diff --git a/.gitmodules b/.gitmodules index 934139011e..0fddd05571 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,9 @@ [submodule "ext/ghoul"] path = ext/ghoul url = git@openspace.itn.liu.se:ghoul +[submodule "ext/spice"] + path = ext/spice + url = git@openspace.itn.liu.se:/spice +[submodule "ext/lua"] + path = ext/lua + url = git@openspace.itn.liu.se:/lua diff --git a/ext/lua b/ext/lua new file mode 160000 index 0000000000..d00aacb598 --- /dev/null +++ b/ext/lua @@ -0,0 +1 @@ +Subproject commit d00aacb598f3bf7f5fc53c7d59bb0bfcd65fe369 diff --git a/ext/lua/CMakeLists.txt b/ext/lua/CMakeLists.txt deleted file mode 100644 index f608a0b4a0..0000000000 --- a/ext/lua/CMakeLists.txt +++ /dev/null @@ -1,86 +0,0 @@ -cmake_minimum_required(VERSION 2.8.0) -project(Lua) - -mark_as_advanced(CMAKE_BACKWARDS_COMPATIBILITY) - -if (POLICY CMP0011) - cmake_policy(SET CMP0011 OLD) # or even better, NEW -endif (POLICY CMP0011) - -if (NOT LUA_ROOT_DIR) - set(LUA_ROOT_DIR ${PROJECT_SOURCE_DIR}) -endif () - -# LUA_USE_APICHECK in full debug mode - -set (LUA_SOURCE - ${PROJECT_SOURCE_DIR}/src/lapi.c - ${PROJECT_SOURCE_DIR}/src/lauxlib.c - ${PROJECT_SOURCE_DIR}/src/lbaselib.c - ${PROJECT_SOURCE_DIR}/src/lbitlib.c - ${PROJECT_SOURCE_DIR}/src/lcode.c - ${PROJECT_SOURCE_DIR}/src/lcorolib.c - ${PROJECT_SOURCE_DIR}/src/lctype.c - ${PROJECT_SOURCE_DIR}/src/ldblib.c - ${PROJECT_SOURCE_DIR}/src/ldebug.c - ${PROJECT_SOURCE_DIR}/src/ldo.c - ${PROJECT_SOURCE_DIR}/src/ldump.c - ${PROJECT_SOURCE_DIR}/src/lfunc.c - ${PROJECT_SOURCE_DIR}/src/lgc.c - ${PROJECT_SOURCE_DIR}/src/linit.c - ${PROJECT_SOURCE_DIR}/src/liolib.c - ${PROJECT_SOURCE_DIR}/src/llex.c - ${PROJECT_SOURCE_DIR}/src/lmathlib.c - ${PROJECT_SOURCE_DIR}/src/lmem.c - ${PROJECT_SOURCE_DIR}/src/loadlib.c - ${PROJECT_SOURCE_DIR}/src/lobject.c - ${PROJECT_SOURCE_DIR}/src/lopcodes.c - ${PROJECT_SOURCE_DIR}/src/loslib.c - ${PROJECT_SOURCE_DIR}/src/lparser.c - ${PROJECT_SOURCE_DIR}/src/lstate.c - ${PROJECT_SOURCE_DIR}/src/lstring.c - ${PROJECT_SOURCE_DIR}/src/lstrlib.c - ${PROJECT_SOURCE_DIR}/src/ltable.c - ${PROJECT_SOURCE_DIR}/src/ltablib.c - ${PROJECT_SOURCE_DIR}/src/ltm.c - ${PROJECT_SOURCE_DIR}/src/lundump.c - ${PROJECT_SOURCE_DIR}/src/lvm.c - ${PROJECT_SOURCE_DIR}/src/lzio.c - ) - -set (LUA_HEADER - ${PROJECT_SOURCE_DIR}/include/lapi.h - ${PROJECT_SOURCE_DIR}/include/lauxlib.h - ${PROJECT_SOURCE_DIR}/include/lcode.h - ${PROJECT_SOURCE_DIR}/include/lctype.h - ${PROJECT_SOURCE_DIR}/include/ldebug.h - ${PROJECT_SOURCE_DIR}/include/ldo.h - ${PROJECT_SOURCE_DIR}/include/lfunc.h - ${PROJECT_SOURCE_DIR}/include/lgc.h - ${PROJECT_SOURCE_DIR}/include/llex.h - ${PROJECT_SOURCE_DIR}/include/llimits.h - ${PROJECT_SOURCE_DIR}/include/lmem.h - ${PROJECT_SOURCE_DIR}/include/lobject.h - ${PROJECT_SOURCE_DIR}/include/lopcodes.h - ${PROJECT_SOURCE_DIR}/include/lparser.h - ${PROJECT_SOURCE_DIR}/include/lstate.h - ${PROJECT_SOURCE_DIR}/include/lstring.h - ${PROJECT_SOURCE_DIR}/include/ltable.h - ${PROJECT_SOURCE_DIR}/include/ltm.h - ${PROJECT_SOURCE_DIR}/include/lua.h - ${PROJECT_SOURCE_DIR}/include/lua.hpp.h - ${PROJECT_SOURCE_DIR}/include/luaconf.h - ${PROJECT_SOURCE_DIR}/include/lualib.h - ${PROJECT_SOURCE_DIR}/include/lundump.h - ${PROJECT_SOURCE_DIR}/include/lvm.h - ${PROJECT_SOURCE_DIR}/include/lzio.h - ) - -if (WIN32) - add_definitions(-D_CRT_SECURE_NO_WARNINGS) -endif() - -add_library(Lua ${LUA_SOURCE}) - -set (LUA_INCLUDE_DIR "${LUA_HEADER}") -include_directories("${LUA_INCLUDE_DIR}") \ No newline at end of file diff --git a/ext/lua/include/lapi.h b/ext/lua/include/lapi.h deleted file mode 100644 index c7d34ad848..0000000000 --- a/ext/lua/include/lapi.h +++ /dev/null @@ -1,24 +0,0 @@ -/* -** $Id: lapi.h,v 2.7.1.1 2013/04/12 18:48:47 roberto Exp $ -** Auxiliary functions from Lua API -** See Copyright Notice in lua.h -*/ - -#ifndef lapi_h -#define lapi_h - - -#include "llimits.h" -#include "lstate.h" - -#define api_incr_top(L) {L->top++; api_check(L, L->top <= L->ci->top, \ - "stack overflow");} - -#define adjustresults(L,nres) \ - { if ((nres) == LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; } - -#define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \ - "not enough elements in the stack") - - -#endif diff --git a/ext/lua/include/lauxlib.h b/ext/lua/include/lauxlib.h deleted file mode 100644 index 0fb023b8e7..0000000000 --- a/ext/lua/include/lauxlib.h +++ /dev/null @@ -1,212 +0,0 @@ -/* -** $Id: lauxlib.h,v 1.120.1.1 2013/04/12 18:48:47 roberto Exp $ -** Auxiliary functions for building Lua libraries -** See Copyright Notice in lua.h -*/ - - -#ifndef lauxlib_h -#define lauxlib_h - - -#include -#include - -#include "lua.h" - - - -/* extra error code for `luaL_load' */ -#define LUA_ERRFILE (LUA_ERRERR+1) - - -typedef struct luaL_Reg { - const char *name; - lua_CFunction func; -} luaL_Reg; - - -LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver); -#define luaL_checkversion(L) luaL_checkversion_(L, LUA_VERSION_NUM) - -LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e); -LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e); -LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len); -LUALIB_API int (luaL_argerror) (lua_State *L, int numarg, const char *extramsg); -LUALIB_API const char *(luaL_checklstring) (lua_State *L, int numArg, - size_t *l); -LUALIB_API const char *(luaL_optlstring) (lua_State *L, int numArg, - const char *def, size_t *l); -LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int numArg); -LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int nArg, lua_Number def); - -LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int numArg); -LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int nArg, - lua_Integer def); -LUALIB_API lua_Unsigned (luaL_checkunsigned) (lua_State *L, int numArg); -LUALIB_API lua_Unsigned (luaL_optunsigned) (lua_State *L, int numArg, - lua_Unsigned def); - -LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg); -LUALIB_API void (luaL_checktype) (lua_State *L, int narg, int t); -LUALIB_API void (luaL_checkany) (lua_State *L, int narg); - -LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname); -LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname); -LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname); -LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname); - -LUALIB_API void (luaL_where) (lua_State *L, int lvl); -LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...); - -LUALIB_API int (luaL_checkoption) (lua_State *L, int narg, const char *def, - const char *const lst[]); - -LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname); -LUALIB_API int (luaL_execresult) (lua_State *L, int stat); - -/* pre-defined references */ -#define LUA_NOREF (-2) -#define LUA_REFNIL (-1) - -LUALIB_API int (luaL_ref) (lua_State *L, int t); -LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref); - -LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename, - const char *mode); - -#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL) - -LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz, - const char *name, const char *mode); -LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s); - -LUALIB_API lua_State *(luaL_newstate) (void); - -LUALIB_API int (luaL_len) (lua_State *L, int idx); - -LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p, - const char *r); - -LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup); - -LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname); - -LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1, - const char *msg, int level); - -LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname, - lua_CFunction openf, int glb); - -/* -** =============================================================== -** some useful macros -** =============================================================== -*/ - - -#define luaL_newlibtable(L,l) \ - lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1) - -#define luaL_newlib(L,l) (luaL_newlibtable(L,l), luaL_setfuncs(L,l,0)) - -#define luaL_argcheck(L, cond,numarg,extramsg) \ - ((void)((cond) || luaL_argerror(L, (numarg), (extramsg)))) -#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL)) -#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL)) -#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n))) -#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d))) -#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n))) -#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d))) - -#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i))) - -#define luaL_dofile(L, fn) \ - (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0)) - -#define luaL_dostring(L, s) \ - (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0)) - -#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n))) - -#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) - -#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL) - - -/* -** {====================================================== -** Generic Buffer manipulation -** ======================================================= -*/ - -typedef struct luaL_Buffer { - char *b; /* buffer address */ - size_t size; /* buffer size */ - size_t n; /* number of characters in buffer */ - lua_State *L; - char initb[LUAL_BUFFERSIZE]; /* initial buffer */ -} luaL_Buffer; - - -#define luaL_addchar(B,c) \ - ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \ - ((B)->b[(B)->n++] = (c))) - -#define luaL_addsize(B,s) ((B)->n += (s)) - -LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B); -LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz); -LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l); -LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s); -LUALIB_API void (luaL_addvalue) (luaL_Buffer *B); -LUALIB_API void (luaL_pushresult) (luaL_Buffer *B); -LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz); -LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz); - -#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE) - -/* }====================================================== */ - - - -/* -** {====================================================== -** File handles for IO library -** ======================================================= -*/ - -/* -** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and -** initial structure 'luaL_Stream' (it may contain other fields -** after that initial structure). -*/ - -#define LUA_FILEHANDLE "FILE*" - - -typedef struct luaL_Stream { - FILE *f; /* stream (NULL for incompletely created streams) */ - lua_CFunction closef; /* to close stream (NULL for closed streams) */ -} luaL_Stream; - -/* }====================================================== */ - - - -/* compatibility with old module system */ -#if defined(LUA_COMPAT_MODULE) - -LUALIB_API void (luaL_pushmodule) (lua_State *L, const char *modname, - int sizehint); -LUALIB_API void (luaL_openlib) (lua_State *L, const char *libname, - const luaL_Reg *l, int nup); - -#define luaL_register(L,n,l) (luaL_openlib(L,(n),(l),0)) - -#endif - - -#endif - - diff --git a/ext/lua/include/lcode.h b/ext/lua/include/lcode.h deleted file mode 100644 index 6a1424cf5a..0000000000 --- a/ext/lua/include/lcode.h +++ /dev/null @@ -1,83 +0,0 @@ -/* -** $Id: lcode.h,v 1.58.1.1 2013/04/12 18:48:47 roberto Exp $ -** Code generator for Lua -** See Copyright Notice in lua.h -*/ - -#ifndef lcode_h -#define lcode_h - -#include "llex.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lparser.h" - - -/* -** Marks the end of a patch list. It is an invalid value both as an absolute -** address, and as a list link (would link an element to itself). -*/ -#define NO_JUMP (-1) - - -/* -** grep "ORDER OPR" if you change these enums (ORDER OP) -*/ -typedef enum BinOpr { - OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW, - OPR_CONCAT, - OPR_EQ, OPR_LT, OPR_LE, - OPR_NE, OPR_GT, OPR_GE, - OPR_AND, OPR_OR, - OPR_NOBINOPR -} BinOpr; - - -typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr; - - -#define getcode(fs,e) ((fs)->f->code[(e)->u.info]) - -#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx) - -#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET) - -#define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t) - -LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx); -LUAI_FUNC int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C); -LUAI_FUNC int luaK_codek (FuncState *fs, int reg, int k); -LUAI_FUNC void luaK_fixline (FuncState *fs, int line); -LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n); -LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n); -LUAI_FUNC void luaK_checkstack (FuncState *fs, int n); -LUAI_FUNC int luaK_stringK (FuncState *fs, TString *s); -LUAI_FUNC int luaK_numberK (FuncState *fs, lua_Number r); -LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e); -LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e); -LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key); -LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k); -LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e); -LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e); -LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults); -LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e); -LUAI_FUNC int luaK_jump (FuncState *fs); -LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret); -LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target); -LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list); -LUAI_FUNC void luaK_patchclose (FuncState *fs, int list, int level); -LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2); -LUAI_FUNC int luaK_getlabel (FuncState *fs); -LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line); -LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v); -LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, - expdesc *v2, int line); -LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore); - - -#endif diff --git a/ext/lua/include/lctype.h b/ext/lua/include/lctype.h deleted file mode 100644 index b09b21a337..0000000000 --- a/ext/lua/include/lctype.h +++ /dev/null @@ -1,95 +0,0 @@ -/* -** $Id: lctype.h,v 1.12.1.1 2013/04/12 18:48:47 roberto Exp $ -** 'ctype' functions for Lua -** See Copyright Notice in lua.h -*/ - -#ifndef lctype_h -#define lctype_h - -#include "lua.h" - - -/* -** WARNING: the functions defined here do not necessarily correspond -** to the similar functions in the standard C ctype.h. They are -** optimized for the specific needs of Lua -*/ - -#if !defined(LUA_USE_CTYPE) - -#if 'A' == 65 && '0' == 48 -/* ASCII case: can use its own tables; faster and fixed */ -#define LUA_USE_CTYPE 0 -#else -/* must use standard C ctype */ -#define LUA_USE_CTYPE 1 -#endif - -#endif - - -#if !LUA_USE_CTYPE /* { */ - -#include - -#include "llimits.h" - - -#define ALPHABIT 0 -#define DIGITBIT 1 -#define PRINTBIT 2 -#define SPACEBIT 3 -#define XDIGITBIT 4 - - -#define MASK(B) (1 << (B)) - - -/* -** add 1 to char to allow index -1 (EOZ) -*/ -#define testprop(c,p) (luai_ctype_[(c)+1] & (p)) - -/* -** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_' -*/ -#define lislalpha(c) testprop(c, MASK(ALPHABIT)) -#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT))) -#define lisdigit(c) testprop(c, MASK(DIGITBIT)) -#define lisspace(c) testprop(c, MASK(SPACEBIT)) -#define lisprint(c) testprop(c, MASK(PRINTBIT)) -#define lisxdigit(c) testprop(c, MASK(XDIGITBIT)) - -/* -** this 'ltolower' only works for alphabetic characters -*/ -#define ltolower(c) ((c) | ('A' ^ 'a')) - - -/* two more entries for 0 and -1 (EOZ) */ -LUAI_DDEC const lu_byte luai_ctype_[UCHAR_MAX + 2]; - - -#else /* }{ */ - -/* -** use standard C ctypes -*/ - -#include - - -#define lislalpha(c) (isalpha(c) || (c) == '_') -#define lislalnum(c) (isalnum(c) || (c) == '_') -#define lisdigit(c) (isdigit(c)) -#define lisspace(c) (isspace(c)) -#define lisprint(c) (isprint(c)) -#define lisxdigit(c) (isxdigit(c)) - -#define ltolower(c) (tolower(c)) - -#endif /* } */ - -#endif - diff --git a/ext/lua/include/ldebug.h b/ext/lua/include/ldebug.h deleted file mode 100644 index 6445c763ea..0000000000 --- a/ext/lua/include/ldebug.h +++ /dev/null @@ -1,34 +0,0 @@ -/* -** $Id: ldebug.h,v 2.7.1.1 2013/04/12 18:48:47 roberto Exp $ -** Auxiliary functions from Debug Interface module -** See Copyright Notice in lua.h -*/ - -#ifndef ldebug_h -#define ldebug_h - - -#include "lstate.h" - - -#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1) - -#define getfuncline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0) - -#define resethookcount(L) (L->hookcount = L->basehookcount) - -/* Active Lua function (given call info) */ -#define ci_func(ci) (clLvalue((ci)->func)) - - -LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o, - const char *opname); -LUAI_FUNC l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2); -LUAI_FUNC l_noret luaG_aritherror (lua_State *L, const TValue *p1, - const TValue *p2); -LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1, - const TValue *p2); -LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...); -LUAI_FUNC l_noret luaG_errormsg (lua_State *L); - -#endif diff --git a/ext/lua/include/ldo.h b/ext/lua/include/ldo.h deleted file mode 100644 index d3d3082c9b..0000000000 --- a/ext/lua/include/ldo.h +++ /dev/null @@ -1,46 +0,0 @@ -/* -** $Id: ldo.h,v 2.20.1.1 2013/04/12 18:48:47 roberto Exp $ -** Stack and Call structure of Lua -** See Copyright Notice in lua.h -*/ - -#ifndef ldo_h -#define ldo_h - - -#include "lobject.h" -#include "lstate.h" -#include "lzio.h" - - -#define luaD_checkstack(L,n) if (L->stack_last - L->top <= (n)) \ - luaD_growstack(L, n); else condmovestack(L); - - -#define incr_top(L) {L->top++; luaD_checkstack(L,0);} - -#define savestack(L,p) ((char *)(p) - (char *)L->stack) -#define restorestack(L,n) ((TValue *)((char *)L->stack + (n))) - - -/* type of protected functions, to be ran by `runprotected' */ -typedef void (*Pfunc) (lua_State *L, void *ud); - -LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name, - const char *mode); -LUAI_FUNC void luaD_hook (lua_State *L, int event, int line); -LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults); -LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults, - int allowyield); -LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u, - ptrdiff_t oldtop, ptrdiff_t ef); -LUAI_FUNC int luaD_poscall (lua_State *L, StkId firstResult); -LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize); -LUAI_FUNC void luaD_growstack (lua_State *L, int n); -LUAI_FUNC void luaD_shrinkstack (lua_State *L); - -LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode); -LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud); - -#endif - diff --git a/ext/lua/include/lfunc.h b/ext/lua/include/lfunc.h deleted file mode 100644 index ca0d3a3e0b..0000000000 --- a/ext/lua/include/lfunc.h +++ /dev/null @@ -1,33 +0,0 @@ -/* -** $Id: lfunc.h,v 2.8.1.1 2013/04/12 18:48:47 roberto Exp $ -** Auxiliary functions to manipulate prototypes and closures -** See Copyright Notice in lua.h -*/ - -#ifndef lfunc_h -#define lfunc_h - - -#include "lobject.h" - - -#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \ - cast(int, sizeof(TValue)*((n)-1))) - -#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \ - cast(int, sizeof(TValue *)*((n)-1))) - - -LUAI_FUNC Proto *luaF_newproto (lua_State *L); -LUAI_FUNC Closure *luaF_newCclosure (lua_State *L, int nelems); -LUAI_FUNC Closure *luaF_newLclosure (lua_State *L, int nelems); -LUAI_FUNC UpVal *luaF_newupval (lua_State *L); -LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level); -LUAI_FUNC void luaF_close (lua_State *L, StkId level); -LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f); -LUAI_FUNC void luaF_freeupval (lua_State *L, UpVal *uv); -LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number, - int pc); - - -#endif diff --git a/ext/lua/include/lgc.h b/ext/lua/include/lgc.h deleted file mode 100644 index 84bb1cdf99..0000000000 --- a/ext/lua/include/lgc.h +++ /dev/null @@ -1,157 +0,0 @@ -/* -** $Id: lgc.h,v 2.58.1.1 2013/04/12 18:48:47 roberto Exp $ -** Garbage Collector -** See Copyright Notice in lua.h -*/ - -#ifndef lgc_h -#define lgc_h - - -#include "lobject.h" -#include "lstate.h" - -/* -** Collectable objects may have one of three colors: white, which -** means the object is not marked; gray, which means the -** object is marked, but its references may be not marked; and -** black, which means that the object and all its references are marked. -** The main invariant of the garbage collector, while marking objects, -** is that a black object can never point to a white one. Moreover, -** any gray object must be in a "gray list" (gray, grayagain, weak, -** allweak, ephemeron) so that it can be visited again before finishing -** the collection cycle. These lists have no meaning when the invariant -** is not being enforced (e.g., sweep phase). -*/ - - - -/* how much to allocate before next GC step */ -#if !defined(GCSTEPSIZE) -/* ~100 small strings */ -#define GCSTEPSIZE (cast_int(100 * sizeof(TString))) -#endif - - -/* -** Possible states of the Garbage Collector -*/ -#define GCSpropagate 0 -#define GCSatomic 1 -#define GCSsweepstring 2 -#define GCSsweepudata 3 -#define GCSsweep 4 -#define GCSpause 5 - - -#define issweepphase(g) \ - (GCSsweepstring <= (g)->gcstate && (g)->gcstate <= GCSsweep) - -#define isgenerational(g) ((g)->gckind == KGC_GEN) - -/* -** macros to tell when main invariant (white objects cannot point to black -** ones) must be kept. During a non-generational collection, the sweep -** phase may break the invariant, as objects turned white may point to -** still-black objects. The invariant is restored when sweep ends and -** all objects are white again. During a generational collection, the -** invariant must be kept all times. -*/ - -#define keepinvariant(g) (isgenerational(g) || g->gcstate <= GCSatomic) - - -/* -** Outside the collector, the state in generational mode is kept in -** 'propagate', so 'keepinvariant' is always true. -*/ -#define keepinvariantout(g) \ - check_exp(g->gcstate == GCSpropagate || !isgenerational(g), \ - g->gcstate <= GCSatomic) - - -/* -** some useful bit tricks -*/ -#define resetbits(x,m) ((x) &= cast(lu_byte, ~(m))) -#define setbits(x,m) ((x) |= (m)) -#define testbits(x,m) ((x) & (m)) -#define bitmask(b) (1<<(b)) -#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2)) -#define l_setbit(x,b) setbits(x, bitmask(b)) -#define resetbit(x,b) resetbits(x, bitmask(b)) -#define testbit(x,b) testbits(x, bitmask(b)) - - -/* Layout for bit use in `marked' field: */ -#define WHITE0BIT 0 /* object is white (type 0) */ -#define WHITE1BIT 1 /* object is white (type 1) */ -#define BLACKBIT 2 /* object is black */ -#define FINALIZEDBIT 3 /* object has been separated for finalization */ -#define SEPARATED 4 /* object is in 'finobj' list or in 'tobefnz' */ -#define FIXEDBIT 5 /* object is fixed (should not be collected) */ -#define OLDBIT 6 /* object is old (only in generational mode) */ -/* bit 7 is currently used by tests (luaL_checkmemory) */ - -#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT) - - -#define iswhite(x) testbits((x)->gch.marked, WHITEBITS) -#define isblack(x) testbit((x)->gch.marked, BLACKBIT) -#define isgray(x) /* neither white nor black */ \ - (!testbits((x)->gch.marked, WHITEBITS | bitmask(BLACKBIT))) - -#define isold(x) testbit((x)->gch.marked, OLDBIT) - -/* MOVE OLD rule: whenever an object is moved to the beginning of - a GC list, its old bit must be cleared */ -#define resetoldbit(o) resetbit((o)->gch.marked, OLDBIT) - -#define otherwhite(g) (g->currentwhite ^ WHITEBITS) -#define isdeadm(ow,m) (!(((m) ^ WHITEBITS) & (ow))) -#define isdead(g,v) isdeadm(otherwhite(g), (v)->gch.marked) - -#define changewhite(x) ((x)->gch.marked ^= WHITEBITS) -#define gray2black(x) l_setbit((x)->gch.marked, BLACKBIT) - -#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x))) - -#define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS) - - -#define luaC_condGC(L,c) \ - {if (G(L)->GCdebt > 0) {c;}; condchangemem(L);} -#define luaC_checkGC(L) luaC_condGC(L, luaC_step(L);) - - -#define luaC_barrier(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p))) \ - luaC_barrier_(L,obj2gco(p),gcvalue(v)); } - -#define luaC_barrierback(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p))) \ - luaC_barrierback_(L,p); } - -#define luaC_objbarrier(L,p,o) \ - { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) \ - luaC_barrier_(L,obj2gco(p),obj2gco(o)); } - -#define luaC_objbarrierback(L,p,o) \ - { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) luaC_barrierback_(L,p); } - -#define luaC_barrierproto(L,p,c) \ - { if (isblack(obj2gco(p))) luaC_barrierproto_(L,p,c); } - -LUAI_FUNC void luaC_freeallobjects (lua_State *L); -LUAI_FUNC void luaC_step (lua_State *L); -LUAI_FUNC void luaC_forcestep (lua_State *L); -LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask); -LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency); -LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz, - GCObject **list, int offset); -LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v); -LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o); -LUAI_FUNC void luaC_barrierproto_ (lua_State *L, Proto *p, Closure *c); -LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt); -LUAI_FUNC void luaC_checkupvalcolor (global_State *g, UpVal *uv); -LUAI_FUNC void luaC_changemode (lua_State *L, int mode); - -#endif diff --git a/ext/lua/include/llex.h b/ext/lua/include/llex.h deleted file mode 100644 index a4acdd3021..0000000000 --- a/ext/lua/include/llex.h +++ /dev/null @@ -1,78 +0,0 @@ -/* -** $Id: llex.h,v 1.72.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lexical Analyzer -** See Copyright Notice in lua.h -*/ - -#ifndef llex_h -#define llex_h - -#include "lobject.h" -#include "lzio.h" - - -#define FIRST_RESERVED 257 - - - -/* -* WARNING: if you change the order of this enumeration, -* grep "ORDER RESERVED" -*/ -enum RESERVED { - /* terminal symbols denoted by reserved words */ - TK_AND = FIRST_RESERVED, TK_BREAK, - TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION, - TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT, - TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE, - /* other terminal symbols */ - TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_DBCOLON, TK_EOS, - TK_NUMBER, TK_NAME, TK_STRING -}; - -/* number of reserved words */ -#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1)) - - -typedef union { - lua_Number r; - TString *ts; -} SemInfo; /* semantics information */ - - -typedef struct Token { - int token; - SemInfo seminfo; -} Token; - - -/* state of the lexer plus state of the parser when shared by all - functions */ -typedef struct LexState { - int current; /* current character (charint) */ - int linenumber; /* input line counter */ - int lastline; /* line of last token `consumed' */ - Token t; /* current token */ - Token lookahead; /* look ahead token */ - struct FuncState *fs; /* current function (parser) */ - struct lua_State *L; - ZIO *z; /* input stream */ - Mbuffer *buff; /* buffer for tokens */ - struct Dyndata *dyd; /* dynamic structures used by the parser */ - TString *source; /* current source name */ - TString *envn; /* environment variable name */ - char decpoint; /* locale decimal point */ -} LexState; - - -LUAI_FUNC void luaX_init (lua_State *L); -LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, - TString *source, int firstchar); -LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l); -LUAI_FUNC void luaX_next (LexState *ls); -LUAI_FUNC int luaX_lookahead (LexState *ls); -LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s); -LUAI_FUNC const char *luaX_token2str (LexState *ls, int token); - - -#endif diff --git a/ext/lua/include/llimits.h b/ext/lua/include/llimits.h deleted file mode 100644 index 152dd05515..0000000000 --- a/ext/lua/include/llimits.h +++ /dev/null @@ -1,309 +0,0 @@ -/* -** $Id: llimits.h,v 1.103.1.1 2013/04/12 18:48:47 roberto Exp $ -** Limits, basic types, and some other `installation-dependent' definitions -** See Copyright Notice in lua.h -*/ - -#ifndef llimits_h -#define llimits_h - - -#include -#include - - -#include "lua.h" - - -typedef unsigned LUA_INT32 lu_int32; - -typedef LUAI_UMEM lu_mem; - -typedef LUAI_MEM l_mem; - - - -/* chars used as small naturals (so that `char' is reserved for characters) */ -typedef unsigned char lu_byte; - - -#define MAX_SIZET ((size_t)(~(size_t)0)-2) - -#define MAX_LUMEM ((lu_mem)(~(lu_mem)0)-2) - -#define MAX_LMEM ((l_mem) ((MAX_LUMEM >> 1) - 2)) - - -#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */ - -/* -** conversion of pointer to integer -** this is for hashing only; there is no problem if the integer -** cannot hold the whole pointer value -*/ -#define IntPoint(p) ((unsigned int)(lu_mem)(p)) - - - -/* type to ensure maximum alignment */ -#if !defined(LUAI_USER_ALIGNMENT_T) -#define LUAI_USER_ALIGNMENT_T union { double u; void *s; long l; } -#endif - -typedef LUAI_USER_ALIGNMENT_T L_Umaxalign; - - -/* result of a `usual argument conversion' over lua_Number */ -typedef LUAI_UACNUMBER l_uacNumber; - - -/* internal assertions for in-house debugging */ -#if defined(lua_assert) -#define check_exp(c,e) (lua_assert(c), (e)) -/* to avoid problems with conditions too long */ -#define lua_longassert(c) { if (!(c)) lua_assert(0); } -#else -#define lua_assert(c) ((void)0) -#define check_exp(c,e) (e) -#define lua_longassert(c) ((void)0) -#endif - -/* -** assertion for checking API calls -*/ -#if !defined(luai_apicheck) - -#if defined(LUA_USE_APICHECK) -#include -#define luai_apicheck(L,e) assert(e) -#else -#define luai_apicheck(L,e) lua_assert(e) -#endif - -#endif - -#define api_check(l,e,msg) luai_apicheck(l,(e) && msg) - - -#if !defined(UNUSED) -#define UNUSED(x) ((void)(x)) /* to avoid warnings */ -#endif - - -#define cast(t, exp) ((t)(exp)) - -#define cast_byte(i) cast(lu_byte, (i)) -#define cast_num(i) cast(lua_Number, (i)) -#define cast_int(i) cast(int, (i)) -#define cast_uchar(i) cast(unsigned char, (i)) - - -/* -** non-return type -*/ -#if defined(__GNUC__) -#define l_noret void __attribute__((noreturn)) -#elif defined(_MSC_VER) -#define l_noret void __declspec(noreturn) -#else -#define l_noret void -#endif - - - -/* -** maximum depth for nested C calls and syntactical nested non-terminals -** in a program. (Value must fit in an unsigned short int.) -*/ -#if !defined(LUAI_MAXCCALLS) -#define LUAI_MAXCCALLS 200 -#endif - -/* -** maximum number of upvalues in a closure (both C and Lua). (Value -** must fit in an unsigned char.) -*/ -#define MAXUPVAL UCHAR_MAX - - -/* -** type for virtual-machine instructions -** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h) -*/ -typedef lu_int32 Instruction; - - - -/* maximum stack for a Lua function */ -#define MAXSTACK 250 - - - -/* minimum size for the string table (must be power of 2) */ -#if !defined(MINSTRTABSIZE) -#define MINSTRTABSIZE 32 -#endif - - -/* minimum size for string buffer */ -#if !defined(LUA_MINBUFFER) -#define LUA_MINBUFFER 32 -#endif - - -#if !defined(lua_lock) -#define lua_lock(L) ((void) 0) -#define lua_unlock(L) ((void) 0) -#endif - -#if !defined(luai_threadyield) -#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);} -#endif - - -/* -** these macros allow user-specific actions on threads when you defined -** LUAI_EXTRASPACE and need to do something extra when a thread is -** created/deleted/resumed/yielded. -*/ -#if !defined(luai_userstateopen) -#define luai_userstateopen(L) ((void)L) -#endif - -#if !defined(luai_userstateclose) -#define luai_userstateclose(L) ((void)L) -#endif - -#if !defined(luai_userstatethread) -#define luai_userstatethread(L,L1) ((void)L) -#endif - -#if !defined(luai_userstatefree) -#define luai_userstatefree(L,L1) ((void)L) -#endif - -#if !defined(luai_userstateresume) -#define luai_userstateresume(L,n) ((void)L) -#endif - -#if !defined(luai_userstateyield) -#define luai_userstateyield(L,n) ((void)L) -#endif - -/* -** lua_number2int is a macro to convert lua_Number to int. -** lua_number2integer is a macro to convert lua_Number to lua_Integer. -** lua_number2unsigned is a macro to convert a lua_Number to a lua_Unsigned. -** lua_unsigned2number is a macro to convert a lua_Unsigned to a lua_Number. -** luai_hashnum is a macro to hash a lua_Number value into an integer. -** The hash must be deterministic and give reasonable values for -** both small and large values (outside the range of integers). -*/ - -#if defined(MS_ASMTRICK) || defined(LUA_MSASMTRICK) /* { */ -/* trick with Microsoft assembler for X86 */ - -#define lua_number2int(i,n) __asm {__asm fld n __asm fistp i} -#define lua_number2integer(i,n) lua_number2int(i, n) -#define lua_number2unsigned(i,n) \ - {__int64 l; __asm {__asm fld n __asm fistp l} i = (unsigned int)l;} - - -#elif defined(LUA_IEEE754TRICK) /* }{ */ -/* the next trick should work on any machine using IEEE754 with - a 32-bit int type */ - -union luai_Cast { double l_d; LUA_INT32 l_p[2]; }; - -#if !defined(LUA_IEEEENDIAN) /* { */ -#define LUAI_EXTRAIEEE \ - static const union luai_Cast ieeeendian = {-(33.0 + 6755399441055744.0)}; -#define LUA_IEEEENDIANLOC (ieeeendian.l_p[1] == 33) -#else -#define LUA_IEEEENDIANLOC LUA_IEEEENDIAN -#define LUAI_EXTRAIEEE /* empty */ -#endif /* } */ - -#define lua_number2int32(i,n,t) \ - { LUAI_EXTRAIEEE \ - volatile union luai_Cast u; u.l_d = (n) + 6755399441055744.0; \ - (i) = (t)u.l_p[LUA_IEEEENDIANLOC]; } - -#define luai_hashnum(i,n) \ - { volatile union luai_Cast u; u.l_d = (n) + 1.0; /* avoid -0 */ \ - (i) = u.l_p[0]; (i) += u.l_p[1]; } /* add double bits for his hash */ - -#define lua_number2int(i,n) lua_number2int32(i, n, int) -#define lua_number2unsigned(i,n) lua_number2int32(i, n, lua_Unsigned) - -/* the trick can be expanded to lua_Integer when it is a 32-bit value */ -#if defined(LUA_IEEELL) -#define lua_number2integer(i,n) lua_number2int32(i, n, lua_Integer) -#endif - -#endif /* } */ - - -/* the following definitions always work, but may be slow */ - -#if !defined(lua_number2int) -#define lua_number2int(i,n) ((i)=(int)(n)) -#endif - -#if !defined(lua_number2integer) -#define lua_number2integer(i,n) ((i)=(lua_Integer)(n)) -#endif - -#if !defined(lua_number2unsigned) /* { */ -/* the following definition assures proper modulo behavior */ -#if defined(LUA_NUMBER_DOUBLE) || defined(LUA_NUMBER_FLOAT) -#include -#define SUPUNSIGNED ((lua_Number)(~(lua_Unsigned)0) + 1) -#define lua_number2unsigned(i,n) \ - ((i)=(lua_Unsigned)((n) - floor((n)/SUPUNSIGNED)*SUPUNSIGNED)) -#else -#define lua_number2unsigned(i,n) ((i)=(lua_Unsigned)(n)) -#endif -#endif /* } */ - - -#if !defined(lua_unsigned2number) -/* on several machines, coercion from unsigned to double is slow, - so it may be worth to avoid */ -#define lua_unsigned2number(u) \ - (((u) <= (lua_Unsigned)INT_MAX) ? (lua_Number)(int)(u) : (lua_Number)(u)) -#endif - - - -#if defined(ltable_c) && !defined(luai_hashnum) - -#include -#include - -#define luai_hashnum(i,n) { int e; \ - n = l_mathop(frexp)(n, &e) * (lua_Number)(INT_MAX - DBL_MAX_EXP); \ - lua_number2int(i, n); i += e; } - -#endif - - - -/* -** macro to control inclusion of some hard tests on stack reallocation -*/ -#if !defined(HARDSTACKTESTS) -#define condmovestack(L) ((void)0) -#else -/* realloc stack keeping its size */ -#define condmovestack(L) luaD_reallocstack((L), (L)->stacksize) -#endif - -#if !defined(HARDMEMTESTS) -#define condchangemem(L) condmovestack(L) -#else -#define condchangemem(L) \ - ((void)(!(G(L)->gcrunning) || (luaC_fullgc(L, 0), 1))) -#endif - -#endif diff --git a/ext/lua/include/lmem.h b/ext/lua/include/lmem.h deleted file mode 100644 index bd4f4e0726..0000000000 --- a/ext/lua/include/lmem.h +++ /dev/null @@ -1,57 +0,0 @@ -/* -** $Id: lmem.h,v 1.40.1.1 2013/04/12 18:48:47 roberto Exp $ -** Interface to Memory Manager -** See Copyright Notice in lua.h -*/ - -#ifndef lmem_h -#define lmem_h - - -#include - -#include "llimits.h" -#include "lua.h" - - -/* -** This macro avoids the runtime division MAX_SIZET/(e), as 'e' is -** always constant. -** The macro is somewhat complex to avoid warnings: -** +1 avoids warnings of "comparison has constant result"; -** cast to 'void' avoids warnings of "value unused". -*/ -#define luaM_reallocv(L,b,on,n,e) \ - (cast(void, \ - (cast(size_t, (n)+1) > MAX_SIZET/(e)) ? (luaM_toobig(L), 0) : 0), \ - luaM_realloc_(L, (b), (on)*(e), (n)*(e))) - -#define luaM_freemem(L, b, s) luaM_realloc_(L, (b), (s), 0) -#define luaM_free(L, b) luaM_realloc_(L, (b), sizeof(*(b)), 0) -#define luaM_freearray(L, b, n) luaM_reallocv(L, (b), n, 0, sizeof((b)[0])) - -#define luaM_malloc(L,s) luaM_realloc_(L, NULL, 0, (s)) -#define luaM_new(L,t) cast(t *, luaM_malloc(L, sizeof(t))) -#define luaM_newvector(L,n,t) \ - cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t))) - -#define luaM_newobject(L,tag,s) luaM_realloc_(L, NULL, tag, (s)) - -#define luaM_growvector(L,v,nelems,size,t,limit,e) \ - if ((nelems)+1 > (size)) \ - ((v)=cast(t *, luaM_growaux_(L,v,&(size),sizeof(t),limit,e))) - -#define luaM_reallocvector(L, v,oldn,n,t) \ - ((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t)))) - -LUAI_FUNC l_noret luaM_toobig (lua_State *L); - -/* not to be called directly */ -LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize, - size_t size); -LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size, - size_t size_elem, int limit, - const char *what); - -#endif - diff --git a/ext/lua/include/lobject.h b/ext/lua/include/lobject.h deleted file mode 100644 index 3a630b944c..0000000000 --- a/ext/lua/include/lobject.h +++ /dev/null @@ -1,607 +0,0 @@ -/* -** $Id: lobject.h,v 2.71.1.1 2013/04/12 18:48:47 roberto Exp $ -** Type definitions for Lua objects -** See Copyright Notice in lua.h -*/ - - -#ifndef lobject_h -#define lobject_h - - -#include - - -#include "llimits.h" -#include "lua.h" - - -/* -** Extra tags for non-values -*/ -#define LUA_TPROTO LUA_NUMTAGS -#define LUA_TUPVAL (LUA_NUMTAGS+1) -#define LUA_TDEADKEY (LUA_NUMTAGS+2) - -/* -** number of all possible tags (including LUA_TNONE but excluding DEADKEY) -*/ -#define LUA_TOTALTAGS (LUA_TUPVAL+2) - - -/* -** tags for Tagged Values have the following use of bits: -** bits 0-3: actual tag (a LUA_T* value) -** bits 4-5: variant bits -** bit 6: whether value is collectable -*/ - -#define VARBITS (3 << 4) - - -/* -** LUA_TFUNCTION variants: -** 0 - Lua function -** 1 - light C function -** 2 - regular C function (closure) -*/ - -/* Variant tags for functions */ -#define LUA_TLCL (LUA_TFUNCTION | (0 << 4)) /* Lua closure */ -#define LUA_TLCF (LUA_TFUNCTION | (1 << 4)) /* light C function */ -#define LUA_TCCL (LUA_TFUNCTION | (2 << 4)) /* C closure */ - - -/* Variant tags for strings */ -#define LUA_TSHRSTR (LUA_TSTRING | (0 << 4)) /* short strings */ -#define LUA_TLNGSTR (LUA_TSTRING | (1 << 4)) /* long strings */ - - -/* Bit mark for collectable types */ -#define BIT_ISCOLLECTABLE (1 << 6) - -/* mark a tag as collectable */ -#define ctb(t) ((t) | BIT_ISCOLLECTABLE) - - -/* -** Union of all collectable objects -*/ -typedef union GCObject GCObject; - - -/* -** Common Header for all collectable objects (in macro form, to be -** included in other objects) -*/ -#define CommonHeader GCObject *next; lu_byte tt; lu_byte marked - - -/* -** Common header in struct form -*/ -typedef struct GCheader { - CommonHeader; -} GCheader; - - - -/* -** Union of all Lua values -*/ -typedef union Value Value; - - -#define numfield lua_Number n; /* numbers */ - - - -/* -** Tagged Values. This is the basic representation of values in Lua, -** an actual value plus a tag with its type. -*/ - -#define TValuefields Value value_; int tt_ - -typedef struct lua_TValue TValue; - - -/* macro defining a nil value */ -#define NILCONSTANT {NULL}, LUA_TNIL - - -#define val_(o) ((o)->value_) -#define num_(o) (val_(o).n) - - -/* raw type tag of a TValue */ -#define rttype(o) ((o)->tt_) - -/* tag with no variants (bits 0-3) */ -#define novariant(x) ((x) & 0x0F) - -/* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */ -#define ttype(o) (rttype(o) & 0x3F) - -/* type tag of a TValue with no variants (bits 0-3) */ -#define ttypenv(o) (novariant(rttype(o))) - - -/* Macros to test type */ -#define checktag(o,t) (rttype(o) == (t)) -#define checktype(o,t) (ttypenv(o) == (t)) -#define ttisnumber(o) checktag((o), LUA_TNUMBER) -#define ttisnil(o) checktag((o), LUA_TNIL) -#define ttisboolean(o) checktag((o), LUA_TBOOLEAN) -#define ttislightuserdata(o) checktag((o), LUA_TLIGHTUSERDATA) -#define ttisstring(o) checktype((o), LUA_TSTRING) -#define ttisshrstring(o) checktag((o), ctb(LUA_TSHRSTR)) -#define ttislngstring(o) checktag((o), ctb(LUA_TLNGSTR)) -#define ttistable(o) checktag((o), ctb(LUA_TTABLE)) -#define ttisfunction(o) checktype(o, LUA_TFUNCTION) -#define ttisclosure(o) ((rttype(o) & 0x1F) == LUA_TFUNCTION) -#define ttisCclosure(o) checktag((o), ctb(LUA_TCCL)) -#define ttisLclosure(o) checktag((o), ctb(LUA_TLCL)) -#define ttislcf(o) checktag((o), LUA_TLCF) -#define ttisuserdata(o) checktag((o), ctb(LUA_TUSERDATA)) -#define ttisthread(o) checktag((o), ctb(LUA_TTHREAD)) -#define ttisdeadkey(o) checktag((o), LUA_TDEADKEY) - -#define ttisequal(o1,o2) (rttype(o1) == rttype(o2)) - -/* Macros to access values */ -#define nvalue(o) check_exp(ttisnumber(o), num_(o)) -#define gcvalue(o) check_exp(iscollectable(o), val_(o).gc) -#define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p) -#define rawtsvalue(o) check_exp(ttisstring(o), &val_(o).gc->ts) -#define tsvalue(o) (&rawtsvalue(o)->tsv) -#define rawuvalue(o) check_exp(ttisuserdata(o), &val_(o).gc->u) -#define uvalue(o) (&rawuvalue(o)->uv) -#define clvalue(o) check_exp(ttisclosure(o), &val_(o).gc->cl) -#define clLvalue(o) check_exp(ttisLclosure(o), &val_(o).gc->cl.l) -#define clCvalue(o) check_exp(ttisCclosure(o), &val_(o).gc->cl.c) -#define fvalue(o) check_exp(ttislcf(o), val_(o).f) -#define hvalue(o) check_exp(ttistable(o), &val_(o).gc->h) -#define bvalue(o) check_exp(ttisboolean(o), val_(o).b) -#define thvalue(o) check_exp(ttisthread(o), &val_(o).gc->th) -/* a dead value may get the 'gc' field, but cannot access its contents */ -#define deadvalue(o) check_exp(ttisdeadkey(o), cast(void *, val_(o).gc)) - -#define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0)) - - -#define iscollectable(o) (rttype(o) & BIT_ISCOLLECTABLE) - - -/* Macros for internal tests */ -#define righttt(obj) (ttype(obj) == gcvalue(obj)->gch.tt) - -#define checkliveness(g,obj) \ - lua_longassert(!iscollectable(obj) || \ - (righttt(obj) && !isdead(g,gcvalue(obj)))) - - -/* Macros to set values */ -#define settt_(o,t) ((o)->tt_=(t)) - -#define setnvalue(obj,x) \ - { TValue *io=(obj); num_(io)=(x); settt_(io, LUA_TNUMBER); } - -#define setnilvalue(obj) settt_(obj, LUA_TNIL) - -#define setfvalue(obj,x) \ - { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_TLCF); } - -#define setpvalue(obj,x) \ - { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_TLIGHTUSERDATA); } - -#define setbvalue(obj,x) \ - { TValue *io=(obj); val_(io).b=(x); settt_(io, LUA_TBOOLEAN); } - -#define setgcovalue(L,obj,x) \ - { TValue *io=(obj); GCObject *i_g=(x); \ - val_(io).gc=i_g; settt_(io, ctb(gch(i_g)->tt)); } - -#define setsvalue(L,obj,x) \ - { TValue *io=(obj); \ - TString *x_ = (x); \ - val_(io).gc=cast(GCObject *, x_); settt_(io, ctb(x_->tsv.tt)); \ - checkliveness(G(L),io); } - -#define setuvalue(L,obj,x) \ - { TValue *io=(obj); \ - val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TUSERDATA)); \ - checkliveness(G(L),io); } - -#define setthvalue(L,obj,x) \ - { TValue *io=(obj); \ - val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TTHREAD)); \ - checkliveness(G(L),io); } - -#define setclLvalue(L,obj,x) \ - { TValue *io=(obj); \ - val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TLCL)); \ - checkliveness(G(L),io); } - -#define setclCvalue(L,obj,x) \ - { TValue *io=(obj); \ - val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TCCL)); \ - checkliveness(G(L),io); } - -#define sethvalue(L,obj,x) \ - { TValue *io=(obj); \ - val_(io).gc=cast(GCObject *, (x)); settt_(io, ctb(LUA_TTABLE)); \ - checkliveness(G(L),io); } - -#define setdeadvalue(obj) settt_(obj, LUA_TDEADKEY) - - - -#define setobj(L,obj1,obj2) \ - { const TValue *io2=(obj2); TValue *io1=(obj1); \ - io1->value_ = io2->value_; io1->tt_ = io2->tt_; \ - checkliveness(G(L),io1); } - - -/* -** different types of assignments, according to destination -*/ - -/* from stack to (same) stack */ -#define setobjs2s setobj -/* to stack (not from same stack) */ -#define setobj2s setobj -#define setsvalue2s setsvalue -#define sethvalue2s sethvalue -#define setptvalue2s setptvalue -/* from table to same table */ -#define setobjt2t setobj -/* to table */ -#define setobj2t setobj -/* to new object */ -#define setobj2n setobj -#define setsvalue2n setsvalue - - -/* check whether a number is valid (useful only for NaN trick) */ -#define luai_checknum(L,o,c) { /* empty */ } - - -/* -** {====================================================== -** NaN Trick -** ======================================================= -*/ -#if defined(LUA_NANTRICK) - -/* -** numbers are represented in the 'd_' field. All other values have the -** value (NNMARK | tag) in 'tt__'. A number with such pattern would be -** a "signaled NaN", which is never generated by regular operations by -** the CPU (nor by 'strtod') -*/ - -/* allows for external implementation for part of the trick */ -#if !defined(NNMARK) /* { */ - - -#if !defined(LUA_IEEEENDIAN) -#error option 'LUA_NANTRICK' needs 'LUA_IEEEENDIAN' -#endif - - -#define NNMARK 0x7FF7A500 -#define NNMASK 0x7FFFFF00 - -#undef TValuefields -#undef NILCONSTANT - -#if (LUA_IEEEENDIAN == 0) /* { */ - -/* little endian */ -#define TValuefields \ - union { struct { Value v__; int tt__; } i; double d__; } u -#define NILCONSTANT {{{NULL}, tag2tt(LUA_TNIL)}} -/* field-access macros */ -#define v_(o) ((o)->u.i.v__) -#define d_(o) ((o)->u.d__) -#define tt_(o) ((o)->u.i.tt__) - -#else /* }{ */ - -/* big endian */ -#define TValuefields \ - union { struct { int tt__; Value v__; } i; double d__; } u -#define NILCONSTANT {{tag2tt(LUA_TNIL), {NULL}}} -/* field-access macros */ -#define v_(o) ((o)->u.i.v__) -#define d_(o) ((o)->u.d__) -#define tt_(o) ((o)->u.i.tt__) - -#endif /* } */ - -#endif /* } */ - - -/* correspondence with standard representation */ -#undef val_ -#define val_(o) v_(o) -#undef num_ -#define num_(o) d_(o) - - -#undef numfield -#define numfield /* no such field; numbers are the entire struct */ - -/* basic check to distinguish numbers from non-numbers */ -#undef ttisnumber -#define ttisnumber(o) ((tt_(o) & NNMASK) != NNMARK) - -#define tag2tt(t) (NNMARK | (t)) - -#undef rttype -#define rttype(o) (ttisnumber(o) ? LUA_TNUMBER : tt_(o) & 0xff) - -#undef settt_ -#define settt_(o,t) (tt_(o) = tag2tt(t)) - -#undef setnvalue -#define setnvalue(obj,x) \ - { TValue *io_=(obj); num_(io_)=(x); lua_assert(ttisnumber(io_)); } - -#undef setobj -#define setobj(L,obj1,obj2) \ - { const TValue *o2_=(obj2); TValue *o1_=(obj1); \ - o1_->u = o2_->u; \ - checkliveness(G(L),o1_); } - - -/* -** these redefinitions are not mandatory, but these forms are more efficient -*/ - -#undef checktag -#undef checktype -#define checktag(o,t) (tt_(o) == tag2tt(t)) -#define checktype(o,t) (ctb(tt_(o) | VARBITS) == ctb(tag2tt(t) | VARBITS)) - -#undef ttisequal -#define ttisequal(o1,o2) \ - (ttisnumber(o1) ? ttisnumber(o2) : (tt_(o1) == tt_(o2))) - - -#undef luai_checknum -#define luai_checknum(L,o,c) { if (!ttisnumber(o)) c; } - -#endif -/* }====================================================== */ - - - -/* -** {====================================================== -** types and prototypes -** ======================================================= -*/ - - -union Value { - GCObject *gc; /* collectable objects */ - void *p; /* light userdata */ - int b; /* booleans */ - lua_CFunction f; /* light C functions */ - numfield /* numbers */ -}; - - -struct lua_TValue { - TValuefields; -}; - - -typedef TValue *StkId; /* index to stack elements */ - - - - -/* -** Header for string value; string bytes follow the end of this structure -*/ -typedef union TString { - L_Umaxalign dummy; /* ensures maximum alignment for strings */ - struct { - CommonHeader; - lu_byte extra; /* reserved words for short strings; "has hash" for longs */ - unsigned int hash; - size_t len; /* number of characters in string */ - } tsv; -} TString; - - -/* get the actual string (array of bytes) from a TString */ -#define getstr(ts) cast(const char *, (ts) + 1) - -/* get the actual string (array of bytes) from a Lua value */ -#define svalue(o) getstr(rawtsvalue(o)) - - -/* -** Header for userdata; memory area follows the end of this structure -*/ -typedef union Udata { - L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */ - struct { - CommonHeader; - struct Table *metatable; - struct Table *env; - size_t len; /* number of bytes */ - } uv; -} Udata; - - - -/* -** Description of an upvalue for function prototypes -*/ -typedef struct Upvaldesc { - TString *name; /* upvalue name (for debug information) */ - lu_byte instack; /* whether it is in stack */ - lu_byte idx; /* index of upvalue (in stack or in outer function's list) */ -} Upvaldesc; - - -/* -** Description of a local variable for function prototypes -** (used for debug information) -*/ -typedef struct LocVar { - TString *varname; - int startpc; /* first point where variable is active */ - int endpc; /* first point where variable is dead */ -} LocVar; - - -/* -** Function Prototypes -*/ -typedef struct Proto { - CommonHeader; - TValue *k; /* constants used by the function */ - Instruction *code; - struct Proto **p; /* functions defined inside the function */ - int *lineinfo; /* map from opcodes to source lines (debug information) */ - LocVar *locvars; /* information about local variables (debug information) */ - Upvaldesc *upvalues; /* upvalue information */ - union Closure *cache; /* last created closure with this prototype */ - TString *source; /* used for debug information */ - int sizeupvalues; /* size of 'upvalues' */ - int sizek; /* size of `k' */ - int sizecode; - int sizelineinfo; - int sizep; /* size of `p' */ - int sizelocvars; - int linedefined; - int lastlinedefined; - GCObject *gclist; - lu_byte numparams; /* number of fixed parameters */ - lu_byte is_vararg; - lu_byte maxstacksize; /* maximum stack used by this function */ -} Proto; - - - -/* -** Lua Upvalues -*/ -typedef struct UpVal { - CommonHeader; - TValue *v; /* points to stack or to its own value */ - union { - TValue value; /* the value (when closed) */ - struct { /* double linked list (when open) */ - struct UpVal *prev; - struct UpVal *next; - } l; - } u; -} UpVal; - - -/* -** Closures -*/ - -#define ClosureHeader \ - CommonHeader; lu_byte nupvalues; GCObject *gclist - -typedef struct CClosure { - ClosureHeader; - lua_CFunction f; - TValue upvalue[1]; /* list of upvalues */ -} CClosure; - - -typedef struct LClosure { - ClosureHeader; - struct Proto *p; - UpVal *upvals[1]; /* list of upvalues */ -} LClosure; - - -typedef union Closure { - CClosure c; - LClosure l; -} Closure; - - -#define isLfunction(o) ttisLclosure(o) - -#define getproto(o) (clLvalue(o)->p) - - -/* -** Tables -*/ - -typedef union TKey { - struct { - TValuefields; - struct Node *next; /* for chaining */ - } nk; - TValue tvk; -} TKey; - - -typedef struct Node { - TValue i_val; - TKey i_key; -} Node; - - -typedef struct Table { - CommonHeader; - lu_byte flags; /* 1<

lsizenode)) - - -/* -** (address of) a fixed nil value -*/ -#define luaO_nilobject (&luaO_nilobject_) - - -LUAI_DDEC const TValue luaO_nilobject_; - - -LUAI_FUNC int luaO_int2fb (unsigned int x); -LUAI_FUNC int luaO_fb2int (int x); -LUAI_FUNC int luaO_ceillog2 (unsigned int x); -LUAI_FUNC lua_Number luaO_arith (int op, lua_Number v1, lua_Number v2); -LUAI_FUNC int luaO_str2d (const char *s, size_t len, lua_Number *result); -LUAI_FUNC int luaO_hexavalue (int c); -LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt, - va_list argp); -LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...); -LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t len); - - -#endif - diff --git a/ext/lua/include/lopcodes.h b/ext/lua/include/lopcodes.h deleted file mode 100644 index 51f5791545..0000000000 --- a/ext/lua/include/lopcodes.h +++ /dev/null @@ -1,288 +0,0 @@ -/* -** $Id: lopcodes.h,v 1.142.1.1 2013/04/12 18:48:47 roberto Exp $ -** Opcodes for Lua virtual machine -** See Copyright Notice in lua.h -*/ - -#ifndef lopcodes_h -#define lopcodes_h - -#include "llimits.h" - - -/*=========================================================================== - We assume that instructions are unsigned numbers. - All instructions have an opcode in the first 6 bits. - Instructions can have the following fields: - `A' : 8 bits - `B' : 9 bits - `C' : 9 bits - 'Ax' : 26 bits ('A', 'B', and 'C' together) - `Bx' : 18 bits (`B' and `C' together) - `sBx' : signed Bx - - A signed argument is represented in excess K; that is, the number - value is the unsigned value minus K. K is exactly the maximum value - for that argument (so that -max is represented by 0, and +max is - represented by 2*max), which is half the maximum for the corresponding - unsigned argument. -===========================================================================*/ - - -enum OpMode {iABC, iABx, iAsBx, iAx}; /* basic instruction format */ - - -/* -** size and position of opcode arguments. -*/ -#define SIZE_C 9 -#define SIZE_B 9 -#define SIZE_Bx (SIZE_C + SIZE_B) -#define SIZE_A 8 -#define SIZE_Ax (SIZE_C + SIZE_B + SIZE_A) - -#define SIZE_OP 6 - -#define POS_OP 0 -#define POS_A (POS_OP + SIZE_OP) -#define POS_C (POS_A + SIZE_A) -#define POS_B (POS_C + SIZE_C) -#define POS_Bx POS_C -#define POS_Ax POS_A - - -/* -** limits for opcode arguments. -** we use (signed) int to manipulate most arguments, -** so they must fit in LUAI_BITSINT-1 bits (-1 for sign) -*/ -#if SIZE_Bx < LUAI_BITSINT-1 -#define MAXARG_Bx ((1<>1) /* `sBx' is signed */ -#else -#define MAXARG_Bx MAX_INT -#define MAXARG_sBx MAX_INT -#endif - -#if SIZE_Ax < LUAI_BITSINT-1 -#define MAXARG_Ax ((1<>POS_OP) & MASK1(SIZE_OP,0))) -#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \ - ((cast(Instruction, o)<>pos) & MASK1(size,0))) -#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \ - ((cast(Instruction, v)<= R(A) + 1 */ -OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */ -OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */ -OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */ - -OP_TEST,/* A C if not (R(A) <=> C) then pc++ */ -OP_TESTSET,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */ - -OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */ -OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */ -OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */ - -OP_FORLOOP,/* A sBx R(A)+=R(A+2); - if R(A) > 4) & 3)) -#define getCMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 2) & 3)) -#define testAMode(m) (luaP_opmodes[m] & (1 << 6)) -#define testTMode(m) (luaP_opmodes[m] & (1 << 7)) - - -LUAI_DDEC const char *const luaP_opnames[NUM_OPCODES+1]; /* opcode names */ - - -/* number of list items to accumulate before a SETLIST instruction */ -#define LFIELDS_PER_FLUSH 50 - - -#endif diff --git a/ext/lua/include/lparser.h b/ext/lua/include/lparser.h deleted file mode 100644 index 0346e3c41a..0000000000 --- a/ext/lua/include/lparser.h +++ /dev/null @@ -1,119 +0,0 @@ -/* -** $Id: lparser.h,v 1.70.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua Parser -** See Copyright Notice in lua.h -*/ - -#ifndef lparser_h -#define lparser_h - -#include "llimits.h" -#include "lobject.h" -#include "lzio.h" - - -/* -** Expression descriptor -*/ - -typedef enum { - VVOID, /* no value */ - VNIL, - VTRUE, - VFALSE, - VK, /* info = index of constant in `k' */ - VKNUM, /* nval = numerical value */ - VNONRELOC, /* info = result register */ - VLOCAL, /* info = local register */ - VUPVAL, /* info = index of upvalue in 'upvalues' */ - VINDEXED, /* t = table register/upvalue; idx = index R/K */ - VJMP, /* info = instruction pc */ - VRELOCABLE, /* info = instruction pc */ - VCALL, /* info = instruction pc */ - VVARARG /* info = instruction pc */ -} expkind; - - -#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXED) -#define vkisinreg(k) ((k) == VNONRELOC || (k) == VLOCAL) - -typedef struct expdesc { - expkind k; - union { - struct { /* for indexed variables (VINDEXED) */ - short idx; /* index (R/K) */ - lu_byte t; /* table (register or upvalue) */ - lu_byte vt; /* whether 't' is register (VLOCAL) or upvalue (VUPVAL) */ - } ind; - int info; /* for generic use */ - lua_Number nval; /* for VKNUM */ - } u; - int t; /* patch list of `exit when true' */ - int f; /* patch list of `exit when false' */ -} expdesc; - - -/* description of active local variable */ -typedef struct Vardesc { - short idx; /* variable index in stack */ -} Vardesc; - - -/* description of pending goto statements and label statements */ -typedef struct Labeldesc { - TString *name; /* label identifier */ - int pc; /* position in code */ - int line; /* line where it appeared */ - lu_byte nactvar; /* local level where it appears in current block */ -} Labeldesc; - - -/* list of labels or gotos */ -typedef struct Labellist { - Labeldesc *arr; /* array */ - int n; /* number of entries in use */ - int size; /* array size */ -} Labellist; - - -/* dynamic structures used by the parser */ -typedef struct Dyndata { - struct { /* list of active local variables */ - Vardesc *arr; - int n; - int size; - } actvar; - Labellist gt; /* list of pending gotos */ - Labellist label; /* list of active labels */ -} Dyndata; - - -/* control of blocks */ -struct BlockCnt; /* defined in lparser.c */ - - -/* state needed to generate code for a given function */ -typedef struct FuncState { - Proto *f; /* current function header */ - Table *h; /* table to find (and reuse) elements in `k' */ - struct FuncState *prev; /* enclosing function */ - struct LexState *ls; /* lexical state */ - struct BlockCnt *bl; /* chain of current blocks */ - int pc; /* next position to code (equivalent to `ncode') */ - int lasttarget; /* 'label' of last 'jump label' */ - int jpc; /* list of pending jumps to `pc' */ - int nk; /* number of elements in `k' */ - int np; /* number of elements in `p' */ - int firstlocal; /* index of first local var (in Dyndata array) */ - short nlocvars; /* number of elements in 'f->locvars' */ - lu_byte nactvar; /* number of active local variables */ - lu_byte nups; /* number of upvalues */ - lu_byte freereg; /* first free register */ -} FuncState; - - -LUAI_FUNC Closure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, - Dyndata *dyd, const char *name, int firstchar); - - -#endif diff --git a/ext/lua/include/lstate.h b/ext/lua/include/lstate.h deleted file mode 100644 index daffd9aacf..0000000000 --- a/ext/lua/include/lstate.h +++ /dev/null @@ -1,228 +0,0 @@ -/* -** $Id: lstate.h,v 2.82.1.1 2013/04/12 18:48:47 roberto Exp $ -** Global State -** See Copyright Notice in lua.h -*/ - -#ifndef lstate_h -#define lstate_h - -#include "lua.h" - -#include "lobject.h" -#include "ltm.h" -#include "lzio.h" - - -/* - -** Some notes about garbage-collected objects: All objects in Lua must -** be kept somehow accessible until being freed. -** -** Lua keeps most objects linked in list g->allgc. The link uses field -** 'next' of the CommonHeader. -** -** Strings are kept in several lists headed by the array g->strt.hash. -** -** Open upvalues are not subject to independent garbage collection. They -** are collected together with their respective threads. Lua keeps a -** double-linked list with all open upvalues (g->uvhead) so that it can -** mark objects referred by them. (They are always gray, so they must -** be remarked in the atomic step. Usually their contents would be marked -** when traversing the respective threads, but the thread may already be -** dead, while the upvalue is still accessible through closures.) -** -** Objects with finalizers are kept in the list g->finobj. -** -** The list g->tobefnz links all objects being finalized. - -*/ - - -struct lua_longjmp; /* defined in ldo.c */ - - - -/* extra stack space to handle TM calls and some other extras */ -#define EXTRA_STACK 5 - - -#define BASIC_STACK_SIZE (2*LUA_MINSTACK) - - -/* kinds of Garbage Collection */ -#define KGC_NORMAL 0 -#define KGC_EMERGENCY 1 /* gc was forced by an allocation failure */ -#define KGC_GEN 2 /* generational collection */ - - -typedef struct stringtable { - GCObject **hash; - lu_int32 nuse; /* number of elements */ - int size; -} stringtable; - - -/* -** information about a call -*/ -typedef struct CallInfo { - StkId func; /* function index in the stack */ - StkId top; /* top for this function */ - struct CallInfo *previous, *next; /* dynamic call link */ - short nresults; /* expected number of results from this function */ - lu_byte callstatus; - ptrdiff_t extra; - union { - struct { /* only for Lua functions */ - StkId base; /* base for this function */ - const Instruction *savedpc; - } l; - struct { /* only for C functions */ - int ctx; /* context info. in case of yields */ - lua_CFunction k; /* continuation in case of yields */ - ptrdiff_t old_errfunc; - lu_byte old_allowhook; - lu_byte status; - } c; - } u; -} CallInfo; - - -/* -** Bits in CallInfo status -*/ -#define CIST_LUA (1<<0) /* call is running a Lua function */ -#define CIST_HOOKED (1<<1) /* call is running a debug hook */ -#define CIST_REENTRY (1<<2) /* call is running on same invocation of - luaV_execute of previous call */ -#define CIST_YIELDED (1<<3) /* call reentered after suspension */ -#define CIST_YPCALL (1<<4) /* call is a yieldable protected call */ -#define CIST_STAT (1<<5) /* call has an error status (pcall) */ -#define CIST_TAIL (1<<6) /* call was tail called */ -#define CIST_HOOKYIELD (1<<7) /* last hook called yielded */ - - -#define isLua(ci) ((ci)->callstatus & CIST_LUA) - - -/* -** `global state', shared by all threads of this state -*/ -typedef struct global_State { - lua_Alloc frealloc; /* function to reallocate memory */ - void *ud; /* auxiliary data to `frealloc' */ - lu_mem totalbytes; /* number of bytes currently allocated - GCdebt */ - l_mem GCdebt; /* bytes allocated not yet compensated by the collector */ - lu_mem GCmemtrav; /* memory traversed by the GC */ - lu_mem GCestimate; /* an estimate of the non-garbage memory in use */ - stringtable strt; /* hash table for strings */ - TValue l_registry; - unsigned int seed; /* randomized seed for hashes */ - lu_byte currentwhite; - lu_byte gcstate; /* state of garbage collector */ - lu_byte gckind; /* kind of GC running */ - lu_byte gcrunning; /* true if GC is running */ - int sweepstrgc; /* position of sweep in `strt' */ - GCObject *allgc; /* list of all collectable objects */ - GCObject *finobj; /* list of collectable objects with finalizers */ - GCObject **sweepgc; /* current position of sweep in list 'allgc' */ - GCObject **sweepfin; /* current position of sweep in list 'finobj' */ - GCObject *gray; /* list of gray objects */ - GCObject *grayagain; /* list of objects to be traversed atomically */ - GCObject *weak; /* list of tables with weak values */ - GCObject *ephemeron; /* list of ephemeron tables (weak keys) */ - GCObject *allweak; /* list of all-weak tables */ - GCObject *tobefnz; /* list of userdata to be GC */ - UpVal uvhead; /* head of double-linked list of all open upvalues */ - Mbuffer buff; /* temporary buffer for string concatenation */ - int gcpause; /* size of pause between successive GCs */ - int gcmajorinc; /* pause between major collections (only in gen. mode) */ - int gcstepmul; /* GC `granularity' */ - lua_CFunction panic; /* to be called in unprotected errors */ - struct lua_State *mainthread; - const lua_Number *version; /* pointer to version number */ - TString *memerrmsg; /* memory-error message */ - TString *tmname[TM_N]; /* array with tag-method names */ - struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */ -} global_State; - - -/* -** `per thread' state -*/ -struct lua_State { - CommonHeader; - lu_byte status; - StkId top; /* first free slot in the stack */ - global_State *l_G; - CallInfo *ci; /* call info for current function */ - const Instruction *oldpc; /* last pc traced */ - StkId stack_last; /* last free slot in the stack */ - StkId stack; /* stack base */ - int stacksize; - unsigned short nny; /* number of non-yieldable calls in stack */ - unsigned short nCcalls; /* number of nested C calls */ - lu_byte hookmask; - lu_byte allowhook; - int basehookcount; - int hookcount; - lua_Hook hook; - GCObject *openupval; /* list of open upvalues in this stack */ - GCObject *gclist; - struct lua_longjmp *errorJmp; /* current error recover point */ - ptrdiff_t errfunc; /* current error handling function (stack index) */ - CallInfo base_ci; /* CallInfo for first level (C calling Lua) */ -}; - - -#define G(L) (L->l_G) - - -/* -** Union of all collectable objects -*/ -union GCObject { - GCheader gch; /* common header */ - union TString ts; - union Udata u; - union Closure cl; - struct Table h; - struct Proto p; - struct UpVal uv; - struct lua_State th; /* thread */ -}; - - -#define gch(o) (&(o)->gch) - -/* macros to convert a GCObject into a specific value */ -#define rawgco2ts(o) \ - check_exp(novariant((o)->gch.tt) == LUA_TSTRING, &((o)->ts)) -#define gco2ts(o) (&rawgco2ts(o)->tsv) -#define rawgco2u(o) check_exp((o)->gch.tt == LUA_TUSERDATA, &((o)->u)) -#define gco2u(o) (&rawgco2u(o)->uv) -#define gco2lcl(o) check_exp((o)->gch.tt == LUA_TLCL, &((o)->cl.l)) -#define gco2ccl(o) check_exp((o)->gch.tt == LUA_TCCL, &((o)->cl.c)) -#define gco2cl(o) \ - check_exp(novariant((o)->gch.tt) == LUA_TFUNCTION, &((o)->cl)) -#define gco2t(o) check_exp((o)->gch.tt == LUA_TTABLE, &((o)->h)) -#define gco2p(o) check_exp((o)->gch.tt == LUA_TPROTO, &((o)->p)) -#define gco2uv(o) check_exp((o)->gch.tt == LUA_TUPVAL, &((o)->uv)) -#define gco2th(o) check_exp((o)->gch.tt == LUA_TTHREAD, &((o)->th)) - -/* macro to convert any Lua object into a GCObject */ -#define obj2gco(v) (cast(GCObject *, (v))) - - -/* actual number of total bytes allocated */ -#define gettotalbytes(g) ((g)->totalbytes + (g)->GCdebt) - -LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt); -LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1); -LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L); -LUAI_FUNC void luaE_freeCI (lua_State *L); - - -#endif - diff --git a/ext/lua/include/lstring.h b/ext/lua/include/lstring.h deleted file mode 100644 index 260e7f169b..0000000000 --- a/ext/lua/include/lstring.h +++ /dev/null @@ -1,46 +0,0 @@ -/* -** $Id: lstring.h,v 1.49.1.1 2013/04/12 18:48:47 roberto Exp $ -** String table (keep all strings handled by Lua) -** See Copyright Notice in lua.h -*/ - -#ifndef lstring_h -#define lstring_h - -#include "lgc.h" -#include "lobject.h" -#include "lstate.h" - - -#define sizestring(s) (sizeof(union TString)+((s)->len+1)*sizeof(char)) - -#define sizeudata(u) (sizeof(union Udata)+(u)->len) - -#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \ - (sizeof(s)/sizeof(char))-1)) - -#define luaS_fix(s) l_setbit((s)->tsv.marked, FIXEDBIT) - - -/* -** test whether a string is a reserved word -*/ -#define isreserved(s) ((s)->tsv.tt == LUA_TSHRSTR && (s)->tsv.extra > 0) - - -/* -** equality for short strings, which are always internalized -*/ -#define eqshrstr(a,b) check_exp((a)->tsv.tt == LUA_TSHRSTR, (a) == (b)) - - -LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l, unsigned int seed); -LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b); -LUAI_FUNC int luaS_eqstr (TString *a, TString *b); -LUAI_FUNC void luaS_resize (lua_State *L, int newsize); -LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, Table *e); -LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l); -LUAI_FUNC TString *luaS_new (lua_State *L, const char *str); - - -#endif diff --git a/ext/lua/include/ltable.h b/ext/lua/include/ltable.h deleted file mode 100644 index d69449b2b8..0000000000 --- a/ext/lua/include/ltable.h +++ /dev/null @@ -1,45 +0,0 @@ -/* -** $Id: ltable.h,v 2.16.1.2 2013/08/30 15:49:41 roberto Exp $ -** Lua tables (hash) -** See Copyright Notice in lua.h -*/ - -#ifndef ltable_h -#define ltable_h - -#include "lobject.h" - - -#define gnode(t,i) (&(t)->node[i]) -#define gkey(n) (&(n)->i_key.tvk) -#define gval(n) (&(n)->i_val) -#define gnext(n) ((n)->i_key.nk.next) - -#define invalidateTMcache(t) ((t)->flags = 0) - -/* returns the key, given the value of a table entry */ -#define keyfromval(v) \ - (gkey(cast(Node *, cast(char *, (v)) - offsetof(Node, i_val)))) - - -LUAI_FUNC const TValue *luaH_getint (Table *t, int key); -LUAI_FUNC void luaH_setint (lua_State *L, Table *t, int key, TValue *value); -LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key); -LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key); -LUAI_FUNC TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key); -LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key); -LUAI_FUNC Table *luaH_new (lua_State *L); -LUAI_FUNC void luaH_resize (lua_State *L, Table *t, int nasize, int nhsize); -LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, int nasize); -LUAI_FUNC void luaH_free (lua_State *L, Table *t); -LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key); -LUAI_FUNC int luaH_getn (Table *t); - - -#if defined(LUA_DEBUG) -LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key); -LUAI_FUNC int luaH_isdummy (Node *n); -#endif - - -#endif diff --git a/ext/lua/include/ltm.h b/ext/lua/include/ltm.h deleted file mode 100644 index 7f89c841f9..0000000000 --- a/ext/lua/include/ltm.h +++ /dev/null @@ -1,57 +0,0 @@ -/* -** $Id: ltm.h,v 2.11.1.1 2013/04/12 18:48:47 roberto Exp $ -** Tag methods -** See Copyright Notice in lua.h -*/ - -#ifndef ltm_h -#define ltm_h - - -#include "lobject.h" - - -/* -* WARNING: if you change the order of this enumeration, -* grep "ORDER TM" -*/ -typedef enum { - TM_INDEX, - TM_NEWINDEX, - TM_GC, - TM_MODE, - TM_LEN, - TM_EQ, /* last tag method with `fast' access */ - TM_ADD, - TM_SUB, - TM_MUL, - TM_DIV, - TM_MOD, - TM_POW, - TM_UNM, - TM_LT, - TM_LE, - TM_CONCAT, - TM_CALL, - TM_N /* number of elements in the enum */ -} TMS; - - - -#define gfasttm(g,et,e) ((et) == NULL ? NULL : \ - ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e])) - -#define fasttm(l,et,e) gfasttm(G(l), et, e) - -#define ttypename(x) luaT_typenames_[(x) + 1] -#define objtypename(x) ttypename(ttypenv(x)) - -LUAI_DDEC const char *const luaT_typenames_[LUA_TOTALTAGS]; - - -LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename); -LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, - TMS event); -LUAI_FUNC void luaT_init (lua_State *L); - -#endif diff --git a/ext/lua/include/lua.h b/ext/lua/include/lua.h deleted file mode 100644 index 149a2c37bc..0000000000 --- a/ext/lua/include/lua.h +++ /dev/null @@ -1,444 +0,0 @@ -/* -** $Id: lua.h,v 1.285.1.2 2013/11/11 12:09:16 roberto Exp $ -** Lua - A Scripting Language -** Lua.org, PUC-Rio, Brazil (http://www.lua.org) -** See Copyright Notice at the end of this file -*/ - - -#ifndef lua_h -#define lua_h - -#include -#include - - -#include "luaconf.h" - - -#define LUA_VERSION_MAJOR "5" -#define LUA_VERSION_MINOR "2" -#define LUA_VERSION_NUM 502 -#define LUA_VERSION_RELEASE "3" - -#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR -#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE -#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2013 Lua.org, PUC-Rio" -#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes" - - -/* mark for precompiled code ('Lua') */ -#define LUA_SIGNATURE "\033Lua" - -/* option for multiple returns in 'lua_pcall' and 'lua_call' */ -#define LUA_MULTRET (-1) - - -/* -** pseudo-indices -*/ -#define LUA_REGISTRYINDEX LUAI_FIRSTPSEUDOIDX -#define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i)) - - -/* thread status */ -#define LUA_OK 0 -#define LUA_YIELD 1 -#define LUA_ERRRUN 2 -#define LUA_ERRSYNTAX 3 -#define LUA_ERRMEM 4 -#define LUA_ERRGCMM 5 -#define LUA_ERRERR 6 - - -typedef struct lua_State lua_State; - -typedef int (*lua_CFunction) (lua_State *L); - - -/* -** functions that read/write blocks when loading/dumping Lua chunks -*/ -typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz); - -typedef int (*lua_Writer) (lua_State *L, const void* p, size_t sz, void* ud); - - -/* -** prototype for memory-allocation functions -*/ -typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize); - - -/* -** basic types -*/ -#define LUA_TNONE (-1) - -#define LUA_TNIL 0 -#define LUA_TBOOLEAN 1 -#define LUA_TLIGHTUSERDATA 2 -#define LUA_TNUMBER 3 -#define LUA_TSTRING 4 -#define LUA_TTABLE 5 -#define LUA_TFUNCTION 6 -#define LUA_TUSERDATA 7 -#define LUA_TTHREAD 8 - -#define LUA_NUMTAGS 9 - - - -/* minimum Lua stack available to a C function */ -#define LUA_MINSTACK 20 - - -/* predefined values in the registry */ -#define LUA_RIDX_MAINTHREAD 1 -#define LUA_RIDX_GLOBALS 2 -#define LUA_RIDX_LAST LUA_RIDX_GLOBALS - - -/* type of numbers in Lua */ -typedef LUA_NUMBER lua_Number; - - -/* type for integer functions */ -typedef LUA_INTEGER lua_Integer; - -/* unsigned integer type */ -typedef LUA_UNSIGNED lua_Unsigned; - - - -/* -** generic extra include file -*/ -#if defined(LUA_USER_H) -#include LUA_USER_H -#endif - - -/* -** RCS ident string -*/ -extern const char lua_ident[]; - - -/* -** state manipulation -*/ -LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud); -LUA_API void (lua_close) (lua_State *L); -LUA_API lua_State *(lua_newthread) (lua_State *L); - -LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf); - - -LUA_API const lua_Number *(lua_version) (lua_State *L); - - -/* -** basic stack manipulation -*/ -LUA_API int (lua_absindex) (lua_State *L, int idx); -LUA_API int (lua_gettop) (lua_State *L); -LUA_API void (lua_settop) (lua_State *L, int idx); -LUA_API void (lua_pushvalue) (lua_State *L, int idx); -LUA_API void (lua_remove) (lua_State *L, int idx); -LUA_API void (lua_insert) (lua_State *L, int idx); -LUA_API void (lua_replace) (lua_State *L, int idx); -LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx); -LUA_API int (lua_checkstack) (lua_State *L, int sz); - -LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n); - - -/* -** access functions (stack -> C) -*/ - -LUA_API int (lua_isnumber) (lua_State *L, int idx); -LUA_API int (lua_isstring) (lua_State *L, int idx); -LUA_API int (lua_iscfunction) (lua_State *L, int idx); -LUA_API int (lua_isuserdata) (lua_State *L, int idx); -LUA_API int (lua_type) (lua_State *L, int idx); -LUA_API const char *(lua_typename) (lua_State *L, int tp); - -LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum); -LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum); -LUA_API lua_Unsigned (lua_tounsignedx) (lua_State *L, int idx, int *isnum); -LUA_API int (lua_toboolean) (lua_State *L, int idx); -LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len); -LUA_API size_t (lua_rawlen) (lua_State *L, int idx); -LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx); -LUA_API void *(lua_touserdata) (lua_State *L, int idx); -LUA_API lua_State *(lua_tothread) (lua_State *L, int idx); -LUA_API const void *(lua_topointer) (lua_State *L, int idx); - - -/* -** Comparison and arithmetic functions -*/ - -#define LUA_OPADD 0 /* ORDER TM */ -#define LUA_OPSUB 1 -#define LUA_OPMUL 2 -#define LUA_OPDIV 3 -#define LUA_OPMOD 4 -#define LUA_OPPOW 5 -#define LUA_OPUNM 6 - -LUA_API void (lua_arith) (lua_State *L, int op); - -#define LUA_OPEQ 0 -#define LUA_OPLT 1 -#define LUA_OPLE 2 - -LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2); -LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op); - - -/* -** push functions (C -> stack) -*/ -LUA_API void (lua_pushnil) (lua_State *L); -LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n); -LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n); -LUA_API void (lua_pushunsigned) (lua_State *L, lua_Unsigned n); -LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t l); -LUA_API const char *(lua_pushstring) (lua_State *L, const char *s); -LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt, - va_list argp); -LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...); -LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n); -LUA_API void (lua_pushboolean) (lua_State *L, int b); -LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p); -LUA_API int (lua_pushthread) (lua_State *L); - - -/* -** get functions (Lua -> stack) -*/ -LUA_API void (lua_getglobal) (lua_State *L, const char *var); -LUA_API void (lua_gettable) (lua_State *L, int idx); -LUA_API void (lua_getfield) (lua_State *L, int idx, const char *k); -LUA_API void (lua_rawget) (lua_State *L, int idx); -LUA_API void (lua_rawgeti) (lua_State *L, int idx, int n); -LUA_API void (lua_rawgetp) (lua_State *L, int idx, const void *p); -LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec); -LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz); -LUA_API int (lua_getmetatable) (lua_State *L, int objindex); -LUA_API void (lua_getuservalue) (lua_State *L, int idx); - - -/* -** set functions (stack -> Lua) -*/ -LUA_API void (lua_setglobal) (lua_State *L, const char *var); -LUA_API void (lua_settable) (lua_State *L, int idx); -LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k); -LUA_API void (lua_rawset) (lua_State *L, int idx); -LUA_API void (lua_rawseti) (lua_State *L, int idx, int n); -LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p); -LUA_API int (lua_setmetatable) (lua_State *L, int objindex); -LUA_API void (lua_setuservalue) (lua_State *L, int idx); - - -/* -** 'load' and 'call' functions (load and run Lua code) -*/ -LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults, int ctx, - lua_CFunction k); -#define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL) - -LUA_API int (lua_getctx) (lua_State *L, int *ctx); - -LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc, - int ctx, lua_CFunction k); -#define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL) - -LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt, - const char *chunkname, - const char *mode); - -LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data); - - -/* -** coroutine functions -*/ -LUA_API int (lua_yieldk) (lua_State *L, int nresults, int ctx, - lua_CFunction k); -#define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL) -LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg); -LUA_API int (lua_status) (lua_State *L); - -/* -** garbage-collection function and options -*/ - -#define LUA_GCSTOP 0 -#define LUA_GCRESTART 1 -#define LUA_GCCOLLECT 2 -#define LUA_GCCOUNT 3 -#define LUA_GCCOUNTB 4 -#define LUA_GCSTEP 5 -#define LUA_GCSETPAUSE 6 -#define LUA_GCSETSTEPMUL 7 -#define LUA_GCSETMAJORINC 8 -#define LUA_GCISRUNNING 9 -#define LUA_GCGEN 10 -#define LUA_GCINC 11 - -LUA_API int (lua_gc) (lua_State *L, int what, int data); - - -/* -** miscellaneous functions -*/ - -LUA_API int (lua_error) (lua_State *L); - -LUA_API int (lua_next) (lua_State *L, int idx); - -LUA_API void (lua_concat) (lua_State *L, int n); -LUA_API void (lua_len) (lua_State *L, int idx); - -LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud); -LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud); - - - -/* -** =============================================================== -** some useful macros -** =============================================================== -*/ - -#define lua_tonumber(L,i) lua_tonumberx(L,i,NULL) -#define lua_tointeger(L,i) lua_tointegerx(L,i,NULL) -#define lua_tounsigned(L,i) lua_tounsignedx(L,i,NULL) - -#define lua_pop(L,n) lua_settop(L, -(n)-1) - -#define lua_newtable(L) lua_createtable(L, 0, 0) - -#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n))) - -#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0) - -#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION) -#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE) -#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA) -#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL) -#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN) -#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD) -#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE) -#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0) - -#define lua_pushliteral(L, s) \ - lua_pushlstring(L, "" s, (sizeof(s)/sizeof(char))-1) - -#define lua_pushglobaltable(L) \ - lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS) - -#define lua_tostring(L,i) lua_tolstring(L, (i), NULL) - - - -/* -** {====================================================================== -** Debug API -** ======================================================================= -*/ - - -/* -** Event codes -*/ -#define LUA_HOOKCALL 0 -#define LUA_HOOKRET 1 -#define LUA_HOOKLINE 2 -#define LUA_HOOKCOUNT 3 -#define LUA_HOOKTAILCALL 4 - - -/* -** Event masks -*/ -#define LUA_MASKCALL (1 << LUA_HOOKCALL) -#define LUA_MASKRET (1 << LUA_HOOKRET) -#define LUA_MASKLINE (1 << LUA_HOOKLINE) -#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT) - -typedef struct lua_Debug lua_Debug; /* activation record */ - - -/* Functions to be called by the debugger in specific events */ -typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar); - - -LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar); -LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar); -LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n); -LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n); -LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n); -LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n); - -LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n); -LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1, - int fidx2, int n2); - -LUA_API int (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count); -LUA_API lua_Hook (lua_gethook) (lua_State *L); -LUA_API int (lua_gethookmask) (lua_State *L); -LUA_API int (lua_gethookcount) (lua_State *L); - - -struct lua_Debug { - int event; - const char *name; /* (n) */ - const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */ - const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */ - const char *source; /* (S) */ - int currentline; /* (l) */ - int linedefined; /* (S) */ - int lastlinedefined; /* (S) */ - unsigned char nups; /* (u) number of upvalues */ - unsigned char nparams;/* (u) number of parameters */ - char isvararg; /* (u) */ - char istailcall; /* (t) */ - char short_src[LUA_IDSIZE]; /* (S) */ - /* private part */ - struct CallInfo *i_ci; /* active function */ -}; - -/* }====================================================================== */ - - -/****************************************************************************** -* Copyright (C) 1994-2013 Lua.org, PUC-Rio. -* -* Permission is hereby granted, free of charge, to any person obtaining -* a copy of this software and associated documentation files (the -* "Software"), to deal in the Software without restriction, including -* without limitation the rights to use, copy, modify, merge, publish, -* distribute, sublicense, and/or sell copies of the Software, and to -* permit persons to whom the Software is furnished to do so, subject to -* the following conditions: -* -* The above copyright notice and this permission notice shall be -* included in all copies or substantial portions of the Software. -* -* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -******************************************************************************/ - - -#endif diff --git a/ext/lua/include/lua.hpp b/ext/lua/include/lua.hpp deleted file mode 100644 index ec417f5946..0000000000 --- a/ext/lua/include/lua.hpp +++ /dev/null @@ -1,9 +0,0 @@ -// lua.hpp -// Lua header files for C++ -// <> not supplied automatically because Lua also compiles as C++ - -extern "C" { -#include "lua.h" -#include "lualib.h" -#include "lauxlib.h" -} diff --git a/ext/lua/include/luaconf.h b/ext/lua/include/luaconf.h deleted file mode 100644 index 18be9a9e43..0000000000 --- a/ext/lua/include/luaconf.h +++ /dev/null @@ -1,551 +0,0 @@ -/* -** $Id: luaconf.h,v 1.176.1.1 2013/04/12 18:48:47 roberto Exp $ -** Configuration file for Lua -** See Copyright Notice in lua.h -*/ - - -#ifndef lconfig_h -#define lconfig_h - -#include -#include - - -/* -** ================================================================== -** Search for "@@" to find all configurable definitions. -** =================================================================== -*/ - - -/* -@@ LUA_ANSI controls the use of non-ansi features. -** CHANGE it (define it) if you want Lua to avoid the use of any -** non-ansi feature or library. -*/ -#if !defined(LUA_ANSI) && defined(__STRICT_ANSI__) -#define LUA_ANSI -#endif - - -#if !defined(LUA_ANSI) && defined(_WIN32) && !defined(_WIN32_WCE) -#define LUA_WIN /* enable goodies for regular Windows platforms */ -#endif - -#if defined(LUA_WIN) -#define LUA_DL_DLL -#define LUA_USE_AFORMAT /* assume 'printf' handles 'aA' specifiers */ -#endif - - - -#if defined(LUA_USE_LINUX) -#define LUA_USE_POSIX -#define LUA_USE_DLOPEN /* needs an extra library: -ldl */ -#define LUA_USE_READLINE /* needs some extra libraries */ -#define LUA_USE_STRTODHEX /* assume 'strtod' handles hex formats */ -#define LUA_USE_AFORMAT /* assume 'printf' handles 'aA' specifiers */ -#define LUA_USE_LONGLONG /* assume support for long long */ -#endif - -#if defined(LUA_USE_MACOSX) -#define LUA_USE_POSIX -#define LUA_USE_DLOPEN /* does not need -ldl */ -#define LUA_USE_READLINE /* needs an extra library: -lreadline */ -#define LUA_USE_STRTODHEX /* assume 'strtod' handles hex formats */ -#define LUA_USE_AFORMAT /* assume 'printf' handles 'aA' specifiers */ -#define LUA_USE_LONGLONG /* assume support for long long */ -#endif - - - -/* -@@ LUA_USE_POSIX includes all functionality listed as X/Open System -@* Interfaces Extension (XSI). -** CHANGE it (define it) if your system is XSI compatible. -*/ -#if defined(LUA_USE_POSIX) -#define LUA_USE_MKSTEMP -#define LUA_USE_ISATTY -#define LUA_USE_POPEN -#define LUA_USE_ULONGJMP -#define LUA_USE_GMTIME_R -#endif - - - -/* -@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for -@* Lua libraries. -@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for -@* C libraries. -** CHANGE them if your machine has a non-conventional directory -** hierarchy or if you want to install your libraries in -** non-conventional directories. -*/ -#if defined(_WIN32) /* { */ -/* -** In Windows, any exclamation mark ('!') in the path is replaced by the -** path of the directory of the executable file of the current process. -*/ -#define LUA_LDIR "!\\lua\\" -#define LUA_CDIR "!\\" -#define LUA_PATH_DEFAULT \ - LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \ - LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" ".\\?.lua" -#define LUA_CPATH_DEFAULT \ - LUA_CDIR"?.dll;" LUA_CDIR"loadall.dll;" ".\\?.dll" - -#else /* }{ */ - -#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR "/" -#define LUA_ROOT "/usr/local/" -#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR -#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR -#define LUA_PATH_DEFAULT \ - LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \ - LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" "./?.lua" -#define LUA_CPATH_DEFAULT \ - LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so" -#endif /* } */ - - -/* -@@ LUA_DIRSEP is the directory separator (for submodules). -** CHANGE it if your machine does not use "/" as the directory separator -** and is not Windows. (On Windows Lua automatically uses "\".) -*/ -#if defined(_WIN32) -#define LUA_DIRSEP "\\" -#else -#define LUA_DIRSEP "/" -#endif - - -/* -@@ LUA_ENV is the name of the variable that holds the current -@@ environment, used to access global names. -** CHANGE it if you do not like this name. -*/ -#define LUA_ENV "_ENV" - - -/* -@@ LUA_API is a mark for all core API functions. -@@ LUALIB_API is a mark for all auxiliary library functions. -@@ LUAMOD_API is a mark for all standard library opening functions. -** CHANGE them if you need to define those functions in some special way. -** For instance, if you want to create one Windows DLL with the core and -** the libraries, you may want to use the following definition (define -** LUA_BUILD_AS_DLL to get it). -*/ -#if defined(LUA_BUILD_AS_DLL) /* { */ - -#if defined(LUA_CORE) || defined(LUA_LIB) /* { */ -#define LUA_API __declspec(dllexport) -#else /* }{ */ -#define LUA_API __declspec(dllimport) -#endif /* } */ - -#else /* }{ */ - -#define LUA_API extern - -#endif /* } */ - - -/* more often than not the libs go together with the core */ -#define LUALIB_API LUA_API -#define LUAMOD_API LUALIB_API - - -/* -@@ LUAI_FUNC is a mark for all extern functions that are not to be -@* exported to outside modules. -@@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables -@* that are not to be exported to outside modules (LUAI_DDEF for -@* definitions and LUAI_DDEC for declarations). -** CHANGE them if you need to mark them in some special way. Elf/gcc -** (versions 3.2 and later) mark them as "hidden" to optimize access -** when Lua is compiled as a shared library. Not all elf targets support -** this attribute. Unfortunately, gcc does not offer a way to check -** whether the target offers that support, and those without support -** give a warning about it. To avoid these warnings, change to the -** default definition. -*/ -#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \ - defined(__ELF__) /* { */ -#define LUAI_FUNC __attribute__((visibility("hidden"))) extern -#define LUAI_DDEC LUAI_FUNC -#define LUAI_DDEF /* empty */ - -#else /* }{ */ -#define LUAI_FUNC extern -#define LUAI_DDEC extern -#define LUAI_DDEF /* empty */ -#endif /* } */ - - - -/* -@@ LUA_QL describes how error messages quote program elements. -** CHANGE it if you want a different appearance. -*/ -#define LUA_QL(x) "'" x "'" -#define LUA_QS LUA_QL("%s") - - -/* -@@ LUA_IDSIZE gives the maximum size for the description of the source -@* of a function in debug information. -** CHANGE it if you want a different size. -*/ -#define LUA_IDSIZE 60 - - -/* -@@ luai_writestring/luai_writeline define how 'print' prints its results. -** They are only used in libraries and the stand-alone program. (The #if -** avoids including 'stdio.h' everywhere.) -*/ -#if defined(LUA_LIB) || defined(lua_c) -#include -#define luai_writestring(s,l) fwrite((s), sizeof(char), (l), stdout) -#define luai_writeline() (luai_writestring("\n", 1), fflush(stdout)) -#endif - -/* -@@ luai_writestringerror defines how to print error messages. -** (A format string with one argument is enough for Lua...) -*/ -#define luai_writestringerror(s,p) \ - (fprintf(stderr, (s), (p)), fflush(stderr)) - - -/* -@@ LUAI_MAXSHORTLEN is the maximum length for short strings, that is, -** strings that are internalized. (Cannot be smaller than reserved words -** or tags for metamethods, as these strings must be internalized; -** #("function") = 8, #("__newindex") = 10.) -*/ -#define LUAI_MAXSHORTLEN 40 - - - -/* -** {================================================================== -** Compatibility with previous versions -** =================================================================== -*/ - -/* -@@ LUA_COMPAT_ALL controls all compatibility options. -** You can define it to get all options, or change specific options -** to fit your specific needs. -*/ -#if defined(LUA_COMPAT_ALL) /* { */ - -/* -@@ LUA_COMPAT_UNPACK controls the presence of global 'unpack'. -** You can replace it with 'table.unpack'. -*/ -#define LUA_COMPAT_UNPACK - -/* -@@ LUA_COMPAT_LOADERS controls the presence of table 'package.loaders'. -** You can replace it with 'package.searchers'. -*/ -#define LUA_COMPAT_LOADERS - -/* -@@ macro 'lua_cpcall' emulates deprecated function lua_cpcall. -** You can call your C function directly (with light C functions). -*/ -#define lua_cpcall(L,f,u) \ - (lua_pushcfunction(L, (f)), \ - lua_pushlightuserdata(L,(u)), \ - lua_pcall(L,1,0,0)) - - -/* -@@ LUA_COMPAT_LOG10 defines the function 'log10' in the math library. -** You can rewrite 'log10(x)' as 'log(x, 10)'. -*/ -#define LUA_COMPAT_LOG10 - -/* -@@ LUA_COMPAT_LOADSTRING defines the function 'loadstring' in the base -** library. You can rewrite 'loadstring(s)' as 'load(s)'. -*/ -#define LUA_COMPAT_LOADSTRING - -/* -@@ LUA_COMPAT_MAXN defines the function 'maxn' in the table library. -*/ -#define LUA_COMPAT_MAXN - -/* -@@ The following macros supply trivial compatibility for some -** changes in the API. The macros themselves document how to -** change your code to avoid using them. -*/ -#define lua_strlen(L,i) lua_rawlen(L, (i)) - -#define lua_objlen(L,i) lua_rawlen(L, (i)) - -#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ) -#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT) - -/* -@@ LUA_COMPAT_MODULE controls compatibility with previous -** module functions 'module' (Lua) and 'luaL_register' (C). -*/ -#define LUA_COMPAT_MODULE - -#endif /* } */ - -/* }================================================================== */ - - - -/* -@@ LUAI_BITSINT defines the number of bits in an int. -** CHANGE here if Lua cannot automatically detect the number of bits of -** your machine. Probably you do not need to change this. -*/ -/* avoid overflows in comparison */ -#if INT_MAX-20 < 32760 /* { */ -#define LUAI_BITSINT 16 -#elif INT_MAX > 2147483640L /* }{ */ -/* int has at least 32 bits */ -#define LUAI_BITSINT 32 -#else /* }{ */ -#error "you must define LUA_BITSINT with number of bits in an integer" -#endif /* } */ - - -/* -@@ LUA_INT32 is an signed integer with exactly 32 bits. -@@ LUAI_UMEM is an unsigned integer big enough to count the total -@* memory used by Lua. -@@ LUAI_MEM is a signed integer big enough to count the total memory -@* used by Lua. -** CHANGE here if for some weird reason the default definitions are not -** good enough for your machine. Probably you do not need to change -** this. -*/ -#if LUAI_BITSINT >= 32 /* { */ -#define LUA_INT32 int -#define LUAI_UMEM size_t -#define LUAI_MEM ptrdiff_t -#else /* }{ */ -/* 16-bit ints */ -#define LUA_INT32 long -#define LUAI_UMEM unsigned long -#define LUAI_MEM long -#endif /* } */ - - -/* -@@ LUAI_MAXSTACK limits the size of the Lua stack. -** CHANGE it if you need a different limit. This limit is arbitrary; -** its only purpose is to stop Lua to consume unlimited stack -** space (and to reserve some numbers for pseudo-indices). -*/ -#if LUAI_BITSINT >= 32 -#define LUAI_MAXSTACK 1000000 -#else -#define LUAI_MAXSTACK 15000 -#endif - -/* reserve some space for error handling */ -#define LUAI_FIRSTPSEUDOIDX (-LUAI_MAXSTACK - 1000) - - - - -/* -@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system. -** CHANGE it if it uses too much C-stack space. -*/ -#define LUAL_BUFFERSIZE BUFSIZ - - - - -/* -** {================================================================== -@@ LUA_NUMBER is the type of numbers in Lua. -** CHANGE the following definitions only if you want to build Lua -** with a number type different from double. You may also need to -** change lua_number2int & lua_number2integer. -** =================================================================== -*/ - -#define LUA_NUMBER_DOUBLE -#define LUA_NUMBER double - -/* -@@ LUAI_UACNUMBER is the result of an 'usual argument conversion' -@* over a number. -*/ -#define LUAI_UACNUMBER double - - -/* -@@ LUA_NUMBER_SCAN is the format for reading numbers. -@@ LUA_NUMBER_FMT is the format for writing numbers. -@@ lua_number2str converts a number to a string. -@@ LUAI_MAXNUMBER2STR is maximum size of previous conversion. -*/ -#define LUA_NUMBER_SCAN "%lf" -#define LUA_NUMBER_FMT "%.14g" -#define lua_number2str(s,n) sprintf((s), LUA_NUMBER_FMT, (n)) -#define LUAI_MAXNUMBER2STR 32 /* 16 digits, sign, point, and \0 */ - - -/* -@@ l_mathop allows the addition of an 'l' or 'f' to all math operations -*/ -#define l_mathop(x) (x) - - -/* -@@ lua_str2number converts a decimal numeric string to a number. -@@ lua_strx2number converts an hexadecimal numeric string to a number. -** In C99, 'strtod' does both conversions. C89, however, has no function -** to convert floating hexadecimal strings to numbers. For these -** systems, you can leave 'lua_strx2number' undefined and Lua will -** provide its own implementation. -*/ -#define lua_str2number(s,p) strtod((s), (p)) - -#if defined(LUA_USE_STRTODHEX) -#define lua_strx2number(s,p) strtod((s), (p)) -#endif - - -/* -@@ The luai_num* macros define the primitive operations over numbers. -*/ - -/* the following operations need the math library */ -#if defined(lobject_c) || defined(lvm_c) -#include -#define luai_nummod(L,a,b) ((a) - l_mathop(floor)((a)/(b))*(b)) -#define luai_numpow(L,a,b) (l_mathop(pow)(a,b)) -#endif - -/* these are quite standard operations */ -#if defined(LUA_CORE) -#define luai_numadd(L,a,b) ((a)+(b)) -#define luai_numsub(L,a,b) ((a)-(b)) -#define luai_nummul(L,a,b) ((a)*(b)) -#define luai_numdiv(L,a,b) ((a)/(b)) -#define luai_numunm(L,a) (-(a)) -#define luai_numeq(a,b) ((a)==(b)) -#define luai_numlt(L,a,b) ((a)<(b)) -#define luai_numle(L,a,b) ((a)<=(b)) -#define luai_numisnan(L,a) (!luai_numeq((a), (a))) -#endif - - - -/* -@@ LUA_INTEGER is the integral type used by lua_pushinteger/lua_tointeger. -** CHANGE that if ptrdiff_t is not adequate on your machine. (On most -** machines, ptrdiff_t gives a good choice between int or long.) -*/ -#define LUA_INTEGER ptrdiff_t - -/* -@@ LUA_UNSIGNED is the integral type used by lua_pushunsigned/lua_tounsigned. -** It must have at least 32 bits. -*/ -#define LUA_UNSIGNED unsigned LUA_INT32 - - - -/* -** Some tricks with doubles -*/ - -#if defined(LUA_NUMBER_DOUBLE) && !defined(LUA_ANSI) /* { */ -/* -** The next definitions activate some tricks to speed up the -** conversion from doubles to integer types, mainly to LUA_UNSIGNED. -** -@@ LUA_MSASMTRICK uses Microsoft assembler to avoid clashes with a -** DirectX idiosyncrasy. -** -@@ LUA_IEEE754TRICK uses a trick that should work on any machine -** using IEEE754 with a 32-bit integer type. -** -@@ LUA_IEEELL extends the trick to LUA_INTEGER; should only be -** defined when LUA_INTEGER is a 32-bit integer. -** -@@ LUA_IEEEENDIAN is the endianness of doubles in your machine -** (0 for little endian, 1 for big endian); if not defined, Lua will -** check it dynamically for LUA_IEEE754TRICK (but not for LUA_NANTRICK). -** -@@ LUA_NANTRICK controls the use of a trick to pack all types into -** a single double value, using NaN values to represent non-number -** values. The trick only works on 32-bit machines (ints and pointers -** are 32-bit values) with numbers represented as IEEE 754-2008 doubles -** with conventional endianess (12345678 or 87654321), in CPUs that do -** not produce signaling NaN values (all NaNs are quiet). -*/ - -/* Microsoft compiler on a Pentium (32 bit) ? */ -#if defined(LUA_WIN) && defined(_MSC_VER) && defined(_M_IX86) /* { */ - -#define LUA_MSASMTRICK -#define LUA_IEEEENDIAN 0 -#define LUA_NANTRICK - - -/* pentium 32 bits? */ -#elif defined(__i386__) || defined(__i386) || defined(__X86__) /* }{ */ - -#define LUA_IEEE754TRICK -#define LUA_IEEELL -#define LUA_IEEEENDIAN 0 -#define LUA_NANTRICK - -/* pentium 64 bits? */ -#elif defined(__x86_64) /* }{ */ - -#define LUA_IEEE754TRICK -#define LUA_IEEEENDIAN 0 - -#elif defined(__POWERPC__) || defined(__ppc__) /* }{ */ - -#define LUA_IEEE754TRICK -#define LUA_IEEEENDIAN 1 - -#else /* }{ */ - -/* assume IEEE754 and a 32-bit integer type */ -#define LUA_IEEE754TRICK - -#endif /* } */ - -#endif /* } */ - -/* }================================================================== */ - - - - -/* =================================================================== */ - -/* -** Local configuration. You can use this space to add your redefinitions -** without modifying the main part of the file. -*/ - - - -#endif - diff --git a/ext/lua/include/lualib.h b/ext/lua/include/lualib.h deleted file mode 100644 index da82005c9d..0000000000 --- a/ext/lua/include/lualib.h +++ /dev/null @@ -1,55 +0,0 @@ -/* -** $Id: lualib.h,v 1.43.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua standard libraries -** See Copyright Notice in lua.h -*/ - - -#ifndef lualib_h -#define lualib_h - -#include "lua.h" - - - -LUAMOD_API int (luaopen_base) (lua_State *L); - -#define LUA_COLIBNAME "coroutine" -LUAMOD_API int (luaopen_coroutine) (lua_State *L); - -#define LUA_TABLIBNAME "table" -LUAMOD_API int (luaopen_table) (lua_State *L); - -#define LUA_IOLIBNAME "io" -LUAMOD_API int (luaopen_io) (lua_State *L); - -#define LUA_OSLIBNAME "os" -LUAMOD_API int (luaopen_os) (lua_State *L); - -#define LUA_STRLIBNAME "string" -LUAMOD_API int (luaopen_string) (lua_State *L); - -#define LUA_BITLIBNAME "bit32" -LUAMOD_API int (luaopen_bit32) (lua_State *L); - -#define LUA_MATHLIBNAME "math" -LUAMOD_API int (luaopen_math) (lua_State *L); - -#define LUA_DBLIBNAME "debug" -LUAMOD_API int (luaopen_debug) (lua_State *L); - -#define LUA_LOADLIBNAME "package" -LUAMOD_API int (luaopen_package) (lua_State *L); - - -/* open all previous libraries */ -LUALIB_API void (luaL_openlibs) (lua_State *L); - - - -#if !defined(lua_assert) -#define lua_assert(x) ((void)0) -#endif - - -#endif diff --git a/ext/lua/include/lundump.h b/ext/lua/include/lundump.h deleted file mode 100644 index 5255db259d..0000000000 --- a/ext/lua/include/lundump.h +++ /dev/null @@ -1,28 +0,0 @@ -/* -** $Id: lundump.h,v 1.39.1.1 2013/04/12 18:48:47 roberto Exp $ -** load precompiled Lua chunks -** See Copyright Notice in lua.h -*/ - -#ifndef lundump_h -#define lundump_h - -#include "lobject.h" -#include "lzio.h" - -/* load one chunk; from lundump.c */ -LUAI_FUNC Closure* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff, const char* name); - -/* make header; from lundump.c */ -LUAI_FUNC void luaU_header (lu_byte* h); - -/* dump one chunk; from ldump.c */ -LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip); - -/* data to catch conversion errors */ -#define LUAC_TAIL "\x19\x93\r\n\x1a\n" - -/* size in bytes of header of binary files */ -#define LUAC_HEADERSIZE (sizeof(LUA_SIGNATURE)-sizeof(char)+2+6+sizeof(LUAC_TAIL)-sizeof(char)) - -#endif diff --git a/ext/lua/include/lvm.h b/ext/lua/include/lvm.h deleted file mode 100644 index 5380270da6..0000000000 --- a/ext/lua/include/lvm.h +++ /dev/null @@ -1,44 +0,0 @@ -/* -** $Id: lvm.h,v 2.18.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua virtual machine -** See Copyright Notice in lua.h -*/ - -#ifndef lvm_h -#define lvm_h - - -#include "ldo.h" -#include "lobject.h" -#include "ltm.h" - - -#define tostring(L,o) (ttisstring(o) || (luaV_tostring(L, o))) - -#define tonumber(o,n) (ttisnumber(o) || (((o) = luaV_tonumber(o,n)) != NULL)) - -#define equalobj(L,o1,o2) (ttisequal(o1, o2) && luaV_equalobj_(L, o1, o2)) - -#define luaV_rawequalobj(o1,o2) equalobj(NULL,o1,o2) - - -/* not to called directly */ -LUAI_FUNC int luaV_equalobj_ (lua_State *L, const TValue *t1, const TValue *t2); - - -LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r); -LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r); -LUAI_FUNC const TValue *luaV_tonumber (const TValue *obj, TValue *n); -LUAI_FUNC int luaV_tostring (lua_State *L, StkId obj); -LUAI_FUNC void luaV_gettable (lua_State *L, const TValue *t, TValue *key, - StkId val); -LUAI_FUNC void luaV_settable (lua_State *L, const TValue *t, TValue *key, - StkId val); -LUAI_FUNC void luaV_finishOp (lua_State *L); -LUAI_FUNC void luaV_execute (lua_State *L); -LUAI_FUNC void luaV_concat (lua_State *L, int total); -LUAI_FUNC void luaV_arith (lua_State *L, StkId ra, const TValue *rb, - const TValue *rc, TMS op); -LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb); - -#endif diff --git a/ext/lua/include/lzio.h b/ext/lua/include/lzio.h deleted file mode 100644 index 441f7479cb..0000000000 --- a/ext/lua/include/lzio.h +++ /dev/null @@ -1,65 +0,0 @@ -/* -** $Id: lzio.h,v 1.26.1.1 2013/04/12 18:48:47 roberto Exp $ -** Buffered streams -** See Copyright Notice in lua.h -*/ - - -#ifndef lzio_h -#define lzio_h - -#include "lua.h" - -#include "lmem.h" - - -#define EOZ (-1) /* end of stream */ - -typedef struct Zio ZIO; - -#define zgetc(z) (((z)->n--)>0 ? cast_uchar(*(z)->p++) : luaZ_fill(z)) - - -typedef struct Mbuffer { - char *buffer; - size_t n; - size_t buffsize; -} Mbuffer; - -#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0) - -#define luaZ_buffer(buff) ((buff)->buffer) -#define luaZ_sizebuffer(buff) ((buff)->buffsize) -#define luaZ_bufflen(buff) ((buff)->n) - -#define luaZ_resetbuffer(buff) ((buff)->n = 0) - - -#define luaZ_resizebuffer(L, buff, size) \ - (luaM_reallocvector(L, (buff)->buffer, (buff)->buffsize, size, char), \ - (buff)->buffsize = size) - -#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0) - - -LUAI_FUNC char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n); -LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, - void *data); -LUAI_FUNC size_t luaZ_read (ZIO* z, void* b, size_t n); /* read next n bytes */ - - - -/* --------- Private Part ------------------ */ - -struct Zio { - size_t n; /* bytes still unread */ - const char *p; /* current position in buffer */ - lua_Reader reader; /* reader function */ - void* data; /* additional data */ - lua_State *L; /* Lua state (for reader) */ -}; - - -LUAI_FUNC int luaZ_fill (ZIO *z); - -#endif diff --git a/ext/lua/src/lapi.c b/ext/lua/src/lapi.c deleted file mode 100644 index d011431ead..0000000000 --- a/ext/lua/src/lapi.c +++ /dev/null @@ -1,1284 +0,0 @@ -/* -** $Id: lapi.c,v 2.171.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua API -** See Copyright Notice in lua.h -*/ - - -#include -#include - -#define lapi_c -#define LUA_CORE - -#include "lua.h" - -#include "lapi.h" -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lgc.h" -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" -#include "lundump.h" -#include "lvm.h" - - - -const char lua_ident[] = - "$LuaVersion: " LUA_COPYRIGHT " $" - "$LuaAuthors: " LUA_AUTHORS " $"; - - -/* value at a non-valid index */ -#define NONVALIDVALUE cast(TValue *, luaO_nilobject) - -/* corresponding test */ -#define isvalid(o) ((o) != luaO_nilobject) - -/* test for pseudo index */ -#define ispseudo(i) ((i) <= LUA_REGISTRYINDEX) - -/* test for valid but not pseudo index */ -#define isstackindex(i, o) (isvalid(o) && !ispseudo(i)) - -#define api_checkvalidindex(L, o) api_check(L, isvalid(o), "invalid index") - -#define api_checkstackindex(L, i, o) \ - api_check(L, isstackindex(i, o), "index not in the stack") - - -static TValue *index2addr (lua_State *L, int idx) { - CallInfo *ci = L->ci; - if (idx > 0) { - TValue *o = ci->func + idx; - api_check(L, idx <= ci->top - (ci->func + 1), "unacceptable index"); - if (o >= L->top) return NONVALIDVALUE; - else return o; - } - else if (!ispseudo(idx)) { /* negative index */ - api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index"); - return L->top + idx; - } - else if (idx == LUA_REGISTRYINDEX) - return &G(L)->l_registry; - else { /* upvalues */ - idx = LUA_REGISTRYINDEX - idx; - api_check(L, idx <= MAXUPVAL + 1, "upvalue index too large"); - if (ttislcf(ci->func)) /* light C function? */ - return NONVALIDVALUE; /* it has no upvalues */ - else { - CClosure *func = clCvalue(ci->func); - return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : NONVALIDVALUE; - } - } -} - - -/* -** to be called by 'lua_checkstack' in protected mode, to grow stack -** capturing memory errors -*/ -static void growstack (lua_State *L, void *ud) { - int size = *(int *)ud; - luaD_growstack(L, size); -} - - -LUA_API int lua_checkstack (lua_State *L, int size) { - int res; - CallInfo *ci = L->ci; - lua_lock(L); - if (L->stack_last - L->top > size) /* stack large enough? */ - res = 1; /* yes; check is OK */ - else { /* no; need to grow stack */ - int inuse = cast_int(L->top - L->stack) + EXTRA_STACK; - if (inuse > LUAI_MAXSTACK - size) /* can grow without overflow? */ - res = 0; /* no */ - else /* try to grow stack */ - res = (luaD_rawrunprotected(L, &growstack, &size) == LUA_OK); - } - if (res && ci->top < L->top + size) - ci->top = L->top + size; /* adjust frame top */ - lua_unlock(L); - return res; -} - - -LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) { - int i; - if (from == to) return; - lua_lock(to); - api_checknelems(from, n); - api_check(from, G(from) == G(to), "moving among independent states"); - api_check(from, to->ci->top - to->top >= n, "not enough elements to move"); - from->top -= n; - for (i = 0; i < n; i++) { - setobj2s(to, to->top++, from->top + i); - } - lua_unlock(to); -} - - -LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) { - lua_CFunction old; - lua_lock(L); - old = G(L)->panic; - G(L)->panic = panicf; - lua_unlock(L); - return old; -} - - -LUA_API const lua_Number *lua_version (lua_State *L) { - static const lua_Number version = LUA_VERSION_NUM; - if (L == NULL) return &version; - else return G(L)->version; -} - - - -/* -** basic stack manipulation -*/ - - -/* -** convert an acceptable stack index into an absolute index -*/ -LUA_API int lua_absindex (lua_State *L, int idx) { - return (idx > 0 || ispseudo(idx)) - ? idx - : cast_int(L->top - L->ci->func + idx); -} - - -LUA_API int lua_gettop (lua_State *L) { - return cast_int(L->top - (L->ci->func + 1)); -} - - -LUA_API void lua_settop (lua_State *L, int idx) { - StkId func = L->ci->func; - lua_lock(L); - if (idx >= 0) { - api_check(L, idx <= L->stack_last - (func + 1), "new top too large"); - while (L->top < (func + 1) + idx) - setnilvalue(L->top++); - L->top = (func + 1) + idx; - } - else { - api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top"); - L->top += idx+1; /* `subtract' index (index is negative) */ - } - lua_unlock(L); -} - - -LUA_API void lua_remove (lua_State *L, int idx) { - StkId p; - lua_lock(L); - p = index2addr(L, idx); - api_checkstackindex(L, idx, p); - while (++p < L->top) setobjs2s(L, p-1, p); - L->top--; - lua_unlock(L); -} - - -LUA_API void lua_insert (lua_State *L, int idx) { - StkId p; - StkId q; - lua_lock(L); - p = index2addr(L, idx); - api_checkstackindex(L, idx, p); - for (q = L->top; q > p; q--) /* use L->top as a temporary */ - setobjs2s(L, q, q - 1); - setobjs2s(L, p, L->top); - lua_unlock(L); -} - - -static void moveto (lua_State *L, TValue *fr, int idx) { - TValue *to = index2addr(L, idx); - api_checkvalidindex(L, to); - setobj(L, to, fr); - if (idx < LUA_REGISTRYINDEX) /* function upvalue? */ - luaC_barrier(L, clCvalue(L->ci->func), fr); - /* LUA_REGISTRYINDEX does not need gc barrier - (collector revisits it before finishing collection) */ -} - - -LUA_API void lua_replace (lua_State *L, int idx) { - lua_lock(L); - api_checknelems(L, 1); - moveto(L, L->top - 1, idx); - L->top--; - lua_unlock(L); -} - - -LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) { - TValue *fr; - lua_lock(L); - fr = index2addr(L, fromidx); - moveto(L, fr, toidx); - lua_unlock(L); -} - - -LUA_API void lua_pushvalue (lua_State *L, int idx) { - lua_lock(L); - setobj2s(L, L->top, index2addr(L, idx)); - api_incr_top(L); - lua_unlock(L); -} - - - -/* -** access functions (stack -> C) -*/ - - -LUA_API int lua_type (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - return (isvalid(o) ? ttypenv(o) : LUA_TNONE); -} - - -LUA_API const char *lua_typename (lua_State *L, int t) { - UNUSED(L); - return ttypename(t); -} - - -LUA_API int lua_iscfunction (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - return (ttislcf(o) || (ttisCclosure(o))); -} - - -LUA_API int lua_isnumber (lua_State *L, int idx) { - TValue n; - const TValue *o = index2addr(L, idx); - return tonumber(o, &n); -} - - -LUA_API int lua_isstring (lua_State *L, int idx) { - int t = lua_type(L, idx); - return (t == LUA_TSTRING || t == LUA_TNUMBER); -} - - -LUA_API int lua_isuserdata (lua_State *L, int idx) { - const TValue *o = index2addr(L, idx); - return (ttisuserdata(o) || ttislightuserdata(o)); -} - - -LUA_API int lua_rawequal (lua_State *L, int index1, int index2) { - StkId o1 = index2addr(L, index1); - StkId o2 = index2addr(L, index2); - return (isvalid(o1) && isvalid(o2)) ? luaV_rawequalobj(o1, o2) : 0; -} - - -LUA_API void lua_arith (lua_State *L, int op) { - StkId o1; /* 1st operand */ - StkId o2; /* 2nd operand */ - lua_lock(L); - if (op != LUA_OPUNM) /* all other operations expect two operands */ - api_checknelems(L, 2); - else { /* for unary minus, add fake 2nd operand */ - api_checknelems(L, 1); - setobjs2s(L, L->top, L->top - 1); - L->top++; - } - o1 = L->top - 2; - o2 = L->top - 1; - if (ttisnumber(o1) && ttisnumber(o2)) { - setnvalue(o1, luaO_arith(op, nvalue(o1), nvalue(o2))); - } - else - luaV_arith(L, o1, o1, o2, cast(TMS, op - LUA_OPADD + TM_ADD)); - L->top--; - lua_unlock(L); -} - - -LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) { - StkId o1, o2; - int i = 0; - lua_lock(L); /* may call tag method */ - o1 = index2addr(L, index1); - o2 = index2addr(L, index2); - if (isvalid(o1) && isvalid(o2)) { - switch (op) { - case LUA_OPEQ: i = equalobj(L, o1, o2); break; - case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break; - case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break; - default: api_check(L, 0, "invalid option"); - } - } - lua_unlock(L); - return i; -} - - -LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *isnum) { - TValue n; - const TValue *o = index2addr(L, idx); - if (tonumber(o, &n)) { - if (isnum) *isnum = 1; - return nvalue(o); - } - else { - if (isnum) *isnum = 0; - return 0; - } -} - - -LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *isnum) { - TValue n; - const TValue *o = index2addr(L, idx); - if (tonumber(o, &n)) { - lua_Integer res; - lua_Number num = nvalue(o); - lua_number2integer(res, num); - if (isnum) *isnum = 1; - return res; - } - else { - if (isnum) *isnum = 0; - return 0; - } -} - - -LUA_API lua_Unsigned lua_tounsignedx (lua_State *L, int idx, int *isnum) { - TValue n; - const TValue *o = index2addr(L, idx); - if (tonumber(o, &n)) { - lua_Unsigned res; - lua_Number num = nvalue(o); - lua_number2unsigned(res, num); - if (isnum) *isnum = 1; - return res; - } - else { - if (isnum) *isnum = 0; - return 0; - } -} - - -LUA_API int lua_toboolean (lua_State *L, int idx) { - const TValue *o = index2addr(L, idx); - return !l_isfalse(o); -} - - -LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) { - StkId o = index2addr(L, idx); - if (!ttisstring(o)) { - lua_lock(L); /* `luaV_tostring' may create a new string */ - if (!luaV_tostring(L, o)) { /* conversion failed? */ - if (len != NULL) *len = 0; - lua_unlock(L); - return NULL; - } - luaC_checkGC(L); - o = index2addr(L, idx); /* previous call may reallocate the stack */ - lua_unlock(L); - } - if (len != NULL) *len = tsvalue(o)->len; - return svalue(o); -} - - -LUA_API size_t lua_rawlen (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - switch (ttypenv(o)) { - case LUA_TSTRING: return tsvalue(o)->len; - case LUA_TUSERDATA: return uvalue(o)->len; - case LUA_TTABLE: return luaH_getn(hvalue(o)); - default: return 0; - } -} - - -LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - if (ttislcf(o)) return fvalue(o); - else if (ttisCclosure(o)) - return clCvalue(o)->f; - else return NULL; /* not a C function */ -} - - -LUA_API void *lua_touserdata (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - switch (ttypenv(o)) { - case LUA_TUSERDATA: return (rawuvalue(o) + 1); - case LUA_TLIGHTUSERDATA: return pvalue(o); - default: return NULL; - } -} - - -LUA_API lua_State *lua_tothread (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - return (!ttisthread(o)) ? NULL : thvalue(o); -} - - -LUA_API const void *lua_topointer (lua_State *L, int idx) { - StkId o = index2addr(L, idx); - switch (ttype(o)) { - case LUA_TTABLE: return hvalue(o); - case LUA_TLCL: return clLvalue(o); - case LUA_TCCL: return clCvalue(o); - case LUA_TLCF: return cast(void *, cast(size_t, fvalue(o))); - case LUA_TTHREAD: return thvalue(o); - case LUA_TUSERDATA: - case LUA_TLIGHTUSERDATA: - return lua_touserdata(L, idx); - default: return NULL; - } -} - - - -/* -** push functions (C -> stack) -*/ - - -LUA_API void lua_pushnil (lua_State *L) { - lua_lock(L); - setnilvalue(L->top); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_pushnumber (lua_State *L, lua_Number n) { - lua_lock(L); - setnvalue(L->top, n); - luai_checknum(L, L->top, - luaG_runerror(L, "C API - attempt to push a signaling NaN")); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) { - lua_lock(L); - setnvalue(L->top, cast_num(n)); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_pushunsigned (lua_State *L, lua_Unsigned u) { - lua_Number n; - lua_lock(L); - n = lua_unsigned2number(u); - setnvalue(L->top, n); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) { - TString *ts; - lua_lock(L); - luaC_checkGC(L); - ts = luaS_newlstr(L, s, len); - setsvalue2s(L, L->top, ts); - api_incr_top(L); - lua_unlock(L); - return getstr(ts); -} - - -LUA_API const char *lua_pushstring (lua_State *L, const char *s) { - if (s == NULL) { - lua_pushnil(L); - return NULL; - } - else { - TString *ts; - lua_lock(L); - luaC_checkGC(L); - ts = luaS_new(L, s); - setsvalue2s(L, L->top, ts); - api_incr_top(L); - lua_unlock(L); - return getstr(ts); - } -} - - -LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt, - va_list argp) { - const char *ret; - lua_lock(L); - luaC_checkGC(L); - ret = luaO_pushvfstring(L, fmt, argp); - lua_unlock(L); - return ret; -} - - -LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) { - const char *ret; - va_list argp; - lua_lock(L); - luaC_checkGC(L); - va_start(argp, fmt); - ret = luaO_pushvfstring(L, fmt, argp); - va_end(argp); - lua_unlock(L); - return ret; -} - - -LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) { - lua_lock(L); - if (n == 0) { - setfvalue(L->top, fn); - } - else { - Closure *cl; - api_checknelems(L, n); - api_check(L, n <= MAXUPVAL, "upvalue index too large"); - luaC_checkGC(L); - cl = luaF_newCclosure(L, n); - cl->c.f = fn; - L->top -= n; - while (n--) - setobj2n(L, &cl->c.upvalue[n], L->top + n); - setclCvalue(L, L->top, cl); - } - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_pushboolean (lua_State *L, int b) { - lua_lock(L); - setbvalue(L->top, (b != 0)); /* ensure that true is 1 */ - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_pushlightuserdata (lua_State *L, void *p) { - lua_lock(L); - setpvalue(L->top, p); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API int lua_pushthread (lua_State *L) { - lua_lock(L); - setthvalue(L, L->top, L); - api_incr_top(L); - lua_unlock(L); - return (G(L)->mainthread == L); -} - - - -/* -** get functions (Lua -> stack) -*/ - - -LUA_API void lua_getglobal (lua_State *L, const char *var) { - Table *reg = hvalue(&G(L)->l_registry); - const TValue *gt; /* global table */ - lua_lock(L); - gt = luaH_getint(reg, LUA_RIDX_GLOBALS); - setsvalue2s(L, L->top++, luaS_new(L, var)); - luaV_gettable(L, gt, L->top - 1, L->top - 1); - lua_unlock(L); -} - - -LUA_API void lua_gettable (lua_State *L, int idx) { - StkId t; - lua_lock(L); - t = index2addr(L, idx); - luaV_gettable(L, t, L->top - 1, L->top - 1); - lua_unlock(L); -} - - -LUA_API void lua_getfield (lua_State *L, int idx, const char *k) { - StkId t; - lua_lock(L); - t = index2addr(L, idx); - setsvalue2s(L, L->top, luaS_new(L, k)); - api_incr_top(L); - luaV_gettable(L, t, L->top - 1, L->top - 1); - lua_unlock(L); -} - - -LUA_API void lua_rawget (lua_State *L, int idx) { - StkId t; - lua_lock(L); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1)); - lua_unlock(L); -} - - -LUA_API void lua_rawgeti (lua_State *L, int idx, int n) { - StkId t; - lua_lock(L); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - setobj2s(L, L->top, luaH_getint(hvalue(t), n)); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_rawgetp (lua_State *L, int idx, const void *p) { - StkId t; - TValue k; - lua_lock(L); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - setpvalue(&k, cast(void *, p)); - setobj2s(L, L->top, luaH_get(hvalue(t), &k)); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API void lua_createtable (lua_State *L, int narray, int nrec) { - Table *t; - lua_lock(L); - luaC_checkGC(L); - t = luaH_new(L); - sethvalue(L, L->top, t); - api_incr_top(L); - if (narray > 0 || nrec > 0) - luaH_resize(L, t, narray, nrec); - lua_unlock(L); -} - - -LUA_API int lua_getmetatable (lua_State *L, int objindex) { - const TValue *obj; - Table *mt = NULL; - int res; - lua_lock(L); - obj = index2addr(L, objindex); - switch (ttypenv(obj)) { - case LUA_TTABLE: - mt = hvalue(obj)->metatable; - break; - case LUA_TUSERDATA: - mt = uvalue(obj)->metatable; - break; - default: - mt = G(L)->mt[ttypenv(obj)]; - break; - } - if (mt == NULL) - res = 0; - else { - sethvalue(L, L->top, mt); - api_incr_top(L); - res = 1; - } - lua_unlock(L); - return res; -} - - -LUA_API void lua_getuservalue (lua_State *L, int idx) { - StkId o; - lua_lock(L); - o = index2addr(L, idx); - api_check(L, ttisuserdata(o), "userdata expected"); - if (uvalue(o)->env) { - sethvalue(L, L->top, uvalue(o)->env); - } else - setnilvalue(L->top); - api_incr_top(L); - lua_unlock(L); -} - - -/* -** set functions (stack -> Lua) -*/ - - -LUA_API void lua_setglobal (lua_State *L, const char *var) { - Table *reg = hvalue(&G(L)->l_registry); - const TValue *gt; /* global table */ - lua_lock(L); - api_checknelems(L, 1); - gt = luaH_getint(reg, LUA_RIDX_GLOBALS); - setsvalue2s(L, L->top++, luaS_new(L, var)); - luaV_settable(L, gt, L->top - 1, L->top - 2); - L->top -= 2; /* pop value and key */ - lua_unlock(L); -} - - -LUA_API void lua_settable (lua_State *L, int idx) { - StkId t; - lua_lock(L); - api_checknelems(L, 2); - t = index2addr(L, idx); - luaV_settable(L, t, L->top - 2, L->top - 1); - L->top -= 2; /* pop index and value */ - lua_unlock(L); -} - - -LUA_API void lua_setfield (lua_State *L, int idx, const char *k) { - StkId t; - lua_lock(L); - api_checknelems(L, 1); - t = index2addr(L, idx); - setsvalue2s(L, L->top++, luaS_new(L, k)); - luaV_settable(L, t, L->top - 1, L->top - 2); - L->top -= 2; /* pop value and key */ - lua_unlock(L); -} - - -LUA_API void lua_rawset (lua_State *L, int idx) { - StkId t; - lua_lock(L); - api_checknelems(L, 2); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - setobj2t(L, luaH_set(L, hvalue(t), L->top-2), L->top-1); - invalidateTMcache(hvalue(t)); - luaC_barrierback(L, gcvalue(t), L->top-1); - L->top -= 2; - lua_unlock(L); -} - - -LUA_API void lua_rawseti (lua_State *L, int idx, int n) { - StkId t; - lua_lock(L); - api_checknelems(L, 1); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - luaH_setint(L, hvalue(t), n, L->top - 1); - luaC_barrierback(L, gcvalue(t), L->top-1); - L->top--; - lua_unlock(L); -} - - -LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) { - StkId t; - TValue k; - lua_lock(L); - api_checknelems(L, 1); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - setpvalue(&k, cast(void *, p)); - setobj2t(L, luaH_set(L, hvalue(t), &k), L->top - 1); - luaC_barrierback(L, gcvalue(t), L->top - 1); - L->top--; - lua_unlock(L); -} - - -LUA_API int lua_setmetatable (lua_State *L, int objindex) { - TValue *obj; - Table *mt; - lua_lock(L); - api_checknelems(L, 1); - obj = index2addr(L, objindex); - if (ttisnil(L->top - 1)) - mt = NULL; - else { - api_check(L, ttistable(L->top - 1), "table expected"); - mt = hvalue(L->top - 1); - } - switch (ttypenv(obj)) { - case LUA_TTABLE: { - hvalue(obj)->metatable = mt; - if (mt) { - luaC_objbarrierback(L, gcvalue(obj), mt); - luaC_checkfinalizer(L, gcvalue(obj), mt); - } - break; - } - case LUA_TUSERDATA: { - uvalue(obj)->metatable = mt; - if (mt) { - luaC_objbarrier(L, rawuvalue(obj), mt); - luaC_checkfinalizer(L, gcvalue(obj), mt); - } - break; - } - default: { - G(L)->mt[ttypenv(obj)] = mt; - break; - } - } - L->top--; - lua_unlock(L); - return 1; -} - - -LUA_API void lua_setuservalue (lua_State *L, int idx) { - StkId o; - lua_lock(L); - api_checknelems(L, 1); - o = index2addr(L, idx); - api_check(L, ttisuserdata(o), "userdata expected"); - if (ttisnil(L->top - 1)) - uvalue(o)->env = NULL; - else { - api_check(L, ttistable(L->top - 1), "table expected"); - uvalue(o)->env = hvalue(L->top - 1); - luaC_objbarrier(L, gcvalue(o), hvalue(L->top - 1)); - } - L->top--; - lua_unlock(L); -} - - -/* -** `load' and `call' functions (run Lua code) -*/ - - -#define checkresults(L,na,nr) \ - api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \ - "results from function overflow current stack size") - - -LUA_API int lua_getctx (lua_State *L, int *ctx) { - if (L->ci->callstatus & CIST_YIELDED) { - if (ctx) *ctx = L->ci->u.c.ctx; - return L->ci->u.c.status; - } - else return LUA_OK; -} - - -LUA_API void lua_callk (lua_State *L, int nargs, int nresults, int ctx, - lua_CFunction k) { - StkId func; - lua_lock(L); - api_check(L, k == NULL || !isLua(L->ci), - "cannot use continuations inside hooks"); - api_checknelems(L, nargs+1); - api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread"); - checkresults(L, nargs, nresults); - func = L->top - (nargs+1); - if (k != NULL && L->nny == 0) { /* need to prepare continuation? */ - L->ci->u.c.k = k; /* save continuation */ - L->ci->u.c.ctx = ctx; /* save context */ - luaD_call(L, func, nresults, 1); /* do the call */ - } - else /* no continuation or no yieldable */ - luaD_call(L, func, nresults, 0); /* just do the call */ - adjustresults(L, nresults); - lua_unlock(L); -} - - - -/* -** Execute a protected call. -*/ -struct CallS { /* data to `f_call' */ - StkId func; - int nresults; -}; - - -static void f_call (lua_State *L, void *ud) { - struct CallS *c = cast(struct CallS *, ud); - luaD_call(L, c->func, c->nresults, 0); -} - - - -LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc, - int ctx, lua_CFunction k) { - struct CallS c; - int status; - ptrdiff_t func; - lua_lock(L); - api_check(L, k == NULL || !isLua(L->ci), - "cannot use continuations inside hooks"); - api_checknelems(L, nargs+1); - api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread"); - checkresults(L, nargs, nresults); - if (errfunc == 0) - func = 0; - else { - StkId o = index2addr(L, errfunc); - api_checkstackindex(L, errfunc, o); - func = savestack(L, o); - } - c.func = L->top - (nargs+1); /* function to be called */ - if (k == NULL || L->nny > 0) { /* no continuation or no yieldable? */ - c.nresults = nresults; /* do a 'conventional' protected call */ - status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func); - } - else { /* prepare continuation (call is already protected by 'resume') */ - CallInfo *ci = L->ci; - ci->u.c.k = k; /* save continuation */ - ci->u.c.ctx = ctx; /* save context */ - /* save information for error recovery */ - ci->extra = savestack(L, c.func); - ci->u.c.old_allowhook = L->allowhook; - ci->u.c.old_errfunc = L->errfunc; - L->errfunc = func; - /* mark that function may do error recovery */ - ci->callstatus |= CIST_YPCALL; - luaD_call(L, c.func, nresults, 1); /* do the call */ - ci->callstatus &= ~CIST_YPCALL; - L->errfunc = ci->u.c.old_errfunc; - status = LUA_OK; /* if it is here, there were no errors */ - } - adjustresults(L, nresults); - lua_unlock(L); - return status; -} - - -LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data, - const char *chunkname, const char *mode) { - ZIO z; - int status; - lua_lock(L); - if (!chunkname) chunkname = "?"; - luaZ_init(L, &z, reader, data); - status = luaD_protectedparser(L, &z, chunkname, mode); - if (status == LUA_OK) { /* no errors? */ - LClosure *f = clLvalue(L->top - 1); /* get newly created function */ - if (f->nupvalues == 1) { /* does it have one upvalue? */ - /* get global table from registry */ - Table *reg = hvalue(&G(L)->l_registry); - const TValue *gt = luaH_getint(reg, LUA_RIDX_GLOBALS); - /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */ - setobj(L, f->upvals[0]->v, gt); - luaC_barrier(L, f->upvals[0], gt); - } - } - lua_unlock(L); - return status; -} - - -LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data) { - int status; - TValue *o; - lua_lock(L); - api_checknelems(L, 1); - o = L->top - 1; - if (isLfunction(o)) - status = luaU_dump(L, getproto(o), writer, data, 0); - else - status = 1; - lua_unlock(L); - return status; -} - - -LUA_API int lua_status (lua_State *L) { - return L->status; -} - - -/* -** Garbage-collection function -*/ - -LUA_API int lua_gc (lua_State *L, int what, int data) { - int res = 0; - global_State *g; - lua_lock(L); - g = G(L); - switch (what) { - case LUA_GCSTOP: { - g->gcrunning = 0; - break; - } - case LUA_GCRESTART: { - luaE_setdebt(g, 0); - g->gcrunning = 1; - break; - } - case LUA_GCCOLLECT: { - luaC_fullgc(L, 0); - break; - } - case LUA_GCCOUNT: { - /* GC values are expressed in Kbytes: #bytes/2^10 */ - res = cast_int(gettotalbytes(g) >> 10); - break; - } - case LUA_GCCOUNTB: { - res = cast_int(gettotalbytes(g) & 0x3ff); - break; - } - case LUA_GCSTEP: { - if (g->gckind == KGC_GEN) { /* generational mode? */ - res = (g->GCestimate == 0); /* true if it will do major collection */ - luaC_forcestep(L); /* do a single step */ - } - else { - lu_mem debt = cast(lu_mem, data) * 1024 - GCSTEPSIZE; - if (g->gcrunning) - debt += g->GCdebt; /* include current debt */ - luaE_setdebt(g, debt); - luaC_forcestep(L); - if (g->gcstate == GCSpause) /* end of cycle? */ - res = 1; /* signal it */ - } - break; - } - case LUA_GCSETPAUSE: { - res = g->gcpause; - g->gcpause = data; - break; - } - case LUA_GCSETMAJORINC: { - res = g->gcmajorinc; - g->gcmajorinc = data; - break; - } - case LUA_GCSETSTEPMUL: { - res = g->gcstepmul; - g->gcstepmul = data; - break; - } - case LUA_GCISRUNNING: { - res = g->gcrunning; - break; - } - case LUA_GCGEN: { /* change collector to generational mode */ - luaC_changemode(L, KGC_GEN); - break; - } - case LUA_GCINC: { /* change collector to incremental mode */ - luaC_changemode(L, KGC_NORMAL); - break; - } - default: res = -1; /* invalid option */ - } - lua_unlock(L); - return res; -} - - - -/* -** miscellaneous functions -*/ - - -LUA_API int lua_error (lua_State *L) { - lua_lock(L); - api_checknelems(L, 1); - luaG_errormsg(L); - /* code unreachable; will unlock when control actually leaves the kernel */ - return 0; /* to avoid warnings */ -} - - -LUA_API int lua_next (lua_State *L, int idx) { - StkId t; - int more; - lua_lock(L); - t = index2addr(L, idx); - api_check(L, ttistable(t), "table expected"); - more = luaH_next(L, hvalue(t), L->top - 1); - if (more) { - api_incr_top(L); - } - else /* no more elements */ - L->top -= 1; /* remove key */ - lua_unlock(L); - return more; -} - - -LUA_API void lua_concat (lua_State *L, int n) { - lua_lock(L); - api_checknelems(L, n); - if (n >= 2) { - luaC_checkGC(L); - luaV_concat(L, n); - } - else if (n == 0) { /* push empty string */ - setsvalue2s(L, L->top, luaS_newlstr(L, "", 0)); - api_incr_top(L); - } - /* else n == 1; nothing to do */ - lua_unlock(L); -} - - -LUA_API void lua_len (lua_State *L, int idx) { - StkId t; - lua_lock(L); - t = index2addr(L, idx); - luaV_objlen(L, L->top, t); - api_incr_top(L); - lua_unlock(L); -} - - -LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) { - lua_Alloc f; - lua_lock(L); - if (ud) *ud = G(L)->ud; - f = G(L)->frealloc; - lua_unlock(L); - return f; -} - - -LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) { - lua_lock(L); - G(L)->ud = ud; - G(L)->frealloc = f; - lua_unlock(L); -} - - -LUA_API void *lua_newuserdata (lua_State *L, size_t size) { - Udata *u; - lua_lock(L); - luaC_checkGC(L); - u = luaS_newudata(L, size, NULL); - setuvalue(L, L->top, u); - api_incr_top(L); - lua_unlock(L); - return u + 1; -} - - - -static const char *aux_upvalue (StkId fi, int n, TValue **val, - GCObject **owner) { - switch (ttype(fi)) { - case LUA_TCCL: { /* C closure */ - CClosure *f = clCvalue(fi); - if (!(1 <= n && n <= f->nupvalues)) return NULL; - *val = &f->upvalue[n-1]; - if (owner) *owner = obj2gco(f); - return ""; - } - case LUA_TLCL: { /* Lua closure */ - LClosure *f = clLvalue(fi); - TString *name; - Proto *p = f->p; - if (!(1 <= n && n <= p->sizeupvalues)) return NULL; - *val = f->upvals[n-1]->v; - if (owner) *owner = obj2gco(f->upvals[n - 1]); - name = p->upvalues[n-1].name; - return (name == NULL) ? "" : getstr(name); - } - default: return NULL; /* not a closure */ - } -} - - -LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) { - const char *name; - TValue *val = NULL; /* to avoid warnings */ - lua_lock(L); - name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL); - if (name) { - setobj2s(L, L->top, val); - api_incr_top(L); - } - lua_unlock(L); - return name; -} - - -LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) { - const char *name; - TValue *val = NULL; /* to avoid warnings */ - GCObject *owner = NULL; /* to avoid warnings */ - StkId fi; - lua_lock(L); - fi = index2addr(L, funcindex); - api_checknelems(L, 1); - name = aux_upvalue(fi, n, &val, &owner); - if (name) { - L->top--; - setobj(L, val, L->top); - luaC_barrier(L, owner, L->top); - } - lua_unlock(L); - return name; -} - - -static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) { - LClosure *f; - StkId fi = index2addr(L, fidx); - api_check(L, ttisLclosure(fi), "Lua function expected"); - f = clLvalue(fi); - api_check(L, (1 <= n && n <= f->p->sizeupvalues), "invalid upvalue index"); - if (pf) *pf = f; - return &f->upvals[n - 1]; /* get its upvalue pointer */ -} - - -LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) { - StkId fi = index2addr(L, fidx); - switch (ttype(fi)) { - case LUA_TLCL: { /* lua closure */ - return *getupvalref(L, fidx, n, NULL); - } - case LUA_TCCL: { /* C closure */ - CClosure *f = clCvalue(fi); - api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index"); - return &f->upvalue[n - 1]; - } - default: { - api_check(L, 0, "closure expected"); - return NULL; - } - } -} - - -LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1, - int fidx2, int n2) { - LClosure *f1; - UpVal **up1 = getupvalref(L, fidx1, n1, &f1); - UpVal **up2 = getupvalref(L, fidx2, n2, NULL); - *up1 = *up2; - luaC_objbarrier(L, f1, *up2); -} - diff --git a/ext/lua/src/lauxlib.c b/ext/lua/src/lauxlib.c deleted file mode 100644 index b00f8c7096..0000000000 --- a/ext/lua/src/lauxlib.c +++ /dev/null @@ -1,959 +0,0 @@ -/* -** $Id: lauxlib.c,v 1.248.1.1 2013/04/12 18:48:47 roberto Exp $ -** Auxiliary functions for building Lua libraries -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include -#include -#include - - -/* This file uses only the official API of Lua. -** Any function declared here could be written as an application function. -*/ - -#define lauxlib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" - - -/* -** {====================================================== -** Traceback -** ======================================================= -*/ - - -#define LEVELS1 12 /* size of the first part of the stack */ -#define LEVELS2 10 /* size of the second part of the stack */ - - - -/* -** search for 'objidx' in table at index -1. -** return 1 + string at top if find a good name. -*/ -static int findfield (lua_State *L, int objidx, int level) { - if (level == 0 || !lua_istable(L, -1)) - return 0; /* not found */ - lua_pushnil(L); /* start 'next' loop */ - while (lua_next(L, -2)) { /* for each pair in table */ - if (lua_type(L, -2) == LUA_TSTRING) { /* ignore non-string keys */ - if (lua_rawequal(L, objidx, -1)) { /* found object? */ - lua_pop(L, 1); /* remove value (but keep name) */ - return 1; - } - else if (findfield(L, objidx, level - 1)) { /* try recursively */ - lua_remove(L, -2); /* remove table (but keep name) */ - lua_pushliteral(L, "."); - lua_insert(L, -2); /* place '.' between the two names */ - lua_concat(L, 3); - return 1; - } - } - lua_pop(L, 1); /* remove value */ - } - return 0; /* not found */ -} - - -static int pushglobalfuncname (lua_State *L, lua_Debug *ar) { - int top = lua_gettop(L); - lua_getinfo(L, "f", ar); /* push function */ - lua_pushglobaltable(L); - if (findfield(L, top + 1, 2)) { - lua_copy(L, -1, top + 1); /* move name to proper place */ - lua_pop(L, 2); /* remove pushed values */ - return 1; - } - else { - lua_settop(L, top); /* remove function and global table */ - return 0; - } -} - - -static void pushfuncname (lua_State *L, lua_Debug *ar) { - if (*ar->namewhat != '\0') /* is there a name? */ - lua_pushfstring(L, "function " LUA_QS, ar->name); - else if (*ar->what == 'm') /* main? */ - lua_pushliteral(L, "main chunk"); - else if (*ar->what == 'C') { - if (pushglobalfuncname(L, ar)) { - lua_pushfstring(L, "function " LUA_QS, lua_tostring(L, -1)); - lua_remove(L, -2); /* remove name */ - } - else - lua_pushliteral(L, "?"); - } - else - lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined); -} - - -static int countlevels (lua_State *L) { - lua_Debug ar; - int li = 1, le = 1; - /* find an upper bound */ - while (lua_getstack(L, le, &ar)) { li = le; le *= 2; } - /* do a binary search */ - while (li < le) { - int m = (li + le)/2; - if (lua_getstack(L, m, &ar)) li = m + 1; - else le = m; - } - return le - 1; -} - - -LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1, - const char *msg, int level) { - lua_Debug ar; - int top = lua_gettop(L); - int numlevels = countlevels(L1); - int mark = (numlevels > LEVELS1 + LEVELS2) ? LEVELS1 : 0; - if (msg) lua_pushfstring(L, "%s\n", msg); - lua_pushliteral(L, "stack traceback:"); - while (lua_getstack(L1, level++, &ar)) { - if (level == mark) { /* too many levels? */ - lua_pushliteral(L, "\n\t..."); /* add a '...' */ - level = numlevels - LEVELS2; /* and skip to last ones */ - } - else { - lua_getinfo(L1, "Slnt", &ar); - lua_pushfstring(L, "\n\t%s:", ar.short_src); - if (ar.currentline > 0) - lua_pushfstring(L, "%d:", ar.currentline); - lua_pushliteral(L, " in "); - pushfuncname(L, &ar); - if (ar.istailcall) - lua_pushliteral(L, "\n\t(...tail calls...)"); - lua_concat(L, lua_gettop(L) - top); - } - } - lua_concat(L, lua_gettop(L) - top); -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Error-report functions -** ======================================================= -*/ - -LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) { - lua_Debug ar; - if (!lua_getstack(L, 0, &ar)) /* no stack frame? */ - return luaL_error(L, "bad argument #%d (%s)", narg, extramsg); - lua_getinfo(L, "n", &ar); - if (strcmp(ar.namewhat, "method") == 0) { - narg--; /* do not count `self' */ - if (narg == 0) /* error is in the self argument itself? */ - return luaL_error(L, "calling " LUA_QS " on bad self (%s)", - ar.name, extramsg); - } - if (ar.name == NULL) - ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?"; - return luaL_error(L, "bad argument #%d to " LUA_QS " (%s)", - narg, ar.name, extramsg); -} - - -static int typeerror (lua_State *L, int narg, const char *tname) { - const char *msg = lua_pushfstring(L, "%s expected, got %s", - tname, luaL_typename(L, narg)); - return luaL_argerror(L, narg, msg); -} - - -static void tag_error (lua_State *L, int narg, int tag) { - typeerror(L, narg, lua_typename(L, tag)); -} - - -LUALIB_API void luaL_where (lua_State *L, int level) { - lua_Debug ar; - if (lua_getstack(L, level, &ar)) { /* check function at level */ - lua_getinfo(L, "Sl", &ar); /* get info about it */ - if (ar.currentline > 0) { /* is there info? */ - lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline); - return; - } - } - lua_pushliteral(L, ""); /* else, no information available... */ -} - - -LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) { - va_list argp; - va_start(argp, fmt); - luaL_where(L, 1); - lua_pushvfstring(L, fmt, argp); - va_end(argp); - lua_concat(L, 2); - return lua_error(L); -} - - -LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) { - int en = errno; /* calls to Lua API may change this value */ - if (stat) { - lua_pushboolean(L, 1); - return 1; - } - else { - lua_pushnil(L); - if (fname) - lua_pushfstring(L, "%s: %s", fname, strerror(en)); - else - lua_pushstring(L, strerror(en)); - lua_pushinteger(L, en); - return 3; - } -} - - -#if !defined(inspectstat) /* { */ - -#if defined(LUA_USE_POSIX) - -#include - -/* -** use appropriate macros to interpret 'pclose' return status -*/ -#define inspectstat(stat,what) \ - if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \ - else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; } - -#else - -#define inspectstat(stat,what) /* no op */ - -#endif - -#endif /* } */ - - -LUALIB_API int luaL_execresult (lua_State *L, int stat) { - const char *what = "exit"; /* type of termination */ - if (stat == -1) /* error? */ - return luaL_fileresult(L, 0, NULL); - else { - inspectstat(stat, what); /* interpret result */ - if (*what == 'e' && stat == 0) /* successful termination? */ - lua_pushboolean(L, 1); - else - lua_pushnil(L); - lua_pushstring(L, what); - lua_pushinteger(L, stat); - return 3; /* return true/nil,what,code */ - } -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Userdata's metatable manipulation -** ======================================================= -*/ - -LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) { - luaL_getmetatable(L, tname); /* try to get metatable */ - if (!lua_isnil(L, -1)) /* name already in use? */ - return 0; /* leave previous value on top, but return 0 */ - lua_pop(L, 1); - lua_newtable(L); /* create metatable */ - lua_pushvalue(L, -1); - lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */ - return 1; -} - - -LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) { - luaL_getmetatable(L, tname); - lua_setmetatable(L, -2); -} - - -LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) { - void *p = lua_touserdata(L, ud); - if (p != NULL) { /* value is a userdata? */ - if (lua_getmetatable(L, ud)) { /* does it have a metatable? */ - luaL_getmetatable(L, tname); /* get correct metatable */ - if (!lua_rawequal(L, -1, -2)) /* not the same? */ - p = NULL; /* value is a userdata with wrong metatable */ - lua_pop(L, 2); /* remove both metatables */ - return p; - } - } - return NULL; /* value is not a userdata with a metatable */ -} - - -LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) { - void *p = luaL_testudata(L, ud, tname); - if (p == NULL) typeerror(L, ud, tname); - return p; -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Argument check functions -** ======================================================= -*/ - -LUALIB_API int luaL_checkoption (lua_State *L, int narg, const char *def, - const char *const lst[]) { - const char *name = (def) ? luaL_optstring(L, narg, def) : - luaL_checkstring(L, narg); - int i; - for (i=0; lst[i]; i++) - if (strcmp(lst[i], name) == 0) - return i; - return luaL_argerror(L, narg, - lua_pushfstring(L, "invalid option " LUA_QS, name)); -} - - -LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) { - /* keep some extra space to run error routines, if needed */ - const int extra = LUA_MINSTACK; - if (!lua_checkstack(L, space + extra)) { - if (msg) - luaL_error(L, "stack overflow (%s)", msg); - else - luaL_error(L, "stack overflow"); - } -} - - -LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) { - if (lua_type(L, narg) != t) - tag_error(L, narg, t); -} - - -LUALIB_API void luaL_checkany (lua_State *L, int narg) { - if (lua_type(L, narg) == LUA_TNONE) - luaL_argerror(L, narg, "value expected"); -} - - -LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) { - const char *s = lua_tolstring(L, narg, len); - if (!s) tag_error(L, narg, LUA_TSTRING); - return s; -} - - -LUALIB_API const char *luaL_optlstring (lua_State *L, int narg, - const char *def, size_t *len) { - if (lua_isnoneornil(L, narg)) { - if (len) - *len = (def ? strlen(def) : 0); - return def; - } - else return luaL_checklstring(L, narg, len); -} - - -LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) { - int isnum; - lua_Number d = lua_tonumberx(L, narg, &isnum); - if (!isnum) - tag_error(L, narg, LUA_TNUMBER); - return d; -} - - -LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) { - return luaL_opt(L, luaL_checknumber, narg, def); -} - - -LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int narg) { - int isnum; - lua_Integer d = lua_tointegerx(L, narg, &isnum); - if (!isnum) - tag_error(L, narg, LUA_TNUMBER); - return d; -} - - -LUALIB_API lua_Unsigned luaL_checkunsigned (lua_State *L, int narg) { - int isnum; - lua_Unsigned d = lua_tounsignedx(L, narg, &isnum); - if (!isnum) - tag_error(L, narg, LUA_TNUMBER); - return d; -} - - -LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int narg, - lua_Integer def) { - return luaL_opt(L, luaL_checkinteger, narg, def); -} - - -LUALIB_API lua_Unsigned luaL_optunsigned (lua_State *L, int narg, - lua_Unsigned def) { - return luaL_opt(L, luaL_checkunsigned, narg, def); -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Generic Buffer manipulation -** ======================================================= -*/ - -/* -** check whether buffer is using a userdata on the stack as a temporary -** buffer -*/ -#define buffonstack(B) ((B)->b != (B)->initb) - - -/* -** returns a pointer to a free area with at least 'sz' bytes -*/ -LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) { - lua_State *L = B->L; - if (B->size - B->n < sz) { /* not enough space? */ - char *newbuff; - size_t newsize = B->size * 2; /* double buffer size */ - if (newsize - B->n < sz) /* not big enough? */ - newsize = B->n + sz; - if (newsize < B->n || newsize - B->n < sz) - luaL_error(L, "buffer too large"); - /* create larger buffer */ - newbuff = (char *)lua_newuserdata(L, newsize * sizeof(char)); - /* move content to new buffer */ - memcpy(newbuff, B->b, B->n * sizeof(char)); - if (buffonstack(B)) - lua_remove(L, -2); /* remove old buffer */ - B->b = newbuff; - B->size = newsize; - } - return &B->b[B->n]; -} - - -LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) { - char *b = luaL_prepbuffsize(B, l); - memcpy(b, s, l * sizeof(char)); - luaL_addsize(B, l); -} - - -LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) { - luaL_addlstring(B, s, strlen(s)); -} - - -LUALIB_API void luaL_pushresult (luaL_Buffer *B) { - lua_State *L = B->L; - lua_pushlstring(L, B->b, B->n); - if (buffonstack(B)) - lua_remove(L, -2); /* remove old buffer */ -} - - -LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) { - luaL_addsize(B, sz); - luaL_pushresult(B); -} - - -LUALIB_API void luaL_addvalue (luaL_Buffer *B) { - lua_State *L = B->L; - size_t l; - const char *s = lua_tolstring(L, -1, &l); - if (buffonstack(B)) - lua_insert(L, -2); /* put value below buffer */ - luaL_addlstring(B, s, l); - lua_remove(L, (buffonstack(B)) ? -2 : -1); /* remove value */ -} - - -LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) { - B->L = L; - B->b = B->initb; - B->n = 0; - B->size = LUAL_BUFFERSIZE; -} - - -LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) { - luaL_buffinit(L, B); - return luaL_prepbuffsize(B, sz); -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Reference system -** ======================================================= -*/ - -/* index of free-list header */ -#define freelist 0 - - -LUALIB_API int luaL_ref (lua_State *L, int t) { - int ref; - if (lua_isnil(L, -1)) { - lua_pop(L, 1); /* remove from stack */ - return LUA_REFNIL; /* `nil' has a unique fixed reference */ - } - t = lua_absindex(L, t); - lua_rawgeti(L, t, freelist); /* get first free element */ - ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */ - lua_pop(L, 1); /* remove it from stack */ - if (ref != 0) { /* any free element? */ - lua_rawgeti(L, t, ref); /* remove it from list */ - lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */ - } - else /* no free elements */ - ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */ - lua_rawseti(L, t, ref); - return ref; -} - - -LUALIB_API void luaL_unref (lua_State *L, int t, int ref) { - if (ref >= 0) { - t = lua_absindex(L, t); - lua_rawgeti(L, t, freelist); - lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */ - lua_pushinteger(L, ref); - lua_rawseti(L, t, freelist); /* t[freelist] = ref */ - } -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Load functions -** ======================================================= -*/ - -typedef struct LoadF { - int n; /* number of pre-read characters */ - FILE *f; /* file being read */ - char buff[LUAL_BUFFERSIZE]; /* area for reading file */ -} LoadF; - - -static const char *getF (lua_State *L, void *ud, size_t *size) { - LoadF *lf = (LoadF *)ud; - (void)L; /* not used */ - if (lf->n > 0) { /* are there pre-read characters to be read? */ - *size = lf->n; /* return them (chars already in buffer) */ - lf->n = 0; /* no more pre-read characters */ - } - else { /* read a block from file */ - /* 'fread' can return > 0 *and* set the EOF flag. If next call to - 'getF' called 'fread', it might still wait for user input. - The next check avoids this problem. */ - if (feof(lf->f)) return NULL; - *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */ - } - return lf->buff; -} - - -static int errfile (lua_State *L, const char *what, int fnameindex) { - const char *serr = strerror(errno); - const char *filename = lua_tostring(L, fnameindex) + 1; - lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr); - lua_remove(L, fnameindex); - return LUA_ERRFILE; -} - - -static int skipBOM (LoadF *lf) { - const char *p = "\xEF\xBB\xBF"; /* Utf8 BOM mark */ - int c; - lf->n = 0; - do { - c = getc(lf->f); - if (c == EOF || c != *(const unsigned char *)p++) return c; - lf->buff[lf->n++] = c; /* to be read by the parser */ - } while (*p != '\0'); - lf->n = 0; /* prefix matched; discard it */ - return getc(lf->f); /* return next character */ -} - - -/* -** reads the first character of file 'f' and skips an optional BOM mark -** in its beginning plus its first line if it starts with '#'. Returns -** true if it skipped the first line. In any case, '*cp' has the -** first "valid" character of the file (after the optional BOM and -** a first-line comment). -*/ -static int skipcomment (LoadF *lf, int *cp) { - int c = *cp = skipBOM(lf); - if (c == '#') { /* first line is a comment (Unix exec. file)? */ - do { /* skip first line */ - c = getc(lf->f); - } while (c != EOF && c != '\n') ; - *cp = getc(lf->f); /* skip end-of-line, if present */ - return 1; /* there was a comment */ - } - else return 0; /* no comment */ -} - - -LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename, - const char *mode) { - LoadF lf; - int status, readstatus; - int c; - int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */ - if (filename == NULL) { - lua_pushliteral(L, "=stdin"); - lf.f = stdin; - } - else { - lua_pushfstring(L, "@%s", filename); - lf.f = fopen(filename, "r"); - if (lf.f == NULL) return errfile(L, "open", fnameindex); - } - if (skipcomment(&lf, &c)) /* read initial portion */ - lf.buff[lf.n++] = '\n'; /* add line to correct line numbers */ - if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */ - lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */ - if (lf.f == NULL) return errfile(L, "reopen", fnameindex); - skipcomment(&lf, &c); /* re-read initial portion */ - } - if (c != EOF) - lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */ - status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode); - readstatus = ferror(lf.f); - if (filename) fclose(lf.f); /* close file (even in case of errors) */ - if (readstatus) { - lua_settop(L, fnameindex); /* ignore results from `lua_load' */ - return errfile(L, "read", fnameindex); - } - lua_remove(L, fnameindex); - return status; -} - - -typedef struct LoadS { - const char *s; - size_t size; -} LoadS; - - -static const char *getS (lua_State *L, void *ud, size_t *size) { - LoadS *ls = (LoadS *)ud; - (void)L; /* not used */ - if (ls->size == 0) return NULL; - *size = ls->size; - ls->size = 0; - return ls->s; -} - - -LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size, - const char *name, const char *mode) { - LoadS ls; - ls.s = buff; - ls.size = size; - return lua_load(L, getS, &ls, name, mode); -} - - -LUALIB_API int luaL_loadstring (lua_State *L, const char *s) { - return luaL_loadbuffer(L, s, strlen(s), s); -} - -/* }====================================================== */ - - - -LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) { - if (!lua_getmetatable(L, obj)) /* no metatable? */ - return 0; - lua_pushstring(L, event); - lua_rawget(L, -2); - if (lua_isnil(L, -1)) { - lua_pop(L, 2); /* remove metatable and metafield */ - return 0; - } - else { - lua_remove(L, -2); /* remove only metatable */ - return 1; - } -} - - -LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) { - obj = lua_absindex(L, obj); - if (!luaL_getmetafield(L, obj, event)) /* no metafield? */ - return 0; - lua_pushvalue(L, obj); - lua_call(L, 1, 1); - return 1; -} - - -LUALIB_API int luaL_len (lua_State *L, int idx) { - int l; - int isnum; - lua_len(L, idx); - l = (int)lua_tointegerx(L, -1, &isnum); - if (!isnum) - luaL_error(L, "object length is not a number"); - lua_pop(L, 1); /* remove object */ - return l; -} - - -LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) { - if (!luaL_callmeta(L, idx, "__tostring")) { /* no metafield? */ - switch (lua_type(L, idx)) { - case LUA_TNUMBER: - case LUA_TSTRING: - lua_pushvalue(L, idx); - break; - case LUA_TBOOLEAN: - lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false")); - break; - case LUA_TNIL: - lua_pushliteral(L, "nil"); - break; - default: - lua_pushfstring(L, "%s: %p", luaL_typename(L, idx), - lua_topointer(L, idx)); - break; - } - } - return lua_tolstring(L, -1, len); -} - - -/* -** {====================================================== -** Compatibility with 5.1 module functions -** ======================================================= -*/ -#if defined(LUA_COMPAT_MODULE) - -static const char *luaL_findtable (lua_State *L, int idx, - const char *fname, int szhint) { - const char *e; - if (idx) lua_pushvalue(L, idx); - do { - e = strchr(fname, '.'); - if (e == NULL) e = fname + strlen(fname); - lua_pushlstring(L, fname, e - fname); - lua_rawget(L, -2); - if (lua_isnil(L, -1)) { /* no such field? */ - lua_pop(L, 1); /* remove this nil */ - lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */ - lua_pushlstring(L, fname, e - fname); - lua_pushvalue(L, -2); - lua_settable(L, -4); /* set new table into field */ - } - else if (!lua_istable(L, -1)) { /* field has a non-table value? */ - lua_pop(L, 2); /* remove table and value */ - return fname; /* return problematic part of the name */ - } - lua_remove(L, -2); /* remove previous table */ - fname = e + 1; - } while (*e == '.'); - return NULL; -} - - -/* -** Count number of elements in a luaL_Reg list. -*/ -static int libsize (const luaL_Reg *l) { - int size = 0; - for (; l && l->name; l++) size++; - return size; -} - - -/* -** Find or create a module table with a given name. The function -** first looks at the _LOADED table and, if that fails, try a -** global variable with that name. In any case, leaves on the stack -** the module table. -*/ -LUALIB_API void luaL_pushmodule (lua_State *L, const char *modname, - int sizehint) { - luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1); /* get _LOADED table */ - lua_getfield(L, -1, modname); /* get _LOADED[modname] */ - if (!lua_istable(L, -1)) { /* not found? */ - lua_pop(L, 1); /* remove previous result */ - /* try global variable (and create one if it does not exist) */ - lua_pushglobaltable(L); - if (luaL_findtable(L, 0, modname, sizehint) != NULL) - luaL_error(L, "name conflict for module " LUA_QS, modname); - lua_pushvalue(L, -1); - lua_setfield(L, -3, modname); /* _LOADED[modname] = new table */ - } - lua_remove(L, -2); /* remove _LOADED table */ -} - - -LUALIB_API void luaL_openlib (lua_State *L, const char *libname, - const luaL_Reg *l, int nup) { - luaL_checkversion(L); - if (libname) { - luaL_pushmodule(L, libname, libsize(l)); /* get/create library table */ - lua_insert(L, -(nup + 1)); /* move library table to below upvalues */ - } - if (l) - luaL_setfuncs(L, l, nup); - else - lua_pop(L, nup); /* remove upvalues */ -} - -#endif -/* }====================================================== */ - -/* -** set functions from list 'l' into table at top - 'nup'; each -** function gets the 'nup' elements at the top as upvalues. -** Returns with only the table at the stack. -*/ -LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) { - luaL_checkversion(L); - luaL_checkstack(L, nup, "too many upvalues"); - for (; l->name != NULL; l++) { /* fill the table with given functions */ - int i; - for (i = 0; i < nup; i++) /* copy upvalues to the top */ - lua_pushvalue(L, -nup); - lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */ - lua_setfield(L, -(nup + 2), l->name); - } - lua_pop(L, nup); /* remove upvalues */ -} - - -/* -** ensure that stack[idx][fname] has a table and push that table -** into the stack -*/ -LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) { - lua_getfield(L, idx, fname); - if (lua_istable(L, -1)) return 1; /* table already there */ - else { - lua_pop(L, 1); /* remove previous result */ - idx = lua_absindex(L, idx); - lua_newtable(L); - lua_pushvalue(L, -1); /* copy to be left at top */ - lua_setfield(L, idx, fname); /* assign new table to field */ - return 0; /* false, because did not find table there */ - } -} - - -/* -** stripped-down 'require'. Calls 'openf' to open a module, -** registers the result in 'package.loaded' table and, if 'glb' -** is true, also registers the result in the global table. -** Leaves resulting module on the top. -*/ -LUALIB_API void luaL_requiref (lua_State *L, const char *modname, - lua_CFunction openf, int glb) { - lua_pushcfunction(L, openf); - lua_pushstring(L, modname); /* argument to open function */ - lua_call(L, 1, 1); /* open module */ - luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED"); - lua_pushvalue(L, -2); /* make copy of module (call result) */ - lua_setfield(L, -2, modname); /* _LOADED[modname] = module */ - lua_pop(L, 1); /* remove _LOADED table */ - if (glb) { - lua_pushvalue(L, -1); /* copy of 'mod' */ - lua_setglobal(L, modname); /* _G[modname] = module */ - } -} - - -LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p, - const char *r) { - const char *wild; - size_t l = strlen(p); - luaL_Buffer b; - luaL_buffinit(L, &b); - while ((wild = strstr(s, p)) != NULL) { - luaL_addlstring(&b, s, wild - s); /* push prefix */ - luaL_addstring(&b, r); /* push replacement in place of pattern */ - s = wild + l; /* continue after `p' */ - } - luaL_addstring(&b, s); /* push last suffix */ - luaL_pushresult(&b); - return lua_tostring(L, -1); -} - - -static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { - (void)ud; (void)osize; /* not used */ - if (nsize == 0) { - free(ptr); - return NULL; - } - else - return realloc(ptr, nsize); -} - - -static int panic (lua_State *L) { - luai_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n", - lua_tostring(L, -1)); - return 0; /* return to Lua to abort */ -} - - -LUALIB_API lua_State *luaL_newstate (void) { - lua_State *L = lua_newstate(l_alloc, NULL); - if (L) lua_atpanic(L, &panic); - return L; -} - - -LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver) { - const lua_Number *v = lua_version(L); - if (v != lua_version(NULL)) - luaL_error(L, "multiple Lua VMs detected"); - else if (*v != ver) - luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f", - ver, *v); - /* check conversions number -> integer types */ - lua_pushnumber(L, -(lua_Number)0x1234); - if (lua_tointeger(L, -1) != -0x1234 || - lua_tounsigned(L, -1) != (lua_Unsigned)-0x1234) - luaL_error(L, "bad conversion number->int;" - " must recompile Lua with proper settings"); - lua_pop(L, 1); -} - diff --git a/ext/lua/src/lbaselib.c b/ext/lua/src/lbaselib.c deleted file mode 100644 index 5255b3cd9b..0000000000 --- a/ext/lua/src/lbaselib.c +++ /dev/null @@ -1,458 +0,0 @@ -/* -** $Id: lbaselib.c,v 1.276.1.1 2013/04/12 18:48:47 roberto Exp $ -** Basic library -** See Copyright Notice in lua.h -*/ - - - -#include -#include -#include -#include - -#define lbaselib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -static int luaB_print (lua_State *L) { - int n = lua_gettop(L); /* number of arguments */ - int i; - lua_getglobal(L, "tostring"); - for (i=1; i<=n; i++) { - const char *s; - size_t l; - lua_pushvalue(L, -1); /* function to be called */ - lua_pushvalue(L, i); /* value to print */ - lua_call(L, 1, 1); - s = lua_tolstring(L, -1, &l); /* get result */ - if (s == NULL) - return luaL_error(L, - LUA_QL("tostring") " must return a string to " LUA_QL("print")); - if (i>1) luai_writestring("\t", 1); - luai_writestring(s, l); - lua_pop(L, 1); /* pop result */ - } - luai_writeline(); - return 0; -} - - -#define SPACECHARS " \f\n\r\t\v" - -static int luaB_tonumber (lua_State *L) { - if (lua_isnoneornil(L, 2)) { /* standard conversion */ - int isnum; - lua_Number n = lua_tonumberx(L, 1, &isnum); - if (isnum) { - lua_pushnumber(L, n); - return 1; - } /* else not a number; must be something */ - luaL_checkany(L, 1); - } - else { - size_t l; - const char *s = luaL_checklstring(L, 1, &l); - const char *e = s + l; /* end point for 's' */ - int base = luaL_checkint(L, 2); - int neg = 0; - luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); - s += strspn(s, SPACECHARS); /* skip initial spaces */ - if (*s == '-') { s++; neg = 1; } /* handle signal */ - else if (*s == '+') s++; - if (isalnum((unsigned char)*s)) { - lua_Number n = 0; - do { - int digit = (isdigit((unsigned char)*s)) ? *s - '0' - : toupper((unsigned char)*s) - 'A' + 10; - if (digit >= base) break; /* invalid numeral; force a fail */ - n = n * (lua_Number)base + (lua_Number)digit; - s++; - } while (isalnum((unsigned char)*s)); - s += strspn(s, SPACECHARS); /* skip trailing spaces */ - if (s == e) { /* no invalid trailing characters? */ - lua_pushnumber(L, (neg) ? -n : n); - return 1; - } /* else not a number */ - } /* else not a number */ - } - lua_pushnil(L); /* not a number */ - return 1; -} - - -static int luaB_error (lua_State *L) { - int level = luaL_optint(L, 2, 1); - lua_settop(L, 1); - if (lua_isstring(L, 1) && level > 0) { /* add extra information? */ - luaL_where(L, level); - lua_pushvalue(L, 1); - lua_concat(L, 2); - } - return lua_error(L); -} - - -static int luaB_getmetatable (lua_State *L) { - luaL_checkany(L, 1); - if (!lua_getmetatable(L, 1)) { - lua_pushnil(L); - return 1; /* no metatable */ - } - luaL_getmetafield(L, 1, "__metatable"); - return 1; /* returns either __metatable field (if present) or metatable */ -} - - -static int luaB_setmetatable (lua_State *L) { - int t = lua_type(L, 2); - luaL_checktype(L, 1, LUA_TTABLE); - luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, - "nil or table expected"); - if (luaL_getmetafield(L, 1, "__metatable")) - return luaL_error(L, "cannot change a protected metatable"); - lua_settop(L, 2); - lua_setmetatable(L, 1); - return 1; -} - - -static int luaB_rawequal (lua_State *L) { - luaL_checkany(L, 1); - luaL_checkany(L, 2); - lua_pushboolean(L, lua_rawequal(L, 1, 2)); - return 1; -} - - -static int luaB_rawlen (lua_State *L) { - int t = lua_type(L, 1); - luaL_argcheck(L, t == LUA_TTABLE || t == LUA_TSTRING, 1, - "table or string expected"); - lua_pushinteger(L, lua_rawlen(L, 1)); - return 1; -} - - -static int luaB_rawget (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - luaL_checkany(L, 2); - lua_settop(L, 2); - lua_rawget(L, 1); - return 1; -} - -static int luaB_rawset (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - luaL_checkany(L, 2); - luaL_checkany(L, 3); - lua_settop(L, 3); - lua_rawset(L, 1); - return 1; -} - - -static int luaB_collectgarbage (lua_State *L) { - static const char *const opts[] = {"stop", "restart", "collect", - "count", "step", "setpause", "setstepmul", - "setmajorinc", "isrunning", "generational", "incremental", NULL}; - static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT, - LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL, - LUA_GCSETMAJORINC, LUA_GCISRUNNING, LUA_GCGEN, LUA_GCINC}; - int o = optsnum[luaL_checkoption(L, 1, "collect", opts)]; - int ex = luaL_optint(L, 2, 0); - int res = lua_gc(L, o, ex); - switch (o) { - case LUA_GCCOUNT: { - int b = lua_gc(L, LUA_GCCOUNTB, 0); - lua_pushnumber(L, res + ((lua_Number)b/1024)); - lua_pushinteger(L, b); - return 2; - } - case LUA_GCSTEP: case LUA_GCISRUNNING: { - lua_pushboolean(L, res); - return 1; - } - default: { - lua_pushinteger(L, res); - return 1; - } - } -} - - -static int luaB_type (lua_State *L) { - luaL_checkany(L, 1); - lua_pushstring(L, luaL_typename(L, 1)); - return 1; -} - - -static int pairsmeta (lua_State *L, const char *method, int iszero, - lua_CFunction iter) { - if (!luaL_getmetafield(L, 1, method)) { /* no metamethod? */ - luaL_checktype(L, 1, LUA_TTABLE); /* argument must be a table */ - lua_pushcfunction(L, iter); /* will return generator, */ - lua_pushvalue(L, 1); /* state, */ - if (iszero) lua_pushinteger(L, 0); /* and initial value */ - else lua_pushnil(L); - } - else { - lua_pushvalue(L, 1); /* argument 'self' to metamethod */ - lua_call(L, 1, 3); /* get 3 values from metamethod */ - } - return 3; -} - - -static int luaB_next (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - lua_settop(L, 2); /* create a 2nd argument if there isn't one */ - if (lua_next(L, 1)) - return 2; - else { - lua_pushnil(L); - return 1; - } -} - - -static int luaB_pairs (lua_State *L) { - return pairsmeta(L, "__pairs", 0, luaB_next); -} - - -static int ipairsaux (lua_State *L) { - int i = luaL_checkint(L, 2); - luaL_checktype(L, 1, LUA_TTABLE); - i++; /* next value */ - lua_pushinteger(L, i); - lua_rawgeti(L, 1, i); - return (lua_isnil(L, -1)) ? 1 : 2; -} - - -static int luaB_ipairs (lua_State *L) { - return pairsmeta(L, "__ipairs", 1, ipairsaux); -} - - -static int load_aux (lua_State *L, int status, int envidx) { - if (status == LUA_OK) { - if (envidx != 0) { /* 'env' parameter? */ - lua_pushvalue(L, envidx); /* environment for loaded function */ - if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */ - lua_pop(L, 1); /* remove 'env' if not used by previous call */ - } - return 1; - } - else { /* error (message is on top of the stack) */ - lua_pushnil(L); - lua_insert(L, -2); /* put before error message */ - return 2; /* return nil plus error message */ - } -} - - -static int luaB_loadfile (lua_State *L) { - const char *fname = luaL_optstring(L, 1, NULL); - const char *mode = luaL_optstring(L, 2, NULL); - int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */ - int status = luaL_loadfilex(L, fname, mode); - return load_aux(L, status, env); -} - - -/* -** {====================================================== -** Generic Read function -** ======================================================= -*/ - - -/* -** reserved slot, above all arguments, to hold a copy of the returned -** string to avoid it being collected while parsed. 'load' has four -** optional arguments (chunk, source name, mode, and environment). -*/ -#define RESERVEDSLOT 5 - - -/* -** Reader for generic `load' function: `lua_load' uses the -** stack for internal stuff, so the reader cannot change the -** stack top. Instead, it keeps its resulting string in a -** reserved slot inside the stack. -*/ -static const char *generic_reader (lua_State *L, void *ud, size_t *size) { - (void)(ud); /* not used */ - luaL_checkstack(L, 2, "too many nested functions"); - lua_pushvalue(L, 1); /* get function */ - lua_call(L, 0, 1); /* call it */ - if (lua_isnil(L, -1)) { - lua_pop(L, 1); /* pop result */ - *size = 0; - return NULL; - } - else if (!lua_isstring(L, -1)) - luaL_error(L, "reader function must return a string"); - lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */ - return lua_tolstring(L, RESERVEDSLOT, size); -} - - -static int luaB_load (lua_State *L) { - int status; - size_t l; - const char *s = lua_tolstring(L, 1, &l); - const char *mode = luaL_optstring(L, 3, "bt"); - int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */ - if (s != NULL) { /* loading a string? */ - const char *chunkname = luaL_optstring(L, 2, s); - status = luaL_loadbufferx(L, s, l, chunkname, mode); - } - else { /* loading from a reader function */ - const char *chunkname = luaL_optstring(L, 2, "=(load)"); - luaL_checktype(L, 1, LUA_TFUNCTION); - lua_settop(L, RESERVEDSLOT); /* create reserved slot */ - status = lua_load(L, generic_reader, NULL, chunkname, mode); - } - return load_aux(L, status, env); -} - -/* }====================================================== */ - - -static int dofilecont (lua_State *L) { - return lua_gettop(L) - 1; -} - - -static int luaB_dofile (lua_State *L) { - const char *fname = luaL_optstring(L, 1, NULL); - lua_settop(L, 1); - if (luaL_loadfile(L, fname) != LUA_OK) - return lua_error(L); - lua_callk(L, 0, LUA_MULTRET, 0, dofilecont); - return dofilecont(L); -} - - -static int luaB_assert (lua_State *L) { - if (!lua_toboolean(L, 1)) - return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); - return lua_gettop(L); -} - - -static int luaB_select (lua_State *L) { - int n = lua_gettop(L); - if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') { - lua_pushinteger(L, n-1); - return 1; - } - else { - int i = luaL_checkint(L, 1); - if (i < 0) i = n + i; - else if (i > n) i = n; - luaL_argcheck(L, 1 <= i, 1, "index out of range"); - return n - i; - } -} - - -static int finishpcall (lua_State *L, int status) { - if (!lua_checkstack(L, 1)) { /* no space for extra boolean? */ - lua_settop(L, 0); /* create space for return values */ - lua_pushboolean(L, 0); - lua_pushstring(L, "stack overflow"); - return 2; /* return false, msg */ - } - lua_pushboolean(L, status); /* first result (status) */ - lua_replace(L, 1); /* put first result in first slot */ - return lua_gettop(L); -} - - -static int pcallcont (lua_State *L) { - int status = lua_getctx(L, NULL); - return finishpcall(L, (status == LUA_YIELD)); -} - - -static int luaB_pcall (lua_State *L) { - int status; - luaL_checkany(L, 1); - lua_pushnil(L); - lua_insert(L, 1); /* create space for status result */ - status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, pcallcont); - return finishpcall(L, (status == LUA_OK)); -} - - -static int luaB_xpcall (lua_State *L) { - int status; - int n = lua_gettop(L); - luaL_argcheck(L, n >= 2, 2, "value expected"); - lua_pushvalue(L, 1); /* exchange function... */ - lua_copy(L, 2, 1); /* ...and error handler */ - lua_replace(L, 2); - status = lua_pcallk(L, n - 2, LUA_MULTRET, 1, 0, pcallcont); - return finishpcall(L, (status == LUA_OK)); -} - - -static int luaB_tostring (lua_State *L) { - luaL_checkany(L, 1); - luaL_tolstring(L, 1, NULL); - return 1; -} - - -static const luaL_Reg base_funcs[] = { - {"assert", luaB_assert}, - {"collectgarbage", luaB_collectgarbage}, - {"dofile", luaB_dofile}, - {"error", luaB_error}, - {"getmetatable", luaB_getmetatable}, - {"ipairs", luaB_ipairs}, - {"loadfile", luaB_loadfile}, - {"load", luaB_load}, -#if defined(LUA_COMPAT_LOADSTRING) - {"loadstring", luaB_load}, -#endif - {"next", luaB_next}, - {"pairs", luaB_pairs}, - {"pcall", luaB_pcall}, - {"print", luaB_print}, - {"rawequal", luaB_rawequal}, - {"rawlen", luaB_rawlen}, - {"rawget", luaB_rawget}, - {"rawset", luaB_rawset}, - {"select", luaB_select}, - {"setmetatable", luaB_setmetatable}, - {"tonumber", luaB_tonumber}, - {"tostring", luaB_tostring}, - {"type", luaB_type}, - {"xpcall", luaB_xpcall}, - {NULL, NULL} -}; - - -LUAMOD_API int luaopen_base (lua_State *L) { - /* set global _G */ - lua_pushglobaltable(L); - lua_pushglobaltable(L); - lua_setfield(L, -2, "_G"); - /* open lib into global table */ - luaL_setfuncs(L, base_funcs, 0); - lua_pushliteral(L, LUA_VERSION); - lua_setfield(L, -2, "_VERSION"); /* set global _VERSION */ - return 1; -} - diff --git a/ext/lua/src/lbitlib.c b/ext/lua/src/lbitlib.c deleted file mode 100644 index 31c7b66f12..0000000000 --- a/ext/lua/src/lbitlib.c +++ /dev/null @@ -1,212 +0,0 @@ -/* -** $Id: lbitlib.c,v 1.18.1.2 2013/07/09 18:01:41 roberto Exp $ -** Standard library for bitwise operations -** See Copyright Notice in lua.h -*/ - -#define lbitlib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -/* number of bits to consider in a number */ -#if !defined(LUA_NBITS) -#define LUA_NBITS 32 -#endif - - -#define ALLONES (~(((~(lua_Unsigned)0) << (LUA_NBITS - 1)) << 1)) - -/* macro to trim extra bits */ -#define trim(x) ((x) & ALLONES) - - -/* builds a number with 'n' ones (1 <= n <= LUA_NBITS) */ -#define mask(n) (~((ALLONES << 1) << ((n) - 1))) - - -typedef lua_Unsigned b_uint; - - - -static b_uint andaux (lua_State *L) { - int i, n = lua_gettop(L); - b_uint r = ~(b_uint)0; - for (i = 1; i <= n; i++) - r &= luaL_checkunsigned(L, i); - return trim(r); -} - - -static int b_and (lua_State *L) { - b_uint r = andaux(L); - lua_pushunsigned(L, r); - return 1; -} - - -static int b_test (lua_State *L) { - b_uint r = andaux(L); - lua_pushboolean(L, r != 0); - return 1; -} - - -static int b_or (lua_State *L) { - int i, n = lua_gettop(L); - b_uint r = 0; - for (i = 1; i <= n; i++) - r |= luaL_checkunsigned(L, i); - lua_pushunsigned(L, trim(r)); - return 1; -} - - -static int b_xor (lua_State *L) { - int i, n = lua_gettop(L); - b_uint r = 0; - for (i = 1; i <= n; i++) - r ^= luaL_checkunsigned(L, i); - lua_pushunsigned(L, trim(r)); - return 1; -} - - -static int b_not (lua_State *L) { - b_uint r = ~luaL_checkunsigned(L, 1); - lua_pushunsigned(L, trim(r)); - return 1; -} - - -static int b_shift (lua_State *L, b_uint r, int i) { - if (i < 0) { /* shift right? */ - i = -i; - r = trim(r); - if (i >= LUA_NBITS) r = 0; - else r >>= i; - } - else { /* shift left */ - if (i >= LUA_NBITS) r = 0; - else r <<= i; - r = trim(r); - } - lua_pushunsigned(L, r); - return 1; -} - - -static int b_lshift (lua_State *L) { - return b_shift(L, luaL_checkunsigned(L, 1), luaL_checkint(L, 2)); -} - - -static int b_rshift (lua_State *L) { - return b_shift(L, luaL_checkunsigned(L, 1), -luaL_checkint(L, 2)); -} - - -static int b_arshift (lua_State *L) { - b_uint r = luaL_checkunsigned(L, 1); - int i = luaL_checkint(L, 2); - if (i < 0 || !(r & ((b_uint)1 << (LUA_NBITS - 1)))) - return b_shift(L, r, -i); - else { /* arithmetic shift for 'negative' number */ - if (i >= LUA_NBITS) r = ALLONES; - else - r = trim((r >> i) | ~(~(b_uint)0 >> i)); /* add signal bit */ - lua_pushunsigned(L, r); - return 1; - } -} - - -static int b_rot (lua_State *L, int i) { - b_uint r = luaL_checkunsigned(L, 1); - i &= (LUA_NBITS - 1); /* i = i % NBITS */ - r = trim(r); - if (i != 0) /* avoid undefined shift of LUA_NBITS when i == 0 */ - r = (r << i) | (r >> (LUA_NBITS - i)); - lua_pushunsigned(L, trim(r)); - return 1; -} - - -static int b_lrot (lua_State *L) { - return b_rot(L, luaL_checkint(L, 2)); -} - - -static int b_rrot (lua_State *L) { - return b_rot(L, -luaL_checkint(L, 2)); -} - - -/* -** get field and width arguments for field-manipulation functions, -** checking whether they are valid. -** ('luaL_error' called without 'return' to avoid later warnings about -** 'width' being used uninitialized.) -*/ -static int fieldargs (lua_State *L, int farg, int *width) { - int f = luaL_checkint(L, farg); - int w = luaL_optint(L, farg + 1, 1); - luaL_argcheck(L, 0 <= f, farg, "field cannot be negative"); - luaL_argcheck(L, 0 < w, farg + 1, "width must be positive"); - if (f + w > LUA_NBITS) - luaL_error(L, "trying to access non-existent bits"); - *width = w; - return f; -} - - -static int b_extract (lua_State *L) { - int w; - b_uint r = luaL_checkunsigned(L, 1); - int f = fieldargs(L, 2, &w); - r = (r >> f) & mask(w); - lua_pushunsigned(L, r); - return 1; -} - - -static int b_replace (lua_State *L) { - int w; - b_uint r = luaL_checkunsigned(L, 1); - b_uint v = luaL_checkunsigned(L, 2); - int f = fieldargs(L, 3, &w); - int m = mask(w); - v &= m; /* erase bits outside given width */ - r = (r & ~(m << f)) | (v << f); - lua_pushunsigned(L, r); - return 1; -} - - -static const luaL_Reg bitlib[] = { - {"arshift", b_arshift}, - {"band", b_and}, - {"bnot", b_not}, - {"bor", b_or}, - {"bxor", b_xor}, - {"btest", b_test}, - {"extract", b_extract}, - {"lrotate", b_lrot}, - {"lshift", b_lshift}, - {"replace", b_replace}, - {"rrotate", b_rrot}, - {"rshift", b_rshift}, - {NULL, NULL} -}; - - - -LUAMOD_API int luaopen_bit32 (lua_State *L) { - luaL_newlib(L, bitlib); - return 1; -} - diff --git a/ext/lua/src/lcode.c b/ext/lua/src/lcode.c deleted file mode 100644 index 820b95c0e1..0000000000 --- a/ext/lua/src/lcode.c +++ /dev/null @@ -1,881 +0,0 @@ -/* -** $Id: lcode.c,v 2.62.1.1 2013/04/12 18:48:47 roberto Exp $ -** Code generator for Lua -** See Copyright Notice in lua.h -*/ - - -#include - -#define lcode_c -#define LUA_CORE - -#include "lua.h" - -#include "lcode.h" -#include "ldebug.h" -#include "ldo.h" -#include "lgc.h" -#include "llex.h" -#include "lmem.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lparser.h" -#include "lstring.h" -#include "ltable.h" -#include "lvm.h" - - -#define hasjumps(e) ((e)->t != (e)->f) - - -static int isnumeral(expdesc *e) { - return (e->k == VKNUM && e->t == NO_JUMP && e->f == NO_JUMP); -} - - -void luaK_nil (FuncState *fs, int from, int n) { - Instruction *previous; - int l = from + n - 1; /* last register to set nil */ - if (fs->pc > fs->lasttarget) { /* no jumps to current position? */ - previous = &fs->f->code[fs->pc-1]; - if (GET_OPCODE(*previous) == OP_LOADNIL) { - int pfrom = GETARG_A(*previous); - int pl = pfrom + GETARG_B(*previous); - if ((pfrom <= from && from <= pl + 1) || - (from <= pfrom && pfrom <= l + 1)) { /* can connect both? */ - if (pfrom < from) from = pfrom; /* from = min(from, pfrom) */ - if (pl > l) l = pl; /* l = max(l, pl) */ - SETARG_A(*previous, from); - SETARG_B(*previous, l - from); - return; - } - } /* else go through */ - } - luaK_codeABC(fs, OP_LOADNIL, from, n - 1, 0); /* else no optimization */ -} - - -int luaK_jump (FuncState *fs) { - int jpc = fs->jpc; /* save list of jumps to here */ - int j; - fs->jpc = NO_JUMP; - j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP); - luaK_concat(fs, &j, jpc); /* keep them on hold */ - return j; -} - - -void luaK_ret (FuncState *fs, int first, int nret) { - luaK_codeABC(fs, OP_RETURN, first, nret+1, 0); -} - - -static int condjump (FuncState *fs, OpCode op, int A, int B, int C) { - luaK_codeABC(fs, op, A, B, C); - return luaK_jump(fs); -} - - -static void fixjump (FuncState *fs, int pc, int dest) { - Instruction *jmp = &fs->f->code[pc]; - int offset = dest-(pc+1); - lua_assert(dest != NO_JUMP); - if (abs(offset) > MAXARG_sBx) - luaX_syntaxerror(fs->ls, "control structure too long"); - SETARG_sBx(*jmp, offset); -} - - -/* -** returns current `pc' and marks it as a jump target (to avoid wrong -** optimizations with consecutive instructions not in the same basic block). -*/ -int luaK_getlabel (FuncState *fs) { - fs->lasttarget = fs->pc; - return fs->pc; -} - - -static int getjump (FuncState *fs, int pc) { - int offset = GETARG_sBx(fs->f->code[pc]); - if (offset == NO_JUMP) /* point to itself represents end of list */ - return NO_JUMP; /* end of list */ - else - return (pc+1)+offset; /* turn offset into absolute position */ -} - - -static Instruction *getjumpcontrol (FuncState *fs, int pc) { - Instruction *pi = &fs->f->code[pc]; - if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1)))) - return pi-1; - else - return pi; -} - - -/* -** check whether list has any jump that do not produce a value -** (or produce an inverted value) -*/ -static int need_value (FuncState *fs, int list) { - for (; list != NO_JUMP; list = getjump(fs, list)) { - Instruction i = *getjumpcontrol(fs, list); - if (GET_OPCODE(i) != OP_TESTSET) return 1; - } - return 0; /* not found */ -} - - -static int patchtestreg (FuncState *fs, int node, int reg) { - Instruction *i = getjumpcontrol(fs, node); - if (GET_OPCODE(*i) != OP_TESTSET) - return 0; /* cannot patch other instructions */ - if (reg != NO_REG && reg != GETARG_B(*i)) - SETARG_A(*i, reg); - else /* no register to put value or register already has the value */ - *i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i)); - - return 1; -} - - -static void removevalues (FuncState *fs, int list) { - for (; list != NO_JUMP; list = getjump(fs, list)) - patchtestreg(fs, list, NO_REG); -} - - -static void patchlistaux (FuncState *fs, int list, int vtarget, int reg, - int dtarget) { - while (list != NO_JUMP) { - int next = getjump(fs, list); - if (patchtestreg(fs, list, reg)) - fixjump(fs, list, vtarget); - else - fixjump(fs, list, dtarget); /* jump to default target */ - list = next; - } -} - - -static void dischargejpc (FuncState *fs) { - patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc); - fs->jpc = NO_JUMP; -} - - -void luaK_patchlist (FuncState *fs, int list, int target) { - if (target == fs->pc) - luaK_patchtohere(fs, list); - else { - lua_assert(target < fs->pc); - patchlistaux(fs, list, target, NO_REG, target); - } -} - - -LUAI_FUNC void luaK_patchclose (FuncState *fs, int list, int level) { - level++; /* argument is +1 to reserve 0 as non-op */ - while (list != NO_JUMP) { - int next = getjump(fs, list); - lua_assert(GET_OPCODE(fs->f->code[list]) == OP_JMP && - (GETARG_A(fs->f->code[list]) == 0 || - GETARG_A(fs->f->code[list]) >= level)); - SETARG_A(fs->f->code[list], level); - list = next; - } -} - - -void luaK_patchtohere (FuncState *fs, int list) { - luaK_getlabel(fs); - luaK_concat(fs, &fs->jpc, list); -} - - -void luaK_concat (FuncState *fs, int *l1, int l2) { - if (l2 == NO_JUMP) return; - else if (*l1 == NO_JUMP) - *l1 = l2; - else { - int list = *l1; - int next; - while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */ - list = next; - fixjump(fs, list, l2); - } -} - - -static int luaK_code (FuncState *fs, Instruction i) { - Proto *f = fs->f; - dischargejpc(fs); /* `pc' will change */ - /* put new instruction in code array */ - luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction, - MAX_INT, "opcodes"); - f->code[fs->pc] = i; - /* save corresponding line information */ - luaM_growvector(fs->ls->L, f->lineinfo, fs->pc, f->sizelineinfo, int, - MAX_INT, "opcodes"); - f->lineinfo[fs->pc] = fs->ls->lastline; - return fs->pc++; -} - - -int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) { - lua_assert(getOpMode(o) == iABC); - lua_assert(getBMode(o) != OpArgN || b == 0); - lua_assert(getCMode(o) != OpArgN || c == 0); - lua_assert(a <= MAXARG_A && b <= MAXARG_B && c <= MAXARG_C); - return luaK_code(fs, CREATE_ABC(o, a, b, c)); -} - - -int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) { - lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx); - lua_assert(getCMode(o) == OpArgN); - lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx); - return luaK_code(fs, CREATE_ABx(o, a, bc)); -} - - -static int codeextraarg (FuncState *fs, int a) { - lua_assert(a <= MAXARG_Ax); - return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a)); -} - - -int luaK_codek (FuncState *fs, int reg, int k) { - if (k <= MAXARG_Bx) - return luaK_codeABx(fs, OP_LOADK, reg, k); - else { - int p = luaK_codeABx(fs, OP_LOADKX, reg, 0); - codeextraarg(fs, k); - return p; - } -} - - -void luaK_checkstack (FuncState *fs, int n) { - int newstack = fs->freereg + n; - if (newstack > fs->f->maxstacksize) { - if (newstack >= MAXSTACK) - luaX_syntaxerror(fs->ls, "function or expression too complex"); - fs->f->maxstacksize = cast_byte(newstack); - } -} - - -void luaK_reserveregs (FuncState *fs, int n) { - luaK_checkstack(fs, n); - fs->freereg += n; -} - - -static void freereg (FuncState *fs, int reg) { - if (!ISK(reg) && reg >= fs->nactvar) { - fs->freereg--; - lua_assert(reg == fs->freereg); - } -} - - -static void freeexp (FuncState *fs, expdesc *e) { - if (e->k == VNONRELOC) - freereg(fs, e->u.info); -} - - -static int addk (FuncState *fs, TValue *key, TValue *v) { - lua_State *L = fs->ls->L; - TValue *idx = luaH_set(L, fs->h, key); - Proto *f = fs->f; - int k, oldsize; - if (ttisnumber(idx)) { - lua_Number n = nvalue(idx); - lua_number2int(k, n); - if (luaV_rawequalobj(&f->k[k], v)) - return k; - /* else may be a collision (e.g., between 0.0 and "\0\0\0\0\0\0\0\0"); - go through and create a new entry for this value */ - } - /* constant not found; create a new entry */ - oldsize = f->sizek; - k = fs->nk; - /* numerical value does not need GC barrier; - table has no metatable, so it does not need to invalidate cache */ - setnvalue(idx, cast_num(k)); - luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants"); - while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]); - setobj(L, &f->k[k], v); - fs->nk++; - luaC_barrier(L, f, v); - return k; -} - - -int luaK_stringK (FuncState *fs, TString *s) { - TValue o; - setsvalue(fs->ls->L, &o, s); - return addk(fs, &o, &o); -} - - -int luaK_numberK (FuncState *fs, lua_Number r) { - int n; - lua_State *L = fs->ls->L; - TValue o; - setnvalue(&o, r); - if (r == 0 || luai_numisnan(NULL, r)) { /* handle -0 and NaN */ - /* use raw representation as key to avoid numeric problems */ - setsvalue(L, L->top++, luaS_newlstr(L, (char *)&r, sizeof(r))); - n = addk(fs, L->top - 1, &o); - L->top--; - } - else - n = addk(fs, &o, &o); /* regular case */ - return n; -} - - -static int boolK (FuncState *fs, int b) { - TValue o; - setbvalue(&o, b); - return addk(fs, &o, &o); -} - - -static int nilK (FuncState *fs) { - TValue k, v; - setnilvalue(&v); - /* cannot use nil as key; instead use table itself to represent nil */ - sethvalue(fs->ls->L, &k, fs->h); - return addk(fs, &k, &v); -} - - -void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) { - if (e->k == VCALL) { /* expression is an open function call? */ - SETARG_C(getcode(fs, e), nresults+1); - } - else if (e->k == VVARARG) { - SETARG_B(getcode(fs, e), nresults+1); - SETARG_A(getcode(fs, e), fs->freereg); - luaK_reserveregs(fs, 1); - } -} - - -void luaK_setoneret (FuncState *fs, expdesc *e) { - if (e->k == VCALL) { /* expression is an open function call? */ - e->k = VNONRELOC; - e->u.info = GETARG_A(getcode(fs, e)); - } - else if (e->k == VVARARG) { - SETARG_B(getcode(fs, e), 2); - e->k = VRELOCABLE; /* can relocate its simple result */ - } -} - - -void luaK_dischargevars (FuncState *fs, expdesc *e) { - switch (e->k) { - case VLOCAL: { - e->k = VNONRELOC; - break; - } - case VUPVAL: { - e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0); - e->k = VRELOCABLE; - break; - } - case VINDEXED: { - OpCode op = OP_GETTABUP; /* assume 't' is in an upvalue */ - freereg(fs, e->u.ind.idx); - if (e->u.ind.vt == VLOCAL) { /* 't' is in a register? */ - freereg(fs, e->u.ind.t); - op = OP_GETTABLE; - } - e->u.info = luaK_codeABC(fs, op, 0, e->u.ind.t, e->u.ind.idx); - e->k = VRELOCABLE; - break; - } - case VVARARG: - case VCALL: { - luaK_setoneret(fs, e); - break; - } - default: break; /* there is one value available (somewhere) */ - } -} - - -static int code_label (FuncState *fs, int A, int b, int jump) { - luaK_getlabel(fs); /* those instructions may be jump targets */ - return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump); -} - - -static void discharge2reg (FuncState *fs, expdesc *e, int reg) { - luaK_dischargevars(fs, e); - switch (e->k) { - case VNIL: { - luaK_nil(fs, reg, 1); - break; - } - case VFALSE: case VTRUE: { - luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0); - break; - } - case VK: { - luaK_codek(fs, reg, e->u.info); - break; - } - case VKNUM: { - luaK_codek(fs, reg, luaK_numberK(fs, e->u.nval)); - break; - } - case VRELOCABLE: { - Instruction *pc = &getcode(fs, e); - SETARG_A(*pc, reg); - break; - } - case VNONRELOC: { - if (reg != e->u.info) - luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0); - break; - } - default: { - lua_assert(e->k == VVOID || e->k == VJMP); - return; /* nothing to do... */ - } - } - e->u.info = reg; - e->k = VNONRELOC; -} - - -static void discharge2anyreg (FuncState *fs, expdesc *e) { - if (e->k != VNONRELOC) { - luaK_reserveregs(fs, 1); - discharge2reg(fs, e, fs->freereg-1); - } -} - - -static void exp2reg (FuncState *fs, expdesc *e, int reg) { - discharge2reg(fs, e, reg); - if (e->k == VJMP) - luaK_concat(fs, &e->t, e->u.info); /* put this jump in `t' list */ - if (hasjumps(e)) { - int final; /* position after whole expression */ - int p_f = NO_JUMP; /* position of an eventual LOAD false */ - int p_t = NO_JUMP; /* position of an eventual LOAD true */ - if (need_value(fs, e->t) || need_value(fs, e->f)) { - int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs); - p_f = code_label(fs, reg, 0, 1); - p_t = code_label(fs, reg, 1, 0); - luaK_patchtohere(fs, fj); - } - final = luaK_getlabel(fs); - patchlistaux(fs, e->f, final, reg, p_f); - patchlistaux(fs, e->t, final, reg, p_t); - } - e->f = e->t = NO_JUMP; - e->u.info = reg; - e->k = VNONRELOC; -} - - -void luaK_exp2nextreg (FuncState *fs, expdesc *e) { - luaK_dischargevars(fs, e); - freeexp(fs, e); - luaK_reserveregs(fs, 1); - exp2reg(fs, e, fs->freereg - 1); -} - - -int luaK_exp2anyreg (FuncState *fs, expdesc *e) { - luaK_dischargevars(fs, e); - if (e->k == VNONRELOC) { - if (!hasjumps(e)) return e->u.info; /* exp is already in a register */ - if (e->u.info >= fs->nactvar) { /* reg. is not a local? */ - exp2reg(fs, e, e->u.info); /* put value on it */ - return e->u.info; - } - } - luaK_exp2nextreg(fs, e); /* default */ - return e->u.info; -} - - -void luaK_exp2anyregup (FuncState *fs, expdesc *e) { - if (e->k != VUPVAL || hasjumps(e)) - luaK_exp2anyreg(fs, e); -} - - -void luaK_exp2val (FuncState *fs, expdesc *e) { - if (hasjumps(e)) - luaK_exp2anyreg(fs, e); - else - luaK_dischargevars(fs, e); -} - - -int luaK_exp2RK (FuncState *fs, expdesc *e) { - luaK_exp2val(fs, e); - switch (e->k) { - case VTRUE: - case VFALSE: - case VNIL: { - if (fs->nk <= MAXINDEXRK) { /* constant fits in RK operand? */ - e->u.info = (e->k == VNIL) ? nilK(fs) : boolK(fs, (e->k == VTRUE)); - e->k = VK; - return RKASK(e->u.info); - } - else break; - } - case VKNUM: { - e->u.info = luaK_numberK(fs, e->u.nval); - e->k = VK; - /* go through */ - } - case VK: { - if (e->u.info <= MAXINDEXRK) /* constant fits in argC? */ - return RKASK(e->u.info); - else break; - } - default: break; - } - /* not a constant in the right range: put it in a register */ - return luaK_exp2anyreg(fs, e); -} - - -void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) { - switch (var->k) { - case VLOCAL: { - freeexp(fs, ex); - exp2reg(fs, ex, var->u.info); - return; - } - case VUPVAL: { - int e = luaK_exp2anyreg(fs, ex); - luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0); - break; - } - case VINDEXED: { - OpCode op = (var->u.ind.vt == VLOCAL) ? OP_SETTABLE : OP_SETTABUP; - int e = luaK_exp2RK(fs, ex); - luaK_codeABC(fs, op, var->u.ind.t, var->u.ind.idx, e); - break; - } - default: { - lua_assert(0); /* invalid var kind to store */ - break; - } - } - freeexp(fs, ex); -} - - -void luaK_self (FuncState *fs, expdesc *e, expdesc *key) { - int ereg; - luaK_exp2anyreg(fs, e); - ereg = e->u.info; /* register where 'e' was placed */ - freeexp(fs, e); - e->u.info = fs->freereg; /* base register for op_self */ - e->k = VNONRELOC; - luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */ - luaK_codeABC(fs, OP_SELF, e->u.info, ereg, luaK_exp2RK(fs, key)); - freeexp(fs, key); -} - - -static void invertjump (FuncState *fs, expdesc *e) { - Instruction *pc = getjumpcontrol(fs, e->u.info); - lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET && - GET_OPCODE(*pc) != OP_TEST); - SETARG_A(*pc, !(GETARG_A(*pc))); -} - - -static int jumponcond (FuncState *fs, expdesc *e, int cond) { - if (e->k == VRELOCABLE) { - Instruction ie = getcode(fs, e); - if (GET_OPCODE(ie) == OP_NOT) { - fs->pc--; /* remove previous OP_NOT */ - return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond); - } - /* else go through */ - } - discharge2anyreg(fs, e); - freeexp(fs, e); - return condjump(fs, OP_TESTSET, NO_REG, e->u.info, cond); -} - - -void luaK_goiftrue (FuncState *fs, expdesc *e) { - int pc; /* pc of last jump */ - luaK_dischargevars(fs, e); - switch (e->k) { - case VJMP: { - invertjump(fs, e); - pc = e->u.info; - break; - } - case VK: case VKNUM: case VTRUE: { - pc = NO_JUMP; /* always true; do nothing */ - break; - } - default: { - pc = jumponcond(fs, e, 0); - break; - } - } - luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */ - luaK_patchtohere(fs, e->t); - e->t = NO_JUMP; -} - - -void luaK_goiffalse (FuncState *fs, expdesc *e) { - int pc; /* pc of last jump */ - luaK_dischargevars(fs, e); - switch (e->k) { - case VJMP: { - pc = e->u.info; - break; - } - case VNIL: case VFALSE: { - pc = NO_JUMP; /* always false; do nothing */ - break; - } - default: { - pc = jumponcond(fs, e, 1); - break; - } - } - luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */ - luaK_patchtohere(fs, e->f); - e->f = NO_JUMP; -} - - -static void codenot (FuncState *fs, expdesc *e) { - luaK_dischargevars(fs, e); - switch (e->k) { - case VNIL: case VFALSE: { - e->k = VTRUE; - break; - } - case VK: case VKNUM: case VTRUE: { - e->k = VFALSE; - break; - } - case VJMP: { - invertjump(fs, e); - break; - } - case VRELOCABLE: - case VNONRELOC: { - discharge2anyreg(fs, e); - freeexp(fs, e); - e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0); - e->k = VRELOCABLE; - break; - } - default: { - lua_assert(0); /* cannot happen */ - break; - } - } - /* interchange true and false lists */ - { int temp = e->f; e->f = e->t; e->t = temp; } - removevalues(fs, e->f); - removevalues(fs, e->t); -} - - -void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) { - lua_assert(!hasjumps(t)); - t->u.ind.t = t->u.info; - t->u.ind.idx = luaK_exp2RK(fs, k); - t->u.ind.vt = (t->k == VUPVAL) ? VUPVAL - : check_exp(vkisinreg(t->k), VLOCAL); - t->k = VINDEXED; -} - - -static int constfolding (OpCode op, expdesc *e1, expdesc *e2) { - lua_Number r; - if (!isnumeral(e1) || !isnumeral(e2)) return 0; - if ((op == OP_DIV || op == OP_MOD) && e2->u.nval == 0) - return 0; /* do not attempt to divide by 0 */ - r = luaO_arith(op - OP_ADD + LUA_OPADD, e1->u.nval, e2->u.nval); - e1->u.nval = r; - return 1; -} - - -static void codearith (FuncState *fs, OpCode op, - expdesc *e1, expdesc *e2, int line) { - if (constfolding(op, e1, e2)) - return; - else { - int o2 = (op != OP_UNM && op != OP_LEN) ? luaK_exp2RK(fs, e2) : 0; - int o1 = luaK_exp2RK(fs, e1); - if (o1 > o2) { - freeexp(fs, e1); - freeexp(fs, e2); - } - else { - freeexp(fs, e2); - freeexp(fs, e1); - } - e1->u.info = luaK_codeABC(fs, op, 0, o1, o2); - e1->k = VRELOCABLE; - luaK_fixline(fs, line); - } -} - - -static void codecomp (FuncState *fs, OpCode op, int cond, expdesc *e1, - expdesc *e2) { - int o1 = luaK_exp2RK(fs, e1); - int o2 = luaK_exp2RK(fs, e2); - freeexp(fs, e2); - freeexp(fs, e1); - if (cond == 0 && op != OP_EQ) { - int temp; /* exchange args to replace by `<' or `<=' */ - temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */ - cond = 1; - } - e1->u.info = condjump(fs, op, cond, o1, o2); - e1->k = VJMP; -} - - -void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) { - expdesc e2; - e2.t = e2.f = NO_JUMP; e2.k = VKNUM; e2.u.nval = 0; - switch (op) { - case OPR_MINUS: { - if (isnumeral(e)) /* minus constant? */ - e->u.nval = luai_numunm(NULL, e->u.nval); /* fold it */ - else { - luaK_exp2anyreg(fs, e); - codearith(fs, OP_UNM, e, &e2, line); - } - break; - } - case OPR_NOT: codenot(fs, e); break; - case OPR_LEN: { - luaK_exp2anyreg(fs, e); /* cannot operate on constants */ - codearith(fs, OP_LEN, e, &e2, line); - break; - } - default: lua_assert(0); - } -} - - -void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) { - switch (op) { - case OPR_AND: { - luaK_goiftrue(fs, v); - break; - } - case OPR_OR: { - luaK_goiffalse(fs, v); - break; - } - case OPR_CONCAT: { - luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */ - break; - } - case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV: - case OPR_MOD: case OPR_POW: { - if (!isnumeral(v)) luaK_exp2RK(fs, v); - break; - } - default: { - luaK_exp2RK(fs, v); - break; - } - } -} - - -void luaK_posfix (FuncState *fs, BinOpr op, - expdesc *e1, expdesc *e2, int line) { - switch (op) { - case OPR_AND: { - lua_assert(e1->t == NO_JUMP); /* list must be closed */ - luaK_dischargevars(fs, e2); - luaK_concat(fs, &e2->f, e1->f); - *e1 = *e2; - break; - } - case OPR_OR: { - lua_assert(e1->f == NO_JUMP); /* list must be closed */ - luaK_dischargevars(fs, e2); - luaK_concat(fs, &e2->t, e1->t); - *e1 = *e2; - break; - } - case OPR_CONCAT: { - luaK_exp2val(fs, e2); - if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) { - lua_assert(e1->u.info == GETARG_B(getcode(fs, e2))-1); - freeexp(fs, e1); - SETARG_B(getcode(fs, e2), e1->u.info); - e1->k = VRELOCABLE; e1->u.info = e2->u.info; - } - else { - luaK_exp2nextreg(fs, e2); /* operand must be on the 'stack' */ - codearith(fs, OP_CONCAT, e1, e2, line); - } - break; - } - case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV: - case OPR_MOD: case OPR_POW: { - codearith(fs, cast(OpCode, op - OPR_ADD + OP_ADD), e1, e2, line); - break; - } - case OPR_EQ: case OPR_LT: case OPR_LE: { - codecomp(fs, cast(OpCode, op - OPR_EQ + OP_EQ), 1, e1, e2); - break; - } - case OPR_NE: case OPR_GT: case OPR_GE: { - codecomp(fs, cast(OpCode, op - OPR_NE + OP_EQ), 0, e1, e2); - break; - } - default: lua_assert(0); - } -} - - -void luaK_fixline (FuncState *fs, int line) { - fs->f->lineinfo[fs->pc - 1] = line; -} - - -void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) { - int c = (nelems - 1)/LFIELDS_PER_FLUSH + 1; - int b = (tostore == LUA_MULTRET) ? 0 : tostore; - lua_assert(tostore != 0); - if (c <= MAXARG_C) - luaK_codeABC(fs, OP_SETLIST, base, b, c); - else if (c <= MAXARG_Ax) { - luaK_codeABC(fs, OP_SETLIST, base, b, 0); - codeextraarg(fs, c); - } - else - luaX_syntaxerror(fs->ls, "constructor too long"); - fs->freereg = base + 1; /* free registers with list values */ -} - diff --git a/ext/lua/src/lcorolib.c b/ext/lua/src/lcorolib.c deleted file mode 100644 index ce4f6ad42c..0000000000 --- a/ext/lua/src/lcorolib.c +++ /dev/null @@ -1,155 +0,0 @@ -/* -** $Id: lcorolib.c,v 1.5.1.1 2013/04/12 18:48:47 roberto Exp $ -** Coroutine Library -** See Copyright Notice in lua.h -*/ - - -#include - - -#define lcorolib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -static int auxresume (lua_State *L, lua_State *co, int narg) { - int status; - if (!lua_checkstack(co, narg)) { - lua_pushliteral(L, "too many arguments to resume"); - return -1; /* error flag */ - } - if (lua_status(co) == LUA_OK && lua_gettop(co) == 0) { - lua_pushliteral(L, "cannot resume dead coroutine"); - return -1; /* error flag */ - } - lua_xmove(L, co, narg); - status = lua_resume(co, L, narg); - if (status == LUA_OK || status == LUA_YIELD) { - int nres = lua_gettop(co); - if (!lua_checkstack(L, nres + 1)) { - lua_pop(co, nres); /* remove results anyway */ - lua_pushliteral(L, "too many results to resume"); - return -1; /* error flag */ - } - lua_xmove(co, L, nres); /* move yielded values */ - return nres; - } - else { - lua_xmove(co, L, 1); /* move error message */ - return -1; /* error flag */ - } -} - - -static int luaB_coresume (lua_State *L) { - lua_State *co = lua_tothread(L, 1); - int r; - luaL_argcheck(L, co, 1, "coroutine expected"); - r = auxresume(L, co, lua_gettop(L) - 1); - if (r < 0) { - lua_pushboolean(L, 0); - lua_insert(L, -2); - return 2; /* return false + error message */ - } - else { - lua_pushboolean(L, 1); - lua_insert(L, -(r + 1)); - return r + 1; /* return true + `resume' returns */ - } -} - - -static int luaB_auxwrap (lua_State *L) { - lua_State *co = lua_tothread(L, lua_upvalueindex(1)); - int r = auxresume(L, co, lua_gettop(L)); - if (r < 0) { - if (lua_isstring(L, -1)) { /* error object is a string? */ - luaL_where(L, 1); /* add extra info */ - lua_insert(L, -2); - lua_concat(L, 2); - } - return lua_error(L); /* propagate error */ - } - return r; -} - - -static int luaB_cocreate (lua_State *L) { - lua_State *NL; - luaL_checktype(L, 1, LUA_TFUNCTION); - NL = lua_newthread(L); - lua_pushvalue(L, 1); /* move function to top */ - lua_xmove(L, NL, 1); /* move function from L to NL */ - return 1; -} - - -static int luaB_cowrap (lua_State *L) { - luaB_cocreate(L); - lua_pushcclosure(L, luaB_auxwrap, 1); - return 1; -} - - -static int luaB_yield (lua_State *L) { - return lua_yield(L, lua_gettop(L)); -} - - -static int luaB_costatus (lua_State *L) { - lua_State *co = lua_tothread(L, 1); - luaL_argcheck(L, co, 1, "coroutine expected"); - if (L == co) lua_pushliteral(L, "running"); - else { - switch (lua_status(co)) { - case LUA_YIELD: - lua_pushliteral(L, "suspended"); - break; - case LUA_OK: { - lua_Debug ar; - if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */ - lua_pushliteral(L, "normal"); /* it is running */ - else if (lua_gettop(co) == 0) - lua_pushliteral(L, "dead"); - else - lua_pushliteral(L, "suspended"); /* initial state */ - break; - } - default: /* some error occurred */ - lua_pushliteral(L, "dead"); - break; - } - } - return 1; -} - - -static int luaB_corunning (lua_State *L) { - int ismain = lua_pushthread(L); - lua_pushboolean(L, ismain); - return 2; -} - - -static const luaL_Reg co_funcs[] = { - {"create", luaB_cocreate}, - {"resume", luaB_coresume}, - {"running", luaB_corunning}, - {"status", luaB_costatus}, - {"wrap", luaB_cowrap}, - {"yield", luaB_yield}, - {NULL, NULL} -}; - - - -LUAMOD_API int luaopen_coroutine (lua_State *L) { - luaL_newlib(L, co_funcs); - return 1; -} - diff --git a/ext/lua/src/lctype.c b/ext/lua/src/lctype.c deleted file mode 100644 index 93f8cadc39..0000000000 --- a/ext/lua/src/lctype.c +++ /dev/null @@ -1,52 +0,0 @@ -/* -** $Id: lctype.c,v 1.11.1.1 2013/04/12 18:48:47 roberto Exp $ -** 'ctype' functions for Lua -** See Copyright Notice in lua.h -*/ - -#define lctype_c -#define LUA_CORE - -#include "lctype.h" - -#if !LUA_USE_CTYPE /* { */ - -#include - -LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = { - 0x00, /* EOZ */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */ - 0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */ - 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, - 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */ - 0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, - 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */ - 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, - 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */ - 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05, - 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */ - 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, - 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */ - 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 8. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 9. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* a. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* b. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* c. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* d. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* e. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* f. */ - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, -}; - -#endif /* } */ diff --git a/ext/lua/src/ldblib.c b/ext/lua/src/ldblib.c deleted file mode 100644 index 84fe3c7d82..0000000000 --- a/ext/lua/src/ldblib.c +++ /dev/null @@ -1,398 +0,0 @@ -/* -** $Id: ldblib.c,v 1.132.1.1 2013/04/12 18:48:47 roberto Exp $ -** Interface from Lua to its debug API -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include - -#define ldblib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -#define HOOKKEY "_HKEY" - - - -static int db_getregistry (lua_State *L) { - lua_pushvalue(L, LUA_REGISTRYINDEX); - return 1; -} - - -static int db_getmetatable (lua_State *L) { - luaL_checkany(L, 1); - if (!lua_getmetatable(L, 1)) { - lua_pushnil(L); /* no metatable */ - } - return 1; -} - - -static int db_setmetatable (lua_State *L) { - int t = lua_type(L, 2); - luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, - "nil or table expected"); - lua_settop(L, 2); - lua_setmetatable(L, 1); - return 1; /* return 1st argument */ -} - - -static int db_getuservalue (lua_State *L) { - if (lua_type(L, 1) != LUA_TUSERDATA) - lua_pushnil(L); - else - lua_getuservalue(L, 1); - return 1; -} - - -static int db_setuservalue (lua_State *L) { - if (lua_type(L, 1) == LUA_TLIGHTUSERDATA) - luaL_argerror(L, 1, "full userdata expected, got light userdata"); - luaL_checktype(L, 1, LUA_TUSERDATA); - if (!lua_isnoneornil(L, 2)) - luaL_checktype(L, 2, LUA_TTABLE); - lua_settop(L, 2); - lua_setuservalue(L, 1); - return 1; -} - - -static void settabss (lua_State *L, const char *i, const char *v) { - lua_pushstring(L, v); - lua_setfield(L, -2, i); -} - - -static void settabsi (lua_State *L, const char *i, int v) { - lua_pushinteger(L, v); - lua_setfield(L, -2, i); -} - - -static void settabsb (lua_State *L, const char *i, int v) { - lua_pushboolean(L, v); - lua_setfield(L, -2, i); -} - - -static lua_State *getthread (lua_State *L, int *arg) { - if (lua_isthread(L, 1)) { - *arg = 1; - return lua_tothread(L, 1); - } - else { - *arg = 0; - return L; - } -} - - -static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) { - if (L == L1) { - lua_pushvalue(L, -2); - lua_remove(L, -3); - } - else - lua_xmove(L1, L, 1); - lua_setfield(L, -2, fname); -} - - -static int db_getinfo (lua_State *L) { - lua_Debug ar; - int arg; - lua_State *L1 = getthread(L, &arg); - const char *options = luaL_optstring(L, arg+2, "flnStu"); - if (lua_isnumber(L, arg+1)) { - if (!lua_getstack(L1, (int)lua_tointeger(L, arg+1), &ar)) { - lua_pushnil(L); /* level out of range */ - return 1; - } - } - else if (lua_isfunction(L, arg+1)) { - lua_pushfstring(L, ">%s", options); - options = lua_tostring(L, -1); - lua_pushvalue(L, arg+1); - lua_xmove(L, L1, 1); - } - else - return luaL_argerror(L, arg+1, "function or level expected"); - if (!lua_getinfo(L1, options, &ar)) - return luaL_argerror(L, arg+2, "invalid option"); - lua_createtable(L, 0, 2); - if (strchr(options, 'S')) { - settabss(L, "source", ar.source); - settabss(L, "short_src", ar.short_src); - settabsi(L, "linedefined", ar.linedefined); - settabsi(L, "lastlinedefined", ar.lastlinedefined); - settabss(L, "what", ar.what); - } - if (strchr(options, 'l')) - settabsi(L, "currentline", ar.currentline); - if (strchr(options, 'u')) { - settabsi(L, "nups", ar.nups); - settabsi(L, "nparams", ar.nparams); - settabsb(L, "isvararg", ar.isvararg); - } - if (strchr(options, 'n')) { - settabss(L, "name", ar.name); - settabss(L, "namewhat", ar.namewhat); - } - if (strchr(options, 't')) - settabsb(L, "istailcall", ar.istailcall); - if (strchr(options, 'L')) - treatstackoption(L, L1, "activelines"); - if (strchr(options, 'f')) - treatstackoption(L, L1, "func"); - return 1; /* return table */ -} - - -static int db_getlocal (lua_State *L) { - int arg; - lua_State *L1 = getthread(L, &arg); - lua_Debug ar; - const char *name; - int nvar = luaL_checkint(L, arg+2); /* local-variable index */ - if (lua_isfunction(L, arg + 1)) { /* function argument? */ - lua_pushvalue(L, arg + 1); /* push function */ - lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */ - return 1; - } - else { /* stack-level argument */ - if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */ - return luaL_argerror(L, arg+1, "level out of range"); - name = lua_getlocal(L1, &ar, nvar); - if (name) { - lua_xmove(L1, L, 1); /* push local value */ - lua_pushstring(L, name); /* push name */ - lua_pushvalue(L, -2); /* re-order */ - return 2; - } - else { - lua_pushnil(L); /* no name (nor value) */ - return 1; - } - } -} - - -static int db_setlocal (lua_State *L) { - int arg; - lua_State *L1 = getthread(L, &arg); - lua_Debug ar; - if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */ - return luaL_argerror(L, arg+1, "level out of range"); - luaL_checkany(L, arg+3); - lua_settop(L, arg+3); - lua_xmove(L, L1, 1); - lua_pushstring(L, lua_setlocal(L1, &ar, luaL_checkint(L, arg+2))); - return 1; -} - - -static int auxupvalue (lua_State *L, int get) { - const char *name; - int n = luaL_checkint(L, 2); - luaL_checktype(L, 1, LUA_TFUNCTION); - name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n); - if (name == NULL) return 0; - lua_pushstring(L, name); - lua_insert(L, -(get+1)); - return get + 1; -} - - -static int db_getupvalue (lua_State *L) { - return auxupvalue(L, 1); -} - - -static int db_setupvalue (lua_State *L) { - luaL_checkany(L, 3); - return auxupvalue(L, 0); -} - - -static int checkupval (lua_State *L, int argf, int argnup) { - lua_Debug ar; - int nup = luaL_checkint(L, argnup); - luaL_checktype(L, argf, LUA_TFUNCTION); - lua_pushvalue(L, argf); - lua_getinfo(L, ">u", &ar); - luaL_argcheck(L, 1 <= nup && nup <= ar.nups, argnup, "invalid upvalue index"); - return nup; -} - - -static int db_upvalueid (lua_State *L) { - int n = checkupval(L, 1, 2); - lua_pushlightuserdata(L, lua_upvalueid(L, 1, n)); - return 1; -} - - -static int db_upvaluejoin (lua_State *L) { - int n1 = checkupval(L, 1, 2); - int n2 = checkupval(L, 3, 4); - luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected"); - luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected"); - lua_upvaluejoin(L, 1, n1, 3, n2); - return 0; -} - - -#define gethooktable(L) luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY) - - -static void hookf (lua_State *L, lua_Debug *ar) { - static const char *const hooknames[] = - {"call", "return", "line", "count", "tail call"}; - gethooktable(L); - lua_pushthread(L); - lua_rawget(L, -2); - if (lua_isfunction(L, -1)) { - lua_pushstring(L, hooknames[(int)ar->event]); - if (ar->currentline >= 0) - lua_pushinteger(L, ar->currentline); - else lua_pushnil(L); - lua_assert(lua_getinfo(L, "lS", ar)); - lua_call(L, 2, 0); - } -} - - -static int makemask (const char *smask, int count) { - int mask = 0; - if (strchr(smask, 'c')) mask |= LUA_MASKCALL; - if (strchr(smask, 'r')) mask |= LUA_MASKRET; - if (strchr(smask, 'l')) mask |= LUA_MASKLINE; - if (count > 0) mask |= LUA_MASKCOUNT; - return mask; -} - - -static char *unmakemask (int mask, char *smask) { - int i = 0; - if (mask & LUA_MASKCALL) smask[i++] = 'c'; - if (mask & LUA_MASKRET) smask[i++] = 'r'; - if (mask & LUA_MASKLINE) smask[i++] = 'l'; - smask[i] = '\0'; - return smask; -} - - -static int db_sethook (lua_State *L) { - int arg, mask, count; - lua_Hook func; - lua_State *L1 = getthread(L, &arg); - if (lua_isnoneornil(L, arg+1)) { - lua_settop(L, arg+1); - func = NULL; mask = 0; count = 0; /* turn off hooks */ - } - else { - const char *smask = luaL_checkstring(L, arg+2); - luaL_checktype(L, arg+1, LUA_TFUNCTION); - count = luaL_optint(L, arg+3, 0); - func = hookf; mask = makemask(smask, count); - } - if (gethooktable(L) == 0) { /* creating hook table? */ - lua_pushstring(L, "k"); - lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */ - lua_pushvalue(L, -1); - lua_setmetatable(L, -2); /* setmetatable(hooktable) = hooktable */ - } - lua_pushthread(L1); lua_xmove(L1, L, 1); - lua_pushvalue(L, arg+1); - lua_rawset(L, -3); /* set new hook */ - lua_sethook(L1, func, mask, count); /* set hooks */ - return 0; -} - - -static int db_gethook (lua_State *L) { - int arg; - lua_State *L1 = getthread(L, &arg); - char buff[5]; - int mask = lua_gethookmask(L1); - lua_Hook hook = lua_gethook(L1); - if (hook != NULL && hook != hookf) /* external hook? */ - lua_pushliteral(L, "external hook"); - else { - gethooktable(L); - lua_pushthread(L1); lua_xmove(L1, L, 1); - lua_rawget(L, -2); /* get hook */ - lua_remove(L, -2); /* remove hook table */ - } - lua_pushstring(L, unmakemask(mask, buff)); - lua_pushinteger(L, lua_gethookcount(L1)); - return 3; -} - - -static int db_debug (lua_State *L) { - for (;;) { - char buffer[250]; - luai_writestringerror("%s", "lua_debug> "); - if (fgets(buffer, sizeof(buffer), stdin) == 0 || - strcmp(buffer, "cont\n") == 0) - return 0; - if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") || - lua_pcall(L, 0, 0, 0)) - luai_writestringerror("%s\n", lua_tostring(L, -1)); - lua_settop(L, 0); /* remove eventual returns */ - } -} - - -static int db_traceback (lua_State *L) { - int arg; - lua_State *L1 = getthread(L, &arg); - const char *msg = lua_tostring(L, arg + 1); - if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */ - lua_pushvalue(L, arg + 1); /* return it untouched */ - else { - int level = luaL_optint(L, arg + 2, (L == L1) ? 1 : 0); - luaL_traceback(L, L1, msg, level); - } - return 1; -} - - -static const luaL_Reg dblib[] = { - {"debug", db_debug}, - {"getuservalue", db_getuservalue}, - {"gethook", db_gethook}, - {"getinfo", db_getinfo}, - {"getlocal", db_getlocal}, - {"getregistry", db_getregistry}, - {"getmetatable", db_getmetatable}, - {"getupvalue", db_getupvalue}, - {"upvaluejoin", db_upvaluejoin}, - {"upvalueid", db_upvalueid}, - {"setuservalue", db_setuservalue}, - {"sethook", db_sethook}, - {"setlocal", db_setlocal}, - {"setmetatable", db_setmetatable}, - {"setupvalue", db_setupvalue}, - {"traceback", db_traceback}, - {NULL, NULL} -}; - - -LUAMOD_API int luaopen_debug (lua_State *L) { - luaL_newlib(L, dblib); - return 1; -} - diff --git a/ext/lua/src/ldebug.c b/ext/lua/src/ldebug.c deleted file mode 100644 index 20d663efff..0000000000 --- a/ext/lua/src/ldebug.c +++ /dev/null @@ -1,593 +0,0 @@ -/* -** $Id: ldebug.c,v 2.90.1.3 2013/05/16 16:04:15 roberto Exp $ -** Debug Interface -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include - - -#define ldebug_c -#define LUA_CORE - -#include "lua.h" - -#include "lapi.h" -#include "lcode.h" -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" -#include "lvm.h" - - - -#define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_TCCL) - - -static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name); - - -static int currentpc (CallInfo *ci) { - lua_assert(isLua(ci)); - return pcRel(ci->u.l.savedpc, ci_func(ci)->p); -} - - -static int currentline (CallInfo *ci) { - return getfuncline(ci_func(ci)->p, currentpc(ci)); -} - - -/* -** this function can be called asynchronous (e.g. during a signal) -*/ -LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) { - if (func == NULL || mask == 0) { /* turn off hooks? */ - mask = 0; - func = NULL; - } - if (isLua(L->ci)) - L->oldpc = L->ci->u.l.savedpc; - L->hook = func; - L->basehookcount = count; - resethookcount(L); - L->hookmask = cast_byte(mask); - return 1; -} - - -LUA_API lua_Hook lua_gethook (lua_State *L) { - return L->hook; -} - - -LUA_API int lua_gethookmask (lua_State *L) { - return L->hookmask; -} - - -LUA_API int lua_gethookcount (lua_State *L) { - return L->basehookcount; -} - - -LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { - int status; - CallInfo *ci; - if (level < 0) return 0; /* invalid (negative) level */ - lua_lock(L); - for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous) - level--; - if (level == 0 && ci != &L->base_ci) { /* level found? */ - status = 1; - ar->i_ci = ci; - } - else status = 0; /* no such level */ - lua_unlock(L); - return status; -} - - -static const char *upvalname (Proto *p, int uv) { - TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name); - if (s == NULL) return "?"; - else return getstr(s); -} - - -static const char *findvararg (CallInfo *ci, int n, StkId *pos) { - int nparams = clLvalue(ci->func)->p->numparams; - if (n >= ci->u.l.base - ci->func - nparams) - return NULL; /* no such vararg */ - else { - *pos = ci->func + nparams + n; - return "(*vararg)"; /* generic name for any vararg */ - } -} - - -static const char *findlocal (lua_State *L, CallInfo *ci, int n, - StkId *pos) { - const char *name = NULL; - StkId base; - if (isLua(ci)) { - if (n < 0) /* access to vararg values? */ - return findvararg(ci, -n, pos); - else { - base = ci->u.l.base; - name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci)); - } - } - else - base = ci->func + 1; - if (name == NULL) { /* no 'standard' name? */ - StkId limit = (ci == L->ci) ? L->top : ci->next->func; - if (limit - base >= n && n > 0) /* is 'n' inside 'ci' stack? */ - name = "(*temporary)"; /* generic name for any valid slot */ - else - return NULL; /* no name */ - } - *pos = base + (n - 1); - return name; -} - - -LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) { - const char *name; - lua_lock(L); - if (ar == NULL) { /* information about non-active function? */ - if (!isLfunction(L->top - 1)) /* not a Lua function? */ - name = NULL; - else /* consider live variables at function start (parameters) */ - name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0); - } - else { /* active function; get information through 'ar' */ - StkId pos = 0; /* to avoid warnings */ - name = findlocal(L, ar->i_ci, n, &pos); - if (name) { - setobj2s(L, L->top, pos); - api_incr_top(L); - } - } - lua_unlock(L); - return name; -} - - -LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { - StkId pos = 0; /* to avoid warnings */ - const char *name = findlocal(L, ar->i_ci, n, &pos); - lua_lock(L); - if (name) - setobjs2s(L, pos, L->top - 1); - L->top--; /* pop value */ - lua_unlock(L); - return name; -} - - -static void funcinfo (lua_Debug *ar, Closure *cl) { - if (noLuaClosure(cl)) { - ar->source = "=[C]"; - ar->linedefined = -1; - ar->lastlinedefined = -1; - ar->what = "C"; - } - else { - Proto *p = cl->l.p; - ar->source = p->source ? getstr(p->source) : "=?"; - ar->linedefined = p->linedefined; - ar->lastlinedefined = p->lastlinedefined; - ar->what = (ar->linedefined == 0) ? "main" : "Lua"; - } - luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); -} - - -static void collectvalidlines (lua_State *L, Closure *f) { - if (noLuaClosure(f)) { - setnilvalue(L->top); - api_incr_top(L); - } - else { - int i; - TValue v; - int *lineinfo = f->l.p->lineinfo; - Table *t = luaH_new(L); /* new table to store active lines */ - sethvalue(L, L->top, t); /* push it on stack */ - api_incr_top(L); - setbvalue(&v, 1); /* boolean 'true' to be the value of all indices */ - for (i = 0; i < f->l.p->sizelineinfo; i++) /* for all lines with code */ - luaH_setint(L, t, lineinfo[i], &v); /* table[line] = true */ - } -} - - -static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, - Closure *f, CallInfo *ci) { - int status = 1; - for (; *what; what++) { - switch (*what) { - case 'S': { - funcinfo(ar, f); - break; - } - case 'l': { - ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1; - break; - } - case 'u': { - ar->nups = (f == NULL) ? 0 : f->c.nupvalues; - if (noLuaClosure(f)) { - ar->isvararg = 1; - ar->nparams = 0; - } - else { - ar->isvararg = f->l.p->is_vararg; - ar->nparams = f->l.p->numparams; - } - break; - } - case 't': { - ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0; - break; - } - case 'n': { - /* calling function is a known Lua function? */ - if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous)) - ar->namewhat = getfuncname(L, ci->previous, &ar->name); - else - ar->namewhat = NULL; - if (ar->namewhat == NULL) { - ar->namewhat = ""; /* not found */ - ar->name = NULL; - } - break; - } - case 'L': - case 'f': /* handled by lua_getinfo */ - break; - default: status = 0; /* invalid option */ - } - } - return status; -} - - -LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { - int status; - Closure *cl; - CallInfo *ci; - StkId func; - lua_lock(L); - if (*what == '>') { - ci = NULL; - func = L->top - 1; - api_check(L, ttisfunction(func), "function expected"); - what++; /* skip the '>' */ - L->top--; /* pop function */ - } - else { - ci = ar->i_ci; - func = ci->func; - lua_assert(ttisfunction(ci->func)); - } - cl = ttisclosure(func) ? clvalue(func) : NULL; - status = auxgetinfo(L, what, ar, cl, ci); - if (strchr(what, 'f')) { - setobjs2s(L, L->top, func); - api_incr_top(L); - } - if (strchr(what, 'L')) - collectvalidlines(L, cl); - lua_unlock(L); - return status; -} - - -/* -** {====================================================== -** Symbolic Execution -** ======================================================= -*/ - -static const char *getobjname (Proto *p, int lastpc, int reg, - const char **name); - - -/* -** find a "name" for the RK value 'c' -*/ -static void kname (Proto *p, int pc, int c, const char **name) { - if (ISK(c)) { /* is 'c' a constant? */ - TValue *kvalue = &p->k[INDEXK(c)]; - if (ttisstring(kvalue)) { /* literal constant? */ - *name = svalue(kvalue); /* it is its own name */ - return; - } - /* else no reasonable name found */ - } - else { /* 'c' is a register */ - const char *what = getobjname(p, pc, c, name); /* search for 'c' */ - if (what && *what == 'c') { /* found a constant name? */ - return; /* 'name' already filled */ - } - /* else no reasonable name found */ - } - *name = "?"; /* no reasonable name found */ -} - - -static int filterpc (int pc, int jmptarget) { - if (pc < jmptarget) /* is code conditional (inside a jump)? */ - return -1; /* cannot know who sets that register */ - else return pc; /* current position sets that register */ -} - - -/* -** try to find last instruction before 'lastpc' that modified register 'reg' -*/ -static int findsetreg (Proto *p, int lastpc, int reg) { - int pc; - int setreg = -1; /* keep last instruction that changed 'reg' */ - int jmptarget = 0; /* any code before this address is conditional */ - for (pc = 0; pc < lastpc; pc++) { - Instruction i = p->code[pc]; - OpCode op = GET_OPCODE(i); - int a = GETARG_A(i); - switch (op) { - case OP_LOADNIL: { - int b = GETARG_B(i); - if (a <= reg && reg <= a + b) /* set registers from 'a' to 'a+b' */ - setreg = filterpc(pc, jmptarget); - break; - } - case OP_TFORCALL: { - if (reg >= a + 2) /* affect all regs above its base */ - setreg = filterpc(pc, jmptarget); - break; - } - case OP_CALL: - case OP_TAILCALL: { - if (reg >= a) /* affect all registers above base */ - setreg = filterpc(pc, jmptarget); - break; - } - case OP_JMP: { - int b = GETARG_sBx(i); - int dest = pc + 1 + b; - /* jump is forward and do not skip `lastpc'? */ - if (pc < dest && dest <= lastpc) { - if (dest > jmptarget) - jmptarget = dest; /* update 'jmptarget' */ - } - break; - } - case OP_TEST: { - if (reg == a) /* jumped code can change 'a' */ - setreg = filterpc(pc, jmptarget); - break; - } - default: - if (testAMode(op) && reg == a) /* any instruction that set A */ - setreg = filterpc(pc, jmptarget); - break; - } - } - return setreg; -} - - -static const char *getobjname (Proto *p, int lastpc, int reg, - const char **name) { - int pc; - *name = luaF_getlocalname(p, reg + 1, lastpc); - if (*name) /* is a local? */ - return "local"; - /* else try symbolic execution */ - pc = findsetreg(p, lastpc, reg); - if (pc != -1) { /* could find instruction? */ - Instruction i = p->code[pc]; - OpCode op = GET_OPCODE(i); - switch (op) { - case OP_MOVE: { - int b = GETARG_B(i); /* move from 'b' to 'a' */ - if (b < GETARG_A(i)) - return getobjname(p, pc, b, name); /* get name for 'b' */ - break; - } - case OP_GETTABUP: - case OP_GETTABLE: { - int k = GETARG_C(i); /* key index */ - int t = GETARG_B(i); /* table index */ - const char *vn = (op == OP_GETTABLE) /* name of indexed variable */ - ? luaF_getlocalname(p, t + 1, pc) - : upvalname(p, t); - kname(p, pc, k, name); - return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field"; - } - case OP_GETUPVAL: { - *name = upvalname(p, GETARG_B(i)); - return "upvalue"; - } - case OP_LOADK: - case OP_LOADKX: { - int b = (op == OP_LOADK) ? GETARG_Bx(i) - : GETARG_Ax(p->code[pc + 1]); - if (ttisstring(&p->k[b])) { - *name = svalue(&p->k[b]); - return "constant"; - } - break; - } - case OP_SELF: { - int k = GETARG_C(i); /* key index */ - kname(p, pc, k, name); - return "method"; - } - default: break; /* go through to return NULL */ - } - } - return NULL; /* could not find reasonable name */ -} - - -static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) { - TMS tm; - Proto *p = ci_func(ci)->p; /* calling function */ - int pc = currentpc(ci); /* calling instruction index */ - Instruction i = p->code[pc]; /* calling instruction */ - switch (GET_OPCODE(i)) { - case OP_CALL: - case OP_TAILCALL: /* get function name */ - return getobjname(p, pc, GETARG_A(i), name); - case OP_TFORCALL: { /* for iterator */ - *name = "for iterator"; - return "for iterator"; - } - /* all other instructions can call only through metamethods */ - case OP_SELF: - case OP_GETTABUP: - case OP_GETTABLE: tm = TM_INDEX; break; - case OP_SETTABUP: - case OP_SETTABLE: tm = TM_NEWINDEX; break; - case OP_EQ: tm = TM_EQ; break; - case OP_ADD: tm = TM_ADD; break; - case OP_SUB: tm = TM_SUB; break; - case OP_MUL: tm = TM_MUL; break; - case OP_DIV: tm = TM_DIV; break; - case OP_MOD: tm = TM_MOD; break; - case OP_POW: tm = TM_POW; break; - case OP_UNM: tm = TM_UNM; break; - case OP_LEN: tm = TM_LEN; break; - case OP_LT: tm = TM_LT; break; - case OP_LE: tm = TM_LE; break; - case OP_CONCAT: tm = TM_CONCAT; break; - default: - return NULL; /* else no useful name can be found */ - } - *name = getstr(G(L)->tmname[tm]); - return "metamethod"; -} - -/* }====================================================== */ - - - -/* -** only ANSI way to check whether a pointer points to an array -** (used only for error messages, so efficiency is not a big concern) -*/ -static int isinstack (CallInfo *ci, const TValue *o) { - StkId p; - for (p = ci->u.l.base; p < ci->top; p++) - if (o == p) return 1; - return 0; -} - - -static const char *getupvalname (CallInfo *ci, const TValue *o, - const char **name) { - LClosure *c = ci_func(ci); - int i; - for (i = 0; i < c->nupvalues; i++) { - if (c->upvals[i]->v == o) { - *name = upvalname(c->p, i); - return "upvalue"; - } - } - return NULL; -} - - -l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) { - CallInfo *ci = L->ci; - const char *name = NULL; - const char *t = objtypename(o); - const char *kind = NULL; - if (isLua(ci)) { - kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */ - if (!kind && isinstack(ci, o)) /* no? try a register */ - kind = getobjname(ci_func(ci)->p, currentpc(ci), - cast_int(o - ci->u.l.base), &name); - } - if (kind) - luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)", - op, kind, name, t); - else - luaG_runerror(L, "attempt to %s a %s value", op, t); -} - - -l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2) { - if (ttisstring(p1) || ttisnumber(p1)) p1 = p2; - lua_assert(!ttisstring(p1) && !ttisnumber(p1)); - luaG_typeerror(L, p1, "concatenate"); -} - - -l_noret luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) { - TValue temp; - if (luaV_tonumber(p1, &temp) == NULL) - p2 = p1; /* first operand is wrong */ - luaG_typeerror(L, p2, "perform arithmetic on"); -} - - -l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) { - const char *t1 = objtypename(p1); - const char *t2 = objtypename(p2); - if (t1 == t2) - luaG_runerror(L, "attempt to compare two %s values", t1); - else - luaG_runerror(L, "attempt to compare %s with %s", t1, t2); -} - - -static void addinfo (lua_State *L, const char *msg) { - CallInfo *ci = L->ci; - if (isLua(ci)) { /* is Lua code? */ - char buff[LUA_IDSIZE]; /* add file:line information */ - int line = currentline(ci); - TString *src = ci_func(ci)->p->source; - if (src) - luaO_chunkid(buff, getstr(src), LUA_IDSIZE); - else { /* no source available; use "?" instead */ - buff[0] = '?'; buff[1] = '\0'; - } - luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); - } -} - - -l_noret luaG_errormsg (lua_State *L) { - if (L->errfunc != 0) { /* is there an error handling function? */ - StkId errfunc = restorestack(L, L->errfunc); - if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR); - setobjs2s(L, L->top, L->top - 1); /* move argument */ - setobjs2s(L, L->top - 1, errfunc); /* push function */ - L->top++; - luaD_call(L, L->top - 2, 1, 0); /* call it */ - } - luaD_throw(L, LUA_ERRRUN); -} - - -l_noret luaG_runerror (lua_State *L, const char *fmt, ...) { - va_list argp; - va_start(argp, fmt); - addinfo(L, luaO_pushvfstring(L, fmt, argp)); - va_end(argp); - luaG_errormsg(L); -} - diff --git a/ext/lua/src/ldo.c b/ext/lua/src/ldo.c deleted file mode 100644 index e9dd5fa951..0000000000 --- a/ext/lua/src/ldo.c +++ /dev/null @@ -1,681 +0,0 @@ -/* -** $Id: ldo.c,v 2.108.1.3 2013/11/08 18:22:50 roberto Exp $ -** Stack and Call structure of Lua -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include - -#define ldo_c -#define LUA_CORE - -#include "lua.h" - -#include "lapi.h" -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lgc.h" -#include "lmem.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lparser.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" -#include "lundump.h" -#include "lvm.h" -#include "lzio.h" - - - - -/* -** {====================================================== -** Error-recovery functions -** ======================================================= -*/ - -/* -** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By -** default, Lua handles errors with exceptions when compiling as -** C++ code, with _longjmp/_setjmp when asked to use them, and with -** longjmp/setjmp otherwise. -*/ -#if !defined(LUAI_THROW) - -#if defined(__cplusplus) && !defined(LUA_USE_LONGJMP) -/* C++ exceptions */ -#define LUAI_THROW(L,c) throw(c) -#define LUAI_TRY(L,c,a) \ - try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; } -#define luai_jmpbuf int /* dummy variable */ - -#elif defined(LUA_USE_ULONGJMP) -/* in Unix, try _longjmp/_setjmp (more efficient) */ -#define LUAI_THROW(L,c) _longjmp((c)->b, 1) -#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a } -#define luai_jmpbuf jmp_buf - -#else -/* default handling with long jumps */ -#define LUAI_THROW(L,c) longjmp((c)->b, 1) -#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a } -#define luai_jmpbuf jmp_buf - -#endif - -#endif - - - -/* chain list of long jump buffers */ -struct lua_longjmp { - struct lua_longjmp *previous; - luai_jmpbuf b; - volatile int status; /* error code */ -}; - - -static void seterrorobj (lua_State *L, int errcode, StkId oldtop) { - switch (errcode) { - case LUA_ERRMEM: { /* memory error? */ - setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */ - break; - } - case LUA_ERRERR: { - setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling")); - break; - } - default: { - setobjs2s(L, oldtop, L->top - 1); /* error message on current top */ - break; - } - } - L->top = oldtop + 1; -} - - -l_noret luaD_throw (lua_State *L, int errcode) { - if (L->errorJmp) { /* thread has an error handler? */ - L->errorJmp->status = errcode; /* set status */ - LUAI_THROW(L, L->errorJmp); /* jump to it */ - } - else { /* thread has no error handler */ - L->status = cast_byte(errcode); /* mark it as dead */ - if (G(L)->mainthread->errorJmp) { /* main thread has a handler? */ - setobjs2s(L, G(L)->mainthread->top++, L->top - 1); /* copy error obj. */ - luaD_throw(G(L)->mainthread, errcode); /* re-throw in main thread */ - } - else { /* no handler at all; abort */ - if (G(L)->panic) { /* panic function? */ - lua_unlock(L); - G(L)->panic(L); /* call it (last chance to jump out) */ - } - abort(); - } - } -} - - -int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { - unsigned short oldnCcalls = L->nCcalls; - struct lua_longjmp lj; - lj.status = LUA_OK; - lj.previous = L->errorJmp; /* chain new error handler */ - L->errorJmp = &lj; - LUAI_TRY(L, &lj, - (*f)(L, ud); - ); - L->errorJmp = lj.previous; /* restore old error handler */ - L->nCcalls = oldnCcalls; - return lj.status; -} - -/* }====================================================== */ - - -static void correctstack (lua_State *L, TValue *oldstack) { - CallInfo *ci; - GCObject *up; - L->top = (L->top - oldstack) + L->stack; - for (up = L->openupval; up != NULL; up = up->gch.next) - gco2uv(up)->v = (gco2uv(up)->v - oldstack) + L->stack; - for (ci = L->ci; ci != NULL; ci = ci->previous) { - ci->top = (ci->top - oldstack) + L->stack; - ci->func = (ci->func - oldstack) + L->stack; - if (isLua(ci)) - ci->u.l.base = (ci->u.l.base - oldstack) + L->stack; - } -} - - -/* some space for error handling */ -#define ERRORSTACKSIZE (LUAI_MAXSTACK + 200) - - -void luaD_reallocstack (lua_State *L, int newsize) { - TValue *oldstack = L->stack; - int lim = L->stacksize; - lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE); - lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK); - luaM_reallocvector(L, L->stack, L->stacksize, newsize, TValue); - for (; lim < newsize; lim++) - setnilvalue(L->stack + lim); /* erase new segment */ - L->stacksize = newsize; - L->stack_last = L->stack + newsize - EXTRA_STACK; - correctstack(L, oldstack); -} - - -void luaD_growstack (lua_State *L, int n) { - int size = L->stacksize; - if (size > LUAI_MAXSTACK) /* error after extra size? */ - luaD_throw(L, LUA_ERRERR); - else { - int needed = cast_int(L->top - L->stack) + n + EXTRA_STACK; - int newsize = 2 * size; - if (newsize > LUAI_MAXSTACK) newsize = LUAI_MAXSTACK; - if (newsize < needed) newsize = needed; - if (newsize > LUAI_MAXSTACK) { /* stack overflow? */ - luaD_reallocstack(L, ERRORSTACKSIZE); - luaG_runerror(L, "stack overflow"); - } - else - luaD_reallocstack(L, newsize); - } -} - - -static int stackinuse (lua_State *L) { - CallInfo *ci; - StkId lim = L->top; - for (ci = L->ci; ci != NULL; ci = ci->previous) { - lua_assert(ci->top <= L->stack_last); - if (lim < ci->top) lim = ci->top; - } - return cast_int(lim - L->stack) + 1; /* part of stack in use */ -} - - -void luaD_shrinkstack (lua_State *L) { - int inuse = stackinuse(L); - int goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK; - if (goodsize > LUAI_MAXSTACK) goodsize = LUAI_MAXSTACK; - if (inuse > LUAI_MAXSTACK || /* handling stack overflow? */ - goodsize >= L->stacksize) /* would grow instead of shrink? */ - condmovestack(L); /* don't change stack (change only for debugging) */ - else - luaD_reallocstack(L, goodsize); /* shrink it */ -} - - -void luaD_hook (lua_State *L, int event, int line) { - lua_Hook hook = L->hook; - if (hook && L->allowhook) { - CallInfo *ci = L->ci; - ptrdiff_t top = savestack(L, L->top); - ptrdiff_t ci_top = savestack(L, ci->top); - lua_Debug ar; - ar.event = event; - ar.currentline = line; - ar.i_ci = ci; - luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ - ci->top = L->top + LUA_MINSTACK; - lua_assert(ci->top <= L->stack_last); - L->allowhook = 0; /* cannot call hooks inside a hook */ - ci->callstatus |= CIST_HOOKED; - lua_unlock(L); - (*hook)(L, &ar); - lua_lock(L); - lua_assert(!L->allowhook); - L->allowhook = 1; - ci->top = restorestack(L, ci_top); - L->top = restorestack(L, top); - ci->callstatus &= ~CIST_HOOKED; - } -} - - -static void callhook (lua_State *L, CallInfo *ci) { - int hook = LUA_HOOKCALL; - ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */ - if (isLua(ci->previous) && - GET_OPCODE(*(ci->previous->u.l.savedpc - 1)) == OP_TAILCALL) { - ci->callstatus |= CIST_TAIL; - hook = LUA_HOOKTAILCALL; - } - luaD_hook(L, hook, -1); - ci->u.l.savedpc--; /* correct 'pc' */ -} - - -static StkId adjust_varargs (lua_State *L, Proto *p, int actual) { - int i; - int nfixargs = p->numparams; - StkId base, fixed; - lua_assert(actual >= nfixargs); - /* move fixed parameters to final position */ - luaD_checkstack(L, p->maxstacksize); /* check again for new 'base' */ - fixed = L->top - actual; /* first fixed argument */ - base = L->top; /* final position of first argument */ - for (i=0; itop++, fixed + i); - setnilvalue(fixed + i); - } - return base; -} - - -static StkId tryfuncTM (lua_State *L, StkId func) { - const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL); - StkId p; - ptrdiff_t funcr = savestack(L, func); - if (!ttisfunction(tm)) - luaG_typeerror(L, func, "call"); - /* Open a hole inside the stack at `func' */ - for (p = L->top; p > func; p--) setobjs2s(L, p, p-1); - incr_top(L); - func = restorestack(L, funcr); /* previous call may change stack */ - setobj2s(L, func, tm); /* tag method is the new function to be called */ - return func; -} - - - -#define next_ci(L) (L->ci = (L->ci->next ? L->ci->next : luaE_extendCI(L))) - - -/* -** returns true if function has been executed (C function) -*/ -int luaD_precall (lua_State *L, StkId func, int nresults) { - lua_CFunction f; - CallInfo *ci; - int n; /* number of arguments (Lua) or returns (C) */ - ptrdiff_t funcr = savestack(L, func); - switch (ttype(func)) { - case LUA_TLCF: /* light C function */ - f = fvalue(func); - goto Cfunc; - case LUA_TCCL: { /* C closure */ - f = clCvalue(func)->f; - Cfunc: - luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ - ci = next_ci(L); /* now 'enter' new function */ - ci->nresults = nresults; - ci->func = restorestack(L, funcr); - ci->top = L->top + LUA_MINSTACK; - lua_assert(ci->top <= L->stack_last); - ci->callstatus = 0; - luaC_checkGC(L); /* stack grow uses memory */ - if (L->hookmask & LUA_MASKCALL) - luaD_hook(L, LUA_HOOKCALL, -1); - lua_unlock(L); - n = (*f)(L); /* do the actual call */ - lua_lock(L); - api_checknelems(L, n); - luaD_poscall(L, L->top - n); - return 1; - } - case LUA_TLCL: { /* Lua function: prepare its call */ - StkId base; - Proto *p = clLvalue(func)->p; - n = cast_int(L->top - func) - 1; /* number of real arguments */ - luaD_checkstack(L, p->maxstacksize); - for (; n < p->numparams; n++) - setnilvalue(L->top++); /* complete missing arguments */ - if (!p->is_vararg) { - func = restorestack(L, funcr); - base = func + 1; - } - else { - base = adjust_varargs(L, p, n); - func = restorestack(L, funcr); /* previous call can change stack */ - } - ci = next_ci(L); /* now 'enter' new function */ - ci->nresults = nresults; - ci->func = func; - ci->u.l.base = base; - ci->top = base + p->maxstacksize; - lua_assert(ci->top <= L->stack_last); - ci->u.l.savedpc = p->code; /* starting point */ - ci->callstatus = CIST_LUA; - L->top = ci->top; - luaC_checkGC(L); /* stack grow uses memory */ - if (L->hookmask & LUA_MASKCALL) - callhook(L, ci); - return 0; - } - default: { /* not a function */ - func = tryfuncTM(L, func); /* retry with 'function' tag method */ - return luaD_precall(L, func, nresults); /* now it must be a function */ - } - } -} - - -int luaD_poscall (lua_State *L, StkId firstResult) { - StkId res; - int wanted, i; - CallInfo *ci = L->ci; - if (L->hookmask & (LUA_MASKRET | LUA_MASKLINE)) { - if (L->hookmask & LUA_MASKRET) { - ptrdiff_t fr = savestack(L, firstResult); /* hook may change stack */ - luaD_hook(L, LUA_HOOKRET, -1); - firstResult = restorestack(L, fr); - } - L->oldpc = ci->previous->u.l.savedpc; /* 'oldpc' for caller function */ - } - res = ci->func; /* res == final position of 1st result */ - wanted = ci->nresults; - L->ci = ci = ci->previous; /* back to caller */ - /* move results to correct place */ - for (i = wanted; i != 0 && firstResult < L->top; i--) - setobjs2s(L, res++, firstResult++); - while (i-- > 0) - setnilvalue(res++); - L->top = res; - return (wanted - LUA_MULTRET); /* 0 iff wanted == LUA_MULTRET */ -} - - -/* -** Call a function (C or Lua). The function to be called is at *func. -** The arguments are on the stack, right after the function. -** When returns, all the results are on the stack, starting at the original -** function position. -*/ -void luaD_call (lua_State *L, StkId func, int nResults, int allowyield) { - if (++L->nCcalls >= LUAI_MAXCCALLS) { - if (L->nCcalls == LUAI_MAXCCALLS) - luaG_runerror(L, "C stack overflow"); - else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3))) - luaD_throw(L, LUA_ERRERR); /* error while handing stack error */ - } - if (!allowyield) L->nny++; - if (!luaD_precall(L, func, nResults)) /* is a Lua function? */ - luaV_execute(L); /* call it */ - if (!allowyield) L->nny--; - L->nCcalls--; -} - - -static void finishCcall (lua_State *L) { - CallInfo *ci = L->ci; - int n; - lua_assert(ci->u.c.k != NULL); /* must have a continuation */ - lua_assert(L->nny == 0); - if (ci->callstatus & CIST_YPCALL) { /* was inside a pcall? */ - ci->callstatus &= ~CIST_YPCALL; /* finish 'lua_pcall' */ - L->errfunc = ci->u.c.old_errfunc; - } - /* finish 'lua_callk'/'lua_pcall' */ - adjustresults(L, ci->nresults); - /* call continuation function */ - if (!(ci->callstatus & CIST_STAT)) /* no call status? */ - ci->u.c.status = LUA_YIELD; /* 'default' status */ - lua_assert(ci->u.c.status != LUA_OK); - ci->callstatus = (ci->callstatus & ~(CIST_YPCALL | CIST_STAT)) | CIST_YIELDED; - lua_unlock(L); - n = (*ci->u.c.k)(L); - lua_lock(L); - api_checknelems(L, n); - /* finish 'luaD_precall' */ - luaD_poscall(L, L->top - n); -} - - -static void unroll (lua_State *L, void *ud) { - UNUSED(ud); - for (;;) { - if (L->ci == &L->base_ci) /* stack is empty? */ - return; /* coroutine finished normally */ - if (!isLua(L->ci)) /* C function? */ - finishCcall(L); - else { /* Lua function */ - luaV_finishOp(L); /* finish interrupted instruction */ - luaV_execute(L); /* execute down to higher C 'boundary' */ - } - } -} - - -/* -** check whether thread has a suspended protected call -*/ -static CallInfo *findpcall (lua_State *L) { - CallInfo *ci; - for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */ - if (ci->callstatus & CIST_YPCALL) - return ci; - } - return NULL; /* no pending pcall */ -} - - -static int recover (lua_State *L, int status) { - StkId oldtop; - CallInfo *ci = findpcall(L); - if (ci == NULL) return 0; /* no recovery point */ - /* "finish" luaD_pcall */ - oldtop = restorestack(L, ci->extra); - luaF_close(L, oldtop); - seterrorobj(L, status, oldtop); - L->ci = ci; - L->allowhook = ci->u.c.old_allowhook; - L->nny = 0; /* should be zero to be yieldable */ - luaD_shrinkstack(L); - L->errfunc = ci->u.c.old_errfunc; - ci->callstatus |= CIST_STAT; /* call has error status */ - ci->u.c.status = status; /* (here it is) */ - return 1; /* continue running the coroutine */ -} - - -/* -** signal an error in the call to 'resume', not in the execution of the -** coroutine itself. (Such errors should not be handled by any coroutine -** error handler and should not kill the coroutine.) -*/ -static l_noret resume_error (lua_State *L, const char *msg, StkId firstArg) { - L->top = firstArg; /* remove args from the stack */ - setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */ - api_incr_top(L); - luaD_throw(L, -1); /* jump back to 'lua_resume' */ -} - - -/* -** do the work for 'lua_resume' in protected mode -*/ -static void resume (lua_State *L, void *ud) { - int nCcalls = L->nCcalls; - StkId firstArg = cast(StkId, ud); - CallInfo *ci = L->ci; - if (nCcalls >= LUAI_MAXCCALLS) - resume_error(L, "C stack overflow", firstArg); - if (L->status == LUA_OK) { /* may be starting a coroutine */ - if (ci != &L->base_ci) /* not in base level? */ - resume_error(L, "cannot resume non-suspended coroutine", firstArg); - /* coroutine is in base level; start running it */ - if (!luaD_precall(L, firstArg - 1, LUA_MULTRET)) /* Lua function? */ - luaV_execute(L); /* call it */ - } - else if (L->status != LUA_YIELD) - resume_error(L, "cannot resume dead coroutine", firstArg); - else { /* resuming from previous yield */ - L->status = LUA_OK; - ci->func = restorestack(L, ci->extra); - if (isLua(ci)) /* yielded inside a hook? */ - luaV_execute(L); /* just continue running Lua code */ - else { /* 'common' yield */ - if (ci->u.c.k != NULL) { /* does it have a continuation? */ - int n; - ci->u.c.status = LUA_YIELD; /* 'default' status */ - ci->callstatus |= CIST_YIELDED; - lua_unlock(L); - n = (*ci->u.c.k)(L); /* call continuation */ - lua_lock(L); - api_checknelems(L, n); - firstArg = L->top - n; /* yield results come from continuation */ - } - luaD_poscall(L, firstArg); /* finish 'luaD_precall' */ - } - unroll(L, NULL); - } - lua_assert(nCcalls == L->nCcalls); -} - - -LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs) { - int status; - int oldnny = L->nny; /* save 'nny' */ - lua_lock(L); - luai_userstateresume(L, nargs); - L->nCcalls = (from) ? from->nCcalls + 1 : 1; - L->nny = 0; /* allow yields */ - api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs); - status = luaD_rawrunprotected(L, resume, L->top - nargs); - if (status == -1) /* error calling 'lua_resume'? */ - status = LUA_ERRRUN; - else { /* yield or regular error */ - while (status != LUA_OK && status != LUA_YIELD) { /* error? */ - if (recover(L, status)) /* recover point? */ - status = luaD_rawrunprotected(L, unroll, NULL); /* run continuation */ - else { /* unrecoverable error */ - L->status = cast_byte(status); /* mark thread as `dead' */ - seterrorobj(L, status, L->top); - L->ci->top = L->top; - break; - } - } - lua_assert(status == L->status); - } - L->nny = oldnny; /* restore 'nny' */ - L->nCcalls--; - lua_assert(L->nCcalls == ((from) ? from->nCcalls : 0)); - lua_unlock(L); - return status; -} - - -LUA_API int lua_yieldk (lua_State *L, int nresults, int ctx, lua_CFunction k) { - CallInfo *ci = L->ci; - luai_userstateyield(L, nresults); - lua_lock(L); - api_checknelems(L, nresults); - if (L->nny > 0) { - if (L != G(L)->mainthread) - luaG_runerror(L, "attempt to yield across a C-call boundary"); - else - luaG_runerror(L, "attempt to yield from outside a coroutine"); - } - L->status = LUA_YIELD; - ci->extra = savestack(L, ci->func); /* save current 'func' */ - if (isLua(ci)) { /* inside a hook? */ - api_check(L, k == NULL, "hooks cannot continue after yielding"); - } - else { - if ((ci->u.c.k = k) != NULL) /* is there a continuation? */ - ci->u.c.ctx = ctx; /* save context */ - ci->func = L->top - nresults - 1; /* protect stack below results */ - luaD_throw(L, LUA_YIELD); - } - lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */ - lua_unlock(L); - return 0; /* return to 'luaD_hook' */ -} - - -int luaD_pcall (lua_State *L, Pfunc func, void *u, - ptrdiff_t old_top, ptrdiff_t ef) { - int status; - CallInfo *old_ci = L->ci; - lu_byte old_allowhooks = L->allowhook; - unsigned short old_nny = L->nny; - ptrdiff_t old_errfunc = L->errfunc; - L->errfunc = ef; - status = luaD_rawrunprotected(L, func, u); - if (status != LUA_OK) { /* an error occurred? */ - StkId oldtop = restorestack(L, old_top); - luaF_close(L, oldtop); /* close possible pending closures */ - seterrorobj(L, status, oldtop); - L->ci = old_ci; - L->allowhook = old_allowhooks; - L->nny = old_nny; - luaD_shrinkstack(L); - } - L->errfunc = old_errfunc; - return status; -} - - - -/* -** Execute a protected parser. -*/ -struct SParser { /* data to `f_parser' */ - ZIO *z; - Mbuffer buff; /* dynamic structure used by the scanner */ - Dyndata dyd; /* dynamic structures used by the parser */ - const char *mode; - const char *name; -}; - - -static void checkmode (lua_State *L, const char *mode, const char *x) { - if (mode && strchr(mode, x[0]) == NULL) { - luaO_pushfstring(L, - "attempt to load a %s chunk (mode is " LUA_QS ")", x, mode); - luaD_throw(L, LUA_ERRSYNTAX); - } -} - - -static void f_parser (lua_State *L, void *ud) { - int i; - Closure *cl; - struct SParser *p = cast(struct SParser *, ud); - int c = zgetc(p->z); /* read first character */ - if (c == LUA_SIGNATURE[0]) { - checkmode(L, p->mode, "binary"); - cl = luaU_undump(L, p->z, &p->buff, p->name); - } - else { - checkmode(L, p->mode, "text"); - cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c); - } - lua_assert(cl->l.nupvalues == cl->l.p->sizeupvalues); - for (i = 0; i < cl->l.nupvalues; i++) { /* initialize upvalues */ - UpVal *up = luaF_newupval(L); - cl->l.upvals[i] = up; - luaC_objbarrier(L, cl, up); - } -} - - -int luaD_protectedparser (lua_State *L, ZIO *z, const char *name, - const char *mode) { - struct SParser p; - int status; - L->nny++; /* cannot yield during parsing */ - p.z = z; p.name = name; p.mode = mode; - p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0; - p.dyd.gt.arr = NULL; p.dyd.gt.size = 0; - p.dyd.label.arr = NULL; p.dyd.label.size = 0; - luaZ_initbuffer(L, &p.buff); - status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc); - luaZ_freebuffer(L, &p.buff); - luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size); - luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size); - luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size); - L->nny--; - return status; -} - - diff --git a/ext/lua/src/ldump.c b/ext/lua/src/ldump.c deleted file mode 100644 index 61fa2cd892..0000000000 --- a/ext/lua/src/ldump.c +++ /dev/null @@ -1,173 +0,0 @@ -/* -** $Id: ldump.c,v 2.17.1.1 2013/04/12 18:48:47 roberto Exp $ -** save precompiled Lua chunks -** See Copyright Notice in lua.h -*/ - -#include - -#define ldump_c -#define LUA_CORE - -#include "lua.h" - -#include "lobject.h" -#include "lstate.h" -#include "lundump.h" - -typedef struct { - lua_State* L; - lua_Writer writer; - void* data; - int strip; - int status; -} DumpState; - -#define DumpMem(b,n,size,D) DumpBlock(b,(n)*(size),D) -#define DumpVar(x,D) DumpMem(&x,1,sizeof(x),D) - -static void DumpBlock(const void* b, size_t size, DumpState* D) -{ - if (D->status==0) - { - lua_unlock(D->L); - D->status=(*D->writer)(D->L,b,size,D->data); - lua_lock(D->L); - } -} - -static void DumpChar(int y, DumpState* D) -{ - char x=(char)y; - DumpVar(x,D); -} - -static void DumpInt(int x, DumpState* D) -{ - DumpVar(x,D); -} - -static void DumpNumber(lua_Number x, DumpState* D) -{ - DumpVar(x,D); -} - -static void DumpVector(const void* b, int n, size_t size, DumpState* D) -{ - DumpInt(n,D); - DumpMem(b,n,size,D); -} - -static void DumpString(const TString* s, DumpState* D) -{ - if (s==NULL) - { - size_t size=0; - DumpVar(size,D); - } - else - { - size_t size=s->tsv.len+1; /* include trailing '\0' */ - DumpVar(size,D); - DumpBlock(getstr(s),size*sizeof(char),D); - } -} - -#define DumpCode(f,D) DumpVector(f->code,f->sizecode,sizeof(Instruction),D) - -static void DumpFunction(const Proto* f, DumpState* D); - -static void DumpConstants(const Proto* f, DumpState* D) -{ - int i,n=f->sizek; - DumpInt(n,D); - for (i=0; ik[i]; - DumpChar(ttypenv(o),D); - switch (ttypenv(o)) - { - case LUA_TNIL: - break; - case LUA_TBOOLEAN: - DumpChar(bvalue(o),D); - break; - case LUA_TNUMBER: - DumpNumber(nvalue(o),D); - break; - case LUA_TSTRING: - DumpString(rawtsvalue(o),D); - break; - default: lua_assert(0); - } - } - n=f->sizep; - DumpInt(n,D); - for (i=0; ip[i],D); -} - -static void DumpUpvalues(const Proto* f, DumpState* D) -{ - int i,n=f->sizeupvalues; - DumpInt(n,D); - for (i=0; iupvalues[i].instack,D); - DumpChar(f->upvalues[i].idx,D); - } -} - -static void DumpDebug(const Proto* f, DumpState* D) -{ - int i,n; - DumpString((D->strip) ? NULL : f->source,D); - n= (D->strip) ? 0 : f->sizelineinfo; - DumpVector(f->lineinfo,n,sizeof(int),D); - n= (D->strip) ? 0 : f->sizelocvars; - DumpInt(n,D); - for (i=0; ilocvars[i].varname,D); - DumpInt(f->locvars[i].startpc,D); - DumpInt(f->locvars[i].endpc,D); - } - n= (D->strip) ? 0 : f->sizeupvalues; - DumpInt(n,D); - for (i=0; iupvalues[i].name,D); -} - -static void DumpFunction(const Proto* f, DumpState* D) -{ - DumpInt(f->linedefined,D); - DumpInt(f->lastlinedefined,D); - DumpChar(f->numparams,D); - DumpChar(f->is_vararg,D); - DumpChar(f->maxstacksize,D); - DumpCode(f,D); - DumpConstants(f,D); - DumpUpvalues(f,D); - DumpDebug(f,D); -} - -static void DumpHeader(DumpState* D) -{ - lu_byte h[LUAC_HEADERSIZE]; - luaU_header(h); - DumpBlock(h,LUAC_HEADERSIZE,D); -} - -/* -** dump Lua function as precompiled chunk -*/ -int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip) -{ - DumpState D; - D.L=L; - D.writer=w; - D.data=data; - D.strip=strip; - D.status=0; - DumpHeader(&D); - DumpFunction(f,&D); - return D.status; -} diff --git a/ext/lua/src/lfunc.c b/ext/lua/src/lfunc.c deleted file mode 100644 index e90e1520ce..0000000000 --- a/ext/lua/src/lfunc.c +++ /dev/null @@ -1,161 +0,0 @@ -/* -** $Id: lfunc.c,v 2.30.1.1 2013/04/12 18:48:47 roberto Exp $ -** Auxiliary functions to manipulate prototypes and closures -** See Copyright Notice in lua.h -*/ - - -#include - -#define lfunc_c -#define LUA_CORE - -#include "lua.h" - -#include "lfunc.h" -#include "lgc.h" -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" - - - -Closure *luaF_newCclosure (lua_State *L, int n) { - Closure *c = &luaC_newobj(L, LUA_TCCL, sizeCclosure(n), NULL, 0)->cl; - c->c.nupvalues = cast_byte(n); - return c; -} - - -Closure *luaF_newLclosure (lua_State *L, int n) { - Closure *c = &luaC_newobj(L, LUA_TLCL, sizeLclosure(n), NULL, 0)->cl; - c->l.p = NULL; - c->l.nupvalues = cast_byte(n); - while (n--) c->l.upvals[n] = NULL; - return c; -} - - -UpVal *luaF_newupval (lua_State *L) { - UpVal *uv = &luaC_newobj(L, LUA_TUPVAL, sizeof(UpVal), NULL, 0)->uv; - uv->v = &uv->u.value; - setnilvalue(uv->v); - return uv; -} - - -UpVal *luaF_findupval (lua_State *L, StkId level) { - global_State *g = G(L); - GCObject **pp = &L->openupval; - UpVal *p; - UpVal *uv; - while (*pp != NULL && (p = gco2uv(*pp))->v >= level) { - GCObject *o = obj2gco(p); - lua_assert(p->v != &p->u.value); - lua_assert(!isold(o) || isold(obj2gco(L))); - if (p->v == level) { /* found a corresponding upvalue? */ - if (isdead(g, o)) /* is it dead? */ - changewhite(o); /* resurrect it */ - return p; - } - pp = &p->next; - } - /* not found: create a new one */ - uv = &luaC_newobj(L, LUA_TUPVAL, sizeof(UpVal), pp, 0)->uv; - uv->v = level; /* current value lives in the stack */ - uv->u.l.prev = &g->uvhead; /* double link it in `uvhead' list */ - uv->u.l.next = g->uvhead.u.l.next; - uv->u.l.next->u.l.prev = uv; - g->uvhead.u.l.next = uv; - lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv); - return uv; -} - - -static void unlinkupval (UpVal *uv) { - lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv); - uv->u.l.next->u.l.prev = uv->u.l.prev; /* remove from `uvhead' list */ - uv->u.l.prev->u.l.next = uv->u.l.next; -} - - -void luaF_freeupval (lua_State *L, UpVal *uv) { - if (uv->v != &uv->u.value) /* is it open? */ - unlinkupval(uv); /* remove from open list */ - luaM_free(L, uv); /* free upvalue */ -} - - -void luaF_close (lua_State *L, StkId level) { - UpVal *uv; - global_State *g = G(L); - while (L->openupval != NULL && (uv = gco2uv(L->openupval))->v >= level) { - GCObject *o = obj2gco(uv); - lua_assert(!isblack(o) && uv->v != &uv->u.value); - L->openupval = uv->next; /* remove from `open' list */ - if (isdead(g, o)) - luaF_freeupval(L, uv); /* free upvalue */ - else { - unlinkupval(uv); /* remove upvalue from 'uvhead' list */ - setobj(L, &uv->u.value, uv->v); /* move value to upvalue slot */ - uv->v = &uv->u.value; /* now current value lives here */ - gch(o)->next = g->allgc; /* link upvalue into 'allgc' list */ - g->allgc = o; - luaC_checkupvalcolor(g, uv); - } - } -} - - -Proto *luaF_newproto (lua_State *L) { - Proto *f = &luaC_newobj(L, LUA_TPROTO, sizeof(Proto), NULL, 0)->p; - f->k = NULL; - f->sizek = 0; - f->p = NULL; - f->sizep = 0; - f->code = NULL; - f->cache = NULL; - f->sizecode = 0; - f->lineinfo = NULL; - f->sizelineinfo = 0; - f->upvalues = NULL; - f->sizeupvalues = 0; - f->numparams = 0; - f->is_vararg = 0; - f->maxstacksize = 0; - f->locvars = NULL; - f->sizelocvars = 0; - f->linedefined = 0; - f->lastlinedefined = 0; - f->source = NULL; - return f; -} - - -void luaF_freeproto (lua_State *L, Proto *f) { - luaM_freearray(L, f->code, f->sizecode); - luaM_freearray(L, f->p, f->sizep); - luaM_freearray(L, f->k, f->sizek); - luaM_freearray(L, f->lineinfo, f->sizelineinfo); - luaM_freearray(L, f->locvars, f->sizelocvars); - luaM_freearray(L, f->upvalues, f->sizeupvalues); - luaM_free(L, f); -} - - -/* -** Look for n-th local variable at line `line' in function `func'. -** Returns NULL if not found. -*/ -const char *luaF_getlocalname (const Proto *f, int local_number, int pc) { - int i; - for (i = 0; isizelocvars && f->locvars[i].startpc <= pc; i++) { - if (pc < f->locvars[i].endpc) { /* is variable active? */ - local_number--; - if (local_number == 0) - return getstr(f->locvars[i].varname); - } - } - return NULL; /* not found */ -} - diff --git a/ext/lua/src/lgc.c b/ext/lua/src/lgc.c deleted file mode 100644 index 52460dcdd5..0000000000 --- a/ext/lua/src/lgc.c +++ /dev/null @@ -1,1220 +0,0 @@ -/* -** $Id: lgc.c,v 2.140.1.2 2013/04/26 18:22:05 roberto Exp $ -** Garbage Collector -** See Copyright Notice in lua.h -*/ - -#include - -#define lgc_c -#define LUA_CORE - -#include "lua.h" - -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lgc.h" -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" - - - -/* -** cost of sweeping one element (the size of a small object divided -** by some adjust for the sweep speed) -*/ -#define GCSWEEPCOST ((sizeof(TString) + 4) / 4) - -/* maximum number of elements to sweep in each single step */ -#define GCSWEEPMAX (cast_int((GCSTEPSIZE / GCSWEEPCOST) / 4)) - -/* maximum number of finalizers to call in each GC step */ -#define GCFINALIZENUM 4 - - -/* -** macro to adjust 'stepmul': 'stepmul' is actually used like -** 'stepmul / STEPMULADJ' (value chosen by tests) -*/ -#define STEPMULADJ 200 - - -/* -** macro to adjust 'pause': 'pause' is actually used like -** 'pause / PAUSEADJ' (value chosen by tests) -*/ -#define PAUSEADJ 100 - - -/* -** 'makewhite' erases all color bits plus the old bit and then -** sets only the current white bit -*/ -#define maskcolors (~(bit2mask(BLACKBIT, OLDBIT) | WHITEBITS)) -#define makewhite(g,x) \ - (gch(x)->marked = cast_byte((gch(x)->marked & maskcolors) | luaC_white(g))) - -#define white2gray(x) resetbits(gch(x)->marked, WHITEBITS) -#define black2gray(x) resetbit(gch(x)->marked, BLACKBIT) - - -#define isfinalized(x) testbit(gch(x)->marked, FINALIZEDBIT) - -#define checkdeadkey(n) lua_assert(!ttisdeadkey(gkey(n)) || ttisnil(gval(n))) - - -#define checkconsistency(obj) \ - lua_longassert(!iscollectable(obj) || righttt(obj)) - - -#define markvalue(g,o) { checkconsistency(o); \ - if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); } - -#define markobject(g,t) { if ((t) && iswhite(obj2gco(t))) \ - reallymarkobject(g, obj2gco(t)); } - -static void reallymarkobject (global_State *g, GCObject *o); - - -/* -** {====================================================== -** Generic functions -** ======================================================= -*/ - - -/* -** one after last element in a hash array -*/ -#define gnodelast(h) gnode(h, cast(size_t, sizenode(h))) - - -/* -** link table 'h' into list pointed by 'p' -*/ -#define linktable(h,p) ((h)->gclist = *(p), *(p) = obj2gco(h)) - - -/* -** if key is not marked, mark its entry as dead (therefore removing it -** from the table) -*/ -static void removeentry (Node *n) { - lua_assert(ttisnil(gval(n))); - if (valiswhite(gkey(n))) - setdeadvalue(gkey(n)); /* unused and unmarked key; remove it */ -} - - -/* -** tells whether a key or value can be cleared from a weak -** table. Non-collectable objects are never removed from weak -** tables. Strings behave as `values', so are never removed too. for -** other objects: if really collected, cannot keep them; for objects -** being finalized, keep them in keys, but not in values -*/ -static int iscleared (global_State *g, const TValue *o) { - if (!iscollectable(o)) return 0; - else if (ttisstring(o)) { - markobject(g, rawtsvalue(o)); /* strings are `values', so are never weak */ - return 0; - } - else return iswhite(gcvalue(o)); -} - - -/* -** barrier that moves collector forward, that is, mark the white object -** being pointed by a black object. -*/ -void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) { - global_State *g = G(L); - lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o)); - lua_assert(g->gcstate != GCSpause); - lua_assert(gch(o)->tt != LUA_TTABLE); - if (keepinvariantout(g)) /* must keep invariant? */ - reallymarkobject(g, v); /* restore invariant */ - else { /* sweep phase */ - lua_assert(issweepphase(g)); - makewhite(g, o); /* mark main obj. as white to avoid other barriers */ - } -} - - -/* -** barrier that moves collector backward, that is, mark the black object -** pointing to a white object as gray again. (Current implementation -** only works for tables; access to 'gclist' is not uniform across -** different types.) -*/ -void luaC_barrierback_ (lua_State *L, GCObject *o) { - global_State *g = G(L); - lua_assert(isblack(o) && !isdead(g, o) && gch(o)->tt == LUA_TTABLE); - black2gray(o); /* make object gray (again) */ - gco2t(o)->gclist = g->grayagain; - g->grayagain = o; -} - - -/* -** barrier for prototypes. When creating first closure (cache is -** NULL), use a forward barrier; this may be the only closure of the -** prototype (if it is a "regular" function, with a single instance) -** and the prototype may be big, so it is better to avoid traversing -** it again. Otherwise, use a backward barrier, to avoid marking all -** possible instances. -*/ -LUAI_FUNC void luaC_barrierproto_ (lua_State *L, Proto *p, Closure *c) { - global_State *g = G(L); - lua_assert(isblack(obj2gco(p))); - if (p->cache == NULL) { /* first time? */ - luaC_objbarrier(L, p, c); - } - else { /* use a backward barrier */ - black2gray(obj2gco(p)); /* make prototype gray (again) */ - p->gclist = g->grayagain; - g->grayagain = obj2gco(p); - } -} - - -/* -** check color (and invariants) for an upvalue that was closed, -** i.e., moved into the 'allgc' list -*/ -void luaC_checkupvalcolor (global_State *g, UpVal *uv) { - GCObject *o = obj2gco(uv); - lua_assert(!isblack(o)); /* open upvalues are never black */ - if (isgray(o)) { - if (keepinvariant(g)) { - resetoldbit(o); /* see MOVE OLD rule */ - gray2black(o); /* it is being visited now */ - markvalue(g, uv->v); - } - else { - lua_assert(issweepphase(g)); - makewhite(g, o); - } - } -} - - -/* -** create a new collectable object (with given type and size) and link -** it to '*list'. 'offset' tells how many bytes to allocate before the -** object itself (used only by states). -*/ -GCObject *luaC_newobj (lua_State *L, int tt, size_t sz, GCObject **list, - int offset) { - global_State *g = G(L); - char *raw = cast(char *, luaM_newobject(L, novariant(tt), sz)); - GCObject *o = obj2gco(raw + offset); - if (list == NULL) - list = &g->allgc; /* standard list for collectable objects */ - gch(o)->marked = luaC_white(g); - gch(o)->tt = tt; - gch(o)->next = *list; - *list = o; - return o; -} - -/* }====================================================== */ - - - -/* -** {====================================================== -** Mark functions -** ======================================================= -*/ - - -/* -** mark an object. Userdata, strings, and closed upvalues are visited -** and turned black here. Other objects are marked gray and added -** to appropriate list to be visited (and turned black) later. (Open -** upvalues are already linked in 'headuv' list.) -*/ -static void reallymarkobject (global_State *g, GCObject *o) { - lu_mem size; - white2gray(o); - switch (gch(o)->tt) { - case LUA_TSHRSTR: - case LUA_TLNGSTR: { - size = sizestring(gco2ts(o)); - break; /* nothing else to mark; make it black */ - } - case LUA_TUSERDATA: { - Table *mt = gco2u(o)->metatable; - markobject(g, mt); - markobject(g, gco2u(o)->env); - size = sizeudata(gco2u(o)); - break; - } - case LUA_TUPVAL: { - UpVal *uv = gco2uv(o); - markvalue(g, uv->v); - if (uv->v != &uv->u.value) /* open? */ - return; /* open upvalues remain gray */ - size = sizeof(UpVal); - break; - } - case LUA_TLCL: { - gco2lcl(o)->gclist = g->gray; - g->gray = o; - return; - } - case LUA_TCCL: { - gco2ccl(o)->gclist = g->gray; - g->gray = o; - return; - } - case LUA_TTABLE: { - linktable(gco2t(o), &g->gray); - return; - } - case LUA_TTHREAD: { - gco2th(o)->gclist = g->gray; - g->gray = o; - return; - } - case LUA_TPROTO: { - gco2p(o)->gclist = g->gray; - g->gray = o; - return; - } - default: lua_assert(0); return; - } - gray2black(o); - g->GCmemtrav += size; -} - - -/* -** mark metamethods for basic types -*/ -static void markmt (global_State *g) { - int i; - for (i=0; i < LUA_NUMTAGS; i++) - markobject(g, g->mt[i]); -} - - -/* -** mark all objects in list of being-finalized -*/ -static void markbeingfnz (global_State *g) { - GCObject *o; - for (o = g->tobefnz; o != NULL; o = gch(o)->next) { - makewhite(g, o); - reallymarkobject(g, o); - } -} - - -/* -** mark all values stored in marked open upvalues. (See comment in -** 'lstate.h'.) -*/ -static void remarkupvals (global_State *g) { - UpVal *uv; - for (uv = g->uvhead.u.l.next; uv != &g->uvhead; uv = uv->u.l.next) { - if (isgray(obj2gco(uv))) - markvalue(g, uv->v); - } -} - - -/* -** mark root set and reset all gray lists, to start a new -** incremental (or full) collection -*/ -static void restartcollection (global_State *g) { - g->gray = g->grayagain = NULL; - g->weak = g->allweak = g->ephemeron = NULL; - markobject(g, g->mainthread); - markvalue(g, &g->l_registry); - markmt(g); - markbeingfnz(g); /* mark any finalizing object left from previous cycle */ -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Traverse functions -** ======================================================= -*/ - -static void traverseweakvalue (global_State *g, Table *h) { - Node *n, *limit = gnodelast(h); - /* if there is array part, assume it may have white values (do not - traverse it just to check) */ - int hasclears = (h->sizearray > 0); - for (n = gnode(h, 0); n < limit; n++) { - checkdeadkey(n); - if (ttisnil(gval(n))) /* entry is empty? */ - removeentry(n); /* remove it */ - else { - lua_assert(!ttisnil(gkey(n))); - markvalue(g, gkey(n)); /* mark key */ - if (!hasclears && iscleared(g, gval(n))) /* is there a white value? */ - hasclears = 1; /* table will have to be cleared */ - } - } - if (hasclears) - linktable(h, &g->weak); /* has to be cleared later */ - else /* no white values */ - linktable(h, &g->grayagain); /* no need to clean */ -} - - -static int traverseephemeron (global_State *g, Table *h) { - int marked = 0; /* true if an object is marked in this traversal */ - int hasclears = 0; /* true if table has white keys */ - int prop = 0; /* true if table has entry "white-key -> white-value" */ - Node *n, *limit = gnodelast(h); - int i; - /* traverse array part (numeric keys are 'strong') */ - for (i = 0; i < h->sizearray; i++) { - if (valiswhite(&h->array[i])) { - marked = 1; - reallymarkobject(g, gcvalue(&h->array[i])); - } - } - /* traverse hash part */ - for (n = gnode(h, 0); n < limit; n++) { - checkdeadkey(n); - if (ttisnil(gval(n))) /* entry is empty? */ - removeentry(n); /* remove it */ - else if (iscleared(g, gkey(n))) { /* key is not marked (yet)? */ - hasclears = 1; /* table must be cleared */ - if (valiswhite(gval(n))) /* value not marked yet? */ - prop = 1; /* must propagate again */ - } - else if (valiswhite(gval(n))) { /* value not marked yet? */ - marked = 1; - reallymarkobject(g, gcvalue(gval(n))); /* mark it now */ - } - } - if (prop) - linktable(h, &g->ephemeron); /* have to propagate again */ - else if (hasclears) /* does table have white keys? */ - linktable(h, &g->allweak); /* may have to clean white keys */ - else /* no white keys */ - linktable(h, &g->grayagain); /* no need to clean */ - return marked; -} - - -static void traversestrongtable (global_State *g, Table *h) { - Node *n, *limit = gnodelast(h); - int i; - for (i = 0; i < h->sizearray; i++) /* traverse array part */ - markvalue(g, &h->array[i]); - for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */ - checkdeadkey(n); - if (ttisnil(gval(n))) /* entry is empty? */ - removeentry(n); /* remove it */ - else { - lua_assert(!ttisnil(gkey(n))); - markvalue(g, gkey(n)); /* mark key */ - markvalue(g, gval(n)); /* mark value */ - } - } -} - - -static lu_mem traversetable (global_State *g, Table *h) { - const char *weakkey, *weakvalue; - const TValue *mode = gfasttm(g, h->metatable, TM_MODE); - markobject(g, h->metatable); - if (mode && ttisstring(mode) && /* is there a weak mode? */ - ((weakkey = strchr(svalue(mode), 'k')), - (weakvalue = strchr(svalue(mode), 'v')), - (weakkey || weakvalue))) { /* is really weak? */ - black2gray(obj2gco(h)); /* keep table gray */ - if (!weakkey) /* strong keys? */ - traverseweakvalue(g, h); - else if (!weakvalue) /* strong values? */ - traverseephemeron(g, h); - else /* all weak */ - linktable(h, &g->allweak); /* nothing to traverse now */ - } - else /* not weak */ - traversestrongtable(g, h); - return sizeof(Table) + sizeof(TValue) * h->sizearray + - sizeof(Node) * cast(size_t, sizenode(h)); -} - - -static int traverseproto (global_State *g, Proto *f) { - int i; - if (f->cache && iswhite(obj2gco(f->cache))) - f->cache = NULL; /* allow cache to be collected */ - markobject(g, f->source); - for (i = 0; i < f->sizek; i++) /* mark literals */ - markvalue(g, &f->k[i]); - for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */ - markobject(g, f->upvalues[i].name); - for (i = 0; i < f->sizep; i++) /* mark nested protos */ - markobject(g, f->p[i]); - for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */ - markobject(g, f->locvars[i].varname); - return sizeof(Proto) + sizeof(Instruction) * f->sizecode + - sizeof(Proto *) * f->sizep + - sizeof(TValue) * f->sizek + - sizeof(int) * f->sizelineinfo + - sizeof(LocVar) * f->sizelocvars + - sizeof(Upvaldesc) * f->sizeupvalues; -} - - -static lu_mem traverseCclosure (global_State *g, CClosure *cl) { - int i; - for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */ - markvalue(g, &cl->upvalue[i]); - return sizeCclosure(cl->nupvalues); -} - -static lu_mem traverseLclosure (global_State *g, LClosure *cl) { - int i; - markobject(g, cl->p); /* mark its prototype */ - for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */ - markobject(g, cl->upvals[i]); - return sizeLclosure(cl->nupvalues); -} - - -static lu_mem traversestack (global_State *g, lua_State *th) { - int n = 0; - StkId o = th->stack; - if (o == NULL) - return 1; /* stack not completely built yet */ - for (; o < th->top; o++) /* mark live elements in the stack */ - markvalue(g, o); - if (g->gcstate == GCSatomic) { /* final traversal? */ - StkId lim = th->stack + th->stacksize; /* real end of stack */ - for (; o < lim; o++) /* clear not-marked stack slice */ - setnilvalue(o); - } - else { /* count call infos to compute size */ - CallInfo *ci; - for (ci = &th->base_ci; ci != th->ci; ci = ci->next) - n++; - } - return sizeof(lua_State) + sizeof(TValue) * th->stacksize + - sizeof(CallInfo) * n; -} - - -/* -** traverse one gray object, turning it to black (except for threads, -** which are always gray). -*/ -static void propagatemark (global_State *g) { - lu_mem size; - GCObject *o = g->gray; - lua_assert(isgray(o)); - gray2black(o); - switch (gch(o)->tt) { - case LUA_TTABLE: { - Table *h = gco2t(o); - g->gray = h->gclist; /* remove from 'gray' list */ - size = traversetable(g, h); - break; - } - case LUA_TLCL: { - LClosure *cl = gco2lcl(o); - g->gray = cl->gclist; /* remove from 'gray' list */ - size = traverseLclosure(g, cl); - break; - } - case LUA_TCCL: { - CClosure *cl = gco2ccl(o); - g->gray = cl->gclist; /* remove from 'gray' list */ - size = traverseCclosure(g, cl); - break; - } - case LUA_TTHREAD: { - lua_State *th = gco2th(o); - g->gray = th->gclist; /* remove from 'gray' list */ - th->gclist = g->grayagain; - g->grayagain = o; /* insert into 'grayagain' list */ - black2gray(o); - size = traversestack(g, th); - break; - } - case LUA_TPROTO: { - Proto *p = gco2p(o); - g->gray = p->gclist; /* remove from 'gray' list */ - size = traverseproto(g, p); - break; - } - default: lua_assert(0); return; - } - g->GCmemtrav += size; -} - - -static void propagateall (global_State *g) { - while (g->gray) propagatemark(g); -} - - -static void propagatelist (global_State *g, GCObject *l) { - lua_assert(g->gray == NULL); /* no grays left */ - g->gray = l; - propagateall(g); /* traverse all elements from 'l' */ -} - -/* -** retraverse all gray lists. Because tables may be reinserted in other -** lists when traversed, traverse the original lists to avoid traversing -** twice the same table (which is not wrong, but inefficient) -*/ -static void retraversegrays (global_State *g) { - GCObject *weak = g->weak; /* save original lists */ - GCObject *grayagain = g->grayagain; - GCObject *ephemeron = g->ephemeron; - g->weak = g->grayagain = g->ephemeron = NULL; - propagateall(g); /* traverse main gray list */ - propagatelist(g, grayagain); - propagatelist(g, weak); - propagatelist(g, ephemeron); -} - - -static void convergeephemerons (global_State *g) { - int changed; - do { - GCObject *w; - GCObject *next = g->ephemeron; /* get ephemeron list */ - g->ephemeron = NULL; /* tables will return to this list when traversed */ - changed = 0; - while ((w = next) != NULL) { - next = gco2t(w)->gclist; - if (traverseephemeron(g, gco2t(w))) { /* traverse marked some value? */ - propagateall(g); /* propagate changes */ - changed = 1; /* will have to revisit all ephemeron tables */ - } - } - } while (changed); -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Sweep Functions -** ======================================================= -*/ - - -/* -** clear entries with unmarked keys from all weaktables in list 'l' up -** to element 'f' -*/ -static void clearkeys (global_State *g, GCObject *l, GCObject *f) { - for (; l != f; l = gco2t(l)->gclist) { - Table *h = gco2t(l); - Node *n, *limit = gnodelast(h); - for (n = gnode(h, 0); n < limit; n++) { - if (!ttisnil(gval(n)) && (iscleared(g, gkey(n)))) { - setnilvalue(gval(n)); /* remove value ... */ - removeentry(n); /* and remove entry from table */ - } - } - } -} - - -/* -** clear entries with unmarked values from all weaktables in list 'l' up -** to element 'f' -*/ -static void clearvalues (global_State *g, GCObject *l, GCObject *f) { - for (; l != f; l = gco2t(l)->gclist) { - Table *h = gco2t(l); - Node *n, *limit = gnodelast(h); - int i; - for (i = 0; i < h->sizearray; i++) { - TValue *o = &h->array[i]; - if (iscleared(g, o)) /* value was collected? */ - setnilvalue(o); /* remove value */ - } - for (n = gnode(h, 0); n < limit; n++) { - if (!ttisnil(gval(n)) && iscleared(g, gval(n))) { - setnilvalue(gval(n)); /* remove value ... */ - removeentry(n); /* and remove entry from table */ - } - } - } -} - - -static void freeobj (lua_State *L, GCObject *o) { - switch (gch(o)->tt) { - case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break; - case LUA_TLCL: { - luaM_freemem(L, o, sizeLclosure(gco2lcl(o)->nupvalues)); - break; - } - case LUA_TCCL: { - luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues)); - break; - } - case LUA_TUPVAL: luaF_freeupval(L, gco2uv(o)); break; - case LUA_TTABLE: luaH_free(L, gco2t(o)); break; - case LUA_TTHREAD: luaE_freethread(L, gco2th(o)); break; - case LUA_TUSERDATA: luaM_freemem(L, o, sizeudata(gco2u(o))); break; - case LUA_TSHRSTR: - G(L)->strt.nuse--; - /* go through */ - case LUA_TLNGSTR: { - luaM_freemem(L, o, sizestring(gco2ts(o))); - break; - } - default: lua_assert(0); - } -} - - -#define sweepwholelist(L,p) sweeplist(L,p,MAX_LUMEM) -static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count); - - -/* -** sweep the (open) upvalues of a thread and resize its stack and -** list of call-info structures. -*/ -static void sweepthread (lua_State *L, lua_State *L1) { - if (L1->stack == NULL) return; /* stack not completely built yet */ - sweepwholelist(L, &L1->openupval); /* sweep open upvalues */ - luaE_freeCI(L1); /* free extra CallInfo slots */ - /* should not change the stack during an emergency gc cycle */ - if (G(L)->gckind != KGC_EMERGENCY) - luaD_shrinkstack(L1); -} - - -/* -** sweep at most 'count' elements from a list of GCObjects erasing dead -** objects, where a dead (not alive) object is one marked with the "old" -** (non current) white and not fixed. -** In non-generational mode, change all non-dead objects back to white, -** preparing for next collection cycle. -** In generational mode, keep black objects black, and also mark them as -** old; stop when hitting an old object, as all objects after that -** one will be old too. -** When object is a thread, sweep its list of open upvalues too. -*/ -static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) { - global_State *g = G(L); - int ow = otherwhite(g); - int toclear, toset; /* bits to clear and to set in all live objects */ - int tostop; /* stop sweep when this is true */ - if (isgenerational(g)) { /* generational mode? */ - toclear = ~0; /* clear nothing */ - toset = bitmask(OLDBIT); /* set the old bit of all surviving objects */ - tostop = bitmask(OLDBIT); /* do not sweep old generation */ - } - else { /* normal mode */ - toclear = maskcolors; /* clear all color bits + old bit */ - toset = luaC_white(g); /* make object white */ - tostop = 0; /* do not stop */ - } - while (*p != NULL && count-- > 0) { - GCObject *curr = *p; - int marked = gch(curr)->marked; - if (isdeadm(ow, marked)) { /* is 'curr' dead? */ - *p = gch(curr)->next; /* remove 'curr' from list */ - freeobj(L, curr); /* erase 'curr' */ - } - else { - if (testbits(marked, tostop)) - return NULL; /* stop sweeping this list */ - if (gch(curr)->tt == LUA_TTHREAD) - sweepthread(L, gco2th(curr)); /* sweep thread's upvalues */ - /* update marks */ - gch(curr)->marked = cast_byte((marked & toclear) | toset); - p = &gch(curr)->next; /* go to next element */ - } - } - return (*p == NULL) ? NULL : p; -} - - -/* -** sweep a list until a live object (or end of list) -*/ -static GCObject **sweeptolive (lua_State *L, GCObject **p, int *n) { - GCObject ** old = p; - int i = 0; - do { - i++; - p = sweeplist(L, p, 1); - } while (p == old); - if (n) *n += i; - return p; -} - -/* }====================================================== */ - - -/* -** {====================================================== -** Finalization -** ======================================================= -*/ - -static void checkSizes (lua_State *L) { - global_State *g = G(L); - if (g->gckind != KGC_EMERGENCY) { /* do not change sizes in emergency */ - int hs = g->strt.size / 2; /* half the size of the string table */ - if (g->strt.nuse < cast(lu_int32, hs)) /* using less than that half? */ - luaS_resize(L, hs); /* halve its size */ - luaZ_freebuffer(L, &g->buff); /* free concatenation buffer */ - } -} - - -static GCObject *udata2finalize (global_State *g) { - GCObject *o = g->tobefnz; /* get first element */ - lua_assert(isfinalized(o)); - g->tobefnz = gch(o)->next; /* remove it from 'tobefnz' list */ - gch(o)->next = g->allgc; /* return it to 'allgc' list */ - g->allgc = o; - resetbit(gch(o)->marked, SEPARATED); /* mark that it is not in 'tobefnz' */ - lua_assert(!isold(o)); /* see MOVE OLD rule */ - if (!keepinvariantout(g)) /* not keeping invariant? */ - makewhite(g, o); /* "sweep" object */ - return o; -} - - -static void dothecall (lua_State *L, void *ud) { - UNUSED(ud); - luaD_call(L, L->top - 2, 0, 0); -} - - -static void GCTM (lua_State *L, int propagateerrors) { - global_State *g = G(L); - const TValue *tm; - TValue v; - setgcovalue(L, &v, udata2finalize(g)); - tm = luaT_gettmbyobj(L, &v, TM_GC); - if (tm != NULL && ttisfunction(tm)) { /* is there a finalizer? */ - int status; - lu_byte oldah = L->allowhook; - int running = g->gcrunning; - L->allowhook = 0; /* stop debug hooks during GC metamethod */ - g->gcrunning = 0; /* avoid GC steps */ - setobj2s(L, L->top, tm); /* push finalizer... */ - setobj2s(L, L->top + 1, &v); /* ... and its argument */ - L->top += 2; /* and (next line) call the finalizer */ - status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0); - L->allowhook = oldah; /* restore hooks */ - g->gcrunning = running; /* restore state */ - if (status != LUA_OK && propagateerrors) { /* error while running __gc? */ - if (status == LUA_ERRRUN) { /* is there an error object? */ - const char *msg = (ttisstring(L->top - 1)) - ? svalue(L->top - 1) - : "no message"; - luaO_pushfstring(L, "error in __gc metamethod (%s)", msg); - status = LUA_ERRGCMM; /* error in __gc metamethod */ - } - luaD_throw(L, status); /* re-throw error */ - } - } -} - - -/* -** move all unreachable objects (or 'all' objects) that need -** finalization from list 'finobj' to list 'tobefnz' (to be finalized) -*/ -static void separatetobefnz (lua_State *L, int all) { - global_State *g = G(L); - GCObject **p = &g->finobj; - GCObject *curr; - GCObject **lastnext = &g->tobefnz; - /* find last 'next' field in 'tobefnz' list (to add elements in its end) */ - while (*lastnext != NULL) - lastnext = &gch(*lastnext)->next; - while ((curr = *p) != NULL) { /* traverse all finalizable objects */ - lua_assert(!isfinalized(curr)); - lua_assert(testbit(gch(curr)->marked, SEPARATED)); - if (!(iswhite(curr) || all)) /* not being collected? */ - p = &gch(curr)->next; /* don't bother with it */ - else { - l_setbit(gch(curr)->marked, FINALIZEDBIT); /* won't be finalized again */ - *p = gch(curr)->next; /* remove 'curr' from 'finobj' list */ - gch(curr)->next = *lastnext; /* link at the end of 'tobefnz' list */ - *lastnext = curr; - lastnext = &gch(curr)->next; - } - } -} - - -/* -** if object 'o' has a finalizer, remove it from 'allgc' list (must -** search the list to find it) and link it in 'finobj' list. -*/ -void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) { - global_State *g = G(L); - if (testbit(gch(o)->marked, SEPARATED) || /* obj. is already separated... */ - isfinalized(o) || /* ... or is finalized... */ - gfasttm(g, mt, TM_GC) == NULL) /* or has no finalizer? */ - return; /* nothing to be done */ - else { /* move 'o' to 'finobj' list */ - GCObject **p; - GCheader *ho = gch(o); - if (g->sweepgc == &ho->next) { /* avoid removing current sweep object */ - lua_assert(issweepphase(g)); - g->sweepgc = sweeptolive(L, g->sweepgc, NULL); - } - /* search for pointer pointing to 'o' */ - for (p = &g->allgc; *p != o; p = &gch(*p)->next) { /* empty */ } - *p = ho->next; /* remove 'o' from root list */ - ho->next = g->finobj; /* link it in list 'finobj' */ - g->finobj = o; - l_setbit(ho->marked, SEPARATED); /* mark it as such */ - if (!keepinvariantout(g)) /* not keeping invariant? */ - makewhite(g, o); /* "sweep" object */ - else - resetoldbit(o); /* see MOVE OLD rule */ - } -} - -/* }====================================================== */ - - -/* -** {====================================================== -** GC control -** ======================================================= -*/ - - -/* -** set a reasonable "time" to wait before starting a new GC cycle; -** cycle will start when memory use hits threshold -*/ -static void setpause (global_State *g, l_mem estimate) { - l_mem debt, threshold; - estimate = estimate / PAUSEADJ; /* adjust 'estimate' */ - threshold = (g->gcpause < MAX_LMEM / estimate) /* overflow? */ - ? estimate * g->gcpause /* no overflow */ - : MAX_LMEM; /* overflow; truncate to maximum */ - debt = -cast(l_mem, threshold - gettotalbytes(g)); - luaE_setdebt(g, debt); -} - - -#define sweepphases \ - (bitmask(GCSsweepstring) | bitmask(GCSsweepudata) | bitmask(GCSsweep)) - - -/* -** enter first sweep phase (strings) and prepare pointers for other -** sweep phases. The calls to 'sweeptolive' make pointers point to an -** object inside the list (instead of to the header), so that the real -** sweep do not need to skip objects created between "now" and the start -** of the real sweep. -** Returns how many objects it swept. -*/ -static int entersweep (lua_State *L) { - global_State *g = G(L); - int n = 0; - g->gcstate = GCSsweepstring; - lua_assert(g->sweepgc == NULL && g->sweepfin == NULL); - /* prepare to sweep strings, finalizable objects, and regular objects */ - g->sweepstrgc = 0; - g->sweepfin = sweeptolive(L, &g->finobj, &n); - g->sweepgc = sweeptolive(L, &g->allgc, &n); - return n; -} - - -/* -** change GC mode -*/ -void luaC_changemode (lua_State *L, int mode) { - global_State *g = G(L); - if (mode == g->gckind) return; /* nothing to change */ - if (mode == KGC_GEN) { /* change to generational mode */ - /* make sure gray lists are consistent */ - luaC_runtilstate(L, bitmask(GCSpropagate)); - g->GCestimate = gettotalbytes(g); - g->gckind = KGC_GEN; - } - else { /* change to incremental mode */ - /* sweep all objects to turn them back to white - (as white has not changed, nothing extra will be collected) */ - g->gckind = KGC_NORMAL; - entersweep(L); - luaC_runtilstate(L, ~sweepphases); - } -} - - -/* -** call all pending finalizers -*/ -static void callallpendingfinalizers (lua_State *L, int propagateerrors) { - global_State *g = G(L); - while (g->tobefnz) { - resetoldbit(g->tobefnz); - GCTM(L, propagateerrors); - } -} - - -void luaC_freeallobjects (lua_State *L) { - global_State *g = G(L); - int i; - separatetobefnz(L, 1); /* separate all objects with finalizers */ - lua_assert(g->finobj == NULL); - callallpendingfinalizers(L, 0); - g->currentwhite = WHITEBITS; /* this "white" makes all objects look dead */ - g->gckind = KGC_NORMAL; - sweepwholelist(L, &g->finobj); /* finalizers can create objs. in 'finobj' */ - sweepwholelist(L, &g->allgc); - for (i = 0; i < g->strt.size; i++) /* free all string lists */ - sweepwholelist(L, &g->strt.hash[i]); - lua_assert(g->strt.nuse == 0); -} - - -static l_mem atomic (lua_State *L) { - global_State *g = G(L); - l_mem work = -cast(l_mem, g->GCmemtrav); /* start counting work */ - GCObject *origweak, *origall; - lua_assert(!iswhite(obj2gco(g->mainthread))); - markobject(g, L); /* mark running thread */ - /* registry and global metatables may be changed by API */ - markvalue(g, &g->l_registry); - markmt(g); /* mark basic metatables */ - /* remark occasional upvalues of (maybe) dead threads */ - remarkupvals(g); - propagateall(g); /* propagate changes */ - work += g->GCmemtrav; /* stop counting (do not (re)count grays) */ - /* traverse objects caught by write barrier and by 'remarkupvals' */ - retraversegrays(g); - work -= g->GCmemtrav; /* restart counting */ - convergeephemerons(g); - /* at this point, all strongly accessible objects are marked. */ - /* clear values from weak tables, before checking finalizers */ - clearvalues(g, g->weak, NULL); - clearvalues(g, g->allweak, NULL); - origweak = g->weak; origall = g->allweak; - work += g->GCmemtrav; /* stop counting (objects being finalized) */ - separatetobefnz(L, 0); /* separate objects to be finalized */ - markbeingfnz(g); /* mark objects that will be finalized */ - propagateall(g); /* remark, to propagate `preserveness' */ - work -= g->GCmemtrav; /* restart counting */ - convergeephemerons(g); - /* at this point, all resurrected objects are marked. */ - /* remove dead objects from weak tables */ - clearkeys(g, g->ephemeron, NULL); /* clear keys from all ephemeron tables */ - clearkeys(g, g->allweak, NULL); /* clear keys from all allweak tables */ - /* clear values from resurrected weak tables */ - clearvalues(g, g->weak, origweak); - clearvalues(g, g->allweak, origall); - g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */ - work += g->GCmemtrav; /* complete counting */ - return work; /* estimate of memory marked by 'atomic' */ -} - - -static lu_mem singlestep (lua_State *L) { - global_State *g = G(L); - switch (g->gcstate) { - case GCSpause: { - /* start to count memory traversed */ - g->GCmemtrav = g->strt.size * sizeof(GCObject*); - lua_assert(!isgenerational(g)); - restartcollection(g); - g->gcstate = GCSpropagate; - return g->GCmemtrav; - } - case GCSpropagate: { - if (g->gray) { - lu_mem oldtrav = g->GCmemtrav; - propagatemark(g); - return g->GCmemtrav - oldtrav; /* memory traversed in this step */ - } - else { /* no more `gray' objects */ - lu_mem work; - int sw; - g->gcstate = GCSatomic; /* finish mark phase */ - g->GCestimate = g->GCmemtrav; /* save what was counted */; - work = atomic(L); /* add what was traversed by 'atomic' */ - g->GCestimate += work; /* estimate of total memory traversed */ - sw = entersweep(L); - return work + sw * GCSWEEPCOST; - } - } - case GCSsweepstring: { - int i; - for (i = 0; i < GCSWEEPMAX && g->sweepstrgc + i < g->strt.size; i++) - sweepwholelist(L, &g->strt.hash[g->sweepstrgc + i]); - g->sweepstrgc += i; - if (g->sweepstrgc >= g->strt.size) /* no more strings to sweep? */ - g->gcstate = GCSsweepudata; - return i * GCSWEEPCOST; - } - case GCSsweepudata: { - if (g->sweepfin) { - g->sweepfin = sweeplist(L, g->sweepfin, GCSWEEPMAX); - return GCSWEEPMAX*GCSWEEPCOST; - } - else { - g->gcstate = GCSsweep; - return 0; - } - } - case GCSsweep: { - if (g->sweepgc) { - g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX); - return GCSWEEPMAX*GCSWEEPCOST; - } - else { - /* sweep main thread */ - GCObject *mt = obj2gco(g->mainthread); - sweeplist(L, &mt, 1); - checkSizes(L); - g->gcstate = GCSpause; /* finish collection */ - return GCSWEEPCOST; - } - } - default: lua_assert(0); return 0; - } -} - - -/* -** advances the garbage collector until it reaches a state allowed -** by 'statemask' -*/ -void luaC_runtilstate (lua_State *L, int statesmask) { - global_State *g = G(L); - while (!testbit(statesmask, g->gcstate)) - singlestep(L); -} - - -static void generationalcollection (lua_State *L) { - global_State *g = G(L); - lua_assert(g->gcstate == GCSpropagate); - if (g->GCestimate == 0) { /* signal for another major collection? */ - luaC_fullgc(L, 0); /* perform a full regular collection */ - g->GCestimate = gettotalbytes(g); /* update control */ - } - else { - lu_mem estimate = g->GCestimate; - luaC_runtilstate(L, bitmask(GCSpause)); /* run complete (minor) cycle */ - g->gcstate = GCSpropagate; /* skip restart */ - if (gettotalbytes(g) > (estimate / 100) * g->gcmajorinc) - g->GCestimate = 0; /* signal for a major collection */ - else - g->GCestimate = estimate; /* keep estimate from last major coll. */ - - } - setpause(g, gettotalbytes(g)); - lua_assert(g->gcstate == GCSpropagate); -} - - -static void incstep (lua_State *L) { - global_State *g = G(L); - l_mem debt = g->GCdebt; - int stepmul = g->gcstepmul; - if (stepmul < 40) stepmul = 40; /* avoid ridiculous low values (and 0) */ - /* convert debt from Kb to 'work units' (avoid zero debt and overflows) */ - debt = (debt / STEPMULADJ) + 1; - debt = (debt < MAX_LMEM / stepmul) ? debt * stepmul : MAX_LMEM; - do { /* always perform at least one single step */ - lu_mem work = singlestep(L); /* do some work */ - debt -= work; - } while (debt > -GCSTEPSIZE && g->gcstate != GCSpause); - if (g->gcstate == GCSpause) - setpause(g, g->GCestimate); /* pause until next cycle */ - else { - debt = (debt / stepmul) * STEPMULADJ; /* convert 'work units' to Kb */ - luaE_setdebt(g, debt); - } -} - - -/* -** performs a basic GC step -*/ -void luaC_forcestep (lua_State *L) { - global_State *g = G(L); - int i; - if (isgenerational(g)) generationalcollection(L); - else incstep(L); - /* run a few finalizers (or all of them at the end of a collect cycle) */ - for (i = 0; g->tobefnz && (i < GCFINALIZENUM || g->gcstate == GCSpause); i++) - GCTM(L, 1); /* call one finalizer */ -} - - -/* -** performs a basic GC step only if collector is running -*/ -void luaC_step (lua_State *L) { - global_State *g = G(L); - if (g->gcrunning) luaC_forcestep(L); - else luaE_setdebt(g, -GCSTEPSIZE); /* avoid being called too often */ -} - - - -/* -** performs a full GC cycle; if "isemergency", does not call -** finalizers (which could change stack positions) -*/ -void luaC_fullgc (lua_State *L, int isemergency) { - global_State *g = G(L); - int origkind = g->gckind; - lua_assert(origkind != KGC_EMERGENCY); - if (isemergency) /* do not run finalizers during emergency GC */ - g->gckind = KGC_EMERGENCY; - else { - g->gckind = KGC_NORMAL; - callallpendingfinalizers(L, 1); - } - if (keepinvariant(g)) { /* may there be some black objects? */ - /* must sweep all objects to turn them back to white - (as white has not changed, nothing will be collected) */ - entersweep(L); - } - /* finish any pending sweep phase to start a new cycle */ - luaC_runtilstate(L, bitmask(GCSpause)); - luaC_runtilstate(L, ~bitmask(GCSpause)); /* start new collection */ - luaC_runtilstate(L, bitmask(GCSpause)); /* run entire collection */ - if (origkind == KGC_GEN) { /* generational mode? */ - /* generational mode must be kept in propagate phase */ - luaC_runtilstate(L, bitmask(GCSpropagate)); - } - g->gckind = origkind; - setpause(g, gettotalbytes(g)); - if (!isemergency) /* do not run finalizers during emergency GC */ - callallpendingfinalizers(L, 1); -} - -/* }====================================================== */ - - diff --git a/ext/lua/src/linit.c b/ext/lua/src/linit.c deleted file mode 100644 index c1a3830471..0000000000 --- a/ext/lua/src/linit.c +++ /dev/null @@ -1,67 +0,0 @@ -/* -** $Id: linit.c,v 1.32.1.1 2013/04/12 18:48:47 roberto Exp $ -** Initialization of libraries for lua.c and other clients -** See Copyright Notice in lua.h -*/ - - -/* -** If you embed Lua in your program and need to open the standard -** libraries, call luaL_openlibs in your program. If you need a -** different set of libraries, copy this file to your project and edit -** it to suit your needs. -*/ - - -#define linit_c -#define LUA_LIB - -#include "lua.h" - -#include "lualib.h" -#include "lauxlib.h" - - -/* -** these libs are loaded by lua.c and are readily available to any Lua -** program -*/ -static const luaL_Reg loadedlibs[] = { - {"_G", luaopen_base}, - {LUA_LOADLIBNAME, luaopen_package}, - {LUA_COLIBNAME, luaopen_coroutine}, - {LUA_TABLIBNAME, luaopen_table}, - {LUA_IOLIBNAME, luaopen_io}, - {LUA_OSLIBNAME, luaopen_os}, - {LUA_STRLIBNAME, luaopen_string}, - {LUA_BITLIBNAME, luaopen_bit32}, - {LUA_MATHLIBNAME, luaopen_math}, - {LUA_DBLIBNAME, luaopen_debug}, - {NULL, NULL} -}; - - -/* -** these libs are preloaded and must be required before used -*/ -static const luaL_Reg preloadedlibs[] = { - {NULL, NULL} -}; - - -LUALIB_API void luaL_openlibs (lua_State *L) { - const luaL_Reg *lib; - /* call open functions from 'loadedlibs' and set results to global table */ - for (lib = loadedlibs; lib->func; lib++) { - luaL_requiref(L, lib->name, lib->func, 1); - lua_pop(L, 1); /* remove lib */ - } - /* add open functions from 'preloadedlibs' into 'package.preload' table */ - luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD"); - for (lib = preloadedlibs; lib->func; lib++) { - lua_pushcfunction(L, lib->func); - lua_setfield(L, -2, lib->name); - } - lua_pop(L, 1); /* remove _PRELOAD table */ -} - diff --git a/ext/lua/src/liolib.c b/ext/lua/src/liolib.c deleted file mode 100644 index 2a4ec4aa34..0000000000 --- a/ext/lua/src/liolib.c +++ /dev/null @@ -1,666 +0,0 @@ -/* -** $Id: liolib.c,v 2.112.1.1 2013/04/12 18:48:47 roberto Exp $ -** Standard I/O (and system) library -** See Copyright Notice in lua.h -*/ - - -/* -** This definition must come before the inclusion of 'stdio.h'; it -** should not affect non-POSIX systems -*/ -#if !defined(_FILE_OFFSET_BITS) -#define _LARGEFILE_SOURCE 1 -#define _FILE_OFFSET_BITS 64 -#endif - - -#include -#include -#include -#include - -#define liolib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -#if !defined(lua_checkmode) - -/* -** Check whether 'mode' matches '[rwa]%+?b?'. -** Change this macro to accept other modes for 'fopen' besides -** the standard ones. -*/ -#define lua_checkmode(mode) \ - (*mode != '\0' && strchr("rwa", *(mode++)) != NULL && \ - (*mode != '+' || ++mode) && /* skip if char is '+' */ \ - (*mode != 'b' || ++mode) && /* skip if char is 'b' */ \ - (*mode == '\0')) - -#endif - -/* -** {====================================================== -** lua_popen spawns a new process connected to the current -** one through the file streams. -** ======================================================= -*/ - -#if !defined(lua_popen) /* { */ - -#if defined(LUA_USE_POPEN) /* { */ - -#define lua_popen(L,c,m) ((void)L, fflush(NULL), popen(c,m)) -#define lua_pclose(L,file) ((void)L, pclose(file)) - -#elif defined(LUA_WIN) /* }{ */ - -#define lua_popen(L,c,m) ((void)L, _popen(c,m)) -#define lua_pclose(L,file) ((void)L, _pclose(file)) - - -#else /* }{ */ - -#define lua_popen(L,c,m) ((void)((void)c, m), \ - luaL_error(L, LUA_QL("popen") " not supported"), (FILE*)0) -#define lua_pclose(L,file) ((void)((void)L, file), -1) - - -#endif /* } */ - -#endif /* } */ - -/* }====================================================== */ - - -/* -** {====================================================== -** lua_fseek: configuration for longer offsets -** ======================================================= -*/ - -#if !defined(lua_fseek) && !defined(LUA_ANSI) /* { */ - -#if defined(LUA_USE_POSIX) /* { */ - -#define l_fseek(f,o,w) fseeko(f,o,w) -#define l_ftell(f) ftello(f) -#define l_seeknum off_t - -#elif defined(LUA_WIN) && !defined(_CRTIMP_TYPEINFO) \ - && defined(_MSC_VER) && (_MSC_VER >= 1400) /* }{ */ -/* Windows (but not DDK) and Visual C++ 2005 or higher */ - -#define l_fseek(f,o,w) _fseeki64(f,o,w) -#define l_ftell(f) _ftelli64(f) -#define l_seeknum __int64 - -#endif /* } */ - -#endif /* } */ - - -#if !defined(l_fseek) /* default definitions */ -#define l_fseek(f,o,w) fseek(f,o,w) -#define l_ftell(f) ftell(f) -#define l_seeknum long -#endif - -/* }====================================================== */ - - -#define IO_PREFIX "_IO_" -#define IO_INPUT (IO_PREFIX "input") -#define IO_OUTPUT (IO_PREFIX "output") - - -typedef luaL_Stream LStream; - - -#define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE)) - -#define isclosed(p) ((p)->closef == NULL) - - -static int io_type (lua_State *L) { - LStream *p; - luaL_checkany(L, 1); - p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE); - if (p == NULL) - lua_pushnil(L); /* not a file */ - else if (isclosed(p)) - lua_pushliteral(L, "closed file"); - else - lua_pushliteral(L, "file"); - return 1; -} - - -static int f_tostring (lua_State *L) { - LStream *p = tolstream(L); - if (isclosed(p)) - lua_pushliteral(L, "file (closed)"); - else - lua_pushfstring(L, "file (%p)", p->f); - return 1; -} - - -static FILE *tofile (lua_State *L) { - LStream *p = tolstream(L); - if (isclosed(p)) - luaL_error(L, "attempt to use a closed file"); - lua_assert(p->f); - return p->f; -} - - -/* -** When creating file handles, always creates a `closed' file handle -** before opening the actual file; so, if there is a memory error, the -** file is not left opened. -*/ -static LStream *newprefile (lua_State *L) { - LStream *p = (LStream *)lua_newuserdata(L, sizeof(LStream)); - p->closef = NULL; /* mark file handle as 'closed' */ - luaL_setmetatable(L, LUA_FILEHANDLE); - return p; -} - - -static int aux_close (lua_State *L) { - LStream *p = tolstream(L); - lua_CFunction cf = p->closef; - p->closef = NULL; /* mark stream as closed */ - return (*cf)(L); /* close it */ -} - - -static int io_close (lua_State *L) { - if (lua_isnone(L, 1)) /* no argument? */ - lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use standard output */ - tofile(L); /* make sure argument is an open stream */ - return aux_close(L); -} - - -static int f_gc (lua_State *L) { - LStream *p = tolstream(L); - if (!isclosed(p) && p->f != NULL) - aux_close(L); /* ignore closed and incompletely open files */ - return 0; -} - - -/* -** function to close regular files -*/ -static int io_fclose (lua_State *L) { - LStream *p = tolstream(L); - int res = fclose(p->f); - return luaL_fileresult(L, (res == 0), NULL); -} - - -static LStream *newfile (lua_State *L) { - LStream *p = newprefile(L); - p->f = NULL; - p->closef = &io_fclose; - return p; -} - - -static void opencheck (lua_State *L, const char *fname, const char *mode) { - LStream *p = newfile(L); - p->f = fopen(fname, mode); - if (p->f == NULL) - luaL_error(L, "cannot open file " LUA_QS " (%s)", fname, strerror(errno)); -} - - -static int io_open (lua_State *L) { - const char *filename = luaL_checkstring(L, 1); - const char *mode = luaL_optstring(L, 2, "r"); - LStream *p = newfile(L); - const char *md = mode; /* to traverse/check mode */ - luaL_argcheck(L, lua_checkmode(md), 2, "invalid mode"); - p->f = fopen(filename, mode); - return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1; -} - - -/* -** function to close 'popen' files -*/ -static int io_pclose (lua_State *L) { - LStream *p = tolstream(L); - return luaL_execresult(L, lua_pclose(L, p->f)); -} - - -static int io_popen (lua_State *L) { - const char *filename = luaL_checkstring(L, 1); - const char *mode = luaL_optstring(L, 2, "r"); - LStream *p = newprefile(L); - p->f = lua_popen(L, filename, mode); - p->closef = &io_pclose; - return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1; -} - - -static int io_tmpfile (lua_State *L) { - LStream *p = newfile(L); - p->f = tmpfile(); - return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1; -} - - -static FILE *getiofile (lua_State *L, const char *findex) { - LStream *p; - lua_getfield(L, LUA_REGISTRYINDEX, findex); - p = (LStream *)lua_touserdata(L, -1); - if (isclosed(p)) - luaL_error(L, "standard %s file is closed", findex + strlen(IO_PREFIX)); - return p->f; -} - - -static int g_iofile (lua_State *L, const char *f, const char *mode) { - if (!lua_isnoneornil(L, 1)) { - const char *filename = lua_tostring(L, 1); - if (filename) - opencheck(L, filename, mode); - else { - tofile(L); /* check that it's a valid file handle */ - lua_pushvalue(L, 1); - } - lua_setfield(L, LUA_REGISTRYINDEX, f); - } - /* return current value */ - lua_getfield(L, LUA_REGISTRYINDEX, f); - return 1; -} - - -static int io_input (lua_State *L) { - return g_iofile(L, IO_INPUT, "r"); -} - - -static int io_output (lua_State *L) { - return g_iofile(L, IO_OUTPUT, "w"); -} - - -static int io_readline (lua_State *L); - - -static void aux_lines (lua_State *L, int toclose) { - int i; - int n = lua_gettop(L) - 1; /* number of arguments to read */ - /* ensure that arguments will fit here and into 'io_readline' stack */ - luaL_argcheck(L, n <= LUA_MINSTACK - 3, LUA_MINSTACK - 3, "too many options"); - lua_pushvalue(L, 1); /* file handle */ - lua_pushinteger(L, n); /* number of arguments to read */ - lua_pushboolean(L, toclose); /* close/not close file when finished */ - for (i = 1; i <= n; i++) lua_pushvalue(L, i + 1); /* copy arguments */ - lua_pushcclosure(L, io_readline, 3 + n); -} - - -static int f_lines (lua_State *L) { - tofile(L); /* check that it's a valid file handle */ - aux_lines(L, 0); - return 1; -} - - -static int io_lines (lua_State *L) { - int toclose; - if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */ - if (lua_isnil(L, 1)) { /* no file name? */ - lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */ - lua_replace(L, 1); /* put it at index 1 */ - tofile(L); /* check that it's a valid file handle */ - toclose = 0; /* do not close it after iteration */ - } - else { /* open a new file */ - const char *filename = luaL_checkstring(L, 1); - opencheck(L, filename, "r"); - lua_replace(L, 1); /* put file at index 1 */ - toclose = 1; /* close it after iteration */ - } - aux_lines(L, toclose); - return 1; -} - - -/* -** {====================================================== -** READ -** ======================================================= -*/ - - -static int read_number (lua_State *L, FILE *f) { - lua_Number d; - if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) { - lua_pushnumber(L, d); - return 1; - } - else { - lua_pushnil(L); /* "result" to be removed */ - return 0; /* read fails */ - } -} - - -static int test_eof (lua_State *L, FILE *f) { - int c = getc(f); - ungetc(c, f); - lua_pushlstring(L, NULL, 0); - return (c != EOF); -} - - -static int read_line (lua_State *L, FILE *f, int chop) { - luaL_Buffer b; - luaL_buffinit(L, &b); - for (;;) { - size_t l; - char *p = luaL_prepbuffer(&b); - if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */ - luaL_pushresult(&b); /* close buffer */ - return (lua_rawlen(L, -1) > 0); /* check whether read something */ - } - l = strlen(p); - if (l == 0 || p[l-1] != '\n') - luaL_addsize(&b, l); - else { - luaL_addsize(&b, l - chop); /* chop 'eol' if needed */ - luaL_pushresult(&b); /* close buffer */ - return 1; /* read at least an `eol' */ - } - } -} - - -#define MAX_SIZE_T (~(size_t)0) - -static void read_all (lua_State *L, FILE *f) { - size_t rlen = LUAL_BUFFERSIZE; /* how much to read in each cycle */ - luaL_Buffer b; - luaL_buffinit(L, &b); - for (;;) { - char *p = luaL_prepbuffsize(&b, rlen); - size_t nr = fread(p, sizeof(char), rlen, f); - luaL_addsize(&b, nr); - if (nr < rlen) break; /* eof? */ - else if (rlen <= (MAX_SIZE_T / 4)) /* avoid buffers too large */ - rlen *= 2; /* double buffer size at each iteration */ - } - luaL_pushresult(&b); /* close buffer */ -} - - -static int read_chars (lua_State *L, FILE *f, size_t n) { - size_t nr; /* number of chars actually read */ - char *p; - luaL_Buffer b; - luaL_buffinit(L, &b); - p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */ - nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */ - luaL_addsize(&b, nr); - luaL_pushresult(&b); /* close buffer */ - return (nr > 0); /* true iff read something */ -} - - -static int g_read (lua_State *L, FILE *f, int first) { - int nargs = lua_gettop(L) - 1; - int success; - int n; - clearerr(f); - if (nargs == 0) { /* no arguments? */ - success = read_line(L, f, 1); - n = first+1; /* to return 1 result */ - } - else { /* ensure stack space for all results and for auxlib's buffer */ - luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments"); - success = 1; - for (n = first; nargs-- && success; n++) { - if (lua_type(L, n) == LUA_TNUMBER) { - size_t l = (size_t)lua_tointeger(L, n); - success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l); - } - else { - const char *p = lua_tostring(L, n); - luaL_argcheck(L, p && p[0] == '*', n, "invalid option"); - switch (p[1]) { - case 'n': /* number */ - success = read_number(L, f); - break; - case 'l': /* line */ - success = read_line(L, f, 1); - break; - case 'L': /* line with end-of-line */ - success = read_line(L, f, 0); - break; - case 'a': /* file */ - read_all(L, f); /* read entire file */ - success = 1; /* always success */ - break; - default: - return luaL_argerror(L, n, "invalid format"); - } - } - } - } - if (ferror(f)) - return luaL_fileresult(L, 0, NULL); - if (!success) { - lua_pop(L, 1); /* remove last result */ - lua_pushnil(L); /* push nil instead */ - } - return n - first; -} - - -static int io_read (lua_State *L) { - return g_read(L, getiofile(L, IO_INPUT), 1); -} - - -static int f_read (lua_State *L) { - return g_read(L, tofile(L), 2); -} - - -static int io_readline (lua_State *L) { - LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1)); - int i; - int n = (int)lua_tointeger(L, lua_upvalueindex(2)); - if (isclosed(p)) /* file is already closed? */ - return luaL_error(L, "file is already closed"); - lua_settop(L , 1); - for (i = 1; i <= n; i++) /* push arguments to 'g_read' */ - lua_pushvalue(L, lua_upvalueindex(3 + i)); - n = g_read(L, p->f, 2); /* 'n' is number of results */ - lua_assert(n > 0); /* should return at least a nil */ - if (!lua_isnil(L, -n)) /* read at least one value? */ - return n; /* return them */ - else { /* first result is nil: EOF or error */ - if (n > 1) { /* is there error information? */ - /* 2nd result is error message */ - return luaL_error(L, "%s", lua_tostring(L, -n + 1)); - } - if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */ - lua_settop(L, 0); - lua_pushvalue(L, lua_upvalueindex(1)); - aux_close(L); /* close it */ - } - return 0; - } -} - -/* }====================================================== */ - - -static int g_write (lua_State *L, FILE *f, int arg) { - int nargs = lua_gettop(L) - arg; - int status = 1; - for (; nargs--; arg++) { - if (lua_type(L, arg) == LUA_TNUMBER) { - /* optimization: could be done exactly as for strings */ - status = status && - fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0; - } - else { - size_t l; - const char *s = luaL_checklstring(L, arg, &l); - status = status && (fwrite(s, sizeof(char), l, f) == l); - } - } - if (status) return 1; /* file handle already on stack top */ - else return luaL_fileresult(L, status, NULL); -} - - -static int io_write (lua_State *L) { - return g_write(L, getiofile(L, IO_OUTPUT), 1); -} - - -static int f_write (lua_State *L) { - FILE *f = tofile(L); - lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */ - return g_write(L, f, 2); -} - - -static int f_seek (lua_State *L) { - static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END}; - static const char *const modenames[] = {"set", "cur", "end", NULL}; - FILE *f = tofile(L); - int op = luaL_checkoption(L, 2, "cur", modenames); - lua_Number p3 = luaL_optnumber(L, 3, 0); - l_seeknum offset = (l_seeknum)p3; - luaL_argcheck(L, (lua_Number)offset == p3, 3, - "not an integer in proper range"); - op = l_fseek(f, offset, mode[op]); - if (op) - return luaL_fileresult(L, 0, NULL); /* error */ - else { - lua_pushnumber(L, (lua_Number)l_ftell(f)); - return 1; - } -} - - -static int f_setvbuf (lua_State *L) { - static const int mode[] = {_IONBF, _IOFBF, _IOLBF}; - static const char *const modenames[] = {"no", "full", "line", NULL}; - FILE *f = tofile(L); - int op = luaL_checkoption(L, 2, NULL, modenames); - lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE); - int res = setvbuf(f, NULL, mode[op], sz); - return luaL_fileresult(L, res == 0, NULL); -} - - - -static int io_flush (lua_State *L) { - return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL); -} - - -static int f_flush (lua_State *L) { - return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL); -} - - -/* -** functions for 'io' library -*/ -static const luaL_Reg iolib[] = { - {"close", io_close}, - {"flush", io_flush}, - {"input", io_input}, - {"lines", io_lines}, - {"open", io_open}, - {"output", io_output}, - {"popen", io_popen}, - {"read", io_read}, - {"tmpfile", io_tmpfile}, - {"type", io_type}, - {"write", io_write}, - {NULL, NULL} -}; - - -/* -** methods for file handles -*/ -static const luaL_Reg flib[] = { - {"close", io_close}, - {"flush", f_flush}, - {"lines", f_lines}, - {"read", f_read}, - {"seek", f_seek}, - {"setvbuf", f_setvbuf}, - {"write", f_write}, - {"__gc", f_gc}, - {"__tostring", f_tostring}, - {NULL, NULL} -}; - - -static void createmeta (lua_State *L) { - luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */ - lua_pushvalue(L, -1); /* push metatable */ - lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ - luaL_setfuncs(L, flib, 0); /* add file methods to new metatable */ - lua_pop(L, 1); /* pop new metatable */ -} - - -/* -** function to (not) close the standard files stdin, stdout, and stderr -*/ -static int io_noclose (lua_State *L) { - LStream *p = tolstream(L); - p->closef = &io_noclose; /* keep file opened */ - lua_pushnil(L); - lua_pushliteral(L, "cannot close standard file"); - return 2; -} - - -static void createstdfile (lua_State *L, FILE *f, const char *k, - const char *fname) { - LStream *p = newprefile(L); - p->f = f; - p->closef = &io_noclose; - if (k != NULL) { - lua_pushvalue(L, -1); - lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */ - } - lua_setfield(L, -2, fname); /* add file to module */ -} - - -LUAMOD_API int luaopen_io (lua_State *L) { - luaL_newlib(L, iolib); /* new module */ - createmeta(L); - /* create (and set) default files */ - createstdfile(L, stdin, IO_INPUT, "stdin"); - createstdfile(L, stdout, IO_OUTPUT, "stdout"); - createstdfile(L, stderr, NULL, "stderr"); - return 1; -} - diff --git a/ext/lua/src/llex.c b/ext/lua/src/llex.c deleted file mode 100644 index c4b820e833..0000000000 --- a/ext/lua/src/llex.c +++ /dev/null @@ -1,530 +0,0 @@ -/* -** $Id: llex.c,v 2.63.1.2 2013/08/30 15:49:41 roberto Exp $ -** Lexical Analyzer -** See Copyright Notice in lua.h -*/ - - -#include -#include - -#define llex_c -#define LUA_CORE - -#include "lua.h" - -#include "lctype.h" -#include "ldo.h" -#include "llex.h" -#include "lobject.h" -#include "lparser.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "lzio.h" - - - -#define next(ls) (ls->current = zgetc(ls->z)) - - - -#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r') - - -/* ORDER RESERVED */ -static const char *const luaX_tokens [] = { - "and", "break", "do", "else", "elseif", - "end", "false", "for", "function", "goto", "if", - "in", "local", "nil", "not", "or", "repeat", - "return", "then", "true", "until", "while", - "..", "...", "==", ">=", "<=", "~=", "::", "", - "", "", "" -}; - - -#define save_and_next(ls) (save(ls, ls->current), next(ls)) - - -static l_noret lexerror (LexState *ls, const char *msg, int token); - - -static void save (LexState *ls, int c) { - Mbuffer *b = ls->buff; - if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) { - size_t newsize; - if (luaZ_sizebuffer(b) >= MAX_SIZET/2) - lexerror(ls, "lexical element too long", 0); - newsize = luaZ_sizebuffer(b) * 2; - luaZ_resizebuffer(ls->L, b, newsize); - } - b->buffer[luaZ_bufflen(b)++] = cast(char, c); -} - - -void luaX_init (lua_State *L) { - int i; - for (i=0; itsv.extra = cast_byte(i+1); /* reserved word */ - } -} - - -const char *luaX_token2str (LexState *ls, int token) { - if (token < FIRST_RESERVED) { /* single-byte symbols? */ - lua_assert(token == cast(unsigned char, token)); - return (lisprint(token)) ? luaO_pushfstring(ls->L, LUA_QL("%c"), token) : - luaO_pushfstring(ls->L, "char(%d)", token); - } - else { - const char *s = luaX_tokens[token - FIRST_RESERVED]; - if (token < TK_EOS) /* fixed format (symbols and reserved words)? */ - return luaO_pushfstring(ls->L, LUA_QS, s); - else /* names, strings, and numerals */ - return s; - } -} - - -static const char *txtToken (LexState *ls, int token) { - switch (token) { - case TK_NAME: - case TK_STRING: - case TK_NUMBER: - save(ls, '\0'); - return luaO_pushfstring(ls->L, LUA_QS, luaZ_buffer(ls->buff)); - default: - return luaX_token2str(ls, token); - } -} - - -static l_noret lexerror (LexState *ls, const char *msg, int token) { - char buff[LUA_IDSIZE]; - luaO_chunkid(buff, getstr(ls->source), LUA_IDSIZE); - msg = luaO_pushfstring(ls->L, "%s:%d: %s", buff, ls->linenumber, msg); - if (token) - luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token)); - luaD_throw(ls->L, LUA_ERRSYNTAX); -} - - -l_noret luaX_syntaxerror (LexState *ls, const char *msg) { - lexerror(ls, msg, ls->t.token); -} - - -/* -** creates a new string and anchors it in function's table so that -** it will not be collected until the end of the function's compilation -** (by that time it should be anchored in function's prototype) -*/ -TString *luaX_newstring (LexState *ls, const char *str, size_t l) { - lua_State *L = ls->L; - TValue *o; /* entry for `str' */ - TString *ts = luaS_newlstr(L, str, l); /* create new string */ - setsvalue2s(L, L->top++, ts); /* temporarily anchor it in stack */ - o = luaH_set(L, ls->fs->h, L->top - 1); - if (ttisnil(o)) { /* not in use yet? (see 'addK') */ - /* boolean value does not need GC barrier; - table has no metatable, so it does not need to invalidate cache */ - setbvalue(o, 1); /* t[string] = true */ - luaC_checkGC(L); - } - else { /* string already present */ - ts = rawtsvalue(keyfromval(o)); /* re-use value previously stored */ - } - L->top--; /* remove string from stack */ - return ts; -} - - -/* -** increment line number and skips newline sequence (any of -** \n, \r, \n\r, or \r\n) -*/ -static void inclinenumber (LexState *ls) { - int old = ls->current; - lua_assert(currIsNewline(ls)); - next(ls); /* skip `\n' or `\r' */ - if (currIsNewline(ls) && ls->current != old) - next(ls); /* skip `\n\r' or `\r\n' */ - if (++ls->linenumber >= MAX_INT) - luaX_syntaxerror(ls, "chunk has too many lines"); -} - - -void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source, - int firstchar) { - ls->decpoint = '.'; - ls->L = L; - ls->current = firstchar; - ls->lookahead.token = TK_EOS; /* no look-ahead token */ - ls->z = z; - ls->fs = NULL; - ls->linenumber = 1; - ls->lastline = 1; - ls->source = source; - ls->envn = luaS_new(L, LUA_ENV); /* create env name */ - luaS_fix(ls->envn); /* never collect this name */ - luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */ -} - - - -/* -** ======================================================= -** LEXICAL ANALYZER -** ======================================================= -*/ - - - -static int check_next (LexState *ls, const char *set) { - if (ls->current == '\0' || !strchr(set, ls->current)) - return 0; - save_and_next(ls); - return 1; -} - - -/* -** change all characters 'from' in buffer to 'to' -*/ -static void buffreplace (LexState *ls, char from, char to) { - size_t n = luaZ_bufflen(ls->buff); - char *p = luaZ_buffer(ls->buff); - while (n--) - if (p[n] == from) p[n] = to; -} - - -#if !defined(getlocaledecpoint) -#define getlocaledecpoint() (localeconv()->decimal_point[0]) -#endif - - -#define buff2d(b,e) luaO_str2d(luaZ_buffer(b), luaZ_bufflen(b) - 1, e) - -/* -** in case of format error, try to change decimal point separator to -** the one defined in the current locale and check again -*/ -static void trydecpoint (LexState *ls, SemInfo *seminfo) { - char old = ls->decpoint; - ls->decpoint = getlocaledecpoint(); - buffreplace(ls, old, ls->decpoint); /* try new decimal separator */ - if (!buff2d(ls->buff, &seminfo->r)) { - /* format error with correct decimal point: no more options */ - buffreplace(ls, ls->decpoint, '.'); /* undo change (for error message) */ - lexerror(ls, "malformed number", TK_NUMBER); - } -} - - -/* LUA_NUMBER */ -/* -** this function is quite liberal in what it accepts, as 'luaO_str2d' -** will reject ill-formed numerals. -*/ -static void read_numeral (LexState *ls, SemInfo *seminfo) { - const char *expo = "Ee"; - int first = ls->current; - lua_assert(lisdigit(ls->current)); - save_and_next(ls); - if (first == '0' && check_next(ls, "Xx")) /* hexadecimal? */ - expo = "Pp"; - for (;;) { - if (check_next(ls, expo)) /* exponent part? */ - check_next(ls, "+-"); /* optional exponent sign */ - if (lisxdigit(ls->current) || ls->current == '.') - save_and_next(ls); - else break; - } - save(ls, '\0'); - buffreplace(ls, '.', ls->decpoint); /* follow locale for decimal point */ - if (!buff2d(ls->buff, &seminfo->r)) /* format error? */ - trydecpoint(ls, seminfo); /* try to update decimal point separator */ -} - - -/* -** skip a sequence '[=*[' or ']=*]' and return its number of '='s or -** -1 if sequence is malformed -*/ -static int skip_sep (LexState *ls) { - int count = 0; - int s = ls->current; - lua_assert(s == '[' || s == ']'); - save_and_next(ls); - while (ls->current == '=') { - save_and_next(ls); - count++; - } - return (ls->current == s) ? count : (-count) - 1; -} - - -static void read_long_string (LexState *ls, SemInfo *seminfo, int sep) { - save_and_next(ls); /* skip 2nd `[' */ - if (currIsNewline(ls)) /* string starts with a newline? */ - inclinenumber(ls); /* skip it */ - for (;;) { - switch (ls->current) { - case EOZ: - lexerror(ls, (seminfo) ? "unfinished long string" : - "unfinished long comment", TK_EOS); - break; /* to avoid warnings */ - case ']': { - if (skip_sep(ls) == sep) { - save_and_next(ls); /* skip 2nd `]' */ - goto endloop; - } - break; - } - case '\n': case '\r': { - save(ls, '\n'); - inclinenumber(ls); - if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */ - break; - } - default: { - if (seminfo) save_and_next(ls); - else next(ls); - } - } - } endloop: - if (seminfo) - seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + (2 + sep), - luaZ_bufflen(ls->buff) - 2*(2 + sep)); -} - - -static void escerror (LexState *ls, int *c, int n, const char *msg) { - int i; - luaZ_resetbuffer(ls->buff); /* prepare error message */ - save(ls, '\\'); - for (i = 0; i < n && c[i] != EOZ; i++) - save(ls, c[i]); - lexerror(ls, msg, TK_STRING); -} - - -static int readhexaesc (LexState *ls) { - int c[3], i; /* keep input for error message */ - int r = 0; /* result accumulator */ - c[0] = 'x'; /* for error message */ - for (i = 1; i < 3; i++) { /* read two hexadecimal digits */ - c[i] = next(ls); - if (!lisxdigit(c[i])) - escerror(ls, c, i + 1, "hexadecimal digit expected"); - r = (r << 4) + luaO_hexavalue(c[i]); - } - return r; -} - - -static int readdecesc (LexState *ls) { - int c[3], i; - int r = 0; /* result accumulator */ - for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */ - c[i] = ls->current; - r = 10*r + c[i] - '0'; - next(ls); - } - if (r > UCHAR_MAX) - escerror(ls, c, i, "decimal escape too large"); - return r; -} - - -static void read_string (LexState *ls, int del, SemInfo *seminfo) { - save_and_next(ls); /* keep delimiter (for error messages) */ - while (ls->current != del) { - switch (ls->current) { - case EOZ: - lexerror(ls, "unfinished string", TK_EOS); - break; /* to avoid warnings */ - case '\n': - case '\r': - lexerror(ls, "unfinished string", TK_STRING); - break; /* to avoid warnings */ - case '\\': { /* escape sequences */ - int c; /* final character to be saved */ - next(ls); /* do not save the `\' */ - switch (ls->current) { - case 'a': c = '\a'; goto read_save; - case 'b': c = '\b'; goto read_save; - case 'f': c = '\f'; goto read_save; - case 'n': c = '\n'; goto read_save; - case 'r': c = '\r'; goto read_save; - case 't': c = '\t'; goto read_save; - case 'v': c = '\v'; goto read_save; - case 'x': c = readhexaesc(ls); goto read_save; - case '\n': case '\r': - inclinenumber(ls); c = '\n'; goto only_save; - case '\\': case '\"': case '\'': - c = ls->current; goto read_save; - case EOZ: goto no_save; /* will raise an error next loop */ - case 'z': { /* zap following span of spaces */ - next(ls); /* skip the 'z' */ - while (lisspace(ls->current)) { - if (currIsNewline(ls)) inclinenumber(ls); - else next(ls); - } - goto no_save; - } - default: { - if (!lisdigit(ls->current)) - escerror(ls, &ls->current, 1, "invalid escape sequence"); - /* digital escape \ddd */ - c = readdecesc(ls); - goto only_save; - } - } - read_save: next(ls); /* read next character */ - only_save: save(ls, c); /* save 'c' */ - no_save: break; - } - default: - save_and_next(ls); - } - } - save_and_next(ls); /* skip delimiter */ - seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1, - luaZ_bufflen(ls->buff) - 2); -} - - -static int llex (LexState *ls, SemInfo *seminfo) { - luaZ_resetbuffer(ls->buff); - for (;;) { - switch (ls->current) { - case '\n': case '\r': { /* line breaks */ - inclinenumber(ls); - break; - } - case ' ': case '\f': case '\t': case '\v': { /* spaces */ - next(ls); - break; - } - case '-': { /* '-' or '--' (comment) */ - next(ls); - if (ls->current != '-') return '-'; - /* else is a comment */ - next(ls); - if (ls->current == '[') { /* long comment? */ - int sep = skip_sep(ls); - luaZ_resetbuffer(ls->buff); /* `skip_sep' may dirty the buffer */ - if (sep >= 0) { - read_long_string(ls, NULL, sep); /* skip long comment */ - luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */ - break; - } - } - /* else short comment */ - while (!currIsNewline(ls) && ls->current != EOZ) - next(ls); /* skip until end of line (or end of file) */ - break; - } - case '[': { /* long string or simply '[' */ - int sep = skip_sep(ls); - if (sep >= 0) { - read_long_string(ls, seminfo, sep); - return TK_STRING; - } - else if (sep == -1) return '['; - else lexerror(ls, "invalid long string delimiter", TK_STRING); - } - case '=': { - next(ls); - if (ls->current != '=') return '='; - else { next(ls); return TK_EQ; } - } - case '<': { - next(ls); - if (ls->current != '=') return '<'; - else { next(ls); return TK_LE; } - } - case '>': { - next(ls); - if (ls->current != '=') return '>'; - else { next(ls); return TK_GE; } - } - case '~': { - next(ls); - if (ls->current != '=') return '~'; - else { next(ls); return TK_NE; } - } - case ':': { - next(ls); - if (ls->current != ':') return ':'; - else { next(ls); return TK_DBCOLON; } - } - case '"': case '\'': { /* short literal strings */ - read_string(ls, ls->current, seminfo); - return TK_STRING; - } - case '.': { /* '.', '..', '...', or number */ - save_and_next(ls); - if (check_next(ls, ".")) { - if (check_next(ls, ".")) - return TK_DOTS; /* '...' */ - else return TK_CONCAT; /* '..' */ - } - else if (!lisdigit(ls->current)) return '.'; - /* else go through */ - } - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': { - read_numeral(ls, seminfo); - return TK_NUMBER; - } - case EOZ: { - return TK_EOS; - } - default: { - if (lislalpha(ls->current)) { /* identifier or reserved word? */ - TString *ts; - do { - save_and_next(ls); - } while (lislalnum(ls->current)); - ts = luaX_newstring(ls, luaZ_buffer(ls->buff), - luaZ_bufflen(ls->buff)); - seminfo->ts = ts; - if (isreserved(ts)) /* reserved word? */ - return ts->tsv.extra - 1 + FIRST_RESERVED; - else { - return TK_NAME; - } - } - else { /* single-char tokens (+ - / ...) */ - int c = ls->current; - next(ls); - return c; - } - } - } - } -} - - -void luaX_next (LexState *ls) { - ls->lastline = ls->linenumber; - if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */ - ls->t = ls->lookahead; /* use this one */ - ls->lookahead.token = TK_EOS; /* and discharge it */ - } - else - ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */ -} - - -int luaX_lookahead (LexState *ls) { - lua_assert(ls->lookahead.token == TK_EOS); - ls->lookahead.token = llex(ls, &ls->lookahead.seminfo); - return ls->lookahead.token; -} - diff --git a/ext/lua/src/lmathlib.c b/ext/lua/src/lmathlib.c deleted file mode 100644 index fe9fc5423d..0000000000 --- a/ext/lua/src/lmathlib.c +++ /dev/null @@ -1,279 +0,0 @@ -/* -** $Id: lmathlib.c,v 1.83.1.1 2013/04/12 18:48:47 roberto Exp $ -** Standard mathematical library -** See Copyright Notice in lua.h -*/ - - -#include -#include - -#define lmathlib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -#undef PI -#define PI ((lua_Number)(3.1415926535897932384626433832795)) -#define RADIANS_PER_DEGREE ((lua_Number)(PI/180.0)) - - - -static int math_abs (lua_State *L) { - lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_sin (lua_State *L) { - lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_sinh (lua_State *L) { - lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_cos (lua_State *L) { - lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_cosh (lua_State *L) { - lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_tan (lua_State *L) { - lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_tanh (lua_State *L) { - lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_asin (lua_State *L) { - lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_acos (lua_State *L) { - lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_atan (lua_State *L) { - lua_pushnumber(L, l_mathop(atan)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_atan2 (lua_State *L) { - lua_pushnumber(L, l_mathop(atan2)(luaL_checknumber(L, 1), - luaL_checknumber(L, 2))); - return 1; -} - -static int math_ceil (lua_State *L) { - lua_pushnumber(L, l_mathop(ceil)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_floor (lua_State *L) { - lua_pushnumber(L, l_mathop(floor)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_fmod (lua_State *L) { - lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1), - luaL_checknumber(L, 2))); - return 1; -} - -static int math_modf (lua_State *L) { - lua_Number ip; - lua_Number fp = l_mathop(modf)(luaL_checknumber(L, 1), &ip); - lua_pushnumber(L, ip); - lua_pushnumber(L, fp); - return 2; -} - -static int math_sqrt (lua_State *L) { - lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_pow (lua_State *L) { - lua_Number x = luaL_checknumber(L, 1); - lua_Number y = luaL_checknumber(L, 2); - lua_pushnumber(L, l_mathop(pow)(x, y)); - return 1; -} - -static int math_log (lua_State *L) { - lua_Number x = luaL_checknumber(L, 1); - lua_Number res; - if (lua_isnoneornil(L, 2)) - res = l_mathop(log)(x); - else { - lua_Number base = luaL_checknumber(L, 2); - if (base == (lua_Number)10.0) res = l_mathop(log10)(x); - else res = l_mathop(log)(x)/l_mathop(log)(base); - } - lua_pushnumber(L, res); - return 1; -} - -#if defined(LUA_COMPAT_LOG10) -static int math_log10 (lua_State *L) { - lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1))); - return 1; -} -#endif - -static int math_exp (lua_State *L) { - lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1))); - return 1; -} - -static int math_deg (lua_State *L) { - lua_pushnumber(L, luaL_checknumber(L, 1)/RADIANS_PER_DEGREE); - return 1; -} - -static int math_rad (lua_State *L) { - lua_pushnumber(L, luaL_checknumber(L, 1)*RADIANS_PER_DEGREE); - return 1; -} - -static int math_frexp (lua_State *L) { - int e; - lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e)); - lua_pushinteger(L, e); - return 2; -} - -static int math_ldexp (lua_State *L) { - lua_Number x = luaL_checknumber(L, 1); - int ep = luaL_checkint(L, 2); - lua_pushnumber(L, l_mathop(ldexp)(x, ep)); - return 1; -} - - - -static int math_min (lua_State *L) { - int n = lua_gettop(L); /* number of arguments */ - lua_Number dmin = luaL_checknumber(L, 1); - int i; - for (i=2; i<=n; i++) { - lua_Number d = luaL_checknumber(L, i); - if (d < dmin) - dmin = d; - } - lua_pushnumber(L, dmin); - return 1; -} - - -static int math_max (lua_State *L) { - int n = lua_gettop(L); /* number of arguments */ - lua_Number dmax = luaL_checknumber(L, 1); - int i; - for (i=2; i<=n; i++) { - lua_Number d = luaL_checknumber(L, i); - if (d > dmax) - dmax = d; - } - lua_pushnumber(L, dmax); - return 1; -} - - -static int math_random (lua_State *L) { - /* the `%' avoids the (rare) case of r==1, and is needed also because on - some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */ - lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX; - switch (lua_gettop(L)) { /* check number of arguments */ - case 0: { /* no arguments */ - lua_pushnumber(L, r); /* Number between 0 and 1 */ - break; - } - case 1: { /* only upper limit */ - lua_Number u = luaL_checknumber(L, 1); - luaL_argcheck(L, (lua_Number)1.0 <= u, 1, "interval is empty"); - lua_pushnumber(L, l_mathop(floor)(r*u) + (lua_Number)(1.0)); /* [1, u] */ - break; - } - case 2: { /* lower and upper limits */ - lua_Number l = luaL_checknumber(L, 1); - lua_Number u = luaL_checknumber(L, 2); - luaL_argcheck(L, l <= u, 2, "interval is empty"); - lua_pushnumber(L, l_mathop(floor)(r*(u-l+1)) + l); /* [l, u] */ - break; - } - default: return luaL_error(L, "wrong number of arguments"); - } - return 1; -} - - -static int math_randomseed (lua_State *L) { - srand(luaL_checkunsigned(L, 1)); - (void)rand(); /* discard first value to avoid undesirable correlations */ - return 0; -} - - -static const luaL_Reg mathlib[] = { - {"abs", math_abs}, - {"acos", math_acos}, - {"asin", math_asin}, - {"atan2", math_atan2}, - {"atan", math_atan}, - {"ceil", math_ceil}, - {"cosh", math_cosh}, - {"cos", math_cos}, - {"deg", math_deg}, - {"exp", math_exp}, - {"floor", math_floor}, - {"fmod", math_fmod}, - {"frexp", math_frexp}, - {"ldexp", math_ldexp}, -#if defined(LUA_COMPAT_LOG10) - {"log10", math_log10}, -#endif - {"log", math_log}, - {"max", math_max}, - {"min", math_min}, - {"modf", math_modf}, - {"pow", math_pow}, - {"rad", math_rad}, - {"random", math_random}, - {"randomseed", math_randomseed}, - {"sinh", math_sinh}, - {"sin", math_sin}, - {"sqrt", math_sqrt}, - {"tanh", math_tanh}, - {"tan", math_tan}, - {NULL, NULL} -}; - - -/* -** Open math library -*/ -LUAMOD_API int luaopen_math (lua_State *L) { - luaL_newlib(L, mathlib); - lua_pushnumber(L, PI); - lua_setfield(L, -2, "pi"); - lua_pushnumber(L, HUGE_VAL); - lua_setfield(L, -2, "huge"); - return 1; -} - diff --git a/ext/lua/src/lmem.c b/ext/lua/src/lmem.c deleted file mode 100644 index ee343e3e03..0000000000 --- a/ext/lua/src/lmem.c +++ /dev/null @@ -1,99 +0,0 @@ -/* -** $Id: lmem.c,v 1.84.1.1 2013/04/12 18:48:47 roberto Exp $ -** Interface to Memory Manager -** See Copyright Notice in lua.h -*/ - - -#include - -#define lmem_c -#define LUA_CORE - -#include "lua.h" - -#include "ldebug.h" -#include "ldo.h" -#include "lgc.h" -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" - - - -/* -** About the realloc function: -** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize); -** (`osize' is the old size, `nsize' is the new size) -** -** * frealloc(ud, NULL, x, s) creates a new block of size `s' (no -** matter 'x'). -** -** * frealloc(ud, p, x, 0) frees the block `p' -** (in this specific case, frealloc must return NULL); -** particularly, frealloc(ud, NULL, 0, 0) does nothing -** (which is equivalent to free(NULL) in ANSI C) -** -** frealloc returns NULL if it cannot create or reallocate the area -** (any reallocation to an equal or smaller size cannot fail!) -*/ - - - -#define MINSIZEARRAY 4 - - -void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems, - int limit, const char *what) { - void *newblock; - int newsize; - if (*size >= limit/2) { /* cannot double it? */ - if (*size >= limit) /* cannot grow even a little? */ - luaG_runerror(L, "too many %s (limit is %d)", what, limit); - newsize = limit; /* still have at least one free place */ - } - else { - newsize = (*size)*2; - if (newsize < MINSIZEARRAY) - newsize = MINSIZEARRAY; /* minimum size */ - } - newblock = luaM_reallocv(L, block, *size, newsize, size_elems); - *size = newsize; /* update only when everything else is OK */ - return newblock; -} - - -l_noret luaM_toobig (lua_State *L) { - luaG_runerror(L, "memory allocation error: block too big"); -} - - - -/* -** generic allocation routine. -*/ -void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) { - void *newblock; - global_State *g = G(L); - size_t realosize = (block) ? osize : 0; - lua_assert((realosize == 0) == (block == NULL)); -#if defined(HARDMEMTESTS) - if (nsize > realosize && g->gcrunning) - luaC_fullgc(L, 1); /* force a GC whenever possible */ -#endif - newblock = (*g->frealloc)(g->ud, block, osize, nsize); - if (newblock == NULL && nsize > 0) { - api_check(L, nsize > realosize, - "realloc cannot fail when shrinking a block"); - if (g->gcrunning) { - luaC_fullgc(L, 1); /* try to free some memory... */ - newblock = (*g->frealloc)(g->ud, block, osize, nsize); /* try again */ - } - if (newblock == NULL) - luaD_throw(L, LUA_ERRMEM); - } - lua_assert((nsize == 0) == (newblock == NULL)); - g->GCdebt = (g->GCdebt + nsize) - realosize; - return newblock; -} - diff --git a/ext/lua/src/loadlib.c b/ext/lua/src/loadlib.c deleted file mode 100644 index bedbea3e9a..0000000000 --- a/ext/lua/src/loadlib.c +++ /dev/null @@ -1,725 +0,0 @@ -/* -** $Id: loadlib.c,v 1.111.1.1 2013/04/12 18:48:47 roberto Exp $ -** Dynamic library loader for Lua -** See Copyright Notice in lua.h -** -** This module contains an implementation of loadlib for Unix systems -** that have dlfcn, an implementation for Windows, and a stub for other -** systems. -*/ - - -/* -** if needed, includes windows header before everything else -*/ -#if defined(_WIN32) -#include -#endif - - -#include -#include - - -#define loadlib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -/* -** LUA_PATH and LUA_CPATH are the names of the environment -** variables that Lua check to set its paths. -*/ -#if !defined(LUA_PATH) -#define LUA_PATH "LUA_PATH" -#endif - -#if !defined(LUA_CPATH) -#define LUA_CPATH "LUA_CPATH" -#endif - -#define LUA_PATHSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR - -#define LUA_PATHVERSION LUA_PATH LUA_PATHSUFFIX -#define LUA_CPATHVERSION LUA_CPATH LUA_PATHSUFFIX - -/* -** LUA_PATH_SEP is the character that separates templates in a path. -** LUA_PATH_MARK is the string that marks the substitution points in a -** template. -** LUA_EXEC_DIR in a Windows path is replaced by the executable's -** directory. -** LUA_IGMARK is a mark to ignore all before it when building the -** luaopen_ function name. -*/ -#if !defined (LUA_PATH_SEP) -#define LUA_PATH_SEP ";" -#endif -#if !defined (LUA_PATH_MARK) -#define LUA_PATH_MARK "?" -#endif -#if !defined (LUA_EXEC_DIR) -#define LUA_EXEC_DIR "!" -#endif -#if !defined (LUA_IGMARK) -#define LUA_IGMARK "-" -#endif - - -/* -** LUA_CSUBSEP is the character that replaces dots in submodule names -** when searching for a C loader. -** LUA_LSUBSEP is the character that replaces dots in submodule names -** when searching for a Lua loader. -*/ -#if !defined(LUA_CSUBSEP) -#define LUA_CSUBSEP LUA_DIRSEP -#endif - -#if !defined(LUA_LSUBSEP) -#define LUA_LSUBSEP LUA_DIRSEP -#endif - - -/* prefix for open functions in C libraries */ -#define LUA_POF "luaopen_" - -/* separator for open functions in C libraries */ -#define LUA_OFSEP "_" - - -/* table (in the registry) that keeps handles for all loaded C libraries */ -#define CLIBS "_CLIBS" - -#define LIB_FAIL "open" - - -/* error codes for ll_loadfunc */ -#define ERRLIB 1 -#define ERRFUNC 2 - -#define setprogdir(L) ((void)0) - - -/* -** system-dependent functions -*/ -static void ll_unloadlib (void *lib); -static void *ll_load (lua_State *L, const char *path, int seeglb); -static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym); - - - -#if defined(LUA_USE_DLOPEN) -/* -** {======================================================================== -** This is an implementation of loadlib based on the dlfcn interface. -** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, -** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least -** as an emulation layer on top of native functions. -** ========================================================================= -*/ - -#include - -static void ll_unloadlib (void *lib) { - dlclose(lib); -} - - -static void *ll_load (lua_State *L, const char *path, int seeglb) { - void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL)); - if (lib == NULL) lua_pushstring(L, dlerror()); - return lib; -} - - -static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { - lua_CFunction f = (lua_CFunction)dlsym(lib, sym); - if (f == NULL) lua_pushstring(L, dlerror()); - return f; -} - -/* }====================================================== */ - - - -#elif defined(LUA_DL_DLL) -/* -** {====================================================================== -** This is an implementation of loadlib for Windows using native functions. -** ======================================================================= -*/ - -#undef setprogdir - -/* -** optional flags for LoadLibraryEx -*/ -#if !defined(LUA_LLE_FLAGS) -#define LUA_LLE_FLAGS 0 -#endif - - -static void setprogdir (lua_State *L) { - char buff[MAX_PATH + 1]; - char *lb; - DWORD nsize = sizeof(buff)/sizeof(char); - DWORD n = GetModuleFileNameA(NULL, buff, nsize); - if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL) - luaL_error(L, "unable to get ModuleFileName"); - else { - *lb = '\0'; - luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff); - lua_remove(L, -2); /* remove original string */ - } -} - - -static void pusherror (lua_State *L) { - int error = GetLastError(); - char buffer[128]; - if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM, - NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL)) - lua_pushstring(L, buffer); - else - lua_pushfstring(L, "system error %d\n", error); -} - -static void ll_unloadlib (void *lib) { - FreeLibrary((HMODULE)lib); -} - - -static void *ll_load (lua_State *L, const char *path, int seeglb) { - HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS); - (void)(seeglb); /* not used: symbols are 'global' by default */ - if (lib == NULL) pusherror(L); - return lib; -} - - -static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { - lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym); - if (f == NULL) pusherror(L); - return f; -} - -/* }====================================================== */ - - -#else -/* -** {====================================================== -** Fallback for other systems -** ======================================================= -*/ - -#undef LIB_FAIL -#define LIB_FAIL "absent" - - -#define DLMSG "dynamic libraries not enabled; check your Lua installation" - - -static void ll_unloadlib (void *lib) { - (void)(lib); /* not used */ -} - - -static void *ll_load (lua_State *L, const char *path, int seeglb) { - (void)(path); (void)(seeglb); /* not used */ - lua_pushliteral(L, DLMSG); - return NULL; -} - - -static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { - (void)(lib); (void)(sym); /* not used */ - lua_pushliteral(L, DLMSG); - return NULL; -} - -/* }====================================================== */ -#endif - - -static void *ll_checkclib (lua_State *L, const char *path) { - void *plib; - lua_getfield(L, LUA_REGISTRYINDEX, CLIBS); - lua_getfield(L, -1, path); - plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */ - lua_pop(L, 2); /* pop CLIBS table and 'plib' */ - return plib; -} - - -static void ll_addtoclib (lua_State *L, const char *path, void *plib) { - lua_getfield(L, LUA_REGISTRYINDEX, CLIBS); - lua_pushlightuserdata(L, plib); - lua_pushvalue(L, -1); - lua_setfield(L, -3, path); /* CLIBS[path] = plib */ - lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */ - lua_pop(L, 1); /* pop CLIBS table */ -} - - -/* -** __gc tag method for CLIBS table: calls 'll_unloadlib' for all lib -** handles in list CLIBS -*/ -static int gctm (lua_State *L) { - int n = luaL_len(L, 1); - for (; n >= 1; n--) { /* for each handle, in reverse order */ - lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */ - ll_unloadlib(lua_touserdata(L, -1)); - lua_pop(L, 1); /* pop handle */ - } - return 0; -} - - -static int ll_loadfunc (lua_State *L, const char *path, const char *sym) { - void *reg = ll_checkclib(L, path); /* check loaded C libraries */ - if (reg == NULL) { /* must load library? */ - reg = ll_load(L, path, *sym == '*'); - if (reg == NULL) return ERRLIB; /* unable to load library */ - ll_addtoclib(L, path, reg); - } - if (*sym == '*') { /* loading only library (no function)? */ - lua_pushboolean(L, 1); /* return 'true' */ - return 0; /* no errors */ - } - else { - lua_CFunction f = ll_sym(L, reg, sym); - if (f == NULL) - return ERRFUNC; /* unable to find function */ - lua_pushcfunction(L, f); /* else create new function */ - return 0; /* no errors */ - } -} - - -static int ll_loadlib (lua_State *L) { - const char *path = luaL_checkstring(L, 1); - const char *init = luaL_checkstring(L, 2); - int stat = ll_loadfunc(L, path, init); - if (stat == 0) /* no errors? */ - return 1; /* return the loaded function */ - else { /* error; error message is on stack top */ - lua_pushnil(L); - lua_insert(L, -2); - lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init"); - return 3; /* return nil, error message, and where */ - } -} - - - -/* -** {====================================================== -** 'require' function -** ======================================================= -*/ - - -static int readable (const char *filename) { - FILE *f = fopen(filename, "r"); /* try to open file */ - if (f == NULL) return 0; /* open failed */ - fclose(f); - return 1; -} - - -static const char *pushnexttemplate (lua_State *L, const char *path) { - const char *l; - while (*path == *LUA_PATH_SEP) path++; /* skip separators */ - if (*path == '\0') return NULL; /* no more templates */ - l = strchr(path, *LUA_PATH_SEP); /* find next separator */ - if (l == NULL) l = path + strlen(path); - lua_pushlstring(L, path, l - path); /* template */ - return l; -} - - -static const char *searchpath (lua_State *L, const char *name, - const char *path, - const char *sep, - const char *dirsep) { - luaL_Buffer msg; /* to build error message */ - luaL_buffinit(L, &msg); - if (*sep != '\0') /* non-empty separator? */ - name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */ - while ((path = pushnexttemplate(L, path)) != NULL) { - const char *filename = luaL_gsub(L, lua_tostring(L, -1), - LUA_PATH_MARK, name); - lua_remove(L, -2); /* remove path template */ - if (readable(filename)) /* does file exist and is readable? */ - return filename; /* return that file name */ - lua_pushfstring(L, "\n\tno file " LUA_QS, filename); - lua_remove(L, -2); /* remove file name */ - luaL_addvalue(&msg); /* concatenate error msg. entry */ - } - luaL_pushresult(&msg); /* create error message */ - return NULL; /* not found */ -} - - -static int ll_searchpath (lua_State *L) { - const char *f = searchpath(L, luaL_checkstring(L, 1), - luaL_checkstring(L, 2), - luaL_optstring(L, 3, "."), - luaL_optstring(L, 4, LUA_DIRSEP)); - if (f != NULL) return 1; - else { /* error message is on top of the stack */ - lua_pushnil(L); - lua_insert(L, -2); - return 2; /* return nil + error message */ - } -} - - -static const char *findfile (lua_State *L, const char *name, - const char *pname, - const char *dirsep) { - const char *path; - lua_getfield(L, lua_upvalueindex(1), pname); - path = lua_tostring(L, -1); - if (path == NULL) - luaL_error(L, LUA_QL("package.%s") " must be a string", pname); - return searchpath(L, name, path, ".", dirsep); -} - - -static int checkload (lua_State *L, int stat, const char *filename) { - if (stat) { /* module loaded successfully? */ - lua_pushstring(L, filename); /* will be 2nd argument to module */ - return 2; /* return open function and file name */ - } - else - return luaL_error(L, "error loading module " LUA_QS - " from file " LUA_QS ":\n\t%s", - lua_tostring(L, 1), filename, lua_tostring(L, -1)); -} - - -static int searcher_Lua (lua_State *L) { - const char *filename; - const char *name = luaL_checkstring(L, 1); - filename = findfile(L, name, "path", LUA_LSUBSEP); - if (filename == NULL) return 1; /* module not found in this path */ - return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename); -} - - -static int loadfunc (lua_State *L, const char *filename, const char *modname) { - const char *funcname; - const char *mark; - modname = luaL_gsub(L, modname, ".", LUA_OFSEP); - mark = strchr(modname, *LUA_IGMARK); - if (mark) { - int stat; - funcname = lua_pushlstring(L, modname, mark - modname); - funcname = lua_pushfstring(L, LUA_POF"%s", funcname); - stat = ll_loadfunc(L, filename, funcname); - if (stat != ERRFUNC) return stat; - modname = mark + 1; /* else go ahead and try old-style name */ - } - funcname = lua_pushfstring(L, LUA_POF"%s", modname); - return ll_loadfunc(L, filename, funcname); -} - - -static int searcher_C (lua_State *L) { - const char *name = luaL_checkstring(L, 1); - const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP); - if (filename == NULL) return 1; /* module not found in this path */ - return checkload(L, (loadfunc(L, filename, name) == 0), filename); -} - - -static int searcher_Croot (lua_State *L) { - const char *filename; - const char *name = luaL_checkstring(L, 1); - const char *p = strchr(name, '.'); - int stat; - if (p == NULL) return 0; /* is root */ - lua_pushlstring(L, name, p - name); - filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP); - if (filename == NULL) return 1; /* root not found */ - if ((stat = loadfunc(L, filename, name)) != 0) { - if (stat != ERRFUNC) - return checkload(L, 0, filename); /* real error */ - else { /* open function not found */ - lua_pushfstring(L, "\n\tno module " LUA_QS " in file " LUA_QS, - name, filename); - return 1; - } - } - lua_pushstring(L, filename); /* will be 2nd argument to module */ - return 2; -} - - -static int searcher_preload (lua_State *L) { - const char *name = luaL_checkstring(L, 1); - lua_getfield(L, LUA_REGISTRYINDEX, "_PRELOAD"); - lua_getfield(L, -1, name); - if (lua_isnil(L, -1)) /* not found? */ - lua_pushfstring(L, "\n\tno field package.preload['%s']", name); - return 1; -} - - -static void findloader (lua_State *L, const char *name) { - int i; - luaL_Buffer msg; /* to build error message */ - luaL_buffinit(L, &msg); - lua_getfield(L, lua_upvalueindex(1), "searchers"); /* will be at index 3 */ - if (!lua_istable(L, 3)) - luaL_error(L, LUA_QL("package.searchers") " must be a table"); - /* iterate over available searchers to find a loader */ - for (i = 1; ; i++) { - lua_rawgeti(L, 3, i); /* get a searcher */ - if (lua_isnil(L, -1)) { /* no more searchers? */ - lua_pop(L, 1); /* remove nil */ - luaL_pushresult(&msg); /* create error message */ - luaL_error(L, "module " LUA_QS " not found:%s", - name, lua_tostring(L, -1)); - } - lua_pushstring(L, name); - lua_call(L, 1, 2); /* call it */ - if (lua_isfunction(L, -2)) /* did it find a loader? */ - return; /* module loader found */ - else if (lua_isstring(L, -2)) { /* searcher returned error message? */ - lua_pop(L, 1); /* remove extra return */ - luaL_addvalue(&msg); /* concatenate error message */ - } - else - lua_pop(L, 2); /* remove both returns */ - } -} - - -static int ll_require (lua_State *L) { - const char *name = luaL_checkstring(L, 1); - lua_settop(L, 1); /* _LOADED table will be at index 2 */ - lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); - lua_getfield(L, 2, name); /* _LOADED[name] */ - if (lua_toboolean(L, -1)) /* is it there? */ - return 1; /* package is already loaded */ - /* else must load package */ - lua_pop(L, 1); /* remove 'getfield' result */ - findloader(L, name); - lua_pushstring(L, name); /* pass name as argument to module loader */ - lua_insert(L, -2); /* name is 1st argument (before search data) */ - lua_call(L, 2, 1); /* run loader to load module */ - if (!lua_isnil(L, -1)) /* non-nil return? */ - lua_setfield(L, 2, name); /* _LOADED[name] = returned value */ - lua_getfield(L, 2, name); - if (lua_isnil(L, -1)) { /* module did not set a value? */ - lua_pushboolean(L, 1); /* use true as result */ - lua_pushvalue(L, -1); /* extra copy to be returned */ - lua_setfield(L, 2, name); /* _LOADED[name] = true */ - } - return 1; -} - -/* }====================================================== */ - - - -/* -** {====================================================== -** 'module' function -** ======================================================= -*/ -#if defined(LUA_COMPAT_MODULE) - -/* -** changes the environment variable of calling function -*/ -static void set_env (lua_State *L) { - lua_Debug ar; - if (lua_getstack(L, 1, &ar) == 0 || - lua_getinfo(L, "f", &ar) == 0 || /* get calling function */ - lua_iscfunction(L, -1)) - luaL_error(L, LUA_QL("module") " not called from a Lua function"); - lua_pushvalue(L, -2); /* copy new environment table to top */ - lua_setupvalue(L, -2, 1); - lua_pop(L, 1); /* remove function */ -} - - -static void dooptions (lua_State *L, int n) { - int i; - for (i = 2; i <= n; i++) { - if (lua_isfunction(L, i)) { /* avoid 'calling' extra info. */ - lua_pushvalue(L, i); /* get option (a function) */ - lua_pushvalue(L, -2); /* module */ - lua_call(L, 1, 0); - } - } -} - - -static void modinit (lua_State *L, const char *modname) { - const char *dot; - lua_pushvalue(L, -1); - lua_setfield(L, -2, "_M"); /* module._M = module */ - lua_pushstring(L, modname); - lua_setfield(L, -2, "_NAME"); - dot = strrchr(modname, '.'); /* look for last dot in module name */ - if (dot == NULL) dot = modname; - else dot++; - /* set _PACKAGE as package name (full module name minus last part) */ - lua_pushlstring(L, modname, dot - modname); - lua_setfield(L, -2, "_PACKAGE"); -} - - -static int ll_module (lua_State *L) { - const char *modname = luaL_checkstring(L, 1); - int lastarg = lua_gettop(L); /* last parameter */ - luaL_pushmodule(L, modname, 1); /* get/create module table */ - /* check whether table already has a _NAME field */ - lua_getfield(L, -1, "_NAME"); - if (!lua_isnil(L, -1)) /* is table an initialized module? */ - lua_pop(L, 1); - else { /* no; initialize it */ - lua_pop(L, 1); - modinit(L, modname); - } - lua_pushvalue(L, -1); - set_env(L); - dooptions(L, lastarg); - return 1; -} - - -static int ll_seeall (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - if (!lua_getmetatable(L, 1)) { - lua_createtable(L, 0, 1); /* create new metatable */ - lua_pushvalue(L, -1); - lua_setmetatable(L, 1); - } - lua_pushglobaltable(L); - lua_setfield(L, -2, "__index"); /* mt.__index = _G */ - return 0; -} - -#endif -/* }====================================================== */ - - - -/* auxiliary mark (for internal use) */ -#define AUXMARK "\1" - - -/* -** return registry.LUA_NOENV as a boolean -*/ -static int noenv (lua_State *L) { - int b; - lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV"); - b = lua_toboolean(L, -1); - lua_pop(L, 1); /* remove value */ - return b; -} - - -static void setpath (lua_State *L, const char *fieldname, const char *envname1, - const char *envname2, const char *def) { - const char *path = getenv(envname1); - if (path == NULL) /* no environment variable? */ - path = getenv(envname2); /* try alternative name */ - if (path == NULL || noenv(L)) /* no environment variable? */ - lua_pushstring(L, def); /* use default */ - else { - /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */ - path = luaL_gsub(L, path, LUA_PATH_SEP LUA_PATH_SEP, - LUA_PATH_SEP AUXMARK LUA_PATH_SEP); - luaL_gsub(L, path, AUXMARK, def); - lua_remove(L, -2); - } - setprogdir(L); - lua_setfield(L, -2, fieldname); -} - - -static const luaL_Reg pk_funcs[] = { - {"loadlib", ll_loadlib}, - {"searchpath", ll_searchpath}, -#if defined(LUA_COMPAT_MODULE) - {"seeall", ll_seeall}, -#endif - {NULL, NULL} -}; - - -static const luaL_Reg ll_funcs[] = { -#if defined(LUA_COMPAT_MODULE) - {"module", ll_module}, -#endif - {"require", ll_require}, - {NULL, NULL} -}; - - -static void createsearcherstable (lua_State *L) { - static const lua_CFunction searchers[] = - {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL}; - int i; - /* create 'searchers' table */ - lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0); - /* fill it with pre-defined searchers */ - for (i=0; searchers[i] != NULL; i++) { - lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */ - lua_pushcclosure(L, searchers[i], 1); - lua_rawseti(L, -2, i+1); - } -} - - -LUAMOD_API int luaopen_package (lua_State *L) { - /* create table CLIBS to keep track of loaded C libraries */ - luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); - lua_createtable(L, 0, 1); /* metatable for CLIBS */ - lua_pushcfunction(L, gctm); - lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */ - lua_setmetatable(L, -2); - /* create `package' table */ - luaL_newlib(L, pk_funcs); - createsearcherstable(L); -#if defined(LUA_COMPAT_LOADERS) - lua_pushvalue(L, -1); /* make a copy of 'searchers' table */ - lua_setfield(L, -3, "loaders"); /* put it in field `loaders' */ -#endif - lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */ - /* set field 'path' */ - setpath(L, "path", LUA_PATHVERSION, LUA_PATH, LUA_PATH_DEFAULT); - /* set field 'cpath' */ - setpath(L, "cpath", LUA_CPATHVERSION, LUA_CPATH, LUA_CPATH_DEFAULT); - /* store config information */ - lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n" - LUA_EXEC_DIR "\n" LUA_IGMARK "\n"); - lua_setfield(L, -2, "config"); - /* set field `loaded' */ - luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED"); - lua_setfield(L, -2, "loaded"); - /* set field `preload' */ - luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD"); - lua_setfield(L, -2, "preload"); - lua_pushglobaltable(L); - lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */ - luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */ - lua_pop(L, 1); /* pop global table */ - return 1; /* return 'package' table */ -} - diff --git a/ext/lua/src/lobject.c b/ext/lua/src/lobject.c deleted file mode 100644 index 882d994d41..0000000000 --- a/ext/lua/src/lobject.c +++ /dev/null @@ -1,287 +0,0 @@ -/* -** $Id: lobject.c,v 2.58.1.1 2013/04/12 18:48:47 roberto Exp $ -** Some generic functions over Lua objects -** See Copyright Notice in lua.h -*/ - -#include -#include -#include -#include - -#define lobject_c -#define LUA_CORE - -#include "lua.h" - -#include "lctype.h" -#include "ldebug.h" -#include "ldo.h" -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" -#include "lstring.h" -#include "lvm.h" - - - -LUAI_DDEF const TValue luaO_nilobject_ = {NILCONSTANT}; - - -/* -** converts an integer to a "floating point byte", represented as -** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if -** eeeee != 0 and (xxx) otherwise. -*/ -int luaO_int2fb (unsigned int x) { - int e = 0; /* exponent */ - if (x < 8) return x; - while (x >= 0x10) { - x = (x+1) >> 1; - e++; - } - return ((e+1) << 3) | (cast_int(x) - 8); -} - - -/* converts back */ -int luaO_fb2int (int x) { - int e = (x >> 3) & 0x1f; - if (e == 0) return x; - else return ((x & 7) + 8) << (e - 1); -} - - -int luaO_ceillog2 (unsigned int x) { - static const lu_byte log_2[256] = { - 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, - 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, - 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, - 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, - 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, - 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, - 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, - 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8 - }; - int l = 0; - x--; - while (x >= 256) { l += 8; x >>= 8; } - return l + log_2[x]; -} - - -lua_Number luaO_arith (int op, lua_Number v1, lua_Number v2) { - switch (op) { - case LUA_OPADD: return luai_numadd(NULL, v1, v2); - case LUA_OPSUB: return luai_numsub(NULL, v1, v2); - case LUA_OPMUL: return luai_nummul(NULL, v1, v2); - case LUA_OPDIV: return luai_numdiv(NULL, v1, v2); - case LUA_OPMOD: return luai_nummod(NULL, v1, v2); - case LUA_OPPOW: return luai_numpow(NULL, v1, v2); - case LUA_OPUNM: return luai_numunm(NULL, v1); - default: lua_assert(0); return 0; - } -} - - -int luaO_hexavalue (int c) { - if (lisdigit(c)) return c - '0'; - else return ltolower(c) - 'a' + 10; -} - - -#if !defined(lua_strx2number) - -#include - - -static int isneg (const char **s) { - if (**s == '-') { (*s)++; return 1; } - else if (**s == '+') (*s)++; - return 0; -} - - -static lua_Number readhexa (const char **s, lua_Number r, int *count) { - for (; lisxdigit(cast_uchar(**s)); (*s)++) { /* read integer part */ - r = (r * cast_num(16.0)) + cast_num(luaO_hexavalue(cast_uchar(**s))); - (*count)++; - } - return r; -} - - -/* -** convert an hexadecimal numeric string to a number, following -** C99 specification for 'strtod' -*/ -static lua_Number lua_strx2number (const char *s, char **endptr) { - lua_Number r = 0.0; - int e = 0, i = 0; - int neg = 0; /* 1 if number is negative */ - *endptr = cast(char *, s); /* nothing is valid yet */ - while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */ - neg = isneg(&s); /* check signal */ - if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */ - return 0.0; /* invalid format (no '0x') */ - s += 2; /* skip '0x' */ - r = readhexa(&s, r, &i); /* read integer part */ - if (*s == '.') { - s++; /* skip dot */ - r = readhexa(&s, r, &e); /* read fractional part */ - } - if (i == 0 && e == 0) - return 0.0; /* invalid format (no digit) */ - e *= -4; /* each fractional digit divides value by 2^-4 */ - *endptr = cast(char *, s); /* valid up to here */ - if (*s == 'p' || *s == 'P') { /* exponent part? */ - int exp1 = 0; - int neg1; - s++; /* skip 'p' */ - neg1 = isneg(&s); /* signal */ - if (!lisdigit(cast_uchar(*s))) - goto ret; /* must have at least one digit */ - while (lisdigit(cast_uchar(*s))) /* read exponent */ - exp1 = exp1 * 10 + *(s++) - '0'; - if (neg1) exp1 = -exp1; - e += exp1; - } - *endptr = cast(char *, s); /* valid up to here */ - ret: - if (neg) r = -r; - return l_mathop(ldexp)(r, e); -} - -#endif - - -int luaO_str2d (const char *s, size_t len, lua_Number *result) { - char *endptr; - if (strpbrk(s, "nN")) /* reject 'inf' and 'nan' */ - return 0; - else if (strpbrk(s, "xX")) /* hexa? */ - *result = lua_strx2number(s, &endptr); - else - *result = lua_str2number(s, &endptr); - if (endptr == s) return 0; /* nothing recognized */ - while (lisspace(cast_uchar(*endptr))) endptr++; - return (endptr == s + len); /* OK if no trailing characters */ -} - - - -static void pushstr (lua_State *L, const char *str, size_t l) { - setsvalue2s(L, L->top++, luaS_newlstr(L, str, l)); -} - - -/* this function handles only `%d', `%c', %f, %p, and `%s' formats */ -const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { - int n = 0; - for (;;) { - const char *e = strchr(fmt, '%'); - if (e == NULL) break; - luaD_checkstack(L, 2); /* fmt + item */ - pushstr(L, fmt, e - fmt); - switch (*(e+1)) { - case 's': { - const char *s = va_arg(argp, char *); - if (s == NULL) s = "(null)"; - pushstr(L, s, strlen(s)); - break; - } - case 'c': { - char buff; - buff = cast(char, va_arg(argp, int)); - pushstr(L, &buff, 1); - break; - } - case 'd': { - setnvalue(L->top++, cast_num(va_arg(argp, int))); - break; - } - case 'f': { - setnvalue(L->top++, cast_num(va_arg(argp, l_uacNumber))); - break; - } - case 'p': { - char buff[4*sizeof(void *) + 8]; /* should be enough space for a `%p' */ - int l = sprintf(buff, "%p", va_arg(argp, void *)); - pushstr(L, buff, l); - break; - } - case '%': { - pushstr(L, "%", 1); - break; - } - default: { - luaG_runerror(L, - "invalid option " LUA_QL("%%%c") " to " LUA_QL("lua_pushfstring"), - *(e + 1)); - } - } - n += 2; - fmt = e+2; - } - luaD_checkstack(L, 1); - pushstr(L, fmt, strlen(fmt)); - if (n > 0) luaV_concat(L, n + 1); - return svalue(L->top - 1); -} - - -const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) { - const char *msg; - va_list argp; - va_start(argp, fmt); - msg = luaO_pushvfstring(L, fmt, argp); - va_end(argp); - return msg; -} - - -/* number of chars of a literal string without the ending \0 */ -#define LL(x) (sizeof(x)/sizeof(char) - 1) - -#define RETS "..." -#define PRE "[string \"" -#define POS "\"]" - -#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) ) - -void luaO_chunkid (char *out, const char *source, size_t bufflen) { - size_t l = strlen(source); - if (*source == '=') { /* 'literal' source */ - if (l <= bufflen) /* small enough? */ - memcpy(out, source + 1, l * sizeof(char)); - else { /* truncate it */ - addstr(out, source + 1, bufflen - 1); - *out = '\0'; - } - } - else if (*source == '@') { /* file name */ - if (l <= bufflen) /* small enough? */ - memcpy(out, source + 1, l * sizeof(char)); - else { /* add '...' before rest of name */ - addstr(out, RETS, LL(RETS)); - bufflen -= LL(RETS); - memcpy(out, source + 1 + l - bufflen, bufflen * sizeof(char)); - } - } - else { /* string; format as [string "source"] */ - const char *nl = strchr(source, '\n'); /* find first new line (if any) */ - addstr(out, PRE, LL(PRE)); /* add prefix */ - bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */ - if (l < bufflen && nl == NULL) { /* small one-line source? */ - addstr(out, source, l); /* keep it */ - } - else { - if (nl != NULL) l = nl - source; /* stop at first newline */ - if (l > bufflen) l = bufflen; - addstr(out, source, l); - addstr(out, RETS, LL(RETS)); - } - memcpy(out, POS, (LL(POS) + 1) * sizeof(char)); - } -} - diff --git a/ext/lua/src/lopcodes.c b/ext/lua/src/lopcodes.c deleted file mode 100644 index 4190dc7624..0000000000 --- a/ext/lua/src/lopcodes.c +++ /dev/null @@ -1,107 +0,0 @@ -/* -** $Id: lopcodes.c,v 1.49.1.1 2013/04/12 18:48:47 roberto Exp $ -** Opcodes for Lua virtual machine -** See Copyright Notice in lua.h -*/ - - -#define lopcodes_c -#define LUA_CORE - - -#include "lopcodes.h" - - -/* ORDER OP */ - -LUAI_DDEF const char *const luaP_opnames[NUM_OPCODES+1] = { - "MOVE", - "LOADK", - "LOADKX", - "LOADBOOL", - "LOADNIL", - "GETUPVAL", - "GETTABUP", - "GETTABLE", - "SETTABUP", - "SETUPVAL", - "SETTABLE", - "NEWTABLE", - "SELF", - "ADD", - "SUB", - "MUL", - "DIV", - "MOD", - "POW", - "UNM", - "NOT", - "LEN", - "CONCAT", - "JMP", - "EQ", - "LT", - "LE", - "TEST", - "TESTSET", - "CALL", - "TAILCALL", - "RETURN", - "FORLOOP", - "FORPREP", - "TFORCALL", - "TFORLOOP", - "SETLIST", - "CLOSURE", - "VARARG", - "EXTRAARG", - NULL -}; - - -#define opmode(t,a,b,c,m) (((t)<<7) | ((a)<<6) | ((b)<<4) | ((c)<<2) | (m)) - -LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { -/* T A B C mode opcode */ - opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_MOVE */ - ,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_LOADK */ - ,opmode(0, 1, OpArgN, OpArgN, iABx) /* OP_LOADKX */ - ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_LOADBOOL */ - ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_LOADNIL */ - ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_GETUPVAL */ - ,opmode(0, 1, OpArgU, OpArgK, iABC) /* OP_GETTABUP */ - ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_GETTABLE */ - ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABUP */ - ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_SETUPVAL */ - ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABLE */ - ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_NEWTABLE */ - ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_SELF */ - ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_ADD */ - ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SUB */ - ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MUL */ - ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_DIV */ - ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MOD */ - ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_POW */ - ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_UNM */ - ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_NOT */ - ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LEN */ - ,opmode(0, 1, OpArgR, OpArgR, iABC) /* OP_CONCAT */ - ,opmode(0, 0, OpArgR, OpArgN, iAsBx) /* OP_JMP */ - ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_EQ */ - ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LT */ - ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LE */ - ,opmode(1, 0, OpArgN, OpArgU, iABC) /* OP_TEST */ - ,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TESTSET */ - ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_CALL */ - ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_TAILCALL */ - ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_RETURN */ - ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORLOOP */ - ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORPREP */ - ,opmode(0, 0, OpArgN, OpArgU, iABC) /* OP_TFORCALL */ - ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_TFORLOOP */ - ,opmode(0, 0, OpArgU, OpArgU, iABC) /* OP_SETLIST */ - ,opmode(0, 1, OpArgU, OpArgN, iABx) /* OP_CLOSURE */ - ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_VARARG */ - ,opmode(0, 0, OpArgU, OpArgU, iAx) /* OP_EXTRAARG */ -}; - diff --git a/ext/lua/src/loslib.c b/ext/lua/src/loslib.c deleted file mode 100644 index 052ba17441..0000000000 --- a/ext/lua/src/loslib.c +++ /dev/null @@ -1,323 +0,0 @@ -/* -** $Id: loslib.c,v 1.40.1.1 2013/04/12 18:48:47 roberto Exp $ -** Standard Operating System library -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include -#include -#include - -#define loslib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -/* -** list of valid conversion specifiers for the 'strftime' function -*/ -#if !defined(LUA_STRFTIMEOPTIONS) - -#if !defined(LUA_USE_POSIX) -#define LUA_STRFTIMEOPTIONS { "aAbBcdHIjmMpSUwWxXyYz%", "" } -#else -#define LUA_STRFTIMEOPTIONS \ - { "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%", "" \ - "", "E", "cCxXyY", \ - "O", "deHImMSuUVwWy" } -#endif - -#endif - - - -/* -** By default, Lua uses tmpnam except when POSIX is available, where it -** uses mkstemp. -*/ -#if defined(LUA_USE_MKSTEMP) -#include -#define LUA_TMPNAMBUFSIZE 32 -#define lua_tmpnam(b,e) { \ - strcpy(b, "/tmp/lua_XXXXXX"); \ - e = mkstemp(b); \ - if (e != -1) close(e); \ - e = (e == -1); } - -#elif !defined(lua_tmpnam) - -#define LUA_TMPNAMBUFSIZE L_tmpnam -#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); } - -#endif - - -/* -** By default, Lua uses gmtime/localtime, except when POSIX is available, -** where it uses gmtime_r/localtime_r -*/ -#if defined(LUA_USE_GMTIME_R) - -#define l_gmtime(t,r) gmtime_r(t,r) -#define l_localtime(t,r) localtime_r(t,r) - -#elif !defined(l_gmtime) - -#define l_gmtime(t,r) ((void)r, gmtime(t)) -#define l_localtime(t,r) ((void)r, localtime(t)) - -#endif - - - -static int os_execute (lua_State *L) { - const char *cmd = luaL_optstring(L, 1, NULL); - int stat = system(cmd); - if (cmd != NULL) - return luaL_execresult(L, stat); - else { - lua_pushboolean(L, stat); /* true if there is a shell */ - return 1; - } -} - - -static int os_remove (lua_State *L) { - const char *filename = luaL_checkstring(L, 1); - return luaL_fileresult(L, remove(filename) == 0, filename); -} - - -static int os_rename (lua_State *L) { - const char *fromname = luaL_checkstring(L, 1); - const char *toname = luaL_checkstring(L, 2); - return luaL_fileresult(L, rename(fromname, toname) == 0, NULL); -} - - -static int os_tmpname (lua_State *L) { - char buff[LUA_TMPNAMBUFSIZE]; - int err; - lua_tmpnam(buff, err); - if (err) - return luaL_error(L, "unable to generate a unique filename"); - lua_pushstring(L, buff); - return 1; -} - - -static int os_getenv (lua_State *L) { - lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */ - return 1; -} - - -static int os_clock (lua_State *L) { - lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC); - return 1; -} - - -/* -** {====================================================== -** Time/Date operations -** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S, -** wday=%w+1, yday=%j, isdst=? } -** ======================================================= -*/ - -static void setfield (lua_State *L, const char *key, int value) { - lua_pushinteger(L, value); - lua_setfield(L, -2, key); -} - -static void setboolfield (lua_State *L, const char *key, int value) { - if (value < 0) /* undefined? */ - return; /* does not set field */ - lua_pushboolean(L, value); - lua_setfield(L, -2, key); -} - -static int getboolfield (lua_State *L, const char *key) { - int res; - lua_getfield(L, -1, key); - res = lua_isnil(L, -1) ? -1 : lua_toboolean(L, -1); - lua_pop(L, 1); - return res; -} - - -static int getfield (lua_State *L, const char *key, int d) { - int res, isnum; - lua_getfield(L, -1, key); - res = (int)lua_tointegerx(L, -1, &isnum); - if (!isnum) { - if (d < 0) - return luaL_error(L, "field " LUA_QS " missing in date table", key); - res = d; - } - lua_pop(L, 1); - return res; -} - - -static const char *checkoption (lua_State *L, const char *conv, char *buff) { - static const char *const options[] = LUA_STRFTIMEOPTIONS; - unsigned int i; - for (i = 0; i < sizeof(options)/sizeof(options[0]); i += 2) { - if (*conv != '\0' && strchr(options[i], *conv) != NULL) { - buff[1] = *conv; - if (*options[i + 1] == '\0') { /* one-char conversion specifier? */ - buff[2] = '\0'; /* end buffer */ - return conv + 1; - } - else if (*(conv + 1) != '\0' && - strchr(options[i + 1], *(conv + 1)) != NULL) { - buff[2] = *(conv + 1); /* valid two-char conversion specifier */ - buff[3] = '\0'; /* end buffer */ - return conv + 2; - } - } - } - luaL_argerror(L, 1, - lua_pushfstring(L, "invalid conversion specifier '%%%s'", conv)); - return conv; /* to avoid warnings */ -} - - -static int os_date (lua_State *L) { - const char *s = luaL_optstring(L, 1, "%c"); - time_t t = luaL_opt(L, (time_t)luaL_checknumber, 2, time(NULL)); - struct tm tmr, *stm; - if (*s == '!') { /* UTC? */ - stm = l_gmtime(&t, &tmr); - s++; /* skip `!' */ - } - else - stm = l_localtime(&t, &tmr); - if (stm == NULL) /* invalid date? */ - lua_pushnil(L); - else if (strcmp(s, "*t") == 0) { - lua_createtable(L, 0, 9); /* 9 = number of fields */ - setfield(L, "sec", stm->tm_sec); - setfield(L, "min", stm->tm_min); - setfield(L, "hour", stm->tm_hour); - setfield(L, "day", stm->tm_mday); - setfield(L, "month", stm->tm_mon+1); - setfield(L, "year", stm->tm_year+1900); - setfield(L, "wday", stm->tm_wday+1); - setfield(L, "yday", stm->tm_yday+1); - setboolfield(L, "isdst", stm->tm_isdst); - } - else { - char cc[4]; - luaL_Buffer b; - cc[0] = '%'; - luaL_buffinit(L, &b); - while (*s) { - if (*s != '%') /* no conversion specifier? */ - luaL_addchar(&b, *s++); - else { - size_t reslen; - char buff[200]; /* should be big enough for any conversion result */ - s = checkoption(L, s + 1, cc); - reslen = strftime(buff, sizeof(buff), cc, stm); - luaL_addlstring(&b, buff, reslen); - } - } - luaL_pushresult(&b); - } - return 1; -} - - -static int os_time (lua_State *L) { - time_t t; - if (lua_isnoneornil(L, 1)) /* called without args? */ - t = time(NULL); /* get current time */ - else { - struct tm ts; - luaL_checktype(L, 1, LUA_TTABLE); - lua_settop(L, 1); /* make sure table is at the top */ - ts.tm_sec = getfield(L, "sec", 0); - ts.tm_min = getfield(L, "min", 0); - ts.tm_hour = getfield(L, "hour", 12); - ts.tm_mday = getfield(L, "day", -1); - ts.tm_mon = getfield(L, "month", -1) - 1; - ts.tm_year = getfield(L, "year", -1) - 1900; - ts.tm_isdst = getboolfield(L, "isdst"); - t = mktime(&ts); - } - if (t == (time_t)(-1)) - lua_pushnil(L); - else - lua_pushnumber(L, (lua_Number)t); - return 1; -} - - -static int os_difftime (lua_State *L) { - lua_pushnumber(L, difftime((time_t)(luaL_checknumber(L, 1)), - (time_t)(luaL_optnumber(L, 2, 0)))); - return 1; -} - -/* }====================================================== */ - - -static int os_setlocale (lua_State *L) { - static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, - LC_NUMERIC, LC_TIME}; - static const char *const catnames[] = {"all", "collate", "ctype", "monetary", - "numeric", "time", NULL}; - const char *l = luaL_optstring(L, 1, NULL); - int op = luaL_checkoption(L, 2, "all", catnames); - lua_pushstring(L, setlocale(cat[op], l)); - return 1; -} - - -static int os_exit (lua_State *L) { - int status; - if (lua_isboolean(L, 1)) - status = (lua_toboolean(L, 1) ? EXIT_SUCCESS : EXIT_FAILURE); - else - status = luaL_optint(L, 1, EXIT_SUCCESS); - if (lua_toboolean(L, 2)) - lua_close(L); - if (L) exit(status); /* 'if' to avoid warnings for unreachable 'return' */ - return 0; -} - - -static const luaL_Reg syslib[] = { - {"clock", os_clock}, - {"date", os_date}, - {"difftime", os_difftime}, - {"execute", os_execute}, - {"exit", os_exit}, - {"getenv", os_getenv}, - {"remove", os_remove}, - {"rename", os_rename}, - {"setlocale", os_setlocale}, - {"time", os_time}, - {"tmpname", os_tmpname}, - {NULL, NULL} -}; - -/* }====================================================== */ - - - -LUAMOD_API int luaopen_os (lua_State *L) { - luaL_newlib(L, syslib); - return 1; -} - diff --git a/ext/lua/src/lparser.c b/ext/lua/src/lparser.c deleted file mode 100644 index 9e1a9ca2cf..0000000000 --- a/ext/lua/src/lparser.c +++ /dev/null @@ -1,1638 +0,0 @@ -/* -** $Id: lparser.c,v 2.130.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua Parser -** See Copyright Notice in lua.h -*/ - - -#include - -#define lparser_c -#define LUA_CORE - -#include "lua.h" - -#include "lcode.h" -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "llex.h" -#include "lmem.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lparser.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" - - - -/* maximum number of local variables per function (must be smaller - than 250, due to the bytecode format) */ -#define MAXVARS 200 - - -#define hasmultret(k) ((k) == VCALL || (k) == VVARARG) - - - -/* -** nodes for block list (list of active blocks) -*/ -typedef struct BlockCnt { - struct BlockCnt *previous; /* chain */ - short firstlabel; /* index of first label in this block */ - short firstgoto; /* index of first pending goto in this block */ - lu_byte nactvar; /* # active locals outside the block */ - lu_byte upval; /* true if some variable in the block is an upvalue */ - lu_byte isloop; /* true if `block' is a loop */ -} BlockCnt; - - - -/* -** prototypes for recursive non-terminal functions -*/ -static void statement (LexState *ls); -static void expr (LexState *ls, expdesc *v); - - -static void anchor_token (LexState *ls) { - /* last token from outer function must be EOS */ - lua_assert(ls->fs != NULL || ls->t.token == TK_EOS); - if (ls->t.token == TK_NAME || ls->t.token == TK_STRING) { - TString *ts = ls->t.seminfo.ts; - luaX_newstring(ls, getstr(ts), ts->tsv.len); - } -} - - -/* semantic error */ -static l_noret semerror (LexState *ls, const char *msg) { - ls->t.token = 0; /* remove 'near to' from final message */ - luaX_syntaxerror(ls, msg); -} - - -static l_noret error_expected (LexState *ls, int token) { - luaX_syntaxerror(ls, - luaO_pushfstring(ls->L, "%s expected", luaX_token2str(ls, token))); -} - - -static l_noret errorlimit (FuncState *fs, int limit, const char *what) { - lua_State *L = fs->ls->L; - const char *msg; - int line = fs->f->linedefined; - const char *where = (line == 0) - ? "main function" - : luaO_pushfstring(L, "function at line %d", line); - msg = luaO_pushfstring(L, "too many %s (limit is %d) in %s", - what, limit, where); - luaX_syntaxerror(fs->ls, msg); -} - - -static void checklimit (FuncState *fs, int v, int l, const char *what) { - if (v > l) errorlimit(fs, l, what); -} - - -static int testnext (LexState *ls, int c) { - if (ls->t.token == c) { - luaX_next(ls); - return 1; - } - else return 0; -} - - -static void check (LexState *ls, int c) { - if (ls->t.token != c) - error_expected(ls, c); -} - - -static void checknext (LexState *ls, int c) { - check(ls, c); - luaX_next(ls); -} - - -#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); } - - - -static void check_match (LexState *ls, int what, int who, int where) { - if (!testnext(ls, what)) { - if (where == ls->linenumber) - error_expected(ls, what); - else { - luaX_syntaxerror(ls, luaO_pushfstring(ls->L, - "%s expected (to close %s at line %d)", - luaX_token2str(ls, what), luaX_token2str(ls, who), where)); - } - } -} - - -static TString *str_checkname (LexState *ls) { - TString *ts; - check(ls, TK_NAME); - ts = ls->t.seminfo.ts; - luaX_next(ls); - return ts; -} - - -static void init_exp (expdesc *e, expkind k, int i) { - e->f = e->t = NO_JUMP; - e->k = k; - e->u.info = i; -} - - -static void codestring (LexState *ls, expdesc *e, TString *s) { - init_exp(e, VK, luaK_stringK(ls->fs, s)); -} - - -static void checkname (LexState *ls, expdesc *e) { - codestring(ls, e, str_checkname(ls)); -} - - -static int registerlocalvar (LexState *ls, TString *varname) { - FuncState *fs = ls->fs; - Proto *f = fs->f; - int oldsize = f->sizelocvars; - luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars, - LocVar, SHRT_MAX, "local variables"); - while (oldsize < f->sizelocvars) f->locvars[oldsize++].varname = NULL; - f->locvars[fs->nlocvars].varname = varname; - luaC_objbarrier(ls->L, f, varname); - return fs->nlocvars++; -} - - -static void new_localvar (LexState *ls, TString *name) { - FuncState *fs = ls->fs; - Dyndata *dyd = ls->dyd; - int reg = registerlocalvar(ls, name); - checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal, - MAXVARS, "local variables"); - luaM_growvector(ls->L, dyd->actvar.arr, dyd->actvar.n + 1, - dyd->actvar.size, Vardesc, MAX_INT, "local variables"); - dyd->actvar.arr[dyd->actvar.n++].idx = cast(short, reg); -} - - -static void new_localvarliteral_ (LexState *ls, const char *name, size_t sz) { - new_localvar(ls, luaX_newstring(ls, name, sz)); -} - -#define new_localvarliteral(ls,v) \ - new_localvarliteral_(ls, "" v, (sizeof(v)/sizeof(char))-1) - - -static LocVar *getlocvar (FuncState *fs, int i) { - int idx = fs->ls->dyd->actvar.arr[fs->firstlocal + i].idx; - lua_assert(idx < fs->nlocvars); - return &fs->f->locvars[idx]; -} - - -static void adjustlocalvars (LexState *ls, int nvars) { - FuncState *fs = ls->fs; - fs->nactvar = cast_byte(fs->nactvar + nvars); - for (; nvars; nvars--) { - getlocvar(fs, fs->nactvar - nvars)->startpc = fs->pc; - } -} - - -static void removevars (FuncState *fs, int tolevel) { - fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel); - while (fs->nactvar > tolevel) - getlocvar(fs, --fs->nactvar)->endpc = fs->pc; -} - - -static int searchupvalue (FuncState *fs, TString *name) { - int i; - Upvaldesc *up = fs->f->upvalues; - for (i = 0; i < fs->nups; i++) { - if (luaS_eqstr(up[i].name, name)) return i; - } - return -1; /* not found */ -} - - -static int newupvalue (FuncState *fs, TString *name, expdesc *v) { - Proto *f = fs->f; - int oldsize = f->sizeupvalues; - checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues"); - luaM_growvector(fs->ls->L, f->upvalues, fs->nups, f->sizeupvalues, - Upvaldesc, MAXUPVAL, "upvalues"); - while (oldsize < f->sizeupvalues) f->upvalues[oldsize++].name = NULL; - f->upvalues[fs->nups].instack = (v->k == VLOCAL); - f->upvalues[fs->nups].idx = cast_byte(v->u.info); - f->upvalues[fs->nups].name = name; - luaC_objbarrier(fs->ls->L, f, name); - return fs->nups++; -} - - -static int searchvar (FuncState *fs, TString *n) { - int i; - for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) { - if (luaS_eqstr(n, getlocvar(fs, i)->varname)) - return i; - } - return -1; /* not found */ -} - - -/* - Mark block where variable at given level was defined - (to emit close instructions later). -*/ -static void markupval (FuncState *fs, int level) { - BlockCnt *bl = fs->bl; - while (bl->nactvar > level) bl = bl->previous; - bl->upval = 1; -} - - -/* - Find variable with given name 'n'. If it is an upvalue, add this - upvalue into all intermediate functions. -*/ -static int singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) { - if (fs == NULL) /* no more levels? */ - return VVOID; /* default is global */ - else { - int v = searchvar(fs, n); /* look up locals at current level */ - if (v >= 0) { /* found? */ - init_exp(var, VLOCAL, v); /* variable is local */ - if (!base) - markupval(fs, v); /* local will be used as an upval */ - return VLOCAL; - } - else { /* not found as local at current level; try upvalues */ - int idx = searchupvalue(fs, n); /* try existing upvalues */ - if (idx < 0) { /* not found? */ - if (singlevaraux(fs->prev, n, var, 0) == VVOID) /* try upper levels */ - return VVOID; /* not found; is a global */ - /* else was LOCAL or UPVAL */ - idx = newupvalue(fs, n, var); /* will be a new upvalue */ - } - init_exp(var, VUPVAL, idx); - return VUPVAL; - } - } -} - - -static void singlevar (LexState *ls, expdesc *var) { - TString *varname = str_checkname(ls); - FuncState *fs = ls->fs; - if (singlevaraux(fs, varname, var, 1) == VVOID) { /* global name? */ - expdesc key; - singlevaraux(fs, ls->envn, var, 1); /* get environment variable */ - lua_assert(var->k == VLOCAL || var->k == VUPVAL); - codestring(ls, &key, varname); /* key is variable name */ - luaK_indexed(fs, var, &key); /* env[varname] */ - } -} - - -static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { - FuncState *fs = ls->fs; - int extra = nvars - nexps; - if (hasmultret(e->k)) { - extra++; /* includes call itself */ - if (extra < 0) extra = 0; - luaK_setreturns(fs, e, extra); /* last exp. provides the difference */ - if (extra > 1) luaK_reserveregs(fs, extra-1); - } - else { - if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */ - if (extra > 0) { - int reg = fs->freereg; - luaK_reserveregs(fs, extra); - luaK_nil(fs, reg, extra); - } - } -} - - -static void enterlevel (LexState *ls) { - lua_State *L = ls->L; - ++L->nCcalls; - checklimit(ls->fs, L->nCcalls, LUAI_MAXCCALLS, "C levels"); -} - - -#define leavelevel(ls) ((ls)->L->nCcalls--) - - -static void closegoto (LexState *ls, int g, Labeldesc *label) { - int i; - FuncState *fs = ls->fs; - Labellist *gl = &ls->dyd->gt; - Labeldesc *gt = &gl->arr[g]; - lua_assert(luaS_eqstr(gt->name, label->name)); - if (gt->nactvar < label->nactvar) { - TString *vname = getlocvar(fs, gt->nactvar)->varname; - const char *msg = luaO_pushfstring(ls->L, - " at line %d jumps into the scope of local " LUA_QS, - getstr(gt->name), gt->line, getstr(vname)); - semerror(ls, msg); - } - luaK_patchlist(fs, gt->pc, label->pc); - /* remove goto from pending list */ - for (i = g; i < gl->n - 1; i++) - gl->arr[i] = gl->arr[i + 1]; - gl->n--; -} - - -/* -** try to close a goto with existing labels; this solves backward jumps -*/ -static int findlabel (LexState *ls, int g) { - int i; - BlockCnt *bl = ls->fs->bl; - Dyndata *dyd = ls->dyd; - Labeldesc *gt = &dyd->gt.arr[g]; - /* check labels in current block for a match */ - for (i = bl->firstlabel; i < dyd->label.n; i++) { - Labeldesc *lb = &dyd->label.arr[i]; - if (luaS_eqstr(lb->name, gt->name)) { /* correct label? */ - if (gt->nactvar > lb->nactvar && - (bl->upval || dyd->label.n > bl->firstlabel)) - luaK_patchclose(ls->fs, gt->pc, lb->nactvar); - closegoto(ls, g, lb); /* close it */ - return 1; - } - } - return 0; /* label not found; cannot close goto */ -} - - -static int newlabelentry (LexState *ls, Labellist *l, TString *name, - int line, int pc) { - int n = l->n; - luaM_growvector(ls->L, l->arr, n, l->size, - Labeldesc, SHRT_MAX, "labels/gotos"); - l->arr[n].name = name; - l->arr[n].line = line; - l->arr[n].nactvar = ls->fs->nactvar; - l->arr[n].pc = pc; - l->n++; - return n; -} - - -/* -** check whether new label 'lb' matches any pending gotos in current -** block; solves forward jumps -*/ -static void findgotos (LexState *ls, Labeldesc *lb) { - Labellist *gl = &ls->dyd->gt; - int i = ls->fs->bl->firstgoto; - while (i < gl->n) { - if (luaS_eqstr(gl->arr[i].name, lb->name)) - closegoto(ls, i, lb); - else - i++; - } -} - - -/* -** "export" pending gotos to outer level, to check them against -** outer labels; if the block being exited has upvalues, and -** the goto exits the scope of any variable (which can be the -** upvalue), close those variables being exited. -*/ -static void movegotosout (FuncState *fs, BlockCnt *bl) { - int i = bl->firstgoto; - Labellist *gl = &fs->ls->dyd->gt; - /* correct pending gotos to current block and try to close it - with visible labels */ - while (i < gl->n) { - Labeldesc *gt = &gl->arr[i]; - if (gt->nactvar > bl->nactvar) { - if (bl->upval) - luaK_patchclose(fs, gt->pc, bl->nactvar); - gt->nactvar = bl->nactvar; - } - if (!findlabel(fs->ls, i)) - i++; /* move to next one */ - } -} - - -static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) { - bl->isloop = isloop; - bl->nactvar = fs->nactvar; - bl->firstlabel = fs->ls->dyd->label.n; - bl->firstgoto = fs->ls->dyd->gt.n; - bl->upval = 0; - bl->previous = fs->bl; - fs->bl = bl; - lua_assert(fs->freereg == fs->nactvar); -} - - -/* -** create a label named "break" to resolve break statements -*/ -static void breaklabel (LexState *ls) { - TString *n = luaS_new(ls->L, "break"); - int l = newlabelentry(ls, &ls->dyd->label, n, 0, ls->fs->pc); - findgotos(ls, &ls->dyd->label.arr[l]); -} - -/* -** generates an error for an undefined 'goto'; choose appropriate -** message when label name is a reserved word (which can only be 'break') -*/ -static l_noret undefgoto (LexState *ls, Labeldesc *gt) { - const char *msg = isreserved(gt->name) - ? "<%s> at line %d not inside a loop" - : "no visible label " LUA_QS " for at line %d"; - msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line); - semerror(ls, msg); -} - - -static void leaveblock (FuncState *fs) { - BlockCnt *bl = fs->bl; - LexState *ls = fs->ls; - if (bl->previous && bl->upval) { - /* create a 'jump to here' to close upvalues */ - int j = luaK_jump(fs); - luaK_patchclose(fs, j, bl->nactvar); - luaK_patchtohere(fs, j); - } - if (bl->isloop) - breaklabel(ls); /* close pending breaks */ - fs->bl = bl->previous; - removevars(fs, bl->nactvar); - lua_assert(bl->nactvar == fs->nactvar); - fs->freereg = fs->nactvar; /* free registers */ - ls->dyd->label.n = bl->firstlabel; /* remove local labels */ - if (bl->previous) /* inner block? */ - movegotosout(fs, bl); /* update pending gotos to outer block */ - else if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */ - undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */ -} - - -/* -** adds a new prototype into list of prototypes -*/ -static Proto *addprototype (LexState *ls) { - Proto *clp; - lua_State *L = ls->L; - FuncState *fs = ls->fs; - Proto *f = fs->f; /* prototype of current function */ - if (fs->np >= f->sizep) { - int oldsize = f->sizep; - luaM_growvector(L, f->p, fs->np, f->sizep, Proto *, MAXARG_Bx, "functions"); - while (oldsize < f->sizep) f->p[oldsize++] = NULL; - } - f->p[fs->np++] = clp = luaF_newproto(L); - luaC_objbarrier(L, f, clp); - return clp; -} - - -/* -** codes instruction to create new closure in parent function. -** The OP_CLOSURE instruction must use the last available register, -** so that, if it invokes the GC, the GC knows which registers -** are in use at that time. -*/ -static void codeclosure (LexState *ls, expdesc *v) { - FuncState *fs = ls->fs->prev; - init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1)); - luaK_exp2nextreg(fs, v); /* fix it at the last register */ -} - - -static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) { - lua_State *L = ls->L; - Proto *f; - fs->prev = ls->fs; /* linked list of funcstates */ - fs->ls = ls; - ls->fs = fs; - fs->pc = 0; - fs->lasttarget = 0; - fs->jpc = NO_JUMP; - fs->freereg = 0; - fs->nk = 0; - fs->np = 0; - fs->nups = 0; - fs->nlocvars = 0; - fs->nactvar = 0; - fs->firstlocal = ls->dyd->actvar.n; - fs->bl = NULL; - f = fs->f; - f->source = ls->source; - f->maxstacksize = 2; /* registers 0/1 are always valid */ - fs->h = luaH_new(L); - /* anchor table of constants (to avoid being collected) */ - sethvalue2s(L, L->top, fs->h); - incr_top(L); - enterblock(fs, bl, 0); -} - - -static void close_func (LexState *ls) { - lua_State *L = ls->L; - FuncState *fs = ls->fs; - Proto *f = fs->f; - luaK_ret(fs, 0, 0); /* final return */ - leaveblock(fs); - luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction); - f->sizecode = fs->pc; - luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int); - f->sizelineinfo = fs->pc; - luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue); - f->sizek = fs->nk; - luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *); - f->sizep = fs->np; - luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar); - f->sizelocvars = fs->nlocvars; - luaM_reallocvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc); - f->sizeupvalues = fs->nups; - lua_assert(fs->bl == NULL); - ls->fs = fs->prev; - /* last token read was anchored in defunct function; must re-anchor it */ - anchor_token(ls); - L->top--; /* pop table of constants */ - luaC_checkGC(L); -} - - - -/*============================================================*/ -/* GRAMMAR RULES */ -/*============================================================*/ - - -/* -** check whether current token is in the follow set of a block. -** 'until' closes syntactical blocks, but do not close scope, -** so it handled in separate. -*/ -static int block_follow (LexState *ls, int withuntil) { - switch (ls->t.token) { - case TK_ELSE: case TK_ELSEIF: - case TK_END: case TK_EOS: - return 1; - case TK_UNTIL: return withuntil; - default: return 0; - } -} - - -static void statlist (LexState *ls) { - /* statlist -> { stat [`;'] } */ - while (!block_follow(ls, 1)) { - if (ls->t.token == TK_RETURN) { - statement(ls); - return; /* 'return' must be last statement */ - } - statement(ls); - } -} - - -static void fieldsel (LexState *ls, expdesc *v) { - /* fieldsel -> ['.' | ':'] NAME */ - FuncState *fs = ls->fs; - expdesc key; - luaK_exp2anyregup(fs, v); - luaX_next(ls); /* skip the dot or colon */ - checkname(ls, &key); - luaK_indexed(fs, v, &key); -} - - -static void yindex (LexState *ls, expdesc *v) { - /* index -> '[' expr ']' */ - luaX_next(ls); /* skip the '[' */ - expr(ls, v); - luaK_exp2val(ls->fs, v); - checknext(ls, ']'); -} - - -/* -** {====================================================================== -** Rules for Constructors -** ======================================================================= -*/ - - -struct ConsControl { - expdesc v; /* last list item read */ - expdesc *t; /* table descriptor */ - int nh; /* total number of `record' elements */ - int na; /* total number of array elements */ - int tostore; /* number of array elements pending to be stored */ -}; - - -static void recfield (LexState *ls, struct ConsControl *cc) { - /* recfield -> (NAME | `['exp1`]') = exp1 */ - FuncState *fs = ls->fs; - int reg = ls->fs->freereg; - expdesc key, val; - int rkkey; - if (ls->t.token == TK_NAME) { - checklimit(fs, cc->nh, MAX_INT, "items in a constructor"); - checkname(ls, &key); - } - else /* ls->t.token == '[' */ - yindex(ls, &key); - cc->nh++; - checknext(ls, '='); - rkkey = luaK_exp2RK(fs, &key); - expr(ls, &val); - luaK_codeABC(fs, OP_SETTABLE, cc->t->u.info, rkkey, luaK_exp2RK(fs, &val)); - fs->freereg = reg; /* free registers */ -} - - -static void closelistfield (FuncState *fs, struct ConsControl *cc) { - if (cc->v.k == VVOID) return; /* there is no list item */ - luaK_exp2nextreg(fs, &cc->v); - cc->v.k = VVOID; - if (cc->tostore == LFIELDS_PER_FLUSH) { - luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */ - cc->tostore = 0; /* no more items pending */ - } -} - - -static void lastlistfield (FuncState *fs, struct ConsControl *cc) { - if (cc->tostore == 0) return; - if (hasmultret(cc->v.k)) { - luaK_setmultret(fs, &cc->v); - luaK_setlist(fs, cc->t->u.info, cc->na, LUA_MULTRET); - cc->na--; /* do not count last expression (unknown number of elements) */ - } - else { - if (cc->v.k != VVOID) - luaK_exp2nextreg(fs, &cc->v); - luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); - } -} - - -static void listfield (LexState *ls, struct ConsControl *cc) { - /* listfield -> exp */ - expr(ls, &cc->v); - checklimit(ls->fs, cc->na, MAX_INT, "items in a constructor"); - cc->na++; - cc->tostore++; -} - - -static void field (LexState *ls, struct ConsControl *cc) { - /* field -> listfield | recfield */ - switch(ls->t.token) { - case TK_NAME: { /* may be 'listfield' or 'recfield' */ - if (luaX_lookahead(ls) != '=') /* expression? */ - listfield(ls, cc); - else - recfield(ls, cc); - break; - } - case '[': { - recfield(ls, cc); - break; - } - default: { - listfield(ls, cc); - break; - } - } -} - - -static void constructor (LexState *ls, expdesc *t) { - /* constructor -> '{' [ field { sep field } [sep] ] '}' - sep -> ',' | ';' */ - FuncState *fs = ls->fs; - int line = ls->linenumber; - int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0); - struct ConsControl cc; - cc.na = cc.nh = cc.tostore = 0; - cc.t = t; - init_exp(t, VRELOCABLE, pc); - init_exp(&cc.v, VVOID, 0); /* no value (yet) */ - luaK_exp2nextreg(ls->fs, t); /* fix it at stack top */ - checknext(ls, '{'); - do { - lua_assert(cc.v.k == VVOID || cc.tostore > 0); - if (ls->t.token == '}') break; - closelistfield(fs, &cc); - field(ls, &cc); - } while (testnext(ls, ',') || testnext(ls, ';')); - check_match(ls, '}', '{', line); - lastlistfield(fs, &cc); - SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */ - SETARG_C(fs->f->code[pc], luaO_int2fb(cc.nh)); /* set initial table size */ -} - -/* }====================================================================== */ - - - -static void parlist (LexState *ls) { - /* parlist -> [ param { `,' param } ] */ - FuncState *fs = ls->fs; - Proto *f = fs->f; - int nparams = 0; - f->is_vararg = 0; - if (ls->t.token != ')') { /* is `parlist' not empty? */ - do { - switch (ls->t.token) { - case TK_NAME: { /* param -> NAME */ - new_localvar(ls, str_checkname(ls)); - nparams++; - break; - } - case TK_DOTS: { /* param -> `...' */ - luaX_next(ls); - f->is_vararg = 1; - break; - } - default: luaX_syntaxerror(ls, " or " LUA_QL("...") " expected"); - } - } while (!f->is_vararg && testnext(ls, ',')); - } - adjustlocalvars(ls, nparams); - f->numparams = cast_byte(fs->nactvar); - luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */ -} - - -static void body (LexState *ls, expdesc *e, int ismethod, int line) { - /* body -> `(' parlist `)' block END */ - FuncState new_fs; - BlockCnt bl; - new_fs.f = addprototype(ls); - new_fs.f->linedefined = line; - open_func(ls, &new_fs, &bl); - checknext(ls, '('); - if (ismethod) { - new_localvarliteral(ls, "self"); /* create 'self' parameter */ - adjustlocalvars(ls, 1); - } - parlist(ls); - checknext(ls, ')'); - statlist(ls); - new_fs.f->lastlinedefined = ls->linenumber; - check_match(ls, TK_END, TK_FUNCTION, line); - codeclosure(ls, e); - close_func(ls); -} - - -static int explist (LexState *ls, expdesc *v) { - /* explist -> expr { `,' expr } */ - int n = 1; /* at least one expression */ - expr(ls, v); - while (testnext(ls, ',')) { - luaK_exp2nextreg(ls->fs, v); - expr(ls, v); - n++; - } - return n; -} - - -static void funcargs (LexState *ls, expdesc *f, int line) { - FuncState *fs = ls->fs; - expdesc args; - int base, nparams; - switch (ls->t.token) { - case '(': { /* funcargs -> `(' [ explist ] `)' */ - luaX_next(ls); - if (ls->t.token == ')') /* arg list is empty? */ - args.k = VVOID; - else { - explist(ls, &args); - luaK_setmultret(fs, &args); - } - check_match(ls, ')', '(', line); - break; - } - case '{': { /* funcargs -> constructor */ - constructor(ls, &args); - break; - } - case TK_STRING: { /* funcargs -> STRING */ - codestring(ls, &args, ls->t.seminfo.ts); - luaX_next(ls); /* must use `seminfo' before `next' */ - break; - } - default: { - luaX_syntaxerror(ls, "function arguments expected"); - } - } - lua_assert(f->k == VNONRELOC); - base = f->u.info; /* base register for call */ - if (hasmultret(args.k)) - nparams = LUA_MULTRET; /* open call */ - else { - if (args.k != VVOID) - luaK_exp2nextreg(fs, &args); /* close last argument */ - nparams = fs->freereg - (base+1); - } - init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2)); - luaK_fixline(fs, line); - fs->freereg = base+1; /* call remove function and arguments and leaves - (unless changed) one result */ -} - - - - -/* -** {====================================================================== -** Expression parsing -** ======================================================================= -*/ - - -static void primaryexp (LexState *ls, expdesc *v) { - /* primaryexp -> NAME | '(' expr ')' */ - switch (ls->t.token) { - case '(': { - int line = ls->linenumber; - luaX_next(ls); - expr(ls, v); - check_match(ls, ')', '(', line); - luaK_dischargevars(ls->fs, v); - return; - } - case TK_NAME: { - singlevar(ls, v); - return; - } - default: { - luaX_syntaxerror(ls, "unexpected symbol"); - } - } -} - - -static void suffixedexp (LexState *ls, expdesc *v) { - /* suffixedexp -> - primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */ - FuncState *fs = ls->fs; - int line = ls->linenumber; - primaryexp(ls, v); - for (;;) { - switch (ls->t.token) { - case '.': { /* fieldsel */ - fieldsel(ls, v); - break; - } - case '[': { /* `[' exp1 `]' */ - expdesc key; - luaK_exp2anyregup(fs, v); - yindex(ls, &key); - luaK_indexed(fs, v, &key); - break; - } - case ':': { /* `:' NAME funcargs */ - expdesc key; - luaX_next(ls); - checkname(ls, &key); - luaK_self(fs, v, &key); - funcargs(ls, v, line); - break; - } - case '(': case TK_STRING: case '{': { /* funcargs */ - luaK_exp2nextreg(fs, v); - funcargs(ls, v, line); - break; - } - default: return; - } - } -} - - -static void simpleexp (LexState *ls, expdesc *v) { - /* simpleexp -> NUMBER | STRING | NIL | TRUE | FALSE | ... | - constructor | FUNCTION body | suffixedexp */ - switch (ls->t.token) { - case TK_NUMBER: { - init_exp(v, VKNUM, 0); - v->u.nval = ls->t.seminfo.r; - break; - } - case TK_STRING: { - codestring(ls, v, ls->t.seminfo.ts); - break; - } - case TK_NIL: { - init_exp(v, VNIL, 0); - break; - } - case TK_TRUE: { - init_exp(v, VTRUE, 0); - break; - } - case TK_FALSE: { - init_exp(v, VFALSE, 0); - break; - } - case TK_DOTS: { /* vararg */ - FuncState *fs = ls->fs; - check_condition(ls, fs->f->is_vararg, - "cannot use " LUA_QL("...") " outside a vararg function"); - init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 1, 0)); - break; - } - case '{': { /* constructor */ - constructor(ls, v); - return; - } - case TK_FUNCTION: { - luaX_next(ls); - body(ls, v, 0, ls->linenumber); - return; - } - default: { - suffixedexp(ls, v); - return; - } - } - luaX_next(ls); -} - - -static UnOpr getunopr (int op) { - switch (op) { - case TK_NOT: return OPR_NOT; - case '-': return OPR_MINUS; - case '#': return OPR_LEN; - default: return OPR_NOUNOPR; - } -} - - -static BinOpr getbinopr (int op) { - switch (op) { - case '+': return OPR_ADD; - case '-': return OPR_SUB; - case '*': return OPR_MUL; - case '/': return OPR_DIV; - case '%': return OPR_MOD; - case '^': return OPR_POW; - case TK_CONCAT: return OPR_CONCAT; - case TK_NE: return OPR_NE; - case TK_EQ: return OPR_EQ; - case '<': return OPR_LT; - case TK_LE: return OPR_LE; - case '>': return OPR_GT; - case TK_GE: return OPR_GE; - case TK_AND: return OPR_AND; - case TK_OR: return OPR_OR; - default: return OPR_NOBINOPR; - } -} - - -static const struct { - lu_byte left; /* left priority for each binary operator */ - lu_byte right; /* right priority */ -} priority[] = { /* ORDER OPR */ - {6, 6}, {6, 6}, {7, 7}, {7, 7}, {7, 7}, /* `+' `-' `*' `/' `%' */ - {10, 9}, {5, 4}, /* ^, .. (right associative) */ - {3, 3}, {3, 3}, {3, 3}, /* ==, <, <= */ - {3, 3}, {3, 3}, {3, 3}, /* ~=, >, >= */ - {2, 2}, {1, 1} /* and, or */ -}; - -#define UNARY_PRIORITY 8 /* priority for unary operators */ - - -/* -** subexpr -> (simpleexp | unop subexpr) { binop subexpr } -** where `binop' is any binary operator with a priority higher than `limit' -*/ -static BinOpr subexpr (LexState *ls, expdesc *v, int limit) { - BinOpr op; - UnOpr uop; - enterlevel(ls); - uop = getunopr(ls->t.token); - if (uop != OPR_NOUNOPR) { - int line = ls->linenumber; - luaX_next(ls); - subexpr(ls, v, UNARY_PRIORITY); - luaK_prefix(ls->fs, uop, v, line); - } - else simpleexp(ls, v); - /* expand while operators have priorities higher than `limit' */ - op = getbinopr(ls->t.token); - while (op != OPR_NOBINOPR && priority[op].left > limit) { - expdesc v2; - BinOpr nextop; - int line = ls->linenumber; - luaX_next(ls); - luaK_infix(ls->fs, op, v); - /* read sub-expression with higher priority */ - nextop = subexpr(ls, &v2, priority[op].right); - luaK_posfix(ls->fs, op, v, &v2, line); - op = nextop; - } - leavelevel(ls); - return op; /* return first untreated operator */ -} - - -static void expr (LexState *ls, expdesc *v) { - subexpr(ls, v, 0); -} - -/* }==================================================================== */ - - - -/* -** {====================================================================== -** Rules for Statements -** ======================================================================= -*/ - - -static void block (LexState *ls) { - /* block -> statlist */ - FuncState *fs = ls->fs; - BlockCnt bl; - enterblock(fs, &bl, 0); - statlist(ls); - leaveblock(fs); -} - - -/* -** structure to chain all variables in the left-hand side of an -** assignment -*/ -struct LHS_assign { - struct LHS_assign *prev; - expdesc v; /* variable (global, local, upvalue, or indexed) */ -}; - - -/* -** check whether, in an assignment to an upvalue/local variable, the -** upvalue/local variable is begin used in a previous assignment to a -** table. If so, save original upvalue/local value in a safe place and -** use this safe copy in the previous assignment. -*/ -static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) { - FuncState *fs = ls->fs; - int extra = fs->freereg; /* eventual position to save local variable */ - int conflict = 0; - for (; lh; lh = lh->prev) { /* check all previous assignments */ - if (lh->v.k == VINDEXED) { /* assigning to a table? */ - /* table is the upvalue/local being assigned now? */ - if (lh->v.u.ind.vt == v->k && lh->v.u.ind.t == v->u.info) { - conflict = 1; - lh->v.u.ind.vt = VLOCAL; - lh->v.u.ind.t = extra; /* previous assignment will use safe copy */ - } - /* index is the local being assigned? (index cannot be upvalue) */ - if (v->k == VLOCAL && lh->v.u.ind.idx == v->u.info) { - conflict = 1; - lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */ - } - } - } - if (conflict) { - /* copy upvalue/local value to a temporary (in position 'extra') */ - OpCode op = (v->k == VLOCAL) ? OP_MOVE : OP_GETUPVAL; - luaK_codeABC(fs, op, extra, v->u.info, 0); - luaK_reserveregs(fs, 1); - } -} - - -static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) { - expdesc e; - check_condition(ls, vkisvar(lh->v.k), "syntax error"); - if (testnext(ls, ',')) { /* assignment -> ',' suffixedexp assignment */ - struct LHS_assign nv; - nv.prev = lh; - suffixedexp(ls, &nv.v); - if (nv.v.k != VINDEXED) - check_conflict(ls, lh, &nv.v); - checklimit(ls->fs, nvars + ls->L->nCcalls, LUAI_MAXCCALLS, - "C levels"); - assignment(ls, &nv, nvars+1); - } - else { /* assignment -> `=' explist */ - int nexps; - checknext(ls, '='); - nexps = explist(ls, &e); - if (nexps != nvars) { - adjust_assign(ls, nvars, nexps, &e); - if (nexps > nvars) - ls->fs->freereg -= nexps - nvars; /* remove extra values */ - } - else { - luaK_setoneret(ls->fs, &e); /* close last expression */ - luaK_storevar(ls->fs, &lh->v, &e); - return; /* avoid default */ - } - } - init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */ - luaK_storevar(ls->fs, &lh->v, &e); -} - - -static int cond (LexState *ls) { - /* cond -> exp */ - expdesc v; - expr(ls, &v); /* read condition */ - if (v.k == VNIL) v.k = VFALSE; /* `falses' are all equal here */ - luaK_goiftrue(ls->fs, &v); - return v.f; -} - - -static void gotostat (LexState *ls, int pc) { - int line = ls->linenumber; - TString *label; - int g; - if (testnext(ls, TK_GOTO)) - label = str_checkname(ls); - else { - luaX_next(ls); /* skip break */ - label = luaS_new(ls->L, "break"); - } - g = newlabelentry(ls, &ls->dyd->gt, label, line, pc); - findlabel(ls, g); /* close it if label already defined */ -} - - -/* check for repeated labels on the same block */ -static void checkrepeated (FuncState *fs, Labellist *ll, TString *label) { - int i; - for (i = fs->bl->firstlabel; i < ll->n; i++) { - if (luaS_eqstr(label, ll->arr[i].name)) { - const char *msg = luaO_pushfstring(fs->ls->L, - "label " LUA_QS " already defined on line %d", - getstr(label), ll->arr[i].line); - semerror(fs->ls, msg); - } - } -} - - -/* skip no-op statements */ -static void skipnoopstat (LexState *ls) { - while (ls->t.token == ';' || ls->t.token == TK_DBCOLON) - statement(ls); -} - - -static void labelstat (LexState *ls, TString *label, int line) { - /* label -> '::' NAME '::' */ - FuncState *fs = ls->fs; - Labellist *ll = &ls->dyd->label; - int l; /* index of new label being created */ - checkrepeated(fs, ll, label); /* check for repeated labels */ - checknext(ls, TK_DBCOLON); /* skip double colon */ - /* create new entry for this label */ - l = newlabelentry(ls, ll, label, line, fs->pc); - skipnoopstat(ls); /* skip other no-op statements */ - if (block_follow(ls, 0)) { /* label is last no-op statement in the block? */ - /* assume that locals are already out of scope */ - ll->arr[l].nactvar = fs->bl->nactvar; - } - findgotos(ls, &ll->arr[l]); -} - - -static void whilestat (LexState *ls, int line) { - /* whilestat -> WHILE cond DO block END */ - FuncState *fs = ls->fs; - int whileinit; - int condexit; - BlockCnt bl; - luaX_next(ls); /* skip WHILE */ - whileinit = luaK_getlabel(fs); - condexit = cond(ls); - enterblock(fs, &bl, 1); - checknext(ls, TK_DO); - block(ls); - luaK_jumpto(fs, whileinit); - check_match(ls, TK_END, TK_WHILE, line); - leaveblock(fs); - luaK_patchtohere(fs, condexit); /* false conditions finish the loop */ -} - - -static void repeatstat (LexState *ls, int line) { - /* repeatstat -> REPEAT block UNTIL cond */ - int condexit; - FuncState *fs = ls->fs; - int repeat_init = luaK_getlabel(fs); - BlockCnt bl1, bl2; - enterblock(fs, &bl1, 1); /* loop block */ - enterblock(fs, &bl2, 0); /* scope block */ - luaX_next(ls); /* skip REPEAT */ - statlist(ls); - check_match(ls, TK_UNTIL, TK_REPEAT, line); - condexit = cond(ls); /* read condition (inside scope block) */ - if (bl2.upval) /* upvalues? */ - luaK_patchclose(fs, condexit, bl2.nactvar); - leaveblock(fs); /* finish scope */ - luaK_patchlist(fs, condexit, repeat_init); /* close the loop */ - leaveblock(fs); /* finish loop */ -} - - -static int exp1 (LexState *ls) { - expdesc e; - int reg; - expr(ls, &e); - luaK_exp2nextreg(ls->fs, &e); - lua_assert(e.k == VNONRELOC); - reg = e.u.info; - return reg; -} - - -static void forbody (LexState *ls, int base, int line, int nvars, int isnum) { - /* forbody -> DO block */ - BlockCnt bl; - FuncState *fs = ls->fs; - int prep, endfor; - adjustlocalvars(ls, 3); /* control variables */ - checknext(ls, TK_DO); - prep = isnum ? luaK_codeAsBx(fs, OP_FORPREP, base, NO_JUMP) : luaK_jump(fs); - enterblock(fs, &bl, 0); /* scope for declared variables */ - adjustlocalvars(ls, nvars); - luaK_reserveregs(fs, nvars); - block(ls); - leaveblock(fs); /* end of scope for declared variables */ - luaK_patchtohere(fs, prep); - if (isnum) /* numeric for? */ - endfor = luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP); - else { /* generic for */ - luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars); - luaK_fixline(fs, line); - endfor = luaK_codeAsBx(fs, OP_TFORLOOP, base + 2, NO_JUMP); - } - luaK_patchlist(fs, endfor, prep + 1); - luaK_fixline(fs, line); -} - - -static void fornum (LexState *ls, TString *varname, int line) { - /* fornum -> NAME = exp1,exp1[,exp1] forbody */ - FuncState *fs = ls->fs; - int base = fs->freereg; - new_localvarliteral(ls, "(for index)"); - new_localvarliteral(ls, "(for limit)"); - new_localvarliteral(ls, "(for step)"); - new_localvar(ls, varname); - checknext(ls, '='); - exp1(ls); /* initial value */ - checknext(ls, ','); - exp1(ls); /* limit */ - if (testnext(ls, ',')) - exp1(ls); /* optional step */ - else { /* default step = 1 */ - luaK_codek(fs, fs->freereg, luaK_numberK(fs, 1)); - luaK_reserveregs(fs, 1); - } - forbody(ls, base, line, 1, 1); -} - - -static void forlist (LexState *ls, TString *indexname) { - /* forlist -> NAME {,NAME} IN explist forbody */ - FuncState *fs = ls->fs; - expdesc e; - int nvars = 4; /* gen, state, control, plus at least one declared var */ - int line; - int base = fs->freereg; - /* create control variables */ - new_localvarliteral(ls, "(for generator)"); - new_localvarliteral(ls, "(for state)"); - new_localvarliteral(ls, "(for control)"); - /* create declared variables */ - new_localvar(ls, indexname); - while (testnext(ls, ',')) { - new_localvar(ls, str_checkname(ls)); - nvars++; - } - checknext(ls, TK_IN); - line = ls->linenumber; - adjust_assign(ls, 3, explist(ls, &e), &e); - luaK_checkstack(fs, 3); /* extra space to call generator */ - forbody(ls, base, line, nvars - 3, 0); -} - - -static void forstat (LexState *ls, int line) { - /* forstat -> FOR (fornum | forlist) END */ - FuncState *fs = ls->fs; - TString *varname; - BlockCnt bl; - enterblock(fs, &bl, 1); /* scope for loop and control variables */ - luaX_next(ls); /* skip `for' */ - varname = str_checkname(ls); /* first variable name */ - switch (ls->t.token) { - case '=': fornum(ls, varname, line); break; - case ',': case TK_IN: forlist(ls, varname); break; - default: luaX_syntaxerror(ls, LUA_QL("=") " or " LUA_QL("in") " expected"); - } - check_match(ls, TK_END, TK_FOR, line); - leaveblock(fs); /* loop scope (`break' jumps to this point) */ -} - - -static void test_then_block (LexState *ls, int *escapelist) { - /* test_then_block -> [IF | ELSEIF] cond THEN block */ - BlockCnt bl; - FuncState *fs = ls->fs; - expdesc v; - int jf; /* instruction to skip 'then' code (if condition is false) */ - luaX_next(ls); /* skip IF or ELSEIF */ - expr(ls, &v); /* read condition */ - checknext(ls, TK_THEN); - if (ls->t.token == TK_GOTO || ls->t.token == TK_BREAK) { - luaK_goiffalse(ls->fs, &v); /* will jump to label if condition is true */ - enterblock(fs, &bl, 0); /* must enter block before 'goto' */ - gotostat(ls, v.t); /* handle goto/break */ - skipnoopstat(ls); /* skip other no-op statements */ - if (block_follow(ls, 0)) { /* 'goto' is the entire block? */ - leaveblock(fs); - return; /* and that is it */ - } - else /* must skip over 'then' part if condition is false */ - jf = luaK_jump(fs); - } - else { /* regular case (not goto/break) */ - luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */ - enterblock(fs, &bl, 0); - jf = v.f; - } - statlist(ls); /* `then' part */ - leaveblock(fs); - if (ls->t.token == TK_ELSE || - ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */ - luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */ - luaK_patchtohere(fs, jf); -} - - -static void ifstat (LexState *ls, int line) { - /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */ - FuncState *fs = ls->fs; - int escapelist = NO_JUMP; /* exit list for finished parts */ - test_then_block(ls, &escapelist); /* IF cond THEN block */ - while (ls->t.token == TK_ELSEIF) - test_then_block(ls, &escapelist); /* ELSEIF cond THEN block */ - if (testnext(ls, TK_ELSE)) - block(ls); /* `else' part */ - check_match(ls, TK_END, TK_IF, line); - luaK_patchtohere(fs, escapelist); /* patch escape list to 'if' end */ -} - - -static void localfunc (LexState *ls) { - expdesc b; - FuncState *fs = ls->fs; - new_localvar(ls, str_checkname(ls)); /* new local variable */ - adjustlocalvars(ls, 1); /* enter its scope */ - body(ls, &b, 0, ls->linenumber); /* function created in next register */ - /* debug information will only see the variable after this point! */ - getlocvar(fs, b.u.info)->startpc = fs->pc; -} - - -static void localstat (LexState *ls) { - /* stat -> LOCAL NAME {`,' NAME} [`=' explist] */ - int nvars = 0; - int nexps; - expdesc e; - do { - new_localvar(ls, str_checkname(ls)); - nvars++; - } while (testnext(ls, ',')); - if (testnext(ls, '=')) - nexps = explist(ls, &e); - else { - e.k = VVOID; - nexps = 0; - } - adjust_assign(ls, nvars, nexps, &e); - adjustlocalvars(ls, nvars); -} - - -static int funcname (LexState *ls, expdesc *v) { - /* funcname -> NAME {fieldsel} [`:' NAME] */ - int ismethod = 0; - singlevar(ls, v); - while (ls->t.token == '.') - fieldsel(ls, v); - if (ls->t.token == ':') { - ismethod = 1; - fieldsel(ls, v); - } - return ismethod; -} - - -static void funcstat (LexState *ls, int line) { - /* funcstat -> FUNCTION funcname body */ - int ismethod; - expdesc v, b; - luaX_next(ls); /* skip FUNCTION */ - ismethod = funcname(ls, &v); - body(ls, &b, ismethod, line); - luaK_storevar(ls->fs, &v, &b); - luaK_fixline(ls->fs, line); /* definition `happens' in the first line */ -} - - -static void exprstat (LexState *ls) { - /* stat -> func | assignment */ - FuncState *fs = ls->fs; - struct LHS_assign v; - suffixedexp(ls, &v.v); - if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */ - v.prev = NULL; - assignment(ls, &v, 1); - } - else { /* stat -> func */ - check_condition(ls, v.v.k == VCALL, "syntax error"); - SETARG_C(getcode(fs, &v.v), 1); /* call statement uses no results */ - } -} - - -static void retstat (LexState *ls) { - /* stat -> RETURN [explist] [';'] */ - FuncState *fs = ls->fs; - expdesc e; - int first, nret; /* registers with returned values */ - if (block_follow(ls, 1) || ls->t.token == ';') - first = nret = 0; /* return no values */ - else { - nret = explist(ls, &e); /* optional return values */ - if (hasmultret(e.k)) { - luaK_setmultret(fs, &e); - if (e.k == VCALL && nret == 1) { /* tail call? */ - SET_OPCODE(getcode(fs,&e), OP_TAILCALL); - lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar); - } - first = fs->nactvar; - nret = LUA_MULTRET; /* return all values */ - } - else { - if (nret == 1) /* only one single value? */ - first = luaK_exp2anyreg(fs, &e); - else { - luaK_exp2nextreg(fs, &e); /* values must go to the `stack' */ - first = fs->nactvar; /* return all `active' values */ - lua_assert(nret == fs->freereg - first); - } - } - } - luaK_ret(fs, first, nret); - testnext(ls, ';'); /* skip optional semicolon */ -} - - -static void statement (LexState *ls) { - int line = ls->linenumber; /* may be needed for error messages */ - enterlevel(ls); - switch (ls->t.token) { - case ';': { /* stat -> ';' (empty statement) */ - luaX_next(ls); /* skip ';' */ - break; - } - case TK_IF: { /* stat -> ifstat */ - ifstat(ls, line); - break; - } - case TK_WHILE: { /* stat -> whilestat */ - whilestat(ls, line); - break; - } - case TK_DO: { /* stat -> DO block END */ - luaX_next(ls); /* skip DO */ - block(ls); - check_match(ls, TK_END, TK_DO, line); - break; - } - case TK_FOR: { /* stat -> forstat */ - forstat(ls, line); - break; - } - case TK_REPEAT: { /* stat -> repeatstat */ - repeatstat(ls, line); - break; - } - case TK_FUNCTION: { /* stat -> funcstat */ - funcstat(ls, line); - break; - } - case TK_LOCAL: { /* stat -> localstat */ - luaX_next(ls); /* skip LOCAL */ - if (testnext(ls, TK_FUNCTION)) /* local function? */ - localfunc(ls); - else - localstat(ls); - break; - } - case TK_DBCOLON: { /* stat -> label */ - luaX_next(ls); /* skip double colon */ - labelstat(ls, str_checkname(ls), line); - break; - } - case TK_RETURN: { /* stat -> retstat */ - luaX_next(ls); /* skip RETURN */ - retstat(ls); - break; - } - case TK_BREAK: /* stat -> breakstat */ - case TK_GOTO: { /* stat -> 'goto' NAME */ - gotostat(ls, luaK_jump(ls->fs)); - break; - } - default: { /* stat -> func | assignment */ - exprstat(ls); - break; - } - } - lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg && - ls->fs->freereg >= ls->fs->nactvar); - ls->fs->freereg = ls->fs->nactvar; /* free registers */ - leavelevel(ls); -} - -/* }====================================================================== */ - - -/* -** compiles the main function, which is a regular vararg function with an -** upvalue named LUA_ENV -*/ -static void mainfunc (LexState *ls, FuncState *fs) { - BlockCnt bl; - expdesc v; - open_func(ls, fs, &bl); - fs->f->is_vararg = 1; /* main function is always vararg */ - init_exp(&v, VLOCAL, 0); /* create and... */ - newupvalue(fs, ls->envn, &v); /* ...set environment upvalue */ - luaX_next(ls); /* read first token */ - statlist(ls); /* parse main body */ - check(ls, TK_EOS); - close_func(ls); -} - - -Closure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, - Dyndata *dyd, const char *name, int firstchar) { - LexState lexstate; - FuncState funcstate; - Closure *cl = luaF_newLclosure(L, 1); /* create main closure */ - /* anchor closure (to avoid being collected) */ - setclLvalue(L, L->top, cl); - incr_top(L); - funcstate.f = cl->l.p = luaF_newproto(L); - funcstate.f->source = luaS_new(L, name); /* create and anchor TString */ - lexstate.buff = buff; - lexstate.dyd = dyd; - dyd->actvar.n = dyd->gt.n = dyd->label.n = 0; - luaX_setinput(L, &lexstate, z, funcstate.f->source, firstchar); - mainfunc(&lexstate, &funcstate); - lua_assert(!funcstate.prev && funcstate.nups == 1 && !lexstate.fs); - /* all scopes should be correctly finished */ - lua_assert(dyd->actvar.n == 0 && dyd->gt.n == 0 && dyd->label.n == 0); - return cl; /* it's on the stack too */ -} - diff --git a/ext/lua/src/lstate.c b/ext/lua/src/lstate.c deleted file mode 100644 index c7f2672be7..0000000000 --- a/ext/lua/src/lstate.c +++ /dev/null @@ -1,323 +0,0 @@ -/* -** $Id: lstate.c,v 2.99.1.2 2013/11/08 17:45:31 roberto Exp $ -** Global State -** See Copyright Notice in lua.h -*/ - - -#include -#include - -#define lstate_c -#define LUA_CORE - -#include "lua.h" - -#include "lapi.h" -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lgc.h" -#include "llex.h" -#include "lmem.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" - - -#if !defined(LUAI_GCPAUSE) -#define LUAI_GCPAUSE 200 /* 200% */ -#endif - -#if !defined(LUAI_GCMAJOR) -#define LUAI_GCMAJOR 200 /* 200% */ -#endif - -#if !defined(LUAI_GCMUL) -#define LUAI_GCMUL 200 /* GC runs 'twice the speed' of memory allocation */ -#endif - - -#define MEMERRMSG "not enough memory" - - -/* -** a macro to help the creation of a unique random seed when a state is -** created; the seed is used to randomize hashes. -*/ -#if !defined(luai_makeseed) -#include -#define luai_makeseed() cast(unsigned int, time(NULL)) -#endif - - - -/* -** thread state + extra space -*/ -typedef struct LX { -#if defined(LUAI_EXTRASPACE) - char buff[LUAI_EXTRASPACE]; -#endif - lua_State l; -} LX; - - -/* -** Main thread combines a thread state and the global state -*/ -typedef struct LG { - LX l; - global_State g; -} LG; - - - -#define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l))) - - -/* -** Compute an initial seed as random as possible. In ANSI, rely on -** Address Space Layout Randomization (if present) to increase -** randomness.. -*/ -#define addbuff(b,p,e) \ - { size_t t = cast(size_t, e); \ - memcpy(buff + p, &t, sizeof(t)); p += sizeof(t); } - -static unsigned int makeseed (lua_State *L) { - char buff[4 * sizeof(size_t)]; - unsigned int h = luai_makeseed(); - int p = 0; - addbuff(buff, p, L); /* heap variable */ - addbuff(buff, p, &h); /* local variable */ - addbuff(buff, p, luaO_nilobject); /* global variable */ - addbuff(buff, p, &lua_newstate); /* public function */ - lua_assert(p == sizeof(buff)); - return luaS_hash(buff, p, h); -} - - -/* -** set GCdebt to a new value keeping the value (totalbytes + GCdebt) -** invariant -*/ -void luaE_setdebt (global_State *g, l_mem debt) { - g->totalbytes -= (debt - g->GCdebt); - g->GCdebt = debt; -} - - -CallInfo *luaE_extendCI (lua_State *L) { - CallInfo *ci = luaM_new(L, CallInfo); - lua_assert(L->ci->next == NULL); - L->ci->next = ci; - ci->previous = L->ci; - ci->next = NULL; - return ci; -} - - -void luaE_freeCI (lua_State *L) { - CallInfo *ci = L->ci; - CallInfo *next = ci->next; - ci->next = NULL; - while ((ci = next) != NULL) { - next = ci->next; - luaM_free(L, ci); - } -} - - -static void stack_init (lua_State *L1, lua_State *L) { - int i; CallInfo *ci; - /* initialize stack array */ - L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, TValue); - L1->stacksize = BASIC_STACK_SIZE; - for (i = 0; i < BASIC_STACK_SIZE; i++) - setnilvalue(L1->stack + i); /* erase new stack */ - L1->top = L1->stack; - L1->stack_last = L1->stack + L1->stacksize - EXTRA_STACK; - /* initialize first ci */ - ci = &L1->base_ci; - ci->next = ci->previous = NULL; - ci->callstatus = 0; - ci->func = L1->top; - setnilvalue(L1->top++); /* 'function' entry for this 'ci' */ - ci->top = L1->top + LUA_MINSTACK; - L1->ci = ci; -} - - -static void freestack (lua_State *L) { - if (L->stack == NULL) - return; /* stack not completely built yet */ - L->ci = &L->base_ci; /* free the entire 'ci' list */ - luaE_freeCI(L); - luaM_freearray(L, L->stack, L->stacksize); /* free stack array */ -} - - -/* -** Create registry table and its predefined values -*/ -static void init_registry (lua_State *L, global_State *g) { - TValue mt; - /* create registry */ - Table *registry = luaH_new(L); - sethvalue(L, &g->l_registry, registry); - luaH_resize(L, registry, LUA_RIDX_LAST, 0); - /* registry[LUA_RIDX_MAINTHREAD] = L */ - setthvalue(L, &mt, L); - luaH_setint(L, registry, LUA_RIDX_MAINTHREAD, &mt); - /* registry[LUA_RIDX_GLOBALS] = table of globals */ - sethvalue(L, &mt, luaH_new(L)); - luaH_setint(L, registry, LUA_RIDX_GLOBALS, &mt); -} - - -/* -** open parts of the state that may cause memory-allocation errors -*/ -static void f_luaopen (lua_State *L, void *ud) { - global_State *g = G(L); - UNUSED(ud); - stack_init(L, L); /* init stack */ - init_registry(L, g); - luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */ - luaT_init(L); - luaX_init(L); - /* pre-create memory-error message */ - g->memerrmsg = luaS_newliteral(L, MEMERRMSG); - luaS_fix(g->memerrmsg); /* it should never be collected */ - g->gcrunning = 1; /* allow gc */ - g->version = lua_version(NULL); - luai_userstateopen(L); -} - - -/* -** preinitialize a state with consistent values without allocating -** any memory (to avoid errors) -*/ -static void preinit_state (lua_State *L, global_State *g) { - G(L) = g; - L->stack = NULL; - L->ci = NULL; - L->stacksize = 0; - L->errorJmp = NULL; - L->nCcalls = 0; - L->hook = NULL; - L->hookmask = 0; - L->basehookcount = 0; - L->allowhook = 1; - resethookcount(L); - L->openupval = NULL; - L->nny = 1; - L->status = LUA_OK; - L->errfunc = 0; -} - - -static void close_state (lua_State *L) { - global_State *g = G(L); - luaF_close(L, L->stack); /* close all upvalues for this thread */ - luaC_freeallobjects(L); /* collect all objects */ - if (g->version) /* closing a fully built state? */ - luai_userstateclose(L); - luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size); - luaZ_freebuffer(L, &g->buff); - freestack(L); - lua_assert(gettotalbytes(g) == sizeof(LG)); - (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */ -} - - -LUA_API lua_State *lua_newthread (lua_State *L) { - lua_State *L1; - lua_lock(L); - luaC_checkGC(L); - L1 = &luaC_newobj(L, LUA_TTHREAD, sizeof(LX), NULL, offsetof(LX, l))->th; - setthvalue(L, L->top, L1); - api_incr_top(L); - preinit_state(L1, G(L)); - L1->hookmask = L->hookmask; - L1->basehookcount = L->basehookcount; - L1->hook = L->hook; - resethookcount(L1); - luai_userstatethread(L, L1); - stack_init(L1, L); /* init stack */ - lua_unlock(L); - return L1; -} - - -void luaE_freethread (lua_State *L, lua_State *L1) { - LX *l = fromstate(L1); - luaF_close(L1, L1->stack); /* close all upvalues for this thread */ - lua_assert(L1->openupval == NULL); - luai_userstatefree(L, L1); - freestack(L1); - luaM_free(L, l); -} - - -LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { - int i; - lua_State *L; - global_State *g; - LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG))); - if (l == NULL) return NULL; - L = &l->l.l; - g = &l->g; - L->next = NULL; - L->tt = LUA_TTHREAD; - g->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT); - L->marked = luaC_white(g); - g->gckind = KGC_NORMAL; - preinit_state(L, g); - g->frealloc = f; - g->ud = ud; - g->mainthread = L; - g->seed = makeseed(L); - g->uvhead.u.l.prev = &g->uvhead; - g->uvhead.u.l.next = &g->uvhead; - g->gcrunning = 0; /* no GC while building state */ - g->GCestimate = 0; - g->strt.size = 0; - g->strt.nuse = 0; - g->strt.hash = NULL; - setnilvalue(&g->l_registry); - luaZ_initbuffer(L, &g->buff); - g->panic = NULL; - g->version = NULL; - g->gcstate = GCSpause; - g->allgc = NULL; - g->finobj = NULL; - g->tobefnz = NULL; - g->sweepgc = g->sweepfin = NULL; - g->gray = g->grayagain = NULL; - g->weak = g->ephemeron = g->allweak = NULL; - g->totalbytes = sizeof(LG); - g->GCdebt = 0; - g->gcpause = LUAI_GCPAUSE; - g->gcmajorinc = LUAI_GCMAJOR; - g->gcstepmul = LUAI_GCMUL; - for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL; - if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) { - /* memory allocation error: free partial state */ - close_state(L); - L = NULL; - } - return L; -} - - -LUA_API void lua_close (lua_State *L) { - L = G(L)->mainthread; /* only the main thread can be closed */ - lua_lock(L); - close_state(L); -} - - diff --git a/ext/lua/src/lstring.c b/ext/lua/src/lstring.c deleted file mode 100644 index af96c89c18..0000000000 --- a/ext/lua/src/lstring.c +++ /dev/null @@ -1,185 +0,0 @@ -/* -** $Id: lstring.c,v 2.26.1.1 2013/04/12 18:48:47 roberto Exp $ -** String table (keeps all strings handled by Lua) -** See Copyright Notice in lua.h -*/ - - -#include - -#define lstring_c -#define LUA_CORE - -#include "lua.h" - -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" -#include "lstring.h" - - -/* -** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a string to -** compute its hash -*/ -#if !defined(LUAI_HASHLIMIT) -#define LUAI_HASHLIMIT 5 -#endif - - -/* -** equality for long strings -*/ -int luaS_eqlngstr (TString *a, TString *b) { - size_t len = a->tsv.len; - lua_assert(a->tsv.tt == LUA_TLNGSTR && b->tsv.tt == LUA_TLNGSTR); - return (a == b) || /* same instance or... */ - ((len == b->tsv.len) && /* equal length and ... */ - (memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */ -} - - -/* -** equality for strings -*/ -int luaS_eqstr (TString *a, TString *b) { - return (a->tsv.tt == b->tsv.tt) && - (a->tsv.tt == LUA_TSHRSTR ? eqshrstr(a, b) : luaS_eqlngstr(a, b)); -} - - -unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) { - unsigned int h = seed ^ cast(unsigned int, l); - size_t l1; - size_t step = (l >> LUAI_HASHLIMIT) + 1; - for (l1 = l; l1 >= step; l1 -= step) - h = h ^ ((h<<5) + (h>>2) + cast_byte(str[l1 - 1])); - return h; -} - - -/* -** resizes the string table -*/ -void luaS_resize (lua_State *L, int newsize) { - int i; - stringtable *tb = &G(L)->strt; - /* cannot resize while GC is traversing strings */ - luaC_runtilstate(L, ~bitmask(GCSsweepstring)); - if (newsize > tb->size) { - luaM_reallocvector(L, tb->hash, tb->size, newsize, GCObject *); - for (i = tb->size; i < newsize; i++) tb->hash[i] = NULL; - } - /* rehash */ - for (i=0; isize; i++) { - GCObject *p = tb->hash[i]; - tb->hash[i] = NULL; - while (p) { /* for each node in the list */ - GCObject *next = gch(p)->next; /* save next */ - unsigned int h = lmod(gco2ts(p)->hash, newsize); /* new position */ - gch(p)->next = tb->hash[h]; /* chain it */ - tb->hash[h] = p; - resetoldbit(p); /* see MOVE OLD rule */ - p = next; - } - } - if (newsize < tb->size) { - /* shrinking slice must be empty */ - lua_assert(tb->hash[newsize] == NULL && tb->hash[tb->size - 1] == NULL); - luaM_reallocvector(L, tb->hash, tb->size, newsize, GCObject *); - } - tb->size = newsize; -} - - -/* -** creates a new string object -*/ -static TString *createstrobj (lua_State *L, const char *str, size_t l, - int tag, unsigned int h, GCObject **list) { - TString *ts; - size_t totalsize; /* total size of TString object */ - totalsize = sizeof(TString) + ((l + 1) * sizeof(char)); - ts = &luaC_newobj(L, tag, totalsize, list, 0)->ts; - ts->tsv.len = l; - ts->tsv.hash = h; - ts->tsv.extra = 0; - memcpy(ts+1, str, l*sizeof(char)); - ((char *)(ts+1))[l] = '\0'; /* ending 0 */ - return ts; -} - - -/* -** creates a new short string, inserting it into string table -*/ -static TString *newshrstr (lua_State *L, const char *str, size_t l, - unsigned int h) { - GCObject **list; /* (pointer to) list where it will be inserted */ - stringtable *tb = &G(L)->strt; - TString *s; - if (tb->nuse >= cast(lu_int32, tb->size) && tb->size <= MAX_INT/2) - luaS_resize(L, tb->size*2); /* too crowded */ - list = &tb->hash[lmod(h, tb->size)]; - s = createstrobj(L, str, l, LUA_TSHRSTR, h, list); - tb->nuse++; - return s; -} - - -/* -** checks whether short string exists and reuses it or creates a new one -*/ -static TString *internshrstr (lua_State *L, const char *str, size_t l) { - GCObject *o; - global_State *g = G(L); - unsigned int h = luaS_hash(str, l, g->seed); - for (o = g->strt.hash[lmod(h, g->strt.size)]; - o != NULL; - o = gch(o)->next) { - TString *ts = rawgco2ts(o); - if (h == ts->tsv.hash && - l == ts->tsv.len && - (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) { - if (isdead(G(L), o)) /* string is dead (but was not collected yet)? */ - changewhite(o); /* resurrect it */ - return ts; - } - } - return newshrstr(L, str, l, h); /* not found; create a new string */ -} - - -/* -** new string (with explicit length) -*/ -TString *luaS_newlstr (lua_State *L, const char *str, size_t l) { - if (l <= LUAI_MAXSHORTLEN) /* short string? */ - return internshrstr(L, str, l); - else { - if (l + 1 > (MAX_SIZET - sizeof(TString))/sizeof(char)) - luaM_toobig(L); - return createstrobj(L, str, l, LUA_TLNGSTR, G(L)->seed, NULL); - } -} - - -/* -** new zero-terminated string -*/ -TString *luaS_new (lua_State *L, const char *str) { - return luaS_newlstr(L, str, strlen(str)); -} - - -Udata *luaS_newudata (lua_State *L, size_t s, Table *e) { - Udata *u; - if (s > MAX_SIZET - sizeof(Udata)) - luaM_toobig(L); - u = &luaC_newobj(L, LUA_TUSERDATA, sizeof(Udata) + s, NULL, 0)->u; - u->uv.len = s; - u->uv.metatable = NULL; - u->uv.env = e; - return u; -} - diff --git a/ext/lua/src/lstrlib.c b/ext/lua/src/lstrlib.c deleted file mode 100644 index 9261fd220d..0000000000 --- a/ext/lua/src/lstrlib.c +++ /dev/null @@ -1,1019 +0,0 @@ -/* -** $Id: lstrlib.c,v 1.178.1.1 2013/04/12 18:48:47 roberto Exp $ -** Standard library for string operations and pattern-matching -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include -#include -#include - -#define lstrlib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -/* -** maximum number of captures that a pattern can do during -** pattern-matching. This limit is arbitrary. -*/ -#if !defined(LUA_MAXCAPTURES) -#define LUA_MAXCAPTURES 32 -#endif - - -/* macro to `unsign' a character */ -#define uchar(c) ((unsigned char)(c)) - - - -static int str_len (lua_State *L) { - size_t l; - luaL_checklstring(L, 1, &l); - lua_pushinteger(L, (lua_Integer)l); - return 1; -} - - -/* translate a relative string position: negative means back from end */ -static size_t posrelat (ptrdiff_t pos, size_t len) { - if (pos >= 0) return (size_t)pos; - else if (0u - (size_t)pos > len) return 0; - else return len - ((size_t)-pos) + 1; -} - - -static int str_sub (lua_State *L) { - size_t l; - const char *s = luaL_checklstring(L, 1, &l); - size_t start = posrelat(luaL_checkinteger(L, 2), l); - size_t end = posrelat(luaL_optinteger(L, 3, -1), l); - if (start < 1) start = 1; - if (end > l) end = l; - if (start <= end) - lua_pushlstring(L, s + start - 1, end - start + 1); - else lua_pushliteral(L, ""); - return 1; -} - - -static int str_reverse (lua_State *L) { - size_t l, i; - luaL_Buffer b; - const char *s = luaL_checklstring(L, 1, &l); - char *p = luaL_buffinitsize(L, &b, l); - for (i = 0; i < l; i++) - p[i] = s[l - i - 1]; - luaL_pushresultsize(&b, l); - return 1; -} - - -static int str_lower (lua_State *L) { - size_t l; - size_t i; - luaL_Buffer b; - const char *s = luaL_checklstring(L, 1, &l); - char *p = luaL_buffinitsize(L, &b, l); - for (i=0; i> 1) - -static int str_rep (lua_State *L) { - size_t l, lsep; - const char *s = luaL_checklstring(L, 1, &l); - int n = luaL_checkint(L, 2); - const char *sep = luaL_optlstring(L, 3, "", &lsep); - if (n <= 0) lua_pushliteral(L, ""); - else if (l + lsep < l || l + lsep >= MAXSIZE / n) /* may overflow? */ - return luaL_error(L, "resulting string too large"); - else { - size_t totallen = n * l + (n - 1) * lsep; - luaL_Buffer b; - char *p = luaL_buffinitsize(L, &b, totallen); - while (n-- > 1) { /* first n-1 copies (followed by separator) */ - memcpy(p, s, l * sizeof(char)); p += l; - if (lsep > 0) { /* avoid empty 'memcpy' (may be expensive) */ - memcpy(p, sep, lsep * sizeof(char)); p += lsep; - } - } - memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */ - luaL_pushresultsize(&b, totallen); - } - return 1; -} - - -static int str_byte (lua_State *L) { - size_t l; - const char *s = luaL_checklstring(L, 1, &l); - size_t posi = posrelat(luaL_optinteger(L, 2, 1), l); - size_t pose = posrelat(luaL_optinteger(L, 3, posi), l); - int n, i; - if (posi < 1) posi = 1; - if (pose > l) pose = l; - if (posi > pose) return 0; /* empty interval; return no values */ - n = (int)(pose - posi + 1); - if (posi + n <= pose) /* (size_t -> int) overflow? */ - return luaL_error(L, "string slice too long"); - luaL_checkstack(L, n, "string slice too long"); - for (i=0; i= ms->level || ms->capture[l].len == CAP_UNFINISHED) - return luaL_error(ms->L, "invalid capture index %%%d", l + 1); - return l; -} - - -static int capture_to_close (MatchState *ms) { - int level = ms->level; - for (level--; level>=0; level--) - if (ms->capture[level].len == CAP_UNFINISHED) return level; - return luaL_error(ms->L, "invalid pattern capture"); -} - - -static const char *classend (MatchState *ms, const char *p) { - switch (*p++) { - case L_ESC: { - if (p == ms->p_end) - luaL_error(ms->L, "malformed pattern (ends with " LUA_QL("%%") ")"); - return p+1; - } - case '[': { - if (*p == '^') p++; - do { /* look for a `]' */ - if (p == ms->p_end) - luaL_error(ms->L, "malformed pattern (missing " LUA_QL("]") ")"); - if (*(p++) == L_ESC && p < ms->p_end) - p++; /* skip escapes (e.g. `%]') */ - } while (*p != ']'); - return p+1; - } - default: { - return p; - } - } -} - - -static int match_class (int c, int cl) { - int res; - switch (tolower(cl)) { - case 'a' : res = isalpha(c); break; - case 'c' : res = iscntrl(c); break; - case 'd' : res = isdigit(c); break; - case 'g' : res = isgraph(c); break; - case 'l' : res = islower(c); break; - case 'p' : res = ispunct(c); break; - case 's' : res = isspace(c); break; - case 'u' : res = isupper(c); break; - case 'w' : res = isalnum(c); break; - case 'x' : res = isxdigit(c); break; - case 'z' : res = (c == 0); break; /* deprecated option */ - default: return (cl == c); - } - return (islower(cl) ? res : !res); -} - - -static int matchbracketclass (int c, const char *p, const char *ec) { - int sig = 1; - if (*(p+1) == '^') { - sig = 0; - p++; /* skip the `^' */ - } - while (++p < ec) { - if (*p == L_ESC) { - p++; - if (match_class(c, uchar(*p))) - return sig; - } - else if ((*(p+1) == '-') && (p+2 < ec)) { - p+=2; - if (uchar(*(p-2)) <= c && c <= uchar(*p)) - return sig; - } - else if (uchar(*p) == c) return sig; - } - return !sig; -} - - -static int singlematch (MatchState *ms, const char *s, const char *p, - const char *ep) { - if (s >= ms->src_end) - return 0; - else { - int c = uchar(*s); - switch (*p) { - case '.': return 1; /* matches any char */ - case L_ESC: return match_class(c, uchar(*(p+1))); - case '[': return matchbracketclass(c, p, ep-1); - default: return (uchar(*p) == c); - } - } -} - - -static const char *matchbalance (MatchState *ms, const char *s, - const char *p) { - if (p >= ms->p_end - 1) - luaL_error(ms->L, "malformed pattern " - "(missing arguments to " LUA_QL("%%b") ")"); - if (*s != *p) return NULL; - else { - int b = *p; - int e = *(p+1); - int cont = 1; - while (++s < ms->src_end) { - if (*s == e) { - if (--cont == 0) return s+1; - } - else if (*s == b) cont++; - } - } - return NULL; /* string ends out of balance */ -} - - -static const char *max_expand (MatchState *ms, const char *s, - const char *p, const char *ep) { - ptrdiff_t i = 0; /* counts maximum expand for item */ - while (singlematch(ms, s + i, p, ep)) - i++; - /* keeps trying to match with the maximum repetitions */ - while (i>=0) { - const char *res = match(ms, (s+i), ep+1); - if (res) return res; - i--; /* else didn't match; reduce 1 repetition to try again */ - } - return NULL; -} - - -static const char *min_expand (MatchState *ms, const char *s, - const char *p, const char *ep) { - for (;;) { - const char *res = match(ms, s, ep+1); - if (res != NULL) - return res; - else if (singlematch(ms, s, p, ep)) - s++; /* try with one more repetition */ - else return NULL; - } -} - - -static const char *start_capture (MatchState *ms, const char *s, - const char *p, int what) { - const char *res; - int level = ms->level; - if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures"); - ms->capture[level].init = s; - ms->capture[level].len = what; - ms->level = level+1; - if ((res=match(ms, s, p)) == NULL) /* match failed? */ - ms->level--; /* undo capture */ - return res; -} - - -static const char *end_capture (MatchState *ms, const char *s, - const char *p) { - int l = capture_to_close(ms); - const char *res; - ms->capture[l].len = s - ms->capture[l].init; /* close capture */ - if ((res = match(ms, s, p)) == NULL) /* match failed? */ - ms->capture[l].len = CAP_UNFINISHED; /* undo capture */ - return res; -} - - -static const char *match_capture (MatchState *ms, const char *s, int l) { - size_t len; - l = check_capture(ms, l); - len = ms->capture[l].len; - if ((size_t)(ms->src_end-s) >= len && - memcmp(ms->capture[l].init, s, len) == 0) - return s+len; - else return NULL; -} - - -static const char *match (MatchState *ms, const char *s, const char *p) { - if (ms->matchdepth-- == 0) - luaL_error(ms->L, "pattern too complex"); - init: /* using goto's to optimize tail recursion */ - if (p != ms->p_end) { /* end of pattern? */ - switch (*p) { - case '(': { /* start capture */ - if (*(p + 1) == ')') /* position capture? */ - s = start_capture(ms, s, p + 2, CAP_POSITION); - else - s = start_capture(ms, s, p + 1, CAP_UNFINISHED); - break; - } - case ')': { /* end capture */ - s = end_capture(ms, s, p + 1); - break; - } - case '$': { - if ((p + 1) != ms->p_end) /* is the `$' the last char in pattern? */ - goto dflt; /* no; go to default */ - s = (s == ms->src_end) ? s : NULL; /* check end of string */ - break; - } - case L_ESC: { /* escaped sequences not in the format class[*+?-]? */ - switch (*(p + 1)) { - case 'b': { /* balanced string? */ - s = matchbalance(ms, s, p + 2); - if (s != NULL) { - p += 4; goto init; /* return match(ms, s, p + 4); */ - } /* else fail (s == NULL) */ - break; - } - case 'f': { /* frontier? */ - const char *ep; char previous; - p += 2; - if (*p != '[') - luaL_error(ms->L, "missing " LUA_QL("[") " after " - LUA_QL("%%f") " in pattern"); - ep = classend(ms, p); /* points to what is next */ - previous = (s == ms->src_init) ? '\0' : *(s - 1); - if (!matchbracketclass(uchar(previous), p, ep - 1) && - matchbracketclass(uchar(*s), p, ep - 1)) { - p = ep; goto init; /* return match(ms, s, ep); */ - } - s = NULL; /* match failed */ - break; - } - case '0': case '1': case '2': case '3': - case '4': case '5': case '6': case '7': - case '8': case '9': { /* capture results (%0-%9)? */ - s = match_capture(ms, s, uchar(*(p + 1))); - if (s != NULL) { - p += 2; goto init; /* return match(ms, s, p + 2) */ - } - break; - } - default: goto dflt; - } - break; - } - default: dflt: { /* pattern class plus optional suffix */ - const char *ep = classend(ms, p); /* points to optional suffix */ - /* does not match at least once? */ - if (!singlematch(ms, s, p, ep)) { - if (*ep == '*' || *ep == '?' || *ep == '-') { /* accept empty? */ - p = ep + 1; goto init; /* return match(ms, s, ep + 1); */ - } - else /* '+' or no suffix */ - s = NULL; /* fail */ - } - else { /* matched once */ - switch (*ep) { /* handle optional suffix */ - case '?': { /* optional */ - const char *res; - if ((res = match(ms, s + 1, ep + 1)) != NULL) - s = res; - else { - p = ep + 1; goto init; /* else return match(ms, s, ep + 1); */ - } - break; - } - case '+': /* 1 or more repetitions */ - s++; /* 1 match already done */ - /* go through */ - case '*': /* 0 or more repetitions */ - s = max_expand(ms, s, p, ep); - break; - case '-': /* 0 or more repetitions (minimum) */ - s = min_expand(ms, s, p, ep); - break; - default: /* no suffix */ - s++; p = ep; goto init; /* return match(ms, s + 1, ep); */ - } - } - break; - } - } - } - ms->matchdepth++; - return s; -} - - - -static const char *lmemfind (const char *s1, size_t l1, - const char *s2, size_t l2) { - if (l2 == 0) return s1; /* empty strings are everywhere */ - else if (l2 > l1) return NULL; /* avoids a negative `l1' */ - else { - const char *init; /* to search for a `*s2' inside `s1' */ - l2--; /* 1st char will be checked by `memchr' */ - l1 = l1-l2; /* `s2' cannot be found after that */ - while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) { - init++; /* 1st char is already checked */ - if (memcmp(init, s2+1, l2) == 0) - return init-1; - else { /* correct `l1' and `s1' to try again */ - l1 -= init-s1; - s1 = init; - } - } - return NULL; /* not found */ - } -} - - -static void push_onecapture (MatchState *ms, int i, const char *s, - const char *e) { - if (i >= ms->level) { - if (i == 0) /* ms->level == 0, too */ - lua_pushlstring(ms->L, s, e - s); /* add whole match */ - else - luaL_error(ms->L, "invalid capture index"); - } - else { - ptrdiff_t l = ms->capture[i].len; - if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture"); - if (l == CAP_POSITION) - lua_pushinteger(ms->L, ms->capture[i].init - ms->src_init + 1); - else - lua_pushlstring(ms->L, ms->capture[i].init, l); - } -} - - -static int push_captures (MatchState *ms, const char *s, const char *e) { - int i; - int nlevels = (ms->level == 0 && s) ? 1 : ms->level; - luaL_checkstack(ms->L, nlevels, "too many captures"); - for (i = 0; i < nlevels; i++) - push_onecapture(ms, i, s, e); - return nlevels; /* number of strings pushed */ -} - - -/* check whether pattern has no special characters */ -static int nospecials (const char *p, size_t l) { - size_t upto = 0; - do { - if (strpbrk(p + upto, SPECIALS)) - return 0; /* pattern has a special character */ - upto += strlen(p + upto) + 1; /* may have more after \0 */ - } while (upto <= l); - return 1; /* no special chars found */ -} - - -static int str_find_aux (lua_State *L, int find) { - size_t ls, lp; - const char *s = luaL_checklstring(L, 1, &ls); - const char *p = luaL_checklstring(L, 2, &lp); - size_t init = posrelat(luaL_optinteger(L, 3, 1), ls); - if (init < 1) init = 1; - else if (init > ls + 1) { /* start after string's end? */ - lua_pushnil(L); /* cannot find anything */ - return 1; - } - /* explicit request or no special characters? */ - if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) { - /* do a plain search */ - const char *s2 = lmemfind(s + init - 1, ls - init + 1, p, lp); - if (s2) { - lua_pushinteger(L, s2 - s + 1); - lua_pushinteger(L, s2 - s + lp); - return 2; - } - } - else { - MatchState ms; - const char *s1 = s + init - 1; - int anchor = (*p == '^'); - if (anchor) { - p++; lp--; /* skip anchor character */ - } - ms.L = L; - ms.matchdepth = MAXCCALLS; - ms.src_init = s; - ms.src_end = s + ls; - ms.p_end = p + lp; - do { - const char *res; - ms.level = 0; - lua_assert(ms.matchdepth == MAXCCALLS); - if ((res=match(&ms, s1, p)) != NULL) { - if (find) { - lua_pushinteger(L, s1 - s + 1); /* start */ - lua_pushinteger(L, res - s); /* end */ - return push_captures(&ms, NULL, 0) + 2; - } - else - return push_captures(&ms, s1, res); - } - } while (s1++ < ms.src_end && !anchor); - } - lua_pushnil(L); /* not found */ - return 1; -} - - -static int str_find (lua_State *L) { - return str_find_aux(L, 1); -} - - -static int str_match (lua_State *L) { - return str_find_aux(L, 0); -} - - -static int gmatch_aux (lua_State *L) { - MatchState ms; - size_t ls, lp; - const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls); - const char *p = lua_tolstring(L, lua_upvalueindex(2), &lp); - const char *src; - ms.L = L; - ms.matchdepth = MAXCCALLS; - ms.src_init = s; - ms.src_end = s+ls; - ms.p_end = p + lp; - for (src = s + (size_t)lua_tointeger(L, lua_upvalueindex(3)); - src <= ms.src_end; - src++) { - const char *e; - ms.level = 0; - lua_assert(ms.matchdepth == MAXCCALLS); - if ((e = match(&ms, src, p)) != NULL) { - lua_Integer newstart = e-s; - if (e == src) newstart++; /* empty match? go at least one position */ - lua_pushinteger(L, newstart); - lua_replace(L, lua_upvalueindex(3)); - return push_captures(&ms, src, e); - } - } - return 0; /* not found */ -} - - -static int gmatch (lua_State *L) { - luaL_checkstring(L, 1); - luaL_checkstring(L, 2); - lua_settop(L, 2); - lua_pushinteger(L, 0); - lua_pushcclosure(L, gmatch_aux, 3); - return 1; -} - - -static void add_s (MatchState *ms, luaL_Buffer *b, const char *s, - const char *e) { - size_t l, i; - const char *news = lua_tolstring(ms->L, 3, &l); - for (i = 0; i < l; i++) { - if (news[i] != L_ESC) - luaL_addchar(b, news[i]); - else { - i++; /* skip ESC */ - if (!isdigit(uchar(news[i]))) { - if (news[i] != L_ESC) - luaL_error(ms->L, "invalid use of " LUA_QL("%c") - " in replacement string", L_ESC); - luaL_addchar(b, news[i]); - } - else if (news[i] == '0') - luaL_addlstring(b, s, e - s); - else { - push_onecapture(ms, news[i] - '1', s, e); - luaL_addvalue(b); /* add capture to accumulated result */ - } - } - } -} - - -static void add_value (MatchState *ms, luaL_Buffer *b, const char *s, - const char *e, int tr) { - lua_State *L = ms->L; - switch (tr) { - case LUA_TFUNCTION: { - int n; - lua_pushvalue(L, 3); - n = push_captures(ms, s, e); - lua_call(L, n, 1); - break; - } - case LUA_TTABLE: { - push_onecapture(ms, 0, s, e); - lua_gettable(L, 3); - break; - } - default: { /* LUA_TNUMBER or LUA_TSTRING */ - add_s(ms, b, s, e); - return; - } - } - if (!lua_toboolean(L, -1)) { /* nil or false? */ - lua_pop(L, 1); - lua_pushlstring(L, s, e - s); /* keep original text */ - } - else if (!lua_isstring(L, -1)) - luaL_error(L, "invalid replacement value (a %s)", luaL_typename(L, -1)); - luaL_addvalue(b); /* add result to accumulator */ -} - - -static int str_gsub (lua_State *L) { - size_t srcl, lp; - const char *src = luaL_checklstring(L, 1, &srcl); - const char *p = luaL_checklstring(L, 2, &lp); - int tr = lua_type(L, 3); - size_t max_s = luaL_optinteger(L, 4, srcl+1); - int anchor = (*p == '^'); - size_t n = 0; - MatchState ms; - luaL_Buffer b; - luaL_argcheck(L, tr == LUA_TNUMBER || tr == LUA_TSTRING || - tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3, - "string/function/table expected"); - luaL_buffinit(L, &b); - if (anchor) { - p++; lp--; /* skip anchor character */ - } - ms.L = L; - ms.matchdepth = MAXCCALLS; - ms.src_init = src; - ms.src_end = src+srcl; - ms.p_end = p + lp; - while (n < max_s) { - const char *e; - ms.level = 0; - lua_assert(ms.matchdepth == MAXCCALLS); - e = match(&ms, src, p); - if (e) { - n++; - add_value(&ms, &b, src, e, tr); - } - if (e && e>src) /* non empty match? */ - src = e; /* skip it */ - else if (src < ms.src_end) - luaL_addchar(&b, *src++); - else break; - if (anchor) break; - } - luaL_addlstring(&b, src, ms.src_end-src); - luaL_pushresult(&b); - lua_pushinteger(L, n); /* number of substitutions */ - return 2; -} - -/* }====================================================== */ - - - -/* -** {====================================================== -** STRING FORMAT -** ======================================================= -*/ - -/* -** LUA_INTFRMLEN is the length modifier for integer conversions in -** 'string.format'; LUA_INTFRM_T is the integer type corresponding to -** the previous length -*/ -#if !defined(LUA_INTFRMLEN) /* { */ -#if defined(LUA_USE_LONGLONG) - -#define LUA_INTFRMLEN "ll" -#define LUA_INTFRM_T long long - -#else - -#define LUA_INTFRMLEN "l" -#define LUA_INTFRM_T long - -#endif -#endif /* } */ - - -/* -** LUA_FLTFRMLEN is the length modifier for float conversions in -** 'string.format'; LUA_FLTFRM_T is the float type corresponding to -** the previous length -*/ -#if !defined(LUA_FLTFRMLEN) - -#define LUA_FLTFRMLEN "" -#define LUA_FLTFRM_T double - -#endif - - -/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */ -#define MAX_ITEM 512 -/* valid flags in a format specification */ -#define FLAGS "-+ #0" -/* -** maximum size of each format specification (such as '%-099.99d') -** (+10 accounts for %99.99x plus margin of error) -*/ -#define MAX_FORMAT (sizeof(FLAGS) + sizeof(LUA_INTFRMLEN) + 10) - - -static void addquoted (lua_State *L, luaL_Buffer *b, int arg) { - size_t l; - const char *s = luaL_checklstring(L, arg, &l); - luaL_addchar(b, '"'); - while (l--) { - if (*s == '"' || *s == '\\' || *s == '\n') { - luaL_addchar(b, '\\'); - luaL_addchar(b, *s); - } - else if (*s == '\0' || iscntrl(uchar(*s))) { - char buff[10]; - if (!isdigit(uchar(*(s+1)))) - sprintf(buff, "\\%d", (int)uchar(*s)); - else - sprintf(buff, "\\%03d", (int)uchar(*s)); - luaL_addstring(b, buff); - } - else - luaL_addchar(b, *s); - s++; - } - luaL_addchar(b, '"'); -} - -static const char *scanformat (lua_State *L, const char *strfrmt, char *form) { - const char *p = strfrmt; - while (*p != '\0' && strchr(FLAGS, *p) != NULL) p++; /* skip flags */ - if ((size_t)(p - strfrmt) >= sizeof(FLAGS)/sizeof(char)) - luaL_error(L, "invalid format (repeated flags)"); - if (isdigit(uchar(*p))) p++; /* skip width */ - if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ - if (*p == '.') { - p++; - if (isdigit(uchar(*p))) p++; /* skip precision */ - if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ - } - if (isdigit(uchar(*p))) - luaL_error(L, "invalid format (width or precision too long)"); - *(form++) = '%'; - memcpy(form, strfrmt, (p - strfrmt + 1) * sizeof(char)); - form += p - strfrmt + 1; - *form = '\0'; - return p; -} - - -/* -** add length modifier into formats -*/ -static void addlenmod (char *form, const char *lenmod) { - size_t l = strlen(form); - size_t lm = strlen(lenmod); - char spec = form[l - 1]; - strcpy(form + l - 1, lenmod); - form[l + lm - 1] = spec; - form[l + lm] = '\0'; -} - - -static int str_format (lua_State *L) { - int top = lua_gettop(L); - int arg = 1; - size_t sfl; - const char *strfrmt = luaL_checklstring(L, arg, &sfl); - const char *strfrmt_end = strfrmt+sfl; - luaL_Buffer b; - luaL_buffinit(L, &b); - while (strfrmt < strfrmt_end) { - if (*strfrmt != L_ESC) - luaL_addchar(&b, *strfrmt++); - else if (*++strfrmt == L_ESC) - luaL_addchar(&b, *strfrmt++); /* %% */ - else { /* format item */ - char form[MAX_FORMAT]; /* to store the format (`%...') */ - char *buff = luaL_prepbuffsize(&b, MAX_ITEM); /* to put formatted item */ - int nb = 0; /* number of bytes in added item */ - if (++arg > top) - luaL_argerror(L, arg, "no value"); - strfrmt = scanformat(L, strfrmt, form); - switch (*strfrmt++) { - case 'c': { - nb = sprintf(buff, form, luaL_checkint(L, arg)); - break; - } - case 'd': case 'i': { - lua_Number n = luaL_checknumber(L, arg); - LUA_INTFRM_T ni = (LUA_INTFRM_T)n; - lua_Number diff = n - (lua_Number)ni; - luaL_argcheck(L, -1 < diff && diff < 1, arg, - "not a number in proper range"); - addlenmod(form, LUA_INTFRMLEN); - nb = sprintf(buff, form, ni); - break; - } - case 'o': case 'u': case 'x': case 'X': { - lua_Number n = luaL_checknumber(L, arg); - unsigned LUA_INTFRM_T ni = (unsigned LUA_INTFRM_T)n; - lua_Number diff = n - (lua_Number)ni; - luaL_argcheck(L, -1 < diff && diff < 1, arg, - "not a non-negative number in proper range"); - addlenmod(form, LUA_INTFRMLEN); - nb = sprintf(buff, form, ni); - break; - } - case 'e': case 'E': case 'f': -#if defined(LUA_USE_AFORMAT) - case 'a': case 'A': -#endif - case 'g': case 'G': { - addlenmod(form, LUA_FLTFRMLEN); - nb = sprintf(buff, form, (LUA_FLTFRM_T)luaL_checknumber(L, arg)); - break; - } - case 'q': { - addquoted(L, &b, arg); - break; - } - case 's': { - size_t l; - const char *s = luaL_tolstring(L, arg, &l); - if (!strchr(form, '.') && l >= 100) { - /* no precision and string is too long to be formatted; - keep original string */ - luaL_addvalue(&b); - break; - } - else { - nb = sprintf(buff, form, s); - lua_pop(L, 1); /* remove result from 'luaL_tolstring' */ - break; - } - } - default: { /* also treat cases `pnLlh' */ - return luaL_error(L, "invalid option " LUA_QL("%%%c") " to " - LUA_QL("format"), *(strfrmt - 1)); - } - } - luaL_addsize(&b, nb); - } - } - luaL_pushresult(&b); - return 1; -} - -/* }====================================================== */ - - -static const luaL_Reg strlib[] = { - {"byte", str_byte}, - {"char", str_char}, - {"dump", str_dump}, - {"find", str_find}, - {"format", str_format}, - {"gmatch", gmatch}, - {"gsub", str_gsub}, - {"len", str_len}, - {"lower", str_lower}, - {"match", str_match}, - {"rep", str_rep}, - {"reverse", str_reverse}, - {"sub", str_sub}, - {"upper", str_upper}, - {NULL, NULL} -}; - - -static void createmetatable (lua_State *L) { - lua_createtable(L, 0, 1); /* table to be metatable for strings */ - lua_pushliteral(L, ""); /* dummy string */ - lua_pushvalue(L, -2); /* copy table */ - lua_setmetatable(L, -2); /* set table as metatable for strings */ - lua_pop(L, 1); /* pop dummy string */ - lua_pushvalue(L, -2); /* get string library */ - lua_setfield(L, -2, "__index"); /* metatable.__index = string */ - lua_pop(L, 1); /* pop metatable */ -} - - -/* -** Open string library -*/ -LUAMOD_API int luaopen_string (lua_State *L) { - luaL_newlib(L, strlib); - createmetatable(L); - return 1; -} - diff --git a/ext/lua/src/ltable.c b/ext/lua/src/ltable.c deleted file mode 100644 index 5d76f97ec3..0000000000 --- a/ext/lua/src/ltable.c +++ /dev/null @@ -1,588 +0,0 @@ -/* -** $Id: ltable.c,v 2.72.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua tables (hash) -** See Copyright Notice in lua.h -*/ - - -/* -** Implementation of tables (aka arrays, objects, or hash tables). -** Tables keep its elements in two parts: an array part and a hash part. -** Non-negative integer keys are all candidates to be kept in the array -** part. The actual size of the array is the largest `n' such that at -** least half the slots between 0 and n are in use. -** Hash uses a mix of chained scatter table with Brent's variation. -** A main invariant of these tables is that, if an element is not -** in its main position (i.e. the `original' position that its hash gives -** to it), then the colliding element is in its own main position. -** Hence even when the load factor reaches 100%, performance remains good. -*/ - -#include - -#define ltable_c -#define LUA_CORE - -#include "lua.h" - -#include "ldebug.h" -#include "ldo.h" -#include "lgc.h" -#include "lmem.h" -#include "lobject.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "lvm.h" - - -/* -** max size of array part is 2^MAXBITS -*/ -#if LUAI_BITSINT >= 32 -#define MAXBITS 30 -#else -#define MAXBITS (LUAI_BITSINT-2) -#endif - -#define MAXASIZE (1 << MAXBITS) - - -#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t)))) - -#define hashstr(t,str) hashpow2(t, (str)->tsv.hash) -#define hashboolean(t,p) hashpow2(t, p) - - -/* -** for some types, it is better to avoid modulus by power of 2, as -** they tend to have many 2 factors. -*/ -#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1)))) - - -#define hashpointer(t,p) hashmod(t, IntPoint(p)) - - -#define dummynode (&dummynode_) - -#define isdummy(n) ((n) == dummynode) - -static const Node dummynode_ = { - {NILCONSTANT}, /* value */ - {{NILCONSTANT, NULL}} /* key */ -}; - - -/* -** hash for lua_Numbers -*/ -static Node *hashnum (const Table *t, lua_Number n) { - int i; - luai_hashnum(i, n); - if (i < 0) { - if (cast(unsigned int, i) == 0u - i) /* use unsigned to avoid overflows */ - i = 0; /* handle INT_MIN */ - i = -i; /* must be a positive value */ - } - return hashmod(t, i); -} - - - -/* -** returns the `main' position of an element in a table (that is, the index -** of its hash value) -*/ -static Node *mainposition (const Table *t, const TValue *key) { - switch (ttype(key)) { - case LUA_TNUMBER: - return hashnum(t, nvalue(key)); - case LUA_TLNGSTR: { - TString *s = rawtsvalue(key); - if (s->tsv.extra == 0) { /* no hash? */ - s->tsv.hash = luaS_hash(getstr(s), s->tsv.len, s->tsv.hash); - s->tsv.extra = 1; /* now it has its hash */ - } - return hashstr(t, rawtsvalue(key)); - } - case LUA_TSHRSTR: - return hashstr(t, rawtsvalue(key)); - case LUA_TBOOLEAN: - return hashboolean(t, bvalue(key)); - case LUA_TLIGHTUSERDATA: - return hashpointer(t, pvalue(key)); - case LUA_TLCF: - return hashpointer(t, fvalue(key)); - default: - return hashpointer(t, gcvalue(key)); - } -} - - -/* -** returns the index for `key' if `key' is an appropriate key to live in -** the array part of the table, -1 otherwise. -*/ -static int arrayindex (const TValue *key) { - if (ttisnumber(key)) { - lua_Number n = nvalue(key); - int k; - lua_number2int(k, n); - if (luai_numeq(cast_num(k), n)) - return k; - } - return -1; /* `key' did not match some condition */ -} - - -/* -** returns the index of a `key' for table traversals. First goes all -** elements in the array part, then elements in the hash part. The -** beginning of a traversal is signaled by -1. -*/ -static int findindex (lua_State *L, Table *t, StkId key) { - int i; - if (ttisnil(key)) return -1; /* first iteration */ - i = arrayindex(key); - if (0 < i && i <= t->sizearray) /* is `key' inside array part? */ - return i-1; /* yes; that's the index (corrected to C) */ - else { - Node *n = mainposition(t, key); - for (;;) { /* check whether `key' is somewhere in the chain */ - /* key may be dead already, but it is ok to use it in `next' */ - if (luaV_rawequalobj(gkey(n), key) || - (ttisdeadkey(gkey(n)) && iscollectable(key) && - deadvalue(gkey(n)) == gcvalue(key))) { - i = cast_int(n - gnode(t, 0)); /* key index in hash table */ - /* hash elements are numbered after array ones */ - return i + t->sizearray; - } - else n = gnext(n); - if (n == NULL) - luaG_runerror(L, "invalid key to " LUA_QL("next")); /* key not found */ - } - } -} - - -int luaH_next (lua_State *L, Table *t, StkId key) { - int i = findindex(L, t, key); /* find original element */ - for (i++; i < t->sizearray; i++) { /* try first array part */ - if (!ttisnil(&t->array[i])) { /* a non-nil value? */ - setnvalue(key, cast_num(i+1)); - setobj2s(L, key+1, &t->array[i]); - return 1; - } - } - for (i -= t->sizearray; i < sizenode(t); i++) { /* then hash part */ - if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */ - setobj2s(L, key, gkey(gnode(t, i))); - setobj2s(L, key+1, gval(gnode(t, i))); - return 1; - } - } - return 0; /* no more elements */ -} - - -/* -** {============================================================= -** Rehash -** ============================================================== -*/ - - -static int computesizes (int nums[], int *narray) { - int i; - int twotoi; /* 2^i */ - int a = 0; /* number of elements smaller than 2^i */ - int na = 0; /* number of elements to go to array part */ - int n = 0; /* optimal size for array part */ - for (i = 0, twotoi = 1; twotoi/2 < *narray; i++, twotoi *= 2) { - if (nums[i] > 0) { - a += nums[i]; - if (a > twotoi/2) { /* more than half elements present? */ - n = twotoi; /* optimal size (till now) */ - na = a; /* all elements smaller than n will go to array part */ - } - } - if (a == *narray) break; /* all elements already counted */ - } - *narray = n; - lua_assert(*narray/2 <= na && na <= *narray); - return na; -} - - -static int countint (const TValue *key, int *nums) { - int k = arrayindex(key); - if (0 < k && k <= MAXASIZE) { /* is `key' an appropriate array index? */ - nums[luaO_ceillog2(k)]++; /* count as such */ - return 1; - } - else - return 0; -} - - -static int numusearray (const Table *t, int *nums) { - int lg; - int ttlg; /* 2^lg */ - int ause = 0; /* summation of `nums' */ - int i = 1; /* count to traverse all array keys */ - for (lg=0, ttlg=1; lg<=MAXBITS; lg++, ttlg*=2) { /* for each slice */ - int lc = 0; /* counter */ - int lim = ttlg; - if (lim > t->sizearray) { - lim = t->sizearray; /* adjust upper limit */ - if (i > lim) - break; /* no more elements to count */ - } - /* count elements in range (2^(lg-1), 2^lg] */ - for (; i <= lim; i++) { - if (!ttisnil(&t->array[i-1])) - lc++; - } - nums[lg] += lc; - ause += lc; - } - return ause; -} - - -static int numusehash (const Table *t, int *nums, int *pnasize) { - int totaluse = 0; /* total number of elements */ - int ause = 0; /* summation of `nums' */ - int i = sizenode(t); - while (i--) { - Node *n = &t->node[i]; - if (!ttisnil(gval(n))) { - ause += countint(gkey(n), nums); - totaluse++; - } - } - *pnasize += ause; - return totaluse; -} - - -static void setarrayvector (lua_State *L, Table *t, int size) { - int i; - luaM_reallocvector(L, t->array, t->sizearray, size, TValue); - for (i=t->sizearray; iarray[i]); - t->sizearray = size; -} - - -static void setnodevector (lua_State *L, Table *t, int size) { - int lsize; - if (size == 0) { /* no elements to hash part? */ - t->node = cast(Node *, dummynode); /* use common `dummynode' */ - lsize = 0; - } - else { - int i; - lsize = luaO_ceillog2(size); - if (lsize > MAXBITS) - luaG_runerror(L, "table overflow"); - size = twoto(lsize); - t->node = luaM_newvector(L, size, Node); - for (i=0; ilsizenode = cast_byte(lsize); - t->lastfree = gnode(t, size); /* all positions are free */ -} - - -void luaH_resize (lua_State *L, Table *t, int nasize, int nhsize) { - int i; - int oldasize = t->sizearray; - int oldhsize = t->lsizenode; - Node *nold = t->node; /* save old hash ... */ - if (nasize > oldasize) /* array part must grow? */ - setarrayvector(L, t, nasize); - /* create new hash part with appropriate size */ - setnodevector(L, t, nhsize); - if (nasize < oldasize) { /* array part must shrink? */ - t->sizearray = nasize; - /* re-insert elements from vanishing slice */ - for (i=nasize; iarray[i])) - luaH_setint(L, t, i + 1, &t->array[i]); - } - /* shrink array */ - luaM_reallocvector(L, t->array, oldasize, nasize, TValue); - } - /* re-insert elements from hash part */ - for (i = twoto(oldhsize) - 1; i >= 0; i--) { - Node *old = nold+i; - if (!ttisnil(gval(old))) { - /* doesn't need barrier/invalidate cache, as entry was - already present in the table */ - setobjt2t(L, luaH_set(L, t, gkey(old)), gval(old)); - } - } - if (!isdummy(nold)) - luaM_freearray(L, nold, cast(size_t, twoto(oldhsize))); /* free old array */ -} - - -void luaH_resizearray (lua_State *L, Table *t, int nasize) { - int nsize = isdummy(t->node) ? 0 : sizenode(t); - luaH_resize(L, t, nasize, nsize); -} - - -static void rehash (lua_State *L, Table *t, const TValue *ek) { - int nasize, na; - int nums[MAXBITS+1]; /* nums[i] = number of keys with 2^(i-1) < k <= 2^i */ - int i; - int totaluse; - for (i=0; i<=MAXBITS; i++) nums[i] = 0; /* reset counts */ - nasize = numusearray(t, nums); /* count keys in array part */ - totaluse = nasize; /* all those keys are integer keys */ - totaluse += numusehash(t, nums, &nasize); /* count keys in hash part */ - /* count extra key */ - nasize += countint(ek, nums); - totaluse++; - /* compute new size for array part */ - na = computesizes(nums, &nasize); - /* resize the table to new computed sizes */ - luaH_resize(L, t, nasize, totaluse - na); -} - - - -/* -** }============================================================= -*/ - - -Table *luaH_new (lua_State *L) { - Table *t = &luaC_newobj(L, LUA_TTABLE, sizeof(Table), NULL, 0)->h; - t->metatable = NULL; - t->flags = cast_byte(~0); - t->array = NULL; - t->sizearray = 0; - setnodevector(L, t, 0); - return t; -} - - -void luaH_free (lua_State *L, Table *t) { - if (!isdummy(t->node)) - luaM_freearray(L, t->node, cast(size_t, sizenode(t))); - luaM_freearray(L, t->array, t->sizearray); - luaM_free(L, t); -} - - -static Node *getfreepos (Table *t) { - while (t->lastfree > t->node) { - t->lastfree--; - if (ttisnil(gkey(t->lastfree))) - return t->lastfree; - } - return NULL; /* could not find a free place */ -} - - - -/* -** inserts a new key into a hash table; first, check whether key's main -** position is free. If not, check whether colliding node is in its main -** position or not: if it is not, move colliding node to an empty place and -** put new key in its main position; otherwise (colliding node is in its main -** position), new key goes to an empty position. -*/ -TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key) { - Node *mp; - if (ttisnil(key)) luaG_runerror(L, "table index is nil"); - else if (ttisnumber(key) && luai_numisnan(L, nvalue(key))) - luaG_runerror(L, "table index is NaN"); - mp = mainposition(t, key); - if (!ttisnil(gval(mp)) || isdummy(mp)) { /* main position is taken? */ - Node *othern; - Node *n = getfreepos(t); /* get a free place */ - if (n == NULL) { /* cannot find a free place? */ - rehash(L, t, key); /* grow table */ - /* whatever called 'newkey' take care of TM cache and GC barrier */ - return luaH_set(L, t, key); /* insert key into grown table */ - } - lua_assert(!isdummy(n)); - othern = mainposition(t, gkey(mp)); - if (othern != mp) { /* is colliding node out of its main position? */ - /* yes; move colliding node into free position */ - while (gnext(othern) != mp) othern = gnext(othern); /* find previous */ - gnext(othern) = n; /* redo the chain with `n' in place of `mp' */ - *n = *mp; /* copy colliding node into free pos. (mp->next also goes) */ - gnext(mp) = NULL; /* now `mp' is free */ - setnilvalue(gval(mp)); - } - else { /* colliding node is in its own main position */ - /* new node will go into free position */ - gnext(n) = gnext(mp); /* chain new position */ - gnext(mp) = n; - mp = n; - } - } - setobj2t(L, gkey(mp), key); - luaC_barrierback(L, obj2gco(t), key); - lua_assert(ttisnil(gval(mp))); - return gval(mp); -} - - -/* -** search function for integers -*/ -const TValue *luaH_getint (Table *t, int key) { - /* (1 <= key && key <= t->sizearray) */ - if (cast(unsigned int, key-1) < cast(unsigned int, t->sizearray)) - return &t->array[key-1]; - else { - lua_Number nk = cast_num(key); - Node *n = hashnum(t, nk); - do { /* check whether `key' is somewhere in the chain */ - if (ttisnumber(gkey(n)) && luai_numeq(nvalue(gkey(n)), nk)) - return gval(n); /* that's it */ - else n = gnext(n); - } while (n); - return luaO_nilobject; - } -} - - -/* -** search function for short strings -*/ -const TValue *luaH_getstr (Table *t, TString *key) { - Node *n = hashstr(t, key); - lua_assert(key->tsv.tt == LUA_TSHRSTR); - do { /* check whether `key' is somewhere in the chain */ - if (ttisshrstring(gkey(n)) && eqshrstr(rawtsvalue(gkey(n)), key)) - return gval(n); /* that's it */ - else n = gnext(n); - } while (n); - return luaO_nilobject; -} - - -/* -** main search function -*/ -const TValue *luaH_get (Table *t, const TValue *key) { - switch (ttype(key)) { - case LUA_TSHRSTR: return luaH_getstr(t, rawtsvalue(key)); - case LUA_TNIL: return luaO_nilobject; - case LUA_TNUMBER: { - int k; - lua_Number n = nvalue(key); - lua_number2int(k, n); - if (luai_numeq(cast_num(k), n)) /* index is int? */ - return luaH_getint(t, k); /* use specialized version */ - /* else go through */ - } - default: { - Node *n = mainposition(t, key); - do { /* check whether `key' is somewhere in the chain */ - if (luaV_rawequalobj(gkey(n), key)) - return gval(n); /* that's it */ - else n = gnext(n); - } while (n); - return luaO_nilobject; - } - } -} - - -/* -** beware: when using this function you probably need to check a GC -** barrier and invalidate the TM cache. -*/ -TValue *luaH_set (lua_State *L, Table *t, const TValue *key) { - const TValue *p = luaH_get(t, key); - if (p != luaO_nilobject) - return cast(TValue *, p); - else return luaH_newkey(L, t, key); -} - - -void luaH_setint (lua_State *L, Table *t, int key, TValue *value) { - const TValue *p = luaH_getint(t, key); - TValue *cell; - if (p != luaO_nilobject) - cell = cast(TValue *, p); - else { - TValue k; - setnvalue(&k, cast_num(key)); - cell = luaH_newkey(L, t, &k); - } - setobj2t(L, cell, value); -} - - -static int unbound_search (Table *t, unsigned int j) { - unsigned int i = j; /* i is zero or a present index */ - j++; - /* find `i' and `j' such that i is present and j is not */ - while (!ttisnil(luaH_getint(t, j))) { - i = j; - j *= 2; - if (j > cast(unsigned int, MAX_INT)) { /* overflow? */ - /* table was built with bad purposes: resort to linear search */ - i = 1; - while (!ttisnil(luaH_getint(t, i))) i++; - return i - 1; - } - } - /* now do a binary search between them */ - while (j - i > 1) { - unsigned int m = (i+j)/2; - if (ttisnil(luaH_getint(t, m))) j = m; - else i = m; - } - return i; -} - - -/* -** Try to find a boundary in table `t'. A `boundary' is an integer index -** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil). -*/ -int luaH_getn (Table *t) { - unsigned int j = t->sizearray; - if (j > 0 && ttisnil(&t->array[j - 1])) { - /* there is a boundary in the array part: (binary) search for it */ - unsigned int i = 0; - while (j - i > 1) { - unsigned int m = (i+j)/2; - if (ttisnil(&t->array[m - 1])) j = m; - else i = m; - } - return i; - } - /* else must find a boundary in hash part */ - else if (isdummy(t->node)) /* hash part is empty? */ - return j; /* that is easy... */ - else return unbound_search(t, j); -} - - - -#if defined(LUA_DEBUG) - -Node *luaH_mainposition (const Table *t, const TValue *key) { - return mainposition(t, key); -} - -int luaH_isdummy (Node *n) { return isdummy(n); } - -#endif diff --git a/ext/lua/src/ltablib.c b/ext/lua/src/ltablib.c deleted file mode 100644 index 6001224e39..0000000000 --- a/ext/lua/src/ltablib.c +++ /dev/null @@ -1,283 +0,0 @@ -/* -** $Id: ltablib.c,v 1.65.1.1 2013/04/12 18:48:47 roberto Exp $ -** Library for Table Manipulation -** See Copyright Notice in lua.h -*/ - - -#include - -#define ltablib_c -#define LUA_LIB - -#include "lua.h" - -#include "lauxlib.h" -#include "lualib.h" - - -#define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_len(L, n)) - - - -#if defined(LUA_COMPAT_MAXN) -static int maxn (lua_State *L) { - lua_Number max = 0; - luaL_checktype(L, 1, LUA_TTABLE); - lua_pushnil(L); /* first key */ - while (lua_next(L, 1)) { - lua_pop(L, 1); /* remove value */ - if (lua_type(L, -1) == LUA_TNUMBER) { - lua_Number v = lua_tonumber(L, -1); - if (v > max) max = v; - } - } - lua_pushnumber(L, max); - return 1; -} -#endif - - -static int tinsert (lua_State *L) { - int e = aux_getn(L, 1) + 1; /* first empty element */ - int pos; /* where to insert new element */ - switch (lua_gettop(L)) { - case 2: { /* called with only 2 arguments */ - pos = e; /* insert new element at the end */ - break; - } - case 3: { - int i; - pos = luaL_checkint(L, 2); /* 2nd argument is the position */ - luaL_argcheck(L, 1 <= pos && pos <= e, 2, "position out of bounds"); - for (i = e; i > pos; i--) { /* move up elements */ - lua_rawgeti(L, 1, i-1); - lua_rawseti(L, 1, i); /* t[i] = t[i-1] */ - } - break; - } - default: { - return luaL_error(L, "wrong number of arguments to " LUA_QL("insert")); - } - } - lua_rawseti(L, 1, pos); /* t[pos] = v */ - return 0; -} - - -static int tremove (lua_State *L) { - int size = aux_getn(L, 1); - int pos = luaL_optint(L, 2, size); - if (pos != size) /* validate 'pos' if given */ - luaL_argcheck(L, 1 <= pos && pos <= size + 1, 1, "position out of bounds"); - lua_rawgeti(L, 1, pos); /* result = t[pos] */ - for ( ; pos < size; pos++) { - lua_rawgeti(L, 1, pos+1); - lua_rawseti(L, 1, pos); /* t[pos] = t[pos+1] */ - } - lua_pushnil(L); - lua_rawseti(L, 1, pos); /* t[pos] = nil */ - return 1; -} - - -static void addfield (lua_State *L, luaL_Buffer *b, int i) { - lua_rawgeti(L, 1, i); - if (!lua_isstring(L, -1)) - luaL_error(L, "invalid value (%s) at index %d in table for " - LUA_QL("concat"), luaL_typename(L, -1), i); - luaL_addvalue(b); -} - - -static int tconcat (lua_State *L) { - luaL_Buffer b; - size_t lsep; - int i, last; - const char *sep = luaL_optlstring(L, 2, "", &lsep); - luaL_checktype(L, 1, LUA_TTABLE); - i = luaL_optint(L, 3, 1); - last = luaL_opt(L, luaL_checkint, 4, luaL_len(L, 1)); - luaL_buffinit(L, &b); - for (; i < last; i++) { - addfield(L, &b, i); - luaL_addlstring(&b, sep, lsep); - } - if (i == last) /* add last value (if interval was not empty) */ - addfield(L, &b, i); - luaL_pushresult(&b); - return 1; -} - - -/* -** {====================================================== -** Pack/unpack -** ======================================================= -*/ - -static int pack (lua_State *L) { - int n = lua_gettop(L); /* number of elements to pack */ - lua_createtable(L, n, 1); /* create result table */ - lua_pushinteger(L, n); - lua_setfield(L, -2, "n"); /* t.n = number of elements */ - if (n > 0) { /* at least one element? */ - int i; - lua_pushvalue(L, 1); - lua_rawseti(L, -2, 1); /* insert first element */ - lua_replace(L, 1); /* move table into index 1 */ - for (i = n; i >= 2; i--) /* assign other elements */ - lua_rawseti(L, 1, i); - } - return 1; /* return table */ -} - - -static int unpack (lua_State *L) { - int i, e, n; - luaL_checktype(L, 1, LUA_TTABLE); - i = luaL_optint(L, 2, 1); - e = luaL_opt(L, luaL_checkint, 3, luaL_len(L, 1)); - if (i > e) return 0; /* empty range */ - n = e - i + 1; /* number of elements */ - if (n <= 0 || !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */ - return luaL_error(L, "too many results to unpack"); - lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */ - while (i++ < e) /* push arg[i + 1...e] */ - lua_rawgeti(L, 1, i); - return n; -} - -/* }====================================================== */ - - - -/* -** {====================================================== -** Quicksort -** (based on `Algorithms in MODULA-3', Robert Sedgewick; -** Addison-Wesley, 1993.) -** ======================================================= -*/ - - -static void set2 (lua_State *L, int i, int j) { - lua_rawseti(L, 1, i); - lua_rawseti(L, 1, j); -} - -static int sort_comp (lua_State *L, int a, int b) { - if (!lua_isnil(L, 2)) { /* function? */ - int res; - lua_pushvalue(L, 2); - lua_pushvalue(L, a-1); /* -1 to compensate function */ - lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */ - lua_call(L, 2, 1); - res = lua_toboolean(L, -1); - lua_pop(L, 1); - return res; - } - else /* a < b? */ - return lua_compare(L, a, b, LUA_OPLT); -} - -static void auxsort (lua_State *L, int l, int u) { - while (l < u) { /* for tail recursion */ - int i, j; - /* sort elements a[l], a[(l+u)/2] and a[u] */ - lua_rawgeti(L, 1, l); - lua_rawgeti(L, 1, u); - if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */ - set2(L, l, u); /* swap a[l] - a[u] */ - else - lua_pop(L, 2); - if (u-l == 1) break; /* only 2 elements */ - i = (l+u)/2; - lua_rawgeti(L, 1, i); - lua_rawgeti(L, 1, l); - if (sort_comp(L, -2, -1)) /* a[i]= P */ - while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) { - if (i>=u) luaL_error(L, "invalid order function for sorting"); - lua_pop(L, 1); /* remove a[i] */ - } - /* repeat --j until a[j] <= P */ - while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) { - if (j<=l) luaL_error(L, "invalid order function for sorting"); - lua_pop(L, 1); /* remove a[j] */ - } - if (j - -#define ltm_c -#define LUA_CORE - -#include "lua.h" - -#include "lobject.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" - - -static const char udatatypename[] = "userdata"; - -LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTAGS] = { - "no value", - "nil", "boolean", udatatypename, "number", - "string", "table", "function", udatatypename, "thread", - "proto", "upval" /* these last two cases are used for tests only */ -}; - - -void luaT_init (lua_State *L) { - static const char *const luaT_eventname[] = { /* ORDER TM */ - "__index", "__newindex", - "__gc", "__mode", "__len", "__eq", - "__add", "__sub", "__mul", "__div", "__mod", - "__pow", "__unm", "__lt", "__le", - "__concat", "__call" - }; - int i; - for (i=0; itmname[i] = luaS_new(L, luaT_eventname[i]); - luaS_fix(G(L)->tmname[i]); /* never collect these names */ - } -} - - -/* -** function to be used with macro "fasttm": optimized for absence of -** tag methods -*/ -const TValue *luaT_gettm (Table *events, TMS event, TString *ename) { - const TValue *tm = luaH_getstr(events, ename); - lua_assert(event <= TM_EQ); - if (ttisnil(tm)) { /* no tag method? */ - events->flags |= cast_byte(1u<metatable; - break; - case LUA_TUSERDATA: - mt = uvalue(o)->metatable; - break; - default: - mt = G(L)->mt[ttypenv(o)]; - } - return (mt ? luaH_getstr(mt, G(L)->tmname[event]) : luaO_nilobject); -} - diff --git a/ext/lua/src/lundump.c b/ext/lua/src/lundump.c deleted file mode 100644 index 4163cb5d3b..0000000000 --- a/ext/lua/src/lundump.c +++ /dev/null @@ -1,258 +0,0 @@ -/* -** $Id: lundump.c,v 2.22.1.1 2013/04/12 18:48:47 roberto Exp $ -** load precompiled Lua chunks -** See Copyright Notice in lua.h -*/ - -#include - -#define lundump_c -#define LUA_CORE - -#include "lua.h" - -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lmem.h" -#include "lobject.h" -#include "lstring.h" -#include "lundump.h" -#include "lzio.h" - -typedef struct { - lua_State* L; - ZIO* Z; - Mbuffer* b; - const char* name; -} LoadState; - -static l_noret error(LoadState* S, const char* why) -{ - luaO_pushfstring(S->L,"%s: %s precompiled chunk",S->name,why); - luaD_throw(S->L,LUA_ERRSYNTAX); -} - -#define LoadMem(S,b,n,size) LoadBlock(S,b,(n)*(size)) -#define LoadByte(S) (lu_byte)LoadChar(S) -#define LoadVar(S,x) LoadMem(S,&x,1,sizeof(x)) -#define LoadVector(S,b,n,size) LoadMem(S,b,n,size) - -#if !defined(luai_verifycode) -#define luai_verifycode(L,b,f) /* empty */ -#endif - -static void LoadBlock(LoadState* S, void* b, size_t size) -{ - if (luaZ_read(S->Z,b,size)!=0) error(S,"truncated"); -} - -static int LoadChar(LoadState* S) -{ - char x; - LoadVar(S,x); - return x; -} - -static int LoadInt(LoadState* S) -{ - int x; - LoadVar(S,x); - if (x<0) error(S,"corrupted"); - return x; -} - -static lua_Number LoadNumber(LoadState* S) -{ - lua_Number x; - LoadVar(S,x); - return x; -} - -static TString* LoadString(LoadState* S) -{ - size_t size; - LoadVar(S,size); - if (size==0) - return NULL; - else - { - char* s=luaZ_openspace(S->L,S->b,size); - LoadBlock(S,s,size*sizeof(char)); - return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */ - } -} - -static void LoadCode(LoadState* S, Proto* f) -{ - int n=LoadInt(S); - f->code=luaM_newvector(S->L,n,Instruction); - f->sizecode=n; - LoadVector(S,f->code,n,sizeof(Instruction)); -} - -static void LoadFunction(LoadState* S, Proto* f); - -static void LoadConstants(LoadState* S, Proto* f) -{ - int i,n; - n=LoadInt(S); - f->k=luaM_newvector(S->L,n,TValue); - f->sizek=n; - for (i=0; ik[i]); - for (i=0; ik[i]; - int t=LoadChar(S); - switch (t) - { - case LUA_TNIL: - setnilvalue(o); - break; - case LUA_TBOOLEAN: - setbvalue(o,LoadChar(S)); - break; - case LUA_TNUMBER: - setnvalue(o,LoadNumber(S)); - break; - case LUA_TSTRING: - setsvalue2n(S->L,o,LoadString(S)); - break; - default: lua_assert(0); - } - } - n=LoadInt(S); - f->p=luaM_newvector(S->L,n,Proto*); - f->sizep=n; - for (i=0; ip[i]=NULL; - for (i=0; ip[i]=luaF_newproto(S->L); - LoadFunction(S,f->p[i]); - } -} - -static void LoadUpvalues(LoadState* S, Proto* f) -{ - int i,n; - n=LoadInt(S); - f->upvalues=luaM_newvector(S->L,n,Upvaldesc); - f->sizeupvalues=n; - for (i=0; iupvalues[i].name=NULL; - for (i=0; iupvalues[i].instack=LoadByte(S); - f->upvalues[i].idx=LoadByte(S); - } -} - -static void LoadDebug(LoadState* S, Proto* f) -{ - int i,n; - f->source=LoadString(S); - n=LoadInt(S); - f->lineinfo=luaM_newvector(S->L,n,int); - f->sizelineinfo=n; - LoadVector(S,f->lineinfo,n,sizeof(int)); - n=LoadInt(S); - f->locvars=luaM_newvector(S->L,n,LocVar); - f->sizelocvars=n; - for (i=0; ilocvars[i].varname=NULL; - for (i=0; ilocvars[i].varname=LoadString(S); - f->locvars[i].startpc=LoadInt(S); - f->locvars[i].endpc=LoadInt(S); - } - n=LoadInt(S); - for (i=0; iupvalues[i].name=LoadString(S); -} - -static void LoadFunction(LoadState* S, Proto* f) -{ - f->linedefined=LoadInt(S); - f->lastlinedefined=LoadInt(S); - f->numparams=LoadByte(S); - f->is_vararg=LoadByte(S); - f->maxstacksize=LoadByte(S); - LoadCode(S,f); - LoadConstants(S,f); - LoadUpvalues(S,f); - LoadDebug(S,f); -} - -/* the code below must be consistent with the code in luaU_header */ -#define N0 LUAC_HEADERSIZE -#define N1 (sizeof(LUA_SIGNATURE)-sizeof(char)) -#define N2 N1+2 -#define N3 N2+6 - -static void LoadHeader(LoadState* S) -{ - lu_byte h[LUAC_HEADERSIZE]; - lu_byte s[LUAC_HEADERSIZE]; - luaU_header(h); - memcpy(s,h,sizeof(char)); /* first char already read */ - LoadBlock(S,s+sizeof(char),LUAC_HEADERSIZE-sizeof(char)); - if (memcmp(h,s,N0)==0) return; - if (memcmp(h,s,N1)!=0) error(S,"not a"); - if (memcmp(h,s,N2)!=0) error(S,"version mismatch in"); - if (memcmp(h,s,N3)!=0) error(S,"incompatible"); else error(S,"corrupted"); -} - -/* -** load precompiled chunk -*/ -Closure* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff, const char* name) -{ - LoadState S; - Closure* cl; - if (*name=='@' || *name=='=') - S.name=name+1; - else if (*name==LUA_SIGNATURE[0]) - S.name="binary string"; - else - S.name=name; - S.L=L; - S.Z=Z; - S.b=buff; - LoadHeader(&S); - cl=luaF_newLclosure(L,1); - setclLvalue(L,L->top,cl); incr_top(L); - cl->l.p=luaF_newproto(L); - LoadFunction(&S,cl->l.p); - if (cl->l.p->sizeupvalues != 1) - { - Proto* p=cl->l.p; - cl=luaF_newLclosure(L,cl->l.p->sizeupvalues); - cl->l.p=p; - setclLvalue(L,L->top-1,cl); - } - luai_verifycode(L,buff,cl->l.p); - return cl; -} - -#define MYINT(s) (s[0]-'0') -#define VERSION MYINT(LUA_VERSION_MAJOR)*16+MYINT(LUA_VERSION_MINOR) -#define FORMAT 0 /* this is the official format */ - -/* -* make header for precompiled chunks -* if you change the code below be sure to update LoadHeader and FORMAT above -* and LUAC_HEADERSIZE in lundump.h -*/ -void luaU_header (lu_byte* h) -{ - int x=1; - memcpy(h,LUA_SIGNATURE,sizeof(LUA_SIGNATURE)-sizeof(char)); - h+=sizeof(LUA_SIGNATURE)-sizeof(char); - *h++=cast_byte(VERSION); - *h++=cast_byte(FORMAT); - *h++=cast_byte(*(char*)&x); /* endianness */ - *h++=cast_byte(sizeof(int)); - *h++=cast_byte(sizeof(size_t)); - *h++=cast_byte(sizeof(Instruction)); - *h++=cast_byte(sizeof(lua_Number)); - *h++=cast_byte(((lua_Number)0.5)==0); /* is lua_Number integral? */ - memcpy(h,LUAC_TAIL,sizeof(LUAC_TAIL)-sizeof(char)); -} diff --git a/ext/lua/src/lvm.c b/ext/lua/src/lvm.c deleted file mode 100644 index 141b9fd19c..0000000000 --- a/ext/lua/src/lvm.c +++ /dev/null @@ -1,867 +0,0 @@ -/* -** $Id: lvm.c,v 2.155.1.1 2013/04/12 18:48:47 roberto Exp $ -** Lua virtual machine -** See Copyright Notice in lua.h -*/ - - -#include -#include -#include - -#define lvm_c -#define LUA_CORE - -#include "lua.h" - -#include "ldebug.h" -#include "ldo.h" -#include "lfunc.h" -#include "lgc.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lstate.h" -#include "lstring.h" -#include "ltable.h" -#include "ltm.h" -#include "lvm.h" - - - -/* limit for table tag-method chains (to avoid loops) */ -#define MAXTAGLOOP 100 - - -const TValue *luaV_tonumber (const TValue *obj, TValue *n) { - lua_Number num; - if (ttisnumber(obj)) return obj; - if (ttisstring(obj) && luaO_str2d(svalue(obj), tsvalue(obj)->len, &num)) { - setnvalue(n, num); - return n; - } - else - return NULL; -} - - -int luaV_tostring (lua_State *L, StkId obj) { - if (!ttisnumber(obj)) - return 0; - else { - char s[LUAI_MAXNUMBER2STR]; - lua_Number n = nvalue(obj); - int l = lua_number2str(s, n); - setsvalue2s(L, obj, luaS_newlstr(L, s, l)); - return 1; - } -} - - -static void traceexec (lua_State *L) { - CallInfo *ci = L->ci; - lu_byte mask = L->hookmask; - int counthook = ((mask & LUA_MASKCOUNT) && L->hookcount == 0); - if (counthook) - resethookcount(L); /* reset count */ - if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */ - ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */ - return; /* do not call hook again (VM yielded, so it did not move) */ - } - if (counthook) - luaD_hook(L, LUA_HOOKCOUNT, -1); /* call count hook */ - if (mask & LUA_MASKLINE) { - Proto *p = ci_func(ci)->p; - int npc = pcRel(ci->u.l.savedpc, p); - int newline = getfuncline(p, npc); - if (npc == 0 || /* call linehook when enter a new function, */ - ci->u.l.savedpc <= L->oldpc || /* when jump back (loop), or when */ - newline != getfuncline(p, pcRel(L->oldpc, p))) /* enter a new line */ - luaD_hook(L, LUA_HOOKLINE, newline); /* call line hook */ - } - L->oldpc = ci->u.l.savedpc; - if (L->status == LUA_YIELD) { /* did hook yield? */ - if (counthook) - L->hookcount = 1; /* undo decrement to zero */ - ci->u.l.savedpc--; /* undo increment (resume will increment it again) */ - ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */ - ci->func = L->top - 1; /* protect stack below results */ - luaD_throw(L, LUA_YIELD); - } -} - - -static void callTM (lua_State *L, const TValue *f, const TValue *p1, - const TValue *p2, TValue *p3, int hasres) { - ptrdiff_t result = savestack(L, p3); - setobj2s(L, L->top++, f); /* push function */ - setobj2s(L, L->top++, p1); /* 1st argument */ - setobj2s(L, L->top++, p2); /* 2nd argument */ - if (!hasres) /* no result? 'p3' is third argument */ - setobj2s(L, L->top++, p3); /* 3rd argument */ - /* metamethod may yield only when called from Lua code */ - luaD_call(L, L->top - (4 - hasres), hasres, isLua(L->ci)); - if (hasres) { /* if has result, move it to its place */ - p3 = restorestack(L, result); - setobjs2s(L, p3, --L->top); - } -} - - -void luaV_gettable (lua_State *L, const TValue *t, TValue *key, StkId val) { - int loop; - for (loop = 0; loop < MAXTAGLOOP; loop++) { - const TValue *tm; - if (ttistable(t)) { /* `t' is a table? */ - Table *h = hvalue(t); - const TValue *res = luaH_get(h, key); /* do a primitive get */ - if (!ttisnil(res) || /* result is not nil? */ - (tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */ - setobj2s(L, val, res); - return; - } - /* else will try the tag method */ - } - else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX))) - luaG_typeerror(L, t, "index"); - if (ttisfunction(tm)) { - callTM(L, tm, t, key, val, 1); - return; - } - t = tm; /* else repeat with 'tm' */ - } - luaG_runerror(L, "loop in gettable"); -} - - -void luaV_settable (lua_State *L, const TValue *t, TValue *key, StkId val) { - int loop; - for (loop = 0; loop < MAXTAGLOOP; loop++) { - const TValue *tm; - if (ttistable(t)) { /* `t' is a table? */ - Table *h = hvalue(t); - TValue *oldval = cast(TValue *, luaH_get(h, key)); - /* if previous value is not nil, there must be a previous entry - in the table; moreover, a metamethod has no relevance */ - if (!ttisnil(oldval) || - /* previous value is nil; must check the metamethod */ - ((tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL && - /* no metamethod; is there a previous entry in the table? */ - (oldval != luaO_nilobject || - /* no previous entry; must create one. (The next test is - always true; we only need the assignment.) */ - (oldval = luaH_newkey(L, h, key), 1)))) { - /* no metamethod and (now) there is an entry with given key */ - setobj2t(L, oldval, val); /* assign new value to that entry */ - invalidateTMcache(h); - luaC_barrierback(L, obj2gco(h), val); - return; - } - /* else will try the metamethod */ - } - else /* not a table; check metamethod */ - if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX))) - luaG_typeerror(L, t, "index"); - /* there is a metamethod */ - if (ttisfunction(tm)) { - callTM(L, tm, t, key, val, 0); - return; - } - t = tm; /* else repeat with 'tm' */ - } - luaG_runerror(L, "loop in settable"); -} - - -static int call_binTM (lua_State *L, const TValue *p1, const TValue *p2, - StkId res, TMS event) { - const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */ - if (ttisnil(tm)) - tm = luaT_gettmbyobj(L, p2, event); /* try second operand */ - if (ttisnil(tm)) return 0; - callTM(L, tm, p1, p2, res, 1); - return 1; -} - - -static const TValue *get_equalTM (lua_State *L, Table *mt1, Table *mt2, - TMS event) { - const TValue *tm1 = fasttm(L, mt1, event); - const TValue *tm2; - if (tm1 == NULL) return NULL; /* no metamethod */ - if (mt1 == mt2) return tm1; /* same metatables => same metamethods */ - tm2 = fasttm(L, mt2, event); - if (tm2 == NULL) return NULL; /* no metamethod */ - if (luaV_rawequalobj(tm1, tm2)) /* same metamethods? */ - return tm1; - return NULL; -} - - -static int call_orderTM (lua_State *L, const TValue *p1, const TValue *p2, - TMS event) { - if (!call_binTM(L, p1, p2, L->top, event)) - return -1; /* no metamethod */ - else - return !l_isfalse(L->top); -} - - -static int l_strcmp (const TString *ls, const TString *rs) { - const char *l = getstr(ls); - size_t ll = ls->tsv.len; - const char *r = getstr(rs); - size_t lr = rs->tsv.len; - for (;;) { - int temp = strcoll(l, r); - if (temp != 0) return temp; - else { /* strings are equal up to a `\0' */ - size_t len = strlen(l); /* index of first `\0' in both strings */ - if (len == lr) /* r is finished? */ - return (len == ll) ? 0 : 1; - else if (len == ll) /* l is finished? */ - return -1; /* l is smaller than r (because r is not finished) */ - /* both strings longer than `len'; go on comparing (after the `\0') */ - len++; - l += len; ll -= len; r += len; lr -= len; - } - } -} - - -int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) { - int res; - if (ttisnumber(l) && ttisnumber(r)) - return luai_numlt(L, nvalue(l), nvalue(r)); - else if (ttisstring(l) && ttisstring(r)) - return l_strcmp(rawtsvalue(l), rawtsvalue(r)) < 0; - else if ((res = call_orderTM(L, l, r, TM_LT)) < 0) - luaG_ordererror(L, l, r); - return res; -} - - -int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) { - int res; - if (ttisnumber(l) && ttisnumber(r)) - return luai_numle(L, nvalue(l), nvalue(r)); - else if (ttisstring(l) && ttisstring(r)) - return l_strcmp(rawtsvalue(l), rawtsvalue(r)) <= 0; - else if ((res = call_orderTM(L, l, r, TM_LE)) >= 0) /* first try `le' */ - return res; - else if ((res = call_orderTM(L, r, l, TM_LT)) < 0) /* else try `lt' */ - luaG_ordererror(L, l, r); - return !res; -} - - -/* -** equality of Lua values. L == NULL means raw equality (no metamethods) -*/ -int luaV_equalobj_ (lua_State *L, const TValue *t1, const TValue *t2) { - const TValue *tm; - lua_assert(ttisequal(t1, t2)); - switch (ttype(t1)) { - case LUA_TNIL: return 1; - case LUA_TNUMBER: return luai_numeq(nvalue(t1), nvalue(t2)); - case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */ - case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2); - case LUA_TLCF: return fvalue(t1) == fvalue(t2); - case LUA_TSHRSTR: return eqshrstr(rawtsvalue(t1), rawtsvalue(t2)); - case LUA_TLNGSTR: return luaS_eqlngstr(rawtsvalue(t1), rawtsvalue(t2)); - case LUA_TUSERDATA: { - if (uvalue(t1) == uvalue(t2)) return 1; - else if (L == NULL) return 0; - tm = get_equalTM(L, uvalue(t1)->metatable, uvalue(t2)->metatable, TM_EQ); - break; /* will try TM */ - } - case LUA_TTABLE: { - if (hvalue(t1) == hvalue(t2)) return 1; - else if (L == NULL) return 0; - tm = get_equalTM(L, hvalue(t1)->metatable, hvalue(t2)->metatable, TM_EQ); - break; /* will try TM */ - } - default: - lua_assert(iscollectable(t1)); - return gcvalue(t1) == gcvalue(t2); - } - if (tm == NULL) return 0; /* no TM? */ - callTM(L, tm, t1, t2, L->top, 1); /* call TM */ - return !l_isfalse(L->top); -} - - -void luaV_concat (lua_State *L, int total) { - lua_assert(total >= 2); - do { - StkId top = L->top; - int n = 2; /* number of elements handled in this pass (at least 2) */ - if (!(ttisstring(top-2) || ttisnumber(top-2)) || !tostring(L, top-1)) { - if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT)) - luaG_concaterror(L, top-2, top-1); - } - else if (tsvalue(top-1)->len == 0) /* second operand is empty? */ - (void)tostring(L, top - 2); /* result is first operand */ - else if (ttisstring(top-2) && tsvalue(top-2)->len == 0) { - setobjs2s(L, top - 2, top - 1); /* result is second op. */ - } - else { - /* at least two non-empty string values; get as many as possible */ - size_t tl = tsvalue(top-1)->len; - char *buffer; - int i; - /* collect total length */ - for (i = 1; i < total && tostring(L, top-i-1); i++) { - size_t l = tsvalue(top-i-1)->len; - if (l >= (MAX_SIZET/sizeof(char)) - tl) - luaG_runerror(L, "string length overflow"); - tl += l; - } - buffer = luaZ_openspace(L, &G(L)->buff, tl); - tl = 0; - n = i; - do { /* concat all strings */ - size_t l = tsvalue(top-i)->len; - memcpy(buffer+tl, svalue(top-i), l * sizeof(char)); - tl += l; - } while (--i > 0); - setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl)); - } - total -= n-1; /* got 'n' strings to create 1 new */ - L->top -= n-1; /* popped 'n' strings and pushed one */ - } while (total > 1); /* repeat until only 1 result left */ -} - - -void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) { - const TValue *tm; - switch (ttypenv(rb)) { - case LUA_TTABLE: { - Table *h = hvalue(rb); - tm = fasttm(L, h->metatable, TM_LEN); - if (tm) break; /* metamethod? break switch to call it */ - setnvalue(ra, cast_num(luaH_getn(h))); /* else primitive len */ - return; - } - case LUA_TSTRING: { - setnvalue(ra, cast_num(tsvalue(rb)->len)); - return; - } - default: { /* try metamethod */ - tm = luaT_gettmbyobj(L, rb, TM_LEN); - if (ttisnil(tm)) /* no metamethod? */ - luaG_typeerror(L, rb, "get length of"); - break; - } - } - callTM(L, tm, rb, rb, ra, 1); -} - - -void luaV_arith (lua_State *L, StkId ra, const TValue *rb, - const TValue *rc, TMS op) { - TValue tempb, tempc; - const TValue *b, *c; - if ((b = luaV_tonumber(rb, &tempb)) != NULL && - (c = luaV_tonumber(rc, &tempc)) != NULL) { - lua_Number res = luaO_arith(op - TM_ADD + LUA_OPADD, nvalue(b), nvalue(c)); - setnvalue(ra, res); - } - else if (!call_binTM(L, rb, rc, ra, op)) - luaG_aritherror(L, rb, rc); -} - - -/* -** check whether cached closure in prototype 'p' may be reused, that is, -** whether there is a cached closure with the same upvalues needed by -** new closure to be created. -*/ -static Closure *getcached (Proto *p, UpVal **encup, StkId base) { - Closure *c = p->cache; - if (c != NULL) { /* is there a cached closure? */ - int nup = p->sizeupvalues; - Upvaldesc *uv = p->upvalues; - int i; - for (i = 0; i < nup; i++) { /* check whether it has right upvalues */ - TValue *v = uv[i].instack ? base + uv[i].idx : encup[uv[i].idx]->v; - if (c->l.upvals[i]->v != v) - return NULL; /* wrong upvalue; cannot reuse closure */ - } - } - return c; /* return cached closure (or NULL if no cached closure) */ -} - - -/* -** create a new Lua closure, push it in the stack, and initialize -** its upvalues. Note that the call to 'luaC_barrierproto' must come -** before the assignment to 'p->cache', as the function needs the -** original value of that field. -*/ -static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base, - StkId ra) { - int nup = p->sizeupvalues; - Upvaldesc *uv = p->upvalues; - int i; - Closure *ncl = luaF_newLclosure(L, nup); - ncl->l.p = p; - setclLvalue(L, ra, ncl); /* anchor new closure in stack */ - for (i = 0; i < nup; i++) { /* fill in its upvalues */ - if (uv[i].instack) /* upvalue refers to local variable? */ - ncl->l.upvals[i] = luaF_findupval(L, base + uv[i].idx); - else /* get upvalue from enclosing function */ - ncl->l.upvals[i] = encup[uv[i].idx]; - } - luaC_barrierproto(L, p, ncl); - p->cache = ncl; /* save it on cache for reuse */ -} - - -/* -** finish execution of an opcode interrupted by an yield -*/ -void luaV_finishOp (lua_State *L) { - CallInfo *ci = L->ci; - StkId base = ci->u.l.base; - Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */ - OpCode op = GET_OPCODE(inst); - switch (op) { /* finish its execution */ - case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV: - case OP_MOD: case OP_POW: case OP_UNM: case OP_LEN: - case OP_GETTABUP: case OP_GETTABLE: case OP_SELF: { - setobjs2s(L, base + GETARG_A(inst), --L->top); - break; - } - case OP_LE: case OP_LT: case OP_EQ: { - int res = !l_isfalse(L->top - 1); - L->top--; - /* metamethod should not be called when operand is K */ - lua_assert(!ISK(GETARG_B(inst))); - if (op == OP_LE && /* "<=" using "<" instead? */ - ttisnil(luaT_gettmbyobj(L, base + GETARG_B(inst), TM_LE))) - res = !res; /* invert result */ - lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP); - if (res != GETARG_A(inst)) /* condition failed? */ - ci->u.l.savedpc++; /* skip jump instruction */ - break; - } - case OP_CONCAT: { - StkId top = L->top - 1; /* top when 'call_binTM' was called */ - int b = GETARG_B(inst); /* first element to concatenate */ - int total = cast_int(top - 1 - (base + b)); /* yet to concatenate */ - setobj2s(L, top - 2, top); /* put TM result in proper position */ - if (total > 1) { /* are there elements to concat? */ - L->top = top - 1; /* top is one after last element (at top-2) */ - luaV_concat(L, total); /* concat them (may yield again) */ - } - /* move final result to final position */ - setobj2s(L, ci->u.l.base + GETARG_A(inst), L->top - 1); - L->top = ci->top; /* restore top */ - break; - } - case OP_TFORCALL: { - lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_TFORLOOP); - L->top = ci->top; /* correct top */ - break; - } - case OP_CALL: { - if (GETARG_C(inst) - 1 >= 0) /* nresults >= 0? */ - L->top = ci->top; /* adjust results */ - break; - } - case OP_TAILCALL: case OP_SETTABUP: case OP_SETTABLE: - break; - default: lua_assert(0); - } -} - - - -/* -** some macros for common tasks in `luaV_execute' -*/ - -#if !defined luai_runtimecheck -#define luai_runtimecheck(L, c) /* void */ -#endif - - -#define RA(i) (base+GETARG_A(i)) -/* to be used after possible stack reallocation */ -#define RB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i)) -#define RC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i)) -#define RKB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \ - ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i)) -#define RKC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \ - ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i)) -#define KBx(i) \ - (k + (GETARG_Bx(i) != 0 ? GETARG_Bx(i) - 1 : GETARG_Ax(*ci->u.l.savedpc++))) - - -/* execute a jump instruction */ -#define dojump(ci,i,e) \ - { int a = GETARG_A(i); \ - if (a > 0) luaF_close(L, ci->u.l.base + a - 1); \ - ci->u.l.savedpc += GETARG_sBx(i) + e; } - -/* for test instructions, execute the jump instruction that follows it */ -#define donextjump(ci) { i = *ci->u.l.savedpc; dojump(ci, i, 1); } - - -#define Protect(x) { {x;}; base = ci->u.l.base; } - -#define checkGC(L,c) \ - Protect( luaC_condGC(L,{L->top = (c); /* limit of live values */ \ - luaC_step(L); \ - L->top = ci->top;}) /* restore top */ \ - luai_threadyield(L); ) - - -#define arith_op(op,tm) { \ - TValue *rb = RKB(i); \ - TValue *rc = RKC(i); \ - if (ttisnumber(rb) && ttisnumber(rc)) { \ - lua_Number nb = nvalue(rb), nc = nvalue(rc); \ - setnvalue(ra, op(L, nb, nc)); \ - } \ - else { Protect(luaV_arith(L, ra, rb, rc, tm)); } } - - -#define vmdispatch(o) switch(o) -#define vmcase(l,b) case l: {b} break; -#define vmcasenb(l,b) case l: {b} /* nb = no break */ - -void luaV_execute (lua_State *L) { - CallInfo *ci = L->ci; - LClosure *cl; - TValue *k; - StkId base; - newframe: /* reentry point when frame changes (call/return) */ - lua_assert(ci == L->ci); - cl = clLvalue(ci->func); - k = cl->p->k; - base = ci->u.l.base; - /* main loop of interpreter */ - for (;;) { - Instruction i = *(ci->u.l.savedpc++); - StkId ra; - if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) && - (--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) { - Protect(traceexec(L)); - } - /* WARNING: several calls may realloc the stack and invalidate `ra' */ - ra = RA(i); - lua_assert(base == ci->u.l.base); - lua_assert(base <= L->top && L->top < L->stack + L->stacksize); - vmdispatch (GET_OPCODE(i)) { - vmcase(OP_MOVE, - setobjs2s(L, ra, RB(i)); - ) - vmcase(OP_LOADK, - TValue *rb = k + GETARG_Bx(i); - setobj2s(L, ra, rb); - ) - vmcase(OP_LOADKX, - TValue *rb; - lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG); - rb = k + GETARG_Ax(*ci->u.l.savedpc++); - setobj2s(L, ra, rb); - ) - vmcase(OP_LOADBOOL, - setbvalue(ra, GETARG_B(i)); - if (GETARG_C(i)) ci->u.l.savedpc++; /* skip next instruction (if C) */ - ) - vmcase(OP_LOADNIL, - int b = GETARG_B(i); - do { - setnilvalue(ra++); - } while (b--); - ) - vmcase(OP_GETUPVAL, - int b = GETARG_B(i); - setobj2s(L, ra, cl->upvals[b]->v); - ) - vmcase(OP_GETTABUP, - int b = GETARG_B(i); - Protect(luaV_gettable(L, cl->upvals[b]->v, RKC(i), ra)); - ) - vmcase(OP_GETTABLE, - Protect(luaV_gettable(L, RB(i), RKC(i), ra)); - ) - vmcase(OP_SETTABUP, - int a = GETARG_A(i); - Protect(luaV_settable(L, cl->upvals[a]->v, RKB(i), RKC(i))); - ) - vmcase(OP_SETUPVAL, - UpVal *uv = cl->upvals[GETARG_B(i)]; - setobj(L, uv->v, ra); - luaC_barrier(L, uv, ra); - ) - vmcase(OP_SETTABLE, - Protect(luaV_settable(L, ra, RKB(i), RKC(i))); - ) - vmcase(OP_NEWTABLE, - int b = GETARG_B(i); - int c = GETARG_C(i); - Table *t = luaH_new(L); - sethvalue(L, ra, t); - if (b != 0 || c != 0) - luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c)); - checkGC(L, ra + 1); - ) - vmcase(OP_SELF, - StkId rb = RB(i); - setobjs2s(L, ra+1, rb); - Protect(luaV_gettable(L, rb, RKC(i), ra)); - ) - vmcase(OP_ADD, - arith_op(luai_numadd, TM_ADD); - ) - vmcase(OP_SUB, - arith_op(luai_numsub, TM_SUB); - ) - vmcase(OP_MUL, - arith_op(luai_nummul, TM_MUL); - ) - vmcase(OP_DIV, - arith_op(luai_numdiv, TM_DIV); - ) - vmcase(OP_MOD, - arith_op(luai_nummod, TM_MOD); - ) - vmcase(OP_POW, - arith_op(luai_numpow, TM_POW); - ) - vmcase(OP_UNM, - TValue *rb = RB(i); - if (ttisnumber(rb)) { - lua_Number nb = nvalue(rb); - setnvalue(ra, luai_numunm(L, nb)); - } - else { - Protect(luaV_arith(L, ra, rb, rb, TM_UNM)); - } - ) - vmcase(OP_NOT, - TValue *rb = RB(i); - int res = l_isfalse(rb); /* next assignment may change this value */ - setbvalue(ra, res); - ) - vmcase(OP_LEN, - Protect(luaV_objlen(L, ra, RB(i))); - ) - vmcase(OP_CONCAT, - int b = GETARG_B(i); - int c = GETARG_C(i); - StkId rb; - L->top = base + c + 1; /* mark the end of concat operands */ - Protect(luaV_concat(L, c - b + 1)); - ra = RA(i); /* 'luav_concat' may invoke TMs and move the stack */ - rb = b + base; - setobjs2s(L, ra, rb); - checkGC(L, (ra >= rb ? ra + 1 : rb)); - L->top = ci->top; /* restore top */ - ) - vmcase(OP_JMP, - dojump(ci, i, 0); - ) - vmcase(OP_EQ, - TValue *rb = RKB(i); - TValue *rc = RKC(i); - Protect( - if (cast_int(equalobj(L, rb, rc)) != GETARG_A(i)) - ci->u.l.savedpc++; - else - donextjump(ci); - ) - ) - vmcase(OP_LT, - Protect( - if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i)) - ci->u.l.savedpc++; - else - donextjump(ci); - ) - ) - vmcase(OP_LE, - Protect( - if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i)) - ci->u.l.savedpc++; - else - donextjump(ci); - ) - ) - vmcase(OP_TEST, - if (GETARG_C(i) ? l_isfalse(ra) : !l_isfalse(ra)) - ci->u.l.savedpc++; - else - donextjump(ci); - ) - vmcase(OP_TESTSET, - TValue *rb = RB(i); - if (GETARG_C(i) ? l_isfalse(rb) : !l_isfalse(rb)) - ci->u.l.savedpc++; - else { - setobjs2s(L, ra, rb); - donextjump(ci); - } - ) - vmcase(OP_CALL, - int b = GETARG_B(i); - int nresults = GETARG_C(i) - 1; - if (b != 0) L->top = ra+b; /* else previous instruction set top */ - if (luaD_precall(L, ra, nresults)) { /* C function? */ - if (nresults >= 0) L->top = ci->top; /* adjust results */ - base = ci->u.l.base; - } - else { /* Lua function */ - ci = L->ci; - ci->callstatus |= CIST_REENTRY; - goto newframe; /* restart luaV_execute over new Lua function */ - } - ) - vmcase(OP_TAILCALL, - int b = GETARG_B(i); - if (b != 0) L->top = ra+b; /* else previous instruction set top */ - lua_assert(GETARG_C(i) - 1 == LUA_MULTRET); - if (luaD_precall(L, ra, LUA_MULTRET)) /* C function? */ - base = ci->u.l.base; - else { - /* tail call: put called frame (n) in place of caller one (o) */ - CallInfo *nci = L->ci; /* called frame */ - CallInfo *oci = nci->previous; /* caller frame */ - StkId nfunc = nci->func; /* called function */ - StkId ofunc = oci->func; /* caller function */ - /* last stack slot filled by 'precall' */ - StkId lim = nci->u.l.base + getproto(nfunc)->numparams; - int aux; - /* close all upvalues from previous call */ - if (cl->p->sizep > 0) luaF_close(L, oci->u.l.base); - /* move new frame into old one */ - for (aux = 0; nfunc + aux < lim; aux++) - setobjs2s(L, ofunc + aux, nfunc + aux); - oci->u.l.base = ofunc + (nci->u.l.base - nfunc); /* correct base */ - oci->top = L->top = ofunc + (L->top - nfunc); /* correct top */ - oci->u.l.savedpc = nci->u.l.savedpc; - oci->callstatus |= CIST_TAIL; /* function was tail called */ - ci = L->ci = oci; /* remove new frame */ - lua_assert(L->top == oci->u.l.base + getproto(ofunc)->maxstacksize); - goto newframe; /* restart luaV_execute over new Lua function */ - } - ) - vmcasenb(OP_RETURN, - int b = GETARG_B(i); - if (b != 0) L->top = ra+b-1; - if (cl->p->sizep > 0) luaF_close(L, base); - b = luaD_poscall(L, ra); - if (!(ci->callstatus & CIST_REENTRY)) /* 'ci' still the called one */ - return; /* external invocation: return */ - else { /* invocation via reentry: continue execution */ - ci = L->ci; - if (b) L->top = ci->top; - lua_assert(isLua(ci)); - lua_assert(GET_OPCODE(*((ci)->u.l.savedpc - 1)) == OP_CALL); - goto newframe; /* restart luaV_execute over new Lua function */ - } - ) - vmcase(OP_FORLOOP, - lua_Number step = nvalue(ra+2); - lua_Number idx = luai_numadd(L, nvalue(ra), step); /* increment index */ - lua_Number limit = nvalue(ra+1); - if (luai_numlt(L, 0, step) ? luai_numle(L, idx, limit) - : luai_numle(L, limit, idx)) { - ci->u.l.savedpc += GETARG_sBx(i); /* jump back */ - setnvalue(ra, idx); /* update internal index... */ - setnvalue(ra+3, idx); /* ...and external index */ - } - ) - vmcase(OP_FORPREP, - const TValue *init = ra; - const TValue *plimit = ra+1; - const TValue *pstep = ra+2; - if (!tonumber(init, ra)) - luaG_runerror(L, LUA_QL("for") " initial value must be a number"); - else if (!tonumber(plimit, ra+1)) - luaG_runerror(L, LUA_QL("for") " limit must be a number"); - else if (!tonumber(pstep, ra+2)) - luaG_runerror(L, LUA_QL("for") " step must be a number"); - setnvalue(ra, luai_numsub(L, nvalue(ra), nvalue(pstep))); - ci->u.l.savedpc += GETARG_sBx(i); - ) - vmcasenb(OP_TFORCALL, - StkId cb = ra + 3; /* call base */ - setobjs2s(L, cb+2, ra+2); - setobjs2s(L, cb+1, ra+1); - setobjs2s(L, cb, ra); - L->top = cb + 3; /* func. + 2 args (state and index) */ - Protect(luaD_call(L, cb, GETARG_C(i), 1)); - L->top = ci->top; - i = *(ci->u.l.savedpc++); /* go to next instruction */ - ra = RA(i); - lua_assert(GET_OPCODE(i) == OP_TFORLOOP); - goto l_tforloop; - ) - vmcase(OP_TFORLOOP, - l_tforloop: - if (!ttisnil(ra + 1)) { /* continue loop? */ - setobjs2s(L, ra, ra + 1); /* save control variable */ - ci->u.l.savedpc += GETARG_sBx(i); /* jump back */ - } - ) - vmcase(OP_SETLIST, - int n = GETARG_B(i); - int c = GETARG_C(i); - int last; - Table *h; - if (n == 0) n = cast_int(L->top - ra) - 1; - if (c == 0) { - lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG); - c = GETARG_Ax(*ci->u.l.savedpc++); - } - luai_runtimecheck(L, ttistable(ra)); - h = hvalue(ra); - last = ((c-1)*LFIELDS_PER_FLUSH) + n; - if (last > h->sizearray) /* needs more space? */ - luaH_resizearray(L, h, last); /* pre-allocate it at once */ - for (; n > 0; n--) { - TValue *val = ra+n; - luaH_setint(L, h, last--, val); - luaC_barrierback(L, obj2gco(h), val); - } - L->top = ci->top; /* correct top (in case of previous open call) */ - ) - vmcase(OP_CLOSURE, - Proto *p = cl->p->p[GETARG_Bx(i)]; - Closure *ncl = getcached(p, cl->upvals, base); /* cached closure */ - if (ncl == NULL) /* no match? */ - pushclosure(L, p, cl->upvals, base, ra); /* create a new one */ - else - setclLvalue(L, ra, ncl); /* push cashed closure */ - checkGC(L, ra + 1); - ) - vmcase(OP_VARARG, - int b = GETARG_B(i) - 1; - int j; - int n = cast_int(base - ci->func) - cl->p->numparams - 1; - if (b < 0) { /* B == 0? */ - b = n; /* get all var. arguments */ - Protect(luaD_checkstack(L, n)); - ra = RA(i); /* previous call may change the stack */ - L->top = ra + n; - } - for (j = 0; j < b; j++) { - if (j < n) { - setobjs2s(L, ra + j, base - n + j); - } - else { - setnilvalue(ra + j); - } - } - ) - vmcase(OP_EXTRAARG, - lua_assert(0); - ) - } - } -} - diff --git a/ext/lua/src/lzio.c b/ext/lua/src/lzio.c deleted file mode 100644 index 20efea9830..0000000000 --- a/ext/lua/src/lzio.c +++ /dev/null @@ -1,76 +0,0 @@ -/* -** $Id: lzio.c,v 1.35.1.1 2013/04/12 18:48:47 roberto Exp $ -** Buffered streams -** See Copyright Notice in lua.h -*/ - - -#include - -#define lzio_c -#define LUA_CORE - -#include "lua.h" - -#include "llimits.h" -#include "lmem.h" -#include "lstate.h" -#include "lzio.h" - - -int luaZ_fill (ZIO *z) { - size_t size; - lua_State *L = z->L; - const char *buff; - lua_unlock(L); - buff = z->reader(L, z->data, &size); - lua_lock(L); - if (buff == NULL || size == 0) - return EOZ; - z->n = size - 1; /* discount char being returned */ - z->p = buff; - return cast_uchar(*(z->p++)); -} - - -void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) { - z->L = L; - z->reader = reader; - z->data = data; - z->n = 0; - z->p = NULL; -} - - -/* --------------------------------------------------------------- read --- */ -size_t luaZ_read (ZIO *z, void *b, size_t n) { - while (n) { - size_t m; - if (z->n == 0) { /* no bytes in buffer? */ - if (luaZ_fill(z) == EOZ) /* try to read more */ - return n; /* no more input; return number of missing bytes */ - else { - z->n++; /* luaZ_fill consumed first byte; put it back */ - z->p--; - } - } - m = (n <= z->n) ? n : z->n; /* min. between n and z->n */ - memcpy(b, z->p, m); - z->n -= m; - z->p += m; - b = (char *)b + m; - n -= m; - } - return 0; -} - -/* ------------------------------------------------------------------------ */ -char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n) { - if (n > buff->buffsize) { - if (n < LUA_MINBUFFER) n = LUA_MINBUFFER; - luaZ_resizebuffer(L, buff, n); - } - return buff->buffer; -} - - diff --git a/ext/spice b/ext/spice new file mode 160000 index 0000000000..784478de97 --- /dev/null +++ b/ext/spice @@ -0,0 +1 @@ +Subproject commit 784478de97c3243c9bbd668256b5e3186a85b8b3 diff --git a/ext/spice/CMakeLists.txt b/ext/spice/CMakeLists.txt deleted file mode 100644 index 1ef4c3a90a..0000000000 --- a/ext/spice/CMakeLists.txt +++ /dev/null @@ -1,28 +0,0 @@ -cmake_minimum_required (VERSION 2.8) - -project (Spice) - -if (NOT SPICE_ROOT_DIR) - set(SPICE_ROOT_DIR ${PROJECT_SOURCE_DIR}) -endif () - -file(GLOB cspice_SRC - "src/cspice/*.c" -) -file(GLOB csupport_SRC - "src/csupport/*.c" -) - -include_directories ("${SPICE_ROOT_DIR}/include") - -add_definitions( -DKR_headers ) - -if(MSVC) -add_definitions( -DMSDOS ) -endif(MSVC) - -#add_library( Spice ${cspice_SRC} ${csupport_SRC} ) -add_library( Spice ${cspice_SRC} ) - -#SET_TARGET_PROPERTIES(cspice PROPERTIES LINKER_LANGUAGE C) -#SET_TARGET_PROPERTIES(csupport PROPERTIES LINKER_LANGUAGE C) diff --git a/ext/spice/include/SpiceCK.h b/ext/spice/include/SpiceCK.h deleted file mode 100644 index 894d4e9a6c..0000000000 --- a/ext/spice/include/SpiceCK.h +++ /dev/null @@ -1,155 +0,0 @@ -/* - --Header_File SpiceCK.h ( CSPICE CK definitions ) - --Abstract - - Perform CSPICE definitions to support CK wrapper interfaces. - --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. - --Particulars - - This header defines types that may be referenced in - application code that calls CSPICE CK functions. - - Typedef - ======= - - Name Description - ---- ---------- - - SpiceCK05Subtype Typedef for enum indicating the - mathematical representation used - in an CK type 05 segment. Possible - values and meanings are: - - C05TP0: - - Hermite interpolation, 8- - element packets containing - - q0, q1, q2, q3, - dq0/dt, dq1/dt, dq2/dt dq3/dt - - where q0, q1, q2, q3 represent - quaternion components and dq0/dt, - dq1/dt, dq2/dt, dq3/dt represent - quaternion time derivative components. - - Quaternions are unitless. Quaternion - time derivatives have units of - 1/second. - - - C05TP1: - - Lagrange interpolation, 4- - element packets containing - - q0, q1, q2, q3, - - where q0, q1, q2, q3 represent - quaternion components. Quaternion - derivatives are obtained by - differentiating interpolating - polynomials. - - - C05TP2: - - Hermite interpolation, 14- - element packets containing - - q0, q1, q2, q3, - dq0/dt, dq1/dt, dq2/dt dq3/dt, - av0, av1, av2, - dav0/dt, dav1/dt, dav2/dt - - where q0, q1, q2, q3 represent - quaternion components and dq0/dt, - dq1/dt, dq2/dt, dq3/dt represent - quaternion time derivative components, - av0, av1, av2 represent angular - velocity components, and - dav0/dt, dav1/dt, dav2/dt represent - angular acceleration components. - - - C05TP3: - - Lagrange interpolation, 7- - element packets containing - - q0, q1, q2, q3, - av0, av1, av2 - - where q0, q1, q2, q3 represent - quaternion components and - av0, av1, av2 represent angular - velocity components. - - - -Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 20-AUG-2002 (NJB) - -*/ - -#ifndef HAVE_SPICE_CK_H - - #define HAVE_SPICE_CK_H - - - - /* - CK type 05 subtype codes: - */ - - enum _SpiceCK05Subtype { C05TP0, C05TP1, C05TP2, C05TP3 }; - - - typedef enum _SpiceCK05Subtype SpiceCK05Subtype; - -#endif - diff --git a/ext/spice/include/SpiceCel.h b/ext/spice/include/SpiceCel.h deleted file mode 100644 index 7b0537e9ee..0000000000 --- a/ext/spice/include/SpiceCel.h +++ /dev/null @@ -1,441 +0,0 @@ -/* - --Header_File SpiceCel.h ( CSPICE Cell definitions ) - --Abstract - - Perform CSPICE definitions for the SpiceCell data type. - --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 - - CELLS - --Particulars - - This header defines structures, macros, and enumerated types that - may be referenced in application code that calls CSPICE cell - functions. - - CSPICE cells are data structures that implement functionality - parallel to that of the cell abstract data type in SPICELIB. In - CSPICE, a cell is a C structure containing bookkeeping information, - including a pointer to an associated data array. - - For numeric data types, the data array is simply a SPICELIB-style - cell, including a valid control area. For character cells, the data - array has the same number of elements as the corresponding - SPICELIB-style cell, but the contents of the control area are not - maintained, and the data elements are null-terminated C-style - strings. - - CSPICE cells should be declared using the declaration macros - provided in this header file. See the table of macros below. - - - Structures - ========== - - Name Description - ---- ---------- - - SpiceCell Structure containing CSPICE cell metadata. - - The members are: - - dtype: Data type of cell: character, - integer, or double precision. - - dtype has type - SpiceCellDataType. - - length: For character cells, the - declared length of the - cell's string array. - - size: The maximum number of data - items that can be stored in - the cell's data array. - - card: The cell's "cardinality": the - number of data items currently - present in the cell. - - isSet: Boolean flag indicating whether - the cell is a CSPICE set. - Sets have no duplicate data - items, and their data items are - stored in increasing order. - - adjust: Boolean flag indicating whether - the cell's data area has - adjustable size. Adjustable - size cell data areas are not - currently implemented. - - init: Boolean flag indicating whether - the cell has been initialized. - - base: is a void pointer to the - associated data array. base - points to the start of the - control area of this array. - - data: is a void pointer to the - first data slot in the - associated data array. This - slot is the element following - the control area. - - - ConstSpiceCell A const SpiceCell. - - - - - Declaration Macros - ================== - - Name Description - ---- ---------- - - SPICECHAR_CELL ( name, size, length ) Declare a - character CSPICE - cell having cell - name name, - maximum cell - cardinality size, - and string length - length. The - macro declares - both the cell and - the associated - data array. The - name of the data - array begins with - "SPICE_". - - - SPICEDOUBLE_CELL ( name, size ) Like SPICECHAR_CELL, - but declares a - double precision - cell. - - - SPICEINT_CELL ( name, size ) Like - SPICECHAR_CELL, - but declares an - integer cell. - - Assignment Macros - ================= - - Name Description - ---- ---------- - SPICE_CELL_SET_C( item, i, cell ) Assign the ith - element of a - character cell. - Arguments cell - and item are - pointers. - - SPICE_CELL_SET_D( item, i, cell ) Assign the ith - element of a - double precision - cell. Argument - cell is a - pointer. - - SPICE_CELL_SET_I( item, i, cell ) Assign the ith - element of an - integer cell. - Argument cell is - a pointer. - - - Fetch Macros - ============== - - Name Description - ---- ---------- - SPICE_CELL_GET_C( cell, i, lenout, item ) Fetch the ith - element from a - character cell. - Arguments cell - and item are - pointers. - Argument lenout - is the available - space in item. - - SPICE_CELL_GET_D( cell, i, item ) Fetch the ith - element from a - double precision - cell. Arguments - cell and item are - pointers. - - SPICE_CELL_GET_I( cell, i, item ) Fetch the ith - element from an - integer cell. - Arguments cell - and item are - pointers. - Element Pointer Macros - ====================== - - Name Description - ---- ---------- - SPICE_CELL_ELEM_C( cell, i ) Macro evaluates - to a SpiceChar - pointer to the - ith data element - of a character - cell. Argument - cell is a - pointer. - - SPICE_CELL_ELEM_D( cell, i ) Macro evaluates - to a SpiceDouble - pointer to the - ith data element - of a double - precision cell. - Argument cell is - a pointer. - - SPICE_CELL_ELEM_I( cell, i ) Macro evaluates - to a SpiceInt - pointer to the - ith data element - of an integer - cell. Argument - cell is a - pointer. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 22-AUG-2002 (NJB) - -*/ -#ifndef HAVE_SPICE_CELLS_H - - #define HAVE_SPICE_CELLS_H - - - /* - Data type codes: - */ - typedef enum _SpiceDataType SpiceCellDataType; - - - /* - Cell structure: - */ - struct _SpiceCell - - { SpiceCellDataType dtype; - SpiceInt length; - SpiceInt size; - SpiceInt card; - SpiceBoolean isSet; - SpiceBoolean adjust; - SpiceBoolean init; - void * base; - void * data; }; - - typedef struct _SpiceCell SpiceCell; - - typedef const SpiceCell ConstSpiceCell; - - - /* - SpiceCell control area size: - */ - #define SPICE_CELL_CTRLSZ 6 - - - /* - Declaration macros: - */ - - #define SPICECHAR_CELL( name, size, length ) \ - \ - static SpiceChar SPICE_CELL_##name[SPICE_CELL_CTRLSZ + size][length]; \ - \ - static SpiceCell name = \ - \ - { SPICE_CHR, \ - length, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - #define SPICEDOUBLE_CELL( name, size ) \ - \ - static SpiceDouble SPICE_CELL_##name [SPICE_CELL_CTRLSZ + size]; \ - \ - static SpiceCell name = \ - \ - { SPICE_DP, \ - 0, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - #define SPICEINT_CELL( name, size ) \ - \ - static SpiceInt SPICE_CELL_##name [SPICE_CELL_CTRLSZ + size]; \ - \ - static SpiceCell name = \ - \ - { SPICE_INT, \ - 0, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - /* - Access macros for individual elements: - */ - - /* - Data element pointer macros: - */ - - #define SPICE_CELL_ELEM_C( cell, i ) \ - \ - ( ( (SpiceChar *) (cell)->data ) + (i)*( (cell)->length ) ) - - - #define SPICE_CELL_ELEM_D( cell, i ) \ - \ - ( ( (SpiceDouble *) (cell)->data )[(i)] ) - - - #define SPICE_CELL_ELEM_I( cell, i ) \ - \ - ( ( (SpiceInt *) (cell)->data )[(i)] ) - - - /* - "Fetch" macros: - */ - - #define SPICE_CELL_GET_C( cell, i, lenout, item ) \ - \ - { \ - SpiceInt nBytes; \ - \ - nBytes = brckti_c ( (cell)->length, 0, (lenout-1) ) \ - * sizeof ( SpiceChar ); \ - \ - memmove ( (item), SPICE_CELL_ELEM_C((cell), (i)), nBytes ); \ - \ - item[nBytes] = NULLCHAR; \ - } - - - #define SPICE_CELL_GET_D( cell, i, item ) \ - \ - ( (*item) = ( (SpiceDouble *) (cell)->data)[i] ) - - - #define SPICE_CELL_GET_I( cell, i, item ) \ - \ - ( (*item) = ( (SpiceInt *) (cell)->data)[i] ) - - - /* - Assignment macros: - */ - - #define SPICE_CELL_SET_C( item, i, cell ) \ - \ - { \ - SpiceChar * sPtr; \ - SpiceInt nBytes; \ - \ - nBytes = brckti_c ( strlen(item), 0, (cell)->length - 1 ) \ - * sizeof ( SpiceChar ); \ - \ - sPtr = SPICE_CELL_ELEM_C((cell), (i)); \ - \ - memmove ( sPtr, (item), nBytes ); \ - \ - sPtr[nBytes] = NULLCHAR; \ - } - - - #define SPICE_CELL_SET_D( item, i, cell ) \ - \ - ( ( (SpiceDouble *) (cell)->data)[i] = (item) ) - - - #define SPICE_CELL_SET_I( item, i, cell ) \ - \ - ( ( (SpiceInt *) (cell)->data)[i] = (item) ) - - - /* - The enum SpiceTransDir is used to indicate language translation - direction: C to Fortran or vice versa. - */ - enum _SpiceTransDir { C2F = 0, F2C = 1 }; - - typedef enum _SpiceTransDir SpiceTransDir; - - -#endif - diff --git a/ext/spice/include/SpiceEK.h b/ext/spice/include/SpiceEK.h deleted file mode 100644 index cbe213fb01..0000000000 --- a/ext/spice/include/SpiceEK.h +++ /dev/null @@ -1,448 +0,0 @@ -/* - --Header_File SpiceEK.h ( CSPICE EK-specific definitions ) - --Abstract - - Perform CSPICE EK-specific definitions, including macros and user- - defined types. - --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. - --Particulars - - This header defines macros, enumerated types, structures, and - typedefs that may be referenced in application code that calls CSPICE - EK functions. - - - Macros - ====== - - General limits - -------------- - - Name Description - ---- ---------- - SPICE_EK_MXCLSG Maximum number of columns per segment. - - SPICE_EK_TYPLEN Maximum length of a short string - indicating a data type (one of - {"CHR", "DP", "INT", "TIME"}). Such - strings are returned by some of the - Fortran SPICELIB EK routines, hence also - by their f2c'd counterparts. - - Sizes of EK objects - ------------------- - - Name Description - ---- ---------- - - SPICE_EK_CNAMSZ Maximum length of column name. - SPICE_EK_CSTRLN Length of string required to hold column - name. - SPICE_EK_TNAMSZ Maximum length of table name. - SPICE_EK_TSTRLN Length of string required to hold table - name. - - - Query-related limits - -------------------- - - Name Description - ---- ---------- - - SPICE_EK_MAXQRY Maximum length of an input query. This - value is currently equivalent to - twenty-five 80-character lines. - - SPICE_EK_MAXQSEL Maximum number of columns that may be - listed in the `SELECT clause' of a query. - - SPICE_EK_MAXQTAB Maximum number of tables that may be - listed in the `FROM clause' of a query. - - SPICE_EK_MAXQCON Maximum number of relational expressions - that may be listed in the `constraint - clause' of a query. - - This limit applies to a query when it is - represented in `normalized form': that - is, the constraints have been expressed - as a disjunction of conjunctions of - relational expressions. The number of - relational expressions in a query that - has been expanded in this fashion may be - greater than the number of relations in - the query as orginally written. For - example, the expression - - ( ( A LT 1 ) OR ( B GT 2 ) ) - AND - ( ( C NE 3 ) OR ( D EQ 4 ) ) - - which contains 4 relational expressions, - expands to the equivalent normalized - constraint - - ( ( A LT 1 ) AND ( C NE 3 ) ) - OR - ( ( A LT 1 ) AND ( D EQ 4 ) ) - OR - ( ( B GT 2 ) AND ( C NE 3 ) ) - OR - ( ( B GT 2 ) AND ( D EQ 4 ) ) - - which contains eight relational - expressions. - - - - SPICE_EK_MAXQJOIN Maximum number of tables that can be - joined. - - SPICE_EK_MAXQJCON Maximum number of join constraints - allowed. - - SPICE_EK_MAXQORD Maximum number of columns that may be - used in the `order-by clause' of a query. - - SPICE_EK_MAXQTOK Maximum number of tokens in a query. - Tokens - are reserved words, column names, - parentheses, and values. Literal strings - and time values count as single tokens. - - SPICE_EK_MAXQNUM Maximum number of numeric tokens in a - query. - - SPICE_EK_MAXQCLN Maximum total length of character tokens - in a query. - - SPICE_EK_MAXQSTR Maximum length of literal string values - allowed in queries. - - - Codes - ----- - - Name Description - ---- ---------- - - SPICE_EK_VARSIZ Code used to indicate variable-size - objects. Usually this is used in a - context where a non-negative integer - indicates the size of a fixed-size object - and the presence of this code indicates a - variable-size object. - - The value of this constant must match the - parameter IFALSE used in the Fortran - library SPICELIB. - - - Enumerated Types - ================ - - Enumerated code values - ---------------------- - - Name Description - ---- ---------- - SpiceEKDataType Codes for data types used in the EK - interface: character, double precision, - integer, and "time." - - The values are: - - { SPICE_CHR = 0, - SPICE_DP = 1, - SPICE_INT = 2, - SPICE_TIME = 3 } - - - - SpiceEKExprClass Codes for types of expressions that may - appear in the SELECT clause of EK - queries. Values and meanings are: - - - SPICE_EK_EXP_COL Selected item was a - column. The column - may qualified by a - table name. - - SPICE_EK_EXP_FUNC Selected item was - a simple function - invocation of the - form - - F ( ) - - or else was - - COUNT(*) - - SPICE_EK_EXP_EXPR Selected item was a - more general - expression than - those shown above. - - - Numeric values are: - - { SPICE_EK_EXP_COL = 0, - SPICE_EK_EXP_FUNC = 1, - SPICE_EK_EXP_EXPR = 2 } - - - Structures - ========== - - EK API structures - ----------------- - - Name Description - ---- ---------- - - SpiceEKAttDsc EK column attribute descriptor. Note - that this object is distinct from the EK - column descriptors used internally in - the EK routines; those descriptors - contain pointers as well as attribute - information. - - The members are: - - cclass: Column class code. - - dtype: Data type code: has type - SpiceEKDataType. - - strlen: String length. Applies to - SPICE_CHR type. Value is - SPICE_EK_VARSIZ for - variable-length strings. - - size: Column entry size; this is - the number of array - elements in a column - entry. The value is - SPICE_EK_VARSIZ for - variable-size columns. - - indexd: Index flag; value is - SPICETRUE if the column is - indexed, SPICEFALSE - otherwise. - - nullok: Null flag; value is - SPICETRUE if the column - may contain null values, - SPICEFALSE otherwise. - - - - SpiceEKSegSum EK segment summary. This structure - contains user interface level descriptive - information. The structure contains the - following members: - - tabnam The name of the table to - which the segment belongs. - - nrows The number of rows in the - segment. - - ncols The number of columns in - the segment. - - cnames An array of names of - columns in the segment. - Column names may contain - as many as SPICE_EK_CNAMSZ - characters. The array - contains room for - SPICE_EK_MXCLSG column - names. - - cdescrs An array of column - attribute descriptors of - type SpiceEKAttDsc. - The array contains room - for SPICE_EK_MXCLSG - descriptors. The Ith - descriptor corresponds to - the column whose name is - the Ith element of the - array cnames. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 2.0.0 27-JUL-2002 (NJB) - - Defined SpiceEKDataType using SpiceDataType. Removed declaration - of enum _SpiceEKDataType. - - -CSPICE Version 1.0.0, 05-JUL-1999 (NJB) - - Renamed _SpiceEKAttDsc member "class" to "cclass." The - former name is a reserved word in C++. - - - -CSPICE Version 1.0.0, 24-FEB-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_EK_H - - #define HAVE_SPICE_EK_H - - - - /* - Constants - */ - - /* - Sizes of EK objects: - */ - - #define SPICE_EK_CNAMSZ 32 - #define SPICE_EK_CSTRLN ( SPICE_EK_CNAMSZ + 1 ) - #define SPICE_EK_TNAMSZ 64 - #define SPICE_EK_TSTRLN ( SPICE_EK_TNAMSZ + 1 ) - - - - /* - Maximum number of columns per segment: - */ - - #define SPICE_EK_MXCLSG 100 - - - /* - Maximum length of string indicating data type: - */ - - #define SPICE_EK_TYPLEN 4 - - - /* - Query-related limits (see header for details): - */ - - #define SPICE_EK_MAXQRY 2000 - #define SPICE_EK_MAXQSEL 50 - #define SPICE_EK_MAXQTAB 10 - #define SPICE_EK_MAXQCON 1000 - #define SPICE_EK_MAXQJOIN 10 - #define SPICE_EK_MAXQJCON 100 - #define SPICE_EK_MAXQORD 10 - #define SPICE_EK_MAXQTOK 500 - #define SPICE_EK_MAXQNUM 100 - #define SPICE_EK_MAXQCLN SPICE_EK_MAXQRY - #define SPICE_EK_MAXQSTR 1024 - - - - /* - Code indicating "variable size": - */ - #define SPICE_EK_VARSIZ (-1) - - - - /* - Data type codes: - */ - typedef SpiceDataType SpiceEKDataType; - - - - /* - SELECT clause expression type codes: - */ - enum _SpiceEKExprClass{ SPICE_EK_EXP_COL = 0, - SPICE_EK_EXP_FUNC = 1, - SPICE_EK_EXP_EXPR = 2 }; - - typedef enum _SpiceEKExprClass SpiceEKExprClass; - - - - /* - EK column attribute descriptor: - */ - - struct _SpiceEKAttDsc - - { SpiceInt cclass; - SpiceEKDataType dtype; - SpiceInt strlen; - SpiceInt size; - SpiceBoolean indexd; - SpiceBoolean nullok; }; - - typedef struct _SpiceEKAttDsc SpiceEKAttDsc; - - - - /* - EK segment summary: - */ - - struct _SpiceEKSegSum - - { SpiceChar tabnam [SPICE_EK_TSTRLN]; - SpiceInt nrows; - SpiceInt ncols; - SpiceChar cnames [SPICE_EK_MXCLSG][SPICE_EK_CSTRLN]; - SpiceEKAttDsc cdescrs[SPICE_EK_MXCLSG]; }; - - typedef struct _SpiceEKSegSum SpiceEKSegSum; - - -#endif - diff --git a/ext/spice/include/SpiceEll.h b/ext/spice/include/SpiceEll.h deleted file mode 100644 index d0c123ab06..0000000000 --- a/ext/spice/include/SpiceEll.h +++ /dev/null @@ -1,115 +0,0 @@ -/* - --Header_File SpiceEll.h ( CSPICE Ellipse definitions ) - --Abstract - - Perform CSPICE definitions for the SpiceEllipse data type. - --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. - --Particulars - - This header defines structures and typedefs that may be referenced in - application code that calls CSPICE Ellipse functions. - - - Structures - ========== - - Name Description - ---- ---------- - - SpiceEllipse Structure representing an ellipse in 3- - dimensional space. - - The members are: - - center: Vector defining ellipse's - center. - - semiMajor: Vector defining ellipse's - semi-major axis. - - semiMinor: Vector defining ellipse's - semi-minor axis. - - The ellipse is the set of points - - {X: X = center - + cos(theta) * semiMajor - + sin(theta) * semiMinor, - - theta in [0, 2*Pi) } - - - ConstSpiceEllipse A const SpiceEllipse. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 04-MAR-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_ELLIPSES - - #define HAVE_SPICE_ELLIPSES - - - - /* - Ellipse structure: - */ - - struct _SpiceEllipse - - { SpiceDouble center [3]; - SpiceDouble semiMajor [3]; - SpiceDouble semiMinor [3]; }; - - typedef struct _SpiceEllipse SpiceEllipse; - - typedef const SpiceEllipse ConstSpiceEllipse; - -#endif - diff --git a/ext/spice/include/SpiceGF.h b/ext/spice/include/SpiceGF.h deleted file mode 100644 index 14d10de2fd..0000000000 --- a/ext/spice/include/SpiceGF.h +++ /dev/null @@ -1,319 +0,0 @@ -/* - --Header_File SpiceGF.h ( CSPICE GF-specific definitions ) - --Abstract - - Perform CSPICE GF-specific definitions. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - --Exceptions - - None - --Files - - None - --Particulars - - This header defines macros that may be referenced in application - code that calls CSPICE GF functions. - - - Macros - ====== - - Workspace parameters - -------------------- - - CSPICE applications normally don't declare workspace arguments - and therefore don't directly reference workspace size parameters. - However, CSPICE GF APIs dealing with numeric constraints - dynamically allocate workspace memory; the amount allocated - depends on the number of intervals the workspace windows can - hold. This amount is an input argument to the GF numeric quantity - APIs. - - The parameters below are used to calculate the amount of memory - required. Each workspace window contains 6 double precision - numbers in its control area and 2 double precision numbers for - each interval it can hold. - - - Name Description - ---- ---------- - SPICE_GF_NWMAX Maximum number of windows required for - a user-defined workspace array. - - SPICE_GF_NWDIST Number of workspace windows used by - gfdist_c and the underlying SPICELIB - routine GFDIST. - - SPICE_GF_NWSEP Number of workspace windows used by - gfsep_c and the underlying SPICELIB - routine GFSEP. - - - - Field of view (FOV) parameters - ------------------------------ - - Name Description - ---- ---------- - SPICE_GF_MAXVRT Maximum allowed number of boundary - vectors for a polygonal FOV. - - SPICE_GF_CIRFOV Parameter identifying a circular FOV. - - SPICE_GF_ELLFOV Parameter identifying a elliptical FOV. - - SPICE_GF_POLFOV Parameter identifying a polygonal FOV. - - SPICE_GF_RECFOV Parameter identifying a rectangular FOV. - - SPICE_GF_SHPLEN Parameter specifying maximum length of - a FOV shape name. - - SPICE_GF_MARGIN is a small positive number used to - constrain the orientation of the - boundary vectors of polygonal FOVs. Such - FOVs must satisfy the following - constraints: - - 1) The boundary vectors must be - contained within a right circular - cone of angular radius less than - than (pi/2) - MARGIN radians; in - other words, there must be a vector - A such that all boundary vectors - have angular separation from A of - less than (pi/2)-MARGIN radians. - - 2) There must be a pair of boundary - vectors U, V such that all other - boundary vectors lie in the same - half space bounded by the plane - containing U and V. Furthermore, all - other boundary vectors must have - orthogonal projections onto a plane - normal to this plane such that the - projections have angular separation - of at least 2*MARGIN radians from - the plane spanned by U and V. - - MARGIN is currently set to 1.D-12. - - - Occultation parameters - ---------------------- - - SPICE_GF_ANNULR Parameter identifying an "annular - occultation." This geometric condition - is more commonly known as a "transit." - The limb of the background object must - not be blocked by the foreground object - in order for an occultation to be - "annular." - - SPICE_GF_ANY Parameter identifying any type of - occultation or transit. - - SPICE_GF_FULL Parameter identifying a full - occultation: the foreground body - entirely blocks the background body. - - SPICE_GF_PARTL Parameter identifying an "partial - occultation." This is an occultation in - which the foreground body blocks part, - but not all, of the limb of the - background body. - - - - Target shape parameters - ----------------------- - - SPICE_GF_EDSHAP Parameter indicating a target object's - shape is modeled as an ellipsoid. - - SPICE_GF_PTSHAP Parameter indicating a target object's - shape is modeled as a point. - - SPICE_GF_RYSHAP Parameter indicating a target object's - "shape" is modeled as a ray emanating - from an observer's location. This model - may be used in visibility computations - for targets whose direction, but not - position, relative to an observer is - known. - - SPICE_GF_SPSHAP Parameter indicating a target object's - shape is modeled as a point. - - - - Search parameters - ----------------- - - These parameters affect the manner in which GF searches are - performed. - - SPICE_GF_ADDWIN is a parameter used in numeric quantity - searches that use an equality - constraint. This parameter is used to - expand the confinement window (the - window over which the search is - performed) by a small amount at both - ends. This expansion accommodates the - case where a geometric quantity is equal - to a reference value at a boundary point - of the original confinement window. - - SPICE_GF_CNVTOL is the default convergence tolerance - used by GF routines that don't support a - user-supplied tolerance value. GF - searches for roots will terminate when a - root is bracketed by times separated by - no more than this tolerance. Units are - seconds. - - Configuration parameter - ----------------------- - - SPICE_GFEVNT_MAXPAR Parameter indicating the maximum number of - elements needed for the 'qnames' and 'q*pars' - arrays used in gfevnt_c. - - SpiceChar qcpars[SPICE_GFEVNT_MAXPAR][LNSIZE]; - SpiceDouble qdpars[SPICE_GFEVNT_MAXPAR]; - SpiceInt qipars[SPICE_GFEVNT_MAXPAR]; - SpiceBoolean qlpars[SPICE_GFEVNT_MAXPAR]; - --Examples - - None - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - --Version - - -CSPICE Version 2.0.0, 23-JUN-2009 (NJB) - - Added parameter for maximum length of FOV shape string. - - -CSPICE Version 1.0.0, 11-MAR-2009 (NJB) - -*/ - - -#ifndef HAVE_SPICE_GF_H - - #define HAVE_SPICE_GF_H - - - /* - See the Particulars section above for parameter descriptions. - */ - - /* - Workspace parameters - */ - #define SPICE_GF_NWMAX 15 - #define SPICE_GF_NWDIST 5 - #define SPICE_GF_NWSEP 5 - - - /* - Field of view (FOV) parameters - */ - #define SPICE_GF_MAXVRT 10000 - #define SPICE_GF_CIRFOV "CIRCLE" - #define SPICE_GF_ELLFOV "ELLIPSE" - #define SPICE_GF_POLFOV "POLYGON" - #define SPICE_GF_RECFOV "RECTANGLE" - #define SPICE_GF_SHPLEN 10 - #define SPICE_GF_MARGIN ( 1.e-12 ) - - - /* - Occultation parameters - */ - #define SPICE_GF_ANNULR "ANNULAR" - #define SPICE_GF_ANY "ANY" - #define SPICE_GF_FULL "FULL" - #define SPICE_GF_PARTL "PARTIAL" - - - /* - Target shape parameters - */ - #define SPICE_GF_EDSHAP "ELLIPSOID" - #define SPICE_GF_PTSHAP "POINT" - #define SPICE_GF_RYSHAP "RAY" - #define SPICE_GF_SPSHAP "SPHERE" - - - /* - Search parameters - */ - #define SPICE_GF_ADDWIN 1.0 - #define SPICE_GF_CNVTOL 1.e-6 - - - /* - Configuration parameters. - */ - #define SPICE_GFEVNT_MAXPAR 10 - - -#endif - - -/* - End of header file SpiceGF.h -*/ diff --git a/ext/spice/include/SpicePln.h b/ext/spice/include/SpicePln.h deleted file mode 100644 index 839fb15606..0000000000 --- a/ext/spice/include/SpicePln.h +++ /dev/null @@ -1,106 +0,0 @@ -/* - --Header_File SpicePln.h ( CSPICE Plane definitions ) - --Abstract - - Perform CSPICE definitions for the SpicePlane data type. - --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. - --Particulars - - This header defines structures and typedefs that may be referenced in - application code that calls CSPICE Plane functions. - - - Structures - ========== - - Name Description - ---- ---------- - - SpicePlane Structure representing a plane in 3- - dimensional space. - - The members are: - - normal: Vector normal to plane. - - constant: Constant of plane equation - - Plane = - - {X: = constant} - - - - ConstSpicePlane A const SpicePlane. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 04-MAR-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_PLANES - - #define HAVE_SPICE_PLANES - - - - /* - Plane structure: - */ - - struct _SpicePlane - - { SpiceDouble normal [3]; - SpiceDouble constant; }; - - typedef struct _SpicePlane SpicePlane; - - typedef const SpicePlane ConstSpicePlane; - -#endif - diff --git a/ext/spice/include/SpiceSPK.h b/ext/spice/include/SpiceSPK.h deleted file mode 100644 index a4c8eac5f7..0000000000 --- a/ext/spice/include/SpiceSPK.h +++ /dev/null @@ -1,128 +0,0 @@ -/* - --Header_File SpiceSPK.h ( CSPICE SPK definitions ) - --Abstract - - Perform CSPICE definitions to support SPK wrapper interfaces. - --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. - --Particulars - - This header defines types that may be referenced in - application code that calls CSPICE SPK functions. - - Typedef - ======= - - Name Description - ---- ---------- - - SpiceSPK18Subtype Typedef for enum indicating the - mathematical representation used - in an SPK type 18 segment. Possible - values and meanings are: - - S18TP0: - - Hermite interpolation, 12- - element packets containing - - x, y, z, dx/dt, dy/dt, dz/dt, - vx, vy, vz, dvx/dt, dvy/dt, dvz/dt - - where x, y, z represent Cartesian - position components and vx, vy, vz - represent Cartesian velocity - components. Note well: vx, vy, and - vz *are not necessarily equal* to the - time derivatives of x, y, and z. - This packet structure mimics that of - the Rosetta/MEX orbit file from which - the data are taken. - - Position units are kilometers, - velocity units are kilometers per - second, and acceleration units are - kilometers per second per second. - - - S18TP1: - - Lagrange interpolation, 6- - element packets containing - - x, y, z, dx/dt, dy/dt, dz/dt - - where x, y, z represent Cartesian - position components and vx, vy, vz - represent Cartesian velocity - components. - - Position units are kilometers; - velocity units are kilometers per - second. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 16-AUG-2002 (NJB) - -*/ - -#ifndef HAVE_SPICE_SPK_H - - #define HAVE_SPICE_SPK_H - - - - /* - SPK type 18 subtype codes: - */ - - enum _SpiceSPK18Subtype { S18TP0, S18TP1 }; - - - typedef enum _SpiceSPK18Subtype SpiceSPK18Subtype; - -#endif - diff --git a/ext/spice/include/SpiceUsr.h b/ext/spice/include/SpiceUsr.h deleted file mode 100644 index 83038e32a3..0000000000 --- a/ext/spice/include/SpiceUsr.h +++ /dev/null @@ -1,217 +0,0 @@ -/* - --Header_File SpiceUsr.h ( CSPICE user interface definitions ) - --Abstract - - Perform CSPICE user interface declarations, including type - definitions and function prototype declarations. - --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. - --Particulars - - This file is an umbrella header that includes all header files - required to support the CSPICE application programming interface - (API). Users' application code that calls CSPICE need include only - this single header file. This file includes function prototypes for - the entire set of CSPICE routines. Typedef statements used to create - SPICE data types are also included. - - - About SPICE data types - ====================== - - To assist with long-term maintainability of CSPICE, NAIF has elected - to use typedefs to represent data types occurring in argument lists - and as return values of CSPICE functions. These are: - - SpiceBoolean - SpiceChar - SpiceDouble - SpiceInt - ConstSpiceBoolean - ConstSpiceChar - ConstSpiceDouble - ConstSpiceInt - - The SPICE typedefs map in an arguably natural way to ANSI C types: - - SpiceBoolean -> enum { SPICEFALSE = 0, SPICETRUE = 1 } - SpiceChar -> char - SpiceDouble -> double - SpiceInt -> int or long - ConstX -> const X (X = any of the above types) - - The type SpiceInt is a special case: the corresponding type is picked - so as to be half the size of a double. On all currently supported - platforms, type double occupies 8 bytes and type int occupies 4 - bytes. Other platforms may require a SpiceInt to map to type long. - - While other data types may be used internally in CSPICE, no other - types appear in the API. - - - About CSPICE function prototypes - ================================ - - Because CSPICE function prototypes enable substantial - compile-time error checking, we recommend that user - applications always reference them. Including the header - file SpiceUsr.h in any module that calls CSPICE will - automatically make the prototypes available. - - - About CSPICE C style - ==================== - - CSPICE is written in ANSI C. No attempt has been made to support K&R - conventions or restrictions. - - - About C++ compatibility - ======================= - - The preprocessor directive -D__cplusplus should be used when - compiling C++ source code that includes this header file. This - directive will suppress mangling of CSPICE names, permitting linkage - to a CSPICE object library built from object modules produced by - an ANSI C compiler. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Restrictions - - The #include statements contained in this file are not part of - the CSPICE API. The set of files included may change without notice. - Users should not include these files directly in their own - application code. - --Version - - -CSPICE Version 4.0.0, 30-SEP-2008 (NJB) - - Updated to include header file - - SpiceGF.h - - -CSPICE Version 3.0.0, 19-AUG-2002 (NJB) - - Updated to include header files - - SpiceCel.h - SpiceCK.h - SpiceSPK.h - - -CSPICE Version 3.0.0, 17-FEB-1999 (NJB) - - Updated to support suppression of name mangling when included in - C++ source code. Also now interface macros to intercept function - calls and perform automatic type casting. - - Now includes platform macro definition header file. - - References to types SpiceVoid and ConstSpiceVoid were removed. - - -CSPICE Version 2.0.0, 06-MAY-1998 (NJB) (EDW) - -*/ - -#ifdef __cplusplus - extern "C" { -#endif - - -#ifndef HAVE_SPICE_USER - - #define HAVE_SPICE_USER - - - /* - Include CSPICE platform macro definitions. - */ - #include "SpiceZpl.h" - - /* - Include CSPICE data type definitions. - */ - #include "SpiceZdf.h" - - /* - Include the CSPICE EK interface definitions. - */ - #include "SpiceEK.h" - - /* - Include the CSPICE Cell interface definitions. - */ - #include "SpiceCel.h" - - /* - Include the CSPICE CK interface definitions. - */ - #include "SpiceCK.h" - - /* - Include the CSPICE SPK interface definitions. - */ - #include "SpiceSPK.h" - - /* - Include the CSPICE GF interface definitions. - */ - #include "SpiceGF.h" - - /* - Include CSPICE prototypes. - */ - #include "SpiceZpr.h" - - /* - Define the CSPICE function interface macros. - */ - #include "SpiceZim.h" - - - -#endif - - -#ifdef __cplusplus - } -#endif - diff --git a/ext/spice/include/SpiceZad.h b/ext/spice/include/SpiceZad.h deleted file mode 100644 index f838e7f31c..0000000000 --- a/ext/spice/include/SpiceZad.h +++ /dev/null @@ -1,205 +0,0 @@ -/* - --Header_File SpiceZad.h ( CSPICE adapter definitions ) - --Abstract - - Perform CSPICE declarations to support passed-in function - adapters used in wrapper interfaces. - --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. - --Particulars - - This header file contains declarations used by the CSPICE - passed-in function adapter ("PFA") system. This system enables - CSPICE wrapper functions to support passed-in function - arguments whose prototypes are C-style, even when these - functions are to be called from f2c'd Fortran routines - expecting f2c-style interfaces. - - This header declares: - - - The prototype for the passed-in function argument - pointer storage and fetch routines - - zzadsave_c - zzadget_c - - - Prototypes for CSPICE adapter functions. Each passed-in - function argument in a CSPICE wrapper has a corresponding - adapter function. The adapter functions have interfaces - that match those of their f2c'd counterparts; this allows - the adapters to be called by f2c'd SPICELIB code. The - adapters look up saved function pointers for routines - passed in by the wrapper's caller and call these functions. - - - Values for the enumerated type SpicePassedInFunc. These - values are used to map function pointers to the - functions they represent, enabling adapters to call - the correct passed-in functions. - -Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 2.1.0, 21-DEC-2009 (EDW) - - Updated to support the user defined scalar function capability. - - -CSPICE Version 2.0.0, 29-JAN-2009 (NJB) - - Now conditionally includes SpiceZfc.h. - - Updated to reflect new calling sequence of f2c'd - routine gfrefn_. Some header updates were made - as well. - - -CSPICE Version 1.0.0, 29-MAR-2008 (NJB) - -*/ - - -/* - This file has dependencies defined in SpiceZfc.h. Include that - file if it hasn't already been included. -*/ -#ifndef HAVE_SPICEF2C_H - #include "SpiceZfc.h" -#endif - - - -#ifndef HAVE_SPICE_ZAD_H - - #define HAVE_SPICE_ZAD_H - - - - /* - Prototypes for GF adapters: - */ - - logical zzadbail_c ( void ); - - - int zzadstep_c ( doublereal * et, - doublereal * step ); - - - int zzadrefn_c ( doublereal * t1, - doublereal * t2, - logical * s1, - logical * s2, - doublereal * t ); - - - int zzadrepf_c ( void ); - - - int zzadrepi_c ( doublereal * cnfine, - char * srcpre, - char * srcsuf, - ftnlen srcprelen, - ftnlen srcsuflen ); - - - int zzadrepu_c ( doublereal * ivbeg, - doublereal * ivend, - doublereal * et ); - - - int zzadfunc_c ( doublereal * et, - doublereal * value ); - - - int zzadqdec_c ( U_fp udfunc, - doublereal * et, - logical * xbool ); - - /* - Define the enumerated type - - SpicePassedInFunc - - for names of passed-in functions. Using this type gives - us compile-time checking and avoids string comparisons. - */ - enum _SpicePassedInFunc { - UDBAIL, - UDREFN, - UDREPF, - UDREPI, - UDREPU, - UDSTEP, - UDFUNC, - UDQDEC, - }; - - typedef enum _SpicePassedInFunc SpicePassedInFunc; - - /* - SPICE_N_PASSED_IN_FUNC is the count of SpicePassedInFunc values. - */ - #define SPICE_N_PASSED_IN_FUNC 8 - - - /* - CSPICE wrappers supporting passed-in function arguments call - the adapter setup interface function once per each such argument; - these calls save the function pointers for later use within the - f2c'd code that calls passed-in functions. The saved pointers - will be used in calls by the adapter functions whose prototypes - are declared above. - - Prototypes for adapter setup interface: - */ - void zzadsave_c ( SpicePassedInFunc functionID, - void * functionPtr ); - - void * zzadget_c ( SpicePassedInFunc functionID ); - - -#endif - -/* -End of header file SpiceZad.h -*/ - diff --git a/ext/spice/include/SpiceZdf.h b/ext/spice/include/SpiceZdf.h deleted file mode 100644 index 36276051d6..0000000000 --- a/ext/spice/include/SpiceZdf.h +++ /dev/null @@ -1,246 +0,0 @@ -/* - --Header_File SpiceZdf.h ( CSPICE definitions ) - --Abstract - - Define CSPICE data types via typedefs; also define some user-visible - enumerated types. - --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. - --Particulars - - CSPICE data types - ================= - - To assist with long-term maintainability of CSPICE, NAIF has elected - to use typedefs to represent data types occurring in argument lists - and as return values of CSPICE functions. These are: - - SpiceBoolean - SpiceChar - SpiceDouble - SpiceInt - ConstSpiceBoolean - ConstSpiceChar - ConstSpiceDouble - ConstSpiceInt - - The SPICE typedefs map in an arguably natural way to ANSI C types: - - SpiceBoolean -> int - SpiceChar -> char - SpiceDouble -> double - SpiceInt -> int or long - ConstX -> const X (X = any of the above types) - - The type SpiceInt is a special case: the corresponding type is picked - so as to be half the size of a double. On most currently supported - platforms, type double occupies 8 bytes and type long occupies 4 - bytes. Other platforms may require a SpiceInt to map to type int. - The Alpha/Digital Unix platform is an example of the latter case. - - While other data types may be used internally in CSPICE, no other - types appear in the API. - - - CSPICE enumerated types - ======================= - - These are provided to enhance readability of the code. - - Type name Value set - --------- --------- - - _Spicestatus { SPICEFAILURE = -1, SPICESUCCESS = 0 } - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 6.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 6.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 5.0.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 4.0.0 27-JUL-2002 (NJB) - - Added definition of SpiceDataType. - - -CSPICE Version 3.0.0 18-SEP-1999 (NJB) - - SpiceBoolean implementation changed from enumerated type to - typedef mapping to int. - - -CSPICE Version 2.0.0 29-JAN-1999 (NJB) - - Made definition of SpiceInt and ConstSpiceInt platform - dependent to accommodate the Alpha/Digital Unix platform. - - Removed definitions of SpiceVoid and ConstSpiceVoid. - - -CSPICE Version 1.0.0 25-OCT-1997 (KRG) (NJB) (EDW) -*/ - - #ifndef HAVE_SPICEDEFS_H - #define HAVE_SPICEDEFS_H - - /* - Include platform definitions, if they haven't been executed already. - */ - #ifndef HAVE_PLATFORM_MACROS_H - #include "SpiceZpl.h" - #endif - - /* - Basic data types. These are defined to be compatible with the - types used by f2c, and so they follow the Fortran notion of what - these things are. See the f2c documentation for the details - about the choices for the sizes of these types. - */ - typedef char SpiceChar; - typedef double SpiceDouble; - typedef float SpiceFloat; - - - - #if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - typedef int SpiceInt; - #else - typedef long SpiceInt; - #endif - - - typedef const char ConstSpiceChar; - typedef const double ConstSpiceDouble; - typedef const float ConstSpiceFloat; - - - #if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - typedef const int ConstSpiceInt; - #else - typedef const long ConstSpiceInt; - #endif - - - /* - More basic data types. These give mnemonics for some other data - types in C that are not used in Fortran written by NAIF or - supported by ANSI Fortran 77. These are for use in C functions - but should not be passed to any C SPICE wrappers, ``*_c.c'' - since they are not Fortran compatible. - */ - typedef long SpiceLong; - typedef short SpiceShort; - - /* - Unsigned data types - */ - typedef unsigned char SpiceUChar; - typedef unsigned int SpiceUInt; - typedef unsigned long SpiceULong; - typedef unsigned short SpiceUShort; - - /* - Signed data types - */ - typedef signed char SpiceSChar; - - /* - Other basic types - */ - typedef int SpiceBoolean; - typedef const int ConstSpiceBoolean; - - #define SPICETRUE 1 - #define SPICEFALSE 0 - - - enum _Spicestatus { SPICEFAILURE = -1, SPICESUCCESS = 0 }; - - typedef enum _Spicestatus SpiceStatus; - - - enum _SpiceDataType { SPICE_CHR = 0, - SPICE_DP = 1, - SPICE_INT = 2, - SPICE_TIME = 3, - SPICE_BOOL = 4 }; - - - typedef enum _SpiceDataType SpiceDataType; - - -#endif diff --git a/ext/spice/include/SpiceZfc.h b/ext/spice/include/SpiceZfc.h deleted file mode 100644 index 33f541770b..0000000000 --- a/ext/spice/include/SpiceZfc.h +++ /dev/null @@ -1,13228 +0,0 @@ -/* - --Header_File SpiceZfc.h ( f2c'd SPICELIB prototypes ) - --Abstract - - Define prototypes for functions produced by converting Fortran - SPICELIB routines to C using f2c. - --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. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - - CSPICE Version 6.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - - CSPICE Version 6.0.0, 21-FEB-2006 (NJB) - - Added typedefs for the PC-LINUX-64BIT-GCC_C - environment (these are identical to those for the - ALPHA-DIGITAL-UNIX_C environment). - - - C-SPICELIB Version 5.0.0, 06-MAR-2005 (NJB) - - Added typedefs for pointers to functions. This change was - made to support CSPICE wrappers for geometry finder routines. - - Added typedefs for the SUN-SOLARIS-64BIT-GCC_C - environment (these are identical to those for the - ALPHA-DIGITAL-UNIX_C environment). - - - C-SPICELIB Version 4.1.0, 24-MAY-2001 (WLT) - - Moved the #ifdef __cplusplus so that it appears after the - typedefs. This allows us to more easily wrap CSPICE in a - namespace for C++. - - - C-SPICELIB Version 4.0.0, 09-FEB-1999 (NJB) - - Updated to accommodate the Alpha/Digital Unix platform. - Also updated to support inclusion in C++ code. - - - C-SPICELIB Version 3.0.0, 02-NOV-1998 (NJB) - - Updated for SPICELIB version N0049. - - - C-SPICELIB Version 2.0.0, 15-SEP-1997 (NJB) - - Changed variable name "typid" to "typid" in prototype - for zzfdat_. This was done to enable compilation under - Borland C++. - - - C-SPICELIB Version 1.0.0, 15-SEP-1997 (NJB) (KRG) - --Index_Entries - - prototypes of f2c'd SPICELIB functions - -*/ - - -#ifndef HAVE_SPICEF2C_H -#define HAVE_SPICEF2C_H - - - -/* - Include Files: - - Many of the prototypes below use data types defined by f2c. We - copy here the f2c definitions that occur in prototypes of functions - produced by running f2c on Fortran SPICELIB routines. - - The reason we don't simply conditionally include f2c.h itself here - is that f2c.h defines macros that conflict with stdlib.h on some - systems. It's simpler to just replicate the few typedefs we need. -*/ - -#if ( defined( CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined( CSPICE_PC_LINUX_64BIT_GCC ) \ - || defined( CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined( CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined( CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined( CSPICE_SUN_SOLARIS_64BIT_GCC ) ) - - #define VOID void - - typedef VOID H_f; - typedef int integer; - typedef double doublereal; - typedef int logical; - typedef int ftnlen; - - - /* - Type H_fp is used for character return type. - Type S_fp is used for subroutines. - Type U_fp is used for functions of unknown type. - */ - typedef VOID (*H_fp)(); - typedef doublereal (*D_fp)(); - typedef doublereal (*E_fp)(); - typedef int (*S_fp)(); - typedef int (*U_fp)(); - typedef integer (*I_fp)(); - typedef logical (*L_fp)(); - -#else - - #define VOID void - - typedef VOID H_f; - typedef long integer; - typedef double doublereal; - typedef long logical; - typedef long ftnlen; - - /* - Type H_fp is used for character return type. - Type S_fp is used for subroutines. - Type U_fp is used for functions of unknown type. - */ - typedef VOID (*H_fp)(); - typedef doublereal (*D_fp)(); - typedef doublereal (*E_fp)(); - typedef int (*S_fp)(); - typedef int (*U_fp)(); - typedef integer (*I_fp)(); - typedef logical (*L_fp)(); - -#endif - - -#ifdef __cplusplus - extern "C" { -#endif - - -/* - Function prototypes for functions created by f2c are listed below. - See the headers of the Fortran routines for descriptions of the - routines' interfaces. - - The functions listed below are those expected to be called by - C-SPICELIB wrappers. Prototypes are not currently provided for other - f2c'd functions. - -*/ - -/* --Prototypes -*/ - -extern logical accept_(logical *ok); -extern logical allowd_(void); - -extern logical alltru_(logical *logcls, integer *n); - -extern H_f ana_(char *ret_val, ftnlen ret_val_len, char *word, char *case__, ftnlen word_len, ftnlen case_len); -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: replch_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int appndc_(char *item, char *cell, ftnlen item_len, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int appndd_(doublereal *item, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int appndi_(integer *item, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical approx_(doublereal *x, doublereal *y, doublereal *tol); - -extern int astrip_(char *instr, char *asciib, char *asciie, char *outstr, ftnlen instr_len, ftnlen asciib_len, ftnlen asciie_len, ftnlen outstr_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern int axisar_(doublereal *axis, doublereal *angle, doublereal *r__); -/*:ref: ident_ 14 1 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern doublereal b1900_(void); - -extern doublereal b1950_(void); - -extern logical badkpv_(char *caller, char *name__, char *comp, integer *size, integer *divby, char *type__, ftnlen caller_len, ftnlen name_len, ftnlen comp_len, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ - -extern logical bedec_(char *string, ftnlen string_len); -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: beuns_ 12 2 13 124 */ - -extern logical beint_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: beuns_ 12 2 13 124 */ - -extern logical benum_(char *string, ftnlen string_len); -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: bedec_ 12 2 13 124 */ -/*:ref: beint_ 12 2 13 124 */ - -extern logical beuns_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ - -extern int bodc2n_(integer *code, char *name__, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodc2n_ 14 4 4 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodc2s_(integer *code, char *name__, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodc2n_ 14 4 4 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int boddef_(char *name__, integer *code, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzboddef_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodeul_(integer *body, doublereal *et, doublereal *ra, doublereal *dec, doublereal *w, doublereal *lambda); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckeul_ 14 6 4 7 12 13 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: m2eul_ 14 7 7 4 4 4 7 7 7 */ - -extern logical bodfnd_(integer *body, char *item, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodmat_(integer *body, doublereal *et, doublereal *tipm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckmat_ 14 5 4 7 4 7 12 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: ccifrm_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int bodn2c_(char *name__, integer *code, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bods2c_(char *name__, integer *code, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodvar_(integer *body, char *item, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: rtpool_ 14 5 13 4 7 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodvcd_(integer *bodyid, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int bodvrd_(char *bodynm, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen bodynm_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern doublereal brcktd_(doublereal *number, doublereal *end1, doublereal *end2); - -extern integer brckti_(integer *number, integer *end1, integer *end2); - -extern integer bschoc_(char *value, integer *ndim, char *array, integer *order, ftnlen value_len, ftnlen array_len); - -extern integer bschoi_(integer *value, integer *ndim, integer *array, integer *order); - -extern integer bsrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern integer bsrchd_(doublereal *value, integer *ndim, doublereal *array); - -extern integer bsrchi_(integer *value, integer *ndim, integer *array); - -extern integer cardc_(char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer cardd_(doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer cardi_(integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cgv2el_(doublereal *center, doublereal *vec1, doublereal *vec2, doublereal *ellips); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer chbase_(void); - -extern int chbder_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, integer *nderiv, doublereal *partdp, doublereal *dpdxs); - -extern int chbint_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, doublereal *p, doublereal *dpdx); - -extern int chbval_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, doublereal *p); - -extern int chckid_(char *class__, integer *maxlen, char *id, ftnlen class_len, ftnlen id_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int chgirf_(integer *refa, integer *refb, doublereal *rotab, char *name__, integer *index, ftnlen name_len); -extern int irfrot_(integer *refa, integer *refb, doublereal *rotab); -extern int irfnum_(char *name__, integer *index, ftnlen name_len); -extern int irfnam_(integer *index, char *name__, ftnlen name_len); -extern int irfdef_(integer *index); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rotate_ 14 3 7 4 7 */ -/*:ref: wdcnt_ 4 2 13 124 */ -/*:ref: nthwd_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: rotmat_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: esrchc_ 4 5 13 4 13 124 124 */ - -extern int ckbsr_(char *fname, integer *handle, integer *inst, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *descr, char *segid, logical *found, ftnlen fname_len, ftnlen segid_len); -extern int cklpf_(char *fname, integer *handle, ftnlen fname_len); -extern int ckupf_(integer *handle); -extern int ckbss_(integer *inst, doublereal *sclkdp, doublereal *tol, logical *needav); -extern int cksns_(integer *handle, doublereal *descr, char *segid, logical *found, ftnlen segid_len); -extern int ckhave_(logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ - -extern int ckcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int ckcov_(char *ck, integer *idcode, logical *needav, char *level, doublereal *tol, char *timsys, doublereal *cover, ftnlen ck_len, ftnlen level_len, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: zzckcv01_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv02_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv03_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv04_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv05_ 14 9 4 4 4 4 7 7 13 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int cke01_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cke02_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequg_ 14 3 7 4 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: axisar_ 14 3 7 7 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cke03_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mtxm_ 14 3 7 7 7 */ -/*:ref: raxisa_ 14 3 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: axisar_ 14 3 7 7 7 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int cke04_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ - -extern int cke05_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: vdistg_ 7 3 7 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpsgip_ 14 3 4 4 7 */ -/*:ref: lgrind_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: qdq2av_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: q2m_ 14 2 7 7 */ - -extern int ckfrot_(integer *inst, doublereal *et, doublereal *rotate, integer *ref, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ckhave_ 14 1 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ -/*:ref: sce2c_ 14 3 4 7 7 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int ckfxfm_(integer *inst, doublereal *et, doublereal *xform, integer *ref, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: ckhave_ 14 1 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ -/*:ref: sce2c_ 14 3 4 7 7 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: rav2xf_ 14 3 7 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol, char *ref, doublereal *cmat, doublereal *clkout, logical *found, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckgpav_(integer *inst, doublereal *sclkdp, doublereal *tol, char *ref, doublereal *cmat, doublereal *av, doublereal *clkout, logical *found, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: xf2rav_ 14 3 7 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int ckgr01_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckgr02_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr02_ 14 3 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckgr03_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckgr04_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: zzck4d2i_ 14 4 7 4 7 4 */ - -extern int ckgr05_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckmeta_(integer *ckid, char *meta, integer *idcode, ftnlen meta_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int cknr01_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int cknr02_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cknr03_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int cknr04_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ - -extern int cknr05_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckobj_(char *ck, integer *ids, ftnlen ck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int ckopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ckpfs_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *cmat, doublereal *av, doublereal *clkout, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: ckr01_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke01_ 14 5 12 7 7 7 7 */ -/*:ref: ckr02_ 14 6 4 7 7 7 7 12 */ -/*:ref: cke02_ 14 5 12 7 7 7 7 */ -/*:ref: ckr03_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke03_ 14 5 12 7 7 7 7 */ -/*:ref: ckr04_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke04_ 14 5 12 7 7 7 7 */ -/*:ref: ckr05_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke05_ 14 5 12 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ckr01_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: lstcld_ 4 3 7 4 7 */ - -extern int ckr02_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: vequg_ 14 3 7 4 7 */ - -extern int ckr03_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dpmax_ 7 0 */ - -extern int ckr04_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: zzck4d2i_ 14 4 7 4 7 4 */ - -extern int ckr05_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckw01_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw02_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, char *segid, integer *nrec, doublereal *start, doublereal *stop, doublereal *quats, doublereal *avvs, doublereal *rates, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw03_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw04a_(integer *handle, integer *npkts, integer *pktsiz, doublereal *pktdat, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzck4i2d_ 14 4 4 4 7 7 */ -/*:ref: sgwvpk_ 14 6 4 4 4 7 4 7 */ - -extern int ckw04b_(integer *handle, doublereal *begtim, integer *inst, char *ref, logical *avflag, char *segid, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: sgbwvs_ 14 7 4 7 13 4 7 4 124 */ - -extern int ckw04e_(integer *handle, doublereal *endtim); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafrs_ 14 1 7 */ - -extern int ckw05_(integer *handle, integer *subtyp, integer *degree, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *n, doublereal *sclkdp, doublereal *packts, doublereal *rate, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int clearc_(integer *ndim, char *array, ftnlen array_len); - -extern int cleard_(integer *ndim, doublereal *array); - -extern int cleari_(integer *ndim, integer *array); - -extern doublereal clight_(void); - -extern int cmprss_(char *delim, integer *n, char *input, char *output, ftnlen delim_len, ftnlen input_len, ftnlen output_len); - -extern int conics_(doublereal *elts, doublereal *et, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ - -extern int convrt_(doublereal *x, char *in, char *out, doublereal *y, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpr_ 7 0 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int copyc_(char *cell, char *copy, ftnlen cell_len, ftnlen copy_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int copyd_(doublereal *cell, doublereal *copy); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int copyi_(integer *cell, integer *copy); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer countc_(integer *unit, integer *bline, integer *eline, char *line, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: astrip_ 14 8 13 13 13 13 124 124 124 124 */ - -extern integer cpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern integer cposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern int cyacip_(integer *nelt, char *dir, integer *ncycle, char *array, ftnlen dir_len, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: nbwid_ 4 3 13 4 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyadip_(integer *nelt, char *dir, integer *ncycle, doublereal *array, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyaiip_(integer *nelt, char *dir, integer *ncycle, integer *array, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclac_(char *array, integer *nelt, char *dir, integer *ncycle, char *out, ftnlen array_len, ftnlen dir_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: nbwid_ 4 3 13 4 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclad_(doublereal *array, integer *nelt, char *dir, integer *ncycle, doublereal *out, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclai_(integer *array, integer *nelt, char *dir, integer *ncycle, integer *out, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclec_(char *instr, char *dir, integer *ncycle, char *outstr, ftnlen instr_len, ftnlen dir_len, ftnlen outstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyllat_(doublereal *r__, doublereal *longc, doublereal *z__, doublereal *radius, doublereal *long__, doublereal *lat); - -extern int cylrec_(doublereal *r__, doublereal *long__, doublereal *z__, doublereal *rectan); - -extern int cylsph_(doublereal *r__, doublereal *longc, doublereal *z__, doublereal *radius, doublereal *colat, doublereal *long__); - -extern doublereal dacosh_(doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal dacosn_(doublereal *arg, doublereal *tol); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafa2b_(char *ascii, char *binary, integer *resv, ftnlen ascii_len, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daft2b_ 14 4 4 13 4 124 */ - -extern int dafac_(integer *handle, integer *n, char *buffer, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ -/*:ref: dafarr_ 14 2 4 4 */ - -extern int dafah_(char *fname, char *ftype, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, integer *unit, integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len); -extern int dafopr_(char *fname, integer *handle, ftnlen fname_len); -extern int dafopw_(char *fname, integer *handle, ftnlen fname_len); -extern int dafonw_(char *fname, char *ftype, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len); -extern int dafopn_(char *fname, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen ifname_len); -extern int dafcls_(integer *handle); -extern int dafhsf_(integer *handle, integer *nd, integer *ni); -extern int dafhlu_(integer *handle, integer *unit); -extern int dafluh_(integer *unit, integer *handle); -extern int dafhfn_(integer *handle, char *fname, ftnlen fname_len); -extern int daffnh_(char *fname, integer *handle, ftnlen fname_len); -extern int dafhof_(integer *fhset); -extern int dafsih_(integer *handle, char *access, ftnlen access_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: zzddhopn_ 14 7 13 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzdafgfr_ 14 11 4 13 4 4 13 4 4 4 12 124 124 */ -/*:ref: zzddhcls_ 14 4 4 13 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafrwa_ 14 3 4 4 4 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: zzdafnfr_ 14 12 4 13 4 4 13 4 4 4 13 124 124 124 */ -/*:ref: removi_ 14 2 4 4 */ -/*:ref: zzddhluh_ 14 3 4 4 12 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzddhfnh_ 14 4 13 4 12 124 */ -/*:ref: copyi_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: elemi_ 12 2 4 4 */ - -extern int dafana_(integer *handle, doublereal *sum, char *name__, doublereal *data, integer *n, ftnlen name_len); -extern int dafbna_(integer *handle, doublereal *sum, char *name__, ftnlen name_len); -extern int dafada_(doublereal *data, integer *n); -extern int dafena_(void); -extern int dafcad_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafhof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafhfn_ 14 3 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafwda_ 14 4 4 4 4 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafrwa_ 14 3 4 4 4 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ - -extern int dafarr_(integer *handle, integer *resv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafws_ 14 1 7 */ - -extern int dafb2a_(char *binary, char *ascii, ftnlen binary_len, ftnlen ascii_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopn_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafb2t_ 14 3 13 4 124 */ - -extern int dafb2t_(char *binary, integer *text, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int dafbt_(char *binfil, integer *xfrlun, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: wrenci_ 14 3 4 4 4 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: wrencd_ 14 3 4 4 7 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int dafdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrrr_ 14 2 4 4 */ - -extern int dafec_(integer *handle, integer *bufsiz, integer *n, char *buffer, logical *done, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int daffa_(integer *handle, doublereal *sum, char *name__, logical *found, ftnlen name_len); -extern int dafbfs_(integer *handle); -extern int daffna_(logical *found); -extern int dafbbs_(integer *handle); -extern int daffpa_(logical *found); -extern int dafgs_(doublereal *sum); -extern int dafgn_(char *name__, ftnlen name_len); -extern int dafgh_(integer *handle); -extern int dafrs_(doublereal *sum); -extern int dafrn_(char *name__, ftnlen name_len); -extern int dafws_(doublereal *sum); -extern int dafcs_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dafhof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafgsr_ 14 6 4 4 4 4 7 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: dafhfn_ 14 3 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ - -extern int dafgda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafgdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ - -extern int dafps_(integer *nd, integer *ni, doublereal *dc, integer *ic, doublereal *sum); -extern int dafus_(doublereal *sum, integer *nd, integer *ni, doublereal *dc, integer *ic); -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: movei_ 14 3 4 4 4 */ - -extern int dafra_(integer *handle, integer *iorder, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isordv_ 12 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: dafws_ 14 1 7 */ -/*:ref: dafrn_ 14 2 13 124 */ - -extern int dafrcr_(integer *handle, integer *recno, char *crec, ftnlen crec_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ - -extern int dafrda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: zzddhisn_ 14 3 4 12 12 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ - -extern int dafrfr_(integer *handle, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzdafgfr_ 14 11 4 13 4 4 13 4 4 4 12 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dafrrr_(integer *handle, integer *resv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafws_ 14 1 7 */ - -extern int dafrwa_(integer *recno, integer *wordno, integer *addr__); -extern int dafarw_(integer *addr__, integer *recno, integer *wordno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafrwd_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *drec, doublereal *data, logical *found, integer *reads, integer *reqs); -extern int dafgdr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafgsr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafrdr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafwdr_(integer *handle, integer *recno, doublereal *drec); -extern int dafnrr_(integer *reads, integer *reqs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: minai_ 14 4 4 4 4 4 */ -/*:ref: zzdafgdr_ 14 4 4 4 7 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: zzddhrcm_ 14 3 4 4 4 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: zzdafgsr_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzddhisn_ 14 3 4 12 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int daft2b_(integer *text, char *binary, integer *resv, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafena_ 14 0 */ - -extern int daftb_(integer *xfrlun, char *binfil, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: rdenci_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rdencd_ 14 3 4 4 7 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int dafwcr_(integer *handle, integer *recno, char *crec, ftnlen crec_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafwda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ - -extern int dafwfr_(integer *handle, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dasa2l_(integer *handle, integer *type__, integer *addrss, integer *clbase, integer *clsize, integer *recno, integer *wordno); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ - -extern int dasac_(integer *handle, integer *n, char *buffer, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasacr_ 14 2 4 4 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ - -extern int dasacr_(integer *handle, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern int dasacu_(integer *comlun, char *begmrk, char *endmrk, logical *insbln, integer *handle, ftnlen begmrk_len, ftnlen endmrk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: readln_ 14 4 4 13 12 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: readla_ 14 6 4 4 4 13 12 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: writla_ 14 4 4 13 4 124 */ -/*:ref: dasac_ 14 4 4 4 13 124 */ - -extern int dasadc_(integer *handle, integer *n, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: daswrc_ 14 4 4 4 13 124 */ -/*:ref: dasurc_ 14 6 4 4 4 4 13 124 */ -/*:ref: dascud_ 14 3 4 4 4 */ - -extern int dasadd_(integer *handle, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: daswrd_ 14 3 4 4 7 */ -/*:ref: dasurd_ 14 5 4 4 4 4 7 */ -/*:ref: dascud_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasadi_(integer *handle, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: daswri_ 14 3 4 4 4 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ -/*:ref: dascud_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasbt_(char *binfil, integer *xfrlun, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: wrenci_ 14 3 4 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: wrencc_ 14 4 4 4 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: wrencd_ 14 3 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int dascls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dashof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dassdr_ 14 1 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int dascud_(integer *handle, integer *type__, integer *nwords); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: daswri_ 14 3 4 4 4 */ - -extern int dasdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasrcr_ 14 2 4 4 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ - -extern int dasec_(integer *handle, integer *bufsiz, integer *n, char *buffer, logical *done, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int dasecu_(integer *handle, integer *comlun, logical *comnts); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasec_ 14 6 4 4 4 13 12 124 */ -/*:ref: writla_ 14 4 4 13 4 124 */ - -extern int dasfm_(char *fname, char *ftype, char *ifname, integer *handle, integer *unit, integer *free, integer *lastla, integer *lastrc, integer *lastwd, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len); -extern int dasopr_(char *fname, integer *handle, ftnlen fname_len); -extern int dasopw_(char *fname, integer *handle, ftnlen fname_len); -extern int dasonw_(char *fname, char *ftype, char *ifname, integer *ncomr, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len); -extern int dasopn_(char *fname, char *ifname, integer *handle, ftnlen fname_len, ftnlen ifname_len); -extern int dasops_(integer *handle); -extern int dasllc_(integer *handle); -extern int dashfs_(integer *handle, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *free, integer *lastla, integer *lastrc, integer *lastwd); -extern int dasufs_(integer *handle, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *free, integer *lastla, integer *lastrc, integer *lastwd); -extern int dashlu_(integer *handle, integer *unit); -extern int dasluh_(integer *unit, integer *handle); -extern int dashfn_(integer *handle, char *fname, ftnlen fname_len); -extern int dasfnh_(char *fname, integer *handle, ftnlen fname_len); -extern int dashof_(integer *fhset); -extern int dassih_(integer *handle, char *access, ftnlen access_len); -extern int dasham_(integer *handle, char *access, ftnlen access_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzddhppf_ 14 3 4 4 4 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: zzdasnfr_ 14 11 4 13 13 4 4 4 4 13 124 124 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: removi_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: copyi_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: elemi_ 12 2 4 4 */ - -extern doublereal dasine_(doublereal *arg, doublereal *tol); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasioc_(char *action, integer *unit, integer *recno, char *record, ftnlen action_len, ftnlen record_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int dasiod_(char *action, integer *unit, integer *recno, doublereal *record, ftnlen action_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int dasioi_(char *action, integer *unit, integer *recno, integer *record, ftnlen action_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int daslla_(integer *handle, integer *lastc, integer *lastd, integer *lasti); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasrcr_(integer *handle, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern int dasrdc_(integer *handle, integer *first, integer *last, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrrc_ 14 6 4 4 4 4 13 124 */ - -extern int dasrdd_(integer *handle, integer *first, integer *last, doublereal *data); -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: dasrrd_ 14 5 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ - -extern int dasrdi_(integer *handle, integer *first, integer *last, integer *data); -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ - -extern int dasrfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dasrwr_(integer *handle, integer *recno, char *recc, doublereal *recd, integer *reci, integer *first, integer *last, doublereal *datad, integer *datai, char *datac, ftnlen recc_len, ftnlen datac_len); -extern int dasrrd_(integer *handle, integer *recno, integer *first, integer *last, doublereal *datad); -extern int dasrri_(integer *handle, integer *recno, integer *first, integer *last, integer *datai); -extern int dasrrc_(integer *handle, integer *recno, integer *first, integer *last, char *datac, ftnlen datac_len); -extern int daswrd_(integer *handle, integer *recno, doublereal *recd); -extern int daswri_(integer *handle, integer *recno, integer *reci); -extern int daswrc_(integer *handle, integer *recno, char *recc, ftnlen recc_len); -extern int dasurd_(integer *handle, integer *recno, integer *first, integer *last, doublereal *datad); -extern int dasuri_(integer *handle, integer *recno, integer *first, integer *last, integer *datai); -extern int dasurc_(integer *handle, integer *recno, integer *first, integer *last, char *datac, ftnlen datac_len); -extern int daswbr_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: lnkxsl_ 14 3 4 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ - -extern int dassdr_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int dastb_(integer *xfrlun, char *binfil, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dasonw_ 14 8 13 13 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: rdenci_ 14 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: dasacr_ 14 2 4 4 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rdencc_ 14 4 4 4 13 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasadc_ 14 6 4 4 4 4 13 124 */ -/*:ref: rdencd_ 14 3 4 4 7 */ -/*:ref: dasadd_ 14 3 4 4 7 */ -/*:ref: dasadi_ 14 3 4 4 4 */ - -extern int dasudc_(integer *handle, integer *first, integer *last, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasurc_ 14 6 4 4 4 4 13 124 */ - -extern int dasudd_(integer *handle, integer *first, integer *last, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasurd_ 14 5 4 4 4 4 7 */ - -extern int dasudi_(integer *handle, integer *first, integer *last, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ - -extern int daswfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern doublereal datanh_(doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal dcbrt_(doublereal *x); - -extern int dcyldr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: drdcyl_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int delfil_(char *filnam, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: getlun_ 14 1 4 */ - -extern int deltet_(doublereal *epoch, char *eptype, doublereal *delta, ftnlen eptype_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern doublereal det_(doublereal *m1); - -extern int dgeodr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: drdgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern doublereal dhfa_(doublereal *state, doublereal *bodyr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int diags2_(doublereal *symmat, doublereal *diag, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rquad_ 14 5 7 7 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ - -extern int diffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int diffd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int diffi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dlatdr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: drdlat_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int dnearp_(doublereal *state, doublereal *a, doublereal *b, doublereal *c__, doublereal *dnear, doublereal *dalt, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vtmv_ 7 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int dp2hx_(doublereal *number, char *string, integer *length, ftnlen string_len); -/*:ref: int2hx_ 14 4 4 13 4 124 */ - -extern int dpfmt_(doublereal *x, char *pictur, char *str, ftnlen pictur_len, ftnlen str_len); -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzvststr_ 14 4 7 13 4 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rjust_ 14 4 13 13 124 124 */ -/*:ref: zzvsbstr_ 14 6 4 4 12 13 12 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int dpgrdr_(char *body, doublereal *x, doublereal *y, doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: dgeodr_ 14 6 7 7 7 7 7 7 */ - -extern doublereal dpr_(void); - -extern int dpspce_(doublereal *time, doublereal *geophs, doublereal *elems, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: zzdpinit_ 14 6 7 7 7 7 7 7 */ -/*:ref: zzdpper_ 14 6 7 7 7 7 7 7 */ -/*:ref: zzdpsec_ 14 9 7 7 7 7 7 7 7 7 7 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dpstr_(doublereal *x, integer *sigdig, char *string, ftnlen string_len); -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int dpstrf_(doublereal *x, integer *sigdig, char *format, char *string, ftnlen format_len, ftnlen string_len); -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: zzvststr_ 14 4 7 13 4 124 */ -/*:ref: zzvsbstr_ 14 6 4 4 12 13 12 124 */ - -extern int drdcyl_(doublereal *r__, doublereal *long__, doublereal *z__, doublereal *jacobi); - -extern int drdgeo_(doublereal *long__, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int drdlat_(doublereal *r__, doublereal *long__, doublereal *lat, doublereal *jacobi); - -extern int drdpgr_(char *body, doublereal *lon, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: drdgeo_ 14 6 7 7 7 7 7 7 */ - -extern int drdsph_(doublereal *r__, doublereal *colat, doublereal *long__, doublereal *jacobi); - -extern int drotat_(doublereal *angle, integer *iaxis, doublereal *dmout); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dsphdr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: drdsph_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int ducrss_(doublereal *s1, doublereal *s2, doublereal *sout); -/*:ref: dvcrss_ 14 3 7 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ - -extern int dvcrss_(doublereal *s1, doublereal *s2, doublereal *sout); -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern doublereal dvdot_(doublereal *s1, doublereal *s2); - -extern int dvhat_(doublereal *s1, doublereal *sout); -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern doublereal dvnorm_(doublereal *state); -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ - -extern doublereal dvsep_(doublereal *s1, doublereal *s2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dxtrct_(char *keywd, integer *maxwds, char *string, integer *nfound, integer *parsed, doublereal *values, ftnlen keywd_len, ftnlen string_len); -/*:ref: wdindx_ 4 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int edlimb_(doublereal *a, doublereal *b, doublereal *c__, doublereal *viewpt, doublereal *limb); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: inedpl_ 14 6 7 7 7 7 7 12 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int edterm_(char *trmtyp, char *source, char *target, doublereal *et, char *fixfrm, char *abcorr, char *obsrvr, integer *npts, doublereal *trgepc, doublereal *obspos, doublereal *trmpts, ftnlen trmtyp_len, ftnlen source_len, ftnlen target_len, ftnlen fixfrm_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: bodvrd_ 14 7 13 13 4 4 7 124 124 */ -/*:ref: spkpos_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: zzedterm_ 14 9 13 7 7 7 7 7 4 7 124 */ - -extern int ekacec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad03_ 14 7 4 4 4 4 13 12 124 */ -/*:ref: zzekad06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekaced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekad05_ 14 7 4 4 4 4 4 7 12 */ - -extern int ekacei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekad04_ 14 7 4 4 4 4 4 4 12 */ - -extern int ekaclc_(integer *handle, integer *segno, char *column, char *cvals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac03_ 14 8 4 4 4 13 12 4 4 124 */ -/*:ref: zzekac06_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: zzekac09_ 14 7 4 4 4 13 12 4 124 */ - -extern int ekacld_(integer *handle, integer *segno, char *column, doublereal *dvals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac02_ 14 7 4 4 4 7 12 4 4 */ -/*:ref: zzekac05_ 14 6 4 4 4 7 4 12 */ -/*:ref: zzekac08_ 14 6 4 4 4 7 12 4 */ - -extern int ekacli_(integer *handle, integer *segno, char *column, integer *ivals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac01_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: zzekac04_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekac07_ 14 6 4 4 4 4 12 4 */ - -extern int ekappr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: ekinsr_ 14 3 4 4 4 */ - -extern int ekbseg_(integer *handle, char *tabnam, integer *ncols, char *cnames, char *decls, integer *segno, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: lxdfid_ 14 1 4 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: lxidnt_ 14 6 4 13 4 4 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekpdec_ 14 3 13 4 124 */ -/*:ref: zzekstyp_ 4 2 4 4 */ -/*:ref: zzekbs01_ 14 8 4 13 4 13 4 4 124 124 */ -/*:ref: zzekbs02_ 14 8 4 13 4 13 4 4 124 124 */ - -extern int ekcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekdelr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekde01_ 14 4 4 4 4 4 */ -/*:ref: zzekde02_ 14 4 4 4 4 4 */ -/*:ref: zzekde03_ 14 4 4 4 4 4 */ -/*:ref: zzekde04_ 14 4 4 4 4 4 */ -/*:ref: zzekde05_ 14 4 4 4 4 4 */ -/*:ref: zzekde06_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekffld_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekff01_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekfind_(char *query, integer *nmrows, logical *error, char *errmsg, ftnlen query_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpars_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: zzeknres_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: zzektres_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: zzeksemc_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: eksrch_ 14 8 4 13 7 4 12 13 124 124 */ - -extern int ekifld_(integer *handle, char *tabnam, integer *ncols, integer *nrows, char *cnames, char *decls, integer *segno, integer *rcptrs, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekbseg_ 14 9 4 13 4 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekif01_ 14 3 4 4 4 */ -/*:ref: zzekif02_ 14 2 4 4 */ - -extern int ekinsr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: filli_ 14 3 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ - -extern integer eknseg_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrsz_ 4 2 4 4 */ - -extern int ekopn_(char *fname, char *ifname, integer *ncomch, integer *handle, ftnlen fname_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasonw_ 14 8 13 13 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekpgin_ 14 1 4 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekopr_(char *fname, integer *handle, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ - -extern int ekops_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgin_ 14 1 4 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekopw_(char *fname, integer *handle, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopw_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ - -extern int ekpsel_(char *query, integer *n, integer *xbegs, integer *xends, char *xtypes, char *xclass, char *tabs, char *cols, logical *error, char *errmsg, ftnlen query_len, ftnlen xtypes_len, ftnlen xclass_len, ftnlen tabs_len, ftnlen cols_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekencd_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: zzekqsel_ 14 12 4 13 4 4 4 13 4 13 4 124 124 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ - -extern int ekqmgr_(integer *cindex, integer *elment, char *eqryc, doublereal *eqryd, integer *eqryi, char *fname, integer *row, integer *selidx, char *column, integer *handle, integer *n, char *table, integer *attdsc, integer *ccount, logical *found, integer *nelt, integer *nmrows, logical *semerr, char *errmsg, char *cdata, doublereal *ddata, integer *idata, logical *null, ftnlen eqryc_len, ftnlen fname_len, ftnlen column_len, ftnlen table_len, ftnlen errmsg_len, ftnlen cdata_len); -extern int eklef_(char *fname, integer *handle, ftnlen fname_len); -extern int ekuef_(integer *handle); -extern int ekntab_(integer *n); -extern int ektnam_(integer *n, char *table, ftnlen table_len); -extern int ekccnt_(char *table, integer *ccount, ftnlen table_len); -extern int ekcii_(char *table, integer *cindex, char *column, integer *attdsc, ftnlen table_len, ftnlen column_len); -extern int eksrch_(integer *eqryi, char *eqryc, doublereal *eqryd, integer *nmrows, logical *semerr, char *errmsg, ftnlen eqryc_len, ftnlen errmsg_len); -extern int eknelt_(integer *selidx, integer *row, integer *nelt); -extern int ekgc_(integer *selidx, integer *row, integer *elment, char *cdata, logical *null, logical *found, ftnlen cdata_len); -extern int ekgd_(integer *selidx, integer *row, integer *elment, doublereal *ddata, logical *null, logical *found); -extern int ekgi_(integer *selidx, integer *row, integer *elment, integer *idata, logical *null, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ekopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: ekcls_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: zzeksinf_ 14 8 4 4 13 4 13 4 124 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: appndc_ 14 4 13 13 124 124 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksdec_ 14 1 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekqcnj_ 14 3 4 4 4 */ -/*:ref: zzekqcon_ 14 24 4 13 7 4 4 13 4 13 4 4 13 4 13 4 4 4 4 7 4 124 124 124 124 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekkey_ 14 20 4 4 4 4 4 4 4 4 13 4 4 7 4 12 4 4 4 4 12 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekrplk_ 14 4 4 4 4 4 */ -/*:ref: zzekrmch_ 12 15 4 12 4 4 4 4 4 4 4 13 4 4 7 4 124 */ -/*:ref: zzekvmch_ 12 13 4 12 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekjsqz_ 14 1 4 */ -/*:ref: zzekjoin_ 14 18 4 4 4 12 4 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekweed_ 14 3 4 4 4 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzekqsel_ 14 12 4 13 4 4 4 13 4 13 4 124 124 124 */ -/*:ref: zzekqord_ 14 11 4 13 4 13 4 13 4 4 124 124 124 */ -/*:ref: zzekjsrt_ 14 13 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekvcal_ 14 3 4 4 4 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ - -extern int ekrcec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd03_ 14 8 4 4 4 4 4 13 12 124 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd06_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrd09_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekrced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd05_ 14 9 4 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrd08_ 14 6 4 4 4 4 7 12 */ - -extern int ekrcei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd04_ 14 9 4 4 4 4 4 4 4 12 12 */ -/*:ref: zzekrd07_ 14 6 4 4 4 4 4 12 */ - -extern int ekshdw_(integer *handle, logical *isshad); - -extern int ekssum_(integer *handle, integer *segno, char *tabnam, integer *nrows, integer *ncols, char *cnames, char *dtypes, integer *sizes, integer *strlns, logical *indexd, logical *nullok, ftnlen tabnam_len, ftnlen cnames_len, ftnlen dtypes_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksinf_ 14 8 4 4 13 4 13 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekucec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue03_ 14 7 4 4 4 4 13 12 124 */ -/*:ref: zzekue06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekuced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekue05_ 14 7 4 4 4 4 4 7 12 */ - -extern int ekucei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekue04_ 14 7 4 4 4 4 4 4 12 */ - -extern int el2cgv_(doublereal *ellips, doublereal *center, doublereal *smajor, doublereal *sminor); -/*:ref: vequ_ 14 2 7 7 */ - -extern logical elemc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical elemd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical elemi_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int elltof_(doublereal *ma, doublereal *ecc, doublereal *e); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int enchar_(integer *number, char *string, ftnlen string_len); -extern int dechar_(char *string, integer *number, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: chbase_ 4 0 */ - -extern logical eqchr_(char *a, char *b, ftnlen a_len, ftnlen b_len); -extern logical nechr_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int eqncpv_(doublereal *et, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *decpol, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: twopi_ 7 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: kepleq_ 7 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern logical eqstr_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int erract_(char *op, char *action, ftnlen op_len, ftnlen action_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getact_ 14 1 4 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: putact_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int errch_(char *marker, char *string, ftnlen marker_len, ftnlen string_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errdev_(char *op, char *device, ftnlen op_len, ftnlen device_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: putdev_ 14 2 13 124 */ - -extern int errdp_(char *marker, doublereal *dpnum, ftnlen marker_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errfnm_(char *marker, integer *unit, ftnlen marker_len); -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int errhan_(char *marker, integer *handle, ftnlen marker_len); -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int errint_(char *marker, integer *integr, ftnlen marker_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errprt_(char *op, char *list, ftnlen op_len, ftnlen list_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: msgsel_ 12 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: setprt_ 12 5 12 12 12 12 12 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer esrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int et2lst_(doublereal *et, integer *body, doublereal *long__, char *type__, integer *hr, integer *mn, integer *sc, char *time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: pgrrec_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: pi_ 7 0 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ - -extern int et2utc_(doublereal *et, char *format, integer *prec, char *utcstr, ftnlen format_len, ftnlen utcstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int etcal_(doublereal *et, char *string, ftnlen string_len); -/*:ref: spd_ 7 0 */ -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: lstlti_ 4 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ - -extern int eul2m_(doublereal *angle3, doublereal *angle2, doublereal *angle1, integer *axis3, integer *axis2, integer *axis1, doublereal *r__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rotate_ 14 3 7 4 7 */ -/*:ref: rotmat_ 14 4 7 7 4 7 */ - -extern int ev2lin_(doublereal *et, doublereal *geophs, doublereal *elems, doublereal *state); -/*:ref: twopi_ 7 0 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern logical even_(integer *i__); - -extern doublereal exact_(doublereal *number, doublereal *value, doublereal *tol); - -extern int excess_(integer *number, char *struct__, ftnlen struct_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical exists_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int expln_(char *msg, char *expl, ftnlen msg_len, ftnlen expl_len); - -extern integer fetchc_(integer *nth, char *set, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer fetchd_(integer *nth, doublereal *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer fetchi_(integer *nth, integer *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int fillc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern int filld_(doublereal *value, integer *ndim, doublereal *array); - -extern int filli_(integer *value, integer *ndim, integer *array); - -extern int fn2lun_(char *filnam, integer *lunit, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int fndlun_(integer *unit); -extern int reslun_(integer *unit); -extern int frelun_(integer *unit); - -extern int fndnwd_(char *string, integer *start, integer *b, integer *e, ftnlen string_len); - -extern int frame_(doublereal *x, doublereal *y, doublereal *z__); -/*:ref: vhatip_ 14 1 7 */ - -extern int framex_(char *cname, char *frname, integer *frcode, integer *cent, integer *class__, integer *clssid, logical *found, ftnlen cname_len, ftnlen frname_len); -extern int namfrm_(char *frname, integer *frcode, ftnlen frname_len); -extern int frmnam_(integer *frcode, char *frname, ftnlen frname_len); -extern int frinfo_(integer *frcode, integer *cent, integer *class__, integer *clssid, logical *found); -extern int cidfrm_(integer *cent, integer *frcode, char *frname, logical *found, ftnlen frname_len); -extern int cnmfrm_(char *cname, integer *frcode, char *frname, logical *found, ftnlen cname_len, ftnlen frname_len); -extern int ccifrm_(integer *class__, integer *clssid, integer *frcode, char *frname, integer *cent, logical *found, ftnlen frname_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: zzfdat_ 14 10 4 13 4 4 4 4 4 4 4 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bschoc_ 4 6 13 4 13 4 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: gnpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int frmchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frmget_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int frmget_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynfrm_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ - -extern integer frstnb_(char *string, ftnlen string_len); - -extern integer frstnp_(char *string, ftnlen string_len); - -extern integer frstpc_(char *string, ftnlen string_len); - -extern integer gcd_(integer *a, integer *b); - -extern int georec_(doublereal *long__, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int getelm_(integer *frstyr, char *lines, doublereal *epoch, doublereal *elems, ftnlen lines_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzgetelm_ 14 8 4 13 7 7 12 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int getfat_(char *file, char *arch, char *kertyp, ftnlen file_len, ftnlen arch_len, ftnlen kertyp_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhfnh_ 14 4 13 4 12 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dashof_ 14 1 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: zzckspk_ 14 3 4 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int getfov_(integer *instid, integer *room, char *shape, char *frame, doublereal *bsight, integer *n, doublereal *bounds, ftnlen shape_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int getlun_(integer *unit); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: fndlun_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int getmsg_(char *option, char *msg, ftnlen option_len, ftnlen msg_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getsms_ 14 2 13 124 */ -/*:ref: expln_ 14 4 13 13 124 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical gfbail_(void); - -extern int gfdist_(char *target, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfevnt_(U_fp udstep, U_fp udrefn, char *gquant, integer *qnpars, char *qpnams, char *qcpars, doublereal *qdpars, integer *qipars, logical *qlpars, char *op, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, logical *rpt, U_fp udrepi, U_fp udrepu, U_fp udrepf, integer *mw, integer *nw, doublereal *work, logical *bail, L_fp udbail, doublereal *result, ftnlen gquant_len, ftnlen qpnams_len, ftnlen qcpars_len, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzgfspin_ 14 11 13 13 13 13 7 13 124 124 124 124 124 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 200 200 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: zzgfdiin_ 14 7 13 13 13 7 124 124 124 */ -/*:ref: zzgfcslv_ 14 37 13 13 13 13 13 13 13 7 13 13 13 7 7 7 200 200 12 200 200 200 12 212 4 4 7 7 7 124 124 124 124 124 124 124 124 124 124 */ -/*:ref: zzgfrrin_ 14 8 13 13 13 7 7 124 124 124 */ - -extern int gffove_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zzgffvin_ 14 13 13 13 7 13 13 13 13 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ - -extern int gfocce_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *abcorr, char *obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzgfocin_ 14 18 13 13 13 13 13 13 13 13 13 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ - -extern int gfoclt_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gfocce_ 14 29 13 13 13 13 13 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfposc_(char *target, char *frame, char *abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen frame_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfrefn_(doublereal *t1, doublereal *t2, logical *s1, logical *s2, doublereal *t); -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int gfrfov_(char *inst, doublereal *raydir, char *rframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen rframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gffove_ 14 24 13 13 7 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfrprt_(doublereal *window, char *begmss, char *endmss, doublereal *ivbeg, doublereal *ivend, doublereal *time, ftnlen begmss_len, ftnlen endmss_len); -extern int gfrepi_(doublereal *window, char *begmss, char *endmss, ftnlen begmss_len, ftnlen endmss_len); -extern int gfrepu_(doublereal *ivbeg, doublereal *ivend, doublereal *time); -extern int gfrepf_(void); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: wnsumd_ 14 6 7 7 7 7 4 4 */ -/*:ref: zzgftswk_ 14 7 7 7 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zzgfwkin_ 14 1 7 */ -/*:ref: zzgfwkad_ 14 6 7 4 13 13 124 124 */ -/*:ref: zzgfwkmo_ 14 9 4 7 7 4 13 13 7 124 124 */ -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: zzgfdsps_ 14 6 4 13 13 4 124 124 */ - -extern int gfrr_(char *target, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfsep_(char *targ1, char *shape1, char *frame1, char *targ2, char *shape2, char *frame2, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen targ1_len, ftnlen shape1_len, ftnlen frame1_len, ftnlen targ2_len, ftnlen shape2_len, ftnlen frame2_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfsntc_(char *target, char *fixref, char *method, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfstep_(doublereal *time, doublereal *step); -extern int gfsstp_(doublereal *step); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int gfsubc_(char *target, char *fixref, char *method, char *abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gftfov_(char *inst, char *target, char *tshape, char *tframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen target_len, ftnlen tshape_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gffove_ 14 24 13 13 7 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfuds_(U_fp udfunc, U_fp udqdec, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen relate_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: zzgfref_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: zzgfrelx_ 14 26 200 200 200 200 200 214 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern doublereal halfpi_(void); - -extern int hrmesp_(integer *n, doublereal *first, doublereal *step, doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, doublereal *df); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int hrmint_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, doublereal *df); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int hx2dp_(char *string, doublereal *number, logical *error, char *errmsg, ftnlen string_len, ftnlen errmsg_len); -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ - -extern int hx2int_(char *string, integer *number, logical *error, char *errmsg, ftnlen string_len, ftnlen errmsg_len); -/*:ref: intmin_ 4 0 */ -/*:ref: intmax_ 4 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ - -extern int hyptof_(doublereal *ma, doublereal *ecc, doublereal *f); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int ident_(doublereal *matrix); - -extern int idw2at_(char *idword, char *arch, char *type__, ftnlen idword_len, ftnlen arch_len, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int illum_(char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar, doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int ilumin_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, doublereal *phase, doublereal *solar, doublereal *emissn, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int inedpl_(doublereal *a, doublereal *b, doublereal *c__, doublereal *plane, doublereal *ellips, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: pl2psv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ - -extern int inelpl_(doublereal *ellips, doublereal *plane, integer *nxpts, doublereal *xpt1, doublereal *xpt2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: pl2nvp_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int inrypl_(doublereal *vertex, doublereal *dir, doublereal *plane, integer *nxpts, doublereal *xpt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: smsgnd_ 12 2 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int inslac_(char *elts, integer *ne, integer *loc, char *array, integer *na, ftnlen elts_len, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inslad_(doublereal *elts, integer *ne, integer *loc, doublereal *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inslai_(integer *elts, integer *ne, integer *loc, integer *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrtc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrtd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrti_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inssub_(char *in, char *sub, integer *loc, char *out, ftnlen in_len, ftnlen sub_len, ftnlen out_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int int2hx_(integer *number, char *string, integer *length, ftnlen string_len); - -extern int interc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int interd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int interi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int intord_(integer *n, char *string, ftnlen string_len); -/*:ref: inttxt_ 14 3 4 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int intstr_(integer *number, char *string, ftnlen string_len); - -extern int inttxt_(integer *n, char *string, ftnlen string_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int invert_(doublereal *m1, doublereal *mout); -/*:ref: det_ 7 1 7 */ -/*:ref: filld_ 14 3 7 4 7 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ - -extern int invort_(doublereal *m, doublereal *mit); -/*:ref: dpmax_ 7 0 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int invstm_(doublereal *mat, doublereal *invmat); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: xposbl_ 14 5 7 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ioerr_(char *action, char *file, integer *iostat, ftnlen action_len, ftnlen file_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ - -extern int irftrn_(char *refa, char *refb, doublereal *rotab, ftnlen refa_len, ftnlen refb_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int iso2utc_(char *tstrng, char *utcstr, char *error, ftnlen tstrng_len, ftnlen utcstr_len, ftnlen error_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical isopen_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern logical isordv_(integer *array, integer *n); - -extern integer isrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern integer isrchd_(doublereal *value, integer *ndim, doublereal *array); - -extern integer isrchi_(integer *value, integer *ndim, integer *array); - -extern logical isrot_(doublereal *m, doublereal *ntol, doublereal *dtol); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: det_ 7 1 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern doublereal j1900_(void); - -extern doublereal j1950_(void); - -extern doublereal j2000_(void); - -extern doublereal j2100_(void); - -extern int jul2gr_(integer *year, integer *month, integer *day, integer *doy); -extern int gr2jul_(integer *year, integer *month, integer *day, integer *doy); -/*:ref: rmaini_ 14 4 4 4 4 4 */ -/*:ref: lstlti_ 4 3 4 4 4 */ - -extern doublereal jyear_(void); - -extern int keeper_(integer *which, char *kind, char *file, integer *count, char *filtyp, integer *handle, char *source, logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int furnsh_(char *file, ftnlen file_len); -extern int ktotal_(char *kind, integer *count, ftnlen kind_len); -extern int kdata_(integer *which, char *kind, char *file, char *filtyp, char *source, integer *handle, logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int kinfo_(char *file, char *filtyp, char *source, integer *handle, logical *found, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int kclear_(void); -extern int unload_(char *file, ftnlen file_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzldker_ 14 7 13 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: stpool_ 14 9 13 4 13 13 4 12 124 124 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: samsub_ 12 8 13 4 4 13 4 4 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: repmot_ 14 9 13 13 4 13 13 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dvpool_ 14 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: spkuef_ 14 1 4 */ -/*:ref: ckupf_ 14 1 4 */ -/*:ref: pckuof_ 14 1 4 */ -/*:ref: ekuef_ 14 1 4 */ -/*:ref: clpool_ 14 0 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: ldpool_ 14 2 13 124 */ -/*:ref: spklef_ 14 3 13 4 124 */ -/*:ref: cklpf_ 14 3 13 4 124 */ -/*:ref: pcklof_ 14 3 13 4 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ - -extern doublereal kepleq_(doublereal *ml, doublereal *h__, doublereal *k); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: kpsolv_ 7 1 7 */ - -extern doublereal kpsolv_(doublereal *evec); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int kxtrct_(char *keywd, char *terms, integer *nterms, char *string, logical *found, char *substr, ftnlen keywd_len, ftnlen terms_len, ftnlen string_len, ftnlen substr_len); -/*:ref: wdindx_ 4 4 13 13 124 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: shiftl_ 14 7 13 4 13 13 124 124 124 */ - -extern integer lastnb_(char *string, ftnlen string_len); - -extern integer lastpc_(char *string, ftnlen string_len); - -extern int latcyl_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *r__, doublereal *longc, doublereal *z__); - -extern int latrec_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *rectan); - -extern int latsph_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *rho, doublereal *colat, doublereal *longs); -/*:ref: halfpi_ 7 0 */ - -extern int lbuild_(char *items, integer *n, char *delim, char *list, ftnlen items_len, ftnlen delim_len, ftnlen list_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int lcase_(char *in, char *out, ftnlen in_len, ftnlen out_len); - -extern doublereal lgresp_(integer *n, doublereal *first, doublereal *step, doublereal *yvals, doublereal *work, doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lgrind_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *work, doublereal *x, doublereal *p, doublereal *dp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern doublereal lgrint_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *work, doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int ljust_(char *input, char *output, ftnlen input_len, ftnlen output_len); - -extern int lnkan_(integer *pool, integer *new__); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkfsl_(integer *head, integer *tail, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnkhl_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkila_(integer *prev, integer *list, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkilb_(integer *list, integer *next, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkini_(integer *size, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnknfn_(integer *pool); - -extern integer lnknxt_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnkprv_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnksiz_(integer *pool); - -extern integer lnktl_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkxsl_(integer *head, integer *tail, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int locati_(integer *id, integer *idsz, integer *list, integer *pool, integer *at, logical *presnt); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnksiz_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lnkxsl_ 14 3 4 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ - -extern int locln_(integer *unit, char *bmark, char *emark, char *line, integer *bline, integer *eline, logical *found, ftnlen bmark_len, ftnlen emark_len, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ltrim_ 4 2 13 124 */ - -extern int lparse_(char *list, char *delim, integer *nmax, integer *n, char *items, ftnlen list_len, ftnlen delim_len, ftnlen items_len); - -extern int lparsm_(char *list, char *delims, integer *nmax, integer *n, char *items, ftnlen list_len, ftnlen delims_len, ftnlen items_len); - -extern int lparss_(char *list, char *delims, char *set, ftnlen list_len, ftnlen delims_len, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal lspcn_(char *body, doublereal *et, char *abcorr, ftnlen body_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkezr_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ - -extern integer lstcld_(doublereal *x, integer *n, doublereal *array); - -extern integer lstcli_(integer *x, integer *n, integer *array); - -extern integer lstlec_(char *string, integer *n, char *array, ftnlen string_len, ftnlen array_len); - -extern integer lstled_(doublereal *x, integer *n, doublereal *array); - -extern integer lstlei_(integer *x, integer *n, integer *array); - -extern integer lstltc_(char *string, integer *n, char *array, ftnlen string_len, ftnlen array_len); - -extern integer lstltd_(doublereal *x, integer *n, doublereal *array); - -extern integer lstlti_(integer *x, integer *n, integer *array); - -extern int ltime_(doublereal *etobs, integer *obs, char *dir, integer *targ, doublereal *ettarg, doublereal *elapsd, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: clight_ 7 0 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: failed_ 12 0 */ - -extern integer ltrim_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ - -extern int lun2fn_(integer *lunit, char *filnam, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lx4dec_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: lx4sgn_ 14 5 13 4 4 4 124 */ - -extern int lx4num_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4dec_ 14 5 13 4 4 4 124 */ -/*:ref: lx4sgn_ 14 5 13 4 4 4 124 */ - -extern int lx4sgn_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ - -extern int lx4uns_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); - -extern int lxname_(char *hdchrs, char *tlchrs, char *string, integer *first, integer *last, integer *idspec, integer *nchar, ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len); -extern int lxidnt_(integer *idspec, char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -extern int lxdfid_(integer *idspec); -extern int lxcsid_(char *hdchrs, char *tlchrs, integer *idspec, ftnlen hdchrs_len, ftnlen tlchrs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: validi_ 14 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ - -extern int lxqstr_(char *string, char *qchar, integer *first, integer *last, integer *nchar, ftnlen string_len, ftnlen qchar_len); - -extern int m2eul_(doublereal *r__, integer *axis3, integer *axis2, integer *axis1, doublereal *angle3, doublereal *angle2, doublereal *angle1); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: mtxm_ 14 3 7 7 7 */ - -extern int m2q_(doublereal *r__, doublereal *q); -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical matchi_(char *string, char *templ, char *wstr, char *wchr, ftnlen string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ -/*:ref: nechr_ 12 4 13 13 124 124 */ -/*:ref: samchi_ 12 6 13 4 13 4 124 124 */ - -extern logical matchw_(char *string, char *templ, char *wstr, char *wchr, ftnlen string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ - -extern int maxac_(char *array, integer *ndim, char *maxval, integer *loc, ftnlen array_len, ftnlen maxval_len); - -extern int maxad_(doublereal *array, integer *ndim, doublereal *maxval, integer *loc); - -extern int maxai_(integer *array, integer *ndim, integer *maxval, integer *loc); - -extern int mequ_(doublereal *m1, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mequg_(doublereal *m1, integer *nr, integer *nc, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int minac_(char *array, integer *ndim, char *minval, integer *loc, ftnlen array_len, ftnlen minval_len); - -extern int minad_(doublereal *array, integer *ndim, doublereal *minval, integer *loc); - -extern int minai_(integer *array, integer *ndim, integer *minval, integer *loc); - -extern int movec_(char *arrfrm, integer *ndim, char *arrto, ftnlen arrfrm_len, ftnlen arrto_len); - -extern int movei_(integer *arrfrm, integer *ndim, integer *arrto); - -extern int mtxm_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mtxmg_(doublereal *m1, doublereal *m2, integer *nc1, integer *nr1r2, integer *nc2, doublereal *mout); - -extern int mtxv_(doublereal *matrix, doublereal *vin, doublereal *vout); - -extern int mtxvg_(doublereal *m1, doublereal *v2, integer *nc1, integer *nr1r2, doublereal *vout); - -extern int mxm_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mxmg_(doublereal *m1, doublereal *m2, integer *row1, integer *col1, integer *col2, doublereal *mout); - -extern int mxmt_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mxmtg_(doublereal *m1, doublereal *m2, integer *nr1, integer *nc1c2, integer *nr2, doublereal *mout); - -extern int mxv_(doublereal *matrix, doublereal *vin, doublereal *vout); - -extern int mxvg_(doublereal *m1, doublereal *v2, integer *nr1, integer *nc1r2, doublereal *vout); - -extern integer nblen_(char *string, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ - -extern integer nbwid_(char *array, integer *nelt, ftnlen array_len); - -extern integer ncpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern integer ncposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern int nearpt_(doublereal *positn, doublereal *a, doublereal *b, doublereal *c__, doublereal *npoint, doublereal *alt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: orderd_ 14 3 7 4 4 */ -/*:ref: reordd_ 14 3 4 4 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: approx_ 12 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int nextwd_(char *string, char *next, char *rest, ftnlen string_len, ftnlen next_len, ftnlen rest_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ - -extern logical notru_(logical *logcls, integer *n); - -extern int nparsd_(char *string, doublereal *x, char *error, integer *ptr, ftnlen string_len, ftnlen error_len); -/*:ref: dpmax_ 7 0 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: pi_ 7 0 */ - -extern int nparsi_(char *string, integer *n, char *error, integer *pnter, ftnlen string_len, ftnlen error_len); -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int npedln_(doublereal *a, doublereal *b, doublereal *c__, doublereal *linept, doublereal *linedr, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: inedpl_ 14 6 7 7 7 7 7 12 */ -/*:ref: pjelpl_ 14 3 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: npelpt_ 14 4 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vprjpi_ 14 5 7 7 7 7 12 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int npelpt_(doublereal *point, doublereal *ellips, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int nplnpt_(doublereal *linpt, doublereal *lindir, doublereal *point, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int nthwd_(char *string, integer *nth, char *word, integer *loc, ftnlen string_len, ftnlen word_len); - -extern int nvc2pl_(doublereal *normal, doublereal *const__, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int nvp2pl_(doublereal *normal, doublereal *point, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern logical odd_(integer *i__); - -extern logical opsgnd_(doublereal *x, doublereal *y); - -extern logical opsgni_(integer *x, integer *y); - -extern integer ordc_(char *item, char *set, ftnlen item_len, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer ordd_(doublereal *item, doublereal *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int orderc_(char *array, integer *ndim, integer *iorder, ftnlen array_len); -/*:ref: swapi_ 14 2 4 4 */ - -extern int orderd_(doublereal *array, integer *ndim, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int orderi_(integer *array, integer *ndim, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern integer ordi_(integer *item, integer *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int oscelt_(doublereal *state, doublereal *et, doublereal *mu, doublereal *elts); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: exact_ 7 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: dacosh_ 7 1 7 */ - -extern int outmsg_(char *list, ftnlen list_len); -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: msgsel_ 12 2 13 124 */ -/*:ref: tkvrsn_ 14 4 13 13 124 124 */ -/*:ref: getsms_ 14 2 13 124 */ -/*:ref: expln_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: wdcnt_ 4 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: trcdep_ 14 1 4 */ -/*:ref: trcnam_ 14 3 4 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int packac_(char *in, integer *pack, integer *npack, integer *maxout, integer *nout, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int packad_(doublereal *in, integer *pack, integer *npack, integer *maxout, integer *nout, doublereal *out); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int packai_(integer *in, integer *pack, integer *npack, integer *maxout, integer *nout, integer *out); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int parsqs_(char *string, char *qchar, char *value, integer *length, logical *error, char *errmsg, integer *ptr, ftnlen string_len, ftnlen qchar_len, ftnlen value_len, ftnlen errmsg_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int partof_(doublereal *ma, doublereal *d__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int pck03a_(integer *handle, integer *ncsets, doublereal *coeffs, doublereal *epochs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ - -extern int pck03b_(integer *handle, char *segid, integer *body, char *frame, doublereal *first, doublereal *last, integer *chbdeg, ftnlen segid_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pckpds_ 14 7 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ - -extern int pck03e_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckbsr_(char *fname, integer *handle, integer *body, doublereal *et, doublereal *descr, char *ident, logical *found, ftnlen fname_len, ftnlen ident_len); -extern int pcklof_(char *fname, integer *handle, ftnlen fname_len); -extern int pckuof_(integer *handle); -extern int pcksfs_(integer *body, doublereal *et, integer *handle, doublereal *descr, char *ident, logical *found, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ - -extern int pckcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pckcov_(char *pck, integer *idcode, doublereal *cover, ftnlen pck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pcke02_(doublereal *et, doublereal *record, doublereal *eulang); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spke02_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pcke03_(doublereal *et, doublereal *record, doublereal *rotmat); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: rpd_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckeul_(integer *body, doublereal *et, logical *found, char *ref, doublereal *eulang, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pcksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: pckr02_ 14 4 4 7 7 7 */ -/*:ref: pcke02_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckfrm_(char *pck, integer *ids, ftnlen pck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pckmat_(integer *body, doublereal *et, integer *ref, doublereal *tsipm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pcksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: pckr02_ 14 4 4 7 7 7 */ -/*:ref: pcke02_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: pckr03_ 14 4 4 7 7 7 */ -/*:ref: pcke03_ 14 3 7 7 7 */ - -extern int pckopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckpds_(integer *body, char *frame, integer *type__, doublereal *first, doublereal *last, doublereal *descr, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ - -extern int pckr02_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckr03_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ - -extern int pckuds_(doublereal *descr, integer *body, integer *frame, integer *type__, doublereal *first, doublereal *last, integer *begin, integer *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckw02_(integer *handle, integer *body, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern integer pcwid_(char *array, integer *nelt, ftnlen array_len); - -extern int pgrrec_(char *body, doublereal *lon, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: georec_ 14 6 7 7 7 7 7 7 */ - -extern doublereal pi_(void); - -extern int pjelpl_(doublereal *elin, doublereal *plane, doublereal *elout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pl2nvc_(doublereal *plane, doublereal *normal, doublereal *const__); -/*:ref: vequ_ 14 2 7 7 */ - -extern int pl2nvp_(doublereal *plane, doublereal *normal, doublereal *point); -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int pl2psv_(doublereal *plane, doublereal *point, doublereal *span1, doublereal *span2); -/*:ref: pl2nvp_ 14 3 7 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ - -extern integer plnsns_(integer *bodid); -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int polyds_(doublereal *coeffs, integer *deg, integer *nderiv, doublereal *t, doublereal *p); - -extern int pool_(char *kernel, integer *unit, char *name__, char *names, integer *nnames, char *agent, integer *n, doublereal *values, logical *found, logical *update, integer *start, integer *room, char *cvals, integer *ivals, char *type__, char *uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen kernel_len, ftnlen name_len, ftnlen names_len, ftnlen agent_len, ftnlen cvals_len, ftnlen type_len, ftnlen uwvars_len, ftnlen uwagnt_len); -extern int clpool_(void); -extern int ldpool_(char *kernel, ftnlen kernel_len); -extern int rtpool_(char *name__, integer *n, doublereal *values, logical *found, ftnlen name_len); -extern int expool_(char *name__, logical *found, ftnlen name_len); -extern int wrpool_(integer *unit); -extern int swpool_(char *agent, integer *nnames, char *names, ftnlen agent_len, ftnlen names_len); -extern int cvpool_(char *agent, logical *update, ftnlen agent_len); -extern int gcpool_(char *name__, integer *start, integer *room, integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen cvals_len); -extern int gdpool_(char *name__, integer *start, integer *room, integer *n, doublereal *values, logical *found, ftnlen name_len); -extern int gipool_(char *name__, integer *start, integer *room, integer *n, integer *ivals, logical *found, ftnlen name_len); -extern int dtpool_(char *name__, logical *found, integer *n, char *type__, ftnlen name_len, ftnlen type_len); -extern int pcpool_(char *name__, integer *n, char *cvals, ftnlen name_len, ftnlen cvals_len); -extern int pdpool_(char *name__, integer *n, doublereal *values, ftnlen name_len); -extern int pipool_(char *name__, integer *n, integer *ivals, ftnlen name_len); -extern int lmpool_(char *cvals, integer *n, ftnlen cvals_len); -extern int szpool_(char *name__, integer *n, logical *found, ftnlen name_len); -extern int dvpool_(char *name__, ftnlen name_len); -extern int gnpool_(char *name__, integer *start, integer *room, integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen cvals_len); -extern int dwpool_(char *agent, ftnlen agent_len); -extern int zzvupool_(char *uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen uwvars_len, ftnlen uwagnt_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzpini_ 14 27 12 4 4 4 13 13 4 4 4 4 4 4 4 13 4 4 13 13 13 13 124 124 124 124 124 124 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: zznwpool_ 14 14 13 13 4 4 13 13 13 13 124 124 124 124 124 124 */ -/*:ref: rdknew_ 14 2 13 124 */ -/*:ref: zzrvar_ 14 13 4 4 13 4 4 7 4 13 13 12 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ -/*:ref: cltext_ 14 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: ioerr_ 14 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzgapool_ 14 10 13 13 4 4 13 13 124 124 124 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lstltc_ 4 5 13 4 13 124 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: removc_ 14 4 13 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzgpnm_ 14 15 4 4 13 4 4 7 4 13 13 12 4 4 124 124 124 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzrvbf_ 14 17 13 4 4 4 4 13 4 4 7 4 13 13 12 124 124 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: copyc_ 14 4 13 13 124 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ - -extern integer pos_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen substr_len); - -extern integer posr_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen substr_len); - -extern int prefix_(char *pref, integer *spaces, char *string, ftnlen pref_len, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: shiftr_ 14 7 13 4 13 13 124 124 124 */ - -extern doublereal prodad_(doublereal *array, integer *n); - -extern integer prodai_(integer *array, integer *n); - -extern int prompt_(char *prmpt, char *string, ftnlen prmpt_len, ftnlen string_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int prop2b_(doublereal *gm, doublereal *pvinit, doublereal *dt, doublereal *pvprop); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: brckti_ 4 3 4 4 4 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: stmp03_ 14 5 7 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vequg_ 14 3 7 4 7 */ - -extern int prsdp_(char *string, doublereal *dpval, ftnlen string_len); -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int prsint_(char *string, integer *intval, ftnlen string_len); -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int prtenc_(integer *number, char *string, ftnlen string_len); -extern int prtdec_(char *string, integer *number, ftnlen string_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical prtpkg_(logical *short__, logical *long__, logical *expl, logical *trace, logical *dfault, char *type__, ftnlen type_len); -extern logical setprt_(logical *short__, logical *expl, logical *long__, logical *trace, logical *dfault); -extern logical msgsel_(char *type__, ftnlen type_len); -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ - -extern int psv2pl_(doublereal *point, doublereal *span1, doublereal *span2, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int putact_(integer *action); -extern int getact_(integer *action); - -extern int putdev_(char *device, ftnlen device_len); -extern int getdev_(char *device, ftnlen device_len); - -extern int putlms_(char *msg, ftnlen msg_len); -extern int getlms_(char *msg, ftnlen msg_len); - -extern int putsms_(char *msg, ftnlen msg_len); -extern int getsms_(char *msg, ftnlen msg_len); - -extern int pxform_(char *from, char *to, doublereal *et, doublereal *rotate, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int q2m_(doublereal *q, doublereal *r__); - -extern int qderiv_(integer *n, doublereal *f0, doublereal *f2, doublereal *delta, doublereal *dfdt); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ - -extern int qdq2av_(doublereal *q, doublereal *dq, doublereal *av); -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: qxq_ 14 3 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int quote_(char *in, char *left, char *right, char *out, ftnlen in_len, ftnlen left_len, ftnlen right_len, ftnlen out_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ - -extern int qxq_(doublereal *q1, doublereal *q2, doublereal *qout); -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int radrec_(doublereal *range, doublereal *ra, doublereal *dec, doublereal *rectan); -/*:ref: latrec_ 14 4 7 7 7 7 */ - -extern int rav2xf_(doublereal *rot, doublereal *av, doublereal *xform); -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int raxisa_(doublereal *matrix, doublereal *axis, doublereal *angle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: m2q_ 14 2 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern int rdencc_(integer *unit, integer *n, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdencd_(integer *unit, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2dp_ 14 6 13 7 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdenci_(integer *unit, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdker_(char *kernel, char *line, integer *number, logical *eof, ftnlen kernel_len, ftnlen line_len); -extern int rdknew_(char *kernel, ftnlen kernel_len); -extern int rdkdat_(char *line, logical *eof, ftnlen line_len); -extern int rdklin_(char *kernel, integer *number, ftnlen kernel_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cltext_ 14 2 13 124 */ -/*:ref: zzsetnnread_ 14 1 12 */ -/*:ref: rdtext_ 14 5 13 13 12 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ - -extern int rdkvar_(char *tabsym, integer *tabptr, doublereal *tabval, char *name__, logical *eof, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: rdkdat_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: replch_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: sydeld_ 14 6 13 13 4 7 124 124 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: syenqd_ 14 7 13 7 13 4 7 124 124 */ - -extern int rdnbl_(char *file, char *line, logical *eof, ftnlen file_len, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rdtext_ 14 5 13 13 12 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rdtext_(char *file, char *line, logical *eof, ftnlen file_len, ftnlen line_len); -extern int cltext_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: getlun_ 14 1 4 */ - -extern int readla_(integer *unit, integer *maxlin, integer *numlin, char *array, logical *eof, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: readln_ 14 4 4 13 12 124 */ -/*:ref: failed_ 12 0 */ - -extern int readln_(integer *unit, char *line, logical *eof, ftnlen line_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int reccyl_(doublereal *rectan, doublereal *r__, doublereal *long__, doublereal *z__); -/*:ref: twopi_ 7 0 */ - -extern int recgeo_(doublereal *rectan, doublereal *re, doublereal *f, doublereal *long__, doublereal *lat, doublereal *alt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ - -extern int reclat_(doublereal *rectan, doublereal *radius, doublereal *long__, doublereal *lat); - -extern int recpgr_(char *body, doublereal *rectan, doublereal *re, doublereal *f, doublereal *lon, doublereal *lat, doublereal *alt, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int recrad_(doublereal *rectan, doublereal *range, doublereal *ra, doublereal *dec); -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ - -extern int recsph_(doublereal *rectan, doublereal *r__, doublereal *colat, doublereal *long__); - -extern int refchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: rotget_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int remlac_(integer *ne, integer *loc, char *array, integer *na, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remlad_(integer *ne, integer *loc, doublereal *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remlai_(integer *ne, integer *loc, integer *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removi_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remsub_(char *in, integer *left, integer *right, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int reordc_(integer *iorder, integer *ndim, char *array, ftnlen array_len); - -extern int reordd_(integer *iorder, integer *ndim, doublereal *array); - -extern int reordi_(integer *iorder, integer *ndim, integer *array); - -extern int reordl_(integer *iorder, integer *ndim, logical *array); - -extern int replch_(char *instr, char *old, char *new__, char *outstr, ftnlen instr_len, ftnlen old_len, ftnlen new_len, ftnlen outstr_len); - -extern int replwd_(char *instr, integer *nth, char *new__, char *outstr, ftnlen instr_len, ftnlen new_len, ftnlen outstr_len); -/*:ref: nthwd_ 14 6 13 4 13 4 124 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int repmc_(char *in, char *marker, char *value, char *out, ftnlen in_len, ftnlen marker_len, ftnlen value_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmct_(char *in, char *marker, integer *value, char *case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: inttxt_ 14 3 4 13 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmd_(char *in, char *marker, doublereal *value, integer *sigdig, char *out, ftnlen in_len, ftnlen marker_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmf_(char *in, char *marker, doublereal *value, integer *sigdig, char *format, char *out, ftnlen in_len, ftnlen marker_len, ftnlen format_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmi_(char *in, char *marker, integer *value, char *out, ftnlen in_len, ftnlen marker_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmot_(char *in, char *marker, integer *value, char *case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: intord_ 14 3 4 13 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repsub_(char *in, integer *left, integer *right, char *string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ - -extern int reset_(void); -/*:ref: seterr_ 12 1 12 */ -/*:ref: putsms_ 14 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ -/*:ref: accept_ 12 1 12 */ - -extern logical return_(void); -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ - -extern int rjust_(char *input, char *output, ftnlen input_len, ftnlen output_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int rmaind_(doublereal *num, doublereal *denom, doublereal *q, doublereal *rem); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rmaini_(integer *num, integer *denom, integer *q, integer *rem); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rmdupc_(integer *nelt, char *array, ftnlen array_len); -/*:ref: shellc_ 14 3 4 13 124 */ - -extern int rmdupd_(integer *nelt, doublereal *array); -/*:ref: shelld_ 14 2 4 7 */ - -extern int rmdupi_(integer *nelt, integer *array); -/*:ref: shelli_ 14 2 4 4 */ - -extern int rotate_(doublereal *angle, integer *iaxis, doublereal *mout); - -extern int rotget_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynrot_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int rotmat_(doublereal *m1, doublereal *angle, integer *iaxis, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int rotvec_(doublereal *v1, doublereal *angle, integer *iaxis, doublereal *vout); - -extern doublereal rpd_(void); - -extern int rquad_(doublereal *a, doublereal *b, doublereal *c__, doublereal *root1, doublereal *root2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern integer rtrim_(char *string, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern int saelgv_(doublereal *vec1, doublereal *vec2, doublereal *smajor, doublereal *sminor); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: diags2_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern logical samch_(char *str1, integer *l1, char *str2, integer *l2, ftnlen str1_len, ftnlen str2_len); - -extern logical samchi_(char *str1, integer *l1, char *str2, integer *l2, ftnlen str1_len, ftnlen str2_len); -/*:ref: eqchr_ 12 4 13 13 124 124 */ - -extern logical sameai_(integer *a1, integer *a2, integer *ndim); - -extern logical samsbi_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, integer *e2, ftnlen str1_len, ftnlen str2_len); -/*:ref: nechr_ 12 4 13 13 124 124 */ - -extern logical samsub_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, integer *e2, ftnlen str1_len, ftnlen str2_len); - -extern int sc01_(integer *sc, char *clkstr, doublereal *ticks, doublereal *sclkdp, doublereal *et, ftnlen clkstr_len); -extern int sctk01_(integer *sc, char *clkstr, doublereal *ticks, ftnlen clkstr_len); -extern int scfm01_(integer *sc, doublereal *ticks, char *clkstr, ftnlen clkstr_len); -extern int scte01_(integer *sc, doublereal *sclkdp, doublereal *et); -extern int scet01_(integer *sc, doublereal *et, doublereal *sclkdp); -extern int scec01_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ - -extern int scanit_(char *string, integer *start, integer *room, integer *nmarks, char *marks, integer *mrklen, integer *pnters, integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen marks_len); -extern int scanpr_(integer *nmarks, char *marks, integer *mrklen, integer *pnters, ftnlen marks_len); -extern int scan_(char *string, char *marks, integer *mrklen, integer *pnters, integer *room, integer *start, integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen marks_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rmdupc_ 14 3 4 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int scanrj_(integer *ids, integer *n, integer *ntokns, integer *ident, integer *beg, integer *end); -/*:ref: isrchi_ 4 3 4 4 4 */ - -extern int scardc_(integer *card, char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: enchar_ 14 3 4 13 124 */ - -extern int scardd_(integer *card, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scardi_(integer *card, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scdecd_(integer *sc, doublereal *sclkdp, char *sclkch, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: scfmt_ 14 4 4 7 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ - -extern int sce2c_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scec01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sce2s_(integer *sc, doublereal *et, char *sclkch, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sce2t_ 14 3 4 7 7 */ -/*:ref: scdecd_ 14 4 4 7 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sce2t_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scet01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scencd_(integer *sc, char *sclkch, doublereal *sclkdp, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: sctiks_ 14 4 4 13 7 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern int scfmt_(integer *sc, doublereal *ticks, char *clkstr, ftnlen clkstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scfm01_ 14 4 4 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sclu01_(char *name__, integer *sc, integer *maxnv, integer *n, integer *ival, doublereal *dval, ftnlen name_len); -extern int scli01_(char *name__, integer *sc, integer *maxnv, integer *n, integer *ival, ftnlen name_len); -extern int scld01_(char *name__, integer *sc, integer *maxnv, integer *n, doublereal *dval, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ - -extern int scpars_(integer *sc, char *sclkch, logical *error, char *msg, doublereal *sclkdp, ftnlen sclkch_len, ftnlen msg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: scps01_ 14 7 4 13 12 13 7 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ - -extern int scpart_(integer *sc, integer *nparts, doublereal *pstart, doublereal *pstop); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int scps01_(integer *sc, char *clkstr, logical *error, char *msg, doublereal *ticks, ftnlen clkstr_len, ftnlen msg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int scs2e_(integer *sc, char *sclkch, doublereal *et, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scencd_ 14 4 4 13 7 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sct2e_(integer *sc, doublereal *sclkdp, doublereal *et); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scte01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sctiks_(integer *sc, char *clkstr, doublereal *ticks, ftnlen clkstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: sctk01_ 14 4 4 13 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sctran_(char *clknam, integer *clkid, logical *found, ftnlen clknam_len); -extern int scn2id_(char *clknam, integer *clkid, logical *found, ftnlen clknam_len); -extern int scid2n_(integer *clkid, char *clknam, logical *found, ftnlen clknam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern integer sctype_(integer *sc); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sdiffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int sdiffd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sdiffi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical setc_(char *a, char *op, char *b, ftnlen a_len, ftnlen op_len, ftnlen b_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical setd_(doublereal *a, char *op, doublereal *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical seterr_(logical *status); -extern logical failed_(void); - -extern logical seti_(integer *a, char *op, integer *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int setmsg_(char *msg, ftnlen msg_len); -/*:ref: allowd_ 12 0 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int sgfcon_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfpkt_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values, integer *ends); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfref_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfrvi_(integer *handle, doublereal *descr, doublereal *x, doublereal *value, integer *indx, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int sgmeta_(integer *handle, doublereal *descr, integer *mnemon, integer *value); -/*:ref: return_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgseqw_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *npkts, integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal *refdat, integer *idxtyp, ftnlen segid_len); -extern int sgbwfs_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *pktsiz, integer *idxtyp, ftnlen segid_len); -extern int sgbwvs_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *idxtyp, ftnlen segid_len); -extern int sgwfpk_(integer *handle, integer *npkts, doublereal *pktdat, integer *nrefs, doublereal *refdat); -extern int sgwvpk_(integer *handle, integer *npkts, integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal *refdat); -extern int sgwes_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafcad_ 14 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafena_ 14 0 */ - -extern int sharpr_(doublereal *rot); -/*:ref: vhatip_ 14 1 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ - -extern int shellc_(integer *ndim, char *array, ftnlen array_len); -/*:ref: swapc_ 14 4 13 13 124 124 */ - -extern int shelld_(integer *ndim, doublereal *array); -/*:ref: swapd_ 14 2 7 7 */ - -extern int shelli_(integer *ndim, integer *array); -/*:ref: swapi_ 14 2 4 4 */ - -extern int shiftc_(char *in, char *dir, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen dir_len, ftnlen fillc_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: shiftl_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: shiftr_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int shiftl_(char *in, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len); - -extern int shiftr_(char *in, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len); - -extern int sigdgt_(char *in, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ - -extern int sigerr_(char *msg, ftnlen msg_len); -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: seterr_ 12 1 12 */ -/*:ref: putsms_ 14 2 13 124 */ -/*:ref: freeze_ 14 0 */ -/*:ref: outmsg_ 14 2 13 124 */ -/*:ref: accept_ 12 1 12 */ -/*:ref: byebye_ 14 2 13 124 */ - -extern int sincpt_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, logical *found, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: npedln_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern integer sizec_(char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sized_(doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sizei_(integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical smsgnd_(doublereal *x, doublereal *y); - -extern logical smsgni_(integer *x, integer *y); - -extern logical somfls_(logical *logcls, integer *n); - -extern logical somtru_(logical *logcls, integer *n); - -extern int spca2b_(char *text, char *binary, ftnlen text_len, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopr_ 14 3 13 4 124 */ -/*:ref: spct2b_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcac_(integer *handle, integer *unit, char *bmark, char *emark, ftnlen bmark_len, ftnlen emark_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: locln_ 14 10 4 13 13 13 4 4 12 124 124 124 */ -/*:ref: countc_ 4 5 4 4 4 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafarr_ 14 2 4 4 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int spcb2a_(char *binary, char *text, ftnlen binary_len, ftnlen text_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopn_ 14 3 13 4 124 */ -/*:ref: spcb2t_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcb2t_(char *binary, integer *unit, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafb2t_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: spcec_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spcdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrrr_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcec_(integer *handle, integer *unit); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int spcopn_(char *spc, char *ifname, integer *handle, ftnlen spc_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcrfl_(integer *handle, char *line, logical *eoc, ftnlen line_len); -extern int spcrnl_(char *line, logical *eoc, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int spct2b_(integer *unit, char *binary, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daft2b_ 14 4 4 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dafopw_ 14 3 13 4 124 */ -/*:ref: spcac_ 14 6 4 4 13 13 124 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern doublereal spd_(void); - -extern int sphcyl_(doublereal *radius, doublereal *colat, doublereal *slong, doublereal *r__, doublereal *long__, doublereal *z__); - -extern int sphlat_(doublereal *r__, doublereal *colat, doublereal *longs, doublereal *radius, doublereal *long__, doublereal *lat); -/*:ref: halfpi_ 7 0 */ - -extern int sphrec_(doublereal *r__, doublereal *colat, doublereal *long__, doublereal *rectan); - -extern doublereal sphsd_(doublereal *radius, doublereal *long1, doublereal *lat1, doublereal *long2, doublereal *lat2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int spk14a_(integer *handle, integer *ncsets, doublereal *coeffs, doublereal *epochs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ - -extern int spk14b_(integer *handle, char *segid, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, integer *chbdeg, ftnlen segid_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ - -extern int spk14e_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkacs_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: spkaps_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int spkapo_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkgps_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int spkapp_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int spkaps_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkltc_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int spkbsr_(char *fname, integer *handle, integer *body, doublereal *et, doublereal *descr, char *ident, logical *found, ftnlen fname_len, ftnlen ident_len); -extern int spklef_(char *fname, integer *handle, ftnlen fname_len); -extern int spkuef_(integer *handle); -extern int spksfs_(integer *body, doublereal *et, integer *handle, doublereal *descr, char *ident, logical *found, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ - -extern int spkcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spkcov_(char *spk, integer *idcode, doublereal *cover, ftnlen spk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spke01_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spke02_(doublereal *et, doublereal *record, doublereal *xyzdot); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbint_ 14 6 7 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke03_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke05_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke08_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: xposeg_ 14 4 7 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lgresp_ 7 6 4 7 7 7 7 7 */ - -extern int spke09_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: xposeg_ 14 4 7 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ - -extern int spke10_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: ev2lin_ 14 4 7 7 7 7 */ -/*:ref: dpspce_ 14 4 7 7 7 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzeprcss_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke12_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: hrmesp_ 14 8 4 7 7 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke13_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke14_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke15_(doublereal *et, doublereal *recin, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dpr_ 7 0 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: pi_ 7 0 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spke17_(doublereal *et, doublereal *recin, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqncpv_ 14 6 7 7 7 7 7 7 */ - -extern int spke18_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: xpsgip_ 14 3 4 4 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int spkez_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkacs_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: spkltc_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int spkezp_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: spkgps_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: spkapo_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int spkezr_(char *targ, doublereal *et, char *ref, char *abcorr, char *obs, doublereal *starg, doublereal *lt, ftnlen targ_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ - -extern int spkgeo_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int spkgps_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int spkltc_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int spkobj_(char *spk, integer *ids, ftnlen spk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spkopa_(char *file, integer *handle, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafopw_ 14 3 13 4 124 */ - -extern int spkopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkpds_(integer *body, integer *center, char *frame, integer *type__, doublereal *first, doublereal *last, doublereal *descr, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ - -extern int spkpos_(char *targ, doublereal *et, char *ref, char *abcorr, char *obs, doublereal *ptarg, doublereal *lt, ftnlen targ_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ - -extern int spkpv_(integer *handle, doublereal *descr, doublereal *et, char *ref, doublereal *state, integer *center, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkpvn_(integer *handle, doublereal *descr, doublereal *et, integer *ref, doublereal *state, integer *center); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: spkr01_ 14 4 4 7 7 7 */ -/*:ref: spke01_ 14 3 7 7 7 */ -/*:ref: spkr02_ 14 4 4 7 7 7 */ -/*:ref: spke02_ 14 3 7 7 7 */ -/*:ref: spkr03_ 14 4 4 7 7 7 */ -/*:ref: spke03_ 14 3 7 7 7 */ -/*:ref: spkr05_ 14 4 4 7 7 7 */ -/*:ref: spke05_ 14 3 7 7 7 */ -/*:ref: spkr08_ 14 4 4 7 7 7 */ -/*:ref: spke08_ 14 3 7 7 7 */ -/*:ref: spkr09_ 14 4 4 7 7 7 */ -/*:ref: spke09_ 14 3 7 7 7 */ -/*:ref: spkr10_ 14 4 4 7 7 7 */ -/*:ref: spke10_ 14 3 7 7 7 */ -/*:ref: spkr12_ 14 4 4 7 7 7 */ -/*:ref: spke12_ 14 3 7 7 7 */ -/*:ref: spkr13_ 14 4 4 7 7 7 */ -/*:ref: spke13_ 14 3 7 7 7 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkr14_ 14 4 4 7 7 7 */ -/*:ref: spke14_ 14 3 7 7 7 */ -/*:ref: spkr15_ 14 4 4 7 7 7 */ -/*:ref: spke15_ 14 3 7 7 7 */ -/*:ref: spkr17_ 14 4 4 7 7 7 */ -/*:ref: spke17_ 14 3 7 7 7 */ -/*:ref: spkr18_ 14 4 4 7 7 7 */ -/*:ref: spke18_ 14 3 7 7 7 */ - -extern int spkr01_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr02_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr03_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr05_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spkr08_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: odd_ 12 1 4 */ - -extern int spkr09_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: odd_ 12 1 4 */ - -extern int spkr10_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr12_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkr08_ 14 4 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr13_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkr09_ 14 4 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr14_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ - -extern int spkr15_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int spkr17_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int spkr18_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ - -extern int spks01_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks02_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks03_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks05_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks08_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks09_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks10_(integer *srchan, doublereal *srcdsc, integer *dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sgfref_ 14 5 4 7 4 4 7 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ -/*:ref: sgwes_ 14 1 4 */ - -extern int spks12_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spks08_ 14 5 4 4 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks13_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spks09_ 14 5 4 4 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks14_(integer *srchan, doublereal *srcdsc, integer *dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: spk14b_ 14 10 4 13 4 4 13 7 7 4 124 124 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sgfref_ 14 5 4 7 4 4 7 */ -/*:ref: spk14a_ 14 4 4 4 7 7 */ -/*:ref: spk14e_ 14 1 4 */ - -extern int spks15_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks17_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks18_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spkssb_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spksub_(integer *handle, doublereal *descr, char *ident, doublereal *begin, doublereal *end, integer *newh, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: spks01_ 14 5 4 4 4 7 7 */ -/*:ref: dafena_ 14 0 */ -/*:ref: spks02_ 14 5 4 4 4 7 7 */ -/*:ref: spks03_ 14 5 4 4 4 7 7 */ -/*:ref: spks05_ 14 5 4 4 4 7 7 */ -/*:ref: spks08_ 14 5 4 4 4 7 7 */ -/*:ref: spks09_ 14 5 4 4 4 7 7 */ -/*:ref: spks10_ 14 6 4 7 4 7 13 124 */ -/*:ref: spks12_ 14 5 4 4 4 7 7 */ -/*:ref: spks13_ 14 5 4 4 4 7 7 */ -/*:ref: spks14_ 14 6 4 7 4 7 13 124 */ -/*:ref: spks15_ 14 5 4 4 4 7 7 */ -/*:ref: spks17_ 14 5 4 4 4 7 7 */ -/*:ref: spks18_ 14 5 4 4 4 7 7 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int spkuds_(doublereal *descr, integer *body, integer *center, integer *frame, integer *type__, doublereal *first, doublereal *last, integer *begin, integer *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkw01_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *n, doublereal *dlines, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw02_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw03_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw05_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *gm, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw08_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epoch1, doublereal *step, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw09_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw10_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *consts, integer *n, doublereal *elems, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: zzwahr_ 14 2 7 7 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ -/*:ref: sgwes_ 14 1 4 */ - -extern int spkw12_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epoch1, doublereal *step, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw13_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw15_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dpr_ 7 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw17_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *decpol, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw18_(integer *handle, integer *subtyp, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *packts, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int srfrec_(integer *body, doublereal *long__, doublereal *lat, doublereal *rectan); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int srfxpt_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal *spoint, doublereal *dist, doublereal *trgepc, doublereal *obspos, logical *found, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: npedln_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ - -extern int ssizec_(integer *size, char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: enchar_ 14 3 4 13 124 */ - -extern int ssized_(integer *size, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ssizei_(integer *size, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stcc01_(char *catfnm, char *tabnam, logical *istyp1, char *errmsg, ftnlen catfnm_len, ftnlen tabnam_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ekopr_ 14 3 13 4 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekssum_ 14 14 4 4 13 4 4 13 13 4 4 12 12 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: ekcls_ 14 1 4 */ - -extern int stcf01_(char *catnam, doublereal *westra, doublereal *eastra, doublereal *sthdec, doublereal *nthdec, integer *nstars, ftnlen catnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpr_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: ekfind_ 14 6 13 4 12 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stcg01_(integer *index, doublereal *ra, doublereal *dec, doublereal *rasig, doublereal *decsig, integer *catnum, char *sptype, doublereal *vmag, ftnlen sptype_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ekgd_ 14 6 4 4 4 7 12 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekgi_ 14 6 4 4 4 4 12 12 */ -/*:ref: ekgc_ 14 7 4 4 4 13 12 12 124 */ -/*:ref: rpd_ 7 0 */ - -extern int stcl01_(char *catfnm, char *tabnam, integer *handle, ftnlen catfnm_len, ftnlen tabnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: stcc01_ 14 7 13 13 12 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ - -extern int stdio_(char *name__, integer *unit, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stelab_(doublereal *pobj, doublereal *vobs, doublereal *appobj); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int stlabx_(doublereal *pobj, doublereal *vobs, doublereal *corpos); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stmp03_(doublereal *x, doublereal *c0, doublereal *c1, doublereal *c2, doublereal *c3); -/*:ref: dpmax_ 7 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stpool_(char *item, integer *nth, char *contin, char *string, integer *size, logical *found, ftnlen item_len, ftnlen contin_len, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int str2et_(char *string, doublereal *et, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: timdef_ 14 6 13 13 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: tchckd_ 14 2 13 124 */ -/*:ref: tparch_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: jul2gr_ 14 4 4 4 4 4 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ -/*:ref: gr2jul_ 14 4 4 4 4 4 */ - -extern int subpnt_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ - -extern int subpt_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int subslr_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ - -extern int subsol_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: ltime_ 14 7 7 4 13 4 7 7 124 */ -/*:ref: spkpos_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ - -extern int suffix_(char *suff, integer *spaces, char *string, ftnlen suff_len, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern doublereal sumad_(doublereal *array, integer *n); - -extern integer sumai_(integer *array, integer *n); - -extern int surfnm_(doublereal *a, doublereal *b, doublereal *c__, doublereal *point, doublereal *normal); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhatip_ 14 1 7 */ - -extern int surfpt_(doublereal *positn, doublereal *u, doublereal *a, doublereal *b, doublereal *c__, doublereal *point, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int surfpv_(doublereal *stvrtx, doublereal *stdir, doublereal *a, doublereal *b, doublereal *c__, doublereal *stx, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int swapac_(integer *n, integer *locn, integer *m, integer *locm, char *array, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapc_ 14 4 13 13 124 124 */ -/*:ref: cyacip_ 14 6 4 13 4 13 124 124 */ - -extern int swapad_(integer *n, integer *locn, integer *m, integer *locm, doublereal *array); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: cyadip_ 14 5 4 13 4 7 124 */ - -extern int swapai_(integer *n, integer *locn, integer *m, integer *locm, integer *array); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: cyaiip_ 14 5 4 13 4 4 124 */ - -extern int swapc_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int swapd_(doublereal *a, doublereal *b); - -extern int swapi_(integer *a, integer *b); - -extern int sxform_(char *from, char *to, doublereal *et, doublereal *xform, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydelc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydeld_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydeli_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupc_(char *name__, char *copy, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupd_(char *name__, char *copy, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupi_(char *name__, char *copy, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetc_ 14 9 13 13 13 4 13 124 124 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetd_ 14 7 13 7 13 4 7 124 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqi_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: syseti_ 14 7 13 4 13 4 4 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfetc_(integer *nth, char *tabsym, integer *tabptr, char *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen tabval_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfetd_(integer *nth, char *tabsym, integer *tabptr, doublereal *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfeti_(integer *nth, char *tabsym, integer *tabptr, integer *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygetc_(char *name__, char *tabsym, integer *tabptr, char *tabval, integer *n, char *values, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygetd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, integer *n, doublereal *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygeti_(char *name__, char *tabsym, integer *tabptr, integer *tabval, integer *n, integer *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthc_(char *name__, integer *nth, char *tabsym, integer *tabptr, char *tabval, char *value, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthd_(char *name__, integer *nth, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthi_(char *name__, integer *nth, char *tabsym, integer *tabptr, integer *tabval, integer *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shellc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shelld_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shelli_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopc_(char *name__, char *tabsym, integer *tabptr, char *tabval, char *value, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, integer *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetc_ 14 9 13 13 13 4 13 124 124 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetd_ 14 7 13 7 13 4 7 124 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshi_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: syseti_ 14 7 13 4 13 4 4 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syputc_(char *name__, char *values, integer *n, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen values_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ - -extern int syputd_(char *name__, doublereal *values, integer *n, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ - -extern int syputi_(char *name__, integer *values, integer *n, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ - -extern int syrenc_(char *old, char *new__, char *tabsym, integer *tabptr, char *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydelc_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syrend_(char *old, char *new__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydeld_ 14 6 13 13 4 7 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapad_ 14 5 4 4 4 4 7 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syreni_(char *old, char *new__, char *tabsym, integer *tabptr, integer *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydeli_ 14 6 13 13 4 4 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syselc_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, char *tabval, char *values, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseld_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseli_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, integer *tabval, integer *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sysetc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sysetd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseti_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrnc_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapc_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrnd_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrni_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int tcheck_(doublereal *tvec, char *type__, logical *mods, char *modify, logical *ok, char *error, ftnlen type_len, ftnlen modify_len, ftnlen error_len); -extern int tparch_(char *type__, ftnlen type_len); -extern int tchckd_(char *type__, ftnlen type_len); -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int texpyr_(integer *year); -extern int tsetyr_(integer *year); - -extern int timdef_(char *action, char *item, char *value, ftnlen action_len, ftnlen item_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ - -extern int timout_(doublereal *et, char *pictur, char *output, ftnlen pictur_len, ftnlen output_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scanpr_ 14 5 4 13 4 4 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: scan_ 14 12 13 13 4 4 4 4 4 4 4 4 124 124 */ -/*:ref: timdef_ 14 6 13 13 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: scanrj_ 14 6 4 4 4 4 4 4 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: j1950_ 7 0 */ -/*:ref: brckti_ 4 3 4 4 4 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: gr2jul_ 14 4 4 4 4 4 */ -/*:ref: jul2gr_ 14 4 4 4 4 4 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int tipbod_(char *ref, integer *body, doublereal *et, doublereal *tipm, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irftrn_ 14 5 13 13 7 124 124 */ -/*:ref: bodmat_ 14 3 4 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int tisbod_(char *ref, integer *body, doublereal *et, doublereal *tsipm, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckmat_ 14 5 4 7 4 7 12 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: ccifrm_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: failed_ 12 0 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int tkfram_(integer *id, doublereal *rot, integer *frame, logical *found); -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: locati_ 14 6 4 4 4 4 4 12 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: dwpool_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: badkpv_ 12 10 13 13 13 4 4 13 124 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: sharpr_ 14 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ - -extern int tkvrsn_(char *item, char *verstr, ftnlen item_len, ftnlen verstr_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int tostdo_(char *line, ftnlen line_len); -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: writln_ 14 3 13 4 124 */ - -extern H_f touchc_(char *ret_val, ftnlen ret_val_len, char *string, ftnlen string_len); - -extern doublereal touchd_(doublereal *dp); - -extern integer touchi_(integer *int__); - -extern logical touchl_(logical *log__); - -extern int tparse_(char *string, doublereal *sp2000, char *error, ftnlen string_len, ftnlen error_len); -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: j2000_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: rmaini_ 14 4 4 4 4 4 */ - -extern int tpartv_(char *string, doublereal *tvec, integer *ntvec, char *type__, char *modify, logical *mods, logical *yabbrv, logical *succes, char *pictur, char *error, ftnlen string_len, ftnlen type_len, ftnlen modify_len, ftnlen pictur_len, ftnlen error_len); -/*:ref: zztpats_ 12 6 4 4 13 13 124 124 */ -/*:ref: zztokns_ 12 4 13 13 124 124 */ -/*:ref: zzcmbt_ 12 5 13 13 12 124 124 */ -/*:ref: zzsubt_ 12 5 13 13 12 124 124 */ -/*:ref: zzrept_ 12 5 13 13 12 124 124 */ -/*:ref: zzremt_ 12 2 13 124 */ -/*:ref: zzist_ 12 2 13 124 */ -/*:ref: zznote_ 12 4 13 4 4 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzunpck_ 12 11 13 12 7 4 13 13 13 124 124 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: zzvalt_ 12 6 13 4 4 13 124 124 */ -/*:ref: zzgrep_ 12 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzispt_ 12 4 13 4 4 124 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ - -extern int tpictr_(char *sample, char *pictur, logical *ok, char *error, ftnlen sample_len, ftnlen pictur_len, ftnlen error_len); -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ - -extern doublereal trace_(doublereal *matrix); - -extern doublereal traceg_(doublereal *matrix, integer *ndim); - -extern int trcpkg_(integer *depth, integer *index, char *module, char *trace, char *name__, ftnlen module_len, ftnlen trace_len, ftnlen name_len); -extern int chkin_(char *module, ftnlen module_len); -extern int chkout_(char *module, ftnlen module_len); -extern int trcdep_(integer *depth); -extern int trcmxd_(integer *depth); -extern int trcnam_(integer *index, char *name__, ftnlen name_len); -extern int qcktrc_(char *trace, ftnlen trace_len); -extern int freeze_(void); -extern int trcoff_(void); -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int ttrans_(char *from, char *to, doublereal *tvec, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ -/*:ref: reordi_ 14 3 4 4 4 */ -/*:ref: reordl_ 14 3 4 4 12 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rmaini_ 14 4 4 4 4 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: lstlti_ 4 3 4 4 4 */ - -extern doublereal twopi_(void); - -extern int twovec_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *mout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int twovxf_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int txtopn_(char *fname, integer *unit, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int txtopr_(char *fname, integer *unit, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern doublereal tyear_(void); - -extern int ucase_(char *in, char *out, ftnlen in_len, ftnlen out_len); - -extern int ucrss_(doublereal *v1, doublereal *v2, doublereal *vout); -/*:ref: vnorm_ 7 1 7 */ - -extern int uddc_(U_fp udfunc, doublereal *x, doublereal *dx, logical *isdecr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: uddf_ 14 4 200 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int uddf_(S_fp udfunc, doublereal *x, doublereal *dx, doublereal *deriv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ - -extern int unionc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int uniond_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int unioni_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal unitim_(doublereal *epoch, char *insys, char *outsys, ftnlen insys_len, ftnlen outsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: unionc_ 14 6 13 13 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: somfls_ 12 2 12 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: setc_ 12 6 13 13 13 124 124 124 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ - -extern int unorm_(doublereal *v1, doublereal *vout, doublereal *vmag); -/*:ref: vnorm_ 7 1 7 */ - -extern int unormg_(doublereal *v1, integer *ndim, doublereal *vout, doublereal *vmag); -/*:ref: vnormg_ 7 2 7 4 */ - -extern int utc2et_(char *utcstr, doublereal *et, ftnlen utcstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int vadd_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern int vaddg_(doublereal *v1, doublereal *v2, integer *ndim, doublereal *vout); - -extern int validc_(integer *size, integer *n, char *a, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupc_ 14 3 4 13 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ - -extern int validd_(integer *size, integer *n, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ - -extern int validi_(integer *size, integer *n, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupi_ 14 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ - -extern int vcrss_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern doublereal vdist_(doublereal *v1, doublereal *v2); -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern doublereal vdistg_(doublereal *v1, doublereal *v2, integer *ndim); - -extern doublereal vdot_(doublereal *v1, doublereal *v2); - -extern doublereal vdotg_(doublereal *v1, doublereal *v2, integer *ndim); - -extern int vequ_(doublereal *vin, doublereal *vout); - -extern int vequg_(doublereal *vin, integer *ndim, doublereal *vout); - -extern int vhat_(doublereal *v1, doublereal *vout); -/*:ref: vnorm_ 7 1 7 */ - -extern int vhatg_(doublereal *v1, integer *ndim, doublereal *vout); -/*:ref: vnormg_ 7 2 7 4 */ - -extern int vhatip_(doublereal *v); -/*:ref: vnorm_ 7 1 7 */ - -extern int vlcom_(doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *sum); - -extern int vlcom3_(doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *c__, doublereal *v3, doublereal *sum); - -extern int vlcomg_(integer *n, doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *sum); - -extern int vminug_(doublereal *vin, integer *ndim, doublereal *vout); - -extern int vminus_(doublereal *v1, doublereal *vout); - -extern doublereal vnorm_(doublereal *v1); - -extern doublereal vnormg_(doublereal *v1, integer *ndim); - -extern int vpack_(doublereal *x, doublereal *y, doublereal *z__, doublereal *v); - -extern int vperp_(doublereal *a, doublereal *b, doublereal *p); -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int vprjp_(doublereal *vin, doublereal *plane, doublereal *vout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int vprjpi_(doublereal *vin, doublereal *projpl, doublereal *invpl, doublereal *vout, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int vproj_(doublereal *a, doublereal *b, doublereal *p); -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int vprojg_(doublereal *a, doublereal *b, integer *ndim, doublereal *p); -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ - -extern doublereal vrel_(doublereal *v1, doublereal *v2); -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern doublereal vrelg_(doublereal *v1, doublereal *v2, integer *ndim); -/*:ref: vdistg_ 7 3 7 7 4 */ -/*:ref: vnormg_ 7 2 7 4 */ - -extern int vrotv_(doublereal *v, doublereal *axis, doublereal *theta, doublereal *r__); -/*:ref: vnorm_ 7 1 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int vscl_(doublereal *s, doublereal *v1, doublereal *vout); - -extern int vsclg_(doublereal *s, doublereal *v1, integer *ndim, doublereal *vout); - -extern int vsclip_(doublereal *s, doublereal *v); - -extern doublereal vsep_(doublereal *v1, doublereal *v2); -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: pi_ 7 0 */ - -extern doublereal vsepg_(doublereal *v1, doublereal *v2, integer *ndim); -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: pi_ 7 0 */ - -extern int vsub_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern int vsubg_(doublereal *v1, doublereal *v2, integer *ndim, doublereal *vout); - -extern doublereal vtmv_(doublereal *v1, doublereal *matrix, doublereal *v2); - -extern doublereal vtmvg_(doublereal *v1, doublereal *matrix, doublereal *v2, integer *nrow, integer *ncol); - -extern int vupack_(doublereal *v, doublereal *x, doublereal *y, doublereal *z__); - -extern logical vzero_(doublereal *v); - -extern logical vzerog_(doublereal *v, integer *ndim); - -extern integer wdcnt_(char *string, ftnlen string_len); - -extern integer wdindx_(char *string, char *word, ftnlen string_len, ftnlen word_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ - -extern integer wncard_(doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wncomd_(doublereal *left, doublereal *right, doublereal *window, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: failed_ 12 0 */ - -extern int wncond_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wndifd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical wnelmd_(doublereal *point, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnexpd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnextd_(char *side, doublereal *window, ftnlen side_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfetd_(doublereal *window, integer *n, doublereal *left, doublereal *right); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfild_(doublereal *small, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfltd_(doublereal *small, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical wnincd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wninsd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int wnintd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical wnreld_(doublereal *a, char *op, doublereal *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: wnincd_ 12 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnsumd_(doublereal *window, doublereal *meas, doublereal *avg, doublereal *stddev, integer *short__, integer *long__); -/*:ref: return_ 12 0 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: even_ 12 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnunid_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnvald_(integer *size, integer *n, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int wrencc_(integer *unit, integer *n, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrencd_(integer *unit, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dp2hx_ 14 4 7 13 4 124 */ - -extern int wrenci_(integer *unit, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: int2hx_ 14 4 4 13 4 124 */ - -extern int writla_(integer *numlin, char *array, integer *unit, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: writln_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ - -extern int writln_(char *line, integer *unit, ftnlen line_len); -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrkvar_(integer *unit, char *name__, char *dirctv, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen dirctv_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sydimd_ 4 6 13 13 4 7 124 124 */ -/*:ref: synthd_ 14 9 13 4 13 4 7 7 12 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rjust_ 14 4 13 13 124 124 */ -/*:ref: ioerr_ 14 5 13 13 4 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrline_(char *device, char *line, ftnlen device_len, ftnlen line_len); -extern int clline_(char *device, ftnlen device_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: fndlun_ 14 1 4 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int xf2eul_(doublereal *xform, integer *axisa, integer *axisb, integer *axisc, doublereal *eulang, logical *unique); -extern int eul2xf_(doublereal *eulang, integer *axisa, integer *axisb, integer *axisc, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: m2eul_ 14 7 7 4 4 4 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int xf2rav_(doublereal *xform, doublereal *rot, doublereal *av); -/*:ref: mtxm_ 14 3 7 7 7 */ - -extern int xposbl_(doublereal *bmat, integer *nrow, integer *ncol, integer *bsize, doublereal *btmat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int xpose_(doublereal *m1, doublereal *mout); - -extern int xposeg_(doublereal *matrix, integer *nrow, integer *ncol, doublereal *xposem); - -extern int xpsgip_(integer *nrow, integer *ncol, doublereal *matrix); - -extern int zzascii_(char *file, char *line, logical *check, char *termin, ftnlen file_len, ftnlen line_len, ftnlen termin_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzasryel_(char *extrem, doublereal *ellips, doublereal *vertex, doublereal *dir, doublereal *angle, doublereal *extpt, ftnlen extrem_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int zzbodblt_(integer *room, char *names, char *nornam, integer *codes, integer *nvals, char *device, char *reqst, ftnlen names_len, ftnlen nornam_len, ftnlen device_len, ftnlen reqst_len); -extern int zzbodget_(integer *room, char *names, char *nornam, integer *codes, integer *nvals, ftnlen names_len, ftnlen nornam_len); -extern int zzbodlst_(char *device, char *reqst, ftnlen device_len, ftnlen reqst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzidmap_ 14 3 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ - -extern integer zzbodbry_(integer *body); - -extern int zzbodini_(char *names, char *nornam, integer *codes, integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, ftnlen names_len, ftnlen nornam_len); -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ - -extern int zzbodker_(char *names, char *nornam, integer *codes, integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, logical *extker, ftnlen names_len, ftnlen nornam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: zzbodini_ 14 9 13 13 4 4 4 4 4 124 124 */ - -extern int zzbodtrn_(char *name__, integer *code, logical *found, ftnlen name_len); -extern int zzbodn2c_(char *name__, integer *code, logical *found, ftnlen name_len); -extern int zzbodc2n_(integer *code, char *name__, logical *found, ftnlen name_len); -extern int zzboddef_(char *name__, integer *code, ftnlen name_len); -extern int zzbodkik_(void); -extern int zzbodrst_(void); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodget_ 14 7 4 13 13 4 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzbodini_ 14 9 13 13 4 4 4 4 4 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: zzbodker_ 14 10 13 13 4 4 4 4 4 12 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: bschoc_ 4 6 13 4 13 4 124 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzbodvcd_(integer *bodyid, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzck4d2i_(doublereal *dpcoef, integer *nsets, doublereal *parcod, integer *i__); - -extern int zzck4i2d_(integer *i__, integer *nsets, doublereal *parcod, doublereal *dpcoef); - -extern int zzckcv01_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv02_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv03_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv04_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv05_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *dc, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errint_ 14 3 13 7 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckspk_(integer *handle, char *ckspk, ftnlen ckspk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: zzsizeok_ 14 6 4 4 4 4 12 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int zzcln_(integer *lookat, integer *nameat, integer *namlst, integer *datlst, integer *nmpool, integer *chpool, integer *dppool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzcorepc_(char *abcorr, doublereal *et, doublereal *lt, doublereal *etcorr, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzcorsxf_(logical *xmit, doublereal *dlt, doublereal *xform, doublereal *corxfm); -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int zzcputim_(doublereal *tvec); -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzdafgdr_(integer *handle, integer *recno, doublereal *dprec, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlated_ 14 5 4 13 4 7 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzdafgfr_(integer *handle, char *idword, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, logical *found, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlatei_ 14 5 4 13 4 4 124 */ - -extern int zzdafgsr_(integer *handle, integer *recno, integer *nd, integer *ni, doublereal *dprec, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlated_ 14 5 4 13 4 7 124 */ -/*:ref: zzxlatei_ 14 5 4 13 4 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzdafnfr_(integer *lun, char *idword, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzdasnfr_(integer *lun, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzddhclu_(logical *utlck, integer *nut); - -extern int zzddhf2h_(char *fname, integer *ftabs, integer *ftamh, integer *ftarc, integer *ftbff, integer *fthan, char *ftnam, integer *ftrtm, integer *nft, integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut, logical *exists, logical *opened, integer *handle, logical *found, ftnlen fname_len, ftnlen ftnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzddhgtu_ 14 6 4 4 12 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzddhrmu_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzddhgsd_(char *class__, integer *id, char *label, ftnlen class_len, ftnlen label_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzddhgtu_(integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut, integer *uindex); -/*:ref: return_ 12 0 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: frelun_ 14 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzddhini_(integer *natbff, integer *supbff, integer *numsup, char *stramh, char *strarc, char *strbff, ftnlen stramh_len, ftnlen strarc_len, ftnlen strbff_len); -/*:ref: return_ 12 0 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ - -extern int zzddhivf_(char *nsum, integer *bff, logical *found, ftnlen nsum_len); - -extern int zzddhman_(logical *lock, char *arch, char *fname, char *method, integer *handle, integer *unit, integer *intamh, integer *intarc, integer *intbff, logical *native, logical *found, logical *kill, ftnlen arch_len, ftnlen fname_len, ftnlen method_len); -extern int zzddhopn_(char *fname, char *method, char *arch, integer *handle, ftnlen fname_len, ftnlen method_len, ftnlen arch_len); -extern int zzddhcls_(integer *handle, char *arch, logical *kill, ftnlen arch_len); -extern int zzddhhlu_(integer *handle, char *arch, logical *lock, integer *unit, ftnlen arch_len); -extern int zzddhunl_(integer *handle, char *arch, ftnlen arch_len); -extern int zzddhnfo_(integer *handle, char *fname, integer *intarc, integer *intbff, integer *intamh, logical *found, ftnlen fname_len); -extern int zzddhisn_(integer *handle, logical *native, logical *found); -extern int zzddhfnh_(char *fname, integer *handle, logical *found, ftnlen fname_len); -extern int zzddhluh_(integer *unit, integer *handle, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhini_ 14 9 4 4 4 13 13 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzpltchk_ 14 1 12 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzddhclu_ 4 2 12 4 */ -/*:ref: zzddhf2h_ 14 20 13 4 4 4 4 4 13 4 4 4 4 12 4 4 12 12 4 12 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: zzddhrcm_ 14 3 4 4 4 */ -/*:ref: zzddhgtu_ 14 6 4 4 12 4 4 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: zzddhppf_ 14 3 4 4 4 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzddhrmu_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: frelun_ 14 1 4 */ - -extern int zzddhppf_(integer *unit, integer *arch, integer *bff); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzftpchk_ 14 3 13 12 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzddhivf_ 14 4 13 4 12 124 */ - -extern int zzddhrcm_(integer *nut, integer *utcst, integer *reqcnt); -/*:ref: intmax_ 4 0 */ - -extern int zzddhrmu_(integer *uindex, integer *nft, integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: reslun_ 14 1 4 */ - -extern int zzdynbid_(char *frname, integer *frcode, char *item, integer *idcode, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzdynfid_(char *frname, integer *frcode, char *item, integer *idcode, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: prsint_ 14 3 13 4 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzdynfr0_(integer *infram, integer *center, doublereal *et, doublereal *xform, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxmg_ 14 6 7 7 4 4 4 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkez1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkzp1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynfrm_(integer *infram, integer *center, doublereal *et, doublereal *xform, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxmg_ 14 6 7 7 4 4 4 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkez0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkzp0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynoac_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, char *values, logical *found, ftnlen frname_len, ftnlen item_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ - -extern int zzdynoad_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, doublereal *values, logical *found, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzdynrot_(integer *infram, integer *center, doublereal *et, doublereal *rotate, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkzp0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzspkez0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynrt0_(integer *infram, integer *center, doublereal *et, doublereal *rotate, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkzp1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzspkez1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynvac_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, char *values, ftnlen frname_len, ftnlen item_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ - -extern int zzdynvad_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, doublereal *values, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzdynvai_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, integer *values, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzedterm_(char *type__, doublereal *a, doublereal *b, doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer *npts, doublereal *trmpts, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ - -extern int zzekac01_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, logical *nlflgs, integer *rcptrs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekordi_ 14 5 4 12 12 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac02_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, logical *nlflgs, integer *rcptrs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: zzekordd_ 14 5 7 12 12 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac03_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekordc_ 14 6 13 12 12 4 4 124 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac04_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, integer *entszs, logical *nlflgs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac05_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, integer *entszs, logical *nlflgs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac06_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, integer *entszs, logical *nlflgs, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac07_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, logical *nlflgs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordi_ 14 5 4 12 12 4 4 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekac08_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, logical *nlflgs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordd_ 14 5 7 12 12 4 4 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekac09_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, logical *nlflgs, integer *wkindx, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordc_ 14 6 13 12 12 4 4 124 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekacps_(integer *handle, integer *segdsc, integer *type__, integer *n, integer *p, integer *base); -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekad01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzekiii1_ 14 6 4 4 4 4 4 12 */ - -extern int zzekad02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzekiid1_ 14 6 4 4 4 7 4 12 */ - -extern int zzekad03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekiic1_ 14 7 4 4 4 13 4 12 124 */ - -extern int zzekad04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, integer *ivals, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekad05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekad06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, ftnlen cvals_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekaps_(integer *handle, integer *segdsc, integer *type__, logical *new__, integer *p, integer *base); -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekbs01_(integer *handle, char *tabnam, integer *ncols, char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekcix1_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekbs02_(integer *handle, char *tabnam, integer *ncols, char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekcchk_(char *query, integer *eqryi, char *eqryc, integer *ntab, char *tablst, char *alslst, integer *base, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen tablst_len, ftnlen alslst_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzekcdsc_(integer *handle, integer *segdsc, char *column, integer *coldsc, ftnlen column_len); -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekcix1_(integer *handle, integer *coldsc); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrit_ 14 2 4 4 */ - -extern int zzekcnam_(integer *handle, integer *coldsc, char *column, ftnlen column_len); -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekde01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekdps_(integer *handle, integer *segdsc, integer *type__, integer *p); -/*:ref: zzekpgfr_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzektrls_ 4 3 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ - -extern integer zzekecmp_(integer *hans, integer *sgdscs, integer *cldscs, integer *rows, integer *elts); -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ - -extern int zzekencd_(char *query, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpars_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: zzeknres_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: zzektres_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: zzeksemc_ 14 9 13 4 13 12 13 4 124 124 124 */ - -extern int zzekerc1_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, integer *prvptr, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekerd1_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekeri1_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern integer zzekesiz_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: zzeksz04_ 4 4 4 4 4 4 */ -/*:ref: zzeksz05_ 4 4 4 4 4 4 */ -/*:ref: zzeksz06_ 4 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekff01_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekfrx_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *pos); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: zzeklerc_ 14 9 4 4 4 13 4 12 4 4 124 */ -/*:ref: zzeklerd_ 14 8 4 4 4 7 4 12 4 4 */ -/*:ref: zzekleri_ 14 8 4 4 4 4 4 12 4 4 */ - -extern int zzekgcdp_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *datptr); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgei_(integer *handle, integer *addrss, integer *ival); -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ - -extern int zzekgfwd_(integer *handle, integer *type__, integer *p, integer *fward); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekglnk_(integer *handle, integer *type__, integer *p, integer *nlinks); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgrcp_(integer *handle, integer *recptr, integer *ptr); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgrs_(integer *handle, integer *recptr, integer *status); -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekif01_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksdec_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekif02_(integer *handle, integer *segno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekiic1_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzeklerc_ 14 9 4 4 4 13 4 12 4 4 124 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzekiid1_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzeklerd_ 14 8 4 4 4 7 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzekiii1_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekleri_ 14 8 4 4 4 4 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern integer zzekille_(integer *handle, integer *segdsc, integer *coldsc, integer *nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekllec_ 14 7 4 4 4 13 4 4 124 */ -/*:ref: zzeklled_ 14 6 4 4 4 7 4 4 */ -/*:ref: zzekllei_ 14 6 4 4 4 4 4 4 */ - -extern integer zzekillt_(integer *handle, integer *segdsc, integer *coldsc, integer *nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeklltc_ 14 7 4 4 4 13 4 4 124 */ -/*:ref: zzeklltd_ 14 6 4 4 4 7 4 4 */ -/*:ref: zzekllti_ 14 6 4 4 4 4 4 4 */ - -extern int zzekinqc_(char *value, integer *length, integer *lexbeg, integer *lexend, integer *eqryi, char *eqryc, integer *descr, ftnlen value_len, ftnlen eqryc_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekinqn_(doublereal *value, integer *type__, integer *lexbeg, integer *lexend, integer *eqryi, doublereal *eqryd, integer *descr); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekixdl_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekfrx_ 14 5 4 4 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekixlk_(integer *handle, integer *coldsc, integer *key, integer *recptr); -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekjoin_(integer *jbase1, integer *jbase2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *jbase3, integer *nrows); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjprp_ 14 23 4 4 4 4 4 4 4 4 4 4 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekjnxt_ 14 2 12 4 */ - -extern int zzekjsqz_(integer *jrsbas); -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ - -extern int zzekjsrt_(integer *njrs, integer *ubases, integer *norder, integer *otabs, integer *ocols, integer *oelts, integer *senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *ordbas); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzekvcal_ 14 3 4 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: zzekvcmp_ 12 15 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ - -extern int zzekjtst_(integer *segvec, integer *jbase1, integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, logical *found, integer *rowvec); -extern int zzekjprp_(integer *segvec, integer *jbase1, integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs); -extern int zzekjnxt_(logical *found, integer *rowvec); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjsrt_ 14 13 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekrcmp_ 12 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekvmch_ 12 13 4 12 4 4 4 4 4 4 4 4 4 4 4 */ - -extern int zzekkey_(integer *handle, integer *segdsc, integer *nrows, integer *ncnstr, integer *clidxs, integer *dsclst, integer *ops, integer *dtypes, char *chrbuf, integer *cbegs, integer *cends, doublereal *dvals, integer *ivals, logical *active, integer *key, integer *keydsc, integer *begidx, integer *endidx, logical *found, ftnlen chrbuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: zzekillt_ 4 9 4 4 4 4 4 13 7 4 124 */ -/*:ref: zzekille_ 4 9 4 4 4 4 4 13 7 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ordi_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ - -extern int zzeklerc_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, integer *prvptr, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekerc1_ 14 9 4 4 4 13 4 12 4 4 124 */ - -extern int zzeklerd_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekerd1_ 14 8 4 4 4 7 4 12 4 4 */ - -extern int zzekleri_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekeri1_ 14 8 4 4 4 4 4 12 4 4 */ - -extern int zzekllec_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklled_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekllei_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklltc_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklltd_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekllti_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekmloc_(integer *handle, integer *segno, integer *page, integer *base); -/*:ref: eknseg_ 4 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ - -extern int zzeknres_(char *query, integer *eqryi, char *eqryc, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: ekntab_ 14 1 4 */ -/*:ref: ektnam_ 14 3 4 13 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: zzekcchk_ 14 15 13 4 13 4 13 13 4 12 13 4 124 124 124 124 124 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzeknrml_(char *query, integer *ntoken, integer *lxbegs, integer *lxends, integer *tokens, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektloc_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: zzekinqn_ 14 7 7 4 4 4 4 7 4 */ -/*:ref: zzekinqc_ 14 9 13 4 4 4 4 13 4 124 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: lnkhl_ 4 2 4 4 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekordc_(char *cvals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder, ftnlen cvals_len); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekordd_(doublereal *dvals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekordi_(integer *ivals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekpage_(integer *handle, integer *type__, integer *addrss, char *stat, integer *p, char *pagec, doublereal *paged, integer *pagei, integer *base, integer *value, ftnlen stat_len, ftnlen pagec_len); -extern int zzekpgin_(integer *handle); -extern int zzekpgan_(integer *handle, integer *type__, integer *p, integer *base); -extern int zzekpgal_(integer *handle, integer *type__, integer *p, integer *base); -extern int zzekpgfr_(integer *handle, integer *type__, integer *p); -extern int zzekpgrc_(integer *handle, integer *p, char *pagec, ftnlen pagec_len); -extern int zzekpgrd_(integer *handle, integer *p, doublereal *paged); -extern int zzekpgri_(integer *handle, integer *p, integer *pagei); -extern int zzekpgwc_(integer *handle, integer *p, char *pagec, ftnlen pagec_len); -extern int zzekpgwd_(integer *handle, integer *p, doublereal *paged); -extern int zzekpgwi_(integer *handle, integer *p, integer *pagei); -extern int zzekpgbs_(integer *type__, integer *p, integer *base); -extern int zzekpgpg_(integer *type__, integer *addrss, integer *p, integer *base); -extern int zzekpgst_(integer *handle, char *stat, integer *value, ftnlen stat_len); -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: fillc_ 14 5 13 4 13 124 124 */ -/*:ref: filld_ 14 3 7 4 7 */ -/*:ref: filli_ 14 3 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: dasadc_ 14 6 4 4 4 4 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasadd_ 14 3 4 4 7 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzekpars_(char *query, integer *ntoken, integer *lxbegs, integer *lxends, integer *tokens, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektloc_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: zzekinqc_ 14 9 13 4 4 4 4 13 4 124 124 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: zzeknrml_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ - -extern int zzekpcol_(char *qcol, integer *eqryi, char *eqryc, char *table, char *alias, integer *tabidx, char *column, integer *colidx, logical *error, char *errmsg, ftnlen qcol_len, ftnlen eqryc_len, ftnlen table_len, ftnlen alias_len, ftnlen column_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ - -extern int zzekpdec_(char *decl, integer *pardsc, ftnlen decl_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern int zzekpgch_(integer *handle, char *access, ftnlen access_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ - -extern int zzekqcnj_(integer *eqryi, integer *n, integer *size); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqcon_(integer *eqryi, char *eqryc, doublereal *eqryd, integer *n, integer *cnstyp, char *ltname, integer *ltidx, char *lcname, integer *lcidx, integer *opcode, char *rtname, integer *rtidx, char *rcname, integer *rcidx, integer *dtype, integer *cbeg, integer *cend, doublereal *dval, integer *ival, ftnlen eqryc_len, ftnlen ltname_len, ftnlen lcname_len, ftnlen rtname_len, ftnlen rcname_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqini_(integer *isize, integer *dsize, integer *eqryi, char *eqryc, doublereal *eqryd, ftnlen eqryc_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ - -extern int zzekqord_(integer *eqryi, char *eqryc, integer *n, char *table, integer *tabidx, char *column, integer *colidx, integer *sense, ftnlen eqryc_len, ftnlen table_len, ftnlen column_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqsel_(integer *eqryi, char *eqryc, integer *n, integer *lxbeg, integer *lxend, char *table, integer *tabidx, char *column, integer *colidx, ftnlen eqryc_len, ftnlen table_len, ftnlen column_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqtab_(integer *eqryi, char *eqryc, integer *n, char *table, char *alias, ftnlen eqryc_len, ftnlen table_len, ftnlen alias_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekrbck_(char *action, integer *handle, integer *segdsc, integer *coldsc, integer *recno, ftnlen action_len); - -extern logical zzekrcmp_(integer *op, integer *ncols, integer *han1, integer *sgdsc1, integer *cdlst1, integer *row1, integer *elts1, integer *han2, integer *sgdsc2, integer *cdlst2, integer *row2, integer *elts2); -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrd01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekrd02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzekrd04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, integer *ivals, logical *isnull, logical *found); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, doublereal *dvals, logical *isnull, logical *found); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, char *cvals, logical *isnull, logical *found, ftnlen cvals_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekrd07_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekrd08_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ - -extern int zzekrd09_(integer *handle, integer *segdsc, integer *coldsc, integer *recno, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekreqi_(integer *eqryi, char *name__, integer *value, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical zzekrmch_(integer *ncnstr, logical *active, integer *handle, integer *segdsc, integer *cdscrs, integer *row, integer *elts, integer *ops, integer *vtypes, char *chrbuf, integer *cbegs, integer *cends, doublereal *dvals, integer *ivals, ftnlen chrbuf_len); -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern integer zzekrp2n_(integer *handle, integer *segno, integer *recptr); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrls_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrplk_(integer *handle, integer *segdsc, integer *n, integer *recptr); -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrsc_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, integer *cvlen, char *cval, logical *isnull, logical *found, ftnlen cval_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd03_ 14 8 4 4 4 4 4 13 12 124 */ -/*:ref: zzekrd06_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrd09_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int zzekrsd_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, doublereal *dval, logical *isnull, logical *found); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekrd05_ 14 9 4 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrd08_ 14 6 4 4 4 4 7 12 */ - -extern int zzekrsi_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, integer *ival, logical *isnull, logical *found); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekrd04_ 14 9 4 4 4 4 4 4 4 12 12 */ -/*:ref: zzekrd07_ 14 6 4 4 4 4 4 12 */ - -extern int zzeksca_(integer *n, integer *beg, integer *end, integer *idata, integer *top); -extern int zzekstop_(integer *top); -extern int zzekspsh_(integer *n, integer *idata); -extern int zzekspop_(integer *n, integer *idata); -extern int zzeksdec_(integer *n); -extern int zzeksupd_(integer *beg, integer *end, integer *idata); -extern int zzeksrd_(integer *beg, integer *end, integer *idata); -extern int zzekscln_(void); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int zzekscan_(char *query, integer *maxntk, integer *maxnum, integer *ntoken, integer *tokens, integer *lxbegs, integer *lxends, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, logical *scnerr, char *errmsg, ftnlen query_len, ftnlen chrbuf_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: lxcsid_ 14 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lxqstr_ 14 7 13 13 4 4 4 124 124 */ -/*:ref: parsqs_ 14 11 13 13 13 4 12 13 4 124 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: lx4num_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: lxidnt_ 14 6 4 13 4 4 4 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: frstpc_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int zzekscdp_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *datptr); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern logical zzekscmp_(integer *op, integer *handle, integer *segdsc, integer *coldsc, integer *row, integer *eltidx, integer *dtype, char *cval, doublereal *dval, integer *ival, logical *null, ftnlen cval_len); -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ - -extern int zzeksdsc_(integer *handle, integer *segno, integer *segdsc); -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzeksei_(integer *handle, integer *addrss, integer *ival); -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzeksemc_(char *query, integer *eqryi, char *eqryc, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzeksfwd_(integer *handle, integer *type__, integer *p, integer *fward); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksinf_(integer *handle, integer *segno, char *tabnam, integer *segdsc, char *cnames, integer *cdscrs, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekslnk_(integer *handle, integer *type__, integer *p, integer *nlinks); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksrcp_(integer *handle, integer *recptr, integer *recno); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksrs_(integer *handle, integer *recptr, integer *status); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern integer zzekstyp_(integer *ncols, integer *cdscrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzeksz04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern integer zzeksz05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ - -extern integer zzeksz06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ - -extern int zzektcnv_(char *timstr, doublereal *et, logical *error, char *errmsg, ftnlen timstr_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: scn2id_ 14 4 13 4 12 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scpars_ 14 7 4 13 12 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: str2et_ 14 3 13 7 124 */ - -extern int zzektloc_(integer *tokid, integer *kwcode, integer *ntoken, integer *tokens, integer *values, integer *loc, logical *found); - -extern int zzektr13_(integer *handle, integer *tree); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektr1s_(integer *handle, integer *tree, integer *size, integer *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzektr23_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx, logical *overfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektr31_(integer *handle, integer *tree); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektr32_(integer *handle, integer *tree, integer *left, integer *middle, integer *right, integer *parent, integer *lpkidx, logical *undrfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektrap_(integer *handle, integer *tree, integer *value, integer *key); -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzektrbn_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzektrrk_ 14 7 4 4 4 4 4 4 4 */ - -extern integer zzektrbs_(integer *node); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ - -extern int zzektrdl_(integer *handle, integer *tree, integer *key); -/*:ref: zzektrud_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrsb_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrrk_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: zzektrbn_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzektrki_ 14 5 4 4 4 4 4 */ -/*:ref: zzektr32_ 14 8 4 4 4 4 4 4 4 12 */ -/*:ref: zzektr31_ 14 2 4 4 */ - -extern int zzektrdp_(integer *handle, integer *tree, integer *key, integer *ptr); -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ - -extern int zzektres_(char *query, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzektcnv_ 14 6 13 7 12 13 124 124 */ -/*:ref: zzekinqn_ 14 7 7 4 4 4 4 7 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzektrfr_(integer *handle, integer *tree); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektrin_(integer *handle, integer *tree, integer *key, integer *value); -/*:ref: zzektrui_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: zzektrbn_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzektrki_ 14 5 4 4 4 4 4 */ -/*:ref: zzektr23_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: zzektr13_ 14 2 4 4 */ - -extern int zzektrit_(integer *handle, integer *tree); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzektrki_(integer *handle, integer *tree, integer *nodkey, integer *n, integer *key); -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrlk_(integer *handle, integer *tree, integer *key, integer *idx, integer *node, integer *noffst, integer *level, integer *value); -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern integer zzektrls_(integer *handle, integer *tree, integer *ival); -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ - -extern integer zzektrnk_(integer *handle, integer *tree, integer *node); -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrpi_(integer *handle, integer *tree, integer *key, integer *parent, integer *pkey, integer *poffst, integer *lpidx, integer *lpkey, integer *lsib, integer *rpidx, integer *rpkey, integer *rsib); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern int zzektrrk_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx, integer *nrot); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektrsb_(integer *handle, integer *tree, integer *key, integer *lsib, integer *lkey, integer *rsib, integer *rkey); -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern integer zzektrsz_(integer *handle, integer *tree); -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrud_(integer *handle, integer *tree, integer *key, integer *trgkey, logical *undrfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzektrui_(integer *handle, integer *tree, integer *key, integer *value, logical *overfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ - -extern int zzekue01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekiii1_ 14 6 4 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekad01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekue02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekiid1_ 14 6 4 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekad02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekue03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde03_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad03_ 14 7 4 4 4 4 13 12 124 */ - -extern int zzekue04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, integer *ivals, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde04_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad04_ 14 7 4 4 4 4 4 4 12 */ - -extern int zzekue05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde05_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad05_ 14 7 4 4 4 4 4 7 12 */ - -extern int zzekue06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde06_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int zzekvadr_(integer *njrs, integer *bases, integer *rwvidx, integer *rwvbas, integer *sgvbas); -extern int zzekvset_(integer *njrs, integer *bases); -extern int zzekvcal_(integer *rwvidx, integer *rwvbas, integer *sgvbas); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern logical zzekvcmp_(integer *op, integer *ncols, integer *tabs, integer *cols, integer *elts, integer *senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *sgvec1, integer *rwvec1, integer *sgvec2, integer *rwvec2); -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical zzekvmch_(integer *ncnstr, logical *active, integer *lhans, integer *lsdscs, integer *lcdscs, integer *lrows, integer *lelts, integer *ops, integer *rhans, integer *rsdscs, integer *rcdscs, integer *rrows, integer *relts); -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ - -extern int zzekweed_(integer *njrs, integer *bases, integer *nrows); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: sameai_ 12 3 4 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjsqz_ 14 1 4 */ - -extern int zzekweqi_(char *name__, integer *value, integer *eqryi, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekwpac_(integer *handle, integer *segdsc, integer *nvals, integer *l, char *cvals, integer *p, integer *base, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ - -extern int zzekwpai_(integer *handle, integer *segdsc, integer *nvals, integer *ivals, integer *p, integer *base); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekwpal_(integer *handle, integer *segdsc, integer *nvals, logical *lvals, integer *p, integer *base); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzelvupy_(doublereal *ellips, doublereal *vertex, doublereal *axis, integer *n, doublereal *bounds, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: repmot_ 14 9 13 13 4 13 13 124 124 124 124 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: zzwind_ 4 4 7 4 7 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: inelpl_ 14 5 7 7 4 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzenut80_(doublereal *et, doublereal *nutxf); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzwahr_ 14 2 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzeprc76_(doublereal *et, doublereal *precxf); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ - -extern int zzeprcss_(doublereal *et, doublereal *precm); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ - -extern int zzfdat_(integer *ncount, char *name__, integer *idcode, integer *center, integer *type__, integer *typid, integer *norder, integer *corder, integer *centrd, ftnlen name_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ - -extern int zzfovaxi_(char *inst, integer *n, doublereal *bounds, doublereal *axis, ftnlen inst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: zzhullax_ 14 5 13 4 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vhatip_ 14 1 7 */ - -extern int zzfrmch0_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzfrmgt0_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int zzfrmch1_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzfrmgt1_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int zzfrmgt0_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynfr0_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ - -extern int zzfrmgt1_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ - -extern int zzftpchk_(char *string, logical *ftperr, ftnlen string_len); -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: zzrbrkst_ 14 10 13 13 13 13 4 12 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int zzftpstr_(char *tstcom, char *lend, char *rend, char *delim, ftnlen tstcom_len, ftnlen lend_len, ftnlen rend_len, ftnlen delim_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int zzgapool_(char *varnam, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agtset, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtset_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ - -extern int zzgetbff_(integer *bffid); - -extern int zzgetelm_(integer *frstyr, char *lines, doublereal *epoch, doublereal *elems, logical *ok, char *error, ftnlen lines_len, ftnlen error_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ - -extern int zzgfcoq_(char *vecdef, char *method, integer *trgid, doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, doublereal *dvec, char *crdsys, integer *ctrid, doublereal *re, doublereal *f, char *crdnam, doublereal *value, logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: subpnt_ 14 14 13 13 7 13 13 13 7 7 7 124 124 124 124 124 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ - -extern int zzgfcost_(char *vecdef, char *method, integer *trgid, doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzgfssob_ 14 11 13 4 7 13 13 4 7 7 124 124 124 */ -/*:ref: zzgfssin_ 14 16 13 4 7 13 13 4 13 4 7 7 7 12 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgfcou_(char *vecdef, char *method, char *target, doublereal *et, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, logical *decres, logical *lssthn, doublereal *crdval, logical *crdfnd, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -extern int zzgfcoin_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -extern int zzgfcour_(doublereal *refval); -extern int zzgfcog_(doublereal *et, doublereal *crdval); -extern int zzgfcolt_(doublereal *et, logical *lssthn); -extern int zzgfcodc_(doublereal *et, logical *decres); -extern int zzgfcoex_(doublereal *et, logical *crdfnd); -extern int zzgfcocg_(doublereal *et, doublereal *crdval); -extern int zzgfcosg_(doublereal *et, doublereal *crdval); -extern int zzgfcocl_(doublereal *et, logical *lssthn); -extern int zzgfcosl_(doublereal *et, logical *lssthn); -extern int zzgfcocd_(doublereal *et, logical *decres); -extern int zzgfcosd_(doublereal *et, logical *decres); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzgfcoq_ 14 23 13 13 4 7 13 13 4 13 7 13 4 7 7 13 7 12 124 124 124 124 124 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: zzgfcost_ 14 18 13 13 4 7 13 13 4 13 4 7 7 7 12 124 124 124 124 124 */ -/*:ref: zzgfcprx_ 14 7 7 13 7 7 4 4 124 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ - -extern int zzgfcprx_(doublereal *state, char *corsys, doublereal *re, doublereal *f, integer *sense, integer *cdsign, ftnlen corsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: zzrtnmat_ 14 2 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzgfcslv_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, integer *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal *result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: zzgfcoin_ 14 20 13 13 13 13 13 13 13 7 13 13 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wncond_ 14 3 7 7 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzgflong_ 14 37 13 13 13 13 13 13 13 7 13 13 13 7 7 7 200 200 12 214 200 214 12 212 4 4 7 7 7 124 124 124 124 124 124 124 124 124 124 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 200 200 13 7 7 7 7 4 4 7 12 214 200 214 13 13 12 212 7 124 124 124 */ - -extern int zzgfdiq_(integer *targid, doublereal *et, char *abcorr, integer *obsid, doublereal *dist, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vnorm_ 7 1 7 */ - -extern int zzgfdiu_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *et, logical *decres, logical *lssthn, doublereal *dist, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfdiin_(char *target, char *abcorr, char *obsrvr, doublereal *refval, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfdiur_(doublereal *refval); -extern int zzgfdidc_(doublereal *et, logical *decres); -extern int zzgfdigq_(doublereal *et, doublereal *dist); -extern int zzgfdilt_(doublereal *et, logical *lssthn); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzgfdiq_ 14 6 4 7 13 4 7 124 */ - -extern int zzgfdsps_(integer *nlead, char *string, char *fmt, integer *ntrail, ftnlen string_len, ftnlen fmt_len); -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgffvu_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, doublereal *time, logical *vistat, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgffvin_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgffvst_(doublereal *time, logical *vistat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: getfov_ 14 9 4 4 13 13 7 4 7 124 124 */ -/*:ref: zzfovaxi_ 14 5 13 4 7 7 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: dpr_ 7 0 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: edlimb_ 14 5 7 7 7 7 7 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: zzelvupy_ 14 6 7 7 7 4 7 12 */ -/*:ref: zzocced_ 4 5 7 7 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzwind2d_ 4 3 4 7 7 */ - -extern int zzgflong_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, U_fp udrepi, U_fp udrepu, U_fp udrepf, logical *bail, L_fp udbail, integer *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal *result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: zzgfcoin_ 14 20 13 13 13 13 13 13 13 7 13 13 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 214 200 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: zzgfcosg_ 14 2 7 7 */ -/*:ref: zzgfcocg_ 14 2 7 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: smsgnd_ 12 2 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzgfcog_ 14 2 7 7 */ -/*:ref: wnunid_ 14 3 7 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ - -extern int zzgfocu_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *obsrvr, char *abcorr, doublereal *time, logical *ocstat, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len); -extern int zzgfocin_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *obsrvr, char *abcorr, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len); -extern int zzgfocst_(doublereal *time, logical *ocstat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: minad_ 14 4 7 4 7 4 */ -/*:ref: maxad_ 14 4 7 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: zzocced_ 4 5 7 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ - -extern int zzgfref_(doublereal *refval); -/*:ref: zzholdd_ 14 3 13 7 124 */ - -extern int zzgfrel_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen rptsuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wnextd_ 14 3 13 7 124 */ -/*:ref: zzgfwsts_ 14 5 7 7 13 7 124 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzgfrelx_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen rptsuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolvx_ 14 14 214 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wnextd_ 14 3 13 7 124 */ -/*:ref: zzgfwsts_ 14 5 7 7 13 7 124 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzgfrpwk_(integer *unit, doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, doublereal *incr, ftnlen begin_len, ftnlen end_len); -extern int zzgftswk_(doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len); -extern int zzgfwkin_(doublereal *incr); -extern int zzgfwkad_(doublereal *freq, integer *tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len); -extern int zzgfwkun_(integer *unit); -extern int zzgfwkmo_(integer *unit, doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, doublereal *incr, ftnlen begin_len, ftnlen end_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: zzcputim_ 14 1 7 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: zzgfdsps_ 14 6 4 13 13 4 124 124 */ -/*:ref: writln_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ - -extern int zzgfrrq_(doublereal *et, integer *targ, integer *obs, char *abcorr, doublereal *value, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvnorm_ 7 1 7 */ - -extern int zzgfrru_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *et, doublereal *dt, logical *decres, logical *lssthn, doublereal *rvl, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfrrin_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *dt, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfrrur_(doublereal *refval); -extern int zzgfrrdc_(doublereal *et, logical *decres); -extern int zzgfrrgq_(doublereal *et, doublereal *rvl); -extern int zzgfrrlt_(doublereal *et, logical *lssthn); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzgfrrq_ 14 6 7 4 4 13 7 124 */ - -extern int zzgfsolv_(S_fp udcond, S_fp udstep, S_fp udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ - -extern int zzgfsolvx_(U_fp udfunc, S_fp udcond, S_fp udstep, S_fp udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ - -extern int zzgfspq_(doublereal *et, integer *targ1, integer *targ2, doublereal *r1, doublereal *r2, integer *obs, char *abcorr, char *ref, doublereal *value, ftnlen abcorr_len, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int zzgfspu_(char *of, char *from, char *shape, char *frame, doublereal *refval, doublereal *et, char *abcorr, logical *decres, logical *lssthn, doublereal *sep, ftnlen of_len, ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len); -extern int zzgfspin_(char *of, char *from, char *shape, char *frame, doublereal *refval, char *abcorr, ftnlen of_len, ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len); -extern int zzgfspur_(doublereal *refval); -extern int zzgfspdc_(doublereal *et, logical *decres); -extern int zzgfgsep_(doublereal *et, doublereal *sep); -extern int zzgfsplt_(doublereal *et, logical *lssthn); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzgftreb_ 14 2 4 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: dvsep_ 7 2 7 7 */ -/*:ref: dhfa_ 7 2 7 7 */ -/*:ref: zzgfspq_ 14 11 7 4 4 7 7 4 13 13 7 124 124 */ - -extern int zzgfssin_(char *method, integer *trgid, doublereal *et, char *fixref, char *abcorr, integer *obsid, char *dref, integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, logical *found, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: surfpv_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: spkacs_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzcorsxf_ 14 4 12 7 7 7 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzgfssob_(char *method, integer *trgid, doublereal *et, char *fixref, char *abcorr, integer *obsid, doublereal *radii, doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: surfpv_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: subpnt_ 14 14 13 13 7 13 13 13 7 7 7 124 124 124 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: sxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzcorsxf_ 14 4 12 7 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzgftreb_(integer *body, doublereal *axes); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgfudlt_(S_fp udfunc, doublereal *et, logical *isless); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzholdd_ 14 3 13 7 124 */ - -extern int zzgfwsts_(doublereal *wndw1, doublereal *wndw2, char *inclsn, doublereal *wndw3, ftnlen inclsn_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: scardd_ 14 2 4 7 */ - -extern int zzgpnm_(integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *found, integer *lookat, integer *nameat, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzholdd_(char *op, doublereal *value, ftnlen op_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzhullax_(char *inst, integer *n, doublereal *bounds, doublereal *axis, ftnlen inst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ - -extern int zzidmap_(integer *bltcod, char *bltnam, ftnlen bltnam_len); - -extern int zzinssub_(char *in, char *sub, integer *loc, char *out, ftnlen in_len, ftnlen sub_len, ftnlen out_len); - -extern int zzldker_(char *file, char *nofile, char *filtyp, integer *handle, ftnlen file_len, ftnlen nofile_len, ftnlen filtyp_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: spklef_ 14 3 13 4 124 */ -/*:ref: cklpf_ 14 3 13 4 124 */ -/*:ref: pcklof_ 14 3 13 4 124 */ -/*:ref: tkvrsn_ 14 4 13 13 124 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ -/*:ref: ldpool_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzbodkik_ 14 0 */ - -extern int zzmkpc_(char *pictur, integer *b, integer *e, char *mark, char *pattrn, ftnlen pictur_len, ftnlen mark_len, ftnlen pattrn_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int zzmobliq_(doublereal *et, doublereal *mob, doublereal *dmob); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ - -extern int zzmsxf_(doublereal *matrix, integer *n, doublereal *output); - -extern int zznofcon_(doublereal *et, integer *frame1, integer *endp1, integer *frame2, integer *endp2, char *errmsg, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: repmf_ 14 10 13 13 7 4 13 13 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ - -extern int zznrddp_(doublereal *ao, doublereal *elems, doublereal *em, doublereal *omgasm, doublereal *omgdot, doublereal *t, doublereal *xinc, doublereal *xll, doublereal *xlldot, doublereal *xn, doublereal *xnodes, doublereal *xnodot, doublereal *xnodp); -extern int zzdpinit_(doublereal *ao, doublereal *xlldot, doublereal *omgdot, doublereal *xnodot, doublereal *xnodp, doublereal *elems); -extern int zzdpsec_(doublereal *xll, doublereal *omgasm, doublereal *xnodes, doublereal *em, doublereal *xinc, doublereal *xn, doublereal *t, doublereal *elems, doublereal *omgdot); -extern int zzdpper_(doublereal *t, doublereal *em, doublereal *xinc, doublereal *omgasm, doublereal *xnodes, doublereal *xll); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: j1950_ 7 0 */ -/*:ref: zzsecprt_ 14 12 4 7 7 7 7 7 7 7 7 7 7 7 */ - -extern int zznwpool_(char *varnam, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agtwrk, char *notify, char *agents, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtwrk_len, ftnlen notify_len, ftnlen agents_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzgapool_ 14 10 13 13 4 4 13 13 124 124 124 124 */ -/*:ref: unionc_ 14 6 13 13 13 124 124 124 */ -/*:ref: copyc_ 14 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzocced_(doublereal *viewpt, doublereal *centr1, doublereal *semax1, doublereal *centr2, doublereal *semax2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: det_ 7 1 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: edlimb_ 14 5 7 7 7 7 7 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: zzasryel_ 14 7 13 7 7 7 7 7 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: pi_ 7 0 */ - -extern integer zzphsh_(char *word, integer *m, integer *m2, ftnlen word_len); -extern integer zzshsh_(integer *m); -extern integer zzhash_(char *word, ftnlen word_len); -extern integer zzhash2_(char *word, integer *m2, ftnlen word_len); -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzpini_(logical *first, integer *maxvar, integer *maxval, integer *maxlin, char *begdat, char *begtxt, integer *nmpool, integer *dppool, integer *chpool, integer *namlst, integer *datlst, integer *maxagt, integer *mxnote, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agents, char *active, char *notify, ftnlen begdat_len, ftnlen begtxt_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agents_len, ftnlen active_len, ftnlen notify_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzshsh_ 4 1 4 */ -/*:ref: touchi_ 4 1 4 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: clearc_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzplatfm_(char *key, char *value, ftnlen key_len, ftnlen value_len); -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzpltchk_(logical *ok); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: zzgetbff_ 14 1 4 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzprscor_(char *abcorr, logical *attblk, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ -/*:ref: reordl_ 14 3 4 4 12 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzrbrkst_(char *string, char *lftend, char *rgtend, char *substr, integer *length, logical *bkpres, ftnlen string_len, ftnlen lftend_len, ftnlen rgtend_len, ftnlen substr_len); -/*:ref: posr_ 4 5 13 13 4 124 124 */ - -extern int zzrefch0_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzrotgt0_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int zzrefch1_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzrotgt1_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int zzrepsub_(char *in, integer *left, integer *right, char *string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len); -/*:ref: sumai_ 4 2 4 4 */ - -extern logical zzrept_(char *sub, char *replac, logical *l2r, ftnlen sub_len, ftnlen replac_len); -/*:ref: zzsubt_ 12 5 13 13 12 124 124 */ -/*:ref: zzremt_ 12 2 13 124 */ - -extern int zzrotgt0_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynrt0_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzrotgt1_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzrtnmat_(doublereal *v, doublereal *m); -/*:ref: return_ 12 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ - -extern int zzrvar_(integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *eof, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: rdkdat_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rdklin_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int zzrvbf_(char *buffer, integer *bsize, integer *linnum, integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *eof, ftnlen buffer_len, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int zzrxr_(doublereal *matrix, integer *n, doublereal *output); -/*:ref: ident_ 14 1 7 */ - -extern logical zzsclk_(integer *ckid, integer *sclkid); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: removi_ 14 2 4 4 */ - -extern int zzsecprt_(integer *isynfl, doublereal *dg, doublereal *del, doublereal *xni, doublereal *omegao, doublereal *atime, doublereal *omgdot, doublereal *xli, doublereal *xfact, doublereal *xldot, doublereal *xndot, doublereal *xnddt); - -extern int zzsizeok_(integer *size, integer *psize, integer *dsize, integer *offset, logical *ok, integer *n); -/*:ref: rmaini_ 14 4 4 4 4 4 */ - -extern int zzspkac0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzspkas0_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int zzspkac1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzspkas1_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int zzspkap0_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkap1_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkas0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspklt0_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int zzspkas1_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspklt1_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int zzspkez0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkac0_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzspklt0_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int zzspkez1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: zzspkac1_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzspklt1_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int zzspkgo0_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgo1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgp0_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgp1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspklt0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzspklt1_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzspkpa0_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgp0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkpa1_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgp1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspksb0_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzspksb1_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzspkzp0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzspkgp0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzspkpa0_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzspkzp1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzspkgp1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzspkpa1_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzstelab_(logical *xmit, doublereal *accobs, doublereal *vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr); -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ - -extern logical zztime_(char *string, char *transl, char *letter, char *error, char *pic, doublereal *tvec, integer *b, integer *e, logical *l2r, logical *yabbrv, ftnlen string_len, ftnlen transl_len, ftnlen letter_len, ftnlen error_len, ftnlen pic_len); -extern logical zzcmbt_(char *string, char *letter, logical *l2r, ftnlen string_len, ftnlen letter_len); -extern logical zzgrep_(char *string, ftnlen string_len); -extern logical zzispt_(char *string, integer *b, integer *e, ftnlen string_len); -extern logical zzist_(char *letter, ftnlen letter_len); -extern logical zznote_(char *letter, integer *b, integer *e, ftnlen letter_len); -extern logical zzremt_(char *letter, ftnlen letter_len); -extern logical zzsubt_(char *string, char *transl, logical *l2r, ftnlen string_len, ftnlen transl_len); -extern logical zztokns_(char *string, char *error, ftnlen string_len, ftnlen error_len); -extern logical zzunpck_(char *string, logical *yabbrv, doublereal *tvec, integer *e, char *transl, char *pic, char *error, ftnlen string_len, ftnlen transl_len, ftnlen pic_len, ftnlen error_len); -extern logical zzvalt_(char *string, integer *b, integer *e, char *letter, ftnlen string_len, ftnlen letter_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: samsbi_ 12 8 13 4 4 13 4 4 124 124 */ -/*:ref: samchi_ 12 6 13 4 13 4 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzmkpc_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern logical zztpats_(integer *room, integer *nknown, char *known, char *meanng, ftnlen known_len, ftnlen meanng_len); -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ - -extern int zztwovxf_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: ducrss_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vzero_ 12 1 7 */ - -extern int zzutcpm_(char *string, integer *start, doublereal *hoff, doublereal *moff, integer *last, logical *succes, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ - -extern int zzvalcor_(char *abcorr, logical *attblk, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzvstrng_(doublereal *x, char *fill, integer *from, integer *to, logical *rnd, integer *expont, char *substr, logical *did, ftnlen fill_len, ftnlen substr_len); -extern int zzvststr_(doublereal *x, char *fill, integer *expont, ftnlen fill_len); -extern int zzvsbstr_(integer *from, integer *to, logical *rnd, char *substr, logical *did, ftnlen substr_len); -/*:ref: dpstr_ 14 4 7 4 13 124 */ - -extern int zzwahr_(doublereal *et, doublereal *dvnut); -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: spd_ 7 0 */ - -extern integer zzwind_(doublereal *plane, integer *n, doublereal *vertcs, doublereal *point); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ - -extern integer zzwind2d_(integer *n, doublereal *vertcs, doublereal *point); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vsepg_ 7 3 7 7 4 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: twopi_ 7 0 */ - -extern int zzwninsd_(doublereal *left, doublereal *right, char *context, doublereal *window, ftnlen context_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzxlated_(integer *inbff, char *input, integer *space, doublereal *output, ftnlen input_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzxlatei_(integer *inbff, char *input, integer *space, integer *output, ftnlen input_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errint_ 14 3 13 4 124 */ - - -#ifdef __cplusplus - } -#endif - -#endif - diff --git a/ext/spice/include/SpiceZim.h b/ext/spice/include/SpiceZim.h deleted file mode 100644 index ee8d96ebc6..0000000000 --- a/ext/spice/include/SpiceZim.h +++ /dev/null @@ -1,1358 +0,0 @@ -/* - --Header_File SpiceZim.h ( CSPICE interface macros ) - --Abstract - - Define interface macros to be called in place of CSPICE - user-interface-level functions. These macros are generally used - to compensate for compiler deficiencies. - --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. - --Literature_References - - None. - --Particulars - - This header file defines interface macros to be called in place of - CSPICE user-interface-level functions. Currently, the sole purpose - of these macros is to implement automatic type casting under some - environments that generate compile-time warnings without the casts. - The typical case that causes a problem is a function argument list - containing an input formal argument of type - - const double [3][3] - - Under some compilers, a non-const actual argument supplied in a call - to such a function will generate a spurious warning due to the - "mismatched" type. These macros generate type casts that will - make such compilers happy. - - Examples of compilers that generate warnings of this type are - - gcc version 2.2.2, hosted on NeXT workstations running - NeXTStep 3.3 - - Sun C compiler, version 4.2, running under Solaris. - - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 11.0.0, 09-MAR-2009 (NJB) (EDW) - - Added macros for - - dvsep_c - gfevnt_c - gffove_c - gfrfov_c - gfsntc_c - surfpv_c - - - -CSPICE Version 10.0.0, 19-FEB-2008 (NJB) (EDW) - - Added macros for - - ilumin_c - spkaps_c - spkltc_c - - -CSPICE Version 9.0.0, 31-OCT-2005 (NJB) - - Added macros for - - qdq2av_c - qxq_c - - -CSPICE Version 8.0.0, 23-FEB-2004 (NJB) - - Added macro for - - dafrs_c - - - -CSPICE Version 7.0.0, 23-FEB-2004 (EDW) - - Added macro for - - srfxpt_c - - -CSPICE Version 6.0.1, 25-FEB-2003 (EDW) (NJB) - - Remove duplicate macro definitions for ekaced_c and - ekacei_c. Visual Studio errored out when compiling - code that included SpiceZim.h. - - Added macro for - - dasac_c - - -CSPICE Version 6.0.0, 17-AUG-2002 (NJB) - - Added macros for - - bschoc_c - bschoi_c - bsrchc_c - bsrchd_c - bsrchi_c - esrchc_c - isordv_c - isrchc_c - isrchd_c - isrchi_c - lstltc_c - lstltd_c - lstlti_c - lstlec_c - lstled_c - lstlei_c - orderc_c - orderd_c - orderi_c - reordc_c - reordd_c - reordi_c - reordl_c - spkw18_c - - -CSPICE Version 5.0.0, 28-AUG-2001 (NJB) - - Added macros for - - conics_c - illum_c - invort_c - pdpool_c - prop2b_c - q2m_c - spkuds_c - xposeg_c - - -CSPICE Version 4.0.0, 22-MAR-2000 (NJB) - - Added macros for - - spkw12_c - spkw13_c - - -CSPICE Version 3.0.0, 27-AUG-1999 (NJB) (EDW) - - Fixed cut & paste error in macro nvp2pl_c. - - Added macros for - - axisar_c - cgv2el_c - dafps_c - dafus_c - diags2_c - dvdot_c - dvhat_c - edlimb_c - ekacli_c - ekacld_c - ekacli_c - eul2xf_c - el2cgv_c - getelm_c - inedpl_c - isrot_c - mequ_c - npedln_c - nplnpt_c - rav2xf_c - raxisa_c - saelgv_c - spk14a_c - spkapo_c - spkapp_c - spkw02_c - spkw03_c - spkw05_c - spkw08_c - spkw09_c - spkw10_c - spkw15_c - spkw17_c - sumai_c - trace_c - vadd_g - vhatg_c - vlcomg_c - vminug_c - vrel_c - vrelg_c - vsepg_c - vtmv_c - vtmvg_c - vupack_c - vzerog_c - xf2eul_c - xf2rav_c - - -CSPICE Version 2.0.0, 07-MAR-1999 (NJB) - - Added macros for - - inrypl_c - nvc2pl_c - nvp2pl_c - pl2nvc_c - pl2nvp_c - pl2psv_c - psv2pl_c - vprjp_c - vprjpi_c - - -CSPICE Version 1.0.0, 24-JAN-1999 (NJB) (EDW) - - --Index_Entries - - interface macros for CSPICE functions - -*/ - - -/* -Include Files: -*/ - - -#ifndef HAVE_SPICEDEFS_H -#include "SpiceZdf.h" -#endif - -#ifndef HAVE_SPICEIFMACROS_H -#define HAVE_SPICEIFMACROS_H - - -/* -Macros used to abbreviate type casts: -*/ - - #define CONST_BOOL ( ConstSpiceBoolean * ) - #define CONST_ELLIPSE ( ConstSpiceEllipse * ) - #define CONST_IVEC ( ConstSpiceInt * ) - #define CONST_MAT ( ConstSpiceDouble (*) [3] ) - #define CONST_MAT2 ( ConstSpiceDouble (*) [2] ) - #define CONST_MAT6 ( ConstSpiceDouble (*) [6] ) - #define CONST_PLANE ( ConstSpicePlane * ) - #define CONST_VEC3 ( ConstSpiceDouble (*) [3] ) - #define CONST_VEC4 ( ConstSpiceDouble (*) [4] ) - #define CONST_STR ( ConstSpiceChar * ) - #define CONST_VEC ( ConstSpiceDouble * ) - #define CONST_VOID ( const void * ) - -/* -Macros that substitute for function calls: -*/ - - #define axisar_c( axis, angle, r ) \ - \ - ( axisar_c( CONST_VEC(axis), (angle), (r) ) ) - - - #define bschoc_c( value, ndim, lenvals, array, order ) \ - \ - ( bschoc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array), CONST_IVEC(order) ) ) - - - #define bschoi_c( value, ndim, array, order ) \ - \ - ( bschoi_c ( (value) , (ndim), \ - CONST_IVEC(array), CONST_IVEC(order) ) ) - - - #define bsrchc_c( value, ndim, lenvals, array ) \ - \ - ( bsrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define bsrchd_c( value, ndim, array ) \ - \ - ( bsrchd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define bsrchi_c( value, ndim, array ) \ - \ - ( bsrchi_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define ckw01_c( handle, begtim, endtim, inst, ref, avflag, \ - segid, nrec, sclkdp, quats, avvs ) \ - \ - ( ckw01_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(sclkdp), CONST_VEC4(quats), \ - CONST_VEC3(avvs) ) ) - - - #define ckw02_c( handle, begtim, endtim, inst, ref, segid, \ - nrec, start, stop, quats, avvs, rates ) \ - \ - ( ckw02_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(start), CONST_VEC(stop), \ - CONST_VEC4(quats), CONST_VEC3(avvs), \ - CONST_VEC(rates) ) ) - - - #define ckw03_c( handle, begtim, endtim, inst, ref, avflag, \ - segid, nrec, sclkdp, quats, avvs, nints, \ - starts ) \ - \ - ( ckw03_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(sclkdp), CONST_VEC4(quats), \ - CONST_VEC3(avvs), (nints), \ - CONST_VEC(starts) ) ) - - - #define ckw05_c( handle, subtyp, degree, begtim, endtim, inst, \ - ref, avflag, segid, n, sclkdp, packts, \ - rate, nints, starts ) \ - \ - ( ckw05_c ( (handle), (subtyp), (degree), \ - (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (n), \ - CONST_VEC(sclkdp), CONST_VOID(packts), \ - (rate), (nints), \ - CONST_VEC(starts) ) ) - - - #define cgv2el_c( center, vec1, vec2, ellipse ) \ - \ - ( cgv2el_c( CONST_VEC(center), CONST_VEC(vec1), \ - CONST_VEC(vec2), (ellipse) ) ) - - - #define conics_c( elts, et, state ) \ - \ - ( conics_c( CONST_VEC(elts), (et), (state) ) ) - - - #define dafps_c( nd, ni, dc, ic, sum ) \ - \ - ( dafps_c ( (nd), (ni), CONST_VEC(dc), CONST_IVEC(ic), \ - (sum) ) ) - - - #define dafrs_c( sum ) \ - \ - ( dafrs_c ( CONST_VEC( sum ) ) ) - - - #define dafus_c( sum, nd, ni, dc, ic ) \ - \ - ( dafus_c ( CONST_VEC(sum), (nd), (ni), (dc), (ic) ) ) - - - #define dasac_c( handle, n, buflen, buffer ) \ - \ - ( dasac_c ( (handle), (n), (buflen), CONST_VOID(buffer) ) ) - - - #define det_c( m1 ) \ - \ - ( det_c ( CONST_MAT(m1) ) ) - - - #define diags2_c( symmat, diag, rotate ) \ - \ - ( diags2_c ( CONST_MAT2(symmat), (diag), (rotate) ) ) - - - - #define dvdot_c( s1, s2 ) \ - \ - ( dvdot_c ( CONST_VEC(s1), CONST_VEC(s2) ) ) - - - #define dvhat_c( v1, v2 ) \ - \ - ( dvhat_c ( CONST_VEC(v1), (v2) ) ) - - - #define dvsep_c( s1, s2 ) \ - \ - ( dvsep_c ( CONST_VEC(s1), CONST_VEC(s2) ) ) - - - #define edlimb_c( a, b, c, viewpt, limb ) \ - \ - ( edlimb_c( (a), (b), (c), CONST_VEC(viewpt), (limb) ) ) - - - #define ekacec_c( handle, segno, recno, column, nvals, vallen, \ - cvals, isnull ) \ - \ - ( ekacec_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), (vallen), CONST_VOID(cvals), \ - (isnull) ) ) - - - #define ekaced_c( handle, segno, recno, column, nvals, \ - dvals, isnull ) \ - \ - ( ekaced_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VEC(dvals), (isnull) ) ) - - - #define ekacei_c( handle, segno, recno, column, nvals, \ - ivals, isnull ) \ - \ - ( ekacei_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_IVEC(ivals), (isnull) ) ) - - - #define ekaclc_c( handle, segno, column, vallen, cvals, entszs, \ - nlflgs, rcptrs, wkindx ) \ - \ - ( ekaclc_c( (handle), (segno), (column), (vallen), \ - CONST_VOID(cvals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekacld_c( handle, segno, column, dvals, entszs, nlflgs, \ - rcptrs, wkindx ) \ - \ - ( ekacld_c( (handle), (segno), (column), \ - CONST_VEC(dvals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekacli_c( handle, segno, column, ivals, entszs, nlflgs, \ - rcptrs, wkindx ) \ - \ - ( ekacli_c( (handle), (segno), (column), \ - CONST_IVEC(ivals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekbseg_c( handle, tabnam, ncols, cnmlen, cnames, declen, \ - decls, segno ) \ - \ - ( ekbseg_c( (handle), (tabnam), (ncols), (cnmlen), \ - CONST_VOID(cnames), (declen), \ - CONST_VOID(decls), (segno) ) ) - - - #define ekifld_c( handle, tabnam, ncols, nrows, cnmlen, cnames, \ - declen, decls, segno, rcptrs ) \ - \ - ( ekifld_c( (handle), (tabnam), (ncols), (nrows), (cnmlen), \ - CONST_VOID(cnames), (declen), \ - CONST_VOID(decls), (segno), (rcptrs) ) ) - - - #define ekucec_c( handle, segno, recno, column, nvals, vallen, \ - cvals, isnull ) \ - \ - ( ekucec_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), (vallen), CONST_VOID(cvals), \ - (isnull) ) ) - - #define ekuced_c( handle, segno, recno, column, nvals, \ - dvals, isnull ) \ - \ - ( ekuced_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VOID(dvals), (isnull) ) ) - - - #define ekucei_c( handle, segno, recno, column, nvals, \ - ivals, isnull ) \ - \ - ( ekucei_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VOID(ivals), (isnull) ) ) - - - #define el2cgv_c( ellipse, center, smajor, sminor ) \ - \ - ( el2cgv_c( CONST_ELLIPSE(ellipse), (center), \ - (smajor), (sminor) ) ) - - - #define esrchc_c( value, ndim, lenvals, array ) \ - \ - ( esrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define eul2xf_c( eulang, axisa, axisb, axisc, xform ) \ - \ - ( eul2xf_c ( CONST_VEC(eulang), (axisa), (axisb), (axisc), \ - (xform) ) ) - - - #define getelm_c( frstyr, lineln, lines, epoch, elems ) \ - \ - ( getelm_c ( (frstyr), (lineln), CONST_VOID(lines), \ - (epoch), (elems) ) ) - - - #define gfevnt_c( udstep, udrefn, gquant, qnpars, lenvals, \ - qpnams, qcpars, qdpars, qipars, qlpars, \ - op, refval, tol, adjust, rpt, \ - udrepi, udrepu, udrepf, nintvls, \ - bail, udbail, cnfine, result ) \ - \ - ( gfevnt_c( (udstep), (udrefn), (gquant), \ - (qnpars), (lenvals), CONST_VOID(qpnams),\ - CONST_VOID(qcpars), (qdpars), (qipars), \ - (qlpars), (op), (refval), \ - (tol), (adjust), (rpt), \ - (udrepi), (udrepu), (udrepf), \ - (nintvls), (bail), \ - (udbail), (cnfine), (result) ) ) - - - #define gffove_c( inst, tshape, raydir, target, tframe, \ - abcorr, obsrvr, tol, udstep, udrefn, \ - rpt, udrepi, udrepu, udrepf, bail, \ - udbail, cnfine, result ) \ - \ - ( gffove_c( (inst), (tshape), CONST_VEC(raydir), \ - (target), (tframe), (abcorr), \ - (obsrvr), (tol), (udstep), \ - (udrefn), (rpt), (udrepi), \ - (udrepu), (udrepf), (bail), \ - (udbail), (cnfine), (result) ) ) - - - #define gfrfov_c( inst, raydir, rframe, abcorr, obsrvr, \ - step, cnfine, result ) \ - \ - ( gfrfov_c( (inst), CONST_VEC(raydir), (rframe), \ - (abcorr), (obsrvr), (step), \ - (cnfine), (result) ) ) - - - #define gfsntc_c( target, fixref, method, abcorr, obsrvr, \ - dref, dvec, crdsys, coord, relate, \ - refval, adjust, step, nintvls, cnfine, \ - result ) \ - \ - ( gfsntc_c( (target), (fixref), (method), \ - (abcorr), (obsrvr), (dref), \ - CONST_VEC(dvec), (crdsys), (coord), \ - (relate), (refval), (adjust), \ - (step), (nintvls), (cnfine), (result) ) ) - - - #define illum_c( target, et, abcorr, obsrvr, \ - spoint, phase, solar, emissn ) \ - \ - ( illum_c ( (target), (et), (abcorr), (obsrvr), \ - CONST_VEC(spoint), (phase), (solar), (emissn) ) ) - - - #define ilumin_c( method, target, et, fixref, \ - abcorr, obsrvr, spoint, trgepc, \ - srfvec, phase, solar, emissn ) \ - \ - ( ilumin_c ( (method), (target), (et), (fixref), \ - (abcorr), (obsrvr), CONST_VEC(spoint), (trgepc), \ - (srfvec), (phase), (solar), (emissn) ) ) - - - #define inedpl_c( a, b, c, plane, ellipse, found ) \ - \ - ( inedpl_c ( (a), (b), (c), \ - CONST_PLANE(plane), (ellipse), (found) ) ) - - - #define inrypl_c( vertex, dir, plane, nxpts, xpt ) \ - \ - ( inrypl_c ( CONST_VEC(vertex), CONST_VEC(dir), \ - CONST_PLANE(plane), (nxpts), (xpt) ) ) - - - #define invert_c( m1, m2 ) \ - \ - ( invert_c ( CONST_MAT(m1), (m2) ) ) - - - #define invort_c( m, mit ) \ - \ - ( invort_c ( CONST_MAT(m), (mit) ) ) - - - #define isordv_c( array, n ) \ - \ - ( isordv_c ( CONST_IVEC(array), (n) ) ) - - - #define isrchc_c( value, ndim, lenvals, array ) \ - \ - ( isrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - #define isrchd_c( value, ndim, array ) \ - \ - ( isrchd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define isrchi_c( value, ndim, array ) \ - \ - ( isrchi_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define isrot_c( m, ntol, dtol ) \ - \ - ( isrot_c ( CONST_MAT(m), (ntol), (dtol) ) ) - - - #define lmpool_c( cvals, lenvals, n ) \ - \ - ( lmpool_c( CONST_VOID(cvals), (lenvals), (n) ) ) - - - #define lstltc_c( value, ndim, lenvals, array ) \ - \ - ( lstltc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define lstled_c( value, ndim, array ) \ - \ - ( lstled_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define lstlei_c( value, ndim, array ) \ - \ - ( lstlei_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define lstlec_c( value, ndim, lenvals, array ) \ - \ - ( lstlec_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define lstltd_c( value, ndim, array ) \ - \ - ( lstltd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define lstlti_c( value, ndim, array ) \ - \ - ( lstlti_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define m2eul_c( r, axis3, axis2, axis1, \ - angle3, angle2, angle1 ) \ - \ - ( m2eul_c ( CONST_MAT(r), (axis3), (axis2), (axis1), \ - (angle3), (angle2), (angle1) ) ) - - #define m2q_c( r, q ) \ - \ - ( m2q_c ( CONST_MAT(r), (q) ) ) - - - #define mequ_c( m1, m2 ) \ - \ - ( mequ_c ( CONST_MAT(m1), m2 ) ) - - - #define mequg_c( m1, nr, nc, mout ) \ - \ - ( mequg_c ( CONST_MAT(m1), (nr), (nc), mout ) ) - - - #define mtxm_c( m1, m2, mout ) \ - \ - ( mtxm_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mtxmg_c( m1, m2, ncol1, nr1r2, ncol2, mout ) \ - \ - ( mtxmg_c ( CONST_MAT(m1), CONST_MAT(m2), \ - (ncol1), (nr1r2), (ncol2), (mout) ) ) - - - #define mtxv_c( m1, vin, vout ) \ - \ - ( mtxv_c ( CONST_MAT(m1), CONST_VEC(vin), (vout) ) ) - - - #define mtxvg_c( m1, v2, nrow1, nc1r2, vout ) \ - \ - ( mtxvg_c( CONST_VOID(m1), CONST_VOID(v2), \ - (nrow1), (nc1r2), (vout) ) ) - - #define mxm_c( m1, m2, mout ) \ - \ - ( mxm_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mxmg_c( m1, m2, row1, col1, col2, mout ) \ - \ - ( mxmg_c ( CONST_VOID(m1), CONST_VOID(m2), \ - (row1), (col1), (col2), (mout) ) ) - - - #define mxmt_c( m1, m2, mout ) \ - \ - ( mxmt_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mxmtg_c( m1, m2, nrow1, nc1c2, nrow2, mout ) \ - \ - ( mxmtg_c ( CONST_VOID(m1), CONST_VOID(m2), \ - (nrow1), (nc1c2), \ - (nrow2), (mout) ) ) - - - #define mxv_c( m1, vin, vout ) \ - \ - ( mxv_c ( CONST_MAT(m1), CONST_VEC(vin), (vout) ) ) - - - #define mxvg_c( m1, v2, nrow1, nc1r2, vout ) \ - \ - ( mxvg_c( CONST_VOID(m1), CONST_VOID(v2), \ - (nrow1), (nc1r2), (vout) ) ) - - #define nearpt_c( positn, a, b, c, npoint, alt ) \ - \ - ( nearpt_c ( CONST_VEC(positn), (a), (b), (c), \ - (npoint), (alt) ) ) - - - #define npedln_c( a, b, c, linept, linedr, pnear, dist ) \ - \ - ( npedln_c ( (a), (b), (c), \ - CONST_VEC(linept), CONST_VEC(linedr), \ - (pnear), (dist) ) ) - - - #define nplnpt_c( linpt, lindir, point, pnear, dist ) \ - \ - ( nplnpt_c ( CONST_VEC(linpt), CONST_VEC(lindir), \ - CONST_VEC(point), (pnear), (dist ) ) ) - - - #define nvc2pl_c( normal, constant, plane ) \ - \ - ( nvc2pl_c ( CONST_VEC(normal), (constant), (plane) ) ) - - - #define nvp2pl_c( normal, point, plane ) \ - \ - ( nvp2pl_c( CONST_VEC(normal), CONST_VEC(point), (plane) ) ) - - - #define orderc_c( lenvals, array, ndim, iorder ) \ - \ - ( orderc_c ( (lenvals), CONST_VOID(array), (ndim), (iorder)) ) - - - #define orderd_c( array, ndim, iorder ) \ - \ - ( orderd_c ( CONST_VEC(array), (ndim), (iorder) ) ) - - - #define orderi_c( array, ndim, iorder ) \ - \ - ( orderi_c ( CONST_IVEC(array), (ndim), (iorder) ) ) - - - #define oscelt_c( state, et, mu, elts ) \ - \ - ( oscelt_c ( CONST_VEC(state), (et), (mu), (elts) ) ) - - - #define pcpool_c( name, n, lenvals, cvals ) \ - \ - ( pcpool_c ( (name), (n), (lenvals), CONST_VOID(cvals) ) ) - - - #define pdpool_c( name, n, dvals ) \ - \ - ( pdpool_c ( (name), (n), CONST_VEC(dvals) ) ) - - - #define pipool_c( name, n, ivals ) \ - \ - ( pipool_c ( (name), (n), CONST_IVEC(ivals) ) ) - - - #define pl2nvc_c( plane, normal, constant ) \ - \ - ( pl2nvc_c ( CONST_PLANE(plane), (normal), (constant) ) ) - - - #define pl2nvp_c( plane, normal, point ) \ - \ - ( pl2nvp_c ( CONST_PLANE(plane), (normal), (point) ) ) - - - #define pl2psv_c( plane, point, span1, span2 ) \ - \ - ( pl2psv_c( CONST_PLANE(plane), (point), (span1), (span2) ) ) - - - #define prop2b_c( gm, pvinit, dt, pvprop ) \ - \ - ( prop2b_c ( (gm), CONST_VEC(pvinit), (dt), (pvprop) ) ) - - - #define psv2pl_c( point, span1, span2, plane ) \ - \ - ( psv2pl_c ( CONST_VEC(point), CONST_VEC(span1), \ - CONST_VEC(span2), (plane) ) ) - - - #define qdq2av_c( q, dq, av ) \ - \ - ( qdq2av_c ( CONST_VEC(q), CONST_VEC(dq), (av) ) ) - - - #define q2m_c( q, r ) \ - \ - ( q2m_c ( CONST_VEC(q), (r) ) ) - - - #define qxq_c( q1, q2, qout ) \ - \ - ( qxq_c ( CONST_VEC(q1), CONST_VEC(q2), (qout) ) ) - - - #define rav2xf_c( rot, av, xform ) \ - \ - ( rav2xf_c ( CONST_MAT(rot), CONST_VEC(av), (xform) ) ) - - - #define raxisa_c( matrix, axis, angle ) \ - \ - ( raxisa_c ( CONST_MAT(matrix), (axis), (angle) ) ); - - - #define reccyl_c( rectan, r, lon, z ) \ - \ - ( reccyl_c ( CONST_VEC(rectan), (r), (lon), (z) ) ) - - - #define recgeo_c( rectan, re, f, lon, lat, alt ) \ - \ - ( recgeo_c ( CONST_VEC(rectan), (re), (f), \ - (lon), (lat), (alt) ) ) - - #define reclat_c( rectan, r, lon, lat ) \ - \ - ( reclat_c ( CONST_VEC(rectan), (r), (lon), (lat) ) ) - - - #define recrad_c( rectan, radius, ra, dec ) \ - \ - ( recrad_c ( CONST_VEC(rectan), (radius), (ra), (dec) ) ) - - - #define recsph_c( rectan, r, colat, lon ) \ - \ - ( recsph_c ( CONST_VEC(rectan), (r), (colat), (lon) ) ) - - - #define reordd_c( iorder, ndim, array ) \ - \ - ( reordd_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define reordi_c( iorder, ndim, array ) \ - \ - ( reordi_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define reordl_c( iorder, ndim, array ) \ - \ - ( reordl_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define rotmat_c( m1, angle, iaxis, mout ) \ - \ - ( rotmat_c ( CONST_MAT(m1), (angle), (iaxis), (mout) ) ) - - - #define rotvec_c( v1, angle, iaxis, vout ) \ - \ - ( rotvec_c ( CONST_VEC(v1), (angle), (iaxis), (vout) ) ) - - - #define saelgv_c( vec1, vec2, smajor, sminor ) \ - \ - ( saelgv_c ( CONST_VEC(vec1), CONST_VEC(vec2), \ - (smajor), (sminor) ) ) - - - #define spk14a_c( handle, ncsets, coeffs, epochs ) \ - \ - ( spk14a_c ( (handle), (ncsets), \ - CONST_VEC(coeffs), CONST_VEC(epochs) ) ) - - - #define spkapo_c( targ, et, ref, sobs, abcorr, ptarg, lt ) \ - \ - ( spkapo_c ( (targ), (et), (ref), CONST_VEC(sobs), \ - (abcorr), (ptarg), (lt) ) ) - - - #define spkapp_c( targ, et, ref, sobs, abcorr, starg, lt ) \ - \ - ( spkapp_c ( (targ), (et), (ref), CONST_VEC(sobs), \ - (abcorr), (starg), (lt) ) ) - - - #define spkaps_c( targ, et, ref, abcorr, sobs, \ - accobs, starg, lt, dlt ) \ - \ - ( spkaps_c ( (targ), (et), (ref), (abcorr), \ - CONST_VEC(sobs), CONST_VEC(accobs), \ - (starg), (lt), (dlt) ) ) - - - #define spkltc_c( targ, et, ref, abcorr, sobs, starg, lt, dlt ) \ - \ - ( spkltc_c ( (targ), (et), (ref), (abcorr), \ - CONST_VEC(sobs), (starg), (lt), (dlt) ) ) - - - #define spkuds_c( descr, body, center, frame, type, \ - first, last, begin, end ) \ - \ - ( spkuds_c ( CONST_VEC(descr), (body), (center), (frame), \ - (type), (first), (last), (begin), (end) ) ) - - - #define spkw02_c( handle, body, center, frame, first, last, \ - segid, intlen, n, polydg, cdata, btime ) \ - \ - ( spkw02_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (intlen), \ - (n), (polydg), CONST_VEC(cdata), (btime) ) ) - - - #define spkw03_c( handle, body, center, frame, first, last, \ - segid, intlen, n, polydg, cdata, btime ) \ - \ - ( spkw03_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (intlen), \ - (n), (polydg), CONST_VEC(cdata), (btime) ) ) - - - - #define spkw05_c( handle, body, center, frame, first, last, \ - segid, gm, n, states, epochs ) \ - \ - ( spkw05_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (gm), \ - (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - #define spkw08_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epoch1, step ) \ - \ - ( spkw08_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), \ - (n), CONST_MAT6(states), (epoch1), \ - (step) ) ) - - - #define spkw09_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epochs ) \ - \ - ( spkw09_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - #define spkw10_c( handle, body, center, frame, first, last, \ - segid, consts, n, elems, epochs ) \ - \ - ( spkw10_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), CONST_VEC(consts), \ - (n), CONST_VEC(elems), CONST_VEC(epochs)) ) - - - #define spkw12_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epoch0, step ) \ - \ - ( spkw12_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), \ - (n), CONST_MAT6(states), (epoch0), \ - (step) ) ) - - - #define spkw13_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epochs ) \ - \ - ( spkw13_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - - - - #define spkw15_c( handle, body, center, frame, first, last, \ - segid, epoch, tp, pa, p, ecc, \ - j2flg, pv, gm, j2, radius ) \ - \ - ( spkw15_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (epoch), \ - CONST_VEC(tp), CONST_VEC(pa), \ - (p), (ecc), (j2flg), CONST_VEC(pv), \ - (gm), (j2), (radius) ) ) - - - #define spkw17_c( handle, body, center, frame, first, last, \ - segid, epoch, eqel, rapol, decpol ) \ - \ - ( spkw17_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (epoch), \ - CONST_VEC(eqel), (rapol), (decpol) ) ) - - - - #define spkw18_c( handle, subtyp, body, center, frame, first, \ - last, segid, degree, n, packts, epochs ) \ - \ - ( spkw18_c ( (handle), (subtyp), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_VOID(packts), CONST_VEC(epochs) ) ) - - - #define srfxpt_c( method, target, et, abcorr, obsrvr, dref, \ - dvec, spoint, dist, trgepc, obspos, found ) \ - \ - ( srfxpt_c ( (method), (target), (et), (abcorr), (obsrvr), \ - (dref), CONST_VEC(dvec), (spoint), (dist), \ - (trgepc), (obspos), (found) ) ) - - - #define stelab_c( pobj, vobj, appobj ) \ - \ - ( stelab_c ( CONST_VEC(pobj), CONST_VEC(vobj), (appobj) ) ) - - - #define sumad_c( array, n ) \ - \ - ( sumad_c ( CONST_VEC(array), (n) ) ) - - - #define sumai_c( array, n ) \ - \ - ( sumai_c ( CONST_IVEC(array), (n) ) ) - - - #define surfnm_c( a, b, c, point, normal ) \ - \ - ( surfnm_c ( (a), (b), (c), CONST_VEC(point), (normal) ) ) - - - #define surfpt_c( positn, u, a, b, c, point, found ) \ - \ - ( surfpt_c ( CONST_VEC(positn), CONST_VEC(u), \ - (a), (b), (c), \ - (point), (found) ) ) - - - #define surfpv_c( stvrtx, stdir, a, b, c, stx, found ) \ - \ - ( surfpv_c ( CONST_VEC(stvrtx), CONST_VEC(stdir), \ - (a), (b), (c), \ - (stx), (found) ) ) - - - #define swpool_c( agent, nnames, lenvals, names ) \ - \ - ( swpool_c( CONST_STR(agent), (nnames), \ - (lenvals), CONST_VOID(names) ) ) - - - #define trace_c( m1 ) \ - \ - ( trace_c ( CONST_MAT(m1) ) ) - - - #define twovec_c( axdef, indexa, plndef, indexp, mout ) \ - \ - ( twovec_c ( CONST_VEC(axdef), (indexa), \ - CONST_VEC(plndef), (indexp), (mout) ) ) - - - #define ucrss_c( v1, v2, vout ) \ - \ - ( ucrss_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define unorm_c( v1, vout, vmag ) \ - \ - ( unorm_c ( CONST_VEC(v1), (vout), (vmag) ) ) - - - #define unormg_c( v1, ndim, vout, vmag ) \ - \ - ( unormg_c ( CONST_VEC(v1), (ndim), (vout), (vmag) ) ) - - - #define vadd_c( v1, v2, vout ) \ - \ - ( vadd_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vaddg_c( v1, v2, ndim,vout ) \ - \ - ( vaddg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim), (vout) ) ) - - - #define vcrss_c( v1, v2, vout ) \ - \ - ( vcrss_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vdist_c( v1, v2 ) \ - \ - ( vdist_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vdistg_c( v1, v2, ndim ) \ - \ - ( vdistg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vdot_c( v1, v2 ) \ - \ - ( vdot_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vdotg_c( v1, v2, ndim ) \ - \ - ( vdotg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vequ_c( vin, vout ) \ - \ - ( vequ_c ( CONST_VEC(vin), (vout) ) ) - - - #define vequg_c( vin, ndim, vout ) \ - \ - ( vequg_c ( CONST_VEC(vin), (ndim), (vout) ) ) - - - #define vhat_c( v1, vout ) \ - \ - ( vhat_c ( CONST_VEC(v1), (vout) ) ) - - - #define vhatg_c( v1, ndim, vout ) \ - \ - ( vhatg_c ( CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vlcom3_c( a, v1, b, v2, c, v3, sum ) \ - \ - ( vlcom3_c ( (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), \ - (c), CONST_VEC(v3), (sum) ) ) - - - #define vlcom_c( a, v1, b, v2, sum ) \ - \ - ( vlcom_c ( (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), (sum) ) ) - - - #define vlcomg_c( n, a, v1, b, v2, sum ) \ - \ - ( vlcomg_c ( (n), (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), (sum) ) ) - - - #define vminug_c( v1, ndim, vout ) \ - \ - ( vminug_c ( CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vminus_c( v1, vout ) \ - \ - ( vminus_c ( CONST_VEC(v1), (vout) ) ) - - - #define vnorm_c( v1 ) \ - \ - ( vnorm_c ( CONST_VEC(v1) ) ) - - - #define vnormg_c( v1, ndim ) \ - \ - ( vnormg_c ( CONST_VEC(v1), (ndim) ) ) - - - #define vperp_c( a, b, p ) \ - \ - ( vperp_c ( CONST_VEC(a), CONST_VEC(b), (p) ) ) - - - #define vprjp_c( vin, plane, vout ) \ - \ - ( vprjp_c ( CONST_VEC(vin), CONST_PLANE(plane), (vout) ) ) - - - #define vprjpi_c( vin, projpl, invpl, vout, found ) \ - \ - ( vprjpi_c( CONST_VEC(vin), CONST_PLANE(projpl), \ - CONST_PLANE(invpl), (vout), (found) ) ) - - - #define vproj_c( a, b, p ) \ - \ - ( vproj_c ( CONST_VEC(a), CONST_VEC(b), (p) ) ) - - - #define vrel_c( v1, v2 ) \ - \ - ( vrel_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vrelg_c( v1, v2, ndim ) \ - \ - ( vrelg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vrotv_c( v, axis, theta, r ) \ - \ - ( vrotv_c ( CONST_VEC(v), CONST_VEC(axis), (theta), (r) ) ) - - - #define vscl_c( s, v1, vout ) \ - \ - ( vscl_c ( (s), CONST_VEC(v1), (vout) ) ) - - - #define vsclg_c( s, v1, ndim, vout ) \ - \ - ( vsclg_c ( (s), CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vsep_c( v1, v2 ) \ - \ - ( vsep_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vsepg_c( v1, v2, ndim) \ - \ - ( vsepg_c ( CONST_VEC(v1), CONST_VEC(v2), ndim ) ) - - - #define vsub_c( v1, v2, vout ) \ - \ - ( vsub_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vsubg_c( v1, v2, ndim, vout ) \ - \ - ( vsubg_c ( CONST_VEC(v1), CONST_VEC(v2), \ - (ndim), (vout) ) ) - - #define vtmv_c( v1, mat, v2 ) \ - \ - ( vtmv_c ( CONST_VEC(v1), CONST_MAT(mat), CONST_VEC(v2) ) ) - - - #define vtmvg_c( v1, mat, v2, nrow, ncol ) \ - \ - ( vtmvg_c ( CONST_VOID(v1), CONST_VOID(mat), CONST_VOID(v2), \ - (nrow), (ncol) ) ) - - - #define vupack_c( v, x, y, z ) \ - \ - ( vupack_c ( CONST_VEC(v), (x), (y), (z) ) ) - - - #define vzero_c( v1 ) \ - \ - ( vzero_c ( CONST_VEC(v1) ) ) - - - #define vzerog_c( v1, ndim ) \ - \ - ( vzerog_c ( CONST_VEC(v1), (ndim) ) ) - - - #define xf2eul_c( xform, axisa, axisb, axisc, eulang, unique ) \ - \ - ( xf2eul_c( CONST_MAT6(xform), (axisa), (axisb), (axisc), \ - (eulang), (unique) ) ) - - - #define xf2rav_c( xform, rot, av ) \ - \ - ( xf2rav_c( CONST_MAT6(xform), (rot), (av) ) ) - - - #define xpose6_c( m1, mout ) \ - \ - ( xpose6_c ( CONST_MAT6(m1), (mout) ) ) - - - #define xpose_c( m1, mout ) \ - \ - ( xpose_c ( CONST_MAT(m1), (mout) ) ) - - - #define xposeg_c( matrix, nrow, ncol, mout ) \ - \ - ( xposeg_c ( CONST_VOID(matrix), (nrow), (ncol), (mout) ) ) - - -#endif diff --git a/ext/spice/include/SpiceZmc.h b/ext/spice/include/SpiceZmc.h deleted file mode 100644 index df694a602e..0000000000 --- a/ext/spice/include/SpiceZmc.h +++ /dev/null @@ -1,975 +0,0 @@ -/* - --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. - -*/ - -/* - CSPICE private macro file. - --Particulars - - Current list of macros (spelling counts) - - BLANK - C2F_MAP_CELL - C2F_MAP_CELL2 - C2F_MAP_CELL3 - CELLINIT - CELLINIT2 - CELLINIT3 - CELLISSETCHK - CELLISSETCHK2 - CELLISSETCHK2_VAL - CELLISSETCHK3 - CELLISSETCHK3_VAL - CELLISSETCHK_VAL - CELLMATCH2 - CELLMATCH2_VAL - CELLMATCH3 - CELLMATCH3_VAL - CELLTYPECHK - CELLTYPECHK2 - CELLTYPECHK2_VAL - CELLTYPECHK3 - CELLTYPECHK3_VAL - CELLTYPECHK_VAL - CHKFSTR - CHKFSTR_VAL - CHKOSTR - CHKOSTR_VAL - CHKPTR - Constants - Even - F2C_MAP_CELL - Index values - MOVED - MOVEI - MaxAbs - MaxVal - MinAbs - MinVal - Odd - SpiceError - TolOrFail - --Restrictions - - This is a private macro file for use within CSPICE. - Do not use or alter any entry. Or else! - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 4.2.0, 16-FEB-2005 (NJB) - - Bug fix: in the macro C2F_MAP_CELL, error checking has been - added after the sequence of calls to ssizec_ and scardc_. - If either of these routines signals an error, the dynamically - allocated memory for the "Fortran cell" is freed. - - -CSPICE Version 4.1.0, 06-DEC-2002 (NJB) - - Bug fix: added previous missing, bracketing parentheses to - references to input cell pointer argument in macro - CELLINIT. - - Changed CELLINIT macro so it no longer initializes to zero - length all strings in data array of a character cell. Instead, - strings are terminated with a null in their final element. - - -CSPICE Version 4.0.0, 22-AUG-2002 (NJB) - - Added macro definitions to support CSPICE cells and sets: - - C2F_MAP_CELL - C2F_MAP_CELL2 - C2F_MAP_CELL3 - CELLINIT - CELLINIT2 - CELLINIT3 - CELLISSETCHK - CELLISSETCHK2 - CELLISSETCHK2_VAL - CELLISSETCHK3 - CELLISSETCHK3_VAL - CELLISSETCHK_VAL - CELLMATCH2 - CELLMATCH2_VAL - CELLMATCH3 - CELLMATCH3_VAL - CELLTYPECHK - CELLTYPECHK2 - CELLTYPECHK2_VAL - CELLTYPECHK3 - CELLTYPECHK3_VAL - CELLTYPECHK_VAL - F2C_MAP_CELL - - -CSPICE Version 3.0.0, 09-JAN-1998 (NJB) - - Added output string check macros CHKOSTR and CHKOSTR_VAL. - Removed variable name arguments from macros - - CHKPTR - CHKPTR_VAL - CHKFSTR - CHKRSTR_VAL - - The strings containing names of the checked variables are now - generated from the variables themselves via the # operator. - - -CSPICE Version 2.0.0, 03-DEC-1997 (NJB) - - Added pointer check macro CHKPTR and Fortran string check macro - CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) -*/ - - - -#include -#include -#include "SpiceZdf.h" - - -#define MOVED( arrfrm, ndim, arrto ) \ - \ - ( memmove ( (void*) (arrto) , \ - (void*) (arrfrm), \ - sizeof (SpiceDouble) * (ndim) ) ) - - - - - -#define MOVEI( arrfrm, ndim, arrto ) \ - \ - ( memmove ( (void*) (arrto) , \ - (void*) (arrfrm), \ - sizeof (SpiceInt) * (ndim) ) ) - - - - - -/* -Define a tolerance test for those pesky double precision reals. -True if the difference is less than the tolerance, false otherwise. -The tolerance refers to a percentage. x, y and tol should be declared -double. All values are assumed to be non-zero. Okay? -*/ - -#define TolOrFail( x, y, tol ) \ - \ - ( fabs( x-y ) < ( tol * fabs(x) ) ) - - - - - -/* -Simple error output through standard SPICE error system . Set the error -message and the type -*/ - -#define SpiceError( errmsg, errtype ) \ - \ - { \ - setmsg_c ( errmsg ); \ - sigerr_c ( errtype ); \ - } - - - - - - -/* -Return a value which is the maximum/minimum of the absolute values of -two values. -*/ - -#define MaxAbs(a,b) ( fabs(a) >= fabs(b) ? fabs(a) : fabs(b) ) -#define MinAbs(a,b) ( fabs(a) < fabs(b) ? fabs(a) : fabs(b) ) - - - - - -/* -Return a value which is the maximum/minimum value of two values. -*/ - -#define MaxVal(A,B) ( (A) >= (B) ? (A) : (B) ) -#define MinVal(A,B) ( (A) < (B) ? (A) : (B) ) - - - - - -/* -Determine whether a value is even or odd -*/ -#define Even( x ) ( ( (x) & 1 ) == 0 ) -#define Odd ( x ) ( ( (x) & 1 ) != 0 ) - - - - - -/* -Array indexes for vectors. -*/ - -#define SpiceX 0 -#define SpiceY 1 -#define SpiceZ 2 -#define SpiceVx 3 -#define SpiceVy 4 -#define SpiceVz 5 - - - - -/* -Physical constants and dates. -*/ - -#define B1900 2415020.31352 -#define J1900 2415020.0 -#define JYEAR 31557600.0 -#define TYEAR 31556925.9747 -#define J1950 2433282.5 -#define SPD 86400.0 -#define B1950 2433282.42345905 -#define J2100 2488070.0 -#define CLIGHT 299792.458 -#define J2000 2451545.0 - - - - - -/* -Common literal values. -*/ - -#define NULLCHAR ( (SpiceChar ) 0 ) -#define NULLCPTR ( (SpiceChar * ) 0 ) -#define BLANK ( (SpiceChar ) ' ' ) - - - -/* -Macro CHKPTR is used for checking for a null pointer. CHKPTR uses -the constants - - CHK_STANDARD - CHK_DISCOVER - CHK_REMAIN - -to control tracing behavior. Values and meanings are: - - CHK_STANDARD Standard tracing. If an error - is found, signal it, check out - and return. - - CHK_DISCOVER Discovery check-in. If an - error is found, check in, signal - the error, check out, and return. - - CHK_REMAIN If an error is found, signal it. - Do not check out or return. This - would allow the caller to clean up - before returning, if necessary. - In such cases the caller must test - failed_c() after the macro call. - -CHKPTR should be used in void functions. In non-void functions, -use CHKPTR_VAL, which is defined below. - -*/ - -#define CHK_STANDARD 1 -#define CHK_DISCOVER 2 -#define CHK_REMAIN 3 - -#define CHKPTR( errHandling, modname, pointer ) \ - \ - if ( (void *)(pointer) == (void *)0 ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Pointer \"#\" is null; a non-null " \ - "pointer is required." ); \ - errch_c ( "#", (#pointer) ); \ - sigerr_c ( "SPICE(NULLPOINTER)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - -#define CHKPTR_VAL( errHandling, modname, pointer, retval ) \ - \ - if ( (void *)(pointer) == (void *)0 ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Pointer \"#\" is null; a non-null " \ - "pointer is required." ); \ - errch_c ( "#", (#pointer) ); \ - sigerr_c ( "SPICE(NULLPOINTER)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - -/* -Macro CHKFSTR checks strings that are to be passed to Fortran or -f2c'd Fortran routines. Such strings must have non-zero length, -and their pointers must be non-null. - -CHKFSTR should be used in void functions. In non-void functions, -use CHKFSTR_VAL, which is defined below. -*/ - -#define CHKFSTR( errHandling, modname, string ) \ - \ - CHKPTR ( errHandling, modname, string ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( strlen(string) == 0 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length zero." ); \ - errch_c ( "#", (#string) ); \ - sigerr_c ( "SPICE(EMPTYSTRING)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - -#define CHKFSTR_VAL( errHandling, modname, string, retval ) \ - \ - CHKPTR_VAL( errHandling, modname, string, retval); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( strlen(string) == 0 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length zero." ); \ - errch_c ( "#", (#string) ); \ - sigerr_c ( "SPICE(EMPTYSTRING)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - -/* -Macro CHKOSTR checks output string pointers and the associated -string length values supplied as input arguments. Output string -pointers must be non-null, and the string lengths must be at -least 2, so Fortran routine can write at least one character to -the output string, and so a null terminator can be appended. -CHKOSTR should be used in void functions. In non-void functions, -use CHKOSTR_VAL, which is defined below. -*/ - -#define CHKOSTR( errHandling, modname, string, length ) \ - \ - CHKPTR ( errHandling, modname, string ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( length < 2 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length #; must be >= 2." ); \ - errch_c ( "#", (#string) ); \ - errint_c ( "#", (length) ); \ - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - -#define CHKOSTR_VAL( errHandling, modname, string, length, retval ) \ - \ - CHKPTR_VAL( errHandling, modname, string, retval ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( length < 2 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length #; must be >= 2." ); \ - errch_c ( "#", (#string) ); \ - errint_c ( "#", (length) ); \ - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - - /* - Definitions for Cells and Sets - */ - - - /* - Cell initialization macros - */ - #define CELLINIT( cellPtr ) \ - \ - if ( !( (cellPtr)->init ) ) \ - { \ - if ( (cellPtr)->dtype == SPICE_CHR ) \ - { \ - /* \ - Make sure all elements of the data array, including \ - the control area, start off null-terminated. We place \ - the null character in the final element of each string, \ - so as to avoid wiping out data that may have been \ - assigned to the data array prior to initialization. \ - */ \ - SpiceChar * sPtr; \ - SpiceInt i; \ - SpiceInt nmax; \ - \ - nmax = SPICE_CELL_CTRLSZ + (cellPtr)->size; \ - \ - for ( i = 1; i <= nmax; i++ ) \ - { \ - sPtr = (SpiceChar *)((cellPtr)->base) \ - + i * (cellPtr)->length \ - - 1; \ - \ - *sPtr = NULLCHAR; \ - } \ - } \ - else \ - { \ - zzsynccl_c ( C2F, (cellPtr) ); \ - } \ - \ - (cellPtr)->init = SPICETRUE; \ - } - - - #define CELLINIT2( cellPtr1, cellPtr2 ) \ - \ - CELLINIT ( cellPtr1 ); \ - CELLINIT ( cellPtr2 ); - - - #define CELLINIT3( cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLINIT ( cellPtr1 ); \ - CELLINIT ( cellPtr2 ); \ - CELLINIT ( cellPtr3 ); - - - /* - Data type checking macros: - */ - #define CELLTYPECHK( errHandling, modname, dType, cellPtr1 ) \ - \ - if ( (cellPtr1)->dtype != (dType) ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; expected type " \ - "is #." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", typstr[ dType ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - - #define CELLTYPECHK_VAL( errHandling, modname, \ - dType, cellPtr1, retval ) \ - \ - if ( (cellPtr1)->dtype != (dType) ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; expected type " \ - "is #." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", typstr[ dType ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return (retval); \ - } \ - } - - - #define CELLTYPECHK2( errHandling, modname, dtype, \ - cellPtr1, cellPtr2 ) \ - \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr1 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr2 ); - - - - #define CELLTYPECHK2_VAL( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, retval ) \ - \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr1, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr2, \ - retval ); - - - - #define CELLTYPECHK3( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr1 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr2 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr3 ); - - - #define CELLTYPECHK3_VAL( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, cellPtr3, \ - retval ) \ - \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr1, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr2, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr3 \ - retval ); - - - - #define CELLMATCH2( errHandling, modname, cellPtr1, cellPtr2 ) \ - \ - if ( (cellPtr1)->dtype != (cellPtr2)->dtype ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; data type of # " \ - "is #, but types must match." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", (#cellPtr2) ); \ - errch_c ( "#", typstr[ (cellPtr2)->dtype ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - #define CELLMATCH2_VAL( errHandling, modname, \ - cellPtr1, cellPtr2, retval ) \ - \ - if ( (cellPtr1)->dtype != (cellPtr2)->dtype ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; data type of # " \ - "is #, but types must match." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr [ (cellPtr1)->dtype ] ); \ - errch_c ( "#", (#cellPtr2) ); \ - errch_c ( "#", typstr [ (cellPtr2)->dtype ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - - #define CELLMATCH3( errHandling, modname, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLMATCH2 ( errHandling, modname, cellPtr1, cellPtr2 ); \ - CELLMATCH2 ( errHandling, modname, cellPtr2, cellPtr3 ); - - - - - #define CELLMATCH3_VAL( errHandling, modname, cellPtr1, \ - cellPtr2, cellPtr3, retval ) \ - \ - CELLMATCH2_VAL ( errHandling, modname, \ - cellPtr1, cellPtr2, retval ); \ - \ - CELLMATCH2_VAL ( errHandling, modname, \ - cellPtr2, cellPtr3, retval ); - - /* - Set checking macros: - */ - #define CELLISSETCHK( errHandling, modname, cellPtr1 ) \ - \ - if ( !(cellPtr1)->isSet ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Cell # must be sorted and have unique " \ - "values in order to be a CSPICE set. " \ - "The isSet flag in this cell is SPICEFALSE, " \ - "indicating the cell may have been modified " \ - "by a routine that doesn't preserve these " \ - "properties." ); \ - errch_c ( "#", (#cellPtr1) ); \ - sigerr_c ( "SPICE(NOTASET)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - - #define CELLISSETCHK_VAL( errHandling, modname, \ - cellPtr1, retval ) \ - \ - if ( !(cellPtr1)->isSet ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Cell # must be sorted and have unique " \ - "values in order to be a CSPICE set. " \ - "The isSet flag in this cell is SPICEFALSE, " \ - "indicating the cell may have been modified " \ - "by a routine that doesn't preserve these " \ - "properties." ); \ - errch_c ( "#", (#cellPtr1) ); \ - sigerr_c ( "SPICE(NOTASET)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return (retval); \ - } \ - } - - - #define CELLISSETCHK2( errHandling, modname, \ - cellPtr1, cellPtr2 ) \ - \ - CELLISSETCHK( errHandling, modname, cellPtr1 ); \ - CELLISSETCHK( errHandling, modname, cellPtr2 ); - - - - #define CELLISSETCHK2_VAL( errHandling, modname, \ - cellPtr1, cellPtr2, retval ) \ - \ - CELLISSETCHK_VAL( errHandling, modname, cellPtr1, retval ); \ - CELLISSETCHK_VAL( errHandling, modname, cellPtr2, retval ); \ - - - - #define CELLISSETCHK3( errHandling, modname, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLISSETCHK ( errHandling, modname, cellPtr1 ); \ - CELLISSETCHK ( errHandling, modname, cellPtr2 ); \ - CELLISSETCHK ( errHandling, modname, cellPtr3 ); - - - #define CELLISSETCHK3_VAL( errHandling, modname, cellPtr1, \ - cellPtr2, cellPtr3, retval ) \ - \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr1, retval ); \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr2, retval ); \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr3, retval ); - - - /* - C-to-Fortran and Fortran-to-C character cell translation macros: - */ - - /* - Macros that map one or more character C cells to dynamically - allocated Fortran-style character cells: - */ - #define C2F_MAP_CELL( caller, CCell, fCell, fLen ) \ - \ - { \ - /* \ - fCell and fLen are to be passed by reference, as if this \ - macro were a function. \ - \ - \ - Caution: dynamically allocates array fCell, which is to be \ - freed by caller! \ - */ \ - SpiceInt ndim; \ - SpiceInt lenvals; \ - \ - \ - ndim = (CCell)->size + SPICE_CELL_CTRLSZ; \ - lenvals = (CCell)->length; \ - \ - C2F_MapFixStrArr ( (caller), ndim, lenvals, \ - (CCell)->base, (fLen), (fCell) ); \ - \ - if ( !failed_c() ) \ - { \ - /* \ - Explicitly set the control area info in the Fortran cell.\ - */ \ - ssizec_ ( ( integer * ) &((CCell)->size), \ - ( char * ) *(fCell), \ - ( ftnlen ) *(fLen) ); \ - \ - scardc_ ( ( integer * ) &((CCell)->card), \ - ( char * ) *(fCell), \ - ( ftnlen ) *(fLen) ); \ - \ - if ( failed_c() ) \ - { \ - /* \ - Setting size or cardinality of the Fortran cell \ - can fail, for example if the cell's string length \ - is too short. \ - */ \ - free ( *(fCell) ); \ - } \ - } \ - } - - - #define C2F_MAP_CELL2( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2 ) \ - \ - { \ - C2F_MAP_CELL( caller, CCell1, fCell1, fLen1 ); \ - \ - if ( !failed_c() ) \ - { \ - C2F_MAP_CELL( caller, CCell2, fCell2, fLen2 ); \ - \ - if ( failed_c() ) \ - { \ - free ( *(fCell1) ); \ - } \ - } \ - } - - - #define C2F_MAP_CELL3( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2, \ - CCell3, fCell3, fLen3 ) \ - \ - { \ - C2F_MAP_CELL2( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2 ); \ - \ - if ( !failed_c() ) \ - { \ - C2F_MAP_CELL( caller, CCell3, fCell3, fLen3 ); \ - \ - if ( failed_c() ) \ - { \ - free ( *(fCell1) ); \ - free ( *(fCell2) ); \ - } \ - } \ - } - - - - /* - Macro that maps a Fortran-style character cell to a C cell - (Note: this macro frees the Fortran cell): - */ - - #define F2C_MAP_CELL( fCell, fLen, CCell ) \ - \ - { \ - SpiceInt card; \ - SpiceInt lenvals; \ - SpiceInt ndim; \ - SpiceInt nBytes; \ - SpiceInt size; \ - void * array; \ - \ - ndim = (CCell)->size + SPICE_CELL_CTRLSZ; \ - lenvals = (CCell)->length; \ - array = (CCell)->base; \ - \ - /* \ - Capture the size and cardinality of the Fortran cell. \ - */ \ - if ( !failed_c() ) \ - { \ - size = sizec_ ( ( char * ) (fCell), \ - ( ftnlen ) fLen ); \ - \ - card = cardc_ ( ( char * ) (fCell), \ - ( ftnlen ) fLen ); \ - } \ - \ - \ - /* \ - Copy the Fortran array into the output array. \ - */ \ - \ - nBytes = ndim * fLen * sizeof(SpiceChar); \ - memmove ( array, fCell, nBytes ); \ - /* \ - Convert the output array from Fortran to C style. \ - */ \ - F2C_ConvertTrStrArr ( ndim, lenvals, (SpiceChar *)array ); \ - \ - /* \ - Sync the size and cardinality of the C cell. \ - */ \ - if ( !failed_c() ) \ - { \ - (CCell)->size = size; \ - (CCell)->card = card; \ - } \ - } - - - -/* - End of header SpiceZmc.h -*/ diff --git a/ext/spice/include/SpiceZpl.h b/ext/spice/include/SpiceZpl.h deleted file mode 100644 index 1413202b69..0000000000 --- a/ext/spice/include/SpiceZpl.h +++ /dev/null @@ -1,109 +0,0 @@ -/* - --Header_File SpiceZpl.h ( CSPICE platform macros ) - --Abstract - - Define macros identifying the host platform for which this - version of CSPICE is targeted. - --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. - --Literature_References - - None. - --Particulars - - This header file defines macros that enable CSPICE code to be - compiled conditionally based on the identity of the host platform. - - The macros defined here ARE visible in the macro name space of - any file that includes SpiceUsr.h. The names are prefixed with - the string CSPICE_ to help prevent conflicts with macros defined - by users' applications. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.2.0, 14-MAY-2010 (EDW)(BVS) - - Updated for the: - - MAC-OSX-64BIT-INTEL_C - PC-64BIT-MS_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - SUN-SOLARIS-INTEL-CC_C - - environments. - - -CSPICE Version 2.1.0, 15-NOV-2006 (BVS) - - Updated for MAC-OSX-INTEL_C environment. - - -CSPICE Version 2.0.0, 21-FEB-2006 (NJB) - - Updated for PC-LINUX-64BIT-GCC_C environment. - - -CSPICE Version 1.3.0, 06-MAR-2005 (NJB) - - Updated for SUN-SOLARIS-64BIT-GCC_C environment. - - -CSPICE Version 1.2.0, 03-JAN-2005 (BVS) - - Updated for PC-CYGWIN_C environment. - - -CSPICE Version 1.1.0, 27-JUL-2002 (BVS) - - Updated for MAC-OSX-NATIVE_C environment. - - -CSPICE Version 1.0.0, 26-FEB-1999 (NJB) (EDW) - --Index_Entries - - platform ID defines for CSPICE - -*/ - - -#ifndef HAVE_PLATFORM_MACROS_H -#define HAVE_PLATFORM_MACROS_H - - - #define CSPICE_PC_LINUX_64BIT_GCC - -#endif - diff --git a/ext/spice/include/SpiceZpr.h b/ext/spice/include/SpiceZpr.h deleted file mode 100644 index b4d672e98c..0000000000 --- a/ext/spice/include/SpiceZpr.h +++ /dev/null @@ -1,3853 +0,0 @@ -/* - --Header_File SpiceZpr.h ( CSPICE prototypes ) - --Abstract - - Define prototypes for CSPICE user-interface-level functions. - --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. - --Literature_References - - None. - --Particulars - - This is the header file containing prototypes for CSPICE user-level - C routines. Prototypes for the underlying f2c'd SPICELIB routines - are contained in the separate header file SpiceZfc. However, those - routines are not part of the official CSPICE API. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 12.12.0, 19-FEB-2010 (EDW) (NJB) - - Added prototypes for - - bodc2s_c - dafgsr_c - dafrfr_c - dp2hx_c - ducrss_c - dvcrss_c - dvnorm_c - gfrr_c - gfuds_c - hx2dp_c - uddc_c - uddf_c - - -CSPICE Version 12.11.0, 29-MAR-2009 (EDW) (NJB) - - Added prototypes for - - dvsep_c - gfbail_c - gfclrh_c - gfdist_c - gfevnt_c - gffove_c - gfinth_c - gfocce_c - gfoclt_c - gfposc_c - gfrefn_c - gfrepf_c - gfrepi_c - gfrepu_c - gfrfov_c - gfsep_c - gfseth_c - gfsntc_c - gfsstp_c - gfstep_c - gfsubc_c - gftfov_c - surfpv_c - zzgfgeth_c - zzgfsavh_c - - -CSPICE Version 12.10.0, 30-JAN-2008 (EDW) (NJB) - - Added prototypes for: - - ilumin_c - pckcov_c - pckfrm_c - sincpt_c - spkacs_c - spkaps_c - spkltc_c - subpnt_c - subslr_c - wncard_c - - -CSPICE Version 12.9.0, 16-NOV-2006 (NJB) - - Bug fix: corrected prototype for vhatg_c. - - Renamed wnfild_c and wnfltd_c arguments `small' to 'smal' for - compatibility with MS Visual C++. - - Added prototypes for - - dafac_c - dafdc_c - dafec_c - dafgda_c - dascls_c - dasopr_c - kclear_c - - -CSPICE Version 12.8.0, 07-NOV-2005 (NJB) - - Added prototypes for - - bodvcd_c - qdq2av_c - qxq_c - srfrec_c - - -CSPICE Version 12.7.0, 06-JAN-2004 (NJB) - - Added prototypes for - - bods2c_c - ckcov_c - ckobj_c - dafopw_c - dafrs_c - dpgrdr_c - drdpgr_c - lspcn_c - pgrrec_c - recpgr_c - spkcov_c - spkobj_c - - -CSPICE Version 12.6.0, 24-FEB-2003 (NJB) - - Added prototype for - - bodvrd_c - deltet_c - srfxpt_c - - -CSPICE Version 12.5.0, 14-MAY-2003 (NJB) - - Removed prototype for getcml_. - - - -CSPICE Version 12.4.0, 25-FEB-2003 (NJB) - - Added prototypes for - - dasac_c - dasec_c - et2lst_c - - -CSPICE Version 12.3.0, 03-SEP-2002 (NJB) - - Added prototypes for - - appndc_c - appndd_c - appndi_c - bschoc_c - bschoi_c - bsrchc_c - bsrchd_c - bsrchi_c - card_c - ckw05_c - copy_c - cpos_c - cposr_c - diff_c - elemc_c - elemd_c - elemi_c - esrchc_c - insrtc_c - insrtd_c - insrti_c - inter_c - isordv_c - isrchc_c - isrchd_c - isrchi_c - lparss_c - lstlec_c - lstled_c - lstlei_c - lstltc_c - lstltd_c - lstlti_c - lx4dec_c - lx4num_c - lx4sgn_c - lx4uns_c - lxqstr_c - ncpos_c - ncposr_c - ordc_c - ordd_c - ordi_c - orderc_c - orderd_c - orderi_c - pos_c - posr_c - prefix_c - remove_c - reordc_c - reordd_c - reordi_c - reordl_c - removc_c - removd_c - removi_c - repmc_c - repmct_c - repmd_c - repmf_c - repmi_c - repmot_c - scard_c - sdiff_c - set_c - shellc_c - shelld_c - shelli_c - size_c - scard_c - spkw18_c - ssize_c - union_c - valid_c - wncomd_c - wncond_c - wndifd_c - wnelmd_c - wnexpd_c - wnextd_c - wnfetd_c - wnfild_c - wnfltd_c - wnincd_c - wninsd_c - wnintd_c - wnreld_c - wnsumd_c - wnunid_c - wnvald_c - zzsynccl_c - - - -CSPICE Version 12.2.0, 23-OCT-2001 (NJB) - - Added prototypes for - - badkpv_c - dcyldr_c - dgeodr_c - dlatdr_c - drdcyl_c - drdgeo_c - drdlat_c - drdsph_c - dsphdr_c - ekacec_c - ekaced_c - ekacei_c - ekappr_c - ekbseg_c - ekccnt_c - ekcii_c - ekdelr_c - ekinsr_c - ekntab_c - ekrcec_c - ekrced_c - ekrcei_c - ektnam_c - ekucec_c - ekuced_c - ekucei_c - inelpl_c - invort_c - kxtrct_c - - Added const qualifier to input array arguments of - - conics_c - illum_c - pdpool_c - prop2b_c - q2m_c - spkuds_c - xposeg_c - - Added const qualifier to the return value of - - tkvrsn_c - - -CSPICE Version 12.1.0, 12-APR-2000 (FST) - - Added prototype for - - getfov_c - - -CSPICE Version 12.0.0, 22-MAR-2000 (NJB) - - Added prototypes for - - lparse_c - lparsm_c - spkw12_c - spkw13_c - - - -CSPICE Version 11.1.0, 17-DEC-1999 (WLT) - - Added prototype for - - dafrda_c - - -CSPICE Version 11.0.0, 07-OCT-1999 (NJB) (EDW) - - Changed ekaclc_c, ekacld_c, ekacli_c prototypes to make input - pointers const-qualified where appropriate. - - Changed prompt_c prototype to accommodate memory leak bug fix. - - Changed ekpsel_c prototype to be consistent with other interfaces - having string array outputs. - - Added prototypes for - - axisar_c - brcktd_c - brckti_c - cidfrm_c - cgv2el_c - clpool_c - cmprss_c - cnmfrm_c - convrt_c - cvpool_c - dafbbs_c - dafbfs_c - dafcls_c - dafcs_c - daffna_c - daffpa_c - dafgh_c - dafgn_c - dafgs_c - dafopr_c - dafps_c - dafus_c - diags2_c - dtpool_c - dvdot_c - dvhat_c - dvpool_c - edlimb_c - ekops_c - ekopw_c - eul2xf_c - ftncls_c - furnsh_c - getmsg_c - getelm_c - gnpool_c - ident_c - illum_c - inedpl_c - kdata_c - kinfo_c - ktotal_c - lmpool_c - matchi_c - matchw_c - maxd_c - maxi_c - mequ_c - mind_c - mini_c - moved_ - npedln_c - npelpt_c - nplnpt_c - pcpool_c - pdpool_c - pipool_c - pjelpl_c - pxform_c - rav2xf_c - raxisa_c - rquad_c - saelgv_c - spk14a_c - spk14b_c - spk14e_c - spkapp_c - spkapo_c - spkcls_c - spkezp_c - spkgps_c - spkopn_c - spkpds_c - spkpos_c - spkssb_c - spksub_c - spkuds_c - spkw02_c - spkw03_c - spkw05_c - spkw08_c - spkw09_c - spkw10_c - spkw15_c - spkw17_c - stpool_c - subpt_c - subsol_c - swpool_c - szpool_c - tparse_c - trace_c - unload_c - vaddg_c - vhatg_c - vlcomg_c - vminug_c - vrel_c - vrelg_c - vsepg_c - vtmv_c - vtmvg_c - vzerog_c - xf2eul_c - xf2rav_c - xposeg_c - - - -CSPICE Version 10.0.0, 09-MAR-1999 (NJB) - - Added prototypes for - - frame_c - inrypl_c - nvc2pl_c - nvp2pl_c - pl2nvc_c - pl2nvp_c - pl2psv_c - psv2pl_c - sce2c_c - vprjp_c - vprjpi_c - - Now conditionally includes SpiceEll.h and SpicePln.h. - - - -CSPICE Version 9.0.0, 25-FEB-1999 (NJB) - - Added prototypes for - - eknseg_c - eknelt_c - ekpsel_c - ekssum_c - - Now conditionally includes SpiceEK.h. - - - -CSPICE Version 8.0.0, 20-OCT-1998 (NJB) - - Added const qualifier to all input matrix and vector arguments. - - Added prototypes for - - det_c - dpmax_c - dpmax_ - dpmin_c - dpmin_ - frinfo_c - frmnam_c - getfat_c - intmax_c - intmax_ - intmin_c - intmin_ - invert_c - namfrm_c - vrotv_c - vsclg_c - - - -CSPICE Version 7.0.0, 02-APR-1998 (EDW) - - Added prototypes for - - mequg_c - unormg_g - vdistg_c - vdotg_c - vequg_c - vnormg_c - - -CSPICE Version 6.0.0, 31-MAR-1998 (NJB) - - Added prototypes for - - ekaclc_c - ekacld_c - ekacli_c - ekcls_c - ekffld_c - ekfind_c - ekgc_c - ekgd_c - ekgi_c - ekifld_c - eklef_c - ekopr_c - ekopn_c - ekuef_c - - -CSPICE Version 5.0.1, 05-MAR-1998 (EDW) - - Remove some non printing characters. - - -CSPICE Version 5.0.0, 03-MAR-1998 (NJB) - - Added prototypes for - - etcal_c - ltime_c - stelab_c - tpictr_c - twovec_c - vsubg_c - - -CSPICE Version 4.0.0, 11-FEB-1998 (EDW) - - Added prototypes for - - timdef_c - tsetyr_c - - - -CSPICE Version 3.0.0, 02-FEB-1998 (NJB) - - Added prototypes for - - pckuof_c - tipbod_c - - Type SpiceVoid was replaced with void. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - Changed all input-only character pointers to type ConstSpiceChar. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - prototypes of CSPICE functions - -*/ - - -/* -Include Files: -*/ - - -#ifndef HAVE_SPICEDEFS_H -#include "SpiceZdf.h" -#endif - -#ifndef HAVE_SPICE_EK_H -#include "SpiceEK.h" -#endif - -#ifndef HAVE_SPICE_PLANES_H -#include "SpicePln.h" -#endif - -#ifndef HAVE_SPICE_ELLIPSES_H -#include "SpiceEll.h" -#endif - -#ifndef HAVE_SPICE_CELLS_H -#include "SpiceCel.h" -#endif - -#ifndef HAVE_SPICE_SPK_H -#include "SpiceSPK.h" -#endif - -#ifndef HAVE_SPICEWRAPPERS_H -#define HAVE_SPICEWRAPPERS_H - - - - -/* - Function prototypes for CSPICE functions are listed below. - Each prototype is accompanied by a function abstract and brief I/O - description. - - See the headers of the C wrappers for detailed descriptions of the - routines' interfaces. - - The list below should be maintained in alphabetical order. -*/ - - void appndc_c ( ConstSpiceChar * item, - SpiceCell * cell ); - - - void appndd_c ( SpiceDouble item, - SpiceCell * cell ); - - - void appndi_c ( SpiceInt item, - SpiceCell * cell ); - - - void axisar_c ( ConstSpiceDouble axis [3], - SpiceDouble angle, - SpiceDouble r [3][3] ); - - - SpiceBoolean badkpv_c ( ConstSpiceChar *caller, - ConstSpiceChar *name, - ConstSpiceChar *comp, - SpiceInt size, - SpiceInt divby, - SpiceChar type ); - - - void bodc2n_c ( SpiceInt code, - SpiceInt namelen, - SpiceChar * name, - SpiceBoolean * found ); - - - void bodc2s_c ( SpiceInt code, - SpiceInt lenout, - SpiceChar * name ); - - void boddef_c ( ConstSpiceChar * name, - SpiceInt code ); - - - SpiceBoolean bodfnd_c ( SpiceInt body, - ConstSpiceChar * item ); - - - void bodn2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ); - - - void bods2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ); - - - void bodvar_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt * dim , - SpiceDouble * values ); - - - void bodvcd_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim , - SpiceDouble * values ); - - - void bodvrd_c ( ConstSpiceChar * body, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim , - SpiceDouble * values ); - - - SpiceDouble brcktd_c ( SpiceDouble number, - SpiceDouble end1, - SpiceDouble end2 ); - - - SpiceInt brckti_c ( SpiceInt number, - SpiceInt end1, - SpiceInt end2 ); - - - SpiceInt bschoc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array, - ConstSpiceInt * order ); - - - SpiceInt bschoi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array, - ConstSpiceInt * order ); - - - SpiceInt bsrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - SpiceInt bsrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ); - - - SpiceInt bsrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ); - - - SpiceDouble b1900_c ( void ); - - - SpiceDouble b1950_c ( void ); - - - SpiceInt card_c ( SpiceCell * cell ); - - - void cgv2el_c ( ConstSpiceDouble center[3], - ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceEllipse * ellipse ); - - - void chkin_c ( ConstSpiceChar * module ); - - - void chkout_c ( ConstSpiceChar * module ); - - - void cidfrm_c ( SpiceInt cent, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ); - - - void ckcls_c ( SpiceInt handle ); - - - void ckcov_c ( ConstSpiceChar * ck, - SpiceInt idcode, - SpiceBoolean needav, - ConstSpiceChar * level, - SpiceDouble tol, - ConstSpiceChar * timsys, - SpiceCell * cover ); - - - void ckobj_c ( ConstSpiceChar * ck, - SpiceCell * ids ); - - - void ckgp_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble * clkout, - SpiceBoolean * found ); - - - void ckgpav_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble av[3], - SpiceDouble * clkout, - SpiceBoolean * found ); - - - void cklpf_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ckopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void ckupf_c ( SpiceInt handle ); - - - void ckw01_c ( SpiceInt handle, - SpiceDouble begtime, - SpiceDouble endtime, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3] ); - - - void ckw02_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble start [], - ConstSpiceDouble stop [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - ConstSpiceDouble rates [] ); - - - void ckw03_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - SpiceInt nints, - ConstSpiceDouble starts [] ); - - - void ckw05_c ( SpiceInt handle, - SpiceCK05Subtype subtyp, - SpiceInt degree, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt n, - ConstSpiceDouble sclkdp[], - const void * packets, - SpiceDouble rate, - SpiceInt nints, - ConstSpiceDouble starts[] ); - - - SpiceDouble clight_c ( void ); - - - void clpool_c ( void ); - - - void cmprss_c ( SpiceChar delim, - SpiceInt n, - ConstSpiceChar * input, - SpiceInt lenout, - SpiceChar * output ); - - - void cnmfrm_c ( ConstSpiceChar * cname, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ); - - - void conics_c ( ConstSpiceDouble elts[8], - SpiceDouble et, - SpiceDouble state[6] ); - - - void convrt_c ( SpiceDouble x, - ConstSpiceChar * in, - ConstSpiceChar * out, - SpiceDouble * y ); - - - void copy_c ( SpiceCell * a, - SpiceCell * b ); - - - - SpiceInt cpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - SpiceInt cposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - void cvpool_c ( ConstSpiceChar * agent, - SpiceBoolean * update ); - - - void cyllat_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ); - - - void cylrec_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble rectan[3] ); - - - void cylsph_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * colat, - SpiceDouble * lon ); - - - void dafac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt lenvals, - const void * buffer ); - - - void dafbbs_c ( SpiceInt handle ); - - - void dafbfs_c ( SpiceInt handle ); - - - void dafcls_c ( SpiceInt handle ); - - - void dafcs_c ( SpiceInt handle ); - - - void dafdc_c ( SpiceInt handle ); - - - void dafec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt lenout, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ); - - - void daffna_c ( SpiceBoolean * found ); - - - void daffpa_c ( SpiceBoolean * found ); - - - void dafgda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ); - - - void dafgh_c ( SpiceInt * handle ); - - - void dafgn_c ( SpiceInt lenout, - SpiceChar * name ); - - - void dafgs_c ( SpiceDouble sum[] ); - - - void dafgsr_c ( SpiceInt handle, - SpiceInt recno, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data, - SpiceBoolean * found ); - - - void dafopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dafopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dafps_c ( SpiceInt nd, - SpiceInt ni, - ConstSpiceDouble dc [], - ConstSpiceInt ic [], - SpiceDouble sum [] ); - - - void dafrda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ); - - - - void dafrfr_c ( SpiceInt handle, - SpiceInt lenout, - SpiceInt * nd, - SpiceInt * ni, - SpiceChar * ifname, - SpiceInt * fward, - SpiceInt * bward, - SpiceInt * free ); - - - - void dafrs_c ( ConstSpiceDouble * sum ); - - - void dafus_c ( ConstSpiceDouble sum [], - SpiceInt nd, - SpiceInt ni, - SpiceDouble dc [], - SpiceInt ic [] ); - - - void dasac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt buflen, - const void * buffer ); - - - void dascls_c ( SpiceInt handle ); - - - void dasec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt buflen, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ); - - - void dasopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dcyldr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void deltet_c ( SpiceDouble epoch, - ConstSpiceChar * eptype, - SpiceDouble * delta ); - - - SpiceDouble det_c ( ConstSpiceDouble m1[3][3] ); - - - void diags2_c ( ConstSpiceDouble symmat [2][2], - SpiceDouble diag [2][2], - SpiceDouble rotate [2][2] ); - - - void diff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void dgeodr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void dlatdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - void dp2hx_c ( SpiceDouble number, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * length - ); - - void dpgrdr_c ( ConstSpiceChar * body, - SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - SpiceDouble dpmax_c ( void ); - - - SpiceDouble dpmax_ ( void ); - - - SpiceDouble dpmin_c ( void ); - - - SpiceDouble dpmin_ ( void ); - - - SpiceDouble dpr_c ( void ); - - - void drdcyl_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void drdgeo_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void drdlat_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble jacobi[3][3] ); - - - void drdpgr_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void drdsph_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble jacobi[3][3] ); - - - void dsphdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void dtpool_c ( ConstSpiceChar * name, - SpiceBoolean * found, - SpiceInt * n, - SpiceChar type [1] ); - - - void ducrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ); - - - void dvcrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ); - - - SpiceDouble dvdot_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6] ); - - - void dvhat_c ( ConstSpiceDouble s1 [6], - SpiceDouble sout[6] ); - - SpiceDouble dvnorm_c ( ConstSpiceDouble state[6] ); - - void dvpool_c ( ConstSpiceChar * name ); - - - SpiceDouble dvsep_c ( ConstSpiceDouble * s1, - ConstSpiceDouble * s2 ); - - - void edlimb_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble viewpt[3], - SpiceEllipse * limb ); - - - void ekacec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ); - - - void ekaced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ); - - - void ekacei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ); - - - void ekaclc_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - SpiceInt vallen, - const void * cvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekacld_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceDouble * dvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekacli_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceInt * ivals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekappr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * recno ); - - - void ekbseg_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno ); - - - void ekccnt_c ( ConstSpiceChar * table, - SpiceInt * ccount ); - - - void ekcii_c ( ConstSpiceChar * table, - SpiceInt cindex, - SpiceInt lenout, - SpiceChar * column, - SpiceEKAttDsc * attdsc ); - - - void ekcls_c ( SpiceInt handle ); - - - void ekdelr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ); - - - void ekffld_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * rcptrs ); - - - void ekfind_c ( ConstSpiceChar * query, - SpiceInt lenout, - SpiceInt * nmrows, - SpiceBoolean * error, - SpiceChar * errmsg ); - - - void ekgc_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt lenout, - SpiceChar * cdata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekgd_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceDouble * ddata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekgi_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt * idata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekifld_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt nrows, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno, - SpiceInt * rcptrs ); - - - void ekinsr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ); - - - void eklef_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - SpiceInt eknelt_c ( SpiceInt selidx, - SpiceInt row ); - - - SpiceInt eknseg_c ( SpiceInt handle ); - - - void ekntab_c ( SpiceInt * n ); - - - void ekopn_c ( ConstSpiceChar * fname, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void ekopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ekops_c ( SpiceInt * handle ); - - - void ekopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ekpsel_c ( ConstSpiceChar * query, - SpiceInt msglen, - SpiceInt tablen, - SpiceInt collen, - SpiceInt * n, - SpiceInt * xbegs, - SpiceInt * xends, - SpiceEKDataType * xtypes, - SpiceEKExprClass * xclass, - void * tabs, - void * cols, - SpiceBoolean * error, - SpiceChar * errmsg ); - - - void ekrcec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt lenout, - SpiceInt * nvals, - void * cvals, - SpiceBoolean * isnull ); - - - void ekrced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceDouble * dvals, - SpiceBoolean * isnull ); - - - void ekrcei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceInt * ivals, - SpiceBoolean * isnull ); - - - void ekssum_c ( SpiceInt handle, - SpiceInt segno, - SpiceEKSegSum * segsum ); - - - void ektnam_c ( SpiceInt n, - SpiceInt lenout, - SpiceChar * table ); - - - void ekucec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ); - - - void ekuced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ); - - - void ekucei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ); - - - void ekuef_c ( SpiceInt handle ); - - - SpiceBoolean elemc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - SpiceBoolean elemd_c ( SpiceDouble item, - SpiceCell * set ); - - - SpiceBoolean elemi_c ( SpiceInt item, - SpiceCell * set ); - - - SpiceBoolean eqstr_c ( ConstSpiceChar * a, - ConstSpiceChar * b ); - - - void el2cgv_c ( ConstSpiceEllipse * ellipse, - SpiceDouble center[3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ); - - - void erract_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * action ); - - - void errch_c ( ConstSpiceChar * marker, - ConstSpiceChar * string ); - - - void errdev_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * device ); - - - void errdp_c ( ConstSpiceChar * marker, - SpiceDouble number ); - - - void errint_c ( ConstSpiceChar * marker, - SpiceInt number ); - - - void errprt_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * list ); - - - SpiceInt esrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - void etcal_c ( SpiceDouble et, - SpiceInt lenout, - SpiceChar * string ); - - - void et2lst_c ( SpiceDouble et, - SpiceInt body, - SpiceDouble lon, - ConstSpiceChar * type, - SpiceInt timlen, - SpiceInt ampmlen, - SpiceInt * hr, - SpiceInt * mn, - SpiceInt * sc, - SpiceChar * time, - SpiceChar * ampm ); - - - void et2utc_c ( SpiceDouble et , - ConstSpiceChar * format, - SpiceInt prec, - SpiceInt lenout, - SpiceChar * utcstr ); - - - void eul2m_c ( SpiceDouble angle3, - SpiceDouble angle2, - SpiceDouble angle1, - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble r [3][3] ); - - - void eul2xf_c ( ConstSpiceDouble eulang[6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble xform [6][6] ); - - - SpiceBoolean exists_c ( ConstSpiceChar * name ); - - - void expool_c ( ConstSpiceChar * name, - SpiceBoolean * found ); - - - SpiceBoolean failed_c ( void ); - - - void frame_c ( SpiceDouble x[3], - SpiceDouble y[3], - SpiceDouble z[3] ); - - - void frinfo_c ( SpiceInt frcode, - SpiceInt * cent, - SpiceInt * clss, - SpiceInt * clssid, - SpiceBoolean * found ); - - - void frmnam_c ( SpiceInt frcode, - SpiceInt lenout, - SpiceChar * frname ); - - - void ftncls_c ( SpiceInt unit ); - - - void furnsh_c ( ConstSpiceChar * file ); - - - void gcpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * cvals, - SpiceBoolean * found ); - - - void gdpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceDouble * values, - SpiceBoolean * found ); - - - void georec_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ); - - - void getcml_c ( SpiceInt * argc, - SpiceChar *** argv ); - - - void getelm_c ( SpiceInt frstyr, - SpiceInt lineln, - const void * lines, - SpiceDouble * epoch, - SpiceDouble * elems ); - - - void getfat_c ( ConstSpiceChar * file, - SpiceInt arclen, - SpiceInt typlen, - SpiceChar * arch, - SpiceChar * type ); - - - void getfov_c ( SpiceInt instid, - SpiceInt room, - SpiceInt shapelen, - SpiceInt framelen, - SpiceChar * shape, - SpiceChar * frame, - SpiceDouble bsight [3], - SpiceInt * n, - SpiceDouble bounds [][3] ); - - - void getmsg_c ( ConstSpiceChar * option, - SpiceInt lenout, - SpiceChar * msg ); - - - SpiceBoolean gfbail_c ( void ); - - - void gfclrh_c ( void ); - - - void gfdist_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gfevnt_c ( void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - ConstSpiceChar * gquant, - SpiceInt qnpars, - SpiceInt lenvals, - const void * qpnams, - const void * qcpars, - ConstSpiceDouble * qdpars, - ConstSpiceInt * qipars, - ConstSpiceBoolean * qlpars, - ConstSpiceChar * op, - SpiceDouble refval, - SpiceDouble tol, - SpiceDouble adjust, - SpiceBoolean rpt, - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - - void ( * udrepf ) ( void ), - SpiceInt nintvls, - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gffove_c ( ConstSpiceChar * inst, - ConstSpiceChar * tshape, - ConstSpiceDouble raydir [3], - ConstSpiceChar * target, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfinth_c ( int sigcode ); - - - void gfocce_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * obsrvr, - ConstSpiceChar * abcorr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gfoclt_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * obsrvr, - ConstSpiceChar * abcorr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfposc_c ( ConstSpiceChar * target, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfrefn_c ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ); - - - void gfrepf_c ( void ); - - - void gfrepi_c ( SpiceCell * window, - ConstSpiceChar * begmss, - ConstSpiceChar * endmss ); - - - void gfrepu_c ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble time ); - - - void gfrfov_c ( ConstSpiceChar * inst, - ConstSpiceDouble raydir [3], - ConstSpiceChar * rframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfrr_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsep_c ( ConstSpiceChar * targ1, - ConstSpiceChar * frame1, - ConstSpiceChar * shape1, - ConstSpiceChar * targ2, - ConstSpiceChar * frame2, - ConstSpiceChar * shape2, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsntc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsstp_c ( SpiceDouble step ); - - - void gfstep_c ( SpiceDouble time, - SpiceDouble * step ); - - - void gfsubc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gftfov_c ( ConstSpiceChar * inst, - ConstSpiceChar * target, - ConstSpiceChar * tshape, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfuds_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - - void ( * udqdec ) ( void ( * udfunc ) - ( SpiceDouble x, - SpiceDouble * value ), - - SpiceDouble x, - SpiceBoolean * isdecr ), - - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gipool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceInt * ivals, - SpiceBoolean * found ); - - - void gnpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * kvars, - SpiceBoolean * found ); - - - SpiceDouble halfpi_c ( void ); - - void hx2dp_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * number, - SpiceBoolean * error, - SpiceChar * errmsg - ); - - - void ident_c ( SpiceDouble matrix[3][3] ); - - - void ilumin_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ); - - - void illum_c ( ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ); - - - void inedpl_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpicePlane * plane, - SpiceEllipse * ellipse, - SpiceBoolean * found ); - - - void inelpl_c ( ConstSpiceEllipse * ellips, - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt1[3], - SpiceDouble xpt2[3] ); - - - void insrtc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - void insrtd_c ( SpiceDouble item, - SpiceCell * set ); - - - void insrti_c ( SpiceInt item, - SpiceCell * set ); - - - void inter_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void inrypl_c ( ConstSpiceDouble vertex [3], - ConstSpiceDouble dir [3], - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt [3] ); - - - SpiceInt intmax_c ( void ); - - - SpiceInt intmax_ ( void ); - - - SpiceInt intmin_c ( void ); - - - SpiceInt intmin_ ( void ); - - - void invert_c ( ConstSpiceDouble m1[3][3], - SpiceDouble m2[3][3] ); - - - void invort_c ( ConstSpiceDouble m [3][3], - SpiceDouble mit[3][3] ); - - - SpiceBoolean isordv_c ( ConstSpiceInt * array, - SpiceInt n ); - - - SpiceBoolean isrot_c ( ConstSpiceDouble m [3][3], - SpiceDouble ntol, - SpiceDouble dtol ); - - - - SpiceInt isrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - SpiceInt isrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ); - - - SpiceInt isrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ); - - - SpiceBoolean iswhsp_c ( ConstSpiceChar * string ); - - - SpiceDouble j1900_c ( void ); - - - SpiceDouble j1950_c ( void ); - - - SpiceDouble j2000_c ( void ); - - - SpiceDouble j2100_c ( void ); - - - SpiceDouble jyear_c ( void ); - - - void kclear_c ( void ); - - - void kdata_c ( SpiceInt which, - ConstSpiceChar * kind, - SpiceInt fillen, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * file, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ); - - - void kinfo_c ( ConstSpiceChar * file, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ); - - - void ktotal_c ( ConstSpiceChar * kind, - SpiceInt * count ); - - - void kxtrct_c ( ConstSpiceChar * keywd, - SpiceInt termlen, - const void * terms, - SpiceInt nterms, - SpiceInt stringlen, - SpiceInt substrlen, - SpiceChar * string, - SpiceBoolean * found, - SpiceChar * substr ); - - - SpiceInt lastnb_c ( ConstSpiceChar * string ); - - - void latcyl_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * r, - SpiceDouble * lonc, - SpiceDouble * z ); - - - void latrec_c ( SpiceDouble radius, - SpiceDouble longitude, - SpiceDouble latitude, - SpiceDouble rectan [3] ); - - - void latsph_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * rho, - SpiceDouble * colat, - SpiceDouble * lons ); - - - void lcase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ); - - - void ldpool_c ( ConstSpiceChar * filename ); - - - void lmpool_c ( const void * cvals, - SpiceInt lenvals, - SpiceInt n ); - - - void lparse_c ( ConstSpiceChar * list, - ConstSpiceChar * delim, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ); - - - void lparsm_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ); - - - void lparss_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceCell * set ); - - - SpiceDouble lspcn_c ( ConstSpiceChar * body, - SpiceDouble et, - ConstSpiceChar * abcorr ); - - - SpiceInt lstlec_c ( ConstSpiceChar * string, - SpiceInt n, - SpiceInt lenvals, - const void * array ); - - - SpiceInt lstled_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ); - - - SpiceInt lstlei_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ); - - - SpiceInt lstltc_c ( ConstSpiceChar * string, - SpiceInt n, - SpiceInt lenvals, - const void * array ); - - - SpiceInt lstltd_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ); - - - SpiceInt lstlti_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ); - - - void ltime_c ( SpiceDouble etobs, - SpiceInt obs, - ConstSpiceChar * dir, - SpiceInt targ, - SpiceDouble * ettarg, - SpiceDouble * elapsd ); - - - void lx4dec_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4num_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4sgn_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4uns_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lxqstr_c ( ConstSpiceChar * string, - SpiceChar qchar, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void m2eul_c ( ConstSpiceDouble r[3][3], - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble * angle3, - SpiceDouble * angle2, - SpiceDouble * angle1 ); - - - void m2q_c ( ConstSpiceDouble r[3][3], - SpiceDouble q[4] ); - - - - SpiceBoolean matchi_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ); - - - SpiceBoolean matchw_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ); - - - SpiceDouble maxd_c ( SpiceInt n, - ... ); - - - SpiceInt maxi_c ( SpiceInt n, - ... ); - - - void mequ_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ); - - - void mequg_c ( const void * m1, - SpiceInt nr, - SpiceInt nc, - void * mout ); - - - SpiceDouble mind_c ( SpiceInt n, - ... ); - - - SpiceInt mini_c ( SpiceInt n, - ... ); - - - int moved_ ( SpiceDouble * arrfrm, - SpiceInt * ndim, - SpiceDouble * arrto ); - - - void mtxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mtxmg_c ( const void * m1, - const void * m2, - SpiceInt row1, - SpiceInt col1, - SpiceInt col2, - void * mout ); - - - void mtxv_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble vin [3], - SpiceDouble vout[3] ); - - - void mtxvg_c ( const void * m1, - const void * v2, - SpiceInt ncol1, - SpiceInt nr1r2, - void * vout ); - - - void mxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mxmg_c ( const void * m1, - const void * m2, - SpiceInt row1, - SpiceInt col1, - SpiceInt col2, - void * mout ); - - - void mxmt_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mxmtg_c ( const void * m1, - const void * m2, - SpiceInt nrow1, - SpiceInt nc1c2, - SpiceInt nrow2, - void * mout ); - - - void mxv_c ( ConstSpiceDouble m1[3][3], - ConstSpiceDouble vin[3], - SpiceDouble vout[3] ); - - - void mxvg_c ( const void * m1, - const void * v2, - SpiceInt nrow1, - SpiceInt nc1r2, - void * vout ); - - - void namfrm_c ( ConstSpiceChar * frname, - SpiceInt * frcode ); - - - SpiceInt ncpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - SpiceInt ncposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - void nearpt_c ( ConstSpiceDouble positn[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble npoint[3], - SpiceDouble * alt ); - - - void npedln_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble linept[3], - ConstSpiceDouble linedr[3], - SpiceDouble pnear[3], - SpiceDouble * dist ); - - - void npelpt_c ( ConstSpiceDouble point[3], - ConstSpiceEllipse * ellips, - SpiceDouble pnear[3], - SpiceDouble * dist ); - - - void nplnpt_c ( ConstSpiceDouble linpt [3], - ConstSpiceDouble lindir [3], - ConstSpiceDouble point [3], - SpiceDouble pnear [3], - SpiceDouble * dist ); - - - void nvc2pl_c ( ConstSpiceDouble normal[3], - SpiceDouble constant, - SpicePlane * plane ); - - - void nvp2pl_c ( ConstSpiceDouble normal[3], - ConstSpiceDouble point[3], - SpicePlane * plane ); - - - SpiceInt ordc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - SpiceInt ordd_c ( SpiceDouble item, - SpiceCell * set ); - - - SpiceInt ordi_c ( SpiceInt item, - SpiceCell * set ); - - - void orderc_c ( SpiceInt lenvals, - const void * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void orderd_c ( ConstSpiceDouble * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void orderi_c ( ConstSpiceInt * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void oscelt_c ( ConstSpiceDouble state[6], - SpiceDouble et , - SpiceDouble mu , - SpiceDouble elts[8] ); - - - void pckcov_c ( ConstSpiceChar * pck, - SpiceInt idcode, - SpiceCell * cover ); - - - void pckfrm_c ( ConstSpiceChar * pck, - SpiceCell * ids ); - - - void pcklof_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void pckuof_c ( SpiceInt handle ); - - - void pcpool_c ( ConstSpiceChar * name, - SpiceInt n, - SpiceInt lenvals, - const void * cvals ); - - - void pdpool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceDouble * dvals ); - - - void pgrrec_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ); - - - SpiceDouble pi_c ( void ); - - - void pipool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceInt * ivals ); - - - void pjelpl_c ( ConstSpiceEllipse * elin, - ConstSpicePlane * plane, - SpiceEllipse * elout ); - - - void pl2nvc_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble * constant ); - - - void pl2nvp_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble point[3] ); - - - void pl2psv_c ( ConstSpicePlane * plane, - SpiceDouble point[3], - SpiceDouble span1[3], - SpiceDouble span2[3] ); - - - SpiceInt pos_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ); - - - SpiceInt posr_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ); - - - void prefix_c ( ConstSpiceChar * pref, - SpiceInt spaces, - SpiceInt lenout, - SpiceChar * string ); - - - SpiceChar * prompt_c ( ConstSpiceChar * prmptStr, - SpiceInt lenout, - SpiceChar * buffer ); - - - void prop2b_c ( SpiceDouble gm, - ConstSpiceDouble pvinit[6], - SpiceDouble dt, - SpiceDouble pvprop[6] ); - - - void prsdp_c ( ConstSpiceChar * string, - SpiceDouble * dpval ); - - - void prsint_c ( ConstSpiceChar * string, - SpiceInt * intval ); - - - void psv2pl_c ( ConstSpiceDouble point[3], - ConstSpiceDouble span1[3], - ConstSpiceDouble span2[3], - SpicePlane * plane ); - - - void putcml_c ( SpiceInt argc , - SpiceChar ** argv ); - - - void pxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble rotate[3][3] ); - - - void q2m_c ( ConstSpiceDouble q[4], - SpiceDouble r[3][3] ); - - - void qdq2av_c ( ConstSpiceDouble q[4], - ConstSpiceDouble dq[4], - SpiceDouble av[3] ); - - - void qxq_c ( ConstSpiceDouble q1[4], - ConstSpiceDouble q2[4], - SpiceDouble qout[4] ); - - - - void radrec_c ( SpiceDouble range, - SpiceDouble ra, - SpiceDouble dec, - SpiceDouble rectan[3] ); - - - void rav2xf_c ( ConstSpiceDouble rot [3][3], - ConstSpiceDouble av [3], - SpiceDouble xform [6][6] ); - - - void raxisa_c ( ConstSpiceDouble matrix[3][3], - SpiceDouble axis [3], - SpiceDouble * angle ); - - - void rdtext_c ( ConstSpiceChar * file, - SpiceInt lenout, - SpiceChar * line, - SpiceBoolean * eof ); - - - void reccyl_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ); - - - void recgeo_c ( ConstSpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ); - - - void reclat_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * longitude, - SpiceDouble * latitude ); - - - void recpgr_c ( ConstSpiceChar * body, - SpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ); - - - void recrad_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * ra, - SpiceDouble * dec ); - - - - void reordc_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt lenvals, - void * array ); - - - void reordd_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceDouble * array ); - - - void reordi_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt * array ); - - - void reordl_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceBoolean * array ); - - - void removc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - void removd_c ( SpiceDouble item, - SpiceCell * set ); - - - void removi_c ( SpiceInt item, - SpiceCell * set ); - - - void repmc_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - ConstSpiceChar * value, - SpiceInt lenout, - SpiceChar * out ); - - - void repmct_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar strCase, - SpiceInt lenout, - SpiceChar * out ); - - - void repmd_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceInt lenout, - SpiceChar * out ); - - - void repmf_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceChar format, - SpiceInt lenout, - SpiceChar * out ); - - - void repmi_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceInt lenout, - SpiceChar * out ); - - - void repmot_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar strCase, - SpiceInt lenout, - SpiceChar * out ); - - - void reset_c ( void ); - - - SpiceBoolean return_c ( void ); - - - void recsph_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * colat, - SpiceDouble * lon ); - - - void rotate_c ( SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ); - - - void rotmat_c ( ConstSpiceDouble m1[3][3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ); - - - void rotvec_c ( ConstSpiceDouble v1[3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble vout[3] ); - - - SpiceDouble rpd_c ( void ); - - - void rquad_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble root1[2], - SpiceDouble root2[2] ); - - - void saelgv_c ( ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ); - - - void scard_c ( SpiceInt card, - SpiceCell * cell ); - - - void scdecd_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceInt sclklen, - SpiceChar * sclkch ); - - - void sce2s_c ( SpiceInt sc, - SpiceDouble et, - SpiceInt sclklen, - SpiceChar * sclkch ); - - - void sce2c_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ); - - - void sce2t_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ); - - - void scencd_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * sclkdp ); - - - void scfmt_c ( SpiceInt sc, - SpiceDouble ticks, - SpiceInt clkstrlen, - SpiceChar * clkstr ); - - - void scpart_c ( SpiceInt sc, - SpiceInt * nparts, - SpiceDouble * pstart, - SpiceDouble * pstop ); - - - void scs2e_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * et ); - - - void sct2e_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceDouble * et ); - - - void sctiks_c ( SpiceInt sc, - ConstSpiceChar * clkstr, - SpiceDouble * ticks ); - - - void sdiff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean set_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ); - - - void setmsg_c ( ConstSpiceChar * msg ); - - - void shellc_c ( SpiceInt ndim, - SpiceInt lenvals, - void * array ); - - - void shelld_c ( SpiceInt ndim, - SpiceDouble * array ); - - - void shelli_c ( SpiceInt ndim, - SpiceInt * array ); - - - void sigerr_c ( ConstSpiceChar * message ); - - - void sincpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceBoolean * found ); - - - SpiceInt size_c ( SpiceCell * size ); - - - SpiceDouble spd_c ( void ); - - - void sphcyl_c ( SpiceDouble radius, - SpiceDouble colat, - SpiceDouble slon, - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ); - - - void sphlat_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lons, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ); - - - void sphrec_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble rectan[3] ); - - - void spk14a_c ( SpiceInt handle, - SpiceInt ncsets, - ConstSpiceDouble coeffs [], - ConstSpiceDouble epochs [] ); - - - void spk14b_c ( SpiceInt handle, - ConstSpiceChar * segid, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - SpiceInt chbdeg ); - - - void spk14e_c ( SpiceInt handle ); - - - void spkapo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs[6], - ConstSpiceChar * abcorr, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkapp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs [6], - ConstSpiceChar * abcorr, - SpiceDouble starg [6], - SpiceDouble * lt ); - - - void spkcls_c ( SpiceInt handle ); - - - void spkcov_c ( ConstSpiceChar * spk, - SpiceInt idcode, - SpiceCell * cover ); - - - void spkacs_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkaps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - ConstSpiceDouble accobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkez_c ( SpiceInt target, - SpiceDouble epoch, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - SpiceInt observer, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkezp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkezr_c ( ConstSpiceChar * target, - SpiceDouble epoch, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * observer, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkgeo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkgps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble pos[3], - SpiceDouble * lt ); - - - void spklef_c ( ConstSpiceChar * filename, - SpiceInt * handle ); - - - void spkltc_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkobj_c ( ConstSpiceChar * spk, - SpiceCell * ids ); - - - void spkopa_c ( ConstSpiceChar * file, - SpiceInt * handle ); - - - void spkopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void spkpds_c ( SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceInt type, - SpiceDouble first, - SpiceDouble last, - SpiceDouble descr[5] ); - - - void spkpos_c ( ConstSpiceChar * targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkssb_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceDouble starg[6] ); - - - void spksub_c ( SpiceInt handle, - SpiceDouble descr[5], - ConstSpiceChar * ident, - SpiceDouble begin, - SpiceDouble end, - SpiceInt newh ); - - - void spkuds_c ( ConstSpiceDouble descr [5], - SpiceInt * body, - SpiceInt * center, - SpiceInt * frame, - SpiceInt * type, - SpiceDouble * first, - SpiceDouble * last, - SpiceInt * begin, - SpiceInt * end ); - - - void spkuef_c ( SpiceInt handle ); - - - void spkw02_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ); - - - void spkw03_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ); - - - void spkw05_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble gm, - SpiceInt n, - ConstSpiceDouble states [][6], - ConstSpiceDouble epochs [] ); - - - void spkw08_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch1, - SpiceDouble step ); - - - void spkw09_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ); - - - void spkw10_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - ConstSpiceDouble consts [8], - SpiceInt n, - ConstSpiceDouble elems [], - ConstSpiceDouble epochs [] ); - - - void spkw12_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch0, - SpiceDouble step ); - - - void spkw13_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ); - - - void spkw15_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble tp [3], - ConstSpiceDouble pa [3], - SpiceDouble p, - SpiceDouble ecc, - SpiceDouble j2flg, - ConstSpiceDouble pv [3], - SpiceDouble gm, - SpiceDouble j2, - SpiceDouble radius ); - - - void spkw17_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble eqel [9], - SpiceDouble rapol, - SpiceDouble decpol ); - - - void spkw18_c ( SpiceInt handle, - SpiceSPK18Subtype subtyp, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - const void * packts, - ConstSpiceDouble epochs[] ); - - - void srfrec_c ( SpiceInt body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble rectan[3] ); - - - void srfxpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * dist, - SpiceDouble * trgepc, - SpiceDouble obspos [3], - SpiceBoolean * found ); - - - void ssize_c ( SpiceInt size, - SpiceCell * cell ); - - - void stelab_c ( ConstSpiceDouble pobj[3], - ConstSpiceDouble vobs[3], - SpiceDouble appobj[3] ); - - - void stpool_c ( ConstSpiceChar * item, - SpiceInt nth, - ConstSpiceChar * contin, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * size, - SpiceBoolean * found ); - - - void str2et_c ( ConstSpiceChar * date, - SpiceDouble * et ); - - - void subpnt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ); - - - void subpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * alt ); - - - void subslr_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ); - - - void subsol_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint[3] ); - - - SpiceDouble sumad_c ( ConstSpiceDouble array[], - SpiceInt n ); - - - SpiceInt sumai_c ( ConstSpiceInt array[], - SpiceInt n ); - - - void surfnm_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble point[3], - SpiceDouble normal[3] ); - - - void surfpt_c ( ConstSpiceDouble positn[3], - ConstSpiceDouble u[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble point[3], - SpiceBoolean * found ); - - - void surfpv_c ( ConstSpiceDouble stvrtx[6], - ConstSpiceDouble stdir [6], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble stx [6], - SpiceBoolean * found ); - - - void swpool_c ( ConstSpiceChar * agent, - SpiceInt nnames, - SpiceInt lenvals, - const void * names ); - - - void sxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble xform[6][6] ); - - - void szpool_c ( ConstSpiceChar * name, - SpiceInt * n, - SpiceBoolean * found ); - - - void timdef_c ( ConstSpiceChar * action, - ConstSpiceChar * item, - SpiceInt lenout, - SpiceChar * value ); - - - void timout_c ( SpiceDouble et, - ConstSpiceChar * pictur, - SpiceInt lenout, - SpiceChar * output ); - - - void tipbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tipm[3][3] ); - - - void tisbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tsipm[6][6] ); - - - ConstSpiceChar * tkvrsn_c ( ConstSpiceChar * item ); - - - void tparse_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * sp2000, - SpiceChar * errmsg ); - - - void tpictr_c ( ConstSpiceChar * sample, - SpiceInt lenpictur, - SpiceInt lenerror, - SpiceChar * pictur, - SpiceBoolean * ok, - SpiceChar * error ); - - - SpiceDouble trace_c ( ConstSpiceDouble matrix[3][3] ); - - - void trcoff_c ( void ); - - - void tsetyr_c ( SpiceInt year ); - - - SpiceDouble twopi_c ( void ); - - - void twovec_c ( ConstSpiceDouble axdef [3], - SpiceInt indexa, - ConstSpiceDouble plndef [3], - SpiceInt indexp, - SpiceDouble mout [3][3] ); - - - SpiceDouble tyear_c ( void ); - - - void ucase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ); - - - void ucrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - void uddc_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - - SpiceDouble x, - SpiceDouble dx, - SpiceBoolean * isdecr ); - - - void uddf_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - SpiceDouble x, - SpiceDouble dx, - SpiceDouble * deriv ); - - - void union_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceDouble unitim_c ( SpiceDouble epoch, - ConstSpiceChar * insys, - ConstSpiceChar * outsys ); - - - void unload_c ( ConstSpiceChar * file ); - - - void unorm_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3], - SpiceDouble * vmag ); - - - void unormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout, - SpiceDouble * vmag ); - - - void utc2et_c ( ConstSpiceChar * utcstr, - SpiceDouble * et ); - - - void vadd_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) ; - - - void vaddg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ); - - - void valid_c ( SpiceInt size, - SpiceInt n, - SpiceCell * a ); - - - void vcrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - SpiceDouble vdist_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - SpiceDouble vdistg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - SpiceDouble vdot_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - SpiceDouble vdotg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - void vequ_c ( ConstSpiceDouble vin[3], - SpiceDouble vout[3] ); - - - void vequg_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vhat_c ( ConstSpiceDouble v1 [3], - SpiceDouble vout[3] ); - - - void vhatg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vlcom_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble sum[3] ); - - - void vlcom3_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble c, - ConstSpiceDouble v3[3], - SpiceDouble sum[3] ); - - - void vlcomg_c ( SpiceInt n, - SpiceDouble a, - ConstSpiceDouble * v1, - SpiceDouble b, - ConstSpiceDouble * v2, - SpiceDouble * sum ); - - - void vminug_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vminus_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3] ); - - - SpiceDouble vnorm_c ( ConstSpiceDouble v1[3] ); - - - SpiceDouble vnormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim ); - - - void vpack_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble v[3] ); - - - void vperp_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ); - - - void vprjp_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * plane, - SpiceDouble vout [3] ); - - - void vprjpi_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * projpl, - ConstSpicePlane * invpl, - SpiceDouble vout [3], - SpiceBoolean * found ); - - - void vproj_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ); - - - SpiceDouble vrel_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - SpiceDouble vrelg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - void vrotv_c ( ConstSpiceDouble v[3], - ConstSpiceDouble axis[3], - SpiceDouble theta, - SpiceDouble r[3] ); - - - void vscl_c ( SpiceDouble s, - ConstSpiceDouble v1[3], - SpiceDouble vout[3] ); - - - void vsclg_c ( SpiceDouble s, - ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ); - - - SpiceDouble vsep_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - void vsub_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - void vsubg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ); - - - SpiceDouble vsepg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - SpiceDouble vtmv_c ( ConstSpiceDouble v1 [3], - ConstSpiceDouble matrix [3][3], - ConstSpiceDouble v2 [3] ); - - - SpiceDouble vtmvg_c ( const void * v1, - const void * matrix, - const void * v2, - SpiceInt nrow, - SpiceInt ncol ); - - - void vupack_c ( ConstSpiceDouble v[3], - SpiceDouble * x, - SpiceDouble * y, - SpiceDouble * z ); - - SpiceBoolean vzero_c ( ConstSpiceDouble v[3] ); - - - SpiceBoolean vzerog_c ( ConstSpiceDouble * v, - SpiceInt ndim ); - - SpiceInt wncard_c ( SpiceCell * window ); - - void wncomd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window, - SpiceCell * result ); - - - void wncond_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wndifd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean wnelmd_c ( SpiceDouble point, - SpiceCell * window ); - - - void wnexpd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wnextd_c ( SpiceChar side, - SpiceCell * window ); - - - void wnfetd_c ( SpiceCell * window, - SpiceInt n, - SpiceDouble * left, - SpiceDouble * right ); - - - void wnfild_c ( SpiceDouble sml, - SpiceCell * window ); - - - void wnfltd_c ( SpiceDouble sml, - SpiceCell * window ); - - - SpiceBoolean wnincd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wninsd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wnintd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean wnreld_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ); - - - void wnsumd_c ( SpiceCell * window, - SpiceDouble * meas, - SpiceDouble * avg, - SpiceDouble * stddev, - SpiceInt * shortest, - SpiceInt * longest ); - - - void wnunid_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void wnvald_c ( SpiceInt size, - SpiceInt n, - SpiceCell * window ); - - - - void xf2eul_c ( ConstSpiceDouble xform [6][6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble eulang [6], - SpiceBoolean * unique ); - - - void xf2rav_c ( ConstSpiceDouble xform [6][6], - SpiceDouble rot [3][3], - SpiceDouble av [3] ); - - - void xpose_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ); - - - void xpose6_c ( ConstSpiceDouble m1 [6][6], - SpiceDouble mout[6][6] ); - - - void xposeg_c ( const void * matrix, - SpiceInt nrow, - SpiceInt ncol, - void * xposem ); - - - void zzgetcml_c( SpiceInt * argc, - SpiceChar *** argv, - SpiceBoolean init ); - - - SpiceBoolean zzgfgeth_c ( void ); - - - void zzgfsavh_c( SpiceBoolean status ); - - - void zzsynccl_c( SpiceTransDir xdir, - SpiceCell * cell ); - - -#endif diff --git a/ext/spice/include/SpiceZst.h b/ext/spice/include/SpiceZst.h deleted file mode 100644 index ba48b16c1c..0000000000 --- a/ext/spice/include/SpiceZst.h +++ /dev/null @@ -1,199 +0,0 @@ -/* - --Header_File SpiceZst.h ( Fortran/C string conversion utilities ) - --Abstract - - Define prototypes for CSPICE Fortran/C string conversion utilities. - - Caution: these prototypes are subject to revision without notice. - - These are private routines and are not part of the official CSPICE - user interface. - --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. - --Particulars - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 6.0.0, 10-JUL-2002 (NJB) - - Added prototype for new functions C2F_MapStrArr and - C2F_MapFixStrArr. - - -CSPICE Version 5.0.0, 18-MAY-2001 (WLT) - - Added #ifdef's to add namespace specification for C++ compilation. - - -CSPICE Version 4.0.0, 14-FEB-2000 (NJB) - - Added prototype for new function C2F_CreateStrArr_Sig. - - -CSPICE Version 3.0.0, 12-JUL-1999 (NJB) - - Added prototype for function C2F_CreateFixStrArr. - Added prototype for function F2C_ConvertTrStrArr. - Removed reference in comments to C2F_CreateStrArr_Sig, which - does not exist. - - -CSPICE Version 2.0.1, 06-MAR-1998 (NJB) - - Type SpiceVoid was changed to void. - - -CSPICE Version 2.0.1, 09-FEB-1998 (EDW) - - Added prototype for F2C_ConvertStrArr. - - -CSPICE Version 2.0.0, 04-JAN-1998 (NJB) - - Added prototype for F2C_ConvertStr. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - protoypes of CSPICE Fortran/C string conversion utilities - -*/ - -#include -#include -#include "SpiceZdf.h" - -#ifndef HAVE_FCSTRINGS_H -#define HAVE_FCSTRINGS_H - -#ifdef __cplusplus -namespace Jpl_NAIF_CSpice { -#endif - - SpiceStatus C2F_CreateStr ( ConstSpiceChar *, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateStr_Sig ( ConstSpiceChar *, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateFixStrArr ( SpiceInt nStr, - SpiceInt cStrDim, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - SpiceStatus C2F_CreateStrArr ( SpiceInt, - ConstSpiceChar **, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateStrArr_Sig ( SpiceInt nStr, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - void C2F_MapFixStrArr ( ConstSpiceChar * caller, - SpiceInt nStr, - SpiceInt cStrLen, - const void * cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - void C2F_MapStrArr ( ConstSpiceChar * caller, - SpiceInt nStr, - SpiceInt cStrLen, - const void * cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - SpiceStatus C2F_StrCpy ( ConstSpiceChar *, - SpiceInt, - SpiceChar * ); - - void F_Alloc ( SpiceInt, - SpiceChar** ); - - void F2C_ConvertStr ( SpiceInt, - SpiceChar * ); - - void F2C_ConvertStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ); - - void F2C_ConvertTrStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ); - - SpiceStatus F2C_CreateStr ( SpiceInt, - ConstSpiceChar *, - SpiceChar ** ); - - void F2C_CreateStr_Sig ( SpiceInt, - ConstSpiceChar *, - SpiceChar ** ); - - SpiceStatus F2C_CreateStrArr ( SpiceInt, - SpiceInt, - ConstSpiceChar *, - SpiceChar *** ); - - void F2C_CreateStrArr_Sig ( SpiceInt, - SpiceInt, - ConstSpiceChar *, - SpiceChar *** ); - - void F2C_FreeStrArr ( SpiceChar **cStrArr ); - - - SpiceStatus F2C_StrCpy ( SpiceInt, - ConstSpiceChar *, - SpiceInt, - SpiceChar * ); - - SpiceInt F_StrLen ( SpiceInt, - ConstSpiceChar * ); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/ext/spice/include/f2c.h b/ext/spice/include/f2c.h deleted file mode 100644 index 079fdaf490..0000000000 --- a/ext/spice/include/f2c.h +++ /dev/null @@ -1,654 +0,0 @@ -/* - --Header_File f2c.h ( CSPICE version of the f2c standard header file ) - --Abstract - - Perform standard f2c declarations, customized for the host - environment. - --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. - --Particulars - - The standard f2c header file f2c.h must be included by every function - generated by running f2c on Fortran source code. The header f2c.h - includes typedefs used to provide a level of indirection in mapping - Fortran data types to native C data types. For example, Fortran - INTEGER variables are mapped to variables of type integer, where - integer is a C typedef. In the standard f2c.h header, the typedef - integer translates to the C type long. - - Because the standard version of f2c.h does not work on all platforms, - this header file contains two platform-dependent versions of it, - meant to be selected at build time via precompiler switches. The - precompiler switches reference macros defined in SpiceZpl.h to - determine for which host platform the code is targeted. The first - version of f2c.h, which works on most platforms, is copied directly - from the standard version of f2c.h. The second version is intended - for use on the DEC Alpha running Digital Unix and the Sun/Solaris - platform using 64 bit mode and running gcc. On those systems, longs - occupy 8 bytes, as do doubles. Because the Fortran standard requires - that INTEGERS occupy half the storage of DOUBLE PRECISION numbers, - INTEGERS should be mapped to 4-byte ints rather than 8-byte longs - on the platforms having 8-byte longs. In order to achieve this, the - header f2c.h was transformed using the sed command - - sed 's/long //' f2c.h - - The high-level structure of this file is then: - - # if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) ) - - - [ Alpha/Digital Unix and Sun Solaris 64 bit mode/gcc - version of f2c.h source code ] - - # else - - [ Standard version of f2c.h source code ] - - # endif - - --Restrictions - - 1) This header file must be updated whenever the f2c processor - or the f2c libraries libI77 and libF77 are updated. - - 2) This header may need to be updated to support new platforms. - The supported platforms at the time of the 31-JAN-1999 release - are: - - ALPHA-DIGITAL-UNIX - HP - NEXT - PC-LINUX - PC-MS - SGI-IRIX-N32 - SGI-IRIX-NO2 - SUN-SOLARIS - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 4.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 4.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 3.0.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - - Updated to support linking CSPICE into executables that - also link in objects compiled from Fortran, in particular - ones that perform Fortran I/O. To enable this odd mix, - one defines the preprocessor flag - - MIX_C_AND_FORTRAN - - This macro is undefined by default, since the action it invokes - is usually not desirable. See the header - - f2cMang.h - - for further information. - - -CSPICE Version 1.0.0, 07-FEB-1999 (NJB) - -*/ - - - /* - Optionally include name-mangling macros for f2c external symbols. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - - - /* - Include CSPICE platform macro definitions. - */ - #include "SpiceZpl.h" - - -#if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - - /* - MODIFICATION - - The following code is intended to be used on the platforms where - a long is the size of a double and an int is half the - size of a double. - - Note that the comment line below indicating that the header is - "Standard" has been retained from the original, but is no longer - true. - */ - - - - - -/* f2c.h -- Standard Fortran to C header file */ - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef int integer; -typedef unsigned uinteger; -typedef char *address; -typedef short int shortint; -typedef float real; -typedef double doublereal; -typedef struct { real r, i; } complex; -typedef struct { doublereal r, i; } doublecomplex; -typedef int logical; -typedef short int shortlogical; -typedef char logical1; -typedef char integer1; -#if 0 /* Adjust for integer*8. */ -typedef long longint; /* system-dependent */ -typedef unsigned long ulongint; /* system-dependent */ -#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) -#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) -#endif - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef int flag; -typedef int ftnlen; -typedef int ftnint; -#endif - -/*external read, write*/ -typedef struct -{ flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} cilist; - -/*internal read, write*/ -typedef struct -{ flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} icilist; - -/*open*/ -typedef struct -{ flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} olist; - -/*close*/ -typedef struct -{ flag cerr; - ftnint cunit; - char *csta; -} cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ flag aerr; - ftnint aunit; -} alist; - -/* inquire */ -typedef struct -{ flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - integer1 g; - shortint h; - integer i; - /* longint j; */ - real r; - doublereal d; - complex c; - doublecomplex z; - }; - -typedef union Multitype Multitype; - -/*typedef int Long;*/ /* No longer used; formerly in Namelist */ - -struct Vardesc { /* for Namelist */ - char *name; - char *addr; - ftnlen *dims; - int type; - }; -typedef struct Vardesc Vardesc; - -struct Namelist { - char *name; - Vardesc **vars; - int nvars; - }; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) -#define bit_test(a,b) ((a) >> (b) & 1) -#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) -#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint (*J_fp)(...); -typedef integer (*I_fp)(...); -typedef real (*R_fp)(...); -typedef doublereal (*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID (*C_fp)(...); -typedef /* Double Complex */ VOID (*Z_fp)(...); -typedef logical (*L_fp)(...); -typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); -typedef /* Subroutine */ int (*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint (*J_fp)(); -typedef integer (*I_fp)(); -typedef real (*R_fp)(); -typedef doublereal (*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID (*C_fp)(); -typedef /* Double Complex */ VOID (*Z_fp)(); -typedef logical (*L_fp)(); -typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_fp)(); -typedef /* Subroutine */ int (*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - /* - This marks the end of the MODIFICATION section version of f2c.h. - */ - -#else - - /* - The following code is the standard f2c.h header. In this - header, an "integer" is defined to be of type long. - - Because the code is copied verbatim, it does not follow the usual - CSPICE indentation pattern. - */ - - -/* f2c.h -- Standard Fortran to C header file */ - - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef long int integer; -typedef unsigned long uinteger; -typedef char *address; -typedef short int shortint; -typedef float real; -typedef double doublereal; -typedef struct { real r, i; } complex; -typedef struct { doublereal r, i; } doublecomplex; -typedef long int logical; -typedef short int shortlogical; -typedef char logical1; -typedef char integer1; -#if 0 /* Adjust for integer*8. */ -typedef long long longint; /* system-dependent */ -typedef unsigned long long ulongint; /* system-dependent */ -#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) -#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) -#endif - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef long int flag; -typedef long int ftnlen; -typedef long int ftnint; -#endif - -/*external read, write*/ -typedef struct -{ flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} cilist; - -/*internal read, write*/ -typedef struct -{ flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} icilist; - -/*open*/ -typedef struct -{ flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} olist; - -/*close*/ -typedef struct -{ flag cerr; - ftnint cunit; - char *csta; -} cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ flag aerr; - ftnint aunit; -} alist; - -/* inquire */ -typedef struct -{ flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - integer1 g; - shortint h; - integer i; - /* longint j; */ - real r; - doublereal d; - complex c; - doublecomplex z; - }; - -typedef union Multitype Multitype; - -/*typedef long int Long;*/ /* No longer used; formerly in Namelist */ - -struct Vardesc { /* for Namelist */ - char *name; - char *addr; - ftnlen *dims; - int type; - }; -typedef struct Vardesc Vardesc; - -struct Namelist { - char *name; - Vardesc **vars; - int nvars; - }; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) -#define bit_test(a,b) ((a) >> (b) & 1) -#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) -#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint (*J_fp)(...); -typedef integer (*I_fp)(...); -typedef real (*R_fp)(...); -typedef doublereal (*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID (*C_fp)(...); -typedef /* Double Complex */ VOID (*Z_fp)(...); -typedef logical (*L_fp)(...); -typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); -typedef /* Subroutine */ int (*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint (*J_fp)(); -typedef integer (*I_fp)(); -typedef real (*R_fp)(); -typedef doublereal (*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID (*C_fp)(); -typedef /* Double Complex */ VOID (*Z_fp)(); -typedef logical (*L_fp)(); -typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_fp)(); -typedef /* Subroutine */ int (*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - #endif - diff --git a/ext/spice/include/f2cMang.h b/ext/spice/include/f2cMang.h deleted file mode 100644 index f18fded688..0000000000 --- a/ext/spice/include/f2cMang.h +++ /dev/null @@ -1,390 +0,0 @@ -/* - --Header_File f2cMang.h ( f2c external symbol mangling ) - --Abstract - - Define macros that mangle the external symbols in the f2c F77 and I77 - libraries. - --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. - --Particulars - - This header supports linking CSPICE into executables that - also link in objects compiled from Fortran, in particular - ones that perform Fortran I/O. To enable this odd mix, - one defines the preprocessor flag - - MIX_C_AND_FORTRAN - - This macro is undefined by default, since the action it invokes - is usually not desirable. When the flag is defined, this header - defines macros that mangle the f2c library external symbols: - the symbol - - xxx - - gets mapped to - - xxx_f2c - - This mangling prevents name collisions between the f2c - implementations of the F77 and I77 library routines and those - in the corresponding Fortran libraries on a host system. - - The set of external symbols defined in the f2c libraries can - be determined by combining objects from both F77 and I77 into - a single Unix archive libarary, then running the Unix utility - nm on the that archive. If available, an nm option that selects - only external symbols should be invoked. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - 1) It is recommended that use of the features implemented by this - header be avoided if at all possible. There are robustness and - portability problems associated with linking Fortran and C objects - together in one executable. - - 2) When f2c external symbol name mangling is invoked, objects - derived from C code translated from Fortran by f2c won't - link against CSPICE any longer, if these objects reference - the standard f2c external symbols. - - 3) The features implemented by this header have been tested only - under the Sun Solaris GCC, Sun Solaris native ANSI C, and - PC/Linux/gcc environments. - --Version - - -CSPICE Version 2.0.1, 07-MAR-2009 (NJB) - - Restrictions header section was updated to note successful - testing on the PC/Linux/gcc platform. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - -*/ - - - /* - Define masking macros for f2c external symbols. - */ - #ifdef MIX_C_AND_FORTRAN - - /* - Define the macros only once, if they need to be defined. - */ - #ifndef F2C_MANGLING_DONE - - #define F77_aloc F77_aloc_f2c - #define F_err F_err_f2c - #define L_len L_len_f2c - #define abort_ abort__f2c - #define b_char b_char_f2c - #define c_abs c_abs_f2c - #define c_cos c_cos_f2c - #define c_dfe c_dfe_f2c - #define c_div c_div_f2c - #define c_due c_due_f2c - #define c_exp c_exp_f2c - #define c_le c_le_f2c - #define c_log c_log_f2c - #define c_sfe c_sfe_f2c - #define c_si c_si_f2c - #define c_sin c_sin_f2c - #define c_sqrt c_sqrt_f2c - #define c_sue c_sue_f2c - #define d_abs d_abs_f2c - #define d_acos d_acos_f2c - #define d_asin d_asin_f2c - #define d_atan d_atan_f2c - #define d_atn2 d_atn2_f2c - #define d_cnjg d_cnjg_f2c - #define d_cos d_cos_f2c - #define d_cosh d_cosh_f2c - #define d_dim d_dim_f2c - #define d_exp d_exp_f2c - #define d_imag d_imag_f2c - #define d_int d_int_f2c - #define d_lg10 d_lg10_f2c - #define d_log d_log_f2c - #define d_mod d_mod_f2c - #define d_nint d_nint_f2c - #define d_prod d_prod_f2c - #define d_sign d_sign_f2c - #define d_sin d_sin_f2c - #define d_sinh d_sinh_f2c - #define d_sqrt d_sqrt_f2c - #define d_tan d_tan_f2c - #define d_tanh d_tanh_f2c - #define derf_ derf__f2c - #define derfc_ derfc__f2c - #define do_fio do_fio_f2c - #define do_lio do_lio_f2c - #define do_ud do_ud_f2c - #define do_uio do_uio_f2c - #define do_us do_us_f2c - #define dtime_ dtime__f2c - #define e_rdfe e_rdfe_f2c - #define e_rdue e_rdue_f2c - #define e_rsfe e_rsfe_f2c - #define e_rsfi e_rsfi_f2c - #define e_rsle e_rsle_f2c - #define e_rsli e_rsli_f2c - #define e_rsue e_rsue_f2c - #define e_wdfe e_wdfe_f2c - #define e_wdue e_wdue_f2c - #define e_wsfe e_wsfe_f2c - #define e_wsfi e_wsfi_f2c - #define e_wsle e_wsle_f2c - #define e_wsli e_wsli_f2c - #define e_wsue e_wsue_f2c - #define ef1asc_ ef1asc__f2c - #define ef1cmc_ ef1cmc__f2c - #define en_fio en_fio_f2c - #define erf_ erf__f2c - #define erfc_ erfc__f2c - #define err__fl err__fl_f2c - #define etime_ etime__f2c - #define exit_ exit__f2c - #define f__Aquote f__Aquote_f2c - #define f__buflen f__buflen_f2c - #define f__cabs f__cabs_f2c - #define f__canseek f__canseek_f2c - #define f__cblank f__cblank_f2c - #define f__cf f__cf_f2c - #define f__cnt f__cnt_f2c - #define f__cp f__cp_f2c - #define f__cplus f__cplus_f2c - #define f__cursor f__cursor_f2c - #define f__curunit f__curunit_f2c - #define f__doed f__doed_f2c - #define f__doend f__doend_f2c - #define f__doned f__doned_f2c - #define f__donewrec f__donewrec_f2c - #define f__dorevert f__dorevert_f2c - #define f__elist f__elist_f2c - #define f__external f__external_f2c - #define f__fatal f__fatal_f2c - #define f__fmtbuf f__fmtbuf_f2c - #define f__formatted f__formatted_f2c - #define f__getn f__getn_f2c - #define f__hiwater f__hiwater_f2c - #define f__icend f__icend_f2c - #define f__icnum f__icnum_f2c - #define f__icptr f__icptr_f2c - #define f__icvt f__icvt_f2c - #define f__init f__init_f2c - #define f__inode f__inode_f2c - #define f__lchar f__lchar_f2c - #define f__lcount f__lcount_f2c - #define f__lioproc f__lioproc_f2c - #define f__lquit f__lquit_f2c - #define f__ltab f__ltab_f2c - #define f__ltype f__ltype_f2c - #define f__lx f__lx_f2c - #define f__ly f__ly_f2c - #define f__nonl f__nonl_f2c - #define f__nowreading f__nowreading_f2c - #define f__nowwriting f__nowwriting_f2c - #define f__parenlvl f__parenlvl_f2c - #define f__pc f__pc_f2c - #define f__putbuf f__putbuf_f2c - #define f__putn f__putn_f2c - #define f__r_mode f__r_mode_f2c - #define f__reading f__reading_f2c - #define f__reclen f__reclen_f2c - #define f__recloc f__recloc_f2c - #define f__recpos f__recpos_f2c - #define f__ret f__ret_f2c - #define f__revloc f__revloc_f2c - #define f__rp f__rp_f2c - #define f__scale f__scale_f2c - #define f__sequential f__sequential_f2c - #define f__svic f__svic_f2c - #define f__typesize f__typesize_f2c - #define f__units f__units_f2c - #define f__w_mode f__w_mode_f2c - #define f__workdone f__workdone_f2c - #define f_back f_back_f2c - #define f_clos f_clos_f2c - #define f_end f_end_f2c - #define f_exit f_exit_f2c - #define f_init f_init_f2c - #define f_inqu f_inqu_f2c - #define f_open f_open_f2c - #define f_rew f_rew_f2c - #define fk_open fk_open_f2c - #define flush_ flush__f2c - #define fmt_bg fmt_bg_f2c - #define fseek_ fseek__f2c - #define ftell_ ftell__f2c - #define g_char g_char_f2c - #define getenv_ getenv__f2c - #define h_abs h_abs_f2c - #define h_dim h_dim_f2c - #define h_dnnt h_dnnt_f2c - #define h_indx h_indx_f2c - #define h_len h_len_f2c - #define h_mod h_mod_f2c - #define h_nint h_nint_f2c - #define h_sign h_sign_f2c - #define hl_ge hl_ge_f2c - #define hl_gt hl_gt_f2c - #define hl_le hl_le_f2c - #define hl_lt hl_lt_f2c - #define i_abs i_abs_f2c - #define i_dim i_dim_f2c - #define i_dnnt i_dnnt_f2c - #define i_indx i_indx_f2c - #define i_len i_len_f2c - #define i_mod i_mod_f2c - #define i_nint i_nint_f2c - #define i_sign i_sign_f2c - #define iw_rev iw_rev_f2c - #define l_eof l_eof_f2c - #define l_ge l_ge_f2c - #define l_getc l_getc_f2c - #define l_gt l_gt_f2c - #define l_le l_le_f2c - #define l_lt l_lt_f2c - #define l_read l_read_f2c - #define l_ungetc l_ungetc_f2c - #define l_write l_write_f2c - #define lbit_bits lbit_bits_f2c - #define lbit_cshift lbit_cshift_f2c - #define lbit_shift lbit_shift_f2c - #define mk_hashtab mk_hashtab_f2c - #define nml_read nml_read_f2c - #define pars_f pars_f_f2c - #define pow_ci pow_ci_f2c - #define pow_dd pow_dd_f2c - #define pow_di pow_di_f2c - #define pow_hh pow_hh_f2c - #define pow_ii pow_ii_f2c - #define pow_ri pow_ri_f2c - #define pow_zi pow_zi_f2c - #define pow_zz pow_zz_f2c - #define r_abs r_abs_f2c - #define r_acos r_acos_f2c - #define r_asin r_asin_f2c - #define r_atan r_atan_f2c - #define r_atn2 r_atn2_f2c - #define r_cnjg r_cnjg_f2c - #define r_cos r_cos_f2c - #define r_cosh r_cosh_f2c - #define r_dim r_dim_f2c - #define r_exp r_exp_f2c - #define r_imag r_imag_f2c - #define r_int r_int_f2c - #define r_lg10 r_lg10_f2c - #define r_log r_log_f2c - #define r_mod r_mod_f2c - #define r_nint r_nint_f2c - #define r_sign r_sign_f2c - #define r_sin r_sin_f2c - #define r_sinh r_sinh_f2c - #define r_sqrt r_sqrt_f2c - #define r_tan r_tan_f2c - #define r_tanh r_tanh_f2c - #define rd_ed rd_ed_f2c - #define rd_ned rd_ned_f2c - #define s_cat s_cat_f2c - #define s_cmp s_cmp_f2c - #define s_copy s_copy_f2c - #define s_paus s_paus_f2c - #define s_rdfe s_rdfe_f2c - #define s_rdue s_rdue_f2c - #define s_rnge s_rnge_f2c - #define s_rsfe s_rsfe_f2c - #define s_rsfi s_rsfi_f2c - #define s_rsle s_rsle_f2c - #define s_rsli s_rsli_f2c - #define s_rsne s_rsne_f2c - #define s_rsni s_rsni_f2c - #define s_rsue s_rsue_f2c - #define s_stop s_stop_f2c - #define s_wdfe s_wdfe_f2c - #define s_wdue s_wdue_f2c - #define s_wsfe s_wsfe_f2c - #define s_wsfi s_wsfi_f2c - #define s_wsle s_wsle_f2c - #define s_wsli s_wsli_f2c - #define s_wsne s_wsne_f2c - #define s_wsni s_wsni_f2c - #define s_wsue s_wsue_f2c - #define sig_die sig_die_f2c - #define signal_ signal__f2c - #define system_ system__f2c - #define t_getc t_getc_f2c - #define t_runc t_runc_f2c - #define w_ed w_ed_f2c - #define w_ned w_ned_f2c - #define wrt_E wrt_E_f2c - #define wrt_F wrt_F_f2c - #define wrt_L wrt_L_f2c - #define x_endp x_endp_f2c - #define x_getc x_getc_f2c - #define x_putc x_putc_f2c - #define x_rev x_rev_f2c - #define x_rsne x_rsne_f2c - #define x_wSL x_wSL_f2c - #define x_wsne x_wsne_f2c - #define xrd_SL xrd_SL_f2c - #define y_getc y_getc_f2c - #define y_rsk y_rsk_f2c - #define z_abs z_abs_f2c - #define z_cos z_cos_f2c - #define z_div z_div_f2c - #define z_exp z_exp_f2c - #define z_getc z_getc_f2c - #define z_log z_log_f2c - #define z_putc z_putc_f2c - #define z_rnew z_rnew_f2c - #define z_sin z_sin_f2c - #define z_sqrt z_sqrt_f2c - #define z_wnew z_wnew_f2c - - #define F2C_MANGLING_DONE - - #endif - - - #endif - diff --git a/ext/spice/include/fio.h b/ext/spice/include/fio.h deleted file mode 100644 index bb20dd2ca0..0000000000 --- a/ext/spice/include/fio.h +++ /dev/null @@ -1,107 +0,0 @@ -#include "stdio.h" -#include "errno.h" -#ifndef NULL -/* ANSI C */ -#include "stddef.h" -#endif - -#ifndef SEEK_SET -#define SEEK_SET 0 -#define SEEK_CUR 1 -#define SEEK_END 2 -#endif - -#ifdef MSDOS -#ifndef NON_UNIX_STDIO -#define NON_UNIX_STDIO -#endif -#endif - -#ifdef UIOLEN_int -typedef int uiolen; -#else -typedef long uiolen; -#endif - -/*units*/ -typedef struct -{ FILE *ufd; /*0=unconnected*/ - char *ufnm; -#ifndef MSDOS - long uinode; - int udev; -#endif - int url; /*0=sequential*/ - flag useek; /*true=can backspace, use dir, ...*/ - flag ufmt; - flag urw; /* (1 for can read) | (2 for can write) */ - flag ublnk; - flag uend; - flag uwrt; /*last io was write*/ - flag uscrtch; -} unit; - -extern flag f__init; -extern cilist *f__elist; /*active external io list*/ -extern flag f__reading,f__external,f__sequential,f__formatted; -#undef Void -#ifdef KR_headers -#define Void /*void*/ -extern int (*f__getn)(); /* for formatted input */ -extern void (*f__putn)(); /* for formatted output */ -extern void x_putc(); -extern long f__inode(); -extern VOID sig_die(); -extern int (*f__donewrec)(), t_putc(), x_wSL(); -extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf(); -#else -#define Void void -#ifdef __cplusplus -extern "C" { -#endif -extern int (*f__getn)(void); /* for formatted input */ -extern void (*f__putn)(int); /* for formatted output */ -extern void x_putc(int); -extern long f__inode(char*,int*); -extern void sig_die(char*,int); -extern void f__fatal(int,char*); -extern int t_runc(alist*); -extern int f__nowreading(unit*), f__nowwriting(unit*); -extern int fk_open(int,int,ftnint); -extern int en_fio(void); -extern void f_init(void); -extern int (*f__donewrec)(void), t_putc(int), x_wSL(void); -extern void b_char(char*,char*,ftnlen), g_char(char*,ftnlen,char*); -extern int c_sfe(cilist*), z_rnew(void); -extern int isatty(int); -extern int err__fl(int,int,char*); -extern int xrd_SL(void); -extern int f__putbuf(int); -#ifdef __cplusplus - } -#endif -#endif -extern int (*f__doend)(Void); -extern FILE *f__cf; /*current file*/ -extern unit *f__curunit; /*current unit*/ -extern unit f__units[]; -#define err(f,m,s) {if(f) errno= m; else f__fatal(m,s); return(m);} -#define errfl(f,m,s) return err__fl((int)f,m,s) - -/*Table sizes*/ -#define MXUNIT 100 - -extern int f__recpos; /*position in current record*/ -extern int f__cursor; /* offset to move to */ -extern int f__hiwater; /* so TL doesn't confuse us */ - -#define WRITE 1 -#define READ 2 -#define SEQ 3 -#define DIR 4 -#define FMT 5 -#define UNF 6 -#define EXT 7 -#define INT 8 - -#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ) diff --git a/ext/spice/include/fmt.h b/ext/spice/include/fmt.h deleted file mode 100644 index 19065a2f04..0000000000 --- a/ext/spice/include/fmt.h +++ /dev/null @@ -1,100 +0,0 @@ -struct syl -{ int op; - int p1; - union { int i[2]; char *s;} p2; - }; -#define RET1 1 -#define REVERT 2 -#define GOTO 3 -#define X 4 -#define SLASH 5 -#define STACK 6 -#define I 7 -#define ED 8 -#define NED 9 -#define IM 10 -#define APOS 11 -#define H 12 -#define TL 13 -#define TR 14 -#define T 15 -#define COLON 16 -#define S 17 -#define SP 18 -#define SS 19 -#define P 20 -#define BN 21 -#define BZ 22 -#define F 23 -#define E 24 -#define EE 25 -#define D 26 -#define G 27 -#define GE 28 -#define L 29 -#define A 30 -#define AW 31 -#define O 32 -#define NONL 33 -#define OM 34 -#define Z 35 -#define ZM 36 -extern int f__pc,f__parenlvl,f__revloc; -typedef union -{ real pf; - doublereal pd; -} ufloat; -typedef union -{ short is; -#ifndef KR_headers - signed -#endif - char ic; - integer il; -#ifdef Allow_TYQUAD - longint ili; -#endif -} Uint; -#ifdef KR_headers -extern int (*f__doed)(),(*f__doned)(); -extern int (*f__dorevert)(); -extern int rd_ed(),rd_ned(); -extern int w_ed(),w_ned(); -#else -#ifdef __cplusplus -extern "C" { -#endif -extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); -extern int (*f__dorevert)(void); -extern void fmt_bg(void); -extern int pars_f(char*); -extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*); -extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*); -extern int wrt_E(ufloat*, int, int, int, ftnlen); -extern int wrt_F(ufloat*, int, int, ftnlen); -extern int wrt_L(Uint*, int, ftnlen); -#ifdef __cplusplus - } -#endif -#endif -extern flag f__cblank,f__cplus,f__workdone, f__nonl; -extern char *f__fmtbuf; -extern int f__scale; -#define GET(x) if((x=(*f__getn)())<0) return(x) -#define VAL(x) (x!='\n'?x:' ') -#define PUT(x) (*f__putn)(x) -extern int f__cursor; - -#undef TYQUAD -#ifndef Allow_TYQUAD -#undef longint -#define longint long -#else -#define TYQUAD 14 -#endif - -#ifdef KR_headers -extern char *f__icvt(); -#else -extern char *f__icvt(longint, int*, int*, int); -#endif diff --git a/ext/spice/include/fp.h b/ext/spice/include/fp.h deleted file mode 100644 index 40743d79f7..0000000000 --- a/ext/spice/include/fp.h +++ /dev/null @@ -1,28 +0,0 @@ -#define FMAX 40 -#define EXPMAXDIGS 8 -#define EXPMAX 99999999 -/* FMAX = max number of nonzero digits passed to atof() */ -/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */ - -#ifdef V10 /* Research Tenth-Edition Unix */ -#include "local.h" -#endif - -/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily - tight) on the maximum number of digits to the right and left of - * the decimal point. - */ - -#ifdef VAX -#define MAXFRACDIGS 56 -#define MAXINTDIGS 38 -#else -#ifdef CRAY -#define MAXFRACDIGS 9880 -#define MAXINTDIGS 9864 -#else -/* values that suffice for IEEE double */ -#define MAXFRACDIGS 344 -#define MAXINTDIGS 308 -#endif -#endif diff --git a/ext/spice/include/lio.h b/ext/spice/include/lio.h deleted file mode 100644 index 012317206a..0000000000 --- a/ext/spice/include/lio.h +++ /dev/null @@ -1,74 +0,0 @@ -/* copy of ftypes from the compiler */ -/* variable types - * numeric assumptions: - * int < reals < complexes - * TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX - */ - -/* 0-10 retain their old (pre LOGICAL*1, etc.) */ -/* values to allow mixing old and new objects. */ - -#define TYUNKNOWN 0 -#define TYADDR 1 -#define TYSHORT 2 -#define TYLONG 3 -#define TYREAL 4 -#define TYDREAL 5 -#define TYCOMPLEX 6 -#define TYDCOMPLEX 7 -#define TYLOGICAL 8 -#define TYCHAR 9 -#define TYSUBR 10 -#define TYINT1 11 -#define TYLOGICAL1 12 -#define TYLOGICAL2 13 -#ifdef Allow_TYQUAD -#undef TYQUAD -#define TYQUAD 14 -#endif - -#define LINTW 24 -#define LINE 80 -#define LLOGW 2 -#ifdef Old_list_output -#define LLOW 1.0 -#define LHIGH 1.e9 -#define LEFMT " %# .8E" -#define LFFMT " %# .9g" -#else -#define LGFMT "%.9G" -#endif -/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */ -#define LEFBL 24 - -typedef union -{ - char flchar; - short flshort; - ftnint flint; -#ifdef Allow_TYQUAD - longint fllongint; -#endif - real flreal; - doublereal fldouble; -} flex; -extern int f__scale; -#ifdef KR_headers -extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); -extern int l_read(), l_write(); -#else -#ifdef __cplusplus -extern "C" { -#endif -extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); -extern int l_write(ftnint*, char*, ftnlen, ftnint); -extern void x_wsne(cilist*); -extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*); -extern int l_read(ftnint*,char*,ftnlen,ftnint); -extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*); -extern int z_rnew(void); -#ifdef __cplusplus - } -#endif -#endif -extern ftnint L_len; diff --git a/ext/spice/include/rawio.h b/ext/spice/include/rawio.h deleted file mode 100644 index fd36a48260..0000000000 --- a/ext/spice/include/rawio.h +++ /dev/null @@ -1,41 +0,0 @@ -#ifndef KR_headers -#ifdef MSDOS -#include "io.h" -#ifndef WATCOM -#define close _close -#define creat _creat -#define open _open -#define read _read -#define write _write -#endif /*WATCOM*/ -#endif /*MSDOS*/ -#ifdef __cplusplus -extern "C" { -#endif -#ifndef MSDOS -#ifdef OPEN_DECL -extern int creat(const char*,int), open(const char*,int); -#endif -extern int close(int); -extern int read(int,void*,size_t), write(int,void*,size_t); -extern int unlink(const char*); -#ifndef _POSIX_SOURCE -#ifndef NON_UNIX_STDIO -extern FILE *fdopen(int, const char*); -#endif -#endif -#endif /*KR_HEADERS*/ - -extern char *mktemp(char*); - -#ifdef __cplusplus - } -#endif -#endif - -#include "fcntl.h" - -#ifndef O_WRONLY -#define O_RDONLY 0 -#define O_WRONLY 1 -#endif diff --git a/ext/spice/include/signal1.h b/ext/spice/include/signal1.h deleted file mode 100644 index 360d8d0118..0000000000 --- a/ext/spice/include/signal1.h +++ /dev/null @@ -1,118 +0,0 @@ -/* - --Header_File signal1.h (CSPICE version of the f2c signal1.h header file) - --Abstract - - Define macros associated with signal handling, customized for the - host environment. - --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. - --Particulars - - This header defines the macro signal1 referenced in main.c, - which is a generic main routine used in CSPICE executables that - link to code generated by f2c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - 1) This header file must be updated whenever the f2c processor - or the f2c libraries libI77 and libF77 are updated. - - 2) This header may need to be updated to support new platforms. - The supported platforms at the time of the 03-FEB-2000 release - are: - - ALPHA-DIGITAL-UNIX_C - HP_C - NEXT_C - PC-LINUX_C - PC-MS_C - SGI-IRIX-N32_C - SGI-IRIX-NO2_C - SUN-SOLARIS-GCC_C - SUN-SOLARIS-NATIVE_C - --Version - - -CSPICE Version 1.0.0, 03-FEB-2000 (NJB) - -*/ - - - - -/* You may need to adjust the definition of signal1 to supply a */ -/* cast to the correct argument type. This detail is system- and */ -/* compiler-dependent. The #define below assumes signal.h declares */ -/* type SIG_PF for the signal function's second argument. */ - -#include - -#ifndef Sigret_t -#define Sigret_t void -#endif -#ifndef Sigarg_t -#ifdef KR_headers -#define Sigarg_t -#else -#ifdef __cplusplus -#define Sigarg_t ... -#else -#define Sigarg_t int -#endif -#endif -#endif /*Sigarg_t*/ - -#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ -#define sig_pf SIG_PF -#else -typedef Sigret_t (*sig_pf)(Sigarg_t); -#endif - -#define signal1(a,b) signal(a,(sig_pf)b) - -#ifdef __cplusplus -#define Sigarg ... -#define Use_Sigarg -#else -#define Sigarg Int n -#define Use_Sigarg n = n /* shut up compiler warning */ -#endif - diff --git a/ext/spice/include/zzalloc.h b/ext/spice/include/zzalloc.h deleted file mode 100644 index 572268c8eb..0000000000 --- a/ext/spice/include/zzalloc.h +++ /dev/null @@ -1,125 +0,0 @@ -/* - --Abstract - - The memory allocation prototypes and macros for use in CSPICE. - --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. - --Particulars - - The routines maintain a count of the number of mallocs vs. free, - signalling an error if any unreleased memory exists at the end - of an Icy interface call. - - The macro ALLOC_CHECK performs malloc/free test. If used, the macro - should exists at the end of any routine using these memory management - routines. - - Prototypes in this file: - - alloc_count - zzalloc_count - alloc_SpiceMemory - alloc_SpiceString_C_array - alloc_SpiceString_C_Copy_array - alloc_SpiceDouble_C_array - alloc_SpiceInt_C_array - alloc_SpiceString - alloc_SpiceString_Pointer_array - free_SpiceString_C_array - free_SpiceMemory - --Version - - CSPICE 1.0.3 02-MAY-2008 (EDW) - - Added alloc_count prototype. - - CSPICE 1.0.2 10-MAY-2007 (EDW) - - Minor edits to clarify 'size' in alloc_SpiceMemory as - size_t. - - CSPICE 1.0.1 23-JUN-2005 (EDW) - - Add prototype for alloc_SpiceString_Pointer_array, allocate - an array of pointers to SpiceChar. - - Icy 1.0.0 December 19, 2003 (EDW) - - Initial release. - -*/ - -#ifndef ZZALLOC_H -#define ZZALLOC_H - - /* - Allocation call prototypes: - */ - int alloc_count (); - - SpiceChar ** alloc_SpiceString_C_array ( int string_length, - int string_count ); - - SpiceChar ** alloc_SpiceString_C_Copy_array ( int array_len , - int string_len, - SpiceChar ** array ); - - SpiceDouble * alloc_SpiceDouble_C_array ( int rows, - int cols ); - - SpiceInt * alloc_SpiceInt_C_array ( int rows, - int cols ); - - SpiceChar * alloc_SpiceString ( int length ); - - SpiceChar ** alloc_SpiceString_Pointer_array( int array_len ); - - void free_SpiceString_C_array ( int dim, - SpiceChar ** array ); - - void * alloc_SpiceMemory ( size_t size ); - - void free_SpiceMemory ( void * ptr ); - - - /* - Simple macro to ensure a zero value alloc count at end of routine. - Note, the need to use this macro exists only in those routines - allocating/deallocating memory. - */ -#define ALLOC_CHECK if ( alloc_count() != 0 ) \ - { \ - setmsg_c ( "Malloc/Free count not zero at end of routine." \ - " Malloc count = #."); \ - errint_c ( "#", alloc_count() ); \ - sigerr_c ( "SPICE(MALLOCCOUNT)" ); \ - } - -#endif - diff --git a/ext/spice/include/zzerror.h b/ext/spice/include/zzerror.h deleted file mode 100644 index 5709c667d5..0000000000 --- a/ext/spice/include/zzerror.h +++ /dev/null @@ -1,80 +0,0 @@ -/* - --Abstract - - The error control routine prototypes for use in CSPICE. - --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. - --Particulars - - Routines prototyped in this file: - - zzerrorinit - zzerror - --Examples - - See the examples section in zzerror() and zzerrorinit(). - --Restrictions - - None. - --Exceptions - - None. - --Files - - None. - --Author_and_Institution - - E. D. Wright (JPL) - --Literature_References - - None. - --Version - - CSPICE 1.0.0 17-OCT-2005 (EDW) - - Initial release. - -*/ - -#ifndef ZZERROR_H -#define ZZERROR_H - - const char * zzerror( long cnt ); - void zzerrorinit(); - -#endif - - - diff --git a/ext/spice/src/cspice/F77_aloc.c b/ext/spice/src/cspice/F77_aloc.c deleted file mode 100644 index e8ba7442f6..0000000000 --- a/ext/spice/src/cspice/F77_aloc.c +++ /dev/null @@ -1,32 +0,0 @@ -#include "f2c.h" -#undef abs -#undef min -#undef max -#include "stdio.h" - -static integer memfailure = 3; - -#ifdef KR_headers -extern char *malloc(); -extern void exit_(); - - char * -F77_aloc(Len, whence) integer Len; char *whence; -#else -#include "stdlib.h" -extern void exit_(integer*); - - char * -F77_aloc(integer Len, char *whence) -#endif -{ - char *rv; - unsigned int uLen = (unsigned int) Len; /* for K&R C */ - - if (!(rv = (char*)malloc(uLen))) { - fprintf(stderr, "malloc(%u) failure in %s\n", - uLen, whence); - exit_(&memfailure); - } - return rv; - } diff --git a/ext/spice/src/cspice/SpiceCK.h b/ext/spice/src/cspice/SpiceCK.h deleted file mode 100644 index 894d4e9a6c..0000000000 --- a/ext/spice/src/cspice/SpiceCK.h +++ /dev/null @@ -1,155 +0,0 @@ -/* - --Header_File SpiceCK.h ( CSPICE CK definitions ) - --Abstract - - Perform CSPICE definitions to support CK wrapper interfaces. - --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. - --Particulars - - This header defines types that may be referenced in - application code that calls CSPICE CK functions. - - Typedef - ======= - - Name Description - ---- ---------- - - SpiceCK05Subtype Typedef for enum indicating the - mathematical representation used - in an CK type 05 segment. Possible - values and meanings are: - - C05TP0: - - Hermite interpolation, 8- - element packets containing - - q0, q1, q2, q3, - dq0/dt, dq1/dt, dq2/dt dq3/dt - - where q0, q1, q2, q3 represent - quaternion components and dq0/dt, - dq1/dt, dq2/dt, dq3/dt represent - quaternion time derivative components. - - Quaternions are unitless. Quaternion - time derivatives have units of - 1/second. - - - C05TP1: - - Lagrange interpolation, 4- - element packets containing - - q0, q1, q2, q3, - - where q0, q1, q2, q3 represent - quaternion components. Quaternion - derivatives are obtained by - differentiating interpolating - polynomials. - - - C05TP2: - - Hermite interpolation, 14- - element packets containing - - q0, q1, q2, q3, - dq0/dt, dq1/dt, dq2/dt dq3/dt, - av0, av1, av2, - dav0/dt, dav1/dt, dav2/dt - - where q0, q1, q2, q3 represent - quaternion components and dq0/dt, - dq1/dt, dq2/dt, dq3/dt represent - quaternion time derivative components, - av0, av1, av2 represent angular - velocity components, and - dav0/dt, dav1/dt, dav2/dt represent - angular acceleration components. - - - C05TP3: - - Lagrange interpolation, 7- - element packets containing - - q0, q1, q2, q3, - av0, av1, av2 - - where q0, q1, q2, q3 represent - quaternion components and - av0, av1, av2 represent angular - velocity components. - - - -Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 20-AUG-2002 (NJB) - -*/ - -#ifndef HAVE_SPICE_CK_H - - #define HAVE_SPICE_CK_H - - - - /* - CK type 05 subtype codes: - */ - - enum _SpiceCK05Subtype { C05TP0, C05TP1, C05TP2, C05TP3 }; - - - typedef enum _SpiceCK05Subtype SpiceCK05Subtype; - -#endif - diff --git a/ext/spice/src/cspice/SpiceCel.h b/ext/spice/src/cspice/SpiceCel.h deleted file mode 100644 index 7b0537e9ee..0000000000 --- a/ext/spice/src/cspice/SpiceCel.h +++ /dev/null @@ -1,441 +0,0 @@ -/* - --Header_File SpiceCel.h ( CSPICE Cell definitions ) - --Abstract - - Perform CSPICE definitions for the SpiceCell data type. - --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 - - CELLS - --Particulars - - This header defines structures, macros, and enumerated types that - may be referenced in application code that calls CSPICE cell - functions. - - CSPICE cells are data structures that implement functionality - parallel to that of the cell abstract data type in SPICELIB. In - CSPICE, a cell is a C structure containing bookkeeping information, - including a pointer to an associated data array. - - For numeric data types, the data array is simply a SPICELIB-style - cell, including a valid control area. For character cells, the data - array has the same number of elements as the corresponding - SPICELIB-style cell, but the contents of the control area are not - maintained, and the data elements are null-terminated C-style - strings. - - CSPICE cells should be declared using the declaration macros - provided in this header file. See the table of macros below. - - - Structures - ========== - - Name Description - ---- ---------- - - SpiceCell Structure containing CSPICE cell metadata. - - The members are: - - dtype: Data type of cell: character, - integer, or double precision. - - dtype has type - SpiceCellDataType. - - length: For character cells, the - declared length of the - cell's string array. - - size: The maximum number of data - items that can be stored in - the cell's data array. - - card: The cell's "cardinality": the - number of data items currently - present in the cell. - - isSet: Boolean flag indicating whether - the cell is a CSPICE set. - Sets have no duplicate data - items, and their data items are - stored in increasing order. - - adjust: Boolean flag indicating whether - the cell's data area has - adjustable size. Adjustable - size cell data areas are not - currently implemented. - - init: Boolean flag indicating whether - the cell has been initialized. - - base: is a void pointer to the - associated data array. base - points to the start of the - control area of this array. - - data: is a void pointer to the - first data slot in the - associated data array. This - slot is the element following - the control area. - - - ConstSpiceCell A const SpiceCell. - - - - - Declaration Macros - ================== - - Name Description - ---- ---------- - - SPICECHAR_CELL ( name, size, length ) Declare a - character CSPICE - cell having cell - name name, - maximum cell - cardinality size, - and string length - length. The - macro declares - both the cell and - the associated - data array. The - name of the data - array begins with - "SPICE_". - - - SPICEDOUBLE_CELL ( name, size ) Like SPICECHAR_CELL, - but declares a - double precision - cell. - - - SPICEINT_CELL ( name, size ) Like - SPICECHAR_CELL, - but declares an - integer cell. - - Assignment Macros - ================= - - Name Description - ---- ---------- - SPICE_CELL_SET_C( item, i, cell ) Assign the ith - element of a - character cell. - Arguments cell - and item are - pointers. - - SPICE_CELL_SET_D( item, i, cell ) Assign the ith - element of a - double precision - cell. Argument - cell is a - pointer. - - SPICE_CELL_SET_I( item, i, cell ) Assign the ith - element of an - integer cell. - Argument cell is - a pointer. - - - Fetch Macros - ============== - - Name Description - ---- ---------- - SPICE_CELL_GET_C( cell, i, lenout, item ) Fetch the ith - element from a - character cell. - Arguments cell - and item are - pointers. - Argument lenout - is the available - space in item. - - SPICE_CELL_GET_D( cell, i, item ) Fetch the ith - element from a - double precision - cell. Arguments - cell and item are - pointers. - - SPICE_CELL_GET_I( cell, i, item ) Fetch the ith - element from an - integer cell. - Arguments cell - and item are - pointers. - Element Pointer Macros - ====================== - - Name Description - ---- ---------- - SPICE_CELL_ELEM_C( cell, i ) Macro evaluates - to a SpiceChar - pointer to the - ith data element - of a character - cell. Argument - cell is a - pointer. - - SPICE_CELL_ELEM_D( cell, i ) Macro evaluates - to a SpiceDouble - pointer to the - ith data element - of a double - precision cell. - Argument cell is - a pointer. - - SPICE_CELL_ELEM_I( cell, i ) Macro evaluates - to a SpiceInt - pointer to the - ith data element - of an integer - cell. Argument - cell is a - pointer. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 22-AUG-2002 (NJB) - -*/ -#ifndef HAVE_SPICE_CELLS_H - - #define HAVE_SPICE_CELLS_H - - - /* - Data type codes: - */ - typedef enum _SpiceDataType SpiceCellDataType; - - - /* - Cell structure: - */ - struct _SpiceCell - - { SpiceCellDataType dtype; - SpiceInt length; - SpiceInt size; - SpiceInt card; - SpiceBoolean isSet; - SpiceBoolean adjust; - SpiceBoolean init; - void * base; - void * data; }; - - typedef struct _SpiceCell SpiceCell; - - typedef const SpiceCell ConstSpiceCell; - - - /* - SpiceCell control area size: - */ - #define SPICE_CELL_CTRLSZ 6 - - - /* - Declaration macros: - */ - - #define SPICECHAR_CELL( name, size, length ) \ - \ - static SpiceChar SPICE_CELL_##name[SPICE_CELL_CTRLSZ + size][length]; \ - \ - static SpiceCell name = \ - \ - { SPICE_CHR, \ - length, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - #define SPICEDOUBLE_CELL( name, size ) \ - \ - static SpiceDouble SPICE_CELL_##name [SPICE_CELL_CTRLSZ + size]; \ - \ - static SpiceCell name = \ - \ - { SPICE_DP, \ - 0, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - #define SPICEINT_CELL( name, size ) \ - \ - static SpiceInt SPICE_CELL_##name [SPICE_CELL_CTRLSZ + size]; \ - \ - static SpiceCell name = \ - \ - { SPICE_INT, \ - 0, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - /* - Access macros for individual elements: - */ - - /* - Data element pointer macros: - */ - - #define SPICE_CELL_ELEM_C( cell, i ) \ - \ - ( ( (SpiceChar *) (cell)->data ) + (i)*( (cell)->length ) ) - - - #define SPICE_CELL_ELEM_D( cell, i ) \ - \ - ( ( (SpiceDouble *) (cell)->data )[(i)] ) - - - #define SPICE_CELL_ELEM_I( cell, i ) \ - \ - ( ( (SpiceInt *) (cell)->data )[(i)] ) - - - /* - "Fetch" macros: - */ - - #define SPICE_CELL_GET_C( cell, i, lenout, item ) \ - \ - { \ - SpiceInt nBytes; \ - \ - nBytes = brckti_c ( (cell)->length, 0, (lenout-1) ) \ - * sizeof ( SpiceChar ); \ - \ - memmove ( (item), SPICE_CELL_ELEM_C((cell), (i)), nBytes ); \ - \ - item[nBytes] = NULLCHAR; \ - } - - - #define SPICE_CELL_GET_D( cell, i, item ) \ - \ - ( (*item) = ( (SpiceDouble *) (cell)->data)[i] ) - - - #define SPICE_CELL_GET_I( cell, i, item ) \ - \ - ( (*item) = ( (SpiceInt *) (cell)->data)[i] ) - - - /* - Assignment macros: - */ - - #define SPICE_CELL_SET_C( item, i, cell ) \ - \ - { \ - SpiceChar * sPtr; \ - SpiceInt nBytes; \ - \ - nBytes = brckti_c ( strlen(item), 0, (cell)->length - 1 ) \ - * sizeof ( SpiceChar ); \ - \ - sPtr = SPICE_CELL_ELEM_C((cell), (i)); \ - \ - memmove ( sPtr, (item), nBytes ); \ - \ - sPtr[nBytes] = NULLCHAR; \ - } - - - #define SPICE_CELL_SET_D( item, i, cell ) \ - \ - ( ( (SpiceDouble *) (cell)->data)[i] = (item) ) - - - #define SPICE_CELL_SET_I( item, i, cell ) \ - \ - ( ( (SpiceInt *) (cell)->data)[i] = (item) ) - - - /* - The enum SpiceTransDir is used to indicate language translation - direction: C to Fortran or vice versa. - */ - enum _SpiceTransDir { C2F = 0, F2C = 1 }; - - typedef enum _SpiceTransDir SpiceTransDir; - - -#endif - diff --git a/ext/spice/src/cspice/SpiceEK.h b/ext/spice/src/cspice/SpiceEK.h deleted file mode 100644 index cbe213fb01..0000000000 --- a/ext/spice/src/cspice/SpiceEK.h +++ /dev/null @@ -1,448 +0,0 @@ -/* - --Header_File SpiceEK.h ( CSPICE EK-specific definitions ) - --Abstract - - Perform CSPICE EK-specific definitions, including macros and user- - defined types. - --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. - --Particulars - - This header defines macros, enumerated types, structures, and - typedefs that may be referenced in application code that calls CSPICE - EK functions. - - - Macros - ====== - - General limits - -------------- - - Name Description - ---- ---------- - SPICE_EK_MXCLSG Maximum number of columns per segment. - - SPICE_EK_TYPLEN Maximum length of a short string - indicating a data type (one of - {"CHR", "DP", "INT", "TIME"}). Such - strings are returned by some of the - Fortran SPICELIB EK routines, hence also - by their f2c'd counterparts. - - Sizes of EK objects - ------------------- - - Name Description - ---- ---------- - - SPICE_EK_CNAMSZ Maximum length of column name. - SPICE_EK_CSTRLN Length of string required to hold column - name. - SPICE_EK_TNAMSZ Maximum length of table name. - SPICE_EK_TSTRLN Length of string required to hold table - name. - - - Query-related limits - -------------------- - - Name Description - ---- ---------- - - SPICE_EK_MAXQRY Maximum length of an input query. This - value is currently equivalent to - twenty-five 80-character lines. - - SPICE_EK_MAXQSEL Maximum number of columns that may be - listed in the `SELECT clause' of a query. - - SPICE_EK_MAXQTAB Maximum number of tables that may be - listed in the `FROM clause' of a query. - - SPICE_EK_MAXQCON Maximum number of relational expressions - that may be listed in the `constraint - clause' of a query. - - This limit applies to a query when it is - represented in `normalized form': that - is, the constraints have been expressed - as a disjunction of conjunctions of - relational expressions. The number of - relational expressions in a query that - has been expanded in this fashion may be - greater than the number of relations in - the query as orginally written. For - example, the expression - - ( ( A LT 1 ) OR ( B GT 2 ) ) - AND - ( ( C NE 3 ) OR ( D EQ 4 ) ) - - which contains 4 relational expressions, - expands to the equivalent normalized - constraint - - ( ( A LT 1 ) AND ( C NE 3 ) ) - OR - ( ( A LT 1 ) AND ( D EQ 4 ) ) - OR - ( ( B GT 2 ) AND ( C NE 3 ) ) - OR - ( ( B GT 2 ) AND ( D EQ 4 ) ) - - which contains eight relational - expressions. - - - - SPICE_EK_MAXQJOIN Maximum number of tables that can be - joined. - - SPICE_EK_MAXQJCON Maximum number of join constraints - allowed. - - SPICE_EK_MAXQORD Maximum number of columns that may be - used in the `order-by clause' of a query. - - SPICE_EK_MAXQTOK Maximum number of tokens in a query. - Tokens - are reserved words, column names, - parentheses, and values. Literal strings - and time values count as single tokens. - - SPICE_EK_MAXQNUM Maximum number of numeric tokens in a - query. - - SPICE_EK_MAXQCLN Maximum total length of character tokens - in a query. - - SPICE_EK_MAXQSTR Maximum length of literal string values - allowed in queries. - - - Codes - ----- - - Name Description - ---- ---------- - - SPICE_EK_VARSIZ Code used to indicate variable-size - objects. Usually this is used in a - context where a non-negative integer - indicates the size of a fixed-size object - and the presence of this code indicates a - variable-size object. - - The value of this constant must match the - parameter IFALSE used in the Fortran - library SPICELIB. - - - Enumerated Types - ================ - - Enumerated code values - ---------------------- - - Name Description - ---- ---------- - SpiceEKDataType Codes for data types used in the EK - interface: character, double precision, - integer, and "time." - - The values are: - - { SPICE_CHR = 0, - SPICE_DP = 1, - SPICE_INT = 2, - SPICE_TIME = 3 } - - - - SpiceEKExprClass Codes for types of expressions that may - appear in the SELECT clause of EK - queries. Values and meanings are: - - - SPICE_EK_EXP_COL Selected item was a - column. The column - may qualified by a - table name. - - SPICE_EK_EXP_FUNC Selected item was - a simple function - invocation of the - form - - F ( ) - - or else was - - COUNT(*) - - SPICE_EK_EXP_EXPR Selected item was a - more general - expression than - those shown above. - - - Numeric values are: - - { SPICE_EK_EXP_COL = 0, - SPICE_EK_EXP_FUNC = 1, - SPICE_EK_EXP_EXPR = 2 } - - - Structures - ========== - - EK API structures - ----------------- - - Name Description - ---- ---------- - - SpiceEKAttDsc EK column attribute descriptor. Note - that this object is distinct from the EK - column descriptors used internally in - the EK routines; those descriptors - contain pointers as well as attribute - information. - - The members are: - - cclass: Column class code. - - dtype: Data type code: has type - SpiceEKDataType. - - strlen: String length. Applies to - SPICE_CHR type. Value is - SPICE_EK_VARSIZ for - variable-length strings. - - size: Column entry size; this is - the number of array - elements in a column - entry. The value is - SPICE_EK_VARSIZ for - variable-size columns. - - indexd: Index flag; value is - SPICETRUE if the column is - indexed, SPICEFALSE - otherwise. - - nullok: Null flag; value is - SPICETRUE if the column - may contain null values, - SPICEFALSE otherwise. - - - - SpiceEKSegSum EK segment summary. This structure - contains user interface level descriptive - information. The structure contains the - following members: - - tabnam The name of the table to - which the segment belongs. - - nrows The number of rows in the - segment. - - ncols The number of columns in - the segment. - - cnames An array of names of - columns in the segment. - Column names may contain - as many as SPICE_EK_CNAMSZ - characters. The array - contains room for - SPICE_EK_MXCLSG column - names. - - cdescrs An array of column - attribute descriptors of - type SpiceEKAttDsc. - The array contains room - for SPICE_EK_MXCLSG - descriptors. The Ith - descriptor corresponds to - the column whose name is - the Ith element of the - array cnames. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 2.0.0 27-JUL-2002 (NJB) - - Defined SpiceEKDataType using SpiceDataType. Removed declaration - of enum _SpiceEKDataType. - - -CSPICE Version 1.0.0, 05-JUL-1999 (NJB) - - Renamed _SpiceEKAttDsc member "class" to "cclass." The - former name is a reserved word in C++. - - - -CSPICE Version 1.0.0, 24-FEB-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_EK_H - - #define HAVE_SPICE_EK_H - - - - /* - Constants - */ - - /* - Sizes of EK objects: - */ - - #define SPICE_EK_CNAMSZ 32 - #define SPICE_EK_CSTRLN ( SPICE_EK_CNAMSZ + 1 ) - #define SPICE_EK_TNAMSZ 64 - #define SPICE_EK_TSTRLN ( SPICE_EK_TNAMSZ + 1 ) - - - - /* - Maximum number of columns per segment: - */ - - #define SPICE_EK_MXCLSG 100 - - - /* - Maximum length of string indicating data type: - */ - - #define SPICE_EK_TYPLEN 4 - - - /* - Query-related limits (see header for details): - */ - - #define SPICE_EK_MAXQRY 2000 - #define SPICE_EK_MAXQSEL 50 - #define SPICE_EK_MAXQTAB 10 - #define SPICE_EK_MAXQCON 1000 - #define SPICE_EK_MAXQJOIN 10 - #define SPICE_EK_MAXQJCON 100 - #define SPICE_EK_MAXQORD 10 - #define SPICE_EK_MAXQTOK 500 - #define SPICE_EK_MAXQNUM 100 - #define SPICE_EK_MAXQCLN SPICE_EK_MAXQRY - #define SPICE_EK_MAXQSTR 1024 - - - - /* - Code indicating "variable size": - */ - #define SPICE_EK_VARSIZ (-1) - - - - /* - Data type codes: - */ - typedef SpiceDataType SpiceEKDataType; - - - - /* - SELECT clause expression type codes: - */ - enum _SpiceEKExprClass{ SPICE_EK_EXP_COL = 0, - SPICE_EK_EXP_FUNC = 1, - SPICE_EK_EXP_EXPR = 2 }; - - typedef enum _SpiceEKExprClass SpiceEKExprClass; - - - - /* - EK column attribute descriptor: - */ - - struct _SpiceEKAttDsc - - { SpiceInt cclass; - SpiceEKDataType dtype; - SpiceInt strlen; - SpiceInt size; - SpiceBoolean indexd; - SpiceBoolean nullok; }; - - typedef struct _SpiceEKAttDsc SpiceEKAttDsc; - - - - /* - EK segment summary: - */ - - struct _SpiceEKSegSum - - { SpiceChar tabnam [SPICE_EK_TSTRLN]; - SpiceInt nrows; - SpiceInt ncols; - SpiceChar cnames [SPICE_EK_MXCLSG][SPICE_EK_CSTRLN]; - SpiceEKAttDsc cdescrs[SPICE_EK_MXCLSG]; }; - - typedef struct _SpiceEKSegSum SpiceEKSegSum; - - -#endif - diff --git a/ext/spice/src/cspice/SpiceEll.h b/ext/spice/src/cspice/SpiceEll.h deleted file mode 100644 index d0c123ab06..0000000000 --- a/ext/spice/src/cspice/SpiceEll.h +++ /dev/null @@ -1,115 +0,0 @@ -/* - --Header_File SpiceEll.h ( CSPICE Ellipse definitions ) - --Abstract - - Perform CSPICE definitions for the SpiceEllipse data type. - --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. - --Particulars - - This header defines structures and typedefs that may be referenced in - application code that calls CSPICE Ellipse functions. - - - Structures - ========== - - Name Description - ---- ---------- - - SpiceEllipse Structure representing an ellipse in 3- - dimensional space. - - The members are: - - center: Vector defining ellipse's - center. - - semiMajor: Vector defining ellipse's - semi-major axis. - - semiMinor: Vector defining ellipse's - semi-minor axis. - - The ellipse is the set of points - - {X: X = center - + cos(theta) * semiMajor - + sin(theta) * semiMinor, - - theta in [0, 2*Pi) } - - - ConstSpiceEllipse A const SpiceEllipse. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 04-MAR-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_ELLIPSES - - #define HAVE_SPICE_ELLIPSES - - - - /* - Ellipse structure: - */ - - struct _SpiceEllipse - - { SpiceDouble center [3]; - SpiceDouble semiMajor [3]; - SpiceDouble semiMinor [3]; }; - - typedef struct _SpiceEllipse SpiceEllipse; - - typedef const SpiceEllipse ConstSpiceEllipse; - -#endif - diff --git a/ext/spice/src/cspice/SpiceGF.h b/ext/spice/src/cspice/SpiceGF.h deleted file mode 100644 index 14d10de2fd..0000000000 --- a/ext/spice/src/cspice/SpiceGF.h +++ /dev/null @@ -1,319 +0,0 @@ -/* - --Header_File SpiceGF.h ( CSPICE GF-specific definitions ) - --Abstract - - Perform CSPICE GF-specific definitions. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - --Exceptions - - None - --Files - - None - --Particulars - - This header defines macros that may be referenced in application - code that calls CSPICE GF functions. - - - Macros - ====== - - Workspace parameters - -------------------- - - CSPICE applications normally don't declare workspace arguments - and therefore don't directly reference workspace size parameters. - However, CSPICE GF APIs dealing with numeric constraints - dynamically allocate workspace memory; the amount allocated - depends on the number of intervals the workspace windows can - hold. This amount is an input argument to the GF numeric quantity - APIs. - - The parameters below are used to calculate the amount of memory - required. Each workspace window contains 6 double precision - numbers in its control area and 2 double precision numbers for - each interval it can hold. - - - Name Description - ---- ---------- - SPICE_GF_NWMAX Maximum number of windows required for - a user-defined workspace array. - - SPICE_GF_NWDIST Number of workspace windows used by - gfdist_c and the underlying SPICELIB - routine GFDIST. - - SPICE_GF_NWSEP Number of workspace windows used by - gfsep_c and the underlying SPICELIB - routine GFSEP. - - - - Field of view (FOV) parameters - ------------------------------ - - Name Description - ---- ---------- - SPICE_GF_MAXVRT Maximum allowed number of boundary - vectors for a polygonal FOV. - - SPICE_GF_CIRFOV Parameter identifying a circular FOV. - - SPICE_GF_ELLFOV Parameter identifying a elliptical FOV. - - SPICE_GF_POLFOV Parameter identifying a polygonal FOV. - - SPICE_GF_RECFOV Parameter identifying a rectangular FOV. - - SPICE_GF_SHPLEN Parameter specifying maximum length of - a FOV shape name. - - SPICE_GF_MARGIN is a small positive number used to - constrain the orientation of the - boundary vectors of polygonal FOVs. Such - FOVs must satisfy the following - constraints: - - 1) The boundary vectors must be - contained within a right circular - cone of angular radius less than - than (pi/2) - MARGIN radians; in - other words, there must be a vector - A such that all boundary vectors - have angular separation from A of - less than (pi/2)-MARGIN radians. - - 2) There must be a pair of boundary - vectors U, V such that all other - boundary vectors lie in the same - half space bounded by the plane - containing U and V. Furthermore, all - other boundary vectors must have - orthogonal projections onto a plane - normal to this plane such that the - projections have angular separation - of at least 2*MARGIN radians from - the plane spanned by U and V. - - MARGIN is currently set to 1.D-12. - - - Occultation parameters - ---------------------- - - SPICE_GF_ANNULR Parameter identifying an "annular - occultation." This geometric condition - is more commonly known as a "transit." - The limb of the background object must - not be blocked by the foreground object - in order for an occultation to be - "annular." - - SPICE_GF_ANY Parameter identifying any type of - occultation or transit. - - SPICE_GF_FULL Parameter identifying a full - occultation: the foreground body - entirely blocks the background body. - - SPICE_GF_PARTL Parameter identifying an "partial - occultation." This is an occultation in - which the foreground body blocks part, - but not all, of the limb of the - background body. - - - - Target shape parameters - ----------------------- - - SPICE_GF_EDSHAP Parameter indicating a target object's - shape is modeled as an ellipsoid. - - SPICE_GF_PTSHAP Parameter indicating a target object's - shape is modeled as a point. - - SPICE_GF_RYSHAP Parameter indicating a target object's - "shape" is modeled as a ray emanating - from an observer's location. This model - may be used in visibility computations - for targets whose direction, but not - position, relative to an observer is - known. - - SPICE_GF_SPSHAP Parameter indicating a target object's - shape is modeled as a point. - - - - Search parameters - ----------------- - - These parameters affect the manner in which GF searches are - performed. - - SPICE_GF_ADDWIN is a parameter used in numeric quantity - searches that use an equality - constraint. This parameter is used to - expand the confinement window (the - window over which the search is - performed) by a small amount at both - ends. This expansion accommodates the - case where a geometric quantity is equal - to a reference value at a boundary point - of the original confinement window. - - SPICE_GF_CNVTOL is the default convergence tolerance - used by GF routines that don't support a - user-supplied tolerance value. GF - searches for roots will terminate when a - root is bracketed by times separated by - no more than this tolerance. Units are - seconds. - - Configuration parameter - ----------------------- - - SPICE_GFEVNT_MAXPAR Parameter indicating the maximum number of - elements needed for the 'qnames' and 'q*pars' - arrays used in gfevnt_c. - - SpiceChar qcpars[SPICE_GFEVNT_MAXPAR][LNSIZE]; - SpiceDouble qdpars[SPICE_GFEVNT_MAXPAR]; - SpiceInt qipars[SPICE_GFEVNT_MAXPAR]; - SpiceBoolean qlpars[SPICE_GFEVNT_MAXPAR]; - --Examples - - None - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - --Version - - -CSPICE Version 2.0.0, 23-JUN-2009 (NJB) - - Added parameter for maximum length of FOV shape string. - - -CSPICE Version 1.0.0, 11-MAR-2009 (NJB) - -*/ - - -#ifndef HAVE_SPICE_GF_H - - #define HAVE_SPICE_GF_H - - - /* - See the Particulars section above for parameter descriptions. - */ - - /* - Workspace parameters - */ - #define SPICE_GF_NWMAX 15 - #define SPICE_GF_NWDIST 5 - #define SPICE_GF_NWSEP 5 - - - /* - Field of view (FOV) parameters - */ - #define SPICE_GF_MAXVRT 10000 - #define SPICE_GF_CIRFOV "CIRCLE" - #define SPICE_GF_ELLFOV "ELLIPSE" - #define SPICE_GF_POLFOV "POLYGON" - #define SPICE_GF_RECFOV "RECTANGLE" - #define SPICE_GF_SHPLEN 10 - #define SPICE_GF_MARGIN ( 1.e-12 ) - - - /* - Occultation parameters - */ - #define SPICE_GF_ANNULR "ANNULAR" - #define SPICE_GF_ANY "ANY" - #define SPICE_GF_FULL "FULL" - #define SPICE_GF_PARTL "PARTIAL" - - - /* - Target shape parameters - */ - #define SPICE_GF_EDSHAP "ELLIPSOID" - #define SPICE_GF_PTSHAP "POINT" - #define SPICE_GF_RYSHAP "RAY" - #define SPICE_GF_SPSHAP "SPHERE" - - - /* - Search parameters - */ - #define SPICE_GF_ADDWIN 1.0 - #define SPICE_GF_CNVTOL 1.e-6 - - - /* - Configuration parameters. - */ - #define SPICE_GFEVNT_MAXPAR 10 - - -#endif - - -/* - End of header file SpiceGF.h -*/ diff --git a/ext/spice/src/cspice/SpicePln.h b/ext/spice/src/cspice/SpicePln.h deleted file mode 100644 index 839fb15606..0000000000 --- a/ext/spice/src/cspice/SpicePln.h +++ /dev/null @@ -1,106 +0,0 @@ -/* - --Header_File SpicePln.h ( CSPICE Plane definitions ) - --Abstract - - Perform CSPICE definitions for the SpicePlane data type. - --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. - --Particulars - - This header defines structures and typedefs that may be referenced in - application code that calls CSPICE Plane functions. - - - Structures - ========== - - Name Description - ---- ---------- - - SpicePlane Structure representing a plane in 3- - dimensional space. - - The members are: - - normal: Vector normal to plane. - - constant: Constant of plane equation - - Plane = - - {X: = constant} - - - - ConstSpicePlane A const SpicePlane. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 04-MAR-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_PLANES - - #define HAVE_SPICE_PLANES - - - - /* - Plane structure: - */ - - struct _SpicePlane - - { SpiceDouble normal [3]; - SpiceDouble constant; }; - - typedef struct _SpicePlane SpicePlane; - - typedef const SpicePlane ConstSpicePlane; - -#endif - diff --git a/ext/spice/src/cspice/SpiceSPK.h b/ext/spice/src/cspice/SpiceSPK.h deleted file mode 100644 index a4c8eac5f7..0000000000 --- a/ext/spice/src/cspice/SpiceSPK.h +++ /dev/null @@ -1,128 +0,0 @@ -/* - --Header_File SpiceSPK.h ( CSPICE SPK definitions ) - --Abstract - - Perform CSPICE definitions to support SPK wrapper interfaces. - --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. - --Particulars - - This header defines types that may be referenced in - application code that calls CSPICE SPK functions. - - Typedef - ======= - - Name Description - ---- ---------- - - SpiceSPK18Subtype Typedef for enum indicating the - mathematical representation used - in an SPK type 18 segment. Possible - values and meanings are: - - S18TP0: - - Hermite interpolation, 12- - element packets containing - - x, y, z, dx/dt, dy/dt, dz/dt, - vx, vy, vz, dvx/dt, dvy/dt, dvz/dt - - where x, y, z represent Cartesian - position components and vx, vy, vz - represent Cartesian velocity - components. Note well: vx, vy, and - vz *are not necessarily equal* to the - time derivatives of x, y, and z. - This packet structure mimics that of - the Rosetta/MEX orbit file from which - the data are taken. - - Position units are kilometers, - velocity units are kilometers per - second, and acceleration units are - kilometers per second per second. - - - S18TP1: - - Lagrange interpolation, 6- - element packets containing - - x, y, z, dx/dt, dy/dt, dz/dt - - where x, y, z represent Cartesian - position components and vx, vy, vz - represent Cartesian velocity - components. - - Position units are kilometers; - velocity units are kilometers per - second. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 16-AUG-2002 (NJB) - -*/ - -#ifndef HAVE_SPICE_SPK_H - - #define HAVE_SPICE_SPK_H - - - - /* - SPK type 18 subtype codes: - */ - - enum _SpiceSPK18Subtype { S18TP0, S18TP1 }; - - - typedef enum _SpiceSPK18Subtype SpiceSPK18Subtype; - -#endif - diff --git a/ext/spice/src/cspice/SpiceUsr.h b/ext/spice/src/cspice/SpiceUsr.h deleted file mode 100644 index 83038e32a3..0000000000 --- a/ext/spice/src/cspice/SpiceUsr.h +++ /dev/null @@ -1,217 +0,0 @@ -/* - --Header_File SpiceUsr.h ( CSPICE user interface definitions ) - --Abstract - - Perform CSPICE user interface declarations, including type - definitions and function prototype declarations. - --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. - --Particulars - - This file is an umbrella header that includes all header files - required to support the CSPICE application programming interface - (API). Users' application code that calls CSPICE need include only - this single header file. This file includes function prototypes for - the entire set of CSPICE routines. Typedef statements used to create - SPICE data types are also included. - - - About SPICE data types - ====================== - - To assist with long-term maintainability of CSPICE, NAIF has elected - to use typedefs to represent data types occurring in argument lists - and as return values of CSPICE functions. These are: - - SpiceBoolean - SpiceChar - SpiceDouble - SpiceInt - ConstSpiceBoolean - ConstSpiceChar - ConstSpiceDouble - ConstSpiceInt - - The SPICE typedefs map in an arguably natural way to ANSI C types: - - SpiceBoolean -> enum { SPICEFALSE = 0, SPICETRUE = 1 } - SpiceChar -> char - SpiceDouble -> double - SpiceInt -> int or long - ConstX -> const X (X = any of the above types) - - The type SpiceInt is a special case: the corresponding type is picked - so as to be half the size of a double. On all currently supported - platforms, type double occupies 8 bytes and type int occupies 4 - bytes. Other platforms may require a SpiceInt to map to type long. - - While other data types may be used internally in CSPICE, no other - types appear in the API. - - - About CSPICE function prototypes - ================================ - - Because CSPICE function prototypes enable substantial - compile-time error checking, we recommend that user - applications always reference them. Including the header - file SpiceUsr.h in any module that calls CSPICE will - automatically make the prototypes available. - - - About CSPICE C style - ==================== - - CSPICE is written in ANSI C. No attempt has been made to support K&R - conventions or restrictions. - - - About C++ compatibility - ======================= - - The preprocessor directive -D__cplusplus should be used when - compiling C++ source code that includes this header file. This - directive will suppress mangling of CSPICE names, permitting linkage - to a CSPICE object library built from object modules produced by - an ANSI C compiler. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Restrictions - - The #include statements contained in this file are not part of - the CSPICE API. The set of files included may change without notice. - Users should not include these files directly in their own - application code. - --Version - - -CSPICE Version 4.0.0, 30-SEP-2008 (NJB) - - Updated to include header file - - SpiceGF.h - - -CSPICE Version 3.0.0, 19-AUG-2002 (NJB) - - Updated to include header files - - SpiceCel.h - SpiceCK.h - SpiceSPK.h - - -CSPICE Version 3.0.0, 17-FEB-1999 (NJB) - - Updated to support suppression of name mangling when included in - C++ source code. Also now interface macros to intercept function - calls and perform automatic type casting. - - Now includes platform macro definition header file. - - References to types SpiceVoid and ConstSpiceVoid were removed. - - -CSPICE Version 2.0.0, 06-MAY-1998 (NJB) (EDW) - -*/ - -#ifdef __cplusplus - extern "C" { -#endif - - -#ifndef HAVE_SPICE_USER - - #define HAVE_SPICE_USER - - - /* - Include CSPICE platform macro definitions. - */ - #include "SpiceZpl.h" - - /* - Include CSPICE data type definitions. - */ - #include "SpiceZdf.h" - - /* - Include the CSPICE EK interface definitions. - */ - #include "SpiceEK.h" - - /* - Include the CSPICE Cell interface definitions. - */ - #include "SpiceCel.h" - - /* - Include the CSPICE CK interface definitions. - */ - #include "SpiceCK.h" - - /* - Include the CSPICE SPK interface definitions. - */ - #include "SpiceSPK.h" - - /* - Include the CSPICE GF interface definitions. - */ - #include "SpiceGF.h" - - /* - Include CSPICE prototypes. - */ - #include "SpiceZpr.h" - - /* - Define the CSPICE function interface macros. - */ - #include "SpiceZim.h" - - - -#endif - - -#ifdef __cplusplus - } -#endif - diff --git a/ext/spice/src/cspice/SpiceZad.h b/ext/spice/src/cspice/SpiceZad.h deleted file mode 100644 index f838e7f31c..0000000000 --- a/ext/spice/src/cspice/SpiceZad.h +++ /dev/null @@ -1,205 +0,0 @@ -/* - --Header_File SpiceZad.h ( CSPICE adapter definitions ) - --Abstract - - Perform CSPICE declarations to support passed-in function - adapters used in wrapper interfaces. - --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. - --Particulars - - This header file contains declarations used by the CSPICE - passed-in function adapter ("PFA") system. This system enables - CSPICE wrapper functions to support passed-in function - arguments whose prototypes are C-style, even when these - functions are to be called from f2c'd Fortran routines - expecting f2c-style interfaces. - - This header declares: - - - The prototype for the passed-in function argument - pointer storage and fetch routines - - zzadsave_c - zzadget_c - - - Prototypes for CSPICE adapter functions. Each passed-in - function argument in a CSPICE wrapper has a corresponding - adapter function. The adapter functions have interfaces - that match those of their f2c'd counterparts; this allows - the adapters to be called by f2c'd SPICELIB code. The - adapters look up saved function pointers for routines - passed in by the wrapper's caller and call these functions. - - - Values for the enumerated type SpicePassedInFunc. These - values are used to map function pointers to the - functions they represent, enabling adapters to call - the correct passed-in functions. - -Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 2.1.0, 21-DEC-2009 (EDW) - - Updated to support the user defined scalar function capability. - - -CSPICE Version 2.0.0, 29-JAN-2009 (NJB) - - Now conditionally includes SpiceZfc.h. - - Updated to reflect new calling sequence of f2c'd - routine gfrefn_. Some header updates were made - as well. - - -CSPICE Version 1.0.0, 29-MAR-2008 (NJB) - -*/ - - -/* - This file has dependencies defined in SpiceZfc.h. Include that - file if it hasn't already been included. -*/ -#ifndef HAVE_SPICEF2C_H - #include "SpiceZfc.h" -#endif - - - -#ifndef HAVE_SPICE_ZAD_H - - #define HAVE_SPICE_ZAD_H - - - - /* - Prototypes for GF adapters: - */ - - logical zzadbail_c ( void ); - - - int zzadstep_c ( doublereal * et, - doublereal * step ); - - - int zzadrefn_c ( doublereal * t1, - doublereal * t2, - logical * s1, - logical * s2, - doublereal * t ); - - - int zzadrepf_c ( void ); - - - int zzadrepi_c ( doublereal * cnfine, - char * srcpre, - char * srcsuf, - ftnlen srcprelen, - ftnlen srcsuflen ); - - - int zzadrepu_c ( doublereal * ivbeg, - doublereal * ivend, - doublereal * et ); - - - int zzadfunc_c ( doublereal * et, - doublereal * value ); - - - int zzadqdec_c ( U_fp udfunc, - doublereal * et, - logical * xbool ); - - /* - Define the enumerated type - - SpicePassedInFunc - - for names of passed-in functions. Using this type gives - us compile-time checking and avoids string comparisons. - */ - enum _SpicePassedInFunc { - UDBAIL, - UDREFN, - UDREPF, - UDREPI, - UDREPU, - UDSTEP, - UDFUNC, - UDQDEC, - }; - - typedef enum _SpicePassedInFunc SpicePassedInFunc; - - /* - SPICE_N_PASSED_IN_FUNC is the count of SpicePassedInFunc values. - */ - #define SPICE_N_PASSED_IN_FUNC 8 - - - /* - CSPICE wrappers supporting passed-in function arguments call - the adapter setup interface function once per each such argument; - these calls save the function pointers for later use within the - f2c'd code that calls passed-in functions. The saved pointers - will be used in calls by the adapter functions whose prototypes - are declared above. - - Prototypes for adapter setup interface: - */ - void zzadsave_c ( SpicePassedInFunc functionID, - void * functionPtr ); - - void * zzadget_c ( SpicePassedInFunc functionID ); - - -#endif - -/* -End of header file SpiceZad.h -*/ - diff --git a/ext/spice/src/cspice/SpiceZdf.h b/ext/spice/src/cspice/SpiceZdf.h deleted file mode 100644 index 36276051d6..0000000000 --- a/ext/spice/src/cspice/SpiceZdf.h +++ /dev/null @@ -1,246 +0,0 @@ -/* - --Header_File SpiceZdf.h ( CSPICE definitions ) - --Abstract - - Define CSPICE data types via typedefs; also define some user-visible - enumerated types. - --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. - --Particulars - - CSPICE data types - ================= - - To assist with long-term maintainability of CSPICE, NAIF has elected - to use typedefs to represent data types occurring in argument lists - and as return values of CSPICE functions. These are: - - SpiceBoolean - SpiceChar - SpiceDouble - SpiceInt - ConstSpiceBoolean - ConstSpiceChar - ConstSpiceDouble - ConstSpiceInt - - The SPICE typedefs map in an arguably natural way to ANSI C types: - - SpiceBoolean -> int - SpiceChar -> char - SpiceDouble -> double - SpiceInt -> int or long - ConstX -> const X (X = any of the above types) - - The type SpiceInt is a special case: the corresponding type is picked - so as to be half the size of a double. On most currently supported - platforms, type double occupies 8 bytes and type long occupies 4 - bytes. Other platforms may require a SpiceInt to map to type int. - The Alpha/Digital Unix platform is an example of the latter case. - - While other data types may be used internally in CSPICE, no other - types appear in the API. - - - CSPICE enumerated types - ======================= - - These are provided to enhance readability of the code. - - Type name Value set - --------- --------- - - _Spicestatus { SPICEFAILURE = -1, SPICESUCCESS = 0 } - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 6.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 6.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 5.0.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 4.0.0 27-JUL-2002 (NJB) - - Added definition of SpiceDataType. - - -CSPICE Version 3.0.0 18-SEP-1999 (NJB) - - SpiceBoolean implementation changed from enumerated type to - typedef mapping to int. - - -CSPICE Version 2.0.0 29-JAN-1999 (NJB) - - Made definition of SpiceInt and ConstSpiceInt platform - dependent to accommodate the Alpha/Digital Unix platform. - - Removed definitions of SpiceVoid and ConstSpiceVoid. - - -CSPICE Version 1.0.0 25-OCT-1997 (KRG) (NJB) (EDW) -*/ - - #ifndef HAVE_SPICEDEFS_H - #define HAVE_SPICEDEFS_H - - /* - Include platform definitions, if they haven't been executed already. - */ - #ifndef HAVE_PLATFORM_MACROS_H - #include "SpiceZpl.h" - #endif - - /* - Basic data types. These are defined to be compatible with the - types used by f2c, and so they follow the Fortran notion of what - these things are. See the f2c documentation for the details - about the choices for the sizes of these types. - */ - typedef char SpiceChar; - typedef double SpiceDouble; - typedef float SpiceFloat; - - - - #if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - typedef int SpiceInt; - #else - typedef long SpiceInt; - #endif - - - typedef const char ConstSpiceChar; - typedef const double ConstSpiceDouble; - typedef const float ConstSpiceFloat; - - - #if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - typedef const int ConstSpiceInt; - #else - typedef const long ConstSpiceInt; - #endif - - - /* - More basic data types. These give mnemonics for some other data - types in C that are not used in Fortran written by NAIF or - supported by ANSI Fortran 77. These are for use in C functions - but should not be passed to any C SPICE wrappers, ``*_c.c'' - since they are not Fortran compatible. - */ - typedef long SpiceLong; - typedef short SpiceShort; - - /* - Unsigned data types - */ - typedef unsigned char SpiceUChar; - typedef unsigned int SpiceUInt; - typedef unsigned long SpiceULong; - typedef unsigned short SpiceUShort; - - /* - Signed data types - */ - typedef signed char SpiceSChar; - - /* - Other basic types - */ - typedef int SpiceBoolean; - typedef const int ConstSpiceBoolean; - - #define SPICETRUE 1 - #define SPICEFALSE 0 - - - enum _Spicestatus { SPICEFAILURE = -1, SPICESUCCESS = 0 }; - - typedef enum _Spicestatus SpiceStatus; - - - enum _SpiceDataType { SPICE_CHR = 0, - SPICE_DP = 1, - SPICE_INT = 2, - SPICE_TIME = 3, - SPICE_BOOL = 4 }; - - - typedef enum _SpiceDataType SpiceDataType; - - -#endif diff --git a/ext/spice/src/cspice/SpiceZfc.h b/ext/spice/src/cspice/SpiceZfc.h deleted file mode 100644 index 33f541770b..0000000000 --- a/ext/spice/src/cspice/SpiceZfc.h +++ /dev/null @@ -1,13228 +0,0 @@ -/* - --Header_File SpiceZfc.h ( f2c'd SPICELIB prototypes ) - --Abstract - - Define prototypes for functions produced by converting Fortran - SPICELIB routines to C using f2c. - --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. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - - CSPICE Version 6.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - - CSPICE Version 6.0.0, 21-FEB-2006 (NJB) - - Added typedefs for the PC-LINUX-64BIT-GCC_C - environment (these are identical to those for the - ALPHA-DIGITAL-UNIX_C environment). - - - C-SPICELIB Version 5.0.0, 06-MAR-2005 (NJB) - - Added typedefs for pointers to functions. This change was - made to support CSPICE wrappers for geometry finder routines. - - Added typedefs for the SUN-SOLARIS-64BIT-GCC_C - environment (these are identical to those for the - ALPHA-DIGITAL-UNIX_C environment). - - - C-SPICELIB Version 4.1.0, 24-MAY-2001 (WLT) - - Moved the #ifdef __cplusplus so that it appears after the - typedefs. This allows us to more easily wrap CSPICE in a - namespace for C++. - - - C-SPICELIB Version 4.0.0, 09-FEB-1999 (NJB) - - Updated to accommodate the Alpha/Digital Unix platform. - Also updated to support inclusion in C++ code. - - - C-SPICELIB Version 3.0.0, 02-NOV-1998 (NJB) - - Updated for SPICELIB version N0049. - - - C-SPICELIB Version 2.0.0, 15-SEP-1997 (NJB) - - Changed variable name "typid" to "typid" in prototype - for zzfdat_. This was done to enable compilation under - Borland C++. - - - C-SPICELIB Version 1.0.0, 15-SEP-1997 (NJB) (KRG) - --Index_Entries - - prototypes of f2c'd SPICELIB functions - -*/ - - -#ifndef HAVE_SPICEF2C_H -#define HAVE_SPICEF2C_H - - - -/* - Include Files: - - Many of the prototypes below use data types defined by f2c. We - copy here the f2c definitions that occur in prototypes of functions - produced by running f2c on Fortran SPICELIB routines. - - The reason we don't simply conditionally include f2c.h itself here - is that f2c.h defines macros that conflict with stdlib.h on some - systems. It's simpler to just replicate the few typedefs we need. -*/ - -#if ( defined( CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined( CSPICE_PC_LINUX_64BIT_GCC ) \ - || defined( CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined( CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined( CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined( CSPICE_SUN_SOLARIS_64BIT_GCC ) ) - - #define VOID void - - typedef VOID H_f; - typedef int integer; - typedef double doublereal; - typedef int logical; - typedef int ftnlen; - - - /* - Type H_fp is used for character return type. - Type S_fp is used for subroutines. - Type U_fp is used for functions of unknown type. - */ - typedef VOID (*H_fp)(); - typedef doublereal (*D_fp)(); - typedef doublereal (*E_fp)(); - typedef int (*S_fp)(); - typedef int (*U_fp)(); - typedef integer (*I_fp)(); - typedef logical (*L_fp)(); - -#else - - #define VOID void - - typedef VOID H_f; - typedef long integer; - typedef double doublereal; - typedef long logical; - typedef long ftnlen; - - /* - Type H_fp is used for character return type. - Type S_fp is used for subroutines. - Type U_fp is used for functions of unknown type. - */ - typedef VOID (*H_fp)(); - typedef doublereal (*D_fp)(); - typedef doublereal (*E_fp)(); - typedef int (*S_fp)(); - typedef int (*U_fp)(); - typedef integer (*I_fp)(); - typedef logical (*L_fp)(); - -#endif - - -#ifdef __cplusplus - extern "C" { -#endif - - -/* - Function prototypes for functions created by f2c are listed below. - See the headers of the Fortran routines for descriptions of the - routines' interfaces. - - The functions listed below are those expected to be called by - C-SPICELIB wrappers. Prototypes are not currently provided for other - f2c'd functions. - -*/ - -/* --Prototypes -*/ - -extern logical accept_(logical *ok); -extern logical allowd_(void); - -extern logical alltru_(logical *logcls, integer *n); - -extern H_f ana_(char *ret_val, ftnlen ret_val_len, char *word, char *case__, ftnlen word_len, ftnlen case_len); -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: replch_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int appndc_(char *item, char *cell, ftnlen item_len, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int appndd_(doublereal *item, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int appndi_(integer *item, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical approx_(doublereal *x, doublereal *y, doublereal *tol); - -extern int astrip_(char *instr, char *asciib, char *asciie, char *outstr, ftnlen instr_len, ftnlen asciib_len, ftnlen asciie_len, ftnlen outstr_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern int axisar_(doublereal *axis, doublereal *angle, doublereal *r__); -/*:ref: ident_ 14 1 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern doublereal b1900_(void); - -extern doublereal b1950_(void); - -extern logical badkpv_(char *caller, char *name__, char *comp, integer *size, integer *divby, char *type__, ftnlen caller_len, ftnlen name_len, ftnlen comp_len, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ - -extern logical bedec_(char *string, ftnlen string_len); -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: beuns_ 12 2 13 124 */ - -extern logical beint_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: beuns_ 12 2 13 124 */ - -extern logical benum_(char *string, ftnlen string_len); -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: bedec_ 12 2 13 124 */ -/*:ref: beint_ 12 2 13 124 */ - -extern logical beuns_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ - -extern int bodc2n_(integer *code, char *name__, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodc2n_ 14 4 4 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodc2s_(integer *code, char *name__, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodc2n_ 14 4 4 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int boddef_(char *name__, integer *code, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzboddef_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodeul_(integer *body, doublereal *et, doublereal *ra, doublereal *dec, doublereal *w, doublereal *lambda); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckeul_ 14 6 4 7 12 13 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: m2eul_ 14 7 7 4 4 4 7 7 7 */ - -extern logical bodfnd_(integer *body, char *item, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodmat_(integer *body, doublereal *et, doublereal *tipm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckmat_ 14 5 4 7 4 7 12 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: ccifrm_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int bodn2c_(char *name__, integer *code, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bods2c_(char *name__, integer *code, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodvar_(integer *body, char *item, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: rtpool_ 14 5 13 4 7 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodvcd_(integer *bodyid, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int bodvrd_(char *bodynm, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen bodynm_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern doublereal brcktd_(doublereal *number, doublereal *end1, doublereal *end2); - -extern integer brckti_(integer *number, integer *end1, integer *end2); - -extern integer bschoc_(char *value, integer *ndim, char *array, integer *order, ftnlen value_len, ftnlen array_len); - -extern integer bschoi_(integer *value, integer *ndim, integer *array, integer *order); - -extern integer bsrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern integer bsrchd_(doublereal *value, integer *ndim, doublereal *array); - -extern integer bsrchi_(integer *value, integer *ndim, integer *array); - -extern integer cardc_(char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer cardd_(doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer cardi_(integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cgv2el_(doublereal *center, doublereal *vec1, doublereal *vec2, doublereal *ellips); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer chbase_(void); - -extern int chbder_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, integer *nderiv, doublereal *partdp, doublereal *dpdxs); - -extern int chbint_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, doublereal *p, doublereal *dpdx); - -extern int chbval_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, doublereal *p); - -extern int chckid_(char *class__, integer *maxlen, char *id, ftnlen class_len, ftnlen id_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int chgirf_(integer *refa, integer *refb, doublereal *rotab, char *name__, integer *index, ftnlen name_len); -extern int irfrot_(integer *refa, integer *refb, doublereal *rotab); -extern int irfnum_(char *name__, integer *index, ftnlen name_len); -extern int irfnam_(integer *index, char *name__, ftnlen name_len); -extern int irfdef_(integer *index); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rotate_ 14 3 7 4 7 */ -/*:ref: wdcnt_ 4 2 13 124 */ -/*:ref: nthwd_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: rotmat_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: esrchc_ 4 5 13 4 13 124 124 */ - -extern int ckbsr_(char *fname, integer *handle, integer *inst, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *descr, char *segid, logical *found, ftnlen fname_len, ftnlen segid_len); -extern int cklpf_(char *fname, integer *handle, ftnlen fname_len); -extern int ckupf_(integer *handle); -extern int ckbss_(integer *inst, doublereal *sclkdp, doublereal *tol, logical *needav); -extern int cksns_(integer *handle, doublereal *descr, char *segid, logical *found, ftnlen segid_len); -extern int ckhave_(logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ - -extern int ckcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int ckcov_(char *ck, integer *idcode, logical *needav, char *level, doublereal *tol, char *timsys, doublereal *cover, ftnlen ck_len, ftnlen level_len, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: zzckcv01_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv02_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv03_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv04_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv05_ 14 9 4 4 4 4 7 7 13 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int cke01_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cke02_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequg_ 14 3 7 4 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: axisar_ 14 3 7 7 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cke03_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mtxm_ 14 3 7 7 7 */ -/*:ref: raxisa_ 14 3 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: axisar_ 14 3 7 7 7 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int cke04_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ - -extern int cke05_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: vdistg_ 7 3 7 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpsgip_ 14 3 4 4 7 */ -/*:ref: lgrind_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: qdq2av_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: q2m_ 14 2 7 7 */ - -extern int ckfrot_(integer *inst, doublereal *et, doublereal *rotate, integer *ref, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ckhave_ 14 1 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ -/*:ref: sce2c_ 14 3 4 7 7 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int ckfxfm_(integer *inst, doublereal *et, doublereal *xform, integer *ref, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: ckhave_ 14 1 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ -/*:ref: sce2c_ 14 3 4 7 7 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: rav2xf_ 14 3 7 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol, char *ref, doublereal *cmat, doublereal *clkout, logical *found, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckgpav_(integer *inst, doublereal *sclkdp, doublereal *tol, char *ref, doublereal *cmat, doublereal *av, doublereal *clkout, logical *found, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: xf2rav_ 14 3 7 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int ckgr01_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckgr02_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr02_ 14 3 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckgr03_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckgr04_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: zzck4d2i_ 14 4 7 4 7 4 */ - -extern int ckgr05_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckmeta_(integer *ckid, char *meta, integer *idcode, ftnlen meta_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int cknr01_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int cknr02_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cknr03_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int cknr04_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ - -extern int cknr05_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckobj_(char *ck, integer *ids, ftnlen ck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int ckopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ckpfs_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *cmat, doublereal *av, doublereal *clkout, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: ckr01_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke01_ 14 5 12 7 7 7 7 */ -/*:ref: ckr02_ 14 6 4 7 7 7 7 12 */ -/*:ref: cke02_ 14 5 12 7 7 7 7 */ -/*:ref: ckr03_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke03_ 14 5 12 7 7 7 7 */ -/*:ref: ckr04_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke04_ 14 5 12 7 7 7 7 */ -/*:ref: ckr05_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke05_ 14 5 12 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ckr01_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: lstcld_ 4 3 7 4 7 */ - -extern int ckr02_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: vequg_ 14 3 7 4 7 */ - -extern int ckr03_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dpmax_ 7 0 */ - -extern int ckr04_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: zzck4d2i_ 14 4 7 4 7 4 */ - -extern int ckr05_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckw01_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw02_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, char *segid, integer *nrec, doublereal *start, doublereal *stop, doublereal *quats, doublereal *avvs, doublereal *rates, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw03_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw04a_(integer *handle, integer *npkts, integer *pktsiz, doublereal *pktdat, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzck4i2d_ 14 4 4 4 7 7 */ -/*:ref: sgwvpk_ 14 6 4 4 4 7 4 7 */ - -extern int ckw04b_(integer *handle, doublereal *begtim, integer *inst, char *ref, logical *avflag, char *segid, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: sgbwvs_ 14 7 4 7 13 4 7 4 124 */ - -extern int ckw04e_(integer *handle, doublereal *endtim); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafrs_ 14 1 7 */ - -extern int ckw05_(integer *handle, integer *subtyp, integer *degree, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *n, doublereal *sclkdp, doublereal *packts, doublereal *rate, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int clearc_(integer *ndim, char *array, ftnlen array_len); - -extern int cleard_(integer *ndim, doublereal *array); - -extern int cleari_(integer *ndim, integer *array); - -extern doublereal clight_(void); - -extern int cmprss_(char *delim, integer *n, char *input, char *output, ftnlen delim_len, ftnlen input_len, ftnlen output_len); - -extern int conics_(doublereal *elts, doublereal *et, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ - -extern int convrt_(doublereal *x, char *in, char *out, doublereal *y, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpr_ 7 0 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int copyc_(char *cell, char *copy, ftnlen cell_len, ftnlen copy_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int copyd_(doublereal *cell, doublereal *copy); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int copyi_(integer *cell, integer *copy); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer countc_(integer *unit, integer *bline, integer *eline, char *line, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: astrip_ 14 8 13 13 13 13 124 124 124 124 */ - -extern integer cpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern integer cposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern int cyacip_(integer *nelt, char *dir, integer *ncycle, char *array, ftnlen dir_len, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: nbwid_ 4 3 13 4 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyadip_(integer *nelt, char *dir, integer *ncycle, doublereal *array, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyaiip_(integer *nelt, char *dir, integer *ncycle, integer *array, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclac_(char *array, integer *nelt, char *dir, integer *ncycle, char *out, ftnlen array_len, ftnlen dir_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: nbwid_ 4 3 13 4 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclad_(doublereal *array, integer *nelt, char *dir, integer *ncycle, doublereal *out, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclai_(integer *array, integer *nelt, char *dir, integer *ncycle, integer *out, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclec_(char *instr, char *dir, integer *ncycle, char *outstr, ftnlen instr_len, ftnlen dir_len, ftnlen outstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyllat_(doublereal *r__, doublereal *longc, doublereal *z__, doublereal *radius, doublereal *long__, doublereal *lat); - -extern int cylrec_(doublereal *r__, doublereal *long__, doublereal *z__, doublereal *rectan); - -extern int cylsph_(doublereal *r__, doublereal *longc, doublereal *z__, doublereal *radius, doublereal *colat, doublereal *long__); - -extern doublereal dacosh_(doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal dacosn_(doublereal *arg, doublereal *tol); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafa2b_(char *ascii, char *binary, integer *resv, ftnlen ascii_len, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daft2b_ 14 4 4 13 4 124 */ - -extern int dafac_(integer *handle, integer *n, char *buffer, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ -/*:ref: dafarr_ 14 2 4 4 */ - -extern int dafah_(char *fname, char *ftype, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, integer *unit, integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len); -extern int dafopr_(char *fname, integer *handle, ftnlen fname_len); -extern int dafopw_(char *fname, integer *handle, ftnlen fname_len); -extern int dafonw_(char *fname, char *ftype, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len); -extern int dafopn_(char *fname, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen ifname_len); -extern int dafcls_(integer *handle); -extern int dafhsf_(integer *handle, integer *nd, integer *ni); -extern int dafhlu_(integer *handle, integer *unit); -extern int dafluh_(integer *unit, integer *handle); -extern int dafhfn_(integer *handle, char *fname, ftnlen fname_len); -extern int daffnh_(char *fname, integer *handle, ftnlen fname_len); -extern int dafhof_(integer *fhset); -extern int dafsih_(integer *handle, char *access, ftnlen access_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: zzddhopn_ 14 7 13 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzdafgfr_ 14 11 4 13 4 4 13 4 4 4 12 124 124 */ -/*:ref: zzddhcls_ 14 4 4 13 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafrwa_ 14 3 4 4 4 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: zzdafnfr_ 14 12 4 13 4 4 13 4 4 4 13 124 124 124 */ -/*:ref: removi_ 14 2 4 4 */ -/*:ref: zzddhluh_ 14 3 4 4 12 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzddhfnh_ 14 4 13 4 12 124 */ -/*:ref: copyi_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: elemi_ 12 2 4 4 */ - -extern int dafana_(integer *handle, doublereal *sum, char *name__, doublereal *data, integer *n, ftnlen name_len); -extern int dafbna_(integer *handle, doublereal *sum, char *name__, ftnlen name_len); -extern int dafada_(doublereal *data, integer *n); -extern int dafena_(void); -extern int dafcad_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafhof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafhfn_ 14 3 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafwda_ 14 4 4 4 4 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafrwa_ 14 3 4 4 4 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ - -extern int dafarr_(integer *handle, integer *resv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafws_ 14 1 7 */ - -extern int dafb2a_(char *binary, char *ascii, ftnlen binary_len, ftnlen ascii_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopn_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafb2t_ 14 3 13 4 124 */ - -extern int dafb2t_(char *binary, integer *text, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int dafbt_(char *binfil, integer *xfrlun, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: wrenci_ 14 3 4 4 4 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: wrencd_ 14 3 4 4 7 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int dafdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrrr_ 14 2 4 4 */ - -extern int dafec_(integer *handle, integer *bufsiz, integer *n, char *buffer, logical *done, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int daffa_(integer *handle, doublereal *sum, char *name__, logical *found, ftnlen name_len); -extern int dafbfs_(integer *handle); -extern int daffna_(logical *found); -extern int dafbbs_(integer *handle); -extern int daffpa_(logical *found); -extern int dafgs_(doublereal *sum); -extern int dafgn_(char *name__, ftnlen name_len); -extern int dafgh_(integer *handle); -extern int dafrs_(doublereal *sum); -extern int dafrn_(char *name__, ftnlen name_len); -extern int dafws_(doublereal *sum); -extern int dafcs_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dafhof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafgsr_ 14 6 4 4 4 4 7 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: dafhfn_ 14 3 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ - -extern int dafgda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafgdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ - -extern int dafps_(integer *nd, integer *ni, doublereal *dc, integer *ic, doublereal *sum); -extern int dafus_(doublereal *sum, integer *nd, integer *ni, doublereal *dc, integer *ic); -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: movei_ 14 3 4 4 4 */ - -extern int dafra_(integer *handle, integer *iorder, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isordv_ 12 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: dafws_ 14 1 7 */ -/*:ref: dafrn_ 14 2 13 124 */ - -extern int dafrcr_(integer *handle, integer *recno, char *crec, ftnlen crec_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ - -extern int dafrda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: zzddhisn_ 14 3 4 12 12 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ - -extern int dafrfr_(integer *handle, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzdafgfr_ 14 11 4 13 4 4 13 4 4 4 12 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dafrrr_(integer *handle, integer *resv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafws_ 14 1 7 */ - -extern int dafrwa_(integer *recno, integer *wordno, integer *addr__); -extern int dafarw_(integer *addr__, integer *recno, integer *wordno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafrwd_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *drec, doublereal *data, logical *found, integer *reads, integer *reqs); -extern int dafgdr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafgsr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafrdr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafwdr_(integer *handle, integer *recno, doublereal *drec); -extern int dafnrr_(integer *reads, integer *reqs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: minai_ 14 4 4 4 4 4 */ -/*:ref: zzdafgdr_ 14 4 4 4 7 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: zzddhrcm_ 14 3 4 4 4 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: zzdafgsr_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzddhisn_ 14 3 4 12 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int daft2b_(integer *text, char *binary, integer *resv, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafena_ 14 0 */ - -extern int daftb_(integer *xfrlun, char *binfil, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: rdenci_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rdencd_ 14 3 4 4 7 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int dafwcr_(integer *handle, integer *recno, char *crec, ftnlen crec_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafwda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ - -extern int dafwfr_(integer *handle, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dasa2l_(integer *handle, integer *type__, integer *addrss, integer *clbase, integer *clsize, integer *recno, integer *wordno); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ - -extern int dasac_(integer *handle, integer *n, char *buffer, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasacr_ 14 2 4 4 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ - -extern int dasacr_(integer *handle, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern int dasacu_(integer *comlun, char *begmrk, char *endmrk, logical *insbln, integer *handle, ftnlen begmrk_len, ftnlen endmrk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: readln_ 14 4 4 13 12 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: readla_ 14 6 4 4 4 13 12 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: writla_ 14 4 4 13 4 124 */ -/*:ref: dasac_ 14 4 4 4 13 124 */ - -extern int dasadc_(integer *handle, integer *n, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: daswrc_ 14 4 4 4 13 124 */ -/*:ref: dasurc_ 14 6 4 4 4 4 13 124 */ -/*:ref: dascud_ 14 3 4 4 4 */ - -extern int dasadd_(integer *handle, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: daswrd_ 14 3 4 4 7 */ -/*:ref: dasurd_ 14 5 4 4 4 4 7 */ -/*:ref: dascud_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasadi_(integer *handle, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: daswri_ 14 3 4 4 4 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ -/*:ref: dascud_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasbt_(char *binfil, integer *xfrlun, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: wrenci_ 14 3 4 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: wrencc_ 14 4 4 4 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: wrencd_ 14 3 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int dascls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dashof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dassdr_ 14 1 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int dascud_(integer *handle, integer *type__, integer *nwords); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: daswri_ 14 3 4 4 4 */ - -extern int dasdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasrcr_ 14 2 4 4 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ - -extern int dasec_(integer *handle, integer *bufsiz, integer *n, char *buffer, logical *done, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int dasecu_(integer *handle, integer *comlun, logical *comnts); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasec_ 14 6 4 4 4 13 12 124 */ -/*:ref: writla_ 14 4 4 13 4 124 */ - -extern int dasfm_(char *fname, char *ftype, char *ifname, integer *handle, integer *unit, integer *free, integer *lastla, integer *lastrc, integer *lastwd, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len); -extern int dasopr_(char *fname, integer *handle, ftnlen fname_len); -extern int dasopw_(char *fname, integer *handle, ftnlen fname_len); -extern int dasonw_(char *fname, char *ftype, char *ifname, integer *ncomr, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len); -extern int dasopn_(char *fname, char *ifname, integer *handle, ftnlen fname_len, ftnlen ifname_len); -extern int dasops_(integer *handle); -extern int dasllc_(integer *handle); -extern int dashfs_(integer *handle, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *free, integer *lastla, integer *lastrc, integer *lastwd); -extern int dasufs_(integer *handle, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *free, integer *lastla, integer *lastrc, integer *lastwd); -extern int dashlu_(integer *handle, integer *unit); -extern int dasluh_(integer *unit, integer *handle); -extern int dashfn_(integer *handle, char *fname, ftnlen fname_len); -extern int dasfnh_(char *fname, integer *handle, ftnlen fname_len); -extern int dashof_(integer *fhset); -extern int dassih_(integer *handle, char *access, ftnlen access_len); -extern int dasham_(integer *handle, char *access, ftnlen access_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzddhppf_ 14 3 4 4 4 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: zzdasnfr_ 14 11 4 13 13 4 4 4 4 13 124 124 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: removi_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: copyi_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: elemi_ 12 2 4 4 */ - -extern doublereal dasine_(doublereal *arg, doublereal *tol); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasioc_(char *action, integer *unit, integer *recno, char *record, ftnlen action_len, ftnlen record_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int dasiod_(char *action, integer *unit, integer *recno, doublereal *record, ftnlen action_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int dasioi_(char *action, integer *unit, integer *recno, integer *record, ftnlen action_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int daslla_(integer *handle, integer *lastc, integer *lastd, integer *lasti); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasrcr_(integer *handle, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern int dasrdc_(integer *handle, integer *first, integer *last, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrrc_ 14 6 4 4 4 4 13 124 */ - -extern int dasrdd_(integer *handle, integer *first, integer *last, doublereal *data); -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: dasrrd_ 14 5 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ - -extern int dasrdi_(integer *handle, integer *first, integer *last, integer *data); -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ - -extern int dasrfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dasrwr_(integer *handle, integer *recno, char *recc, doublereal *recd, integer *reci, integer *first, integer *last, doublereal *datad, integer *datai, char *datac, ftnlen recc_len, ftnlen datac_len); -extern int dasrrd_(integer *handle, integer *recno, integer *first, integer *last, doublereal *datad); -extern int dasrri_(integer *handle, integer *recno, integer *first, integer *last, integer *datai); -extern int dasrrc_(integer *handle, integer *recno, integer *first, integer *last, char *datac, ftnlen datac_len); -extern int daswrd_(integer *handle, integer *recno, doublereal *recd); -extern int daswri_(integer *handle, integer *recno, integer *reci); -extern int daswrc_(integer *handle, integer *recno, char *recc, ftnlen recc_len); -extern int dasurd_(integer *handle, integer *recno, integer *first, integer *last, doublereal *datad); -extern int dasuri_(integer *handle, integer *recno, integer *first, integer *last, integer *datai); -extern int dasurc_(integer *handle, integer *recno, integer *first, integer *last, char *datac, ftnlen datac_len); -extern int daswbr_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: lnkxsl_ 14 3 4 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ - -extern int dassdr_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int dastb_(integer *xfrlun, char *binfil, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dasonw_ 14 8 13 13 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: rdenci_ 14 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: dasacr_ 14 2 4 4 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rdencc_ 14 4 4 4 13 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasadc_ 14 6 4 4 4 4 13 124 */ -/*:ref: rdencd_ 14 3 4 4 7 */ -/*:ref: dasadd_ 14 3 4 4 7 */ -/*:ref: dasadi_ 14 3 4 4 4 */ - -extern int dasudc_(integer *handle, integer *first, integer *last, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasurc_ 14 6 4 4 4 4 13 124 */ - -extern int dasudd_(integer *handle, integer *first, integer *last, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasurd_ 14 5 4 4 4 4 7 */ - -extern int dasudi_(integer *handle, integer *first, integer *last, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ - -extern int daswfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern doublereal datanh_(doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal dcbrt_(doublereal *x); - -extern int dcyldr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: drdcyl_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int delfil_(char *filnam, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: getlun_ 14 1 4 */ - -extern int deltet_(doublereal *epoch, char *eptype, doublereal *delta, ftnlen eptype_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern doublereal det_(doublereal *m1); - -extern int dgeodr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: drdgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern doublereal dhfa_(doublereal *state, doublereal *bodyr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int diags2_(doublereal *symmat, doublereal *diag, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rquad_ 14 5 7 7 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ - -extern int diffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int diffd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int diffi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dlatdr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: drdlat_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int dnearp_(doublereal *state, doublereal *a, doublereal *b, doublereal *c__, doublereal *dnear, doublereal *dalt, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vtmv_ 7 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int dp2hx_(doublereal *number, char *string, integer *length, ftnlen string_len); -/*:ref: int2hx_ 14 4 4 13 4 124 */ - -extern int dpfmt_(doublereal *x, char *pictur, char *str, ftnlen pictur_len, ftnlen str_len); -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzvststr_ 14 4 7 13 4 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rjust_ 14 4 13 13 124 124 */ -/*:ref: zzvsbstr_ 14 6 4 4 12 13 12 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int dpgrdr_(char *body, doublereal *x, doublereal *y, doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: dgeodr_ 14 6 7 7 7 7 7 7 */ - -extern doublereal dpr_(void); - -extern int dpspce_(doublereal *time, doublereal *geophs, doublereal *elems, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: zzdpinit_ 14 6 7 7 7 7 7 7 */ -/*:ref: zzdpper_ 14 6 7 7 7 7 7 7 */ -/*:ref: zzdpsec_ 14 9 7 7 7 7 7 7 7 7 7 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dpstr_(doublereal *x, integer *sigdig, char *string, ftnlen string_len); -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int dpstrf_(doublereal *x, integer *sigdig, char *format, char *string, ftnlen format_len, ftnlen string_len); -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: zzvststr_ 14 4 7 13 4 124 */ -/*:ref: zzvsbstr_ 14 6 4 4 12 13 12 124 */ - -extern int drdcyl_(doublereal *r__, doublereal *long__, doublereal *z__, doublereal *jacobi); - -extern int drdgeo_(doublereal *long__, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int drdlat_(doublereal *r__, doublereal *long__, doublereal *lat, doublereal *jacobi); - -extern int drdpgr_(char *body, doublereal *lon, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: drdgeo_ 14 6 7 7 7 7 7 7 */ - -extern int drdsph_(doublereal *r__, doublereal *colat, doublereal *long__, doublereal *jacobi); - -extern int drotat_(doublereal *angle, integer *iaxis, doublereal *dmout); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dsphdr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: drdsph_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int ducrss_(doublereal *s1, doublereal *s2, doublereal *sout); -/*:ref: dvcrss_ 14 3 7 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ - -extern int dvcrss_(doublereal *s1, doublereal *s2, doublereal *sout); -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern doublereal dvdot_(doublereal *s1, doublereal *s2); - -extern int dvhat_(doublereal *s1, doublereal *sout); -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern doublereal dvnorm_(doublereal *state); -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ - -extern doublereal dvsep_(doublereal *s1, doublereal *s2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dxtrct_(char *keywd, integer *maxwds, char *string, integer *nfound, integer *parsed, doublereal *values, ftnlen keywd_len, ftnlen string_len); -/*:ref: wdindx_ 4 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int edlimb_(doublereal *a, doublereal *b, doublereal *c__, doublereal *viewpt, doublereal *limb); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: inedpl_ 14 6 7 7 7 7 7 12 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int edterm_(char *trmtyp, char *source, char *target, doublereal *et, char *fixfrm, char *abcorr, char *obsrvr, integer *npts, doublereal *trgepc, doublereal *obspos, doublereal *trmpts, ftnlen trmtyp_len, ftnlen source_len, ftnlen target_len, ftnlen fixfrm_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: bodvrd_ 14 7 13 13 4 4 7 124 124 */ -/*:ref: spkpos_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: zzedterm_ 14 9 13 7 7 7 7 7 4 7 124 */ - -extern int ekacec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad03_ 14 7 4 4 4 4 13 12 124 */ -/*:ref: zzekad06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekaced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekad05_ 14 7 4 4 4 4 4 7 12 */ - -extern int ekacei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekad04_ 14 7 4 4 4 4 4 4 12 */ - -extern int ekaclc_(integer *handle, integer *segno, char *column, char *cvals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac03_ 14 8 4 4 4 13 12 4 4 124 */ -/*:ref: zzekac06_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: zzekac09_ 14 7 4 4 4 13 12 4 124 */ - -extern int ekacld_(integer *handle, integer *segno, char *column, doublereal *dvals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac02_ 14 7 4 4 4 7 12 4 4 */ -/*:ref: zzekac05_ 14 6 4 4 4 7 4 12 */ -/*:ref: zzekac08_ 14 6 4 4 4 7 12 4 */ - -extern int ekacli_(integer *handle, integer *segno, char *column, integer *ivals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac01_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: zzekac04_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekac07_ 14 6 4 4 4 4 12 4 */ - -extern int ekappr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: ekinsr_ 14 3 4 4 4 */ - -extern int ekbseg_(integer *handle, char *tabnam, integer *ncols, char *cnames, char *decls, integer *segno, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: lxdfid_ 14 1 4 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: lxidnt_ 14 6 4 13 4 4 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekpdec_ 14 3 13 4 124 */ -/*:ref: zzekstyp_ 4 2 4 4 */ -/*:ref: zzekbs01_ 14 8 4 13 4 13 4 4 124 124 */ -/*:ref: zzekbs02_ 14 8 4 13 4 13 4 4 124 124 */ - -extern int ekcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekdelr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekde01_ 14 4 4 4 4 4 */ -/*:ref: zzekde02_ 14 4 4 4 4 4 */ -/*:ref: zzekde03_ 14 4 4 4 4 4 */ -/*:ref: zzekde04_ 14 4 4 4 4 4 */ -/*:ref: zzekde05_ 14 4 4 4 4 4 */ -/*:ref: zzekde06_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekffld_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekff01_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekfind_(char *query, integer *nmrows, logical *error, char *errmsg, ftnlen query_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpars_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: zzeknres_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: zzektres_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: zzeksemc_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: eksrch_ 14 8 4 13 7 4 12 13 124 124 */ - -extern int ekifld_(integer *handle, char *tabnam, integer *ncols, integer *nrows, char *cnames, char *decls, integer *segno, integer *rcptrs, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekbseg_ 14 9 4 13 4 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekif01_ 14 3 4 4 4 */ -/*:ref: zzekif02_ 14 2 4 4 */ - -extern int ekinsr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: filli_ 14 3 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ - -extern integer eknseg_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrsz_ 4 2 4 4 */ - -extern int ekopn_(char *fname, char *ifname, integer *ncomch, integer *handle, ftnlen fname_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasonw_ 14 8 13 13 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekpgin_ 14 1 4 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekopr_(char *fname, integer *handle, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ - -extern int ekops_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgin_ 14 1 4 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekopw_(char *fname, integer *handle, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopw_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ - -extern int ekpsel_(char *query, integer *n, integer *xbegs, integer *xends, char *xtypes, char *xclass, char *tabs, char *cols, logical *error, char *errmsg, ftnlen query_len, ftnlen xtypes_len, ftnlen xclass_len, ftnlen tabs_len, ftnlen cols_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekencd_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: zzekqsel_ 14 12 4 13 4 4 4 13 4 13 4 124 124 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ - -extern int ekqmgr_(integer *cindex, integer *elment, char *eqryc, doublereal *eqryd, integer *eqryi, char *fname, integer *row, integer *selidx, char *column, integer *handle, integer *n, char *table, integer *attdsc, integer *ccount, logical *found, integer *nelt, integer *nmrows, logical *semerr, char *errmsg, char *cdata, doublereal *ddata, integer *idata, logical *null, ftnlen eqryc_len, ftnlen fname_len, ftnlen column_len, ftnlen table_len, ftnlen errmsg_len, ftnlen cdata_len); -extern int eklef_(char *fname, integer *handle, ftnlen fname_len); -extern int ekuef_(integer *handle); -extern int ekntab_(integer *n); -extern int ektnam_(integer *n, char *table, ftnlen table_len); -extern int ekccnt_(char *table, integer *ccount, ftnlen table_len); -extern int ekcii_(char *table, integer *cindex, char *column, integer *attdsc, ftnlen table_len, ftnlen column_len); -extern int eksrch_(integer *eqryi, char *eqryc, doublereal *eqryd, integer *nmrows, logical *semerr, char *errmsg, ftnlen eqryc_len, ftnlen errmsg_len); -extern int eknelt_(integer *selidx, integer *row, integer *nelt); -extern int ekgc_(integer *selidx, integer *row, integer *elment, char *cdata, logical *null, logical *found, ftnlen cdata_len); -extern int ekgd_(integer *selidx, integer *row, integer *elment, doublereal *ddata, logical *null, logical *found); -extern int ekgi_(integer *selidx, integer *row, integer *elment, integer *idata, logical *null, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ekopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: ekcls_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: zzeksinf_ 14 8 4 4 13 4 13 4 124 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: appndc_ 14 4 13 13 124 124 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksdec_ 14 1 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekqcnj_ 14 3 4 4 4 */ -/*:ref: zzekqcon_ 14 24 4 13 7 4 4 13 4 13 4 4 13 4 13 4 4 4 4 7 4 124 124 124 124 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekkey_ 14 20 4 4 4 4 4 4 4 4 13 4 4 7 4 12 4 4 4 4 12 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekrplk_ 14 4 4 4 4 4 */ -/*:ref: zzekrmch_ 12 15 4 12 4 4 4 4 4 4 4 13 4 4 7 4 124 */ -/*:ref: zzekvmch_ 12 13 4 12 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekjsqz_ 14 1 4 */ -/*:ref: zzekjoin_ 14 18 4 4 4 12 4 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekweed_ 14 3 4 4 4 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzekqsel_ 14 12 4 13 4 4 4 13 4 13 4 124 124 124 */ -/*:ref: zzekqord_ 14 11 4 13 4 13 4 13 4 4 124 124 124 */ -/*:ref: zzekjsrt_ 14 13 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekvcal_ 14 3 4 4 4 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ - -extern int ekrcec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd03_ 14 8 4 4 4 4 4 13 12 124 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd06_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrd09_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekrced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd05_ 14 9 4 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrd08_ 14 6 4 4 4 4 7 12 */ - -extern int ekrcei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd04_ 14 9 4 4 4 4 4 4 4 12 12 */ -/*:ref: zzekrd07_ 14 6 4 4 4 4 4 12 */ - -extern int ekshdw_(integer *handle, logical *isshad); - -extern int ekssum_(integer *handle, integer *segno, char *tabnam, integer *nrows, integer *ncols, char *cnames, char *dtypes, integer *sizes, integer *strlns, logical *indexd, logical *nullok, ftnlen tabnam_len, ftnlen cnames_len, ftnlen dtypes_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksinf_ 14 8 4 4 13 4 13 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekucec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue03_ 14 7 4 4 4 4 13 12 124 */ -/*:ref: zzekue06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekuced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekue05_ 14 7 4 4 4 4 4 7 12 */ - -extern int ekucei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekue04_ 14 7 4 4 4 4 4 4 12 */ - -extern int el2cgv_(doublereal *ellips, doublereal *center, doublereal *smajor, doublereal *sminor); -/*:ref: vequ_ 14 2 7 7 */ - -extern logical elemc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical elemd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical elemi_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int elltof_(doublereal *ma, doublereal *ecc, doublereal *e); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int enchar_(integer *number, char *string, ftnlen string_len); -extern int dechar_(char *string, integer *number, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: chbase_ 4 0 */ - -extern logical eqchr_(char *a, char *b, ftnlen a_len, ftnlen b_len); -extern logical nechr_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int eqncpv_(doublereal *et, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *decpol, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: twopi_ 7 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: kepleq_ 7 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern logical eqstr_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int erract_(char *op, char *action, ftnlen op_len, ftnlen action_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getact_ 14 1 4 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: putact_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int errch_(char *marker, char *string, ftnlen marker_len, ftnlen string_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errdev_(char *op, char *device, ftnlen op_len, ftnlen device_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: putdev_ 14 2 13 124 */ - -extern int errdp_(char *marker, doublereal *dpnum, ftnlen marker_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errfnm_(char *marker, integer *unit, ftnlen marker_len); -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int errhan_(char *marker, integer *handle, ftnlen marker_len); -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int errint_(char *marker, integer *integr, ftnlen marker_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errprt_(char *op, char *list, ftnlen op_len, ftnlen list_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: msgsel_ 12 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: setprt_ 12 5 12 12 12 12 12 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer esrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int et2lst_(doublereal *et, integer *body, doublereal *long__, char *type__, integer *hr, integer *mn, integer *sc, char *time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: pgrrec_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: pi_ 7 0 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ - -extern int et2utc_(doublereal *et, char *format, integer *prec, char *utcstr, ftnlen format_len, ftnlen utcstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int etcal_(doublereal *et, char *string, ftnlen string_len); -/*:ref: spd_ 7 0 */ -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: lstlti_ 4 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ - -extern int eul2m_(doublereal *angle3, doublereal *angle2, doublereal *angle1, integer *axis3, integer *axis2, integer *axis1, doublereal *r__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rotate_ 14 3 7 4 7 */ -/*:ref: rotmat_ 14 4 7 7 4 7 */ - -extern int ev2lin_(doublereal *et, doublereal *geophs, doublereal *elems, doublereal *state); -/*:ref: twopi_ 7 0 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern logical even_(integer *i__); - -extern doublereal exact_(doublereal *number, doublereal *value, doublereal *tol); - -extern int excess_(integer *number, char *struct__, ftnlen struct_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical exists_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int expln_(char *msg, char *expl, ftnlen msg_len, ftnlen expl_len); - -extern integer fetchc_(integer *nth, char *set, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer fetchd_(integer *nth, doublereal *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer fetchi_(integer *nth, integer *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int fillc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern int filld_(doublereal *value, integer *ndim, doublereal *array); - -extern int filli_(integer *value, integer *ndim, integer *array); - -extern int fn2lun_(char *filnam, integer *lunit, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int fndlun_(integer *unit); -extern int reslun_(integer *unit); -extern int frelun_(integer *unit); - -extern int fndnwd_(char *string, integer *start, integer *b, integer *e, ftnlen string_len); - -extern int frame_(doublereal *x, doublereal *y, doublereal *z__); -/*:ref: vhatip_ 14 1 7 */ - -extern int framex_(char *cname, char *frname, integer *frcode, integer *cent, integer *class__, integer *clssid, logical *found, ftnlen cname_len, ftnlen frname_len); -extern int namfrm_(char *frname, integer *frcode, ftnlen frname_len); -extern int frmnam_(integer *frcode, char *frname, ftnlen frname_len); -extern int frinfo_(integer *frcode, integer *cent, integer *class__, integer *clssid, logical *found); -extern int cidfrm_(integer *cent, integer *frcode, char *frname, logical *found, ftnlen frname_len); -extern int cnmfrm_(char *cname, integer *frcode, char *frname, logical *found, ftnlen cname_len, ftnlen frname_len); -extern int ccifrm_(integer *class__, integer *clssid, integer *frcode, char *frname, integer *cent, logical *found, ftnlen frname_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: zzfdat_ 14 10 4 13 4 4 4 4 4 4 4 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bschoc_ 4 6 13 4 13 4 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: gnpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int frmchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frmget_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int frmget_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynfrm_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ - -extern integer frstnb_(char *string, ftnlen string_len); - -extern integer frstnp_(char *string, ftnlen string_len); - -extern integer frstpc_(char *string, ftnlen string_len); - -extern integer gcd_(integer *a, integer *b); - -extern int georec_(doublereal *long__, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int getelm_(integer *frstyr, char *lines, doublereal *epoch, doublereal *elems, ftnlen lines_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzgetelm_ 14 8 4 13 7 7 12 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int getfat_(char *file, char *arch, char *kertyp, ftnlen file_len, ftnlen arch_len, ftnlen kertyp_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhfnh_ 14 4 13 4 12 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dashof_ 14 1 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: zzckspk_ 14 3 4 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int getfov_(integer *instid, integer *room, char *shape, char *frame, doublereal *bsight, integer *n, doublereal *bounds, ftnlen shape_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int getlun_(integer *unit); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: fndlun_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int getmsg_(char *option, char *msg, ftnlen option_len, ftnlen msg_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getsms_ 14 2 13 124 */ -/*:ref: expln_ 14 4 13 13 124 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical gfbail_(void); - -extern int gfdist_(char *target, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfevnt_(U_fp udstep, U_fp udrefn, char *gquant, integer *qnpars, char *qpnams, char *qcpars, doublereal *qdpars, integer *qipars, logical *qlpars, char *op, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, logical *rpt, U_fp udrepi, U_fp udrepu, U_fp udrepf, integer *mw, integer *nw, doublereal *work, logical *bail, L_fp udbail, doublereal *result, ftnlen gquant_len, ftnlen qpnams_len, ftnlen qcpars_len, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzgfspin_ 14 11 13 13 13 13 7 13 124 124 124 124 124 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 200 200 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: zzgfdiin_ 14 7 13 13 13 7 124 124 124 */ -/*:ref: zzgfcslv_ 14 37 13 13 13 13 13 13 13 7 13 13 13 7 7 7 200 200 12 200 200 200 12 212 4 4 7 7 7 124 124 124 124 124 124 124 124 124 124 */ -/*:ref: zzgfrrin_ 14 8 13 13 13 7 7 124 124 124 */ - -extern int gffove_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zzgffvin_ 14 13 13 13 7 13 13 13 13 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ - -extern int gfocce_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *abcorr, char *obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzgfocin_ 14 18 13 13 13 13 13 13 13 13 13 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ - -extern int gfoclt_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gfocce_ 14 29 13 13 13 13 13 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfposc_(char *target, char *frame, char *abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen frame_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfrefn_(doublereal *t1, doublereal *t2, logical *s1, logical *s2, doublereal *t); -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int gfrfov_(char *inst, doublereal *raydir, char *rframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen rframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gffove_ 14 24 13 13 7 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfrprt_(doublereal *window, char *begmss, char *endmss, doublereal *ivbeg, doublereal *ivend, doublereal *time, ftnlen begmss_len, ftnlen endmss_len); -extern int gfrepi_(doublereal *window, char *begmss, char *endmss, ftnlen begmss_len, ftnlen endmss_len); -extern int gfrepu_(doublereal *ivbeg, doublereal *ivend, doublereal *time); -extern int gfrepf_(void); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: wnsumd_ 14 6 7 7 7 7 4 4 */ -/*:ref: zzgftswk_ 14 7 7 7 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zzgfwkin_ 14 1 7 */ -/*:ref: zzgfwkad_ 14 6 7 4 13 13 124 124 */ -/*:ref: zzgfwkmo_ 14 9 4 7 7 4 13 13 7 124 124 */ -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: zzgfdsps_ 14 6 4 13 13 4 124 124 */ - -extern int gfrr_(char *target, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfsep_(char *targ1, char *shape1, char *frame1, char *targ2, char *shape2, char *frame2, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen targ1_len, ftnlen shape1_len, ftnlen frame1_len, ftnlen targ2_len, ftnlen shape2_len, ftnlen frame2_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfsntc_(char *target, char *fixref, char *method, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfstep_(doublereal *time, doublereal *step); -extern int gfsstp_(doublereal *step); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int gfsubc_(char *target, char *fixref, char *method, char *abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gftfov_(char *inst, char *target, char *tshape, char *tframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen target_len, ftnlen tshape_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gffove_ 14 24 13 13 7 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfuds_(U_fp udfunc, U_fp udqdec, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen relate_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: zzgfref_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: zzgfrelx_ 14 26 200 200 200 200 200 214 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern doublereal halfpi_(void); - -extern int hrmesp_(integer *n, doublereal *first, doublereal *step, doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, doublereal *df); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int hrmint_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, doublereal *df); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int hx2dp_(char *string, doublereal *number, logical *error, char *errmsg, ftnlen string_len, ftnlen errmsg_len); -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ - -extern int hx2int_(char *string, integer *number, logical *error, char *errmsg, ftnlen string_len, ftnlen errmsg_len); -/*:ref: intmin_ 4 0 */ -/*:ref: intmax_ 4 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ - -extern int hyptof_(doublereal *ma, doublereal *ecc, doublereal *f); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int ident_(doublereal *matrix); - -extern int idw2at_(char *idword, char *arch, char *type__, ftnlen idword_len, ftnlen arch_len, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int illum_(char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar, doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int ilumin_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, doublereal *phase, doublereal *solar, doublereal *emissn, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int inedpl_(doublereal *a, doublereal *b, doublereal *c__, doublereal *plane, doublereal *ellips, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: pl2psv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ - -extern int inelpl_(doublereal *ellips, doublereal *plane, integer *nxpts, doublereal *xpt1, doublereal *xpt2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: pl2nvp_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int inrypl_(doublereal *vertex, doublereal *dir, doublereal *plane, integer *nxpts, doublereal *xpt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: smsgnd_ 12 2 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int inslac_(char *elts, integer *ne, integer *loc, char *array, integer *na, ftnlen elts_len, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inslad_(doublereal *elts, integer *ne, integer *loc, doublereal *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inslai_(integer *elts, integer *ne, integer *loc, integer *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrtc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrtd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrti_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inssub_(char *in, char *sub, integer *loc, char *out, ftnlen in_len, ftnlen sub_len, ftnlen out_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int int2hx_(integer *number, char *string, integer *length, ftnlen string_len); - -extern int interc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int interd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int interi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int intord_(integer *n, char *string, ftnlen string_len); -/*:ref: inttxt_ 14 3 4 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int intstr_(integer *number, char *string, ftnlen string_len); - -extern int inttxt_(integer *n, char *string, ftnlen string_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int invert_(doublereal *m1, doublereal *mout); -/*:ref: det_ 7 1 7 */ -/*:ref: filld_ 14 3 7 4 7 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ - -extern int invort_(doublereal *m, doublereal *mit); -/*:ref: dpmax_ 7 0 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int invstm_(doublereal *mat, doublereal *invmat); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: xposbl_ 14 5 7 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ioerr_(char *action, char *file, integer *iostat, ftnlen action_len, ftnlen file_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ - -extern int irftrn_(char *refa, char *refb, doublereal *rotab, ftnlen refa_len, ftnlen refb_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int iso2utc_(char *tstrng, char *utcstr, char *error, ftnlen tstrng_len, ftnlen utcstr_len, ftnlen error_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical isopen_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern logical isordv_(integer *array, integer *n); - -extern integer isrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern integer isrchd_(doublereal *value, integer *ndim, doublereal *array); - -extern integer isrchi_(integer *value, integer *ndim, integer *array); - -extern logical isrot_(doublereal *m, doublereal *ntol, doublereal *dtol); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: det_ 7 1 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern doublereal j1900_(void); - -extern doublereal j1950_(void); - -extern doublereal j2000_(void); - -extern doublereal j2100_(void); - -extern int jul2gr_(integer *year, integer *month, integer *day, integer *doy); -extern int gr2jul_(integer *year, integer *month, integer *day, integer *doy); -/*:ref: rmaini_ 14 4 4 4 4 4 */ -/*:ref: lstlti_ 4 3 4 4 4 */ - -extern doublereal jyear_(void); - -extern int keeper_(integer *which, char *kind, char *file, integer *count, char *filtyp, integer *handle, char *source, logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int furnsh_(char *file, ftnlen file_len); -extern int ktotal_(char *kind, integer *count, ftnlen kind_len); -extern int kdata_(integer *which, char *kind, char *file, char *filtyp, char *source, integer *handle, logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int kinfo_(char *file, char *filtyp, char *source, integer *handle, logical *found, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int kclear_(void); -extern int unload_(char *file, ftnlen file_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzldker_ 14 7 13 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: stpool_ 14 9 13 4 13 13 4 12 124 124 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: samsub_ 12 8 13 4 4 13 4 4 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: repmot_ 14 9 13 13 4 13 13 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dvpool_ 14 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: spkuef_ 14 1 4 */ -/*:ref: ckupf_ 14 1 4 */ -/*:ref: pckuof_ 14 1 4 */ -/*:ref: ekuef_ 14 1 4 */ -/*:ref: clpool_ 14 0 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: ldpool_ 14 2 13 124 */ -/*:ref: spklef_ 14 3 13 4 124 */ -/*:ref: cklpf_ 14 3 13 4 124 */ -/*:ref: pcklof_ 14 3 13 4 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ - -extern doublereal kepleq_(doublereal *ml, doublereal *h__, doublereal *k); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: kpsolv_ 7 1 7 */ - -extern doublereal kpsolv_(doublereal *evec); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int kxtrct_(char *keywd, char *terms, integer *nterms, char *string, logical *found, char *substr, ftnlen keywd_len, ftnlen terms_len, ftnlen string_len, ftnlen substr_len); -/*:ref: wdindx_ 4 4 13 13 124 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: shiftl_ 14 7 13 4 13 13 124 124 124 */ - -extern integer lastnb_(char *string, ftnlen string_len); - -extern integer lastpc_(char *string, ftnlen string_len); - -extern int latcyl_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *r__, doublereal *longc, doublereal *z__); - -extern int latrec_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *rectan); - -extern int latsph_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *rho, doublereal *colat, doublereal *longs); -/*:ref: halfpi_ 7 0 */ - -extern int lbuild_(char *items, integer *n, char *delim, char *list, ftnlen items_len, ftnlen delim_len, ftnlen list_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int lcase_(char *in, char *out, ftnlen in_len, ftnlen out_len); - -extern doublereal lgresp_(integer *n, doublereal *first, doublereal *step, doublereal *yvals, doublereal *work, doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lgrind_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *work, doublereal *x, doublereal *p, doublereal *dp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern doublereal lgrint_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *work, doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int ljust_(char *input, char *output, ftnlen input_len, ftnlen output_len); - -extern int lnkan_(integer *pool, integer *new__); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkfsl_(integer *head, integer *tail, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnkhl_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkila_(integer *prev, integer *list, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkilb_(integer *list, integer *next, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkini_(integer *size, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnknfn_(integer *pool); - -extern integer lnknxt_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnkprv_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnksiz_(integer *pool); - -extern integer lnktl_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkxsl_(integer *head, integer *tail, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int locati_(integer *id, integer *idsz, integer *list, integer *pool, integer *at, logical *presnt); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnksiz_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lnkxsl_ 14 3 4 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ - -extern int locln_(integer *unit, char *bmark, char *emark, char *line, integer *bline, integer *eline, logical *found, ftnlen bmark_len, ftnlen emark_len, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ltrim_ 4 2 13 124 */ - -extern int lparse_(char *list, char *delim, integer *nmax, integer *n, char *items, ftnlen list_len, ftnlen delim_len, ftnlen items_len); - -extern int lparsm_(char *list, char *delims, integer *nmax, integer *n, char *items, ftnlen list_len, ftnlen delims_len, ftnlen items_len); - -extern int lparss_(char *list, char *delims, char *set, ftnlen list_len, ftnlen delims_len, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal lspcn_(char *body, doublereal *et, char *abcorr, ftnlen body_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkezr_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ - -extern integer lstcld_(doublereal *x, integer *n, doublereal *array); - -extern integer lstcli_(integer *x, integer *n, integer *array); - -extern integer lstlec_(char *string, integer *n, char *array, ftnlen string_len, ftnlen array_len); - -extern integer lstled_(doublereal *x, integer *n, doublereal *array); - -extern integer lstlei_(integer *x, integer *n, integer *array); - -extern integer lstltc_(char *string, integer *n, char *array, ftnlen string_len, ftnlen array_len); - -extern integer lstltd_(doublereal *x, integer *n, doublereal *array); - -extern integer lstlti_(integer *x, integer *n, integer *array); - -extern int ltime_(doublereal *etobs, integer *obs, char *dir, integer *targ, doublereal *ettarg, doublereal *elapsd, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: clight_ 7 0 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: failed_ 12 0 */ - -extern integer ltrim_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ - -extern int lun2fn_(integer *lunit, char *filnam, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lx4dec_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: lx4sgn_ 14 5 13 4 4 4 124 */ - -extern int lx4num_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4dec_ 14 5 13 4 4 4 124 */ -/*:ref: lx4sgn_ 14 5 13 4 4 4 124 */ - -extern int lx4sgn_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ - -extern int lx4uns_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); - -extern int lxname_(char *hdchrs, char *tlchrs, char *string, integer *first, integer *last, integer *idspec, integer *nchar, ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len); -extern int lxidnt_(integer *idspec, char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -extern int lxdfid_(integer *idspec); -extern int lxcsid_(char *hdchrs, char *tlchrs, integer *idspec, ftnlen hdchrs_len, ftnlen tlchrs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: validi_ 14 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ - -extern int lxqstr_(char *string, char *qchar, integer *first, integer *last, integer *nchar, ftnlen string_len, ftnlen qchar_len); - -extern int m2eul_(doublereal *r__, integer *axis3, integer *axis2, integer *axis1, doublereal *angle3, doublereal *angle2, doublereal *angle1); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: mtxm_ 14 3 7 7 7 */ - -extern int m2q_(doublereal *r__, doublereal *q); -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical matchi_(char *string, char *templ, char *wstr, char *wchr, ftnlen string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ -/*:ref: nechr_ 12 4 13 13 124 124 */ -/*:ref: samchi_ 12 6 13 4 13 4 124 124 */ - -extern logical matchw_(char *string, char *templ, char *wstr, char *wchr, ftnlen string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ - -extern int maxac_(char *array, integer *ndim, char *maxval, integer *loc, ftnlen array_len, ftnlen maxval_len); - -extern int maxad_(doublereal *array, integer *ndim, doublereal *maxval, integer *loc); - -extern int maxai_(integer *array, integer *ndim, integer *maxval, integer *loc); - -extern int mequ_(doublereal *m1, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mequg_(doublereal *m1, integer *nr, integer *nc, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int minac_(char *array, integer *ndim, char *minval, integer *loc, ftnlen array_len, ftnlen minval_len); - -extern int minad_(doublereal *array, integer *ndim, doublereal *minval, integer *loc); - -extern int minai_(integer *array, integer *ndim, integer *minval, integer *loc); - -extern int movec_(char *arrfrm, integer *ndim, char *arrto, ftnlen arrfrm_len, ftnlen arrto_len); - -extern int movei_(integer *arrfrm, integer *ndim, integer *arrto); - -extern int mtxm_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mtxmg_(doublereal *m1, doublereal *m2, integer *nc1, integer *nr1r2, integer *nc2, doublereal *mout); - -extern int mtxv_(doublereal *matrix, doublereal *vin, doublereal *vout); - -extern int mtxvg_(doublereal *m1, doublereal *v2, integer *nc1, integer *nr1r2, doublereal *vout); - -extern int mxm_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mxmg_(doublereal *m1, doublereal *m2, integer *row1, integer *col1, integer *col2, doublereal *mout); - -extern int mxmt_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mxmtg_(doublereal *m1, doublereal *m2, integer *nr1, integer *nc1c2, integer *nr2, doublereal *mout); - -extern int mxv_(doublereal *matrix, doublereal *vin, doublereal *vout); - -extern int mxvg_(doublereal *m1, doublereal *v2, integer *nr1, integer *nc1r2, doublereal *vout); - -extern integer nblen_(char *string, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ - -extern integer nbwid_(char *array, integer *nelt, ftnlen array_len); - -extern integer ncpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern integer ncposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern int nearpt_(doublereal *positn, doublereal *a, doublereal *b, doublereal *c__, doublereal *npoint, doublereal *alt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: orderd_ 14 3 7 4 4 */ -/*:ref: reordd_ 14 3 4 4 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: approx_ 12 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int nextwd_(char *string, char *next, char *rest, ftnlen string_len, ftnlen next_len, ftnlen rest_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ - -extern logical notru_(logical *logcls, integer *n); - -extern int nparsd_(char *string, doublereal *x, char *error, integer *ptr, ftnlen string_len, ftnlen error_len); -/*:ref: dpmax_ 7 0 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: pi_ 7 0 */ - -extern int nparsi_(char *string, integer *n, char *error, integer *pnter, ftnlen string_len, ftnlen error_len); -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int npedln_(doublereal *a, doublereal *b, doublereal *c__, doublereal *linept, doublereal *linedr, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: inedpl_ 14 6 7 7 7 7 7 12 */ -/*:ref: pjelpl_ 14 3 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: npelpt_ 14 4 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vprjpi_ 14 5 7 7 7 7 12 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int npelpt_(doublereal *point, doublereal *ellips, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int nplnpt_(doublereal *linpt, doublereal *lindir, doublereal *point, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int nthwd_(char *string, integer *nth, char *word, integer *loc, ftnlen string_len, ftnlen word_len); - -extern int nvc2pl_(doublereal *normal, doublereal *const__, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int nvp2pl_(doublereal *normal, doublereal *point, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern logical odd_(integer *i__); - -extern logical opsgnd_(doublereal *x, doublereal *y); - -extern logical opsgni_(integer *x, integer *y); - -extern integer ordc_(char *item, char *set, ftnlen item_len, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer ordd_(doublereal *item, doublereal *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int orderc_(char *array, integer *ndim, integer *iorder, ftnlen array_len); -/*:ref: swapi_ 14 2 4 4 */ - -extern int orderd_(doublereal *array, integer *ndim, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int orderi_(integer *array, integer *ndim, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern integer ordi_(integer *item, integer *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int oscelt_(doublereal *state, doublereal *et, doublereal *mu, doublereal *elts); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: exact_ 7 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: dacosh_ 7 1 7 */ - -extern int outmsg_(char *list, ftnlen list_len); -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: msgsel_ 12 2 13 124 */ -/*:ref: tkvrsn_ 14 4 13 13 124 124 */ -/*:ref: getsms_ 14 2 13 124 */ -/*:ref: expln_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: wdcnt_ 4 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: trcdep_ 14 1 4 */ -/*:ref: trcnam_ 14 3 4 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int packac_(char *in, integer *pack, integer *npack, integer *maxout, integer *nout, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int packad_(doublereal *in, integer *pack, integer *npack, integer *maxout, integer *nout, doublereal *out); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int packai_(integer *in, integer *pack, integer *npack, integer *maxout, integer *nout, integer *out); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int parsqs_(char *string, char *qchar, char *value, integer *length, logical *error, char *errmsg, integer *ptr, ftnlen string_len, ftnlen qchar_len, ftnlen value_len, ftnlen errmsg_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int partof_(doublereal *ma, doublereal *d__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int pck03a_(integer *handle, integer *ncsets, doublereal *coeffs, doublereal *epochs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ - -extern int pck03b_(integer *handle, char *segid, integer *body, char *frame, doublereal *first, doublereal *last, integer *chbdeg, ftnlen segid_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pckpds_ 14 7 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ - -extern int pck03e_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckbsr_(char *fname, integer *handle, integer *body, doublereal *et, doublereal *descr, char *ident, logical *found, ftnlen fname_len, ftnlen ident_len); -extern int pcklof_(char *fname, integer *handle, ftnlen fname_len); -extern int pckuof_(integer *handle); -extern int pcksfs_(integer *body, doublereal *et, integer *handle, doublereal *descr, char *ident, logical *found, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ - -extern int pckcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pckcov_(char *pck, integer *idcode, doublereal *cover, ftnlen pck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pcke02_(doublereal *et, doublereal *record, doublereal *eulang); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spke02_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pcke03_(doublereal *et, doublereal *record, doublereal *rotmat); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: rpd_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckeul_(integer *body, doublereal *et, logical *found, char *ref, doublereal *eulang, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pcksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: pckr02_ 14 4 4 7 7 7 */ -/*:ref: pcke02_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckfrm_(char *pck, integer *ids, ftnlen pck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pckmat_(integer *body, doublereal *et, integer *ref, doublereal *tsipm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pcksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: pckr02_ 14 4 4 7 7 7 */ -/*:ref: pcke02_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: pckr03_ 14 4 4 7 7 7 */ -/*:ref: pcke03_ 14 3 7 7 7 */ - -extern int pckopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckpds_(integer *body, char *frame, integer *type__, doublereal *first, doublereal *last, doublereal *descr, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ - -extern int pckr02_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckr03_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ - -extern int pckuds_(doublereal *descr, integer *body, integer *frame, integer *type__, doublereal *first, doublereal *last, integer *begin, integer *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckw02_(integer *handle, integer *body, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern integer pcwid_(char *array, integer *nelt, ftnlen array_len); - -extern int pgrrec_(char *body, doublereal *lon, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: georec_ 14 6 7 7 7 7 7 7 */ - -extern doublereal pi_(void); - -extern int pjelpl_(doublereal *elin, doublereal *plane, doublereal *elout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pl2nvc_(doublereal *plane, doublereal *normal, doublereal *const__); -/*:ref: vequ_ 14 2 7 7 */ - -extern int pl2nvp_(doublereal *plane, doublereal *normal, doublereal *point); -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int pl2psv_(doublereal *plane, doublereal *point, doublereal *span1, doublereal *span2); -/*:ref: pl2nvp_ 14 3 7 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ - -extern integer plnsns_(integer *bodid); -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int polyds_(doublereal *coeffs, integer *deg, integer *nderiv, doublereal *t, doublereal *p); - -extern int pool_(char *kernel, integer *unit, char *name__, char *names, integer *nnames, char *agent, integer *n, doublereal *values, logical *found, logical *update, integer *start, integer *room, char *cvals, integer *ivals, char *type__, char *uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen kernel_len, ftnlen name_len, ftnlen names_len, ftnlen agent_len, ftnlen cvals_len, ftnlen type_len, ftnlen uwvars_len, ftnlen uwagnt_len); -extern int clpool_(void); -extern int ldpool_(char *kernel, ftnlen kernel_len); -extern int rtpool_(char *name__, integer *n, doublereal *values, logical *found, ftnlen name_len); -extern int expool_(char *name__, logical *found, ftnlen name_len); -extern int wrpool_(integer *unit); -extern int swpool_(char *agent, integer *nnames, char *names, ftnlen agent_len, ftnlen names_len); -extern int cvpool_(char *agent, logical *update, ftnlen agent_len); -extern int gcpool_(char *name__, integer *start, integer *room, integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen cvals_len); -extern int gdpool_(char *name__, integer *start, integer *room, integer *n, doublereal *values, logical *found, ftnlen name_len); -extern int gipool_(char *name__, integer *start, integer *room, integer *n, integer *ivals, logical *found, ftnlen name_len); -extern int dtpool_(char *name__, logical *found, integer *n, char *type__, ftnlen name_len, ftnlen type_len); -extern int pcpool_(char *name__, integer *n, char *cvals, ftnlen name_len, ftnlen cvals_len); -extern int pdpool_(char *name__, integer *n, doublereal *values, ftnlen name_len); -extern int pipool_(char *name__, integer *n, integer *ivals, ftnlen name_len); -extern int lmpool_(char *cvals, integer *n, ftnlen cvals_len); -extern int szpool_(char *name__, integer *n, logical *found, ftnlen name_len); -extern int dvpool_(char *name__, ftnlen name_len); -extern int gnpool_(char *name__, integer *start, integer *room, integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen cvals_len); -extern int dwpool_(char *agent, ftnlen agent_len); -extern int zzvupool_(char *uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen uwvars_len, ftnlen uwagnt_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzpini_ 14 27 12 4 4 4 13 13 4 4 4 4 4 4 4 13 4 4 13 13 13 13 124 124 124 124 124 124 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: zznwpool_ 14 14 13 13 4 4 13 13 13 13 124 124 124 124 124 124 */ -/*:ref: rdknew_ 14 2 13 124 */ -/*:ref: zzrvar_ 14 13 4 4 13 4 4 7 4 13 13 12 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ -/*:ref: cltext_ 14 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: ioerr_ 14 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzgapool_ 14 10 13 13 4 4 13 13 124 124 124 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lstltc_ 4 5 13 4 13 124 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: removc_ 14 4 13 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzgpnm_ 14 15 4 4 13 4 4 7 4 13 13 12 4 4 124 124 124 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzrvbf_ 14 17 13 4 4 4 4 13 4 4 7 4 13 13 12 124 124 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: copyc_ 14 4 13 13 124 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ - -extern integer pos_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen substr_len); - -extern integer posr_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen substr_len); - -extern int prefix_(char *pref, integer *spaces, char *string, ftnlen pref_len, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: shiftr_ 14 7 13 4 13 13 124 124 124 */ - -extern doublereal prodad_(doublereal *array, integer *n); - -extern integer prodai_(integer *array, integer *n); - -extern int prompt_(char *prmpt, char *string, ftnlen prmpt_len, ftnlen string_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int prop2b_(doublereal *gm, doublereal *pvinit, doublereal *dt, doublereal *pvprop); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: brckti_ 4 3 4 4 4 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: stmp03_ 14 5 7 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vequg_ 14 3 7 4 7 */ - -extern int prsdp_(char *string, doublereal *dpval, ftnlen string_len); -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int prsint_(char *string, integer *intval, ftnlen string_len); -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int prtenc_(integer *number, char *string, ftnlen string_len); -extern int prtdec_(char *string, integer *number, ftnlen string_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical prtpkg_(logical *short__, logical *long__, logical *expl, logical *trace, logical *dfault, char *type__, ftnlen type_len); -extern logical setprt_(logical *short__, logical *expl, logical *long__, logical *trace, logical *dfault); -extern logical msgsel_(char *type__, ftnlen type_len); -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ - -extern int psv2pl_(doublereal *point, doublereal *span1, doublereal *span2, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int putact_(integer *action); -extern int getact_(integer *action); - -extern int putdev_(char *device, ftnlen device_len); -extern int getdev_(char *device, ftnlen device_len); - -extern int putlms_(char *msg, ftnlen msg_len); -extern int getlms_(char *msg, ftnlen msg_len); - -extern int putsms_(char *msg, ftnlen msg_len); -extern int getsms_(char *msg, ftnlen msg_len); - -extern int pxform_(char *from, char *to, doublereal *et, doublereal *rotate, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int q2m_(doublereal *q, doublereal *r__); - -extern int qderiv_(integer *n, doublereal *f0, doublereal *f2, doublereal *delta, doublereal *dfdt); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ - -extern int qdq2av_(doublereal *q, doublereal *dq, doublereal *av); -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: qxq_ 14 3 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int quote_(char *in, char *left, char *right, char *out, ftnlen in_len, ftnlen left_len, ftnlen right_len, ftnlen out_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ - -extern int qxq_(doublereal *q1, doublereal *q2, doublereal *qout); -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int radrec_(doublereal *range, doublereal *ra, doublereal *dec, doublereal *rectan); -/*:ref: latrec_ 14 4 7 7 7 7 */ - -extern int rav2xf_(doublereal *rot, doublereal *av, doublereal *xform); -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int raxisa_(doublereal *matrix, doublereal *axis, doublereal *angle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: m2q_ 14 2 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern int rdencc_(integer *unit, integer *n, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdencd_(integer *unit, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2dp_ 14 6 13 7 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdenci_(integer *unit, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdker_(char *kernel, char *line, integer *number, logical *eof, ftnlen kernel_len, ftnlen line_len); -extern int rdknew_(char *kernel, ftnlen kernel_len); -extern int rdkdat_(char *line, logical *eof, ftnlen line_len); -extern int rdklin_(char *kernel, integer *number, ftnlen kernel_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cltext_ 14 2 13 124 */ -/*:ref: zzsetnnread_ 14 1 12 */ -/*:ref: rdtext_ 14 5 13 13 12 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ - -extern int rdkvar_(char *tabsym, integer *tabptr, doublereal *tabval, char *name__, logical *eof, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: rdkdat_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: replch_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: sydeld_ 14 6 13 13 4 7 124 124 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: syenqd_ 14 7 13 7 13 4 7 124 124 */ - -extern int rdnbl_(char *file, char *line, logical *eof, ftnlen file_len, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rdtext_ 14 5 13 13 12 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rdtext_(char *file, char *line, logical *eof, ftnlen file_len, ftnlen line_len); -extern int cltext_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: getlun_ 14 1 4 */ - -extern int readla_(integer *unit, integer *maxlin, integer *numlin, char *array, logical *eof, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: readln_ 14 4 4 13 12 124 */ -/*:ref: failed_ 12 0 */ - -extern int readln_(integer *unit, char *line, logical *eof, ftnlen line_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int reccyl_(doublereal *rectan, doublereal *r__, doublereal *long__, doublereal *z__); -/*:ref: twopi_ 7 0 */ - -extern int recgeo_(doublereal *rectan, doublereal *re, doublereal *f, doublereal *long__, doublereal *lat, doublereal *alt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ - -extern int reclat_(doublereal *rectan, doublereal *radius, doublereal *long__, doublereal *lat); - -extern int recpgr_(char *body, doublereal *rectan, doublereal *re, doublereal *f, doublereal *lon, doublereal *lat, doublereal *alt, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int recrad_(doublereal *rectan, doublereal *range, doublereal *ra, doublereal *dec); -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ - -extern int recsph_(doublereal *rectan, doublereal *r__, doublereal *colat, doublereal *long__); - -extern int refchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: rotget_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int remlac_(integer *ne, integer *loc, char *array, integer *na, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remlad_(integer *ne, integer *loc, doublereal *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remlai_(integer *ne, integer *loc, integer *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removi_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remsub_(char *in, integer *left, integer *right, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int reordc_(integer *iorder, integer *ndim, char *array, ftnlen array_len); - -extern int reordd_(integer *iorder, integer *ndim, doublereal *array); - -extern int reordi_(integer *iorder, integer *ndim, integer *array); - -extern int reordl_(integer *iorder, integer *ndim, logical *array); - -extern int replch_(char *instr, char *old, char *new__, char *outstr, ftnlen instr_len, ftnlen old_len, ftnlen new_len, ftnlen outstr_len); - -extern int replwd_(char *instr, integer *nth, char *new__, char *outstr, ftnlen instr_len, ftnlen new_len, ftnlen outstr_len); -/*:ref: nthwd_ 14 6 13 4 13 4 124 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int repmc_(char *in, char *marker, char *value, char *out, ftnlen in_len, ftnlen marker_len, ftnlen value_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmct_(char *in, char *marker, integer *value, char *case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: inttxt_ 14 3 4 13 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmd_(char *in, char *marker, doublereal *value, integer *sigdig, char *out, ftnlen in_len, ftnlen marker_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmf_(char *in, char *marker, doublereal *value, integer *sigdig, char *format, char *out, ftnlen in_len, ftnlen marker_len, ftnlen format_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmi_(char *in, char *marker, integer *value, char *out, ftnlen in_len, ftnlen marker_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmot_(char *in, char *marker, integer *value, char *case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: intord_ 14 3 4 13 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repsub_(char *in, integer *left, integer *right, char *string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ - -extern int reset_(void); -/*:ref: seterr_ 12 1 12 */ -/*:ref: putsms_ 14 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ -/*:ref: accept_ 12 1 12 */ - -extern logical return_(void); -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ - -extern int rjust_(char *input, char *output, ftnlen input_len, ftnlen output_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int rmaind_(doublereal *num, doublereal *denom, doublereal *q, doublereal *rem); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rmaini_(integer *num, integer *denom, integer *q, integer *rem); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rmdupc_(integer *nelt, char *array, ftnlen array_len); -/*:ref: shellc_ 14 3 4 13 124 */ - -extern int rmdupd_(integer *nelt, doublereal *array); -/*:ref: shelld_ 14 2 4 7 */ - -extern int rmdupi_(integer *nelt, integer *array); -/*:ref: shelli_ 14 2 4 4 */ - -extern int rotate_(doublereal *angle, integer *iaxis, doublereal *mout); - -extern int rotget_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynrot_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int rotmat_(doublereal *m1, doublereal *angle, integer *iaxis, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int rotvec_(doublereal *v1, doublereal *angle, integer *iaxis, doublereal *vout); - -extern doublereal rpd_(void); - -extern int rquad_(doublereal *a, doublereal *b, doublereal *c__, doublereal *root1, doublereal *root2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern integer rtrim_(char *string, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern int saelgv_(doublereal *vec1, doublereal *vec2, doublereal *smajor, doublereal *sminor); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: diags2_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern logical samch_(char *str1, integer *l1, char *str2, integer *l2, ftnlen str1_len, ftnlen str2_len); - -extern logical samchi_(char *str1, integer *l1, char *str2, integer *l2, ftnlen str1_len, ftnlen str2_len); -/*:ref: eqchr_ 12 4 13 13 124 124 */ - -extern logical sameai_(integer *a1, integer *a2, integer *ndim); - -extern logical samsbi_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, integer *e2, ftnlen str1_len, ftnlen str2_len); -/*:ref: nechr_ 12 4 13 13 124 124 */ - -extern logical samsub_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, integer *e2, ftnlen str1_len, ftnlen str2_len); - -extern int sc01_(integer *sc, char *clkstr, doublereal *ticks, doublereal *sclkdp, doublereal *et, ftnlen clkstr_len); -extern int sctk01_(integer *sc, char *clkstr, doublereal *ticks, ftnlen clkstr_len); -extern int scfm01_(integer *sc, doublereal *ticks, char *clkstr, ftnlen clkstr_len); -extern int scte01_(integer *sc, doublereal *sclkdp, doublereal *et); -extern int scet01_(integer *sc, doublereal *et, doublereal *sclkdp); -extern int scec01_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ - -extern int scanit_(char *string, integer *start, integer *room, integer *nmarks, char *marks, integer *mrklen, integer *pnters, integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen marks_len); -extern int scanpr_(integer *nmarks, char *marks, integer *mrklen, integer *pnters, ftnlen marks_len); -extern int scan_(char *string, char *marks, integer *mrklen, integer *pnters, integer *room, integer *start, integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen marks_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rmdupc_ 14 3 4 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int scanrj_(integer *ids, integer *n, integer *ntokns, integer *ident, integer *beg, integer *end); -/*:ref: isrchi_ 4 3 4 4 4 */ - -extern int scardc_(integer *card, char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: enchar_ 14 3 4 13 124 */ - -extern int scardd_(integer *card, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scardi_(integer *card, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scdecd_(integer *sc, doublereal *sclkdp, char *sclkch, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: scfmt_ 14 4 4 7 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ - -extern int sce2c_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scec01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sce2s_(integer *sc, doublereal *et, char *sclkch, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sce2t_ 14 3 4 7 7 */ -/*:ref: scdecd_ 14 4 4 7 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sce2t_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scet01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scencd_(integer *sc, char *sclkch, doublereal *sclkdp, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: sctiks_ 14 4 4 13 7 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern int scfmt_(integer *sc, doublereal *ticks, char *clkstr, ftnlen clkstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scfm01_ 14 4 4 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sclu01_(char *name__, integer *sc, integer *maxnv, integer *n, integer *ival, doublereal *dval, ftnlen name_len); -extern int scli01_(char *name__, integer *sc, integer *maxnv, integer *n, integer *ival, ftnlen name_len); -extern int scld01_(char *name__, integer *sc, integer *maxnv, integer *n, doublereal *dval, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ - -extern int scpars_(integer *sc, char *sclkch, logical *error, char *msg, doublereal *sclkdp, ftnlen sclkch_len, ftnlen msg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: scps01_ 14 7 4 13 12 13 7 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ - -extern int scpart_(integer *sc, integer *nparts, doublereal *pstart, doublereal *pstop); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int scps01_(integer *sc, char *clkstr, logical *error, char *msg, doublereal *ticks, ftnlen clkstr_len, ftnlen msg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int scs2e_(integer *sc, char *sclkch, doublereal *et, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scencd_ 14 4 4 13 7 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sct2e_(integer *sc, doublereal *sclkdp, doublereal *et); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scte01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sctiks_(integer *sc, char *clkstr, doublereal *ticks, ftnlen clkstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: sctk01_ 14 4 4 13 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sctran_(char *clknam, integer *clkid, logical *found, ftnlen clknam_len); -extern int scn2id_(char *clknam, integer *clkid, logical *found, ftnlen clknam_len); -extern int scid2n_(integer *clkid, char *clknam, logical *found, ftnlen clknam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern integer sctype_(integer *sc); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sdiffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int sdiffd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sdiffi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical setc_(char *a, char *op, char *b, ftnlen a_len, ftnlen op_len, ftnlen b_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical setd_(doublereal *a, char *op, doublereal *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical seterr_(logical *status); -extern logical failed_(void); - -extern logical seti_(integer *a, char *op, integer *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int setmsg_(char *msg, ftnlen msg_len); -/*:ref: allowd_ 12 0 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int sgfcon_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfpkt_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values, integer *ends); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfref_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfrvi_(integer *handle, doublereal *descr, doublereal *x, doublereal *value, integer *indx, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int sgmeta_(integer *handle, doublereal *descr, integer *mnemon, integer *value); -/*:ref: return_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgseqw_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *npkts, integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal *refdat, integer *idxtyp, ftnlen segid_len); -extern int sgbwfs_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *pktsiz, integer *idxtyp, ftnlen segid_len); -extern int sgbwvs_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *idxtyp, ftnlen segid_len); -extern int sgwfpk_(integer *handle, integer *npkts, doublereal *pktdat, integer *nrefs, doublereal *refdat); -extern int sgwvpk_(integer *handle, integer *npkts, integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal *refdat); -extern int sgwes_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafcad_ 14 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafena_ 14 0 */ - -extern int sharpr_(doublereal *rot); -/*:ref: vhatip_ 14 1 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ - -extern int shellc_(integer *ndim, char *array, ftnlen array_len); -/*:ref: swapc_ 14 4 13 13 124 124 */ - -extern int shelld_(integer *ndim, doublereal *array); -/*:ref: swapd_ 14 2 7 7 */ - -extern int shelli_(integer *ndim, integer *array); -/*:ref: swapi_ 14 2 4 4 */ - -extern int shiftc_(char *in, char *dir, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen dir_len, ftnlen fillc_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: shiftl_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: shiftr_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int shiftl_(char *in, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len); - -extern int shiftr_(char *in, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len); - -extern int sigdgt_(char *in, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ - -extern int sigerr_(char *msg, ftnlen msg_len); -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: seterr_ 12 1 12 */ -/*:ref: putsms_ 14 2 13 124 */ -/*:ref: freeze_ 14 0 */ -/*:ref: outmsg_ 14 2 13 124 */ -/*:ref: accept_ 12 1 12 */ -/*:ref: byebye_ 14 2 13 124 */ - -extern int sincpt_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, logical *found, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: npedln_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern integer sizec_(char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sized_(doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sizei_(integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical smsgnd_(doublereal *x, doublereal *y); - -extern logical smsgni_(integer *x, integer *y); - -extern logical somfls_(logical *logcls, integer *n); - -extern logical somtru_(logical *logcls, integer *n); - -extern int spca2b_(char *text, char *binary, ftnlen text_len, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopr_ 14 3 13 4 124 */ -/*:ref: spct2b_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcac_(integer *handle, integer *unit, char *bmark, char *emark, ftnlen bmark_len, ftnlen emark_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: locln_ 14 10 4 13 13 13 4 4 12 124 124 124 */ -/*:ref: countc_ 4 5 4 4 4 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafarr_ 14 2 4 4 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int spcb2a_(char *binary, char *text, ftnlen binary_len, ftnlen text_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopn_ 14 3 13 4 124 */ -/*:ref: spcb2t_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcb2t_(char *binary, integer *unit, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafb2t_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: spcec_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spcdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrrr_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcec_(integer *handle, integer *unit); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int spcopn_(char *spc, char *ifname, integer *handle, ftnlen spc_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcrfl_(integer *handle, char *line, logical *eoc, ftnlen line_len); -extern int spcrnl_(char *line, logical *eoc, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int spct2b_(integer *unit, char *binary, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daft2b_ 14 4 4 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dafopw_ 14 3 13 4 124 */ -/*:ref: spcac_ 14 6 4 4 13 13 124 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern doublereal spd_(void); - -extern int sphcyl_(doublereal *radius, doublereal *colat, doublereal *slong, doublereal *r__, doublereal *long__, doublereal *z__); - -extern int sphlat_(doublereal *r__, doublereal *colat, doublereal *longs, doublereal *radius, doublereal *long__, doublereal *lat); -/*:ref: halfpi_ 7 0 */ - -extern int sphrec_(doublereal *r__, doublereal *colat, doublereal *long__, doublereal *rectan); - -extern doublereal sphsd_(doublereal *radius, doublereal *long1, doublereal *lat1, doublereal *long2, doublereal *lat2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int spk14a_(integer *handle, integer *ncsets, doublereal *coeffs, doublereal *epochs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ - -extern int spk14b_(integer *handle, char *segid, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, integer *chbdeg, ftnlen segid_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ - -extern int spk14e_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkacs_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: spkaps_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int spkapo_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkgps_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int spkapp_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int spkaps_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkltc_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int spkbsr_(char *fname, integer *handle, integer *body, doublereal *et, doublereal *descr, char *ident, logical *found, ftnlen fname_len, ftnlen ident_len); -extern int spklef_(char *fname, integer *handle, ftnlen fname_len); -extern int spkuef_(integer *handle); -extern int spksfs_(integer *body, doublereal *et, integer *handle, doublereal *descr, char *ident, logical *found, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ - -extern int spkcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spkcov_(char *spk, integer *idcode, doublereal *cover, ftnlen spk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spke01_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spke02_(doublereal *et, doublereal *record, doublereal *xyzdot); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbint_ 14 6 7 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke03_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke05_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke08_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: xposeg_ 14 4 7 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lgresp_ 7 6 4 7 7 7 7 7 */ - -extern int spke09_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: xposeg_ 14 4 7 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ - -extern int spke10_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: ev2lin_ 14 4 7 7 7 7 */ -/*:ref: dpspce_ 14 4 7 7 7 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzeprcss_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke12_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: hrmesp_ 14 8 4 7 7 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke13_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke14_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke15_(doublereal *et, doublereal *recin, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dpr_ 7 0 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: pi_ 7 0 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spke17_(doublereal *et, doublereal *recin, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqncpv_ 14 6 7 7 7 7 7 7 */ - -extern int spke18_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: xpsgip_ 14 3 4 4 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int spkez_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkacs_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: spkltc_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int spkezp_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: spkgps_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: spkapo_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int spkezr_(char *targ, doublereal *et, char *ref, char *abcorr, char *obs, doublereal *starg, doublereal *lt, ftnlen targ_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ - -extern int spkgeo_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int spkgps_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int spkltc_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int spkobj_(char *spk, integer *ids, ftnlen spk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spkopa_(char *file, integer *handle, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafopw_ 14 3 13 4 124 */ - -extern int spkopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkpds_(integer *body, integer *center, char *frame, integer *type__, doublereal *first, doublereal *last, doublereal *descr, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ - -extern int spkpos_(char *targ, doublereal *et, char *ref, char *abcorr, char *obs, doublereal *ptarg, doublereal *lt, ftnlen targ_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ - -extern int spkpv_(integer *handle, doublereal *descr, doublereal *et, char *ref, doublereal *state, integer *center, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkpvn_(integer *handle, doublereal *descr, doublereal *et, integer *ref, doublereal *state, integer *center); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: spkr01_ 14 4 4 7 7 7 */ -/*:ref: spke01_ 14 3 7 7 7 */ -/*:ref: spkr02_ 14 4 4 7 7 7 */ -/*:ref: spke02_ 14 3 7 7 7 */ -/*:ref: spkr03_ 14 4 4 7 7 7 */ -/*:ref: spke03_ 14 3 7 7 7 */ -/*:ref: spkr05_ 14 4 4 7 7 7 */ -/*:ref: spke05_ 14 3 7 7 7 */ -/*:ref: spkr08_ 14 4 4 7 7 7 */ -/*:ref: spke08_ 14 3 7 7 7 */ -/*:ref: spkr09_ 14 4 4 7 7 7 */ -/*:ref: spke09_ 14 3 7 7 7 */ -/*:ref: spkr10_ 14 4 4 7 7 7 */ -/*:ref: spke10_ 14 3 7 7 7 */ -/*:ref: spkr12_ 14 4 4 7 7 7 */ -/*:ref: spke12_ 14 3 7 7 7 */ -/*:ref: spkr13_ 14 4 4 7 7 7 */ -/*:ref: spke13_ 14 3 7 7 7 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkr14_ 14 4 4 7 7 7 */ -/*:ref: spke14_ 14 3 7 7 7 */ -/*:ref: spkr15_ 14 4 4 7 7 7 */ -/*:ref: spke15_ 14 3 7 7 7 */ -/*:ref: spkr17_ 14 4 4 7 7 7 */ -/*:ref: spke17_ 14 3 7 7 7 */ -/*:ref: spkr18_ 14 4 4 7 7 7 */ -/*:ref: spke18_ 14 3 7 7 7 */ - -extern int spkr01_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr02_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr03_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr05_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spkr08_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: odd_ 12 1 4 */ - -extern int spkr09_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: odd_ 12 1 4 */ - -extern int spkr10_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr12_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkr08_ 14 4 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr13_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkr09_ 14 4 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr14_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ - -extern int spkr15_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int spkr17_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int spkr18_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ - -extern int spks01_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks02_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks03_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks05_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks08_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks09_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks10_(integer *srchan, doublereal *srcdsc, integer *dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sgfref_ 14 5 4 7 4 4 7 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ -/*:ref: sgwes_ 14 1 4 */ - -extern int spks12_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spks08_ 14 5 4 4 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks13_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spks09_ 14 5 4 4 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks14_(integer *srchan, doublereal *srcdsc, integer *dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: spk14b_ 14 10 4 13 4 4 13 7 7 4 124 124 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sgfref_ 14 5 4 7 4 4 7 */ -/*:ref: spk14a_ 14 4 4 4 7 7 */ -/*:ref: spk14e_ 14 1 4 */ - -extern int spks15_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks17_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks18_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spkssb_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spksub_(integer *handle, doublereal *descr, char *ident, doublereal *begin, doublereal *end, integer *newh, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: spks01_ 14 5 4 4 4 7 7 */ -/*:ref: dafena_ 14 0 */ -/*:ref: spks02_ 14 5 4 4 4 7 7 */ -/*:ref: spks03_ 14 5 4 4 4 7 7 */ -/*:ref: spks05_ 14 5 4 4 4 7 7 */ -/*:ref: spks08_ 14 5 4 4 4 7 7 */ -/*:ref: spks09_ 14 5 4 4 4 7 7 */ -/*:ref: spks10_ 14 6 4 7 4 7 13 124 */ -/*:ref: spks12_ 14 5 4 4 4 7 7 */ -/*:ref: spks13_ 14 5 4 4 4 7 7 */ -/*:ref: spks14_ 14 6 4 7 4 7 13 124 */ -/*:ref: spks15_ 14 5 4 4 4 7 7 */ -/*:ref: spks17_ 14 5 4 4 4 7 7 */ -/*:ref: spks18_ 14 5 4 4 4 7 7 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int spkuds_(doublereal *descr, integer *body, integer *center, integer *frame, integer *type__, doublereal *first, doublereal *last, integer *begin, integer *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkw01_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *n, doublereal *dlines, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw02_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw03_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw05_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *gm, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw08_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epoch1, doublereal *step, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw09_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw10_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *consts, integer *n, doublereal *elems, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: zzwahr_ 14 2 7 7 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ -/*:ref: sgwes_ 14 1 4 */ - -extern int spkw12_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epoch1, doublereal *step, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw13_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw15_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dpr_ 7 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw17_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *decpol, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw18_(integer *handle, integer *subtyp, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *packts, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int srfrec_(integer *body, doublereal *long__, doublereal *lat, doublereal *rectan); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int srfxpt_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal *spoint, doublereal *dist, doublereal *trgepc, doublereal *obspos, logical *found, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: npedln_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ - -extern int ssizec_(integer *size, char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: enchar_ 14 3 4 13 124 */ - -extern int ssized_(integer *size, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ssizei_(integer *size, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stcc01_(char *catfnm, char *tabnam, logical *istyp1, char *errmsg, ftnlen catfnm_len, ftnlen tabnam_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ekopr_ 14 3 13 4 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekssum_ 14 14 4 4 13 4 4 13 13 4 4 12 12 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: ekcls_ 14 1 4 */ - -extern int stcf01_(char *catnam, doublereal *westra, doublereal *eastra, doublereal *sthdec, doublereal *nthdec, integer *nstars, ftnlen catnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpr_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: ekfind_ 14 6 13 4 12 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stcg01_(integer *index, doublereal *ra, doublereal *dec, doublereal *rasig, doublereal *decsig, integer *catnum, char *sptype, doublereal *vmag, ftnlen sptype_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ekgd_ 14 6 4 4 4 7 12 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekgi_ 14 6 4 4 4 4 12 12 */ -/*:ref: ekgc_ 14 7 4 4 4 13 12 12 124 */ -/*:ref: rpd_ 7 0 */ - -extern int stcl01_(char *catfnm, char *tabnam, integer *handle, ftnlen catfnm_len, ftnlen tabnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: stcc01_ 14 7 13 13 12 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ - -extern int stdio_(char *name__, integer *unit, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stelab_(doublereal *pobj, doublereal *vobs, doublereal *appobj); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int stlabx_(doublereal *pobj, doublereal *vobs, doublereal *corpos); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stmp03_(doublereal *x, doublereal *c0, doublereal *c1, doublereal *c2, doublereal *c3); -/*:ref: dpmax_ 7 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stpool_(char *item, integer *nth, char *contin, char *string, integer *size, logical *found, ftnlen item_len, ftnlen contin_len, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int str2et_(char *string, doublereal *et, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: timdef_ 14 6 13 13 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: tchckd_ 14 2 13 124 */ -/*:ref: tparch_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: jul2gr_ 14 4 4 4 4 4 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ -/*:ref: gr2jul_ 14 4 4 4 4 4 */ - -extern int subpnt_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ - -extern int subpt_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int subslr_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ - -extern int subsol_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: ltime_ 14 7 7 4 13 4 7 7 124 */ -/*:ref: spkpos_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ - -extern int suffix_(char *suff, integer *spaces, char *string, ftnlen suff_len, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern doublereal sumad_(doublereal *array, integer *n); - -extern integer sumai_(integer *array, integer *n); - -extern int surfnm_(doublereal *a, doublereal *b, doublereal *c__, doublereal *point, doublereal *normal); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhatip_ 14 1 7 */ - -extern int surfpt_(doublereal *positn, doublereal *u, doublereal *a, doublereal *b, doublereal *c__, doublereal *point, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int surfpv_(doublereal *stvrtx, doublereal *stdir, doublereal *a, doublereal *b, doublereal *c__, doublereal *stx, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int swapac_(integer *n, integer *locn, integer *m, integer *locm, char *array, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapc_ 14 4 13 13 124 124 */ -/*:ref: cyacip_ 14 6 4 13 4 13 124 124 */ - -extern int swapad_(integer *n, integer *locn, integer *m, integer *locm, doublereal *array); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: cyadip_ 14 5 4 13 4 7 124 */ - -extern int swapai_(integer *n, integer *locn, integer *m, integer *locm, integer *array); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: cyaiip_ 14 5 4 13 4 4 124 */ - -extern int swapc_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int swapd_(doublereal *a, doublereal *b); - -extern int swapi_(integer *a, integer *b); - -extern int sxform_(char *from, char *to, doublereal *et, doublereal *xform, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydelc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydeld_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydeli_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupc_(char *name__, char *copy, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupd_(char *name__, char *copy, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupi_(char *name__, char *copy, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetc_ 14 9 13 13 13 4 13 124 124 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetd_ 14 7 13 7 13 4 7 124 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqi_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: syseti_ 14 7 13 4 13 4 4 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfetc_(integer *nth, char *tabsym, integer *tabptr, char *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen tabval_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfetd_(integer *nth, char *tabsym, integer *tabptr, doublereal *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfeti_(integer *nth, char *tabsym, integer *tabptr, integer *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygetc_(char *name__, char *tabsym, integer *tabptr, char *tabval, integer *n, char *values, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygetd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, integer *n, doublereal *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygeti_(char *name__, char *tabsym, integer *tabptr, integer *tabval, integer *n, integer *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthc_(char *name__, integer *nth, char *tabsym, integer *tabptr, char *tabval, char *value, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthd_(char *name__, integer *nth, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthi_(char *name__, integer *nth, char *tabsym, integer *tabptr, integer *tabval, integer *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shellc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shelld_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shelli_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopc_(char *name__, char *tabsym, integer *tabptr, char *tabval, char *value, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, integer *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetc_ 14 9 13 13 13 4 13 124 124 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetd_ 14 7 13 7 13 4 7 124 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshi_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: syseti_ 14 7 13 4 13 4 4 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syputc_(char *name__, char *values, integer *n, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen values_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ - -extern int syputd_(char *name__, doublereal *values, integer *n, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ - -extern int syputi_(char *name__, integer *values, integer *n, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ - -extern int syrenc_(char *old, char *new__, char *tabsym, integer *tabptr, char *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydelc_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syrend_(char *old, char *new__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydeld_ 14 6 13 13 4 7 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapad_ 14 5 4 4 4 4 7 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syreni_(char *old, char *new__, char *tabsym, integer *tabptr, integer *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydeli_ 14 6 13 13 4 4 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syselc_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, char *tabval, char *values, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseld_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseli_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, integer *tabval, integer *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sysetc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sysetd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseti_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrnc_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapc_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrnd_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrni_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int tcheck_(doublereal *tvec, char *type__, logical *mods, char *modify, logical *ok, char *error, ftnlen type_len, ftnlen modify_len, ftnlen error_len); -extern int tparch_(char *type__, ftnlen type_len); -extern int tchckd_(char *type__, ftnlen type_len); -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int texpyr_(integer *year); -extern int tsetyr_(integer *year); - -extern int timdef_(char *action, char *item, char *value, ftnlen action_len, ftnlen item_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ - -extern int timout_(doublereal *et, char *pictur, char *output, ftnlen pictur_len, ftnlen output_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scanpr_ 14 5 4 13 4 4 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: scan_ 14 12 13 13 4 4 4 4 4 4 4 4 124 124 */ -/*:ref: timdef_ 14 6 13 13 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: scanrj_ 14 6 4 4 4 4 4 4 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: j1950_ 7 0 */ -/*:ref: brckti_ 4 3 4 4 4 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: gr2jul_ 14 4 4 4 4 4 */ -/*:ref: jul2gr_ 14 4 4 4 4 4 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int tipbod_(char *ref, integer *body, doublereal *et, doublereal *tipm, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irftrn_ 14 5 13 13 7 124 124 */ -/*:ref: bodmat_ 14 3 4 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int tisbod_(char *ref, integer *body, doublereal *et, doublereal *tsipm, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckmat_ 14 5 4 7 4 7 12 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: ccifrm_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: failed_ 12 0 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int tkfram_(integer *id, doublereal *rot, integer *frame, logical *found); -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: locati_ 14 6 4 4 4 4 4 12 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: dwpool_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: badkpv_ 12 10 13 13 13 4 4 13 124 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: sharpr_ 14 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ - -extern int tkvrsn_(char *item, char *verstr, ftnlen item_len, ftnlen verstr_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int tostdo_(char *line, ftnlen line_len); -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: writln_ 14 3 13 4 124 */ - -extern H_f touchc_(char *ret_val, ftnlen ret_val_len, char *string, ftnlen string_len); - -extern doublereal touchd_(doublereal *dp); - -extern integer touchi_(integer *int__); - -extern logical touchl_(logical *log__); - -extern int tparse_(char *string, doublereal *sp2000, char *error, ftnlen string_len, ftnlen error_len); -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: j2000_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: rmaini_ 14 4 4 4 4 4 */ - -extern int tpartv_(char *string, doublereal *tvec, integer *ntvec, char *type__, char *modify, logical *mods, logical *yabbrv, logical *succes, char *pictur, char *error, ftnlen string_len, ftnlen type_len, ftnlen modify_len, ftnlen pictur_len, ftnlen error_len); -/*:ref: zztpats_ 12 6 4 4 13 13 124 124 */ -/*:ref: zztokns_ 12 4 13 13 124 124 */ -/*:ref: zzcmbt_ 12 5 13 13 12 124 124 */ -/*:ref: zzsubt_ 12 5 13 13 12 124 124 */ -/*:ref: zzrept_ 12 5 13 13 12 124 124 */ -/*:ref: zzremt_ 12 2 13 124 */ -/*:ref: zzist_ 12 2 13 124 */ -/*:ref: zznote_ 12 4 13 4 4 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzunpck_ 12 11 13 12 7 4 13 13 13 124 124 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: zzvalt_ 12 6 13 4 4 13 124 124 */ -/*:ref: zzgrep_ 12 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzispt_ 12 4 13 4 4 124 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ - -extern int tpictr_(char *sample, char *pictur, logical *ok, char *error, ftnlen sample_len, ftnlen pictur_len, ftnlen error_len); -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ - -extern doublereal trace_(doublereal *matrix); - -extern doublereal traceg_(doublereal *matrix, integer *ndim); - -extern int trcpkg_(integer *depth, integer *index, char *module, char *trace, char *name__, ftnlen module_len, ftnlen trace_len, ftnlen name_len); -extern int chkin_(char *module, ftnlen module_len); -extern int chkout_(char *module, ftnlen module_len); -extern int trcdep_(integer *depth); -extern int trcmxd_(integer *depth); -extern int trcnam_(integer *index, char *name__, ftnlen name_len); -extern int qcktrc_(char *trace, ftnlen trace_len); -extern int freeze_(void); -extern int trcoff_(void); -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int ttrans_(char *from, char *to, doublereal *tvec, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ -/*:ref: reordi_ 14 3 4 4 4 */ -/*:ref: reordl_ 14 3 4 4 12 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rmaini_ 14 4 4 4 4 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: lstlti_ 4 3 4 4 4 */ - -extern doublereal twopi_(void); - -extern int twovec_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *mout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int twovxf_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int txtopn_(char *fname, integer *unit, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int txtopr_(char *fname, integer *unit, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern doublereal tyear_(void); - -extern int ucase_(char *in, char *out, ftnlen in_len, ftnlen out_len); - -extern int ucrss_(doublereal *v1, doublereal *v2, doublereal *vout); -/*:ref: vnorm_ 7 1 7 */ - -extern int uddc_(U_fp udfunc, doublereal *x, doublereal *dx, logical *isdecr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: uddf_ 14 4 200 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int uddf_(S_fp udfunc, doublereal *x, doublereal *dx, doublereal *deriv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ - -extern int unionc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int uniond_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int unioni_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal unitim_(doublereal *epoch, char *insys, char *outsys, ftnlen insys_len, ftnlen outsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: unionc_ 14 6 13 13 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: somfls_ 12 2 12 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: setc_ 12 6 13 13 13 124 124 124 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ - -extern int unorm_(doublereal *v1, doublereal *vout, doublereal *vmag); -/*:ref: vnorm_ 7 1 7 */ - -extern int unormg_(doublereal *v1, integer *ndim, doublereal *vout, doublereal *vmag); -/*:ref: vnormg_ 7 2 7 4 */ - -extern int utc2et_(char *utcstr, doublereal *et, ftnlen utcstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int vadd_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern int vaddg_(doublereal *v1, doublereal *v2, integer *ndim, doublereal *vout); - -extern int validc_(integer *size, integer *n, char *a, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupc_ 14 3 4 13 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ - -extern int validd_(integer *size, integer *n, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ - -extern int validi_(integer *size, integer *n, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupi_ 14 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ - -extern int vcrss_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern doublereal vdist_(doublereal *v1, doublereal *v2); -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern doublereal vdistg_(doublereal *v1, doublereal *v2, integer *ndim); - -extern doublereal vdot_(doublereal *v1, doublereal *v2); - -extern doublereal vdotg_(doublereal *v1, doublereal *v2, integer *ndim); - -extern int vequ_(doublereal *vin, doublereal *vout); - -extern int vequg_(doublereal *vin, integer *ndim, doublereal *vout); - -extern int vhat_(doublereal *v1, doublereal *vout); -/*:ref: vnorm_ 7 1 7 */ - -extern int vhatg_(doublereal *v1, integer *ndim, doublereal *vout); -/*:ref: vnormg_ 7 2 7 4 */ - -extern int vhatip_(doublereal *v); -/*:ref: vnorm_ 7 1 7 */ - -extern int vlcom_(doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *sum); - -extern int vlcom3_(doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *c__, doublereal *v3, doublereal *sum); - -extern int vlcomg_(integer *n, doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *sum); - -extern int vminug_(doublereal *vin, integer *ndim, doublereal *vout); - -extern int vminus_(doublereal *v1, doublereal *vout); - -extern doublereal vnorm_(doublereal *v1); - -extern doublereal vnormg_(doublereal *v1, integer *ndim); - -extern int vpack_(doublereal *x, doublereal *y, doublereal *z__, doublereal *v); - -extern int vperp_(doublereal *a, doublereal *b, doublereal *p); -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int vprjp_(doublereal *vin, doublereal *plane, doublereal *vout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int vprjpi_(doublereal *vin, doublereal *projpl, doublereal *invpl, doublereal *vout, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int vproj_(doublereal *a, doublereal *b, doublereal *p); -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int vprojg_(doublereal *a, doublereal *b, integer *ndim, doublereal *p); -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ - -extern doublereal vrel_(doublereal *v1, doublereal *v2); -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern doublereal vrelg_(doublereal *v1, doublereal *v2, integer *ndim); -/*:ref: vdistg_ 7 3 7 7 4 */ -/*:ref: vnormg_ 7 2 7 4 */ - -extern int vrotv_(doublereal *v, doublereal *axis, doublereal *theta, doublereal *r__); -/*:ref: vnorm_ 7 1 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int vscl_(doublereal *s, doublereal *v1, doublereal *vout); - -extern int vsclg_(doublereal *s, doublereal *v1, integer *ndim, doublereal *vout); - -extern int vsclip_(doublereal *s, doublereal *v); - -extern doublereal vsep_(doublereal *v1, doublereal *v2); -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: pi_ 7 0 */ - -extern doublereal vsepg_(doublereal *v1, doublereal *v2, integer *ndim); -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: pi_ 7 0 */ - -extern int vsub_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern int vsubg_(doublereal *v1, doublereal *v2, integer *ndim, doublereal *vout); - -extern doublereal vtmv_(doublereal *v1, doublereal *matrix, doublereal *v2); - -extern doublereal vtmvg_(doublereal *v1, doublereal *matrix, doublereal *v2, integer *nrow, integer *ncol); - -extern int vupack_(doublereal *v, doublereal *x, doublereal *y, doublereal *z__); - -extern logical vzero_(doublereal *v); - -extern logical vzerog_(doublereal *v, integer *ndim); - -extern integer wdcnt_(char *string, ftnlen string_len); - -extern integer wdindx_(char *string, char *word, ftnlen string_len, ftnlen word_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ - -extern integer wncard_(doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wncomd_(doublereal *left, doublereal *right, doublereal *window, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: failed_ 12 0 */ - -extern int wncond_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wndifd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical wnelmd_(doublereal *point, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnexpd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnextd_(char *side, doublereal *window, ftnlen side_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfetd_(doublereal *window, integer *n, doublereal *left, doublereal *right); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfild_(doublereal *small, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfltd_(doublereal *small, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical wnincd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wninsd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int wnintd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical wnreld_(doublereal *a, char *op, doublereal *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: wnincd_ 12 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnsumd_(doublereal *window, doublereal *meas, doublereal *avg, doublereal *stddev, integer *short__, integer *long__); -/*:ref: return_ 12 0 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: even_ 12 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnunid_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnvald_(integer *size, integer *n, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int wrencc_(integer *unit, integer *n, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrencd_(integer *unit, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dp2hx_ 14 4 7 13 4 124 */ - -extern int wrenci_(integer *unit, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: int2hx_ 14 4 4 13 4 124 */ - -extern int writla_(integer *numlin, char *array, integer *unit, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: writln_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ - -extern int writln_(char *line, integer *unit, ftnlen line_len); -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrkvar_(integer *unit, char *name__, char *dirctv, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen dirctv_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sydimd_ 4 6 13 13 4 7 124 124 */ -/*:ref: synthd_ 14 9 13 4 13 4 7 7 12 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rjust_ 14 4 13 13 124 124 */ -/*:ref: ioerr_ 14 5 13 13 4 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrline_(char *device, char *line, ftnlen device_len, ftnlen line_len); -extern int clline_(char *device, ftnlen device_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: fndlun_ 14 1 4 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int xf2eul_(doublereal *xform, integer *axisa, integer *axisb, integer *axisc, doublereal *eulang, logical *unique); -extern int eul2xf_(doublereal *eulang, integer *axisa, integer *axisb, integer *axisc, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: m2eul_ 14 7 7 4 4 4 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int xf2rav_(doublereal *xform, doublereal *rot, doublereal *av); -/*:ref: mtxm_ 14 3 7 7 7 */ - -extern int xposbl_(doublereal *bmat, integer *nrow, integer *ncol, integer *bsize, doublereal *btmat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int xpose_(doublereal *m1, doublereal *mout); - -extern int xposeg_(doublereal *matrix, integer *nrow, integer *ncol, doublereal *xposem); - -extern int xpsgip_(integer *nrow, integer *ncol, doublereal *matrix); - -extern int zzascii_(char *file, char *line, logical *check, char *termin, ftnlen file_len, ftnlen line_len, ftnlen termin_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzasryel_(char *extrem, doublereal *ellips, doublereal *vertex, doublereal *dir, doublereal *angle, doublereal *extpt, ftnlen extrem_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int zzbodblt_(integer *room, char *names, char *nornam, integer *codes, integer *nvals, char *device, char *reqst, ftnlen names_len, ftnlen nornam_len, ftnlen device_len, ftnlen reqst_len); -extern int zzbodget_(integer *room, char *names, char *nornam, integer *codes, integer *nvals, ftnlen names_len, ftnlen nornam_len); -extern int zzbodlst_(char *device, char *reqst, ftnlen device_len, ftnlen reqst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzidmap_ 14 3 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ - -extern integer zzbodbry_(integer *body); - -extern int zzbodini_(char *names, char *nornam, integer *codes, integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, ftnlen names_len, ftnlen nornam_len); -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ - -extern int zzbodker_(char *names, char *nornam, integer *codes, integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, logical *extker, ftnlen names_len, ftnlen nornam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: zzbodini_ 14 9 13 13 4 4 4 4 4 124 124 */ - -extern int zzbodtrn_(char *name__, integer *code, logical *found, ftnlen name_len); -extern int zzbodn2c_(char *name__, integer *code, logical *found, ftnlen name_len); -extern int zzbodc2n_(integer *code, char *name__, logical *found, ftnlen name_len); -extern int zzboddef_(char *name__, integer *code, ftnlen name_len); -extern int zzbodkik_(void); -extern int zzbodrst_(void); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodget_ 14 7 4 13 13 4 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzbodini_ 14 9 13 13 4 4 4 4 4 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: zzbodker_ 14 10 13 13 4 4 4 4 4 12 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: bschoc_ 4 6 13 4 13 4 124 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzbodvcd_(integer *bodyid, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzck4d2i_(doublereal *dpcoef, integer *nsets, doublereal *parcod, integer *i__); - -extern int zzck4i2d_(integer *i__, integer *nsets, doublereal *parcod, doublereal *dpcoef); - -extern int zzckcv01_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv02_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv03_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv04_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv05_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *dc, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errint_ 14 3 13 7 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckspk_(integer *handle, char *ckspk, ftnlen ckspk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: zzsizeok_ 14 6 4 4 4 4 12 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int zzcln_(integer *lookat, integer *nameat, integer *namlst, integer *datlst, integer *nmpool, integer *chpool, integer *dppool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzcorepc_(char *abcorr, doublereal *et, doublereal *lt, doublereal *etcorr, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzcorsxf_(logical *xmit, doublereal *dlt, doublereal *xform, doublereal *corxfm); -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int zzcputim_(doublereal *tvec); -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzdafgdr_(integer *handle, integer *recno, doublereal *dprec, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlated_ 14 5 4 13 4 7 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzdafgfr_(integer *handle, char *idword, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, logical *found, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlatei_ 14 5 4 13 4 4 124 */ - -extern int zzdafgsr_(integer *handle, integer *recno, integer *nd, integer *ni, doublereal *dprec, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlated_ 14 5 4 13 4 7 124 */ -/*:ref: zzxlatei_ 14 5 4 13 4 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzdafnfr_(integer *lun, char *idword, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzdasnfr_(integer *lun, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzddhclu_(logical *utlck, integer *nut); - -extern int zzddhf2h_(char *fname, integer *ftabs, integer *ftamh, integer *ftarc, integer *ftbff, integer *fthan, char *ftnam, integer *ftrtm, integer *nft, integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut, logical *exists, logical *opened, integer *handle, logical *found, ftnlen fname_len, ftnlen ftnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzddhgtu_ 14 6 4 4 12 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzddhrmu_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzddhgsd_(char *class__, integer *id, char *label, ftnlen class_len, ftnlen label_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzddhgtu_(integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut, integer *uindex); -/*:ref: return_ 12 0 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: frelun_ 14 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzddhini_(integer *natbff, integer *supbff, integer *numsup, char *stramh, char *strarc, char *strbff, ftnlen stramh_len, ftnlen strarc_len, ftnlen strbff_len); -/*:ref: return_ 12 0 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ - -extern int zzddhivf_(char *nsum, integer *bff, logical *found, ftnlen nsum_len); - -extern int zzddhman_(logical *lock, char *arch, char *fname, char *method, integer *handle, integer *unit, integer *intamh, integer *intarc, integer *intbff, logical *native, logical *found, logical *kill, ftnlen arch_len, ftnlen fname_len, ftnlen method_len); -extern int zzddhopn_(char *fname, char *method, char *arch, integer *handle, ftnlen fname_len, ftnlen method_len, ftnlen arch_len); -extern int zzddhcls_(integer *handle, char *arch, logical *kill, ftnlen arch_len); -extern int zzddhhlu_(integer *handle, char *arch, logical *lock, integer *unit, ftnlen arch_len); -extern int zzddhunl_(integer *handle, char *arch, ftnlen arch_len); -extern int zzddhnfo_(integer *handle, char *fname, integer *intarc, integer *intbff, integer *intamh, logical *found, ftnlen fname_len); -extern int zzddhisn_(integer *handle, logical *native, logical *found); -extern int zzddhfnh_(char *fname, integer *handle, logical *found, ftnlen fname_len); -extern int zzddhluh_(integer *unit, integer *handle, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhini_ 14 9 4 4 4 13 13 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzpltchk_ 14 1 12 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzddhclu_ 4 2 12 4 */ -/*:ref: zzddhf2h_ 14 20 13 4 4 4 4 4 13 4 4 4 4 12 4 4 12 12 4 12 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: zzddhrcm_ 14 3 4 4 4 */ -/*:ref: zzddhgtu_ 14 6 4 4 12 4 4 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: zzddhppf_ 14 3 4 4 4 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzddhrmu_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: frelun_ 14 1 4 */ - -extern int zzddhppf_(integer *unit, integer *arch, integer *bff); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzftpchk_ 14 3 13 12 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzddhivf_ 14 4 13 4 12 124 */ - -extern int zzddhrcm_(integer *nut, integer *utcst, integer *reqcnt); -/*:ref: intmax_ 4 0 */ - -extern int zzddhrmu_(integer *uindex, integer *nft, integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: reslun_ 14 1 4 */ - -extern int zzdynbid_(char *frname, integer *frcode, char *item, integer *idcode, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzdynfid_(char *frname, integer *frcode, char *item, integer *idcode, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: prsint_ 14 3 13 4 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzdynfr0_(integer *infram, integer *center, doublereal *et, doublereal *xform, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxmg_ 14 6 7 7 4 4 4 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkez1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkzp1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynfrm_(integer *infram, integer *center, doublereal *et, doublereal *xform, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxmg_ 14 6 7 7 4 4 4 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkez0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkzp0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynoac_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, char *values, logical *found, ftnlen frname_len, ftnlen item_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ - -extern int zzdynoad_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, doublereal *values, logical *found, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzdynrot_(integer *infram, integer *center, doublereal *et, doublereal *rotate, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkzp0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzspkez0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynrt0_(integer *infram, integer *center, doublereal *et, doublereal *rotate, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkzp1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzspkez1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynvac_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, char *values, ftnlen frname_len, ftnlen item_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ - -extern int zzdynvad_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, doublereal *values, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzdynvai_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, integer *values, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzedterm_(char *type__, doublereal *a, doublereal *b, doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer *npts, doublereal *trmpts, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ - -extern int zzekac01_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, logical *nlflgs, integer *rcptrs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekordi_ 14 5 4 12 12 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac02_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, logical *nlflgs, integer *rcptrs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: zzekordd_ 14 5 7 12 12 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac03_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekordc_ 14 6 13 12 12 4 4 124 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac04_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, integer *entszs, logical *nlflgs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac05_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, integer *entszs, logical *nlflgs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac06_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, integer *entszs, logical *nlflgs, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac07_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, logical *nlflgs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordi_ 14 5 4 12 12 4 4 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekac08_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, logical *nlflgs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordd_ 14 5 7 12 12 4 4 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekac09_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, logical *nlflgs, integer *wkindx, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordc_ 14 6 13 12 12 4 4 124 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekacps_(integer *handle, integer *segdsc, integer *type__, integer *n, integer *p, integer *base); -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekad01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzekiii1_ 14 6 4 4 4 4 4 12 */ - -extern int zzekad02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzekiid1_ 14 6 4 4 4 7 4 12 */ - -extern int zzekad03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekiic1_ 14 7 4 4 4 13 4 12 124 */ - -extern int zzekad04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, integer *ivals, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekad05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekad06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, ftnlen cvals_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekaps_(integer *handle, integer *segdsc, integer *type__, logical *new__, integer *p, integer *base); -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekbs01_(integer *handle, char *tabnam, integer *ncols, char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekcix1_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekbs02_(integer *handle, char *tabnam, integer *ncols, char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekcchk_(char *query, integer *eqryi, char *eqryc, integer *ntab, char *tablst, char *alslst, integer *base, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen tablst_len, ftnlen alslst_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzekcdsc_(integer *handle, integer *segdsc, char *column, integer *coldsc, ftnlen column_len); -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekcix1_(integer *handle, integer *coldsc); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrit_ 14 2 4 4 */ - -extern int zzekcnam_(integer *handle, integer *coldsc, char *column, ftnlen column_len); -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekde01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekdps_(integer *handle, integer *segdsc, integer *type__, integer *p); -/*:ref: zzekpgfr_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzektrls_ 4 3 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ - -extern integer zzekecmp_(integer *hans, integer *sgdscs, integer *cldscs, integer *rows, integer *elts); -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ - -extern int zzekencd_(char *query, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpars_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: zzeknres_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: zzektres_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: zzeksemc_ 14 9 13 4 13 12 13 4 124 124 124 */ - -extern int zzekerc1_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, integer *prvptr, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekerd1_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekeri1_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern integer zzekesiz_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: zzeksz04_ 4 4 4 4 4 4 */ -/*:ref: zzeksz05_ 4 4 4 4 4 4 */ -/*:ref: zzeksz06_ 4 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekff01_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekfrx_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *pos); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: zzeklerc_ 14 9 4 4 4 13 4 12 4 4 124 */ -/*:ref: zzeklerd_ 14 8 4 4 4 7 4 12 4 4 */ -/*:ref: zzekleri_ 14 8 4 4 4 4 4 12 4 4 */ - -extern int zzekgcdp_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *datptr); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgei_(integer *handle, integer *addrss, integer *ival); -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ - -extern int zzekgfwd_(integer *handle, integer *type__, integer *p, integer *fward); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekglnk_(integer *handle, integer *type__, integer *p, integer *nlinks); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgrcp_(integer *handle, integer *recptr, integer *ptr); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgrs_(integer *handle, integer *recptr, integer *status); -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekif01_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksdec_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekif02_(integer *handle, integer *segno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekiic1_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzeklerc_ 14 9 4 4 4 13 4 12 4 4 124 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzekiid1_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzeklerd_ 14 8 4 4 4 7 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzekiii1_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekleri_ 14 8 4 4 4 4 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern integer zzekille_(integer *handle, integer *segdsc, integer *coldsc, integer *nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekllec_ 14 7 4 4 4 13 4 4 124 */ -/*:ref: zzeklled_ 14 6 4 4 4 7 4 4 */ -/*:ref: zzekllei_ 14 6 4 4 4 4 4 4 */ - -extern integer zzekillt_(integer *handle, integer *segdsc, integer *coldsc, integer *nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeklltc_ 14 7 4 4 4 13 4 4 124 */ -/*:ref: zzeklltd_ 14 6 4 4 4 7 4 4 */ -/*:ref: zzekllti_ 14 6 4 4 4 4 4 4 */ - -extern int zzekinqc_(char *value, integer *length, integer *lexbeg, integer *lexend, integer *eqryi, char *eqryc, integer *descr, ftnlen value_len, ftnlen eqryc_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekinqn_(doublereal *value, integer *type__, integer *lexbeg, integer *lexend, integer *eqryi, doublereal *eqryd, integer *descr); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekixdl_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekfrx_ 14 5 4 4 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekixlk_(integer *handle, integer *coldsc, integer *key, integer *recptr); -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekjoin_(integer *jbase1, integer *jbase2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *jbase3, integer *nrows); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjprp_ 14 23 4 4 4 4 4 4 4 4 4 4 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekjnxt_ 14 2 12 4 */ - -extern int zzekjsqz_(integer *jrsbas); -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ - -extern int zzekjsrt_(integer *njrs, integer *ubases, integer *norder, integer *otabs, integer *ocols, integer *oelts, integer *senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *ordbas); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzekvcal_ 14 3 4 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: zzekvcmp_ 12 15 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ - -extern int zzekjtst_(integer *segvec, integer *jbase1, integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, logical *found, integer *rowvec); -extern int zzekjprp_(integer *segvec, integer *jbase1, integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs); -extern int zzekjnxt_(logical *found, integer *rowvec); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjsrt_ 14 13 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekrcmp_ 12 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekvmch_ 12 13 4 12 4 4 4 4 4 4 4 4 4 4 4 */ - -extern int zzekkey_(integer *handle, integer *segdsc, integer *nrows, integer *ncnstr, integer *clidxs, integer *dsclst, integer *ops, integer *dtypes, char *chrbuf, integer *cbegs, integer *cends, doublereal *dvals, integer *ivals, logical *active, integer *key, integer *keydsc, integer *begidx, integer *endidx, logical *found, ftnlen chrbuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: zzekillt_ 4 9 4 4 4 4 4 13 7 4 124 */ -/*:ref: zzekille_ 4 9 4 4 4 4 4 13 7 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ordi_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ - -extern int zzeklerc_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, integer *prvptr, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekerc1_ 14 9 4 4 4 13 4 12 4 4 124 */ - -extern int zzeklerd_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekerd1_ 14 8 4 4 4 7 4 12 4 4 */ - -extern int zzekleri_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekeri1_ 14 8 4 4 4 4 4 12 4 4 */ - -extern int zzekllec_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklled_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekllei_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklltc_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklltd_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekllti_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekmloc_(integer *handle, integer *segno, integer *page, integer *base); -/*:ref: eknseg_ 4 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ - -extern int zzeknres_(char *query, integer *eqryi, char *eqryc, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: ekntab_ 14 1 4 */ -/*:ref: ektnam_ 14 3 4 13 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: zzekcchk_ 14 15 13 4 13 4 13 13 4 12 13 4 124 124 124 124 124 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzeknrml_(char *query, integer *ntoken, integer *lxbegs, integer *lxends, integer *tokens, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektloc_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: zzekinqn_ 14 7 7 4 4 4 4 7 4 */ -/*:ref: zzekinqc_ 14 9 13 4 4 4 4 13 4 124 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: lnkhl_ 4 2 4 4 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekordc_(char *cvals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder, ftnlen cvals_len); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekordd_(doublereal *dvals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekordi_(integer *ivals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekpage_(integer *handle, integer *type__, integer *addrss, char *stat, integer *p, char *pagec, doublereal *paged, integer *pagei, integer *base, integer *value, ftnlen stat_len, ftnlen pagec_len); -extern int zzekpgin_(integer *handle); -extern int zzekpgan_(integer *handle, integer *type__, integer *p, integer *base); -extern int zzekpgal_(integer *handle, integer *type__, integer *p, integer *base); -extern int zzekpgfr_(integer *handle, integer *type__, integer *p); -extern int zzekpgrc_(integer *handle, integer *p, char *pagec, ftnlen pagec_len); -extern int zzekpgrd_(integer *handle, integer *p, doublereal *paged); -extern int zzekpgri_(integer *handle, integer *p, integer *pagei); -extern int zzekpgwc_(integer *handle, integer *p, char *pagec, ftnlen pagec_len); -extern int zzekpgwd_(integer *handle, integer *p, doublereal *paged); -extern int zzekpgwi_(integer *handle, integer *p, integer *pagei); -extern int zzekpgbs_(integer *type__, integer *p, integer *base); -extern int zzekpgpg_(integer *type__, integer *addrss, integer *p, integer *base); -extern int zzekpgst_(integer *handle, char *stat, integer *value, ftnlen stat_len); -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: fillc_ 14 5 13 4 13 124 124 */ -/*:ref: filld_ 14 3 7 4 7 */ -/*:ref: filli_ 14 3 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: dasadc_ 14 6 4 4 4 4 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasadd_ 14 3 4 4 7 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzekpars_(char *query, integer *ntoken, integer *lxbegs, integer *lxends, integer *tokens, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektloc_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: zzekinqc_ 14 9 13 4 4 4 4 13 4 124 124 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: zzeknrml_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ - -extern int zzekpcol_(char *qcol, integer *eqryi, char *eqryc, char *table, char *alias, integer *tabidx, char *column, integer *colidx, logical *error, char *errmsg, ftnlen qcol_len, ftnlen eqryc_len, ftnlen table_len, ftnlen alias_len, ftnlen column_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ - -extern int zzekpdec_(char *decl, integer *pardsc, ftnlen decl_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern int zzekpgch_(integer *handle, char *access, ftnlen access_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ - -extern int zzekqcnj_(integer *eqryi, integer *n, integer *size); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqcon_(integer *eqryi, char *eqryc, doublereal *eqryd, integer *n, integer *cnstyp, char *ltname, integer *ltidx, char *lcname, integer *lcidx, integer *opcode, char *rtname, integer *rtidx, char *rcname, integer *rcidx, integer *dtype, integer *cbeg, integer *cend, doublereal *dval, integer *ival, ftnlen eqryc_len, ftnlen ltname_len, ftnlen lcname_len, ftnlen rtname_len, ftnlen rcname_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqini_(integer *isize, integer *dsize, integer *eqryi, char *eqryc, doublereal *eqryd, ftnlen eqryc_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ - -extern int zzekqord_(integer *eqryi, char *eqryc, integer *n, char *table, integer *tabidx, char *column, integer *colidx, integer *sense, ftnlen eqryc_len, ftnlen table_len, ftnlen column_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqsel_(integer *eqryi, char *eqryc, integer *n, integer *lxbeg, integer *lxend, char *table, integer *tabidx, char *column, integer *colidx, ftnlen eqryc_len, ftnlen table_len, ftnlen column_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqtab_(integer *eqryi, char *eqryc, integer *n, char *table, char *alias, ftnlen eqryc_len, ftnlen table_len, ftnlen alias_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekrbck_(char *action, integer *handle, integer *segdsc, integer *coldsc, integer *recno, ftnlen action_len); - -extern logical zzekrcmp_(integer *op, integer *ncols, integer *han1, integer *sgdsc1, integer *cdlst1, integer *row1, integer *elts1, integer *han2, integer *sgdsc2, integer *cdlst2, integer *row2, integer *elts2); -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrd01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekrd02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzekrd04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, integer *ivals, logical *isnull, logical *found); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, doublereal *dvals, logical *isnull, logical *found); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, char *cvals, logical *isnull, logical *found, ftnlen cvals_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekrd07_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekrd08_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ - -extern int zzekrd09_(integer *handle, integer *segdsc, integer *coldsc, integer *recno, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekreqi_(integer *eqryi, char *name__, integer *value, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical zzekrmch_(integer *ncnstr, logical *active, integer *handle, integer *segdsc, integer *cdscrs, integer *row, integer *elts, integer *ops, integer *vtypes, char *chrbuf, integer *cbegs, integer *cends, doublereal *dvals, integer *ivals, ftnlen chrbuf_len); -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern integer zzekrp2n_(integer *handle, integer *segno, integer *recptr); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrls_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrplk_(integer *handle, integer *segdsc, integer *n, integer *recptr); -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrsc_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, integer *cvlen, char *cval, logical *isnull, logical *found, ftnlen cval_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd03_ 14 8 4 4 4 4 4 13 12 124 */ -/*:ref: zzekrd06_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrd09_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int zzekrsd_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, doublereal *dval, logical *isnull, logical *found); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekrd05_ 14 9 4 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrd08_ 14 6 4 4 4 4 7 12 */ - -extern int zzekrsi_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, integer *ival, logical *isnull, logical *found); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekrd04_ 14 9 4 4 4 4 4 4 4 12 12 */ -/*:ref: zzekrd07_ 14 6 4 4 4 4 4 12 */ - -extern int zzeksca_(integer *n, integer *beg, integer *end, integer *idata, integer *top); -extern int zzekstop_(integer *top); -extern int zzekspsh_(integer *n, integer *idata); -extern int zzekspop_(integer *n, integer *idata); -extern int zzeksdec_(integer *n); -extern int zzeksupd_(integer *beg, integer *end, integer *idata); -extern int zzeksrd_(integer *beg, integer *end, integer *idata); -extern int zzekscln_(void); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int zzekscan_(char *query, integer *maxntk, integer *maxnum, integer *ntoken, integer *tokens, integer *lxbegs, integer *lxends, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, logical *scnerr, char *errmsg, ftnlen query_len, ftnlen chrbuf_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: lxcsid_ 14 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lxqstr_ 14 7 13 13 4 4 4 124 124 */ -/*:ref: parsqs_ 14 11 13 13 13 4 12 13 4 124 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: lx4num_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: lxidnt_ 14 6 4 13 4 4 4 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: frstpc_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int zzekscdp_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *datptr); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern logical zzekscmp_(integer *op, integer *handle, integer *segdsc, integer *coldsc, integer *row, integer *eltidx, integer *dtype, char *cval, doublereal *dval, integer *ival, logical *null, ftnlen cval_len); -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ - -extern int zzeksdsc_(integer *handle, integer *segno, integer *segdsc); -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzeksei_(integer *handle, integer *addrss, integer *ival); -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzeksemc_(char *query, integer *eqryi, char *eqryc, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzeksfwd_(integer *handle, integer *type__, integer *p, integer *fward); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksinf_(integer *handle, integer *segno, char *tabnam, integer *segdsc, char *cnames, integer *cdscrs, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekslnk_(integer *handle, integer *type__, integer *p, integer *nlinks); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksrcp_(integer *handle, integer *recptr, integer *recno); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksrs_(integer *handle, integer *recptr, integer *status); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern integer zzekstyp_(integer *ncols, integer *cdscrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzeksz04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern integer zzeksz05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ - -extern integer zzeksz06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ - -extern int zzektcnv_(char *timstr, doublereal *et, logical *error, char *errmsg, ftnlen timstr_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: scn2id_ 14 4 13 4 12 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scpars_ 14 7 4 13 12 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: str2et_ 14 3 13 7 124 */ - -extern int zzektloc_(integer *tokid, integer *kwcode, integer *ntoken, integer *tokens, integer *values, integer *loc, logical *found); - -extern int zzektr13_(integer *handle, integer *tree); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektr1s_(integer *handle, integer *tree, integer *size, integer *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzektr23_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx, logical *overfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektr31_(integer *handle, integer *tree); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektr32_(integer *handle, integer *tree, integer *left, integer *middle, integer *right, integer *parent, integer *lpkidx, logical *undrfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektrap_(integer *handle, integer *tree, integer *value, integer *key); -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzektrbn_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzektrrk_ 14 7 4 4 4 4 4 4 4 */ - -extern integer zzektrbs_(integer *node); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ - -extern int zzektrdl_(integer *handle, integer *tree, integer *key); -/*:ref: zzektrud_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrsb_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrrk_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: zzektrbn_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzektrki_ 14 5 4 4 4 4 4 */ -/*:ref: zzektr32_ 14 8 4 4 4 4 4 4 4 12 */ -/*:ref: zzektr31_ 14 2 4 4 */ - -extern int zzektrdp_(integer *handle, integer *tree, integer *key, integer *ptr); -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ - -extern int zzektres_(char *query, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzektcnv_ 14 6 13 7 12 13 124 124 */ -/*:ref: zzekinqn_ 14 7 7 4 4 4 4 7 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzektrfr_(integer *handle, integer *tree); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektrin_(integer *handle, integer *tree, integer *key, integer *value); -/*:ref: zzektrui_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: zzektrbn_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzektrki_ 14 5 4 4 4 4 4 */ -/*:ref: zzektr23_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: zzektr13_ 14 2 4 4 */ - -extern int zzektrit_(integer *handle, integer *tree); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzektrki_(integer *handle, integer *tree, integer *nodkey, integer *n, integer *key); -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrlk_(integer *handle, integer *tree, integer *key, integer *idx, integer *node, integer *noffst, integer *level, integer *value); -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern integer zzektrls_(integer *handle, integer *tree, integer *ival); -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ - -extern integer zzektrnk_(integer *handle, integer *tree, integer *node); -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrpi_(integer *handle, integer *tree, integer *key, integer *parent, integer *pkey, integer *poffst, integer *lpidx, integer *lpkey, integer *lsib, integer *rpidx, integer *rpkey, integer *rsib); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern int zzektrrk_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx, integer *nrot); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektrsb_(integer *handle, integer *tree, integer *key, integer *lsib, integer *lkey, integer *rsib, integer *rkey); -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern integer zzektrsz_(integer *handle, integer *tree); -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrud_(integer *handle, integer *tree, integer *key, integer *trgkey, logical *undrfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzektrui_(integer *handle, integer *tree, integer *key, integer *value, logical *overfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ - -extern int zzekue01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekiii1_ 14 6 4 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekad01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekue02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekiid1_ 14 6 4 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekad02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekue03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde03_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad03_ 14 7 4 4 4 4 13 12 124 */ - -extern int zzekue04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, integer *ivals, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde04_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad04_ 14 7 4 4 4 4 4 4 12 */ - -extern int zzekue05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde05_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad05_ 14 7 4 4 4 4 4 7 12 */ - -extern int zzekue06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde06_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int zzekvadr_(integer *njrs, integer *bases, integer *rwvidx, integer *rwvbas, integer *sgvbas); -extern int zzekvset_(integer *njrs, integer *bases); -extern int zzekvcal_(integer *rwvidx, integer *rwvbas, integer *sgvbas); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern logical zzekvcmp_(integer *op, integer *ncols, integer *tabs, integer *cols, integer *elts, integer *senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *sgvec1, integer *rwvec1, integer *sgvec2, integer *rwvec2); -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical zzekvmch_(integer *ncnstr, logical *active, integer *lhans, integer *lsdscs, integer *lcdscs, integer *lrows, integer *lelts, integer *ops, integer *rhans, integer *rsdscs, integer *rcdscs, integer *rrows, integer *relts); -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ - -extern int zzekweed_(integer *njrs, integer *bases, integer *nrows); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: sameai_ 12 3 4 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjsqz_ 14 1 4 */ - -extern int zzekweqi_(char *name__, integer *value, integer *eqryi, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekwpac_(integer *handle, integer *segdsc, integer *nvals, integer *l, char *cvals, integer *p, integer *base, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ - -extern int zzekwpai_(integer *handle, integer *segdsc, integer *nvals, integer *ivals, integer *p, integer *base); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekwpal_(integer *handle, integer *segdsc, integer *nvals, logical *lvals, integer *p, integer *base); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzelvupy_(doublereal *ellips, doublereal *vertex, doublereal *axis, integer *n, doublereal *bounds, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: repmot_ 14 9 13 13 4 13 13 124 124 124 124 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: zzwind_ 4 4 7 4 7 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: inelpl_ 14 5 7 7 4 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzenut80_(doublereal *et, doublereal *nutxf); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzwahr_ 14 2 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzeprc76_(doublereal *et, doublereal *precxf); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ - -extern int zzeprcss_(doublereal *et, doublereal *precm); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ - -extern int zzfdat_(integer *ncount, char *name__, integer *idcode, integer *center, integer *type__, integer *typid, integer *norder, integer *corder, integer *centrd, ftnlen name_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ - -extern int zzfovaxi_(char *inst, integer *n, doublereal *bounds, doublereal *axis, ftnlen inst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: zzhullax_ 14 5 13 4 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vhatip_ 14 1 7 */ - -extern int zzfrmch0_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzfrmgt0_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int zzfrmch1_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzfrmgt1_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int zzfrmgt0_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynfr0_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ - -extern int zzfrmgt1_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ - -extern int zzftpchk_(char *string, logical *ftperr, ftnlen string_len); -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: zzrbrkst_ 14 10 13 13 13 13 4 12 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int zzftpstr_(char *tstcom, char *lend, char *rend, char *delim, ftnlen tstcom_len, ftnlen lend_len, ftnlen rend_len, ftnlen delim_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int zzgapool_(char *varnam, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agtset, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtset_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ - -extern int zzgetbff_(integer *bffid); - -extern int zzgetelm_(integer *frstyr, char *lines, doublereal *epoch, doublereal *elems, logical *ok, char *error, ftnlen lines_len, ftnlen error_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ - -extern int zzgfcoq_(char *vecdef, char *method, integer *trgid, doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, doublereal *dvec, char *crdsys, integer *ctrid, doublereal *re, doublereal *f, char *crdnam, doublereal *value, logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: subpnt_ 14 14 13 13 7 13 13 13 7 7 7 124 124 124 124 124 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ - -extern int zzgfcost_(char *vecdef, char *method, integer *trgid, doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzgfssob_ 14 11 13 4 7 13 13 4 7 7 124 124 124 */ -/*:ref: zzgfssin_ 14 16 13 4 7 13 13 4 13 4 7 7 7 12 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgfcou_(char *vecdef, char *method, char *target, doublereal *et, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, logical *decres, logical *lssthn, doublereal *crdval, logical *crdfnd, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -extern int zzgfcoin_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -extern int zzgfcour_(doublereal *refval); -extern int zzgfcog_(doublereal *et, doublereal *crdval); -extern int zzgfcolt_(doublereal *et, logical *lssthn); -extern int zzgfcodc_(doublereal *et, logical *decres); -extern int zzgfcoex_(doublereal *et, logical *crdfnd); -extern int zzgfcocg_(doublereal *et, doublereal *crdval); -extern int zzgfcosg_(doublereal *et, doublereal *crdval); -extern int zzgfcocl_(doublereal *et, logical *lssthn); -extern int zzgfcosl_(doublereal *et, logical *lssthn); -extern int zzgfcocd_(doublereal *et, logical *decres); -extern int zzgfcosd_(doublereal *et, logical *decres); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzgfcoq_ 14 23 13 13 4 7 13 13 4 13 7 13 4 7 7 13 7 12 124 124 124 124 124 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: zzgfcost_ 14 18 13 13 4 7 13 13 4 13 4 7 7 7 12 124 124 124 124 124 */ -/*:ref: zzgfcprx_ 14 7 7 13 7 7 4 4 124 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ - -extern int zzgfcprx_(doublereal *state, char *corsys, doublereal *re, doublereal *f, integer *sense, integer *cdsign, ftnlen corsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: zzrtnmat_ 14 2 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzgfcslv_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, integer *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal *result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: zzgfcoin_ 14 20 13 13 13 13 13 13 13 7 13 13 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wncond_ 14 3 7 7 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzgflong_ 14 37 13 13 13 13 13 13 13 7 13 13 13 7 7 7 200 200 12 214 200 214 12 212 4 4 7 7 7 124 124 124 124 124 124 124 124 124 124 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 200 200 13 7 7 7 7 4 4 7 12 214 200 214 13 13 12 212 7 124 124 124 */ - -extern int zzgfdiq_(integer *targid, doublereal *et, char *abcorr, integer *obsid, doublereal *dist, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vnorm_ 7 1 7 */ - -extern int zzgfdiu_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *et, logical *decres, logical *lssthn, doublereal *dist, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfdiin_(char *target, char *abcorr, char *obsrvr, doublereal *refval, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfdiur_(doublereal *refval); -extern int zzgfdidc_(doublereal *et, logical *decres); -extern int zzgfdigq_(doublereal *et, doublereal *dist); -extern int zzgfdilt_(doublereal *et, logical *lssthn); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzgfdiq_ 14 6 4 7 13 4 7 124 */ - -extern int zzgfdsps_(integer *nlead, char *string, char *fmt, integer *ntrail, ftnlen string_len, ftnlen fmt_len); -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgffvu_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, doublereal *time, logical *vistat, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgffvin_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgffvst_(doublereal *time, logical *vistat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: getfov_ 14 9 4 4 13 13 7 4 7 124 124 */ -/*:ref: zzfovaxi_ 14 5 13 4 7 7 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: dpr_ 7 0 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: edlimb_ 14 5 7 7 7 7 7 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: zzelvupy_ 14 6 7 7 7 4 7 12 */ -/*:ref: zzocced_ 4 5 7 7 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzwind2d_ 4 3 4 7 7 */ - -extern int zzgflong_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, U_fp udrepi, U_fp udrepu, U_fp udrepf, logical *bail, L_fp udbail, integer *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal *result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: zzgfcoin_ 14 20 13 13 13 13 13 13 13 7 13 13 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 214 200 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: zzgfcosg_ 14 2 7 7 */ -/*:ref: zzgfcocg_ 14 2 7 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: smsgnd_ 12 2 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzgfcog_ 14 2 7 7 */ -/*:ref: wnunid_ 14 3 7 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ - -extern int zzgfocu_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *obsrvr, char *abcorr, doublereal *time, logical *ocstat, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len); -extern int zzgfocin_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *obsrvr, char *abcorr, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len); -extern int zzgfocst_(doublereal *time, logical *ocstat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: minad_ 14 4 7 4 7 4 */ -/*:ref: maxad_ 14 4 7 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: zzocced_ 4 5 7 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ - -extern int zzgfref_(doublereal *refval); -/*:ref: zzholdd_ 14 3 13 7 124 */ - -extern int zzgfrel_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen rptsuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wnextd_ 14 3 13 7 124 */ -/*:ref: zzgfwsts_ 14 5 7 7 13 7 124 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzgfrelx_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen rptsuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolvx_ 14 14 214 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wnextd_ 14 3 13 7 124 */ -/*:ref: zzgfwsts_ 14 5 7 7 13 7 124 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzgfrpwk_(integer *unit, doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, doublereal *incr, ftnlen begin_len, ftnlen end_len); -extern int zzgftswk_(doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len); -extern int zzgfwkin_(doublereal *incr); -extern int zzgfwkad_(doublereal *freq, integer *tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len); -extern int zzgfwkun_(integer *unit); -extern int zzgfwkmo_(integer *unit, doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, doublereal *incr, ftnlen begin_len, ftnlen end_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: zzcputim_ 14 1 7 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: zzgfdsps_ 14 6 4 13 13 4 124 124 */ -/*:ref: writln_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ - -extern int zzgfrrq_(doublereal *et, integer *targ, integer *obs, char *abcorr, doublereal *value, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvnorm_ 7 1 7 */ - -extern int zzgfrru_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *et, doublereal *dt, logical *decres, logical *lssthn, doublereal *rvl, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfrrin_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *dt, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfrrur_(doublereal *refval); -extern int zzgfrrdc_(doublereal *et, logical *decres); -extern int zzgfrrgq_(doublereal *et, doublereal *rvl); -extern int zzgfrrlt_(doublereal *et, logical *lssthn); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzgfrrq_ 14 6 7 4 4 13 7 124 */ - -extern int zzgfsolv_(S_fp udcond, S_fp udstep, S_fp udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ - -extern int zzgfsolvx_(U_fp udfunc, S_fp udcond, S_fp udstep, S_fp udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ - -extern int zzgfspq_(doublereal *et, integer *targ1, integer *targ2, doublereal *r1, doublereal *r2, integer *obs, char *abcorr, char *ref, doublereal *value, ftnlen abcorr_len, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int zzgfspu_(char *of, char *from, char *shape, char *frame, doublereal *refval, doublereal *et, char *abcorr, logical *decres, logical *lssthn, doublereal *sep, ftnlen of_len, ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len); -extern int zzgfspin_(char *of, char *from, char *shape, char *frame, doublereal *refval, char *abcorr, ftnlen of_len, ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len); -extern int zzgfspur_(doublereal *refval); -extern int zzgfspdc_(doublereal *et, logical *decres); -extern int zzgfgsep_(doublereal *et, doublereal *sep); -extern int zzgfsplt_(doublereal *et, logical *lssthn); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzgftreb_ 14 2 4 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: dvsep_ 7 2 7 7 */ -/*:ref: dhfa_ 7 2 7 7 */ -/*:ref: zzgfspq_ 14 11 7 4 4 7 7 4 13 13 7 124 124 */ - -extern int zzgfssin_(char *method, integer *trgid, doublereal *et, char *fixref, char *abcorr, integer *obsid, char *dref, integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, logical *found, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: surfpv_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: spkacs_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzcorsxf_ 14 4 12 7 7 7 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzgfssob_(char *method, integer *trgid, doublereal *et, char *fixref, char *abcorr, integer *obsid, doublereal *radii, doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: surfpv_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: subpnt_ 14 14 13 13 7 13 13 13 7 7 7 124 124 124 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: sxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzcorsxf_ 14 4 12 7 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzgftreb_(integer *body, doublereal *axes); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgfudlt_(S_fp udfunc, doublereal *et, logical *isless); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzholdd_ 14 3 13 7 124 */ - -extern int zzgfwsts_(doublereal *wndw1, doublereal *wndw2, char *inclsn, doublereal *wndw3, ftnlen inclsn_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: scardd_ 14 2 4 7 */ - -extern int zzgpnm_(integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *found, integer *lookat, integer *nameat, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzholdd_(char *op, doublereal *value, ftnlen op_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzhullax_(char *inst, integer *n, doublereal *bounds, doublereal *axis, ftnlen inst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ - -extern int zzidmap_(integer *bltcod, char *bltnam, ftnlen bltnam_len); - -extern int zzinssub_(char *in, char *sub, integer *loc, char *out, ftnlen in_len, ftnlen sub_len, ftnlen out_len); - -extern int zzldker_(char *file, char *nofile, char *filtyp, integer *handle, ftnlen file_len, ftnlen nofile_len, ftnlen filtyp_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: spklef_ 14 3 13 4 124 */ -/*:ref: cklpf_ 14 3 13 4 124 */ -/*:ref: pcklof_ 14 3 13 4 124 */ -/*:ref: tkvrsn_ 14 4 13 13 124 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ -/*:ref: ldpool_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzbodkik_ 14 0 */ - -extern int zzmkpc_(char *pictur, integer *b, integer *e, char *mark, char *pattrn, ftnlen pictur_len, ftnlen mark_len, ftnlen pattrn_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int zzmobliq_(doublereal *et, doublereal *mob, doublereal *dmob); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ - -extern int zzmsxf_(doublereal *matrix, integer *n, doublereal *output); - -extern int zznofcon_(doublereal *et, integer *frame1, integer *endp1, integer *frame2, integer *endp2, char *errmsg, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: repmf_ 14 10 13 13 7 4 13 13 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ - -extern int zznrddp_(doublereal *ao, doublereal *elems, doublereal *em, doublereal *omgasm, doublereal *omgdot, doublereal *t, doublereal *xinc, doublereal *xll, doublereal *xlldot, doublereal *xn, doublereal *xnodes, doublereal *xnodot, doublereal *xnodp); -extern int zzdpinit_(doublereal *ao, doublereal *xlldot, doublereal *omgdot, doublereal *xnodot, doublereal *xnodp, doublereal *elems); -extern int zzdpsec_(doublereal *xll, doublereal *omgasm, doublereal *xnodes, doublereal *em, doublereal *xinc, doublereal *xn, doublereal *t, doublereal *elems, doublereal *omgdot); -extern int zzdpper_(doublereal *t, doublereal *em, doublereal *xinc, doublereal *omgasm, doublereal *xnodes, doublereal *xll); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: j1950_ 7 0 */ -/*:ref: zzsecprt_ 14 12 4 7 7 7 7 7 7 7 7 7 7 7 */ - -extern int zznwpool_(char *varnam, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agtwrk, char *notify, char *agents, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtwrk_len, ftnlen notify_len, ftnlen agents_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzgapool_ 14 10 13 13 4 4 13 13 124 124 124 124 */ -/*:ref: unionc_ 14 6 13 13 13 124 124 124 */ -/*:ref: copyc_ 14 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzocced_(doublereal *viewpt, doublereal *centr1, doublereal *semax1, doublereal *centr2, doublereal *semax2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: det_ 7 1 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: edlimb_ 14 5 7 7 7 7 7 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: zzasryel_ 14 7 13 7 7 7 7 7 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: pi_ 7 0 */ - -extern integer zzphsh_(char *word, integer *m, integer *m2, ftnlen word_len); -extern integer zzshsh_(integer *m); -extern integer zzhash_(char *word, ftnlen word_len); -extern integer zzhash2_(char *word, integer *m2, ftnlen word_len); -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzpini_(logical *first, integer *maxvar, integer *maxval, integer *maxlin, char *begdat, char *begtxt, integer *nmpool, integer *dppool, integer *chpool, integer *namlst, integer *datlst, integer *maxagt, integer *mxnote, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agents, char *active, char *notify, ftnlen begdat_len, ftnlen begtxt_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agents_len, ftnlen active_len, ftnlen notify_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzshsh_ 4 1 4 */ -/*:ref: touchi_ 4 1 4 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: clearc_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzplatfm_(char *key, char *value, ftnlen key_len, ftnlen value_len); -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzpltchk_(logical *ok); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: zzgetbff_ 14 1 4 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzprscor_(char *abcorr, logical *attblk, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ -/*:ref: reordl_ 14 3 4 4 12 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzrbrkst_(char *string, char *lftend, char *rgtend, char *substr, integer *length, logical *bkpres, ftnlen string_len, ftnlen lftend_len, ftnlen rgtend_len, ftnlen substr_len); -/*:ref: posr_ 4 5 13 13 4 124 124 */ - -extern int zzrefch0_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzrotgt0_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int zzrefch1_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzrotgt1_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int zzrepsub_(char *in, integer *left, integer *right, char *string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len); -/*:ref: sumai_ 4 2 4 4 */ - -extern logical zzrept_(char *sub, char *replac, logical *l2r, ftnlen sub_len, ftnlen replac_len); -/*:ref: zzsubt_ 12 5 13 13 12 124 124 */ -/*:ref: zzremt_ 12 2 13 124 */ - -extern int zzrotgt0_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynrt0_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzrotgt1_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzrtnmat_(doublereal *v, doublereal *m); -/*:ref: return_ 12 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ - -extern int zzrvar_(integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *eof, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: rdkdat_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rdklin_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int zzrvbf_(char *buffer, integer *bsize, integer *linnum, integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *eof, ftnlen buffer_len, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int zzrxr_(doublereal *matrix, integer *n, doublereal *output); -/*:ref: ident_ 14 1 7 */ - -extern logical zzsclk_(integer *ckid, integer *sclkid); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: removi_ 14 2 4 4 */ - -extern int zzsecprt_(integer *isynfl, doublereal *dg, doublereal *del, doublereal *xni, doublereal *omegao, doublereal *atime, doublereal *omgdot, doublereal *xli, doublereal *xfact, doublereal *xldot, doublereal *xndot, doublereal *xnddt); - -extern int zzsizeok_(integer *size, integer *psize, integer *dsize, integer *offset, logical *ok, integer *n); -/*:ref: rmaini_ 14 4 4 4 4 4 */ - -extern int zzspkac0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzspkas0_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int zzspkac1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzspkas1_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int zzspkap0_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkap1_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkas0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspklt0_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int zzspkas1_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspklt1_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int zzspkez0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkac0_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzspklt0_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int zzspkez1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: zzspkac1_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzspklt1_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int zzspkgo0_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgo1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgp0_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgp1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspklt0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzspklt1_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzspkpa0_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgp0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkpa1_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgp1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspksb0_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzspksb1_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzspkzp0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzspkgp0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzspkpa0_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzspkzp1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzspkgp1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzspkpa1_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzstelab_(logical *xmit, doublereal *accobs, doublereal *vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr); -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ - -extern logical zztime_(char *string, char *transl, char *letter, char *error, char *pic, doublereal *tvec, integer *b, integer *e, logical *l2r, logical *yabbrv, ftnlen string_len, ftnlen transl_len, ftnlen letter_len, ftnlen error_len, ftnlen pic_len); -extern logical zzcmbt_(char *string, char *letter, logical *l2r, ftnlen string_len, ftnlen letter_len); -extern logical zzgrep_(char *string, ftnlen string_len); -extern logical zzispt_(char *string, integer *b, integer *e, ftnlen string_len); -extern logical zzist_(char *letter, ftnlen letter_len); -extern logical zznote_(char *letter, integer *b, integer *e, ftnlen letter_len); -extern logical zzremt_(char *letter, ftnlen letter_len); -extern logical zzsubt_(char *string, char *transl, logical *l2r, ftnlen string_len, ftnlen transl_len); -extern logical zztokns_(char *string, char *error, ftnlen string_len, ftnlen error_len); -extern logical zzunpck_(char *string, logical *yabbrv, doublereal *tvec, integer *e, char *transl, char *pic, char *error, ftnlen string_len, ftnlen transl_len, ftnlen pic_len, ftnlen error_len); -extern logical zzvalt_(char *string, integer *b, integer *e, char *letter, ftnlen string_len, ftnlen letter_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: samsbi_ 12 8 13 4 4 13 4 4 124 124 */ -/*:ref: samchi_ 12 6 13 4 13 4 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzmkpc_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern logical zztpats_(integer *room, integer *nknown, char *known, char *meanng, ftnlen known_len, ftnlen meanng_len); -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ - -extern int zztwovxf_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: ducrss_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vzero_ 12 1 7 */ - -extern int zzutcpm_(char *string, integer *start, doublereal *hoff, doublereal *moff, integer *last, logical *succes, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ - -extern int zzvalcor_(char *abcorr, logical *attblk, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzvstrng_(doublereal *x, char *fill, integer *from, integer *to, logical *rnd, integer *expont, char *substr, logical *did, ftnlen fill_len, ftnlen substr_len); -extern int zzvststr_(doublereal *x, char *fill, integer *expont, ftnlen fill_len); -extern int zzvsbstr_(integer *from, integer *to, logical *rnd, char *substr, logical *did, ftnlen substr_len); -/*:ref: dpstr_ 14 4 7 4 13 124 */ - -extern int zzwahr_(doublereal *et, doublereal *dvnut); -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: spd_ 7 0 */ - -extern integer zzwind_(doublereal *plane, integer *n, doublereal *vertcs, doublereal *point); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ - -extern integer zzwind2d_(integer *n, doublereal *vertcs, doublereal *point); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vsepg_ 7 3 7 7 4 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: twopi_ 7 0 */ - -extern int zzwninsd_(doublereal *left, doublereal *right, char *context, doublereal *window, ftnlen context_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzxlated_(integer *inbff, char *input, integer *space, doublereal *output, ftnlen input_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzxlatei_(integer *inbff, char *input, integer *space, integer *output, ftnlen input_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errint_ 14 3 13 4 124 */ - - -#ifdef __cplusplus - } -#endif - -#endif - diff --git a/ext/spice/src/cspice/SpiceZim.h b/ext/spice/src/cspice/SpiceZim.h deleted file mode 100644 index ee8d96ebc6..0000000000 --- a/ext/spice/src/cspice/SpiceZim.h +++ /dev/null @@ -1,1358 +0,0 @@ -/* - --Header_File SpiceZim.h ( CSPICE interface macros ) - --Abstract - - Define interface macros to be called in place of CSPICE - user-interface-level functions. These macros are generally used - to compensate for compiler deficiencies. - --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. - --Literature_References - - None. - --Particulars - - This header file defines interface macros to be called in place of - CSPICE user-interface-level functions. Currently, the sole purpose - of these macros is to implement automatic type casting under some - environments that generate compile-time warnings without the casts. - The typical case that causes a problem is a function argument list - containing an input formal argument of type - - const double [3][3] - - Under some compilers, a non-const actual argument supplied in a call - to such a function will generate a spurious warning due to the - "mismatched" type. These macros generate type casts that will - make such compilers happy. - - Examples of compilers that generate warnings of this type are - - gcc version 2.2.2, hosted on NeXT workstations running - NeXTStep 3.3 - - Sun C compiler, version 4.2, running under Solaris. - - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 11.0.0, 09-MAR-2009 (NJB) (EDW) - - Added macros for - - dvsep_c - gfevnt_c - gffove_c - gfrfov_c - gfsntc_c - surfpv_c - - - -CSPICE Version 10.0.0, 19-FEB-2008 (NJB) (EDW) - - Added macros for - - ilumin_c - spkaps_c - spkltc_c - - -CSPICE Version 9.0.0, 31-OCT-2005 (NJB) - - Added macros for - - qdq2av_c - qxq_c - - -CSPICE Version 8.0.0, 23-FEB-2004 (NJB) - - Added macro for - - dafrs_c - - - -CSPICE Version 7.0.0, 23-FEB-2004 (EDW) - - Added macro for - - srfxpt_c - - -CSPICE Version 6.0.1, 25-FEB-2003 (EDW) (NJB) - - Remove duplicate macro definitions for ekaced_c and - ekacei_c. Visual Studio errored out when compiling - code that included SpiceZim.h. - - Added macro for - - dasac_c - - -CSPICE Version 6.0.0, 17-AUG-2002 (NJB) - - Added macros for - - bschoc_c - bschoi_c - bsrchc_c - bsrchd_c - bsrchi_c - esrchc_c - isordv_c - isrchc_c - isrchd_c - isrchi_c - lstltc_c - lstltd_c - lstlti_c - lstlec_c - lstled_c - lstlei_c - orderc_c - orderd_c - orderi_c - reordc_c - reordd_c - reordi_c - reordl_c - spkw18_c - - -CSPICE Version 5.0.0, 28-AUG-2001 (NJB) - - Added macros for - - conics_c - illum_c - invort_c - pdpool_c - prop2b_c - q2m_c - spkuds_c - xposeg_c - - -CSPICE Version 4.0.0, 22-MAR-2000 (NJB) - - Added macros for - - spkw12_c - spkw13_c - - -CSPICE Version 3.0.0, 27-AUG-1999 (NJB) (EDW) - - Fixed cut & paste error in macro nvp2pl_c. - - Added macros for - - axisar_c - cgv2el_c - dafps_c - dafus_c - diags2_c - dvdot_c - dvhat_c - edlimb_c - ekacli_c - ekacld_c - ekacli_c - eul2xf_c - el2cgv_c - getelm_c - inedpl_c - isrot_c - mequ_c - npedln_c - nplnpt_c - rav2xf_c - raxisa_c - saelgv_c - spk14a_c - spkapo_c - spkapp_c - spkw02_c - spkw03_c - spkw05_c - spkw08_c - spkw09_c - spkw10_c - spkw15_c - spkw17_c - sumai_c - trace_c - vadd_g - vhatg_c - vlcomg_c - vminug_c - vrel_c - vrelg_c - vsepg_c - vtmv_c - vtmvg_c - vupack_c - vzerog_c - xf2eul_c - xf2rav_c - - -CSPICE Version 2.0.0, 07-MAR-1999 (NJB) - - Added macros for - - inrypl_c - nvc2pl_c - nvp2pl_c - pl2nvc_c - pl2nvp_c - pl2psv_c - psv2pl_c - vprjp_c - vprjpi_c - - -CSPICE Version 1.0.0, 24-JAN-1999 (NJB) (EDW) - - --Index_Entries - - interface macros for CSPICE functions - -*/ - - -/* -Include Files: -*/ - - -#ifndef HAVE_SPICEDEFS_H -#include "SpiceZdf.h" -#endif - -#ifndef HAVE_SPICEIFMACROS_H -#define HAVE_SPICEIFMACROS_H - - -/* -Macros used to abbreviate type casts: -*/ - - #define CONST_BOOL ( ConstSpiceBoolean * ) - #define CONST_ELLIPSE ( ConstSpiceEllipse * ) - #define CONST_IVEC ( ConstSpiceInt * ) - #define CONST_MAT ( ConstSpiceDouble (*) [3] ) - #define CONST_MAT2 ( ConstSpiceDouble (*) [2] ) - #define CONST_MAT6 ( ConstSpiceDouble (*) [6] ) - #define CONST_PLANE ( ConstSpicePlane * ) - #define CONST_VEC3 ( ConstSpiceDouble (*) [3] ) - #define CONST_VEC4 ( ConstSpiceDouble (*) [4] ) - #define CONST_STR ( ConstSpiceChar * ) - #define CONST_VEC ( ConstSpiceDouble * ) - #define CONST_VOID ( const void * ) - -/* -Macros that substitute for function calls: -*/ - - #define axisar_c( axis, angle, r ) \ - \ - ( axisar_c( CONST_VEC(axis), (angle), (r) ) ) - - - #define bschoc_c( value, ndim, lenvals, array, order ) \ - \ - ( bschoc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array), CONST_IVEC(order) ) ) - - - #define bschoi_c( value, ndim, array, order ) \ - \ - ( bschoi_c ( (value) , (ndim), \ - CONST_IVEC(array), CONST_IVEC(order) ) ) - - - #define bsrchc_c( value, ndim, lenvals, array ) \ - \ - ( bsrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define bsrchd_c( value, ndim, array ) \ - \ - ( bsrchd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define bsrchi_c( value, ndim, array ) \ - \ - ( bsrchi_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define ckw01_c( handle, begtim, endtim, inst, ref, avflag, \ - segid, nrec, sclkdp, quats, avvs ) \ - \ - ( ckw01_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(sclkdp), CONST_VEC4(quats), \ - CONST_VEC3(avvs) ) ) - - - #define ckw02_c( handle, begtim, endtim, inst, ref, segid, \ - nrec, start, stop, quats, avvs, rates ) \ - \ - ( ckw02_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(start), CONST_VEC(stop), \ - CONST_VEC4(quats), CONST_VEC3(avvs), \ - CONST_VEC(rates) ) ) - - - #define ckw03_c( handle, begtim, endtim, inst, ref, avflag, \ - segid, nrec, sclkdp, quats, avvs, nints, \ - starts ) \ - \ - ( ckw03_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(sclkdp), CONST_VEC4(quats), \ - CONST_VEC3(avvs), (nints), \ - CONST_VEC(starts) ) ) - - - #define ckw05_c( handle, subtyp, degree, begtim, endtim, inst, \ - ref, avflag, segid, n, sclkdp, packts, \ - rate, nints, starts ) \ - \ - ( ckw05_c ( (handle), (subtyp), (degree), \ - (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (n), \ - CONST_VEC(sclkdp), CONST_VOID(packts), \ - (rate), (nints), \ - CONST_VEC(starts) ) ) - - - #define cgv2el_c( center, vec1, vec2, ellipse ) \ - \ - ( cgv2el_c( CONST_VEC(center), CONST_VEC(vec1), \ - CONST_VEC(vec2), (ellipse) ) ) - - - #define conics_c( elts, et, state ) \ - \ - ( conics_c( CONST_VEC(elts), (et), (state) ) ) - - - #define dafps_c( nd, ni, dc, ic, sum ) \ - \ - ( dafps_c ( (nd), (ni), CONST_VEC(dc), CONST_IVEC(ic), \ - (sum) ) ) - - - #define dafrs_c( sum ) \ - \ - ( dafrs_c ( CONST_VEC( sum ) ) ) - - - #define dafus_c( sum, nd, ni, dc, ic ) \ - \ - ( dafus_c ( CONST_VEC(sum), (nd), (ni), (dc), (ic) ) ) - - - #define dasac_c( handle, n, buflen, buffer ) \ - \ - ( dasac_c ( (handle), (n), (buflen), CONST_VOID(buffer) ) ) - - - #define det_c( m1 ) \ - \ - ( det_c ( CONST_MAT(m1) ) ) - - - #define diags2_c( symmat, diag, rotate ) \ - \ - ( diags2_c ( CONST_MAT2(symmat), (diag), (rotate) ) ) - - - - #define dvdot_c( s1, s2 ) \ - \ - ( dvdot_c ( CONST_VEC(s1), CONST_VEC(s2) ) ) - - - #define dvhat_c( v1, v2 ) \ - \ - ( dvhat_c ( CONST_VEC(v1), (v2) ) ) - - - #define dvsep_c( s1, s2 ) \ - \ - ( dvsep_c ( CONST_VEC(s1), CONST_VEC(s2) ) ) - - - #define edlimb_c( a, b, c, viewpt, limb ) \ - \ - ( edlimb_c( (a), (b), (c), CONST_VEC(viewpt), (limb) ) ) - - - #define ekacec_c( handle, segno, recno, column, nvals, vallen, \ - cvals, isnull ) \ - \ - ( ekacec_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), (vallen), CONST_VOID(cvals), \ - (isnull) ) ) - - - #define ekaced_c( handle, segno, recno, column, nvals, \ - dvals, isnull ) \ - \ - ( ekaced_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VEC(dvals), (isnull) ) ) - - - #define ekacei_c( handle, segno, recno, column, nvals, \ - ivals, isnull ) \ - \ - ( ekacei_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_IVEC(ivals), (isnull) ) ) - - - #define ekaclc_c( handle, segno, column, vallen, cvals, entszs, \ - nlflgs, rcptrs, wkindx ) \ - \ - ( ekaclc_c( (handle), (segno), (column), (vallen), \ - CONST_VOID(cvals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekacld_c( handle, segno, column, dvals, entszs, nlflgs, \ - rcptrs, wkindx ) \ - \ - ( ekacld_c( (handle), (segno), (column), \ - CONST_VEC(dvals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekacli_c( handle, segno, column, ivals, entszs, nlflgs, \ - rcptrs, wkindx ) \ - \ - ( ekacli_c( (handle), (segno), (column), \ - CONST_IVEC(ivals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekbseg_c( handle, tabnam, ncols, cnmlen, cnames, declen, \ - decls, segno ) \ - \ - ( ekbseg_c( (handle), (tabnam), (ncols), (cnmlen), \ - CONST_VOID(cnames), (declen), \ - CONST_VOID(decls), (segno) ) ) - - - #define ekifld_c( handle, tabnam, ncols, nrows, cnmlen, cnames, \ - declen, decls, segno, rcptrs ) \ - \ - ( ekifld_c( (handle), (tabnam), (ncols), (nrows), (cnmlen), \ - CONST_VOID(cnames), (declen), \ - CONST_VOID(decls), (segno), (rcptrs) ) ) - - - #define ekucec_c( handle, segno, recno, column, nvals, vallen, \ - cvals, isnull ) \ - \ - ( ekucec_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), (vallen), CONST_VOID(cvals), \ - (isnull) ) ) - - #define ekuced_c( handle, segno, recno, column, nvals, \ - dvals, isnull ) \ - \ - ( ekuced_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VOID(dvals), (isnull) ) ) - - - #define ekucei_c( handle, segno, recno, column, nvals, \ - ivals, isnull ) \ - \ - ( ekucei_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VOID(ivals), (isnull) ) ) - - - #define el2cgv_c( ellipse, center, smajor, sminor ) \ - \ - ( el2cgv_c( CONST_ELLIPSE(ellipse), (center), \ - (smajor), (sminor) ) ) - - - #define esrchc_c( value, ndim, lenvals, array ) \ - \ - ( esrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define eul2xf_c( eulang, axisa, axisb, axisc, xform ) \ - \ - ( eul2xf_c ( CONST_VEC(eulang), (axisa), (axisb), (axisc), \ - (xform) ) ) - - - #define getelm_c( frstyr, lineln, lines, epoch, elems ) \ - \ - ( getelm_c ( (frstyr), (lineln), CONST_VOID(lines), \ - (epoch), (elems) ) ) - - - #define gfevnt_c( udstep, udrefn, gquant, qnpars, lenvals, \ - qpnams, qcpars, qdpars, qipars, qlpars, \ - op, refval, tol, adjust, rpt, \ - udrepi, udrepu, udrepf, nintvls, \ - bail, udbail, cnfine, result ) \ - \ - ( gfevnt_c( (udstep), (udrefn), (gquant), \ - (qnpars), (lenvals), CONST_VOID(qpnams),\ - CONST_VOID(qcpars), (qdpars), (qipars), \ - (qlpars), (op), (refval), \ - (tol), (adjust), (rpt), \ - (udrepi), (udrepu), (udrepf), \ - (nintvls), (bail), \ - (udbail), (cnfine), (result) ) ) - - - #define gffove_c( inst, tshape, raydir, target, tframe, \ - abcorr, obsrvr, tol, udstep, udrefn, \ - rpt, udrepi, udrepu, udrepf, bail, \ - udbail, cnfine, result ) \ - \ - ( gffove_c( (inst), (tshape), CONST_VEC(raydir), \ - (target), (tframe), (abcorr), \ - (obsrvr), (tol), (udstep), \ - (udrefn), (rpt), (udrepi), \ - (udrepu), (udrepf), (bail), \ - (udbail), (cnfine), (result) ) ) - - - #define gfrfov_c( inst, raydir, rframe, abcorr, obsrvr, \ - step, cnfine, result ) \ - \ - ( gfrfov_c( (inst), CONST_VEC(raydir), (rframe), \ - (abcorr), (obsrvr), (step), \ - (cnfine), (result) ) ) - - - #define gfsntc_c( target, fixref, method, abcorr, obsrvr, \ - dref, dvec, crdsys, coord, relate, \ - refval, adjust, step, nintvls, cnfine, \ - result ) \ - \ - ( gfsntc_c( (target), (fixref), (method), \ - (abcorr), (obsrvr), (dref), \ - CONST_VEC(dvec), (crdsys), (coord), \ - (relate), (refval), (adjust), \ - (step), (nintvls), (cnfine), (result) ) ) - - - #define illum_c( target, et, abcorr, obsrvr, \ - spoint, phase, solar, emissn ) \ - \ - ( illum_c ( (target), (et), (abcorr), (obsrvr), \ - CONST_VEC(spoint), (phase), (solar), (emissn) ) ) - - - #define ilumin_c( method, target, et, fixref, \ - abcorr, obsrvr, spoint, trgepc, \ - srfvec, phase, solar, emissn ) \ - \ - ( ilumin_c ( (method), (target), (et), (fixref), \ - (abcorr), (obsrvr), CONST_VEC(spoint), (trgepc), \ - (srfvec), (phase), (solar), (emissn) ) ) - - - #define inedpl_c( a, b, c, plane, ellipse, found ) \ - \ - ( inedpl_c ( (a), (b), (c), \ - CONST_PLANE(plane), (ellipse), (found) ) ) - - - #define inrypl_c( vertex, dir, plane, nxpts, xpt ) \ - \ - ( inrypl_c ( CONST_VEC(vertex), CONST_VEC(dir), \ - CONST_PLANE(plane), (nxpts), (xpt) ) ) - - - #define invert_c( m1, m2 ) \ - \ - ( invert_c ( CONST_MAT(m1), (m2) ) ) - - - #define invort_c( m, mit ) \ - \ - ( invort_c ( CONST_MAT(m), (mit) ) ) - - - #define isordv_c( array, n ) \ - \ - ( isordv_c ( CONST_IVEC(array), (n) ) ) - - - #define isrchc_c( value, ndim, lenvals, array ) \ - \ - ( isrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - #define isrchd_c( value, ndim, array ) \ - \ - ( isrchd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define isrchi_c( value, ndim, array ) \ - \ - ( isrchi_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define isrot_c( m, ntol, dtol ) \ - \ - ( isrot_c ( CONST_MAT(m), (ntol), (dtol) ) ) - - - #define lmpool_c( cvals, lenvals, n ) \ - \ - ( lmpool_c( CONST_VOID(cvals), (lenvals), (n) ) ) - - - #define lstltc_c( value, ndim, lenvals, array ) \ - \ - ( lstltc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define lstled_c( value, ndim, array ) \ - \ - ( lstled_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define lstlei_c( value, ndim, array ) \ - \ - ( lstlei_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define lstlec_c( value, ndim, lenvals, array ) \ - \ - ( lstlec_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define lstltd_c( value, ndim, array ) \ - \ - ( lstltd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define lstlti_c( value, ndim, array ) \ - \ - ( lstlti_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define m2eul_c( r, axis3, axis2, axis1, \ - angle3, angle2, angle1 ) \ - \ - ( m2eul_c ( CONST_MAT(r), (axis3), (axis2), (axis1), \ - (angle3), (angle2), (angle1) ) ) - - #define m2q_c( r, q ) \ - \ - ( m2q_c ( CONST_MAT(r), (q) ) ) - - - #define mequ_c( m1, m2 ) \ - \ - ( mequ_c ( CONST_MAT(m1), m2 ) ) - - - #define mequg_c( m1, nr, nc, mout ) \ - \ - ( mequg_c ( CONST_MAT(m1), (nr), (nc), mout ) ) - - - #define mtxm_c( m1, m2, mout ) \ - \ - ( mtxm_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mtxmg_c( m1, m2, ncol1, nr1r2, ncol2, mout ) \ - \ - ( mtxmg_c ( CONST_MAT(m1), CONST_MAT(m2), \ - (ncol1), (nr1r2), (ncol2), (mout) ) ) - - - #define mtxv_c( m1, vin, vout ) \ - \ - ( mtxv_c ( CONST_MAT(m1), CONST_VEC(vin), (vout) ) ) - - - #define mtxvg_c( m1, v2, nrow1, nc1r2, vout ) \ - \ - ( mtxvg_c( CONST_VOID(m1), CONST_VOID(v2), \ - (nrow1), (nc1r2), (vout) ) ) - - #define mxm_c( m1, m2, mout ) \ - \ - ( mxm_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mxmg_c( m1, m2, row1, col1, col2, mout ) \ - \ - ( mxmg_c ( CONST_VOID(m1), CONST_VOID(m2), \ - (row1), (col1), (col2), (mout) ) ) - - - #define mxmt_c( m1, m2, mout ) \ - \ - ( mxmt_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mxmtg_c( m1, m2, nrow1, nc1c2, nrow2, mout ) \ - \ - ( mxmtg_c ( CONST_VOID(m1), CONST_VOID(m2), \ - (nrow1), (nc1c2), \ - (nrow2), (mout) ) ) - - - #define mxv_c( m1, vin, vout ) \ - \ - ( mxv_c ( CONST_MAT(m1), CONST_VEC(vin), (vout) ) ) - - - #define mxvg_c( m1, v2, nrow1, nc1r2, vout ) \ - \ - ( mxvg_c( CONST_VOID(m1), CONST_VOID(v2), \ - (nrow1), (nc1r2), (vout) ) ) - - #define nearpt_c( positn, a, b, c, npoint, alt ) \ - \ - ( nearpt_c ( CONST_VEC(positn), (a), (b), (c), \ - (npoint), (alt) ) ) - - - #define npedln_c( a, b, c, linept, linedr, pnear, dist ) \ - \ - ( npedln_c ( (a), (b), (c), \ - CONST_VEC(linept), CONST_VEC(linedr), \ - (pnear), (dist) ) ) - - - #define nplnpt_c( linpt, lindir, point, pnear, dist ) \ - \ - ( nplnpt_c ( CONST_VEC(linpt), CONST_VEC(lindir), \ - CONST_VEC(point), (pnear), (dist ) ) ) - - - #define nvc2pl_c( normal, constant, plane ) \ - \ - ( nvc2pl_c ( CONST_VEC(normal), (constant), (plane) ) ) - - - #define nvp2pl_c( normal, point, plane ) \ - \ - ( nvp2pl_c( CONST_VEC(normal), CONST_VEC(point), (plane) ) ) - - - #define orderc_c( lenvals, array, ndim, iorder ) \ - \ - ( orderc_c ( (lenvals), CONST_VOID(array), (ndim), (iorder)) ) - - - #define orderd_c( array, ndim, iorder ) \ - \ - ( orderd_c ( CONST_VEC(array), (ndim), (iorder) ) ) - - - #define orderi_c( array, ndim, iorder ) \ - \ - ( orderi_c ( CONST_IVEC(array), (ndim), (iorder) ) ) - - - #define oscelt_c( state, et, mu, elts ) \ - \ - ( oscelt_c ( CONST_VEC(state), (et), (mu), (elts) ) ) - - - #define pcpool_c( name, n, lenvals, cvals ) \ - \ - ( pcpool_c ( (name), (n), (lenvals), CONST_VOID(cvals) ) ) - - - #define pdpool_c( name, n, dvals ) \ - \ - ( pdpool_c ( (name), (n), CONST_VEC(dvals) ) ) - - - #define pipool_c( name, n, ivals ) \ - \ - ( pipool_c ( (name), (n), CONST_IVEC(ivals) ) ) - - - #define pl2nvc_c( plane, normal, constant ) \ - \ - ( pl2nvc_c ( CONST_PLANE(plane), (normal), (constant) ) ) - - - #define pl2nvp_c( plane, normal, point ) \ - \ - ( pl2nvp_c ( CONST_PLANE(plane), (normal), (point) ) ) - - - #define pl2psv_c( plane, point, span1, span2 ) \ - \ - ( pl2psv_c( CONST_PLANE(plane), (point), (span1), (span2) ) ) - - - #define prop2b_c( gm, pvinit, dt, pvprop ) \ - \ - ( prop2b_c ( (gm), CONST_VEC(pvinit), (dt), (pvprop) ) ) - - - #define psv2pl_c( point, span1, span2, plane ) \ - \ - ( psv2pl_c ( CONST_VEC(point), CONST_VEC(span1), \ - CONST_VEC(span2), (plane) ) ) - - - #define qdq2av_c( q, dq, av ) \ - \ - ( qdq2av_c ( CONST_VEC(q), CONST_VEC(dq), (av) ) ) - - - #define q2m_c( q, r ) \ - \ - ( q2m_c ( CONST_VEC(q), (r) ) ) - - - #define qxq_c( q1, q2, qout ) \ - \ - ( qxq_c ( CONST_VEC(q1), CONST_VEC(q2), (qout) ) ) - - - #define rav2xf_c( rot, av, xform ) \ - \ - ( rav2xf_c ( CONST_MAT(rot), CONST_VEC(av), (xform) ) ) - - - #define raxisa_c( matrix, axis, angle ) \ - \ - ( raxisa_c ( CONST_MAT(matrix), (axis), (angle) ) ); - - - #define reccyl_c( rectan, r, lon, z ) \ - \ - ( reccyl_c ( CONST_VEC(rectan), (r), (lon), (z) ) ) - - - #define recgeo_c( rectan, re, f, lon, lat, alt ) \ - \ - ( recgeo_c ( CONST_VEC(rectan), (re), (f), \ - (lon), (lat), (alt) ) ) - - #define reclat_c( rectan, r, lon, lat ) \ - \ - ( reclat_c ( CONST_VEC(rectan), (r), (lon), (lat) ) ) - - - #define recrad_c( rectan, radius, ra, dec ) \ - \ - ( recrad_c ( CONST_VEC(rectan), (radius), (ra), (dec) ) ) - - - #define recsph_c( rectan, r, colat, lon ) \ - \ - ( recsph_c ( CONST_VEC(rectan), (r), (colat), (lon) ) ) - - - #define reordd_c( iorder, ndim, array ) \ - \ - ( reordd_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define reordi_c( iorder, ndim, array ) \ - \ - ( reordi_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define reordl_c( iorder, ndim, array ) \ - \ - ( reordl_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define rotmat_c( m1, angle, iaxis, mout ) \ - \ - ( rotmat_c ( CONST_MAT(m1), (angle), (iaxis), (mout) ) ) - - - #define rotvec_c( v1, angle, iaxis, vout ) \ - \ - ( rotvec_c ( CONST_VEC(v1), (angle), (iaxis), (vout) ) ) - - - #define saelgv_c( vec1, vec2, smajor, sminor ) \ - \ - ( saelgv_c ( CONST_VEC(vec1), CONST_VEC(vec2), \ - (smajor), (sminor) ) ) - - - #define spk14a_c( handle, ncsets, coeffs, epochs ) \ - \ - ( spk14a_c ( (handle), (ncsets), \ - CONST_VEC(coeffs), CONST_VEC(epochs) ) ) - - - #define spkapo_c( targ, et, ref, sobs, abcorr, ptarg, lt ) \ - \ - ( spkapo_c ( (targ), (et), (ref), CONST_VEC(sobs), \ - (abcorr), (ptarg), (lt) ) ) - - - #define spkapp_c( targ, et, ref, sobs, abcorr, starg, lt ) \ - \ - ( spkapp_c ( (targ), (et), (ref), CONST_VEC(sobs), \ - (abcorr), (starg), (lt) ) ) - - - #define spkaps_c( targ, et, ref, abcorr, sobs, \ - accobs, starg, lt, dlt ) \ - \ - ( spkaps_c ( (targ), (et), (ref), (abcorr), \ - CONST_VEC(sobs), CONST_VEC(accobs), \ - (starg), (lt), (dlt) ) ) - - - #define spkltc_c( targ, et, ref, abcorr, sobs, starg, lt, dlt ) \ - \ - ( spkltc_c ( (targ), (et), (ref), (abcorr), \ - CONST_VEC(sobs), (starg), (lt), (dlt) ) ) - - - #define spkuds_c( descr, body, center, frame, type, \ - first, last, begin, end ) \ - \ - ( spkuds_c ( CONST_VEC(descr), (body), (center), (frame), \ - (type), (first), (last), (begin), (end) ) ) - - - #define spkw02_c( handle, body, center, frame, first, last, \ - segid, intlen, n, polydg, cdata, btime ) \ - \ - ( spkw02_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (intlen), \ - (n), (polydg), CONST_VEC(cdata), (btime) ) ) - - - #define spkw03_c( handle, body, center, frame, first, last, \ - segid, intlen, n, polydg, cdata, btime ) \ - \ - ( spkw03_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (intlen), \ - (n), (polydg), CONST_VEC(cdata), (btime) ) ) - - - - #define spkw05_c( handle, body, center, frame, first, last, \ - segid, gm, n, states, epochs ) \ - \ - ( spkw05_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (gm), \ - (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - #define spkw08_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epoch1, step ) \ - \ - ( spkw08_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), \ - (n), CONST_MAT6(states), (epoch1), \ - (step) ) ) - - - #define spkw09_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epochs ) \ - \ - ( spkw09_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - #define spkw10_c( handle, body, center, frame, first, last, \ - segid, consts, n, elems, epochs ) \ - \ - ( spkw10_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), CONST_VEC(consts), \ - (n), CONST_VEC(elems), CONST_VEC(epochs)) ) - - - #define spkw12_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epoch0, step ) \ - \ - ( spkw12_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), \ - (n), CONST_MAT6(states), (epoch0), \ - (step) ) ) - - - #define spkw13_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epochs ) \ - \ - ( spkw13_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - - - - #define spkw15_c( handle, body, center, frame, first, last, \ - segid, epoch, tp, pa, p, ecc, \ - j2flg, pv, gm, j2, radius ) \ - \ - ( spkw15_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (epoch), \ - CONST_VEC(tp), CONST_VEC(pa), \ - (p), (ecc), (j2flg), CONST_VEC(pv), \ - (gm), (j2), (radius) ) ) - - - #define spkw17_c( handle, body, center, frame, first, last, \ - segid, epoch, eqel, rapol, decpol ) \ - \ - ( spkw17_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (epoch), \ - CONST_VEC(eqel), (rapol), (decpol) ) ) - - - - #define spkw18_c( handle, subtyp, body, center, frame, first, \ - last, segid, degree, n, packts, epochs ) \ - \ - ( spkw18_c ( (handle), (subtyp), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_VOID(packts), CONST_VEC(epochs) ) ) - - - #define srfxpt_c( method, target, et, abcorr, obsrvr, dref, \ - dvec, spoint, dist, trgepc, obspos, found ) \ - \ - ( srfxpt_c ( (method), (target), (et), (abcorr), (obsrvr), \ - (dref), CONST_VEC(dvec), (spoint), (dist), \ - (trgepc), (obspos), (found) ) ) - - - #define stelab_c( pobj, vobj, appobj ) \ - \ - ( stelab_c ( CONST_VEC(pobj), CONST_VEC(vobj), (appobj) ) ) - - - #define sumad_c( array, n ) \ - \ - ( sumad_c ( CONST_VEC(array), (n) ) ) - - - #define sumai_c( array, n ) \ - \ - ( sumai_c ( CONST_IVEC(array), (n) ) ) - - - #define surfnm_c( a, b, c, point, normal ) \ - \ - ( surfnm_c ( (a), (b), (c), CONST_VEC(point), (normal) ) ) - - - #define surfpt_c( positn, u, a, b, c, point, found ) \ - \ - ( surfpt_c ( CONST_VEC(positn), CONST_VEC(u), \ - (a), (b), (c), \ - (point), (found) ) ) - - - #define surfpv_c( stvrtx, stdir, a, b, c, stx, found ) \ - \ - ( surfpv_c ( CONST_VEC(stvrtx), CONST_VEC(stdir), \ - (a), (b), (c), \ - (stx), (found) ) ) - - - #define swpool_c( agent, nnames, lenvals, names ) \ - \ - ( swpool_c( CONST_STR(agent), (nnames), \ - (lenvals), CONST_VOID(names) ) ) - - - #define trace_c( m1 ) \ - \ - ( trace_c ( CONST_MAT(m1) ) ) - - - #define twovec_c( axdef, indexa, plndef, indexp, mout ) \ - \ - ( twovec_c ( CONST_VEC(axdef), (indexa), \ - CONST_VEC(plndef), (indexp), (mout) ) ) - - - #define ucrss_c( v1, v2, vout ) \ - \ - ( ucrss_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define unorm_c( v1, vout, vmag ) \ - \ - ( unorm_c ( CONST_VEC(v1), (vout), (vmag) ) ) - - - #define unormg_c( v1, ndim, vout, vmag ) \ - \ - ( unormg_c ( CONST_VEC(v1), (ndim), (vout), (vmag) ) ) - - - #define vadd_c( v1, v2, vout ) \ - \ - ( vadd_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vaddg_c( v1, v2, ndim,vout ) \ - \ - ( vaddg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim), (vout) ) ) - - - #define vcrss_c( v1, v2, vout ) \ - \ - ( vcrss_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vdist_c( v1, v2 ) \ - \ - ( vdist_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vdistg_c( v1, v2, ndim ) \ - \ - ( vdistg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vdot_c( v1, v2 ) \ - \ - ( vdot_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vdotg_c( v1, v2, ndim ) \ - \ - ( vdotg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vequ_c( vin, vout ) \ - \ - ( vequ_c ( CONST_VEC(vin), (vout) ) ) - - - #define vequg_c( vin, ndim, vout ) \ - \ - ( vequg_c ( CONST_VEC(vin), (ndim), (vout) ) ) - - - #define vhat_c( v1, vout ) \ - \ - ( vhat_c ( CONST_VEC(v1), (vout) ) ) - - - #define vhatg_c( v1, ndim, vout ) \ - \ - ( vhatg_c ( CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vlcom3_c( a, v1, b, v2, c, v3, sum ) \ - \ - ( vlcom3_c ( (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), \ - (c), CONST_VEC(v3), (sum) ) ) - - - #define vlcom_c( a, v1, b, v2, sum ) \ - \ - ( vlcom_c ( (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), (sum) ) ) - - - #define vlcomg_c( n, a, v1, b, v2, sum ) \ - \ - ( vlcomg_c ( (n), (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), (sum) ) ) - - - #define vminug_c( v1, ndim, vout ) \ - \ - ( vminug_c ( CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vminus_c( v1, vout ) \ - \ - ( vminus_c ( CONST_VEC(v1), (vout) ) ) - - - #define vnorm_c( v1 ) \ - \ - ( vnorm_c ( CONST_VEC(v1) ) ) - - - #define vnormg_c( v1, ndim ) \ - \ - ( vnormg_c ( CONST_VEC(v1), (ndim) ) ) - - - #define vperp_c( a, b, p ) \ - \ - ( vperp_c ( CONST_VEC(a), CONST_VEC(b), (p) ) ) - - - #define vprjp_c( vin, plane, vout ) \ - \ - ( vprjp_c ( CONST_VEC(vin), CONST_PLANE(plane), (vout) ) ) - - - #define vprjpi_c( vin, projpl, invpl, vout, found ) \ - \ - ( vprjpi_c( CONST_VEC(vin), CONST_PLANE(projpl), \ - CONST_PLANE(invpl), (vout), (found) ) ) - - - #define vproj_c( a, b, p ) \ - \ - ( vproj_c ( CONST_VEC(a), CONST_VEC(b), (p) ) ) - - - #define vrel_c( v1, v2 ) \ - \ - ( vrel_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vrelg_c( v1, v2, ndim ) \ - \ - ( vrelg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vrotv_c( v, axis, theta, r ) \ - \ - ( vrotv_c ( CONST_VEC(v), CONST_VEC(axis), (theta), (r) ) ) - - - #define vscl_c( s, v1, vout ) \ - \ - ( vscl_c ( (s), CONST_VEC(v1), (vout) ) ) - - - #define vsclg_c( s, v1, ndim, vout ) \ - \ - ( vsclg_c ( (s), CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vsep_c( v1, v2 ) \ - \ - ( vsep_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vsepg_c( v1, v2, ndim) \ - \ - ( vsepg_c ( CONST_VEC(v1), CONST_VEC(v2), ndim ) ) - - - #define vsub_c( v1, v2, vout ) \ - \ - ( vsub_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vsubg_c( v1, v2, ndim, vout ) \ - \ - ( vsubg_c ( CONST_VEC(v1), CONST_VEC(v2), \ - (ndim), (vout) ) ) - - #define vtmv_c( v1, mat, v2 ) \ - \ - ( vtmv_c ( CONST_VEC(v1), CONST_MAT(mat), CONST_VEC(v2) ) ) - - - #define vtmvg_c( v1, mat, v2, nrow, ncol ) \ - \ - ( vtmvg_c ( CONST_VOID(v1), CONST_VOID(mat), CONST_VOID(v2), \ - (nrow), (ncol) ) ) - - - #define vupack_c( v, x, y, z ) \ - \ - ( vupack_c ( CONST_VEC(v), (x), (y), (z) ) ) - - - #define vzero_c( v1 ) \ - \ - ( vzero_c ( CONST_VEC(v1) ) ) - - - #define vzerog_c( v1, ndim ) \ - \ - ( vzerog_c ( CONST_VEC(v1), (ndim) ) ) - - - #define xf2eul_c( xform, axisa, axisb, axisc, eulang, unique ) \ - \ - ( xf2eul_c( CONST_MAT6(xform), (axisa), (axisb), (axisc), \ - (eulang), (unique) ) ) - - - #define xf2rav_c( xform, rot, av ) \ - \ - ( xf2rav_c( CONST_MAT6(xform), (rot), (av) ) ) - - - #define xpose6_c( m1, mout ) \ - \ - ( xpose6_c ( CONST_MAT6(m1), (mout) ) ) - - - #define xpose_c( m1, mout ) \ - \ - ( xpose_c ( CONST_MAT(m1), (mout) ) ) - - - #define xposeg_c( matrix, nrow, ncol, mout ) \ - \ - ( xposeg_c ( CONST_VOID(matrix), (nrow), (ncol), (mout) ) ) - - -#endif diff --git a/ext/spice/src/cspice/SpiceZmc.h b/ext/spice/src/cspice/SpiceZmc.h deleted file mode 100644 index df694a602e..0000000000 --- a/ext/spice/src/cspice/SpiceZmc.h +++ /dev/null @@ -1,975 +0,0 @@ -/* - --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. - -*/ - -/* - CSPICE private macro file. - --Particulars - - Current list of macros (spelling counts) - - BLANK - C2F_MAP_CELL - C2F_MAP_CELL2 - C2F_MAP_CELL3 - CELLINIT - CELLINIT2 - CELLINIT3 - CELLISSETCHK - CELLISSETCHK2 - CELLISSETCHK2_VAL - CELLISSETCHK3 - CELLISSETCHK3_VAL - CELLISSETCHK_VAL - CELLMATCH2 - CELLMATCH2_VAL - CELLMATCH3 - CELLMATCH3_VAL - CELLTYPECHK - CELLTYPECHK2 - CELLTYPECHK2_VAL - CELLTYPECHK3 - CELLTYPECHK3_VAL - CELLTYPECHK_VAL - CHKFSTR - CHKFSTR_VAL - CHKOSTR - CHKOSTR_VAL - CHKPTR - Constants - Even - F2C_MAP_CELL - Index values - MOVED - MOVEI - MaxAbs - MaxVal - MinAbs - MinVal - Odd - SpiceError - TolOrFail - --Restrictions - - This is a private macro file for use within CSPICE. - Do not use or alter any entry. Or else! - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 4.2.0, 16-FEB-2005 (NJB) - - Bug fix: in the macro C2F_MAP_CELL, error checking has been - added after the sequence of calls to ssizec_ and scardc_. - If either of these routines signals an error, the dynamically - allocated memory for the "Fortran cell" is freed. - - -CSPICE Version 4.1.0, 06-DEC-2002 (NJB) - - Bug fix: added previous missing, bracketing parentheses to - references to input cell pointer argument in macro - CELLINIT. - - Changed CELLINIT macro so it no longer initializes to zero - length all strings in data array of a character cell. Instead, - strings are terminated with a null in their final element. - - -CSPICE Version 4.0.0, 22-AUG-2002 (NJB) - - Added macro definitions to support CSPICE cells and sets: - - C2F_MAP_CELL - C2F_MAP_CELL2 - C2F_MAP_CELL3 - CELLINIT - CELLINIT2 - CELLINIT3 - CELLISSETCHK - CELLISSETCHK2 - CELLISSETCHK2_VAL - CELLISSETCHK3 - CELLISSETCHK3_VAL - CELLISSETCHK_VAL - CELLMATCH2 - CELLMATCH2_VAL - CELLMATCH3 - CELLMATCH3_VAL - CELLTYPECHK - CELLTYPECHK2 - CELLTYPECHK2_VAL - CELLTYPECHK3 - CELLTYPECHK3_VAL - CELLTYPECHK_VAL - F2C_MAP_CELL - - -CSPICE Version 3.0.0, 09-JAN-1998 (NJB) - - Added output string check macros CHKOSTR and CHKOSTR_VAL. - Removed variable name arguments from macros - - CHKPTR - CHKPTR_VAL - CHKFSTR - CHKRSTR_VAL - - The strings containing names of the checked variables are now - generated from the variables themselves via the # operator. - - -CSPICE Version 2.0.0, 03-DEC-1997 (NJB) - - Added pointer check macro CHKPTR and Fortran string check macro - CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) -*/ - - - -#include -#include -#include "SpiceZdf.h" - - -#define MOVED( arrfrm, ndim, arrto ) \ - \ - ( memmove ( (void*) (arrto) , \ - (void*) (arrfrm), \ - sizeof (SpiceDouble) * (ndim) ) ) - - - - - -#define MOVEI( arrfrm, ndim, arrto ) \ - \ - ( memmove ( (void*) (arrto) , \ - (void*) (arrfrm), \ - sizeof (SpiceInt) * (ndim) ) ) - - - - - -/* -Define a tolerance test for those pesky double precision reals. -True if the difference is less than the tolerance, false otherwise. -The tolerance refers to a percentage. x, y and tol should be declared -double. All values are assumed to be non-zero. Okay? -*/ - -#define TolOrFail( x, y, tol ) \ - \ - ( fabs( x-y ) < ( tol * fabs(x) ) ) - - - - - -/* -Simple error output through standard SPICE error system . Set the error -message and the type -*/ - -#define SpiceError( errmsg, errtype ) \ - \ - { \ - setmsg_c ( errmsg ); \ - sigerr_c ( errtype ); \ - } - - - - - - -/* -Return a value which is the maximum/minimum of the absolute values of -two values. -*/ - -#define MaxAbs(a,b) ( fabs(a) >= fabs(b) ? fabs(a) : fabs(b) ) -#define MinAbs(a,b) ( fabs(a) < fabs(b) ? fabs(a) : fabs(b) ) - - - - - -/* -Return a value which is the maximum/minimum value of two values. -*/ - -#define MaxVal(A,B) ( (A) >= (B) ? (A) : (B) ) -#define MinVal(A,B) ( (A) < (B) ? (A) : (B) ) - - - - - -/* -Determine whether a value is even or odd -*/ -#define Even( x ) ( ( (x) & 1 ) == 0 ) -#define Odd ( x ) ( ( (x) & 1 ) != 0 ) - - - - - -/* -Array indexes for vectors. -*/ - -#define SpiceX 0 -#define SpiceY 1 -#define SpiceZ 2 -#define SpiceVx 3 -#define SpiceVy 4 -#define SpiceVz 5 - - - - -/* -Physical constants and dates. -*/ - -#define B1900 2415020.31352 -#define J1900 2415020.0 -#define JYEAR 31557600.0 -#define TYEAR 31556925.9747 -#define J1950 2433282.5 -#define SPD 86400.0 -#define B1950 2433282.42345905 -#define J2100 2488070.0 -#define CLIGHT 299792.458 -#define J2000 2451545.0 - - - - - -/* -Common literal values. -*/ - -#define NULLCHAR ( (SpiceChar ) 0 ) -#define NULLCPTR ( (SpiceChar * ) 0 ) -#define BLANK ( (SpiceChar ) ' ' ) - - - -/* -Macro CHKPTR is used for checking for a null pointer. CHKPTR uses -the constants - - CHK_STANDARD - CHK_DISCOVER - CHK_REMAIN - -to control tracing behavior. Values and meanings are: - - CHK_STANDARD Standard tracing. If an error - is found, signal it, check out - and return. - - CHK_DISCOVER Discovery check-in. If an - error is found, check in, signal - the error, check out, and return. - - CHK_REMAIN If an error is found, signal it. - Do not check out or return. This - would allow the caller to clean up - before returning, if necessary. - In such cases the caller must test - failed_c() after the macro call. - -CHKPTR should be used in void functions. In non-void functions, -use CHKPTR_VAL, which is defined below. - -*/ - -#define CHK_STANDARD 1 -#define CHK_DISCOVER 2 -#define CHK_REMAIN 3 - -#define CHKPTR( errHandling, modname, pointer ) \ - \ - if ( (void *)(pointer) == (void *)0 ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Pointer \"#\" is null; a non-null " \ - "pointer is required." ); \ - errch_c ( "#", (#pointer) ); \ - sigerr_c ( "SPICE(NULLPOINTER)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - -#define CHKPTR_VAL( errHandling, modname, pointer, retval ) \ - \ - if ( (void *)(pointer) == (void *)0 ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Pointer \"#\" is null; a non-null " \ - "pointer is required." ); \ - errch_c ( "#", (#pointer) ); \ - sigerr_c ( "SPICE(NULLPOINTER)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - -/* -Macro CHKFSTR checks strings that are to be passed to Fortran or -f2c'd Fortran routines. Such strings must have non-zero length, -and their pointers must be non-null. - -CHKFSTR should be used in void functions. In non-void functions, -use CHKFSTR_VAL, which is defined below. -*/ - -#define CHKFSTR( errHandling, modname, string ) \ - \ - CHKPTR ( errHandling, modname, string ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( strlen(string) == 0 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length zero." ); \ - errch_c ( "#", (#string) ); \ - sigerr_c ( "SPICE(EMPTYSTRING)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - -#define CHKFSTR_VAL( errHandling, modname, string, retval ) \ - \ - CHKPTR_VAL( errHandling, modname, string, retval); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( strlen(string) == 0 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length zero." ); \ - errch_c ( "#", (#string) ); \ - sigerr_c ( "SPICE(EMPTYSTRING)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - -/* -Macro CHKOSTR checks output string pointers and the associated -string length values supplied as input arguments. Output string -pointers must be non-null, and the string lengths must be at -least 2, so Fortran routine can write at least one character to -the output string, and so a null terminator can be appended. -CHKOSTR should be used in void functions. In non-void functions, -use CHKOSTR_VAL, which is defined below. -*/ - -#define CHKOSTR( errHandling, modname, string, length ) \ - \ - CHKPTR ( errHandling, modname, string ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( length < 2 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length #; must be >= 2." ); \ - errch_c ( "#", (#string) ); \ - errint_c ( "#", (length) ); \ - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - -#define CHKOSTR_VAL( errHandling, modname, string, length, retval ) \ - \ - CHKPTR_VAL( errHandling, modname, string, retval ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( length < 2 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length #; must be >= 2." ); \ - errch_c ( "#", (#string) ); \ - errint_c ( "#", (length) ); \ - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - - /* - Definitions for Cells and Sets - */ - - - /* - Cell initialization macros - */ - #define CELLINIT( cellPtr ) \ - \ - if ( !( (cellPtr)->init ) ) \ - { \ - if ( (cellPtr)->dtype == SPICE_CHR ) \ - { \ - /* \ - Make sure all elements of the data array, including \ - the control area, start off null-terminated. We place \ - the null character in the final element of each string, \ - so as to avoid wiping out data that may have been \ - assigned to the data array prior to initialization. \ - */ \ - SpiceChar * sPtr; \ - SpiceInt i; \ - SpiceInt nmax; \ - \ - nmax = SPICE_CELL_CTRLSZ + (cellPtr)->size; \ - \ - for ( i = 1; i <= nmax; i++ ) \ - { \ - sPtr = (SpiceChar *)((cellPtr)->base) \ - + i * (cellPtr)->length \ - - 1; \ - \ - *sPtr = NULLCHAR; \ - } \ - } \ - else \ - { \ - zzsynccl_c ( C2F, (cellPtr) ); \ - } \ - \ - (cellPtr)->init = SPICETRUE; \ - } - - - #define CELLINIT2( cellPtr1, cellPtr2 ) \ - \ - CELLINIT ( cellPtr1 ); \ - CELLINIT ( cellPtr2 ); - - - #define CELLINIT3( cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLINIT ( cellPtr1 ); \ - CELLINIT ( cellPtr2 ); \ - CELLINIT ( cellPtr3 ); - - - /* - Data type checking macros: - */ - #define CELLTYPECHK( errHandling, modname, dType, cellPtr1 ) \ - \ - if ( (cellPtr1)->dtype != (dType) ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; expected type " \ - "is #." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", typstr[ dType ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - - #define CELLTYPECHK_VAL( errHandling, modname, \ - dType, cellPtr1, retval ) \ - \ - if ( (cellPtr1)->dtype != (dType) ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; expected type " \ - "is #." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", typstr[ dType ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return (retval); \ - } \ - } - - - #define CELLTYPECHK2( errHandling, modname, dtype, \ - cellPtr1, cellPtr2 ) \ - \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr1 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr2 ); - - - - #define CELLTYPECHK2_VAL( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, retval ) \ - \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr1, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr2, \ - retval ); - - - - #define CELLTYPECHK3( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr1 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr2 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr3 ); - - - #define CELLTYPECHK3_VAL( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, cellPtr3, \ - retval ) \ - \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr1, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr2, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr3 \ - retval ); - - - - #define CELLMATCH2( errHandling, modname, cellPtr1, cellPtr2 ) \ - \ - if ( (cellPtr1)->dtype != (cellPtr2)->dtype ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; data type of # " \ - "is #, but types must match." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", (#cellPtr2) ); \ - errch_c ( "#", typstr[ (cellPtr2)->dtype ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - #define CELLMATCH2_VAL( errHandling, modname, \ - cellPtr1, cellPtr2, retval ) \ - \ - if ( (cellPtr1)->dtype != (cellPtr2)->dtype ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; data type of # " \ - "is #, but types must match." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr [ (cellPtr1)->dtype ] ); \ - errch_c ( "#", (#cellPtr2) ); \ - errch_c ( "#", typstr [ (cellPtr2)->dtype ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - - #define CELLMATCH3( errHandling, modname, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLMATCH2 ( errHandling, modname, cellPtr1, cellPtr2 ); \ - CELLMATCH2 ( errHandling, modname, cellPtr2, cellPtr3 ); - - - - - #define CELLMATCH3_VAL( errHandling, modname, cellPtr1, \ - cellPtr2, cellPtr3, retval ) \ - \ - CELLMATCH2_VAL ( errHandling, modname, \ - cellPtr1, cellPtr2, retval ); \ - \ - CELLMATCH2_VAL ( errHandling, modname, \ - cellPtr2, cellPtr3, retval ); - - /* - Set checking macros: - */ - #define CELLISSETCHK( errHandling, modname, cellPtr1 ) \ - \ - if ( !(cellPtr1)->isSet ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Cell # must be sorted and have unique " \ - "values in order to be a CSPICE set. " \ - "The isSet flag in this cell is SPICEFALSE, " \ - "indicating the cell may have been modified " \ - "by a routine that doesn't preserve these " \ - "properties." ); \ - errch_c ( "#", (#cellPtr1) ); \ - sigerr_c ( "SPICE(NOTASET)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - - #define CELLISSETCHK_VAL( errHandling, modname, \ - cellPtr1, retval ) \ - \ - if ( !(cellPtr1)->isSet ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Cell # must be sorted and have unique " \ - "values in order to be a CSPICE set. " \ - "The isSet flag in this cell is SPICEFALSE, " \ - "indicating the cell may have been modified " \ - "by a routine that doesn't preserve these " \ - "properties." ); \ - errch_c ( "#", (#cellPtr1) ); \ - sigerr_c ( "SPICE(NOTASET)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return (retval); \ - } \ - } - - - #define CELLISSETCHK2( errHandling, modname, \ - cellPtr1, cellPtr2 ) \ - \ - CELLISSETCHK( errHandling, modname, cellPtr1 ); \ - CELLISSETCHK( errHandling, modname, cellPtr2 ); - - - - #define CELLISSETCHK2_VAL( errHandling, modname, \ - cellPtr1, cellPtr2, retval ) \ - \ - CELLISSETCHK_VAL( errHandling, modname, cellPtr1, retval ); \ - CELLISSETCHK_VAL( errHandling, modname, cellPtr2, retval ); \ - - - - #define CELLISSETCHK3( errHandling, modname, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLISSETCHK ( errHandling, modname, cellPtr1 ); \ - CELLISSETCHK ( errHandling, modname, cellPtr2 ); \ - CELLISSETCHK ( errHandling, modname, cellPtr3 ); - - - #define CELLISSETCHK3_VAL( errHandling, modname, cellPtr1, \ - cellPtr2, cellPtr3, retval ) \ - \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr1, retval ); \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr2, retval ); \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr3, retval ); - - - /* - C-to-Fortran and Fortran-to-C character cell translation macros: - */ - - /* - Macros that map one or more character C cells to dynamically - allocated Fortran-style character cells: - */ - #define C2F_MAP_CELL( caller, CCell, fCell, fLen ) \ - \ - { \ - /* \ - fCell and fLen are to be passed by reference, as if this \ - macro were a function. \ - \ - \ - Caution: dynamically allocates array fCell, which is to be \ - freed by caller! \ - */ \ - SpiceInt ndim; \ - SpiceInt lenvals; \ - \ - \ - ndim = (CCell)->size + SPICE_CELL_CTRLSZ; \ - lenvals = (CCell)->length; \ - \ - C2F_MapFixStrArr ( (caller), ndim, lenvals, \ - (CCell)->base, (fLen), (fCell) ); \ - \ - if ( !failed_c() ) \ - { \ - /* \ - Explicitly set the control area info in the Fortran cell.\ - */ \ - ssizec_ ( ( integer * ) &((CCell)->size), \ - ( char * ) *(fCell), \ - ( ftnlen ) *(fLen) ); \ - \ - scardc_ ( ( integer * ) &((CCell)->card), \ - ( char * ) *(fCell), \ - ( ftnlen ) *(fLen) ); \ - \ - if ( failed_c() ) \ - { \ - /* \ - Setting size or cardinality of the Fortran cell \ - can fail, for example if the cell's string length \ - is too short. \ - */ \ - free ( *(fCell) ); \ - } \ - } \ - } - - - #define C2F_MAP_CELL2( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2 ) \ - \ - { \ - C2F_MAP_CELL( caller, CCell1, fCell1, fLen1 ); \ - \ - if ( !failed_c() ) \ - { \ - C2F_MAP_CELL( caller, CCell2, fCell2, fLen2 ); \ - \ - if ( failed_c() ) \ - { \ - free ( *(fCell1) ); \ - } \ - } \ - } - - - #define C2F_MAP_CELL3( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2, \ - CCell3, fCell3, fLen3 ) \ - \ - { \ - C2F_MAP_CELL2( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2 ); \ - \ - if ( !failed_c() ) \ - { \ - C2F_MAP_CELL( caller, CCell3, fCell3, fLen3 ); \ - \ - if ( failed_c() ) \ - { \ - free ( *(fCell1) ); \ - free ( *(fCell2) ); \ - } \ - } \ - } - - - - /* - Macro that maps a Fortran-style character cell to a C cell - (Note: this macro frees the Fortran cell): - */ - - #define F2C_MAP_CELL( fCell, fLen, CCell ) \ - \ - { \ - SpiceInt card; \ - SpiceInt lenvals; \ - SpiceInt ndim; \ - SpiceInt nBytes; \ - SpiceInt size; \ - void * array; \ - \ - ndim = (CCell)->size + SPICE_CELL_CTRLSZ; \ - lenvals = (CCell)->length; \ - array = (CCell)->base; \ - \ - /* \ - Capture the size and cardinality of the Fortran cell. \ - */ \ - if ( !failed_c() ) \ - { \ - size = sizec_ ( ( char * ) (fCell), \ - ( ftnlen ) fLen ); \ - \ - card = cardc_ ( ( char * ) (fCell), \ - ( ftnlen ) fLen ); \ - } \ - \ - \ - /* \ - Copy the Fortran array into the output array. \ - */ \ - \ - nBytes = ndim * fLen * sizeof(SpiceChar); \ - memmove ( array, fCell, nBytes ); \ - /* \ - Convert the output array from Fortran to C style. \ - */ \ - F2C_ConvertTrStrArr ( ndim, lenvals, (SpiceChar *)array ); \ - \ - /* \ - Sync the size and cardinality of the C cell. \ - */ \ - if ( !failed_c() ) \ - { \ - (CCell)->size = size; \ - (CCell)->card = card; \ - } \ - } - - - -/* - End of header SpiceZmc.h -*/ diff --git a/ext/spice/src/cspice/SpiceZpl.h b/ext/spice/src/cspice/SpiceZpl.h deleted file mode 100644 index 1413202b69..0000000000 --- a/ext/spice/src/cspice/SpiceZpl.h +++ /dev/null @@ -1,109 +0,0 @@ -/* - --Header_File SpiceZpl.h ( CSPICE platform macros ) - --Abstract - - Define macros identifying the host platform for which this - version of CSPICE is targeted. - --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. - --Literature_References - - None. - --Particulars - - This header file defines macros that enable CSPICE code to be - compiled conditionally based on the identity of the host platform. - - The macros defined here ARE visible in the macro name space of - any file that includes SpiceUsr.h. The names are prefixed with - the string CSPICE_ to help prevent conflicts with macros defined - by users' applications. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.2.0, 14-MAY-2010 (EDW)(BVS) - - Updated for the: - - MAC-OSX-64BIT-INTEL_C - PC-64BIT-MS_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - SUN-SOLARIS-INTEL-CC_C - - environments. - - -CSPICE Version 2.1.0, 15-NOV-2006 (BVS) - - Updated for MAC-OSX-INTEL_C environment. - - -CSPICE Version 2.0.0, 21-FEB-2006 (NJB) - - Updated for PC-LINUX-64BIT-GCC_C environment. - - -CSPICE Version 1.3.0, 06-MAR-2005 (NJB) - - Updated for SUN-SOLARIS-64BIT-GCC_C environment. - - -CSPICE Version 1.2.0, 03-JAN-2005 (BVS) - - Updated for PC-CYGWIN_C environment. - - -CSPICE Version 1.1.0, 27-JUL-2002 (BVS) - - Updated for MAC-OSX-NATIVE_C environment. - - -CSPICE Version 1.0.0, 26-FEB-1999 (NJB) (EDW) - --Index_Entries - - platform ID defines for CSPICE - -*/ - - -#ifndef HAVE_PLATFORM_MACROS_H -#define HAVE_PLATFORM_MACROS_H - - - #define CSPICE_PC_LINUX_64BIT_GCC - -#endif - diff --git a/ext/spice/src/cspice/SpiceZpr.h b/ext/spice/src/cspice/SpiceZpr.h deleted file mode 100644 index b4d672e98c..0000000000 --- a/ext/spice/src/cspice/SpiceZpr.h +++ /dev/null @@ -1,3853 +0,0 @@ -/* - --Header_File SpiceZpr.h ( CSPICE prototypes ) - --Abstract - - Define prototypes for CSPICE user-interface-level functions. - --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. - --Literature_References - - None. - --Particulars - - This is the header file containing prototypes for CSPICE user-level - C routines. Prototypes for the underlying f2c'd SPICELIB routines - are contained in the separate header file SpiceZfc. However, those - routines are not part of the official CSPICE API. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 12.12.0, 19-FEB-2010 (EDW) (NJB) - - Added prototypes for - - bodc2s_c - dafgsr_c - dafrfr_c - dp2hx_c - ducrss_c - dvcrss_c - dvnorm_c - gfrr_c - gfuds_c - hx2dp_c - uddc_c - uddf_c - - -CSPICE Version 12.11.0, 29-MAR-2009 (EDW) (NJB) - - Added prototypes for - - dvsep_c - gfbail_c - gfclrh_c - gfdist_c - gfevnt_c - gffove_c - gfinth_c - gfocce_c - gfoclt_c - gfposc_c - gfrefn_c - gfrepf_c - gfrepi_c - gfrepu_c - gfrfov_c - gfsep_c - gfseth_c - gfsntc_c - gfsstp_c - gfstep_c - gfsubc_c - gftfov_c - surfpv_c - zzgfgeth_c - zzgfsavh_c - - -CSPICE Version 12.10.0, 30-JAN-2008 (EDW) (NJB) - - Added prototypes for: - - ilumin_c - pckcov_c - pckfrm_c - sincpt_c - spkacs_c - spkaps_c - spkltc_c - subpnt_c - subslr_c - wncard_c - - -CSPICE Version 12.9.0, 16-NOV-2006 (NJB) - - Bug fix: corrected prototype for vhatg_c. - - Renamed wnfild_c and wnfltd_c arguments `small' to 'smal' for - compatibility with MS Visual C++. - - Added prototypes for - - dafac_c - dafdc_c - dafec_c - dafgda_c - dascls_c - dasopr_c - kclear_c - - -CSPICE Version 12.8.0, 07-NOV-2005 (NJB) - - Added prototypes for - - bodvcd_c - qdq2av_c - qxq_c - srfrec_c - - -CSPICE Version 12.7.0, 06-JAN-2004 (NJB) - - Added prototypes for - - bods2c_c - ckcov_c - ckobj_c - dafopw_c - dafrs_c - dpgrdr_c - drdpgr_c - lspcn_c - pgrrec_c - recpgr_c - spkcov_c - spkobj_c - - -CSPICE Version 12.6.0, 24-FEB-2003 (NJB) - - Added prototype for - - bodvrd_c - deltet_c - srfxpt_c - - -CSPICE Version 12.5.0, 14-MAY-2003 (NJB) - - Removed prototype for getcml_. - - - -CSPICE Version 12.4.0, 25-FEB-2003 (NJB) - - Added prototypes for - - dasac_c - dasec_c - et2lst_c - - -CSPICE Version 12.3.0, 03-SEP-2002 (NJB) - - Added prototypes for - - appndc_c - appndd_c - appndi_c - bschoc_c - bschoi_c - bsrchc_c - bsrchd_c - bsrchi_c - card_c - ckw05_c - copy_c - cpos_c - cposr_c - diff_c - elemc_c - elemd_c - elemi_c - esrchc_c - insrtc_c - insrtd_c - insrti_c - inter_c - isordv_c - isrchc_c - isrchd_c - isrchi_c - lparss_c - lstlec_c - lstled_c - lstlei_c - lstltc_c - lstltd_c - lstlti_c - lx4dec_c - lx4num_c - lx4sgn_c - lx4uns_c - lxqstr_c - ncpos_c - ncposr_c - ordc_c - ordd_c - ordi_c - orderc_c - orderd_c - orderi_c - pos_c - posr_c - prefix_c - remove_c - reordc_c - reordd_c - reordi_c - reordl_c - removc_c - removd_c - removi_c - repmc_c - repmct_c - repmd_c - repmf_c - repmi_c - repmot_c - scard_c - sdiff_c - set_c - shellc_c - shelld_c - shelli_c - size_c - scard_c - spkw18_c - ssize_c - union_c - valid_c - wncomd_c - wncond_c - wndifd_c - wnelmd_c - wnexpd_c - wnextd_c - wnfetd_c - wnfild_c - wnfltd_c - wnincd_c - wninsd_c - wnintd_c - wnreld_c - wnsumd_c - wnunid_c - wnvald_c - zzsynccl_c - - - -CSPICE Version 12.2.0, 23-OCT-2001 (NJB) - - Added prototypes for - - badkpv_c - dcyldr_c - dgeodr_c - dlatdr_c - drdcyl_c - drdgeo_c - drdlat_c - drdsph_c - dsphdr_c - ekacec_c - ekaced_c - ekacei_c - ekappr_c - ekbseg_c - ekccnt_c - ekcii_c - ekdelr_c - ekinsr_c - ekntab_c - ekrcec_c - ekrced_c - ekrcei_c - ektnam_c - ekucec_c - ekuced_c - ekucei_c - inelpl_c - invort_c - kxtrct_c - - Added const qualifier to input array arguments of - - conics_c - illum_c - pdpool_c - prop2b_c - q2m_c - spkuds_c - xposeg_c - - Added const qualifier to the return value of - - tkvrsn_c - - -CSPICE Version 12.1.0, 12-APR-2000 (FST) - - Added prototype for - - getfov_c - - -CSPICE Version 12.0.0, 22-MAR-2000 (NJB) - - Added prototypes for - - lparse_c - lparsm_c - spkw12_c - spkw13_c - - - -CSPICE Version 11.1.0, 17-DEC-1999 (WLT) - - Added prototype for - - dafrda_c - - -CSPICE Version 11.0.0, 07-OCT-1999 (NJB) (EDW) - - Changed ekaclc_c, ekacld_c, ekacli_c prototypes to make input - pointers const-qualified where appropriate. - - Changed prompt_c prototype to accommodate memory leak bug fix. - - Changed ekpsel_c prototype to be consistent with other interfaces - having string array outputs. - - Added prototypes for - - axisar_c - brcktd_c - brckti_c - cidfrm_c - cgv2el_c - clpool_c - cmprss_c - cnmfrm_c - convrt_c - cvpool_c - dafbbs_c - dafbfs_c - dafcls_c - dafcs_c - daffna_c - daffpa_c - dafgh_c - dafgn_c - dafgs_c - dafopr_c - dafps_c - dafus_c - diags2_c - dtpool_c - dvdot_c - dvhat_c - dvpool_c - edlimb_c - ekops_c - ekopw_c - eul2xf_c - ftncls_c - furnsh_c - getmsg_c - getelm_c - gnpool_c - ident_c - illum_c - inedpl_c - kdata_c - kinfo_c - ktotal_c - lmpool_c - matchi_c - matchw_c - maxd_c - maxi_c - mequ_c - mind_c - mini_c - moved_ - npedln_c - npelpt_c - nplnpt_c - pcpool_c - pdpool_c - pipool_c - pjelpl_c - pxform_c - rav2xf_c - raxisa_c - rquad_c - saelgv_c - spk14a_c - spk14b_c - spk14e_c - spkapp_c - spkapo_c - spkcls_c - spkezp_c - spkgps_c - spkopn_c - spkpds_c - spkpos_c - spkssb_c - spksub_c - spkuds_c - spkw02_c - spkw03_c - spkw05_c - spkw08_c - spkw09_c - spkw10_c - spkw15_c - spkw17_c - stpool_c - subpt_c - subsol_c - swpool_c - szpool_c - tparse_c - trace_c - unload_c - vaddg_c - vhatg_c - vlcomg_c - vminug_c - vrel_c - vrelg_c - vsepg_c - vtmv_c - vtmvg_c - vzerog_c - xf2eul_c - xf2rav_c - xposeg_c - - - -CSPICE Version 10.0.0, 09-MAR-1999 (NJB) - - Added prototypes for - - frame_c - inrypl_c - nvc2pl_c - nvp2pl_c - pl2nvc_c - pl2nvp_c - pl2psv_c - psv2pl_c - sce2c_c - vprjp_c - vprjpi_c - - Now conditionally includes SpiceEll.h and SpicePln.h. - - - -CSPICE Version 9.0.0, 25-FEB-1999 (NJB) - - Added prototypes for - - eknseg_c - eknelt_c - ekpsel_c - ekssum_c - - Now conditionally includes SpiceEK.h. - - - -CSPICE Version 8.0.0, 20-OCT-1998 (NJB) - - Added const qualifier to all input matrix and vector arguments. - - Added prototypes for - - det_c - dpmax_c - dpmax_ - dpmin_c - dpmin_ - frinfo_c - frmnam_c - getfat_c - intmax_c - intmax_ - intmin_c - intmin_ - invert_c - namfrm_c - vrotv_c - vsclg_c - - - -CSPICE Version 7.0.0, 02-APR-1998 (EDW) - - Added prototypes for - - mequg_c - unormg_g - vdistg_c - vdotg_c - vequg_c - vnormg_c - - -CSPICE Version 6.0.0, 31-MAR-1998 (NJB) - - Added prototypes for - - ekaclc_c - ekacld_c - ekacli_c - ekcls_c - ekffld_c - ekfind_c - ekgc_c - ekgd_c - ekgi_c - ekifld_c - eklef_c - ekopr_c - ekopn_c - ekuef_c - - -CSPICE Version 5.0.1, 05-MAR-1998 (EDW) - - Remove some non printing characters. - - -CSPICE Version 5.0.0, 03-MAR-1998 (NJB) - - Added prototypes for - - etcal_c - ltime_c - stelab_c - tpictr_c - twovec_c - vsubg_c - - -CSPICE Version 4.0.0, 11-FEB-1998 (EDW) - - Added prototypes for - - timdef_c - tsetyr_c - - - -CSPICE Version 3.0.0, 02-FEB-1998 (NJB) - - Added prototypes for - - pckuof_c - tipbod_c - - Type SpiceVoid was replaced with void. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - Changed all input-only character pointers to type ConstSpiceChar. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - prototypes of CSPICE functions - -*/ - - -/* -Include Files: -*/ - - -#ifndef HAVE_SPICEDEFS_H -#include "SpiceZdf.h" -#endif - -#ifndef HAVE_SPICE_EK_H -#include "SpiceEK.h" -#endif - -#ifndef HAVE_SPICE_PLANES_H -#include "SpicePln.h" -#endif - -#ifndef HAVE_SPICE_ELLIPSES_H -#include "SpiceEll.h" -#endif - -#ifndef HAVE_SPICE_CELLS_H -#include "SpiceCel.h" -#endif - -#ifndef HAVE_SPICE_SPK_H -#include "SpiceSPK.h" -#endif - -#ifndef HAVE_SPICEWRAPPERS_H -#define HAVE_SPICEWRAPPERS_H - - - - -/* - Function prototypes for CSPICE functions are listed below. - Each prototype is accompanied by a function abstract and brief I/O - description. - - See the headers of the C wrappers for detailed descriptions of the - routines' interfaces. - - The list below should be maintained in alphabetical order. -*/ - - void appndc_c ( ConstSpiceChar * item, - SpiceCell * cell ); - - - void appndd_c ( SpiceDouble item, - SpiceCell * cell ); - - - void appndi_c ( SpiceInt item, - SpiceCell * cell ); - - - void axisar_c ( ConstSpiceDouble axis [3], - SpiceDouble angle, - SpiceDouble r [3][3] ); - - - SpiceBoolean badkpv_c ( ConstSpiceChar *caller, - ConstSpiceChar *name, - ConstSpiceChar *comp, - SpiceInt size, - SpiceInt divby, - SpiceChar type ); - - - void bodc2n_c ( SpiceInt code, - SpiceInt namelen, - SpiceChar * name, - SpiceBoolean * found ); - - - void bodc2s_c ( SpiceInt code, - SpiceInt lenout, - SpiceChar * name ); - - void boddef_c ( ConstSpiceChar * name, - SpiceInt code ); - - - SpiceBoolean bodfnd_c ( SpiceInt body, - ConstSpiceChar * item ); - - - void bodn2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ); - - - void bods2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ); - - - void bodvar_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt * dim , - SpiceDouble * values ); - - - void bodvcd_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim , - SpiceDouble * values ); - - - void bodvrd_c ( ConstSpiceChar * body, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim , - SpiceDouble * values ); - - - SpiceDouble brcktd_c ( SpiceDouble number, - SpiceDouble end1, - SpiceDouble end2 ); - - - SpiceInt brckti_c ( SpiceInt number, - SpiceInt end1, - SpiceInt end2 ); - - - SpiceInt bschoc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array, - ConstSpiceInt * order ); - - - SpiceInt bschoi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array, - ConstSpiceInt * order ); - - - SpiceInt bsrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - SpiceInt bsrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ); - - - SpiceInt bsrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ); - - - SpiceDouble b1900_c ( void ); - - - SpiceDouble b1950_c ( void ); - - - SpiceInt card_c ( SpiceCell * cell ); - - - void cgv2el_c ( ConstSpiceDouble center[3], - ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceEllipse * ellipse ); - - - void chkin_c ( ConstSpiceChar * module ); - - - void chkout_c ( ConstSpiceChar * module ); - - - void cidfrm_c ( SpiceInt cent, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ); - - - void ckcls_c ( SpiceInt handle ); - - - void ckcov_c ( ConstSpiceChar * ck, - SpiceInt idcode, - SpiceBoolean needav, - ConstSpiceChar * level, - SpiceDouble tol, - ConstSpiceChar * timsys, - SpiceCell * cover ); - - - void ckobj_c ( ConstSpiceChar * ck, - SpiceCell * ids ); - - - void ckgp_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble * clkout, - SpiceBoolean * found ); - - - void ckgpav_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble av[3], - SpiceDouble * clkout, - SpiceBoolean * found ); - - - void cklpf_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ckopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void ckupf_c ( SpiceInt handle ); - - - void ckw01_c ( SpiceInt handle, - SpiceDouble begtime, - SpiceDouble endtime, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3] ); - - - void ckw02_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble start [], - ConstSpiceDouble stop [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - ConstSpiceDouble rates [] ); - - - void ckw03_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - SpiceInt nints, - ConstSpiceDouble starts [] ); - - - void ckw05_c ( SpiceInt handle, - SpiceCK05Subtype subtyp, - SpiceInt degree, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt n, - ConstSpiceDouble sclkdp[], - const void * packets, - SpiceDouble rate, - SpiceInt nints, - ConstSpiceDouble starts[] ); - - - SpiceDouble clight_c ( void ); - - - void clpool_c ( void ); - - - void cmprss_c ( SpiceChar delim, - SpiceInt n, - ConstSpiceChar * input, - SpiceInt lenout, - SpiceChar * output ); - - - void cnmfrm_c ( ConstSpiceChar * cname, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ); - - - void conics_c ( ConstSpiceDouble elts[8], - SpiceDouble et, - SpiceDouble state[6] ); - - - void convrt_c ( SpiceDouble x, - ConstSpiceChar * in, - ConstSpiceChar * out, - SpiceDouble * y ); - - - void copy_c ( SpiceCell * a, - SpiceCell * b ); - - - - SpiceInt cpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - SpiceInt cposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - void cvpool_c ( ConstSpiceChar * agent, - SpiceBoolean * update ); - - - void cyllat_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ); - - - void cylrec_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble rectan[3] ); - - - void cylsph_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * colat, - SpiceDouble * lon ); - - - void dafac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt lenvals, - const void * buffer ); - - - void dafbbs_c ( SpiceInt handle ); - - - void dafbfs_c ( SpiceInt handle ); - - - void dafcls_c ( SpiceInt handle ); - - - void dafcs_c ( SpiceInt handle ); - - - void dafdc_c ( SpiceInt handle ); - - - void dafec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt lenout, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ); - - - void daffna_c ( SpiceBoolean * found ); - - - void daffpa_c ( SpiceBoolean * found ); - - - void dafgda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ); - - - void dafgh_c ( SpiceInt * handle ); - - - void dafgn_c ( SpiceInt lenout, - SpiceChar * name ); - - - void dafgs_c ( SpiceDouble sum[] ); - - - void dafgsr_c ( SpiceInt handle, - SpiceInt recno, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data, - SpiceBoolean * found ); - - - void dafopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dafopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dafps_c ( SpiceInt nd, - SpiceInt ni, - ConstSpiceDouble dc [], - ConstSpiceInt ic [], - SpiceDouble sum [] ); - - - void dafrda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ); - - - - void dafrfr_c ( SpiceInt handle, - SpiceInt lenout, - SpiceInt * nd, - SpiceInt * ni, - SpiceChar * ifname, - SpiceInt * fward, - SpiceInt * bward, - SpiceInt * free ); - - - - void dafrs_c ( ConstSpiceDouble * sum ); - - - void dafus_c ( ConstSpiceDouble sum [], - SpiceInt nd, - SpiceInt ni, - SpiceDouble dc [], - SpiceInt ic [] ); - - - void dasac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt buflen, - const void * buffer ); - - - void dascls_c ( SpiceInt handle ); - - - void dasec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt buflen, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ); - - - void dasopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dcyldr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void deltet_c ( SpiceDouble epoch, - ConstSpiceChar * eptype, - SpiceDouble * delta ); - - - SpiceDouble det_c ( ConstSpiceDouble m1[3][3] ); - - - void diags2_c ( ConstSpiceDouble symmat [2][2], - SpiceDouble diag [2][2], - SpiceDouble rotate [2][2] ); - - - void diff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void dgeodr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void dlatdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - void dp2hx_c ( SpiceDouble number, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * length - ); - - void dpgrdr_c ( ConstSpiceChar * body, - SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - SpiceDouble dpmax_c ( void ); - - - SpiceDouble dpmax_ ( void ); - - - SpiceDouble dpmin_c ( void ); - - - SpiceDouble dpmin_ ( void ); - - - SpiceDouble dpr_c ( void ); - - - void drdcyl_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void drdgeo_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void drdlat_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble jacobi[3][3] ); - - - void drdpgr_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void drdsph_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble jacobi[3][3] ); - - - void dsphdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void dtpool_c ( ConstSpiceChar * name, - SpiceBoolean * found, - SpiceInt * n, - SpiceChar type [1] ); - - - void ducrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ); - - - void dvcrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ); - - - SpiceDouble dvdot_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6] ); - - - void dvhat_c ( ConstSpiceDouble s1 [6], - SpiceDouble sout[6] ); - - SpiceDouble dvnorm_c ( ConstSpiceDouble state[6] ); - - void dvpool_c ( ConstSpiceChar * name ); - - - SpiceDouble dvsep_c ( ConstSpiceDouble * s1, - ConstSpiceDouble * s2 ); - - - void edlimb_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble viewpt[3], - SpiceEllipse * limb ); - - - void ekacec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ); - - - void ekaced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ); - - - void ekacei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ); - - - void ekaclc_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - SpiceInt vallen, - const void * cvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekacld_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceDouble * dvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekacli_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceInt * ivals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekappr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * recno ); - - - void ekbseg_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno ); - - - void ekccnt_c ( ConstSpiceChar * table, - SpiceInt * ccount ); - - - void ekcii_c ( ConstSpiceChar * table, - SpiceInt cindex, - SpiceInt lenout, - SpiceChar * column, - SpiceEKAttDsc * attdsc ); - - - void ekcls_c ( SpiceInt handle ); - - - void ekdelr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ); - - - void ekffld_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * rcptrs ); - - - void ekfind_c ( ConstSpiceChar * query, - SpiceInt lenout, - SpiceInt * nmrows, - SpiceBoolean * error, - SpiceChar * errmsg ); - - - void ekgc_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt lenout, - SpiceChar * cdata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekgd_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceDouble * ddata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekgi_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt * idata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekifld_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt nrows, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno, - SpiceInt * rcptrs ); - - - void ekinsr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ); - - - void eklef_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - SpiceInt eknelt_c ( SpiceInt selidx, - SpiceInt row ); - - - SpiceInt eknseg_c ( SpiceInt handle ); - - - void ekntab_c ( SpiceInt * n ); - - - void ekopn_c ( ConstSpiceChar * fname, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void ekopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ekops_c ( SpiceInt * handle ); - - - void ekopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ekpsel_c ( ConstSpiceChar * query, - SpiceInt msglen, - SpiceInt tablen, - SpiceInt collen, - SpiceInt * n, - SpiceInt * xbegs, - SpiceInt * xends, - SpiceEKDataType * xtypes, - SpiceEKExprClass * xclass, - void * tabs, - void * cols, - SpiceBoolean * error, - SpiceChar * errmsg ); - - - void ekrcec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt lenout, - SpiceInt * nvals, - void * cvals, - SpiceBoolean * isnull ); - - - void ekrced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceDouble * dvals, - SpiceBoolean * isnull ); - - - void ekrcei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceInt * ivals, - SpiceBoolean * isnull ); - - - void ekssum_c ( SpiceInt handle, - SpiceInt segno, - SpiceEKSegSum * segsum ); - - - void ektnam_c ( SpiceInt n, - SpiceInt lenout, - SpiceChar * table ); - - - void ekucec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ); - - - void ekuced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ); - - - void ekucei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ); - - - void ekuef_c ( SpiceInt handle ); - - - SpiceBoolean elemc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - SpiceBoolean elemd_c ( SpiceDouble item, - SpiceCell * set ); - - - SpiceBoolean elemi_c ( SpiceInt item, - SpiceCell * set ); - - - SpiceBoolean eqstr_c ( ConstSpiceChar * a, - ConstSpiceChar * b ); - - - void el2cgv_c ( ConstSpiceEllipse * ellipse, - SpiceDouble center[3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ); - - - void erract_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * action ); - - - void errch_c ( ConstSpiceChar * marker, - ConstSpiceChar * string ); - - - void errdev_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * device ); - - - void errdp_c ( ConstSpiceChar * marker, - SpiceDouble number ); - - - void errint_c ( ConstSpiceChar * marker, - SpiceInt number ); - - - void errprt_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * list ); - - - SpiceInt esrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - void etcal_c ( SpiceDouble et, - SpiceInt lenout, - SpiceChar * string ); - - - void et2lst_c ( SpiceDouble et, - SpiceInt body, - SpiceDouble lon, - ConstSpiceChar * type, - SpiceInt timlen, - SpiceInt ampmlen, - SpiceInt * hr, - SpiceInt * mn, - SpiceInt * sc, - SpiceChar * time, - SpiceChar * ampm ); - - - void et2utc_c ( SpiceDouble et , - ConstSpiceChar * format, - SpiceInt prec, - SpiceInt lenout, - SpiceChar * utcstr ); - - - void eul2m_c ( SpiceDouble angle3, - SpiceDouble angle2, - SpiceDouble angle1, - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble r [3][3] ); - - - void eul2xf_c ( ConstSpiceDouble eulang[6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble xform [6][6] ); - - - SpiceBoolean exists_c ( ConstSpiceChar * name ); - - - void expool_c ( ConstSpiceChar * name, - SpiceBoolean * found ); - - - SpiceBoolean failed_c ( void ); - - - void frame_c ( SpiceDouble x[3], - SpiceDouble y[3], - SpiceDouble z[3] ); - - - void frinfo_c ( SpiceInt frcode, - SpiceInt * cent, - SpiceInt * clss, - SpiceInt * clssid, - SpiceBoolean * found ); - - - void frmnam_c ( SpiceInt frcode, - SpiceInt lenout, - SpiceChar * frname ); - - - void ftncls_c ( SpiceInt unit ); - - - void furnsh_c ( ConstSpiceChar * file ); - - - void gcpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * cvals, - SpiceBoolean * found ); - - - void gdpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceDouble * values, - SpiceBoolean * found ); - - - void georec_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ); - - - void getcml_c ( SpiceInt * argc, - SpiceChar *** argv ); - - - void getelm_c ( SpiceInt frstyr, - SpiceInt lineln, - const void * lines, - SpiceDouble * epoch, - SpiceDouble * elems ); - - - void getfat_c ( ConstSpiceChar * file, - SpiceInt arclen, - SpiceInt typlen, - SpiceChar * arch, - SpiceChar * type ); - - - void getfov_c ( SpiceInt instid, - SpiceInt room, - SpiceInt shapelen, - SpiceInt framelen, - SpiceChar * shape, - SpiceChar * frame, - SpiceDouble bsight [3], - SpiceInt * n, - SpiceDouble bounds [][3] ); - - - void getmsg_c ( ConstSpiceChar * option, - SpiceInt lenout, - SpiceChar * msg ); - - - SpiceBoolean gfbail_c ( void ); - - - void gfclrh_c ( void ); - - - void gfdist_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gfevnt_c ( void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - ConstSpiceChar * gquant, - SpiceInt qnpars, - SpiceInt lenvals, - const void * qpnams, - const void * qcpars, - ConstSpiceDouble * qdpars, - ConstSpiceInt * qipars, - ConstSpiceBoolean * qlpars, - ConstSpiceChar * op, - SpiceDouble refval, - SpiceDouble tol, - SpiceDouble adjust, - SpiceBoolean rpt, - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - - void ( * udrepf ) ( void ), - SpiceInt nintvls, - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gffove_c ( ConstSpiceChar * inst, - ConstSpiceChar * tshape, - ConstSpiceDouble raydir [3], - ConstSpiceChar * target, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfinth_c ( int sigcode ); - - - void gfocce_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * obsrvr, - ConstSpiceChar * abcorr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gfoclt_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * obsrvr, - ConstSpiceChar * abcorr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfposc_c ( ConstSpiceChar * target, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfrefn_c ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ); - - - void gfrepf_c ( void ); - - - void gfrepi_c ( SpiceCell * window, - ConstSpiceChar * begmss, - ConstSpiceChar * endmss ); - - - void gfrepu_c ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble time ); - - - void gfrfov_c ( ConstSpiceChar * inst, - ConstSpiceDouble raydir [3], - ConstSpiceChar * rframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfrr_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsep_c ( ConstSpiceChar * targ1, - ConstSpiceChar * frame1, - ConstSpiceChar * shape1, - ConstSpiceChar * targ2, - ConstSpiceChar * frame2, - ConstSpiceChar * shape2, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsntc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsstp_c ( SpiceDouble step ); - - - void gfstep_c ( SpiceDouble time, - SpiceDouble * step ); - - - void gfsubc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gftfov_c ( ConstSpiceChar * inst, - ConstSpiceChar * target, - ConstSpiceChar * tshape, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfuds_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - - void ( * udqdec ) ( void ( * udfunc ) - ( SpiceDouble x, - SpiceDouble * value ), - - SpiceDouble x, - SpiceBoolean * isdecr ), - - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gipool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceInt * ivals, - SpiceBoolean * found ); - - - void gnpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * kvars, - SpiceBoolean * found ); - - - SpiceDouble halfpi_c ( void ); - - void hx2dp_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * number, - SpiceBoolean * error, - SpiceChar * errmsg - ); - - - void ident_c ( SpiceDouble matrix[3][3] ); - - - void ilumin_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ); - - - void illum_c ( ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ); - - - void inedpl_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpicePlane * plane, - SpiceEllipse * ellipse, - SpiceBoolean * found ); - - - void inelpl_c ( ConstSpiceEllipse * ellips, - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt1[3], - SpiceDouble xpt2[3] ); - - - void insrtc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - void insrtd_c ( SpiceDouble item, - SpiceCell * set ); - - - void insrti_c ( SpiceInt item, - SpiceCell * set ); - - - void inter_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void inrypl_c ( ConstSpiceDouble vertex [3], - ConstSpiceDouble dir [3], - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt [3] ); - - - SpiceInt intmax_c ( void ); - - - SpiceInt intmax_ ( void ); - - - SpiceInt intmin_c ( void ); - - - SpiceInt intmin_ ( void ); - - - void invert_c ( ConstSpiceDouble m1[3][3], - SpiceDouble m2[3][3] ); - - - void invort_c ( ConstSpiceDouble m [3][3], - SpiceDouble mit[3][3] ); - - - SpiceBoolean isordv_c ( ConstSpiceInt * array, - SpiceInt n ); - - - SpiceBoolean isrot_c ( ConstSpiceDouble m [3][3], - SpiceDouble ntol, - SpiceDouble dtol ); - - - - SpiceInt isrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - SpiceInt isrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ); - - - SpiceInt isrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ); - - - SpiceBoolean iswhsp_c ( ConstSpiceChar * string ); - - - SpiceDouble j1900_c ( void ); - - - SpiceDouble j1950_c ( void ); - - - SpiceDouble j2000_c ( void ); - - - SpiceDouble j2100_c ( void ); - - - SpiceDouble jyear_c ( void ); - - - void kclear_c ( void ); - - - void kdata_c ( SpiceInt which, - ConstSpiceChar * kind, - SpiceInt fillen, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * file, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ); - - - void kinfo_c ( ConstSpiceChar * file, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ); - - - void ktotal_c ( ConstSpiceChar * kind, - SpiceInt * count ); - - - void kxtrct_c ( ConstSpiceChar * keywd, - SpiceInt termlen, - const void * terms, - SpiceInt nterms, - SpiceInt stringlen, - SpiceInt substrlen, - SpiceChar * string, - SpiceBoolean * found, - SpiceChar * substr ); - - - SpiceInt lastnb_c ( ConstSpiceChar * string ); - - - void latcyl_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * r, - SpiceDouble * lonc, - SpiceDouble * z ); - - - void latrec_c ( SpiceDouble radius, - SpiceDouble longitude, - SpiceDouble latitude, - SpiceDouble rectan [3] ); - - - void latsph_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * rho, - SpiceDouble * colat, - SpiceDouble * lons ); - - - void lcase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ); - - - void ldpool_c ( ConstSpiceChar * filename ); - - - void lmpool_c ( const void * cvals, - SpiceInt lenvals, - SpiceInt n ); - - - void lparse_c ( ConstSpiceChar * list, - ConstSpiceChar * delim, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ); - - - void lparsm_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ); - - - void lparss_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceCell * set ); - - - SpiceDouble lspcn_c ( ConstSpiceChar * body, - SpiceDouble et, - ConstSpiceChar * abcorr ); - - - SpiceInt lstlec_c ( ConstSpiceChar * string, - SpiceInt n, - SpiceInt lenvals, - const void * array ); - - - SpiceInt lstled_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ); - - - SpiceInt lstlei_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ); - - - SpiceInt lstltc_c ( ConstSpiceChar * string, - SpiceInt n, - SpiceInt lenvals, - const void * array ); - - - SpiceInt lstltd_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ); - - - SpiceInt lstlti_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ); - - - void ltime_c ( SpiceDouble etobs, - SpiceInt obs, - ConstSpiceChar * dir, - SpiceInt targ, - SpiceDouble * ettarg, - SpiceDouble * elapsd ); - - - void lx4dec_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4num_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4sgn_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4uns_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lxqstr_c ( ConstSpiceChar * string, - SpiceChar qchar, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void m2eul_c ( ConstSpiceDouble r[3][3], - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble * angle3, - SpiceDouble * angle2, - SpiceDouble * angle1 ); - - - void m2q_c ( ConstSpiceDouble r[3][3], - SpiceDouble q[4] ); - - - - SpiceBoolean matchi_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ); - - - SpiceBoolean matchw_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ); - - - SpiceDouble maxd_c ( SpiceInt n, - ... ); - - - SpiceInt maxi_c ( SpiceInt n, - ... ); - - - void mequ_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ); - - - void mequg_c ( const void * m1, - SpiceInt nr, - SpiceInt nc, - void * mout ); - - - SpiceDouble mind_c ( SpiceInt n, - ... ); - - - SpiceInt mini_c ( SpiceInt n, - ... ); - - - int moved_ ( SpiceDouble * arrfrm, - SpiceInt * ndim, - SpiceDouble * arrto ); - - - void mtxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mtxmg_c ( const void * m1, - const void * m2, - SpiceInt row1, - SpiceInt col1, - SpiceInt col2, - void * mout ); - - - void mtxv_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble vin [3], - SpiceDouble vout[3] ); - - - void mtxvg_c ( const void * m1, - const void * v2, - SpiceInt ncol1, - SpiceInt nr1r2, - void * vout ); - - - void mxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mxmg_c ( const void * m1, - const void * m2, - SpiceInt row1, - SpiceInt col1, - SpiceInt col2, - void * mout ); - - - void mxmt_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mxmtg_c ( const void * m1, - const void * m2, - SpiceInt nrow1, - SpiceInt nc1c2, - SpiceInt nrow2, - void * mout ); - - - void mxv_c ( ConstSpiceDouble m1[3][3], - ConstSpiceDouble vin[3], - SpiceDouble vout[3] ); - - - void mxvg_c ( const void * m1, - const void * v2, - SpiceInt nrow1, - SpiceInt nc1r2, - void * vout ); - - - void namfrm_c ( ConstSpiceChar * frname, - SpiceInt * frcode ); - - - SpiceInt ncpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - SpiceInt ncposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - void nearpt_c ( ConstSpiceDouble positn[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble npoint[3], - SpiceDouble * alt ); - - - void npedln_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble linept[3], - ConstSpiceDouble linedr[3], - SpiceDouble pnear[3], - SpiceDouble * dist ); - - - void npelpt_c ( ConstSpiceDouble point[3], - ConstSpiceEllipse * ellips, - SpiceDouble pnear[3], - SpiceDouble * dist ); - - - void nplnpt_c ( ConstSpiceDouble linpt [3], - ConstSpiceDouble lindir [3], - ConstSpiceDouble point [3], - SpiceDouble pnear [3], - SpiceDouble * dist ); - - - void nvc2pl_c ( ConstSpiceDouble normal[3], - SpiceDouble constant, - SpicePlane * plane ); - - - void nvp2pl_c ( ConstSpiceDouble normal[3], - ConstSpiceDouble point[3], - SpicePlane * plane ); - - - SpiceInt ordc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - SpiceInt ordd_c ( SpiceDouble item, - SpiceCell * set ); - - - SpiceInt ordi_c ( SpiceInt item, - SpiceCell * set ); - - - void orderc_c ( SpiceInt lenvals, - const void * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void orderd_c ( ConstSpiceDouble * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void orderi_c ( ConstSpiceInt * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void oscelt_c ( ConstSpiceDouble state[6], - SpiceDouble et , - SpiceDouble mu , - SpiceDouble elts[8] ); - - - void pckcov_c ( ConstSpiceChar * pck, - SpiceInt idcode, - SpiceCell * cover ); - - - void pckfrm_c ( ConstSpiceChar * pck, - SpiceCell * ids ); - - - void pcklof_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void pckuof_c ( SpiceInt handle ); - - - void pcpool_c ( ConstSpiceChar * name, - SpiceInt n, - SpiceInt lenvals, - const void * cvals ); - - - void pdpool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceDouble * dvals ); - - - void pgrrec_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ); - - - SpiceDouble pi_c ( void ); - - - void pipool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceInt * ivals ); - - - void pjelpl_c ( ConstSpiceEllipse * elin, - ConstSpicePlane * plane, - SpiceEllipse * elout ); - - - void pl2nvc_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble * constant ); - - - void pl2nvp_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble point[3] ); - - - void pl2psv_c ( ConstSpicePlane * plane, - SpiceDouble point[3], - SpiceDouble span1[3], - SpiceDouble span2[3] ); - - - SpiceInt pos_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ); - - - SpiceInt posr_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ); - - - void prefix_c ( ConstSpiceChar * pref, - SpiceInt spaces, - SpiceInt lenout, - SpiceChar * string ); - - - SpiceChar * prompt_c ( ConstSpiceChar * prmptStr, - SpiceInt lenout, - SpiceChar * buffer ); - - - void prop2b_c ( SpiceDouble gm, - ConstSpiceDouble pvinit[6], - SpiceDouble dt, - SpiceDouble pvprop[6] ); - - - void prsdp_c ( ConstSpiceChar * string, - SpiceDouble * dpval ); - - - void prsint_c ( ConstSpiceChar * string, - SpiceInt * intval ); - - - void psv2pl_c ( ConstSpiceDouble point[3], - ConstSpiceDouble span1[3], - ConstSpiceDouble span2[3], - SpicePlane * plane ); - - - void putcml_c ( SpiceInt argc , - SpiceChar ** argv ); - - - void pxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble rotate[3][3] ); - - - void q2m_c ( ConstSpiceDouble q[4], - SpiceDouble r[3][3] ); - - - void qdq2av_c ( ConstSpiceDouble q[4], - ConstSpiceDouble dq[4], - SpiceDouble av[3] ); - - - void qxq_c ( ConstSpiceDouble q1[4], - ConstSpiceDouble q2[4], - SpiceDouble qout[4] ); - - - - void radrec_c ( SpiceDouble range, - SpiceDouble ra, - SpiceDouble dec, - SpiceDouble rectan[3] ); - - - void rav2xf_c ( ConstSpiceDouble rot [3][3], - ConstSpiceDouble av [3], - SpiceDouble xform [6][6] ); - - - void raxisa_c ( ConstSpiceDouble matrix[3][3], - SpiceDouble axis [3], - SpiceDouble * angle ); - - - void rdtext_c ( ConstSpiceChar * file, - SpiceInt lenout, - SpiceChar * line, - SpiceBoolean * eof ); - - - void reccyl_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ); - - - void recgeo_c ( ConstSpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ); - - - void reclat_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * longitude, - SpiceDouble * latitude ); - - - void recpgr_c ( ConstSpiceChar * body, - SpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ); - - - void recrad_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * ra, - SpiceDouble * dec ); - - - - void reordc_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt lenvals, - void * array ); - - - void reordd_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceDouble * array ); - - - void reordi_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt * array ); - - - void reordl_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceBoolean * array ); - - - void removc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - void removd_c ( SpiceDouble item, - SpiceCell * set ); - - - void removi_c ( SpiceInt item, - SpiceCell * set ); - - - void repmc_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - ConstSpiceChar * value, - SpiceInt lenout, - SpiceChar * out ); - - - void repmct_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar strCase, - SpiceInt lenout, - SpiceChar * out ); - - - void repmd_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceInt lenout, - SpiceChar * out ); - - - void repmf_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceChar format, - SpiceInt lenout, - SpiceChar * out ); - - - void repmi_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceInt lenout, - SpiceChar * out ); - - - void repmot_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar strCase, - SpiceInt lenout, - SpiceChar * out ); - - - void reset_c ( void ); - - - SpiceBoolean return_c ( void ); - - - void recsph_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * colat, - SpiceDouble * lon ); - - - void rotate_c ( SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ); - - - void rotmat_c ( ConstSpiceDouble m1[3][3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ); - - - void rotvec_c ( ConstSpiceDouble v1[3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble vout[3] ); - - - SpiceDouble rpd_c ( void ); - - - void rquad_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble root1[2], - SpiceDouble root2[2] ); - - - void saelgv_c ( ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ); - - - void scard_c ( SpiceInt card, - SpiceCell * cell ); - - - void scdecd_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceInt sclklen, - SpiceChar * sclkch ); - - - void sce2s_c ( SpiceInt sc, - SpiceDouble et, - SpiceInt sclklen, - SpiceChar * sclkch ); - - - void sce2c_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ); - - - void sce2t_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ); - - - void scencd_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * sclkdp ); - - - void scfmt_c ( SpiceInt sc, - SpiceDouble ticks, - SpiceInt clkstrlen, - SpiceChar * clkstr ); - - - void scpart_c ( SpiceInt sc, - SpiceInt * nparts, - SpiceDouble * pstart, - SpiceDouble * pstop ); - - - void scs2e_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * et ); - - - void sct2e_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceDouble * et ); - - - void sctiks_c ( SpiceInt sc, - ConstSpiceChar * clkstr, - SpiceDouble * ticks ); - - - void sdiff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean set_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ); - - - void setmsg_c ( ConstSpiceChar * msg ); - - - void shellc_c ( SpiceInt ndim, - SpiceInt lenvals, - void * array ); - - - void shelld_c ( SpiceInt ndim, - SpiceDouble * array ); - - - void shelli_c ( SpiceInt ndim, - SpiceInt * array ); - - - void sigerr_c ( ConstSpiceChar * message ); - - - void sincpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceBoolean * found ); - - - SpiceInt size_c ( SpiceCell * size ); - - - SpiceDouble spd_c ( void ); - - - void sphcyl_c ( SpiceDouble radius, - SpiceDouble colat, - SpiceDouble slon, - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ); - - - void sphlat_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lons, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ); - - - void sphrec_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble rectan[3] ); - - - void spk14a_c ( SpiceInt handle, - SpiceInt ncsets, - ConstSpiceDouble coeffs [], - ConstSpiceDouble epochs [] ); - - - void spk14b_c ( SpiceInt handle, - ConstSpiceChar * segid, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - SpiceInt chbdeg ); - - - void spk14e_c ( SpiceInt handle ); - - - void spkapo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs[6], - ConstSpiceChar * abcorr, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkapp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs [6], - ConstSpiceChar * abcorr, - SpiceDouble starg [6], - SpiceDouble * lt ); - - - void spkcls_c ( SpiceInt handle ); - - - void spkcov_c ( ConstSpiceChar * spk, - SpiceInt idcode, - SpiceCell * cover ); - - - void spkacs_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkaps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - ConstSpiceDouble accobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkez_c ( SpiceInt target, - SpiceDouble epoch, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - SpiceInt observer, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkezp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkezr_c ( ConstSpiceChar * target, - SpiceDouble epoch, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * observer, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkgeo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkgps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble pos[3], - SpiceDouble * lt ); - - - void spklef_c ( ConstSpiceChar * filename, - SpiceInt * handle ); - - - void spkltc_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkobj_c ( ConstSpiceChar * spk, - SpiceCell * ids ); - - - void spkopa_c ( ConstSpiceChar * file, - SpiceInt * handle ); - - - void spkopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void spkpds_c ( SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceInt type, - SpiceDouble first, - SpiceDouble last, - SpiceDouble descr[5] ); - - - void spkpos_c ( ConstSpiceChar * targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkssb_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceDouble starg[6] ); - - - void spksub_c ( SpiceInt handle, - SpiceDouble descr[5], - ConstSpiceChar * ident, - SpiceDouble begin, - SpiceDouble end, - SpiceInt newh ); - - - void spkuds_c ( ConstSpiceDouble descr [5], - SpiceInt * body, - SpiceInt * center, - SpiceInt * frame, - SpiceInt * type, - SpiceDouble * first, - SpiceDouble * last, - SpiceInt * begin, - SpiceInt * end ); - - - void spkuef_c ( SpiceInt handle ); - - - void spkw02_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ); - - - void spkw03_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ); - - - void spkw05_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble gm, - SpiceInt n, - ConstSpiceDouble states [][6], - ConstSpiceDouble epochs [] ); - - - void spkw08_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch1, - SpiceDouble step ); - - - void spkw09_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ); - - - void spkw10_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - ConstSpiceDouble consts [8], - SpiceInt n, - ConstSpiceDouble elems [], - ConstSpiceDouble epochs [] ); - - - void spkw12_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch0, - SpiceDouble step ); - - - void spkw13_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ); - - - void spkw15_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble tp [3], - ConstSpiceDouble pa [3], - SpiceDouble p, - SpiceDouble ecc, - SpiceDouble j2flg, - ConstSpiceDouble pv [3], - SpiceDouble gm, - SpiceDouble j2, - SpiceDouble radius ); - - - void spkw17_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble eqel [9], - SpiceDouble rapol, - SpiceDouble decpol ); - - - void spkw18_c ( SpiceInt handle, - SpiceSPK18Subtype subtyp, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - const void * packts, - ConstSpiceDouble epochs[] ); - - - void srfrec_c ( SpiceInt body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble rectan[3] ); - - - void srfxpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * dist, - SpiceDouble * trgepc, - SpiceDouble obspos [3], - SpiceBoolean * found ); - - - void ssize_c ( SpiceInt size, - SpiceCell * cell ); - - - void stelab_c ( ConstSpiceDouble pobj[3], - ConstSpiceDouble vobs[3], - SpiceDouble appobj[3] ); - - - void stpool_c ( ConstSpiceChar * item, - SpiceInt nth, - ConstSpiceChar * contin, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * size, - SpiceBoolean * found ); - - - void str2et_c ( ConstSpiceChar * date, - SpiceDouble * et ); - - - void subpnt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ); - - - void subpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * alt ); - - - void subslr_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ); - - - void subsol_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint[3] ); - - - SpiceDouble sumad_c ( ConstSpiceDouble array[], - SpiceInt n ); - - - SpiceInt sumai_c ( ConstSpiceInt array[], - SpiceInt n ); - - - void surfnm_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble point[3], - SpiceDouble normal[3] ); - - - void surfpt_c ( ConstSpiceDouble positn[3], - ConstSpiceDouble u[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble point[3], - SpiceBoolean * found ); - - - void surfpv_c ( ConstSpiceDouble stvrtx[6], - ConstSpiceDouble stdir [6], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble stx [6], - SpiceBoolean * found ); - - - void swpool_c ( ConstSpiceChar * agent, - SpiceInt nnames, - SpiceInt lenvals, - const void * names ); - - - void sxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble xform[6][6] ); - - - void szpool_c ( ConstSpiceChar * name, - SpiceInt * n, - SpiceBoolean * found ); - - - void timdef_c ( ConstSpiceChar * action, - ConstSpiceChar * item, - SpiceInt lenout, - SpiceChar * value ); - - - void timout_c ( SpiceDouble et, - ConstSpiceChar * pictur, - SpiceInt lenout, - SpiceChar * output ); - - - void tipbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tipm[3][3] ); - - - void tisbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tsipm[6][6] ); - - - ConstSpiceChar * tkvrsn_c ( ConstSpiceChar * item ); - - - void tparse_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * sp2000, - SpiceChar * errmsg ); - - - void tpictr_c ( ConstSpiceChar * sample, - SpiceInt lenpictur, - SpiceInt lenerror, - SpiceChar * pictur, - SpiceBoolean * ok, - SpiceChar * error ); - - - SpiceDouble trace_c ( ConstSpiceDouble matrix[3][3] ); - - - void trcoff_c ( void ); - - - void tsetyr_c ( SpiceInt year ); - - - SpiceDouble twopi_c ( void ); - - - void twovec_c ( ConstSpiceDouble axdef [3], - SpiceInt indexa, - ConstSpiceDouble plndef [3], - SpiceInt indexp, - SpiceDouble mout [3][3] ); - - - SpiceDouble tyear_c ( void ); - - - void ucase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ); - - - void ucrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - void uddc_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - - SpiceDouble x, - SpiceDouble dx, - SpiceBoolean * isdecr ); - - - void uddf_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - SpiceDouble x, - SpiceDouble dx, - SpiceDouble * deriv ); - - - void union_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceDouble unitim_c ( SpiceDouble epoch, - ConstSpiceChar * insys, - ConstSpiceChar * outsys ); - - - void unload_c ( ConstSpiceChar * file ); - - - void unorm_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3], - SpiceDouble * vmag ); - - - void unormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout, - SpiceDouble * vmag ); - - - void utc2et_c ( ConstSpiceChar * utcstr, - SpiceDouble * et ); - - - void vadd_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) ; - - - void vaddg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ); - - - void valid_c ( SpiceInt size, - SpiceInt n, - SpiceCell * a ); - - - void vcrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - SpiceDouble vdist_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - SpiceDouble vdistg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - SpiceDouble vdot_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - SpiceDouble vdotg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - void vequ_c ( ConstSpiceDouble vin[3], - SpiceDouble vout[3] ); - - - void vequg_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vhat_c ( ConstSpiceDouble v1 [3], - SpiceDouble vout[3] ); - - - void vhatg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vlcom_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble sum[3] ); - - - void vlcom3_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble c, - ConstSpiceDouble v3[3], - SpiceDouble sum[3] ); - - - void vlcomg_c ( SpiceInt n, - SpiceDouble a, - ConstSpiceDouble * v1, - SpiceDouble b, - ConstSpiceDouble * v2, - SpiceDouble * sum ); - - - void vminug_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vminus_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3] ); - - - SpiceDouble vnorm_c ( ConstSpiceDouble v1[3] ); - - - SpiceDouble vnormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim ); - - - void vpack_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble v[3] ); - - - void vperp_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ); - - - void vprjp_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * plane, - SpiceDouble vout [3] ); - - - void vprjpi_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * projpl, - ConstSpicePlane * invpl, - SpiceDouble vout [3], - SpiceBoolean * found ); - - - void vproj_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ); - - - SpiceDouble vrel_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - SpiceDouble vrelg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - void vrotv_c ( ConstSpiceDouble v[3], - ConstSpiceDouble axis[3], - SpiceDouble theta, - SpiceDouble r[3] ); - - - void vscl_c ( SpiceDouble s, - ConstSpiceDouble v1[3], - SpiceDouble vout[3] ); - - - void vsclg_c ( SpiceDouble s, - ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ); - - - SpiceDouble vsep_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - void vsub_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - void vsubg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ); - - - SpiceDouble vsepg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - SpiceDouble vtmv_c ( ConstSpiceDouble v1 [3], - ConstSpiceDouble matrix [3][3], - ConstSpiceDouble v2 [3] ); - - - SpiceDouble vtmvg_c ( const void * v1, - const void * matrix, - const void * v2, - SpiceInt nrow, - SpiceInt ncol ); - - - void vupack_c ( ConstSpiceDouble v[3], - SpiceDouble * x, - SpiceDouble * y, - SpiceDouble * z ); - - SpiceBoolean vzero_c ( ConstSpiceDouble v[3] ); - - - SpiceBoolean vzerog_c ( ConstSpiceDouble * v, - SpiceInt ndim ); - - SpiceInt wncard_c ( SpiceCell * window ); - - void wncomd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window, - SpiceCell * result ); - - - void wncond_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wndifd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean wnelmd_c ( SpiceDouble point, - SpiceCell * window ); - - - void wnexpd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wnextd_c ( SpiceChar side, - SpiceCell * window ); - - - void wnfetd_c ( SpiceCell * window, - SpiceInt n, - SpiceDouble * left, - SpiceDouble * right ); - - - void wnfild_c ( SpiceDouble sml, - SpiceCell * window ); - - - void wnfltd_c ( SpiceDouble sml, - SpiceCell * window ); - - - SpiceBoolean wnincd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wninsd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wnintd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean wnreld_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ); - - - void wnsumd_c ( SpiceCell * window, - SpiceDouble * meas, - SpiceDouble * avg, - SpiceDouble * stddev, - SpiceInt * shortest, - SpiceInt * longest ); - - - void wnunid_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void wnvald_c ( SpiceInt size, - SpiceInt n, - SpiceCell * window ); - - - - void xf2eul_c ( ConstSpiceDouble xform [6][6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble eulang [6], - SpiceBoolean * unique ); - - - void xf2rav_c ( ConstSpiceDouble xform [6][6], - SpiceDouble rot [3][3], - SpiceDouble av [3] ); - - - void xpose_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ); - - - void xpose6_c ( ConstSpiceDouble m1 [6][6], - SpiceDouble mout[6][6] ); - - - void xposeg_c ( const void * matrix, - SpiceInt nrow, - SpiceInt ncol, - void * xposem ); - - - void zzgetcml_c( SpiceInt * argc, - SpiceChar *** argv, - SpiceBoolean init ); - - - SpiceBoolean zzgfgeth_c ( void ); - - - void zzgfsavh_c( SpiceBoolean status ); - - - void zzsynccl_c( SpiceTransDir xdir, - SpiceCell * cell ); - - -#endif diff --git a/ext/spice/src/cspice/SpiceZst.h b/ext/spice/src/cspice/SpiceZst.h deleted file mode 100644 index ba48b16c1c..0000000000 --- a/ext/spice/src/cspice/SpiceZst.h +++ /dev/null @@ -1,199 +0,0 @@ -/* - --Header_File SpiceZst.h ( Fortran/C string conversion utilities ) - --Abstract - - Define prototypes for CSPICE Fortran/C string conversion utilities. - - Caution: these prototypes are subject to revision without notice. - - These are private routines and are not part of the official CSPICE - user interface. - --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. - --Particulars - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 6.0.0, 10-JUL-2002 (NJB) - - Added prototype for new functions C2F_MapStrArr and - C2F_MapFixStrArr. - - -CSPICE Version 5.0.0, 18-MAY-2001 (WLT) - - Added #ifdef's to add namespace specification for C++ compilation. - - -CSPICE Version 4.0.0, 14-FEB-2000 (NJB) - - Added prototype for new function C2F_CreateStrArr_Sig. - - -CSPICE Version 3.0.0, 12-JUL-1999 (NJB) - - Added prototype for function C2F_CreateFixStrArr. - Added prototype for function F2C_ConvertTrStrArr. - Removed reference in comments to C2F_CreateStrArr_Sig, which - does not exist. - - -CSPICE Version 2.0.1, 06-MAR-1998 (NJB) - - Type SpiceVoid was changed to void. - - -CSPICE Version 2.0.1, 09-FEB-1998 (EDW) - - Added prototype for F2C_ConvertStrArr. - - -CSPICE Version 2.0.0, 04-JAN-1998 (NJB) - - Added prototype for F2C_ConvertStr. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - protoypes of CSPICE Fortran/C string conversion utilities - -*/ - -#include -#include -#include "SpiceZdf.h" - -#ifndef HAVE_FCSTRINGS_H -#define HAVE_FCSTRINGS_H - -#ifdef __cplusplus -namespace Jpl_NAIF_CSpice { -#endif - - SpiceStatus C2F_CreateStr ( ConstSpiceChar *, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateStr_Sig ( ConstSpiceChar *, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateFixStrArr ( SpiceInt nStr, - SpiceInt cStrDim, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - SpiceStatus C2F_CreateStrArr ( SpiceInt, - ConstSpiceChar **, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateStrArr_Sig ( SpiceInt nStr, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - void C2F_MapFixStrArr ( ConstSpiceChar * caller, - SpiceInt nStr, - SpiceInt cStrLen, - const void * cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - void C2F_MapStrArr ( ConstSpiceChar * caller, - SpiceInt nStr, - SpiceInt cStrLen, - const void * cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - SpiceStatus C2F_StrCpy ( ConstSpiceChar *, - SpiceInt, - SpiceChar * ); - - void F_Alloc ( SpiceInt, - SpiceChar** ); - - void F2C_ConvertStr ( SpiceInt, - SpiceChar * ); - - void F2C_ConvertStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ); - - void F2C_ConvertTrStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ); - - SpiceStatus F2C_CreateStr ( SpiceInt, - ConstSpiceChar *, - SpiceChar ** ); - - void F2C_CreateStr_Sig ( SpiceInt, - ConstSpiceChar *, - SpiceChar ** ); - - SpiceStatus F2C_CreateStrArr ( SpiceInt, - SpiceInt, - ConstSpiceChar *, - SpiceChar *** ); - - void F2C_CreateStrArr_Sig ( SpiceInt, - SpiceInt, - ConstSpiceChar *, - SpiceChar *** ); - - void F2C_FreeStrArr ( SpiceChar **cStrArr ); - - - SpiceStatus F2C_StrCpy ( SpiceInt, - ConstSpiceChar *, - SpiceInt, - SpiceChar * ); - - SpiceInt F_StrLen ( SpiceInt, - ConstSpiceChar * ); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/ext/spice/src/cspice/abort_.c b/ext/spice/src/cspice/abort_.c deleted file mode 100644 index 696af7681e..0000000000 --- a/ext/spice/src/cspice/abort_.c +++ /dev/null @@ -1,32 +0,0 @@ -/* - 06-FEB-1999 (NJB) - - The statement - - return 0; - - for the normal C case was added to suppress compilation warnings. - -*/ - -#include "stdio.h" -#include "f2c.h" - -#ifdef KR_headers -extern VOID sig_die(); - -int abort_() -#else -extern void sig_die(char*,int); - -int abort_(void) -#endif -{ -sig_die("Fortran abort routine called", 1); - -return 0; - -#ifdef __cplusplus -return 0; -#endif -} diff --git a/ext/spice/src/cspice/accept.c b/ext/spice/src/cspice/accept.c deleted file mode 100644 index c4d5e213ec..0000000000 --- a/ext/spice/src/cspice/accept.c +++ /dev/null @@ -1,318 +0,0 @@ -/* accept.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ACCEPT ( Accept New Long Error Message ) */ -logical accept_0_(int n__, logical *ok) -{ - /* Initialized data */ - - static logical savok = TRUE_; - - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Indicate to the SPICELIB error handling mechanism whether or not */ -/* a replacement or modification of the long error message can be */ -/* accepted. DO NOT CALL THIS ROUTINE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OK I Indicates whether long error msg changes are ok. */ - -/* The function takes an UNSPECIFIED value on exit. */ - -/* $ Detailed_Input */ - -/* OK Indicates to the error handling mechanism whether */ -/* replacement of or changes to the long error message */ -/* are to be allowed; for them to be allowed, */ -/* both of the following must be true: */ - -/* 1. No error condition exists, or the error response */ -/* action is not 'RETURN'. */ - -/* 2. The current error response mode is not 'IGNORE'. */ - - -/* $ Detailed_Output */ - -/* The function is assigned a value on output, but the */ -/* value is not meaningful. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - - -/* - Beta Version 1.1.0, 13-DEC-1989 (NJB) */ - -/* ACCEPT must return a value, in order to comply with the */ -/* Fortran standard. So, now it does. The value has no */ -/* meaning, as far as the specification of ACCEPT is */ -/* concerned. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* SPICELIB functions: */ - - -/* Local Variables: */ - - -/* Initial Values: */ - - switch(n__) { - case 1: goto L_allowd; - } - - -/* Executable Code: */ - - savok = *ok; - ret_val = FALSE_; - return ret_val; -/* $Procedure ALLOWD (Are Changes of Long Error Message Allowed?) */ - -L_allowd: -/* $ Abstract */ - -/* True if replacement or modification of the long error message */ -/* is allowed. DO NOT CALL THIS ROUTINE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function takes the value, .TRUE., if replacement or */ -/* modification of the long error message is currently allowed. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function takes the value, .TRUE., if replacement of or */ -/* changes to the long error message are to be allowed; for them */ -/* to be allowed, both of the following must be true: */ - -/* 1. No error condition exists, or the error response */ -/* action is not 'RETURN'. */ - -/* 2. The current error response mode is not 'IGNORE'. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* Non-error handling routines should not call this routine. Such */ -/* routines can set the long error message using SETMSG, which */ -/* itself calls this routine to test whether an update is allowed. */ - -/* The initial value returned by ALLOWD is .FALSE. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* allow changes of long error message */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 18-DEC-1989 (HAN) */ - -/* Empty parentheses added to the ENTRY statement in order to */ -/* comply with the ANSI Fortran 77 Standard. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* Executable Code: */ - - ret_val = savok; - return ret_val; -} /* accept_ */ - -logical accept_(logical *ok) -{ - return accept_0_(0, ok); - } - -logical allowd_(void) -{ - return accept_0_(1, (logical *)0); - } - diff --git a/ext/spice/src/cspice/alltru.c b/ext/spice/src/cspice/alltru.c deleted file mode 100644 index 3be7a41c82..0000000000 --- a/ext/spice/src/cspice/alltru.c +++ /dev/null @@ -1,154 +0,0 @@ -/* alltru.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ALLTRU ( All entries true? ) */ -logical alltru_(logical *logcls, integer *n) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Determine if all the entries in an array of logicals are .TRUE. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LOGCLS I An array of logicals. */ -/* N I Number of elements in the array LOGCLS. */ - -/* The function returns .TRUE. if all of the values in the array */ -/* LOGCLS are true. */ - -/* $ Detailed_Input */ - -/* LOGCLS is an array of logicals. */ - -/* N is the number of elements in the array LOGCLS */ - -/* $ Detailed_Output */ - -/* The function returns true if the value of every entry of LOGCLS */ -/* is .TRUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If N is less than 1, the function returns a value of .TRUE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function examines each element of LOGCLS until */ -/* a .FALSE. value is found or until all values have been */ -/* examined. */ - -/* $ Examples */ - -/* Suppose you needed to confirm that each a character set */ -/* WORDS contained all of the words in the phrase */ - -/* 'EVERY GOOD BOY DOES FINE' */ - -/* You might execute the following block of code. */ - -/* FOUND(1) = ELEMC ( 'EVERY', WORDS ) */ -/* FOUND(2) = ELEMC ( 'GOOD', WORDS ) */ -/* FOUND(3) = ELEMC ( 'BOY', WORDS ) */ -/* FOUND(4) = ELEMC ( 'DOES', WORDS ) */ -/* FOUND(5) = ELEMC ( 'FINE', WORDS ) */ - -/* OK = ALLTRU ( FOUND, 5 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 12-JUL-1991 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether all logicals in an array are true */ - -/* -& */ - -/* Just do it. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (! logcls[i__ - 1]) { - ret_val = FALSE_; - return ret_val; - } - } - ret_val = TRUE_; - return ret_val; -} /* alltru_ */ - diff --git a/ext/spice/src/cspice/ana.c b/ext/spice/src/cspice/ana.c deleted file mode 100644 index e0fc337d81..0000000000 --- a/ext/spice/src/cspice/ana.c +++ /dev/null @@ -1,281 +0,0 @@ -/* ana.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__33 = 33; -static integer c__22 = 22; - -/* $Procedure ANA ( AN or A ? ) */ -/* Character */ VOID ana_(char *ret_val, ftnlen ret_val_len, char *word, char - *case__, ftnlen word_len, ftnlen case_len) -{ - /* Initialized data */ - - static char a[2*3] = "A " "A " "a "; - static char an[2*3] = "AN" "An" "an"; - static char anword[8*22] = "HEIR " "HONEST " "HONOR " "H " - "HOUR " "HORS " "HOMBRE " "F " "L " "M " - "N " "R " "S " "X " "UNIN " "UNIM " - "ONEI " "ONER " "SPK " "EK " "IK " "SCLK "; - static char aword[8*33] = "HORSE " "ONE " "ONE- " "ONCE " - "ONENESS " "UIG " "UIN " "UKA " "UKE " "UKO " - "UKI " "UKU " "ULOT " "UNANI " "UNI " "UNINU " - "UPA " "URA " "URE " "URO " "USA " "USE " - "USU " "UTE " "UTI " "UTO " "UVA " "UVE " - "UVU " "EU " "EWE " "UTRI " "U "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - static integer caps, i__; - static char begin[1]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static char start[32*7]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int replch_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - static char mycase[1], myword[32]; - -/* $ Abstract */ - -/* Return the correct article "a" or "an" used to modify a word */ -/* and return it capitalized, lower case, or upper case. */ - -/* $ 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 */ - -/* WORD */ - -/* $ Keywords */ - -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WORD I is a word that should be modified by "a" or "an" */ -/* CASE I 'U', 'L', or 'C' to specify capitalization of ANA. */ -/* ANA O 'A' or 'AN' appropriately capitalized. */ - -/* $ Detailed_Input */ - -/* WORD is any english word for which you want to write the */ -/* correct phrase "a(an) response(answer)". The case */ -/* of the letters of word do not matter. */ - -/* Leading white space in word is ignored. The characters */ -/* " and ' are ignored. Thus ''' apple '' ' and */ -/* '"apple"' and ' apple' and 'apple' are all treated as */ -/* the same word. */ - -/* CASE is a character that describes how the value returned */ -/* in ANA should be capitalized. The rules are: */ - -/* 'U' --- ANA is returned in all caps ( A, AN ) */ -/* 'C' --- ANA is returned capitalized ( A, An ) */ -/* 'L' --- ANA is returned lower case ( a, an ) */ - -/* The case of CASE does not matter. Any value other */ -/* than those specified result in ANA being returned */ -/* in all lower case. */ - -/* $ Detailed_Output */ - -/* ANA is a character function an will return the correct */ -/* indefinite article needed to modify the word contained */ -/* in WORD. ANA should be declared to be CHARACTER*(2) */ -/* (or CHARACTER*(N) where N > 1) in the calling */ -/* program. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free */ - -/* 1) If the uppercase value of CASE is not 'U', 'C' or 'L', it shall */ -/* be treated as 'L'. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to construct grammatically correct phrases */ -/* when you need to modify a word by an indefinite article. Using */ -/* the pronunciations contained in the Webster's Ninth Collegiate */ -/* Dictionary, the phrase */ - -/* ANA(WORD, CASE) // ' ' // WORD */ - -/* will be grammatically correct. */ - -/* $ Examples */ - -/* Suppose you wished to construct one of the messages */ - -/* 'a new file' */ -/* 'an existing file' */ - -/* and that the NEW/EXISTING word was in the variable WORD. Then */ -/* you could write */ - -/* MESSAGE = ANA( WORD, 'L' ) // ' ' // WORD // ' file ' */ -/* CALL CMPRSS ( ' ', 1, MESSAGE, MESSAGE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* Webster's Ninth Collegiate Dictionary. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.1.1, 22-SEP-2004 (EDW) */ - -/* Added Copyright section. */ - -/* - SPICELIB Version 1.1.0, 18-JAN-2001 (WLT) */ - -/* Made SCLK and "an" word. */ - -/* - SPICELIB Version 1.0.0, 29-NOV-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* GET THE CORRECT INDEFINITE ARTICLE */ - -/* -& */ - ucase_(word, myword, word_len, (ftnlen)32); - replch_(myword, "'", " ", myword, (ftnlen)32, (ftnlen)1, (ftnlen)1, ( - ftnlen)32); - replch_(myword, "\"", " ", myword, (ftnlen)32, (ftnlen)1, (ftnlen)1, ( - ftnlen)32); - ljust_(myword, myword, (ftnlen)32, (ftnlen)32); - ucase_(case__, mycase, case_len, (ftnlen)1); - s_copy(ret_val, " ", ret_val_len, (ftnlen)1); - if (*(unsigned char *)mycase == 'U') { - caps = 1; - } else if (*(unsigned char *)mycase == 'C') { - caps = 2; - } else { - caps = 3; - } - -/* Handle the obvious things first. */ - - *(unsigned char *)begin = *(unsigned char *)myword; - if (i_indx("AI", begin, (ftnlen)2, (ftnlen)1) > 0) { - s_copy(ret_val, an + (((i__1 = caps - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("an", i__1, "ana_", (ftnlen)235)) << 1), ret_val_len, ( - ftnlen)2); - return ; - } else if (i_indx("BCDGJKPQTVWYZ", begin, (ftnlen)13, (ftnlen)1) > 0) { - s_copy(ret_val, a + (((i__1 = caps - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("a", i__1, "ana_", (ftnlen)240)) << 1), ret_val_len, ( - ftnlen)2); - return ; - } - -/* If we are still here, we need to be a bit more careful */ -/* in our determination of ANA. */ - -/* Get the beginnings of the input word. */ - - for (i__ = 1; i__ <= 7; ++i__) { - s_copy(start + (((i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "start", i__1, "ana_", (ftnlen)252)) << 5), myword, (ftnlen) - 32, i__); - } - -/* Now see if the start of the input word belongs to */ -/* one of the special collections. */ - - for (i__ = 7; i__ >= 2; --i__) { - if (isrchc_(start + (((i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : - s_rnge("start", i__1, "ana_", (ftnlen)261)) << 5), &c__33, - aword, (ftnlen)32, (ftnlen)8) != 0) { - s_copy(ret_val, a + (((i__1 = caps - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("a", i__1, "ana_", (ftnlen)263)) << 1), - ret_val_len, (ftnlen)2); - return ; - } - if (isrchc_(start + (((i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : - s_rnge("start", i__1, "ana_", (ftnlen)268)) << 5), &c__22, - anword, (ftnlen)32, (ftnlen)8) != 0) { - s_copy(ret_val, an + (((i__1 = caps - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("an", i__1, "ana_", (ftnlen)270)) << 1), - ret_val_len, (ftnlen)2); - return ; - } - } - -/* If we got this far we can determine the ANAe by */ -/* just looking at the beginning of the string. */ - - if (i_indx("AEIOU", myword, (ftnlen)5, (ftnlen)1) > 0) { - s_copy(ret_val, an + (((i__1 = caps - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("an", i__1, "ana_", (ftnlen)282)) << 1), ret_val_len, ( - ftnlen)2); - } else { - s_copy(ret_val, a + (((i__1 = caps - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("a", i__1, "ana_", (ftnlen)286)) << 1), ret_val_len, ( - ftnlen)2); - } - return ; -} /* ana_ */ - diff --git a/ext/spice/src/cspice/appndc.c b/ext/spice/src/cspice/appndc.c deleted file mode 100644 index 8189f275b7..0000000000 --- a/ext/spice/src/cspice/appndc.c +++ /dev/null @@ -1,188 +0,0 @@ -/* appndc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure APPNDC ( Append an item to a character cell ) */ -/* Subroutine */ int appndc_(char *item, char *cell, ftnlen item_len, ftnlen - cell_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - integer nwcard; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Append an item to a character cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I The item to append. */ -/* CELL I/O The cell to which ITEM will be appended. */ - -/* $ Detailed_Input */ - -/* ITEM is a character string which is to be appended to CELL. */ - -/* CELL is a character cell to which ITEM will be appended. */ - -/* $ Detailed_Output */ - -/* CELL is a character cell in which the last element is ITEM. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the cell is not large enough to accommodate the addition */ -/* of a new element, the error SPICE(CELLTOOSMALL) is signalled. */ - -/* 2) If the length of the item is longer than the length of the */ -/* cell, ITEM is truncated on the right. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the item 'PLUTO' is appended to */ -/* the character cell PLANETS. */ - -/* Before appending 'PLUTO', the cell contains: */ - -/* PLANETS (1) = 'MERCURY' */ -/* PLANETS (2) = 'VENUS' */ -/* PLANETS (3) = 'EARTH' */ -/* PLANTES (4) = 'MARS' */ -/* PLANETS (5) = 'JUPITER' */ -/* PLANETS (6) = 'SATURN' */ -/* PLANETS (7) = 'URANUS' */ -/* PLANETS (8) = 'NEPTUNE' */ - -/* The call */ - -/* CALL APPNDC ( 'PLUTO', PLANETS ) */ - -/* appends the element 'PLUTO' at the location PLANETS (9), and the */ -/* cardinality is updated. */ - -/* If the cell is not big enough to accomodate the addition of */ -/* the item, an error is signalled. In this case, the cell is not */ -/* altered. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ 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 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* append an item to a character cell */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("APPNDC", (ftnlen)6); - } - -/* Check to see if the cell can accomodate the addition of a */ -/* new item. If there is room, append the item to the cell and */ -/* reset the cardinality. If the cell cannot accomodate the */ -/* addition of a new item, signal an error. */ - - nwcard = cardc_(cell, cell_len) + 1; - if (nwcard <= sizec_(cell, cell_len)) { - s_copy(cell + (nwcard + 5) * cell_len, item, cell_len, item_len); - scardc_(&nwcard, cell, cell_len); - } else { - setmsg_("The cell cannot accomodate the addition of the item *.", ( - ftnlen)54); - errch_("*", item, (ftnlen)1, item_len); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - } - chkout_("APPNDC", (ftnlen)6); - return 0; -} /* appndc_ */ - diff --git a/ext/spice/src/cspice/appndc_c.c b/ext/spice/src/cspice/appndc_c.c deleted file mode 100644 index 2391fbcbcd..0000000000 --- a/ext/spice/src/cspice/appndc_c.c +++ /dev/null @@ -1,286 +0,0 @@ -/* - --Procedure appndc_c ( Append an item to a character cell ) - --Abstract - - Append an item to a character cell. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - -#include "SpiceUsr.h" -#include "SpiceZfc.h" -#include "SpiceZmc.h" -#include "f2cMang.h" - - - void appndc_c ( ConstSpiceChar * item, - SpiceCell * cell ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I The item to append. - cell I/O The cell to which item will be appended. - --Detailed_Input - - item is a character string which is to be appended to cell. - - cell is a character SpiceCell to which item will be appended. - --Detailed_Output - - cell is the input SpiceCell with item appended. item is the - last member of cell. - - If cell is actually a CSPICE set on input and ceases to - qualify as a set as result of the append operation, - the isSet member of cell will be set to SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If the input cell argument is a SpiceCell of type other than - character, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the cell is not large enough to accommodate the addition - of a new element, the error SPICE(CELLTOOSMALL) is signaled. - - 3) If the length of the item is longer than the length of the - cell, ITEM is truncated on the right. - - 4) If on input cell is actually a CSPICE set, that is, it - contains sorted elements with no duplicates, and if item - is not strictly greater than the last element, on output the - isSet member of cell will be set to SPICEFALSE. This case - is not considered an error. - - 5) If the input string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following example, the item "PLUTO" is appended to - the character cell planets. planets is declared with - string length NAMLEN. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the cell with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - . - . - . - /. - Before appending "PLUTO", suppose the cell planets' data array - contains: - - Element 0: == "MERCURY" - Element 1: == "VENUS" - Element 2: == "EARTH" - Element 3: == "MARS" - Element 4: == "JUPITER" - Element 5: == "SATURN" - Element 6: == "URANUS" - Element 7: == "NEPTUNE" - - Append the string "PLUTO" at index 8, and update the - cell's cardinality. - ./ - - appndc_c ( "PLUTO", &planets ); - - /. - The cell's data array now has the contents - - Element 0: == "MERCURY" - Element 1: == "VENUS" - Element 2: == "EARTH" - Element 3: == "MARS" - Element 4: == "JUPITER" - Element 5: == "SATURN" - Element 6: == "URANUS" - Element 7: == "NEPTUNE" - Element 8: == "PLUTO" - ./ - --Restrictions - - 1) 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) - --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. - - Header sections were re-ordered. - - -CSPICE Version 1.0.0, 21-AUG-2002 (NJB) (HAN) - --Index_Entries - - append an item to a character cell - --& -*/ - -{ /* Begin appndc_c */ - - - /* - f2c library utility prototypes - */ - extern integer s_cmp (char *a, char *b, ftnlen la, ftnlen lb ); - - - /* - Local variables - */ - SpiceChar * sPtr; - - SpiceInt card; - SpiceInt diff; - - - /* - Use discovery check-in. - */ - if ( return_c() ) - { - return; - } - - - /* - Check the input string pointer to make sure it's not null. - */ - CHKPTR ( CHK_DISCOVER, "appndc_c", item ); - - - /* - Make sure we're working with a character cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "appndc_c", SPICE_CHR, cell ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - card = cell->card; - - if ( card == cell->size ) - { - chkin_c ( "appndc_c" ); - setmsg_c ( "The cell cannot accommodate the addition of the " - "element *" ); - errch_c ( "*", item ); - sigerr_c ( "SPICE(CELLTOOSMALL)" ); - chkout_c ( "appndc_c" ); - return; - } - - - if ( ( cell->isSet ) && ( card > 0 ) ) - { - /* - The item must be strictly greater than its predecessor, or - the input cell is no longer a set. - */ - sPtr = SPICE_CELL_ELEM_C(cell, card-1 ); - - diff = s_cmp ( (char *) item, - (char *) sPtr, - (ftnlen ) strlen(item), - (ftnlen ) strlen(sPtr) ); - - if ( diff < 1 ) - { - cell->isSet = SPICEFALSE; - } - } - - - /* - Append the item to the cell and increment the cell's cardinality. - */ - SPICE_CELL_SET_C ( item, card, cell ); - - (cell->card) ++; - - -} /* End appndc_c */ diff --git a/ext/spice/src/cspice/appndd.c b/ext/spice/src/cspice/appndd.c deleted file mode 100644 index acfd1c24f5..0000000000 --- a/ext/spice/src/cspice/appndd.c +++ /dev/null @@ -1,188 +0,0 @@ -/* appndd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure APPNDD ( Append an item to a double precision cell ) */ -/* Subroutine */ int appndd_(doublereal *item, doublereal *cell) -{ - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - integer nwcard; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Append an item to a double precision cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I The item to append. */ -/* CELL I/O The cell to which ITEM will be appended. */ - -/* $ Detailed_Input */ - -/* ITEM is a double precision value which is to be appended */ -/* to CELL. */ - -/* CELL is a double precision cell to which ITEM will be */ -/* appended. */ - -/* $ Detailed_Output */ - -/* CELL is a double precision cell in which the last element */ -/* is ITEM. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the cell is not big enough to accommodate the addition */ -/* of a new element, the error SPICE(CELLTOOSMALL) is signalled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 34.0D0 is appended to */ -/* the d.p. cell NUMBERS. */ - -/* Before appending 34.0D0, the cell contains: */ - -/* NUMBERS (1) = 1.0D0 */ -/* NUMBERS (2) = 1.D0D */ -/* NUMBERS (3) = 2.0D0 */ -/* NUMBERS (4) = 3.0D0 */ -/* NUMBERS (5) = 5.0D0 */ -/* NUMBERS (6) = 8.0D0 */ -/* NUMBERS (7) = 13.0D0 */ -/* NUMBERS (8) = 21.0D0 */ - -/* The call */ - -/* CALL APPNDD ( 34.0D0, NUMBERS ) */ - -/* appends the element 34.0D0 at the location NUMBERS (9), and the */ -/* cardinality is updated. */ - -/* If the cell is not big enough to accomodate the addition of */ -/* the item, an error is signalled. In this case, the cell is not */ -/* altered. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 09-NOV-2006 (WLT) */ - -/* Corrected typo in Examples section describing the cell as */ -/* character instead of d.p. */ - -/* - 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 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* append an item to a d.p. cell */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("APPNDD", (ftnlen)6); - } - -/* Check to see if the cell can accomodate the addition of a */ -/* new item. If there is room, append the item to the cell and */ -/* reset the cardinality. If the cell cannot accomodate the */ -/* addition of a new item, signal an error. */ - - nwcard = cardd_(cell) + 1; - if (nwcard <= sized_(cell)) { - cell[nwcard + 5] = *item; - scardd_(&nwcard, cell); - } else { - setmsg_("The cell cannot accomodate the addition of the element *. ", - (ftnlen)58); - errdp_("*", item, (ftnlen)1); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - } - chkout_("APPNDD", (ftnlen)6); - return 0; -} /* appndd_ */ - diff --git a/ext/spice/src/cspice/appndd_c.c b/ext/spice/src/cspice/appndd_c.c deleted file mode 100644 index 24406614ab..0000000000 --- a/ext/spice/src/cspice/appndd_c.c +++ /dev/null @@ -1,216 +0,0 @@ -/* - --Procedure appndd_c ( Append an item to a double precision cell ) - --Abstract - - Append an item to a double precision cell. - --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 - - CELLS - --Keywords - - CELLS - -*/ - -#include "SpiceUsr.h" -#include "SpiceZmc.h" - - - void appndd_c ( SpiceDouble item, - SpiceCell * cell ) - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I The item to append. - cell I/O The cell to which item will be appended. - --Detailed_Input - - item is an double precision value which is to be appended to - cell. - - cell is a double precision SpiceCell to which item will be - appended. - --Detailed_Output - - cell is the input SpiceCell with item appended. item is the - last member of cell. - - If cell is actually a CSPICE set on input and ceases to - qualify as a set as result of the requested append - operation, the isSet member of cell will be set to - SPICEFALSE. --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the input cell argument doesn't have double precision data type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the cell is not big enough to accommodate the addition - of a new element, the error SPICE(CELLTOOSMALL) is signaled. - --Particulars - - None. - --Examples - - 1) In the following example, the element 34 is appended to - the double precision cell fibNums. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the cell with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( fibNums, MAXSIZ ); - . - . - . - /. - Before appending 34, the cell contains: - - Element 0: == 1.0 - Element 1: == 1.0 - Element 2: == 2.0 - Element 3: == 3.0 - Element 4: == 5.0 - Element 5: == 8.0 - Element 6: == 13.0 - Element 7: == 21.0 - - The following call appends the element 34 at index 8, and - updates the cardinality. - ./ - - appndd_c ( 34, &fibNums ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - --Version - - -CSPICE Version 1.0.0, 01-AUG-2002 (NJB) (HAN) - --Index_Entries - - append an item to a d.p. cell - --& -*/ - -{ /* Begin appndd_c */ - - - /* - Use discovery check-in. - */ - - /* - Make sure we're working with a DP cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "appndd_c", SPICE_DP, cell ); - - - if ( cell->card == cell->size ) - { - chkin_c ( "appndd_c" ); - setmsg_c ( "The cell cannot accommodate the addition of the " - "element *" ); - errdp_c ( "*", item ); - sigerr_c ( "SPICE(CELLTOOSMALL)" ); - chkout_c ( "appndd_c" ); - return; - } - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - /* - The item must be strictly greater than its predecessor, or - the input cell is no longer a set. - */ - if ( ( cell->isSet ) && ( cell->card > 0 ) ) - { - if ( item <= SPICE_CELL_ELEM_D(cell, cell->card-1) ) - { - cell->isSet = SPICEFALSE; - } - } - - - /* - Append the item to the cell and increment the cell's cardinality. - */ - SPICE_CELL_SET_D ( item, cell->card, cell ); - - (cell->card) ++; - - - /* - Sync the cell. - */ - zzsynccl_c ( C2F, cell ); - - -} /* End appndd_c */ - diff --git a/ext/spice/src/cspice/appndi.c b/ext/spice/src/cspice/appndi.c deleted file mode 100644 index 86a4de460d..0000000000 --- a/ext/spice/src/cspice/appndi.c +++ /dev/null @@ -1,186 +0,0 @@ -/* appndi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure APPNDI ( Append an item to an integer cell ) */ -/* Subroutine */ int appndi_(integer *item, integer *cell) -{ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *); - integer nwcard; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Append an item to an integer cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I The item to append. */ -/* CELL I/O The cell to which ITEM will be appended. */ - -/* $ Detailed_Input */ - -/* ITEM is an integer value which is to be appended to CELL. */ - -/* CELL is an integer cell to which ITEM will be appended. */ - -/* $ Detailed_Output */ - -/* CELL is an integer cell in which the last element is ITEM. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the cell is not big enough to accommodate the addition */ -/* of a new element, the error SPICE(CELLTOOSMALL) is signaled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 34 is appended to */ -/* the integer cell NUMBERS. */ - -/* Before appending 34, the cell contains: */ - -/* NUMBERS (1) = 1 */ -/* NUMBERS (2) = 1 */ -/* NUMBERS (3) = 2 */ -/* NUMBERS (4) = 3 */ -/* NUMBERS (5) = 5 */ -/* NUMBERS (6) = 8 */ -/* NUMBERS (7) = 13 */ -/* NUMBERS (8) = 21 */ - -/* The call */ - -/* CALL APPNDI ( 34, NUMBERS ) */ - -/* appends the element 34 at the location NUMBERS (9), and the */ -/* cardinality is updated. */ - -/* If the cell is not big enough to accommodate the addition of */ -/* the item, an error is signaled. In this case, the cell is not */ -/* altered. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 31-JUL-2002 (NJB) */ - -/* Corrected miscellaneous typos in header and in the long */ -/* error message text. */ - -/* - 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 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* append an item to an integer cell */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("APPNDI", (ftnlen)6); - } - -/* Check to see if the cell can accommodate the addition of a */ -/* new item. If there is room, append the item to the cell and */ -/* reset the cardinality. If the cell cannot accommodate the */ -/* addition of a new item, signal an error. */ - - nwcard = cardi_(cell) + 1; - if (nwcard <= sizei_(cell)) { - cell[nwcard + 5] = *item; - scardi_(&nwcard, cell); - } else { - setmsg_("The cell cannot accommodate the addition of the element *. ", - (ftnlen)59); - errint_("*", item, (ftnlen)1); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - } - chkout_("APPNDI", (ftnlen)6); - return 0; -} /* appndi_ */ - diff --git a/ext/spice/src/cspice/appndi_c.c b/ext/spice/src/cspice/appndi_c.c deleted file mode 100644 index c23b02869b..0000000000 --- a/ext/spice/src/cspice/appndi_c.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - --Procedure appndi_c ( Append an item to an integer cell ) - --Abstract - - Append an item to an integer cell. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - -#include "SpiceUsr.h" -#include "SpiceZmc.h" - - - void appndi_c ( SpiceInt item, - SpiceCell * cell ) - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I The item to append. - cell I/O The cell to which item will be appended. - --Detailed_Input - - item is an integer value which is to be appended to cell. - - cell is an integer SpiceCell to which item will be appended. - --Detailed_Output - - cell is the input SpiceCell with item appended. item is the - last member of cell. - - If cell is actually a CSPICE set on input and ceases to - qualify as a set as result of the requested append - operation, the isSet member of cell will be set to - SPICEFALSE. --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the input cell argument doesn't have integer data type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the cell is not big enough to accommodate the addition - of a new element, the error SPICE(CELLTOOSMALL) is signaled. - --Particulars - - None. - --Examples - - 1) In the following example, the element 34 is appended to - the integer cell fibNums. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the cell with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( fibNums, MAXSIZ ); - . - . - . - /. - Before appending 34, the cell contains: - - Element 0: == 1 - Element 1: == 1 - Element 2: == 2 - Element 3: == 3 - Element 4: == 5 - Element 5: == 8 - Element 6: == 13 - Element 7: == 21 - - The following call appends the element 34 at index 8, and - updates the cardinality. - ./ - - appndi_c ( 34, &fibNums ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - --Version - - -CSPICE Version 1.0.0, 01-AUG-2002 (NJB) (HAN) - --Index_Entries - - append an item to an integer cell - --& -*/ - -{ /* Begin appndi_c */ - - - /* - Use discovery check-in. - */ - if ( return_c() ) - { - return; - } - - /* - Make sure we're working with an integer cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "appndi_c", SPICE_INT, cell ); - - - if ( cell->card == cell->size ) - { - chkin_c ( "appndi_c" ); - setmsg_c ( "The cell cannot accomodate the addition of the " - "element *" ); - errint_c ( "*", item ); - sigerr_c ( "SPICE(CELLTOOSMALL)" ); - chkout_c ( "appndi_c" ); - return; - } - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - /* - The item must be strictly greater than its predecessor, or - the input cell is no longer a set. - */ - if ( ( cell->isSet ) && ( cell->card > 0 ) ) - { - if ( item <= SPICE_CELL_ELEM_I(cell, cell->card-1) ) - { - cell->isSet = SPICEFALSE; - } - } - - - /* - Append the item to the cell and increment the cell's cardinality. - */ - SPICE_CELL_SET_I ( item, cell->card, cell ); - - (cell->card) ++; - - - /* - Sync the cell. - */ - zzsynccl_c ( C2F, cell ); - - -} /* End appndi_c */ diff --git a/ext/spice/src/cspice/approx.c b/ext/spice/src/cspice/approx.c deleted file mode 100644 index d7d8835f53..0000000000 --- a/ext/spice/src/cspice/approx.c +++ /dev/null @@ -1,144 +0,0 @@ -/* approx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure APPROX ( Approximate equality ) */ -logical approx_(doublereal *x, doublereal *y, doublereal *tol) -{ - /* System generated locals */ - doublereal d__1; - logical ret_val; - -/* $ Abstract */ - -/* True if two double precision numbers are equal to within some */ -/* tolerance. */ - -/* $ 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 */ - -/* COMPARE */ -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X, */ -/* Y I Double precision numbers. */ -/* TOL I Tolerance. */ - -/* The function is true whenever |X - Y| < TOL. */ -/* - */ - -/* $ Detailed_Input */ - -/* X, */ -/* Y are arbitrary double precision numbers. */ - -/* TOL is a tolerance. X and Y are considered to be equal */ -/* if they differ by no more than this amount. If TOL */ -/* is negative, X and Y are never considered equal. */ - -/* $ Detailed_Output */ - -/* The function is true whenever |X - Y| < TOL, and is false */ -/* otherwise. - */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* C */ -/* C If the eccentricity is near one, this a parabola. */ -/* C */ -/* IF ( APPROX ( ECC, 1.D0, 10.D-12 ) ) THEN */ -/* TYPE = 'PARABOLA' */ - -/* ELSE IF ( ECC .LT. 1 ) THEN */ -/* TYPE = 'ELLIPSE' */ - -/* ELSE */ -/* TYPE = 'HYPERBOLA' */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* approximate equality */ - -/* -& */ - -/* Just shorthand, really. */ - - ret_val = (d__1 = *x - *y, abs(d__1)) <= *tol; - return ret_val; -} /* approx_ */ - diff --git a/ext/spice/src/cspice/astrip.c b/ext/spice/src/cspice/astrip.c deleted file mode 100644 index 44f9f010c8..0000000000 --- a/ext/spice/src/cspice/astrip.c +++ /dev/null @@ -1,239 +0,0 @@ -/* astrip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ASTRIP ( STRIP Ascii characters from a string ) */ -/* Subroutine */ int astrip_(char *instr, char *asciib, char *asciie, char * - outstr, ftnlen instr_len, ftnlen asciib_len, ftnlen asciie_len, - ftnlen outstr_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, i__, j, k; - extern integer lastnb_(char *, ftnlen); - integer lwrbnd, uprbnd, outlen; - -/* $ Abstract */ - -/* Remove from a character string all characters which fall */ -/* between specified starting and ending characters, inclusive. */ - -/* $ 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 */ - -/* ASCII, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INSTR I Input string. */ -/* ASCIIB I First ASCII character in range to be stripped. */ -/* ASCIIE I Last ASCII character in range to be stripped. */ -/* OUTSTR O Output (stripped) string. */ - -/* $ Detailed_Input */ - -/* INSTR Is a character string from which all characters */ -/* between ASCIIB and ASCIIE, inclusive, are to be */ -/* removed. */ - -/* ASCIIB Is the first ASCII character in the range of */ -/* characters to be removed from the input string. */ -/* ASCIIB is itself removed from the string, if */ -/* it occurs. */ - -/* ASCIIE Is the last ASCII character in the range of */ -/* characters to be removed from the input string. */ -/* ASCIIE is itself removed from the string, if */ -/* it occurs. */ - -/* $ Detailed_Output */ - -/* OUTSTR Is the input string after all the character */ -/* between ASCIIB and ASCIIE, inclusive, have */ -/* been removed. */ - -/* If OUTSTR is not large enough to hold the output */ -/* string, it is truncated on the right. */ - -/* OUTSTR may overwrite INSTR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* ASTRIP checks each character */ -/* in INSTR to determine if it falls between the characters ASCIIB */ -/* and ASCIIE. If so this character is removed from the string */ -/* (and the string is shortened). Remaining characters are copied */ -/* to the output string. */ - -/* $ Examples */ - -/* The following examples illustrate the use of ASTRIP. */ - -/* ASCIIB = 'b' */ -/* ASCIIE = 'k' */ -/* INSTR = 'Now is the time for all good men to come quick.' */ -/* OUTSTR = 'Now s t tm or all oo mn to om qu.' */ - -/* ASCIIB = 'a' */ -/* ASCIIE = 'z' */ -/* INSTR = 'SELECT column TIME FROM table TEST' */ -/* OUTSTR = 'SELECT TIME FROM TEST' */ - -/* ASCIIB = 'a' */ -/* ASCIIE = 'z' */ -/* INSTR = 'this is going to be an empty string' */ -/* OUTSTR = ' ' */ - -/* ASCIIB = '!' */ -/* ASCIIE = '!' */ -/* INSTR = 'Only 32 more shopping days until Christmas!' */ -/* OUTSTR = 'Only 32 more shopping days until Christmas' */ - -/* ASTRIP may also be used to strip ASCII control characters */ -/* (line feeds, tab stops, and so on), as shown in the example */ -/* below. */ - -/* ASCIIB = CHAR ( 0 ) */ -/* ASCIIE = CHAR ( 31 ) */ -/* CALL ASTRIP ( STRING, ASCIIB, ASCIIE, STRING ) */ - -/* $ Restrictions */ - -/* If ASCIIB and ASCIIE are not properly ordered (that is, */ -/* if ICHAR(ASCIIB) is not less than or equal to ICHAR(ASCIIE)) */ -/* then ASTRIP will not function as described. (In fact, it will */ -/* copy the input string to the output string without change.) */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* strip ascii characters from a string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Find the length of the output string. We don't want to */ -/* exceed it. */ - - outlen = i_len(outstr, outstr_len); - -/* Find the last non-blank character of the input string. */ - - last = lastnb_(instr, instr_len); - -/* Get the numeric representation of ASCIIB and ASCIIE. */ - - lwrbnd = *(unsigned char *)asciib; - uprbnd = *(unsigned char *)asciie; - -/* Step through INSTR (I) a character at a time, transferring */ -/* characters to OUTSTR (J) whenever they fall outside the range */ -/* [ASCIIB, ASCIIE]. */ - -/* If the end of OUTSTR is reached, stop transferring characters */ -/* and return. */ - - j = 0; - i__1 = last; - for (i__ = 1; i__ <= i__1; ++i__) { - k = *(unsigned char *)&instr[i__ - 1]; - if (k < lwrbnd || k > uprbnd) { - -/* The character is kept. Note that if the user inputs */ -/* ASCIIB and ASCIIE in the wrong order this test will */ -/* always succeed so that the output string will be */ -/* the same as the input string. */ - - ++j; - *(unsigned char *)&outstr[j - 1] = *(unsigned char *)&instr[i__ - - 1]; - if (j == outlen) { - return 0; - } - } - } - -/* Pad the output string with blanks. */ - - if (j < outlen) { - i__1 = j; - s_copy(outstr + i__1, " ", outstr_len - i__1, (ftnlen)1); - } - return 0; -} /* astrip_ */ - diff --git a/ext/spice/src/cspice/axisar.c b/ext/spice/src/cspice/axisar.c deleted file mode 100644 index 6debcf2310..0000000000 --- a/ext/spice/src/cspice/axisar.c +++ /dev/null @@ -1,255 +0,0 @@ -/* axisar.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure AXISAR ( Axis and angle to rotation ) */ -/* Subroutine */ int axisar_(doublereal *axis, doublereal *angle, doublereal * - r__) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int ident_(doublereal *); - doublereal vtemp[3]; - extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal - *, doublereal *); - -/* $ Abstract */ - -/* Construct a rotation matrix that rotates vectors by a specified */ -/* angle about a specified axis. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATRIX */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* AXIS I Rotation axis. */ -/* ANGLE I Rotation angle, in radians. */ -/* R O Rotation matrix corresponding to AXIS and ANGLE. */ - -/* $ Detailed_Input */ - -/* AXIS, */ -/* ANGLE are, respectively, a rotation axis and a rotation */ -/* angle. AXIS and ANGLE determine a coordinate */ -/* transformation whose effect on any vector V is to */ -/* rotate V by ANGLE radians about the vector AXIS. */ - -/* $ Detailed_Output */ - -/* R is a rotation matrix representing the coordinate */ -/* transformation determined by AXIS and ANGLE: for */ -/* each vector V, R*V is the vector resulting from */ -/* rotating V by ANGLE radians about AXIS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If AXIS is the zero vector, the rotation generated is the */ -/* identity. This is consistent with the specification of VROTV. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* AXISAR can be thought of as a partial inverse of RAXISA. AXISAR */ -/* really is a `left inverse': the code fragment */ - -/* CALL RAXISA ( R, AXIS, ANGLE ) */ -/* CALL AXISAR ( AXIS, ANGLE, R ) */ - -/* preserves R, except for round-off error, as long as R is a */ -/* rotation matrix. */ - -/* On the other hand, the code fragment */ - -/* CALL AXISAR ( AXIS, ANGLE, R ) */ -/* CALL RAXISA ( R, AXIS, ANGLE ) */ - -/* preserves AXIS and ANGLE, except for round-off error, only if */ -/* ANGLE is in the range (0, pi). So AXISAR is a right inverse */ -/* of RAXISA only over a limited domain. */ - -/* $ Examples */ - -/* 1) A matrix that rotates vectors by pi/2 radians about the z-axis */ -/* can be found using the code fragment */ - -/* AXIS(1) = 0.D0 */ -/* AXIS(2) = 0.D0 */ -/* AXIS(3) = 1.D0 */ - -/* CALL AXISAR ( AXIS, HALFPI(), R ) */ - -/* The returned matrix R will equal */ - -/* +- -+ */ -/* | 0 -1 0 | */ -/* | | */ -/* | 1 0 0 |. */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - - -/* 2) Linear interpolation between two rotation matrices: */ - -/* Let R(t) be a time-varying rotation matrix; R could be */ -/* a C-matrix describing the orientation of a spacecraft */ -/* structure. Given two points in time t1 and t2 at which */ -/* R(t) is known, and given a third time t3, where */ - -/* t1 < t3 < t2, */ - -/* we can estimate R(t3) by linear interpolation. In other */ -/* words, we approximate the motion of R by pretending that */ -/* R rotates about a fixed axis at a uniform angular rate */ -/* during the time interval [t1, t2]. More specifically, we */ -/* assume that each column vector of R rotates in this */ -/* fashion. This procedure will not work if R rotates through */ -/* an angle of pi radians or more during the time interval */ -/* [t1, t2]; an aliasing effect would occur in that case. */ - -/* If we let */ - -/* R1 = R(t1) */ -/* R2 = R(t2), and */ - -/* -1 */ -/* Q = R2 * R1 , */ - -/* then the rotation axis and angle of Q define the rotation */ -/* that each column of R(t) undergoes from time t1 to time */ -/* t2. Since R(t) is orthogonal, we can find Q using the */ -/* transpose of R1. We find the rotation axis and angle via */ -/* RAXISA. */ - -/* CALL MXMT ( R2, R1, Q ) */ -/* CALL RAXISA ( Q, AXIS, ANGLE ) */ - -/* Find the fraction of the total rotation angle that R */ -/* rotates through in the time interval [t1, t3]. */ - -/* FRAC = ( T3 - T1 ) / ( T2 - T1 ) */ - -/* Finally, find the rotation DELTA that R(t) undergoes */ -/* during the time interval [t1, t3], and apply that rotation */ -/* to R1, yielding R(t3), which we'll call R3. */ - -/* CALL AXISAR ( AXIS, FRAC * ANGLE, DELTA ) */ -/* CALL MXM ( DELTA, R1, R3 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VROTV call. */ - -/* - 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, 30-AUG-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* axis and angle to rotation */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VROTV call. */ - -/* Identity matrix is now obtained from IDENT. */ - -/* -& */ - -/* Local variables */ - - -/* First, set R equal to the identity. */ - - ident_(r__); - -/* The matrix we want rotates EVERY vector by ANGLE about AXIS. */ -/* In particular, it does so to our basis vectors. The columns */ -/* of R are the images of the basis vectors under this rotation. */ - - for (i__ = 1; i__ <= 3; ++i__) { - vrotv_(&r__[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "r", i__1, "axisar_", (ftnlen)240)], axis, angle, vtemp); - vequ_(vtemp, &r__[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : - s_rnge("r", i__1, "axisar_", (ftnlen)241)]); - } - return 0; -} /* axisar_ */ - diff --git a/ext/spice/src/cspice/axisar_c.c b/ext/spice/src/cspice/axisar_c.c deleted file mode 100644 index 11d5ced651..0000000000 --- a/ext/spice/src/cspice/axisar_c.c +++ /dev/null @@ -1,226 +0,0 @@ -/* - --Procedure axisar_c ( Axis and angle to rotation ) - --Abstract - - Construct a rotation matrix that rotates vectors by a specified - angle about a specified axis. - --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 - - ROTATION - --Keywords - - MATRIX - ROTATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef axisar_c - - - void axisar_c ( ConstSpiceDouble axis [3], - SpiceDouble angle, - SpiceDouble r [3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - axis I Rotation axis. - angle I Rotation angle, in radians. - r O Rotation matrix corresponding to axis and angle. - --Detailed_Input - - axis, - angle are, respectively, a rotation axis and a rotation - angle. axis and angle determine a coordinate - transformation whose effect on any vector v is to - rotate v by angle radians about the vector axis. - --Detailed_Output - - r is a rotation matrix representing the coordinate - transformation determined by axis and angle: for - each vector v, r*v is the vector resulting from - rotating v by angle radians about axis. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If axis is the zero vector, the rotation generated is the - identity. This is consistent with the specification of vrotv. - --Files - - None. - --Particulars - - axisar_c can be thought of as a partial inverse of raxisa_c. - axisar_c is really is a `left inverse': the code fragment - - raxisa_c ( r, axis, &angle ); - axisar_c ( axis, angle, r ); - - preserves r, except for round-off error, as long as r is a - rotation matrix. - - On the other hand, the code fragment - - axisar_c ( axis, angle, r ); - raxisa_c ( r, axis, &angle ); - - preserves axis and angle, except for round-off error, only if - angle is in the range (0, pi). So axisar_c is a right inverse - of raxisa_c only over a limited domain. - --Examples - - 1) A matrix that rotates vectors by pi/2 radians about the z-axis - can be found using the code fragment - - axis[0] = 0. - axis[1] = 0. - axis[2] = 1. - - axisar_c ( axis, halfpi_c(), r ); - - The returned matrix r will equal - - +- -+ - | 0 -1 0 | - | | - | 1 0 0 |. - | | - | 0 0 1 | - +- -+ - - - 2) Linear interpolation between two rotation matrices: - - Let r(t) be a time-varying rotation matrix; r could be - a C-matrix describing the orientation of a spacecraft - structure. Given two points in time t1 and t2 at which - r(t) is known, and given a third time t3, where - - t1 < t3 < t2, - - we can estimate r(t3) by linear interpolation. In other - words, we approximate the motion of r by pretending that - r rotates about a fixed axis at a uniform angular rate - during the time interval [t1, t2]. More specifically, we - assume that each column vector of r rotates in this - fashion. This procedure will not work if r rotates through - an angle of pi radians or more during the time interval - [t1, t2]; an aliasing effect would occur in that case. - - If we let - - r1 = r(t1) - r2 = r(t2), and - - -1 - q = r2 * r1 , - - then the rotation axis and angle of q define the rotation - that each column of r(t) undergoes from time t1 to time - t2. Since r(t) is orthogonal, we can find q using the - transpose of r1. We find the rotation axis and angle via - raxisa_c. - - mxmt_c ( r2, r1, q ); - raxisa_c ( q, axis, &angle ); - - Find the fraction of the total rotation angle that r - rotates through in the time interval [t1, t3]. - - frac = ( t3 - t1 ) / ( t2 - t1 ) - - Finally, find the rotation delta that r(t) undergoes - during the time interval [t1, t3], and apply that rotation - to r1, yielding r(t3), which we'll call r3. - - axisar_c ( axis, frac * angle, delta ); - mxm_c ( delta, r1, r3 ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 18-JUN-1999 (NJB) - --Index_Entries - - axis and angle to rotation - --& -*/ - -{ /* Begin axisar_c */ - - - - /* - Error free: no error tracing required. - */ - - axisar_ ( ( doublereal * ) axis, - ( doublereal * ) &angle, - ( doublereal * ) r ); - - /* - Transpose the output matrix to put it in row-major order. - */ - - xpose_c ( r, r ); - - -} /* End axisar_c */ diff --git a/ext/spice/src/cspice/b1900.c b/ext/spice/src/cspice/b1900.c deleted file mode 100644 index b216222b19..0000000000 --- a/ext/spice/src/cspice/b1900.c +++ /dev/null @@ -1,126 +0,0 @@ -/* b1900.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure B1900 ( Besselian Date 1900.0 ) */ -doublereal b1900_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the Julian Date corresponding to Besselian Date 1900.0. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the Julian Date corresponding to Besselian */ -/* date 1900.0. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns 2415020.31352, the Julian Date corresponding */ -/* to Besselian Date 1900.0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of B1900. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (B1900). */ -/* C */ -/* SPREF = ( JD - B1900() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* besselian date 1900.0 */ - -/* -& */ - ret_val = 2415020.31352; - return ret_val; -} /* b1900_ */ - diff --git a/ext/spice/src/cspice/b1900_c.c b/ext/spice/src/cspice/b1900_c.c deleted file mode 100644 index b2d07a6799..0000000000 --- a/ext/spice/src/cspice/b1900_c.c +++ /dev/null @@ -1,136 +0,0 @@ -/* - --Procedure b1900_c ( Besselian Date 1900.0 ) - --Abstract - - Return the Julian Date corresponding to Besselian Date 1900.0. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble b1900_c ( void ) - -/* - --Brief_I/O - - The function returns the Julian Date corresponding to Besselian - date 1900.0. - --Detailed_Input - - None. - --Detailed_Output - - The function returns 2415020.31352, the Julian Date corresponding - to Besselian Date 1900.0 as reported by Lieske [1]. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - Lieske [1] defines a mapping from Julian Ephemeris Date - to Besselian: - - BE = 1900. + (JED - 2415020.31352)/365.242198781 - - The inverse mapping being: - - JED = (BE - 1900.)*365.242198781 + 2415020.31352 - --Examples - - The following code fragment illustrates the use of b1900_c. - - /. - Convert Julian Date to UTC seconds past the reference - epoch (B1900). - ./ - - spref = ( jd - b1900_c() ) * spd_c(); - --Restrictions - - None. - --Literature_References - - [1] Jay Lieske, ``Precession Matrix Based on IAU (1976) - System of Astronomical Constants,'' Astron. Astrophys. - 73, 282-284 (1979). - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 01-SEP-2005 (EDW) - - Added journal reference and associated citations. - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - besselian date 1900.0 - --& -*/ - -{ /* Begin b1900_c */ - - return 2415020.31352; - -} /* End b1900_c */ diff --git a/ext/spice/src/cspice/b1950.c b/ext/spice/src/cspice/b1950.c deleted file mode 100644 index 5799defd51..0000000000 --- a/ext/spice/src/cspice/b1950.c +++ /dev/null @@ -1,144 +0,0 @@ -/* b1950.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure B1950 ( Besselian Date 1950.0 ) */ -doublereal b1950_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the Julian Date corresponding to Besselian Date 1950.0. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the Julian Date corresponding to Besselian */ -/* date 1950.0. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns 2433282.42345905, the Julian Date */ -/* corresponding to Besselian Date 1950.0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of B1950. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (B1950). */ -/* C */ -/* SPREF = ( JD - B1950() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Jay Lieske, ``Precession Matrix Based on IAU (1976) */ -/* System of Astronomical Constants,'' Astron. Astrophys. */ -/* 73, 282-284 (1979). */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 18-AUG-2008 (EDW) */ - -/* Edited the value stated in Detailed_Output to match the */ -/* current return value. The edit changed: */ - -/* 2433282.423 */ - -/* to */ - -/* 2433282.42345905 */ - -/* - SPICELIB Version 2.0.0, 30-JUL-1993 (WLT) */ - -/* The value of B1950 was updated to reflect the value given */ -/* by Lieske in [1] */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* besselian date 1950.0 */ - -/* -& */ - ret_val = 2433282.42345905; - return ret_val; -} /* b1950_ */ - diff --git a/ext/spice/src/cspice/b1950_c.c b/ext/spice/src/cspice/b1950_c.c deleted file mode 100644 index 18bbdee79f..0000000000 --- a/ext/spice/src/cspice/b1950_c.c +++ /dev/null @@ -1,154 +0,0 @@ -/* - --Procedure b1950_c ( Besselian Date 1950.0 ) - --Abstract - - Return the Julian Date corresponding to Besselian Date 1950.0. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble b1950_c ( void ) - -/* - --Brief_I/O - - The function returns the Julian Date corresponding to Besselian - date 1950.0. - --Detailed_Input - - None. - --Detailed_Output - - The function returns 2433282.42345905, the Julian Date corresponding - to Besselian Date 1950.0 as reported by Lieske [1]. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - Lieske [1] defines a mapping from Julian Ephemeris Date - to Besselian: - - BE = 1900. + (JED - 2415020.31352)/365.242198781 - - The inverse mapping being: - - JED = (BE - 1900.)*365.242198781 + 2415020.31352 - --Examples - - The following code fragment illustrates the use of b1950_c. - - /. - Convert Julian Date to UTC seconds past the reference - epoch (b1950_c). - ./ - - spref = ( jd - b1950_c() ) * spd_c(); - --Restrictions - - None. - --Literature_References - - [1] Jay Lieske, ``Precession Matrix Based on IAU (1976) - System of Astronomical Constants,'' Astron. Astrophys. - 73, 282-284 (1979). - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 2.0.0, 01-SEP-2005 (EDW) - - This routine now returns the value reported in the Lieske - paper: - - 2433282.42345905 - - The same value returned by the FORTRAN SPICELIB routine - B1950. - - This routine previously returned the value reported in the - "Explanatory Supplement to the Astronomical Almanac", 1992, - page 699: - - 2433282.423 - - The ESAA value describing a truncation of the Lieske value. - The difference between the two values expressed as seconds - yields approximately 39.662 seconds. - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - besselian date 1950.0 - --& -*/ - -{ /* Begin b1950_c */ - - - return 2433282.42345905; - - -} /* End b1950_c */ diff --git a/ext/spice/src/cspice/backspace.c b/ext/spice/src/cspice/backspace.c deleted file mode 100644 index c3fa545df2..0000000000 --- a/ext/spice/src/cspice/backspace.c +++ /dev/null @@ -1,69 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#ifdef KR_headers -integer f_back(a) alist *a; -#else -integer f_back(alist *a) -#endif -{ unit *b; - long v, w, x, y, z; - uiolen n; - FILE *f; - - f__curunit = b = &f__units[a->aunit]; /* curunit for error messages */ - if(a->aunit >= MXUNIT || a->aunit < 0) - err(a->aerr,101,"backspace") - if(b->useek==0) err(a->aerr,106,"backspace") - if((f = b->ufd) == NULL) { - fk_open(1, 1, a->aunit); - return(0); - } - if(b->uend==1) - { b->uend=0; - return(0); - } - if(b->uwrt) { - (void) t_runc(a); - if (f__nowreading(b)) - err(a->aerr,errno,"backspace") - } - if(b->url>0) - { - x=ftell(f); - y = x % b->url; - if(y == 0) x--; - x /= b->url; - x *= b->url; - (void) fseek(f,x,SEEK_SET); - return(0); - } - - if(b->ufmt==0) - { fseek(f,-(long)sizeof(uiolen),SEEK_CUR); - fread((char *)&n,sizeof(uiolen),1,f); - fseek(f,-(long)n-2*sizeof(uiolen),SEEK_CUR); - return(0); - } - w = x = ftell(f); - z = 0; - loop: - while(x) { - x -= x < 64 ? x : 64; - fseek(f,x,SEEK_SET); - for(y = x; y < w; y++) { - if (getc(f) != '\n') - continue; - v = ftell(f); - if (v == w) { - if (z) - goto break2; - goto loop; - } - z = v; - } - err(a->aerr,(EOF),"backspace") - } - break2: - fseek(f, z, SEEK_SET); - return 0; -} diff --git a/ext/spice/src/cspice/badkpv.c b/ext/spice/src/cspice/badkpv.c deleted file mode 100644 index 59b0ce5c99..0000000000 --- a/ext/spice/src/cspice/badkpv.c +++ /dev/null @@ -1,393 +0,0 @@ -/* badkpv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BADKPV ( Bad Kernel Pool Variable ) */ -logical badkpv_(char *caller, char *name__, char *comp, integer *size, - integer *divby, char *type__, ftnlen caller_len, ftnlen name_len, - ftnlen comp_len, ftnlen type_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical eqchr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - char class__[1]; - logical found; - integer ratio; - logical ok; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer dim; - -/* $ Abstract */ - -/* Determine if a kernel pool variable is present and if so */ -/* that it has the correct size and type. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CALLER I Name of the routine calling this routine. */ -/* NAME I Name of a kernel pool variable */ -/* COMP I Comparison operator. */ -/* SIZE I Expected size of the kernel pool variable */ -/* DIVBY I A divisor of the size of the kernel pool variable. */ -/* TYPE I Expected type of the kernel pool variable */ - -/* The function returns FALSE if the kernel pool variable is OK */ - -/* $ Detailed_Input */ - -/* CALLER is the name of the routine calling this routine */ -/* to check correctness of kernel pool variables. */ - -/* NAME is the name of a kernel pool variable that the */ -/* calling program expects to be present in the */ -/* kernel pool. */ - -/* COMP is the comparison operator to use when comparing */ -/* the number of components of the kernel pool variable */ -/* specified by NAME with the integer SIZE. If DIM is */ -/* is the actual size of the kernel pool variable then */ -/* BADKPV will check that the sentence */ - -/* DIM COMP SIZE */ - -/* is a true statement. If it is not a true statement */ -/* an error will be signalled. */ - -/* Allowed values for COMP and their meanings are: */ - -/* '=' DIM .EQ. SIZE */ -/* '<' DIM .LT. SIZE */ -/* '>' DIM .GT. SIZE */ -/* '=>' DIM .GE. SIZE */ -/* '<=' DIM .LE. SIZE */ - - -/* SIZE is an integer to compare with the actual */ -/* number of components of the kernel pool variable */ -/* specified by NAME. */ - -/* DIVBY is an integer that is one of the factors of the */ -/* actual dimension of the specified kernel pool variable. */ -/* In other words, it is expected that DIVBY evenly */ -/* divides the actual dimension of NAME. In those */ -/* cases in which the factors of the dimension of NAME */ -/* are not important, set DIVBY to 1 in the calling */ -/* program. */ - -/* TYPE is the expected type of the kernel pool variable. */ -/* Recognize values are */ - -/* 'C' for character type */ -/* 'N' for numeric type (integer and double precision) */ - -/* The case of type is insignificant. If the value */ -/* of TYPE is not one of the 2 values given above */ -/* no check for the type of the variable will be */ -/* performed. */ - - -/* $ Detailed_Output */ - -/* The function returns the value FALSE if the kernel pool variable */ -/* has the expected properties. Otherwise the routine signals */ -/* an error and returns the value .TRUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the kernel pool variable specified by NAME is not */ -/* present in the kernels pool, the error */ -/* 'SPICE(VARIABLENOTFOUND)' will be signalled and the */ -/* routine will return the value .TRUE. */ - -/* 2) If the comparison operator specified by COMP is unrecognized */ -/* the error 'SPICE(UNKNOWNCOMPARE)' will be signalled and the */ -/* routine will return the value .TRUE. */ - -/* 3) If the comparison of the actual size of the kernel pool */ -/* variable with SIZE is not satisfied, the error */ -/* 'SPICE(BADVARIABLESIZE)' will be signalled and the */ -/* routine will return the value .TRUE. */ - -/* 4) If the variable does not have the expected type, the error */ -/* 'SPICE(BADVARIABLETYPE)' will be signalled and the routine */ -/* will return the value .TRUE. */ - -/* $ Particulars */ - -/* This routine takes care of routine checking that often needs */ -/* to be done by programs and routines that rely upon kernel */ -/* pool variables being present and having the correct attributes. */ - -/* It checks for the presence of the kernel pool variable and */ -/* examines the type and dimension of the variable to make sure */ -/* they conform to the requirements of the calling routine. */ - -/* $ Examples */ - -/* Suppose that you need to fetch a number of variables */ -/* from the kernel pool and want to check that the requested */ -/* items are in fact available prior to performing further */ -/* computations. The following shows how you might use */ -/* this routine to handle the details of checking of */ -/* the various items. */ - -/* CALLER = 'MYROUTINE' */ - -/* We need some data for body 399 and we expect there to be an */ -/* even number of items available and at least 4 such items. */ -/* Moreover we expect these items to be numeric. Note that */ -/* The variable assignments below are comments and are present */ -/* only to assist in understanding the calls to BADKPV. */ - -/* C NAME = 'BODY_399_DATA' */ -/* C COMP = '=>' */ -/* C SIZE = 4 */ -/* C DIVBY = 2 */ -/* C TYPE = 'N' */ - -/* In addition we need the units associated with this data. */ -/* We expect the units to be character and that the number */ -/* of components is 1. Since we expect only one item, the */ -/* number of items should be divisible by 1. */ - -/* C NAME = 'BODY_399_DATAUNIT' */ -/* C COMP = '=' */ -/* C SIZE = 1 */ -/* C DIVBY = 1 */ -/* C TYPE = 'C' */ - -/* IF ( BADKPV( CALLER, 'BODY_399_DATA', '=>', 4, 2, 'N') */ -/* . .OR. BADKPV( CALLER, 'BODY_399_DATAUNITS', '=', 1, 1, 'C')) */ -/* . THEN */ - -/* CALL CHKOUT ( 'MYROUTINE' ) */ -/* RETURN */ - -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.1.1, 10-MAY-2000 (WLT) */ - -/* Modified the example section so that it is consistent with */ -/* calling sequence for BADKPV. */ - -/* - SPICELIB Version 1.1.0, 26-AUG-1997 (WLT) */ - -/* Moved the initial assignment of BADKPV to the lines */ -/* prior to the check of RETURN(). This avoids returning */ -/* without having assigned value to BADKPV. */ - -/* - SPICELIB Version 1.0.0, 09-APR-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Check the properties of a kernel pool variable */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Until we know otherwise, we shall assume that we have */ -/* a bad kernel pool variable. */ - - ret_val = TRUE_; - if (return_()) { - return ret_val; - } - chkin_("BADKPV", (ftnlen)6); - -/* Look up the attributes of this variable in the kernel pool. */ - - dtpool_(name__, &found, &dim, class__, name_len, (ftnlen)1); - if (! found) { - setmsg_("#: The kernel pool variable '#' is not currently present in" - " the kernel pool. Possible reasons are that the appropriate " - "text kernel file has not been loaded via a call to FURNSH or" - " that the routine CLPOOL has been called after loading the a" - "ppropriate file. ", (ftnlen)256); - errch_("#", caller, (ftnlen)1, caller_len); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VARIABLENOTFOUND)", (ftnlen)23); - chkout_("BADKPV", (ftnlen)6); - return ret_val; - } - -/* Compare the dimension of the specified variable with the */ -/* input SIZE. */ - - if (s_cmp(comp, "=", comp_len, (ftnlen)1) == 0) { - ok = dim == *size; - } else if (s_cmp(comp, "<", comp_len, (ftnlen)1) == 0) { - ok = dim < *size; - } else if (s_cmp(comp, ">", comp_len, (ftnlen)1) == 0) { - ok = dim > *size; - } else if (s_cmp(comp, "<=", comp_len, (ftnlen)2) == 0) { - ok = dim <= *size; - } else if (s_cmp(comp, "=>", comp_len, (ftnlen)2) == 0) { - ok = dim >= *size; - } else { - setmsg_("#: The comparison operator '#' is not a recognized value. " - "The recognized values are '<', '<=', '=', '=>', '>'. ", ( - ftnlen)112); - errch_("#", caller, (ftnlen)1, caller_len); - errch_("#", comp, (ftnlen)1, comp_len); - sigerr_("SPICE(UNKNOWNCOMPARE)", (ftnlen)21); - chkout_("BADKPV", (ftnlen)6); - return ret_val; - } - -/* If the comparison was not favorable, signal an error */ -/* and return. */ - - if (! ok) { - setmsg_("#: The kernel pool variable '#' is expected to have a numbe" - "r of components DIM such that the comparison DIM # # is TRUE" - ". However, the current number of components for '#' is #. ", - (ftnlen)178); - errch_("#", caller, (ftnlen)1, caller_len); - errch_("#", name__, (ftnlen)1, name_len); - errch_("#", comp, (ftnlen)1, comp_len); - errint_("#", size, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &dim, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("BADKPV", (ftnlen)6); - return ret_val; - } - -/* Check to see that DIVBY evenly divides the dimension of */ -/* the variable. */ - - if (*divby != 0) { - ratio = dim / *divby; - } else { - ratio = 1; - } - if (*divby * ratio != dim) { - setmsg_("#: The number of components of the kernel pool variable '#'" - " is required to be divisible by #. However, the actual numb" - "er of components is # which is not evenly divisible by #. ", ( - ftnlen)177); - errch_("#", caller, (ftnlen)1, caller_len); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", divby, (ftnlen)1); - errint_("#", &dim, (ftnlen)1); - errint_("#", divby, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("BADKPV", (ftnlen)6); - return ret_val; - } - -/* Finally check the type of the variable. */ - - if (eqchr_(type__, "C", type_len, (ftnlen)1)) { - if (*(unsigned char *)class__ != 'C') { - setmsg_("#: The kernel pool variable '#' must be of type \"CHARA" - "CTER\". However, the current type is numeric. ", (ftnlen) - 99); - errch_("#", caller, (ftnlen)1, caller_len); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("BADKPV", (ftnlen)6); - return ret_val; - } - } else if (eqchr_(type__, "N", type_len, (ftnlen)1)) { - if (*(unsigned char *)class__ != 'N') { - setmsg_("#: The kernel pool variable '#' must be of type \"NUMER" - "IC\". However, the current type is character. ", (ftnlen) - 100); - errch_("#", caller, (ftnlen)1, caller_len); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("BADKPV", (ftnlen)6); - return ret_val; - } - } - ret_val = FALSE_; - chkout_("BADKPV", (ftnlen)6); - return ret_val; -} /* badkpv_ */ - diff --git a/ext/spice/src/cspice/badkpv_c.c b/ext/spice/src/cspice/badkpv_c.c deleted file mode 100644 index 3e79d0061c..0000000000 --- a/ext/spice/src/cspice/badkpv_c.c +++ /dev/null @@ -1,281 +0,0 @@ -/* - --Procedure badkpv_c ( Bad Kernel Pool Variable ) - --Abstract - - Determine if a kernel pool variable is present and if so - that it has the correct size and type. - --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 - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - SpiceBoolean badkpv_c ( ConstSpiceChar *caller, - ConstSpiceChar *name, - ConstSpiceChar *comp, - SpiceInt size, - SpiceInt divby, - SpiceChar type ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - caller I Name of the routine calling this routine. - name I Name of a kernel pool variable - comp I Comparison operator. - size I Expected size of the kernel pool variable - divby I A divisor of the size of the kernel pool variable. - type I Expected type of the kernel pool variable - - The function returns SPICEFALSE if the kernel pool variable is OK. - --Detailed_Input - - caller is the name of the routine calling this routine - to check correctness of kernel pool variables. - - name is the name of a kernel pool variable that the - calling program expects to be present in the - kernel pool. - - comp is the comparison operator to use when comparing - the number of components of the kernel pool variable - specified by name with the integer size. If dim is - is the actual size of the kernel pool variable then - badkpv_c will check that the sentence - - dim comp size - - is a true statement. If it is not a true statement - an error will be signaled. - - Allowed values for comp and their meanings are: - - "=" dim == size - "<" dim < size - ">" dim > size - "=>" dim >= size - "<=" dim <= size - - - size is an integer to compare with the actual - number of components of the kernel pool variable - specified by name. - - divby is an integer that is one of the factors of the - actual dimension of the specified kernel pool variable. - In other words, it is expected that divby evenly - divides the actual dimension of name. In those - cases in which the factors of the dimension of name - are not important, set divby to 1 in the calling - program. - - type is the expected type of the kernel pool variable. - Recognized values are - - 'C' for character type - 'N' for numeric type (integer and double precision) - - The case of type is insignificant. If the value - of TYPE is not one of the 2 values given above - no check for the type of the variable will be - performed. - - --Detailed_Output - - The function returns the value SPICEFALSE if the kernel pool variable - has the expected properties. Otherwise the routine signals - an error and returns the value SPICETRUE. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the kernel pool variable specified by name is not - present in the kernel pool, the error - SPICE(VARIABLENOTFOUND) will be signaled and the - routine will return the value SPICETRUE. - - 2) If the comparison operator specified by comp is unrecognized - the error SPICE(UNKNOWNCOMPARE) will be signaled and the - routine will return the value SPICETRUE. - - 3) If the comparison of the actual size of the kernel pool - variable with size is not satisfied, the error - SPICE(BADVARIABLESIZE) will be signaled and the - routine will return the value SPICETRUE. - - 4) If the variable does not have the expected type, the error - SPICE(BADVARIABLETYPE) will be signaled and the routine - will return the value SPICETRUE. - - 5) If any input string pointers are null, the error - SPICE(NULLPOINTER) will be signaled. - - 6) If any input strings have length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Particulars - - This routine takes care of routine checking that often needs - to be done by programs and routines that rely upon kernel - pool variables being present and having the correct attributes. - - It checks for the presence of the kernel pool variable and - examines the type and dimension of the variable to make sure - they conform to the requirements of the calling routine. - --Examples - - Suppose that you need to fetch a number of variables - from the kernel pool and want to check that the requested - items are in fact available prior to performing further - computations. The following shows how you might use - this routine to handle the details of checking of - the various items. - - caller == "MYROUTINE" - - We need some data for body 399 and we expect there to - be an even number of items available. Moreover we - expect these items to be numeric. - - name == "BODY_399_DATA" - comp == ">" - size == 1 - divby == 2 - type == 'N' - - In addition we need the units associated with this data. - We expect the units to be character and that the number - of components is 1. - - name == "BODY_399_DATAUNIT"; - comp == "=" - size == 1 - divby == 1 - type == 'C' - - - if ( badkpv_c( caller, "BODY_399_DATA", ">", 1, 2, 'N' ) - || badkpv_c( caller, "BODY_399_DATAUNITS", "=", 1, 1, 'C' ) ) - { - chkout_c ( "MYROUTINE" ); - return; - } - - --Restrictions - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 07-JUL-2000 (WLT) (NJB) - --Index_Entries - - Check the properties of a kernel pool variable - --& -*/ - -{ /* Begin badkpv_c */ - - - /* - Local variables - */ - logical isbad; - - - /* - Participate in error tracing. - */ - chkin_c ( "badkpv_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "badkpv_c", caller, SPICETRUE ); - CHKFSTR_VAL ( CHK_STANDARD, "badkpv_c", name, SPICETRUE ); - CHKFSTR_VAL ( CHK_STANDARD, "badkpv_c", comp, SPICETRUE ); - - /* - Let the f2c'd routine do all the work. - */ - isbad = badkpv_ ( (char *) caller, - (char *) name, - (char *) comp, - (integer *) &size, - (integer *) &divby, - (char *) &type, - (ftnlen ) strlen(caller), - (ftnlen ) strlen(name), - (ftnlen ) strlen(comp), - (ftnlen ) 1 ); - - - chkout_c ( "badkpv_c" ); - - return ( (SpiceBoolean) isbad ); - -} /* End badkpv_c */ diff --git a/ext/spice/src/cspice/bedec.c b/ext/spice/src/cspice/bedec.c deleted file mode 100644 index 9f265757a4..0000000000 --- a/ext/spice/src/cspice/bedec.c +++ /dev/null @@ -1,278 +0,0 @@ -/* bedec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure BEDEC ( Be a decimal number? ) */ -logical bedec_(char *string, ftnlen string_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer c__, d__, e, l; - extern logical beint_(char *, ftnlen), beuns_(char *, ftnlen); - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine whether a string represents a decimal number. */ - -/* $ 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 */ - -/* WORDS */ - -/* $ Keywords */ - -/* ALPHANUMERIC */ -/* NUMBERS */ -/* SCANNING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Character string. */ - -/* The function returns TRUE if the string represents a decimal */ -/* number. Otherwise, it returns FALSE. */ - -/* $ Detailed_Input */ - -/* STRING is any string. */ - -/* $ Detailed_Output */ - -/* If the input string contains a decimal number (as defined */ -/* in $Particulars below), the function returns TRUE. Otherwise, */ -/* the functions returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A decimal number may be constructed by concatenating */ -/* the following components in the order shown. */ - -/* 1) A sign ('+' or '-'), or the null string. */ - -/* 2) An unsigned integer (as defined by function BEUNS), */ -/* or the null string. */ - -/* 3) A decimal point, or the null string. */ - -/* 4) An unsigned integer, or the null string. */ - -/* $ Examples */ - -/* Four classes of numbers recognized by the various BE functions. */ - -/* UNS unsigned integer */ -/* INT integer (includes INT) */ -/* DEC decimal number (includes UNS, INT) */ -/* NUM number (includes UNS, INT, NUM) */ - -/* The following table illustrates the differences between */ -/* the classes. (Any number of leading and trailing blanks */ -/* are acceptable.) */ - -/* String Accepted by */ -/* ------------------ ------------------ */ -/* 0 UNS, INT, DEC, NUM */ -/* 21 */ -/* 21994217453648 */ - -/* +0 INT, DEC, NUM */ -/* -13 */ -/* +21946 */ - -/* 1.23 DEC, NUM */ -/* 12. */ -/* .17 */ -/* +4.1 */ -/* -.25 */ - -/* 2.3e17 NUM */ -/* 17.D-13275849 */ -/* -.194265E+0004 */ - -/* Note that the functions don't take the magnitudes of the numbers */ -/* into account. They may accept numbers that cannot be represented */ -/* in Fortran variables. (For example, '2.19E999999999999' probably */ -/* exceeds the maximum floating point number on any machine, but */ -/* is perfectly acceptable to BENUM.) */ - -/* The following strings are not accepted by any of the functions. */ - -/* String Reason */ -/* --------------- ---------------------------------------- */ -/* 3/4 No implied operations (rational numbers) */ -/* 37+14 No explicit operations */ -/* E12 Must have mantissa */ -/* 217,346.91 No commas */ -/* 3.14 159 264 No embedded spaces */ -/* PI No special numbers */ -/* FIVE No textual numbers */ -/* CXIV No roman numerals */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* determine if a string is a decimal number */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* First determine whether or not a decimal point is present. */ - - d__ = pos_(string, ".", &c__1, string_len, (ftnlen)1); - c__ = d__ - 1; - e = d__ + 1; - if (d__ == 0) { - -/* If there is no decimal point just apply the integer test. */ - - ret_val = beint_(string, string_len); - } else { - -/* A decimal point is present, get the length of the string */ -/* and see where the decimal point is relative to the last */ -/* character. */ - - l = i_len(string, string_len); - if (l == 1) { - -/* The string is one character long and a decimal point. */ -/* Sorry, this is not a decimal number. */ - - ret_val = FALSE_; - } else if (d__ == 1) { - -/* The decimal point occurs as the first character of the */ -/* string. The string following it must begin with */ -/* a non-blank character and be an unsigned integer. */ - - ret_val = *(unsigned char *)&string[e - 1] != ' ' && beuns_( - string + (e - 1), string_len - (e - 1)); - } else if (d__ == l) { - -/* The decimal point is the last character of the string. */ -/* The character that precedes it must be non-blank and */ -/* the substring to the left must be an integer. */ - - ret_val = *(unsigned char *)&string[c__ - 1] != ' ' && beint_( - string, c__); - } else if (*(unsigned char *)&string[c__ - 1] == ' ') { - -/* The decimal point occurs somewhere in the middle of the */ -/* string and the character preceding it is blank. */ - - ret_val = *(unsigned char *)&string[e - 1] != ' ' && s_cmp(string, - " ", c__, (ftnlen)1) == 0 && beuns_(string + (e - 1), - string_len - (e - 1)); - } else if (*(unsigned char *)&string[e - 1] == ' ') { - -/* Again the decimal point occurs somewhere in the middle of */ -/* the string and the character following it is blank. */ - - ret_val = s_cmp(string + (e - 1), " ", l - (e - 1), (ftnlen)1) == - 0 && *(unsigned char *)&string[c__ - 1] != ' ' && beint_( - string, c__); - } else if (*(unsigned char *)&string[c__ - 1] == '-' || *(unsigned - char *)&string[c__ - 1] == '+') { - -/* The decimal point is in the middle of the string and */ -/* is preceded by a '+' or '-'. There should be nothing */ -/* preceeding the sign and what follows the decimal point */ -/* should be an unsigned integer. (we already know that the */ -/* character following the decimal point is not a blank) */ - - if (c__ == 1) { - ret_val = beuns_(string + (e - 1), l - (e - 1)); - } else { - ret_val = beuns_(string + (e - 1), l - (e - 1)) && s_cmp( - string, " ", c__ - 1, (ftnlen)1) == 0; - } - } else { - -/* Last chance, the decimal point is in the middle of the */ -/* string. The characters to the right and left of the */ -/* point are non-blank and we know the character to the */ -/* left of the point is not a sign. The string left must */ -/* be an integer, the string to the right must be an */ -/* unsigned integer. */ - - ret_val = beint_(string, c__) && beuns_(string + (e - 1), l - (e - - 1)); - } - } - return ret_val; -} /* bedec_ */ - diff --git a/ext/spice/src/cspice/beint.c b/ext/spice/src/cspice/beint.c deleted file mode 100644 index 716ccbf05d..0000000000 --- a/ext/spice/src/cspice/beint.c +++ /dev/null @@ -1,227 +0,0 @@ -/* beint.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BEINT ( Be an Integer? ) */ -logical beint_(char *string, ftnlen string_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__, l; - extern logical beuns_(char *, ftnlen); - extern integer frstnb_(char *, ftnlen); - char letter[1]; - -/* $ Abstract */ - -/* Determine whether a string represents an integer. */ - -/* $ 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 */ - -/* WORDS */ - -/* $ Keywords */ - -/* ALPHANUMERIC */ -/* NUMBERS */ -/* SCANNING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Character string. */ - -/* The function returns TRUE if the string represents an integer. */ -/* Otherwise, it returns FALSE. */ - -/* $ Detailed_Input */ - -/* STRING is any string. */ - -/* $ Detailed_Output */ - -/* If the input string contains an integer (as defined in */ -/* $Particulars below), the function returns TRUE. Otherwise, */ -/* the function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* An integer may be either of the following: */ - -/* 1) An unsigned integer (as defined by function BEUNS). */ - -/* 2) A sign ('+' or '-') followed by an unsigned */ -/* integer. */ - -/* $ Examples */ - -/* Four classes of numbers recognized by the various BE functions. */ - -/* UNS unsigned integer */ -/* INT integer (includes INT) */ -/* DEC decimal number (includes UNS, INT) */ -/* NUM number (includes UNS, INT, NUM) */ - -/* The following table illustrates the differences between */ -/* the classes. (Any number of leading and trailing blanks */ -/* are acceptable.) */ - -/* String Accepted by */ -/* ------------------ ------------------ */ -/* 0 UNS, INT, DEC, NUM */ -/* 21 */ -/* 21994217453648 */ - -/* +0 INT, DEC, NUM */ -/* -13 */ -/* +21946 */ - -/* 1.23 DEC, NUM */ -/* 12. */ -/* .17 */ -/* +4.1 */ -/* -.25 */ - -/* 2.3e17 NUM */ -/* 17.D-13275849 */ -/* -.194265E+0004 */ - -/* Note that the functions don't take the magnitudes of the numbers */ -/* into account. They may accept numbers that cannot be represented */ -/* in Fortran variables. (For example, '2.19E999999999999' probably */ -/* exceeds the maximum floating point number on any machine, but */ -/* is perfectly acceptable to BENUM.) */ - -/* The following strings are not accepted by any of the functions. */ - -/* String Reason */ -/* --------------- ---------------------------------------- */ -/* 3/4 No implied operations (rational numbers) */ -/* 37+14 No explicit operations */ -/* E12 Must have mantissa */ -/* 217,346.91 No commas */ -/* 3.14 159 264 No embedded spaces */ -/* PI No special numbers */ -/* FIVE No textual numbers */ -/* CXIV No roman numerals */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* determine if a string is an integer */ - -/* -& */ - -/* Find the first non-blank character and the length of the */ -/* string. */ - - l = i_len(string, string_len); - i__ = frstnb_(string, string_len); - -/* If there isn't a non-blank character, this isn't an */ -/* integer. */ - - if (i__ == 0) { - ret_val = FALSE_; - return ret_val; - } - -/* Copy the first non-blank letter in the string. */ - - *(unsigned char *)letter = *(unsigned char *)&string[i__ - 1]; - if (i__ < l) { - -/* The first character is not the last, so we might start with */ -/* a plus or minus. If so the rest must be an unsigned integer. */ - - if (*(unsigned char *)letter == '+' || *(unsigned char *)letter == - '-') { - ++i__; - if (*(unsigned char *)&string[i__ - 1] != ' ') { - ret_val = beuns_(string + (i__ - 1), string_len - (i__ - 1)); - } else { - ret_val = FALSE_; - } - } else { - -/* If the first character isn't plus (+) or minus (-) */ -/* the string must be an unsigned integer if its going */ -/* to be an integer. */ - - ret_val = beuns_(string + (i__ - 1), string_len - (i__ - 1)); - } - } else { - -/* If the first (non-blank) character is the last one, then */ -/* it must be an unsigned integer, for the string to */ -/* represent an integer. */ - - ret_val = beuns_(letter, (ftnlen)1); - } - return ret_val; -} /* beint_ */ - diff --git a/ext/spice/src/cspice/benum.c b/ext/spice/src/cspice/benum.c deleted file mode 100644 index fb84a2edc8..0000000000 --- a/ext/spice/src/cspice/benum.c +++ /dev/null @@ -1,214 +0,0 @@ -/* benum.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure BENUM ( Be a number? ) */ -logical benum_(char *string, ftnlen string_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - extern logical bedec_(char *, ftnlen); - integer d__, e, f, l; - extern logical beint_(char *, ftnlen); - -/* $ Abstract */ - -/* Determine whether a string represents a number. */ - -/* $ 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 */ - -/* WORDS */ - -/* $ Keywords */ - -/* ALPHANUMERIC */ -/* NUMBERS */ -/* SCANNING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Character string. */ - -/* The function returns TRUE if the string is a number. */ -/* Otherwise, it returns FALSE. */ - -/* $ Detailed_Input */ - -/* STRING is any string. */ - -/* $ Detailed_Output */ - -/* If the input string contains a number (as defined in */ -/* $Particulars below) the function returns TRUE. Otherwise, */ -/* the function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A number may be either of the following: */ - -/* 1) A decimal number (as defined by function BEDEC). */ - -/* 2) A decimal number followed by an exponent character */ -/* ('E', 'e', 'D', or 'd') and an integer (as defined */ -/* by function BEINT). */ - -/* $ Examples */ - -/* Four classes of numbers recognized by the various BE functions. */ - -/* UNS unsigned integer */ -/* INT integer (includes INT) */ -/* DEC decimal number (includes UNS, INT) */ -/* NUM number (includes UNS, INT, NUM) */ - -/* The following table illustrates the differences between */ -/* the classes. (Any number of leading and trailing blanks */ -/* are acceptable.) */ - -/* String Accepted by */ -/* ------------------ ------------------ */ -/* 0 UNS, INT, DEC, NUM */ -/* 21 */ -/* 21994217453648 */ - -/* +0 INT, DEC, NUM */ -/* -13 */ -/* +21946 */ - -/* 1.23 DEC, NUM */ -/* 12. */ -/* .17 */ -/* +4.1 */ -/* -.25 */ - -/* 2.3e17 NUM */ -/* 17.D-13275849 */ -/* -.194265E+0004 */ - -/* Note that the functions don't take the magnitudes of the numbers */ -/* into account. They may accept numbers that cannot be represented */ -/* in Fortran variables. (For example, '2.19E999999999999' probably */ -/* exceeds the maximum floating point number on any machine, but */ -/* is perfectly acceptable to BENUM.) */ - -/* The following strings are not accepted by any of the functions. */ - -/* String Reason */ -/* --------------- ---------------------------------------- */ -/* 3/4 No implied operations (rational numbers) */ -/* 37+14 No explicit operations */ -/* E12 Must have mantissa */ -/* 217,346.91 No commas */ -/* 3.14 159 264 No embedded spaces */ -/* PI No special numbers */ -/* FIVE No textual numbers */ -/* CXIV No roman numerals */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* determine if a string is a number */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Determine whether or not there is an exponent character in the */ -/* string. */ - - l = i_len(string, string_len); - e = cpos_(string, "EeDd", &c__1, string_len, (ftnlen)4); - d__ = e - 1; - f = e + 1; - if (e == 0) { - -/* There is no exponent character, this is a number if it */ -/* is a decimal number. */ - - ret_val = bedec_(string, string_len); - } else if (e == 1 || e == l) { - ret_val = FALSE_; - } else if (*(unsigned char *)&string[d__ - 1] == ' ' || *(unsigned char *) - &string[f - 1] == ' ') { - ret_val = FALSE_; - } else { - ret_val = bedec_(string, d__) && beint_(string + (f - 1), l - (f - 1)) - ; - } - return ret_val; -} /* benum_ */ - diff --git a/ext/spice/src/cspice/beuns.c b/ext/spice/src/cspice/beuns.c deleted file mode 100644 index 7becf11e7d..0000000000 --- a/ext/spice/src/cspice/beuns.c +++ /dev/null @@ -1,225 +0,0 @@ -/* beuns.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BEUNS ( Be an unsigned integer? ) */ -logical beuns_(char *string, ftnlen string_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen), - s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, l; - logical ok; - extern integer frstnb_(char *, ftnlen); - -/* $ Abstract */ - -/* Determine whether a string represents an unsigned integer. */ - -/* $ 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 */ - -/* WORDS */ - -/* $ Keywords */ - -/* ALPHANUMERIC */ -/* NUMBERS */ -/* SCANNING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Character string. */ - -/* The function returns TRUE if the string represents an unsigned */ -/* integer. Otherwise, it returns FALSE. */ - -/* $ Detailed_Input */ - -/* STRING is any string. */ - -/* $ Detailed_Output */ - -/* If STRING contains a single word made entirely from the */ -/* characters '0' through '9', then the function returns TRUE. */ -/* Otherwise, it returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* By definition an unsigned integer is a word made exclusively */ -/* from the characters '0', '1', '2', '3', '4', '5', '6', '7', '8', */ -/* and '9'. */ - -/* $ Examples */ - - -/* Four classes of numbers recognized by the various BE functions. */ - -/* UNS unsigned integer */ -/* INT integer (includes INT) */ -/* DEC decimal number (includes UNS, INT) */ -/* NUM number (includes UNS, INT, NUM) */ - -/* The following table illustrates the differences between */ -/* the classes. (Any number of leading and trailing blanks */ -/* are acceptable.) */ - -/* String Accepted by */ -/* ------------------ ------------------ */ -/* 0 UNS, INT, DEC, NUM */ -/* 21 */ -/* 21994217453648 */ - -/* +0 INT, DEC, NUM */ -/* -13 */ -/* +21946 */ - -/* 1.23 DEC, NUM */ -/* 12. */ -/* .17 */ -/* +4.1 */ -/* -.25 */ - -/* 2.3e17 NUM */ -/* 17.D-13275849 */ -/* -.194265E+0004 */ - -/* Note that the functions don't take the magnitudes of the numbers */ -/* into account. They may accept numbers that cannot be represented */ -/* in Fortran variables. (For example, '2.19E999999999999' probably */ -/* exceeds the maximum floating point number on any machine, but */ -/* is perfectly acceptable to BENUM.) */ - -/* The following strings are not accepted by any of the functions. */ - -/* String Reason */ -/* --------------- ---------------------------------------- */ -/* 3/4 No implied operations (rational numbers) */ -/* 37+14 No explicit operations */ -/* E12 Must have mantissa */ -/* 217,346.91 No commas */ -/* 3.14 159 264 No embedded spaces */ -/* PI No special numbers */ -/* FIVE No textual numbers */ -/* CXIV No roman numerals */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* determine if a string is an unsigned integer */ - -/* -& */ - -/* SPICE functions */ - - -/* Local variables */ - - -/* Get the length of the string and the position of its */ -/* first non-blank character. */ - - l = i_len(string, string_len); - i__ = frstnb_(string, string_len); - -/* If there isn't a non-blank character, this isn't an */ -/* unsigned integer. */ - - if (i__ == 0) { - ret_val = FALSE_; - return ret_val; - } - -/* As far as we know right now, everything is ok. Examine */ -/* characters until we run out of string or until we */ -/* hit a non-digit character. */ - - ok = TRUE_; - while(ok && i__ <= l) { - if (i_indx("0123456789", string + (i__ - 1), (ftnlen)10, (ftnlen)1) > - 0) { - ++i__; - } else { - ok = FALSE_; - } - } - -/* If the string still is ok as an unsigned integer, it must be */ -/* one... */ - - if (ok) { - ret_val = TRUE_; - } else { - -/* ... otherwise, it's an unsigned integer if the remainder is blank. */ - - ret_val = s_cmp(string + (i__ - 1), " ", string_len - (i__ - 1), ( - ftnlen)1) == 0; - } - return ret_val; -} /* beuns_ */ - diff --git a/ext/spice/src/cspice/bodc2n.c b/ext/spice/src/cspice/bodc2n.c deleted file mode 100644 index adedb99a7f..0000000000 --- a/ext/spice/src/cspice/bodc2n.c +++ /dev/null @@ -1,265 +0,0 @@ -/* bodc2n.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BODC2N ( Body ID code to name translation ) */ -/* Subroutine */ int bodc2n_(integer *code, char *name__, logical *found, - ftnlen name_len) -{ - extern /* Subroutine */ int zzbodc2n_(integer *, char *, logical *, - ftnlen), chkin_(char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Translate the SPICE integer code of a body into a common name */ -/* for that body. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CODE I Integer ID code to be translated into a name. */ -/* NAME O A common name for the body identified by CODE. */ -/* FOUND O True if translated, otherwise false. */ -/* MAXL P Maximum length of NAME string. */ - -/* $ Detailed_Input */ - -/* CODE is an integer code for a body --- */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* $ Detailed_Output */ - -/* NAME is a common name of the body identified by CODE. */ -/* If CODE has more than one translation, then the */ -/* most recently defined NAME corresponding to CODE */ -/* is returned. NAME will have the exact format (case */ -/* and blanks) as when the name/code pair was defined. */ -/* If the input value of CODE is not recognized, NAME */ -/* will remain unchanged from its input value. */ - -/* FOUND is true if CODE has a translation. Otherwise, FOUND */ -/* is false. */ - -/* $ Parameters */ - -/* MAXL is the maximum allowable length of a body name. */ -/* This amount of storage space should be declared */ -/* to receive NAME, otherwise truncation may occur. */ -/* The value of this parameter may be found in the */ -/* include file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BODS2N is one of five related subroutines, */ - -/* BODS2C Body string to code */ -/* BODC2S Body code to string */ -/* BODN2C Body name to code */ -/* BODC2N Body code to name */ -/* BODDEF Body name/code definition */ - -/* BODS2C, BODC2S, BODN2C, and BODC2N perform translations between */ -/* body names and their corresponding integer ID codes which are */ -/* used in SPICE files and routines. */ - -/* BODS2C is a slightly more general version of BODN2C: support */ -/* for strings containing ID codes in string format enables a caller */ -/* to identify a body using a string, even when no name is */ -/* associated with that body. */ - -/* BODC2S is a general version of BODC2N; the routine returns either */ -/* the name assigned in the body ID to name mapping or a string */ -/* representation of the CODE value if no mapping exists. */ - -/* BODDEF assigns a body name to ID mapping. The mapping has */ -/* priority in name-to-ID and ID-to-name translations. */ - -/* Refer to NAIF_IDs for the list of name/code associations built */ -/* into SPICE, and for details concerning adding new name/code */ -/* associations at run time by loading text kernels. */ - -/* $ Examples */ - -/* 1. Suppose you ran the utility program SPACIT to summarize */ -/* an SPK ephemeris file and the following data was output */ -/* to the terminal screen. */ - -/* ---------------------------------------------------------- */ -/* Segment identifier: JPL archive 21354 */ -/* Body : -77 Center : 399 */ -/* From : 1990 DEC 08 18:00:00.000 */ -/* To : 1990 DEC 10 21:10:00.000 */ -/* Reference : DE-200 SPK Type :1 */ -/* ---------------------------------------------------------- */ - -/* You could write a program to translate the body codes */ -/* shown in the SPACIT output: */ - -/* CALL BODC2N ( -77, BODY, FOUND ) */ -/* CALL BODC2N ( 399, CENTER, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* WRITE ( *,* ) 'BODY: -77 = ', BODY */ -/* WRITE ( *,* ) 'CENTER: 399 = ', CENTER */ - -/* END IF */ - -/* You could also read the body and center codes directly from */ -/* the SPK files, using the appropriate DAF routines, and then */ -/* translate them, as above. */ - - -/* 2. In this example, we assume that BODDEF has not been called, */ -/* so only the set of default name/code pairs has */ -/* been defined. */ - -/* Given these names, BODN2C will return the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - - -/* Given these codes, BODC2N will return the following names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ -/* -1 - No */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* B.V. Semenov (JPL) */ -/* F.S. Turner (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 16-MAY-2009 (EDW) */ - -/* Edit to Particulars section to document the BODC2S routine. */ - -/* - SPICELIB Version 1.0.3, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.0.2, 26-AUG-2002 (FST) */ - -/* Added documentation discussing the parameter MAXL. */ - -/* - SPICELIB Version 1.0.1, 01-DEC-1998 (WLT) */ - -/* Added documentation that describes the output NAME if CODE */ -/* is not a recognized body ID. */ - -/* - SPICELIB Version 1.0.0, 23-JAN-1996 (KRG) */ - -/* This was the BODC2N entry point from the original BODTRN */ -/* subroutine that was in the NAIF toolkit SUPPORT library. */ -/* When the private subroutine ZZBODTRN was added to SPICELIB, */ -/* superceding the BODTRN from SUPPORT, the body ID code/name */ -/* translation interface from the original BODTRN was moved to */ -/* SPICELIB so that ID codes did not have to be hard coded by */ -/* users of the toolkit. */ - -/* This subroutine simply calls the private subroutine ZZBODC2N */ -/* to perform its job. */ - -/* -& */ -/* $ Index_Entries */ - -/* body id code to name */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODC2N", (ftnlen)6); - } - zzbodc2n_(code, name__, found, name_len); - -/* No need for any error checking, since all we do is check out */ -/* and return anyway. We leave the error checking to the caller. */ - - chkout_("BODC2N", (ftnlen)6); - return 0; -} /* bodc2n_ */ - diff --git a/ext/spice/src/cspice/bodc2n_c.c b/ext/spice/src/cspice/bodc2n_c.c deleted file mode 100644 index 2df87d7954..0000000000 --- a/ext/spice/src/cspice/bodc2n_c.c +++ /dev/null @@ -1,313 +0,0 @@ -/* - --Procedure bodc2n_c ( Body ID code to name translation ) - --Abstract - - Translate the SPICE integer code of a body into a common name - for that body. - --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 - - NAIF_IDS - --Keywords - - BODY - CONVERSION - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef bodc2n_c - - void bodc2n_c ( SpiceInt code, - SpiceInt lenout, - SpiceChar * name, - SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - code I Integer ID code to be translated into a name. - lenout I Maximum length of output name. - name O A common name for the body identified by code. - found O True if translated, otherwise false. - --Detailed_Input - - code is an integer code for a body --- - a planet, satellite, barycenter, spacecraft, - asteroid, comet, or other ephemeris object. - - lenout is the maximum allowed length of the output name, - including the terminating null character. For example, - if the caller wishes to be able to accept a 32-character - name, lenout must be set to (at least) 33. The current - maximum name length is 32 characters, so a value of 33 - for lenout will suffice. - --Detailed_Output - - name is a common name of the body identified by code. - If code has more than one translation, then the - most recently defined name corresponding to code - is returned. 'name' will have the exact format (case - and blanks) as when the name/code pair was defined. - - No more than lenout characters, including the - terminating null, will be written to name. A terminating - null will always be written. - - found is SPICETRUE if code has a translation. Otherwise, found - is SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 2) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - --Files - - None. - --Particulars - - bodc2n_c is one of five related subroutines, - - bods2c_c Body string to code - bodc2s_c Body code to string - bodn2c_c Body name to code - bodc2n_c Body code to name - boddef_c Body name/code definition - - bods2c_c, bodc2s_c, bodn2c_c, and bodc2n_c perform translations between - body names and their corresponding integer ID codes which are - used in SPICE files and routines. - - bods2c_c is a slightly more general version of bodn2c_c: support - for strings containing ID codes in string format enables a caller - to identify a body using a string, even when no name is - associated with that body. - - bodc2s_c is a general version of bodc2n_c; the routine returns either - the name assigned in the body ID to name mapping or a string - representation of the CODE value if no mapping exists. - - boddef_c assigns a body name to ID mapping. The mapping has priority - in name-to-ID and ID-to-name translations. - - Refer to NAIF_ID.REQ for the list of name/code associations built into - SPICE, and for details concerning adding new name/code - associations at run time by loading text kernels. - --Examples - - 1. Suppose you ran the utility program SPACIT to summarize - an SPK ephemeris file and the following data was output - to the terminal screen. - - ---------------------------------------------------------- - Segment identifier: JPL archive 21354 - Body : -77 Center : 399 - From : 1990 DEC 08 18:00:00.000 - To : 1990 DEC 10 21:10:00.000 - Reference : DE-200 SPK Type :1 - ---------------------------------------------------------- - - You could write a program to translate the body codes - shown in the SPACIT output: - - #define MAXLEN 32 - . - . - . - bodc2n_c ( -77, MAXLEN, body, found ); - bodc2n_c ( 399, MAXLEN, center, found ); - - if ( found ) - { - printf ( "body: -77 = %s\n", body ); - printf ( "center: 399 = %s\n", center ); - } - - You could also read the body and center codes directly from - the SPK files, using the appropriate DAF routines, and then - translate them, as above. - - - 2. In this example, we assume that boddef_c has not been called, - so only the set of default name/code pairs has - been defined. - - Given these names, bodn2c_c will return the following codes: - - Name Code Found? - ------------------------ ------ ------ - "EARTH" 399 Yes - " Earth " 399 Yes - "EMB" 3 Yes - "Solar System Barycenter" 0 Yes - "SolarSystemBarycenter" - No - "SSB" 0 Yes - "Voyager 2" -32 Yes - "U.S.S. Enterprise" - No - " " - No - "Halley's Comet" - No - - - Given these codes, bodc2n_c will return the following names: - - Code Name Found? - ------- ------------------- ------ - 399 "EARTH" Yes - 0 "SOLAR SYSTEM BARYCENTER" Yes - 3 "EARTH BARYCENTER" Yes - -77 "GALILEO ORBITER" Yes - 11 - No - -1 - No - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 2.2.2, 24-APR-2010 (EDW) - - Edit to Particulars section to document the bodc2s_c routine. - Minor edit to code comments eliminating typo. - - -CSPICE Version 2.2.1, 27-FEB-2008 (BVS) - - Corrected the contents of the Required_Reading section of - the header. - - -CSPICE Version 2.2.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for found flag used in - interface of bodc2n_. - - -CSPICE Version 2.1.1, 25-MAR-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 2.1.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Updated the Exceptions header section. - - -CSPICE Version 2.0.1, 16-JAN-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.0, 23-JAN-1996 (KRG) - --Index_Entries - - body id code to name - --& -*/ - -{ /* Begin bodc2n_c */ - - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "bodc2n_c"); - - - /* - Make sure the output name has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "bodc2n_c", name, lenout ); - - - /* - Call the f2c'd routine. - */ - bodc2n_( ( integer * ) &code, - ( char * ) name, - ( logical * ) &fnd, - ( ftnlen ) lenout-1 ); - - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - /* - Convert the Fortran string to a C string by placing a null - after the last non-blank character. This operation is valid - whether or not the CSPICE routine signaled an error. - */ - F2C_ConvertStr ( lenout, name ); - - - chkout_c ( "bodc2n_c"); - -} /* End bodc2n_c */ diff --git a/ext/spice/src/cspice/bodc2s.c b/ext/spice/src/cspice/bodc2s.c deleted file mode 100644 index 0a0fbef4fe..0000000000 --- a/ext/spice/src/cspice/bodc2s.c +++ /dev/null @@ -1,249 +0,0 @@ -/* bodc2s.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BODC2S ( Body ID code to string translation ) */ -/* Subroutine */ int bodc2s_(integer *code, char *name__, ftnlen name_len) -{ - extern /* Subroutine */ int zzbodc2n_(integer *, char *, logical *, - ftnlen), chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Translate a body ID code to either the corresponding name */ -/* or if no name to ID code mapping exists, the string */ -/* representation of the body ID value. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ -/* ID */ -/* NAME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CODE I Integer ID code to translate to a string. */ -/* NAME O String corresponding to CODE. */ - -/* $ Detailed_Input */ - -/* CODE the integer code for a body: planet, satellite, */ -/* barycenter, spacecraft, asteroid, comet, or */ -/* other ephemeris object. */ - -/* $ Detailed_Output */ - -/* NAME the string name of the body identified by CODE */ -/* if a mapping between CODE and a body name exists */ -/* within SPICE. */ - -/* If CODE has more than one translation, then the */ -/* most recently defined NAME corresponding to CODE */ -/* is returned. NAME will have the exact format (case */ -/* and blanks) as when the name/code pair was defined. */ - -/* If the input value of CODE does not map to a body */ -/* name, NAME returns the string representation */ -/* of CODE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* Body-name mappings may be defined at run time by loading text */ -/* kernels containing kernel variable assignments of the form */ - -/* NAIF_BODY_NAME += ( , ... ) */ -/* NAIF_BODY_CODE += ( , ... ) */ - -/* See NAIF_ID.REQ for details. */ - -/* $ Particulars */ - -/* BODS2N is one of five related subroutines, */ - -/* BODS2C Body string to code */ -/* BODC2S Body code to string */ -/* BODN2C Body name to code */ -/* BODC2N Body code to name */ -/* BODDEF Body name/code definition */ - -/* BODS2C, BODC2S, BODN2C, and BODC2N perform translations between */ -/* body names and their corresponding integer ID codes which are */ -/* used in SPICE files and routines. */ - -/* BODS2C is a slightly more general version of BODN2C: support */ -/* for strings containing ID codes in string format enables a caller */ -/* to identify a body using a string, even when no name is */ -/* associated with that body. */ - -/* BODC2S is a general version of BODC2N; the routine returns either */ -/* the name assigned in the body ID to name mapping or a string */ -/* representation of the CODE value if no mapping exists. */ - -/* BODDEF assigns a body name to ID mapping. The mapping has */ -/* priority in name-to-ID and ID-to-name translations. */ - -/* Refer to NAIF_ID.REQ for the list of name/code associations built */ -/* into SPICE, and for details concerning adding new name/code */ -/* associations at run time by loading text kernels. */ - -/* $ Examples */ - -/* Apply the BODC2S call to several IDs representing codes */ -/* included in the default SPICE ID-name lists and codes not */ -/* included in the list. */ - -/* PROGRAM BODC2S_T */ - -/* INTEGER CODE (7) */ -/* CHARACTER*(32) NAME */ - -/* C */ -/* C Assign an array of body IDs. Not all the listed IDS */ -/* C map to a body name. */ -/* C */ -/* CODE(1) = 399 */ -/* CODE(2) = 0 */ -/* CODE(3) = 3 */ -/* CODE(4) = -77 */ -/* CODE(5) = 11 */ -/* CODE(6) = -1 */ -/* CODE(7) = 6000001 */ - -/* C */ -/* C Loop over the CODE array, call BODC2S for each */ -/* C element of CODE. */ -/* C */ -/* DO I= 1, 7 */ - -/* CALL BODC2S( CODE(I), NAME ) */ - -/* WRITE(*, '(I8,3x,A)' ) CODE(I), NAME */ - -/* END DO */ - -/* END */ - -/* Given these codes, BODC2S returns the following NAME strings: */ - -/* Code Name */ -/* ------- ------------------- */ -/* 399 'EARTH' */ -/* 0 'SOLAR SYSTEM BARYCENTER' */ -/* 3 'EARTH BARYCENTER' */ -/* -77 'GALILEO ORBITER' */ -/* 11 '11' */ -/* -1 'GEOTAIL' */ -/* 6000001 '6000001' */ - -/* The codes 11 and 6000001 did not map to a name so the call */ -/* returns as NAME the string expression of the codes. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-APR-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* body ID code to string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("BODC2S", (ftnlen)6); - -/* Fortran. No type check available for CODE. Bother. */ - - -/* Attempt to translate the input CODE to a name. Use */ -/* the private routine ZZBODC2N. */ - - zzbodc2n_(code, name__, &found, name_len); - if (found) { - -/* Success. CODE maps to NAME. Return. */ - - chkout_("BODC2S", (ftnlen)6); - return 0; - } - -/* If execution reaches this level, the SPICE body ID */ -/* to name mapping lacks an assignment for CODE. Convert */ -/* CODE to a string representation of the integer value. */ - - intstr_(code, name__, name_len); - chkout_("BODC2S", (ftnlen)6); - return 0; -} /* bodc2s_ */ - diff --git a/ext/spice/src/cspice/bodc2s_c.c b/ext/spice/src/cspice/bodc2s_c.c deleted file mode 100644 index 009e5b45cf..0000000000 --- a/ext/spice/src/cspice/bodc2s_c.c +++ /dev/null @@ -1,262 +0,0 @@ -/* - --Procedure bodc2s_c ( Body ID code to string translation ) - --Abstract - - Translate a body ID code to either the corresponding name or if no - name to ID code mapping exists, the string representation of the - body ID value. - --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 - - NAIF_IDS - --Keywords - - BODY - CONVERSION - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef bodc2s_c - - void bodc2s_c ( SpiceInt code, - SpiceInt lenout, - SpiceChar * name ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - code I Integer ID code to translate to a string. - lenout I Maximum length of output name. - name O String corresponding to 'code'. - --Detailed_Input - - code the integer code for a body: planet, satellite, - barycenter, spacecraft, asteroid, comet, or - other ephemeris object. - - lenout is the maximum allowed length of the output name, - including the terminating null character. For example, - if the caller wishes to be able to accept a 32-character - name, lenout must be set to (at least) 33. The current - maximum name length is 32 characters, so a value of 33 - for lenout will suffice. - --Detailed_Output - - name the string name of the body identified by 'code' - if a mapping between 'code' and a body name exists - within SPICE. - - If 'code' has more than one translation, then the - most recently defined 'name' corresponding to 'code' - is returned. 'name' will have the exact format (case - and blanks) as when the name/code pair was defined. - - If the input value of 'code' does not map to a body - name, 'name' returns with the string representation - of 'code'. - --Parameters - - None. - --Exceptions - - 1) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 2) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - --Files - - Body-name mappings may be defined at run time by loading text - kernels containing kernel variable assignments of the form - - NAIF_BODY_NAME += ( , ... ) - NAIF_BODY_CODE += ( , ... ) - - See NAIF_ID.REQ for details. - --Particulars - - bodc2s_c is one of five related subroutines, - - bods2c_c Body string to code - bodc2s_c Body code to string - bodn2c_c Body name to code - bodc2n_c Body code to name - boddef_c Body name/code definition - - bods2c_c, bodc2s_c, bodn2c_c, and bodc2n_c perform translations between - body names and their corresponding integer ID codes which are - used in SPICE files and routines. - - bods2c_c is a slightly more general version of bodn2c_c: support - for strings containing ID codes in string format enables a caller - to identify a body using a string, even when no name is - associated with that body. - - bodc2s_c is a general version of bodc2n_c; the routine returns either - the name assigned in the body ID to name mapping or a string - representation of the CODE value if no mapping exists. - - boddef_c assigns a body name to ID mapping. The mapping has priority - in name-to-ID and ID-to-name translations. - - Refer to NAIF_ID.REQ for the list of name/code associations built into - SPICE, and for details concerning adding new name/code - associations at run time by loading text kernels. - --Examples - - Apply the BODC2S call to several IDs representing codes - included in the default SPICE ID-name lists and codes not - included in the list. - - #include - #include "SpiceUsr.h" - #define LEN 32 - - int main() - { - - /. - Assign an array of body ID codes. Not all the listed codes - map to a body name. - ./ - - SpiceInt code[] = { 399, 0, 3, -77, - 11, -1, 6000001 }; - - SpiceInt lenout = LEN; - SpiceChar name [LEN]; - SpiceInt i; - - /. - Loop over the 'code' array, call bodc2s_c for each - element of 'code'. - ./ - - for (i=0; i<7; i++ ) - { - (void) bodc2s_c ( code[i], lenout, name ); - printf("%ld %s\n", code[i], name); - } - - return ( 0 ); - } - - Given these codes, bodc2s_c returns the following 'name' strings: - - Code Name - ------- ------------------- - 399 'EARTH' - 0 'SOLAR SYSTEM BARYCENTER' - 3 'EARTH BARYCENTER' - -77 'GALILEO ORBITER' - 11 '11' - -1 'GEOTAIL' - 6000001 '6000001' - - The codes 11 and 6000001 did not map to a name so the call - returns as 'name' the string expression of the codes. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 24-APR-2010 (EDW) - --Index_Entries - - body id code to string - --& -*/ - -{ /* Begin bodc2s_c */ - - - /* - Local variables - */ - - /* - Participate in error tracing. - */ - chkin_c ( "bodc2s_c"); - - - /* - Make sure the output name has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "bodc2s_c", name, lenout ); - - - /* - Call the f2c'd routine. - */ - (void) bodc2s_( ( integer * ) &code, - ( char * ) name, - ( ftnlen ) lenout-1 ); - - /* - Convert the Fortran string to a C string by placing a null - after the last non-blank character. This operation is valid - whether or not the CSPICE routine signaled an error. - */ - F2C_ConvertStr ( lenout, name ); - - chkout_c ( "bodc2s_c"); - -} /* End bodc2s_c */ diff --git a/ext/spice/src/cspice/boddef.c b/ext/spice/src/cspice/boddef.c deleted file mode 100644 index 1c9e23d26e..0000000000 --- a/ext/spice/src/cspice/boddef.c +++ /dev/null @@ -1,301 +0,0 @@ -/* boddef.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BODDEF ( Body name/ID code definition ) */ -/* Subroutine */ int boddef_(char *name__, integer *code, ftnlen name_len) -{ - extern /* Subroutine */ int zzboddef_(char *, integer *, ftnlen), chkin_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Define a body name/ID code pair for later translation via */ -/* BODN2C or BODC2N. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Common name of some body. */ -/* CODE I Integer code for that body. */ -/* MAXL P Maximum length of NAME string. */ - -/* $ Detailed_Input */ - -/* NAME is an arbitrary name of a body which could be */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* The case and positions of blanks in a name are */ -/* significant. BODC2N returns the same string */ -/* (case and space) most recently mapped to a code. */ -/* When NAME consists of more than one word, the */ -/* words require separation by at least one blank. */ - -/* The kernel sub-system stores NAME as described in */ -/* the BODDEF call, but creates an equivalence class */ -/* based on NAME for comparisons in BODN2C. This class */ -/* ignores leading/trailing whitespace, compresses */ -/* interior whitespace to a single space, and ignores */ -/* character case. */ - -/* The following strings belong to the same equivalence */ -/* class: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is distinct from */ -/* the names above. */ - -/* When ignoring trailing blanks, NAME must be short */ -/* enough to fit into the space defined by parameter */ -/* MAXL. */ - -/* CODE is the integer ID code for assignment to body NAME. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MAXL is the maximum allowed length of a body NAME. */ -/* Names exceeding this length will be truncated */ -/* on assignment to a code with BODDEF. The value */ -/* of this parameter may be found in the include */ -/* file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* 1) Routines in the call tree of this routine may signal errors */ -/* if improper inputs are supplied, or if there is insufficient */ -/* room to store the requested addition. */ - -/* 2) If a name-code definition inserted into this routine seems to */ -/* have no effect, it is possible that the contents of the */ -/* definition are masked by the higher precedence kernel pool */ -/* assignments. See the "Particulars" section of this document */ -/* for more information. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BODDEF is one of five related subroutines, */ - -/* BODS2C Body string to code */ -/* BODC2S Body code to string */ -/* BODN2C Body name to code */ -/* BODC2N Body code to name */ -/* BODDEF Body name/code definition */ - -/* BODS2C, BODC2S, BODN2C, and BODC2N perform translations between */ -/* body names and their corresponding integer ID codes which are */ -/* used in SPICE files and routines. */ - -/* BODS2C is a slightly more general version of BODN2C: support */ -/* for strings containing ID codes in string format enables a caller */ -/* to identify a body using a string, even when no name is */ -/* associated with that body. */ - -/* BODC2S is a general version of BODC2N; the routine returns either */ -/* the name assigned in the body ID to name mapping or a string */ -/* representation of the CODE value if no mapping exists. */ - -/* BODDEF assigns a body name to ID mapping. The mapping has */ -/* priority in name-to-ID and ID-to-name translations. */ - -/* Refer to NAIF_IDs for the list of name/code associations built */ -/* into SPICE, and for details concerning adding new name/code */ -/* associations at run time by loading text kernels. */ - -/* Modifying the SPICE name-ID mapping set */ -/* ======================================= */ - -/* Each body has a unique integer CODE, but may have several */ -/* names. Thus you may associate more than one name with */ -/* a particular integer code. */ - -/* CODE may already have a name as defined by a previous */ -/* call to BODDEF or as part of the set of default */ -/* definitions. That previous definition will remain, */ -/* and a translation of that name will still give the */ -/* same CODE. However, future translations of CODE will */ -/* give the new NAME instead of the previous one. This */ -/* feature is useful for assigning a more familiar or */ -/* abbreviated name to a body. For example, in addition */ -/* to the default name for body 5, 'JUPITER BARYCENTER', */ -/* you could define the abbreviation 'JB' to mean 5. */ - -/* Note: In the case where BODDEF performs a name-to-ID mapping */ -/* assignment for an unused body name and unused ID value, */ -/* any subsequent assignment to NAME destroys the previous */ -/* mapping. */ - -/* BODDEF( 'spud', 22) */ - -/* then */ - -/* BODDEF( 'spud', 23) */ - -/* results in the state 'spud' maps to 23, 23 maps to 'spud', */ -/* and 22 maps to nothing (FOUND in BODC2N returns FALSE). */ - -/* $ Examples */ - -/* You may associate a new name for a previously defined code: */ - -/* CALL BODDEF ( 'JB', 5 ) */ - -/* You may also define the name and integer code for a new body: */ - -/* CALL BODDEF ( 'Asteroid Frank', 20103456 ) */ - -/* After these calls to BODDEF, BODN2C would return the following */ -/* translations: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'JB' 5 Yes */ -/* 'Jupiter Barycenter' 5 Yes */ -/* 'ASTEROID FRANK' 20103456 Yes */ -/* 'ASTEROIDFRANK' - No */ -/* 'Frank' - No */ - -/* and BODC2N will return these translations: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 5 'JB' Yes */ -/* 20103456 'Asteroid Frank' Yes */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* B.V. Semenov (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 16-MAY-2009 (EDW) */ - -/* Edit to Particulars section to document the BODC2S routine. */ - -/* - SPICELIB Version 1.1.1, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.1.0, 23-JAN-2004 (EDW) */ - -/* Rewrote header for clarity with regards to the */ -/* current capabilities of the kernel subsystem. */ - -/* - SPICELIB Version 1.0.2, 26-AUG-2002 (FST) */ - -/* Updated header to describe the parameter MAXL and */ -/* its effect on this module. The exceptions section */ -/* was updated to include a more general discussion */ -/* of errors that routines in the call tree of this */ -/* routine may signal. */ - -/* - SPICELIB Version 1.0.1, 12-AUG-2001 (EDW) */ - -/* Updated header with information on new functionality. */ -/* The code-to-name retrieval routines now return the exact */ -/* string as defined in the last code/name mapping (case */ -/* and space). */ - -/* - SPICELIB Version 1.0.0, 23-JAN-1996 (KRG) */ - -/* This was the BODDEF entry point from the original BODTRN */ -/* subroutine that was in the NAIF toolkit SUPPORT library. */ -/* When the private subroutine ZZBODTRN was added to SPICELIB, */ -/* superceding the BODTRN from SUPPORT, the body ID code/name */ -/* translation interface from the original BODTRN was moved to */ -/* SPICELIB so that ID codes did not have to be hard coded by */ -/* users of the toolkit. */ - -/* This subroutine simply calls the private subroutine ZZBODDEF */ -/* to perform its job. */ - -/* -& */ -/* $ Index_Entries */ - -/* body name/id code definition */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODDEF", (ftnlen)6); - } - zzboddef_(name__, code, name_len); - -/* No need for any error checking, since all we do is check out */ -/* and return anyway. We leave the error checking to the caller. */ - - chkout_("BODDEF", (ftnlen)6); - return 0; -} /* boddef_ */ - diff --git a/ext/spice/src/cspice/boddef_c.c b/ext/spice/src/cspice/boddef_c.c deleted file mode 100644 index 6f0f7f2592..0000000000 --- a/ext/spice/src/cspice/boddef_c.c +++ /dev/null @@ -1,319 +0,0 @@ -/* - --Procedure boddef_c ( Body name/ID code definition ) - --Abstract - - Define a body name/ID code pair for later translation via - bodn2c_c or bodc2n_c. - --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 - - NAIF_IDS - --Keywords - - BODY - CONVERSION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void boddef_c ( ConstSpiceChar * name, - SpiceInt code ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - name I Common name of some body. - code I Integer code for that body. - --Detailed_Input - - name is an arbitrary name of a body which could be - a planet, satellite, barycenter, spacecraft, - asteroid, comet, or other ephemeris object. - - The case and positions of blanks in a name are - significant. bodc2n_c returns the same string - (case and space) most recently mapped to a code. - When 'name' consists of more than one word, the - words require separation by at least one blank. - - The kernel sub-system stores 'name' as described in - the boddef_c call, but creates an equivalence class - based on 'name for comparisons in bodn2c_c. This class - ignores leading/trailing whitespace, compresses - interior whitespace to a single space, and ignores - character case. - - The following strings belong to the same equivalence - class: - - "JUPITER BARYCENTER" - "Jupiter Barycenter" - "JUPITER BARYCENTER " - "JUPITER BARYCENTER" - " JUPITER BARYCENTER" - - However, "JUPITERBARYCENTER" is distinct from - the names above. - - When ignoring trailing blanks, NAME must be short - enough to fit into the space defined by parameter - MAXL.The value may be found in the C file - zzbodtrn.c. Due to the way in which f2c converts - FORTRAN code to C, you must examine the dimensions - assigned to the variables: - - defnam - defnor - kernam - kernor - - to obtain the MAXL value. These variables have a - declaration of the form: - - static char variable_name[MAXL*array_length] - - (note MAXL is this first value). - - The maximum allowed length of a name is in any case - at least 32 characters. - - code is the integer ID code for assignment to body 'name'. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) An attempt to associate more than one code with a given name - will cause an error to be signaled by a routine called by this - routine. - - 2) Names too long to be stored will be truncated on the right. - Names of length not exceeding 32 characters will not be - truncated. - --Files - - None. - --Particulars - - boddef_c is one of five related subroutines, - - bods2c_c Body string to code - bodc2s_c Body code to string - bodn2c_c Body name to code - bodc2n_c Body code to name - boddef_c Body name/code definition - - bods2c_c, bodc2s_c, bodn2c_c, and bodc2n_c perform translations between - body names and their corresponding integer ID codes which are - used in SPICE files and routines. - - bods2c_c is a slightly more general version of bodn2c_c: support - for strings containing ID codes in string format enables a caller - to identify a body using a string, even when no name is - associated with that body. - - bodc2s_c is a general version of bodc2n_c; the routine returns either - the name assigned in the body ID to name mapping or a string - representation of the CODE value if no mapping exists. - - boddef_c assigns a body name to ID mapping. The mapping has priority - in name-to-ID and ID-to-name translations. - - Refer to NAIF_IDs for the list of name/code associations built into - SPICE, and for details concerning adding new name/code - associations at run time by loading text kernels. - - Modifying the SPICE name-ID mapping set - ======================================= - - Each body has a unique integer 'code', but may have several - names. Thus you may associate more than one name with - a particular integer code. - - 'code' may already have a name as defined by a previous - call to boddef_c or as part of the set of default - definitions. That previous definition will remain, - and a translation of that name will still give the - same 'code'. However, future translations of 'code' will - give the new 'name' instead of the previous one. This - feature is useful for assigning a more familiar or - abbreviated name to a body. For example, in addition - to the default name for body 5, "JUPITER BARYCENTER", - you could define the abbreviation "JB" to mean 5. - - Note: In the case where boddef_c performs a name-to-ID mapping - assignment for an unused body name and unused ID value, - any subsequent assignment to NAME destroys the previous - mapping. - - boddef_c ( "spud", 22) - - then - - boddef_c ( "spud", 23) - - results in the state "spud" maps to 23, 23 maps to "spud", - and 22 maps to nothing ('found' in bodc2n_c returns SPICEFALSE). - --Examples - - You may associate a new name with a particular code that - has already been defined: - - boddef_c ( "JB", 5 ); - - You may also define the name and integer code for a new body: - - boddef_c ( "Asteroid Frank", 20103456 ); - - After these calls to boddef_c, bodn2c_c would return the following - translations: - - Name Code Found? - ------------------------ ------ ------ - "JB" 5 Yes - "Jupiter Barycenter" 5 Yes - "ASTEROID FRANK" 20103456 Yes - "ASTEROIDFRANK" - No - "Frank" - No - - and BODC2N will return these translations: - - Code Name Found? - ------- ------------------- ------ - 5 "JB" Yes - 20103456 "Asteroid Frank" Yes - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 2.2.2, 16-MAY-2009 (EDW) - - Edit to Particulars section to document the bodc2s_c routine. - - -CSPICE Version 2.2.1, 27-FEB-2008 (BVS) - - Corrected the contents of the Required_Reading section of - the header. - - -CSPICE Version 2.2.0, 23-JAN-2004 (EDW) - - Rewrote header for clarity with regards to the - current capabilities of the kernel subsystem. - - -CSPICE Version 2.1.0, 17-NOV-2003 (EDW) - - Updated header to describe the maximum allowed length - for 'name' and its effect on this module. - - Updated header with information on new functionality. - The code-to-name retrieval routines now return the exact - string as defined in the last code/name mapping (case - and space). - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - The type of the input argument name was changed to - ConstSpiceChar *. - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.0, 23-JAN-1996 (KRG) - --Index_Entries - - body name/id code definition - --& -*/ - -{ /* Begin boddef_c */ - - /* - Participate in error handling - */ - chkin_c ( "boddef_c"); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "boddef_c", name ); - - - /* - Effect the new name/code mapping. - */ - boddef_ ( ( char * ) name, - ( integer * ) &code, - ( ftnlen ) strlen(name) ); - - - chkout_c ( "boddef_c"); - -} /* End boddef_c */ diff --git a/ext/spice/src/cspice/bodeul.c b/ext/spice/src/cspice/bodeul.c deleted file mode 100644 index c19acbc2c9..0000000000 --- a/ext/spice/src/cspice/bodeul.c +++ /dev/null @@ -1,622 +0,0 @@ -/* bodeul.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__100 = 100; - -/* $Procedure BODEUL ( Return Euler angles for a body ) */ -/* Subroutine */ int bodeul_(integer *body, doublereal *et, doublereal *ra, - doublereal *dec, doublereal *w, doublereal *lambda) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical found = FALSE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double d_mod(doublereal *, doublereal *); - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - double sin(doublereal), cos(doublereal); - - /* Local variables */ - char bref[32], item[32]; - doublereal j2ref[9] /* was [3][3] */, j2bfx[9] /* was [3][3] */; - extern integer zzbodbry_(integer *); - extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal - *, integer *, integer *, integer *, doublereal *), m2eul_( - doublereal *, integer *, integer *, integer *, doublereal *, - doublereal *, doublereal *); - doublereal d__; - integer i__; - doublereal dcoef[3], t; - integer refid; - doublereal delta; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3], - theta; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen); - doublereal costh[100]; - extern doublereal vdotg_(doublereal *, doublereal *, integer *); - doublereal sinth[100]; - extern doublereal twopi_(void); - static integer j2code; - doublereal rf2bfx[9] /* was [3][3] */, ac[100], dc[100]; - integer na, nd, nl; - doublereal wc[100]; - extern logical bodfnd_(integer *, char *, ftnlen); - extern /* Subroutine */ int cleard_(integer *, doublereal *), bodvcd_( - integer *, char *, integer *, integer *, doublereal *, ftnlen); - extern doublereal halfpi_(void); - integer nw; - doublereal conepc, conref, eulang[6]; - integer ntheta; - extern /* Subroutine */ int pckeul_(integer *, doublereal *, logical *, - char *, doublereal *, ftnlen), gdpool_(char *, integer *, integer - *, integer *, doublereal *, logical *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), irfnum_(char *, integer *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), irfrot_(integer *, integer *, doublereal *); - extern logical return_(void); - extern doublereal j2000_(void); - integer dim, ref; - doublereal phi; - extern doublereal rpd_(void), spd_(void); - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Return the Euler angles needed to compute the transformation */ -/* from inertial to body-fixed coordinates for any body in the */ -/* kernel pool. */ - -/* $ 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 */ - -/* PCK */ -/* NAIF_IDS */ -/* TIME */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* ROTATION */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of body. */ -/* ET I Epoch of transformation. */ -/* RA O Right ascension of the (IAU) north pole. */ -/* DEC O Declination of the (IAU) north pole of the body. */ -/* W O Angle between the x-axis and the prime meridian. */ -/* LAMBDA O Angle between the prime meridian and longitude of */ -/* longest axis. */ - -/* $ Detailed_Input */ - -/* BODY is the integer ID code of the body for which the */ -/* transformation is requested. Bodies are numbered */ -/* according to the standard NAIF numbering scheme. */ - -/* ET is the epoch at which the transformation is */ -/* requested. (This is typically the epoch of */ -/* observation minus the one-way light time from */ -/* the observer to the body at the epoch of */ -/* observation.) */ - -/* $ Detailed_Output */ - -/* RA, */ -/* DEC are the right ascension and declination of the */ -/* (IAU) north pole of the body at the epoch of */ -/* transformation. RA and DEC are given in radians. */ - -/* W is the angle between the x-axis (inertial) and the */ -/* prime meridian of the body. W is given in radians. */ - -/* LAMBDA is the angle between the prime meridian and the */ -/* longest axis of the tri-axial ellipsoid which */ -/* models the body. LAMBDA is given in radians. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of phase terms is insufficient, the error */ -/* SPICE(KERNELVARNOTFOUND) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If there exists high-precision binary PCK kernel information */ -/* for the body at the requested time, the angles, W, DELTA */ -/* and PHI are computed directly from that file. These angles */ -/* are then used to compute RA, DEC and W. The most recently */ -/* loaded binary PCK file has first priority followed by previously */ -/* loaded binary PCK files in backward time order. If no binary */ -/* PCK file has been loaded, the text P_constants kernel file */ -/* is used. */ - -/* If there is only text PCK kernel information, it is */ -/* expressed in terms of RA, DEC and W (same W as above), where */ - -/* RA = PHI - HALFPI() */ -/* DEC = HALFPI() - DELTA */ - -/* RA, DEC, and W are defined as follows in the text PCK file: */ - -/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */ -/* i i */ - -/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */ -/* i i */ - -/* W = W0 + W1*d + W2*d*d + w sin theta */ -/* i i */ - -/* where: */ - -/* d = days past J2000. */ - -/* T = Julian centuries past J2000. */ - -/* a , d , and w arrays apply to satellites only. */ -/* i i i */ - -/* theta = THETA0 * THETA1*T are specific to each planet. */ -/* i */ - -/* These angles -- typically nodal rates -- vary in number and */ -/* definition from one planetary system to the next. */ - -/* The offset LAMBDA is a constant for a given body. LAMBDA is */ -/* needed to distinguish between the latitude and longitude */ -/* system and the geometric system (where Prime Meridian always */ -/* intersects the longest axis). */ - -/* $ Examples */ - -/* In the following code fragment, BODEUL is used to get the unit */ -/* vector (POLE) parallel to the north pole of a target body (BODY) */ -/* at a specific epoch (ET). */ - -/* CALL BODEUL ( BODY, ET, RA, DEC, W, LAMBDA ) */ -/* CALL RADREC ( 1.D0, RA, DEC, POLE ) */ - -/* Note that the items necessary to compute the Euler angles */ -/* must have been loaded into the kernel pool (by one or more */ -/* previous calls to LDPOOL). */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Refer to the NAIF_IDS required reading file for a complete */ -/* list of the NAIF integer ID codes for bodies. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 24-OCT-2005 (NJB) */ - -/* Calls to ZZBODVCD have been replaced with calls to */ -/* BODVCD. */ - -/* - SPICELIB Version 4.0.0, 13-FEB-2004 (NJB) */ - -/* Code has been updated to support satellite ID codes in the */ -/* range 10000 to 99999 and to allow nutation precession angles */ -/* to be associated with any object. */ - -/* Implementation changes were made to improve robustness */ -/* of the code. */ - -/* - SPICELIB Version 3.1.0, 21-MAR-1995 (KSZ) */ - -/* REF frame is now passed correctly as a character string. */ - -/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */ - -/* Ability to get Euler angles from binary PCK file added. */ -/* This uses the new routine PCKEUL. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (NJB) */ - -/* Allowed number of nutation precession angles increased to */ -/* 100. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* euler angles for orientation of a body */ -/* fetch euler angles for a body */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 24-OCT-2005 (NJB) */ - -/* Calls to ZZBODVCD have been replaced with calls to */ -/* BODVCD. */ - -/* - SPICELIB Version 4.0.0, 13-FEB-2004 (NJB) */ - -/* Code has been updated to support satellite ID codes in the */ -/* range 10000 to 99999 and to allow nutation precession angles */ -/* to be associated with any object. */ - -/* Calls to deprecated kernel pool access routine RTPOOL */ -/* were replaced by calls to GDPOOL. */ - -/* Calls to BODVAR have been replaced with calls to */ -/* ZZBODVCD. */ - -/* - SPICELIB Version 3.1.0, 21-MAR-1995 (KSZ) */ - -/* REF frame is now passed correctly as a character string. */ - -/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */ - -/* BODEUL now uses new software to check for the */ -/* existence of binary PCK files, search the for */ -/* data corresponding to the requested body and time, */ -/* and return the appropriate Euler angles, using the */ -/* new routine PCKEUL. Otherwise the code calculates */ -/* the Euler angles from the P_constants kernel file. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* BODEUL now checks the kernel pool for presence of the */ -/* variables */ - -/* BODY#_CONSTANTS_REF_FRAME */ - -/* and */ - -/* BODY#_CONSTANTS_JED_EPOCH */ - -/* where # is the NAIF integer code of the barycenter of a */ -/* planetary system or of a body other than a planet or */ -/* satellite. If either or both of these variables are */ -/* present, the P_constants for BODY are presumed to be */ -/* referenced to the specified inertial frame or epoch. */ -/* If the epoch of the constants is not J2000, the input */ -/* time ET is converted to seconds past the reference epoch. */ -/* If the frame of the constants is not J2000, the Euler angles */ -/* defining the rotation from the P_constants' frame to */ -/* body-fixed coordinates are transformed so that they define */ -/* the rotation from J2000 coordinates to body-fixed */ -/* coordinates. */ - - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (NJB) */ - -/* Allowed number of nutation precession angles increased to */ -/* 100. */ - -/* - Beta Version 2.0.0, 23-JUN-1989 (HAN) */ - -/* Mod angles by two pi. Check to see that right ascension and */ -/* prime meridian angles are within the range 0 to two pi. */ - -/* LAMBDA used to be returned in degrees. It has been corrected */ -/* to return LAMBDA in radians. */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Examples section completed. Declarations of unused variables */ -/* HALFPI and N removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODEUL", (ftnlen)6); - } - -/* Get the code for the J2000 frame, if we don't have it yet. */ - - if (first) { - irfnum_("J2000", &j2code, (ftnlen)5); - first = FALSE_; - } - -/* Get Euler angles from high precision data file. */ - - pckeul_(body, et, &found, bref, eulang, (ftnlen)32); - if (found) { - phi = eulang[0]; - delta = eulang[1]; - *w = eulang[2]; - irfnum_(bref, &ref, (ftnlen)32); - -/* The offset of the prime meridian is optional. */ - - s_copy(item, "LONG_AXIS", (ftnlen)32, (ftnlen)9); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__1, &nl, lambda, (ftnlen)32); - *lambda *= rpd_(); - d__1 = twopi_(); - *lambda = d_mod(lambda, &d__1); - } else { - *lambda = 0.; - } - } else { - -/* Find the body code used to label the reference frame and epoch */ -/* specifiers for the orientation constants for BODY. */ - -/* For planetary systems, the reference frame and epoch for the */ -/* orientation constants is associated with the system */ -/* barycenter, not with individual bodies in the system. For any */ -/* other bodies, (the Sun or asteroids, for example) the body's */ -/* own code is used as the label. */ - - refid = zzbodbry_(body); - -/* Look up the epoch of the constants. The epoch is specified */ -/* as a Julian ephemeris date. The epoch defaults to J2000. */ - - s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25); - repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32); - if (found) { - -/* The reference epoch is returned as a JED. Convert to */ -/* ephemeris seconds past J2000. Then convert the input ET to */ -/* seconds past the reference epoch. */ - - conepc = spd_() * (conepc - j2000_()); - epoch = *et - conepc; - } else { - epoch = *et; - } - -/* Look up the reference frame of the constants. The reference */ -/* frame is specified by a code recognized by CHGIRF. The */ -/* default frame is J2000, symbolized by the code J2CODE. */ - - irfnum_("J2000", &j2code, (ftnlen)5); - s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25); - repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32); - if (found) { - ref = i_dnnt(&conref); - } else { - ref = j2code; - } - -/* Whatever the body, it has quadratic time polynomials for */ -/* the RA and Dec of the pole, and for the rotation of the */ -/* Prime Meridian. */ - - s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7); - cleard_(&c__3, rcoef); - bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32); - s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8); - cleard_(&c__3, dcoef); - bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32); - s_copy(item, "PM", (ftnlen)32, (ftnlen)2); - cleard_(&c__3, wcoef); - bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32); - -/* The offset of the prime meridian is optional. */ - - s_copy(item, "LONG_AXIS", (ftnlen)32, (ftnlen)9); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__1, &nl, lambda, (ftnlen)32); - } else { - *lambda = 0.; - } - -/* There may be additional nutation and libration (THETA) terms. */ - - ntheta = 0; - na = 0; - nd = 0; - nw = 0; - s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15); - if (bodfnd_(&refid, item, (ftnlen)32)) { - bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32); - ntheta /= 2; - } - s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32); - } - s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32); - } - s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32); - } -/* Computing MAX */ - i__1 = max(na,nd); - if (max(i__1,nw) > ntheta) { - setmsg_("BODEUL: Insufficient number of nutation/precession angl" - "es for body * at time #.", (ftnlen)79); - errint_("*", body, (ftnlen)1); - errdp_("#", et, (ftnlen)1); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("BODEUL", (ftnlen)6); - return 0; - } - -/* Evaluate the time polynomials at EPOCH. */ - - d__ = epoch / spd_(); - t = d__ / 36525.; - *ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]); - *dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]); - *w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]); - -/* Add nutation and libration as appropriate. */ - - i__1 = ntheta; - for (i__ = 1; i__ <= i__1; ++i__) { - theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 : - s_rnge("tcoef", i__2, "bodeul_", (ftnlen)590)] + t * - tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 : - s_rnge("tcoef", i__3, "bodeul_", (ftnlen)590)]) * rpd_(); - sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth", - i__2, "bodeul_", (ftnlen)592)] = sin(theta); - costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh", - i__2, "bodeul_", (ftnlen)593)] = cos(theta); - } - *ra += vdotg_(ac, sinth, &na); - *dec += vdotg_(dc, costh, &nd); - *w += vdotg_(wc, sinth, &nw); - -/* Convert from degrees to radians and mod by two pi. */ - - *ra *= rpd_(); - *dec *= rpd_(); - *w *= rpd_(); - *lambda *= rpd_(); - d__1 = twopi_(); - *ra = d_mod(ra, &d__1); - d__1 = twopi_(); - *dec = d_mod(dec, &d__1); - d__1 = twopi_(); - *w = d_mod(w, &d__1); - d__1 = twopi_(); - *lambda = d_mod(lambda, &d__1); - -/* Convert to Euler angles. */ - - phi = *ra + halfpi_(); - delta = halfpi_() - *dec; - } - -/* Convert the angles to the J2000 frame if they are not already */ -/* referenced to J2000. */ - - if (ref != j2code) { - -/* Find the transformation from the J2000 frame to the frame */ -/* designated by REF. Form the transformation from `REF' */ -/* coordinates to body-fixed coordinates, using our Euler angles. */ -/* Compose the transformations to obtain the J2000-to-body-fixed */ -/* transformation. Decompose this transformation into Euler */ -/* angles. */ - - irfrot_(&j2code, &ref, j2ref); - eul2m_(w, &delta, &phi, &c__3, &c__1, &c__3, rf2bfx); - mxm_(rf2bfx, j2ref, j2bfx); - m2eul_(j2bfx, &c__3, &c__1, &c__3, w, &delta, &phi); - } - -/* The Euler angles now give the transformation from J2000 to */ -/* body-fixed coordinates at epoch ET seconds past J2000, */ -/* regardless of the epoch and frame of the orientation constants */ -/* for the specified body. */ - - *ra = phi - halfpi_(); - *dec = halfpi_() - delta; - -/* Make sure that the prime meridian and right ascension are in */ -/* the correct range. */ - - if (*w < 0.) { - *w += twopi_(); - } - if (*ra < 0.) { - *ra += twopi_(); - } - chkout_("BODEUL", (ftnlen)6); - return 0; -} /* bodeul_ */ - diff --git a/ext/spice/src/cspice/bodfnd.c b/ext/spice/src/cspice/bodfnd.c deleted file mode 100644 index 44eb790734..0000000000 --- a/ext/spice/src/cspice/bodfnd.c +++ /dev/null @@ -1,214 +0,0 @@ -/* bodfnd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure BODFND ( Find values from the kernel pool ) */ -logical bodfnd_(integer *body, char *item, ftnlen item_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char code[16]; - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - char dtype[1], varnam[32]; - extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *, - logical *, integer *, char *, ftnlen, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Determine whether values exist for some item for any body */ -/* in the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of body. */ -/* ITEM I Item to find ('RADII', 'NUT_AMP_RA', etc.). */ - -/* $ Detailed_Input */ - -/* BODY is the ID code of the body for which the item is */ -/* requested. Bodies are numbered according to the */ -/* standard NAIF numbering scheme. */ - -/* ITEM is the item to be returned. Together, the body and */ -/* item name combine to form a variable name, e.g., */ - -/* 'BODY599_RADII' */ -/* 'BODY4_POLE_RA' */ - -/* $ Detailed_Output */ - -/* The result is TRUE if the item is in the kernel pool, */ -/* and is FALSE if it is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* BODVCD, which returns values from the kernel pool, causes an */ -/* error to be signalled whenever the specified item is not found. */ -/* In many cases, this is appropriate. However, sometimes the */ -/* program may attempt to recover, by providing default values, */ -/* prompting for replacements, and so on. */ - -/* $ Examples */ - -/* In the following example, default values are substituted for */ -/* bodies for which axes are not found. */ - -/* IF ( BODFND ( TARGET, 'RADII' ) ) THEN */ -/* CALL BODVCD ( TARGET, 'RADII', 3, N, RADII ) */ -/* ELSE */ -/* CALL VPACK ( 100.D0, 100.D0, 100.D0, RADII ) */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Refer to the SPK required reading file for a complete list of */ -/* the NAIF integer ID codes for bodies. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 24-OCT-2005 (NJB) */ - -/* Header update: calls to BODVAR in example code were replaced */ -/* with calls to BODVCD. The string 'AXES' and variable AXES */ -/* were replaced with the string 'RADII' and variable 'RADII' */ -/* throughout the header. */ - -/* - SPICELIB Version 1.2.0, 15-MAR-2002 (NJB) */ - -/* Bug fix: routine was updated to work with string-valued */ -/* kernel variables. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* find constants for a body in the kernel pool */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("BODFND", (ftnlen)6); - } - -/* Construct the variable name from BODY and ITEM. */ - - s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4); - intstr_(body, code, (ftnlen)16); - suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32); - suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32); - suffix_(item, &c__0, varnam, item_len, (ftnlen)32); - -/* Search the kernel pool for the item. */ - - dtpool_(varnam, &found, &n, dtype, (ftnlen)32, (ftnlen)1); - -/* Was anything there? */ - - ret_val = found; - chkout_("BODFND", (ftnlen)6); - return ret_val; -} /* bodfnd_ */ - diff --git a/ext/spice/src/cspice/bodfnd_c.c b/ext/spice/src/cspice/bodfnd_c.c deleted file mode 100644 index 821b821b2f..0000000000 --- a/ext/spice/src/cspice/bodfnd_c.c +++ /dev/null @@ -1,210 +0,0 @@ -/* - --Procedure bodfnd_c ( Find values from the kernel pool ) - --Abstract - - Determine whether values exist for some item for any body - in the kernel pool. - --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 - - KERNEL - NAIF_IDS - PCK - --Keywords - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceBoolean bodfnd_c ( SpiceInt body, - ConstSpiceChar * item ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - body I ID code of body. - item I Item to find ("RADII", "NUT_AMP_RA", etc.). - - The function returns the value SPICETRUE if the item is in the - kernel pool, and is SPICEFALSE if it is not. - --Detailed_Input - - body is the ID code of the body for which the item is - requested. Bodies are numbered according to the - standard NAIF numbering scheme. - - item is the item to be returned. Together, the body and - item name combine to form a variable name, e.g., - - "BODY599_RADII" - "BODY4_POLE_RA" - --Detailed_Output - - The function returns the value SPICETRUE if the item is in the - kernel pool, and is SPICEFALSE if it is not. - --Parameters - - None. - --Particulars - - The CSPICE routines bodvcd_c and bodvrd_c, which return values from - the kernel pool, signal an error if the specified item is not found. - In many cases, this is appropriate. However, sometimes the program - may attempt to recover, by providing default values, prompting for - replacements, and so on. - --Examples - - In the following example, default values are substituted for - bodies for which radii are not found. - - #include "SpiceUsr.h" - ... - SpiceDouble radii[3]; - SpiceInt n; - SpiceInt target; - ... - - if ( bodfnd_c ( target, "RADII" ) ) - { - bodvcd_c ( target, "AXES", 3, &n, radii ); - } - else - { - vpack_c ( 100.0, 100.0, 100.0, radii ); - } - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 2.0.2, 24-OCT-2005 (NJB) - - Header updates: reference to bodvar_c was replaced with - reference to bodvcd_c. The string "AXES" and variable `axes' - were replaced with the string "RADII" and variable `radii' - throughout the header. A few other minor header edits were - made. - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - Input argument item was changed to type ConstSpiceChar *. - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR_VAL. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - find constants for a body in the kernel pool - --& -*/ - - -{ /* Begin bodfnd_c */ - - /* - Local variables. - */ - SpiceBoolean result; - - - /* - Participate in error tracing. - */ - chkin_c ( "bodfnd_c" ); - - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "bodfnd_c", item, SPICEFALSE ); - - - /* - Execute the f2c'd routine. - */ - result = (SpiceBoolean) bodfnd_( ( integer * ) &body, - ( char * ) item, - ( ftnlen ) strlen(item) ); - - - /* - We now have a true or false. Tell the caller the value. It may need - to know. - */ - chkout_c ( "bodfnd_c" ); - - return ( result ); - -} /* End bodfnd_c */ - diff --git a/ext/spice/src/cspice/bodmat.c b/ext/spice/src/cspice/bodmat.c deleted file mode 100644 index f7f8283975..0000000000 --- a/ext/spice/src/cspice/bodmat.c +++ /dev/null @@ -1,842 +0,0 @@ -/* bodmat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__100 = 100; -static integer c__9 = 9; - -/* $Procedure BODMAT ( Return transformation matrix for a body ) */ -/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical found = FALSE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_dnnt(doublereal *); - double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *) - ; - - /* Local variables */ - integer cent; - char item[32]; - doublereal j2ref[9] /* was [3][3] */; - extern integer zzbodbry_(integer *); - extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal - *, integer *, integer *, integer *, doublereal *); - doublereal d__; - integer i__, j; - doublereal dcoef[3], t, w; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen); - integer refid; - doublereal delta; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal theta; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen) - , errdp_(char *, doublereal *, ftnlen); - doublereal costh[100]; - extern doublereal vdotg_(doublereal *, doublereal *, integer *); - char dtype[1]; - doublereal sinth[100], tsipm[36] /* was [6][6] */; - extern doublereal twopi_(void); - static integer j2code; - doublereal ac[100], dc[100]; - integer na, nd; - doublereal ra, wc[100]; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - extern logical bodfnd_(integer *, char *, ftnlen); - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer frcode; - extern doublereal halfpi_(void); - extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char - *, integer *, logical *, ftnlen); - integer nw; - doublereal conepc, conref; - extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *, - doublereal *, logical *); - integer ntheta; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen); - char fixfrm[32], errmsg[1840]; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen); - doublereal tmpmat[9] /* was [3][3] */; - extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen), errint_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - irfrot_(integer *, integer *, doublereal *); - extern logical return_(void); - char timstr[35]; - extern doublereal j2000_(void); - doublereal dec; - integer dim, ref; - doublereal phi; - extern doublereal rpd_(void), spd_(void); - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Return the J2000 to body Equator and Prime Meridian coordinate */ -/* transformation matrix for a specified body. */ - -/* $ 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 */ - -/* PCK */ -/* NAIF_IDS */ -/* TIME */ - -/* $ Keywords */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of body. */ -/* ET I Epoch of transformation. */ -/* TIPM O Transformation from Inertial to PM for BODY at ET. */ - -/* $ Detailed_Input */ - -/* BODY is the integer ID code of the body for which the */ -/* transformation is requested. Bodies are numbered */ -/* according to the standard NAIF numbering scheme. */ - -/* ET is the epoch at which the transformation is */ -/* requested. (This is typically the epoch of */ -/* observation minus the one-way light time from */ -/* the observer to the body at the epoch of */ -/* observation.) */ - -/* $ Detailed_Output */ - -/* TIPM is the transformation matrix from Inertial to body */ -/* Equator and Prime Meridian. The X axis of the PM */ -/* system is directed to the intersection of the */ -/* equator and prime meridian. The Z axis points north. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If data required to define the body-fixed frame associated */ -/* with BODY are not found in the binary PCK system or the kernel */ -/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */ -/* the case of IAU style body-fixed frames, the absence of */ -/* prime meridian polynomial data (which are required) is used */ -/* as an indicator of missing data. */ - -/* 2) If the test for exception (1) passes, but in fact requested */ -/* data are not available in the kernel pool, the error will be */ -/* signaled by routines in the call tree of this routine. */ - -/* 3) If the kernel pool does not contain all of the data required */ -/* to define the number of nutation precession angles */ -/* corresponding to the available nutation precession */ -/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */ -/* signaled. */ - -/* 4) If the reference frame REF is not recognized, a routine */ -/* called by BODMAT will diagnose the condition and invoke the */ -/* SPICE error handling system. */ - -/* 5) If the specified body code BODY is not recognized, the */ -/* error is diagnosed by a routine called by BODMAT. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is related to the more general routine TIPBOD */ -/* which returns a matrix that transforms vectors from a */ -/* specified inertial reference frame to body equator and */ -/* prime meridian coordinates. TIPBOD accepts an input argument */ -/* REF that allows the caller to specify an inertial reference */ -/* frame. */ - -/* The transformation represented by BODMAT's output argument TIPM */ -/* is defined as follows: */ - -/* TIPM = [W] [DELTA] [PHI] */ -/* 3 1 3 */ - -/* If there exists high-precision binary PCK kernel information */ -/* for the body at the requested time, these angles, W, DELTA */ -/* and PHI are computed directly from that file. The most */ -/* recently loaded binary PCK file has first priority followed */ -/* by previously loaded binary PCK files in backward time order. */ -/* If no binary PCK file has been loaded, the text P_constants */ -/* kernel file is used. */ - -/* If there is only text PCK kernel information, it is */ -/* expressed in terms of RA, DEC and W (same W as above), where */ - -/* RA = PHI - HALFPI() */ -/* DEC = HALFPI() - DELTA */ - -/* RA, DEC, and W are defined as follows in the text PCK file: */ - -/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */ -/* i i */ - -/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */ -/* i i */ - -/* W = W0 + W1*d + W2*d*d + w sin theta */ -/* i i */ - -/* where: */ - -/* d = days past J2000. */ - -/* T = Julian centuries past J2000. */ - -/* a , d , and w arrays apply to satellites only. */ -/* i i i */ - -/* theta = THETA0 * THETA1*T are specific to each planet. */ -/* i */ - -/* These angles -- typically nodal rates -- vary in number and */ -/* definition from one planetary system to the next. */ - -/* $ Examples */ - -/* In the following code fragment, BODMAT is used to rotate */ -/* the position vector (POS) from a target body (BODY) to a */ -/* spacecraft from inertial coordinates to body-fixed coordinates */ -/* at a specific epoch (ET), in order to compute the planetocentric */ -/* longitude (PCLONG) of the spacecraft. */ - -/* CALL BODMAT ( BODY, ET, TIPM ) */ -/* CALL MXV ( TIPM, POS, POS ) */ -/* CALL RECLAT ( POS, RADIUS, PCLONG, LAT ) */ - -/* To compute the equivalent planetographic longitude (PGLONG), */ -/* it is necessary to know the direction of rotation of the target */ -/* body, as shown below. */ - -/* CALL BODVCD ( BODY, 'PM', 3, DIM, VALUES ) */ - -/* IF ( VALUES(2) .GT. 0.D0 ) THEN */ -/* PGLONG = PCLONG */ -/* ELSE */ -/* PGLONG = TWOPI() - PCLONG */ -/* END IF */ - -/* Note that the items necessary to compute the transformation */ -/* TIPM must have been loaded into the kernel pool (by one or more */ -/* previous calls to FURNSH). */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Refer to the NAIF_IDS required reading file for a complete */ -/* list of the NAIF integer ID codes for bodies. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.1, 01-FEB-2008 (NJB) */ - -/* The routine was updated to improve the error messages created */ -/* when required PCK data are not found. Now in most cases the */ -/* messages are created locally rather than by the kernel pool */ -/* access routines. In particular missing binary PCK data will */ -/* be indicated with a reasonable error message. */ - -/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM call. */ - -/* Calls to ZZBODVCD have been replaced with calls to */ -/* BODVCD. */ - -/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */ - -/* Code has been updated to support satellite ID codes in the */ -/* range 10000 to 99999 and to allow nutation precession angles */ -/* to be associated with any object. */ - -/* Implementation changes were made to improve robustness */ -/* of the code. */ - -/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */ - -/* Gets TSIPM matrix from PCKMAT (instead of Euler angles */ -/* from PCKEUL.) */ - -/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */ - -/* Ability to get Euler angles from binary PCK file added. */ -/* This uses the new routine PCKEUL. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* The header was updated to specify that the inertial reference */ -/* frame used by BODMAT is restricted to be J2000. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch transformation matrix for a body */ -/* transformation from j2000 position to bodyfixed */ -/* transformation from j2000 to bodyfixed coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM call. */ - -/* Calls to ZZBODVCD have been replaced with calls to */ -/* BODVCD. */ - -/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */ - -/* Code has been updated to support satellite ID codes in the */ -/* range 10000 to 99999 and to allow nutation precession angles */ -/* to be associated with any object. */ - -/* Calls to deprecated kernel pool access routine RTPOOL */ -/* were replaced by calls to GDPOOL. */ - -/* Calls to BODVAR have been replaced with calls to */ -/* ZZBODVCD. */ - -/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */ - -/* BODMAT now get the TSIPM matrix from PCKMAT, and */ -/* unpacks TIPM from it. Also the calculated but unused */ -/* variable LAMBDA was removed. */ - -/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */ - -/* BODMAT now uses new software to check for the */ -/* existence of binary PCK files, search the for */ -/* data corresponding to the requested body and time, */ -/* and return the appropriate Euler angles, using the */ -/* new routine PCKEUL. Otherwise the code calculates */ -/* the Euler angles from the P_constants kernel file. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* The header was updated to specify that the inertial reference */ -/* frame used by BODMAT is restricted to be J2000. */ - -/* BODMAT now checks the kernel pool for presence of the */ -/* variables */ - -/* BODY#_CONSTANTS_REF_FRAME */ - -/* and */ - -/* BODY#_CONSTANTS_JED_EPOCH */ - -/* where # is the NAIF integer code of the barycenter of a */ -/* planetary system or of a body other than a planet or */ -/* satellite. If either or both of these variables are */ -/* present, the P_constants for BODY are presumed to be */ -/* referenced to the specified inertial frame or epoch. */ -/* If the epoch of the constants is not J2000, the input */ -/* time ET is converted to seconds past the reference epoch. */ -/* If the frame of the constants is not J2000, the rotation from */ -/* the P_constants' frame to body-fixed coordinates is */ -/* transformed to the rotation from J2000 coordinates to */ -/* body-fixed coordinates. */ - -/* For efficiency reasons, this routine now duplicates much */ -/* of the code of BODEUL so that it doesn't have to call BODEUL. */ -/* In some cases, BODEUL must covert Euler angles to a matrix, */ -/* rotate the matrix, and convert the result back to Euler */ -/* angles. If this routine called BODEUL, then in such cases */ -/* this routine would convert the transformed angles back to */ -/* a matrix. That would be a bit much.... */ - - -/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Examples section completed. Declaration of unused variable */ -/* FOUND removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE Error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODMAT", (ftnlen)6); - } - -/* Get the code for the J2000 frame, if we don't have it yet. */ - - if (first) { - irfnum_("J2000", &j2code, (ftnlen)5); - first = FALSE_; - } - -/* Get Euler angles from high precision data file. */ - - pckmat_(body, et, &ref, tsipm, &found); - if (found) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("tipm", i__1, "bodmat_", (ftnlen)485)] = tsipm[ - (i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("tsipm", i__2, "bodmat_", (ftnlen)485)]; - } - } - } else { - -/* The data for the frame of interest are not available in a */ -/* loaded binary PCK file. This is not an error: the data may be */ -/* present in the kernel pool. */ - -/* Conduct a non-error-signaling check for the presence of a */ -/* kernel variable that is required to implement an IAU style */ -/* body-fixed reference frame. If the data aren't available, we */ -/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */ -/* we want to issue the error signal locally, with a better error */ -/* message. */ - - s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8); - repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1); - if (! found) { - -/* Now we do have an error. */ - -/* We don't have the data we'll need to produced the requested */ -/* state transformation matrix. In order to create an error */ -/* message understandable to the user, find, if possible, the */ -/* name of the reference frame associated with the input body. */ -/* Note that the body is really identified by a PCK frame class */ -/* ID code, though most of the documentation just calls it a */ -/* body ID code. */ - - ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32); - etcal_(et, timstr, (ftnlen)35); - s_copy(errmsg, "PCK data required to compute the orientation of " - "the # # for epoch # TDB were not found. If these data we" - "re to be provided by a binary PCK file, then it is possi" - "ble that the PCK file does not have coverage for the spe" - "cified body-fixed frame at the time of interest. If the " - "data were to be provided by a text PCK file, then possib" - "ly the file does not contain data for the specified body" - "-fixed frame. In either case it is possible that a requi" - "red PCK file was not loaded at all.", (ftnlen)1840, ( - ftnlen)475); - -/* Fill in the variable data in the error message. */ - - if (found) { - -/* The frame system knows the name of the body-fixed frame. */ - - setmsg_(errmsg, (ftnlen)1840); - errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16); - errch_("#", fixfrm, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)35); - } else { - -/* The frame system doesn't know the name of the */ -/* body-fixed frame, most likely due to a missing */ -/* frame kernel. */ - - suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840); - setmsg_(errmsg, (ftnlen)1840); - errch_("#", "body-fixed frame associated with the ID code", ( - ftnlen)1, (ftnlen)44); - errint_("#", body, (ftnlen)1); - errch_("#", timstr, (ftnlen)1, (ftnlen)35); - errch_("#", "Also, a frame kernel defining the body-fixed fr" - "ame associated with body # may need to be loaded.", ( - ftnlen)1, (ftnlen)96); - errint_("#", body, (ftnlen)1); - } - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("BODMAT", (ftnlen)6); - return 0; - } - -/* Find the body code used to label the reference frame and epoch */ -/* specifiers for the orientation constants for BODY. */ - -/* For planetary systems, the reference frame and epoch for the */ -/* orientation constants is associated with the system */ -/* barycenter, not with individual bodies in the system. For any */ -/* other bodies, (the Sun or asteroids, for example) the body's */ -/* own code is used as the label. */ - - refid = zzbodbry_(body); - -/* Look up the epoch of the constants. The epoch is specified */ -/* as a Julian ephemeris date. The epoch defaults to J2000. */ - - s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25); - repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32); - if (found) { - -/* The reference epoch is returned as a JED. Convert to */ -/* ephemeris seconds past J2000. Then convert the input ET to */ -/* seconds past the reference epoch. */ - - conepc = spd_() * (conepc - j2000_()); - epoch = *et - conepc; - } else { - epoch = *et; - } - -/* Look up the reference frame of the constants. The reference */ -/* frame is specified by a code recognized by CHGIRF. The */ -/* default frame is J2000, symbolized by the code J2CODE. */ - - s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25); - repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32); - if (found) { - ref = i_dnnt(&conref); - } else { - ref = j2code; - } - -/* Whatever the body, it has quadratic time polynomials for */ -/* the RA and Dec of the pole, and for the rotation of the */ -/* Prime Meridian. */ - - s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7); - cleard_(&c__3, rcoef); - bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32); - s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8); - cleard_(&c__3, dcoef); - bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32); - s_copy(item, "PM", (ftnlen)32, (ftnlen)2); - cleard_(&c__3, wcoef); - bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32); - -/* There may be additional nutation and libration (THETA) terms. */ - - ntheta = 0; - na = 0; - nd = 0; - nw = 0; - s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15); - if (bodfnd_(&refid, item, (ftnlen)32)) { - bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32); - ntheta /= 2; - } - s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32); - } - s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32); - } - s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32); - } -/* Computing MAX */ - i__1 = max(na,nd); - if (max(i__1,nw) > ntheta) { - setmsg_("Insufficient number of nutation/precession angles for b" - "ody * at time #.", (ftnlen)71); - errint_("*", body, (ftnlen)1); - errdp_("#", et, (ftnlen)1); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("BODMAT", (ftnlen)6); - return 0; - } - -/* Evaluate the time polynomials at EPOCH. */ - - d__ = epoch / spd_(); - t = d__ / 36525.; - ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]); - dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]); - w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]); - -/* Add nutation and libration as appropriate. */ - - i__1 = ntheta; - for (i__ = 1; i__ <= i__1; ++i__) { - theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 : - s_rnge("tcoef", i__2, "bodmat_", (ftnlen)700)] + t * - tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 : - s_rnge("tcoef", i__3, "bodmat_", (ftnlen)700)]) * rpd_(); - sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth", - i__2, "bodmat_", (ftnlen)702)] = sin(theta); - costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh", - i__2, "bodmat_", (ftnlen)703)] = cos(theta); - } - ra += vdotg_(ac, sinth, &na); - dec += vdotg_(dc, costh, &nd); - w += vdotg_(wc, sinth, &nw); - -/* Convert from degrees to radians and mod by two pi. */ - - ra *= rpd_(); - dec *= rpd_(); - w *= rpd_(); - d__1 = twopi_(); - ra = d_mod(&ra, &d__1); - d__1 = twopi_(); - dec = d_mod(&dec, &d__1); - d__1 = twopi_(); - w = d_mod(&w, &d__1); - -/* Convert to Euler angles. */ - - phi = ra + halfpi_(); - delta = halfpi_() - dec; - -/* Produce the rotation matrix defined by the Euler angles. */ - - eul2m_(&w, &delta, &phi, &c__3, &c__1, &c__3, tipm); - } - -/* Convert TIPM to the J2000-to-bodyfixed rotation, if is is not */ -/* already referenced to J2000. */ - - if (ref != j2code) { - -/* Find the transformation from the J2000 frame to the frame */ -/* designated by REF. Form the transformation from `REF' */ -/* coordinates to body-fixed coordinates. Compose the */ -/* transformations to obtain the J2000-to-body-fixed */ -/* transformation. */ - - irfrot_(&j2code, &ref, j2ref); - mxm_(tipm, j2ref, tmpmat); - moved_(tmpmat, &c__9, tipm); - } - -/* TIPM now gives the transformation from J2000 to */ -/* body-fixed coordinates at epoch ET seconds past J2000, */ -/* regardless of the epoch and frame of the orientation constants */ -/* for the specified body. */ - - chkout_("BODMAT", (ftnlen)6); - return 0; -} /* bodmat_ */ - diff --git a/ext/spice/src/cspice/bodn2c.c b/ext/spice/src/cspice/bodn2c.c deleted file mode 100644 index feddd7b949..0000000000 --- a/ext/spice/src/cspice/bodn2c.c +++ /dev/null @@ -1,286 +0,0 @@ -/* bodn2c.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BODN2C ( Body name to ID code translation ) */ -/* Subroutine */ int bodn2c_(char *name__, integer *code, logical *found, - ftnlen name_len) -{ - extern /* Subroutine */ int zzbodn2c_(char *, integer *, logical *, - ftnlen), chkin_(char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Translate the name of a body or object to the corresponding SPICE */ -/* integer ID code. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ -/* ID */ -/* NAME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Body name to be translated into a SPICE ID code. */ -/* CODE O SPICE integer ID code for the named body. */ -/* FOUND O True if translated, otherwise false. */ -/* MAXL P Maximum length of NAME string. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a body or object, such as a planet, */ -/* satellite, comet, asteroid, barycenter, DSN station, */ -/* spacecraft, or instrument, that is "known" to the */ -/* SPICE system, whether through hard-coded */ -/* registration or run-time registration in the SPICE */ -/* kernel pool. */ - -/* Case and leading and trailing blanks in a name */ -/* are not significant. However when a name is made */ -/* up of more than one word, they must be separated by */ -/* at least one blank. That is, all of the following */ -/* strings are equivalent names: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is not equivalent to */ -/* the names above. */ - -/* $ Detailed_Output */ - -/* CODE is the SPICE or user-defined integer ID code for the */ -/* named body. */ - -/* FOUND is true if NAME has a translation. Otherwise, FOUND */ -/* is false. */ - -/* $ Parameters */ - -/* MAXL is the maximum allowable length of a body name. */ -/* The value of this parameter may be found in the */ -/* include file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* Body-name mappings may be defined at run time by loading text */ -/* kernels containing kernel variable assignments of the form */ - -/* NAIF_BODY_NAME += ( , ... ) */ -/* NAIF_BODY_CODE += ( , ... ) */ - -/* See NAIF_IDs for details. */ - -/* $ Particulars */ - -/* BODN2C is one of five related subroutines, */ - -/* BODS2C Body string to code */ -/* BODC2S Body code to string */ -/* BODN2C Body name to code */ -/* BODC2N Body code to name */ -/* BODDEF Body name/code definition */ - -/* BODS2C, BODC2S, BODN2C, and BODC2N perform translations between */ -/* body names and their corresponding integer ID codes which are */ -/* used in SPICE files and routines. */ - -/* BODS2C is a slightly more general version of BODN2C: support */ -/* for strings containing ID codes in string format enables a caller */ -/* to identify a body using a string, even when no name is */ -/* associated with that body. */ - -/* BODC2S is a general version of BODC2N; the routine returns either */ -/* the name assigned in the body ID to name mapping or a string */ -/* representation of the CODE value if no mapping exists. */ - -/* BODDEF assigns a body name to ID mapping. The mapping has */ -/* priority in name-to-ID and ID-to-name translations. */ - -/* Programmers writing user interface code should consider using the */ -/* SPICELIB routine BODS2C. BODS2C provides more flexibility in */ -/* handling input strings, since it accepts both body names and */ -/* strings representing integer ID codes, for example '399'. */ - -/* Refer to NAIF_IDs for the list of name/code associations built */ -/* into SPICE, and for details concerning adding new name/code */ -/* associations at run time by loading text kernels. */ - -/* $ Examples */ - -/* 1. In the following code fragment, BODVCD returns the radii */ -/* of Jupiter. BODVCD requires the SPICE integer ID code for */ -/* Jupiter, so we use BODN2C to convert the name to */ -/* its corresponding integer ID code. */ - -/* CALL BODN2C ( 'JUPITER', JUPID, FOUND ) */ - -/* CALL BODVCD ( JUPID, 'RADII', 3, N, RADII ) */ - - -/* 2. In this example, we assume that only the set of default */ -/* name/code pairs has been defined. */ - -/* Given these names, BODN2C will return the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - - -/* Given these codes, BODC2N will return the following names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* B.V. Semenov (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.8, 16-MAY-2009 (EDW) */ - -/* Edit to Particulars section to document the BODC2S routine. */ - -/* - SPICELIB Version 1.0.7, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.0.6, 31-JAN-2008 (NJB) */ - -/* References to the routine BODS2C were added to the header. */ - -/* - SPICELIB Version 1.0.5, 24-OCT-2005 (NJB) */ - -/* Header update: changed references to BODVAR to references */ -/* to BODVCD. */ - -/* - SPICELIB Version 1.0.4, 20-JUL-2004 (EDW) */ - -/* Removed unneeded assignment of FOUND = .FALSE. */ - -/* - SPICELIB Version 1.0.3, 29-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - SPICELIB Version 1.0.2, 26-AUG-2002 (FST) */ - -/* Added discussion of MAXL to the parameters section. */ - -/* - SPICELIB Version 1.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - SPICELIB Version 1.0.0, 23-JAN-1996 (KRG) */ - -/* This was the BODN2C entry point from the original BODTRN */ -/* subroutine that was in the NAIF toolkit SUPPORT library. */ -/* When the private subroutine ZZBODTRN was added to SPICELIB, */ -/* superceding the BODTRN from SUPPORT, the body ID code/name */ -/* translation interface from the original BODTRN was moved to */ -/* SPICELIB so that ID codes did not have to be hard coded by */ -/* users of the Toolkit. */ - -/* This subroutine simply calls the private subroutine ZZBODN2C */ -/* to perform its job. */ - -/* -& */ -/* $ Index_Entries */ - -/* body name to code */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODN2C", (ftnlen)6); - } - zzbodn2c_(name__, code, found, name_len); - -/* No need for any error checking, since all we do is check out */ -/* and return anyway. We leave the error checking to the caller. */ - - chkout_("BODN2C", (ftnlen)6); - return 0; -} /* bodn2c_ */ - diff --git a/ext/spice/src/cspice/bodn2c_c.c b/ext/spice/src/cspice/bodn2c_c.c deleted file mode 100644 index 97b98de4f2..0000000000 --- a/ext/spice/src/cspice/bodn2c_c.c +++ /dev/null @@ -1,317 +0,0 @@ -/* - --Procedure bodn2c_c ( Body name to ID code translation ) - --Abstract - - Translate the name of a body or object to the corresponding SPICE - integer ID code. - --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 - - NAIF_IDS - --Keywords - - BODY - CONVERSION - ID - NAME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void bodn2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - name I Body name to be translated into a SPICE ID code. - code O SPICE integer ID code for the named body. - found O SPICETRUE if translated, otherwise SPICEFALSE. - --Detailed_Input - - name is the name of a body or object, such as a planet, - satellite, comet, asteroid, barycenter, DSN station, - spacecraft, or instrument, that is "known" to the SPICE - system, whether through hard-coded registration or - run-time registration in the SPICE kernel pool. - - Case and leading and trailing blanks in `name' - are not significant. However when a name is made - up of more than one word, they must be separated by - at least one blank. That is, all of the following - strings are equivalent names: - - "JUPITER BARYCENTER" - "Jupiter Barycenter" - "JUPITER BARYCENTER " - "JUPITER BARYCENTER" - " JUPITER BARYCENTER" - - However, "JUPITERBARYCENTER" is not equivalent to - the names above. - --Detailed_Output - - code is the SPICE or user-defined integer ID code for the - named body. - - found is SPICETRUE if `name' has a translation. Otherwise, - `found' is SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signaled if the input string - `name' does not contain at least one character, since the input - string cannot be converted to a Fortran-style string in this - case. - - 2) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `name' is null. - --Files - - Body-name mappings may be defined at run time by loading text - kernels containing kernel variable assignments of the form - - NAIF_BODY_NAME += ( , ... ) - NAIF_BODY_CODE += ( , ... ) - - See NAIF_IDs for details. - --Particulars - - bodn2c_c is one of five related subroutines, - - bods2c_c Body string to code - bodc2s_c Body code to string - bodn2c_c Body name to code - bodc2n_c Body code to name - boddef_c Body name/code definition - - bods2c_c, bodc2s_c, bodn2c_c, and bodc2n_c perform translations between - body names and their corresponding integer ID codes which are - used in SPICE files and routines. - - bods2c_c is a slightly more general version of bodn2c_c: support - for strings containing ID codes in string format enables a caller - to identify a body using a string, even when no name is - associated with that body. - - bodc2s_c is a general version of bodc2n_c; the routine returns either - the name assigned in the body ID to name mapping or a string - representation of the CODE value if no mapping exists. - - boddef_c assigns a body name to ID mapping. The mapping has priority - in name-to-ID and ID-to-name translations. - - Programmers writing user interface code should consider using the - CSPICE routine bods2c_c. bods2c_c provides more flexibility in - handling input strings, since it accepts both body names and - strings representing integer ID codes, for example "399". - - Refer to NAIF_IDs for the list of name/code associations built into - SPICE, and for details concerning adding new name/code - associations at run time by loading text kernels. - --Examples - - 1) In the following code fragment, bodvcd_c returns the radii - of Jupiter. bodvcd_c requires the SPICE integer ID code - for Jupiter, so we use bodn2c_c to convert the name to its - corresponding integer ID code. - - - bodn2c_c ( "JUPITER", &jupid, &found ); - - bodvcd_c ( jupid, "RADII", 3, &n, radii ); - - - 2) In this example, we assume that only the set of default - name/code pairs has been defined. - - Given these names, bodn2c_c will return the following codes: - - Name Code Found? - ------------------------ ------ ------ - "EARTH" 399 Yes - " Earth " 399 Yes - "EMB" 3 Yes - "Solar System Barycenter" 0 Yes - "SolarSystemBarycenter" - No - "SSB" 0 Yes - "Voyager 2" -32 Yes - "U.S.S. Enterprise" - No - " " - No - "Halley's Comet" - No - - - Given these codes, bodc2n_c will return the following names: - - Code Name Found? - ------- ------------------- ------ - 399 "EARTH" Yes - 0 "SOLAR SYSTEM BARYCENTER" Yes - 3 "EARTH BARYCENTER" Yes - -77 "GALILEO ORBITER" Yes - 11 - No - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 2.1.6, 16-MAY-2009 (EDW) - - Edit to Particulars section to document the bodc2s_c routine. - - -CSPICE Version 2.1.5, 27-FEB-2008 (BVS) - - Corrected the contents of the Required_Reading section of - the header. - - -CSPICE Version 2.1.4, 31-JAN-2008 (NJB) - - References to the routine bods2c_c were added to the header. - - -CSPICE Version 2.1.3, 27-OCT-2005 (NJB) - - Header update: replaced references to bodvar_c with - references to bodvcd_c. - - -CSPICE Version 2.1.2, 23-JUL-2004 (NJB) - - Header correction: Exceptions section was updated to document - input string error handling. - - -CSPICE Version 2.1.1, 28-JUL-2003 (NJB) - - Various header changes were made to improve clarity. Some - minor header corrections were made. - - -CSPICE Version 2.1.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for found flag used in - interface of bodn2c_. - - -CSPICE Version 2.0.2, 25-MAR-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - The type of the input argument name was changed to - ConstSpiceChar *. - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.0, 23-JAN-1996 (KRG) - --Index_Entries - - body name to code - --& -*/ - -{ /* Begin bodn2c_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error handling - */ - chkin_c ( "bodn2c_c"); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "bodn2c_c", name ); - - - /* - Translate the name to the corresponding code. - */ - bodn2c_( ( char * ) name, - ( integer * ) code, - ( logical * ) &fnd, - ( ftnlen ) strlen(name) ); - - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - - chkout_c ( "bodn2c_c"); - -} /* End bodn2c_c */ diff --git a/ext/spice/src/cspice/bods2c.c b/ext/spice/src/cspice/bods2c.c deleted file mode 100644 index f92e91a0e7..0000000000 --- a/ext/spice/src/cspice/bods2c.c +++ /dev/null @@ -1,311 +0,0 @@ -/* bods2c.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BODS2C ( Body string to ID code translation ) */ -/* Subroutine */ int bods2c_(char *name__, integer *code, logical *found, - ftnlen name_len) -{ - extern /* Subroutine */ int zzbodn2c_(char *, integer *, logical *, - ftnlen), chkin_(char *, ftnlen); - extern logical beint_(char *, ftnlen); - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen), chkout_(char *, ftnlen); - char errmsg[1]; - extern logical return_(void); - integer ptr; - -/* $ Abstract */ - -/* Translate a string containing a body name or ID code to an */ -/* integer code. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ -/* ID */ -/* NAME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I String to be translated to an ID code. */ -/* CODE O Integer ID code corresponding to NAME. */ -/* FOUND O Flag indicating whether translation succeeded. */ - -/* $ Detailed_Input */ - -/* NAME is a string containing the name or ID code of a */ -/* body or object, such as a planet, satellite, comet, */ -/* asteroid, barycenter, DSN station, spacecraft, or */ -/* instrument. */ - -/* If NAME contains the name of a body or object, that */ -/* name must be "known" to the SPICE system, whether */ -/* through hard-coded registration or run-time */ -/* registration in the SPICE kernel pool. */ - -/* Case and leading and trailing blanks in a name are */ -/* not significant. However when a name is made up of */ -/* more than one word, adjacent words must be separated */ -/* by at least one blank. That is, all of the following */ -/* strings are equivalent names: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is not equivalent to */ -/* the names above. */ - -/* If NAME is a string representation of an integer, */ -/* for example */ - -/* '399' */ - -/* the string will be translated to the equivalent */ -/* INTEGER datum. The input integer need not be one */ -/* recognized by the SPICE system: the integer need not */ -/* be a built-in NAIF ID code, nor need it be associated */ -/* with a name via run-time registration. */ - -/* $ Detailed_Output */ - -/* CODE is, if NAME contains the name of a body or object, */ -/* the corresponding NAIF or user-defined integer ID */ -/* code, as determined by the SPICE name-code mapping */ -/* subsystem. If NAME represents an integer, the same */ -/* integer is returned in CODE. */ - -/* CODE is assigned a value only if FOUND is returned */ -/* as .TRUE.; otherwise it is returned unchanged. */ - - -/* FOUND is .TRUE. if NAME has a translation or represents an */ -/* integer. Otherwise, FOUND is .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* Body-name mappings may be defined at run time by loading text */ -/* kernels containing kernel variable assignments of the form */ - -/* NAIF_BODY_NAME += ( , ... ) */ -/* NAIF_BODY_CODE += ( , ... ) */ - -/* See NAIF_IDs for details. */ - -/* $ Particulars */ - -/* BODS2C is one of five related subroutines, */ - -/* BODS2C Body string to code */ -/* BODC2S Body code to string */ -/* BODN2C Body name to code */ -/* BODC2N Body code to name */ -/* BODDEF Body name/code definition */ - -/* BODS2C, BODC2S, BODN2C, and BODC2N perform translations between */ -/* body names and their corresponding integer ID codes which are */ -/* used in SPICE files and routines. */ - -/* BODS2C is a slightly more general version of BODN2C: support */ -/* for strings containing ID codes in string format enables a caller */ -/* to identify a body using a string, even when no name is */ -/* associated with that body. */ - -/* BODC2S is a general version of BODC2N; the routine returns either */ -/* the name assigned in the body ID to name mapping or a string */ -/* representation of the CODE value if no mapping exists. */ - -/* BODDEF assigns a body name to ID mapping. The mapping has */ -/* priority in name-to-ID and ID-to-name translations. */ - -/* Refer to NAIF_IDs for the list of name/code associations built */ -/* into SPICE, and for details concerning adding new name/code */ -/* associations at run time by loading text kernels. */ - -/* $ Examples */ - -/* 1. In the following code fragment, BODEUL returns the Euler */ -/* angles representing the orientation of Jupiter relative to */ -/* the J2000 reference frame. BODEUL requires the NAIF integer */ -/* ID code for Jupiter, so we use BODS2C to convert the name to */ -/* its corresponding integer ID code. */ - -/* We know Jupiter has a built-in name-code mapping, so we */ -/* needn't check the FOUND flag. */ - -/* CALL BODS2C ( 'JUPITER', JUPID, FOUND ) */ - -/* CALL BODEUL ( JUPID, ET, RA, DEC, W, LAMBDA ) */ - - -/* 2. In this example, we assume that only the set of default */ -/* name/code pairs has been defined. */ - -/* Given these names, BODS2C will return the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* '399' 399 Yes */ -/* ' 399 ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* '3' 3 Yes */ -/* '1000000000' 1000000000 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - -/* Given these codes, BODC2N will return the following names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ -/* 1000000000 - No */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* B.V. Semenov (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 16-MAY-2009 (EDW) */ - -/* Edit to Particulars section to document the BODC2S routine. */ - -/* - SPICELIB Version 1.0.1, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.0.0, 23-JUL-2003 (CHA) (NJB) (KRG) (FST) (EDW) */ - -/* Based on SPICELIB Version 1.0.3, 29-JUL-2003 */ -/* (CHA) (NJB) (KEG) (FST) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* body string to code */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("BODS2C", (ftnlen)6); - -/* Attempt to translate the input name to an integer code. Call */ -/* the private routine ZZBODN2C to avoid additional CHKIN and */ -/* CHKOUT calls. */ - - zzbodn2c_(name__, code, found, name_len); - if (! (*found)) { - -/* It's possible the name is a string representation */ -/* of an integer, for example, '999'. If so, find */ -/* the equivalent datum of INTEGER type. */ - - if (beint_(name__, name_len)) { - -/* The input conforms to the syntax of an integer, but it may */ -/* be outside of the range of the INTEGER data type. */ -/* Therefore we use the non-error-signaling routine NPARSI */ -/* rather than the cleaner PRSINT to attempt to convert the */ -/* string to an INTEGER. */ - - nparsi_(name__, code, errmsg, &ptr, name_len, (ftnlen)1); - -/* We have an ID code if and only if PTR is zero. */ - - *found = ptr == 0; - } - } - -/* FOUND is set. CODE is set if NAME was a recognized name */ -/* or a string representation of an integer. */ - - chkout_("BODS2C", (ftnlen)6); - return 0; -} /* bods2c_ */ - diff --git a/ext/spice/src/cspice/bods2c_c.c b/ext/spice/src/cspice/bods2c_c.c deleted file mode 100644 index a49ee7eac2..0000000000 --- a/ext/spice/src/cspice/bods2c_c.c +++ /dev/null @@ -1,296 +0,0 @@ -/* - --Procedure bods2c_c ( Body string to ID code translation ) - --Abstract - - Translate a string containing a body name or ID code to an integer - code. - --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 - - NAIF_IDS - --Keywords - - BODY - CONVERSION - ID - NAME - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void bods2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - name I String to be translated to an ID code. - code O Integer ID code corresponding to `name'. - found O Flag indicating whether translation succeeded. - --Detailed_Input - - name is a string containing the name or ID code of a body or - object, such as a planet, satellite, comet, asteroid, - barycenter, DSN station, spacecraft, or instrument. - - If `name' contains the name of a body or object, that - name must be "known" to the SPICE system, whether - through hard-coded registration or run-time registration - in the SPICE kernel pool. - - Case and leading and trailing blanks in `name' - are not significant. However when a name is made - up of more than one word, they must be separated by - at least one blank. That is, all of the following - strings are equivalent names: - - "JUPITER BARYCENTER" - "Jupiter Barycenter" - "JUPITER BARYCENTER " - "JUPITER BARYCENTER" - " JUPITER BARYCENTER" - - However, "JUPITERBARYCENTER" is not equivalent to - the names above. - - If NAME is a string representation of an integer, - for example - - "399" - - the string will be translated to the equivalent SpiceInt - datum. The input integer need not be one recognized by - the SPICE system: the integer need not be a built-in - NAIF ID code, nor need it be associated with a name via - run-time registration. - --Detailed_Output - - code is, if `name' contains the name of a body or object, - the corresponding NAIF or user-defined integer ID code, - as determined by the SPICE name-code mapping subsystem. - If the input argument `name' represents an integer, the - same integer is returned in `code'. - - `code' is assigned a value only if `found' is returned - as SPICETRUE; otherwise it is returned unchanged. - - - found is SPICETRUE if `name' has a translation. Otherwise, - `found' is SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signaled if the input string - `name' does not contain at least one character, since the input - string cannot be converted to a Fortran-style string in this - case. - - 2) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `name' is null. - --Files - - Body-name mappings may be defined at run time by loading text - kernels containing kernel variable assignments of the form - - NAIF_BODY_NAME += ( , ... ) - NAIF_BODY_CODE += ( , ... ) - - See NAIF_IDs for details. - --Particulars - - bods2c_c is one of five related subroutines, - - bods2c_c Body string to code - bodc2s_c Body code to string - bodn2c_c Body name to code - bodc2n_c Body code to name - boddef_c Body name/code definition - - bods2c_c, bodc2s_c, bodn2c_c, and bodc2n_c perform translations between - body names and their corresponding integer ID codes which are - used in SPICE files and routines. - - bods2c_c is a slightly more general version of bodn2c_c: support - for strings containing ID codes in string format enables a caller - to identify a body using a string, even when no name is - associated with that body. - - bodc2s_c is a general version of bodc2n_c; the routine returns either - the name assigned in the body ID to name mapping or a string - representation of the CODE value if no mapping exists. - - boddef_c assigns a body name to ID mapping. The mapping has priority - in name-to-ID and ID-to-name translations. - - Refer to NAIF_IDs for the list of name/code associations built into - SPICE, and for details concerning adding new name/code - associations at run time by loading text kernels. - --Examples - - 1. In the following code fragment, bodeul_ returns the Euler - angles representing the orientation of Jupiter relative to - the J2000 reference frame. bodeul_ requires the NAIF integer - ID code for Jupiter, so we use bods2c_c to convert the name to - its corresponding integer ID code. - - bods2c_c ( "JUPITER", &jupid, &found ); - - bodeul_ ( &jupid, &et, &ra, &dec, &w, &lambda ); - - 2. In this example, we assume that only the set of default - name/code pairs has been defined. - - Given these names, bods2c_c will return the following codes: - - Name Code Found? - ------------------------ ---------- ------ - "EARTH" 399 Yes - " Earth " 399 Yes - "399" 399 Yes - " 399 " 399 Yes - "EMB" 3 Yes - "3" 3 Yes - "1000000000" 1000000000 Yes - "Solar System Barycenter" 0 Yes - "SolarSystemBarycenter" - No - "SSB" 0 Yes - "Voyager 2" -32 Yes - "U.S.S. Enterprise" - No - " " - No - "Halley's Comet" - No - - - Given these codes, bodc2n_c will return the following names: - - Code Name Found? - ---------- ------------------------ ------ - 399 "EARTH" Yes - 0 "SOLAR SYSTEM BARYCENTER" Yes - 3 "EARTH BARYCENTER" Yes - -77 "GALILEO ORBITER" Yes - 11 - No - 1000000000 - No - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 1.0.2, 16-MAY-2009 (EDW) - - Edit to Particulars section to document the bodc2s_c routine. - - -CSPICE Version 1.0.1, 27-FEB-2008 (BVS) - - Corrected the contents of the Required_Reading section of - the header. - - -CSPICE Version 1.0.0, 23-JUL-2004 (CHA) (NJB) (KRG) - --Index_Entries - - body name to code - --& -*/ - -{ /* Begin bods2c_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error handling - */ - chkin_c ( "bods2c_c"); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "bods2c_c", name ); - - - /* - Translate the name to the corresponding code. - */ - bods2c_( ( char * ) name, - ( integer * ) code, - ( logical * ) &fnd, - ( ftnlen ) strlen(name) ); - - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - - chkout_c ( "bods2c_c"); - -} /* End bods2c_c */ diff --git a/ext/spice/src/cspice/bodvar.c b/ext/spice/src/cspice/bodvar.c deleted file mode 100644 index a6e73e9db3..0000000000 --- a/ext/spice/src/cspice/bodvar.c +++ /dev/null @@ -1,216 +0,0 @@ -/* bodvar.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure BODVAR ( Return values from the kernel pool ) */ -/* Subroutine */ int bodvar_(integer *body, char *item, integer *dim, - doublereal *values, ftnlen item_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char code[16]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - char varnam[32]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), suffix_(char *, integer *, char - *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int rtpool_(char *, integer *, doublereal *, - logical *, ftnlen), intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Deprecated: This routine has been superseded by BODVCD and */ -/* BODVRD. This routine is supported for purposes of backward */ -/* compatibility only. */ - -/* Return the values of some item for any body in the */ -/* kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of body. */ -/* ITEM I Item for which values are desired. ('RADII', */ -/* 'NUT_PREC_ANGLES', etc. ) */ -/* DIM O Number of values returned. */ -/* VALUES O Values. */ - -/* $ Detailed_Input */ - -/* BODY is the ID code of the body for which ITEM is */ -/* requested. Bodies are numbered according to the */ -/* standard NAIF numbering scheme. */ - -/* ITEM is the item to be returned. Together, the body and */ -/* item name combine to form a variable name, e.g., */ - -/* 'BODY599_RADII' */ -/* 'BODY401_POLE_RA' */ - -/* $ Detailed_Output */ - -/* DIM is the number of values associated with the variable. */ - -/* VALUES are the values associated with the variable. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The call */ - -/* CALL BODVAR ( 399, 'RADII', DIM, VALUE ) */ - -/* returns the dimension and values associated with the variable */ -/* 'BODY399_RADII', for example, */ - -/* DIM = 3 */ -/* VALUE(1) = 6378.140 */ -/* VALUE(2) = 6378.140 */ -/* VALUE(3) = 6356.755 */ - -/* $ Restrictions */ - -/* 1) If the requested item is not found, the error */ -/* SPICE(KERNELVARNOTFOUND) is signalled. */ - -/* $ Literature_References */ - -/* 1) Refer to the SPK required reading file for a complete list of */ -/* the NAIF integer ID codes for bodies. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.5, 18-MAY-2010 (BVS) */ - -/* Index lines now state that this routine is deprecated. */ - -/* - SPICELIB Version 1.0.4, 27-OCT-2005 (NJB) */ - -/* Routine is now deprecated. */ - -/* - SPICELIB Version 1.0.3, 08-JAN-2004 (EDW) */ - -/* Trivial typo corrected. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 8-AUG-1990 (HAN) */ - -/* Detailed Input section of the header was updated. The */ -/* description for the variable BODY was incorrect. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED fetch constants for a body from the kernel pool */ -/* DEPRECATED physical constants for a body */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODVAR", (ftnlen)6); - } - -/* Construct the variable name from BODY and ITEM. */ - - s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4); - intstr_(body, code, (ftnlen)16); - suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32); - suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32); - suffix_(item, &c__0, varnam, item_len, (ftnlen)32); - -/* Grab the items. Complain if they aren't there. */ - - rtpool_(varnam, dim, values, &found, (ftnlen)32); - if (! found) { - setmsg_("The variable # could not be found in the kernel pool.", ( - ftnlen)53); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - } - chkout_("BODVAR", (ftnlen)6); - return 0; -} /* bodvar_ */ - diff --git a/ext/spice/src/cspice/bodvar_c.c b/ext/spice/src/cspice/bodvar_c.c deleted file mode 100644 index 7734840448..0000000000 --- a/ext/spice/src/cspice/bodvar_c.c +++ /dev/null @@ -1,209 +0,0 @@ -/* - --Procedure bodvar_c ( Return values from the kernel pool ) - --Abstract - - Deprecated: This routine has been superseded by bodvcd_c and - bodvrd_c. This routine is supported for purposes of backward - compatibility only. - - Return the values of some item for any body in the - kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void bodvar_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt * dim, - SpiceDouble * values ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - body I ID code of body. - item I Item for which values are desired. ("RADII", - "NUT_PREC_ANGLES", etc. ) - dim O Number of values returned. - values O Values. - - --Detailed_Input - - body is the ID code of the body for which ITEM is - requested. Bodies are numbered according to the - standard NAIF numbering scheme. - - item is the item to be returned. Together, the body and - item name combine to form a variable name, e.g., - - "BODY599_RADII" - "BODY401_POLE_RA" - --Detailed_Output - - dim is the number of values associated with the variable. - - values are the values associated with the variable. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - None. - --Examples - - The call - - SpiceInt body; - SpiceInt dim; - SpiceChar * item; - SpiceDouble value[10]; - - body = 399; - item = "RADII"; - - bodvar_c ( body, item, &dim, value ); - - returns the dimension and values associated with the variable - "BODY399_RADII", for example, - - dim is 3 - value[0] is 6378.140 - value[1] is 6378.140 - value[2] is 6356.755 - - --Restrictions - - 1) If the requested item is not found, the error - SPICE(KERNELVARNOTFOUND) is signalled. - --Literature_References - - 1) Refer to the SPK required reading file for a complete list of - the NAIF integer ID codes for bodies. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.0.4, 19-MAY-2010 (BVS) - - Index lines now states that this routine is deprecated. - - -CSPICE Version 2.0.3, 27-OCT-2005 (NJB) - - Routine is now deprecated. - - -CSPICE Version 2.0.2, 08-JAN-2004 (EDW) - - Trivial typo corrected. - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - Input argument item was changed to type ConstSpiceChar *. - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - DEPRECATED fetch constants for a body from the kernel pool - DEPRECATED physical constants for a body - --& -*/ - - -{ /* Begin bodvar_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "bodvar_c" ); - - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "bodfnd_c", item ); - - - /* - Call the f2c'd routine. - */ - bodvar_( ( integer * ) &body, - ( char * ) item, - ( integer * ) dim, - ( doublereal * ) values, - ( ftnlen ) strlen(item) ); - - - chkout_c ( "bodvar_c" ); - -} /* End bodvar_c*/ diff --git a/ext/spice/src/cspice/bodvcd.c b/ext/spice/src/cspice/bodvcd.c deleted file mode 100644 index 340388c766..0000000000 --- a/ext/spice/src/cspice/bodvcd.c +++ /dev/null @@ -1,314 +0,0 @@ -/* bodvcd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure BODVCD ( Return d.p. values from the kernel pool ) */ -/* Subroutine */ int bodvcd_(integer *bodyid, char *item, integer *maxn, - integer *dim, doublereal *values, ftnlen item_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char code[16], type__[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - char varnam[32]; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), dtpool_(char *, logical *, integer *, - char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Fetch from the kernel pool the double precision values */ -/* of an item associated with a body, where the body is */ -/* specified by an integer ID code. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ - -/* $ Keywords */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODYID I Body ID code. */ -/* ITEM I Item for which values are desired. ('RADII', */ -/* 'NUT_PREC_ANGLES', etc. ) */ -/* MAXN I Maximum number of values that may be returned. */ -/* DIM O Number of values returned. */ -/* VALUES O Values. */ - -/* $ Detailed_Input */ - -/* BODYID is the NAIF integer ID code for a body of interest. */ -/* For example, if the body is the earth, the code is */ -/* 399. */ - -/* ITEM is the item to be returned. Together, the NAIF ID */ -/* code of the body and the item name combine to form a */ -/* kernel variable name, e.g., */ - -/* 'BODY599_RADII' */ -/* 'BODY401_POLE_RA' */ - -/* The values associated with the kernel variable having */ -/* the name constructed as shown are sought. Below */ -/* we'll take the shortcut of calling this kernel variable */ -/* the "requested kernel variable." */ - -/* Note that ITEM *is* case-sensitive. This attribute */ -/* is inherited from the case-sensitivity of kernel */ -/* variable names. */ - -/* MAXN is the maximum number of values that may be returned. */ -/* The output array VALUES must be declared with size at */ -/* least MAXN. It's an error to supply an output array */ -/* that is too small to hold all of the values associated */ -/* with the requested kernel variable. */ - -/* $ Detailed_Output */ - -/* DIM is the number of values returned; this is always the */ -/* number of values associated with the requested kernel */ -/* variable unless an error has been signaled. */ - -/* VALUES is the array of values associated with the requested */ -/* kernel variable. If VALUES is too small to hold all */ -/* of the values associated with the kernel variable, the */ -/* returned values of DIM and VALUES are undefined. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the requested kernel variable is not found in the kernel */ -/* pool, the error SPICE(KERNELVARNOTFOUND) is signaled. */ - -/* 2) If the requested kernel variable is found but the associated */ -/* values aren't numeric, the error SPICE(TYPEMISMATCH) is */ -/* signaled. */ - -/* 3) The output array VALUES must be declared with sufficient size */ -/* to contain all of the values associated with the requested */ -/* kernel variable. If the dimension of */ -/* VALUES indicated by MAXN is too small to contain the */ -/* requested values, the error SPICE(ARRAYTOOSMALL) is signaled. */ - -/* 4) If the input dimension MAXN indicates there is more room */ -/* in VALUES than there really is---for example, if MAXN is */ -/* 10 but values is declared with dimension 5---and the dimension */ -/* of the requested kernel variable is larger than the actual */ -/* dimension of VALUES, then this routine may overwrite */ -/* memory. The results are unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simplifies looking up PCK kernel variables by */ -/* constructing names of requested kernel variables and by */ -/* performing error checking. */ - -/* This routine is intended for use in cases where the maximum */ -/* number of values that may be returned is known at compile */ -/* time. The caller fetches all of the values associated with */ -/* the specified kernel variable via a single call to this */ -/* routine. If the number of values to be fetched cannot be */ -/* known until run time, the lower-level routine GDPOOL (an */ -/* entry point of POOL) should be used instead. GDPOOL supports */ -/* fetching arbitrary amounts of data in multiple "chunks." */ - -/* This routine is intended for use in cases where the requested */ -/* kernel variable is expected to be present in the kernel pool. If */ -/* the variable is not found or has the wrong data type, this */ -/* routine signals an error. In cases where it is appropriate to */ -/* indicate absence of an expected kernel variable by returning a */ -/* boolean "found flag" with the value .FALSE., again the routine */ -/* GDPOOL should be used. */ - -/* $ Examples */ - -/* 1) When the kernel variable */ - -/* BODY399_RADII */ - -/* is present in the kernel pool---normally because a PCK */ -/* defining this variable has been loaded---the call */ - -/* CALL BODVCD ( 399, 'RADII', 3, DIM, VALUES ) */ - -/* returns the dimension and values associated with the variable */ -/* 'BODY399_RADII', for example, */ - -/* DIM = 3 */ -/* VALUES(1) = 6378.140 */ -/* VALUES(2) = 6378.140 */ -/* VALUES(3) = 6356.755 */ - -/* 2) The call */ - -/* CALL BODVCD ( 399, 'radii', 3, DIM, VALUES ) */ - -/* usually will cause a SPICE(KERNELVARNOTFOUND) error to be */ -/* signaled, because this call will attempt to look up the */ -/* values associated with a kernel variable of the name */ - -/* 'BODY399_radii' */ - -/* Since kernel variable names are case sensitive, this */ -/* name is not considered to match the name */ - -/* 'BODY399_RADII' */ - -/* which normally would be present after a text PCK */ -/* containing data for all planets and satellites has */ -/* been loaded. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 24-OCT-2004 (NJB) (BVS) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch constants for a body from the kernel pool */ -/* physical constants for a body */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODVCD", (ftnlen)6); - } - -/* Construct the variable name from BODY and ITEM. */ - - s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4); - intstr_(bodyid, code, (ftnlen)16); - suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32); - suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32); - suffix_(item, &c__0, varnam, item_len, (ftnlen)32); - -/* Make sure the item is present in the kernel pool. */ - - dtpool_(varnam, &found, dim, type__, (ftnlen)32, (ftnlen)1); - if (! found) { - setmsg_("The variable # could not be found in the kernel pool.", ( - ftnlen)53); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("BODVCD", (ftnlen)6); - return 0; - } - -/* Make sure the item's data type is numeric. */ - - if (*(unsigned char *)type__ != 'N') { - setmsg_("The data associated with variable # are not of numeric type." - , (ftnlen)60); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("BODVCD", (ftnlen)6); - return 0; - } - -/* Make sure there's enough room in the array VALUES to hold */ -/* the requested data. */ - - if (*maxn < *dim) { - setmsg_("The data array associated with variable # has dimension #, " - "which is larger than the available space # in the output arr" - "ay.", (ftnlen)122); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - errint_("#", dim, (ftnlen)1); - errint_("#", maxn, (ftnlen)1); - sigerr_("SPICE(ARRAYTOOSMALL)", (ftnlen)20); - chkout_("BODVCD", (ftnlen)6); - return 0; - } - -/* Grab the values. We know at this point they're present in */ -/* the kernel pool, so we don't check the FOUND flag. */ - - gdpool_(varnam, &c__1, maxn, dim, values, &found, (ftnlen)32); - chkout_("BODVCD", (ftnlen)6); - return 0; -} /* bodvcd_ */ - diff --git a/ext/spice/src/cspice/bodvcd_c.c b/ext/spice/src/cspice/bodvcd_c.c deleted file mode 100644 index 7b0ed7fd2d..0000000000 --- a/ext/spice/src/cspice/bodvcd_c.c +++ /dev/null @@ -1,270 +0,0 @@ -/* - --Procedure bodvcd_c ( Return d.p. values from the kernel pool ) - --Abstract - - Fetch from the kernel pool the double precision values of an item - associated with a body, where the body is specified by an integer ID - code. - --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 - - KERNEL - NAIF_IDS - --Keywords - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void bodvcd_c ( SpiceInt bodyid, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim, - SpiceDouble * values ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - bodyid I Body ID code. - item I Item for which values are desired. ("RADII", - "NUT_PREC_ANGLES", etc. ) - maxn I Maximum number of values that may be returned. - dim O Number of values returned. - values O Values. - --Detailed_Input - - bodyid is the NAIF integer ID code for a body of interest. - For example, if the body is the earth, the code is - 399. - - item is the item to be returned. Together, the NAIF ID - code of the body and the item name combine to form a - kernel variable name, e.g., - - "BODY599_RADII" - "BODY401_POLE_RA" - - The values associated with the kernel variable having - the name constructed as shown are sought. Below - we'll take the shortcut of calling this kernel variable - the "requested kernel variable." - - Note that `item' *is* case-sensitive. This attribute - is inherited from the case-sensitivity of kernel - variable names. - - maxn is the maximum number of values that may be returned. - The output array `values' must be declared with size at - least `maxn'. It's an error to supply an output array - that is too small to hold all of the values associated - with the requested kernel variable. - --Detailed_Output - - dim is the number of values returned; this is always the - number of values associated with the requested kernel - variable unless an error has been signaled. - - values is the array of values associated with the requested - kernel variable. If `values' is too small to hold all - of the values associated with the kernel variable, the - returned values of `dim' and `values' are undefined. - --Parameters - - None. - --Exceptions - - 1) If the requested kernel variable is not found in the kernel - pool, the error SPICE(KERNELVARNOTFOUND) is signaled. - - 2) If the requested kernel variable is found but the associated - values aren't numeric, the error SPICE(TYPEMISMATCH) is - signaled. - - 3) The output array `values' must be declared with sufficient size - to contain all of the values associated with the requested kernel - variable. If the dimension of `values' indicated by `maxn' is - too small to contain the requested values, the error - SPICE(ARRAYTOOSMALL) is signaled. - - 4) If the input dimension `maxn' indicates there is more room - in `values' than there really is---for example, if `maxn' is - 10 but `values' is declared with dimension 5---and the dimension - of the requested kernel variable is larger than the actual - dimension of `values', then this routine may overwrite - memory. The results are unpredictable. - - 5) If the input string pointer `item' is null, the error - SPICE(NULLPOINTER) will be signaled. - - 6) If either of the input strings referred to by `item' contains - no data characters, the error SPICE(EMPTYSTRING) will - be signaled. - --Files - - None. - --Particulars - - This routine simplifies looking up PCK kernel variables by - constructing names of requested kernel variables and by performing - error checking. - - This routine is intended for use in cases where the maximum number - of values that may be returned is known at compile time. The caller - fetches all of the values associated with the specified kernel - variable via a single call to this routine. If the number of values - to be fetched cannot be known until run time, the lower-level - routine gdpool_c should be used instead. gdpool_c supports fetching - arbitrary amounts of data in multiple "chunks." - - This routine is intended for use in cases where the requested kernel - variable is expected to be present in the kernel pool. If the - variable is not found or has the wrong data type, this routine - signals an error. In cases where it is appropriate to indicate - absence of an expected kernel variable by returning a boolean "found - flag" with the value SPICEFALSE, again the routine gdpool_c should - be used. - --Examples - - 1) When the kernel variable - - BODY399_RADII - - is present in the kernel pool---normally because a PCK defining - this variable has been loaded---the call - - bodvcd_c ( 399, "RADII", 3, &dim, values ); - - returns the dimension and values associated with the variable - "BODY399_RADII", for example, - - dim == 3 - value[0] == 6378.140 - value[1] == 6378.140 - value[2] == 6356.755 - - - 2) The call - - bodvcd_c ( 399, "radii", 3, &dim, values ); - - usually will cause a SPICE(KERNELVARNOTFOUND) error to be - signaled, because this call will attempt to look up the values - associated with a kernel variable of the name - - "BODY399_radii" - - Since kernel variable names are case sensitive, this name is not - considered to match the name - - "BODY399_RADII" - - which normally would be present after a text PCK containing data - for all planets and satellites has been loaded. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 12-APR-2006 (NJB) - - Header fix: output argument `dim' is now preceded by - an ampersand in example calls to bodvcd_c.c. - - -CSPICE Version 1.0.0, 24-OCT-2005 (NJB) (BVS) (WLT) (IMU) - --Index_Entries - - fetch constants for a body from the kernel pool - physical constants for a body - --& -*/ - -{ /* Begin bodvcd_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "bodvcd_c" ); - - - /* - Check the input string. - */ - CHKFSTR ( CHK_STANDARD, "bodvcd_c", item ); - - - /* - Call the f2c'd SPICELIB function. - */ - bodvcd_ ( (integer *) &bodyid, - (char *) item, - (integer *) &maxn, - (integer *) dim, - (doublereal *) values, - (ftnlen ) strlen(item) ); - - chkout_c ( "bodvcd_c" ); - -} /* End bodvcd_c */ diff --git a/ext/spice/src/cspice/bodvrd.c b/ext/spice/src/cspice/bodvrd.c deleted file mode 100644 index 593b6c6853..0000000000 --- a/ext/spice/src/cspice/bodvrd.c +++ /dev/null @@ -1,368 +0,0 @@ -/* bodvrd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure BODVRD ( Return d.p. values from the kernel pool ) */ -/* Subroutine */ int bodvrd_(char *bodynm, char *item, integer *maxn, integer - *dim, doublereal *values, ftnlen bodynm_len, ftnlen item_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char code[16], type__[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - integer bodyid; - char varnam[32]; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), dtpool_(char *, logical *, integer *, - char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Fetch from the kernel pool the double precision values */ -/* of an item associated with a body. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ - -/* $ Keywords */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODYNM I Body name. */ -/* ITEM I Item for which values are desired. ('RADII', */ -/* 'NUT_PREC_ANGLES', etc. ) */ -/* MAXN I Maximum number of values that may be returned. */ -/* DIM O Number of values returned. */ -/* VALUES O Values. */ - -/* $ Detailed_Input */ - -/* BODYNM is the name of the body for which ITEM is requested. */ -/* BODYNM is case-insensitive, and leading and trailing */ -/* blanks in BODYNM are not significant. Optionally, you */ -/* may supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the moon is the body */ -/* of interest. */ - -/* ITEM is the item to be returned. Together, the NAIF ID */ -/* code of the body and the item name combine to form a */ -/* kernel variable name, e.g., */ - -/* 'BODY599_RADII' */ -/* 'BODY401_POLE_RA' */ - -/* The values associated with the kernel variable having */ -/* the name constructed as shown are sought. Below */ -/* we'll take the shortcut of calling this kernel variable */ -/* the "requested kernel variable." */ - -/* Note that ITEM *is* case-sensitive. This attribute */ -/* is inherited from the case-sensitivity of kernel */ -/* variable names. */ - -/* MAXN is the maximum number of values that may be returned. */ -/* The output array VALUES must be declared with size at */ -/* least MAXN. It's an error to supply an output array */ -/* that is too small to hold all of the values associated */ -/* with the requested kernel variable. */ - -/* $ Detailed_Output */ - -/* DIM is the number of values returned; this is always the */ -/* number of values associated with the requested kernel */ -/* variable unless an error has been signaled. */ - -/* VALUES is the array of values associated with the requested */ -/* kernel variable. If VALUES is too small to hold all */ -/* of the values associated with the kernel variable, the */ -/* returned values of DIM and VALUES are undefined. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input body name cannot be translated to an ID code, */ -/* and if the name is not a string representation of an integer */ -/* (for example, '399'), the error SPICE(NOTRANSLATION) is */ -/* signaled. */ - -/* 2) If the requested kernel variable is not found in the kernel */ -/* pool, the error SPICE(KERNELVARNOTFOUND) is signaled. */ - -/* 3) If the requested kernel variable is found but the associated */ -/* values aren't numeric, the error SPICE(TYPEMISMATCH) is */ -/* signaled. */ - -/* 4) The output array VALUES must be declared with sufficient size */ -/* to contain all of the values associated with the requested */ -/* kernel variable. If the dimension of */ -/* VALUES indicated by MAXN is too small to contain the */ -/* requested values, the error SPICE(ARRAYTOOSMALL) is signaled. */ - -/* 5) If the input dimension MAXN indicates there is more room */ -/* in VALUES than there really is---for example, if MAXN is */ -/* 10 but values is declared with dimension 5---and the dimension */ -/* of the requested kernel variable is larger than the actual */ -/* dimension of VALUES, then this routine may overwrite */ -/* memory. The results are unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simplifies looking up PCK kernel variables by */ -/* constructing names of requested kernel variables and by */ -/* performing error checking. */ - -/* This routine is intended for use in cases where the maximum */ -/* number of values that may be returned is known at compile */ -/* time. The caller fetches all of the values associated with */ -/* the specified kernel variable via a single call to this */ -/* routine. If the number of values to be fetched cannot be */ -/* known until run time, the lower-level routine GDPOOL (an */ -/* entry point of POOL) should be used instead. GDPOOL supports */ -/* fetching arbitrary amounts of data in multiple "chunks." */ - -/* This routine is intended for use in cases where the requested */ -/* kernel variable is expected to be present in the kernel pool. If */ -/* the variable is not found or has the wrong data type, this */ -/* routine signals an error. In cases where it is appropriate to */ -/* indicate absence of an expected kernel variable by returning a */ -/* boolean "found flag" with the value .FALSE., again the routine */ -/* GDPOOL should be used. */ - -/* $ Examples */ - -/* 1) When the kernel variable */ - -/* BODY399_RADII */ - -/* is present in the kernel pool---normally because a PCK */ -/* defining this variable has been loaded---the call */ - -/* CALL BODVRD ( 'EARTH', 'RADII', 3, DIM, VALUES ) */ - -/* returns the dimension and values associated with the variable */ -/* 'BODY399_RADII', for example, */ - -/* DIM = 3 */ -/* VALUES(1) = 6378.140 */ -/* VALUES(2) = 6378.140 */ -/* VALUES(3) = 6356.755 */ - - -/* 2) The call */ - -/* CALL BODVRD ( 'earth', 'RADII', 3, DIM, VALUES ) */ - -/* will produce the same results shown in example (1), */ -/* since the case of the input argument BODYNM is */ -/* not significant. */ - - -/* 3) The call */ - -/* CALL BODVRD ( '399', 'RADII', 3, DIM, VALUES ) */ - -/* will produce the same results shown in example (1), */ -/* since strings containing integer codes are accepted */ -/* by this routine. */ - - -/* 4) The call */ - -/* CALL BODVRD ( 'EARTH', 'radii', 3, DIM, VALUES ) */ - -/* usually will cause a SPICE(KERNELVARNOTFOUND) error to be */ -/* signaled, because this call will attempt to look up the */ -/* values associated with a kernel variable of the name */ - -/* 'BODY399_radii' */ - -/* Since kernel variable names are case sensitive, this */ -/* name is not considered to match the name */ - -/* 'BODY399_RADII' */ - -/* which normally would be present after a text PCK */ -/* containing data for all planets and satellites has */ -/* been loaded. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to use BODS2C. */ - -/* - SPICELIB Version 1.0.0, 23-FEB-2004 (NJB) (BVS) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch constants for a body from the kernel pool */ -/* physical constants for a body */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to use BODS2C. This simplifies the name-to-ID */ -/* mapping code. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BODVRD", (ftnlen)6); - } - -/* Translate the input name to an ID code. */ - - bods2c_(bodynm, &bodyid, &found, bodynm_len); - if (! found) { - setmsg_("The body name # could not be translated to a NAIF ID code. " - " The cause of this problem may be that you need an updated v" - "ersion of the SPICE Toolkit.", (ftnlen)147); - errch_("#", bodynm, (ftnlen)1, bodynm_len); - sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20); - chkout_("BODVRD", (ftnlen)6); - return 0; - } - -/* Construct the variable name from BODY and ITEM. */ - - s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4); - intstr_(&bodyid, code, (ftnlen)16); - suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32); - suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32); - suffix_(item, &c__0, varnam, item_len, (ftnlen)32); - -/* Make sure the item is present in the kernel pool. */ - - dtpool_(varnam, &found, dim, type__, (ftnlen)32, (ftnlen)1); - if (! found) { - setmsg_("The variable # could not be found in the kernel pool.", ( - ftnlen)53); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("BODVRD", (ftnlen)6); - return 0; - } - -/* Make sure the item's data type is numeric. */ - - if (*(unsigned char *)type__ != 'N') { - setmsg_("The data associated with variable # are not of numeric type." - , (ftnlen)60); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("BODVRD", (ftnlen)6); - return 0; - } - -/* Make sure there's enough room in the array VALUES to hold */ -/* the requested data. */ - - if (*maxn < *dim) { - setmsg_("The data array associated with variable # has dimension #, " - "which is larger than the available space # in the output arr" - "ay.", (ftnlen)122); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - errint_("#", dim, (ftnlen)1); - errint_("#", maxn, (ftnlen)1); - sigerr_("SPICE(ARRAYTOOSMALL)", (ftnlen)20); - chkout_("BODVRD", (ftnlen)6); - return 0; - } - -/* Grab the values. We know at this point they're present in */ -/* the kernel pool, so we don't check the FOUND flag. */ - - gdpool_(varnam, &c__1, maxn, dim, values, &found, (ftnlen)32); - chkout_("BODVRD", (ftnlen)6); - return 0; -} /* bodvrd_ */ - diff --git a/ext/spice/src/cspice/bodvrd_c.c b/ext/spice/src/cspice/bodvrd_c.c deleted file mode 100644 index 4aa101c71c..0000000000 --- a/ext/spice/src/cspice/bodvrd_c.c +++ /dev/null @@ -1,299 +0,0 @@ -/* - --Procedure bodvrd_c ( Return d.p. values from the kernel pool ) - --Abstract - - Fetch from the kernel pool the double precision values - of an item associated with a body. - --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 - - KERNEL - NAIF_IDS - --Keywords - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void bodvrd_c ( ConstSpiceChar * bodynm, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim, - SpiceDouble * values ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - bodynm I Body name. - item I Item for which values are desired. ("RADII", - "NUT_PREC_ANGLES", etc. ) - maxn I Maximum number of values that may be returned. - dim O Number of values returned. - values O Values. - --Detailed_Input - - bodynm is the name of the body for which `item' is requested. - `bodynm' is case-insensitive, and leading and trailing - blanks in `bodynm' are not significant. Optionally, you - may supply the integer ID code for the object as an - integer string. For example both "MOON" and "301" are - legitimate strings that indicate the moon is the body - of interest. - - item is the item to be returned. Together, the NAIF ID - code of the body and the item name combine to form a - kernel variable name, e.g., - - "BODY599_RADII" - "BODY401_POLE_RA" - - The values associated with the kernel variable having - the name constructed as shown are sought. Below - we'll take the shortcut of calling this kernel variable - the "requested kernel variable." - - Note that `item' *is* case-sensitive. This attribute - is inherited from the case-sensitivity of kernel - variable names. - - maxn is the maximum number of values that may be returned. - The output array `values' must be declared with size at - least `maxn'. It's an error to supply an output array - that is too small to hold all of the values associated - with the requested kernel variable. - --Detailed_Output - - dim is the number of values returned; this is always the - number of values associated with the requested kernel - variable unless an error has been signaled. - - values is the array of values associated with the requested - kernel variable. If `values' is too small to hold all - of the values associated with the kernel variable, the - returned values of `dim' and `values' are undefined. - --Parameters - - None. - --Exceptions - - 1) If the input body name cannot be translated to an ID code, - and if the name is not a string representation of an integer - (for example, "399"), the error SPICE(NOTRANSLATION) is - signaled. - - 2) If the requested kernel variable is not found in the kernel - pool, the error SPICE(KERNELVARNOTFOUND) is signaled. - - 3) If the requested kernel variable is found but the associated - values aren't numeric, the error SPICE(TYPEMISMATCH) is - signaled. - - 4) The output array `values' must be declared with sufficient size - to contain all of the values associated with the requested kernel - variable. If the dimension of `values' indicated by `maxn' is - too small to contain the requested values, the error - SPICE(ARRAYTOOSMALL) is signaled. - - 5) If the input dimension `maxn' indicates there is more room - in `values' than there really is---for example, if `maxn' is - 10 but `values' is declared with dimension 5---and the dimension - of the requested kernel variable is larger than the actual - dimension of `values', then this routine may overwrite - memory. The results are unpredictable. - - 6) If either of the input string pointers `bodynm' or `item' - are null, the error SPICE(NULLPOINTER) will be signaled. - - 7) If either of the input strings referred to by `bodynm' or `item' - contain no data characters, the error SPICE(EMPTYSTRING) will - be signaled. - --Files - - None. - --Particulars - - This routine simplifies looking up PCK kernel variables by - constructing names of requested kernel variables and by performing - error checking. - - This routine is intended for use in cases where the maximum number - of values that may be returned is known at compile time. The caller - fetches all of the values associated with the specified kernel - variable via a single call to this routine. If the number of values - to be fetched cannot be known until run time, the lower-level - routine gdpool_c should be used instead. gdpool_c supports fetching - arbitrary amounts of data in multiple "chunks." - - This routine is intended for use in cases where the requested kernel - variable is expected to be present in the kernel pool. If the - variable is not found or has the wrong data type, this routine - signals an error. In cases where it is appropriate to indicate - absence of an expected kernel variable by returning a boolean "found - flag" with the value SPICEFALSE, again the routine gdpool_c should - be used. - --Examples - - 1) When the kernel variable - - BODY399_RADII - - is present in the kernel pool---normally because a PCK - defining this variable has been loaded---the call - - bodvrd_c ( "EARTH", "RADII", 3, &dim, values ); - - returns the dimension and values associated with the variable - "BODY399_RADII", for example, - - dim == 3 - value[0] == 6378.140 - value[1] == 6378.140 - value[2] == 6356.755 - - - 2) The call - - bodvrd_c ( "earth", "RADII", 3, &dim, values ); - - will produce the same results shown in example (1), - since the case of the input argument `bodynm' is - not significant. - - - 3) The call - - bodvrd_c ( "399", "RADII", 3, &dim, values ); - - will produce the same results shown in example (1), - since strings containing integer codes are accepted - by this routine. - - - 4) The call - - bodvrd_c ( "EARTH", "radii", 3, &dim, values ); - - usually will cause a SPICE(KERNELVARNOTFOUND) error to be - signaled, because this call will attempt to look up the - values associated with a kernel variable of the name - - "BODY399_radii" - - Since kernel variable names are case sensitive, this - name is not considered to match the name - - "BODY399_RADII" - - which normally would be present after a text PCK - containing data for all planets and satellites has - been loaded. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 12-APR-2006 (NJB) - - Header fix: output argument `dim' is now preceded by - an ampersand in example calls to bodvrd_c.c. - - -CSPICE Version 1.0.0, 22-FEB-2004 (NJB) - --Index_Entries - - fetch constants for a body from the kernel pool - physical constants for a body - --& -*/ - -{ /* Begin bodvrd_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "bodvrd_c" ); - - - /* - Check the input strings. - */ - CHKFSTR ( CHK_STANDARD, "bodvrd_c", bodynm ); - CHKFSTR ( CHK_STANDARD, "bodvrd_c", item ); - - - /* - Call the f2c'd SPICELIB function. - */ - bodvrd_ ( (char *) bodynm, - (char *) item, - (integer *) &maxn, - (integer *) dim, - (doublereal *) values, - (ftnlen ) strlen(bodynm), - (ftnlen ) strlen(item) ); - - chkout_c ( "bodvrd_c" ); - -} /* End bodvrd_c */ diff --git a/ext/spice/src/cspice/brcktd.c b/ext/spice/src/cspice/brcktd.c deleted file mode 100644 index 77fadb34a5..0000000000 --- a/ext/spice/src/cspice/brcktd.c +++ /dev/null @@ -1,174 +0,0 @@ -/* brcktd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BRCKTD (Bracket a double precision value within an interval) */ -doublereal brcktd_(doublereal *number, doublereal *end1, doublereal *end2) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - -/* $ Abstract */ - -/* Bracket a number. That is, given a number and an acceptable */ -/* interval, make sure that the number is contained in the */ -/* interval. (If the number is already in the interval, leave it */ -/* alone. If not, set it to the nearest endpoint of the interval.) */ - -/* $ 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 */ - -/* INTERVALS, NUMBERS, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Number to be bracketed. */ -/* END1 I One of the bracketing endpoints for NUMBER. */ -/* END2 I The other bracketing endpoint for NUMBER. */ -/* BRCKTD O Bracketed number. */ - -/* $ Detailed_Input */ - -/* NUMBER is the number to be bracketed. That is, the */ -/* value of NUMBER is constrained to lie in the */ -/* interval bounded by END1 and END2. */ - -/* END1, */ -/* END2 are the lower and upper bounds for NUMBER. The */ -/* order is not important. */ - -/* $ Detailed_Output */ - -/* BRCKTD is NUMBER, if it was already in the interval */ -/* provided. Otherwise it is the value of the nearest */ -/* bound of the interval. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a shorthand notation for code fragments */ -/* like the following */ - -/* IF ( NUMBER .LT. END1 ) THEN */ -/* NUMBER = END1 */ -/* ELSE IF ( NUMBER .GT. END2 ) THEN */ -/* NUMBER = END2 */ -/* END IF */ - -/* which occur frequently during the processing of program inputs. */ - -/* $ Examples */ - -/* The following illustrate the operation of BRCKTD. */ - -/* BRCKTD ( -1.D0, 1.D0, 10.D0 ) = 1.D0 */ -/* BRCKTD ( 29.D0, 1.D0, 10.D0 ) = 10.D0 */ -/* BRCKTD ( 3.D0, -10.D0, 10.D0 ) = 3.D0 */ -/* BRCKTD ( 3.D0, -10.D0, -1.D0 ) = -1.D0 */ - -/* The following code fragment illustrates a typical use for BRCKTD. */ - -/* C */ -/* C Star magnitude limit must be in the range 0-10. */ -/* C */ -/* READ (5,*) MAGLIM */ -/* MAGLIM = BRCKTD ( MAGLIM, 0.D0, 10.D0 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* bracket a d.p. value within an interval */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 30-DEC-1988 (WLT) */ - -/* The routine was modified so that the order of the endpoints */ -/* of the bracketing interval is not needed. The routine now */ -/* determines which is the left endpoint and which is the */ -/* right and acts appropriately. */ - -/* -& */ - -/* What else is there to say? */ - - if (*end1 < *end2) { -/* Computing MAX */ - d__1 = *end1, d__2 = min(*end2,*number); - ret_val = max(d__1,d__2); - } else { -/* Computing MAX */ - d__1 = *end2, d__2 = min(*end1,*number); - ret_val = max(d__1,d__2); - } - return ret_val; -} /* brcktd_ */ - diff --git a/ext/spice/src/cspice/brcktd_c.c b/ext/spice/src/cspice/brcktd_c.c deleted file mode 100644 index 8fade57214..0000000000 --- a/ext/spice/src/cspice/brcktd_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure brcktd_c (Bracket a d.p. value within an interval) - --Abstract - - Bracket a number. That is, given a number and an acceptable - interval, make sure that the number is contained in the - interval. (If the number is already in the interval, leave it - alone. If not, set it to the nearest endpoint of the interval.) - --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 - - None. - -*/ - - #include "SpiceUsr.h" - - - SpiceDouble brcktd_c ( SpiceDouble number, - SpiceDouble end1, - SpiceDouble end2 ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - number I Number to be bracketed. - end1 I One of the bracketing endpoints for number. - end2 I The other bracketing endpoint for number. - - The function returns the bracketed number. - --Detailed_Input - - number is the number to be bracketed. That is, the - value of number is constrained to lie in the - interval bounded by end1 and end2. - - end1, - end2 are the lower and upper bounds for number. The - order is not important. - --Detailed_Output - - The function returnes the input number, if it was already in the - interval provided. Otherwise the returned value is the nearest - bound of the interval. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This routine provides a shorthand notation for code fragments - like the following - - #include "SpiceUsr.h" - . - . - . - if ( number < end 1 ) - { - number = end1; - } - else if ( number > end2 ) - { - number = end2; - } - - - which occur frequently during the processing of program inputs. - --Examples - - The following illustrates the operation of brcktd_c. - - brcktd_c ( -1., 1., 10. ) = 1. - brcktd_c ( 29., 1., 10. ) = 10. - brcktd_c ( 3., -10., 10. ) = 3. - brcktd_c ( 3., -10., -1. ) = -1. - - The following code fragment illustrates a typical use for brcktd_c. - - #include "SpiceUsr.h" - . - . - . - /. - Star magnitude limit must be in the range 0-10. - ./ - - prompt_c ( "Enter magnitude limit > ", 25, magLimStr ); - - prsdp_c ( magLimStr, &maglim ); - - maglim = brcktd_c ( maglim, 0., 10. ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added "None." text to Keywords section, required for - API doc script (cspicehtml.pl) integrity checks. - - -CSPICE Version 1.0.0, 16-AUG-1999 (NJB) (WLT) (IMU) - --Index_Entries - - bracket a d.p. value within an interval - --& -*/ - -{ /* Begin brcktd_c */ - - if ( number < end1 ) - { - return ( end1 ); - } - else if ( number > end2 ) - { - return ( end2 ); - } - - return ( number ); - -} /* End brcktd_c */ diff --git a/ext/spice/src/cspice/brckti.c b/ext/spice/src/cspice/brckti.c deleted file mode 100644 index 493577093c..0000000000 --- a/ext/spice/src/cspice/brckti.c +++ /dev/null @@ -1,174 +0,0 @@ -/* brckti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BRCKTI ( Bracket an integer value within an interval. ) */ -integer brckti_(integer *number, integer *end1, integer *end2) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - -/* $ Abstract */ - -/* Bracket a number. That is, given a number and an acceptable */ -/* interval, make sure that the number is contained in the */ -/* interval. (If the number is already in the interval, leave it */ -/* alone. If not, set it to the nearest endpoint of the interval.) */ - -/* $ 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 */ - -/* INTERVALS, NUMBERS, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Number to be bracketed. */ -/* END1 I One of the bracketing endpoints for NUMBER. */ -/* END2 I The other bracketing endpoint for NUMBER. */ -/* BRCKTI O Bracketed number. */ - -/* $ Detailed_Input */ - -/* NUMBER is the number to be bracketed. That is, the */ -/* value of NUMBER is constrained to lie in the */ -/* interval bounded bye END1 and END2. */ - -/* END1, */ -/* END2 are the lower and upper bounds for NUMBER. The */ -/* order is not important. */ - -/* $ Detailed_Output */ - -/* BRCKTI is NUMBER, if it was already in the interval */ -/* provided. Otherwise it is the value of the nearest */ -/* bound of the interval. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a shorthand notation for code fragments */ -/* like the following */ - -/* IF ( NUMBER .LT. END1 ) THEN */ -/* NUMBER = END1 */ -/* ELSE IF ( NUMBER .GT. END2 ) THEN */ -/* NUMBER = END2 */ -/* END IF */ - -/* which occur frequently during the processing of program inputs. */ - -/* $ Examples */ - -/* The following illustrate the operation of BRCKTI. */ - -/* BRCKTI ( -1, 1, 10 ) = 1 */ -/* BRCKTI ( 29, 1, 10 ) = 10 */ -/* BRCKTI ( 3, -10, 10 ) = 3 */ -/* BRCKTI ( 3, -10, -1 ) = -1 */ - -/* The following code fragment illustrates a typical use for BRCKTI. */ - -/* C */ -/* C Object code must be in the range 701-705. */ -/* C */ -/* READ (5,*) CODE */ -/* CODE = BRCKTI ( CODE, 701, 705 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* bracket an integer value within an interval */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 30-DEC-1988 (WLT) */ - -/* The routine was modified so that the order of the endpoints */ -/* of the bracketing interval is not needed. The routine now */ -/* determines which is the left endpoint and which is the */ -/* right and acts appropriately. */ - -/* -& */ - -/* What else is there to say? */ - - if (*end1 < *end2) { -/* Computing MAX */ - i__1 = *end1, i__2 = min(*end2,*number); - ret_val = max(i__1,i__2); - } else { -/* Computing MAX */ - i__1 = *end2, i__2 = min(*end1,*number); - ret_val = max(i__1,i__2); - } - return ret_val; -} /* brckti_ */ - diff --git a/ext/spice/src/cspice/brckti_c.c b/ext/spice/src/cspice/brckti_c.c deleted file mode 100644 index 1f8c49dca4..0000000000 --- a/ext/spice/src/cspice/brckti_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure brckti_c (Bracket an integer value within an interval) - --Abstract - - Bracket a number. That is, given a number and an acceptable - interval, make sure that the number is contained in the - interval. (If the number is already in the interval, leave it - alone. If not, set it to the nearest endpoint of the interval.) - --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 - - None. - -*/ - - #include "SpiceUsr.h" - - - SpiceInt brckti_c ( SpiceInt number, - SpiceInt end1, - SpiceInt end2 ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - number I Number to be bracketed. - end1 I One of the bracketing endpoints for number. - end2 I The other bracketing endpoint for number. - - The function returns the bracketed number. - --Detailed_Input - - number is the number to be bracketed. That is, the - value of number is constrained to lie in the - interval bounded by end1 and end2. - - end1, - end2 are the lower and upper bounds for number. The - order is not important. - --Detailed_Output - - The function returnes the input number, if it was already in the - interval provided. Otherwise the returned value is the nearest - bound of the interval. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This routine provides a shorthand notation for code fragments - like the following - - #include "SpiceUsr.h" - . - . - . - if ( number < end 1 ) - { - number = end1; - } - else if ( number > end2 ) - { - number = end2; - } - - - which occur frequently during the processing of program inputs. - --Examples - - The following illustrates the operation of brckti_c. - - brckti_c ( -1, 1, 10 ) = 1.0; - brckti_c ( 29, 1, 10 ) = 10.0; - brckti_c ( 3, -10, 10 ) = 3.0; - brckti_c ( 3, -10, -1 ) = -1.0; - - The following code fragment illustrates a typical use for brckti_c. - - #include "SpiceUsr.h" - . - . - . - /. - Number of time steps must be in the range 1-10. - ./ - - prompt_c ( "Enter number of time steps > ", 80, nStr ); - - prsint_c ( nStr, &n ); - - nstep = brckti_c ( n, 1, 10 ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added "None." text to Keywords section, required for - API doc script (cspicehtml.pl) integrity checks. - - -CSPICE Version 1.0.0, 16-AUG-1999 (NJB) (WLT) (IMU) - --Index_Entries - - bracket an integer value within an interval - --& -*/ - -{ /* Begin brckti_c */ - - if ( number < end1 ) - { - return ( end1 ); - } - else if ( number > end2 ) - { - return ( end2 ); - } - - return ( number ); - -} /* End brckti_c */ diff --git a/ext/spice/src/cspice/bschoc.c b/ext/spice/src/cspice/bschoc.c deleted file mode 100644 index 488814f9c3..0000000000 --- a/ext/spice/src/cspice/bschoc.c +++ /dev/null @@ -1,205 +0,0 @@ -/* bschoc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BSCHOC ( Binary search with order vector, character ) */ -integer bschoc_(char *value, integer *ndim, char *array, integer *order, - ftnlen value_len, ftnlen array_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer left, i__, right; - -/* $ Abstract */ - -/* Do a binary search for a given value within a character array, */ -/* accompanied by an order vector. Return the index of the */ -/* matching array entry, or zero if the key value is not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Value to find in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Array to be searched. */ -/* ORDER I Order vector. */ -/* BSCHOC O Index of VALUE in ARRAY. (Zero if not found.) */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be found in the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY is the array to be searched. */ - - -/* ORDER is an order array that can be used to access */ -/* the elements of ARRAY in order (according to the */ -/* ASCII collating sequence). */ - -/* $ Detailed_Output */ - -/* BSCHOC is the index of the input value in the input array. */ -/* If ARRAY does not contain VALUE, BSCHOC is zero. */ - -/* If ARRAY contains more than one occurrence of VALUE, */ -/* BSCHOC may point to any of the occurrences. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If NDIM < 1 the value of the function is zero. */ - -/* $ Particulars */ - -/* A binary search is implemented on the input array, whose order */ -/* is given by an associated order vector. If an element of the */ -/* array is found to match the input value, the index of that */ -/* element is returned. If no matching element is found, zero is */ -/* returned. */ - -/* $ Examples */ - -/* Let ARRAY and ORDER contain the following elements: */ - -/* ARRAY ORDER */ -/* ----------- ----- */ -/* 'FEYNMAN' 2 */ -/* 'BOHR' 3 */ -/* 'EINSTEIN' 1 */ -/* 'NEWTON' 5 */ -/* 'GALILEO' 4 */ - -/* Then */ - -/* BSCHOC ( 'NEWTON', 5, ARRAY, ORDER ) = 4 */ -/* BSCHOC ( 'EINSTEIN', 5, ARRAY, ORDER ) = 3 */ -/* BSCHOC ( 'GALILEO', 5, ARRAY, ORDER ) = 5 */ -/* BSCHOC ( 'Galileo', 5, ARRAY, ORDER ) = 0 */ -/* BSCHOC ( 'BETHE', 5, ARRAY, ORDER ) = 0 */ - -/* That is */ - -/* ARRAY(4) = 'NEWTON' */ -/* ARRAY(3) = 'EINSTEIN' */ -/* ARRAY(5) = 'GALILEO' */ - -/* (Compare with BSCHOC_2.) */ - -/* $ Restrictions */ - -/* ORDER is assumed to give the order of the elements of ARRAY */ -/* in increasing order according to the ASCII collating sequence. */ -/* If this condition is not met, the results of BSCHOC are */ -/* unpredictable. */ - -/* $ Author_and_Institution */ - -/* I. M. Underwood */ -/* W. L. Taber */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary search for a string using an order vector */ - -/* -& */ - -/* Local variables */ - - -/* Set the initial bounds for the search area. */ - - left = 1; - right = *ndim; - while(left <= right) { - -/* Check the middle element. */ - - i__ = (left + right) / 2; - -/* If the middle element matches, return its location. */ - - if (s_cmp(value, array + (order[i__ - 1] - 1) * array_len, value_len, - array_len) == 0) { - ret_val = order[i__ - 1]; - return ret_val; - -/* Otherwise narrow the search area. */ - - } else if (l_lt(value, array + (order[i__ - 1] - 1) * array_len, - value_len, array_len)) { - right = i__ - 1; - } else { - left = i__ + 1; - } - } - -/* If the search area is empty, return zero. */ - - ret_val = 0; - return ret_val; -} /* bschoc_ */ - diff --git a/ext/spice/src/cspice/bschoc_c.c b/ext/spice/src/cspice/bschoc_c.c deleted file mode 100644 index 11a97bd3a6..0000000000 --- a/ext/spice/src/cspice/bschoc_c.c +++ /dev/null @@ -1,317 +0,0 @@ -/* - --Procedure bschoc_c ( Binary search with order vector, character ) - --Abstract - - Do a binary search for a given value within a character string array, - accompanied by an order vector. Return the index of the matching array - entry, or -1 if the key value is not found. - --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 - - ARRAY, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #include "f2cMang.h" - #undef bschoc_c - - - SpiceInt bschoc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array, - ConstSpiceInt * order ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Key value to be found in array. - ndim I Dimension of array. - lenvals I String length. - array I Character string array to search. - order I Order vector. - - The function returns the index of the first matching array - element or -1 if the value is not found. - --Detailed_Input - - value is the key value to be found in the array. Trailing - blanks space in this key are not significant: string - matches found by this routine do not require trailing - blanks in value to match those in the corresponding - element of array. - - ndim 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 - - [ndim][lenvals] - - array is the array of character srings to be searched. Trailing - blanks in the strings in this array are not significant. - - order is an order vector which can be used to access the elements - of array in order. The contents of order are a permutation - of the sequence of integers ranging from zero to ndim-1. - --Detailed_Output - - The function returns the index of the specified value in the input array. - Indices range from zero to ndim-1. - - If the input array does not contain the specified value, the function - returns -1. - - If the input array contains more than one occurrence of the specified - value, the returned index may point to any of the occurrences. - --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. - - 6) If memory cannot be allocated to create a Fortran-style version of - the input order vector, the error SPICE(MALLOCFAILED) is signaled. - The function returns -1 in this case. - --Files - - None. - --Particulars - - A binary search is performed on the input array, whose order is given - by an associated order vector. If an element of the array is found to - match the input value, the index of that element is returned. If no - matching element is found, -1 is returned. - --Examples - - Let the input arguments array and order contain the following elements: - - array order - - "FEYNMAN" 1 - "BOHR" 2 - "EINSTEIN" 0 - "NEWTON" 4 - "GALILEO" 3 - - Then - - bschoc_c ( "NEWTON", 5, lenvals, array, order ) == 3 - bschoc_c ( "EINSTEIN", 5, lenvals, array, order ) == 2 - bschoc_c ( "GALILEO", 5, lenvals, array, order ) == 4 - bschoc_c ( "Galileo", 5, lenvals, array, order ) == -1 - bschoc_c ( "BETHE", 5, lenvals, array, order ) == -1 - --Restrictions - - 1) The input array is assumed to be sorted in increasing order. If - this condition is not met, the results of bschoc_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) - W.L. Taber (JPL) - I.M. Underwood (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. - - Header sections were re-ordered. - - -CSPICE Version 1.0.0, 26-AUG-2002 (NJB) (WLT) (IMU) - --Index_Entries - - search in a character array - --& -*/ - -{ /* Begin bschoc_c */ - - - /* - f2c library utility prototypes - */ - logical l_lt (char *a, char *b, ftnlen la, ftnlen lb ); - extern integer s_cmp (char *a, char *b, ftnlen la, ftnlen lb ); - - /* - Local macros - */ - #define ARR_ORD( i ) ( ( (SpiceChar *)array ) + order[(i)]*lenvals ) - - - /* - Local variables - */ - SpiceInt i; - SpiceInt keylen; - SpiceInt left; - SpiceInt lexord; - SpiceInt right; - - - /* - Use discovery check-in. - - Return immediately if the array dimension is non-positive. - */ - if ( ndim < 1 ) - { - return ( -1 ); - } - - - /* - Make sure the pointer for the key value is non-null - and that the length is adequate. - */ - CHKPTR_VAL ( CHK_DISCOVER, "bschoc_c", value, -1 ); - - - /* - Make sure the pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR_VAL ( CHK_DISCOVER, "bschoc_c", array, lenvals, -1 ); - - - /* - Do a binary search for the specified key value. - */ - keylen = strlen(value); - - left = 0; - right = ndim - 1; - - while ( left <= right ) - { - /* - Check the middle element. - */ - i = ( left + right ) / 2; - - /* - The f2c library function s_cmp performs a Fortran-style - lexical order comparison. A negative return value indicates - the first argument is less than the second, a return value - of zero indicates equality, and a positive value indicates - the second argument is greater. - */ - lexord = (SpiceInt) s_cmp ( (char * ) value, - (char * ) ARR_ORD(i), - (ftnlen ) keylen, - (ftnlen ) strlen(ARR_ORD(i)) ); - - /* - If the middle element matches, return its location. - */ - if ( lexord == 0 ) - { - return ( order[i] ); - } - - /* - Otherwise, narrow the search area. - */ - else if ( lexord < 0 ) - { - /* - value is less than the middle element. - */ - right = i - 1; - } - - else - { - left = i + 1; - } - - } - - /* - If the search area is empty, indicate the value was not found. - */ - return ( -1 ); - - - -} /* End bschoc_c */ diff --git a/ext/spice/src/cspice/bschoi.c b/ext/spice/src/cspice/bschoi.c deleted file mode 100644 index 343b5dd361..0000000000 --- a/ext/spice/src/cspice/bschoi.c +++ /dev/null @@ -1,196 +0,0 @@ -/* bschoi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BSCHOI ( Binary search with order vector, integer ) */ -integer bschoi_(integer *value, integer *ndim, integer *array, integer *order) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer left, i__, right; - -/* $ Abstract */ - -/* Do a binary search for a given value within an integer array, */ -/* accompanied by an order vector. Return the index of the */ -/* matching array entry, or zero if the key value is not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Value to find in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Array to be searched. */ -/* ORDER I Order vector. */ -/* BSCHOI O Index of VALUE in ARRAY. (Zero if not found.) */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be found in the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY is the array to be searched. */ - - -/* ORDER is an order array that can be used to access */ -/* the elements of ARRAY in order. */ - -/* $ Detailed_Output */ - -/* BSCHOI is the index of the input value in the input array. */ -/* If ARRAY does not contain VALUE, BSCHOI is zero. */ - -/* If ARRAY contains more than one occurrence of VALUE, */ -/* BSCHOI may point to any of the occurrences. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the value of the function is zero. */ - -/* $ Particulars */ - -/* A binary search is implemented on the input array, whose order */ -/* is given by an associated order vector. If an element of the */ -/* array is found to match the input value, the index of that */ -/* element is returned. If no matching element is found, zero is */ -/* returned. */ - -/* $ Examples */ - -/* Let ARRAY and ORDER contain the following elements: */ - -/* ARRAY ORDER */ -/* ----------- ----- */ -/* 100 2 */ -/* 1 3 */ -/* 10 1 */ -/* 10000 5 */ -/* 1000 4 */ - -/* Then */ - -/* BSCHOI ( 1000, 5, ARRAY, ORDER ) = 5 */ -/* BSCHOI ( 1, 5, ARRAY, ORDER ) = 2 */ -/* BSCHOI ( 10000, 5, ARRAY, ORDER ) = 4 */ -/* BSCHOI ( -1, 5, ARRAY, ORDER ) = 0 */ -/* BSCHOI ( 17, 5, ARRAY, ORDER ) = 0 */ - -/* That is, */ - -/* ARRAY(5) = 1000 */ -/* ARRAY(2) = 1 */ -/* ARRAY(4) = 10000 */ - -/* (Compare with BSCHOI_2.) */ - -/* $ Restrictions */ - -/* ORDER is assumed to give the order of the elements of ARRAY */ -/* in increasing order. If this condition is not met, the results */ -/* of BSCHOI are unpredictable. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary search for an integer using an order vector */ - -/* -& */ - -/* Local variables */ - - -/* Set the initial bounds for the search area. */ - - left = 1; - right = *ndim; - while(left <= right) { - -/* Check the middle element. */ - - i__ = (left + right) / 2; - -/* If the middle element matches, return its location. */ - - if (*value == array[order[i__ - 1] - 1]) { - ret_val = order[i__ - 1]; - return ret_val; - -/* Otherwise narrow the search area. */ - - } else if (*value < array[order[i__ - 1] - 1]) { - right = i__ - 1; - } else { - left = i__ + 1; - } - } - -/* If the search area is empty, return zero. */ - - ret_val = 0; - return ret_val; -} /* bschoi_ */ - diff --git a/ext/spice/src/cspice/bschoi_c.c b/ext/spice/src/cspice/bschoi_c.c deleted file mode 100644 index f9b2a8e770..0000000000 --- a/ext/spice/src/cspice/bschoi_c.c +++ /dev/null @@ -1,231 +0,0 @@ -/* - --Procedure bschoi_c ( Binary search with order vector, integer ) - --Abstract - - Do a binary search for a given value within an integer array, - accompanied by an order vector. Return the index of the - matching array entry, or -1 if the key value is not found. - --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 - - ARRAY, SEARCH - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef bschoi_c - - - SpiceInt bschoi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array, - ConstSpiceInt * order ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Value to find in array. - ndim I Dimension of array. - array I Array to be searched. - order I Order vector. - - The function returns the index of value in array, or -1 if the value - is not found. - --Detailed_Input - - value is the value to be found in the input array. - - ndim is the number of elements in the input array. - - array is the array to be searched. - - order is an order vector which can be used to access the elements - of array in order. The contents of order are a permutation - of the sequence of integers ranging from zero to ndim-1. - --Detailed_Output - - The function returns the index of the input value in the input array. - Indices range from zero to ndim-1. - - If the input array does not contain the specified value, the function - returns -1. - - If the input array contains more than one occurrence of the specified - value, the returned index may point to any of the occurrences. - --Parameters - - None. - --Exceptions - - - 1) If memory cannot be allocated to create a Fortran-style version of - the input order vector, the error SPICE(MALLOCFAILED) is signaled. - The function returns -1 in this case. - - 2) If ndim < 1 the value of the function is -1. This is not an error. - --Files - - None. - --Particulars - - A binary search is performed on the input array, whose order is given - by an associated order vector. If an element of the array is found to - match the input value, the index of that element is returned. If no - matching element is found, -1 is returned. - --Examples - - Let array and order contain the following elements: - - array order - ----------- ----- - 100 1 - 1 2 - 10 0 - 10000 4 - 1000 3 - - Then - - bschoi_c ( 1000, 5, array, order ) == 4 - bschoi_c ( 1, 5, array, order ) == 1 - bschoi_c ( 10000, 5, array, order ) == 3 - bschoi_c ( -1, 5, array, order ) == -1 - bschoi_c ( 17, 5, array, order ) == -1 - - That is, - - array[4] == 1000 - array[1] == 1 - array[3] == 10000 - --Restrictions - - The input order vector is assumed give the order of the elements of the - input array in increasing order. If this condition is not met, the - results of bschoi_c are unpredictable. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) (IMU) - --Index_Entries - - binary search for an integer value - --& -*/ - -{ /* Begin bschoi_c */ - - - /* - Local variables - */ - SpiceInt i ; - SpiceInt loc ; - SpiceInt * ordvec; - SpiceInt vSize; - - - - /* - Use discovery check-in. - - Return immediately if the array dimension is non-positive. - */ - if ( ndim < 1 ) - { - return ( -1 ); - } - - - /* - Get a local copy of the input order vector; map the vector's contents - to the range 1:ndim. - */ - vSize = ndim * sizeof(SpiceInt); - - ordvec = (SpiceInt *) malloc( vSize ); - - if ( ordvec == 0 ) - { - chkin_c ( "bschoi_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", vSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "bschoi_c" ); - - return ( -1 ); - } - - for ( i = 0; i < ndim; i++ ) - { - ordvec[i] = order[i] + 1; - } - - loc = bschoi_ ( (integer *) &value, - (integer *) &ndim, - (integer *) array, - (integer *) ordvec ) - 1; - - free ( ordvec ); - - return ( loc ); - - -} /* End bschoi_c */ diff --git a/ext/spice/src/cspice/bsrchc.c b/ext/spice/src/cspice/bsrchc.c deleted file mode 100644 index 52a2551ac6..0000000000 --- a/ext/spice/src/cspice/bsrchc.c +++ /dev/null @@ -1,201 +0,0 @@ -/* bsrchc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BSRCHC ( Binary search for a character string ) */ -integer bsrchc_(char *value, integer *ndim, char *array, ftnlen value_len, - ftnlen array_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer left, i__, right; - -/* $ Abstract */ - -/* Do a binary search for a given value within a character array, */ -/* assumed to be in increasing order. Return the index of the */ -/* matching array entry, or zero if the key value is not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Value to find in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Array to be searched. */ -/* BSRCHC O Index of VALUE in ARRAY. (Zero if not found.) */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be found in the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY is the array to be searched. The elements in */ -/* ARRAY are assumed to sorted according to the */ -/* ASCII collating sequence. */ - -/* $ Detailed_Output */ - -/* BSRCHC is the index of the input value in the input array. */ -/* If ARRAY does not contain VALUE, BSRCHC is zero. */ - -/* If ARRAY contains more than one occurrence of VALUE, */ -/* BSRCHC may point to any of the occurrences. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A binary search is implemented on the input array. If an */ -/* element of the array is found to match the input value, the */ -/* index of that element is returned. If no matching element */ -/* is found, zero is returned. */ - - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* 'BOHR' */ -/* 'EINSTEIN' */ -/* 'FEYNMAN' */ -/* 'GALILEO' */ -/* 'NEWTON' */ - -/* Then */ - -/* BSRCHC ( 'NEWTON', 5, ARRAY ) = 5 */ -/* BSRCHC ( 'EINSTEIN', 5, ARRAY ) = 2 */ -/* BSRCHC ( 'GALILEO', 5, ARRAY ) = 4 */ -/* BSRCHC ( 'Galileo', 5, ARRAY ) = 0 */ -/* BSRCHC ( 'BETHE', 5, ARRAY ) = 0 */ - -/* $ Restrictions */ - -/* ARRAY is assumed to be sorted in increasing order according to */ -/* the ASCII collating sequence. If this condition is not met, */ -/* the results of BSRCHC are unpredictable. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If NDIM < 1 the value of the function is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary search for a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 8-JAN-1989 (IMU) */ - -/* Now works for all values of NDIM. */ - -/* -& */ - -/* Local variables */ - - -/* Set the initial bounds for the search area. */ - - left = 1; - right = *ndim; - while(left <= right) { - -/* Check the middle element. */ - - i__ = (left + right) / 2; - -/* If the middle element matches, return its location. */ - - if (s_cmp(value, array + (i__ - 1) * array_len, value_len, array_len) - == 0) { - ret_val = i__; - return ret_val; - -/* Otherwise narrow the search area. */ - - } else if (l_lt(value, array + (i__ - 1) * array_len, value_len, - array_len)) { - right = i__ - 1; - } else { - left = i__ + 1; - } - } - -/* If the search area is empty, return zero. */ - - ret_val = 0; - return ret_val; -} /* bsrchc_ */ - diff --git a/ext/spice/src/cspice/bsrchc_c.c b/ext/spice/src/cspice/bsrchc_c.c deleted file mode 100644 index 85c3190079..0000000000 --- a/ext/spice/src/cspice/bsrchc_c.c +++ /dev/null @@ -1,304 +0,0 @@ -/* - --Procedure bsrchc_c ( Binary search for a character string ) - --Abstract - - Do a binary earch for a given value within a character string array. - Return the index of the first matching array entry, or -1 if the key - value was not found. - --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 - - ARRAY, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "f2cMang.h" - #undef bsrchc_c - - - SpiceInt bsrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Key value to be found in array. - ndim I Dimension of array. - lenvals I String length. - array I Character string array to search. - - The function returns the index of the first matching array - element or -1 if the value is not found. - --Detailed_Input - - value is the key value to be found in the array. Trailing blanks - in this key are not significant: string matches found - by this routine do not require trailing blanks in - value to match that in the corresponding element of array. - - ndim 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 - - [ndim][lenvals] - - array is the array of character srings to be searched. Trailing - blanks in the strings in this array are not significant. - --Detailed_Output - - The function returns the index of the specified value in the input array. - Array indices range from zero to ndim-1. - - If the input array does not contain the specified value, the function - returns -1. - - If the input array contains more than one occurrence of the specified - value, the returned index may point to any of the occurrences. - --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 - - A binary search is performed on the input array. If an - element of the array is found to match the input value, the - index of that element is returned. If no matching element - is found, -1 is returned. - --Examples - - Let array be a character array of dimension - - [5][lenvals] - - which contains the following elements: - - "BOHR" - "EINSTEIN" - "FEYNMAN" - "GALILEO" - "NEWTON" - - Then - - bsrchc_c ( "NEWTON", 5, lenvals, array ) == 4 - bsrchc_c ( "EINSTEIN", 5, lenvals, array ) == 1 - bsrchc_c ( "GALILEO", 5, lenvals, array ) == 3 - bsrchc_c ( "Galileo", 5, lenvals, array ) == -1 - bsrchc_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) - W.M. Owen (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. - - Header sections were re-ordered. - - -CSPICE Version 1.0.0, 26-AUG-2002 (NJB) (WMO) - --Index_Entries - - search in a character array - --& -*/ - -{ /* Begin bsrchc_c */ - - /* - f2c library utility prototypes - */ - logical l_lt (char *a, char *b, ftnlen la, ftnlen lb ); - extern integer s_cmp (char *a, char *b, ftnlen la, ftnlen lb ); - - /* - Local macros - */ - #define ARRAY( i ) ( ( (SpiceChar *)array ) + (i)*lenvals ) - - - /* - Local variables - */ - SpiceInt i; - SpiceInt keylen; - SpiceInt left; - SpiceInt order; - SpiceInt right; - - - /* - Use discovery check-in. - - Return immediately if the array dimension is non-positive. - */ - if ( ndim < 1 ) - { - return ( -1 ); - } - - - /* - Make sure the pointer for the key value is non-null - and that the length is adequate. - */ - CHKPTR_VAL ( CHK_DISCOVER, "bsrchc_c", value, -1 ); - - - /* - Make sure the pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR_VAL ( CHK_DISCOVER, "bsrchc_c", array, lenvals, -1 ); - - - /* - Do a binary search for the specified key value. - */ - keylen = strlen(value); - - left = 0; - right = ndim - 1; - - while ( left <= right ) - { - /* - Check the middle element. - */ - i = ( left + right ) / 2; - - /* - The f2c library function s_cmp performs a Fortran-style - lexical order comparison. A negative return value indicates - the first argument is less than the second, a return value - of zero indicates equality, and a positive value indicates - the second argument is greater. - */ - order = (SpiceInt) s_cmp ( (char * ) value, - (char * ) ARRAY(i), - (ftnlen ) keylen, - (ftnlen ) strlen(ARRAY(i)) ); - - /* - If the middle element matches, return its location. - */ - if ( order == 0 ) - { - return ( i ); - } - - /* - Otherwise, narrow the search area. - */ - else if ( order < 0 ) - { - /* - value is less than the middle element. - */ - right = i - 1; - } - - else - { - left = i + 1; - } - - } - - /* - If the search area is empty, indicate the value was not found. - */ - return ( -1 ); - - -} /* End bsrchc_c */ - diff --git a/ext/spice/src/cspice/bsrchd.c b/ext/spice/src/cspice/bsrchd.c deleted file mode 100644 index ab49100def..0000000000 --- a/ext/spice/src/cspice/bsrchd.c +++ /dev/null @@ -1,189 +0,0 @@ -/* bsrchd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BSRCHD ( Binary search for double precision value ) */ -integer bsrchd_(doublereal *value, integer *ndim, doublereal *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer left, i__, right; - -/* $ Abstract */ - -/* Do a binary search for a given value within a DOUBLE PRECISION */ -/* array, assumed to be in increasing order. Return the index of */ -/* the matching array entry, or zero if the key value is not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Value to find in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Array to be searched. */ -/* BSRCHD O Index of VALUE in ARRAY. (Zero if not found.) */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be found in the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY is the array to be searched. The elements in */ -/* ARRAY are assumed to sorted in increasing order. */ - -/* $ Detailed_Output */ - -/* BSRCHD is the index of the input value in the input array. */ -/* If ARRAY does not contain VALUE, BSRCHD is zero. */ - -/* If ARRAY contains more than one occurrence of VALUE, */ -/* BSRCHD may point to any of the occurrences. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A binary search is implemented on the input array. If an */ -/* element of the array is found to match the input value, the */ -/* index of that element is returned. If no matching element */ -/* is found, zero is returned. */ - - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* -11.D0 */ -/* 0.D0 */ -/* 22.491D0 */ -/* 750.0D0 */ - -/* Then */ - -/* BSRCHD ( -11.D0, 4, ARRAY ) = 1 */ -/* BSRCHD ( 22.491D0, 4, ARRAY ) = 3 */ -/* BSRCHD ( 751.D0, 4, ARRAY ) = 0 */ - -/* $ Restrictions */ - -/* ARRAY is assumed to be sorted in increasing order. If this */ -/* condition is not met, the results of BSRCHD are unpredictable. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If NDIM < 1 the value of the function is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary search for d.p. value */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 8-JAN-1989 (IMU) */ - -/* Now works for all values of NDIM. */ - -/* -& */ - -/* Local variables */ - - -/* Set the initial bounds for the search area. */ - - left = 1; - right = *ndim; - while(left <= right) { - -/* Check the middle element. */ - - i__ = (left + right) / 2; - -/* If the middle element matches, return its location. */ - - if (*value == array[i__ - 1]) { - ret_val = i__; - return ret_val; - -/* Otherwise narrow the search area. */ - - } else if (*value < array[i__ - 1]) { - right = i__ - 1; - } else { - left = i__ + 1; - } - } - -/* If the search area is empty, return zero. */ - - ret_val = 0; - return ret_val; -} /* bsrchd_ */ - diff --git a/ext/spice/src/cspice/bsrchd_c.c b/ext/spice/src/cspice/bsrchd_c.c deleted file mode 100644 index 9eae844349..0000000000 --- a/ext/spice/src/cspice/bsrchd_c.c +++ /dev/null @@ -1,161 +0,0 @@ -/* - --Procedure bsrchd_c ( Binary search for a double precision value ) - --Abstract - - Do a binary search for a key value within a double precision array, - assumed to be in increasing order. Return the index of the matching - array entry, or -1 if the key value is not found. - --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 - - ARRAY - SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef bsrchd_c - - SpiceInt bsrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Value to find in array. - ndim I Dimension of array. - array I Array to be searched. - - The function returns the index of the input key value in the - input array, or -1 if the value is not found. - --Detailed_Input - - value is the value to be found in the input array. - - ndim is the number of elements in the input array. - - array is the array to be searched. The elements in the - array are assumed to sorted in increasing order. - --Detailed_Output - - The function returns the index of the input value in the input array. - Indices range from zero to ndim-1. - - If the input array does not contain the specified value, the function - returns -1. - - If the input array contains more than one occurrence of the specified - value, the returned index may point to any of the occurrences. - --Parameters - - None. - --Exceptions - - Error free. - - If ndim < 1 the value of the function is -1. - --Files - - None. - --Particulars - - A binary search is performed on the input array. If an element of - the array is found to match the input value, the index of that - element is returned. If no matching element is found, -1 is - returned. - --Examples - - Let array contain the following elements: - - -11.0 - 0.0 - 22.0 - 750.0 - - Then - - bsrchd_c ( -11.0, 4, array ) == 0 - bsrchd_c ( 22.0, 4, array ) == 2 - bsrchd_c ( 751.0, 4, array ) == -1 - --Restrictions - - array is assumed to be sorted in increasing order. If this - condition is not met, the results of bsrchd_c are unpredictable. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 22-AUG-2002 (NJB) (IMU) - --Index_Entries - - binary search for a double precision value - --& -*/ - -{ /* Begin bsrchd_c */ - - - /* - Note that we adjust the return value to make it a C-style index. - */ - - return ( bsrchd_ ( (doublereal *) &value, - (integer *) &ndim, - (doublereal *) array ) - 1 ); - -} /* End bsrchd_c */ - diff --git a/ext/spice/src/cspice/bsrchi.c b/ext/spice/src/cspice/bsrchi.c deleted file mode 100644 index 121aea0f9f..0000000000 --- a/ext/spice/src/cspice/bsrchi.c +++ /dev/null @@ -1,189 +0,0 @@ -/* bsrchi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BSRCHI ( Binary search for an integer value ) */ -integer bsrchi_(integer *value, integer *ndim, integer *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer left, i__, right; - -/* $ Abstract */ - -/* Do a binary search for a given value within an INTEGER array, */ -/* assumed to be in increasing order. Return the index of the */ -/* matching array entry, or zero if the key value is not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Value to find in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Array to be searched. */ -/* BSRCHI O Index of VALUE in ARRAY. (Zero if not found.) */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be found in the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY is the array to be searched. The elements in */ -/* ARRAY are assumed to sorted in increasing order. */ - -/* $ Detailed_Output */ - -/* BSRCHI is the index of the input value in the input array. */ -/* If ARRAY does not contain VALUE, BSRCHI is zero. */ - -/* If ARRAY contains more than one occurrence of VALUE, */ -/* BSRCHI may point to any of the occurrences. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A binary search is implemented on the input array. If an */ -/* element of the array is found to match the input value, the */ -/* index of that element is returned. If no matching element */ -/* is found, zero is returned. */ - - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* -11 */ -/* 0 */ -/* 22 */ -/* 750 */ - -/* Then */ - -/* BSRCHI ( -11, 4, ARRAY ) = 1 */ -/* BSRCHI ( 22, 4, ARRAY ) = 3 */ -/* BSRCHI ( 751, 4, ARRAY ) = 0 */ - -/* $ Restrictions */ - -/* ARRAY is assumed to be sorted in increasing order. If this */ -/* condition is not met, the results of BSRCHI are unpredictable. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If NDIM < 1 the value of the function is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary search for an integer value */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 8-JAN-1989 (IMU) */ - -/* Now works for all values of NDIM. */ - -/* -& */ - -/* Local variables */ - - -/* Set the initial bounds for the search area. */ - - left = 1; - right = *ndim; - while(left <= right) { - -/* Check the middle element. */ - - i__ = (left + right) / 2; - -/* If the middle element matches, return its location. */ - - if (*value == array[i__ - 1]) { - ret_val = i__; - return ret_val; - -/* Otherwise narrow the search area. */ - - } else if (*value < array[i__ - 1]) { - right = i__ - 1; - } else { - left = i__ + 1; - } - } - -/* If the search area is empty, return zero. */ - - ret_val = 0; - return ret_val; -} /* bsrchi_ */ - diff --git a/ext/spice/src/cspice/bsrchi_c.c b/ext/spice/src/cspice/bsrchi_c.c deleted file mode 100644 index d93eb44c38..0000000000 --- a/ext/spice/src/cspice/bsrchi_c.c +++ /dev/null @@ -1,160 +0,0 @@ -/* - --Procedure bsrchi_c ( Binary search for an integer value ) - --Abstract - - Do a binary search for a key value within an integer array, - assumed to be in increasing order. Return the index of the - matching array entry, or -1 if the key value is not found. - --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 - - ARRAY - SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef bsrchi_c - - SpiceInt bsrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Value to find in array. - ndim I Dimension of array. - array I Array to be searched. - - The function returns the index of the input key value in the - input array, or -1 if the value is not found. - --Detailed_Input - - value is the value to be found in the input array. - - ndim is the number of elements in the input array. - - array is the array to be searched. The elements in the - array are assumed to sorted in increasing order. - --Detailed_Output - - The function returns the index of the input value in the input array. - Indices range from zero to ndim-1. - - If the input array does not contain the specified value, the function - returns -1. - - If the input array contains more than one occurrence of the specified - value, the returned index may point to any of the occurrences. - --Parameters - - None. - --Exceptions - - Error free. - - If ndim < 1 the value of the function is -1. - --Files - - None. - --Particulars - - A binary search is performed on the input array. If an element of - the array is found to match the input value, the index of that - element is returned. If no matching element is found, -1 is - returned. - --Examples - - Let array contain the following elements: - - -11 - 0 - 22 - 750 - - Then - - bsrchi_c ( -11, 4, array ) == 0 - bsrchi_c ( 22, 4, array ) == 2 - bsrchi_c ( 751, 4, array ) == -1 - --Restrictions - - array is assumed to be sorted in increasing order. If this - condition is not met, the results of bsrchi_c are unpredictable. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 30-AUG-2002 (NJB) (IMU) - --Index_Entries - - binary search for an integer value - --& -*/ - -{ /* Begin bsrchi_c */ - - - /* - Note that we adjust the return value to make it a C-style index. - */ - - return ( bsrchi_ ( (integer *) &value, - (integer *) &ndim, - (integer *) array ) - 1 ); - -} /* End bsrchi_c */ diff --git a/ext/spice/src/cspice/byebye.c b/ext/spice/src/cspice/byebye.c deleted file mode 100644 index 43e1b90d6a..0000000000 --- a/ext/spice/src/cspice/byebye.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure byebye_ ( Exit a program indicating an error status ) - --Abstract - - Exit an executing program returning a success or failure status - to the operating system. Supports f2c'd code whose Fortran - counterpart calls the SPICELIB routine byebye. - --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 - - UTILITY - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - int byebye_ ( char *status, ftnlen statusLen ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - status I A string indicating the exit status of a program. - statusLen I Length of status string. - --Detailed_Input - - status This is a character string which indicates the status - to use when exiting a program. The two status values - currently supported are "SUCCESS" and "FAILURE", which - have their obvious meanings. The case of the input is - not important, i.e., "Success" or "failure" are accepted. - - If STATUS has a value of "SUCCESS", then the calling - program will be terminated with the ANSI stdlib.h status - code EXIT_SUCCESS. - - If STATUS has a value of "FAILURE", then the calling - program will be terminated with the ANSI stdlib.h status - code EXIT_FAILURE. - - If STATUS has a value that is not recognized, the calling - program will be terminated with the ANSI stdlib.h status - code EXIT_FAILURE. - - - statusLen is the length of the string passed in via the first - argument status. This argument is provided for - compatibility with the signature generated by running - f2c on the Fortran version of byebye. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - Error free. - - If the input status value is not recognized, the effect is the same - as if the input status were "FAILURE". - --Files - - None. - --Particulars - - This routine should not be called by user applications. It exists - solely for the use of CSPICE functions produced by running f2c - on Fortran code. - - This subroutine is called by sigerr_ to exit a program - returning a success or failure indication to the operating - system. - --Examples - - To exit a program indicating success: - - byebye_ ( "SUCCESS", 7 ); - - To exit a program indicating failure: - - byebye_ ( "FAILURE", 7 ); - --Restrictions - - 1) This function should not be called directly by user's application - software. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.1, 14-FEB-2008 (BVS) - - Removed TABs from the header. - - -CSPICE Version 1.0.0, 04-NOV-1998 (NJB) (KRG) - --Index_Entries - - gracefully exit a program - --& -*/ - -{ /* Begin byebye_ */ - - - - if ( eqstr_c ( status, "SUCCESS" ) ) - { - exit ( EXIT_SUCCESS ); - } - else - { - exit ( EXIT_FAILURE ); - } - - return ( 0 ); - -} /* End byebye_ */ - diff --git a/ext/spice/src/cspice/c_abs.c b/ext/spice/src/cspice/c_abs.c deleted file mode 100644 index 041fbd3d8b..0000000000 --- a/ext/spice/src/cspice/c_abs.c +++ /dev/null @@ -1,14 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double f__cabs(); - -double c_abs(z) complex *z; -#else -extern double f__cabs(double, double); - -double c_abs(complex *z) -#endif -{ -return( f__cabs( z->r, z->i ) ); -} diff --git a/ext/spice/src/cspice/c_cos.c b/ext/spice/src/cspice/c_cos.c deleted file mode 100644 index 4aea0c3cf6..0000000000 --- a/ext/spice/src/cspice/c_cos.c +++ /dev/null @@ -1,17 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double sin(), cos(), sinh(), cosh(); - -VOID c_cos(r, z) complex *r, *z; -#else -#undef abs -#include "math.h" - -void c_cos(complex *r, complex *z) -#endif -{ - double zr = z->r; - r->r = cos(zr) * cosh(z->i); - r->i = - sin(zr) * sinh(z->i); - } diff --git a/ext/spice/src/cspice/c_div.c b/ext/spice/src/cspice/c_div.c deleted file mode 100644 index ac963079ba..0000000000 --- a/ext/spice/src/cspice/c_div.c +++ /dev/null @@ -1,37 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern VOID sig_die(); -VOID c_div(c, a, b) -complex *a, *b, *c; -#else -extern void sig_die(char*,int); -void c_div(complex *c, complex *a, complex *b) -#endif -{ - double ratio, den; - double abr, abi, cr; - - if( (abr = b->r) < 0.) - abr = - abr; - if( (abi = b->i) < 0.) - abi = - abi; - if( abr <= abi ) - { - if(abi == 0) - sig_die("complex division by zero", 1); - ratio = (double)b->r / b->i ; - den = b->i * (1 + ratio*ratio); - cr = (a->r*ratio + a->i) / den; - c->i = (a->i*ratio - a->r) / den; - } - - else - { - ratio = (double)b->i / b->r ; - den = b->r * (1 + ratio*ratio); - cr = (a->r + a->i*ratio) / den; - c->i = (a->i - a->r*ratio) / den; - } - c->r = cr; - } diff --git a/ext/spice/src/cspice/c_exp.c b/ext/spice/src/cspice/c_exp.c deleted file mode 100644 index 8252c7f701..0000000000 --- a/ext/spice/src/cspice/c_exp.c +++ /dev/null @@ -1,19 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double exp(), cos(), sin(); - - VOID c_exp(r, z) complex *r, *z; -#else -#undef abs -#include "math.h" - -void c_exp(complex *r, complex *z) -#endif -{ -double expx; - -expx = exp(z->r); -r->r = expx * cos(z->i); -r->i = expx * sin(z->i); -} diff --git a/ext/spice/src/cspice/c_log.c b/ext/spice/src/cspice/c_log.c deleted file mode 100644 index 6ac990ca26..0000000000 --- a/ext/spice/src/cspice/c_log.c +++ /dev/null @@ -1,17 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double log(), f__cabs(), atan2(); -VOID c_log(r, z) complex *r, *z; -#else -#undef abs -#include "math.h" -extern double f__cabs(double, double); - -void c_log(complex *r, complex *z) -#endif -{ - double zi; - r->i = atan2(zi = z->i, z->r); - r->r = log( f__cabs(z->r, zi) ); - } diff --git a/ext/spice/src/cspice/c_sin.c b/ext/spice/src/cspice/c_sin.c deleted file mode 100644 index 15acccc59a..0000000000 --- a/ext/spice/src/cspice/c_sin.c +++ /dev/null @@ -1,17 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double sin(), cos(), sinh(), cosh(); - -VOID c_sin(r, z) complex *r, *z; -#else -#undef abs -#include "math.h" - -void c_sin(complex *r, complex *z) -#endif -{ - double zr = z->r; - r->r = sin(zr) * cosh(z->i); - r->i = cos(zr) * sinh(z->i); - } diff --git a/ext/spice/src/cspice/c_sqrt.c b/ext/spice/src/cspice/c_sqrt.c deleted file mode 100644 index 8481ee4857..0000000000 --- a/ext/spice/src/cspice/c_sqrt.c +++ /dev/null @@ -1,35 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double sqrt(), f__cabs(); - -VOID c_sqrt(r, z) complex *r, *z; -#else -#undef abs -#include "math.h" -extern double f__cabs(double, double); - -void c_sqrt(complex *r, complex *z) -#endif -{ - double mag, t; - double zi = z->i, zr = z->r; - - if( (mag = f__cabs(zr, zi)) == 0.) - r->r = r->i = 0.; - else if(zr > 0) - { - r->r = t = sqrt(0.5 * (mag + zr) ); - t = zi / t; - r->i = 0.5 * t; - } - else - { - t = sqrt(0.5 * (mag - zr) ); - if(zi < 0) - t = -t; - r->i = t; - t = zi / t; - r->r = 0.5 * t; - } - } diff --git a/ext/spice/src/cspice/cabs.c b/ext/spice/src/cspice/cabs.c deleted file mode 100644 index 0487277de7..0000000000 --- a/ext/spice/src/cspice/cabs.c +++ /dev/null @@ -1,103 +0,0 @@ -/* - --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. - -*/ - -/* - --Description - - This is a slightly modified version of the f2c library - file cabs.c, which was included in the 1998-09-13 f2c - distribution. - - This file has been modified as follows: - - 1) This "header" text has been added. - - 2) The file optionally invokes macros that mangle the - external symbols in f2c's F77 and I77 libraries. The - purpose of this is to allow programs to link to - CSPICE and also link to Fortran objects that do - Fortran I/O. - - The mangling is invoked by defining the preprocessor - flag - - MIX_C_AND_FORTRAN - - - The name mangling capability used by this routine should only be - used as a last resort. - --Version - - -CSPICE Version 1.0.0, 19-DEC-2001 (NJB) - - --& -*/ - - /* - Mangle external symbols if we're mixing C and Fortran. This - code was not in the original version of cabs.c obtained with - the f2c distribution. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - /* - End of modification. - */ - -#ifdef KR_headers -extern double sqrt(); -double f__cabs(real, imag) double real, imag; -#else -#undef abs -#include "math.h" -double f__cabs(double real, double imag) -#endif -{ -double temp; - -if(real < 0) - real = -real; -if(imag < 0) - imag = -imag; -if(imag > real){ - temp = real; - real = imag; - imag = temp; -} -if((real+imag) == real) - return(real); - -temp = imag/real; -temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/ -return(temp); -} diff --git a/ext/spice/src/cspice/card_c.c b/ext/spice/src/cspice/card_c.c deleted file mode 100644 index cc2a27c54d..0000000000 --- a/ext/spice/src/cspice/card_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure card_c ( Cardinality of a cell ) - --Abstract - - Return the cardinality (current number of elements) in a - cell of any data type. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - SpiceInt card_c ( SpiceCell * cell ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - cell I Input cell. - - The function returns the cardinality of the input cell. - --Detailed_Input - - cell is a cell of character, double precision, or - integer data type. - --Detailed_Output - - The function returns the cardinality of (current number of elements - in) the input cell. - --Parameters - - None. - --Exceptions - - 1) If the input cell has invalid cardinality, the error - SPICE(INVALIDCARDINALITY) is signaled. card_c returns - an unspecified value in this case. - - 2) If the input array has invalid size, the error - SPICE(INVALIDSIZE) is signaled. card_c returns - an unspecified value in this case. - --Files - - None. - --Particulars - - This is a generic function which may be used on SpiceCells of - character, double precision, or integer data type. - --Examples - - The cardinality function card_c is typically used to process - each of the elements of a cell. In the following example, cardc_c - is used to step through the individual elements of the character - cell names. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the cell names with string length LNSIZE and maximum - number of strings SIZE. - ./ - SPICECHAR_CELL ( names, SIZE, LNSIZE ); - . - . - . - for ( i = 0; i < card_c(&names); i++ ) - { - . - . - . - } - - In conjunction with the size_c function, card_c may be used - to predict (and subsequently avoid) overflows when manipulating - cells. In the following example, size_c is used to determine - whether the integer cell original can be safely copied into - the integer cell save before actually attempting the operation. - If original contains more elements than save can hold, then - the operation would fail. - - if ( card_c(&original) <= size_c(&save) ) - { - copy_c ( &original, &save ); - } - else - { - . - . - . - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 06-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - cardinality of an integer cell - --& -*/ - -{ /* Begin card_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( cell->card ); - } - chkin_c ( "card_c" ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - /* - Check the size and cardinality of the input cell. - */ - if ( cell->size < 0 ) - { - setmsg_c ( "Invalid cell size. The size was #." ); - errint_c ( "#", cell->size ); - sigerr_c ( "SPICE(INVALIDSIZE)" ); - chkout_c ( "card_c" ); - - return ( cell->card ); - } - - else if ( cell->card < 0 ) - { - setmsg_c ( "Invalid cell cardinality. The " - "cardinality was #." ); - errint_c ( "#", cell->card ); - sigerr_c ( "SPICE(INVALIDCARDINALITY)" ); - chkout_c ( "card_c" ); - - return ( cell->card ); - } - - else if ( cell->card > cell->size ) - { - setmsg_c ( "Invalid cell cardinality; cardinality exceeds " - " cell size. The cardinality was #. The size " - " was #." ); - errint_c ( "#", cell->card ); - errint_c ( "#", cell->size ); - sigerr_c ( "SPICE(INVALIDCARDINALITY)" ); - chkout_c ( "card_c" ); - - return ( cell->card ); - } - - - chkout_c ( "card_c" ); - - return ( cell->card ); - - -} /* End card_c */ - diff --git a/ext/spice/src/cspice/cardc.c b/ext/spice/src/cspice/cardc.c deleted file mode 100644 index 5b73712b5c..0000000000 --- a/ext/spice/src/cspice/cardc.c +++ /dev/null @@ -1,225 +0,0 @@ -/* cardc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CARDC ( Cardinality of a character cell ) */ -integer cardc_(char *cell, ftnlen cell_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer card, size; - extern /* Subroutine */ int chkin_(char *, ftnlen), dechar_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the cardinality (number of elements) of a character cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Input cell. */ - -/* The function returns the cardinality of the input cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* The function returns the cardinality of (number of elements in) */ -/* the input cell. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The cardinality (CARD) functions are typically used to process */ -/* each of the elements of a cell. In the following example, CARDC */ -/* is used to step through the individual elements of the character */ -/* cell NAMES. */ - -/* DO I = 1, CARDC ( NAMES ) */ -/* . */ -/* . */ -/* END DO */ - -/* In conjunction with the size (SIZE) functions, they may be used */ -/* to predict (and subsequently avoid) overflows when manipulating */ -/* cells. In the following example, SIZEC is used to determine */ -/* whether the character cell ORIGINAL can be safely copied into */ -/* the character cell SAVE before actually attempting the operation. */ -/* If ORIGINAL contains more elements than SAVE can hold, then */ -/* the operation would fail. */ - -/* IF ( CARDC ( ORIGINAL ) .LE. SIZEC ( SAVE ) ) THEN */ -/* CALL COPYC ( ORIGINAL, SAVE ) */ - -/* ELSE */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input array has invalid cardinality, the error */ -/* SPICE(INVALIDCARDINALITY) is signaled. CARDC returns */ -/* an unspecified value in this case. */ - -/* 2) If the input array has invalid size, the error */ -/* SPICE(INVALIDSIZE) is signaled. CARDC returns */ -/* an unspecified value in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 29-JUL-2002 (NJB) */ - -/* Errors in code fragments in the Examples section of */ -/* the header were corrected. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* cardinality of a character cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for valid input cell added. The input cell must */ -/* have valid size and cardinality values. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("CARDC", (ftnlen)5); - } - -/* Set return value, regardless of validity. */ - - dechar_(cell + cell_len * 5, &card, cell_len); - ret_val = card; - -/* Squeal if something is awry. */ - - dechar_(cell + (cell_len << 2), &size, cell_len); - if (size < 0) { - setmsg_("Invalid cell size. The size was #.", (ftnlen)35); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("CARDC", (ftnlen)5); - return ret_val; - } else if (card < 0) { - setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen) - 49); - errint_("#", &card, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("CARDC", (ftnlen)5); - return ret_val; - } else if (card > size) { - setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T" - "he cardinality was #. The size was #.", (ftnlen)97); - errint_("#", &card, (ftnlen)1); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("CARDC", (ftnlen)5); - return ret_val; - } - chkout_("CARDC", (ftnlen)5); - return ret_val; -} /* cardc_ */ - diff --git a/ext/spice/src/cspice/cardd.c b/ext/spice/src/cspice/cardd.c deleted file mode 100644 index 5e276ba0b5..0000000000 --- a/ext/spice/src/cspice/cardd.c +++ /dev/null @@ -1,223 +0,0 @@ -/* cardd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CARDD ( Cardinality of a double precision cell ) */ -integer cardd_(doublereal *cell) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the cardinality (number of elements) of a double */ -/* precision cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Input cell. */ - -/* The function returns the cardinality of the input cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* The function returns the cardinality of (number of elements in) */ -/* the input cell. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The cardinality (CARD) functions are typically used to process */ -/* each of the elements of a cell. In the following example, CARDC */ -/* is used to step through the individual elements of the character */ -/* cell NAMES. */ - -/* DO I = 1, CARDC ( NAMES ) */ -/* . */ -/* . */ -/* END DO */ - -/* In conjunction with the size (SIZE) functions, they may be used */ -/* to predict (and subsequently avoid) overflows when manipulating */ -/* cells. In the following example, SIZED is used to determine */ -/* whether the d.p. cell ORIGINAL can be safely copied into */ -/* the d.p. cell SAVE before actually attempting the operation. */ -/* If ORIGINAL contains more elements than SAVE can hold, then */ -/* the operation would fail. */ - -/* IF ( CARDD ( ORIGINAL ) .LE. SIZED ( SAVE ) ) THEN */ -/* CALL COPYD ( ORIGINAL, SAVE ) */ - -/* ELSE */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input array has invalid cardinality, the error */ -/* SPICE(INVALIDCARDINALITY) is signaled. CARDD returns */ -/* an unspecified value in this case. */ - -/* 2) If the input array has invalid size, the error */ -/* SPICE(INVALIDSIZE) is signaled. CARDD returns */ -/* an unspecified value in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 29-JUL-2002 (NJB) */ - -/* Errors in code fragments in the Examples section of */ -/* the header were corrected. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* cardinality of a d.p. cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for valid input cell added. The input cell must */ -/* have valid size and cardinality values. */ -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("CARDD", (ftnlen)5); - } - -/* Set return value, regardless of validity. */ - - ret_val = (integer) cell[5]; - -/* Squeal if something is awry. */ - - if ((integer) cell[4] < 0) { - setmsg_("Invalid cell size. The size was #.", (ftnlen)35); - i__1 = (integer) cell[4]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("CARDD", (ftnlen)5); - return ret_val; - } else if ((integer) cell[5] < 0) { - setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen) - 49); - i__1 = (integer) cell[5]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("CARDD", (ftnlen)5); - return ret_val; - } else if ((integer) cell[5] > (integer) cell[4]) { - setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T" - "he cardinality was #. The size was #.", (ftnlen)97); - i__1 = (integer) cell[5]; - errint_("#", &i__1, (ftnlen)1); - i__1 = (integer) cell[4]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("CARDD", (ftnlen)5); - return ret_val; - } - chkout_("CARDD", (ftnlen)5); - return ret_val; -} /* cardd_ */ - diff --git a/ext/spice/src/cspice/cardi.c b/ext/spice/src/cspice/cardi.c deleted file mode 100644 index 15bc9a8b77..0000000000 --- a/ext/spice/src/cspice/cardi.c +++ /dev/null @@ -1,218 +0,0 @@ -/* cardi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CARDI ( Cardinality of an integer cell ) */ -integer cardi_(integer *cell) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the cardinality (number of elements) of an integer cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Input cell. */ - -/* The function returns the cardinality of the input cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* The function returns the cardinality of (number of elements in) */ -/* the input cell. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The cardinality (CARD) functions are typically used to process */ -/* each of the elements of a cell. In the following example, CARDC */ -/* is used to step through the individual elements of the character */ -/* cell NAMES. */ - -/* DO I = 1, CARDC ( NAMES ) */ -/* . */ -/* . */ -/* END DO */ - -/* In conjunction with the size (SIZE) functions, they may be used */ -/* to predict (and subsequently avoid) overflows when manipulating */ -/* cells. In the following example, SIZEI is used to determine */ -/* whether the integer cell ORIGINAL can be safely copied into */ -/* the integer cell SAVE before actually attempting the operation. */ -/* If ORIGINAL contains more elements than SAVE can hold, then */ -/* the operation would fail. */ - -/* IF ( CARDI ( ORIGINAL ) .LE. SIZEI ( SAVE ) ) THEN */ -/* CALL COPYI ( ORIGINAL, SAVE ) */ - -/* ELSE */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input array has invalid cardinality, the error */ -/* SPICE(INVALIDCARDINALITY) is signaled. CARDI returns */ -/* an unspecified value in this case. */ - -/* 2) If the input array has invalid size, the error */ -/* SPICE(INVALIDSIZE) is signaled. CARDI returns */ -/* an unspecified value in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 29-JUL-2002 (NJB) */ - -/* Errors in code fragments in the Examples section of */ -/* the header were corrected. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* cardinality of an integer cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for valid input cell added. The input cell must */ -/* have valid size and cardinality values. */ -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("CARDI", (ftnlen)5); - } - -/* Set return value, regardless of validity. */ - - ret_val = cell[5]; - -/* Squeal if something is awry. */ - - if (cell[4] < 0) { - setmsg_("Invalid cell size. The size was #.", (ftnlen)35); - errint_("#", &cell[4], (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("CARDI", (ftnlen)5); - return ret_val; - } else if (cell[5] < 0) { - setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen) - 49); - errint_("#", &cell[5], (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("CARDI", (ftnlen)5); - return ret_val; - } else if (cell[5] > cell[4]) { - setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T" - "he cardinality was #. The size was #.", (ftnlen)97); - errint_("#", &cell[5], (ftnlen)1); - errint_("#", &cell[4], (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("CARDI", (ftnlen)5); - return ret_val; - } - chkout_("CARDI", (ftnlen)5); - return ret_val; -} /* cardi_ */ - diff --git a/ext/spice/src/cspice/cgv2el.c b/ext/spice/src/cspice/cgv2el.c deleted file mode 100644 index b0dec4481b..0000000000 --- a/ext/spice/src/cspice/cgv2el.c +++ /dev/null @@ -1,194 +0,0 @@ -/* cgv2el.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CGV2EL ( Center and generating vectors to ellipse ) */ -/* Subroutine */ int cgv2el_(doublereal *center, doublereal *vec1, doublereal - *vec2, doublereal *ellips) -{ - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), chkin_( - char *, ftnlen), saelgv_(doublereal *, doublereal *, doublereal *, - doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Form a SPICELIB ellipse from a center vector and two generating */ -/* vectors. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CENTER, */ -/* VEC1, */ -/* VEC2 I Center and two generating vectors for an ellipse. */ -/* ELLIPS O The SPICELIB ellipse defined by the input vectors. */ - -/* $ Detailed_Input */ - -/* CENTER, */ -/* VEC1, */ -/* VEC2 are a center and two generating vectors defining */ -/* an ellipse in three-dimensional space. The */ -/* ellipse is the set of points */ - -/* CENTER + cos(theta) VEC1 + sin(theta) VEC2 */ - -/* where theta ranges over the interval (-pi, pi]. */ -/* VEC1 and VEC2 need not be linearly independent. */ - -/* $ Detailed_Output */ - -/* ELLIPS is the SPICELIB ellipse defined by the input */ -/* vectors. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If VEC1 and VEC2 are linearly dependent, ELLIPS will be */ -/* degenerate. SPICELIB ellipses are allowed to represent */ -/* degenerate geometric ellipses. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB ellipses serve to simplify calling sequences and reduce */ -/* the chance for error in declaring and describing argument lists */ -/* involving ellipses. */ - -/* The set of ellipse conversion routines is */ - -/* CGV2EL ( Center and generating vectors to ellipse ) */ -/* EL2CGV ( Ellipse to center and generating vectors ) */ - -/* $ Examples */ - -/* 1) Find the intersecton of an ellipse with a plane. The ellipse */ -/* is defined by the vectors CENTER, VEC1, and VEC2. The plane */ -/* is defined by the normal vector N and the constant C. */ - -/* C */ -/* C Make a SPICELIB ellipse. Make a plane while */ -/* C we're at it. */ -/* C */ -/* CALL CGV2EL ( CENTER, VEC1, VEC2, ELLIPS ) */ -/* CALL NVC2PL ( N, C, PLANE ) */ - -/* C */ -/* C Find the intersection of the ellipse and plane. */ -/* C NXPTS is the number of intersection points; XPT1 */ -/* C and XPT2 are the points themselves. */ -/* C */ -/* CALL INELPL ( ELLIPS, PLANE, NXPTS, XPT1, XPT2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* center and generating vectors to ellipse */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* SPICELIB ellipses contain a center vector, a semi-major */ -/* axis vector, and a semi-minor axis vector. These are */ -/* located, respectively, in elements */ - -/* CTRPOS through CTRPOS + 1 */ - -/* MAJPOS through MAJPOS + 1 */ - -/* MINPOS through MINPOS + 1 */ - - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CGV2EL", (ftnlen)6); - } - -/* The center of the ellipse is held in the first three elements. */ - - vequ_(center, ellips); - -/* Find the semi-axes of the ellipse. These may be degenerate. */ - - saelgv_(vec1, vec2, &ellips[3], &ellips[6]); - chkout_("CGV2EL", (ftnlen)6); - return 0; -} /* cgv2el_ */ - diff --git a/ext/spice/src/cspice/cgv2el_c.c b/ext/spice/src/cspice/cgv2el_c.c deleted file mode 100644 index c92869f149..0000000000 --- a/ext/spice/src/cspice/cgv2el_c.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - --Procedure cgv2el_c ( Center and generating vectors to ellipse ) - --Abstract - - Form a CSPICE ellipse from a center vector and two generating - vectors. - --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 - - ELLIPSES - --Keywords - - ELLIPSE - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef cgv2el_c - - - void cgv2el_c ( ConstSpiceDouble center[3], - ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceEllipse * ellipse ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - center, - vec1, - vec2 I Center and two generating vectors for an ellipse. - ellipse O The CSPICE ellipse defined by the input vectors. - --Detailed_Input - - center, - vec1, - vec2 are a center and two generating vectors defining - an ellipse in three-dimensional space. The - ellipse is the set of points - - center + cos(theta) vec1 + sin(theta) vec2 - - where theta ranges over the interval (-pi, pi]. - vec1 and vec2 need not be linearly independent. - --Detailed_Output - - ellipse is the CSPICE ellipse defined by the input - vectors. - --Parameters - - None. - --Exceptions - - 1) If vec1 and vec2 are linearly dependent, ellips will be - degenerate. CSPICE ellipses are allowed to represent - degenerate geometric ellipses. - --Files - - None. - --Particulars - - CSPICE ellipses serve to simplify calling sequences and reduce - the chance for error in declaring and describing argument lists - involving ellipses. - - The set of ellipse conversion routines is - - cgv2el_c ( Center and generating vectors to ellipse ) - el2cgv_c ( Ellipse to center and generating vectors ) - --Examples - - 1) Find the intersecton of an ellipse with a plane. The ellipse - is defined by the vectors center, vec1, and vec2. The plane - is defined by the normal vector n and the constant c. - - #include "SpiceUsr.h" - . - . - . - /. - Make a CSPICE ellipse. Make a plane while we're at it. - ./ - cgv2el_c ( center, vec1, vec2, &ellipse ); - nvc2pl_c ( n, c, &plane ); - - /. - Find the intersection of the ellipse and plane. - nxpts is the number of intersection points; xpt1 - and xpt2 are the points themselves. - ./ - inelpl_c ( &ellipse, &plane, &nxpts, xpt1, xpt2 ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - center and generating vectors to ellipse - --& -*/ - -{ /* Begin cgv2el_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "cgv2el_c" ); - - /* - The center of the ellipse is held in the first three elements. - */ - MOVED ( center, 3, ellipse->center ); - - /* - Find the semi-axes of the ellipse. These may be degenerate. - */ - saelgv_c ( vec1, vec2, ellipse->semiMajor, ellipse->semiMinor ); - - - chkout_c ( "cgv2el_c" ); - -} /* End cgv2el_c */ - diff --git a/ext/spice/src/cspice/chbase.c b/ext/spice/src/cspice/chbase.c deleted file mode 100644 index 9c0d125254..0000000000 --- a/ext/spice/src/cspice/chbase.c +++ /dev/null @@ -1,401 +0,0 @@ -/* chbase.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CHBASE ( Character set base ) */ -integer chbase_(void) -{ - /* System generated locals */ - integer ret_val; - -/* $ Abstract */ - -/* Return the base value used to encode unsigned integer values */ -/* in character strings. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* None. */ -/* $ Brief_I/O */ - -/* The function returns the base value used to encode unsigned */ -/* integer values in character strings. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* CHBASE is the base used by ENCHAR and DECHAR to encode and decode */ -/* non-negative integers to and from character strings. Its value is */ -/* determined by the size of the character set available for a given */ -/* machine and compiler. Strictly speaking, CHBASE is one more than */ -/* the biggest positive integer which can be handled by both the */ -/* CHAR and ICHAR intrinsic functions (which are used by ENCHAR and */ -/* DECHAR). That is, CHBASE is the first positive integer for which */ -/* the logical expression */ - -/* ( ICHAR ( CHAR ( CHBASE ) ) .EQ. CHBASE ) */ - -/* is false. */ - -/* Note that CHBASE can be (and probably is) different from the */ -/* number of characters in the character set used by the processor. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns a constant value, set by the user */ -/* prior to compilation. */ - -/* CHBASE should always be at least 128 (the size of the ASCII */ -/* character set), and will usually be 256 for machines which use */ -/* eight bits to represent a single character. The following list */ -/* contains the values of CHBASE for a range of environments. */ - -/* Environment: VAX/VMS, VAX FORTRAN */ -/* Value: 256 */ - -/* Environment: Sun, Sun FORTRAN */ -/* Value: 256 */ - -/* Environment: PC, MS FORTRAN */ -/* Value: 256 */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Value: 256 */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Value: 256 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Value: 256 */ - -/* Environment: Silicon Graphics IRIX OS, SGI FORTRAN 77 */ -/* Value: 256 */ - -/* Environment: DEC Alpha 3000/4000, OSF/1, DEC FORTRAN-77 */ -/* Value: 256 */ - -/* Environment: NeXT/Mach OS, Absoft Fortran */ -/* Value: 256 */ - -/* Environment: PC/Linux, Fort77 */ -/* Value: 128 */ - - -/* For other machines, the value can be determined by running */ -/* the following simple program: */ - -/* INTEGER CHBASE */ -/* DATA CHBASE / 0 / */ - -/* DO WHILE ( .TRUE. ) */ - -/* IF ( ICHAR (CHAR ( CHBASE ) ) .EQ. CHBASE ) THEN */ -/* CHBASE = CHBASE + 1 */ -/* ELSE */ -/* WRITE (6,*) 'CHBASE for this machine is : ', CHBASE */ -/* STOP */ -/* END IF */ - -/* END DO */ -/* END */ - -/* $ Examples */ - -/* See ENCHAR, DECHAR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1. "Programming in VAX FORTRAN", Digital Equipment Corporation, */ -/* September 1984, Section 8.3, page 8-6. */ - -/* 2. "Microsoft FORTRAN Reference", Microsoft Corporation, */ -/* 1989, Section 5.1.1, page 241. */ - -/* 3. "Language Systems FORTRAN Reference Manual", Language Systems */ -/* Corporation, version 1.2.1, page 3-20. */ - -/* 4. "Lahey F77L EM/32 FORTRAN Language Reference Manual", page */ -/* 222, Note 20. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.21.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.11.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.8.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.4.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.3.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.1.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.1.0, 05-DEC-2001 (FST) */ - -/* Updated the value for PC-LINUX environment. */ - -/* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 2.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 2.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 2.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 05-APR-1998 (NJB) */ - -/* Added reference to the PC-LINUX environment. */ - -/* - SPICELIB Version 1.5.0, 03-NOV-1993 (HAN) */ - -/* Module was updated to include the character base */ -/* value for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. */ - -/* - SPICELIB Version 1.4.0, 06-OCT-1992 (HAN) */ - -/* Module was updated to include the character base */ -/* value for the Hewlett Packard UX 9000/750 environment, */ -/* and the value for the Sun was changed from 128 to 256. */ -/* Both changes are the result of running the program in */ -/* the Particulars section of the header on both machines. */ - -/* - SPICELIB Version 1.3.1, 10-MAR-1999 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.3.0, 13-NOV-1991 (MJS) */ - -/* Module was updated to include the character base */ -/* value for the Lahey FORTRAN EM/32 environment (PC). */ - -/* - SPICELIB Version 1.2.0, 07-DEC-1990 (MJS) */ - -/* Module was updated to include the character base */ -/* value for the Macintosh. */ - -/* - SPICELIB Version 1.1.0, 09-MAR-1990 (HAN) */ - -/* Module was updated to include the character base */ -/* value for the Sun. Sources for the values contained */ -/* in this module are now specified in the Literature_References */ -/* section. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* base for encoding integers in character_string */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 05-DEC-2001 (FST) */ - -/* It was discovered that linux distributions shipping */ -/* versions of g77 derived off of gcc versions 2.96-3.00 */ -/* suffer from in implementation change in ICHAR that */ -/* requires CHBASE to change to 128. Since restricting */ -/* CHBASE to 128 has little impact on other linux */ -/* environments utilizing other versions of g77 or fort77, */ -/* we elected to make the change to all environments */ -/* rather than complicate this issue by forking a new one. */ - -/* - SPICELIB Version 1.4.0, 06-OCT-1992 (HAN) */ - -/* Module was updated to include the character base */ -/* value for the Hewlett Packard UX 9000/750 environment, */ -/* and the value for the Sun was changed from 128 to 256. */ -/* Both changes are the result of running the program in */ -/* the Particulars section of the header on both machines. */ - -/* The previous Sun value was computed on the Sun3 and was */ -/* not updated when we moved to the Sun4. Everything passed */ -/* the suite of test programs that would have indicated a bug. */ - -/* The code was also reformatted so that a utility program can */ -/* create the file for each environment. */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ - -/* Missing parentheses added to CHBASE declaration. */ - -/* -& */ - -/* We have provided values for several popular machines. Remove */ -/* the comment character in front of the value for your machine, */ -/* or provide your own value. Numbers are provided in a variety */ -/* of formats: decimal, hex, and binary. These last two formats */ -/* are not portable; but then, neither are the values. */ - - -/* VAX, VAX FORTRAN */ -/* Sun, Sun FORTRAN */ -/* IBM PC, Microsoft FORTRAN, Lahey EM/32 FORTRAN */ -/* Macintosh, Language Systems FORTRAN */ -/* HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Silicon Graphics, IRIX OS, SGI FORTRAN 77 */ -/* DEC Alpha, OSF/1, DEC FORTRAN-77 */ -/* NeXT, Mach OS, Absoft Fortran 77 */ - - ret_val = 256; - return ret_val; -} /* chbase_ */ - diff --git a/ext/spice/src/cspice/chbder.c b/ext/spice/src/cspice/chbder.c deleted file mode 100644 index 2fc07abf9d..0000000000 --- a/ext/spice/src/cspice/chbder.c +++ /dev/null @@ -1,389 +0,0 @@ -/* chbder.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CHBDER ( Derivatives of a Chebyshev expansion ) */ -/* Subroutine */ int chbder_(doublereal *cp, integer *degp, doublereal *x2s, - doublereal *x, integer *nderiv, doublereal *partdp, doublereal *dpdxs) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - doublereal s, scale, s2; - -/* $ Abstract */ - -/* Given the coefficients for the Chebyshev expansion of a */ -/* polynomial, this returns the value of the polynomial and its */ -/* first NDERIV derivatives evaluated at the input X. */ - -/* $ 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 */ - -/* INTERPOLATION, MATH, POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CP I NDEG+1 Chebyshev polynomial coefficients. */ -/* DEGP I Degree of polynomial. */ -/* X2S I Transformation parameters of polynomial. */ -/* X I Value for which the polynomial is to be evaluated */ -/* NDERIV I The number of derivatives to compute */ -/* PARTDP - Workspace provided for computing derivatives */ -/* DPDXS(I) O Value of the I'th derivative of the polynomial */ - -/* $ Detailed_Input */ - -/* CP is an array of coefficients a polynomial with respect */ -/* to the Chebyshev basis. The polynomial to be */ -/* evaluated is assumed to be of the form: */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where T(I,S) is the I'th Chebyshev polynomial */ -/* evaluated at a number S whose double precision */ -/* value lies between -1 and 1. The value of S is */ -/* computed from the input variables P(1), P(2) and X. */ - -/* DEGP is the degree of the Chebyshev polynomial to be */ -/* evaluated. */ - -/* X2S is an array of two parameters. These parameters are */ -/* used to transform the domain of the input variable X */ -/* into the standard domain of the Chebyshev polynomial. */ -/* X2S(1) should be a reference point in the domain of */ -/* X; X2S(2) should be the radius by which points are */ -/* allowed to deviate from the reference point and while */ -/* remaining within the domain of X. The value of */ -/* X is transformed into the value S given by */ - -/* S = ( X - X2S(1) ) / X2S(2) */ - -/* Typically X2S(1) is the midpoint of the interval over */ -/* which X is allowed to vary and X2S(2) is the radius */ -/* of the interval. */ - -/* The main reason for doing this is that a Chebyshev */ -/* expansion is usually fit to data over a span */ -/* from A to B where A and B are not -1 and 1 */ -/* respectively. Thus to get the "best fit" the */ -/* data was transformed to the interval [-1,1] and */ -/* coefficients generated. These coefficients are */ -/* not rescaled to the interval of the data so that */ -/* the numerical "robustness" of the Chebyshev fit will */ -/* not be lost. Consequently, when the "best fitting" */ -/* polynomial needs to be evaluated at an intermediate */ -/* point, the point of evaluation must be transformed */ -/* in the same way that the generating points were */ -/* transformed. */ - -/* X Value for which the polynomial is to be evaluated. */ - -/* NDERIV is the number of derivatives to be computed by the */ -/* routine. NDERIV should be non-negative. */ - -/* PARTDP Is a work space used by the program to compute */ -/* all of the desired derivatives. It should be declared */ -/* in the calling program as */ - -/* DOUBLE PRECISION PARTDP(3, 0:NDERIV) */ - -/* $ Detailed_Output */ - -/* DPDXS(0) The value of the polynomial to be evaluated. It */ -/* is given by */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where T(I,S) is the I'th Chebyshev polynomial */ -/* evaluated at a number S = ( X - P(1) )/P(2) */ - -/* DPDXS(I) The value of the I'th derivative of the polynomial at */ -/* X. (I ranges from 1 to NDERIV) It is given by */ - -/* [i] */ -/* (1/P(2)**I) ( CP(DEGP+1)*T (DEGP,S) */ - -/* [i] */ -/* + CP(DEGP)*T (DEGP-1,S) + ... */ - -/* . */ -/* . */ -/* . */ -/* [i] */ -/* ... + CP(2)*T (1,S) */ - -/* [i] */ -/* + CP(1)*T (0,S) ) */ - -/* [i] */ -/* where T(k,S) and T (I,S) are the k'th Chebyshev */ -/* polynomial and its i'th derivative respectively, */ -/* evaluated at the number S = ( X - X2S(1) )/X2S(2). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the value of a Chebyshev polynomial */ -/* expansion and the derivatives of the expansion with respect to X. */ -/* The polynomial is given by */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where */ - -/* S = ( X - X2S(1) ) / X2S(2) */ - -/* and */ - -/* T(i,S) is the i'th Chebyshev polynomial of the first kind */ -/* evaluated at S. */ - - -/* $ Examples */ - -/* Depending upon the user's needs, there are 3 routines available */ -/* for evaluating Chebyshev polynomials. */ - -/* CHBVAL for evaluating a Chebyshev polynomial when no */ -/* derivatives are desired. */ - -/* CHBINT for evaluating a Chebyshev polynomial and its */ -/* first derivative. */ - -/* CHBDER for evaluating a Chebyshev polynomial and a user */ -/* or application dependent number of derivatives. */ - -/* Of these 3 the one most commonly employed by NAIF software */ -/* is CHBINT as it is used to interpolate ephemeris state */ -/* vectors which requires the evaluation of a polynomial */ -/* and its derivative. When no derivatives are desired one */ -/* should use CHBVAL, or when more than one or an unknown */ -/* number of derivatives are desired one should use CHBDER. */ - -/* The code fragment below illustrates how this routine might */ -/* be used to obtain points for plotting a polynomial */ -/* and its derivatives. */ - -/* fetch the pieces needed for describing the polynomial */ -/* to be evaluated. */ - -/* READ (*,*) DEGP, ( CP(I), I = 1, DEG+1 ), NDERIV, BEG, END */ - -/* check to see that BEG is actually less than END */ - -/* IF ( BEG .GE. END ) THEN */ - -/* take some appropriate action */ - -/* ELSE */ - -/* X2S(1) = ( END + BEG ) / 2.0D0 */ -/* X2S(2) = ( END - BEG ) / 2.0D0 */ - -/* END IF */ - -/* STEP = END - BEG / */ -/* X = BEG */ - -/* DO WHILE ( X .LE. END ) */ - -/* CALL CHBDER ( CP, DEGP, X2S , X, NDERIV, PARTDP, DPDXS ) */ - -/* do something with the pairs ( X, DPDXS(0)),(X,DPDXS(1)), */ -/* (X,DPDXS(2)) ... (X,DPDXS(NDERIV)) */ - -/* X = X + STEP */ - -/* END DO */ - -/* $ Restrictions */ - -/* The user must be sure that the provided workspace is declared */ -/* properly in the calling routine. The proper declaration is: */ - -/* INTEGER NDERIV */ -/* PARAMETER ( NDERIV = the desired number of derivatives ) */ -/* DOUBLE PRECISION PARTDP (3, 0:NDERIV) */ - -/* If for some reason a parameter is not passed to this routine in */ -/* NDERIV, the user should make sure that the value of NDERIV is not */ -/* so large that the work space provided is inadequate. */ - -/* One needs to be careful that the value (X-X2S(1)) / X2S(2) lies */ -/* between -1 and 1. Otherwise, the routine may fail spectacularly */ -/* (for example with a floating point overflow). */ - -/* While this routine will compute derivatives of the input */ -/* polynomial, the user should consider how accurately the */ -/* derivatives of the Chebyshev fit, match the derivatives of the */ -/* function it approximates. */ - - - -/* $ Exceptions */ - -/* Error free */ - -/* No tests are performed for exceptional values ( NDERIV negative, */ -/* DEGP negative, etc.) This routine is expected to be used at a low */ -/* level in ephemeris evaluations. For that reason it has been */ -/* elected as a routine that will not participate in error handling. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* "Numerical Recipes -- The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* Willam T. Vetterling. (See Clenshaw's Recurrence Formula) */ - -/* "The Chebyshev Polynomials" by Theodore J. Rivlin */ - -/* "CRC Handbook of Tables for Mathematics" */ - -/* $ 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 */ - -/* derivatives of a chebyshev expansion */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 16-FEB-1988 (WLT) (NJB) */ - -/* The Error free specification was added to the routine as */ -/* well as an explanation for this designation. Examples added. */ -/* Declaration of unused variable RECIP removed. */ -/* -& */ - -/* Local variables */ - - -/* Transform X to S and initialize temporary variables. */ - - s = (*x - x2s[0]) / x2s[1]; - s2 = s * 2.; - j = *degp + 1; - i__1 = *nderiv; - for (i__ = 0; i__ <= i__1; ++i__) { - partdp[i__ * 3] = 0.; - partdp[i__ * 3 + 1] = 0.; - } - -/* Evaluate the polynomial ... */ - - while(j > 1) { - partdp[2] = partdp[1]; - partdp[1] = partdp[0]; - partdp[0] = cp[j - 1] + (s2 * partdp[1] - partdp[2]); - -/* ... and its derivatives using recursion. */ - - scale = 2.; - i__1 = *nderiv; - for (i__ = 1; i__ <= i__1; ++i__) { - partdp[i__ * 3 + 2] = partdp[i__ * 3 + 1]; - partdp[i__ * 3 + 1] = partdp[i__ * 3]; - partdp[i__ * 3] = partdp[(i__ - 1) * 3 + 1] * scale + partdp[i__ * - 3 + 1] * s2 - partdp[i__ * 3 + 2]; - scale += 2.; - } - --j; - } - dpdxs[0] = cp[0] + (s * partdp[0] - partdp[1]); - scale = 1.; - i__1 = *nderiv; - for (i__ = 1; i__ <= i__1; ++i__) { - dpdxs[i__] = partdp[(i__ - 1) * 3] * scale + partdp[i__ * 3] * s - - partdp[i__ * 3 + 1]; - scale += 1; - } - -/* Scale the k'th derivative w.r.t S by (1/X2S(2)**k) so that we have */ -/* the derivatives */ - -/* 2 3 4 5 */ -/* d P(S) d P(S) d P(S) d P(S) d P(S) */ -/* ------ ------ ------ ------ ------ */ -/* 2 3 4 5 */ -/* dX dX dX dX dX */ - - -/* NOTE: In the loop that follows we perform division instead of */ -/* multiplying by reciprocals so that the algorithm matches */ -/* CHBINT. If multiplication by reciprocals is performed */ -/* CHBINT and CHBDER (although mathematically equivalent) will */ -/* not produce identical results for the first derivative. */ - - - scale = x2s[1]; - i__1 = *nderiv; - for (i__ = 1; i__ <= i__1; ++i__) { - dpdxs[i__] /= scale; - scale = x2s[1] * scale; - } - return 0; -} /* chbder_ */ - diff --git a/ext/spice/src/cspice/chbint.c b/ext/spice/src/cspice/chbint.c deleted file mode 100644 index 0895394abd..0000000000 --- a/ext/spice/src/cspice/chbint.c +++ /dev/null @@ -1,315 +0,0 @@ -/* chbint.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CHBINT ( Interpolate a Chebyshev expansion ) */ -/* Subroutine */ int chbint_(doublereal *cp, integer *degp, doublereal *x2s, - doublereal *x, doublereal *p, doublereal *dpdx) -{ - integer j; - doublereal s, w[3], s2, dw[3]; - -/* $ Abstract */ - -/* Given the coefficients for the Chebyshev expansion of a */ -/* polynomial, this returns the value of the polynomial and its */ -/* derivative evaluated at the input X. */ - -/* $ 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 */ - -/* INTERPOLATION, MATH, POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CP I NDEG+1 Chebyshev polynomial coefficients. */ -/* DEGP I Degree of polynomial. */ -/* X2S I Transformation parameters of polynomial. */ -/* X I Value for which the polynomial is to be evaluated */ -/* P O Value of the polynomial at X */ -/* DPDX O Value of the derivative of the polynomial at X */ - -/* $ Detailed_Input */ - -/* CP is an array of coefficients OF a polynomial with */ -/* respect to the Chebyshev basis. The polynomial to be */ -/* evaluated is assumed to be of the form: */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where T(I,S) is the I'th Chebyshev polynomial */ -/* evaluated at a number S whose double precision */ -/* value lies between -1 and 1. The value of S is */ -/* computed from the input variables X2S(1), X2S(2) and X */ - -/* DEGP is the degree of the Chebyshev polynomial to be */ -/* evaluated. */ - -/* X2S is an array of two parameters. These parameters are */ -/* used to transform the domain of the input variable X */ -/* into the standard domain of the Chebyshev polynomial. */ -/* X2S(1) should be a reference point in the domain of X; */ -/* X2S(2) should be the radius by which points are */ -/* allowed to deviate from the reference point and while */ -/* remaining within the domain of X. The value of */ -/* X is transformed into the value S given by */ - -/* S = ( X - X2S(1) ) / X2S(2) */ - -/* Typically X2S(1) is the midpoint of the interval over */ -/* which X is allowed to vary and X2S(2) is the radius of */ -/* the interval. */ - -/* The main reason for doing this is that a Chebyshev */ -/* expansion is usually fit to data over a span */ -/* from A to B where A and B are not -1 and 1 */ -/* respectively. Thus to get the "best fit" the */ -/* data was transformed to the interval [-1,1] and */ -/* coefficients generated. These coefficients are */ -/* not rescaled to the interval of the data so that */ -/* the numerical "robustness" of the Chebyshev fit will */ -/* not be lost. Consequently, when the "best fitting" */ -/* polynomial needs to be evaluated at an intermediate */ -/* point, the point of evaluation must be transformed */ -/* in the same way that the generating points were */ -/* transformed. */ - -/* X Value for which the polynomial is to be evaluated. */ - -/* $ Detailed_Output */ - -/* P is the value of the polynomial to be evaluated. It */ -/* is given by */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where T(I,S) is the I'th Chebyshev polynomial */ -/* evaluated at a number S = ( X - X2S(1) )/X2S(2) */ - -/* DPDX is the value of the derivative of the polynomial at X. */ -/* It is given by */ - -/* 1/X2S(2) [ CP(DEGP+1)*T'(DEGP,S) */ -/* + CP(DEGP)*T'(DEGP-1,S) + ... */ -/* . */ -/* . */ -/* . */ -/* ... + CP(2)*T'(1,S) */ -/* + CP(1)*T'(0,S) ] */ - -/* where T(I,S) and T'(I,S) are the I'th Chebyshev */ -/* polynomial and its derivative, respectively, */ -/* evaluated at a number S = ( X - X2S(1) )/X2S(2) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the value of a Chebyshev polynomial */ -/* expansion and the derivative of the expansion with respect to X. */ -/* The polynomial is given by */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where */ - -/* S = ( X - X2S(1) ) / X2S(2) */ - -/* and */ - -/* T(i,S) is the i'th Chebyshev polynomial of the first kind */ -/* evaluated at S. */ - -/* $ Examples */ - - -/* Depending upon the user's needs, there are 3 routines available */ -/* for evaluating Chebyshev polynomials. */ - -/* CHBVAL for evaluating a Chebyshev polynomial when no */ -/* derivatives are desired. */ - -/* CHBINT for evaluating a Chebyshev polynomial and its */ -/* first derivative. */ - -/* CHBDER for evaluating a Chebyshev polynomial and a user */ -/* or application dependent number of derivatives. */ - -/* Of these 3 the one most commonly employed by NAIF software */ -/* is CHBINT as it is used to interpolate ephemeris state */ -/* vectors which requires the evaluation of a polynomial */ -/* and its derivative. When no derivatives are desired one */ -/* should use CHBVAL, or when more than one or an unknown */ -/* number of derivatives are desired one should use CHBDER. */ - -/* The code fragment below illustrates how this routine might */ -/* be used to obtain points for plotting a polynomial */ -/* and its derivatives. */ - -/* fetch the pieces needed for describing the polynomial */ -/* to be evaluated. */ - -/* READ (*,*) DEGP, ( CP(I), I = 1, DEG+1 ), BEG, END */ - -/* check to see that BEG is actually less than END */ - -/* IF ( BEG .GE. END ) THEN */ - -/* take some appropriate action */ - -/* ELSE */ - -/* X2S(1) = ( END + BEG ) / 2.0D0 */ -/* X2S(2) = ( END - BEG ) / 2.0D0 */ - -/* END IF */ - -/* STEP = END - BEG / */ -/* X = BEG */ - -/* DO WHILE ( X .LE. END ) */ - -/* CALL CHBINT ( CP, DEGP, X2S, X, P, DPDX ) */ - -/* do something with the pairs (X,P) and (X,DPDX) */ - -/* X = X + STEP */ - -/* END DO */ - -/* $ Restrictions */ - -/* One needs to be careful that the value (X-X2S(1)) / X2S(2) lies */ -/* between -1 and 1. Otherwise, the routine may fail spectacularly */ -/* (for example with a floating point overflow). */ - -/* $ Exceptions */ - -/* Error free */ - -/* No tests are performed for exceptional values (DEGP negative, */ -/* etc.) This routine is expected to be used at a low level in */ -/* ephemeris evaluations. For that reason it has been elected as a */ -/* routine that will not participate in error handling. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* "Numerical Recipes -- The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* Willam T. Vetterling. (See Clenshaw's Recurrance Formula) */ - -/* "The Chebyshev Polynomials" by Theodore J. Rivlin */ - -/* "CRC Handbook of Tables for Mathematics" */ - -/* $ 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 */ - -/* interpolate a chebyshev expansion */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 30-DEC-1988 (WLT) */ - -/* The Error free specification was added to the routine as */ -/* well as an explanation for this designation. Examples added. */ - -/* -& */ - -/* Local variables */ - - -/* Transform X to S and initialize temporary variables. */ - - s = (*x - x2s[0]) / x2s[1]; - s2 = s * 2.; - j = *degp + 1; - w[0] = 0.; - w[1] = 0.; - dw[0] = 0.; - dw[1] = 0.; - -/* Evaluate the polynomial and its derivative using recursion. */ - - while(j > 1) { - w[2] = w[1]; - w[1] = w[0]; - w[0] = cp[j - 1] + (s2 * w[1] - w[2]); - dw[2] = dw[1]; - dw[1] = dw[0]; - dw[0] = w[1] * 2. + dw[1] * s2 - dw[2]; - --j; - } - *p = cp[0] + (s * w[0] - w[1]); - *dpdx = w[0] + s * dw[0] - dw[1]; - -/* Scale the derivative by 1/X2S(2) so that we have the derivative */ - -/* d P(S) */ -/* ------ */ -/* dX */ - - *dpdx /= x2s[1]; - return 0; -} /* chbint_ */ - diff --git a/ext/spice/src/cspice/chbval.c b/ext/spice/src/cspice/chbval.c deleted file mode 100644 index a16b684dc3..0000000000 --- a/ext/spice/src/cspice/chbval.c +++ /dev/null @@ -1,285 +0,0 @@ -/* chbval.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CHBVAL ( Value of a Chebsheff polynomial expansion ) */ -/* Subroutine */ int chbval_(doublereal *cp, integer *degp, doublereal *x2s, - doublereal *x, doublereal *p) -{ - integer j; - doublereal s, w[3], s2; - -/* $ Abstract */ - -/* Given the coefficients for the Chebyshev expansion of a */ -/* polynomial, this returns the value of the polynomial evaluated */ -/* at the input X. */ - -/* $ 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 */ - -/* INTERPOLATION, MATH, POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CP I NDEG+1 Chebyshev polynomial coefficients. */ -/* DEGP I Degree of polynomial. */ -/* X2S I Transformation parameters of polynomial. */ -/* X I Value for which the polynomial is to be evaluated */ -/* P O Value of the polynomial at X. */ - -/* $ Detailed_Input */ - -/* CP is an array of coefficients a polynomial with respect */ -/* to the Chebyshev basis. The polynomial to be */ -/* evaluated is assumed to be of the form: */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where T(I,S) is the I'th Chebyshev polynomial */ -/* evaluated at a number S whose double precision */ -/* value lies between -1 and 1. The value of S is */ -/* computed from the input variables X2S(1), X2S(2) */ -/* and X. */ - -/* DEGP is the degree of the Chebyshev polynomial to be */ -/* evaluated. */ - -/* X2S is an array of two parameters. These parameters are */ -/* used to transform the domain of the input variable X */ -/* into the standard domain of the Chebyshev polynomial. */ -/* X2S(1) should be a reference point in the domain of X; */ -/* X2S(2) should be the radius by which points are */ -/* allowed to deviate from the reference point and while */ -/* remaining within the domain of X. The value of */ -/* X is transformed into the value S given by */ - -/* S = ( X - X2S(1) ) / X2S(2) */ - -/* Typically X2S(1) is the midpoint of the interval over */ -/* which X is allowed to vary and X2S(2) is the radius of */ -/* the interval. */ - -/* The main reason for doing this is that a Chebyshev */ -/* expansion is usually fit to data over a span */ -/* from A to B where A and B are not -1 and 1 */ -/* respectively. Thus to get the "best fit" the */ -/* data was transformed to the interval [-1,1] and */ -/* coefficients generated. These coefficients are */ -/* not rescaled to the interval of the data so that */ -/* the numerical "robustness" of the Chebyshev fit will */ -/* not be lost. Consequently, when the "best fitting" */ -/* polynomial needs to be evaluated at an intermediate */ -/* point, the point of evaluation must be transformed */ -/* in the same way that the generating points were */ -/* transformed. */ - -/* X Value for which the polynomial is to be evaluated. */ - -/* $ Detailed_Output */ - -/* P The value of the polynomial to be evaluated. It */ -/* is given by */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where T(I,S) is the I'th Chebyshev polynomial */ -/* evaluated at a number S = ( X - X2S(1) )/X2S(2) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the value P given by */ - -/* CP(DEGP+1)*T(DEGP,S) + CP(DEGP)*T(DEGP-1,S) + ... */ - -/* ... + CP(2)*T(1,S) + CP(1)*T(0,S) */ - -/* where */ - -/* S = ( X - X2S(1) ) / X2S(2) */ - -/* and */ - -/* T(i,S) is the i'th Chebyshev polynomial of the first kind */ -/* evaluated at S. */ - -/* $ Examples */ - - -/* Depending upon the user's needs, there are 3 routines available */ -/* for evaluating Chebyshev polynomials. */ - -/* CHBVAL for evaluating a Chebyshev polynomial when no */ -/* derivatives are desired. */ - -/* CHBINT for evaluating a Chebyshev polynomial and its */ -/* first derivative. */ - -/* CHBDER for evaluating a Chebyshev polynomial and a user */ -/* or application dependent number of derivatives. */ - -/* Of these 3 the one most commonly employed by NAIF software */ -/* is CHBINT as it is used to interpolate ephemeris state */ -/* vectors which requires the evaluation of a polynomial */ -/* and its derivative. When no derivatives are desired one */ -/* should use CHBVAL, or when more than one or an unknown */ -/* number of derivatives are desired one should use CHBDER. */ - -/* The code fragment below illustrates how this routine might */ -/* be used to obtain points for plotting a polynomial. */ - -/* fetch the pieces needed for describing the polynomial */ -/* to be evaluated. */ - -/* READ (*,*) DEGP, ( CP(I), I = 1, DEG+1 ), BEG, END */ - -/* check to see that BEG is actually less than END */ - -/* IF ( BEG .GE. END ) THEN */ - -/* take some appropriate action */ - -/* ELSE */ - -/* X2S(1) = ( END + BEG ) / 2.0D0 */ -/* X2S(2) = ( END - BEG ) / 2.0D0 */ - -/* END IF */ - -/* STEP = END - BEG / */ -/* X = BEG */ - -/* DO WHILE ( X .LE. END ) */ - -/* CALL CHBVAL ( CP, DEGP, X2S, X, P ) */ - -/* do something with the pair (X,P) */ - -/* X = X + STEP */ - -/* END DO */ - - -/* $ Restrictions */ - -/* One needs to be careful that the value (X-X2S(1)) / X2S(2) lies */ -/* between -1 and 1. Otherwise, the routine may fail spectacularly */ -/* (for example with a floating point overflow). */ - -/* $ Exceptions */ - -/* Error free */ - -/* No tests are performed for exceptional values (DEGP negative, */ -/* etc.) This routine is expected to be used at a low level in */ -/* ephemeris evaluations. For that reason it has been elected as a */ -/* routine that will not participate in error handling. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* "Numerical Recipes -- The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* Willam T. Vetterling. */ - -/* "The Chebyshev Polynomials" by Theodore J. Rivlin */ - -/* "CRC Handbook of Tables for Mathematics" */ - -/* $ 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 (WMO) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* value of a chebyshev polynomial expansion */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 30-DEC-1988 (WLT) */ - -/* The Error free specification was added to the routine as */ -/* well as an explanation for this designation. Examples added. */ - -/* -& */ - -/* Local variables */ - - -/* Transform X to S and initialize temporary variables. */ - - s = (*x - x2s[0]) / x2s[1]; - s2 = s * 2.; - j = *degp + 1; - w[0] = 0.; - w[1] = 0.; - -/* Evaluate the polynomial using recursion. */ - - while(j > 1) { - w[2] = w[1]; - w[1] = w[0]; - w[0] = cp[j - 1] + (s2 * w[1] - w[2]); - --j; - } - *p = s * w[0] - w[1] + cp[0]; - return 0; -} /* chbval_ */ - diff --git a/ext/spice/src/cspice/chckid.c b/ext/spice/src/cspice/chckid.c deleted file mode 100644 index 841c5645dd..0000000000 --- a/ext/spice/src/cspice/chckid.c +++ /dev/null @@ -1,276 +0,0 @@ -/* chckid.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CHCKID ( Check ID string ) */ -/* Subroutine */ int chckid_(char *class__, integer *maxlen, char *id, ftnlen - class_len, ftnlen id_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, l; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer chrcod; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Validate an ID string: check for non-printing characters */ -/* or excessive non-blank length. */ - -/* $ 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 */ - -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CLASS I A description of the class to which ID belongs. */ -/* MAXLEN I Maximum allowed non-blank length of ID. */ -/* ID I The ID string to be validated. */ - -/* $ Detailed_Input */ - -/* CLASS is a descriptive string indicating the type of */ -/* object represented by ID. Examples are */ -/* 'SPK segment identifier', 'DAF internal file name', */ -/* or 'EK table name'. */ - -/* If the input ID is found to be invalid, CLASS is */ -/* used in the error message generated by this */ -/* routine. */ - -/* MAXLEN is the maximum allowed non-blank length of the */ -/* input ID string. If ID has any non-blank */ -/* characters at positions greater than MAXLEN, */ -/* an error will be signalled. */ - -/* ID is the input ID string to be checked. In order */ -/* to be considered valid, ID must contain only */ -/* printing characters and must satisfy the condition */ - -/* LASTNB( ID ) < MAXLEN */ -/* - */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If ID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 2) If MAXLEN is non-positive, the error SPICE(INVALIDCOUNT) is */ -/* signalled. */ - -/* 3) If ID contains any non-blank characters past position */ -/* MAXLEN, the error SPICE(IDSTRINGTOOLONG) is signalled. */ - -/* 4) If CLASS contains any non-printing characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 5) CLASS is allowed to be blank. The word 'ID' is used in */ -/* place of the class string in any error messages in this */ -/* case. */ - -/* 6) Error messages signalled by this routine have a maximum */ -/* length of 320 characters. If substitution of CLASS and */ -/* ID into the long messages causes overflow, the messages */ -/* will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it validates an ID string */ -/* and signals an error if the ID has either of the following */ -/* problems: */ - -/* - There are non-printing characters in the ID string. */ - -/* - The last non-blank character in the string occurs at a */ -/* location having index higher than a specified value. */ - -/* The error message signalled by this routine contains the offending */ -/* ID string and indicates the class of item to which ID belongs. */ -/* The form of the message is: */ - -/* The <'ID'> is invalid; */ - -/* $ Examples */ - -/* 1) If */ - -/* CLASS = 'segment identifier' */ -/* MAXLEN = 40 */ - -/* and */ - -/* ID = 'Example EK created on March 28, 1995 by NJB/NAIF' */ - -/* the error message */ - -/* The segment identifier 'Example EK created on March 28, */ -/* 1995 by NJB/NAIF' is invalid; the last non-blank character */ -/* is located at position 48. */ - -/* will be signalled. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-JUN-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* check an ID string */ -/* validate an ID string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CHCKID", (ftnlen)6); - } - -/* Check CLASS before trying to use it in an error message. */ - - i__ = frstnp_(class__, class_len); - if (i__ > 0) { - chrcod = *(unsigned char *)&class__[i__ - 1]; - setmsg_("The class string '#' is invalid; this string contains a non" - "-printing character (ICHAR = #) at position #.", (ftnlen)105); - errch_("#", class__, (ftnlen)1, class_len); - errint_("#", &chrcod, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CHCKID", (ftnlen)6); - return 0; - } - -/* MAXLEN must be a sensible value. */ - - if (*maxlen < 1) { - setmsg_("Non-blank length limit MAXLEN should be positive but was #.", - (ftnlen)59); - errint_("#", maxlen, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("CHCKID", (ftnlen)6); - return 0; - } - l = lastnb_(id, id_len); - -/* The ID must not be too long. */ - - if (l > *maxlen) { - setmsg_("The # '#' is invalid; the last non-blank character is locat" - "ed at position #; the maximum allowed length is #.", (ftnlen) - 109); - if (s_cmp(class__, " ", class_len, (ftnlen)1) != 0) { - errch_("#", class__, (ftnlen)1, class_len); - } else { - errch_("#", "ID", (ftnlen)1, (ftnlen)2); - } - errch_("#", id, (ftnlen)1, id_len); - errint_("#", &l, (ftnlen)1); - errint_("#", maxlen, (ftnlen)1); - sigerr_("SPICE(IDSTRINGTOOLONG)", (ftnlen)22); - chkout_("CHCKID", (ftnlen)6); - return 0; - } - -/* Look for non-printing characters in ID. */ - - i__ = frstnp_(id, id_len); - if (i__ > 0) { - chrcod = *(unsigned char *)&id[i__ - 1]; - setmsg_("The # '#' is invalid; this string contains a non-printing c" - "haracter (ICHAR = #) at position #.", (ftnlen)94); - if (s_cmp(class__, " ", class_len, (ftnlen)1) != 0) { - errch_("#", class__, (ftnlen)1, class_len); - } else { - errch_("#", "ID", (ftnlen)1, (ftnlen)2); - } - errch_("#", id, (ftnlen)1, id_len); - errint_("#", &chrcod, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CHCKID", (ftnlen)6); - return 0; - } - chkout_("CHCKID", (ftnlen)6); - return 0; -} /* chckid_ */ - diff --git a/ext/spice/src/cspice/chgirf.c b/ext/spice/src/cspice/chgirf.c deleted file mode 100644 index 3de395f92f..0000000000 --- a/ext/spice/src/cspice/chgirf.c +++ /dev/null @@ -1,1601 +0,0 @@ -/* chgirf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b6 = 0.; -static integer c__1 = 1; -static integer c__9 = 9; -static integer c__21 = 21; - -/* $Procedure CHGIRF ( Change inertial reference frames ) */ -/* Subroutine */ int chgirf_0_(int n__, integer *refa, integer *refb, - doublereal *rotab, char *name__, integer *index, ftnlen name_len) -{ - /* Initialized data */ - - static logical ready = FALSE_; - static char frames[16*21] = "J2000 " "B1950 " "FK4 " - " " "DE-118 " "DE-96 " "DE-102 " - " " "DE-108 " "DE-111 " "DE-114 " - "DE-122 " "DE-125 " "DE-130 " "GALACT" - "IC " "DE-200 " "DE-202 " "MARSIAU " - " " "ECLIPJ2000 " "ECLIPB1950 " "DE-140 " - "DE-142 " "DE-143 "; - static char bases[16*21] = "J2000 " "J2000 " "B1950 " - " " "B1950 " "B1950 " "B1950 " - " " "B1950 " "B1950 " "B1950 " - "B1950 " "B1950 " "B1950 " "FK4 " - " " "J2000 " "J2000 " "J2000 " - " " "J2000 " "B1950 " "J2000 " - "J2000 " "J2000 "; - static char defs[80*21] = "0.0 1 " - " " "1152.84248596724 3 -1002." - "26108439117 2 1153.04066200330 3 " "0.525 " - "3 " - " " "0.53155 3 " - " " "0.4107 3 " - " " "0.1359 3 " - " " - " " "0.4775 3 " - " " "0.5880 3 " - " " "0.5529 3 " - " " - "0.5316 3 " - " " "0.5754 3 " - " " "0.5247 3 " - " " "117720" - "0.0 3 225360.0 1 1016100.0 3 " - " " "0.0 3 " - " " "0.0 3 " - " " "324000.0D0 3 " - "133610.4D0 2 -152348.4D0 3 " - " " "84381.448 1 " - " " "84404.836 1 " - " " "1152.71013777252 3 " - "-1002.25042010533 2 1153.75719544491 3 " - "1152.72061453864 3 -1002.25052830351 2 1153.74663857521 3 " - " " "1153.03919093833, 3, -1002.24822382286, 2, 1" - "153.42900222357, 3 "; - static integer dframe = 0; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer axis; - static char word[25]; - extern /* Subroutine */ int mxmt_(doublereal *, doublereal *, doublereal * - ); - static integer b, i__, j, p; - static doublereal angle; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - extern integer wdcnt_(char *, ftnlen); - extern /* Subroutine */ int nthwd_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - static doublereal trans[189] /* was [9][21] */; - static char error[25]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static doublereal radang; - extern integer esrchc_(char *, integer *, char *, ftnlen, ftnlen), - isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen), sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), rotate_(doublereal *, integer *, doublereal *); - static doublereal tmpmat[9] /* was [3][3] */; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), rotmat_(doublereal *, doublereal *, integer *, - doublereal *), convrt_(doublereal *, char *, char *, doublereal * - , ftnlen, ftnlen); - extern logical return_(void); - static integer loc; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Support changes among a standard set of inertial coordinate */ -/* reference frames. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* EPHEMERIS */ -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* REFA I IRFROT */ -/* REFB I IRFROT */ -/* ROTAB O IRFROT */ -/* NAME I/O IRFNUM, IRFNAM, IRFDEF */ -/* INDEX I/O IRFNUM, IRFNAM */ - -/* $ Detailed_Input */ - -/* See entry points IRFROT, IRFNUM, IRFNAM, and IRFDEF. */ - -/* $ Detailed_Output */ - -/* See entry points IRFROT, IRFNUM, and IRFNAM. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If CHGIRF is called directly, the signal SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* 2) See entry points IRFROT, IRFNUM, IRFNAM, and IRFDEF for */ -/* exceptions specific to those routines. */ - -/* $ Particulars */ - -/* CHGIRF exists only as an umbrella for data to be shared */ -/* by its entry points (IRFROT, IRFNUM, IRFNAM, and IRFDEF). */ -/* It should never be called directly. */ - -/* $ Examples */ - -/* See entry points IRFROT, IRFNUM, IRFNAM, and IRFDEF. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Jay Lieske, ``Precession Matrix Based on IAU (1976) */ -/* System of Astronomical Constants,'' Astron. Astrophys. */ -/* 73, 282-284 (1979). */ - -/* [2] E.M. Standish, Jr., ``Orientation of the JPL Ephemerides, */ -/* DE 200/LE 200, to the Dynamical Equinox of J2000,'' */ -/* Astron. Astrophys. 114, 297-302 (1982). */ - -/* [3] E.M. Standish, Jr., ``Conversion of Ephemeris Coordinates */ -/* from the B1950 System to the J2000 System,'' JPL IOM */ -/* 314.6-581, 24 June 1985. */ - -/* [4] E.M. Standish, Jr., ``The Equinox Offsets of the JPL */ -/* Ephemeris,'' JPL IOM 314.6-929, 26 February 1988. */ - -/* [5] Jay Lieske, ``Expressions for the Precession Quantities */ -/* Based upon the IAU (1976) System of Astronomical */ -/* Constants'' Astron. Astrophys. 58, 1-16 (1977). */ - -/* [6] Laura Bass and Robert Cesarone "Mars Observer Planetary */ -/* Constants and Models" JPL D-3444 November 1990. */ - -/* [7] "Explanatory Supplement to the Astronomical Almanac" */ -/* edited by P. Kenneth Seidelmann. University Science */ -/* Books, 20 Edgehill Road, Mill Valley, CA 94941 (1992) */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.3.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CONVRT, ROTMAT and MXM calls. */ - -/* - SPICELIB Version 4.2.1, 04-JAN-2002 (EDW) */ - -/* Added DE-143 to header description for IRFROT. */ - -/* - SPICELIB Version 4.2.0, 10-APR-1997 (WLT) */ - -/* A descriptive diagnostic was added to the entry points */ -/* IRFROT and IRFDEF. Before they simply signalled the error */ -/* with no diagnostic. */ - -/* - SPICELIB Version 4.1.0, 14-OCT-1996 (WLT) */ - -/* The number of inertial frames recognized is now stored */ -/* in the include file ninert.inc. */ - -/* - SPICELIB Version 4.0.0, 20-MAY-1996 (WLT) */ - -/* The inertial frame DE-143 was added to the list of recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1995 (WLT) */ - -/* The inertial frames DE-140 and DE-142 were added to the */ -/* list of recognized inertial frames. */ - -/* - SPICELIB Version 2.0.0, 30-JUL-1993 (WLT) */ - -/* The transformation from J2000 to B1950 was upgraded */ -/* so that the transformation matrix produced matches */ -/* the matrix given in [1]. */ - -/* The frame MARSIAU was added to the list */ -/* of recognized frames. This is the standard mars */ -/* referenced inertial frame used by the Mars Observer */ -/* project. */ - -/* Values for the obliquity of the ecliptic were taken */ -/* from the Explanatory Supplement [7] to the Astronomical */ -/* Almanac (1992) at both the epochs J2000 and B1950 and */ -/* used to define the mean ecliptic and equinox frames */ -/* ECLIPJ2000 and ECLIPB1950. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* change inertial reference frames */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.3.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CONVRT, ROTMAT and MXM calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Each frame is defined in terms of another frame, except for */ -/* the root frame, which is defined in terms of itself. For now, */ -/* the root frame is the standard IAU reference frame, J2000, */ -/* defined by the Earth mean equator and dynamical equinox of */ -/* Julian year 2000. */ - -/* Each definition consists of a series of rotations, each */ -/* through some angle (in arc seconds) and about some axis. */ -/* The rotations are listed in the opposite order in which */ -/* they are to be performed, so as to correspond more closely */ -/* to conventional notation. For example, the definition */ - -/* FRAMES(i) = 'F2' */ -/* BASES(i) = 'F1' */ -/* DEFS(i) = '22.34 3 31.21 2 0.449 1' */ - -/* means that a vector in frame F1 is converted to the equivalent */ -/* vector in frame F2 by applying the following rotation: */ - -/* - - */ -/* v = ( [ 22.34 ] [ 31.21 ] [ 0.449 ] ) v */ -/* F2 3 2 1 F1 */ - -/* where the notation */ - -/* [ theta ] */ -/* a */ - -/* means ``rotate through angle theta about axis a.'' */ - -/* New frames may be added by: */ - -/* 1) Increasing the value of MAXF. */ - -/* 2) Adding new values for FRAMES, BASES, and DEFS. */ - -/* The actual transformations (TRANS) will be computed during */ -/* initialization. */ - -/* Note that BASES must be the name of a previously defined */ -/* reference frame, and that no frame should appear more than */ -/* once in FRAMES. */ - -/* Note also that the list of valid reference frames maintained */ -/* by CHGIRF must be updated whenever new frames are added. */ - - /* Parameter adjustments */ - if (rotab) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_irfrot; - case 2: goto L_irfnum; - case 3: goto L_irfnam; - case 4: goto L_irfdef; - } - - -/* The root frame is mostly for show. Rotate by 0 arc seconds */ -/* about the x-axis to obtain the identity matrix. */ - - -/* The B1950 reference frame is obtained by precessing the J2000 */ -/* frame backwards from Julian year 2000 to Besselian year 1950, */ -/* using the 1976 IAU precession model. */ - -/* The rotation from B1950 to J2000 is */ - -/* [ -z ] [ theta ] [ -zeta ] */ -/* 3 2 3 */ - -/* So the rotation from J2000 to B1950 is the transpose, */ - -/* [ zeta ] [ -theta ] [ z ] */ -/* 3 2 3 */ - -/* The values for z, theta, and zeta are taken directly from */ -/* are computed from the formulas given in table 5 of [5]. */ - -/* z = 1153.04066200330" */ -/* theta = -1002.26108439117" */ -/* zeta = 1152.84248596724" */ - - -/* The FK4 reference frame is derived from the B1950 frame by */ -/* applying the equinox offset determined by Fricke. This is just */ -/* the rotation */ - -/* [ 0.525" ] */ -/* 3 */ - - -/* The DE-118 reference frame is nearly identical to the FK4 */ -/* reference frame. It is also derived from the B1950 frame. */ -/* Only the offset is different: */ - -/* [ 0.53155" ] */ -/* 3 */ - -/* In [2], Standish uses two separate rotations, */ - -/* [ 0.00073" ] P [ 0.5316" ] */ -/* 3 3 */ - -/* (where P is the precession matrix used above to define the */ -/* B1950 frame). The major effect of the second rotation is to */ -/* correct for truncating the magnitude of the first rotation. */ -/* At his suggestion, we will use the untruncated value, and */ -/* stick to a single rotation. */ - - -/* Most of the other DE reference frames may be defined relative */ -/* to either the DE-118 or B1950 frames. The values below are taken */ -/* from [4]. */ - -/* DE number Offset from DE-118 Offset from B1950 */ -/* --------- ------------------ ----------------- */ -/* 96 +0.1209" +0.4107" */ -/* 102 +0.3956" +0.1359" */ -/* 108 +0.0541" +0.4775" */ -/* 111 -0.0564" +0.5880" */ -/* 114 -0.0213" +0.5529" */ -/* 122 +0.0000" +0.5316" */ -/* 125 -0.0438" +0.5754" */ -/* 130 +0.0069" +0.5247" */ - -/* We will use B1950 for now, since the offsets generally have */ -/* more significant digits. */ - - -/* The Galactic System II reference frame is defined by the */ -/* following rotations: */ - -/* o o o */ -/* [ 327 ] [ 62.6 ] [ 282.25 ] */ -/* 3 1 3 */ - -/* In the absence of better information, we will assume that */ -/* it is derived from the FK4 frame. Converting the angles from */ -/* degrees to arc seconds, */ - -/* o */ -/* 327 = 1177200" */ -/* o */ -/* 62.6 = 225360" */ -/* o */ -/* 282.25 = 1016100" */ - - -/* According to Standish, the various DE-200 frames are identical */ -/* with J2000, because he rotates the ephemerides before releasing */ -/* them (in order to avoid problems like the one that this routine */ -/* is designed to solve). Because we have to have something, we */ -/* will use */ - -/* o */ -/* [ 0.0 ] */ -/* 3 */ - - -/* The values for the transformation from J2000 to MARSIAU_MO */ -/* are derived from the constants given for the pole of Mars */ -/* on page 8-2 of reference [6]. */ - - -/* The value for the obliquity of the ecliptic at J2000 is */ -/* taken from page 114 of [7] equation 3.222-1. This agrees */ -/* with the expression given in [5] */ - - -/* The value for the obliquity of the ecliptic at B1950 is */ -/* taken from page 171 of [7]. */ - - -/* The frame for DE-140 is simply DE-400 rotated by the rotation: */ - -/* 0.9999256765384668 0.0111817701197967 0.0048589521583895 */ -/* -0.0111817701797229 0.9999374816848701 -0.0000271545195858 */ -/* -0.0048589520204830 -0.0000271791849815 0.9999881948535965 */ - -/* Note that the DE-400 frame is J2000. */ - -/* The transpose of this is the frame from DE140 to DE400. To get */ -/* the euler angles below, the matrix given above was copied into */ -/* a matrix XFORM. */ - -/* This matrix was transposed to give the transformation from */ -/* DE-140 to J2000. */ - -/* CALL XPOSE ( XFORM, XFORM ) */ - -/* Using the SPICE routine M2EUL, the euler representation of the */ -/* transformation from DE140 to J2000 was constructed. */ - -/* CALL M2EUL ( XFORM, 3, 2, 3, A1, A2, A3 ) */ - -/* Angles were converted to the range from -180 to 180 degrees */ -/* and converted to arcseconds. At this point we have the */ -/* euler representation from DE-140 to J2000. */ - -/* [ A1 ] [ A2 ] [ A3 ] */ -/* 3 2 3 */ - -/* To get the Euler representation of the transformation from */ -/* J2000 to DE-140 we use. */ - -/* [ -A3 ] [ -A2 ] [ -A1 ] */ -/* 3 2 3 */ - -/* This method was used because it yields a nicer form of */ -/* representation than the straight forward transformation. */ -/* Note that these numbers are quite close to the values used */ -/* for the transformation from J2000 to B1950 */ - - -/* The frame for DE-142 is simply DE-402 rotated by the rotation: */ - -/* 0.9999256765402605 0.0111817697320531 0.0048589526815484 */ -/* -0.0111817697907755 0.9999374816892126 -0.0000271547693170 */ -/* -0.0048589525464121 -0.0000271789392288 0.9999881948510477 */ - -/* Note that the DE-402 frame is J2000. */ - -/* The Euler angles giving the transformation for J2000 to */ -/* DE-142 were constructed in the same way as the transformation */ -/* from J2000 to DE140. Only the input matrix changed to use the */ -/* one given above. */ - - -/* The frame for DE-143 is simply DE-403 rotated by the rotation: */ - -/* 0.9999256765435852 0.0111817743077255 0.0048589414674762 */ -/* -0.0111817743300355 0.9999374816382505 -0.0000271622115251 */ -/* -0.0048589414161348 -0.0000271713942366 0.9999881949053349 */ - -/* Note that the DE-403 frame is J2000. */ - -/* The Euler angles giving the transformation for J2000 to */ -/* DE-143 were constructed in the same way as the transformation */ -/* from J2000 to DE140. Only the input matrix changed to use the */ -/* one given above. */ - - -/* Until defined (by a call to IRFDEF), the default frame is */ -/* undefined. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CHGIRF", (ftnlen)6); - } - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("CHGIRF", (ftnlen)6); - return 0; -/* $Procedure IRFROT ( Inertial reference frame rotation ) */ - -L_irfrot: -/* $ Abstract */ - -/* Compute the matrix needed to rotate vectors between two */ -/* standard inertial reference frames. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* EPHEMERIS */ -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ -/* VECTOR */ - -/* $ Declarations */ - -/* INTEGER REFA */ -/* INTEGER REFB */ -/* DOUBLE PRECISION ROTAB ( 3,3 ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* REFA, */ -/* REFB I Indices of target reference frames (A,B). */ -/* MATRIX O Rotation from frame A to frame B. */ - -/* $ Detailed_Input */ - -/* REFA, */ -/* REFB are the indices of two standard inertial reference */ -/* frames. The complete set of supported frames is shown */ -/* below. */ - -/* Index Name Description */ -/* ----- -------- -------------------------------- */ -/* 1 J2000 Earth mean equator, dynamical */ -/* equinox of J2000 */ - -/* 2 B1950 Earth mean equator, dynamical */ -/* equinox of B1950 */ - -/* 3 FK4 Fundamental Catalog (4) */ - -/* 4 DE-118 JPL Developmental Ephemeris (118) */ - -/* 5 DE-96 JPL Developmental Ephemeris ( 96) */ - -/* 6 DE-102 JPL Developmental Ephemeris (102) */ - -/* 7 DE-108 JPL Developmental Ephemeris (108) */ - -/* 8 DE-111 JPL Developmental Ephemeris (111) */ - -/* 9 DE-114 JPL Developmental Ephemeris (114) */ - -/* 10 DE-122 JPL Developmental Ephemeris (122) */ - -/* 11 DE-125 JPL Developmental Ephemeris (125) */ - -/* 12 DE-130 JPL Developmental Ephemeris (130) */ - -/* 13 GALACTIC Galactic System II */ - -/* 14 DE-200 JPL Developmental Ephemeris (200) */ - -/* 15 DE-202 JPL Developmental Ephemeris (202) */ - -/* 16 MARSIAU Mars Observer inertial frame */ -/* defined relative to MARS. */ - -/* 17 ECLIPJ2000 Earth mean ecliptic and equinox */ -/* of the epoch J2000 */ - -/* 18 ECLIPB1950 Earth mean ecliptic and equinox */ -/* of the Besselian date 1950. */ - -/* 19 DE-140 JPL Developmental Ephemeris (140) */ - -/* 20 DE-142 JPL Developmental Ephemeris (142) */ - -/* 21 DE-143 JPL Developmental Ephemeris (143) */ - -/* $ Detailed_Output */ - -/* ROTAB is the rotation which, when applied to a vector v */ -/* in reference frame A, */ -/* _ _ */ -/* v = (ROTAB) v */ -/* B A */ - -/* yields the same vector in reference frame B. The */ -/* inverse rotation is performed by applying the */ -/* transpose, */ -/* _ T _ */ -/* v = (ROTAB) v */ -/* A B */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either REFA or REFB is outside the range [1,MAXF], */ -/* where MAXF is the number of supported frames, the error */ -/* SPICE(IRFNOTREC) is signalled. */ - -/* $ Particulars */ - -/* IRFROT exists primarily for use by the ephemeris and star */ -/* catalog readers in the SPICELIB toolkit library. */ - -/* $ Examples */ - -/* In the following code fragment, IRFROT is used to rotate */ -/* vectors originally referenced to the DE-118 coordinate frame */ -/* to equivalent vectors referenced to the IAU standard J2000 */ -/* reference frame. */ - -/* CALL IRFROT ( 4, 1, R ) */ - -/* CALL MXV ( R, SC1950, SC2000 ) */ -/* CALL MXV ( R, MP1950, MP2000 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See subroutine CHGIRF. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.1, 04-JAN-2002 (EDW) */ - -/* Added DE-143 to header description for IRFROT. */ - -/* - SPICELIB Version 4.2.0, 10-APR-1997 (WLT) */ - -/* A descriptive diagnostic was added to the entry points */ -/* IRFROT and IRFDEF. Before they simply signalled the error */ -/* with no diagnostic. */ - -/* - SPICELIB Version 4.1.0, 14-OCT-1996 (WLT) */ - -/* The number of inertial frames recognized is now stored */ -/* in the include file ninert.inc. */ - -/* - SPICELIB Version 4.0.0, 20-MAY-1996 (WLT) */ - -/* The inertial frame DE-143 was added to the list of recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1995 (WLT) */ - -/* The inertial frames DE-140 and DE-142 were added to the */ -/* list of recognized inertial frames. */ - -/* - SPICELIB Version 2.0.0, 30-JUL-1993 (WLT) */ - -/* The transformation from J2000 to B1950 was upgraded */ -/* so that the transformation matrix produced matches */ -/* the matrix given in [1]. */ - -/* The frame MARSIAU was added to the list */ -/* of recognized frames. This is the standard mars */ -/* referenced inertial frame used by the Mars Observer */ -/* project. */ - -/* Values for the obliquity of the ecliptic were taken */ -/* from the Explanatory Supplement [7] to the Astronomical */ -/* Almanac (1992) at both the epochs J2000 and B1950 and */ -/* used to define the mean ecliptic and equinox frames */ -/* ECLIPJ2000 and ECLIPB1950. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* inertial reference frame rotation */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("IRFROT", (ftnlen)6); - } - -/* If it has not been done already, construct the transformation */ -/* from the root frame to each supported reference frame. */ - -/* Begin by constructing the identity matrix (rotating by zero */ -/* radians about the x-axis). Apply the rotations indicated in */ -/* the frame definition (from right to left) to get the incremental */ -/* rotation from the base frame. The final rotation is */ - -/* R = (R ) (R ) */ -/* root->frame base->frame root->base */ - - if (! ready) { - for (i__ = 1; i__ <= 21; ++i__) { - rotate_(&c_b6, &c__1, &trans[(i__1 = i__ * 9 - 9) < 189 && 0 <= - i__1 ? i__1 : s_rnge("trans", i__1, "chgirf_", (ftnlen) - 868)]); - for (j = wdcnt_(defs + ((i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 - : s_rnge("defs", i__1, "chgirf_", (ftnlen)870)) * 80, ( - ftnlen)80); j >= 2; j += -2) { - nthwd_(defs + ((i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("defs", i__1, "chgirf_", (ftnlen)872)) * 80, & - j, word, &loc, (ftnlen)80, (ftnlen)25); - nparsi_(word, &axis, error, &p, (ftnlen)25, (ftnlen)25); - i__2 = j - 1; - nthwd_(defs + ((i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("defs", i__1, "chgirf_", (ftnlen)875)) * 80, & - i__2, word, &loc, (ftnlen)80, (ftnlen)25); - nparsd_(word, &angle, error, &p, (ftnlen)25, (ftnlen)25); - convrt_(&angle, "ARCSECONDS", "RADIANS", &radang, (ftnlen)10, - (ftnlen)7); - rotmat_(&trans[(i__1 = i__ * 9 - 9) < 189 && 0 <= i__1 ? i__1 - : s_rnge("trans", i__1, "chgirf_", (ftnlen)880)], & - radang, &axis, tmpmat); - moved_(tmpmat, &c__9, &trans[(i__1 = i__ * 9 - 9) < 189 && 0 - <= i__1 ? i__1 : s_rnge("trans", i__1, "chgirf_", ( - ftnlen)881)]); - } - b = isrchc_(bases + (((i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("bases", i__1, "chgirf_", (ftnlen)885)) << 4), & - i__, frames, (ftnlen)16, (ftnlen)16); - mxm_(&trans[(i__1 = i__ * 9 - 9) < 189 && 0 <= i__1 ? i__1 : - s_rnge("trans", i__1, "chgirf_", (ftnlen)887)], &trans[( - i__2 = b * 9 - 9) < 189 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "chgirf_", (ftnlen)887)], tmpmat); - moved_(tmpmat, &c__9, &trans[(i__1 = i__ * 9 - 9) < 189 && 0 <= - i__1 ? i__1 : s_rnge("trans", i__1, "chgirf_", (ftnlen) - 888)]); - } - ready = TRUE_; - } - -/* If the transformations have been defined, we can proceed with */ -/* the business at hand: determining the rotation from one frame */ -/* to another. To get from frame A to frame B, the rotation is */ - -/* T */ -/* R = (R ) (R ) */ -/* A->B root->B root->A */ - -/* If A and B are the same frame, the rotation is just the identity. */ -/* In theory, computing */ - -/* T */ -/* R = (R ) (R ) */ -/* A->A root->A root->A */ - -/* should work, but why risk roundoff problems? */ - - if (*refa < 1 || *refa > 21) { - setmsg_("A request has been made to obtain the transformation from i" - "nertial reference frame # to inertial reference frame #. Unf" - "ortunately # is not the id-code of a known inertial frame. ", - (ftnlen)178); - errint_("#", refa, (ftnlen)1); - errint_("#", refb, (ftnlen)1); - errint_("#", refa, (ftnlen)1); - sigerr_("SPICE(IRFNOTREC)", (ftnlen)16); - } else if (*refb < 1 || *refb > 21) { - setmsg_("A request has been made to obtain the transformation from i" - "nertial reference frame # to inertial reference frame #. Unf" - "ortunately # is not the id-code of a known inertial frame. ", - (ftnlen)178); - errint_("#", refa, (ftnlen)1); - errint_("#", refb, (ftnlen)1); - errint_("#", refb, (ftnlen)1); - sigerr_("SPICE(IRFNOTREC)", (ftnlen)16); - } else if (*refa == *refb) { - rotate_(&c_b6, &c__1, rotab); - } else { - mxmt_(&trans[(i__1 = *refb * 9 - 9) < 189 && 0 <= i__1 ? i__1 : - s_rnge("trans", i__1, "chgirf_", (ftnlen)943)], &trans[(i__2 = - *refa * 9 - 9) < 189 && 0 <= i__2 ? i__2 : s_rnge("trans", - i__2, "chgirf_", (ftnlen)943)], rotab); - } - chkout_("IRFROT", (ftnlen)6); - return 0; -/* $Procedure IRFNUM ( Inertial reference frame number ) */ - -L_irfnum: -/* $ Abstract */ - -/* Return the index of one of the standard inertial reference */ -/* frames supported by IRFROT. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* EPHEMERIS */ -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ -/* VECTOR */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER INDEX */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of standard inertial reference frame. */ -/* INDEX O Index of frame. */ - -/* $ Detailed_Input */ - -/* NAME is the name of one of the standard inertial */ -/* reference frames supported by IRFROT, or */ -/* 'DEFAULT'. */ - -/* $ Detailed_Output */ - -/* INDEX is the index of the frame specified by NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is not recognized, INDEX is zero. */ - -/* 2) If no default frame has been specified, INDEX is zero. */ - -/* $ Particulars */ - -/* IRFNUM is supplied as a convenience, to allow users to refer to */ -/* the various standard inertial reference frames by name. */ - -/* $ Examples */ - -/* In the following example, the rotation from DE-118 to FK4 is */ -/* computed without knowing the indices of these frames. */ - -/* CALL IRFNUM ( 'DE-118', A ) */ -/* CALL IRFNUM ( 'FK4', B ) */ - -/* CALL IRFROT ( A, B, ROTAB ) */ - -/* IRFNUM can be used to rotate vectors into the default frame, */ -/* as illustrated by the following code fragment. */ - -/* CALL IRFNUM ( 'FK4', A ) */ -/* CALL IRFNUM ( 'DEFAULT', B ) */ - -/* CALL IRFROT ( A, B, ROTAB ) */ -/* CALL MXV ( ROTAB, OLDVEC, NEWVEC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See subroutine CHGIRF. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.1, 04-JAN-2002 (EDW) */ - -/* Added DE-143 to header description for IRFROT. */ - -/* - SPICELIB Version 4.2.0, 10-APR-1997 (WLT) */ - -/* A descriptive diagnostic was added to the entry points */ -/* IRFROT and IRFDEF. Before they simply signalled the error */ -/* with no diagnostic. */ - -/* - SPICELIB Version 4.1.0, 14-OCT-1996 (WLT) */ - -/* The number of inertial frames recognized is now stored */ -/* in the include file ninert.inc. */ - -/* - SPICELIB Version 4.0.0, 20-MAY-1996 (WLT) */ - -/* The inertial frame DE-143 was added to the list of recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1995 (WLT) */ - -/* The inertial frames DE-140 and DE-142 were added to the */ -/* list of recognized inertial frames. */ - -/* - SPICELIB Version 2.0.0, 30-JUL-1993 (WLT) */ - -/* The transformation from J2000 to B1950 was upgraded */ -/* so that the transformation matrix produced matches */ -/* the matrix given in [1]. */ - -/* The frame MARSIAU was added to the list */ -/* of recognized frames. This is the standard mars */ -/* referenced inertial frame used by the Mars Observer */ -/* project. */ - -/* Values for the obliquity of the ecliptic were taken */ -/* from the Explanatory Supplement [7] to the Astronomical */ -/* Almanac (1992) at both the epochs J2000 and B1950 and */ -/* used to define the mean ecliptic and equinox frames */ -/* ECLIPJ2000 and ECLIPB1950. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* inertial reference frame number */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("IRFNUM", (ftnlen)6); - } - if (eqstr_(name__, "DEFAULT", name_len, (ftnlen)7)) { - *index = dframe; - } else { - *index = esrchc_(name__, &c__21, frames, name_len, (ftnlen)16); - } - chkout_("IRFNUM", (ftnlen)6); - return 0; -/* $Procedure IRFNAM ( Inertial reference frame name ) */ - -L_irfnam: -/* $ Abstract */ - -/* Return the name of one of the standard inertial reference */ -/* frames supported by IRFROT. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* EPHEMERIS */ -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ -/* VECTOR */ - -/* $ Declarations */ - -/* INTEGER INDEX */ -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INDEX I Index of standard inertial reference frame. */ -/* NAME O Name of frame. */ - -/* $ Detailed_Input */ - -/* INDEX is the index of one of the standard inertial */ -/* reference frames supported by IRFROT. */ - -/* $ Detailed_Output */ - -/* NAME is the name of the frame specified by INDEX. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If INDEX is not the index of a supported frame, NAME is blank. */ - -/* $ Particulars */ - -/* IRFNAM is supplied as a convenience, to allow users to determine */ -/* the names of standard inertial reference frames referred to only */ -/* by index (as in the segment descriptors of a GEF ephemeris file). */ - -/* $ Examples */ - -/* In the following example, the identity of a rotation from DE-118 */ -/* to FK4 is deduced from the indices used to create the rotation. */ - -/* CALL IRFROT ( A, B, ROTAB ) */ - -/* CALL IRFNAM ( A, NAME(1) ) */ -/* CALL IRFNAM ( B, NAME(2) ) */ - -/* WRITE (6,*) 'Rotation from ' // NAME(1) // ' to ' // NAME(2) */ - -/* Note that the name of the default reference frame can only be */ -/* recovered from the number: */ - -/* CALL IRFNUM ( 'DEFAULT', DINDEX ) */ -/* CALL IRFNAM ( DINDEX, DNAME ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See subroutine CHGIRF. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.1, 04-JAN-2002 (EDW) */ - -/* Added DE-143 to header description for IRFROT. */ - -/* - SPICELIB Version 4.2.0, 10-APR-1997 (WLT) */ - -/* A descriptive diagnostic was added to the entry points */ -/* IRFROT and IRFDEF. Before they simply signalled the error */ -/* with no diagnostic. */ - -/* - SPICELIB Version 4.1.0, 14-OCT-1996 (WLT) */ - -/* The number of inertial frames recognized is now stored */ -/* in the include file ninert.inc. */ - -/* - SPICELIB Version 4.0.0, 20-MAY-1996 (WLT) */ - -/* The inertial frame DE-143 was added to the list of recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1995 (WLT) */ - -/* The inertial frames DE-140 and DE-142 were added to the */ -/* list of recognized inertial frames. */ - -/* - SPICELIB Version 2.0.0, 30-JUL-1993 (WLT) */ - -/* The transformation from J2000 to B1950 was upgraded */ -/* so that the transformation matrix produced matches */ -/* the matrix given in [1]. */ - -/* The frame MARSIAU was added to the list */ -/* of recognized frames. This is the standard mars */ -/* referenced inertial frame used by the Mars Observer */ -/* project. */ - -/* Values for the obliquity of the ecliptic were taken */ -/* from the Explanatory Supplement [7] to the Astronomical */ -/* Almanac (1992) at both the epochs J2000 and B1950 and */ -/* used to define the mean ecliptic and equinox frames */ -/* ECLIPJ2000 and ECLIPB1950. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* inertial reference frame name */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("IRFNAM", (ftnlen)6); - } - if (*index < 1 || *index > 21) { - s_copy(name__, " ", name_len, (ftnlen)1); - } else { - s_copy(name__, frames + (((i__1 = *index - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("frames", i__1, "chgirf_", (ftnlen)1348)) << 4), - name_len, (ftnlen)16); - } - chkout_("IRFNAM", (ftnlen)6); - return 0; -/* $Procedure IRFDEF ( Inertial reference frame, default ) */ - -L_irfdef: -/* $ Abstract */ - -/* Specify a standard inertial reference frame as the default */ -/* frame for a program. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* EPHEMERIS */ -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ -/* VECTOR */ - -/* $ Declarations */ - -/* INTEGER INDEX */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INDEX I Index of default frame. */ - -/* $ Detailed_Input */ - -/* INDEX is the index of one of the standard inertial */ -/* reference frames supported by IRFROT. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If INDEX is outside the range [1,MAXF], where MAXF is the */ -/* number of supported frames, the error SPICE(IRFNOTREC) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* IRFDEF allows tools to be written at a relatively high level */ -/* without requiring the reference frame to be tramp coupled or */ -/* placed in global memory. */ - -/* $ Examples */ - -/* Typically, the calling program will select a default frame */ -/* during initialization, */ - -/* C */ -/* C Use J2000 for all ephemeris, star data. */ -/* C */ -/* CALL IRFDEF ( 1 ) */ - -/* and recover the default frame at lower levels, */ - -/* C */ -/* C Rotate all vectors into the default frame. */ -/* C */ -/* CALL IRFNUM ( 'DEFAULT', REFD ) */ - -/* DO I = 1, NVEC */ -/* CALL IRFROT ( REFIN, REFD, ROT ) */ -/* CALL MXV ROT, VEC, VEC ) */ -/* END DO */ - -/* Note that many utilities accept 'DEFAULT' as the name of */ -/* an inertial reference frame, */ - -/* CALL SPKEZ ( TARGET, ..., 'DEFAULT', ... ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See subroutine CHGIRF. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.1, 04-JAN-2002 (EDW) */ - -/* Added DE-143 to header description for IRFROT. */ - -/* - SPICELIB Version 4.2.0, 10-APR-1997 (WLT) */ - -/* A descriptive diagnostic was added to the entry points */ -/* IRFROT and IRFDEF. Before they simply signalled the error */ -/* with no diagnostic. */ - -/* - SPICELIB Version 4.1.0, 14-OCT-1996 (WLT) */ - -/* The number of inertial frames recognized is now stored */ -/* in the include file ninert.inc. */ - -/* - SPICELIB Version 4.0.0, 20-MAY-1996 (WLT) */ - -/* The inertial frame DE-143 was added to the list of recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1995 (WLT) */ - -/* The inertial frames DE-140 and DE-142 were added to the */ -/* list of recognized inertial frames. */ - -/* - SPICELIB Version 2.0.0, 30-JUL-1993 (WLT) */ - -/* The transformation from J2000 to B1950 was upgraded */ -/* so that the transformation matrix produced matches */ -/* the matrix given in [1]. */ - -/* The frame MARSIAU was added to the list */ -/* of recognized frames. This is the standard mars */ -/* referenced inertial frame used by the Mars Observer */ -/* project. */ - -/* Values for the obliquity of the ecliptic were taken */ -/* from the Explanatory Supplement [7] to the Astronomical */ -/* Almanac (1992) at both the epochs J2000 and B1950 and */ -/* used to define the mean ecliptic and equinox frames */ -/* ECLIPJ2000 and ECLIPB1950. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* inertial reference frame default */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("IRFDEF", (ftnlen)6); - } - -/* There's not much to do, except save the value for later use. */ - - if (*index < 1 || *index > 21) { - setmsg_("The reference frame with id-code # is not a recognized iner" - "tial reference frame. ", (ftnlen)81); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(IRFNOTREC)", (ftnlen)16); - } else { - dframe = *index; - } - chkout_("IRFDEF", (ftnlen)6); - return 0; -} /* chgirf_ */ - -/* Subroutine */ int chgirf_(integer *refa, integer *refb, doublereal *rotab, - char *name__, integer *index, ftnlen name_len) -{ - return chgirf_0_(0, refa, refb, rotab, name__, index, name_len); - } - -/* Subroutine */ int irfrot_(integer *refa, integer *refb, doublereal *rotab) -{ - return chgirf_0_(1, refa, refb, rotab, (char *)0, (integer *)0, (ftnint)0) - ; - } - -/* Subroutine */ int irfnum_(char *name__, integer *index, ftnlen name_len) -{ - return chgirf_0_(2, (integer *)0, (integer *)0, (doublereal *)0, name__, - index, name_len); - } - -/* Subroutine */ int irfnam_(integer *index, char *name__, ftnlen name_len) -{ - return chgirf_0_(3, (integer *)0, (integer *)0, (doublereal *)0, name__, - index, name_len); - } - -/* Subroutine */ int irfdef_(integer *index) -{ - return chgirf_0_(4, (integer *)0, (integer *)0, (doublereal *)0, (char *) - 0, index, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/chkin_c.c b/ext/spice/src/cspice/chkin_c.c deleted file mode 100644 index 7589a27df6..0000000000 --- a/ext/spice/src/cspice/chkin_c.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - --Procedure chkin_c ( module Check In ) - --Abstract - - Inform the CSPICE error handling mechanism of entry into a - routine. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void chkin_c ( ConstSpiceChar * module ) - -/* --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- --------------------------------------------------- - module I The name of the calling routine. - --Detailed_Input - - module is the name of the routine calling chkin_c. The - named routine is supposed to be `checking in' - when it calls chkin_c; that is, the call should be - the first executable statement following the - reference to the function return_c() (which should be - the first executable statement). - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 2) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - - The underlying f2c'd CSPICE routine chkin_ does not signal errors; - rather it writes error messages, so as to avoid recursion. The - errors detected by chkin_ are: - - 3) If the traceback storage area overflows, the short error - message "SPICE(TRACEBACKOVERFLOW)" is written to the error - output device. - - 4) If the input argument module is blank, the short error message - SPICE(BLANKMODULENAME) is written to the error output device. - --Files - - None. - --Particulars - - This routine is part of the CSPICE error handling mechanism. - - Conceptually, the effect of this routine is to `push' the - supplied module name onto a stack. The routine chkout_c performs - the inverse, or `pop', operation. - - Every routine that participates in the traceback scheme should - have a call to chkin_c as the second executable statement. The - first executable statements should be: - - if ( return_c() ) - { - return; - } - else - { - chkin_c ( module ); - } - - - Here module is the name of the routine in which this code appears. - - The line of code preceding the exit or any return statement should - be - - chkout_c ( module ); - - - All CSPICE routines should call chkin_c and chkout_c, unless they - are classified as `error free'. Programs linked with CSPICE - may also use chkin_c and chkout_c. - - Routines that don't call chkin_c and chkout_c won't appear in the - traceback. - - All routines that call chkin_c must also call chkout_c, or else the - trace mechanism will become very confused and require therapy. - - It is possible to disable check-ins (and check-outs) by calling - the trcoff_c. chkin_c and chkout_c will return immediately - upon entry after trcoff_c has been called. It is not possible to - re-enable check-ins and check-outs after calling trcoff_c. Routines - that don't call chkin_c and chkout_c won't appear in the traceback. - --Examples - - See `Particulars' for an example of how to call this routine. - --Restrictions - - Routines that call this routine must call chkout_c immediately - prior to any return or exit statement. - - module names are assumed to have no embedded blanks. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 2.0.3, 23-JUL-2001 (NJB) - - Tabs removed from source file. - - -CSPICE Version 2.0.2, 25-MAR-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 2.0.0, 09-JAN-1998 (NJB) - - Input argument filename was changed to type ConstSpiceChar *. - - Re-implemented routine without dynamically allocated, temporary - strings. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - module check in - --& -*/ - -{ /* Begin chkin_c */ - - - /* - Check the input string module to make sure the pointer is non-null - and the string length is non-zero. Use discovery check-in. If an - error is found, this wrapper will be called recursively, but that - should not cause a problem. - */ - CHKFSTR ( CHK_DISCOVER, "chkin_c", module ); - - - /* - Call the f2c'd Fortran routine. - */ - chkin_ ( ( char * ) module, - ( ftnlen ) strlen(module) ); - - - -} /* end chkin_c */ diff --git a/ext/spice/src/cspice/chkout_c.c b/ext/spice/src/cspice/chkout_c.c deleted file mode 100644 index 275eeacab4..0000000000 --- a/ext/spice/src/cspice/chkout_c.c +++ /dev/null @@ -1,215 +0,0 @@ -/* - --Procedure chkout_c ( Module Check Out ) - --Abstract - - Inform the CSPICE error handling mechanism of exit from a - routine. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void chkout_c ( ConstSpiceChar * module ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - module I The name of the calling routine. - --Detailed_Input - - module is the name of the routine calling chkout_c. The - named routine is supposed to be `checking out' - when it calls chkout_c; that is, the call should be - the last executable statement preceding any exit - from the routine. - --Detailed_Output - - None. - --Parameters - - None. - - --Exceptions - - chkout_c does not signal errors; rather it writes error messages, - so as to avoid recursion. - - 1) If the input module name module does not match the name popped - from the trace stack, the short error message - SPICE(NAMESDONOTMATCH) is written to the error output device. - - 2) If the trace stack is empty, the short error message - SPICE(TRACESTACKEMPTY) is written to the error output device. - --Files - - None. - --Particulars - - This routine is part of the CSPICE error handling mechanism. - - Conceptually, the effect of this routine is to `pop' a module - name from a stack. The routine chkin_c performs the inverse, or - `push' operation. - - Every routine that participates in the traceback scheme should - have a call to chkin_c as the second executable statement. - The first executable statements should be: - - if ( return_c() ) - { - return; - } - else - { - chkin_c ( module ); - } - - - Here module is the name of the routine in which this code appears. - - The line of code preceding the exit or any return statement - should be - - chkout_c ( module ); - - All CSPICE routines should call chkin_c and chkout_c, unless they - are classified as `error free'. Programs linked with CSPICE - may also use chkin_c and chkout_c. - - Routines that don't call chkin_c and chkout_c won't appear in the - traceback. - - All routines that call chkin_c must also call chkout_c, or else the - trace mechanism will become very confused and need alot of therapy. - - It is possible to disable check-ins (and check-outs) by calling - the trcoff_c. chkin_c and chkout_c will return immediately - upon entry after trcoff_c has been called. It is not possible to - re-enable check-ins and check-outs after calling trcoff_c. Routines - that don't call chkin_c and chkout_c won't appear in the traceback. - --Examples - - 1) Call chkout_c before a return statement: - - if ( failed() ) - { - chkout_c ( module ); - return; - } - - - 2) Call chkout_c before an exit statement: - - chkout_c ( module ); - exit; - - - 3) Only ONE call to chkout_c is needed here: - - chkout_c ( module ) ; - return; - - --Restrictions - - Routines that call this routine must call chkin_c as the second - executable statement. (The first is a call to return_c() ). - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 2.0.0, 09-JAN-1998 (NJB) - - Input argument filename was changed to type ConstSpiceChar *. - - Re-implemented routine without dynamically allocated, temporary - strings. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - module check out - --& -*/ - -{ /* Begin chkout_c */ - - /* - Check the input string module to make sure the pointer is non-null - and the string length is non-zero. Use discovery check-in. If an - error is found, this wrapper will be called recursively, but that - should not cause a problem. - */ - CHKFSTR ( CHK_DISCOVER, "chkout_c", module ); - - /* - Call the f2c'd Fortran routine. - */ - chkout_ ( ( char * ) module, - ( ftnlen ) strlen(module) ); - - -} /* End chkout_c */ diff --git a/ext/spice/src/cspice/cidfrm_c.c b/ext/spice/src/cspice/cidfrm_c.c deleted file mode 100644 index cb635acdf9..0000000000 --- a/ext/spice/src/cspice/cidfrm_c.c +++ /dev/null @@ -1,216 +0,0 @@ -/* - --Procedure cidfrm_c ( center SPK ID frame ) - --Abstract - - Retrieve frame ID code and name to associate with a frame center. - --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 - - FRAMES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void cidfrm_c ( SpiceInt cent, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - cent I An object to associate a frame with. - lenout I Available space in output string frname. - frcode O The ID code of the frame associated with cent. - frname O The name of the frame with ID frcode. - found O SPICETRUE if the requested information is available. - --Detailed_Input - - cent is the ID code for object for which there is a - preferred reference frame. - - lenout is the available space in the output string frname, - including room for the terminating null character. - --Detailed_Output - - frcode is the frame ID code to associate with the object - specified by cent. - - frname is the name of the frame that should be associated - with the object specified by cent. - - found is SPICETRUE if the appropriate frame ID code and frame - name can be determined. Otherwise found is returned - with the value SPICEFALSE. - --Parameters - - None. - --Files - - None. - --Exceptions - - None. - --Particulars - - This routine allows the user to determine the frame that should - be associated with a particular object. For example, if you - need the frame to associate with the Io, you can call cidfrm_c - to determine the frame name and ID code for the bodyfixed frame - of Io. - - The preferred frame to use with an object is specified via one - of the kernel pool variables: - - OBJECT__FRAME - - where is the decimal representation of the integer cent. - - For those PCK objects that have "built-in" frame names this - routine returns the corresponding "IAU" frame and frame ID code. - --Examples - - Suppose that you want to determine the state of a target in the - preferred reference frame of some observer. This routine can be - used in conjunction with spkezr_c to compute the state. - - #include - #include - #include "SpiceUsr.h" - - #define LENOUT 32 - . - . - . - - cidfrm_c ( obs, LENOUT, &frcode, frname, &found ); - - if ( !found ) - { - printf ( "The bodyfixed frame for object %d\n" - "could not be identified.\n", - obs ); - exit(1); - } - - spkezr_c ( targ, et, frname, abcorr, obs, state, < ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 22-JUL-1999 (NJB) (WLT) - --Index_Entries - - Fetch reference frame attributes - --& -*/ - -{ /* Begin cidfrm_c */ - - /* - Local variables - */ - logical fnd; - - - - /* - Participate in error tracing. - */ - chkin_c ( "cidfrm_c" ); - - - /* - Check the output string to make sure the pointer is non-null and that - there is room for at least one character plus a null terminator. - */ - CHKOSTR ( CHK_STANDARD, "cidfrm_c", frname, lenout ); - - - /* - Call the f2c'd routine. - */ - - cidfrm_ ( ( integer * ) ¢, - ( integer * ) frcode, - ( char * ) frname, - ( logical * ) &fnd, - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, frname ); - - - /* - Set the SpiceBoolean found flag. - */ - - *found = fnd; - - - chkout_c ( "cidfrm_c" ); - -} /* End cidfrm_c */ diff --git a/ext/spice/src/cspice/ckbsr.c b/ext/spice/src/cspice/ckbsr.c deleted file mode 100644 index a4b8e1aa04..0000000000 --- a/ext/spice/src/cspice/ckbsr.c +++ /dev/null @@ -1,4222 +0,0 @@ -/* ckbsr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__50000 = 50000; -static integer c__1000 = 1000; -static integer c__5 = 5; -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKBSR ( C-kernel, buffer segments for readers ) */ -/* Subroutine */ int ckbsr_0_(int n__, char *fname, integer *handle, integer * - inst, doublereal *sclkdp, doublereal *tol, logical *needav, - doublereal *descr, char *segid, logical *found, ftnlen fname_len, - ftnlen segid_len) -{ - /* Initialized data */ - - static logical fresub = FALSE_; - static integer nft = 0; - static integer nit = 0; - static integer next = 0; - static integer savep = 0; - static doublereal savtol = 0.; - static char status[40] = "BOGUS ENTRY "; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - integer head, tail; - static doublereal itlb[100], itub[100]; - integer cost; - static doublereal reqt; - integer i__, j; - extern /* Subroutine */ int dafgn_(char *, ftnlen); - integer cheap, p; - extern /* Subroutine */ int dafgs_(doublereal *); - static doublereal alpha, omega; - static integer itbeg[100], slbeg; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - static integer fthan[1000]; - static doublereal stdcd[100000] /* was [2][50000] */; - char doing[40], stack[40*2]; - static integer sticd[300000] /* was [6][50000] */; - extern doublereal dpmin_(void), dpmax_(void); - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - static integer ithfs[100], sthan[50000]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - static integer itlfs[100]; - extern /* Subroutine */ int lnkan_(integer *, integer *); - extern integer lnktl_(integer *, integer *); - static integer itins[100], ftnum[1000], itexp[100]; - extern /* Subroutine */ int daffna_(logical *), dafbbs_(integer *), - daffpa_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), cleard_(integer *, - doublereal *), dafcls_(integer *); - logical fndhan; - static logical avneed; - extern /* Subroutine */ int lnkila_(integer *, integer *, integer *), - dafopr_(char *, integer *, ftnlen); - static integer findex; - extern /* Subroutine */ int lnkilb_(integer *, integer *, integer *); - extern integer isrchi_(integer *, integer *, integer *); - static integer iindex; - static logical itchkp[100]; - extern /* Subroutine */ int lnkini_(integer *, integer *); - extern integer lnknfn_(integer *); - static logical newsch; - extern /* Subroutine */ int lnkfsl_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - extern integer intmax_(void); - integer minexp; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static char stidnt[40*50000]; - char urgent[40]; - static doublereal itprvd[500] /* was [5][100] */; - static integer itprvf[100]; - integer nxtseg; - extern integer lnkprv_(integer *, integer *); - static char itprvi[40*100]; - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - static integer itprvh[100], itruex[100], stpool[100012] /* was [2][ - 50006] */, scinst; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - doublereal dcd[2]; - integer icd[6]; - static logical fnd; - integer new__; - static integer top; - -/* $ Abstract */ - -/* Load and unload files for use by the readers. Buffer segments */ -/* for readers. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I CKLPF */ -/* HANDLE I,O CKLPF, CKUPF, CKSNS */ -/* INST I CKBSS */ -/* SCLKDP I CKBSS */ -/* TOL I CKBSS */ -/* NEEDAV I CKBSS */ -/* DESCR O CKSNS */ -/* SEGID O CKSNS */ -/* FOUND O CKSNS */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a binary C-kernel file to be loaded. */ - -/* HANDLE on input is the handle of a binary C-kernel file to be */ -/* unloaded. */ - - -/* The purpose of entry points CKBSS and CKSNS is to search for */ -/* segments in CK files matching certain criteria. The four */ -/* quantities below establish these search criteria. */ - - -/* INST is the NAIF ID of an instrument. */ - -/* SCLKDP is an encoded spacecraft clock time. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* NEEDAV indicates whether or not angular velocity data are */ -/* required. */ - -/* If true, only segments containing pointing and angular */ -/* velocity data will be checked. If false, segments */ -/* containing just pointing data will also be considered. */ - - -/* A segment matches the CKBSS/CKSNS search criteria when the */ -/* following statements are true. */ - -/* 1) INST matches the instrument number for the segment. */ - -/* 2) The time interval [SCLKDP - TOL, SCLKDP + TOL] intersects */ -/* the time interval of the segment. */ - -/* 3) If angular velocity data are required, as indicated by */ -/* NEEDAV, the segment contains angular velocity data. */ - - -/* $ Detailed_Output */ - -/* HANDLE on output is the handle of the C-kernel file */ -/* containing a located segment. */ - -/* DESCR is the packed descriptor of a located segment. */ - -/* SEGID is the identifier of a located segment. */ - -/* FOUND indicates whether a requested segment was found or not. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of pointing files that can */ -/* be loaded by CKLPF at any given time for use by the */ -/* readers. */ - -/* ITSIZE is the maximum number of instruments whose segments */ -/* are buffered by CKSNS. */ - -/* STSIZE is the maximum number of segments that can be buffered */ -/* at any given time by CKSNS. */ - -/* $ Exceptions */ - -/* 1) If CKBSR is called directly, the error SPICE(CKBOGUSENTRY) */ -/* is signaled. */ - -/* 2) See entry points CKLPF, CKUPF, CKBSS, and CKSNS for exceptions */ -/* specific to them. */ - -/* $ Files */ - -/* C-kernel pointing files are indicated by filename before loading */ -/* (see CKLPF) and handle after loading (all other places). */ - -/* $ Particulars */ - -/* CKBSR serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* CKLPF Load pointing file. */ -/* CKUPF Unload pointing file. */ -/* CKBSS Begin search for segment. */ -/* CKSNS Select next segment. */ - -/* Before a file can be read by the C-kernel readers, it must be */ -/* loaded by CKLPF, which among other things load the file into */ -/* the DAF subsystem. */ - -/* Up to FTSIZE files may be loaded for use simultaneously, and a */ -/* file only has to be loaded once to become a potential search */ -/* target for any number of subsequent reads. */ - -/* Once a C-kernel has been loaded, it is assigned a file */ -/* handle, which is used to keep track of the file internally, and */ -/* which is used by the calling program to refer to the file in all */ -/* subsequent calls to CK routines. */ - -/* A file may be removed from the list of files for potential */ -/* searching by unloading it via a call to CKUPF. */ - -/* CKBSS and CKSNS are used together to search through loaded files */ -/* for segments. */ - -/* CKBSS sets up the search. You tell it the instrument and time */ -/* that you are interested in, and whether you require segments */ -/* containing angular velocity data. */ - -/* CKSNS finds segments matching the search criteria set up by */ -/* CKBSS. Last-loaded files get searched first, and individual files */ -/* are searched backwards. */ - -/* When an applicable segment is found, CKSNS returns that segment's */ -/* descriptor and identifier, along with the handle of the file */ -/* containing the segment. */ - -/* Subsequent calls to CKSNS continue the search, picking up where */ -/* the previous call to this routine left off. */ - -/* CKSNS uses information on loaded files to manage a buffer */ -/* of saved segment descriptors and identifiers. The buffer is used */ -/* to speed up access time by minimizing file reads. */ - -/* $ Examples */ - -/* Suppose that pointing data for the Voyager 2 narrow angle camera */ -/* for a certain interval of time are contained in three separate */ -/* files: ORIGINAL.CK contains an original complete set of pointing */ -/* data and UPDATE_1.CK and UPDATE_2.CK contain two separate pointing */ -/* updates for certain pictures in the same time period. */ - -/* In the following example, pointing from the C-kernel is extracted */ -/* in two different ways for the purpose of comparing the two */ -/* updates: */ - -/* First, the original pointing file and one of the update files are */ -/* both loaded and pointing is retrieved for all of the pictures. */ -/* The update file is searched through first, and if no data for the */ -/* desired picture is located, then the original file provides the */ -/* requested pointing. */ - -/* Then, the first update file is unloaded, the second update file */ -/* is loaded, and the same search is performed, as above. */ - -/* Throughout the two searches, a ficticious non-SPICELIB routine */ -/* named WRTABL writes an entry into a table that contains */ -/* the pointing of the camera and the file from which the pointing */ -/* came, if such pointing was found. WRERR, another ficticious, */ -/* non-SPICELIB routine writes an error message if no such pointing */ -/* was found. */ - -/* It is assumed that an array (FDS) exists that contains character */ -/* representations of the spacecraft clock time for each picture, */ -/* and that there are NPICS pictures. */ - -/* INTEGER NPICS */ -/* PARAMETER ( NPICS = 100 ) */ - -/* INTEGER HANDLE */ -/* INTEGER HNORIG */ -/* INTEGER HUPDT */ -/* INTEGER UPDATE */ -/* INTEGER INST */ -/* INTEGER SC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ - -/* CHARACTER*(12) FDS ( NPICS ) */ -/* CHARACTER*(25) FNAME */ -/* CHARACTER*(40) SEGID */ -/* CHARACTER*(12) OUTFDS */ -/* CHARACTER*(12) TOLSTR */ -/* CHARACTER*(25) UDFILE ( 2 ) */ - -/* LOGICAL PFOUND */ -/* LOGICAL SFOUND */ -/* LOGICAL NEEDAV */ - - -/* UDFILE ( 1 ) = 'UPDATE_1.CK' */ -/* UDFILE ( 2 ) = 'UPDATE_2.CK' */ - -/* C */ -/* C The NAIF integer ID codes for the Voyager 2 spacecraft */ -/* C and the narrow angle camera on Voyager 2 are -32 and */ -/* C -32001, respectively. */ -/* C */ -/* SC = -32 */ -/* INST = -32001 */ -/* C */ -/* C Load the Voyager SCLK file. */ -/* C */ -/* CALL FURNSH ( 'VG2_SCLK.TSC' ) */ - -/* C */ -/* C Allow a time tolerance of 400 line counts. Convert */ -/* C the tolerance to 'ticks', the units of encoded spacecraft */ -/* C clock time. */ -/* C */ -/* TOLSTR = '0:00:400' */ -/* CALL SCTIKS ( SC, TOLSTR, TOL ) */ - -/* C */ -/* C Don't care about angular velocity data. */ -/* C */ -/* NEEDAV = .FALSE. */ - -/* C */ -/* C Load the original CK file first. */ -/* C */ -/* CALL CKLPF ( 'ORIGINAL.CK', HNORIG ) */ - - -/* DO UPDATE = 1, 2 */ -/* C */ -/* C Load the update file. Last-loaded files get searched */ -/* C first, so the update file will be searched before */ -/* C the original file. */ -/* C */ -/* CALL CKLPF ( UDFILE ( UPDATE ), HUPDT ) */ - -/* DO I = 1, NPICS */ - -/* C */ -/* C Encode the character string representation of */ -/* C spacecraft clock time in FDS. */ -/* C */ -/* CALL SCENCD ( SC, FDS( I ), SCLKDP ) */ - -/* C */ -/* C Begin a search for this instrument and time, and */ -/* C get the first applicable segment. */ -/* C */ -/* CALL CKBSS ( INST, SCLKDP, TOL, NEEDAV ) */ -/* CALL CKSNS ( HANDLE, DESCR, SEGID, SFOUND ) */ - -/* C */ -/* C Keep trying candidate segments until a segment can */ -/* C produce a pointing instance within the specified */ -/* C time tolerance of SCLKDP, the encoded spacecraft */ -/* C clock time. */ -/* C */ -/* PFOUND = .FALSE. */ - -/* DO WHILE ( SFOUND .AND. ( .NOT. PFOUND ) ) */ - -/* CALL CKPFS ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . CMAT, AV, CLKOUT, PFOUND ) */ - -/* IF ( PFOUND ) THEN */ - -/* C Get the name of the file from whence the */ -/* C pointing instance came, decode the spacecraft */ -/* C clock time associated with the instance, and */ -/* C write the results to the table. */ -/* C */ -/* CALL DAFHFN ( HANDLE, FNAME ) */ -/* CALL SCDECD ( SC, CLKOUT, OUTFDS ) */ - -/* CALL WRTABL ( FDS( I ), OUTFDS, CMAT, FNAME ) */ - -/* ELSE */ -/* C */ -/* C Look for another candidate segment. */ -/* C */ -/* CALL CKSNS ( HANDLE, DESCR, SEGID, SFOUND ) */ - -/* END IF */ - -/* END DO */ - -/* IF ( .NOT. PFOUND ) THEN */ - -/* CALL WRERR ( FDS( I ) ) */ - -/* END IF */ - -/* END DO */ - -/* C */ -/* C Unload the update file. The original file stays loaded. */ -/* C */ -/* CALL CKUPF ( HUPDT ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) If Fortran I/O errors occur while searching a loaded CK */ -/* file, the internal state of this suite of routines may */ -/* be corrupted. It may be possible to correct the state */ -/* by unloading the pertinent CK files and then re-loading */ -/* them. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.4.0, 07-APR-2010 (NJB) */ - -/* Increased STSIZE to 50000. */ - -/* - SPICELIB Version 4.3.1, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section */ -/* of the CKHAVE entry point header. */ - -/* - SPICELIB Version 4.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments in */ -/* MOVED calls in entry points CKUPF and CKSNS. Replaced header */ -/* reference to LDPOOL with reference to FURNSH. */ - -/* - SPICELIB Version 4.2.0, 30-DEC-2004 (NJB) */ - -/* Increased STSIZE to 20000. */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single CK file, and the list is */ -/* too large to be buffered, the corresponding instrument */ -/* table pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current instrument index when instrument */ -/* table entries having empty segment lists were compressed */ -/* out of the instrument table. Previously the instrument */ -/* table pointer IINDEX could go stale after the */ -/* compression. */ - -/* 3) When a already loaded kernel is re-opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 4) The load routine CKLPF now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby */ -/* avoiding arithmetic overflow. */ - -/* 5) The unload routine CKUPF now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* 6) In CKSNS, DAF calls are followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The instrument table size has been increased to 100 in order */ -/* to decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* - SPICELIB Version 4.0.0, 17-FEB-2000 (WLT) */ - -/* Added the Entry point CKHAVE */ - -/* - SPICELIB Version 3.0.0, 03-MAR-1999 (WLT) */ - -/* The parameter STSIZE was increased from 1000 to 4000 to */ -/* avoid the buffering error that exists in the CKBSR. */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) When loading a file, CKLPF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that CKLPF and CKUPF clean up the instrument */ -/* tables after a file is unloaded was fixed. */ - -/* 3) Variable declarations were added to the example program */ -/* so that it can now be compiled. */ - -/* 4) The length of the elements in the array of segment */ -/* indentifiers ( STIDNT ) was changed from 56 to 40. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 01-NOV-1990 (JML) */ - -/* An intial value was assigned to the variable STATUS so */ -/* that an error will be signaled if CKSNS is called */ -/* without CKBSS ever having been called to initiate the */ -/* search. */ - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* buffer ck segments for readers */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments in */ -/* MOVED calls in entry points CKUPF and CKSNS. Replaced header */ -/* reference to LDPOOL with reference to FURNSH. */ - -/* - SPICELIB Version 4.2.0, 30-DEC-2004 (NJB) */ - -/* Increased STSIZE to 20000. */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single CK file, and the list is */ -/* too large to be buffered, the corresponding instrument */ -/* table pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current instrument index when instrument */ -/* table entries having empty segment lists were compressed */ -/* out of the instrument. Previously the instrument table */ -/* pointer IINDEX could go stale after the compression. */ - -/* 3) When a already loaded kernel is re-opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 4) The load routine CKLPF now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby */ -/* avoiding arithmetic overflow. */ - -/* 5) The unload routine CKUPF now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* 6) In CKSNS, DAF calls are followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. For each instrument, the associated */ -/* re-use interval marks the time interval containing the previous */ -/* request time for which the previously returned segment provides */ -/* the highest-priority data available. */ -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The instrument table size has been increased to 100 in order */ -/* to decrease the chance of thrashing due to swapping segment */ -/* lists for different instruments. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* In order to simplify the source code, the in-line singly */ -/* linked list implementation of the segment table has been */ -/* replaced by an implementation relying on the SPICELIB */ -/* doubly linked list routines. */ - - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) When loading a file, CKLPF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that CKLPF and CKUPF clean up the instrument */ -/* tables after a file is unloaded was fixed. */ - -/* 3) Variable declarations were added to the example program */ -/* so that it can now be compiled. */ - -/* 4) The length of the elements in the array of segment */ -/* indentifiers ( STIDNT ) was changed from 56 to 40. */ - -/* - SPICELIB Version 1.1.0, 01-NOV-1990 (JML) */ - -/* An intial value was assigned to the variable STATUS so */ -/* that an error will be signaled if CKSNS is called */ -/* without CKBSS ever having been called to initiate the */ -/* search. */ - - -/* - Beta Version 1.1.0, 28-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable SCLK was changed to SCLKDP. */ -/* 2) The variable IDENT was changed to SEGID. */ -/* 3) The parameterized values for FTSIZE and ITSIZE were */ -/* increased from 5 to 20. */ -/* 4) The paramterized value for STSIZE was increased from 100 */ -/* to 1000. */ -/* 5) The local variables INTDES and DPDES were changed to */ -/* ICD and DCD. */ -/* 6) The extended SAVE statement was broken in to single */ -/* SAVE statements. */ -/* 7) Header and internal documentation was corrected and */ -/* updated. */ - -/* - Beta Version 1.0.0, 14-MAR-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* ND is the number of double precision components in an */ -/* unpacked C-kernel descriptor. */ - -/* NI is the number of integer components in an unpacked */ -/* C-kernel descriptor. */ - -/* DSCSIZ is the number of components in a packed C-kernel */ -/* descriptor. All DAF summaries have this formulaic */ -/* relationship between the number of its integer and */ -/* double precision components and the number of packed */ -/* components. */ - - -/* Constants used in the doubly linked list structure: */ - - -/* Local variables */ - - -/* The file table contains the handle and file number of each file */ -/* that has been loaded for use with the CK readers. File */ -/* numbers begin at one, and are incremented until they reach a */ -/* value of INTMAX() - 1, at which point they are mapped to the */ -/* range 1:NFT, where NFT is the number of loaded CK files. */ - -/* A file number is similar to a file handle, but it is assigned */ -/* and used exclusively by this module. The purpose of file numbers */ -/* is to keep track of the order in which files are loaded and the */ -/* order in which they are searched. */ - -/* All names begin with FT. */ - -/* HAN Handle */ -/* NUM File number */ - -/* NFT is the number of currently loaded CK files. NEXT is */ -/* incremented whenever a new file is loaded to give the file */ -/* number for that file. FINDEX is the index of whatever file is */ -/* of current interest. */ - -/* New files are added at the end of the table. As files are */ -/* removed, succeeding files are moved forward to take up the */ -/* slack. This keeps the table ordered by file number. */ - - -/* The instrument table contains the beginning of the list of the */ -/* stored segments for each spacecraft/instrument pair, and the */ -/* expense at which that list was constructed. (The expense of an */ -/* instrument list is the number of segment descriptors examined */ -/* during the construction of the list.) It also contains the */ -/* highest and lowest file numbers searched during the construction */ -/* of the list. */ - -/* For each instrument, the time bounds of the "re-use interval" */ -/* of the last segment found are stored. This interval is the */ -/* maximal interval containing the epoch of the last request for */ -/* data for this instrument, such that the interval is not masked */ -/* by higher-priority segments. The handle, segment descriptor, */ -/* and segment identifier returned on the last request are also */ -/* stored. */ - -/* The reuse-interval is computed without regard to presence of */ -/* angular velocity: all segments seen while searching for */ -/* a segment satisfying a request are used to define the bounds */ -/* of the re-use interval. */ - -/* Re-use intervals are defined on the *first* search following */ -/* a setup call to CKBSS. If a search is resumed (multiple calls */ -/* to CKSNS are made consecutively), the re-use interval becomes */ -/* invalid after the first CKSNS call. */ - -/* All names begin with IT. */ - -/* INS Spacecraft/instrument number */ -/* EXP Expense */ -/* HFS Highest file (number) searched */ -/* LFS Lowest file (number) searched */ -/* BEG Beginning of segment list */ -/* LB Lower bound of effective coverage interval of */ -/* previous segment returned. */ -/* UB Upper bound of effective coverage interval of */ -/* previous segment returned. */ -/* PRVD Previous descriptor. */ -/* PRVF Previous descriptor angular velocity flag. Angular */ -/* velocity is present when ITPRVF is non-zero. */ -/* PRVI Previous segment identifier returned. */ -/* PRVH Previous handle returned. */ -/* CHKP Logical indicating that previous segment should */ -/* be checked to see whether it satisfies a request. */ -/* RUEX Expense of the re-use interval. */ - -/* NIT is the number of instruments for which segments are currently */ -/* being stored in the table. IINDEX is the index of whatever */ -/* instrument is of current interest at any given time. */ - -/* New instruments are added at the end of the table. As instruments */ -/* are removed, the last instrument is moved forward to take up the */ -/* slack. This keeps the entries in the table contiguous. */ - - -/* The segment table contains the handle, descriptor, and identifier */ -/* for each segment that has been found so far. */ - -/* The segment table is implemented as a set of arrays indexed by */ -/* a SPICE doubly linked list structure. For each instrument */ -/* in the instrument table, there is a segment table list; each */ -/* node of a list points to data associated with a segment. In */ -/* each list, the head node corresponds to the highest-priority */ -/* segment in that list, and segment priority decreases in the */ -/* forward direction. */ - -/* All names begin with ST. */ - -/* IDNT Identifier */ -/* DCD Double Precision component of descriptor */ -/* HAN Handle */ -/* ICD Integer component of descriptor */ -/* POOL Doubly linked list pool. */ - -/* New segments are added to the front or end of an instrument list */ -/* as appropriate, according to the rules spelled out under */ -/* entry point CKSNS. */ - - -/* Other local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (descr) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_cklpf; - case 2: goto L_ckupf; - case 3: goto L_ckbss; - case 4: goto L_cksns; - case 5: goto L_ckhave; - } - - -/* Nobody has any business calling CKBSR directly. */ - - if (return_()) { - return 0; - } - chkin_("CKBSR", (ftnlen)5); - sigerr_("SPICE(CKBOGUSENTRY)", (ftnlen)19); - chkout_("CKBSR", (ftnlen)5); - return 0; -/* $Procedure CKLPF ( C-kernel, load pointing file ) */ - -L_cklpf: -/* $ Abstract */ - -/* Load a CK pointing file for use by the CK readers. Return that */ -/* file's handle, to be used by other CK routines to refer to the */ -/* file. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of the CK file to be loaded. */ -/* HANDLE O Loaded file's handle. */ -/* FTSIZE P Maximum number of loaded CK files. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a C-kernel file to be loaded. */ - -/* $ Detailed_Output */ - -/* HANDLE is an integer handle assigned to the file upon loading. */ -/* Almost every other CK routine will subsequently use */ -/* this number to refer to the file. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of CK files that may */ -/* be loaded simultaneously under any circumstances. */ -/* FTSIZE is currently set to match the maximum number */ -/* of DAF files that may be loaded simultaneously. */ - -/* $ Exceptions */ - -/* 1) If an attempt is made to open more DAF files than is specified */ -/* by the parameter FTSIZE in DAFAH, an error is signaled by a */ -/* routine in the call tree of this routine. */ - -/* 2) If an attempt is made to load more files than is specified */ -/* by the local paramater FTSIZE, and if the DAF system has */ -/* room to load another file, the error SPICE(CKTOOMANYFILES) */ -/* signaled. The current setting of FTSIZE does not allow this */ -/* situation to arise: the DAF system will trap the error */ -/* before this routine has the chance. */ - -/* 3) If the file specified by FNAME can not be opened, an error */ -/* is signaled by a routine that this routine calls. */ - -/* 4) If the file specified by FNAME has already been loaded, */ -/* it will become the "last-loaded" file. The readers */ -/* search the last-loaded file first. */ - -/* $ Files */ - -/* The C-kernel file specified by FNAME is loaded. The file is */ -/* assigned an integer handle by CKLPF. Other CK routines will refer */ -/* to this file by its handle. */ - -/* $ Particulars */ - -/* See Particulars above, in CKBSR. */ - -/* If there is room for a new file, CKLPF opens the file for */ -/* reading. This routine must be called prior to a call to CKGP or */ -/* CKGPAV. */ - -/* CK readers search files loaded with CKLPF in the reverse order */ -/* in which they were loaded. That is, last-loaded files are */ -/* searched first. */ - -/* $ Examples */ - -/* See the Example above, in CKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* J.E. McLean (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When an already loaded kernel is opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 2) This routine now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby avoiding */ -/* arithmetic overflow. The numbers in the file table */ -/* are replaced with consecutive integers in the range */ -/* 1 : NFT, such that the ordering of the numbers is not */ -/* changed. The HFS and LFS arrays are updated accordingly. */ - -/* Also, the flags indicating validity of the re-use intervals */ -/* are set to .FALSE. here. */ - -/* - SPICELIB Version 4.0.0, 17-FEB-2000 (WLT) */ - -/* Added the Entry point CKHAVE */ - -/* - SPICELIB Version 3.0.0, 03-MAR-1999 (WLT) */ - -/* The parameter STSIZE was increased from 1000 to 4000 to */ -/* avoid the buffering error that exists in the CKBSR. */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) When loading a file, CKLPF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that CKLPF and CKUPF clean up the instrument */ -/* tables after a file is unloaded was fixed. */ - -/* - 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, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* load ck pointing file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a loaded kernel is opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 2) This routine now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby avoiding */ -/* arithmetic overflow. The numbers in the file table */ -/* are replaced with consecutive integers in the range */ -/* 1 : NFT, such that the ordering of the numbers is not */ -/* changed. The HFS and LFS arrays are updated accordingly. */ -/* HFS and LFS entries that have gone stale are set to zero. */ - -/* Also, the flags indicating validity of the re-use intervals */ -/* are set to .FALSE. here. */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* Temp version for testing purposes. */ - -/* 1) When loading a file, CKLPF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that CKLPF and CKUPF clean up the instrument */ -/* tables after a file is unloaded was fixed. */ - -/* If as the result of loading a file that was previously loaded, */ -/* there are no more segments buffered for a particular */ -/* instrument, the counter variable for the instruments is no */ -/* longer incremented. */ - -/* The following code fragment changed: */ - -/* IF ( ITBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NIT = NIT - 1 */ - -/* END IF */ - -/* I = I + 1 */ - -/* This is the fix: */ - -/* IF ( ITBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NIT = NIT - 1 */ - -/* ELSE */ - -/* I = I + 1 */ - -/* END IF */ - -/* - Beta Version 1.1.0, 28-AUG-1990 (MJS) (JEM) */ - -/* Header documentation was updated, and error handling was */ -/* modified. */ - -/* - Beta Version 1.0.0, 14-MAR-1990 (RET) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKLPF", (ftnlen)5); - } - -/* Don't allow a search to continue after loading a file; a new */ -/* search should be re-started. */ - - s_copy(status, "BOGUS ENTRY", (ftnlen)40, (ftnlen)11); - -/* Since a current search cannot be continued at this point, */ -/* free the left-over partial list searched in the */ -/* 'CHECK PARTIAL LIST' state, if the list is present. */ - - if (fresub) { - -/* Return the partial list to the free list. */ - - tail = lnktl_(&slbeg, stpool); - lnkfsl_(&slbeg, &tail, stpool); - fresub = FALSE_; - } - -/* Any time we load a file, there is a possibility that the */ -/* re-use intervals are invalid because they're been superseded */ -/* by higher-priority data. Since we're not going to examine */ -/* the loaded file, simply indicate that all of the re-use */ -/* intervals are invalid. */ - - i__1 = nit; - for (i__ = 1; i__ <= i__1; ++i__) { - itchkp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itchkp", - i__2, "ckbsr_", (ftnlen)1260)] = FALSE_; - } - -/* Nothing works unless at least one file has been loaded, so */ -/* this is as good a place as any to initialize the free list */ -/* whenever the instrument table is empty. */ - - if (nit == 0) { - lnkini_(&c__50000, stpool); - } - -/* To load a new file, first try to open it for reading. */ - - dafopr_(fname, handle, fname_len); - if (failed_()) { - chkout_("CKLPF", (ftnlen)5); - return 0; - } - -/* Determine if the file is already in the table. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex > 0) { - -/* The last call we made to DAFOPR added another DAF link to */ -/* the CK file. Remove this link. */ - - dafcls_(handle); - -/* Handle is already in the table. Remove it. */ - - --nft; - i__1 = nft; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan" - , i__2, "ckbsr_", (ftnlen)1300)] = fthan[(i__3 = i__) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "ckbsr_", - (ftnlen)1300)]; - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum" - , i__2, "ckbsr_", (ftnlen)1301)] = ftnum[(i__3 = i__) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftnum", i__3, "ckbsr_", - (ftnlen)1301)]; - } - -/* Unlink any segments that came from this file. */ - - i__ = 1; - while(i__ <= nit) { - p = itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itbeg", i__1, "ckbsr_", (ftnlen)1311)]; - while(p > 0) { - -/* Find the successor of P, if any. */ - - nxtseg = lnknxt_(&p, stpool); - if (sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "ckbsr_", (ftnlen)1319)] == *handle) { - -/* The segment corresponding to node P came from */ -/* the file we're unloading. Delete the node for */ -/* P from the segment list for instrument I; if P happens */ -/* to be the head node for instrument I's segment list, */ -/* make the successor of P the head of the list. */ - - lnkfsl_(&p, &p, stpool); - if (p == itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)1329)]) - { - itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)1330)] - = nxtseg; - } - } - -/* Update P. */ - - p = nxtseg; - } - -/* If the list for this instrument is now empty, shorten the */ -/* current table by one: put all the entries for the last */ -/* instrument in the table into the space occupied by the */ -/* one we've deleted. */ - - if (itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itbeg", i__1, "ckbsr_", (ftnlen)1347)] <= 0) { - -/* Because all of the re-use intervals are invalid, we need */ -/* not copy the saved items associated with them. The */ -/* items not copied are */ - -/* ITCHKP */ -/* ITLB */ -/* ITPRVD */ -/* ITPRVF */ -/* ITPRVH */ -/* ITPRVI */ -/* ITRUEX */ -/* ITUB */ - - itins[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itins", i__1, "ckbsr_", (ftnlen)1362)] = itins[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itins", - i__2, "ckbsr_", (ftnlen)1362)]; - itexp[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itexp", i__1, "ckbsr_", (ftnlen)1363)] = itexp[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itexp", - i__2, "ckbsr_", (ftnlen)1363)]; - ithfs[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "ithfs", i__1, "ckbsr_", (ftnlen)1364)] = ithfs[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("ithfs", - i__2, "ckbsr_", (ftnlen)1364)]; - itlfs[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itlfs", i__1, "ckbsr_", (ftnlen)1365)] = itlfs[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itlfs", - i__2, "ckbsr_", (ftnlen)1365)]; - itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itbeg", i__1, "ckbsr_", (ftnlen)1366)] = itbeg[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itbeg", - i__2, "ckbsr_", (ftnlen)1366)]; - --nit; - } else { - ++i__; - } - } - } else { - -/* This is a new file. Make sure that there are unused slots */ -/* in the file table. */ - - if (nft == 1000) { - dafcls_(handle); - setmsg_("Number of files loaded is at a maximum, as specified by" - " the parameter FTSIZE, the value of which is #. You will" - " need to either load fewer files, or change the paramete" - "r FTSIZE.", (ftnlen)176); - errint_("#", &c__1000, (ftnlen)1); - sigerr_("SPICE(CKTOOMANYFILES)", (ftnlen)21); - chkout_("CKLPF", (ftnlen)5); - return 0; - } - } - -/* Determine the next file number. */ - - if (next < intmax_() - 1) { - ++next; - } else { - -/* The user is to be congratulated: we've run out of file */ -/* numbers. */ - -/* Re-set the valid file numbers so they lie in the range 1:NFT, */ -/* with the Ith file in the file table having file number I. */ -/* First update the LFS and HFS components of the instrument table */ -/* according to this mapping. */ - -/* Set any instrument table entries that are lower than FTNUM(1) */ -/* to zero. */ - - i__1 = nit; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Re-map the HFS table for the Ith instrument. */ - - j = isrchi_(&ithfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("ithfs", i__2, "ckbsr_", (ftnlen)1425)], &nft, - ftnum); - if (j > 0) { - -/* The highest file searched for instrument I is the Jth */ -/* file in the file table. */ - - ithfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "ithfs", i__2, "ckbsr_", (ftnlen)1432)] = j; - } else { - -/* The highest file searched for instrument I is not in the */ -/* file table. This occurs when the highest file searched */ -/* has been unloaded. Note that this assigment makes all */ -/* files appear to be "new" when a lookup for instrument */ -/* I is performed. */ - - ithfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "ithfs", i__2, "ckbsr_", (ftnlen)1442)] = 0; - } - -/* Re-map the LFS table for the Ith instrument. */ - - j = isrchi_(&itlfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itlfs", i__2, "ckbsr_", (ftnlen)1449)], &nft, - ftnum); - if (j > 0) { - -/* The lowest file searched for instrument I is the Jth file */ -/* in the file table. */ - - itlfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itlfs", i__2, "ckbsr_", (ftnlen)1456)] = j; - } else { - -/* The lowest file searched for instrument I is not in the */ -/* file table. This occurs when the lowest file searched */ -/* has been unloaded. Zero out both the lowest and */ -/* highest file searched to force reconstruction of the */ -/* list. */ - - itlfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itlfs", i__2, "ckbsr_", (ftnlen)1466)] = 0; - ithfs[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "ithfs", i__2, "ckbsr_", (ftnlen)1467)] = 0; - } - } - -/* Re-map the file number table itself. */ - - i__1 = nft; - for (i__ = 1; i__ <= i__1; ++i__) { - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum" - , i__2, "ckbsr_", (ftnlen)1478)] = i__; - } - -/* Assign a new file number. */ - - next = nft + 1; - } - -/* Now add this file to file table. */ - - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "ckbsr_", (ftnlen)1493)] = *handle; - ftnum[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnum", i__1, - "ckbsr_", (ftnlen)1494)] = next; - chkout_("CKLPF", (ftnlen)5); - return 0; -/* $Procedure CKUPF ( C-kernel, Unload pointing file ) */ - -L_ckupf: -/* $ Abstract */ - -/* Unload a CK pointing file so that it will no longer be searched */ -/* by the readers. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of CK file to be unloaded */ - -/* $ Detailed_Input */ - -/* HANDLE Integer handle assigned to the file upon loading. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Unloading a file that has not been loaded is a no-op. */ -/* No error is signaled. */ - -/* $ Files */ - -/* The file referred to by HANDLE is unloaded. */ - -/* $ Particulars */ - -/* See Particulars section above, in CKBSR. */ - -/* Unloading a file with CKUPF removes that file from consideration */ -/* by the CK readers. In doing so, it frees up space for another */ -/* file to be loaded. */ - -/* $ Examples */ - -/* See the Example above, in CKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) This routine now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* Also, the flags indicating validity of those re-use intervals */ -/* whose data comes from the unloaded file are set to .FALSE. */ - -/* - SPICELIB Version 4.0.0, 17-FEB-2000 (WLT) */ - -/* Added the Entry point CKHAVE */ - -/* - SPICELIB Version 3.0.0, 03-MAR-1999 (WLT) */ - -/* The parameter STSIZE was increased from 1000 to 4000 to */ -/* avoid the buffering error that exists in the CKBSR. */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) A bug in the way that CKLPF and CKUPF clean up the instrument */ -/* tables after a file is unloaded was fixed. */ - -/* - 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, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* unload ck pointing file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.2.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) This routine now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* Also, the flags indicating validity of those re-use intervals */ -/* whose data comes from the unloaded file are set to .FALSE. */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) A bug in the way that CKLPF and CKUPF clean up the instrument */ -/* tables after a file is unloaded was fixed. */ - -/* If as the result of unloading a file there are no more */ -/* segments buffered for a particular instrument, the counter */ -/* variable for the instruments in the instrument table is no */ -/* longer incremented. */ - -/* The following code fragment changed: */ - -/* IF ( ITBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NIT = NIT - 1 */ - -/* END IF */ - -/* I = I + 1 */ - -/* This is the fix: */ - -/* IF ( ITBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NIT = NIT - 1 */ - -/* ELSE */ - -/* I = I + 1 */ - -/* END IF */ - -/* - Beta Version 1.0.1, 29-AUG-1990 (MJS) (JEM) */ - -/* Comments were updated. */ - -/* - Beta Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("CKUPF", (ftnlen)5); - -/* Don't allow a search to continue after unloading a file; a new */ -/* search should be re-started. */ - - s_copy(status, "BOGUS ENTRY", (ftnlen)40, (ftnlen)11); - -/* Since a current search cannot be continued at this point, */ -/* free the left-over partial list searched in the */ -/* 'CHECK PARTIAL LIST' state, if the list is present. */ - - if (fresub) { - -/* Return the partial list to the free list. */ - - tail = lnktl_(&slbeg, stpool); - lnkfsl_(&slbeg, &tail, stpool); - fresub = FALSE_; - } - -/* All of the stored segments from the file must be removed */ -/* from the segment table (by returning the corresponding nodes */ -/* to the segment table pool.) */ - -/* Don't do anything if the given handle is not in the file table. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex == 0) { - chkout_("CKUPF", (ftnlen)5); - return 0; - } - - -/* First get rid of the entry in the file table. Close the file */ -/* before wiping out the handle. */ - - dafcls_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "ckbsr_", (ftnlen)1760)]); - --nft; - i__1 = nft; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan", - i__2, "ckbsr_", (ftnlen)1766)] = fthan[(i__3 = i__) < 1000 && - 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "ckbsr_", (ftnlen) - 1766)]; - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "ckbsr_", (ftnlen)1767)] = ftnum[(i__3 = i__) < 1000 && - 0 <= i__3 ? i__3 : s_rnge("ftnum", i__3, "ckbsr_", (ftnlen) - 1767)]; - } - -/* Check each instrument list individually. Note that the first */ -/* node on each list, having no predecessor, must be handled */ -/* specially. */ - - i__ = 1; - while(i__ <= nit) { - p = itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itbeg", - i__1, "ckbsr_", (ftnlen)1779)]; - while(p > 0) { - nxtseg = lnknxt_(&p, stpool); - if (sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "ckbsr_", (ftnlen)1785)] == *handle) { - if (p == itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)1787)]) { - itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itbeg", i__1, "ckbsr_", (ftnlen)1788)] = nxtseg; - } - -/* Free this segment table entry. */ - - lnkfsl_(&p, &p, stpool); - } - p = nxtseg; - } - -/* If the list for this instrument is now empty, shorten the */ -/* current table by one: put all the entries for the last */ -/* instrument in the table into the space occupied by the */ -/* one we've deleted. */ - - if (itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itbeg", - i__1, "ckbsr_", (ftnlen)1807)] == 0) { - if (i__ != nit) { - itins[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itins", i__1, "ckbsr_", (ftnlen)1811)] = itins[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itins", - i__2, "ckbsr_", (ftnlen)1811)]; - itexp[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itexp", i__1, "ckbsr_", (ftnlen)1812)] = itexp[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itexp", - i__2, "ckbsr_", (ftnlen)1812)]; - ithfs[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "ithfs", i__1, "ckbsr_", (ftnlen)1813)] = ithfs[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("ithfs", - i__2, "ckbsr_", (ftnlen)1813)]; - itlfs[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itlfs", i__1, "ckbsr_", (ftnlen)1814)] = itlfs[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itlfs", - i__2, "ckbsr_", (ftnlen)1814)]; - itbeg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itbeg", i__1, "ckbsr_", (ftnlen)1815)] = itbeg[(i__2 - = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itbeg", - i__2, "ckbsr_", (ftnlen)1815)]; - itlb[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itlb", i__1, "ckbsr_", (ftnlen)1816)] = itlb[(i__2 = - nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itlb", - i__2, "ckbsr_", (ftnlen)1816)]; - itub[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itub", i__1, "ckbsr_", (ftnlen)1817)] = itub[(i__2 = - nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itub", - i__2, "ckbsr_", (ftnlen)1817)]; - itprvf[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itprvf", i__1, "ckbsr_", (ftnlen)1818)] = itprvf[( - i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itprvf", i__2, "ckbsr_", (ftnlen)1818)]; - itprvh[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itprvh", i__1, "ckbsr_", (ftnlen)1819)] = itprvh[( - i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itprvh", i__2, "ckbsr_", (ftnlen)1819)]; - s_copy(itprvi + ((i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itprvi", i__1, "ckbsr_", (ftnlen)1820)) * 40, - itprvi + ((i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itprvi", i__2, "ckbsr_", (ftnlen)1820)) * 40, - (ftnlen)40, (ftnlen)40); - itchkp[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itchkp", i__1, "ckbsr_", (ftnlen)1821)] = itchkp[( - i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itchkp", i__2, "ckbsr_", (ftnlen)1821)]; - itruex[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itruex", i__1, "ckbsr_", (ftnlen)1822)] = itruex[( - i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itruex", i__2, "ckbsr_", (ftnlen)1822)]; - moved_(&itprvd[(i__1 = nit * 5 - 5) < 500 && 0 <= i__1 ? i__1 - : s_rnge("itprvd", i__1, "ckbsr_", (ftnlen)1824)], & - c__5, &itprvd[(i__2 = i__ * 5 - 5) < 500 && 0 <= i__2 - ? i__2 : s_rnge("itprvd", i__2, "ckbsr_", (ftnlen) - 1824)]); - } - --nit; - } else { - ++i__; - } - } - -/* Any time we unload a file, we may be removing the file */ -/* providing data for the re-use interval for one or more */ -/* instruments. For each instrument, if the handle associated */ -/* with the re-use interval happens to be that of the file */ -/* we're unloading, indicate that the re-use interval is invalid. */ - - i__1 = nit; - for (i__ = 1; i__ <= i__1; ++i__) { - if (itchkp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("itch" - "kp", i__2, "ckbsr_", (ftnlen)1847)]) { - if (itprvh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itprvh", i__2, "ckbsr_", (ftnlen)1849)] == *handle) { - itchkp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itchkp", i__2, "ckbsr_", (ftnlen)1850)] = FALSE_; - } - } - } - chkout_("CKUPF", (ftnlen)5); - return 0; -/* $Procedure CKBSS ( C-kernel, begin search for segment ) */ - -L_ckbss: -/* $ Abstract */ - -/* Initiate search through loaded files to find segments applicable */ -/* to the spacecraft instrument and time specified. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ - -/* INTEGER INST */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ -/* LOGICAL NEEDAV */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INST I Spacecraft and instrument ID. */ -/* SCLKDP I Encoded spacecraft clock time. */ -/* TOL I Time tolerance. */ -/* NEEDAV I Is there a need for angular velocity? */ - -/* $ Detailed_Input */ - -/* CKBSS sets up a search for segments. The four quantities below */ -/* establish the search criteria. */ - - -/* INST is the NAIF ID of an instrument. */ - -/* SCLKDP is an encoded spacecraft clock time. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* NEEDAV indicates whether or not angular velocity data is */ -/* required. */ - -/* If true, only segments containing pointing and angular */ -/* velocity data will be checked. If false, segments */ -/* containing just pointing data will also be considered. */ - - -/* A segment matches the CKBSS/CKSNS search criteria when the */ -/* following statements are true. */ - -/* 1) INST matches the instrument number for the segment. */ - -/* 2) The time interval [SCLKDP - TOL, SCLKDP + TOL] intersects */ -/* the time interval of the segment. */ - -/* 3) If angular velocity data is required, as indicated by */ -/* NEEDAV, the segment contains angular velocity data. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If no files have been loaded, the error SPICE(NOLOADEDFILES) */ -/* is signaled. */ - -/* $ Files */ - -/* All files loaded by CKLPF are potential search targets for */ -/* CKSNS. */ - -/* $ Particulars */ - -/* CKBSS sets up a search for segments by CKSNS. It records the */ -/* instrument and time to be searched for, and whether to require */ -/* segments containing angular velocity data. If angular velocity */ -/* data are required, only segments containing angular velocity */ -/* data will be returned by CKSNS. If angular velocity data are */ -/* not required, segments returned by CKSNS may or may not contain */ -/* angular velocity data. */ - -/* CKBSS determines the first task that CKSNS will have to perform */ -/* if it is called to get an applicable segment. */ - -/* $ Examples */ - -/* See Examples in CKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* M.J. Spencer (JPL) */ -/* J.E. McLean (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Updated to support new doubly-linked list implementation: */ -/* partial segment list that cannot be buffered is now */ -/* deallocated here rather than in CKSNS. Minor changes to */ -/* comments were made as well. */ - -/* - SPICELIB Version 4.0.0, 17-FEB-2000 (WLT) */ - -/* Added the Entry point CKHAVE */ - -/* - SPICELIB Version 3.0.0, 03-MAR-1999 (WLT) */ - -/* The parameter STSIZE was increased from 1000 to 4000 to */ -/* avoid the buffering error that exists in the CKBSR. */ - -/* - 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, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin search for ck segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Updated to support new doubly-linked list implementation: */ -/* partial segment list that cannot be buffered is now */ -/* deallocated here rather than in CKSNS. Minor changes to */ -/* comments were made as well. */ - -/* - Beta Version 1.1.0, 28-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable SCLK was changed to SCLKDP. */ -/* 2) Header documentation was updated. */ - -/* - Beta Version 1.0.0, 20-APR-1990 (RET) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKBSS", (ftnlen)5); - } - -/* If we're starting a new search after passing through the */ -/* 'CHECK PARTIAL LIST' state, free the left-over partial list */ -/* that was searched in that state, if necessary. */ - - if (fresub) { - -/* Return the partial list to the free list. */ - - tail = lnktl_(&slbeg, stpool); - lnkfsl_(&slbeg, &tail, stpool); - fresub = FALSE_; - } - -/* Make copies of the instrument ID code and angular velocity flag. */ -/* Save the request time itself. */ - -/* And form the endpoints of the acceptable time interval using the */ -/* input time and time tolerance. */ - - scinst = *inst; - alpha = *sclkdp - *tol; - omega = *sclkdp + *tol; - avneed = *needav; - reqt = *sclkdp; - savtol = *tol; - -/* There must be at least one file loaded. */ - - if (nft == 0) { - setmsg_("At least one CK file needs must be loaded by CKLPF before b" - "eginning a search.", (ftnlen)77); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("CKBSS", (ftnlen)5); - return 0; - } - -/* The stack of suspended tasks is empty. */ - - top = 0; - -/* Is the instrument already in the instrument table? The answer */ -/* determines what the first task for CKSNS will be. */ - - iindex = isrchi_(&scinst, &nit, itins); - if (iindex == 0) { - s_copy(status, "NEW INSTRUMENT", (ftnlen)40, (ftnlen)14); - } else { - -/* Set the status so that CKSNS will determine whether to check */ -/* the segment list, search new files, or return data from the */ -/* re-use interval. */ - - s_copy(status, "?", (ftnlen)40, (ftnlen)1); - } - -/* Indicate a new search has started. */ - - newsch = TRUE_; - chkout_("CKBSS", (ftnlen)5); - return 0; -/* $Procedure CKSNS ( C-kernel, Select next segment ) */ - -L_cksns: -/* $ Abstract */ - -/* Search through loaded files to find a segment matching the */ -/* requested instrument, time, and need for angular velocity. */ -/* Buffer segment descriptors, identifiers, and handles in the */ -/* process to minimize file reads. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* DOUBLE PRECISION DESCR ( * ) */ -/* CHARACTER*(*) SEGID */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE O Handle of file containing the applicable segment. */ -/* DESCR O Descriptor of the applicable segment. */ -/* SEGID O Identifier of the applicable segment. */ -/* FOUND O True if a segment was found. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* HANDLE is an integer handle of the file containing the */ -/* segment matching the instrument and time */ -/* specifications made in the last call to CKBSS. */ - -/* DESCR, */ -/* SEGID are the descriptor and identifier of the segment found */ -/* which matches the instrument and time specifications */ -/* made in the last call to CKBSS. */ - -/* FOUND is true if an applicable segment was found. False */ -/* otherwise. If FOUND is false, the values of the */ -/* other arguments are meaningless. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If CKSNS is called without CKBSS ever having been called, */ -/* the error 'SPICE(CALLCKBSSFIRST)' is signaled. */ - -/* 2) If no segment is found that matches the search criteria, */ -/* FOUND is set to false, but the values of HANDLE, DESCR, */ -/* and SEGID will be meaningless. */ - -/* $ Files */ - -/* All files loaded by CKLPF are potential search targets for */ -/* CKSNS. The files are all referred to by their integer handles. */ - -/* $ Particulars */ - -/* CKSNS is used to locate segments based on the search criteria */ -/* established by the most recent call to CKBSS. When a segment */ -/* is found it will have the following characteristics: */ - -/* 1) Its instrument will match the instrument specified in the */ -/* call to CKBSS. */ - -/* 2) Its time interval will intersect the time interval */ - -/* [SCLKDP - TOL, SCLKDP + TOL], */ - -/* where SCLKDP and TOL were specified in the call to CKBSS. */ - -/* 3) If there is a need for angular velocity data, as specified */ -/* by NEEDAV in the call to CKBSS, a returned segment */ -/* will contain angular velocity data. If there is no need */ -/* for such data, the returned segment may or may not contain */ -/* angular velocity data. */ - -/* The first call to CKSNS following a call to CKBSS starts a search */ -/* through loaded files and either returns the first applicable */ -/* segment, or indicates that no segment was found. */ - -/* CKSNS searches through last-loaded files first. Individual */ -/* files are searched backwards, so that segments that were inserted */ -/* last into the file get checked first. */ - -/* Subsequent calls to CKSNS pick up the search exactly where the */ -/* previous calls left off. If a segment is not found, future calls */ -/* will also indicate that no segment could be found, until a new */ -/* search is begun. */ - -/* CKSNS also buffers segment descriptors and identifiers, to */ -/* attempt to minimize file reads. */ - -/* $ Examples */ - -/* See Examples in CKBSR. */ - -/* $ Restrictions */ - -/* 1) This subroutine assumes that a search has been initiated by */ -/* a call to CKBSS. */ - -/* 2) When a CK file is loaded or unloaded, a new search must */ -/* be started via a call to CKBSS before this routine may */ -/* be called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single CK file, and the list is */ -/* too large to be buffered, the corresponding intrument */ -/* table pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current instrument index when instrument */ -/* table entries having empty segment lists were compressed */ -/* out of the instrument table. Previously the instrument */ -/* table pointer IINDEX could go stale after the */ -/* compression. */ - -/* 3) DAF calls are now followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The instrument table size has been increased to 100 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* - SPICELIB Version 4.0.0, 17-FEB-2000 (WLT) */ - -/* Added the Entry point CKHAVE */ - -/* - SPICELIB Version 3.0.0, 03-MAR-1999 (WLT) */ - -/* The parameter STSIZE was increased from 1000 to 4000 to */ -/* avoid the buffering error that exists in the CKBSR. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 01-NOV-1990 (JML) */ - -/* A check on the initial value of the variable STATUS */ -/* was added in order to detect the situation in which */ -/* CKBSS was never called to initiate a search. */ - - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* select next ck segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.2.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.1.0, 20-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single CK file, and the list is */ -/* too large to be buffered, the corresponding instrument */ -/* table pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current instrument index when instrument */ -/* table entries having empty segment lists were compressed */ -/* out of the instrument table. Previously the instrument */ -/* table pointer IINDEX could go stale after the */ -/* compression. */ - -/* 3) DAF calls are now followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The instrument table size has been increased to 100 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different instruments. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - - -/* - SPICELIB Version 1.1.0, 01-NOV-1990 (JML) */ - -/* A check on the initial value of the variable STATUS */ -/* was added in order to detect the situation in which */ -/* CKBSS was never called to initiate a search. */ - - -/* - Beta Version 1.1.0, 28-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable IDENT was changed to SEGID. */ -/* 2) The local variables INTDES and DPDES were changed to */ -/* ICD and DCD. */ -/* 3) Header and internal documentation was corrected and */ -/* updated. */ - -/* - Beta Version 1.0.0, 20-APR-1990 (RET) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKSNS", (ftnlen)5); - } - -/* Nothing's been found yet. */ - - *found = FALSE_; - -/* Initialize the segment list pointer to the saved value from */ -/* the previous pass through this routine, if any. */ - - p = savep; - -/* CKSNS buffers segment descriptors and identifiers, to */ -/* attempt to minimize file reads. Buffering segments involves */ -/* maintaining three tables: the file table, the instrument table, */ -/* and the segment table. CKSNS is broken down into various tasks, */ -/* described in the code below, which perform these manipulations. */ - -/* A description of the components of each table is provided in */ -/* the declarations section of CKBSR. */ - -/* Basically, the buffering is performed as follows: once a request */ -/* for a segment for a particular instrument is made, if there are */ -/* no adequate entries in the buffer already, a search is made */ -/* through loaded files for applicable segments. Every segment */ -/* pertaining to that instrument in a searched file is buffered, */ -/* before a check of the current buffer is made. If the search */ -/* doesn't turn up a segment matching the specified search criteria */ -/* the next file is searched and new segments are added to the list, */ -/* and so on. */ - -/* The information in the segment table (ST) is stored in a */ -/* doubly-linked list. Each node in the list contains several */ -/* individual pieces of data, which are stored in parallel */ -/* arrays. */ - -/* In the following loop, we will try to simplify things by */ -/* doing exactly one thing on each pass through the loop. */ -/* After each pass, the status of the loop (STATUS) will be */ -/* adjusted to reflect the next thing that needs to be done. */ -/* The first task is set by CKBSS. */ - -/* Occasionally, the current task will have to be interrupted */ -/* until another task can be carried out. (For example, when */ -/* collecting new segments, an interrupt might place a segment */ -/* at the front or end of the current instrument list; when placing */ -/* the segment on the list, a second interrupt might free */ -/* room in the segment table in order to allow the addition */ -/* to proceed.) In this case, the current task will be saved and */ -/* restored after the more urgent task has been completed. */ - -/* The loop can terminate in only one of two ways (unless an error */ -/* occurs). First, if an applicable segment is found in the segment */ -/* table, the handle, descriptor, and identifier for the segment */ -/* are returned immediately. Second, if the table does not contain */ -/* an applicable segment, and if no files remain to be searched, */ -/* the loop terminates normally, and no data are returned. */ - -/* The status is saved on exit, however, so that subsequent calls */ -/* will resume a search exactly where previous calls left off. */ - -/* Each status is described below. */ - -/* 'NEW INSTRUMENT' */ - -/* This indicates that the specified spacecraft/instrument has */ -/* no segments stored for it at all. It must be added to the */ -/* instrument table. (This is followed immediately by an */ -/* OLD FILES search, in which every file loaded is considered an */ -/* old file.) */ - -/* 'NEW FILES' */ - -/* This indicates that at least one new file has been added */ -/* since the last time the segment list for the specified */ -/* instrument was searched. Find the oldest of these new files, */ -/* and begin a NEW SEGMENTS search in forward order for */ -/* segments to add to the front of the list. */ - -/* 'NEW SEGMENTS' */ - -/* Continue a NEW FILES search, adding segments for the specified */ -/* instrument to the front of the list. */ - -/* 'OLD FILES' */ - -/* This indicates that although the list has been searched */ -/* and found to contain no applicable segment, some of the */ -/* older files remain to be searched. Find the newest of these */ -/* old files, and begin an OLD SEGMENTS search in backward order. */ - -/* 'OLD SEGMENTS' */ - -/* Continue an OLD FILES search, adding segments for the specified */ -/* instrument to the end of the list. */ - -/* 'CHECK LIST' */ - -/* This indicates that the list is ready to be searched, */ -/* either because no new files have been added, or because */ -/* segments from a new file or an old file have recently */ -/* been added. */ - -/* The list is never checked until all new files have been */ -/* searched. */ - -/* If an applicable segment is found, it is returned. */ - -/* 'MAKE ROOM' (Interrupt) */ - -/* This indicates that one of the instruments must be removed, */ -/* along with its stored segments, to make room for another */ -/* instrument or segment. The instrument (other than the */ -/* specified instrument) with the smallest expense is selected */ -/* for this honor. */ - -/* 'ADD TO FRONT' (Interrupt) */ - -/* This indicates that a segment has been found (during the */ -/* course of a NEW FILES search) and must be added to the front */ -/* of the list. */ - -/* 'ADD TO END' (Interrupt) */ - -/* This indicates that a segment has been found (during the */ -/* course of an OLD FILES search) and must be added to the end */ -/* of the list. */ - -/* 'PREPARE PARTIAL LIST' */ - -/* This indicates that an attempt to 'MAKE ROOM' failed when */ -/* trying to 'ADD TO END' because all of the segments in the */ -/* table were for the instrument being searched on. The partial */ -/* list is found that contains all of the segments that were in */ -/* the process of being added to the table for the current old */ -/* file. Next a 'CHECK PARTIAL LIST' is performed. Following */ -/* that, a 'SEARCH W/O BUFF' is performed on all unsearched */ -/* files. */ - -/* 'CHECK PARTIAL LIST' */ - -/* This indicates that a portion of the list can't be buffered. */ -/* Before this portion is freed, it is to be checked for */ -/* applicable segments. */ - -/* 'SEARCH W/O BUFF' */ - -/* This indicates that the segment table was too small to handle */ -/* all of the segments for the current instrument, and that the */ -/* remaining unchecked old files should be searched for applicable */ -/* segments, without buffering the segments. */ - -/* 'SUSPEND' */ - -/* This indicates that the current task (DOING) should be */ -/* interrupted until a more urgent task (URGENT) can be */ -/* carried out. The current task is placed on a stack for */ -/* safekeeping. */ - -/* 'RESUME' */ - -/* This indicates that the most recently interrupted task */ -/* should be resumed immediately. */ - -/* '?' */ - -/* This indicates that the next task is not immediately */ -/* apparent: if new files exist, they should be searched; */ -/* otherwise the list should be checked. */ - -/* 'HOPELESS' */ - -/* This indicates that the table does not contain an applicable */ -/* segment, and no files remain to be searched. */ - -/* 'BOGUS ENTRY' */ - -/* This is the initial value of STATUS and indicates that no */ -/* call to CKBSS was ever made. If this is the case then an */ -/* error will be signaled. */ - - if (s_cmp(status, "BOGUS ENTRY", (ftnlen)40, (ftnlen)11) == 0) { - setmsg_("Must begin a search by calling CKBSS first.", (ftnlen)43); - sigerr_("SPICE(CALLCKBSSFIRST)", (ftnlen)21); - chkout_("CKSNS", (ftnlen)5); - return 0; - } - while(s_cmp(status, "HOPELESS", (ftnlen)40, (ftnlen)8) != 0) { - -/* If new files have been added, they have to be searched. */ -/* Otherwise, go right to the list of stored segments. */ - - if (s_cmp(status, "?", (ftnlen)40, (ftnlen)1) == 0) { - -/* There are two ways to get to this point. */ - -/* 1) Status may have been set to '?' by CKBSS. */ - -/* 2) Status was set to '?' by the NEW SEGMENTS block */ -/* of code as the result of finishing the read of */ -/* a new file. */ - - if (ithfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "ithfs", i__1, "ckbsr_", (ftnlen)2678)] < ftnum[(i__2 = - nft - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "ckbsr_", (ftnlen)2678)]) { - s_copy(status, "NEW FILES", (ftnlen)40, (ftnlen)9); - } else { - -/* Much of the time, the segment used to satisfy the */ -/* previous request will also satisfy the current */ -/* request. Check whether this is the case. */ - - if (itchkp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itchkp", i__1, "ckbsr_", (ftnlen)2688)]) { - -/* The previous segment found for the current instrument */ -/* is a viable candidate for the current request. See */ -/* whether the request time REQT falls into the time */ -/* interval for which this segment provides the */ -/* highest-priority coverage. */ - -/* We treat the re-use interval as topologically open */ -/* because one or both endpoints may belong to */ -/* higher-priority segments. */ - - if (reqt > itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itlb", i__1, "ckbsr_", (ftnlen) - 2700)] + savtol && reqt < itub[(i__2 = iindex - 1) - < 100 && 0 <= i__2 ? i__2 : s_rnge("itub", i__2, - "ckbsr_", (ftnlen)2700)] - savtol) { - -/* The request time falls into the portion of */ -/* the re-use interval that isn't blocked by */ -/* higher-priority segments, when the coverage of */ -/* those segments is extended in either direction */ -/* by TOL. */ - - if (! avneed || itprvf[(i__1 = iindex - 1) < 100 && 0 - <= i__1 ? i__1 : s_rnge("itprvf", i__1, "ckb" - "sr_", (ftnlen)2709)] != 0) { - -/* This segment has angular velocity if we */ -/* need it. The segment satisfies the */ -/* request. */ - - *handle = itprvh[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itprvh", i__1, - "ckbsr_", (ftnlen)2716)]; - s_copy(segid, itprvi + ((i__1 = iindex - 1) < 100 - && 0 <= i__1 ? i__1 : s_rnge("itprvi", - i__1, "ckbsr_", (ftnlen)2717)) * 40, - segid_len, (ftnlen)40); - moved_(&itprvd[(i__1 = iindex * 5 - 5) < 500 && 0 - <= i__1 ? i__1 : s_rnge("itprvd", i__1, - "ckbsr_", (ftnlen)2719)], &c__5, descr); - *found = TRUE_; - -/* We can only use the re-use interval once on */ -/* a given search. If this search is continued, */ -/* we'll have to check the list. Prepare now. */ - - savep = itbeg[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itbeg", i__1, "ckb" - "sr_", (ftnlen)2728)]; - s_copy(status, "CHECK LIST", (ftnlen)40, (ftnlen) - 10); - chkout_("CKSNS", (ftnlen)5); - return 0; - } - -/* We needed angular velocity data but didn't have */ -/* it if we reached this point. */ - - } - -/* Adjust the expense here. If the expense of the list */ -/* contains a component due to the cost of finding the */ -/* unbuffered segment providing data for re-use, subtract */ -/* that component from the expense. */ - - itexp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itexp", i__1, "ckbsr_", (ftnlen)2747)] = - itexp[(i__2 = iindex - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itexp", i__2, "ckbsr_", (ftnlen) - 2747)] - itruex[(i__3 = iindex - 1) < 100 && 0 <= - i__3 ? i__3 : s_rnge("itruex", i__3, "ckbsr_", ( - ftnlen)2747)]; - itruex[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itruex", i__1, "ckbsr_", (ftnlen)2748)] = - 0; - -/* The re-use interval becomes invalid if it didn't */ -/* satisfy the request. The validity flag gets */ -/* re-set below. */ - -/* At this point, the previous segment is not a candidate */ -/* to satisfy the request---at least not until we've done */ -/* some file searches to verify that */ - -/* - The previous segment is still available. */ - -/* - The previous segment hasn't been superseded by a */ -/* more recently loaded segment. */ - -/* Carry on with the usual search algorithm. */ - - itchkp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itchkp", i__1, "ckbsr_", (ftnlen)2766)] = - FALSE_; - } - -/* If the segment list for this instrument is empty, make */ -/* sure the expense is reset to 0. */ - - if (itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)2774)] == 0) { - itexp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itexp", i__1, "ckbsr_", (ftnlen)2775)] = - 0; - } - -/* Prepare to look at the first segment in the list for */ -/* this instrument. */ - - p = itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)2782)]; - s_copy(status, "CHECK LIST", (ftnlen)40, (ftnlen)10); - } - } else if (s_cmp(status, "NEW INSTRUMENT", (ftnlen)40, (ftnlen)14) == - 0) { - -/* New instruments are added to the end of the instrument */ -/* table. If the table is full, one of the current occupants */ -/* must be removed to make room for the new one. */ - -/* Setting LFS to one more than the highest current file */ -/* number means the 'OLD FILES' search that follows will */ -/* begin with the last-loaded file. */ - -/* There is one way to get here: */ - -/* 1) The variable STATUS was set to NEW INSTRUMENT prior */ -/* in CKBSS. */ - -/* Find the cheapest slot in the instrument table to store */ -/* the initial information about this instrument. */ - -/* NOTE: This used to be handled by the MAKE ROOM section. */ -/* However, trying to handle this special case there was */ -/* just more trouble than it was worth. */ - - if (nit < 100) { - -/* If the instrument table isn't full, the cheapest place is */ -/* just the next unused row of the table. */ - - ++nit; - cheap = nit; - } else { - -/* The instrument table is full. Find the least */ -/* expensive instrument in the table and remove it. */ - - cheap = 1; - minexp = itexp[0]; - i__1 = nit; - for (i__ = 2; i__ <= i__1; ++i__) { - if (itexp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itexp", i__2, "ckbsr_", (ftnlen)2829)] < - minexp) { - cheap = i__; - minexp = itexp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itexp", i__2, "ckbsr_", ( - ftnlen)2831)]; - } - } - -/* If there are any segments associated with the */ -/* least expensive instrument, we put them back on the free */ -/* list. */ - - head = itbeg[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)2841)]; - if (head > 0) { - tail = -lnkprv_(&head, stpool); - lnkfsl_(&head, &tail, stpool); - } - } - -/* Set up a table entry for the new instrument. */ - - itins[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("iti" - "ns", i__1, "ckbsr_", (ftnlen)2855)] = scinst; - itexp[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("ite" - "xp", i__1, "ckbsr_", (ftnlen)2856)] = 0; - ithfs[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("ith" - "fs", i__1, "ckbsr_", (ftnlen)2857)] = ftnum[(i__2 = nft - - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", i__2, - "ckbsr_", (ftnlen)2857)]; - itlfs[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itl" - "fs", i__1, "ckbsr_", (ftnlen)2858)] = ftnum[(i__2 = nft - - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", i__2, - "ckbsr_", (ftnlen)2858)] + 1; - itbeg[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itb" - "eg", i__1, "ckbsr_", (ftnlen)2859)] = 0; - itchkp[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itchkp", i__1, "ckbsr_", (ftnlen)2860)] = FALSE_; - iindex = cheap; - -/* The following items associated with the re-use interval */ -/* need not be initialized at this point: */ - -/* ITRUEX */ -/* ITLB */ -/* ITUB */ -/* ITPRVF */ -/* ITPRVH */ -/* ITPRVI */ -/* ITPRVD */ - -/* However, we'll give these items initial values to */ -/* help prevent compilation warnings from zealous */ -/* compilers. */ - - itruex[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itruex", i__1, "ckbsr_", (ftnlen)2879)] = 0; - itlb[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itlb", - i__1, "ckbsr_", (ftnlen)2880)] = dpmin_(); - itub[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itub", - i__1, "ckbsr_", (ftnlen)2881)] = dpmax_(); - itprvf[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itprvf", i__1, "ckbsr_", (ftnlen)2882)] = 0; - itprvh[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itprvh", i__1, "ckbsr_", (ftnlen)2883)] = 0; - s_copy(itprvi + ((i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itprvi", i__1, "ckbsr_", (ftnlen)2884)) * 40, - " ", (ftnlen)40, (ftnlen)1); - cleard_(&c__5, &itprvd[(i__1 = cheap * 5 - 5) < 500 && 0 <= i__1 ? - i__1 : s_rnge("itprvd", i__1, "ckbsr_", (ftnlen)2885)]); - -/* Now search all of the files for segments relating to */ -/* this instrument. */ - - s_copy(status, "OLD FILES", (ftnlen)40, (ftnlen)9); - } else if (s_cmp(status, "NEW FILES", (ftnlen)40, (ftnlen)9) == 0) { - -/* When new files exist, they should be searched in forward */ -/* order, beginning with the oldest new file not yet searched. */ -/* All new files must be searched before the list can be */ -/* checked, to ensure that the best (newest) segments are */ -/* being used. */ - -/* Begin a forward search, and prepare to look for individual */ -/* segments from the file. */ - -/* The only way to get here is to have STATUS set to */ -/* the value NEW FILES in the STATUS .EQ. '?' block */ -/* of the IF structure. */ - -/* Find the next file to search; set FINDEX to the */ -/* corresponding file table entry. */ - findex = 1; - while(ithfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ithfs", i__1, "ckbsr_", (ftnlen)2914)] >= ftnum[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnum", i__2, "ckbsr_", (ftnlen)2914)]) { - ++findex; - } - ithfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "ithfs", i__1, "ckbsr_", (ftnlen)2920)] = ftnum[(i__2 = - findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "ckbsr_", (ftnlen)2920)]; - dafbfs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "ckbsr_", (ftnlen)2922)]); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - s_copy(status, "NEW SEGMENTS", (ftnlen)40, (ftnlen)12); - -/* The cost of the list contributed by the new file is */ -/* zero so far. */ - - cost = 0; - } else if (s_cmp(status, "NEW SEGMENTS", (ftnlen)40, (ftnlen)12) == 0) - { - -/* New files are searched in forward order. Segments, when */ -/* found, are inserted at the front of the list. Invisible */ -/* segments (initial time > final time) are ignored. */ - -/* Each segment examined, whether applicable or not, adds to */ -/* the expense of the list. */ - -/* The only way to get here is from the NEW FILES block */ -/* of the IF structure. */ - daffna_(&fnd); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - if (! fnd) { - -/* We're out of segments in the current file. Decide */ -/* whether we need to examine another new file, or */ -/* whether we're ready to check the list. */ - - s_copy(status, "?", (ftnlen)40, (ftnlen)1); - itexp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itexp", i__1, "ckbsr_", (ftnlen)2964)] = itexp[(i__2 - = iindex - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itexp", i__2, "ckbsr_", (ftnlen)2964)] + cost; - } else { - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - if (icd[0] == scinst && dcd[0] <= dcd[1]) { - s_copy(doing, "NEW SEGMENTS", (ftnlen)40, (ftnlen)12); - s_copy(urgent, "ADD TO FRONT", (ftnlen)40, (ftnlen)12); - s_copy(status, "SUSPEND", (ftnlen)40, (ftnlen)7); - } - ++cost; - } - -/* If we haven't reset the status, we'll return for another */ -/* 'NEW SEGMENTS' pass. */ - - } else if (s_cmp(status, "OLD FILES", (ftnlen)40, (ftnlen)9) == 0) { - -/* When old files must be searched (because the segments in */ -/* the list are inadequate), they should be searched in */ -/* backward order, beginning with the newest old file not */ -/* yet searched. The segment list will be re-checked */ -/* after each file is searched. If a match is found, */ -/* the search terminates, so some old files may not be */ -/* searched. */ - -/* Begin a backwards search, and prepare to look for */ -/* individual segments from the file. */ - -/* You can get to this block in two ways. */ - -/* 1) We can have a NEW INSTRUMENT. */ - -/* 2) We have checked the current list (CHECK LIST) for */ -/* this instrument, didn't find an applicable segment and */ -/* have some files left that have not been seached. */ - findex = nft; - while(itlfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlfs", i__1, "ckbsr_", (ftnlen)3016)] <= ftnum[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnum", i__2, "ckbsr_", (ftnlen)3016)]) { - --findex; - } - dafbbs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "ckbsr_", (ftnlen)3020)]); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - s_copy(status, "OLD SEGMENTS", (ftnlen)40, (ftnlen)12); - -/* The next thing we'll do is search through all the segments */ -/* of this file for those that applicable to this instrument. */ -/* The cost of the list contributed by the current file is */ -/* zero so far. */ - - cost = 0; - -/* Old files are searched in backward order. Segments, when */ -/* found, are inserted at the end of the list. Invisible */ -/* segments (initial time > final time) are ignored. */ - -/* Each segment examined, whether applicable or not, adds to */ -/* the expense of the list. */ - - } else if (s_cmp(status, "OLD SEGMENTS", (ftnlen)40, (ftnlen)12) == 0) - { - -/* There is only one way to get here---from the */ -/* block 'OLD FILES'. Note we do not add to the */ -/* expense of the list for this instrument until we've */ -/* completely searched this file. */ - - daffpa_(&fnd); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - if (! fnd) { - -/* All of the segments in this file have been exhausted. */ -/* Change the lowest file searched indicator for this */ -/* instrument to be the current file, and go check the */ -/* current list. */ - - itlfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itlfs", i__1, "ckbsr_", (ftnlen)3066)] = ftnum[(i__2 - = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnum", i__2, "ckbsr_", (ftnlen)3066)]; - itexp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itexp", i__1, "ckbsr_", (ftnlen)3067)] = itexp[(i__2 - = iindex - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "itexp", i__2, "ckbsr_", (ftnlen)3067)] + cost; - p = itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3068)]; - s_copy(status, "CHECK LIST", (ftnlen)40, (ftnlen)10); - } else { - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - if (icd[0] == scinst && dcd[0] <= dcd[1]) { - s_copy(doing, "OLD SEGMENTS", (ftnlen)40, (ftnlen)12); - s_copy(urgent, "ADD TO END", (ftnlen)40, (ftnlen)10); - s_copy(status, "SUSPEND", (ftnlen)40, (ftnlen)7); - } - ++cost; - } - } else if (s_cmp(status, "CHECK LIST", (ftnlen)40, (ftnlen)10) == 0) { - -/* Okay, all the new files (and maybe an old file or two) */ -/* have been searched. Time to look at the list of segments */ -/* stored for the instrument, to see if there is one applicable */ -/* to the specified epoch and need for angular velocity data. */ - -/* If so, return it. If not, try another old file. If there */ -/* are no more old files, give up the ghost. */ - -/* There are two ways to get to this point. */ - -/* 1) From the '?' block. */ -/* 2) From the 'OLD SEGMENTS' block. */ - -/* For every segment examined, adjust the re-use interval */ -/* associated with the current instrument. */ - -/* P always points to the current segment in the list. Reject */ -/* a segment if there is a need for angular velocity data and */ -/* the segment doesn't have it. */ - -/* If this is a new search, initialize the re-use interval. */ -/* If we're resuming a search, the re-use interval is invalid. */ - - if (newsch) { - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itlb", i__1, "ckbsr_", (ftnlen)3123)] = dpmin_(); - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itub", i__1, "ckbsr_", (ftnlen)3124)] = dpmax_(); - } - while(p > 0) { - if (newsch) { - -/* Trim the re-use interval if the request time lies */ -/* outside of the current segment. */ - - if (reqt > stdcd[(i__1 = (p << 1) - 1) < 100000 && 0 <= - i__1 ? i__1 : s_rnge("stdcd", i__1, "ckbsr_", ( - ftnlen)3135)]) { - -/* REQT is to the right of the coverage interval of */ -/* this segment. Trim the re-use interval on the */ -/* left, if necessary. */ - -/* Computing MAX */ - d__1 = itlb[(i__2 = iindex - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itlb", i__2, "ckbsr_", (ftnlen) - 3141)], d__2 = stdcd[(i__3 = (p << 1) - 1) < - 100000 && 0 <= i__3 ? i__3 : s_rnge("stdcd", - i__3, "ckbsr_", (ftnlen)3141)]; - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlb", i__1, "ckbsr_", (ftnlen)3141)] - = max(d__1,d__2); - } else if (reqt < stdcd[(i__1 = (p << 1) - 2) < 100000 && - 0 <= i__1 ? i__1 : s_rnge("stdcd", i__1, "ckbsr_", - (ftnlen)3144)]) { - -/* REQT is to the left of the coverage interval of */ -/* this segment. Trim the re-use interval on the */ -/* right, if necessary. */ - -/* Computing MIN */ - d__1 = itub[(i__2 = iindex - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itub", i__2, "ckbsr_", (ftnlen) - 3150)], d__2 = stdcd[(i__3 = (p << 1) - 2) < - 100000 && 0 <= i__3 ? i__3 : s_rnge("stdcd", - i__3, "ckbsr_", (ftnlen)3150)]; - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itub", i__1, "ckbsr_", (ftnlen)3150)] - = min(d__1,d__2); - } - } - if (omega >= stdcd[(i__1 = (p << 1) - 2) < 100000 && 0 <= - i__1 ? i__1 : s_rnge("stdcd", i__1, "ckbsr_", (ftnlen) - 3157)] && alpha <= stdcd[(i__2 = (p << 1) - 1) < - 100000 && 0 <= i__2 ? i__2 : s_rnge("stdcd", i__2, - "ckbsr_", (ftnlen)3157)]) { - -/* The segment coverage interval intersects the request */ -/* interval ALPHA:OMEGA. */ - - if (! avneed || sticd[(i__1 = p * 6 - 3) < 300000 && 0 <= - i__1 ? i__1 : s_rnge("sticd", i__1, "ckbsr_", ( - ftnlen)3163)] != 0) { - -/* This segment satisfies the request. */ - - dafps_(&c__2, &c__6, &stdcd[(i__1 = (p << 1) - 2) < - 100000 && 0 <= i__1 ? i__1 : s_rnge("stdcd", - i__1, "ckbsr_", (ftnlen)3167)], &sticd[(i__2 = - p * 6 - 6) < 300000 && 0 <= i__2 ? i__2 : - s_rnge("sticd", i__2, "ckbsr_", (ftnlen)3167)] - , descr); - s_copy(segid, stidnt + ((i__1 = p - 1) < 50000 && 0 <= - i__1 ? i__1 : s_rnge("stidnt", i__1, "ckbsr_" - , (ftnlen)3170)) * 40, segid_len, (ftnlen)40); - *handle = sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("sthan", i__1, "ckbsr_", ( - ftnlen)3171)]; - *found = TRUE_; - -/* If the segment actually contains the request */ -/* time, and if this is a new search, set the */ -/* re-use interval. We require the request time */ -/* to be in the interior of the interval: it */ -/* cannot be one of the endpoints. */ - - if (newsch && reqt > stdcd[(i__1 = (p << 1) - 2) < - 100000 && 0 <= i__1 ? i__1 : s_rnge("stdcd", - i__1, "ckbsr_", (ftnlen)3181)] && reqt < - stdcd[(i__2 = (p << 1) - 1) < 100000 && 0 <= - i__2 ? i__2 : s_rnge("stdcd", i__2, "ckbsr_", - (ftnlen)3181)]) { - -/* Set the re-use interval for the current */ -/* instrument. */ - -/* Computing MAX */ - d__1 = itlb[(i__2 = iindex - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("itlb", i__2, "ckbs" - "r_", (ftnlen)3188)], d__2 = stdcd[(i__3 = - (p << 1) - 2) < 100000 && 0 <= i__3 ? - i__3 : s_rnge("stdcd", i__3, "ckbsr_", ( - ftnlen)3188)]; - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itlb", i__1, "ckbsr_", ( - ftnlen)3188)] = max(d__1,d__2); -/* Computing MIN */ - d__1 = itub[(i__2 = iindex - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("itub", i__2, "ckbs" - "r_", (ftnlen)3189)], d__2 = stdcd[(i__3 = - (p << 1) - 1) < 100000 && 0 <= i__3 ? - i__3 : s_rnge("stdcd", i__3, "ckbsr_", ( - ftnlen)3189)]; - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itub", i__1, "ckbsr_", ( - ftnlen)3189)] = min(d__1,d__2); - -/* Save the returned output items, in case this */ -/* segment may satisfy the next request. */ - - itprvh[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itprvh", i__1, "ckbsr_", ( - ftnlen)3195)] = *handle; - s_copy(itprvi + ((i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itprvi", i__1, - "ckbsr_", (ftnlen)3196)) * 40, segid, ( - ftnlen)40, segid_len); - itprvf[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itprvf", i__1, "ckbsr_", ( - ftnlen)3197)] = sticd[(i__2 = p * 6 - 3) < - 300000 && 0 <= i__2 ? i__2 : s_rnge( - "sticd", i__2, "ckbsr_", (ftnlen)3197)]; - moved_(descr, &c__5, &itprvd[(i__1 = iindex * 5 - - 5) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "itprvd", i__1, "ckbsr_", (ftnlen)3199)]); - itchkp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itchkp", i__1, "ckbsr_", ( - ftnlen)3201)] = TRUE_; - } - -/* Go ahead and move the pointer up before returning */ -/* so that the search for the next applicable segment */ -/* will start at the right place. */ - - savep = stpool[(i__1 = (p << 1) + 10) < 100012 && 0 <= - i__1 ? i__1 : s_rnge("stpool", i__1, "ckbsr_" - , (ftnlen)3210)]; - -/* Indicate the first pass of this search has been */ -/* completed. */ - - newsch = FALSE_; - chkout_("CKSNS", (ftnlen)5); - return 0; - } - } - -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - p = stpool[(i__1 = (p << 1) + 10) < 100012 && 0 <= i__1 ? - i__1 : s_rnge("stpool", i__1, "ckbsr_", (ftnlen)3228)] - ; - } - -/* If we're still here we didn't have information for this */ -/* instrument in the segment list. */ - -/* If there are more files, search them. */ -/* Otherwise, things are hopeless, set the status that way. */ - - if (itlfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itlfs", i__1, "ckbsr_", (ftnlen)3239)] > ftnum[0]) { - s_copy(status, "OLD FILES", (ftnlen)40, (ftnlen)9); - } else { - s_copy(status, "HOPELESS", (ftnlen)40, (ftnlen)8); - } - } else if (s_cmp(status, "MAKE ROOM", (ftnlen)40, (ftnlen)9) == 0) { - -/* When adding a new segment to a full table, one of the */ -/* current instruments must be dropped. The ideal */ -/* candidate is the one whose list was constructed at the */ -/* lowest expense. The candidate should be removed from */ -/* the instrument table, and its list transferred to the */ -/* segment table pool. */ - -/* There is ``room'' if the segment table pool contains at */ -/* least one free node. */ - -/* It is possible that a single instrument requires more */ -/* than the entire segment table for its own segments. */ -/* Two things might happen in such a case: */ - -/* 1) If the list under consideration was being added to at */ -/* the end, then a search is continued without buffering */ -/* any segments. */ - -/* 2) If the list was being added to at the beginning, then */ -/* that means there was a NEW FILES search going on, and */ -/* so a brand new list is constructed for the instrument, */ -/* much as in a 'NEW INSTRUMENT' task. */ - -/* There are two different ways to get to this point. */ - -/* 1) From 'ADD TO FRONT' if the segment table pool is full. */ -/* 2) From 'ADD TO END' if the segment table pool is full. */ - -/* Try to make room by deleting a segment list. CHEAP will */ -/* be the index of the "cheapest" segment list in the */ -/* instrument table. */ - - minexp = intmax_(); - cheap = 0; - i__1 = nit; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ != iindex) { - if (itexp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itexp", i__2, "ckbsr_", (ftnlen)3288)] < - minexp || cheap == 0) { - -/* This list is the cheapest seen so far, */ -/* possibly because it's the first one */ -/* considered. At the moment, it's as good */ -/* a candidate for removal as any. */ - - cheap = i__; - minexp = itexp[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itexp", i__2, "ckbsr_", ( - ftnlen)3297)]; - } - } - } - if (cheap == 0) { - -/* If there are no deleteable segments, the Thing To */ -/* Do depends on the task that was suspended before */ -/* entering MAKE ROOM. */ - - if (s_cmp(stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "ckbsr_", (ftnlen)3312)) * 40, - "ADD TO END", (ftnlen)40, (ftnlen)10) == 0) { - -/* The segment meta-data from the current file cannot */ -/* be buffered. We'll search the partial list of */ -/* segments from this file, then proceed to search */ -/* the rest of the file and any other old files, until */ -/* we find an applicable segment or run out of segments. */ - - s_copy(status, "PREPARE PARTIAL LIST", (ftnlen)40, ( - ftnlen)20); - } else { - -/* STACK(TOP) is set to 'ADD TO FRONT'. */ - -/* If there is no room left in the table in the middle */ -/* of an attempt to add to the front of the list, just */ -/* start from scratch by effectively initiating a 'NEW */ -/* INSTRUMENT' task. */ - -/* Return the current list to the segment table pool. */ -/* Note this list is non-empty. */ - - p = itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3335)]; - tail = -lnkprv_(&p, stpool); - lnkfsl_(&p, &tail, stpool); - -/* Re-initialize the table for this instrument, and */ -/* initiate an 'OLD FILES' search, just as in 'NEW */ -/* INSTRUMENT'. */ - - itexp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itexp", i__1, "ckbsr_", (ftnlen)3344)] = - 0; - ithfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ithfs", i__1, "ckbsr_", (ftnlen)3345)] = - ftnum[(i__2 = nft - 1) < 1000 && 0 <= i__2 ? i__2 - : s_rnge("ftnum", i__2, "ckbsr_", (ftnlen)3345)]; - itlfs[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlfs", i__1, "ckbsr_", (ftnlen)3346)] = - ftnum[(i__2 = nft - 1) < 1000 && 0 <= i__2 ? i__2 - : s_rnge("ftnum", i__2, "ckbsr_", (ftnlen)3346)] - + 1; - s_copy(status, "OLD FILES", (ftnlen)40, (ftnlen)9); - } - -/* Unwind the stack; we've set the target states already. */ - - top = 0; - } else { - -/* Return this cheapest list to the segment pool. This */ -/* list could be empty. */ - - head = itbeg[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3362)]; - if (head > 0) { - tail = -lnkprv_(&head, stpool); - lnkfsl_(&head, &tail, stpool); - } - -/* Fill the deleted instrument's space in the table with */ -/* the final entry in the table. */ - - if (cheap != nit) { - itins[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itins", i__1, "ckbsr_", (ftnlen)3378)] = - itins[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itins", i__2, "ckbsr_", (ftnlen)3378)]; - itexp[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itexp", i__1, "ckbsr_", (ftnlen)3379)] = - itexp[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itexp", i__2, "ckbsr_", (ftnlen)3379)]; - ithfs[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ithfs", i__1, "ckbsr_", (ftnlen)3380)] = - ithfs[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("ithfs", i__2, "ckbsr_", (ftnlen)3380)]; - itlfs[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlfs", i__1, "ckbsr_", (ftnlen)3381)] = - itlfs[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itlfs", i__2, "ckbsr_", (ftnlen)3381)]; - itbeg[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3382)] = - itbeg[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itbeg", i__2, "ckbsr_", (ftnlen)3382)]; - itlb[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlb", i__1, "ckbsr_", (ftnlen)3383)] = - itlb[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itlb", i__2, "ckbsr_", (ftnlen)3383)]; - itub[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itub", i__1, "ckbsr_", (ftnlen)3384)] = - itub[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("itub", i__2, "ckbsr_", (ftnlen)3384)]; - itprvh[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itprvh", i__1, "ckbsr_", (ftnlen)3385)] = - itprvh[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("itprvh", i__2, "ckbsr_", (ftnlen)3385)]; - s_copy(itprvi + ((i__1 = cheap - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itprvi", i__1, "ckbsr_", (ftnlen) - 3386)) * 40, itprvi + ((i__2 = nit - 1) < 100 && - 0 <= i__2 ? i__2 : s_rnge("itprvi", i__2, "ckbsr_" - , (ftnlen)3386)) * 40, (ftnlen)40, (ftnlen)40); - itprvf[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itprvf", i__1, "ckbsr_", (ftnlen)3387)] = - itprvf[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("itprvf", i__2, "ckbsr_", (ftnlen)3387)]; - itchkp[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itchkp", i__1, "ckbsr_", (ftnlen)3388)] = - itchkp[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("itchkp", i__2, "ckbsr_", (ftnlen)3388)]; - itruex[(i__1 = cheap - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itruex", i__1, "ckbsr_", (ftnlen)3389)] = - itruex[(i__2 = nit - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("itruex", i__2, "ckbsr_", (ftnlen)3389)]; - moved_(&itprvd[(i__1 = nit * 5 - 5) < 500 && 0 <= i__1 ? - i__1 : s_rnge("itprvd", i__1, "ckbsr_", (ftnlen) - 3391)], &c__5, &itprvd[(i__2 = cheap * 5 - 5) < - 500 && 0 <= i__2 ? i__2 : s_rnge("itprvd", i__2, - "ckbsr_", (ftnlen)3391)]); - } - if (iindex == nit) { - iindex = cheap; - } - -/* One less instrument now. */ - - --nit; - s_copy(status, "RESUME", (ftnlen)40, (ftnlen)6); - } - -/* Either we made room by freeing a non-empty segment list, */ -/* or we're going to work without additional space. In the */ -/* latter case, the state is now 'OLD FILES' or */ -/* 'PREPARE PARTIAL LIST'. */ - - } else if (s_cmp(status, "ADD TO FRONT", (ftnlen)40, (ftnlen)12) == 0) - { - -/* The current segment information should be linked in at */ -/* the head of the segment list for the current instrument, */ -/* and the pertinent instrument table entry should point */ -/* to the new head of the list. */ - -/* The only way to get here is from the block NEW SEGMENTS */ -/* after suspending that task. */ - if (lnknfn_(stpool) == 0) { - s_copy(doing, "ADD TO FRONT", (ftnlen)40, (ftnlen)12); - s_copy(urgent, "MAKE ROOM", (ftnlen)40, (ftnlen)9); - s_copy(status, "SUSPEND", (ftnlen)40, (ftnlen)7); - } else { - -/* Allocate a node and link it to the front of the list */ -/* for the current instrument. */ - - lnkan_(stpool, &new__); - sthan[(i__1 = new__ - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "ckbsr_", (ftnlen)3437)] = fthan[(i__2 - = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "fthan", i__2, "ckbsr_", (ftnlen)3437)]; - dafgn_(stidnt + ((i__1 = new__ - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("stidnt", i__1, "ckbsr_", (ftnlen)3439)) - * 40, (ftnlen)40); - dafus_(descr, &c__2, &c__6, &stdcd[(i__1 = (new__ << 1) - 2) < - 100000 && 0 <= i__1 ? i__1 : s_rnge("stdcd", i__1, - "ckbsr_", (ftnlen)3441)], &sticd[(i__2 = new__ * 6 - - 6) < 300000 && 0 <= i__2 ? i__2 : s_rnge("sticd", - i__2, "ckbsr_", (ftnlen)3441)]); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - -/* If the current list is empty, this append operation */ -/* is a no-op. */ - - lnkilb_(&new__, &itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 - ? i__1 : s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3452) - ], stpool); - itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itbeg", i__1, "ckbsr_", (ftnlen)3453)] = new__; - s_copy(status, "RESUME", (ftnlen)40, (ftnlen)6); - } - } else if (s_cmp(status, "ADD TO END", (ftnlen)40, (ftnlen)10) == 0) { - -/* The current segment information should be linked in at */ -/* the tail of the segment list for the current instrument. */ - -/* The only way to get to this task is from the OLD SEGMENTS */ -/* block after suspending that task. */ - - if (lnknfn_(stpool) == 0) { - s_copy(doing, "ADD TO END", (ftnlen)40, (ftnlen)10); - s_copy(urgent, "MAKE ROOM", (ftnlen)40, (ftnlen)9); - s_copy(status, "SUSPEND", (ftnlen)40, (ftnlen)7); - } else { - -/* Allocate a new node in the segment table pool. */ - - lnkan_(stpool, &new__); - sthan[(i__1 = new__ - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "ckbsr_", (ftnlen)3480)] = fthan[(i__2 - = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "fthan", i__2, "ckbsr_", (ftnlen)3480)]; - dafgn_(stidnt + ((i__1 = new__ - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("stidnt", i__1, "ckbsr_", (ftnlen)3482)) - * 40, (ftnlen)40); - dafus_(descr, &c__2, &c__6, &stdcd[(i__1 = (new__ << 1) - 2) < - 100000 && 0 <= i__1 ? i__1 : s_rnge("stdcd", i__1, - "ckbsr_", (ftnlen)3484)], &sticd[(i__2 = new__ * 6 - - 6) < 300000 && 0 <= i__2 ? i__2 : s_rnge("sticd", - i__2, "ckbsr_", (ftnlen)3484)]); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - if (itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3491)] <= 0) { - -/* This is the first node in the list for this */ -/* instrument. */ - - itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3496)] = - new__; - } else { - -/* Link the new node to the tail of the list. */ - - tail = -lnkprv_(&itbeg[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itbeg", i__1, "ckbsr_", ( - ftnlen)3502)], stpool); - lnkila_(&tail, &new__, stpool); - } - s_copy(status, "RESUME", (ftnlen)40, (ftnlen)6); - } - } else if (s_cmp(status, "PREPARE PARTIAL LIST", (ftnlen)40, (ftnlen) - 20) == 0) { - -/* When the segment table is completely full, continue */ -/* the search by looking through the unchecked portion */ -/* of the segment list for the current instrument, and */ -/* then searching old, unchecked files without buffering */ -/* their segments. */ - -/* The only way to get here is from the MAKE ROOM state */ -/* via the block ADD TO END. If you get here there is no */ -/* free space in the segment table pool. */ - -/* At this point, we need to initialize the cost of */ -/* the re-use interval. */ - - itruex[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itruex", i__1, "ckbsr_", (ftnlen)3527)] = 0; - -/* Find the portion of the current instrument's segment list */ -/* which comes from the current file of interest. SLBEG */ -/* will point to the beginning of this sublist. */ - - slbeg = itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3534)]; - fndhan = FALSE_; - while(! fndhan && slbeg > 0) { - fndhan = sthan[(i__1 = slbeg - 1) < 50000 && 0 <= i__1 ? i__1 - : s_rnge("sthan", i__1, "ckbsr_", (ftnlen)3539)] == - fthan[(i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "ckbsr_", (ftnlen)3539)]; - if (! fndhan) { - -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - slbeg = stpool[(i__1 = (slbeg << 1) + 10) < 100012 && 0 <= - i__1 ? i__1 : s_rnge("stpool", i__1, "ckbsr_", ( - ftnlen)3546)]; - } - } - -/* If the list contains segments from the current file, */ -/* check that portion of the list. */ - -/* Otherwise, finish searching old files without buffering */ -/* anything. */ - - if (slbeg > 0) { - -/* The partial list from the current node onwards is to be */ -/* returned to the free list. Save this node, since */ -/* we'll finish searching the list before freeing the */ -/* partial list. */ - - p = slbeg; - -/* Record the fact that we'll need to free the partial list */ -/* later. */ - - fresub = TRUE_; - -/* It may be that the partial list we're going to delete is */ -/* the entire segment list for this instrument. If so, the */ -/* corresponding instrument table entry should be set to */ -/* a non-positive value to indicate an empty segment list. */ - - if (p == itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3580)]) { - itbeg[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itbeg", i__1, "ckbsr_", (ftnlen)3582)] = - 0; - -/* Also in this case, we must initialize the time */ -/* bounds for this instrument. */ - - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlb", i__1, "ckbsr_", (ftnlen)3588)] = - dpmin_(); - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itub", i__1, "ckbsr_", (ftnlen)3589)] = - dpmax_(); - } - s_copy(status, "CHECK PARTIAL LIST", (ftnlen)40, (ftnlen)18); - } else { - s_copy(status, "SEARCH W/O BUFF", (ftnlen)40, (ftnlen)15); - } - } else if (s_cmp(status, "CHECK PARTIAL LIST", (ftnlen)40, (ftnlen)18) - == 0) { - -/* The only ways to get here are from the */ -/* 'PREPARE PARTIAL LIST' state, or by resuming a search of */ -/* the partial list. */ - -/* The portion of the segment list from the current file */ -/* is to be checked. */ - -/* BEG points to the current segment in the temporary portion */ -/* of the list. */ - -/* Reject a segment if there is a need for angular velocity */ -/* data and the segment doesn't have it. */ - - while(p > 0) { - -/* If this is a new search, update the re-use interval */ -/* and its expense. */ - - if (newsch) { - -/* Every segment seen from the current file contributes */ -/* to the expense of the re-use interval. */ - - itruex[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itruex", i__1, "ckbsr_", (ftnlen)3628)] = - itruex[(i__2 = iindex - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itruex", i__2, "ckbsr_", (ftnlen) - 3628)] + 1; - -/* Trim the re-use interval if the request time lies */ -/* outside the coverage of the current segment. */ - - if (reqt > stdcd[(i__1 = (p << 1) - 1) < 100000 && 0 <= - i__1 ? i__1 : s_rnge("stdcd", i__1, "ckbsr_", ( - ftnlen)3634)]) { - -/* REQT is to the right of the coverage interval of */ -/* this segment. Trim the re-use interval on the */ -/* left, if necessary. */ - -/* Computing MAX */ - d__1 = itlb[(i__2 = iindex - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itlb", i__2, "ckbsr_", (ftnlen) - 3640)], d__2 = stdcd[(i__3 = (p << 1) - 1) < - 100000 && 0 <= i__3 ? i__3 : s_rnge("stdcd", - i__3, "ckbsr_", (ftnlen)3640)]; - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itlb", i__1, "ckbsr_", (ftnlen)3640)] - = max(d__1,d__2); - } else if (reqt < stdcd[(i__1 = (p << 1) - 2) < 100000 && - 0 <= i__1 ? i__1 : s_rnge("stdcd", i__1, "ckbsr_", - (ftnlen)3643)]) { - -/* REQT is to the left of the coverage interval of */ -/* this segment. Trim the re-use interval on the */ -/* right, if necessary. */ - -/* Computing MIN */ - d__1 = itub[(i__2 = iindex - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("itub", i__2, "ckbsr_", (ftnlen) - 3649)], d__2 = stdcd[(i__3 = (p << 1) - 2) < - 100000 && 0 <= i__3 ? i__3 : s_rnge("stdcd", - i__3, "ckbsr_", (ftnlen)3649)]; - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itub", i__1, "ckbsr_", (ftnlen)3649)] - = min(d__1,d__2); - } - } - -/* We've updated the re-use interval if so required. */ - - if (omega >= stdcd[(i__1 = (p << 1) - 2) < 100000 && 0 <= - i__1 ? i__1 : s_rnge("stdcd", i__1, "ckbsr_", (ftnlen) - 3658)] && alpha <= stdcd[(i__2 = (p << 1) - 1) < - 100000 && 0 <= i__2 ? i__2 : s_rnge("stdcd", i__2, - "ckbsr_", (ftnlen)3658)]) { - -/* The segment coverage interval intersects the request */ -/* interval ALPHA:OMEGA. */ - - if (! avneed || sticd[(i__1 = p * 6 - 3) < 300000 && 0 <= - i__1 ? i__1 : s_rnge("sticd", i__1, "ckbsr_", ( - ftnlen)3664)] != 0) { - -/* This segment satisfies the request. Set the */ -/* output arguments. */ - - dafps_(&c__2, &c__6, &stdcd[(i__1 = (p << 1) - 2) < - 100000 && 0 <= i__1 ? i__1 : s_rnge("stdcd", - i__1, "ckbsr_", (ftnlen)3669)], &sticd[(i__2 = - p * 6 - 6) < 300000 && 0 <= i__2 ? i__2 : - s_rnge("sticd", i__2, "ckbsr_", (ftnlen)3669)] - , descr); - s_copy(segid, stidnt + ((i__1 = p - 1) < 50000 && 0 <= - i__1 ? i__1 : s_rnge("stidnt", i__1, "ckbsr_" - , (ftnlen)3672)) * 40, segid_len, (ftnlen)40); - *handle = sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("sthan", i__1, "ckbsr_", ( - ftnlen)3673)]; - *found = TRUE_; - -/* If this is the first pass performed for the */ -/* current search, then we can set the re-use */ -/* interval. The re-use interval becomes invalid */ -/* after the first pass. */ - -/* If the segment actually contains the request */ -/* time, set the re-use interval. We require */ -/* the request time to be in the interior of the */ -/* interval: it cannot be one of the endpoints. */ - - if (newsch && reqt > stdcd[(i__1 = (p << 1) - 2) < - 100000 && 0 <= i__1 ? i__1 : s_rnge("stdcd", - i__1, "ckbsr_", (ftnlen)3687)] && reqt < - stdcd[(i__2 = (p << 1) - 1) < 100000 && 0 <= - i__2 ? i__2 : s_rnge("stdcd", i__2, "ckbsr_", - (ftnlen)3687)]) { - -/* Adjust the re-use interval for the current */ -/* instrument. */ - -/* Computing MAX */ - d__1 = itlb[(i__2 = iindex - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("itlb", i__2, "ckbs" - "r_", (ftnlen)3694)], d__2 = stdcd[(i__3 = - (p << 1) - 2) < 100000 && 0 <= i__3 ? - i__3 : s_rnge("stdcd", i__3, "ckbsr_", ( - ftnlen)3694)]; - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itlb", i__1, "ckbsr_", ( - ftnlen)3694)] = max(d__1,d__2); -/* Computing MIN */ - d__1 = itub[(i__2 = iindex - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("itub", i__2, "ckbs" - "r_", (ftnlen)3695)], d__2 = stdcd[(i__3 = - (p << 1) - 1) < 100000 && 0 <= i__3 ? - i__3 : s_rnge("stdcd", i__3, "ckbsr_", ( - ftnlen)3695)]; - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itub", i__1, "ckbsr_", ( - ftnlen)3695)] = min(d__1,d__2); - -/* Save the returned output items, in case this */ -/* segment may satisfy the next request. */ - - itprvh[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itprvh", i__1, "ckbsr_", ( - ftnlen)3700)] = *handle; - s_copy(itprvi + ((i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itprvi", i__1, - "ckbsr_", (ftnlen)3701)) * 40, segid, ( - ftnlen)40, segid_len); - itprvf[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itprvf", i__1, "ckbsr_", ( - ftnlen)3702)] = sticd[(i__2 = p * 6 - 3) < - 300000 && 0 <= i__2 ? i__2 : s_rnge( - "sticd", i__2, "ckbsr_", (ftnlen)3702)]; - moved_(descr, &c__5, &itprvd[(i__1 = iindex * 5 - - 5) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "itprvd", i__1, "ckbsr_", (ftnlen)3704)]); - itchkp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itchkp", i__1, "ckbsr_", ( - ftnlen)3706)] = TRUE_; - -/* Update the expense of the list to reflect */ -/* the cost of locating this segment. */ - - itexp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itexp", i__1, "ckbsr_", ( - ftnlen)3711)] = itexp[(i__2 = iindex - 1) - < 100 && 0 <= i__2 ? i__2 : s_rnge("itexp" - , i__2, "ckbsr_", (ftnlen)3711)] + itruex[ - (i__3 = iindex - 1) < 100 && 0 <= i__3 ? - i__3 : s_rnge("itruex", i__3, "ckbsr_", ( - ftnlen)3711)]; - } - -/* We've set the re-use interval. */ - -/* Go ahead and move the pointer up before returning */ -/* so that the search for the next applicable segment */ -/* will start at the right place. */ - -/* We avoid LNKNXT here in order to speed up the */ -/* operation. */ - - savep = stpool[(i__1 = (p << 1) + 10) < 100012 && 0 <= - i__1 ? i__1 : s_rnge("stpool", i__1, "ckbsr_" - , (ftnlen)3724)]; - -/* We cannot free the partial list yet, because */ -/* we may return to search it again if the current */ -/* segment doesn't have pointing that satisfies */ -/* the caller's request. The list will be freed */ -/* at the start of the next search if it's not */ -/* freed at the end of this block or in the */ -/* 'SEARCH W/O BUFFERING' block. */ - -/* Indicate the first pass of this search has been */ -/* completed. */ - - newsch = FALSE_; - chkout_("CKSNS", (ftnlen)5); - return 0; - } - -/* Getting here implies angular velocity was */ -/* requested but was not present in the segment. */ - - } - -/* The current segment didn't match. Look at the next */ -/* segment in the list. */ - - p = stpool[(i__1 = (p << 1) + 10) < 100012 && 0 <= i__1 ? - i__1 : s_rnge("stpool", i__1, "ckbsr_", (ftnlen)3753)] - ; - } - -/* We're done looking at the partial list. */ - -/* Return the partial list to the segment table pool. */ -/* P at this point is the negative of the list head. */ -/* The list tail is (by the spec of the SPICELIB doubly */ -/* linked list routines) the negative of the predecessor */ -/* of the head. */ - -/* Note the list is always non-empty at this point. */ - - i__1 = -p; - tail = -lnkprv_(&i__1, stpool); - lnkfsl_(&slbeg, &tail, stpool); - fresub = FALSE_; - -/* Search the remaining files. */ - - s_copy(status, "SEARCH W/O BUFF", (ftnlen)40, (ftnlen)15); - } else if (s_cmp(status, "SEARCH W/O BUFF", (ftnlen)40, (ftnlen)15) == - 0) { - -/* The only ways to get here are from the */ -/* 'PREPARE PARTIAL LIST' and 'CHECK PARTIAL LIST' states. */ - -/* When the segment table is full with the current instrument's */ -/* segments and any freed up portions have been checked, */ -/* continue the search for applicable segments in old files, */ -/* without buffering any of the segments in the segment table. */ - -/* Recall that a search is already in progress and that a */ -/* segment is currently under consideration (FND = .TRUE.). */ - - while(findex > 0) { - while(fnd) { - if (newsch) { - -/* Each segment found contributes to the expense of */ -/* the re-use interval. */ - - itruex[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("itruex", i__1, "ckbsr_", (ftnlen) - 3801)] = itruex[(i__2 = iindex - 1) < 100 && - 0 <= i__2 ? i__2 : s_rnge("itruex", i__2, - "ckbsr_", (ftnlen)3801)] + 1; - } - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - if (failed_()) { - chkout_("CKSNS", (ftnlen)5); - return 0; - } - if (scinst == icd[0]) { - -/* This is a segment for the instrument of interest. */ - if (newsch) { - -/* Update the re-use interval for this instrument. */ - - if (reqt > dcd[1]) { - -/* REQT is to the right of the coverage interval */ -/* of this segment. Trim the re-use interval */ -/* on the left, if necessary. */ - -/* Computing MAX */ - d__1 = itlb[(i__2 = iindex - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("itlb", i__2, - "ckbsr_", (ftnlen)3828)]; - itlb[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itlb", i__1, "ckbsr_", - (ftnlen)3828)] = max(d__1,dcd[1]); - } else if (reqt < dcd[0]) { - -/* REQT is to the left of the coverage interval */ -/* of this segment. Trim the re-use interval */ -/* on the right, if necessary. */ - -/* Computing MIN */ - d__1 = itub[(i__2 = iindex - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("itub", i__2, - "ckbsr_", (ftnlen)3837)]; - itub[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("itub", i__1, "ckbsr_", - (ftnlen)3837)] = min(d__1,dcd[0]); - } - } - -/* We've trimmed the re-use interval if necessary. */ - - if (omega >= dcd[0] && alpha <= dcd[1]) { - -/* The segment coverage interval intersects the */ -/* request interval ALPHA:OMEGA. */ - - if (! avneed || icd[3] != 0) { - -/* This segment satisfies the request. Set */ -/* the output arguments. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - dafgn_(segid, segid_len); - *handle = fthan[(i__1 = findex - 1) < 1000 && - 0 <= i__1 ? i__1 : s_rnge("fthan", - i__1, "ckbsr_", (ftnlen)3861)]; - *found = TRUE_; - if (newsch) { - -/* Adjust the re-use interval for the current */ -/* instrument. */ - -/* Computing MAX */ - d__1 = itlb[(i__2 = iindex - 1) < 100 && - 0 <= i__2 ? i__2 : s_rnge("itlb", - i__2, "ckbsr_", (ftnlen)3869)]; - itlb[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itlb", i__1, - "ckbsr_", (ftnlen)3869)] = max( - d__1,dcd[0]); -/* Computing MIN */ - d__1 = itub[(i__2 = iindex - 1) < 100 && - 0 <= i__2 ? i__2 : s_rnge("itub", - i__2, "ckbsr_", (ftnlen)3870)]; - itub[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itub", i__1, - "ckbsr_", (ftnlen)3870)] = min( - d__1,dcd[1]); - -/* Save the returned output items, in case */ -/* this segment may satisfy the next request. */ - - itprvh[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itprvh", - i__1, "ckbsr_", (ftnlen)3876)] = * - handle; - s_copy(itprvi + ((i__1 = iindex - 1) < - 100 && 0 <= i__1 ? i__1 : s_rnge( - "itprvi", i__1, "ckbsr_", (ftnlen) - 3877)) * 40, segid, (ftnlen)40, - segid_len); - itprvf[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itprvf", - i__1, "ckbsr_", (ftnlen)3878)] = - icd[3]; - moved_(descr, &c__5, &itprvd[(i__1 = - iindex * 5 - 5) < 500 && 0 <= - i__1 ? i__1 : s_rnge("itprvd", - i__1, "ckbsr_", (ftnlen)3880)]); - itchkp[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itchkp", - i__1, "ckbsr_", (ftnlen)3883)] = - TRUE_; - -/* Update the expense of the list to reflect */ -/* cost of locating this segment. */ - - itexp[(i__1 = iindex - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("itexp", - i__1, "ckbsr_", (ftnlen)3889)] = - itexp[(i__2 = iindex - 1) < 100 && - 0 <= i__2 ? i__2 : s_rnge("itexp" - , i__2, "ckbsr_", (ftnlen)3889)] - + itruex[(i__3 = iindex - 1) < - 100 && 0 <= i__3 ? i__3 : s_rnge( - "itruex", i__3, "ckbsr_", (ftnlen) - 3889)]; - } - -/* The re-use interval is set. */ - -/* Go ahead and point to the next segment in the */ -/* file in case an attempt is made to continue */ -/* the search: you want to pick up exactly where */ -/* you left off. */ - - daffpa_(&fnd); - -/* Indicate the first pass of this search has */ -/* been completed. */ - - newsch = FALSE_; - chkout_("CKSNS", (ftnlen)5); - return 0; - } - -/* Getting here implies angular velocity was */ -/* requested but was not present in the segment. */ - - } - -/* The current segment's coverage didn't intersect */ -/* the request interval. */ - - } - -/* The current segment didn't contain data for the */ -/* specified instrument. */ - -/* Look at the next segment in the current file. */ - - daffpa_(&fnd); - } - -/* Try the next oldest file. */ - - --findex; - if (findex > 0) { - dafbbs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("fthan", i__1, "ckbsr_", (ftnlen) - 3938)]); - daffpa_(&fnd); - } - } - -/* There's nothing nowhere if you get to here. */ - - itruex[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "itruex", i__1, "ckbsr_", (ftnlen)3948)] = 0; - s_copy(status, "HOPELESS", (ftnlen)40, (ftnlen)8); - } else if (s_cmp(status, "SUSPEND", (ftnlen)40, (ftnlen)7) == 0) { - -/* When a task is suspended, the current activity is placed on */ -/* a stack, to be restored later. Two levels are provided, */ -/* since some interrupts can be interrupted by others. */ - - ++top; - s_copy(stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "stack", i__1, "ckbsr_", (ftnlen)3959)) * 40, doing, ( - ftnlen)40, (ftnlen)40); - s_copy(status, urgent, (ftnlen)40, (ftnlen)40); - } else if (s_cmp(status, "RESUME", (ftnlen)40, (ftnlen)6) == 0) { - s_copy(status, stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "ckbsr_", (ftnlen)3964)) * 40, ( - ftnlen)40, (ftnlen)40); - --top; - } - } - -/* Can only get here if status is 'HOPELESS', in which case a */ -/* segment was not found. */ - - *found = FALSE_; - -/* If we didn't find a segment, don't attempt to use saved */ -/* outputs from a previous call. IINDEX will always be set */ -/* at this point. Also, make sure the expense of the re-use */ -/* interval is zeroed out. */ - - if (iindex > 0) { - itchkp[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itchkp" - , i__1, "ckbsr_", (ftnlen)3985)] = FALSE_; - itruex[(i__1 = iindex - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("itruex" - , i__1, "ckbsr_", (ftnlen)3986)] = 0; - } - -/* For safety, indicate the first pass of this search has been */ -/* completed. Normally, we won't return here before CKBSS is */ -/* called again, but it's possible. */ - - newsch = FALSE_; - chkout_("CKSNS", (ftnlen)5); - return 0; -/* $Procedure CKHAVE ( C-kernels --- Have some ) */ - -L_ckhave: -/* $ Abstract */ - -/* Determine whether or not any C-kernels are currently loaded. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* C-KERNEL */ - -/* $ Declarations */ - -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FOUND O TRUE if at least one C-kernel is loaded. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* FOUND is returned with the value TRUE if at least one */ -/* C-kernel is currently loaded. Otherwise it returns */ -/* the value FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point allows the user to query the set of "loaded" */ -/* C-kernels to make sure that at least one C-kernel has been loaded. */ -/* This allows you to avoid making a search of an empty set of */ -/* loaded kernels which forces a SPICELIB error to be signaled. */ - -/* $ Examples */ - -/* Suppose you want to call on of the C-kernel readers, but wish */ -/* to handle the exceptional case of "no kernels loaded" so that */ -/* the SPICELIB exception handling mechanism is avoided in the */ -/* case of an empty set of loaded kernels. The code fragment */ -/* below shows how you might do this: */ - -/* CALL CKHAVE ( LOADED ) */ - -/* IF ( LOADED ) THEN */ - -/* CALL CKGP ( ... ) */ - -/* ELSE */ - -/* take some kind of "reasonable action" */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.2, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 4.0.1, 31-OCT-2001 (NJB) */ - -/* Typo corrected. */ - -/* - SPICELIB Version 4.0.0, 17-FEB-2000 (WLT) */ - -/* Added the Entry point CKHAVE */ - -/* - SPICELIB Version 3.0.0, 03-MAR-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Determine whether any C-kernels are loaded */ - -/* -& */ - *found = nft > 0; - return 0; -} /* ckbsr_ */ - -/* Subroutine */ int ckbsr_(char *fname, integer *handle, integer *inst, - doublereal *sclkdp, doublereal *tol, logical *needav, doublereal * - descr, char *segid, logical *found, ftnlen fname_len, ftnlen - segid_len) -{ - return ckbsr_0_(0, fname, handle, inst, sclkdp, tol, needav, descr, segid, - found, fname_len, segid_len); - } - -/* Subroutine */ int cklpf_(char *fname, integer *handle, ftnlen fname_len) -{ - return ckbsr_0_(1, fname, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (logical *)0, (doublereal *)0, (char *)0, ( - logical *)0, fname_len, (ftnint)0); - } - -/* Subroutine */ int ckupf_(integer *handle) -{ - return ckbsr_0_(2, (char *)0, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (logical *)0, (doublereal *)0, (char *)0, ( - logical *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ckbss_(integer *inst, doublereal *sclkdp, doublereal * - tol, logical *needav) -{ - return ckbsr_0_(3, (char *)0, (integer *)0, inst, sclkdp, tol, needav, ( - doublereal *)0, (char *)0, (logical *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int cksns_(integer *handle, doublereal *descr, char *segid, - logical *found, ftnlen segid_len) -{ - return ckbsr_0_(4, (char *)0, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (logical *)0, descr, segid, found, (ftnint)0, - segid_len); - } - -/* Subroutine */ int ckhave_(logical *found) -{ - return ckbsr_0_(5, (char *)0, (integer *)0, (integer *)0, (doublereal *)0, - (doublereal *)0, (logical *)0, (doublereal *)0, (char *)0, found, - (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/ckcls.c b/ext/spice/src/cspice/ckcls.c deleted file mode 100644 index 73af55223d..0000000000 --- a/ext/spice/src/cspice/ckcls.c +++ /dev/null @@ -1,209 +0,0 @@ -/* ckcls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CKCLS ( CK, Close file ) */ -/* Subroutine */ int ckcls_(integer *handle) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), dafcls_(integer *); - char access[5]; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Close an open CK file. */ - -/* $ 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 */ - -/* CK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the CK file to be closed. */ - -/* $ Detailed_Input */ - -/* HANDLE The handle of the CK file that is to be closed. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there are no segments in the file the error */ -/* SPICE(NOSEGMENTSFOUND) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Close the CK file attached to HANDLE. */ - -/* $ Examples */ - -/* Suppose that you want to create a new CK file called 'new.ck' */ -/* that contains a single type 3 CK segment and has room for at */ -/* least 5000 comment characters. The following code fragment should */ -/* take care of this for you, assuming that all of the variables */ -/* passed to the CK type 3 segment writer have appropriate values. */ - -/* NAME = 'new.ck' */ -/* IFNAME = 'Test CK file' */ - -/* CALL CKOPN ( NAME, IFNAME, 5000, HANDLE ) */ -/* CALL CKW03 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */ -/* . SEGID, NREC, SCLKDP, QUATS, AVVS, NINTS, */ -/* . STARTS ) */ -/* CALL CKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Removed DAFHLU call; replaced ERRFNM call with ERRHAN. */ - -/* - SPICELIB Version 1.1.0, 17-FEB-2000 (FST) */ - -/* Removed the call to ZZFIXID. This will make all C-kernels */ -/* created with future versions of the toolkit possess the */ -/* unambiguous ID word 'DAF/CK '. */ - -/* - SPICELIB Version 1.0.0, 27-JAN-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* close a ck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local Variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKCLS", (ftnlen)5); - -/* Get the access method for the file. Currently, if HANDLE < 0, the */ -/* access method is 'WRITE'. If HANDLE > 0, the access method is */ -/* 'READ'. In the future this should make use of the private entry */ -/* in the handle manager umbrella, ZZDDHNFO. */ - - if (*handle < 0) { - s_copy(access, "WRITE", (ftnlen)5, (ftnlen)5); - } else if (*handle > 0) { - s_copy(access, "READ", (ftnlen)5, (ftnlen)4); - } - -/* Fix the ID word if the file is open for writing and close the */ -/* file, or just close the file. */ - - if (s_cmp(access, "WRITE", (ftnlen)5, (ftnlen)5) == 0) { - -/* Check to see if there are any segments in the file. If there */ -/* are no segments, we signal an error. This probably indicates a */ -/* programming error of some sort anyway. Why would you create a */ -/* file and put nothing in it? */ - - dafbfs_(handle); - daffna_(&found); - if (failed_()) { - chkout_("CKCLS", (ftnlen)5); - return 0; - } - if (! found) { - setmsg_("No segments were found in the CK file '#'. There must b" - "e at least one segment in the file when this subroutine " - "is called.", (ftnlen)121); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(NOSEGMENTSFOUND)", (ftnlen)22); - chkout_("CKCLS", (ftnlen)5); - return 0; - } - } - -/* Close the file. */ - - dafcls_(handle); - -/* No need to check FAILED() here, since we just return. The caller */ -/* should check it though. */ - - chkout_("CKCLS", (ftnlen)5); - return 0; -} /* ckcls_ */ - diff --git a/ext/spice/src/cspice/ckcls_c.c b/ext/spice/src/cspice/ckcls_c.c deleted file mode 100644 index e0b81d3c7c..0000000000 --- a/ext/spice/src/cspice/ckcls_c.c +++ /dev/null @@ -1,148 +0,0 @@ -/* - --Procedure ckcls_c ( CK, Close file ) - --Abstract - - Close an open CK file. - --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 - - CK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void ckcls_c ( SpiceInt handle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - handle I Handle of the CK file to be closed. - --Detailed_Input - - handle The handle of the CK file that is to be closed. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If there are no segments in the file the error - SPICE(NOSEGMENTSFOUND) will be signalled. - --Files - - See Detailed_Input. - --Particulars - - Close the CK file attached to handle. - --Examples - - Suppose that you want to create a new CK file called "new.ck" - that contains a single type 3 CK segment and has room for at - least 5000 comment characters. The following code fragment should - take care of this for you, assuming that all of the variables - passed to the CK type 3 segment writer have appropriate values. - - name = "new.ck"; - ifname = "Test CK file"; - - ckopn_c ( name, ifname, 5000, &handle ); - - ckw03_c ( handle, begtim, endtim, inst, - ref, avflag, segid, nrec, - sclkdp, quats, avvs, nints, starts ); - - ckcls_c ( handle ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (NJB) - K.R. Gehringer (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 08-MAR-2002 (EDW) - - Corrected header typo. Examples" to Examples. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 26-JAN-1995 (KRG) - --Index_Entries - - close a ck file - --& -*/ - -{ /* Begin ckcls_c */ - - - /* - Participate in error handling. - */ - chkin_c ( "ckcls_c"); - - - ckcls_ ( ( integer * ) &handle ); - - - chkout_c ( "ckcls_c"); - -} /* End ckcls_c */ - diff --git a/ext/spice/src/cspice/ckcov.c b/ext/spice/src/cspice/ckcov.c deleted file mode 100644 index effdacbd71..0000000000 --- a/ext/spice/src/cspice/ckcov.c +++ /dev/null @@ -1,902 +0,0 @@ -/* ckcov.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKCOV ( CK coverage ) */ -/* Subroutine */ int ckcov_(char *ck, integer *idcode, logical *needav, char * - level, doublereal *tol, char *timsys, doublereal *cover, ftnlen - ck_len, ftnlen level_len, ftnlen timsys_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - char arch[80]; - logical avok; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int dafgs_(doublereal *); - integer clkid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - doublereal dctol[2]; - logical istdb, found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer dtype; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - doublereal et; - integer handle, segbeg; - extern /* Subroutine */ int dafcls_(integer *), ckmeta_(integer *, char *, - integer *, ftnlen); - integer segend; - extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen); - logical seglvl; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), wninsd_(doublereal *, doublereal *, doublereal *), - errint_(char *, integer *, ftnlen); - char kertyp[80]; - extern logical return_(void); - extern /* Subroutine */ int zzckcv01_(integer *, integer *, integer *, - integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv02_( - integer *, integer *, integer *, integer *, doublereal *, char *, - doublereal *, ftnlen), zzckcv03_(integer *, integer *, integer *, - integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv04_( - integer *, integer *, integer *, integer *, doublereal *, char *, - doublereal *, ftnlen), zzckcv05_(integer *, integer *, integer *, - integer *, doublereal *, doublereal *, char *, doublereal *, - ftnlen); - -/* $ Abstract */ - -/* Find the coverage window for a specified object in a specified CK */ -/* file. */ - -/* $ 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 */ - -/* CELLS */ -/* DAF */ -/* CK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* POINTING */ -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CK I Name of CK file. */ -/* IDCODE I ID code of object. */ -/* NEEDAV I Flag indicating whether angular velocity is needed. */ -/* LEVEL I Coverage level: 'SEGMENT' OR 'INTERVAL'. */ -/* TOL I Tolerance in ticks. */ -/* TIMSYS I Time system used to represent coverage. */ -/* COVER I/O Window giving coverage for IDCODE. */ - -/* $ Detailed_Input */ - -/* CK is the name of a C-kernel. */ - -/* IDCODE is the integer ID code of an object, normally */ -/* a spacecraft structure or instrument, for which */ -/* pointing data are expected to exist in the */ -/* specified CK file. */ - -/* NEEDAV is a logical variable indicating whether only */ -/* segments having angular velocity are to be */ -/* considered when determining coverage. When */ -/* NEEDAV is .TRUE., segments without angular */ -/* velocity don't contribute to the coverage */ -/* window; when NEEDAV is .FALSE., all segments for */ -/* IDCODE may contribute to the coverage window. */ - - -/* LEVEL is the level (granularity) at which the coverage */ -/* is examined. Allowed values and corresponding */ -/* meanings are: */ - -/* 'SEGMENT' The output coverage window */ -/* contains intervals defined by the */ -/* start and stop times of segments */ -/* for the object designated by */ -/* IDCODE. */ - -/* 'INTERVAL' The output coverage window */ -/* contains interpolation intervals */ -/* of segments for the object */ -/* designated by IDCODE. For type 1 */ -/* segments, which don't have */ -/* interpolation intervals, each */ -/* epoch associated with a pointing */ -/* instance is treated as a singleton */ -/* interval; these intervals are */ -/* added to the coverage window. */ - -/* All interpolation intervals are */ -/* considered to lie within the */ -/* segment bounds for the purpose of */ -/* this summary: if an interpolation */ -/* interval extends beyond the */ -/* segment coverage interval, only */ -/* its intersection with the segment */ -/* coverage interval is considered to */ -/* contribute to the total coverage. */ - - -/* TOL is a tolerance value expressed in ticks of the */ -/* spacecraft clock associated with IDCODE. Before */ -/* each interval is inserted into the coverage */ -/* window, the interval is intersected with the */ -/* segment coverage interval, then if the */ -/* intersection is non-empty, it is expanded by TOL: */ -/* the left endpoint of the intersection interval is */ -/* reduced by TOL and the right endpoint is increased */ -/* by TOL. Adjusted interval endpoints, when */ -/* expressed as encoded SCLK, never are less than */ -/* zero ticks. Any intervals that overlap as a */ -/* result of the expansion are merged. */ - -/* The coverage window returned when TOL > 0 */ -/* indicates the coverage provided by the file to the */ -/* CK readers CKGPAV and CKGP when that value of TOL */ -/* is passed to them as an input. */ - - -/* TIMSYS is a string indicating the time system used */ -/* in the output coverage window. TIMSYS may */ -/* have the values: */ - -/* 'SCLK' Elements of COVER are expressed in */ -/* encoded SCLK ("ticks"), where the */ -/* clock is associated with the object */ -/* designated by IDCODE. */ - -/* 'TDB' Elements of COVER are expressed as */ -/* seconds past J2000 TDB. */ - - -/* COVER is an initialized SPICELIB window data structure. */ -/* COVER optionally may contain coverage data on */ -/* input; on output, the data already present in */ -/* COVER will be combined with coverage found for the */ -/* object designated by IDCODE in the file CK. */ - -/* If COVER contains no data on input, its size and */ -/* cardinality still must be initialized. */ - -/* $ Detailed_Output */ - -/* COVER is a SPICELIB window data structure which */ -/* represents the merged coverage for IDCODE. When */ -/* the coverage level is 'INTERVAL', this is the set */ -/* of time intervals for which data for IDCODE are */ -/* present in the file CK, merged with the set of */ -/* time intervals present in COVER on input. The */ -/* merged coverage is represented as the union of one */ -/* or more disjoint time intervals. The window COVER */ -/* contains the pairs of endpoints of these */ -/* intervals. */ - -/* When the coverage level is 'SEGMENT', COVER is */ -/* computed in a manner similar to that described */ -/* above, but the coverage intervals used in the */ -/* computation are those of segments rather than */ -/* interpolation intervals within segments. */ - -/* When TOL is > 0, the intervals comprising the */ -/* coverage window for IDCODE are expanded by TOL and */ -/* any intervals overlapping as a result are merged. */ -/* The resulting window is returned in COVER. The */ -/* expanded window in no case extends beyond the */ -/* segment bounds in either direction by more than */ -/* TOL. */ - -/* The interval endpoints contained in COVER are */ -/* encoded spacecraft clock times if TIMSYS is */ -/* 'SCLK'; otherwise the times are converted from */ -/* encoded spacecraft clock to seconds past J2000 */ -/* TDB. */ - -/* See the Examples section below for a complete */ -/* example program showing how to retrieve the */ -/* endpoints from COVER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file has transfer format, the error */ -/* SPICE(INVALIDFORMAT) is signaled. */ - -/* 2) If the input file is not a transfer file but has architecture */ -/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */ - -/* 3) If the input file is a binary DAF file of type other than */ -/* CK, the error SPICE(BADFILETYPE) is signaled. */ - -/* 4) If the CK file cannot be opened or read, the error will */ -/* be diagnosed by routines called by this routine. The output */ -/* window will not be modified. */ - -/* 5) If the size of the output WINDOW argument COVER is */ -/* insufficient to contain the actual number of intervals in the */ -/* coverage window for IDCODE, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 6) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* 7) If LEVEL is not recognized, the error SPICE(INVALIDOPTION) */ -/* is signaled. */ - -/* 8) If TIMSYS is not recognized, the error SPICE(NOTSUPPORTED) */ -/* is signaled. */ - -/* 9) If a time conversion error occurs, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 10) If the output time system is TDB, the CK subsystem must be */ -/* able to map IDCODE to the ID code of the associated */ -/* spacecraft clock. If this mapping cannot be performed, the */ -/* error will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* This routine reads a C-kernel. */ - -/* If the output time system is 'TDB', then a leapseconds kernel */ -/* and an SCLK kernel for the spacecraft clock associated with */ -/* IDCODE must be loaded before this routine is called. */ - -/* If the ID code of the clock associated with IDCODE is not */ -/* equal to */ - -/* IDCODE / 1000 */ - -/* then the kernel variable */ - -/* CK__SCLK */ - -/* must be present in the kernel pool to identify the clock */ -/* associated with IDCODE. This variable must contain the ID code */ -/* to be used for conversion between SCLK and TDB. Normally this */ -/* variable is provided in a text kernel loaded via FURNSH. */ - -/* $ Particulars */ - -/* This routine provides an API via which applications can determine */ -/* the coverage a specified CK file provides for a specified */ -/* object. */ - -/* $ Examples */ - -/* 1) Display the interval-level coverage for each object in a */ -/* specified CK file. Use tolerance of zero ticks. Do not */ -/* request angular velocity. Express the results in the TDB time */ -/* system. */ - -/* Find the set of objects in the file. Loop over the contents */ -/* of the ID code set: find the coverage for each item in the */ -/* set and display the coverage. */ - - -/* PROGRAM CKCVR */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ -/* INTEGER CARDI */ -/* C */ -/* C Local parameters */ -/* C */ -/* C */ -/* C Declare the coverage window. Make enough room */ -/* C for MAXIV intervals. */ -/* C */ -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXIV */ -/* PARAMETER ( MAXIV = 100000 ) */ - -/* INTEGER WINSIZ */ -/* PARAMETER ( WINSIZ = 2 * MAXIV ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER MAXOBJ */ -/* PARAMETER ( MAXOBJ = 1000 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) CK */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) SCLK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER I */ -/* INTEGER IDS ( LBCELL : MAXOBJ ) */ -/* INTEGER J */ -/* INTEGER NIV */ - -/* C */ -/* C Load a leapseconds kernel and SCLK kernel for output */ -/* C time conversion. Note that we assume a single spacecraft */ -/* C clock is associated with all of the objects in the CK. */ -/* C */ -/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */ -/* CALL FURNSH ( LSK ) */ - -/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */ -/* CALL FURNSH ( SCLK ) */ - -/* C */ -/* C Get name of CK file. */ -/* C */ -/* CALL PROMPT ( 'Name of CK file > ', CK ) */ - -/* C */ -/* C Initialize the set IDS. */ -/* C */ -/* CALL SSIZEI ( MAXOBJ, IDS ) */ - -/* C */ -/* C Initialize the window COVER. */ -/* C */ -/* CALL SSIZED ( WINSIZ, COVER ) */ - -/* C */ -/* C Find the set of objects in the CK file. */ -/* C */ -/* CALL CKOBJ ( CK, IDS ) */ - -/* C */ -/* C We want to display the coverage for each object. Loop */ -/* C over the contents of the ID code set, find the coverage */ -/* C for each item in the set, and display the coverage. */ -/* C */ -/* DO I = 1, CARDI( IDS ) */ -/* C */ -/* C Find the coverage window for the current */ -/* C object. Empty the coverage window each time */ -/* C so we don't include data for the previous object. */ -/* C */ -/* CALL SCARDD ( 0, COVER ) */ -/* CALL CKCOV ( CK, IDS(I), .FALSE., */ -/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */ - -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) '========================================' */ -/* WRITE (*,*) 'Coverage for object ', IDS(I) */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO J = 1, NIV */ -/* C */ -/* C Get the endpoints of the Jth interval. */ -/* C */ -/* CALL WNFETD ( COVER, J, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.###### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', J */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.###### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* WRITE (*,*) '========================================' */ - -/* END DO */ - -/* END */ - - -/* 2) Find the segment-level coverage for the object designated by */ -/* IDCODE provided by the set of CK files loaded via a */ -/* metakernel. (The metakernel must also specify leapseconds and */ -/* SCLK kernels.) Use tolerance of zero ticks. Do not request */ -/* angular velocity. Express the results in the TDB time system. */ - -/* PROGRAM CKMET */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* INTEGER MAXCOV */ -/* PARAMETER ( MAXCOV = 100000 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) FILE */ -/* CHARACTER*(LNSIZE) IDCH */ -/* CHARACTER*(FILSIZ) META */ -/* CHARACTER*(FILSIZ) SOURCE */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(LNSIZE) TYPE */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER COUNT */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER IDCODE */ -/* INTEGER NIV */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Prompt for the metakernel name; load the metakernel. */ -/* C The metakernel lists the CK files whose coverage */ -/* C for IDCODE we'd like to determine. The metakernel */ -/* C must also specify a leapseconds kernel and an SCLK */ -/* C kernel for the clock associated with IDCODE. */ -/* C */ -/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */ - -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Get the ID code of interest. */ -/* C */ -/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */ - -/* CALL PRSINT ( IDCH, IDCODE ) */ - -/* C */ -/* C Initialize the coverage window. */ -/* C */ -/* CALL SSIZED ( MAXCOV, COVER ) */ - -/* C */ -/* C Find out how many kernels are loaded. Loop over the */ -/* C kernels: for each loaded CK file, add its coverage */ -/* C for IDCODE, if any, to the coverage window. */ -/* C */ -/* CALL KTOTAL ( 'CK', COUNT ) */ - -/* DO I = 1, COUNT */ - -/* CALL KDATA ( I, 'CK', FILE, TYPE, */ -/* . SOURCE, HANDLE, FOUND ) */ - -/* CALL CKCOV ( FILE, IDCODE, .FALSE., */ -/* . 'SEGMENT', 0.0, 'TDB', COVER ) */ - -/* END DO */ - -/* C */ -/* C Display results. */ -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Coverage for object ', IDCODE */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO I = 1, NIV */ -/* C */ -/* C Get the endpoints of the Ith interval. */ -/* C */ -/* CALL WNFETD ( COVER, I, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.###### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', I */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.###### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) When this routine is used to accumulate coverage for IDCODE */ -/* provided by multiple CK files, the inputs NEEDAV, LEVEL, TOL, */ -/* and TIMSYS must have the same values for all files in order */ -/* for the result to be meaningful. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */ - -/* Corrected bug in first program in header Examples section: */ -/* program now empties the coverage window prior to collecting */ -/* data for the current object. Updated examples to use WNCARD */ -/* rather than CARDD. */ - -/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get coverage window for ck object */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKCOV", (ftnlen)5); - -/* Check tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative; actual value was #.", ( - ftnlen)51); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("CKCOV", (ftnlen)5); - return 0; - } - -/* Use a logical flag to indicate whether this is a segment-level */ -/* coverage description. */ - - seglvl = eqstr_(level, "SEGMENT", level_len, (ftnlen)7); - -/* Check coverage level keyword. */ - - if (! (seglvl || eqstr_(level, "INTERVAL", level_len, (ftnlen)8))) { - setmsg_("Allowed values of LEVEL are # and #; actual value was #.", ( - ftnlen)56); - errch_("#", "SEGMENT", (ftnlen)1, (ftnlen)7); - errch_("#", "INTERVAL", (ftnlen)1, (ftnlen)8); - errch_("#", level, (ftnlen)1, level_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("CKCOV", (ftnlen)5); - return 0; - } - -/* See whether GETFAT thinks we've got a CK file. */ - - getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80); - if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "CK file to be readable by this routine. If the input file i" - "s an CK file in transfer format, run TOBIN on the file to co" - "nvert it to binary format.", (ftnlen)205); - errch_("#", ck, (ftnlen)1, ck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("CKCOV", (ftnlen)5); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "CK file to be readable by this routine. Binary CK files hav" - "e DAF architecture. If you expected the file to be a binary" - " CK file, the problem may be due to the file being an old no" - "n-native file lacking binary file format information. It's a" - "lso possible the file has been corrupted.", (ftnlen)340); - errch_("#", ck, (ftnlen)1, ck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22); - chkout_("CKCOV", (ftnlen)5); - return 0; - } else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) { - setmsg_("Input file # has file type #. The file must be a binary CK " - "file to be readable by this routine. If you expected the fil" - "e to be a binary CK file, the problem may be due to the file" - " being an old non-native file lacking binary file format inf" - "ormation. It's also possible the file has been corrupted.", ( - ftnlen)296); - errch_("#", ck, (ftnlen)1, ck_len); - errch_("#", kertyp, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22); - chkout_("CKCOV", (ftnlen)5); - return 0; - } - -/* Set a logical flag indicating whether the time systm is SCLK. */ - - istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3); - -/* Check time system. */ - - if (! istdb) { - if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) { - setmsg_("Time system spec TIMSYS was #; allowed values are SCLK " - "and TDB.", (ftnlen)63); - errch_("#", timsys, (ftnlen)1, timsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKCOV", (ftnlen)5); - return 0; - } - } - -/* If the output time system is TDB, find the clock ID associated */ -/* with IDCODE. */ - - if (istdb) { - ckmeta_(idcode, "SCLK", &clkid, (ftnlen)4); - if (failed_()) { - chkout_("CKCOV", (ftnlen)5); - return 0; - } - } - -/* Open the file for reading. */ - - dafopr_(ck, &handle, ck_len); - if (failed_()) { - chkout_("CKCOV", (ftnlen)5); - return 0; - } - -/* We will examine each segment descriptor in the file, and */ -/* we'll update our coverage bounds according to the data found */ -/* in these descriptors. */ - -/* If TOL > 0, we'll apply TOL after we've found the coverage */ -/* for the zero-tolerance case. */ - -/* If the time system is TDB, we'll convert the times to TDB */ -/* at the end of this routine. */ - -/* Start a forward search. */ - - dafbfs_(&handle); - -/* Find the next DAF array. */ - - daffna_(&found); - while(found) { - -/* Note: we check FAILED() at the bottom of this loop; this */ -/* routine returns if FAILED() returns .TRUE. at that point. */ - -/* Fetch and unpack the segment descriptor. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dc, ic); - -/* Let AVOK indicate whether the segment satisfies the */ -/* angular velocity restriction. */ - - avok = ic[3] == 1 || ! (*needav); - if (ic[0] == *idcode && avok) { - -/* This segment is for the body of interest. If angular */ -/* velocity is needed, this segment has it. */ - - if (seglvl) { - -/* This is a segment-level summary. */ - -/* Insert the coverage bounds into the coverage window. */ -/* Adjust the interval using the tolerance. */ - -/* Computing MAX */ - d__1 = dc[0] - *tol; - dctol[0] = max(d__1,0.); - dctol[1] = dc[1] + *tol; - -/* Convert the time to TDB if necessary. */ - - if (istdb) { - -/* Convert the time bounds to TDB before inserting */ -/* into the window. */ - - for (i__ = 1; i__ <= 2; ++i__) { - sct2e_(&clkid, &dctol[(i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("dctol", i__1, "ckcov_", - (ftnlen)868)], &et); - dctol[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("dctol", i__1, "ckcov_", (ftnlen)869)] - = et; - } - } - if (dctol[0] <= dctol[1]) { - wninsd_(dctol, &dctol[1], cover); - } - } else { - -/* We're looking for an interval-level coverage window. */ -/* This information must be retrieved in a */ -/* data-type-dependent fashion. The coverage routines */ -/* we'll call will, if necessary, adjust intervals by TOL */ -/* and convert interval times to TDB. */ - - dtype = ic[2]; - segbeg = ic[4]; - segend = ic[5]; - if (dtype == 1) { - zzckcv01_(&handle, &segbeg, &segend, &clkid, tol, timsys, - cover, timsys_len); - } else if (dtype == 2) { - zzckcv02_(&handle, &segbeg, &segend, &clkid, tol, timsys, - cover, timsys_len); - } else if (dtype == 3) { - zzckcv03_(&handle, &segbeg, &segend, &clkid, tol, timsys, - cover, timsys_len); - } else if (dtype == 4) { - zzckcv04_(&handle, &segbeg, &segend, &clkid, tol, timsys, - cover, timsys_len); - } else if (dtype == 5) { - -/* Note: this calling sequence is exceptional; the */ -/* segment bounds are an input. */ - - zzckcv05_(&handle, &segbeg, &segend, &clkid, dc, tol, - timsys, cover, timsys_len); - } else { - setmsg_("Supported CK data types are 1, 2, 3, 4, 5. Dat" - "a type of segment: #. This problem may indicate " - "that you need to update your SPICE Toolkit.", ( - ftnlen)138); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKCOV", (ftnlen)5); - return 0; - } - } - } - daffna_(&found); - if (failed_()) { - chkout_("CKCOV", (ftnlen)5); - return 0; - } - } - -/* COVER now represents the coverage of the entire file at the */ -/* granularity indicated by LEVEL, combined with the coverage */ -/* contained in COVER on input. */ - -/* Release the file. */ - - dafcls_(&handle); - chkout_("CKCOV", (ftnlen)5); - return 0; -} /* ckcov_ */ - diff --git a/ext/spice/src/cspice/ckcov_c.c b/ext/spice/src/cspice/ckcov_c.c deleted file mode 100644 index 62c260009a..0000000000 --- a/ext/spice/src/cspice/ckcov_c.c +++ /dev/null @@ -1,648 +0,0 @@ -/* - --Procedure ckcov_c ( CK coverage ) - --Abstract - - Find the coverage window for a specified object in a specified CK - file. - --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 - - CELLS - DAF - CK - TIME - WINDOWS - --Keywords - - POINTING - TIME - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void ckcov_c ( ConstSpiceChar * ck, - SpiceInt idcode, - SpiceBoolean needav, - ConstSpiceChar * level, - SpiceDouble tol, - ConstSpiceChar * timsys, - SpiceCell * cover ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - ck I Name of CK file. - idcode I ID code of object. - needav I Flag indicating whether angular velocity is needed. - level I Coverage level: "SEGMENT" OR "INTERVAL". - tol I Tolerance in ticks. - timsys I Time system used to represent coverage. - cover I/O Window giving coverage for `idcode'. - --Detailed_Input - - ck is the name of a C-kernel. - - idcode is the integer ID code of an object, normally a - spacecraft structure or instrument, for which - pointing data are expected to exist in the specified - CK file. - - needav is a logical variable indicating whether only - segments having angular velocity are to be considered - when determining coverage. When `needav' is - SPICETRUE, segments without angular velocity don't - contribute to the coverage window; when `needav' is - SPICEFALSE, all segments for `idcode' may contribute - to the coverage window. - - - level is the level (granularity) at which the coverage - is examined. Allowed values and corresponding - meanings are: - - "SEGMENT" The output coverage window contains - intervals defined by the start and - stop times of segments for the object - designated by `idcode'. - - "INTERVAL" The output coverage window contains - interpolation intervals of segments - for the object designated by - `idcode'. For type 1 segments, which - don't have interpolation intervals, - each epoch associated with a pointing - instance is treated as a singleton - interval; these intervals are added - to the coverage window. - - All interpolation intervals are - considered to lie within the segment - bounds for the purpose of this - summary: if an interpolation - interval extends beyond the segment - coverage interval, only its - intersection with the segment - coverage interval is considered to - contribute to the total coverage. - - tol is a tolerance value expressed in ticks of the - spacecraft clock associated with IDCODE. Before each - interval is inserted into the coverage window, the - interval is intersected with the segment coverage - interval, then if the intersection is non-empty, it - is expanded by `tol': the left endpoint of the - intersection interval is reduced by `tol' and the - right endpoint is increased by `tol'. Adjusted - interval endpoints, when expressed as encoded SCLK, - never are less than zero ticks. Any intervals that - overlap as a result of the expansion are merged. - - The coverage window returned when tol > 0 indicates - the coverage provided by the file to the CK readers - ckgpav_c and ckgp_c when that value of `tol' is - passed to them as an input. - - - timsys is a string indicating the time system used in the - output coverage window. `timsys' may have the - values: - - "SCLK" Elements of `cover' are expressed in - encoded SCLK ("ticks"), where the - clock is associated with the object - designated by `idcode'. - - "TDB" Elements of `cover' are expressed as - seconds past J2000 TDB. - - - cover is an initialized CSPICE window data structure. - `cover' optionally may contain coverage data on - input; on output, the data already present in `cover' - will be combined with coverage found for the object - designated by `idcode' in the file `ck'. - - If `cover' contains no data on input, its size and - cardinality still must be initialized. - --Detailed_Output - - cover is a CSPICE window data structure which represents - the merged coverage for `idcode'. When the coverage - level is "INTERVAL", this is the set of time - intervals for which data for `idcode' are present in - the file `ck', merged with the set of time intervals - present in `cover' on input. The merged coverage is - represented as the union of one or more disjoint time - intervals. The window `cover' contains the pairs of - endpoints of these intervals. - - When the coverage level is "SEGMENT", `cover' is - computed in a manner similar to that described above, - but the coverage intervals used in the computation - are those of segments rather than interpolation - intervals within segments. - - When `tol' is > 0, the intervals comprising the - coverage window for `idcode' are expanded by `tol' - and any intervals overlapping as a result are merged. - The resulting window is returned in `cover'. The - expanded window in no case extends beyond the segment - bounds in either direction by more than `tol'. - - The interval endpoints contained in `cover' are - encoded spacecraft clock times if `timsys' is "SCLK"; - otherwise the times are converted from encoded - spacecraft clock to seconds past J2000 TDB. - - See the Examples section below for a complete example - program showing how to retrieve the endpoints from - `cover'. - --Parameters - - None. - --Exceptions - - 1) If the input file has transfer format, the error - SPICE(INVALIDFORMAT) is signaled. - - 2) If the input file is not a transfer file but has architecture - other than DAF, the error SPICE(BADARCHTYPE) is signaled. - - 3) If the input file is a binary DAF file of type other than - CK, the error SPICE(BADFILETYPE) is signaled. - - 4) If the CK file cannot be opened or read, the error will - be diagnosed by routines called by this routine. The output - window will not be modified. - - 5) If the size of the output window argument `cover' is - insufficient to contain the actual number of intervals in the - coverage window for `idcode', the error will be diagnosed by - routines called by this routine. - - 6) If `tol' is negative, the error SPICE(VALUEOUTOFRANGE) is - signaled. - - 7) If `level' is not recognized, the error SPICE(INVALIDOPTION) - is signaled. - - 8) If `timsys' is not recognized, the error SPICE(INVALIDOPTION) - is signaled. - - 9) If a time conversion error occurs, the error will be - diagnosed by a routine in the call tree of this routine. - - 10) If the output time system is TDB, the CK subsystem must be - able to map `idcode' to the ID code of the associated - spacecraft clock. If this mapping cannot be performed, the - error will be diagnosed by a routine in the call tree of this - routine. - - 11) The error SPICE(EMPTYSTRING) is signaled if any of the input - strings `ck', `level', or `timsys' do not contain at least one - character, since such an input string cannot be converted to a - Fortran-style string in this case. - - 12) The error SPICE(NULLPOINTER) is signaled if the if any of the input - strings `ck', `level', or `timsys' are null. - - --Files - - This routine reads a C-kernel. - - If the output time system is "TDB", then a leapseconds kernel - and an SCLK kernel for the spacecraft clock associated with - `idcode' must be loaded before this routine is called. - - If the ID code of the clock associated with `idcode' is not - equal to - - idcode / 1000 - - then the kernel variable - - CK__SCLK - - must be present in the kernel pool to identify the clock - associated with `idcode'. This variable must contain the ID code - to be used for conversion between SCLK and TDB. Normally this - variable is provided in a text kernel loaded via furnsh_c. - --Particulars - - This routine provides an API via which applications can determine - the coverage a specified CK file provides for a specified - object. - --Examples - - 1) Display the interval-level coverage for each object in a - specified CK file. Use tolerance of zero ticks. Do not request - angular velocity. Express the results in the TDB time system. - - Find the set of objects in the file. Loop over the contents of - the ID code set: find the coverage for each item in the set and - display the coverage. - - - #include - #include "SpiceUsr.h" - - int main() - { - - /. - Local parameters - ./ - #define FILSIZ 256 - #define MAXIV 100000 - #define WINSIZ ( 2 * MAXIV ) - #define TIMLEN 51 - #define MAXOBJ 1000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - SPICEINT_CELL ( ids, MAXOBJ ); - - SpiceChar ck [ FILSIZ ]; - SpiceChar lsk [ FILSIZ ]; - SpiceChar sclk [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt i; - SpiceInt j; - SpiceInt niv; - SpiceInt obj; - - - /. - Load a leapseconds kernel and SCLK kernel for output time - conversion. Note that we assume a single spacecraft clock is - associated with all of the objects in the CK. - ./ - prompt_c ( "Name of leapseconds kernel > ", FILSIZ, lsk ); - furnsh_c ( lsk ); - - prompt_c ( "Name of SCLK kernel > ", FILSIZ, sclk ); - furnsh_c ( sclk ); - - /. - Get name of CK file. - ./ - prompt_c ( "Name of CK file > ", FILSIZ, ck ); - - /. - Find the set of objects in the CK file. - ./ - ckobj_c ( ck, &ids ); - - /. - We want to display the coverage for each object. Loop over - the contents of the ID code set, find the coverage for - each item in the set, and display the coverage. - ./ - for ( i = 0; i < card_c( &ids ); i++ ) - { - /. - Find the coverage window for the current object. - Empty the coverage window each time so we don't - include data for the previous object. - ./ - obj = SPICE_CELL_ELEM_I( &ids, i ); - - scard_c ( 0, &cover ); - ckcov_c ( ck, obj, SPICEFALSE, - "INTERVAL", 0.0, "TDB", &cover ); - - /. - Get the number of intervals in the coverage window. - ./ - niv = wncard_c( &cover ); - - /. - Display a simple banner. - ./ - printf ( "%s\n", "========================================" ); - - printf ( "Coverage for object %ld\n", obj ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( j = 0; j < niv; j++ ) - { - /. - Get the endpoints of the jth interval. - ./ - wnfetd_c ( &cover, j, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.###### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - j, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.###### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - printf ( "%s\n", "========================================" ); - - } - return ( 0 ); - } - - - 2) Find the segment-level coverage for the object designated by - IDCODE provided by the set of CK files loaded via a metakernel. - (The metakernel must also specify leapseconds and SCLK kernels.) - Use tolerance of zero ticks. Do not request angular velocity. - Express the results in the TDB time system. - - - #include - #include "SpiceUsr.h" - - int main() - { - - /. - Local parameters - ./ - #define FILSIZ 256 - #define LNSIZE 81 - #define MAXCOV 100000 - #define WINSIZ ( 2 * MAXCOV ) - #define TIMLEN 51 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - - SpiceBoolean found; - - SpiceChar file [ FILSIZ ]; - SpiceChar idch [ LNSIZE ]; - SpiceChar meta [ FILSIZ ]; - SpiceChar source [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - SpiceChar type [ LNSIZE ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt count; - SpiceInt handle; - SpiceInt i; - SpiceInt idcode; - SpiceInt niv; - - - /. - Prompt for the metakernel name; load the metakernel. - The metakernel lists the CK files whose coverage - for `idcode' we'd like to determine. The metakernel - must also specify a leapseconds kernel and an SCLK - kernel for the clock associated with `idcode'. - ./ - prompt_c ( "Name of metakernel > ", FILSIZ, meta ); - furnsh_c ( meta ); - - /. - Get the ID code of interest. - ./ - prompt_c ( "Enter ID code > ", LNSIZE, idch ); - prsint_c ( idch, &idcode ); - - /. - Find out how many kernels are loaded. Loop over the - kernels: for each loaded CK file, add its coverage - for `idcode', if any, to the coverage window. - ./ - ktotal_c ( "CK", &count ); - - for ( i = 0; i < count; i++ ) - { - kdata_c ( i, "CK", FILSIZ, - LNSIZE, FILSIZ, file, - type, source, &handle, &found ); - - ckcov_c ( file, idcode, SPICEFALSE, - "SEGMENT", 0.0, "TDB", &cover ); - } - - /. - Display results. - - Get the number of intervals in the coverage window. - ./ - niv = wncard_c( &cover ); - - /. - Display a simple banner. - ./ - printf ( "\nCoverage for object %ld\n", idcode ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( i = 0; i < niv; i++ ) - { - /. - Get the endpoints of the ith interval. - ./ - wnfetd_c ( &cover, i, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.###### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - i, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.###### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - return ( 0 ); - } - - --Restrictions - - 1) When this routine is used to accumulate coverage for `idcode' - provided by multiple CK files, the inputs `needav', `level', `tol', - and `timsys' must have the same values for all files in order - for the result to be meaningful. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 30-NOV-2007 (NJB) - - Corrected bug in first example program in header: - program now empties result window prior to collecting - data for each object. Updated examples to use wncard_c - rather than card_c. Updated second example to demonstrate - segment-level summary capability. - - -CSPICE Version 1.0.0, 07-JAN-2005 (NJB) - --Index_Entries - - get coverage window for ck object - --& -*/ - -{ /* Begin ckcov_c */ - - - /* - Local variables - */ - logical need; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "ckcov_c" ); - - /* - Check the input string `ck' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckcov_c", ck ); - - /* - Check the input string `level' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckcov_c", level ); - - /* - Check the input string `timsys' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckcov_c", timsys ); - - /* - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "ckcov_c", SPICE_DP, cover ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cover ); - - /* - Call the f2c'd Fortran routine. - */ - need = needav; - - ckcov_ ( ( char * ) ck, - ( integer * ) &idcode, - ( logical * ) &need, - ( char * ) level, - ( doublereal * ) &tol, - ( char * ) timsys, - ( doublereal * ) (cover->base), - ( ftnlen ) strlen(ck), - ( ftnlen ) strlen(level), - ( ftnlen ) strlen(timsys) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, cover ); - } - - chkout_c ( "ckcov_c" ); - -} /* End ckcov_c */ diff --git a/ext/spice/src/cspice/cke01.c b/ext/spice/src/cspice/cke01.c deleted file mode 100644 index 3c4d59df2d..0000000000 --- a/ext/spice/src/cspice/cke01.c +++ /dev/null @@ -1,387 +0,0 @@ -/* cke01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CKE01 ( CK evaluate pointing record, data type 1 ) */ -/* Subroutine */ int cke01_(logical *needav, doublereal *record, doublereal * - cmat, doublereal *av, doublereal *clkout) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int q2m_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Evaluate a pointing record returned by CKR01 from a CK data type 1 */ -/* segment. Return the C-matrix and optionally the angular velocity */ -/* vector associated with the time CLKOUT. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ -/* ROTATION */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NEEDAV I True if angular velocity vector is required. */ -/* RECORD I Data type 1 pointing record. */ -/* CMAT O C-matrix. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O Output spacecraft clock time. */ - -/* $ Detailed_Input */ - -/* NEEDAV is true when angular velocity data is requested. */ - -/* RECORD is a set of double precision numbers returned by CKR01 */ -/* that contain sufficient information from a data type */ -/* 1 pointing segment to evaluate the C-matrix and */ -/* possibly the angular velocity vector (if NEEDAV is */ -/* true) for a particular instance. */ - -/* The contents of RECORD are as follows: */ - -/* RECORD( 1 ) = CLKOUT */ - -/* RECORD( 2 ) = q0 */ -/* RECORD( 3 ) = q1 */ -/* RECORD( 4 ) = q2 */ -/* RECORD( 5 ) = q3 */ - -/* RECORD( 6 ) = Av1 ] */ -/* RECORD( 7 ) = Av2 |-- Optional */ -/* RECORD( 8 ) = Av3 ] */ - - -/* The quantities q0 - q3 represent a quaternion. */ -/* The quantities Av1, Av2, and Av3 represent the angular */ -/* velocity vector. */ - -/* CLKOUT is the encoded spacecraft clock time */ -/* associated with the quaternion and, optionally, the */ -/* angular velocity vector. */ - -/* $ Detailed_Output */ - -/* CMAT is a rotation matrix that transforms the components of */ -/* of a vector expressed in the reference frame given in */ -/* the segment to components expressed in the instrument */ -/* fixed frame at time CLKOUT. */ - -/* Thus, if a vector v has components x, y, z in the */ -/* reference frame, then v has components x', y', z' in */ -/* the instrument fixed frame at time CLKOUT: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If the x', y', z' components are known, use the */ -/* transpose of the C-matrix to determine x, y, z as */ -/* follows. */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - -/* AV is the angular velocity vector. This is returned only */ -/* if it has been requested, as indicated by NEEDAV. In */ -/* other words, if NEEDAV is true, the angular velocity */ -/* portion of RECORD must be present. */ - -/* The angular velocity vector is the vector whose */ -/* direction gives the right-handed axis about which */ -/* the reference frame tied to the instrument is */ -/* instantaneously rotating at time CLKOUT. */ - -/* The angular velocity vector is returned in component */ -/* form */ - -/* AV = [ AV1 , AV2 , AV3 ] */ - -/* which is in terms of the reference coordinate frame */ -/* specified in the segment descriptor. */ - -/* The magnitude of AV is the magnitude of the instantane- */ -/* ous velocity of the rotation, in radians per second. */ - -/* CLKOUT The encoded spacecraft clock time associated with the */ -/* returned C-matrix and, optionally, the returned angular */ -/* velocity vector. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) No checking is done to determine whether RECORD is a valid */ -/* record. */ - -/* 2) If NEEDAV is true, then RECORD is assumed to contain angular */ -/* velocity data. No checking is performed to verify this */ -/* assumption. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 1 pointing */ -/* segment, see the CK Required Reading file. */ - -/* The only real work done by CKE01 is to convert the pointing */ -/* portion of the record from quaternion form to C-matrix form. */ - -/* The angular velocity vector will only be returned if it has been */ -/* requested. In other words, if NEEDAV is true, the routine will */ -/* expect the angular velocity component of the record to be present. */ - -/* $ Examples */ - -/* A call to a CKEnn routine is almost always preceded by a call to */ -/* the corresponding CKRnn routine, which gets the logical record */ -/* that CKEnn evaluates. */ - -/* The following code fragment searches through a file represented */ -/* by HANDLE for all segments applicable to the Voyager 2 wide angle */ -/* camera, for a particular spacecraft clock time, which have data */ -/* type 1. It then evaluates the pointing for that epoch and prints */ -/* the result. */ - -/* C */ -/* C - Get the spacecraft clock time. Must encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* C - Set the time tolerance high to catch anything close to */ -/* C the input time. */ -/* C */ -/* C - We don't need angular velocity data. */ -/* C */ - -/* SC = -32 */ -/* INST = -32002 */ -/* TOL = 1000.D0 */ -/* NEEDAV = .FALSE. */ -/* DTYPE = 1 */ -/* C */ -/* C Load the Voyager 2 spacecraft clock kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'VGR_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'VGR2_CK.BC', HANDLE ) */ -/* C */ -/* C Convert the input request time to ticks. */ -/* C */ -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ - -/* C */ -/* C Search from the beginning through all segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* DO WHILE ( SFND ) */ - -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* IF ( INST .EQ. ICD( 1 ) */ -/* . DTYPE .EQ. ICD( 3 ) */ -/* . .AND. SCLKDP + TOL .GE. DCD( 1 ) */ -/* . .AND. SCLKDP - TOL .LE. DCD( 2 ) ) THEN */ - -/* CALL CKR01 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* CALL CKE01 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */ - -/* WRITE (*,*) 'Segment descriptor and identifier:' */ -/* WRITE (*,*) DCD, ICD */ -/* WRITE (*,*) IDENT */ - -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) CMAT */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 22-AUG-2006 (EDW) */ - -/* Replaced header references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.2.0, 14-NOV-1995 (WLT) */ - -/* Changed "inertial frame" to simply reference frame to */ -/* reflect new capabilities of the SPICE system. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 30-AUG-1991 (MJS) (JML) */ - -/* 1) Previously, in the standard SPICE error handling, the */ -/* logical function RETURN was not written as a function; */ -/* it is now written as a function. */ - -/* 2) The example program was changed so that the tolerance */ -/* and data type are used in selecting which segments to read. */ - -/* 3) It was specified that the angular velocity vector */ -/* gives the right-handed axis about which the instrument */ -/* frame rotates. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* The example program was corrected so that the input */ -/* instrument code was tested against ICD(1) instead of */ -/* ICD(3). */ - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate ck type_1 pointing data record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 14-NOV-1995 (WLT) */ - -/* Changed "inertial frame" to simply reference frame to */ -/* reflect new capabilities of the SPICE system. */ - -/* This change affects only documentation not code. */ - -/* - SPICELIB Version 1.1.0, 30-AUG-1991 (MJS) (JML) */ - -/* 1) In the standard SPICE error handling, the line: */ - -/* IF ( RETURN ) THEN */ - -/* was changed to */ - -/* IF ( RETURN() ) THEN */ - -/* 2) The example program was changed so that the tolerance */ -/* and data type are used in selecting which segments to read. */ - -/* 3) It was specified that the angular velocity vector */ -/* gives the right-handed axis about which the instrument */ -/* frame rotates. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* 1) The example program was corrected so that the input */ -/* instrument code was tested against ICD(1) instead of */ -/* ICD(3). */ -/* 2) SCLK was removed from the Required Reading section. */ - -/* - Beta Version 1.1.0, 29-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The argument SCLK was removed from the calling sequence. */ -/* 2) Header was updated. */ -/* 3) The call to the routine QUAT2M_3 was replaced by a call to */ -/* the routine Q2M. */ - -/* - Beta Version 1.0.0, 18-MAY-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKE01", (ftnlen)5); - } - -/* Dissect the record. */ - - *clkout = record[0]; - q2m_(&record[1], cmat); - if (*needav) { - av[0] = record[5]; - av[1] = record[6]; - av[2] = record[7]; - } - chkout_("CKE01", (ftnlen)5); - return 0; -} /* cke01_ */ - diff --git a/ext/spice/src/cspice/cke02.c b/ext/spice/src/cspice/cke02.c deleted file mode 100644 index 902a557e44..0000000000 --- a/ext/spice/src/cspice/cke02.c +++ /dev/null @@ -1,389 +0,0 @@ -/* cke02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure CKE02 ( C-kernel, evaluate pointing record, data type 2 ) */ -/* Subroutine */ int cke02_(logical *needav, doublereal *record, doublereal * - cmat, doublereal *av, doublereal *clkout) -{ - doublereal time, quat[4]; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mxmt_( - doublereal *, doublereal *, doublereal *); - doublereal cbase[9] /* was [3][3] */, angle; - extern /* Subroutine */ int chkin_(char *, ftnlen), vequg_(doublereal *, - integer *, doublereal *); - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int axisar_(doublereal *, doublereal *, - doublereal *); - doublereal avtemp[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int q2m_(doublereal *, doublereal *); - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Evaluate a pointing record returned by CKR02 from a CK data type 2 */ -/* segment. Return the C-matrix and angular velocity vector associated */ -/* with the time CLKOUT. */ - -/* $ 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 */ - -/* CK */ -/* ROTATION */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NEEDAV I True if angular velocity is requested. */ -/* RECORD I Data type 2 pointing record. */ -/* CMAT O C-matrix. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O SCLK associated with C-matrix. */ - -/* $ Detailed_Input */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* RECORD is a set of double precision numbers returned by CKR02 */ -/* that contain sufficient information from a data type */ -/* 2 pointing segment to evaluate the C-matrix and the */ -/* angular velocity vector for a particular instance. */ - -/* The contents of RECORD are as follows: */ - -/* RECORD( 1 ) = start SCLKDP of interval */ - -/* RECORD( 2 ) = SCLK for which pointing was found */ - -/* RECORD( 3 ) = seconds / tick rate */ - -/* RECORD( 4 ) = q0 */ -/* RECORD( 5 ) = q1 */ -/* RECORD( 6 ) = q2 */ -/* RECORD( 7 ) = q3 */ - -/* RECORD( 8 ) = av1 */ -/* RECORD( 9 ) = av2 */ -/* RECORD( 10 ) = av3 */ - -/* The quantities q0 - q3 are the components of the */ -/* quaternion that represents the C - matrix associated */ -/* with the start of the interval. The quantities av1, */ -/* av2, and av3 are the components of the angular velocity */ -/* vector. */ - -/* $ Detailed_Output */ - - -/* CMAT is a rotation matrix that transforms the components */ -/* of a vector expressed in the inertial frame given in */ -/* the segment to components expressed in the instrument */ -/* fixed frame at the returned time. */ - -/* Thus, if a vector v has components x, y, z in the */ -/* inertial frame, then v has components x', y', z' in the */ -/* instrument fixed frame where: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If the x', y', z' components are known, use the */ -/* transpose of the C-matrix to determine x, y, z as */ -/* follows. */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - -/* AV is the angular velocity vector. The angular velocity */ -/* contained in RECORD is returned only if NEEDAV is true. */ - -/* The direction of the angular velocity vector gives */ -/* the right-handed axis about which the instrument fixed */ -/* reference frame is rotating. The magnitude of AV is */ -/* the magnitude of the instantaneous velocity of the */ -/* rotation, in radians per second. */ - -/* The angular velocity vector is returned in component */ -/* form */ - -/* AV = [ AV1 , AV2 , AV3 ] */ - -/* which is in terms of the inertial coordinate frame */ -/* specified in the segment descriptor. */ - -/* CLKOUT is the encoded SCLK associated with the returned */ -/* C-matrix and angular velocity vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) No checking is done to determine whether RECORD is valid. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 2 pointing */ -/* segment, see the CK Required Reading. */ - -/* Pointing data in a type 2 segment consists of intervals during */ -/* which the orientation of the spacecraft structure can be described */ -/* by an initial C-matrix and a constant angular velocity vector. */ -/* From the information contained in the pointing record returned by */ -/* CKR02, this subroutine calculates and returns the C-matrix */ -/* associated with the time returned by CKR02. It also returns the */ -/* angular velocity vector contained in the pointing record. */ - -/* $ Examples */ - -/* A call to a CKEnn routine is almost always preceded by a call to */ -/* the corresponding CKRnn routine, which gets the logical record */ -/* that CKEnn evaluates. */ - -/* The following code fragment searches through a file (represented */ -/* by HANDLE) for all segments applicable to the Voyager 2 wide angle */ -/* camera, for a particular spacecraft clock time, that are of data */ -/* types 1 or 2. It then evaluates the pointing for that epoch and */ -/* prints the result. */ - - -/* SC = -32 */ -/* INST = -32002 */ -/* C */ -/* C Load the Voyager 2 spacecraft clock kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'VGR_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'VGR2_CK.BC', HANDLE ) */ - -/* C */ -/* C Get the spacecraft clock time. Must encode it for use */ -/* C in the C-kernel. */ -/* C */ - -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ - -/* C */ -/* C Search from the beginning through all segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* DO WHILE ( SFND ) */ - -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* IF ( INST .EQ. ICD( 1 ) .AND. */ -/* . SCLKDP + TOL .GE. DCD( 1 ) .AND. */ -/* . SCLKDP - TOL .LE. DCD( 2 ) ) THEN */ - -/* DTYPE = ICD ( 3 ) */ - -/* IF ( DTYPE .EQ. 1 ) THEN */ - -/* CALL CKR01 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* CALL CKE01 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */ -/* END IF */ - -/* ELSE IF ( DTYPE .EQ. 2 ) THEN */ - -/* CALL CKR02 ( HANDLE, DESCR, SCLKDP, TOL, */ -/* . RECORD, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* CALL CKE02 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */ -/* END IF */ - -/* END IF */ - -/* IF ( FOUND ) THEN */ - -/* WRITE (*,*) 'Segment descriptor and identifier:' */ -/* WRITE (*,*) DCD, ICD */ -/* WRITE (*,*) IDENT */ - -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) CMAT */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - 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, 30-AUG-1991 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate ck type_2 pointing data record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKE02", (ftnlen)5); - } - -/* Copy the returned encoded SCLK time into CLKOUT. */ - - *clkout = record[1]; -/* The quaternion stored in RECORD represents the C - matrix */ -/* corresponding to the start time of the interval. The angular */ -/* velocity vector is constant throughout the interval and gives */ -/* the axis and rate by which the spacecraft is rotating. */ - -/* Copy the quaternion and the angular velocity from RECORD. */ - -/* RECORD ( 4 ) = q0 */ -/* RECORD ( 5 ) = q1 */ -/* RECORD ( 6 ) = q2 */ -/* RECORD ( 7 ) = q3 */ - -/* RECORD ( 8 ) = av1 */ -/* RECORD ( 9 ) = av2 */ -/* RECORD ( 10 ) = av3 */ - - vequg_(&record[3], &c__4, quat); - vequ_(&record[7], avtemp); - -/* Calculate the angle of the rotation. */ - -/* RECORD ( 1 ) = The start time of the interval. */ -/* RECORD ( 2 ) = The time that pointing was returned for. */ -/* RECORD ( 3 ) = The number of seconds per SCLK tick. */ - - time = (record[1] - record[0]) * record[2]; - angle = time * vnorm_(avtemp); - -/* Construct a matrix which rotates vectors by ANGLE radians about */ -/* AVTEMP. */ - - axisar_(avtemp, &angle, rot); - -/* Convert the quaternion to a C - matrix. */ - - q2m_(quat, cbase); - -/* Rotate each of the axis vectors of the spacecraft instrument frame */ -/* by ANGLE radians about AVTEMP. (AVTEMP is given in the same */ -/* inertial frame as the C - matrix.) The resulting matrix is the */ -/* transpose of the requested C - matrix. */ - -/* [ ] [ ] T [ ] T */ -/* [ ROT ] * [ CBASE ] = [ CMAT ] */ -/* [ ] [ ] [ ] */ - -/* OR */ - -/* [ ] [ ] T [ ] */ -/* [ CBASE ] * [ ROT ] = [ CMAT ] */ -/* [ ] [ ] [ ] */ - - mxmt_(cbase, rot, cmat); - -/* Return the angular velocity only if it is requested. */ - - if (*needav) { - vequ_(avtemp, av); - } - chkout_("CKE02", (ftnlen)5); - return 0; -} /* cke02_ */ - diff --git a/ext/spice/src/cspice/cke03.c b/ext/spice/src/cspice/cke03.c deleted file mode 100644 index 3fd51057f8..0000000000 --- a/ext/spice/src/cspice/cke03.c +++ /dev/null @@ -1,545 +0,0 @@ -/* cke03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__3 = 3; - -/* $Procedure CKE03 ( C-kernel, evaluate pointing record, data type 3 ) */ -/* Subroutine */ int cke03_(logical *needav, doublereal *record, doublereal * - cmat, doublereal *av, doublereal *clkout) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - doublereal frac, axis[3]; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mtxm_( - doublereal *, doublereal *, doublereal *), mxmt_(doublereal *, - doublereal *, doublereal *); - doublereal cmat1[9] /* was [3][3] */, cmat2[9] /* was [3][3] */, t, - angle, delta[9] /* was [3][3] */; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *), vlcom_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - doublereal q1[4], q2[4], t1, t2; - extern logical failed_(void); - extern /* Subroutine */ int raxisa_(doublereal *, doublereal *, - doublereal *), axisar_(doublereal *, doublereal *, doublereal *), - chkout_(char *, ftnlen); - doublereal av1[3], av2[3]; - extern logical return_(void); - extern /* Subroutine */ int q2m_(doublereal *, doublereal *); - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Evaluate a pointing record returned by CKR03 from a CK type 3 */ -/* segment. Return the C-matrix and angular velocity vector associated */ -/* with the time CLKOUT. */ - -/* $ 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 */ - -/* CK */ -/* ROTATION */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NEEDAV I True if angular velocity is requested. */ -/* RECORD I Data type 3 pointing record. */ -/* CMAT O C-matrix. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O SCLK associated with C-matrix. */ - -/* $ Detailed_Input */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* RECORD is a set of double precision numbers returned by CKR03 */ -/* that contain sufficient information from a type 3 CK */ -/* segment to evaluate the C-matrix and the angular */ -/* velocity vector at a particular time. Depending on */ -/* the contents of RECORD, this routine will either */ -/* interpolate between two pointing instances that */ -/* bracket a request time, or it will simply return the */ -/* pointing given by a single pointing instance. */ - -/* When pointing at the request time can be determined */ -/* by linearly interpolating between the two pointing */ -/* instances that bracket that time, the bracketing */ -/* pointing instances are returned in RECORD as follows: */ - -/* RECORD( 1 ) = Left bracketing SCLK time. */ - -/* RECORD( 2 ) = lq0 \ */ -/* RECORD( 3 ) = lq1 \ Left bracketing */ -/* RECORD( 4 ) = lq2 / quaternion. */ -/* RECORD( 5 ) = lq3 / */ - -/* RECORD( 6 ) = lav1 \ Left bracketing */ -/* RECORD( 7 ) = lav2 | angular velocity */ -/* RECORD( 8 ) = lav3 / ( optional ) */ - -/* RECORD( 9 ) = Right bracketing SCLK time. */ - -/* RECORD( 10 ) = rq0 \ */ -/* RECORD( 11 ) = rq1 \ Right bracketing */ -/* RECORD( 12 ) = rq2 / quaternion. */ -/* RECORD( 13 ) = rq3 / */ - -/* RECORD( 14 ) = rav1 \ Right bracketing */ -/* RECORD( 15 ) = rav2 | angular velocity */ -/* RECORD( 16 ) = rav3 / ( optional ) */ - -/* RECORD( 17 ) = pointing request time */ - -/* The quantities lq0 - lq3 and rq0 - rq3 are the */ -/* components of the quaternions that represent the */ -/* C-matrices associated with the times that bracket */ -/* the requested time. */ - -/* The quantities lav1, lav2, lav3 and rav1, rav2, rav3 */ -/* are the components of the angular velocity vectors at */ -/* the respective bracketing times. The components of the */ -/* angular velocity vectors are specified relative to the */ -/* inertial reference frame of the segment. */ - -/* When the routine is to simply return the pointing */ -/* given by a particular pointing instance, then the */ -/* values of that pointing instance are returned in both */ -/* parts of RECORD ( i.e. RECORD(1-9) and RECORD(10-16) ). */ - -/* $ Detailed_Output */ - -/* CMAT is a rotation matrix that transforms the components */ -/* of a vector expressed in the inertial frame given in */ -/* the segment to components expressed in the instrument */ -/* fixed frame at the returned time. */ - -/* Thus, if a vector v has components x, y, z in the */ -/* inertial frame, then v has components x', y', z' in the */ -/* instrument fixed frame where: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If the x', y', z' components are known, use the */ -/* transpose of the C-matrix to determine x, y, z as */ -/* follows. */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - -/* AV is the angular velocity vector of the instrument fixed */ -/* frame defined by CMAT. The angular velocity is */ -/* returned only if NEEDAV is true. */ - -/* The direction of the angular velocity vector gives */ -/* the right-handed axis about which the instrument fixed */ -/* reference frame is rotating. The magnitude of AV is */ -/* the magnitude of the instantaneous velocity of the */ -/* rotation, in radians per second. */ - -/* The angular velocity vector is returned in component */ -/* form */ - -/* AV = [ AV1 , AV2 , AV3 ] */ - -/* which is in terms of the inertial coordinate frame */ -/* specified in the segment descriptor. */ - -/* CLKOUT is the encoded SCLK associated with the returned */ -/* C-matrix and angular velocity vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) No explicit checking is done to determine whether RECORD is */ -/* valid. However, routines in the call tree of this routine */ -/* may signal errors if inputs are invalid or otherwise */ -/* in appropriate. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If the array RECORD contains pointing instances that bracket the */ -/* request time then CKE03 will linearly interpolate between those */ -/* two values to obtain pointing at the request time. If the */ -/* pointing instances in RECORD are for the same time, then this */ -/* routine will simply unpack the record and convert the quaternion */ -/* to a C-matrix. */ - -/* The linear interpolation performed by this routine is defined */ -/* as follows: */ - -/* 1) Let t be the time for which pointing is requested and */ -/* let CMAT1 and CMAT2 be C-matrices associated with times */ -/* t1 and t2 where: */ - -/* t1 < t2, and t1 <= t, and t <= t2. */ - -/* 2) Assume that the spacecraft frame rotates about a fixed */ -/* axis at a constant angular rate from time t1 to time t2. */ -/* The angle and rotation axis can be obtained from the */ -/* rotation matrix ROT12 where: */ - -/* T T */ -/* CMAT2 = ROT12 * CMAT1 */ - -/* or */ -/* T */ -/* ROT12 = CMAT2 * CMAT1 */ - - -/* ROT12 ==> ( ANGLE, AXIS ) */ - - -/* 3) To obtain pointing at time t, rotate the spacecraft frame */ -/* about the vector AXIS from its orientation at time t1 by the */ -/* angle THETA where: */ - -/* ( t - t1 ) */ -/* THETA = ANGLE * ----------- */ -/* ( t2 - t1 ) */ - -/* 4) Thus if ROT1t is the matrix that rotates vectors by the */ -/* angle THETA about the vector AXIS, then the output C-matrix */ -/* is given by: */ - -/* T T */ -/* CMAT = ROT1t * CMAT1 */ - -/* T */ -/* CMAT = CMAT1 * ROT1t */ - - -/* 5) The angular velocity is treated independently of the */ -/* C-matrix. If it is requested, then the AV at time t is */ -/* the weighted average of the angular velocity vectors at */ -/* the times t1 and t2: */ - -/* ( t - t1 ) */ -/* W = ----------- */ -/* ( t2 - t1 ) */ - - -/* AV = ( 1 - W ) * AV1 + W * AV2 */ - -/* $ Examples */ - -/* The CKRnn routines are usually used in tandem with the CKEnn */ -/* routines, which evaluate the record returned by CKRnn to give */ -/* the pointing information and output time. */ - -/* The following code fragment searches through all of the segments */ -/* in a file applicable to the Mars Observer spacecraft bus that */ -/* are of data type 3, for a particular spacecraft clock time. */ -/* It then evaluates the pointing for that epoch and prints the */ -/* result. */ - -/* CHARACTER*(20) SCLKCH */ -/* CHARACTER*(20) SCTIME */ -/* CHARACTER*(40) IDENT */ - -/* INTEGER I */ -/* INTEGER SC */ -/* INTEGER INST */ -/* INTEGER HANDLE */ -/* INTEGER DTYPE */ -/* INTEGER ICD ( 6 ) */ - -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION RECORD ( 17 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ - -/* LOGICAL NEEDAV */ -/* LOGICAL FND */ -/* LOGICAL SFND */ - - -/* SC = -94 */ -/* INST = -94000 */ -/* DTYPE = 3 */ -/* NEEDAV = .FALSE. */ - -/* C */ -/* C Load the MO SCLK kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'MO_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'MO_CK.BC', HANDLE ) */ -/* C */ -/* C Get the spacecraft clock time. Then encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ - -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ -/* C */ -/* C Use a tolerance of 2 seconds ( half of the nominal */ -/* C separation between MO pointing instances ). */ -/* C */ -/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */ - -/* C */ -/* C Search from the beginning of the CK file through all */ -/* C of the segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* FND = .FALSE. */ - -/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */ - -/* C */ -/* C Get the segment identifier and descriptor. */ -/* C */ - -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its integer and */ -/* C double precision components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C Determine if this segment should be processed. */ -/* C */ -/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */ -/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */ -/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */ -/* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */ - - -/* CALL CKR03 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FND ) */ - -/* IF ( FND ) THEN */ - -/* CALL CKE03 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */ - -/* CALL SCDECD ( SC, CLKOUT, SCTIME ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment identifier: ', IDENT */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Pointing returned for time: ', */ -/* . SCTIME */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) */ -/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */ -/* WRITE (*,*) */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) No explicit checking is done on the input RECORD. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 2.0.0, 13-JUN-2002 (FST) */ - -/* This routine now participates in error handling properly. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate ck type_3 pointing data record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 13-JUN-2002 (FST) */ - -/* Calls to CHKIN and CHKOUT in the standard SPICE error */ -/* handling style were added. Versions prior to 2.0.0 */ -/* were error free, however changes to RAXISA from error */ -/* free to error signaling forced this update. */ - -/* Additionally, FAILED is now checked after the call to */ -/* RAXISA. This prevents garbage from being placed into */ -/* the output arguments. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKE03", (ftnlen)5); - } - -/* Unpack the record, for easier reading. */ - - t = record[16]; - t1 = record[0]; - t2 = record[8]; - moved_(&record[1], &c__4, q1); - moved_(&record[5], &c__3, av1); - moved_(&record[9], &c__4, q2); - moved_(&record[13], &c__3, av2); - -/* If T1 and T2 are the same then no interpolation or extrapolation */ -/* is performed. Simply convert the quaternion to a C-matrix and */ -/* return. */ - - if (t1 == t2) { - q2m_(q1, cmat); - *clkout = t1; - if (*needav) { - vequ_(av1, av); - } - chkout_("CKE03", (ftnlen)5); - return 0; - } - -/* Interpolate between the two pointing instances to obtain pointing */ -/* at the request time. */ - - -/* Calculate what fraction of the interval the request time */ -/* represents. */ - - frac = (t - t1) / (t2 - t1); - -/* Convert the left and right quaternions to C-matrices. */ - - q2m_(q1, cmat1); - q2m_(q2, cmat2); - -/* Find the matrix that rotates the spacecraft instrument frame from */ -/* the orientation specified by CMAT1 to that specified by CMAT2. */ -/* Then find the axis and angle of that rotation matrix. */ - -/* T T */ -/* CMAT2 = ROT * CMAT1 */ - -/* T */ -/* ROT = CMAT2 * CMAT1 */ - - mtxm_(cmat2, cmat1, rot); - raxisa_(rot, axis, &angle); - if (failed_()) { - chkout_("CKE03", (ftnlen)5); - return 0; - } - -/* Calculate the matrix that rotates vectors about the vector AXIS */ -/* by the angle ANGLE * FRAC. */ - - d__1 = angle * frac; - axisar_(axis, &d__1, delta); - -/* The interpolated pointing at the request time is given by CMAT */ -/* where: */ - -/* T T */ -/* CMAT = DELTA * CMAT1 */ - -/* and */ -/* T */ -/* CMAT = CMAT1 * DELTA */ - - mxmt_(cmat1, delta, cmat); - -/* Set CLKOUT equal to the time that pointing is being returned. */ - - *clkout = t; - -/* If angular velocity is requested then take a weighted average */ -/* of the angular velocities at the left and right endpoints. */ - - if (*needav) { - d__1 = 1. - frac; - vlcom_(&d__1, av1, &frac, av2, av); - } - chkout_("CKE03", (ftnlen)5); - return 0; -} /* cke03_ */ - diff --git a/ext/spice/src/cspice/cke04.c b/ext/spice/src/cspice/cke04.c deleted file mode 100644 index 158f849661..0000000000 --- a/ext/spice/src/cspice/cke04.c +++ /dev/null @@ -1,566 +0,0 @@ -/* cke04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure CKE04 ( C-kernel, evaluate pointing record, type 4 ) */ -/* Subroutine */ int cke04_(logical *needav, doublereal *record, doublereal * - cmat, doublereal *av, doublereal *clkout) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer ideg[7]; - doublereal qout[4]; - integer i__; - doublereal q[4]; - extern /* Subroutine */ int vhatg_(doublereal *, integer *, doublereal *); - integer basadd; - extern /* Subroutine */ int chbval_(doublereal *, integer *, doublereal *, - doublereal *, doublereal *), q2m_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Evaluate a pointing record returned by CKR04 from a CK type 4 */ -/* segment. Return the C-matrix and angular velocity vector */ -/* associated with the time CLKOUT. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NEEDAV I True if angular velocity is requested. */ -/* RECORD I Data type 4 pointing record. */ -/* CMAT O C-matrix. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O SCLK associated with C-matrix. */ - -/* $ Detailed_Input */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* RECORD is a set of double precision numbers returned by */ -/* CKR04. RECORD must have the following structure: */ - -/* --------------------------------------------------- */ -/* | Encoded onboard time which is the closest | */ -/* | to SCLKDP and belongs to one of approximation | */ -/* | intervals | */ -/* --------------------------------------------------- */ -/* | encoded SCLK time of the midpoint of | */ -/* | interpolation interval | */ -/* --------------------------------------------------- */ -/* | radii of interpolation interval | */ -/* | expressed as double precision SCLK ticks | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q0 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q1 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q2 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q3 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV1 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV2 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV3 | */ -/* --------------------------------------------------- */ -/* | q0 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q1 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q2 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q3 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | AV1 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ -/* | AV2 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ -/* | AV3 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ - -/* $ Detailed_Output */ - -/* CMAT is a rotation matrix that transforms the components */ -/* of a vector expressed in the inertial frame given in */ -/* the segment to components expressed in the instrument */ -/* fixed frame at the returned time. */ - -/* Thus, if a vector v has components x, y, z in the */ -/* inertial frame, then v has components x', y', z' in */ -/* the instrument fixed frame where: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If the x', y', z' components are known, use the */ -/* transpose of the C-matrix to determine x, y, z as */ -/* follows. */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - -/* AV is the angular velocity vector of the instrument fixed */ -/* frame defined by CMAT. The angular velocity is */ -/* returned only if NEEDAV is true. */ - -/* The direction of the angular velocity vector gives */ -/* the right-handed axis about which the instrument fixed */ -/* reference frame is rotating. The magnitude of AV is */ -/* the magnitude of the instantaneous velocity of the */ -/* rotation, in radians per second. */ - -/* The angular velocity vector is returned in component */ -/* form */ - -/* AV = [ AV1 , AV2 , AV3 ] */ - -/* which is in terms of the inertial coordinate frame */ -/* specified in the segment descriptor. */ - -/* CLKOUT is the encoded SCLK associated with the returned */ -/* C-matrix and angular velocity vector. */ - -/* $ Parameters */ - -/* See 'ckparam.inc'. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* No checking is done to determine whether RECORD is valid. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 4 pointing */ -/* segment, see the CK Required Reading file. */ - -/* The work done by CKE04 is to calculate quaternion and angular */ -/* velocity components using Chebyshev polynomial approximation */ -/* parameters. The second step of evaluation is to convert the */ -/* pointing portion of the record from quaternion form to C-matrix */ -/* form. */ - -/* The angular velocity vector will only be returned if it has been */ -/* requested. In other words, if NEEDAV is true, the routine will */ -/* expect the angular velocity component of the record to be */ -/* present. */ - -/* $ Examples */ - -/* The CKRnn routines are usually used in tandem with the CKEnn */ -/* routines, which evaluate the record returned by CKRnn to give */ -/* the pointing information and output time. */ - -/* The following code fragment searches through all of the segments */ -/* in a file applicable to the Mars Global Surveyor spacecraft bus */ -/* that are of data type 4, for a particular spacecraft clock time. */ -/* It then evaluates the pointing for that epoch and prints the */ -/* result. */ - -/* C */ -/* C CK parameters include file. */ -/* C */ -/* INCLUDE 'ckparam.inc' */ -/* C */ -/* C Declarations */ -/* C */ -/* CHARACTER*(20) SCLKCH */ -/* CHARACTER*(20) SCTIME */ -/* CHARACTER*(40) IDENT */ - -/* DOUBLE PRECISION AV ( 3 ) */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( CK4RSZ ) */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ - -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER ICD ( 6 ) */ -/* INTEGER INST */ -/* INTEGER SC */ - -/* LOGICAL FND */ -/* LOGICAL NEEDAV */ -/* LOGICAL SFND */ -/* C */ -/* C Initial values. */ -/* C */ -/* SC = -94 */ -/* INST = -94000 */ -/* NEEDAV = .FALSE. */ -/* C */ -/* C Load the MGS SCLK kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH( 'MGS_SCLK.TSC' ) */ -/* CALL DAFOPR( 'MGS_CK4.BC', HANDLE ) */ -/* C */ -/* C Get the spacecraft clock time. Then encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* CALL PROMPT( 'Enter SCLK string: ', SCLKCH ) */ -/* CALL SCENCD( SC, SCLKCH, SCLKDP ) */ -/* C */ -/* C Use a tolerance of 2 seconds (half of the nominal */ -/* C separation between MGS pointing instances ). */ -/* C */ -/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */ -/* C */ -/* C Search from the beginning of the CK file through all */ -/* C of the segments. */ -/* C */ -/* CALL DAFBFS( HANDLE ) */ -/* CALL DAFFNA( SFND ) */ - -/* FND = .FALSE. */ - -/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */ -/* C */ -/* C Get the segment identifier and descriptor. */ -/* C */ -/* CALL DAFGN( IDENT ) */ -/* CALL DAFGS( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its integer and */ -/* C double precision components. */ -/* C */ -/* CALL DAFUS( DESCR, 2, 6, DCD, ICD ) */ -/* C */ -/* C Determine if this segment should be processed. */ -/* C */ -/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */ -/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */ -/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */ -/* . ( CK4DTP .EQ. ICD( 3 ) ) ) THEN */ -/* C */ -/* C Find CK 4 record covering requested time. */ -/* C */ -/* CALL CKR04( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FND ) */ - -/* IF ( FND ) THEN */ -/* C */ -/* C Compute pointing using found CK 4 record. */ -/* C */ -/* CALL CKE04( NEEDAV, RECORD, CMAT, AV, CLKOUT) */ - -/* CALL SCDECD( SC, CLKOUT, SCTIME ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment identifier: ', IDENT */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Pointing returned for time: ', */ -/* . SCTIME */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) */ -/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */ -/* WRITE (*,*) */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) No checking is done on the input RECORD. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate CK type_4 pointing data record */ - -/* -& */ - -/* Local variables */ - - -/* Initial values. */ - - av[0] = 0.; - av[1] = 0.; - av[2] = 0.; - -/* Read numbers of polynomial coefficients from input record to */ -/* local integer array. */ - - for (i__ = 1; i__ <= 7; ++i__) { - ideg[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("ideg", i__1, - "cke04_", (ftnlen)365)] = (integer) record[i__ + 2]; - } - -/* Evaluate polynomial function for quaternion components at time */ -/* RECORD( 1 ). */ - - basadd = 11; - for (i__ = 1; i__ <= 4; ++i__) { - i__3 = ideg[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("ideg", - i__1, "cke04_", (ftnlen)376)] - 1; - chbval_(&record[basadd - 1], &i__3, &record[1], record, &q[(i__2 = - i__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("q", i__2, "cke04_", - (ftnlen)376)]); - basadd += ideg[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "ideg", i__1, "cke04_", (ftnlen)378)]; - } - -/* Normalize quaternion. */ - - vhatg_(q, &c__4, qout); - -/* Convert the quaternion to a C-matrix. */ - - q2m_(qout, cmat); - *clkout = record[0]; - -/* Check if angular velocities have to be evaluated, then */ -/* evaluate them. */ - - if (*needav) { - for (i__ = 5; i__ <= 7; ++i__) { - i__3 = ideg[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "ideg", i__1, "cke04_", (ftnlen)402)] - 1; - chbval_(&record[basadd - 1], &i__3, &record[1], record, &av[(i__2 - = i__ - 5) < 3 && 0 <= i__2 ? i__2 : s_rnge("av", i__2, - "cke04_", (ftnlen)402)]); - basadd += ideg[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "ideg", i__1, "cke04_", (ftnlen)404)]; - } - } - -/* All done. */ - - return 0; -} /* cke04_ */ - diff --git a/ext/spice/src/cspice/cke05.c b/ext/spice/src/cspice/cke05.c deleted file mode 100644 index a344f20314..0000000000 --- a/ext/spice/src/cspice/cke05.c +++ /dev/null @@ -1,1067 +0,0 @@ -/* cke05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure CKE05 ( C-Kernel, evaluate, type 5 ) */ -/* Subroutine */ int cke05_(logical *needav, doublereal *record, doublereal * - cmat, doublereal *av, doublereal *clkout) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal mags, qneg[4], rate; - integer from; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal work[912] /* was [456][2] */; - integer i__, j, n; - doublereal q[4]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal vbuff[6]; - extern /* Subroutine */ int vhatg_(doublereal *, integer *, doublereal *), - moved_(doublereal *, integer *, doublereal *), errdp_(char *, - doublereal *, ftnlen), vsclg_(doublereal *, doublereal *, integer - *, doublereal *); - doublereal state[8]; - extern doublereal vdotg_(doublereal *, doublereal *, integer *); - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *), qdq2av_(doublereal *, doublereal *, doublereal *); - doublereal dq[4], ds[4]; - integer ub, to; - doublereal locrec[228], sclddq[4]; - extern /* Subroutine */ int lgrind_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - doublereal sclkdp, radtrm[4]; - integer packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - extern doublereal lgrint_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *), vdistg_(doublereal *, doublereal *, - integer *); - integer prvder; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), chkout_(char *, ftnlen), vminug_(doublereal *, - integer *, doublereal *); - extern doublereal vnormg_(doublereal *, integer *); - extern /* Subroutine */ int xpsgip_(integer *, integer *, doublereal *), - vsclip_(doublereal *, doublereal *), hrmint_(integer *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - extern logical return_(void); - integer newptr; - extern /* Subroutine */ int q2m_(doublereal *, doublereal *); - integer xstart, subtyp, ystart, prvptr; - -/* $ Abstract */ - -/* Evaluate a single data record from a type 5 CK segment. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to CK type 05. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ - -/* CK type 5 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ -/* and quaternion derivatives only, no angular velocity */ -/* vector provided. Quaternion elements are listed */ -/* first, followed by derivatives. Angular velocity is */ -/* derived from the quaternions and quaternion */ -/* derivatives. */ - - -/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ -/* only. Angular velocity is derived by differentiating */ -/* the interpolating polynomials. */ - - -/* Subtype 2: Hermite interpolation, 14-element packets. */ -/* Quaternion and angular angular velocity vector, as */ -/* well as derivatives of each, are provided. The */ -/* quaternion comes first, then quaternion derivatives, */ -/* then angular velocity and its derivatives. */ - - -/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ -/* and angular velocity vector provided. The quaternion */ -/* comes first. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of file ck05.inc. */ - -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NEEDAV I True if angular velocity is requested. */ -/* RECORD I-O Data type 5 record. */ -/* CMAT O C-matrix. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O SCLK associated with C-matrix. */ - -/* $ Detailed_Input */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* RECORD is a record from a type 5 CK segment which, when */ -/* evaluated at the epoch contained in its first */ -/* element, will give the attitude and angular velocity */ -/* of a spacecraft structure or instrument relative to a */ -/* base reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | evaluation epoch | */ -/* +----------------------+ */ -/* | subtype code | */ -/* +----------------------+ */ -/* | number of packets (n)| */ -/* +----------------------+ */ -/* | nominal SCLK rate | */ -/* +----------------------+ */ -/* | packet 1 | */ -/* +----------------------+ */ -/* | packet 2 | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | packet n | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* See the CK Required Reading or the include file */ -/* ck05.inc for details on CK type 5 packet contents. */ - - -/* $ Detailed_Output */ - -/* RECORD has been modified due to its use as a workspace array. */ -/* The contents are undefined. */ - - -/* CMAT is a rotation matrix that transforms the components */ -/* of a vector expressed in the base frame given in */ -/* the segment to components expressed in the instrument */ -/* fixed frame at the returned time. */ - -/* Thus, if a vector v has components x, y, z in the */ -/* base frame, then v has components x', y', z' in the */ -/* instrument fixed frame where: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If the x', y', z' components are known, use the */ -/* transpose of the C-matrix to determine x, y, z as */ -/* follows. */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - - -/* AV is the angular velocity vector of the instrument fixed */ -/* frame defined by CMAT. The angular velocity is */ -/* returned only if NEEDAV is true. */ - -/* The direction of the angular velocity vector gives */ -/* the right-handed axis about which the instrument fixed */ -/* reference frame is rotating. The magnitude of AV is */ -/* the magnitude of the instantaneous velocity of the */ -/* rotation, in radians per second. */ - -/* The angular velocity vector is returned in component */ -/* form */ - -/* AV = [ AV1 , AV2 , AV3 ] */ - -/* which is in terms of the base coordinate frame */ -/* specified in the segment descriptor. */ - -/* CLKOUT is the encoded SCLK associated with the returned */ -/* C-matrix and angular velocity vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input record contains an unrecognized subtype code, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of CK type 5 (MEX/Rosetta Attitude */ -/* file interpolation) CK segments is described in the CK Required */ -/* Reading. */ - -/* $ Examples */ - -/* The CKEnn routines are almost always used in conjunction with */ -/* the corresponding CKRnn routines, which read the records from */ -/* CK files. */ - -/* The following code fragment searches through all of the segments */ -/* in a file applicable to the Mars Express spacecraft bus that */ -/* are of data type 5, for a particular spacecraft clock time. */ -/* It then evaluates the pointing for that epoch and prints the */ -/* result. */ - -/* CHARACTER*(20) SCLKCH */ -/* CHARACTER*(20) SCTIME */ -/* CHARACTER*(40) IDENT */ - -/* INTEGER I */ -/* INTEGER SC */ -/* INTEGER INST */ -/* INTEGER HANDLE */ -/* INTEGER DTYPE */ -/* INTEGER ICD ( 6 ) */ - -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION RECORD ( 17 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ - -/* LOGICAL NEEDAV */ -/* LOGICAL FND */ -/* LOGICAL SFND */ - - -/* SC = -41 */ -/* INST = -41000 */ -/* DTYPE = 5 */ -/* NEEDAV = .FALSE. */ - -/* C */ -/* C Load the MEX SCLK kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'MEX_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'MEX_CK.BC', HANDLE ) */ -/* C */ -/* C Get the spacecraft clock time. Then encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ - -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ -/* C */ -/* C Use a tolerance of 2 seconds ( half of the nominal */ -/* C separation between MEX pointing instances ). */ -/* C */ -/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */ - -/* C */ -/* C Search from the beginning of the CK file through all */ -/* C of the segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* FND = .FALSE. */ - -/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */ - -/* C */ -/* C Get the segment identifier and descriptor. */ -/* C */ -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its integer and */ -/* C double precision components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C Determine if this segment should be processed. */ -/* C */ -/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */ -/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */ -/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */ -/* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */ - - -/* CALL CKR05 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FND ) */ - -/* IF ( FND ) THEN */ - -/* CALL CKE05 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */ - -/* CALL SCDECD ( SC, CLKOUT, SCTIME ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment identifier: ', IDENT */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Pointing returned for time: ', */ -/* . SCTIME */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) */ -/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */ -/* WRITE (*,*) */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the input record is valid. Any */ -/* checking of the input data is assumed to have been performed */ -/* when the source CK file was created. */ - -/* 2) This routine assumes that the input data are suitable for the */ -/* interpolation method indicated by the subtype code in the */ -/* input record. Since the mapping of rotations to quaternions */ -/* is multiple-valued, this routine assumes that whichever sign */ -/* minimizes the Euclidean distance between one quaternion and */ -/* the next is the correct sign. The same assumption is made */ -/* for quaternion derivatives. */ - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 20-NOV-2006 (NJB) */ - -/* Bug fix: this routine now assumes that angular velocity */ -/* and quaternion derivative values stored in the input */ -/* record have units of radians/second. */ - -/* Bug fix: this routine no longer attempts to determine */ -/* the correct sign of quaternion derivatives. The caller */ -/* must supply quaternion derivatives that are suitable */ -/* for interpolation. */ - -/* - SPICELIB Version 1.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments in */ -/* XPOSEG and VSCL calls. Replaced header reference to LDPOOL */ -/* with reference to FURNSH. */ - -/* - SPICELIB Version 1.2.0, 14-FEB-2003 (NJB) */ - -/* Bug fix: angular velocity computation was modified to */ -/* match that used in the corresponding algorithm employed */ -/* by the MEX/Rosetta attitude file reader. The quaternion */ -/* derivative used to derive angular velocity now is the */ -/* derivative of the *unit* quaternion. */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_5 ck segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments in */ -/* XPOSEG and VSCL calls. Replaced header reference to LDPOOL */ -/* with reference to FURNSH. */ - -/* - SPICELIB Version 1.2.0, 14-FEB-2003 (NJB) */ - -/* Bug fix: angular velocity computation was modified to */ -/* match that used in the corresponding algorithm employed */ -/* by the MEX/Rosetta attitude file reader. The quaternion */ -/* derivative used to derive angular velocity now is the */ -/* derivative of the *unit* quaternion. */ - -/* Letting Q(t) be the quaternion derived by polynomial */ -/* interpolation, and letting UQ(t) be Q(t)/||Q(t)||, */ -/* the quaternion derivative d(UQ)/dt is now used. */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Index of evaluation epoch in record: */ - - -/* Index of subtype code in record: */ - - -/* Index of packet count in record: */ - - -/* Index of SCLK rate in record: */ - - -/* Index at which packets start; packet base: */ - - -/* Maximum polynomial degree: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKE05", (ftnlen)5); - -/* Capture the subtype from the record and set the packet size */ -/* accordingly. */ - - subtyp = i_dnnt(&record[1]); - if (subtyp == 0) { - packsz = 8; - } else if (subtyp == 1) { - packsz = 4; - } else if (subtyp == 2) { - packsz = 14; - } else if (subtyp == 3) { - packsz = 7; - } else { - setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", ( - ftnlen)55); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKE05", (ftnlen)5); - return 0; - } - -/* Get the packet count and epoch. */ - - n = i_dnnt(&record[2]); - sclkdp = record[0]; - -/* Get the nominal clock rate. */ - - rate = record[3]; - -/* Adjust quaternion "signs" as necessary to minimize distance */ -/* between successive quaternions. */ - - if (subtyp == 1 || subtyp == 3) { - -/* For these types, only the quaternions themselves need be */ -/* adjusted. */ - -/* PRVPTR is the index of the "previous" quaternion---the */ -/* one to which the successor and its negative will be */ -/* compared. */ - - prvptr = 5; - i__1 = n; - for (i__ = 2; i__ <= i__1; ++i__) { - -/* NEWPTR points to the quaternion ahead of the one */ -/* pointed to by PRVPTR. */ - - newptr = packsz * (i__ - 1) + 5; - vminug_(&record[newptr - 1], &c__4, qneg); - -/* Replace the Ith quaternion with QNEG if QNEG is closer */ -/* than the current quaternion to the previous quaternion. */ - - if (vdistg_(&record[prvptr - 1], qneg, &c__4) < vdistg_(&record[ - prvptr - 1], &record[newptr - 1], &c__4)) { - moved_(qneg, &c__4, &record[newptr - 1]); - } - prvptr = newptr; - } - } else { - -/* For the Hermite types, the quaternions may need to be */ -/* adjusted; the derivatives are not adjusted. */ - -/* PRVPTR is the index of the "previous" quaternion---the */ -/* one to which the successor and its negative will be */ -/* compared. PRVDER points to the corresponding derivative. */ - - prvptr = 5; - prvder = 9; - i__1 = n; - for (i__ = 2; i__ <= i__1; ++i__) { - -/* NEWPTR points to the quaternion ahead of the one */ -/* pointed to by PRVPTR. */ - - newptr = packsz * (i__ - 1) + 5; - vminug_(&record[newptr - 1], &c__4, qneg); - -/* Replace the Ith quaternion with QNEG if QNEG is closer */ -/* than the current quaternion to the previous quaternion. */ - - if (vdistg_(&record[prvptr - 1], qneg, &c__4) < vdistg_(&record[ - prvptr - 1], &record[newptr - 1], &c__4)) { - moved_(qneg, &c__4, &record[newptr - 1]); - } - } - } - if (subtyp == 1) { - -/* We perform Lagrange interpolation on each quaternion */ -/* component, and obtain quaternion derivatives from the */ -/* interpolating polynomials. The quaternion and derivative */ -/* gives us angular velocity. */ - -/* We'll transpose the pointing information in the input record so */ -/* that contiguous pieces of it can be shoved directly into the */ -/* interpolation routine LGRINT. We allow LGRINT to overwrite */ -/* the state values in the input record, since this saves local */ -/* storage and does no harm. (See the header of LGRINT for a */ -/* description of its work space usage.) */ - - n = i_dnnt(&record[2]); - xpsgip_(&packsz, &n, &record[4]); - -/* We interpolate each state component in turn. */ - - xstart = n * packsz + 5; - i__1 = packsz; - for (i__ = 1; i__ <= i__1; ++i__) { - ystart = n * (i__ - 1) + 5; - lgrind_(&n, &record[xstart - 1], &record[ystart - 1], work, & - sclkdp, &state[(i__2 = i__ - 1) < 8 && 0 <= i__2 ? i__2 : - s_rnge("state", i__2, "cke05_", (ftnlen)626)], &state[( - i__3 = i__ + 3) < 8 && 0 <= i__3 ? i__3 : s_rnge("state", - i__3, "cke05_", (ftnlen)626)]); - } - -/* The output quaternion is a unitized version of the */ -/* interpolated state. */ - - mags = vnormg_(state, &c__4); - if (mags == 0.) { - setmsg_("Quaternion magnitude at SCLK # was zero.", (ftnlen)40); - errdp_("#", &sclkdp, (ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("CKE05", (ftnlen)5); - return 0; - } - d__1 = 1. / mags; - vsclg_(&d__1, state, &c__4, q); - if (*needav) { - -/* Find the time derivative of the unit quaternion: */ -/* Letting S represent the quaternion portion of STATE, we */ -/* have */ - -/* Q = S/||S|| */ - - -/* Then letting < , > denote the 4-dimensional inner product */ -/* operator, we have */ - - -/* d(S)/dt < Q, d(S)/dt > */ -/* d(Q)/dt = ------- - -------------- * Q */ -/* ||S|| ||S|| */ - - - moved_(&state[4], &c__4, ds); - d__1 = 1. / mags; - vsclg_(&d__1, ds, &c__4, sclddq); - d__1 = vdotg_(q, ds, &c__4) / mags; - vsclg_(&d__1, q, &c__4, radtrm); - vsubg_(sclddq, radtrm, &c__4, dq); - -/* Derive angular velocity from Q and dQ/dt: */ - - qdq2av_(q, dq, av); - -/* Scale the rate from radians/tick to radians/second. */ - - d__1 = 1. / rate; - vsclip_(&d__1, av); - } - -/* Q and if required AV have been assigned. */ - - } else if (subtyp == 3) { - -/* This is the easiest case: we perform Lagrange interpolation */ -/* on each quaternion or angular velocity component. */ - -/* We'll transpose the pointing information in the input record so */ -/* that contiguous pieces of it can be shoved directly into the */ -/* interpolation routine LGRINT. We allow LGRINT to overwrite */ -/* the state values in the input record, since this saves local */ -/* storage and does no harm. (See the header of LGRINT for a */ -/* description of its work space usage.) */ - - n = i_dnnt(&record[2]); - xpsgip_(&packsz, &n, &record[4]); - -/* We interpolate each state component in turn. */ - - xstart = n * packsz + 5; - if (*needav) { - ub = packsz; - } else { - ub = 4; - } - i__1 = ub; - for (i__ = 1; i__ <= i__1; ++i__) { - ystart = n * (i__ - 1) + 5; - state[(i__2 = i__ - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("state", - i__2, "cke05_", (ftnlen)727)] = lgrint_(&n, &record[ - xstart - 1], &record[ystart - 1], locrec, &sclkdp); - } - -/* The output quaternion is a unitized version of the */ -/* interpolated state. */ - - vhatg_(state, &c__4, q); - if (*needav) { - -/* The angular velocity already is in units of radians/second. */ - - vequ_(&state[4], av); - } - -/* Q and if required AV have been assigned. */ - - } else { - -/* We have a Hermite-style subtype. Whether it's subtype 0 */ -/* or 2, we perform Hermite interpolation on the quaternions. */ - -/* We interpolate each quaternion component in turn. Attitude and */ -/* angular velocity are interpolated separately. */ - - xstart = packsz * n + 5; - for (i__ = 1; i__ <= 4; ++i__) { - i__1 = n; - for (j = 1; j <= i__1; ++j) { - -/* For the Jth input packet, copy the Ith position and */ -/* velocity components into the local record buffer RECORD. */ - -/* In order to perform Hermite interpolation, the */ -/* quaternions and quaternion derivatives must have a */ -/* common time scale. So prior to interpolation, we scale */ -/* the units of the quaternion derivatives from radians/sec */ -/* to radians/tick. */ - - from = packsz * (j - 1) + 4 + i__; - to = (j << 1) - 1; - locrec[(i__2 = to - 1) < 228 && 0 <= i__2 ? i__2 : s_rnge( - "locrec", i__2, "cke05_", (ftnlen)779)] = record[from - - 1]; - locrec[(i__2 = to) < 228 && 0 <= i__2 ? i__2 : s_rnge("locrec" - , i__2, "cke05_", (ftnlen)780)] = record[from + 3] * - rate; - } - -/* Interpolate the Ith quaternion and quaternion derivative */ -/* components. */ - - hrmint_(&n, &record[xstart - 1], locrec, &sclkdp, work, &state[( - i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("state", - i__1, "cke05_", (ftnlen)788)], &state[(i__2 = i__ + 3) < - 8 && 0 <= i__2 ? i__2 : s_rnge("state", i__2, "cke05_", ( - ftnlen)788)]); - } - -/* The output quaternion is a unitized version of the */ -/* interpolated state. */ - - mags = vnormg_(state, &c__4); - if (mags == 0.) { - setmsg_("Quaternion magnitude at SCLK # was zero.", (ftnlen)40); - errdp_("#", &sclkdp, (ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("CKE05", (ftnlen)5); - return 0; - } - d__1 = 1. / mags; - vsclg_(&d__1, state, &c__4, q); - if (*needav) { - if (subtyp == 0) { - -/* Find the time derivative of the unit quaternion: */ -/* Letting S represent the quaternion portion of STATE, we */ -/* have */ - -/* Q = S/||S|| */ - - -/* Then letting < , > denote the 4-dimensional inner product */ -/* operator, we have */ - - -/* d(S)/dt < Q, d(S)/dt > */ -/* d(Q)/dt = ------- - -------------- * Q */ -/* ||S|| ||S|| */ - - - moved_(&state[4], &c__4, ds); - d__1 = 1. / mags; - vsclg_(&d__1, ds, &c__4, sclddq); - d__1 = vdotg_(q, ds, &c__4) / mags; - vsclg_(&d__1, q, &c__4, radtrm); - vsubg_(sclddq, radtrm, &c__4, dq); - -/* Derive angular velocity from Q and dQ/dt: */ - - qdq2av_(q, dq, av); - -/* Scale the rate from radians/tick to radians/second. */ - - d__1 = 1. / rate; - vsclip_(&d__1, av); - } else { - -/* This is subtype 2; we perform Hermite interpolation on */ -/* the angular velocity and its derivative. */ - -/* Now interpolate angular velocity, using separate angular */ -/* velocity data and angular acceleration. */ - - for (i__ = 1; i__ <= 3; ++i__) { - i__1 = n; - for (j = 1; j <= i__1; ++j) { - -/* For the Jth input packet, copy the Ith position */ -/* and velocity components into the local record */ -/* buffer LOCREC. Note that, as with quaternion */ -/* derivatives, we must scale angular acceleration */ -/* from radians/sec**2 to radians/(sec*tick) before */ -/* interpolating. */ - - from = packsz * (j - 1) + 12 + i__; - to = (j << 1) - 1; - locrec[(i__2 = to - 1) < 228 && 0 <= i__2 ? i__2 : - s_rnge("locrec", i__2, "cke05_", (ftnlen)876)] - = record[from - 1]; - locrec[(i__2 = to) < 228 && 0 <= i__2 ? i__2 : s_rnge( - "locrec", i__2, "cke05_", (ftnlen)877)] = - record[from + 2] * rate; - } - -/* Interpolate the Ith angular velocity and angular */ -/* acceleration components of the attitude. We'll */ -/* capture the result in a temporary buffer, then */ -/* transfer the velocity to the output argument AV. */ - - hrmint_(&n, &record[xstart - 1], locrec, &sclkdp, work, & - vbuff[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("vbuff", i__1, "cke05_", (ftnlen)887)], & - vbuff[(i__2 = i__ + 2) < 6 && 0 <= i__2 ? i__2 : - s_rnge("vbuff", i__2, "cke05_", (ftnlen)887)]); - } - -/* Fill in the angular velocity in the output angular */ -/* velocity vector using the results of interpolating */ -/* velocity and acceleration. */ - -/* The angular velocity is already in units of */ -/* radians/second. */ - - vequ_(vbuff, av); - } - -/* We've handled the type 0 and type 2 cases. */ - - } - -/* We've computed the angular velocity AV for the Hermite */ -/* subtypes, if a.v. was requested. */ - - } - -/* We've handled all four subtypes. */ - - -/* Produce a C-matrix from the interpolated quaternion. Set CLKOUT. */ - - q2m_(q, cmat); - *clkout = record[0]; - chkout_("CKE05", (ftnlen)5); - return 0; -} /* cke05_ */ - diff --git a/ext/spice/src/cspice/ckfrot.c b/ext/spice/src/cspice/ckfrot.c deleted file mode 100644 index 8a9efdd619..0000000000 --- a/ext/spice/src/cspice/ckfrot.c +++ /dev/null @@ -1,290 +0,0 @@ -/* ckfrot.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKFROT ( C-kernel, find rotation ) */ -/* Subroutine */ int ckfrot_(integer *inst, doublereal *et, doublereal * - rotate, integer *ref, logical *found) -{ - logical have, pfnd, sfnd; - doublereal time; - extern /* Subroutine */ int sce2c_(integer *, doublereal *, doublereal *); - char segid[40]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), ckbss_(integer *, doublereal *, - doublereal *, logical *), ckpfs_(integer *, doublereal *, - doublereal *, doublereal *, logical *, doublereal *, doublereal *, - doublereal *, logical *), cksns_(integer *, doublereal *, char *, - logical *, ftnlen), xpose_(doublereal *, doublereal *); - extern logical failed_(void); - doublereal av[3]; - integer handle; - extern /* Subroutine */ int ckhave_(logical *); - logical needav; - extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen); - integer sclkid; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal clkout; - extern logical return_(void), zzsclk_(integer *, integer *); - doublereal dcd[2]; - integer icd[6]; - doublereal tol, rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Find the rotation from a C-kernel Id to the native */ -/* frame at the time requested. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INST I NAIF instrument ID. */ -/* ET I Epoch measured in seconds past J2000. */ -/* ROTATE O rotation from CK platform to frame REF. */ -/* REF O Reference frame. */ -/* FOUND O True when requested pointing is available. */ - -/* $ Detailed_Input */ - -/* INST is the unique NAIF integer ID for the spacecraft */ -/* instrument for which data is being requested. */ - -/* ET is the epoch for which the state rotation */ -/* is desired. ET should be given in seconds past the */ -/* epoch of J2000. */ - - -/* $ Detailed_Output */ - -/* ROTATE is a rotation matrix that converts */ -/* positions relative to the input frame (given by INST) */ -/* to positions relative to the frame REF. */ - -/* Thus, if a state S has components x,y,z,dx,dy,dz */ -/* in the frame of INST, frame, then S has components */ -/* x', y', z', dx', dy', dz' in frame REF. */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | ROTATE | | y | */ -/* [ z' ] [ ] [ z ] */ - - -/* REF is the id-code reference frame to which ROTATE will */ -/* transform states. */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. FOUND will be false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a C-kernel file is not loaded using CKLPF prior to calling */ -/* this routine, an error is signalled by a routine that this */ -/* routine calls. */ - - -/* $ Files */ - -/* CKFROT searches through files loaded by CKLPF to locate a segment */ -/* that can satisfy the request for position rotation */ -/* for instrument INST at time ET. You must load a C-kernel */ -/* file using CKLPF before calling this routine. */ - -/* $ Particulars */ - -/* CKFROT searches through files loaded by CKLPF to satisfy a */ -/* pointing request. Last-loaded files are searched first, and */ -/* individual files are searched in backwards order, giving */ -/* priority to segments that were added to a file later than the */ -/* others. CKFROT considers only those segments that contain */ -/* angular velocity data. */ - -/* The search ends when a segment is found that can give pointing */ -/* for the specified instrument at the request time. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* A C-kernel file should have been loaded by CKLPF. */ - -/* In addition it is helpful to load a CK-info file into the */ -/* Kernel pool. This file should have the following variables */ -/* defined. */ - -/* CK__SCLK = SCLK idcode that yields SCLK mapping for INST. */ -/* CK__SPK = SPK idcode that yields ephemeris for INST. */ - -/* where is the integer string corresponding to INST. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 17-FEB-2000 (WLT) */ - -/* The routine now checks to make sure convert ET to TICKS */ -/* and that at least one C-kernel is loaded before trying */ -/* to look up the transformation. Also the routine now calls */ -/* SCE2C instead of SCE2T. */ - -/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* get instrument frame rotation and reference frame */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* NC is the number of components in a packed C-kernel */ -/* descriptor. All DAF summaries have this formulaic */ -/* relationship between the number of its integer and */ -/* double precision components and the number of packed */ -/* components. */ - -/* IDLEN is the length of the C-kernel segment identifier. */ -/* All DAF names have this formulaic relationship */ -/* between the number of summary components and */ -/* the length of the name (You will notice that */ -/* a name and a summary have the same length in bytes.) */ - - -/* Local variables */ - - -/* Set FOUND to FALSE right now in case we end up */ -/* returning before doing any work. */ - - *found = FALSE_; - *ref = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKFROT", (ftnlen)6); - } - -/* We don't need angular velocity data. */ -/* Assume the segment won't be found until it really is. */ - - needav = FALSE_; - tol = 0.; - -/* Begin a search for this instrument and time, and get the first */ -/* applicable segment. */ - - ckhave_(&have); - ckmeta_(inst, "SCLK", &sclkid, (ftnlen)4); - if (! have) { - chkout_("CKFROT", (ftnlen)6); - return 0; - } else if (! zzsclk_(inst, &sclkid)) { - chkout_("CKFROT", (ftnlen)6); - return 0; - } - sce2c_(&sclkid, et, &time); - ckbss_(inst, &time, &tol, &needav); - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - -/* Keep trying candidate segments until a segment can produce a */ -/* pointing instance within the specified time tolerance of the */ -/* input time. */ - -/* Check FAILED to prevent an infinite loop if an error is detected */ -/* by a SPICELIB routine and the error handling is not set to abort. */ - - while(sfnd && ! failed_()) { - ckpfs_(&handle, descr, &time, &tol, &needav, rot, av, &clkout, &pfnd); - if (pfnd) { - -/* Found one. Fetch the ID code of the reference frame */ -/* from the descriptor. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - *ref = icd[1]; - *found = TRUE_; - -/* We now have the rotation matrix from */ -/* REF to INS. We invert ROT to get the rotation */ -/* from INST to REF. */ - - xpose_(rot, rotate); - chkout_("CKFROT", (ftnlen)6); - return 0; - } - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - } - chkout_("CKFROT", (ftnlen)6); - return 0; -} /* ckfrot_ */ - diff --git a/ext/spice/src/cspice/ckfxfm.c b/ext/spice/src/cspice/ckfxfm.c deleted file mode 100644 index 280155baac..0000000000 --- a/ext/spice/src/cspice/ckfxfm.c +++ /dev/null @@ -1,351 +0,0 @@ -/* ckfxfm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKFXFM ( C-kernel, find transformation ) */ -/* Subroutine */ int ckfxfm_(integer *inst, doublereal *et, doublereal *xform, - integer *ref, logical *found) -{ - logical have, pfnd, sfnd; - doublereal time; - extern /* Subroutine */ int sce2c_(integer *, doublereal *, doublereal *); - char segid[40]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), ckbss_(integer *, doublereal *, - doublereal *, logical *), ckpfs_(integer *, doublereal *, - doublereal *, doublereal *, logical *, doublereal *, doublereal *, - doublereal *, logical *), cksns_(integer *, doublereal *, char *, - logical *, ftnlen); - doublereal ref2in[36] /* was [6][6] */; - extern /* Subroutine */ int rav2xf_(doublereal *, doublereal *, - doublereal *); - extern logical failed_(void); - doublereal av[3]; - integer handle; - extern /* Subroutine */ int ckhave_(logical *); - logical needav; - extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen); - integer sclkid; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal clkout; - extern logical return_(void), zzsclk_(integer *, integer *); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *); - doublereal dcd[2]; - integer icd[6]; - doublereal tol, rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Find the transformation from a C-kernel Id to the native */ -/* frame at the time requested. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INST I NAIF instrument ID. */ -/* ET I Epoch measured in seconds past J2000. */ -/* XFORM O Transformation from CK platform to frame REF. */ -/* REF O Reference frame. */ -/* FOUND O True when requested pointing is available. */ - -/* $ Detailed_Input */ - -/* INST is the unique NAIF integer ID for the spacecraft */ -/* instrument for which data is being requested. */ - -/* ET is the epoch for which the state transformation */ -/* is desired. ET should be given in seconds past the */ -/* epoch of J2000. */ - - -/* $ Detailed_Output */ - -/* XFORM is a state transformation matrix that converts */ -/* states relative to the input frame (given by INST) */ -/* to states relative to the frame REF. */ - - -/* Thus, if a state S has components x,y,z,dx,dy,dz */ -/* in the frame of INST, frame, then S has components */ -/* x', y', z', dx', dy', dz' in frame REF. */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | | | y | */ -/* | z' | | | | z | */ -/* | dx' | [ XFORM ] | dx | */ -/* | dy' | = | | | dy | */ -/* [ dz' ] [ ] [ dz ] */ - - -/* REF is the id-code reference frame to which XFORM will */ -/* transform states. */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. FOUND will be false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a C-kernel file is not loaded using CKLPF prior to calling */ -/* this routine, an error is signalled by a routine that this */ -/* routine calls. */ - - -/* $ Files */ - -/* CKFXFM searches through files loaded by CKLPF to locate a segment */ -/* that can satisfy the request for state transformation */ -/* for instrument INST at time ET. You must load a C-kernel */ -/* file using CKLPF before calling this routine. */ - -/* $ Particulars */ - -/* CKFXFM searches through files loaded by CKLPF to satisfy a */ -/* pointing request. Last-loaded files are searched first, and */ -/* individual files are searched in backwards order, giving */ -/* priority to segments that were added to a file later than the */ -/* others. CKFXFM considers only those segments that contain */ -/* angular velocity data. */ - -/* The search ends when a segment is found that can give pointing */ -/* and angular velocity for the specified instrument at the request */ -/* time. */ - -/* $ Examples */ - -/* Suppose that you want to determine how fast an instrument */ -/* is rotating with respect to the frame used to store the */ -/* instrument's attitude. First look up the transformation */ -/* from the instrument frame specified by ID to the reference */ -/* frame (returned by CKFXFM). */ - -/* INST = id_code of the instrument of interest */ -/* ET = epoch of interest in seconds past J2000. */ - -/* CALL CKFXFM ( INST, ET, XFORM, REF, FOUND ) */ - -/* Next determine the angular velocity of the transformation from */ - -/* CALL XF2RAV ( XFORM, ROT, AV ) */ - -/* The angular rate of change (in radians/second) is just the */ -/* magnitude of AV. */ - -/* RATE = VNORM ( AV ) */ - -/* $ Restrictions */ - -/* A C-kernel file should have been loaded by CKLPF. */ - -/* In addition is helpful to load a CK-info file into the */ -/* Kernel pool. This file should have the following variables */ -/* defined. */ - -/* CK__SCLK = SCLK idcode that yields SCLK mapping for INST. */ -/* CK__SPK = SPK idcode that yields ephemeris for INST. */ - -/* where is the integer string corresponding to INST. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 17-FEB-2000 (WLT) */ - -/* The routine now checks to make sure convert ET to TICKS */ -/* and that at least one C-kernel is loaded before trying */ -/* to look up the transformation. */ - -/* - SPICELIB Version 2.1.0, 09-MAR-1999 (NJB) */ - -/* A call to SCE2T has been replaced by a call to SCE2C. */ - -/* - SPICELIB Version 2.0.0, 28-JUL-1997 (WLT) */ - -/* The previous edition did not correctly compute the derivative */ -/* block of the state transformation matrix. */ - -/* The routine incorrectly computed the state transformation */ -/* matrix using the rotation from INST to REF together with */ -/* the angular velocity from REF to INST. Now it computes */ -/* the state transformation matrix from REF to INST and then */ -/* inverts the result to get the correct matrix. */ - -/* Moved the assignment of FOUND to just before the check */ -/* of the SPICELIB function RETURN. That way if the routine */ -/* exits immediately via a check of the function RETURN(), */ -/* FOUND will have an appropriate value. */ - -/* - SPICELIB Version 1.0.0, 3-OCT-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* get instrument frame transformation and reference frame */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 09-MAR-1999 (NJB) */ - -/* A call to SCE2T has been replaced by a call to SCE2C. This */ -/* routine performs conversion of ET to continuous ticks, */ -/* reducing truncation error in the representation of the input */ -/* time value. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* NC is the number of components in a packed C-kernel */ -/* descriptor. All DAF summaries have this formulaic */ -/* relationship between the number of its integer and */ -/* double precision components and the number of packed */ -/* components. */ - -/* IDLEN is the length of the C-kernel segment identifier. */ -/* All DAF names have this formulaic relationship */ -/* between the number of summary components and */ -/* the length of the name (You will notice that */ -/* a name and a summary have the same length in bytes.) */ - - -/* Local variables */ - - -/* Set FOUND to FALSE right now in case we end up */ -/* returning before doing any work. */ - - *found = FALSE_; - *ref = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKFXFM", (ftnlen)6); - } - -/* Need angular velocity data. */ -/* Assume the segment won't be found until it really is. */ - - needav = TRUE_; - tol = 0.; - -/* Begin a search for this instrument and time, and get the first */ -/* applicable segment. */ - - ckmeta_(inst, "SCLK", &sclkid, (ftnlen)4); - ckhave_(&have); - if (! have) { - chkout_("CKFXFM", (ftnlen)6); - return 0; - } else if (! zzsclk_(inst, &sclkid)) { - chkout_("CKFXFM", (ftnlen)6); - return 0; - } - sce2c_(&sclkid, et, &time); - ckbss_(inst, &time, &tol, &needav); - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - -/* Keep trying candidate segments until a segment can produce a */ -/* pointing instance within the specified time tolerance of the */ -/* input time. */ - -/* Check FAILED to prevent an infinite loop if an error is detected */ -/* by a SPICELIB routine and the error handling is not set to abort. */ - - while(sfnd && ! failed_()) { - ckpfs_(&handle, descr, &time, &tol, &needav, rot, av, &clkout, &pfnd); - if (pfnd) { - -/* Found one. Fetch the ID code of the reference frame */ -/* from the descriptor. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - *ref = icd[1]; - *found = TRUE_; - -/* We now have the transformation matrix from */ -/* REF to INST immediately. Using the angular velocity */ -/* we compute the state transformation matrix from REF to INST */ - - rav2xf_(rot, av, ref2in); - -/* Finally, we invert REF2IN to get the state transformation */ -/* from INST to REF. */ - - invstm_(ref2in, xform); - chkout_("CKFXFM", (ftnlen)6); - return 0; - } - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - } - chkout_("CKFXFM", (ftnlen)6); - return 0; -} /* ckfxfm_ */ - diff --git a/ext/spice/src/cspice/ckgp.c b/ext/spice/src/cspice/ckgp.c deleted file mode 100644 index a1c684182e..0000000000 --- a/ext/spice/src/cspice/ckgp.c +++ /dev/null @@ -1,1026 +0,0 @@ -/* ckgp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__9 = 9; - -/* $Procedure CKGP ( C-kernel, get pointing ) */ -/* Subroutine */ int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol, - char *ref, doublereal *cmat, doublereal *clkout, logical *found, - ftnlen ref_len) -{ - logical pfnd, sfnd; - integer sclk; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - integer type1, type2; - char segid[40]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), ckbss_(integer *, doublereal *, - doublereal *, logical *), ckpfs_(integer *, doublereal *, - doublereal *, doublereal *, logical *, doublereal *, doublereal *, - doublereal *, logical *), moved_(doublereal *, integer *, - doublereal *), cksns_(integer *, doublereal *, char *, logical *, - ftnlen); - logical gotit; - extern logical failed_(void); - doublereal av[3], et; - integer handle; - extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, - doublereal *); - logical needav; - extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen); - integer refseg, center; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - integer refreq, typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal tmpmat[9] /* was [3][3] */; - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Get pointing (attitude) for a specified spacecraft clock time. */ - -/* $ 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 */ - -/* CK */ -/* SCLK */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INST I NAIF ID of instrument, spacecraft, or structure. */ -/* SCLKDP I Encoded spacecraft clock time. */ -/* TOL I Time tolerance. */ -/* REF I Reference frame. */ -/* CMAT O C-matrix pointing data. */ -/* CLKOUT O Output encoded spacecraft clock time. */ -/* FOUND O True when requested pointing is available. */ - -/* $ Detailed_Input */ - -/* INST is the NAIF integer ID for the instrument, spacecraft, */ -/* or other structure for which pointing is requested. */ -/* For brevity we will refer to this object as the */ -/* "instrument," and the frame fixed to this object as */ -/* the "instrument frame" or "instrument-fixed" frame. */ - -/* SCLKDP is the encoded spacecraft clock time for which */ -/* pointing is requested. */ - -/* The SPICELIB routines SCENCD and SCE2C respectively */ -/* convert spacecraft clock strings and ephemeris time to */ -/* encoded spacecraft clock. The inverse conversions are */ -/* performed by SCDECD and SCT2E. */ - -/* TOL is a time tolerance in ticks, the units of encoded */ -/* spacecraft clock time. */ - -/* The SPICELIB routine SCTIKS converts a spacecraft */ -/* clock tolerance duration from its character string */ -/* representation to ticks. SCFMT performs the inverse */ -/* conversion. */ - -/* The C-matrix returned by CKGP is the one whose time */ -/* tag is closest to SCLKDP and within TOL units of */ -/* SCLKDP. (More in Particulars, below.) */ - -/* In general, because using a non-zero tolerance */ -/* affects selection of the segment from which the */ -/* data is obtained, users are strongly discouraged */ -/* from using a non-zero tolerance when reading CKs */ -/* with continuous data. Using a non-zero tolerance */ -/* should be reserved exclusively to reading CKs with */ -/* discrete data because in practice obtaining data */ -/* from such CKs using a zero tolerance is often not */ -/* possible due to time round off. */ - -/* REF is the desired reference frame for the returned */ -/* pointing. The returned C-matrix CMAT gives the */ -/* orientation of the instrument designated by INST */ -/* relative to the frame designated by REF. When a */ -/* vector specified relative to frame REF is left- */ -/* multiplied by CMAT, the vector is rotated to the */ -/* frame associated with INST. See the discussion of */ -/* CMAT below for details. */ - -/* Consult the SPICE document "Frames" for a discussion */ -/* of supported reference frames. */ - -/* $ Detailed_Output */ - -/* CMAT is a rotation matrix that transforms the components of */ -/* a vector expressed in the reference frame specified by */ -/* REF to components expressed in the frame tied to the */ -/* instrument, spacecraft, or other structure at time */ -/* CLKOUT (see below). */ - -/* Thus, if a vector v has components x,y,z in the REF */ -/* reference frame, then v has components x',y',z' in the */ -/* instrument fixed frame at time CLKOUT: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If you know x', y', z', use the transpose of the */ -/* C-matrix to determine x, y, z as follows: */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - - -/* CLKOUT is the encoded spacecraft clock time associated with */ -/* the returned C-matrix. This value may differ from the */ -/* requested time, but never by more than the input */ -/* tolerance TOL. */ - -/* The particulars section below describes the search */ -/* algorithm used by CKGP to satisfy a pointing */ -/* request. This algorithm determines the pointing */ -/* instance (and therefore the associated time value) */ -/* that is returned. */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. FOUND will be false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a C-kernel file has not been loaded using FURNSH prior to */ -/* a call to this routine, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 2) If TOL is negative, found is set to .FALSE. */ - -/* 3) If REF is not a supported reference frame, an error is */ -/* signaled by a routine in the call tree of this routine and */ -/* FOUND is set to .FALSE. */ - -/* $ Files */ - -/* CKGP searches through files loaded by FURNSH to locate a */ -/* segment that can satisfy the request for pointing for instrument */ -/* INST at time SCLKDP. You must load a C-kernel file using FURNSH */ -/* prior to calling this routine. */ - -/* $ Particulars */ - -/* How the tolerance argument is used */ -/* ================================== */ - - -/* Reading a type 1 CK segment (discrete pointing instances) */ -/* --------------------------------------------------------- */ - -/* In the diagram below */ - -/* - "0" is used to represent discrete pointing instances */ -/* (quaternions and associated time tags). */ - -/* - "( )" are used to represent the end points of the time */ -/* interval covered by a segment in a CK file. */ - -/* - SCLKDP is the time at which you requested pointing. */ -/* The location of SCLKDP relative to the time tags of the */ -/* pointing instances is indicated by the "+" sign. */ - -/* - TOL is the time tolerance specified in the pointing */ -/* request. The square brackets "[ ]" represent the */ -/* endpoints of the time interval */ - -/* SCLKDP-TOL : SCLKDP+TOL */ - -/* - The quaternions occurring in the segment need not be */ -/* evenly spaced in time. */ - - -/* Case 1: pointing is available */ -/* ------------------------------ */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) */ -/* ^ */ -/* | */ -/* CKGP returns this instance. */ - - -/* Case 2: pointing is not available */ -/* ---------------------------------- */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) */ - - -/* CKGP returns no pointing; the output */ -/* FOUND flag is set to .FALSE. */ - - - -/* Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) */ -/* ------------------------------------------------------------- */ - -/* In the diagrams below */ - -/* - "==" is used to represent periods of continuous pointing. */ - -/* - "--" is used to represent gaps in the pointing coverage. */ - -/* - "( )" are used to represent the end points of the time */ -/* interval covered by a segment in a CK file. */ - -/* - SCLKDP is the time at which you requested pointing. */ -/* The location of SCLKDP relative to the time tags of the */ -/* pointing instances is indicated by the "+" sign. */ - -/* - TOL is the time tolerance specified in the pointing */ -/* request. The square brackets "[ ]" represent the */ -/* endpoints of the time interval */ - -/* SCLKDP-TOL : SCLKDP+TOL */ - -/* - The quaternions occurring in the periods of continuous */ -/* pointing need not be evenly spaced in time. */ - - -/* Case 1: pointing is available at the request time */ -/* -------------------------------------------------- */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* . . . */ -/* Segment (==---===========---=======----------===--) */ -/* ^ */ -/* | */ - -/* The request time lies within an interval where */ -/* continuous pointing is available. CKGP returns */ -/* pointing at the requested epoch. */ - - -/* Case 2: pointing is available "near" the request time */ -/* ------------------------------------------------------ */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (==---===========----=======---------===--) */ -/* ^ */ -/* | */ - -/* The request time lies in a gap: an interval where */ -/* continuous pointing is *not* available. CKGP */ -/* returns pointing for the epoch closest to the */ -/* request time SCLKDP. */ - - -/* Case 3: pointing is not available */ -/* ---------------------------------- */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (==---===========----=======---------===--) */ - -/* CKGP returns no pointing; the output */ -/* FOUND flag is set to .FALSE. */ - - - -/* Tolerance and segment priority */ -/* ============================== */ - -/* CKGP searches through loaded C-kernels to satisfy a pointing */ -/* request. Last-loaded files are searched first. Individual files */ -/* are searched in backwards order, so that between competing */ -/* segments (segments containing data for the same object, for */ -/* overlapping time ranges), the one closest to the end of the file */ -/* has highest priority. */ - -/* The search ends when a segment is found that can provide pointing */ -/* for the specified instrument at a time falling within the */ -/* specified tolerance on either side of the request time. Within */ -/* that segment, the instance closest to the input time is located */ -/* and returned. */ - -/* The following four cases illustrate this search procedure. */ -/* Segments A and B are in the same file, with segment A located */ -/* further towards the end of the file than segment B. Both segments */ -/* A and B contain discrete pointing data, indicated by the number */ -/* 0. */ - - -/* Case 1: Pointing is available in the first segment searched. */ -/* Because segment A has the highest priority and can */ -/* satisfy the request, segment B is not searched. */ - - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment A (0-----------------0--------0--0-----0) */ -/* ^ */ -/* | */ -/* | */ -/* CKGP returns this instance */ - -/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */ - - - -/* Case 2: Pointing is not available in the first segment searched. */ -/* Because segment A cannot satisfy the request, segment B */ -/* is searched. */ - - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment A (0-----------------0--------0--0-----0) */ -/* . . . */ -/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */ -/* ^ */ -/* | */ -/* CKGP returns this instance */ - - -/* Segments that contain continuous pointing data are searched in */ -/* the same manner as segments containing discrete pointing data. */ -/* For request times that fall within the bounds of continuous */ -/* intervals, CKGP will return pointing at the request time. When */ -/* the request time does not fall within an interval, then a time at */ -/* an endpoint of an interval may be returned if it is the closest */ -/* time in the segment to the user request time and is also within */ -/* the tolerance. */ - -/* In the following examples, segment A is located further towards */ -/* the end of the file than segment C. Segment A contains discrete */ -/* pointing data and segment C contains continuous data, indicated */ -/* by the "=" character. */ - - -/* Case 3: Pointing is not available in the first segment searched. */ -/* Because segment A cannot satisfy the request, segment C */ -/* is searched. */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* Segment A (0-----------------0--------0--0-----0) */ -/* . . . */ -/* . . . */ -/* Segment C (---=============-----====--------==--) */ -/* ^ */ -/* | */ -/* | */ -/* CKGP returns this instance */ - - -/* In the next case, assume that the order of segments A and C in the */ -/* file is reversed: A is now closer to the front, so data from */ -/* segment C are considered first. */ - - -/* Case 4: Pointing is available in the first segment searched. */ -/* Because segment C has the highest priority and can */ -/* satisfy the request, segment A is not searched. */ - -/* SCLKDP */ -/* / */ -/* | TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* Segment C (---=============-----====--------==--) */ -/* ^ */ -/* | */ -/* CKGP returns this instance */ - -/* Segment A (0-----------------0--------0--0-----0) */ -/* ^ */ -/* | */ -/* "Best" answer */ - - -/* The next case illustrates an unfortunate side effect of using */ -/* a non-zero tolerance when reading multi-segment CKs with */ -/* continuous data. In all cases when the look-up interval */ -/* formed using tolerance overlaps a segment boundary and */ -/* the request time falls within the coverage of the lower */ -/* priority segment, the data at the end of the higher priority */ -/* segment will be picked instead of the data from the lower */ -/* priority segment. */ - - -/* Case 5: Pointing is available in the first segment searched. */ -/* Because segment C has the highest priority and can */ -/* satisfy the request, segment A is not searched. */ - -/* SCLKDP */ -/* / */ -/* | TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* Segment C (===============) */ -/* ^ */ -/* | */ -/* CKGP returns this instance */ - -/* Segment A (=====================) */ -/* ^ */ -/* | */ -/* "Best" answer */ - -/* $ Examples */ - -/* Suppose you have two C-kernel files containing data for the */ -/* Voyager 2 narrow angle camera. One file contains predict values, */ -/* and the other contains corrected pointing for a selected group */ -/* of images, that is, for a subset of images from the first file. */ - -/* The following example program uses CKGP to get C-matrices for a */ -/* set of images whose SCLK counts (un-encoded character string */ -/* versions) are contained in the array SCLKCH. */ - -/* If available, the program will get the corrected pointing values. */ -/* Otherwise, predict values will be used. */ - -/* For each C-matrix, a unit pointing vector is constructed */ -/* and printed. */ - - -/* C */ -/* C Constants for this program. */ -/* C */ -/* C -- The code for the Voyager 2 spacecraft clock is -32 */ -/* C */ -/* C -- The code for the narrow angle camera on the Voyager 2 */ -/* C spacecraft is -32001. */ -/* C */ -/* C -- Spacecraft clock times for successive Voyager images */ -/* C always differ by more than 0:0:400. This is an */ -/* C acceptable tolerance, and must be converted to "ticks" */ -/* C (units of encoded SCLK) for input to CKGP. */ -/* C */ -/* C -- The reference frame we want is FK4. */ -/* C */ -/* C -- The narrow angle camera boresight defines the third */ -/* C axis of the instrument-fixed coordinate system. */ -/* C Therefore, the vector ( 0, 0, 1 ) represents */ -/* C the boresight direction in the camera-fixed frame. */ -/* C */ -/* IMPLICIT NONE */ - -/* INTEGER FILEN */ -/* PARAMETER ( FILEN = 255 ) */ - -/* INTEGER NPICS */ -/* PARAMETER ( NPICS = 2 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 30 ) */ - -/* INTEGER REFLEN */ -/* PARAMETER ( REFLEN = 32 ) */ - -/* CHARACTER*(TIMLEN) CLKCH */ -/* CHARACTER*(FILEN) CKPRED */ -/* CHARACTER*(FILEN) CKCORR */ -/* CHARACTER*(REFLEN) REF */ -/* CHARACTER*(FILEN) SCLK */ -/* CHARACTER*(TIMLEN) SCLKCH ( NPICS ) */ -/* CHARACTER*(TIMLEN) TOLVGR */ - -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOLTIK */ -/* DOUBLE PRECISION VCFIX ( 3 ) */ -/* DOUBLE PRECISION VINERT ( 3 ) */ - -/* INTEGER SC */ -/* INTEGER I */ -/* INTEGER INST */ - -/* LOGICAL FOUND */ - -/* CKPRED = 'voyager2_predict.bc' */ -/* CKCORR = 'voyager2_corrected.bc' */ -/* SCLK = 'voyager2_sclk.tsc' */ -/* SC = -32 */ -/* INST = -32001 */ -/* SCLKCH(1) = '4/08966:30:768' */ -/* SCLKCH(2) = '4/08970:58:768' */ -/* TOLVGR = '0:0:400' */ -/* REF = 'FK4' */ -/* VCFIX( 1 ) = 0.D0 */ -/* VCFIX( 2 ) = 0.D0 */ -/* VCFIX( 3 ) = 1.D0 */ - -/* C */ -/* C Loading the files in this order ensures that the */ -/* C corrected file will get searched first. */ -/* C */ -/* CALL FURNSH ( CKPRED ) */ -/* CALL FURNSH ( CKCORR ) */ - -/* C */ -/* C Need to load a Voyager 2 SCLK kernel to convert from */ -/* C clock strings to ticks. */ -/* C */ -/* CALL FURNSH ( SCLK ) */ - -/* C */ -/* C Convert tolerance from VGR formatted character string */ -/* C SCLK to ticks which are units of encoded SCLK. */ -/* C */ -/* CALL SCTIKS ( SC, TOLVGR, TOLTIK ) */ - - -/* DO I = 1, NPICS */ -/* C */ -/* C CKGP requires encoded spacecraft clock. */ -/* C */ -/* CALL SCENCD ( SC, SCLKCH( I ), SCLKDP ) */ - -/* CALL CKGP ( INST, SCLKDP, TOLTIK, REF, CMAT, */ -/* . CLKOUT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* C */ -/* C Use the transpose of the C-matrix to transform the */ -/* C boresight vector from camera-fixed to reference */ -/* C coordinates. */ -/* C */ -/* CALL MTXV ( CMAT, VCFIX, VINERT ) */ -/* CALL SCDECD ( SC, CLKOUT, CLKCH ) */ - -/* WRITE (*,*) 'VGR 2 SCLK Time: ', CLKCH */ -/* WRITE (*,*) 'VGR 2 NA ISS boresight ' */ -/* . // 'pointing vector: ', VINERT */ - -/* ELSE */ - -/* WRITE (*,*) 'Pointing not found for time ', SCLKCH(I) */ - -/* END IF */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* J.M. Lynch (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.3.1, 09-JUN-2010 (BVS) */ - -/* Header update: description of the tolerance and Particulars */ -/* section were expanded to address some problems arising from */ -/* using a non-zero tolerance. */ - -/* - SPICELIB Version 5.3.0, 23-APR-2010 (NJB) */ - -/* Bug fix: this routine now obtains the rotation */ -/* from the request frame to the applicable CK segment's */ -/* base frame via a call to REFCHG. Formerly the routine */ -/* used FRMCHG, which required that angular velocity data */ -/* be available for this transformation. */ - -/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM call. */ - -/* - SPICELIB Version 5.1.2, 29-JAN-2004 (NJB) */ - -/* Header update: description of input argument REF was */ -/* expanded. */ - -/* - SPICELIB Version 5.1.1, 27-JUL-2003 (CHA) (NJB) */ - -/* Various header corrections were made. */ - -/* - SPICELIB Version 3.2.0, 23-FEB-1999 (WLT) */ - -/* The previous editions of this routine did not properly handle */ -/* the case when TOL was negative. The routine now returns a */ -/* value of .FALSE. for FOUND as is advertised above. */ - -/* - SPICELIB Version 3.1.0, 13-APR-1998 (WLT) */ - -/* The call to CHKOUT in the case when FAILED returned the */ -/* value TRUE used to check out with the name 'CKGPAV'. This */ -/* has been changed to a CKGP. */ - -/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */ - -/* The routine was upgraded to support non-inertial frames. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */ - -/* The Particulars section was updated to show how the */ -/* search algorithm processes segments with continuous */ -/* pointing data. */ - -/* The example program now loads an SCLK kernel. */ - -/* FAILED is checked after the call to IRFROT to handle the */ -/* case where the reference frame is invalid and the error */ -/* handling is not set to abort. */ - -/* FAILED is checked in the DO WHILE loop to handle the case */ -/* where an error is detected by a SPICELIB routine inside the */ -/* loop and the error handling is not set to abort. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get ck pointing */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM call. */ - -/* - SPICELIB Version 3.1.0, 20-DEC-1995 (WLT) */ - -/* A call to FRINFO did not have enough arguments and */ -/* went undetected until Howard Taylor of ACT. Many */ -/* thanks go out to Howard for tracking down this error. */ - -/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */ - -/* The routine was upgraded to support non-inertial frames. */ - -/* Calls to NAMIRF and IRFROT were replaced with calls to */ -/* NAMFRM and FRMCHG respectively. */ - - -/* - SPICELIB Version 1.0.2, 30-AUG-1991 (JML) */ - -/* 1) The Particulars section was updated to show how the */ -/* search algorithm processes segments with continuous */ -/* pointing data. */ - -/* 2) The example program now loads an SCLK kernel. */ - -/* 3) FAILED is checked after the call to IRFROT to handle the */ -/* case where the reference frame is invalid and the error */ -/* handling is not set to abort. */ - -/* 4) FAILED is checked in the DO WHILE loop to handle the case */ -/* where an error is detected by a SPICELIB routine inside the */ -/* loop and the error handling is not set to abort. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* 1) The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ -/* 2) Minor changes were made to the wording of the header. */ - - -/* - Beta Version 1.1.0, 29-AUG-1990 (MJS) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable SCLK was changed to SCLKDP. */ -/* 2) The variable INSTR was changed to INST. */ -/* 3) The variable IDENT was changed to SEGID. */ -/* 4) The declarations for the parameters NDC, NIC, NC, and */ -/* IDLEN were moved from the "Declarations" section of the */ -/* header to the "Local parameters" section of the code below */ -/* the header. These parameters are not meant to modified by */ -/* users. */ -/* 5) The header was updated to reflect the changes. */ - -/* - Beta Version 1.0.0, 04-MAY-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* NC is the number of components in a packed C-kernel */ -/* descriptor. All DAF summaries have this formulaic */ -/* relationship between the number of its integer and */ -/* double precision components and the number of packed */ -/* components. */ - -/* IDLEN is the length of the C-kernel segment identifier. */ -/* All DAF names have this formulaic relationship */ -/* between the number of summary components and */ -/* the length of the name (You will notice that */ -/* a name and a summary have the same length in bytes.) */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGP", (ftnlen)4); - } - -/* Don't need angular velocity data. */ -/* Assume the segment won't be found until it really is. */ - - needav = FALSE_; - *found = FALSE_; - -/* If the tolerance is less than zero, we go no further. */ - - if (*tol < 0.) { - chkout_("CKGP", (ftnlen)4); - return 0; - } - -/* Begin a search for this instrument and time, and get the first */ -/* applicable segment. */ - - ckbss_(inst, sclkdp, tol, &needav); - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - -/* Keep trying candidate segments until a segment can produce a */ -/* pointing instance within the specified time tolerance of the */ -/* input time. */ - -/* Check FAILED to prevent an infinite loop if an error is detected */ -/* by a SPICELIB routine and the error handling is not set to abort. */ - - while(sfnd && ! failed_()) { - ckpfs_(&handle, descr, sclkdp, tol, &needav, cmat, av, clkout, &pfnd); - if (pfnd) { - -/* Found one. If the C-matrix doesn't already rotate from the */ -/* requested frame, convert it to one that does. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - refseg = icd[1]; - -/* Look up the id code for the requested reference frame. */ - - namfrm_(ref, &refreq, ref_len); - if (refreq != refseg) { - -/* We may need to convert the output ticks CLKOUT to ET */ -/* so that we can get the needed state transformation */ -/* matrix. This is the case if either of the frames */ -/* is non-inertial. */ - - frinfo_(&refreq, ¢er, &type1, &typeid, &gotit); - frinfo_(&refseg, ¢er, &type2, &typeid, &gotit); - if (type1 == 1 && type2 == 1) { - -/* Any old value of ET will do in this case. We'll */ -/* use zero. */ - - et = 0.; - } else { - -/* Look up the spacecraft clock id to use to convert */ -/* the output CLKOUT to ET. */ - - ckmeta_(inst, "SCLK", &sclk, (ftnlen)4); - sct2e_(&sclk, clkout, &et); - } - -/* Get the transformation from the requested frame to */ -/* the segment frame at ET. */ - - refchg_(&refreq, &refseg, &et, rot); - -/* If REFCHG detects that the reference frame is invalid */ -/* then return from this routine with FOUND equal to false. */ - - if (failed_()) { - chkout_("CKGP", (ftnlen)4); - return 0; - } - -/* Transform the attitude information: convert CMAT so that */ -/* it maps from request frame to C-matrix frame. */ - - mxm_(cmat, rot, tmpmat); - moved_(tmpmat, &c__9, cmat); - } - *found = TRUE_; - chkout_("CKGP", (ftnlen)4); - return 0; - } - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - } - chkout_("CKGP", (ftnlen)4); - return 0; -} /* ckgp_ */ - diff --git a/ext/spice/src/cspice/ckgp_c.c b/ext/spice/src/cspice/ckgp_c.c deleted file mode 100644 index 24f984644f..0000000000 --- a/ext/spice/src/cspice/ckgp_c.c +++ /dev/null @@ -1,721 +0,0 @@ -/* - --Procedure ckgp_c ( C-kernel, get pointing ) - --Abstract - - Get pointing (attitude) for a specified spacecraft clock time. - --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 - - CK - SCLK - --Keywords - - POINTING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ckgp_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble * clkout, - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - inst I NAIF ID of instrument, spacecraft, or structure. - sclkdp I Encoded spacecraft clock time. - tol I Time tolerance. - ref I Reference frame. - cmat O C-matrix pointing data. - clkout O Output encoded spacecraft clock time. - found O True when requested pointing is available. - --Detailed_Input - - inst is the NAIF integer ID for the instrument, spacecraft, or - other structure for which pointing is being requested. - For brevity we will refer to this object as the - "instrument," and the frame fixed to this object as the - "instrument frame" or "instrument-fixed" frame. - - sclkdp is the encoded spacecraft clock time for which - pointing is being requested. - - The CSPICE routines scencd_c and sce2c_c respectively - convert spacecraft clock strings and ephemeris time - to encoded spacecraft clock. The inverse conversions - are performed by scdecd_c and sct2e_c. - - tol is a time tolerance in ticks, the units of encoded - spacecraft clock time. - - The CSPICE routine sctiks_c converts a spacecraft clock - tolerance duration from its character string - representation to ticks. scfmt_c performs the inverse - conversion. - - The C-matrix returned by ckgp_c is the one whose time tag - is closest to `sclkdp' and within `tol' units of - `sclkdp'. (More in Particulars, below.) - - In general, because using a non-zero tolerance - affects selection of the segment from which the - data is obtained, users are strongly discouraged - from using a non-zero tolerance when reading CKs - with continuous data. Using a non-zero tolerance - should be reserved exclusively to reading CKs with - discrete data because in practice obtaining data - from such CKs using a zero tolerance is often not - possible due to time round off. - - ref is the desired reference frame for the returned pointing. - The returned C-matrix `cmat' gives the orientation of the - instrument designated by `inst' relative to the frame - designated by `ref'. When a vector specified relative to - frame `ref' is left-multiplied by `cmat', the vector is - rotated to the frame associated with `inst'. See the - discussion of `cmat' below for details. - - Consult the SPICE document "Frames" for a discussion - of supported reference frames. - --Detailed_Output - - cmat is a rotation matrix that transforms the components of a - vector expressed in the frame specified by `ref' to - components expressed in the frame tied to the instrument, - spacecraft, or other structure at time `clkout' (see - below). - - Thus, if a vector v has components x,y,z in the `ref' - reference frame, then v has components x',y',z' in the - instrument fixed frame at time `clkout': - - [ x' ] [ ] [ x ] - | y' | = | cmat | | y | - [ z' ] [ ] [ z ] - - If you know x', y', z', use the transpose of the - C-matrix to determine x, y, z as follows: - - [ x ] [ ]T [ x' ] - | y | = | cmat | | y' | - [ z ] [ ] [ z' ] - (Transpose of cmat) - - - clkout is the encoded spacecraft clock time associated with - the returned C-matrix. This value may differ from the - requested time, but never by more than the input - tolerance `tol'. - - The particulars section below describes the search - algorithm used by ckgp_c to satisfy a pointing request. - This algorithm determines the pointing instance - (and therefore the associated time value) that is - returned. - - found is SPICETRUE if a record was found to satisfy the - pointing request. `found' will be SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) If a C-kernel file has not been loaded using furnsh_c prior to a - call to this routine, an error is signaled by a routine in the - call tree of this routine. - - 2) If `tol' is negative, found is set to SPICEFALSE. - - 3) If `ref' is not a supported reference frame, an error is - signaled by a routine in the call tree of this routine and - `found' is set to SPICEFALSE. - --Files - - ckgp_c searches through files loaded by furnsh_c to locate a segment - that satisfies the request for pointing for the instrument `inst' at - time `sclkdp'. You must load at least one C-kernel file via furnsh_c - prior to calling this routine. - --Particulars - - How the tolerance argument is used - ================================== - - - Reading a type 1 CK segment (discrete pointing instances) - --------------------------------------------------------- - - In the diagram below - - - "0" is used to represent discrete pointing instances - (quaternions and associated time tags). - - - "( )" are used to represent the end points of the time - interval covered by a segment in a CK file. - - - `sclkdp' is the time at which you requested pointing. - The location of `sclkdp' relative to the time tags of the - pointing instances is indicated by the "+" sign. - - - `tol' is the time tolerance specified in the pointing - request. The square brackets "[ ]" represent the - endpoints of the time interval - - sclkdp-tol : sclkdp+tol - - - The quaternions occurring in the segment need not be - evenly spaced in time. - - - Case 1: pointing is available - ------------------------------ - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) - ^ - | - ckgp_c returns this instance. - - - Case 2: pointing is not available - ---------------------------------- - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) - - - ckgp_c returns no pointing; the output - `found' flag is set to SPICEFALSE. - - - - Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) - ------------------------------------------------------------- - - In the diagrams below - - - "==" is used to represent periods of continuous pointing. - - - "--" is used to represent gaps in the pointing coverage. - - - "( )" are used to represent the end points of the time - interval covered by a segment in a CK file. - - - `sclkdp' is the time at which you requested pointing. - The location of `sclkdp' relative to the time tags of the - pointing instances is indicated by the "+" sign. - - - `tol' is the time tolerance specified in the pointing - request. The square brackets "[ ]" represent the - endpoints of the time interval - - sclkdp-tol : sclkdp+tol - - - The quaternions occurring in the periods of continuous - pointing need not be evenly spaced in time. - - - Case 1: pointing is available at the request time - -------------------------------------------------- - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - . . . - . . . - Segment (==---===========---=======----------===--) - ^ - | - - The request time lies within an interval where - continuous pointing is available. ckgp_c returns - pointing at the requested epoch. - - - Case 2: pointing is available "near" the request time - ------------------------------------------------------ - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (==---===========----=======---------===--) - ^ - | - - The request time lies in a gap: an interval where - continuous pointing is *not* available. ckgp_c - returns pointing for the epoch closest to the - request time `sclkdp'. - - - Case 3: pointing is not available - ---------------------------------- - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (==---===========----=======---------===--) - - ckgp_c returns no pointing; the output - `found' flag is set to SPICEFALSE. - - - - Tolerance and segment priority - ============================== - - ckgp_c searches through loaded C-kernels to satisfy a pointing - request. Last-loaded files are searched first. Individual files are - searched in backwards order, so that between competing segments - (segments containing data for the same object, for overlapping time - ranges), the one closest to the end of the file has highest - priority. - - The search ends when a segment is found that can provide pointing - for the specified instrument at a time falling within the specified - tolerance on either side of the request time. Within that segment, - the instance closest to the input time is located and returned. - - The following four cases illustrate this search procedure. Segments - A and B are in the same file, with segment A located further - towards the end of the file than segment B. Both segments A and B - contain discrete pointing data, indicated by the number 0. - - - Case 1: Pointing is available in the first segment searched. - Because segment A has the highest priority and can - satisfy the request, segment B is not searched. - - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment A (0-----------------0--------0--0-----0) - ^ - | - | - ckgp_c returns this instance - - Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) - - - - Case 2: Pointing is not available in the first segment searched. - Because segment A cannot satisfy the request, segment B - is searched. - - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment A (0-----------------0--------0--0-----0) - . . . - Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) - ^ - | - ckgp_c returns this instance - - - Segments that contain continuous pointing data are searched in the - same manner as segments containing discrete pointing data. For - request times that fall within the bounds of continuous intervals, - ckgp_c will return pointing at the request time. When the request - time does not fall within an interval, then a time at an endpoint of - an interval may be returned if it is the closest time in the segment - to the user request time and is also within the tolerance. - - In the following examples, segment A is located further towards the - end of the file than segment C. Segment A contains discrete pointing - data and segment C contains continuous data, indicated by the "=" - character. - - - Case 3: Pointing is not available in the first segment searched. - Because segment A cannot satisfy the request, segment C - is searched. - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - . . . - Segment A (0-----------------0--------0--0-----0) - . . . - . . . - Segment C (---=============-----====--------==--) - ^ - | - | - ckgp_c returns this instance - - - In the next case, assume that the order of segments A and C in the - file is reversed: A is now closer to the front, so data from - segment C are considered first. - - - Case 4: Pointing is available in the first segment searched. - Because segment C has the highest priority and can - satisfy the request, segment A is not searched. - - sclkdp - / - | tol - | / - |/\ - Your request [--+--] - . . . - . . . - Segment C (---=============-----====--------==--) - ^ - | - ckgp_c returns this instance - - Segment A (0-----------------0--------0--0-----0) - ^ - | - "Best" answer - - - The next case illustrates an unfortunate side effect of using - a non-zero tolerance when reading multi-segment CKs with - continuous data. In all cases when the look-up interval - formed using tolerance overlaps a segment boundary and - the request time falls within the coverage of the lower - priority segment, the data at the end of the higher priority - segment will be picked instead of the data from the lower - priority segment. - - - Case 5: Pointing is available in the first segment searched. - Because segment C has the highest priority and can - satisfy the request, segment A is not searched. - - sclkdp - / - | tol - | / - |/\ - Your request [--+--] - . . . - . . . - Segment C (===============) - ^ - | - ckgp_c returns this instance - - Segment A (=====================) - ^ - | - "Best" answer - - --Examples - - - Suppose you have two C-kernel files containing pointing for the - Voyager 2 narrow angle camera. One file contains predict (planned) - values, and the other contains corrected pointing for a selected - group of images, that is, for a subset of images from the first - file. - - The following example program uses ckgp_c to get C-matrices for a - set of images whose SCLK counts (un-encoded character string - versions) are contained in the array `sclkch'. - - If available, the program will get the corrected pointing values. - Otherwise, predict values will be used. - - For each C-matrix, a unit pointing vector is constructed and - printed. - - #include - #include "SpiceUsr.h" - - int main () - { - /. - Constants for this program: - - -- The code for the Voyager 2 spacecraft clock is -32 - - -- The code for the narrow angle camera on the Voyager 2 - spacecraft is -32001. - - -- Spacecraft clock times for successive Voyager images always - differ by more than 0:0:400. This is an acceptable - tolerance, and must be converted to "ticks" (units of - encoded SCLK) for input to ckgp_c. - - -- The reference frame we want is FK4. - - -- The narrow angle camera boresight defines the third - axis of the instrument-fixed reference frame. - Therefore, the vector ( 0, 0, 1 ) represents - the boresight direction in the camera-fixed frame. - ./ - - #define SC -32 - #define INST -32001 - #define REF "FK4" - #define TOLVGR "0:0:400" - #define NPICS 2 - #define MAXCLK 30 - #define CKPRED "voyager2_predict.bc" - #define CKCORR "voyager2_corrected.bc" - #define SCLK "voyager2_sclk.tsc" - - - SpiceBoolean found; - - SpiceChar sclkch [NPICS][MAXCLK] = - - { { "4/08966:30:768" }, - { "4/08970:58:768" } }; - - SpiceChar clkch [MAXCLK]; - - SpiceDouble cmat [3][3]; - SpiceDouble clkout; - SpiceDouble sclkdp; - SpiceDouble toltik; - SpiceDouble vinert [3]; - - SpiceInt i; - - - /. - Loading the files in this order ensures that the - corrected file will get searched first. - ./ - furnsh_c ( CKPRED ); - furnsh_c ( CKCORR ); - - /. - Need to load a Voyager 2 SCLK kernel to convert from - clock string to ticks. Although not required for - the Voyager spacecraft clocks, most modern spacecraft - clocks require a leapseconds kernel to be loaded in - addition to an SCLK kernel. - ./ - furnsh_c ( SCLK ); - - /. - Convert tolerance from VGR formatted character string - SCLK to ticks, which are units of encoded SCLK. - ./ - sctiks_c ( SC, TOLVGR, &toltik ); - - for ( i = 0; i < NPICS; i++ ) - { - - /. - ckgp_c requires encoded spacecraft clock time. - ./ - scencd_c ( SC, sclkch[ i ], &sclkdp ); - - ckgp_c ( INST, sclkdp, toltik, REF, - cmat, &clkout, &found ); - - if ( found ) - { - /. - The boresight vector, relative to inertial coordinates, - is just the third row of the C-matrix. - ./ - vequ_c ( cmat[2], vinert ); - - scdecd_c ( SC, clkout, MAXCLK, clkch ); - - - printf ( "VGR 2 SCLK time: %s\n", clkch ); - - printf ( "VGR 2 NA ISS boresight pointing vector: " - "%f %f %f\n", - vinert[0], - vinert[1], - vinert[2] ); - } - else - { - printf ( "Pointing not found for time %s\n", sclkch[i] ); - } - - } - - return ( 0 ); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - J.M. Lynch (JPL) - B.V. Semenov (JPL) - M.J. Spencer (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.2.3, 03-JUN-2010 (BVS) - - Header update: description of the tolerance and Particulars - section were expanded to address some problems arising from - using a non-zero tolerance. - - -CSPICE Version 1.2.2, 29-JAN-2004 (NJB) - - Header update: description of input argument `ref' was - expanded. - - -CSPICE Version 1.2.1, 27-JUL-2003 (CHA) (NJB) - - Various header corrections were made. - - -CSPICE Version 1.2.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for found flag used in - interface of ckgp_. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) - --Index_Entries - - get ck pointing - --& -*/ - -{ /* Begin ckgp_c */ - - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "ckgp_c"); - - /* - Check the input string ref to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckgp_c", ref ); - - - ckgp_( ( integer * ) &inst, - ( doublereal * ) &sclkdp, - ( doublereal * ) &tol, - ( char * ) ref, - ( doublereal * ) cmat, - ( doublereal * ) clkout, - ( logical * ) &fnd, - ( ftnlen ) strlen(ref) ); - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - /* - Transpose the C-matrix on output. - */ - xpose_c ( cmat, cmat ); - - - chkout_c ( "ckgp_c" ); - -} /* End ckgp_c */ diff --git a/ext/spice/src/cspice/ckgpav.c b/ext/spice/src/cspice/ckgpav.c deleted file mode 100644 index 1ee8790c58..0000000000 --- a/ext/spice/src/cspice/ckgpav.c +++ /dev/null @@ -1,1208 +0,0 @@ -/* ckgpav.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__9 = 9; - -/* $Procedure CKGPAV ( C-kernel, get pointing and angular velocity ) */ -/* Subroutine */ int ckgpav_(integer *inst, doublereal *sclkdp, doublereal * - tol, char *ref, doublereal *cmat, doublereal *av, doublereal *clkout, - logical *found, ftnlen ref_len) -{ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - logical pfnd, sfnd; - integer sclk; - doublereal tmpv[3]; - extern /* Subroutine */ int mtxv_(doublereal *, doublereal *, doublereal * - ), sct2e_(integer *, doublereal *, doublereal *); - integer type1, type2; - doublereal omega[3]; - char segid[40]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), ckbss_(integer *, doublereal *, - doublereal *, logical *), ckpfs_(integer *, doublereal *, - doublereal *, doublereal *, logical *, doublereal *, doublereal *, - doublereal *, logical *), moved_(doublereal *, integer *, - doublereal *), cksns_(integer *, doublereal *, char *, logical *, - ftnlen); - logical gotit; - doublereal xform[36] /* was [6][6] */; - extern /* Subroutine */ int xf2rav_(doublereal *, doublereal *, - doublereal *); - extern logical failed_(void); - doublereal et; - integer handle; - logical needav; - extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen), - frmchg_(integer *, integer *, doublereal *, doublereal *); - integer refseg, center; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - integer refreq, typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal tmpmat[9] /* was [3][3] */; - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Get pointing (attitude) and angular velocity for a specified */ -/* spacecraft clock time. */ - -/* $ 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 */ - -/* CK */ -/* SCLK */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INST I NAIF ID of instrument, spacecraft, or structure. */ -/* SCLKDP I Encoded spacecraft clock time. */ -/* TOL I Time tolerance. */ -/* REF I Reference frame. */ -/* CMAT O C-matrix pointing data. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O Output encoded spacecraft clock time. */ -/* FOUND O True when requested pointing is available. */ - -/* $ Detailed_Input */ - -/* INST is the NAIF integer ID for the instrument, spacecraft, */ -/* or other structure for which pointing and angular */ -/* velocity are requested. For brevity we will refer to */ -/* this object as the "instrument," and the frame fixed */ -/* to this object as the "instrument frame" or */ -/* "instrument-fixed" frame. */ - -/* SCLKDP is the encoded spacecraft clock time for which */ -/* pointing and angular velocity are requested. */ - -/* The SPICELIB routines SCENCD and SCE2C respectively */ -/* convert spacecraft clock strings and ephemeris time to */ -/* encoded spacecraft clock. The inverse conversions are */ -/* performed by SCDECD and SCT2E. */ - -/* TOL is a time tolerance in ticks, the units of encoded */ -/* spacecraft clock time. */ - -/* The SPICELIB routine SCTIKS converts a spacecraft */ -/* clock tolerance duration from its character string */ -/* representation to ticks. SCFMT performs the inverse */ -/* conversion. */ - -/* The C-matrix - angular velocity vector pair returned by */ -/* CKGPAV is the one whose time tag is closest to SCLKDP */ -/* and within TOL units of SCLKDP. (More in Particulars, */ -/* below.) */ - -/* In general, because using a non-zero tolerance */ -/* affects selection of the segment from which the */ -/* data is obtained, users are strongly discouraged */ -/* from using a non-zero tolerance when reading CKs */ -/* with continuous data. Using a non-zero tolerance */ -/* should be reserved exclusively to reading CKs with */ -/* discrete data because in practice obtaining data */ -/* from such CKs using a zero tolerance is often not */ -/* possible due to time round off. */ - -/* REF is the desired reference frame for the returned */ -/* pointing and angular velocity. The returned C-matrix */ -/* CMAT gives the orientation of the instrument */ -/* designated by INST relative to the frame designated by */ -/* REF. When a vector specified relative to frame REF is */ -/* left-multiplied by CMAT, the vector is rotated to the */ -/* frame associated with INST. The returned angular */ -/* velocity vector AV expresses the angular velocity of */ -/* the instrument designated by INST relative to the */ -/* frame designated by REF. See the discussion of CMAT */ -/* and AV below for details. */ - -/* Consult the SPICE document "Frames" for a discussion */ -/* of supported reference frames. */ - -/* $ Detailed_Output */ - -/* CMAT is a rotation matrix that transforms the components of */ -/* a vector expressed in the reference frame specified by */ -/* REF to components expressed in the frame tied to the */ -/* instrument, spacecraft, or other structure at time */ -/* CLKOUT (see below). */ - -/* Thus, if a vector v has components x,y,z in the REF */ -/* reference frame, then v has components x',y',z' in the */ -/* instrument fixed frame at time CLKOUT: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If you know x', y', z', use the transpose of the */ -/* C-matrix to determine x, y, z as follows: */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - -/* AV is the angular velocity vector. This is the axis about */ -/* which the reference frame tied to the instrument is */ -/* rotating in the right-handed sense at time CLKOUT. The */ -/* magnitude of AV is the magnitude of the instantaneous */ -/* velocity of the rotation, in radians per second. AV */ -/* is expressed relative to the frame designated by REF. */ - -/* CLKOUT is the encoded spacecraft clock time associated with */ -/* the returned C-matrix and the returned angular */ -/* velocity vector. This value may differ from the */ -/* requested time, but never by more than the input */ -/* tolerance TOL. */ - -/* The particulars section below describes the search */ -/* algorithm used by CKGPAV to satisfy a pointing */ -/* request. This algorithm determines the pointing */ -/* instance (and therefore the associated time value) */ -/* that is returned. */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. FOUND will be false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a C-kernel file has not been loaded using FURNSH prior to */ -/* a call to this routine, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 2) If TOL is negative, found is set to .FALSE. */ - -/* 3) If REF is not a supported reference frame, an error is */ -/* signaled by a routine in the call tree of this routine and */ -/* FOUND is set to .FALSE. */ - -/* $ Files */ - -/* CKGPAV searches through files loaded by FURNSH to locate a */ -/* segment that can satisfy the request for pointing and angular */ -/* velocity for instrument INST at time SCLKDP. You must load a */ -/* C-kernel file using FURNSH prior to calling this routine. */ - -/* $ Particulars */ - -/* How the tolerance argument is used */ -/* ================================== */ - - -/* Reading a type 1 CK segment (discrete pointing instances) */ -/* --------------------------------------------------------- */ - -/* In the diagram below */ - -/* - "0" is used to represent discrete pointing instances */ -/* (quaternions, angular velocity vectors, and associated */ -/* time tags). */ - -/* - "( )" are used to represent the end points of the time */ -/* interval covered by a segment in a CK file. */ - -/* - SCLKDP is the time at which you requested pointing. */ -/* The location of SCLKDP relative to the time tags of the */ -/* pointing instances is indicated by the "+" sign. */ - -/* - TOL is the time tolerance specified in the pointing */ -/* request. The square brackets "[ ]" represent the */ -/* endpoints of the time interval */ - -/* SCLKDP-TOL : SCLKDP+TOL */ - -/* - The quaternions occurring in the segment need not be */ -/* evenly spaced in time. */ - - -/* Case 1: pointing is available */ -/* ------------------------------ */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) */ -/* ^ */ -/* | */ -/* CKGPAV returns this instance. */ - - -/* Case 2: pointing is not available */ -/* ---------------------------------- */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) */ - - -/* CKGPAV returns no pointing; the output */ -/* FOUND flag is set to .FALSE. */ - - - -/* Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) */ -/* ------------------------------------------------------------- */ - -/* In the diagrams below */ - -/* - "==" is used to represent periods of continuous pointing. */ - -/* - "--" is used to represent gaps in the pointing coverage. */ - -/* - "( )" are used to represent the end points of the time */ -/* interval covered by a segment in a CK file. */ - -/* - SCLKDP is the time at which you requested pointing. */ -/* The location of SCLKDP relative to the time tags of the */ -/* pointing instances is indicated by the "+" sign. */ - -/* - TOL is the time tolerance specified in the pointing */ -/* request. The square brackets "[ ]" represent the */ -/* endpoints of the time interval */ - -/* SCLKDP-TOL : SCLKDP+TOL */ - -/* - The quaternions occurring in the periods of continuous */ -/* pointing need not be evenly spaced in time. */ - - -/* Case 1: pointing is available at the request time */ -/* -------------------------------------------------- */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* . . . */ -/* Segment (==---===========---=======----------===--) */ -/* ^ */ -/* | */ - -/* The request time lies within an interval where */ -/* continuous pointing is available. CKGPAV returns */ -/* pointing at the requested epoch. */ - - -/* Case 2: pointing is available "near" the request time */ -/* ------------------------------------------------------ */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (==---===========----=======---------===--) */ -/* ^ */ -/* | */ - -/* The request time lies in a gap: an interval where */ -/* continuous pointing is *not* available. CKGPAV */ -/* returns pointing for the epoch closest to the */ -/* request time SCLKDP. */ - - -/* Case 3: pointing is not available */ -/* ---------------------------------- */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment (==---===========----=======---------===--) */ - -/* CKGPAV returns no pointing; the output */ -/* FOUND flag is set to .FALSE. */ - - - -/* Tolerance and segment priority */ -/* ============================== */ - -/* CKGPAV searches through loaded C-kernels to satisfy a pointing */ -/* request. Last-loaded files are searched first. Individual files */ -/* are searched in backwards order, so that between competing */ -/* segments (segments containing data for the same object, for */ -/* overlapping time ranges), the one closest to the end of the file */ -/* has highest priority. CKGPAV considers only those segments that */ -/* contain both pointing and angular velocity data, as indicated by */ -/* the segment descriptor. */ - -/* The search ends when a segment is found that can provide pointing */ -/* and angular velocity for the specified instrument at a time */ -/* falling within the specified tolerance on either side of the */ -/* request time. Within that segment, the instance closest to the */ -/* input time is located and returned. */ - -/* The following four cases illustrate this search procedure. */ -/* Segments A and B are in the same file, with segment A located */ -/* further towards the end of the file than segment B. Both segments */ -/* A and B contain discrete pointing data, indicated by the number */ -/* 0. */ - - -/* Case 1: Pointing is available in the first segment searched. */ -/* Because segment A has the highest priority and can */ -/* satisfy the request, segment B is not searched. */ - - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment A (0-----------------0--------0--0-----0) */ -/* ^ */ -/* | */ -/* | */ -/* CKGPAV returns this instance */ - -/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */ - - - -/* Case 2: Pointing is not available in the first segment searched. */ -/* Because segment A cannot satisfy the request, segment B */ -/* is searched. */ - - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* Segment A (0-----------------0--------0--0-----0) */ -/* . . . */ -/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */ -/* ^ */ -/* | */ -/* CKGPAV returns this instance */ - - -/* Segments that contain continuous pointing data are searched in */ -/* the same manner as segments containing discrete pointing data. */ -/* For request times that fall within the bounds of continuous */ -/* intervals, CKGPAV will return pointing at the request time. When */ -/* the request time does not fall within an interval, then a time at */ -/* an endpoint of an interval may be returned if it is the closest */ -/* time in the segment to the user request time and is also within */ -/* the tolerance. */ - -/* In the following examples, segment A is located further towards */ -/* the end of the file than segment C. Segment A contains discrete */ -/* pointing data and segment C contains continuous data, indicated */ -/* by the "=" character. */ - - -/* Case 3: Pointing is not available in the first segment searched. */ -/* Because segment A cannot satisfy the request, segment C */ -/* is searched. */ - -/* SCLKDP */ -/* \ TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* Segment A (0-----------------0--------0--0-----0) */ -/* . . . */ -/* . . . */ -/* Segment C (---=============-----====--------==--) */ -/* ^ */ -/* | */ -/* | */ -/* CKGPAV returns this instance */ - - -/* In the next case, assume that the order of segments A and C in the */ -/* file is reversed: A is now closer to the front, so data from */ -/* segment C are considered first. */ - - -/* Case 4: Pointing is available in the first segment searched. */ -/* Because segment C has the highest priority and can */ -/* satisfy the request, segment A is not searched. */ - -/* SCLKDP */ -/* / */ -/* | TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* Segment C (---=============-----====--------==--) */ -/* ^ */ -/* | */ -/* CKGPAV returns this instance */ - -/* Segment A (0-----------------0--------0--0-----0) */ -/* ^ */ -/* | */ -/* "Best" answer */ - - -/* The next case illustrates an unfortunate side effect of using */ -/* a non-zero tolerance when reading multi-segment CKs with */ -/* continuous data. In all cases when the look-up interval */ -/* formed using tolerance overlaps a segment boundary and */ -/* the request time falls within the coverage of the lower */ -/* priority segment, the data at the end of the higher priority */ -/* segment will be picked instead of the data from the lower */ -/* priority segment. */ - - -/* Case 5: Pointing is available in the first segment searched. */ -/* Because segment C has the highest priority and can */ -/* satisfy the request, segment A is not searched. */ - -/* SCLKDP */ -/* / */ -/* | TOL */ -/* | / */ -/* |/\ */ -/* Your request [--+--] */ -/* . . . */ -/* . . . */ -/* Segment C (===============) */ -/* ^ */ -/* | */ -/* CKGPAV returns this instance */ - -/* Segment A (=====================) */ -/* ^ */ -/* | */ -/* "Best" answer */ - -/* $ Examples */ - - -/* Suppose you have two C-kernel files containing data for the */ -/* Voyager 2 narrow angle camera. One file contains predict values, */ -/* and the other contains corrected pointing for a selected group */ -/* of images, that is, for a subset of images from the first file. */ - -/* The following example program uses CKGPAV to get C-matrices and */ -/* associated angular velocity vectors for a set of images whose */ -/* SCLK counts (un-encoded character string versions) are contained */ -/* in the array SCLKCH. */ - -/* If available, the program will get the corrected pointing values. */ -/* Otherwise, predict values will be used. */ - -/* For each C-matrix, a unit pointing vector is constructed */ -/* and printed along with the angular velocity vector. */ - -/* Note: if the C-kernels of interest do not contain angular */ -/* velocity data, then the SPICELIB routine CKGP should be used to */ -/* read the pointing data. An example program in the header of the */ -/* SPICELIB routine CKGP demonstrates this. */ - - - -/* C */ -/* C Constants for this program. */ -/* C */ -/* C -- The code for the Voyager 2 spacecraft clock is -32 */ -/* C */ -/* C -- The code for the narrow angle camera on the Voyager 2 */ -/* C spacecraft is -32001. */ -/* C */ -/* C -- Spacecraft clock times for successive Voyager images */ -/* C always differ by more than 0:0:400. This is an */ -/* C acceptable tolerance, and must be converted to "ticks" */ -/* C (units of encoded SCLK) for input to CKGPAV. */ -/* C */ -/* C -- The reference frame we want is FK4. */ -/* C */ -/* C -- The narrow angle camera boresight defines the third */ -/* C axis of the instrument-fixed coordinate system. */ -/* C Therefore, the vector ( 0, 0, 1 ) represents */ -/* C the boresight direction in the camera-fixed frame. */ -/* C */ -/* IMPLICIT NONE */ - -/* INTEGER FILEN */ -/* PARAMETER ( FILEN = 255 ) */ - -/* INTEGER NPICS */ -/* PARAMETER ( NPICS = 2 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 30 ) */ - -/* INTEGER REFLEN */ -/* PARAMETER ( REFLEN = 32 ) */ - -/* CHARACTER*(TIMLEN) CLKCH */ -/* CHARACTER*(FILEN) CKPRED */ -/* CHARACTER*(FILEN) CKCORR */ -/* CHARACTER*(REFLEN) REF */ -/* CHARACTER*(FILEN) SCLK */ -/* CHARACTER*(TIMLEN) SCLKCH ( NPICS ) */ -/* CHARACTER*(TIMLEN) TOLVGR */ - -/* DOUBLE PRECISION AV ( 3 ) */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOLTIK */ -/* DOUBLE PRECISION VCFIX ( 3 ) */ -/* DOUBLE PRECISION VINERT ( 3 ) */ - -/* INTEGER SC */ -/* INTEGER I */ -/* INTEGER INST */ - -/* LOGICAL FOUND */ - -/* CKPRED = 'voyager2_predict.bc' */ -/* CKCORR = 'voyager2_corrected.bc' */ -/* SCLK = 'voyager2_sclk.tsc' */ -/* SC = -32 */ -/* INST = -32001 */ -/* SCLKCH(1) = '4/08966:30:768' */ -/* SCLKCH(2) = '4/08970:58:768' */ -/* TOLVGR = '0:0:400' */ -/* REF = 'FK4' */ -/* VCFIX( 1 ) = 0.D0 */ -/* VCFIX( 2 ) = 0.D0 */ -/* VCFIX( 3 ) = 1.D0 */ - -/* C */ -/* C Loading the files in this order ensures that the */ -/* C corrected file will get searched first. */ -/* C */ -/* CALL FURNSH ( CKPRED ) */ -/* CALL FURNSH ( CKCORR ) */ - -/* C */ -/* C Need to load a Voyager 2 SCLK kernel to convert from */ -/* C clock strings to ticks. */ -/* C */ -/* CALL FURNSH ( SCLK ) */ - -/* C */ -/* C Convert tolerance from VGR formatted character string */ -/* C SCLK to ticks which are units of encoded SCLK. */ -/* C */ -/* CALL SCTIKS ( SC, TOLVGR, TOLTIK ) */ - - -/* DO I = 1, NPICS */ -/* C */ -/* C CKGPAV requires encoded spacecraft clock. */ -/* C */ -/* CALL SCENCD ( SC, SCLKCH( I ), SCLKDP ) */ - -/* CALL CKGPAV ( INST, SCLKDP, TOLTIK, REF, CMAT, AV, */ -/* . CLKOUT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* C */ -/* C Use the transpose of the C-matrix to transform the */ -/* C boresight vector from camera-fixed to reference */ -/* C coordinates. */ -/* C */ -/* CALL MTXV ( CMAT, VCFIX, VINERT ) */ -/* CALL SCDECD ( SC, CLKOUT, CLKCH ) */ - -/* WRITE (*,*) 'VGR 2 SCLK Time: ', CLKCH */ -/* WRITE (*,*) 'VGR 2 NA ISS boresight ' */ -/* . // 'pointing vector: ', VINERT */ -/* WRITE (*,*) 'Angular velocity vector: ', AV */ - -/* ELSE */ - -/* WRITE (*,*) 'Pointing not found for time ', SCLKCH(I) */ - -/* END IF */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* Only loaded C-kernel segments containing both pointing and */ -/* angular velocity data will be searched by this reader. Segments */ -/* containing only pointing data will be skipped over. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* J.M. Lynch (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.2.1, 03-JUN-2010 (BVS) */ - -/* Header update: description of the tolerance and Particulars */ -/* section were expanded to address some problems arising from */ -/* using a non-zero tolerance. */ - -/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MTXV, MXM and VADD calls. */ - -/* - SPICELIB Version 5.1.2, 29-JAN-2004 (NJB) */ - -/* Header update: descriptions of input arguments REF and */ -/* AV were expanded. */ - -/* - SPICELIB Version 5.1.1, 27-JUL-2003 (CHA) (NJB) */ - -/* Various header corrections were made. */ - -/* - SPICELIB Version 5.1.0, 23-FEB-1999 (WLT) */ - -/* The previous editions of this routine did not properly handle */ -/* the case when TOL was negative. The routine now returns a */ -/* value of .FALSE. for FOUND as is advertised above. */ - -/* - SPICELIB Version 5.0.0, 28-JUL-1997 (WLT) */ - -/* The previous routine incorrectly computed the angular */ -/* velocity of the transformation from the request frame */ -/* to the platform frame of the C-matrix for non-inertial */ -/* reference frames. */ - -/* - SPICELIB Version 4.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded so that the reference frame may */ -/* be non-inertial. */ - -/* - SPICELIB Version 3.0.0, 5-OCT-1994 (WLT) */ - -/* The previous versions all computed an incorrect */ -/* value for the angular velocity if the frame specified by */ -/* REF was different from the reference frame of the segment */ -/* from which the angular velocity was extracted. This has */ -/* now been corrected. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */ - -/* 1) The Particulars section was updated to show how the */ -/* search algorithm processes segments with continuous */ -/* pointing data. */ - -/* 2) It was specified that the angular velocity vector */ -/* gives the right-handed axis about which the instrument */ -/* frame rotates. */ - -/* 3) The example program now loads an SCLK kernel. */ - -/* 4) FAILED is checked after the call to IRFROT to handle the */ -/* case where the reference frame is invalid and the error */ -/* handling is not set to abort. */ - -/* 5) FAILED is checked in the DO WHILE loop to handle the case */ -/* where an error is detected by a SPICELIB routine inside the */ -/* loop and the error handling is not set to abort. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (JML) */ - -/* 1) The variable NEEDAV is no longer being saved. */ -/* 2) In the example program, the calling sequences */ -/* for SCENCD and CKGPAV were corrected. */ -/* 3) The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get ck pointing and angular velocity */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MTXV, MXM and VADD calls. */ - -/* - SPICELIB Version 4.1.0, 20-DEC-1995 (WLT) */ - -/* A call to FRINFO did not have enough arguments and */ -/* went undetected until Howard Taylor of ACT. Many */ -/* thanks go out to Howard for tracking down this error. */ - -/* - SPICELIB Version 4.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded so that the reference frame may */ -/* be non-inertial. */ - -/* - SPICELIB Version 3.0.0, 5-OCT-1994 (WLT) */ - -/* The previous versions all computed an incorrect */ -/* value for the angular velocity if the frame specified by */ -/* REF was different from the reference frame of the segment */ -/* from which the angular velocity was extracted. This has */ -/* now been corrected. */ - -/* Previously we were multiplying by the inverse of the */ -/* rotation that transforms frames. */ - -/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */ - -/* 1) The Particulars section was updated to show how the */ -/* search algorithm processes segments with continuous */ -/* pointing data. */ - -/* 2) It was specified that the angular velocity vector */ -/* gives the right-handed axis about which the instrument */ -/* frame rotates. */ - -/* 3) The example program now loads an SCLK kernel. */ - -/* 4) FAILED is checked after the call to IRFROT to handle the */ -/* case where the reference frame is invalid and the error */ -/* handling is not set to abort. */ - -/* 5) FAILED is checked in the DO WHILE loop to handle the case */ -/* where an error is detected by a SPICELIB routine inside the */ -/* loop and the error handling is not set to abort. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (JML) */ - -/* 1) The variable NEEDAV is no longer being saved. */ -/* 2) In the example program, the calling sequences */ -/* for SCENCD and CKGPAV were corrected. */ -/* 3) The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - -/* - Beta Version 1.1.0, 30-AUG-1990 (MJS) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable SCLK was changed to SCLKDP. */ -/* 2) The variable INSTR was changed to INST. */ -/* 3) The variable IDENT was changed to SEGID. */ -/* 4) The declarations for the parameters NDC, NIC, NC, and */ -/* IDLEN were moved from the "Declarations" section of the */ -/* header to the "Local parameters" section of the code below */ -/* the header. These parameters are not meant to modified by */ -/* users. */ -/* 5) The header was updated to reflect the changes. */ - -/* - Beta Version 1.0.0, 04-JUN-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* NC is the number of components in a packed C-kernel */ -/* descriptor. All DAF summaries have this formulaic */ -/* relationship between the number of its integer and */ -/* double precision components and the number of packed */ -/* components. */ - -/* IDLEN is the length of the C-kernel segment identifier. */ -/* All DAF names have this formulaic relationship */ -/* between the number of summary components and */ -/* the length of the name (You will notice that */ -/* a name and a summary have the same length in bytes.) */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGPAV", (ftnlen)6); - } - -/* Need angular velocity data. */ -/* Assume the segment won't be found until it really is. */ - - needav = TRUE_; - *found = FALSE_; - -/* If the tolerance is less than zero, we go no further. */ - - if (*tol < 0.) { - chkout_("CKGPAV", (ftnlen)6); - return 0; - } - -/* Begin a search for this instrument and time, and get the first */ -/* applicable segment. */ - - ckbss_(inst, sclkdp, tol, &needav); - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - -/* Keep trying candidate segments until a segment can produce a */ -/* pointing instance within the specified time tolerance of the */ -/* input time. */ - -/* Check FAILED to prevent an infinite loop if an error is detected */ -/* by a SPICELIB routine and the error handling is not set to abort. */ - - while(sfnd && ! failed_()) { - ckpfs_(&handle, descr, sclkdp, tol, &needav, cmat, av, clkout, &pfnd); - if (pfnd) { - -/* Found one. If the data aren't already referenced to the */ -/* requested frame, rotate them. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - refseg = icd[1]; - -/* Look up the id code for the requested reference frame. */ - - namfrm_(ref, &refreq, ref_len); - if (refreq != refseg) { - -/* We may need to convert the output ticks CLKOUT to ET */ -/* so that we can get the needed state transformation */ -/* matrix. This is the case if either of the frames */ -/* is non-inertial. */ - - frinfo_(&refreq, ¢er, &type1, &typeid, &gotit); - frinfo_(&refseg, ¢er, &type2, &typeid, &gotit); - if (type1 == 1 && type2 == 1) { - -/* Any old value of ET will do in this case. We'll */ -/* use zero. */ - - et = 0.; - } else { - -/* Look up the spacecraft clock id to use to convert */ -/* the output CLKOUT to ET. */ - - ckmeta_(inst, "SCLK", &sclk, (ftnlen)4); - sct2e_(&sclk, clkout, &et); - } - -/* Get the transformation from the requested frame to */ -/* the segment frame at ET. */ - - frmchg_(&refreq, &refseg, &et, xform); - -/* If FRMCHG detects that the reference frame is invalid */ -/* then return from this routine with FOUND equal to false. */ - - if (failed_()) { - chkout_("CKGPAV", (ftnlen)6); - return 0; - } - -/* First transform the attitude information. Get the */ -/* rotation and angular velocity associated with the */ -/* transformation from request frame to segment frame. */ -/* Then convert CMAT so that it maps from request frame */ -/* to C-matrix frame. */ - - xf2rav_(xform, rot, omega); - mxm_(cmat, rot, tmpmat); - moved_(tmpmat, &c__9, cmat); - -/* Now transform the angular velocity information. */ -/* Currently we have OMEGA (the angular velocity of */ -/* the transformation from REF frame to the base */ -/* frame of the C-matrix), and AV the angular velocity */ -/* of the transformation from the C-MATRIX reference */ -/* system to the platform of the C-matrix. */ - -/* The angular velocity of the C-MATRIX relative to */ -/* requested frame is given by */ - -/* T */ -/* OMEGA + ROT * AV */ - -/* Here's why. */ - -/* The transformation from the request frame to the frame */ -/* of the C-kernel looks like this: */ - -/* [ ] */ -/* [ ROT : 0 ] */ -/* [................ ] */ -/* [ dROT : ] */ -/* [ ---- : ROT ] */ -/* [ dt : ] */ - -/* The transformation from the C-kernel reference frame to */ -/* the C-kernel platform frame looks like: */ - - -/* [ ] */ -/* [ CMAT : 0 ] */ -/* [ ............... ] */ -/* [ dCMAT : ] */ -/* [ ---- : CMAT ] */ -/* [ dt : ] */ - - -/* The transformation from the request frame to the platform */ -/* frame is the product shown below */ - - -/* [ ][ ] */ -/* [ CMAT : 0 ][ ROT : 0 ] */ -/* [ ............... ][................ ] */ -/* [ dCMAT : ][ dROT : ] */ -/* [ ---- : CMAT ][ ---- : ROT ] */ -/* [ dt : ][ dt : ] */ - - -/* [ : ] */ -/* [ CMAT * ROT : 0 ] */ -/* = [ ........................................ ] */ -/* [ dCMAT dROT : ] */ -/* [ ---- * ROT + CMAT * ---- : CMAT * ROT ] */ -/* [ dt dt : ] */ - - -/* In general, the angular velocity matrix of a */ -/* transformation R is given by */ - -/* T */ -/* dR */ -/* -- * R */ -/* dt */ - -/* Substituting the appropriate components of the matrix */ -/* in for R we have: */ - -/* T T */ -/* OMEGA = ROT * dCMAT * CMAT * ROT */ -/* CMAT*ROT ----- */ -/* dt */ - -/* T */ -/* dROT T */ -/* + ---- * CMAT * CMAT * ROT */ -/* dt */ - - -/* T */ -/* = ROT * OMEGA * ROT + OMEGA */ -/* CMAT ROT */ - - -/* Consider the first term of the final expression. If we */ -/* let "x" stand for the cross product operation, then by */ -/* definition for any vector V: */ - - -/* T */ -/* ROT * OMEGA * ROT * V */ -/* CMAT */ - - -/* T */ -/* = ROT * (AV x ROT*V ) */ -/* CMAT */ - -/* (since rotations distribute across cross */ -/* products) */ - -/* T T */ -/* = (ROT * AV ) x ( ROT * ROT*V ) */ -/* CMAT */ - - -/* T */ -/* = (ROT * AV ) x V */ -/* CMAT */ - -/* Thus OMEGA is the matrix form of the cross */ -/* CMAT*ROT */ - -/* T */ -/* product operation {( ROT *AV ) + AV } x . */ -/* CMAT ROT */ - - - mtxv_(rot, av, tmpv); - vadd_(omega, tmpv, av); - } - *found = TRUE_; - chkout_("CKGPAV", (ftnlen)6); - return 0; - } - cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); - } - chkout_("CKGPAV", (ftnlen)6); - return 0; -} /* ckgpav_ */ - diff --git a/ext/spice/src/cspice/ckgpav_c.c b/ext/spice/src/cspice/ckgpav_c.c deleted file mode 100644 index e910b10d30..0000000000 --- a/ext/spice/src/cspice/ckgpav_c.c +++ /dev/null @@ -1,759 +0,0 @@ -/* - --Procedure ckgpav_c ( C-kernel, get pointing and angular velocity ) - --Abstract - - Get pointing (attitude) and angular velocity for a specified - spacecraft clock time. - --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 - - CK - SCLK - --Keywords - - POINTING - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ckgpav_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble av[3], - SpiceDouble * clkout, - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - inst I NAIF ID of instrument, spacecraft, or structure. - sclkdp I Encoded spacecraft clock time. - tol I Time tolerance. - ref I Reference frame. - cmat O C-matrix pointing data. - av O Angular velocity vector. - clkout O Output encoded spacecraft clock time. - found O True when requested pointing is available. - --Detailed_Input - - inst is the NAIF integer ID for the instrument, spacecraft, or - other structure for which pointing and angular velocity - are requested. For brevity we will refer to this object - as the "instrument," and the frame fixed to this object - as the "instrument frame" or "instrument-fixed" frame. - - sclkdp is the encoded spacecraft clock time for which - pointing and angular velocity are requested. - - The CSPICE routines scencd_c and sce2c_c respectively - convert spacecraft clock strings and ephemeris time - to encoded spacecraft clock. The inverse conversions - are performed by scdecd_c and sct2e_c. - - tol is a time tolerance in ticks, the units of encoded - spacecraft clock time. - - The CSPICE routine sctiks_c converts a spacecraft clock - tolerance duration from its character string - representation to ticks. scfmt_c performs the inverse - conversion. - - The C-matrix - angular velocity vector pair returned by - ckgpav_c is the one whose time tag is closest to `sclkdp' - and within `tol' units of `sclkdp'. (More in - Particulars, below.) - - In general, because using a non-zero tolerance - affects selection of the segment from which the - data is obtained, users are strongly discouraged - from using a non-zero tolerance when reading CKs - with continuous data. Using a non-zero tolerance - should be reserved exclusively to reading CKs with - discrete data because in practice obtaining data - from such CKs using a zero tolerance is often not - possible due to time round off. - - ref is the desired reference frame for the returned pointing - and angular velocity. The returned C-matrix `cmat' gives - the orientation of the instrument designated by `inst' - relative to the frame designated by `ref'. When a vector - specified relative to frame `ref' is left-multiplied by - `cmat', the vector is rotated to the frame associated - with `inst'. The returned angular velocity vector `av' - expresses the angular velocity of the instrument - designated by `inst' relative to the frame designated by - `ref'. See the discussion of `cmat' and `av' below - for details. - - Consult the SPICE document "Frames" for a discussion - of supported reference frames. - --Detailed_Output - - cmat is a rotation matrix that transforms the components of a - vector expressed in the frame specified by `ref' to - components expressed in the frame tied to the instrument, - spacecraft, or other structure at time `clkout' (see - below). - - Thus, if a vector v has components x,y,z in the `ref' - reference frame, then v has components x',y',z' in the - instrument fixed frame at time `clkout': - - [ x' ] [ ] [ x ] - | y' | = | cmat | | y | - [ z' ] [ ] [ z ] - - If you know x', y', z', use the transpose of the - C-matrix to determine x, y, z as follows: - - [ x ] [ ]T [ x' ] - | y | = | cmat | | y' | - [ z ] [ ] [ z' ] - (Transpose of cmat) - - - av is the angular velocity vector. This is the axis about - which the reference frame tied to the instrument is - rotating in the right-handed sense at time `clkout'. The - magnitude of `av' is the magnitude of the instantaneous - velocity of the rotation, in radians per second. - The components of `av' are given relative to the - reference frame specified by the input argument `ref'. - - clkout is the encoded spacecraft clock time associated with - the returned C-matrix and the returned angular - velocity vector. This value may differ from the - requested time, but never by more than the input - tolerance `tol'. - - The particulars section below describes the search - algorithm used by ckgpav_c to satisfy a pointing request. - This algorithm determines the pointing instance - (and therefore the associated time value) that is - returned. - - found is SPICETRUE if a record was found to satisfy the - pointing request. `found' will be SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) If a C-kernel file has not been loaded using furnsh_c prior to a - call to this routine, an error is signaled by a routine in the - call tree of this routine. - - 2) If `tol' is negative, found is set to SPICEFALSE. - - 3) If `ref' is not a supported reference frame, an error is - signaled by a routine in the call tree of this routine and - `found' is set to SPICEFALSE. - --Files - - ckgpav_c searches through files loaded by furnsh_c to locate a - segment that satisfies the request for pointing and angular velocity - for the instrument `inst' at time `sclkdp'. You must load at least - one C-kernel file via furnsh_c prior to calling this routine. - --Particulars - - - How the tolerance argument is used - ================================== - - - Reading a type 1 CK segment (discrete pointing instances) - --------------------------------------------------------- - - In the diagram below - - - "0" is used to represent discrete pointing instances - (quaternions, angular velocity vectors, and associated - time tags). - - - "( )" are used to represent the end points of the time - interval covered by a segment in a CK file. - - - `sclkdp' is the time at which you requested pointing. - The location of `sclkdp' relative to the time tags of the - pointing instances is indicated by the "+" sign. - - - `tol' is the time tolerance specified in the pointing - request. The square brackets "[ ]" represent the - endpoints of the time interval - - sclkdp-tol : sclkdp+tol - - - The quaternions occurring in the segment need not be - evenly spaced in time. - - - Case 1: pointing is available - ------------------------------ - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) - ^ - | - ckgpav_c returns this instance. - - - Case 2: pointing is not available - ---------------------------------- - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) - - - ckgpav_c returns no pointing; the output - `found' flag is set to SPICEFALSE. - - - - Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) - ------------------------------------------------------------- - - In the diagrams below - - - "==" is used to represent periods of continuous pointing. - - - "--" is used to represent gaps in the pointing coverage. - - - "( )" are used to represent the end points of the time - interval covered by a segment in a CK file. - - - `sclkdp' is the time at which you requested pointing. - The location of `sclkdp' relative to the time tags of the - pointing instances is indicated by the "+" sign. - - - `tol' is the time tolerance specified in the pointing - request. The square brackets "[ ]" represent the - endpoints of the time interval - - sclkdp-tol : sclkdp+tol - - - The quaternions occurring in the periods of continuous - pointing need not be evenly spaced in time. - - - Case 1: pointing is available at the request time - -------------------------------------------------- - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - . . . - . . . - Segment (==---===========---=======----------===--) - ^ - | - - The request time lies within an interval where - continuous pointing is available. ckgpav_c returns - pointing at the requested epoch. - - - Case 2: pointing is available "near" the request time - ------------------------------------------------------ - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (==---===========----=======---------===--) - ^ - | - - The request time lies in a gap: an interval where - continuous pointing is *not* available. ckgpav_c - returns pointing for the epoch closest to the - request time `sclkdp'. - - - Case 3: pointing is not available - ---------------------------------- - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment (==---===========----=======---------===--) - - ckgpav_c returns no pointing; the output - `found' flag is set to SPICEFALSE. - - - - Tolerance and segment priority - ============================== - - ckgpav_c searches through loaded C-kernels to satisfy a pointing - request. Last-loaded files are searched first. Individual files are - searched in backwards order, so that between competing segments - (segments containing data for the same object, for overlapping time - ranges), the one closest to the end of the file has highest - priority. ckgpav_c considers only those segments that contain both - pointing and angular velocity data, as indicated by the segment - descriptor. - - The search ends when a segment is found that can provide pointing - and angular velocity for the specified instrument at a time - falling within the specified tolerance on either side of the - request time. Within that segment, the instance closest to the - input time is located and returned. - - The following four cases illustrate this search procedure. Segments - A and B are in the same file, with segment A located further - towards the end of the file than segment B. Both segments A and B - contain discrete pointing data, indicated by the number 0. - - - Case 1: Pointing is available in the first segment searched. - Because segment A has the highest priority and can - satisfy the request, segment B is not searched. - - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment A (0-----------------0--------0--0-----0) - ^ - | - | - ckgpav_c returns this instance - - Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) - - - - Case 2: Pointing is not available in the first segment searched. - Because segment A cannot satisfy the request, segment B - is searched. - - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - Segment A (0-----------------0--------0--0-----0) - . . . - Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) - ^ - | - ckgpav_c returns this instance - - - Segments that contain continuous pointing data are searched in the - same manner as segments containing discrete pointing data. For - request times that fall within the bounds of continuous intervals, - ckgpav_c will return pointing at the request time. When the request - time does not fall within an interval, then a time at an endpoint of - an interval may be returned if it is the closest time in the segment - to the user request time and is also within the tolerance. - - In the following examples, segment A is located further towards the - end of the file than segment C. Segment A contains discrete pointing - data and segment C contains continuous data, indicated by the "=" - character. - - - Case 3: Pointing is not available in the first segment searched. - Because segment A cannot satisfy the request, segment C - is searched. - - sclkdp - \ tol - | / - |/\ - Your request [--+--] - . . . - . . . - Segment A (0-----------------0--------0--0-----0) - . . . - . . . - Segment C (---=============-----====--------==--) - ^ - | - | - ckgpav_c returns this instance - - - In the next case, assume that the order of segments A and C in the - file is reversed: A is now closer to the front, so data from - segment C are considered first. - - - Case 4: Pointing is available in the first segment searched. - Because segment C has the highest priority and can - satisfy the request, segment A is not searched. - - sclkdp - / - | tol - | / - |/\ - Your request [--+--] - . . . - . . . - Segment C (---=============-----====--------==--) - ^ - | - ckgpav_c returns this instance - - Segment A (0-----------------0--------0--0-----0) - ^ - | - "Best" answer - - - The next case illustrates an unfortunate side effect of using - a non-zero tolerance when reading multi-segment CKs with - continuous data. In all cases when the look-up interval - formed using tolerance overlaps a segment boundary and - the request time falls within the coverage of the lower - priority segment, the data at the end of the higher priority - segment will be picked instead of the data from the lower - priority segment. - - - Case 5: Pointing is available in the first segment searched. - Because segment C has the highest priority and can - satisfy the request, segment A is not searched. - - sclkdp - / - | tol - | / - |/\ - Your request [--+--] - . . . - . . . - Segment C (===============) - ^ - | - ckgpav_c returns this instance - - Segment A (=====================) - ^ - | - "Best" answer - - --Examples - - - Suppose you have two C-kernel files containing pointing for the - Voyager 2 narrow angle camera. One file contains predict (planned) - values, and the other contains corrected pointing for a selected - group of images, that is, for a subset of images from the first - file. - - The following example program uses ckgpav_c to get C-matrices and - associated angular velocity vectors for a set of images whose - SCLK counts (un-encoded character string versions) are contained - in the array `sclkch'. - - If available, the program will get the corrected pointing values. - Otherwise, predict values will be used. - - For each C-matrix, a unit pointing vector is constructed and printed - along with the angular velocity vector. - - Note: if the C-kernels of interest do not contain angular velocity - data, then the CSPICE routine ckgp_c should be used to read the - pointing data. An example program in the header of the CSPICE - routine ckgp_c demonstrates this. - - - #include - #include "SpiceUsr.h" - - int main () - { - /. - Constants for this program: - - -- The code for the Voyager 2 spacecraft clock is -32 - - -- The code for the narrow angle camera on the Voyager 2 - spacecraft is -32001. - - -- Spacecraft clock times for successive Voyager images always - differ by more than 0:0:400. This is an acceptable - tolerance, and must be converted to "ticks" (units of - encoded SCLK) for input to ckgpav_c. - - -- The reference frame we want is FK4. - - -- The narrow angle camera boresight defines the third - axis of the instrument-fixed reference frame. - Therefore, the vector ( 0, 0, 1 ) represents - the boresight direction in the camera-fixed frame. - ./ - - #define SC -32 - #define INST -32001 - #define REF "FK4" - #define TOLVGR "0:0:400" - #define NPICS 2 - #define MAXCLK 30 - #define CKPRED "voyager2_predict.bc" - #define CKCORR "voyager2_corrected.bc" - #define SCLK "voyager2_sclk.tsc" - - - SpiceBoolean found; - - SpiceChar sclkch [NPICS][MAXCLK] = - - { { "4/08966:30:768" }, - { "4/08970:58:768" } }; - - SpiceChar clkch [MAXCLK]; - - SpiceDouble av [3]; - SpiceDouble cmat [3][3]; - SpiceDouble clkout; - SpiceDouble sclkdp; - SpiceDouble toltik; - SpiceDouble vinert [3]; - - SpiceInt i; - - - /. - Loading the files in this order ensures that the - corrected file will get searched first. - ./ - furnsh_c ( CKPRED ); - furnsh_c ( CKCORR ); - - /. - Need to load a Voyager 2 SCLK kernel to convert from - clock string to ticks. Although not required for - the Voyager spacecraft clocks, most modern spacecraft - clocks require a leapseconds kernel to be loaded in - addition to an SCLK kernel. - ./ - furnsh_c ( SCLK ); - - /. - Convert tolerance from VGR formatted character string - SCLK to ticks, which are units of encoded SCLK. - ./ - sctiks_c ( SC, TOLVGR, &toltik ); - - for ( i = 0; i < NPICS; i++ ) - { - - /. - ckgpav_c requires encoded spacecraft clock time. - ./ - scencd_c ( SC, sclkch[ i ], &sclkdp ); - - ckgpav_c ( INST, sclkdp, toltik, REF, - cmat, av, &clkout, &found ); - - if ( found ) - { - /. - The boresight vector, relative to inertial coordinates, - is just the third row of the C-matrix. - ./ - vequ_c ( cmat[2], vinert ); - - scdecd_c ( SC, clkout, MAXCLK, clkch ); - - - printf ( "VGR 2 SCLK time: %s\n", clkch ); - - printf ( "VGR 2 NA ISS boresight pointing vector: " - "%f %f %f\n", - vinert[0], - vinert[1], - vinert[2] ); - - printf ( "Angular velocity vector: %f %f %f\n", - av[0], - av[1], - av[2] ); - } - else - { - printf ( "Pointing not found for time %s\n", sclkch[i] ); - } - - } - - return ( 0 ); - } - - --Restrictions - - Only loaded C-kernel segments containing both pointing and angular - velocity data will be searched by this reader. Segments containing - only pointing data will be skipped over. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - J.M. Lynch (JPL) - B.V. Semenov (JPL) - M.J. Spencer (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.2.3, 03-JUN-2010 (BVS) - - Header update: description of the tolerance and Particulars - section were expanded to address some problems arising from - using a non-zero tolerance. - - -CSPICE Version 1.2.2, 29-JAN-2004 (NJB) - - Header update: the description of the input argument `ref' - was expanded. - - -CSPICE Version 1.2.1, 27-JUL-2003 (CHA) (NJB) - - Various header corrections were made. - - -CSPICE Version 1.2.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for found flag used in - interface of ckgpav_. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 5.0.0, 28-JUL-1997 (WLT) - --Index_Entries - - get ck pointing and angular velocity - --& -*/ - -{ /* Begin ckgpav_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error handling - */ - chkin_c ( "ckgpav_c"); - - - /* - Check the input string ref to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckgpav_c", ref ); - - - ckgpav_( ( integer * ) &inst, - ( doublereal * ) &sclkdp, - ( doublereal * ) &tol, - ( char * ) ref, - ( doublereal * ) cmat, - ( doublereal * ) av, - ( doublereal * ) clkout, - ( logical * ) &fnd, - ( ftnlen ) strlen(ref) ); - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - /* - Transpose the c-matrix on output. - */ - xpose_c ( cmat, cmat ); - - - chkout_c ( "ckgpav_c"); - -} /* End ckgpav_c */ diff --git a/ext/spice/src/cspice/ckgr01.c b/ext/spice/src/cspice/ckgr01.c deleted file mode 100644 index 955b7bb7f4..0000000000 --- a/ext/spice/src/cspice/ckgr01.c +++ /dev/null @@ -1,403 +0,0 @@ -/* ckgr01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKGR01 ( C-kernel, get record, type 01 ) */ -/* Subroutine */ int ckgr01_(integer *handle, doublereal *descr, integer * - recno, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer addr__, nrec, psiz; - doublereal n; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6]; - -/* $ Abstract */ - -/* Given the handle and descriptor of a data type 1 segment in a */ -/* CK file, return a specified pointing record from that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The segment descriptor. */ -/* RECNO I The number of the pointing record to be returned. */ -/* RECORD O The pointing record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* desired segment. The file should have been opened */ -/* for read access, either by CKLPF or DAFOPR. */ - -/* DESCR is the packed descriptor of the data type 1 segment. */ - -/* RECNO is the number of the individual pointing record to be */ -/* returned from the data type 1 segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the pointing record indexed by RECNO in the segment. */ -/* The contents are as follows: */ - -/* RECORD( 1 ) = CLKOUT */ - -/* RECORD( 2 ) = q0 */ -/* RECORD( 3 ) = q1 */ -/* RECORD( 4 ) = q2 */ -/* RECORD( 5 ) = q3 */ - -/* RECORD( 6 ) = Av1 ] */ -/* RECORD( 7 ) = Av2 |-- Returned optionally */ -/* RECORD( 8 ) = Av3 ] */ - -/* CLKOUT is the encoded spacecraft clock time associated */ -/* with the returned pointing values. */ - -/* The quantities q0 - q3 represent a quaternion. */ -/* The quantities Av1, Av2, and Av3 represent the */ -/* angular velocity vector, and are returned only if the */ -/* segment contains angular velocity data. The */ -/* components of the angular velocity vector are */ -/* specified relative to the inertial reference */ -/* frame of the segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment is not of data type 1, the error */ -/* SPICE(CKWRONGDATATYPE) is signalled. */ - -/* 2) If RECNO is less than one or greater than the number of */ -/* records in the specified segment, the error */ -/* SPICE(CKNONEXISTREC) is signalled. */ - -/* 3) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 4) If DESCR is not a valid, packed descriptor of a segment in */ -/* the CK file specified by HANDLE, the results of this routine */ -/* are unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read access. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 1 segment, */ -/* see the CK required reading. */ - -/* This is a utility routine that performs as follows. It finds out */ -/* how many records are in the segment, checks to see if the request */ -/* fits the bounds of the segment, and then moves directly to get */ -/* the requested data. */ - -/* $ Examples */ - -/* The following code fragment prints the records of the first */ -/* segment in a CK file. Suppose MOC.CK is valid CK file that */ -/* contains segments of data type 1. */ - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 8 ) */ -/* LOGICAL FOUND */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'MOC.CK', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 1 ) THEN */ - -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR01 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ - -/* C */ -/* C Get the record associated with record number I. */ -/* C */ -/* CALL CKGR01 ( HANDLE, DESCR, I, RECORD ) */ -/* WRITE (*,*) 'Record ', I, ':' */ -/* WRITE (*,*) RECORD */ -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* The binay CK file containing the segment whose descriptor was */ -/* passed to this routine must be opened for read access by either */ -/* CKLPF or DAFOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 06-MAR-1991 (JML) */ - -/* A correction was made to the example program in the */ -/* header. The array of double precision components of */ -/* the descriptor ( DCD ) had originally been declared */ -/* as an integer. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get ck type_1 record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2000 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ - -/* - SPICELIB Version 1.0.2, 06-MAR-1991 (JML) */ - -/* A correction was made to the example program in the */ -/* header. The array of double precision components of */ -/* the descriptor ( DCD ) had originally been declared */ -/* as an integer. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* 1) The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ -/* 2) ROTATIONS was removed from the required reading section. */ -/* 3) Minor changes were made to the wording of the header. */ - - -/* - Beta Version 1.1.0, 28-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The name of this routine was changed from CK01GR to */ -/* CKGR01 in order to be consistent with the SPICELIB */ -/* naming convention. */ -/* 2) The declarations for the parameters QSIZ, QAVSIZ, NDC, and */ -/* NIC were moved from the "Declarations" section of the */ -/* header to the "Local parameters" section of the code below */ -/* the header. These parameters are not meant to modified by */ -/* users. */ -/* 3) The header was corrected, improved, and updated to reflect */ -/* the changes. */ -/* 4) The in-code comments were improved. */ - -/* - Beta Version 1.0.0, 23-MAY-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* QSIZ is the number of double precision numbers making up */ -/* the quaternion portion of a pointing record. */ - -/* QAVSIZ is the number of double precision numbers making up */ -/* the quaternion and angular velocity portion of a */ -/* pointing record. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGR01", (ftnlen)6); - } - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - -/* From the descriptor, determine */ - -/* 1 - Is this really a type 1 segment? */ -/* 2 - The beginning address of the segment. */ -/* 3 - The number of records in the segment (it's the last number */ -/* in the segment). */ -/* 4 - The existence of angular velocity data, which determines how */ -/* big the pointing portion of the returned record will be. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - if (icd[2] != 1) { - setmsg_("Data type of the segment should be 1: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKGR01", (ftnlen)6); - return 0; - } - beg = icd[4]; - dafgda_(handle, &icd[5], &icd[5], &n); - nrec = (integer) n; - if (icd[3] == 1) { - psiz = 7; - } else { - psiz = 4; - } - -/* If a request was made for a record which doesn't exist, then */ -/* signal an error and leave. */ - - if (*recno < 1 || *recno > nrec) { - setmsg_("Requested record number (#) does not exist. There are # rec" - "ords in the segment.", (ftnlen)79); - errint_("#", recno, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20); - chkout_("CKGR01", (ftnlen)6); - return 0; - } - -/* Get the pointing record indexed by RECNO. */ - - addr__ = beg + psiz * (*recno - 1); - i__1 = addr__ + (psiz - 1); - dafgda_(handle, &addr__, &i__1, &record[1]); - -/* Next get the SCLK time. Need to go past all of the NREC pointing */ -/* records (PSIZ * NREC numbers), and then to the RECNOth SCLK */ -/* time. */ - - addr__ = beg + psiz * nrec + *recno - 1; - dafgda_(handle, &addr__, &addr__, record); - chkout_("CKGR01", (ftnlen)6); - return 0; -} /* ckgr01_ */ - diff --git a/ext/spice/src/cspice/ckgr02.c b/ext/spice/src/cspice/ckgr02.c deleted file mode 100644 index 13c1a4f01d..0000000000 --- a/ext/spice/src/cspice/ckgr02.c +++ /dev/null @@ -1,359 +0,0 @@ -/* ckgr02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__7 = 7; - -/* $Procedure CKGR02 ( C-kernel, get record, type 02 ) */ -/* Subroutine */ int ckgr02_(integer *handle, doublereal *descr, integer * - recno, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer addr__, nrec; - doublereal prec[8]; - extern /* Subroutine */ int chkin_(char *, ftnlen), cknr02_(integer *, - doublereal *, integer *), dafus_(doublereal *, integer *, integer - *, doublereal *, integer *), moved_(doublereal *, integer *, - doublereal *), dafgda_(integer *, integer *, integer *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6]; - -/* $ Abstract */ - -/* Given the handle and descriptor of a type 2 segment in a CK file, */ -/* return a specified pointing record from that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The segment descriptor. */ -/* RECNO I The number of the pointing record to be returned. */ -/* RECORD O The pointing record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* desired segment. The file should have been opened */ -/* for read or write access, either by CKLPF, DAFOPR, */ -/* or DAFOPW. */ - -/* DESCR is the packed descriptor of the data type 2 segment. */ - -/* RECNO is the number of the individual pointing record to be */ -/* returned from the data type 2 segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the pointing record indexed by RECNO in the segment. */ -/* The contents are as follows: */ - -/* RECORD( 1 ) = start SCLK time of interval */ -/* RECORD( 2 ) = end SCLK time of interval */ -/* RECORD( 3 ) = seconds per tick rate */ - -/* RECORD( 4 ) = q0 */ -/* RECORD( 5 ) = q1 */ -/* RECORD( 6 ) = q2 */ -/* RECORD( 7 ) = q3 */ - -/* RECORD( 8 ) = av1 */ -/* RECORD( 9 ) = av2 */ -/* RECORD( 10 ) = av3 */ - - -/* See the section on data type 2 in the CK Required */ -/* Reading for a complete description on how pointing */ -/* is obtained from a type 2 record. */ - -/* Note that the RECORD returned by this routine is */ -/* slightly different from that returned by CKR02. */ -/* The second element of the record returned by CKR02 */ -/* contains the SCLK time at which pointing was */ -/* requested, whereas this routine returns the SCLK */ -/* time of the right endpoint of the interval for which */ -/* the constant angular velocity model is valid. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment is not of data type 2, the error */ -/* SPICE(CKWRONGDATATYPE) is signalled. */ - -/* 2) If RECNO is less than one or greater than the number of */ -/* records in the specified segment, the error */ -/* SPICE(CKNONEXISTREC) is signalled. */ - -/* 3) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 4) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or write */ -/* access. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 2 segment, */ -/* see the CK Required Reading. */ - -/* This is a utility routine that may be used to read the individual */ -/* pointing records that make up a data type 2 segment. It is */ -/* normally used in combination with CKNR02, which gives the number */ -/* of pointing instances stored in a segment. */ - -/* $ Examples */ - -/* Suppose GLL_PLT.BC is a CK file that contains segments of data */ -/* type 2. Then the following code fragment uses CKNR02 and CKGR02 */ -/* to extract each pointing record in the first segment in the file. */ - - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 10 ) */ - -/* LOGICAL FOUND */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'GLL_PLT.BC', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 2 ) THEN */ - -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR02 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ - -/* C */ -/* C Get the Ith record in the segment. */ -/* C */ -/* CALL CKGR02 ( HANDLE, DESCR, I, RECORD ) */ -/* C */ -/* C Process the pointing data. */ -/* C */ -/* . */ -/* . */ -/* . */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The binary CK file containing the segment whose descriptor was */ -/* passed to this routine must be opened for read or write access */ -/* by either CKLPF, DAFOPR, or DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* get ck type_2 record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* PSIZ is the number of double precision numbers making up */ -/* the quaternion, angular velocity, and seconds per */ -/* tick rate portion of a pointing record. */ - -/* DTYPE is the data type. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGR02", (ftnlen)6); - } - - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - if (icd[2] != 2) { - setmsg_("Data type of the segment should be 2: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKGR02", (ftnlen)6); - return 0; - } - -/* Find out how many pointing instances there are in the segment. */ - - cknr02_(handle, descr, &nrec); - -/* If a request was made for a record which doesn't exist, then */ -/* signal an error and leave. */ - - if (*recno < 1 || *recno > nrec) { - setmsg_("Requested record number (#) does not exist. There are # rec" - "ords in the segment.", (ftnlen)79); - errint_("#", recno, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20); - chkout_("CKGR02", (ftnlen)6); - return 0; - } - -/* The address of the first double precision number in the array */ -/* is stored in the fifth integer component of the descriptor. */ - - beg = icd[4]; - -/* Get the pointing record indexed by RECNO. */ - - addr__ = beg + (*recno - 1 << 3); - i__1 = addr__ + 7; - dafgda_(handle, &addr__, &i__1, prec); - record[2] = prec[7]; - moved_(prec, &c__7, &record[3]); - -/* Next get the interval start time. Need to go past all of the */ -/* NREC pointing records (PSIZ * NREC numbers), and then to the */ -/* RECNOth SCLK start time. */ - - addr__ = beg + (nrec << 3) + *recno - 1; - dafgda_(handle, &addr__, &addr__, record); - -/* Next get the interval stop time. Need to go past all of the */ -/* NREC pointing records and start times ( (PSIZ+1)*NREC numbers ), */ -/* and then to the RECNOth SCLK stop time. */ - - addr__ = beg + nrec * 9 + *recno - 1; - dafgda_(handle, &addr__, &addr__, &record[1]); - chkout_("CKGR02", (ftnlen)6); - return 0; -} /* ckgr02_ */ - diff --git a/ext/spice/src/cspice/ckgr03.c b/ext/spice/src/cspice/ckgr03.c deleted file mode 100644 index 3dec38db8c..0000000000 --- a/ext/spice/src/cspice/ckgr03.c +++ /dev/null @@ -1,396 +0,0 @@ -/* ckgr03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKGR03 ( C-kernel, get record, type 03 ) */ -/* Subroutine */ int ckgr03_(integer *handle, doublereal *descr, integer * - recno, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer addr__, nrec, psiz; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - doublereal npoint; - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6], end; - -/* $ Abstract */ - -/* Given the handle and descriptor of a type 3 segment in a CK file, */ -/* return a specified pointing instance from that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The segment descriptor. */ -/* RECNO I The number of the pointing instance to be returned. */ -/* RECORD O The pointing record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* desired segment. The file should have been opened */ -/* for read or write access, either by CKLPF, DAFOPR, */ -/* or DAFOPW. */ - -/* DESCR is the packed descriptor of the data type 3 segment. */ - -/* RECNO is the number of the discrete pointing instance to be */ -/* returned from the data type 3 segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the pointing instance indexed by RECNO in the */ -/* segment. The contents are as follows: */ - -/* RECORD( 1 ) = CLKOUT */ - -/* RECORD( 2 ) = q0 */ -/* RECORD( 3 ) = q1 */ -/* RECORD( 4 ) = q2 */ -/* RECORD( 5 ) = q3 */ - -/* RECORD( 6 ) = av1 ] */ -/* RECORD( 7 ) = av2 |-- Returned optionally */ -/* RECORD( 8 ) = av3 ] */ - -/* CLKOUT is the encoded spacecraft clock time associated */ -/* with the returned pointing values. */ - -/* The quantities q0 - q3 are the components of the */ -/* quaternion that represents the C-matrix that transforms */ -/* vectors from the inertial reference frame of the */ -/* segment to the instrument frame at time CLKOUT. */ - -/* The quantities av1, av2, and av3 represent the */ -/* angular velocity vector, and are returned only if */ -/* the segment contains angular velocity data. The */ -/* components of the angular velocity vector are */ -/* specified relative to the inertial reference */ -/* frame of the segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment is not of data type 3, the error */ -/* SPICE(CKWRONGDATATYPE) is signalled. */ - -/* 2) If RECNO is less than one or greater than the number of */ -/* records in the specified segment, the error */ -/* SPICE(CKNONEXISTREC) is signalled. */ - -/* 3) If the specified handle does not belong to any DAF file that */ -/* is currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 4) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or */ -/* write access. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 3 segment, */ -/* see the CK required reading. */ - -/* This is a utility routine that may be used to read the individual */ -/* pointing instances that make up a type 3 segment. It is normally */ -/* used in conjunction with CKNR03, which gives the number of */ -/* pointing instances stored in a segment. */ - -/* $ Examples */ - -/* Suppose that MOC.BC is a CK file that contains segments of */ -/* data type 3. Then the following code fragment extracts the */ -/* SCLK time, boresight vector, and angular velocity vector for */ -/* each pointing instance in the first segment in the file. */ - - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 8 ) */ -/* DOUBLE PRECISION QUAT ( 4 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ -/* DOUBLE PRECISION BORE ( 3 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ - -/* LOGICAL FOUND */ -/* LOGICAL AVSEG */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'MOC.BC', HANDLE ) */ -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 3 ) THEN */ -/* C */ -/* C Does the segment contain AV data? */ -/* C */ -/* AVSEG = ( ICD(4) .EQ. 1 ) */ -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR03 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ -/* C */ -/* C Get the Ith pointing instance in the segment. */ -/* C */ -/* CALL CKGR03 ( HANDLE, DESCR, I, RECORD ) */ - -/* C */ -/* C Unpack RECORD into the time, quaternion, and av. */ -/* C */ -/* SCLKDP = RECORD ( 1 ) */ - -/* CALL MOVED ( RECORD(2), 4, QUAT ) */ - -/* IF ( AVSEG ) THEN */ -/* CALL MOVED ( RECORD(6), 3, AV ) */ -/* END IF */ - -/* C */ -/* C The boresight vector is the third row of the C-matrix. */ -/* C */ -/* CALL Q2M ( QUAT, CMAT ) */ - -/* BORE(1) = CMAT(3,1) */ -/* BORE(2) = CMAT(3,2) */ -/* BORE(3) = CMAT(3,3) */ -/* C */ -/* C Write out the results. */ -/* C */ -/* WRITE (*,*) 'Record: ', I */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'SCLK time = ', SCLKDP */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'boresight: ', BORE */ - -/* IF ( AVSEG ) THEN */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'angular velocity: ', AV */ -/* END IF */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The binary CK file containing the segment whose descriptor was */ -/* passed to this routine must be opened for read or write access */ -/* by either CKLPF, DAFOPR, DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* get ck type_3 record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* QSIZ is the number of double precision numbers making up */ -/* the quaternion portion of a pointing record. */ - -/* QAVSIZ is the number of double precision numbers making up */ -/* the quaternion and angular velocity portion of a */ -/* pointing record. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGR03", (ftnlen)6); - } - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - -/* From the descriptor, determine */ - -/* 1 - Is this really a type 3 segment? */ -/* 2 - The beginning address of the segment. */ -/* 3 - The number of pointing instances in the segment (it's the */ -/* last word in the segment). */ -/* 4 - The existence of angular velocity data, which determines how */ -/* big the pointing portion of the returned record will be. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - if (icd[2] != 3) { - setmsg_("Data type of the segment should be 3: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKGR03", (ftnlen)6); - return 0; - } - if (icd[3] == 1) { - psiz = 7; - } else { - psiz = 4; - } - beg = icd[4]; - end = icd[5]; - dafgda_(handle, &end, &end, &npoint); - nrec = i_dnnt(&npoint); - -/* If a request was made for a record which doesn't exist, then */ -/* signal an error and leave. */ - - if (*recno < 1 || *recno > nrec) { - setmsg_("Requested record number (#) does not exist. There are # rec" - "ords in the segment.", (ftnlen)79); - errint_("#", recno, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20); - chkout_("CKGR03", (ftnlen)6); - return 0; - } - -/* Get the pointing record indexed by RECNO. */ - - addr__ = beg + psiz * (*recno - 1); - i__1 = addr__ + psiz - 1; - dafgda_(handle, &addr__, &i__1, &record[1]); - -/* Next get the SCLK time. Need to go past all of the NREC pointing */ -/* records (PSIZ * NREC numbers), and then to the RECNOth SCLK */ -/* time. */ - - addr__ = beg + psiz * nrec + *recno - 1; - dafgda_(handle, &addr__, &addr__, record); - chkout_("CKGR03", (ftnlen)6); - return 0; -} /* ckgr03_ */ - diff --git a/ext/spice/src/cspice/ckgr04.c b/ext/spice/src/cspice/ckgr04.c deleted file mode 100644 index 2c3941cd79..0000000000 --- a/ext/spice/src/cspice/ckgr04.c +++ /dev/null @@ -1,534 +0,0 @@ -/* ckgr04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__7 = 7; -static doublereal c_b15 = 128.; - -/* $Procedure CKGR04 ( C-kernel, get record, type 04 ) */ -/* Subroutine */ int ckgr04_(integer *handle, doublereal *descr, integer * - recno, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec, ends[1], k; - extern /* Subroutine */ int chkin_(char *, ftnlen), cknr04_(integer *, - doublereal *, integer *), dafus_(doublereal *, integer *, integer - *, doublereal *, integer *); - integer numall; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numcft[7]; - extern /* Subroutine */ int chkout_(char *, ftnlen), sgfpkt_(integer *, - doublereal *, integer *, integer *, doublereal *, integer *), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - extern /* Subroutine */ int zzck4d2i_(doublereal *, integer *, doublereal - *, integer *); - -/* $ Abstract */ - -/* Given the handle and descriptor of a type 4 segment in */ -/* a CK file, return a specified pointing record from that */ -/* segment. */ - -/* $ 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 */ - -/* CK.REQ */ -/* DAF.REQ */ -/* GS.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The segment descriptor. */ -/* RECNO I The number of the pointing record to be returned. */ -/* RECORD O The pointing record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* desired segment. The file should have been opened */ -/* for read or write access, either by CKLPF, DAFOPR, */ -/* or DAFOPW. */ - -/* DESCR is the packed descriptor of the data type 4 segment. */ - -/* RECNO is the number of the pointing record to be returned */ -/* from the data type 4 segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the pointing record indexed by RECNO in the */ -/* segment. The contents of the record are as follows: */ - -/* --------------------------------------------------- */ -/* | The midpoint of the approximation interval | */ -/* --------------------------------------------------- */ -/* | The radius of the approximation interval | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q0 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q1 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q2 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q3 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV1 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV2 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV3 | */ -/* --------------------------------------------------- */ -/* | q0 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q1 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q2 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q3 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | AV1 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ -/* | AV2 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ -/* | AV3 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ - -/* $ Parameters */ - -/* See 'ckparam.inc'. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or */ -/* write access. */ - -/* $ Exceptions */ - -/* 1) If the segment is not of data type 4, the error */ -/* SPICE(CKWRONGDATATYPE) is signalled. */ - -/* 2) If RECNO is less than one or greater than the number of */ -/* records in the specified segment, the error */ -/* SPICE(CKNONEXISTREC) is signalled. */ - -/* 3) If the specified handle does not belong to any DAF file that */ -/* is currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 4) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 4 segment, */ -/* see the CK required reading. */ - -/* This is a utility routine that may be used to read the individual */ -/* pointing records that make up a type 4 segment. It is normally */ -/* used in conjunction with CKNR04, which gives the number of */ -/* pointing records stored in a segment. */ - -/* $ Examples */ - -/* Suppose that DATA.BC is a CK file that contains segments of */ -/* data type 4. Then the following code fragment extracts the */ -/* data packets contained in the segment. */ - -/* C */ -/* C CK parameters include file. */ -/* C */ -/* INCLUDE 'ckparam.inc' */ -/* C */ -/* C Declarations. */ -/* C */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION PKTDAT ( CK4RSZ ) */ - -/* INTEGER AVFLAG */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER ICD ( 6 ) */ -/* INTEGER K */ -/* INTEGER LASTAD */ -/* INTEGER NCOEF ( QAVSIZ ) */ -/* INTEGER NREC */ - -/* LOGICAL FOUND */ -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'DATA.BC', HANDLE ) */ -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* IF ( ICD( 3 ) .EQ. 4 ) THEN */ -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR04 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ -/* C */ -/* C Get the data records stored in the segment. */ -/* C */ -/* CALL CKGR04 ( HANDLE, DESCR, I, PKTDAT ) */ -/* C */ -/* C Print data packet contents. Print coverage interval */ -/* C midpoint & radii first. */ -/* C */ -/* WRITE (2,*) PKTDAT (1) */ -/* WRITE (2,*) PKTDAT (2) */ -/* C */ -/* C Decode numbers of coefficients. */ -/* C */ -/* CALL ZZCK4D2I ( PKTDAT(3), QAVSIZ, CK4PCD, NCOEF ) */ -/* C */ -/* C Print number of coefficients for Q0, Q1, Q2 and Q3. */ -/* C */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 1 ), NCOEF( 2 ) */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 3 ), NCOEF( 4 ) */ -/* C */ -/* C Print number coefficients for AV1, AV2 and AV3. */ -/* C */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 5 ), NCOEF( 6 ) */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 7 ) */ -/* C */ -/* C Print Cheby coefficients. */ -/* C */ -/* LASTAD = 0 */ - -/* DO K = 1, QAVSIZ */ -/* LASTAD = LASTAD + NCOEF( K ) */ -/* END DO */ - -/* DO K = 4, LASTAD + 4 */ -/* WRITE (2,*) PKTDAT (K) */ -/* END DO */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The binary CK file containing the segment whose descriptor */ -/* was passed to this routine must be opened for read or write */ -/* access by either CKLPF, DAFOPR, or DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* get CK type_4 record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Length (in DPs) of non-coefficient front part of RECORD when */ -/* it contains decoded numbers of coefficients. It is one less */ -/* than the length of the same part in a record exchanged between */ -/* CKR04 and CKE04 because it doesn't contain time at which */ -/* pointing has to be evaluated. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGR04", (ftnlen)6); - } - -/* Unpack descriptor and check segment data type. Signal an error */ -/* if it's not 4. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - if (icd[2] != 4) { - setmsg_("Data type of the segment should be 4: Passed descriptor sh" - "ows type = #.", (ftnlen)72); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKGR04", (ftnlen)6); - return 0; - } - -/* If a request was made for a data record which doesn't */ -/* exist, then signal an error and leave. */ - - cknr04_(handle, descr, &nrec); - if (*recno < 1 || *recno > nrec) { - setmsg_("Requested record number (#) does not exist. There are # rec" - "ords in the segment.", (ftnlen)79); - errint_("#", recno, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20); - chkout_("CKGR04", (ftnlen)6); - return 0; - } - -/* Get the data record indexed by RECNO. */ - - sgfpkt_(handle, descr, recno, recno, record, ends); - -/* Decode 7 numbers of coefficients from double precision value. */ - - zzck4d2i_(&record[2], &c__7, &c_b15, numcft); - -/* Compute total number of coefficients in the fetched packet. */ - - numall = 0; - for (k = 1; k <= 7; ++k) { - numall += numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "numcft", i__1, "ckgr04_", (ftnlen)366)]; - } - -/* Move polynomial coefficients to the right to free space for */ -/* decoded numbers of coefficients and insert these numbers */ -/* starting from the third position. */ - - for (k = numall; k >= 1; --k) { - record[k + 8] = record[k + 2]; - } - for (k = 1; k <= 7; ++k) { - record[k + 1] = (doublereal) numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ? - i__1 : s_rnge("numcft", i__1, "ckgr04_", (ftnlen)379)]; - } - -/* All done. */ - - chkout_("CKGR04", (ftnlen)6); - return 0; -} /* ckgr04_ */ - diff --git a/ext/spice/src/cspice/ckgr05.c b/ext/spice/src/cspice/ckgr05.c deleted file mode 100644 index f9109130ae..0000000000 --- a/ext/spice/src/cspice/ckgr05.c +++ /dev/null @@ -1,521 +0,0 @@ -/* ckgr05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKGR05 ( C-kernel, get record, type 05 ) */ -/* Subroutine */ int ckgr05_(integer *handle, doublereal *descr, integer * - recno, doublereal *record) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer addr__, nrec; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *); - integer packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - doublereal npoint; - extern logical return_(void); - integer subtyp; - doublereal dcd[2]; - integer beg, icd[6], end; - -/* $ Abstract */ - -/* Given the handle and descriptor of a type 5 segment in a CK file, */ -/* return a specified pointing instance from that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to CK type 05. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ - -/* CK type 5 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ -/* and quaternion derivatives only, no angular velocity */ -/* vector provided. Quaternion elements are listed */ -/* first, followed by derivatives. Angular velocity is */ -/* derived from the quaternions and quaternion */ -/* derivatives. */ - - -/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ -/* only. Angular velocity is derived by differentiating */ -/* the interpolating polynomials. */ - - -/* Subtype 2: Hermite interpolation, 14-element packets. */ -/* Quaternion and angular angular velocity vector, as */ -/* well as derivatives of each, are provided. The */ -/* quaternion comes first, then quaternion derivatives, */ -/* then angular velocity and its derivatives. */ - - -/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ -/* and angular velocity vector provided. The quaternion */ -/* comes first. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of file ck05.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The segment descriptor. */ -/* RECNO I The number of the pointing instance to be returned. */ -/* RECORD O The pointing record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* desired segment. */ - -/* DESCR is the packed descriptor of the data type 5 segment. */ - -/* RECNO is the number of the discrete pointing instance to be */ -/* returned from the data type 5 segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the pointing instance indexed by RECNO in the */ -/* segment. The contents are as follows: */ - -/* RECORD( 1 ) = CLKOUT */ - -/* CLKOUT is the encoded spacecraft clock time associated */ -/* with the returned pointing values. */ - -/* RECORD( 2 ) = SUBTYP */ - -/* SUBTYP is the CK type 5 subtype code. This code */ -/* identifies the structure and meaning of the rest */ -/* of the record. However, all subtypes have a */ -/* quaternion stored in elements 3-6. */ - -/* RECORD( 3 ) = q0 */ -/* RECORD( 4 ) = q1 */ -/* RECORD( 5 ) = q2 */ -/* RECORD( 6 ) = q3 */ - -/* Subtype 1 ends here; there are no angular velocity */ -/* data. Angular velocity is derived by differentiating */ -/* Lagrange interpolating polynomials. */ - -/* RECORD( 7 ) = ] */ -/* RECORD( 8 ) = ] --- For subtypes 0 and 2, these */ -/* RECORD( 9 ) = ] elements contain a quaternion */ -/* RECORD( 10 ) = ] derivative. For subtype 3, */ -/* elements 7-9 contain an */ -/* angular velocity vector; */ -/* element 10 is unassigned. */ - -/* All subtypes except subtype */ -/* 2 stop here. */ - -/* RECORD( 11 ) = ] */ -/* RECORD( 12 ) = ] --- For subtype 2, these */ -/* RECORD( 13 ) = ] elements contain an angular */ -/* velocity vector. */ - - -/* RECORD( 14 ) = ] */ -/* RECORD( 15 ) = ] --- For subtype 2, these */ -/* RECORD( 16 ) = ] elements contain the */ -/* derivative of an angular */ -/* velocity vector. */ - -/* The quantities q0 - q3 are the components of the */ -/* quaternion that represents the C-matrix that transforms */ -/* vectors from the inertial reference frame of the */ -/* segment to the instrument frame at time CLKOUT. */ - -/* Quaternion derivatives, angular velocity, or the */ -/* derivative of angular velocity are returned only */ -/* these are supported by the segment subtype and */ -/* if the segment descriptor indicates that angular */ -/* velocity is present. */ - -/* The components of the angular velocity vector are */ -/* specified relative to the inertial reference frame of */ -/* the segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment is not of data type 5, the error */ -/* SPICE(CKWRONGDATATYPE) is signaled. */ - -/* 2) If RECNO is less than one or greater than the number of */ -/* records in the specified segment, the error */ -/* SPICE(CKNONEXISTREC) is signaled. */ - -/* 3) If the specified handle does not belong to any DAF file that */ -/* is currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 4) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* 5) If the segment subtype is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or */ -/* write access. */ - -/* $ Particulars */ - -/* For a detailed description of the structure of a type 5 segment, */ -/* see the CK required reading. */ - -/* This is a utility routine that may be used to read the individual */ -/* pointing instances that make up a type 5 segment. It is normally */ -/* used in conjunction with CKNR05, which gives the number of */ -/* pointing instances stored in a segment. */ - -/* $ Examples */ - -/* Suppose that MOC.BC is a CK file that contains segments of */ -/* data type 5. Then the following code fragment extracts the */ -/* SCLK time and boresight vector for each pointing instance */ -/* in the first segment in the file. */ - - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 16 ) */ -/* DOUBLE PRECISION QUAT ( 4 ) */ -/* DOUBLE PRECISION BORE ( 3 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ - -/* LOGICAL FOUND */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'MOC.BC', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 5 ) THEN */ -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR05 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ -/* C */ -/* C Get the Ith pointing instance in the segment. */ -/* C */ -/* CALL CKGR05 ( HANDLE, DESCR, I, RECORD ) */ - -/* C */ -/* C Unpack from RECORD the time tag and quaternion. */ -/* C The locations of these items in the record are */ -/* C independent of the subtype. */ -/* C */ -/* SCLKDP = RECORD ( 1 ) */ - -/* CALL MOVED ( RECORD(3), 4, QUAT ) */ - -/* C */ -/* C The boresight vector is the third row of the C-matrix. */ -/* C */ -/* CALL Q2M ( QUAT, CMAT ) */ - -/* BORE(1) = CMAT(3,1) */ -/* BORE(2) = CMAT(3,2) */ -/* BORE(3) = CMAT(3,3) */ -/* C */ -/* C Write out the results. */ -/* C */ -/* WRITE (*,*) 'Record: ', I */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'SCLK time = ', SCLKDP */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'boresight: ', BORE */ - -/* END DO */ - -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 27-AUG-2002 (NJB) (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* get ck type_5 record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKGR05", (ftnlen)6); - } - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - -/* From the descriptor, determine */ - -/* 1 - Is this really a type 5 segment? */ -/* 2 - The beginning address of the segment. */ -/* 3 - The number of pointing instances in the segment (it's the */ -/* last word in the segment). */ -/* 4 - The existence of angular velocity data, which determines how */ -/* big the pointing portion of the returned record will be. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - if (icd[2] != 5) { - setmsg_("Data type of the segment should be 5: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKGR05", (ftnlen)6); - return 0; - } - -/* Capture the segment's address range. */ - - beg = icd[4]; - end = icd[5]; - -/* Read the subtype from the segment. */ - - i__1 = end - 3; - i__2 = end - 3; - dafgda_(handle, &i__1, &i__2, &record[1]); - subtyp = (integer) record[1]; - if (subtyp == 0) { - packsz = 8; - } else if (subtyp == 1) { - packsz = 4; - } else if (subtyp == 2) { - packsz = 14; - } else if (subtyp == 3) { - packsz = 7; - } else { - setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", ( - ftnlen)55); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKGR05", (ftnlen)6); - return 0; - } - dafgda_(handle, &end, &end, &npoint); - nrec = i_dnnt(&npoint); - -/* If a request was made for a record which doesn't exist, then */ -/* signal an error and leave. */ - - if (*recno < 1 || *recno > nrec) { - setmsg_("Requested record number (#) does not exist. There are # rec" - "ords in the segment.", (ftnlen)79); - errint_("#", recno, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20); - chkout_("CKGR05", (ftnlen)6); - return 0; - } - -/* Get the pointing record indexed by RECNO. */ - - addr__ = beg + packsz * (*recno - 1); - i__1 = addr__ + packsz - 1; - dafgda_(handle, &addr__, &i__1, &record[2]); - -/* Next get the SCLK time. Need to go past all of the NREC pointing */ -/* records (PACKSZ * NREC numbers), and then to the RECNOth SCLK */ -/* time. */ - - addr__ = beg + packsz * nrec + *recno - 1; - dafgda_(handle, &addr__, &addr__, record); - chkout_("CKGR05", (ftnlen)6); - return 0; -} /* ckgr05_ */ - diff --git a/ext/spice/src/cspice/cklpf_c.c b/ext/spice/src/cspice/cklpf_c.c deleted file mode 100644 index 136aa36826..0000000000 --- a/ext/spice/src/cspice/cklpf_c.c +++ /dev/null @@ -1,190 +0,0 @@ -/* - --Procedure cklpf_c ( C-kernel, load pointing file ) - --Abstract - - Load a CK pointing file for use by the CK readers. Return that - file's handle, to be used by other CK routines to refer to the - file. - --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 - - CK - DAF - --Keywords - - POINTING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void cklpf_c ( ConstSpiceChar * filename, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - filename I Name of the CK file to be loaded. - handle O Loaded file's handle. - --Detailed_Input - - filename is the name of a C-kernel file to be loaded. - --Detailed_Output - - handle is an integer handle assigned to the file upon loading. - Almost every other CK routine will subsequently use - this number to refer to the file. - --Parameters - - ftsize is the maximum number of pointing files that can - be loaded by CKLPF at any given time for use by the - readers. - --Exceptions - - 1) If an attempt is made to load more files than is specified - by the parameter ftsize, the error "SPICE(CKTOOMANYFILES)" - is signalled. - - 2) If an attempt is made to open more DAF files than is specified - by the parameter ftsize in DAFAH, an error is signalled by a - routine that this routine calls. - - 3) If the file specified by filename can not be opened, an error - is signalled by a routine that this routine calls. - - 4) If the file specified by filename has already been loaded, - it will become the "last-loaded" file. (The readers - search the last-loaded file first.) - --Files - - The C-kernel file specified by filename is loaded. The file is - assigned an integer handle by CKLPF. Other CK routines will refer - to this file by its handle. - --Particulars - - See Particulars in ckbsr. - - If there is room for a new file, CKLPF opens the file for - reading. This routine must be called prior to a call to CKGP or - CKGPAV. - - CK readers search files loaded with CKLPF in the reverse order - in which they were loaded. That is, last-loaded files are - searched first. - --Examples - - ck_kern = "/kernels/mpf/ck/lander_nominal.bck"; - cklpf_c ( ck_kern, &hand ); - - Also see the Example in ckbsr.for. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - J.M. Lynch (JPL) - J.E. McLean (JPL) - M.J. Spencer (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 2.0.1, 31-JAN-2008 (BVS) - - Removed '-Revisions' from the header. - - -CSPICE Version 2.0.0, 08-FEB-1998 (NJB) - - Input argument filename changed to type ConstSpiceChar *; - name was changed to "filename" from "fname." - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - load ck pointing file - --& -*/ - -{ /* Begin spklef_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "cklpf_c" ); - - - /* - Check the input string filename to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "cklpf_c", filename ); - - - /* - Call the f2c'd Fortran routine. - */ - cklpf_ ( ( char * ) filename, - ( integer * ) handle, - ( ftnlen ) strlen(filename) ); - - - chkout_c ( "cklpf_c" ); - -} /* end cklpf_c */ diff --git a/ext/spice/src/cspice/ckmeta.c b/ext/spice/src/cspice/ckmeta.c deleted file mode 100644 index b9fd3c6018..0000000000 --- a/ext/spice/src/cspice/ckmeta.c +++ /dev/null @@ -1,419 +0,0 @@ -/* ckmeta.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__2 = 2; - -/* $Procedure CKMETA ( CK ID to associated SCLK ) */ -/* Subroutine */ int ckmeta_(integer *ckid, char *meta, integer *idcode, - ftnlen meta_len) -{ - /* Initialized data */ - - static char base[7] = "CKMETA."; - static integer currnt = 0; - static integer last = 0; - static logical nodata = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer this__, spks[30], n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char agent[32*30]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - static logical found[2]; - static integer sclks[30]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - extern integer bschoi_(integer *, integer *, integer *, integer *); - static logical update; - extern /* Subroutine */ int orderi_(integer *, integer *, integer *); - static integer cksord[30]; - extern /* Subroutine */ int gipool_(char *, integer *, integer *, integer - *, integer *, logical *, ftnlen), sigerr_(char *, ftnlen); - static char mymeta[7]; - extern /* Subroutine */ int chkout_(char *, ftnlen), prefix_(char *, - integer *, char *, ftnlen, ftnlen), cvpool_(char *, logical *, - ftnlen), setmsg_(char *, ftnlen), suffix_(char *, integer *, char - *, ftnlen, ftnlen), cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - static char lookup[32*2*30]; - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), swpool_( - char *, integer *, char *, ftnlen, ftnlen); - static integer cks[30]; - -/* $ Abstract */ - -/* This routine returns (depending upon the users' request) */ -/* the ID code of either the spacecraft or spacecraft clock */ -/* associated with a C-Kernel ID code. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CKID I The ID code for some C kernel object. */ -/* META I The kind of meta data requested 'SPK' or 'SCLK' */ -/* IDCODE O The ID code for the clock of the C kernel. */ - -/* $ Detailed_Input */ - -/* CKID is the ID code for some object whose attitude */ -/* and possibly angular velocity are stored in */ -/* some C-kernel. */ - -/* META is a character string that indicates which piece */ -/* of meta data to fetch. Acceptable values are */ -/* 'SCLK' and 'SPK'. The routine is case insensitive. */ -/* Leading and trailing blanks are insignificant. */ -/* However, blanks between characters are regarded */ -/* as being significant and will result in the error */ -/* 'SPICE(UNKNOWNCKMETA)' being signalled. */ - -/* $ Detailed_Output */ - -/* IDCODE if META is 'SCLK' then the value returned in IDCODE */ -/* is the "ID code" of the spacecraft clock used for */ -/* converting ET to TICKS and TICKS to ET for the */ -/* C-kernel used to represent the attitude of the */ -/* object with ID code CKID. */ - -/* if META is 'SPK' then the value returned in IDCODE */ -/* is the "ID code" of the spacecraft on which the */ -/* platform indicated by CKID is mounted. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the variable META is not recognized to be one of the */ -/* inputs 'SPK' or 'SCLK' then the error 'SPICE(UNKNOWNCKMETA)' */ -/* will be signalled. */ - -/* 2) If CKID is greater than -1000, the associated SCLK and SPK */ -/* ID's must be in the kernel pool. If they are not present */ -/* a value of zero is returned for the requested item. Zero */ -/* is never the valid ID of a spacecraft clock or ephemeris */ -/* object. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine for mapping C-kernels to associated */ -/* spacecraft clocks. This is needed to facilitate the writing */ -/* of routines such as CKEZ and CKEZAV. */ - -/* $ Examples */ - -/* Suppose you would like to look up the attitude of */ -/* an object in a C-kernel but have ET and seconds as your */ -/* input time and tolerance. */ - -/* This routine can be used in conjunction with SCE2C and */ -/* CKGPAV to perform this task. */ - -/* CALL CKMETA ( CKID, 'SCLK' IDCODE ) */ - -/* CALL SCE2C ( IDCODE, ET, TICKS ) */ -/* CALL SCE2C ( IDCODE, ET+SECTOL, TICK2 ) */ - -/* TOL = TICK2 - TICKS */ - -/* CALL CKGPAV ( CKID, TICKS, TOL, REF, CMAT, AV, CLKOUT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* CALL SCT2E ( IDCODE, CLKOUT, ETOUT ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 05-MAR-2009 (NJB) */ - -/* This routine now keeps track of whether its kernel pool */ -/* look-up failed. If so, a kernel pool lookup is attempted on */ -/* the next call to this routine. This change is an enhancement, */ -/* not a bug fix (unlike similar modifications in SCLK routines). */ - -/* Header sections were put in correct order. */ - -/* - SPICELIB Version 1.0.1, 09-MAR-1999 (NJB) */ - -/* Comments referring to SCE2T have been updated to refer to */ -/* SCE2C. Occurrences of "id" replaced by "ID." */ - -/* - SPICELIB Version 1.0.0, 4-OCT-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Map C-kernel ID to SCLK and SPK ID */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKMETA", (ftnlen)6); - -/* Get an upper-case, left-justified copy of the metadata */ -/* type ('SCLK' or 'SPK'). */ - - cmprss_(" ", &c__1, meta, mymeta, (ftnlen)1, meta_len, (ftnlen)7); - ljust_(mymeta, mymeta, (ftnlen)7, (ftnlen)7); - ucase_(mymeta, mymeta, (ftnlen)7, (ftnlen)7); - -/* See if we already have this CK ID in hand. */ - - this__ = bschoi_(ckid, &currnt, cks, cksord); - if (this__ > 0) { - -/* We've got it. Check to see if its value has been updated. */ -/* (Note that every CK ID has its own agent.) */ - - cvpool_(agent + (((i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : - s_rnge("agent", i__1, "ckmeta_", (ftnlen)264)) << 5), &update, - (ftnlen)32); - if (update || nodata) { - gipool_(lookup + (((i__1 = (this__ << 1) - 2) < 60 && 0 <= i__1 ? - i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen)268)) << - 5), &c__1, &c__1, &n, &sclks[(i__2 = this__ - 1) < 30 && - 0 <= i__2 ? i__2 : s_rnge("sclks", i__2, "ckmeta_", ( - ftnlen)268)], found, (ftnlen)32); - gipool_(lookup + (((i__1 = (this__ << 1) - 1) < 60 && 0 <= i__1 ? - i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen)271)) << - 5), &c__1, &c__1, &n, &spks[(i__2 = this__ - 1) < 30 && 0 - <= i__2 ? i__2 : s_rnge("spks", i__2, "ckmeta_", (ftnlen) - 271)], &found[1], (ftnlen)32); - if (failed_()) { - nodata = TRUE_; - chkout_("CKMETA", (ftnlen)6); - return 0; - } - -/* Note that failure to find data is not an error in this */ -/* routine; it's just SPICE errors that are a problem. */ - - nodata = FALSE_; - } - } else { - -/* We don't have this on our handy list. Find a place to put it. */ - - if (currnt < 30) { - ++currnt; - last = currnt; - } else { - ++last; - if (last > 30) { - last = 1; - } - } - this__ = last; - cks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge("cks", i__1, - "ckmeta_", (ftnlen)314)] = *ckid; - -/* Recompute the order vector for the CKS; construct the */ -/* kernel pool variable names and the agent name. */ - - orderi_(cks, &currnt, cksord); - intstr_(ckid, lookup + (((i__1 = (this__ << 1) - 2) < 60 && 0 <= i__1 - ? i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen)321)) << 5) - , (ftnlen)32); - prefix_("CK_", &c__0, lookup + (((i__1 = (this__ << 1) - 2) < 60 && 0 - <= i__1 ? i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen) - 322)) << 5), (ftnlen)3, (ftnlen)32); -/* Writing concatenation */ - i__3[0] = 7, a__1[0] = base; - i__3[1] = 32, a__1[1] = lookup + (((i__2 = (this__ << 1) - 2) < 60 && - 0 <= i__2 ? i__2 : s_rnge("lookup", i__2, "ckmeta_", (ftnlen) - 324)) << 5); - s_cat(agent + (((i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "agent", i__1, "ckmeta_", (ftnlen)324)) << 5), a__1, i__3, & - c__2, (ftnlen)32); - s_copy(lookup + (((i__1 = (this__ << 1) - 1) < 60 && 0 <= i__1 ? i__1 - : s_rnge("lookup", i__1, "ckmeta_", (ftnlen)325)) << 5), - lookup + (((i__2 = (this__ << 1) - 2) < 60 && 0 <= i__2 ? - i__2 : s_rnge("lookup", i__2, "ckmeta_", (ftnlen)325)) << 5), - (ftnlen)32, (ftnlen)32); - suffix_("_SCLK", &c__0, lookup + (((i__1 = (this__ << 1) - 2) < 60 && - 0 <= i__1 ? i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen) - 327)) << 5), (ftnlen)5, (ftnlen)32); - suffix_("_SPK", &c__0, lookup + (((i__1 = (this__ << 1) - 1) < 60 && - 0 <= i__1 ? i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen) - 328)) << 5), (ftnlen)4, (ftnlen)32); - -/* Set a watch for this item and fetch the current value */ -/* from the kernel pool (if there is a value there). */ - - swpool_(agent + (((i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : - s_rnge("agent", i__1, "ckmeta_", (ftnlen)334)) << 5), &c__1, - lookup + (((i__2 = (this__ << 1) - 2) < 60 && 0 <= i__2 ? - i__2 : s_rnge("lookup", i__2, "ckmeta_", (ftnlen)334)) << 5), - (ftnlen)32, (ftnlen)32); - cvpool_(agent + (((i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : - s_rnge("agent", i__1, "ckmeta_", (ftnlen)335)) << 5), &update, - (ftnlen)32); - gipool_(lookup + (((i__1 = (this__ << 1) - 2) < 60 && 0 <= i__1 ? - i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen)337)) << 5), - &c__1, &c__1, &n, &sclks[(i__2 = this__ - 1) < 30 && 0 <= - i__2 ? i__2 : s_rnge("sclks", i__2, "ckmeta_", (ftnlen)337)], - found, (ftnlen)32); - gipool_(lookup + (((i__1 = (this__ << 1) - 1) < 60 && 0 <= i__1 ? - i__1 : s_rnge("lookup", i__1, "ckmeta_", (ftnlen)340)) << 5), - &c__1, &c__1, &n, &spks[(i__2 = this__ - 1) < 30 && 0 <= i__2 - ? i__2 : s_rnge("spks", i__2, "ckmeta_", (ftnlen)340)], & - found[1], (ftnlen)32); - if (failed_()) { - nodata = TRUE_; - chkout_("CKMETA", (ftnlen)6); - return 0; - } - -/* Note that failure to find data is not an error in this */ -/* routine; it's just SPICE errors that are a problem. */ - -/* At this point, kernel data checks are done. */ - - nodata = FALSE_; - -/* If we didn't find it, we manufacture an ID code based upon */ -/* the "convention" used for all CKS so far. However, the */ -/* convention assumes that the CK ID will be less than -1000 */ -/* if it's not there is no sensible ID to return. We return */ -/* zero in that case. */ - - if (cks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge("cks", - i__1, "ckmeta_", (ftnlen)368)] <= -1000) { - if (! found[0]) { - sclks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "sclks", i__1, "ckmeta_", (ftnlen)371)] = cks[(i__2 = - this__ - 1) < 30 && 0 <= i__2 ? i__2 : s_rnge("cks", - i__2, "ckmeta_", (ftnlen)371)] / 1000; - } - if (! found[1]) { - spks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "spks", i__1, "ckmeta_", (ftnlen)375)] = cks[(i__2 = - this__ - 1) < 30 && 0 <= i__2 ? i__2 : s_rnge("cks", - i__2, "ckmeta_", (ftnlen)375)] / 1000; - } - } else { - if (! found[0]) { - sclks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "sclks", i__1, "ckmeta_", (ftnlen)381)] = 0; - } - if (! found[1]) { - spks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "spks", i__1, "ckmeta_", (ftnlen)385)] = 0; - } - } - } - if (s_cmp(mymeta, "SPK", (ftnlen)7, (ftnlen)3) == 0) { - *idcode = spks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "spks", i__1, "ckmeta_", (ftnlen)395)]; - } else if (s_cmp(mymeta, "SCLK", (ftnlen)7, (ftnlen)4) == 0) { - *idcode = sclks[(i__1 = this__ - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "sclks", i__1, "ckmeta_", (ftnlen)399)]; - } else { - *idcode = 0; - setmsg_("The CK meta data item \"#\" is not a recognized meta data i" - "tem for the routine CKMETA. The recognized value are \"SP" - "K\" and \"SCLK\". ", (ftnlen)129); - errch_("#", meta, (ftnlen)1, meta_len); - sigerr_("SPICE(UNKNOWNCKMETA)", (ftnlen)20); - chkout_("CKMETA", (ftnlen)6); - return 0; - } - chkout_("CKMETA", (ftnlen)6); - return 0; -} /* ckmeta_ */ - diff --git a/ext/spice/src/cspice/cknr01.c b/ext/spice/src/cspice/cknr01.c deleted file mode 100644 index ca5e41af04..0000000000 --- a/ext/spice/src/cspice/cknr01.c +++ /dev/null @@ -1,325 +0,0 @@ -/* cknr01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKNR01 ( C-kernel, number of records, type 01 ) */ -/* Subroutine */ int cknr01_(integer *handle, doublereal *descr, integer * - nrec) -{ - doublereal n; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Given the handle of a CK file and the descriptor of a data */ -/* type 1 segment in that file, return the number of pointing */ -/* records in that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The descriptor of the type 1 segment. */ -/* NREC O The number of records in the segment. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* segment whose descriptor was also passed. The file */ -/* should have been opened for read access, either by */ -/* CKLPF or DAFOPR. */ - -/* DESCR The packed descriptor of a data type 1 segment. */ - -/* $ Detailed_Output */ - -/* NREC The number of pointing records in the type 1 segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment indicated by DESCR is not a type 1 segment, */ -/* the error 'SPICE(CKWRONGDATATYPE)' is signalled. */ - -/* 2) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 3) If DESCR is not a valid, packed descriptor of a segment in */ -/* the CK file specified by HANDLE, the results of this routine */ -/* are unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read access. */ - -/* $ Particulars */ - -/* For a complete description of the internal structure of a type 1 */ -/* segment, see the CK required reading. */ - -/* $ Examples */ - -/* The following code fragment prints the records of the first */ -/* segment in a CK file. Suppose MOC.CK is binary CK file that */ -/* contains segments of data type 1. */ - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 8 ) */ -/* LOGICAL FOUND */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'MOC.CK', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 1 ) THEN */ - -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR01 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ - -/* C */ -/* C Get the record associated with record number I. */ -/* C */ -/* CALL CKGR01 ( HANDLE, DESCR, I, RECORD ) */ -/* WRITE (*,*) 'Record ', I, ':' */ -/* WRITE (*,*) RECORD */ -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* The binay CK file containing the segment whose descriptor was */ -/* passed to this routine must be opened for read access by either */ -/* CKLPF or DAFOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 06-MAR-1991 (JML) */ - -/* A correction was made to the example program in the */ -/* header. The array of double precision components of */ -/* the descriptor ( DCD ) had originally been declared */ -/* as an integer. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* number of ck type_1 records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.2, 06-MAR-1991 (JML) */ - -/* A correction was made to the example program in the */ -/* header. The array of double precision components of */ -/* the descriptor ( DCD ) had originally been declared */ -/* as an integer. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* 1) The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ -/* 2) Minor changes were made to the wording of the header. */ - -/* - Beta Version 1.1.0, 28-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The name of this routine was changed from CK01NR to */ -/* CKNR01 in order to be consistent with the SPICELIB */ -/* naming convention. */ -/* 2) The declarations for the parameters NDC and NIC were */ -/* moved from the "Declarations" section of the header to */ -/* the "Local parameters" section of the code below the */ -/* header. These parameters are not meant to modified by */ -/* users. */ -/* 3) The variables INTDES and DPDES were changed to ICD and */ -/* DCD. */ -/* 4) The header was corrected, improved, and updated to reflect */ -/* the changes. */ -/* 5) The in-code comments were improved. */ - -/* - Beta Version 1.0.0, 22-MAY-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel descriptor. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKNR01", (ftnlen)6); - } - -/* The number of pointing records contained in a data type 1 */ -/* segment is stored in the final double precision word of the */ -/* segment. Since the address of this very word is stored in the */ -/* sixth integer component of the segment descriptor, it is a trivial */ -/* matter to extract the count. */ - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* If this segment is not of data type 1, then signal an error. */ - - if (icd[2] != 1) { - setmsg_("Data type of the segment should be 1: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKNR01", (ftnlen)6); - return 0; - } - -/* The number of records is the final word in the segment. */ - - dafgda_(handle, &icd[5], &icd[5], &n); - *nrec = (integer) n; - chkout_("CKNR01", (ftnlen)6); - return 0; -} /* cknr01_ */ - diff --git a/ext/spice/src/cspice/cknr02.c b/ext/spice/src/cspice/cknr02.c deleted file mode 100644 index 3bb6b025db..0000000000 --- a/ext/spice/src/cspice/cknr02.c +++ /dev/null @@ -1,318 +0,0 @@ -/* cknr02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKNR02 ( C-kernel, number of records, type 02 ) */ -/* Subroutine */ int cknr02_(integer *handle, doublereal *descr, integer * - nrec) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - integer arrsiz; - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6], end; - -/* $ Abstract */ - -/* Given the handle of a CK file and the descriptor of a type 2 */ -/* segment in that file, return the number of pointing records */ -/* in that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The descriptor of the type 2 segment. */ -/* NREC O The number of records in the segment. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* segment. The file should have been opened for read */ -/* or write access, either by CKLPF, DAFOPR, or DAFOPW. */ - -/* DESCR The packed descriptor of a data type 2 segment. */ - -/* $ Detailed_Output */ - -/* NREC The number of pointing records in the type 2 segment */ -/* associated with HANDLE and DESCR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment indicated by DESCR is not a type 2 segment, */ -/* the error 'SPICE(CKWRONGDATATYPE)' is signalled. */ - -/* 2) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 3) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or write */ -/* access. */ - -/* $ Particulars */ - -/* For a complete description of the internal structure of a type 2 */ -/* segment, see the CK required reading. */ - -/* This routine returns the number of pointing records contained */ -/* in the specified segment. It is normally used in conjunction */ -/* with CKGR02, which returns the Ith record in the segment. */ - -/* $ Examples */ - -/* Suppose GLL_PLT.BC is a CK file that contains segments of data */ -/* type 2. Then the following code fragment uses CKNR02 and CKGR02 */ -/* to extract each pointing record in the first segment in the file. */ - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 10 ) */ - -/* LOGICAL FOUND */ - -/* C */ -/* C First load the file. ( The file may also be opened by using */ -/* C CKLPF. ) */ -/* C */ -/* CALL DAFOPR ( 'GLL_PLT.BC', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 2 ) THEN */ - -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR02 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ - -/* C */ -/* C Get the Ith record in the segment. */ -/* C */ -/* CALL CKGR02 ( HANDLE, DESCR, I, RECORD ) */ -/* C */ -/* C Process the pointing data. */ -/* C */ -/* . */ -/* . */ -/* . */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The binary CK file containing the segment whose descriptor was */ -/* passed to this routine must be opened for read or write access */ -/* by either CKLPF, DAFOPR, DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* number of ck type_2 records */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel descriptor. */ - -/* DTYPE is the data type. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKNR02", (ftnlen)6); - } - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* If this segment is not of data type 2, then signal an error. */ - - if (icd[2] != 2) { - setmsg_("Data type of the segment should be 2: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKNR02", (ftnlen)6); - return 0; - } - -/* The beginning and ending addresses of the segment are in the */ -/* descriptor. */ - - beg = icd[4]; - end = icd[5]; - -/* Calculate the number of pointing records in the segment from */ -/* the physical size of the segment and knowledge of its structure. */ - -/* Based on the structure of a type 2 segment, the size of a */ -/* segment with N pointing intervals is given as follows: */ - -/* ARRSIZ = PSIZ * N + 2 * N + ( N-1 ) / 100 (1) */ - -/* In the above equation PSIZ is eight and integer arithmetic is */ -/* used. This equation is equivalent to: */ - - -/* 100 * ARRSIZ = 1000 * N + ( N-1 ) * 100 (2) */ -/* ------- */ -/* 100 */ - -/* If we can eliminate the integer division then, since all of */ -/* the other values represent whole numbers, we can solve the */ -/* equation for N in terms of ARRSIZ by using double precision */ -/* arithmetic and then rounding the result to the nearest integer. */ - -/* This next equation uses double precision arithmetic and is */ -/* equivalent to (2): */ - -/* 100 * ARRSIZ = 1000 * N + ( N-1 ) - ( N-1 ) MOD 100 (3) */ - -/* Which means: */ - -/* 100 * ARRSIZ + 1 ( N-1 ) MOD 100 */ -/* ---------------- + --------------- = N (4) */ -/* 1001 1001 */ - -/* Since the second term on the left side of (4) is always less */ -/* than 0.1, the first term will always round to the correct */ -/* value of N. */ - - arrsiz = end - beg + 1; - d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.; - *nrec = i_dnnt(&d__1); - chkout_("CKNR02", (ftnlen)6); - return 0; -} /* cknr02_ */ - diff --git a/ext/spice/src/cspice/cknr03.c b/ext/spice/src/cspice/cknr03.c deleted file mode 100644 index e0b9854d8e..0000000000 --- a/ext/spice/src/cspice/cknr03.c +++ /dev/null @@ -1,324 +0,0 @@ -/* cknr03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKNR03 ( C-kernel, number of records, type 03 ) */ -/* Subroutine */ int cknr03_(integer *handle, doublereal *descr, integer * - nrec) -{ - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - doublereal npoint; - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Given the handle of a CK file and the descriptor of a type 3 */ -/* segment in that file, return the number of pointing instances */ -/* in that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The descriptor of the type 3 segment. */ -/* NREC O The number of pointing instances in the segment. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* segment. The file should have been opened for read */ -/* or write access, either by CKLPF, DAFOPR, or DAFOPW. */ - -/* DESCR The packed descriptor of a data type 3 segment. */ - -/* $ Detailed_Output */ - -/* NREC The number of pointing instances in the type 3 segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment indicated by DESCR is not a type 3 segment, */ -/* the error 'SPICE(CKWRONGDATATYPE)' is signalled. */ - -/* 2) If the specified handle does not belong to any DAF file that */ -/* is currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 3) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or */ -/* write access. */ - -/* $ Particulars */ - -/* For a complete description of the internal structure of a type 3 */ -/* segment, see the CK required reading. */ - -/* This routine returns the number of discrete pointing instances */ -/* contained in the specified segment. It is normally used in */ -/* conjunction with CKGR03 which returns the Ith pointing instance */ -/* in the segment. */ - -/* $ Examples */ - -/* Suppose that MOC.BC is a CK file that contains segments of */ -/* data type 3. Then the following code fragment extracts the */ -/* SCLK time, boresight vector, and angular velocity vector for */ -/* each pointing instance in the first segment in the file. */ - - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 8 ) */ -/* DOUBLE PRECISION QUAT ( 4 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ -/* DOUBLE PRECISION BORE ( 3 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ - -/* LOGICAL FOUND */ -/* LOGICAL AVSEG */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'MOC.BC', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 3 ) THEN */ -/* C */ -/* C Does the segment contain AV data? */ -/* C */ -/* AVSEG = ( ICD(4) .EQ. 1 ) */ -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR03 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ - -/* C */ -/* C Get the Ith pointing instance in the segment. */ -/* C */ -/* CALL CKGR03 ( HANDLE, DESCR, I, RECORD ) */ - -/* C */ -/* C Unpack RECORD into the time, quaternion, and av. */ -/* C */ -/* SCLKDP = RECORD ( 1 ) */ - -/* CALL MOVED ( RECORD(2), 4, QUAT ) */ - -/* IF ( AVSEG ) THEN */ -/* CALL MOVED ( RECORD(6), 3, AV ) */ -/* END IF */ -/* C */ -/* C The boresight vector is the third row of the C-matrix. */ -/* C */ -/* CALL Q2M ( QUAT, CMAT ) */ - -/* BORE(1) = CMAT(3,1) */ -/* BORE(2) = CMAT(3,2) */ -/* BORE(3) = CMAT(3,3) */ -/* C */ -/* C Write out the results. */ -/* C */ -/* WRITE (*,*) 'Record: ', I */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'SCLK time = ', SCLKDP */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'boresight: ', BORE */ - -/* IF ( AVSEG ) THEN */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'angular velocity: ', AV */ -/* END IF */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The binary CK file containing the segment whose descriptor was */ -/* passed to this routine must be opened for read or write access */ -/* by either CKLPF, DAFOPR, or DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* number of ck type_3 records */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel descriptor. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKNR03", (ftnlen)6); - } - -/* The number of discrete pointing instances contained in a data */ -/* type 3 segment is stored in the last double precision word of */ -/* the segment. Since the address of the last word is stored in */ -/* the sixth integer component of the segment descriptor, it is */ -/* a trivial matter to extract the count. */ - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* If this segment is not of data type 3, then signal an error. */ - - if (icd[2] != 3) { - setmsg_("Data type of the segment should be 3: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKNR03", (ftnlen)6); - return 0; - } - -/* The number of records is the final word in the segment. */ - - dafgda_(handle, &icd[5], &icd[5], &npoint); - *nrec = i_dnnt(&npoint); - chkout_("CKNR03", (ftnlen)6); - return 0; -} /* cknr03_ */ - diff --git a/ext/spice/src/cspice/cknr04.c b/ext/spice/src/cspice/cknr04.c deleted file mode 100644 index e302f0b187..0000000000 --- a/ext/spice/src/cspice/cknr04.c +++ /dev/null @@ -1,433 +0,0 @@ -/* cknr04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__12 = 12; - -/* $Procedure CKNR04 ( C-kernel, number of records, data type 4 ) */ -/* Subroutine */ int cknr04_(integer *handle, doublereal *descr, integer * - nrec) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), sgmeta_(integer *, - doublereal *, integer *, integer *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Given the handle of a CK file and the descriptor of a type 4 */ -/* segment in that file, return the number of pointing instances */ -/* in that segment. */ - -/* $ 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 */ - -/* CK.REQ */ -/* DAF.REQ */ -/* GS.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The descriptor of the type 4 segment. */ -/* NREC O The number of pointing records in the segment. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* segment. The file should have been opened for read */ -/* or write access, either by CKLPF, DAFOPR, or DAFOPW. */ - -/* DESCR The packed descriptor of a data type 4 segment. */ - -/* $ Detailed_Output */ - -/* NREC The number of pointing records in the type 4 */ -/* segment. */ - -/* $ Parameters */ - -/* See 'ckparam.inc'. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or */ -/* write access. */ - -/* $ Exceptions */ - -/* 1) If the segment indicated by DESCR is not a type 4 segment, */ -/* the error 'SPICE(CKWRONGDATATYPE)' is signalled. */ - -/* 2) If the specified handle does not belong to any DAF file that */ -/* is currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 3) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Particulars */ - -/* For a complete description of the internal structure of a type 4 */ -/* segment, see the CK required reading. */ - -/* This routine returns the number of pointing records contained */ -/* in the specified segment. It is normally used in conjunction */ -/* with CKGR04 which returns the Ith pointing record in the */ -/* segment. */ - -/* $ Examples */ - -/* Suppose that DATA.BC is a CK file that contains segments of */ -/* data type 4. Then the following code fragment extracts the */ -/* data packets contained in the segment. */ - -/* C */ -/* C CK parameters include file. */ -/* C */ -/* INCLUDE 'ckparam.inc' */ -/* C */ -/* C Declarations. */ -/* C */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION PKTDAT ( CK4RSZ ) */ - -/* INTEGER AVFLAG */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER ICD ( 6 ) */ -/* INTEGER K */ -/* INTEGER LASTAD */ -/* INTEGER NCOEF ( QAVSIZ ) */ -/* INTEGER NREC */ - -/* LOGICAL FOUND */ -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'DATA.BC', HANDLE ) */ -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* IF ( ICD( 3 ) .EQ. 4 ) THEN */ -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR04 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ -/* C */ -/* C Get the data records stored in the segment. */ -/* C */ -/* CALL CKGR04 ( HANDLE, DESCR, I, PKTDAT ) */ -/* C */ -/* C Print data packet contents. Print coverage interval */ -/* C midpoint & radii first. */ -/* C */ -/* WRITE (2,*) PKTDAT (1) */ -/* WRITE (2,*) PKTDAT (2) */ -/* C */ -/* C Decode numbers of coefficients. */ -/* C */ -/* CALL ZZCK4D2I ( PKTDAT(3), QAVSIZ, CK4PCD, NCOEF ) */ -/* C */ -/* C Print number of coefficients for Q0, Q1, Q2 and Q3. */ -/* C */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 1 ), NCOEF( 2 ) */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 3 ), NCOEF( 4 ) */ -/* C */ -/* C Print number coefficients for AV1, AV2 and AV3. */ -/* C */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 5 ), NCOEF( 6 ) */ -/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 7 ) */ -/* C */ -/* C Print Cheby coefficients. */ -/* C */ -/* LASTAD = 0 */ - -/* DO K = 1, QAVSIZ */ -/* LASTAD = LASTAD + NCOEF( K ) */ -/* END DO */ - -/* DO K = 4, LASTAD + 4 */ -/* WRITE (2,*) PKTDAT (K) */ -/* END DO */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The binary CK file containing the segment whose descriptor */ -/* was passed to this routine must be opened for read or write */ -/* access by either CKLPF, DAFOPR, or DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* number of CK type_4 records */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKNR04", (ftnlen)6); - } - -/* Check whether our segment is of the type 4 by unpacking */ -/* descriptor and checking value of its third integer component. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - if (icd[2] != 4) { - setmsg_("Data type of the segment should be 4: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKNR04", (ftnlen)6); - return 0; - } - -/* The number of records (packets) can be obtained by a call to */ -/* SGMETA. This number is a meta item 12 (see sgparam.inc for */ -/* details.) */ - - sgmeta_(handle, descr, &c__12, nrec); - -/* All done. */ - - chkout_("CKNR04", (ftnlen)6); - return 0; -} /* cknr04_ */ - diff --git a/ext/spice/src/cspice/cknr05.c b/ext/spice/src/cspice/cknr05.c deleted file mode 100644 index 1f948c88fe..0000000000 --- a/ext/spice/src/cspice/cknr05.c +++ /dev/null @@ -1,304 +0,0 @@ -/* cknr05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKNR05 ( C-kernel, number of records, type 05 ) */ -/* Subroutine */ int cknr05_(integer *handle, doublereal *descr, integer * - nrec) -{ - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - doublereal npoint; - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Given the handle of a CK file and the descriptor of a type 5 */ -/* segment in that file, return the number of pointing instances */ -/* in that segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of the file containing the segment. */ -/* DESCR I The descriptor of the type 5 segment. */ -/* NREC O The number of pointing instances in the segment. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* segment. */ - -/* DESCR The packed descriptor of a data type 5 segment. */ - -/* $ Detailed_Output */ - -/* NREC The number of pointing instances in the type 5 segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment indicated by DESCR is not a type 5 segment, */ -/* the error 'SPICE(CKWRONGDATATYPE)' is signaled. */ - -/* 2) If the specified handle does not belong to any DAF file that */ -/* is currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 3) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* $ Files */ - -/* The file specified by HANDLE should be open for read or */ -/* write access. */ - -/* $ Particulars */ - -/* For a complete description of the internal structure of a type 5 */ -/* segment, see the CK required reading. */ - -/* This routine returns the number of discrete pointing instances */ -/* contained in the specified segment. It is normally used in */ -/* conjunction with CKGR05 which returns the Ith pointing instance */ -/* in the segment. */ - -/* $ Examples */ - -/* Suppose that MOC.BC is a CK file that contains segments of */ -/* data type 5. Then the following code fragment extracts the */ -/* SCLK time and boresight vector for each pointing instance */ -/* in the first segment in the file. */ - - -/* INTEGER ICD ( 6 ) */ -/* INTEGER HANDLE */ -/* INTEGER NREC */ -/* INTEGER I */ - -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( 16 ) */ -/* DOUBLE PRECISION QUAT ( 4 ) */ -/* DOUBLE PRECISION BORE ( 3 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ - -/* LOGICAL FOUND */ - -/* C */ -/* C First load the file. (The file may also be opened by using */ -/* C CKLPF.) */ -/* C */ -/* CALL DAFOPR ( 'MOC.BC', HANDLE ) */ - -/* C */ -/* C Begin forward search. Find the first array. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* C */ -/* C Get segment descriptor. */ -/* C */ -/* CALL DAFGS ( DESCR ) */ - -/* C */ -/* C Unpack the segment descriptor into its double precision */ -/* C and integer components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C The data type for a segment is located in the third integer */ -/* C component of the descriptor. */ -/* C */ -/* IF ( ICD( 3 ) .EQ. 5 ) THEN */ -/* C */ -/* C How many records does this segment contain? */ -/* C */ -/* CALL CKNR05 ( HANDLE, DESCR, NREC ) */ - -/* DO I = 1, NREC */ -/* C */ -/* C Get the Ith pointing instance in the segment. */ -/* C */ -/* CALL CKGR05 ( HANDLE, DESCR, I, RECORD ) */ - -/* C */ -/* C Unpack from RECORD the time tag and quaternion. */ -/* C The locations of these items in the record are */ -/* C independent of the subtype. */ -/* C */ -/* SCLKDP = RECORD ( 1 ) */ - -/* CALL MOVED ( RECORD(3), 4, QUAT ) */ - -/* C */ -/* C The boresight vector is the third row of the C-matrix. */ -/* C */ -/* CALL Q2M ( QUAT, CMAT ) */ - -/* BORE(1) = CMAT(3,1) */ -/* BORE(2) = CMAT(3,2) */ -/* BORE(3) = CMAT(3,3) */ -/* C */ -/* C Write out the results. */ -/* C */ -/* WRITE (*,*) 'Record: ', I */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'SCLK time = ', SCLKDP */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'boresight: ', BORE */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* number of ck type_5 records */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel descriptor. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKNR05", (ftnlen)6); - } - -/* The number of discrete pointing instances contained in a data */ -/* type 5 segment is stored in the last double precision word of */ -/* the segment. Since the address of the last word is stored in */ -/* the sixth integer component of the segment descriptor, it is */ -/* a trivial matter to extract the count. */ - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* If this segment is not of data type 5, then signal an error. */ - - if (icd[2] != 5) { - setmsg_("Data type of the segment should be 5: Passed descriptor sho" - "ws type = #.", (ftnlen)71); - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22); - chkout_("CKNR05", (ftnlen)6); - return 0; - } - -/* The number of records is the final word in the segment. */ - - dafgda_(handle, &icd[5], &icd[5], &npoint); - *nrec = i_dnnt(&npoint); - chkout_("CKNR05", (ftnlen)6); - return 0; -} /* cknr05_ */ - diff --git a/ext/spice/src/cspice/ckobj.c b/ext/spice/src/cspice/ckobj.c deleted file mode 100644 index 6e8a7d1794..0000000000 --- a/ext/spice/src/cspice/ckobj.c +++ /dev/null @@ -1,433 +0,0 @@ -/* ckobj.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKOBJ ( CK objects ) */ -/* Subroutine */ int ckobj_(char *ck, integer *ids, ftnlen ck_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[80]; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - logical found; - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), insrti_(integer *, integer *); - char kertyp[80]; - extern logical return_(void); - -/* $ Abstract */ - -/* Find the set of ID codes of all objects in a specified CK file. */ - -/* $ 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 */ - -/* CELLS */ -/* CK */ -/* DAF */ -/* NAIF_IDS */ -/* SETS */ - -/* $ Keywords */ - -/* POINTING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CK I Name of CK file. */ -/* IDS I/O Set of ID codes of objects in CK file. */ - -/* $ Detailed_Input */ - -/* CK is the name of a C-kernel. */ - -/* IDS is an initialized SPICELIB set data structure. */ -/* IDS optionally may contain a set of ID codes on */ -/* input; on output, the data already present in */ -/* IDS will be combined with ID code set found for the */ -/* file CK. */ - -/* If IDS contains no data on input, its size and */ -/* cardinality still must be initialized. */ - -/* $ Detailed_Output */ - -/* IDS is a SPICELIB set data structure which contains */ -/* the union of its contents upon input with the set */ -/* of ID codes of each object for which pointing data */ -/* are present in the indicated CK file. The elements */ -/* of SPICELIB sets are unique; hence each ID code in */ -/* IDS appears only once, even if the CK file */ -/* contains multiple segments for that ID code. */ - -/* See the Examples section below for a complete */ -/* example program showing how to retrieve the ID */ -/* codes from IDS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file has transfer format, the error */ -/* SPICE(INVALIDFORMAT) is signaled. */ - -/* 2) If the input file is not a transfer file but has architecture */ -/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */ - -/* 3) If the input file is a binary DAF file of type other than */ -/* CK, the error SPICE(BADFILETYPE) is signaled. */ - -/* 4) If the CK file cannot be opened or read, the error will */ -/* be diagnosed by routines called by this routine. */ - -/* 5) If the size of the output set argument IDS is insufficient to */ -/* contain the actual number of ID codes of objects covered by */ -/* the indicated CK file, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* This routine reads a C-kernel. */ - -/* $ Particulars */ - -/* This routine provides an API via which applications can determine */ -/* the set of objects for which there are pointing data in a */ -/* specified CK file. */ - -/* $ Examples */ - -/* 1) Display the interval-level coverage for each object in a */ -/* specified CK file. Use tolerance of zero ticks. Do not */ -/* request angular velocity. Express the results in the TDB time */ -/* system. */ - -/* Find the set of objects in the file. Loop over the contents */ -/* of the ID code set: find the coverage for each item in the */ -/* set and display the coverage. */ - - -/* PROGRAM CKCVR */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ -/* INTEGER CARDI */ -/* C */ -/* C Local parameters */ -/* C */ -/* C */ -/* C Declare the coverage window. Make enough room */ -/* C for MAXIV intervals. */ -/* C */ -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXIV */ -/* PARAMETER ( MAXIV = 100000 ) */ - -/* INTEGER WINSIZ */ -/* PARAMETER ( WINSIZ = 2 * MAXIV ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER MAXOBJ */ -/* PARAMETER ( MAXOBJ = 1000 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) CK */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) SCLK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER I */ -/* INTEGER IDS ( LBCELL : MAXOBJ ) */ -/* INTEGER J */ -/* INTEGER NIV */ - -/* C */ -/* C Load a leapseconds kernel and SCLK kernel for output */ -/* C time conversion. Note that we assume a single spacecraft */ -/* C clock is associated with all of the objects in the CK. */ -/* C */ -/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */ -/* CALL FURNSH ( LSK ) */ - -/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */ -/* CALL FURNSH ( SCLK ) */ - -/* C */ -/* C Get name of CK file. */ -/* C */ -/* CALL PROMPT ( 'Name of CK file > ', CK ) */ - -/* C */ -/* C Initialize the set IDS. */ -/* C */ -/* CALL SSIZEI ( MAXOBJ, IDS ) */ - -/* C */ -/* C Initialize the window COVER. */ -/* C */ -/* CALL SSIZED ( WINSIZ, COVER ) */ - -/* C */ -/* C Find the set of objects in the CK file. */ -/* C */ -/* CALL CKOBJ ( CK, IDS ) */ - -/* C */ -/* C We want to display the coverage for each object. Loop */ -/* C over the contents of the ID code set, find the coverage */ -/* C for each item in the set, and display the coverage. */ -/* C */ -/* DO I = 1, CARDI( IDS ) */ -/* C */ -/* C Find the coverage window for the current */ -/* C object. Empty the coverage window each time */ -/* C so we don't include data for the previous object. */ -/* C */ -/* CALL SCARDD ( 0, COVER ) */ -/* CALL CKCOV ( CK, IDS(I), .FALSE., */ -/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */ - -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) '========================================' */ -/* WRITE (*,*) 'Coverage for object ', IDS(I) */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO J = 1, NIV */ -/* C */ -/* C Get the endpoints of the Jth interval. */ -/* C */ -/* CALL WNFETD ( COVER, J, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.###### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', J */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.###### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* WRITE (*,*) '========================================' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) If an error occurs while this routine is updating the set */ -/* IDS, the set may be corrupted. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */ - -/* Corrected bug in program in header Examples section: program */ -/* now empties the coverage window prior to collecting data for */ -/* the current object. Deleted declaration of unused parameter */ -/* NAMLEN in example program. Updated example to use WNCARD */ -/* rather than CARDD. */ - -/* - SPICELIB Version 1.0.0, 30-DEC-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find id codes of objects in ck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKOBJ", (ftnlen)5); - -/* See whether GETFAT thinks we've got a CK file. */ - - getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80); - if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "CK file to be readable by this routine. If the input file i" - "s an CK file in transfer format, run TOBIN on the file to co" - "nvert it to binary format.", (ftnlen)205); - errch_("#", ck, (ftnlen)1, ck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("CKOBJ", (ftnlen)5); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "CK file to be readable by this routine. Binary CK files hav" - "e DAF architecture. If you expected the file to be a binary" - " CK file, the problem may be due to the file being an old no" - "n-native file lacking binary file format information. It's a" - "lso possible the file has been corrupted.", (ftnlen)340); - errch_("#", ck, (ftnlen)1, ck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22); - chkout_("CKOBJ", (ftnlen)5); - return 0; - } else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) { - setmsg_("Input file # has file type #. The file must be a binary CK " - "file to be readable by this routine. If you expected the fil" - "e to be a binary CK file, the problem may be due to the file" - " being an old non-native file lacking binary file format inf" - "ormation. It's also possible the file has been corrupted.", ( - ftnlen)296); - errch_("#", ck, (ftnlen)1, ck_len); - errch_("#", kertyp, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22); - chkout_("CKOBJ", (ftnlen)5); - return 0; - } - -/* Open the file for reading. */ - - dafopr_(ck, &handle, ck_len); - if (failed_()) { - chkout_("CKOBJ", (ftnlen)5); - return 0; - } - -/* We will examine each segment descriptor in the file, and */ -/* we'll update our ID code set according to the data found */ -/* in these descriptors. */ - -/* Start a forward search. */ - - dafbfs_(&handle); - -/* Find the next DAF array. */ - - daffna_(&found); - while(found && ! failed_()) { - -/* Fetch and unpack the segment descriptor. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dc, ic); - -/* Insert the current ID code into the output set. */ -/* The insertion algorithm will handle duplicates; no special */ -/* action is required here. */ - - insrti_(ic, ids); - daffna_(&found); - } - -/* Release the file. */ - - dafcls_(&handle); - chkout_("CKOBJ", (ftnlen)5); - return 0; -} /* ckobj_ */ - diff --git a/ext/spice/src/cspice/ckobj_c.c b/ext/spice/src/cspice/ckobj_c.c deleted file mode 100644 index 6f27bc9fa8..0000000000 --- a/ext/spice/src/cspice/ckobj_c.c +++ /dev/null @@ -1,348 +0,0 @@ -/* - --Procedure ckobj_c ( CK objects ) - --Abstract - - Find the set of ID codes of all objects in a specified CK file. - --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 - - CELLS - CK - DAF - NAIF_IDS - SETS - --Keywords - - POINTING - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void ckobj_c ( ConstSpiceChar * ck, - SpiceCell * ids ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - ck I Name of CK file. - ids I/O Set of ID codes of objects in CK file. - --Detailed_Input - - ck is the name of a C-kernel. - - ids is an initialized CSPICE set data structure. - `ids' optionally may contain a set of ID codes on - input; on output, the data already present in - `ids' will be combined with ID code set found for the - file `ck'. - - If `ids' contains no data on input, its size and - cardinality still must be initialized. - --Detailed_Output - - ids is a CSPICE set data structure which contains - the union of its contents upon input with the set - of ID codes of each object for which pointing data - are present in the indicated CK file. The elements - of CSPICE sets are unique; hence each ID code in - `ids' appears only once, even if the CK file - contains multiple segments for that ID code. - - See the Examples section below for a complete - example program showing how to retrieve the ID - codes from `ids'. - --Parameters - - None. - --Exceptions - - 1) If the input file has transfer format, the error - SPICE(INVALIDFORMAT) is signaled. - - 2) If the input file is not a transfer file but has architecture - other than DAF, the error SPICE(BADARCHTYPE) is signaled. - - 3) If the input file is a binary DAF file of type other than - CK, the error SPICE(BADFILETYPE) is signaled. - - 4) If the CK file cannot be opened or read, the error will - be diagnosed by routines called by this routine. - - 5) If the size of the output set argument `ids' is insufficient to - contain the actual number of ID codes of objects covered by - the indicated CK file, the error will be diagnosed by - routines called by this routine. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input - string `ck' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `ck' is null. - --Files - - This routine reads a C-kernel. - --Particulars - - This routine provides an API via which applications can determine - the set of objects for which there are pointing data in a - specified CK file. - --Examples - - 1) Display the interval-level coverage for each object in a - specified CK file. Use tolerance of zero ticks. Do not request - angular velocity. Express the results in the TDB time system. - - Find the set of objects in the file. Loop over the contents of - the ID code set: find the coverage for each item in the set and - display the coverage. - - - #include - #include "SpiceUsr.h" - - int main() - { - - /. - Local parameters - ./ - #define FILSIZ 256 - #define MAXIV 100000 - #define WINSIZ ( 2 * MAXIV ) - #define TIMLEN 51 - #define MAXOBJ 1000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - SPICEINT_CELL ( ids, MAXOBJ ); - - SpiceChar ck [ FILSIZ ]; - SpiceChar lsk [ FILSIZ ]; - SpiceChar sclk [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt i; - SpiceInt j; - SpiceInt niv; - SpiceInt obj; - - - /. - Load a leapseconds kernel and SCLK kernel for output time - conversion. Note that we assume a single spacecraft clock is - associated with all of the objects in the CK. - ./ - prompt_c ( "Name of leapseconds kernel > ", FILSIZ, lsk ); - furnsh_c ( lsk ); - - prompt_c ( "Name of SCLK kernel > ", FILSIZ, sclk ); - furnsh_c ( sclk ); - - /. - Get name of CK file. - ./ - prompt_c ( "Name of CK file > ", FILSIZ, ck ); - - /. - Find the set of objects in the CK file. - ./ - ckobj_c ( ck, &ids ); - - /. - We want to display the coverage for each object. Loop over - the contents of the ID code set, find the coverage for - each item in the set, and display the coverage. - ./ - for ( i = 0; i < card_c( &ids ); i++ ) - { - /. - Find the coverage window for the current object. - Empty the coverage window each time so we don't - include data for the previous object. - ./ - obj = SPICE_CELL_ELEM_I( &ids, i ); - - scard_c ( 0, &cover ); - ckcov_c ( ck, obj, SPICEFALSE, - "INTERVAL", 0.0, "TDB", &cover ); - - /. - Get the number of intervals in the coverage window. - ./ - niv = wncard_c( &cover ); - - /. - Display a simple banner. - ./ - printf ( "%s\n", "========================================" ); - - printf ( "Coverage for object %ld\n", obj ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( j = 0; j < niv; j++ ) - { - /. - Get the endpoints of the jth interval. - ./ - wnfetd_c ( &cover, j, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.###### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - j, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.###### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - printf ( "%s\n", "========================================" ); - - } - return ( 0 ); - } - - --Restrictions - - 1) If an error occurs while this routine is updating the set - `ids', the set may be corrupted. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 30-NOV-2007 (NJB) - - Corrected bug in example program in header: - program now empties result window prior to collecting - data for each object. Updated example to use wncard_c - rather than card_c. - - -CSPICE Version 1.0.0, 30-DEC-2004 (NJB) - --Index_Entries - - find id codes in ck file - --& -*/ - -{ /* Begin ckobj_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "ckobj_c" ); - - /* - Check the input string `ck' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckobj_c", ck ); - - /* - Make sure cell data type is SpiceInt. - */ - CELLTYPECHK ( CHK_STANDARD, "ckobj_c", SPICE_INT, ids ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( ids ); - - /* - Call the f2c'd Fortran routine. - */ - ckobj_ ( ( char * ) ck, - ( integer * ) (ids->base), - ( ftnlen ) strlen(ck) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, ids ); - } - - - chkout_c ( "ckobj_c" ); - -} /* End ckobj_c */ diff --git a/ext/spice/src/cspice/ckopn.c b/ext/spice/src/cspice/ckopn.c deleted file mode 100644 index bcc23e7f41..0000000000 --- a/ext/spice/src/cspice/ckopn.c +++ /dev/null @@ -1,212 +0,0 @@ -/* ckopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKOPN ( CK, open new file. ) */ -/* Subroutine */ int ckopn_(char *name__, char *ifname, integer *ncomch, - integer *handle, ftnlen name_len, ftnlen ifname_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomr; - extern logical failed_(void); - extern /* Subroutine */ int dafonw_(char *, char *, integer *, integer *, - char *, integer *, integer *, ftnlen, ftnlen, ftnlen), chkout_( - char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open a new CK file, returning the handle of the opened file. */ - -/* $ 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 */ - -/* CK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of the CK file to be opened. */ -/* IFNAME I The internal filename for the CK. */ -/* NCOMCH I The number of characters to reserve for comments. */ -/* HANDLE O The handle of the opened CK file. */ - -/* $ Detailed_Input */ - -/* NAME The name of the CK file to be opened. */ - -/* IFNAME The internal filename for the CK file that is being */ -/* created. The internal filename may be up to 60 characters */ -/* long. If you do not have any conventions for tagging your */ -/* files, an internal filename of 'CK_file' is perfectly */ -/* acceptable. You may also leave it blank if you like. */ - -/* NCOMCH This is the space, measured in characters, to be */ -/* initially set aside for the comment area when a new CK */ -/* file is opened. The amount of space actually set aside */ -/* may be greater than the amount requested, due to the */ -/* manner in which comment records are allocated in an CK */ -/* file. However, the amount of space set aside for comments */ -/* will always be at least the amount that was requested. */ - -/* The value of NCOMCH should be greater than or equal to */ -/* zero, i.e., 0 <= NCOMCH. A negative value, should one */ -/* occur, will be assumed to be zero. */ - -/* $ Detailed_Output */ - -/* HANDLE The handle of the opened CK file. If an error occurs the */ -/* value of this variable will not represent a valid handle. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of NCOMCH is negative, a value of zero (0) will */ -/* be used for the number of comment characters to be set aside */ -/* for comments. */ - -/* 2) If an error occurs while attempting to open a CK file the */ -/* value of HANDLE will not represent a valid file handle. */ - -/* $ Files */ - -/* See NAME and HANDLE. */ - -/* $ Particulars */ - -/* Open a new CK file, reserving room for comments if requested. */ - -/* $ Examples */ - -/* Suppose that you want to create a new CK file called 'new.ck' */ -/* that contains a single type 3 CK segment and has room for at */ -/* least 5000 comment characters. The following code fragment should */ -/* take care of this for you, assuming that all of the variables */ -/* passed to the CK type 3 segment writer have appropriate values. */ - -/* NAME = 'new.ck' */ -/* IFNAME = 'Test CK file' */ - -/* CALL CKOPN ( NAME, IFNAME, 5000, HANDLE ) */ -/* CALL CKW03 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */ -/* . SEGID, NREC, SCLKDP, QUATS, AVVS, NINTS, */ -/* . STARTS ) */ -/* CALL CKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 09-NOV-2006 (NJB) */ - -/* Routine has been upgraded to support comment */ -/* area allocation using NCOMCH. */ - -/* - SPICELIB Version 1.0.0, 26-JAN-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a new ck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* DAF ND and NI values for CK files. */ - - -/* Length of a DAF comment record, in characters. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKOPN", (ftnlen)5); - -/* Compute the number of comment records that we want to allocate, if */ -/* the number of comment characters requested is greater than zero, */ -/* we always allocate an extra record to account for the end of line */ -/* marks in the comment area. */ - - if (*ncomch > 0) { - ncomr = (*ncomch - 1) / 1000 + 1; - } else { - ncomr = 0; - } - -/* Just do it. All of the error handling is taken care of for us. */ - - dafonw_(name__, "CK", &c__2, &c__6, ifname, &ncomr, handle, name_len, ( - ftnlen)2, ifname_len); - if (failed_()) { - -/* If we failed, make sure that HANDLE does not contain a value */ -/* that represents a valid DAF file handle. */ - - *handle = 0; - } - chkout_("CKOPN", (ftnlen)5); - return 0; -} /* ckopn_ */ - diff --git a/ext/spice/src/cspice/ckopn_c.c b/ext/spice/src/cspice/ckopn_c.c deleted file mode 100644 index 177eaab68b..0000000000 --- a/ext/spice/src/cspice/ckopn_c.c +++ /dev/null @@ -1,194 +0,0 @@ -/* - --Procedure ckopn_c ( CK, open new file. ) - --Abstract - - Open a new CK file, returning the handle of the opened file. - --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 - - CK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ckopn_c ( ConstSpiceChar * fname, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - fname I The name of the CK file to be opened. - ifname I The internal filename for the CK. - ncomch I The number of characters to reserve for comments. - handle O The handle of the opened CK file. - --Detailed_Input - - fname The name of the CK file to be opened. - - ifname The internal filename for the CK file that is being - created. The internal filename may be up to 60 characters - long. If you do not have any conventions for tagging your - files, an internal filename of "CK_file" is perfectly - acceptable. You may also leave it blank if you like. - - ncomch This is the space, measured in characters, to be - initially set aside for the comment area when a new CK - file is opened. The amount of space actually set aside - may be greater than the amount requested, due to the - manner in which comment records are allocated in an CK - file. However, the amount of space set aside for comments - will always be at least the amount that was requested. - - The value of ncomch should be greater than or equal to - zero, i.e., 0 <= ncomch. A negative value, should one - occur, will be assumed to be zero. - --Detailed_Output - - handle The handle of the opened CK file. If an error occurs the - value of this variable will not represent a valid handle. - --Parameters - - None. - --Exceptions - - 1) If the value of ncomch is negative, a value of zero will - be used for the number of comment characters to be set aside - for comments. - - 2) If an error occurs while attempting to open a CK file the - value of handle will not represent a valid file handle. - --Files - - See fname and handle. - --Particulars - - Open a new CK file, reserving room for comments if requested. - --Examples - - Suppose that you want to create a new CK file called "new.ck" - that contains a single type 3 CK segment and has room for at - least 5000 comment characters. The following code fragment should - take care of this for you, assuming that all of the variables - passed to the CK type 3 segment writer have appropriate values. - - fname = "new.ck"; - ifname = "Test CK file"; - - ckopn_c ( fname, ifname, 5000, &handle ); - - ckw03_c ( handle, begtim, endtim, inst, - ref, avflag, segid, nrec, - sclkdp, quats, avvs, nints, starts ); - - ckcls_c ( handle ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.1, 09-NOV-2006 (NJB) - - Header comments indicating that `ncomch' is ignored have - been deleted. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.0, 26-JAN-1995 (KRG) - --Index_Entries - - open a new ck file - --& -*/ - -{ /* Begin ckopn_c */ - - /* - Participate in error handling. - */ - chkin_c ( "ckopn_c" ); - - /* - Check the input strings fname and ifname to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckopn_c", fname ); - CHKFSTR ( CHK_STANDARD, "ckopn_c", ifname ); - - - ckopn_ ( ( char * ) fname, - ( char * ) ifname, - ( integer * ) &ncomch, - ( integer * ) handle, - ( ftnlen ) strlen(fname), - ( ftnlen ) strlen(ifname) ); - - - chkout_c ( "ckopn_c" ); - -} /* End ckopn_c */ diff --git a/ext/spice/src/cspice/ckpfs.c b/ext/spice/src/cspice/ckpfs.c deleted file mode 100644 index 24cf5c9242..0000000000 --- a/ext/spice/src/cspice/ckpfs.c +++ /dev/null @@ -1,622 +0,0 @@ -/* ckpfs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKPFS ( C-kernel, get pointing from segment ) */ -/* Subroutine */ int ckpfs_(integer *handle, doublereal *descr, doublereal * - sclkdp, doublereal *tol, logical *needav, doublereal *cmat, - doublereal *av, doublereal *clkout, logical *found) -{ - extern /* Subroutine */ int cke01_(logical *, doublereal *, doublereal *, - doublereal *, doublereal *), cke02_(logical *, doublereal *, - doublereal *, doublereal *, doublereal *), cke03_(logical *, - doublereal *, doublereal *, doublereal *, doublereal *), cke04_( - logical *, doublereal *, doublereal *, doublereal *, doublereal *) - , cke05_(logical *, doublereal *, doublereal *, doublereal *, - doublereal *), ckr01_(integer *, doublereal *, doublereal *, - doublereal *, logical *, doublereal *, logical *), ckr02_(integer - *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *), ckr03_(integer *, doublereal *, doublereal *, - doublereal *, logical *, doublereal *, logical *), ckr04_(integer - *, doublereal *, doublereal *, doublereal *, logical *, - doublereal *, logical *), ckr05_(integer *, doublereal *, - doublereal *, doublereal *, logical *, doublereal *, logical *); - integer type__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - doublereal record[228]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Evaluate pointing data from a segment for a given time. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I CK file handle. */ -/* DESCR I Segment descriptor. */ -/* SCLKDP I Spacecraft clock time. */ -/* TOL I Time tolerance. */ -/* NEEDAV I True when angular velocity data is requested. */ -/* CMAT O C-matrix. */ -/* AV O Angular velocity vector. */ -/* CLKOUT O Output spacecraft clock time. */ -/* FOUND O True when requested pointing is available. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the binary CK file containing the */ -/* desired segment. The file should have been opened */ -/* for read access, either by CKLPF or DAFOPR. */ - -/* DESCR is the packed descriptor of the segment. */ - -/* SCLKDP is the encoded spacecraft clock time for which */ -/* pointing is desired. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. The C-matrix returned by */ -/* CKPFS is the one whose time is closest to SCLKDP and */ -/* within TOL units of SCLKDP. */ - -/* NEEDAV is true when angular velocity data is requested. */ - - -/* $ Detailed_Output */ - -/* CMAT is a rotation matrix that transforms the components of */ -/* of a vector expressed in the inertial frame given in */ -/* the segment to components expressed in the instrument */ -/* fixed frame at time CLKOUT. */ - -/* Thus, if a vector v has components x, y, z in the */ -/* inertial frame, then v has components x', y', z' in */ -/* the instrument fixed frame at time CLKOUT: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* If the x', y', z' components are known, use the */ -/* transpose of the C-matrix to determine x, y, z as */ -/* follows. */ - -/* [ x ] [ ]T [ x' ] */ -/* | y | = | CMAT | | y' | */ -/* [ z ] [ ] [ z' ] */ -/* (Transpose of CMAT) */ - -/* AV is the angular velocity vector. This is returned only */ -/* if it has been requested, as indicated by NEEDAV. In */ -/* other words, if NEEDAV is true, then the pointing */ -/* records in the segment must contain AV data. */ - -/* The angular velocity vector is the right-handed axis */ -/* about which the reference frame tied to the instrument */ -/* is instantaneously rotating at time CLKOUT. The */ -/* magnitude of AV is the magnitude of the instantaneous */ -/* velocity of the rotation, in radians per second. */ - -/* The components of AV are given relative to the */ -/* reference frame specified in the segment descriptor. */ - -/* CLKOUT is the encoded spacecraft clock time associated with */ -/* the returned C-matrix and, optionally, the returned */ -/* angular velocity vector. */ - -/* FOUND is true if a C-matrix and an angular velocity vector */ -/* (if requested) were found to satisfy the pointing */ -/* request. FOUND will be false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the data type of the segment is not one of those supported */ -/* by this routine, the error SPICE(CKUNKNOWNDATATYPE) is */ -/* signalled. */ - -/* 2) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 3) If DESCR is not a valid, packed descriptor of a segment in */ -/* the CK file specified by HANDLE, the results of this routine */ -/* are unpredictable. */ - -/* 4) If TOL is negative, FOUND is false. */ - -/* 5) If NEEDAV is true, but the segment doesn't contain AV data, */ -/* an error is signalled by a routine that this routine calls. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The structure of this routine is just a big case statement. Each */ -/* segment data type is supported by two routines: */ - -/* CKRnn which reads a single logical pointing record from a */ -/* segment of type nn. (A logical record is defined as */ -/* a collection of numbers sufficient to determine the */ -/* C-matrix, and optionally the angular velocity vector, */ -/* at the input time.) */ - -/* CKEnn which evaluates the pointing record returned by CKRnn */ -/* to give the C-matrix and optionally the angular */ -/* velocity vector at the input time. */ - -/* The data type is determined from the segment descriptor, and the */ -/* appropriate routines are called. */ - -/* $ Examples */ - -/* CKPFS allows you to be more selective than CKGP or CKGPAV about */ -/* choosing segments to satisfy CK pointing requests. */ - -/* Suppose MOC.BC is a CK file consisting of several segments */ -/* containing Mars Observer Camera pointing data. Each segment */ -/* covers the same time period, but produces different pointing */ -/* values (one segment may contain predict values, another may */ -/* contain telemetry-based values, and others may contain different */ -/* corrected versions). */ - -/* The following code fragment shows how different the results are */ -/* for each segment. The program steps through the file segment by */ -/* segment and requests pointing for the same time from each */ -/* segment. The results are printed to the screen. */ - -/* GETIME is an imaginary routine used to get an encoded SCLK time */ -/* (SCLKDP) and time tolerance from the user. */ - -/* SC = -94 */ -/* INST = -94001 */ -/* NEEDAV = .TRUE. */ - -/* CALL CKLPF ( 'MOC.BC', HANDLE ) */ - -/* CALL GETIME ( SCLKDP, TOL, QUIT ) */ - -/* C */ -/* C For each time, begin a forward search through the file, and */ -/* C for each segment found, get its descriptor, identifier, and */ -/* C evaluate the pointing. */ -/* C */ -/* DO WHILE ( .NOT. QUIT ) */ - -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ - -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFGN ( IDENT ) */ - -/* CALL CKPFS ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . CMAT, AV, CLKOUT, PFOUND ) */ - -/* IF ( PFOUND ) THEN */ -/* WRITE (*,*) 'Segment: ', IDENT */ -/* WRITE (*,*) 'C-Matrix: ', CMAT */ -/* WRITE (*,*) 'Angular velocity: ', AV */ - -/* ELSE */ -/* CALL SCDECD ( SC, SCLKDP, SCLKCH ) */ -/* WRITE (*,*) 'Data not found at time ', SCLKCH */ - -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ - -/* END DO */ - -/* CALL GETIME ( SCLKDP, TOL, QUIT ) */ - -/* END DO */ - - -/* $ Restrictions */ - -/* A C-kernel file should have been loaded by either CKLPF */ -/* or DAFOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.0.0, 19-AUG-2002 (NJB) */ - -/* The routine was updated to handle data type 5 segments. */ - -/* - SPICELIB Version 4.0.0, 02-MAY-1999 (BVS) */ - -/* The routine was updated to handle data type 4 segments. */ -/* The RECSIZ size parameter was eliminated. The dimension */ -/* of the RECORD buffer is now defined by the CKMRSZ parameter */ -/* specified in the 'ckparam.inc' include file. */ - -/* - SPICELIB Version 3.0.0, 11-SEP-1992 (JML) */ - -/* The routine was updated to handle data type 3 segments. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */ - -/* The routine was updated to handle data type 2 segments. */ - -/* FOUND is now initialized to false. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get pointing from ck segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.0.0, 19-AUG-2002 (NJB) */ - -/* The routine was updated to handle data type 5 segments. */ - -/* - SPICELIB Version 4.0.0, 02-MAY-1999 (BVS) */ - -/* The routine was updated to handle data type 4 segments. */ - -/* a) 'ckparam.inc' include file was included. */ - -/* b) RECSIZ size parameter was eliminated. */ - -/* c) Size of the RECORD was reset to CKMRSZ, parameter */ -/* defined in the 'ckparam.inc' include file. */ - -/* d) Calls to CKR04 and CKE04 were added to the case */ -/* statement. */ - -/* - SPICELIB Version 3.0.0, 11-SEP-1992 (JML) */ - -/* The routine was updated to handle data type 3 segments. */ - -/* a) RECSIZ was increased to 17. */ - -/* b) Calls to CKR03 and CKE03 were added to the case */ -/* statement. */ - -/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */ - -/* 1) The routine was updated to handle data type 2 segments. */ - -/* 2) FOUND is initialized to false to guard against it being */ -/* left unchanged from its previous value when an error is */ -/* detected. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* 1) The restriction that a C-kernel file must be loaded */ -/* was explicitly stated. */ - -/* - Beta Version 1.1.0, 30-AUG-1990 (MJS) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable SCLK was changed to SCLKDP. */ -/* 2) The declarations for the parameters RECSIZ, NDC, and NIC */ -/* were moved from the "Declarations" section of the header */ -/* to the "Local parameters" section of the code below the */ -/* header. These parameters are not meant to modified by */ -/* users. */ -/* 3) The header was updated. */ -/* 4) The comments in the code were improved. */ - -/* - Beta Version 1.0.0, 07-MAY-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKPFS", (ftnlen)5); - } - -/* Start off with FOUND set to false. This guards against FOUND */ -/* being left unchanged from a previous call if any errors are */ -/* detected. */ - - *found = FALSE_; - -/* Upgrading CKPFS to accommodate new data types involves following */ -/* these steps: */ - -/* 1) Write the two new routines CKRnn and CKEnn. (You may need to */ -/* add or subtract from the arguments used in the existing CKRnn */ -/* and CKEnn calling sequences, but should not have to change */ -/* the inputs or outputs to CKPFS.) */ - -/* 2) Insert a new case into the code of CKPFS. */ - -/* 3) Depending on the size of RECORD returned from CKRnn, modify */ -/* the parameter RECSIZ. (You will only need to change it if */ -/* RECSIZ is not large enough for the new CKRnn's RECORD.) */ - - -/* Unpack the descriptor to see what the data type of the segment is, */ -/* and call the appropriate read-and-evaluate routines. */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - type__ = icd[2]; - if (type__ == 1) { - ckr01_(handle, descr, sclkdp, tol, needav, record, found); - if (*found) { - cke01_(needav, record, cmat, av, clkout); - } - } else if (type__ == 2) { - ckr02_(handle, descr, sclkdp, tol, record, found); - if (*found) { - cke02_(needav, record, cmat, av, clkout); - } - } else if (type__ == 3) { - ckr03_(handle, descr, sclkdp, tol, needav, record, found); - if (*found) { - cke03_(needav, record, cmat, av, clkout); - } - } else if (type__ == 4) { - ckr04_(handle, descr, sclkdp, tol, needav, record, found); - if (*found) { - cke04_(needav, record, cmat, av, clkout); - } - } else if (type__ == 5) { - ckr05_(handle, descr, sclkdp, tol, needav, record, found); - if (*found) { - cke05_(needav, record, cmat, av, clkout); - } - } else { - setmsg_("The data type # is not currently supported.", (ftnlen)43); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(CKUNKNOWNDATATYPE)", (ftnlen)24); - } - chkout_("CKPFS", (ftnlen)5); - return 0; -} /* ckpfs_ */ - diff --git a/ext/spice/src/cspice/ckr01.c b/ext/spice/src/cspice/ckr01.c deleted file mode 100644 index fc54944c82..0000000000 --- a/ext/spice/src/cspice/ckr01.c +++ /dev/null @@ -1,602 +0,0 @@ -/* ckr01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKR01 ( C-kernel, read pointing record, data type 1 ) */ -/* Subroutine */ int ckr01_(integer *handle, doublereal *descr, doublereal * - sclkdp, doublereal *tol, logical *needav, doublereal *record, logical - *found) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec, ndir, skip, psiz, i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer group; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal buffer[100]; - integer remain, dirloc; - extern integer lstcld_(doublereal *, integer *, doublereal *), lstled_( - doublereal *, integer *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer grpndx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6], end; - logical fnd; - -/* $ Abstract */ - -/* Read a pointing record from a CK segment, data type 1. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* SCLKDP I Spacecraft clock time. */ -/* TOL I Time tolerance. */ -/* NEEDAV I True when angular velocity data is requested. */ -/* RECORD O Pointing data record. */ -/* FOUND O True when data is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the integer handle of the CK file containing the */ -/* segment. */ - -/* DESCR is the descriptor of the segment. */ - -/* SCLKDP is an encoded spacecraft clock time for which */ -/* pointing is being requested. The SPICELIB routines */ -/* SCENCD and SCDECD are used to encode and decode SCLK */ -/* times. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* The record returned by CKR01 is the one whose time is */ -/* closest to SCLKDP and within TOL units of SCLKDP. */ - -/* NEEDAV is true when angular velocity data is requested. */ - - -/* $ Detailed_Output */ - -/* RECORD is the pointing record. Contents are as follows: */ - -/* RECORD( 1 ) = CLKOUT */ - -/* RECORD( 2 ) = q0 */ -/* RECORD( 3 ) = q1 */ -/* RECORD( 4 ) = q2 */ -/* RECORD( 5 ) = q3 */ - -/* RECORD( 6 ) = Av1 ] */ -/* RECORD( 7 ) = Av2 |-- Returned optionally */ -/* RECORD( 8 ) = Av3 ] */ - -/* CLKOUT is the encoded spacecraft clock time for the */ -/* returned pointing values. CLKOUT will be the closest */ -/* time in the segment to the input time as long as it is */ -/* within the input tolerance (see FOUND below). If SCLKDP */ -/* falls at the exact midpoint of two times, the record */ -/* for the greater of the two will be returned. */ - -/* The quantities q0 - q3 represent a quaternion. */ -/* The quantities Av1, Av2, and Av3 represent the angular */ -/* velocity vector, and are returned if the segment */ -/* contains angular velocity data and NEEDAV is true. */ -/* The components of the angular velocity vector are */ -/* specified relative to the inertial reference frame */ -/* for the segment. */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. FOUND will be false when there is no pointing */ -/* instance within the segment whose time falls within */ -/* the requested time tolerance on either side of the */ -/* input time. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 2) If DESCR is not a valid, packed descriptor of a segment in */ -/* the CK file specified by HANDLE, the results of this routine */ -/* are unpredictable. */ - -/* 3) If the segment is not of data type 1, as specified in the */ -/* third integer component of the segment descriptor, then */ -/* the error SPICE(WRONGDATATYPE) is signalled. */ - -/* 4) If there is a need for angular velocity data and the segment */ -/* contains no such data, the error SPICE(NOAVDATA) is signalled. */ - -/* $ Files */ - -/* The file containing the segment is specified by its handle, and */ -/* should be opened for read, either by CKLPF or DAFOPR. */ - -/* $ Particulars */ - -/* See the CK Required Reading file for a detailed description of */ -/* the structure of a type 1 pointing segment. */ - -/* This routine searches a type 1 segment for the pointing instance */ -/* whose associated time is closest to the time that pointing was */ -/* requested for. If this time is within the tolerance specified by */ -/* the user, it sets FOUND equal to true and returns information in */ -/* the array RECORD that CKE01 uses to evaluate the pointing at the */ -/* time CLKOUT. */ - -/* $ Examples */ - -/* The CKRnn routines are usually used in tandem with the CKEnn */ -/* routines, which evaluate the record returned by CKRnn to give */ -/* the pointing information and output time. */ - -/* The following code fragment searches through a file (represented */ -/* by HANDLE) for all segments applicable to the Voyager 2 wide angle */ -/* camera, for a particular spacecraft clock time, which have data */ -/* type 1. It then evaluates the pointing for that epoch and prints */ -/* the result. */ - -/* C */ -/* C - Get the spacecraft clock time. Must encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* C - Set the time tolerance high to catch anything close to */ -/* C the input time. */ -/* C */ -/* C - We don't need angular velocity data. */ -/* C */ -/* SC = -32 */ -/* INST = -32002 */ -/* TOL = 1000.D0 */ -/* NEEDAV = .FALSE. */ -/* DTYPE = 1 */ -/* C */ -/* C Load the Voyager 2 spacecraft clock kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'VGR_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'VGR2_CK.BC', HANDLE ) */ -/* C */ -/* C Convert the input request time to ticks. */ -/* C */ -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ - -/* C */ -/* C Search from the beginning through all segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* DO WHILE ( SFND ) */ - -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* IF ( INST .EQ. ICD( 1 ) .AND. */ -/* . DTYPE .EQ. ICD( 3 ) .AND. */ -/* . SCLKDP + TOL .GE. DCD( 1 ) .AND. */ -/* . SCLKDP - TOL .LE. DCD( 2 ) ) THEN */ - -/* CALL CKR01 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* CALL CKE01 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */ - -/* WRITE (*,*) 'Segment descriptor and identifier:' */ -/* WRITE (*,*) DCD, ICD */ -/* WRITE (*,*) IDENT */ - -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) CMAT */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The file containing the segment should be opened for read, */ -/* either by CKLPF or DAFOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* J.E. McLean (JPL) */ -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 30-AUG-1991 (JML) */ - -/* This routine now checks the segment descriptor to */ -/* determine if it has been given a type 1 segment. */ - -/* The FOUND flag is set to FALSE at the beginning of */ -/* the routine. */ - -/* The particulars section was changed to provide a more */ -/* general description of the function of this routine. The */ -/* information that was originally in Particulars was moved */ -/* to the body of the code. */ - -/* The example program was changed so that the tolerance */ -/* and data type are used in selecting which segments to read. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* The example program was corrected so that the input */ -/* instrument code was tested against ICD(1) instead of */ -/* ICD(3). */ - -/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read ck type_1 pointing data record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */ - -/* 1) This routine now checks the segment descriptor, ICD(3), */ -/* to determine if it has been given a type 1 segment. */ - -/* 2) The FOUND flag is set to FALSE at the beginning of */ -/* the routine. This is done so that if a SPICE error */ -/* is signalled, the FOUND flag will definitely be false. */ - -/* 3) The particulars section was changed to provide a more */ -/* general description of the function of this routine. The */ -/* information that was originally in Particulars was moved */ -/* to the body of the code. */ - -/* 4) The example program was changed so that the tolerance */ -/* and data type are used in selecting which segments to read. */ - -/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */ - -/* 1) The example program was corrected so that the input */ -/* instrument code was tested against ICD(1) instead of */ -/* ICD(3). */ -/* 2) ROTATIONS was removed from the Required Reading section. */ - -/* - Beta Version 1.1.0, 29-AUG-1990 (MJS) (JEM) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The variable SCLK was changed to SCLKDP. */ -/* 2) The declarations for the parameters QSIZ, QAVSIZ, NDC, and */ -/* NIC were moved from the "Declarations" section of the */ -/* header to the "Local parameters" section of the code below */ -/* the header. These parameters are not meant to modified by */ -/* users. */ -/* 3) The variable DIRSIZ has been parameterized in the code */ -/* following the header. DIRSIZ is still 100. */ -/* 5) The header was improved and updated to reflect the changes. */ -/* 6) The in-code comments were improved. */ - -/* - Beta Version 1.0.0, 17-MAY-1990 (RET) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* DIRSIZ is the directory size. */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* QSIZ is the number of double precision numbers making up */ -/* the quaternion portion of a pointing record. */ - -/* QAVSIZ is the number of double precision numbers making up */ -/* the quaternion and angular velocity portion of a */ -/* pointing record. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKR01", (ftnlen)5); - } - -/* To minimize the number of file reads performed during the search, */ -/* a buffer of 100 double precision numbers is used to read the SCLK */ -/* times from the C-kernel. If there are 10,001 or fewer pointing */ -/* records, at most four reads will be needed to satisfy the request: */ -/* one to read NREC, one to read in 100 or fewer directory times, */ -/* one to read 100 or fewer actual times, and then after the */ -/* appropriate record has been located, one to read the quaternion */ -/* and angular velocity data. */ - -/* One more read would be required for every other group of 10,000 */ -/* records in the segment. */ - - -/* Start off with FOUND set to FALSE. */ - - *found = FALSE_; - -/* We need to look at a few of the descriptor components. */ - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* Check to make sure that the segment is type 1. */ - - if (icd[2] != 1) { - setmsg_("The segment is not a type 1 segment. Type is #", (ftnlen)47) - ; - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("CKR01", (ftnlen)5); - return 0; - } - -/* The size of the record returned depends on whether or not the */ -/* segment contains angular velocity data. */ - -/* This is a convenient place to check if the need for angular */ -/* velocity data matches the availability. */ - - if (icd[3] == 1) { - psiz = 7; - } else { - psiz = 4; - if (*needav) { - setmsg_("Segment does not contain angular velocity data.", ( - ftnlen)47); - sigerr_("SPICE(NOAVDATA)", (ftnlen)15); - chkout_("CKR01", (ftnlen)5); - return 0; - } - } - -/* The beginning and ending addresses of the segment are in the */ -/* descriptor. */ - - beg = icd[4]; - end = icd[5]; - -/* Get the number of records in this segment, and from that determine */ -/* the number of directory epochs. */ - - dafgda_(handle, &end, &end, buffer); - nrec = (integer) buffer[0]; - ndir = (nrec - 1) / 100; - -/* The directory epochs narrow down the search to a group of DIRSIZ */ -/* or fewer records. The way the directory is constructed guarantees */ -/* that we will definitely find the closest time in the segment to */ -/* SCLKDP in the indicated group. */ - -/* There is only one group if there are no directory epochs. */ - - if (ndir == 0) { - group = 1; - } else { - -/* Compute the location of the first directory epoch. From the */ -/* beginning of the segment, need to go through all of the */ -/* pointing numbers (PSIZ*NREC of them), then through all of */ -/* the SCLKDP times (NREC more) to get to the first SCLK */ -/* directory. */ - - dirloc = beg + (psiz + 1) * nrec; - -/* Locate the first directory epoch greater than SCLKDP. Read in */ -/* as many as DIRSIZ directory epochs at a time for comparison. */ - - fnd = FALSE_; - remain = ndir; - group = 0; - while(! fnd) { - -/* The number of records to read in the buffer. */ - - n = min(remain,100); - i__1 = dirloc + n - 1; - dafgda_(handle, &dirloc, &i__1, buffer); - remain -= n; - -/* If we find the first directory time greater than or equal */ -/* to the epoch, we're done. */ - -/* If we reach the end of the directories, and still haven't */ -/* found one bigger than the epoch, the group is the last group */ -/* in the segment. */ - -/* Otherwise keep looking. */ - - i__ = lstled_(sclkdp, &n, buffer); - if (i__ < n) { - group = group + i__ + 1; - fnd = TRUE_; - } else if (remain == 0) { - group = ndir + 1; - fnd = TRUE_; - } else { - dirloc += n; - group += n; - } - } - } - -/* Now we know which group of DIRSIZ (or less) times to look at. */ -/* Out of the NREC SCLKDP times, the number that we should skip over */ -/* to get to the proper group is DIRSIZ*( GROUP - 1 ). */ - - skip = (group - 1) * 100; - -/* From this we can compute the index into the segment of the group */ -/* of times we want. From the beginning, need to pass through */ -/* PSIZ*NREC pointing numbers to get to the first SCLKDP time. */ -/* Then we skip over the number just computed above. */ - - grpndx = beg + nrec * psiz + skip; - -/* The number of times that we have to look at may be less than */ -/* DIRSIZ. However many there are, go ahead and read them into the */ -/* buffer. */ - -/* Computing MIN */ - i__1 = 100, i__2 = nrec - skip; - n = min(i__1,i__2); - i__1 = grpndx + n - 1; - dafgda_(handle, &grpndx, &i__1, buffer); - -/* Find the time in the group closest to the input time, and see */ -/* if it's within tolerance. */ - - i__ = lstcld_(sclkdp, &n, buffer); - if ((d__1 = *sclkdp - buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr01_", (ftnlen)625)], abs(d__1)) > *tol) - { - chkout_("CKR01", (ftnlen)5); - return 0; - } - -/* Now we know the exact record that we want. */ - -/* RECORD( 1 ) holds CLKOUT. */ - - *found = TRUE_; - record[0] = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "buffer", i__1, "ckr01_", (ftnlen)638)]; - -/* We need the Ith pointing record out of this group of DIRSIZ. */ -/* This group of DIRSIZ is SKIP records into the beginning */ -/* of the segment. And each record is PSIZ big. */ - - n = beg + psiz * (skip + i__ - 1); - i__1 = n + psiz - 1; - dafgda_(handle, &n, &i__1, &record[1]); - -/* That is all. */ - - chkout_("CKR01", (ftnlen)5); - return 0; -} /* ckr01_ */ - diff --git a/ext/spice/src/cspice/ckr02.c b/ext/spice/src/cspice/ckr02.c deleted file mode 100644 index 9884f41f10..0000000000 --- a/ext/spice/src/cspice/ckr02.c +++ /dev/null @@ -1,659 +0,0 @@ -/* ckr02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__7 = 7; - -/* $Procedure CKR02 ( C-kernel, read pointing record, data type 2 ) */ -/* Subroutine */ int ckr02_(integer *handle, doublereal *descr, doublereal * - sclkdp, doublereal *tol, doublereal *record, logical *found) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec; - doublereal prec[8]; - integer ndir, skip; - doublereal diff1, diff2; - integer i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer index; - extern /* Subroutine */ int vequg_(doublereal *, integer *, doublereal *); - integer group; - doublereal start, stopi; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal buffer[100]; - integer remain, dirloc; - extern integer lstled_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal clkout; - integer grpndx; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer stploc; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer arrsiz; - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6], end; - logical fnd; - -/* $ Abstract */ - -/* Read a pointing record from a CK segment, data type 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* SCLKDP I Spacecraft clock time. */ -/* TOL I Time tolerance */ -/* RECORD O Pointing data record. */ -/* FOUND O True when data is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the integer handle of the CK file containing the */ -/* segment. */ - -/* DESCR is the descriptor of the segment. */ - -/* SCLKDP is the encoded spacecraft clock time for which */ -/* pointing is being requested. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* When SCLKDP falls within the bounds of one of the */ -/* intervals then the tolerance has no effect. However, */ -/* if the request time is not in one of the intervals */ -/* then the tolerance is used to determine if pointing */ -/* at one of the interval endpoints should be returned. */ - -/* $ Detailed_Output */ - -/* RECORD is the pointing record. Contents are as follows: */ - -/* RECORD( 1 ) = Start time of interval. */ -/* RECORD( 2 ) = Time for which pointing was found. */ -/* RECORD( 3 ) = Seconds per tick rate. */ - -/* RECORD( 4 ) = q0 */ -/* RECORD( 5 ) = q1 */ -/* RECORD( 6 ) = q2 */ -/* RECORD( 7 ) = q3 */ - -/* RECORD( 8 ) = av1 */ -/* RECORD( 9 ) = av2 */ -/* RECORD( 10 ) = av3 */ - -/* The quantities q0 - q3 are the components of the */ -/* quaternion that represents the C-matrix associated with */ -/* the start time of the interval. The quantities av1, */ -/* av2, and av3 represent the angular velocity vector of */ -/* the interval. The components of the angular velocity */ -/* vector are specified relative to the inertial reference */ -/* frame of the segment. */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, an error is diagnosed by a */ -/* routine that this routine calls. */ - -/* 2) If DESCR is not a valid, packed descriptor of a segment in */ -/* the CK file specified by HANDLE, the results of this routine */ -/* are unpredictable. */ - -/* 3) If the segment is not of data type 2, as specified in the */ -/* third integer component of the segment descriptor, then */ -/* the error SPICE(WRONGDATATYPE) is signalled. */ - -/* $ Files */ - -/* The file containing the segment is specified by its handle, and */ -/* should be opened for read, either by CKLPF or DAFOPR. */ - -/* $ Particulars */ - -/* See the CK Required Reading file for a detailed description of */ -/* the structure of a type 2 pointing segment. */ - -/* This routine searches a type 2 segment and determines if the */ -/* request for pointing can be satisfied by the segment. If so, */ -/* then it returns information in the array RECORD that CKE02 uses */ -/* to evaluate the pointing at the time for which pointing was found. */ - -/* When the time for which pointing was requested falls within one */ -/* of the intervals then the returned time is the same as the */ -/* requested time. However, when the request time is not within any */ -/* of the intervals then the returned time will be the interval */ -/* endpoint closest to the request time, provided that endpoint is */ -/* within the tolerance specified by the user. */ - - -/* $ Examples */ - -/* The CKRnn routines are usually used in tandem with the CKEnn */ -/* routines, which evaluate the record returned by CKRnn to give */ -/* the pointing information and output time. */ - -/* The following code fragment searches through a file (attached to */ -/* HANDLE) for all segments applicable to the Voyager 2 wide angle */ -/* camera, for a particular spacecraft clock time, that are of data */ -/* types 1 or 2. It then evaluates the pointing for that epoch and */ -/* prints the result. */ - - -/* SC = -32 */ -/* INST = -32002 */ -/* C */ -/* C Load the Voyager 2 spacecraft clock kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'VGR_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'VGR2_CK.BC', HANDLE ) */ -/* C */ -/* C Get the spacecraft clock time. Must encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ - -/* C */ -/* C Search from the beginning through all segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* DO WHILE ( SFND ) */ - -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* IF ( INST .EQ. ICD( 1 ) .AND. */ -/* . SCLKDP + TOL .GE. DCD( 1 ) .AND. */ -/* . SCLKDP - TOL .LE. DCD( 2 ) ) THEN */ - -/* DTYPE = ICD ( 3 ) */ - -/* IF ( DTYPE .EQ. 1 ) THEN */ - -/* CALL CKR01 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* CALL CKE01 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */ -/* END IF */ - -/* ELSE IF ( DTYPE .EQ. 2 ) THEN */ - -/* CALL CKR02 ( HANDLE, DESCR, SCLKDP, TOL, */ -/* . RECORD, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* CALL CKE02 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */ -/* END IF */ - -/* END IF */ - -/* IF ( FOUND ) THEN */ - -/* WRITE (*,*) 'Segment descriptor and identifier:' */ -/* WRITE (*,*) DCD, ICD */ -/* WRITE (*,*) IDENT */ - -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) CMAT */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The file containing the segment should be opened for read, */ -/* either by CKLPF or DAFOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - 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, 30-AUG-1991 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* read ck type_2 pointing data record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* DIRSIZ is the directory size. */ - -/* NDC is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NIC is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* PSIZ is the number of double precision numbers making up */ -/* the record containing the quaternion, angular */ -/* velocity vector, and seconds per tick rate. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKR02", (ftnlen)5); - } - -/* To minimize the number of file reads performed during the search, */ -/* a buffer of 100 double precision numbers is used to read the SCLK */ -/* times from the C-kernel. If there are 10,001 or fewer pointing */ -/* records, at most four reads will be needed to satisfy the request: */ -/* one to read in 100 or fewer directory times, one to read 100 or */ -/* fewer interval start times, one to read from the stop times, and */ -/* then, after the appropriate record has been located, one to read */ -/* the pointing record. */ - -/* One more read would be required for every other group of 10,000 */ -/* records in the segment. */ - - -/* Start off with FOUND equal to false. */ - - *found = FALSE_; - -/* We need to look at a few of the descriptor components. */ - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* Check to make sure that the segment is type 2. */ - - if (icd[2] != 2) { - setmsg_("The segment is not a type 2 segment. Type is #", (ftnlen)47) - ; - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("CKR02", (ftnlen)5); - return 0; - } - -/* The beginning and ending addresses of the segment are in the */ -/* descriptor. */ - - beg = icd[4]; - end = icd[5]; - -/* Get the number of records in this segment, and from that determine */ -/* the number of directory epochs. */ - - -/* Based on the structure of a type 2 segment, the size of a */ -/* segment with N pointing intervals is given as follows: */ - -/* ARRSIZ = PSIZ * N + 2 * N + ( N-1 ) / 100 (1) */ - -/* In the above equation PSIZ is eight and integer arithmetic is */ -/* used. This equation is equivalent to: */ - - -/* 100 * ARRSIZ = 1000 * N + ( N-1 ) * 100 (2) */ -/* ------- */ -/* 100 */ - -/* If we can eliminate the integer division then, since all of */ -/* the other values represent whole numbers, we can solve the */ -/* equation for N in terms of ARRSIZ by using double precision */ -/* arithmetic and then rounding the result to the nearest integer. */ - -/* This next equation uses double precision arithmetic and is */ -/* equivalent to (2): */ - -/* 100 * ARRSIZ = 1000 * N + ( N-1 ) - ( N-1 ) MOD 100 (3) */ - -/* Which means: */ - -/* 100 * ARRSIZ + 1 ( N-1 ) MOD 100 */ -/* ---------------- + --------------- = N (4) */ -/* 1001 1001 */ - -/* Since the second term on the left side of (4) is always less */ -/* than 0.1, the first term will always round to the correct */ -/* value of N. */ - - arrsiz = end - beg + 1; - d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.; - nrec = i_dnnt(&d__1); - ndir = (nrec - 1) / 100; - -/* The directory epochs narrow down the search to a group of DIRSIZ */ -/* or fewer records. */ - -/* There is only one group if there are no directory epochs. */ - - if (ndir == 0) { - group = 1; - } else { - -/* Compute the location of the first directory epoch. From the */ -/* beginning of the segment, we need to go through all of the */ -/* pointing numbers (PSIZ*NREC of them), then through all of */ -/* the SCLK start and stop times (2*NREC more) to get to the */ -/* first SCLK directory. */ - - dirloc = beg + nrec * 10; - -/* Locate the last directory epoch less than or equal to SCLKDP. */ - -/* Read in as many as DIRSIZ directory epochs at a time for */ -/* comparison. */ - - fnd = FALSE_; - remain = ndir; - group = 0; - while(! fnd) { - -/* The number of records to read in the buffer. */ - - n = min(remain,100); - i__1 = dirloc + n - 1; - dafgda_(handle, &dirloc, &i__1, buffer); - remain -= n; - -/* Determine the last directory element in BUFFER that's less */ -/* than or equal to SCLKDP. */ - -/* If we reach the end of the directories, and still haven't */ -/* found one bigger than the epoch, the group is the last group */ -/* in the segment. */ - -/* Otherwise keep looking. */ - - i__ = lstled_(sclkdp, &n, buffer); - if (i__ < n) { - group = group + i__ + 1; - fnd = TRUE_; - } else if (remain == 0) { - group = ndir + 1; - fnd = TRUE_; - } else { - dirloc += n; - group += n; - } - } - } - -/* Now we know which group of DIRSIZ (or less) times to look at. */ -/* Out of the NREC START times, the number that we should skip over */ -/* to get to the proper group is DIRSIZ*( GROUP - 1 ). */ - - skip = (group - 1) * 100; - -/* From this we can compute the index into the segment of the group */ -/* of times we want. From the beginning, we need to pass through */ -/* PSIZ*NREC pointing numbers to get to the first START time. */ -/* Then we skip over the number just computed above. */ - - grpndx = beg + (nrec << 3) + skip; - -/* The number of times that we have to look at may be less than */ -/* DIRSIZ. However many there are, go ahead and read them into the */ -/* buffer. */ - -/* Computing MIN */ - i__1 = 100, i__2 = nrec - skip; - n = min(i__1,i__2); - i__1 = grpndx + n - 1; - dafgda_(handle, &grpndx, &i__1, buffer); - -/* Find the largest time in the group less than or equal to the input */ -/* time. */ - - i__ = lstled_(sclkdp, &n, buffer); - -/* If the request time does not fall into one of the intervals, then */ -/* there are several cases in which this routine can return an */ -/* endpoint of an interval. */ - -/* 1) If I = 0 then the request time falls before the first START */ -/* time in the group. Because of the way that the directory */ -/* is constructed we already know that the preceding STOP */ -/* time is not the right one so all we have to check is if */ -/* SCLKDP + TOL is greater than or equal to the first START */ -/* time of the group. */ - -/* 2) If I = N and the request time is not in the Nth interval */ -/* then we know that the request time is after the last STOP */ -/* time in the group. Because of the way that the directory */ -/* is constructed we already know that the following START */ -/* time is not the right one so all we have to check is if */ -/* SCLKDP - TOL is less than or equal to the last STOP time */ -/* of the group. */ - -/* 3) Finally, if I is between 1 and N-1 and the request time */ -/* does not fall in any of the intervals then we need to */ -/* return the closer of STOP(I) or START(I+1) if it is */ -/* within TOL of SCLKDP. */ - - -/* If SCLKDP is less than the first time in BUFFER then check to see */ -/* if we want the first START time in the group. */ - - if (i__ == 0) { - if (*sclkdp + *tol >= buffer[0]) { - *found = TRUE_; - start = buffer[0]; - clkout = buffer[0]; - index = 1; - } else { - chkout_("CKR02", (ftnlen)5); - return 0; - } - } else { - -/* I is not equal to zero. Determine if the request time falls */ -/* within the Ith interval. */ - - stploc = beg + nrec * 9 + skip + i__ - 1; - dafgda_(handle, &stploc, &stploc, &stopi); - if (*sclkdp <= stopi) { - *found = TRUE_; - start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr02_", (ftnlen)619)]; - clkout = *sclkdp; - index = i__; - } else { - -/* The request time does not fall within the interval. Check */ -/* to see if the Ith STOP time or the (I+1)th START time */ -/* satisfy the request. */ - -/* If I = N then we need to consider only the STOP time */ -/* because of the way that the directory is constructed. */ - - if (i__ == n) { - if (*sclkdp - *tol <= stopi) { - *found = TRUE_; - start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("buffer", i__1, "ckr02_", (ftnlen)638)]; - clkout = stopi; - index = i__; - } else { - chkout_("CKR02", (ftnlen)5); - return 0; - } - } else { - -/* Find which time SCLKDP is closest to and then see if */ -/* it is within the tolerance. */ - - diff1 = *sclkdp - stopi; - diff2 = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr02_", (ftnlen)656)] - * - sclkdp; - if (min(diff1,diff2) <= *tol) { - *found = TRUE_; - -/* Notice that if the request time is equidistant from */ -/* the STOP and START time the START time will be chosen. */ - - if (diff2 <= diff1) { - start = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 - : s_rnge("buffer", i__1, "ckr02_", (ftnlen) - 667)]; - clkout = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "ckr02_", ( - ftnlen)668)]; - index = i__ + 1; - } else { - start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "ckr02_", ( - ftnlen)673)]; - clkout = stopi; - index = i__; - } - } else { - chkout_("CKR02", (ftnlen)5); - return 0; - } - } - } - } - - -/* Now we know the exact record that we want and can begin */ -/* constructing the output record. */ - -/* RECORD( 1 ) holds the interval start time. */ -/* RECORD( 2 ) holds the time for which pointing was found (CLKOUT). */ - - record[0] = start; - record[1] = clkout; - -/* We need the pointing record out of GROUP indexed by INDEX. */ -/* This group of size DIRSIZ is SKIP records into the beginning */ -/* of the segment. And each record is PSIZ big. */ - - n = beg + (skip + index - 1 << 3); - i__1 = n + 7; - dafgda_(handle, &n, &i__1, prec); - record[2] = prec[7]; - vequg_(prec, &c__7, &record[3]); - -/* That is all. */ - - chkout_("CKR02", (ftnlen)5); - return 0; -} /* ckr02_ */ - diff --git a/ext/spice/src/cspice/ckr03.c b/ext/spice/src/cspice/ckr03.c deleted file mode 100644 index 6b8a4c3cb7..0000000000 --- a/ext/spice/src/cspice/ckr03.c +++ /dev/null @@ -1,995 +0,0 @@ -/* ckr03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKR03 ( C-kernel, read pointing record, data type 3 ) */ -/* Subroutine */ int ckr03_(integer *handle, doublereal *descr, doublereal * - sclkdp, doublereal *tol, logical *needav, doublereal *record, logical - *found) -{ - /* Initialized data */ - - static doublereal prevs = -1.; - static doublereal prevn = -1.; - static integer lhand = 0; - static integer lbeg = -1; - static integer lend = -1; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer addr__, skip, psiz, i__, n; - doublereal ldiff; - integer laddr; - doublereal rdiff; - integer raddr; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer nidir; - doublereal lsclk; - extern doublereal dpmax_(void); - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - integer nrdir; - doublereal rsclk; - integer group; - doublereal start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - extern logical failed_(void); - integer grpadd; - doublereal buffer[100]; - integer remain, dirloc; - extern integer lstled_(doublereal *, integer *, doublereal *); - integer numrec; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - integer numint; - doublereal nstart; - extern logical return_(void); - doublereal dcd[2]; - integer beg, icd[6], end; - logical fnd; - -/* $ Abstract */ - -/* Read a pointing record from a CK segment, data type 3. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* SCLKDP I Pointing request time. */ -/* TOL I Time tolerance. */ -/* NEEDAV I Angular velocity request flag. */ -/* RECORD O Pointing data record. */ -/* FOUND O True when data is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the integer handle of the CK file containing the */ -/* segment. */ - -/* DESCR is the descriptor of the segment. */ - -/* SCLKDP is the encoded spacecraft clock time for which */ -/* pointing is being requested. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* When SCLKDP falls within the bounds of one of the */ -/* interpolation intervals then the tolerance has no */ -/* effect because pointing will be returned at the */ -/* request time. */ - -/* However, if the request time is not in one of the */ -/* intervals, then the tolerance is used to determine */ -/* if pointing at one of the interval endpoints should */ -/* be returned. */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* $ Detailed_Output */ - -/* RECORD is the record that CKE03 will evaluate to determine */ -/* the pointing. */ - -/* When the request time falls within an interval for */ -/* which linear interpolation is valid, the values of */ -/* the two pointing instances that bracket the request */ -/* time are returned in RECORD as follows: */ - -/* RECORD( 1 ) = Left bracketing SCLK time. */ - -/* RECORD( 2 ) = lq0 \ */ -/* RECORD( 3 ) = lq1 \ Left bracketing */ -/* RECORD( 4 ) = lq2 / quaternion. */ -/* RECORD( 5 ) = lq3 / */ - -/* RECORD( 6 ) = lav1 \ Left bracketing */ -/* RECORD( 7 ) = lav2 angular velocity */ -/* RECORD( 8 ) = lav3 / ( optional ) */ - -/* RECORD( 9 ) = Right bracketing SCLK time. */ - -/* RECORD( 10 ) = rq0 \ */ -/* RECORD( 11 ) = rq1 \ Right bracketing */ -/* RECORD( 12 ) = rq2 / quaternion. */ -/* RECORD( 13 ) = rq3 / */ - -/* RECORD( 14 ) = rav1 \ Right bracketing */ -/* RECORD( 15 ) = rav2 angular velocity */ -/* RECORD( 16 ) = rav3 / ( optional ) */ - -/* RECORD( 17 ) = pointing request time, SCLKDP. */ - -/* The quantities lq0 - lq3 and rq0 - rq3 are the */ -/* components of the quaternions that represent the */ -/* C-matrices associated with the times that bracket */ -/* the requested time. */ - -/* The quantities lav1, lav2, lav3 and rav1, rav2, rav3 */ -/* are the components of the angular velocity vectors at */ -/* the respective bracketing times. The components of the */ -/* angular velocity vectors are specified relative to */ -/* the inertial reference frame of the segment. */ - -/* If the request time does not fall within an */ -/* interpolation interval, but is within TOL of an */ -/* interval endpoint, the values of that pointing */ -/* instance are returned in both parts of RECORD */ -/* ( i.e. RECORD(1-9) and RECORD(10-16) ). */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. This occurs when the time for which pointing */ -/* is requested falls inside one of the interpolation */ -/* intervals, or when the request time is within the */ -/* tolerance of an interval endpoint. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to an open DAF file, */ -/* an error is diagnosed by a routine that this routine calls. */ - -/* 2) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* 3) If the segment is not of data type 3, as specified in the */ -/* third integer component of the segment descriptor, then */ -/* the error SPICE(WRONGDATATYPE) is signalled. */ - -/* 4) If angular velocity data was requested but the segment */ -/* contains no such data, the error SPICE(NOAVDATA) is signalled. */ - -/* $ Files */ - -/* The file containing the segment is specified by its handle and */ -/* should be opened for read or write access, either by CKLPF, */ -/* DAFOPR, or DAFOPW. */ - -/* $ Particulars */ - -/* See the CK Required Reading file for a detailed description of */ -/* the structure of a type 3 pointing segment. */ - -/* When the time for which pointing was requested falls within an */ -/* interpolation interval, then FOUND will be true and RECORD will */ -/* contain the pointing instances in the segment that bracket the */ -/* request time. CKE03 will evaluate RECORD to give pointing at */ -/* the request time. */ - -/* However, when the request time is not within any of the */ -/* interpolation intervals, then FOUND will be true only if the */ -/* interval endpoint closest to the request time is within the */ -/* tolerance specified by the user. In this case both parts of */ -/* RECORD will contain this closest pointing instance, and CKE03 */ -/* will evaluate RECORD to give pointing at the time associated */ -/* with the returned pointing instance. */ - -/* $ Examples */ - -/* The CKRnn routines are usually used in tandem with the CKEnn */ -/* routines, which evaluate the record returned by CKRnn to give */ -/* the pointing information and output time. */ - -/* The following code fragment searches through all of the segments */ -/* in a file applicable to the Mars Observer spacecraft bus that */ -/* are of data type 3, for a particular spacecraft clock time. */ -/* It then evaluates the pointing for that epoch and prints the */ -/* result. */ - -/* CHARACTER*(20) SCLKCH */ -/* CHARACTER*(20) SCTIME */ -/* CHARACTER*(40) IDENT */ - -/* INTEGER I */ -/* INTEGER SC */ -/* INTEGER INST */ -/* INTEGER HANDLE */ -/* INTEGER DTYPE */ -/* INTEGER ICD ( 6 ) */ - -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION RECORD ( 17 ) */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ - -/* LOGICAL NEEDAV */ -/* LOGICAL FND */ -/* LOGICAL SFND */ - - -/* SC = -94 */ -/* INST = -94000 */ -/* DTYPE = 3 */ -/* NEEDAV = .FALSE. */ - -/* C */ -/* C Load the MO SCLK kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH ( 'MO_SCLK.TSC' ) */ -/* CALL DAFOPR ( 'MO_CK.BC', HANDLE ) */ -/* C */ -/* C Get the spacecraft clock time. Then encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* WRITE (*,*) 'Enter spacecraft clock time string:' */ -/* READ (*,FMT='(A)') SCLKCH */ - -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ -/* C */ -/* C Use a tolerance of 2 seconds ( half of the nominal */ -/* C separation between MO pointing instances ). */ -/* C */ -/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */ - -/* C */ -/* C Search from the beginning of the CK file through all */ -/* C of the segments. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( SFND ) */ - -/* FND = .FALSE. */ - -/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */ - -/* C */ -/* C Get the segment identifier and descriptor. */ -/* C */ - -/* CALL DAFGN ( IDENT ) */ -/* CALL DAFGS ( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its integer and */ -/* C double precision components. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* C */ -/* C Determine if this segment should be processed. */ -/* C */ -/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */ -/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */ -/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */ -/* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */ - - -/* CALL CKR03 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FND ) */ - -/* IF ( FND ) THEN */ - -/* CALL CKE03 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */ - -/* CALL SCDECD ( SC, CLKOUT, SCTIME ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment identifier: ', IDENT */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Pointing returned for time: ', */ -/* . SCTIME */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) */ -/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */ -/* WRITE (*,*) */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The file containing the segment should be opened for read */ -/* or write access either by CKLPF, DAFOPR, or DAFOPW. */ - -/* 2) The record returned by this routine is intended to be */ -/* evaluated by CKE03. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* read ck type_3 pointing data record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* DIRSIZ is the directory size. */ - -/* BUFSIZ is the maximum number of double precision numbers */ -/* that we will read from the DAF file at one time. */ -/* BUFSIZ is normally set equal to DIRSIZ. */ - -/* ND is the number of double precision components in an */ -/* unpacked C-kernel segment descriptor. */ - -/* NI is the number of integer components in an unpacked */ -/* C-kernel segment descriptor. */ - -/* QSIZ is the number of double precision numbers making up */ -/* the quaternion portion of a pointing record. */ - -/* QAVSIZ is the number of double precision numbers making up */ -/* the quaternion and angular velocity portion of a */ -/* pointing record. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - - - -/* Local variables */ - - -/* Saved variables. */ - - -/* Initial values. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKR03", (ftnlen)5); - } - -/* Start off with FOUND equal to false just in case a SPICELIB error */ -/* is signalled and the return mode is not set to ABORT. */ - - *found = FALSE_; - -/* We need to look at a few of the descriptor components. */ - -/* The unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* Check to make sure that the segment is type 3. */ - - if (icd[2] != 3) { - setmsg_("The segment is not a type 3 segment. Type is #", (ftnlen)47) - ; - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("CKR03", (ftnlen)5); - return 0; - } - -/* Does this segment contain angular velocity? */ - - if (icd[3] == 1) { - psiz = 7; - } else { - psiz = 4; - if (*needav) { - setmsg_("Segment does not contain angular velocity data.", ( - ftnlen)47); - sigerr_("SPICE(NOAVDATA)", (ftnlen)15); - chkout_("CKR03", (ftnlen)5); - return 0; - } - } - -/* The beginning and ending addresses of the segment are in the */ -/* descriptor. */ - - beg = icd[4]; - end = icd[5]; - -/* The procedure used in finding a record to satisfy the request */ -/* for pointing is as follows: */ - -/* 1) Find the two pointing instances in the segment that bracket */ -/* the request time. */ - -/* The pointing instance that brackets the request time on the */ -/* left is defined to be the one associated with the largest */ -/* time in the segment that is less than or equal to SCLKDP. */ - -/* The pointing instance that brackets the request time on the */ -/* right is defined to be the one associated with the first */ -/* time in the segment greater than SCLKDP. */ - -/* Since the times in the segment are strictly increasing the */ -/* left and right bracketing pointing instances are always */ -/* adjacent. */ - -/* 2) Determine if the bracketing times are in the same */ -/* interpolation interval. */ - -/* 3) If they are, then pointing at the request time may be */ -/* linearly interpolated from the bracketing times. */ - -/* 4) If the times that bracket the request time are not in the */ -/* same interval then, since they are adjacent in the segment */ -/* and since intervals begin and end at actual times, they must */ -/* both be interval endpoints. Return the pointing instance */ -/* associated with the endpoint closest to the request time, */ -/* provided that it is within the tolerance. */ - - -/* Get the number of intervals and pointing instances ( records ) */ -/* in this segment, and from that determine the number of respective */ -/* directory epochs. */ - - i__1 = end - 1; - dafgda_(handle, &i__1, &end, buffer); - numint = i_dnnt(buffer); - numrec = i_dnnt(&buffer[1]); - nidir = (numint - 1) / 100; - nrdir = (numrec - 1) / 100; - -/* Check the FAILED flag just in case HANDLE is not attached to */ -/* any DAF file and the error action is not set to ABORT. You need */ -/* need to do this only after the first call to DAFGDA. */ - - if (failed_()) { - chkout_("CKR03", (ftnlen)5); - return 0; - } - -/* To find the times that bracket the request time we will first */ -/* find the greatest directory time less than the request time. */ -/* This will narrow down the search to a group of DIRSIZ or fewer */ -/* times where the Jth group is defined to contain SCLK times */ -/* ((J-1)*DIRSIZ + 1) through (J*DIRSIZ). */ - -/* For example if DIRSIZ = 100 then: */ - -/* group first time # last time # */ -/* ----- --------------- ------------ */ -/* 1 1 100 */ -/* 2 101 200 */ -/* . . . */ -/* . . . */ -/* 10 901 1000 */ -/* . . . */ -/* . . . */ -/* NRDIR+1 (NRDIR)*100+1 NUMREC */ - - -/* Thus if the Ith directory time is the largest one less than */ -/* our request time SCLKDP, then we know that: */ - -/* SCLKS ( DIRSIZ * I ) < SCLKDP <= SCLKS ( DIRSIZ * (I+1) ) */ - -/* where SCLKS is taken to be the array of NUMREC times associated */ -/* with the pointing instances. */ - -/* Therefore, at least one of the bracketing times will come from */ -/* the (I+1)th group. */ - - -/* There is only one group if there are no directory epochs. */ - - if (nrdir == 0) { - group = 1; - } else { - -/* Compute the location of the first directory epoch. From the */ -/* beginning of the segment, we need to go through all of the */ -/* pointing numbers (PSIZ*NUMREC of them) and then through all of */ -/* the NUMREC SCLK times. */ - - dirloc = beg + (psiz + 1) * numrec; - -/* Search through the directory times. Read in as many as BUFSIZ */ -/* directory epochs at a time for comparison. */ - - fnd = FALSE_; - remain = nrdir; - group = 0; - while(! fnd) { - -/* The number of records to read into the buffer. */ - - n = min(remain,100); - i__1 = dirloc + n - 1; - dafgda_(handle, &dirloc, &i__1, buffer); - remain -= n; - -/* Determine the last directory element in BUFFER that's less */ -/* than SCLKDP. */ - - i__ = lstltd_(sclkdp, &n, buffer); - if (i__ < n) { - group = group + i__ + 1; - fnd = TRUE_; - } else if (remain == 0) { - -/* The request time is greater than the last directory time */ -/* so we want the last group in the segment. */ - - group = nrdir + 1; - fnd = TRUE_; - } else { - -/* Need to read another block of directory times. */ - - dirloc += n; - group += n; - } - } - } - -/* Now we know which group of DIRSIZ (or less) times to look at. */ -/* Out of the NUMREC SCLK times, the number that we should skip over */ -/* to get to the proper group is DIRSIZ * ( GROUP - 1 ). */ - - skip = (group - 1) * 100; - -/* From this we can compute the address in the segment of the group */ -/* of times we want. From the beginning, we need to pass through */ -/* PSIZ * NUMREC pointing numbers to get to the first SCLK time. */ -/* Then we skip over the number just computed above. */ - - grpadd = beg + numrec * psiz + skip; - -/* The number of times that we have to look at may be less than */ -/* DIRSIZ. However many there are, go ahead and read them into the */ -/* buffer. */ - -/* Computing MIN */ - i__1 = 100, i__2 = numrec - skip; - n = min(i__1,i__2); - i__1 = grpadd + n - 1; - dafgda_(handle, &grpadd, &i__1, buffer); - -/* Find the largest time in the group less than or equal to the input */ -/* time. */ - - i__ = lstled_(sclkdp, &n, buffer); - -/* Find the pointing instances in the segment that bracket the */ -/* request time and calculate the addresses for the pointing data */ -/* associated with these times. For cases in which the request time */ -/* is equal to one of the times in the segment, that time will be */ -/* the left bracketing time of the returned pair. */ - -/* Need to handle the cases when the request time is greater than */ -/* the last or less than the first time in the segment separately. */ - - if (i__ == 0) { - if (group == 1) { - -/* The time occurs before the first time in the segment. Since */ -/* this time cannot possibly be in any of the intervals, the */ -/* first time can satisfy the request for pointing only if it */ -/* is within the tolerance of the request time. */ - - if (buffer[0] - *sclkdp <= *tol) { - record[0] = buffer[0]; - record[8] = buffer[0]; - -/* Calculate the address of the quaternion and angular */ -/* velocity data. Then read it from the file. */ - - i__1 = beg + psiz - 1; - dafgda_(handle, &beg, &i__1, buffer); - moved_(buffer, &psiz, &record[1]); - moved_(buffer, &psiz, &record[9]); - record[16] = *sclkdp; - *found = TRUE_; - } - chkout_("CKR03", (ftnlen)5); - return 0; - } else { - -/* The first time in the current group brackets the request */ -/* time on the right and the last time from the preceding */ -/* group brackets on the left. */ - - rsclk = buffer[0]; - raddr = beg + skip * psiz; - i__1 = grpadd - 1; - i__2 = grpadd - 1; - dafgda_(handle, &i__1, &i__2, &lsclk); - laddr = raddr - psiz; - } - } else if (i__ == n) { - -/* There are two possible cases, but the same action can handle */ -/* both. */ - -/* 1) If this is the last group ( NRDIR + 1 ) then the request */ -/* time occurs on or after the last time in the segment. */ -/* In either case this last time can satisfy the request for */ -/* pointing only if it is within the tolerance of the request */ -/* time. */ - -/* 2) The request time is greater than or equal to the last time */ -/* in this group. Since this time is the same as the (I+1)th */ -/* directory time, and since the search on the directory times */ -/* used a strictly less than test, we know that the request */ -/* time must be equal to this time. Just return the pointing */ -/* instance associated with the request time. ( Note that */ -/* SCLKDP - BUFFER(N) will be zero in this case. ) */ - - if (*sclkdp - buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr03_", (ftnlen)826)] <= *tol) { - record[0] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr03_", (ftnlen)828)]; - record[8] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr03_", (ftnlen)829)]; - -/* Calculate the address of the quaternion and angular */ -/* velocity data. Then read it from the file. */ - - addr__ = beg + psiz * (skip + n - 1); - i__1 = addr__ + psiz - 1; - dafgda_(handle, &addr__, &i__1, buffer); - moved_(buffer, &psiz, &record[1]); - moved_(buffer, &psiz, &record[9]); - record[16] = *sclkdp; - *found = TRUE_; - } - chkout_("CKR03", (ftnlen)5); - return 0; - } else { - -/* The bracketing times are contained in this group. */ - - lsclk = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "buffer", i__1, "ckr03_", (ftnlen)855)]; - rsclk = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge("buff" - "er", i__1, "ckr03_", (ftnlen)856)]; - laddr = beg + (skip + i__ - 1) * psiz; - raddr = laddr + psiz; - } - -/* At this point we have the two times in the segment that bracket */ -/* the request time. We also have the addresses of the pointing */ -/* data associated with those times. The task now is to determine */ -/* if the bracketing times fall in the same interval. If so then */ -/* we can interpolate between them. If they don't then return */ -/* pointing for whichever of the two times is closest to the */ -/* request time, provided that it is within the tolerance. */ - - -/* Find the interpolation interval that the request time is in and */ -/* determine if the bracketing SCLK's are both in it. */ - -/* First check if the request time falls in the same interval as */ -/* it did last time. We need to make sure that we are dealing */ -/* with the same segment as well as the same time range. */ - - -/* PREVS is the start time of the interval that satisfied */ -/* the previous request for pointing. */ - -/* PREVN is the start time of the interval that followed */ -/* the interval specified above. */ - -/* LHAND is the handle of the file that PREVS and PREVN */ -/* were found in. */ - -/* LBEG, are the beginning and ending addresses of the */ -/* LEND segment in the file LHAND that PREVS and PREVN */ -/* were found in. */ - - if (*handle == lhand && beg == lbeg && end == lend && *sclkdp >= prevs && - *sclkdp < prevn) { - start = prevs; - nstart = prevn; - } else { - -/* The START times of all of the intervals are stored in the */ -/* segment and a directory of every hundredth START is also */ -/* stored. The procedure to find the bracketing interval start */ -/* times is identical to the one used above for finding the */ -/* bracketing times. */ - -/* The directory epochs narrow down the search for the times that */ -/* bracket the request time to a group of DIRSIZ or fewer records. */ - - -/* There is only one group if there are no directory epochs. */ - - if (nidir == 0) { - group = 1; - } else { - -/* Compute the location of the first directory epoch. From the */ -/* beginning of the segment, we need to go through all of the */ -/* pointing numbers (PSIZ*NUMREC of them), then through all of */ -/* the NUMREC SCLK times and NRDIR directory times, and then */ -/* finally through the NUMINT interval start times. */ - - dirloc = beg + (psiz + 1) * numrec + nrdir + numint; - -/* Locate the largest directory time less than the */ -/* request time SCLKDP. */ - -/* Read in as many as BUFSIZ directory epochs at a time for */ -/* comparison. */ - - fnd = FALSE_; - remain = nidir; - group = 0; - while(! fnd) { - -/* The number of records to read into the buffer. */ - - n = min(remain,100); - i__1 = dirloc + n - 1; - dafgda_(handle, &dirloc, &i__1, buffer); - remain -= n; - -/* Determine the last directory element in BUFFER that's */ -/* less than SCLKDP. */ - - i__ = lstltd_(sclkdp, &n, buffer); - if (i__ < n) { - group = group + i__ + 1; - fnd = TRUE_; - } else if (remain == 0) { - -/* The request time is greater than the last directory */ -/* time so we want the last group in the segment. */ - - group = nidir + 1; - fnd = TRUE_; - } else { - -/* Need to read another block of directory times. */ - - dirloc += n; - group += n; - } - } - } - -/* Now we know which group of DIRSIZ (or less) times to look at. */ -/* Out of the NUMINT SCLK START times, the number that we should */ -/* skip over to get to the proper group is DIRSIZ * ( GROUP - 1 ). */ - - skip = (group - 1) * 100; - -/* From this we can compute the address in the segment of the */ -/* group of times we want. To get to the first interval start */ -/* time we must pass over PSIZ * NUMREC pointing numbers, NUMREC */ -/* SCLK times, and NRDIR SCLK directory times. Then we skip */ -/* over the number just computed above. */ - - grpadd = beg + (psiz + 1) * numrec + nrdir + skip; - -/* The number of times that we have to look at may be less than */ -/* DIRSIZ. However many there are, go ahead and read them into */ -/* the buffer. */ - -/* Computing MIN */ - i__1 = 100, i__2 = numint - skip; - n = min(i__1,i__2); - i__1 = grpadd + n - 1; - dafgda_(handle, &grpadd, &i__1, buffer); - -/* Find the index of the largest time in the group that is less */ -/* than or equal to the input time. */ - - i__ = lstled_(sclkdp, &n, buffer); - if (i__ == 0) { - -/* The first start time in the buffer is the start of the */ -/* interval following the one containing the request time. */ - -/* We don't need to check if GROUP = 1 because the case of */ -/* the request time occurring before the first time in the */ -/* segment has already been handled. */ - - nstart = buffer[0]; - addr__ = grpadd - 1; - dafgda_(handle, &addr__, &addr__, &start); - } else if (i__ == n) { - if (group == nidir + 1) { - -/* This is the last interval in the segment. */ - - start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr03_", (ftnlen)1040)]; - nstart = dpmax_(); - } else { - -/* The last START time in this group is equal to the */ -/* request time. */ - - start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr03_", (ftnlen)1049)]; - addr__ = grpadd + n; - dafgda_(handle, &addr__, &addr__, &nstart); - } - } else { - -/* The bracketing START times are contained in this group. */ - - start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "ckr03_", (ftnlen)1061)]; - nstart = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "buffer", i__1, "ckr03_", (ftnlen)1062)]; - } - -/* Save the information about the interval and segment. */ - - lhand = *handle; - lbeg = beg; - lend = end; - prevs = start; - prevn = nstart; - } - -/* Check and see if the bracketing pointing instances belong */ -/* to the same interval. If they do then we can interpolate */ -/* between them, if not then check to see if the closer of */ -/* the two to the request time lies within the tolerance. */ - -/* The left bracketing time will always belong to the same */ -/* interval as the request time, therefore we need to check */ -/* only that the right bracketing time is less than the start */ -/* time of the next interval. */ - - if (rsclk < nstart) { - record[0] = lsclk; - i__1 = laddr + psiz - 1; - dafgda_(handle, &laddr, &i__1, &record[1]); - record[8] = rsclk; - i__1 = raddr + psiz - 1; - dafgda_(handle, &raddr, &i__1, &record[9]); - record[16] = *sclkdp; - *found = TRUE_; - } else { - ldiff = *sclkdp - lsclk; - rdiff = rsclk - *sclkdp; - if (ldiff <= *tol || rdiff <= *tol) { - -/* Return the pointing instance closest to the request time. */ - -/* If the request time is midway between LSCLK and RSCLK then */ -/* grab the pointing instance associated with the greater time. */ - - if (ldiff < rdiff) { - record[0] = lsclk; - record[8] = lsclk; - i__1 = laddr + psiz - 1; - dafgda_(handle, &laddr, &i__1, buffer); - moved_(buffer, &psiz, &record[1]); - moved_(buffer, &psiz, &record[9]); - } else { - record[0] = rsclk; - record[8] = rsclk; - i__1 = raddr + psiz - 1; - dafgda_(handle, &raddr, &i__1, buffer); - moved_(buffer, &psiz, &record[1]); - moved_(buffer, &psiz, &record[9]); - } - record[16] = *sclkdp; - *found = TRUE_; - } - } - chkout_("CKR03", (ftnlen)5); - return 0; -} /* ckr03_ */ - diff --git a/ext/spice/src/cspice/ckr04.c b/ext/spice/src/cspice/ckr04.c deleted file mode 100644 index 9093a2f8b3..0000000000 --- a/ext/spice/src/cspice/ckr04.c +++ /dev/null @@ -1,783 +0,0 @@ -/* ckr04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__7 = 7; -static doublereal c_b18 = 128.; - -/* $Procedure CKR04 ( C-kernel, read pointing record, data type 4 ) */ -/* Subroutine */ int ckr04_(integer *handle, doublereal *descr, doublereal * - sclkdp, doublereal *tol, logical *needav, doublereal *record, logical - *found) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec, ends, indx; - doublereal lbnd1, lbnd2, rbnd1; - integer k; - extern /* Subroutine */ int chkin_(char *, ftnlen), cknr04_(integer *, - doublereal *, integer *), dafus_(doublereal *, integer *, integer - *, doublereal *, integer *); - doublereal value; - logical exist; - doublereal midpt1, midpt2; - extern logical failed_(void); - integer numall; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numcft[7]; - extern /* Subroutine */ int chkout_(char *, ftnlen), sgfpkt_(integer *, - doublereal *, integer *, integer *, doublereal *, integer *), - sgfrvi_(integer *, doublereal *, doublereal *, doublereal *, - integer *, logical *); - doublereal clkout; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - extern /* Subroutine */ int zzck4d2i_(doublereal *, integer *, doublereal - *, integer *); - doublereal rad1, rad2; - -/* $ Abstract */ - -/* Read a single data record from a type 4 CK segment. */ - -/* $ 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 */ - -/* CK.REQ */ -/* DAF.REQ */ -/* GS.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* SCLKDP I Pointing request time. */ -/* TOL I Time tolerance. */ -/* NEEDAV I Angular velocity request flag. */ -/* RECORD O Pointing data record. */ -/* FOUND O True when a record covering SCLKDP is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the integer handle of the CK file containing the */ -/* segment. */ - -/* DESCR is the descriptor of the segment. */ - -/* SCLKDP is the encoded spacecraft clock time for which */ -/* pointing is being requested. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* When SCLKDP falls within the bounds of one of the */ -/* interpolation intervals then the tolerance has no */ -/* effect because pointing will be returned at the */ -/* request time. */ - -/* However, if the request time is not in one of the */ -/* intervals, then the tolerance is used to determine */ -/* if pointing at one of the interval endpoints should */ -/* be returned. */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* $ Detailed_Output */ - -/* RECORD is the record that CKE04 will evaluate to determine */ -/* the pointing and it includes parameters: */ - -/* --------------------------------------------------- */ -/* | Encoded onboard time which is the closest | */ -/* | to SCLKDP and belongs to one of approximation | */ -/* | intervals | */ -/* --------------------------------------------------- */ -/* | encoded SCLK time of the midpoint of | */ -/* | interpolation interval | */ -/* --------------------------------------------------- */ -/* | radii of interpolation interval | */ -/* | expressed as double precision SCLK ticks | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q0 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q1 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q2 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for q3 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV1 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV2 | */ -/* --------------------------------------------------- */ -/* | Number of coefficients for AV3 | */ -/* --------------------------------------------------- */ -/* | q0 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q1 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q2 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | q3 Cheby coefficients | */ -/* --------------------------------------------------- */ -/* | AV1 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ -/* | AV2 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ -/* | AV3 Cheby coefficients (optional) | */ -/* --------------------------------------------------- */ - -/* FOUND is true if a record was found to satisfy the pointing */ -/* request. This occurs when the time for which pointing */ -/* is requested falls inside one of the interpolation */ -/* intervals, or when the request time is within the */ -/* tolerance of an interval endpoint. */ - -/* $ Parameters */ - -/* See 'ckparam.inc'. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to an open DAF file, */ -/* an error is diagnosed by a routine that this routine calls. */ - -/* 2) If the specified descriptor does not belong a segment */ -/* data in which are organized in accordance with generic */ -/* segment architecture, an error is diagnosed by DAF generic */ -/* segment routines that this routine calls. */ - -/* 3) If DESCR is not a valid descriptor of a segment in the CK */ -/* file specified by HANDLE, the results of this routine are */ -/* unpredictable. */ - -/* 4) If the segment is not of data type 4, as specified in the */ -/* third integer component of the segment descriptor, then */ -/* the error SPICE(WRONGDATATYPE) is signalled. */ - -/* 5) If angular velocity data was requested but the segment */ -/* contains no such data, the error SPICE(NOAVDATA) is */ -/* signalled. */ - -/* $ Particulars */ - -/* See the CK Required Reading file for a detailed description of */ -/* the structure of a type 4 pointing segment. */ - -/* When the time for which pointing was requested falls within an */ -/* interpolation interval, then FOUND will be true and RECORD will */ -/* contain the set of Chebychev polynomial coefficients for the */ -/* time interval that brackets the request time. CKE04 will */ -/* evaluate RECORD to give pointing at the request time. */ - -/* However, when the request time is not within any of the */ -/* interpolation intervals, then FOUND will be true only if the */ -/* interval endpoint closest to the request time is within the */ -/* tolerance specified by the user. In this case RECORD will */ -/* contain the set of Chebychev polynomial coefficients for the */ -/* time interval one of the ends of which was within tolerance */ -/* from the request time, and CKE04 will evaluate RECORD to give */ -/* pointing at the time associated with that interval end time. */ - - -/* $ Examples */ - -/* The CKRnn routines are usually used in tandem with the CKEnn */ -/* routines, which evaluate the record returned by CKRnn to give */ -/* the pointing information and output time. */ - -/* The following code fragment searches through all of the segments */ -/* in a file applicable to the Mars Global Surveyor spacecraft bus */ -/* that are of data type 4, for a particular spacecraft clock time. */ -/* It then evaluates the pointing for that epoch and prints the */ -/* result. */ - -/* C */ -/* C CK parameters include file. */ -/* C */ -/* INCLUDE 'ckparam.inc' */ -/* C */ -/* C Declarations */ -/* C */ -/* CHARACTER*(20) SCLKCH */ -/* CHARACTER*(20) SCTIME */ -/* CHARACTER*(40) IDENT */ - -/* DOUBLE PRECISION AV ( 3 ) */ -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION DCD ( 2 ) */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION RECORD ( CK4RSZ ) */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION TOL */ - -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER ICD ( 6 ) */ -/* INTEGER INST */ -/* INTEGER SC */ - -/* LOGICAL FND */ -/* LOGICAL NEEDAV */ -/* LOGICAL SFND */ -/* C */ -/* C Initial values. */ -/* C */ -/* SC = -94 */ -/* INST = -94000 */ -/* NEEDAV = .FALSE. */ -/* C */ -/* C Load the MGS SCLK kernel and the C-kernel. */ -/* C */ -/* CALL FURNSH( 'MGS_SCLK.TSC' ) */ -/* CALL DAFOPR( 'MGS_CK4.BC', HANDLE ) */ -/* C */ -/* C Get the spacecraft clock time. Then encode it for use */ -/* C in the C-kernel. */ -/* C */ -/* CALL PROMPT( 'Enter SCLK string: ', SCLKCH ) */ -/* CALL SCENCD( SC, SCLKCH, SCLKDP ) */ -/* C */ -/* C Use a tolerance of 2 seconds (half of the nominal */ -/* C separation between MGS pointing instances ). */ -/* C */ -/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */ -/* C */ -/* C Search from the beginning of the CK file through all */ -/* C of the segments. */ -/* C */ -/* CALL DAFBFS( HANDLE ) */ -/* CALL DAFFNA( SFND ) */ - -/* FND = .FALSE. */ - -/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */ -/* C */ -/* C Get the segment identifier and descriptor. */ -/* C */ -/* CALL DAFGN( IDENT ) */ -/* CALL DAFGS( DESCR ) */ -/* C */ -/* C Unpack the segment descriptor into its integer and */ -/* C double precision components. */ -/* C */ -/* CALL DAFUS( DESCR, 2, 6, DCD, ICD ) */ -/* C */ -/* C Determine if this segment should be processed. */ -/* C */ -/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */ -/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */ -/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */ -/* . ( CK4DTP .EQ. ICD( 3 ) ) ) THEN */ -/* C */ -/* C Find CK 4 record covering requested time. */ -/* C */ -/* CALL CKR04( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FND ) */ - -/* IF ( FND ) THEN */ -/* C */ -/* C Compute pointing using found CK 4 record. */ -/* C */ -/* CALL CKE04( NEEDAV, RECORD, CMAT, AV, CLKOUT) */ - -/* CALL SCDECD( SC, CLKOUT, SCTIME ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment identifier: ', IDENT */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Pointing returned for time: ', */ -/* . SCTIME */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'C-matrix:' */ -/* WRITE (*,*) */ -/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */ -/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */ -/* WRITE (*,*) */ - -/* END IF */ - -/* END IF */ - -/* CALL DAFFNA ( SFND ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The file containing the segment should be opened for read */ -/* or write access either by CKLPF, DAFOPR, or DAFOPW. */ - -/* 2) The record returned by this routine is intended to be */ -/* evaluated by CKE04. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_4 CK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKR04", (ftnlen)5); - } - -/* Set initial value of the found flag to "NOT FOUND". */ - - *found = FALSE_; - -/* We need to unpack and analyze descriptor components. The */ -/* unpacked descriptor contains the following information */ -/* about the segment: */ - -/* DCD(1) Initial encoded SCLK */ -/* DCD(2) Final encoded SCLK */ -/* ICD(1) Instrument */ -/* ICD(2) Inertial reference frame */ -/* ICD(3) Data type */ -/* ICD(4) Angular velocity flag */ -/* ICD(5) Initial address of segment data */ -/* ICD(6) Final address of segment data */ - - dafus_(descr, &c__2, &c__6, dcd, icd); - -/* Check if the segment is type 4. Signal an error if it's not. */ - - if (icd[2] != 4) { - setmsg_("The segment is not a type 4 segment. Type is #", (ftnlen)47) - ; - errint_("#", &icd[2], (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("CKR04", (ftnlen)5); - return 0; - } - if (*needav) { - -/* Signal an error if angular velocities are required but */ -/* they are not present in the segment. */ - - if (icd[3] != 1) { - setmsg_("Segment does not contain angular velocity data.", ( - ftnlen)47); - sigerr_("SPICE(NOAVDATA)", (ftnlen)15); - chkout_("CKR04", (ftnlen)5); - return 0; - } - } - -/* Get number of records (packets) in the segment. */ - - cknr04_(handle, descr, &nrec); - -/* Locate the last time in the set of reference epochs less than or */ -/* equal to the input SCLKDP. */ - - sgfrvi_(handle, descr, sclkdp, &value, &indx, &exist); - if (failed_()) { - chkout_("CKR04", (ftnlen)5); - return 0; - } - if (! exist) { - -/* We didn't find reference value with means that SCLKDP is */ -/* less than the left bound of the first interpolation interval. */ -/* Fetch the first record. */ - - indx = 1; - sgfpkt_(handle, descr, &indx, &indx, record, &ends); - if (failed_()) { - chkout_("CKR04", (ftnlen)5); - return 0; - } - midpt1 = record[0]; - rad1 = record[1]; - -/* Check whether SCLKDP is within TOL of the left bound of the */ -/* first interval. */ - - lbnd1 = midpt1 - rad1 - *tol; - if (*sclkdp >= lbnd1) { - *found = TRUE_; - clkout = midpt1 - rad1; - } - } else { - -/* We found reference value. */ - - if (indx >= nrec) { - -/* The SCLKDP is greater than the left bound of the last */ -/* interpolation interval. Fetch the last record. */ - - indx = nrec; - sgfpkt_(handle, descr, &indx, &indx, record, &ends); - if (failed_()) { - chkout_("CKR04", (ftnlen)5); - return 0; - } - midpt1 = record[0]; - rad1 = record[1]; - -/* Check whether SCLKDP is within TOL of the right bound of */ -/* the last interval. */ - - rbnd1 = midpt1 + rad1 + *tol; - if (*sclkdp <= rbnd1) { - *found = TRUE_; - -/* Check whether SCLKDP falls between right bound of the */ -/* last interval and right bound + TOL. */ - - rbnd1 = midpt1 + rad1; - if (*sclkdp >= rbnd1) { - clkout = midpt1 + rad1; - } else { - -/* SCLKDP belongs to the last interval */ - - clkout = *sclkdp; - } - } - } else if (indx >= 1 && indx < nrec) { - -/* The SCLKDP lies between left bound of the first interval */ -/* and the right bound of the interval before the last */ -/* interval. Fetch the found record. */ - - sgfpkt_(handle, descr, &indx, &indx, record, &ends); - if (failed_()) { - chkout_("CKR04", (ftnlen)5); - return 0; - } - midpt1 = record[0]; - rad1 = record[1]; - -/* Check whether SCLKDP belongs to current interval. */ - - rbnd1 = midpt1 + rad1; - if (*sclkdp <= rbnd1) { - *found = TRUE_; - clkout = *sclkdp; - } else { - -/* SCLKDP doesn't belong to current interval. Fetch the */ -/* next packet. */ - - i__1 = indx + 1; - i__2 = indx + 1; - sgfpkt_(handle, descr, &i__1, &i__2, record, &ends); - if (failed_()) { - chkout_("CKR04", (ftnlen)5); - return 0; - } - midpt2 = record[0]; - rad2 = record[1]; - -/* Find the closest interval bound for SCLKDP. */ - - rbnd1 = midpt1 + rad1; - lbnd2 = midpt2 - rad2; - if (*sclkdp - rbnd1 <= lbnd2 - *sclkdp) { - -/* SCLKDP is closer to the right bound of current */ -/* interval. Check whether it's within TOL of it. */ - - rbnd1 = midpt1 + rad1 + *tol; - if (*sclkdp <= rbnd1) { - *found = TRUE_; - clkout = midpt1 + rad1; - -/* At this point we need to re-read our current */ -/* record because it was overwritten by the next */ -/* record. No FAILED() check here -- we already */ -/* fetched this packet successfully one call to */ -/* SGFPKT ago. */ - - sgfpkt_(handle, descr, &indx, &indx, record, &ends); - } - } else { - -/* SCLKDP is closer to the left bound of the next */ -/* interval. Check whether it's within TOL of it. */ - - lbnd2 = midpt2 - rad2 - *tol; - if (*sclkdp >= lbnd2) { - *found = TRUE_; - ++indx; - clkout = midpt2 - rad2; - } - } - } - } - } - -/* If we found the interval on segment the SCLKDP belongs to, then */ - - if (*found) { - -/* Decode numbers of polynomial coefficients. */ - - zzck4d2i_(&record[2], &c__7, &c_b18, numcft); - -/* Count total number of coefficients. */ - - numall = 0; - for (k = 1; k <= 7; ++k) { - numall += numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "numcft", i__1, "ckr04_", (ftnlen)665)]; - } - -/* Move coefficients to the right and insert numbers of */ -/* coefficients into output RECORD. */ - - for (k = numall; k >= 1; --k) { - record[k + 9] = record[k + 2]; - } - for (k = 1; k <= 7; ++k) { - record[k + 2] = (doublereal) numcft[(i__1 = k - 1) < 7 && 0 <= - i__1 ? i__1 : s_rnge("numcft", i__1, "ckr04_", (ftnlen) - 677)]; - } - record[2] = record[1]; - record[1] = record[0]; - -/* Insert CLKOUT into output RECORD */ - - record[0] = clkout; - } - -/* All done. */ - - chkout_("CKR04", (ftnlen)5); - return 0; -} /* ckr04_ */ - diff --git a/ext/spice/src/cspice/ckr05.c b/ext/spice/src/cspice/ckr05.c deleted file mode 100644 index e0213a6c76..0000000000 --- a/ext/spice/src/cspice/ckr05.c +++ /dev/null @@ -1,1251 +0,0 @@ -/* ckr05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKR05 ( Read CK record from segment, type 05 ) */ -/* Subroutine */ int ckr05_(integer *handle, doublereal *descr, doublereal * - sclkdp, doublereal *tol, logical *needav, doublereal *record, logical - *found) -{ - /* Initialized data */ - - static integer lbeg = -1; - static integer lend = -1; - static integer lhand = 0; - static doublereal prevn = -1.; - static doublereal prevnn = -1.; - static doublereal prevs = -1.; - - /* System generated locals */ - integer i__1, i__2; - doublereal d__1, d__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer high; - doublereal rate; - integer last, type__, i__, j, n; - doublereal t; - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer nidir; - extern doublereal dpmax_(void); - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - integer npdir, nsrch; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer lsize, first, nints, rsize; - doublereal start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6]; - extern logical failed_(void); - integer bufbas, dirbas; - doublereal hepoch; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - doublereal lepoch; - integer npread, nsread, remain, pbegix, sbegix, timbas; - doublereal pbuffr[101]; - extern integer lstled_(doublereal *, integer *, doublereal *); - doublereal sbuffr[103]; - integer pendix, sendix, packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer maxwnd; - doublereal contrl[5]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - doublereal nstart; - extern logical return_(void); - integer pgroup, sgroup, wndsiz, wstart, subtyp; - doublereal nnstrt; - extern logical odd_(integer *); - integer end, low; - -/* $ Abstract */ - -/* Read a single CK data record from a segment of type 05 */ -/* (MEX/Rosetta Attitude file interpolation). */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to CK type 05. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ - -/* CK type 5 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ -/* and quaternion derivatives only, no angular velocity */ -/* vector provided. Quaternion elements are listed */ -/* first, followed by derivatives. Angular velocity is */ -/* derived from the quaternions and quaternion */ -/* derivatives. */ - - -/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ -/* only. Angular velocity is derived by differentiating */ -/* the interpolating polynomials. */ - - -/* Subtype 2: Hermite interpolation, 14-element packets. */ -/* Quaternion and angular angular velocity vector, as */ -/* well as derivatives of each, are provided. The */ -/* quaternion comes first, then quaternion derivatives, */ -/* then angular velocity and its derivatives. */ - - -/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ -/* and angular velocity vector provided. The quaternion */ -/* comes first. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of file ck05.inc. */ - -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* SCLKDP I Pointing request time. */ -/* TOL I Lookup tolerance. */ -/* NEEDAV I Angular velocity flag. */ -/* RECORD O Data record. */ -/* FOUND O Flag indicating whether record was found. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a CK segment of type 05. */ - -/* SCLKDP is an encoded spacecraft clock time indicating */ -/* the epoch for which pointing is desired. */ - -/* TOL is a time tolerance, measured in the same units as */ -/* encoded spacecraft clock. */ - -/* When SCLKDP falls within the bounds of one of the */ -/* interpolation intervals then the tolerance has no */ -/* effect because pointing will be returned at the */ -/* request time. */ - -/* However, if the request time is not in one of the */ -/* intervals, then the tolerance is used to determine */ -/* if pointing at one of the interval endpoints should */ -/* be returned. */ - -/* NEEDAV is true if angular velocity is requested. */ - -/* $ Detailed_Output */ - -/* RECORD is a set of data from the specified segment which, */ -/* when evaluated at epoch SCLKDP, will give the */ -/* attitude and angular velocity of some body, relative */ -/* to the reference frame indicated by DESCR. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | evaluation epoch | */ -/* +----------------------+ */ -/* | subtype code | */ -/* +----------------------+ */ -/* | number of packets (n)| */ -/* +----------------------+ */ -/* | nominal SCLK rate | */ -/* +----------------------+ */ -/* | packet 1 | */ -/* +----------------------+ */ -/* | packet 2 | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | packet n | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* The packet size is a function of the subtype code. */ -/* All packets in a record have the same size. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine follows the pattern established in the lower-numbered */ -/* CK data type readers of not explicitly performing error */ -/* diagnoses. Exceptions are listed below nonetheless. */ - -/* 1) If the input HANDLE does not designate a loaded CK file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 2) If the segment specified by DESCR is not of data type 05, */ -/* the error 'SPICE(WRONGCKTYPE)' is signaled. */ - -/* 3) If the input SCLK value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signaled. */ - -/* 4) If the window size is non-positive or greater than the */ -/* maximum allowed value, the error SPICE(INVALIDVALUE) is */ -/* signaled. */ - -/* 5) If the window size is not compatible with the segment */ -/* subtype, the error SPICE(INVALIDVALUE) is signaled. */ - -/* 6) If the segment subtype is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 7) If the tolerance is negative, the error SPICE(VALUEOUTOFRANGE) */ -/* is signaled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the CK Required Reading file for a description of the */ -/* structure of a data type 05 segment. */ - -/* $ Examples */ - -/* The data returned by the CKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the CKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* C CALL CKBSS ( INST, SCLKDP, TOL, NEEDAV ) */ -/* CALL CKSNS ( HANDLE, DESCR, SEGID, SFND ) */ - -/* IF ( .NOT. SFND ) THEN */ -/* [Handle case of pointing not being found] */ -/* END IF */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 05 ) THEN */ - -/* CALL CKR05 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */ -/* . RECORD, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* [Handle case of pointing not being found] */ -/* END IF */ - -/* [Look at the RECORD data] */ -/* . */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) Correctness of inputs must be ensured by the caller of */ -/* this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_5 ck segment */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Maximum polynomial degree: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKR05", (ftnlen)5); - -/* No pointing found so far. */ - - *found = FALSE_; - -/* Unpack the segment descriptor, and get the start and end addresses */ -/* of the segment. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[2]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 05 data segment. */ - - if (type__ != 5) { - setmsg_("You are attempting to locate type * data in a type 5 data s" - "egment.", (ftnlen)66); - errint_("*", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGCKTYPE)", (ftnlen)18); - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Check the tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative but was actually *.", (ftnlen) - 50); - errdp_("*", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Check the request time and tolerance against the bounds in */ -/* the segment descriptor. */ - - if (*sclkdp + *tol < dc[0] || *sclkdp - *tol > dc[1]) { - -/* The request time is too far outside the segment's coverage */ -/* interval for any pointing to satisfy the request. */ - - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Set the request time to use for searching. */ - - t = brcktd_(sclkdp, dc, &dc[1]); - -/* From this point onward, we assume the segment was constructed */ -/* correctly. In particular, we assume: */ - -/* 1) The segment descriptor's time bounds are in order and are */ -/* distinct. */ - -/* 2) The epochs in the segment are in strictly increasing */ -/* order. */ - - -/* 3) The interpolation interval start times in the segment are */ -/* in strictly increasing order. */ - - -/* 4) The degree of the interpolating polynomial specified by */ -/* the segment is at least 1 and is no larger than MAXDEG. */ - - - i__1 = end - 4; - dafgda_(handle, &i__1, &end, contrl); - -/* Check the FAILED flag just in case HANDLE is not attached to */ -/* any DAF file and the error action is not set to ABORT. We */ -/* do this only after the first call to DAFGDA, as in CKR03. */ - - if (failed_()) { - chkout_("CKR05", (ftnlen)5); - return 0; - } - rate = contrl[0]; - subtyp = i_dnnt(&contrl[1]); - wndsiz = i_dnnt(&contrl[2]); - nints = i_dnnt(&contrl[3]); - n = i_dnnt(&contrl[4]); - -/* Set the packet size, which is a function of the subtype. */ - - if (subtyp == 0) { - packsz = 8; - } else if (subtyp == 1) { - packsz = 4; - } else if (subtyp == 2) { - packsz = 14; - } else if (subtyp == 3) { - packsz = 7; - } else { - setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", ( - ftnlen)55); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Check the window size. */ - - if (wndsiz <= 0) { - setmsg_("Window size in type 05 segment was #; must be positive.", ( - ftnlen)55); - errint_("#", &wndsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - if (subtyp == 0 || subtyp == 2) { - -/* These are the Hermite subtypes. */ - - maxwnd = 8; - if (wndsiz > maxwnd) { - setmsg_("Window size in type 05 segment was #; max allowed value" - " is # for subtypes 0 and 2 (Hermite, 8 or 14-element pac" - "kets).", (ftnlen)117); - errint_("#", &wndsiz, (ftnlen)1); - errint_("#", &maxwnd, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - if (odd_(&wndsiz)) { - setmsg_("Window size in type 05 segment was #; must be even for " - "subtypes 0 and 2 (Hermite, 8 or 14-element packets).", ( - ftnlen)107); - errint_("#", &wndsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - } else if (subtyp == 1 || subtyp == 3) { - -/* These are the Lagrange subtypes. */ - - maxwnd = 16; - if (wndsiz > maxwnd) { - setmsg_("Window size in type 05 segment was #; max allowed value" - " is # for subtypes 1 and 3 (Lagrange, 4 or 7-element pac" - "kets).", (ftnlen)117); - errint_("#", &wndsiz, (ftnlen)1); - errint_("#", &maxwnd, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - if (odd_(&wndsiz)) { - setmsg_("Window size in type 05 segment was #; must be even for " - "subtypes 1 and 3 (Lagrange, 4 or 7-element packets).", ( - ftnlen)107); - errint_("#", &wndsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - } else { - setmsg_("This point should not be reached. Getting here may indicate" - " that the code needs to updated to handle the new subtype #", - (ftnlen)118); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* We now need to select the pointing values to interpolate */ -/* in order to satisfy the pointing request. The first step */ -/* is to use the pointing directories (if any) to locate a set of */ -/* epochs bracketing the request time. Note that the request */ -/* time might not be bracketed: it could precede the first */ -/* epoch or follow the last epoch. */ - -/* We'll use the variable PGROUP to refer to the set of epochs */ -/* to search. The first group consists of the epochs prior to */ -/* and including the first pointing directory entry. The last */ -/* group consists of the epochs following the last pointing */ -/* directory entry. Other groups consist of epochs following */ -/* one pointing directory entry up to and including the next */ -/* pointing directory entry. */ - - npdir = (n - 1) / 100; - dirbas = begin + n * packsz + n - 1; - if (npdir == 0) { - -/* There's no mystery about which group of epochs to search. */ - - pgroup = 1; - } else { - -/* There's at least one directory. Find the first directory */ -/* whose time is greater than or equal to the request time, if */ -/* there is such a directory. We'll search linearly through the */ -/* directory entries, reading up to DIRSIZ of them at a time. */ -/* Having found the correct set of directory entries, we'll */ -/* perform a binary search within that set for the desired entry. */ - - bufbas = dirbas; - npread = min(npdir,100); - i__1 = bufbas + 1; - i__2 = bufbas + npread; - dafgda_(handle, &i__1, &i__2, pbuffr); - remain = npdir - npread; - while(pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge( - "pbuffr", i__1, "ckr05_", (ftnlen)633)] < t && remain > 0) { - bufbas += npread; - npread = min(remain,100); - -/* Note: NPREAD is always > 0 here. */ - - i__1 = bufbas + 1; - i__2 = bufbas + npread; - dafgda_(handle, &i__1, &i__2, pbuffr); - remain -= npread; - } - -/* At this point, BUFBAS - DIRBAS is the number of directory */ -/* entries preceding the one contained in PBUFFR(1). */ - -/* PGROUP is one more than the number of directories we've */ -/* passed by. */ - - pgroup = bufbas - dirbas + lstltd_(&t, &npread, pbuffr) + 1; - } - -/* PGROUP now indicates the set of epochs in which to search for the */ -/* request epoch. The following cases can occur: */ - -/* PGROUP = 1 */ -/* ========== */ - -/* NPDIR = 0 */ -/* -------- */ -/* The request time may precede the first time tag */ -/* of the segment, exceed the last time tag, or lie */ -/* in the closed interval bounded by these time tags. */ - -/* NPDIR >= 1 */ -/* --------- */ -/* The request time may precede the first time tag */ -/* of the group but does not exceed the last epoch */ -/* of the group. */ - - -/* 1 < PGROUP <= NPDIR */ -/* =================== */ - -/* The request time follows the last time of the */ -/* previous group and is less than or equal to */ -/* the pointing directory entry at index PGROUP. */ - -/* 1 < PGROUP = NPDIR + 1 */ -/* ====================== */ - -/* The request time follows the last time of the */ -/* last pointing directory entry. The request time */ -/* may exceed the last time tag. */ - - -/* Now we'll look up the time tags in the group of epochs */ -/* we've identified. */ - -/* We'll use the variable names PBEGIX and PENDIX to refer to */ -/* the indices, relative to the set of time tags, of the first */ -/* and last time tags in the set we're going to look up. */ - - if (pgroup == 1) { - pbegix = 1; - pendix = min(n,100); - } else { - -/* If the group index is greater than 1, we'll include the last */ -/* time tag of the previous group in the set of time tags we look */ -/* up. That way, the request time is strictly bracketed on the */ -/* low side by the time tag set we look up. */ - - pbegix = (pgroup - 1) * 100; -/* Computing MIN */ - i__1 = pbegix + 100; - pendix = min(i__1,n); - } - timbas = dirbas - n; - i__1 = timbas + pbegix; - i__2 = timbas + pendix; - dafgda_(handle, &i__1, &i__2, pbuffr); - npread = pendix - pbegix + 1; - -/* At this point, we'll deal with the cases where T lies outside */ -/* of the range of epochs we've buffered. */ - - if (t < pbuffr[0]) { - -/* This can happen only if PGROUP = 1 and T precedes all epochs. */ -/* If the input request time is too far from PBUFFR(1) on */ -/* the low side, we're done. */ - - if (*sclkdp + *tol < pbuffr[0]) { - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Bracket T to move it within the range of buffered epochs. */ - - t = pbuffr[0]; - } else if (t > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : - s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)748)]) { - -/* This can happen only if T follows all epochs. */ - - if (*sclkdp - *tol > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)752)]) { - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Bracket T to move it within the range of buffered epochs. */ - - t = pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge( - "pbuffr", i__1, "ckr05_", (ftnlen)762)]; - } - -/* At this point, */ - -/* | T - SCLKDP | <= TOL */ - -/* Also, one of the following is true: */ - -/* T is the first time of the segment */ - -/* T is the last time of the segment */ - -/* T equals SCLKDP */ - - - -/* Find two adjacent time tags bounding the request epoch. The */ -/* request time cannot be greater than all of time tags in the */ -/* group, and it cannot precede the first element of the group. */ - - i__ = lstltd_(&t, &npread, pbuffr); - -/* The variables LOW and HIGH are the indices of a pair of time */ -/* tags that bracket the request time. Remember that NPREAD could */ -/* be equal to 1, in which case we would have LOW = HIGH. */ - - if (i__ == 0) { - -/* This can happen only if PGROUP = 1 and T = PBUFFR(1). */ - - low = 1; - lepoch = pbuffr[0]; - if (n == 1) { - high = 1; - } else { - high = 2; - } - hepoch = pbuffr[(i__1 = high - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge( - "pbuffr", i__1, "ckr05_", (ftnlen)805)]; - } else { - low = pbegix + i__ - 1; - lepoch = pbuffr[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge( - "pbuffr", i__1, "ckr05_", (ftnlen)810)]; - high = low + 1; - hepoch = pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbu" - "ffr", i__1, "ckr05_", (ftnlen)813)]; - } - -/* We now need to find the interpolation interval containing */ -/* T, if any. We may be able to use the interpolation */ -/* interval found on the previous call to this routine. If */ -/* this is the first call or if the previous interval is not */ -/* applicable, we'll search for the interval. */ - -/* First check if the request time falls in the same interval as */ -/* it did last time. We need to make sure that we are dealing */ -/* with the same segment as well as the same time range. */ - - -/* PREVS is the start time of the interval that satisfied */ -/* the previous request for pointing. */ - -/* PREVN is the start time of the interval that followed */ -/* the interval specified above. */ - -/* PREVNN is the start time of the interval that followed */ -/* the interval starting at PREVN. */ - -/* LHAND is the handle of the file that PREVS and PREVN */ -/* were found in. */ - -/* LBEG, are the beginning and ending addresses of the */ -/* LEND segment in the file LHAND that PREVS and PREVN */ -/* were found in. */ - - if (*handle == lhand && begin == lbeg && end == lend && t >= prevs && t < - prevn) { - start = prevs; - nstart = prevn; - nnstrt = prevnn; - } else { - -/* Search for the interpolation interval. */ - - nidir = (nints - 1) / 100; - dirbas = end - 5 - nidir; - if (nidir == 0) { - -/* There's no mystery about which group of epochs to search. */ - - sgroup = 1; - } else { - -/* There's at least one directory. Find the first directory */ -/* whose time is greater than or equal to the request time, if */ -/* there is such a directory. We'll search linearly through */ -/* the directory entries, reading up to DIRSIZ of them at a */ -/* time. Having found the correct set of directory entries, */ -/* we'll perform a binary search within that set for the */ -/* desired entry. */ - - bufbas = dirbas; - nsread = min(nidir,100); - remain = nidir - nsread; - i__1 = bufbas + 1; - i__2 = bufbas + nsread; - dafgda_(handle, &i__1, &i__2, sbuffr); - while(sbuffr[(i__1 = nsread - 1) < 103 && 0 <= i__1 ? i__1 : - s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)885)] < t && - remain > 0) { - bufbas += nsread; - nsread = min(remain,100); - remain -= nsread; - -/* Note: NSREAD is always > 0 here. */ - - i__1 = bufbas + 1; - i__2 = bufbas + nsread; - dafgda_(handle, &i__1, &i__2, sbuffr); - } - -/* At this point, BUFBAS - DIRBAS is the number of directory */ -/* entries preceding the one contained in SBUFFR(1). */ - -/* SGROUP is one more than the number of directories we've */ -/* passed by. */ - - sgroup = bufbas - dirbas + lstltd_(&t, &nsread, sbuffr) + 1; - } - -/* SGROUP now indicates the set of interval start times in which */ -/* to search for the request epoch. */ - -/* Now we'll look up the time tags in the group of epochs we've */ -/* identified. */ - -/* We'll use the variable names SBEGIX and SENDIX to refer to the */ -/* indices, relative to the set of start times, of the first and */ -/* last start times in the set we're going to look up. */ - - if (sgroup == 1) { - sbegix = 1; - sendix = min(nints,102); - } else { - -/* Look up the start times for the group of interest. Also */ -/* buffer last start time from the previous group. Also, it */ -/* turns out to be useful to pick up two extra start */ -/* times---the first two start times of the next group---if */ -/* they exist. */ - - sbegix = (sgroup - 1) * 100; -/* Computing MIN */ - i__1 = sbegix + 102; - sendix = min(i__1,nints); - } - timbas = dirbas - nints; - i__1 = timbas + sbegix; - i__2 = timbas + sendix; - dafgda_(handle, &i__1, &i__2, sbuffr); - nsread = sendix - sbegix + 1; - -/* Find the last interval start time less than or equal to the */ -/* request time. We know T is greater than or equal to the */ -/* first start time, so I will be > 0. */ - - nsrch = min(101,nsread); - i__ = lstled_(&t, &nsrch, sbuffr); - start = sbuffr[(i__1 = i__ - 1) < 103 && 0 <= i__1 ? i__1 : s_rnge( - "sbuffr", i__1, "ckr05_", (ftnlen)956)]; - -/* Let NSTART ("next start") be the start time that follows */ -/* START, if START is not the last start time. If NSTART */ -/* has a successor, let NNSTRT be that start time. */ - - if (i__ < nsread) { - nstart = sbuffr[(i__1 = i__) < 103 && 0 <= i__1 ? i__1 : s_rnge( - "sbuffr", i__1, "ckr05_", (ftnlen)965)]; - if (i__ + 1 < nsread) { - nnstrt = sbuffr[(i__1 = i__ + 1) < 103 && 0 <= i__1 ? i__1 : - s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)969)]; - } else { - nnstrt = dpmax_(); - } - } else { - nstart = dpmax_(); - nnstrt = dpmax_(); - } - } - -/* If T does not lie within the interpolation interval starting */ -/* at time START, we'll determine whether T is closer to this */ -/* interval or the next. If the distance between T and the */ -/* closer interval is less than or equal to TOL, we'll map T */ -/* to the closer endpoint of the closer interval. Otherwise, */ -/* we return without finding pointing. */ - - if (hepoch == nstart) { - -/* The first time tag greater than or equal to T is the start */ -/* time of the next interpolation interval. */ - -/* The request time lies between interpolation intervals. */ -/* LEPOCH is the last time tag of the first interval; HEPOCH */ -/* is the first time tag of the next interval. */ - - if ((d__1 = t - lepoch, abs(d__1)) <= (d__2 = hepoch - t, abs(d__2))) - { - -/* T is closer to the first interval... */ - - if ((d__1 = t - lepoch, abs(d__1)) > *tol) { - -/* ...But T is too far from the interval. */ - - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Map T to the right endpoint of the preceding interval. */ - - t = lepoch; - high = low; - hepoch = lepoch; - } else { - -/* T is closer to the second interval... */ - - if ((d__1 = hepoch - t, abs(d__1)) > *tol) { - -/* ...But T is too far from the interval. */ - - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Map T to the left endpoint of the next interval. */ - - t = hepoch; - low = high; - lepoch = hepoch; - -/* Since we're going to be picking time tags from the next */ -/* interval, we'll need to adjust START and NSTART. */ - - start = nstart; - nstart = nnstrt; - } - } - -/* We now have */ - -/* LEPOCH < T < HEPOCH */ -/* - - */ - -/* where LEPOCH and HEPOCH are the time tags at indices */ -/* LOW and HIGH, respectively. */ - -/* Now select the set of packets used for interpolation. Note */ -/* that the window size is known to be even. */ - -/* Unlike CK types 8, 9, 12, and 13, for type 05 we adjust */ -/* the window size to keep the request time within the central */ -/* interval of the window. */ - -/* The nominal bracketing epochs we've found are the (WNDSIZ/2)nd */ -/* and (WNDSIZ/2 + 1)st of the interpolating set. If the request */ -/* time is too close to one end of the interpolation interval, we */ -/* reduce the window size, after which one endpoint of the window */ -/* will coincide with an endpoint of the interpolation interval. */ - -/* We start out by looking up the set of time tags we'd use */ -/* if there were no gaps in the coverage. We then trim our */ -/* time tag set to ensure all tags are in the interpolation */ -/* interval. It's possible that the interpolation window will */ -/* collapse to a single point as a result of this last step. */ - -/* Let LSIZE be the size of the "left half" of the window: the */ -/* size of the set of window epochs to the left of the request time. */ -/* We want this size to be WNDSIZ/2, but if not enough states are */ -/* available, the set ranges from index 1 to index LOW. */ - -/* Computing MIN */ - i__1 = wndsiz / 2; - lsize = min(i__1,low); - -/* RSIZE is defined analogously for the right half of the window. */ - -/* Computing MIN */ - i__1 = wndsiz / 2, i__2 = n - high + 1; - rsize = min(i__1,i__2); - -/* The window size is simply the sum of LSIZE and RSIZE. */ - - wndsiz = lsize + rsize; - -/* FIRST and LAST are the endpoints of the range of indices of */ -/* time tags (and packets) we'll collect in the output record. */ - - first = low - lsize + 1; - last = first + wndsiz - 1; - -/* Buffer the epochs. */ - - wstart = begin + n * packsz + first - 1; - i__1 = wstart + wndsiz - 1; - dafgda_(handle, &wstart, &i__1, pbuffr); - -/* Discard any epochs less than START or greater than or equal */ -/* to NSTART. The set of epochs we want ranges from indices */ -/* I+1 to J. This range is non-empty unless START and NSTART */ -/* are both DPMAX(). */ - - i__ = lstltd_(&start, &wndsiz, pbuffr); - j = lstltd_(&nstart, &wndsiz, pbuffr); - if (i__ == j) { - -/* Fuggedaboudit. */ - - chkout_("CKR05", (ftnlen)5); - return 0; - } - -/* Update FIRST, LAST, and WNDSIZ. */ - - wndsiz = j - i__; - first += i__; - last = first + wndsiz - 1; - -/* Put the subtype into the output record. The size of the group */ -/* of packets is derived from the subtype, so we need not include */ -/* the size. */ - - record[0] = t; - record[1] = (doublereal) subtyp; - record[2] = (doublereal) wndsiz; - record[3] = rate; - -/* Read the packets. */ - - i__1 = begin + (first - 1) * packsz; - i__2 = begin + last * packsz - 1; - dafgda_(handle, &i__1, &i__2, &record[4]); - -/* Finally, add the epochs to the output record. */ - - i__2 = j - i__; - moved_(&pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbuffr", - i__1, "ckr05_", (ftnlen)1158)], &i__2, &record[wndsiz * packsz + - 4]); - -/* Save the information about the interval and segment. */ - - lhand = *handle; - lbeg = begin; - lend = end; - prevs = start; - prevn = nstart; - prevnn = nnstrt; - -/* Indicate pointing was found. */ - - *found = TRUE_; - chkout_("CKR05", (ftnlen)5); - return 0; -} /* ckr05_ */ - diff --git a/ext/spice/src/cspice/ckupf_c.c b/ext/spice/src/cspice/ckupf_c.c deleted file mode 100644 index b4f9ca2781..0000000000 --- a/ext/spice/src/cspice/ckupf_c.c +++ /dev/null @@ -1,146 +0,0 @@ -/* - --Procedure ckupf_c ( C-kernel, Unload pointing file ) - --Abstract - - Unload a CK pointing file so that it will no longer be searched - by the readers. - --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 - - CK - DAF - --Keywords - - POINTING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ckupf_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of CK file to be unloaded - --Detailed_Input - - handle Integer handle assigned to the file upon loading. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If the file specified by handle does not appear in the file - table, nothing happens. - --Files - - The file referred to by handle is unloaded. - --Particulars - - See Particulars section above, in ckbsr.for. - - Unloading a file with ckupf_c removes that file from consideration - by the CK readers. In doing so, it frees up space for another - file to be loaded. - --Examples - - See the Example in ckbsr.for. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - J.M. Lynch (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 1.0.2, 31-JAN-2008 (BVS) - - Removed '-Revisions' from the header. - - -CSPICE Version 1.0.1, 03-JUN-2003 (EDW) - - Correct typo in Procedure line. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - unload ck pointing file - --& -*/ - -{ /* Begin ckupf_c */ - - /* - Participate in error handling - */ - - chkin_c ( "ckupf_c"); - - - /* - Call the f2c'd Fortran routine. - */ - ckupf_ ( &handle ); - - - chkout_c ( "ckupf_c"); - -} /* End ckupf_c */ diff --git a/ext/spice/src/cspice/ckw01.c b/ext/spice/src/cspice/ckw01.c deleted file mode 100644 index d38db86374..0000000000 --- a/ext/spice/src/cspice/ckw01.c +++ /dev/null @@ -1,772 +0,0 @@ -/* ckw01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__4 = 4; -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure CKW01 ( C-Kernel, write segment to C-kernel, data type 1 ) */ -/* Subroutine */ int ckw01_(integer *handle, doublereal *begtim, doublereal * - endtim, integer *inst, char *ref, logical *avflag, char *segid, - integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal * - avvs, ftnlen ref_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Local variables */ - integer ndir, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer index, value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( - doublereal *, integer *), dafbna_(integer *, doublereal *, char *, - ftnlen), dafena_(void); - extern logical failed_(void); - integer refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - doublereal dirent; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical vzerog_(doublereal *, integer *), return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Add a type 1 segment to a C-kernel. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ -/* SCLK */ - -/* $ Keywords */ - -/* POINTING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open CK file. */ -/* BEGTIM I The beginning encoded SCLK of the segment. */ -/* ENDTIM I The ending encoded SCLK of the segment. */ -/* INST I The NAIF instrument ID code. */ -/* REF I The reference frame of the segment. */ -/* AVFLAG I True if the segment will contain angular velocity. */ -/* SEGID I Segment identifier. */ -/* NREC I Number of pointing records. */ -/* SCLKDP I Encoded SCLK times. */ -/* QUATS I SPICE quaternions representing instrument pointing. */ -/* AVVS I Angular velocity vectors. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the CK file to which the segment will */ -/* be written. The file must have been opened with write */ -/* access. */ - -/* BEGTIM is the beginning encoded SCLK time of the segment. This */ -/* value should be less than or equal to the first time in */ -/* the segment. */ - -/* ENDTIM is the encoded SCLK time at which the segment ends. */ -/* This value should be greater than or equal to the last */ -/* time in the segment. */ - -/* INST is the NAIF integer ID code for the instrument. */ - -/* REF is a character string which specifies the */ -/* reference frame of the segment. This should be one of */ -/* the frames supported by the SPICELIB routine NAMFRM */ -/* which is an entry point of FRAMEX. */ - -/* AVFLAG is a logical flag which indicates whether or not the */ -/* segment will contain angular velocity. */ - -/* SEGID is the segment identifier. A CK segment identifier may */ -/* contain up to 40 characters. */ - -/* NREC is the number of pointing instances in the segment. */ - -/* SCLKDP are the encoded spacecraft clock times associated with */ -/* each pointing instance. These times must be strictly */ -/* increasing. */ - -/* QUATS is an array of SPICE-style quaternions representing a */ -/* sequence of C-matrices. See the discussion of */ -/* quaternion styles in Particulars below. */ - -/* AVVS are the angular velocity vectors ( optional ). */ - -/* If AVFLAG is FALSE then this array is ignored by the */ -/* routine, however it still must be supplied as part of */ -/* the calling sequence. */ - -/* $ Detailed_Output */ - -/* None. See Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is not the handle of a C-kernel opened for writing */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 2) If SEGID is more than 40 characters long, the error */ -/* SPICE(SEGIDTOOLONG) is signalled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 4) If the first encoded SCLK time is negative then the error */ -/* SPICE(INVALIDSCLKTIME) is signalled. If any subsequent times */ -/* are negative the error SPICE(TIMESOUTOFORDER) is signalled. */ - -/* 5) If the encoded SCLK times are not strictly increasing, */ -/* the error SPICE(TIMESOUTOFORDER) is signalled. */ - -/* 6) If BEGTIM is greater than SCLKDP(1) or ENDTIM is less than */ -/* SCLKDP(NREC), the error SPICE(INVALIDDESCRTIME) is */ -/* signalled. */ - -/* 7) If the name of the reference frame is not one of those */ -/* supported by the routine NAMFRM, the error */ -/* SPICE(INVALIDREFFRAME) is signalled. */ - -/* 8) If NREC, the number of pointing records, is less than or */ -/* equal to 0, the error SPICE(INVALIDNUMRECS) is signalled. */ - -/* 9) If the squared length of any quaternion differes from 1 */ -/* by more than 1.0D-2, the error SPICE(NONUNITQUATERNION) is */ -/* signalled. */ - -/* $ Files */ - -/* This routine adds a type 1 segment to a C-kernel. The C-kernel */ -/* may be either a new one or an existing one opened for writing. */ - -/* $ Particulars */ - -/* For a detailed description of a type 1 CK segment please see the */ -/* CK Required Reading. */ - -/* This routine relieves the user from performing the repetitive */ -/* calls to the DAF routines necessary to construct a CK segment. */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* C */ -/* C This example writes a type 1 C-kernel segment for the */ -/* C Galileo scan platform to a previously opened file attached to */ -/* C HANDLE. */ - -/* C */ -/* C Assume arrays of quaternions, angular velocities, and the */ -/* C associated SCLK times are produced elsewhere. */ -/* C */ -/* . */ -/* . */ -/* . */ - -/* C */ -/* C The subroutine CKW01 needs the following items for the */ -/* C segment descriptor: */ -/* C */ -/* C 1) SCLK limits of the segment. */ -/* C 2) Instrument code. */ -/* C 3) Reference frame. */ -/* C 4) The angular velocity flag. */ -/* C */ -/* BEGTIM = SCLK ( 1 ) */ -/* ENDTIM = SCLK ( NREC ) */ - -/* INST = -77001 */ -/* REF = 'J2000' */ -/* AVFLAG = .TRUE. */ - -/* SEGID = 'GLL SCAN PLT - DATA TYPE 1' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL CKW01 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */ -/* . SEGID, NREC, SCLKDP, QUATS, AVVS ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 01-JUN-2010 (NJB) */ - -/* The check for non-unit quaternions has been replaced */ -/* with a check for zero-length quaternions. */ - -/* - SPICELIB Version 2.2.0, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* Minor typo in a long error message was corrected. */ - -/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */ - -/* Added check to make sure that all quaternions are unit */ -/* length to single precision. */ - -/* - SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ - -/* Removed all references to a specific method of opening the CK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ -/* $ Files, and $ Examples sections of the header. It is assumed */ -/* that a person using this routine has some knowledge of the DAF */ -/* system and the methods for obtaining file handles. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* If the number of pointing records is not positive an error */ -/* is now signalled. */ - -/* FAILED is checked after the call to DAFBNA. */ - -/* The variable HLDCLK was removed from the loop where the times */ -/* were checked. */ - -/* - 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, 30-AUG-1991 (JML) (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write ck type_1 pointing data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ - -/* Removed all references to a specific method of opening the CK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ -/* $ Files, and $ Examples sections of the header. It is assumed */ -/* that a person using this routine has some knowledge of the DAF */ -/* system and the methods for obtaining file handles. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* If the number of pointing records is not positive an error */ -/* is now signalled. */ - -/* FAILED is checked after the call to DAFBNA. */ - -/* The variable HLDCLK was removed from the loop where the times */ -/* were checked. */ - -/* - 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, 30-AUG-1991 (JML) (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* SIDLEN is the maximum number of characters allowed in a CK */ -/* segment identifier. */ - -/* NDC is the size of a packed CK segment descriptor. */ - -/* ND is the number of double precision components in a CK */ -/* segment descriptor. */ - -/* NI is the number of integer components in a CK segment */ -/* descriptor. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII */ -/* character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKW01", (ftnlen)5); - -/* The first thing that we will do is create the segment descriptor. */ - -/* The structure of the segment descriptor is as follows. */ - -/* DCD( 1 ) and DCD( 2 ) -- SCLK limits of the segment. */ -/* ICD( 1 ) -- Instrument code. */ -/* ICD( 2 ) -- Reference frame ID. */ -/* ICD( 3 ) -- Data type of the segment. */ -/* ICD( 4 ) -- Angular rates flag. */ -/* ICD( 5 ) -- Beginning address of segment. */ -/* ICD( 6 ) -- Ending address of segment. */ - - -/* Make sure that there is a positive number of pointing records. */ - - if (*nrec <= 0) { - setmsg_("# is an invalid number of pointing instances for type 1.", ( - ftnlen)56); - errint_("#", nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMREC)", (ftnlen)20); - chkout_("CKW01", (ftnlen)5); - return 0; - } - -/* Check that the SCLK bounds on the segment are reasonable. */ - - if (*begtim > sclkdp[0]) { - setmsg_("The first d.p. component of the descriptor is invalid. DCD(" - "1) = # and SCLKDP(1) = # ", (ftnlen)84); - errdp_("#", begtim, (ftnlen)1); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); - chkout_("CKW01", (ftnlen)5); - return 0; - } - if (*endtim < sclkdp[*nrec - 1]) { - setmsg_("The second d.p. component of the descriptor is invalid. DCD" - "(2) = # and SCLKDP(NREC) = # ", (ftnlen)88); - errdp_("#", endtim, (ftnlen)1); - errdp_("#", &sclkdp[*nrec - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); - chkout_("CKW01", (ftnlen)5); - return 0; - } - dcd[0] = *begtim; - dcd[1] = *endtim; - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(ref, &refcod, ref_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("CKW01", (ftnlen)5); - return 0; - } - -/* Assign values to the integer components of the segment descriptor. */ - - icd[0] = *inst; - icd[1] = refcod; - icd[2] = 1; - if (*avflag) { - icd[3] = 1; - } else { - icd[3] = 0; - } - -/* Now pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Check that all the characters in the segid can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CKW01", (ftnlen)5); - return 0; - } - } - -/* Also check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("CKW01", (ftnlen)5); - return 0; - } - -/* Now check that the encoded SCLK times are positive and strictly */ -/* increasing. */ - -/* Check that the first time is nonnegative. */ - - if (sclkdp[0] < 0.) { - setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22); - chkout_("CKW01", (ftnlen)5); - return 0; - } - -/* Now check that the times are ordered properly. */ - - i__1 = *nrec; - for (i__ = 2; i__ <= i__1; ++i__) { - if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) { - setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)" - " = # and SCLKDP(#) = #.", (ftnlen)78); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &sclkdp[i__ - 1], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &sclkdp[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("CKW01", (ftnlen)5); - return 0; - } - } - -/* Make sure that the quaternions are non-zero. This is just */ -/* a check for uninitialized data. */ - - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - if (vzerog_(&quats[(i__ << 2) - 4], &c__4)) { - setmsg_("The quaternion at index # has magnitude zero.", (ftnlen) - 45); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21); - chkout_("CKW01", (ftnlen)5); - return 0; - } - } - -/* No more checks, begin writing the segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("CKW01", (ftnlen)5); - return 0; - } - -/* Now add the quaternions and optionally, the angular velocity */ -/* vectors. */ - - if (*avflag) { - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&quats[(i__ << 2) - 4], &c__4); - dafada_(&avvs[i__ * 3 - 3], &c__3); - } - } else { - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&quats[(i__ << 2) - 4], &c__4); - } - } - -/* Add the SCLK times. */ - - dafada_(sclkdp, nrec); - -/* The time tag directory. The Ith element is defined to be the */ -/* average of the (I*100)th and the (I*100+1)st SCLK time. */ - - ndir = (*nrec - 1) / 100; - index = 100; - i__1 = ndir; - for (i__ = 1; i__ <= i__1; ++i__) { - dirent = (sclkdp[index - 1] + sclkdp[index]) / 2.; - dafada_(&dirent, &c__1); - index += 100; - } - -/* Finally, the number of records. */ - - d__1 = (doublereal) (*nrec); - dafada_(&d__1, &c__1); - -/* End the segment. */ - - dafena_(); - chkout_("CKW01", (ftnlen)5); - return 0; -} /* ckw01_ */ - diff --git a/ext/spice/src/cspice/ckw01_c.c b/ext/spice/src/cspice/ckw01_c.c deleted file mode 100644 index e3f7902fcc..0000000000 --- a/ext/spice/src/cspice/ckw01_c.c +++ /dev/null @@ -1,546 +0,0 @@ -/* - --Procedure ckw01_c ( C-Kernel, write segment to C-kernel, data type 1 ) - --Abstract - - Add a type 1 segment to a C-kernel. - --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 - - CK - DAF - SCLK - --Keywords - - POINTING - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ckw01_c - - - void ckw01_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an open CK file. - begtim I The beginning encoded SCLK of the segment. - endtim I The ending encoded SCLK of the segment. - inst I The NAIF instrument ID code. - ref I The reference frame of the segment. - avflag I True if the segment will contain angular velocity. - segid I Segment identifier. - nrec I Number of pointing records. - sclkdp I Encoded SCLK times. - quats I Quaternions representing instrument pointing. - avvs I Angular velocity vectors. - --Detailed_Input - - handle is the handle of the CK file to which the segment will - be written. The file must have been opened with write - access. - - begtim is the beginning encoded SCLK time of the segment. This - value should be less than or equal to the first time in - the segment. - - endtim is the encoded SCLK time at which the segment ends. - This value should be greater than or equal to the last - time in the segment. - - inst is the NAIF integer ID code for the instrument. - - ref is a character string which specifies the - reference frame of the segment. This should be one of - the frames supported by the SPICELIB routine NAMFRM - which is an entry point of FRAMEX. - - avflag is a logical flag which indicates whether or not the - segment will contain angular velocity. - - segid is the segment identifier. A CK segment identifier may - contain up to 40 characters, excluding the terminating - null. - - nrec is the number of pointing instances in the segment. - - sclkdp are the encoded spacecraft clock times associated with - each pointing instance. These times must be strictly - increasing. - - quats is an array of SPICE-style quaternions representing a - sequence of C-matrices. See the discussion of "Quaternion - Styles" in the Particulars section below. - - avvs are the angular velocity vectors (optional). - - If avflag is FALSE then this array is ignored by the - routine, however it still must be supplied as part of - the calling sequence. - --Detailed_Output - - None. See Files section. - --Parameters - - None. - --Exceptions - - 1) If handle is not the handle of a C-kernel opened for writing - the error will be diagnosed by routines called by this - routine. - - 2) If segid is more than 40 characters long, the error - SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If the first encoded SCLK time is negative then the error - SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times - are negative the error SPICE(TIMESOUTOFORDER) is signaled. - - 5) If the encoded SCLK times are not strictly increasing, - the error SPICE(TIMESOUTOFORDER) is signaled. - - 6) If begtim is greater than sclkdp[0] or endtim is less than - sclkdp[nrec-1], the error SPICE(INVALIDDESCRTIME) is - signaled. - - 7) If the name of the reference frame is not one of those - supported by the SPICELIB routine NAMFRM, the error - SPICE(INVALIDREFFRAME) is signaled. - - 8) If nrec, the number of pointing records, is less than or - equal to 0, the error SPICE(INVALIDNUMRECS) is signaled. - - 9) If any quaternion has magnitude zero, the error - SPICE(ZEROQUATERNION) is signaled. - - --Files - - This routine adds a type 1 segment to a C-kernel. The C-kernel - may be either a new one or an existing one opened for writing. - --Particulars - - For a detailed description of a type 1 CK segment please see the - CK Required Reading. - - This routine relieves the user from performing the repetitive - calls to the DAF routines necessary to construct a CK segment. - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - - This example writes a type 1 C-kernel segment for the - Galileo scan platform to a previously opened file attached to - handle. - - /. - Include CSPICE interface definitions. - ./ - #include "SpiceUsr.h" - . - . - . - /. - Assume arrays of quaternions, angular velocities, and the - associated SCLK times are produced elsewhere. - ./ - . - . - . - /. - The subroutine ckw01_c needs the following items for the - segment descriptor: - - 1) SCLK limits of the segment. - 2) Instrument code. - 3) Reference frame. - 4) The angular velocity flag. - ./ - - begtim = (SpiceChar *) sclk[0]; - endtim = (SpiceChar *) sclk[nrec-1]; - - inst = -77001; - ref = "J2000"; - avflag = SPICETRUE; - segid = "GLL SCAN PLT - DATA TYPE 1"; - - /. - Write the segment. - ./ - ckw01_c ( handle, begtim, endtim, inst, ref, avflag, - segid, nrec, sclkdp, quats, avvs ); - - . - . - . - - /. - After all segments are written, close the C-kernel. - ./ - ckcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - N.J. Bachman (JPL) - J.M. Lynch (JPL) - --Version - - -CSPICE Version 2.0.0, 01-JUN-2010 (NJB) - - The check for non-unit quaternions has been replaced - with a check for zero-length quaternions. (The - implementation of the check is located in ckw01_.) - - -CSPICE Version 1.3.2, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. - - -CSPICE Version 1.3.1, 12-JUN-2006 (NJB) - - Corrected typo in example, the sclk indexes for the begtim - and endtim assignments used FORTRAN convention. - - -CSPICE Version 1.3.0, 28-AUG-2001 (NJB) - - Changed prototype: inputs sclkdp, quats, and avvs are now - const-qualified. Implemented interface macros for casting - these inputs to const. - - -CSPICE Version 1.2.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for angular velocity - flag used in interface of ckw01_. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) - --Index_Entries - - write ck type_1 pointing data segment - --& -*/ - -{ /* Begin ckw01_c */ - - - /* - Local variables - */ - logical avf; - - - /* - Participate in error handling. - */ - chkin_c ( "ckw01_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckw01_c", ref ); - CHKFSTR ( CHK_STANDARD, "ckw01_c", segid ); - - /* - Get a type logical copy of the a.v. flag. - */ - avf = avflag; - - - /* - Write the segment. Note that the quaternion and angular velocity - arrays DO NOT require transposition! - */ - - ckw01_( ( integer * ) &handle, - ( doublereal * ) &begtim, - ( doublereal * ) &endtim, - ( integer * ) &inst, - ( char * ) ref, - ( logical * ) &avf, - ( char * ) segid, - ( integer * ) &nrec, - ( doublereal * ) sclkdp, - ( doublereal * ) quats, - ( doublereal * ) avvs, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "ckw01_c" ); - -} /* End ckw01_c */ diff --git a/ext/spice/src/cspice/ckw02.c b/ext/spice/src/cspice/ckw02.c deleted file mode 100644 index 599f893770..0000000000 --- a/ext/spice/src/cspice/ckw02.c +++ /dev/null @@ -1,839 +0,0 @@ -/* ckw02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__4 = 4; -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure CKW02 ( C-Kernel, write segment to C-kernel, data type 2 ) */ -/* Subroutine */ int ckw02_(integer *handle, doublereal *begtim, doublereal * - endtim, integer *inst, char *ref, char *segid, integer *nrec, - doublereal *start, doublereal *stop, doublereal *quats, doublereal * - avvs, doublereal *rates, ftnlen ref_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer ndir, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer index, value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( - doublereal *, integer *), dafbna_(integer *, doublereal *, char *, - ftnlen), dafena_(void); - extern logical failed_(void); - integer refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - doublereal dirent; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical vzerog_(doublereal *, integer *), return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Write a type 2 segment to a C-kernel. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ -/* SCLK */ - -/* $ Keywords */ - -/* POINTING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open CK file. */ -/* BEGTIM I The beginning encoded SCLK of the segment. */ -/* ENDTIM I The ending encoded SCLK of the segment. */ -/* INST I The NAIF instrument ID code. */ -/* REF I The reference frame of the segment. */ -/* SEGID I Segment identifier. */ -/* NREC I Number of pointing records. */ -/* START I Encoded SCLK interval start times. */ -/* STOP I Encoded SCLK interval stop times. */ -/* QUATS I SPICE quaternions representing instrument pointing. */ -/* AVVS I Angular velocity vectors. */ -/* RATES I Number of seconds per tick for each interval. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the CK file to which the segment will */ -/* be written. The file must have been opened with write */ -/* access. */ - -/* BEGTIM is the beginning encoded SCLK time of the segment. This */ -/* value should be less than or equal to the first START */ -/* time in the segment. */ - -/* ENDTIM is the encoded SCLK time at which the segment ends. */ -/* This value should be greater than or equal to the last */ -/* STOP time in the segment. */ - -/* INST is the NAIF integer ID code for the instrument. */ - -/* REF is a character string that specifies the */ -/* reference frame of the segment. This should be one of */ -/* the frames supported by the SPICELIB routine NAMFRM */ -/* which is an entry point to FRAMEX. */ - -/* SEGID is the segment identifier. A CK segment identifier may */ -/* contain up to 40 characters. */ - -/* NREC is the number of pointing intervals that will be */ -/* written to the segment. */ - -/* START are the start times of each interval in encoded */ -/* spacecraft clock. These times must be strictly */ -/* increasing. */ - -/* STOP are the stop times of each interval in encoded */ -/* spacecraft clock. These times must be greater than */ -/* the START times that they correspond to but less */ -/* than or equal to the START time of the next interval. */ - -/* QUATS is an array of SPICE-style quaternions representing */ -/* the C-matrices associated with the start times of each */ -/* interval. See the discussion of quaternion styles in */ -/* Particulars below. */ - -/* AVVS are the angular velocity vectors for each interval. */ - -/* RATES are the number of seconds per encoded spacecraft clock */ -/* tick for each interval. */ - -/* In most applications this value will be the same for */ -/* each interval within a segment. For example, when */ -/* constructing a predict C-kernel for Mars Observer, the */ -/* rate would be 1/256 for each interval since this is */ -/* the smallest time unit expressible by the MO clock. The */ -/* nominal seconds per tick rates for Galileo and Voyager */ -/* are 1/120 and 0.06 respectively. */ - -/* $ Detailed_Output */ - -/* None. See Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is not the handle of a C-kernel opened for writing */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 2) If SEGID is more than 40 characters long, the error */ -/* SPICE(SEGIDTOOLONG) is signalled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 4) If the first START time is negative, the error */ -/* SPICE(INVALIDSCLKTIME) is signalled. If any of the subsequent */ -/* START times are negative the error SPICE(TIMESOUTOFORDER) */ -/* will be signalled. */ - -/* 5) If any of the STOP times are negative, the error */ -/* SPICE(DEGENERATEINTERVAL) is signalled. */ - -/* 6) If the STOP time of any of the intervals is less than or equal */ -/* to the START time, the error SPICE(DEGENERATEINTERVAL) is */ -/* signalled. */ - -/* 7) If the START times are not strictly increasing, the */ -/* error SPICE(TIMESOUTOFORDER) is signalled. */ - -/* 8) If the STOP time of one interval is greater than the START */ -/* time of the next interval, the error SPICE(BADSTOPTIME) */ -/* is signalled. */ - -/* 9) If BEGTIM is greater than START(1) or ENDTIM is less than */ -/* STOP(NREC), the error SPICE(INVALIDDESCRTIME) is */ -/* signalled. */ - -/* 10) If the name of the reference frame is not one of those */ -/* supported by the routine NAMFRM, the error */ -/* SPICE(INVALIDREFFRAME) is signalled. */ - -/* 11) If NREC, the number of pointing records, is less than or */ -/* equal to 0, the error SPICE(INVALIDNUMRECS) is signalled. */ - -/* 12) If the squared length of any quaternion differes from 1 */ -/* by more than 1.0D-2, the error SPICE(NONUNITQUATERNION) is */ -/* signalled. */ - -/* $ Files */ - -/* This routine adds a type 2 segment to a C-kernel. The C-kernel */ -/* may be either a new one or an existing one opened for writing. */ - -/* $ Particulars */ - -/* For a detailed description of a type 2 CK segment please see the */ -/* CK Required Reading. */ - -/* This routine relieves the user from performing the repetitive */ -/* calls to the DAF routines necessary to construct a CK segment. */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* C */ -/* C This example writes a predict type 2 C-kernel segment for */ -/* C the Mars Observer spacecraft bus to a previously opened CK file */ -/* C attached to HANDLE. */ - -/* C */ -/* C Assume arrays of quaternions, angular velocities, and interval */ -/* C start and stop times are produced elsewhere. */ -/* C */ -/* . */ -/* . */ -/* . */ - -/* C */ -/* C The nominal number of seconds in a tick for MO is 1/256 */ -/* C */ -/* SECTIK = 1.D0 / 256.D0 */ - -/* DO I = 1, NREC */ -/* RATE(I) = SECTIK */ -/* END DO */ - -/* C */ -/* C The subroutine CKW02 needs the following components of the */ -/* C segment descriptor: */ -/* C */ -/* C 1) SCLK limits of the segment. */ -/* C 2) Instrument code. */ -/* C 3) Reference frame. */ - -/* BEGTIM = START ( 1 ) */ -/* ENDTIM = STOP ( NREC ) */ - -/* INST = -94000 */ -/* REF = 'J2000' */ - -/* SEGID = 'MO PREDICT SEG TYPE 2' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL CKW02 ( HANDLE, BEGTIM, ENDTIM, INST, REF, SEGID, */ -/* . NREC, START, STOP, QUAT, AVV, RATES ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 01-JUN-2010 (NJB) */ - -/* The check for non-unit quaternions has been replaced */ -/* with a check for zero-length quaternions. */ - -/* - SPICELIB Version 2.2.0, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* Minor typo in a long error message was corrected. */ - -/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */ - -/* Added check to make sure that all quaternions are unit */ -/* length to single precision. */ - -/* - SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ - -/* Removed all references to a specific method of opening the CK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ -/* $ Files, and $ Examples sections of the header. It is assumed */ -/* that a person using this routine has some knowledge of the DAF */ -/* system and the methods for obtaining file handles. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* 1) If the number of pointing records is not positive an error */ -/* is now signalled. */ - -/* 2) FAILED is checked after the call to DAFBNA. */ - -/* 3) The variables HLDBEG and HLDEND were removed from the loop */ -/* where the interval start and stop times are tested. */ - -/* - 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, 30-AUG-1991 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* write ck type_2 pointing data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */ - -/* Added check to make sure that all quaternions are unit */ -/* length to single precision. */ - -/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ - -/* Removed all references to a specific method of opening the CK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ -/* $ Files, and $ Examples sections of the header. It is assumed */ -/* that a person using this routine has some knowledge of the DAF */ -/* system and the methods for obtaining file handles. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* 1) If the number of pointing records is not positive an error */ -/* is now signalled. */ - -/* 2) FAILED is checked after the call to DAFBNA. */ - -/* 3) The variables HLDBEG and HLDEND were removed from the loop */ -/* where the interval start and stop times are tested. */ - -/* - 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, 30-AUG-1991 (JML) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* SIDLEN is the maximum number of characters allowed in a CK */ -/* segment identifier. */ - -/* NDC is the size of a packed CK segment descriptor. */ - -/* ND is the number of double precision components in a CK */ -/* segment descriptor. */ - -/* NI is the number of integer components in a CK segment */ -/* descriptor. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII */ -/* character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKW02", (ftnlen)5); - } - -/* The first thing that we will do is create the segment descriptor. */ - -/* The structure of the segment descriptor is as follows. */ - -/* DCD( 1 ) and DCD( 2 ) -- SCLK limits of the segment. */ -/* ICD( 1 ) -- Instrument code. */ -/* ICD( 2 ) -- Reference frame ID. */ -/* ICD( 3 ) -- Data type of the segment. */ -/* ICD( 4 ) -- Angular rates flag. */ -/* ICD( 5 ) -- Beginning address of the segment. */ -/* ICD( 6 ) -- Ending address of the segment. */ - - -/* Make sure that there is a positive number of pointing records. */ - - if (*nrec <= 0) { - setmsg_("# is an invalid number of pointing instances for type 2.", ( - ftnlen)56); - errint_("#", nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMREC)", (ftnlen)20); - chkout_("CKW02", (ftnlen)5); - return 0; - } - -/* Check that the SCLK bounds on the segment are reasonable. */ - - if (*begtim > start[0]) { - setmsg_("The first d.p. component of the descriptor is invalid. DCD" - "(1) = # and START(1) = # ", (ftnlen)84); - errdp_("#", begtim, (ftnlen)1); - errdp_("#", start, (ftnlen)1); - sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); - chkout_("CKW02", (ftnlen)5); - return 0; - } - if (*endtim < stop[*nrec - 1]) { - setmsg_("The second d.p. component of the descriptor is invalid. DC" - "D(2) = # and STOP(NREC) = # ", (ftnlen)87); - errdp_("#", endtim, (ftnlen)1); - errdp_("#", &stop[*nrec - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); - chkout_("CKW02", (ftnlen)5); - return 0; - } - dcd[0] = *begtim; - dcd[1] = *endtim; - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(ref, &refcod, ref_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("CKW02", (ftnlen)5); - return 0; - } - -/* Assign values to the integer components of the segment descriptor. */ -/* By definition data type two must have angular velocity. */ - - icd[0] = *inst; - icd[1] = refcod; - icd[2] = 2; - icd[3] = 1; - -/* Now pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Now check that all the characters in the segid can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CKW02", (ftnlen)5); - return 0; - } - } - -/* Also check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("CKW02", (ftnlen)5); - return 0; - } - -/* Now check that the START and STOP times on the intervals */ -/* make sense. Three checks will be performed on each interval: */ - -/* 1) Check that the STOP time is greater than the START time. */ - -/* 2) Check that the START times are strictly increasing. */ - -/* 3) Check that the START time is greater than or equal to the */ -/* STOP time from the previous interval. */ - -/* For the first interval also make sure that the START time is */ -/* nonnegative. */ - - if (start[0] < 0.) { - setmsg_("The first START time: # is negative.", (ftnlen)36); - errdp_("#", start, (ftnlen)1); - sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22); - chkout_("CKW02", (ftnlen)5); - return 0; - } - if (stop[0] <= start[0]) { - setmsg_("The STOP time is less than or equal to the START time for i" - "nterval number 1. START time is # and STOP time is #.", ( - ftnlen)112); - errdp_("#", start, (ftnlen)1); - errdp_("#", stop, (ftnlen)1); - sigerr_("SPICE(DEGENERATEINTERVAL)", (ftnlen)25); - chkout_("CKW02", (ftnlen)5); - return 0; - } - i__1 = *nrec; - for (i__ = 2; i__ <= i__1; ++i__) { - if (stop[i__ - 1] <= start[i__ - 1]) { - setmsg_("The STOP time is less than or equal to the START time f" - "or interval number #. START time is # and STOP time is #." - , (ftnlen)112); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &start[i__ - 1], (ftnlen)1); - errdp_("#", &stop[i__ - 1], (ftnlen)1); - sigerr_("SPICE(DEGENERATEINTERVAL)", (ftnlen)25); - chkout_("CKW02", (ftnlen)5); - return 0; - } - if (start[i__ - 1] <= start[i__ - 2]) { - setmsg_("The START times are not strictly increasing. START(#) " - "= # and START(#) = #.", (ftnlen)76); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &start[i__ - 1], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &start[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("CKW02", (ftnlen)5); - return 0; - } - if (stop[i__ - 2] > start[i__ - 1]) { - setmsg_("The STOP time for interval # is greater than the follow" - "ing START time. STOP(#) = # and START(#) = #.", (ftnlen) - 100); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &stop[i__ - 2], (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &start[i__ - 1], (ftnlen)1); - sigerr_("SPICE(BADSTOPTIME)", (ftnlen)18); - chkout_("CKW02", (ftnlen)5); - return 0; - } - } - -/* Make sure that the quaternions are non-zero. This is just */ -/* a check for uninitialized data. */ - - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - if (vzerog_(&quats[(i__ << 2) - 4], &c__4)) { - setmsg_("The quaternion at index # has magnitude zero.", (ftnlen) - 45); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21); - chkout_("CKW02", (ftnlen)5); - return 0; - } - } - -/* No more checks, begin writing the segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("CKW02", (ftnlen)5); - return 0; - } - -/* Now add the quaternions, angular velocity vectors, and time */ -/* conversion factors for each interval. */ - - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&quats[(i__ << 2) - 4], &c__4); - dafada_(&avvs[i__ * 3 - 3], &c__3); - dafada_(&rates[i__ - 1], &c__1); - } - -/* The SCLK start times. */ - - dafada_(start, nrec); - -/* The SCLK stop times. */ - - dafada_(stop, nrec); - -/* The time tag directory. The Ith element is defined to be the */ -/* average of the (I*100)th STOP time and the (I*100+1)th START time. */ - - ndir = (*nrec - 1) / 100; - index = 100; - i__1 = ndir; - for (i__ = 1; i__ <= i__1; ++i__) { - dirent = (stop[index - 1] + start[index]) / 2.; - dafada_(&dirent, &c__1); - index += 100; - } - -/* End the segment. */ - - dafena_(); - chkout_("CKW02", (ftnlen)5); - return 0; -} /* ckw02_ */ - diff --git a/ext/spice/src/cspice/ckw02_c.c b/ext/spice/src/cspice/ckw02_c.c deleted file mode 100644 index d3a8e967d8..0000000000 --- a/ext/spice/src/cspice/ckw02_c.c +++ /dev/null @@ -1,544 +0,0 @@ -/* - --Procedure ckw02_c ( C-Kernel, write segment to C-kernel, data type 2 ) - --Abstract - - Write a type 2 segment to a C-kernel. - --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 - - CK - DAF - SCLK - --Keywords - - POINTING - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ckw02_c - - - void ckw02_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble start [], - ConstSpiceDouble stop [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - ConstSpiceDouble rates [] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an open CK file. - begtim I The beginning encoded SCLK of the segment. - endtim I The ending encoded SCLK of the segment. - inst I The NAIF instrument ID code. - ref I The reference frame of the segment. - segid I Segment identifier. - nrec I Number of pointing records. - start I Encoded SCLK interval start times. - stop I Encoded SCLK interval stop times. - quats I Quaternions representing instrument pointing. - avvs I Angular velocity vectors. - rates I Number of seconds per tick for each interval. - --Detailed_Input - - handle is the handle of the CK file to which the segment will - be written. The file must have been opened with write - access. - - begtim is the beginning encoded SCLK time of the segment. This - value should be less than or equal to the first START - time in the segment. - - endtim is the encoded SCLK time at which the segment ends. - This value should be greater than or equal to the last - STOP time in the segment. - - inst is the NAIF integer ID code for the instrument. - - ref is a character string that specifies the - reference frame of the segment. This should be one of - the frames supported by the SPICELIB routine NAMFRM - which is an entry point of FRAMEX. - - segid is the segment identifier. A CK segment identifier may - contain up to 40 characters. - - nrec is the number of pointing intervals that will be - written to the segment. - - start are the start times of each interval in encoded - spacecraft clock. These times must be strictly - increasing. - - stop are the stop times of each interval in encoded - spacecraft clock. These times must be greater than - the START times that they correspond to but less - than or equal to the START time of the next interval. - - quats are the quaternions representing the C-matrices - associated with the start times of each interval. See the - discussion of "Quaternion Styles" in the Particulars - section below. - - AVVS are the angular velocity vectors for each interval. - - RATES are the number of seconds per encoded spacecraft clock - tick for each interval. - - In most applications this value will be the same for - each interval within a segment. For example, when - constructing a predict C-kernel for Mars Observer, the - rate would be 1/256 for each interval since this is - the smallest time unit expressible by the MO clock. The - nominal seconds per tick rates for Galileo and Voyager - are 1/120 and 0.06 respectively. - --Detailed_Output - - None. See Files section. - --Parameters - - None. - --Exceptions - - 1) If handle is not the handle of a C-kernel opened for writing - the error will be diagnosed by routines called by this - routine. - - 2) If segid is more than 40 characters long, the error - SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If the first START time is negative, the error - SPICE(INVALIDSCLKTIME) is signaled. If any of the subsequent - START times are negative the error SPICE(TIMESOUTOFORDER) - will be signaled. - - 5) If any of the STOP times are negative, the error - SPICE(DEGENERATEINTERVAL) is signaled. - - 6) If the STOP time of any of the intervals is less than or equal - to the START time, the error SPICE(DEGENERATEINTERVAL) is - signaled. - - 7) If the START times are not strictly increasing, the - error SPICE(TIMESOUTOFORDER) is signaled. - - 8) If the STOP time of one interval is greater than the START - time of the next interval, the error SPICE(BADSTOPTIME) - is signaled. - - 9) If begtim is greater than START[0] or endtim is less than - STOP[NREC-1], the error SPICE(INVALIDDESCRTIME) is - signaled. - - 10) If the name of the reference frame is not one of those - supported by the routine NAMFRM, the error - SPICE(INVALIDREFFRAME) is signaled. - - 11) If nrec, the number of pointing records, is less than or - equal to 0, the error SPICE(INVALIDNUMRECS) is signaled. - - 12) If any quaternion has magnitude zero, the error - SPICE(ZEROQUATERNION) is signaled. - - --Files - - This routine adds a type 2 segment to a C-kernel. The C-kernel - may be either a new one or an existing one opened for writing. - --Particulars - - For a detailed description of a type 2 CK segment please see the - CK Required Reading. - - This routine relieves the user from performing the repetitive - calls to the DAF routines necessary to construct a CK segment. - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - - This example writes a predict type 2 C-kernel segment for - the Mars Observer spacecraft bus to a previously opened CK file - attached to handle. - - - /. - Assume arrays of quaternions, angular velocities, and interval - start and stop times are produced elsewhere. - ./ - - . - . - . - - /. - The nominal number of seconds in a tick for MO is 1/256. - ./ - sectik = 1. / 256.; - - for ( i = 0; i < nrec; i++ ) - { - rate[i] = sectik; - } - - /. - The subroutine ckw02_c needs the following components of the - segment descriptor: - - 1) SCLK limits of the segment. - 2) Instrument code. - 3) Reference frame. - ./ - begtim = start [ 0 ]; - endtim = stop [nrec-1]; - - inst = -94000; - ref = "j2000"; - - segid = "mo predict seg type 2"; - - /. - Write the segment. - ./ - ckw02_c ( handle, begtim, endtim, inst, ref, segid, - nrec, start, stop, quat, avv, rates ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - J.M. Lynch (JPL) - --Version - - -CSPICE Version 2.0.0, 01-JUN-2010 (NJB) - - The check for non-unit quaternions has been replaced - with a check for zero-length quaternions. (The - implementation of the check is located in ckw02_.) - - -CSPICE Version 1.2.1, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Changed prototype: inputs start, stop, sclkdp, quats, - and avvs are now const-qualified. Implemented interface - macros for casting these inputs to const. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) - --Index_Entries - - write ck type_2 pointing data segment - --& -*/ - -{ /* Begin ckw02_c */ - - /* - Participate in error handling. - */ - chkin_c ( "ckw02_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckw02_c", ref ); - CHKFSTR ( CHK_STANDARD, "ckw02_c", segid ); - - - /* - Write the segment. Note that the quaternion and angular velocity - arrays DO NOT require transposition! - */ - - ckw02_( ( integer * ) &handle, - ( doublereal * ) &begtim, - ( doublereal * ) &endtim, - ( integer * ) &inst, - ( char * ) ref, - ( char * ) segid, - ( integer * ) &nrec, - ( doublereal * ) start, - ( doublereal * ) stop, - ( doublereal * ) quats, - ( doublereal * ) avvs, - ( doublereal * ) rates, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "ckw02_c" ); - -} /* End ckw02_c */ diff --git a/ext/spice/src/cspice/ckw03.c b/ext/spice/src/cspice/ckw03.c deleted file mode 100644 index 80f61f73b8..0000000000 --- a/ext/spice/src/cspice/ckw03.c +++ /dev/null @@ -1,951 +0,0 @@ -/* ckw03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__4 = 4; -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure CKW03 ( C-Kernel, write segment to C-kernel, data type 3 ) */ -/* Subroutine */ int ckw03_(integer *handle, doublereal *begtim, doublereal * - endtim, integer *inst, char *ref, logical *avflag, char *segid, - integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal * - avvs, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen - segid_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Local variables */ - integer i__; - logical match; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer nidir, index, value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer nrdir; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( - integer *, doublereal *, char *, ftnlen), dafena_(void); - extern logical failed_(void); - integer refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical vzerog_(doublereal *, integer *), return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Add a type 3 segment to a C-kernel. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ -/* ROTATION */ -/* SCLK */ - -/* $ Keywords */ - -/* POINTING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open CK file. */ -/* BEGTIM I Beginning encoded SCLK of the segment. */ -/* ENDTIM I Ending encoded SCLK of the segment. */ -/* INST I NAIF instrument ID code. */ -/* REF I Reference frame of the segment. */ -/* AVFLAG I True if the segment will contain angular velocity. */ -/* SEGID I Segment identifier. */ -/* NREC I Number of pointing records. */ -/* SCLKDP I Encoded SCLK times. */ -/* QUATS I SPICE quaternions representing instrument pointing. */ -/* AVVS I Angular velocity vectors. */ -/* NINTS I Number of intervals. */ -/* STARTS I Encoded SCLK interval start times. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the CK file to which the segment will */ -/* be written. The file must have been opened with write */ -/* access. */ - -/* BEGTIM, are the beginning and ending encoded SCLK times for */ -/* ENDTIM which the segment provides pointing information. */ -/* BEGTIM must be less than or equal to the SCLK time */ -/* associated with the first pointing instance in the */ -/* segment, and ENDTIM must be greater than or equal to */ -/* the time associated with the last pointing instance */ -/* in the segment. */ - -/* INST is the NAIF integer ID code for the instrument that */ -/* this segment will contain pointing information for. */ - -/* REF is a character string which specifies the inertial */ -/* reference frame of the segment. */ - -/* The rotation matrices represented by the quaternions */ -/* that are to be written to the segment transform the */ -/* components of vectors from the inertial reference frame */ -/* specified by REF to components in the instrument fixed */ -/* frame. Also, the components of the angular velocity */ -/* vectors to be written to the segment should be given */ -/* with respect to REF. */ - -/* REF should be the name of one of the frames supported */ -/* by the SPICELIB routine FRAMEX. */ - -/* AVFLAG is a logical flag which indicates whether or not the */ -/* segment will contain angular velocity. */ - -/* SEGID is the segment identifier. A CK segment identifier may */ -/* contain up to 40 printable characters and spaces. */ - -/* NREC is the number of pointing instances in the segment. */ - -/* SCLKDP are the encoded spacecraft clock times associated with */ -/* each pointing instance. These times must be strictly */ -/* increasing. */ - -/* QUATS is an array of SPICE-style quaternions representing */ -/* a sequence of C-matrices. See the discussion of */ -/* quaternion styles in Particulars below. */ - -/* The C-matrix represented by the Ith quaternion in */ -/* QUATS is a rotation matrix that transforms the */ -/* components of a vector expressed in the inertial */ -/* frame specified by REF to components expressed in */ -/* the instrument fixed frame at the time SCLKDP(I). */ - -/* Thus, if a vector V has components x, y, z in the */ -/* inertial frame, then V has components x', y', z' in */ -/* the instrument fixed frame where: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - -/* AVVS are the angular velocity vectors ( optional ). */ - -/* The Ith vector in AVVS gives the angular velocity of */ -/* the instrument fixed frame at time SCLKDP(I). The */ -/* components of the angular velocity vectors should */ -/* be given with respect to the inertial reference frame */ -/* specified by REF. */ - -/* The direction of an angular velocity vector gives */ -/* the right-handed axis about which the instrument fixed */ -/* reference frame is rotating. The magnitude of the */ -/* vector is the magnitude of the instantaneous velocity */ -/* of the rotation, in radians per second. */ - -/* If AVFLAG is FALSE then this array is ignored by the */ -/* routine; however it still must be supplied as part of */ -/* the calling sequence. */ - -/* NINTS is the number of intervals that the pointing instances */ -/* are partitioned into. */ - -/* STARTS are the start times of each of the interpolation */ -/* intervals. These times must be strictly increasing */ -/* and must coincide with times for which the segment */ -/* contains pointing. */ - -/* $ Detailed_Output */ - -/* None. See Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is not the handle of a C-kernel opened for writing */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 2) If SEGID is more than 40 characters long, the error */ -/* SPICE(SEGIDTOOLONG) is signaled. */ - -/* 3) If SEGID contains any non-printable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signaled. */ - -/* 4) If the first encoded SCLK time is negative then the error */ -/* SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times */ -/* are negative the error will be detected in exception (5). */ - -/* 5) If the encoded SCLK times are not strictly increasing, */ -/* the error SPICE(TIMESOUTOFORDER) is signaled. */ - -/* 6) If BEGTIM is greater than SCLKDP(1) or ENDTIM is less than */ -/* SCLKDP(NREC), the error SPICE(INVALIDDESCRTIME) is */ -/* signaled. */ - -/* 7) If the name of the reference frame is not one of those */ -/* supported by the routine FRAMEX, the error */ -/* SPICE(INVALIDREFFRAME) is signaled. */ - -/* 8) If NREC, the number of pointing records, is less than or */ -/* equal to 0, the error SPICE(INVALIDNUMREC) is signaled. */ - -/* 9) If NINTS, the number of interpolation intervals, is less than */ -/* or equal to 0, the error SPICE(INVALIDNUMINT) is signaled. */ - -/* 10) If the encoded SCLK interval start times are not strictly */ -/* increasing, the error SPICE(TIMESOUTOFORDER) is signaled. */ - -/* 11) If an interval start time does not coincide with a time for */ -/* which there is an actual pointing instance in the segment, */ -/* then the error SPICE(INVALIDSTARTTIME) is signaled. */ - -/* 12) This routine assumes that the rotation between adjacent */ -/* quaternions that are stored in the same interval has a */ -/* rotation angle of THETA radians, where */ - -/* 0 < THETA < pi. */ -/* _ */ - -/* The routines that evaluate the data in the segment produced */ -/* by this routine cannot distinguish between rotations of THETA */ -/* radians, where THETA is in the interval [0, pi), and */ -/* rotations of */ - -/* THETA + 2 * k * pi */ - -/* radians, where k is any integer. These `large' rotations will */ -/* yield invalid results when interpolated. You must ensure that */ -/* the data stored in the segment will not be subject to this */ -/* sort of ambiguity. */ - -/* 13) If any quaternion has magnitude zero, the error */ -/* SPICE(ZEROQUATERNION) is signaled. */ - -/* 14) If the start time of the first interval and the time of the */ -/* first pointing instance are not the same, the error */ -/* SPICE(TIMESDONTMATCH) is signaled. */ - -/* $ Files */ - -/* This routine adds a type 3 segment to a C-kernel. The C-kernel */ -/* may be either a new one or an existing one opened for writing. */ - -/* $ Particulars */ - -/* For a detailed description of a type 3 CK segment please see the */ -/* CK Required Reading. */ - -/* This routine relieves the user from performing the repetitive */ -/* calls to the DAF routines necessary to construct a CK segment. */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* C */ -/* C This example code fragment writes a type 3 C-kernel segment */ -/* C for the Mars Observer spacecraft bus to a previously opened CK */ -/* C file attached to HANDLE. */ -/* C */ - -/* C */ -/* C Assume arrays of quaternions, angular velocities, and the */ -/* C associated SCLK times are produced elsewhere. The software */ -/* C that calls CKW03 must then decide how to partition these */ -/* C pointing instances into intervals over which linear */ -/* C interpolation between adjacent points is valid. */ -/* C */ -/* . */ -/* . */ -/* . */ - -/* C */ -/* C The subroutine CKW03 needs the following items for the */ -/* C segment descriptor: */ -/* C */ -/* C 1) SCLK limits of the segment. */ -/* C 2) Instrument code. */ -/* C 3) Reference frame. */ -/* C 4) The angular velocity flag. */ -/* C */ -/* BEGTIM = SCLK ( 1 ) */ -/* ENDTIM = SCLK ( NREC ) */ - -/* INST = -94000 */ -/* REF = 'J2000' */ -/* AVFLAG = .TRUE. */ - -/* SEGID = 'MO SPACECRAFT BUS - DATA TYPE 3' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL CKW03 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */ -/* . SEGID, NREC, SCLKDP, QUATS, AVVS, NINTS, */ -/* . STARTS ) */ - -/* $ Restrictions */ - -/* 1) The creator of the segment is given the responsibility for */ -/* determining whether it is reasonable to interpolate between */ -/* two given pointing values. */ - -/* 2) This routine assumes that the rotation between adjacent */ -/* quaternions that are stored in the same interval has a */ -/* rotation angle of THETA radians, where */ - -/* 0 < THETA < pi. */ -/* _ */ - -/* The routines that evaluate the data in the segment produced */ -/* by this routine cannot distinguish between rotations of THETA */ -/* radians, where THETA is in the interval [0, pi), and */ -/* rotations of */ - -/* THETA + 2 * k * pi */ - -/* radians, where k is any integer. These `large' rotations will */ -/* yield invalid results when interpolated. You must ensure that */ -/* the data stored in the segment will not be subject to this */ -/* sort of ambiguity. */ - -/* 3) All pointing instances in the segment must belong to one and */ -/* only one of the intervals. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 01-JUN-2010 (NJB) */ - -/* The check for non-unit quaternions has been replaced */ -/* with a check for zero-length quaternions. */ - -/* - SPICELIB Version 2.3.0, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* Minor typo in a long error message was corrected. */ - -/* - SPICELIB Version 2.2.0, 26-SEP-2005 (BVS) */ - -/* Added check to ensure that the start time of the first */ -/* interval is the same as the time of the first pointing */ -/* instance. */ - -/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */ - -/* Added check to make sure that all quaternions are unit */ -/* length to single precision. */ - -/* - SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ - -/* Removed all references to a specific method of opening the CK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ -/* $ Files, and $ Examples sections of the header. It is assumed */ -/* that a person using this routine has some knowledge of the DAF */ -/* system and the methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* write ck type_3 pointing data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.2.0, 26-SEP-2005 (BVS) */ - -/* Added check to ensure that the start time of the first */ -/* interval is the same as the time of the first pointing */ -/* instance. */ - -/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */ - -/* Added check to make sure that all quaternions are unit */ -/* length to single precision. */ - -/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ - -/* Removed all references to a specific method of opening the CK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ -/* $ Files, and $ Examples sections of the header. It is assumed */ -/* that a person using this routine has some knowledge of the DAF */ -/* system and the methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* SIDLEN is the maximum number of characters allowed in a CK */ -/* segment identifier. */ - -/* NDC is the size of a packed CK segment descriptor. */ - -/* ND is the number of double precision components in a CK */ -/* segment descriptor. */ - -/* NI is the number of integer components in a CK segment */ -/* descriptor. */ - -/* DTYPE is the data type of the segment that this routine */ -/* operates on. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII */ -/* character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CKW03", (ftnlen)5); - -/* The first thing that we will do is create the segment descriptor. */ - -/* The structure of the segment descriptor is as follows. */ - -/* DCD( 1 ) and DCD( 2 ) -- SCLK limits of the segment. */ -/* ICD( 1 ) -- Instrument code. */ -/* ICD( 2 ) -- Reference frame ID. */ -/* ICD( 3 ) -- Data type of the segment. */ -/* ICD( 4 ) -- Angular rates flag. */ -/* ICD( 5 ) -- Beginning address of segment. */ -/* ICD( 6 ) -- Ending address of segment. */ - - -/* Make sure that there is a positive number of pointing records. */ - - if (*nrec <= 0) { - setmsg_("# is an invalid number of pointing instances for type 3.", ( - ftnlen)56); - errint_("#", nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMREC)", (ftnlen)20); - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Make sure that there is a positive number of interpolation */ -/* intervals. */ - - if (*nints <= 0) { - setmsg_("# is an invalid number of interpolation intervals for type " - "3.", (ftnlen)61); - errint_("#", nints, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMINT)", (ftnlen)20); - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Check that the SCLK bounds on the segment are reasonable. */ - - if (*begtim > sclkdp[0]) { - setmsg_("The segment begin time is greater than the time associated " - "with the first pointing instance in the segment. DCD(1) = # " - "and SCLKDP(1) = # ", (ftnlen)137); - errdp_("#", begtim, (ftnlen)1); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); - chkout_("CKW03", (ftnlen)5); - return 0; - } - if (*endtim < sclkdp[*nrec - 1]) { - setmsg_("The segment end time is less than the time associated with " - "the last pointing instance in the segment. DCD(2) = # and SC" - "LKDP(#) = #", (ftnlen)130); - errdp_("#", endtim, (ftnlen)1); - errint_("#", nrec, (ftnlen)1); - errdp_("#", &sclkdp[*nrec - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); - chkout_("CKW03", (ftnlen)5); - return 0; - } - dcd[0] = *begtim; - dcd[1] = *endtim; - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(ref, &refcod, ref_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Assign values to the integer components of the segment descriptor. */ - - icd[0] = *inst; - icd[1] = refcod; - icd[2] = 3; - if (*avflag) { - icd[3] = 1; - } else { - icd[3] = 0; - } - -/* Now pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Check that all the characters in the segid can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CKW03", (ftnlen)5); - return 0; - } - } - -/* Also check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Now check that the encoded SCLK times are positive and strictly */ -/* increasing. */ - -/* Check that the first time is nonnegative. */ - - if (sclkdp[0] < 0.) { - setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22); - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Now check that the times are ordered properly. */ - - i__1 = *nrec; - for (i__ = 2; i__ <= i__1; ++i__) { - if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) { - setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)" - " = # and SCLKDP(#) = #.", (ftnlen)78); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &sclkdp[i__ - 1], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &sclkdp[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("CKW03", (ftnlen)5); - return 0; - } - } - -/* Now check that the start time of the first interval is the */ -/* same as the time of the first pointing instance. */ - - if (sclkdp[0] != starts[0]) { - setmsg_("The start time of the first interval # and the time of the " - "first pointing instance # are not the same.", (ftnlen)102); - errdp_("#", starts, (ftnlen)1); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(TIMESDONTMATCH)", (ftnlen)21); - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Now check that the interval start times are ordered properly. */ - - i__1 = *nints; - for (i__ = 2; i__ <= i__1; ++i__) { - if (starts[i__ - 1] <= starts[i__ - 2]) { - setmsg_("The interval start times are not strictly increasing. S" - "TARTS(#) = # and STARTS(#) = #.", (ftnlen)86); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &starts[i__ - 1], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &starts[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("CKW03", (ftnlen)5); - return 0; - } - } - -/* Now make sure that all of the interval start times coincide with */ -/* one of the times associated with the actual pointing. */ - - index = 0; - i__1 = *nints; - for (i__ = 1; i__ <= i__1; ++i__) { - match = FALSE_; - while(! match && index < *nrec) { - ++index; - match = starts[i__ - 1] == sclkdp[index - 1]; - } - if (! match) { - setmsg_("Interval start time number # is invalid. STARTS(#) = *", - (ftnlen)54); - errint_("#", &i__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("*", &starts[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDSTARTTIME)", (ftnlen)23); - chkout_("CKW03", (ftnlen)5); - return 0; - } - } - -/* Make sure that the quaternions are non-zero. This is just */ -/* a check for uninitialized data. */ - - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - if (vzerog_(&quats[(i__ << 2) - 4], &c__4)) { - setmsg_("The quaternion at index # has magnitude zero.", (ftnlen) - 45); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21); - chkout_("CKW03", (ftnlen)5); - return 0; - } - } - -/* No more checks, begin writing the segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("CKW03", (ftnlen)5); - return 0; - } - -/* Now add the quaternions and optionally, the angular velocity */ -/* vectors. */ - - if (*avflag) { - i__1 = *nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&quats[(i__ << 2) - 4], &c__4); - dafada_(&avvs[i__ * 3 - 3], &c__3); - } - } else { - i__1 = *nrec << 2; - dafada_(quats, &i__1); - } - -/* Add the SCLK times. */ - - dafada_(sclkdp, nrec); - -/* The time tag directory. The Ith element is defined to be the */ -/* (I*100)th SCLK time. */ - - nrdir = (*nrec - 1) / 100; - index = 100; - i__1 = nrdir; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&sclkdp[index - 1], &c__1); - index += 100; - } - -/* Now add the interval start times. */ - - dafada_(starts, nints); - -/* And the directory of interval start times. The directory of */ -/* start times will simply be every 100th start time. */ - - nidir = (*nints - 1) / 100; - index = 100; - i__1 = nidir; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&starts[index - 1], &c__1); - index += 100; - } - -/* Finally, the number of intervals and records. */ - - d__1 = (doublereal) (*nints); - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*nrec); - dafada_(&d__1, &c__1); - -/* End the segment. */ - - dafena_(); - chkout_("CKW03", (ftnlen)5); - return 0; -} /* ckw03_ */ - diff --git a/ext/spice/src/cspice/ckw03_c.c b/ext/spice/src/cspice/ckw03_c.c deleted file mode 100644 index 9e6e9b82f5..0000000000 --- a/ext/spice/src/cspice/ckw03_c.c +++ /dev/null @@ -1,667 +0,0 @@ -/* - --Procedure ckw03_c ( C-Kernel, write segment to C-kernel, data type 3 ) - --Abstract - - Add a type 3 segment to a C-kernel. - --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 - - CK - DAF - SCLK - --Keywords - - POINTING - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ckw03_c - - - void ckw03_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - SpiceInt nints, - ConstSpiceDouble starts [] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an open CK file. - begtim I The beginning encoded SCLK of the segment. - endtim I The ending encoded SCLK of the segment. - inst I The NAIF instrument ID code. - ref I The reference frame of the segment. - avflag I True if the segment will contain angular velocity. - segid I Segment identifier. - nrec I Number of pointing records. - sclkdp I Encoded SCLK times. - quats I Quaternions representing instrument pointing. - avvs I Angular velocity vectors. - nints I Number of intervals. - starts I Encoded SCLK interval start times. - --Detailed_Input - - handle is the handle of the CK file to which the segment will - be written. The file must have been opened with write - access. - - begtim is the beginning encoded SCLK time of the segment. This - value should be less than or equal to the first time in - the segment. - - endtim is the encoded SCLK time at which the segment ends. - This value should be greater than or equal to the last - time in the segment. - - inst is the NAIF integer ID code for the instrument. - - ref is a character string which specifies the - reference frame of the segment. This should be one of - the frames supported by the SPICELIB routine NAMFRM - which is an entry point of FRAMEX. - - The rotation matrices represented by the quaternions - that are to be written to the segment transform the - components of vectors from the inertial reference frame - specified by ref to components in the instrument fixed - frame. Also, the components of the angular velocity - vectors to be written to the segment should be given - with respect to ref. - - ref should be the name of one of the frames supported - by the SPICELIB routine NAMFRM. - - - avflag is a boolean flag which indicates whether or not the - segment will contain angular velocity. - - segid is the segment identifier. A CK segment identifier may - contain up to 40 characters, excluding the terminating - null. - - nrec is the number of pointing instances in the segment. - - sclkdp are the encoded spacecraft clock times associated with - each pointing instance. These times must be strictly - increasing. - - quats is an array of SPICE-style quaternions representing a - sequence of C-matrices. See the discussion of "Quaternion - Styles" in the Particulars section below. - - The C-matrix represented by the ith quaternion in - quats is a rotation matrix that transforms the - components of a vector expressed in the inertial - frame specified by ref to components expressed in - the instrument fixed frame at the time sclkdp[i]. - - Thus, if a vector V has components x, y, z in the - inertial frame, then V has components x', y', z' in - the instrument fixed frame where: - - [ x' ] [ ] [ x ] - | y' | = | cmat | | y | - [ z' ] [ ] [ z ] - - avvs are the angular velocity vectors ( optional ). - - The ith vector in avvs gives the angular velocity of - the instrument fixed frame at time sclkdp[i]. The - components of the angular velocity vectors should - be given with respect to the inertial reference frame - specified by ref. - - The direction of an angular velocity vector gives - the right-handed axis about which the instrument fixed - reference frame is rotating. The magnitude of the - vector is the magnitude of the instantaneous velocity - of the rotation, in radians per second. - - If avflag is FALSE then this array is ignored by the - routine; however it still must be supplied as part of - the calling sequence. - - nints is the number of intervals that the pointing instances - are partitioned into. - - starts are the start times of each of the interpolation - intervals. These times must be strictly increasing - and must coincide with times for which the segment - contains pointing. - --Detailed_Output - - None. See Files section. - --Parameters - - None. - --Exceptions - - 1) If handle is not the handle of a C-kernel opened for writing - the error will be diagnosed by routines called by this - routine. - - 2) If segid is more than 40 characters long, the error - SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If the first encoded SCLK time is negative then the error - SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times - are negative the error SPICE(TIMESOUTOFORDER) is signaled. - - 5) If the encoded SCLK times are not strictly increasing, - the error SPICE(TIMESOUTOFORDER) is signaled. - - 6) If begtim is greater than sclkdp[0] or endtim is less than - sclkdp[nrec-1], the error SPICE(INVALIDDESCRTIME) is - signaled. - - 7) If the name of the reference frame is not one of those - supported by the SPICELIB routine NAMFRM, the error - SPICE(INVALIDREFFRAME) is signaled. - - 8) If nrec, the number of pointing records, is less than or - equal to 0, the error SPICE(INVALIDNUMRECS) is signaled. - - 9) If nints, the number of interpolation intervals, is less than - or equal to 0, the error SPICE(INVALIDNUMINTS) is signaled. - - 10) If the encoded SCLK interval start times are not strictly - increasing, the error SPICE(TIMESOUTOFORDER) is signaled. - - 11) If an interval start time does not coincide with a time for - which there is an actual pointing instance in the segment, - then the error SPICE(INVALIDSTARTTIME) is signaled. - - 12) This routine assumes that the rotation between adjacent - quaternions that are stored in the same interval has a - rotation angle of THETA radians, where - - 0 < THETA < pi. - _ - - The routines that evaluate the data in the segment produced - by this routine cannot distinguish between rotations of THETA - radians, where THETA is in the interval [0, pi), and - rotations of - - THETA + 2 * k * pi - - radians, where k is any integer. These `large' rotations will - yield invalid results when interpolated. You must ensure that - the data stored in the segment will not be subject to this - sort of ambiguity. - - 14) If the start time of the first interval and the time of the - first pointing instance are not the same, the error - SPICE(TIMESDONTMATCH) is signaled. - - 15) If any quaternion has magnitude zero, the error - SPICE(ZEROQUATERNION) is signaled. - - --Files - - This routine adds a type 3 segment to a C-kernel. The C-kernel - may be either a new one or an existing one opened for writing. - --Particulars - - For a detailed description of a type 3 CK segment please see the - CK Required Reading. - - This routine relieves the user from performing the repetitive - calls to the DAF routines necessary to construct a CK segment. - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - This example code fragment writes a type 3 C-kernel segment - for the Mars Global Surveyor spacecraft bus to a previously opened CK - file attached to HANDLE. - - /. - Include CSPICE interface definitions. - ./ - #include "SpiceUsr.h" - . - . - . - /. - Assume arrays of quaternions, angular velocities, and the - associated SCLK times are produced elsewhere. The software - that calls ckw03_c must then decide how to partition these - pointing instances into intervals over which linear - interpolation between adjacent points is valid. - ./ - . - . - . - - /. - The subroutine ckw03_c needs the following items for the - segment descriptor: - - 1) SCLK limits of the segment. - 2) Instrument code. - 3) Reference frame. - 4) The angular velocity flag. - - ./ - - begtim = sclk [ 0 ]; - endtim = sclk [ nrec-1 ]; - - inst = -94000; - ref = "j2000"; - avflag = SPICETRUE; - - segid = "MGS spacecraft bus - data type 3"; - - /. - Write the segment. - ./ - ckw03_c ( handle, begtim, endtim, inst, ref, avflag, - segid, nrec, sclkdp, quats, avvs, nints, - starts ); - . - . - . - /. - After all segments are written, close the C-kernel. - ./ - ckcls_c ( handle ); - - --Restrictions - - 1) The creator of the segment is given the responsibility for - determining whether it is reasonable to interpolate between - two given pointing values. - - 2) This routine assumes that the rotation between adjacent - quaternions that are stored in the same interval has a - rotation angle of THETA radians, where - - 0 < THETA < pi. - _ - - The routines that evaluate the data in the segment produced - by this routine cannot distinguish between rotations of THETA - radians, where THETA is in the interval [0, pi), and - rotations of - - THETA + 2 * k * pi - - radians, where k is any integer. These `large' rotations will - yield invalid results when interpolated. You must ensure that - the data stored in the segment will not be subject to this - sort of ambiguity. - - 3) All pointing instances in the segment must belong to one and - only one of the intervals. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - N.J. Bachman (JPL) - J.M. Lynch (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.0.0, 01-JUN-2010 (NJB) - - The check for non-unit quaternions has been replaced - with a check for zero-length quaternions. (The - implementation of the check is located in ckw03_.) - - -CSPICE Version 1.4.2, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. - - -CSPICE Version 1.4.1, 27-SEP-2005 (BVS) - - Added an item for SPICE(TIMESDONTMATCH) exception to the - Exceptions section of the header. - - -CSPICE Version 1.3.1, 07-JAN-2004 (EDW) - - Trivial typo correction in index entries section. - - -CSPICE Version 1.3.0, 28-AUG-2001 (NJB) - - Changed prototype: inputs sclkdp, quats, avvs, and starts - are now const-qualified. Implemented interface macros for - casting these inputs to const. - - -CSPICE Version 1.2.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for angular velocity - flag used in interface of ckw03_. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) - --Index_Entries - - write ck type_3 pointing data segment - --& -*/ - -{ /* Begin ckw03_c */ - - - - /* - Local variables - */ - logical avf; - - - /* - Participate in error handling. - */ - chkin_c ( "ckw03_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckw03_c", ref ); - CHKFSTR ( CHK_STANDARD, "ckw03_c", segid ); - - - /* - Get a type logical copy of the a.v. flag. - */ - avf = avflag; - - - /* - Write the segment. Note that the quaternion and angular velocity - arrays DO NOT require transposition! - */ - - ckw03_( ( integer * ) &handle, - ( doublereal * ) &begtim, - ( doublereal * ) &endtim, - ( integer * ) &inst, - ( char * ) ref, - ( logical * ) &avf, - ( char * ) segid, - ( integer * ) &nrec, - ( doublereal * ) sclkdp, - ( doublereal * ) quats, - ( doublereal * ) avvs, - ( integer * ) &nints, - ( doublereal * ) starts, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "ckw03_c" ); - -} /* End ckw03_c */ diff --git a/ext/spice/src/cspice/ckw04a.c b/ext/spice/src/cspice/ckw04a.c deleted file mode 100644 index d4fcb40f98..0000000000 --- a/ext/spice/src/cspice/ckw04a.c +++ /dev/null @@ -1,764 +0,0 @@ -/* ckw04a.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__142 = 142; -static integer c__7 = 7; -static doublereal c_b20 = 128.; - -/* $Procedure CKW04A ( CK type 04: Add data to a segment ) */ -/* Subroutine */ int ckw04a_(integer *handle, integer *npkts, integer *pktsiz, - doublereal *pktdat, doublereal *sclkdp) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer k; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer dispm, kk; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen); - integer displm; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numcft[7]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int sgwvpk_(integer *, integer *, integer *, - doublereal *, integer *, doublereal *), zzck4i2d_(integer *, - integer *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Add data to a type 4 CK segment currently being written to */ -/* the file associated with HANDLE. See also CKW04B and CKW04E. */ - -/* $ 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 */ - -/* CK.REQ */ -/* DAF.REQ */ -/* GS.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of an DAF file opened for writing. */ -/* NPKTS I Number of data packets to write to a segment. */ -/* PKTSIZ I The numbers of values in the data packets */ -/* PKTDAT I The data packets. */ -/* SCLKDP I The SCLK times associated with the data packets. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a CK file in which a CK type 4 */ -/* segment is currently being written. */ - -/* NPKTS is the number of data packets to write to a segment. */ - -/* PKTSIZ is the number of values in all data packets. */ - -/* PKTDAT is the data packets. The data packets in this array */ -/* must be organized as described in the $ Particulars */ -/* section of the header. */ - -/* SCLKDP contains the initial SCLK times corresponding to the */ -/* Chebyshev coefficients in PKTSIZ. The I'th time is */ -/* start time of the I'th packet coverage interval. */ -/* The times must form a strictly increasing sequence. */ - -/* $ Detailed_Output */ - -/* None. Data is stored in a segment in the DAF file */ -/* associated with HANDLE. */ - -/* $ Parameters */ - -/* See 'ckparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If the number of coefficient sets and epochs is not positive, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If size of any input packet is greater that maximum allowed */ -/* type 4 CK record size minus one, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine adds data to a type 4 CK segment that is currently */ -/* being written to the associated with HANDLE. The segment must */ -/* have been started by a call to the routine CKW04B, the routine */ -/* which begins a type 4 CK segment. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 4 CK segments. These routines are: */ - -/* CKW04B: Begin a type 4 CK segment. This routine must be */ -/* called before any data may be added to a type 4 */ -/* segment. */ - -/* CKW04A: Add data to a type 4 CK segment. This routine may be */ -/* called any number of times after a call to CKW04B to */ -/* add type 4 records to the CK segment that was */ -/* started. */ - -/* CKW04E: End a type 4 CK segment. This routine is called to */ -/* make the type 4 segment a permanent addition to the */ -/* DAF file. Once this routine is called, no further type */ -/* 4 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 4 CK segment consists of coefficient sets for variable */ -/* order Chebyshev polynomials over consecutive time intervals of a */ -/* variable length. The gaps between intervals are allowed. The */ -/* Chebyshev polynomials represent individual SPICE-style quaternion */ -/* components q0, q1, q2 and q3 and individual angular velocities */ -/* AV1, AV2 and AV3 if they are included with the data. */ - -/* See the discussion of quaternion styles below. */ - -/* The pointing data supplied to the type 4 CK writer (CKW04A) */ -/* is packed into an array as a sequence of records, */ - -/* ---------------------------------------------------- */ -/* | Record 1 | Record 2 | .. | Record N-1 | Record N | */ -/* ---------------------------------------------------- */ - -/* with each record in data packets has the following format. */ - -/* ---------------------------------------------------- */ -/* | The midpoint of the approximation interval | */ -/* ---------------------------------------------------- */ -/* | The radius of the approximation interval | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q0 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q1 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q2 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q3 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV1 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV2 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV3 | */ -/* ---------------------------------------------------- */ -/* | q0 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q1 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q2 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q3 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | AV1 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ -/* | AV2 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ -/* | AV3 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ - - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* Assume that we have: */ - -/* HANDLE is the handle of an CK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the CK */ -/* segment we will create. */ - -/* INST is the SPICE ID code for the instrument whose */ -/* pointing data is to be placed into the file. */ - -/* AVFLAG angular rates flag. */ - -/* REFFRM is the name of the SPICE reference frame for the */ -/* pointing data. */ - -/* BEGTIM is the starting encoded SCLK time for which the */ -/* segment is valid. */ - -/* ENDTIM is the ending encoded SCLK time for which the segment */ -/* is valid. */ - -/* N is the number of type 4 records that we want to */ -/* put into a segment in an CK file. */ - -/* NPKTS is integer array which contains the lengths of */ -/* variable size data packets */ - -/* RECRDS contains N type 4 records packaged for the CK */ -/* file. */ - -/* SCSTRT contains the initial encoded SC time for each of */ -/* the records contained in RECRDS, where */ - -/* SCSTRT(I) < SCSTRT(I+1), I = 1, N-1 */ - -/* SCSTRT(1) <= FIRST, SCSTRT(N) < LAST */ - -/* Then the following code fragment demonstrates how to create */ -/* a type 4 CK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL CKW04B ( HANDLE, BEGTIM, INST, REF, AVFLAG, SEGID ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL CKW04A ( HANDLE, N, NPKTS, RECRDS, SCSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent */ -/* C addition to the CK file. */ -/* C */ -/* CALL CKW04E ( HANDLE, ENDTIM ) */ - -/* $ Restrictions */ - -/* 1) The type 4 CK segment to which the data is added must have */ -/* been started by the routine CKW04B, the routine which begins */ -/* a type 4 CK segment. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Removed DAFHLU call; replaced ERRFNM call with ERRHAN. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* add data to a type_4 ck segment */ - -/* -& */ - -/* Spicelib functions. */ - - -/* Local parameters. */ - - -/* The number of elements by which coefficients in each packet */ -/* have to be shifted to the left after numbers of coefficients */ -/* were packed into a single integer. */ - - -/* Local Variables. */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKW04A", (ftnlen)6); - } - -/* First, check if the number of coefficient sets and epochs */ -/* is positive and whether each packet is smaller than the */ -/* maximum size of a record that CKPFS can handle. */ - - i__1 = *npkts; - for (k = 1; k <= i__1; ++k) { - if (pktsiz[k - 1] <= 0) { - setmsg_("The number of coefficient sets and epochs in the # data" - " packet (record) to be added to the DAF segment in the f" - "ile '#' was not positive. Its value was: #.", (ftnlen)154) - ; - errint_("#", &k, (ftnlen)1); - errhan_("#", handle, (ftnlen)1); - errint_("#", &pktsiz[k - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("CKW04A", (ftnlen)6); - return 0; - } - -/* We do .GE. comparison because a type 4 CK record passed */ -/* inside CKPFS will have one more element -- time at which */ -/* the pointing will be evaluated. */ - - if (pktsiz[k - 1] >= 143) { - setmsg_("The total size of the # data packet (record) to be adde" - "d to the DAF segment in the file '#' is greater than the" - " maximum allowed type 4 record size #. Its value was: #.", - (ftnlen)167); - errint_("#", &k, (ftnlen)1); - errhan_("#", handle, (ftnlen)1); - errint_("#", &c__142, (ftnlen)1); - errint_("#", &pktsiz[k - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("CKW04A", (ftnlen)6); - return 0; - } - } - displm = 0; - dispm = 0; - -/* The cycle below encodes groups of numbers of coefficients in */ -/* data packets to single double precision numbers and shift */ -/* data in packets to the left to decrease the data packet */ -/* lengths. */ - - i__1 = *npkts; - for (k = 1; k <= i__1; ++k) { - -/* Encode integer numbers of coefficients for each component */ -/* to single double precision variable */ - - for (kk = 1; kk <= 7; ++kk) { - numcft[(i__2 = kk - 1) < 7 && 0 <= i__2 ? i__2 : s_rnge("numcft", - i__2, "ckw04a_", (ftnlen)577)] = (integer) pktdat[kk + 2 - + displm - 1]; - } - zzck4i2d_(numcft, &c__7, &c_b20, &pktdat[dispm + 2]); - -/* Shift coefficients sets to the left to overwrite numbers of */ -/* packets */ - - i__2 = pktsiz[k - 1]; - for (kk = 4; kk <= i__2; ++kk) { - pktdat[kk + dispm - 1] = pktdat[kk + 6 + displm - 1]; - } - -/* Shift middle value and radii of interval */ - - pktdat[dispm] = pktdat[displm]; - pktdat[dispm + 1] = pktdat[displm + 1]; - displm += pktsiz[k - 1]; - -/* Length of each data packet became less for 6 elements because */ -/* of encoding of 7 double precision numbers, which are the */ -/* numbers of polynomial coefficients, to one double precision */ -/* number */ - - pktsiz[k - 1] += -6; - dispm += pktsiz[k - 1]; - } - -/* Add the data. */ - - sgwvpk_(handle, npkts, pktsiz, pktdat, npkts, sclkdp); - -/* No need to check FAILED() here, since all we do is check out. */ -/* Leave it up to the caller. */ - - chkout_("CKW04A", (ftnlen)6); - return 0; -} /* ckw04a_ */ - diff --git a/ext/spice/src/cspice/ckw04b.c b/ext/spice/src/cspice/ckw04b.c deleted file mode 100644 index 43e16666f7..0000000000 --- a/ext/spice/src/cspice/ckw04b.c +++ /dev/null @@ -1,948 +0,0 @@ -/* ckw04b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__0 = 0; -static integer c__3 = 3; - -/* $Procedure CKW04B ( CK type 04: Begin a segment ) */ -/* Subroutine */ int ckw04b_(integer *handle, doublereal *begtim, integer * - inst, char *ref, logical *avflag, char *segid, ftnlen ref_len, ftnlen - segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer value; - doublereal dcoeff; - integer refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), sgbwvs_(integer *, doublereal *, - char *, integer *, doublereal *, integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Begin a type CK04 segment in the DAF file associated with */ -/* HANDLE. See also CKW04A and CKW04E. */ - -/* $ 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 */ - -/* CK.REQ */ -/* DAF.REQ */ -/* GS.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of an DAF file open for writing. */ -/* SEGID I The string to use for segment identifier. */ -/* INST I The NAIF ID code for the SC or instrument. */ -/* AVFLAG I The angular rates flag. */ -/* REF I The reference frame for this segment. */ -/* BEGTIM I The segment coverage start encoded SCLK time */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a CK file that has been */ -/* opened for writing. */ - -/* SEGID is the segment identifier. CK segment identifier */ -/* may contain up to 40 printing ASCII characters. */ - -/* INST is the SPICE ID for the SC structure or instrument */ -/* whose orientation are to be recorded in a CK file. */ - -/* AVFLAG angular rates flag indicates whether segment will */ -/* contain angular rate information. */ - -/* REF is the name of a reference frame that pointing is */ -/* given with respect to, for example 'J2000'. */ - -/* BEGTIM is the encoded SCLK time for the start of the segment */ -/* coverage. */ - -/* $ Detailed_Output */ - -/* None. The input data is used to create the segment summary */ -/* for the segment being started in the DAF file */ -/* associated with HANDLE. */ - -/* See the $ Particulars section for details about the */ -/* structure of a type 4 CK segment. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the files */ -/* 'sgparam.inc' and 'ckparam.inc'. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Exceptions */ - -/* 1) File access errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 2) If numeric ID for given reference frame cannot be resolved */ -/* from it's name SPICE(INVALIDREFFRAME) is signalled. */ - -/* 2) If SEGID is more than 40 characters long, the error */ -/* SPICE(SEGIDTOOLONG) is signalled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* $ Particulars */ - -/* This routine begins writing a type 4 CK segment to the open DAF */ -/* file that is associated with HANDLE. The file must have been */ -/* opened with write access. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 4 CK segments. These routines are: */ - -/* CKW04B: Begin a type 4 CK segment. This routine must be */ -/* called before any data may be added to a type 4 */ -/* segment. */ - -/* CKW04A: Add data to a type 4 CK segment. This routine may be */ -/* called any number of times after a call to CKW04B to */ -/* add type 4 records to the CK segment that was */ -/* started. */ - -/* CKW04E: End a type 4 CK segment. This routine is called to */ -/* make the type 4 segment a permanent addition to the */ -/* DAF file. Once this routine is called, no further type */ -/* 4 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 4 CK segment consists of coefficient sets for variable */ -/* order Chebyshev polynomials over consecutive time intervals of */ -/* a variable length. The gaps between intervals are allowed. */ -/* The Chebyshev polynomials represent individual quaternion */ -/* components q0, q1, q2 and q3 and individual angular velocities */ -/* AV1, AV2 and AV3 if they are included with the data. */ - -/* The pointing data supplied to the type 4 CK writer (CKW04A) */ -/* is packed into an array as a sequence of records, */ - -/* ---------------------------------------------------- */ -/* | Record 1 | Record 2 | .. | Record N-1 | Record N | */ -/* ---------------------------------------------------- */ - -/* with each record in data packets has the following format. */ - -/* ---------------------------------------------------- */ -/* | The midpoint of the approximation interval | */ -/* ---------------------------------------------------- */ -/* | The radius of the approximation interval | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q0 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q1 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q2 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q3 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV1 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV2 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV3 | */ -/* ---------------------------------------------------- */ -/* | q0 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q1 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q2 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q3 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | AV1 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ -/* | AV2 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ -/* | AV3 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ - -/* $ Examples */ - -/* Assume that we have: */ - -/* HANDLE is the handle of an CK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the CK */ -/* segment we will create. */ - -/* INST is the SPICE ID code for the instrument whose */ -/* pointing data is to be placed into the file. */ - -/* AVFLAG angular rates flag. */ - -/* REFFRM is the name of the SPICE reference frame for the */ -/* pointing data. */ - -/* BEGTIM is the starting encoded SCLK time for which the */ -/* segment is valid. */ - -/* ENDTIM is the ending encoded SCLK time for which the segment */ -/* is valid. */ - -/* N is the number of type 4 records that we want to */ -/* put into a segment in an CK file. */ - -/* NPKTS is integer array which contains the lengths of */ -/* variable size data packets */ - -/* RECRDS contains N type 4 records packaged for the CK */ -/* file. */ - -/* SCSTRT contains the initial encoded SC time for each of */ -/* the records contained in RECRDS, where */ - -/* SCSTRT(I) < SCSTRT(I+1), I = 1, N-1 */ - -/* SCSTRT(1) <= FIRST, SCSTRT(N) < LAST */ - -/* Then the following code fragment demonstrates how to create */ -/* a type 4 CK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL CKW04B ( HANDLE, BEGTIM, INST, REF, AVFLAG, SEGID ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL CKW04A ( HANDLE, N, NPKTS, RECRDS, SCSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent */ -/* C addition to the CK file. */ -/* C */ -/* CALL CKW04E ( HANDLE, ENDTIM ) */ - -/* $ Restrictions */ - -/* 1) The file containing the segment should be opened for read */ -/* or write access either by CKOPN or DAFOPW. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin writing a type_4 CK segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Parameters */ - - -/* DAF ND and NI values for CK files and length of a DAF descriptor. */ - - -/* The number of generic segment constants in a type 4 CK segment. */ - - -/* The integer codes of the first and last printable ASCII */ -/* characters. */ - - -/* The maximum number of characters allowed in a CK segment */ -/* identifier. */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKW04B", (ftnlen)6); - } - -/* Create a descriptor for the segment we are about to write. First */ -/* assign start and stop times. */ - - dcd[0] = *begtim; - dcd[1] = 0.; - -/* Second, resolve reference frame ID code from its name and */ -/* assign it to the corresponding descriptor component. Signal */ -/* an error if frame is not recognized. */ - - namfrm_(ref, &refcod, ref_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("CKW04B", (ftnlen)6); - return 0; - } - icd[1] = refcod; - -/* Third, assign values to the rest of the integer components of */ -/* the segment descriptor. */ - - icd[0] = *inst; - icd[2] = 4; - if (*avflag) { - icd[3] = 1; - } else { - icd[3] = 0; - } - -/* Now pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Check that all characters in the SEGID are printable. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CKW04B", (ftnlen)6); - return 0; - } - } - -/* Also check if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("CKW04B", (ftnlen)6); - return 0; - } - -/* We've got a valid descriptor and identifier and can begin */ -/* the segment. For this data type, we want to use an explicit */ -/* reference value index where the reference epochs are in */ -/* increasing order. We also want the index returned for a */ -/* particular request epoch to be the index of the greatest */ -/* reference epoch less than or equal to the request epoch. These */ -/* characteristics are prescribed by the mnemonic EXPLE. See the */ -/* include file 'sgparam.inc' for more details. */ - - sgbwvs_(handle, descr, segid, &c__0, &dcoeff, &c__3, segid_len); - -/* No need to check FAILED() here, since all we do after this */ -/* point is checking out. */ - - chkout_("CKW04B", (ftnlen)6); - return 0; -} /* ckw04b_ */ - diff --git a/ext/spice/src/cspice/ckw04e.c b/ext/spice/src/cspice/ckw04e.c deleted file mode 100644 index e709619d61..0000000000 --- a/ext/spice/src/cspice/ckw04e.c +++ /dev/null @@ -1,328 +0,0 @@ -/* ckw04e.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure CKW04E ( CK type 04: End a segment ) */ -/* Subroutine */ int ckw04e_(integer *handle, doublereal *endtim) -{ - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen), - dafps_(integer *, integer *, doublereal *, integer *, doublereal * - ), dafrs_(doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - logical found; - extern /* Subroutine */ int sgwes_(integer *), dafbbs_(integer *), - daffpa_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* End the type 04 CK segment currently being written to the DAF */ -/* file associated with HANDLE. See also CKW04B and CKW04E. */ - -/* $ 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 */ - -/* CK.REQ */ -/* DAF.REQ */ -/* GS.REQ */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of an CK file open for writing. */ -/* ENDTIM I The segment coverage end encoded SCLK time. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an CK file that has been */ -/* opened for writing, and to which a type 4 CK segment */ -/* is being written. */ - -/* ENDTIM is the encoded SCLK time for the end of the segment */ -/* coverage. */ - -/* $ Detailed_Output */ - -/* None. The type 4 segment in the DAF file associated with */ -/* HANDLE will be ended, making the addition of the */ -/* data to the file permanent. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See the argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) Errors reading or writing the file indicated by HANDLE will */ -/* be diagnosed by routine in the call tree of this routine. */ - -/* $ Particulars */ - -/* This routine ends a type 4 CK segment which is being written to */ -/* the DAF file associated with HANDLE. Ending the DAF segment is a */ -/* necessary step in the process of making the data a permanent part */ -/* of the DAF file. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 4 CK segments. These routines are: */ - -/* CKW04B: Begin a type 4 CK segment. This routine must be */ -/* called before any data may be added to a type 4 */ -/* segment. */ - -/* CKW04A: Add data to a type 4 CK segment. This routine may be */ -/* called any number of times after a call to CKW04B to */ -/* add type 4 records to the CK segment that was */ -/* started. */ - -/* CKW04E: End a type 4 CK segment. This routine is called to */ -/* make the type 4 segment a permanent addition to the */ -/* DAF file. Once this routine is called, no further type */ -/* 4 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 4 CK segment consists of coefficient sets for variable */ -/* order Chebyshev polynomials over consecutive time intervals of */ -/* a variable length. The gaps between intervals are allowed. */ -/* The Chebyshev polynomials represent individual quaternion */ -/* components q0, q1, q2 and q3 and individual angular velocities */ -/* AV1, AV2 and AV3 if they are included with the data. */ - -/* The pointing data supplied to the type 4 CK writer (CKW04A) */ -/* is packed into an array as a sequence of records, */ - -/* ---------------------------------------------------- */ -/* | Record 1 | Record 2 | .. | Record N-1 | Record N | */ -/* ---------------------------------------------------- */ - -/* with each record in data packets has the following format. */ - -/* ---------------------------------------------------- */ -/* | The midpoint of the approximation interval | */ -/* ---------------------------------------------------- */ -/* | The radius of the approximation interval | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q0 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q1 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q2 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for q3 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV1 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV2 | */ -/* ---------------------------------------------------- */ -/* | Number of coefficients for AV3 | */ -/* ---------------------------------------------------- */ -/* | q0 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q1 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q2 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | q3 Cheby coefficients | */ -/* ---------------------------------------------------- */ -/* | AV1 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ -/* | AV2 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ -/* | AV3 Cheby coefficients (optional) | */ -/* ---------------------------------------------------- */ - -/* $ Examples */ - -/* Assume that we have: */ - -/* HANDLE is the handle of an CK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the CK */ -/* segment we will create. */ - -/* INST is the SPICE ID code for the instrument whose */ -/* pointing data is to be placed into the file. */ - -/* AVFLAG angular rates flag. */ - -/* REFFRM is the name of the SPICE reference frame for the */ -/* pointing data. */ - -/* BEGTIM is the starting encoded SCLK time for which the */ -/* segment is valid. */ - -/* ENDTIM is the ending encoded SCLK time for which the segment */ -/* is valid. */ - -/* N is the number of type 4 records that we want to */ -/* put into a segment in an CK file. */ - -/* NPKTS is integer array which contains the lengths of */ -/* variable size data packets */ - -/* RECRDS contains N type 4 records packaged for the CK */ -/* file. */ - -/* SCSTRT contains the initial encoded SC time for each of */ -/* the records contained in RECRDS, where */ - -/* SCSTRT(I) < SCSTRT(I+1), I = 1, N-1 */ - -/* SCSTRT(1) <= FIRST, SCSTRT(N) < LAST */ - -/* Then the following code fragment demonstrates how to create */ -/* a type 4 CK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL CKW04B ( HANDLE, BEGTIM, INST, REF, AVFLAG, SEGID ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL CKW04A ( HANDLE, N, NPKTS, RECRDS, SCSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent */ -/* C addition to the CK file. */ -/* C */ -/* CALL CKW04E ( HANDLE, ENDTIM ) */ - -/* $ Restrictions */ - -/* 1) The type 4 CK segment being closed must have been started by */ -/* the routine CKW04B, the routine which begins a type 4 CK */ -/* segment. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* end a type_4 ck segment */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local parameters. */ - - -/* DAF ND and NI values for CK files and length of a DAF descriptor. */ - - -/* Local variables. */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKW04E", (ftnlen)6); - } - -/* This is simple, just call the routine which ends a generic */ -/* segment. */ - - sgwes_(handle); - if (failed_()) { - chkout_("CKW04E", (ftnlen)6); - return 0; - } - -/* Now update the descriptor with the end time. Locate the segment */ -/* with a backward search. */ - - dafbbs_(handle); - daffpa_(&found); - if (! found) { - -/* We have a bug. */ - - setmsg_("The segment which was just written could not be found by a " - "DAF search. This indicates a serious error. Contact NAIF.", - (ftnlen)118); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("CKW04E", (ftnlen)6); - return 0; - } - -/* Get the descriptor, set the end time, and update the descriptor */ -/* in the file. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - dcd[1] = *endtim; - dafps_(&c__2, &c__6, dcd, icd, descr); - dafrs_(descr); - -/* All done. */ - - chkout_("CKW04E", (ftnlen)6); - return 0; -} /* ckw04e_ */ - diff --git a/ext/spice/src/cspice/ckw05.c b/ext/spice/src/cspice/ckw05.c deleted file mode 100644 index f0ff062697..0000000000 --- a/ext/spice/src/cspice/ckw05.c +++ /dev/null @@ -1,1112 +0,0 @@ -/* ckw05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__15 = 15; -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure CKW05 ( Write CK segment, type 5 ) */ -/* Subroutine */ int ckw05_(integer *handle, integer *subtyp, integer *degree, - doublereal *begtim, doublereal *endtim, integer *inst, char *ref, - logical *avflag, char *segid, integer *n, doublereal *sclkdp, - doublereal *packts, doublereal *rate, integer *nints, doublereal * - starts, ftnlen ref_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Local variables */ - integer addr__, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *); - doublereal dc[2]; - extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, - ftnlen); - integer ic[6]; - extern /* Subroutine */ int dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern integer bsrchd_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - integer packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - extern logical vzerog_(doublereal *, integer *), return_(void); - integer winsiz; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* Write a type 5 segment to a CK file. */ - -/* $ 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 */ - -/* CK */ -/* NAIF_IDS */ -/* ROTATION */ -/* TIME */ - -/* $ Keywords */ - -/* POINTING */ -/* FILES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to CK type 05. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ - -/* CK type 5 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ -/* and quaternion derivatives only, no angular velocity */ -/* vector provided. Quaternion elements are listed */ -/* first, followed by derivatives. Angular velocity is */ -/* derived from the quaternions and quaternion */ -/* derivatives. */ - - -/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ -/* only. Angular velocity is derived by differentiating */ -/* the interpolating polynomials. */ - - -/* Subtype 2: Hermite interpolation, 14-element packets. */ -/* Quaternion and angular angular velocity vector, as */ -/* well as derivatives of each, are provided. The */ -/* quaternion comes first, then quaternion derivatives, */ -/* then angular velocity and its derivatives. */ - - -/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ -/* and angular velocity vector provided. The quaternion */ -/* comes first. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of file ck05.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an CK file open for writing. */ -/* SUBTYP I CK type 5 subtype code. */ -/* DEGREE I Degree of interpolating polynomials. */ -/* BEGTIM I Start time of interval covered by segment. */ -/* ENDTIM I End time of interval covered by segment. */ -/* INST I NAIF code for a s/c instrument or structure. */ -/* REF I Reference frame name. */ -/* AVFLAG I True if the segment will contain angular velocity. */ -/* SEGID I Segment identifier. */ -/* N I Number of packets. */ -/* SCLKDP I Encoded SCLK times. */ -/* PACKTS I Array of packets. */ -/* RATE I Nominal SCLK rate in seconds per tick. */ -/* NINTS I Number of intervals. */ -/* STARTS I Encoded SCLK interval start times. */ -/* MAXDEG P Maximum allowed degree of interpolating polynomial. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a CK file that has been */ -/* opened for writing. */ - -/* SUBTYP is an integer code indicating the subtype of the */ -/* the segment to be created. */ - -/* DEGREE is the degree of the polynomials used to */ -/* interpolate the quaternions contained in the input */ -/* packets. All components of the quaternions are */ -/* interpolated by polynomials of fixed degree. */ - -/* BEGTIM, */ -/* ENDTIM are the beginning and ending encoded SCLK times */ -/* for which the segment provides pointing */ -/* information. BEGTIM must be less than or equal to */ -/* ENDTIM, and at least one data packet must have a */ -/* time tag T such that */ - -/* BEGTIM < T < ENDTIM */ -/* - - */ - -/* INST is the NAIF integer code for the instrument or */ -/* structure for which a segment is to be created. */ - -/* REF is the NAIF name for a reference frame relative to */ -/* which the pointing information for INST is */ -/* specified. */ - -/* AVFLAG is a logical flag which indicates whether or not */ -/* the segment will contain angular velocity. */ - -/* SEGID is the segment identifier. A CK segment */ -/* identifier may contain up to 40 characters. */ - -/* N is the number of packets in the input packet */ -/* array. */ - -/* SCLKDP are the encoded spacecraft clock times associated */ -/* with each pointing instance. These times must be */ -/* strictly increasing. */ - -/* PACKTS contains a time-ordered array of data packets */ -/* representing the orientation of INST relative to */ -/* the frame REF. Each packet contains a SPICE-style */ -/* quaternion and optionally, depending on the */ -/* segment subtype, attitude derivative data, from */ -/* which a C-matrix and an angular velocity vector */ -/* may be derived. */ - -/* See the discussion of quaternion styles in */ -/* Particulars below. */ - -/* The C-matrix represented by the Ith data packet is */ -/* a rotation matrix that transforms the components */ -/* of a vector expressed in the base frame specified */ -/* by REF to components expressed in the instrument */ -/* fixed frame at the time SCLKDP(I). */ - -/* Thus, if a vector V has components x, y, z in the */ -/* base frame, then V has components x', y', z' */ -/* in the instrument fixed frame where: */ - -/* [ x' ] [ ] [ x ] */ -/* | y' | = | CMAT | | y | */ -/* [ z' ] [ ] [ z ] */ - - -/* The attitude derivative information in PACKTS(I) */ -/* gives the angular velocity of the instrument fixed */ -/* frame at time SCLKDP(I) with respect to the */ -/* reference frame specified by REF. */ - -/* The direction of an angular velocity vector gives */ -/* the right-handed axis about which the instrument */ -/* fixed reference frame is rotating. The magnitude */ -/* of the vector is the magnitude of the */ -/* instantaneous velocity of the rotation, in radians */ -/* per second. */ - -/* Packet contents and the corresponding */ -/* interpolation methods depend on the segment */ -/* subtype, and are as follows: */ - -/* Subtype 0: Hermite interpolation, 8-element */ -/* packets. Quaternion and quaternion */ -/* derivatives only, no angular */ -/* velocity vector provided. */ -/* Quaternion elements are listed */ -/* first, followed by derivatives. */ -/* Angular velocity is derived from */ -/* the quaternions and quaternion */ -/* derivatives. */ - -/* Subtype 1: Lagrange interpolation, 4-element */ -/* packets. Quaternion only. Angular */ -/* velocity is derived by */ -/* differentiating the interpolating */ -/* polynomials. */ - -/* Subtype 2: Hermite interpolation, 14-element */ -/* packets. Quaternion and angular */ -/* angular velocity vector, as well as */ -/* derivatives of each, are provided. */ -/* The quaternion comes first, then */ -/* quaternion derivatives, then */ -/* angular velocity and its */ -/* derivatives. */ - -/* Subtype 3: Lagrange interpolation, 7-element */ -/* packets. Quaternion and angular */ -/* velocity vector provided. The */ -/* quaternion comes first. */ - -/* Angular velocity is always specified relative to */ -/* the base frame. */ - -/* RATE is the nominal rate of the spacecraft clock */ -/* associated with INST. Units are seconds per */ -/* tick. RATE is used to scale angular velocity */ -/* to radians/second. */ - -/* NINTS is the number of intervals that the pointing */ -/* instances are partitioned into. */ - -/* STARTS are the start times of each of the interpolation */ -/* intervals. These times must be strictly increasing */ -/* and must coincide with times for which the segment */ -/* contains pointing. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* MAXDEG is the maximum allowed degree of the interpolating */ -/* polynomial. If the value of MAXDEG is increased, */ -/* the SPICELIB routine CKPFS must be changed */ -/* accordingly. In particular, the size of the */ -/* record passed to CKRnn and CKEnn must be */ -/* increased, and comments describing the record size */ -/* must be changed. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If HANDLE is not the handle of a C-kernel opened for writing */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signaled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signaled. */ - -/* 4) If the first encoded SCLK time is negative then the error */ -/* SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times */ -/* are negative the error will be detected in exception (5). */ - -/* 5) If the encoded SCLK times are not strictly increasing, */ -/* the error SPICE(TIMESOUTOFORDER) is signaled. */ - -/* 6) If the name of the reference frame is not one of those */ -/* supported by the routine FRAMEX, the error */ -/* SPICE(INVALIDREFFRAME) is signaled. */ - -/* 7) If the number of packets N is not at least 1, the error */ -/* SPICE(TOOFEWPACKETS) will be signaled. */ - -/* 8) If NINTS, the number of interpolation intervals, is less than */ -/* or equal to 0, the error SPICE(INVALIDNUMINTS) is signaled. */ - -/* 9) If the encoded SCLK interval start times are not strictly */ -/* increasing, the error SPICE(TIMESOUTOFORDER) is signaled. */ - -/* 10) If an interval start time does not coincide with a time for */ -/* which there is an actual pointing instance in the segment, */ -/* then the error SPICE(INVALIDSTARTTIME) is signaled. */ - -/* 11) This routine assumes that the rotation between adjacent */ -/* quaternions that are stored in the same interval has a */ -/* rotation angle of THETA radians, where */ - -/* 0 < THETA < pi. */ -/* _ */ - -/* The routines that evaluate the data in the segment produced */ -/* by this routine cannot distinguish between rotations of THETA */ -/* radians, where THETA is in the interval [0, pi), and */ -/* rotations of */ - -/* THETA + 2 * k * pi */ - -/* radians, where k is any integer. These "large" rotations will */ -/* yield invalid results when interpolated. You must ensure that */ -/* the data stored in the segment will not be subject to this */ -/* sort of ambiguity. */ - -/* 12) If any quaternion has magnitude zero, the error */ -/* SPICE(ZEROQUATERNION) is signaled. */ - -/* 13) If the interpolation window size implied by DEGREE is not */ -/* even, the error SPICE(INVALIDDEGREE) is signaled. The window */ -/* size is DEGREE+1 for Lagrange subtypes and is (DEGREE+1)/2 */ -/* for Hermite subtypes. */ - -/* 14) If an unrecognized subtype code is supplied, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 15) If DEGREE is not at least 1 or is greater than MAXDEG, the */ -/* error SPICE(INVALIDDEGREE) is signaled. */ - -/* 16) If the segment descriptor bounds are out of order, the */ -/* error SPICE(BADDESCRTIMES) is signaled. */ - -/* 17) If there is no element of SCLKDP that lies between BEGTIM and */ -/* ENDTIM inclusive, the error SPICE(EMPTYSEGMENT) is signaled. */ - -/* 18) If RATE is zero, the error SPICE(INVALIDVALUE) is signaled. */ - - -/* $ Files */ - -/* A new type 5 CK segment is written to the CK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes a CK type 5 data segment to the open CK */ -/* file according to the format described in the type 5 section of */ -/* the CK Required Reading. The CK file must have been opened with */ -/* write access. */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* Suppose that you have data packets and are prepared to produce */ -/* a segment of type 5 in a CK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened CK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_CK_TYPE_5_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL CKW05 ( HANDLE, SUBTYP, DEGREE, BEGTIM, ENDTIM, */ -/* . INST, REF, AVFLAG, SEGID, N, */ -/* . SCLKDP, PACKTS, RATE, NINTS, STARTS ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */ - -/* The check for non-unit quaternions has been replaced */ -/* with a check for zero-length quaternions. */ - -/* - SPICELIB Version 1.1.0, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* Minor typo in a long error message was corrected. */ - -/* - SPICELIB Version 1.0.1, 07-JAN-2005 (NJB) */ - -/* Description in Detailed_Input header section of */ -/* constraints on BEGTIM and ENDTIM was corrected. */ - -/* - SPICELIB Version 1.0.0, 30-AUG-2002 (NJB) (KRG) (JML) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write ck type_5 data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */ - -/* The check for non-unit quaternions has been replaced */ -/* with a check for zero-length quaternions. */ - -/* This change was made to accommodate CK generation, */ -/* via the non-SPICE utility MEX2KER, for European missions. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Packet structure parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CKW05", (ftnlen)5); - } - -/* Make sure that the number of packets is positive. */ - - if (*n < 1) { - setmsg_("At least 1 packet is required for CK type 5. Number of pack" - "ets supplied: #", (ftnlen)75); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Make sure that there is a positive number of interpolation */ -/* intervals. */ - - if (*nints <= 0) { - setmsg_("# is an invalid number of interpolation intervals for type " - "5.", (ftnlen)61); - errint_("#", nints, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMINTS)", (ftnlen)21); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(ref, &refcod, ref_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("CKW05", (ftnlen)5); - return 0; - } - } - -/* Now check that the encoded SCLK times are positive and strictly */ -/* increasing. */ - -/* Check that the first time is nonnegative. */ - - if (sclkdp[0] < 0.) { - setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Now check that the times are ordered properly. */ - - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) { - setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)" - " = # and SCLKDP(#) = #.", (ftnlen)78); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &sclkdp[i__ - 1], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &sclkdp[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("CKW05", (ftnlen)5); - return 0; - } - } - -/* Now check that the interval start times are ordered properly. */ - - i__1 = *nints; - for (i__ = 2; i__ <= i__1; ++i__) { - if (starts[i__ - 1] <= starts[i__ - 2]) { - setmsg_("The interval start times are not strictly increasing. S" - "TARTS(#) = # and STARTS(#) = #.", (ftnlen)86); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &starts[i__ - 1], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &starts[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("CKW05", (ftnlen)5); - return 0; - } - } - -/* Now make sure that all of the interval start times coincide with */ -/* one of the times associated with the actual pointing. */ - - i__1 = *nints; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* We know the SCLKDP array is ordered, so a binary search is */ -/* ok. */ - - if (bsrchd_(&starts[i__ - 1], n, sclkdp) == 0) { - setmsg_("Interval start time number # is invalid. STARTS(#) = *", - (ftnlen)54); - errint_("#", &i__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("*", &starts[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDSTARTTIME)", (ftnlen)23); - chkout_("CKW05", (ftnlen)5); - return 0; - } - } - -/* Set the window, packet size and angular velocity flag, all of */ -/* which are functions of the subtype. */ - - if (*subtyp == 0) { - winsiz = (*degree + 1) / 2; - packsz = 8; - } else if (*subtyp == 1) { - winsiz = *degree + 1; - packsz = 4; - } else if (*subtyp == 2) { - winsiz = (*degree + 1) / 2; - packsz = 14; - } else if (*subtyp == 3) { - winsiz = *degree + 1; - packsz = 7; - } else { - setmsg_("CK type 5 subtype <#> is not supported.", (ftnlen)39); - errint_("#", subtyp, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Make sure that the quaternions are non-zero. This is just */ -/* a check for uninitialized data. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* We have to address the quaternion explicitly, since the shape */ -/* of the packet array is not known at compile time. */ - - addr__ = packsz * (i__ - 1) + 1; - if (vzerog_(&packts[addr__ - 1], &c__4)) { - setmsg_("The quaternion at index # has magnitude zero.", (ftnlen) - 45); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21); - chkout_("CKW05", (ftnlen)5); - return 0; - } - } - -/* Make sure that the degree of the interpolating polynomials is */ -/* in range. */ - - if (*degree < 1 || *degree > 15) { - setmsg_("The interpolating polynomials have degree #; the valid degr" - "ee range is [1, #]", (ftnlen)77); - errint_("#", degree, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Make sure that the window size is even. If not, the input */ -/* DEGREE is incompatible with the subtype. */ - - if (odd_(&winsiz)) { - setmsg_("The interpolating polynomials have degree #; for CK type 5," - " the degree must be equivalent to 3 mod 4 for Hermite interp" - "olation and odd for for Lagrange interpolation.", (ftnlen)166) - ; - errint_("#", degree, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* If we made it this far, we're ready to start writing the segment. */ - -/* Create the segment descriptor. */ - -/* Assign values to the integer components of the segment descriptor. */ - - ic[0] = *inst; - ic[1] = refcod; - ic[2] = 5; - if (*avflag) { - ic[3] = 1; - } else { - ic[3] = 0; - } - dc[0] = *begtim; - dc[1] = *endtim; - -/* Make sure the descriptor times are in increasing order. */ - - if (*endtim < *begtim) { - setmsg_("Descriptor bounds are non-increasing: #:#", (ftnlen)41); - errdp_("#", begtim, (ftnlen)1); - errdp_("#", endtim, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Make sure that at least one time tag lies between BEGTIM and */ -/* ENDTIM. The first time tag not less than BEGTIM must exist */ -/* and must be less than or equal to ENDTIM. */ - - i__ = lstltd_(begtim, n, sclkdp); - if (i__ == *n) { - setmsg_("All time tags are less than segment start time #.", (ftnlen) - 49); - errdp_("#", begtim, (ftnlen)1); - sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19); - chkout_("CKW05", (ftnlen)5); - return 0; - } else if (sclkdp[i__] > *endtim) { - setmsg_("No time tags lie between the segment start time # and segme" - "nt end time #", (ftnlen)72); - errdp_("#", begtim, (ftnlen)1); - errdp_("#", endtim, (ftnlen)1); - sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* The clock rate must be non-zero. */ - - if (*rate == 0.) { - setmsg_("The SCLK rate RATE was zero.", (ftnlen)28); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* Now pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dc, ic, descr); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("CKW05", (ftnlen)5); - return 0; - } - -/* The type 5 segment structure is eloquently described by this */ -/* diagram from the CK Required Reading: */ - -/* +-----------------------+ */ -/* | Packet 1 | */ -/* +-----------------------+ */ -/* | Packet 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Packet N | */ -/* +-----------------------+ */ -/* | Epoch 1 | */ -/* +-----------------------+ */ -/* | Epoch 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------------+ */ -/* | Epoch N | */ -/* +----------------------------+ */ -/* | Epoch 100 | (First directory) */ -/* +----------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------------+ */ -/* | Epoch ((N-1)/100)*100 | (Last directory) */ -/* +----------------------------+ */ -/* | Start time 1 | */ -/* +----------------------------+ */ -/* | Start time 2 | */ -/* +----------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------------+ */ -/* | Start time M | */ -/* +----------------------------+ */ -/* | Start time 100 | (First interval start */ -/* +----------------------------+ time directory) */ -/* . */ -/* . */ -/* . */ -/* +----------------------------+ */ -/* | Start time ((M-1)/100)*100 | (Last interval start */ -/* +----------------------------+ time directory) */ -/* | Seconds per tick | */ -/* +----------------------------+ */ -/* | Subtype code | */ -/* +----------------------------+ */ -/* | Window size | */ -/* +----------------------------+ */ -/* | Number of interp intervals | */ -/* +----------------------------+ */ -/* | Number of packets | */ -/* +----------------------------+ */ - - - i__1 = *n * packsz; - dafada_(packts, &i__1); - dafada_(sclkdp, n); - i__1 = (*n - 1) / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&sclkdp[i__ * 100 - 1], &c__1); - } - -/* Now add the interval start times. */ - - dafada_(starts, nints); - -/* And the directory of interval start times. The directory of */ -/* start times will simply be every (DIRSIZ)th start time. */ - - i__1 = (*nints - 1) / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&starts[i__ * 100 - 1], &c__1); - } - -/* Add the SCLK rate, segment subtype, window size, interval */ -/* count, and packet count. */ - - dafada_(rate, &c__1); - d__1 = (doublereal) (*subtyp); - dafada_(&d__1, &c__1); - d__1 = (doublereal) winsiz; - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*nints); - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("CKW05", (ftnlen)5); - return 0; -} /* ckw05_ */ - diff --git a/ext/spice/src/cspice/ckw05_c.c b/ext/spice/src/cspice/ckw05_c.c deleted file mode 100644 index b691a5c294..0000000000 --- a/ext/spice/src/cspice/ckw05_c.c +++ /dev/null @@ -1,701 +0,0 @@ -/* - --Procedure ckw05_c ( Write CK segment, type 5 ) - --Abstract - - Write a type 5 segment to a CK file. - --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 - - CK - NAIF_IDS - ROTATION - TIME - --Keywords - - POINTING - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef ckw05_c - - - void ckw05_c ( SpiceInt handle, - SpiceCK05Subtype subtyp, - SpiceInt degree, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt n, - ConstSpiceDouble sclkdp [], - const void * packts, - SpiceDouble rate, - SpiceInt nints, - ConstSpiceDouble starts [] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an open CK file. - subtyp I CK type 5 subtype code. - degree I Degree of interpolating polynomials. - begtim I The beginning encoded SCLK of the segment. - endtim I The ending encoded SCLK of the segment. - inst I The NAIF instrument ID code. - ref I The reference frame of the segment. - avflag I True if the segment will contain angular velocity. - segid I Segment identifier. - n I Number of packets. - sclkdp I Encoded SCLK times. - packts I Array of packets. - rate I Nominal SCLK rate in seconds per tick. - nints I Number of intervals. - starts I Encoded SCLK interval start times. - MAXDEG P Maximum allowed degree of interpolating polynomial. - --Detailed_Input - - - handle is the handle of the CK file to which the segment will be - written. The file must have been opened with write - access. - - subtyp is an integer code indicating the subtype of the - segment to be created. - - degree is the degree of the polynomials used to interpolate the - quaternions contained in the input packets. All - components of the quaternions are interpolated by - polynomials of fixed degree. - - begtim, - endtim are the beginning and ending encoded SCLK times - for which the segment provides pointing information. - begtim must be less than or equal to endtim, and at least - one data packet must have a time tag t such that - - begtim < t < endtim - - - - - inst is the NAIF integer ID code for the instrument. - - ref is a character string which specifies the - reference frame of the segment. This should be one of - the frames supported by the SPICELIB routine NAMFRM - which is an entry point of FRAMEX. - - The rotation matrices represented by the quaternions - that are to be written to the segment transform the - components of vectors from the inertial reference frame - specified by ref to components in the instrument fixed - frame. Also, the components of the angular velocity - vectors to be written to the segment should be given - with respect to ref. - - ref should be the name of one of the frames supported - by the SPICELIB routine NAMFRM. - - - avflag is a boolean flag which indicates whether or not the - segment will contain angular velocity. - - segid is the segment identifier. A CK segment identifier may - contain up to 40 characters, excluding the terminating - null. - - packts contains a time-ordered array of data packets - representing the orientation of inst relative to the - frame ref. Each packet contains a SPICE-style quaternion - and optionally, depending on the segment subtype, - attitude derivative data, from which a C-matrix and an - angular velocity vector may be derived. - - See the discussion of "Quaternion Styles" in the - Particulars section below. - - The C-matrix represented by the Ith data packet is a - rotation matrix that transforms the components of a - vector expressed in the base frame specified by ref to - components expressed in the instrument fixed frame at the - time sclkdp(I). - - Thus, if a vector v has components x, y, z in the base - frame, then v has components x', y', z' in the instrument - fixed frame where: - - [ x' ] [ ] [ x ] - | y' | = | cmat | | y | - [ z' ] [ ] [ z ] - - - The attitude derivative information in packts[i] gives - the angular velocity of the instrument fixed frame at - time sclkdp[i] with respect to the reference frame - specified by ref. - - The direction of an angular velocity vector gives the - right-handed axis about which the instrument fixed - reference frame is rotating. The magnitude of the vector - is the magnitude of the instantaneous velocity of the - rotation, in radians per second. - - Packet contents and the corresponding interpolation - methods depend on the segment subtype, and are as - follows: - - Subtype 0: Hermite interpolation, 8-element packets. - Quaternion and quaternion derivatives - only, no angular velocity vector provided. - Quaternion elements are listed first, - followed by derivatives. Angular velocity - is derived from the quaternions and - quaternion derivatives. - - Subtype 1: Lagrange interpolation, 4-element packets. - Quaternion only. Angular velocity is - derived by differentiating the - interpolating polynomials. - - Subtype 2: Hermite interpolation, 14-element packets. - Quaternion and angular angular velocity - vector, as well as derivatives of each, - are provided. The quaternion comes first, - then quaternion derivatives, then angular - velocity and its derivatives. - - Subtype 3: Lagrange interpolation, 7-element packets. - Quaternion and angular velocity vector - provided. The quaternion comes first. - - Angular velocity is always specified relative to the base - frame. - - rate is the nominal rate of the spacecraft clock associated - with inst. Units are seconds per tick. rate is used to - scale angular velocity to radians/second. - - nints is the number of intervals that the pointing instances - are partitioned into. - - starts are the start times of each of the interpolation - intervals. These times must be strictly increasing and - must coincide with times for which the segment contains - pointing. - --Detailed_Output - - None. See Files section. - --Parameters - - MAXDEG is the maximum allowed degree of the interpolating - polynomial. If the value of MAXDEG is increased, the - CSPICE routine ckpfs_ must be changed accordingly. In - particular, the size of the record passed to ckrNN_ and - ckeNN_ must be increased, and comments describing the - record size must be changed. - --Exceptions - - If any of the following exceptions occur, this routine will return - without creating a new segment. - - 1) If handle is not the handle of a C-kernel opened for writing - the error will be diagnosed by routines called by this - routine. - - 2) If the last non-blank character of segid occurs past index 40, - the error SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If the first encoded SCLK time is negative then the error - SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times - are negative the error will be detected in exception (5). - - 5) If the encoded SCLK times are not strictly increasing, - the error SPICE(TIMESOUTOFORDER) is signaled. - - 6) If the name of the reference frame is not one of those - supported by the routine framex_, the error - SPICE(INVALIDREFFRAME) is signaled. - - 7) If the number of packets n is not at least 1, the error - SPICE(TOOFEWPACKETS) will be signaled. - - 8) If nints, the number of interpolation intervals, is less than - or equal to 0, the error SPICE(INVALIDNUMINTS) is signaled. - - 9) If the encoded SCLK interval start times are not strictly - increasing, the error SPICE(TIMESOUTOFORDER) is signaled. - - 10) If an interval start time does not coincide with a time for - which there is an actual pointing instance in the segment, - then the error SPICE(INVALIDSTARTTIME) is signaled. - - 11) This routine assumes that the rotation between adjacent - quaternions that are stored in the same interval has a - rotation angle of theta radians, where - - 0 < theta < pi. - _ - - The routines that evaluate the data in the segment produced - by this routine cannot distinguish between rotations of theta - radians, where theta is in the interval [0, pi), and - rotations of - - theta + 2 * k * pi - - radians, where k is any integer. These "large" rotations will - yield invalid results when interpolated. You must ensure that - the data stored in the segment will not be subject to this - sort of ambiguity. - - 12) If any quaternion is the zero vector, the error - SPICE(ZEROQUATERNION) is signaled. - - 13) If the interpolation window size implied by degree is not - even, the error SPICE(INVALIDDEGREE) is signaled. The window - size is degree+1 for Lagrange subtypes and is (degree+1)/2 - for Hermite subtypes. - - 14) If an unrecognized subtype code is supplied, the error - SPICE(NOTSUPPORTED) is signaled. - - 15) If degree is not at least 1 or is greater than MAXDEG, the - error SPICE(INVALIDDEGREE) is signaled. - - 16) If the segment descriptor bounds are out of order, the - error SPICE(BADDESCRTIMES) is signaled. - - 17) If there is no element of SCLKDP that lies between BEGTIM and - ENDTIM inclusive, the error SPICE(EMPTYSEGMENT) is signaled. - - 18) If RATE is zero, the error SPICE(INVALIDVALUE) is signaled. - - 18) If either the input frame or segment ID have null string - pointers, the error SPICE(NULLPOINTER) is signaled. - - 19) If either the input frame or segment ID are zero-length - strings, the error SPICE(EMPTYSTRING) is signaled. - - --Files - - A new type 5 CK segment is written to the CK file attached - to handle. - --Particulars - - This routine writes a CK type 5 data segment to the open CK - file according to the format described in the type 5 section of - the CK Required Reading. The CK file must have been opened with - write access. - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - This example code fragment writes a type 5 C-kernel segment - for the Mars Express spacecraft bus to a previously opened CK - file attached to handle. - - /. - Include CSPICE interface definitions. - ./ - #include "SpiceUsr.h" - . - . - . - /. - Assume arrays of quaternions, angular velocities, and the - associated SCLK times are produced elsewhere. The software - that calls ckw05_c must then decide how to partition these - pointing instances into intervals over which linear - interpolation between adjacent points is valid. - ./ - . - . - . - - /. - The subroutine ckw05_c needs the following items for the - segment descriptor: - - 1) SCLK limits of the segment. - 2) Instrument code. - 3) Reference frame. - 4) The angular velocity flag. - - ./ - - begtim = sclk [ 0 ]; - endtim = sclk [ nrec-1 ]; - - inst = -41000; - ref = "J2000"; - avflag = SPICETRUE; - - segid = "MEX spacecraft bus - data type 5"; - - /. - Write the segment. - ./ - ckw05_c ( handle, subtyp, degree, begtim, endtim, inst, - ref, avflag, segid, n, sclkdp, packts, - rate, nints, starts ); - . - . - . - /. - After all segments are written, close the C-kernel. - ./ - ckcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - K.R. Gehringer (JPL) - J.M. Lynch (JPL) - --Version - - -CSPICE Version 2.0.0, 01-JUN-2010 (NJB) - - The check for non-unit quaternions has been replaced - with a check for zero-length quaternions. (The - implementation of the check is located in ckw05_.) - - -CSPICE Version 1.0.2, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. - - -CSPICE Version 1.0.1, 07-JAN-2005 (NJB) - - Description in Detailed_Input header section of - constraints on BEGTIM and ENDTIM was corrected - - -CSPICE Version 1.0.0, 30-AUG-2002 (NJB) (WLT) (KRG) (JML) - --Index_Entries - - write ck type_5 data segment - --& -*/ - -{ /* Begin ckw05_c */ - - - - /* - Local variables - */ - logical avf; - - SpiceInt locSubtype; - - - - - /* - Participate in error tracingx. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "ckw05_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ckw05_c", ref ); - CHKFSTR ( CHK_STANDARD, "ckw05_c", segid ); - - - /* - Get a type logical copy of the a.v. flag. Get a type SpiceInt - copy of the CK type 5 subtype. - */ - avf = (logical) avflag; - - locSubtype = (SpiceInt) subtyp; - - - /* - Write the segment. Note that the packet array - DOES NOT require transposition! - */ - ckw05_( ( integer * ) &handle, - ( integer * ) &locSubtype, - ( integer * ) °ree, - ( doublereal * ) &begtim, - ( doublereal * ) &endtim, - ( integer * ) &inst, - ( char * ) ref, - ( logical * ) &avf, - ( char * ) segid, - ( integer * ) &n, - ( doublereal * ) sclkdp, - ( doublereal * ) packts, - ( doublereal * ) &rate, - ( integer * ) &nints, - ( doublereal * ) starts, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "ckw05_c" ); - -} /* End ckw05_c */ diff --git a/ext/spice/src/cspice/clearc.c b/ext/spice/src/cspice/clearc.c deleted file mode 100644 index 5acab4bf2d..0000000000 --- a/ext/spice/src/cspice/clearc.c +++ /dev/null @@ -1,139 +0,0 @@ -/* clearc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CLEARC ( Clear a character-string array ) */ -/* Subroutine */ int clearc_(integer *ndim, char *array, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Fill a character-string array with blank strings. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------- */ -/* NDIM I The number of elements of ARRAY which are to be */ -/* set to blank. */ -/* ARRAY O Character-string array to be filled. */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in ARRAY which are to be */ -/* set to blank. */ - -/* $ Detailed_Output */ - -/* ARRAY is the character string array which is to be filled */ -/* with blank elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* If NDIM = 4, then the contents of ARRAY are: */ - -/* ARRAY (1) = ' ' */ -/* ARRAY (2) = ' ' */ -/* ARRAY (3) = ' ' */ -/* ARRAY (4) = ' ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1, the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* clear a character array */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(array + (i__ - 1) * array_len, " ", array_len, (ftnlen)1); - } - return 0; -} /* clearc_ */ - diff --git a/ext/spice/src/cspice/cleard.c b/ext/spice/src/cspice/cleard.c deleted file mode 100644 index 68ea17050b..0000000000 --- a/ext/spice/src/cspice/cleard.c +++ /dev/null @@ -1,136 +0,0 @@ -/* cleard.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CLEARD ( Clear a double precision array ) */ -/* Subroutine */ int cleard_(integer *ndim, doublereal *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Fill a double precision array with zeros. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------- */ -/* NDIM I The number of elements of ARRAY which are to be */ -/* set to zero. */ -/* ARRAY O Double precision array to be filled. */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in ARRAY which are to be */ -/* set to zero. */ - -/* $ Detailed_Output */ - -/* ARRAY is the double precision array which it to be filled */ -/* with zeros. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* If NDIM = 4, then the contents of ARRAY are: */ - -/* ARRAY (1) = 0.0D0 */ -/* ARRAY (2) = 0.0D0 */ -/* ARRAY (3) = 0.0D0 */ -/* ARRAY (4) = 0.0D0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1, the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* clear a d.p. array */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - array[i__ - 1] = 0.; - } - return 0; -} /* cleard_ */ - diff --git a/ext/spice/src/cspice/cleari.c b/ext/spice/src/cspice/cleari.c deleted file mode 100644 index 876d817c14..0000000000 --- a/ext/spice/src/cspice/cleari.c +++ /dev/null @@ -1,136 +0,0 @@ -/* cleari.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CLEARI ( Clear an integer array ) */ -/* Subroutine */ int cleari_(integer *ndim, integer *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Fill an integer array with zeros. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------- */ -/* NDIM I The number of elements of ARRAY which are to be */ -/* set to zero. */ -/* ARRAY O Integer array to be filled. */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in ARRAY which are to be */ -/* set to zero. */ - -/* $ Detailed_Output */ - -/* ARRAY is the integer array which it to be filled with */ -/* zeros. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* If NDIM = 4, then the contents of ARRAY are: */ - -/* ARRAY (1) = 0 */ -/* ARRAY (2) = 0 */ -/* ARRAY (3) = 0 */ -/* ARRAY (4) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1, the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* clear an integer array */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - array[i__ - 1] = 0; - } - return 0; -} /* cleari_ */ - diff --git a/ext/spice/src/cspice/clight.c b/ext/spice/src/cspice/clight.c deleted file mode 100644 index c1ba4675d7..0000000000 --- a/ext/spice/src/cspice/clight.c +++ /dev/null @@ -1,156 +0,0 @@ -/* clight.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CLIGHT ( C, Speed of light in a vacuum ) */ -doublereal clight_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the speed of light in a vacuum (IAU official */ -/* value, in km/sec). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the speed of light in vacuo (km/sec). */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the IAU official value for the speed of light */ -/* in vacuo: 299792.458 km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* Find the light time corresponding to the length of a given */ -/* 3-dimensional position vector. Length units are km. */ - -/* To use CLIGHT, declare it as having double precision type: */ - -/* DOUBLE PRECISION CLIGHT */ - -/* Let POS be a 3-vector of interest; let TAU be the light time. */ -/* VNORM is the SPICELIB function that returns the norm of a */ -/* 3-vector. */ - -/* DOUBLE PRECISION VNORM */ -/* DOUBLE PRECISION TAU */ -/* DOUBLE PRECISION POS (3 ) */ - -/* Find the light time: */ - -/* TAU = VNORM ( POS ) / CLIGHT () */ - -/* Note that the SPK readers */ - -/* SPKEZR */ -/* SPKEZ */ -/* SPKPOS */ -/* SPKEZP */ - -/* return the one-way light time between target and observer */ -/* as an output. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 08-JAN-2008 (NJB) */ - -/* Example section was updated to remove references to SPKAPP */ -/* and BODMAT. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* c speed of light in a vacuum */ - -/* -& */ - -/* Just like it says. */ - - ret_val = 299792.458; - return ret_val; -} /* clight_ */ - diff --git a/ext/spice/src/cspice/clight_c.c b/ext/spice/src/cspice/clight_c.c deleted file mode 100644 index 606c679d9e..0000000000 --- a/ext/spice/src/cspice/clight_c.c +++ /dev/null @@ -1,146 +0,0 @@ -/* - --Procedure clight_c ( C, Speed of light in a vacuum ) - --Abstract - - Return the speed of light in a vacuum (IAU official - value, in km/sec). - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble clight_c ( void ) - -/* - --Brief_I/O - - The function returns the speed of light in vacuo (km/sec). - --Detailed_Input - - None. - --Detailed_Output - - The function returns the IAU official value for the speed of light - in vacuo: 299792.458 km/sec. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns the constant value shown above. - --Examples - - The following example uses clight_c to determine the one-way - light-time (tau) to an object whose position relative to an - observer is contained in pos. - - tau = vnorm_c ( pos ) / clight_c (); - - Note that the SPK readers - - spkezr_c - spkez_c - spkpos_c - spkezp_c - - return the one-way light time as an output, for example - - spkez_c ( ..., &tau ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.2, 07-FEB-2008 (EDW) (NJB) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - Updated example to show pointer output argument - `tau' and list other high-level SPK routines that - return light time. Call to bodmat_c was removed - from example. - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - measured velocity of light in a vacuum - --& -*/ - -{ /* Begin clight_c */ - - return 299792.458; - -} /* End clight_c */ - diff --git a/ext/spice/src/cspice/close.c b/ext/spice/src/cspice/close.c deleted file mode 100644 index 58100593f7..0000000000 --- a/ext/spice/src/cspice/close.c +++ /dev/null @@ -1,94 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#ifdef KR_headers -integer f_clos(a) cllist *a; -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -#ifdef NON_UNIX_STDIO -#ifndef unlink -#define unlink remove -#endif -#else -#ifdef MSDOS -#include "io.h" -#else -#ifdef __cplusplus -extern "C" int unlink(const char*); -#else -extern int unlink(const char*); -#endif -#endif -#endif - -integer f_clos(cllist *a) -#endif -{ unit *b; - - if(a->cunit >= MXUNIT) return(0); - b= &f__units[a->cunit]; - if(b->ufd==NULL) - goto done; - if (b->uscrtch == 1) - goto Delete; - if (!a->csta) - goto Keep; - switch(*a->csta) { - default: - Keep: - case 'k': - case 'K': - if(b->uwrt == 1) - t_runc((alist *)a); - if(b->ufnm) { - fclose(b->ufd); - free(b->ufnm); - } - break; - case 'd': - case 'D': - Delete: - fclose(b->ufd); - if(b->ufnm) { - unlink(b->ufnm); /*SYSDEP*/ - free(b->ufnm); - } - } - b->ufd=NULL; - done: - b->uend=0; - b->ufnm=NULL; - return(0); - } - void -#ifdef KR_headers -f_exit() -#else -f_exit(void) -#endif -{ int i; - static cllist xx; - if (!xx.cerr) { - xx.cerr=1; - xx.csta=NULL; - for(i=0;i_FRAME - - where is the non-blank portion of the string CNAME. - - For those PCK objects that have "built-in" frame names this - routine returns the corresponding "IAU" frame and frame ID code. - --Examples - - Suppose that you want to determine the state of a target - in the preferred reference frame of some observer. This - routine can be used in conjunction with spkezr_c to compute - the state. - - #include - #include - #include "SpiceUsr.h" - . - . - . - #define LENOUT 80 - - cnmfrm_c ( obsnam, LENOUT, &frcode, frname, &found ); - - if ( !found ) - { - printf ( "The bodyfixed frame for object %s " - "could not be identified.\n", - obsnam ); - exit(1); - } - - spkezr_c ( target, et, frname, abcorr, obsnam, state, < ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 25-JUN-1999 (NJB) (WLT) - --Index_Entries - - Fetch reference frame attributes - --& -*/ - -{ /* Begin cnmfrm_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "cnmfrm_c" ); - - /* - Check the input object's name string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "cnmfrm_c", cname ); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "cnmfrm_c", frname, lenout ); - - - /* - Invoke the f2c'd routine. - */ - cnmfrm_ ( ( char * ) cname, - ( integer * ) frcode, - ( char * ) frname, - ( logical * ) found, - ( ftnlen ) strlen(cname), - ( ftnlen ) lenout-1 ); - - - /* - Convert the output string to C-style. - */ - F2C_ConvertStr ( lenout, frname ); - - - chkout_c ( "cnmfrm_c" ); - -} /* End cnmfrm_c */ diff --git a/ext/spice/src/cspice/conics.c b/ext/spice/src/cspice/conics.c deleted file mode 100644 index 1505d16b4a..0000000000 --- a/ext/spice/src/cspice/conics.c +++ /dev/null @@ -1,436 +0,0 @@ -/* conics.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CONICS ( Determine state from conic elements ) */ -/* Subroutine */ int conics_(doublereal *elts, doublereal *et, doublereal * - state) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double cos(doublereal), sin(doublereal), sqrt(doublereal), d_mod( - doublereal *, doublereal *); - - /* Local variables */ - doublereal cnci, argp, snci, cosi, sini, cosn, sinn; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - doublereal cosw, sinw, n, v; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal lnode; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal m0; - extern doublereal twopi_(void); - doublereal t0; - extern /* Subroutine */ int prop2b_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal dt, rp, mu, basisp[3], period, basisq[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal pstate[6], ainvrs; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - doublereal ecc, inc; - -/* $ Abstract */ - -/* Determine the state (position, velocity) of an orbiting body */ -/* from a set of elliptic, hyperbolic, or parabolic orbital */ -/* elements. */ - -/* $ 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 */ - -/* CONIC */ -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ELTS I Conic elements. */ -/* ET I Input time. */ -/* STATE O State of orbiting body at ET. */ - -/* $ Detailed_Input */ - -/* ELTS are conic elements describing the orbit of a body */ -/* around a primary. The elements are, in order: */ - -/* RP Perifocal distance. */ -/* ECC Eccentricity. */ -/* INC Inclination. */ -/* LNODE Longitude of the ascending node. */ -/* ARGP Argument of periapse. */ -/* M0 Mean anomaly at epoch. */ -/* T0 Epoch. */ -/* MU Gravitational parameter. */ - -/* Units are km, rad, rad/sec, km**3/sec**2. The epoch */ -/* is given in ephemeris seconds past J2000. The same */ -/* elements are used to describe all three types */ -/* (elliptic, hyperbolic, and parabolic) of conic orbit. */ - -/* ET is the time at which the state of the orbiting body */ -/* is to be determined, in ephemeris seconds J2000. */ - -/* $ Detailed_Output */ - -/* STATE is the state (position and velocity) of the body at */ -/* time ET. Components are x, y, z, dx/dt, dy/dt, dz/dt. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity supplied is less than 0, the error */ -/* 'SPICE(BADECCENTRICITY)' is signalled. */ - -/* 2) If a non-positive periapse distance is supplied, the error */ -/* 'SPICE(BADPERIAPSEVALUE)' is signalled. */ - -/* 3) If a non-positive value for the attracting mass is supplied, */ -/* the error 'SPICE(BADGM)', is signalled. */ - -/* 4) Errors such as an out of bounds value for ET are diagnosed */ -/* by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let VINIT contain the initial state of a spacecraft relative to */ -/* the center of a planet at epoch ET, and let GM be the gravitation */ -/* parameter of the planet. The call */ - -/* CALL OSCELT ( VINIT, ET, GM, ELTS ) */ - -/* produces a set of osculating elements describing the nominal */ -/* orbit that the spacecraft would follow in the absence of all */ -/* other bodies in the solar system and non-gravitational forces */ -/* on the spacecraft. */ - -/* Now let STATE contain the state of the same spacecraft at some */ -/* other epoch, LATER. The difference between this state and the */ -/* state predicted by the nominal orbit at the same epoch can be */ -/* computed as follows. */ - -/* CALL CONICS ( ELTS, LATER, NOMINAL ) */ -/* CALL VSUBG ( NOMINAL, STATE, 6, DIFF ) */ - -/* WRITE (*,*) 'Perturbation in x, dx/dt = ', DIFF(1), DIFF(4) */ -/* WRITE (*,*) ' y, dy/dt = ', DIFF(2), DIFF(5) */ -/* WRITE (*,*) ' z, dz/dt = ', DIFF(3), DIFF(6) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 26-MAR-1998 (WLT) */ - -/* There was a coding error in the computation of the mean */ -/* anomaly in the parabolic case. This problem has been */ -/* corrected. */ - -/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */ - -/* Corrected a typo in the description of the units associated */ -/* with the input elements. */ - -/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */ - -/* The routine was re-written to make use of NAIF's universal */ -/* variables formulation for state propagation (PROP2B). As */ -/* a result, several problems were simultaneously corrected. */ - -/* A major bug was fixed that caused improper state evaluations */ -/* for ET's that precede the epoch of the elements in the */ -/* elliptic case. */ - -/* A danger of non-convergence in the solution of Kepler's */ -/* equation has been eliminated. */ - -/* In addition to this reformulation of CONICS checks were */ -/* installed that ensure the elements supplied are physically */ -/* meaningful. Eccentricity must be non-negative. The */ -/* distance at periapse and central mass must be positive. If */ -/* not errors are signalled. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */ - -/* An error in the hyperbolic state generation was corrected. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* state from conic elements */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */ - -/* Corrected a typo in the description of the units associated */ -/* with the input elements. */ - -/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */ - -/* The routine was re-written to make use of NAIF's universal */ -/* variables formulation for state propagation (PROP2B). As */ -/* a result, several problems were simultaneously corrected. */ - -/* A major bug was fixed that caused improper state evaluations */ -/* for ET's that precede the epoch of the elements in the */ -/* elliptic case. */ - -/* A danger of non-convergence in the solution of Kepler's */ -/* equation has been eliminated. */ - -/* In addition to this reformulation of CONICS checks were */ -/* installed that ensure the elements supplied are physically */ -/* meaningful. Eccentricity must be non-negative. The */ -/* distance at periapse and central mass must be positive. If */ -/* not errors are signalled. */ - -/* These changes were prompted by the discovery that the old */ -/* formulation had a severe bug for elliptic orbits and epochs */ -/* prior to the epoch of the input elements, and by the discovery */ -/* that the time of flight routines had problems with convergence. */ - -/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */ - -/* The original version of the routine had a bug in that */ -/* it attempted to restrict the hyperbolic anomaly to */ -/* the interval 0 to 2*PI. This has been fixed. */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* The only real work required by this routine is the construction */ -/* of a preliminary state vector from the input elements. Once this */ -/* is in hand, we can simply let the routine PROP2B do the real */ -/* work, free from the instabilities inherent in the classical */ -/* elements formulation of two-body motion. */ - -/* To do this we shall construct a basis of vectors that lie in the */ -/* plane of the orbit. The first vector P shall point towards the */ -/* position of the orbiting body at periapse. The second */ -/* vector Q shall point along the velocity vector of the body at */ -/* periapse. */ - -/* The only other consideration is determining an epoch, TP, of */ -/* this state and the delta time ET - TP. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CONICS", (ftnlen)6); - } - -/* Unpack the element vector. */ - - rp = elts[0]; - ecc = elts[1]; - inc = elts[2]; - lnode = elts[3]; - argp = elts[4]; - m0 = elts[5]; - t0 = elts[6]; - mu = elts[7]; - -/* Handle all of the exceptions first. */ - - if (ecc < 0.) { - setmsg_("The eccentricity supplied was negative. Only positive value" - "s are meaningful. The value was #", (ftnlen)93); - errdp_("#", &ecc, (ftnlen)1); - sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); - chkout_("CONICS", (ftnlen)6); - return 0; - } - if (rp <= 0.) { - setmsg_("The value of periapse range supplied was non-positive. Onl" - "y positive values are allowed. The value supplied was #. ", ( - ftnlen)117); - errdp_("#", &rp, (ftnlen)1); - sigerr_("SPICE(BADPERIAPSEVALUE)", (ftnlen)23); - chkout_("CONICS", (ftnlen)6); - return 0; - } - if (mu <= 0.) { - setmsg_("The value of GM supplied was non-positive. Only positive v" - "alues are allowed. The value supplied was #. ", (ftnlen)105); - errdp_("#", &mu, (ftnlen)1); - sigerr_("SPICE(BADGM)", (ftnlen)12); - chkout_("CONICS", (ftnlen)6); - return 0; - } - -/* First construct the orthonormal basis vectors that span the orbit */ -/* plane. */ - - cosi = cos(inc); - sini = sin(inc); - cosn = cos(lnode); - sinn = sin(lnode); - cosw = cos(argp); - sinw = sin(argp); - snci = sinn * cosi; - cnci = cosn * cosi; - basisp[0] = cosn * cosw - snci * sinw; - basisp[1] = sinn * cosw + cnci * sinw; - basisp[2] = sini * sinw; - basisq[0] = -cosn * sinw - snci * cosw; - basisq[1] = -sinn * sinw + cnci * cosw; - basisq[2] = sini * cosw; - -/* Next construct the state at periapse. */ - -/* The position at periapse is just BASISP scaled by the distance */ -/* at periapse. */ - -/* The velocity must be constructed so that we can get an orbit */ -/* of this shape. Recall that the magnitude of the specific angular */ -/* momentum vector is given by DSQRT ( MU*RP*(1+ECC) ) */ -/* The velocity will be given by V * BASISQ. But we must have the */ -/* magnitude of the cross product of position and velocity be */ -/* equal to DSQRT ( MU*RP*(1+ECC) ). So we must have */ - -/* RP*V = DSQRT( MU*RP*(1+ECC) ) */ - -/* so that: */ - - v = sqrt(mu * (ecc + 1.) / rp); - vscl_(&rp, basisp, pstate); - vscl_(&v, basisq, &pstate[3]); - -/* Finally compute DT the elapsed time since the epoch of periapse. */ -/* Ellipses first, since they are the most common. */ - - if (ecc < 1.) { - -/* Recall that: */ - -/* N ( mean motion ) is given by DSQRT( MU / A**3 ). */ -/* But since, A = RP / ( 1 - ECC ) ... */ - - ainvrs = (1. - ecc) / rp; - n = sqrt(mu * ainvrs) * ainvrs; - period = twopi_() / n; - -/* In general the mean anomaly is given by */ - -/* M = (T - TP) * N */ - -/* Where TP is the time of periapse passage. M0 is the mean */ -/* anomaly at time T0 so that */ -/* Thus */ - -/* M0 = ( T0 - TP ) * N */ - -/* So TP = T0-M0/N hence the time since periapse at time ET */ -/* is given by ET - T0 + M0/N. Finally, since elliptic orbits are */ -/* periodic, we can mod this value by the period of the orbit. */ - - d__1 = *et - t0 + m0 / n; - dt = d_mod(&d__1, &period); - -/* Hyperbolas next. */ - - } else if (ecc > 1.) { - -/* Again, recall that: */ - -/* N ( mean motion ) is given by DSQRT( MU / |A**3| ). */ -/* But since, |A| = RP / ( ECC - 1 ) ... */ - - ainvrs = (ecc - 1.) / rp; - n = sqrt(mu * ainvrs) * ainvrs; - dt = *et - t0 + m0 / n; - -/* Finally, parabolas. */ - - } else { - n = sqrt(mu / (rp * 2.)) / rp; - dt = *et - t0 + m0 / n; - } - -/* Now let PROP2B do the work of propagating the state. */ - - prop2b_(&mu, pstate, &dt, state); - chkout_("CONICS", (ftnlen)6); - return 0; -} /* conics_ */ - diff --git a/ext/spice/src/cspice/conics_c.c b/ext/spice/src/cspice/conics_c.c deleted file mode 100644 index bd72da8ed4..0000000000 --- a/ext/spice/src/cspice/conics_c.c +++ /dev/null @@ -1,203 +0,0 @@ -/* - --Procedure conics_c ( Determine state from conic elements ) - --Abstract - - Determine the state (position, velocity) of an orbiting body - from a set of elliptic, hyperbolic, or parabolic orbital - elements. - --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 - - CONIC - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef conics_c - - - void conics_c ( ConstSpiceDouble elts[8], - SpiceDouble et, - SpiceDouble state[6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - elts I Conic elements. - et I Input time. - state O State of orbiting body at et. - --Detailed_Input - - elts are conic osculating elements describing the orbit of a - body around a primary. The elements are, in order: - - RP Perifocal distance. - ECC Eccentricity. - INC Inclination. - LNODE Longitude of the ascending node. - ARGP Argument of periapse. - M0 Mean anomaly at epoch. - T0 Epoch. - MU Gravitational parameter. - - Units are km, rad, rad/sec, km**3/sec**2. - - The epoch T0 is given in ephemeris seconds past J2000. - T0 is the instant at which the state of the body is - specified by the elements. - - The same elements are used to describe all three types - (elliptic, hyperbolic, and parabolic) of conic orbit. - - et is the time at which the state of the orbiting body - is to be determined, in ephemeris seconds J2000. - --Detailed_Output - - state is the state (position and velocity) of the body at - time `et'. Components are x, y, z, dx/dt, dy/dt, dz/dt. - --Parameters - - None. - --Exceptions - - 1) If the eccentricity supplied is less than 0, the error - SPICE(BADECCENTRICITY) is signaled. - - 2) If a non-positive periapse distance is supplied, the error - SPICE(BADPERIAPSEVALUE) is signaled. - - 3) If a non-positive value for the attracting mass is supplied, - the error SPICE(BADGM), is signaled. - - 4) Errors such as an out of bounds value for `et' are diagnosed - by routines in the call tree of this routine. - --Files - - None. - --Particulars - - None. - --Examples - - Let vinit contain the initial state of a spacecraft relative to the - center of a planet at epoch `et', and let `gm' be the gravitation - parameter of the planet. The call - - oscelt_c ( vinit, et, gm, elts ); - - produces a set of osculating elements describing the nominal - orbit that the spacecraft would follow in the absence of all - other bodies in the solar system and non-gravitational forces - on the spacecraft. - - Now let `state' contain the state of the same spacecraft at some - other, later epoch. The difference between this state and the - state predicted by the nominal orbit at the same epoch can be - computed as follows. - - conics_c ( elts, later, nominal ); - vsubg_c ( nominal, state, 6, diff ); - - printf( "Perturbation in x, dx/dt = %f %f", diff[0], diff[3] ); - printf( " y, dy/dt = %f %f", diff[1], diff[4] ); - printf( " z, dz/dt = %f %f", diff[2], diff[5] ); - --Restrictions - - None. - --Literature_References - - [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.1, 29-JUL-2003 (NJB) - - Various header corrections were made. - - -CSPICE Version 1.1.0, 24-JUL-2001 (NJB) - - Changed protoype: input elts is now type (ConstSpiceDouble *). - Implemented interface macro for casting input array to const. - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 1.0.0, 10-NOV-1997 (EDW) - --Index_Entries - - state from conic elements - --& -*/ - -{ /* Begin conics_c */ - - /* - Participate in error tracing. - */ - - chkin_c ( "conics_c"); - - conics_ ( ( doublereal * ) elts, - ( doublereal * ) &et, - ( doublereal * ) state ); - - chkout_c ( "conics_c"); - - -} /* End conics_c */ diff --git a/ext/spice/src/cspice/convrt.c b/ext/spice/src/cspice/convrt.c deleted file mode 100644 index d648c96cb7..0000000000 --- a/ext/spice/src/cspice/convrt.c +++ /dev/null @@ -1,414 +0,0 @@ -/* convrt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__27 = 27; -static integer c__5 = 5; -static integer c__3 = 3; -static integer c__9 = 9; - -/* $Procedure CONVRT ( Convert Units ) */ -/* Subroutine */ int convrt_(doublereal *x, char *in, char *out, doublereal * - y, ftnlen in_len, ftnlen out_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char units[16*27] = "RADIANS " "DEGREES " "ARCMIN" - "UTES " "ARCSECONDS " "HOURANGLE " "MINUTEANGLE " - " " "SECONDANGLE " "METERS " "KM " - "CM " "MM " "LIGHTSECS " "AU " - " " "FEET " "INCHES " "STATUTE_MILES" - " " "NAUTICAL_MILES " "YARDS " "LIGHTYEARS " - "PARSECS " "SECONDS " "MINUTES " "HOURS " - " " "DAYS " "JULIAN_YEARS " "TROPICAL_YEAR" - "S " "YEARS "; - static doublereal cnvrtn[27] = { 0.0,1.,.016666666666666666, - 2.7777777777777778e-4,15.,.25,.0041666666666666666,1.,1e3,.01, - .001,299792458.,149597870613.68887,.3048,.0254,1609.344,1852., - .9144,9460730472580800.,30856775797231604.,1.,60.,3600.,86400., - 31557600.,31556925.976319999,31557600. }; - static char type__[8*27] = "ANGLE " "ANGLE " "ANGLE " "ANGLE " - "ANGLE " "ANGLE " "ANGLE " "DISTANCE" "DISTANCE" "DISTANCE" - "DISTANCE" "DISTANCE" "DISTANCE" "DISTANCE" "DISTANCE" "DISTANCE" - "DISTANCE" "DISTANCE" "DISTANCE" "DISTANCE" "TIME " "TIME " - "TIME " "TIME " "TIME " "TIME " "TIME "; - - /* System generated locals */ - address a__1[5], a__2[3], a__3[9]; - integer i__1[5], i__2[3], i__3, i__4, i__5[9]; - char ch__1[101], ch__2[56], ch__3[57], ch__4[123]; - - /* Builtin functions */ - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - doublereal temp; - char outu[16]; - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern doublereal dpr_(void); - char inu[16]; - -/* $ Abstract */ - -/* Take a measurement X, the units associated with */ -/* X, and units to which X should be converted; return Y --- */ -/* the value of the measurement in the output units. */ - -/* $ 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 */ - -/* CONVERSION, UNITS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* X I Number representing a measurement in some units. */ -/* IN I The units in which X is measured. */ -/* OUT I Desired units for the measurement. */ -/* Y O The measurment in the desired units. */ - -/* $ Detailed_Input */ - -/* X is a number representing a measurement in the units */ -/* specified by IN. */ - -/* IN represents the units associated with a measurement X. */ -/* Acceptable units are: */ - -/* Angles: 'RADIANS' */ -/* 'DEGREES' */ -/* 'ARCMINUTES' */ -/* 'ARCSECONDS' */ -/* 'HOURANGLE' */ -/* 'MINUTEANGLE' */ -/* 'SECONDANGLE' */ - -/* Metric Distances: 'METERS' */ -/* 'KM' */ -/* 'CM' */ -/* 'MM' */ - -/* English Distances: 'FEET' */ -/* 'INCHES' */ -/* 'YARDS' */ -/* 'STATUTE_MILES' */ -/* 'NAUTICAL_MILES' */ - -/* Astrometric Distances: 'AU' */ -/* 'PARSECS' */ -/* 'LIGHTSECS' */ -/* 'LIGHTYEARS' julian lightyears */ - -/* Time: 'SECONDS' */ -/* 'MINUTES' */ -/* 'HOURS' */ -/* 'DAYS' */ -/* 'JULIAN_YEARS' */ -/* 'TROPICAL_YEARS' */ -/* 'YEARS' (same as julian years) */ - -/* OUT represents the units desired for the measurement X. */ -/* See the description of IN. */ - -/* $ Detailed_Output */ - -/* Y is the input measurement converted to the desired */ -/* units. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts a measurement X given in units specified by */ -/* IN to the equivalent value Y in units specified by OUT. */ - -/* If a unit is not recognized, an error message is produced that */ -/* indicates which one was not recognized. */ - -/* If input and output units are incompatible (for example ANGLE */ -/* and DISTANCE units) and error message will be produced stating */ -/* the requested units and associated types. */ - -/* $ Examples */ - -/* To convert 1 meter to statute miles and feet you could */ - -/* CALL CONVRT ( 1.0D0, 'METERS', 'STATUTE_MILES', MILES ) */ -/* CALL CONVRT ( MILES, 'STATUTE_MILES', 'FEET', FEET ) */ - -/* or */ - -/* CALL CONVRT ( 1.0D0, 'METERS', 'STATUTE_MILES', MILES ) */ -/* CALL CONVRT ( 1.0D0, 'METERS', 'FEET', FEET ) */ - - -/* $ Restrictions */ - -/* You should make sure that your units are appropriate for the */ -/* measurement. This routine does not do any checking for over- */ -/* flow. Something like */ - -/* CALL ( 10.0D22, 'LIGHTYEARS', 'MM', Y ) */ - -/* will cause a floating point overflow. */ - -/* Some of the units are not "defined" quantities. In such a case */ -/* a best estimate is provided as of the date of the current version */ -/* of this routine. Those estimated quantities are: */ - -/* 1 AU --- the astronomical unit is taken from the JPL */ -/* ephemeris DE125. It is believed to be accurate to */ -/* about 40 meters. */ - -/* The tropical year is the time from equinox to equinox. This */ -/* varies slightly with time. */ - -/* 1 PARSEC --- is dependent upon the value of the astronomical */ -/* unit. */ - -/* $ Exceptions */ - -/* 1) If the input units, output units, or both input and */ -/* output units are not recognized, the error */ -/* SPICE(UNITSNOTREC) is signalled. */ - -/* 2) If the units being converted between are incompatible, the */ -/* error SPICE(INCOMPATIBLEUNITS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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 (CAC) (WMO) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert units */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 05-JAN-1990 (WLT) */ - -/* Data statements for double precision values were changed */ -/* to include a 'D' so that this routine would function properly */ -/* on the Univac. */ - -/* - Beta Version 1.1.0, 02-MAR-1989 (HAN) */ - -/* The variable LIGHTYEAR was changed to LTYEAR in order to */ -/* comply with the ANSI Fortran Standard six character */ -/* variable name length restriction. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* 1.0d0 divided by the sin of 1 arc second */ - - -/* Angular Conversions: */ - -/* (1) Degrees/Radians */ -/* (2) Degrees/Degrees */ -/* (3) Degrees/ARCMINUTES */ -/* (4) Degrees/ARCSECONDS */ - -/* () Degrees/HOURANGLE */ -/* () Degrees/MINUTEANGLE */ -/* () Degrees/SECONDANGLE */ - - -/* DATA CNVRTN (ANG + 1) / DPR() / */ - -/* This value will be loaded using the SPICELIB function DPR() */ -/* on the first execution of this routine. */ - - -/* Distance Conversions ( 5 through 17 ) */ - -/* ( 5) Meters/Meter */ -/* ( 6) Meters/Km */ -/* ( 7) Meters/Cm */ -/* ( 8) Meters/mm */ -/* ( 9) Meters/Lightsecs */ -/* (10) Meters/AU */ - - -/* Distance Conversions */ - -/* (+ 7 ) Meters/Foot */ -/* (+ 8 ) Meters/inch */ -/* (+ 9 ) Meters/Statute Mile */ -/* (+ 10) Meters/Nautical Mile */ -/* (+ 11) Meters/Yard */ - - -/* Distance Conversions */ - -/* (+ 12) Meters/LightYear */ -/* (+ 13) Meters/Parsec */ - - -/* Time Conversions */ - -/* (+ 1 ) seconds / second */ -/* (+ 2 ) seconds / minute */ -/* (+ 3 ) seconds / hour */ -/* (+ 4 ) seconds / day */ -/* (+ 5 ) Seconds / Julian year */ -/* (+ 6 ) Seconds / Tropical year */ -/* (+ 7 ) Seconds / year --- same as Julian year */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("CONVRT", (ftnlen)6); - if (first) { - cnvrtn[0] = dpr_(); - first = FALSE_; - } - ucase_(in, inu, in_len, (ftnlen)16); - ucase_(out, outu, out_len, (ftnlen)16); - i__ = isrchc_(inu, &c__27, units, (ftnlen)16, (ftnlen)16); - j = isrchc_(outu, &c__27, units, (ftnlen)16, (ftnlen)16); - if (i__ == 0 || j == 0) { - if (i__ == 0 && j == 0) { -/* Writing concatenation */ - i__1[0] = 32, a__1[0] = "CONVRT: Neither the input units "; - i__1[1] = 16, a__1[1] = inu; - i__1[2] = 21, a__1[2] = "nor the output units "; - i__1[3] = 16, a__1[3] = outu; - i__1[4] = 16, a__1[4] = "were recognized."; - s_cat(ch__1, a__1, i__1, &c__5, (ftnlen)101); - setmsg_(ch__1, (ftnlen)101); - sigerr_("SPICE(UNITSNOTREC)", (ftnlen)18); - chkout_("CONVRT", (ftnlen)6); - return 0; - } else if (i__ == 0) { -/* Writing concatenation */ - i__2[0] = 20, a__2[0] = "CONVRT: Input units "; - i__2[1] = 16, a__2[1] = inu; - i__2[2] = 20, a__2[2] = " were not recognized"; - s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)56); - setmsg_(ch__2, (ftnlen)56); - sigerr_("SPICE(UNITSNOTREC)", (ftnlen)18); - chkout_("CONVRT", (ftnlen)6); - return 0; - } else if (j == 0) { -/* Writing concatenation */ - i__2[0] = 21, a__2[0] = "CONVRT: Output units "; - i__2[1] = 16, a__2[1] = outu; - i__2[2] = 20, a__2[2] = " were not recognized"; - s_cat(ch__3, a__2, i__2, &c__3, (ftnlen)57); - setmsg_(ch__3, (ftnlen)57); - sigerr_("SPICE(UNITSNOTREC)", (ftnlen)18); - chkout_("CONVRT", (ftnlen)6); - return 0; - } - } - if (s_cmp(type__ + (((i__3 = i__ - 1) < 27 && 0 <= i__3 ? i__3 : s_rnge( - "type", i__3, "convrt_", (ftnlen)514)) << 3), type__ + (((i__4 = - j - 1) < 27 && 0 <= i__4 ? i__4 : s_rnge("type", i__4, "convrt_", - (ftnlen)514)) << 3), (ftnlen)8, (ftnlen)8) != 0) { -/* Writing concatenation */ - i__5[0] = 58, a__3[0] = "CONVRT: Incompatible units. You are attempt" - "ing to convert "; - i__5[1] = 16, a__3[1] = inu; - i__5[2] = 6, a__3[2] = "type: "; - i__5[3] = 8, a__3[3] = type__ + (((i__3 = i__ - 1) < 27 && 0 <= i__3 ? - i__3 : s_rnge("type", i__3, "convrt_", (ftnlen)516)) << 3); - i__5[4] = 4, a__3[4] = " to "; - i__5[5] = 16, a__3[5] = outu; - i__5[6] = 6, a__3[6] = "type: "; - i__5[7] = 8, a__3[7] = type__ + (((i__4 = j - 1) < 27 && 0 <= i__4 ? - i__4 : s_rnge("type", i__4, "convrt_", (ftnlen)516)) << 3); - i__5[8] = 1, a__3[8] = "."; - s_cat(ch__4, a__3, i__5, &c__9, (ftnlen)123); - setmsg_(ch__4, (ftnlen)123); - sigerr_("SPICE(INCOMPATIBLEUNITS)", (ftnlen)24); - chkout_("CONVRT", (ftnlen)6); - return 0; - } - temp = *x * cnvrtn[(i__3 = i__ - 1) < 27 && 0 <= i__3 ? i__3 : s_rnge( - "cnvrtn", i__3, "convrt_", (ftnlen)532)]; - *y = temp / cnvrtn[(i__3 = j - 1) < 27 && 0 <= i__3 ? i__3 : s_rnge("cnv" - "rtn", i__3, "convrt_", (ftnlen)533)]; - chkout_("CONVRT", (ftnlen)6); - return 0; -} /* convrt_ */ - diff --git a/ext/spice/src/cspice/convrt_c.c b/ext/spice/src/cspice/convrt_c.c deleted file mode 100644 index ebf49f773c..0000000000 --- a/ext/spice/src/cspice/convrt_c.c +++ /dev/null @@ -1,248 +0,0 @@ -/* - --Procedure convrt_c ( Convert Units ) - --Abstract - - Take a measurement X, the units associated with - X, and units to which X should be converted; return Y --- - the value of the measurement in the output units. - --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 - - CONVERSION, UNITS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void convrt_c ( SpiceDouble x, - ConstSpiceChar * in, - ConstSpiceChar * out, - SpiceDouble * y ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------- - x I Number representing a measurement in some units. - in I The units in which x is measured. - out I Desired units for the measurement. - y O The measurment in the desired units. - --Detailed_Input - - x is a number representing a measurement in the units - specified by in. - - in represents the units associated with a measurement x. - Acceptable units are: - - Angles: "RADIANS" - "DEGREES" - "ARCMINUTES" - "ARCSECONDS" - "HOURANGLE" - "MINUTEANGLE" - "SECONDANGLE" - - Metric Distances: "METERS" - "KM" - "CM" - "MM" - - English Distances: "FEET" - "INCHES" - "YARDS" - "STATUTE_MILES" - "NAUTICAL_MILES" - - Astrometric Distances: "AU" - "PARSECS" - "LIGHTSECS" - "LIGHTYEARS" julian lightyears - - Time: "SECONDS" - "MINUTES" - "HOURS" - "DAYS" - "JULIAN_YEARS" - "TROPICAL_YEARS" - "YEARS" (same as julian years) - - - The case of the string in is not significant. - - - out represents the units desired for the measurement x. - See the description of in. - - The case of the string out is not significant. - - --Detailed_Output - - y is the input measurement converted to the desired units. - - --Parameters - - None. - --Exceptions - - 1) If the input units, output units, or both input and - output units are not recognized, the error - SPICE(UNITSNOTREC) is signaled. - - 2) If the units being converted between are incompatible, the - error SPICE(INCOMPATIBLEUNITS) is signaled. - --Particulars - - This routine converts a measurement x given in units specified by - in to the equivalent value y in units specified by out. - - If a unit is not recognized, an error message is produced that - indicates which one was not recognized. - - If input and output units are incompatible (for example angle - and distance units) and error message will be produced stating - the requested units and associated types. - --Examples - - To convert 1 meter to statute miles and feet you could make the - calls - - - convrt_c ( 1.0, "meters", "statute_miles", &miles ); - convrt_c ( miles, "statute_miles", "feet", &feet ); - - or - - convrt_c ( 1.0, "METERS", "STATUTE_MILES", &miles ); - convrt_c ( 1.0, "METERS", "FEET", &feet ); - - --Restrictions - - You should make sure that your units are appropriate for the - measurement. This routine does not do any checking for over- - flow. Something like - - convrt_c ( 10.0e302, "LIGHTYEARS", "MM", &y ); - - will cause a floating point overflow. - - Some of the units are not "defined" quantities. In such a case - a best estimate is provided as of the date of the current version - of this routine. Those estimated quantities are: - - 1 AU --- the astronomical unit is taken from the JPL - ephemeris DE125. It is believed to be accurate to - about 40 meters. - - The tropical year is the time from equinox to equinox. This - varies slightly with time. - - 1 PARSEC --- is dependent upon the value of the astronomical - unit. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.M. Owen (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 17-MAY-1999 (NJB)(CAC)(HAN)(WMO)(WLT)(IMU) - --Index_Entries - - convert units - --& -*/ - -{ /* Begin convrt_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "convrt_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "convrt_c", in ); - CHKFSTR ( CHK_STANDARD, "convrt_c", out ); - - - /* - Call the f2c'd Fortran routine. - */ - - convrt_ ( ( doublereal * ) &x, - ( char * ) in, - ( char * ) out, - ( doublereal * ) y, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(out) ); - - - chkout_c ( "convrt_c" ); - -} /* End convrt_c */ - diff --git a/ext/spice/src/cspice/copy_c.c b/ext/spice/src/cspice/copy_c.c deleted file mode 100644 index 9c7590b0a9..0000000000 --- a/ext/spice/src/cspice/copy_c.c +++ /dev/null @@ -1,272 +0,0 @@ -/* - --Procedure copy_c ( Copy a CSPICE cell ) - --Abstract - - Copy the contents of a SpiceCell of any data type to another - cell of the same type. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void copy_c ( SpiceCell * cell, - SpiceCell * copy ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - cell I Cell to be copied. - copy O New cell. - --Detailed_Input - - cell is a cell of character, double precision, or - integer data type. - - --Detailed_Output - - copy is a cell which contains the same elements as the - input cell, in the same order. - --Parameters - - None. - --Exceptions - - 1) If the cell arguments don't have matching data types, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the output cell in not large enough to hold the elements - of the input cell, the error SPICE(CELLTOOSMALL) is signaled. - - 3) If the cell arguments have character type and the length of the - elements of the output cell is less than the length of the - elements of the input cell, the error SPICE(INSUFFLEN) is - signaled. - --Files - - None. - --Particulars - - This routine is used primarily to manipulate working cells, since - many routines that use cells (binary set routines, for instance) do - not allow cells to be combined or manipulated in place. - --Examples - - In the following example, copy_c is used to copy the result - of the union of two character CSICE sets from a temporary - working set back into the one of the original set. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the cell names with string length LNSIZE and maximum - number of strings SIZE. - ./ - SPICECHAR_CELL ( bodies, SIZE, LNSIZE ); - SPICECHAR_CELL ( planets, SIZE, LNSIZE ); - SPICECHAR_CELL ( temp, SIZE, LNSIZE ); - . - . - . - union_c ( &bodies, &planets, &temp ); - copy_c ( &temp, &bodies ); - - - If the size of the temporary cell is greater than the size - of the original set, the function failed_c should be checked to be - sure that no overflow occurred. If bodies is at least as - large as temp, no such check is necessary. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - copy a character cell - --& -*/ - -{ /* Begin copy_c */ - - - /* - Local variables - */ - SpiceChar * fCell[2]; - - SpiceInt fLen [2]; - SpiceInt i; - - - /* - Standard SPICE error handling. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "copy_c" ); - - - /* - Make sure data types match. - */ - CELLMATCH2 ( CHK_STANDARD, "copy_c", cell, copy ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT2 ( cell, copy ); - - - /* - Call the copy routine appropriate for the data type of the cells. - */ - if ( cell->dtype == SPICE_CHR ) - { - - /* - Construct Fortran-style sets suitable for passing to copyc_. - */ - C2F_MAP_CELL2 ( "copy_c", - cell, fCell, fLen, - copy, fCell+1, fLen+1 ); - - if ( failed_c() ) - { - chkout_c ( "copy_c" ); - return; - } - - copyc_ ( (char * ) fCell[0], - (char * ) fCell[1], - (ftnlen ) fLen[0], - (ftnlen ) fLen[1] ); - - if ( !failed_c() ) - { - /* - Map the copy back to a C style cell. - */ - F2C_MAP_CELL ( fCell[1], fLen[1], copy ); - } - - /* - We're done with the dynamically allocated Fortran-style arrays. - */ - for ( i = 0; i < 2; i++ ) - { - free ( fCell[i] ); - } - } - - else if ( cell->dtype == SPICE_DP ) - { - copyd_ ( (doublereal * ) (cell->base), - (doublereal * ) (copy->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, copy ); - } - - } - - else if ( cell->dtype == SPICE_INT ) - { - copyi_ ( (integer * ) (cell->base), - (integer * ) (copy->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, copy ); - } - - } - - else - { - setmsg_c ( "Source cell contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (cell->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "copy_c" ); - return; - } - - chkout_c ( "copy_c" ); - -} /* End copy_c */ diff --git a/ext/spice/src/cspice/copyc.c b/ext/spice/src/cspice/copyc.c deleted file mode 100644 index 408f95d2b8..0000000000 --- a/ext/spice/src/cspice/copyc.c +++ /dev/null @@ -1,263 +0,0 @@ -/* copyc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure COPYC ( Copy a character cell ) */ -/* Subroutine */ int copyc_(char *cell, char *copy, ftnlen cell_len, ftnlen - copy_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - integer card, size, i__; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer moved; - extern integer sizec_(char *, ftnlen); - logical trunc; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - extern integer lastpc_(char *, ftnlen); - integer reqlen; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Copy the contents of a character cell to another cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Cell to be copied. */ -/* COPY O New cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* COPY is a cell which contains the same elements as the */ -/* input cell, in the same order. If the size (maximum */ -/* cardinality) of the output cell is smaller than */ -/* the cardinality of the input cell, then only as many */ -/* items as will fit in the output cell are copied, */ -/* and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The copy routines (COPYC, COPYD, and COPYI) are used primarily */ -/* to manipulate working cells, since many routines that use cells */ -/* (binary set routines, for instance) do not allow cells to be */ -/* combined or manipulated in place. */ - -/* $ Examples */ - -/* In the following example, COPYC is used to copy the result */ -/* of the union of two sets (ordered cells) from a temporary */ -/* working set back into the one of the original set. */ - -/* CALL UNIONC ( BODIES, PLANETS, TEMP ) */ -/* CALL COPYC ( TEMP, BODIES ) */ - -/* If the size of the temporary cell is greater than the size */ -/* of the original set, the function FAILED should be checked to be */ -/* sure that no overflow occurred. If BODIES is at least as */ -/* large as TEMP, no such check is necessary. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the output cell in not large enough to hold the elements */ -/* of the input cell, the error SPICE(CELLTOOSMALL) is signalled. */ - -/* 2) If length of the elements of the output cell is less than the */ -/* length of the elements of the input cell, the error */ -/* SPICE(ELEMENTSTOOSHORT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* copy a character cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 09-JAN-1989 (NJB) */ - -/* Error signalled if output set elements are not long enough. */ -/* Length must be at least max of lengths of input elements. */ -/* Also, calling protocol for EXCESS has been changed. And, */ -/* elements LBCELL through -2 of control area are now copied to */ -/* the output cell. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("COPYC", (ftnlen)5); - -/* We need the cardinality of the input cell, and the size of */ -/* the output cell. */ - - card = cardc_(cell, cell_len); - size = sizec_(copy, copy_len); - -/* Start moving the elements, one by one. Stop if the output */ -/* cell fills up. Copy the control area too, except for the */ -/* the size and cardinality values. Truncation indicator */ -/* starts at .FALSE. */ - - trunc = FALSE_; - reqlen = 0; - moved = min(card,size); - i__1 = moved; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(copy + (i__ + 5) * copy_len, cell + (i__ + 5) * cell_len, - copy_len, cell_len); - -/* Test for truncation: */ - - if (s_cmp(copy + (i__ + 5) * copy_len, cell + (i__ + 5) * cell_len, - copy_len, cell_len) != 0) { - trunc = TRUE_; -/* Computing MAX */ - i__2 = reqlen, i__3 = lastpc_(cell + (i__ + 5) * cell_len, - cell_len); - reqlen = max(i__2,i__3); - } - } - for (i__ = -5; i__ <= -2; ++i__) { - s_copy(copy + (i__ + 5) * copy_len, cell + (i__ + 5) * cell_len, - copy_len, cell_len); - -/* Test for truncation: */ - - if (s_cmp(copy + (i__ + 5) * copy_len, cell + (i__ + 5) * cell_len, - copy_len, cell_len) != 0) { - trunc = TRUE_; -/* Computing MAX */ - i__1 = reqlen, i__2 = lastpc_(cell + (i__ + 5) * cell_len, - cell_len); - reqlen = max(i__1,i__2); - } - } - -/* Set the cardinality of the output cell. */ - - scardc_(&moved, copy, copy_len); - -/* We've got an error if the output cell was too small. */ - - if (size < card) { - i__1 = card - size; - excess_(&i__1, "cell", (ftnlen)4); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - chkout_("COPYC", (ftnlen)5); - return 0; - } - -/* We also have an error if the output set elements are not long */ -/* enough. */ - - if (trunc) { - setmsg_("Length of output cell is #. Length required to contain res" - "ult is #.", (ftnlen)68); - i__1 = i_len(copy, copy_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &reqlen, (ftnlen)1); - sigerr_("SPICE(ELEMENTSTOOSHORT)", (ftnlen)23); - chkout_("COPYC", (ftnlen)5); - return 0; - } - chkout_("COPYC", (ftnlen)5); - return 0; -} /* copyc_ */ - diff --git a/ext/spice/src/cspice/copyd.c b/ext/spice/src/cspice/copyd.c deleted file mode 100644 index 3962a35bdd..0000000000 --- a/ext/spice/src/cspice/copyd.c +++ /dev/null @@ -1,199 +0,0 @@ -/* copyd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure COPYD ( Copy a double precision cell ) */ -/* Subroutine */ int copyd_(doublereal *cell, doublereal *copy) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, size, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer moved; - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), excess_( - integer *, char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Copy the contents of a double precision cell to another cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Cell to be copied. */ -/* COPY O New cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* COPY is a cell which contains the same elements as the */ -/* input cell, in the same order. If the size (maximum */ -/* cardinality) of the output cell is smaller than */ -/* the cardinality of the input cell, then only as many */ -/* items as will fit in the output cell are copied, */ -/* and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The copy routines (COPYC, COPYD, and COPYI) are used primarily */ -/* to manipulate working cells, since many routines that use cells */ -/* (binary set routines, for instance) do not allow cells to be */ -/* combined or manipulated in place. */ - -/* $ Examples */ - -/* In the following example, COPYC is used to copy the result */ -/* of the union of two sets (ordered cells) from a temporary */ -/* working set back into the one of the original set. */ - -/* CALL UNIONC ( BODIES, PLANETS, TEMP ) */ -/* CALL COPYC ( TEMP, BODIES ) */ - -/* If the size of the temporary cell is greater than the size */ -/* of the original set, the function FAILED should be checked to be */ -/* sure that no overflow occurred. If BODIES is at least as */ -/* large as TEMP, no such check is necessary. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the output cell in not large enough to hold the elements */ -/* of the input cell, the error SPICE(CELLTOOSMALL) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* copy a d.p. cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 09-JAN-1989 (NJB) */ - -/* Calling protocol for EXCESS has been changed. Call to SETMSG */ -/* has been removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("COPYD", (ftnlen)5); - -/* We need the cardinality of the input cell, and the size of */ -/* the output cell. */ - - card = cardd_(cell); - size = sized_(copy); - -/* Start moving the elements, one by one. Stop if the output */ -/* cell fills up. */ - - moved = min(card,size); - i__1 = moved; - for (i__ = 1; i__ <= i__1; ++i__) { - copy[i__ + 5] = cell[i__ + 5]; - } - -/* Set the cardinality of the output cell. Report any excess. */ - - scardd_(&moved, copy); - if (card > size) { - i__1 = card - size; - excess_(&i__1, "cell", (ftnlen)4); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - chkout_("COPYD", (ftnlen)5); - return 0; - } - chkout_("COPYD", (ftnlen)5); - return 0; -} /* copyd_ */ - diff --git a/ext/spice/src/cspice/copyi.c b/ext/spice/src/cspice/copyi.c deleted file mode 100644 index 9e3b887ffe..0000000000 --- a/ext/spice/src/cspice/copyi.c +++ /dev/null @@ -1,200 +0,0 @@ -/* copyi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure COPYI ( Copy an integer cell ) */ -/* Subroutine */ int copyi_(integer *cell, integer *copy) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, size, i__; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer moved; - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), excess_( - integer *, char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Copy the contents of an integer cell to another cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Cell to be copied. */ -/* COPY O New cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* COPY is a cell which contains the same elements as the */ -/* input cell, in the same order. If the size (maximum */ -/* cardinality) of the output cell is smaller than */ -/* the cardinality of the input cell, then only as many */ -/* items as will fit in the output cell are copied, */ -/* and an error is signalled. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The copy routines (COPYC, COPYD, and COPYI) are used primarily */ -/* to manipulate working cells, since many routines that use cells */ -/* (binary set routines, for instance) do not allow cells to be */ -/* combined or manipulated in place. */ - -/* $ Examples */ - -/* In the following example, COPYC is used to copy the result */ -/* of the union of two sets (ordered cells) from a temporary */ -/* working set back into the one of the original set. */ - -/* CALL UNIONC ( BODIES, PLANETS, TEMP ) */ -/* CALL COPYC ( TEMP, BODIES ) */ - -/* If the size of the temporary cell is greater than the size */ -/* of the original set, the function FAILED should be checked to be */ -/* sure that no overflow occurred. If BODIES is at least as */ -/* large as TEMP, no such check is necessary. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the output cell in not large enough to hold the elements */ -/* of the input cell, the error SPICE(CELLTOOSMALL) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* copy an integer cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 09-JAN-1989 (NJB) */ - -/* Calling protocol for EXCESS has been changed. Call to SETMSG */ -/* has been removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("COPYI", (ftnlen)5); - -/* We need the cardinality of the input cell, and the size of */ -/* the output cell. */ - - card = cardi_(cell); - size = sizei_(copy); - -/* Start moving the elements, one by one. Stop if the output */ -/* cell fills up. */ - - moved = min(card,size); - i__1 = moved; - for (i__ = 1; i__ <= i__1; ++i__) { - copy[i__ + 5] = cell[i__ + 5]; - } - -/* Set the cardinality of the output cell. Report any excess. */ - - scardi_(&moved, copy); - if (card > size) { - i__1 = card - size; - excess_(&i__1, "cell", (ftnlen)4); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - chkout_("COPYI", (ftnlen)5); - return 0; - } - chkout_("COPYI", (ftnlen)5); - return 0; -} /* copyi_ */ - diff --git a/ext/spice/src/cspice/countc.c b/ext/spice/src/cspice/countc.c deleted file mode 100644 index a64578ba5f..0000000000 --- a/ext/spice/src/cspice/countc.c +++ /dev/null @@ -1,319 +0,0 @@ -/* countc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure COUNTC ( Count characters in a text file ) */ -integer countc_(integer *unit, integer *bline, integer *eline, char *line, - ftnlen line_len) -{ - /* System generated locals */ - integer ret_val; - cilist ci__1; - alist al__1; - - /* Builtin functions */ - integer f_rew(alist *), s_rsfe(cilist *), do_fio(integer *, char *, - ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical done; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer chars, linect; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), astrip_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Count the characters in a group of lines in a text file. */ - -/* $ 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 */ - -/* CHARACTERS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit connected to text file. */ -/* BLINE I Beginning line number. */ -/* ELINE I Ending line number. */ -/* LINE I,O Workspace. */ - -/* COUNTC returns the number of characters. */ - -/* $ Detailed_Input */ - -/* UNIT is a logical unit that has been connected to a */ -/* text file by the calling program. Use the routine */ -/* TXTOPR to open the file for read access and get its */ -/* logical unit. A text file is a formatted, */ -/* sequential file that contains only printable */ -/* characters: ASCII 32-126. */ - -/* BLINE, */ -/* ELINE are line numbers in the text file. BLINE is */ -/* the line where the count will begin, and ELINE */ -/* is the line where the count will end. The */ -/* number of characters in the beginning and ending */ -/* lines are included in the total count. */ - -/* By convention, line 1 is the first line of the file. */ - -/* LINE on input, is an arbitrary character string whose */ -/* contents are ignored. LINE is used to read lines */ -/* from the file connected to UNIT; its function */ -/* is to determine the maximum length of the lines */ -/* that can be read from the file. Lines longer */ -/* than the declared length of LINE are truncated */ -/* as they are read. */ - -/* $ Detailed_Output */ - -/* LINE on output, is undefined. */ - -/* The function, COUNTC, returns the number of characters in the */ -/* group of lines in the file beginning with BLINE and ending with */ -/* ELINE. Trailing blanks on a line are not included in the count. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while reading from the input file, */ -/* the error SPICE(FILEREADFAILED) is signalled. */ - -/* 2) If a non-printing ASCII character is encountered during */ -/* the count, the error SPICE(INVALIDTEXT) is signalled. */ - -/* 3) If BLINE is greater than ELINE or if the file does not */ -/* contain both of this lines, the error SPICE(CANNOTFINDGRP) */ -/* is signalled. */ - -/* $ Files */ - -/* See argument UNIT. COUNTC rewinds the text file connected to */ -/* UNIT and then steps through the file. The next read statement */ -/* after calling COUNTC would return the line after ELINE. */ - -/* $ Particulars */ - -/* This routine counts characters in a group of lines in a text */ -/* file. Using COUNTC, you can determine in advance how much space */ -/* is required to store those characters. */ - -/* $ Examples */ - -/* The following code fragment opens an existing text file for */ -/* read access and counts the characters that it contains in */ -/* the first five lines. We'll assume that the longest line */ -/* in the file is 80 characters. */ - -/* INTEGER COUNTC */ -/* INTEGER UNIT */ -/* INTEGER N */ -/* CHARACTER*(80) LINE */ - -/* CALL TXTOPR ( 'DATA.TXT', UNIT ) */ - -/* N = COUNTC ( UNIT, 1, 5, LINE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* count characters in a text file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("COUNTC", (ftnlen)6); - ret_val = 0; - } - -/* First, see if the line numbers make sense. */ - - if (*bline > *eline || *bline <= 0) { - setmsg_("The line numbers do not make sense: BLINE = # and ELINE =" - " #.", (ftnlen)62); - errint_("#", bline, (ftnlen)1); - errint_("#", eline, (ftnlen)1); - sigerr_("SPICE(CANNOTFINDGRP)", (ftnlen)20); - chkout_("COUNTC", (ftnlen)6); - return ret_val; - } - -/* Read through the file, line by line, beginning with the first */ -/* line in the file, checking for I/O errors, and counting */ -/* characters in the lines between and including BLINE and ELINE. */ - - al__1.aerr = 0; - al__1.aunit = *unit; - f_rew(&al__1); - linect = 0; - chars = 0; - done = FALSE_; - while(! done) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, line_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - -/* An end-of-file condition is indicated by a negative value */ -/* for IOSTAT. Any other non-zero value indicates some other */ -/* error. If IOSTAT is zero, the read was successful. */ - - if (iostat > 0) { - setmsg_("Error reading text file named FILENAME.The value of IOS" - "TAT is #.", (ftnlen)64); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FILENAME", unit, (ftnlen)8); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("COUNTC", (ftnlen)6); - return ret_val; - } else if (iostat < 0) { - setmsg_("Reached end of file unexpectedly at line # in file FILE" - ". BLINE = # and ELINE = #.", (ftnlen)82); - errint_("#", &linect, (ftnlen)1); - errint_("#", bline, (ftnlen)1); - errint_("#", eline, (ftnlen)1); - errfnm_("FILE", unit, (ftnlen)4); - sigerr_("SPICE(CANNOTFINDGRP)", (ftnlen)20); - chkout_("COUNTC", (ftnlen)6); - return ret_val; - } else { - -/* We've read a line successfully, so add it to the line count. */ -/* If this line is in the group delimited by BLINE and ELINE, */ -/* count the characters in it, and if this line is ELINE, we're */ -/* done. */ - - ++linect; - if (linect >= *bline && linect <= *eline) { - -/* Add the number of characters in this line to the count. */ -/* If LINE is blank, LASTNB will return 0 which is just */ -/* what we want. */ - - chars += lastnb_(line, line_len); - -/* Remove the printable characters from the line. If */ -/* any characters remain, signal an error. */ - - astrip_(line, " ", "~", line, line_len, (ftnlen)1, (ftnlen)1, - line_len); - if (s_cmp(line, " ", line_len, (ftnlen)1) != 0) { - setmsg_("Non-printing ASCII characters were found when c" - "ounting characters on line number # in file FILE" - "NAME.", (ftnlen)100); - errint_("#", &linect, (ftnlen)1); - errfnm_("FILENAME", unit, (ftnlen)8); - sigerr_("SPICE(INVALIDTEXT)", (ftnlen)18); - chkout_("COUNTC", (ftnlen)6); - return ret_val; - } - } - if (linect == *eline) { - done = TRUE_; - } - } - } - -/* Assign the final character count. */ - - ret_val = chars; - chkout_("COUNTC", (ftnlen)6); - return ret_val; -} /* countc_ */ - diff --git a/ext/spice/src/cspice/cpos.c b/ext/spice/src/cspice/cpos.c deleted file mode 100644 index e9544cb46a..0000000000 --- a/ext/spice/src/cspice/cpos.c +++ /dev/null @@ -1,226 +0,0 @@ -/* cpos.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CPOS ( Character position ) */ -integer cpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen - chars_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b; - logical found; - integer lenstr; - -/* $ Abstract */ - -/* Find the first occurrence in a string of a character belonging */ -/* to a collection of characters, starting at a specified location, */ -/* searching forward. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* CHARACTER */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I Any character string. */ -/* CHARS I A collection of characters. */ -/* START I Position to begin looking for one of CHARS */ - -/* The function returns the index of the first character of STR */ -/* at or following index START that is in the collection CHARS. */ - -/* $ Detailed_Input */ - -/* STR is any character string. */ - -/* CHARS is a character string containing a collection */ -/* of characters. Spaces in CHARS are significant. */ - -/* START is the position in STR to begin looking for one of */ -/* the characters in CHARS. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the first character of STR */ -/* (at or following index START) that is one of the characters in */ -/* the string CHARS. If none of the characters is found, the */ -/* function returns zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If START is less than 1, the search begins at the first */ -/* character of the string. */ - -/* 2) If START is greater than the length of the string, CPOS */ -/* returns zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* CPOS is case sensitive. */ - -/* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */ -/* POSR, CPOSR, NCPOSR) is described in the Required Reading. */ - -/* Those familiar with the True BASIC language should note that */ -/* these functions are equivalent to the True BASIC intrinsic */ -/* functions with the same names. */ - -/* $ Examples */ - -/* Let STRING = 'BOB, JOHN, TED, AND MARTIN....' */ -/* 123456789012345678901234567890 */ - -/* Normal (sequential) searching */ -/* ----------------------------- */ - -/* CPOS( STRING, ' ,', 1 ) = 4 */ - -/* CPOS( STRING, ' ,', 5 ) = 5 */ - -/* CPOS( STRING, ' ,', 6 ) = 10 */ - -/* CPOS( STRING, ' ,', 11 ) = 11 */ - -/* CPOS( STRING, ' ,', 12 ) = 15 */ - -/* CPOS( STRING, ' ,', 16 ) = 16 */ - -/* CPOS( STRING, ' ,', 17 ) = 20 */ - -/* CPOS( STRING, ' ,', 21 ) = 0 */ - - -/* START out of bounds */ -/* ------------------- */ - -/* CPOS( STRING, ' ,', -113 ) = 4 */ - -/* CPOS( STRING, ' ,', -1 ) = 4 */ - -/* CPOS( STRING, ' ,', 31 ) = 0 */ - -/* CPOS( STRING, ' ,', 1231 ) = 0 */ - - -/* Order within CHARS */ -/* ------------------ */ - -/* CPOS( STRING, ',. ', 22 ) = 27 */ - -/* CPOS( STRING, ' ,.', 22 ) = 27 */ - -/* CPOS( STRING, ', .', 22 ) = 27 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */ - -/* The Required Reading file POSITION was renamed to SCANNING. */ -/* This header was updated to reflect the change. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* forward search for position of character */ - -/* -& */ - -/* Local variables */ - - lenstr = i_len(str, str_len); - b = max(1,*start); - found = FALSE_; - ret_val = 0; - while(! found) { - if (b > lenstr) { - return ret_val; - } else if (i_indx(chars, str + (b - 1), chars_len, (ftnlen)1) != 0) { - ret_val = b; - return ret_val; - } else { - ++b; - } - } - return ret_val; -} /* cpos_ */ - diff --git a/ext/spice/src/cspice/cpos_c.c b/ext/spice/src/cspice/cpos_c.c deleted file mode 100644 index 5786ab7818..0000000000 --- a/ext/spice/src/cspice/cpos_c.c +++ /dev/null @@ -1,226 +0,0 @@ -/* - --Procedure cpos_c ( Character position ) - --Abstract - - Find the first occurrence in a string of a character belonging - to a collection of characters, starting at a specified location, - searching forward. - --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 - - SCANNING - --Keywords - - CHARACTER - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - SpiceInt cpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I Any character string. - chars I A collection of characters. - start I Position to begin looking for one of chars. - - The function returns the index of the first character of str - at or following index start that is in the collection chars. - --Detailed_Input - - str is any character string. - - chars is a character string containing a collection - of characters. Spaces in chars are significant, - including trailing blanks. The order in which - characters are listed is not significant. - - start is the position in str to begin looking for one of - the characters in chars. start may range from 0 - to n-1, where n is the number of characters in str. - --Detailed_Output - - The function returns the index of the first character of str (at or - following index start) that is one of the characters in the string - chars. The returned value normally ranges from 0 to n-1, where n is - the number of characters in str. If none of the characters is found, - the function returns -1. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either of - the input string pointers is null. - - 2) If start is less than 0, the search begins at the first - character of the string. - - 3) If start is greater than or equal to the length of the string, - cpos_c returns -1. - - 4) The function returns -1 if either of the input strings is empty. - --Files - - None. - --Particulars - - cpos_c is case sensitive. - - An entire family of related CSPICE routines - - cpos_c - cposr_c - ncpos_c - ncposr_c - pos_c - posr_c - - is described in the Required Reading. - --Examples - - Let string == "BOB, JOHN, TED, AND MARTIN...." - 012345678901234567890123456789 - - - Normal (sequential) searching - ----------------------------- - - cpos_c( string, " ,", 0 ) == 3 - cpos_c( string, " ,", 4 ) == 4 - cpos_c( string, " ,", 5 ) == 9 - cpos_c( string, " ,", 10 ) == 10 - cpos_c( string, " ,", 11 ) == 14 - cpos_c( string, " ,", 15 ) == 15 - cpos_c( string, " ,", 16 ) == 19 - cpos_c( string, " ,", 20 ) == -1 - - - start out of bounds - ------------------- - - cpos_c( string, " ,", -112 ) == 3 - cpos_c( string, " ,", -1 ) == 3 - cpos_c( string, " ,", 1230 ) == -1 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 15-AUG-2002 (NJB) (WLT) - --Index_Entries - - forward search for position of character - --& -*/ - -{ /* Begin cpos_c */ - - - /* - Local variables - */ - SpiceInt fstart; - SpiceInt retval; - - - - /* - Use discovery check-in. - - Check for null pointers. - */ - CHKPTR_VAL ( CHK_DISCOVER, "cpos_c", str, -1 ); - CHKPTR_VAL ( CHK_DISCOVER, "cpos_c", chars, -1 ); - - - /* - Check for empty strings. - */ - if ( ( strlen(str) == 0 ) || ( strlen(chars) == 0 ) ) - { - return ( -1 ); - } - - - /* - The rest can be handled by the f2c'd SPICELIB routine. Adjust - the start index to account for Fortran indexing. - */ - - fstart = start + 1; - - retval = cpos_ ( (char *) str, - (char *) chars, - (integer *) &fstart, - (ftnlen ) strlen(str), - (ftnlen ) strlen(chars) ); - - /* - Adjust the return value to account for C indexing. - */ - return ( retval-1 ); - - -} /* End cpos_c */ diff --git a/ext/spice/src/cspice/cposr.c b/ext/spice/src/cspice/cposr.c deleted file mode 100644 index 64d8e32af2..0000000000 --- a/ext/spice/src/cspice/cposr.c +++ /dev/null @@ -1,234 +0,0 @@ -/* cposr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CPOSR ( Character position, reverse ) */ -integer cposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen - chars_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b; - logical found; - integer lenstr; - -/* $ Abstract */ - -/* Find the first occurrence in a string of a character belonging */ -/* to a collection of characters, starting at a specified location, */ -/* searching in reverse. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* CHARACTER */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I Any character string. */ -/* CHARS I A collection of characters. */ -/* START I Position to begin looking for one of CHARS */ - -/* The function returns the index of the last character of STR */ -/* at or before index START that is in the collection CHARS. */ - -/* $ Detailed_Input */ - -/* STR is any character string. */ - -/* CHARS is a character string containing a collection of */ -/* characters. Spaces in CHARS are significant. */ - -/* START is the position in STR to begin looking for one of the */ -/* characters in CHARS. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the last character of STR (at */ -/* or before index START) that is one of the characters in the */ -/* string CHARS. If none of the characters is found, the function */ -/* returns zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If START is less than 1, CPOSR returns zero. */ - -/* 2) If START is greater than LEN(STRING), the search begins */ -/* at the last character of the string. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* CPOSR is case sensitive. */ - -/* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */ -/* POSR, CPOSR, NCPOSR) is desribed in the Required Reading. */ - -/* Those familiar with the True BASIC language should note that */ -/* these functions are equivalent to the True BASIC intrinsic */ -/* functions with the same name. */ - -/* $ Examples */ - -/* Let STRING = 'BOB, JOHN, TED, AND MARTIN ' */ -/* 123456789012345678901234567890 */ - -/* Normal (sequential) searching: */ -/* ------------------------------ */ - -/* CPOSR( STRING, ' ,', 30 ) = 30 */ - -/* CPOSR( STRING, ' ,', 29 ) = 29 */ - -/* CPOSR( STRING, ' ,', 28 ) = 28 */ - -/* CPOSR( STRING, ' ,', 27 ) = 27 */ - -/* CPOSR( STRING, ' ,', 26 ) = 20 */ - -/* CPOSR( STRING, ' ,', 19 ) = 16 */ - -/* CPOSR( STRING, ' ,', 15 ) = 15 */ - -/* CPOSR( STRING, ' ,', 14 ) = 11 */ - -/* CPOSR( STRING, ' ,', 10 ) = 10 */ - -/* CPOSR( STRING, ' ,', 9 ) = 5 */ - -/* CPOSR( STRING, ' ,', 4 ) = 4 */ - -/* CPOSR( STRING, ' ,', 3 ) = 0 */ - -/* START out of bounds: */ -/* -------------------- */ - -/* CPOSR( STRING, ' ,', 231 ) = 30 */ - -/* CPOSR( STRING, ' ,', 31 ) = 30 */ - -/* CPOSR( STRING, ' ,', 0 ) = 0 */ - -/* CPOSR( STRING, ' ,', -10 ) = 0 */ - - -/* Order within CHARS */ -/* ------------------ */ - -/* CPOSR( STRING, 'JOHN', 23 ) = 18 */ - -/* CPOSR( STRING, 'OHNJ', 23 ) = 18 */ - -/* CPOSR( STRING, 'HNJO', 23 ) = 18 */ - -/* CPOSR( STRING, 'NJOH', 23 ) = 18 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */ - -/* The Required Reading file POSITION was renamed to SCANNING. */ -/* This header was updated to reflect the change. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* backward search for the position of a character */ - -/* -& */ - -/* Local variables */ - - lenstr = i_len(str, str_len); - b = min(lenstr,*start); - found = FALSE_; - ret_val = 0; - while(! found) { - if (b <= 0) { - return ret_val; - } else if (i_indx(chars, str + (b - 1), chars_len, (ftnlen)1) != 0) { - ret_val = b; - return ret_val; - } else { - --b; - } - } - return ret_val; -} /* cposr_ */ - diff --git a/ext/spice/src/cspice/cposr_c.c b/ext/spice/src/cspice/cposr_c.c deleted file mode 100644 index ad7a9f4ed9..0000000000 --- a/ext/spice/src/cspice/cposr_c.c +++ /dev/null @@ -1,230 +0,0 @@ -/* - --Procedure cposr_c ( Character position, reverse ) - --Abstract - - Find the first occurrence in a string of a character belonging - to a collection of characters, starting at a specified location, - searching in reverse. - --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 - - SCANNING - --Keywords - - CHARACTER - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - SpiceInt cposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I Any character string. - chars I A collection of characters. - start I Position to begin looking for one of chars. - - The function returns the index of the last character of str - at or before index start that is in the collection chars. - --Detailed_Input - - str is any character string. - - chars is a character string containing a collection - of characters. Spaces in chars are significant, - including trailing blanks. The order in which - characters are listed is not significant. - - start is the position in str to begin looking for one of - the characters in chars. start may range from 0 - to n-1, where n is the number of characters in str. - --Detailed_Output - - The function returns the index of the last character of str (at or - before index start) that is one of the characters in the string - chars. The returned value normally ranges from 0 to n-1, where n is - the number of characters in str. If none of the characters is found, - the function returns -1. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either of - the input string pointers is null. - - 2) If start is less than 0, cposr_c returns -1. - - 3) If start is greater than or equal to the length of the string, - the search begins at the last character of the string. - - 4) The function returns -1 if either of the input strings is empty. - --Files - - None. - --Particulars - - cposr_c is case sensitive. - - An entire family of related CSPICE routines - - cpos_c - cposr_c - ncpos_c - ncposr_c - pos_c - posr_c - - is described in the Required Reading. - --Examples - - Let string == "BOB, JOHN, TED, AND MARTIN...." - 012345678901234567890123456789 - - - Normal (sequential) searching: - ------------------------------ - - cposr_c( string, ' ,', 29 ) = 29 - cposr_c( string, ' ,', 28 ) = 28 - cposr_c( string, ' ,', 27 ) = 27 - cposr_c( string, ' ,', 26 ) = 26 - cposr_c( string, ' ,', 25 ) = 19 - cposr_c( string, ' ,', 18 ) = 15 - cposr_c( string, ' ,', 14 ) = 14 - cposr_c( string, ' ,', 13 ) = 10 - cposr_c( string, ' ,', 9 ) = 9 - cposr_c( string, ' ,', 8 ) = 4 - cposr_c( string, ' ,', 3 ) = 3 - cposr_c( string, ' ,', 2 ) = -1 - - - start out of bounds: - -------------------- - - cposr_c( string, ' ,', 230 ) = 29 - cposr_c( string, ' ,', 30 ) = 29 - cposr_c( string, ' ,', -1 ) = -1 - cposr_c( string, ' ,', -10 ) = -1 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 27-AUG-2002 (NJB) (WLT) - --Index_Entries - - backward search for position of character - --& -*/ - -{ /* Begin cposr_c */ - - /* - Local variables - */ - SpiceInt fstart; - SpiceInt retval; - - - - /* - Use discovery check-in. - - Check for null pointers. - */ - CHKPTR_VAL ( CHK_DISCOVER, "cposr_c", str, -1 ); - CHKPTR_VAL ( CHK_DISCOVER, "cposr_c", chars, -1 ); - - - /* - Check for empty strings. - */ - if ( ( strlen(str) == 0 ) || ( strlen(chars) == 0 ) ) - { - return ( -1 ); - } - - - /* - The rest can be handled by the f2c'd SPICELIB routine. Adjust - the start index to account for Fortran indexing. - */ - - fstart = start + 1; - - retval = cposr_ ( (char *) str, - (char *) chars, - (integer *) &fstart, - (ftnlen ) strlen(str), - (ftnlen ) strlen(chars) ); - - /* - Adjust the return value to account for C indexing. - */ - return ( retval-1 ); - - -} /* End cposr_c */ diff --git a/ext/spice/src/cspice/cvpool_c.c b/ext/spice/src/cspice/cvpool_c.c deleted file mode 100644 index 031dbc6832..0000000000 --- a/ext/spice/src/cspice/cvpool_c.c +++ /dev/null @@ -1,245 +0,0 @@ -/* - --Procedure cvpool_c ( Check variable in the pool for update) - --Abstract - - Determine whether or not any of the variables that are to be watched - and have a specified agent on their distribution list have been - updated. - --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 - - KERNEL - --Keywords - - SYMBOLS - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void cvpool_c ( ConstSpiceChar * agent, - SpiceBoolean * update ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - agent I Name of the agent to check for notices. - update O SPICETRUE if variables for agent have been updated. - --Detailed_Input - - agent is the name of a function or significant portion of code - that needs to access variables in the kernel pool. - Generally this agent will buffer these variables - internally and fetch them from the kernel pool only when - they are updated. - --Detailed_Output - - update is a logical flag that will be set to SPICETRUE if the - variables in the kernel pool that are required by agent - have been updated since the last call to cvpool_c. - --Parameters - - See function szpool_c. - --Exceptions - - 1) If the string pointer for agent is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the input string haslength zero, the error SPICE(EMPTYSTRING) - will be signaled. - --Files - - None. - --Particulars - - This entry point allows the calling program to determine whether or - not variables associated with with agent have been updated. Making - use of this entry point in conjunction with the entry point swpool_c - (set watch on pool variables) modules can buffer kernel pool - variables they need and fetch values from the kernel pool only when - variables have been updated. - - Note that the call to cvpool_c has a side effect. Two consecutive - calls to cvpool_c with the same agent will always result in the - update being SPICEFALSE on the second call. In other words, if you - imbed the following two lines of code in a piece of code - - cvpool_c ( agent, &update ); - cvpool_c ( agent, &update ); - - and then test update, it will be SPICEFALSE. The idea is that once - a call to cvpool_c has been made, the kernel pool has performed its - duty and notified the calling routine that one of the agent's - variables has been updated. Consequently, on the second call to - cvpool_c above, the kernel pool will not have any updates to report - about any of agent's variables. - - If, on the other hand, you have code such as - - cvpool_c ( agent, &update ); - furnsh_c ( "myfile.dat" ); - cvpool_c ( agent, &update ); - - the value of update will be true if one of the variables associated - with agent was updated by the call to furnsh_c (and that variable - has been specified as one to watch by call a call to swpool_c). - - It should also be noted that any call to cvpool_c that occurs - immediately after a call to swpool_c will result in update being - returned as SPICETRUE In other words, code such as shown below, - will always result in the value of UPDATE as being returned - SPICETRUE: - - swpool_c ( agent, nnames, namelen, names ); - cvpool_c ( agent, &update ); - - See the header for swpool_c for a full discussion of this - feature. - --Examples - - Suppose that you have an application subroutine, MYTASK, that - needs to access a large data set in the kernel pool. If this - data could be kept in local storage and kernel pool queries - performed only when the data in the kernel pool has been - updated, the routine can perform much more efficiently. - - The code fragment below illustrates how you might make use of this - feature. - - #include "SpiceUsr.h" - . - . - . - /. - On the first call to this routine establish those variables - that we will want to read from the kernel pool only when - new values have been assigned. - ./ - if ( first ) - { - first = SPICEFALSE; - swpool_c ( "MYTASK", nnames, namelen, names ); - } - - /. - If any of the variables has been updated, fetch them from the - kernel pool. - ./ - - cvpool_c ( "MYTASK", &update ); - - if ( update ) - { - for ( i = 0; i < NVAR; i++ ) - { - gdpool_c( MYTASK_VAR[i], 1, NMAX, n[i], val[i], &found[i] ); - } - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.0.0, 05-JUN-1999 (NJB) (WLT) - --Index_Entries - - Check the kernel pool for updated variables - --& -*/ - -{ /* Begin cvpool_c */ - - - /* - Local variables - */ - logical upd; - - - /* - Use discovery check-in. - */ - - /* - Check the input agent name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "cvpool_c", agent ); - - - /* - Call the f2c'd routine. - */ - cvpool_ ( ( char * ) agent, - ( logical * ) &upd, - ( ftnlen ) strlen(agent) ); - - - /* - Assign the SpiceBoolean output argument. - */ - - *update = upd; - - -} /* End cvpool_c */ - diff --git a/ext/spice/src/cspice/cyacip.c b/ext/spice/src/cspice/cyacip.c deleted file mode 100644 index 72cfd0a93d..0000000000 --- a/ext/spice/src/cspice/cyacip.c +++ /dev/null @@ -1,286 +0,0 @@ -/* cyacip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYACIP ( Cycle the elements of a character array ) */ -/* Subroutine */ int cyacip_(integer *nelt, char *dir, integer *ncycle, char * - array, ftnlen dir_len, ftnlen array_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char last[1], temp[1]; - integer c__, g, i__, j, k, l, m; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer nbwid_(char *, integer *, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - integer widest; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer outlen; - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the elements of a character array forward or backward */ -/* in place. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NELT I Number of elements. */ -/* DIR I Direction to cycle: 'F' or 'B'. */ -/* NCYCLE I Number of times to cycle. */ -/* ARRAY I-O Array to be cycled/cycled array. */ - -/* $ Detailed_Input */ - -/* NELT is the number of elements in the input array. */ - -/* DIR is the direction in which the elements in the */ -/* array are to be cycled. */ - -/* 'F' or 'f' to cycle forward. */ -/* 'B' or 'b' to cycle backward. */ - -/* NCYCLE is the number of times the elements in the array */ -/* are to be cycled. */ - -/* ARRAY is the array to be cycled. */ - - -/* $ Detailed_Output */ - -/* ARRAY is the input array after it has been cycled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of DIR is not recognized, the error */ -/* SPICE(INVALIDDIRECTION) is signaled. */ - -/* 2) If NELT is less than 1, the output array is not modified. */ - -/* 3) If NCYCLE is negative, the array is cycled NCYCLE times in */ -/* the opposite direction of DIR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine cycles a character array in place. To cycle */ -/* an array and store the result in a new array, use CYCLAC. */ - -/* An array is cycled when its contents are shifted forward or */ -/* backward by one place. An element pushed off one end of the */ -/* array is brought around to the other end of the array instead */ -/* of disappearing. */ - -/* $ Examples */ - -/* Let the integer array A contain the following elements. */ - -/* A(1) = 'apple' */ -/* A(2) = 'bear' */ -/* A(3) = 'cake' */ -/* A(4) = 'dragon' */ - -/* Cycling A forward once yields the array */ - -/* A(1) = 'dragon' */ -/* A(2) = 'apple' */ -/* A(3) = 'bear' */ -/* A(4) = 'cake' */ - -/* Cycling A backward once yields the array */ - -/* A(1) = 'bear' */ -/* A(2) = 'cake' */ -/* A(3) = 'dragon' */ -/* A(4) = 'apple' */ - -/* Cycling by any multiple of the number of elements in the array */ -/* yields the same array. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 09-SEP-2005 (NJB) (HAN) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle the elements of a character array in place */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CYACIP", (ftnlen)6); - } - -/* Don't even screw around if there are no elements in the array. */ - - if (*nelt < 1) { - chkout_("CYACIP", (ftnlen)6); - return 0; - } - -/* A backward cycle is the same as a forward cycle by the opposite */ -/* of NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum forward right cycle that is equivalent to the inputs. */ -/* If the cycling direction is not recognized, signal an error. */ - - if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') { - k = -(*ncycle) % *nelt; - } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'f') { - k = *ncycle % *nelt; - } else { - setmsg_("Cycling direction was *.", (ftnlen)24); - errch_("*", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYACIP", (ftnlen)6); - return 0; - } - if (k < 0) { - k += *nelt; - } else if (k == 0) { - chkout_("CYACIP", (ftnlen)6); - return 0; - } - -/* The algorithm used to cycle arrays is identical to the one used */ -/* to cycle character strings in CYCLEC. We won't repeat the (rather */ -/* lengthy) description here. */ - -/* The character version of CYCLAx differs from the other */ -/* versions in that a single character is cycled at a time. That */ -/* is, the first trip through the outermost loop cycles the first */ -/* characters of the array elements; the second trip cycles the */ -/* second characters; and so on. This allows the same algorithm to */ -/* be used for all the routines. The local storage required is just */ -/* a couple of characters. */ - -/* Don't swap the ends of strings if they're just blank padded. */ -/* And don't overwrite the elements of the output array, if they */ -/* happen to be shorter than those in the input array. */ - - outlen = i_len(array, array_len); - widest = nbwid_(array, nelt, array_len); - -/* The greatest common divisor need only be computed once. */ - - g = gcd_(&k, nelt); - m = *nelt / g; - -/* To make this a non-character routine, remove all references to C. */ - - i__1 = widest; - for (c__ = 1; c__ <= i__1; ++c__) { - i__2 = g; - for (i__ = 1; i__ <= i__2; ++i__) { - l = i__; - *(unsigned char *)last = *(unsigned char *)&array[(l - 1) * - array_len + (c__ - 1)]; - i__3 = m; - for (j = 1; j <= i__3; ++j) { - l += k; - if (l > *nelt) { - l -= *nelt; - } - *(unsigned char *)temp = *(unsigned char *)&array[(l - 1) * - array_len + (c__ - 1)]; - *(unsigned char *)&array[(l - 1) * array_len + (c__ - 1)] = *( - unsigned char *)last; - *(unsigned char *)last = *(unsigned char *)temp; - } - } - } - -/* If needed, pad the output array with blanks. */ - - if (outlen > widest) { - i__1 = *nelt; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = widest; - s_copy(array + ((i__ - 1) * array_len + i__2), " ", array_len - - i__2, (ftnlen)1); - } - } - chkout_("CYACIP", (ftnlen)6); - return 0; -} /* cyacip_ */ - diff --git a/ext/spice/src/cspice/cyadip.c b/ext/spice/src/cspice/cyadip.c deleted file mode 100644 index 095a05b7c0..0000000000 --- a/ext/spice/src/cspice/cyadip.c +++ /dev/null @@ -1,239 +0,0 @@ -/* cyadip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYADIP ( Cycle the elements of a DP array, in place ) */ -/* Subroutine */ int cyadip_(integer *nelt, char *dir, integer *ncycle, - doublereal *array, ftnlen dir_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - doublereal last, temp; - integer g, i__, j, k, l, m; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - , setmsg_(char *, ftnlen); - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the elements of a double precision array forward */ -/* or backward in place. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NELT I Number of elements. */ -/* DIR I Direction to cycle: 'F' or 'B'. */ -/* NCYCLE I Number of times to cycle. */ -/* ARRAY I-O Array to be cycled/cycled array. */ - -/* $ Detailed_Input */ - -/* NELT is the number of elements in the input array. */ - -/* DIR is the direction in which the elements in the */ -/* array are to be cycled. */ - -/* 'F' or 'f' to cycle forward. */ -/* 'B' or 'b' to cycle backward. */ - -/* NCYCLE is the number of times the elements in the array */ -/* are to be cycled. */ - -/* ARRAY is the array to be cycled. */ - -/* $ Detailed_Output */ - -/* ARRAY is the input array after it has been cycled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of DIR is not recognized, the error */ -/* SPICE(INVALIDDIRECTION) is signaled. */ - -/* 2) If NELT is less than 1, the output array is not modified. */ - -/* 3) If NCYCLE is negative, the array is cycled NCYCLE times in */ -/* the opposite direction of DIR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine cycles a double precision array in place. To cycle */ -/* an array and store the result in a new array, use CYCLAD. */ - -/* An array is cycled when its contents are shifted forward or */ -/* backward by one place. An element pushed off one end of the array */ -/* is brought around to the other end of the array instead of */ -/* disappearing. */ - -/* $ Examples */ - -/* Let the double precision A contain the following elements. */ - -/* A(1) = 1.D0 */ -/* A(2) = 2.D0 */ -/* A(3) = 3.D0 */ -/* A(4) = 4.D0 */ - -/* Cycling A forward once yields the array */ - -/* A(1) = 4.D0 */ -/* A(2) = 1.D0 */ -/* A(3) = 2.D0 */ -/* A(4) = 3.D0 */ - -/* Cycling A backward once yields the array */ - -/* A(1) = 2.D0 */ -/* A(2) = 3.D0 */ -/* A(3) = 4.D0 */ -/* A(4) = 1.D0 */ - -/* Cycling by any multiple of the number of elements in the array */ -/* yields the same array. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 09-SEP-2005 (NJB) (HAN) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle the elements of a d.p. array in place */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CYADIP", (ftnlen)6); - } - -/* Don't even screw around if there are no elements in the array. */ - - if (*nelt < 1) { - chkout_("CYADIP", (ftnlen)6); - return 0; - } - -/* A backward cycle is the same as a forward cycle by the opposite */ -/* of NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum forward right cycle that is equivalent to the inputs. */ - - if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') { - k = -(*ncycle) % *nelt; - } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'F') { - k = *ncycle % *nelt; - } else { - setmsg_("Cycling direction was *.", (ftnlen)24); - errch_("*", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYADIP", (ftnlen)6); - return 0; - } - if (k < 0) { - k += *nelt; - } else if (k == 0) { - chkout_("CYADIP", (ftnlen)6); - return 0; - } - -/* The algorithm used to cycle arrays is identical to the one used */ -/* to cycle character strings in CYCLEC. We won't repeat the (rather */ -/* lengthy) description here. */ - - g = gcd_(&k, nelt); - m = *nelt / g; - i__1 = g; - for (i__ = 1; i__ <= i__1; ++i__) { - l = i__; - last = array[l - 1]; - i__2 = m; - for (j = 1; j <= i__2; ++j) { - l += k; - if (l > *nelt) { - l -= *nelt; - } - temp = array[l - 1]; - array[l - 1] = last; - last = temp; - } - } - chkout_("CYADIP", (ftnlen)6); - return 0; -} /* cyadip_ */ - diff --git a/ext/spice/src/cspice/cyaiip.c b/ext/spice/src/cspice/cyaiip.c deleted file mode 100644 index a1cfd969ea..0000000000 --- a/ext/spice/src/cspice/cyaiip.c +++ /dev/null @@ -1,238 +0,0 @@ -/* cyaiip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYAIIP ( Cycle the elements of an integer array, in place ) */ -/* Subroutine */ int cyaiip_(integer *nelt, char *dir, integer *ncycle, - integer *array, ftnlen dir_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer last, temp, g, i__, j, k, l, m; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - , setmsg_(char *, ftnlen); - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the elements of an integer array forward or backward */ -/* in place. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NELT I Number of elements. */ -/* DIR I Direction to cycle: 'F' or 'B'. */ -/* NCYCLE I Number of times to cycle. */ -/* ARRAY I-O Array to be cycled/cycled array. */ - -/* $ Detailed_Input */ - -/* NELT is the number of elements in the input array. */ - -/* DIR is the direction in which the elements in the */ -/* array are to be cycled. */ - -/* 'F' or 'f' to cycle forward. */ -/* 'B' or 'b' to cycle backward. */ - -/* NCYCLE is the number of times the elements in the array */ -/* are to be cycled. */ - -/* ARRAY is the array to be cycled. */ - -/* $ Detailed_Output */ - -/* ARRAY is the input array after it has been cycled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of DIR is not recognized, the error */ -/* SPICE(INVALIDDIRECTION) is signaled. */ - -/* 2) If NELT is less than 1, the output array is not modified. */ - -/* 3) If NCYCLE is negative, the array is cycled NCYCLE times in */ -/* the opposite direction of DIR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine cycles an integer array in place. To cycle */ -/* an array and store the result in a new array, use CYCLAI. */ - -/* An array is cycled when its contents are shifted forward or */ -/* backward by one place. An element pushed off one end of the */ -/* array is brought around to the other end of the array instead */ -/* of disappearing. */ - -/* $ Examples */ - -/* Let the integer array A contain the following elements. */ - -/* A(1) = 1 */ -/* A(2) = 2 */ -/* A(3) = 3 */ -/* A(4) = 4 */ - -/* Cycling A forward once yields the array */ - -/* A(1) = 4 */ -/* A(2) = 1 */ -/* A(3) = 2 */ -/* A(4) = 3 */ - -/* Cycling A backward once yields the array */ - -/* A(1) = 2 */ -/* A(2) = 3 */ -/* A(3) = 4 */ -/* A(4) = 1 */ - -/* Cycling by any multiple of the number of elements in the array */ -/* yields the same array. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 09-SEP-2005 (NJB) (HAN) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle the elements of an integer array in place */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CYAIIP", (ftnlen)6); - } - -/* Don't even screw around if there are no elements in the array. */ - - if (*nelt < 1) { - chkout_("CYAIIP", (ftnlen)6); - return 0; - } - -/* A backward cycle is the same as a forward cycle by the opposite */ -/* of NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum forward right cycle that is equivalent to the inputs. */ - - if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') { - k = -(*ncycle) % *nelt; - } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'F') { - k = *ncycle % *nelt; - } else { - setmsg_("Cycling direction was *.", (ftnlen)24); - errch_("*", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYAIIP", (ftnlen)6); - return 0; - } - if (k < 0) { - k += *nelt; - } else if (k == 0) { - chkout_("CYAIIP", (ftnlen)6); - return 0; - } - -/* The algorithm used to cycle arrays is identical to the one used */ -/* to cycle character strings in CYCLEC. We won't repeat the (rather */ -/* lengthy) description here. */ - - g = gcd_(&k, nelt); - m = *nelt / g; - i__1 = g; - for (i__ = 1; i__ <= i__1; ++i__) { - l = i__; - last = array[l - 1]; - i__2 = m; - for (j = 1; j <= i__2; ++j) { - l += k; - if (l > *nelt) { - l -= *nelt; - } - temp = array[l - 1]; - array[l - 1] = last; - last = temp; - } - } - chkout_("CYAIIP", (ftnlen)6); - return 0; -} /* cyaiip_ */ - diff --git a/ext/spice/src/cspice/cyclac.c b/ext/spice/src/cspice/cyclac.c deleted file mode 100644 index 0c10a73936..0000000000 --- a/ext/spice/src/cspice/cyclac.c +++ /dev/null @@ -1,322 +0,0 @@ -/* cyclac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYCLAC ( Cycle the elements of a character array ) */ -/* Subroutine */ int cyclac_(char *array, integer *nelt, char *dir, integer * - ncycle, char *out, ftnlen array_len, ftnlen dir_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char last[1], temp[1]; - integer c__, g, i__, j, k, l, m; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer nbwid_(char *, integer *, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - movec_(char *, integer *, char *, ftnlen, ftnlen); - integer limit; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer widest; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer outlen; - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the elements of a character array forward or backward. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NELT I Number of elements. */ -/* DIR I Direction to cycle: 'F' or 'B'. */ -/* NCYCLE I Number of times to cycle. */ -/* OUT O Cycled array. */ - -/* $ Detailed_Input */ - -/* ARRAY is the array to be cycled. */ - -/* NELT is the number of elements in the input array. */ - -/* DIR is the direction in which the elements in the */ -/* array are to be cycled. */ - -/* 'F' or 'f' to cycle forward. */ -/* 'B' or 'b' to cycle backward. */ - -/* NCYCLE is the number of times the elements in the array */ -/* are to be cycled. */ - -/* $ Detailed_Output */ - -/* OUT is the input array after it has been cycled. */ -/* OUT may overwrite ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of DIR is not recognized, the error */ -/* SPICE(INVALIDDIRECTION) is signalled. */ - -/* 2) If NELT is less than 1, the output array is not modified. */ - -/* 3) If NCYCLE is negative, the array is cycled NCYCLE times in */ -/* the opposite direction of DIR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* An array is cycled when its contents are shifted forward or */ -/* backward by one place. An element pushed off one end of the */ -/* array is brought around to the other end of the array instead */ -/* of disappearing. */ - -/* $ Examples */ - -/* Let the integer array A contain the following elements. */ - -/* A(1) = 'apple' */ -/* A(2) = 'bear' */ -/* A(3) = 'cake' */ -/* A(4) = 'dragon' */ - -/* Cycling A forward once yields the array */ - -/* A(1) = 'dragon' */ -/* A(2) = 'apple' */ -/* A(3) = 'bear' */ -/* A(4) = 'cake' */ - -/* Cycling A backward once yields the array */ - -/* A(1) = 'bear' */ -/* A(2) = 'cake' */ -/* A(3) = 'dragon' */ -/* A(4) = 'apple' */ - -/* Cycling by any multiple of the number of elements in the array */ -/* yields the same array. */ - -/* $ Restrictions */ - -/* The memory used for the output array must be identical to or */ -/* disjoint from the memory used for the input array. */ - -/* That is: */ - -/* CALL CYCLAC ( ARRAY, NELT, DIR, NCYCLE, ARRAY ) */ - -/* will produce correct results, while */ - -/* CALL CYCLAC ( ARRAY, NELT-3, DIR, NCYCLE, ARRAY(4) ) */ - -/* will produce garbage. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - 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 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle the elements of a character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */ - -/* Error handling was added to detect an invalid value for */ -/* the cycling direction. If the direction is not recognized */ -/* the error SPICE(INVALIDDIRECTION) is signalled and the */ -/* output array is not modified. (The routine used to copy the */ -/* input array into the output array if the direction was not */ -/* recognized.) */ - -/* The "Exceptions" section was filled out in more detail. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CYCLAC", (ftnlen)6); - } - -/* Don't even screw around if there are no elements in the array. */ - - if (*nelt < 1) { - chkout_("CYCLAC", (ftnlen)6); - return 0; - } - -/* A backward cycle is the same as a forward cycle by the opposite */ -/* of NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum forward right cycle that is equivalent to the inputs. */ -/* If the cycling direction is not recognized, signal an error. */ - - if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') { - k = -(*ncycle) % *nelt; - } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'f') { - k = *ncycle % *nelt; - } else { - setmsg_("Cycling direction was *.", (ftnlen)24); - errch_("*", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYCLAC", (ftnlen)6); - return 0; - } - if (k < 0) { - k += *nelt; - } else if (k == 0) { - movec_(array, nelt, out, array_len, out_len); - chkout_("CYCLAC", (ftnlen)6); - return 0; - } - -/* The algorithm used to cycle arrays is identical to the one used */ -/* to cycle character strings in CYCLEC. We won't repeat the (rather */ -/* lengthy) description here. */ - -/* The character version of CYCLAx differs from the other */ -/* versions in that a single character is cycled at a time. That */ -/* is, the first trip through the outermost loop cycles the first */ -/* characters of the array elements; the second trip cycles the */ -/* second characters; and so on. This allows the same algorithm to */ -/* be used for all the routines. The local storage required is just */ -/* a couple of characters. */ - - -/* Don't swap the ends of strings if they're just blank padded. */ -/* And don't overwrite the elements of the output array, if they */ -/* happen to be shorter thAn those in the input array. */ - - outlen = i_len(out, out_len); - widest = nbwid_(array, nelt, array_len); - limit = min(outlen,widest); - -/* The greatest common divisor need only be computed once. */ - - g = gcd_(&k, nelt); - m = *nelt / g; - -/* To make this a non-character routine, remove all references to C. */ - - i__1 = limit; - for (c__ = 1; c__ <= i__1; ++c__) { - i__2 = g; - for (i__ = 1; i__ <= i__2; ++i__) { - l = i__; - *(unsigned char *)last = *(unsigned char *)&array[(l - 1) * - array_len + (c__ - 1)]; - i__3 = m; - for (j = 1; j <= i__3; ++j) { - l += k; - if (l > *nelt) { - l -= *nelt; - } - *(unsigned char *)temp = *(unsigned char *)&array[(l - 1) * - array_len + (c__ - 1)]; - *(unsigned char *)&out[(l - 1) * out_len + (c__ - 1)] = *( - unsigned char *)last; - *(unsigned char *)last = *(unsigned char *)temp; - } - } - } - -/* If needed, pad the output array with blanks. */ - - if (outlen > limit) { - i__1 = *nelt; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = limit; - s_copy(out + ((i__ - 1) * out_len + i__2), " ", out_len - i__2, ( - ftnlen)1); - } - } - chkout_("CYCLAC", (ftnlen)6); - return 0; -} /* cyclac_ */ - diff --git a/ext/spice/src/cspice/cyclad.c b/ext/spice/src/cspice/cyclad.c deleted file mode 100644 index 45a1494d5d..0000000000 --- a/ext/spice/src/cspice/cyclad.c +++ /dev/null @@ -1,267 +0,0 @@ -/* cyclad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYCLAD ( Cycle the elements of a DP array ) */ -/* Subroutine */ int cyclad_(doublereal *array, integer *nelt, char *dir, - integer *ncycle, doublereal *out, ftnlen dir_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - doublereal last, temp; - integer g, i__, j, k, l, m; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the elements of a double precision array forward */ -/* or backward. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NELT I Number of elements. */ -/* DIR I Direction to cycle: 'F' or 'B'. */ -/* NCYCLE I Number of times to cycle. */ -/* OUT O Cycled array. */ - -/* $ Detailed_Input */ - -/* ARRAY is the array to be cycled. */ - -/* NELT is the number of elements in the input array. */ - -/* DIR is the direction in which the elements in the */ -/* array are to be cycled. */ - -/* 'F' or 'f' to cycle forward. */ -/* 'B' or 'b' to cycle backward. */ - -/* NCYCLE is the number of times the elements in the array */ -/* are to be cycled. */ - -/* $ Detailed_Output */ - -/* OUT is the input array after it has been cycled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of DIR is not recognized, the error */ -/* SPICE(INVALIDDIRECTION) is signalled. */ - -/* 2) If NELT is less than 1, the output array is not modified. */ - -/* 3) If NCYCLE is negative, the array is cycled NCYCLE times in */ -/* the opposite direction of DIR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* An array is cycled when its contents are shifted forward or */ -/* backward by one place. An element pushed off one end of the */ -/* array is brought around to the other end of the array instead */ -/* of disappearing. */ - -/* $ Examples */ - -/* Let the double precision A contain the following elements. */ - -/* A(1) = 1.D0 */ -/* A(2) = 2.D0 */ -/* A(3) = 3.D0 */ -/* A(4) = 4.D0 */ - -/* Cycling A forward once yields the array */ - -/* A(1) = 4.D0 */ -/* A(2) = 1.D0 */ -/* A(3) = 2.D0 */ -/* A(4) = 3.D0 */ - -/* Cycling A backward once yields the array */ - -/* A(1) = 2.D0 */ -/* A(2) = 3.D0 */ -/* A(3) = 4.D0 */ -/* A(4) = 1.D0 */ - -/* Cycling by any multiple of the number of elements in the array */ -/* yields the same array. */ - -/* $ Restrictions */ - -/* The memory used for the output array must be disjoint from the */ -/* memory used for the input array. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle the elements of a d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */ - -/* Error handling was added to detect an invalid value for */ -/* the cycling direction. If the direction is not recognized */ -/* the error SPICE(INVALIDDIRECTION) is signalled and the */ -/* output array is not modified. (The routine used to copy the */ -/* input array into the output array if the direction was not */ -/* recognized.) */ - -/* The "Exceptions" section was filled out in more detail. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CYCLAD", (ftnlen)6); - } - -/* Don't even screw around if there are no elements in the array. */ - - if (*nelt < 1) { - chkout_("CYCLAD", (ftnlen)6); - return 0; - } - -/* A backward cycle is the same as a forward cycle by the opposite */ -/* of NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum forward right cycle that is equivalent to the inputs. */ - - if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') { - k = -(*ncycle) % *nelt; - } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'F') { - k = *ncycle % *nelt; - } else { - setmsg_("Cycling direction was *.", (ftnlen)24); - errch_("*", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYCLAD", (ftnlen)6); - return 0; - } - if (k < 0) { - k += *nelt; - } else if (k == 0) { - moved_(array, nelt, out); - chkout_("CYCLAD", (ftnlen)6); - return 0; - } - -/* The algorithm used to cycle arrays is identical to the one used */ -/* to cycle character strings in CYCLEC. We won't repeat the (rather */ -/* lengthy) description here. */ - - g = gcd_(&k, nelt); - m = *nelt / g; - i__1 = g; - for (i__ = 1; i__ <= i__1; ++i__) { - l = i__; - last = array[l - 1]; - i__2 = m; - for (j = 1; j <= i__2; ++j) { - l += k; - if (l > *nelt) { - l -= *nelt; - } - temp = array[l - 1]; - out[l - 1] = last; - last = temp; - } - } - chkout_("CYCLAD", (ftnlen)6); - return 0; -} /* cyclad_ */ - diff --git a/ext/spice/src/cspice/cyclai.c b/ext/spice/src/cspice/cyclai.c deleted file mode 100644 index 7b2609342a..0000000000 --- a/ext/spice/src/cspice/cyclai.c +++ /dev/null @@ -1,265 +0,0 @@ -/* cyclai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYCLAI ( Cycle the elements of an integer array ) */ -/* Subroutine */ int cyclai_(integer *array, integer *nelt, char *dir, - integer *ncycle, integer *out, ftnlen dir_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer last, temp, g, i__, j, k, l, m; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), movei_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the elements of an integer array forward or backward. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NELT I Number of elements. */ -/* DIR I Direction to cycle: 'F' or 'B'. */ -/* NCYCLE I Number of times to cycle. */ -/* OUT O Cycled array. */ - -/* $ Detailed_Input */ - -/* ARRAY is the array to be cycled. */ - -/* NELT is the number of elements in the input array. */ - -/* DIR is the direction in which the elements in the */ -/* array are to be cycled. */ - -/* 'F' or 'f' to cycle forward. */ -/* 'B' or 'b' to cycle backward. */ - -/* NCYCLE is the number of times the elements in the array */ -/* are to be cycled. */ - -/* $ Detailed_Output */ - -/* OUT is the input array after it has been cycled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of DIR is not recognized, the error */ -/* SPICE(INVALIDDIRECTION) is signaled. */ - -/* 2) If NELT is less than 1, the output array is not modified. */ - -/* 3) If NCYCLE is negative, the array is cycled NCYCLE times in */ -/* the opposite direction of DIR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* An array is cycled when its contents are shifted forward or */ -/* backward by one place. An element pushed off one end of the */ -/* array is brought around to the other end of the array instead */ -/* of disappearing. */ - -/* $ Examples */ - -/* Let the integer array A contain the following elements. */ - -/* A(1) = 1 */ -/* A(2) = 2 */ -/* A(3) = 3 */ -/* A(4) = 4 */ - -/* Cycling A forward once yields the array */ - -/* A(1) = 4 */ -/* A(2) = 1 */ -/* A(3) = 2 */ -/* A(4) = 3 */ - -/* Cycling A backward once yields the array */ - -/* A(1) = 2 */ -/* A(2) = 3 */ -/* A(3) = 4 */ -/* A(4) = 1 */ - -/* Cycling by any multiple of the number of elements in the array */ -/* yields the same array. */ - -/* $ Restrictions */ - -/* The memory used for the output array must be disjoint from the */ -/* memory used for the input array. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle the elements of an integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */ - -/* Error handling was added to detect an invalid value for */ -/* the cycling direction. If the direction is not recognized */ -/* the error SPICE(INVALIDDIRECTION) is signalled and the */ -/* output array is not modified. (The routine used to copy the */ -/* input array into the output array if the direction was not */ -/* recognized.) */ - -/* The "Exceptions" section was filled out in more detail. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CYCLAI", (ftnlen)6); - } - -/* Don't even screw around if there are no elements in the array. */ - - if (*nelt < 1) { - chkout_("CYCLAI", (ftnlen)6); - return 0; - } - -/* A backward cycle is the same as a forward cycle by the opposite */ -/* of NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum forward right cycle that is equivalent to the inputs. */ - - if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') { - k = -(*ncycle) % *nelt; - } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'F') { - k = *ncycle % *nelt; - } else { - setmsg_("Cycling direction was *.", (ftnlen)24); - errch_("*", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYCLAI", (ftnlen)6); - return 0; - } - if (k < 0) { - k += *nelt; - } else if (k == 0) { - movei_(array, nelt, out); - chkout_("CYCLAI", (ftnlen)6); - return 0; - } - -/* The algorithm used to cycle arrays is identical to the one used */ -/* to cycle character strings in CYCLEC. We won't repeat the (rather */ -/* lengthy) description here. */ - - g = gcd_(&k, nelt); - m = *nelt / g; - i__1 = g; - for (i__ = 1; i__ <= i__1; ++i__) { - l = i__; - last = array[l - 1]; - i__2 = m; - for (j = 1; j <= i__2; ++j) { - l += k; - if (l > *nelt) { - l -= *nelt; - } - temp = array[l - 1]; - out[l - 1] = last; - last = temp; - } - } - chkout_("CYCLAI", (ftnlen)6); - return 0; -} /* cyclai_ */ - diff --git a/ext/spice/src/cspice/cyclec.c b/ext/spice/src/cspice/cyclec.c deleted file mode 100644 index b41f973d80..0000000000 --- a/ext/spice/src/cspice/cyclec.c +++ /dev/null @@ -1,325 +0,0 @@ -/* cyclec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYCLEC ( Cycle a character string ) */ -/* Subroutine */ int cyclec_(char *instr, char *dir, integer *ncycle, char * - outstr, ftnlen instr_len, ftnlen dir_len, ftnlen outstr_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - char last[1], temp[1]; - integer g, i__, j, k, l, m, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer limit; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern integer gcd_(integer *, integer *); - -/* $ Abstract */ - -/* Cycle the contents of a character string to the left or right. */ - -/* $ 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 */ - -/* CHARACTER, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INSTR I String to be cycled. */ -/* DIR I Direction to cycle. */ -/* NCYCLE I Number of times to cycle. */ -/* OUTSTR O Cycled string. */ - -/* $ Detailed_Input */ - -/* DIR is the direction in which the characters in the */ -/* string are to be cycled. */ - -/* 'L' or 'l' to cycle left. */ -/* 'R' or 'r' to cycle right. */ - -/* NCYCLE is the number of times the characters in the string */ -/* are to be cycled. */ - -/* INSTR is the string to be cycled. */ - -/* $ Detailed_Output */ - -/* OUTSTR the input string after it has been cycled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A string is cycled when its contents are shifted to the left */ -/* or right by one place. A character pushed off one end of the */ -/* string is brought around to the other end of the string instead */ -/* of disappearing. */ - -/* Leading and trailing blanks are treated just like any other */ -/* characters. */ - -/* If the output string is not large enough to contain the input */ -/* string, the cycled string is truncated on the right. */ - -/* $ Examples */ - -/* 'abcde' cycled left twice becomes 'cdeab' */ -/* 'abcde ' cycled left twice becomes 'cde ab' */ -/* 'abcde' cycled right once becomes 'eabcd' */ -/* 'Apple ' cycled left six times becomes 'Apple ' */ -/* 'Apple ' cycled right twenty-four times becomes 'Apple ' */ - -/* $ Restrictions */ - -/* The memory used for the output string must be identical to that */ -/* used for the input string or be disjoint from the input string */ -/* memory. */ - -/* That is: */ - -/* CALL CYCLEN ( STRING, DIR, NCYCLE, STRING ) */ - -/* will produce correct results with output overwriting input. */ - -/* CALL CYCLEN ( STRING(4:20), DIR, NCYCLE, STRING(2:18) ) */ - -/* will produce garbage results. */ - -/* $ Exceptions */ - -/* 1) If the direction flag is not one of the acceptable values */ -/* 'r', 'R', 'l', 'L', the error 'SPICE(INVALIDDIRECTION)' is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Fixed problem with unbalanced CHKIN/CHKOUT calls. */ - -/* - 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 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* cycle a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 6-FEB-1989 (WLT) */ - -/* Error handling for bad direction flag added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("CYCLEC", (ftnlen)6); - } - -/* Get the length of the input string. */ - - n = i_len(instr, instr_len); - limit = i_len(outstr, outstr_len); - -/* A left cycle is the same as a right cycle by the opposite of */ -/* NCYCLE. Moreover a cycle by K is the same as a cycle by */ -/* K + m*N for any integer m. Thus we compute the value of the */ -/* minimum positive right cycle that is equivalent to the inputs. */ - - if (*(unsigned char *)dir == 'L' || *(unsigned char *)dir == 'l') { - k = -(*ncycle) % n; - } else if (*(unsigned char *)dir == 'R' || *(unsigned char *)dir == 'r') { - k = *ncycle % n; - } else { - setmsg_("The direction flag should be one of the following: 'r', 'R'" - ", 'l', 'L'. It was #.", (ftnlen)81); - errch_("#", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23); - chkout_("CYCLEC", (ftnlen)6); - return 0; - } - if (k < 0) { - k += n; - } else if (k == 0) { - chkout_("CYCLEC", (ftnlen)6); - return 0; - } - -/* As to the method for performing the cycle in place, we need a */ -/* few preliminaries. */ - -/* 1. Since we are performing a cycle on the input string we */ -/* can regard the letters of the string as being attached */ -/* to a circle at N equally spaced points. Thus a cycle */ -/* by K has the effect of moving the position of each letter */ -/* to the K'th point from its current position along the */ -/* circle. (The first point from its position is the */ -/* adjacent point.) */ - -/* 2. If we start at some point on the circle and begin moves to */ -/* other points of the circle by always moving K points */ -/* at a time, how long will it take until we get back to */ -/* the starting point? Answer: N/gcd(K,N) */ - -/* Justification of the above answer. */ - -/* a. If we count all of the points that we move past or */ -/* onto in such a trip (counting second, third, ... */ -/* passes), we will find that we have */ -/* moved past or onto i*K points after i steps. */ - -/* b. In order to get back to the starting point we will */ -/* have to move past or onto a multiple of N points. */ - -/* c. The first time we will get back to the starting */ -/* point is the smallest value of i such that i*K */ -/* is a multiple of N. That value is N/g.c.d.(K,N) */ -/* where g.c.d stands for the greatest common divisor */ -/* of K and N. Lets call this number M. */ - -/* i. To see that this is the smallest number we */ -/* first show that K*M is in fact a multiple of */ -/* N. The product K*M = K * ( N / gcd(K,N) ) */ -/* = N * ( K / gcd(K,N) ) */ - -/* Since gcd(K,N) evenly divides K, K/gcd(K,N) */ -/* is an integer. Thus K*M = N*I for some */ -/* integer I ( = K / gcd(K,N) ). */ - -/* ii. The least common multiple of K and N is: */ -/* K*N / gcd(K,N) thus the first multiple */ -/* of K that is also a multiple of N is the */ -/* N/ gcd(K,N) 'th multiple of K. */ - -/* 3. The closest stopping point on the circle will be gcd(K,N) */ -/* points away from our starting point. To see this recall */ -/* that we make N/gcd(K,N) moves of size K inorder to get */ -/* back to the starting point. The stopping points must */ -/* be equally spaced around the circle since the set of */ -/* points must look the same from any one of the points */ -/* visited --- after all we could get the same set by just */ -/* starting at one of those visited and making N/gcd(K,N) */ -/* moves. But the set of N/gcd(K,N) equally space points */ -/* out of the original N must be gcd(K,N) points apart. */ - -/* 4. To visit every point on the circle we could */ - -/* a. Pick a starting point */ -/* b. Take N/gcd(K,N) steps of size K (bringing us back */ -/* to our starting point. */ -/* c. move forward 1 point */ -/* d. repeat steps a. b. and c. gcd(K,N) times. */ - -/* 5. If in addition to moving around the circle by the */ -/* prescription of 4. above we: */ -/* a. pick up the letter at a position when we stop there */ -/* (starting being the same as stopping) */ -/* b. put down the letter we had picked up at a previous */ -/* point. */ -/* then we will cycle every letter by the prescribed value */ -/* of K. */ - -/* In this case the code is much shorter than its explanation. */ - - g = gcd_(&k, &n); - m = n / g; - i__1 = g; - for (i__ = 1; i__ <= i__1; ++i__) { - l = i__; - *(unsigned char *)last = *(unsigned char *)&instr[l - 1]; - i__2 = m; - for (j = 1; j <= i__2; ++j) { - l += k; - -/* Compute L mod N. */ - - if (l > n) { - l -= n; - } - *(unsigned char *)temp = *(unsigned char *)&instr[l - 1]; - -/* Make sure there is someplace to put the letter picked up */ -/* in the previous pass through the loop. */ - - if (l <= limit) { - *(unsigned char *)&outstr[l - 1] = *(unsigned char *)last; - } - *(unsigned char *)last = *(unsigned char *)temp; - } - } - chkout_("CYCLEC", (ftnlen)6); - return 0; -} /* cyclec_ */ - diff --git a/ext/spice/src/cspice/cyllat.c b/ext/spice/src/cspice/cyllat.c deleted file mode 100644 index 4fac081cd7..0000000000 --- a/ext/spice/src/cspice/cyllat.c +++ /dev/null @@ -1,206 +0,0 @@ -/* cyllat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYLLAT ( Cylindrical to latitudinal ) */ -/* Subroutine */ int cyllat_(doublereal *r__, doublereal *longc, doublereal * - z__, doublereal *radius, doublereal *long__, doublereal *lat) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal), atan2(doublereal, doublereal); - - /* Local variables */ - doublereal x, y, lattud, big, rho; - -/* $ Abstract */ - -/* Convert from cylindrical to latitudinal coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* R I Distance of point from Z axis. */ -/* LONGC I Cylindrical angle of point from XZ plane(radians). */ -/* Z I Height of point above XY plane. */ -/* RADIUS O Distance of point from origin. */ -/* LONG O Longitude of point (radians). */ -/* LAT O Latitude of point (radians). */ - -/* $ Detailed_Input */ - -/* R Distance of the input point from Z axis. */ - -/* LONGC Cylindrical angle of the point from XZ plane(radians). */ - -/* Z Height of the point above XY plane. */ - -/* $ Detailed_Output */ - -/* RADIUS Distance of the input point from origin. */ - -/* LONG Longitude (i.e. angle from the XZ plane) of the input */ -/* point. */ - -/* LAT Latitude (i.e. angle above the XY plane) of the input */ -/* point (radians). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts coordinates given in cylindrical */ -/* coordinates to coordinates in latitudinal coordinates. */ - -/* Latitudinal coordinates are the same coordinates as use for */ -/* the earth. Latitude refers to angle above the equator, longitude */ -/* to angle east from a meridian, and radius to the distance from */ -/* an origin. */ - -/* $ Examples */ - -/* Below are two tables: The first is a set of input values */ -/* the second is the result of the following sequence of */ -/* calls to Spicelib routines. Note all input and output angular */ -/* quantities are in degrees. */ - -/* CALL CONVRT ( LONGC, 'DEGREES', 'RADIANS', LONGC ) */ - -/* CALL CYLLAT ( R, LONGC, Z, RADIUS, LONG, LAT ) */ - -/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */ -/* CALL CONVRT ( LAT, 'RADIANS', 'DEGREES', LAT ) */ - - - -/* Inputs: Results: */ - -/* R LONGC Z RADIUS LONG LAT */ -/* ------ ------ ------ ------ ------ ------ */ -/* 1.0000 0 0 1.0000 0 0 */ -/* 1.0000 90.00 0 1.0000 90.00 0 */ -/* 1.0000 180.00 1.000 1.4142 180.00 45.00 */ -/* 1.0000 180.00 -1.000 1.4142 180.00 -45.00 */ -/* 0.0000 180.00 1.000 1.0000 180.00 90.00 */ -/* 0.0000 33.00 0 0.0000 33.00 0.00 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - 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 */ - -/* cylindrical to latitudinal */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Local Variables */ - - -/* Convert the input cylindrical coordinates to latitudinal */ -/* coordinates, storing in temporary variables. */ - -/* Computing MAX */ - d__1 = abs(*r__), d__2 = abs(*z__); - big = max(d__1,d__2); - if (big > 0.) { - x = *r__ / big; - y = *z__ / big; - rho = big * sqrt(x * x + y * y); - } else { - rho = 0.; - } - if (rho == 0.) { - lattud = 0.; - } else { - lattud = atan2(*z__, *r__); - } - -/* Move results to output variables */ - - *long__ = *longc; - *radius = rho; - *lat = lattud; - - return 0; -} /* cyllat_ */ - diff --git a/ext/spice/src/cspice/cyllat_c.c b/ext/spice/src/cspice/cyllat_c.c deleted file mode 100644 index 9f9ad2113f..0000000000 --- a/ext/spice/src/cspice/cyllat_c.c +++ /dev/null @@ -1,211 +0,0 @@ -/* - --Procedure cyllat_c ( Cylindrical to latitudinal ) - --Abstract - - Convert from cylindrical to latitudinal coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - void cyllat_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - r I Distance of point from z axis. - lonc I Cylindrical angle of point from XZ plane(radians). - z I Height of point above XY plane. - radius O Distance of point from origin. - lon O Longitude of point (radians). - lat O Latitude of point (radians). - --Detailed_Input - - r Distance of the input point from z axis. - - lonc Cylindrical angle of the point from XZ plane(radians). - - z Height of the point above XY plane. - --Detailed_Output - - radius Distance of the input point from origin. - - lon Longitude (i.e. angle from the XZ plane) of the input - point. - - lat Latitude (i.e. angle above the XY plane) of the input - point (radians). - --Parameters - - None. - --Particulars - - This routine converts coordinates given in cylindrical - coordinates to coordinates in latitudinal coordinates. - - Latitudinal coordinates are the same coordinates as use for - the earth. Latitude refers to angle above the equator, longitude - to angle east from a meridian, and radius to the distance from - an origin. - --Examples - - Below are two tables: The first is a set of input values - the second is the result of the following sequence of - calls to Spicelib routines. Note all input and output angular - quantities are in degrees. - - convrt_c ( lonc , "DEGREES", "RADIANS", lonc ); - - cyllat_c ( r, lonc , z, &radius, &lon, &lat ); - - convrt_c ( lon, "RADIANS", "DEGREES", lon ); - convrt_c ( lat, "RADIANS", "DEGREES", lat ); - - - Inputs: Results: - - r lonc z radius lon lat - ------ ------ ------ ------ ------ ------ - 1.0000 0 0 1.0000 0 0 - 1.0000 90.00 0 1.0000 90.00 0 - 1.0000 180.00 1.000 1.4142 180.00 45.00 - 1.0000 180.00 -1.000 1.4142 180.00 -45.00 - 0.0000 180.00 1.000 1.0000 180.00 90.00 - 0.0000 33.00 0 0.0000 33.00 0.00 - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. Removed return call. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - cylindrical to latitudinal - --& -*/ - -{ /* Begin cyllat_c */ - - /* - Local variables - */ - - SpiceDouble lattud; - SpiceDouble rho; - SpiceDouble x; - SpiceDouble y; - SpiceDouble big; - - - /* Computing biggest absolute value */ - - big = MaxAbs( r, z); - - if (big > 0.) - { - x = r / big; - y = z / big; - rho = big * sqrt(x * x + y * y); - } - else - { - rho = 0.; - } - - if (rho == 0.) - { - lattud = 0.; - } - else - { - lattud = atan2( z, r ); - } - - - /* Move results to output variables */ - - *lon = lonc; - *radius = rho; - *lat = lattud; - - -} /* End cyllat_c */ diff --git a/ext/spice/src/cspice/cylrec.c b/ext/spice/src/cspice/cylrec.c deleted file mode 100644 index 3ef7605691..0000000000 --- a/ext/spice/src/cspice/cylrec.c +++ /dev/null @@ -1,183 +0,0 @@ -/* cylrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYLREC ( Cylindrical to rectangular ) */ -/* Subroutine */ int cylrec_(doublereal *r__, doublereal *long__, doublereal * - z__, doublereal *rectan) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal x, y; - -/* $ Abstract */ - -/* Convert from cylindrical to rectangular coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* R I Distance of a point from Z axis. */ -/* LONG I Angle (radians) of a point from XZ plane */ -/* Z I Height of a point above XY plane. */ -/* RECTAN O Rectangular coordinates of the point. */ - -/* $ Detailed_Input */ - -/* R Distance of the point of interest from Z axis. */ - -/* LONG Cylindrical angle (in radians) of the point of */ -/* interest from XZ plane. */ - -/* Z Height of the point above XY plane. */ - -/* $ Detailed_Output */ - -/* RECTAN Rectangular coordinates of the point of interest. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine transforms the coordinates of a point from */ -/* cylindrical to rectangular coordinates. */ - -/* $ Examples */ - -/* Below are two tables. */ - -/* Listed in the first table (under R, LONG and Z ) are */ -/* cylindrical coordinate triples that approximately represent */ -/* points whose rectangular coordinates are taken from the set */ -/* {-1, 0, 1}. (Angular quantities are given in degrees.) */ - -/* The result of the code fragment */ - -/* Use the SPICELIB routine CONVRT to convert the angular */ -/* quantities to radians */ - -/* CALL CONVRT ( LONG, 'DEGREES', 'RADIANS', LONG ) */ - -/* CALL CYLREC ( R, LONG, Z, X ) */ - - -/* are listed in the second parallel table under X(1), X(2) and X(3). */ - - -/* R LONG Z X(1) X(2) X(3) */ -/* ------------------------- -------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 */ -/* 1.0000 90.0000 0.0000 0.0000 1.0000 0.0000 */ -/* 0.0000 0.0000 1.0000 0.0000 0.0000 1.0000 */ -/* 1.0000 180.0000 0.0000 -1.0000 0.0000 0.0000 */ -/* 1.0000 270.0000 0.0000 0.0000 -1.0000 0.0000 */ -/* 0.0000 0.0000 -1.0000 0.0000 0.0000 -1.0000 */ -/* 1.4142 45.0000 0.0000 1.0000 1.0000 0.0000 */ -/* 1.0000 0.0000 1.0000 1.0000 0.0000 1.0000 */ -/* 1.0000 90.0000 1.0000 0.0000 1.0000 1.0000 */ -/* 1.4142 45.0000 1.0000 1.0000 1.0000 1.0000 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* cylindrical to rectangular */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Local variables */ - - -/* Convert to rectangular coordinates, storing the results in */ -/* temporary variables. */ - - x = *r__ * cos(*long__); - y = *r__ * sin(*long__); - -/* Move the results to the output variables. */ - - rectan[0] = x; - rectan[1] = y; - rectan[2] = *z__; - return 0; -} /* cylrec_ */ - diff --git a/ext/spice/src/cspice/cylrec_c.c b/ext/spice/src/cspice/cylrec_c.c deleted file mode 100644 index c22a66719b..0000000000 --- a/ext/spice/src/cspice/cylrec_c.c +++ /dev/null @@ -1,182 +0,0 @@ -/* - --Procedure cylrec_c ( Cylindrical to rectangular ) - --Abstract - - Convert from cylindrical to rectangular coordinates. - --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 - - CONVERSION - COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - - void cylrec_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble rectan[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------- - r I Distance of a point from z axis. - lon I Angle (radians) of a point from xZ plane - z I Height of a point above xY plane. - rectan O Rectangular coordinates of the point. - --Detailed_Input - - r Distance of the point of interest from z axis. - - lon Cylindrical angle (in radians) of the point of - interest from XZ plane. - - z Height of the point above XY plane. - --Detailed_Output - - rectan Rectangular coordinates of the point of interest. - --Parameters - - None. - --Particulars - - This routine transforms the coordinates of a point from - cylindrical to rectangular coordinates. - --Examples - - Below are two tables. - - Listed in the first table (under r, lon and z ) are - cylindrical coordinate triples that approximately represent - points whose rectangular coordinates are taken from the set - {-1, 0, 1}. (Angular quantities are given in degrees.) - - The result of the code fragment - - Use the CSPICE routine convrt_c to convert the angular - quantities to radians - - convrt_c ( lon, "DEGREES", "RADIANS", lon ); - - cylrec_c ( r, lon, z, x ); - - - are listed in the second parallel table under x(1), x(2) and x(3). - - - r lon z x(1) x(2) x(3) - ------------------------- -------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 - 1.0000 90.0000 0.0000 0.0000 1.0000 0.0000 - 0.0000 0.0000 1.0000 0.0000 0.0000 1.0000 - 1.0000 180.0000 0.0000 -1.0000 0.0000 0.0000 - 1.0000 270.0000 0.0000 0.0000 -1.0000 0.0000 - 0.0000 0.0000 -1.0000 0.0000 0.0000 -1.0000 - 1.4142 45.0000 0.0000 1.0000 1.0000 0.0000 - 1.0000 0.0000 1.0000 1.0000 0.0000 1.0000 - 1.0000 90.0000 1.0000 0.0000 1.0000 1.0000 - 1.4142 45.0000 1.0000 1.0000 1.0000 1.0000 - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. Removed return call. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - cylindrical to rectangular - --& -*/ - -{ /* Begin cylrec_c */ - - /* - Local variables - */ - - SpiceDouble x; - SpiceDouble y; - - - /* Function Body */ - - x = r * cos( lon ); - y = r * sin( lon ); - - - /* Move the results to the output variables. */ - - rectan[0] = x; - rectan[1] = y; - rectan[2] = z; - - -} /* End cylrec_c */ diff --git a/ext/spice/src/cspice/cylsph.c b/ext/spice/src/cspice/cylsph.c deleted file mode 100644 index bf84cfeca4..0000000000 --- a/ext/spice/src/cspice/cylsph.c +++ /dev/null @@ -1,190 +0,0 @@ -/* cylsph.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CYLSPH ( Cylindrical to spherical ) */ -/* Subroutine */ int cylsph_(doublereal *r__, doublereal *longc, doublereal * - z__, doublereal *radius, doublereal *colat, doublereal *long__) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal), atan2(doublereal, doublereal); - - /* Local variables */ - doublereal x, y, rh, th, big; - -/* $ Abstract */ - -/* Convert from cylindrical to spherical coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* R I Distance of point from Z axis. */ -/* LONGC I Angle (radians) of point from XZ plane. */ -/* Z I Height of point above XY plane. */ -/* RADIUS O Distance of point from origin. */ -/* COLAT O Polar angle (co-latitude in radians) of point. */ -/* LONG O Azimuthal angle (longitude) of point (radians). */ - -/* $ Detailed_Input */ - -/* R Distance of the point of interest from Z axis. */ - -/* LONGC Cylindrical angle (radians) of the point from the */ -/* XZ plane. */ - -/* Z Height of the point above XY plane. */ - -/* $ Detailed_Output */ - -/* RADIUS Distance of the point from origin. */ - -/* COLAT Polar angle (co-latitude in radians) of the point. */ - -/* LONG Azimuthal angle (longitude) of the point (radians). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This returns the spherical coordinates of a point whose position */ -/* is input through cylindrical coordinates. */ - -/* $ Examples */ - - -/* Below are two tables: The first is a set of input values */ -/* the second is the result of the following sequence of */ -/* calls to Spicelib routines. Note all input and output angular */ -/* quantities are in degrees. */ - -/* CALL CONVRT ( LONGC, 'DEGREES', 'RADIANS', LONGC ) */ - -/* CALL CYLSPH ( R, LONGC, Z, RADIUS, COLAT, LONG ) */ - -/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */ -/* CALL CONVRT ( LAT, 'RADIANS', 'DEGREES', LAT ) */ - - - -/* Inputs: Results: */ - -/* R LONGC Z RADIUS LONG COLAT */ -/* ------ ------ ------ ------ ------ ------ */ -/* 1.0000 0 0 1.0000 0 90.00 */ -/* 1.0000 90.00 0 1.0000 90.00 90.00 */ -/* 1.0000 180.00 1.000 1.4142 180.00 45.00 */ -/* 1.0000 180.00 -1.000 1.4142 180.00 135.00 */ -/* 0.0000 180.00 1.000 1.0000 180.00 0.00 */ -/* 0.0000 33.00 0 0.0000 33.00 0.00 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. Obsolete Revisions section */ -/* deleted. */ - -/* - 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 */ - -/* cylindrical to spherical */ - -/* -& */ - -/* Local variables */ - - -/* Convert to spherical, storing in temporary variables */ - -/* Computing MAX */ - d__1 = abs(*r__), d__2 = abs(*z__); - big = max(d__1,d__2); - if (big == 0.) { - th = 0.; - rh = 0.; - } else { - x = *r__ / big; - y = *z__ / big; - rh = big * sqrt(x * x + y * y); - th = atan2(*r__, *z__); - } - -/* Move the results to output variables */ - - *long__ = *longc; - *radius = rh; - *colat = th; - return 0; -} /* cylsph_ */ - diff --git a/ext/spice/src/cspice/cylsph_c.c b/ext/spice/src/cspice/cylsph_c.c deleted file mode 100644 index 86e9c4afb2..0000000000 --- a/ext/spice/src/cspice/cylsph_c.c +++ /dev/null @@ -1,197 +0,0 @@ -/* - --Procedure cylsph_c ( Cylindrical to spherical ) - --Abstract - - Convert from cylindrical to spherical coordinates. - --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 - - CONVERSION - COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - void cylsph_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * colat, - SpiceDouble * lon ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------- - r I Distance of point from z axis. - lonc I Angle (radians) of point from XZ plane. - z I Height of point above XY plane. - radius O Distance of point from origin. - colat O Polar angle (co-latitude in radians) of point. - lon O Azimuthal angle (longitude) of point (radians). - --Detailed_Input - - r Distance of the point of interest from z axis. - - lonc Cylindrical angle (radians) of the point from the - XZ plane. - - z Height of the point above XY plane. - --Detailed_Output - - radius Distance of the point from origin. - - colat Polar angle (co-latitude in radians) of the point. - - lon Azimuthal angle (longitude) of the point (radians). - --Parameters - - None. - --Particulars - - This returns the spherical coordinates of a point whose position - is input through cylindrical coordinates. - --Examples - - - Below are two tables: The first is a set of input values - the second is the result of the following sequence of - calls to Spicelib routines. Note all input and output angular - quantities are in degrees. - - convrt_c ( lonc, "DEGREES", "RADIANS", lonc ); - - cylsph_c ( r, lonc, z, &radius, &colat, &lon ); - - convrt_c ( lon, "RADIANS", "DEGREES", lon ); - convrt_c ( lat, "RADIANS", "DEGREES", lat ); - - - - Inputs: Results: - - r lonc z radius lon colat - ------ ------ ------ ------ ------ ------ - 1.0000 0 0 1.0000 0 90.00 - 1.0000 90.00 0 1.0000 90.00 90.00 - 1.0000 180.00 1.000 1.4142 180.00 45.00 - 1.0000 180.00 -1.000 1.4142 180.00 135.00 - 0.0000 180.00 1.000 1.0000 180.00 0.00 - 0.0000 33.00 0 0.0000 33.00 0.00 - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Corrected and clarified header entries. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - cylindrical to spherical - --& -*/ - -{ /* Begin cylsph_c */ - - /* - Local variables - */ - - SpiceDouble big; - SpiceDouble th; - SpiceDouble rh; - SpiceDouble x; - SpiceDouble y; - - - /* Computing biggest absolute value */ - - big = MaxAbs( r, z ); - - if (big == 0.) - { - th = 0.; - rh = 0.; - } - else - { - x = r / big; - y = z / big; - rh = big * sqrt( x * x + y * y); - th = atan2( r, z ); - } - - - /* Move the results to output variables */ - - *lon = lonc; - *radius = rh; - *colat = th; - - -} /* End cylsph_c */ diff --git a/ext/spice/src/cspice/d_abs.c b/ext/spice/src/cspice/d_abs.c deleted file mode 100644 index cb157e067b..0000000000 --- a/ext/spice/src/cspice/d_abs.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double d_abs(x) doublereal *x; -#else -double d_abs(doublereal *x) -#endif -{ -if(*x >= 0) - return(*x); -return(- *x); -} diff --git a/ext/spice/src/cspice/d_acos.c b/ext/spice/src/cspice/d_acos.c deleted file mode 100644 index ecb56e87f5..0000000000 --- a/ext/spice/src/cspice/d_acos.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double acos(); -double d_acos(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_acos(doublereal *x) -#endif -{ -return( acos(*x) ); -} diff --git a/ext/spice/src/cspice/d_asin.c b/ext/spice/src/cspice/d_asin.c deleted file mode 100644 index 045e73301c..0000000000 --- a/ext/spice/src/cspice/d_asin.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double asin(); -double d_asin(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_asin(doublereal *x) -#endif -{ -return( asin(*x) ); -} diff --git a/ext/spice/src/cspice/d_atan.c b/ext/spice/src/cspice/d_atan.c deleted file mode 100644 index 03530a1857..0000000000 --- a/ext/spice/src/cspice/d_atan.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double atan(); -double d_atan(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_atan(doublereal *x) -#endif -{ -return( atan(*x) ); -} diff --git a/ext/spice/src/cspice/d_atn2.c b/ext/spice/src/cspice/d_atn2.c deleted file mode 100644 index 7c25ac0460..0000000000 --- a/ext/spice/src/cspice/d_atn2.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double atan2(); -double d_atn2(x,y) doublereal *x, *y; -#else -#undef abs -#include "math.h" -double d_atn2(doublereal *x, doublereal *y) -#endif -{ -return( atan2(*x,*y) ); -} diff --git a/ext/spice/src/cspice/d_cnjg.c b/ext/spice/src/cspice/d_cnjg.c deleted file mode 100644 index c778c38758..0000000000 --- a/ext/spice/src/cspice/d_cnjg.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - - VOID -#ifdef KR_headers -d_cnjg(r, z) doublecomplex *r, *z; -#else -d_cnjg(doublecomplex *r, doublecomplex *z) -#endif -{ -r->r = z->r; -r->i = - z->i; -} diff --git a/ext/spice/src/cspice/d_cos.c b/ext/spice/src/cspice/d_cos.c deleted file mode 100644 index 45c4838bae..0000000000 --- a/ext/spice/src/cspice/d_cos.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double cos(); -double d_cos(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_cos(doublereal *x) -#endif -{ -return( cos(*x) ); -} diff --git a/ext/spice/src/cspice/d_cosh.c b/ext/spice/src/cspice/d_cosh.c deleted file mode 100644 index 1181833cc1..0000000000 --- a/ext/spice/src/cspice/d_cosh.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double cosh(); -double d_cosh(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_cosh(doublereal *x) -#endif -{ -return( cosh(*x) ); -} diff --git a/ext/spice/src/cspice/d_dim.c b/ext/spice/src/cspice/d_dim.c deleted file mode 100644 index 1d0ecb7bbb..0000000000 --- a/ext/spice/src/cspice/d_dim.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double d_dim(a,b) doublereal *a, *b; -#else -double d_dim(doublereal *a, doublereal *b) -#endif -{ -return( *a > *b ? *a - *b : 0); -} diff --git a/ext/spice/src/cspice/d_exp.c b/ext/spice/src/cspice/d_exp.c deleted file mode 100644 index 3f2b6ffcc4..0000000000 --- a/ext/spice/src/cspice/d_exp.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double exp(); -double d_exp(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_exp(doublereal *x) -#endif -{ -return( exp(*x) ); -} diff --git a/ext/spice/src/cspice/d_imag.c b/ext/spice/src/cspice/d_imag.c deleted file mode 100644 index 793a3f9c40..0000000000 --- a/ext/spice/src/cspice/d_imag.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double d_imag(z) doublecomplex *z; -#else -double d_imag(doublecomplex *z) -#endif -{ -return(z->i); -} diff --git a/ext/spice/src/cspice/d_int.c b/ext/spice/src/cspice/d_int.c deleted file mode 100644 index 6c0e64215d..0000000000 --- a/ext/spice/src/cspice/d_int.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -double d_int(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_int(doublereal *x) -#endif -{ -return( (*x>0) ? floor(*x) : -floor(- *x) ); -} diff --git a/ext/spice/src/cspice/d_lg10.c b/ext/spice/src/cspice/d_lg10.c deleted file mode 100644 index f03ff0043f..0000000000 --- a/ext/spice/src/cspice/d_lg10.c +++ /dev/null @@ -1,15 +0,0 @@ -#include "f2c.h" - -#define log10e 0.43429448190325182765 - -#ifdef KR_headers -double log(); -double d_lg10(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_lg10(doublereal *x) -#endif -{ -return( log10e * log(*x) ); -} diff --git a/ext/spice/src/cspice/d_log.c b/ext/spice/src/cspice/d_log.c deleted file mode 100644 index d7a1941d56..0000000000 --- a/ext/spice/src/cspice/d_log.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double log(); -double d_log(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_log(doublereal *x) -#endif -{ -return( log(*x) ); -} diff --git a/ext/spice/src/cspice/d_mod.c b/ext/spice/src/cspice/d_mod.c deleted file mode 100644 index 0d3ffbff9e..0000000000 --- a/ext/spice/src/cspice/d_mod.c +++ /dev/null @@ -1,40 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -#ifdef IEEE_drem -double drem(); -#else -double floor(); -#endif -double d_mod(x,y) doublereal *x, *y; -#else -#ifdef IEEE_drem -double drem(double, double); -#else -#undef abs -#include "math.h" -#endif -double d_mod(doublereal *x, doublereal *y) -#endif -{ -#ifdef IEEE_drem - double xa, ya, z; - if ((ya = *y) < 0.) - ya = -ya; - z = drem(xa = *x, ya); - if (xa > 0) { - if (z < 0) - z += ya; - } - else if (z > 0) - z -= ya; - return z; -#else - double quotient; - if( (quotient = *x / *y) >= 0) - quotient = floor(quotient); - else - quotient = -floor(-quotient); - return(*x - (*y) * quotient ); -#endif -} diff --git a/ext/spice/src/cspice/d_nint.c b/ext/spice/src/cspice/d_nint.c deleted file mode 100644 index 2ead3df200..0000000000 --- a/ext/spice/src/cspice/d_nint.c +++ /dev/null @@ -1,14 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -double d_nint(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_nint(doublereal *x) -#endif -{ -return( (*x)>=0 ? - floor(*x + .5) : -floor(.5 - *x) ); -} diff --git a/ext/spice/src/cspice/d_prod.c b/ext/spice/src/cspice/d_prod.c deleted file mode 100644 index 3d4cef7835..0000000000 --- a/ext/spice/src/cspice/d_prod.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double d_prod(x,y) real *x, *y; -#else -double d_prod(real *x, real *y) -#endif -{ -return( (*x) * (*y) ); -} diff --git a/ext/spice/src/cspice/d_sign.c b/ext/spice/src/cspice/d_sign.c deleted file mode 100644 index 514ff0bbff..0000000000 --- a/ext/spice/src/cspice/d_sign.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double d_sign(a,b) doublereal *a, *b; -#else -double d_sign(doublereal *a, doublereal *b) -#endif -{ -double x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); -} diff --git a/ext/spice/src/cspice/d_sin.c b/ext/spice/src/cspice/d_sin.c deleted file mode 100644 index 0013af0349..0000000000 --- a/ext/spice/src/cspice/d_sin.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sin(); -double d_sin(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_sin(doublereal *x) -#endif -{ -return( sin(*x) ); -} diff --git a/ext/spice/src/cspice/d_sinh.c b/ext/spice/src/cspice/d_sinh.c deleted file mode 100644 index 1ccd02ead9..0000000000 --- a/ext/spice/src/cspice/d_sinh.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sinh(); -double d_sinh(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_sinh(doublereal *x) -#endif -{ -return( sinh(*x) ); -} diff --git a/ext/spice/src/cspice/d_sqrt.c b/ext/spice/src/cspice/d_sqrt.c deleted file mode 100644 index bee10a3a55..0000000000 --- a/ext/spice/src/cspice/d_sqrt.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sqrt(); -double d_sqrt(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_sqrt(doublereal *x) -#endif -{ -return( sqrt(*x) ); -} diff --git a/ext/spice/src/cspice/d_tan.c b/ext/spice/src/cspice/d_tan.c deleted file mode 100644 index 23fa423188..0000000000 --- a/ext/spice/src/cspice/d_tan.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double tan(); -double d_tan(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_tan(doublereal *x) -#endif -{ -return( tan(*x) ); -} diff --git a/ext/spice/src/cspice/d_tanh.c b/ext/spice/src/cspice/d_tanh.c deleted file mode 100644 index 0363a49b1b..0000000000 --- a/ext/spice/src/cspice/d_tanh.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double tanh(); -double d_tanh(x) doublereal *x; -#else -#undef abs -#include "math.h" -double d_tanh(doublereal *x) -#endif -{ -return( tanh(*x) ); -} diff --git a/ext/spice/src/cspice/dacosh.c b/ext/spice/src/cspice/dacosh.c deleted file mode 100644 index 8af1b8f926..0000000000 --- a/ext/spice/src/cspice/dacosh.c +++ /dev/null @@ -1,178 +0,0 @@ -/* dacosh.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DACOSH ( Double precision arc hyperbolic cosine ) */ -doublereal dacosh_(doublereal *x) -{ - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double sqrt(doublereal), log(doublereal); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the inverse hyperbolic cosine of a double */ -/* precision argument. */ - -/* $ 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 */ - -/* HYPERBOLIC, MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I Number whose inverse hyperbolic cosine is desired. */ -/* X must be >= 1. */ - -/* $ Detailed_Input */ - -/* X is any double precision number greater than or equal to 1. */ - -/* $ Detailed_Output */ - -/* DACOSH is the inverse hyperbolic cosine of X. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This function simply implements the definition of the inverse */ -/* hyperbolic cosine as follows: */ - -/* DACOSH = DLOG (X + DSQRT (X*X-1.D0)) */ - -/* If the input value is not valid, an error is signalled. */ - -/* $ Examples */ - -/* The following table gives a few values for X and the resulting */ -/* value of DACOSH. */ - -/* X DACOSH(X) */ -/* ---------------------------------------------- */ -/* 1.000000000000000 0.0000000000000000E+00 */ -/* 10.00000000000000 2.993222846126381 */ -/* 100.0000000000000 5.298292365610485 */ -/* 1000.000000000000 7.600902209541989 */ - -/* $ Restrictions */ - -/* The value of the input variable X must be greater than or equal */ -/* to 1.0d0. */ - -/* $ Exceptions */ - -/* 1) If X is less than 1.0d0, the error SPICE(INVALIDARGUMENT) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.M. Owen (JPL) */ - -/* $ Literature_References */ - -/* Any good book of mathematical tables and formulae, for example */ -/* the "Standard Mathematical Tables" published by the Chemical */ -/* Rubber Company. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* d.p. arc hyperbolic_cosine */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Set up the error processing. */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } else { - chkin_("DACOSH", (ftnlen)6); - ret_val = 0.; - } - -/* Check that X >= 1. */ - - if (*x < 1.) { - setmsg_("DACOSH: Invalid argument, X is less than one.", (ftnlen)45); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DACOSH", (ftnlen)6); - return ret_val; - } - -/* Abiding by the order implied by the parentheses in the expression */ -/* (1.0D0/X)/X prevents floating point overflow that might occur for */ -/* large values of X if the equivalent expression, 1.0D0/(X*X), were */ -/* used. */ - - ret_val = log(*x + *x * sqrt(1. - 1. / *x / *x)); - chkout_("DACOSH", (ftnlen)6); - return ret_val; -} /* dacosh_ */ - diff --git a/ext/spice/src/cspice/dacosn.c b/ext/spice/src/cspice/dacosn.c deleted file mode 100644 index 3a6a51974e..0000000000 --- a/ext/spice/src/cspice/dacosn.c +++ /dev/null @@ -1,176 +0,0 @@ -/* dacosn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DACOSN (arc cosine of bracketed argument) */ -doublereal dacosn_(doublereal *arg, doublereal *tol) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - - /* Builtin functions */ - double acos(doublereal); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* This routine produces a SPICE error if the |argument| exceeds */ -/* 1.D0 by more than TOL. If ARG exceeds 1.D0, the argument is */ -/* evaluated as if it equaled 1.D0, if ARG is less than -1., */ -/* the argument is evaluated as if it equaled -1.D0. */ - -/* $ 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 */ - -/* INTERVALS, NUMBERS, UTILITY, INVERSE TRIGONOMETRIC FUNCTION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARG I Argument to be evaluated. */ -/* TOL I Tolerance. */ -/* DACOSN O The function returns the arc cosine of ARG. */ - -/* $ Detailed_Input */ - -/* ARG is the arc cosine argument that is to be evaluated */ -/* such that if it is less than -1.D0 by more than TOL */ -/* or greater than 1.D0 by more than TOL, an error */ -/* results. */ - -/* TOL is a tolerance such that |ARG| is considered to be */ -/* equal to 1.D0 if |ARG| <= 1.D0 + TOL. TOL must be */ -/* non-negative. */ - -/* $ Detailed_Output */ - -/* DACOSN The function returns the arc cosine of ARG. If |ARG| */ -/* >= 1.D0, it returns DACOS (1.D0) or DACOS (-1.D0) as */ -/* appropriate. Values range from 0 to PI. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If |ARG| > 1.D0 + TOL, the error SPICE(INPUTOUTOFBOUNDS) is */ -/* signaled. */ - -/* 2) If TOL is less than zero, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether |ARG| > 1.D0 + TOL. If */ -/* it is, an error will be flagged. In addition, */ -/* the values of ARG are constrained to [-1.D0, 1.D0]. */ - -/* $ Examples */ - -/* The following illustrate the operation of DACOSN. */ - -/* DACOSN ( -1.D0, 1.D-7 ) = PI */ -/* DACOSN ( -1.00001D0, 1.D-3 ) = PI */ -/* DACOSN ( -1.00001D0, 1.D-7 ) = PI (error flagged) */ -/* DACOSN ( 0.D0, 1.D-7 ) = PI/2 */ -/* DACOSN ( 1.00001D0, 1.D-3 ) = 0. */ -/* DACOSN ( 1.00001D0, 1.D-7 ) = 0. (error flagged) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* L.S. Elson (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 28-FEB-2006 (LSE) */ - -/* -& */ -/* $ Index_Entries */ - -/* check a d.p. argument for ACOS before evaluation */ - -/* -& */ - -/* Bracket ARG. */ - -/* Computing MAX */ - d__1 = -1., d__2 = min(1.,*arg); - ret_val = acos((max(d__1,d__2))); - -/* Check that tolerance is non negative. */ - - if (*tol < 0.) { - chkin_("DACOSN", (ftnlen)6); - setmsg_("TOL was #; must be non-negative.", (ftnlen)32); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DACOSN", (ftnlen)6); - return ret_val; - } - -/* Check to see if |ARG| is within TOL of 1.D0. Signal error if */ -/* appropriate. */ - - if (abs(*arg) - *tol > 1.) { - chkin_("DACOSN", (ftnlen)6); - setmsg_("The |argument| specified was greater than 1.D0 by more than" - " #. The value of the argument is #. ", (ftnlen)95); - errdp_("#", tol, (ftnlen)1); - errdp_("#", arg, (ftnlen)1); - sigerr_("SPICE(INPUTOUTOFBOUNDS)", (ftnlen)23); - chkout_("DACOSN", (ftnlen)6); - return ret_val; - } - return ret_val; -} /* dacosn_ */ - diff --git a/ext/spice/src/cspice/dafa2b.c b/ext/spice/src/cspice/dafa2b.c deleted file mode 100644 index 8fcb0cc506..0000000000 --- a/ext/spice/src/cspice/dafa2b.c +++ /dev/null @@ -1,271 +0,0 @@ -/* dafa2b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFA2B ( DAF, ASCII to binary ) */ -/* Subroutine */ int dafa2b_(char *ascii, char *binary, integer *resv, ftnlen - ascii_len, ftnlen binary_len) -{ - /* System generated locals */ - cllist cl__1; - - /* Builtin functions */ - integer f_clos(cllist *); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen), daft2b_(integer *, - char *, integer *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int txtopr_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Convert an ASCII (text) DAF to an equivalent binary DAF. */ -/* (Obsolete, maintained for backward compatibility only.) */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ASCII I Name of an existing ASCII (text) DAF. */ -/* BINARY I Name of a binary DAF to be created. */ -/* RESV I Number of records to reserve. */ - -/* $ Detailed_Input */ - -/* ASCII is the name of an existing ASCII (text) DAF. */ - -/* BINARY is the name of the binary DAF to be created. */ -/* The binary DAF contains the same data as the */ -/* ASCII DAF, but in a form more suitable for use */ -/* by application programs. */ - -/* RESV is the number of records to be reserved in the */ -/* binary DAF. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments ASCII, BINARY. */ - -/* $ Exceptions */ - -/* None. */ - -/* Errors are detected and signalled by routines called by this */ -/* routine. */ - -/* $ Particulars */ - -/* This routine has been made obsolete by the new DAF text to binary */ -/* conversion routine DAFTB. This routine remains available for */ -/* reasons of backward compatibility. We strongly recommend that the */ -/* conversion routine DAFTB be used for any new software development. */ -/* Please see the header of the routine DAFTB for details. */ - -/* This routine is used for converting older DAF text files, which */ -/* use a decimal format for numbers, into their equivalent binary */ -/* formats. Note that the routine DAFTB makes use of a text file */ -/* format that is incompatible with the text file format expected by */ -/* the routines called by this routine. */ - -/* Note that you must select the number of records to be reserved */ -/* in the binary DAF. The contents of reserved records are ignored */ -/* by the normal transfer process. */ - -/* $ Examples */ - -/* DAFB2A and DAFA2B are typically used to transfer files. */ -/* If file A.DAF is a binary DAF in environment 1, it */ -/* can be transferred to environment 2 in three steps. */ - -/* 1) Convert it to ASCII, */ - -/* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */ - -/* 2) Transfer the ASCII file, using FTP, Kermit, or some other */ -/* file transfer utility, */ - -/* ftp> put a.ascii */ - -/* 3) Convert it to binary on the new machine, */ - -/* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */ - -/* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */ -/* environment. */ - -/* $ Restrictions */ - -/* DAFA2B cannot be executed while any other DAF is open */ -/* for writing. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 30-SEP-1993 (KRG) */ - -/* This routine was completely rewritten to make use of the */ -/* routines DAFT2B and TXTOPR, for converting a text file to */ -/* binary and opening a text file. It now simply calls the */ -/* routine DAFT2B after opening the text file. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFTB, and that the use of the new routine is */ -/* strongly recommended for new software development. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* ascii daf to binary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 30-SEP-1993 (KRG) */ - -/* This routine was completely rewritten to make use of the */ -/* routines DAFT2B and TXTOPR, for converting a text file to */ -/* binary and opening a text file. It now simply calls the */ -/* routine DAFT2B after opening the text file. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFTB, and that the use of the new routine is */ -/* strongly recommended for new software development. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFA2B", (ftnlen)6); - } - -/* Open the ASCII file for reading. If an error occurs, then check */ -/* out and return. An appropriate error message will have already */ -/* been set. */ - - txtopr_(ascii, &unit, ascii_len); - if (failed_()) { - chkout_("DAFA2B", (ftnlen)6); - return 0; - } - -/* Call DAFT2B to perform the conversion. If it fails, then just */ -/* check out and return, as an appropriate error message should have */ -/* already been set. Also close the text file that we opened. */ - - daft2b_(&unit, binary, resv, binary_len); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFA2B", (ftnlen)6); - return 0; - } - -/* Close the file. */ - - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFA2B", (ftnlen)6); - return 0; -} /* dafa2b_ */ - diff --git a/ext/spice/src/cspice/dafac.c b/ext/spice/src/cspice/dafac.c deleted file mode 100644 index 3bef869eb0..0000000000 --- a/ext/spice/src/cspice/dafac.c +++ /dev/null @@ -1,720 +0,0 @@ -/* dafac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure DAFAC ( DAF add comments ) */ -/* Subroutine */ int dafac_(integer *handle, integer *n, char *buffer, ftnlen - buffer_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - integer free; - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen); - integer i__, j, space; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, bward, fward, recno; - logical found; - integer ncomr; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - logical empty; - integer nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - extern /* Subroutine */ int dafarr_(integer *, integer *); - char crecrd[1000]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - integer daflun, nchars; - extern integer lastnb_(char *, ftnlen); - static char eocmrk[1]; - integer length, newrec, eocpos; - static char eolmrk[1]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - integer nelpos; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer rinuse, curpos, notusd; - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___21 = { 1, 0, 1, 0, 0 }; - static cilist io___30 = { 1, 0, 0, 0, 0 }; - static cilist io___31 = { 1, 0, 0, 0, 0 }; - static cilist io___32 = { 1, 0, 0, 0, 0 }; - static cilist io___33 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Add comments from a buffer of character strings to the comment */ -/* area of a binary DAF file, appending them to any comments which */ -/* are already present in the file's comment area. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I handle of a DAF opened with write access. */ -/* N I Number of comments to put into the comment area. */ -/* BUFFER I Buffer of comments to put into the comment area. */ - -/* $ Detailed_Input */ - -/* HANDLE The file handle of a binary DAF which has been opened */ -/* with write access. */ - -/* N The number of comments in BUFFER that are to be added to */ -/* the comment area of the binary DAF attached to HANDLE. */ - -/* BUFFER A buffer containing comments which are to be added */ -/* to the comment area of the binary DAF attached to HANDLE. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of comments to be added is not positive, the */ -/* error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If a non printing ASCII character is encountered in the */ -/* comments, the error SPICE(ILLEGALCHARACTER) will be */ -/* signalled. */ - -/* 3) If the binary DAF file attached to HANDLE is not open with */ -/* write access an error will be signalled by a routine called */ -/* by this routine. */ - -/* 4) If the end of the comments cannot be found, i.e., the end of */ -/* comments marker is missing on the last comment record, the */ -/* error SPICE(BADCOMMENTAREA) will be signalled. */ - -/* $ Files */ - -/* See argument HANDLE in $ Detailed_Input. */ - -/* $ Particulars */ - -/* A binary DAF contains a data area which is reserved for storing */ -/* annotations or descriptive textual information about the data */ -/* contained in a file. This area is referred to as the ``comment */ -/* area'' of the file. The comment area of a DAF is a line oriented */ -/* medium for storing textual information. The comment area */ -/* preserves leading or embedded white space in the line(s) of text */ -/* which are stored so that the appearance of the information will */ -/* be unchanged when it is retrieved (extracted) at some other time. */ -/* Trailing blanks, however, are NOT preserved, due to the way that */ -/* character strings are represented in standard Fortran 77. */ - -/* This routine will take a buffer of text lines and add (append) */ -/* them to the comment area of a binary DAF. If there are no */ -/* comments in the comment area of the file, then space will be */ -/* allocated and the text lines in BUFFER will be placed into the */ -/* comment area. The text lines may contain only printable ASCII */ -/* characters (decimal values 32 - 126). */ - -/* There is NO maximum length imposed on the significant portion */ -/* of a text line that may be placed into the comment area of a */ -/* DAF. The maximum length of a line stored in the comment area */ -/* should be reasonable, however, so that they may be easily */ -/* extracted. A good maximum value for this would be 255 characters, */ -/* as this can easily accommodate ``screen width'' lines as well as */ -/* long lines which may contain some other form of information. */ - -/* $ Examples */ - -/* Let */ - -/* HANDLE be the handle for a DAF which has been opened with */ -/* write access. */ - -/* N be the number of lines of text to be added to the */ -/* comment area of the binary DAF attached to HANDLE. */ - -/* BUFFER is a list of text lines to be added to the comment */ -/* area of the binary DAF attached to HANDLE. */ - -/* The call */ - -/* CALL DAFAC ( HANDLE, N, BUFFER ) */ - -/* will append the first N line(s) in BUFFER to the comment area */ -/* of the binary DAF attached to HANDLE. */ - -/* $ Restrictions */ - -/* 1) This routine uses constants that are specific to the ASCII */ -/* character sequence. The results of using this routine with */ -/* a different character sequence are unpredictable. */ - -/* 2) This routine is only used to extract records on environments */ -/* whose characters are a single byte in size. Updates to this */ -/* routine and routines in its call tree may be required to */ -/* properly handle other cases. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Support Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to utilize the new handle manager */ -/* interfaces. */ - -/* - Beta Version 1.0.0, 26-JUL-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* add comments to a binary daf file */ -/* append comments to a daf file comment area */ - -/* -& */ -/* $ Revisions */ - -/* - Support Version 2.0.0, 16-NOV-2001 (FST) */ - -/* The call to DAFHLU has been replaced with a call to ZZDDHHLU, */ -/* the handle manager interface for retrieving a logical unit. */ -/* DAFHLU is no longer used, since it locks the unit returned to */ -/* its HANDLE, tying up resources in the handle manager. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Length of a DAF file internal filename. */ - - -/* Decimal value for the DAF comment area end-of-comment (EOC) */ -/* marker. */ - - -/* Decimal value for the DAF comment area end-of-line (EOL) marker. */ - - -/* Length of a DAF character record, in characters. */ - - -/* Maximum and minimum decimal values for the printable ASCII */ -/* characters. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFAC", (ftnlen)5); - } - -/* The lines of text in BUFFER will be ``packed'' into DAF comment */ -/* records: the significant portion of each comment line from BUFFER */ -/* will be terminated using the special character EOLMRK to indicate */ -/* the end of the line. When a comment record is full or all of the */ -/* comments have been added, the comment record will be written to */ -/* the comment area of the binary DAF file. */ - -/* If this is the first time that this routine has been called, */ -/* we need to initialize the character value for the end-of-line */ -/* marker and the character value for the end of comments marker. */ - - if (first) { - first = FALSE_; - *(unsigned char *)eocmrk = '\4'; - *(unsigned char *)eolmrk = '\0'; - } - -/* Verify that the DAF file attached to HANDLE is opened with write */ -/* access. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFAC", (ftnlen)5); - return 0; - } - -/* Convert the DAF file handle to its corresponding Fortran logical */ -/* unit number for reading and writing comment records. */ - - zzddhhlu_(handle, "DAF", &c_false, &daflun, (ftnlen)3); - if (failed_()) { - chkout_("DAFAC", (ftnlen)5); - return 0; - } - -/* Check for a nonpositive number of lines in the buffer. */ - - if (*n <= 0) { - setmsg_("The number of comment lines to be added to the binary DAF f" - "ile '#' was not positive: #.", (ftnlen)87); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - -/* Count the number of characters in the buffer ignoring trailing */ -/* blanks on nonblank lines and blank lines. The count will be */ -/* modified to include the contribution of blank lines later. This */ -/* count is used to determine the number of character records to be */ -/* added to the binary DAF file attached to HANDLE. */ - - nchars = 0; - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the length of the significant portion of a comment line. */ - - length = lastnb_(buffer + (i__ - 1) * buffer_len, buffer_len); - -/* Scan the comment line for non printing characters. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* Check to see that the characters in the buffer are all */ -/* printing ASCII characters. The bounds for printing ASCII */ -/* characters are given by MINPCH and MAXPCH, which are */ -/* defined in the $ Local Parameters section of the header. */ - - if (*(unsigned char *)&buffer[(i__ - 1) * buffer_len + (j - 1)] > - 126 || *(unsigned char *)&buffer[(i__ - 1) * buffer_len + - (j - 1)] < 32) { - setmsg_("A nonprinting character was encountered in the comm" - "ent buffer. Value: #", (ftnlen)71); - i__3 = *(unsigned char *)&buffer[(i__ - 1) * buffer_len + (j - - 1)]; - errint_("#", &i__3, (ftnlen)1); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - } - -/* Increment the number of characters by the length of the */ -/* significant portion of the current line in the buffer. */ - - nchars += length; - } - -/* We need to include the number of end of line markers in the */ -/* number of characters, so add the number of comment lines to */ -/* be added, N, to the number of characters, NCHARS. This is where */ -/* the contribution of any blank lines gets added to the character */ -/* count. We also need to have space for the end of comments marker. */ - - nchars = nchars + *n + 1; - -/* Get the current number of comment records and comment characters */ -/* from the DAF file attached to HANDLE. We will also get back some */ -/* extra stuff that we do not use. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFAC", (ftnlen)5); - return 0; - } - -/* Compute the number of comment records and the number of comment */ -/* characters. In order to perform these calculations, we assume */ -/* that we have a valid comment area in the DAF file attached to */ -/* HANDLE. */ - - ncomr = fward - 2; - if (ncomr > 0) { - -/* The starting record number is the number of comment records + 1 */ -/* where the 1 skips the file record. */ - - empty = TRUE_; - found = FALSE_; - notusd = 0; - while(ncomr > 0 && ! found && empty) { - recno = ncomr + 1; - io___21.ciunit = daflun; - io___21.cirec = recno; - iostat = s_rdue(&io___21); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Error reading comment area of binary file named '#'" - ". IOSTAT = #.", (ftnlen)65); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - -/* Scan the comment record looking for the end of comments */ -/* marker. */ - - eocpos = cpos_(crecrd, eocmrk, &c__1, (ftnlen)1000, (ftnlen)1); - if (eocpos > 0) { - found = TRUE_; - } else { - nelpos = ncpos_(crecrd, eolmrk, &c__1, (ftnlen)1000, (ftnlen) - 1); - if (nelpos != 0) { - empty = FALSE_; - } else { - --ncomr; - ++notusd; - } - } - } - -/* If we do not find the end of comments marker and the comment */ -/* area is not empty, then it is an error. */ - - if (! found && ! empty) { - setmsg_("The comment area in the DAF file '#' may be damaged. Th" - "e end of the comments could not be found.", (ftnlen)96); - errfnm_("#", &daflun, (ftnlen)1); - sigerr_("SPICE(BADCOMMENTAREA)", (ftnlen)21); - chkout_("DAFAC", (ftnlen)5); - return 0; - } else if (found) { - ncomc = (ncomr - 1) * 1000 + eocpos - 1; - } else if (empty) { - ncomc = 0; - } - } else { - ncomc = 0; - notusd = 0; - } - -/* Determine the amount of free space in the comment area. If */ -/* there are some comment records allocated, the space available */ -/* is the number of comment records allocated times the length of */ -/* a comment record, minus the number of comment characters already */ -/* used. Otherwise, the space available is zero. */ - - if (ncomr + notusd > 0) { - space = notusd * 1000 + ncomr * 1000 - ncomc; - } else { - space = 0; - } - -/* Determine the number of new comment records which are necessary */ -/* to store all of the comments from the buffer. */ - - if (nchars > space) { - -/* If there are more characters to store than available space */ -/* we need at least one new record. */ - - newrec = (nchars - space - 1) / 1000 + 1; - } else { - -/* Otherwise, we do not need any new records. */ - - newrec = 0; - } - -/* Now add the necessary number of comment records to the file, */ -/* if we need to add any. */ - - if (newrec > 0) { - dafarr_(handle, &newrec); - if (failed_()) { - chkout_("DAFAC", (ftnlen)5); - return 0; - } - } - -/* At this point, we know that we have enough space to write all of */ -/* the comments in BUFFER to the comment area. Either there was */ -/* enough space already there, or we calculated how many new comment */ -/* records were needed, and we added them to the file. So, now we */ -/* begin ``packing'' the comments into DAF comment records and */ -/* writing them to the file. */ - -/* We begin initializing the appropriate variables. */ - - if (ncomc == 0) { - -/* If there are no comments in the comment area, then we need */ -/* to skip the file record. The first available comment record */ -/* is therecord immediately after the file record, so we set */ -/* RECNO accordingly. We also initialize the current position in */ -/* the comment record, and the comment record itself. */ - - recno = 2; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } else { - -/* If there are comments in the comment area, then we need to */ -/* skip the file record and any comment records which have been */ -/* filled. The first comment record with space available is the */ -/* record immediately following the last completely filled */ -/* comment record. So calculate the number of comment records */ -/* in use, and set RECNO appropriately. Finally calculate the */ -/* initial position. */ - - rinuse = ncomc / 1000 + 1; - recno = rinuse + 1; - curpos = ncomc - (rinuse - 1) * 1000 + 1; - } - -/* Begin ``packing'' the comments from the input buffer into the */ -/* comment records, writing the comment records to the file as they */ -/* become filled. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the length of the significant portion of comment line I. */ - - length = lastnb_(buffer + (i__ - 1) * buffer_len, buffer_len); - -/* Process the comment line. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* If we have filled the comment record while processing */ -/* comment line BUFFER(I), write out the comment record, */ -/* increment the record number, RECNO, and reset the values */ -/* of the current position and the comment record. */ - - if (curpos > 1000) { - io___30.ciunit = daflun; - io___30.cirec = recno; - iostat = s_wdue(&io___30); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - setmsg_("Error writing to record # of the binary file na" - "med '#'. IOSTAT = #.", (ftnlen)67); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - ++recno; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)&buffer[ - (i__ - 1) * buffer_len + (j - 1)]; - ++curpos; - } - -/* Check to see if we happened to exactly fill the comment record */ -/* when we finished processing comment line BUFFER(I). If we */ -/* did, CURPOS will be 1 greater than MXCREC, and we will need */ -/* to write the comment record to the file, increment the record */ -/* number, RECNO, and reset the values of the current position */ -/* and the comment record. */ - - if (curpos > 1000) { - io___31.ciunit = daflun; - io___31.cirec = recno; - iostat = s_wdue(&io___31); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100003; - } - iostat = e_wdue(); -L100003: - if (iostat != 0) { - setmsg_("Error writing to record # of the binary file named " - "'#'. IOSTAT = #.", (ftnlen)67); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - ++recno; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } - -/* Append the end-of-line marker to the comment line that we just */ -/* placed into the comment record. */ - - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)eolmrk; - ++curpos; - } - -/* We have now finished processing all of the comment lines in */ -/* BUFFER, so we need write the current record to the file. This */ -/* record will always contain something, so we always need to write */ -/* it. */ - - if (curpos > 1000) { - -/* If we have completely filled the comment record, the last */ -/* character of the last line n the buffer coincides with the */ -/* last character in the comment record, then we need to write */ -/* the record and get set up to add the end of comments mark on */ -/* the next record. */ - - io___32.ciunit = daflun; - io___32.cirec = recno; - iostat = s_wdue(&io___32); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100004; - } - iostat = e_wdue(); -L100004: - if (iostat != 0) { - setmsg_("Error writing to record # of the binary file named '#'." - " IOSTAT = #.", (ftnlen)67); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - ++recno; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } - -/* Add the end of comments mark to the final comment record and */ -/* write it to the file. */ - - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)eocmrk; - io___33.ciunit = daflun; - io___33.cirec = recno; - iostat = s_wdue(&io___33); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100005; - } - iostat = e_wdue(); -L100005: - if (iostat != 0) { - setmsg_("Error writing to record # of the binary file named '#'. IOS" - "TAT = #.", (ftnlen)67); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFAC", (ftnlen)5); - return 0; - } - -/* Check out and leave DAFAC. */ - - chkout_("DAFAC", (ftnlen)5); - return 0; -} /* dafac_ */ - diff --git a/ext/spice/src/cspice/dafac_c.c b/ext/spice/src/cspice/dafac_c.c deleted file mode 100644 index befadaff63..0000000000 --- a/ext/spice/src/cspice/dafac_c.c +++ /dev/null @@ -1,258 +0,0 @@ -/* - --Procedure dafac_c ( DAF add comments ) - --Abstract - - Add comments from a buffer of character strings to the comment - area of a binary DAF file, appending them to any comments which - are already present in the file's comment area. - --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 - - DAF - --Keywords - - FILES - UTILITY - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #undef dafac_c - - void dafac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt lenvals, - const void * buffer ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I handle of a DAF opened with write access. - n I Number of comments to put into the comment area. - lenvals I Length of elements - buffer I Buffer of comments to put into the comment area. - --Detailed_Input - - handle is the file handle of a binary DAF which has been opened - with write access. - - n is the number of rows in the array `buffer'. This is - also the number of comment lines in `buffer' that are to be - added to the comment area of the binary DAF attached to - `handle'. - - buffer A string buffer containing comments which are to be added - to the comment area of the binary DAF attached to `handle'. - buffer should be declared by the caller has follows: - - SpiceChar buffer[n][lenvals]; - - Each row of the buffer should contain one comment line. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the number of comments to be added is not positive, the - error SPICE(INVALIDARGUMENT) will be signaled. - - 2) If a non printing ASCII character is encountered in the - comments, the error SPICE(ILLEGALCHARACTER) will be signaled. - - 3) If the binary DAF file attached to HANDLE is not open with - write access an error will be signalled by a routine called by - this routine. - - 4) If the end of the comments cannot be found, i.e., the end of - comments marker is missing on the last comment record, the error - SPICE(BADCOMMENTAREA) will be signaled. - - 5) If the input pointer `buffer' is null, the error - SPICE(NULLPOINTER) will be signaled. - - 6) If the input buffer string length indicated by `lenvals' - is less than 2, the error SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See argument `handle' in $ Detailed_Input. - --Particulars - - A binary DAF contains a data area which is reserved for storing - annotations or descriptive textual information about the data - contained in a file. This area is referred to as the ``comment - area'' of the file. The comment area of a DAF is a line oriented - medium for storing textual information. The comment area preserves - leading or embedded white space in the line(s) of text which are - stored so that the appearance of the information will be unchanged - when it is retrieved (extracted) at some other time. Trailing - blanks, however, are NOT preserved, due to the way that character - strings are represented in standard Fortran 77. - - This routine will take a buffer of text lines and add (append) them - to the comment area of a binary DAF. If there are no comments in the - comment area of the file, then space will be allocated and the text - lines in `buffer' will be placed into the comment area. The text lines - may contain only printable ASCII characters (decimal values 32 - - 126). - - There is NO maximum length imposed on the significant portion of a - text line that may be placed into the comment area of a DAF. The - maximum length of a line stored in the comment area should be - reasonable, however, so that they may be easily extracted. A good - maximum value for this would be 255 characters, as this can easily - accommodate ``screen width'' lines as well as long lines which may - contain some other form of information. - --Examples - - 1) Let - - handle be the handle for a DAF which has been opened with - write access. - - n be the number of lines of text to be added to the - comment area of the binary DAF attached to handle. - - lenvals be the length of the rows of a string buffer. - - buffer is an array of text lines to be added to the comment - area of the binary DAF attached to handle. `buffer' - normally is declared - - SpiceChar buffer [n][lenvals]; - - The call - - dafac_c ( handle, n, lenvals, buffer ); - - will append the first n line(s) in `buffer' to the comment area - of the binary DAF attached to `handle'. - --Restrictions - - 1) This routine uses constants that are specific to the ASCII - character sequence. The results of using this routine with - a different character sequence are unpredictable. - - 2) This routine is only used to extract records on environments - whose characters are a single byte in size. Updates to this - routine and routines in its call tree may be required to - properly handle other cases. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.0, 16-NOV-2006 (NJB) (KRG) - --Index_Entries - - add comments to a binary daf file - append comments to a daf file comment area - --& -*/ - -{ /* Begin dafac_c */ - - - /* - Local variables - */ - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - chkin_c ( "dafac_c" ); - - - /* - Make sure the input string pointer for the `buffer' array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "dafac_c", buffer, lenvals ); - - /* - The input buffer contains C-style strings; we must pass a - Fortran-style buffer to dafac_. - */ - C2F_MapStrArr ( "dafac_c", - n, lenvals, buffer, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - chkout_c ( "dafac_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - dafac_ ( ( integer * ) &handle, - ( integer * ) &n, - ( char * ) fCvalsArr, - ( ftnlen ) fCvalsLen ); - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - - chkout_c ( "dafac_c" ); - -} /* End dafac_c */ diff --git a/ext/spice/src/cspice/dafah.c b/ext/spice/src/cspice/dafah.c deleted file mode 100644 index 96ca0a9c60..0000000000 --- a/ext/spice/src/cspice/dafah.c +++ /dev/null @@ -1,4965 +0,0 @@ -/* dafah.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1000 = 1000; -static logical c_false = FALSE_; -static integer c__2 = 2; -static integer c__124 = 124; -static integer c__250 = 250; -static integer c__125 = 125; -static integer c__128 = 128; -static integer c__1 = 1; -static logical c_true = TRUE_; - -/* $Procedure DAFAH ( DAF, assign handles ) */ -/* Subroutine */ int dafah_0_(int n__, char *fname, char *ftype, integer *nd, - integer *ni, char *ifname, integer *resv, integer *handle, integer * - unit, integer *fhset, char *access, ftnlen fname_len, ftnlen - ftype_len, ftnlen ifname_len, ftnlen access_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer nft = 0; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2], i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - integer s_wdue(cilist *), do_uio(integer *, char *, ftnlen), e_wdue(void); - - /* Local variables */ - static integer ibff; - static char crec[1000]; - static doublereal drec[128]; - static integer iarc, iamh, free, ftnd[1000], ftni[1000]; - extern /* Subroutine */ int zzdafgfr_(integer *, char *, integer *, - integer *, char *, integer *, integer *, integer *, logical *, - ftnlen, ftnlen), zzddhfnh_(char *, integer *, logical *, ftnlen), - zzdafnfr_(integer *, char *, integer *, integer *, char *, - integer *, integer *, integer *, char *, ftnlen, ftnlen, ftnlen), - zzddhcls_(integer *, char *, logical *, ftnlen), zzddhnfo_( - integer *, char *, integer *, integer *, integer *, logical *, - ftnlen), zzddhhlu_(integer *, char *, logical *, integer *, - ftnlen), zzddhluh_(integer *, integer *, logical *), zzddhopn_( - char *, char *, char *, integer *, ftnlen, ftnlen, ftnlen), - zzplatfm_(char *, char *, ftnlen, ftnlen); - static integer i__; - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer bward, fthan[1000]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static integer fward; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static logical found; - static integer ftlnk[1000]; - extern /* Subroutine */ int copyi_(integer *, integer *); - extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static char ttype[4]; - extern logical failed_(void); - static char dafnam[255]; - extern /* Subroutine */ int cleard_(integer *, doublereal *), dafrwa_( - integer *, integer *, integer *); - static integer findex; - extern integer isrchi_(integer *, integer *, integer *); - static char format[8], idword[8]; - static integer fhlist[1006]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), errfnm_(char *, integer *, ftnlen), removi_(integer *, - integer *), setmsg_(char *, ftnlen); - static integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), ssizei_( - integer *, integer *), insrti_(integer *, integer *); - extern logical return_(void); - static char acc[10]; - static integer fnb, fnd; - static char ifn[60]; - static integer fni, lun; - - /* Fortran I/O blocks */ - static cilist io___25 = { 1, 0, 0, 0, 0 }; - static cilist io___26 = { 1, 0, 0, 0, 0 }; - static cilist io___27 = { 1, 0, 0, 0, 0 }; - static cilist io___28 = { 1, 0, 0, 0, 0 }; - static cilist io___29 = { 1, 0, 0, 0, 0 }; - static cilist io___30 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Assign handles to DAFs as they are opened. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I,O OPR, OPW, ONW, OPN (Obsolete), HFN, FNH */ -/* FTYPE I ONW */ -/* ND I,O ONW, OPN (Obsolete), HSF */ -/* NI I,O ONW, OPN (Obsolete), HSF */ -/* IFNAME I ONW, OPN (Obsolete) */ -/* RESV I ONW, OPN (Obsolete) */ -/* HANDLE I,O OPR, OPW, ONW, OPN (Obsolete), CLS, HLU, LUH, HFN, */ -/* FNH, SIH */ -/* UNIT I,O HLU, LUH */ -/* FHSET O HOF */ -/* ACCESS I SIH */ -/* RECL P OPR, OPW, ONW, OPN (Obsolete) */ -/* FTSIZE P OPR, OPW, ONW, OPN (Obsolete), CLS, HLU, LUH, HFN, */ -/* FNH */ -/* FILEN P SIH */ - -/* $ Detailed_Input */ - -/* FNAME on input is the name of a DAF to be opened, or */ -/* the name of a DAF about which some information */ -/* (handle, logical unit) is requested. */ - -/* FTYPE on input is a code for the type of data that is */ -/* contained in the DAF file. This code has no meaning or */ -/* interpretation at the level of the DAF file */ -/* architecture, but is provided as a convenience for */ -/* higher level software. The maximum length for the file */ -/* type is four (4) characters. If the input string is */ -/* longer than four characters, the first nonblank */ -/* character and its three, or fewer, immediate nonblank */ -/* successors will be used as the file type. The file */ -/* type may not contain nonprinting characters, and it IS */ -/* case sensitive. */ - -/* NAIF has reserved for its own use file types */ -/* consisting of the upper case letters (A-Z) and the */ -/* digits 0-9. NAIF recommends lower case or mixed case */ -/* file types be used by all others in order to avoid */ -/* any conflicts with NAIF file types. */ - -/* ND on input is the number of double precision components */ -/* in each array summary of a new file. */ - -/* NI on input is the number of integer components in each */ -/* array summary in a new file. */ - -/* IFNAME is the internal file name for a DAF to be created. */ - -/* RESV is the number of records to be reserved in a DAF */ -/* to be created. */ - -/* HANDLE on input is the handle of a DAF about which some */ -/* information (file name, logical unit) is requested, */ -/* or the handle of a DAF to be closed. */ - -/* UNIT on input is the logical unit connected to a DAF */ -/* about which some information (file name, handle) is */ -/* requested. */ - -/* ACCESS is the type of access a DAF is open for, that is, */ -/* either reading or writing. The values of ACCESS */ -/* may be */ - -/* 'READ' */ -/* 'WRITE' */ - -/* Leading and trailing blanks are ignored, and case */ -/* is not significant. */ - -/* $ Detailed_Output */ - -/* FNAME on output is the name of a DAF for which */ -/* the corresponding handle or logical unit has been */ -/* supplied. */ - -/* ND on output is the number of double precision */ -/* components in each array summary of an existing file. */ - -/* NI on output is the number of integer components in */ -/* each array summary in an existing file. */ - -/* HANDLE on output is the handle of a DAF for which */ -/* the corresponding file name or logical unit has been */ -/* supplied. */ - -/* UNIT on output is the logical unit connected to a DAF */ -/* for which the corresponding file name or handle has */ -/* been supplied. */ - -/* FHSET is a SPICELIB set containing the handles of the */ -/* currently open DAFs. */ - -/* $ Parameters */ - -/* RECL is the record length of a DAF. Each record */ -/* must be large enough to hold 128 double */ -/* precision numbers or 1000 characters, whichever */ -/* is greater. The units in which the record length */ -/* must be specified vary from environment to */ -/* environment. For example, VAX Fortran requires */ -/* record lengths to be specified in longwords, */ -/* where two longwords equal one double precision */ -/* number. See the include file 'zzddhman.inc' for */ -/* details. */ - -/* FTSIZE is the size of the file table maintained internally */ -/* by DAFAH. In effect, FTSIZE is the maximum number */ -/* of DAFs that the DAF routines allow to be open */ -/* simultaneously. See the include file 'zzddhman.inc' */ -/* for details. */ - -/* FILEN is the maximum filename length. See the include file */ -/* 'zzddhman.inc' for details. */ - - -/* INTEOC is the ASCII decimal integer code of the character */ -/* recognized by SPICE as representing the end of the */ -/* comment data in the reserved record area. */ - - -/* $ Files */ - -/* All DAFs opened by this routine are specified by name. */ - -/* $ Exceptions */ - -/* 1) If DAFAH is called directly, the error SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* 2) See entry points DAFOPR, DAFOPW, DAFONW, DAFOPN, DAFCLS, */ -/* DAFHSF, DAFHLU, DAFLUH, DAFHFN, DAFNFH, DAFHOF, and DAFSIH for */ -/* exceptions specific to those entry points. */ - -/* $ Particulars */ - -/* DAFAH serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* DAFOPR Open for read. */ -/* DAFOPW Open for write. */ -/* DAFONW Open new. */ -/* DAFOPN Open new. (Obsolete, use DAFONW ) */ - -/* DAFCLS Close. */ - -/* DAFHSF Handle to summary format. */ - -/* DAFHLU Handle to logical unit. */ -/* DAFLUH Logical to handle. */ - -/* DAFHFN Handle to name. */ -/* DAFFNH File name to handle. */ - -/* DAFHOF Handles of open files. */ -/* DAFSIH Signal invalid handles. */ - -/* Before a DAF can be used, it must be opened. Entry points */ -/* DAFOPR and DAFOPW provide the only means for opening an */ -/* existing DAF. */ - -/* Several files may be opened for use simultaneously. (This makes */ -/* it convenient to combine data from several files to produce a */ -/* single result.) As each DAF is opened, it is assigned a file */ -/* handle, which is used to keep track of the file internally, and */ -/* which is used by the calling program to refer to the file in all */ -/* subsequent calls to DAF routines. */ - -/* DAFs may be opened for two kinds of access: read, and write. */ -/* Files opened for read access may not be changed in any way. Files */ -/* opened for write access may be both read and written. */ - -/* DAFONW is used to open a new DAF file. This routine extends the */ -/* functionality of DAFOPN by providing a mechanism for associating a */ -/* type with the data in the DAF file. The use of this entry over */ -/* DAFOPN is highly recommended. */ - -/* Since the only reason for creating a new file is to write */ -/* something in it, all new files are opened for write access. */ - -/* Entry point DAFOPN, for opening a new DAF file, has been rendered */ -/* obsolete by the new entry point DAFONW. The entry point DAFOPN */ -/* will continue to be supported for purposes of backward */ -/* compatibility, but its use in new software development is */ -/* discouraged. */ - -/* Entry point DAFCLS provides the only official means of closing */ -/* a DAF that is currently open. Closing a DAF any other way (for */ -/* example, by determining its logical unit and using the Fortran */ -/* CLOSE statement directly) may affect your calling program in */ -/* mysterious ways. */ - -/* Entry point DAFHSF allows you to determine the summary format */ -/* of any DAF that is currently open, without calling DAFRFR to */ -/* re-read the file record. */ - -/* Entry point DAFHOF allows you to determine which DAFs are open */ -/* at any time. In particular, you can use DAFHOF to determine */ -/* whether any file handle points to an open DAF. */ - -/* Entry point DAFSIH signals errors when it is supplied with invalid */ -/* handles, so it serves to centralize error handling associated */ -/* with invalid handles. */ - -/* The remaining entry points exist mainly to translate between */ -/* alternative representations of DAFs. There are three ways to */ -/* identify any open DAF: by name, by handle, and by logical */ -/* unit. Given any one of these, you may use these entry points to */ -/* find the other two. */ - -/* $ Examples */ - -/* See entry points DAFOPR, DAFOPW, DAFONW, DAFOPN, DAFCLS, DAFHSF, */ -/* DAFHLU, DAFLUH, DAFHFN, DAFNFH, DAFHOF, and DAFSIH for examples */ -/* specific to those entry points. */ - -/* $ Restrictions */ - -/* 1) The value of parameter RECL may need to be changed when DAFAH */ -/* and its entry points are ported to a new environment (CPU and */ -/* compiler). */ - -/* 2) An integer overflow may occur if the number of files opened */ -/* by a single program exceeds the maximum number that can be */ -/* stored in an integer variable. */ - -/* $ Literature_References */ - -/* 1) NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* 2) Sun Fortran Programmer's Guide */ - -/* 3) Microsoft Fortran Optimizing Compiler User's Guide */ - -/* 4) Lahey F77 EM/32 Language Reference Manual, page 144 */ - -/* 5) Language Systems FORTRAN Reference Manual, Version 1.2, */ -/* page 12-7 */ - -/* 6) "FORTRAN/9000 Reference HP 9000 Series 700 Computers", */ -/* First Edition, June 1991, Hewlett Packard Company, page 5-110. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 9.0.0, 09-NOV-2006 (NJB) */ - -/* Updated the entry point DAFONW so that a non-empty reserved */ -/* record area will also be a valid empty comment area. DAFONW */ -/* now writes a EOC character to the first byte of the second */ -/* record when the input number of reserved records NRESV is */ -/* greater than zero. */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* Updated the following entry points in response to changes */ -/* to the handle manager interfaces: */ - -/* DAFCLS */ -/* DAFOPR */ -/* DAFOPW */ -/* DAFONW */ -/* DAFOPN */ - -/* See the Revisions section for details. */ - -/* Minor bug fix to DAFFNH. An error was signaled but the */ -/* intended call to CHKOUT and RETURN statement were omitted. */ - -/* - SPICELIB Version 8.0.0, 14-NOV-2000 (FST) */ - -/* Cleaned up entry point headers by removing duplicate */ -/* entries from the Revisions section where appropriate. */ - -/* Integrated the new handle manager code into this module. */ -/* The number of DAFs the system can load is now 1000, */ -/* and some supported environments can read non-native */ -/* binary DAFs. See the Convert User's Guide for details. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 22-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 7.0.0, 22-MAR-1999 (FST) */ - -/* To accommodate the DAF FTP validation check, the following */ -/* entry points were modified: */ - -/* DAFOPR, DAFOPW, DAFONW, DAFOPN. */ - -/* See their headers and code for the details of the changes. */ - -/* - SPICELIB Version 6.0.0, 05-APR-1998 (NJB) */ - -/* Added references to the PC-LINUX environment. */ - -/* - SPICELIB Version 5.1.0, 08-MAR-1996 (KRG) */ - -/* The Following entry points have been modified: DAFONW and */ -/* DAFOPN. */ - -/* The modifications support the notion of a DAF comment area, */ -/* and involve writing NULL filled reserved records when the */ -/* number of reserved records is greater than zero (0). */ - -/* Some nested IF...THEN...ELSE IF...THEN...END IF constructs */ -/* were expanded to be independent IF...THEN...END IF tests. */ -/* The tests were for IOSTAT errors on cascading write statements */ -/* nested in the IF...ELSE IF... statements, and this was */ -/* confusing. These tests were restructured so that IOSTAT is */ -/* tested after each write statement which is equicalent to the */ -/* original intent and easier to read. */ - -/* - SPICELIB Version 5.0.0, 27-SEP-1993 (KRG) */ - -/* The following entry points have had code modifications: */ -/* DAFOPR, DAFOPW and DAFOPN. */ - -/* A new entry point has been added: DAFONW. */ - -/* The modifications are to allow a type to be associated with a */ -/* DAF file. */ - -/* A new parameter has been added to this subroutine's parameter */ -/* list, FTYPE, so that type information may be passed to the */ -/* entry point DAFONW. Two new variables were added to the */ -/* routine as well, TARCH and TTYPE, which provide temporary */ -/* storage for the file architecture and type. */ - -/* Several new parameters have been added to the declarations for */ -/* this routine: */ - -/* ARCLEN The length of a file architecture. */ - -/* MAXPC The maximum decimal value for the range of */ -/* printable characters. */ - -/* MINPC The minimum decimal value for the range of */ -/* printable characters. */ - -/* TYPLEN The length of a file type. */ - -/* See the individual entry points for detailed descriptions of */ -/* their modifications. */ - -/* Removed the variables MINHAN and NIL, as they were not used in */ -/* any of the entry points, yet they had values assigned to them */ -/* through DATA statements. */ - -/* Made all occurrences of error message formatting of filenames */ -/* consistent. All filenames will be single quoted in the output */ -/* error message. */ - -/* - SPICELIB Version 4.0.0, 25-FEB-1993 (JML) */ - -/* In the entry points DAFOPR, DAFOPW, and DAFFNH, the INQUIRE */ -/* statement that checks if the file is already open now also */ -/* checks that the file exists. */ - -/* IOSTAT is now checked after all INQUIRE statements. */ - -/* A new variable LUN is used in DAFOPR, DAFOPW, and DAFOPN */ -/* for the logical unit number returned by GETLUN. */ - -/* The IF-THEN statements in DAFOPR and DAFOPW were reorganized */ -/* to make the routines more readable. */ - -/* In DAFOPR and DAFOPW, a long error message was added for the */ -/* case when the NAIF/DAF id word was not recognized. Also, the */ -/* file is closed when this error is signalled. */ - -/* In DAFOPR and DAFOPW, IOSTAT is now checked after the file */ -/* record is read. */ - -/* In DAFOPR, DAFOPW, DAFOPN, and DAFFNH, the file name is */ -/* checked to see if it is blank. */ - -/* In DAFOPR, DAFOPW, DAFOPN, and DAFFNH, the file name passed */ -/* to the FORTRAN OPEN and INQUIRE statements has been chopped */ -/* at the last non-blank character. */ - -/* A minor error in the particulars section of the header of */ -/* DAFCLS was corrected. It formerly stated that a file could be */ -/* open more than once for read or write access instead of just */ -/* read access. */ - -/* - SPICELIB Version 3.2.0, 6-OCT-1992 (HAN) */ - -/* Module was updated to include the record length and source */ -/* for the Hewlett Packard UX 9000/750 environment. Moved FILEN */ -/* to the Declarations section, and corrected Revisions section */ -/* to include the last code change description, 3.1.0. */ - -/* - SPICELIB Version 3.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 3.1.0, 13-NOV-1991 (MJS) */ - -/* Module was updated to operate in the Lahey F77 EM/32 */ -/* PC environment. */ - -/* - SPICELIB Version 3.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* DAFAH and its entry points were modified to permit multiple */ -/* DAFs to be open for writing at the same time. Also, the */ -/* entry points DAFHOF and DAFSIH were added. */ - -/* - SPICELIB Version 2.0.0, 25-MAR-1991 (JEM) (MJS) */ - -/* The variable MINHAN was initialized to zero and the variable */ -/* NEXT was saved. DAFOPW now accepts the ID word 'NAIF/NIP' */ -/* as well 'NAIF/DAF'. Spelling mistakes were corrected. */ - -/* - SPICELIB Version 1.1.0, 5-NOV-1990 (HAN) */ - -/* The parameter FTSIZE was increased from 4 to 20. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* assign daf handles */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* The entry point ZZDDHCLS in the handle manager (ZZDDHMAN) */ -/* had its argument list augmented to allow files to be */ -/* deleted on close. This allows the removal of a series */ -/* of "raw" CLOSE statements in a few of the entry points */ -/* of this routine. */ - -/* - SPICELIB Version 8.0.0, 14-NOV-2001 (FST) */ - -/* The DAF system now utilizes the handle manager umbrella */ -/* (ZZDDHMAN) and its entry points to provide most of the */ -/* handle and logical unit based operations that DAFAH */ -/* previously managed. */ - -/* FTSIZE Files with UTSIZE Units: */ - -/* In previous versions of the DAF system all files opened */ -/* through the DAFAH entry points were connected to logical */ -/* units. In contrast, the handle manager umbrella entry */ -/* points allow FTSIZE files to be loaded (opened), while */ -/* only utilizing UTSIZE (less than FTSIZE, see the include */ -/* file 'zzddhman.inc') logical units. The entry points in */ -/* the handle manager automatically connect and disconnect */ -/* loaded files from their logical units as new files are */ -/* loaded and accessed. */ - -/* Previously, one could buffer a logical unit associated */ -/* with a particular handle and access the file directly */ -/* with Fortran I/O statements. To preserve this capability */ -/* invoking DAFHLU locks a handle to its assigned logical */ -/* unit, until that lock is removed (see ZZDDHUNL, an entry */ -/* point in ZZDDHMAN) or the file is closed. See the */ -/* Revisions section in the DAFHLU entry point for details. */ - -/* Another consequence of the utilization of the handle */ -/* manager code is that the process of connecting a file */ -/* name to a HANDLE may require performing up to FTSIZE */ -/* INQUIRE statements. This is necessary to insure that */ -/* different names referring to the same file return the */ -/* same handle. This was the case previously with the DAF */ -/* system since an INQUIRE on a different, but equivalent, */ -/* file name would produce the same logical unit. */ - -/* FTP Error Detection: */ - -/* The FTP error detection software is now integrated into */ -/* the handle manager umbrella entry points, and as such */ -/* is no longer present in DAFAH. */ - -/* Non-Native Files: */ - -/* In addition to expanding the number of loaded files the */ -/* DAF system supports, the handle manager also detects and */ -/* tracks binary file formats. This allows a layer of */ -/* private code that has been inserted between DAF routines */ -/* and the Fortran I/O statements to provide translation */ -/* services for DAF. Some environments are now endowed with */ -/* the ability to read files created with certain non-native */ -/* binary file formats. See the Convert User's Guide for */ -/* details. */ - -/* - SPICELIB Version 7.0.0, 22-MAR-1999 (FST) */ - -/* Binary File Format Identification: */ - -/* The file record now contains an 8 character string that */ -/* identifies the binary file format utilized by DAFs. */ -/* The purpose of this string's inclusion in the file record */ -/* is preparatory in nature, to accelerate the migration to */ -/* files that support the runtime translation update that */ -/* is scheduled. */ - -/* FTP Validation: */ - -/* The DAF system now employs a validation scheme to assist */ -/* users in detecting DAFs potentially corrupted via ASCII mode */ -/* FTP transfers. A string that contains sequences of */ -/* characters commonly corrupted by improper FTP transfers is */ -/* inserted into the unused portion of the file record. When any */ -/* DAFAH entry point attempts to open a file, this string is */ -/* located and examined. If the string indicates the file is */ -/* corrupted, the entry point signals an error. */ - -/* Detection Scheme Implementation: */ - -/* When a new DAF is created, the entry points DAFONW and */ -/* DAFOPN(obsolete) retrieve the FTP validation string from */ -/* the defining routine (ZZFTPSTR) and insert it into the */ -/* tail of the file record. A diagram illustrating the new */ -/* file record for 32-bit environments with single byte */ -/* characters follows: */ - -/* +=============+ */ -/* | File Record | */ -/* | Data | */ -/* +=============+ */ -/* | */ -/* +=====|===+==========================+===+========+ */ -/* | | | 603 bytes of nulls | | | nulls | */ -/* +=========+==========================+=|=+========+ */ -/* Byte 1 | 1024 */ -/* +============+ */ -/* | FTP | */ -/* | Validation | */ -/* | String | */ -/* +============+ */ - -/* As can be seen above, the file record is now null padded, */ -/* which was not the case previously. */ - -/* When an existing DAF is opened, the entry points DAFOPR */ -/* and DAFOPW attempt to verify that the validation string is */ -/* intact. This is accomplished by reading the file */ -/* record into a character string, and then passing the last */ -/* half of this string into the validation subroutine */ -/* ZZFTPCHK. Only sending the latter half of the file record */ -/* into ZZFTPCHK is done to prevent other portions of the file */ -/* record from confusing the validation process. The following */ -/* three abnormal situations may arise during validation: */ - -/* (1) Older DAFs without the FTP validation string are */ -/* not validated. As far as the DAF open routines */ -/* are concerned such files are valid by default. The */ -/* only notable exception is that the garbage that */ -/* resides in the unused portion of the file record may */ -/* confuse ZZFTPCHK into thinking the validation */ -/* string is present. (The probability of this event */ -/* is minimal and noted only for completeness.) */ - -/* (2) Files with an older version of the validation */ -/* string are examined for errors supported by the */ -/* contemporaneous version of the Toolkit. */ - -/* (3) Files with a newer version of the validation */ -/* string are examined for errors supported by the */ -/* current version of the Toolkit. */ - -/* Updates to the FTP Validation String: */ - -/* In the event that it becomes necessary to add additional */ -/* test characters to the validation string, refer to */ -/* ZZFTPSTR for the proper procedure. The instructions */ -/* provided there ensure that the above behavior is properly */ -/* adhered to by the modifications. */ - -/* FTP Validation Issues in Code Portability: */ - -/* The scheme as currently implemented will function */ -/* properly in any computing environment whose character data */ -/* conforms to the single byte ASCII standards with a word */ -/* size that is between 32 and 64 bits inclusive. Refer to */ -/* the above diagram that displays the new DAF file record */ -/* and the following discussion for details. */ - -/* Since the DAF file record block contains integer data, */ -/* it may expand if the word size increases above the */ -/* currently supported 32 bits. However, the FTP validation */ -/* string is extracted by reading in 1000 bytes of character */ -/* data and examining bytes 500-1000. (See the parameters */ -/* FTPBLK and FTPSTR if you need to alter these numbers). */ -/* So as long as the alteration in word size does not cause */ -/* the FTP string information to shift out of bytes 500-1000 */ -/* in the file record, the existing code will function */ -/* properly. */ - -/* - SPICELIB Version 3.2.0, 6-OCT-1992 (HAN) */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 3.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* DAFAH and the entry point DAFOPW were modified to permit */ -/* multiple DAFs to be open for writing at the same time. */ -/* Also, the entry points DAFHOF and DAFSIH were added. DAFHOF */ -/* returns a set containing the handles of currently open DAFs. */ -/* To accommodate the addition of DAFHOF, the argument FHSET */ -/* was added to DAFAH's argument list, and local declarations */ -/* for DAFHOF were added to DAFAH's declaration section. DAFSIH */ -/* signals an error if the file indicated by the handle is not */ -/* open for the specified type of access. */ - -/* - SPICELIB Version 2.0.0, 24-JAN-1991 (JEM) (MJS) */ - -/* The entry point DAFOPW accepted only 'NAIF/DAF' as a valid */ -/* ID word. It now accepts 'NAIF/NIP' as well for */ -/* backwards compatibility. The entry point DAFOPR did not need */ -/* this fix because it already accepts both ID words. */ - -/* - SPICELIB Version 1.1.0, 5-NOV-1990 (HAN) */ - -/* The parameter FTSIZE was increased from 4 to 20. The number */ -/* 4 was chosen for testing purposes and was not removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* As each file is opened, it is assigned a handle, and the */ -/* internal file name is stored for comparison with other files. */ -/* All names in the file table begin with FT. */ - -/* HAN Handle */ -/* LNK Number of links */ -/* ND, */ -/* NI Summary format */ - -/* The columns are stored in no particular order. New files are */ -/* added to the end of the list; the list is repacked whenever a */ -/* file is removed from the list. */ - -/* NFT is the number of files currently opened: this may not be */ -/* greater than FTSIZE. FINDEX refers to a file of interest within */ -/* the table. */ - -/* NEXT is incremented each time a file is opened to become the */ -/* next file handle assigned. */ - - -/* Other local variables */ - - -/* Saved variables */ - - -/* Save everything between calls. */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (fhset) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_dafopr; - case 2: goto L_dafopw; - case 3: goto L_dafonw; - case 4: goto L_dafopn; - case 5: goto L_dafcls; - case 6: goto L_dafhsf; - case 7: goto L_dafhlu; - case 8: goto L_dafluh; - case 9: goto L_dafhfn; - case 10: goto L_daffnh; - case 11: goto L_dafhof; - case 12: goto L_dafsih; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFAH", (ftnlen)5); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("DAFAH", (ftnlen)5); - } - return 0; -/* $Procedure DAFOPR ( DAF, open for read ) */ - -L_dafopr: -/* $ Abstract */ - -/* Open a DAF for subsequent read requests. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of DAF to be opened. */ -/* HANDLE O Handle assigned to DAF. */ - -/* $ Detailed_Input */ - -/* FNAME is the file name of a DAF to be opened for read */ -/* access. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAF routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Exceptions */ - -/* 1) If the specified file has already been opened for read */ -/* access, the handle already associated with the file is */ -/* returned. */ - -/* 2) If the specified file has already been opened for write */ -/* access, an error is signaled by routines in the call */ -/* tree of this routine. */ - -/* 3) If the specified file has already been opened by a non-DAF */ -/* routine, an error is signaled by routines in the call */ -/* tree of this routine. */ - -/* 4) If the specified file cannot be opened without exceeding */ -/* the maximum number of files, the error SPICE(DAFFTFULL) */ -/* is signaled. */ - -/* 5) If the attempt to read the file's file record fails, */ -/* the error SPICE(FILEREADFAILED) is signaled. */ - -/* 6) If the specified file is not a DAF file, an error is */ -/* signaled by routines in the call tree of this routine. */ - -/* 7) If no logical units are available, an error is */ -/* signaled by routines called by this routine. */ - -/* 8) If the file does not exist, the error SPICE(FILENOTFOUND) */ -/* is signaled by routines in the call tree of this routine. */ - -/* 9) If an I/O error occurs in the process of opening the file, */ -/* routines in the call tree of this routine signal an error. */ - -/* 10) If the file name is blank or otherwise inappropriate */ -/* routines in the call tree of this routine signal an error. */ - -/* 11) If the file was transferred improperly via FTP, routines */ -/* in the call tree of this routine signal an error. */ - -/* 12) If the file utilizes a binary file format that is not */ -/* currently supported on this platform, an error is signaled */ -/* by routines in the call tree of this routine. */ - -/* $ Particulars */ - -/* Most DAFs require only read access. If you do not need to */ -/* change the contents of a file, you should open it with DAFOPR. */ - -/* $ Examples */ - -/* In the following code fragment, DAFOPR is used to open a file, */ -/* which is then searched for DAFs containing data for a particular */ -/* object. */ - -/* CALL DAFOPR ( FNAME, HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ - -/* IF ( IC(1) .EQ. TARGET_OBJECT ) THEN */ -/* . */ -/* . */ - -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* $ Restrictions */ - -/* 1) Files opened using this routine must be closed with DAFCLS. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* This routine was updated to accomodate changes to the */ -/* handle manager interface. See DAFAH's Revision section */ -/* for details. */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 5.0.0, 03-MAR-1999 (FST) */ - -/* This entry point now attempts to locate and validate the */ -/* FTP validation string contained in the file record. */ - -/* - SPICELIB Version 4.0.0, 27-SEP-1993 (KRG) */ - -/* This routine was modified to use a subroutine to obtain the */ -/* architecture of the file rather than using hard coded values */ -/* for comparison with the file ID word. This was done in order to */ -/* isolate the code which checks to determine a file architecture */ -/* and to make the identification of file types easier through a */ -/* change to the file ID word. */ - -/* In particular, the changes to this routine support the change */ -/* of the file ID word from 'NAIF/DAF' or 'NAIF/NIP' to 'DAF/xxxx' */ -/* where 'xxxx' represents a four character mnemonic code for the */ -/* type of data in the file. */ - -/* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADAFFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* Changed the long error message when the error */ -/* SPICE(NOTADAFFILE) is signalled to suggest that a common error */ -/* is attempting to load a text version of the desired file rather */ -/* than the binary version. */ - -/* - SPICELIB Version 3.0.0, 25-FEB-1993 (JML) */ - -/* The INQUIRE statement that checks if the file is already open */ -/* now also checks that the file exists. */ - -/* A new variable LUN is used for the logical unit number */ -/* returned by GETLUN. */ - -/* The IF-THEN statements were reorganized to improve readability. */ - -/* A long error message is now set when the DAF id word is not */ -/* recognized. Also, the file is closed when this error is */ -/* signalled. */ - -/* IOSTAT is checked after the file record is read. */ - -/* The file name is checked to see if it is blank. */ - -/* The file name string that is passed to the FORTRAN OPEN and */ -/* INQUIRE statements has been chopped at the last non-blank */ -/* character. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open daf for read */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.0.0, 03-MAR-1999 (FST) */ - -/* See the Revisions section under DAFAH for a discussion */ -/* of the impact of the changes made for this version. */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* Some error messages were changed so that they specify */ -/* names of relevant DAFs. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFOPR", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Attempt to open the file; perform any appropriate checks. */ - - zzddhopn_(fname, "READ", "DAF", handle, fname_len, (ftnlen)4, (ftnlen)3); - -/* Check FAILED(); return if an error has occurred. */ - - if (failed_()) { - chkout_("DAFOPR", (ftnlen)6); - return 0; - } - -/* See if this file is already present in the file table. If it */ -/* is simply increment its link count by one, check out and */ -/* return. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex != 0) { - ftlnk[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", - i__1, "dafah_", (ftnlen)1221)] = ftlnk[(i__2 = findex - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("ftlnk", i__2, "dafah_", ( - ftnlen)1221)] + 1; - chkout_("DAFOPR", (ftnlen)6); - return 0; - } - -/* Retrieve ND and NI from the file record. */ - - zzdafgfr_(handle, idword, &fnd, &fni, ifn, &fward, &bward, &free, &found, - (ftnlen)8, (ftnlen)60); - if (! found) { - zzddhcls_(handle, "DAF", &c_false, (ftnlen)3); - setmsg_("Error reading the file record from the binary DAF file '#'.", - (ftnlen)59); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFOPR", (ftnlen)6); - return 0; - } - -/* At this point, we know that we have a valid DAF file, and we're */ -/* set up to read from it, so ... */ - -/* Update the file table to include information about our newly */ -/* opened DAF. */ - - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "dafah_", (ftnlen)1259)] = *handle; - ftnd[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnd", i__1, - "dafah_", (ftnlen)1260)] = fnd; - ftni[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftni", i__1, - "dafah_", (ftnlen)1261)] = fni; - ftlnk[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", i__1, - "dafah_", (ftnlen)1262)] = 1; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - chkout_("DAFOPR", (ftnlen)6); - return 0; -/* $Procedure DAFOPW ( DAF, open for write ) */ - -L_dafopw: -/* $ Abstract */ - -/* Open a DAF for subsequent write requests. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of DAF to be opened. */ -/* HANDLE O Handle assigned to DAF. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a DAF to be opened with write */ -/* access. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAF routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Exceptions */ - -/* 1) If the specified file has already been opened, either by */ -/* the DAF routines or by other code, an error is signaled by */ -/* routines in the call tree of this routine. Note that this */ -/* response is not paralleled by DAFOPR, which allows you */ -/* to open a DAF for reading even if it is already open for */ -/* reading. */ - -/* 2) If the specified file cannot be opened without exceeding */ -/* the maximum number of files, the error SPICE(DAFFTFULL) */ -/* is signaled. */ - -/* 3) If the attempt to read the file's file record fails, the */ -/* error SPICE(FILEREADFAILED) will be signalled. */ - -/* 4) If the specified file is not a DAF file, an error is */ -/* signaled by routines in the call tree of this routine. */ - -/* 5) If no logical units are available, an error is */ -/* signaled by routines called by this routine. */ - -/* 6) If the file does not exist, the error SPICE(FILENOTFOUND) */ -/* is signaled by routines in the call tree of this routine. */ - -/* 7) If an I/O error occurs in the process of opening the file, */ -/* routines in the call tree of this routine signal an error. */ - -/* 8) If the file name is blank or otherwise inappropriate */ -/* routines in the call tree of this routine signal an error. */ - -/* 9) If the file was transferred improperly via FTP, routines */ -/* in the call tree of this routine signal an error. */ - -/* 10) If the file utilizes a non-native binary file format, an */ -/* error is signaled by routines in the call tree of this */ -/* routine. */ - -/* $ Particulars */ - -/* Most DAFs require only read access. If you do not need to */ -/* change the contents of a file, you should open it with DAFOPR. */ -/* Use DAFOPW when you need to */ - -/* -- change (update) one or more summaries, names, or */ -/* arrays within a file; or */ - -/* -- add new arrays to a file. */ - -/* $ Examples */ - -/* In the following code fragment, DAFOPW is used to open a */ -/* file, which is then searched for arrays containing data for */ -/* a particular object. The code for the object is then changed */ -/* (perhaps to reflect some new convention). */ - -/* CALL DAFOPW ( FNAME, HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ - -/* IF ( IC(1) .EQ. OLD_CODE ) THEN */ -/* IC(1) = NEW_CODE */ - -/* CALL DAFPS ( ND, NI, DC, IC, SUM ) */ -/* CALL DAFRS ( SUM ) */ -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* $ Restrictions */ - -/* 1) Only file of the native binary file format may be opened */ -/* with this routine. */ - -/* 2) Files opened using this routine must be closed with DAFCLS. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* This routine was updated to accomodate changes to the */ -/* handle manager interface. See DAFAH's Revision section */ -/* for details. */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 6.0.0, 03-MAR-1999 (FST) */ - -/* This entry point now attempts to locate and validate the */ -/* FTP validation string contained in the file record. */ - -/* - SPICELIB Version 5.0.0, 27-SEP-1993 (KRG) */ - -/* This routine was modified to use a subroutine to obtain the */ -/* architecture of the file rather than using hard coded values */ -/* for comparing to the file ID word. This was done in order to */ -/* isolate the code which checks to determine a file architecture, */ -/* and to make the identification of file types easier through a */ -/* change to the file ID word. */ - -/* In particular, the changes to this routine support the change */ -/* of the file ID word from 'NAIF/DAF' or 'NAIF/NIP' to 'DAF/xxxx' */ -/* where 'xxxx' represents a four character mnemonic code for the */ -/* type of data in the file. */ - -/* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADAFFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* Changed the long error message when the error */ -/* SPICE(NOTADAFFILE) is signalled to suggest that a common error */ -/* is attempting to load a text version of the desired file rather */ -/* than the binary version. */ - -/* - SPICELIB Version 4.0.0, 25-FEB-1993 (JML) */ - -/* The INQUIRE statement that checks if the file is already open */ -/* now also checks that the file exists. */ - -/* A new variable LUN is used for the logical unit number */ -/* returned by GETLUN. */ - -/* The IF-THEN statements were reorganized to improve readability. */ - -/* A long error message is now set when the DAF id word is not */ -/* recognized. Also, the file is closed when this error is */ -/* signalled. */ - -/* IOSTAT is now checked after the file record is read. */ - -/* The file name is checked to see if it is blank. */ - -/* The file name string that is passed to the FORTRAN OPEN and */ -/* INQUIRE statements has been chopped at the last non-blank */ -/* character. */ - -/* - SPICELIB Version 3.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 3.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* DAFOPW now allows multiple files to be open for writing. */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* - SPICELIB Version 2.0.0, 24-JAN-1991 (JEM) */ - -/* DAFOPW now accepts the ID word 'NAIF/NIP' as well 'NAIF/DAF'. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open daf for write */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.0.0, 03-MAR-1999 (FST) */ - -/* See the Revisions section under DAFAH for a discussion */ -/* of the impact of the changes made for this version. */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* DAFOPW now allows multiple files to be open for writing. */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* Some error messages were changed so that they specify */ -/* names of relevant DAFs. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFOPW", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Check to see if there is room in the file table. */ - - if (nft == 1000) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__1000, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DAFFTFULL)", (ftnlen)16); - chkout_("DAFOPW", (ftnlen)6); - return 0; - } - -/* Attempt to open the file; perform any appropriate checks. */ - - zzddhopn_(fname, "WRITE", "DAF", handle, fname_len, (ftnlen)5, (ftnlen)3); - -/* Check FAILED(); return if an error has occurred. */ - - if (failed_()) { - chkout_("DAFOPW", (ftnlen)6); - return 0; - } - -/* Retrieve ND and NI from the file record. */ - - zzdafgfr_(handle, idword, &fnd, &fni, ifn, &fward, &bward, &free, &found, - (ftnlen)8, (ftnlen)60); - if (! found) { - zzddhcls_(handle, "DAF", &c_false, (ftnlen)3); - setmsg_("Error reading the file record from the binary DAF file '#'.", - (ftnlen)59); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFOPW", (ftnlen)6); - return 0; - } - -/* At this point, we know that we have a valid DAF file, and we're */ -/* set up to write to it or read from it, so ... */ - -/* Update the file table to include information about our */ -/* newly opened DAF. */ - - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "dafah_", (ftnlen)1663)] = *handle; - ftnd[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnd", i__1, - "dafah_", (ftnlen)1664)] = fnd; - ftni[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftni", i__1, - "dafah_", (ftnlen)1665)] = fni; - ftlnk[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", i__1, - "dafah_", (ftnlen)1666)] = 1; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - chkout_("DAFOPW", (ftnlen)6); - return 0; -/* $Procedure DAFONW ( DAF, open new ) */ - -L_dafonw: -/* $ Abstract */ - -/* Open a new DAF for subsequent write requests. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* CHARACTER*(*) FTYPE */ -/* INTEGER ND */ -/* INTEGER NI */ -/* CHARACTER*(*) IFNAME */ -/* INTEGER RESV */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of DAF to be opened. */ -/* FTYPE I Mnemonic code for type of data in the DAF file. */ -/* ND I Number of double precision components in summaries. */ -/* NI I Number of integer components in summaries. */ -/* IFNAME I Internal file name. */ -/* RESV I Number of records to reserve. */ -/* HANDLE O Handle assigned to DAF. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a new DAF to be created (and */ -/* consequently opened for write access). */ - -/* FTYPE is a code for type of data placed into a DAF file. */ -/* The first nonblank character and the three (3) */ -/* characters immediately following it, giving four (4) */ -/* characters, are used to represent the type of the data */ -/* placed in the DAF file. This is provided as a */ -/* convenience for higher level software. It is an error */ -/* if this string is blank. When written to the DAF file, */ -/* the value for the type IS case sensitive; what you put */ -/* in is what you get out, so be careful. */ - -/* NAIF has reserved for its own use file types */ -/* consisting of the upper case letters (A-Z) and the */ -/* digits 0-9. NAIF recommends lower case or mixed case */ -/* file types be used by all others in order to avoid */ -/* any conflicts with NAIF file types. */ - -/* ND is the number of double precision components */ -/* in each array summary of the new file. */ - -/* NI is the number of integer components in each */ -/* array summary in the new file. */ - -/* IFNAME is the internal file name (containing as many as 60 */ -/* characters) for the new file. This should uniquely */ -/* identify the file. */ - -/* RESV is the number of records in the new file to be */ -/* reserved; these records will not be used to store any */ -/* data belonging to DAF arrays subsequently written to */ -/* the file. The user may reserve records 2 through (2 + */ -/* RESV - 1) in the file. SPICE kernels based on the DAF */ -/* format use the reserved record area to store optional */ -/* textual information; for these kernels, the reserved */ -/* records contain the file's "comment area." */ - -/* When RESV is non-zero, this routine writes an */ -/* end-of-comments character into the first byte of */ -/* record 2, and fills the rest of the allocated records */ -/* will null (ASCII code 0) characters. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAF routines. */ - -/* $ Parameters */ - -/* INTEOC is the ASCII decimal integer code of the character */ -/* recognized by SPICE as representing the end of the */ -/* comment data in the reserved record area. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Exceptions */ - -/* 1) If the specified file cannot be opened without exceeding */ -/* the maximum number of files, the error SPICE(DAFFTFULL) */ -/* is signalled. */ - -/* 2) If the input argument ND is out of the range [0, 124] */ -/* or if NI is out of the range [2, 250], the error */ -/* SPICE(DAFINVALIDPARAMS) is signalled. */ - -/* 3) If */ - -/* ND + ( NI + 1 ) / 2 > 125 */ - -/* the error SPICE(DAFINVALIDPARAMS) is signalled. */ - -/* 4) If the number of records to be reserved is not zero or */ -/* positive, the error SPICE(DAFNORESV) is signalled. */ - -/* 5) If an I/O error occurs in the process of creating the file, */ -/* routines in the call tree of this routine signal an error. */ - -/* 6) If (for some reason) the initial records in the file cannot */ -/* be written, the error SPICE(DAFWRITEFAIL) is signalled. */ - -/* 7) If no logical units are available, the error is */ -/* signaled by routines called by this routine. */ - -/* 8) If the file name is blank or otherwise inappropriate */ -/* routines in the call tree of this routine signal an error. */ - -/* 9) If the file type is blank, the error SPICE(BLANKFILETYPE) */ -/* is signalled. */ - -/* 10) If the file type contains nonprinting characters, decimal */ -/* 0-31 and 127-255, the error SPICE(ILLEGALCHARACTER) is */ -/* signalled. */ - -/* $ Particulars */ - -/* This routine supersedes DAFOPN as the method for opening a new DAF */ -/* file. It includes a data type identifier as part of the ID word of */ -/* a DAF file it creates. */ - -/* The DAFs created by DAFONW have initialized file records but */ -/* do not yet contain any arrays. See the DAF Required Reading */ -/* for a discussion of file records. */ - -/* $ Examples */ - -/* In the following code fragment, DAFONW is used to open a file, */ -/* to which a new array is then added. This file will have the data */ -/* type 'TEST' which may be used to distinguish production data from */ -/* test data at a user subroutine level. */ - -/* FNAME = 'test.bin' */ -/* FTYPE = 'TEST' */ - -/* CALL DAFONW ( FNAME, FTYPE, ND, NI, IFNAME, 0, HANDLE ) */ - -/* CALL DAFBNA ( HANDLE, SUM, NAME ) */ -/* CALL GET_DATA ( DATA, N, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFADA ( DATA, N ) */ -/* CALL GET_DATA ( DATA, N, FOUND ) */ -/* END DO */ - -/* CALL DAFENA */ - -/* $ Restrictions */ - -/* 1) Files opened using this routine must be closed with DAFCLS. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 9.0.0, 09-NOV-2006 (NJB) */ - -/* DAFONW now writes a EOC character to the first byte */ -/* of the second record when NRESV > 0. */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* This routine was updated to accomodate changes to the */ -/* handle manager interface. See DAFAH's Revision section */ -/* for details. */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 03-MAR-1999 (FST) */ - -/* The entry point was modified to insert the FTP validation */ -/* string, as well as the binary file format into the file record. */ - -/* - SPICELIB Version 1.1.0, 08-MAR-1996 (KRG) */ - -/* The modifications support the notion of a DAF comment area, */ -/* and involve writing NULL filled reserved records when the */ -/* number of reserved records is greater than zero (0). */ - -/* Some nested IF...THEN...ELSE IF...THEN...END IF constructs */ -/* were expanded to be independent IF...THEN...END IF tests. */ -/* The tests were for IOSTAT errors on cascading write statements */ -/* nested in the IF...ELSE IF... statements, and this was */ -/* confusing. These tests were restructured so that IOSTAT is */ -/* tested after each write statement which is equicalent to the */ -/* original intent and easier to read. */ - -/* - SPICELIB Version 1.0.0, 29-SEP-1993 (KRG) */ - -/* This routine implements the notion of a file type for DAF */ -/* files. It allows type information to be added to the file ID */ -/* word. */ - -/* This routine is a modified version of DAFOPN. See the revision */ -/* history of that entry point for details of changes before the */ -/* creation of this entry point. */ - -/* -& */ -/* $ Index_Entries */ - -/* open new daf with type */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 03-MAR-1999 (FST) */ - -/* See the Revisions section under DAFAH for a discussion */ -/* of the impact of the changes made for this version. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFONW", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Check to see if there is room in the file table. */ - - if (nft == 1000) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__1000, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DAFFTFULL)", (ftnlen)16); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* Check if the file type is blank. */ - - if (s_cmp(ftype, " ", ftype_len, (ftnlen)1) == 0) { - setmsg_("The file type is blank.", (ftnlen)23); - sigerr_("SPICE(BLANKFILETYPE)", (ftnlen)20); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* Check for nonprinting characters in the file type. */ - - fnb = ltrim_(ftype, ftype_len); - i__1 = rtrim_(ftype, ftype_len); - for (i__ = fnb; i__ <= i__1; ++i__) { - if (*(unsigned char *)&ftype[i__ - 1] > 126 || *(unsigned char *)& - ftype[i__ - 1] < 32) { - setmsg_("The file type contains nonprinting characters.", (ftnlen) - 46); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - } - -/* Set the value the file type in a temporary variable to be sure of */ -/* its length and then set the value of the ID word. Only 4 */ -/* characters are allowed for the file type, and they are the first */ -/* nonblank character and its three (3), or fewer, immediate */ -/* successors in the input string FTYPE. */ - - s_copy(ttype, ftype + (fnb - 1), (ftnlen)4, ftype_len - (fnb - 1)); -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = "DAF/"; - i__3[1] = 4, a__1[1] = ttype; - s_cat(idword, a__1, i__3, &c__2, (ftnlen)8); - -/* Make sure ND and NI are in range. */ - - if (*nd < 0 || *nd > 124) { - setmsg_("ND was #, should be in range [0,#].", (ftnlen)35); - errint_("#", nd, (ftnlen)1); - errint_("#", &c__124, (ftnlen)1); - sigerr_("SPICE(DAFINVALIDPARAMS)", (ftnlen)23); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - if (*ni < 2 || *ni > 250) { - setmsg_("NI was #, should be in range [2,#].", (ftnlen)35); - errint_("#", ni, (ftnlen)1); - errint_("#", &c__250, (ftnlen)1); - sigerr_("SPICE(DAFINVALIDPARAMS)", (ftnlen)23); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - if (*nd + (*ni + 1) / 2 > 125) { - setmsg_("Summary size was #, should not exceed #.", (ftnlen)40); - i__1 = *nd + (*ni + 1) / 2; - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__125, (ftnlen)1); - sigerr_("SPICE(DAFINVALIDPARAMS)", (ftnlen)23); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* The user must reserve some non-negative number of records. */ - - if (*resv < 0) { - setmsg_("An attempt was made to reserve a negative number (#) of rec" - "ords.", (ftnlen)64); - errint_("#", resv, (ftnlen)1); - sigerr_("SPICE(DAFNORESV)", (ftnlen)16); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* Attempt to create the file; perform any appropriate checks. */ - - zzddhopn_(fname, "NEW", "DAF", handle, fname_len, (ftnlen)3, (ftnlen)3); - -/* Check FAILED(); return if an error has occurred. */ - - if (failed_()) { - chkout_("DAFONW", (ftnlen)6); - return 0; - } - s_copy(ifn, ifname, (ftnlen)60, ifname_len); - fnd = *nd; - fni = *ni; - fward = *resv + 2; - bward = fward; - s_copy(crec, " ", (ftnlen)1000, (ftnlen)1); - cleard_(&c__128, drec); - i__1 = fward + 2; - dafrwa_(&i__1, &c__1, &free); - -/* Fetch a logical unit for HANDLE. */ - - zzddhhlu_(handle, "DAF", &c_false, &lun, (ftnlen)3); - -/* Check FAILED(); return if an error has occurred. */ - - if (failed_()) { - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* Fetch the system file format. */ - - zzplatfm_("FILE_FORMAT", format, (ftnlen)11, (ftnlen)8); - -/* Write the new file record to the logical unit, LUN. */ - - zzdafnfr_(&lun, idword, &fnd, &fni, ifn, &fward, &bward, &free, format, ( - ftnlen)8, (ftnlen)60, (ftnlen)8); - -/* Check to see whether or not ZZDAFNFR generated an error writing */ -/* the file record to the logical unit. In the event an error */ -/* occurs, checkout and return. */ - - if (failed_()) { - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* Write NULL filled reserved records. */ - - if (*resv > 0) { - for (i__ = 1; i__ <= 1000; ++i__) { - *(unsigned char *)&crec[i__ - 1] = '\0'; - } - i__1 = *resv + 1; - for (i__ = 2; i__ <= i__1; ++i__) { - -/* Place an end-of-comments marker in the first byte */ -/* of the first record. */ - - if (i__ == 2) { - *(unsigned char *)crec = '\4'; - } else { - *(unsigned char *)crec = '\0'; - } - io___25.ciunit = lun; - io___25.cirec = i__; - iostat = s_wdue(&io___25); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, crec, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_wdue(); -L100001: - if (iostat != 0) { - zzddhcls_(handle, "DAF", &c_true, (ftnlen)3); - setmsg_("Attempt to write file '#' failed. Value of IOSTAT w" - "as #.", (ftnlen)56); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - } - } - io___26.ciunit = lun; - io___26.cirec = fward; - iostat = s_wdue(&io___26); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__128, (char *)&drec[0], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - zzddhcls_(handle, "DAF", &c_true, (ftnlen)3); - setmsg_("Attempt to write file '#' failed. Value of IOSTAT was #.", ( - ftnlen)56); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - io___27.ciunit = lun; - io___27.cirec = fward + 1; - iostat = s_wdue(&io___27); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, crec, (ftnlen)1000); - if (iostat != 0) { - goto L100003; - } - iostat = e_wdue(); -L100003: - if (iostat != 0) { - zzddhcls_(handle, "DAF", &c_true, (ftnlen)3); - setmsg_("Attempt to write file '#' failed. Value of IOSTAT was #.", ( - ftnlen)56); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFONW", (ftnlen)6); - return 0; - } - -/* Update the file table to include information about our newly */ -/* opened DAF. */ - - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "dafah_", (ftnlen)2243)] = *handle; - ftnd[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnd", i__1, - "dafah_", (ftnlen)2244)] = fnd; - ftni[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftni", i__1, - "dafah_", (ftnlen)2245)] = fni; - ftlnk[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", i__1, - "dafah_", (ftnlen)2246)] = 1; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - chkout_("DAFONW", (ftnlen)6); - return 0; -/* $Procedure DAFOPN ( DAF, open new ) */ - -L_dafopn: -/* $ Abstract */ - -/* Open a new DAF for subsequent write requests. */ -/* Obsolete: This routine has been superceded by DAFONW. It is */ -/* supported for purposes of backward compatibility only. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER ND */ -/* INTEGER NI */ -/* CHARACTER*(*) IFNAME */ -/* INTEGER RESV */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of DAF to be opened. */ -/* ND I Number of double precision components in summaries. */ -/* NI I Number of integer components in summaries. */ -/* IFNAME I Internal file name. */ -/* RESV I Number of records to reserve. */ -/* HANDLE O Handle assigned to DAF. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a new DAF to be created (and */ -/* consequently open for write access). */ - -/* ND is the number of double precision components */ -/* in each array summary of the new file. */ - -/* NI is the number of integer components in each */ -/* array summary in the new file. */ - -/* IFNAME is the internal file name (containing as many as 60 */ -/* characters) for the new file. This should uniquely */ -/* identify the file. */ - -/* RESV is the number of records in the new file to be */ -/* reserved for non-DAF use. The user may reserve */ -/* records 2 through (2 + RESV - 1) in the file. */ -/* These records are not used to store DAF data, */ -/* and are in fact invisible to all DAF routines. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAF routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Exceptions */ - -/* 1) If the specified file cannot be opened without exceeding */ -/* the maximum number of files, the error SPICE(DAFFTFULL) */ -/* is signalled. */ - -/* 2) If the input argument ND is out of the range [0, 124] */ -/* or if NI is out of the range [2, 250], the error */ -/* SPICE(DAFINVALIDPARAMS) is signalled. */ - -/* 3) If */ - -/* ND + ( NI + 1 ) / 2 > 125 */ - -/* the error SPICE(DAFINVALIDPARAMS) is signalled. */ - -/* 4) If the number of records to be reserved is not zero or */ -/* positive, the error SPICE(DAFNORESV) is signalled. */ - -/* 5) If an I/O error occurs in the process of creating the file, */ -/* routines in the call tree of this routine signal an error. */ - -/* 6) If (for some reason) the initial records in the file cannot */ -/* be written, the error SPICE(DAFWRITEFAIL) is signalled. */ - -/* 7) If no logical units are available, the error is */ -/* signaled by routines called by this routine. */ - -/* 8) If the file name is blank, or otherwise inappropriate */ -/* routines in the call tree of this routine signal an error. */ - -/* $ Particulars */ - -/* The DAFs created by DAFOPN have initialized file records but */ -/* do not yet contain any arrays. See the DAF Required Reading */ -/* for a discussion of file records. */ - -/* This entry point has been made obsolete by the entry point DAFONW. */ -/* It is supported for reasons of backward compatibility only. New */ -/* software development should use the entry point DAFONW. */ - -/* $ Examples */ - -/* In the following code fragment, DAFOPN is used to open a file, */ -/* to which a new array is then added. */ - -/* CALL DAFOPN ( FNAME, ND, NI, IFNAME, 0, HANDLE ) */ - -/* CALL DAFBNA ( HANDLE, SUM, NAME ) */ -/* CALL GET_DATA ( DATA, N, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFADA ( DATA, N ) */ -/* CALL GET_DATA ( DATA, N, FOUND ) */ -/* END DO */ - -/* CALL DAFENA */ - -/* $ Restrictions */ - -/* 1) Files opened using this routine must be closed with DAFCLS. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* This routine was updated to accomodate changes to the */ -/* handle manager interface. See DAFAH's Revision section */ -/* for details. */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 4.0.0, 03-MAR-1999 (FST) */ - -/* The entry point was modified to insert the FTP validation */ -/* string, as well as the binary file format into the file record. */ - -/* - SPICELIB Version 3.1.0, 08-MAR-1996 (KRG) */ - -/* The modifications support the notion of a DAF comment area, */ -/* and involve writing NULL filled reserved records when the */ -/* number of reserved records is greater than zero (0). */ - -/* Some nested IF...THEN...ELSE IF...THEN...END IF constructs */ -/* were expanded to be independent IF...THEN...END IF tests. */ -/* The tests were for IOSTAT errors on cascading write statements */ -/* nested in the IF...ELSE IF... statements, and this was */ -/* confusing. These tests were restructured so that IOSTAT is */ -/* tested after each write statement which is equicalent to the */ -/* original intent and easier to read. */ - -/* - SPICELIB Version 3.0.0, 29-SEP-1993 (KRG) */ - -/* Modified the logical structure of some */ -/* IF ... THEN ... ELSE IF... END IF */ -/* statements which were testing different items in each ELSE IF */ -/* clause for failure into separate IF ... END IF statements. This */ -/* improved the readability and supportability of the code. */ - -/* - SPICELIB Version 2.1.0, 25-FEB-1993 (JML) */ - -/* A new variable LUN is used for the logical unit number */ -/* returned by GETLUN. */ - -/* The file name is checked to see if it is blank. */ - -/* The file name string that is passed to the FORTRAN OPEN and */ -/* INQUIRE statements has been chopped at the last non-blank */ -/* character. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (HAN) (WLT) */ - -/* Updated to allow multiple DAFs to be open for write */ -/* access simultaneously. An error in a calling sequence */ -/* shown in the Examples section was corrected. */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open new daf */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 03-MAR-1999 (FST) */ - -/* See the Revisions section under DAFAH for a discussion */ -/* of the impact of the changes made for this version. */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (HAN) (WLT) */ - -/* Updated to allow multiple DAFs to be open for write */ -/* access simultaneously. */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* Invalid values of ND and NI are now screened; two new */ -/* exceptions were added to the $Exceptions header section. */ - -/* The calling sequence of DAFADA shown in the first example */ -/* in the Examples section was reversed; this was fixed. */ - -/* Some error messages were changed so that they specify */ -/* names of relevant DAFs. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFOPN", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Check to see if there is room in the file table. */ - - if (nft == 1000) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__1000, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DAFFTFULL)", (ftnlen)16); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - -/* Make sure ND and NI are in range. */ - - if (*nd < 0 || *nd > 124) { - setmsg_("ND was #, should be in range [0,#].", (ftnlen)35); - errint_("#", nd, (ftnlen)1); - errint_("#", &c__124, (ftnlen)1); - sigerr_("SPICE(DAFINVALIDPARAMS)", (ftnlen)23); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - if (*ni < 2 || *ni > 250) { - setmsg_("NI was #, should be in range [2,#].", (ftnlen)35); - errint_("#", ni, (ftnlen)1); - errint_("#", &c__250, (ftnlen)1); - sigerr_("SPICE(DAFINVALIDPARAMS)", (ftnlen)23); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - if (*nd + (*ni + 1) / 2 > 125) { - setmsg_("Summary size was #, should not exceed #.", (ftnlen)40); - i__1 = *nd + (*ni + 1) / 2; - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__125, (ftnlen)1); - sigerr_("SPICE(DAFINVALIDPARAMS)", (ftnlen)23); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - -/* The user must reserve some non-negative number of records. */ - - if (*resv < 0) { - setmsg_("An attempt was made to reserve a negative number (#) of rec" - "ords.", (ftnlen)64); - errint_("#", resv, (ftnlen)1); - sigerr_("SPICE(DAFNORESV)", (ftnlen)16); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - -/* Attempt to create the file; perform any appropriate checks. */ - - zzddhopn_(fname, "NEW", "DAF", handle, fname_len, (ftnlen)3, (ftnlen)3); - -/* Check FAILED(); return if an error has occurred. */ - - if (failed_()) { - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - s_copy(ifn, ifname, (ftnlen)60, ifname_len); - fnd = *nd; - fni = *ni; - fward = *resv + 2; - bward = fward; - s_copy(crec, " ", (ftnlen)1000, (ftnlen)1); - cleard_(&c__128, drec); - i__1 = fward + 2; - dafrwa_(&i__1, &c__1, &free); - -/* Fetch a logical unit for HANDLE. */ - - zzddhhlu_(handle, "DAF", &c_false, &lun, (ftnlen)3); - -/* Check FAILED(); return if an error has occurred. */ - - if (failed_()) { - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - -/* Fetch the system file format. */ - - zzplatfm_("FILE_FORMAT", format, (ftnlen)11, (ftnlen)8); - -/* Write the new file record to the logical unit, LUN. */ - - zzdafnfr_(&lun, "NAIF/DAF", &fnd, &fni, ifn, &fward, &bward, &free, - format, (ftnlen)8, (ftnlen)60, (ftnlen)8); - -/* Check to see whether or not ZZDAFNFR generated an error writing */ -/* the file record to the logical unit. In the event an error */ -/* occurs, checkout and return. */ - - if (failed_()) { - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - -/* Write NULL filled reserved records. */ - - if (*resv > 0) { - for (i__ = 1; i__ <= 1000; ++i__) { - *(unsigned char *)&crec[i__ - 1] = '\0'; - } - i__1 = *resv + 1; - for (i__ = 2; i__ <= i__1; ++i__) { - io___28.ciunit = lun; - io___28.cirec = i__; - iostat = s_wdue(&io___28); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, crec, (ftnlen)1000); - if (iostat != 0) { - goto L100004; - } - iostat = e_wdue(); -L100004: - if (iostat != 0) { - zzddhcls_(handle, "DAF", &c_true, (ftnlen)3); - setmsg_("Attempt to write file '#' failed. Value of IOSTAT w" - "as #.", (ftnlen)56); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - } - } - io___29.ciunit = lun; - io___29.cirec = fward; - iostat = s_wdue(&io___29); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__128, (char *)&drec[0], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100005; - } - iostat = e_wdue(); -L100005: - if (iostat != 0) { - zzddhcls_(handle, "DAF", &c_true, (ftnlen)3); - setmsg_("Attempt to write file '#' failed. Value of IOSTAT was #.", ( - ftnlen)56); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - io___30.ciunit = lun; - io___30.cirec = fward + 1; - iostat = s_wdue(&io___30); - if (iostat != 0) { - goto L100006; - } - iostat = do_uio(&c__1, crec, (ftnlen)1000); - if (iostat != 0) { - goto L100006; - } - iostat = e_wdue(); -L100006: - if (iostat != 0) { - zzddhcls_(handle, "DAF", &c_true, (ftnlen)3); - setmsg_("Attempt to write file '#' failed. Value of IOSTAT was #.", ( - ftnlen)56); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFOPN", (ftnlen)6); - return 0; - } - -/* Update the file table to include information about */ -/* our newly opened DAF. */ - - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "dafah_", (ftnlen)2776)] = *handle; - ftnd[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnd", i__1, - "dafah_", (ftnlen)2777)] = fnd; - ftni[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftni", i__1, - "dafah_", (ftnlen)2778)] = fni; - ftlnk[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", i__1, - "dafah_", (ftnlen)2779)] = 1; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - chkout_("DAFOPN", (ftnlen)6); - return 0; -/* $Procedure DAFCLS ( DAF, close ) */ - -L_dafcls: -/* $ Abstract */ - -/* Close the DAF associated with a given handle. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF to be closed. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a previously opened DAF file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to a DAF */ -/* that is currently open, nothing happens. */ - -/* 2) If this routine is used to close an HANDLE not associated */ -/* with a DAF, routines called by this routine signal an error. */ - -/* $ Particulars */ - -/* Because DAFAH and its entry points must keep track of what */ -/* files are open at any given time, it is important that DAF */ -/* files be closed only with DAFCLS, to prevent the remaining */ -/* DAF routines from failing, sometimes mysteriously. */ - -/* Note that when a file is opened more than once for read access, */ -/* DAFOPR returns the same handle each time it is re-opened. */ -/* Each time the file is closed, DAFCLS checks to see if any other */ -/* claims on the file are still active before physically closing */ -/* the file. */ - -/* $ Examples */ - -/* In the following code fragment, the arrays in a file are */ -/* examined in order to determine whether the file contains */ -/* any arrays whose names begin with the word TEST. */ -/* The complete names for these arrays are printed to */ -/* the screen. The file is closed at the end of the search. */ - -/* CALL DAFOPR ( FNAME, HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGN ( NAME ) */ - -/* IF ( NAME(1:5) .EQ. 'TEST ' ) THEN */ -/* WRITE (*,*) NAME */ -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* CALL DAFCLS ( HANDLE ) */ - -/* Note that if the file has been opened already by a DAF routine */ -/* at some other place in the calling program, it remains open. */ -/* This makes it possible to examine files that have been opened for */ -/* use by other modules without interfering with the operation of */ -/* those routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* This routine was updated to accomodate changes to the */ -/* handle manager interface. See DAFAH's Revision section */ -/* for details. */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.3, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 2.0.2, 25-FEB-1993 (JML) */ - -/* A minor error in the particulars section of the header was */ -/* corrected. It formerly stated that a file could be open more */ -/* than once for read or write access instead of just read access. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* This routine was updated so that it now keeps current the set */ -/* of DAF handles returned by DAFHOF. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* close daf */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 03-SEP-1991 (NJB) (WLT) */ - -/* Upgraded to support file handle checking routines */ -/* DAFHOF and DAFSIH. DAFCLS now initializes the file */ -/* handle list if necessary, and removes from the list */ -/* the handles of files it closes. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFCLS", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Is this file even open? If so, decrement the number of links */ -/* to the file. If the number of links drops to zero, physically */ -/* close the file and remove it from the file buffer. */ - -/* If the file is not open: no harm, no foul. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex > 0) { - ftlnk[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", - i__1, "dafah_", (ftnlen)3042)] = ftlnk[(i__2 = findex - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("ftlnk", i__2, "dafah_", ( - ftnlen)3042)] - 1; - if (ftlnk[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftlnk", i__1, "dafah_", (ftnlen)3044)] == 0) { - zzddhcls_(handle, "DAF", &c_false, (ftnlen)3); - i__1 = nft - 1; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "fthan", i__2, "dafah_", (ftnlen)3049)] = fthan[(i__4 - = i__) < 1000 && 0 <= i__4 ? i__4 : s_rnge("fthan", - i__4, "dafah_", (ftnlen)3049)]; - ftlnk[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftlnk", i__2, "dafah_", (ftnlen)3050)] = ftlnk[(i__4 - = i__) < 1000 && 0 <= i__4 ? i__4 : s_rnge("ftlnk", - i__4, "dafah_", (ftnlen)3050)]; - ftnd[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnd", i__2, "dafah_", (ftnlen)3051)] = ftnd[(i__4 = - i__) < 1000 && 0 <= i__4 ? i__4 : s_rnge("ftnd", i__4, - "dafah_", (ftnlen)3051)]; - ftni[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftni", i__2, "dafah_", (ftnlen)3052)] = ftni[(i__4 = - i__) < 1000 && 0 <= i__4 ? i__4 : s_rnge("ftni", i__4, - "dafah_", (ftnlen)3052)]; - } - --nft; - -/* Delete the handle from our handle set. */ - - removi_(handle, fhlist); - } - } - chkout_("DAFCLS", (ftnlen)6); - return 0; -/* $Procedure DAFHSF ( DAF, handle to summary format ) */ - -L_dafhsf: -/* $ Abstract */ - -/* Return the summary format associated with a handle. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER ND */ -/* INTEGER NI */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file. */ -/* ND O Number of double precision components in summaries. */ -/* NI O Number of integer components in summaries. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a previously opened */ -/* DAF file. */ - -/* $ Detailed_Output */ - -/* ND, */ -/* NI are the numbers of double precision and integer */ -/* components, respectively, in each array summary */ -/* in the specified file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, the error SPICE(DAFNOSUCHHANDLE) */ -/* is signalled. */ - -/* $ Particulars */ - -/* The summary format must be known in order to pack or unpack */ -/* an array summary. See the DAF Required Reading for a discussion */ -/* of summary formats. */ - -/* $ Examples */ - -/* 1) Find the number of d.p. `words' in a DAF having an */ -/* arbitrary summary format. */ - - -/* PROGRAM NWORDS */ -/* C */ -/* C Count the number of d.p. words of data in a */ -/* C DAF. Exclude array summaries, reserved records, */ -/* C the file record, and character records. */ -/* C */ -/* INTEGER FILEN */ -/* PARAMETER ( FILEN = 128 ) */ - -/* INTEGER MAXND */ -/* PARAMETER ( MAXND = 124 ) */ - -/* INTEGER MAXNI */ -/* PARAMETER ( MAXNI = 250 ) */ - -/* INTEGER MAXSUM */ -/* PARAMETER ( MAXSUM = 125 ) */ - -/* CHARACTER*(FILEN) DAF */ - -/* DOUBLE PRECISION DC ( MAXND ) */ -/* DOUBLE PRECISION SUM ( MAXSUM ) */ - -/* INTEGER FA */ -/* INTEGER HANDLE */ -/* INTEGER IA */ -/* INTEGER IC ( MAXNI ) */ -/* INTEGER N */ -/* INTEGER ND */ -/* INTEGER NI */ - -/* LOGICAL FOUND */ - -/* DATA N / 0 / */ - -/* WRITE (*,*) 'Enter file name' */ -/* READ (*,FMT='(A)') DAF */ - -/* C */ -/* C Open the DAF and find the summary format. */ -/* C */ -/* CALL DAFOPR ( DAF, HANDLE ) */ -/* CALL DAFHSF ( HANDLE, ND, NI ) */ - -/* C */ -/* C Start a forward search and examine each array in */ -/* C turn. */ -/* C */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* C */ -/* C Obtain the array summary, unpack it, and get */ -/* C the initial and final array addresses from */ -/* C the integer descriptor component. */ -/* C */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ - -/* IA = IC ( NI - 1 ) */ -/* FA = IC ( NI ) */ - -/* N = FA - IA + 1 + N */ - -/* CALL DAFFNA ( FOUND ) */ - -/* END DO */ - -/* WRITE (*,*) 'Number of d.p. words is ', N */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.4, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 03-SEP-1990 (NJB) */ - -/* Example added to the $Examples section. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* handle to daf summary format */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFHSF", (ftnlen)6); - } - findex = isrchi_(handle, &nft, fthan); - if (findex > 0) { - *nd = ftnd[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftnd", i__1, "dafah_", (ftnlen)3331)]; - *ni = ftni[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftni", i__1, "dafah_", (ftnlen)3332)]; - } else { - setmsg_("There is no DAF open with handle = #", (ftnlen)36); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHHANDLE)", (ftnlen)22); - } - chkout_("DAFHSF", (ftnlen)6); - return 0; -/* $Procedure DAFHLU ( DAF, handle to logical unit ) */ - -L_dafhlu: -/* $ Abstract */ - -/* Return the logical unit associated with a handle. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file. */ -/* UNIT O Corresponding logical unit. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a previously opened */ -/* DAF file. */ - -/* $ Detailed_Output */ - -/* UNIT is the Fortran logical unit to which the file is */ -/* connected. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while attempting to fetch a logical */ -/* unit, routines in the call tree process and signal any */ -/* appropriate errors. The value of UNIT in this case is */ -/* undefined. */ - -/* $ Particulars */ - -/* The best reason for knowing the logical unit to which a DAF */ -/* is connected is to read or write from the records reserved in a */ -/* file. Since these records are by definition invisible to the DAF */ -/* routines, you must read and write them directly. */ - -/* $ Examples */ - -/* In the following code fragment, the first reserved record in */ -/* a newly created DAF is used to store the name and address */ -/* of the person who created it. */ - -/* FTYPE = 'TEST' */ -/* CALL DAFONW ( FNAME, FTYPE, 3, 6, IFNAME, 5, HANDLE ) */ -/* CALL DAFHLU ( HANDLE, UNIT ) */ - -/* WRITE (UNIT,REC=2) 'Ellis Wyatt, JPL ', */ -/* . '4800 Oak Grove Drive ', */ -/* . 'Room 301-125A ', */ -/* . 'Pasadena, CA 91109' */ - -/* $ Restrictions */ - -/* 1) This routine may only be used to retrieve logical units */ -/* for DAFs loaded or created using the interfaces available */ -/* in this entry point umbrella. Using this entry point to */ -/* retrieve units for files not loaded through these interfaces */ -/* may result in unexpected behavior. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* R.E. Thurman (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.3, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Changed the example to use the new entry point DAFONW. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* daf handle to logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.0.0, 15-NOV-2000 (FST) */ - -/* Successfully invoking this module has the side effect of */ -/* locking UNIT to HANDLE. This 'lock' guarentees until */ -/* HANDLE is closed (or unlocked) that the file associated */ -/* with HANDLE is always open and attached to logical unit */ -/* UNIT. To unlock a handle without closing the file, use */ -/* ZZDDHUNL, an entry point in the handle manager umbrella, */ -/* ZZDDHMAN. */ - -/* The system can lock at most UTSIZE-SCRUNT-RSVUNT */ -/* simultaneously (see the include file 'zzddhman.inc' for */ -/* specific values of these parameters), but unnecessarily */ -/* locking handles to their logical units may cause performance */ -/* degradation. The handle manager will have less logical */ -/* units to utilize when disconnecting and reconnecting */ -/* loaded files. */ - -/* - Beta Version 1.1.0, 1-NOV-1989 (RET) */ - -/* DAFHLU now only checks in and checks out if the one exception */ -/* occurs. The purpose of this change was to help speed up a */ -/* routine that gets called constantly by higher level DAF */ -/* routines. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFHLU", (ftnlen)6); - } - zzddhhlu_(handle, "DAF", &c_true, unit, (ftnlen)3); - chkout_("DAFHLU", (ftnlen)6); - return 0; -/* $Procedure DAFLUH ( DAF, logical unit to handle ) */ - -L_dafluh: -/* $ Abstract */ - -/* Return the handle associated with a logical unit. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER UNIT */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit connected to a DAF. */ -/* HANDLE O Corresponding DAF file handle. */ - -/* $ Detailed_Input */ - -/* UNIT is the logical unit to which a DAF has been */ -/* connected after it has been opened. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle associated with the file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified unit is not connected to any file that is */ -/* currently loaded as a DAF, the error SPICE(DAFNOSUCHUNIT) */ -/* is signaled. The value of HANDLE returned is undefined in */ -/* this case. */ - -/* $ Particulars */ - -/* It is unlikely, but possible, that a calling program would know */ -/* the logical unit to which a file is connected without knowing the */ -/* handle associated with the file. DAFLUH is provided mostly for */ -/* completeness. */ - -/* $ Examples */ - -/* In the following code fragment, the handle associated with */ -/* a DAF is retrieved using the logical unit to which the */ -/* file is connected. The handle is then used to determine the */ -/* name of the file. */ - -/* CALL DAFLUH ( UNIT, HANDLE ) */ -/* CALL DAFHFN ( HANDLE, FNAME ) */ - -/* $ Restrictions */ - -/* 1) This routine may only be used to retrieve handles for logical */ -/* units connected to DAFs loaded or created using the interfaces */ -/* available in this entry point umbrella. Using this entry point */ -/* to retrieve handles for files not loaded through these */ -/* interfaces may result in unexpected behavior. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.3, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* logical unit to daf handle */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFLUH", (ftnlen)6); - } - zzddhluh_(unit, handle, &found); - if (! found) { - *handle = 0; - setmsg_("There is no file open with unit = #", (ftnlen)35); - errint_("#", unit, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHUNIT)", (ftnlen)20); - chkout_("DAFLUH", (ftnlen)6); - return 0; - } - -/* Now make certain that the HANDLE is associated with a DAF. */ - - zzddhnfo_(handle, dafnam, &iarc, &ibff, &iamh, &found, (ftnlen)255); - if (iarc != 1) { - *handle = 0; - setmsg_("The file, '#', connected to unit # is not a DAF.", (ftnlen) - 48); - errfnm_("#", unit, (ftnlen)1); - errint_("#", unit, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHUNIT)", (ftnlen)20); - chkout_("DAFLUH", (ftnlen)6); - return 0; - } - chkout_("DAFLUH", (ftnlen)6); - return 0; -/* $Procedure DAFHFN ( DAF, handle to file name ) */ - -L_dafhfn: -/* $ Abstract */ - -/* Return the name of the file associated with a handle. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) FNAME */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file. */ -/* FNAME O Corresponding file name. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a previously opened */ -/* DAF file. */ - -/* $ Detailed_Output */ - -/* UNIT is the name of the file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be loaded as a DAF, the error */ -/* SPICE(DAFNOSUCHHANDLE) is signaled. */ - -/* $ Particulars */ - -/* It may be desirable to recover the names of one or more DAF */ -/* files in a different part of the program from the one in which */ -/* they were opened. Note that the names returned by DAFHFN may */ -/* not be identical to the names used to open the files. Under */ -/* most operating systems, a particular file can be accessed using */ -/* many different names. DAFHFN returns one of them. */ - -/* $ Examples */ - -/* In the following code fragment, the name of a DAF is */ -/* recovered using the handle associated with the file. */ - -/* CALL DAFOPR ( 'sample.DAF', HANDLE ) */ -/* . */ -/* . */ - -/* CALL DAFHFN ( HANDLE, FNAME ) */ - -/* Depending on the circumstances (operating system, compiler, */ -/* default directory) the value of FNAME might resemble any of */ -/* the following: */ - -/* 'USER$DISK:[WYATT.IMAGES]SAMPLE.DAF;4' */ - -/* '/wyatt/images/sample.DAF' */ - -/* 'A:\IMAGES\SAMPLE.DAF' */ - -/* On the other hand, it might not. */ - -/* $ Restrictions */ - -/* 1) This routine may only be used to retrieve the names of DAFs */ -/* loaded or created using the interfaces available in this entry */ -/* point umbrella. Using this entry point to retrieve names for */ -/* files not loaded through these interfaces may result in */ -/* unexpected behavior. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.1.1, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.1.0, 25-FEB-1993 (JML) */ - -/* IOSTAT is checked after the INQUIRE statement. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* daf handle to file name */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFHFN", (ftnlen)6); - } - zzddhnfo_(handle, dafnam, &iarc, &ibff, &iamh, &found, (ftnlen)255); - if (! found || iarc != 1) { - setmsg_("There is no file open with handle = #", (ftnlen)37); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHHANDLE)", (ftnlen)22); - chkout_("DAFHFN", (ftnlen)6); - return 0; - } - s_copy(fname, dafnam, fname_len, (ftnlen)255); - chkout_("DAFHFN", (ftnlen)6); - return 0; -/* $Procedure DAFFNH ( DAF, file name to handle ) */ - -L_daffnh: -/* $ Abstract */ - -/* Return handle associated with a file name. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a DAF file. */ -/* HANDLE O Corresponding DAF file handle. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a previously opened DAF file. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle associated with the file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified name does not specify any file currently known */ -/* to be loaded as a DAF the error SPICE(DAFNOSUCHFILE) is */ -/* signaled. The value of HANDLE is undefined in this case. */ - -/* 2) If the file does not exist, an error is signaled by routines */ -/* in the call tree of this routine. The value of HANDLE is */ -/* undefined in this case. */ - -/* 3) Any I/O errors generated in the process of connecting the */ -/* specified name with a handle cause errors to be signaled */ -/* by routines in the call tree of this routine. The value of */ -/* HANDLE is undefined in this case. */ - -/* $ Particulars */ - -/* It is sometimes easier to work with file names (which are */ -/* meaningful, and often predictable) than with file handles */ -/* (which are neither), especially in interactive situations. */ -/* However, nearly every DAF routines requires that you use file */ -/* handles to refer to files. DAFFNH is provided to bridge the gap */ -/* between the two representations. */ - -/* $ Examples */ - -/* In the following code fragment, the handle associated with a */ -/* DAF is recovered using the name of the file. */ - -/* CALL DAFOPR ( 'sample.DAF', HANDLE ) */ -/* . */ -/* . */ - -/* CALL DAFFNH ( 'sample.DAF', HANDLE ) */ - -/* $ Restrictions */ - -/* 1) Only file names of DAFs loaded with interfaces present in */ -/* this entry point umbrella should be passed into this routine. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 02-APR-2002 (FST) */ - -/* Fixed a bug, where an error was signaled but the call to */ -/* CHKOUT and the RETURN statement were omitted. */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.1, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 2.0.0, 25-FEB-1993 (JML) */ - -/* The INQUIRE statement that checks if the file is open now also */ -/* checks that the file exists. Two new exceptions were added as */ -/* a result of this change. */ - -/* A RETURN statement was added after the error signalled when */ -/* the file is not open. */ - -/* The file name is checked to see if it is blank. */ - -/* The file name string that is passed to the FORTRAN INQUIRE */ -/* statement has been chopped at the last non-blank character. */ - -/* - SPICELIB Version 1.1.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.1, 18-SEP-1991 (HAN) */ - -/* The Revisions section was incorrectly named Version. This has */ -/* been fixed. */ - -/* - SPICELIB Version 1.1.0, 5-NOV-1990 (HAN) */ - -/* Call to CHKIN was corrected. The module was checking in */ -/* as 'DAFFHN'. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* file name to daf handle */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.0.0, 15-NOV-2000 (FST) */ - -/* In previous version of DAFAH, this module simply */ -/* performed an INQUIRE on FNAME and looked in the */ -/* file table for the logical unit returned. */ - -/* The integration of the new handle manager interfaces */ -/* into this entry point has the possibility of increasing */ -/* the complexity of this routine when more than UTSIZE */ -/* files are loaded. Essentially, when given an arbitrary */ -/* name, a total of FTSIZE INQUIRE statements may be executed */ -/* to accurately connect FNAME with HANDLE. See ZZDDHFNH and */ -/* ZZDDHF2H for details. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFFNH", (ftnlen)6); - } - zzddhfnh_(fname, handle, &found, fname_len); - if (! found) { - *handle = 0; - setmsg_("There is no file in the DAF table with file name = '#'", ( - ftnlen)54); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DAFNOSUCHFILE)", (ftnlen)20); - chkout_("DAFFNH", (ftnlen)6); - return 0; - } - -/* Now make certain that HANDLE is associated with a DAF. */ - - zzddhnfo_(handle, dafnam, &iarc, &ibff, &iamh, &found, (ftnlen)255); - if (iarc != 1) { - *handle = 0; - setmsg_("The file, '#', is not a DAF.", (ftnlen)28); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DAFNOSUCHFILE)", (ftnlen)20); - chkout_("DAFFNH", (ftnlen)6); - return 0; - } - chkout_("DAFFNH", (ftnlen)6); - return 0; -/* $Procedure DAFHOF ( DAF, handles of open files ) */ - -L_dafhof: -/* $ Abstract */ - -/* Return a SPICELIB set containing the handles of all currently */ -/* open DAFS. */ - -/* $ 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 */ - -/* DAF */ -/* SETS */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER FHSET ( LBCELL : * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FHSET O A set containing handles of currently open DAFS. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* FHSET is a SPICELIB set containing the file handles of */ -/* all currently open DAFs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the set FHSET is not initialized, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the set FHSET is too small to accommodate the set of */ -/* handles to be returned, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows subroutines to test file handles for */ -/* validity before performing operations on them, such as */ -/* finding the name of the file designated by a handle. Many */ -/* DAF operations on handles cause errors to be signalled if */ -/* the handles are invalid. */ - -/* $ Examples */ - -/* 1) Find out how may DAFs are open for writing. */ - -/* C */ -/* C Find out which DAFs are open. */ -/* C */ -/* CALL DAFHOF ( FHSET ) */ - -/* C */ -/* C Count the ones open for writing. These have */ -/* C negative file handles. */ -/* C */ -/* COUNT = 0 */ - -/* DO I = 1, CARDC(FHSET) */ - -/* IF ( FHSET(I) .LT. 0 ) THEN */ -/* COUNT = COUNT + 1 */ -/* END IF */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - 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, 03-SEP-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return the set of handles for open daf files */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFHOF", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Just stuff our local list into the set. */ - - copyi_(fhlist, fhset); - chkout_("DAFHOF", (ftnlen)6); - return 0; -/* $Procedure DAFSIH ( DAF, signal invalid handles ) */ - -L_dafsih: -/* $ Abstract */ - -/* Signal an error if a DAF file handle does not designate a DAF */ -/* that is open for a specified type of access. */ - -/* $ 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 */ - -/* DAF */ -/* ERROR */ -/* SETS */ - -/* $ Keywords */ - -/* DAF */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) ACCESS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I HANDLE to be validated. */ -/* ACCESS I String indicating access type. */ - -/* $ Detailed_Input */ - -/* HANDLE is a DAF handle to validate. For HANDLE to be */ -/* considered valid, it must specify a DAF that is */ -/* open for the type of access specified by the input */ -/* argument ACCESS. */ - - -/* ACCESS is a string indicating the type of access that */ -/* the DAF specified by the input argument HANDLE */ -/* must be open for. The values of ACCESS may be */ - - -/* 'READ' File must be open for read access */ -/* by DAF routines. All open DAFs */ -/* may be read. */ - -/* 'WRITE' File must be open for write access */ -/* by DAF routines. */ - -/* Note that files open for write */ -/* access may be read as well as */ -/* written. */ - - -/* Leading and trailing blanks in ACCESS are ignored, */ -/* and case is not significant. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input argument ACCESS has an unrecognized value, */ -/* the error SPICE(INVALIDOPTION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine signals the error SPICE(DAFINVALIDACCESS) if the */ -/* DAF designated by the input argument HANDLE is not open */ -/* for the specified type of access. If HANDLE does not designate */ -/* an open DAF, the error SPICE(DAFNOSUCHHANDLE) is signalled. */ - -/* This routine allows subroutines to test file handles for */ -/* validity before performing operations on them, such as */ -/* finding the name of the file designated by a handle. Many */ -/* DAF operations on handles may cause unpredictable program */ -/* behavior if the handles are invalid. This routine should */ -/* be used in situations where the appropriate action to take upon */ -/* determining that a handle is invalid is to signal an error. */ -/* DAFSIH centralizes the error response for this type of error in a */ -/* single routine. */ - -/* In cases where it is necessary to determine the validity of a */ -/* file handle, but it is not an error for the handle to refer */ -/* to a closed file, the entry point DAFHOF should be used instead */ -/* of DAFSIH. */ - -/* $ Examples */ - -/* 1) Add data to a DAF specified by a file handle. Signal an */ -/* error if the file is not open for writing. Check the */ -/* SPICELIB error status function FAILED after calling */ -/* DAFSIH, so that the routine will return if DAFSIH */ -/* signalled an error (we're presuming that this code */ -/* fragment would be used in a subroutine). */ - -/* C */ -/* C Check that HANDLE is valid, then add data to the */ -/* C file specified by HANDLE. */ -/* C */ -/* CALL DAFSIH ( HANDLE, 'WRITE' ) */ - -/* IF ( FAILED() ) THEN */ -/* RETURN */ -/* END IF */ - -/* CALL DAFBNA ( HANDLE, SUM, NAME ) */ -/* CALL DAFADA ( DATA, N ) */ -/* CALL DAFENA */ - -/* 2) Find the size of an array in a DAF specified by a file */ -/* handle. Signal an error if the file is not open for reading. */ - -/* C */ -/* C Check that HANDLE is valid, then obtain the */ -/* C current array summary and compute the size of */ -/* C the current array. */ -/* C */ -/* CALL DAFSIH ( HANDLE, 'READ' ) */ - -/* IF ( FAILED() ) THEN */ -/* RETURN */ -/* END IF */ - -/* C */ -/* C Obtain the summary format, then the integer and d.p. */ -/* C components of the summary. Finally, compute the */ -/* C array length. */ -/* C */ -/* CALL DAFHSF ( HANDLE, ND, NI ) */ -/* CALL DAFGS ( SUMMRY ) */ -/* CALL DAFUS ( SUMMRY, ND, NI, DC, IC ) */ - -/* IA = IC( NI - 1 ) */ -/* FA = IC( NI ) */ -/* LENGTH = FA - IA + 1 */ - -/* 3) Make sure that a file handle designates an open DAF. Signal */ -/* an error if it does not. */ - -/* Note that if a DAF is open at all, read access is allowed. */ - -/* CALL DAFSIH ( HANDLE, 'READ' ) */ - -/* IF ( FAILED() ) THEN */ -/* RETURN */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 13-NOV-2001 (FST) */ - -/* This routine was updated to utilize the new handle manager */ -/* software to manage binary file formats and consolidated */ -/* I/O code. */ - -/* - SPICELIB Version 7.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 7.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 7.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 7.0.1, 17-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.2.1, 29-SEP-1993 (KRG) */ - -/* Removed references to specific DAF file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.2.0, 25-FEB-1993 (JML) */ - -/* IOSTAT is now checked after the INQUIRE statement. */ - -/* - 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, 03-SEP-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* signal an error for invalid daf handles */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFSIH", (ftnlen)6); - } - -/* Initialize the handle list, if necessary. */ - - if (first) { - ssizei_(&c__1000, fhlist); - first = FALSE_; - } - -/* Get an upper case, left-justified copy of ACCESS. */ - - ljust_(access, acc, access_len, (ftnlen)10); - ucase_(acc, acc, (ftnlen)10, (ftnlen)10); - -/* Make sure we recognize the access type specified by the caller. */ - - if (s_cmp(acc, "READ", (ftnlen)10, (ftnlen)4) != 0 && s_cmp(acc, "WRITE", - (ftnlen)10, (ftnlen)5) != 0) { - setmsg_("Unrecognized access type. Type was #. ", (ftnlen)39); - errch_("#", access, (ftnlen)1, access_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("DAFSIH", (ftnlen)6); - return 0; - } - -/* Retrieve information about this HANDLE. */ - - zzddhnfo_(handle, dafnam, &iarc, &ibff, &iamh, &found, (ftnlen)255); - -/* See whether the input handle is in our list at all. It's */ -/* unlawful for the handle to be absent. All open DAFs are */ -/* readable, so in the case that ACC is 'READ', we're done if */ -/* the DAF is open. */ - - if (! found || ! elemi_(handle, fhlist)) { - setmsg_("There is no file open with handle = #", (ftnlen)37); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHHANDLE)", (ftnlen)22); - chkout_("DAFSIH", (ftnlen)6); - return 0; - -/* If the access type is 'WRITE', the DAF must be open for writing. */ -/* This is not the case if the value of IAMH returned from the handle */ -/* manager is not READ. */ - - } else if (s_cmp(acc, "WRITE", (ftnlen)10, (ftnlen)5) == 0 && iamh == 1) { - setmsg_("DAF not open for write. Handle = #, file = '#'", (ftnlen)47) - ; - errint_("#", handle, (ftnlen)1); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(DAFINVALIDACCESS)", (ftnlen)23); - chkout_("DAFSIH", (ftnlen)6); - return 0; - } - -/* The DAF's handle is o.k. */ - - chkout_("DAFSIH", (ftnlen)6); - return 0; -} /* dafah_ */ - -/* Subroutine */ int dafah_(char *fname, char *ftype, integer *nd, integer * - ni, char *ifname, integer *resv, integer *handle, integer *unit, - integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, - ftnlen ifname_len, ftnlen access_len) -{ - return dafah_0_(0, fname, ftype, nd, ni, ifname, resv, handle, unit, - fhset, access, fname_len, ftype_len, ifname_len, access_len); - } - -/* Subroutine */ int dafopr_(char *fname, integer *handle, ftnlen fname_len) -{ - return dafah_0_(1, fname, (char *)0, (integer *)0, (integer *)0, (char *) - 0, (integer *)0, handle, (integer *)0, (integer *)0, (char *)0, - fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafopw_(char *fname, integer *handle, ftnlen fname_len) -{ - return dafah_0_(2, fname, (char *)0, (integer *)0, (integer *)0, (char *) - 0, (integer *)0, handle, (integer *)0, (integer *)0, (char *)0, - fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafonw_(char *fname, char *ftype, integer *nd, integer * - ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, - ftnlen ftype_len, ftnlen ifname_len) -{ - return dafah_0_(3, fname, ftype, nd, ni, ifname, resv, handle, (integer *) - 0, (integer *)0, (char *)0, fname_len, ftype_len, ifname_len, ( - ftnint)0); - } - -/* Subroutine */ int dafopn_(char *fname, integer *nd, integer *ni, char * - ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen - ifname_len) -{ - return dafah_0_(4, fname, (char *)0, nd, ni, ifname, resv, handle, ( - integer *)0, (integer *)0, (char *)0, fname_len, (ftnint)0, - ifname_len, (ftnint)0); - } - -/* Subroutine */ int dafcls_(integer *handle) -{ - return dafah_0_(5, (char *)0, (char *)0, (integer *)0, (integer *)0, ( - char *)0, (integer *)0, handle, (integer *)0, (integer *)0, (char - *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafhsf_(integer *handle, integer *nd, integer *ni) -{ - return dafah_0_(6, (char *)0, (char *)0, nd, ni, (char *)0, (integer *)0, - handle, (integer *)0, (integer *)0, (char *)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafhlu_(integer *handle, integer *unit) -{ - return dafah_0_(7, (char *)0, (char *)0, (integer *)0, (integer *)0, ( - char *)0, (integer *)0, handle, unit, (integer *)0, (char *)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafluh_(integer *unit, integer *handle) -{ - return dafah_0_(8, (char *)0, (char *)0, (integer *)0, (integer *)0, ( - char *)0, (integer *)0, handle, unit, (integer *)0, (char *)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafhfn_(integer *handle, char *fname, ftnlen fname_len) -{ - return dafah_0_(9, fname, (char *)0, (integer *)0, (integer *)0, (char *) - 0, (integer *)0, handle, (integer *)0, (integer *)0, (char *)0, - fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int daffnh_(char *fname, integer *handle, ftnlen fname_len) -{ - return dafah_0_(10, fname, (char *)0, (integer *)0, (integer *)0, (char *) - 0, (integer *)0, handle, (integer *)0, (integer *)0, (char *)0, - fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafhof_(integer *fhset) -{ - return dafah_0_(11, (char *)0, (char *)0, (integer *)0, (integer *)0, ( - char *)0, (integer *)0, (integer *)0, (integer *)0, fhset, (char * - )0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dafsih_(integer *handle, char *access, ftnlen access_len) -{ - return dafah_0_(12, (char *)0, (char *)0, (integer *)0, (integer *)0, ( - char *)0, (integer *)0, handle, (integer *)0, (integer *)0, - access, (ftnint)0, (ftnint)0, (ftnint)0, access_len); - } - diff --git a/ext/spice/src/cspice/dafana.c b/ext/spice/src/cspice/dafana.c deleted file mode 100644 index 499bc3fdc6..0000000000 --- a/ext/spice/src/cspice/dafana.c +++ /dev/null @@ -1,2457 +0,0 @@ -/* dafana.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1000 = 1000; -static integer c__20 = 20; -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure DAFANA ( DAF, add new array ) */ -/* Subroutine */ int dafana_0_(int n__, integer *handle, doublereal *sum, - char *name__, doublereal *data, integer *n, ftnlen name_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer sthead = -1; - static integer stfptr = -1; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer cloc, dloc, free, stfh[20], word, prev, next, i__, p; - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - static integer bward; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - static integer fward; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - static logical found; - static integer nextp; - static doublereal dc[124]; - static integer ic[250], nd; - extern logical failed_(void); - static char dafnam[255]; - static integer ni; - extern /* Subroutine */ int dafhof_(integer *), dafhfn_(integer *, char *, - ftnlen), dafwda_(integer *, integer *, integer *, doublereal *), - dafhsf_(integer *, integer *, integer *), dafsih_(integer *, char - *, ftnlen); - static char ifname[60]; - extern /* Subroutine */ int cleard_(integer *, doublereal *), dafrcr_( - integer *, integer *, char *, ftnlen), dafrdr_(integer *, integer - *, integer *, integer *, doublereal *, logical *), dafrfr_( - integer *, integer *, integer *, char *, integer *, integer *, - integer *, ftnlen); - static char namrec[1000]; - static logical staddg[20]; - extern /* Subroutine */ int dafwdr_(integer *, integer *, doublereal *), - dafwcr_(integer *, integer *, char *, ftnlen), dafarw_(integer *, - integer *, integer *), dafrwa_(integer *, integer *, integer *), - errhan_(char *, integer *, ftnlen); - static integer stbegn[20]; - extern /* Subroutine */ int dafwfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - static integer stfree[20]; - static char stname[1000*20]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer narray; - extern /* Subroutine */ int chkout_(char *, ftnlen); - static doublereal sumrec[128]; - static char stifnm[60*20]; - static integer namsiz, opnset[1006]; - extern /* Subroutine */ int ssizei_(integer *, integer *); - static integer stlast[20]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - static integer stpool[20]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - static integer stfrst[20]; - static doublereal stlsum[2500] /* was [125][20] */; - static integer sumsiz; - -/* $ Abstract */ - -/* Add a new array to an existing DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAFBNA, DAFCAD */ -/* SUM I DAFBNA */ -/* NAME I DAFBNA */ -/* DATA I DAFADA */ -/* N I DAFADA */ -/* TBSIZE P DAFANA */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF opened for write access */ -/* by a previous call to DAFOPW or DAFOPN. */ - -/* SUM is the summary for the array being added. */ - -/* NAME is the name of the array being added. */ - -/* DATA contains all or part of the data in the array. */ - -/* N is the number of elements in DATA. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* TBSIZE is the size of the file table maintained internally */ -/* by DAFANA, TBSIZE is the maximum number of DAFs */ -/* that can be in use simultaneously by this routine. */ - -/* $ Files */ - -/* See argument HANDLE, above. */ - -/* $ Exceptions */ - -/* 1) If DAFANA is called directly, the error SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* 2) See entry points DAFBNA, DAFADA, DAFENA, and DAFCAD */ -/* for exceptions specific to those entry points. */ - -/* $ Particulars */ - -/* DAFANA serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* DAFBNA Begin new array. */ -/* DAFADA Add data to array. */ -/* DAFCAD Continue adding data. */ -/* DAFENA End new array. */ - -/* The main function of these entry points is to simplify the */ -/* addition of new arrays to existing DAFs. */ - -/* An application can add data to a single DAF, or to multiple DAFs, */ -/* simultaneously. In the case of writing to a single DAF, the */ -/* creation of a new array requires four steps: */ - -/* 1) Open a DAF for write access, using either DAFOPW */ -/* (if the file already exists) or DAFOPN (if it does not). */ - -/* CALL DAFOPW ( FNAME, HANDLE ) */ - -/* 2) Begin the new DAF by calling DAFBNA, */ - -/* CALL DAFBNA ( HANDLE, SUM, NAME ) */ - -/* 3) Add data to the array by calling DAFADA as many times */ -/* as necessary, */ - -/* CALL GET_DATA ( DATA, N, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFADA ( DATA, N ) */ -/* CALL GET_DATA ( DATA, N, FOUND ) */ -/* END DO */ - -/* 4) End the array by calling DAFENA, */ - -/* CALL DAFENA */ - -/* Note that the data can be added in chunks of any size, so long */ -/* as the chunks are ordered correctly. */ - -/* In applications that add data to multiple DAFs simultaneously, it */ -/* is necessary to specify which DAF to add data to. The DAFANA */ -/* entry points that allow specification of a DAF via a file handle */ -/* argument are DAFBNA (DAF, begin new array) and DAFCAD (DAF, */ -/* continue adding data). As in the single-DAF case, arrays are */ -/* started by calls to DAFBNA, and data is added to arrays by calls */ -/* to DAFADA. The last DAF designated by the input file handle */ -/* supplied to DAFBNA or DAFCAD is the `current DAF'. If a */ -/* DAF contains an array started by a call to DAFBNA but not yet */ -/* completed by a call to DAFENA, we call this array the `current */ -/* array' for that DAF. Each call to DAFADA will add data to the */ -/* current array in the current DAF. A call to DAFENA will make the */ -/* current array in the current DAF a permanent addition to that DAF. */ - -/* The notion of `current DAF' as discussed here applies only to */ -/* DAFs acted upon by entry points of DAFANA. In DAFFA, there is a */ -/* DAF that is treated as the `current DAF' for searching; there is */ -/* no connection between the DAFs regarded as current by DAFANA and */ -/* DAFFA. */ - -/* In the following example, we write data obtained from the routine */ -/* GET_DATA into two separate DAFs. The first N/2 elements of the */ -/* array DATA will be written to the first DAF; the rest of the */ -/* array will be written to the second DAF. */ - - -/* 1) Open the DAFs for write access, using either DAFOPW */ -/* (if the files already exist) or DAFOPN (if they do not). */ - -/* CALL DAFOPW ( FNAME1, HANDL1 ) */ -/* CALL DAFOPW ( FNAME2, HANDL2 ) */ - -/* 2) Begin the new DAFs by calling DAFBNA, */ - -/* CALL DAFBNA ( HANDL1, SUM1, NAME1 ) */ -/* CALL DAFBNA ( HANDL2, SUM2, NAME2 ) */ - -/* 3) Add data to the arrays by calling DAFCAD and DAFADA as many */ -/* times as necessary, selecting the file to add data to by */ -/* calling DAFCAD: */ - -/* CALL GET_DATA ( DATA, N, FOUND ) */ - -/* DO WHILE ( FOUND ) */ - -/* CALL DAFCAD ( HANDL1 ) */ -/* CALL DAFADA ( DATA, N/2 ) */ - -/* CALL DAFCAD ( HANDL2 ) */ -/* CALL DAFADA ( DATA( N/2 + 1 ), N - N/2 ) */ - -/* CALL GET_DATA ( DATA, N, FOUND ) */ - -/* END DO */ - -/* 4) End each array by calling DAFENA, selecting the file */ -/* in which to end the array by calling DAFCAD: */ - -/* CALL DAFCAD ( HANDL1 ) */ -/* CALL DAFENA */ - -/* CALL DAFCAD ( HANDL2 ) */ -/* CALL DAFENA */ - - -/* $ Examples */ - -/* 1) The following code fragment illustrates one possible way */ -/* to copy an array from one DAF (with handle ORIGIN) to another */ -/* (with handle COPY), SIZE words at a time. */ - -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* CALL DAFHSF ( ORIGIN, ND, NI ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ - -/* BEGIN = IC(NI-1) */ -/* END = IC(NI ) */ - -/* CALL DAFBNA ( COPY, SUM, NAME ) */ - -/* DO WHILE ( BEGIN .LE. END ) */ -/* CHUNK = MIN ( BEGIN + SIZE - 1, END ) */ - -/* CALL DAFRDA ( ORIGIN, BEGIN, CHUNK, DATA ) */ -/* CALL DAFADA ( DATA, SIZE ) */ - -/* BEGIN = BEGIN + SIZE */ -/* END DO */ - -/* CALL DAFENA */ - - -/* 2) A simple example demonstrating simultaneous addition */ -/* of data to multiple DAFs. We read data from a text */ -/* file containing three columns of numbers, and we write */ -/* the data from each column out to a separate DAF. The */ -/* format of the input text file is as follows: */ - -/* +- -+ */ -/* | n11 n12 n13 | */ -/* | n21 n22 n23 | */ -/* | . . . | */ -/* | . . . | */ -/* | . . . | */ -/* +- -+ */ - -/* Here the symbol nij indicates the jth number on the ith line */ -/* of the file. */ - -/* The delimiters between the numbers in each column may be */ -/* commas or blanks. */ - -/* The input file is called NUMBERS.TXT. The output files are */ -/* called */ - -/* COLUMN1.DAF */ -/* COLUMN2.DAF */ -/* COLUMN3.DAF */ - -/* To confirm that the DAFs created by this program contain the */ -/* correct contents, we will read the data from each DAF and */ -/* combine it to create a new text file call RESULT.TXT. This */ -/* file should contain the same data as NUMBERS.TXT. If */ -/* RESULT.TXT is copied as NUMBERS.TXT and used as the input for */ -/* a second run of this program, the output file RESULT.TXT */ -/* from the second program run should match, up to round-off */ -/* error in the numbers, the input file NUMBERS.TXT containing */ -/* the output of the first program run. If the numbers in */ -/* NUMBERS.TXT are integers, the match should be exact. */ - - -/* PROGRAM WRTDAF */ -/* C */ -/* C Read columns of d.p. numbers from a text file */ -/* C and write the data from each column into a */ -/* C separate DAF. Read these DAFs and create a */ -/* C second text file containing the same data as */ -/* C the input text file. */ -/* C */ -/* C Since we do not need to retain any descriptive */ -/* C information about the DAFs inside of the files */ -/* C themselves, we'll use a summary format having */ -/* C two integer components (the minimum--these are */ -/* C reserved for use by the DAF routines) and zero */ -/* C double precision components. */ -/* C */ -/* C The internal file names and array names will */ -/* C simply indicate the data sources. */ -/* C */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER FNMLEN */ -/* PARAMETER ( FNMLEN = 20 ) */ - -/* INTEGER LINLEN */ -/* PARAMETER ( LINLEN = 80 ) */ - -/* INTEGER MAXCOL */ -/* PARAMETER ( MAXCOL = 3 ) */ - -/* INTEGER ND */ -/* PARAMETER ( ND = 0 ) */ - -/* INTEGER NDAF */ -/* PARAMETER ( NDAF = 3 ) */ - -/* INTEGER NI */ -/* PARAMETER ( NI = 2 ) */ - -/* INTEGER NUMLEN */ -/* PARAMETER ( NUMLEN = 30 ) */ - -/* INTEGER SIG */ -/* PARAMETER ( SIG = 14 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FNMLEN) DAF ( NDAF ) */ -/* CHARACTER*(FNMLEN) INFILE */ -/* CHARACTER*(LINLEN) LINE */ -/* CHARACTER*(NUMLEN) NUMCH ( MAXCOL ) */ -/* CHARACTER*(LINLEN) PRSERR */ -/* CHARACTER*(FNMLEN) RESULT */ - -/* DOUBLE PRECISION DC ( 1 ) */ -/* DOUBLE PRECISION NUMBER ( MAXCOL ) */ -/* DOUBLE PRECISION SUMMRY ( 1 ) */ - -/* INTEGER FA */ -/* INTEGER HAN ( NDAF ) */ -/* INTEGER I */ -/* INTEGER IA */ -/* INTEGER IC ( NI ) */ -/* INTEGER J */ -/* INTEGER LENGTH */ -/* INTEGER NCOLS */ -/* INTEGER PTR */ - -/* LOGICAL EOF */ -/* LOGICAL FOUND */ - -/* C */ -/* C Initial values */ -/* C */ -/* DATA DAF / 'COLUMN1.DAF', */ -/* . 'COLUMN2.DAF', */ -/* . 'COLUMN3.DAF' / */ - -/* DATA INFILE / 'NUMBERS.TXT' / */ -/* DATA RESULT / 'RESULT.TXT' / */ - - -/* C */ -/* C Use SPICELIB call tracing. */ -/* C */ -/* CALL CHKIN ( 'WRTDAF' ) */ - -/* C */ -/* C Create the new DAFs, and start a new array in each */ -/* C one. Just use the file name for the internal file */ -/* C name and array name, for each DAF. No assignments */ -/* C are required for the array summaries. */ -/* C */ -/* DO I = 1, 3 */ -/* CALL DAFOPN ( DAF(I), ND, NI, DAF(I), 0, HAN(I) ) */ -/* CALL DAFBNA ( HAN(I), SUMMRY, DAF(I) ) */ -/* END DO */ - -/* C */ -/* C Now read numbers from the text file, line by line, */ -/* C and add the numbers from each column to the */ -/* C corresponding DAF. */ -/* C */ -/* CALL RDTEXT ( INFILE, LINE, EOF ) */ - -/* DO WHILE ( .NOT. EOF ) */ -/* C */ -/* C Parse the numbers in the input line. They */ -/* C may be separated by commas or blanks (the second */ -/* C argument of LPARSM is a list of allowed */ -/* C delimiters). Parse the strings found by LPARSM. */ -/* C */ -/* C For brevity, we won't check the number of columns */ -/* C found, or the parse error flag. */ -/* C */ -/* CALL LPARSM ( LINE, ' ,', MAXCOL, NCOLS, NUMCH ) */ - -/* DO I = 1, NCOLS */ -/* CALL NPARSD ( NUMCH(I), NUMBER(I), PRSERR, PTR) */ -/* END DO */ - -/* C */ -/* C Add the number from the ith column to the array */ -/* C in the ith DAF. We'll use DAFCAD to select */ -/* C the correct DAF to add data to. */ -/* C */ -/* DO I = 1, NDAF */ -/* CALL DAFCAD ( HAN(I) ) */ -/* CALL DAFADA ( NUMBER(I), 1 ) */ -/* END DO */ - -/* C */ -/* C Get the next line. */ -/* C */ -/* CALL RDTEXT ( INFILE, LINE, EOF ) */ - -/* END DO */ - -/* C */ -/* C Finish (`end') the arrays. Again, we'll use DAFCAD */ -/* C to select the DAFs in which the arrays are to be */ -/* C finished. After finishing each array, close the DAF */ -/* C containing it. */ -/* C */ -/* DO I = 1, NDAF */ -/* CALL DAFCAD ( HAN(I) ) */ -/* CALL DAFENA */ -/* CALL DAFCLS ( HAN(I) ) */ -/* END DO */ - -/* C */ -/* C Now for the verification step. We'll try to */ -/* C build a text file containing the same data as */ -/* C the orginal input file. The format of the numbers, */ -/* C the delimiters separating the numbers, spacing, and */ -/* C non-printing characters may differ. However, if this */ -/* C file is used as the input file, and if the numbers */ -/* C used in the file are integers, WRTDAF will create an */ -/* C exact copy of it. */ -/* C */ - -/* C */ -/* C Open the DAFs for reading. */ -/* C */ -/* DO I = 1, NDAF */ -/* CALL DAFOPR ( DAF(I), HAN(I) ) */ -/* END DO */ - -/* C */ -/* C Obtain the start and end addresses of the */ -/* C data in each DAF. To do this, we'll need to */ -/* C obtain and unpack the array summaries. */ -/* C */ -/* C If all went well, the addresses should be the */ -/* C same for each DAF. We'll assume that the initial */ -/* C and final addresses in the first DAF are correct */ -/* C for all three. */ -/* C */ -/* CALL DAFBFS ( HAN(1) ) */ -/* CALL DAFFNA ( FOUND ) */ -/* CALL DAFGS ( SUMMRY ) */ -/* CALL DAFUS ( SUMMRY, ND, NI, DC, IC ) */ - -/* IA = IC( NI-1 ) */ -/* FA = IC( NI ) */ -/* LENGTH = FA - IA + 1 */ - -/* C */ -/* C Now read numbers from the DAFs and build up */ -/* C lines of text. Write these lines out to our */ -/* C output text file. */ -/* C */ -/* DO I = 0, LENGTH - 1 */ - -/* LINE = ' ' */ - -/* DO J = 1, NDAF */ -/* CALL DAFRDA ( HAN(J), IA+I, IA+I, NUMBER(J)) */ -/* CALL DPSTR ( NUMBER(J), SIG, NUMCH(J) ) */ -/* CALL SUFFIX ( NUMCH(J), 5, LINE ) */ -/* END DO */ - -/* CALL WRLINE ( RESULT, LINE ) */ - -/* END DO */ - -/* C */ -/* C Close the output text file and the DAFs. */ -/* C */ -/* CALL CLLINE ( RESULT ) */ - -/* DO I = 1, NDAF */ -/* CALL DAFCLS( HAN(I) ) */ -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated the entry points of DAFANA to enable its */ -/* internal state table size, TBSIZE, to be smaller */ -/* than the file table maintained by DAFAH: FTSIZE. */ - -/* - SPICELIB Version 2.1.0, 11-JUL-1995 (KRG) */ - -/* Updated to remove potential compiler warnings from the */ -/* truncation of double precision numbers to integers. */ - -/* Also changed was a numeric constant from 1.D0 to the */ -/* equivalent, but more aesthetically pleasing 1.0D0. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous writes to multiple DAFs. */ -/* The $Examples section of this routine now illustrates */ -/* usage of the routine DAFCAD. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* add new daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* This umbrella and its entry points were updated to */ -/* work properly with the changes in the DAF system as */ -/* a result of its utilization of the new handle manager. */ - -/* Since DAFAH now tracks FTSIZE files as defined in */ -/* the include file 'zzddhman.inc', it was decided that */ -/* in the interest of releasing the toolkit this module */ -/* would undergo simple changes. As such most previous */ -/* references to FTSIZE in this umbrella have been replaced */ -/* with TBSIZE where appropriate. DAFBNA now signals an */ -/* error if there is not enough room to add a new DAF's */ -/* dossier to the state table. Also, after attempting to */ -/* clean up all files listed in the state table that are */ -/* not currently open, DAFBNA attempts to locate the */ -/* first dossier with STADDG set to FALSE. This is then */ -/* freed to make room for the new DAF. If DAFBNA fails */ -/* to locate such a dossier in the state table, it */ -/* signals the error SPICE(STFULL). */ - -/* The parameter FILEN was removed, as it is defined */ -/* on an environmental basis in the include file */ -/* 'zzddhman.inc'. */ - - -/* - SPICELIB Version 2.1.0, 11-JUL-1995 (KRG) */ - -/* Updated to remove potential compiler warnings from the */ -/* truncation of double precision numbers to integers. Two */ -/* assignments to NARRAY were updated, being changed from: */ - -/* NARRAY = SUMREC(ARYCNT) */ - -/* to */ - -/* NARRAY = IDINT ( SUMREC(ARYCNT) ) */ - -/* Also changed was a numeric constant from 1.D0 to the */ -/* equivalent, but more aesthetically pleasing 1.0D0. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous writes to multiple DAFs. */ - -/* In previous versions of DAFANA, data could be added to only */ -/* one DAF array at a time. In fact, DAFAH allowed only one */ -/* DAF to be open for writing at any time. Therefore, there was */ -/* no question about which DAF was being operated on by either of */ -/* the DAFANA entry points that don't accept file handles as */ -/* input arguments: DAFADA and DAFENA. In the current version */ -/* of DAFANA, the entry points that don't accept file handles as */ -/* inputs operate on the `current DAF'. The current DAF is the */ -/* last one in which a new array was started by DAFBNA, or in */ -/* which addition of data to an array was continued by the new */ -/* entry point DAFCAD. DAFCAD was added to allow users to set */ -/* the current DAF, so that additions of data to arrays in */ -/* multiple DAFs can be interleaved. */ - -/* Note that the notion of `current DAF' as discussed here applies */ -/* only to DAFs acted upon by entry points of DAFANA. In DAFFA, */ -/* there is a DAF that is treated as the `current DAF' for */ -/* searching; there is no connection between the DAFs regarded */ -/* as current by DAFANA and DAFFA. */ - -/* The two principal changes to DAFANA are the addition of the */ -/* new entry point DAFCAD, and the addition of a data structure */ -/* called the `state table'. The state table is a collection of */ -/* parallel arrays that maintain information about the state */ -/* of each data addition that is currently in progress. The */ -/* state table arrays are indexed by a singly linked list pool; */ -/* this mechanism allows addition and deletion of information */ -/* about data additions without requiring movement of data */ -/* already in the state table. */ - -/* The linked list pool contains an `active' list and a `free' */ -/* list. Nodes in the active list are used to index elements of */ -/* the state table where information about additions in progress */ -/* is stored. The head node of the active list is of particular */ -/* significance: the state information pointed to by this node */ -/* is that of the current DAF. Nodes in the free list index */ -/* elements of the state table that are available for use. */ - -/* When an array is started in a DAF that is not already `known' */ -/* to DAFANA, information about the DAF is added to the state */ -/* table. If there are no free elements in the state table, */ -/* the routine starting the array (DAFBNA) will perform garbage */ -/* collection: the routine will test the handles of each file */ -/* about which information in stored in the state table to see */ -/* whether that file is still open. Nodes containing information */ -/* about DAFs that are no longer open will be moved to the free */ -/* list. */ - -/* Whenever a DAF becomes the current DAF, the linked list */ -/* that indexes the state table is adjusted so that the node */ -/* pointing to information about the current DAF is at the head */ -/* of the active list. This way, a slight efficiency is gained */ -/* when repeated data additions are made to the same DAF, since */ -/* the linear search through the state table for information on */ -/* that DAF will be shortened. */ - -/* Since the algorithms for maintenance of linked lists are well */ -/* known, they are not documented here. However, see the */ -/* internals of the SPICELIB routine SPKBSR for a nice diagram */ -/* describing a similar data structure. */ - -/* The state table contains two arrays that are quite large: */ -/* there are buffers that contain the name and array summary for */ -/* each array under construction. A parallel situation exists */ -/* in DAFFA, where there are buffers that contain the last */ -/* character record and summary record read from each DAF. The */ -/* total storage required for these arrays (in DAFANA and DAFFA */ -/* together) is 4000 * TBSIZE bytes. For this reason, it may be */ -/* a good idea to reduce the value of TBSIZE in SPICELIB versions */ -/* for machines where memory is scarce. */ - -/* On a completely different topic: the local declarations in */ -/* DAFANA have been alphabetized and separated by type, except */ -/* for those relating to the state table. Several hard-coded */ -/* constants have been replaced by parameters. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* State variables. */ - -/* These variables define the state of each DAF to which data */ -/* is currently being added. For each DAF that we're writing to, we */ -/* maintain a copy of: */ - -/* STFH File handle. */ - -/* STIFNM Internal file name. */ - -/* STADDG (`State table: adding') Flag indicating */ -/* whether addition of data to an array is in */ -/* progress. */ - -/* STFRST Record number of initial summary record. */ - -/* STLAST Record number of final summary record. */ - -/* STBEGN Beginning address of new array. */ - -/* STFREE Address of next free word. */ - -/* STLSUM Local copy of the array summary for the current */ -/* array. */ - -/* STNAME Local copy of the array name for the current */ -/* array. */ - - -/* These variables are maintained in a table of parallel arrays; */ -/* the size of the table is TBSIZE. */ - - - -/* The table of state variables is indexed by a singly linked list */ -/* of pointers. This mechanism avoids the work of moving */ -/* the state variable data about as information about DAFs is */ -/* added to or deleted from the table. */ - -/* The structure containing the linked list pointers is called a */ -/* `pool.' The pool contains a list of `active' nodes and a list */ -/* of free nodes. The head nodes of the active and free lists are */ -/* maintained as the variables STHEAD (`state table head') and */ -/* STFPTR (`state table free pointer'), respectively. Every node in */ -/* the pool is on exactly one of these lists. */ - - -/* The pool starts out with all of the nodes on the free list. */ -/* DAFBNA initializes the pool. As new DAFs are written to, */ -/* DAFBNA adds information about them to the state table. Every */ -/* time a DAF array is started by DAFBNA, or selected for */ -/* continuation by DAFCAD, the routine in question `moves' the */ -/* DAF's state information to the head of the active list, if the */ -/* state information is not already there. This re-organization is */ -/* accomplished by deleting the node for the DAF from its current */ -/* position in the active list and inserting the node at the head of */ -/* the list. Thus, the change is made merely by setting pointers, */ -/* not by moving chunks of data in the state table. */ - -/* It may happen that there is no room left in the state table */ -/* to accommodate information about a new DAF. In this case, */ -/* garbage collection must be performed: DAFBNA frees all nodes in */ -/* the table that index DAFs that are not currently open. */ - -/* Note that the routine DAFADA does not modify the state table; it */ -/* merely adds data to the DAF that is at the head of the active */ -/* list. */ - - -/* Other local variables */ - - -/* Save everything between calls */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (sum) { - } - if (data) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_dafbna; - case 2: goto L_dafada; - case 3: goto L_dafena; - case 4: goto L_dafcad; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFANA", (ftnlen)6); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("DAFANA", (ftnlen)6); - } - return 0; -/* $Procedure DAFBNA ( DAF, begin new array ) */ - -L_dafbna: -/* $ Abstract */ - -/* Begin a new array in a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* DOUBLE PRECISION SUM ( * ) */ -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* SUM I Summary of new array. */ -/* NAME I Name of new array. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF opened for write access */ -/* by a previous call to DAFOPW or DAFOPN. */ - -/* SUM is the summary of a new array to be added to the */ -/* specified file. The addresses (the final two integer */ -/* components) need not be filled in. */ - -/* NAME is the name of the new array. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE, above. */ - -/* $ Exceptions */ - -/* 1) If the input handle is not that of a DAF that is open */ -/* for writing, the error is diagnosed by routines called by */ -/* this routine. These files are implicitly of the native */ -/* binary file format. */ - -/* 2) If the input array name is too long to fit in the number */ -/* of characters allowed by the summary format of the DAF */ -/* designated by HANDLE, the excess characters are truncated. */ -/* No error is signalled. */ - -/* 3) If there is not enough room in the state table to add */ -/* the DAF associated with HANDLE, the error SPICE(STFULL) */ -/* is signaled. */ - -/* $ Particulars */ - -/* Only one array can be added to a DAF at any one time, so */ -/* calling DAFBNA cancels any addition to the file specified */ -/* by HANDLE that may be in progress. No warning is issued. */ - -/* $ Examples */ - -/* See DAFANA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated DAFBNA to support changes made to the DAF */ -/* system that utilize the new handle manager. See */ -/* the Revisions section of DAFANA for a detailed */ -/* discussion of the changes. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Modified to support simultaneous writes to multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin new daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Modified to support simultaneous writes to multiple DAFs. */ -/* DAFBNA now adds information about DAFs to the state table, */ -/* deletes information about closed DAFs from the state table, */ -/* and intializes the state pool. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFBNA", (ftnlen)6); - } - -/* Check out the file handle before going any further. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFBNA", (ftnlen)6); - return 0; - } - -/* Initialize the state table pool, if this hasn't been done yet. */ -/* Also initialize the cell used to obtain the set of handles of */ -/* open DAFs. */ - - if (first) { - ssizei_(&c__1000, opnset); - for (i__ = 1; i__ <= 19; ++i__) { - stpool[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stpool" - , i__1, "dafana_", (ftnlen)1067)] = i__ + 1; - } - stpool[19] = -1; - stfptr = 1; - sthead = -1; - first = FALSE_; - } - -/* We know that the beginning of the array will be the first */ -/* free address in the file. We also need the summary format. */ -/* Get both items from the file record. */ - -/* We won't use the information we're obtaining now until */ -/* after we've placed the state information for the current */ -/* DAF at the head of the active list, but we want to make sure */ -/* that we can actually read the file record first. So, we */ -/* do the read now and avoid modifying the active list if the */ -/* read fails. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - -/* If we couldn't read the file record, bail out now. */ - - if (failed_()) { - chkout_("DAFBNA", (ftnlen)6); - return 0; - } - -/* See whether we already have an entry for this DAF in the */ -/* state table. Find the previous node if possible. */ - - p = sthead; - prev = -1; - found = FALSE_; - while(p != -1 && ! found) { - if (stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1109)] == *handle) { - found = TRUE_; - } else { - prev = p; - p = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stp" - "ool", i__1, "dafana_", (ftnlen)1113)]; - } - } - -/* At this point, either FOUND is false, or P points to a */ -/* state table entry describing the DAF indicated by HANDLE. */ -/* In the latter case, PREV is the predecessor of P. */ - - - if (found) { - -/* We already have a dossier on this DAF. We already have */ -/* the information on the summary format, but we must re-set */ -/* the rest of our state information. */ - -/* Rather than doing the update here, we do it outside of this */ -/* IF block. That way, the update gets done in just one place. */ -/* This just makes life easier: if the collection of state */ -/* variables is changed, there are fewer places to forget to */ -/* make the required code changes. */ - -/* Move the node for this DAF to the head of the active list, */ -/* if it is not already there: */ - -/* - Make the predecessor of P point to the successor of P. */ - -/* - Make P point to the head of the active list. */ - -/* - Make P the active list head node. */ - - - if (p != sthead) { - -/* P is in the active list, but is not at the head. So, */ -/* the predecessor of P is not NIL. */ - - stpool[(i__1 = prev - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stpo" - "ol", i__1, "dafana_", (ftnlen)1151)] = stpool[(i__2 = p - - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("stpool", i__2, - "dafana_", (ftnlen)1151)]; - stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "dafana_", (ftnlen)1152)] = sthead; - sthead = p; - } - } else { - -/* We don't yet have any information on this DAF. Make a new */ -/* state table entry for the DAF. We may need to make room for */ -/* the new information by freeing space allocated to DAFs that */ -/* are no longer open. */ - - if (stfptr == -1) { - -/* Oops, we're out of space. Time for garbage collection. */ -/* Test each file handle to see whether it designates a DAF */ -/* that is still open. DAFHOF will tell us which handles */ -/* point to open DAFs. */ - - dafhof_(opnset); - p = sthead; - prev = -1; - -/* For every DAF file represented in the state table, we'll */ -/* delete the corresponding state information if the DAF is */ -/* now closed. We traverse the active list, examining each */ -/* file handle as we go. */ - - while(p != -1) { - if (elemi_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("stfh", i__1, "dafana_", (ftnlen)1185)], - opnset)) { - -/* The file is open. Have a look at the next node. */ - - prev = p; - p = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "dafana_", (ftnlen)1190)]; - } else { - -/* This file handle is not on the list, so free the */ -/* node pointing to the information about the DAF it */ -/* designated: */ - -/* - Save the successor of P. */ - -/* - Link the predecessor of node P to the successor */ -/* of P, if the predecessor is not NIL. */ - -/* - If it happens that P is the head node of the */ -/* active list, set the head equal to the */ -/* successor of P. */ - -/* - Link P into the free list. */ - -/* - Set P equal to its saved successor. */ - -/* - (PREV remains unchanged.) */ - - - nextp = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "dafana_", (ftnlen)1214)]; - if (p == sthead) { - -/* Re-assign STHEAD so that we don't lose the head */ -/* of the active list. P has no predecessor in this */ -/* case, so there's no need to set the forward pointer */ -/* of node PREV. */ - - sthead = nextp; - } else { - -/* Since P is not the head node of the active list, */ -/* PREV is not NIL, so we'll need to set the forward */ -/* pointer of node PREV. */ - - stpool[(i__1 = prev - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "dafana_", (ftnlen) - 1231)] = nextp; - } - stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "dafana_", (ftnlen)1236)] = - stfptr; - stfptr = p; - p = nextp; - } - } - -/* At this point, we've freed all nodes from the active */ -/* list that were used to index information about DAFs that */ -/* are no longer open. Now see if we still need to make */ -/* room. If so, locate the first dossier with STADDG(P) */ -/* set to FALSE. We know then that this file is not */ -/* currently involved in an array addition. */ - - if (stfptr == -1) { - found = FALSE_; - p = sthead; - prev = -1; - while(p != -1 && ! found) { - -/* If STADDG(P) is TRUE, then we must continue */ -/* searching. */ - - if (staddg[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("staddg", i__1, "dafana_", (ftnlen)1264)]) - { - prev = p; - p = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "dafana_", (ftnlen) - 1267)]; - } else { - found = TRUE_; - -/* No array is presently being added to the DAF */ -/* associated with this dossier, so free the */ -/* node pointing to the information about the DAF it */ -/* designated: */ - -/* - Save the successor of P. */ - -/* - Link the predecessor of node P to the successor */ -/* of P, if the predecessor is not NIL. */ - -/* - If it happens that P is the head node of the */ -/* active list, set the head equal to the */ -/* successor of P. */ - -/* - Link P into the free list. */ - -/* - Set P equal to its saved successor. */ - -/* - (PREV remains unchanged.) */ - - - nextp = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("stpool", i__1, "dafana_", ( - ftnlen)1294)]; - if (p == sthead) { - -/* Re-assign STHEAD so that we don't lose the head */ -/* of the active list. P has no predecessor in */ -/* this case, so there's no need to set the */ -/* forward pointer of node PREV. */ - - sthead = nextp; - } else { - -/* Since P is not the head node of the active list, */ -/* PREV is not NIL, so we'll need to set the */ -/* forward pointer of node PREV. */ - - stpool[(i__1 = prev - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("stpool", i__1, "dafana_", ( - ftnlen)1311)] = nextp; - } - stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "dafana_", (ftnlen) - 1316)] = stfptr; - stfptr = p; - p = nextp; - } - } - } - -/* Now, check to see if there is now room to add the dossier */ -/* for the new DAF to the state table. If not signal an error. */ - - if (stfptr == -1) { - setmsg_("Attempt to initiate create a new array in DAF '#' h" - "as failed. DAFANA's state table has room to manage w" - "riting to # new arrays simultaneously, but there is " - "no room left in the table for this DAF.", (ftnlen)194) - ; - errhan_("#", handle, (ftnlen)1); - errint_("#", &c__20, (ftnlen)1); - sigerr_("SPICE(STFULL)", (ftnlen)13); - chkout_("DAFBNA", (ftnlen)6); - return 0; - } - } - -/* If we reach here, then we have room in the state table for */ -/* the new DAF. The first free node is indicated by SFTPTR. */ -/* Allocate this node and use it to index the state information */ -/* for the new DAF. */ - - p = stfptr; - -/* Update the free list pointer, link P to the previous head */ -/* of the active list, and make P the head of the active list. */ - - stfptr = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "dafana_", (ftnlen)1360)]; - stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "dafana_", (ftnlen)1361)] = sthead; - sthead = p; - } - -/* At this point, P is the head node of the active list, and P is */ -/* the index in the state table of the information for the current */ -/* DAF. */ - - -/* Set the state information for the current array. */ - - stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", i__1, "daf" - "ana_", (ftnlen)1375)] = *handle; - s_copy(stifnm + ((i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stifnm" - , i__1, "dafana_", (ftnlen)1376)) * 60, ifname, (ftnlen)60, ( - ftnlen)60); - staddg[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("staddg", i__1, - "dafana_", (ftnlen)1377)] = TRUE_; - stfrst[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfrst", i__1, - "dafana_", (ftnlen)1378)] = fward; - stlast[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stlast", i__1, - "dafana_", (ftnlen)1379)] = bward; - stbegn[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stbegn", i__1, - "dafana_", (ftnlen)1380)] = free; - stfree[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfree", i__1, - "dafana_", (ftnlen)1381)] = free; - -/* Find out how big the array summary is supposed to be. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1386)], &nd, &ni); - sumsiz = nd + (ni + 1) / 2; - -/* Set the local copies of the array's summary and name. */ - - moved_(sum, &sumsiz, &stlsum[(i__1 = p * 125 - 125) < 2500 && 0 <= i__1 ? - i__1 : s_rnge("stlsum", i__1, "dafana_", (ftnlen)1393)]); - s_copy(stname + ((i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stname" - , i__1, "dafana_", (ftnlen)1395)) * 1000, name__, (ftnlen)1000, - name_len); - chkout_("DAFBNA", (ftnlen)6); - return 0; -/* $Procedure DAFADA ( DAF, add data to array ) */ - -L_dafada: -/* $ Abstract */ - -/* Add one or more double precision words of data to the newest */ -/* array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* DOUBLE PRECISION DATA ( * ) */ -/* INTEGER N */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* DATA I Elements of the new array. */ -/* N I Number of elements in DATA. */ - -/* $ Detailed_Input */ - -/* DATA is an arbitrary number of double precision words to */ -/* be added to the data in the array being created. */ - -/* N is the number of double precision words in DATA. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there are no DAFs to which data is currently being added, */ -/* the error SPICE(DAFNOWRITE) is signalled. */ - -/* 2) If a new array has not been started in the current DAF (by a */ -/* call to DAFBNA), the error SPICE(DAFNEWCONFLICT) is signalled. */ - -/* 3) If N is less than one, no data are added to the file. */ - -/* $ Particulars */ - -/* DAFADA adds data to the last array begun by DAFBNA or selected */ -/* by DAFCAD. */ - -/* Data can be added to a DAF in chunks of any size, so long */ -/* as the chunks are added in the proper order. */ - -/* $ Examples */ - -/* See example for DAFADA in the header of DAFANA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated entry points to support changes made to the DAF */ -/* system that utilize the new handle manager. See */ -/* the Revisions section of DAFANA for a detailed */ -/* discussion of the changes. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to work with new DAF routines that allow writing */ -/* to multiple DAFs simultaneously. Functionality for */ -/* applications that write to one DAF at a time is unchanged. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* add data to daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to work with new DAF routines that allow writing */ -/* to multiple DAFs simultaneously. Functionality for */ -/* applications that write to one DAF at a time is unchanged. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFADA", (ftnlen)6); - } - -/* This routine operates on the DAF at the head of the active list. */ - - p = sthead; - -/* We must make sure that the requested addition can be performed. */ -/* We don't validate the file handle here because this is one place */ -/* where we are concerned about speed. The low-level writer routine */ -/* DAFWDR will handle the check. */ - - if (p == -1) { - setmsg_("No DAF is currently being written.", (ftnlen)34); - sigerr_("SPICE(DAFNOWRITE)", (ftnlen)17); - chkout_("DAFADA", (ftnlen)6); - return 0; - -/* An array cannot be extended unless begun first. */ - - } else if (! staddg[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "staddg", i__1, "dafana_", (ftnlen)1592)]) { - -/* Validate the current handle, then get the name of the DAF. */ - - dafsih_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1596)], "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFADA", (ftnlen)6); - return 0; - } - dafhfn_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1603)], dafnam, (ftnlen)255); - setmsg_("An attempt was made to add data to an array that has not ye" - "t been begun, in file #.", (ftnlen)83); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(DAFNEWCONFLICT)", (ftnlen)21); - chkout_("DAFADA", (ftnlen)6); - return 0; - -/* Start adding data at the first free address, then update that */ -/* address to get ready for the next addition. */ - - } else if (*n >= 1) { - i__4 = stfree[(i__3 = p - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("stfr" - "ee", i__3, "dafana_", (ftnlen)1617)] + *n - 1; - dafwda_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1617)], &stfree[(i__2 = p - 1) < 20 - && 0 <= i__2 ? i__2 : s_rnge("stfree", i__2, "dafana_", ( - ftnlen)1617)], &i__4, data); - stfree[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfree", - i__1, "dafana_", (ftnlen)1618)] = stfree[(i__2 = p - 1) < 20 - && 0 <= i__2 ? i__2 : s_rnge("stfree", i__2, "dafana_", ( - ftnlen)1618)] + *n; - } - chkout_("DAFADA", (ftnlen)6); - return 0; -/* $Procedure DAFENA ( DAF, end new array ) */ - -L_dafena: -/* $ Abstract */ - -/* End the addition of data to the newest array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there are no DAFs to which data is currently being added, */ -/* the error SPICE(DAFNOWRITE) is signalled, or the error will */ -/* be detected by routines called by this routine. */ - -/* 2) If a new array has not been started in the current DAF (by a */ -/* call to DAFBNA), the error SPICE(DAFNEWCONFLICT) is signalled. */ - -/* $ Particulars */ - -/* DAFENA makes the current array a permanent addition to the */ -/* current DAF. */ - -/* The pointers within the file are not changed until an array */ -/* is ended successfully. If an error occurs or if the current */ -/* DAF is closed before DAFENA is called, the last array will */ -/* not be visible to the DAF reader routines. */ - -/* $ Examples */ - -/* See DAFANA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated entry points to support changes made to the DAF */ -/* system that utilize the new handle manager. See */ -/* the Revisions section of DAFANA for a detailed */ -/* discussion of the changes. */ - -/* - SPICELIB Version 2.1.0, 11-JUL-1995 (KRG) */ - -/* Updated to remove potential compiler warnings from the */ -/* truncation of double precision numbers to integers. */ - -/* Also changed was a numeric constant from 1.D0 to the */ -/* equivalent, but more aesthetically pleasing 1.0D0. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to work with new DAF routines that allow writing */ -/* to multiple DAFs simultaneously. Functionality for */ -/* applications that write to one DAF at a time is unchanged. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* end new daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 11-JUL-1995 (KRG) */ - -/* Updated to remove potential compiler warnings from the */ -/* truncation of double precision numbers to integers. Two */ -/* assignments to NARRAY were updated, being changed from: */ - -/* NARRAY = SUMREC(ARYCNT) */ - -/* to */ - -/* NARRAY = IDINT ( SUMREC(ARYCNT) ) */ - -/* Also changed was a numeric constant from 1.D0 to the */ -/* equivalent, but more aesthetically pleasing 1.0D0. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to work with new DAF routines that allow writing */ -/* to multiple DAFs simultaneously. Functionality for */ -/* applications that write to one DAF at a time is unchanged. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFENA", (ftnlen)6); - } - -/* This routine operates on the DAF at the head of the active list. */ - - p = sthead; - if (p == -1) { - setmsg_("No DAF is currently being written.", (ftnlen)34); - sigerr_("SPICE(DAFNOWRITE)", (ftnlen)17); - chkout_("DAFENA", (ftnlen)6); - return 0; - -/* A new array cannot be ended unless begun first. */ - - } else if (! staddg[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "staddg", i__1, "dafana_", (ftnlen)1832)]) { - -/* Validate the current handle, then get the name of the DAF. */ - - dafsih_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1836)], "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFENA", (ftnlen)6); - return 0; - } - dafhfn_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1843)], dafnam, (ftnlen)255); - setmsg_("An attempt was made to end an array that has not yet been b" - "egun, in file #.", (ftnlen)75); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(DAFNEWCONFLICT)", (ftnlen)21); - chkout_("DAFENA", (ftnlen)6); - return 0; - } - -/* No more data. The array ends just before the next free */ -/* address. The summary should be complete except for the */ -/* initial and final addresses of the data, of which we */ -/* have been keeping track. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1859)], &nd, &ni); - dafus_(&stlsum[(i__1 = p * 125 - 125) < 2500 && 0 <= i__1 ? i__1 : s_rnge( - "stlsum", i__1, "dafana_", (ftnlen)1861)], &nd, &ni, dc, ic); - ic[(i__1 = ni - 2) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, "dafan" - "a_", (ftnlen)1863)] = stbegn[(i__2 = p - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("stbegn", i__2, "dafana_", (ftnlen)1863)]; - ic[(i__1 = ni - 1) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, "dafan" - "a_", (ftnlen)1864)] = stfree[(i__2 = p - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("stfree", i__2, "dafana_", (ftnlen)1864)] - 1; - dafps_(&nd, &ni, dc, ic, &stlsum[(i__1 = p * 125 - 125) < 2500 && 0 <= - i__1 ? i__1 : s_rnge("stlsum", i__1, "dafana_", (ftnlen)1866)]); - -/* The summary should be stored in the final summary record (the */ -/* one at the end of the file). Get that entire record, and the */ -/* corresponding name record. */ - - dafrdr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1873)], &stlast[(i__2 = p - 1) < 20 && 0 - <= i__2 ? i__2 : s_rnge("stlast", i__2, "dafana_", (ftnlen)1873)], - &c__1, &c__128, sumrec, &found); - i__3 = stlast[(i__2 = p - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("stlast", - i__2, "dafana_", (ftnlen)1874)] + 1; - dafrcr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1874)], &i__3, namrec, (ftnlen)1000); - narray = (integer) sumrec[2]; - -/* The number of arrays determines where the summary and name */ -/* are stored within the summary record. Adding this array increases */ -/* the number of arrays by one. */ - - sumsiz = nd + (ni + 1) / 2; - dloc = narray * sumsiz + 4; - moved_(&stlsum[(i__1 = p * 125 - 125) < 2500 && 0 <= i__1 ? i__1 : s_rnge( - "stlsum", i__1, "dafana_", (ftnlen)1885)], &sumsiz, &sumrec[(i__2 - = dloc - 1) < 128 && 0 <= i__2 ? i__2 : s_rnge("sumrec", i__2, - "dafana_", (ftnlen)1885)]); - namsiz = sumsiz << 3; - cloc = narray * namsiz + 1; - s_copy(namrec + (cloc - 1), stname + ((i__1 = p - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("stname", i__1, "dafana_", (ftnlen)1890)) * 1000, - cloc + namsiz - 1 - (cloc - 1), (ftnlen)1000); - sumrec[2] += 1.; - narray = (integer) sumrec[2]; - -/* Usually, adding an array does not fill the final summary */ -/* record, and it can simply be replaced. */ - - if (narray < 125 / sumsiz) { - dafwdr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1901)], &stlast[(i__2 = p - 1) < 20 - && 0 <= i__2 ? i__2 : s_rnge("stlast", i__2, "dafana_", ( - ftnlen)1901)], sumrec); - i__3 = stlast[(i__2 = p - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("stla" - "st", i__2, "dafana_", (ftnlen)1902)] + 1; - dafwcr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1902)], &i__3, namrec, (ftnlen)1000) - ; - -/* When the record becomes full, a new one must be written. */ -/* However, this fact should be transparent to the user. */ - - } else { - -/* The new summary record will be stored in the next free record */ -/* in the file. This summary record should point to it. */ - -/* To find out which record the next free address is in, we use */ -/* DAFARW (`address to record and word'). */ - - i__2 = stfree[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfr" - "ee", i__1, "dafana_", (ftnlen)1917)] - 1; - dafarw_(&i__2, &next, &word); - ++next; - sumrec[0] = (doublereal) next; - dafwdr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1921)], &stlast[(i__2 = p - 1) < 20 - && 0 <= i__2 ? i__2 : s_rnge("stlast", i__2, "dafana_", ( - ftnlen)1921)], sumrec); - i__3 = stlast[(i__2 = p - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("stla" - "st", i__2, "dafana_", (ftnlen)1922)] + 1; - dafwcr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1922)], &i__3, namrec, (ftnlen)1000) - ; - -/* The new summary record should point backwards to the one just */ -/* written, and should point forwards to nothing. Of course, */ -/* it contains no summaries, and no names. */ - - cleard_(&c__128, sumrec); - sumrec[0] = 0.; - sumrec[1] = (doublereal) stlast[(i__1 = p - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("stlast", i__1, "dafana_", (ftnlen)1931)]; - sumrec[2] = 0.; - s_copy(namrec, " ", (ftnlen)1000, (ftnlen)1); - dafwdr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1935)], &next, sumrec); - i__2 = next + 1; - dafwcr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1936)], &i__2, namrec, (ftnlen)1000) - ; - -/* If a new summary record was added, the first free address */ -/* lies just beyond the end of the matching character record. */ - -/* We use DAFRWA (`record and word to address') to calculate */ -/* the next free address. */ - - stlast[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stlast", - i__1, "dafana_", (ftnlen)1945)] = next; - i__3 = stlast[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stla" - "st", i__1, "dafana_", (ftnlen)1946)] + 2; - dafrwa_(&i__3, &c__1, &stfree[(i__2 = p - 1) < 20 && 0 <= i__2 ? i__2 - : s_rnge("stfree", i__2, "dafana_", (ftnlen)1946)]); - } - -/* The new value STFREE(P) must be rewritten in the file record each */ -/* time a new array is added. If a new record was added, the new */ -/* value of STLAST(P) will be rewritten as well. */ - - dafwfr_(&stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)1955)], &nd, &ni, stifnm + ((i__2 = p - - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("stifnm", i__2, "dafana_", ( - ftnlen)1955)) * 60, &stfrst[(i__3 = p - 1) < 20 && 0 <= i__3 ? - i__3 : s_rnge("stfrst", i__3, "dafana_", (ftnlen)1955)], &stlast[( - i__4 = p - 1) < 20 && 0 <= i__4 ? i__4 : s_rnge("stlast", i__4, - "dafana_", (ftnlen)1955)], &stfree[(i__5 = p - 1) < 20 && 0 <= - i__5 ? i__5 : s_rnge("stfree", i__5, "dafana_", (ftnlen)1955)], ( - ftnlen)60); - -/* Ready for another array. */ - - staddg[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("staddg", i__1, - "dafana_", (ftnlen)1966)] = FALSE_; - chkout_("DAFENA", (ftnlen)6); - return 0; -/* $Procedure DAFCAD ( DAF, continue adding data ) */ - -L_dafcad: -/* $ Abstract */ - -/* Select a DAF that already has a new array in progress as the */ -/* one to continue adding data to. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF to continue adding data to. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF that is open for write */ -/* access and in which a new array has been */ -/* started by a call to DAFBNA. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input handle is not that of a DAF that is open */ -/* for writing, the error will be diagnosed by routines called */ -/* by this routine. */ - -/* 2) If no array is currently being added to in the file indicated */ -/* by HANDLE, the error will be diagnosed by this routine or */ -/* routines called by this routine. If DAFCAD can detect the */ -/* problem, the error SPICE(NOARRAYSTARTED) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DAFCAD supports simultaneous addition of data to arrays in */ -/* multiple DAFs. In applications that use this capability, */ -/* DAFCAD should be called prior to each call to DAFADA or DAFENA */ -/* to specify which DAF is to be acted upon. */ - -/* Here is a code fragment that adds a new array to each of N */ -/* existing DAFs, simultaneously. The data to be added to each */ -/* is broken up into M chunks; one chunk is written to each DAF */ -/* at a time. The data is contained in the array CHUNK, dimensioned */ - -/* DOUBLE PRECISION CHUNK ( MAXDAT, M, N ) */ - -/* The actual amount of data in the Jth chunk for the Ith file is */ -/* given by */ - -/* AMOUNT (J,I) */ - - - -/* DO I = 1, N */ -/* CALL DAFOPW ( HANDLE(I) ) */ -/* CALL DAFBNA ( HANDLE(I) ) */ -/* END DO */ - -/* DO J = 1, M */ - -/* DO I = 1, N */ -/* CALL DAFCAD ( HANDLE(I) ) */ -/* CALL DAFADA ( CHUNK(1,J,I), AMOUNT(J,I) ) */ -/* END DO */ - -/* END DO */ - -/* DO I = 1, N */ -/* CALL DAFCAD ( HANDLE(I) ) */ -/* CALL DAFENA */ -/* END DO */ - - -/* Note that if we write all of the data for each array to just one */ -/* DAF at a time, we don't need to use DAFCAD: */ - -/* DO I = 1, N */ - -/* CALL DAFOPW ( HANDLE(I) ) */ -/* CALL DAFBNA ( HANDLE(I) ) */ - -/* DO J = 1, M */ -/* CALL DAFADA ( CHUNK(1,J,I), AMOUNT(J,I) ) */ -/* END DO */ - -/* CALL DAFENA */ - -/* END DO */ - - -/* $ Examples */ - -/* See DAFANA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated entry points to support changes made to the DAF */ -/* system that utilize the new handle manager. See */ -/* the Revisions section of DAFANA for a detailed */ -/* discussion of the changes. */ - -/* - 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, 04-SEP-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* continue adding data to a daf */ -/* select a daf to continue adding data to */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFCAD", (ftnlen)6); - } - -/* Check out the file handle before going any further. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFCAD", (ftnlen)6); - return 0; - } - -/* See whether we already have an entry for this DAF in the */ -/* state table. Find the previous node if possible. */ - - p = sthead; - prev = -1; - found = FALSE_; - while(p != -1 && ! found) { - if (stfh[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "dafana_", (ftnlen)2189)] == *handle) { - found = TRUE_; - } else { - prev = p; - p = stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stp" - "ool", i__1, "dafana_", (ftnlen)2193)]; - } - } - -/* Either FOUND is false, or P is the index in the state table of */ -/* the DAF specified by HANDLE, and PREV is the predecessor of P. */ - - -/* You can't continue writing to a DAF that you're not */ -/* already writing to. */ - - if (! found) { - dafhfn_(handle, dafnam, (ftnlen)255); - setmsg_("No write in progress to #. (Handle was #.) ", (ftnlen)43); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(NOARRAYSTARTED)", (ftnlen)21); - chkout_("DAFCAD", (ftnlen)6); - return 0; - } else if (! staddg[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "staddg", i__1, "dafana_", (ftnlen)2217)]) { - dafhfn_(handle, dafnam, (ftnlen)255); - setmsg_("No write in progress to #. (Handle was #.) ", (ftnlen)43); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(NOARRAYSTARTED)", (ftnlen)21); - chkout_("DAFCAD", (ftnlen)6); - return 0; - } - -/* Move the node for this DAF to the head of the active list, */ -/* if it is not already there: */ - -/* - Make the predecessor of P point to the successor of P. */ - -/* - Make P point to the head of the active list. */ - -/* - Make P the active list head node. */ - - - if (p != sthead) { - -/* P is in the active list, but is not at the head. So, */ -/* the predecessor of P is not NIL. */ - - stpool[(i__1 = prev - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "dafana_", (ftnlen)2246)] = stpool[(i__2 = p - 1) < 20 - && 0 <= i__2 ? i__2 : s_rnge("stpool", i__2, "dafana_", ( - ftnlen)2246)]; - stpool[(i__1 = p - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "dafana_", (ftnlen)2247)] = sthead; - sthead = p; - } - chkout_("DAFCAD", (ftnlen)6); - return 0; -} /* dafana_ */ - -/* Subroutine */ int dafana_(integer *handle, doublereal *sum, char *name__, - doublereal *data, integer *n, ftnlen name_len) -{ - return dafana_0_(0, handle, sum, name__, data, n, name_len); - } - -/* Subroutine */ int dafbna_(integer *handle, doublereal *sum, char *name__, - ftnlen name_len) -{ - return dafana_0_(1, handle, sum, name__, (doublereal *)0, (integer *)0, - name_len); - } - -/* Subroutine */ int dafada_(doublereal *data, integer *n) -{ - return dafana_0_(2, (integer *)0, (doublereal *)0, (char *)0, data, n, ( - ftnint)0); - } - -/* Subroutine */ int dafena_(void) -{ - return dafana_0_(3, (integer *)0, (doublereal *)0, (char *)0, (doublereal - *)0, (integer *)0, (ftnint)0); - } - -/* Subroutine */ int dafcad_(integer *handle) -{ - return dafana_0_(4, handle, (doublereal *)0, (char *)0, (doublereal *)0, ( - integer *)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/dafarr.c b/ext/spice/src/cspice/dafarr.c deleted file mode 100644 index bf8935bbf3..0000000000 --- a/ext/spice/src/cspice/dafarr.c +++ /dev/null @@ -1,477 +0,0 @@ -/* dafarr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure DAFARR ( DAF, add reserved records ) */ -/* Subroutine */ int dafarr_(integer *handle, integer *resv) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char crec[1000]; - doublereal drec[128]; - integer free, incr, word, next, i__; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen), - dafps_(integer *, integer *, doublereal *, integer *, doublereal * - ); - integer bward; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - integer fward; - extern /* Subroutine */ int dafws_(doublereal *); - integer recno; - logical found; - doublereal dc[125]; - integer ic[250]; - extern /* Subroutine */ int daffna_(logical *); - integer nd; - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer begblk, ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - integer endblk; - extern /* Subroutine */ int dafrdr_(integer *, integer *, integer *, - integer *, doublereal *, logical *), dafrcr_(integer *, integer *, - char *, ftnlen), dafrfr_(integer *, integer *, integer *, char *, - integer *, integer *, integer *, ftnlen), dafarw_(integer *, - integer *, integer *), dafwcr_(integer *, integer *, char *, - ftnlen), dafwdr_(integer *, integer *, doublereal *), dafwfr_( - integer *, integer *, integer *, char *, integer *, integer *, - integer *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - doublereal sum[125]; - -/* $ Abstract */ - -/* Add a specified number of reserved records to a Double Precision */ -/* Array File (DAF). */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened for writing. */ -/* RESV I Number of records to reserve. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF file that has */ -/* been opened with write access. */ - -/* RESV is the number of reserved records to be added */ -/* to the specified file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If RESV is less than one, the file is not changed. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* Normally, the reserved records in an array file are reserved */ -/* when the file is created. However, it may occasionally become */ -/* necessary to add reserved records---when the contents of one */ -/* file are appended to another, for example. (In this case, any */ -/* information in the reserved records of either file should */ -/* be included in the resulting file.) */ - -/* The new reserved records are appended to the old ones. The new */ -/* reserved records are also NULL filled. */ - -/* $ Examples */ - -/* In the following call to DAFARR, assume that HANDLE is the file */ -/* handle for a DAF file that has been opened for write access, and */ -/* that the DAF file already contains 12 reserved records (located in */ -/* records 2-13 of the physical file). */ - -/* CALL DAFARR ( HANDLE, 7 ) */ - -/* After this call, the DAF file attached to HANDLE will contain 19 */ -/* reserved records. The new reserved records are located in */ -/* records 14-20 of the physical file. */ - -/* $ Restrictions */ - -/* 1) This routine will only add reserved records to DAFs open for */ -/* write. These files are implicitly of the native binary file */ -/* format. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.0, 16-NOV-2001 (FST) */ - -/* Added a call to DAFSIH to prevent this routine from */ -/* attempting to write to non-native binary file formats. */ -/* This will provide a more useful error diagnostic with */ -/* little impact on performance. */ - -/* - SPICELIB Version 1.4.0, 08-MAR-1996 (KRG) */ - -/* Added code to write NULL filled records to the file for the */ -/* new reserved records. */ - -/* - SPICELIB Version 1.3.0, 12-MAY-1994 (KRG) */ - -/* Added a missing call to CHKOUT before the RETURN statement in */ -/* the test */ - -/* IF ( RESV .LT. 1 ) THEN */ -/* RETURN */ -/* END IF */ - -/* - SPICELIB Version 1.2.0, 30-SEP-1993 (KRG) */ - -/* Detailed_Input and Examples section of the header were */ -/* modified. */ - -/* Added calls to the FORTRAN intrinsic functions INT and */ -/* DBLE in the code that updates the summary record. */ - -/* Modified an IF loop to make logic clearer. */ - -/* - 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, 17-JUL-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* add daf reserved records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.4.0, 08-MAR-1996 (KRG) */ - -/* Added code to write NULL filled records to the file for the */ -/* new reserved records. */ - -/* - SPICELIB Version 1.3.0, 12-MAY-1994 (KRG) */ - -/* Added a missing call to CHKOUT before the RETURN statement in */ -/* the test */ - -/* IF ( RESV .LT. 1 ) THEN */ -/* RETURN */ -/* END IF */ - -/* - SPICELIB Version 1.2.0, 30-SEP-1993 (KRG) */ - -/* $ Detailed_Input section was modified. References to any */ -/* specific routines by name as a method for opening a DAF file */ -/* for write access were removed. The assumption is that a person */ -/* using DAF files would already know something about opening and */ -/* closing the files. */ - -/* $ Examples section was modified. References to any specific */ -/* routines by name as a method for opening a DAF file for writing */ -/* were removed, and the example was reworded in such a way that */ -/* the use of the subroutine remained clear. */ - -/* Added calls to the INT intrinsic function to convert a DP */ -/* number to an integer before assigning it to NEXT, which is an */ -/* integer variable. Also added calls to INT in IF statements */ -/* where comparisons were made between DP numbers and INTEGERs, */ -/* when integral values were actually being compared. */ - -/* Added calls to the intrinsic function DBLE to convert an */ -/* integer, RESV, into a DP number when doing some arithmetic. */ - -/* Took an ELSE IF clause out of the initial IF return ELSE */ -/* check in END IF at the beginning of the routine. Replaced the */ -/* code: */ - -/* IF ( RETURN () ) THEN */ -/* RETURN */ - -/* ELSE IF ( RESV .LT. 1 ) THEN */ -/* RETURN */ - -/* ELSE */ -/* CALL CHKIN ( 'DAFARR' ) */ -/* END IF */ - -/* with the eqivalent code: */ - -/* IF ( RETURN () ) THEN */ -/* RETURN */ -/* ELSE */ -/* CALL CHKIN ( 'DAFARR' ) */ -/* END IF */ - -/* C */ -/* C Check to see if the number of records to be reserved is */ -/* C less than one. If so, just return without changing */ -/* C anything. */ -/* C */ -/* IF ( RESV .LT. 1 ) THEN */ -/* RETURN */ -/* END IF */ - -/* - 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, 17-JUL-1990 (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - - -/* WPR is the maximum number of double precision numbers */ -/* (words) per record. */ - -/* MAXD, are the maximum number of double precision */ -/* MAXI, numbers, integers, and characters, respectively, */ -/* MAXC per record, not including space reserved for */ -/* control information (3 dp numbers are reserved). */ -/* There are two integers per double precision word, */ -/* and eight characters per word. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFARR", (ftnlen)6); - } - - -/* Check to see if the number of records to be reserved is less than */ -/* one. If so, just return without changing anything. */ - - if (*resv < 1) { - chkout_("DAFARR", (ftnlen)6); - return 0; - } - -/* Before proceeding any further, check that the DAF associated */ -/* with HANDLE is available for write access. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFARR", (ftnlen)6); - return 0; - } - -/* Get the contents of the file record. If it fails, then just check */ -/* out and return, as an appropriate error message should have */ -/* already been set. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFARR", (ftnlen)6); - return 0; - } - -/* Okay, here's the plan. We are just going to move records */ -/* in the direction of the end of the file, starting */ -/* with the last record in the file and ending with the first */ -/* summary record. */ - -/* After everything has been moved, the initial and final */ -/* addresses of all the arrays have to be incremented by the */ -/* same amount: the number of words per record (128) times */ -/* the number of new records. */ - - incr = *resv << 7; - -/* Before we do that, however, we should write some bogus records */ -/* to the end of the file, to make sure we don't run out of space */ -/* later on. If this doesn't work, we will leave the logical */ -/* contents of the file uncorrupted (although it may get larger). */ - - dafarw_(&free, &recno, &word); - i__1 = *resv; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = recno + i__; - dafwdr_(handle, &i__2, drec); - } - if (failed_()) { - chkout_("DAFARR", (ftnlen)6); - return 0; - } - -/* Records will be moved in `blocks', where each block contains */ - -/* -- a summary record */ - -/* -- a name record */ - -/* -- one or more data records */ - -/* The first block to be moved (that is, the last block in */ -/* the file) lies between the final summary record (BWARD) and */ -/* whatever record contains the first free address in the file. */ - - begblk = bward; - dafarw_(&free, &endblk, &word); - while(begblk > 0 && ! failed_()) { - -/* Move the data records first. */ - - i__1 = begblk + 2; - for (recno = endblk; recno >= i__1; --recno) { - dafrdr_(handle, &recno, &c__1, &c__128, drec, &found); - i__2 = recno + *resv; - dafwdr_(handle, &i__2, drec); - } - -/* Then the name record. */ - - recno = begblk + 1; - dafrcr_(handle, &recno, crec, (ftnlen)1000); - i__1 = recno + *resv; - dafwcr_(handle, &i__1, crec, (ftnlen)1000); - -/* Finally, the summary record. */ - -/* To find the beginning of the next block, look at the backward */ -/* pointer from the summary record of the current block. */ - -/* Be sure to adjust the forward and backward pointers; */ -/* otherwise, we won't be able to find the summaries again. */ - - recno = begblk; - dafrdr_(handle, &recno, &c__1, &c__128, drec, &found); - next = (integer) drec[1]; - if ((integer) drec[0] > 0) { - drec[0] += (doublereal) (*resv); - } - if ((integer) drec[1] > 0) { - drec[1] += (doublereal) (*resv); - } - i__1 = recno + *resv; - dafwdr_(handle, &i__1, drec); - -/* The next block ends just before the current block begins. */ - - endblk = begblk - 1; - begblk = next; - } - -/* Rewrite the file record, to reflect the new organization of */ -/* the file. */ - - fward += *resv; - bward += *resv; - free += incr; - dafwfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - -/* Get the summary for each array, increment the addresses (stored */ -/* in the final two integer components), and replace the summary. */ - - dafbfs_(handle); - daffna_(&found); - while(found && ! failed_()) { - dafgs_(sum); - dafus_(sum, &nd, &ni, dc, ic); - ic[(i__1 = ni - 2) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, - "dafarr_", (ftnlen)474)] = ic[(i__2 = ni - 2) < 250 && 0 <= - i__2 ? i__2 : s_rnge("ic", i__2, "dafarr_", (ftnlen)474)] + - incr; - ic[(i__1 = ni - 1) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, - "dafarr_", (ftnlen)475)] = ic[(i__2 = ni - 1) < 250 && 0 <= - i__2 ? i__2 : s_rnge("ic", i__2, "dafarr_", (ftnlen)475)] + - incr; - dafps_(&nd, &ni, dc, ic, sum); - dafws_(sum); - daffna_(&found); - } - -/* Write NULL filled records to the reserved record area. */ - - for (i__ = 1; i__ <= 1000; ++i__) { - *(unsigned char *)&crec[i__ - 1] = '\0'; - } - i__ = fward - *resv; - i__1 = i__ + *resv - 1; - for (recno = i__; recno <= i__1; ++recno) { - dafwcr_(handle, &recno, crec, (ftnlen)1000); - } - chkout_("DAFARR", (ftnlen)6); - return 0; -} /* dafarr_ */ - diff --git a/ext/spice/src/cspice/dafb2a.c b/ext/spice/src/cspice/dafb2a.c deleted file mode 100644 index 682bb106ca..0000000000 --- a/ext/spice/src/cspice/dafb2a.c +++ /dev/null @@ -1,263 +0,0 @@ -/* dafb2a.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFB2A ( DAF, binary to ASCII ) */ -/* Subroutine */ int dafb2a_(char *binary, char *ascii, ftnlen binary_len, - ftnlen ascii_len) -{ - /* System generated locals */ - cllist cl__1; - - /* Builtin functions */ - integer f_clos(cllist *); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafb2t_(char *, - integer *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Convert a binary DAF to an equivalent ASCII (text) DAF. */ -/* (Obsolete, maintained for backward compatibility only.) */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINARY I Name of an existing binary DAF. */ -/* ASCII I Name of an ASCII (text) DAF to be created. */ - -/* $ Detailed_Input */ - -/* BINARY is the name of an existing binary DAF. */ - -/* ASCII is the name of an ASCII (text) DAF to be created. */ -/* The ASCII file contains the same data as the binary */ -/* file, but in a form more suitable for transfer */ -/* between heterogeneous computing environments. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments BINARY, ASCII. */ - -/* $ Exceptions */ - -/* None. */ - -/* Errors are detected and signalled by routines called by this */ -/* routine. */ - -/* $ Particulars */ - -/* This routine has been made obsolete by the new DAF binary to text */ -/* conversion routine DAFBT. This routine remains available for */ -/* reasons of backward compatibility. We strongly recommend that the */ -/* conversion routine DAFBT be used for any new software development. */ -/* Please see the header of the routine DAFBT for details. */ - -/* Note that the contents of reserved records in the binary file */ -/* are not stored in the ASCII file. */ - -/* $ Examples */ - -/* DAFB2A and DAFA2B are typically used to transfer files. */ -/* If file A.DAF is a binary DAF in environment 1, it can be */ -/* transferred to environment 2 in three steps. */ - -/* 1) Convert it to ASCII, */ - -/* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */ - -/* 2) Transfer the ASCII file, using FTP, Kermit, or some other */ -/* file transfer utility, */ - -/* ftp> put a.ascii */ - -/* 3) Convert it to binary on the new machine, */ - -/* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */ - -/* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */ -/* environment. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 18-JUN-1999 (WLT) */ - -/* Fixed call to CHKOUT with wrong name. */ - -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* This routine was completely rewritten to make use of the */ -/* routines DAFB2T and TXTOPN, for converting a text file to */ -/* binary and opening a text file. It now simply calls the */ -/* routine DAFT2B after opening the text file with TXTOPN. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFBT, and that we strongly recommend the use of */ -/* the new routine. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary daf to ascii */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* This routine was completely rewritten to make use of the */ -/* routines DAFB2T and TXTOPN, for converting a text file to */ -/* binary and opening a text file. It now simply calls the */ -/* routine DAFT2B after opening the text file with TXTOPN. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFBT, and that we strongly recommend the use of */ -/* the new routine. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFB2A", (ftnlen)6); - } - -/* Open the ASCII file for writing. If an error occurs, then check */ -/* out and return. An appropriate error message will have already */ -/* been set. */ - - txtopn_(ascii, &unit, ascii_len); - if (failed_()) { - chkout_("DAFB2A", (ftnlen)6); - return 0; - } - -/* Attempt to perform the file conversion. If it fails, close the */ -/* text file with STATUS = 'DELETE', check out and return, as an */ -/* appropriate error message should have already been set. */ - - dafb2t_(binary, &unit, binary_len); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("DAFB2A", (ftnlen)6); - return 0; - } - -/* Close the text file. */ - - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFB2A", (ftnlen)6); - return 0; -} /* dafb2a_ */ - diff --git a/ext/spice/src/cspice/dafb2t.c b/ext/spice/src/cspice/dafb2t.c deleted file mode 100644 index 0dab9dafb5..0000000000 --- a/ext/spice/src/cspice/dafb2t.c +++ /dev/null @@ -1,864 +0,0 @@ -/* dafb2t.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__9 = 9; -static integer c__5 = 5; - -/* $Procedure DAFB2T ( DAF, binary to text ) */ -/* Subroutine */ int dafb2t_(char *binary, integer *text, ftnlen binary_len) -{ - /* System generated locals */ - address a__1[3]; - integer i__1[3], i__2, i__3; - char ch__1[10], ch__2[62], ch__3[1002]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wsle(cilist *); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void), - s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char name__[1000]; - integer free; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen); - integer i__; - extern /* Subroutine */ int dafgn_(char *, ftnlen); - integer begin; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen); - integer bward; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - integer fward; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer chunk; - logical found; - integer csize, isize, lsize; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[125]; - integer ic[250]; - extern /* Subroutine */ int daffna_(logical *); - integer nd; - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer ni, handle; - extern /* Subroutine */ int dafcls_(integer *); - char ifname[60]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - doublereal buffer[100]; - integer daflun; - extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen); - char idword[8]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer end; - doublereal sum[125]; - - /* Fortran I/O blocks */ - static cilist io___5 = { 1, 0, 1, 0, 1 }; - static cilist io___12 = { 1, 0, 0, 0, 0 }; - static cilist io___13 = { 1, 0, 0, 0, 0 }; - static cilist io___14 = { 1, 0, 0, 0, 0 }; - static cilist io___15 = { 1, 0, 0, 0, 0 }; - static cilist io___23 = { 1, 0, 0, 0, 0 }; - static cilist io___24 = { 1, 0, 0, 0, 0 }; - static cilist io___25 = { 1, 0, 0, 0, 0 }; - static cilist io___27 = { 1, 0, 0, 0, 0 }; - static cilist io___33 = { 1, 0, 0, 0, 0 }; - static cilist io___34 = { 1, 0, 0, 0, 0 }; - static cilist io___35 = { 1, 0, 0, 0, 0 }; - static cilist io___36 = { 1, 0, 0, 0, 0 }; - static cilist io___37 = { 1, 0, 0, 0, 0 }; - static cilist io___38 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Write the contents of a binary DAF to a text file opened by */ -/* the calling program. (Obsolete, maintained for backward */ -/* compatibility only.) */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINARY I Name of an existing binary DAF. */ -/* TEXT I Logical unit connected to text file. */ - -/* $ Detailed_Input */ - -/* BINARY is the name of an existing binary DAF. */ - -/* TEXT is a logical unit number, to which a text file has */ -/* been connected by the calling program, and into */ -/* which the contents of BINARY are to be written */ -/* (in a form more suitable for transfer between */ -/* heterogeneous computing environments). */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments BINARY, TEXT. */ - -/* $ Exceptions */ - -/* 1) If for some reason the text file cannot be written, */ -/* the error SPICE(DAFWRITEFAIL) is signalled. */ - -/* 2) If for some reason the ID word cannot be read from the DAF */ -/* file, the error SPICE(DAFREADFAIL) will be signalled. */ - -/* $ Particulars */ - -/* This routine has been made obsolete by the new DAF binary to text */ -/* conversion routine DAFBT. This routine remains available for */ -/* reasons of backward compatibility. We strongly recommend that you */ -/* use the new conversion routines for any new software development. */ -/* Please see the header of the routine DAFBT for details. */ - -/* Any binary DAF may be transferred between heterogeneous */ -/* Fortran environments by converting it to an equivalent file */ -/* containing only ASCII characters. Such a file can be transferred */ -/* almost universally, using any number of established protocols */ -/* (Kermit, FTP, and so on). Once transferred, the ASCII file can */ -/* be converted to a binary file, using the representations */ -/* native to the new host environment. */ - -/* There are two pairs of routines that can be used to convert */ -/* DAFs between binary and text. The first pair, DAFB2A */ -/* and DAFA2B, works with complete files. That is, DAFB2A creates */ -/* a complete ASCII file containing all of the information in */ -/* a particular binary file, and nothing else; this file can */ -/* be fed directly into DAFA2B to produce a complete binary file. */ -/* In each case, the names of the files are specified. */ - -/* A related pair of routines, DAFB2T and DAFT2B, assume that */ -/* the ASCII data are to be stored in the midst of a text file. */ -/* This allows the calling program to surround the data with */ -/* standardized labels, to append several binary files into a */ -/* single text file, and so on. */ - -/* Note that the contents of reserved records in the binary file */ -/* are not written by this routine (although they may be stored */ -/* in the ASCII file by the calling program). */ - -/* $ Examples */ - -/* DAFB2A and DAFA2B are typically used for simple file transfers. */ -/* If file A.DAF is a binary DAF in environment 1, it can be */ -/* transferred to environment 2 in three steps. */ - -/* 1) Convert it to ASCII: */ - -/* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */ - -/* 2) Transfer the ASCII file, using FTP, Kermit, or some other */ -/* file transfer utility: */ - -/* ftp> put a.ascii */ - -/* 3) Convert it to binary on the new machine, */ - -/* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */ - -/* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */ -/* environment. */ - -/* If the file needs to contain other information---a standard */ -/* label, for instance---the first and third steps must be modified */ -/* to use DAFB2T and DAFT2B. The first step becomes */ - -/* (Open a text file) */ -/* (Write the label) */ -/* CALL DAFB2T ( BINARY, UNIT ) */ -/* (Close the text file) */ - -/* The third step becomes */ - -/* (Open the text file) */ -/* (Read the label) */ -/* CALL DAFT2B ( UNIT, BINARY, RESV ) */ -/* (Close the text file) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to utilize the new handle manager */ -/* interfaces. */ - -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* Added the variable IDWORD to the routine for storing the ID */ -/* word from the file being converted. This replaces a hard coded */ -/* value of 'NAIF/DAF', and supports the new interpretation of the */ -/* ID word. */ - -/* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ -/* relevant. */ - -/* There were no checks of the IOSTAT variable after attempting to */ -/* write to the text file, a single test of the IOSTAT variable */ -/* was made at the end of the routine. This was not adequate to */ -/* detect errors when writing to the text file. So after all of */ -/* these write statements, an IF ... END IF block was added to */ -/* signal an error if IOSTAT .NE. 0. */ - -/* Added the following error message to the routine: */ - -/* C 2) If for some reason the ID word cannot be read from */ -/* C the DAF file, the error SPICE(DAFREADFAIL) will be */ -/* C signalled. */ - -/* because the file ID word is now read from the binary DAF file */ -/* rather than being hard coded as 'NAIF/DAF' in this routine. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFBT, and that we strongly recommend the use of */ -/* the new routine. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary daf to text */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* This routine still uses a naked READ to retrieve the */ -/* file IDWORD from the first 8 characters stored in the */ -/* file record. It may be that future environments */ -/* will have characters whose storage exceeds 1 byte, */ -/* in which case this routine will require modification. */ -/* One possibility is to call the private file record */ -/* reader ZZDAFGFR, which must address the translation */ -/* for all supported non-native binary file formats on this */ -/* platform. */ - -/* The existing call to DAFHLU was replaced with ZZDDHHLU. */ -/* The call to DAFRDA was replaced with a call to the new, */ -/* translation-aware routine DAFGDA. */ - -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* Added the variable IDWORD to the routine for storing the ID */ -/* word from the file being converted. This replaces a hard coded */ -/* value of 'NAIF/DAF', and supports the new interpretation of the */ -/* ID word. */ - -/* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ -/* relevant. */ - -/* There were no checks of the IOSTAT variable after attempting to */ -/* write to the text file, a single test of the IOSTAT variable */ -/* was made at the end of the routine. This was not adequate to */ -/* detect errors when writing to the text file. So after all of */ -/* these write statements, an IF ... END IF block was added to */ -/* signal an error if IOSTAT .NE. 0. */ - -/* IF ( IOSTAT .NE. 0 ) THEN */ - -/* CALL DAFCLS ( HANDLE ) */ -/* CALL SETMSG ( 'The attempt to write to file ''#''' // */ -/* . ' failed. IOSTAT = #.' ) */ -/* CALL ERRFNM ( '#', TEXT ) */ -/* CALL SIGERR ( 'SPICE(DAFWRITEFAIL)' ) */ -/* CALL CHKOUT ( 'DAFB2T' ) */ -/* RETURN */ - -/* END IF */ - -/* Removed the code from the end of the routine that purported to */ -/* check for read errors: */ - -/* C */ -/* C If any write screws up, they should all screw up. Why */ -/* C make a billion separate checks? */ -/* C */ -/* IF ( IOSTAT .NE. 0 ) THEN */ -/* CALL SETMSG ( 'Value of IOSTAT was: #. ' ) */ -/* CALL ERRINT ( '#', IOSTAT ) */ -/* CALL SIGERR ( 'SPICE(DAFWRITEFAIL)' ) */ -/* END IF */ - -/* The answer to the question is: */ - -/* You have to do a billion separate checks because the IOSTAT */ -/* value is only valid for the most recently executed write. */ - -/* Added the following error message to the routine: */ - -/* C 2) If for some reason the ID word cannot be read from */ -/* C the DAF file, the error SPICE(DAFREADFAIL) will be */ -/* C signalled. */ - -/* because the file ID word is now read from the binary DAF file */ -/* rather than being hard coded as 'NAIF/DAF' in this routine. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFBT, and that we strongly recommend the use of */ -/* the new routine. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFB2T", (ftnlen)6); - } - -/* Initialize the IDWORD. */ - - s_copy(idword, " ", (ftnlen)8, (ftnlen)1); - -/* Open the binary file for reading and read the ID word from the */ -/* first record of the file. */ - - dafopr_(binary, &handle, binary_len); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - -/* At this point, we know that we have a DAF file, because we were */ -/* able to successfully open it, so we will attempt to proceed with */ -/* the file conversion process. */ - -/* Convert the DAF file handle to its equivalent Fortran logical */ -/* unit. We need to do this in order to accurately move the file */ -/* ID word to the text file. */ - - zzddhhlu_(&handle, "DAF", &c_false, &daflun, (ftnlen)3); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___5.ciunit = daflun; - iostat = s_rdue(&io___5); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Could not read ID word from file '#'. IOSTAT = #.", (ftnlen) - 49); - errch_("#", binary, (ftnlen)1, binary_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - -/* Get the contents of the file record. The ASCII file begins */ -/* with the ID word which is followed by the summary format, */ -/* which is followed by the internal file name. */ - - dafrfr_(&handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___12.ciunit = *text; - iostat = s_wsle(&io___12); - if (iostat != 0) { - goto L100002; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 8, a__1[1] = idword; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)10); - iostat = do_lio(&c__9, &c__1, ch__1, (ftnlen)10); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsle(); -L100002: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___13.ciunit = *text; - iostat = s_wsle(&io___13); - if (iostat != 0) { - goto L100003; - } - iostat = do_lio(&c__3, &c__1, (char *)&nd, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100003; - } - iostat = e_wsle(); -L100003: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___14.ciunit = *text; - iostat = s_wsle(&io___14); - if (iostat != 0) { - goto L100004; - } - iostat = do_lio(&c__3, &c__1, (char *)&ni, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsle(); -L100004: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___15.ciunit = *text; - iostat = s_wsle(&io___15); - if (iostat != 0) { - goto L100005; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 60, a__1[1] = ifname; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)62); - iostat = do_lio(&c__9, &c__1, ch__2, (ftnlen)62); - if (iostat != 0) { - goto L100005; - } - iostat = e_wsle(); -L100005: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - -/* Each array is preceded by a '1', which indicates that more */ -/* arrays are to come. The array itself begins with the name */ -/* and the summary components, and ends with the name again. */ -/* The elements are written in arbitrary chunks. The final */ -/* chunk is followed by a '0', which indicates that no chunks */ -/* remain. */ - -/* Write the arrays in forward order. */ - - lsize = nd + (ni - 1) / 2 + 1; - isize = lsize << 3; - dafbfs_(&handle); - daffna_(&found); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - while(found) { - dafgs_(sum); - dafgn_(name__, (ftnlen)1000); - dafus_(sum, &nd, &ni, dc, ic); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___23.ciunit = *text; - iostat = s_wsle(&io___23); - if (iostat != 0) { - goto L100006; - } - iostat = do_lio(&c__9, &c__1, "1", (ftnlen)1); - if (iostat != 0) { - goto L100006; - } - iostat = e_wsle(); -L100006: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___24.ciunit = *text; - iostat = s_wsle(&io___24); - if (iostat != 0) { - goto L100007; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = isize, a__1[1] = name__; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)1002); - iostat = do_lio(&c__9, &c__1, ch__3, isize + 2); - if (iostat != 0) { - goto L100007; - } - iostat = e_wsle(); -L100007: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___25.ciunit = *text; - iostat = s_wsle(&io___25); - if (iostat != 0) { - goto L100008; - } - i__2 = nd; - for (i__ = 1; i__ <= i__2; ++i__) { - iostat = do_lio(&c__5, &c__1, (char *)&dc[(i__3 = i__ - 1) < 125 - && 0 <= i__3 ? i__3 : s_rnge("dc", i__3, "dafb2t_", ( - ftnlen)558)], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100008; - } - } - iostat = e_wsle(); -L100008: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___27.ciunit = *text; - iostat = s_wsle(&io___27); - if (iostat != 0) { - goto L100009; - } - i__3 = ni - 2; - for (i__ = 1; i__ <= i__3; ++i__) { - iostat = do_lio(&c__3, &c__1, (char *)&ic[(i__2 = i__ - 1) < 250 - && 0 <= i__2 ? i__2 : s_rnge("ic", i__2, "dafb2t_", ( - ftnlen)573)], (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100009; - } - } - iostat = e_wsle(); -L100009: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - begin = ic[(i__2 = ni - 2) < 250 && 0 <= i__2 ? i__2 : s_rnge("ic", - i__2, "dafb2t_", (ftnlen)588)]; - end = ic[(i__2 = ni - 1) < 250 && 0 <= i__2 ? i__2 : s_rnge("ic", - i__2, "dafb2t_", (ftnlen)589)]; - while(begin <= end) { -/* Computing MIN */ - i__2 = begin + 99; - chunk = min(i__2,end); - csize = chunk - begin + 1; - dafgda_(&handle, &begin, &chunk, buffer); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___33.ciunit = *text; - iostat = s_wsle(&io___33); - if (iostat != 0) { - goto L100010; - } - iostat = do_lio(&c__3, &c__1, (char *)&csize, (ftnlen)sizeof( - integer)); - if (iostat != 0) { - goto L100010; - } - iostat = e_wsle(); -L100010: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #." - , (ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___34.ciunit = *text; - iostat = s_wsle(&io___34); - if (iostat != 0) { - goto L100011; - } - i__2 = csize; - for (i__ = 1; i__ <= i__2; ++i__) { - iostat = do_lio(&c__5, &c__1, (char *)&buffer[(i__3 = i__ - 1) - < 100 && 0 <= i__3 ? i__3 : s_rnge("buffer", i__3, - "dafb2t_", (ftnlen)620)], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100011; - } - } - iostat = e_wsle(); -L100011: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #." - , (ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - begin += 100; - } - io___35.ciunit = *text; - iostat = s_wsle(&io___35); - if (iostat != 0) { - goto L100012; - } - iostat = do_lio(&c__9, &c__1, "0", (ftnlen)1); - if (iostat != 0) { - goto L100012; - } - iostat = e_wsle(); -L100012: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___36.ciunit = *text; - iostat = s_wsle(&io___36); - if (iostat != 0) { - goto L100013; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = isize, a__1[1] = name__; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)1002); - iostat = do_lio(&c__9, &c__1, ch__3, isize + 2); - if (iostat != 0) { - goto L100013; - } - iostat = e_wsle(); -L100013: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - daffna_(&found); - if (failed_()) { - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - } - -/* A final '0' indicates that no arrays remain. The first shall be */ -/* last: the internal file name brings up the rear. */ - - io___37.ciunit = *text; - iostat = s_wsle(&io___37); - if (iostat != 0) { - goto L100014; - } - iostat = do_lio(&c__9, &c__1, "0", (ftnlen)1); - if (iostat != 0) { - goto L100014; - } - iostat = e_wsle(); -L100014: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - io___38.ciunit = *text; - iostat = s_wsle(&io___38); - if (iostat != 0) { - goto L100015; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 60, a__1[1] = ifname; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)62); - iostat = do_lio(&c__9, &c__1, ch__2, (ftnlen)62); - if (iostat != 0) { - goto L100015; - } - iostat = e_wsle(); -L100015: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to write to file '#' failed. IOSTAT = #.", ( - ftnlen)52); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFB2T", (ftnlen)6); - return 0; - } - -/* Close only the binary file. */ - - dafcls_(&handle); - chkout_("DAFB2T", (ftnlen)6); - return 0; -} /* dafb2t_ */ - diff --git a/ext/spice/src/cspice/dafbbs_c.c b/ext/spice/src/cspice/dafbbs_c.c deleted file mode 100644 index 7143dae6f2..0000000000 --- a/ext/spice/src/cspice/dafbbs_c.c +++ /dev/null @@ -1,246 +0,0 @@ -/* - --Procedure dafbbs_c ( DAF, begin backward search ) - --Abstract - - Begin a backward search for arrays in a DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void dafbbs_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of DAF to be searched. - --Detailed_Input - - handle is the handle of a DAF on which a backward - search is to be conducted. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - See argument handle. - --Exceptions - - 1) If the input handle is invalid, the error will be diagnosed - by routines called by this routine. - --Particulars - - - The DAF search routines are: - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 31-JUL-1999 (NJB) (WLT) (IMU) - --Index_Entries - - begin daf backward search - --& -*/ - -{ /* Begin dafbbs_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafbbs_c" ); - - - dafbbs_ ( ( integer * ) &handle ); - - - chkout_c ( "dafbbs_c" ); - -} /* End dafbbs_c */ diff --git a/ext/spice/src/cspice/dafbfs_c.c b/ext/spice/src/cspice/dafbfs_c.c deleted file mode 100644 index baab761422..0000000000 --- a/ext/spice/src/cspice/dafbfs_c.c +++ /dev/null @@ -1,247 +0,0 @@ -/* - --Procedure dafbfs_c ( DAF, begin forward search ) - --Abstract - - Begin a forward search for arrays in a DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dafbfs_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of file to be searched. - --Detailed_Input - - handle is the handle of a DAF on which a forward - search is to be conducted. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - See argument handle. - --Exceptions - - 1) If the input handle is invalid, the error will be diagnosed - by routines called by this routine. - --Particulars - - The DAF search routines are: - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 31-JUL-1999 (NJB) (WLT) (IMU) - --Index_Entries - - begin daf forward search - --& -*/ - -{ /* Begin dafbfs_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafbfs_c" ); - - - dafbfs_ ( ( integer * ) &handle ); - - - chkout_c ( "dafbfs_c" ); - -} /* End dafbfs_c */ diff --git a/ext/spice/src/cspice/dafbt.c b/ext/spice/src/cspice/dafbt.c deleted file mode 100644 index 97a1e5ff71..0000000000 --- a/ext/spice/src/cspice/dafbt.c +++ /dev/null @@ -1,917 +0,0 @@ -/* dafbt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure DAFBT ( DAF, convert binary file to transfer file ) */ -/* Subroutine */ int dafbt_(char *binfil, integer *xfrlun, ftnlen binfil_len) -{ - /* System generated locals */ - address a__1[3]; - integer i__1[3], i__2, i__3; - char ch__1[10], ch__2[62], ch__3[1002]; - cilist ci__1; - - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void) - ; - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[1000]; - integer free; - char line[80]; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen), dafgn_(char *, ftnlen), dafgs_(doublereal *), - chkin_(char *, ftnlen); - integer bward; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - integer fward; - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *), daffna_(logical *); - integer nd; - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer dtabeg, ni; - extern /* Subroutine */ int dafcls_(integer *); - char ifname[60]; - integer binhdl; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - doublereal buffer[1024]; - integer dtacnt; - extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen), wrencd_( - integer *, integer *, doublereal *); - integer binlun; - char idword[8]; - integer numdta; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - integer snmlen; - extern /* Subroutine */ int chkout_(char *, ftnlen), wrenci_(integer *, - integer *, integer *); - integer iostat, numarr, numlft; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dsumry[125]; - integer isumry[250]; - doublereal summry[125]; - - /* Fortran I/O blocks */ - static cilist io___4 = { 1, 0, 1, 0, 1 }; - - -/* $ Abstract */ - -/* Convert the contents of a binary DAF file to an equivalent DAF */ -/* transfer file. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINFIL I The name of a binary DAF file to be converted. */ -/* XFRLUN I Logical unit of a previously opened file. */ - -/* $ Detailed_Input */ - -/* BINFIL The name of a binary DAF file which is to be converted */ -/* to an equivalent DAF transfer file. */ - -/* XFRLUN The Fortran logical unit number of a previously opened */ -/* file. The DAF transfer file will be written to the */ -/* file attached to this logical unit beginning at the */ -/* current position in the file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments BINFIL, XFRLUN. */ - -/* $ Exceptions */ - - -/* 1) If the binary DAF file specified by the filename BINFIL */ -/* cannot be opened for read access, an appropriate error */ -/* message will be signalled by a DAF file access routine that */ -/* is called. */ - -/* 2) If for some reason the DAF transfer file cannot be written */ -/* to, the error SPICE(FILEWRITEFAILED) is signalled. */ - -/* 3) If, for any reason, the DAF file cannot be read, a DAF file */ -/* access routine will signal an error with appropriate error */ -/* message. */ - -/* 4) If the ID word cannot be read from the binary file, the error */ -/* SPICE(FILEREADFAILED) will be signalled. */ - -/* 5) The binary DAF file opened by this routine, BINFIL, is only */ -/* GUARANTEED to be closed upon successful completion of the */ -/* conversion process. In the event of an error, the caller of */ -/* this routine is required to close the binary DAF file BINFIL. */ - -/* $ Particulars */ - -/* Any binary DAF file may be transferred between heterogeneous */ -/* Fortran environments by converting it to an equivalent file */ -/* containing only ASCII characters. Such a file can be transferred */ -/* almost universally, using any number of established protocols. */ -/* Once transferred, the ASCII file can be converted to a binary */ -/* file, using the representations native to the new host */ -/* environment. */ - -/* This routine provides a mechanism for converting a binary DAF */ -/* file into an equivalent encoded ASCII file called a DAF transfer */ -/* file. It is one of a pair of routines for performing conversions */ -/* between the binary format of a DAF file and the DAF transfer file. */ -/* The inverse of this routine is the routine DAFTB. */ - -/* The contents of the reserved records in a binary DAF file are */ -/* ignored by this routine. They are not written to the DAF transfer */ -/* file. The reserved records must be dealt with separately from the */ -/* data in a DAF file. */ - -/* Upon successful completion, the DAF transfer file attached to */ -/* Fortran logical unit XFRLUN will contain the same data as the */ -/* binary DAF file BINFIL. The binary DAF file BINFIL will be closed */ -/* when this routine exits. The DAF transfer file will remain open, */ -/* as it was on entry, and it will be positioned to write on the */ -/* first line following the encoded DAF data. */ - -/* $ Examples */ - -/* Let */ - -/* BINFIL be the name of a binary DAF file which is to be */ -/* converted to an equivalent DAF transfer file. */ - -/* XFRLUN be the Fortran logical unit to which the DAF transfer */ -/* file is to be written. */ - -/* The following subroutine call would read the binary DAF */ -/* file with the name BINFIL, convert its data into an encoded */ -/* format, and write that data to the DAF transfer file attached */ -/* to the Fortran logical unit XFRLUN, beginning at the current */ -/* position in the file. */ - -/* CALL DAFBT( BINFIL, XFRLUN ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 16-NOV-2001 (FST) */ - -/* Updated the routine to utilize the new handle manager */ -/* interfaces. */ - -/* - SPICELIB Version 3.0.0, 25-JAN-1995 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name TXTLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* No changes to this routine were necessary to incorporate the */ -/* new file ID word format. This routine already read and copied */ -/* the ID word to the text file being created. */ - -/* Also, all list directed writes in this routine were replaced by */ -/* formatted writes with FMT = '(A)'. This routine only writes */ -/* character data. */ - -/* Added a test of FAILED() after the call to DAFHLU for */ -/* completeness. */ - -/* - SPICELIB Version 1.0.1, 24-JUN-1993 (KRG) */ - -/* Modified the description of the DAF encoded text file format */ -/* appearing before the program code. */ - -/* - SPICELIB Version 1.0.0, 29-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert binary daf into a daf transfer file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 16-NOV-2001 (FST) */ - -/* This routine still uses a naked READ to retrieve the */ -/* file IDWORD from the first 8 characters stored in the */ -/* file record. It may be that future environments */ -/* will have characters whose storage exceeds 1 byte, */ -/* in which case this routine will require modification. */ -/* One possibility is to call the private file record */ -/* reader ZZDAFGFR, which must address the translation */ -/* for all supported non-native binary file formats on this */ -/* platform. */ - -/* The existing call to DAFHLU was replaced with ZZDDHHLU. */ -/* The call to DAFRDA was replaced with a call to the new, */ -/* translation-aware routine DAFGDA. */ - -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* No changes to this routine were necessary to incorporate the */ -/* new file ID word format. This routine already read and copied */ -/* the ID word to the text file being created. */ - -/* Also, all list directed writes in this routine were replaced by */ -/* formatted writes with FMT = '(A)'. This routine only writes */ -/* character data. */ - -/* Added a test of FAILED() after the call to DAFHLU for */ -/* completeness. */ - -/* - SPICELIB Version 1.0.1, 24-JUN-1993 (KRG) */ - -/* Modified the description of the DAF encoded text file format */ -/* appearing before the program code. Changed the line: */ - -/* C < DAF ND value > < DAF NI value > */ - -/* to the lines: */ - -/* C < DAF ND value > */ -/* C < DAF NI value > */ - -/* This change was necessary because the output format for the */ -/* low level routines which encode and write the data were */ -/* modified to fix a problem. See the routines WRENCD and WRENCI */ -/* for details of the modification. */ - -/* - SPICELIB Version 1.0.0, 29-OCT-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFBT", (ftnlen)5); - } - -/* A brief description of the DAF transfer file format and its */ -/* intended use follows. This description is intended to provide a */ -/* simple ``picture'' of the DAF transfer file format to aid in the */ -/* understanding of this routine. This description is NOT intended to */ -/* be a detailed specification of the file format. */ - -/* A DAF transfer file contains all of the data from a binary */ -/* DAF file, except for the reserved record area, in an encoded */ -/* ASCII format. The file also contains some bookkeeping information */ -/* for maintaining the integrity of the data. The DAF transfer file */ -/* format allows the full precision of both integer and floating */ -/* point numeric data to be maintained in a portable fashion. The DAF */ -/* transfer file format is intended to provide a reliable and */ -/* accurate means for porting data among multiple computer systems */ -/* and for the archival storage of data. */ - -/* A DAF transfer file is not intended to be used directly to */ -/* provide data to a program, the equivalent binary DAF file is */ -/* to be used for this purpose. In no way should any program, other */ -/* than a DAF binary <-> transfer conversion program, rely on the DAF */ -/* encoded transfer file format. */ - -/* To correctly understand the DAF transfer file description */ -/* the reader should be familiar with the DAF file architecture. */ -/* Items enclosed in angle brackets, '<' and '>', are used to */ -/* represent the data which is to be placed at that position in */ -/* the file. The bookkeeping information is represented exactly */ -/* as it would appear in a DAF transfer file. */ - -/* Let */ - -/* BOF denote the beginning of the file */ -/* EOF denote the end of the file */ - -/* and */ - -/* n denote the total number of arrays in a DAF file */ -/* NA(i) denote the number of double precision numbers in array i */ -/* m(i) denote the number of blocks of encoded data for array i */ -/* N(i,j) denote the number of encoded double precision numbers */ -/* in block j of array i */ - -/* and */ - -/* m(i) */ -/* ----- */ -/* \ */ -/* > N(i,k) = NA(i), i = 1, ..., n. */ -/* / */ -/* ----- */ -/* k=1 */ - -/* A DAF encoded transfer file has the following format: */ - -/* */ -/* < Information line > */ -/* < DAF file ID word > */ -/* < DAF ND value > */ -/* < DAF NI value > */ -/* < DAF internal file name > */ -/* BEGIN_ARRAY 1 NA(1) */ -/* < Name for array 1 > */ -/* < ND double precision summary values > */ -/* < NI-2 integer summary values > */ -/* N(1,1) */ -/* < N(1,1) Encoded double precision numbers > */ -/* N(1,2) */ -/* < N(1,2) Encoded double precision numbers > */ -/* . */ -/* . */ -/* . */ -/* N(1,m(1)) */ -/* < N(1,m(1)) Encoded double precision numbers > */ -/* END_ARRAY 1 NA(1) */ -/* BEGIN_ARRAY 2 NA(2) */ -/* < Name for array 2 > */ -/* < ND double precision summary values > */ -/* < NI-2 integer summary values > */ -/* N(2,1) */ -/* < N(2,1) Encoded double precision numbers > */ -/* N(2,2) */ -/* < N(2,2) Encoded double precision numbers > */ -/* . */ -/* . */ -/* . */ -/* N(2,m(2)) */ -/* < N(2,m(2)) Encoded double precision numbers > */ -/* END_ARRAY 2 NA(2) */ -/* . */ -/* . */ -/* . */ -/* BEGIN_ARRAY n NA(n) */ -/* < Name for array n > */ -/* < ND double precision summary values > */ -/* < NI-2 integer summary values > */ -/* N(n,1) */ -/* < N(n,1) Encoded double precision numbers > */ -/* N(n,2) */ -/* < N(n,2) Encoded double precision numbers > */ -/* . */ -/* . */ -/* . */ -/* N(n,m(n)) */ -/* < N(n,m(n)) Encoded double precision numbers > */ -/* END_ARRAY n NA(n) */ -/* TOTAL_ARRAYS n */ -/* */ - -/* This routine will check the SPICELIB function FAILED() after */ -/* each call, or consecutive sequence of calls, to data encoding */ -/* routines, and if an error was signalled it will simply check out */ -/* and return to the caller. */ - -/* This routine will check the SPICELIB function FAILED() after */ -/* each DAF file access call, and if an error was signalled it will */ -/* simply check out and return to the caller. */ - -/* We begin by opening the binary DAF file specified by BINFIL for */ -/* read access, obtaining a DAF file handle. */ - - dafopr_(binfil, &binhdl, binfil_len); - -/* If the open failed, check out and return, as an appropriate error */ -/* message should have already been set. */ - - if (failed_()) { - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* At this point, we know that we have a DAF file, because we were */ -/* able to successfully open it, so we will attempt to proceed with */ -/* the file conversion process. */ - -/* Convert the DAF file handle to its equivalent Fortran logical */ -/* unit. We need to do this in order to accurately move the file */ -/* ID word to the DAF transfer file. */ - - zzddhhlu_(&binhdl, "DAF", &c_false, &binlun, (ftnlen)3); - -/* If the translation failed, checkout and return, as an appropriate */ -/* error message should have already been set. */ - - if (failed_()) { - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Read the ID word from the binary file. It should be the first 8 */ -/* characters on the first record in the file. */ - - io___4.ciunit = binlun; - iostat = s_rdue(&io___4); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Error reading the file ID word from the binary DAF file '#'" - ". IOSTAT = #.", (ftnlen)72); - errfnm_("#", &binlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Get the contents of the file record: the number of double */ -/* precision numbers in the summary (ND), the number of integers */ -/* in the summary (NI), the internal filename (IFNAME), and some */ -/* data pointer information (FWARD, BWARD, FREE). */ - - dafrfr_(&binhdl, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write the information line containing the file type information */ -/* for the DAF transfer file format to the current position in the */ -/* DAF transfer file. The file type information must be the first */ -/* ``word'' on the information line. The rest of the line may be used */ -/* for other purposes. Right now, it simply contains an expanded */ -/* description of the file type information ``word.'' */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, "DAFETF NAIF DAF ENCODED TRANSFER FILE", (ftnlen) - 37); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsfe(); -L100002: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'.IOSTAT = #.", ( - ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write the ID word to the DAF transfer file. */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 8, a__1[1] = idword; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)10); - iostat = do_fio(&c__1, ch__1, (ftnlen)10); - if (iostat != 0) { - goto L100003; - } - iostat = e_wsfe(); -L100003: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOSTAT = #.", ( - ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write out the ND and NI values for the DAF file architecture. */ - - isumry[0] = nd; - isumry[1] = ni; - wrenci_(xfrlun, &c__2, isumry); - if (failed_()) { - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write out the internal file name. */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 60, a__1[1] = ifname; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)62); - iostat = do_fio(&c__1, ch__2, (ftnlen)62); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsfe(); -L100004: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOSTAT = #.", ( - ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Calculate the length of the segment names. */ - - snmlen = nd + (ni + 1) / 2 << 3; - -/* Get ready to begin a forward search through the DAF file for the */ -/* data. */ - - dafbfs_(&binhdl); - if (failed_()) { - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Initialize the number of arrays processed to zero. */ - - numarr = 0; - -/* We'll assume that we will find some data, until proven otherwise. */ - - found = TRUE_; - -/* Begin looking for and processing the arrays in the binary DAF */ -/* file. */ - - while(found) { - -/* Look for a DAF array. */ - - daffna_(&found); - if (failed_()) { - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* If we found an array, then we need to process it. Start */ -/* by incrementing the number of arrays processed. If not, */ -/* we just skip to the bottom of the loop. */ - - if (found) { - ++numarr; - -/* Get and unpack the summary information for the current */ -/* array. */ - - dafgs_(summry); - dafus_(summry, &nd, &ni, dsumry, isumry); - -/* Get the name of the current array. */ - - dafgn_(name__, (ftnlen)1000); - if (failed_()) { - -/* If an error occurred on any of the DAF system calls */ -/* above, return to the caller. An appropriate error */ -/* message will have already been set by the routine which */ -/* signalled the error. */ - - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Get the beginning address for the data in the current array. */ - - dtabeg = isumry[(i__2 = ni - 2) < 250 && 0 <= i__2 ? i__2 : - s_rnge("isumry", i__2, "dafbt_", (ftnlen)657)]; - -/* Set the number of double precision numbers in the current */ -/* array. */ - - dtacnt = isumry[(i__2 = ni - 1) < 250 && 0 <= i__2 ? i__2 : - s_rnge("isumry", i__2, "dafbt_", (ftnlen)662)] - isumry[( - i__3 = ni - 2) < 250 && 0 <= i__3 ? i__3 : s_rnge("isumry" - , i__3, "dafbt_", (ftnlen)662)] + 1; - s_copy(line, "BEGIN_ARRAY # #", (ftnlen)80, (ftnlen)15); - repmi_(line, "#", &numarr, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &dtacnt, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100005; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100005; - } - iostat = e_wsfe(); -L100005: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOSTAT " - "= #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write the name of the current array. */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100006; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = snmlen, a__1[1] = name__; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)1002); - iostat = do_fio(&c__1, ch__3, snmlen + 2); - if (iostat != 0) { - goto L100006; - } - iostat = e_wsfe(); -L100006: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOSTAT " - "= #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write out the double precision part of the summary. */ - - wrencd_(xfrlun, &nd, dsumry); - -/* Write out the integer part of the summary, excluding the */ -/* beginning and ending addresses of the data in the array, */ -/* ISUMRY(NI-1) and ISUMRY(NI), since these values vary with */ -/* the number of reserved records allocated. */ - - i__2 = ni - 2; - wrenci_(xfrlun, &i__2, isumry); - if (failed_()) { - -/* If an error occurred on any of the data encoding calls */ -/* above, return to the caller. An appropriate error message */ -/* will have already been set by the routine which signalled */ -/* the error. */ - - chkout_("DAFBT", (ftnlen)5); - return 0; - } - numlft = dtacnt; - while(numlft > 0) { - if (numlft >= 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Read in NUMDTA numbers from the current array. The */ -/* desired data are specified by beginning and ending */ -/* indices into the array, inclusive: thus the subtraction */ -/* of 1 in the call. */ - - i__2 = dtabeg + numdta - 1; - dafgda_(&binhdl, &dtabeg, &i__2, buffer); - if (failed_()) { - -/* We want to check failed here because were in a loop. */ -/* We should exit the loop, and the routine, as soon as */ -/* an error is detected, so we don't continue doing */ -/* things for a long time. */ - - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Write out the count of double precision numbers which are */ -/* in the buffer. */ - - s_copy(line, "#", (ftnlen)80, (ftnlen)1); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, ( - ftnlen)80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100007; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100007; - } - iostat = e_wsfe(); -L100007: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOS" - "TAT = #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Encode and write out a buffer of double precision */ -/* numbers. */ - - wrencd_(xfrlun, &numdta, buffer); - if (failed_()) { - -/* We want to check failed here because were in a loop. */ -/* We should exit the loop, and the routine, as soon as */ -/* an error is detected, so we don't continue doing */ -/* things for a long time. */ - - chkout_("DAFBT", (ftnlen)5); - return 0; - } - numlft -= numdta; - dtabeg += numdta; - } - s_copy(line, "END_ARRAY # #", (ftnlen)80, (ftnlen)13); - repmi_(line, "#", &numarr, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &dtacnt, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100008; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100008; - } - iostat = e_wsfe(); -L100008: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOSTAT " - "= #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - } - -/* At this point, one complete DAF array has been written to the */ -/* DAF transfer file. */ - - } - -/* Write out the number of arrays processed. */ - - s_copy(line, "TOTAL_ARRAYS #", (ftnlen)80, (ftnlen)14); - repmi_(line, "#", &numarr, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100009; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100009; - } - iostat = e_wsfe(); -L100009: - if (iostat != 0) { - setmsg_("Error writing to the DAF transfer file '#'. IOSTAT = #.", ( - ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DAFBT", (ftnlen)5); - return 0; - } - -/* Close only the binary file. */ - - dafcls_(&binhdl); - chkout_("DAFBT", (ftnlen)5); - return 0; -} /* dafbt_ */ - diff --git a/ext/spice/src/cspice/dafcls_c.c b/ext/spice/src/cspice/dafcls_c.c deleted file mode 100644 index 04717f7b03..0000000000 --- a/ext/spice/src/cspice/dafcls_c.c +++ /dev/null @@ -1,180 +0,0 @@ -/* - --Procedure dafcls_c ( DAF, close ) - --Abstract - - Close the DAF associated with a given handle. - --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 - - DAF - --Keywords - - DAF - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void dafcls_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of DAF to be closed. - --Detailed_Input - - handle is the file handle of a previously opened DAF file. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the specified handle is not known to the DAF subsystem - (because it does not belong to a file opened via the DAF - API), nothing happens. - - 2) If this routine is used to close a file whose handle is - known to the DAF subsystem, and if the file handle is - attached to a non-DAF file, routines called by this - routine signal an error. - --Particulars - - Because the DAF subsystem must keep track of what files are open at - any given time, it is important that DAF files be closed only with - dafcls_c, to prevent the remaining DAF routines from failing, - sometimes mysteriously. - - Note that when a file is opened more than once for read access, - dafopr_c returns the same handle each time it is re-opened. - Each time the file is closed, dafcls_c checks to see if any other - claims on the file are still active before physically closing - the file. - --Examples - - In the following code fragment, the arrays in a file are examined in - order to determine whether the file contains any arrays whose names - begin with the word TEST. The complete names for these arrays are - printed to the screen. The file is closed at the end of the search. - - #include "SpiceUsr.h" - . - . - . - dafopr_c ( fname, &handle ); - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgn_c ( name ); - - if ( strncmp( name, "TEST", 4 ) == 0 ) - { - printf ( "%s\n", name ); - } - daffna_c ( &found ); - } - - dafcls_c ( handle ); - - - Note that if the file has been opened already by a DAF routine - at some other place in the calling program, it remains open. - This makes it possible to examine files that have been opened for - use by other modules without interfering with the operation of - those routines. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 28-JAN-2004 (NJB) - - Header update: the exceptions section now lists the - case of attempting to close a non-DAF file using this - routine. - - -CSPICE Version 1.0.0, 01-AUG-1999 (NJB) (KRG) (WLT) (IMU) - --Index_Entries - - close daf - --& -*/ - -{ /* Begin dafcls_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafcls_c" ); - - - dafcls_ ( ( integer * ) &handle ); - - - chkout_c ( "dafcls_c" ); - -} /* End dafcls_c */ diff --git a/ext/spice/src/cspice/dafcs_c.c b/ext/spice/src/cspice/dafcs_c.c deleted file mode 100644 index b5125ecfdb..0000000000 --- a/ext/spice/src/cspice/dafcs_c.c +++ /dev/null @@ -1,256 +0,0 @@ -/* - --Procedure dafcs_c ( DAF, continue search ) - --Abstract - - Select a DAF that already has a search in progress as the - one to continue searching. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dafcs_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of DAF to continue searching. - --Detailed_Input - - handle is the handle of a DAF in which either a forward - or backward search has already been started by - dafbfs_c or dafbbs_c. The DAF may be open for read - or write access. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the input handle is invalid, the error will be diagnosed - by routines called by this routine. - - 2) If this routine is called when no search is in progress in the - the current DAF, the error SPICE(DAFNOSEARCH) is signalled. - --Files - - None. - --Particulars - - dafcs_c supports simultaneous searching of multiple DAFs. In - applications that use this capability, dafcs_c should be called - prior to each call to daffna_c, daffpa_c, dafgn_c, or dafgs_c to - specify which DAF is to be acted upon. - - The DAF search routines are: - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 31-JUL-1999 (NJB) (WLT) - --Index_Entries - - select a daf to continue searching - --& -*/ - -{ /* Begin dafcs_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafcs_c" ); - - - dafcs_ ( ( integer * ) &handle ); - - - chkout_c ( "dafcs_c" ); - -} /* End dafcs_c */ diff --git a/ext/spice/src/cspice/dafdc.c b/ext/spice/src/cspice/dafdc.c deleted file mode 100644 index bd4d89edc4..0000000000 --- a/ext/spice/src/cspice/dafdc.c +++ /dev/null @@ -1,206 +0,0 @@ -/* dafdc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFDC ( DAF delete comments ) */ -/* Subroutine */ int dafdc_(integer *handle) -{ - integer free; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer bward, fward, ncomr, nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen), dafrrr_(integer *, - integer *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Delete the entire comment area of a previously opened binary */ -/* DAF attached to HANDLE. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a binary DAF opened for writing. */ - -/* $ Detailed_Input */ - -/* HANDLE The handle of a binary DAF that is to have its entire */ -/* comment area deleted. The DAF must have been opened */ -/* with write access. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the binary DAF attached to HANDLE is not open with write */ -/* access, an error will be signalled by a routine called by */ -/* this routine. */ - -/* $ Files */ - -/* See argument HANDLE in $ Detailed_Input. */ - -/* $ Particulars */ - -/* A binary DAF contains an area which is reserved for storing */ -/* annotations or descriptive textual information about the data */ -/* contained in a file. This area is referred to as the ``comment */ -/* area'' of the file. The comment area of a DAF is a line */ -/* oriented medium for storing textual information. The comment */ -/* area preserves any leading or embedded white space in the line(s) */ -/* of text which are stored, so that the appearance of the of */ -/* information will be unchanged when it is retrieved (extracted) at */ -/* some other time. Trailing blanks, however, are NOT preserved, */ -/* due to the way that character strings are represented in */ -/* standard Fortran 77. */ - -/* This routine will delete the entire comment area from the binary */ -/* DAF attached to HANDLE. The size of the binary DAF will remain */ -/* unchanged. The space that was used by the comment records */ -/* is reclaimed. */ - -/* $ Examples */ - -/* Let */ - -/* HANDLE be the handle of a DAF which has been opened */ -/* with write access. */ - -/* The call */ - -/* CALL DAFDC ( HANDLE ) */ - -/* deletes the entire comment area of the binary DAF attached to */ -/* HANDLE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-SEP-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete DAF comment area */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Length of a DAF file internal filename. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFDC", (ftnlen)5); - } - -/* Verify that the DAF attached to HANDLE was opened with write */ -/* access. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFDC", (ftnlen)5); - return 0; - } - -/* Read the file record to obtain the current number of comment */ -/* records in the DAF attached to HANDLE. We will also get back some */ -/* extra stuff that we do not use. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - ncomr = fward - 2; - if (failed_()) { - chkout_("DAFDC", (ftnlen)5); - return 0; - } - -/* Now we will attempt to remove the comment records, if there are */ -/* any, otherwise we do nothing. */ - - if (ncomr > 0) { - -/* We have some comment records, so remove them. */ - - dafrrr_(handle, &ncomr); - if (failed_()) { - chkout_("DAFDC", (ftnlen)5); - return 0; - } - } - -/* We're done now, so goodbye. */ - - chkout_("DAFDC", (ftnlen)5); - return 0; -} /* dafdc_ */ - diff --git a/ext/spice/src/cspice/dafdc_c.c b/ext/spice/src/cspice/dafdc_c.c deleted file mode 100644 index 0b4e47546d..0000000000 --- a/ext/spice/src/cspice/dafdc_c.c +++ /dev/null @@ -1,156 +0,0 @@ -/* - --Procedure dafdc_c ( DAF delete comments ) - --Abstract - - Delete the entire comment area of a specified DAF file. - --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 - - DAF - --Keywords - - None. - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void dafdc_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I The handle of a binary DAF opened for writing. - --Detailed_Input - - handle is the handle of a binary DAF that is to have its entire - comment area deleted. The DAF must have been opened - with write access. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the binary DAF attached to `handle' is not open with write - access, an error will be signaled by a routine called by - this routine. - --Files - - See argument `handle' in $ Detailed_Input. - --Particulars - - A binary DAF contains an area which is reserved for storing - annotations or descriptive textual information about the data - contained in a file. This area is referred to as the ``comment - area'' of the file. The comment area of a DAF is a line oriented - medium for storing textual information. The comment area preserves - any leading or embedded white space in the line(s) of text which are - stored, so that the appearance of the of information will be - unchanged when it is retrieved (extracted) at some other time. - Trailing blanks, however, are NOT preserved, due to the way that - character strings are represented in standard Fortran 77. - - This routine will delete the entire comment area from the binary DAF - attached to `handle'. The size of the binary DAF will remain - unchanged. The space that was used by the comment records is - reclaimed: the data area of the DAF is shifted toward the beginning - - --Examples - - Let - - handle be the handle of a DAF which has been opened - with write access. - - The call - - dafdc_c ( handle ); - - deletes the entire comment area of the binary DAF attached to - `handle'. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.0, 16-NOV-2006 (NJB) (KRG) - --Index_Entries - - delete DAF comment area - --& -*/ - -{ /* Begin dafdc_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafdc_c" ); - - - /* - Hand off the task to the f2c'd routine. - */ - dafdc_ ( (integer *) &handle ); - - - - chkout_c ( "dafdc_c" ); - -} /* End dafdc_c */ diff --git a/ext/spice/src/cspice/dafec.c b/ext/spice/src/cspice/dafec.c deleted file mode 100644 index 1cb61173d6..0000000000 --- a/ext/spice/src/cspice/dafec.c +++ /dev/null @@ -1,846 +0,0 @@ -/* dafec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; -static integer c__1000 = 1000; - -/* $Procedure DAFEC ( DAF extract comments ) */ -/* Subroutine */ int dafec_(integer *handle, integer *bufsiz, integer *n, - char *buffer, logical *done, ftnlen buffer_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen), - s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer free; - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen); - integer i__, j, k; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, bward, fward, recno, index; - logical found; - integer ncomr; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - logical empty; - char ch[1]; - integer nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - static integer filhan[1000]; - static char crecrd[1000]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - static integer filchr[1000]; - integer daflun, nchars; - static integer filcnt[1000]; - static char eocmrk[1]; - extern integer isrchi_(integer *, integer *, integer *); - integer linlen; - static integer nfiles; - integer eocpos; - static char eolmrk[1]; - static integer lsthan, lstrec[1000]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer numcom; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer nelpos; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer curpos; - extern logical return_(void); - static integer lstpos[1000]; - logical eol; - - /* Fortran I/O blocks */ - static cilist io___29 = { 1, 0, 1, 0, 0 }; - static cilist io___33 = { 1, 0, 1, 0, 0 }; - static cilist io___38 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Extract comments from the comment area of a binary DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of binary DAF opened with read access. */ -/* BUFSIZ I Maximum size, in lines, of BUFFER. */ -/* N O Number of extracted comment lines. */ -/* BUFFER O Buffer where extracted comment lines are placed. */ -/* DONE O Indicates whether all comments have been extracted. */ - -/* $ Detailed_Input */ - -/* HANDLE The file handle of a binary DAF which has been opened */ -/* with read access. */ - -/* BUFSIZ The maximum number of comments that may be placed into */ -/* BUFFER. This would typically be the declared array size */ -/* for the Fortran character string array passed into this */ -/* routine. */ - -/* $ Detailed_Output */ - -/* N The number of comment lines extracted from the comment */ -/* area of the binary DAF attached to HANDLE. This number */ -/* will be <= BUFSIZ on output. If N = BUFSIZ and DONE <> */ -/* .TRUE., then there are more comments left to to extract. */ -/* If N = 0, then DONE = .TRUE., i.e., there were no */ -/* comments in the comment area or we have extracted all */ -/* of the comments. If there are comments in the comment */ -/* area, or comments remaining after the extraction process */ -/* has begun, N > 0, always. */ - -/* BUFFER A array of at most BUFSIZ comments which have been */ -/* extracted from the comment area of the binary DAF */ -/* attached to HANDLE. */ - -/* DONE A logical flag indicating whether or not all of the */ -/* comment lines from the comment area of the DAF have */ -/* been read. This variable has the value .TRUE. after the */ -/* last comment line has been read. It will have the value */ -/* .FALSE. otherwise. */ - -/* If there are no comments in the comment area, this */ -/* variable will have the value .TRUE., and N = 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the output line buffer is is not positive, */ -/* the error SPICE(INVALIDARGUMENT) will be signaled. */ - -/* 3) If a comment line in a DAF is longer than the length */ -/* of a character string array element of BUFFER, the error */ -/* SPICE(COMMENTTOOLONG) will be signaled. */ - -/* 3) If the end of the comments cannot be found, i.e., the end of */ -/* comments marker is missing on the last comment record, the */ -/* error SPICE(BADCOMMENTAREA) will be signaled. */ - -/* 4) If the number of comment characters scanned exceeds the */ -/* number of comment characters computed, the error */ -/* SPICE(BADCOMMENTAREA) will be signaled. */ - -/* 5) If the binary DAF attached to HANDLE is not open for */ -/* reading,an error will be signaled by a routine called by */ -/* this routine. */ - -/* $ Files */ - -/* See argument HANDLE in $ Detailed_Input. */ - -/* $ Particulars */ - -/* A binary DAF contains an area which is reserved for storing */ -/* annotations or descriptive textual information describing the data */ -/* contained in a file. This area is referred to as the ``comment */ -/* area'' of the file. The comment area of a DAF is a line */ -/* oriented medium for storing textual information. The comment */ -/* area preserves any leading or embedded white space in the line(s) */ -/* of text which are stored, so that the appearance of the of */ -/* information will be unchanged when it is retrieved (extracted) at */ -/* some other time. Trailing blanks, however, are NOT preserved, */ -/* due to the way that character strings are represented in */ -/* standard Fortran 77. */ - -/* This routine will read the comments from the comment area of */ -/* a binary DAF, placing them into a line buffer. If the line */ -/* buffer is not large enough to hold the entire comment area, */ -/* the portion read will be returned to the caller, and the DONE */ -/* flag will be set to .FALSE.. This allows the comment area to be */ -/* read in ``chunks,'' a buffer at a time. After all of the comment */ -/* lines have been read, the DONE flag will be set to .TRUE.. */ - -/* This routine can be used to ``simultaneously'' extract comments */ -/* from the comment areas of multiple binary DAFs. See Example */ -/* 2 in the $ Examples section. */ - -/* $ Examples */ - -/* Example 1 */ -/* --------- */ - -/* The following example will extract the entire comment area of a */ -/* binary DAF attached to HANDLE, displaying the comments on the */ -/* terminal screen. */ - -/* Let */ - -/* BUFFER have the following declaration: */ - -/* CHARACTER*(80) BUFFER(25) */ - -/* HANDLE be the handle of an open binary DAF file. */ - -/* then */ - -/* BUFSIZ = 25 */ -/* DONE = .FALSE. */ - -/* DO WHILE ( .NOT. DONE ) */ - -/* CALL DAFEC( HANDLE, BUFSIZ, N, BUFFER, DONE ) */ - -/* DO I = 1, N */ - -/* WRITE (*,*) BUFFER(I) */ - -/* END DO */ - -/* END DO */ - -/* Example 2 */ -/* --------- */ - -/* The following example demonstrates the use of this routine to */ -/* simultaneously read the comment areas of multiple DAFs. For each */ -/* file, the comments will be displayed on the screen as they are */ -/* extracted. */ - -/* Let */ - -/* BUFFER have the following declaration: */ - -/* CHARACTER*(80) BUFFER(25) */ - -/* NUMFIL be the number of binary DAFs that are to have their */ -/* comment areas displayed. */ - -/* DAFNAM(I) Be a list of filenames for the DAFs which are to */ -/* have their comment areas displayed. */ - -/* HANDLE(I) be a list of handles for the DAFs which are to have */ -/* their comment areas displayed. */ - -/* DONE(I) be a list of logical flags indicating whether */ -/* we are done extracting the comment area from the */ -/* DAF attached to HANDLE(I) */ - -/* then */ - -/* BUFSIZ = 25 */ - -/* DO I = 1, NUMFIL */ - -/* DONE(I) = .FALSE. */ -/* HANDLE(I) = 0 */ - -/* END DO */ -/* C */ -/* C Open the DAFs. */ -/* C */ -/* DO I = 1, NUMFIL */ - -/* CALL DAFOPR ( DAFNAM(I), HANDLE(I) ) */ - -/* END DO */ -/* C */ -/* C While there are still some comments left to read in at */ -/* C least one of the files, read them and display them. */ -/* C */ -/* DO WHILE ( .NOT. ALLTRU( DONE, NUMFIL ) ) */ - -/* DO I = 1, NUMFIL */ - -/* IF ( .NOT. DONE(I) ) THEN */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'File: ', DAFNAM(I)(:RTRIM(DAFNAM(I))) */ -/* WRITE (*,*) */ -/* N = 0 */ - -/* CALL DAFEC ( HANDLE(I), */ -/* . BUFSIZ, */ -/* . N, */ -/* . BUFFER, */ -/* . DONE(I) ) */ - -/* DO J = 1, N */ - -/* WRITE (*,*) BUFFER(J)(:RTRIM(BUFFER(J))) */ - -/* END DO */ - -/* END IF */ - -/* END DO */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The comment area may consist only of printing ASCII characters, */ -/* decimal values 32 - 126. */ - -/* 2) There is NO maximum length imposed on the significant portion */ -/* of a text line that may be placed into the comment area of a */ -/* DAF. The maximum length of a line stored in the comment area */ -/* should be kept reasonable, so that they may be easily */ -/* extracted. A good value for this would be 1000 characters, as */ -/* this can easily accomodate ``screen width'' lines as well as */ -/* long lines which may contain some other form of information. */ - -/* 3) This routine is only used to read records on environments */ -/* whose characters are a single byte in size. Updates */ -/* to this routine and routines in its call tree may be */ -/* required to properly handle other cases. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 08-NOV-2006 (NJB) (KRG) (FST) */ - -/* Based on Support Version 2.0.0, 16-NOV-2001 (FST) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract comments from a DAF */ - -/* -& */ -/* $ Revisions */ - - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Length of a DAF internal filename. */ - - -/* Decimal value for the DAF comment area end-of-comment (EOC) */ -/* marker. */ - - -/* Decimal value for the DAF comment area end-of-line (EOL) marker. */ - - -/* The maximum number of DAFs that may be open simultaneously. */ - - -/* Length of a DAF character record, in characters. */ - - -/* Local variables */ - - -/* The file table declarations for keeping track of which files */ -/* are currently in the process of having comments extracted. */ - - -/* Saved variables */ - - -/* Save all of the file table information. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFEC", (ftnlen)5); - } - -/* If this is the first time that this routine has been called, */ -/* we need to initialize the character value of the end-of-line */ -/* marker, and the file table variables. */ - - if (first) { - first = FALSE_; - nfiles = 0; - lsthan = 0; - *(unsigned char *)eocmrk = '\4'; - *(unsigned char *)eolmrk = '\0'; - for (i__ = 1; i__ <= 1000; ++i__) { - filchr[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fil" - "chr", i__1, "dafec_", (ftnlen)445)] = 0; - filcnt[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fil" - "cnt", i__1, "dafec_", (ftnlen)446)] = 0; - filhan[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fil" - "han", i__1, "dafec_", (ftnlen)447)] = 0; - lstpos[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("lst" - "pos", i__1, "dafec_", (ftnlen)448)] = 0; - lstrec[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("lst" - "rec", i__1, "dafec_", (ftnlen)449)] = 0; - } - } - -/* Verify that the DAF attached to HANDLE is opened for reading */ -/* by calling the routine to signal an invalid access mode on a */ -/* handle. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFEC", (ftnlen)5); - return 0; - } - -/* Check for a nonpositive BUFFER size. */ - - if (*bufsiz <= 0) { - setmsg_("The output buffer size was not positive: #.", (ftnlen)43); - errint_("#", bufsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - -/* Convert the DAF handle to its corresponding Fortran logical */ -/* unit number for reading the comment records. */ - - zzddhhlu_(handle, "DAF", &c_false, &daflun, (ftnlen)3); - if (failed_()) { - chkout_("DAFEC", (ftnlen)5); - return 0; - } - -/* Get the length of a single character string in the buffer. */ - - linlen = i_len(buffer, buffer_len); - -/* If we have extracted comments from at least one file and we */ -/* didn't finish, check to see if HANDLE is in the file table. */ - - if (nfiles > 0) { - index = isrchi_(handle, &nfiles, filhan); - } else { - index = 0; - } - -/* Check to see if we found HANDLE in the file handle table. If */ -/* we did, INDEX will be > 0. */ - - if (index > 0) { - -/* Set the record number and the starting position accordingly, */ -/* i.e., where we left off when we last read from that file. */ - - recno = lstrec[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "lstrec", i__1, "dafec_", (ftnlen)515)]; - curpos = lstpos[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("lstpos", i__1, "dafec_", (ftnlen)516)]; - nchars = filchr[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("filchr", i__1, "dafec_", (ftnlen)517)]; - ncomc = filcnt[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "filcnt", i__1, "dafec_", (ftnlen)518)]; - } else { - -/* We have not yet read any comments from this file, so start at */ -/* the start. To get to the first comment record, we need to skip */ -/* the file record. We also need to count the number of comment */ -/* characters. */ - -/* Read the file record from the DAF attached to HANDLE. We will */ -/* get back some stuff that we do not use. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFEC", (ftnlen)5); - return 0; - } - -/* Compute the number of comment records and the number of */ -/* comment characters. In order to perform these calculations, */ -/* we assume that we have a valid comment area in the DAF */ -/* attached to HANDLE. */ - - ncomr = fward - 2; - if (ncomr > 0) { - -/* The starting record number is the number of comment records */ -/* + 1 where the 1 skips the file record. */ - - empty = TRUE_; - found = FALSE_; - while(ncomr > 0 && ! found && empty) { - recno = ncomr + 1; - io___29.ciunit = daflun; - io___29.cirec = recno; - iostat = s_rdue(&io___29); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Error reading comment area of binary file named" - " '#'. IOSTAT = #.", (ftnlen)64); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - -/* Scan the comment record looking for the end of comments */ -/* marker. */ - - eocpos = cpos_(crecrd, eocmrk, &c__1, (ftnlen)1000, (ftnlen)1) - ; - if (eocpos > 0) { - found = TRUE_; - } else { - nelpos = ncpos_(crecrd, eolmrk, &c__1, (ftnlen)1000, ( - ftnlen)1); - if (nelpos != 0) { - empty = FALSE_; - } else { - --ncomr; - } - } - } - -/* If we do not find the end of comments marker and the */ -/* comment area is not empty, then it is an error. */ - - if (! found && ! empty) { - setmsg_("The comment area in the DAF file '#' may be damaged" - ". The end of the comments could not be found.", ( - ftnlen)96); - errfnm_("#", &daflun, (ftnlen)1); - sigerr_("SPICE(BADCOMMENTAREA)", (ftnlen)21); - chkout_("DAFEC", (ftnlen)5); - return 0; - } else if (found) { - ncomc = (ncomr - 1) * 1000 + eocpos - 1; - } else if (empty) { - ncomc = 0; - } - } else { - ncomc = 0; - } - -/* If the number of comment characters, NCOMC, is equal to zero, */ -/* then we have no comments to read, so set the number of comments */ -/* to zero, set DONE to .TRUE., check out, and return. */ - - if (ncomc == 0) { - *n = 0; - *done = TRUE_; - chkout_("DAFEC", (ftnlen)5); - return 0; - } - -/* Otherwise, set the initial position in the comment area. */ - - recno = 2; - curpos = 1; - nchars = 0; - } - -/* Begin reading the comment area into the buffer. */ - - if (*handle != lsthan) { - -/* If the current DAF handle is not the same as the handle on */ -/* the last call, then we need to read in the appropriate record */ -/* from the DAF comment area. Otherwise the record was saved and */ -/* so we don't need to read it in. */ - - io___33.ciunit = daflun; - io___33.cirec = recno; - iostat = s_rdue(&io___33); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - if (iostat != 0) { - setmsg_("Error reading comment area of binary file named FILE. " - "IOSTAT = *.", (ftnlen)66); - errint_("*", &iostat, (ftnlen)1); - errfnm_("FILE", &daflun, (ftnlen)4); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - } - -/* Initialize the BUFFER line counter, I, and the line position */ -/* counter, J. */ - - i__ = 1; - j = 1; - -/* Start filling up the BUFFER. */ - - numcom = 0; - *done = FALSE_; - while(i__ <= *bufsiz && ! (*done)) { - eol = FALSE_; - while(! eol) { - ++nchars; - *(unsigned char *)ch = *(unsigned char *)&crecrd[curpos - 1]; - if (*(unsigned char *)ch == 0) { - eol = TRUE_; - if (j <= linlen) { - s_copy(buffer + ((i__ - 1) * buffer_len + (j - 1)), " ", - buffer_len - (j - 1), (ftnlen)1); - } - } else { - if (j <= linlen) { - *(unsigned char *)&buffer[(i__ - 1) * buffer_len + (j - 1) - ] = *(unsigned char *)ch; - ++j; - } else { - setmsg_("The output buffer line length (#) was not long " - "enough to contain comment line #.", (ftnlen)80); - errint_("#", &linlen, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(COMMENTTOOLONG)", (ftnlen)21); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - } - -/* If we have reached the end of the current comment record, */ -/* read in the next one and reset the current position. */ -/* Otherwise, just increment the current position. */ - - if (curpos == 1000) { - ++recno; - io___38.ciunit = daflun; - io___38.cirec = recno; - iostat = s_rdue(&io___38); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, crecrd, (ftnlen)1000); - if (iostat != 0) { - goto L100003; - } - iostat = e_rdue(); -L100003: - if (iostat != 0) { - setmsg_("Error reading comment area of binary file named" - " #. IOSTAT = #.", (ftnlen)63); - errfnm_("#", &daflun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - curpos = 1; - } else { - ++curpos; - } - -/* Check to make sure that it is safe to continue, i.e., */ -/* that the number of comment characters we have processed */ -/* has not exceeded the number of comment characters in the */ -/* comment area of the DAF file. This should never happen. */ - - if (nchars > ncomc) { - setmsg_("Count of comment characters (#) exceeds the number " - "of comment characters (#) in the DAF file #.", ( - ftnlen)95); - errint_("#", &nchars, (ftnlen)1); - errint_("#", &ncomc, (ftnlen)1); - errfnm_("#", &daflun, (ftnlen)1); - sigerr_("SPICE(BADCOMMENTAREA)", (ftnlen)21); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - } - -/* We have just completed a comment line, so we save the comment */ -/* number, increment the buffer line counter, I, and reset the */ -/* buffer line position counter, J. */ - - numcom = i__; - ++i__; - j = 1; - -/* Check for the end of the comments. */ - - if (nchars == ncomc) { - -/* If we have reached the end of the comments, signaled */ -/* by having processed all of the comment characters, NCOMC, */ -/* then we are done. So, set DONE to .TRUE. and remove the */ -/* entry for this file from the file table. */ - - *done = TRUE_; - lsthan = 0; - -/* 0 <= INDEX <= NFILES, and we only want to remove things */ -/* from the file table if: */ - -/* The file we are currently reading from is in the */ -/* file table, INDEX > 0, which implies NFILES > 0. */ - -/* So, if INDEX > 0, we know that there are files in the file */ -/* table, and that we are currently reading from one of them. */ - - if (index > 0) { - i__1 = nfiles - 1; - for (k = index; k <= i__1; ++k) { - filchr[(i__2 = k - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "filchr", i__2, "dafec_", (ftnlen)810)] = filchr[( - i__3 = k) < 1000 && 0 <= i__3 ? i__3 : s_rnge( - "filchr", i__3, "dafec_", (ftnlen)810)]; - filcnt[(i__2 = k - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "filcnt", i__2, "dafec_", (ftnlen)811)] = filcnt[( - i__3 = k) < 1000 && 0 <= i__3 ? i__3 : s_rnge( - "filcnt", i__3, "dafec_", (ftnlen)811)]; - filhan[(i__2 = k - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "filhan", i__2, "dafec_", (ftnlen)812)] = filhan[( - i__3 = k) < 1000 && 0 <= i__3 ? i__3 : s_rnge( - "filhan", i__3, "dafec_", (ftnlen)812)]; - lstrec[(i__2 = k - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "lstrec", i__2, "dafec_", (ftnlen)813)] = lstrec[( - i__3 = k) < 1000 && 0 <= i__3 ? i__3 : s_rnge( - "lstrec", i__3, "dafec_", (ftnlen)813)]; - lstpos[(i__2 = k - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "lstpos", i__2, "dafec_", (ftnlen)814)] = lstpos[( - i__3 = k) < 1000 && 0 <= i__3 ? i__3 : s_rnge( - "lstpos", i__3, "dafec_", (ftnlen)814)]; - } - --nfiles; - } - } - } - -/* Set the number of comment lines in the buffer */ - - *n = numcom; - -/* At this point, we have either filled the buffer or we have */ -/* finished reading in the comment area. Find out what has */ -/* happened and act accordingly. */ - - if (! (*done)) { - -/* If we are not done, then we have filled the buffer, so save */ -/* everything that needs to be saved in the file table before */ -/* exiting. */ - - if (index == 0) { - -/* This was the first time that the comment area of this file */ -/* has been read, so add it to the file table and save all of */ -/* its information if there is room in the file table. */ - - if (nfiles >= 1000) { - setmsg_("The file table is full with # files, and another fi" - "le could not be added.", (ftnlen)73); - errint_("#", &c__1000, (ftnlen)1); - sigerr_("SPICE(FILETABLEFULL)", (ftnlen)20); - chkout_("DAFEC", (ftnlen)5); - return 0; - } - ++nfiles; - filchr[(i__1 = nfiles - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "filchr", i__1, "dafec_", (ftnlen)858)] = nchars; - filcnt[(i__1 = nfiles - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "filcnt", i__1, "dafec_", (ftnlen)859)] = ncomc; - filhan[(i__1 = nfiles - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "filhan", i__1, "dafec_", (ftnlen)860)] = *handle; - lstrec[(i__1 = nfiles - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "lstrec", i__1, "dafec_", (ftnlen)861)] = recno; - lstpos[(i__1 = nfiles - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "lstpos", i__1, "dafec_", (ftnlen)862)] = curpos; - lsthan = *handle; - } else { - -/* The comment area of this file is already in the file table, */ -/* so just update its information. */ - - filchr[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "filchr", i__1, "dafec_", (ftnlen)870)] = nchars; - lstrec[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "lstrec", i__1, "dafec_", (ftnlen)871)] = recno; - lstpos[(i__1 = index - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "lstpos", i__1, "dafec_", (ftnlen)872)] = curpos; - lsthan = *handle; - } - } - chkout_("DAFEC", (ftnlen)5); - return 0; -} /* dafec_ */ - diff --git a/ext/spice/src/cspice/dafec_c.c b/ext/spice/src/cspice/dafec_c.c deleted file mode 100644 index 7886245910..0000000000 --- a/ext/spice/src/cspice/dafec_c.c +++ /dev/null @@ -1,302 +0,0 @@ -/* - --Procedure dafec_c ( DAF extract comments ) - --Abstract - - Extract comments from the comment area of a binary DAF. - --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 - - DAF - --Keywords - - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - void dafec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt lenout, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of binary DAF opened with read access. - bufsiz I Maximum size, in lines, of buffer. - lenout I Length of strings in output buffer. - n O Number of extracted comment lines. - buffer O Buffer where extracted comment lines are placed. - done O Indicates whether all comments have been extracted. - --Detailed_Input - - handle is the file handle of a binary DAF which has been opened with - read access. - - bufsiz is the maximum number of comments that may be placed into - buffer. This would typically be the declared array size for - the Fortran character string array passed into this - routine. - - lenout is the allowed length of each string element of the output - buffer. This length must large enough to hold the longest - output string plus the null terminator. The SPICE system - imposes no limit on the length of comment lines, so `lenout' - normally should be set to a "generous" value that is unlikely - to be exceeded. - --Detailed_Output - - n is the number of comment lines extracted from the comment area - of the binary DAF associated with `handle'. `n' will be - less than or equal to `bufsiz' on output. - - buffer is an array containing comment lines read from the DAF - associated with `handle'. `buffer' should be declared - - SpiceChar buffer[bufsiz][lenout]; - - On output, the first `n' strings of `buffer' will contain - comment text, with one comment line per string. - - done is a logical flag indicating whether or not all of the - comment lines from the comment area of the DAF have - been read. This variable has the value SPICETRUE after the - last comment line has been read. It will have the value - SPICEFALSE otherwise. - - If there are no comments in the comment area, this - variable will have the value SPICETRUE. - --Parameters - - None. - --Exceptions - - 1) If the size of the output line buffer is is not positive, - the error SPICE(INVALIDARGUMENT) will be signaled. - - 3) If a comment line in a DAF is longer than the length - of a character string array element of BUFFER, the error - SPICE(COMMENTTOOLONG) will be signaled. - - 3) If the end of the comments cannot be found, i.e., the end of - comments marker is missing on the last comment record, the - error SPICE(BADCOMMENTAREA) will be signaled. - - 4) If the number of comment characters scanned exceeds the - number of comment characters computed, the error - SPICE(BADCOMMENTAREA) will be signaled. - - 5) If the binary DAF attached to HANDLE is not open for - reading,an error will be signaled by a routine called by - this routine. - - 6) If the output buffer pointer is null the error SPICE(NULLPOINTER) - will be signaled. - - 7) If the output buffer string length is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See argument `handle' in $ Detailed_Input. - --Particulars - - A binary DAF contains an area which is reserved for storing - annotations or descriptive textual information describing the data - contained in a file. This area is referred to as the ``comment - area'' of the file. The comment area of a DAF is a line - oriented medium for storing textual information. The comment - area preserves any leading or embedded white space in the line(s) - of text which are stored, so that the appearance of the of - information will be unchanged when it is retrieved (extracted) at - some other time. Trailing blanks, however, are NOT preserved, - due to the way that character strings are represented in - standard Fortran 77. - - This routine will read the comments from the comment area of - a binary DAF, placing them into a line buffer. If the line - buffer is not large enough to hold the entire comment area, - the portion read will be returned to the caller, and the DONE - flag will be set to SPICEFALSE. This allows the comment area to be - read in ``chunks,'' a buffer at a time. After all of the comment - lines have been read, the `done' flag will be set to SPICETRUE. - - This routine can be used to ``simultaneously'' extract comments - from the comment areas of multiple binary DAFs. See Example - 2 in the $ Examples section. - --Examples - - 1) The following example will extract the entire comment area of a - binary DAF, displaying the comments on the terminal screen. - - #include - #include "SpiceUsr.h" - - int main() - { - #define FILSIZ 256 - #define LINLEN 1001 - #define BUFFSZ 25 - - SpiceBoolean done = SPICEFALSE; - - SpiceChar daf [FILSIZ]; - SpiceChar buffer [BUFFSZ][LINLEN]; - - SpiceInt handle; - SpiceInt i; - SpiceInt n; - - - prompt_c ( "Enter name of DAF > ", FILSIZ, daf ); - - dafopr_c ( daf, &handle ); - - while ( !done ) - { - dafec_c ( handle, BUFFSZ, LINLEN, &n, buffer, &done ); - - for ( i = 0; i < n; i++ ) - { - printf ( "%s\n", buffer[i] ); - } - } - - return ( 0 ); - } - - - --Restrictions - - 1) The comment area may consist only of printing ASCII characters, - decimal values 32 - 126. - - 2) There is NO maximum length imposed on the significant portion - of a text line that may be placed into the comment area of a - DAF. The maximum length of a line stored in the comment area - should be kept reasonable, so that they may be easily - extracted. A good value for this might be 1000 characters, as - this can easily accommodate ``screen width'' lines as well as - long lines which may contain some other form of information. - - 3) This routine is only used to read records on environments - whose characters are a single byte in size. Updates - to this routine and routines in its call tree may be - required to properly handle other cases. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.0, 16-NOV-2006 (NJB) (KRG) - --Index_Entries - - extract comments from a DAF - --& -*/ - -{ /* Begin dafec_c */ - - - /* - Local variables - */ - logical fin; - - - /* - Participate in error tracing. - */ - chkin_c ( "dafec_c" ); - - /* - Make sure the string pointer for the buffer array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "dafec_c", buffer, lenout ); - - - /* - Call the f2c'd routine. - */ - dafec_ ( ( integer * ) &handle, - ( integer * ) &bufsiz, - ( integer * ) n, - ( char * ) buffer, - ( logical * ) &fin, - ( ftnlen ) lenout-1 ); - - /* - Set the output SpiceBoolean found flag. - */ - *done = fin; - - if ( *n > 0 ) - { - /* - `cvals' now contains the requested data in a single Fortran-style - string containing (lenout-1)*n significant characters. - - We need to convert `cvals' into an array - of n null-terminated strings each `lenout' long. - */ - F2C_ConvertTrStrArr ( *n, lenout, (char *)buffer ); - } - - chkout_c ( "dafec_c" ); - -} /* End dafec_c */ diff --git a/ext/spice/src/cspice/daffa.c b/ext/spice/src/cspice/daffa.c deleted file mode 100644 index 2f10d72801..0000000000 --- a/ext/spice/src/cspice/daffa.c +++ /dev/null @@ -1,4239 +0,0 @@ -/* daffa.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1000 = 1000; -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure DAFFA ( DAF, find array ) */ -/* Subroutine */ int daffa_0_(int n__, integer *handle, doublereal *sum, char - *name__, logical *found, ftnlen name_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical sthvnr[1000] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_ }; - static integer stfptr = -1; - static integer sthead = -1; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer free; - static doublereal exdc[124]; - static integer exic[250], stfh[1000], prev; - static char stnr[1000*1000]; - static doublereal stsr[128000] /* was [128][1000] */; - static integer i__, p; - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - static integer bward; - static doublereal newdc[124]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - static integer fward, newic[250]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *), movei_(integer *, - integer *, integer *); - static integer nextp; - static doublereal exsum[124]; - static integer nd; - extern logical failed_(void); - static char dafnam[255]; - static integer ni; - extern /* Subroutine */ int dafhof_(integer *), dafhfn_(integer *, char *, - ftnlen), dafhsf_(integer *, integer *, integer *), dafsih_( - integer *, char *, ftnlen); - static char ifname[60]; - extern /* Subroutine */ int dafrcr_(integer *, integer *, char *, ftnlen), - dafrfr_(integer *, integer *, integer *, char *, integer *, - integer *, integer *, ftnlen), dafgsr_(integer *, integer *, - integer *, integer *, doublereal *, logical *), dafwdr_(integer *, - integer *, doublereal *), dafwcr_(integer *, integer *, char *, - ftnlen); - static integer offset; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - static integer namsiz; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static integer stnseg[1000]; - extern /* Subroutine */ int ssizei_(integer *, integer *); - static integer opnset[1006]; - extern logical return_(void); - static integer stthis[1000], stpool[1000], stcurr[1000], stprev[1000], - stnext[1000], sumsiz; - static logical fnd; - -/* $ Abstract */ - -/* Find arrays in a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I,O DAFBFS, DAFBBS, DAFGH, DAFCS */ -/* SUM I,O DAFGS, DAFRS, DAFWS */ -/* NAME I,O DAFGN, DAFRN */ -/* FOUND O DAFFNA, DAFFPA */ - -/* $ Detailed_Input */ - -/* HANDLE on input is the handle of the DAF to be searched. */ - -/* SUM on input is an array summary that replaces the */ -/* summary of the current array in the DAF currently */ -/* being searched. */ - -/* NAME on input is an array name that replaces the name */ -/* of the current array in the DAF currently being */ -/* searched. */ - -/* $ Detailed_Output */ - -/* HANDLE on output is the handle of the DAF currently being */ -/* searched. */ - -/* SUM on output is the summary for the array found most */ -/* recently. */ - -/* NAME on output is the name for the array found */ -/* most recently. */ - -/* FOUND is true whenever the search for the next or the */ -/* previous array is successful, and is false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* DAFs read by DAFFA and its entry points are opened */ -/* elsewhere, and referred to only by their handles. */ - -/* $ Exceptions */ - -/* 1) If DAFFA is called directly, the error SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* 2) See entry points DAFBFS, DAFFNA, DAFBBS, DAFFPA, DAFGS, DAFGN, */ -/* DAFGH, DAFRS, DAFWS, DAFRN, and DAFCS for exceptions specific */ -/* to those entry points. */ - -/* $ Particulars */ - -/* DAFFA serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* DAFBFS Begin forward search. */ -/* DAFFNA Find next array. */ - -/* DAFBBS Begin backward search. */ -/* DAFFPA Find previous array. */ - -/* DAFGS Get summary. */ -/* DAFGN Get name. */ -/* DAFGH Get handle. */ - -/* DAFRS Replace summary. */ -/* DAFWS Write summary. */ -/* DAFRN Replace name. */ - -/* DAFCS Continue search. */ - -/* The main function of these entry points is to allow the */ -/* contents of any DAF to be examined on an array-by-array */ -/* basis. */ - -/* Conceptually, the arrays in a DAF form a doubly linked list, */ -/* which can be searched in either of two directions: forward or */ -/* backward. It is possible to search multiple DAFs simultaneously. */ - -/* DAFBFS (begin forward search) and DAFFNA are used to search the */ -/* arrays in a DAF in forward order. In applications that search a */ -/* single DAF at a time, the normal usage is */ - -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* . */ -/* . */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - - - -/* DAFBBS (begin backward search) and DAFFPA are used to search the */ -/* arrays in a DAF in backward order. In applications that search */ -/* a single DAF at a time, the normal usage is */ - -/* CALL DAFBBS ( HANDLE ) */ -/* CALL DAFFPA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* . */ -/* . */ - -/* CALL DAFFPA ( FOUND ) */ -/* END DO */ - - -/* In applications that conduct multiple searches simultaneously, */ -/* the above usage must be modified to specify the handle of the */ -/* file to operate on, in any case where the file may not be the */ -/* last one specified by DAFBFS or DAFBBS. The routine DAFCS */ -/* (DAF, continue search) is used for this purpose. Below, we */ -/* give an example of an interleaved search of two files specified */ -/* by the handles HANDL1 and HANDL2. The directions of searches */ -/* in different DAFs are independent; here we conduct a forward */ -/* search on one file and a backward search on the other. */ -/* Throughout, we use DAFCS to specify which file to operate on, */ -/* before calling DAFFNA, DAFFPA, DAFGS, DAFRS, DAFWS, DAFGN, or */ -/* DAFRN. */ - - -/* CALL DAFBFS ( HANDL1 ) */ -/* CALL DAFBBS ( HANDL2 ) */ - -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFFNA ( FOUND1 ) */ - -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFFPA ( FOUND2 ) */ - -/* DO WHILE ( FOUND1 .OR. FOUND2 ) */ - -/* IF ( FOUND1 ) THEN */ - -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* . */ -/* . */ -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFFNA ( FOUND1 ) */ - -/* END IF */ - -/* IF ( FOUND2 ) THEN */ - -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* . */ -/* . */ -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFFPA ( FOUND2 ) */ - -/* END IF */ - -/* END DO */ - - -/* At any time, the latest array found (whether by DAFFNA or DAFFPA) */ -/* is regarded as the `current' array for the file in which the */ -/* array was found. The last DAF in which a search was started, */ -/* executed, or continued by any of DAFBFS, DAFBBS, DAFFNA, DAFFPA */ -/* or DAFCS is regarded as the `current' DAF. The summary and name */ -/* for the current array in the current DAF can be returned */ -/* separately, as shown above, by calls to DAFGS (get summary) and */ -/* DAFGN (get name). The handle of the current DAF can also be */ -/* returned by calling DAFGH (get handle). */ - -/* The summary and name of the current array in the current DAF can */ -/* be updated (again, separately) by providing new ones through DAFRS */ -/* (replace summary) and DAFRN (replace name). This feature */ -/* should not be used except to correct errors that occurred during */ -/* the creation of a file. Note that changes can only be made to */ -/* files opened for write access. Also, the addresses of an array */ -/* cannot be changed using these routines. (Another routine, */ -/* DAFWS, is provided for this purpose, but should be used only */ -/* to reorder the arrays in a file.) */ - -/* Once a search has been begun, it may be continued in either */ -/* direction. That is, DAFFPA may be used to back up during a */ -/* forward search, and DAFFNA may be used to advance during a */ -/* backward search. */ - -/* $ Examples */ - -/* 1) The following code fragment illustrates the way the entry */ -/* points of DAFFA might be used to edit the summaries and names */ -/* for the arrays contained in a DAF. (All subroutines and */ -/* functions are from SPICELIB.) */ - -/* In this example, the user begins by supplying the name of */ -/* the file to be edited, followed by any number of the following */ -/* commands. */ - -/* NEXT finds the next array. */ - -/* PREV finds the previous array. */ - -/* EDIT changes the value of an item in the summary or */ -/* of the entire name. The keyword EDIT is */ -/* always followed by the name of the item to be */ -/* edited, */ - -/* DC n */ -/* IC n */ -/* NAME */ - -/* and the value, e.g., */ - -/* EDIT IC 2 315 */ -/* EDIT NAME NAIF test K2905-1 */ - -/* The user may terminate the session at any time by typing END. */ -/* Commands other than those listed above are ignored. */ - -/* READ (*,FMT='(A)') FNAME */ -/* CALL DAFOPW ( FNAME, HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ - -/* READ (*,FMT='(A)') COMMAND */ - -/* DO WHILE ( COMMAND .NE. 'END' ) */ -/* CALL NEXTWD ( COMMAND, VERB, COMMAND ) */ - -/* IF ( VERB .EQ. 'NEXT' ) THEN */ -/* CALL DAFFNA ( FOUND ) */ -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,*) 'At end of array list.' */ -/* END IF */ - -/* IF ( VERB .EQ. 'PREV' ) THEN */ -/* CALL DAFFPA ( FOUND ) */ -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,*) 'At beginning of array list.' */ -/* END IF */ - -/* IF ( VERB .EQ. 'EDIT' ) THEN */ -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ - -/* CALL NEXTWD ( COMMAND, ITEM, VALUE ) */ - -/* IF ( ITEM .EQ. 'DC' ) THEN */ -/* CALL NEXTWD ( VALUE, INDEX, VALUE ) */ -/* CALL NPARSI ( INDEX, LOC, ERR, PTR ) */ -/* CALL NPARSD ( VALUE, DC(LOC), ERR, PTR ) */ - -/* ELSE IF ( ITEM .EQ. 'IC' ) THEN */ -/* CALL NEXTWD ( VALUE, INDEX, VALUE ) */ -/* CALL NPARSI ( INDEX, LOC, ERR, PTR ) */ -/* CALL NPARSI ( VALUE, IC(LOC), ERR, PTR ) */ - -/* ELSE IF ( ITEM .EQ. 'NAME' ) THEN */ -/* NAME = VALUE */ -/* END IF */ - -/* CALL DAFPS ( ND, NI, DC, IC, SUM ) */ -/* CALL DAFRS ( SUM ) */ -/* CALL DAFRN ( NAME ) */ -/* END IF */ - -/* READ (*,FMT='(A)') COMMAND */ -/* END DO */ - - -/* 2) The following program compares data in two DAFs. The DAFs are */ -/* expected to have the same number of arrays, the same number */ -/* of elements in each corresponding array, and the same summary */ -/* format. */ - -/* Each difference whose magnitude exceeds a specified tolerance */ -/* is flagged. The difference information is written to a file. */ - - -/* PROGRAM CMPDAF */ - -/* C */ -/* C Compare data in two DAFs having identical structures. */ -/* C No array in either DAF is longer than ARRYSZ d.p. */ -/* C numbers. */ -/* C */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER ARRYSZ */ -/* PARAMETER ( ARRYSZ = 1000 ) */ - -/* INTEGER ERRLEN */ -/* PARAMETER ( ERRLEN = 240 ) */ - -/* INTEGER FILEN */ -/* PARAMETER ( FILEN = 128 ) */ - -/* INTEGER LINLEN */ -/* PARAMETER ( LINLEN = 80 ) */ - -/* INTEGER MAXND */ -/* PARAMETER ( MAXND = 125 ) */ - -/* INTEGER MAXNI */ -/* PARAMETER ( MAXNI = 250 ) */ - -/* INTEGER MAXSUM */ -/* PARAMETER ( MAXSUM = 128 ) */ - -/* INTEGER RLEN */ -/* PARAMETER ( RLEN = 1000 ) */ - - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(RLEN) ANAME1 */ -/* CHARACTER*(RLEN) ANAME2 */ -/* CHARACTER*(FILEN) DAF1 */ -/* CHARACTER*(FILEN) DAF2 */ -/* CHARACTER*(FILEN) LOG */ -/* CHARACTER*(ERRLEN) PRSERR */ -/* CHARACTER*(LINLEN) STR */ -/* CHARACTER*(LINLEN) TOLCH */ - -/* DOUBLE PRECISION ARRAY1 ( ARRYSZ ) */ -/* DOUBLE PRECISION ARRAY2 ( ARRYSZ ) */ -/* DOUBLE PRECISION DC1 ( MAXND ) */ -/* DOUBLE PRECISION DC2 ( MAXND ) */ -/* DOUBLE PRECISION TOL */ -/* DOUBLE PRECISION DIFF */ -/* DOUBLE PRECISION SUM1 ( MAXSUM ) */ -/* DOUBLE PRECISION SUM2 ( MAXSUM ) */ - -/* INTEGER FA1 */ -/* INTEGER FA2 */ -/* INTEGER I */ -/* INTEGER IA1 */ -/* INTEGER IA2 */ -/* INTEGER IC1 ( MAXNI ) */ -/* INTEGER IC2 ( MAXNI ) */ -/* INTEGER FA */ -/* INTEGER HANDL1 */ -/* INTEGER HANDL2 */ -/* INTEGER LEN1 */ -/* INTEGER LEN2 */ -/* INTEGER ND1 */ -/* INTEGER ND2 */ -/* INTEGER NI1 */ -/* INTEGER NI2 */ -/* INTEGER PTR */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Start out by obtaining the names of the DAFs to be */ -/* C compared. */ -/* C */ -/* WRITE (*,*) 'Enter name of first DAF.' */ -/* READ (*,FMT='(A)') DAF1 */ - -/* WRITE (*,*) 'Enter name of second DAF.' */ -/* READ (*,FMT='(A)') DAF2 */ - -/* WRITE (*,*) 'Enter name of log file.' */ -/* READ (*,FMT='(A)') LOG */ - -/* WRITE (*,*) 'Enter tolerance for data comparison.' */ -/* READ (*,FMT='(A)') TOLCH */ - -/* CALL NPARSD ( TOLCH, TOL, PRSERR, PTR ) */ - -/* DO WHILE ( PRSERR .NE. ' ' ) */ - -/* WRITE (*,*) PRSERR */ -/* WRITE (*,*) 'Enter tolerance for data comparison.' */ -/* READ (*,FMT='(A)') TOLCH */ - -/* CALL NPARSD ( TOLCH, TOL, PRSERR, PTR ) */ - -/* END DO */ - -/* C */ -/* C Open both DAFs for reading. */ -/* C */ -/* CALL DAFOPR ( DAF1, HANDL1 ) */ -/* CALL DAFOPR ( DAF2, HANDL2 ) */ - -/* C */ -/* C Start forward searches in both DAFS. */ -/* C */ -/* CALL DAFBFS ( HANDL1 ) */ -/* CALL DAFBFS ( HANDL2 ) */ - -/* C */ -/* C Obtain the summary formats for each DAF. Stop now */ -/* C if the summary formats don't match. */ -/* C */ -/* CALL DAFHSF ( HANDL1, ND1, NI1 ) */ -/* CALL DAFHSF ( HANDL2, ND2, NI2 ) */ - -/* IF ( ( ND1 .NE. ND2 ) .OR. ( NI1 .NE. NI2 ) ) THEN */ - -/* STR = 'Summary formats do not match. NI1 = #, '// */ -/* . 'NI2 = #, ND1 = #, ND2 = #.' */ - -/* CALL REPMI ( STR, '#', NI1, STR ) */ -/* CALL REPMI ( STR, '#', NI2, STR ) */ -/* CALL REPMI ( STR, '#', ND1, STR ) */ -/* CALL REPMI ( STR, '#', ND2, STR ) */ - -/* CALL WRLINE ( LOG, STR ) */ - -/* CALL SIGERR ( 'Incompatible DAFs' ) */ - -/* END IF */ - -/* C */ -/* C Find the first array in each DAF. Use DAFCS */ -/* C (DAF, continue search) to set the handle of the DAF */ -/* C to search in before calling DAFFNA. */ -/* C */ -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFFNA ( FOUND ) */ -/* END IF */ - -/* DO WHILE ( FOUND ) */ - -/* C */ -/* C Get the summary and name of each array, using */ -/* C DAFCS to select the DAF to get the information */ -/* C from. Unpack the summaries and find the beginning */ -/* C and ending addresses of the arrays. Read the */ -/* C arrays into the variables ARRAY1 and ARRAY2. */ -/* C */ -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFGN ( ANAME1 ) */ -/* CALL DAFGS ( SUM1 ) */ -/* CALL DAFUS ( SUM1, ND1, NI1, DC1, IC1 ) */ - -/* IA1 = IC1 ( NI1 - 1 ) */ -/* FA1 = IC1 ( NI1 ) */ -/* LEN1 = FA1 - IA1 + 1 */ - -/* IF ( LEN1 .GT. ARRYSZ ) THEN */ -/* CALL SETMSG ( 'Buffer too small; need # elts.') */ -/* CALL ERRINT ( '#', LEN1 ) */ -/* CALL SIGERR ( 'ARRAYTOOSMALL' ) */ -/* ELSE */ -/* CALL DAFRDA ( HANDL1, IA1, FA1, ARRAY1 ) */ -/* END IF */ - -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFGN ( ANAME2 ) */ -/* CALL DAFGS ( SUM2 ) */ -/* CALL DAFUS ( SUM2, ND2, NI2, DC2, IC2 ) */ - -/* IA2 = IC2 ( NI2 - 1 ) */ -/* FA2 = IC2 ( NI2 ) */ - -/* LEN2 = FA2 - IA2 + 1 */ - -/* IF ( LEN1 .GT. ARRYSZ ) THEN */ - -/* CALL SETMSG ( 'Buffer too small; need # elts.') */ -/* CALL ERRINT ( '#', LEN2 ) */ -/* CALL SIGERR ( 'ARRAYTOOSMALL' ) */ - -/* ELSE IF ( LEN1 .NE. LEN2 ) THEN */ - -/* CALL SETMSG ( 'DAF structures do not match. '// */ -/* . 'LEN1 = #, LEN2 = #. ' ) */ -/* CALL ERRINT ( '#', LEN1 ) */ -/* CALL ERRINT ( '#', LEN2 ) */ -/* CALL SIGERR ( 'Incompatible DAFs' ) */ - -/* ELSE */ -/* CALL DAFRDA ( HANDL2, IA2, FA2, ARRAY2 ) */ -/* END IF */ -/* C */ -/* C */ -/* C Compare the data in the two arrays. Log a message */ -/* C for every instance of data that differs by more */ -/* C than the allowed tolerance. Use the array names */ -/* C to label the data sources. */ -/* C */ -/* DO I = 1, LEN1 */ - -/* DIFF = ABS( ARRAY1(I) - ARRAY2(I) ) */ - -/* IF ( DIFF .GT. TOL ) THEN */ -/* C */ -/* C Get the array names. */ -/* C */ -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFGN ( ANAME1 ) */ -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFGN ( ANAME2 ) */ - -/* C */ -/* C Construct the report strings. The number 14 */ -/* C below is the number of significant digits to */ -/* C show in the strings representing d.p. */ -/* C numbers. */ -/* C */ - -/* CALL WRLINE ( LOG, ' ' ) */ -/* CALL WRLINE ( LOG, 'Difference of array ' // */ -/* . 'elements exceeded ' // */ -/* . 'tolerance.' ) */ -/* CALL WRLINE ( LOG, 'First array: '//ANAME1) */ -/* CALL WRLINE ( LOG, 'Second array: '//ANAME2) */ - -/* STR = 'First value: #' */ -/* CALL REPMD ( STR, '#', ARRAY1(I), 14, STR ) */ -/* CALL WRLINE ( LOG, STR ) */ - -/* STR = 'Second value: #' */ -/* CALL REPMD ( STR, '#', ARRAY2(I), 14, STR ) */ -/* CALL WRLINE ( LOG, STR ) */ - -/* STR = 'Difference: #' */ -/* CALL REPMD ( STR, '#', DIFF, 14, STR ) */ -/* CALL WRLINE ( LOG, STR ) */ -/* CALL WRLINE ( LOG, ' ' ) */ - -/* END IF */ - -/* END DO */ - -/* C */ -/* C Find the next pair of arrays. */ -/* C */ -/* CALL DAFCS ( HANDL1 ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* CALL DAFCS ( HANDL2 ) */ -/* CALL DAFFNA ( FOUND ) */ -/* END IF */ - -/* END DO */ - -/* C */ -/* C Close the DAFs. */ -/* C */ -/* CALL DAFCLS ( HANDL1 ) */ -/* CALL DAFCLS ( HANDL2 ) */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated the entry points of DAFFA to enable its */ -/* internal state table size, TBSIZE, to be smaller */ -/* than the file table maintained by DAFAH: FTSIZE. */ - -/* Calls to DAFRDR were replaced with the translation-aware */ -/* interface DAFGSR for retrieving summary records from */ -/* DAFs. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* find daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* This umbrella and its entry points were updated to */ -/* work properly with the changes in the DAF system as */ -/* a result of its utilization of the new handle manager. */ - -/* Since DAFAH now tracks FTSIZE files as defined in */ -/* the include file 'zzddhman.inc', it was decided that */ -/* in the interest of releasing the toolkit this module */ -/* would undergo simple changes. As such most previous */ -/* references to FTSIZE in this umbrella have been replaced */ -/* with TBSIZE where appropriate. DAFBFS and DAFBBS now signal */ -/* errors if there is not enough room to add a new DAF's */ -/* dossier to the state table. Also, after attempting to */ -/* clean up all files listed in the state table that are */ -/* not currently open, DAFBFS and DAFBBS attempt to locate */ -/* the first dossier with STADDG set to FALSE. This is then */ -/* freed to make room for the new DAF. If DAFBNA fails */ -/* to locate such a dossier in the state table, it */ -/* signals the error SPICE(STFULL). */ - -/* The parameter FILEN was removed, as it is defined */ -/* on an environmental basis in the include file */ -/* 'zzddhman.inc'. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* In previous versions of DAFFA, only one search could be */ -/* conducted at a time. Therefore, there was no question about */ -/* which DAF was being operated on by any of the DAFFA entry */ -/* points that don't accept file handles as input arguments. */ -/* In the current version of DAFFA, the entry points that don't */ -/* accept file handles as inputs operate on the `current DAF'. */ -/* The current DAF is the last one in which a search was */ -/* started by DAFBFS or DAFBBS, or continued by the new entry */ -/* point DAFCS. DAFCS was added to allow users to set the */ -/* current DAF, so that searches of multiple DAFs can be */ -/* interleaved. */ - -/* Note that the notion of `current DAF' as discussed here applies */ -/* only to DAFs acted upon by entry points of DAFFA. In DAFANA, */ -/* there is a DAF that is treated as the `current DAF' for */ -/* adding data; there is no connection between the DAFs regarded */ -/* as current by DAFFA and DAFANA. */ - -/* The two principal changes to DAFFA are the addition of the */ -/* new entry point DAFCS, and the addition of a data structure */ -/* called the `state table'. The state table is a collection of */ -/* parallel arrays that maintain information about the state */ -/* of each search that is currently in progress. The arrays are */ -/* indexed by a singly linked list pool; this mechanism allows */ -/* addition and deletion of information about searches without */ -/* requiring movement of data already in the state table. The */ -/* linked list pool contains an `active' list and a `free' list. */ -/* Nodes in the active list are used to index elements of the */ -/* state table where data about searches in progress is stored. */ -/* The head node of the active list is of particular significance: */ -/* the state information pointed to by this node is that of the */ -/* current DAF. Nodes in the free list index elements of the */ -/* state table that are available for use. */ - -/* When a search is started on a DAF that is not already `known' */ -/* to DAFFA, information about the DAF is added to the state */ -/* table. If there are no free elements in the state table, */ -/* the routine starting the search (DAFBFS or DAFBBS) will */ -/* perform garbage collection: the routine will test the handles */ -/* of each file about which information in stored in the state */ -/* table to see whether that file is still open. Nodes containing */ -/* information about DAFs that are no longer open will be moved */ -/* to the free list. */ - -/* Whenever a DAF becomes the current DAF, the linked list */ -/* that indexes the state table is adjusted so that the */ -/* information about the current DAF is at the head of the list. */ -/* This way, a slight efficiency is gained when repeated search */ -/* accesses are made to the same DAF, since the linear search */ -/* through the state table for information on that DAF will */ -/* be shortened. */ - -/* Since the algorithms for maintenance of linked lists are well */ -/* known, they are not documented here. However, see the */ -/* internals of the SPICELIB routine SPKBSR for a nice diagram */ -/* describing a similar data structure. */ - -/* The state table contains two arrays that are quite large: */ -/* there are buffers that contain the last character record */ -/* and summary record read from each DAF. A parallel situation */ -/* exists in DAFANA, where the name and array summary for each */ -/* array under construction are buffered. The total storage */ -/* required for these arrays (in DAFANA and DAFFA together) is */ -/* 4000 * TBSIZE bytes. For this reason, it may be a good idea */ -/* to reduce the value of TBSIZE in SPICELIB versions for */ -/* machines where memory is scarce. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* State variables. */ - -/* These variables define the state of each DAF to which data */ -/* is currently being added. For each DAF that we're writing to, we */ -/* maintain a copy of: */ - -/* STFH File handle. */ - -/* STPREV Record number of previous array summary. */ - -/* STTHIS Record number of current array summary. */ - -/* STNEXT Record number of next array summary. */ - -/* STNSEG Number of summaries in current summary record. */ - -/* STCURR Index of current summary within summary record. */ - -/* STNR Last name record read. */ - -/* STHVNR Flag indicating whether name record containing */ -/* name of current array is buffered. */ - -/* STSR Last summary record read. */ - -/* These variables are maintained in a table of parallel arrays; */ -/* the size of the table is TBSIZE. */ - - -/* The table of state variables is indexed by a singly linked list */ -/* of pointers. This mechanism avoids the work of moving */ -/* the state variable data about as information about DAFs is */ -/* added to or deleted from the table. */ - -/* The structure containing the linked list pointers is called a */ -/* `pool'. The pool contains a list of `active' nodes and a list */ -/* of free nodes. The head nodes of the active and free lists are */ -/* maintained as the variables STHEAD (`state table head') and */ -/* STFPTR (`state table free pointer'), respectively. Every node in */ -/* the pool is on exactly one of these lists. */ - - -/* The pool starts out with all of the nodes on the free list. The */ -/* first one of DAFBFS or DAFBBS to be called initializes the pool. */ -/* As new DAFs are searched, DAFBFS and DAFBBS add information about */ -/* them to the state table. Every time a search is started by DAFBFS */ -/* or DAFBBS, the routine in question `moves' the DAF's state */ -/* information to the head of the active list, if the state */ -/* information is not already there. This re-organization is */ -/* accomplished by deleting the node for the DAF from its current */ -/* position in the active list and inserting the node at the head of */ -/* the list. Thus, the change is made merely by setting pointers, */ -/* not by moving chunks of data in the state table. */ - -/* It may happen that there is no room left in the state table */ -/* to accommodate information about a new DAF. In this case, */ -/* garbage collection must be performed: whichever of DAFBFS or */ -/* DAFBBS needs more room frees all nodes in the table that index */ -/* DAFs that are not currently open. */ - -/* Note that the routines DAFGS, DAFGN, DAFRS, DAFRN, and DAFWS do */ -/* not modify the state table; they merely act on the current array */ -/* in the DAF that is at the head of the active list. */ - - -/* Other local variables */ - - -/* Save everything between calls */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (sum) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_dafbfs; - case 2: goto L_daffna; - case 3: goto L_dafbbs; - case 4: goto L_daffpa; - case 5: goto L_dafgs; - case 6: goto L_dafgn; - case 7: goto L_dafgh; - case 8: goto L_dafrs; - case 9: goto L_dafrn; - case 10: goto L_dafws; - case 11: goto L_dafcs; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFFA", (ftnlen)5); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("DAFFA", (ftnlen)5); - } - return 0; -/* $Procedure DAFBFS ( DAF, begin forward search ) */ - -L_dafbfs: -/* $ Abstract */ - -/* Begin a forward search for arrays in a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file to be searched. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF on which a forward */ -/* search is to be conducted. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin daf forward search */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* Also, the $Exceptions section was filled out. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFBFS", (ftnlen)6); - } - -/* Check out the file handle before going any further. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFBFS", (ftnlen)6); - return 0; - } - -/* Initialize the state table pool, if this hasn't been done yet. */ -/* Also initialize the cell used to obtain the set of handles of */ -/* open DAFs. */ - - if (first) { - ssizei_(&c__1000, opnset); - for (i__ = 1; i__ <= 999; ++i__) { - stpool[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stp" - "ool", i__1, "daffa_", (ftnlen)1123)] = i__ + 1; - } - stpool[999] = -1; - stfptr = 1; - first = FALSE_; - } - -/* See whether we already have an entry for this DAF in the */ -/* state table. Find the previous node if possible. */ - - p = sthead; - prev = -1; - fnd = FALSE_; - while(p != -1 && ! fnd) { - if (stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)1142)] == *handle) { - fnd = TRUE_; - } else { - prev = p; - p = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1146)]; - } - } - -/* At this point, either FND is false, or P points to a */ -/* state table entry describing the DAF indicated by HANDLE. */ -/* In the latter case, PREV is the predecessor of P. */ - - if (fnd) { - -/* We already have a dossier on this DAF. We already have */ -/* the information on the summary format, but we must re-set */ -/* our summary record pointers and our name record availability */ -/* flag. */ - -/* Rather than doing the update here, we do it outside of this */ -/* IF block. That way, the update gets done in just one place. */ -/* This just makes life easier: if the collection of state */ -/* variables is changed, there are fewer places to forget to */ -/* make the required code changes. */ - -/* Move the node for this DAF to the head of the active list, */ -/* if it is not already there: */ - -/* - Make the predecessor of P point to the successor of P. */ - -/* - Make P point to the head of the active list. */ - -/* - Make P the active list head node. */ - - - if (p != sthead) { - -/* P is in the active list, but is not at the head. So, */ -/* the predecessor of P is not NIL. */ - - stpool[(i__1 = prev - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1184)] = stpool[(i__2 = - p - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("stpool", i__2, - "daffa_", (ftnlen)1184)]; - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stpool" - , i__1, "daffa_", (ftnlen)1185)] = sthead; - sthead = p; - } - } else { - -/* We don't yet have any information on this DAF. Make a new */ -/* state table entry for the DAF. We may need to make room for */ -/* the new information by freeing space allocated to DAFs that */ -/* are no longer open. */ - - if (stfptr == -1) { - -/* Oops, we're out of space. Time for garbage collection. */ -/* Test each file handle to see whether it designates a DAF */ -/* that is still open. DAFHOF will tell us which handles */ -/* point to open DAFs. */ - - dafhof_(opnset); - p = sthead; - prev = -1; - -/* For every DAF file represented in the state table, we'll */ -/* delete the corresponding state information if the DAF is */ -/* now closed. We traverse the active list, examining each */ -/* file handle as we go. */ - - while(p != -1) { - if (elemi_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stfh", i__1, "daffa_", (ftnlen)1217)], opnset) - ) { - -/* The file is open. Have a look at the next node. */ - - prev = p; - p = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "daffa_", (ftnlen)1222)]; - } else { - -/* This file handle is not on the list, so free the */ -/* node pointing to the information about the DAF it */ -/* designated: */ - -/* - Save the successor of P. */ - -/* - Link the predecessor of node P to the successor */ -/* of P, if the predecessor is not NIL. */ - -/* - If it happens that P is the head node of the */ -/* active list, set the head equal to the */ -/* successor of P. */ - -/* - Link P into the free list. */ - -/* - Set P equal to its saved successor. */ - -/* - (PREV remains unchanged.) */ - - - nextp = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "daffa_", (ftnlen)1246)]; - if (p == sthead) { - -/* Re-assign STHEAD so that we don't lose the head */ -/* of the active list. P has no predecessor in this */ -/* case, so there's no need to set the forward pointer */ -/* of node PREV. */ - - sthead = nextp; - } else { - -/* Since P is not the head node of the active list, */ -/* PREV is not NIL, so we'll need to set the forward */ -/* pointer of node PREV. */ - - stpool[(i__1 = prev - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "daffa_", (ftnlen)1264) - ] = nextp; - } - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1269)] = stfptr; - stfptr = p; - p = nextp; - } - } - -/* At this point, we've freed all nodes from the active */ -/* list that were used to index information about DAFs that */ -/* are no longer open. If there's any more room in the state */ -/* table, we have it now. */ - - } - -/* If there still is no room, there is a bug in DAFAH, since DAFAH */ -/* should not allow more than TBSIZE DAFs to be open. So, we */ -/* assume that we've found some room. The first free node is */ -/* indicated by STFPTR. We'll allocate this node and use it to */ -/* index the state information for the new DAF. */ - - p = stfptr; - -/* Update the free list pointer, link P to the previous head */ -/* of the active list, and make P the head of the active list. */ - - stfptr = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1297)]; - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "daffa_", (ftnlen)1298)] = sthead; - sthead = p; - } - -/* At this point, P is the head node of the active list, and P is */ -/* the index in the state table of the information for the current */ -/* DAF. */ - - -/* Read the file record and first summary record. Do not read the */ -/* corresponding name record until necessary. In most searches, */ -/* names are of no interest. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - dafgsr_(handle, &fward, &c__1, &c__128, &stsr[(i__1 = (p << 7) - 128) < - 128000 && 0 <= i__1 ? i__1 : s_rnge("stsr", i__1, "daffa_", ( - ftnlen)1316)], &fnd); - -/* Set up the state information for this file. Note that we */ -/* don't have a name record yet, and we have no current array */ -/* yet. */ - - stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", i__1, - "daffa_", (ftnlen)1323)] = *handle; - stthis[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stthis", i__1, - "daffa_", (ftnlen)1324)] = fward; - stnext[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnext", i__1, - "daffa_", (ftnlen)1325)] = (integer) stsr[(i__2 = (p << 7) - 128) - < 128000 && 0 <= i__2 ? i__2 : s_rnge("stsr", i__2, "daffa_", ( - ftnlen)1325)]; - stprev[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stprev", i__1, - "daffa_", (ftnlen)1326)] = (integer) stsr[(i__2 = (p << 7) - 127) - < 128000 && 0 <= i__2 ? i__2 : s_rnge("stsr", i__2, "daffa_", ( - ftnlen)1326)]; - stnseg[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnseg", i__1, - "daffa_", (ftnlen)1327)] = (integer) stsr[(i__2 = (p << 7) - 126) - < 128000 && 0 <= i__2 ? i__2 : s_rnge("stsr", i__2, "daffa_", ( - ftnlen)1327)]; - sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr", i__1, - "daffa_", (ftnlen)1328)] = FALSE_; - -/* The arrays are returned in forward order within each summary */ -/* record. */ - - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", i__1, - "daffa_", (ftnlen)1333)] = 0; - chkout_("DAFBFS", (ftnlen)6); - return 0; -/* $Procedure DAFFNA ( DAF, find next array ) */ - -L_daffna: -/* $ Abstract */ - -/* Find the next (forward) array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FOUND O True if an array was found. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* FOUND is true if an array was found, and is false if, */ -/* when this routine is called, the current array is */ -/* the tail of the array list. (Recall that the */ -/* arrays in a DAF may be viewed as a doubly linked */ -/* list, with the tail being the last array in the file.) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called before a search is begun, the */ -/* error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF to be searched has actually been closed, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 3) If the end of the array list has already been reached when */ -/* this routine is called, this routine has no effect. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* find next daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFFNA", (ftnlen)6); - } - -/* FOUND will be false until we make it past the error checks. */ - - *found = FALSE_; - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFFNA", (ftnlen)6); - return 0; - -/* Make sure that the `current' DAF is still open. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)1522)], "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFFNA", (ftnlen)6); - return 0; - } - } - -/* Now that we know a search is going on, assume that we will find */ -/* an array until proven otherwise. */ - - *found = TRUE_; - -/* Either there are more summaries left in this record, or */ -/* there aren't. If there are, just incrementing the pointer */ -/* is sufficient. If there aren't, we have to find the next */ -/* record and point to the first array there. (If that */ -/* record is empty, or doesn't exist, then there are simply */ -/* no more arrays to be found.) */ - - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", i__1, - "daffa_", (ftnlen)1548)] = stcurr[(i__2 = p - 1) < 1000 && 0 <= - i__2 ? i__2 : s_rnge("stcurr", i__2, "daffa_", (ftnlen)1548)] + 1; - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)1550)] > stnseg[(i__2 = p - 1) < 1000 && - 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", (ftnlen)1550)] - ) { - if (stnext[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnext" - , i__1, "daffa_", (ftnlen)1552)] == 0) { - -/* There are no more arrays in the list. */ - - *found = FALSE_; - -/* Make sure that the array pointer stays pointing to */ -/* the position following the end of the list. Otherwise, */ -/* a call to DAFFPA might fail to find the last array in */ -/* the list. */ - - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr" - , i__1, "daffa_", (ftnlen)1563)] = stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daff" - "a_", (ftnlen)1563)] + 1; - -/* The careful reader may note that we're not updating any */ -/* of the pointers */ - -/* STTHIS */ -/* STNEXT */ -/* STPREV */ - -/* These will not be accessed if there is no current array. */ -/* If the array pointer is backed up again by a call to */ -/* DAFFPA, the values we have right now will be correct. */ - - } else { - dafgsr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)1578)], &stnext[(i__2 = p - - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("stnext", i__2, - "daffa_", (ftnlen)1578)], &c__1, &c__128, &stsr[(i__3 = ( - p << 7) - 128) < 128000 && 0 <= i__3 ? i__3 : s_rnge( - "stsr", i__3, "daffa_", (ftnlen)1578)], &fnd); - -/* The name (character) record we've saved no longer applies */ -/* to the current summary record. However, we've just updated */ -/* the summary record, so the summary record remains valid. */ - - sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr" - , i__1, "daffa_", (ftnlen)1584)] = FALSE_; - stthis[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stthis" - , i__1, "daffa_", (ftnlen)1586)] = stnext[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnext", i__2, "daff" - "a_", (ftnlen)1586)]; - stnext[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnext" - , i__1, "daffa_", (ftnlen)1587)] = (integer) stsr[(i__2 = - (p << 7) - 128) < 128000 && 0 <= i__2 ? i__2 : s_rnge( - "stsr", i__2, "daffa_", (ftnlen)1587)]; - stprev[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stprev" - , i__1, "daffa_", (ftnlen)1588)] = (integer) stsr[(i__2 = - (p << 7) - 127) < 128000 && 0 <= i__2 ? i__2 : s_rnge( - "stsr", i__2, "daffa_", (ftnlen)1588)]; - stnseg[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnseg" - , i__1, "daffa_", (ftnlen)1589)] = (integer) stsr[(i__2 = - (p << 7) - 126) < 128000 && 0 <= i__2 ? i__2 : s_rnge( - "stsr", i__2, "daffa_", (ftnlen)1589)]; - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr" - , i__1, "daffa_", (ftnlen)1590)] = 1; - *found = stnseg[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stnseg", i__1, "daffa_", (ftnlen)1592)] > 0; - } - } - chkout_("DAFFNA", (ftnlen)6); - return 0; -/* $Procedure DAFBBS ( DAF, begin backward search ) */ - -L_dafbbs: -/* $ Abstract */ - -/* Begin a backward search for arrays in a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF to be searched. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF on which a backward */ -/* search is to be conducted. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin daf backward search */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now makes the DAF designated by HANDLE the */ -/* current DAF---the one at the head of the active list. All */ -/* saved state variables used by this routine are now part of the */ -/* state table, or its associated set of pointers. */ - -/* Also, the $Exceptions section was filled out. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFBBS", (ftnlen)6); - } - -/* Check out the file handle before going any further. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFBBS", (ftnlen)6); - return 0; - } - -/* Initialize the state table pool, if this hasn't been done yet. */ -/* Also initialize the cell used to obtain the set of handles of */ -/* open DAFs. */ - - if (first) { - ssizei_(&c__1000, opnset); - for (i__ = 1; i__ <= 999; ++i__) { - stpool[(i__1 = i__ - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stp" - "ool", i__1, "daffa_", (ftnlen)1774)] = i__ + 1; - } - stpool[999] = -1; - stfptr = 1; - first = FALSE_; - } - -/* See whether we already have an entry for this DAF in the */ -/* state table. Find the previous node if possible. */ - - p = sthead; - prev = -1; - fnd = FALSE_; - while(p != -1 && ! fnd) { - if (stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)1793)] == *handle) { - fnd = TRUE_; - } else { - prev = p; - p = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1797)]; - } - } - -/* At this point, either FND is false, or P points to a */ -/* state table entry describing the DAF indicated by HANDLE. */ -/* In the latter case, PREV is the predecessor of P. */ - - if (fnd) { - -/* We already have a dossier on this DAF. We already have */ -/* the information on the summary format, but we must re-set */ -/* our summary record pointers and our name record availability */ -/* flag. */ - -/* Rather than doing the update here, we do it outside of this */ -/* IF block. That way, the update gets done in just one place. */ -/* This just makes life easier: if the collection of state */ -/* variables is changed, there are fewer places to forget to */ -/* make the required code changes. */ - -/* Move the node for this DAF to the head of the active list, */ -/* if it is not already there: */ - -/* - Make the predecessor of P point to the successor of P. */ - -/* - Make P point to the head of the active list. */ - -/* - Make P the active list head node. */ - - - if (p != sthead) { - -/* P is in the active list, but is not at the head. So, */ -/* the predecessor of P is not NIL. */ - - stpool[(i__1 = prev - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1835)] = stpool[(i__2 = - p - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("stpool", i__2, - "daffa_", (ftnlen)1835)]; - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stpool" - , i__1, "daffa_", (ftnlen)1836)] = sthead; - sthead = p; - } - } else { - -/* We don't yet have any information on this DAF. Make a new */ -/* state table entry for the DAF. We may need to make room for */ -/* the new information by freeing space allocated to DAFs that */ -/* are no longer open. */ - - if (stfptr == -1) { - -/* Oops, we're out of space. Time for garbage collection. */ -/* Test each file handle to see whether it designates a DAF */ -/* that is still open. DAFHOF will tell us which handles */ -/* point to open DAFs. */ - - dafhof_(opnset); - p = sthead; - prev = -1; - -/* For every DAF file represented in the state table, we'll */ -/* delete the corresponding state information if the DAF is */ -/* now closed. We traverse the active list, examining each */ -/* file handle as we go. */ - - while(p != -1) { - if (elemi_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stfh", i__1, "daffa_", (ftnlen)1868)], opnset) - ) { - -/* The file is open. Have a look at the next node. */ - - prev = p; - p = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "daffa_", (ftnlen)1873)]; - } else { - -/* This file handle is not on the list, so free the */ -/* node pointing to the information about the DAF it */ -/* designated: */ - -/* - Save the successor of P. */ - -/* - Link the predecessor of node P to the successor */ -/* of P, if the predecessor is not NIL. */ - -/* - If it happens that P is the head node of the */ -/* active list, set the head equal to the */ -/* successor of P. */ - -/* - Link P into the free list. */ - -/* - Set P equal to its saved successor. */ - -/* - (PREV remains unchanged.) */ - - - nextp = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "daffa_", (ftnlen)1897)]; - if (p == sthead) { - -/* Re-assign STHEAD so that we don't lose the head */ -/* of the active list. P has no predecessor in this */ -/* case, so there's no need to set the forward pointer */ -/* of node PREV. */ - - sthead = nextp; - } else { - -/* Since P is not the head node of the active list, */ -/* PREV is not NIL, so we'll need to set the forward */ -/* pointer of node PREV. */ - - stpool[(i__1 = prev - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "daffa_", (ftnlen)1915) - ] = nextp; - } - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1920)] = stfptr; - stfptr = p; - p = nextp; - } - } - -/* At this point, we've freed all nodes from the active */ -/* list that were used to index information about DAFs that */ -/* are no longer open. If there's any more room in the state */ -/* table, we have it now. */ - - } - -/* If there still is no room, there is a bug in DAFAH, since DAFAH */ -/* should not allow more than TBSIZE DAFs to be open. So, we */ -/* assume that we've found some room. The first free node is */ -/* indicated by STFPTR. We'll allocate this node and use it to */ -/* index the state information for the new DAF. */ - - p = stfptr; - -/* Update the free list pointer, link P to the previous head */ -/* of the active list, and make P the head of the active list. */ - - stfptr = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)1947)]; - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "daffa_", (ftnlen)1948)] = sthead; - sthead = p; - } - -/* At this point, P is the head node of the active list, and P is */ -/* the index in the state table of the information for the current */ -/* DAF. */ - - -/* Read the file record and last summary record. Do not read the */ -/* corresponding name record until necessary. In most searches, */ -/* names are of no interest. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - dafgsr_(handle, &bward, &c__1, &c__128, &stsr[(i__1 = (p << 7) - 128) < - 128000 && 0 <= i__1 ? i__1 : s_rnge("stsr", i__1, "daffa_", ( - ftnlen)1965)], &fnd); - stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", i__1, - "daffa_", (ftnlen)1967)] = *handle; - stthis[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stthis", i__1, - "daffa_", (ftnlen)1968)] = bward; - stnext[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnext", i__1, - "daffa_", (ftnlen)1969)] = (integer) stsr[(i__2 = (p << 7) - 128) - < 128000 && 0 <= i__2 ? i__2 : s_rnge("stsr", i__2, "daffa_", ( - ftnlen)1969)]; - stprev[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stprev", i__1, - "daffa_", (ftnlen)1970)] = (integer) stsr[(i__2 = (p << 7) - 127) - < 128000 && 0 <= i__2 ? i__2 : s_rnge("stsr", i__2, "daffa_", ( - ftnlen)1970)]; - stnseg[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnseg", i__1, - "daffa_", (ftnlen)1971)] = (integer) stsr[(i__2 = (p << 7) - 126) - < 128000 && 0 <= i__2 ? i__2 : s_rnge("stsr", i__2, "daffa_", ( - ftnlen)1971)]; - sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr", i__1, - "daffa_", (ftnlen)1972)] = FALSE_; - -/* The arrays are returned in backward order from each summary */ -/* record. */ - - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", i__1, - "daffa_", (ftnlen)1978)] = stnseg[(i__2 = p - 1) < 1000 && 0 <= - i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", (ftnlen)1978)] + 1; - chkout_("DAFBBS", (ftnlen)6); - return 0; -/* $Procedure DAFFPA ( DAF, find previous array ) */ - -L_daffpa: -/* $ Abstract */ - -/* Find the previous (backward) array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FOUND O True if an array was found. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* FOUND is true if an array was found, and is false if, */ -/* when this routine is called, the current array is */ -/* the head of the array list. (Recall that the */ -/* arrays in a DAF may be viewed as a doubly linked */ -/* list, with the head being the first array in the */ -/* file.) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called before a search is begun, the */ -/* error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF to be searched has actually been closed, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 3) If the beginning of the array list has already been reached */ -/* when this routine is called, this routine will not change the */ -/* current array. FOUND will be false on output. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ -/* Also, a bug fix was made to the array pointer adjustment */ -/* algorithm. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* find previous daf array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* Also, a bug fix was made to the array pointer adjustment */ -/* algorithm: the pointer is no longer decremented if it */ -/* is already less than 1 and the array summary pointer */ -/* is already pointing to the first array summary. In */ -/* addition, a test made to detect this condition was fixed: */ -/* the test */ - -/* CURR .EQ. 0 */ - -/* was replaced by */ - -/* STCURR(P) .LE. 0 */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFFPA", (ftnlen)6); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* FOUND will be false until we make it past the error checks. */ - - *found = FALSE_; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFFPA", (ftnlen)6); - return 0; - -/* Make sure that the `current' DAF is still open. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2189)], "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFFPA", (ftnlen)6); - return 0; - } - } - -/* Now that we know a search is going on, assume that we will find */ -/* an array until proven otherwise. */ - - *found = TRUE_; - -/* Either there are more summaries left in this record, or */ -/* there aren't. If there are, just decrementing the pointer */ -/* is sufficient. If there aren't, we have to find the previous */ -/* record and point to the last array there. (If that */ -/* record is empty, or doesn't exist, then there are simply */ -/* no more arrays to be found.) */ - - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", i__1, - "daffa_", (ftnlen)2212)] = stcurr[(i__2 = p - 1) < 1000 && 0 <= - i__2 ? i__2 : s_rnge("stcurr", i__2, "daffa_", (ftnlen)2212)] - 1; - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)2214)] <= 0) { - if (stprev[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stprev" - , i__1, "daffa_", (ftnlen)2216)] == 0) { - -/* There is no predecessor of the current array in the list. */ - - *found = FALSE_; - -/* Make sure that the array pointer stays pointing to */ -/* the position preceding the front of the list. Otherwise, */ -/* a call to DAFFNA might fail to find the first array in */ -/* the list. */ - - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr" - , i__1, "daffa_", (ftnlen)2227)] = 0; - -/* The careful reader may note that we're not updating any */ -/* of the pointers */ - -/* STTHIS */ -/* STNEXT */ -/* STPREV */ - -/* These will not be accessed if there is no current array. */ -/* If the array pointer is moved forward again by a call to */ -/* DAFFNA, the values we have right now will be correct. */ - - } else { - dafgsr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2242)], &stprev[(i__2 = p - - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("stprev", i__2, - "daffa_", (ftnlen)2242)], &c__1, &c__128, &stsr[(i__3 = ( - p << 7) - 128) < 128000 && 0 <= i__3 ? i__3 : s_rnge( - "stsr", i__3, "daffa_", (ftnlen)2242)], &fnd); - -/* The name (character) record we've saved no longer applies */ -/* to the current summary record. However, we've just updated */ -/* the summary record, so the summary record remains valid. */ - - sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr" - , i__1, "daffa_", (ftnlen)2248)] = FALSE_; - stthis[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stthis" - , i__1, "daffa_", (ftnlen)2250)] = stprev[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stprev", i__2, "daff" - "a_", (ftnlen)2250)]; - stnext[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnext" - , i__1, "daffa_", (ftnlen)2251)] = (integer) stsr[(i__2 = - (p << 7) - 128) < 128000 && 0 <= i__2 ? i__2 : s_rnge( - "stsr", i__2, "daffa_", (ftnlen)2251)]; - stprev[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stprev" - , i__1, "daffa_", (ftnlen)2252)] = (integer) stsr[(i__2 = - (p << 7) - 127) < 128000 && 0 <= i__2 ? i__2 : s_rnge( - "stsr", i__2, "daffa_", (ftnlen)2252)]; - stnseg[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnseg" - , i__1, "daffa_", (ftnlen)2253)] = (integer) stsr[(i__2 = - (p << 7) - 126) < 128000 && 0 <= i__2 ? i__2 : s_rnge( - "stsr", i__2, "daffa_", (ftnlen)2253)]; - stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr" - , i__1, "daffa_", (ftnlen)2254)] = stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daff" - "a_", (ftnlen)2254)]; - *found = stnseg[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stnseg", i__1, "daffa_", (ftnlen)2256)] > 0; - } - } - chkout_("DAFFPA", (ftnlen)6); - return 0; -/* $Procedure DAFGS ( DAF, get summary ) */ - -L_dafgs: -/* $ Abstract */ - -/* Return (get) the summary for the current array in the current */ -/* DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* DOUBLE PRECISION SUM ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SUM O Summary for current array. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* SUM is the summary for the current array (the array */ -/* found by the latest call to DAFFNA or DAFFPA). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF for which the `current' array's summary is to be */ -/* returned has actually been closed, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 3) If no array is current in the current DAF, the error */ -/* SPICE(NOCURRENTARRAY) is signalled. There is no current */ -/* array when a search is started by DAFBFS or DAFBBS, but no */ -/* calls to DAFFNA or DAFBNA have been made yet, or whenever */ -/* DAFFNA or DAFFPA return the value .FALSE. in the FOUND */ -/* argument. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ -/* Bug fix made to handle case of having no current array. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get daf summary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* In addition, this routine now checks whether an array */ -/* is current before trying to read its summary. The routine */ -/* previously crashed under these conditions. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFGS", (ftnlen)5); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFGS", (ftnlen)5); - return 0; - -/* Make sure that the `current' DAF is still open. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2454)], "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFGS", (ftnlen)5); - return 0; - } - } - -/* Check the current pointer position to make sure that it's in */ -/* bounds. If there is no current array, then we cannot return */ -/* a summary. This situation occurs if DAFFNA was called when the */ -/* current array was the last, or if DAFFPA was called when the */ -/* current array was the first. */ - - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)2470)] == 0) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2472)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `next' array is the first array of" - " DAF #", (ftnlen)65); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFGS", (ftnlen)5); - return 0; - } else if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stcurr", i__1, "daffa_", (ftnlen)2480)] > stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", ( - ftnlen)2480)]) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2482)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `previous' array is the last array" - " of DAF #", (ftnlen)68); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFGS", (ftnlen)5); - return 0; - } - -/* The location of the summary depends on the current pointer */ -/* position. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)2496)], &nd, &ni); - sumsiz = nd + (ni + 1) / 2; - offset = (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stc" - "urr", i__1, "daffa_", (ftnlen)2500)] - 1) * sumsiz + 3; - moved_(&stsr[(i__1 = offset + 1 + (p << 7) - 129) < 128000 && 0 <= i__1 ? - i__1 : s_rnge("stsr", i__1, "daffa_", (ftnlen)2502)], &sumsiz, - sum); - chkout_("DAFGS", (ftnlen)5); - return 0; -/* $Procedure DAFGN ( DAF, get array name ) */ - -L_dafgn: -/* $ Abstract */ - -/* Return (get) the name for the current array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME O Name of current array. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* NAME is the name for the current array (the array */ -/* found by the latest call to DAFFNA or DAFFPA). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF for which the `current' array's name is to be */ -/* returned has actually been closed, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 3) If no array is current in the current DAF, the error */ -/* SPICE(NOCURRENTARRAY) is signalled. There is no current */ -/* array when a search is started by DAFBFS or DAFBBS, but no */ -/* calls to DAFFNA or DAFBNA have been made yet, or whenever */ -/* DAFFNA or DAFFPA return the value .FALSE. in the FOUND */ -/* argument. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ -/* Bug fix made to handle case of having no current array. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get daf array name */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* In addition, this routine now checks whether an array */ -/* is current before trying to read its summary. The routine */ -/* previously crashed under these conditions. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFGN", (ftnlen)5); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFGN", (ftnlen)5); - return 0; - -/* Make sure that the `current' DAF is still open. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2692)], "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFGN", (ftnlen)5); - return 0; - } - } - -/* Check the current pointer position to make sure that it's in */ -/* bounds. If there is no current array, then we cannot get the */ -/* array's summary's name. This situation occurs if DAFFNA was */ -/* called when the current array was the last, or if DAFFPA was */ -/* called when the current array was the first. */ - - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)2708)] == 0) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2710)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `next' array is the first array of" - " DAF #", (ftnlen)65); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFGN", (ftnlen)5); - return 0; - } else if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stcurr", i__1, "daffa_", (ftnlen)2718)] > stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", ( - ftnlen)2718)]) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2720)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `previous' array is the last array" - " of DAF #", (ftnlen)68); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFGN", (ftnlen)5); - return 0; - } - -/* Read the name record for this summary record, if we don't have it */ -/* already. */ - - if (! sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr", - i__1, "daffa_", (ftnlen)2735)]) { - i__4 = stthis[(i__2 = p - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "stthis", i__2, "daffa_", (ftnlen)2737)] + 1; - dafrcr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2737)], &i__4, stnr + ((i__3 = - p - 1) < 1000 && 0 <= i__3 ? i__3 : s_rnge("stnr", i__3, - "daffa_", (ftnlen)2737)) * 1000, (ftnlen)1000); - sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr", - i__1, "daffa_", (ftnlen)2739)] = TRUE_; - } - -/* The location of the name depends on the current pointer */ -/* position. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)2748)], &nd, &ni); - sumsiz = nd + (ni + 1) / 2; - namsiz = sumsiz << 3; - offset = (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stc" - "urr", i__1, "daffa_", (ftnlen)2754)] - 1) * namsiz; - i__2 = offset; - s_copy(name__, stnr + (((i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("stnr", i__1, "daffa_", (ftnlen)2756)) * 1000 + i__2), - name_len, offset + namsiz - i__2); - chkout_("DAFGN", (ftnlen)5); - return 0; -/* $Procedure DAFGH ( DAF, get handle ) */ - -L_dafgh: -/* $ Abstract */ - -/* Return (get) the handle of the DAF currently being searched. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE O Handle for current DAF. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle for the current DAF (the handle */ -/* connected to the DAF that is currently being */ -/* searched). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF whose handle is to be returned has actually been */ -/* closed, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* $ Particulars */ - -/* Under rare circumstances, it may be necessary to identify */ -/* the particular DAF that is being searched (such as when */ -/* the search is begun by one module and continued by another). */ - -/* $ Examples */ - -/* Consider a program like the following, which examines the */ -/* individual arrays in a DAF and examines the contents of those */ -/* meeting certain criteria. */ - -/* CALL DAFOPW ( FNAME, HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL CHECK_DAF ( STATUS ) */ - -/* IF ( STATUS .EQ. 'EXAMINE' ) THEN */ -/* CALL EXAMINE_DAF */ -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* The subroutine CHECK_DAF, which assumes that a search is in */ -/* progress, gets the summary and name for the current array, and */ -/* uses them to decide whether the data in the array merit further */ -/* consideration. */ - -/* SUBROUTINE CHECK_DAF ( STATUS ) */ - -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGN ( NAME ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ -/* . */ -/* . */ - -/* The subroutine EXAMINE_DAF needs to examine the data in */ -/* the array itself. In order to do do, it needs to have access */ -/* not only to the summary, but to the handle of the file */ -/* containing the array. This is provided by DAFGH. */ - -/* SUBROUTINE EXAMINE_DAF */ - -/* CALL DAFGS ( SUM ) */ -/* CALL DAFGH ( HANDLE ) */ -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ - -/* CALL DAFRDA ( HANDLE, BEGIN, END, DATA ) */ -/* . */ -/* . */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get daf handle */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFGH", (ftnlen)5); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFGH", (ftnlen)5); - return 0; - -/* Make sure that the `current' DAF is still open. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)2983)], "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFGH", (ftnlen)5); - return 0; - } - } - *handle = stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)2993)]; - chkout_("DAFGH", (ftnlen)5); - return 0; -/* $Procedure DAFRS ( DAF, replace summary ) */ - -L_dafrs: -/* $ Abstract */ - -/* Change the summary for the current array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* DOUBLE PRECISION SUM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SUM I New summary for current array. */ - -/* $ Detailed_Input */ - -/* SUM is the new summary for the current array. This */ -/* replaces the existing summary. However, the addresses */ -/* (the final two integer components) of the original */ -/* summary are not changed. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF containing the `current' array has actually been */ -/* closed, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* 3) If the DAF containing the `current' array is not open for */ -/* writing, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* 4) If no array is current in the current DAF, the error */ -/* SPICE(NOCURRENTARRAY) is signalled. There is no current */ -/* array when a search is started by DAFBFS or DAFBBS, but no */ -/* calls to DAFFNA or DAFBNA have been made yet, or whenever */ -/* DAFFNA or DAFFPA return the value .FALSE. in the FOUND */ -/* argument. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ -/* Bug fix made to handle case of having no current array. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace daf summary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* In addition, this routine now checks whether an array */ -/* is current before trying to read its summary. The routine */ -/* previously crashed under these conditions. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRS", (ftnlen)5); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFRS", (ftnlen)5); - return 0; - -/* Make sure that the `current' DAF is still open, and that it */ -/* is open for writing. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3192)], "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFRS", (ftnlen)5); - return 0; - } - } - -/* Check the current pointer position to make sure that it's in */ -/* bounds. If there is no current array, then we cannot replace the */ -/* array's summary. This situation occurs if DAFFNA was called */ -/* when the current array was the last, or if DAFFPA was called when */ -/* the current array was the first. */ - - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)3208)] == 0) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3210)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `next' array is the first array of" - " DAF #", (ftnlen)65); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFRS", (ftnlen)5); - return 0; - } else if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stcurr", i__1, "daffa_", (ftnlen)3218)] > stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", ( - ftnlen)3218)]) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3220)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `previous' array is the last array" - " of DAF #", (ftnlen)68); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFRS", (ftnlen)5); - return 0; - } - -/* The location of the summary depends on the current pointer */ -/* position. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3234)], &nd, &ni); - sumsiz = nd + (ni + 1) / 2; - offset = (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stc" - "urr", i__1, "daffa_", (ftnlen)3238)] - 1) * sumsiz + 3; - -/* Get the existing summary, and unpack it. Replace everything */ -/* but the addresses (the final two integer components), and */ -/* repack. Then replace the existing summary within the record. */ - - moved_(&stsr[(i__1 = offset + 1 + (p << 7) - 129) < 128000 && 0 <= i__1 ? - i__1 : s_rnge("stsr", i__1, "daffa_", (ftnlen)3245)], &sumsiz, - exsum); - dafus_(exsum, &nd, &ni, exdc, exic); - dafus_(sum, &nd, &ni, newdc, newic); - moved_(newdc, &nd, exdc); - i__1 = ni - 2; - movei_(newic, &i__1, exic); - dafps_(&nd, &ni, exdc, exic, exsum); - moved_(exsum, &sumsiz, &stsr[(i__1 = offset + 1 + (p << 7) - 129) < - 128000 && 0 <= i__1 ? i__1 : s_rnge("stsr", i__1, "daffa_", ( - ftnlen)3254)]); - -/* Rewrite the modified summary record. */ - - dafwdr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3259)], &stthis[(i__2 = p - 1) < 1000 && - 0 <= i__2 ? i__2 : s_rnge("stthis", i__2, "daffa_", (ftnlen)3259)] - , &stsr[(i__3 = (p << 7) - 128) < 128000 && 0 <= i__3 ? i__3 : - s_rnge("stsr", i__3, "daffa_", (ftnlen)3259)]); - chkout_("DAFRS", (ftnlen)5); - return 0; -/* $Procedure DAFRN ( DAF, change array name ) */ - -L_dafrn: -/* $ Abstract */ - -/* Replace the name for the current array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I New name for current array. */ - -/* $ Detailed_Input */ - -/* NAME is the new name for the current array. */ -/* This replaces the existing name. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF containing the `current' array has actually been */ -/* closed, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* 3) If the DAF containing the `current' array is not open for */ -/* writing, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* 4) If no array is current in the current DAF, the error */ -/* SPICE(NOCURRENTARRAY) is signalled. There is no current */ -/* array when a search is started by DAFBFS or DAFBBS, but no */ -/* calls to DAFFNA or DAFBNA have been made yet, or whenever */ -/* DAFFNA or DAFFPA return the value .FALSE. in the FOUND */ -/* argument. */ - -/* $ Particulars */ - -/* See DAFFA. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* change daf array name */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* In addition, this routine now checks whether an array */ -/* is current before trying to read its summary. The routine */ -/* previously crashed under these conditions. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRN", (ftnlen)5); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFRN", (ftnlen)5); - return 0; - -/* Make sure that the `current' DAF is still open, and that it */ -/* is open for writing. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3453)], "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFRN", (ftnlen)5); - return 0; - } - } - -/* Check the current pointer position to make sure that it's in */ -/* bounds. If there is no current array, then we cannot replace */ -/* the array's summary's name. This situation occurs if DAFFNA was */ -/* called when the current array was the last, or if DAFFPA was */ -/* called when the current array was the first. */ - - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)3469)] == 0) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3471)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `next' array is the first array of" - " DAF #", (ftnlen)65); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFRN", (ftnlen)5); - return 0; - } else if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stcurr", i__1, "daffa_", (ftnlen)3479)] > stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", ( - ftnlen)3479)]) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3481)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `previous' array is the last array" - " of DAF #", (ftnlen)68); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFRN", (ftnlen)5); - return 0; - } - -/* Read the name record for this summary record, if we don't have it */ -/* already. */ - - if (! sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr", - i__1, "daffa_", (ftnlen)3497)]) { - i__4 = stthis[(i__2 = p - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "stthis", i__2, "daffa_", (ftnlen)3499)] + 1; - dafrcr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3499)], &i__4, stnr + ((i__3 = - p - 1) < 1000 && 0 <= i__3 ? i__3 : s_rnge("stnr", i__3, - "daffa_", (ftnlen)3499)) * 1000, (ftnlen)1000); - sthvnr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sthvnr", - i__1, "daffa_", (ftnlen)3501)] = TRUE_; - } - -/* The location of the name depends on the current pointer */ -/* position. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3510)], &nd, &ni); - sumsiz = nd + (ni + 1) / 2; - namsiz = sumsiz << 3; - offset = (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stc" - "urr", i__1, "daffa_", (ftnlen)3516)] - 1) * namsiz; - i__2 = offset; - s_copy(stnr + (((i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stnr", - i__1, "daffa_", (ftnlen)3518)) * 1000 + i__2), name__, offset + - namsiz - i__2, name_len); - -/* Rewrite the character record. */ - - i__4 = stthis[(i__2 = p - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("stthis", - i__2, "daffa_", (ftnlen)3523)] + 1; - dafwcr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3523)], &i__4, stnr + ((i__3 = p - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("stnr", i__3, "daffa_", (ftnlen) - 3523)) * 1000, (ftnlen)1000); - chkout_("DAFRN", (ftnlen)5); - return 0; -/* $Procedure DAFWS ( DAF, write summary ) */ - -L_dafws: -/* $ Abstract */ - -/* Write a new summary for the current array in the current DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* DOUBLE PRECISION SUM ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SUM I New summary for current array in the current DAF. */ - -/* $ Detailed_Input */ - -/* SUM is the new summary for the current array. This */ -/* replaces the existing summary, including the */ -/* addresses (the final two integer components) of */ -/* the original summary. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* DAFWS updates the DAF currently being searched. The handle */ -/* of this DAF can be retrieved using the routine DAFGH. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* 2) If the DAF containing the `current' array has actually been */ -/* closed, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* 3) If the DAF containing the `current' array is not open for */ -/* writing, the error will be diagnosed by routines called by */ -/* this routine. */ - -/* 4) If no array is current in the current DAF, the error */ -/* SPICE(NOCURRENTARRAY) is signalled. There is no current */ -/* array when a search is started by DAFBFS or DAFBBS, but no */ -/* calls to DAFFNA or DAFBNA have been made yet, or whenever */ -/* DAFFNA or DAFFPA return the value .FALSE. in the FOUND */ -/* argument. */ - -/* $ Particulars */ - -/* Unless you are reordering the arrays in the file being searched, */ -/* you should be using DAFRS instead of this routine. */ - -/* See also DAFFA, DAFRS. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ -/* Bug fix made to handle case of having no current array. */ - -/* - SPICELIB Version 1.0.0, 28-MAR-1991 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write daf summary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT) */ - -/* Updated to support simultaneous searches of multiple DAFs. */ - -/* This routine now operates on the current DAF---the one at */ -/* the head of the active list. All saved state variables */ -/* used by this routine are now part of the state table, or */ -/* its associated set of pointers. */ - -/* In addition, this routine now checks whether an array */ -/* is current before trying to read its summary. The routine */ -/* previously crashed under these conditions. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFWS", (ftnlen)5); - } - -/* Operate on the last DAF in which a search has been started. */ - - p = sthead; - -/* Make sure that a search has been started in this DAF. */ - - if (p == -1) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFWS", (ftnlen)5); - return 0; - -/* Make sure that the `current' DAF is still open, and that it is */ -/* open for writing. */ - - } else { - dafsih_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3719)], "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFWS", (ftnlen)5); - return 0; - } - } - -/* Check the current pointer position to make sure that it's in */ -/* bounds. If there is no current array, then we cannot write a */ -/* new array summary. This situation occurs if DAFFNA was called */ -/* when the current array was the last, or if DAFFPA was called */ -/* when the current array was the first. */ - - if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stcurr", - i__1, "daffa_", (ftnlen)3735)] == 0) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3737)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `next' array is the first array of" - " DAF #", (ftnlen)65); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFWS", (ftnlen)5); - return 0; - } else if (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stcurr", i__1, "daffa_", (ftnlen)3745)] > stnseg[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stnseg", i__2, "daffa_", ( - ftnlen)3745)]) { - dafhfn_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stfh", i__1, "daffa_", (ftnlen)3747)], dafnam, (ftnlen)255); - setmsg_("No array is current; the `previous' array is the last array" - " of DAF #", (ftnlen)68); - errch_("#", dafnam, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(NOCURRENTARRAY)", (ftnlen)21); - chkout_("DAFWS", (ftnlen)5); - return 0; - } - -/* The location of the summary depends on the current pointer */ -/* position. */ - - dafhsf_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3763)], &nd, &ni); - sumsiz = nd + (ni + 1) / 2; - offset = (stcurr[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stc" - "urr", i__1, "daffa_", (ftnlen)3767)] - 1) * sumsiz + 3; - moved_(sum, &sumsiz, &stsr[(i__1 = offset + 1 + (p << 7) - 129) < 128000 - && 0 <= i__1 ? i__1 : s_rnge("stsr", i__1, "daffa_", (ftnlen)3769) - ]); - -/* Rewrite the modified summary record. */ - - dafwdr_(&stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3774)], &stthis[(i__2 = p - 1) < 1000 && - 0 <= i__2 ? i__2 : s_rnge("stthis", i__2, "daffa_", (ftnlen)3774)] - , &stsr[(i__3 = (p << 7) - 128) < 128000 && 0 <= i__3 ? i__3 : - s_rnge("stsr", i__3, "daffa_", (ftnlen)3774)]); - chkout_("DAFWS", (ftnlen)5); - return 0; -/* $Procedure DAFCS ( DAF, continue search ) */ - -L_dafcs: -/* $ Abstract */ - -/* Select a DAF that already has a search in progress as the */ -/* one to continue searching. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF to continue searching. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF in which either a forward */ -/* or backward search has already been started by */ -/* DAFBFS or DAFBBS. The DAF may be open for read */ -/* or write access. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 2) If this routine is called when no search is in progress in the */ -/* the current DAF, the error SPICE(DAFNOSEARCH) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DAFCS supports simultaneous searching of multiple DAFs. In */ -/* applications that use this capability, DAFCS should be called */ -/* prior to each call to DAFFNA, DAFFPA, DAFGN, DAFGS, DAFRS, or */ -/* DAFWS, to specify which DAF is to be acted upon. */ - -/* $ Examples */ - -/* See DAFFA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ 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, 04-SEP-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* select a daf to continue searching */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFCS", (ftnlen)5); - } - -/* Validate the DAF's handle before going any further. DAFSIH will */ -/* signal an error if HANDLE doesn't designate an open DAF. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFCS", (ftnlen)5); - return 0; - } - -/* See whether we already have an entry for this DAF in the */ -/* state table. Find the previous node if possible. */ - - p = sthead; - prev = -1; - fnd = FALSE_; - while(p != -1 && ! fnd) { - if (stfh[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stfh", - i__1, "daffa_", (ftnlen)3938)] == *handle) { - fnd = TRUE_; - } else { - prev = p; - p = stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "stpool", i__1, "daffa_", (ftnlen)3942)]; - } - } - -/* Either FND is false, or P is the index in the state table of */ -/* the DAF specified by HANDLE, and PREV is the predecessor of P. */ - - -/* You can't continue searching a DAF that you're not already */ -/* searching. */ - - if (! fnd) { - setmsg_("No DAF is currently being searched.", (ftnlen)35); - sigerr_("SPICE(DAFNOSEARCH)", (ftnlen)18); - chkout_("DAFCS", (ftnlen)5); - return 0; - } - -/* Move the node for this DAF to the head of the active list, */ -/* if it is not already there: */ - -/* - Make the predecessor of P point to the successor of P. */ - -/* - Make P point to the head of the active list. */ - -/* - Make P the active list head node. */ - - - if (p != sthead) { - -/* P is in the active list, but is not at the head. So, */ -/* the predecessor of P is not NIL. */ - - stpool[(i__1 = prev - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "daffa_", (ftnlen)3983)] = stpool[(i__2 = p - 1) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("stpool", i__2, "daffa_", ( - ftnlen)3983)]; - stpool[(i__1 = p - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("stpool", - i__1, "daffa_", (ftnlen)3984)] = sthead; - sthead = p; - } - chkout_("DAFCS", (ftnlen)5); - return 0; -} /* daffa_ */ - -/* Subroutine */ int daffa_(integer *handle, doublereal *sum, char *name__, - logical *found, ftnlen name_len) -{ - return daffa_0_(0, handle, sum, name__, found, name_len); - } - -/* Subroutine */ int dafbfs_(integer *handle) -{ - return daffa_0_(1, handle, (doublereal *)0, (char *)0, (logical *)0, ( - ftnint)0); - } - -/* Subroutine */ int daffna_(logical *found) -{ - return daffa_0_(2, (integer *)0, (doublereal *)0, (char *)0, found, ( - ftnint)0); - } - -/* Subroutine */ int dafbbs_(integer *handle) -{ - return daffa_0_(3, handle, (doublereal *)0, (char *)0, (logical *)0, ( - ftnint)0); - } - -/* Subroutine */ int daffpa_(logical *found) -{ - return daffa_0_(4, (integer *)0, (doublereal *)0, (char *)0, found, ( - ftnint)0); - } - -/* Subroutine */ int dafgs_(doublereal *sum) -{ - return daffa_0_(5, (integer *)0, sum, (char *)0, (logical *)0, (ftnint)0); - } - -/* Subroutine */ int dafgn_(char *name__, ftnlen name_len) -{ - return daffa_0_(6, (integer *)0, (doublereal *)0, name__, (logical *)0, - name_len); - } - -/* Subroutine */ int dafgh_(integer *handle) -{ - return daffa_0_(7, handle, (doublereal *)0, (char *)0, (logical *)0, ( - ftnint)0); - } - -/* Subroutine */ int dafrs_(doublereal *sum) -{ - return daffa_0_(8, (integer *)0, sum, (char *)0, (logical *)0, (ftnint)0); - } - -/* Subroutine */ int dafrn_(char *name__, ftnlen name_len) -{ - return daffa_0_(9, (integer *)0, (doublereal *)0, name__, (logical *)0, - name_len); - } - -/* Subroutine */ int dafws_(doublereal *sum) -{ - return daffa_0_(10, (integer *)0, sum, (char *)0, (logical *)0, (ftnint)0) - ; - } - -/* Subroutine */ int dafcs_(integer *handle) -{ - return daffa_0_(11, handle, (doublereal *)0, (char *)0, (logical *)0, ( - ftnint)0); - } - diff --git a/ext/spice/src/cspice/daffna_c.c b/ext/spice/src/cspice/daffna_c.c deleted file mode 100644 index a413b86f1f..0000000000 --- a/ext/spice/src/cspice/daffna_c.c +++ /dev/null @@ -1,263 +0,0 @@ -/* - --Procedure daffna_c ( DAF, find next array ) - --Abstract - - Find the next (forward) array in the current DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void daffna_c ( SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - found O SPICETRUE if an array was found. - --Detailed_Input - - None. - --Detailed_Output - - found is SPICETRUE if an array was found, and is SPICEFALSE - if, when this routine is called, the current array is - the tail of the array list. (Recall that the arrays in - a DAF may be viewed as a doubly linked list, with the - tail being the last array in the file.) - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If this routine is called before a search is begun, the - error SPICE(DAFNOSEARCH) is signalled. - - 2) If the DAF to be searched has actually been closed, the error - will be diagnosed by routines called by this routine. - - 3) If the end of the array list has already been reached when - this routine is called, this routine has no effect. - --Particulars - - - The DAF search routines are: - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 31-JUL-1999 (NJB) (WLT) (IMU) - --Index_Entries - - find next daf array - --& -*/ - -{ /* Begin daffna_c */ - - /* - Local variables - */ - logical fnd; - - /* - Participate in error tracing. - */ - chkin_c ( "daffna_c" ); - - - daffna_ ( ( logical * ) &fnd ); - - *found = fnd; - - - chkout_c ( "daffna_c" ); - -} /* End daffna_c */ diff --git a/ext/spice/src/cspice/daffpa_c.c b/ext/spice/src/cspice/daffpa_c.c deleted file mode 100644 index 053bed0e2f..0000000000 --- a/ext/spice/src/cspice/daffpa_c.c +++ /dev/null @@ -1,265 +0,0 @@ -/* - --Procedure daffpa_c ( DAF, find previous array ) - --Abstract - - Find the previous (backward) array in the current DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void daffpa_c ( SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - found O SPICETRUE if an array was found. - --Detailed_Input - - None. - --Detailed_Output - - found is SPICETRUE if an array was found, and is SPICEFALSE - if, when this routine is called, the current array is - the head of the array list. (Recall that the arrays in - a DAF may be viewed as a doubly linked list, with the - head being the first array in the file.) - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If this routine is called before a search is begun, the - error SPICE(DAFNOSEARCH) is signaled. - - 2) If the DAF to be searched has actually been closed, the error - will be diagnosed by routines called by this routine. - - 3) If the beginning of the array list has already been reached - when this routine is called, this routine will not change the - current array. found will be SPICEFALSE on output. - --Particulars - - The DAF search routines are: - - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 31-JUL-1999 (NJB) (WLT) (IMU) - --Index_Entries - - find previous daf array - --& -*/ - -{ /* Begin daffpa_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "daffpa_c" ); - - - daffpa_ ( ( logical * ) &fnd ); - - *found = fnd; - - - chkout_c ( "daffpa_c" ); - -} /* End daffpa_c */ diff --git a/ext/spice/src/cspice/dafgda.c b/ext/spice/src/cspice/dafgda.c deleted file mode 100644 index 3169ecfdbf..0000000000 --- a/ext/spice/src/cspice/dafgda.c +++ /dev/null @@ -1,244 +0,0 @@ -/* dafgda.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFGDA ( DAF, read data from address ) */ -/* Subroutine */ int dafgda_(integer *handle, integer *begin, integer *end, - doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer begr, begw, endr, endw, last, next; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno; - logical found; - integer first; - extern /* Subroutine */ int dafgdr_(integer *, integer *, integer *, - integer *, doublereal *, logical *), cleard_(integer *, - doublereal *), dafarw_(integer *, integer *, integer *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Read the double precision data bounded by two addresses within */ -/* a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF. */ -/* BEGIN, */ -/* END I Initial, final address within file. */ -/* DATA O Data contained between BEGIN and END. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF. */ - -/* BEGIN, */ -/* END are the initial and final addresses of a contiguous */ -/* set of double precision numbers within a DAF. */ -/* Presumably, these make up all or part of a particular */ -/* array. */ - -/* $ Detailed_Output */ - -/* DATA are the double precision data contained between */ -/* the specified addresses within the specified file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If BEGIN is zero or negative, the error SPICE(DAFNEGADDR) */ -/* is signalled. */ - -/* 2) If the BEGIN > END, the error SPICE(DAFBEGGTEND) */ -/* is signalled. */ - -/* 3) If HANDLE is invalid, routines in the call tree of DAFGDA */ -/* signal an appropriate error. */ - -/* 4) If the range of addresses covered between BEGIN and END */ -/* includes records that do not contain strictly double */ -/* precision data, then the values returned in DATA are */ -/* undefined. See the Restrictions section below for details. */ - -/* $ Particulars */ - -/* The principal reason that DAFs are so easy to use is that */ -/* the data in each DAF are considered to be one long contiguous */ -/* set of double precision numbers. You can grab data from anywhere */ -/* within a DAF without knowing (or caring) about the physical */ -/* records in which they are stored. */ - -/* This routine replaces DAFRDA as the principle mechanism for */ -/* reading the contents of DAF arrays. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of DAFGDA */ -/* to read data from an imaginary array. The array begins with a */ -/* directory containing 11 epochs. Each pair of epochs bounds */ -/* an interval, and each interval is covered by a set of eight */ -/* osculating elements. */ - -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ -/* BEGIN = IC(5) */ -/* END = IC(6) */ - -/* CALL DAFGDA ( HANDLE, BEGIN, BEGIN+10, EPOCHS ) */ - -/* DO I = 1, 10 */ -/* IF ( ET .GE. EPOCHS(I) .AND. ET .LE. EPOCHS(I+1) ) THEN */ -/* OFFSET = 11 + (I - 1) * 8 */ - -/* CALL DAFGDA ( HANDLE, OFFSET+1, OFFSET+8, ELEMENTS ) */ -/* RETURN */ -/* END IF */ -/* END DO */ - - -/* $ Restrictions */ - -/* 1) There are several types of records in a DAF. This routine */ -/* is only to be used to read double precision data bounded */ -/* between two DAF addresses. The range of addresses input */ -/* may not cross data and summary record boundaries. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-NOV-2001 (FST) */ - -/* -& */ -/* $ Index_Entries */ - -/* read data from daf address */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Bad addresses? */ - - if (*begin <= 0) { - chkin_("DAFGDA", (ftnlen)6); - setmsg_("Negative value for BEGIN address: #", (ftnlen)35); - errint_("#", begin, (ftnlen)1); - sigerr_("SPICE(DAFNEGADDR)", (ftnlen)17); - chkout_("DAFGDA", (ftnlen)6); - return 0; - } else if (*begin > *end) { - chkin_("DAFGDA", (ftnlen)6); - setmsg_("Beginning address (#) greater than ending address (#).", ( - ftnlen)54); - errint_("#", begin, (ftnlen)1); - errint_("#", end, (ftnlen)1); - sigerr_("SPICE(DAFBEGGTEND)", (ftnlen)18); - chkout_("DAFGDA", (ftnlen)6); - return 0; - } - -/* Convert raw addresses to record/word representations. */ - - dafarw_(begin, &begr, &begw); - dafarw_(end, &endr, &endw); - -/* Get as many records as needed. Return the last part of the */ -/* first record, the first part of the last record, and all of */ -/* every record in between. Any record not found is assumed to */ -/* be filled with zeros. */ - - next = 1; - i__1 = endr; - for (recno = begr; recno <= i__1; ++recno) { - if (begr == endr) { - first = begw; - last = endw; - } else if (recno == begr) { - first = begw; - last = 128; - } else if (recno == endr) { - first = 1; - last = endw; - } else { - first = 1; - last = 128; - } - dafgdr_(handle, &recno, &first, &last, &data[next - 1], &found); - if (! found) { - i__2 = last - first + 1; - cleard_(&i__2, &data[next - 1]); - } - next += last - first + 1; - } - return 0; -} /* dafgda_ */ - diff --git a/ext/spice/src/cspice/dafgda_c.c b/ext/spice/src/cspice/dafgda_c.c deleted file mode 100644 index ea13f93fa7..0000000000 --- a/ext/spice/src/cspice/dafgda_c.c +++ /dev/null @@ -1,193 +0,0 @@ -/* - --Procedure dafgda_c ( DAF, read data from address ) - --Abstract - - Read the double precision data bounded by two addresses within - a DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dafgda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ) -/* --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of a DAF. - begin, - end I Initial, final address within file. - data O Data contained between `begin' and `end'. - --Detailed_Input - - handle is the handle of a DAF. - - begin, - end are the initial and final addresses of a contiguous - set of double precision numbers within a DAF. - Presumably, these make up all or part of a particular - array. - - Note that CSPICE DAF addresses begin at 1 as in the - FORTRAN version of the SPICE Toolkit. - --Detailed_Output - - data are the double precision data contained between - the specified addresses within the specified file. - --Parameters - - None. - --Exceptions - - 1) If `begin' is zero or negative, the error SPICE(DAFNEGADDR) - is signaled. - - 2) If `begin' > `end', the error SPICE(DAFBEGGTEND) - is signaled. - - 3) If `handle' is invalid, routines in the call tree of dafgda_c - signal an appropriate error. - - 4) If the range of addresses covered between `begin' and `end' - includes records that do not contain strictly double - precision data, then the values returned in `data' are - undefined. See the Restrictions section below for details. - --Files - - None. - --Particulars - - The principal reason that DAFs are so easy to use is that - the data in each DAF are considered to be one long contiguous - set of double precision numbers. You can grab data from anywhere - within a DAF without knowing (or caring) about the physical - records in which they are stored. - - This routine replaces dafrda_c as the principal mechanism for - reading the contents of DAF arrays. - --Examples - - The following code fragment illustrates the use of dafgda_c to read - data from an array. The array begins with a directory containing 11 - epochs. Each pair of epochs bounds an interval, and each interval is - covered by a set of eight osculating elements. - - #include "SpiceUsr.h" - - . - . - . - - dafus_c ( sum, nd, ni, dc, ic ); - begin = ic[4]; - end = ic[5]; - - dafgda_c ( handle, begin, begin+10, epochs ); - - for ( i = 0; i < 10; i++ ) - { - if ( ( et > epochs[i] ) - && ( et < epochs[i+1] ) ) - { - offset = begin + 11 + (i - 1) * 8; - dafgda_c ( handle, offset+1, offset+8, elements ); - return; - } - } - - --Restrictions - - 1) There are several types of records in a DAF. This routine - is only to be used to read double precision data bounded - between two DAF addresses. The range of addresses input - may not cross data and summary record boundaries. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 23-JAN-2008 (EDW) - - Removed a spurious and unneeded "-Declarations" - tag. The tag's presence prevented the HTML API doc - script from parsing the function description. - - -CSPICE Version 1.0.0, 14-SEP-2006 (NJB) - --Index_Entries - - read data from daf address - --& -*/ - -{ /* Begin dafgda_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafgda_c" ); - - dafgda_ ( ( integer * ) &handle, - ( integer * ) &begin, - ( integer * ) &end, - ( doublereal * ) data ); - - chkout_c ( "dafgda_c" ); - -} /* End of dafgda_c */ - diff --git a/ext/spice/src/cspice/dafgn_c.c b/ext/spice/src/cspice/dafgn_c.c deleted file mode 100644 index e5f51fca14..0000000000 --- a/ext/spice/src/cspice/dafgn_c.c +++ /dev/null @@ -1,290 +0,0 @@ -/* - --Procedure dafgn_c ( DAF, get array name ) - --Abstract - - Return (get) the name for the current array in the current DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - void dafgn_c ( SpiceInt lenout, - SpiceChar * name ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - lenout I Length of array name string. - name O Name of current array. - --Detailed_Input - - lenout is the length of the name string, including room for - the null terminator. For a DAF with summary - parameters ND and NI, the maximum length of an array - name is - - (NI + 1) - NC = 8 * ( ND + -------- ) (Note that this is - 2 integer division.) - - Given NC, lenout should be set equal to NC+1. - --Detailed_Output - - name is the name for the current array (the array found by - the latest call to daffna_c or daffpa_c). - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If this routine is called when no search is in progress in the - the current DAF, the error SPICE(DAFNOSEARCH) is signalled. - - 2) If the DAF for which the "current" array's name is to be - returned has actually been closed, the error will be diagnosed - by routines called by this routine. - - 3) If no array is current in the current DAF, the error - SPICE(NOCURRENTARRAY) is signalled. There is no current - array when a search is started by dafbfs_c or dafbbs_c, but no - calls to daffna_c or dafbna_c have been made yet, or whenever - daffna_c or daffpa_c return the value SPICEFALSE in the found - argument. - - 4) The error SPICE(NULLPOINTER) is signaled if the input string - pointer is null. - - 5) The caller must pass a value indicating the length of the output - string. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) is signaled. - --Particulars - - The DAF search routines are: - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 01-AUG-1999 (NJB) (WLT) (IMU) - --Index_Entries - - get daf array name - --& -*/ - -{ /* Begin dafgn_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafgn_c" ); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "dafgn_c", name, lenout ); - - - dafgn_ ( ( char * ) name, - ( ftnlen ) lenout-1 ); - - /* - Convert the output string to C style. - */ - F2C_ConvertStr ( lenout, name ); - - - chkout_c ( "dafgn_c" ); - -} /* End dafgn_c */ diff --git a/ext/spice/src/cspice/dafgs_c.c b/ext/spice/src/cspice/dafgs_c.c deleted file mode 100644 index c8f7575028..0000000000 --- a/ext/spice/src/cspice/dafgs_c.c +++ /dev/null @@ -1,261 +0,0 @@ -/* - --Procedure dafgs_c ( DAF, get summary ) - --Abstract - - Return (get) the summary for the current array in the current - DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dafgs_c ( SpiceDouble sum[] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sum O Summary for current array. - --Detailed_Input - - None. - --Detailed_Output - - sum is the summary for the current array (the array - found by the latest call to daffna_c or daffpa_c). - Summaries are also called "segment descriptors." - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If this routine is called when no search is in progress in the - the current DAF, the error SPICE(DAFNOSEARCH) is signalled. - - 2) If the DAF for which the "current" array's summary is to be - returned has actually been closed, the error will be diagnosed - by routines called by this routine. - - 3) If no array is current in the current DAF, the error - SPICE(NOCURRENTARRAY) is signalled. There is no current - array when a search is started by dafbfs_c or dafbbs_c, but no - calls to daffna_c or dafbna_c have been made yet, or whenever - daffna_c or daffpa_c return the value SPICEFALSE in the found - argument. - --Particulars - - The DAF search routines are: - - - dafbfs_c Begin forward search. - daffna Find next array. - - dafbbs_c Begin backward search. - daffpa_c Find previous array. - - dafgs_c Get summary. - dafgn_c Get name. - dafgh_c Get handle. - - dafcs_c Continue search. - - The main function of these entry points is to allow the - contents of any DAF to be examined on an array-by-array - basis. - - Conceptually, the arrays in a DAF form a doubly linked list, - which can be searched in either of two directions: forward or - backward. It is possible to search multiple DAFs simultaneously. - - dafbfs_c (begin forward search) and daffna are used to search the - arrays in a DAF in forward order. In applications that search a - single DAF at a time, the normal usage is - - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffna_c ( &found ); - } - - - dafbbs_c (begin backward search) and daffpa_c are used to search the - arrays in a DAF in backward order. In applications that search - a single DAF at a time, the normal usage is - - dafbbs_c ( handle ); - daffpa_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - - daffpa_c ( &found ); - } - - - In applications that conduct multiple searches simultaneously, - the above usage must be modified to specify the handle of the - file to operate on, in any case where the file may not be the - last one specified by dafbfs_c or dafbbs_c. The routine dafcs_c - (DAF, continue search) is used for this purpose. Below, we - give an example of an interleaved search of two files specified - by the handles handl1 and handl2. The directions of searches - in different DAFs are independent; here we conduct a forward - search on one file and a backward search on the other. - Throughout, we use dafcs to specify which file to operate on, - before calling daffna_c, daffpa_c, dafgs_c, or dafgn_c. - - - dafbfs_c ( handl1 ); - dafbbs_c ( handl2 ); - - dafcs_c ( handl1 ); - daffna_c ( &found1 ); - - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - - while ( found1 || found2 ) - { - if ( found1 ) - { - dafcs_c ( handl1 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( &handl1 ); - daffna_c ( &found1 ); - } - - if ( found2 ) - { - dafcs_c ( handl2 ); - dafgs_c ( sum ); - dafgn_c ( name ); - . - . - dafcs_c ( handl2 ); - daffpa_c ( &found2 ); - } - } - - - At any time, the latest array found (whether by daffna_c or daffpa_c) - is regarded as the "current" array for the file in which the - array was found. The last DAF in which a search was started, - executed, or continued by any of dafbfs_c, dafbbs_c, daffna_c, - daffpa_c or dafcs_c is regarded as the "current" DAF. The summary - and name for the current array in the current DAF can be obtained - separately, as shown above, by calls to DAFGS (get summary) and - dafgn_c (get name). The handle of the current DAF can also be - obtained by calling dafgh_c (get handle). - - Once a search has been begun, it may be continued in either - direction. That is, daffpa_c may be used to back up during a - forward search, and daffna_c may be used to advance during a - backward search. - --Examples - - 1) See Particulars. - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 31-JUL-1999 (NJB) (WLT) (IMU) - --Index_Entries - - get daf summary - --& -*/ - -{ /* Begin dafgs_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafgs_c" ); - - - dafgs_ ( ( doublereal * ) sum ); - - - chkout_c ( "dafgs_c" ); - -} /* End dafgs_c */ diff --git a/ext/spice/src/cspice/dafgsr_c.c b/ext/spice/src/cspice/dafgsr_c.c deleted file mode 100644 index e077616d87..0000000000 --- a/ext/spice/src/cspice/dafgsr_c.c +++ /dev/null @@ -1,208 +0,0 @@ -/* - --Procedure dafgsr_c ( DAF, get summary/descriptor record ) - --Abstract - - Read a portion of the contents of a summary record in a DAF file. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void dafgsr_c ( SpiceInt handle, - SpiceInt recno, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data, - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of DAF. - recno I Record number. - begin I First word to read from record. - end I Last word to read from record. - data O Contents of record. - found O True if record is found. - --Detailed_Input - - handle is the handle associated with a DAF. - - recno is the record number of a particular double precision - record within the DAF, whose contents are to be read. - DAF record numbers start at 1. - - begin is the first word in the specified record to be - returned. For compatibility with SPICELIB, word - numbers range from 1 to 128. - - end is the final word in the specified record to be - returned. For compatibility with SPICELIB, word - numbers range from 1 to 128. - --Detailed_Output - - data contains the specified portion (from `begin' to `end', - inclusive) of the specified record. - - found is SPICETRUE when the specified record is found, and is - SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) Bad values for `begin' and `end' (begin < 1, end < begin, - etc.) are not signaled as errors, but result in the actions - implied by the pseudo-code: - - for ( j = 0, i = max(1,begin); i <= max(128,end); i++, j++ ) - { - data[j] = buffered_DAF_record[i]; - } - - 2) If `handle' is invalid, the error will be diagnosed by - routines called by this routine. - --Files - - The input handle must refer to a DAF that is open for read or write - access. - --Particulars - - dafgsr_c checks the DAF record buffer to see if the requested - record can be returned without actually reading it from - external storage. If not, it reads the record and stores - it in the buffer, typically removing another record from - the buffer as a result. - - Once in the buffer, the specified portion of the record is - returned. - --Examples - - The following code fragment illustrates one way that dafgsr_c - and dafwdr_ can be used to update part of a summary record. - If the record does not yet exist, we can assume that it is - filled with zeros. - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - SpiceInt size = 128; - SpiceInt recno; - SpiceInt handle; - . - . - . - dafgsr_c ( handle, recno, 1, 128, drec, &found ); - - if ( !found ) - { - cleard_ ( &size, drec ); - } - - for ( i = first; i <= last; i++ ) - { - drec[i] = new_value[i]; - } - - dafwdr_ ( &handle, &recno, drec ); - - Note that since only entire records may be written using dafwdr_, - the entire record needs to be read also. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - F.S. Turner (JPL) - --Version - - -CSPICE Version 1.0.0, 17-JUN-2009 (NJB) (FST) - --Index_Entries - - read daf summary record - --& -*/ - -{ /* Begin dafgsr_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "dafgsr_c" ); - - - dafgsr_ ( ( integer * ) &handle, - ( integer * ) &recno, - ( integer * ) &begin, - ( integer * ) &end, - ( doublereal * ) data, - ( logical * ) &fnd ); - - *found = (SpiceBoolean) fnd; - - - chkout_c ( "dafgsr_c" ); - -} /* End dafgsr_c */ diff --git a/ext/spice/src/cspice/dafopr_c.c b/ext/spice/src/cspice/dafopr_c.c deleted file mode 100644 index ab4c238162..0000000000 --- a/ext/spice/src/cspice/dafopr_c.c +++ /dev/null @@ -1,205 +0,0 @@ -/* - --Procedure dafopr_c ( DAF, open for read ) - --Abstract - - Open a DAF for subsequent read requests. - --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 - - DAF - --Keywords - - DAF - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void dafopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of DAF to be opened. - handle O Handle assigned to DAF. - --Detailed_Input - - fname is the file name of a DAF to be opened for read - access. - --Detailed_Output - - handle is the file handle associated with the file. This - handle is used to identify the file in subsequent - calls to other DAF routines. - --Parameters - - None. - --Files - - See argument fname. - --Exceptions - - 1) If the specified file has already been opened for read - access, the handle already associated with the file is - returned. - - 2) If the specified file has already been opened for write - access, the error SPICE(DAFRWCONFLICT) is signaled. - - 3) If the specified file has already been opened by a non-DAF - routine, the error SPICE(DAFIMPROPOPEN) is signaled. - - 4) If the specified file cannot be opened without exceeding - the maximum number of files, the error SPICE(DAFFTFULL) - is signaled. - - 5) If (for some reason) the file cannot be opened properly, - the error SPICE(DAFOPENFAIL) is signaled. - - 6) If the attempt to read the file's ID word fails, the error - SPICE(FILEREADFAILED) will be signaled. - - 7) If the specified file is not a DAF file, as indicated by the - file's ID word, the error SPICE(NOTADAFFILE) is signaled. - - 8) If no logical units are available, the error will be - signaled by routines called by this routine. - - 9) If the file does not exist, the error SPICE(FILEDOESNOTEXIST) - is signaled. - - 10) If the INQUIRE fails, the error SPICE(INQUIREFAILED) - is signaled. - - 11) If the file record cannot (for some reason) be read, - the error SPICE(DAFFRNOTFOUND) is signaled. - - 12) If the file name is blank, the error SPICE(BLANKFILENAME) - is signaled. - --Particulars - - Most DAFs require only read access. If you do not need to - change the contents of a file, you should open it with dafopr_c. - --Examples - - In the following code fragment, dafopr_c is used to open a file, - which is then searched for DAFs containing data for a particular - object. - - #include "SpiceUsr.h" - . - . - . - dafopr_c ( fname, &handle ); - dafbfs_c ( handle ); - - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafus_c ( sum, ND, NI, dc, ic ); - - if ( ic[0] == target_object ) - { - . - . - . - } - - daffna_c ( &found ); - } - - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - J.M. Lynch (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 01-AUG-1999 (NJB) (KRG) (JML) (WLT) (IMU) - --Index_Entries - - open daf for read - --& -*/ - -{ /* Begin dafopr_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafopr_c" ); - - /* - Check the file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "dafopr_c", fname ); - - - dafopr_ ( ( char * ) fname, - ( integer * ) handle, - ( ftnlen ) strlen(fname) ); - - - chkout_c ( "dafopr_c" ); - -} /* End dafopr_c */ diff --git a/ext/spice/src/cspice/dafopw_c.c b/ext/spice/src/cspice/dafopw_c.c deleted file mode 100644 index 0e7d7aaa7a..0000000000 --- a/ext/spice/src/cspice/dafopw_c.c +++ /dev/null @@ -1,308 +0,0 @@ -/* - --Procedure dafopw_c ( DAF, open for write ) - --Abstract - - Open a DAF for subsequent write requests. - --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 - - DAF - --Keywords - - DAF - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - void dafopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of DAF to be opened. - handle O Handle assigned to DAF. - --Detailed_Input - - fname is the name of a DAF to be opened with write - access. - --Detailed_Output - - handle is the file handle associated with the file. This - handle is used to identify the file in subsequent - calls to other DAF routines. - --Parameters - - None. - --Files - - See argument `fname'. - --Exceptions - - 1) If the specified file has already been opened, either by - the DAF routines or by other code, an error is signaled by - routines in the call tree of this routine. Note that this - response is not paralleled by dafopr_c, which allows you - to open a DAF for reading even if it is already open for - reading. - - 2) If the specified file cannot be opened without exceeding - the maximum number of files, the error SPICE(DAFFTFULL) - is signaled. - - 3) If the attempt to read the file's file record fails, the - error SPICE(FILEREADFAILED) will be signaled. - - 4) If the specified file is not a DAF file, an error is - signaled by routines in the call tree of this routine. - - 5) If no logical units are available, an error is - signaled by routines called by this routine. - - 6) If the file does not exist, the error SPICE(FILENOTFOUND) - is signaled by routines in the call tree of this routine. - - 7) If an I/O error occurs in the process of opening the file, - routines in the call tree of this routine signal an error. - - 8) If the file name is blank or otherwise inappropriate - routines in the call tree of this routine signal an error. - - 9) If the file was transferred improperly via FTP, routines - in the call tree of this routine signal an error. - - 10) If the file utilizes a non-native binary file format, an - error is signaled by routines in the call tree of this - routine. - - 11) The error SPICE(EMPTYSTRING) is signaled if the file namne - string does not contain at least one character, since the - string cannot be converted to a Fortran-style string - in this case. - - 12) The error SPICE(NULLPOINTER) is signaled if the input file - name string pointer is null. - --Particulars - - Most DAFs require only read access. If you do not need to - change the contents of a file, you should open it with dafopr_c. - Use dafopw_c when you need to - - -- change (update) one or more summaries, names, or - arrays within a file; or - - -- add new arrays to a file. - --Examples - - In the following code fragment, dafopw_c is used to open a - file, which is then searched for arrays containing data for - a particular object. The code for the object is then changed - (perhaps to reflect some new convention). - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - int main() - { - void dafopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - #define DSCSIZ 5 - #define FILSIZ 256 - #define LINSIZ 81 - #define ND 2 - #define NI 6 - - SpiceBoolean found; - - SpiceChar fname [ FILSIZ ]; - SpiceChar line [ LINSIZ ]; - - SpiceDouble dc [ ND ]; - SpiceDouble sum [ DSCSIZ ]; - - SpiceInt handle; - SpiceInt ic [ NI ]; - SpiceInt nd = ND; - SpiceInt new_code; - SpiceInt ni = NI; - SpiceInt old_code; - - - /. - Get the file name. - ./ - prompt_c ( "Enter name of existing DAF > ", FILSIZ, fname ); - - prompt_c ( "Enter ID code to change > ", LINSIZ, line ); - prsint_c ( line, &old_code ); - - prompt_c ( "Enter replacement code > ", LINSIZ, line ); - prsint_c ( line, &new_code ); - - /. - Open the existing DAF file for write access. - ./ - dafopw_c ( fname, &handle ); - - /. - Start a forward search through the file. - ./ - dafbfs_c ( handle ); - - /. - Find the first array (segment). - ./ - daffna_c ( &found ); - - while ( found ) - { - /. - Read and unpack the current DAF array summary - (aka segment descriptor) sum: - ./ - dafgs_c ( sum ); - dafus_c ( sum, nd, ni, dc, ic ); - - - if ( ic[0] == old_code ) - { - ic[0] = new_code; - - /. - Pack the summary array using the updated - integer array ic. Note this is an f2c'd - routine, so the array sizes are passed by - reference. - ./ - dafps_ ( &nd, &ni, dc, ic, sum ); - - /. - Replace the segment descriptor in the DAF. - ./ - dafrs_ ( sum ); - } - - /. - Find the next segment. - ./ - daffna_c ( &found ); - } - - /. - Close the DAF. - ./ - dafcls_c ( handle ); - - return ( 0 ); - } - - --Restrictions - - 1) Only files of the native binary file format may be opened - with this routine. - - 2) Files opened using this routine must be closed with dafcls_c. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - J.M. Lynch (JPL) - J.E. McLean (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 13-OCT-2004 (NJB) (KRG) (JML) (JEM) (WLT) (FST) (IMU) - --Index_Entries - - open existing daf for write - --& -*/ - -{ /* Begin dafopw_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "dafopw_c" ); - - /* - Check the file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "dafopw_c", fname ); - - /* - Let the f2c'd routine do the work. - */ - dafopw_ ( ( char * ) fname, - ( integer * ) handle, - ( ftnlen ) strlen(fname) ); - - - chkout_c ( "dafopw_c" ); - -} /* End dafopw_c */ - - diff --git a/ext/spice/src/cspice/dafps.c b/ext/spice/src/cspice/dafps.c deleted file mode 100644 index bf0a22adde..0000000000 --- a/ext/spice/src/cspice/dafps.c +++ /dev/null @@ -1,367 +0,0 @@ -/* dafps.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFPS ( DAF, pack summary ) */ -/* Subroutine */ int dafps_0_(int n__, integer *nd, integer *ni, doublereal * - dc, integer *ic, doublereal *sum) -{ - /* System generated locals */ - integer i__1, i__2; - static doublereal equiv_0[125]; - - /* Local variables */ - integer m, n; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - movei_(integer *, integer *, integer *); -#define dequiv (equiv_0) -#define iequiv ((integer *)equiv_0) - -/* $ Abstract */ - -/* Pack (assemble) an array summary from its double precision and */ -/* integer components. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ND I Number of double precision components. */ -/* NI I Number of integer components. */ -/* DC I Double precision components. */ -/* IC I Integer components. */ -/* SUM O Array summary. */ - -/* $ Detailed_Input */ - -/* ND is the number of double precision components in */ -/* the summary to be packed. */ - -/* NI is the number of integer components in the summary. */ - -/* DC are the double precision components of the summary. */ - -/* IC are the integer components of the summary. */ - -/* $ Detailed_Output */ - -/* SUM is an array summary containing the components in DC */ -/* and IC. This identifies the contents and location of */ -/* a single array within a DAF. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If ND is zero or negative, no DP components are stored. */ - -/* 2) If NI is zero or negative, no integer components are stored. */ - -/* 3) If the total size of the summary is greater than 125 double */ -/* precision words, some components may not be stored. */ - -/* $ Particulars */ - -/* The components of array summaries are packed into double */ -/* precision arrays for reasons outlined in [1]. Two routines, */ -/* DAFPS (pack summary) and DAFUS (unpack summary) are provided */ -/* for packing and unpacking summaries. */ - -/* The total size of the summary is */ - -/* (NI - 1) */ -/* ND + -------- + 1 */ -/* 2 */ - -/* double precision words (where ND, NI are nonnegative). */ - -/* $ Examples */ - -/* Maybe later. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* pack daf summary */ - -/* -& */ - -/* Local variables */ - - -/* Equivalences */ - - -/* Here's the deal: the DP components always precede the integer */ -/* components, avoiding alignment problems. The DP components can */ -/* be stored directly. */ - - switch(n__) { - case 1: goto L_dafus; - } - -/* Computing MIN */ - i__1 = 125, i__2 = max(0,*nd); - n = min(i__1,i__2); - moved_(dc, &n, sum); - -/* The integer components must detour through an equivalence. */ - -/* Computing MIN */ - i__1 = 250 - (n << 1), i__2 = max(0,*ni); - m = min(i__1,i__2); - movei_(ic, &m, iequiv); - i__1 = (m - 1) / 2 + 1; - moved_(dequiv, &i__1, &sum[n]); - return 0; -/* $Procedure DAFUS ( DAF, unpack summary ) */ - -L_dafus: -/* $ Abstract */ - -/* Unpack an array summary into its double precision and integer */ -/* components. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ - -/* DOUBLE PRECISION SUM ( * ) */ -/* INTEGER ND */ -/* INTEGER NI */ -/* DOUBLE PRECISION DC ( * ) */ -/* INTEGER IC ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SUM I Array summary. */ -/* ND I Number of double precision components. */ -/* NI I Number of integer components. */ -/* DC O Double precision components. */ -/* IC O Integer components. */ - -/* $ Detailed_Input */ - -/* SUM is an array summary. This identifies the contents and */ -/* location of a single array within a DAF. */ - -/* ND is the number of double precision components in */ -/* the summary. */ - -/* NI is the number of integer components in the summary. */ - -/* $ Detailed_Output */ - -/* DC are the double precision components of the summary. */ - -/* IC are the integer components of the summary. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If ND is zero or negative, no double precision components */ -/* are returned. */ - -/* 2) If NI is zero or negative, no integer components are returned. */ - -/* 3) If the total size of the summary is greater than 125 double */ -/* precision words, some components may not be returned. */ - -/* $ Particulars */ - -/* The components of array summaries are packed into double */ -/* precision arrays for reasons outlined in [1]. Two routines, */ -/* DAFPS (pack summary) and DAFUS (unpack summary) are provided */ -/* for packing and unpacking summaries. */ - -/* The total size of the summary is */ - -/* (NI - 1) */ -/* ND + -------- + 1 */ -/* 2 */ - -/* double precision words (where ND, NI are nonnegative). */ - -/* $ Examples */ - -/* Maybe later. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* unpack daf summary */ - -/* -& */ - -/* Just undo whatever DAFPS did. */ - -/* Computing MIN */ - i__1 = 125, i__2 = max(0,*nd); - n = min(i__1,i__2); - moved_(sum, &n, dc); -/* Computing MIN */ - i__1 = 250 - (n << 1), i__2 = max(0,*ni); - m = min(i__1,i__2); - i__1 = (m - 1) / 2 + 1; - moved_(&sum[n], &i__1, dequiv); - movei_(iequiv, &m, ic); - return 0; -} /* dafps_ */ - -#undef iequiv -#undef dequiv - - -/* Subroutine */ int dafps_(integer *nd, integer *ni, doublereal *dc, integer - *ic, doublereal *sum) -{ - return dafps_0_(0, nd, ni, dc, ic, sum); - } - -/* Subroutine */ int dafus_(doublereal *sum, integer *nd, integer *ni, - doublereal *dc, integer *ic) -{ - return dafps_0_(1, nd, ni, dc, ic, sum); - } - diff --git a/ext/spice/src/cspice/dafps_c.c b/ext/spice/src/cspice/dafps_c.c deleted file mode 100644 index aa232ed0f9..0000000000 --- a/ext/spice/src/cspice/dafps_c.c +++ /dev/null @@ -1,243 +0,0 @@ -/* - --Procedure dafps_c ( DAF, pack summary ) - --Abstract - - Pack (assemble) an array summary from its double precision and - integer components. - --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 - - DAF - --Keywords - - CONVERSION - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZim.h" - #undef dafps_c - - - void dafps_c ( SpiceInt nd, - SpiceInt ni, - ConstSpiceDouble * dc, - ConstSpiceInt * ic, - SpiceDouble * sum ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - nd I Number of double precision components. - ni I Number of integer components. - dc I Double precision components. - ic I Integer components. - sum O Array summary. - --Detailed_Input - - nd is the number of double precision components in - the summary to be packed. - - ni is the number of integer components in the summary. - - dc are the double precision components of the summary. - - ic are the integer components of the summary. - --Detailed_Output - - sum is an array summary containing the components in `dc' - and `ic'. This identifies the contents and location of - a single array within a DAF. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - 1) If ND is zero or negative, no DP components are stored. - - 2) If NI is zero or negative, no integer components are stored. - - 3) If the total size of the summary is greater than 125 double - precision words, some components may not be stored. - --Particulars - - The components of array summaries are packed into double - precision arrays for reasons outlined in [1]. Two routines, - dafps_c (pack summary) and dafus_c (unpack summary) are provided - for packing and unpacking summaries. - - The total size of the summary is - - (NI - 1) - ND + -------- + 1 - 2 - - double precision words (where ND, NI are nonnegative). - --Examples - - - 1) Replace the body ID code -999 with -1999 in every descriptor - of an SPK file. - - - #include - - int main ( int argc, char **argv ) - { - #define ND 2 - #define NI 6 - #define DSCSIZ 5 - #define NEWCODE ( -1999 ) - #define OLDCODE ( -999 ) - - SpiceBoolean found; - - SpiceInt handle; - SpiceInt ic [ NI ]; - - SpiceDouble dc [ ND ]; - SpiceDouble sum [ DSCSIZ ]; - - /. - Open for writing the SPK file specified on the command line. - ./ - dafopw_c ( argv[1], &handle ); - - /. - Search the file in forward order. - ./ - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - /. - Fetch and unpack the descriptor (aka summary) - of the current segment. - ./ - dafgs_c ( sum ); - dafus_c ( sum, ND, NI, dc, ic ); - - /. - Replace ID codes if necessary. - ./ - if ( ic[0] == OLDCODE ) - { - ic[0] = NEWCODE; - } - if ( ic[1] == OLDCODE ) - { - ic[1] = NEWCODE; - } - - /. - Re-pack the descriptor; replace the descriptor - in the file. - ./ - dafps_c ( ND, NI, dc, ic, sum ); - - dafrs_c ( sum ); - - /. - Find the next segment. - ./ - daffna_c ( &found ); - } - - /. - Close the file. - ./ - dafcls_c ( handle ); - - return ( 0 ); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 23-NOV-2004 (NJB) - --Index_Entries - - pack daf summary - --& -*/ - -{ /* Begin dafps_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafps_c" ); - - - dafps_ ( ( integer * ) &nd, - ( integer * ) &ni, - ( doublereal * ) dc, - ( integer * ) ic, - ( doublereal * ) sum ); - - - chkout_c ( "dafps_c" ); - -} /* End dafps_c */ diff --git a/ext/spice/src/cspice/dafra.c b/ext/spice/src/cspice/dafra.c deleted file mode 100644 index c03069254b..0000000000 --- a/ext/spice/src/cspice/dafra.c +++ /dev/null @@ -1,365 +0,0 @@ -/* dafra.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFRA ( DAF, Re-order arrays ) */ -/* Subroutine */ int dafra_(integer *handle, integer *iorder, integer *n) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer hold, i__; - extern /* Subroutine */ int dafgn_(char *, ftnlen), dafgs_(doublereal *), - dafrn_(char *, ftnlen), chkin_(char *, ftnlen); - char holdn[1000]; - extern /* Subroutine */ int dafws_(doublereal *); - integer index; - doublereal holds[128]; - logical found; - char tempn[1000]; - integer total; - doublereal temps[128]; - integer start; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical isordv_(integer *, integer *), return_(void); - -/* $ Abstract */ - -/* Re-order the arrays in a DAF according to a given order */ -/* vector. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ -/* SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* IORDER I Order vector. */ -/* N I Dimension of IORDER. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF that has been opened for */ -/* write access. Use DAFOPW, for example, to open */ -/* an existing file and get its handle. */ - -/* IORDER is the order vector to be used to re-order the */ -/* arrays stored in the DAF specified by HANDLE. */ - -/* An integer order vector is an array of length */ -/* N whose elements are the integers 1 through N. */ - -/* The first element of IORDER is the index of the */ -/* first array in the re-ordered file, and so on. */ - -/* N is the number of elements in the order vector. */ -/* This may be less than the number of arrays in */ -/* the file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* DAFRA does not actually move the elements of the double */ -/* precision arrays; it works by rearranging the contents */ -/* of the summary and name records in the file. The result */ -/* is that the search routines (BFS, FNA, BBS, FPA) will */ -/* return the arrays in the indicated order. */ - -/* After re-ordering, array IORDER(1) of the input file is the */ -/* first array of the output file, array IORDER(2) of the input */ -/* file is the second array of the output file, and so on. */ - -/* The order vector used by DAFRA is typically created for */ -/* a related array by one of the ORDER routines, as shown in */ -/* the example below. */ - -/* $ Examples */ - -/* The following code fragment sorts the arrays in a DAF by name. */ - -/* C */ -/* C Collect the names of the arrays in the file. */ -/* C */ -/* CALL DAFOPW ( FILE, HANDLE ) */ - -/* N = 0 */ -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* N = N + 1 */ -/* CALL DAFGN ( NAMES(I) ) */ -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* C */ -/* C Sort the names. */ -/* C */ -/* CALL ORDERC ( NAMES, N, IORDER ) */ - -/* C */ -/* C Re-order the arrays. */ -/* C */ -/* CALL DARFA ( HANDLE, IORDER, N ) */ -/* CALL DAFCLS ( HANDLE ) */ - -/* Afterward, a forward search like the one shown below */ - -/* CALL DAFBFS ( HANDLE ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGN ( NAME ) */ -/* WRITE (*,*) NAME */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* produces an ordered list of the names in the sorted file. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If IORDER is not an order vector (that is, if it does */ -/* not contain every integer between 1 and N), the error */ -/* SPICE(DISORDER) is signalled. */ - -/* 2) If N is greater than the number of arrays in the file, */ -/* the error SPICE(DISARRAY) is signalled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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, 28-MAR-1991 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* reorder daf arrays */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRA", (ftnlen)5); - } - -/* If the order vector has fewer than two elements, don't bother. */ - - if (*n < 2) { - chkout_("DAFRA", (ftnlen)5); - return 0; - } - -/* If IORDER is not an order vector, complain. */ - - if (! isordv_(iorder, n)) { - setmsg_("Sorry, IORDER is not an order vector.", (ftnlen)37); - sigerr_("SPICE(DISORDER)", (ftnlen)15); - chkout_("DAFRA", (ftnlen)5); - return 0; - } - -/* If the number of arrays to be moved exceeds the number of */ -/* arrays in the file, complain. */ - - total = 0; - dafbfs_(handle); - daffna_(&found); - while(found && ! failed_()) { - ++total; - daffna_(&found); - } - if (failed_()) { - chkout_("DAFRA", (ftnlen)5); - return 0; - } else if (total < *n) { - setmsg_("N (#) exceeds number of arrays (#).", (ftnlen)35); - errint_("#", n, (ftnlen)1); - errint_("#", &total, (ftnlen)1); - sigerr_("SPICE(DISARRAY)", (ftnlen)15); - chkout_("DAFRA", (ftnlen)5); - return 0; - } - -/* Not surprisingly, this routine is patterned closely after the */ -/* (original) REORDx routines in SPICELIB. The only differences */ -/* are that */ - -/* 1) This routine is not error free---it checks to make */ -/* sure that IORDER is in fact an order vector, and that */ -/* every element in IORDER refers to an existing array. */ - -/* 2) Instead of moving elements of an array in and out of */ -/* a temporary location, it moves summaries and names. */ -/* This means that two sets of temporary storage locations */ -/* are needed: one to hold the summary and name of the */ -/* guy who began the current cycle; and one to hold the guy */ -/* being moved from location HOLD to location INDEX. */ - - start = 1; - while(start < *n && ! failed_()) { - -/* Start the cycle. One guy (pair of summary and name record) */ -/* has to sit out (in HOLDS and HOLDN) until the end of the cycle */ -/* is reached. */ - - index = start; - hold = iorder[index - 1]; - dafbfs_(handle); - i__1 = index; - for (i__ = 1; i__ <= i__1; ++i__) { - daffna_(&found); - } - dafgs_(holds); - dafgn_(holdn, (ftnlen)1000); - -/* Move guys from HOLD to INDEX; then update HOLD (to point */ -/* to the next guy to be moved) and INDEX (to point at the */ -/* space just vacated). */ - -/* Keep going until HOLD points to the first guy moved during */ -/* the current cycle. This ends the cycle. */ - - while(hold != start) { - -/* Get the guy in position HOLD. */ - - dafbfs_(handle); - i__1 = hold; - for (i__ = 1; i__ <= i__1; ++i__) { - daffna_(&found); - } - dafgs_(temps); - dafgn_(tempn, (ftnlen)1000); - -/* Move him to position INDEX. (Note that DAFWS is used to */ -/* update the summary instead of DAFRS, because the addresses */ -/* are actually being changed.) */ - - dafbfs_(handle); - i__1 = index; - for (i__ = 1; i__ <= i__1; ++i__) { - daffna_(&found); - } - dafws_(temps); - dafrn_(tempn, (ftnlen)1000); - -/* Update HOLD and INDEX. */ - - index = hold; - hold = iorder[hold - 1]; - iorder[index - 1] = -iorder[index - 1]; - } - -/* The last element in the cycle is restored from TEMP. */ - - dafbfs_(handle); - i__1 = index; - for (i__ = 1; i__ <= i__1; ++i__) { - daffna_(&found); - } - dafws_(holds); - dafrn_(holdn, (ftnlen)1000); - iorder[hold - 1] = -iorder[hold - 1]; - -/* Begin the next cycle at the next element in the order */ -/* vector with a positive sign. (That is, the next one */ -/* that hasn't been moved.) */ - - while(iorder[start - 1] < 0 && start < *n) { - ++start; - } - } - -/* Restore the original signs of the elements of the order */ -/* vector, for the next go around. */ - - i__1 = *n; - for (index = 1; index <= i__1; ++index) { - iorder[index - 1] = (i__2 = iorder[index - 1], abs(i__2)); - } - chkout_("DAFRA", (ftnlen)5); - return 0; -} /* dafra_ */ - diff --git a/ext/spice/src/cspice/dafrcr.c b/ext/spice/src/cspice/dafrcr.c deleted file mode 100644 index 7a478974cf..0000000000 --- a/ext/spice/src/cspice/dafrcr.c +++ /dev/null @@ -1,256 +0,0 @@ -/* dafrcr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure DAFRCR ( DAF, read character record ) */ -/* Subroutine */ int dafrcr_(integer *handle, integer *recno, char *crec, - ftnlen crec_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_rdue(cilist *), do_uio(integer *, char *, - ftnlen), e_rdue(void); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen), chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___3 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Read the contents of a character record from a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* RECNO I Record number of character record. */ -/* CREC O Character record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a character record within */ -/* the file. */ - -/* $ Detailed_Output */ - -/* CREC contains the first 1000 characters of the specified */ -/* record from the specified file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the declared length of CREC is not 1000 characters, */ -/* the error SPICE(DAFBADRECLEN) is signalled. */ - -/* 2) If the specified record cannot (for some reason) be read, */ -/* the error SPICE(DAFCRNOTFOUND) is signalled. */ - -/* $ Particulars */ - -/* Unlike double precision records, character records are */ -/* not buffered. Also, while failing to find a specific double */ -/* precision record is indicated through the calling sequence, */ -/* failing to find a character record results in an error. */ - -/* $ Examples */ - -/* In the following example, matching summary and name records are */ -/* read from a DAF: */ - -/* CALL DAFGDR ( HANDLE, NEXT, DREC, FOUND ) */ -/* CALL DAFRCR ( HANDLE, NEXT+1, CREC ) */ - -/* Note that a character record always immediately follows a summary */ -/* record. */ - -/* $ Restrictions */ - -/* 1) This routine is only used to read records on environments */ -/* whose characters are a single byte in size. Updates */ -/* to this routine and routines in its call tree may be */ -/* required to properly handle other cases. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to make proper use of the new */ -/* handle manager functionality installed underneath */ -/* DAF. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read daf character record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* This routine now makes use of the handle manager */ -/* code. A call to DAFSIH was inserted just after */ -/* the standard SPICE error handling code at the */ -/* head of the module. This was done to insure that */ -/* the caller is referring to a legitmately loaded */ -/* DAF. The penalty for performing this check is */ -/* a binary search on the number of loaded files, */ -/* which should be small compared to the actual READ */ -/* performed below. */ - -/* The call to DAFHLU has been replaced with ZZDDHHLU, */ -/* since calls to DAFHLU locks handles to their logical */ -/* units. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRCR", (ftnlen)6); - } - -/* Check to be sure that HANDLE is attached to a file that is open */ -/* with read access. If the call fails, check out and return. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFRCR", (ftnlen)6); - return 0; - } - -/* Now make certain that the string to receive the contents of */ -/* the character record is the appropriate length. */ - - if (i_len(crec, crec_len) != 1000) { - setmsg_("Expected length of character record is 1000. Passed string " - "has length #", (ftnlen)71); - i__1 = i_len(crec, crec_len); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(DAFBADCRECLEN)", (ftnlen)20); - } else { - -/* Retrieve a logical unit for this handle. This has the */ -/* side-effect of locking this UNIT to HANDLE. */ - - zzddhhlu_(handle, "DAF", &c_false, &unit, (ftnlen)3); - if (failed_()) { - chkout_("DAFRCR", (ftnlen)6); - return 0; - } - io___3.ciunit = unit; - io___3.cirec = *recno; - iostat = s_rdue(&io___3); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, crec, crec_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Could not read record #. IOSTAT was #.", (ftnlen)38); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFCRNOTFOUND)", (ftnlen)20); - } - } - chkout_("DAFRCR", (ftnlen)6); - return 0; -} /* dafrcr_ */ - diff --git a/ext/spice/src/cspice/dafrda.c b/ext/spice/src/cspice/dafrda.c deleted file mode 100644 index c0bcc6bae4..0000000000 --- a/ext/spice/src/cspice/dafrda.c +++ /dev/null @@ -1,318 +0,0 @@ -/* dafrda.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFRDA ( DAF, read data from address ) */ -/* Subroutine */ int dafrda_(integer *handle, integer *begin, integer *end, - doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer begr, begw, endr, endw, last, next; - extern /* Subroutine */ int zzddhisn_(integer *, logical *, logical *), - chkin_(char *, ftnlen); - integer recno; - logical found; - integer first; - extern /* Subroutine */ int cleard_(integer *, doublereal *), dafrdr_( - integer *, integer *, integer *, integer *, doublereal *, logical - *), dafarw_(integer *, integer *, integer *), errhan_(char *, - integer *, ftnlen); - logical native; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Read the double precision data bounded by two addresses within */ -/* a DAF. */ - -/* Deprecated: This routine has been superseded by DAFGDA and */ -/* DAFGSR. This routine is supported for purposes of backward */ -/* compatibility only. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF. */ -/* BEGIN, */ -/* END I Initial, final address within file. */ -/* DATA O Data contained between BEGIN and END. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF. */ - -/* BEGIN, */ -/* END are the initial and final addresses of a contiguous */ -/* set of double precision numbers within a DAF. */ -/* Presumably, these make up all or part of a particular */ -/* array. */ - -/* $ Detailed_Output */ - -/* DATA are the double precision data contained between */ -/* the specified addresses within the specified file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If BEGIN is zero or negative, the error SPICE(DAFNEGADDR) */ -/* is signalled. */ - -/* 2) If the BEGIN > END, the error SPICE(DAFBEGGTEND) */ -/* is signalled. */ - -/* 3) If the file associated with HANDLE is not of the native */ -/* binary file format this routine signals the error */ -/* SPICE(UNSUPPORTEDBFF). */ - -/* 4) If HANDLE is invalid, routines in the call tree of DAFRDA */ -/* signal an appropriate error. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The principal reason that DAFs are so easy to use is that */ -/* the data in each DAF are considered to be one long contiguous */ -/* set of double precision numbers. You can grab data from anywhere */ -/* within a DAF without knowing (or caring) about the physical */ -/* records in which they are stored. */ - -/* This routine has been made obsolete by the routines DAFGDA and */ -/* DAFGSR. This routine is supported for reasons of backward */ -/* compatibility only. New software development should utilize */ -/* DAFGDA or DAFGSR. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of DAFRDA */ -/* to read data from an imaginary array. The array begins with a */ -/* directory containing 11 epochs. Each pair of epochs bounds */ -/* an interval, and each interval is covered by a set of eight */ -/* osculating elements. */ - -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ -/* BEGIN = IC(5) */ -/* END = IC(6) */ - -/* CALL DAFRDA ( HANDLE, BEGIN, BEGIN+10, EPOCHS ) */ - -/* DO I = 1, 10 */ -/* IF ( ET .GE. EPOCHS(I) .AND. ET .LE. EPOCHS(I+1) ) THEN */ -/* OFFSET = IC(5) + 11 + (I - 1) * 8 */ - -/* CALL DAFRDA ( HANDLE, OFFSET+1, OFFSET+8, ELEMENTS ) */ -/* RETURN */ -/* END IF */ -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.2, 18-MAY-2010 (BVS) */ - -/* Index line now states that this routine is deprecated. */ - -/* - SPICELIB Version 2.0.1, 27-OCT-2003 (NJB) */ - -/* The header now states that this routine is deprecated. */ -/* The Exceptions header section has been extended. */ -/* Minor additional header updates were made. */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Added SPICE(UNSUPPORTEDBFF) exception to the routine. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED read data from daf address */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* The exception SPICE(UNSUPPORTEDBFF) was added to guarantee */ -/* this routine's functionality remains unchanged as a result */ -/* of the updates to the underlying DAF software's utilization of */ -/* the handle manager. In versions of the Toolkit prior to this, */ -/* all DAFs loaded were of the native binary file format. */ -/* While rather unlikely, this routine could be used to read */ -/* the contents of summary records in addition to the usual */ -/* data records. The non-native to native translation process */ -/* for these two different types of records in general are not */ -/* the same. Rather than attempt to interpret the caller's */ -/* intent, this routine is deprecated and restricted to */ -/* functioning only on DAFs of the native binary file format. */ - -/* - Beta Version 1.1.0, 1-NOV-1989 (RET) */ - -/* DAFRDA now only checks in and checks out if one of the two */ -/* possible exceptions occurs. The purpose of this change was to */ -/* help speed up a routine that gets called constantly by higher */ -/* level DAF routines. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Check to see if HANDLE is associated with a DAF of the native */ -/* binary file format. */ - - zzddhisn_(handle, &native, &found); - -/* If the HANDLE was located, then check whether the binary file */ -/* format is native. Otherwise, defer diagnosing the missing */ -/* handle to DAFRDR. */ - - if (found && ! native) { - chkin_("DAFRDA", (ftnlen)6); - setmsg_("The binary file format for file '#' is not native. This rou" - "tine operates only on files of the native format.", (ftnlen) - 108); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(UNSUPPORTEDBFF)", (ftnlen)21); - chkout_("DAFRDA", (ftnlen)6); - return 0; - } - -/* Bad addresses? */ - - if (*begin <= 0) { - chkin_("DAFRDA", (ftnlen)6); - setmsg_("Negative value for BEGIN address: #", (ftnlen)35); - errint_("#", begin, (ftnlen)1); - sigerr_("SPICE(DAFNEGADDR)", (ftnlen)17); - chkout_("DAFRDA", (ftnlen)6); - return 0; - } else if (*begin > *end) { - chkin_("DAFRDA", (ftnlen)6); - setmsg_("Beginning address (#) greater than ending address (#).", ( - ftnlen)54); - errint_("#", begin, (ftnlen)1); - errint_("#", end, (ftnlen)1); - sigerr_("SPICE(DAFBEGGTEND)", (ftnlen)18); - chkout_("DAFRDA", (ftnlen)6); - return 0; - } - -/* Convert raw addresses to record/word representations. */ - - dafarw_(begin, &begr, &begw); - dafarw_(end, &endr, &endw); - -/* Get as many records as needed. Return the last part of the */ -/* first record, the first part of the last record, and all of */ -/* every record in between. Any record not found is assumed to */ -/* be filled with zeros. */ - - next = 1; - i__1 = endr; - for (recno = begr; recno <= i__1; ++recno) { - if (begr == endr) { - first = begw; - last = endw; - } else if (recno == begr) { - first = begw; - last = 128; - } else if (recno == endr) { - first = 1; - last = endw; - } else { - first = 1; - last = 128; - } - dafrdr_(handle, &recno, &first, &last, &data[next - 1], &found); - if (! found) { - i__2 = last - first + 1; - cleard_(&i__2, &data[next - 1]); - } - next += last - first + 1; - } - return 0; -} /* dafrda_ */ - diff --git a/ext/spice/src/cspice/dafrda_c.c b/ext/spice/src/cspice/dafrda_c.c deleted file mode 100644 index 4d1b2cce77..0000000000 --- a/ext/spice/src/cspice/dafrda_c.c +++ /dev/null @@ -1,211 +0,0 @@ -/* - --Procedure dafrda_c ( DAF, read data from address ) - --Abstract - - Read the double precision data bounded by two addresses within - a DAF. - - Deprecated: This routine has been superseded by dafgda_c and - dafgsr_c. This routine is supported for purposes of backward - compatibility only. - --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 - - DAF - --Keywords - - FILES - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dafrda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ) -/* --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of a DAF. - begin, - end I Initial, final address within file. - data O Data contained between begin and end. - --Detailed_Input - - handle is the handle of a DAF. - - begin, - end are the initial and final addresses of a contiguous - set of double precision numbers within a DAF. - Presumably, these make up all or part of a particular - array. - - Note that CSPICE DAF addresses begin at 1 as in the - FORTRAN version of the SPICE Toolkit. - --Detailed_Output - - data are the double precision data contained between - the specified addresses within the specified file. - --Parameters - - None. - --Exceptions - - 1) If `begin' is zero or negative, the error SPICE(DAFNEGADDR) - is signaled. - - 2) If the begin > end, the error SPICE(DAFBEGGTEND) - is signaled. - - 3) If the file associated with `handle' is not of the native - binary file format this routine signals the error - SPICE(UNSUPPORTEDBFF). - - 4) If `handle' is invalid, routines in the call tree of dafrda_c - signal an appropriate error. - --Files - - None. - --Particulars - - The principal reason that DAFs are so easy to use is that - the data in each DAF are considered to be one long contiguous - set of double precision numbers. You can grab data from anywhere - within a DAF without knowing (or caring) about the physical - records in which they are stored. - - This routine has been made obsolete by the routines dafgda_c and - dafgsr_c. This routine is supported for reasons of backward - compatibility only. New software development should utilize - dafgda_c or dafgsr_c. - --Examples - - The following code fragment illustrates the use of dafrda_c - to read data from an imaginary array. The array begins with a - directory containing 11 epochs. Each pair of epochs bounds - an interval, and each interval is covered by a set of eight - osculating elements. - - #include "SpiceUsr.h" - - . - . - . - - dafus_c ( sum, nd, ni, dc, ic ); - begin = ic[4]; - end = ic[5]; - - dafrda_c ( handle, begin, begin+10, epochs ); - - for ( i = 0; i < 10; i++ ) - { - if ( ( et > epochs[i] ) - && ( et < epochs[i+1] ) ) - { - offset = ic[4] + 11 + (i - 1) * 8; - dafrda_c ( handle, offset+1, offset+8, elements ); - return; - } - } - - --Restrictions - - 1) This routine is deprecated. See the routines dafgda_c and - dafgsr_c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.3, 19-MAY-2010 (BVS) - - Index line now states that this routine is deprecated. - - -CSPICE Version 1.0.2, 23-JAN-2008 (EDW) - - Removed a spurious and unneeded "-Declarations" - tag. The tag's presence prevented the HTML API doc - script from parsing the function description. - - -CSPICE Version 1.0.1, 27-OCT-2003 (NJB) (FST) - - The header now states that this routine is deprecated. - The Exceptions header section has been extended. - Minor additional header updates were made. - - -CSPICE Version 1.0.0, 14-DEC-1999 (NJB) (RET) (IMU) (WLT) - --Index_Entries - - DEPRECATED read data from daf address - --& -*/ - -{ /* Begin dafrda_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafrda_c" ); - - dafrda_ ( ( integer * ) &handle, - ( integer * ) &begin, - ( integer * ) &end, - ( doublereal * ) data ); - - chkout_c ( "dafrda_c" ); - -} /* End of dafrda_c */ - diff --git a/ext/spice/src/cspice/dafrfr.c b/ext/spice/src/cspice/dafrfr.c deleted file mode 100644 index e968eee8eb..0000000000 --- a/ext/spice/src/cspice/dafrfr.c +++ /dev/null @@ -1,280 +0,0 @@ -/* dafrfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFRFR ( DAF, read file record ) */ -/* Subroutine */ int dafrfr_(integer *handle, integer *nd, integer *ni, char * - ifname, integer *fward, integer *bward, integer *free, ftnlen - ifname_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzdafgfr_(integer *, char *, integer *, - integer *, char *, integer *, integer *, integer *, logical *, - ftnlen, ftnlen), chkin_(char *, ftnlen); - logical found; - extern logical failed_(void); - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char idword[8]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Read the contents of the file record of a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open DAF file. */ -/* ND O Number of double precision components in summaries. */ -/* NI O Number of integer components in summaries. */ -/* IFNAME O Internal file name. */ -/* FWARD O Forward list pointer. */ -/* BWARD O Backward list pointer. */ -/* FREE O Free address pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle assigned to a DAF file opened for */ -/* reading. */ - -/* $ Detailed_Output */ - -/* ND, */ -/* NI are the numbers of double precision and integer */ -/* components, respectively, in each array summary in */ -/* the specified file. */ - -/* IFNAME is the internal file name stored in the first */ -/* (or file) record of the specified file. */ - -/* FWARD is the forward list pointer. This points to the */ -/* first summary record in the file. (Records between */ -/* the first record and the first summary record are */ -/* reserved when the file is created, and are invisible */ -/* to DAF routines.) */ - -/* BWARD is the backward list pointer. This points */ -/* to the final summary record in the file. */ - -/* FREE is the free address pointer. This contains the */ -/* first free address in the file. (That is, the */ -/* initial address of the next array to be added */ -/* to the file.) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the handle passed to this routine is not the handle of an */ -/* open DAF file, the error will be signaled by a routine called */ -/* by this routine. */ - -/* 2) If the specified DAF file is not open for read access, the */ -/* error will be diagnosed by a routine called by this routine. */ - -/* 3) If the specified record cannot (for some reason) be read, */ -/* the error SPICE(DAFFRNOTFOUND) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The file record of a DAF is the only record that contains */ -/* any global information about the file. This record is created */ -/* when the file is created, and is updated only when new arrays */ -/* are added. */ - -/* Like character records, file records are not buffered. */ - -/* $ Examples */ - -/* In the following example, the value of the forward list */ -/* pointer is examined in order to determine the number of */ -/* reserved records in the DAF. These records are then read */ -/* and the contents printed to the screen. */ - -/* CALL DAFRFR ( HANDLE, ND, NI, IFNAME, FWARD, BWARD, FREE ) */ -/* CALL DAFHLU ( HANDLE, UNIT ) */ - -/* DO I = 2, FWARD - 1 */ -/* READ (UNIT,REC=I) PRIVATE(1:1000) */ -/* WRITE (*,*) PRIVATE(1:1000) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.0, 30-DEC-2009 (EDW) */ - -/* Expanded DAFFRNOTFOUND error message to identify the file */ -/* handle corresponding to the error condition. */ - -/* Reordered header sections to conform to SPICE format. */ -/* Merged the Revisions sections, now deleted, with Version. */ - -/* - SPICELIB Version 3.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to utilize interfaces built on */ -/* the new handle manager to perform I/O operations. */ - -/* This routine now utilizes ZZDAFGFR to retrieve information */ -/* from the file record. As this private interface takes a */ -/* handle and performs the necessary logical unit to handle */ -/* mapping, the call to DAFHLU was removed. The DAFSIH call */ -/* remains, since this insures that HANDLE is known to DAFAH. */ -/* C */ -/* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ - -/* The error SPICE(DAFNOIDWORD) is no longer signaled by this */ -/* routine. The reason for this is that if DAFSIH returns OK then */ -/* the handle passed to this routine is indeed a valid DAF file */ -/* handle, otherwise the error is diagnosed by DAFSIH. */ - -/* Added a call to DAFSIH to signal an invalid handle and a test */ -/* of FAILED () after it. This is to make sure that the DAF file */ -/* is open for reading. If this call succeeds, we know that we */ -/* have a valid DAF handle, so there is no need to check FAILED */ -/* after the call to DAFHLU. */ - -/* The variable name DAFWRD was changed to IDWORD. */ - -/* Added two new exceptions to the $ Exceptions section: 1 and 2. */ -/* The remaining exception (3) was already present. The exceptions */ -/* that were added are not new, but are being documented for the */ -/* first time. */ - - -/* - SPICELIB Version 1.0.3, 6-OCT-1992 (HAN) */ - -/* Corrected a typo in the Brief_I/O section. ND was listed */ -/* twice as an input, and NI was not listed. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read daf file record */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRFR", (ftnlen)6); - } - -/* Do some initializations */ - - s_copy(idword, " ", (ftnlen)8, (ftnlen)1); - -/* Check to be sure that HANDLE is attached to a file that is open */ -/* with read access. If the call fails, check out and return. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFRFR", (ftnlen)6); - return 0; - } - -/* Retrieve all but the internal file name directly from the */ -/* file record. Read the internal file name into a temporary */ -/* string, to be sure of the length. Check FOUND. */ - - zzdafgfr_(handle, idword, nd, ni, ifname, fward, bward, free, &found, ( - ftnlen)8, ifname_len); - if (! found) { - setmsg_("File record not found for file handle #1. Check if program " - "code uses handle #2 for a read or write operation.", (ftnlen) - 109); - errint_("#1", handle, (ftnlen)2); - errint_("#2", handle, (ftnlen)2); - sigerr_("SPICE(DAFFRNOTFOUND)", (ftnlen)20); - chkout_("DAFRFR", (ftnlen)6); - return 0; - } - chkout_("DAFRFR", (ftnlen)6); - return 0; -} /* dafrfr_ */ - diff --git a/ext/spice/src/cspice/dafrfr_c.c b/ext/spice/src/cspice/dafrfr_c.c deleted file mode 100644 index 455ab4e0f3..0000000000 --- a/ext/spice/src/cspice/dafrfr_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure dafrfr_c ( DAF, read file record ) - --Abstract - - Read the contents of the file record of a DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void dafrfr_c ( SpiceInt handle, - SpiceInt lenout, - SpiceInt * nd, - SpiceInt * ni, - SpiceChar * ifname, - SpiceInt * fward, - SpiceInt * bward, - SpiceInt * free ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an open DAF file. - lenout I Available room in the output string `ifname'. - nd O Number of double precision components in summaries. - ni O Number of integer components in summaries. - ifname O Internal file name. - fward O Forward list pointer. - bward O Backward list pointer. - free O Free address pointer. - --Detailed_Input - - handle is the handle assigned to a DAF file opened for - reading. - - lenout is the maximum number of characters that can be - accommodated in the output string `ifname'. This count - includes room for the terminating null character. - DAF internal file names may contain up to 60 - characters, so lenout normally should be set to 61. - --Detailed_Output - - nd, - ni are the numbers of double precision and integer - components, respectively, in each array summary in - the specified file. - - ifname is the internal file name stored in the first - (or file) record of the specified file. `ifname' - should be declared with the length specified by - `lenout'. - - fward is the forward list pointer. This points to the - first summary record in the file. (Records between - the first record and the first summary record are - reserved when the file is created, and are invisible - to DAF routines.) - - DAF list pointers are actually Fortran record numbers, - and as such, start at one. - - bward is the backward list pointer. This points - to the final summary record in the file. - - - free is the free address pointer. This contains the - first free address in the file. (That is, the - initial address of the next array to be added - to the file.) - - `free' is a DAF address; for compatiblity with - SPICELIB, the range of DAF addresses starts at 1. - --Parameters - - None. - --Exceptions - - 1) If the handle passed to this routine is not the handle of an - open DAF file, the error will be signaled by a routine called - by this routine. - - 2) If the specified DAF file is not open for read access, the - error will be diagnosed by a routine called by this routine. - - 3) If the specified record cannot (for some reason) be read, - the error SPICE(DAFFRNOTFOUND) is signaled. - --Files - - The input `handle' should refer to a DAF file open for read - or write access. - --Particulars - - The file record of a DAF is the only record that contains - any global information about the file. This record is created - when the file is created, and is updated only when new arrays - are added. - - Like character records, file records are not buffered. - --Examples - - In the following example, the file record of a DAF is read - to determine the first free address in the file. - - #include - #include "SpiceUsr.h" - - int main ( int argc, char ** argv ) - { - #define IFNLEN 61 - - SpiceChar ifname[IFNLEN]; - - SpiceInt bward; - SpiceInt free; - SpiceInt fward; - SpiceInt handle; - SpiceInt nd; - SpiceInt ni; - - dafopr_c ( argv[1], &handle ); - - dafrfr_c ( handle, IFNLEN, &nd, &ni, ifname, &fward, &bward, &free ); - - printf ( "First free DAF address is %ld.\n", free ); - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 17-JUN-2009 (NJB) (KRG) (IMU) - --Index_Entries - - read daf file record - --& -*/ - -{ /* Begin dafrfr_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafrfr_c" ); - - dafrfr_ ( (integer *) &handle, - (integer *) nd, - (integer *) ni, - (char *) ifname, - (integer *) fward, - (integer *) bward, - (integer *) free, - (ftnlen ) lenout-1 ); - - /* - Convert the internal file name to a C-style string. - */ - F2C_ConvertStr ( lenout, ifname ); - - - chkout_c ( "dafrfr_c" ); - -} /* End dafrfr_c */ - diff --git a/ext/spice/src/cspice/dafrrr.c b/ext/spice/src/cspice/dafrrr.c deleted file mode 100644 index 42c752c219..0000000000 --- a/ext/spice/src/cspice/dafrrr.c +++ /dev/null @@ -1,392 +0,0 @@ -/* dafrrr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure DAFRRR ( DAF, remove reserved records ) */ -/* Subroutine */ int dafrrr_(integer *handle, integer *resv) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char crec[1000]; - doublereal drec[128]; - integer decr, free, word, next; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen), - dafps_(integer *, integer *, doublereal *, integer *, doublereal * - ); - integer bward; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - integer fward; - extern /* Subroutine */ int dafws_(doublereal *); - integer recno; - logical found; - doublereal dc[125]; - integer ic[250]; - extern /* Subroutine */ int daffna_(logical *); - integer nd; - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer begblk, ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - integer endblk; - extern /* Subroutine */ int dafrcr_(integer *, integer *, char *, ftnlen), - dafrdr_(integer *, integer *, integer *, integer *, doublereal *, - logical *), dafrfr_(integer *, integer *, integer *, char *, - integer *, integer *, integer *, ftnlen), dafarw_(integer *, - integer *, integer *), dafwcr_(integer *, integer *, char *, - ftnlen), dafwdr_(integer *, integer *, doublereal *), dafwfr_( - integer *, integer *, integer *, char *, integer *, integer *, - integer *, ftnlen); - integer remove; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - doublereal sum[125]; - -/* $ Abstract */ - -/* Remove a specified number of reserved records from a Double */ -/* Precision Array File (DAF). */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAF, opened for writing. */ -/* RESV I Number of records to remove. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF that has been */ -/* opened with write access. */ - -/* RESV is the number of reserved records to be removed */ -/* from the specified file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If RESV is less than one, the file is not changed. */ - -/* 2) If RESV is greater than the number of reserved records in the */ -/* file, all of the reserved records are removed. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* Normally, the reserved records in an array file are reserved */ -/* when the file is created. However, it may occasionally become */ -/* desirable to remove reserved records---when their contents are */ -/* significantly reduced, for example. */ - -/* The records nearest the end of the file are removed. Note */ -/* that the physical size of the file is not reduced when reserved */ -/* records are removed. */ - -/* $ Examples */ - -/* For the following call to DAFRRR, assume that HANDLE is the file */ -/* handle for a DAF file that has been opened for write access, and */ -/* that the DAF file already contains 12 reserved records (located in */ -/* records 2-13 of the physical file). */ - -/* CALL DAFRRR ( HANDLE, 7 ) */ - -/* After this call to DAFRRR, the number of reserved records has been */ -/* decreased by 7, leaving only the first five of the original */ -/* reserved records, physical records 2-6. */ - -/* $ Restrictions */ - -/* 1) This routine will only remove reserve records from DAFs open */ -/* for write. These files are implicitly of the native binary */ -/* file format. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 16-NOV-2001 (FST) */ - -/* Added a call to DAFSIH to prevent this routine from */ -/* attempting to write to non-native binary file formats. */ -/* This will provide a more useful error diagnostic with */ -/* little impact on performance. */ - -/* - SPICELIB Version 1.1.0, 30-SEP-1993 (KRG) */ - -/* Detailed_Input and Examples section of the header were */ -/* modified. */ - -/* Added calls to the FORTRAN intrinsic functions INT and */ -/* DBLE in the code that updates the summary record. */ - -/* - 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, 18-JUL-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove daf reserved records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-SEP-1993 (KRG) */ - -/* $ Detailed_Input section was modified. References to any */ -/* specific routines by name as a method for opening a DAF file */ -/* for write access were removed. The assumption is that a person */ -/* using DAF files would already know something about opening and */ -/* closing the files. */ - -/* $ Examples section was modified. References to any specific */ -/* routines by name as a method for opening a DAF file for writing */ -/* were removed, and the example was reworded in such a way that */ -/* the use of the subroutine remained clear. */ - -/* Added calls to the INT intrinsic function to convert a DP */ -/* number to an integer before assigning it to NEXT or ENDBLK, */ -/* both of which are integer variables. Also added calls to INT */ -/* in IF statements where comparisons were made between DP numbers */ -/* and INTEGERs, when integral values were actually being */ -/* compared. */ - -/* Added calls to the intrinsic function DBLE to convert an */ -/* integer, REMOVE, into a DP number when doing some arithmetic. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - - -/* WPR is the maximum number of double precision */ -/* numbers per record. WPR stands for words */ -/* per record. */ - - -/* MAXD, are the maximum number of double precision */ -/* MAXI, numbers, integers, and characters, respectively, */ -/* MAXC not including space reserved for control information. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRRR", (ftnlen)6); - } - -/* Before proceeding any further, check that the DAF associated */ -/* with HANDLE is available for write access. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFRRR", (ftnlen)6); - return 0; - } - -/* Get the contents of the file record. If it fails, then just check */ -/* out and return, as an appropriate error message should have */ -/* already been set. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFRRR", (ftnlen)6); - return 0; - } - -/* Don't remove more than the current number of reserved records! */ -/* If there are none, check out. */ - -/* Computing MIN */ - i__1 = *resv, i__2 = fward - 2; - remove = min(i__1,i__2); - if (remove < 1) { - chkout_("DAFRRR", (ftnlen)6); - return 0; - } - -/* Okay, here's the plan. We are just going to move records */ -/* forward, starting with the first summary record in the file */ -/* and ending with the last data record. */ - -/* After everything has been moved, the initial and final */ -/* addresses of all the arrays have to be decremented by the */ -/* same amount: the number of words per record (128) times */ -/* the number of records removed. */ - - decr = remove << 7; - -/* Records will be moved in `blocks', where each block contains */ - -/* -- a summary record */ - -/* -- a name record */ - -/* -- one or more data records */ - -/* Most blocks lie between one summary record and the next. */ -/* The final block lies between the final summary record and */ -/* whatever data record contains the first free address. */ - -/* BEGBLK is initially the first summary record location. */ - - begblk = fward; - while(begblk > 0 && ! failed_()) { - -/* Move the summary record first. The location of the next */ -/* summary record determines the end of this block, and the */ -/* beginning of the next. */ - -/* Be sure to adjust the forward and backward pointers; */ -/* otherwise, we won't be able to find the summaries again. */ - - recno = begblk; - dafrdr_(handle, &recno, &c__1, &c__128, drec, &found); - if ((integer) drec[0] > 0) { - endblk = (integer) drec[0] - 1; - next = (integer) drec[0]; - } else { - dafarw_(&free, &endblk, &word); - next = 0; - } - if ((integer) drec[0] > 0) { - drec[0] -= (doublereal) remove; - } - if ((integer) drec[1] > 0) { - drec[1] -= (doublereal) remove; - } - i__1 = recno - remove; - dafwdr_(handle, &i__1, drec); - -/* Then the name record. */ - - recno = begblk + 1; - dafrcr_(handle, &recno, crec, (ftnlen)1000); - i__1 = recno - remove; - dafwcr_(handle, &i__1, crec, (ftnlen)1000); - -/* Finally, the data records. */ - - i__1 = endblk; - for (recno = begblk + 2; recno <= i__1; ++recno) { - dafrdr_(handle, &recno, &c__1, &c__128, drec, &found); - i__2 = recno - remove; - dafwdr_(handle, &i__2, drec); - } - -/* Start the next block, if one exists. */ - - begblk = next; - } - -/* Rewrite the file record, to reflect the new organization of */ -/* the file. */ - - fward -= remove; - bward -= remove; - free -= decr; - dafwfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - -/* Get the summary for each array, decrement the addresses (stored */ -/* in the final two integer components), and replace the summary. */ - - dafbfs_(handle); - daffna_(&found); - while(found && ! failed_()) { - dafgs_(sum); - dafus_(sum, &nd, &ni, dc, ic); - ic[(i__1 = ni - 2) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, - "dafrrr_", (ftnlen)393)] = ic[(i__2 = ni - 2) < 250 && 0 <= - i__2 ? i__2 : s_rnge("ic", i__2, "dafrrr_", (ftnlen)393)] - - decr; - ic[(i__1 = ni - 1) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, - "dafrrr_", (ftnlen)394)] = ic[(i__2 = ni - 1) < 250 && 0 <= - i__2 ? i__2 : s_rnge("ic", i__2, "dafrrr_", (ftnlen)394)] - - decr; - dafps_(&nd, &ni, dc, ic, sum); - dafws_(sum); - daffna_(&found); - } - chkout_("DAFRRR", (ftnlen)6); - return 0; -} /* dafrrr_ */ - diff --git a/ext/spice/src/cspice/dafrs_c.c b/ext/spice/src/cspice/dafrs_c.c deleted file mode 100644 index f498680963..0000000000 --- a/ext/spice/src/cspice/dafrs_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure dafrs_c ( DAF, replace summary ) - --Abstract - - Change the summary for the current array in the current DAF. - --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 - - DAF - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZim.h" - #undef dafrs_c - - - void dafrs_c ( ConstSpiceDouble * sum ) - - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sum I New summary for current array. - --Detailed_Input - - sum is the new summary for the current array. This - replaces the existing summary. However, the addresses - (the final two integer components) of the original - summary are not changed. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - This routine operates on a DAF opened for write access. A search - must be in progress at the time this routine is called; this - routine replaces the descriptor of the current segment. - --Exceptions - - 1) If this routine is called when no search is in progress in the - the current DAF, the error SPICE(DAFNOSEARCH) is signaled. - - 2) If the DAF containing the `current' array has actually been - closed, the error will be diagnosed by routines called by - this routine. - - 3) If the DAF containing the `current' array is not open for - writing, the error will be diagnosed by routines called by - this routine. - - 4) If no array is current in the current DAF, the error - SPICE(NOCURRENTARRAY) is signaled. There is no current - array when a search is started by dafbfs_c or dafbbs_c, but no - calls to daffna_c or dafbna_ have been made yet, or whenever - daffna_c or daffpa_c return the value SPICEFALSE in the `found' - argument. - --Particulars - - See SPICELIB umbrella routine DAFFA. - --Examples - - 1) Replace the body ID code -999 with -1999 in every descriptor - of an SPK file. - - - #include - - int main ( int argc, char **argv ) - { - #define ND 2 - #define NI 6 - #define DSCSIZ 5 - #define NEWCODE ( -1999 ) - #define OLDCODE ( -999 ) - - SpiceBoolean found; - - SpiceInt handle; - SpiceInt ic [ NI ]; - - SpiceDouble dc [ ND ]; - SpiceDouble sum [ DSCSIZ ]; - - /. - Open for writing the SPK file specified on the command line. - ./ - dafopw_c ( argv[1], &handle ); - - /. - Search the file in forward order. - ./ - dafbfs_c ( handle ); - daffna_c ( &found ); - - while ( found ) - { - /. - Fetch and unpack the descriptor (aka summary) - of the current segment. - ./ - dafgs_c ( sum ); - dafus_c ( sum, ND, NI, dc, ic ); - - /. - Replace ID codes if necessary. - ./ - if ( ic[0] == OLDCODE ) - { - ic[0] = NEWCODE; - } - if ( ic[1] == OLDCODE ) - { - ic[1] = NEWCODE; - } - - /. - Re-pack the descriptor; replace the descriptor - in the file. - ./ - dafps_c ( ND, NI, dc, ic, sum ); - - dafrs_c ( sum ); - - /. - Find the next segment. - ./ - daffna_c ( &found ); - } - - /. - Close the file. - ./ - dafcls_c ( handle ); - - return ( 0 ); - } - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 23-NOV-2004 (NJB) - --Index_Entries - - replace daf summary - --& -*/ - -{ /* Begin dafrs_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dafrs_c" ); - - /* - Not much to it. - */ - dafrs_ ( (doublereal *) sum ); - - - chkout_c ( "dafrs_c" ); - -} /* End dafrs_c */ diff --git a/ext/spice/src/cspice/dafrwa.c b/ext/spice/src/cspice/dafrwa.c deleted file mode 100644 index 5f0b86d874..0000000000 --- a/ext/spice/src/cspice/dafrwa.c +++ /dev/null @@ -1,316 +0,0 @@ -/* dafrwa.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DAFRWA ( DAF, record/word to address ) */ -/* Subroutine */ int dafrwa_0_(int n__, integer *recno, integer *wordno, - integer *addr__) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert a record/word pair to its equivalent address within */ -/* a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* RECNO, */ -/* WORDNO I Record, word numbers of a location within DAF. */ -/* ADDR O Corresponding address. */ - -/* $ Detailed_Input */ - -/* RECNO, */ -/* WORDNO are the record and word numbers of an arbitrary */ -/* location within a DAF. */ - -/* $ Detailed_Output */ - -/* ADDR is the corresponding address within the DAF. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either RECNO or WORDNO is zero or negative, the error */ -/* SPICE(DAFNOSUCHADDR) is signalled. */ - -/* $ Particulars */ - -/* To the user, the data in a DAF appear to be a contiguous */ -/* collection of double precision numbers, each of which has an */ -/* address. To the DAF software, however, the data appear to be */ -/* a collection of records, each containing 128 double precision */ -/* words. The routines DAFARW and DAFRWA translate between these */ -/* two representations. */ - -/* $ Examples */ - -/* Routines DAFRDA and DAFWDA illustrate the use of DAFARW and */ -/* DAFRWA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* record/word to daf address */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_dafarw; - } - - if (return_()) { - return 0; - } else if (*recno <= 0 || *wordno <= 0) { - chkin_("DAFRWA", (ftnlen)6); - setmsg_("No address for record #, word #.", (ftnlen)32); - errint_("#", recno, (ftnlen)1); - errint_("#", wordno, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHADDR)", (ftnlen)20); - chkout_("DAFRWA", (ftnlen)6); - return 0; - } - -/* If the record and word numbers are legal, the computation is */ -/* straightforward. */ - - *addr__ = *wordno + (*recno - 1 << 7); - return 0; -/* $Procedure DAFARW ( DAF, address to record/word ) */ - -L_dafarw: -/* $ Abstract */ - -/* Convert an address within a DAF to its equivalent */ -/* record/word representation. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER ADDR */ -/* INTEGER RECNO */ -/* INTEGER WORDNO */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ADDR I Address within DAF. */ -/* RECNO, */ -/* WORDNO O Corresponding record, word numbers. */ - -/* $ Detailed_Input */ - -/* ADDR is an arbitrary address within a DAF. */ - -/* $ Detailed_Output */ - -/* RECNO, */ -/* WORDNO are the corresponding record and word numbers */ -/* within the DAF. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If ADDR is zero or negative, the error SPICE(DAFNOSUCHADDR) */ -/* is signalled. */ - -/* $ Particulars */ - -/* To the user, the data in a DAF appear to be a contiguous */ -/* collection of double precision numbers, each of which has an */ -/* address. To the DAF software, however, the data appear to be */ -/* a collection of records, each containing 128 double precision */ -/* words. The routines DAFARW and DAFRWA translate between these */ -/* two representations. */ - -/* $ Examples */ - -/* Routines DAFRDA and DAFWDA illustrate the use of DAFARW and */ -/* DAFRWA. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* daf address to record/word */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else if (*addr__ <= 0) { - chkin_("DAFARW", (ftnlen)6); - setmsg_("No record, word for address #.", (ftnlen)30); - errint_("#", addr__, (ftnlen)1); - sigerr_("SPICE(DAFNOSUCHADDR)", (ftnlen)20); - chkout_("DAFARW", (ftnlen)6); - return 0; - } - -/* If the address is legal, the computation is straightforward. */ - - *recno = (*addr__ - 1) / 128 + 1; - *wordno = *addr__ - (*recno - 1 << 7); - return 0; -} /* dafrwa_ */ - -/* Subroutine */ int dafrwa_(integer *recno, integer *wordno, integer *addr__) -{ - return dafrwa_0_(0, recno, wordno, addr__); - } - -/* Subroutine */ int dafarw_(integer *addr__, integer *recno, integer *wordno) -{ - return dafrwa_0_(1, recno, wordno, addr__); - } - diff --git a/ext/spice/src/cspice/dafrwd.c b/ext/spice/src/cspice/dafrwd.c deleted file mode 100644 index c27b64a24e..0000000000 --- a/ext/spice/src/cspice/dafrwd.c +++ /dev/null @@ -1,2304 +0,0 @@ -/* dafrwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__128 = 128; - -/* $Procedure DAFRWD ( DAF, read, write double precision ) */ -/* Subroutine */ int dafrwd_0_(int n__, integer *handle, integer *recno, - integer *begin, integer *end, doublereal *drec, doublereal *data, - logical *found, integer *reads, integer *reqs) -{ - /* Initialized data */ - - static integer rbhan[100] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0 }; - static integer rbrec[100] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0 }; - static integer rbreq[100] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0 }; - static doublereal rbdat[12800] /* was [128][100] */ = { 0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0. }; - static integer rbnbr = 1; - static integer nread = 0; - static integer nreq = 0; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_wdue(cilist *), - do_uio(integer *, char *, ftnlen), e_wdue(void); - - /* Local variables */ - logical done; - integer unit; - extern /* Subroutine */ int zzdafgdr_(integer *, integer *, doublereal *, - logical *), zzddhrcm_(integer *, integer *, integer *), zzdafgsr_( - integer *, integer *, integer *, integer *, doublereal *, logical - *), zzddhhlu_(integer *, char *, logical *, integer *, ftnlen), - zzddhisn_(integer *, logical *, logical *); - integer b, e; - extern /* Subroutine */ int chkin_(char *, ftnlen), minai_(integer *, - integer *, integer *, integer *), moved_(doublereal *, integer *, - doublereal *); - integer count, nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafhsf_(integer *, integer *, integer *); - logical locfnd; - integer bufloc; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen); - integer minval; - logical native; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - logical stored; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___21 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Read, write, and rewrite double precision records to and */ -/* from DAFs. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAFGDR. DAFGSR, DAFRDR (Obsolete), DAFWDR */ -/* RECNO I DAFGDR. DAFGSR, DAFRDR (Obsolete), DAFWDR */ -/* BEGIN I DAFGDR. DAFGSR, DAFRDR (Obsolete) */ -/* END I DAFGDR. DAFGSR, DAFRDR (Obsolete) */ -/* DREC I DAFWDR */ -/* DATA O DAFGDR. DAFGSR, DAFRDR (Obsolete) */ -/* FOUND O DAFGDR. DAFGSR, DAFRDR (Obsolete) */ -/* READS O DAFNRR */ -/* REQS O DAFNRR */ -/* RBSIZE P DAFGDR. DAFGSR, DAFRDR (Obsolete), DAFWDR, DAFNRR */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a double precision record */ -/* within a DAF to be read or written. */ - -/* BEGIN is the first in word in a double precision record */ -/* to be read. */ - -/* END is the last in word in a double precision record */ -/* to be read. */ - -/* DREC contains a single double precision record, to be */ -/* written to the specified DAF. */ - -/* $ Detailed_Output */ - -/* DATA contains a portion of a single double precision */ -/* record, read from the specified DAF. */ - -/* FOUND is true when the specified record is found, and is */ -/* false otherwise. */ - -/* READS, */ -/* REQS are the number of physical reads and the number */ -/* of requests processed by DAFRDR during the current */ -/* execution of the calling program. */ - - -/* $ Parameters */ - -/* RBSIZE is the size of the record buffer maintained by */ -/* DAFRWD. In effect, RBSIZE is the maximum number */ -/* of records that can be stored (buffered) at any */ -/* one time. Higher values of RBSIZE reduce the */ -/* amount of time spent reading from disk at the */ -/* cost of increasing the amount of space required */ -/* by the calling program. The optimal value of */ -/* RBSIZE may differ from environment to environment, */ -/* and may even vary from application to application. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If DAFRWD is called directly, the error SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* 2) See entry points DAFGDR, DAFGSR, DAFRDR, DAFWDR, and DAFNRR */ -/* for exceptions specific to those entry points. */ - -/* $ Particulars */ - -/* DAFRWD serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* DAFGDR Read double precision record. */ - -/* DAFGSR Read summary/descriptor record. */ - -/* DAFRDR Read double precision record. (Obsolete, use */ -/* DAFGDR) */ - -/* DAFWDR Write double precision record. */ - -/* DAFNRR Number of reads, requests. */ - -/* DAFGDR, DAFGSR, and DAFWDR are the only approved means for */ -/* reading and writing double precision records to and from DAFs. */ -/* DAFRDR continues to function, but only on files of the native */ -/* binary format. They keep track of which records have been read */ -/* most recently, and of which records have been requested most */ -/* often, in order to minimize the amount of time spent actually */ -/* reading from external storage. */ - -/* DAFNRR may be used at any time during the execution of a */ -/* program to determine the number of requests that have been */ -/* processed, and the number of actual read operations needed */ -/* to fulfill those requests. Ideally, the ratio of reads to */ -/* requests should approach zero. In the worst case, the ratio */ -/* approaches one. The ratio is related to the size of the */ -/* record buffer, which controlled by parameter RBSIZE. The */ -/* results returned by DAFNRR may be used to determine the */ -/* optimal value of RBSIZE empirically. */ - -/* All data records in a DAF can be treated as an undifferentiated */ -/* collection of double precision numbers. Summary records must */ -/* be read using the DAFGSR interface, but their contents are */ -/* properly buffered in a single buffer with the data records. */ -/* No special buffers are required for each new data type, or to */ -/* keep summary records separate from data records. */ - -/* $ Examples */ - -/* See entry points DAFGDR, DAFGSR, DAFRDR, DAFWDR, and DAFNRR */ -/* for examples specific to those entry points. */ - -/* $ Restrictions */ - -/* 1) An integer overflow may occur if the number of requests */ -/* by a single program exceeds the maximum number that can */ -/* be stored in an integer variable. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Added DAFGDR and DAFGSR entry points to allow read access */ -/* to DAFs utilizing non-native, but supported, binary file */ -/* formats. */ - -/* DAFRDR was phased into obsolescence. */ - -/* The umbrella no longer suffers from integer overflow if */ -/* a sufficient number of successful read requests are made. */ - -/* DAFWDR no longer uses DAFHLU to retrieve a logical unit */ -/* for HANDLE. This call has been replaced with the handle */ -/* manager interface, which does not lock handles to their */ -/* logical units. */ - -/* - SPICELIB Version 1.3.0, 24-MAR-2000 (WLT) */ - -/* The loop in DAFRDR that moved buffered d.p.s into the output */ -/* array DATA was modified to use the routine MOVED. */ - -/* - SPICELIB Version 1.2.0, 01-AUG-1997 (NJB) */ - -/* Unnecessary CHKIN and CHKOUT calls were removed from entry */ -/* point DAFRDR. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* 1) In DAFRDR, the found flag is now set to false if the */ -/* call to DAFHLU fails. */ - -/* 2) In the example code fragment in DAFRDR and DAFWDR, the */ -/* calling sequence to MOVED was corrected. */ - -/* 3) In DAFRDR a variable name was changed. */ - -/* 4) In DAFNRR a cut and paste error in the header was fixed. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read write d.p. daf */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this umbrella and its entry points in preparation */ -/* for DAF's utilization of the handle manager. DAFRDR is */ -/* obsolete, and will now signal errors when used to read */ -/* records from DAFs using non-native, binary file formats. */ - -/* Two new entry points were added: DAFGDR and DAFGDR. These */ -/* are the translation-aware 'get data record' and 'get */ -/* summary record' routines that all new software developed */ -/* should utilize. */ - -/* - SPICELIB Version 1.3.0, 24-MAR-2000 (WLT) */ - -/* The loop in DAFRDR that moved buffered d.p.s into the output */ -/* array DATA was modified to use the routine MOVED. */ - -/* - SPICELIB Version 1.2.0, 01-AUG-1997 (NJB) */ - -/* Unnecessary CHKIN and CHKOUT calls were removed from entry */ -/* point DAFRDR. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (drec) { - } - if (data) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_dafgdr; - case 2: goto L_dafgsr; - case 3: goto L_dafrdr; - case 4: goto L_dafwdr; - case 5: goto L_dafnrr; - } - - -/* As double precision records are processed, they are stored in a */ -/* record buffer. (File and character records are not buffered.) */ -/* The user controls the number of records that may be stored at */ -/* any one time by setting the value of the paramater RBSIZE before */ -/* compiling the routine. */ - -/* The record buffer contains one entry for each record that has */ -/* been read. */ - -/* +----------+----------+----------+----------+ */ -/* | File Record Request Contents | */ -/* | Handle Number Number | */ -/* +----------+----------+----------+----------+ */ -/* | INT INT INT DP(128) | */ -/* +----------+----------+----------+----------+ */ - -/* The request number is a counter that is incremented every time */ -/* a record is requested. When all the slots in the record buffer are */ -/* full, the least recently requested record (the one with the lowest */ -/* request number) is replaced by the new record. */ - -/* In addition, a separate counter is used to keep track of the */ -/* number of actual file reads performed. It is possible to tune */ -/* the entire package by checking the read/request ratio for */ -/* any specific buffer configuration. */ - -/* Note also that whenever a write operation fails, the affected */ -/* buffers (if any) should NOT be updated. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFRWD", (ftnlen)6); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("DAFRWD", (ftnlen)6); - } - return 0; -/* $Procedure DAFGDR ( DAF, get double precision record ) */ - -L_dafgdr: -/* $ Abstract */ - -/* Read a portion of the contents of a double precision record in a */ -/* DAF file. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER BEGIN */ -/* INTEGER END */ -/* DOUBLE PRECISION DATA ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* RECNO I Record number. */ -/* BEGIN I First word to read from record. */ -/* END I Last word to read from record. */ -/* DATA O Contents of record. */ -/* FOUND O True if record is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a particular double precision */ -/* record within the DAF, whose contents are to be read. */ - -/* BEGIN is the first word in the specified record to be */ -/* returned. */ - -/* END is the final word in the specified record to be */ -/* returned. */ - -/* $ Detailed_Output */ - -/* DATA contains the specified portion (from BEGIN to END, */ -/* inclusize) of the specified record from the specified */ -/* file, specifically. */ - -/* FOUND is true when the specified record is found, and is */ -/* false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* DAFGDR checks the record buffer to see if the requested */ -/* record can be returned without actually reading it from */ -/* external storage. If not, it reads the record and stores */ -/* it in the buffer, typically removing another record from */ -/* the buffer as a result. */ - -/* Once in the buffer, the specified portion of the record is */ -/* returned, using the following control loop. */ - -/* J = 1 */ -/* DO I = MAX( 1, BEGIN ), MIN( 128, END ) */ -/* DATA( J ) = Buffered record ( I ) */ -/* J = J + 1 */ -/* END DO */ - -/* Therefore bad values for BEGIN and END (BEGIN < 1, END < BEGIN, */ -/* etc.) are not signaled as errors, but result in the actions */ -/* implied by the above. */ - -/* $ Examples */ - -/* The following code fragment illustrates one way that DAFGDR */ -/* and DAFWDR can be used to update part of a double precision */ -/* record. If the record does not yet exist, we can assume that */ -/* it is filled with zeros. */ - -/* CALL DAFGDR ( HANDLE, RECNO, 1, 128, DREC, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* CALL MOVED ( 0.D0, 128, DREC ) */ -/* END IF */ - -/* DO I = FIRST, LAST */ -/* DREC(I) = NEW_VALUE(I) */ -/* END DO */ - -/* CALL DAFWDR ( HANDLE, RECNO, DREC ) */ - -/* Note that since only entire records may be written using DAFWDR, */ -/* the entire record needs to be read also. */ - -/* $ Restrictions */ - -/* 1) Bad values for BEGIN and END ( BEGIN < 1, END > 128, */ -/* END < BEGIN ) are not signalled as errors. The effects of */ -/* such assignments on the returned data are defined by the */ -/* following control structure: */ - -/* J = 1 */ -/* DO I = MAX( 1, BEGIN ), MIN( 128, END ) */ -/* DATA( J ) = Buffered record ( I ) */ -/* J = J + 1 */ -/* END DO */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* -& */ -/* $ Index_Entries */ - -/* read daf d.p. record */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Assume that the record will be found until proven otherwise. */ - - *found = TRUE_; - -/* First, find the record. */ - -/* If the specified handle and record number match those of */ -/* a buffered record, determine the location of that record */ -/* within the buffer. */ - - bufloc = 0; - done = FALSE_; - stored = FALSE_; - while(! done) { - ++bufloc; - stored = *handle == rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("rbhan", i__1, "dafrwd_", (ftnlen)592)] && * - recno == rbrec[(i__2 = bufloc - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rbrec", i__2, "dafrwd_", (ftnlen)592)]; - done = stored || bufloc == rbnbr; - } - -/* If not, determine the location of the least recently requested */ -/* record (the one with the smallest request number). Get the unit */ -/* number for the file, and read the record into this location. */ - -/* If an error occurs while reading the record, clear the entire */ -/* buffer entry in case the entry was corrupted by a partial read. */ -/* Otherwise, increment the number of reads performed so far. */ - - if (! stored) { - minai_(rbreq, &rbnbr, &minval, &bufloc); - zzdafgdr_(handle, recno, &rbdat[(i__1 = (bufloc << 7) - 128) < 12800 - && 0 <= i__1 ? i__1 : s_rnge("rbdat", i__1, "dafrwd_", ( - ftnlen)612)], &locfnd); - -/* If the call to ZZDAFGDR failed, or the record was not found, */ -/* then clean up. */ - - if (failed_() || ! locfnd) { - *found = FALSE_; - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)620)] = 0; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)621)] = 0; - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbreq", i__1, "dafrwd_", (ftnlen)622)] = 0; - } else { - ++nread; - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)625)] = *handle; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)626)] = *recno; - if (rbnbr < 100) { - ++rbnbr; - } - } - } - -/* Whether previously stored or just read, the record is now in */ -/* the buffer. Return the specified portion directly, and increment */ -/* the corresponding request number. */ - - if (*found) { - b = max(1,*begin); - e = min(128,*end); - count = e - b + 1; - moved_(&rbdat[(i__1 = b + (bufloc << 7) - 129) < 12800 && 0 <= i__1 ? - i__1 : s_rnge("rbdat", i__1, "dafrwd_", (ftnlen)646)], &count, - data); - -/* Increment the request counter in such a way that integer */ -/* overflow will not occur. This private module from the */ -/* handle manager halves RBREQ if adding 1 to NREQ would */ -/* cause its value to exceed INTMAX. */ - - zzddhrcm_(&rbnbr, rbreq, &nreq); - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("rbreq", - i__1, "dafrwd_", (ftnlen)655)] = nreq; - } - return 0; -/* $Procedure DAFGSR ( DAF, get summary/descriptor record ) */ - -L_dafgsr: -/* $ Abstract */ - -/* Read a portion of the contents of a summary record in a */ -/* DAF file. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER BEGIN */ -/* INTEGER END */ -/* DOUBLE PRECISION DATA ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* RECNO I Record number. */ -/* BEGIN I First word to read from record. */ -/* END I Last word to read from record. */ -/* DATA O Contents of record. */ -/* FOUND O True if record is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a particular double precision */ -/* record within the DAF, whose contents are to be read. */ - -/* BEGIN is the first word in the specified record to be */ -/* returned. */ - -/* END is the final word in the specified record to be */ -/* returned. */ - -/* $ Detailed_Output */ - -/* DATA contains the specified portion (from BEGIN to END, */ -/* inclusize) of the specified record from the specified */ -/* file, specifically. */ - -/* FOUND is true when the specified record is found, and is */ -/* false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* DAFGSR checks the record buffer to see if the requested */ -/* record can be returned without actually reading it from */ -/* external storage. If not, it reads the record and stores */ -/* it in the buffer, typically removing another record from */ -/* the buffer as a result. */ - -/* Once in the buffer, the specified portion of the record is */ -/* returned, using the following control loop. */ - -/* J = 1 */ -/* DO I = MAX( 1, BEGIN ), MIN( 128, END ) */ -/* DATA( J ) = Buffered record ( I ) */ -/* J = J + 1 */ -/* END DO */ - -/* Therefore bad values for BEGIN and END (BEGIN < 1, END < BEGIN, */ -/* etc.) are not signalled as errors, but result in the actions */ -/* implied by the above. */ - -/* $ Examples */ - -/* The following code fragment illustrates one way that DAFGSR */ -/* and DAFWDR can be used to update part of a summary record. */ -/* If the record does not yet exist, we can assume that it is */ -/* filled with zeros. */ - -/* CALL DAFGSR ( HANDLE, RECNO, 1, 128, DREC, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* CALL MOVED ( 0.D0, 128, DREC ) */ -/* END IF */ - -/* DO I = FIRST, LAST */ -/* DREC(I) = NEW_VALUE(I) */ -/* END DO */ - -/* CALL DAFWDR ( HANDLE, RECNO, DREC ) */ - -/* Note that since only entire records may be written using DAFWDR, */ -/* the entire record needs to be read also. */ - -/* $ Restrictions */ - -/* 1) Bad values for BEGIN and END ( BEGIN < 1, END > 128, */ -/* END < BEGIN ) are not signalled as errors. The effects of */ -/* such assignments on the returned data are defined by the */ -/* following control structure: */ - -/* J = 1 */ -/* DO I = MAX( 1, BEGIN ), MIN( 128, END ) */ -/* DATA( J ) = Buffered record ( I ) */ -/* J = J + 1 */ -/* END DO */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* -& */ -/* $ Index_Entries */ - -/* read daf summary record */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Assume that the record will be found until proven otherwise. */ - - *found = TRUE_; - -/* First, find the record. */ - -/* If the specified handle and record number match those of */ -/* a buffered record, determine the location of that record */ -/* within the buffer. */ - - bufloc = 0; - done = FALSE_; - stored = FALSE_; - while(! done) { - ++bufloc; - stored = *handle == rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("rbhan", i__1, "dafrwd_", (ftnlen)862)] && * - recno == rbrec[(i__2 = bufloc - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rbrec", i__2, "dafrwd_", (ftnlen)862)]; - done = stored || bufloc == rbnbr; - } - -/* If not, determine the location of the least recently requested */ -/* record (the one with the smallest request number). Get the unit */ -/* number for the file, and read the record into this location. */ - -/* If an error occurs while reading the record, clear the entire */ -/* buffer entry in case the entry was corrupted by a partial read. */ -/* Otherwise, increment the number of reads performed so far. */ - - if (! stored) { - minai_(rbreq, &rbnbr, &minval, &bufloc); - dafhsf_(handle, &nd, &ni); - zzdafgsr_(handle, recno, &nd, &ni, &rbdat[(i__1 = (bufloc << 7) - 128) - < 12800 && 0 <= i__1 ? i__1 : s_rnge("rbdat", i__1, "dafrwd_" - , (ftnlen)884)], &locfnd); - -/* If the call to ZZDAFGSR or DAFHSF failed, or the record */ -/* was not found, then clean up. */ - - if (failed_() || ! locfnd) { - *found = FALSE_; - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)893)] = 0; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)894)] = 0; - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbreq", i__1, "dafrwd_", (ftnlen)895)] = 0; - } else { - ++nread; - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)898)] = *handle; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)899)] = *recno; - if (rbnbr < 100) { - ++rbnbr; - } - } - } - -/* Whether previously stored or just read, the record is now in */ -/* the buffer. Return the specified portion directly, and increment */ -/* the corresponding request number. */ - - if (*found) { - b = max(1,*begin); - e = min(128,*end); - count = e - b + 1; - moved_(&rbdat[(i__1 = b + (bufloc << 7) - 129) < 12800 && 0 <= i__1 ? - i__1 : s_rnge("rbdat", i__1, "dafrwd_", (ftnlen)919)], &count, - data); - -/* Increment the request counter in such a way that integer */ -/* overflow will not occur. This private module from the */ -/* handle manager halves RBREQ if adding 1 to NREQ would */ -/* cause its value to exceed INTMAX. */ - - zzddhrcm_(&rbnbr, rbreq, &nreq); - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("rbreq", - i__1, "dafrwd_", (ftnlen)928)] = nreq; - } - return 0; -/* $Procedure DAFRDR ( DAF, read double precision record ) */ - -L_dafrdr: -/* $ Abstract */ - -/* Read a portion of the contents of a double precision record in a */ -/* DAF file. */ -/* Obsolete: This routine has been superceded by DAFGDR, and it is */ -/* supported for purposes of backwards compatibility only. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER BEGIN */ -/* INTEGER END */ -/* DOUBLE PRECISION DATA ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* RECNO I Record number. */ -/* BEGIN I First word to read from record. */ -/* END I Last word to read from record. */ -/* DATA O Contents of record. */ -/* FOUND O True if record is found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a particular double precision */ -/* record within the DAF, whose contents are to be read. */ - -/* BEGIN is the first word in the specified record to be */ -/* returned. */ - -/* END is the final word in the specified record to be */ -/* returned. */ - -/* $ Detailed_Output */ - -/* DATA contains the specified portion (from BEGIN to END, */ -/* inclusize) of the specified record from the specified */ -/* file, specifically. */ - -/* FOUND is true when the specified record is found, and is */ -/* false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file associated with HANDLE is not of the native */ -/* binary file format, this routine signals the error */ -/* SPICE(UNSUPPORTEDBFF). */ - -/* $ Particulars */ - -/* DAFRDR checks the record buffer to see if the requested */ -/* record can be returned without actually reading it from */ -/* external storage. If not, it reads the record and stores */ -/* it in the buffer, typically removing another record from */ -/* the buffer as a result. */ - -/* Once in the buffer, the specified portion of the record is */ -/* returned, using the following control loop. */ - -/* J = 1 */ -/* DO I = MAX( 1, BEGIN ), MIN( 128, END ) */ -/* DATA( J ) = Buffered record ( I ) */ -/* J = J + 1 */ -/* END DO */ - -/* Therefore bad values for BEGIN and END (BEGIN < 1, END < BEGIN, */ -/* etc.) are not signalled as errors, but result in the actions */ -/* implied by the above. */ - -/* This routine has been made obsolete by the routine DAFGDR, */ -/* and it is supported for reasons of backwards compatibility */ -/* only. New software development should utilize DAFGDA. */ - -/* $ Examples */ - -/* The following code fragment illustrates one way that DAFRDR */ -/* and DAFWDR can be used to update part of a double precision */ -/* record. If the record does not yet exist, we can assume that */ -/* it is filled with zeros. */ - -/* CALL DAFRDR ( HANDLE, RECNO, 1, 128, DREC, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* CALL MOVED ( 0.D0, 128, DREC ) */ -/* END IF */ - -/* DO I = FIRST, LAST */ -/* DREC(I) = NEW_VALUE(I) */ -/* END DO */ - -/* CALL DAFWDR ( HANDLE, RECNO, DREC ) */ - -/* Note that since only entire records may be written using DAFWDR, */ -/* the entire record needs to be read also. */ - -/* $ Restrictions */ - -/* 1) An integer overflow may occur if the number of requests */ -/* by a single program exceeds the maximum number that can */ -/* be stored in an integer variable. */ - -/* 2) Bad values for BEGIN and END ( BEGIN < 1, END > 128, */ -/* END < BEGIN ) are not signalled as errors. The effects of */ -/* such assignments on the returned data are defined by the */ -/* following control structure: */ - -/* J = 1 */ -/* DO I = MAX( 1, BEGIN ), MIN( 128, END ) */ -/* DATA( J ) = Buffered record ( I ) */ -/* J = J + 1 */ -/* END DO */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Added SPICE(UNSUPPORTEDBFF) exception to the routine. */ - -/* - SPICELIB Version 1.3.0, 24-MAR-2000 (WLT) */ - -/* The loop in DAFRDR that moved buffered d.p.s into the output */ -/* array DATA was modified to use the routine MOVED. */ - -/* - SPICELIB Version 1.2.0, 01-AUG-1997 (NJB) */ - -/* Unnecessary CHKIN and CHKOUT calls were removed from entry */ -/* point DAFRDR. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* 1) In DAFRDR, the found flag is now set to false if the */ -/* call to DAFHLU fails. */ - -/* 2) In the example code fragment in DAFRDR and DAFWDR, the */ -/* calling sequence to MOVED was corrected. */ - -/* 3) In the call to MINAI the argument for the minimum value */ -/* was changed from I to MINVAL. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read daf d.p. record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* The exception SPICE(UNSUPPORTEDBFF) was added to guarantee */ -/* this routine's functionality remains unchanged as a result */ -/* of the updates to the underlying DAF software's utilization of */ -/* the handle manager. In versions of the toolkit prior to this, */ -/* all DAFs loaded were of the native binary file format. */ -/* Previously, this routine was used to read the contents of */ -/* summary records in addition to the usual data records. */ -/* The non-native to native translation process for these two */ -/* different types of records in general are not the same. */ -/* Rather than attempt to interpret the caller's intent, this */ -/* routine is obsolete and restricted to functioning only on */ -/* DAFs of the native binary file format. */ - -/* - SPICELIB Version 1.3.0, 24-MAR-2000 (WLT) */ - -/* The loop in DAFRDR that moved buffered d.p.s into the output */ -/* array DATA was modified to use the routine MOVED. */ - -/* - SPICELIB Version 1.2.0, 01-AUG-1997 (NJB) */ - -/* Unnecessary CHKIN and CHKOUT calls were removed from entry */ -/* point DAFRDR. These calls were placed together prior to */ -/* a RETURN statement. It's unclear why they were there in the */ -/* first place. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* 1) In DAFRDR, the found flag is now set to false if the */ -/* call to DAFHLU fails. */ - -/* 2) In the example code fragment in DAFRDR and DAFWDR, the */ -/* calling sequence to MOVED was corrected. */ - -/* 3) In the call to MINAI the argument for the minimum value */ -/* was changed from I to MINVAL. */ - -/* - Beta Version 2.0.0, 1-NOV-1989 (RET) */ - -/* The function of DAFRDR was changed so that it returns only */ -/* a specified portion of the record. The calling sequence there- */ -/* fore changed from */ - -/* DAFRDR ( HANDLE, RECNO, DREC, FOUND ) to */ -/* DAFRDR ( HANDLE, RECNO, BEGIN, END, DATA, FOUND ) */ - -/* The change was made to cut down on the shuffling of unneeded */ -/* data. */ - -/* Also, DAFRDR now only checks in and checks out if DAFHLU has */ -/* failed (the only routine called by DAFRDR that could possibly */ -/* signal an error). The purpose of this change was to help */ -/* speed up a routine that gets called constantly by higher level */ -/* DAF routines. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Assume that the record will be found until proven otherwise. */ - - *found = TRUE_; - -/* First check to see if HANDLE is associated with a DAF of the */ -/* native binary file format. */ - - zzddhisn_(handle, &native, &locfnd); - if (locfnd && ! native) { - *found = FALSE_; - chkin_("DAFRDR", (ftnlen)6); - setmsg_("The binary file format for file '#' is not native. This rou" - "tine operates only on files of the native format.", (ftnlen) - 108); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(UNSUPPORTEDBFF)", (ftnlen)21); - chkout_("DAFRDR", (ftnlen)6); - return 0; - } - -/* Now, find the record. */ - -/* If the specified handle and record number match those of */ -/* a buffered record, determine the location of that record */ -/* within the buffer. */ - - bufloc = 0; - done = FALSE_; - stored = FALSE_; - while(! done) { - ++bufloc; - stored = *handle == rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("rbhan", i__1, "dafrwd_", (ftnlen)1264)] && * - recno == rbrec[(i__2 = bufloc - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rbrec", i__2, "dafrwd_", (ftnlen)1264)]; - done = stored || bufloc == rbnbr; - } - -/* If not, determine the location of the least recently requested */ -/* record (the one with the smallest request number). Get the unit */ -/* number for the file, and read the record into this location. */ - -/* If an error occurs while reading the record, clear the entire */ -/* buffer entry in case the entry was corrupted by a partial read. */ -/* Otherwise, increment the number of reads performed so far. */ - - if (! stored) { - minai_(rbreq, &rbnbr, &minval, &bufloc); - zzdafgdr_(handle, recno, &rbdat[(i__1 = (bufloc << 7) - 128) < 12800 - && 0 <= i__1 ? i__1 : s_rnge("rbdat", i__1, "dafrwd_", ( - ftnlen)1284)], &locfnd); - -/* If the call to ZZDAFGDR failed, or the record was not found, */ -/* then clean up. */ - - if (failed_() || ! locfnd) { - *found = FALSE_; - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)1292)] = 0; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)1293)] = 0; - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbreq", i__1, "dafrwd_", (ftnlen)1294)] = 0; - } else { - ++nread; - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)1297)] = *handle; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)1298)] = *recno; - if (rbnbr < 100) { - ++rbnbr; - } - } - } - -/* Whether previously stored or just read, the record is now in */ -/* the buffer. Return the specified portion directly, and increment */ -/* the corresponding request number. */ - - if (*found) { - b = max(1,*begin); - e = min(128,*end); - count = e - b + 1; - moved_(&rbdat[(i__1 = b + (bufloc << 7) - 129) < 12800 && 0 <= i__1 ? - i__1 : s_rnge("rbdat", i__1, "dafrwd_", (ftnlen)1318)], & - count, data); - -/* Increment the request counter in such a way that integer */ -/* overflow will not occur. This private module from the */ -/* handle manager halves RBREQ if adding 1 to NREQ would */ -/* cause its value to exceed INTMAX. */ - - zzddhrcm_(&rbnbr, rbreq, &nreq); - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("rbreq", - i__1, "dafrwd_", (ftnlen)1327)] = nreq; - } - return 0; -/* $Procedure DAFWDR ( DAF, write double precision record ) */ - -L_dafwdr: -/* $ Abstract */ - -/* Write or rewrite the contents of a double precision record in */ -/* a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* DOUBLE PRECISION DREC ( 128 ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* RECNO I Record number. */ -/* DREC I Contents of record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a particular double */ -/* precision record within the file, whose */ -/* contents are to be written (if the record does */ -/* not yet exist) or overwritten (if it does). */ - -/* DREC contains the new contents of the record. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file is not open for write access, the error */ -/* SPICE(DAFILLEGWRITE) is signalled. */ - -/* 2) If (for some reason) the record cannot be written the */ -/* error SPICE(DAFDPWRITEFAIL) is signalled. */ - -/* $ Particulars */ - -/* Like DAFRDR, DAFWDR checks the record buffer to see if the */ -/* requested record is in the buffer. If so, the buffer is */ -/* updated along with the file. This prevents the buffer from */ -/* becoming outdated. */ - -/* $ Examples */ - -/* The following code fragment illustrates one way that DAFRDR */ -/* and DAFWDR can be used to update part of a double precision */ -/* record. If the record does not yet exist, we can assume that */ -/* it is filled with zeros. */ - -/* CALL DAFRDR ( HANDLE, RECNO, DREC, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* CALL MOVED ( 0.D0, 128, DREC ) */ -/* END IF */ - -/* DO I = FIRST, LAST */ -/* DREC(I) = NEW_VALUE(I) */ -/* END DO */ - -/* CALL DAFWDR ( HANDLE, RECNO, DREC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Replaced the call to DAFHLU to ZZDDHHLU. This prevents */ -/* DAFWDR from tying up resources in the handle manager. */ - -/* - SPICELIB Version 1.3.0, 24-MAR-2000 (WLT) */ - -/* The loop in DAFRDR that moved buffered d.p.s into the output */ -/* array DATA was modified to use the routine MOVED. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* In the example code fragment in DAFRDR and DAFWDR, the */ -/* calling sequence to MOVED was corrected. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write daf d.p. record */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFWDR", (ftnlen)6); - } - -/* No fair writing to a read-only file! */ - - if (*handle >= 0) { - setmsg_("Attempt was made to write to a read-only file.", (ftnlen)46); - sigerr_("SPICE(DAFILLEGWRITE)", (ftnlen)20); - chkout_("DAFWDR", (ftnlen)6); - return 0; - } - -/* If the specified handle and record number match those of */ -/* a buffered record, determine the location of that record */ -/* within the buffer. */ - - bufloc = 0; - done = FALSE_; - stored = FALSE_; - while(! done) { - ++bufloc; - stored = *handle == rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("rbhan", i__1, "dafrwd_", (ftnlen)1532)] && * - recno == rbrec[(i__2 = bufloc - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rbrec", i__2, "dafrwd_", (ftnlen)1532)]; - done = stored || bufloc == 100; - } - -/* Get the unit number for the file, and write the record. */ - - zzddhhlu_(handle, "DAF", &c_false, &unit, (ftnlen)3); - io___21.ciunit = unit; - io___21.cirec = *recno; - iostat = s_wdue(&io___21); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__128, (char *)&drec[0], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100001; - } - iostat = e_wdue(); -L100001: - -/* If the record was buffered, replace it---with the input */ -/* record if the write was successful, or with zeros if it */ -/* was not. */ - - if (stored) { - if (iostat == 0) { - moved_(drec, &c__128, &rbdat[(i__1 = (bufloc << 7) - 128) < 12800 - && 0 <= i__1 ? i__1 : s_rnge("rbdat", i__1, "dafrwd_", ( - ftnlen)1555)]); - } else { - rbhan[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbhan", i__1, "dafrwd_", (ftnlen)1557)] = 0; - rbrec[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbrec", i__1, "dafrwd_", (ftnlen)1558)] = 0; - rbreq[(i__1 = bufloc - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "rbreq", i__1, "dafrwd_", (ftnlen)1559)] = 0; - } - } - -/* Declare an error if the write failed. */ - - if (iostat != 0) { - setmsg_("Double precision write failed. Value of IOSTAT was #", ( - ftnlen)52); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFDPWRITEFAIL)", (ftnlen)21); - } - chkout_("DAFWDR", (ftnlen)6); - return 0; -/* $Procedure DAFNRR ( DAF number of reads, requests ) */ - -L_dafnrr: -/* $ Abstract */ - -/* Return the number of reads and requests fielded by DAFRDR. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER READS */ -/* INTEGER REQS */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* READS, */ -/* REQS O Reads, requests in this execution. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* READS, */ -/* REQS are the number of physical reads and the number */ -/* of requests processed by DAFRDR during the current */ -/* execution of the calling program. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* The ratio of reads to requests tells you something about */ -/* the effectiveness with which the record buffer is preventing */ -/* unwanted disk access. In the ideal case, most of the records */ -/* needed by the calling program can be returned directly from */ -/* the buffer, and the ratio of reads to requests approaches zero. */ -/* More realistically, it should be be somewhere between 1/10 */ -/* and 1/2. */ - -/* If the ratio is greater than 1/2, you should consider increasing */ -/* the size of the record buffer (which is controlled by parameter */ -/* RBSIZE) in order to improve the performance of the DAF package, */ -/* unless your application is strapped for space. */ - -/* $ Examples */ - -/* In the following code fragment, the ratio of reads to requests */ -/* is determined following a series of calls to the reader DAFEZ. */ - -/* DO I = 1, N */ -/* CALL DAFEZ ( ..., STATES(1,I), ... ) */ -/* END DO */ - -/* CALL DAFNRR ( READS, REQS ) */ - -/* WRITE (*,*) 'Reads/requests = ', FLOAT( READS ) / FLOAT( REQS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 24-MAR-2000 (WLT) */ - -/* The loop in DAFRDR that moved buffered d.p.s into the output */ -/* array DATA was modified to use the routine MOVED. */ - -/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ - -/* A cut and paste error in the literature references */ -/* section of the header was fixed. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* number of daf read requests */ - -/* -& */ - *reads = nread; - *reqs = nreq; - return 0; -} /* dafrwd_ */ - -/* Subroutine */ int dafrwd_(integer *handle, integer *recno, integer *begin, - integer *end, doublereal *drec, doublereal *data, logical *found, - integer *reads, integer *reqs) -{ - return dafrwd_0_(0, handle, recno, begin, end, drec, data, found, reads, - reqs); - } - -/* Subroutine */ int dafgdr_(integer *handle, integer *recno, integer *begin, - integer *end, doublereal *data, logical *found) -{ - return dafrwd_0_(1, handle, recno, begin, end, (doublereal *)0, data, - found, (integer *)0, (integer *)0); - } - -/* Subroutine */ int dafgsr_(integer *handle, integer *recno, integer *begin, - integer *end, doublereal *data, logical *found) -{ - return dafrwd_0_(2, handle, recno, begin, end, (doublereal *)0, data, - found, (integer *)0, (integer *)0); - } - -/* Subroutine */ int dafrdr_(integer *handle, integer *recno, integer *begin, - integer *end, doublereal *data, logical *found) -{ - return dafrwd_0_(3, handle, recno, begin, end, (doublereal *)0, data, - found, (integer *)0, (integer *)0); - } - -/* Subroutine */ int dafwdr_(integer *handle, integer *recno, doublereal * - drec) -{ - return dafrwd_0_(4, handle, recno, (integer *)0, (integer *)0, drec, ( - doublereal *)0, (logical *)0, (integer *)0, (integer *)0); - } - -/* Subroutine */ int dafnrr_(integer *reads, integer *reqs) -{ - return dafrwd_0_(5, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (doublereal *)0, (doublereal *)0, (logical *)0, reads, reqs); - } - diff --git a/ext/spice/src/cspice/daft2b.c b/ext/spice/src/cspice/daft2b.c deleted file mode 100644 index d1da3371b8..0000000000 --- a/ext/spice/src/cspice/daft2b.c +++ /dev/null @@ -1,815 +0,0 @@ -/* daft2b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__5 = 5; - -/* $Procedure DAFT2B ( DAF, text to binary ) */ -/* Subroutine */ int daft2b_(integer *text, char *binary, integer *resv, - ftnlen binary_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), - e_rsle(void), s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char * - , integer, char *, integer); - - /* Local variables */ - char name__[1000*2]; - integer more, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - char tarch[8]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer chunk, isize, lsize; - char ttype[8]; - extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), dafada_(doublereal *, integer *); - doublereal dc[125]; - extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, - ftnlen); - integer ic[250]; - extern /* Subroutine */ int dafena_(void); - integer nd; - extern logical failed_(void); - integer ni, handle; - extern /* Subroutine */ int dafcls_(integer *); - char ifname[60*2]; - extern /* Subroutine */ int dafopn_(char *, integer *, integer *, char *, - integer *, integer *, ftnlen, ftnlen); - doublereal buffer[1024]; - char idword[8]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - doublereal sum[125]; - - /* Fortran I/O blocks */ - static cilist io___5 = { 1, 0, 1, 0, 0 }; - static cilist io___6 = { 1, 0, 1, 0, 0 }; - static cilist io___13 = { 1, 0, 1, 0, 0 }; - static cilist io___15 = { 1, 0, 1, 0, 0 }; - static cilist io___17 = { 1, 0, 1, 0, 0 }; - static cilist io___20 = { 1, 0, 1, 0, 0 }; - static cilist io___23 = { 1, 0, 1, 0, 0 }; - static cilist io___25 = { 1, 0, 1, 0, 0 }; - static cilist io___27 = { 1, 0, 1, 0, 0 }; - static cilist io___28 = { 1, 0, 1, 0, 0 }; - static cilist io___29 = { 1, 0, 1, 0, 0 }; - static cilist io___30 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Reconstruct a binary DAF from a text file opened by */ -/* the calling program. (Obsolete, maintained for backward */ -/* compatibility only.) */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TEXT I Logical unit connected to text file. */ -/* BINARY I Name of a binary DAF to be created. */ -/* RESV I Number of records to reserve. */ -/* BSIZE P Buffer size. */ - -/* $ Detailed_Input */ - -/* TEXT is a logical unit number, to which a text file has */ -/* been connected by the calling program, and into */ -/* which the contents of binary DAF have been */ -/* written. The file pointer should be placed just */ -/* before the file ID word. */ - -/* BINARY is the name of a binary DAF to be created. */ -/* The binary DAF contains the same data as the */ -/* text file, but in a form more suitable for use */ -/* by application programs. */ - -/* RESV is the number of records to be reserved in the */ -/* binary DAF. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* BSIZE is the size of the buffer used to read array elements */ -/* from the text file. No single group of elements should */ -/* contains more than BSIZE elements. */ - -/* $ Files */ - -/* See arguments TEXT, BINARY. */ - -/* $ Exceptions */ - -/* 1) If for some reason the text file cannot be read, */ -/* the error SPICE(DAFREADFAIL) is signalled. */ - -/* 2) If the architecture of the file is not DAF, as specified by */ -/* the ID word, the error SPICE(NOTADAFFILE) will be signalled. */ - -/* 3) If the text file does not contain matching internal file */ -/* names, the error SPICE(DAFNOIFNMATCH) is signalled. */ - -/* 4) If the text file does not contain matching array names, */ -/* the error SPICE(DAFNONAMEMATCH) is signalled. */ - -/* 5) If the buffer size is not sufficient, the error */ -/* SPICE(DAFOVERFLOW) is signalled. */ - -/* $ Particulars */ - -/* This routine has been made obsolete by the new DAF text to binary */ -/* conversion routine DAFTB. This routine remains available for */ -/* reasons of backward compatibility. We strongly recommend that you */ -/* use the new conversion routines for any new software development. */ -/* Please see the header of the routine DAFTB for details. */ - -/* This routine is necessary for converting older DAF text files into */ -/* their equivalent binary formats, as DAFTB uses a different text */ -/* file format that is incompatible with the text file format */ -/* expected by this routine. */ - -/* Any binary DAF may be transferred between heterogeneous */ -/* Fortran environments by converting it to an equivalent file */ -/* containing only ASCII characters. Such a file can be transferred */ -/* almost universally, using any number of established protocols */ -/* (Kermit, FTP, and so on). Once transferred, the ASCII file can */ -/* be reconverted to a binary DAF, using the representations */ -/* native to the new host environment. */ - -/* There are two pairs of routines that can be used to convert */ -/* DAFs between binary and ASCII. The first pair, DAFB2A */ -/* and DAFA2B, works with complete files. That is, DAFB2A creates */ -/* a complete ASCII file containing all of the information in */ -/* a particular binary DAF, and nothing else; this file can */ -/* be fed directly into DAFA2B to produce a complete binary DAF. */ -/* In each case, the names of the files are specified. */ - -/* A related pair of routines, DAFB2T and DAFT2B, assume that */ -/* the ASCII data are to be stored in the midst of a text file. */ -/* This allows the calling program to surround the data with */ -/* standardized labels, to append several binary DAFs into a */ -/* single text file, and so on. */ - -/* Note that you must select the number of records to be reserved */ -/* in the binary DAF. The contents of reserved records are ignored */ -/* by the normal transfer process. */ - -/* $ Examples */ - -/* DAFB2A and DAFA2B are typically used for simple transfers. */ -/* If A.DAF is a binary DAF in environment 1, it can be transferred */ -/* to environment 2 in three steps. */ - -/* 1) Convert it to ASCII: */ - -/* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */ - -/* 2) Transfer the ASCII file, using FTP, Kermit, or some other */ -/* file transfer utility: */ - -/* ftp> put a.ascii */ - -/* 3) Convert it to binary on the new machine, */ - -/* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */ - -/* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */ -/* environment. */ - -/* If the file needs to contain other information---a standard */ -/* label, for instance---the first and third steps must be modified */ -/* to use DAFB2T and DAFT2B. The first step becomes */ - -/* (Open a text file) */ -/* (Write the label) */ -/* CALL DAFB2T ( BINARY, UNIT ) */ -/* (Close the text file) */ - -/* The third step becomes */ - -/* (Open the text file) */ -/* (Read the label) */ -/* CALL DAFT2B ( UNIT, BINARY, RESV ) */ -/* (Close the text file) */ - -/* $ Restrictions */ - -/* DAFT2B cannot be executed while any other DAF is open */ -/* for writing. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K. R. Gehringer (JPL) */ -/* J.E. McLean (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 04-OCT-1993 (KRG) */ - -/* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADAFFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* There were no checks of the IOSTAT variable after attempting to */ -/* read from the text file, a single test of the IOSTAT variable */ -/* was made at the end of the routine. This was not adequate to */ -/* detect errors when writing to the text file. So after all of */ -/* these read statements, an IF ... END IF block was added to */ -/* signal an error if IOSTAT .NE. 0. */ - -/* Added a statement to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFTB, and that we strongly recommend the use of */ -/* the new routine. This routine must, however, be used when */ -/* converting older text files to binary, as the old and new */ -/* formats are not compatible. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete and maintained for purposes of backward */ -/* compatibility only. */ - -/* - SPICELIB Version 2.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.1, 6-AUG-1990 (HAN) */ - -/* Header documentation was corrected. This routine will */ -/* convert a file containing either ID word, 'NAIF/DAF' or */ -/* 'NAIF/NIP'. (Previous versions of SPICELIB software used */ -/* the ID word 'NAIF/NIP'.) */ - -/* - SPICELIB Version 2.0.0, 2-AUG-1990 (JEM) */ - -/* The previous version of this routine always failed and */ -/* signalled the error SPICE(DAFNOIDWORD) because of a faulty */ -/* logical expression in an error-checking IF statement. */ -/* The error SPICE(DAFNOIDWORD) should be signalled if the */ -/* next non-blank line in the text file does not begin with the */ -/* word 'NAIF/DAF' AND does not begin with the word 'NAIF/NIP'. */ -/* Previously the logic was incorrect causing the error to be */ -/* signalled every time no matter what the word was. The */ -/* correction consisted of replacing '.OR.' with '.AND.' */ -/* in the logical expression. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* text daf to binary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 04-OCT-1993 (KRG) */ - -/* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADAFFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* There were no checks of the IOSTAT variable after attempting to */ -/* read from the text file, a single test of the IOSTAT variable */ -/* was made at the end of the routine. This was not adequate to */ -/* detect errors when writing to the text file. So after all of */ -/* these read statements, an IF ... END IF block was added to */ -/* signal an error if IOSTAT .NE. 0. */ - -/* IF ( IOSTAT .NE. 0 ) THEN */ - -/* CALL SETMSG ( 'The attempt to read from file ''#''' // */ -/* . ' failed. IOSTAT = #.' ) */ -/* CALL ERRFNM ( '#', UNIT ) */ -/* CALL SIGERR ( 'SPICE(DAFREADFAIL)' ) */ -/* CALL CHKOUT ( 'DAFT2B' ) */ -/* RETURN */ - -/* END IF */ - -/* Removed the code from the end of the routine that purported to */ -/* check for read errors: */ - -/* C */ -/* C If any read screws up, they should all screw up. Why */ -/* C make a billion separate checks? */ -/* C */ -/* IF ( IOSTAT .NE. 0 ) THEN */ -/* CALL SETMSG ( 'Value of IOSTAT was: #. ' ) */ -/* CALL ERRINT ( '#', IOSTAT ) */ -/* CALL SIGERR ( 'SPICE(DAFREADFAIL)' ) */ -/* END IF */ - -/* The answer to the question is: */ - -/* You have to do a billion separate checks because the IOSTAT */ -/* value is only valid for the most recently executed read. */ - -/* Added a statment to the $ Particulars section to the effect */ -/* that this routine has been made obsolete by the introduction of */ -/* the routine DAFTB, and that we strongly recommend the use of */ -/* the new routine. This routine must, however, be used when */ -/* converting older text files to binary, as the old and new */ -/* formats are not compatible. */ - -/* Modified the $ Abstract section to reflect the fact that this */ -/* routine is obsolete and maintained for purposes of backward */ -/* compatibility only. */ - -/* - SPICELIB Version 2.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.1, 6-AUG-1990 (HAN) */ - -/* Header documentation was corrected. This routine will */ -/* convert a file containing either ID word, 'NAIF/DAF' or */ -/* 'NAIF/NIP'. (Previous versions of SPICELIB software used */ -/* the ID word 'NAIF/NIP'.) */ - -/* - SPICELIB Version 2.0.0, 2-AUG-1990 (JEM) */ - -/* The previous version of this routine always failed and */ -/* signalled the error SPICE(DAFNOIDWORD) because of a faulty */ -/* logical expression in an error-checking IF statement. */ -/* The error SPICE(DAFNOIDWORD) should be signalled if the */ -/* next non-blank line in the text file does not begin with the */ -/* word 'NAIF/DAF' AND does not begin with the word 'NAIF/NIP'. */ -/* Previously the logic was incorrect causing the error to be */ -/* signalled every time no matter what the word was. The */ -/* correction consisted of replacing '.OR.' with '.AND.' */ -/* in the logical expression. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFT2B", (ftnlen)6); - } - s_copy(idword, " ", (ftnlen)8, (ftnlen)1); - s_copy(tarch, " ", (ftnlen)8, (ftnlen)1); - s_copy(ttype, " ", (ftnlen)8, (ftnlen)1); - -/* We should be positioned and ready to read the file ID word from */ -/* the text file, so let's try it. */ - - io___5.ciunit = *text; - iostat = s_rsle(&io___5); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsle(); -L100001: - if (iostat != 0) { - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - -/* Split the ID word into an architecture and type, and verify that */ -/* the architecture is 'DAF'. If it is not, this is the wrong */ -/* routine, and an error will be signalled. */ - - idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)8, (ftnlen)8); - if (s_cmp(tarch, "DAF", (ftnlen)8, (ftnlen)3) != 0) { - setmsg_("File architecture is not 'DAF' for file '#'", (ftnlen)43); - errfnm_("#", text, (ftnlen)1); - sigerr_("SPICE(NOTADAFFILE)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - io___6.ciunit = *text; - iostat = s_rsle(&io___6); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__3, &c__1, (char *)&nd, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__3, &c__1, (char *)&ni, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__9, &c__1, ifname, (ftnlen)60); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsle(); -L100002: - if (iostat != 0) { - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - -/* Open the new binary file. */ - - dafopn_(binary, &nd, &ni, ifname, resv, &handle, binary_len, (ftnlen)60); - if (failed_()) { - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - -/* Each array is preceded by a '1', which indicates that more */ -/* arrays are to come. The array itself begins with the name */ -/* and the summary components, and ends with the name again. */ -/* The contents are written in arbitrary chunks. The final */ -/* chunk is followed by a '0', which indicates that no chunks */ -/* remain. The names must match, or the array should not */ -/* be terminated normally. */ - -/* If the chunks in the file are bigger than the local buffer */ -/* size, we are in trouble. */ - - lsize = nd + (ni - 1) / 2 + 1; - isize = lsize << 3; - io___13.ciunit = *text; - iostat = s_rsle(&io___13); - if (iostat != 0) { - goto L100003; - } - iostat = do_lio(&c__3, &c__1, (char *)&more, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsle(); -L100003: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - while(more > 0) { - io___15.ciunit = *text; - iostat = s_rsle(&io___15); - if (iostat != 0) { - goto L100004; - } - iostat = do_lio(&c__9, &c__1, name__, isize); - if (iostat != 0) { - goto L100004; - } - iostat = e_rsle(); -L100004: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - io___17.ciunit = *text; - iostat = s_rsle(&io___17); - if (iostat != 0) { - goto L100005; - } - i__1 = nd; - for (i__ = 1; i__ <= i__1; ++i__) { - iostat = do_lio(&c__5, &c__1, (char *)&dc[(i__2 = i__ - 1) < 125 - && 0 <= i__2 ? i__2 : s_rnge("dc", i__2, "daft2b_", ( - ftnlen)517)], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100005; - } - } - iostat = e_rsle(); -L100005: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - io___20.ciunit = *text; - iostat = s_rsle(&io___20); - if (iostat != 0) { - goto L100006; - } - i__2 = ni - 2; - for (i__ = 1; i__ <= i__2; ++i__) { - iostat = do_lio(&c__3, &c__1, (char *)&ic[(i__1 = i__ - 1) < 250 - && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, "daft2b_", ( - ftnlen)532)], (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100006; - } - } - iostat = e_rsle(); -L100006: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - dafps_(&nd, &ni, dc, ic, sum); - dafbna_(&handle, sum, name__, isize); - if (failed_()) { - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - io___23.ciunit = *text; - iostat = s_rsle(&io___23); - if (iostat != 0) { - goto L100007; - } - iostat = do_lio(&c__3, &c__1, (char *)&chunk, (ftnlen)sizeof(integer)) - ; - if (iostat != 0) { - goto L100007; - } - iostat = e_rsle(); -L100007: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - while(chunk > 0) { - if (chunk > 1024) { - dafcls_(&handle); - setmsg_("Buffer size exceeded. Increase to #.", (ftnlen)36); - errint_("#", &chunk, (ftnlen)1); - sigerr_("SPICE(DAFOVERFLOW)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } else { - io___25.ciunit = *text; - iostat = s_rsle(&io___25); - if (iostat != 0) { - goto L100008; - } - i__1 = chunk; - for (i__ = 1; i__ <= i__1; ++i__) { - iostat = do_lio(&c__5, &c__1, (char *)&buffer[(i__2 = i__ - - 1) < 1024 && 0 <= i__2 ? i__2 : s_rnge("buffer", - i__2, "daft2b_", (ftnlen)585)], (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100008; - } - } - iostat = e_rsle(); -L100008: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTA" - "T = #.", (ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - dafada_(buffer, &chunk); - if (failed_()) { - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - } - io___27.ciunit = *text; - iostat = s_rsle(&io___27); - if (iostat != 0) { - goto L100009; - } - iostat = do_lio(&c__3, &c__1, (char *)&chunk, (ftnlen)sizeof( - integer)); - if (iostat != 0) { - goto L100009; - } - iostat = e_rsle(); -L100009: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = " - "#.", (ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - } - io___28.ciunit = *text; - iostat = s_rsle(&io___28); - if (iostat != 0) { - goto L100010; - } - iostat = do_lio(&c__9, &c__1, name__ + 1000, isize); - if (iostat != 0) { - goto L100010; - } - iostat = e_rsle(); -L100010: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - if (s_cmp(name__, name__ + 1000, isize, isize) != 0) { - dafcls_(&handle); - setmsg_("Array name mismatch: # and #.", (ftnlen)29); - errch_("#", name__, (ftnlen)1, isize); - errch_("#", name__ + 1000, (ftnlen)1, isize); - sigerr_("SPICE(DAFNONAMEMATCH)", (ftnlen)21); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } else { - dafena_(); - if (failed_()) { - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - } - io___29.ciunit = *text; - iostat = s_rsle(&io___29); - if (iostat != 0) { - goto L100011; - } - iostat = do_lio(&c__3, &c__1, (char *)&more, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100011; - } - iostat = e_rsle(); -L100011: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - } - -/* The final '0' indicates that no arrays remain. The first shall */ -/* be last: the internal file name brings up the rear. If it doesn't */ -/* match the one at the front, complain. */ - - io___30.ciunit = *text; - iostat = s_rsle(&io___30); - if (iostat != 0) { - goto L100012; - } - iostat = do_lio(&c__9, &c__1, ifname + 60, (ftnlen)60); - if (iostat != 0) { - goto L100012; - } - iostat = e_rsle(); -L100012: - if (iostat != 0) { - dafcls_(&handle); - setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( - ftnlen)53); - errfnm_("#", text, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - if (s_cmp(ifname, ifname + 60, (ftnlen)60, (ftnlen)60) != 0) { - dafcls_(&handle); - setmsg_("Internal file name mismatch: # and #", (ftnlen)36); - errch_("#", ifname, (ftnlen)1, (ftnlen)60); - errch_("#", ifname + 60, (ftnlen)1, (ftnlen)60); - sigerr_("SPICE(DAFNOIFNMATCH)", (ftnlen)20); - chkout_("DAFT2B", (ftnlen)6); - return 0; - } - -/* Close the DAF file we just created. */ - - dafcls_(&handle); - chkout_("DAFT2B", (ftnlen)6); - return 0; -} /* daft2b_ */ - diff --git a/ext/spice/src/cspice/daftb.c b/ext/spice/src/cspice/daftb.c deleted file mode 100644 index 6661f020d0..0000000000 --- a/ext/spice/src/cspice/daftb.c +++ /dev/null @@ -1,900 +0,0 @@ -/* daftb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__0 = 0; -static integer c__3 = 3; - -/* $Procedure DAFTB ( DAF, convert transfer file to binary file ) */ -/* Subroutine */ int daftb_(integer *xfrlun, char *binfil, ftnlen binfil_len) -{ - /* System generated locals */ - integer i__1; - cilist ci__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), - e_rsle(void), s_cmp(char *, char *, ftnlen, ftnlen), s_rsfe( - cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void); - - /* Local variables */ - char name__[1000]; - integer barr; - char line[255]; - integer bcnt, earr, ecnt; - logical more; - char word[255], rest[255]; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - char tarch[8]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - logical inarr; - char ttype[8]; - extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), dafada_(doublereal *, integer *), dafbna_( - integer *, doublereal *, char *, ftnlen), dafena_(void); - integer nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafcls_(integer *); - char ifname[60]; - integer binhdl; - extern /* Subroutine */ int rdencd_(integer *, integer *, doublereal *), - rdenci_(integer *, integer *, integer *), dafopn_(char *, integer - *, integer *, char *, integer *, integer *, ftnlen, ftnlen); - doublereal buffer[1024]; - integer dtacnt; - extern /* Subroutine */ int dafonw_(char *, char *, integer *, integer *, - char *, integer *, integer *, ftnlen, ftnlen, ftnlen); - char idword[8]; - integer arrcnt, numdta; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen); - integer snmlen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char errmsg[320]; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - integer iostat, numarr, numlft; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), nextwd_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - integer lftovr; - extern logical return_(void); - integer errptr; - doublereal dsumry[125]; - integer isumry[250]; - doublereal summry[125]; - - /* Fortran I/O blocks */ - static cilist io___5 = { 1, 0, 1, 0, 0 }; - static cilist io___9 = { 1, 0, 1, 0, 0 }; - static cilist io___27 = { 1, 0, 1, 0, 0 }; - static cilist io___32 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Convert the contents of an DAF transfer file into an equivalent */ -/* binary DAF file. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* XFRLUN I Logical unit of an open DAF transfer file. */ -/* BINFIL I Name of a binary DAF file to be created. */ - -/* $ Detailed_Input */ - -/* XFRLUN The Fortran logical unit number of a previously opened */ -/* DAF transfer file has been. */ - -/* The file pointer should be positioned ready to read */ -/* the file ID word. */ - -/* BINFIL The name of the binary DAF file to be created. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments XFRLUN, BINFIL. */ - -/* $ Exceptions */ - -/* 1) If the DAF transfer file cannot be read, the error */ -/* SPICE(FILEREADFAILED) will be signalled. */ - -/* 2) If the architecture of the file is not DAF, as specified by */ -/* the ID word, the error SPICE(NOTADAFFILE) will be signalled. */ - -/* 3) If an error occurs while attempting to decode data in the */ -/* DAF transfer file, the error SPICE(BADDAFTRANSFERFILE) will */ -/* be signalled. */ - -/* 4) If the DAF file cannot be written, a DAF file access routine */ -/* will signal an error with an appropriate error message. */ - -/* 5) The binary DAF file opened by this routine, BINFIL, is only */ -/* GUARANTEED to be closed upon successful completion of the */ -/* transfer file to binary file conversion process. In the event */ -/* of an error, the caller of this routine is required to close */ -/* the binary DAF file BINFIL. */ - -/* $ Particulars */ - -/* Any binary DAF file may be transferred between heterogeneous */ -/* Fortran environments by converting it to an equivalent file */ -/* containing only ASCII characters. Such a file can be transferred */ -/* almost universally, using any number of established protocols. */ -/* Once transferred, the ASCII file can be converted to a binary */ -/* file, using the representations native to the new host */ -/* environment. */ - -/* This routine provides a mechanism for converting an DAF transfer */ -/* file created by DAFBT, or an equivalent procedure, into an */ -/* equivalent binary DAF file which may be used with the SPICE */ -/* system. It is one of a pair of routines for performing conversions */ -/* between the binary format of a DAF file and the DAF transfer file. */ -/* The inverse of this routine is the routine DAFBT. */ - -/* This routine makes NO use of the DAF reserved record area. It */ -/* can only deal with the data portion of a DAF file in the DAF */ -/* transfer file. */ - -/* Upon successful completion, the binary DAF file specified by */ -/* BINFIL will have been created. The binary DAF file that was */ -/* created will be closed when this routine exits. The DAF transfer */ -/* file will remain open, as it was on entry, and it will be */ -/* positioned to read the first line after the encoded DAF file data. */ - -/* $ Examples */ - -/* Let */ - -/* XFRLUN be the Fortran logical unit attached to a DAF */ -/* transfer file which is to be converted into its binary */ -/* DAF equivalent. */ - -/* BINFIL be the name of the binary DAF file which will be */ -/* created from the DAF transfer file. */ - -/* The following subroutine call would read the DAF transfer file */ -/* attached to the Fortran logical unit XFRLUN, convert its data into */ -/* binary format, and write that data to the binary DAF file which */ -/* has been created: */ - -/* CALL DAFTB( XFRLUN, BINFIL ) */ - -/* $ Restrictions */ - -/* 1) This routine assumes that it is positioned ready to read the */ -/* file ID word from the DAF transfer file. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - SPICELIB Version 3.0.0, 25-JAN-1995 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name TXTLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* Changed the short error message from "BADDAFTEXTFILE" to */ -/* "BADDAFTRANSFERFILE". */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1993 (KRG) */ - -/* This routine was modified to incorporate the file ID word */ -/* changes which will allow run time identification of the type of */ -/* data in a SPICE binary file. */ - -/* Removed the error SPICE(IDWORDNOTKNOWN) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADAFFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* - SPICELIB Version 1.0.1, 24-JUN-1993 (KRG) */ - -/* Modified the description of the DAF encoded text file format */ -/* appearing before the program code. */ - -/* - SPICELIB Version 1.0.0, 02-NOV-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert daf transfer file to binary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 25-JAN-1995 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name TXTLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* Changed the short error message from "BADDAFTEXTFILE" to */ -/* "BADDAFTRANSFERFILE". */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1993 (KRG) */ - -/* This routine was modified to incorporate the file ID word */ -/* changes which will allow runtime identification of the type of */ -/* data in a binary file SPICE binary file. */ - -/* Removed the error SPICE(IDWORDNOTKNOWN) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADAFFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* - SPICELIB Version 1.0.1, 24-JUN-1993 (KRG) */ - -/* Modified the description of the DAF encoded text file format */ -/* appearing before the program code. Changed the line: */ - -/* C < DAF ND value > < DAF NI value > */ - -/* to the lines: */ - -/* C < DAF ND value > */ -/* C < DAF NI value > */ - -/* This change was necessary because the output format for the */ -/* low level routines which encode and write the data were */ -/* modified to fix a problem. See the routines WRENCD and WRENCI */ -/* for details of the modification. */ - -/* - SPICELIB Version 1.0.0, 29-OCT-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* Standard/ SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFTB", (ftnlen)5); - } - -/* A brief description of the DAF transfer file format and its */ -/* intended use follows. This description is intended to provide a */ -/* simple ``picture'' of the DAF transfer file format to aid in the */ -/* understanding of this routine. This description is NOT intended to */ -/* be a detailed specification of the file format. */ - -/* A DAF transfer file contains all of the data from a binary */ -/* DAF file, except for the reserved record area, in an encoded */ -/* ASCII format. The file also contains some bookkeeping information */ -/* for maintaining the integrity of the data. The DAF transfer file */ -/* format allows the full precision of both integer and floating */ -/* point numeric data to be maintained in a portable fashion. The DAF */ -/* transfer file format is intended to provide a reliable and */ -/* accurate means for porting data among multiple computer systems */ -/* and for the archival storage of data. */ - -/* A DAF transfer file is not intended to be used directly to */ -/* provide data to a program, the equivalent binary DAF file is */ -/* to be used for this purpose. In no way should any program, other */ -/* than a DAF binary <-> transfer conversion program, rely on the DAF */ -/* encoded transfer file format. */ - -/* To correctly understand the DAF transfer file description */ -/* the reader should be familiar with the DAF file architecture. */ -/* Items enclosed in angle brackets, '<' and '>', are used to */ -/* represent the data which is to be placed at that position in */ -/* the file. The bookkeeping information is represented exactly */ -/* as it would appear in a DAF transfer file. */ - -/* Let */ - -/* BOF denote the beginning of the file */ -/* EOF denote the end of the file */ - -/* and */ - -/* n denote the total number of arrays in a DAF file */ -/* NA(i) denote the number of double precision numbers in array i */ -/* m(i) denote the number of blocks of encoded data for array i */ -/* N(i,j) denote the number of encoded double precision numbers */ -/* in block j of array i */ - -/* and */ - -/* m(i) */ -/* ----- */ -/* \ */ -/* > N(i,k) = NA(i), i = 1, ..., n. */ -/* / */ -/* ----- */ -/* k=1 */ - -/* A DAF encoded transfer file has the following format: */ - -/* */ -/* < Information line > */ -/* < DAF file ID word > */ -/* < DAF ND value > */ -/* < DAF NI value > */ -/* < DAF internal file name > */ -/* BEGIN_ARRAY 1 NA(1) */ -/* < Name for array 1 > */ -/* < ND double precision summary values > */ -/* < NI-2 integer summary values > */ -/* N(1,1) */ -/* < N(1,1) Encoded double precision numbers > */ -/* N(1,2) */ -/* < N(1,2) Encoded double precision numbers > */ -/* . */ -/* . */ -/* . */ -/* N(1,m(1)) */ -/* < N(1,m(1)) Encoded double precision numbers > */ -/* END_ARRAY 1 NA(1) */ -/* BEGIN_ARRAY 2 NA(2) */ -/* < Name for array 2 > */ -/* < ND double precision summary values > */ -/* < NI-2 integer summary values > */ -/* N(2,1) */ -/* < N(2,1) Encoded double precision numbers > */ -/* N(2,2) */ -/* < N(2,2) Encoded double precision numbers > */ -/* . */ -/* . */ -/* . */ -/* N(2,m(2)) */ -/* < N(2,m(2)) Encoded double precision numbers > */ -/* END_ARRAY 2 NA(2) */ -/* . */ -/* . */ -/* . */ -/* BEGIN_ARRAY n NA(n) */ -/* < Name for array n > */ -/* < ND double precision summary values > */ -/* < NI-2 integer summary values > */ -/* N(n,1) */ -/* < N(n,1) Encoded double precision numbers > */ -/* N(n,2) */ -/* < N(n,2) Encoded double precision numbers > */ -/* . */ -/* . */ -/* . */ -/* N(n,m(n)) */ -/* < N(n,m(n)) Encoded double precision numbers > */ -/* END_ARRAY n NA(n) */ -/* TOTAL_ARRAYS n */ -/* */ - - -/* Initialize a few things. */ - - s_copy(tarch, " ", (ftnlen)8, (ftnlen)1); - s_copy(ttype, " ", (ftnlen)8, (ftnlen)1); - s_copy(idword, " ", (ftnlen)8, (ftnlen)1); - -/* We begin by reading the DAF file ID word from the DAF transfer */ -/* file. We should have been positioned ready to read this. If an */ -/* error occurs, set an appropriate error message and signal the */ -/* error. */ - - io___5.ciunit = *xfrlun; - iostat = s_rsle(&io___5); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsle(); -L100001: - if (iostat != 0) { - setmsg_("Error reading the file ID word from the DAF transfer file '" - "#'. IOSTAT = #.", (ftnlen)74); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Separate the ID word into its components and verify that we are */ -/* looking at a DAF transfer file. If we're not, then this routine */ -/* should not be used. */ - - idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)8, (ftnlen)8); - if (s_cmp(tarch, "DAF", (ftnlen)8, (ftnlen)3) != 0) { - setmsg_("File architecture is not 'DAF' for file '#'", (ftnlen)43); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(NOTADAFFILE)", (ftnlen)18); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* The file architecture is OK, but before we can open the binary */ -/* DAF, we need to get the summary format and the internal file name */ -/* from the DAF transfer file. We begin doing this here. */ - -/* Read in the ND and NI values for the DAF file. */ - - rdenci_(xfrlun, &c__2, isumry); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - nd = isumry[0]; - ni = isumry[1]; - -/* Read the internal filename for the DAF file. */ - - io___9.ciunit = *xfrlun; - iostat = s_rsle(&io___9); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__9, &c__1, ifname, (ftnlen)60); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsle(); -L100002: - if (iostat != 0) { - setmsg_("Error reading the internal filename from the DAF transfer f" - "ile '#'. IOSTAT = #.", (ftnlen)79); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Open a new binary DAF file. Call the proper open routine, */ -/* depending on whether it's a new file or an old file. */ - - if (s_cmp(ttype, "?", (ftnlen)8, (ftnlen)1) != 0) { - dafonw_(binfil, ttype, &nd, &ni, ifname, &c__0, &binhdl, binfil_len, ( - ftnlen)8, (ftnlen)60); - } else { - dafopn_(binfil, &nd, &ni, ifname, &c__0, &binhdl, binfil_len, (ftnlen) - 60); - } - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Calculate the length of the segment names. */ - - snmlen = nd + (ni + 1) / 2 << 3; - -/* Initialize a few things: the array counter and the data counter. */ - - arrcnt = 0; - dtacnt = 0; - -/* We currently have more to process. */ - - more = TRUE_; - -/* We are currently not processing an array. */ - - inarr = FALSE_; - -/* Begin converting the DAF transfer file into a binary DAF file */ -/* here. */ - - while(more) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - if (iostat != 0) { - setmsg_("Error reading from the DAF transfer file '#'. IOSTAT = " - "#.", (ftnlen)57); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* At this point, we should be beginning an array, ending an */ -/* array, or scanning for the total number of arrays. So look */ -/* for the appropriate keyword. */ - - nextwd_(line, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - if (s_cmp(word, "BEGIN_ARRAY", (ftnlen)255, (ftnlen)11) == 0) { - -/* Get the array number. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - nparsi_(word, &barr, errmsg, &errptr, (ftnlen)255, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("Begin array error, could not parse array number. Er" - "ror: # File: #", (ftnlen)65); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Parse the count of double precision numbers in the array. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - nparsi_(word, &bcnt, errmsg, &errptr, (ftnlen)255, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("Begin array error, could not parse the data count f" - "or array: #. Error: # File: #", (ftnlen)80); - errint_("#", &barr, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we are inside an array, so set the in */ -/* array flag, INARR, to .TRUE. and increment the array */ -/* counter. */ - - inarr = TRUE_; - ++arrcnt; - } else if (s_cmp(word, "END_ARRAY", (ftnlen)255, (ftnlen)9) == 0) { - -/* Get the array number. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - nparsi_(word, &earr, errmsg, &errptr, (ftnlen)255, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("End array error, could not parse array number. Erro" - "r: # File: #", (ftnlen)63); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Parse the count of double precision numbers in the array. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - nparsi_(word, &ecnt, errmsg, &errptr, (ftnlen)255, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("End array error, could not parse the data count for" - " array: #. Error: # File: #", (ftnlen)78); - errint_("#", &earr, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array numbers */ -/* match. If not, signal an appropriate error. */ - - if (earr != barr) { - setmsg_("Data array number mismatch: Beginning number: #; En" - "ding number: #. File: #", (ftnlen)74); - errint_("#", &barr, (ftnlen)1); - errint_("#", &earr, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array data counts */ -/* match. If not, signal an appropriate error. */ - - if (ecnt != bcnt) { - setmsg_("Data array count mismatch: Beginning count: #; Endi" - "ng count: #. File: #", (ftnlen)71); - errint_("#", &bcnt, (ftnlen)1); - errint_("#", &ecnt, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully ended the */ -/* processing of an array, so set the in array flag, INARR, */ -/* to .FALSE.. */ - - inarr = FALSE_; - } else if (s_cmp(word, "TOTAL_ARRAYS", (ftnlen)255, (ftnlen)12) == 0) - { - -/* We have the total arrays keyword to parse, so get */ -/* the total number of arrays processed. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - nparsi_(word, &numarr, errmsg, &errptr, (ftnlen)255, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("Array count error, could not parse the total number" - " of arrays: #. File: #", (ftnlen)73); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - if (arrcnt != numarr) { - setmsg_("The number of data arrays processed (#) was not equ" - "al to the number of data arrays placed in the DAF tr" - "ansfer file (#). File: #", (ftnlen)127); - errint_("#", &arrcnt, (ftnlen)1); - errint_("#", &numarr, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully processed the */ -/* entir data portion of the DAF transfer file, so there is */ -/* no more data. */ - - more = FALSE_; - } else { - setmsg_("Unknown keyword '#' encountered while processing the DA" - "F transfer file #.", (ftnlen)73); - errch_("#", word, (ftnlen)1, (ftnlen)255); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDAFTRANSFERFILE)", (ftnlen)25); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* If we have begun an array, then process it. Otherwise, we */ -/* have either ended an array or ended the file. */ - - if (inarr) { - dtacnt = 0; - io___27.ciunit = *xfrlun; - iostat = s_rsle(&io___27); - if (iostat != 0) { - goto L100004; - } - iostat = do_lio(&c__9, &c__1, name__, snmlen); - if (iostat != 0) { - goto L100004; - } - iostat = e_rsle(); -L100004: - if (iostat != 0) { - setmsg_("Error reading the array name from the DAF transfer " - "file #. IOSTAT = #.", (ftnlen)70); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Read in the double precision part of the summary. */ - - rdencd_(xfrlun, &nd, dsumry); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Read in the integer part of the summary. The beginning and */ -/* ending addresses, ISUMRY(NI-1) and ISUMRY(NI), for the */ -/* array are not known currently. They will be filled in when */ -/* the array is actually written to the DAF file. */ - - i__1 = ni - 2; - rdenci_(xfrlun, &i__1, isumry); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Pack the summary information into the DAF array summary. */ - - dafps_(&nd, &ni, dsumry, isumry, summry); - -/* Begin a new array in the binary DAF file. */ - - dafbna_(&binhdl, summry, name__, snmlen); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Read and decode the data in the current DAF array. */ - -/* First set the count of numbers yet to be decoded and placed */ -/* in the binary DAF file. */ - - numlft = bcnt; - while(numlft > 0) { - -/* First, read in the count of encoded numbers in the */ -/* current data block. */ - - io___32.ciunit = *xfrlun; - iostat = s_rsle(&io___32); - if (iostat != 0) { - goto L100005; - } - iostat = do_lio(&c__3, &c__1, (char *)&numdta, (ftnlen)sizeof( - integer)); - if (iostat != 0) { - goto L100005; - } - iostat = e_rsle(); -L100005: - if (iostat != 0) { - setmsg_("Error reading array data from the DAF transfer " - "file #. IOSTAT = #.", (ftnlen)66); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Now read and decode the data in the current data block, */ -/* placing the data in the current array in the binary DAF */ -/* file. */ - - lftovr = numdta; - while(lftovr > 0) { - if (lftovr >= 1024) { - numdta = 1024; - } else { - numdta = lftovr; - } - -/* Read and decode a buffer of encoded double precision */ -/* data from the DAF transfer file. */ - - rdencd_(xfrlun, &numdta, buffer); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Write the double precision data to the current array */ -/* in the binary DAF file. */ - - dafada_(buffer, &numdta); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - -/* Decrement the counters for the amount of data */ -/* remaining to be moved from the current data block, */ -/* LFTOVR, and the current array, NUMLFT. */ - - lftovr -= numdta; - numlft -= numdta; - -/* Increment the counter for the amount of data that */ -/* has been successfully moved into the current array */ -/* in the binary DAF file. */ - - dtacnt += numdta; - } - -/* At this point, we have either finished reading in the */ -/* entire array, or we have just completed reading the */ -/* current encoded block of data for the current array */ -/* from the DAF transfer file. */ - - } - -/* If we got to here, we have successfully written an array */ -/* to the binary file, so we need to end it. */ - - dafena_(); - if (failed_()) { - chkout_("DAFTB", (ftnlen)5); - return 0; - } - } - } - -/* Close only the binary file. */ - - dafcls_(&binhdl); - chkout_("DAFTB", (ftnlen)5); - return 0; -} /* daftb_ */ - diff --git a/ext/spice/src/cspice/dafus_c.c b/ext/spice/src/cspice/dafus_c.c deleted file mode 100644 index 6588494852..0000000000 --- a/ext/spice/src/cspice/dafus_c.c +++ /dev/null @@ -1,197 +0,0 @@ -/* - --Procedure dafus_c ( DAF, unpack summary ) - --Abstract - - Unpack an array summary into its double precision and integer - components. - --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 - - DAF - --Keywords - - CONVERSION - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef dafus_c - - - void dafus_c ( ConstSpiceDouble sum [], - SpiceInt nd, - SpiceInt ni, - SpiceDouble dc [], - SpiceInt ic [] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sum I Array summary. - nd I Number of double precision components. - ni I Number of integer components. - dc O Double precision components. - ic O Integer components. - --Detailed_Input - - sum is an array summary. This identifies the contents and - location of a single array within a DAF. - - nd is the number of double precision components in - the summary. - - ni is the number of integer components in the summary. - --Detailed_Output - - dc are the double precision components of the summary. - - ic are the integer components of the summary. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - 1) If nd is zero or negative, no double precision components - are returned. - - 2) If ni is zero or negative, no integer components are returned. - - 3) If the total size of the summary is greater than 125 double - precision words, some components may not be returned. - --Particulars - - The components of array summaries are packed into double - precision arrays for reasons outlined in [1]. Two routines, - DAFPS (pack summary) and dafus_c (unpack summary) are provided - for packing and unpacking summaries. - - The total size of the summary is - - (ni - 1) - nd + -------- + 1 - 2 - - double precision words (where nd, ni are nonnegative). - --Examples - - - In the following code fragment, dafopr_c is used to open a file, - which is then searched for DAFs containing data for a particular - object. dafus_c is used to unpack the summaries so the applicability - of the segments can be determined. - - - #include "SpiceUsr.h" - . - . - . - dafopr_c ( fname, &handle ); - dafbfs_c ( handle ); - - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( sum ); - dafus_c ( sum, ND, NI, dc, ic ); - - if ( ic[0] == target_object ) - { - . - . - . - } - - daffna_c ( &found ); - } - - --Restrictions - - None. - --Literature_References - - NAIF Document 167.0, "Double Precision Array Files (DAF) - Specification and User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 01-AUG-1999 (NJB), (IMU) - --Index_Entries - - unpack daf summary - --& -*/ - -{ /* Begin dafus_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dafus_c" ); - - - dafus_ ( ( doublereal * ) sum, - ( integer * ) &nd, - ( integer * ) &ni, - ( doublereal * ) dc, - ( integer * ) ic ); - - - chkout_c ( "dafus_c" ); - -} /* End dafus_c */ diff --git a/ext/spice/src/cspice/dafwcr.c b/ext/spice/src/cspice/dafwcr.c deleted file mode 100644 index 4685c51045..0000000000 --- a/ext/spice/src/cspice/dafwcr.c +++ /dev/null @@ -1,240 +0,0 @@ -/* dafwcr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure DAFWCR ( DAF, write character record ) */ -/* Subroutine */ int dafwcr_(integer *handle, integer *recno, char *crec, - ftnlen crec_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_wdue(cilist *), do_uio(integer *, char *, - ftnlen), e_wdue(void); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen), chkin_(char *, ftnlen), dafsih_(integer *, - char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___3 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Write or rewrite the contents of a character record to */ -/* a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAF. */ -/* RECNO I Record number of character record. */ -/* CREC I Character record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF. */ - -/* RECNO is the record number of a character record within */ -/* the file. If the record does not already exist, it */ -/* is created. Otherwise its contents are overwritten. */ - -/* CREC contains the first 1000 characters of the specified */ -/* record. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified file is not open for write access, an error */ -/* is signaled by routines in the call tree of this routine. */ - -/* 2) If the declared length of CREC is not 1000 characters, */ -/* the error SPICE(DAFBADRECLEN) is signaled. */ - -/* 2) If the specified record cannot (for some reason) be written, */ -/* the error SPICE(DAFWRITEFAIL) is signaled. */ - -/* $ Particulars */ - -/* Unlike double precision records, character records are */ -/* not buffered. */ - -/* $ Examples */ - -/* In the following example, matching summary and name records are */ -/* written to a DAF: */ - -/* CALL DAFWDR ( HANDLE, NEXT, DREC ) */ -/* CALL DAFWCR ( HANDLE, NEXT+1, CREC ) */ - -/* Note that a character record always immediately follows a summary */ -/* record. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 27-NOV-2001 (FST) */ - -/* Updated this routine to utilize new handle manager */ -/* interfaces. Replaced the check of the input handle's */ -/* sign with the appropriate call to DAFSIH. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write daf character record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 27-NOV-2001 (FST) */ - -/* The call to DAFHLU has been replaced with a call to */ -/* ZZDDHHLU, the handle manager interface for retrieving */ -/* a logical unit. DAFHLU is no longer used, since it */ -/* locks the unit returned to its HANDLE, tying up resources */ -/* in the handle manager. A call to DAFSIH was inserted to */ -/* make certain that HANDLE is present in DAFAH's file table, */ -/* rather than simply checking the sign of HANDLE. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFWCR", (ftnlen)6); - } - zzddhhlu_(handle, "DAF", &c_false, &unit, (ftnlen)3); - -/* Look out for */ - -/* -- Writing to a file that is open for read-only. */ - -/* -- Trying to write a record that doesn't have length 1000. */ - -/* -- Failed write. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (i_len(crec, crec_len) != 1000) { - setmsg_("Expected length of character record is 1000. Length of pass" - "ed record is #", (ftnlen)73); - i__1 = i_len(crec, crec_len); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(DAFBADCRECLEN)", (ftnlen)20); - } else { - io___3.ciunit = unit; - io___3.cirec = *recno; - iostat = s_wdue(&io___3); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, crec, crec_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_wdue(); -L100001: - if (iostat != 0) { - setmsg_("Character record write failed. Value of IOSTAT was #", ( - ftnlen)52); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - } - } - chkout_("DAFWCR", (ftnlen)6); - return 0; -} /* dafwcr_ */ - diff --git a/ext/spice/src/cspice/dafwda.c b/ext/spice/src/cspice/dafwda.c deleted file mode 100644 index df94958fce..0000000000 --- a/ext/spice/src/cspice/dafwda.c +++ /dev/null @@ -1,262 +0,0 @@ -/* dafwda.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure DAFWDA ( DAF, write data to address ) */ -/* Subroutine */ int dafwda_(integer *handle, integer *begin, integer *end, - doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer begr, begw, endr, endw, next, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - logical found; - integer first; - extern /* Subroutine */ int cleard_(integer *, doublereal *), dafrdr_( - integer *, integer *, integer *, integer *, doublereal *, logical - *), dafarw_(integer *, integer *, integer *), dafwdr_(integer *, - integer *, doublereal *); - doublereal buffer[128]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Write or rewrite the double precision data bounded by two */ -/* addresses within a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF. */ -/* BEGIN, */ -/* END I Initial, final address within file. */ -/* DATA I Data to be stored between BEGIN and END. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF. */ - -/* BEGIN, */ -/* END are the initial and final addresses of a contiguous */ -/* set of double precision numbers within a DAF. */ -/* Presumably, these make up all or part of a */ -/* particular array. */ - -/* DATA are the double precision data to be stored between */ -/* the specified addresses within the specified file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If BEGIN is zero or negative, the error SPICE(DAFNEGADDR) */ -/* is signalled. */ - -/* 1) If the BEGIN > END, the error SPICE(DAFBEGGTEND) */ -/* is signalled. */ - -/* $ Particulars */ - -/* The principal reason that DAFs are so easy to use is that */ -/* the data in each DAF are considered to be one long contiguous */ -/* set of double precision numbers. You can store data anywhere */ -/* within a DAF without knowing (or caring) about the physical */ -/* records in which they are stored. */ - -/* Of course, if you are merely adding arrays to a DAF, */ -/* you should not use DAFWDA directly, but should use DAFANA */ -/* (add new array) and its entry points, since these update */ -/* the appropriate bookkeeping records automatically. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of DAFWDA */ -/* to update an imaginary array. The array begins with a directory */ -/* containing 11 epochs. Each pair of epochs bounds an */ -/* interval, and each interval is covered by a set of eight */ -/* osculating elements. */ - -/* By accident, the elements were written with the wrong value for */ -/* the GM of the central body (the last element in each set). Each */ -/* set must be retrieved, updated,and rewritten. */ - -/* CALL DAFUS ( SUM, ND, NI, DC, IC ) */ -/* BEGIN = IC(5) */ - -/* DO I = 1, 10 */ -/* OFFSET = BEGIN + 11 + (I - 1) * 8 */ - -/* CALL DAFRDA ( HANDLE, OFFSET+1, OFFSET+8, ELEMENTS ) */ -/* ELEMENTS(8) = NEW_GM */ - -/* CALL DAFWDA ( HANDLE, OFFSET+1, OFFSET+8, ELEMENTS ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write data to daf address */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFWDA", (ftnlen)6); - } - -/* Bad addresses? */ - - if (*begin <= 0) { - setmsg_("Negative beginning address: #", (ftnlen)29); - errint_("#", begin, (ftnlen)1); - sigerr_("SPICE(DAFNEGADDR)", (ftnlen)17); - chkout_("DAFWDA", (ftnlen)6); - return 0; - } else if (*begin > *end) { - setmsg_("Beginning address (#) greater than ending address (#)", ( - ftnlen)53); - errint_("#", begin, (ftnlen)1); - errint_("#", end, (ftnlen)1); - sigerr_("SPICE(DAFBEGGTEND)", (ftnlen)18); - chkout_("DAFWDA", (ftnlen)6); - return 0; - } - -/* Convert raw addresses to record/word representations. */ - - dafarw_(begin, &begr, &begw); - dafarw_(end, &endr, &endw); - -/* The first and last records may have to be read, updated, and */ -/* rewritten. Any records in between may be written directly. */ - - next = 1; - i__1 = endr; - for (recno = begr; recno <= i__1; ++recno) { - if (recno == begr || recno == endr) { - dafrdr_(handle, &recno, &c__1, &c__128, buffer, &found); - if (! found) { - cleard_(&c__128, buffer); - } - } - if (begr == endr) { - first = begw; - n = endw - begw + 1; - } else if (recno == begr) { - first = begw; - n = 128 - begw + 1; - } else if (recno == endr) { - first = 1; - n = endw; - } else { - first = 1; - n = 128; - } - moved_(&data[next - 1], &n, &buffer[(i__2 = first - 1) < 128 && 0 <= - i__2 ? i__2 : s_rnge("buffer", i__2, "dafwda_", (ftnlen)258)]) - ; - next += n; - dafwdr_(handle, &recno, buffer); - } - chkout_("DAFWDA", (ftnlen)6); - return 0; -} /* dafwda_ */ - diff --git a/ext/spice/src/cspice/dafwfr.c b/ext/spice/src/cspice/dafwfr.c deleted file mode 100644 index c57be627b9..0000000000 --- a/ext/spice/src/cspice/dafwfr.c +++ /dev/null @@ -1,478 +0,0 @@ -/* dafwfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure DAFWFR ( DAF write file record ) */ -/* Subroutine */ int dafwfr_(integer *handle, integer *nd, integer *ni, char * - ifname, integer *fward, integer *bward, integer *free, ftnlen - ifname_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - char tail[928]; - integer unit; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen), chkin_(char *, ftnlen); - integer locnd, locni; - extern logical failed_(void); - integer locffa; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char locifn[60]; - integer locfdr, locldr; - char format[8], idword[8]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - char ifn[60]; - - /* Fortran I/O blocks */ - static cilist io___4 = { 1, 0, 1, 0, 1 }; - static cilist io___14 = { 1, 0, 0, 0, 1 }; - - -/* $ Abstract */ - -/* Write or rewrite the contents of the file record of a DAF. */ - -/* $ 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 */ - -/* DAF */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open DAF file. */ -/* ND I Number of double precision components in summaries. */ -/* ND I Number of integer components in summaries. */ -/* IFNAME I Internal filename. */ -/* FWARD I Forward list pointer. */ -/* BWARD I Backward list pointer. */ -/* FREE I Free address pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with a DAF file opened for */ -/* writing. */ - -/* ND, */ -/* NI are the numbers of double precision and integer */ -/* components, respectively, in each array summary */ -/* in the specified file. */ - -/* IFNAME is the internal file name to be stored in the first */ -/* (or file) record of the specified file. */ - -/* FWARD is the forward list pointer. This points to the */ -/* first summary record in the file. */ - -/* BWARD is the backward list pointer. This points to the */ -/* final summary record in the file. */ - -/* FREE is the free address pointer. This contains the */ -/* first free address in the file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the handle passed to this routine is not the handle of an */ -/* open DAF file, the error will be signaled by a routine called */ -/* by this routine. */ - -/* 2) If the specified DAF file is not open for write access, the */ -/* error will be diagnosed by a routine called by this routine. */ - -/* 3) If the file record cannot (for some reason) be written, */ -/* the error SPICE(DAFWRITEFAIL) is signaled. */ - -/* 4) If the attempt to read the file record fails, the error */ -/* SPICE(DAFREADFAIL) will be signaled. */ - -/* $ Particulars */ - -/* The file record of a DAF is the only record that contains */ -/* any global information about the file. This record is created */ -/* when the file is created, and is updated only when new arrays */ -/* are added. */ - -/* DO NOT CHANGE THE CONTENTS OF THE FILE RECORD UNLESS */ -/* YOU ARE ABSOLUTELY SURE YOU KNOW WHAT YOU ARE DOING. */ - -/* Like character records, file records are not buffered. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 167.0, "Double Precision Array Files (DAF) */ -/* Specification and User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 27-NOV-2001 (FST) */ - -/* Updated this routine to utilize new handle manager */ -/* interfaces. Comments were expanded and clarified. */ - -/* - SPICELIB Version 3.0.0, 21-MAR-1999 (FST) */ - -/* This routine was modified to accomodate the preservation */ -/* of the FTP validation and binary file format strings that */ -/* are now part of the DAF file record. */ - -/* - SPICELIB Version 2.0.0, 05-OCT-1993 (KRG) */ - -/* The error SPICE(DAFNOIDWORD) is no longer signalled by this */ -/* routine. The reason for this is that if DAFSIH returns OK then */ -/* the handle passed to this routine is indeed a valid DAF file */ -/* handle, otherwise the error is diagnosed by DAFSIH. */ - -/* Added two new exceptions to the $ Exceptions section: 1 and 4. */ -/* The remaining exceptions (2 and 3) were already present. The */ -/* exceptions that were added are not new, but are being */ -/* documented for the first time. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write daf file record */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 27-NOV-2001 (FST) */ - -/* The call to DAFHLU has been replaced with a call to */ -/* ZZDDHHLU, the handle manager interface for retrieving */ -/* a logical unit. DAFHLU is no longer used, since it */ -/* locks the unit returned to its HANDLE, tying up resources */ -/* in the handle manager. */ - -/* - SPICELIB Version 3.0.0, 21-MAR-1999 (FST) */ - -/* In order to preserve the additional information that */ -/* now resides in the file record, this routine reads */ -/* the entire record into local buffers, including the */ -/* TAILEN characters that follow the actual data content. */ -/* The contents of the local buffers that correspond to */ -/* information brought in from the call sequence of the */ -/* routine are ignored when the record is rewritten. */ -/* However, the ID word, the file format string, and the */ -/* trailing TAILEN characters that contain the FTP validation */ -/* string are rewritten along with the input values. */ - -/* This routine does not simply replace the FTP validation */ -/* string with the components from ZZFTPSTR, since that */ -/* would possibly validate a corrupt file created using a newer */ -/* Toolkit. */ - -/* - SPICELIB Version 2.0.0, 05-OCT-1993 (KRG) */ - -/* The error SPICE(DAFNOIDWORD) is no longer signalled by this */ -/* routine. The reason for this is that if DAFSIH returns OK then */ -/* the handle passed to this routine is indeed a valid DAF file */ -/* handle, otherwise the error is diagnosed by DAFSIH. */ - -/* Added a call to DAFSIH to signal an invalid handle and a test */ -/* of FAILED () after it. This is to make sure that the DAF file */ -/* is open for writing. If this call succeeds, we know that we */ -/* have a valid DAF handle, so there is no need to check FAILED */ -/* after the call to DAFHLU. */ - -/* Added code to read the file ID word so that it could be */ -/* preserved when the file record is written. This supports the ID */ -/* word format that contains type information. */ - -/* Added variable IDWORD to the routine, as well as the parameters */ -/* IDWLEN and IFNLEN. */ - -/* Added two new exceptions to the $ Exceptions section: 1 and 4. */ -/* The remaining exceptions (2 and 3) were already present. The */ -/* exceptions that were added are not new, but are being */ -/* documented for the first time. */ - -/* Removed code that tested the sign of HANDLE to see if the file */ -/* was open for write access, HANDLE < 0. This test was no longer */ -/* necessary, as the call to DASSIH performs this test as well. No */ -/* sense doing it twice. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* The parameter TAILEN determines the tail length of a DAF file */ -/* record. This is the number of bytes (characters) that */ -/* occupy the portion of the file record that follows the */ -/* integer holding the first free address. For environments */ -/* with a 32 bit word length, 1 byte characters, and DAF */ -/* record sizes of 1024 bytes, we have: */ - -/* 8 bytes - IDWORD */ -/* 4 bytes - ND (32 bit integer) */ -/* 4 bytes - NI (32 bit integer) */ -/* 60 bytes - IFNAME */ -/* 4 bytes - FWARD (32 bit integer) */ -/* 4 bytes - BWARD (32 bit integer) */ -/* + 4 bytes - FREE (32 bit integer) */ -/* --------- */ -/* 88 bytes - (All file records utilize this space.) */ - -/* So the size of the remaining portion (or tail) of the DAF */ -/* file record for computing enviroments as described above */ -/* would be: */ - -/* 1024 bytes - DAF record size */ -/* - 8 bytes - DAF Binary File Format Word */ -/* - 88 bytes - (from above) */ -/* ------------ */ -/* 928 bytes - DAF file record tail length */ - -/* Note: environments that do not have a 32 bit word length, */ -/* 1 byte characters, and a DAF record size of 1024 bytes, will */ -/* require the adjustment of this parameter. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFWFR", (ftnlen)6); - } - -/* Do some initializations */ - - s_copy(idword, " ", (ftnlen)8, (ftnlen)1); - -/* Check to be sure that HANDLE is attached to a file that is open */ -/* with write access. If the call fails, check out and return. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFWFR", (ftnlen)6); - return 0; - } - -/* Get the logical unit for the file, as we know we have a valid DAF */ -/* handle with the correct access method. */ - - zzddhhlu_(handle, "DAF", &c_false, &unit, (ftnlen)3); - if (failed_()) { - chkout_("DAFWFR", (ftnlen)6); - return 0; - } - -/* In order to maintain the integrity of the file ID word, the */ -/* file FORMAT, and the FTP string if present, we need to */ -/* read the entire file record into the appropriate sized local */ -/* buffers. The values of the LOCxxx variables are simply */ -/* ignored, since the caller passes new values in for updates. */ - - io___4.ciunit = unit; - iostat = s_rdue(&io___4); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locnd, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locni, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locfdr, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locldr, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locffa, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, format, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, tail, (ftnlen)928); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Attempt to read the file record failed for file '#'. IOSTAT" - " = #", (ftnlen)63); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); - chkout_("DAFWFR", (ftnlen)6); - return 0; - } - -/* Set the value of the internal filename before writing. This is to */ -/* guarantee that its length is ok. */ - - s_copy(ifn, ifname, (ftnlen)60, ifname_len); - io___14.ciunit = unit; - iostat = s_wdue(&io___14); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*nd), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*ni), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, ifn, (ftnlen)60); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*fward), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*bward), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*free), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, format, (ftnlen)8); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, tail, (ftnlen)928); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - setmsg_("File record write failed. Value of IOSTAT was #", (ftnlen)47) - ; - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("DAFWFR", (ftnlen)6); - return 0; - } - chkout_("DAFWFR", (ftnlen)6); - return 0; -} /* dafwfr_ */ - diff --git a/ext/spice/src/cspice/dasa2l.c b/ext/spice/src/cspice/dasa2l.c deleted file mode 100644 index 7de3607f56..0000000000 --- a/ext/spice/src/cspice/dasa2l.c +++ /dev/null @@ -1,1042 +0,0 @@ -/* dasa2l.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__256 = 256; - -/* $Procedure DASA2L ( DAS, address to physical location ) */ -/* Subroutine */ int dasa2l_(integer *handle, integer *type__, integer * - addrss, integer *clbase, integer *clsize, integer *recno, integer * - wordno) -{ - /* Initialized data */ - - static integer next[3] = { 2,3,1 }; - static integer prev[3] = { 3,1,2 }; - static integer nw[3] = { 1024,128,256 }; - static integer rngloc[3] = { 3,5,7 }; - static logical first = TRUE_; - static integer nfiles = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - static integer free, nrec, fidx; - static logical fast; - static integer unit, i__, range[2], tbhan[20]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer ncomc, ncomr, ndirs; - static logical known; - static integer hiaddr; - extern /* Subroutine */ int dasham_(integer *, char *, ftnlen); - static integer tbbase[60] /* was [3][20] */; - static char access[10]; - static integer dscloc, dirrec[256]; - extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - static logical samfil; - static integer mxaddr; - extern integer isrchi_(integer *, integer *, integer *); - static integer tbmxad[60] /* was [3][20] */; - static logical tbfast[20]; - static integer mxclrc; - extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, - integer *, ftnlen); - static integer lstrec[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer prvhan; - extern /* Subroutine */ int chkout_(char *, ftnlen); - static integer nresvc, tbsize[60] /* was [3][20] */, nxtrec; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), dasrri_(integer *, integer *, integer *, - integer *, integer *); - static logical rdonly; - static integer lstwrd[3], nresvr, ntypes, curtyp, prvtyp; - -/* $ Abstract */ - -/* Map a DAS address to a physical location in the DAS file */ -/* it refers to. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* TRANSFORMATION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* TYPE I Data type specifier. */ -/* ADDRSS I DAS address of a word of data type TYPE. */ -/* CLBASE, */ -/* CLSIZE O Cluster base record number and size. */ -/* RECNO, */ -/* WORDNO O Record/word pair corresponding to ADDRSS. */ -/* CHAR P Parameter indicating character data type. */ -/* DP P Parameter indicating double precision data type. */ -/* INT P Parameter indicating integer data type. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an open DAS file. */ - -/* TYPE is a data type specifier. TYPE may be any of */ -/* the parameters */ - -/* CHAR */ -/* DP */ -/* INT */ - -/* which indicate `character', `double precision', */ -/* and `integer' respectively. */ - - -/* ADDRSS is the address in a DAS of a word of data */ -/* type TYPE. For each data type (double precision, */ -/* integer, or character), addresses range */ -/* from 1 to the maximum current value for that type, */ -/* which is available from DAFRFR. */ - -/* $ Detailed_Output */ - -/* CLBASE, */ -/* CLSIZE are, respectively, the base record number and */ -/* size, in records, of the cluster containing the */ -/* word corresponding to ADDRSS. The cluster spans */ -/* records numbered CLBASE through CLBASE + */ -/* CLSIZE - 1. */ - -/* RECNO, */ -/* WORD are, respectively, the number of the physical */ -/* record and the number of the word within the */ -/* record that correspond to ADDRSS. Word numbers */ -/* start at 1 and go up to NC, ND, or NI in */ -/* character, double precision, or integer records */ -/* respectively. */ - -/* $ Parameters */ - -/* CHAR, */ -/* DP, */ -/* INT are data type specifiers which indicate */ -/* `character', `double precision', and `integer' */ -/* respectively. These parameters are used in */ -/* all DAS routines that require a data type */ -/* specifier as input. */ - -/* $ Exceptions */ - -/* 1) If TYPE is not recognized, the error SPICE(DASINVALIDTYPE) */ -/* will be signalled. */ - -/* 2) ADDRSS must be between 1 and LAST inclusive, where LAST */ -/* is last address in the DAS for a word of the specified */ -/* type. If ADDRSS is out of range, the error */ -/* SPICE(DASNOSUCHADDRESS) will be signalled. */ - -/* 3) If this routine fails to find directory information for */ -/* the input address, the error SPICE(NOSUCHRECORD) will be */ -/* signalled. */ - -/* 4) If the input handle is invalid, the error will be diagnosed */ -/* by routines called by this routine. */ - - -/* If any of the above exceptions occur, the output arguments may */ -/* contain bogus information. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* The DAS architecture allows a programmer to think of the data */ -/* within a DAS file as three one-dimensional arrays: one of */ -/* double precision numbers, one of integers, and one of characters. */ -/* This model allows a programmer to ask the DAS system for the */ -/* `nth double precision number (or integer, or character) in the */ -/* file'. */ - -/* DAS files are Fortran direct access files, so to find the */ -/* `nth double precision number', you must have the number of the */ -/* record containing it and the `word number', or position, within */ -/* the record of the double precision number. This routine finds */ -/* the record/word number pair that specify the physical location */ -/* in a DAS file corresponding to a DAS address. */ - -/* As opposed to DAFs, the mapping of addresses to physical locations */ -/* for a DAS file depends on the organization of data in the file. */ -/* Given a fixed set of DAS format parameters, the physical location */ -/* of the nth double precision number can depend on how many integer */ -/* and character records have been written prior to the record */ -/* containing that double precision number. */ - -/* The cluster information output from this routine allows the */ -/* caller to substantially reduce the number of directory reads */ -/* required to read a from range of addresses that spans */ -/* multiple physical records; the reading program only need call */ -/* this routine once per cluster read, rather than once per */ -/* physical record read. */ - -/* $ Examples */ - -/* 1) Use this routine to read integers from a range of */ -/* addresses. This is done in the routine DASRDI. */ - -/* C */ -/* C Decide how many integers to read. */ -/* C */ -/* NUMINT = LAST - FIRST + 1 */ -/* NREAD = 0 */ - -/* C */ -/* C Find out the physical location of the first */ -/* C integer. If FIRST is invalid, DASA2L will take care */ -/* C of the problem. */ -/* C */ - -/* CALL DASA2L ( HANDLE, INT, FIRST, */ -/* . CLBASE, CLSIZE, RECNO, WORDNO ) */ - -/* C */ -/* C Read as much data from record RECNO as necessary. */ -/* C */ -/* N = MIN ( NUMINT, NWI - WORDNO + 1 ) */ - -/* CALL DASRRI ( HANDLE, RECNO, WORDNO, WORDNO + N-1, */ -/* . DATA ) */ - -/* NREAD = N */ -/* RECNO = RECNO + 1 */ - -/* C */ -/* C Read from as many additional records as necessary. */ -/* C */ -/* DO WHILE ( NREAD .LT. NUMINT ) */ -/* C */ -/* C At this point, RECNO is the correct number of the */ -/* C record to read from next. CLBASE is the number */ -/* C of the first record of the cluster we're about */ -/* C to read from. */ -/* C */ - -/* IF ( RECNO .LT. ( CLBASE + CLSIZE ) ) THEN */ -/* C */ -/* C We can continue reading from the current */ -/* C cluster. */ -/* C */ -/* N = MIN ( NUMINT - NREAD, NWI ) */ - -/* CALL DASRRI ( HANDLE, */ -/* . RECNO, */ -/* . 1, */ -/* . N, */ -/* . DATA ( NREAD + 1 ) ) */ - -/* NREAD = NREAD + N */ -/* RECNO = RECNO + 1 */ - - -/* ELSE */ -/* C */ -/* C We must find the next integer cluster to */ -/* C read from. The first integer in this */ -/* C cluster has address FIRST + NREAD. */ -/* C */ -/* CALL DASA2L ( HANDLE, */ -/* . INT, */ -/* . FIRST + NREAD, */ -/* . CLBASE, */ -/* . CLSIZE, */ -/* . RECNO, */ -/* . WORDNO ) */ - -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1 20-NOV-2001 (NJB) */ - -/* Comment fix: diagram showing directory record pointers */ -/* incorrectly showed element 2 of the record as a backward */ -/* pointer. The element is actually a forward pointer. */ - -/* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */ - -/* Bug fix: calculation to determine whether file is segregated */ -/* has been fixed. */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ - -/* Re-written to optimize address calculations for segregated, */ -/* read-only files. */ - -/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ - -/* Fixed a typo in the $ Brief_I/O section of the header. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* map DAS logical address to physical location */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */ - -/* Bug fix: calculation to determine whether file is segregated */ -/* has been fixed. An incorrect variable name used in a bound */ -/* calculation resulted in an incorrect determination of whether */ -/* a file was segregated, and caused arithmetic overflow for */ -/* files with large maximum addresses. */ - -/* In the previous version, the number of DAS words in a cluster */ -/* was incorrectly calculated as the product of the maximum */ -/* address of the cluster's data type and the number of words of */ -/* that data type in a DAS record. The correct product involves */ -/* the number of records in the cluster and the number of words of */ -/* that data type in a DAS record. */ - -/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ - -/* Re-written to optimize address calculations for segregated, */ -/* read-only files. */ - -/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ - -/* Fixed a typo in the $ Brief_I/O section of the header. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Words per data record, for each data type: */ - - -/* Directory pointer locations */ - - -/* Directory address range locations */ - - -/* Indices of lowest and highest addresses in a `range array': */ - - -/* Location of first type descriptor */ - - -/* Access word length */ - - -/* File table size */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* NEXT and PREV map the DAS data type codes to their */ -/* successors and predecessors, respectively. */ - - -/* Discovery check-in is used in this routine. */ - - -/* DAS files have the following general structure: */ - -/* +------------------------+ */ -/* | file record | */ -/* +------------------------+ */ -/* | reserved records | */ -/* | | */ -/* +------------------------+ */ -/* | comment records | */ -/* | | */ -/* | | */ -/* | | */ -/* +------------------------+ */ -/* | first data directory | */ -/* +------------------------+ */ -/* | data records | */ -/* | | */ -/* | | */ -/* | | */ -/* | | */ -/* +------------------------+ */ -/* . */ -/* . */ -/* +------------------------+ */ -/* | last data directory | */ -/* +------------------------+ */ -/* | data records | */ -/* | | */ -/* | | */ -/* +------------------------+ */ - - -/* Within each DAS data record, word numbers start at one and */ -/* increase up to NWI, NWD, or NWC: the number of words in an */ -/* integer, double precision, or character data record. */ - - -/* +--------------------------------+ */ -/* | | | ... | | */ -/* +--------------------------------+ */ -/* 1 2 NWD */ - -/* +--------------------------------+ */ -/* | | | ... | | */ -/* +--------------------------------+ */ -/* 1 2 NWI */ - -/* +------------------------------------+ */ -/* | | | ... | | */ -/* +------------------------------------+ */ -/* 1 2 NWC */ - - -/* Directories are single records that describe the data */ -/* types of data records that follow. The directories */ -/* in a DAS file form a doubly linked list: each directory */ -/* contains forward and backward pointers to the next and */ -/* previous directories. */ - -/* Each directory also contains, for each data type, the lowest */ -/* and highest logical address occurring in any of the records */ -/* described by the directory. */ - -/* Following the pointers and address range information is */ -/* a sequence of data type descriptors. These descriptors */ -/* indicate the data type of data records following the */ -/* directory record. Each descriptor gives the data type */ -/* of a maximal set of contiguous data records, all having the */ -/* same type. By `maximal set' we mean that no data records of */ -/* the same type bound the set of records in question. */ - -/* Pictorially, the structure of a directory is as follows: */ - -/* +----------------------------------------------------+ */ -/* | |

| | */ -/* +----------------------------------------------------+ */ - -/* where the section looks like */ - -/* +-----------------------------------------+ */ -/* | | | */ -/* +-----------------------------------------+ */ - -/* the
section looks like */ - -/* +-------------------------------------------+ */ -/* | | | | */ -/* +-------------------------------------------+ */ - -/* and each range looks like one of: */ - -/* +------------------------------------------------+ */ -/* | | | */ -/* +------------------------------------------------+ */ - -/* +------------------------------------------------+ */ -/* | | | */ -/* +------------------------------------------------+ */ - -/* +------------------------------------------------+ */ -/* | | | */ -/* +------------------------------------------------+ */ - -/* The type descriptors implement a run-length encoding */ -/* scheme. The first element of the series of descriptors */ -/* occupies two integers: it contains a type code and a count. */ -/* The rest of the descriptors are just signed counts; the data */ -/* types of the records they describe are deduced from the sign */ -/* of the count and the data type of the previous descriptor. */ -/* The method of finding the data type for a given descriptor */ -/* in terms of its predecessor is as follows: if the sign of a */ -/* descriptor is positive, the type of that descriptor is the */ -/* successor of the type of the preceding descriptor in the */ -/* sequence of types below. If the sign of a descriptor is */ -/* negative, the type of the descriptor is the predecessor of the */ -/* type of the preceding descriptor. */ - -/* C --> D --> I --> C */ - -/* For example, if the preceding type is `I', and a descriptor */ -/* contains the number 16, the type of the descriptor is `C', */ -/* whereas if the descriptor contained the number -800, the type */ -/* of the descriptor would be `D'. */ - - -/* Make sure the data type is valid. */ - - if (*type__ < 1 || *type__ > 3) { - chkin_("DASA2L", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Invalid data type: #. File was #", (ftnlen)33); - errint_("#", type__, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(DASINVALIDTYPE)", (ftnlen)21); - chkout_("DASA2L", (ftnlen)6); - return 0; - } - -/* Decide whether we're looking at the same file as we did on */ -/* the last call. */ - - if (first) { - samfil = FALSE_; - fast = FALSE_; - prvhan = *handle; - first = FALSE_; - } else { - samfil = *handle == prvhan; - prvhan = *handle; - } - -/* We have a special case if we're looking at a `fast' file */ -/* that we saw on the last call. When we say a file is fast, */ -/* we're implying that it's open for read access only and that it's */ -/* segregated. In this case, we can do an address calculation */ -/* without looking up any information from the file. */ - - if (samfil && fast) { - *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? - i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)666)]; - *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? - i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)667)]; - mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? - i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)668)]; - hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("nw", i__1, "dasa2l_", (ftnlen)669)]; - -/* Make sure that ADDRSS points to an existing location. */ - - if (*addrss < 1 || *addrss > mxaddr) { - chkin_("DASA2L", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("ADDRSS was #; valid range for type # is # to #. File w" - "as #", (ftnlen)59); - errint_("#", addrss, (ftnlen)1); - errint_("#", type__, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &mxaddr, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); - chkout_("DASA2L", (ftnlen)6); - return 0; - } - } else { - -/* If the current file is not the same one we looked at on the */ -/* last call, find out whether the file is on record in our file */ -/* table. Add the file to the table if necessary. Bump the */ -/* oldest file in the table if there's no room. */ - - if (! samfil) { - fidx = isrchi_(handle, &nfiles, tbhan); - known = fidx > 0; - if (known) { - -/* The file is in our list. */ - - fast = tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tbfast", i__1, "dasa2l_", (ftnlen)708)]; - if (fast) { - -/* This is a segregated, read-only file. Look up the */ -/* saved information we'll need to calculate addresses. */ - - *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && - 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2" - "l_", (ftnlen)715)]; - *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && - 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2" - "l_", (ftnlen)716)]; - mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 - <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", - (ftnlen)717)]; - hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", ( - ftnlen)718)]; - -/* Make sure that ADDRSS points to an existing location. */ - - if (*addrss < 1 || *addrss > mxaddr) { - chkin_("DASA2L", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("ADDRSS was #; valid range for type # is # " - "to #. File was #", (ftnlen)60); - errint_("#", addrss, (ftnlen)1); - errint_("#", type__, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &mxaddr, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); - chkout_("DASA2L", (ftnlen)6); - return 0; - } - } - -/* FAST is set. */ - - } - -/* KNOWN is set. */ - - } - -/* SAMFIL, FAST, and KNOWN are set. If the file is the same one */ -/* we saw on the last call, the state variables FAST, and KNOWN */ -/* retain their values from the previous call. */ - -/* FIDX is set at this point only if we're looking at a known */ -/* file. */ - -/* Unless the file is recognized and known to be a fast file, we */ -/* look up all metadata for the file. */ - - if (! (known && fast)) { - if (! known) { - -/* This file is not in our list. If the list is not full, */ -/* append the file to the list. If the list is full, */ -/* replace the oldest (first) file with this one. */ - - if (nfiles < 20) { - ++nfiles; - fidx = nfiles; - } else { - fidx = 1; - } - tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tbhan", i__1, "dasa2l_", (ftnlen)781)] = *handle; - -/* Find out whether the file is open for read or write */ -/* access. We consider the file to be `slow' until we find */ -/* out otherwise. The contents of the arrays TBHIGH, */ -/* TBBASE, TBSIZE, and TBMXAD are left undefined for slow */ -/* files. */ - - dasham_(handle, access, (ftnlen)10); - rdonly = s_cmp(access, "READ", (ftnlen)10, (ftnlen)4) == 0; - fast = FALSE_; - tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tbfast", i__1, "dasa2l_", (ftnlen)794)] = fast; - -/* We'll set the flag KNOWN at the end of the outer IF */ -/* block. */ - - } else { - -/* We set RDONLY to .FALSE. for any known file that is */ -/* not fast. It's actually possible for a read-only file */ -/* to be unsegregated, but this is expected to be a rare */ -/* case, one that's not worth complicating this routine */ -/* further for. */ - - rdonly = FALSE_; - } - -/* RDONLY is set. */ - -/* FIDX is now set whether or not the current file is known. */ - -/* Get the number of reserved records, comment records, and */ -/* the current last address of the data type TYPE from the */ -/* file summary. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, &tbmxad[( - i__1 = fidx * 3 - 3) < 60 && 0 <= i__1 ? i__1 : s_rnge( - "tbmxad", i__1, "dasa2l_", (ftnlen)821)], lstrec, lstwrd); - mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 - ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)831)]; - -/* Make sure that ADDRSS points to an existing location. */ - - if (*addrss < 1 || *addrss > mxaddr) { - chkin_("DASA2L", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("ADDRSS was #; valid range for type # is # to #. F" - "ile was #", (ftnlen)60); - errint_("#", addrss, (ftnlen)1); - errint_("#", type__, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &mxaddr, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); - chkout_("DASA2L", (ftnlen)6); - return 0; - } - -/* Find out which directory describes the cluster containing */ -/* this word. To do this, we must traverse the directory */ -/* list. The first directory record comes right after the */ -/* last comment record. (Don't forget the file record when */ -/* counting the predecessors of the directory record.) */ - -/* Note that we don't need to worry about not finding a */ -/* directory record that contains the address we're looking */ -/* for, since we've already checked that the address is in */ -/* range. */ - -/* Keep track of the number of directory records we see. We'll */ -/* use this later to determine whether we've got a segregated */ -/* file. */ - - nrec = nresvr + ncomr + 2; - ndirs = 1; - i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)872)] + 1; - dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen) - 872)], &i__3, range); - while(range[1] < *addrss) { - -/* The record number of the next directory is the forward */ -/* pointer in the current directory record. Update NREC */ -/* with this pointer. Get the address range for the */ -/* specified type covered by this next directory record. */ - - dasrri_(handle, &nrec, &c__2, &c__2, &nxtrec); - nrec = nxtrec; - ++ndirs; - i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)891)] + 1; - dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 - <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", ( - ftnlen)891)], &i__3, range); - } - -/* NREC is now the record number of the directory that contains */ -/* the type descriptor for the address we're looking for. */ - -/* Our next task is to find the descriptor for the cluster */ -/* containing the input address. To do this, we must examine */ -/* the directory record in `left-to-right' order. As we do so, */ -/* we'll keep track of the highest address of type TYPE */ -/* occurring in the clusters whose descriptors we've seen. */ -/* The variable HIADDR will contain this address. */ - - dasrri_(handle, &nrec, &c__1, &c__256, dirrec); - -/* In the process of finding the physical location */ -/* corresponding to ADDRSS, we'll find the record number of the */ -/* base of the cluster containing ADDRSS. We'll start out by */ -/* initializing this value with the number of the first data */ -/* record of the next cluster. */ - - *clbase = nrec + 1; - -/* We'll initialize HIADDR with the value preceding the lowest */ -/* address of type TYPE described by the current directory. */ - - hiaddr = dirrec[(i__2 = rngloc[(i__1 = *type__ - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen) - 925)] - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", - i__2, "dasa2l_", (ftnlen)925)] - 1; - -/* Initialize the number of records described by the last seen */ -/* type descriptor. This number, when added to CLBASE, should */ -/* yield the number of the first record of the current cluster; */ -/* that's why it's initialized to 0. */ - - *clsize = 0; - -/* Now find the descriptor for the cluster containing ADDRSS. */ -/* Read descriptors until we get to the one that describes the */ -/* record containing ADDRSS. Keep track of descriptor data */ -/* types as we go. Also count the descriptors. */ - -/* At this point, HIADDR is less than ADDRSS, so the loop will */ -/* always be executed at least once. */ - - prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("prev", i__1, "dasa2l_", (ftnlen)944)]; - dscloc = 10; - while(hiaddr < *addrss) { - -/* Update CLBASE so that it is the record number of the */ -/* first record of the current cluster. */ - - *clbase += *clsize; - -/* Find the type of the current descriptor. */ - - if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("dirrec", i__1, "dasa2l_", (ftnlen)957)] > 0) { - curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("next", i__1, "dasa2l_", (ftnlen)958)]; - } else { - curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("prev", i__1, "dasa2l_", (ftnlen)960)]; - } - -/* Forgetting to update PRVTYP is a Very Bad Thing (VBT). */ - - prvtyp = curtyp; - -/* If the current descriptor is of the type we're interested */ -/* in, update the highest address count. */ - - if (curtyp == *type__) { - hiaddr += nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("nw", i__1, "dasa2l_", (ftnlen)973)] * ( - i__3 = dirrec[(i__2 = dscloc - 1) < 256 && 0 <= - i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", ( - ftnlen)973)], abs(i__3)); - } - -/* Compute the number of records described by the current */ -/* descriptor. Update the descriptor location. */ - - *clsize = (i__2 = dirrec[(i__1 = dscloc - 1) < 256 && 0 <= - i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", ( - ftnlen)980)], abs(i__2)); - ++dscloc; - } - -/* If we have an unknown read-only file, see whether the file */ -/* is segregated. If it is, we'll be able to compute */ -/* addresses much faster for subsequent reads to this file. */ - - if (rdonly && ! known) { - if (ndirs == 1) { - -/* If this file is segregated, there are at most three */ -/* cluster descriptors, and each one points to a cluster */ -/* containing all records of the corresponding data type. */ -/* For each data type having a non-zero maximum address, */ -/* the size of the corresponding cluster must be large */ -/* enough to hold all addresses of that type. */ - - ntypes = 0; - for (i__ = 1; i__ <= 3; ++i__) { - if (tbmxad[(i__1 = i__ + fidx * 3 - 4) < 60 && 0 <= - i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_" - , (ftnlen)1005)] > 0) { - ++ntypes; - } - } - -/* Now look at the first NTYPES cluster descriptors, */ -/* collecting cluster bases and sizes as we go. */ - - mxclrc = nrec + 1; - prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen) - 1016)]; - dscloc = 10; - fast = TRUE_; - while(dscloc <= ntypes + 9 && fast) { - -/* Find the type of the current descriptor. */ - - if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("dirrec", i__1, "dasa2l_", ( - ftnlen)1025)] > 0) { - curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("next", i__1, "dasa" - "2l_", (ftnlen)1026)]; - } else { - curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("prev", i__1, "dasa" - "2l_", (ftnlen)1028)]; - } - prvtyp = curtyp; - tbbase[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= - i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2l_" - , (ftnlen)1032)] = mxclrc; - tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= - i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_" - , (ftnlen)1033)] = (i__3 = dirrec[(i__2 = - dscloc - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("dirrec", i__2, "dasa2l_", (ftnlen) - 1033)], abs(i__3)); - mxclrc += tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 - && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, - "dasa2l_", (ftnlen)1034)]; - fast = tbmxad[(i__1 = curtyp + fidx * 3 - 4) < 60 && - 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, - "dasa2l_", (ftnlen)1037)] <= tbsize[(i__2 = - curtyp + fidx * 3 - 4) < 60 && 0 <= i__2 ? - i__2 : s_rnge("tbsize", i__2, "dasa2l_", ( - ftnlen)1037)] * nw[(i__3 = curtyp - 1) < 3 && - 0 <= i__3 ? i__3 : s_rnge("nw", i__3, "dasa2" - "l_", (ftnlen)1037)]; - ++dscloc; - } - -/* FAST is set. */ - - } else { - -/* The file has more than one directory record. */ - - fast = FALSE_; - } - -/* If the file was unknown, readonly, and had one directory */ -/* record, we determined whether it was a fast file. */ - - - } else { - -/* The file was already known and wasn't fast, or is not */ -/* readonly. */ - - fast = FALSE_; - } - -/* FAST is set. */ - - } - -/* This is the end of the `.NOT. ( KNOWN .AND. FAST )' case. */ - -/* At this point, we've set or looked up CLBASE, CLSIZE, MXADDR, */ -/* and HIADDR. */ - -/* If the file was unknown, we set TBHAN, TBRDON, and TBFAST. */ -/* If the file was unknown and turned out to be fast, we set */ -/* TBBASE, TBSIZE, TBHIGH, and TBMXAD as well. */ - -/* At this point, it's safe to indicate that the file is known. */ - - known = TRUE_; - } - -/* At this point, */ - -/* -- CLBASE is properly set: it is the record number of the */ -/* first record of the cluster containing ADDRSS. */ - -/* -- CLSIZE is properly set: it is the size of the cluster */ -/* containing ADDRSS. */ - -/* -- HIADDR is the last logical address in the cluster */ -/* containing ADDRSS. */ - -/* Now we must find the physical record and word corresponding */ -/* to ADDRSS. The structure of the cluster containing ADDRSS and */ -/* HIADDR is shown below: */ - -/* +--------------------------------------+ */ -/* | | Record # CLBASE */ -/* +--------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------+ */ -/* | |ADDRSS| | Record # RECNO */ -/* +--------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------+ Record # */ -/* | |HIADDR| */ -/* +--------------------------------------+ CLBASE + CLSIZE - 1 */ - - - - *recno = *clbase + *clsize - 1 - (hiaddr - *addrss) / nw[(i__1 = *type__ - - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", ( - ftnlen)1122)]; - *wordno = *addrss - (*addrss - 1) / nw[(i__1 = *type__ - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)1125)] * nw[( - i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("nw", i__2, - "dasa2l_", (ftnlen)1125)]; - return 0; -} /* dasa2l_ */ - diff --git a/ext/spice/src/cspice/dasac.c b/ext/spice/src/cspice/dasac.c deleted file mode 100644 index eb19ce6505..0000000000 --- a/ext/spice/src/cspice/dasac.c +++ /dev/null @@ -1,548 +0,0 @@ -/* dasac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DASAC ( DAS add comments ) */ -/* Subroutine */ int dasac_(integer *handle, integer *n, char *buffer, ftnlen - buffer_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j, space; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, recno, ncomr; - extern logical failed_(void); - extern /* Subroutine */ int dasacr_(integer *, integer *); - char ifname[60], crecrd[1024]; - extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *, - ftnlen, ftnlen), dassih_(integer *, char *, ftnlen); - integer nchars; - extern integer lastnb_(char *, ftnlen); - integer length, newrec, daslun; - extern /* Subroutine */ int dashlu_(integer *, integer *); - char idword[8]; - static char eolmrk[1]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), dasrfr_(integer *, char - *, char *, integer *, integer *, integer *, integer *, ftnlen, - ftnlen), daswfr_(integer *, char *, char *, integer *, integer *, - integer *, integer *, ftnlen, ftnlen); - integer nresvc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer rinuse, curpos; - extern logical return_(void); - integer nresvr; - -/* $ Abstract */ - -/* Add comments from a buffer of character strings to the comment */ -/* area of a binary DAS file, appending them to any comments which */ -/* are already present in the file's comment area. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS handle of a file opened with write access. */ -/* N I Number of comments to put into the comment area. */ -/* BUFFER I Buffer of lines to be put into the comment area. */ - -/* $ Detailed_Input */ - -/* HANDLE The file handle of a binary DAS file which has been */ -/* opened with write access. */ - -/* N The number of comments in BUFFER that are to be */ -/* added to the comment area of the binary DAS file */ -/* attached to HANDLE. */ - -/* BUFFER A buffer containing comments which are to be added */ -/* to the comment area of the binary DAS file attached */ -/* to HANDLE. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of comments to be added is not positive, the */ -/* error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If a non printing ASCII character is encountered in the */ -/* comments, the error SPICE(ILLEGALCHARACTER) will be */ -/* signalled. */ - -/* 3) If the binary DAS file attached to HANDLE is not open with */ -/* write access an error will be signalled by a routine called */ -/* by this routine. */ - -/* $ Files */ - -/* See argument HANDLE in $ Detailed_Input. */ - -/* $ Particulars */ - -/* Binary DAS files contain a data area which is reserved for storing */ -/* annotations or descriptive textual information about the data */ -/* contained in a file. This area is referred to as the ``comment */ -/* area'' of the file. The comment area of a DAS file is a line */ -/* oriented medium for storing textual information. The comment */ -/* area preserves any leading or embedded white space in the line(s) */ -/* of text which are stored so that the appearance of the */ -/* information will be unchanged when it is retrieved (extracted) at */ -/* some other time. Trailing blanks, however, are NOT preserved, */ -/* due to the way that character strings are represented in */ -/* standard Fortran 77. */ - -/* This routine will take a buffer of text lines and add (append) */ -/* them to the comment area of a binary DAS file. If there are no */ -/* comments in the comment area of the file, then space will be */ -/* allocated and the text lines in BUFFER will then placed into the */ -/* comment area. The text lines may contain only printable ASCII */ -/* characters (decimal values 32 - 126). */ - -/* There is NO maximum length imposed on the significant portion */ -/* of a text line that may be placed into the comment area of a */ -/* DAS file. The maximum length of a line stored in the comment */ -/* area should be reasonable, however, so that they may be easily */ -/* extracted. A good value for this would be 255 characters, as */ -/* this can easily accommodate ``screen width'' lines as well as */ -/* long lines which may contain some other form of information. */ - -/* $ Examples */ - -/* Let */ - -/* HANDLE be the handle for a DAS file which has been opened */ -/* with write access. */ - -/* N be the number of lines of text to be added to the */ -/* comment area of the binary DAS file attached to */ -/* HANDLE. */ - -/* BUFFER is a list of text lines to be added to the comment */ -/* area of the binary DAS file attached to HANDLE. */ - -/* The call */ - -/* CALL DASAC ( HANDLE, N, BUFFER ) */ - -/* will append the first N line(s) in BUFFER to the comment area */ -/* of the binary DAS file attached to HANDLE. */ - -/* $ Restrictions */ - -/* 1) This routine uses constants that are specific to the ASCII */ -/* character sequence. The results of using this routine with */ -/* a different character sequence are unpredictable. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.1, 12-MAY-1994 (KRG) */ - -/* Fixed a typo in the $ Particulars section. */ - -/* - Beta Version 1.0.0, 23-NOV-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* add comments to a binary das file */ -/* append comments to a das file comment area */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 12-MAY-1994 (KRG) */ - -/* Fixed a typo in the $ Particulars section. */ - -/* - Beta Version 1.0.0, 23-NOV-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Length of a DAS character record, in characters. */ - - -/* Maximum and minimum decimal values for the printable ASCII */ -/* characters. */ - - -/* Decimal value for the DAS comment area end-of-line (EOL) marker. */ - - -/* Length of a DAS file ID word. */ - - -/* Length of a DAS file internal filename. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASAC", (ftnlen)5); - } - -/* The lines of text in BUFFER will be ``packed'' into DAS comment */ -/* records: the significant portion of each comment line from BUFFER */ -/* will be terminated by the special character EOLMRK to indicate the */ -/* end of the line. When a comment record is full or all of the */ -/* comments have been added to the file, the comment record will be */ -/* written to the comment area of the binary DAS file. */ - -/* If this is the first time that this routine has been called, */ -/* we need to initialize the character value for the end-of-line */ -/* marker. */ - - if (first) { - first = FALSE_; - *(unsigned char *)eolmrk = '\0'; - } - -/* Verify that the DAS file attached to HANDLE is opened with write */ -/* access. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - -/* Convert the DAS file handle to its corresponding Fortran logical */ -/* unit number for reading and writing comment records. */ - - dashlu_(handle, &daslun); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - -/* Check for a nonpositive number of lines in the buffer. */ - - if (*n <= 0) { - setmsg_("The number of comment lines to be added to the binary DAS f" - "ile # was not positive: #.", (ftnlen)85); - errfnm_("#", &daslun, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DASAC", (ftnlen)5); - return 0; - } - -/* Count the number of characters in the buffer ignoring trailing */ -/* blanks on nonblank lines and blank lines. The count will be */ -/* modified to include the contribution of blank lines later. This */ -/* count is used to determine the number of character records to be */ -/* added to the binary DAS file attached to HANDLE. */ - - nchars = 0; - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the length of the significant portion of a comment line. */ - - length = lastnb_(buffer + (i__ - 1) * buffer_len, buffer_len); - -/* Scan the comment line for non printing characters. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* Check to see that the characters in the buffer are all */ -/* printing ASCII characters. The bounds for printing ASCII */ -/* characters are given by MAXPCH and MINPCH, which are */ -/* defined in the $ Local Parameters section of the header. */ - - if (*(unsigned char *)&buffer[(i__ - 1) * buffer_len + (j - 1)] > - 126 || *(unsigned char *)&buffer[(i__ - 1) * buffer_len + - (j - 1)] < 32) { - setmsg_("A nonprinting character was encountered in the comm" - "ent buffer. Value: #", (ftnlen)71); - i__3 = *(unsigned char *)&buffer[(i__ - 1) * buffer_len + (j - - 1)]; - errint_("#", &i__3, (ftnlen)1); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DASAC", (ftnlen)5); - return 0; - } - } - -/* Increment the number of characters by the length of the */ -/* significant portion of the current line in the buffer. */ - - nchars += length; - } - -/* We need to include the number of end of line markers in the */ -/* number of characters, so add the number of comment lines to */ -/* be added, N, to the number of characters, NCHARS. This is where */ -/* the contribution of any blank lines gets added to the character */ -/* count. */ - - nchars += *n; - -/* Get the current number of comment records and comment characters */ -/* from the DAS file attached to HANDLE. We will also get back some */ -/* extra stuff that we do not use. */ - - dasrfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, (ftnlen) - 8, (ftnlen)60); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - -/* Determine the amount of free space in the comment area. If */ -/* there are some comment records allocated, the space available */ -/* is the number of comment records allocated times the length of */ -/* a comment record, minus the number of comment characters already */ -/* used. Otherwise, the space available is zero. */ - - if (ncomr > 0) { - space = (ncomr << 10) - ncomc; - } else { - space = 0; - } - -/* Determine the number of new comment records which are necessary */ -/* to store all of the comments from the buffer. */ - - if (nchars > space) { - -/* If there are more characters to store than available space */ -/* we need at least one new record. */ - - newrec = (nchars - space - 1) / 1024 + 1; - } else { - -/* Otherwise, we do not need any new records. */ - - newrec = 0; - } - -/* Now add the necessary number of comment records to the file, */ -/* if we need to add any. */ - - if (newrec > 0) { - dasacr_(handle, &newrec); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - -/* Update the value for the number of comment records to include */ -/* those that were just added. We need this value when we write */ -/* the file record at the end of the routine to update the number */ -/* comment characters, NCOMC. */ - - ncomr += newrec; - } - -/* At this point, we know that we have enough space to write all of */ -/* the comments in BUFFER to the comment area. Either there was */ -/* enough space already there, or we figured out how many new comment */ -/* records were needed, and we added them to the file. So, now we */ -/* begin ``packing'' the comments into DAS character records and */ -/* writing them to the file. */ - -/* We begin by reading the last comment record if there is one. */ -/* Otherwise we just initialize the appropriate variables. */ - - if (ncomc == 0) { - -/* If there are no comments in the comment area, then we need to */ -/* skip the file record and the reserved records, if any. The */ -/* first available comment record is the record immediately */ -/* after the last reserved record, so we set RECNO accordingly. */ -/* We also initialize the current position in the comment record, */ -/* and the comment record itself. */ - - recno = nresvr + 2; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1024, (ftnlen)1); - } else { - -/* If there are comments in the comment area, then we need to skip */ -/* the file record, the reserved records, if any, and any comment */ -/* records which have been filled. The first comment record */ -/* with space available is the record immediately following the */ -/* last completely filled comment record. So calculate the number */ -/* of comment records in use, and set RECNO appropriately. Then */ -/* calculate the initial position and read in the comment record. */ - - rinuse = ncomc / 1024 + 1; - recno = nresvr + 1 + rinuse; - curpos = ncomc - (rinuse - 1 << 10) + 1; - dasioc_("READ", &daslun, &recno, crecrd, (ftnlen)4, (ftnlen)1024); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - } - -/* Begin ``packing'' the comments from the input buffer into the */ -/* comment records, writing the comment records to the DAS file */ -/* as they become filled. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the length of the significant portion of a comment line. */ - - length = lastnb_(buffer + (i__ - 1) * buffer_len, buffer_len); - -/* Process the comment line. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* If we have filled the comment record while processing */ -/* comment line BUFFER(I), write out the comment record, */ -/* increment the record number, RECNO, and reset the values */ -/* of the current position and the comment record. */ - - if (curpos > 1024) { - dasioc_("WRITE", &daslun, &recno, crecrd, (ftnlen)5, (ftnlen) - 1024); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - ++recno; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1024, (ftnlen)1); - } - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)&buffer[ - (i__ - 1) * buffer_len + (j - 1)]; - ++curpos; - } - -/* Check to see if we happened to exactly fill the comment record */ -/* when we finished processing comment line BUFFER(I). If we */ -/* did, CURPOS will be 1 greater than MXCREC, and we will need */ -/* to write the comment record to the file, increment the record */ -/* number, RECNO, and reset the values of the current position */ -/* and the comment record. */ - - if (curpos > 1024) { - dasioc_("WRITE", &daslun, &recno, crecrd, (ftnlen)5, (ftnlen)1024) - ; - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - ++recno; - curpos = 1; - s_copy(crecrd, " ", (ftnlen)1024, (ftnlen)1); - } - -/* Append the end-of-line marker to the comment line that we just */ -/* placed into the comment record. */ - - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)eolmrk; - ++curpos; - } - -/* We have now finished processing all of the comment lines in */ -/* BUFFER, so we need write the current record to the file. This */ -/* record will always contain something, so we always need to write */ -/* it. */ - - dasioc_("WRITE", &daslun, &recno, crecrd, (ftnlen)5, (ftnlen)1024); - if (failed_()) { - chkout_("DASAC", (ftnlen)5); - return 0; - } - -/* And finally, we need to update the number of comment characters */ -/* in the file record by adding NCHARS, and writing the file record. */ - - ncomc += nchars; - daswfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, (ftnlen) - 8, (ftnlen)60); - -/* Check out and leave DASAC. A test of FAILED should be done by */ -/* the calling routine to catch an error that may occur during */ -/* the call to DASWFR. */ - - chkout_("DASAC", (ftnlen)5); - return 0; -} /* dasac_ */ - diff --git a/ext/spice/src/cspice/dasac_c.c b/ext/spice/src/cspice/dasac_c.c deleted file mode 100644 index a7d46931d7..0000000000 --- a/ext/spice/src/cspice/dasac_c.c +++ /dev/null @@ -1,273 +0,0 @@ -/* - --Procedure dasac_c ( DAS add comments ) - --Abstract - - Add comments from a buffer of character strings to the comment - area of a binary DAS file, appending them to any comments which - are already present in the file's comment area. - --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 - - DAS - --Keywords - - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef dasac_c - - - void dasac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt buflen, - const void * buffer ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I DAS handle of a file opened with write access. - n I Number of comments to put into the comment area. - buflen I Line length associated with buffer. - buffer I Buffer of lines to be put into the comment area. - --Detailed_Input - - handle The file handle of a binary DAS file which has been - opened with write access. - - n The number of strings in buffer that are to be - appended to the comment area of the binary DAS file - attached to handle. - - buflen is the common length of the strings in buffer, including the - terminating nulls. - - buffer A buffer containing comments which are to be added - to the comment area of the binary DAS file attached - to handle. buffer should be declared as follows: - - ConstSpiceChar buffer [n][buflen] - - Each string in buffer is null-terminated. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the number of comments to be added is not positive, the - error SPICE(INVALIDARGUMENT) will be signaled. - - 2) If a non-null, non printing ASCII character is encountered in the - comments, the error SPICE(ILLEGALCHARACTER) will be - signaled. - - 3) If the binary DAS file attached to handle is not open for - write access, an error will be signaled by a routine called - by this routine. - - 4) If the input buffer pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 5) If the input buffer string length buflen is not at least 2, - the error SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See argument handle in Detailed_Input. - --Particulars - - Binary DAS files contain a data area which is reserved for storing - annotations or descriptive textual information about the data - contained in a file. This area is referred to as the "comment - area" of the file. The comment area of a DAS file is a line - oriented medium for storing textual information. The comment - area preserves any leading or embedded white space in the line(s) - of text which are stored so that the appearance of the - information will be unchanged when it is retrieved (extracted) at - some other time. Trailing blanks, however, are NOT preserved, - due to the way that character strings are represented in - standard Fortran 77. - - This routine will take a buffer of text lines and add (append) - them to the comment area of a binary DAS file. If there are no - comments in the comment area of the file, then space will be - allocated and the text lines in buffer will then placed into the - comment area. The text lines may contain only printable ASCII - characters (decimal values 32 - 126). - - There is no maximum length imposed on the significant portion - of a text line that may be placed into the comment area of a - DAS file. The maximum length of a line stored in the comment - area should be reasonable, however, so that they may be easily - extracted. A good value for this would be 255 characters, as - this can easily accommodate "screen width" lines as well as - long lines which may contain some other form of information. - --Examples - - Let - - handle be the handle for a DAS file which has been opened - with write access. - - n be the number of lines of text to be added to the - comment area of the binary DAS file attached to - handle. - - BUFLEN be the declared line length of the buffer. - - buffer is a list of text lines to be added to the comment - area of the binary DAS file attached to handle. - - The call - - dasac_c ( handle, n, BUFLEN, buffer ); - - will append the first n line(s) in buffer to the comment area - of the binary DAS file attached to handle. - --Restrictions - - 1) This routine uses constants that are specific to the ASCII - character sequence. The results of using this routine with - a different character sequence are unpredictable. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.1.0, 02-MAR-2003 (NJB) - - Added error check in wrapper for non-positive - buffer line count. - - -CSPICE Version 1.0.0, 25-FEB-2003 (NJB) (KRG) - --Index_Entries - - add comments to a binary das file - append comments to a das file comment area - --& -*/ - -{ /* Begin dasac_c */ - - - /* - Local variables - */ - - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "dasac_c" ); - - /* - Check the line count of the input buffer. - */ - if ( n < 1 ) - { - setmsg_c ( "Comment buffer line count n = #; must be positive." ); - errint_c ( "#", n ); - sigerr_c ( "SPICE(INVALIDARGUMENT)" ); - chkout_c ( "dasac_c" ); - return; - } - - /* - Check the input buffer for null pointer or short lines. - */ - CHKOSTR ( CHK_STANDARD, "dasac_c", buffer, buflen ); - - - /* - Map the input buffer to a Fortran-style buffer. - */ - C2F_MapStrArr ( "dasac_c", n, buflen, buffer, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - chkout_c ( "dasac_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - dasac_ ( ( integer * ) &handle, - ( integer * ) &n, - ( char * ) fCvalsArr, - ( ftnlen ) fCvalsLen ); - - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - - chkout_c ( "dasac_c" ); - -} /* End dasac_c */ diff --git a/ext/spice/src/cspice/dasacr.c b/ext/spice/src/cspice/dasacr.c deleted file mode 100644 index 3534146928..0000000000 --- a/ext/spice/src/cspice/dasacr.c +++ /dev/null @@ -1,502 +0,0 @@ -/* dasacr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__256 = 256; - -/* $Procedure DASACR ( DAS, add comment records ) */ -/* Subroutine */ int dasacr_(integer *handle, integer *n) -{ - /* Initialized data */ - - static integer next[3] = { 2,3,1 }; - static integer prev[3] = { 3,1,2 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base; - char recc[1024]; - doublereal recd[128]; - integer free, reci[256], lrec, nrec, prec, unit, type__, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc; - extern /* Subroutine */ int maxai_(integer *, integer *, integer *, - integer *); - integer ncomr, lword, ltype; - extern logical failed_(void); - extern /* Subroutine */ int cleari_(integer *, integer *), dasioc_(char *, - integer *, integer *, char *, ftnlen, ftnlen), dasiod_(char *, - integer *, integer *, doublereal *, ftnlen); - integer dirrec[256]; - extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *), - dassih_(integer *, char *, ftnlen), dasioi_(char *, integer *, - integer *, integer *, ftnlen); - integer lastla[3]; - extern /* Subroutine */ int dashlu_(integer *, integer *), daswbr_( - integer *); - integer lindex; - extern /* Subroutine */ int dasufs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - integer lastrc[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer lastwd[3], nresvc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - integer nresvr, nxttyp, loc, pos; - -/* $ Abstract */ - -/* Increase the size of the comment area in a DAS file to accommodate */ -/* a specified number of additional comment records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I A DAS file handle. */ -/* N I Number of comment records to append to the comment */ -/* area of the specified file. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an existing DAS file opened for */ -/* comment area modification by DASOPC. */ - -/* N is the number of records to append to the comment */ -/* area. If NCOMR is the number of comment records */ -/* present in the file on input, then on output the */ -/* number of comment records will be NCOMR + N. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 2) If an I/O error occurs during the addition process, the error */ -/* will be diagnosed by routines called by this routine. The */ -/* DAS file will probably be corrupted in this case. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is used to create space in the comment area of a DAS */ -/* file to allow addition of comments to the file. If there are */ -/* comment records present in the file at the time this routine is */ -/* called, the number of comment records specified by the input */ -/* argument N will be appended to the existing comment records. */ -/* In any case, any existing directory records and data records will */ -/* be shifted down by N records. */ - -/* This routine updates the file record of the specified DAS file */ -/* to reflect the addition of records to the file's comment area. */ -/* Also, the file summary obtainable from DASHFS will be updated to */ -/* reflect the addition of comment records. */ - -/* This routine may be used only on existing DAS files opened by */ -/* DASOPW. */ - -/* The association of DAS logical addresses and data within the */ -/* specified file will remain unaffected by use of this routine. */ - -/* Normally, SPICELIB applications will not call this routine */ -/* directly, but will add comments by calling DASAC. */ - -/* This routine has an inverse DASRCR, which removes a specified */ -/* number of records from the end of the comment area. */ - -/* $ Examples */ - -/* 1) Make room for 10 comment records in the comment area of a */ -/* new DAS file. */ - -/* C */ -/* C Create a new DAS file. */ -/* C */ -/* CALL DASOPW ( DAS, HANDLE ) */ - -/* C */ -/* C Now add 10 comment records to the comment area. */ -/* C */ -/* CALL DASACR ( HANDLE, 10 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 11-OCT-1996 (NJB) */ - -/* Bug fix: backward and forward directory record pointers */ -/* are now updated when directory records are moved. */ - -/* - SPICELIB Version 1.0.0, 01-FEB-1993 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* add comment records to a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 11-OCT-1996 (NJB) */ - -/* Bug fix: backward and forward directory record pointers */ -/* are now updated when directory records are moved. */ - -/* Because these pointers are not used by the DAS sofware */ -/* once a DAS file is segregated, this bug had no effect on */ -/* DAS files that were created and closed via DASCLS, then */ -/* commented via the commnt utility. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Words per data record, for each data type: */ - - -/* Data type parameters */ - - -/* Directory pointer locations (backward and forward): */ - - -/* Directory address range locations */ - - -/* Location of first type descriptor */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* NEXT and PREV map the DAS data type codes to their */ -/* successors and predecessors, respectively. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASACR", (ftnlen)6); - } - -/* Make sure this DAS file is open for writing. Signal an error if */ -/* not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - -/* Get the logical unit for this DAS file. */ - - dashlu_(handle, &unit); - if (failed_()) { - chkout_("DASACR", (ftnlen)6); - return 0; - } - -/* It's a mistake to use a negative value of N. */ - - if (*n < 0) { - setmsg_("Number of comment records to add must be non-negative. Act" - "ual number requested was #.", (ftnlen)86); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(DASINVALIDCOUNT)", (ftnlen)22); - chkout_("DASACR", (ftnlen)6); - return 0; - } - -/* Before doing anything to the file, make sure that the DASRWR */ -/* data buffers do not contain any updated records for this file. */ -/* All of the record numbers that pertain to this file and remain */ -/* in the DASRWR buffers will be invalidated after this routine */ -/* returns. */ - -/* DASWBR flushes buffered records to the file. */ - - daswbr_(handle); - -/* Grab the file summary for this DAS file. Find the number of */ -/* comment records and the number of the first free record. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - -/* Find the record and word positions LREC and LWORD of the last */ -/* descriptor in the file, and also find the type of the descriptor */ -/* LTYPE. */ - - maxai_(lastrc, &c__3, &lrec, &loc); - lword = 0; - for (i__ = 1; i__ <= 3; ++i__) { - if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", - i__1, "dasacr_", (ftnlen)371)] == lrec && lastwd[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dasac" - "r_", (ftnlen)371)] > lword) { - lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dasacr_", (ftnlen)374)]; - ltype = i__; - } - } - -/* LREC, LWORD, and LTYPE are now the record, word, and data type */ -/* of the last descriptor in the file. If LREC is zero, there are */ -/* no directories in the file yet. However, even DAS files that */ -/* don't contain any data have their first directory records */ -/* zeroed out, and this should remain true after the addition of */ -/* the comment records. */ - - if (lrec == 0) { - -/* Just write the zero-filled record to record number */ - -/* NRESVR + NCOMR + N + 2 */ - - cleari_(&c__256, dirrec); - i__1 = nresvr + ncomr + *n + 2; - dasioi_("WRITE", &unit, &i__1, dirrec, (ftnlen)5); - } else { - -/* There really is stuff to move. For each directory record, */ -/* move all of the records described by that directory. We start */ -/* with the last directory and work our way toward the beginning */ -/* of the file. */ - - nrec = lrec; - while(nrec > 0) { - -/* For each descriptor in the current directory, move the */ -/* cluster of data records it refers to. */ - -/* Read the current directory record. */ - - dasioi_("READ", &unit, &nrec, dirrec, (ftnlen)4); - -/* Find the data type, size, and base record number of the */ -/* last cluster in the current directory. To do this, */ -/* traverse the directory record, keeping track of the record */ -/* count and data types of descriptors as we go. */ - - type__ = dirrec[8]; - base = nrec + 1; - if (nrec == lrec) { - lindex = lword; - } else { - lindex = 256; - } - i__1 = lindex; - for (i__ = 11; i__ <= i__1; ++i__) { - if (dirrec[(i__2 = i__ - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("dirrec", i__2, "dasacr_", (ftnlen)434)] < 0) { - type__ = prev[(i__2 = type__ - 1) < 3 && 0 <= i__2 ? i__2 - : s_rnge("prev", i__2, "dasacr_", (ftnlen)435)]; - } else { - type__ = next[(i__2 = type__ - 1) < 3 && 0 <= i__2 ? i__2 - : s_rnge("next", i__2, "dasacr_", (ftnlen)437)]; - } - base += (i__3 = dirrec[(i__2 = i__ - 2) < 256 && 0 <= i__2 ? - i__2 : s_rnge("dirrec", i__2, "dasacr_", (ftnlen)440)] - , abs(i__3)); - } - -/* TYPE and BASE are now the data type and base record number */ -/* of the last cluster described by the current directory. */ - -/* We'll now traverse the directory in reverse order, keeping */ -/* track of cluster sizes and types as we go. */ - -/* POS will be the index of the descriptor of the current */ -/* cluster. */ - - pos = lindex; - while(pos > 9) { - if (pos < lindex) { - -/* We'll need to determine the type of the current */ -/* cluster. If the next descriptor contains a positive */ -/* value, the data type of the cluster it refers to is */ -/* the successor of the current type, according to our */ -/* ordering of types. */ - - if (dirrec[(i__1 = pos) < 256 && 0 <= i__1 ? i__1 : - s_rnge("dirrec", i__1, "dasacr_", (ftnlen)466)] > - 0) { - type__ = prev[(i__1 = nxttyp - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("prev", i__1, "dasacr_", ( - ftnlen)467)]; - } else { - type__ = next[(i__1 = nxttyp - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("next", i__1, "dasacr_", ( - ftnlen)469)]; - } - -/* Update the cluster base record number. */ - - base -= (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 <= - i__1 ? i__1 : s_rnge("dirrec", i__1, "dasacr_", ( - ftnlen)475)], abs(i__2)); - } - -/* Move the current cluster. */ - - i__3 = base; - for (i__ = base + (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 - <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasacr_", ( - ftnlen)482)], abs(i__2)) - 1; i__ >= i__3; --i__) { - if (type__ == 1) { - dasioc_("READ", &unit, &i__, recc, (ftnlen)4, (ftnlen) - 1024); - i__1 = i__ + *n; - dasioc_("WRITE", &unit, &i__1, recc, (ftnlen)5, ( - ftnlen)1024); - } else if (type__ == 2) { - dasiod_("READ", &unit, &i__, recd, (ftnlen)4); - i__1 = i__ + *n; - dasiod_("WRITE", &unit, &i__1, recd, (ftnlen)5); - } else { - dasioi_("READ", &unit, &i__, reci, (ftnlen)4); - i__1 = i__ + *n; - dasioi_("WRITE", &unit, &i__1, reci, (ftnlen)5); - } - } - -/* The next descriptor to look at is the preceding one in */ -/* the directory. */ - - --pos; - nxttyp = type__; - } - -/* Find the preceding directory record. */ - - prec = dirrec[0]; - -/* Update the backward and forward pointers in the current */ -/* directory record. However, don't modify null pointers. */ - - if (dirrec[1] > 0) { - dirrec[1] += *n; - } - if (dirrec[0] > 0) { - dirrec[0] += *n; - } - -/* Move the current directory record. */ - - i__3 = nrec + *n; - dasioi_("WRITE", &unit, &i__3, dirrec, (ftnlen)5); - -/* Consider the previous directory. */ - - nrec = prec; - } - } - -/* Update the file summary. The number of comment records and the */ -/* number of the first free record have been incremented by N. */ -/* The numbers of the records containing the last descriptor of each */ -/* type have been incremented by N only if they were non-zero. */ - -/* The call to DASUFS will update the file record as well as the */ -/* file summary. */ - - ncomr += *n; - free += *n; - for (i__ = 1; i__ <= 3; ++i__) { - if (lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc", - i__3, "dasacr_", (ftnlen)557)] != 0) { - lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc", - i__3, "dasacr_", (ftnlen)558)] = lastrc[(i__1 = i__ - 1) - < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", i__1, "dasacr_" - , (ftnlen)558)] + *n; - } - } - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - chkout_("DASACR", (ftnlen)6); - return 0; -} /* dasacr_ */ - diff --git a/ext/spice/src/cspice/dasacu.c b/ext/spice/src/cspice/dasacu.c deleted file mode 100644 index 86d6a940d2..0000000000 --- a/ext/spice/src/cspice/dasacu.c +++ /dev/null @@ -1,799 +0,0 @@ -/* dasacu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__22 = 22; -static integer c__1 = 1; - -/* $Procedure DASACU ( DAS add comments from a logical unit ) */ -/* Subroutine */ int dasacu_(integer *comlun, char *begmrk, char *endmrk, - logical *insbln, integer *handle, ftnlen begmrk_len, ftnlen - endmrk_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - olist o__1; - cllist cl__1; - alist al__1; - - /* Builtin functions */ - integer f_open(olist *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *), s_rnge( - char *, integer, char *, integer), f_rew(alist *); - - /* Local variables */ - char line[255]; - logical more; - integer i__, j; - extern /* Subroutine */ int dasac_(integer *, integer *, char *, ftnlen), - chkin_(char *, ftnlen); - integer ncomc; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer ncomr; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int readla_(integer *, integer *, integer *, char - *, logical *, ftnlen); - char ifname[60]; - extern /* Subroutine */ int readln_(integer *, char *, logical *, ftnlen); - char combuf[255*22]; - extern /* Subroutine */ int dassih_(integer *, char *, ftnlen); - extern integer lastnb_(char *, ftnlen); - integer length, intchr; - char idword[8]; - extern /* Subroutine */ int dasrfr_(integer *, char *, char *, integer *, - integer *, integer *, integer *, ftnlen, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen); - integer numcom; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer nresvc; - extern /* Subroutine */ int getlun_(integer *); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer scrlun; - extern /* Subroutine */ int writla_(integer *, char *, integer *, ftnlen); - extern logical return_(void); - integer nresvr; - logical eof; - -/* $ Abstract */ - -/* Add comments to a previously opened binary DAS file from a */ -/* previously opened text file attached to a Fortran logical unit. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* COMLUN I Logical unit of the open comment text file. */ -/* BEGMRK I The begin comments marker in the comment text file. */ -/* ENDMRK I The end comments marker in the comment text file. */ -/* INSBLN I A flag indicating whether to insert a blank line. */ -/* HANDLE I Handle of a DAS file opened with write access. */ - -/* $ Detailed_Input */ - -/* COMLUN The Fortran logical unit of a previously opened text */ -/* file which contains comments that are to be added to */ -/* the comment area of a binary E-Kernel file. */ - -/* BEGMRK A marker which identifies the beginning of the comments */ -/* in the comment text file. This marker must appear on a */ -/* line by itself, and leading and trailing blanks are not */ -/* significant. */ - -/* The line immediately following this marker is the first */ -/* comment line to be placed into the comment area of the */ -/* binary DAS file. */ - -/* If the begin marker is blank, BEGMRK .EQ. ' ', then the */ -/* comments are assumed to start at the current location */ -/* in the comment text file. */ - -/* ENDMRK A marker which identifies the end of the comments in the */ -/* comment text file. This marker must appear on a line by */ -/* itself, and leading and trailing blanks are not */ -/* significant. */ - -/* The line immediately preceeding this marker is the last */ -/* comment line to be placed into the comment area of the */ -/* binary DAS file. */ - -/* If the end marker is blank, ENDMRK .EQ. ' ', then the */ -/* comments are assumed to stop at the end of the comment */ -/* text file. */ - -/* INSBLN A logical flag which indicates whether a blank line is */ -/* to be inserted into the comment area of the binary DAS */ -/* file attached to HANDLE before any comments are added */ -/* to the comment area of the DAS file. This is to provide */ -/* a simple mechanism for separating any comments already */ -/* contained in the comment area of a DAS file from those */ -/* comments that are being added. */ - -/* If the comment area of a binary DAS file is empty, the */ -/* value of this flag is not significant, the comments will */ -/* simply be placed into the comment area. */ - -/* HANDLE The file handle for a binary DAS file that has been */ -/* opened with write access. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the scratch file for temporarily holding the comments */ -/* culled from the text file cannot be opened, then the */ -/* error SPICE(FILEOPENFAILED) will be signalled. */ - -/* 2) If a non printing ASCII character is encountered in the */ -/* comments, the error SPICE(ILLEGALCHARACTER) will be */ -/* signalled. */ - -/* 3) If the begin marker cannot be found in the text file, the */ -/* error SPICE(MARKERNOTFOUND) will be signalled. */ - -/* 4) If the end marker cannot be found in the text file, the */ -/* error SPICE(MARKERNOTFOUND) will be signalled. */ - -/* $ Files */ - -/* 1) See parameters COMLUN and HANDLE in the $ Detailed_Inputs */ -/* section. */ - -/* 2) A scratch file is used to temporarily hold the comments */ -/* culled from the comment text file. This is so we do not */ -/* have to find the place where we started searching for */ -/* comments in the original file. */ - -/* $ Particulars */ - -/* This routine will place all lines between two specified markers, */ -/* a `begin comments marker' and an `end comments marker,' in a */ -/* text file into the comment area of a binary DAS file attached to */ -/* HANDLE. If the `begin comments marker' is blank, then the */ -/* comments are asumed to start at the current location of the */ -/* comment text file attached to COMLUN. If the `end comments */ -/* marker' is blank, then the comments are assumed to stop at the */ -/* end of the comment text file attached to COMLUN. */ - -/* $ Examples */ - -/* We will be using the files `jabber.txt', 'batty.txt', and */ -/* `wndrland.das' in the example which follows. */ - -/* `wndrland.das' is a binary DAS file with an empty comment area */ -/* into which we are going to place the entire file */ -/* `jabber.txt' and a selected portion of the file */ -/* `batty.txt'. */ - -/* `jabber.txt' is a text file that is to be placed into the */ -/* comment area of the binary DAS file `wndrland.das'. */ - -/* `batty.txt' is a text file from which will have a selected */ -/* portion of its text placed into the comment area */ -/* of the binary DAS file `wndrland.das'. */ - -/* Let -BOF- and -EOF- denote the beginning and end of a file, */ -/* respectively. */ - -/* The file `jabber.txt' contains: */ - -/* -BOF- */ -/* The Jabberwock */ - -/* 'Twas brillig, and the slithy toves */ -/* Did gyre and gimble in the wabe; */ -/* All mimsy were the borogoves, */ -/* And the mome raths outgrabe. */ - -/* ``Beware the Jabberwock, my son! */ -/* The jaws that bite, the claws that catch!'' */ - -/* And as in uffish thought he stood, */ -/* The Jabberwock, with eyes of flame, */ -/* Came whiffling through the tulgey wood, */ -/* And burbled as it came! */ - -/* One, two! One, two! And through and through */ -/* The vorpal blade went snicker-snack! */ -/* He left it dead, and with its head */ -/* He went galumphing back. */ - -/* ``And hast thou slain the Jabberwock? */ -/* Come to my arms, my beamish boy! */ -/* O frabjous day! Callooh! Callay!'' */ -/* He chortled in his joy. */ - -/* Through the Looking-Glass */ -/* Lewis Carroll */ -/* -EOF- */ - -/* The file `batty.txt' contains: */ - -/* -BOF- */ -/* This file contains a brief poem about bats. */ - -/* BEGIN bat poem */ -/* Twinkle, twinkle, little bat! */ -/* How I wonder what you're at! */ -/* Up above the world you fly! */ -/* Like a teatray in the sky. */ - -/* Alice's Adventures in Wonderland */ -/* Lewis Carroll */ -/* END bat poem */ - -/* And that's that for bats. */ -/* -EOF- */ - -/* Let */ - -/* JABLUN be the logical unit for the file `jabber.txt' */ -/* BATLUN be the logical unit for the file `batty.txt' */ -/* and */ -/* HANDLE be the DAS handle for the file `wndrland.das' */ - -/* The code fragment */ - -/* C */ -/* C Open the files. */ -/* C */ -/* CALL DASOPW ( `wndrland.das', HANDLE ) */ -/* CALL TXTOPN ( `jabber.txt' , JABLUN ) */ -/* CALL TXTOPN ( `batty.txt' , BATLUN ) */ -/* C */ -/* C Initialize the markers for the file `jabber.txt'. We want */ -/* C to include the entire file, so both markers are blank. */ -/* C */ -/* BEGMRK = ' ' */ -/* ENDMRK = ' ' */ -/* INSBLN = .TRUE. */ -/* C */ -/* C Add the comments from the file 'jabber.txt' */ -/* C */ -/* CALL DASACU ( JABLUN, BEGMRK, ENDMRK, INSBLN, HANDLE ) */ -/* C */ -/* C Initialize the markers for the file `batty.txt'. We want */ -/* C to include the bat poem only, so we define the begin and */ -/* C end markere accordingly. */ -/* C */ -/* BEGMRK = 'BEGIN bat poem' */ -/* ENDMRK = 'END bat poem' */ -/* INSBLN = .TRUE. */ -/* C */ -/* C Add the comments from the file 'batty.txt' */ -/* C */ -/* CALL DASACU ( BATLUN, BEGMRK, ENDMRK, INSBLN, HANDLE ) */ -/* C */ -/* C Close the files. */ - -/* CLOSE ( JABLUN ) */ -/* CLOSE ( BATLUN ) */ -/* CALL DASCLS ( HANDLE ) */ - -/* will create a comment area in `wndrland.das' which contains: */ - -/* -BOC- */ -/* The Jabberwock */ - -/* 'Twas brillig, and the slithy toves */ -/* Did gyre and gimble in the wabe; */ -/* All mimsy were the borogoves, */ -/* And the mome raths outgrabe. */ - -/* ``Beware the Jabberwock, my son! */ -/* The jaws that bite, the claws that catch!'' */ - -/* And as in uffish thought he stood, */ -/* The Jabberwock, with eyes of flame, */ -/* Came whiffling through the tulgey wood, */ -/* And burbled as it came! */ - -/* One, two! One, two! And through and through */ -/* The vorpal blade went snicker-snack! */ -/* He left it dead, and with its head */ -/* He went galumphing back. */ - -/* ``And hast thou slain the Jabberwock? */ -/* Come to my arms, my beamish boy! */ -/* O frabjous day! Callooh! Callay!'' */ -/* He chortled in his joy. */ - -/* Through the Looking-Glass */ -/* Lewis Carroll */ - -/* Twinkle, twinkle, little bat! */ -/* How I wonder what you're at! */ -/* Up above the world you fly! */ -/* Like a teatray in the sky. */ - -/* Alice's Adventures in Wonderland */ -/* Lewis Carroll */ -/* -EOC- */ - -/* where -BOC- and -EOC- represent the beginning and end of the */ -/* comments, respectively. */ - -/* $ Restrictions */ - -/* 1) The begin comments marker, BEGMRK, and the end comments marker, */ -/* ENDMRK, must each appear alone on a line in the comment text */ -/* file if they are not blank. */ - -/* 2) The maximum length of a text line in a comment file is */ -/* specified by the LINLEN parameter defined below. Currently */ -/* this values is 255 characters. */ - -/* 3) The maximum length of a single line comment in the comment */ -/* area is specified by the parameter LINLEN defined below. */ -/* Currently this value is 255 characters. */ - -/* 4) This routine uses constants that are specific to the ASCII */ -/* character sequence. The results of using this routine with */ -/* a different character sequence are unpredictable. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.2.0, 07-JUL-1996 (NJB) */ - -/* Removed declaration, DATA and SAVE statements for unused */ -/* variable FIRST. */ - -/* - Beta Version 1.1.0, 20-SEP-1995 (KRG) */ - -/* Added a check of FAILED after the call to GETLUN to trap */ -/* an error, if one is signalled by GETLUN, before attempting to */ -/* open the SCRATCH file. */ - -/* - Beta Version 1.0.0, 4-JAN-1993 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* add comments from a logical unit to a das file */ - -/* -& */ -/* $ Revisions */ - - -/* - SPICELIB 1.2.0, 07-JUL-1996 (NJB) */ - -/* Removed declaration, DATA and SAVE statements for unused */ -/* variable FIRST. */ - -/* - Beta Version 1.1.0, 20-SEP-1995 (KRG) */ - -/* Added a check of FAILED after the call to GETLUN to trap */ -/* an error, if one is signalled by GETLUN, before attempting to */ -/* open the SCRATCH file. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Set the value for the maximum length of a text line. */ - - -/* Set the length of a DAS file ID word. */ - - -/* Set the length of a DAS file internal filename. */ - - -/* Set the size of the comment buffer. */ - - -/* Maximum and minimum decimal values for the printable ASCII */ -/* characters. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASACU", (ftnlen)6); - } - -/* Verify that the DAS file attached to HANDLE is opened with write */ -/* access. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* Get the number of comment characters, and some other stuff that */ -/* we will not be using. */ - - dasrfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, (ftnlen) - 8, (ftnlen)60); - if (failed_()) { - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* Get an available logical unit for the comment scratch file. */ - - getlun_(&scrlun); - if (failed_()) { - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* Attempt to open the comment scratch file. */ - - o__1.oerr = 1; - o__1.ounit = scrlun; - o__1.ofnm = 0; - o__1.orl = 0; - o__1.osta = "SCRATCH"; - o__1.oacc = 0; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Attempt to open a temporary file failed. IOSTAT = #.", ( - ftnlen)52); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* Start looking for the begin comment marker. If the begin marker */ -/* is a blank line, then the comments begin on the first line of the */ -/* comment file. Otherwise, the comments begin on the line */ -/* immediately following the line which contains the begin comments */ -/* marker. */ - - s_copy(line, " ", (ftnlen)255, (ftnlen)1); - eof = FALSE_; - while(s_cmp(line, begmrk, (ftnlen)255, begmrk_len) != 0) { - readln_(comlun, line, &eof, (ftnlen)255); - ljust_(line, line, (ftnlen)255, (ftnlen)255); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* If we have encountered the end of file here, we have a */ -/* problem: We did not find the begin comments marker in the */ -/* text file. So, set an appropriate error message and signal */ -/* the error. don't forget to close the scratch file. */ - - if (eof) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("The begin comments marker '#' was not found in the comm" - "ent file '#'.", (ftnlen)68); - errch_("#", begmrk, (ftnlen)1, begmrk_len); - errfnm_("#", comlun, (ftnlen)1); - sigerr_("SPICE(MARKERNOTFOUND)", (ftnlen)21); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - -/* Begin reading in the comment lines from the comment file, */ -/* placing them a buffer at a time into the temporary file. */ -/* We also scan each line for non printing characters. */ - - s_copy(line, " ", (ftnlen)255, (ftnlen)1); - if (s_cmp(endmrk, " ", endmrk_len, (ftnlen)1) == 0) { - -/* If the end mark is blank, then we want to go until we hit the */ -/* end of the comment file. */ - - while(! eof) { - numcom = 0; - readla_(comlun, &c__22, &numcom, combuf, &eof, (ftnlen)255); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* If we got some comments, we need to scan them for non */ -/* printing characters. */ - - if (numcom > 0) { - i__1 = numcom; - for (i__ = 1; i__ <= i__1; ++i__) { - length = lastnb_(combuf + ((i__2 = i__ - 1) < 22 && 0 <= - i__2 ? i__2 : s_rnge("combuf", i__2, "dasacu_", ( - ftnlen)570)) * 255, (ftnlen)255); - -/* Scan the comment line for non printinig characters. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* Check to see that the characters in the buffer */ -/* are all printing ASCII characters. The bounds */ -/* for printing ASCII characters are given by */ -/* MAXPCH and MINPCH, which are defined in the */ -/* $ Local Parameters section of the header. */ - - intchr = *(unsigned char *)&combuf[((i__3 = i__ - 1) < - 22 && 0 <= i__3 ? i__3 : s_rnge("combuf", - i__3, "dasacu_", (ftnlen)582)) * 255 + (j - 1) - ]; - if (intchr > 126 || intchr < 32) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("A nonprinting character was encountered" - " in the comments. Value: #", (ftnlen)65); - errint_("#", &intchr, (ftnlen)1); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - } - -/* Write the comments to the temporary file. */ - - writla_(&numcom, combuf, &scrlun, (ftnlen)255); - } - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - } else { - -/* The endmark is non blank, then we want to go until we find a */ -/* line in the comment file that matches the end mark that was */ -/* entered. */ - - more = TRUE_; - while(more) { - numcom = 0; - readla_(comlun, &c__22, &numcom, combuf, &eof, (ftnlen)255); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* Look for ENDMRK in the current buffer if we got some */ -/* comments. */ - - if (numcom > 0) { - i__ = 1; - while(more && i__ <= numcom) { - s_copy(line, combuf + ((i__1 = i__ - 1) < 22 && 0 <= i__1 - ? i__1 : s_rnge("combuf", i__1, "dasacu_", ( - ftnlen)645)) * 255, (ftnlen)255, (ftnlen)255); - ljust_(line, line, (ftnlen)255, (ftnlen)255); - if (s_cmp(line, endmrk, (ftnlen)255, endmrk_len) == 0) { - more = FALSE_; - numcom = i__ - 1; - } else { - ++i__; - } - } - } - -/* If we still have some comments, we need to scan them for */ -/* non printing characters. */ - - if (numcom > 0) { - i__1 = numcom; - for (i__ = 1; i__ <= i__1; ++i__) { - length = lastnb_(combuf + ((i__2 = i__ - 1) < 22 && 0 <= - i__2 ? i__2 : s_rnge("combuf", i__2, "dasacu_", ( - ftnlen)670)) * 255, (ftnlen)255); - -/* Scan the comment line for non printinig characters. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* Check to see that the characters in the buffer */ -/* are all printing ASCII characters. The bounds */ -/* for printing ASCII characters are given by */ -/* MAXPCH and MINPCH, which are defined in the */ -/* $ Local Parameters section of the header. */ - - intchr = *(unsigned char *)&combuf[((i__3 = i__ - 1) < - 22 && 0 <= i__3 ? i__3 : s_rnge("combuf", - i__3, "dasacu_", (ftnlen)682)) * 255 + (j - 1) - ]; - if (intchr > 126 || intchr < 32) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("A nonprinting character was encountered" - " in the comment buffer. Value: #", ( - ftnlen)71); - errint_("#", &intchr, (ftnlen)1); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - } - -/* Write the comments to the temporary file. */ - - writla_(&numcom, combuf, &scrlun, (ftnlen)255); - } - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - -/* If we have encountered the end of file here, we have a */ -/* problem: We did not find the end comments marker in the */ -/* text file. So, set an appropriate error message and */ -/* signal the error. */ - - if (more && eof) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("The end comments marker '#' was not found in the co" - "mment file '#'.", (ftnlen)66); - errch_("#", endmrk, (ftnlen)1, endmrk_len); - errfnm_("#", comlun, (ftnlen)1); - sigerr_("SPICE(MARKERNOTFOUND)", (ftnlen)21); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - } - -/* If we made it to here, we have culled all of the comments out of */ -/* the text file and they were all OK. So we need to add all of the */ -/* comments to the DAS comment area now. */ - -/* If we are supposed to insert a blank line to separate the current */ -/* addition from any previously stored comments, and there are */ -/* comments already in the comment area, indicated by NCOMC > 0, then */ -/* we insert the blank line. Otherwise, just add the comments. */ - - if (*insbln && ncomc > 0) { - dasac_(handle, &c__1, " ", (ftnlen)1); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - -/* Rewind the scratch file to get ready to put the comments into the */ -/* comment area. */ - - al__1.aerr = 0; - al__1.aunit = scrlun; - f_rew(&al__1); - -/* Begin reading through the scratch file, placing the comment lines */ -/* into the comment area of the DAS file a buffer at a time */ - - eof = FALSE_; - while(! eof) { - numcom = 0; - -/* Read in a buffer of comment lines. */ - - readla_(&scrlun, &c__22, &numcom, combuf, &eof, (ftnlen)255); - -/* If we got some, add them to the comment area of the DAS file. */ - - if (numcom > 0) { - dasac_(handle, &numcom, combuf, (ftnlen)255); - } - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; - } - } - -/* Close the scratch file before exiting, it's the only one we */ -/* opened. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASACU", (ftnlen)6); - return 0; -} /* dasacu_ */ - diff --git a/ext/spice/src/cspice/dasadc.c b/ext/spice/src/cspice/dasadc.c deleted file mode 100644 index 893b526d85..0000000000 --- a/ext/spice/src/cspice/dasadc.c +++ /dev/null @@ -1,532 +0,0 @@ -/* dasadc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure DASADC ( DAS, add data, character ) */ -/* Subroutine */ int dasadc_(integer *handle, integer *n, integer *bpos, - integer *epos, char *data, ftnlen data_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer free; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, lastc, recno, ncomr, nmove, rcpos; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int dascud_(integer *, integer *, integer *), - dashfs_(integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - char record[1024]; - integer lastla[3]; - extern /* Subroutine */ int dasurc_(integer *, integer *, integer *, - integer *, char *, ftnlen), daswrc_(integer *, integer *, char *, - ftnlen); - integer lastrc[3], clsize, nmoved; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numchr; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer lastwd[3], nresvc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer wordno; - extern logical return_(void); - integer nresvr, nwritn, chr, elt; - -/* $ Abstract */ - -/* Add character data to a DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* N I Number of characters to add to file. */ -/* BPOS, */ -/* EPOS I Begin and end positions of substrings. */ -/* DATA I Array of character strings. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* N is the number of characters, in the specified set */ -/* of substrings, to add to the specified DAS file. */ - -/* BPOS, */ -/* EPOS are begin and end character positions that define */ -/* a set of substrings in the input array. This */ -/* routine writes characters from the specified set */ -/* of substrings to the specified DAS file. */ - -/* DATA is an array of character strings, some portion of */ -/* whose contents are to be added to the specified */ -/* DAS file. Specifically, the first N characters of */ -/* the substrings */ - -/* DATA(I) (BPOS:EPOS), I = 1, ... */ - -/* are appended to the character data in the file. */ -/* The order of characters in the input substrings */ -/* is considered to increase from left to right */ -/* within each element of DATA, and to increase */ -/* with the indices of the elements of DATA. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If EPOS or BPOS are outside of the range */ - -/* [ 1, LEN( DATA(1) ) ] */ - -/* or if EPOS < BPOS, the error SPICE(BADSUBSTRINGBOUNDS) will */ -/* be signalled. */ - -/* 3) If the input count N is less than 1, no data will be */ -/* added to the specified DAS file. */ - -/* 4) If an I/O error occurs during the data addition attempted */ -/* by this routine, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 5) If N is greater than the number of characters in the */ -/* specified set of input substrings, the results of calling */ -/* this routine are unpredictable. This routine cannot */ -/* detect this error. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine adds character data to a DAS file by `appending' it */ -/* after any character data already in the file. The sense in which */ -/* the data is `appended' is that the data will occupy a range of */ -/* logical addresses for character data that immediately follow the */ -/* last logical address of a character that is occupied at the time */ -/* this routine is called. The diagram below illustrates this */ -/* addition: */ - -/* +-------------------------+ */ -/* | (already in use) | Character logical address 1 */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ Last character logical address */ -/* | (already in use) | in use before call to DASADC */ -/* +-------------------------+ */ -/* | DATA(1) (BPOS:BPOS) | First added character */ -/* +-------------------------+ */ -/* | DATA(1) (BPOS+1:BPOS+1) | */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ */ -/* | DATA(1) (EPOS:EPOS) | */ -/* +-------------------------+ */ -/* | DATA(2) (BPOS:BPOS) | */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ */ -/* | DATA(R) (C:C) | Nth added character---here R is */ -/* +-------------------------+ */ -/* INT ( (N+L-1)/L ) */ - -/* where L = EPOS - BPOS + 1, and */ -/* C is */ - -/* N - (R-1)*L */ - - -/* The logical organization of the characters in the DAS file is */ -/* independent of the order of addition to the file or physical */ -/* location of any data of integer or double precision type. */ - -/* The actual physical write operations that add the input array */ -/* DATA to the indicated DAS file may not take place before this */ -/* routine returns, since the DAS system buffers data that is */ -/* written as well as data that is read. In any case, the data */ -/* will be flushed to the file at the time the file is closed, if */ -/* not earlier. A physical write of all buffered records can be */ -/* forced by calling the SPICELIB routine DASWUR ( DAS, write */ -/* updated records ). */ - -/* In order to update character logical addresses that already */ -/* contain data, the SPICELIB routine DASUDC (DAS, update data, */ -/* character) should be used. */ - -/* $ Examples */ - -/* 1) Create the new DAS file TEST.DAS and add 120 characters to it. */ -/* Close the file, then re-open it and read the data back out. */ - - -/* PROGRAM TEST_ADD */ - -/* CHARACTER*(80) LINES ( 3 ) */ -/* CHARACTER*(4) TYPE */ - -/* INTEGER HANDLE */ -/* INTEGER I */ - -/* DATA LINES / 'Here is the first line.', */ -/* . 'Here is the second line.', */ -/* . 'Here is the third line.' / */ - -/* C */ -/* C Open a new DAS file. Use the file name as */ -/* C the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Add the contents of the array LINES to the file. */ -/* C Since the lines are short, just use the first 40 */ -/* C characters of each one. */ -/* C */ -/* CALL DASADC ( HANDLE, 120, 1, 40, LINES ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now verify the addition of data by opening the */ -/* C file for read access and retrieving the data. */ -/* C */ -/* CALL DASOPR ( 'TEST.DAS', HANDLE ) */ - -/* DO I = 1, 3 */ -/* LINES(I) = ' ' */ -/* END DO */ - -/* CALL DASRDC ( HANDLE, 1, 120, 1, 40, LINES ) */ - -/* C */ -/* C Dump the data to the screen. We should see the */ -/* C sequence */ -/* C */ -/* C Here is the first line. */ -/* C Here is the second line. */ -/* C Here is the third line. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data from TEST.DAS: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) LINES */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.1.0 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new, which makes use of the file */ -/* type. Also, a variable for the type of the file to be created */ -/* was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* add character data to a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L, DASURC or */ -/* DASWRC signaled an error inside the loop. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new, which makes use of the file */ -/* type. Also, a variable for the type of the file to be created */ -/* was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASADC", (ftnlen)6); - } - -/* Make sure BPOS and EPOS are OK; stop here if not. */ - - if (*bpos < 1 || *epos < 1 || *bpos > i_len(data, data_len) || *epos > - i_len(data, data_len)) { - setmsg_("Substring bounds must be in range [1,#]. Actual range [BPOS" - ",EPOS] was [#,#].", (ftnlen)76); - i__1 = i_len(data, data_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", bpos, (ftnlen)1); - errint_("#", epos, (ftnlen)1); - sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25); - chkout_("DASADC", (ftnlen)6); - return 0; - } else if (*epos < *bpos) { - setmsg_("Substring upper bound must not be less than lower bound. A" - "ctual range [BPOS,EPOS] was [#,#].", (ftnlen)93); - errint_("#", bpos, (ftnlen)1); - errint_("#", epos, (ftnlen)1); - sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25); - chkout_("DASADC", (ftnlen)6); - return 0; - } - -/* Get the file summary for this DAS. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - lastc = lastla[0]; - -/* We will keep track of the location that we wish to write to */ -/* with the variables RECNO and WORDNO. RECNO will be the record */ -/* number of the record we'll write to; WORDNO will be the number */ -/* preceding the word index, within record number RECNO, that we'll */ -/* write to. For example, if we're about to write to the first */ -/* character in record 10, RECNO will be 10 and WORDNO will be 0. Of */ -/* course, when WORDNO reaches NWC, we'll have to find a free record */ -/* before writing anything. */ - -/* Prepare the variables RECNO and WORDNO: use the physical location */ -/* of the last character address, if there are any character data in */ -/* the file. Otherwise, RECNO becomes the first record available for */ -/* character data. */ - - if (lastc >= 1) { - dasa2l_(handle, &c__1, &lastc, &clbase, &clsize, &recno, &wordno); - } else { - recno = free; - wordno = 0; - } - -/* Set the number of character words already written. Keep */ -/* writing to the file until this number equals the number of */ -/* elements in DATA. */ - -/* Note that if N is non-positive, the loop doesn't get */ -/* exercised. */ - -/* Also initialize the array element index and position of the */ -/* character to be moved next. */ - - nwritn = 0; - elt = 1; - chr = *bpos; - while(nwritn < *n && ! failed_()) { - -/* Write as much data as we can (or need to) into the current */ -/* record. We assume that RECNO, WORDNO, and NWRITN have */ -/* been set correctly at this point. */ - -/* Find out how many words to write into the current record. */ -/* There may be no space left in the current record. */ - -/* Computing MIN */ - i__1 = *n - nwritn, i__2 = 1024 - wordno; - numchr = min(i__1,i__2); - if (numchr > 0) { - -/* Write NUMCHR words into the current record. If the record */ -/* is new, write the entire record. Otherwise, just update */ -/* the part we're interested in. */ - -/* In either case, we'll first fill in characters WORDNO+1 */ -/* through WORDNO + NUMCHR of the string RECORD. */ - - -/* So far, we haven't moved any characters. */ - - nmoved = 0; - rcpos = wordno; - while(nmoved < numchr) { - -/* Find out how many characters in the current array */ -/* element we should move. */ - - if (chr > *epos) { - ++elt; - chr = *bpos; - } -/* Computing MIN */ - i__1 = numchr - nmoved, i__2 = *epos - chr + 1; - nmove = min(i__1,i__2); - i__1 = rcpos; - s_copy(record + i__1, data + ((elt - 1) * data_len + (chr - 1) - ), rcpos + nmove - i__1, data_len - (chr - 1)); - nmoved += nmove; - rcpos += nmove; - chr += nmove; - } - -/* Now we can write or update the file with RECORD. */ - - if (wordno == 0) { - -/* The record has not yet been written, so write out the */ -/* entire record. */ - - daswrc_(handle, &recno, record, (ftnlen)1024); - } else { - -/* Update elements WORDNO+1 through WORDNO+NUMCHR. */ - - i__1 = wordno; - i__2 = wordno + 1; - i__3 = wordno + numchr; - dasurc_(handle, &recno, &i__2, &i__3, record + i__1, wordno + - numchr - i__1); - } - nwritn += numchr; - wordno += numchr; - } else { - -/* It's time to start on a new record. If the record we */ -/* just finished writing to (or just attempted writing to, */ -/* if it was full) was FREE or a higher-numbered record, */ -/* then we are writing to a contiguous set of data records: */ -/* the next record to write to is the immediate successor */ -/* of the last one. Otherwise, FREE is the next record */ -/* to write to. */ - -/* We intentionally leave FREE at the value it had before */ -/* we starting adding data to the file. */ - - if (recno >= free) { - ++recno; - } else { - recno = free; - } - wordno = 0; - } - } - -/* Update the DAS file directories to reflect the addition of N */ -/* character words. DASCUD will also update the file summary */ -/* accordingly. */ - - dascud_(handle, &c__1, n); - chkout_("DASADC", (ftnlen)6); - return 0; -} /* dasadc_ */ - diff --git a/ext/spice/src/cspice/dasadd.c b/ext/spice/src/cspice/dasadd.c deleted file mode 100644 index 413b6edd91..0000000000 --- a/ext/spice/src/cspice/dasadd.c +++ /dev/null @@ -1,412 +0,0 @@ -/* dasadd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure DASADD ( DAS, add data, double precision ) */ -/* Subroutine */ int dasadd_(integer *handle, integer *n, doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer free; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, recno, lastd; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - integer ncomr, numdp; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int dascud_(integer *, integer *, integer *), - dashfs_(integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - doublereal record[128]; - integer lastla[3]; - extern /* Subroutine */ int dasurd_(integer *, integer *, integer *, - integer *, doublereal *), daswrd_(integer *, integer *, - doublereal *); - integer lastrc[3], clsize; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer lastwd[3], nresvc, wordno; - extern logical return_(void); - integer nresvr, nwritn; - -/* $ Abstract */ - -/* Add an array of double precision numbers to a DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* N I Number of d.p. numbers to add to DAS file. */ -/* DATA I Array of d.p. numbers to add. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* N is a the number of double precision `words' to */ -/* add to the DAS file specified by HANDLE. */ - -/* DATA is an array of double precision numbers to be */ -/* added to the specified DAS file. Elements */ -/* 1 through N are appended to the double precision */ -/* data in the file. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If an I/O error occurs during the data addition attempted */ -/* by this routine, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If the input count N is less than 1, no data will be */ -/* added to the specified DAS file. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine adds double precision data to a DAS file by */ -/* `appending' it after any double precision data already in the */ -/* file. The sense in which the data is `appended' is that the */ -/* data will occupy a range of logical addresses for double precision */ -/* data that immediately follow the last logical address of a double */ -/* precision number that is occupied at the time this routine is */ -/* called. The diagram below illustrates this addition: */ - -/* +-------------------------+ */ -/* | (already in use) | D.p. logical address 1 */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ */ -/* | (already in use) | Last d.p. logical address */ -/* +-------------------------+ in use before call to DASADD */ -/* | DATA(1) | */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ */ -/* | DATA(N) | */ -/* +-------------------------+ */ - - -/* The logical organization of the double precision numbers in the */ -/* DAS file is independent of the order of addition to the file or */ -/* physical location of any data of integer or character type. */ - -/* The actual physical write operations that add the input array */ -/* DATA to the indicated DAS file may not take place before this */ -/* routine returns, since the DAS system buffers data that is */ -/* written as well as data that is read. In any case, the data */ -/* will be flushed to the file at the time the file is closed, if */ -/* not earlier. A physical write of all buffered records can be */ -/* forced by calling the SPICELIB routine DASWUR ( DAS, write */ -/* updated records ). */ - -/* In order to update double precision logical addresses that */ -/* already contain data, the SPICELIB routine DASUDD */ -/* ( DAS update data, double precision ) should be used. */ - -/* $ Examples */ - -/* 1) Create the new DAS file TEST.DAS and add 200 double */ -/* precision numbers to it. Close the file, then re-open */ -/* it and read the data back out. */ - - -/* PROGRAM TEST_ADD */ - -/* CHARACTER*(4) TYPE */ - -/* DOUBLE PRECISION DATA ( 200 ) */ - -/* INTEGER HANDLE */ -/* INTEGER I */ -/* C */ -/* C Open a new DAS file. Use the file name as */ -/* C the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Fill the array DATA with the double precision */ -/* C numbers 1.D0 through 100.D0, and add this array */ -/* C to the file. */ -/* C */ -/* DO I = 1, 100 */ -/* DATA(I) = DBLE(I) */ -/* END DO */ - -/* CALL DASADD ( HANDLE, 100, DATA ) */ - -/* C */ -/* C Now append the array DATA to the file again. */ -/* C */ -/* CALL DASADD ( HANDLE, 100, DATA ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now verify the addition of data by opening the */ -/* C file for read access and retrieving the data. */ -/* C */ -/* CALL DASRDD ( HANDLE, 1, 200, DATA ) */ - -/* C */ -/* C Dump the data to the screen. We should see the */ -/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. The */ -/* C numbers will be represented as double precision */ -/* C numbers in the output. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data from TEST.DAS: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) DATA */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new, which makes use of the file */ -/* type. Also, a variable for the type of the file to be created */ -/* was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* add double precision data to a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L, DASURD or */ -/* DASWRD signaled an error inside the loop. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new, which makes use of the file */ -/* type. Also, a variable for the type of the file to be created */ -/* was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASADD", (ftnlen)6); - } - -/* Get the file summary for this DAS. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - lastd = lastla[1]; - -/* We will keep track of the location that we wish to write to */ -/* with the variables RECNO and WORDNO. RECNO will be the record */ -/* number of the record we'll write to; WORDNO will be the number */ -/* preceding the word index, within record number RECNO, that we'll */ -/* write to. For example, if we're about to write to the first */ -/* double precision number in record 10, RECNO will be 10 and */ -/* WORDNO will be 0. Of course, when WORDNO reaches NWD, we'll */ -/* have to find a free record before writing anything. */ - -/* Prepare the variables RECNO and WORDNO: use the physical */ -/* location of the last double precision address, if there are any */ -/* double precision data in the file. Otherwise, RECNO becomes the */ -/* first record available for double precision data. */ - - if (lastd >= 1) { - dasa2l_(handle, &c__2, &lastd, &clbase, &clsize, &recno, &wordno); - } else { - recno = free; - wordno = 0; - } - -/* Set the number of double precision words already written. Keep */ -/* writing to the file until this number equals the number of */ -/* elements in DATA. */ - -/* Note that if N is non-positive, the loop doesn't get exercised. */ - - - nwritn = 0; - while(nwritn < *n && ! failed_()) { - -/* Write as much data as we can (or need to) into the current */ -/* record. We assume that RECNO, WORDNO, and NWRITN have been */ -/* set correctly at this point. */ - -/* Find out how many words to write into the current record. */ -/* There may be no space left in the current record. */ - -/* Computing MIN */ - i__1 = *n - nwritn, i__2 = 128 - wordno; - numdp = min(i__1,i__2); - if (numdp > 0) { - -/* Write NUMDP words into the current record. If the record */ -/* is new, write the entire record. Otherwise, just update */ -/* the part we're interested in. */ - - if (wordno == 0) { - moved_(&data[nwritn], &numdp, record); - daswrd_(handle, &recno, record); - } else { - i__1 = wordno + 1; - i__2 = wordno + numdp; - dasurd_(handle, &recno, &i__1, &i__2, &data[nwritn]); - } - nwritn += numdp; - wordno += numdp; - } else { - -/* It's time to start on a new record. If the record we */ -/* just finished writing to (or just attempted writing to, */ -/* if it was full) was FREE or a higher-numbered record, */ -/* then we are writing to a contiguous set of data records: */ -/* the next record to write to is the immediate successor */ -/* of the last one. Otherwise, FREE is the next record */ -/* to write to. */ - -/* We intentionally leave FREE at the value it had before */ -/* we starting adding data to the file. */ - - if (recno >= free) { - ++recno; - } else { - recno = free; - } - wordno = 0; - } - } - -/* Update the DAS file directories to reflect the addition of N */ -/* double precision words. DASCUD will also update the file summary */ -/* accordingly. */ - - dascud_(handle, &c__2, n); - chkout_("DASADD", (ftnlen)6); - return 0; -} /* dasadd_ */ - diff --git a/ext/spice/src/cspice/dasadi.c b/ext/spice/src/cspice/dasadi.c deleted file mode 100644 index 47381d1961..0000000000 --- a/ext/spice/src/cspice/dasadi.c +++ /dev/null @@ -1,391 +0,0 @@ -/* dasadi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure DASADI ( DAS, add data, integer ) */ -/* Subroutine */ int dasadi_(integer *handle, integer *n, integer *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer free; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, recno, lasti, ncomr; - extern /* Subroutine */ int movei_(integer *, integer *, integer *), - dasa2l_(integer *, integer *, integer *, integer *, integer *, - integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int dascud_(integer *, integer *, integer *), - dashfs_(integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - integer record[256], lastla[3]; - extern /* Subroutine */ int dasuri_(integer *, integer *, integer *, - integer *, integer *); - integer lastrc[3], clsize; - extern /* Subroutine */ int daswri_(integer *, integer *, integer *), - chkout_(char *, ftnlen); - integer lastwd[3], nresvc, wordno, numint; - extern logical return_(void); - integer nresvr, nwritn; - -/* $ Abstract */ - -/* Add an array of integers to a DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* N I Number of integers to add to DAS file. */ -/* DATA I Array of integers to add. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* N is a the number of integer `words' to */ -/* add to the DAS file specified by HANDLE. */ - -/* DATA is an array of integers to be added to the */ -/* specified DAS file. Elements 1 through N are */ -/* appended to the integer data in the file. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If an I/O error occurs during the data addition attempted */ -/* by this routine, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If the input count N is less than 1, no data will be */ -/* added to the specified DAS file. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine adds integer data to a DAS file by `appending' it */ -/* after any integer data already in the file. The sense in which */ -/* the data is `appended' is that the data will occupy a range of */ -/* logical addresses for integer data that immediately follow the */ -/* last logical address of a integer that is occupied at the time */ -/* this routine is called. The diagram below illustrates this */ -/* addition: */ - -/* +-------------------------+ */ -/* | (already in use) | Integer logical address 1 */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ */ -/* | (already in use) | Last integer logical address */ -/* +-------------------------+ in use before call to DASADI */ -/* | DATA(1) | */ -/* +-------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-------------------------+ */ -/* | DATA(N) | */ -/* +-------------------------+ */ - - -/* The logical organization of the integers in the DAS file is */ -/* independent of the order of addition to the file or physical */ -/* location of any data of double precision or character type. */ - -/* The actual physical write operations that add the input array */ -/* DATA to the indicated DAS file may not take place before this */ -/* routine returns, since the DAS system buffers data that is */ -/* written as well as data that is read. In any case, the data */ -/* will be flushed to the file at the time the file is closed, if */ -/* not earlier. A physical write of all buffered records can be */ -/* forced by calling the SPICELIB routine DASWUR ( DAS, write */ -/* updated records ). */ - -/* In order to update integer logical addresses that already contain */ -/* data, the SPICELIB routine DASUDI ( DAS update data, integer ) */ -/* should be used. */ - -/* $ Examples */ - -/* 1) Create the new DAS file TEST.DAS and add 200 integers to it. */ -/* Close the file, then re-open it and read the data back out. */ - - -/* PROGRAM TEST_ADD */ - -/* CHARACTER*(4) TYPE */ - -/* INTEGER DATA ( 200 ) */ - -/* INTEGER HANDLE */ -/* INTEGER I */ -/* C */ -/* C Open a new DAS file. Use the file name as */ -/* C the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Fill the array DATA with the integers 1 through */ -/* C 100, and add this array to the file. */ -/* C */ -/* DO I = 1, 100 */ -/* DATA(I) = I */ -/* END DO */ - -/* CALL DASADI ( HANDLE, 100, DATA ) */ - -/* C */ -/* C Now append the array DATA to the file again. */ -/* C */ -/* CALL DASADI ( HANDLE, 100, DATA ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now verify the addition of data by opening the */ -/* C file for read access and retrieving the data. */ -/* C */ -/* CALL DASRDI ( HANDLE, 1, 200, DATA ) */ - -/* C */ -/* C Dump the data to the screen. We should see the */ -/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data from TEST.DAS: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) DATA */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination conditions. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new, which makes use of the file */ -/* type. Also, a variable for the type of the file to be created */ -/* was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* add integer data to a DAS file */ -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L, DASURI or */ -/* DASWRI signaled an error inside the loop. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASADI", (ftnlen)6); - } - -/* Get the file summary for this DAS. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - lasti = lastla[2]; - -/* We will keep track of the location that we wish to write to */ -/* with the variables RECNO and WORDNO. RECNO will be the record */ -/* number of the record we'll write to; WORDNO will be the number */ -/* preceding the word index, within record number RECNO, that we'll */ -/* write to. For example, if we're about to write to the first */ -/* integer in record 10, RECNO will be 10 and WORDNO will be 0. Of */ -/* course, when WORDNO reaches NWI, we'll have to find a free record */ -/* before writing anything. */ - -/* Prepare the variables RECNO and WORDNO: use the physical */ -/* location of the last integer address, if there are any integer */ -/* data in the file. Otherwise, RECNO becomes the first record */ -/* available for integer data. */ - - if (lasti >= 1) { - dasa2l_(handle, &c__3, &lasti, &clbase, &clsize, &recno, &wordno); - } else { - recno = free; - wordno = 0; - } - -/* Set the number of integer words already written. Keep */ -/* writing to the file until this number equals the number of */ -/* elements in DATA. */ - -/* Note that if N is non-positive, the loop doesn't get exercised. */ - - - nwritn = 0; - while(nwritn < *n && ! failed_()) { - -/* Write as much data as we can (or need to) into the current */ -/* record. We assume that RECNO, WORDNO, and NWRITN have been */ -/* set correctly at this point. */ - -/* Find out how many words to write into the current record. */ -/* There may be no space left in the current record. */ - -/* Computing MIN */ - i__1 = *n - nwritn, i__2 = 256 - wordno; - numint = min(i__1,i__2); - if (numint > 0) { - -/* Write NUMINT words into the current record. If the record */ -/* is new, write the entire record. Otherwise, just update */ -/* the part we're interested in. */ - - if (wordno == 0) { - movei_(&data[nwritn], &numint, record); - daswri_(handle, &recno, record); - } else { - i__1 = wordno + 1; - i__2 = wordno + numint; - dasuri_(handle, &recno, &i__1, &i__2, &data[nwritn]); - } - nwritn += numint; - wordno += numint; - } else { - -/* It's time to start on a new record. If the record we */ -/* just finished writing to (or just attempted writing to, */ -/* if it was full) was FREE or a higher-numbered record, */ -/* then we are writing to a contiguous set of data records: */ -/* the next record to write to is the immediate successor */ -/* of the last one. Otherwise, FREE is the next record */ -/* to write to. */ - -/* We intentionally leave FREE at the value it had before */ -/* we starting adding data to the file. */ - - if (recno >= free) { - ++recno; - } else { - recno = free; - } - wordno = 0; - } - } - -/* Update the DAS file directories to reflect the addition of N */ -/* integer words. DASCUD will also update the file summary */ -/* accordingly. */ - - dascud_(handle, &c__3, n); - chkout_("DASADI", (ftnlen)6); - return 0; -} /* dasadi_ */ - diff --git a/ext/spice/src/cspice/dasbt.c b/ext/spice/src/cspice/dasbt.c deleted file mode 100644 index a46dcfe99c..0000000000 --- a/ext/spice/src/cspice/dasbt.c +++ /dev/null @@ -1,1311 +0,0 @@ -/* dasbt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__4 = 4; - -/* $Procedure DASBT ( DAS, convert binary file to transfer file ) */ -/* Subroutine */ int dasbt_(char *binfil, integer *xfrlun, ftnlen binfil_len) -{ - /* System generated locals */ - address a__1[3]; - integer i__1[3], i__2; - char ch__1[10], ch__2[62]; - cilist ci__1; - - /* Builtin functions */ - integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char line[80]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, recno; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - integer ncomr; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer dtabeg, ncdata, handle, nddata; - char ifname[60]; - integer nidata; - extern /* Subroutine */ int daslla_(integer *, integer *, integer *, - integer *); - char crecrd[1024]; - extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *, - ftnlen, ftnlen), dasrdc_(integer *, integer *, integer *, integer - *, integer *, char *, ftnlen); - char cbuffr[4*1024]; - doublereal dbuffr[1024]; - extern /* Subroutine */ int dascls_(integer *); - integer ibuffr[1024]; - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dashlu_(integer *, integer *); - integer daslun; - extern /* Subroutine */ int dasrfr_(integer *, char *, char *, integer *, - integer *, integer *, integer *, ftnlen, ftnlen); - char idword[8]; - integer numblk, numdta; - extern /* Subroutine */ int dasopr_(char *, integer *, ftnlen), chkout_( - char *, ftnlen), errfnm_(char *, integer *, ftnlen); - integer nresvc; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer numlft; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), wrenci_( - integer *, integer *, integer *), wrencc_(integer *, integer *, - char *, ftnlen), wrencd_(integer *, integer *, doublereal *), - dasrdi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer nresvr; - -/* $ Abstract */ - -/* Convert the contents of a binary DAS file to an equivalent DAS */ -/* transfer file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINFIL I Name of the binary DAS file to be converted. */ -/* XFRLUN I Logical unit of a previously opened file. */ - -/* $ Detailed_Input */ - -/* BINFIL The name of a binary DAS file which is to be converted */ -/* to an equivalent DAS transfer file. */ - -/* XFRLUN The Fortran logical unit number of a previously opened */ -/* file. The DAS transfer file will be written to the */ -/* file attached to this logical unit beginning at the */ -/* current position in the file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments BINFIL, XFRLUN. */ - -/* $ Exceptions */ - -/* 1) If the binary DAS file specified by the filename BINFIL */ -/* cannot be opened for read access, an appropriate error */ -/* message will be signalled by a DAS file access routine that */ -/* is called by this routine. */ - -/* 2) If for some reason the DAS transfer file cannot be written */ -/* to, the error SPICE(FILEWRITEFAILED) is signalled. */ - -/* 3) If, for any reason, the DAS file cannot be read, a DAS file */ -/* access routine will signal an error with appropriate error */ -/* message. */ - -/* 4) The binary DAS file opened by this routine, BINFIL, is only */ -/* GUARANTEED to be closed upon successful completion of the */ -/* binary to transfer conversion process. In the event of an */ -/* error, the caller of this routine is required to close the */ -/* binary DAS file BINFIL. */ - -/* 5) If the values for the number of reserved records or the */ -/* number of reserved characters in a DAS file is nonzero, */ -/* the error SPICE(BADDASFILE) will be signalled. THIS ERROR */ -/* IS SIGNALLED ONLY BECAUSE THE RESERVED RECORD AREA HAS */ -/* NOT YET BEEN IMPLEMENTED. */ - -/* $ Particulars */ - -/* Any binary DAS file may be transferred between heterogeneous */ -/* Fortran environments by converting it to an equivalent file */ -/* containing only ASCII characters called a DAS transfer file. */ -/* Such a file can be transferred almost universally using any number */ -/* of established protocols. Once transferred, the DAS transfer file */ -/* can be converted to a binary file using the representations native */ -/* to the new host environment. */ - -/* This routine provides a mechanism for converting a binary DAS */ -/* file into an equivalent DAS transfer file. It is one of a pair of */ -/* routines for performing conversions between the binary format of a */ -/* DAS file and the DAS transfer file. The inverse of this routine is */ -/* the routine DASTB. */ - -/* Upon successful completion, the DAS transfer file attached to */ -/* Fortran logical unit XFRLUN will contain the same data as the */ -/* binary DAS file BINFIL in an encoded ASCII format. The binary DAS */ -/* file BINFIL will be closed when this routine exits successfully. */ -/* The DAS transfer file will remain open, as it was on entry, and it */ -/* will be positioned to write on the first line following the */ -/* encoded data from the binary DAS file. */ - -/* $ Examples */ - -/* Let */ - -/* BINFIL be the name of a binary DAS file which is to be */ -/* converted to an equivalent DAS transfer file. This */ -/* could be for purposes of porting the data to a */ -/* different computer platform, or possibly for */ -/* archival storage of the data. */ - -/* XFRLUN be the Fortran logical unit to which the DAS transfer */ -/* file is to be written. */ - -/* Then, the following subroutine call would read the binary DAS */ -/* file BINFIL, convert its contents into an encoded format, and */ -/* then write that data to the DAS transfer file attached to XFRLUN, */ -/* beginning at the current position in that file. */ - -/* CALL DASBT ( BINFIL, XFRLUN ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 13-AUG-1994 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name TXTLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* - SPICELIB Version 2.0.0, 13-AUG-1994 (KRG) */ - -/* A potential problem with list directed writes was fixed. Some */ -/* compilers have list directed writes that write multiple comma */ -/* separated items to one line and other compilers write these to */ -/* multiple lines even when all of the output will fit on a single */ -/* line. This was fixed by replacing all of the affected list */ -/* directed write statements with code to put the desired data */ -/* into a character string and then write the character string. */ - -/* - SPICELIB Version 1.0.0, 29-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert binary das to das transfer file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 13-AUG-1994 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name TXTLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* - SPICELIB Version 2.0.0, 13-AUG-1994 (KRG) */ - -/* A potential problem with list directed writes was fixed. Some */ -/* compilers have list directed writes that write multiple comma */ -/* separated items to one line and other compilers write these to */ -/* multiple lines even when all of the output will fit on a single */ -/* line. This was fixed by replacing all of the affected list */ -/* directed write statements with code to put the desired data */ -/* into a character string and then write the character string. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* CHARACTER*(*) BEGRES */ -/* PARAMETER ( BEGRES = 'BEGIN_RESERVED_BLOCK' ) */ - -/* CHARACTER*(*) ENDRES */ -/* PARAMETER ( ENDRES = 'END_RESERVED_BLOCK' ) */ - -/* CHARACTER*(*) TRRBLK */ -/* PARAMETER ( TRRBLK = 'TOTAL_RESERVED_BLOCKS' ) */ - - -/* Some parameters for writing the array markers */ - - -/* Length of a character buffer array element. */ - - -/* Length of a DAS file ID word. */ - - -/* Length of a DAS internal filename. */ - - -/* Length of a DAS comment record, in characters. */ - - -/* Size of the character, double precision, and integer data buffers. */ - - -/* Beginning and ending string positions for reading/writing */ -/* character data from/to a DAS file using the character data */ -/* buffer. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASBT", (ftnlen)5); - } - -/* When converting a binary DAS file into its DAS transfer file */ -/* equivalent, all of the data contained in the binary file is */ -/* placed into the DAS transfer file by this routine. This includes */ -/* the reserved record area, the comment area, and the character, */ -/* double precision, and integer data arrays as well. */ - -/* Currently, the reserved record area has not been implemented, as */ -/* there is no need for it at this time. If, or when, the reserved */ -/* record area is implemented, this routine will need to be modified */ -/* in order to support it. See the code for details. */ - -/* The data from the binary file are written to the DAS transfer */ -/* file as sequences of small blocks of data. This is to provide */ -/* a means for performing some error detection when converting a */ -/* DAS transfer file into its binary equivalent. Each block of */ -/* data is enclosed within begin and end block markers which hold */ -/* the count of data items in a data block. When all of the data */ -/* blocks for a data area have been written, a total blocks line is */ -/* written to the DAS transfer file. */ - -/* The data from the binary DAS file MUST appear in the following */ -/* order in the DAS transfer file. */ - -/* 1) Reserved records (when/if implemented) */ -/* 2) Comment area */ -/* 3) Character data array */ -/* 4) Double precision data array */ -/* 5) Integer data array */ - -/* If the data count for any of these DAS data areas is zero, no */ -/* data or markers for it are placed into the DAS transfer file. */ -/* Conversion proceeds with the next DAS data area in the list. */ - -/* For example, suppose that we have a binary DAS file where there */ -/* are 0 reserved characters in the reserved record area, 5000 */ -/* comment characters in the comment area, and that the character, */ -/* double precision, and integer array counts are 0, 2300, and */ -/* 6900, respectively. Then, the DAS transfer file will contain */ -/* no reserved record data blocks, 2 comment data blocks, no */ -/* character data blocks, 3 double precision data blocks, and 7 */ -/* integer data blocks, in that order. */ - -/* DAS transfer file description. */ -/* ---------------------------------- */ - -/* A brief description of the DAS encoded file format and its */ -/* intended use follows. This description is intended to provide a */ -/* simple ``picture'' of the DAS transfer file format to aid in the */ -/* understanding of this routine. This description is NOT intended to */ -/* be a detailed specification of the file format. */ - -/* A DAS transfer file contains all of the data from a binary */ -/* DAS file in an encoded ASCII format. It also contains some */ -/* bookkeeping information for maintaining the integrity of the */ -/* data. The DAS transfer file format allows the full precision of */ -/* character, integer, and floating point numeric data to be */ -/* maintained in a portable fashion. The DAS transfer file format is */ -/* intended to provide a reliable and accurate means for porting data */ -/* among multiple computer systems and for the archival storage of */ -/* data. */ - -/* A DAS transfer file is not intended to be used directly to provide */ -/* data to a program. The equivalent binary DAS file is to be used */ -/* for this purpose. In no way should any program, other than a DAS */ -/* binary <-> transfer conversion program, rely on the DAS transfer */ -/* file format. */ - -/* To correctly understand the DAS transfer file description the */ -/* reader should be familiar with the DAS file architecture. Items */ -/* enclosed in angle brackets, '<' and '>', are used to represent the */ -/* data which are to be placed at that position in the file. The */ -/* bookkeeping information which appears is represented exactly as it */ -/* would appear in a DAS transfer file. */ - -/* Let */ - -/* denote the beginning of the file */ -/* denote the end of the file */ - -/* and */ - -/* nresvb denote the number of encoded reserved record data */ -/* blocks generated */ -/* nresvc denote the total number of reserved record characters */ -/* in the reserved record area of a DAS file */ -/* ncomb denote the number of encoded comment data blocks */ -/* generated */ -/* ncomc denote the total number of comment characters in the */ -/* comment area of a DAS file */ -/* nchrb denote the number of encoded character data blocks */ -/* generated */ -/* nchrs denote the count of characters in the DAS character */ -/* data array */ -/* ndpb denote the number of encoded double precision data */ -/* blocks generated */ -/* ndps denote the count of double precision numbers in the DAS */ -/* double precision data array */ -/* nintb denote the number of encoded integer data blocks */ -/* generated */ -/* nints denote the count of integers in the DAS integer data */ -/* array */ - -/* A DAS encoded transfer file has the following format: */ - -/* */ -/* < Information line > */ -/* < DAS file ID word > */ -/* < Internal filename > */ -/* < Encoded count of reserved records > */ -/* < Encoded count of reserved characters > */ -/* < Encoded count of comment records > */ -/* < Encoded count of comment characters > */ -/* < Blocks of encoded reserved record data, if nresvc > 0 > */ -/* TOTAL_RESERVED_BLOCKS nresvb nresvc */ -/* < Blocks of encoded comment data, if ncomc > 0 > */ -/* TOTAL_COMMENT_BLOCKS ncomb ncomc */ -/* < Encoded count of character data > */ -/* < Encoded count of double precision data > */ -/* < Encoded count of integer data > */ -/* < Blocks of encoded character data, if nchrs > 0 > */ -/* TOTAL_CHARACTER_BLOCKS nchrb nchrs */ -/* < Blocks of encoded double precision data, if ndps > 0 > */ -/* TOTAL_DP_BLOCKS ndpb ndps */ -/* < Blocks of encoded integer data, if nints > 0 > */ -/* TOTAL_INTEGER_BLOCKS nintb nints */ -/* */ - -/* This routine will check the SPICELIB function FAILED() after */ -/* each call, or consecutive sequence of calls, to data encoding */ -/* routines, and if an error was signalled it will simply check out */ -/* and return to the caller. */ - -/* This routine will check the SPICELIB function FAILED() after */ -/* each DAS file access call, and if an error was signalled it will */ -/* simply check out and return to the caller. */ - -/* We begin by opening the binary DAS file specified by BINFIL for */ -/* read access, obtaining a file handle. */ - - dasopr_(binfil, &handle, binfil_len); - if (failed_()) { - -/* If an error occurred while opening the file check out and */ -/* return to the caller. */ - - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Get the contents of the DAS file record. */ - - dasrfr_(&handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, ( - ftnlen)8, (ftnlen)60); - -/* Convert the DAS file handle into its equivalent Fortran logical */ -/* unit. We need the logical unit so that we can read the reserved */ -/* records and the comment records. */ - - dashlu_(&handle, &daslun); - if (failed_()) { - -/* If an error occurred while converting the DAS file handle to */ -/* a logical unit, attempt to close the binary file, then check */ -/* out and return. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Check to be sure that the number of reserved records and the */ -/* number of reserved characters are not being used. The DAS */ -/* reserved record area is not currently implemented, so nobody */ -/* should be using it. */ - - if (nresvc != 0) { - -/* Set the error message, close the file, signal the error, and */ -/* exit. */ - - setmsg_("The number of reserved characters was nonzero (#) in file: " - "#, but the DAS reserved record area has NOT been implemented" - " yet!", (ftnlen)124); - errint_("#", &nresvc, (ftnlen)1); - errfnm_("#", &daslun, (ftnlen)1); - dascls_(&handle); - sigerr_("SPICE(BADDASFILE)", (ftnlen)17); - chkout_("DASBT", (ftnlen)5); - return 0; - } - if (nresvr != 0) { - -/* Set the error message, close the file, signal the error, and */ -/* exit. */ - - setmsg_("The number of reserved records was nonzero (#) in file: #, " - "but the DAS reserved record area has NOT been implemented ye" - "t!", (ftnlen)121); - errint_("#", &nresvr, (ftnlen)1); - errfnm_("#", &daslun, (ftnlen)1); - dascls_(&handle); - sigerr_("SPICE(BADDASFILE)", (ftnlen)17); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write the information line containing the file type information */ -/* and format version for the DAS transfer to the current position in */ -/* the file. The file format version information must be the first */ -/* ``word'' on the information line. The rest of the line may be used */ -/* for other purposes. Right now, it simply contains an expanded */ -/* description of the file format version information ``word.'' */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, "DASETF NAIF DAS ENCODED TRANSFER FILE", (ftnlen) - 37); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", ( - ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write the DAS ID word to the DAS transfer file. */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 8, a__1[1] = idword; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)10); - iostat = do_fio(&c__1, ch__1, (ftnlen)10); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsfe(); -L100002: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", ( - ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write the internal file name of the DAS file to the DAS transfer */ -/* file. */ - - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = "'"; - i__1[1] = 60, a__1[1] = ifname; - i__1[2] = 1, a__1[2] = "'"; - s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)62); - iostat = do_fio(&c__1, ch__2, (ftnlen)62); - if (iostat != 0) { - goto L100003; - } - iostat = e_wsfe(); -L100003: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", ( - ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write the number of reserved records and reserved characters to */ -/* the DAS transfer file. */ - - wrenci_(xfrlun, &c__1, &nresvr); - wrenci_(xfrlun, &c__1, &nresvc); - if (failed_()) { - -/* If an error occurred while writing the number of reserved */ -/* records or number of reserved characters, attempt to close */ -/* the binary file, then check out and return. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write the number of comment records and comment characters to */ -/* the DAS transfer file. */ - - wrenci_(xfrlun, &c__1, &ncomr); - wrenci_(xfrlun, &c__1, &ncomc); - if (failed_()) { - -/* If an error occurred while writing the number of comment */ -/* records or number of comment characters, attempt to close */ -/* the binary file, then check out and return. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* ************************************************************** */ -/* When/if the reserved record area is implemented, the code to */ -/* convert it and place it into the DAS transfer file should go */ -/* here. It should be possible to simply copy the code for the */ -/* comment area, making all of the necessary variable name changes, */ -/* etc., since the reserved record area is going to contain ONLY */ -/* character data. */ -/* ************************************************************** */ - -/* Write out the comment area of the DAS file, if there are any */ -/* comment characters stored in it. */ - - if (ncomc > 0) { - -/* Write out the comment records, one at a time. */ - - s_copy(crecrd, " ", (ftnlen)1024, (ftnlen)1); - numlft = ncomc; - numblk = 0; - recno = nresvr + 1; - while(numlft > 0) { - ++numblk; - ++recno; - if (numlft > 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Write out the begin comment block marker and the number of */ -/* comment characters. */ - - s_copy(line, "BEGIN_COMMENT_BLOCK # #", (ftnlen)80, (ftnlen)23); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsfe(); -L100004: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Read a comment record and then encode and write it. */ - - dasioc_("READ", &daslun, &recno, crecrd, (ftnlen)4, (ftnlen)1024); - wrencc_(xfrlun, &numdta, crecrd, (ftnlen)1024); - if (failed_()) { - -/* We want to check failed here because were in a loop. */ -/* We should exit the loop, and the routine, as soon as */ -/* an error is detected, so we don't continue doing things */ -/* for a long time. Attempt to close the binary DAS file */ -/* that we opened and then return to the caller. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write out the end comment block marker and the number of */ -/* comment characters. */ - - s_copy(line, "END_COMMENT_BLOCK # #", (ftnlen)80, (ftnlen)21); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100005; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100005; - } - iostat = e_wsfe(); -L100005: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Update the number of comment characters remaining to be */ -/* written. */ - - numlft -= numdta; - } - -/* Write out the number of comment blocks processed, and the */ -/* count of comment characters */ - - s_copy(line, "TOTAL_COMMENT_BLOCKS # #", (ftnlen)80, (ftnlen)24); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - repmi_(line, "#", &ncomc, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100006; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100006; - } - iostat = e_wsfe(); -L100006: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", - (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - } - -/* Read in the data counts for each of the data types from the binary */ -/* DAS file. */ - - daslla_(&handle, &ncdata, &nddata, &nidata); - -/* Write the data counts to the DAS transfer file. These will be */ -/* useful in determining which data types to expect in the DAS */ -/* transfer file when converting it back to binary. */ - - wrenci_(xfrlun, &c__1, &ncdata); - wrenci_(xfrlun, &c__1, &nddata); - wrenci_(xfrlun, &c__1, &nidata); - if (failed_()) { - -/* If an error occurred while writing any of the data counts to */ -/* the DAS transfer file, attempt to close the binary file, then */ -/* check out and return. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Encode and write the CHARACTER data to the DAS transfer file, if */ -/* there is any character data. */ - - if (ncdata > 0) { - numblk = 0; - dtabeg = 1; - numlft = ncdata; - while(numlft > 0) { - ++numblk; - if (numlft >= 4096) { - numdta = 4096; - } else { - numdta = numlft; - } - -/* Write out the begin data block identifier, the block */ -/* number, and the data count for the block. */ - - s_copy(line, "BEGIN_CHARACTER_BLOCK # #", (ftnlen)80, (ftnlen)25); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100007; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100007; - } - iostat = e_wsfe(); -L100007: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Read in NUMDTA characters. The desired data are specified by */ -/* beginning and ending indices into the array, inclusive: thus */ -/* the subtraction of 1 in the call. */ - - i__2 = dtabeg + numdta - 1; - dasrdc_(&handle, &dtabeg, &i__2, &c__1, &c__4, cbuffr, (ftnlen)4); - -/* Encode and write out a buffer of characters. */ - - wrencc_(xfrlun, &numdta, cbuffr, (ftnlen)4); - if (failed_()) { - -/* We want to check failed here because were in a loop. */ -/* We should exit the loop, and the routine, as soon as */ -/* an error is detected, so we don't continue doing things */ -/* for a long time. Attempt to close the binary DAS file */ -/* that we opened and then returrn to the caller. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write out the end data block identifier, the block number, */ -/* and the data count for the block. */ - - s_copy(line, "END_CHARACTER_BLOCK # #", (ftnlen)80, (ftnlen)23); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100008; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100008; - } - iostat = e_wsfe(); -L100008: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Increment the data pointer and decrement the amount of data */ -/* left to move. */ - - dtabeg += numdta; - numlft -= numdta; - } - -/* Write out the number of character data blocks processed */ -/* processed, and the count of double precision data items. */ - - s_copy(line, "TOTAL_CHARACTER_BLOCKS # #", (ftnlen)80, (ftnlen)26); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - repmi_(line, "#", &ncdata, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100009; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100009; - } - iostat = e_wsfe(); -L100009: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", - (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - } - -/* Encode and write the DOUBLE PRECISION data to the DAS transfer */ -/* file. */ - - if (nddata > 0) { - numblk = 0; - dtabeg = 1; - numlft = nddata; - while(numlft > 0) { - ++numblk; - if (numlft >= 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Write out the begin data block identifier, the block */ -/* number, and the data count for the block. */ - - s_copy(line, "BEGIN_DP_BLOCK # #", (ftnlen)80, (ftnlen)18); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100010; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100010; - } - iostat = e_wsfe(); -L100010: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Read in NUMDTA double precision numbers.The desired data are */ -/* specified by beginning and ending indices into the array, */ -/* inclusive: thus the subtraction of 1 in the call. */ - - i__2 = dtabeg + numdta - 1; - dasrdd_(&handle, &dtabeg, &i__2, dbuffr); - -/* Encode and write out a buffer of double precision numbers. */ - - wrencd_(xfrlun, &numdta, dbuffr); - if (failed_()) { - -/* We want to check failed here because were in a loop. */ -/* We should exit the loop, and the routine, as soon as */ -/* an error is detected, so we don't continue doing things */ -/* for a long time. Attempt to close the binary DAS file */ -/* that we opened and then returrn to the caller. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write out the end data block identifier, the block number, */ -/* and the data count for the block. */ - - s_copy(line, "END_DP_BLOCK # #", (ftnlen)80, (ftnlen)16); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100011; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100011; - } - iostat = e_wsfe(); -L100011: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Increment the data pointer and decrement the amount of data */ -/* left to move. */ - - dtabeg += numdta; - numlft -= numdta; - } - -/* Write out the number of double precision processed data blocks */ -/* processed, and the count of double precision data items. */ - - s_copy(line, "TOTAL_DP_BLOCKS # #", (ftnlen)80, (ftnlen)19); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - repmi_(line, "#", &nddata, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100012; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100012; - } - iostat = e_wsfe(); -L100012: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", - (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - } - -/* Encode and write the INTEGER data to the DAS transfer file, if */ -/* there is any. */ - - if (nidata > 0) { - numblk = 0; - dtabeg = 1; - numlft = nidata; - while(numlft > 0) { - ++numblk; - if (numlft >= 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Write out the begin data block identifier, the block number, */ -/* and the data count for the block. */ - - s_copy(line, "BEGIN_INTEGER_BLOCK # #", (ftnlen)80, (ftnlen)23); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100013; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100013; - } - iostat = e_wsfe(); -L100013: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Read in NUMDTA integers. The desired data are specified by */ -/* beginning and ending indices into the array,inclusive: thus */ -/* the subtraction of 1 in the call. */ - - i__2 = dtabeg + numdta - 1; - dasrdi_(&handle, &dtabeg, &i__2, ibuffr); - -/* Encode and write out a buffer of integers. */ - - wrenci_(xfrlun, &numdta, ibuffr); - if (failed_()) { - -/* We want to check failed here because were in a loop. */ -/* We should exit the loop, and the routine, as soon as */ -/* an error is detected, so we don't continue doing things */ -/* for a long time. Attempt to close the binary DAS file */ -/* that we opened and then returrn to the caller. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Write out the end data block identifier, the block number, */ -/* and the data count for the block. */ - - s_copy(line, "END_INTEGER_BLOCK # #", (ftnlen)80, (ftnlen)21); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100014; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100014; - } - iostat = e_wsfe(); -L100014: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - -/* Increment the data pointers and decrement the amount of data */ -/* left. */ - - dtabeg += numdta; - numlft -= numdta; - } - -/* Write out the number of processed integer data blocks */ -/* processed, and the count of double precision data items. */ - - s_copy(line, "TOTAL_INTEGER_BLOCKS # #", (ftnlen)80, (ftnlen)24); - repmi_(line, "#", &numblk, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - repmi_(line, "#", &nidata, line, (ftnlen)80, (ftnlen)1, (ftnlen)80); - ci__1.cierr = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100015; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80)); - if (iostat != 0) { - goto L100015; - } - iostat = e_wsfe(); -L100015: - if (iostat != 0) { - -/* An error occurred, so close the binary DAS file, set an */ -/* appropriate error message, and return to the caller. */ - - dascls_(&handle); - setmsg_("Error writing to the DAS transfer file: #. IOSTAT = #.", - (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("DASBT", (ftnlen)5); - return 0; - } - } - -/* Close only the binary DAS file. */ - - dascls_(&handle); - chkout_("DASBT", (ftnlen)5); - return 0; -} /* dasbt_ */ - diff --git a/ext/spice/src/cspice/dascls.c b/ext/spice/src/cspice/dascls.c deleted file mode 100644 index e6bbe106f5..0000000000 --- a/ext/spice/src/cspice/dascls.c +++ /dev/null @@ -1,363 +0,0 @@ -/* dascls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__21 = 21; - -/* $Procedure DASCLS ( DAS, close file ) */ -/* Subroutine */ int dascls_(integer *handle) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - - /* System generated locals */ - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *); - - /* Local variables */ - integer unit; - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer fhset[27]; - extern logical failed_(void); - extern /* Subroutine */ int dasham_(integer *, char *, ftnlen), dasllc_( - integer *), dashof_(integer *); - char method[10]; - extern /* Subroutine */ int dashlu_(integer *, integer *), daswbr_( - integer *), dassdr_(integer *), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), ssizei_( - integer *, integer *); - logical notscr; - extern logical return_(void); - -/* $ Abstract */ - -/* Close a DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open DAS file. */ -/* FTSIZE P Maximum number of simultaneously open DAS files. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an open DAS file. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of DAS files that can be */ -/* open at any one time. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If HANDLE is not the handle of an open DAS file, no error */ -/* is signalled. */ - -/* $ Files */ - -/* See the description of input argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine provides the primary recommended method of closing an */ -/* open DAS file. It is also possible to close a DAS file without */ -/* segregating it by calling DASWBR and DASLLC. Closing a DAS file by */ -/* any other means may cause the DAS mechanism for keeping track of */ -/* which files are open to fail. Closing a DAS file that has been */ -/* opened for writing by any other means may result in the production */ -/* of something other than a DAS file. */ - -/* $ Examples */ - -/* 1) Open a new DAS file called TEST.DAS, add 100 d.p. numbers */ -/* to it, and then close the file. */ - -/* C */ -/* C We'll give the file the same internal file name */ -/* C as the file's actual name. We don't require any */ -/* C reserved records. */ -/* C */ -/* FNAME = 'TEST.DAS' */ -/* FTYPE = 'TEST' */ - -/* CALL DASONW ( FNAME, FTYPE, FNAME, 0, HANDLE ) */ - -/* DO I = 1, 100 */ -/* DATAD(I) = DBLE(I) */ -/* END DO */ - -/* CALL DASADD ( HANDLE, 100, DATAD ) */ - -/* CALL DASCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.3, 05-OCT-2006 (NJB) */ - -/* Corrected DASADD calling sequence error in code example. */ -/* Updated Particulars header section to mention closing DAS */ -/* files without segregation via calls to DASWBR and DASLLC. */ - -/* - SPICELIB Version 1.3.2, 24-MAR-2003 (NJB) */ - -/* DASWBR call has been reinstated for scratch DAS case. */ -/* This call has the side effect of freeing buffer records */ -/* owned by the file DASWBR writes to. Failing to free these */ -/* records can cause write errors on HP/Fortran systems. */ - -/* - SPICELIB Version 1.2.2, 27-FEB-2003 (NJB) */ - -/* Tests whether file to be closed is a scratch DAS; if */ -/* so, buffer flushes and record segregation are omitted. */ - -/* - EKLIB Version 1.1.1, 26-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* Changed the value of the parameter FTSIZE from 20 to 21. This */ -/* change makes the value of FTSIZE in DASCLS compatible with the */ -/* value in DASFM. See DASFM for a discussion of the reasons for */ -/* the increase in the value. */ - -/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) */ - -/* FHSET is now saved. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* close an open DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.2, 24-MAR-2003 (NJB) */ - -/* DASWBR call has been reinstated for scratch DAS case. */ -/* This call has the side effect of freeing buffer records */ -/* owned by the file DASWBR writes to. Failing to free these */ -/* records can cause write errors on HP/Fortran systems. */ - -/* - SPICELIB Version 1.2.2, 27-FEB-2003 (NJB) */ - -/* Tests whether file to be closed is a scratch DAS; if */ -/* so, buffer flushes and record segregation are omitted. */ - -/* - EKLIB Version 1.1.1, 26-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* Changed the value of the parameter FTSIZE from 20 to 21. This */ -/* change makes the value of FTSIZE in DASCLS compatible with the */ -/* value in DASFM. See DASFM for a discussion of the reasons for */ -/* the increase in the value. */ - -/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) */ - -/* FHSET is now saved. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASCLS", (ftnlen)6); - } - if (pass1) { - ssizei_(&c__21, fhset); - pass1 = FALSE_; - } - -/* There are only four items on our worklist: */ - -/* 1) Determine whether the file open for reading or writing, */ -/* and if it's open for writing, whether it's a scratch */ -/* file. */ - -/* 2) If the DAS file is open for writing, flush any updated */ -/* records from the data buffers to the file. */ - -/* 3) If the DAS file is open for writing, re-order the records */ -/* in the file so that the data is segregated by data type. */ - -/* 4) Close the file. */ - - -/* See whether the input handle designates an open DAS file. If not, */ -/* return now. */ - - dashof_(fhset); - if (! elemi_(handle, fhset)) { - chkout_("DASCLS", (ftnlen)6); - return 0; - } - -/* If the file is open for writing, flush any buffered */ -/* records that belong to it. */ - - dasham_(handle, method, (ftnlen)10); - if (s_cmp(method, "WRITE ", (ftnlen)10, (ftnlen)6) == 0) { - -/* Make sure that all buffered records belonging to the */ -/* indicated file are written out. */ - - daswbr_(handle); - -/* We cannot directly test the status of the file, but if */ -/* the file is unnamed, it must be a scratch file. */ - - dashlu_(handle, &unit); - if (failed_()) { - chkout_("DASCLS", (ftnlen)6); - return 0; - } - ioin__1.inerr = 1; - ioin__1.inunit = unit; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = 0; - ioin__1.innamed = ¬scr; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - setmsg_("Error occurred while performing an INQUIRE on a DAS fi" - "le about to be closed. IOSTAT = #. File handle was #. " - "Logical unit was #.", (ftnlen)130); - errint_("#", &iostat, (ftnlen)1); - errint_("#", handle, (ftnlen)1); - errint_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("DASCLS", (ftnlen)6); - return 0; - } - if (notscr) { - -/* Segregate the data records in the file according to data */ -/* type. */ - - dassdr_(handle); - } - } - -/* Close the file. */ - - dasllc_(handle); - chkout_("DASCLS", (ftnlen)6); - return 0; -} /* dascls_ */ - diff --git a/ext/spice/src/cspice/dascls_c.c b/ext/spice/src/cspice/dascls_c.c deleted file mode 100644 index 16f5a5836f..0000000000 --- a/ext/spice/src/cspice/dascls_c.c +++ /dev/null @@ -1,202 +0,0 @@ -/* - --Procedure dascls_c ( DAS, close file ) - --Abstract - - Close a DAS file. - --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 - - DAS - --Keywords - - DAS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void dascls_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an open DAS file. - FTSIZE P Maximum number of simultaneously open DAS files. - --Detailed_Input - - handle is the file handle of an open DAS file. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - FTSIZE is the maximum number of DAS files that can be - open at any one time. See the file dasfm.c - for details. - --Exceptions - - Error free. - - 1) If `handle' is not the handle of an open DAS file, no error - is signaled. - --Files - - See the description of input argument `handle' in $Detailed_Input. - --Particulars - - This routine provides the primary recommended method of closing an - open DAS file. It is also possible to close a DAS file without - segregating it by calling daswbr_ and dasllc_. Closing a DAS file by - any other means may cause the DAS mechanism for keeping track of - which files are open to fail. Closing a DAS file that has been - opened for writing by any other means may result in the production - of something other than a DAS file. - --Examples - - 1) Open a new DAS file called TEST.DAS, add 100 d.p. numbers - to it, and then close the file. - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include - - int main() - { - #define NMAX 100 - - SpiceChar * fname; - SpiceChar * ftype; - SpiceChar * ifname; - - SpiceDouble ddata [ NMAX ]; - - SpiceInt handle; - SpiceInt i; - SpiceInt n; - SpiceInt ncomch; - - - /. - We'll give the file the same internal file name - as the file's actual name. We don't require any - comment records. - ./ - fname = "TEST.DAS"; - ftype = "TEST"; - ifname = fname; - ncomch = 0; - - dasonw_ ( (SpiceChar *) fname, - (SpiceChar *) ftype, - (SpiceChar *) ifname, - (integer *) &ncomch, - (integer *) &handle, - (ftnlen ) strlen(fname), - (ftnlen ) strlen(ftype), - (ftnlen ) strlen(ifname) ); - - - for ( i = 0; i < NMAX; i++ ) - { - ddata[i] = (SpiceDouble)i; - } - - n = NMAX; - - dasadd_ ( &handle, &n, ddata ); - - dascls_c ( handle ); - - return ( 0 ); - } - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 05-OCT-2006 (NJB) (KRG) (WLT) - --Index_Entries - - close a DAS file - --& -*/ - -{ /* Begin dascls_c */ - - - - /* - Participate in error tracing. - */ - - chkin_c ( "dascls_c" ); - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - dascls_ ( ( integer * ) &handle ); - - - chkout_c ( "dascls_c" ); - -} /* End dascls_c */ - diff --git a/ext/spice/src/cspice/dascud.c b/ext/spice/src/cspice/dascud.c deleted file mode 100644 index 0e2dbaeb93..0000000000 --- a/ext/spice/src/cspice/dascud.c +++ /dev/null @@ -1,828 +0,0 @@ -/* dascud.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__256 = 256; -static integer c__2 = 2; - -/* $Procedure DASCUD ( DAS, create or update directories ) */ -/* Subroutine */ int dascud_(integer *handle, integer *type__, integer * - nwords) -{ - /* Initialized data */ - - static integer next[3] = { 2,3,1 }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer free, lrec, last, room, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, descr; - extern /* Subroutine */ int maxai_(integer *, integer *, integer *, - integer *); - integer recno, ncomr, lword, ltype, needed; - extern /* Subroutine */ int cleari_(integer *, integer *); - integer dscrec, nw, dirrec[256]; - extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - integer minadr, maxadr, lastla[3], rngloc; - extern /* Subroutine */ int dasufs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *), - dasrri_(integer *, integer *, integer *, integer *, integer *), - dasuri_(integer *, integer *, integer *, integer *, integer *); - integer lastrc[3]; - extern /* Subroutine */ int daswri_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - integer lastwd[3], nresvc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - integer nresvr, loc; - -/* $ Abstract */ - -/* Create or update directories in a DAS file to reflect addition */ -/* of a specified number of words of a specified data type. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* TYPE I Data type specifier. */ -/* NWORDS I Number of words of data being added. */ -/* CHAR P Parameter indicating character data type. */ -/* DP P Parameter indicating double precision data type. */ -/* INT P Parameter indicating integer data type. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a DAS file open for writing. */ - -/* TYPE is a data type specifier. TYPE may be any of */ -/* the parameters */ - -/* CHAR */ -/* DP */ -/* INT */ - -/* which indicate `character', `double precision', */ -/* and `integer' respectively. */ - -/* NWORDS is the number of words of data of the data type */ -/* indicated by TYPE whose addition to the indicated */ -/* DAS file is to be accounted for. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action */ -/* of this routine. */ - -/* $ Parameters */ - -/* CHAR, */ -/* DP, */ -/* INT are data type specifiers which indicate */ -/* `character', `double precision', and `integer' */ -/* respectively. These parameters are used in */ -/* all DAS routines that require a data type */ -/* specifier as input. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 2) If TYPE is not recognized, the error SPICE(DASINVALIDTYPE) */ -/* will be signalled. */ - -/* 3) If NWORDS is negative, the error SPICE(VALUEOUTOFRANGE) will */ -/* be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine operates by side effects: the directories in the */ -/* indicated DAS file will be updated to reflect the addition of */ -/* the indicated number of words of the specified data type. */ -/* If necessary, a new directory record will be added to the file */ -/* to hold a new cluster descriptor. */ - -/* In addition, the file summary for the indicated DAS file will be */ -/* updated with the new values of the descriptor location and last */ -/* logical address of the indicated type, as well as with the new */ -/* value of the free record pointer. */ - -/* This routine is used by the DASADx routines: after each data */ -/* addition, they call this routine to update the directories of the */ -/* affected DAS file. */ - -/* Normally, there will be no need for routines outside of SPICELIB */ -/* to call this routine directly. To add data to or update a DAS */ -/* file, the DASADx and DASUDx routines should be used; these */ -/* routines take care of directory creation and updates. */ - -/* $ Examples */ - -/* 1) Update directories after writing N integer words to a */ -/* DAS file designated by HANDLE: */ - -/* CALL DASCUD ( HANDLE, INT, N ) */ - -/* $ Restrictions */ - -/* 1) This routine is intended for use by the SPICELIB DAS routines. */ -/* Non-SPICELIB software normally will not need to call this */ -/* routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.4.0 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable LTYPE to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. */ - -/* - SPICELIB Version 1.3.0 16-JAN-2003 (NJB) */ - -/* Bug fix: fixed previous bug fix. */ - -/* - SPICELIB Version 1.2.0 10-DEC-2002 (NJB) */ - -/* Bug fix: now a new, empty directory record with valid */ -/* backward and forward pointers is written immediately */ -/* when it is created. */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Removed an unused variable. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update DAS cluster directories */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.4.0 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable LTYPE to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. The */ -/* statement referencing the uninitialized variable */ -/* was: */ - -/* ELSE IF ( ( TYPE .EQ. LTYPE ) */ -/* . .AND. ( DSCREC .GT. 0 ) */ -/* . .AND. ( LWORD .LT. NWI ) ) THEN */ - - -/* In the previous version of the code, LTYPE is uninitialized */ -/* when the DAS file is empty, which implies DSCREC is 0. */ -/* Otherwise LTYPE is initialized. So the value of the logical */ -/* expression is not affected by the uninitialized value of */ -/* LTYPE. */ - -/* However, the Intel Fortran compiler for the Mac flags a runtime */ -/* error when the above code is exercised. So LTYPE is now */ -/* initialized to an invalid value prior to execution of this */ -/* code. If the invalid value is ever used, a runtime error */ -/* should result. */ - - -/* - SPICELIB Version 1.3.0 16-JAN-2003 (NJB) */ - -/* Bug fix: fixed previous bug fix. */ - - -/* The offending line (#778) in previous version) of code is: */ - -/* CALL DASWRI ( HANDLE, RECNO, DIRREC ) */ - -/* The correct line of code is: */ - -/* CALL DASWRI ( HANDLE, FREE, DIRREC ) */ - - -/* - SPICELIB Version 1.2.0 10-DEC-2002 (NJB) */ - -/* Bug fix: now a new, empty directory record with valid */ -/* backward and forward pointers is written immediately */ -/* when it is created. This prevents an unsegregated file */ -/* from being left with an invalid forward pointer. */ - -/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Removed an unused variable, PREV. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Words per data record, for each data type: */ - - -/* Directory pointer locations (backward and forward): */ - - -/* Directory address range locations */ - - -/* Location of first type descriptor */ - - -/* Local variables */ - - -/* Saved variables */ - - - -/* NEXT maps the DAS data type codes to their successors. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASCUD", (ftnlen)6); - } - -/* Here's a preview of coming attractions: */ - -/* We're going to update the directories in the indicated */ -/* DAS file to reflect the addition of NWORDS new data words. */ -/* This data is supposed to have been added to the file BEFORE */ -/* this routine is called. There are several possible states */ -/* the file can be in at the point this routine is called. */ - - -/* 1) There is already a descriptor of TYPE in the file, and */ -/* the addition of data does not require this descriptor */ -/* to be modified. */ - -/* We can tell that we have this case when the file */ -/* summary indicates that, before the addition of data, */ -/* there was room for NWORDS of data in the last data */ -/* record in the file. Since no new data records were */ -/* required to accommodate the new data, the descriptor */ -/* for TYPE does not have to be updated. */ - -/* However, even though the descriptor need not be */ -/* modified, the address range for TYPE covered by the */ -/* directory record containing this last descriptor must be */ -/* updated, as must be the file summary. */ - - -/* 2) There is already a descriptor of TYPE in the file, and */ -/* in order to describe the new data added to the file, */ -/* it suffices to update this descriptor and the address */ -/* range in the directory containing it. */ - -/* This happens when case (1) doesn't apply, and the */ -/* descriptor of TYPE is the last descriptor in the last */ -/* directory, and the descriptor is not in the last */ -/* position (index NWI) of the directory. */ - -/* Note that we never update the last descriptor in a */ -/* directory record. The reason for this is that after */ -/* this descriptor is written, we build a new directory */ -/* record. All subsequent additions of data are made to */ -/* records that follow this new directory record; */ -/* otherwise, the new directory would get overwritten */ -/* with data. */ - - -/* 3) A new descriptor of TYPE is needed. */ - -/* This can happen in several ways: */ - -/* a) There are no directories in the file yet, in which */ -/* case space has been reserved for the first */ -/* directory. */ - -/* This can happen only when the file had no data at */ -/* all in it before the last addition of data. */ - -/* In this case, we must fill in the first descriptor */ -/* and the address range for TYPE. We must also update */ -/* the file summary, because the descriptor location, */ -/* last logical address of TYPE, and the free pointer */ -/* have changed. */ - -/* b) The conditions for cases (1) and (2) are not */ -/* satisfied, and the current last directory record */ -/* has room for a new descriptor. In this case, if */ -/* the data addition filled in the last data record */ -/* described by the current last descriptor of type, */ -/* (which will usually be the case), we must update */ -/* the appropriate address range in the directory */ -/* record containing that descriptor. We will then */ -/* add a new descriptor to the last directory record */ -/* and update the address range for TYPE in that */ -/* record. The file summary must be updated as well. */ - -/* If the new descriptor we've added went into the */ -/* last slot in a directory record (index NWI), we */ -/* also create a new, empty directory record and */ -/* update the forward pointer of the current directory */ -/* to point to it. We also update the file summary */ -/* so that the free pointer points to the record */ -/* following the empty directory record. */ - - -/* c) The conditions for cases (1) and (2) are not */ -/* satisfied, and the current last directory record */ -/* has no room for a new descriptor. */ - -/* In this case, if the data addition filled in the */ -/* last data record described by the current last */ -/* descriptor of TYPE, (which will usually be the */ -/* case), we must update the appropriate address range */ -/* in the directory record containing that descriptor. */ -/* We will then add a new descriptor to the empty */ -/* directory record and initialize the address range */ -/* for TYPE in that record. The file summary must be */ -/* updated as well. */ - - -/* To start out, we'll need to find out how the file is currently */ -/* disposed. We'll need the location of the last descriptor of */ -/* TYPE, the last logical address of TYPE, and the location of */ -/* the last descriptor of any type. */ - -/* Get the file summary. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - -/* Now do all of the data-type-dependent work: */ - -/* -- Set the last address of the indicated data type LAST. */ - -/* -- Set the physical record of the last descriptor of TYPE. */ - -/* -- Set the number of words of data of the specified type per */ -/* physical record NW. */ - -/* -- Set the address range location used to pick address ranges */ -/* out of directory records. */ - - -/* Note that the address and descriptor location information from */ -/* the file summary is assumed NOT to take into account the latest */ -/* data addition. */ - - - last = lastla[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("las" - "tla", i__1, "dascud_", (ftnlen)513)]; - dscrec = lastrc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastrc", i__1, "dascud_", (ftnlen)514)]; - if (*type__ == 2) { - nw = 128; - rngloc = 5; - } else if (*type__ == 3) { - nw = 256; - rngloc = 7; - } else if (*type__ == 1) { - nw = 1024; - rngloc = 3; - } else { - setmsg_("Invalid data type: #. ", (ftnlen)22); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(DASINVALIDTYPE)", (ftnlen)21); - chkout_("DASCUD", (ftnlen)6); - return 0; - } - -/* Make sure that NWORDS is something sensible. */ - - if (*nwords < 0) { - setmsg_("NWORDS was #; should be non-negative.", (ftnlen)37); - errint_("#", nwords, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DASCUD", (ftnlen)6); - return 0; - } - -/* Find the record and word positions LREC and LWORD of the last */ -/* descriptor in the file, and also find the type of the descriptor */ -/* LTYPE. */ - - maxai_(lastrc, &c__3, &lrec, &loc); - lword = 0; - ltype = 0; - for (i__ = 1; i__ <= 3; ++i__) { - if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", - i__1, "dascud_", (ftnlen)565)] == lrec && lastwd[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dascu" - "d_", (ftnlen)565)] > lword) { - lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dascud_", (ftnlen)568)]; - ltype = i__; - } - } - -/* LREC, LWORD, and LTYPE are now the record, word, and data type */ -/* of the last descriptor in the file. If LREC is zero, there are */ -/* no directories in the file yet. In this case, LWORD and */ -/* LTYPE are both zero. */ - - -/* Compute the number of words we have room for in the current */ -/* last data record of the indicated type. */ - - if (last > 0) { - room = nw - (last - (last - 1) / nw * nw); - } else { - room = 0; - } - -/* Compute the number of additional data records needed to */ -/* accommodate (NWORDS - ROOM) additional words of data of type */ -/* TYPE. */ - - needed = (*nwords - room + nw - 1) / nw; - -/* Now, update the descriptor directories. */ - - if (room >= *nwords && dscrec > 0) { - -/* This is case (1). */ - -/* There is already a descriptor of TYPE in the file. The data */ -/* fits in the current record, so no descriptors have to change. */ - -/* Update the address range in the directory record containing */ -/* the last descriptor of TYPE. */ - - maxadr = last + *nwords; - i__1 = rngloc + 1; - i__2 = rngloc + 1; - dasuri_(handle, &dscrec, &i__1, &i__2, &maxadr); - -/* The last logical address of TYPE is now MAXADR. */ - - lastla[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastla", - i__1, "dascud_", (ftnlen)621)] = maxadr; - -/* Write out the updated file summary. */ - - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, - lastrc, lastwd); - } else if (*type__ == ltype && dscrec > 0 && lword < 256) { - - -/* This is case (2). */ - -/* The descriptor of TYPE is the last descriptor in the */ -/* file but is not in the last location (index NWI) of a */ -/* directory record. All we have to do is update this last */ -/* descriptor to reflect the addition of the number of needed */ -/* data records. */ - -/* Get the old descriptor, since we're going to update it. */ - - - dasrri_(handle, &dscrec, &lword, &lword, &descr); - -/* Update the descriptor and write it back into the file. */ - - if (descr < 0) { - descr -= needed; - } else { - descr += needed; - } - dasuri_(handle, &dscrec, &lword, &lword, &descr); - -/* Update the address range for this type. */ - - maxadr = last + *nwords; - i__1 = rngloc + 1; - i__2 = rngloc + 1; - dasuri_(handle, &dscrec, &i__1, &i__2, &maxadr); - -/* The last logical address of TYPE is now MAXADR. The first */ -/* free record follows the last data record in use. */ - - lastla[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastla", - i__1, "dascud_", (ftnlen)678)] = maxadr; - free += needed; - -/* Write out the updated file summary. */ - - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, - lastrc, lastwd); - } else { - -/* This is case (3). We need a new descriptor. */ - - if (lrec == 0) { - -/* This is case (3a). We have a virgin directory record. */ -/* Set the number of this record. */ - - recno = nresvr + ncomr + 2; - -/* Start with an empty directory record. */ - - cleari_(&c__256, dirrec); - -/* Add a new descriptor to the directory. The record */ -/* count is the number of new records required: NEEDED. */ - - dirrec[8] = *type__; - dirrec[9] = needed; - -/* Fill in the address range for TYPE covered by this */ -/* directory. */ - - dirrec[(i__1 = rngloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "dirrec", i__1, "dascud_", (ftnlen)723)] = 1; - dirrec[(i__1 = rngloc) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec" - , i__1, "dascud_", (ftnlen)724)] = *nwords; - -/* Write out this directory. */ - - daswri_(handle, &recno, dirrec); - -/* Update the file summary: the location of the descriptor */ -/* and the last logical address for this type must be set. */ -/* The count portion of the descriptor goes after the initial */ -/* data type indicator; this data type indicator is not */ -/* considered to be part of the descriptor. */ - -/* The first free record follows the last data record in use. */ - - free = recno + needed + 1; - lastla[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastla", i__1, "dascud_", (ftnlen)741)] = *nwords; - lastrc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastrc", i__1, "dascud_", (ftnlen)742)] = recno; - lastwd[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dascud_", (ftnlen)743)] = 10; - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, - lastrc, lastwd); - } else if (lword < 256) { - -/* This is case (3b). We have room for another descriptor */ -/* in the current directory record. */ - -/* Before adding the new descriptor, we must update the */ -/* directory containing the current last descriptor of TYPE, */ -/* if the range of addresses covered by the cluster it */ -/* describes was increased by the last data addition. Of */ -/* course, this update is required only if there IS such a */ -/* descriptor, and if it is in a record that precedes LREC. */ - - if (dscrec > 0 && dscrec < lrec && room > 0) { - -/* Update the address range for TYPE in record DSCREC. */ -/* The upper bound is increased by ROOM, since that many */ -/* words of TYPE were added to the last record in the */ -/* last cluster of TYPE described by that directory. */ - - maxadr = last + room; - i__1 = rngloc + 1; - i__2 = rngloc + 1; - dasuri_(handle, &dscrec, &i__1, &i__2, &maxadr); - } - -/* Make up the new descriptor and write it to the last */ -/* directory, following the current last descriptor. The */ -/* sign of the new descriptor is a function of the type of */ -/* the current last descriptor. */ - - if (*type__ == next[(i__1 = ltype - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("next", i__1, "dascud_", (ftnlen)789)]) { - -/* TYPE is the successor in the type sequence of the type */ -/* of the previous descriptor; use a positive count. */ - - descr = needed; - } else { - descr = -needed; - } - i__1 = lword + 1; - i__2 = lword + 1; - dasuri_(handle, &lrec, &i__1, &i__2, &descr); - -/* Update the address range for this type. Some care is needed */ -/* when updating the minimum address: this value should be */ -/* assigned only if this is the first descriptor of TYPE in */ -/* this directory record. */ - - if (dscrec < lrec) { - minadr = last + room + 1; - dasuri_(handle, &lrec, &rngloc, &rngloc, &minadr); - } - maxadr = last + *nwords; - i__1 = rngloc + 1; - i__2 = rngloc + 1; - dasuri_(handle, &lrec, &i__1, &i__2, &maxadr); - -/* Update the file summary: the location of the descriptor */ -/* and the last logical address for this type must be set. */ - -/* The first free record follows the last data record in use. */ - - free += needed; - lastla[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastla", i__1, "dascud_", (ftnlen)829)] = last + *nwords; - lastrc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastrc", i__1, "dascud_", (ftnlen)830)] = lrec; - lastwd[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dascud_", (ftnlen)831)] = lword + 1; - -/* Before writing out the summary, see whether we'll need */ -/* a new directory; this will decide whether the first free */ -/* record changes. */ - -/* If we just filled in the last descriptor in a directory, */ -/* it's time to add a new directory record to the file. */ -/* All we have to do at the moment is make room for it, and */ -/* set the forward pointer of the current directory record */ -/* to point to the saved record. Initialize the pointers */ -/* of the new directory record to make the linked list valid. */ - - if (lword + 1 == 256) { - -/* Update the previous directory to point forward to the */ -/* next one. */ - - dasuri_(handle, &lrec, &c__2, &c__2, &free); - -/* Prepare the new directory record: clear it, set the */ -/* backward pointer, and write the record. */ - - cleari_(&c__256, dirrec); - dirrec[0] = lrec; - daswri_(handle, &free, dirrec); - -/* Update the free record number. */ - - ++free; - } - -/* Now write out the file summary. */ - - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, - lastrc, lastwd); - } else { - -/* This is case (3c). We must put the new descriptor in */ -/* the last directory record, which is currently empty. */ - -/* As in case (3b), we may have to update the directory */ -/* containing the current last descriptor of TYPE, if the */ -/* range of addresses covered by the cluster it describes was */ -/* increased by the last data addition. Of course, this */ -/* update is required only if there IS such a descriptor. */ - - if (dscrec > 0 && room > 0) { - -/* Update the address range for TYPE in record DSCREC. */ -/* The upper bound is increased by ROOM, since that many */ -/* words of TYPE were added to the last record in the */ -/* last cluster of TYPE described by that directory. */ - - maxadr = last + room; - i__1 = rngloc + 1; - i__2 = rngloc + 1; - dasuri_(handle, &dscrec, &i__1, &i__2, &maxadr); - } - -/* Obtain the record number for this directory. */ - - dasrri_(handle, &lrec, &c__2, &c__2, &recno); - -/* Now fill in the new directory record. Start with a clean */ -/* record. */ - - cleari_(&c__256, dirrec); - -/* Set the backward pointer, the address range for TYPE, */ -/* initial data type, and record count. */ - - dirrec[0] = lrec; - dirrec[(i__1 = rngloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "dirrec", i__1, "dascud_", (ftnlen)925)] = last + room + - 1; - dirrec[(i__1 = rngloc) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec" - , i__1, "dascud_", (ftnlen)926)] = last + *nwords; - dirrec[8] = *type__; - dirrec[9] = needed; - -/* Write out the record. */ - - daswri_(handle, &recno, dirrec); - -/* Update the file summary to reflect the new record and word */ -/* offsets of the last descriptor of the indicated type. The */ -/* last address of TYPE has increased also. The first free */ -/* record lies after the added data records. */ - - free += needed; - lastla[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastla", i__1, "dascud_", (ftnlen)943)] = last + *nwords; - lastrc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastrc", i__1, "dascud_", (ftnlen)944)] = recno; - lastwd[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dascud_", (ftnlen)945)] = 10; - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, - lastrc, lastwd); - } - } - chkout_("DASCUD", (ftnlen)6); - return 0; -} /* dascud_ */ - diff --git a/ext/spice/src/cspice/dasdc.c b/ext/spice/src/cspice/dasdc.c deleted file mode 100644 index cf77593bf0..0000000000 --- a/ext/spice/src/cspice/dasdc.c +++ /dev/null @@ -1,251 +0,0 @@ -/* dasdc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DASDC ( DAS delete comments ) */ -/* Subroutine */ int dasdc_(integer *handle) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, ncomr; - extern logical failed_(void); - char ifname[60]; - extern /* Subroutine */ int dassih_(integer *, char *, ftnlen), dasrcr_( - integer *, integer *), dasrfr_(integer *, char *, char *, integer - *, integer *, integer *, integer *, ftnlen, ftnlen), daswfr_( - integer *, char *, char *, integer *, integer *, integer *, - integer *, ftnlen, ftnlen); - char idword[8]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer nresvc; - extern logical return_(void); - integer nresvr; - -/* $ Abstract */ - -/* Delete the entire comment area of a previously opened binary */ -/* DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a binary DAS file opened for writing. */ - -/* $ Detailed_Input */ - -/* HANDLE The handle of a binary DAS file that is to have its */ -/* entire comment area deleted. The DAS file should have */ -/* been opened with write access. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the binary DAS file attached to HANDLE is not open with */ -/* write access, an error will be signalled by a routine called */ -/* by this routine. */ - -/* $ Files */ - -/* See argument HANDLE in $ Detailed_Input. */ - -/* $ Particulars */ - -/* Binary DAS files contain an area which is reserved for storing */ -/* annotations or descriptive textual information about the data */ -/* contained in a file. This area is referred to as the ``comment */ -/* area'' of the file. The comment area of a DAS file is a line */ -/* oriented medium for storing textual information. The comment */ -/* area preserves any leading or embedded white space in the line(s) */ -/* of text which are stored, so that the appearance of the of */ -/* information will be unchanged when it is retrieved (extracted) at */ -/* some other time. Trailing blanks, however, are NOT preserved, */ -/* due to the way that character strings are represented in */ -/* standard Fortran 77. */ - -/* This routine will delete the entire comment area from the binary */ -/* DAS file attached to HANDLE. The size of the binary DAS file will */ -/* remain unchanged. The space that was used by the comment records */ -/* is reclaimed. */ - -/* $ Examples */ - -/* Let */ - -/* HANDLE be the handle for a DAS file which has been opened */ -/* with write access. */ - -/* The call */ - -/* CALL DASDC ( HANDLE ) */ - -/* will delete the entire comment area of the binary DAS file */ -/* attached to HANDLE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ - -/* Changed the $Brief_I/O description of handle. It now mentions */ -/* that the file must be open for writing. Also added a statement */ -/* to the $ Detailed_Input section to the effect that the DAS file */ -/* should have been opened with write access. */ - -/* - SPICELIB Version 1.0.0, 24-NOV-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete das comment area */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ - -/* Changed the $Brief_I/O description of handle. It now mentions */ -/* that the file must be open for writing. Also added a statement */ -/* to the $ Detailed_Input section to the effect that the DAS file */ -/* should have been opened with write access. */ - -/* - SPICELIB Version 1.0.0, 24-NOV-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Length of a DAS file ID word. */ - - -/* Length of a DAS file internal filename. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASDC", (ftnlen)5); - } - -/* Verify that the DAS file attached to HANDLE is opened with write */ -/* access. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASDC", (ftnlen)5); - return 0; - } - -/* Read the file record to obtain the current number of comment */ -/* records in the DAS file attached to HANDLE. We will also get */ -/* back some extra stuff that we do not use. */ - - dasrfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, (ftnlen) - 8, (ftnlen)60); - if (failed_()) { - chkout_("DASDC", (ftnlen)5); - return 0; - } - -/* Now we will attempt to remove the comment records, if there are */ -/* any, otherwise we do nothing. */ - - if (ncomr > 0) { - dasrcr_(handle, &ncomr); - if (failed_()) { - chkout_("DASDC", (ftnlen)5); - return 0; - } - -/* Now we need to update the DAS file record. */ - -/* Read in the updated file record since it has been modified: */ -/* we deleted all of the comment records. */ - - dasrfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, ( - ftnlen)8, (ftnlen)60); - if (failed_()) { - chkout_("DASDC", (ftnlen)5); - return 0; - } - -/* Zero out the number of comment characters, and write the */ -/* updated file record to the file. */ - - ncomc = 0; - daswfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, ( - ftnlen)8, (ftnlen)60); - if (failed_()) { - chkout_("DASDC", (ftnlen)5); - return 0; - } - } - -/* We're done now, so goodbye. */ - - chkout_("DASDC", (ftnlen)5); - return 0; -} /* dasdc_ */ - diff --git a/ext/spice/src/cspice/dasec.c b/ext/spice/src/cspice/dasec.c deleted file mode 100644 index 952e3e4f92..0000000000 --- a/ext/spice/src/cspice/dasec.c +++ /dev/null @@ -1,752 +0,0 @@ -/* dasec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__21 = 21; - -/* $Procedure DASEC ( DAS extract comments ) */ -/* Subroutine */ int dasec_(integer *handle, integer *bufsiz, integer *n, - char *buffer, logical *done, ftnlen buffer_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j, k; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, recno, index, ncomr; - char ch[1]; - extern logical failed_(void); - char ifname[60]; - static integer filhan[21]; - static char crecrd[1024]; - extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *, - ftnlen, ftnlen); - static integer filchr[21]; - extern /* Subroutine */ int dassih_(integer *, char *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - integer linlen, nchars, daslun; - static integer filcnt[21]; - char idword[8]; - static integer lsthan, nfiles, lstrec[21]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer numcom; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer nresvc; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), dasrfr_(integer *, - char *, char *, integer *, integer *, integer *, integer *, - ftnlen, ftnlen), errfnm_(char *, integer *, ftnlen); - integer curpos; - extern logical return_(void); - integer nresvr; - static integer lstpos[21]; - logical eol; - -/* $ Abstract */ - -/* Extract comments from the comment area of a binary DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of binary DAS file open with read access. */ -/* BUFSIZ I Maximum size, in lines, of BUFFER. */ -/* N O Number of comments extracted from the DAS file. */ -/* BUFFER O Buffer in which extracted comments are placed. */ -/* DONE O Indicates whether all comments have been extracted. */ - -/* $ Detailed_Input */ - -/* HANDLE The file handle of a binary DAS file which has been */ -/* opened with read access. */ - -/* BUFSIZ The maximum number of comments that may be placed into */ -/* BUFFER. This would typically be the declared array size */ -/* for the Fortran character string array passed into this */ -/* routine. */ - -/* $ Detailed_Output */ - -/* N The number of comment lines extracted from the comment */ -/* area of the binary DAS file attached to HANDLE. This */ -/* number will be <= BUFSIZ on output. If N = BUFSIZ and */ -/* DONE <> .TRUE. then there are more comments left to to */ -/* extract. If N = 0, then DONE = .TRUE., i.e., there were */ -/* no comments in the comment area. If there are comments */ -/* in the comment area, or comments remaining after the */ -/* extraction process has begun, N > 0, always. */ - -/* BUFFER A list of at most BUFSIZ comments which have been */ -/* extracted from the comment area of the binary DAS */ -/* file attached to HANDLE. */ - -/* DONE A logical flag indicating whether or not all of the */ -/* comment lines from the comment area of the DAS file have */ -/* been read. This variable has the value .TRUE. after the */ -/* last comment line has been read. It will have the value */ -/* .FALSE. otherwise. */ - -/* If there are no comments in the comment area, this */ -/* variable will have the value .TRUE., and N = 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the output line buffer is is not positive, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 3) If a comment line in a DAS file is longer than the length */ -/* of a character string array element of BUFFER, the error */ -/* SPICE(COMMENTTOOLONG) will be signalled. */ - -/* 3) If there is a mismatch between the number of comment */ -/* characters found and the number of comment characters */ -/* expected, the error SPICE(BADDASCOMMENTAREA) will be */ -/* signalled. */ - -/* 4) If the binary DAS file attached to HANDLE is not open for */ -/* reading, an error will be signalled by a routine called by */ -/* this routine. */ - -/* $ Files */ - -/* See argument HANDLE in $ Detailed_Input. */ - -/* $ Particulars */ - -/* Binary DAS files contain an area which is reserved for storing */ -/* annotations or descriptive textual information describing the data */ -/* contained in a file. This area is referred to as the ``comment */ -/* area'' of the file. The comment area of a DAS file is a line */ -/* oriented medium for storing textual information. The comment */ -/* area preserves any leading or embedded white space in the line(s) */ -/* of text which are stored, so that the appearance of the of */ -/* information will be unchanged when it is retrieved (extracted) at */ -/* some other time. Trailing blanks, however, are NOT preserved, */ -/* due to the way that character strings are represented in */ -/* standard Fortran 77. */ - -/* This routine will read the comments from the comment area of */ -/* a binary DAS file, placing them into a line buffer. If the line */ -/* buffer is not large enough to hold the entire comment area, */ -/* the portion read will be returned to the caller, and the DONE */ -/* flag will be set to .FALSE.. This allows the comment area to be */ -/* read in ``chunks,'' a buffer at a time. After all of the comment */ -/* lines have been read, the DONE flag will be set to .TRUE.. */ - -/* This routine can be used to ``simultaneously'' extract comments */ -/* from the comment areas of multiple binary DAS files. See Example */ -/* 2 in the $ Examples section. */ - -/* $ Examples */ - -/* Example 1 */ -/* --------- */ - -/* The following example will extract the entire comment area of a */ -/* binary DAS file attached to HANDLE, displaying the comments on */ -/* the terminal screen. */ - -/* Let */ - -/* BUFFER have the following declaration: */ - -/* CHARACTER*(80) BUFFER(25) */ - -/* HANDLE be the handle of an open binary DAS file. */ - -/* then */ - -/* BUFSIZ = 25 */ -/* DONE = .FALSE. */ - -/* DO WHILE ( .NOT. DONE ) */ - -/* CALL DASEC( HANDLE, BUFSIZ, N, BUFFER, DONE ) */ - -/* DO I = 1, N */ - -/* WRITE (*,*) BUFFER(I) */ - -/* END DO */ - -/* END DO */ - -/* Example 2 */ -/* --------- */ - -/* The following example demonstrates the use of this routine to */ -/* simultaneously read the comment areas of multiple DAS files. */ -/* For each file, the comments will be displayed on the screen as */ -/* they are extracted. */ - -/* Let */ - -/* BUFFER have the following declaration: */ - -/* CHARACTER*(80) BUFFER(25) */ - -/* NUMFIL be the number of binary DAS files that are to have */ -/* their comment areas displayed. */ - -/* DASNAM(I) Be a list of filenames for the DAS files which are */ -/* to have their comment areas displayed. */ - -/* HANDLE(I) be a list of handles for the DAS files which are */ -/* to have their comment areas displayed. */ - -/* DONE(I) be a list of logical flags indicating whether */ -/* we are done extracting the comment area from the */ -/* DAS file attached to HANDLE(I) */ - -/* then */ - -/* BUFSIZ = 25 */ - -/* DO I = 1, NUMFIL */ - -/* DONE(I) = .FALSE. */ -/* HANDLE(I) = 0 */ - -/* END DO */ -/* C */ -/* C Open the DAS files. */ -/* C */ -/* DO I = 1, NUMFIL */ - -/* CALL DASOPR ( DASNAM(I), HANDLE(I) ) */ - -/* END DO */ -/* C */ -/* C While there are still some comments left to read in at */ -/* C least one of the files, read them and display them. */ -/* C */ -/* DO WHILE ( .NOT. ALLTRU( DONE, NUMFIL ) ) */ - -/* DO I = 1, NUMFIL */ - -/* IF ( .NOT. DONE(I) ) THEN */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'File: ', DASNAM(I)(:RTRIM(DASNAM(I))) */ -/* WRITE (*,*) */ -/* N = 0 */ - -/* CALL DASEC ( HANDLE(I), */ -/* . BUFSIZ, */ -/* . N, */ -/* . BUFFER, */ -/* . DONE(I) ) */ - -/* DO J = 1, N */ - -/* WRITE (*,*) BUFFER(J)(:RTRIM(BUFFER(J))) */ - -/* END DO */ - -/* END IF */ - -/* END DO */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The comment area may consist only of printing ASCII characters, */ -/* decimal values 32 - 126. See the MAXPCH and MINPCH parameters */ -/* defined in the $ Local Parameters section. */ - -/* 2) There is NO maximum length imposed on the significant portion */ -/* of a text line that may be placed into the comment area of a */ -/* DAS file. The maximum length of a line stored in the comment */ -/* area should be kept reasonable, so that they may be easily */ -/* extracted. A good value for this would be 255 characters, as */ -/* this can easily accomodate ``screen width'' lines as well as */ -/* long lines which may contain some other form of information. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 18-JUN-1999 (WLT) */ - -/* Changed name used in CHKOUT to be consistent with the CHKIN */ -/* value. */ - -/* - SPICELIB Version 1.2.0, 04-AUG-1994 (KRG) */ - -/* Rearranged some of the code to avoid always reading the file */ -/* record. Now we look for the input HANDLE in the file table */ -/* first, and only read the file record if we do not find it. Also */ -/* added a new array to be saved: FILCNT. This is the number of */ -/* comment characters in a file; we save it now rather than */ -/* reading it every time. */ - -/* Fixed a bug. If the Fortran character string array elements */ -/* have exactly the same length as a comment in the comment area, */ -/* this routine would halt rather unexpectedly from a memory over */ -/* run. */ - -/* - SPICELIB Version 1.1.0, 22-NOV-1993 (KRG) */ - -/* Changed the value of the parameter FTSIZE from 20 to 21. This */ -/* change makes the value of FTSIZE in DASEC compatible with the */ -/* value in DASFM. See DASFM for a discussion of the reasons for */ -/* the increase in the value. */ - -/* - SPICELIB Version 1.0.0, 23-NOV-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract comments from a das file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 04-AUG-1994 (KRG) */ - -/* Rearranged some of the code to avoid always reading the file */ -/* record. Now we look for the input HANDLE in the file table */ -/* first, and only read the file record if we do not find it. Also */ -/* added a new array to be saved: FILCNT. This is the number of */ -/* comment characters in a file; we save it now rather than */ -/* reading it every time. */ - -/* Fixed a bug. If the Fortran character string array elements */ -/* have exactly the same length as a comment in the comment area, */ -/* this routine would halt rather unexpectedly from a memory over */ -/* run. This occurred when attempting to clear, i.e., blank pad, */ -/* the portion of a character string element that extended beyond */ -/* the text in a comment line. A test has been added to verify */ -/* that blank padding can be performed. */ - -/* - SPICELIB Version 1.1.0, 22-NOV-1993 (KRG) */ - -/* Changed the value of the parameter FTSIZE from 20 to 21. This */ -/* change makes the value of FTSIZE in DASEC compatible with the */ -/* value in DASFM. See DASFM for a discussion of the reasons for */ -/* the increase in the value. */ - -/* - SPICELIB Version 1.0.0, 23-NOV-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* The maximum number of DAS files that may be open simultaneously. */ - - -/* Length of a DAS character record, in characters. */ - - -/* Maximum and minimum decimal values for the printable ASCII */ -/* characters. */ - - -/* Decimal value for the DAS comment area end-of-line (EOL) marker. */ - - -/* Maximum length of a filename. */ - - -/* Length of a DAS file ID word. */ - - -/* Length of a DAS file internal filename. */ - - -/* Local variables */ - - -/* The file table declarations for keeping track of which files */ -/* are currently in the process of having comments extracted. */ - - -/* Saved variables */ - - -/* Save all of the file table information. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASEC", (ftnlen)5); - } - -/* If this is the first time that this routine has been called, */ -/* we need to initialize the character value of the end-of-line */ -/* marker, and the file table variables. */ - - if (first) { - first = FALSE_; - nfiles = 0; - lsthan = -1; - for (i__ = 1; i__ <= 21; ++i__) { - filcnt[(i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("filcnt" - , i__1, "dasec_", (ftnlen)478)] = 0; - filchr[(i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("filchr" - , i__1, "dasec_", (ftnlen)479)] = 0; - filhan[(i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("filhan" - , i__1, "dasec_", (ftnlen)480)] = 0; - lstrec[(i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("lstrec" - , i__1, "dasec_", (ftnlen)481)] = 0; - lstpos[(i__1 = i__ - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("lstpos" - , i__1, "dasec_", (ftnlen)482)] = 0; - } - } - -/* Verify that the DAS file attached to HANDLE is opened for reading */ -/* by calling the routine to signal an invalid access mode on a */ -/* handle. */ - - dassih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DASEC", (ftnlen)5); - return 0; - } - -/* Check for a nonpositive BUFFER size. */ - - if (*bufsiz <= 0) { - setmsg_("The output buffer size was not positive: #.", (ftnlen)43); - errint_("#", bufsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DASEC", (ftnlen)5); - return 0; - } - -/* Convert the DAS file handle to its corresponding Fortran logical */ -/* unit number for reading the comment records. */ - - dashlu_(handle, &daslun); - if (failed_()) { - chkout_("DASEC", (ftnlen)5); - return 0; - } - -/* Get the length of a single character string in the buffer. */ - - linlen = i_len(buffer, buffer_len); - -/* If we have extracted comments from at least one file and we */ -/* didn't finish, get the index for that file in the file table. */ - - if (nfiles > 0) { - index = isrchi_(handle, &nfiles, filhan); - } else { - index = 0; - } - -/* Check to see if we found HANDLE in the file handle table. If */ -/* we did, INDEX will be > 0. */ - - if (index > 0) { - -/* Set the record number and the starting position accordingly, */ -/* i.e., where we left off when we last read from that file. */ - - recno = lstrec[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "lstrec", i__1, "dasec_", (ftnlen)550)]; - curpos = lstpos[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "lstpos", i__1, "dasec_", (ftnlen)551)]; - nchars = filchr[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "filchr", i__1, "dasec_", (ftnlen)552)]; - ncomc = filcnt[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "filcnt", i__1, "dasec_", (ftnlen)553)]; - } else { - -/* We have not yet read any comments from this file, so start at */ -/* the start. To get to the first comment record, we need to skip */ -/* the file record and any reserved records that are in the file. */ -/* The first comment record immediately follows the last reserved */ -/* record. */ - -/* Get the current number of comment records and comment */ -/* characters from the DAS file attached to HANDLE. We will also */ -/* get back some extra stuff that we do not use. */ - - dasrfr_(handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, ( - ftnlen)8, (ftnlen)60); - if (failed_()) { - chkout_("DASEC", (ftnlen)5); - return 0; - } - -/* If the number of comment characters, NCOMC, is equal to zero, */ -/* then we have no comments to read, so set the number of comments */ -/* to zero, set DONE to .TRUE., check out, and return. */ - - if (ncomc == 0) { - *n = 0; - *done = TRUE_; - chkout_("DASEC", (ftnlen)5); - return 0; - } - recno = nresvr + 2; - curpos = 1; - nchars = 0; - } - -/* Begin reading the comment area into the buffer. */ - - if (*handle != lsthan) { - -/* If the current DAS handle is not the same as the handle on */ -/* the last call, then we need to read in the appropriate record */ -/* from the DAS file comment area. Otherwise the record was saved, */ -/* so we don't need to read it in. */ - - dasioc_("READ", &daslun, &recno, crecrd, (ftnlen)4, (ftnlen)1024); - } - -/* Initialize the BUFFER line counter, I, and the line position */ -/* counter, J. */ - - i__ = 1; - j = 1; - *done = FALSE_; - while(i__ <= *bufsiz && ! (*done)) { - eol = FALSE_; - while(! eol) { - ++nchars; - *(unsigned char *)ch = *(unsigned char *)&crecrd[curpos - 1]; - if (*(unsigned char *)ch == 0) { - eol = TRUE_; - if (j <= linlen) { - s_copy(buffer + ((i__ - 1) * buffer_len + (j - 1)), " ", - buffer_len - (j - 1), (ftnlen)1); - } - } else { - if (j <= linlen) { - *(unsigned char *)&buffer[(i__ - 1) * buffer_len + (j - 1) - ] = *(unsigned char *)ch; - ++j; - } else { - setmsg_("The output buffer line length (#) was not long " - "enough to contain a comment line with length #.", - (ftnlen)94); - errint_("#", &linlen, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(COMMENTTOOLONG)", (ftnlen)21); - chkout_("DASEC", (ftnlen)5); - return 0; - } - } - -/* If we have reached the end of the current comment record, */ -/* read in the next one and reset the current position. */ -/* Otherwise, just increment the current position. */ - - if (curpos == 1024) { - ++recno; - dasioc_("READ", &daslun, &recno, crecrd, (ftnlen)4, (ftnlen) - 1024); - curpos = 1; - } else { - ++curpos; - } - -/* Check to make sure that it is safe to continue, i.e., */ -/* that the number of comment characters we have processed */ -/* has not exceeded the number of comment characters in the */ -/* comment area of the DAS file. */ - - if (nchars > ncomc) { - setmsg_("Count of comment characters (#) exceeds the number " - "of comment characters (#) in the DAS file #.", ( - ftnlen)95); - errint_("#", &nchars, (ftnlen)1); - errint_("#", &ncomc, (ftnlen)1); - errfnm_("#", &daslun, (ftnlen)1); - sigerr_("SPICE(BADDASCOMMENTAREA)", (ftnlen)24); - chkout_("DASEC", (ftnlen)5); - return 0; - } - } - -/* We have just completed a comment line, so we save the comment */ -/* number, increment the buffer line counter, I, and reset the */ -/* buffer line position counter, J. */ - - numcom = i__; - ++i__; - j = 1; - -/* Check for the end of the comments. */ - - if (nchars == ncomc) { - -/* If we have reached the end of the comments, signalled */ -/* by having processed all of the comment characters, NCOMC, */ -/* then we are done. So, set DONE to .TRUE. and remove the */ -/* entry for this file from the file table. */ - - *done = TRUE_; - lsthan = -1; - -/* 0 <= INDEX <= NFILES, and we only want to remove things */ -/* from the file table if: */ - -/* 1) There are files in the file table, NFILES > 0 */ -/* 2) The file we are currently reading from is in the */ -/* file table, INDEX > 0. */ - -/* So, if INDEX > 0, we know that there are files in the file */ -/* table, and that we are currently reading from one of them. */ - - if (index > 0) { - i__1 = nfiles - 1; - for (k = index; k <= i__1; ++k) { - filcnt[(i__2 = k - 1) < 21 && 0 <= i__2 ? i__2 : s_rnge( - "filcnt", i__2, "dasec_", (ftnlen)729)] = filcnt[( - i__3 = k) < 21 && 0 <= i__3 ? i__3 : s_rnge("fil" - "cnt", i__3, "dasec_", (ftnlen)729)]; - filchr[(i__2 = k - 1) < 21 && 0 <= i__2 ? i__2 : s_rnge( - "filchr", i__2, "dasec_", (ftnlen)730)] = filchr[( - i__3 = k) < 21 && 0 <= i__3 ? i__3 : s_rnge("fil" - "chr", i__3, "dasec_", (ftnlen)730)]; - filhan[(i__2 = k - 1) < 21 && 0 <= i__2 ? i__2 : s_rnge( - "filhan", i__2, "dasec_", (ftnlen)731)] = filhan[( - i__3 = k) < 21 && 0 <= i__3 ? i__3 : s_rnge("fil" - "han", i__3, "dasec_", (ftnlen)731)]; - lstrec[(i__2 = k - 1) < 21 && 0 <= i__2 ? i__2 : s_rnge( - "lstrec", i__2, "dasec_", (ftnlen)732)] = lstrec[( - i__3 = k) < 21 && 0 <= i__3 ? i__3 : s_rnge("lst" - "rec", i__3, "dasec_", (ftnlen)732)]; - lstpos[(i__2 = k - 1) < 21 && 0 <= i__2 ? i__2 : s_rnge( - "lstpos", i__2, "dasec_", (ftnlen)733)] = lstpos[( - i__3 = k) < 21 && 0 <= i__3 ? i__3 : s_rnge("lst" - "pos", i__3, "dasec_", (ftnlen)733)]; - } - --nfiles; - } - } - } - -/* Set the number of comment lines in the buffer */ - - *n = numcom; - -/* At this point, we have either filled the buffer or we have */ -/* finished reading in the comment area. Find out what has */ -/* happened and act accordingly. */ - - if (! (*done)) { - -/* If we are not done, then we have filled the buffer, so save */ -/* everything that needs to be saved in the file table before */ -/* exiting. */ - - if (index == 0) { - -/* This was the first time that the comment area of this file */ -/* has been read, so add it to the file table and save all of */ -/* its information if there is room in the file table. */ - - if (nfiles >= 21) { - setmsg_("The file table is full with # files, and another fi" - "le could not be added.", (ftnlen)73); - errint_("#", &c__21, (ftnlen)1); - sigerr_("SPICE(FILETABLEFULL)", (ftnlen)20); - chkout_("DASEC", (ftnlen)5); - return 0; - } - ++nfiles; - filcnt[(i__1 = nfiles - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "filcnt", i__1, "dasec_", (ftnlen)777)] = ncomc; - filchr[(i__1 = nfiles - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "filchr", i__1, "dasec_", (ftnlen)778)] = nchars; - filhan[(i__1 = nfiles - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "filhan", i__1, "dasec_", (ftnlen)779)] = *handle; - lstrec[(i__1 = nfiles - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "lstrec", i__1, "dasec_", (ftnlen)780)] = recno; - lstpos[(i__1 = nfiles - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "lstpos", i__1, "dasec_", (ftnlen)781)] = curpos; - lsthan = *handle; - } else { - -/* The comment area of this file is already in the file table, */ -/* so just update its information. */ - - filchr[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fil" - "chr", i__1, "dasec_", (ftnlen)789)] = nchars; - lstrec[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("lst" - "rec", i__1, "dasec_", (ftnlen)790)] = recno; - lstpos[(i__1 = index - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("lst" - "pos", i__1, "dasec_", (ftnlen)791)] = curpos; - lsthan = *handle; - } - } - chkout_("DASEC", (ftnlen)5); - return 0; -} /* dasec_ */ - diff --git a/ext/spice/src/cspice/dasec_c.c b/ext/spice/src/cspice/dasec_c.c deleted file mode 100644 index 0757d4531f..0000000000 --- a/ext/spice/src/cspice/dasec_c.c +++ /dev/null @@ -1,306 +0,0 @@ -/* - --Procedure dasec_c ( DAS extract comments ) - --Abstract - - Extract comments from the comment area of a binary DAS file. - --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 - - DAS - --Keywords - - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef dasec_c - - void dasec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt buflen, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of binary DAS file open with read access. - bufsiz I Maximum size, in lines, of buffer. - buflen I Line length associated with buffer. - n O Number of comments extracted from the DAS file. - buffer O Buffer in which extracted comments are placed. - done O Indicates whether all comments have been extracted. - --Detailed_Input - - handle The file handle of a binary DAS file which has been - opened with read access. - - bufsiz The maximum number of comments that may be placed into - buffer. This would typically be the declared array size - for the C character string array passed into this - routine. - - buflen is the common length of the strings in buffer, including the - terminating nulls. - --Detailed_Output - - n The number of comment lines extracted from the comment area - of the binary DAS file attached to handle. This number will - be <= bufsiz on output. If n == bufsiz and done != - SPICETRUE then there are more comments left to extract. If - n == 0, then done == SPICETRUE, i.e., there were no - comments in the comment area. If there are comments in the - comment area, or comments remaining after the extraction - process has begun, n > 0, always. - - buffer A list of at most bufsiz comments which have been - extracted from the comment area of the binary DAS - file attached to handle. buffer should be declared as - follows: - - ConstSpiceChar buffer [bufsiz][buflen] - - Each string in buffer is null-terminated. - - done A boolean flag indicating whether or not all of the - comment lines from the comment area of the DAS file have - been read. This variable has the value SPICETRUE after the - last comment line has been read. It will have the value - SPICEFALSE otherwise. - - If there are no comments in the comment area, this - variable will have the value SPICETRUE, and n == 0. - --Parameters - - None. - --Exceptions - - 1) If the size of the output line buffer is is not positive, - the error SPICE(INVALIDARGUMENT) will be signaled. - - 2) If a comment line in a DAS file is longer than the length - of a character string array element of BUFFER, the error - SPICE(COMMENTTOOLONG) will be signaled. - - 3) If there is a mismatch between the number of comment - characters found and the number of comment characters - expected, the error SPICE(BADDASCOMMENTAREA) will be - signaled. - - 4) If the binary DAS file attached to HANDLE is not open for - reading, an error will be signaled by a routine called by - this routine. - - 5) If the input buffer pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 6) If the input buffer string length buflen is not at least 2, - the error SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See argument handle in $ Detailed_Input. - --Particulars - - Binary DAS files contain an area which is reserved for storing - annotations or descriptive textual information describing the data - contained in a file. This area is referred to as the "comment - area" of the file. The comment area of a DAS file is a line - oriented medium for storing textual information. The comment - area preserves any leading or embedded white space in the line(s) - of text which are stored, so that the appearance of the of - information will be unchanged when it is retrieved (extracted) at - some other time. Trailing blanks, however, are NOT preserved, - due to the way that character strings are represented in - standard Fortran 77. - - This routine will read the comments from the comment area of - a binary DAS file, placing them into a line buffer. If the line - buffer is not large enough to hold the entire comment area, - the portion read will be returned to the caller, and the done - flag will be set to SPICEFALSE. This allows the comment area to be - read in "chunks," a buffer at a time. After all of the comment - lines have been read, the done flag will be set to SPICETRUE. - - After all of the comments in DAS file have been read, the next - call to this routine will start reading comments at the start - of the comment area. - - This routine can be used to "simultaneously" extract comments - from the comment areas of multiple binary DAS files. - --Examples - - 1) The following example will extract the entire comment area of a - binary DAS file attached to HANDLE, displaying the comments on - the terminal screen. - - #include - #include "SpiceUsr.h" - - int main( int argc, char ** argv ) - { - - #define LNSIZE 81 - #define MAXBUF 25 - - SpiceBoolean done; - - SpiceChar buffer [MAXBUF][LNSIZE]; - SpiceChar * filename; - - SpiceInt handle; - SpiceInt i; - SpiceInt n; - - - filename = argv[1]; - - dasopr_ ( filename, &handle, (ftnlen)strlen(filename) ); - - done = SPICEFALSE; - - while ( !done ) - { - dasec_c( handle, MAXBUF, LNSIZE, &n, buffer, &done ); - - for ( i = 0; i < n; i++ ) - { - printf ( "%s\n", buffer[i] ); - } - } - - return ( 0 ); - } - - --Restrictions - - 1) The comment area may consist only of printing ASCII characters, - decimal values 32 - 126. - - 2) There is NO maximum length imposed on the significant portion - of a text line that may be placed into the comment area of a - DAS file. The maximum length of a line stored in the comment - area should be kept reasonable, so that they may be easily - extracted. A good value for this would be 255 characters, as - this can easily accommodate "screen width" lines as well as - long lines which may contain some other form of information. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.0, 24-FEB-2003 (NJB) (KRG) - --Index_Entries - - extract comments from a das file - --& -*/ - -{ /* Begin dasec_c */ - - - /* - Local variables - */ - logical locDone; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "dasec_c" ); - - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "dasec_c", buffer, buflen ); - - - /* - Call the f2c'd routine. - */ - dasec_ ( (integer *) &handle, - (integer *) &bufsiz, - (integer *) n, - (char *) buffer, - (logical *) &locDone, - (ftnlen ) buflen-1 ); - - /* - Convert the output array from Fortran to C style. - */ - if ( *n > 0 ); - { - F2C_ConvertTrStrArr ( *n, buflen, (SpiceChar *)buffer ); - } - - - /* - Set the "done" flag. - */ - - *done = (SpiceBoolean) locDone; - - - chkout_c ( "dasec_c" ); - -} /* End dasec_c */ diff --git a/ext/spice/src/cspice/dasecu.c b/ext/spice/src/cspice/dasecu.c deleted file mode 100644 index 84c9aa2027..0000000000 --- a/ext/spice/src/cspice/dasecu.c +++ /dev/null @@ -1,235 +0,0 @@ -/* dasecu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__22 = 22; - -/* $Procedure DASECU ( DAS extract comments to a logical unit ) */ -/* Subroutine */ int dasecu_(integer *handle, integer *comlun, logical * - comnts) -{ - extern /* Subroutine */ int dasec_(integer *, integer *, integer *, char * - , logical *, ftnlen), chkin_(char *, ftnlen); - extern logical failed_(void); - char combuf[255*22]; - extern /* Subroutine */ int dassih_(integer *, char *, ftnlen); - integer numcom; - extern /* Subroutine */ int chkout_(char *, ftnlen), writla_(integer *, - char *, integer *, ftnlen); - logical gotsom; - extern logical return_(void); - logical eoc; - -/* $ Abstract */ - -/* Extract comments from a previously opened binary DAS file to a */ -/* previously opened text file attached to a Fortran logical unit. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAS file opened with read access. */ -/* COMLUN I Logical unit of an opened text file. */ -/* COMNTS O Logical flag, indicating comments were found. */ - -/* $ Detailed_Input */ - -/* HANDLE The file handle for a binary DAS file that has been */ -/* opened with read access. */ - -/* COMLUN The Fortran logical unit of a previously opened text */ -/* file to which the comments from a binary DAS file are */ -/* to be written. */ - -/* The comments will be placed into the text file beginning */ -/* at the current location in the file, and continuing */ -/* until all of the comments have been written. */ - -/* $ Detailed_Output */ - -/* COMNTS A logical flag indicating whether or not any comments */ -/* were found in the comment area of a DAS file. COMNTS will */ -/* have the value .TRUE. if there were some comments, and */ -/* the value .FALSE. otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while reading from the binary DAS file */ -/* attached to HANDLE, a routine called by this routine will */ -/* signal an error. */ - -/* 2) If an error occurs while writing to the text file attached */ -/* to COMLUN, a routine called by this routine will signal an */ -/* error. */ - -/* $ Files */ - -/* See parameters COMLUN and HANDLE in the $ Detailed_Inputs section. */ - -/* $ Particulars */ - -/* This routine will extract all of the comments from the comment */ -/* area of a binary DAS file, placing them into a text file */ -/* attached to COMLUN, beginning at the current position in the */ -/* text file. If there are no comments in the DAS file, nothing is */ -/* written to the text file attached to COMLUN. */ - -/* $ Examples */ - -/* Let */ - -/* HANDLE be the DAS file handle of a previously opened binary */ -/* DAS file. */ - -/* COMLUN be the Fortran logical unit of a previously opened */ -/* text file that is to accept the comments from the */ -/* DAS comment area. */ - -/* The subroutine call */ - -/* CALL DASECU ( HANDLE, COMLUN, COMNTS ) */ - -/* will extract the comments from the comment area of the binary */ -/* DAS file attached to HANDLE, if there are any, and write them */ -/* to the logical unit COMLUN. Upun successfur completion, the */ -/* value of COMNTS will be .TRUE. if there were some comments */ -/* in the comment area and .FALSE. otherwise. */ - -/* $ Restrictions */ - -/* The maximum length of a single line comment in the comment area is */ -/* specified by the parameter LINLEN defined below. Currently this */ -/* value is 255 characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-JAN-1993 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract comments from a DAS file to a logical unit */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Set the value for the maximum length of a text line. */ - - -/* Set the size of the comment buffer. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASECU", (ftnlen)6); - } - -/* Verify that the DAS file attached to HANDLE is opened for reading. */ - - dassih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DASECU", (ftnlen)6); - return 0; - } - -/* Initialize some things before the loop. */ - - numcom = 0; - eoc = FALSE_; - gotsom = FALSE_; - while(! eoc) { - -/* While we have not reached the end of the comments, get some */ -/* more. */ - - dasec_(handle, &c__22, &numcom, combuf, &eoc, (ftnlen)255); - if (failed_()) { - chkout_("DASECU", (ftnlen)6); - return 0; - } - if (numcom > 0) { - -/* If NUMCOM .GT. 0 then we did get some comments, and we need */ -/* to write them out, but first, set the flag indicating that */ -/* we got some comments. */ - - if (! gotsom) { - gotsom = TRUE_; - } - writla_(&numcom, combuf, comlun, (ftnlen)255); - if (failed_()) { - chkout_("DASECU", (ftnlen)6); - return 0; - } - } - } - -/* Set the output flag indicating whether or not we got any comments. */ - - *comnts = gotsom; - chkout_("DASECU", (ftnlen)6); - return 0; -} /* dasecu_ */ - diff --git a/ext/spice/src/cspice/dasfm.c b/ext/spice/src/cspice/dasfm.c deleted file mode 100644 index fef5359773..0000000000 --- a/ext/spice/src/cspice/dasfm.c +++ /dev/null @@ -1,6452 +0,0 @@ -/* dasfm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__21 = 21; -static integer c__2 = 2; -static integer c__4 = 4; -static integer c__1 = 1; -static integer c__14 = 14; -static integer c__3 = 3; -static integer c__0 = 0; -static integer c__256 = 256; - -/* $Procedure DASFM ( DAS, file manager ) */ -/* Subroutine */ int dasfm_0_(int n__, char *fname, char *ftype, char *ifname, - integer *handle, integer *unit, integer *free, integer *lastla, - integer *lastrc, integer *lastwd, integer *nresvr, integer *nresvc, - integer *ncomr, integer *ncomc, integer *fhset, char *access, ftnlen - fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - static integer fthead = 0; - static integer nxthan = 0; - static integer next[3] = { 2,3,1 }; - static integer prev[3] = { 3,1,2 }; - static integer nw[3] = { 1024,128,256 }; - static char bfflst[8*4] = "BIG-IEEE" "LTL-IEEE" "VAX-GFLT" "VAX-DFLT"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3, i__4[2], i__5; - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), s_rnge( - char *, integer, char *, integer), f_open(olist *), f_clos(cllist - *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - static integer nrec; - static char tail[932]; - static integer last, pool[54] /* was [2][27] */, type__; - extern /* Subroutine */ int zzddhppf_(integer *, integer *, integer *), - zzdasnfr_(integer *, char *, char *, integer *, integer *, - integer *, integer *, char *, ftnlen, ftnlen, ftnlen), zzplatfm_( - char *, char *, ftnlen, ftnlen); - static integer i__, ftacc[21], ldrec[3]; - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer fthan[21]; - static char tarch[3]; - extern /* Subroutine */ int maxai_(integer *, integer *, integer *, - integer *), errch_(char *, char *, ftnlen, ftnlen), lnkan_( - integer *, integer *), ucase_(char *, char *, ftnlen, ftnlen); - static logical found; - static integer ftlnk[21]; - extern /* Subroutine */ int copyi_(integer *, integer *); - extern integer ltrim_(char *, ftnlen); - static integer ftlun[21]; - extern integer rtrim_(char *, ftnlen); - static integer ftsum[294] /* was [14][21] */; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static char ttype[4]; - extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - extern logical failed_(void); - static char dasfil[255]; - static integer endrec, loccch, dirrec[256], loccrc; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - lnknfn_(integer *); - static char format[8], idword[8], lngmsg[1840], locifn[60], locfmt[8]; - static integer dsctyp, fhlist[27], findex, iostat, ldrmax, locrrc; - extern integer lnknxt_(integer *, integer *); - extern logical exists_(char *, ftnlen), return_(void); - static integer locrch, maxadr, number, curtyp, nxtdir, nxtrec; - static logical opened; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), lnkini_(integer *, integer *), ssizei_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), getlun_(integer *); - static integer prvtyp; - extern /* Subroutine */ int lnkilb_(integer *, integer *, integer *), - cleari_(integer *, integer *); - static char acc[10]; - extern /* Subroutine */ int dasioi_(char *, integer *, integer *, integer - *, ftnlen), insrti_(integer *, integer *); - static integer bff; - extern /* Subroutine */ int lnkfsl_(integer *, integer *, integer *), - removi_(integer *, integer *), errfnm_(char *, integer *, ftnlen); - static integer fnb, loc, new__, pos; - - /* Fortran I/O blocks */ - static cilist io___22 = { 1, 0, 1, 0, 1 }; - static cilist io___48 = { 1, 0, 1, 0, 1 }; - static cilist io___52 = { 1, 0, 0, 0, 1 }; - static cilist io___53 = { 1, 0, 1, 0, 1 }; - static cilist io___55 = { 1, 0, 0, 0, 1 }; - - -/* $ Abstract */ - -/* Manage open DAS files. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* The record length should be big enough to hold the greatest of the */ -/* following: */ -/* -- NWD double precision numbers. */ -/* -- NWI integers. */ -/* -- NWC characters. */ -/* These parameters are named to enhance ease of maintenance of */ -/* the code; the values should not be changed. */ -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ -/* Environment: PC/Linux, Fort77 */ -/* Source: Determined by experiment. */ -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ -/* FTSIZE is the maximum number of DAS files that a user can have */ -/* open simultaneously. See the description in the $ Parameters */ -/* section for details. */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I,O OPR, OPW, ONW, OPN (Obsolete), HFN, FNH */ -/* FTYPE I ONW */ -/* IFNAME I ONW, OPN (Obsolete) */ -/* SUM I,O UFS, HFS */ -/* HANDLE I,O OPR, OPW, ONW, OPN (Obsolete), OPS, LLC, HLU, LUH, */ -/* HFN, FNH, HAM, SIH */ -/* UNIT I,O HLU, LUH */ -/* FREE I,O HFS, UFS */ -/* LASTLA I,O HFS, UFS */ -/* LASTRC I,O HFS, UFS */ -/* LASTWD I,O HFS, UFS */ -/* NRESVR O HFS */ -/* NRESVC O HFS */ -/* NCOMR O HFS */ -/* NCOMC O HFS */ -/* FHSET O HOF */ -/* ACCESS I,O SIH, HAM */ -/* RECL P OPR, OPW, ONW, OPN (Obsolete) */ -/* FTSIZE P OPR, OPW, ONW, OPN (Obsolete), LLC, HLU, LUH, HFN, */ -/* FNH */ - -/* $ Detailed_Input */ - -/* FNAME on input is the name of a DAS file to be opened, or */ -/* the name of a DAS file about which some information */ -/* (handle, logical unit) is requested. */ - -/* FTYPE on input is a code for the type of data that is */ -/* contained in the DAS file. This code has no meaning or */ -/* interpretation at the level of the DAS file */ -/* architecture, but is provided as a convenience for */ -/* higher level software. The maximum length for the file */ -/* type is four (4) characters. If the input string is */ -/* longer than four characters, the first nonblank */ -/* character and its three, at most, immediate successors */ -/* will be used as the file type. The file type may not */ -/* contain nonprinting characters, and it IS case */ -/* sensitive. */ - -/* IFNAME is the internal file name for a DAS file to be */ -/* created. */ - -/* HANDLE on input is the handle of a DAS file about which some */ -/* information (file name, logical unit) is requested, */ -/* or the handle of a DAS file to be closed. */ - -/* UNIT on input is the logical unit connected to a DAS file */ -/* about which some information (file name, handle) is */ -/* requested. */ - -/* FREE is the Fortran record number of the first free record */ -/* in a specified DAS file. */ - -/* LASTLA is an array containing the highest current logical */ -/* addresses, in the specified DAS file, of data of */ -/* character, double precision, and integer types, in */ -/* that order. */ - -/* LASTRC is an array containing the Fortran record numbers, in */ -/* the specified DAS file, of the directory records */ -/* containing the current last descriptors of clusters */ -/* of character, double precision, and integer data */ -/* records, in that order. */ - -/* LASTWD is an array containing the word positions, in the */ -/* specified DAS file, of the current last descriptors */ -/* of clusters of character, double precision, and */ -/* integer data records, in that order. */ - -/* ACCESS is the type of access for which a DAS file is open. */ -/* The values of ACCESS may be */ - -/* 'READ' */ -/* 'WRITE' */ - -/* Leading and trailing blanks are ignored, and case */ -/* is not significant. */ - -/* DAS files that are open for writing may also be read. */ - -/* $ Detailed_Output */ - -/* FNAME on output is the name of a DAS file for which */ -/* the corresponding handle or logical unit has been */ -/* supplied. */ - - -/* HANDLE on output is the handle of a DAS file for which */ -/* the corresponding file name or logical unit has been */ -/* supplied. */ - -/* UNIT on output is the logical unit connected to a DAS file */ -/* for which the corresponding file name or handle has */ -/* been supplied. */ - -/* FREE is the Fortran record number of the first free record */ -/* in a specified DAS file. */ - -/* LASTLA is an array containing the highest current logical */ -/* addresses, in the specified DAS file, of data of */ -/* character, double precision, and integer types, in */ -/* that order. */ - -/* LASTRC is an array containing the Fortran record numbers, in */ -/* the specified DAS file, of the directory records */ -/* containing the current last descriptors of clusters */ -/* of character, double precision, and integer data */ -/* records, in that order. */ - -/* LASTWD is an array containing the word positions, in the */ -/* specified DAS file, of the current last descriptors */ -/* of clusters of character, double precision, and */ -/* integer data records, in that order. */ - -/* NRESVR is the number of reserved records in a specified DAS */ -/* file. */ - -/* NRESVC is the number of characters in use in the reserved */ -/* record area of a specified DAS file. */ - -/* NCOMR is the number of comment records in a specified DAS */ -/* file. */ - -/* NCOMC is the number of characters in use in the comment area */ -/* of a specified DAS file. */ - -/* FHSET is a SPICELIB set containing the handles of the */ -/* currently open DAS files. */ - -/* $ Parameters */ - -/* RECL is the record length of a DAS file. Each record */ -/* must be large enough to hold the greatest of NWI */ -/* integers, NWD double precision numbers, or NWC */ -/* characters, whichever is greater. The units in which */ -/* the record length must be specified vary from */ -/* environment to environment. For example, VAX Fortran */ -/* requires record lengths to be specified in longwords, */ -/* where two longwords equal one double precision */ -/* number. */ - -/* FTSIZE is the maximum number of DAS files that a user can */ -/* have open simultaneously. This includes any files used */ -/* by the DAS system when closing files opened with write */ -/* access. Currently, DASCLS (via DASSDR) opens a scratch */ -/* DAS file using DASOPS to segregate (sort by data */ -/* type) the records in the DAS file being closed. */ -/* Segregating the data by type improves the speed of */ -/* access to the data. */ - -/* In order to avoid the possibility of overflowing the */ -/* DAS file table we recommend, when at least one DAS */ -/* file is open with write access, that users of this */ -/* software limit themselves to at most FTSIZE - 2 other */ -/* open DAS files. If no files are to be open with write */ -/* access, then users may open FTSIZE files with no */ -/* possibility of overflowing the DAS file table. */ - -/* $ Exceptions */ - -/* 1) If DASFM is called directly, the error SPICE(BOGUSENTRY) */ -/* is signaled. */ - -/* 2) See entry points DASOPR, DASOPW, DASONW, DASOPN, DASOPS, */ -/* DASLLC, DASHFS, DASUFS, DASHLU, DASLUH, DASHFN, DASFNH, DASHOF, */ -/* and DASSIH for exceptions specific to those entry points. */ - -/* $ Files */ - -/* This set of routines is intended to support the creation, */ -/* updating, and reading of Fortran direct access files that */ -/* conform to the DAS file format. This format is described in */ -/* detail in the DAS Required Reading. */ - -/* See FTSIZE in the $ Parameters section for a description of a */ -/* potential problem with overflowing the DAS file table when at */ -/* least one DAS file is opened with write access. */ - -/* $ Particulars */ - -/* DASFM serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* DASOPR Open for read. */ -/* DASOPW Open for write. */ -/* DASONW Open new. */ -/* DASOPN Open new. (Obsolete: Use DASONW instead.) */ -/* DASOPS Open as scratch file. */ - -/* DASLLC Low-level close. */ - -/* DASHFS Handle to file summary. */ -/* DASUFS Update file summary. */ - -/* DASHLU Handle to logical unit. */ -/* DASLUH Logical to handle. */ - -/* DASHFN Handle to name. */ -/* DASFNH File name to handle. */ - -/* DASHAM Handle to access method. */ - -/* DASHOF Handles of open files. */ -/* DASSIH Signal invalid handles. */ - - -/* Before a DAS file can be used, it must be opened. Entry points */ -/* DASOPR and DASOPW provide the only means for opening an */ -/* existing DAS file. */ - -/* Several files may be opened for use simultaneously. (This makes */ -/* it convenient to combine data from several files to produce a */ -/* single result, or to route subsets of data from a single source */ -/* to multiple DAS files.) As each DAS file is opened, it is */ -/* assigned a file handle, which is used to keep track of the file */ -/* internally, and which is used by the calling program to refer to */ -/* the file in all subsequent calls to DAS routines. */ - -/* DAS files may be opened for either read or write access. Files */ -/* open for read access may not be changed in any way. Files opened */ -/* for write access may be both read from and written to. */ - -/* DASONW is used to open a new DAS file. This routine extends the */ -/* functionality of DASOPN by providing a mechanism for associating a */ -/* type with the data in the DAS file. The use of this entry over */ -/* DASOPN is highly recommended. */ - -/* Since the only reason for creating a new file is to write */ -/* something in it, all new files are opened for write access. */ - -/* Entry point DASOPN, for opening a new DAS file, has been rendered */ -/* obsolete by the new entry point DASONW. The entry point DASOPN */ -/* will continue to be supported for purposes of backward */ -/* compatibility, but its use in new software development is strongly */ -/* discouraged. */ - -/* Entry point DASOPS creates a new scratch DAS file. As with new */ -/* permanent files, these files are opened for write access. DAS */ -/* files opened by DASOPS are automatically deleted when they are */ -/* closed. */ - -/* Entry point DASLLC is used by DASCLS ( DAS, close file ) to close */ -/* an open DAS file and update DASFM's bookkeeping information */ -/* accordingly. DASCLS provides the only official means of closing */ -/* a DAS file that is currently open. Closing a DAS file any other */ -/* way (for example, by determining its logical unit and using the */ -/* Fortran CLOSE statement directly) may affect your calling program */ -/* in mysterious ways. Normally, DASLLC should not be called by */ -/* non-SPICELIB routines; these should call DASCLS instead. */ - -/* Entry point DASHFS allows you to obtain a file summary for any */ -/* DAS file that is currently open, without calling DASRFR to */ -/* re-read the file record. Entry point DASUFS can be used to */ -/* update a file summary at run-time. Normally, there is no */ -/* need for routines outside of SPICELIB to modify a DAS file's */ -/* summary. */ - -/* Entry point DASHAM allows you to determine which access method */ -/* a DAS file has been opened for. */ - -/* Entry point DASHOF allows you to determine which DAS files are */ -/* open at any time. In particular, you can use DASHOF to determine */ -/* whether any file handle points to an open DAS file. */ - -/* Entry point DASSIH signals errors when it is supplied with invalid */ -/* handles, so it serves to centralize error handling associated */ -/* with invalid handles. */ - -/* The remaining entry points exist mainly to translate between */ -/* alternative representations of DAS files. There are three ways to */ -/* identify any open DAS file: by name, by handle, and by logical */ -/* unit. Given any one of these, you may use these entry points to */ -/* find the other two. */ - -/* $ Examples */ - -/* See entry points DASOPR, DASOPW, DASONW, DASOPN (Obsolete), */ -/* DASLLC, DASHFS, DASUFS, DASHLU, DASLUH, DASHFN, DASFNH, DASHAM, */ -/* DASHOF, and DASSIH for examples specific to those entry points. */ - -/* $ Restrictions */ - -/* 1) The value of parameter RECL may need to be changed when DASFM */ -/* and its entry points are ported to a new environment (CPU and */ -/* compiler). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 7.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 7.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 7.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 7.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 7.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 7.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 7.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 7.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 7.10.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 7.9.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 7.8.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 7.7.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 7.6.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 7.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 7.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 7.3.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 7.2.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 7.1.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 7.0.0, 28-SEP-2005 (NJB) */ - -/* Error handling for non-native files was added to */ -/* entry points DASOPR and DASOPW. */ - -/* Bug in code for constructing long error message in entry */ -/* point DASUFS was corrected. */ - -/* - SPICELIB Version 6.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 6.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 6.0.3, 24-APR-2003 (EDW) */ - -/* Added MAC-OSX-F77 to the list of platforms */ -/* that require READONLY to read write protected */ -/* kernels. */ - -/* - SPICELIB Version 6.0.2, 21-FEB-2003 (NJB) */ - -/* Corrected inline comment in DASLLC: determination of */ -/* whether file is open is done by searching the handle column of */ -/* the file table, not the unit column. */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.0, 11-DEC-2001 (NJB) (FST) */ - -/* To accomodate future updates to the DAS system, including */ -/* integration with the handle manager and FTP validation */ -/* checks, the following entry points were modified: */ - -/* DASONW, DASOPN */ - -/* See their headers and code for the details of the changes. */ - -/* Bug fix: removed local buffering of the DAS file ID word */ -/* and the internal file name, as this was causing DASWFR */ -/* to exhibit improper behavior. */ - -/* Bug fix: missing call to CHKIN was added to an error */ -/* handling branch in entry point DASUFS. This call is */ -/* required because DASUFS uses discovery check-in. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 5.0.0, 05-APR-1998 (NJB) */ - -/* Added references to the PC-LINUX environment. Repaired some */ -/* format errors involving placement of comment markers in */ -/* column 1. */ - -/* - SPICELIB Version 4.0.1, 19-DEC-1995 (NJB) */ - -/* Added permuted index entry section. */ - -/* - SPICELIB Version 4.0.0, 31-AUG-1995 (NJB) */ - -/* Changed argument list of the entry point DASONW. The input */ -/* argument NCOMR, which indicates the number of comment records */ -/* to reserve, was added to the argument list. */ - -/* - SPICELIB Version 3.1.0, 5-JAN-1995 (HAN) */ - -/* Removed Sun Solaris environment since it is now the same */ -/* as the Sun OS 4.1.x environment. */ -/* Removed DEC Alpha/OpenVMS environment since it is now the same */ -/* as the VAX environment. */ -/* Entry points affected are: DASFM, DASOPR. */ - -/* - SPICELIB Version 3.0.0, 15-JUN-1994 (KRG) */ - -/* Modified the umbrella routine DASFM to allow the inclusion of */ -/* a file type in the creation and manipulation of DAS files. */ - -/* - SPICELIB Version 2.0.0, 11-APR-1994 (HAN) */ - -/* Updated module to include values for the Silicon Graphics/IRIX, */ -/* DEC Alpha-OSF/1, and Next/Absoft Fortran platforms. Entry */ -/* points affected are: DASFM, DASOPR. */ - -/* - SPICELIB Version 1.0.0, 15-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* manage open DAS files */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 7.0.0, 28-SEP-2005 (NJB) */ - -/* Error handling for non-native files was added to */ -/* entry points DASOPR and DASOPW. */ - -/* Bug in code for constructing long error message in entry */ -/* point DASUFS was corrected. */ - -/* Local variable DAS was renamed to DASFIL in DASSIH. */ - -/* - SPICELIB Version 6.0.0, 11-DEC-2001 (NJB) (FST) */ - -/* Binary File Format Identification: */ - -/* The file record now contains an 8 character string that */ -/* identifies the binary file format utilized by DAS files. */ -/* The purpose of this string's inclusion in the file record */ -/* is preparatory in nature, to accelerate the migration to */ -/* files that support the runtime translation update that */ -/* is scheduled. */ - -/* FTP Validation: */ - -/* The file record now contains a sequence of characters */ -/* commonly corrupted by improper FTP transfers. These */ -/* characters will be examined by the handle manager when */ -/* existing files are opened. */ - -/* FTIDW and FTIFN have been removed from the elements of */ -/* the DAS file table. Their presence and use in DASUFS */ -/* was causing DASWFR difficulties in updating the internal */ -/* filename under situations where changes to the comment and */ -/* reserved record parameters in the file record were updated. */ -/* This change effects DASOPR, DASOPN, DASONW, DASOPW, and */ -/* DASUFS. */ - -/* - SPICELIB Version 3.0.0, 15-JUN-1994 (KRG) */ - -/* Modified the umbrella routine DASFM to allow the inclusion of */ -/* a file type in the creation and manipulation of DAS files. In */ -/* particular, the following changes were made: */ - -/* 1) Added variable FTYPE to the SUBROUTINE declaration, and */ -/* added appropriate entries for this variable in the */ -/* $Brief_I/O and $ Detailed_Input sections of the header. */ - -/* 2) Removed erroneous references to OPC from the $ Brief_I/O */ -/* section. */ - -/* 3) Added a new entry point, DASONW, which will support the */ -/* ability to associate a data type with a new DAS file */ -/* when it is created. The addition of this new entry point */ -/* makes the entry point DASOPN obsolete. */ - -/* 4) Added a description of the new entry point DASONW to the */ -/* $ Particulars section. Also added a statement that the */ -/* entry point DASOPN has been made obsolete by this new */ -/* entry point, and its use in new code development is */ -/* discouraged. */ - -/* 5) Added a new variable to the file table, FTIDW, which */ -/* will be used to store the ID words from successfully */ -/* opened DAS files. We need to maintain this information */ -/* when writing the file record, as we do not want to */ -/* modify the ID word in the file. */ - -/* 6) Removed the parameter DASID as it is no longer needed. */ - -/* 7) Added new variables TARCH and TTYPE for temporary */ -/* storage of the file architecture and type. Also added a */ -/* new variable FNB for storing the position of the first */ -/* nonblank in a string. */ - -/* 8) Added new parameters: */ - -/* ARCLEN The maximum length of a file architecture */ -/* TYPLEN The maximum length of a file type */ -/* MAXPC Decimal value for the upper limit of printable */ -/* ASCII characters. */ -/* MINPC Decimal value for the lower limit of printable */ -/* ASCII characters. */ - -/* 9) Modified entry points which open DAS files: OPR, OPW, */ -/* OPS, OPN, ONW to support the new file ID word format. */ - -/* 10) Made all occurrences of error message formatting of */ -/* filenames consistent. All filenames will be single */ -/* quoted in output error messages. */ - -/* 11) Added a test for a blank filename before the inquire */ -/* to obtain information about a file in the entry points: */ -/* DASOPR, DASOPW, DASONW, and DASOPN. */ - -/* 12) Modified the description of FTSIZE in the $ Parameters */ -/* section to reflect the possibility of overflowing the */ -/* DAS file table when at least one DAS file had been */ -/* opened with write access. */ - -/* The problem occurs when the file table is full, the */ -/* number of open DAS files equals FTSIZE, and at least one */ -/* of the open files was opened with write access. If an */ -/* attempt to close a file opened with write access is made */ -/* under these conditions, by calling DASCLS, it will fail. */ -/* DASCLS (via DASSDR) calls DASOPS to open a scratch DAS */ -/* file, but the scratch file CANNOT be opened because the */ -/* file table is full. If this occurs, close a file open */ -/* for read access, or restrict the number of open files */ -/* in use to be at most FTSIZE - 1 when there will be at */ -/* least one file opened with write access. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Access method parameters: */ - - -/* File summary parameters: */ - -/* A DAS file summary has the following structure: */ - -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ -/* | | */ -/* +----------------------------------------+ */ - - -/* Base indices for: */ - -/* -- last logical addresses */ -/* -- records containing last descriptor for a given type */ -/* -- word containing last descriptor for a given type */ - -/* The offset into the file summary for any of these items */ -/* is obtained by adding the appropriate data type parameter */ -/* (DP, INT, or CHAR) to the base index for the item. */ - - -/* Descriptor record pointer locations (within descriptor records): */ - - -/* Directory address range location parameters: */ - - -/* First descriptor position in descriptor record: */ - - -/* Length of the Binary File Format string: */ - - -/* The parameter TAILEN determines the tail length of a DAS file */ -/* record. This is the number of bytes (characters) that */ -/* occupy the portion of the file record that follows the */ -/* integer holding the first free address. For environments */ -/* with a 32 bit word length, 1 byte characters, and DAS */ -/* record sizes of 1024 bytes, we have: */ - -/* 8 bytes - IDWORD */ -/* 60 bytes - IFNAME */ -/* 4 bytes - NRESVR (32 bit integer) */ -/* 4 bytes - NRESVC (32 bit integer) */ -/* 4 bytes - NCOMR (32 bit integer) */ -/* + 4 bytes - NCOMC (32 bit integer) */ -/* --------- */ -/* 84 bytes - (All file records utilize this space.) */ - -/* So the size of the remaining portion (or tail) of the DAS */ -/* file record for computing enviroments as described above */ -/* would be: */ - -/* 1024 bytes - DAS record size */ -/* - 8 bytes - DAS Binary File Format Word */ -/* - 84 bytes - (from above) */ -/* ------------ */ -/* 932 bytes - DAS file record tail length */ - -/* Note: environments that do not have a 32 bit word length, */ -/* 1 byte characters, and a DAS record size of 1024 bytes, will */ -/* require the adjustment of this parameter. */ - - -/* Local variables */ - - -/* The file table consists of a set of arrays which serve as */ -/* `columns' of the table. The sets of elements having the same */ -/* index in the arrays form the `rows' of the table. Each column */ -/* contains a particular type of information; each row contains */ -/* all of the information pertaining to a particular DAS file. */ - -/* All column names in the file table begin with `FT'. The */ -/* columns are: */ - -/* HAN Handle */ -/* LUN Logical unit */ -/* ACC Access method */ -/* LNK Number of links */ -/* SUM File summary */ - -/* The rows of the file table are indexed by a doubly linked */ -/* list pool. The pool contains an active list and a free list. */ -/* when a file is opened, a pointer to the file (the pointer */ -/* is called a `node'). it is placed at the head of the active */ -/* list; when a file is closed, the node in the active list that */ -/* pointed to the file is placed on the free list. */ - -/* NEXT is incremented each time a file is opened to become the */ -/* next file handle assigned. */ - - -/* FTHEAD is a pointer to the head of the active file list. */ - - -/* NEXT and PREV map the DAS data type codes to their */ -/* successors and predecessors, respectively. */ - - -/* Length of binary file format name. */ - - -/* Number of binary file formats. */ - - -/* Other local variables */ - - -/* Save everything between calls. */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (lastla) { - } - if (lastrc) { - } - if (lastwd) { - } - if (fhset) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_dasopr; - case 2: goto L_dasopw; - case 3: goto L_dasonw; - case 4: goto L_dasopn; - case 5: goto L_dasops; - case 6: goto L_dasllc; - case 7: goto L_dashfs; - case 8: goto L_dasufs; - case 9: goto L_dashlu; - case 10: goto L_dasluh; - case 11: goto L_dashfn; - case 12: goto L_dasfnh; - case 13: goto L_dashof; - case 14: goto L_dassih; - case 15: goto L_dasham; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASFM", (ftnlen)5); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("DASFM", (ftnlen)5); - } - return 0; -/* $Procedure DASOPR ( DAS, open for read ) */ - -L_dasopr: -/* $ Abstract */ - -/* Open a DAS file for reading. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a DAS file to be opened. */ -/* HANDLE O Handle assigned to the opened DAS file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a DAS file to be opened with read */ -/* access. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle that is associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAS routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input filename is blank, the error SPICE(BLANKFILENAME) */ -/* will be signaled. */ - -/* 2) If the specified file does not exist, the error */ -/* SPICE(FILENOTFOUND) will be signaled. */ - -/* 3) If the specified file has already been opened for read */ -/* access, the handle already associated with the file is */ -/* returned. */ - -/* 4) If the specified file has already been opened for write */ -/* access, the error SPICE(DASRWCONFLICT) is signaled. */ - -/* 5) If the specified file has already been opened by a non-DAS */ -/* routine, the error SPICE(DASIMPROPOPEN) is signaled. */ - -/* 6) If the specified file cannot be opened without exceeding */ -/* the maximum allowed number of open DAS files, the error */ -/* SPICE(DASFTFULL) is signaled. */ - -/* 7) If the named file cannot be opened properly, the error */ -/* SPICE(DASOPENFAIL) is signaled. */ - -/* 8) If the file record cannot be read, the error */ -/* SPICE(FILEREADFAILED) will be signaled. */ - -/* 9) If the specified file is not a DAS file, as indicated by the */ -/* file's ID word, the error SPICE(NOTADASFILE) is signaled. */ - -/* 10) If no logical units are available, the error will be */ -/* signaled by routines called by this routine. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Particulars */ - -/* Most DAS files require only read access. If you do not need to */ -/* change the contents of a file, you should open it using DASOPR. */ - -/* $ Examples */ - -/* 1) Open the existing DAS file TEST.DAS for reading. */ - -/* CALL DASOPR ( 'TEST.DAS', HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 7.0.0, 28-SEP-2005 (NJB) */ - -/* Error handling for non-native files was added. */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.0, 14-DEC-2001 (FST) */ - -/* The DAS file ID word and internal file name are no longer */ -/* buffered by this routine. See DASFM's Revisions section */ -/* for details. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 3.0.0, 15-JUN-1994 (KRG) */ - -/* Modified the entry point to use the new file ID format which */ -/* contains a mnemonic code for the data type. Added error */ -/* checks on file names. Fixed bug involving use of sign of */ -/* file handles. Improved some error messages. (delete rest) */ - -/* - SPICELIB Version 2.0.0, 11-APR-1994 (HAN) */ - -/* Updated module to include values for the Silicon Graphics/IRIX, */ -/* DEC Alpha-OSF/1, and Next/Absoft Fortran platforms. Entry */ -/* points affected are: DASFM, DASOPR. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a DAS file for reading */ -/* open a DAS file for read access */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 7.0.0, 28-SEP-2005 (NJB) */ - -/* Error handling for non-native files was added. */ - -/* - SPICELIB Version 3.0.1, 24-APR-2003 (EDW) */ - -/* Added MAC-OSX-F77 to the list of platforms */ -/* that require READONLY to read write protected */ -/* kernels. */ - -/* - SPICELIB Version 3.0.0, 15-JUN-1994 (KRG) */ - -/* Modified the entry point to use the new file ID format which */ -/* contains a mnemonic code for the data type. */ - -/* Split an IF ... ELSE IF ... statement into 2 IF statements of */ -/* equivalent behavior to allow testing of the file architecture. */ - -/* Added code to test the file architecture and to verify that the */ -/* file is a DAS file. */ - -/* Removed the error SPICE(DASNOIDWORD) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADASFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAS file. */ - -/* Added a test for a blank filename before attempting to use the */ -/* filename in the routine. If the filename is blank, the error */ -/* SPICE(BLANKFILENAME) will be signaled. */ - -/* Fixed a bug when dealing with a read/write open conflict for */ -/* DAS files: the code used the DAF positive/negative handle */ -/* method to determine read/write access rather than the DAS file */ -/* table column FTACC. Replaced the code: */ - -/* IF ( FTHAN(FINDEX) .LT. 0 ) THEN */ - -/* with */ - -/* IF ( FTACC(FINDEX) .EQ. WRITE ) THEN */ - -/* Changed the long error message when the error */ -/* SPICE(NOTADASFILE) is signaled to suggest that a common error */ -/* is attempting to use a text version of the desired file rather */ -/* than the binary version. */ - -/* - SPICELIB Version 2.0.0, 11-APR-1994 (HAN) */ - -/* Updated module to include values for the Silicon Graphics/IRIX, */ -/* DEC Alpha-OSF/1, and Next/Absoft Fortran platforms. Entry */ -/* points affected are: DASFM, DASOPR. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASOPR", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Check to see whether the filename is blank. If it is, signal an */ -/* error, check out, and return. */ - - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - setmsg_("The file name is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - -/* If the file doesn't exist, we can't continue. */ - - if (! exists_(fname, rtrim_(fname, fname_len))) { - setmsg_("The file '#' was not found.", (ftnlen)27); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - -/* The file may or may not already be open. If so, it should have */ -/* not been opened for writing FTACC .EQ. WRITE. If opened for */ -/* reading, just increment the number of links and return the handle. */ -/* If opened elsewhere, panic. */ - - ioin__1.inerr = 0; - ioin__1.infilen = rtrim_(fname, fname_len); - ioin__1.infile = fname; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = &number; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - f_inqu(&ioin__1); - if (opened) { - -/* Peruse the `unit' column of the file table; see whether this */ -/* unit is present. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftlun", i__1, "dasfm_", (ftnlen)1412)] == number) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - if (ftacc[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftacc", i__1, "dasfm_", (ftnlen)1422)] == 2) { - setmsg_("'#' already opened for write access.", (ftnlen)36); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASRWCONFLICT)", (ftnlen)20); - chkout_("DASOPR", (ftnlen)6); - return 0; - } else { - -/* The file is open for read access. Increment the number */ -/* of links to this file. */ - - ftlnk[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftlnk", i__1, "dasfm_", (ftnlen)1435)] = ftlnk[(i__2 - = findex - 1) < 21 && 0 <= i__2 ? i__2 : s_rnge("ftl" - "nk", i__2, "dasfm_", (ftnlen)1435)] + 1; - *handle = fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "dasfm_", (ftnlen)1436)]; - } - } else { - -/* The file is open, but it wasn't opened by DAS routines. */ - - setmsg_("'#' is already connected to unit #.", (ftnlen)35); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(DASIMPROPOPEN)", (ftnlen)20); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - -/* If it hasn't been opened, it needs to be, but only if there */ -/* is room for another file. */ - - } else if (lnknfn_(pool) == 0) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__21, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASFTFULL)", (ftnlen)16); - chkout_("DASOPR", (ftnlen)6); - return 0; - -/* To open for reading: get a free unit, open the file, get the */ -/* internal file name, and increment the number of links. */ - -/* Look out for: */ - -/* -- No free logical units. */ - -/* -- Error opening the file. */ - -/* -- No ID word in the first record. */ - - } else { - getlun_(&number); - if (failed_()) { - chkout_("DASOPR", (ftnlen)6); - return 0; - } - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = rtrim_(fname, fname_len); - o__1.ofnm = fname; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to open file '#' failed. Value of IOSTAT was #.", - (ftnlen)55); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASOPENFAIL)", (ftnlen)18); - chkout_("DASOPR", (ftnlen)6); - return 0; - } else { - -/* Try to determine the binary file format of this file. */ - - zzddhppf_(&number, &c__2, &bff); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - -/* Find the local binary file format. */ - - zzplatfm_("FILE_FORMAT", locfmt, (ftnlen)11, (ftnlen)8); - -/* Compare binary format to local format. These must match. */ - - if (bff != isrchc_(locfmt, &c__4, bfflst, (ftnlen)8, (ftnlen)8)) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - s_copy(lngmsg, "File '#' has the non-native binary format #." - " The SPICE Toolkit does not support reading non-nati" - "ve files, such as E-kernels, that are based on SPICE" - "'s DAS architecture. To port a DAS file between plat" - "forms having incompatible binary formats, for exampl" - "e big-endian (Sun) vs little-endian (PC), use the SP" - "ICE utility toxfr to create a transfer format versio" - "n of the file, then move (ftp) the transfer file in " - "ASCII mode. You will need to perform line terminator" - " conversion when moving files between Windows and Un" - "ix systems if the ASCII mode of ftp is unavailable; " - "the freeware utilities dos2unix and unix2dos are mea" - "ns for doing this. Then transform the file to binary" - " format on the target system using the SPICE utility" - " tobin. See the SPICE document convert.ug for detail" - "s on using the SPICE utility programs.", (ftnlen)1840, - (ftnlen)810); - setmsg_(lngmsg, (ftnlen)1840); - errch_("#", fname, (ftnlen)1, fname_len); - errch_("#", bfflst + (((i__1 = bff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("bfflst", i__1, "dasfm_", (ftnlen)1556)) - << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(NONNATIVEFILE)", (ftnlen)20); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - io___22.ciunit = number; - iostat = s_rdue(&io___22); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locrrc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locrch, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&loccrc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&loccch, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Could not read file record. File was '#'. IOSTAT " - "was #.", (ftnlen)57); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - -/* Check the ID word to see if we have opened a DAS file. First */ -/* separate the ID word into its components and verify that we */ -/* are looking at a DAS file. If we're not, then this routine */ -/* should not be used. */ - - idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)3, (ftnlen)4); - if (s_cmp(tarch, "DAS", (ftnlen)3, (ftnlen)3) != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("File '#' is not a DAS file. A common error is attem" - "pting to open a text version of the file rather than" - " the binary version of the file.", (ftnlen)135); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(NOTADASFILE)", (ftnlen)18); - chkout_("DASOPR", (ftnlen)6); - return 0; - } - -/* At this point, we know that we have a valid DAS file, and */ -/* we're set up to read from it, so ... */ - -/* Update the file table to include information about */ -/* our newly opened DAS file. Link the information */ -/* for this file at the head of the file table list. */ - -/* Set the output argument HANDLE as well. */ - - lnkan_(pool, &new__); - lnkilb_(&new__, &fthead, pool); - fthead = new__; - ++nxthan; - fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)1622)] = nxthan; - ftlun[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "un", i__1, "dasfm_", (ftnlen)1623)] = number; - ftacc[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fta" - "cc", i__1, "dasfm_", (ftnlen)1624)] = 1; - ftlnk[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "nk", i__1, "dasfm_", (ftnlen)1625)] = 1; - -/* Fill in the file summary. We already know how many */ -/* reserved records and comment records there are. To find */ -/* the number of the first free record, the last logical */ -/* address of each type, and the locations of the last */ -/* descriptors of each type, we must examine the directory */ -/* records. Note that we do not assume that the data records */ -/* in the DAS file have been segregated: we could be */ -/* restoring a DAS file whose creation was interrupted. */ - - cleari_(&c__14, &ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen) - 1637)]); - ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)1639)] = locrrc; - ftsum[(i__1 = fthead * 14 - 13) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)1640)] = locrch; - ftsum[(i__1 = fthead * 14 - 12) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)1641)] = loccrc; - ftsum[(i__1 = fthead * 14 - 11) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)1642)] = loccch; - -/* We'll find the values for each data type separately. */ - - for (type__ = 1; type__ <= 3; ++type__) { - -/* The first directory record is located right after the */ -/* last comment record. */ - - nrec = locrrc + loccrc + 2; - -/* Keep track of the record number of the last data */ -/* record of the current type. */ - - ldrec[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "ldrec", i__1, "dasfm_", (ftnlen)1658)] = 0; - -/* Find the last directory containing a descriptor of a */ -/* record cluster of the current type. */ - - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - maxadr = dirrec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 - ? i__1 : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 1666)]; - nxtdir = dirrec[1]; - while(nxtdir > 0) { - -/* Read the directory record. If this record contains */ -/* descriptors for clusters we're interested in, update */ -/* the directory record number. */ - - dasioi_("READ", &number, &nxtdir, dirrec, (ftnlen)4); - if (dirrec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 1678)] > 0) { - maxadr = dirrec[(i__1 = (type__ << 1) + 1) < 256 && 0 - <= i__1 ? i__1 : s_rnge("dirrec", i__1, "das" - "fm_", (ftnlen)1679)]; - nrec = nxtdir; - } - nxtdir = dirrec[1]; - } - -/* At this point, NREC is the record number of the directory */ -/* containing the last descriptor for clusters of TYPE, if */ -/* there are any such descriptors. */ - -/* MAXADR is the maximum logical address of TYPE. */ - - ftsum[(i__1 = type__ + 5 + fthead * 14 - 15) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen) - 1694)] = maxadr; - if (maxadr > 0) { - ftsum[(i__1 = type__ + 8 + fthead * 14 - 15) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)1697)] = nrec; - } else { - ftsum[(i__1 = type__ + 8 + fthead * 14 - 15) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)1699)] = 0; - } - -/* We still need to set the word location of the final */ -/* descriptor of TYPE, if there are any descriptors of TYPE. */ - - if (maxadr > 0) { - -/* Re-read the directory record containing the last */ -/* descriptor of the current type. */ - - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - -/* Traverse the directory record, looking for the last */ -/* descriptor of TYPE. We'll keep track of the maximum */ -/* logical address of TYPE for each cluster of TYPE */ -/* whose descriptor we examine. When this value is */ -/* the maximum logical address of TYPE, we've found */ -/* the last descriptor of TYPE. */ - -/* Also keep track of the end record numbers for each */ -/* cluster. */ - - last = dirrec[(i__1 = type__ << 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 1722)] - 1; - dsctyp = dirrec[8]; - prvtyp = prev[(i__1 = dsctyp - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("prev", i__1, "dasfm_", (ftnlen)1724)]; - endrec = nrec; - pos = 9; - while(last < maxadr) { - ++pos; - if (dirrec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 - : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 1732)] > 0) { - curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("next", i__1, "dasf" - "m_", (ftnlen)1733)]; - } else { - curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("prev", i__1, "dasf" - "m_", (ftnlen)1735)]; - } - if (curtyp == type__) { - last += nw[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("nw", i__1, "dasfm_", ( - ftnlen)1739)] * (i__3 = dirrec[(i__2 = - pos - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("dirrec", i__2, "dasfm_", (ftnlen) - 1739)], abs(i__3)); - } - endrec += (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 - <= i__1 ? i__1 : s_rnge("dirrec", i__1, "das" - "fm_", (ftnlen)1742)], abs(i__2)); - prvtyp = curtyp; - } - -/* At this point, POS is the word position of the last */ -/* descriptor of TYPE, and ENDREC is the record number */ -/* of the last data record of TYPE. */ - - ftsum[(i__1 = type__ + 11 + fthead * 14 - 15) < 294 && 0 - <= i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)1751)] = pos; - ldrec[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("ldrec", i__1, "dasfm_", (ftnlen)1752)] = - endrec; - } else { - -/* There's no data of TYPE in the file. */ - - ftsum[(i__1 = type__ + 11 + fthead * 14 - 15) < 294 && 0 - <= i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)1759)] = 0; - ldrec[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("ldrec", i__1, "dasfm_", (ftnlen)1760)] = - 0; - } - } - -/* We're almost done; we need to find the number of the first */ -/* free record. This record follows all of the data records */ -/* and all of the directory records. It may happen that the */ -/* last record in use is an empty directory. */ - - maxai_(ldrec, &c__3, &ldrmax, &loc); - nrec = locrrc + loccrc + 2; - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - nxtrec = dirrec[1]; - while(nxtrec != 0) { - nrec = nxtrec; - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - nxtrec = dirrec[1]; - } - -/* Now NREC is the last directory record. */ - - ftsum[(i__1 = fthead * 14 - 10) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)1795)] = max( - ldrmax,nrec) + 1; - -/* Insert the new handle into our handle set. */ - - *handle = fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "dasfm_", (ftnlen)1800)]; - insrti_(handle, fhlist); - } - } - chkout_("DASOPR", (ftnlen)6); - return 0; -/* $Procedure DASOPW ( DAS, open for write ) */ - -L_dasopw: -/* $ Abstract */ - -/* Open a DAS file for writing. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a DAS file to be opened. */ -/* HANDLE O Handle assigned to the opened DAS file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a DAS file to be opened with write */ -/* access. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle that is associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAS routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input filename is blank, the error SPICE(BLANKFILENAME) */ -/* will be signaled. */ - -/* 2) If the specified file does not exist, the error */ -/* SPICE(FILENOTFOUND) will be signaled. */ - -/* 3) If the specified file has already been opened, either by */ -/* the DAS file routines or by other code, the error */ -/* SPICE(DASOPENCONFLICT) is signaled. Note that this */ -/* response is not paralleled by DASOPR, which allows you */ -/* to open a DAS file for reading even if it is already open for */ -/* reading. */ - -/* 4) If the specified file cannot be opened without exceeding */ -/* the maximum allowed number of open DAS files, the error */ -/* SPICE(DASFTFULL) is signaled. */ - -/* 5) If the specified file cannot be opened properly, the error */ -/* SPICE(DASOPENFAIL) is signaled. */ - -/* 6) If the file record cannot be read, the error */ -/* SPICE(FILEREADFAILED) will be signaled. */ - -/* 7) If the specified file is not a DAS file, as indicated by the */ -/* file's ID word, the error SPICE(NOTADASFILE) is signaled. */ - -/* 8) If no logical units are available, the error will be */ -/* signaled by routines called by this routine. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Particulars */ - -/* Most DAS files require only read access. If you do not need to */ -/* change the contents of a file, you should open it with DASOPR. */ - -/* $ Examples */ - -/* 1) Open the existing DAS file TEST.DAS in order to add data */ -/* to it. */ - -/* CALL DASOPW ( 'TEST.DAS', HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 7.0.0, 28-SEP-2005 (NJB) */ - -/* Error handling for non-native files was added. */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.0, 14-DEC-2001 (FST) */ - -/* The DAS file ID word and internal file name are no longer */ -/* buffered by this routine. See DASFM's Revisions section */ -/* for details. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 29-OCT-1993 (KRG) */ - -/* Modified the entry point to use the new file ID format which */ -/* contains a mnemonic code for the data type. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a DAS file for writing */ -/* open a DAS file for write access */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 7.0.0, 28-SEP-2005 (NJB) */ - -/* Error handling for non-native files was added. */ - -/* - SPICELIB Version 2.0.0, 29-OCT-1993 (KRG) */ - -/* Modified the entry point to use the new file ID format which */ -/* contains a mnemonic code for the data type. */ - -/* Split an IF ... ELSE IF ... statement into 2 IF statements of */ -/* equivalent behavior to allow testing of the file architecture. */ - -/* Added code to test the file architecture and to verify that the */ -/* file is a DAS file. */ - -/* Removed the error SPICE(DASNOIDWORD) as it was no longer */ -/* relevant. */ - -/* Added the error SPICE(NOTADASFILE) if this routine is called */ -/* with a file that does not contain an ID word identifying the */ -/* file as a DAF file. */ - -/* Added a test for a blank filename before attempting to use the */ -/* filename in the routine. If the filename is blank, the error */ -/* SPICE(BLANKFILENAME) will be signaled. */ - -/* Changed the long error message when the error */ -/* SPICE(NOTADASFILE) is signaled to suggest that a common error */ -/* is attempting to load a text version of the desired file rather */ -/* than the binary version. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASOPW", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Check to see whether the filename is blank. If it is, signal an */ -/* error, check out, and return. */ - - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - setmsg_("The file name is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("DASOPW", (ftnlen)6); - return 0; - } - -/* If the file doesn't exist, we can't continue. */ - - if (! exists_(fname, rtrim_(fname, fname_len))) { - setmsg_("The file '#' was not found.", (ftnlen)27); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19); - chkout_("DASOPW", (ftnlen)6); - return 0; - } - -/* A file may not be opened for writing if it is already open. */ - - ioin__1.inerr = 0; - ioin__1.infilen = rtrim_(fname, fname_len); - ioin__1.infile = fname; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = &number; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - f_inqu(&ioin__1); - if (opened) { - setmsg_("File '#' already opened.", (ftnlen)24); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASOPENCONFLICT)", (ftnlen)22); - chkout_("DASOPW", (ftnlen)6); - return 0; - -/* If it hasn't been opened, it needs to be, but only if there */ -/* is room for another file. */ - - } else if (lnknfn_(pool) == 0) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__21, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASFTFULL)", (ftnlen)16); - chkout_("DASOPW", (ftnlen)6); - return 0; - -/* To open for writing: get a free unit, open the file, get the */ -/* internal file name, and set the number of links to one. */ - -/* Look out for: */ - -/* -- No free logical units. */ - -/* -- Error opening the file. */ - - } else { - getlun_(&number); - if (failed_()) { - chkout_("DASOPW", (ftnlen)6); - return 0; - } - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = rtrim_(fname, fname_len); - o__1.ofnm = fname; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to open file '#' failed. Value of IOSTAT was #.", - (ftnlen)55); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASOPENFAIL)", (ftnlen)18); - chkout_("DASOPW", (ftnlen)6); - return 0; - } else { - -/* Try to determine the binary file format of this file. */ - - zzddhppf_(&number, &c__2, &bff); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DASOPW", (ftnlen)6); - return 0; - } - -/* Find the local binary file format. */ - - zzplatfm_("FILE_FORMAT", locfmt, (ftnlen)11, (ftnlen)8); - -/* Compare binary format to local format. These must match. */ - - if (bff != isrchc_(locfmt, &c__4, bfflst, (ftnlen)8, (ftnlen)8)) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - s_copy(lngmsg, "File '#' has the non-native binary format #." - " The SPICE Toolkit does not support writing to non-n" - "ative files, such as E-kernels, that are based on SP" - "ICE's DAS architecture. To port a DAS file between p" - "latforms having incompatible binary formats, for exa" - "mple big-endian (Sun) vs little-endian (PC), use the" - " SPICE utility toxfr to create a transfer format ver" - "sion of the file, then move (ftp) the transfer file " - "in ASCII mode. You will need to perform line termina" - "tor conversion when moving files between Windows and" - " Unix systems if the ASCII mode of ftp is unavailabl" - "e; the freeware utilities dos2unix and unix2dos are " - "means for doing this. Then transform the file to bin" - "ary format on the target system using the SPICE util" - "ity tobin. See the SPICE document convert.ug for det" - "ails on using the SPICE utility programs.", (ftnlen) - 1840, (ftnlen)813); - setmsg_(lngmsg, (ftnlen)1840); - errch_("#", fname, (ftnlen)1, fname_len); - errch_("#", bfflst + (((i__1 = bff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("bfflst", i__1, "dasfm_", (ftnlen)2199)) - << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(NONNATIVEFILE)", (ftnlen)20); - chkout_("DASOPW", (ftnlen)6); - return 0; - } - -/* Read the file record. */ - - io___48.ciunit = number; - iostat = s_rdue(&io___48); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&locrrc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&locrch, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&loccrc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&loccch, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Could not read file record. File was '#'. IOSTAT " - "was #.", (ftnlen)57); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASOPW", (ftnlen)6); - return 0; - } - -/* Check the ID word to see if we have opened a DAS file. First */ -/* separate the ID word into its components and verify that we */ -/* are looking at a DAS file. If we're not, then this routine */ -/* should not be used. */ - - idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)3, (ftnlen)4); - if (s_cmp(tarch, "DAS", (ftnlen)3, (ftnlen)3) != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("File '#' is not a DAS file. A common error is attem" - "pting to open a text version of the file rather than" - " the binary version of the file.", (ftnlen)135); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(NOTADASFILE)", (ftnlen)18); - chkout_("DASOPW", (ftnlen)6); - return 0; - } - -/* At this point, we know that we have a valid DAS file, and */ -/* we're set up to read from it, so ... */ - -/* Update the file table to include information about */ -/* our newly opened DAS file. Link the information */ -/* for this file at the head of the file table list. */ - -/* Set the output argument HANDLE as well. */ - - lnkan_(pool, &new__); - lnkilb_(&new__, &fthead, pool); - fthead = new__; - ++nxthan; - fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)2270)] = nxthan; - ftlun[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "un", i__1, "dasfm_", (ftnlen)2271)] = number; - ftacc[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fta" - "cc", i__1, "dasfm_", (ftnlen)2272)] = 2; - ftlnk[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "nk", i__1, "dasfm_", (ftnlen)2273)] = 1; - -/* Fill in the file summary. We already know how many */ -/* reserved records and comment records there are. To find */ -/* the number of the first free record, the last logical */ -/* address of each type, and the locations of the last */ -/* descriptors of each type, we must examine the directory */ -/* records. Note that we do not assume that the data records */ -/* in the DAS file have been segregated: we could be */ -/* restoring a DAS file whose creation was interrupted. */ - - cleari_(&c__14, &ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen) - 2285)]); - ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2287)] = locrrc; - ftsum[(i__1 = fthead * 14 - 13) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2288)] = locrch; - ftsum[(i__1 = fthead * 14 - 12) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2289)] = loccrc; - ftsum[(i__1 = fthead * 14 - 11) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2290)] = loccch; - -/* We'll find the values for each data type separately. */ - - for (type__ = 1; type__ <= 3; ++type__) { - -/* The first directory record is located right after the */ -/* last comment record. The directory may be empty. */ - - nrec = locrrc + loccrc + 2; - -/* Keep track of the record number of the last data */ -/* record of the current type. */ - - ldrec[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "ldrec", i__1, "dasfm_", (ftnlen)2306)] = 0; - -/* Find the last directory containing a descriptor of a */ -/* record cluster of the current type. */ - - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - maxadr = dirrec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 - ? i__1 : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 2314)]; - nxtdir = dirrec[1]; - while(nxtdir > 0) { - -/* Read the directory record. If this record contains */ -/* descriptors for clusters we're interested in, update */ -/* the directory record number. */ - - dasioi_("READ", &number, &nxtdir, dirrec, (ftnlen)4); - if (dirrec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 2326)] > 0) { - maxadr = dirrec[(i__1 = (type__ << 1) + 1) < 256 && 0 - <= i__1 ? i__1 : s_rnge("dirrec", i__1, "das" - "fm_", (ftnlen)2327)]; - nrec = nxtdir; - } - nxtdir = dirrec[1]; - } - -/* At this point, NREC is the record number of the directory */ -/* containing the last descriptor for clusters of TYPE, if */ -/* there are any such descriptors. */ - -/* MAXADR is the maximum logical address of TYPE. */ - - ftsum[(i__1 = type__ + 5 + fthead * 14 - 15) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen) - 2342)] = maxadr; - if (maxadr > 0) { - ftsum[(i__1 = type__ + 8 + fthead * 14 - 15) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)2345)] = nrec; - } else { - ftsum[(i__1 = type__ + 8 + fthead * 14 - 15) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)2347)] = 0; - } - -/* We still need to set the word location of the final */ -/* descriptor of TYPE, if there are any descriptors of TYPE. */ - - if (maxadr > 0) { - -/* Re-read the directory record containing the last */ -/* descriptor of the current type. */ - - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - -/* Traverse the directory record, looking for the last */ -/* descriptor of TYPE. We'll keep track of the maximum */ -/* logical address of TYPE for each cluster of TYPE */ -/* whose descriptor we examine. When this value is */ -/* the maximum logical address of TYPE, we've found */ -/* the last descriptor of TYPE. */ - -/* Also keep track of the end record numbers for each */ -/* cluster. */ - - last = dirrec[(i__1 = type__ << 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 2371)] - 1; - dsctyp = dirrec[8]; - prvtyp = prev[(i__1 = dsctyp - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("prev", i__1, "dasfm_", (ftnlen)2373)]; - endrec = nrec; - pos = 9; - while(last < maxadr) { - ++pos; - if (dirrec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 - : s_rnge("dirrec", i__1, "dasfm_", (ftnlen) - 2381)] > 0) { - curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("next", i__1, "dasf" - "m_", (ftnlen)2382)]; - } else { - curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("prev", i__1, "dasf" - "m_", (ftnlen)2384)]; - } - if (curtyp == type__) { - last += nw[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("nw", i__1, "dasfm_", ( - ftnlen)2388)] * (i__3 = dirrec[(i__2 = - pos - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("dirrec", i__2, "dasfm_", (ftnlen) - 2388)], abs(i__3)); - } - endrec += (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 - <= i__1 ? i__1 : s_rnge("dirrec", i__1, "das" - "fm_", (ftnlen)2391)], abs(i__2)); - prvtyp = curtyp; - } - -/* At this point, POS is the word position of the last */ -/* descriptor of TYPE, and ENDREC is the record number */ -/* of the last data record of TYPE. */ - - ftsum[(i__1 = type__ + 11 + fthead * 14 - 15) < 294 && 0 - <= i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)2400)] = pos; - ldrec[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("ldrec", i__1, "dasfm_", (ftnlen)2401)] = - endrec; - } else { - -/* There's no data of TYPE in the file. */ - - ftsum[(i__1 = type__ + 11 + fthead * 14 - 15) < 294 && 0 - <= i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)2407)] = 0; - ldrec[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("ldrec", i__1, "dasfm_", (ftnlen)2408)] = - 0; - } - } - -/* We're almost done; we need to find the number of the first */ -/* free record. This record follows all of the data records */ -/* and all of the directory records. It may happen that the */ -/* last record in use is an empty directory. */ - - maxai_(ldrec, &c__3, &ldrmax, &loc); - nrec = locrrc + loccrc + 2; - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - nxtrec = dirrec[1]; - while(nxtrec != 0) { - nrec = nxtrec; - dasioi_("READ", &number, &nrec, dirrec, (ftnlen)4); - nxtrec = dirrec[1]; - } - -/* Now NREC is the last directory record. */ - - ftsum[(i__1 = fthead * 14 - 10) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2443)] = max( - ldrmax,nrec) + 1; - -/* Insert the new handle into our handle set. */ - - *handle = fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "dasfm_", (ftnlen)2448)]; - insrti_(handle, fhlist); - } - } - chkout_("DASOPW", (ftnlen)6); - return 0; -/* $Procedure DASONW ( DAS, open new file ) */ - -L_dasonw: -/* $ Abstract */ - -/* Open a new DAS file and set the file type. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* CHARACTER*(*) FTYPE */ -/* CHARACTER*(*) IFNAME */ -/* INTEGER NCOMR */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a DAS file to be opened. */ -/* FTYPE I Mnemonic code for type of data in the DAF file. */ -/* IFNAME I Internal file name. */ -/* NCOMR I Number of comment records to allocate. */ -/* HANDLE O Handle assigned to the opened DAS file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a new DAS file to be created (and */ -/* consequently opened for write access). */ - -/* FTYPE is a code for type of data placed into a DAS file. */ -/* The first nonblank character and the three (3), or */ -/* fewer, characters immediately following it, giving */ -/* four (4) characters, are used to represent the type of */ -/* the data placed in the DAF file. This is provided as a */ -/* convenience for higher level software. It is an error */ -/* if this string is blank. Also, the file type may not */ -/* contain any nonprinting characters. When written to */ -/* the DAS file, the value for the type IS case */ -/* sensitive. */ - -/* NAIF has reserved for its own use file types */ -/* consisting of the upper case letters (A-Z) and the */ -/* digits 0-9. NAIF recommends lower case or mixed case */ -/* file types be used by all others in order to avoid any */ -/* conflicts with NAIF file types. */ - -/* IFNAME is the internal file name for the new file. The name */ -/* may contain as many as 60 characters. This should */ -/* uniquely identify the file. */ - - -/* NCOMR is the number of comment records to allocate. */ -/* Allocating comment records at file creation time may */ -/* reduce the likelihood of having to expand the */ -/* comment area later. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAS routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input filename is blank, the error SPICE(BLANKFILENAME) */ -/* is signaled. */ - -/* 2) If the specified file cannot be opened without exceeding */ -/* the maximum allowed number of open DAS files, the error */ -/* SPICE(DASFTFULL) is signaled. No file will be created. */ - -/* 3) If the file cannot be opened properly, the error */ -/* SPICE(DASOPENFAIL) is signaled. No file will be created. */ - -/* 4) If the initial records in the file cannot be written, the */ -/* error is diagnosed by routines called by this routine. No */ -/* file will be created. */ - -/* 5) If no logical units are available, the error will be */ -/* signaled by routines called by this routine. No file will be */ -/* created. */ - -/* 6) If the file type is blank, the error SPICE(BLANKFILETYPE) will */ -/* be signaled. */ - -/* 7) If the file type contains nonprinitng characters, decimal */ -/* 0-31 and 127-255, the error SPICE(ILLEGALCHARACTER) is */ -/* signaled. */ - -/* 8) If the number of comment records allocated NCOMR is negative, */ -/* the error SPICE(INVALIDCOUNT) is signaled. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Particulars */ - -/* The DAS files created by this routine have initialized file */ -/* records. */ - -/* This entry point creates a new DAS file and sets the type of the */ -/* file to the mnemonic code passed to it. */ - -/* $ Examples */ - -/* 1) Create a new DAS file, using an internal file name that */ -/* attempts to serve as an unique identifier, and give the file a */ -/* type of 'TEST'. */ - -/* FNAME = 'TEST.DAS' */ -/* FTYPE = 'TEST' */ -/* IFNAME = 'TEST.DAS/NAIF/NJB/11-NOV-1992-20:12:20' */ - -/* CALL DASONW ( FNAME, FTYPE, IFNAME, HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.0, 11-DEC-2001 (FST) */ - -/* The DAS file ID word and internal file name are no longer */ -/* buffered by this routine. See DASFM's Revisions section */ -/* for details. */ - -/* The entry point was modified to insert the FTP validation */ -/* string, as well as the binary file format into the file record. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 31-AUG-1995 (NJB) */ - -/* Changed argument list of the entry point DASONW. The input */ -/* argument NCOMR, which indicates the number of comment records */ -/* to reserve, was added to the argument list. */ - -/* - SPICELIB Version 1.0.0, 29-OCT-1993 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a new DAS file */ -/* open a new DAS file with write access */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.0.0, 11-DEC-2001 (NJB) (FST) */ - -/* See the Revisions section under DASFM for a discussion of */ -/* the various changes made for this version. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASONW", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Check to see whether the filename is blank. If it is, signal an */ -/* error, check out, and return. */ - - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - setmsg_("The file name is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("DASONW", (ftnlen)6); - return 0; - } - -/* Check if the file type is blank. */ - - if (s_cmp(ftype, " ", ftype_len, (ftnlen)1) == 0) { - setmsg_("The file type is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILETYPE)", (ftnlen)20); - chkout_("DASONW", (ftnlen)6); - return 0; - } - -/* Check for nonprinting characters in the file type. */ - - fnb = ltrim_(ftype, ftype_len); - i__1 = rtrim_(ftype, ftype_len); - for (i__ = fnb; i__ <= i__1; ++i__) { - if (*(unsigned char *)&ftype[i__ - 1] > 126 || *(unsigned char *)& - ftype[i__ - 1] < 32) { - setmsg_("The file type contains nonprinting characters. ", ( - ftnlen)47); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DASONW", (ftnlen)6); - return 0; - } - } - -/* Validate the comment record count. */ - - if (*ncomr < 0) { - setmsg_("The number of comment records allocated must be non-negativ" - "e but was #.", (ftnlen)71); - errint_("#", ncomr, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("DASONW", (ftnlen)6); - return 0; - } - -/* Set the value the file type in a temporary variable to be sure of */ -/* its length and then set the value of the ID word. Only 4 */ -/* characters are allowed for the file type, and they are the first */ -/* nonblank character and its three (3) immediate successors in the */ -/* input string FTYPE. */ - - s_copy(ttype, ftype + (fnb - 1), (ftnlen)4, ftype_len - (fnb - 1)); -/* Writing concatenation */ - i__4[0] = 4, a__1[0] = "DAS/"; - i__4[1] = 4, a__1[1] = ttype; - s_cat(idword, a__1, i__4, &c__2, (ftnlen)8); - -/* The file can be opened only if there is room for another file. */ - - if (lnknfn_(pool) == 0) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__21, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASFTFULL)", (ftnlen)16); - chkout_("DASONW", (ftnlen)6); - return 0; - } else { - -/* To open a new file: get a free unit, open the file, write */ -/* the file record, and set the number of links to one. */ - -/* Look out for: */ - -/* -- No free logical units. */ - -/* -- Error opening the file. */ - -/* -- Error writing to the file. */ - -/* If anything goes wrong after the file has been opened, delete */ -/* the file. */ - - - getlun_(&number); - if (failed_()) { - chkout_("DASONW", (ftnlen)6); - return 0; - } - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = rtrim_(fname, fname_len); - o__1.ofnm = fname; - o__1.orl = 1024; - o__1.osta = "NEW"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to open file '#' failed. Value of IOSTAT was #.", - (ftnlen)55); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASOPENFAIL)", (ftnlen)18); - chkout_("DASONW", (ftnlen)6); - return 0; - } else { - -/* Fetch the system file format. */ - - zzplatfm_("FILE_FORMAT", format, (ftnlen)11, (ftnlen)8); - -/* Prepare to write the file record. Clear out the file */ -/* summary, except for the number of reserved records and */ -/* the free record pointer. The free record pointer should */ -/* point to the first record AFTER the first directory. */ - -/* Use a local variable for the internal file name to ensure */ -/* that IFNLEN characters are written. The remaining */ -/* elements of the file record are: */ - -/* -- the number of reserved records */ - -/* -- the number of characters in use in the reserved */ -/* record area */ - -/* -- the number of comment records */ - -/* -- the number of characters in use in the comment */ -/* area */ - -/* Initially, all of these counts are zero, except for the */ -/* comment record count, which is set by the caller. */ - - - s_copy(locifn, ifname, (ftnlen)60, ifname_len); - zzdasnfr_(&number, idword, locifn, &c__0, &c__0, ncomr, &c__0, - format, (ftnlen)8, (ftnlen)60, (ftnlen)8); - -/* Check to see whether or not ZZDASNFR generated an error */ -/* writing the file record to the logical unit. In the event */ -/* an error occurs, checkout and return. */ - - if (failed_()) { - chkout_("DASONW", (ftnlen)6); - return 0; - } - -/* Zero out the first directory record in the file. If this */ -/* write fails, close the file with delete status and return */ -/* immediately. The first directory record follows the */ -/* comment records and reserved records. Currently there */ -/* are no reserved records, so the directory occupies record */ -/* NCOMR+2. */ - - cleari_(&c__256, dirrec); - i__1 = *ncomr + 2; - dasioi_("WRITE", &number, &i__1, dirrec, (ftnlen)5); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("DASONW", (ftnlen)6); - return 0; - } - -/* Update the file table to include information about */ -/* our newly opened DAS file. Link the information */ -/* for this file at the head of the file table list. */ - -/* Set the output argument HANDLE as well. */ - - lnkan_(pool, &new__); - lnkilb_(&new__, &fthead, pool); - ++nxthan; - fthead = new__; - cleari_(&c__14, &ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen) - 2926)]); - fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)2928)] = nxthan; - ftlun[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "un", i__1, "dasfm_", (ftnlen)2929)] = number; - ftacc[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fta" - "cc", i__1, "dasfm_", (ftnlen)2930)] = 2; - ftlnk[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "nk", i__1, "dasfm_", (ftnlen)2931)] = 1; - ftsum[(i__1 = fthead * 14 - 10) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2932)] = *ncomr + - 3; - ftsum[(i__1 = fthead * 14 - 12) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)2933)] = *ncomr; - *handle = fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "dasfm_", (ftnlen)2935)]; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - } - } - chkout_("DASONW", (ftnlen)6); - return 0; -/* $Procedure DASOPN ( DAS, open new ) */ - -L_dasopn: -/* $ Abstract */ - -/* Open a new DAS file for writing. */ -/* Obsolete: This routine has been superceded by DASONW, and it is */ -/* supported for purposes of backward compatibility only. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* CHARACTER*(*) IFNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a DAS file to be opened. */ -/* IFNAME I Internal file name. */ -/* HANDLE O Handle assigned to the opened DAS file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a new DAS file to be created (and */ -/* consequently opened for write access). */ - -/* IFNAME is the internal file name for the new file. The name */ -/* may contain as many as 60 characters. This should */ -/* uniquely identify the file. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other DAS routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input filename is blank, the error SPICE(BLANKFILENAME) */ -/* will be signaled. */ - -/* 2) If the specified file cannot be opened without exceeding */ -/* the maximum allowed number of open DAS files, the error */ -/* SPICE(DASFTFULL) is signaled. No file will be created. */ - -/* 3) If the file cannot be opened properly, the error */ -/* SPICE(DASOPENFAIL) is signaled. No file will be created. */ - -/* 4) If the initial records in the file cannot be written, the */ -/* error is diagnosed by routines called by this routine. No */ -/* file will be created. */ - -/* 5) If no logical units are available, the error will be */ -/* signaled by routines called by this routine. No file will be */ -/* created. */ - -/* $ Files */ - -/* See argument FNAME. */ - -/* $ Particulars */ - -/* The DAS files created by this routine have initialized file */ -/* records. */ - -/* This entry point has been made obsolete by the entry point DASONW, */ -/* and it is supported for reasons of backward compatibility only. */ -/* New software development should use the entry point DASONW. */ - -/* $ Examples */ - -/* 1) Create a new DAS file, using an internal file name that */ -/* attempts to serve as an unique identifier. */ - -/* FNAME = 'TEST.DAS' */ -/* IFNAME = 'TEST.DAS/NAIF/NJB/11-NOV-1992-20:12:20' */ - -/* CALL DASOPN ( FNAME, IFNAME, HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.0, 11-DEC-2001 (FST) */ - -/* The DAS file ID word and internal file name are no longer */ -/* buffered by this routine. See DASFM's Revisions section */ -/* for details. */ - -/* This entry point was modified to insert the FTP validation */ -/* string, as well as the binary file format into the file record. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 29-OCT-1993 (KRG) */ - -/* The effect of this routine is unchanged. It still uses the ID */ -/* word 'NAIF/DAS'. This is for backward compatibility only. */ - -/* Added statements to the $ Abstract and $ Particulars sections */ -/* to document that this entry is now considered to be obsolete, */ -/* and that it has been superceded by the entry point DASONW. */ - -/* Added a test for a blank filename before attempting to use the */ -/* filename in the routine. If the filename is blank, the error */ -/* SPICE(BLANKFILENAME) will be signaled. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a new DAS file for writing */ -/* open a new DAS file for write access */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.0.0, 11-DEC-2001 (FST) */ - -/* See the Revisions section under DASFM for a discussion */ -/* of the changes made for this version. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASOPN", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Check to see whether the filename is blank. If it is, signal an */ -/* error, check out, and return. */ - - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - setmsg_("The file name is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("DASOPN", (ftnlen)6); - return 0; - } - -/* The file can be opened only if there is room for another file. */ - - if (lnknfn_(pool) == 0) { - setmsg_("The file table is full, with # entries. Could not open '#'.", - (ftnlen)59); - errint_("#", &c__21, (ftnlen)1); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASFTFULL)", (ftnlen)16); - chkout_("DASOPN", (ftnlen)6); - return 0; - } else { - -/* To open a new file: get a free unit, open the file, write */ -/* the file record, and set the number of links to one. */ - -/* Look out for: */ - -/* -- No free logical units. */ - -/* -- Error opening the file. */ - -/* -- Error writing to the file. */ - -/* If anything goes wrong after the file has been opened, delete */ -/* the file. */ - - - getlun_(&number); - if (failed_()) { - chkout_("DASOPN", (ftnlen)6); - return 0; - } - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = rtrim_(fname, fname_len); - o__1.ofnm = fname; - o__1.orl = 1024; - o__1.osta = "NEW"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to open file '#' failed. Value of IOSTAT was #.", - (ftnlen)55); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASOPENFAIL)", (ftnlen)18); - chkout_("DASOPN", (ftnlen)6); - return 0; - } else { - -/* Fetch the system file format. */ - - zzplatfm_("FILE_FORMAT", format, (ftnlen)11, (ftnlen)8); - -/* Prepare to write the file record. Clear out the file */ -/* summary, except for the number of reserved records and */ -/* the free record pointer. The free record pointer should */ -/* point to the first record AFTER the first directory. */ - -/* Use a local variable for the internal file name to ensure */ -/* that IFNLEN characters are written. The remaining */ -/* elements of the file record are: */ - -/* -- the number of reserved records */ - -/* -- the number of characters in use in the reserved */ -/* record area */ - -/* -- the number of comment records */ - -/* -- the number of characters in use in the comment */ -/* area */ - -/* Initially, all of these counts are zero. */ - - - s_copy(locifn, ifname, (ftnlen)60, ifname_len); - s_copy(idword, "NAIF/DAS", (ftnlen)8, (ftnlen)8); - zzdasnfr_(&number, idword, locifn, &c__0, &c__0, &c__0, &c__0, - format, (ftnlen)8, (ftnlen)60, (ftnlen)8); - if (failed_()) { - chkout_("DASOPN", (ftnlen)6); - return 0; - } - -/* Zero out the first directory record (record #2) in the */ -/* file. If this write fails, close the file with delete */ -/* status and return immediately. */ - - cleari_(&c__256, dirrec); - dasioi_("WRITE", &number, &c__2, dirrec, (ftnlen)5); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("DASOPN", (ftnlen)6); - return 0; - } - -/* Update the file table to include information about */ -/* our newly opened DAS file. Link the information */ -/* for this file at the head of the file table list. */ - -/* Set the output argument HANDLE as well. */ - - lnkan_(pool, &new__); - lnkilb_(&new__, &fthead, pool); - ++nxthan; - fthead = new__; - cleari_(&c__14, &ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen) - 3324)]); - fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)3326)] = nxthan; - ftlun[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "un", i__1, "dasfm_", (ftnlen)3327)] = number; - ftacc[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fta" - "cc", i__1, "dasfm_", (ftnlen)3328)] = 2; - ftlnk[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "nk", i__1, "dasfm_", (ftnlen)3329)] = 1; - ftsum[(i__1 = fthead * 14 - 10) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)3330)] = 3; - *handle = fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "dasfm_", (ftnlen)3332)]; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - } - } - chkout_("DASOPN", (ftnlen)6); - return 0; -/* $Procedure DASOPS ( DAS, open scratch ) */ - -L_dasops: -/* $ Abstract */ - -/* Open a scratch DAS file for writing. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE O Handle assigned to a scratch DAS file. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the scratch file */ -/* opened by this routine. This handle is used to */ -/* identify the file in subsequent calls to other DAS */ -/* routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified file cannot be opened without exceeding */ -/* the maximum allowed number of open DAS files, the error */ -/* SPICE(DASFTFULL) is signaled. No file will be created. */ - -/* 2) If file cannot be opened properly, the error */ -/* SPICE(DASOPENFAIL) is signaled. No file will be created. */ - -/* 3) If the initial records in the file cannot be written, the */ -/* error SPICE(DASWRITEFAIL) is signaled. No file will be */ -/* created. */ - -/* 4) If no logical units are available, the error will be */ -/* signaled by routines called by this routine. No file will be */ -/* created. */ - -/* $ Files */ - -/* See output argument HANDLE. */ - -/* See FTSIZE in the $ Parameters section for a description of a */ -/* potential problem with overflowing the DAS file table when at */ -/* least one DAS file is opened with write access. */ - -/* $ Particulars */ - -/* This routine is a utility used by the DAS system to provide */ -/* work space needed when creating new DAS files. */ - -/* The DAS files created by this routine have initialized file */ -/* records. The file type for a DAS scratch file is 'SCR ', so the */ -/* file type 'SCR ' is not available for general use. */ - -/* $ Examples */ - -/* 1) Create a scratch DAS file to use as a temporary storage */ -/* area. */ - -/* CALL DASOPS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 29-OCT-1993 (KRG) */ - -/* Modified the entry point to use the new file ID format which */ -/* contains a mnemonic code for the data type. */ - -/* Put meaningful values into the type and internal filename */ -/* for a DAS scratch file, rather than leaving them blank. */ - -/* Documented the potential problem of overflowing the DAS file */ -/* table when attempting to close a DAS file opened with write */ -/* access when the file table is full. Modified the long error */ -/* message to indicate this as a cause of the problem. */ - -/* - SPICELIB Version 1.1.0, 04-MAY-1993 (NJB) */ - -/* Bug fix: removed file name variable from error message. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a scratch DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 29-OCT-1993 (KRG) */ - -/* Modified the entry point to use the new file ID format which */ -/* contains a mnemonic code for the data type. */ - -/* DAS scratch files use the type 'SCR ', so the ID word for a DAS */ -/* scratch file would be: 'DAS/SCR ' */ - -/* Changed the internal fielname from blank to the string: */ - -/* 'DAS SCRATCH FILE' */ - -/* It's probably better to have something written there than */ -/* nothing. */ - -/* Documented the potential problem of overflowing the DAS file */ -/* table when attempting to close a DAS file opened with write */ -/* access when the file table is full. Modified the long error */ -/* message to indicate this as a cause of the problem. */ - -/* The problem occurs when the file table is full, the number of */ -/* open DAS files equals FTSIZE, and at least one of the open */ -/* files was opened with write access. If an attempt to close a */ -/* file opened with write access is made under these conditions, */ -/* by calling DASCLS, it will fail. DASCLS (via DASSDR) calls */ -/* DASOPS to open a scratch DAS file, but the scratch file CANNOT */ -/* be opened because the file table is full. If this occurs, close */ -/* a file open for read access, or restrict the number of open */ -/* files in use to be at most FTSIZE - 1 when there will be at */ -/* least one file opened with write access. */ - -/* - SPICELIB Version 1.1.0, 04-MAY-1993 (NJB) */ - -/* Bug fix: removed unneeded file name variable FNAME from */ -/* error message. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASOPS", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* The file can be opened only if there is room for another file. */ - - if (lnknfn_(pool) == 0) { - setmsg_("The file table is full, with # entries. Could not open a sc" - "ratch file. If a call to DASOPS was not made and this error " - "occurred, it is likely that the DAS file table was full and " - "an attempt to close a file opened with write access was made" - ". See the DAS required reading and DASFM for details.", ( - ftnlen)292); - errint_("#", &c__21, (ftnlen)1); - sigerr_("SPICE(DASFTFULL)", (ftnlen)16); - chkout_("DASOPS", (ftnlen)6); - return 0; - } else { - -/* To open a new file: get a free unit, open the file, write */ -/* the file record, and set the number of links to one. */ - -/* Look out for: */ - -/* -- No free logical units. */ - -/* -- Error opening the file. */ - -/* -- Error writing to the file. */ - -/* If anything goes wrong after the file has been opened, delete */ -/* the file. */ - - - getlun_(&number); - if (failed_()) { - chkout_("DASOPS", (ftnlen)6); - return 0; - } - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnm = 0; - o__1.orl = 1024; - o__1.osta = "SCRATCH"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to open scratch file failed. IOSTAT was #.", ( - ftnlen)51); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASOPENFAIL)", (ftnlen)18); - chkout_("DASOPS", (ftnlen)6); - return 0; - } else { - -/* Prepare to write the file record. Clear out the file */ -/* summary, the free record pointer. The free record pointer */ -/* should point to the first record AFTER the first directory. */ - - s_copy(locifn, "DAS SCRATCH FILE", (ftnlen)60, (ftnlen)16); - s_copy(idword, "DAS/SCR ", (ftnlen)8, (ftnlen)8); - io___52.ciunit = number; - iostat = s_wdue(&io___52); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100003; - } - iostat = e_wdue(); -L100003: - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - setmsg_("Attempt to write scratch file failed. Value of IOST" - "AT was #.", (ftnlen)60); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASWRITEFAIL)", (ftnlen)19); - chkout_("DASOPS", (ftnlen)6); - return 0; - } else { - -/* Update the file table to include information about */ -/* our newly opened DAS file. Link the information */ -/* for this file at the head of the file table list. */ - -/* Set the output argument HANDLE as well. */ - - lnkan_(pool, &new__); - lnkilb_(&new__, &fthead, pool); - ++nxthan; - fthead = new__; - cleari_(&c__14, &ftsum[(i__1 = fthead * 14 - 14) < 294 && 0 <= - i__1 ? i__1 : s_rnge("ftsum", i__1, "dasfm_", ( - ftnlen)3690)]); - fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "dasfm_", (ftnlen)3692)] = nxthan; - ftlun[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftlun", i__1, "dasfm_", (ftnlen)3693)] = number; - ftacc[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftacc", i__1, "dasfm_", (ftnlen)3694)] = 2; - ftlnk[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftlnk", i__1, "dasfm_", (ftnlen)3695)] = 1; - ftsum[(i__1 = fthead * 14 - 10) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)3696)] = 3; - *handle = fthan[(i__1 = fthead - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "dasfm_", (ftnlen)3698)]; - -/* Insert the new handle into our handle set. */ - - insrti_(handle, fhlist); - } - } - } - chkout_("DASOPS", (ftnlen)6); - return 0; -/* $Procedure DASLLC ( DAS, low-level close ) */ - -L_dasllc: -/* $ Abstract */ - -/* Close the DAS file associated with a given handle. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAS file to be closed. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to a DAS file */ -/* that is currently open, nothing happens. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Normally, routines outside of SPICELIB will not need to call this */ -/* routine. Application programs should close DAS files by calling */ -/* the SPICELIB routine DASCLS. This routine is a lower-level */ -/* routine that is called by DASCLS, but (obviously) does not have */ -/* the full functionality of DASCLS. */ - -/* This routine closes a DAS file and updates DASFM's bookkeeping */ -/* information on open DAS files. Because DASFM and its entry */ -/* points must keep track of what files are open at any given time, */ -/* it is important that DAS files be closed only with DASCLS or */ -/* DASLLC, to prevent the remaining DAS routines from failing, */ -/* sometimes mysteriously. */ - -/* Note that when a file is opened more than once for read or write */ -/* access, DASOPR returns the same handle each time it is re-opened. */ -/* Each time the file is closed, DASLLC checks to see if any other */ -/* claims on the file are still active before physically closing */ -/* the file. */ - -/* Unlike DASCLS, this routine does not force a write of updated, */ -/* buffered records to the indicated file, nor does it segregate the */ -/* data records in the file. */ - -/* $ Examples */ - -/* 1) Here's how DASCLS uses this routine: */ - - -/* C */ -/* C If the file is open for writing, flush any buffered */ -/* C records that belong to it. */ -/* C */ -/* CALL DASHAM ( HANDLE, METHOD ) */ - -/* IF ( METHOD .EQ. WRITE ) THEN */ - -/* Make sure that all updated, buffered records are */ -/* written out to the indicated file. */ - -/* CALL DASWUR ( HANDLE ) */ - -/* Segregate the data records in the file according */ -/* to data type. */ - -/* CALL DASSDR ( HANDLE ) */ - -/* END IF */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASLLC ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.2, 21-FEB-2003 (NJB) */ - -/* Corrected inline comment: determination of whether file */ -/* is open is done by searching the handle column of the file */ -/* table, not the unit column. */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* close a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASLLC", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Is this file even open? Peruse the `handle' column of the file */ -/* table; see whether this handle is present. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)3956)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - -/* If the file is not open: no harm, no foul. Otherwise, decrement */ -/* the number of links to the file. If the number of links drops to */ -/* zero, physically close the file and remove it from the file */ -/* buffer. */ - - if (found) { - ftlnk[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftlnk", - i__1, "dasfm_", (ftnlen)3972)] = ftlnk[(i__2 = findex - 1) < - 21 && 0 <= i__2 ? i__2 : s_rnge("ftlnk", i__2, "dasfm_", ( - ftnlen)3972)] - 1; - if (ftlnk[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "nk", i__1, "dasfm_", (ftnlen)3974)] == 0) { - -/* Close this file and delete it from the active list. */ -/* If this was the head node of the list, the head node */ -/* becomes the successor of this node (which may be NIL). */ -/* Delete the handle from our handle set. */ - - cl__1.cerr = 0; - cl__1.cunit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("ftlun", i__1, "dasfm_", (ftnlen)3981)]; - cl__1.csta = 0; - f_clos(&cl__1); - if (findex == fthead) { - fthead = lnknxt_(&findex, pool); - } - lnkfsl_(&findex, &findex, pool); - removi_(handle, fhlist); - } - } - chkout_("DASLLC", (ftnlen)6); - return 0; -/* $Procedure DASHFS ( DAS, handle to file summary ) */ - -L_dashfs: -/* $ Abstract */ - -/* Return a file summary for a specified DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER NRESVR */ -/* INTEGER NRESVC */ -/* INTEGER NCOMR */ -/* INTEGER NCOMC */ -/* INTEGER FREE */ -/* INTEGER LASTLA ( 3 ) */ -/* INTEGER LASTRC ( 3 ) */ -/* INTEGER LASTWD ( 3 ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAS file. */ -/* NRESVR O Number of reserved records in file. */ -/* NRESVC O Number of characters in use in reserved rec. area. */ -/* NCOMR O Number of comment records in file. */ -/* NCOMC O Number of characters in use in comment area. */ -/* FREE O Number of first free record. */ -/* LASTLA O Array of last logical addresses for each data type. */ -/* LASTRC O Record number of last descriptor of each data type. */ -/* LASTWD O Word number of last descriptor of each data type. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* NRESVR is the number of reserved records in a specified DAS */ -/* file. */ - -/* NRESVC is the number of characters in use in the reserved */ -/* record area of a specified DAS file. */ - -/* NCOMR is the number of comment records in a specified DAS */ -/* file. */ - -/* NCOMC is the number of characters in use in the comment area */ -/* of a specified DAS file. */ - -/* FREE is the Fortran record number of the first free record */ -/* in a specified DAS file. */ - -/* LASTLA is an array containing the highest current logical */ -/* addresses, in the specified DAS file, of data of */ -/* character, double precision, and integer types, in */ -/* that order. */ - -/* LASTRC is an array containing the Fortran record numbers, in */ -/* the specified DAS file, of the directory records */ -/* containing the current last descriptors of clusters */ -/* of character, double precision, and integer data */ -/* records, in that order. */ - -/* LASTWD is an array containing the word positions, in the */ -/* specified DAS file, of the current last descriptors */ -/* of clusters of character, double precision, and */ -/* integer data records, in that order. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, the error SPICE(DASNOSUCHHANDLE) */ -/* is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The quantities NRESVR, NRESRC, NCOMR, NCOMC, FREE, LASTLA, */ -/* LASTRC, and LASTWD define the `state' of a DAS file, and in */ -/* particular the state of the directory structure of the file. */ -/* This information is needed by other DAS routines, but application */ -/* programs will usually have no need for it. The one exception is */ -/* the array of `last' logical addresses LASTLA: these addresses */ -/* indicate how many words of data of each type are contained in the */ -/* specified DAS file. The elements of LASTLA can be conveniently */ -/* retrieved by calling DASLLA. */ - -/* $ Examples */ - -/* 1) Dump the data from a DAS file. */ - -/* C */ -/* C Open the DAS file for reading. */ -/* C */ -/* CALL DASOPR ( FILE, HANDLE ) */ - -/* C */ -/* C Obtain the file summary. */ -/* C */ -/* CALL DASHFS ( HANDLE, */ -/* . NRESVR, */ -/* . RRESVC, */ -/* . NCOMR, */ -/* . NCOMC, */ -/* . FREE, */ -/* . LASTLA, */ -/* . LASTRC, */ -/* . LASTWD ) */ - -/* C */ -/* C Read the integers and dump them. */ -/* C */ -/* DO I = 1, LASTLA(INT) */ -/* CALL DASRDI ( HANDLE, I, I, N ) */ -/* WRITE (*,*) N */ -/* END DO */ - -/* C */ -/* C Now the d.p. numbers: */ -/* C */ -/* DO I = 1, LASTLA(DP) */ -/* CALL DASRDD ( HANDLE, I, I, X ) */ -/* WRITE (*,*) X */ -/* END DO */ - -/* C */ -/* C Now the characters. In this case, we read the */ -/* C data a line at a time. */ -/* C */ -/* FIRST = 0 */ -/* LAST = 0 */ -/* REMAIN = LASTLA(CHAR) */ - -/* DO WHILE ( REMAIN .GT. 0 ) */ - -/* NREAD = MIN ( LINLEN, REMAIN ) */ -/* FIRST = LAST + 1 */ -/* LAST = LAST + NREAD */ - -/* CALL DASRDC ( HANDLE, FIRST, LAST, LINE ) */ - -/* WRITE (*,*) LINE(:NREAD) */ - -/* REMAIN = REMAIN - NREAD */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUL-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return the file summary of a DAS file */ -/* find the amount of data in a DAS file */ -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUL-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASHFS", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)4299)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - -/* Give the caller the current summary from the file table. */ - - *nresvr = ftsum[(i__1 = findex * 14 - 14) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4312)]; - *nresvc = ftsum[(i__1 = findex * 14 - 13) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4313)]; - *ncomr = ftsum[(i__1 = findex * 14 - 12) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4314)]; - *ncomc = ftsum[(i__1 = findex * 14 - 11) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4315)]; - *free = ftsum[(i__1 = findex * 14 - 10) < 294 && 0 <= i__1 ? i__1 : - s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4316)]; - for (i__ = 1; i__ <= 3; ++i__) { - lastla[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastla", - i__1, "dasfm_", (ftnlen)4319)] = ftsum[(i__2 = i__ + 5 + - findex * 14 - 15) < 294 && 0 <= i__2 ? i__2 : s_rnge( - "ftsum", i__2, "dasfm_", (ftnlen)4319)]; - lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", - i__1, "dasfm_", (ftnlen)4320)] = ftsum[(i__2 = i__ + 8 + - findex * 14 - 15) < 294 && 0 <= i__2 ? i__2 : s_rnge( - "ftsum", i__2, "dasfm_", (ftnlen)4320)]; - lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastwd", - i__1, "dasfm_", (ftnlen)4321)] = ftsum[(i__2 = i__ + 11 - + findex * 14 - 15) < 294 && 0 <= i__2 ? i__2 : s_rnge( - "ftsum", i__2, "dasfm_", (ftnlen)4321)]; - } - } else { - setmsg_("There is no DAS file open with handle = #", (ftnlen)41); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHHANDLE)", (ftnlen)22); - } - chkout_("DASHFS", (ftnlen)6); - return 0; -/* $Procedure DASUFS ( DAS, update file summary ) */ - -L_dasufs: -/* $ Abstract */ - -/* Update the file summary in a specified DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER NRESVR */ -/* INTEGER NRESVC */ -/* INTEGER NCOMR */ -/* INTEGER NCOMC */ -/* INTEGER FREE */ -/* INTEGER LASTLA ( 3 ) */ -/* INTEGER LASTRC ( 3 ) */ -/* INTEGER LASTWD ( 3 ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an open DAS file. */ -/* NRESVR I Number of reserved records in file. */ -/* NRESVC I Number of characters in use in reserved rec. area. */ -/* NCOMR I Number of comment records in file. */ -/* NCOMC I Number of characters in use in comment area. */ -/* FREE I Number of first free record. */ -/* LASTLA I Array of last logical addresses for each data type. */ -/* LASTRC I Record number of last descriptor of each data type. */ -/* LASTWD I Word number of last descriptor of each data type. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a previously opened DAS file. */ - -/* NRESVR is the number of reserved records in a specified DAS */ -/* file. */ - -/* NRESVC is the number of characters in use in the reserved */ -/* record area of a specified DAS file. */ - -/* NCOMR is the number of comment records in a specified DAS */ -/* file. */ - -/* NCOMC is the number of characters in use in the comment area */ -/* of a specified DAS file. */ - -/* FREE is the Fortran record number of the first free record */ -/* in a specified DAS file. */ - -/* LASTLA is an array containing the highest current logical */ -/* addresses, in the specified DAS file, of data of */ -/* character, double precision, and integer types, in */ -/* that order. */ - -/* LASTRC is an array containing the Fortran record numbers, in */ -/* the specified DAS file, of the directory records */ -/* containing the current last descriptors of clusters */ -/* of character, double precision, and integer data */ -/* records, in that order. */ - -/* LASTWD is an array containing the word positions, in the */ -/* specified DAS file, of the current last descriptors */ -/* of clusters of character, double precision, and */ -/* integer data records, in that order. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, the error SPICE(DASNOSUCHHANDLE) */ -/* is signaled. */ - -/* 2) If the specified handle is not open for WRITE access, the */ -/* error SPICE(DASINVALIDACCESS) is signaled. */ - -/* 3) If this routine's attempts to read the DAS file record */ -/* fail before an update, the error SPICE(DASREADFAIL) is */ -/* signaled. */ - -/* 4) If the attempt to write to the DAS file record fails, the */ -/* error SPICE(DASWRITEFAIL) is signaled. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* The quantities NRESVR, NRESRC, NCOMR, NCOMC, FREE, LASTLA, */ -/* LASTRC, and LASTWD define the `state' of a DAS file, and in */ -/* particular the state of the directory structure of the file. */ -/* These quantities should normally be updated only by DAS routines. */ - -/* The higher-level DAS routines that affect a DAS file's summary, */ -/* such as */ - -/* DASADx */ -/* DASUDx */ -/* DASARR */ - -/* automatically update the file summary, so there is no need for */ -/* the calling program to perform the update explicitly. */ - -/* $ Examples */ - -/* 1) Update the last d.p. logical address for a DAS file, leaving */ -/* the rest of the file summary intact. */ - -/* C */ -/* C Read the file summary. */ -/* C */ -/* CALL DASHFS ( HANDLE, */ -/* . NRESVR, */ -/* . RRESVC, */ -/* . NCOMR, */ -/* . NCOMC, */ -/* . FREE, */ -/* . LASTLA, */ -/* . LASTRC, */ -/* . LASTWD ) */ - -/* C */ -/* C Update the d.p. component of the `last logical */ -/* C address' array. */ -/* C */ -/* LASTLA(DP) = NEWVAL */ - -/* CALL DASUFS ( HANDLE, */ -/* . NRESVR, */ -/* . RRESVC, */ -/* . NCOMR, */ -/* . NCOMC, */ -/* . FREE, */ -/* . LASTLA, */ -/* . LASTRC, */ -/* . LASTWD ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.1.0, 26-SEP-2005 (NJB) */ - -/* Bug fix: file name is now correctly inserted into long */ -/* error message generated when target file is not open for */ -/* write access. */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.0, 15-OCT-2001 (FST) (NJB) */ - -/* Bug fix: this routine now reads the file record */ -/* before attempting to update it. The buffered values */ -/* of IDWORD and IFN are no longer present. */ - -/* Bug fix: missing call to CHKIN was added to an error */ -/* handling branch in entry point DASUFS. This call is */ -/* required because DASUFS uses discovery check-in. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUL-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update the file summary of a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.1.0, 26-SEP-2005 (NJB) */ - -/* Bug fix: file name is now correctly inserted into long */ -/* error message generated when target file is not open for */ -/* write access. */ - -/* - SPICELIB Version 5.1.0, 15-OCT-2001 (NJB) */ - -/* Bug fix: missing call to CHKIN was added to an error */ -/* handling branch in entry point DASUFS. This call is */ -/* required because DASUFS uses discovery check-in. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUL-1992 (NJB) (WLT) */ - -/* -& */ - -/* We use discovery check-ins in this routine. */ - - if (return_()) { - return 0; - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - chkin_("DASUFS", (ftnlen)6); - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - chkout_("DASUFS", (ftnlen)6); - pass1 = FALSE_; - } - -/* Find the file table entries for this file. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)4660)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - -/* Now check to see that HANDLE is open for write, as one has */ -/* no business updating a file summary for files that are */ -/* open for read access only. */ - - if (ftacc[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fta" - "cc", i__1, "dasfm_", (ftnlen)4675)] != 2) { - chkin_("DASUFS", (ftnlen)6); - setmsg_("DAS file not open for writing. Handle = #, file = '#'.", - (ftnlen)54); - errint_("#", handle, (ftnlen)1); - errfnm_("#", &ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("ftlun", i__1, "dasfm_", (ftnlen)4681)], (ftnlen) - 1); - sigerr_("SPICE(DASINVALIDACCESS)", (ftnlen)23); - chkout_("DASUFS", (ftnlen)6); - return 0; - } - -/* If any of the counts pertaining to the reserved record are or */ -/* the comment area were changed, we need to record the new */ -/* counts in the file record. Otherwise, leave the file alone. */ - - if (*nresvr != ftsum[(i__1 = findex * 14 - 14) < 294 && 0 <= i__1 ? - i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4693)] || * - nresvc != ftsum[(i__2 = findex * 14 - 13) < 294 && 0 <= i__2 ? - i__2 : s_rnge("ftsum", i__2, "dasfm_", (ftnlen)4693)] || * - ncomr != ftsum[(i__3 = findex * 14 - 12) < 294 && 0 <= i__3 ? - i__3 : s_rnge("ftsum", i__3, "dasfm_", (ftnlen)4693)] || * - ncomc != ftsum[(i__5 = findex * 14 - 11) < 294 && 0 <= i__5 ? - i__5 : s_rnge("ftsum", i__5, "dasfm_", (ftnlen)4693)]) { - -/* Read the file record. */ - - io___53.ciunit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("ftlun", i__1, "dasfm_", (ftnlen)4701)]; - iostat = s_rdue(&io___53); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, (char *)&locrrc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, (char *)&locrch, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, (char *)&loccrc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, (char *)&loccch, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, locfmt, (ftnlen)8); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, tail, (ftnlen)932); - if (iostat != 0) { - goto L100004; - } - iostat = e_rdue(); -L100004: - if (iostat != 0) { - chkin_("DASUFS", (ftnlen)6); - setmsg_("Attempt to read file record failed. File was '#'. " - "Value of IOSTAT was '#'.", (ftnlen)75); - errfnm_("#", &ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("ftlun", i__1, "dasfm_", (ftnlen)4718)], - (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASREADFAIL)", (ftnlen)18); - chkout_("DASUFS", (ftnlen)6); - return 0; - } - io___55.ciunit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("ftlun", i__1, "dasfm_", (ftnlen)4726)]; - iostat = s_wdue(&io___55); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer) - ); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer) - ); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer)) - ; - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer)) - ; - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, locfmt, (ftnlen)8); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, tail, (ftnlen)932); - if (iostat != 0) { - goto L100005; - } - iostat = e_wdue(); -L100005: - if (iostat != 0) { - chkin_("DASUFS", (ftnlen)6); - cl__1.cerr = 0; - cl__1.cunit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("ftlun", i__1, "dasfm_", (ftnlen)4741)]; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to update file record failed. File was '#'." - " Value of IOSTAT was '#'.", (ftnlen)77); - errfnm_("#", &ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("ftlun", i__1, "dasfm_", (ftnlen)4746)], - (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASWRITEFAIL)", (ftnlen)19); - chkout_("DASUFS", (ftnlen)6); - return 0; - } - } - -/* Update the file table. */ - - ftsum[(i__1 = findex * 14 - 14) < 294 && 0 <= i__1 ? i__1 : s_rnge( - "ftsum", i__1, "dasfm_", (ftnlen)4759)] = *nresvr; - ftsum[(i__1 = findex * 14 - 13) < 294 && 0 <= i__1 ? i__1 : s_rnge( - "ftsum", i__1, "dasfm_", (ftnlen)4760)] = *nresvc; - ftsum[(i__1 = findex * 14 - 12) < 294 && 0 <= i__1 ? i__1 : s_rnge( - "ftsum", i__1, "dasfm_", (ftnlen)4761)] = *ncomr; - ftsum[(i__1 = findex * 14 - 11) < 294 && 0 <= i__1 ? i__1 : s_rnge( - "ftsum", i__1, "dasfm_", (ftnlen)4762)] = *ncomc; - ftsum[(i__1 = findex * 14 - 10) < 294 && 0 <= i__1 ? i__1 : s_rnge( - "ftsum", i__1, "dasfm_", (ftnlen)4763)] = *free; - for (i__ = 1; i__ <= 3; ++i__) { - ftsum[(i__1 = i__ + 5 + findex * 14 - 15) < 294 && 0 <= i__1 ? - i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4766)] = - lastla[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "lastla", i__2, "dasfm_", (ftnlen)4766)]; - ftsum[(i__1 = i__ + 8 + findex * 14 - 15) < 294 && 0 <= i__1 ? - i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4767)] = - lastrc[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "lastrc", i__2, "dasfm_", (ftnlen)4767)]; - ftsum[(i__1 = i__ + 11 + findex * 14 - 15) < 294 && 0 <= i__1 ? - i__1 : s_rnge("ftsum", i__1, "dasfm_", (ftnlen)4768)] = - lastwd[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "lastwd", i__2, "dasfm_", (ftnlen)4768)]; - } - } else { - chkin_("DASUFS", (ftnlen)6); - setmsg_("There is no file open with handle = #", (ftnlen)37); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHHANDLE)", (ftnlen)22); - chkout_("DASUFS", (ftnlen)6); - } - return 0; -/* $Procedure DASHLU ( DAS, handle to logical unit ) */ - -L_dashlu: -/* $ Abstract */ - -/* Return the logical unit associated with a handle. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAS file. */ -/* UNIT O Corresponding logical unit. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* UNIT is the Fortran logical unit to which the file is */ -/* connected. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, the error SPICE(DASNOSUCHHANDLE) */ -/* is signaled. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is a utility used by the DAS system to support */ -/* file I/O. DASHLU may also prove useful to general SPICELIB */ -/* users for constructing error messages. */ - -/* $ Examples */ - -/* 1) Obtain the logical unit associated with a DAS file having */ -/* a known handle. */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* map DAS file handle to logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* We use discovery check-ins in this routine. */ - - if (return_()) { - return 0; - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - chkin_("DASHLU", (ftnlen)6); - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - chkout_("DASHLU", (ftnlen)6); - pass1 = FALSE_; - } - -/* Find the file table entries for this file. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)4980)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - *unit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "ftlun", i__1, "dasfm_", (ftnlen)4991)]; - } else { - chkin_("DASHLU", (ftnlen)6); - setmsg_("There is no file open with handle = #", (ftnlen)37); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHHANDLE)", (ftnlen)22); - chkout_("DASHLU", (ftnlen)6); - } - return 0; -/* $Procedure DASLUH ( DAS, logical unit to handle ) */ - -L_dasluh: -/* $ Abstract */ - -/* Return the handle associated with a logical unit. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER UNIT */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit connected to a DAS file. */ -/* HANDLE O Corresponding handle. */ - -/* $ Detailed_Input */ - -/* UNIT is the logical unit to which a DAS file has been */ -/* connected when it was opened. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle associated with the file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified unit is not connected to any DAS file that is */ -/* currently known to be open, the error SPICE(DASNOSUCHUNIT) */ -/* is signaled. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* It is unlikely, but possible, that a calling program would know */ -/* the logical unit to which a file is connected without knowing the */ -/* handle associated with the file. DASLUH is provided mostly for */ -/* completeness. */ - -/* $ Examples */ - -/* In the following code fragment, the handle associated with */ -/* a DAS file is retrieved using the logical unit to which the */ -/* file is connected. The handle is then used to determine the */ -/* name of the file. */ - -/* CALL DASLUH ( UNIT, HANDLE ) */ -/* CALL DASHFN ( HANDLE, FNAME ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* map logical unit to DAS file handle */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASLUH", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Find the file table entries for this file. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "un", i__1, "dasfm_", (ftnlen)5205)] == *unit) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - *handle = fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "dasfm_", (ftnlen)5215)]; - } else { - setmsg_("There is no DAS file open with unit = #", (ftnlen)39); - errint_("#", unit, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHUNIT)", (ftnlen)20); - } - chkout_("DASLUH", (ftnlen)6); - return 0; -/* $Procedure DASHFN ( DAS, handle to file name ) */ - -L_dashfn: -/* $ Abstract */ - -/* Return the name of the DAS file associated with a handle. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) FNAME */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAS file. */ -/* FNAME O Corresponding file name. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* FNAME is the name of the DAS file associated with the input */ -/* file handle. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified handle does not belong to any file that is */ -/* currently known to be open, the error SPICE(DASNOSUCHHANDLE) */ -/* is signaled. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* It may be desirable to recover the names of one or more DAS */ -/* files in a different part of the program from the one in which */ -/* they were opened. Note that the names returned by DASHFN may */ -/* not be identical to the names used to open the files. Under */ -/* most operating systems, a particular file can be accessed using */ -/* many different names. DASHFN returns one of them. */ - -/* $ Examples */ - -/* In the following code fragment, the name of a DAS file is */ -/* recovered using the handle associated with the file. */ - -/* CALL DASOPR ( 'sample.DAS', HANDLE ) */ -/* . */ -/* . */ - -/* CALL DASHFN ( HANDLE, FNAME ) */ - -/* Depending on the circumstances (operating system, compiler, */ -/* default directory) the value of FNAME might resemble any of */ -/* the following: */ - -/* 'USER$DISK:[WYATT.IMAGES]SAMPLE.DAS;4' */ - -/* '/wyatt/images/sample.DAS' */ - -/* 'A:\IMAGES\SAMPLE.DAS' */ - -/* On the other hand, it might not. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* map DAS handle to file name */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASHFN", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Find the file table entries for this file. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)5443)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - ioin__1.inerr = 0; - ioin__1.inunit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : - s_rnge("ftlun", i__1, "dasfm_", (ftnlen)5453)]; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.innamlen = fname_len; - ioin__1.inname = fname; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - f_inqu(&ioin__1); - } else { - setmsg_("There is no DAS file open with handle = #", (ftnlen)41); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHHANDLE)", (ftnlen)22); - } - chkout_("DASHFN", (ftnlen)6); - return 0; -/* $Procedure DASFNH ( DAS, file name to handle ) */ - -L_dasfnh: -/* $ Abstract */ - -/* Return handle associated with a file name. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a DAS file. */ -/* HANDLE O Corresponding handle. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle associated with the file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified name does not specify any DAS file currently */ -/* known to be open, the error SPICE(DASNOSUCHFILE) is signaled. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* It is sometimes easier to work with file names (which are */ -/* meaningful, and often predictable) than with file handles */ -/* (which are neither), especially in interactive situations. */ -/* However, nearly every DAS routine requires that you use file */ -/* handles to refer to files. DASFNH is provided to bridge the gap */ -/* between the two representations. */ - -/* $ Examples */ - -/* In the following code fragment, the handle associated with a */ -/* DAS file is recovered using the name of the file. */ - -/* CALL DASOPR ( 'sample.DAS', HANDLE ) */ -/* . */ -/* . */ - -/* CALL DASFNH ( 'sample.DAS', HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* map file name to DAS handle */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASFNH", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - ioin__1.inerr = 0; - ioin__1.infilen = rtrim_(fname, fname_len); - ioin__1.infile = fname; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = &number; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - f_inqu(&ioin__1); - -/* Find the file table entries for this file. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftl" - "un", i__1, "dasfm_", (ftnlen)5671)] == number) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (found) { - *handle = fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "dasfm_", (ftnlen)5681)]; - } else { - setmsg_("There is no DAS file in the table with file name = '#'", ( - ftnlen)54); - errch_("#", fname, (ftnlen)1, fname_len); - sigerr_("SPICE(DASNOSUCHFILE)", (ftnlen)20); - } - chkout_("DASFNH", (ftnlen)6); - return 0; -/* $Procedure DASHOF ( DAS, handles of open files ) */ - -L_dashof: -/* $ Abstract */ - -/* Return a SPICELIB set containing the handles of all currently */ -/* open DAS files. */ - -/* $ 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 */ - -/* DAS */ -/* SETS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER FHSET ( LBCELL : * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FHSET O A set containing handles of currently open DAS */ -/* files. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* FHSET is a SPICELIB set containing the file handles of */ -/* all currently open DAS files. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the set FHSET is not initialized, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the set FHSET is too small to accommodate the set of */ -/* handles to be returned, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows subroutines to test DAS file handles for */ -/* validity before using them. Many DAS operations that rely on */ -/* handles to identify DAS files cause errors to be signaled if */ -/* the handles are invalid. */ - -/* $ Examples */ - -/* 1) Find out how may DAS files are open for writing. */ - -/* C */ -/* C Find out which DAS files are open. */ -/* C */ -/* CALL DASHOF ( FHSET ) */ - -/* C */ -/* C Count the ones open for writing. */ -/* C */ -/* COUNT = 0 */ - -/* DO I = 1, CARDC(FHSET) */ - -/* CALL DASHAM ( FHSET(I), METHOD ) */ - -/* IF ( METHOD .EQ. WRITE ) THEN */ -/* COUNT = COUNT + 1 */ -/* END IF */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* return set of handles of open DAS files */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASHOF", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Just stuff our local list into the set. */ - - copyi_(fhlist, fhset); - chkout_("DASHOF", (ftnlen)6); - return 0; -/* $Procedure DASSIH ( DAS, signal invalid handles ) */ - -L_dassih: -/* $ Abstract */ - -/* Signal an error if a DAS file file handle does not designate a */ -/* DAS file that is open for a specified type of access. */ - -/* $ 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 */ - -/* DAS */ -/* ERROR */ -/* SETS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) ACCESS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I HANDLE to be validated. */ -/* ACCESS I String indicating access type. */ - -/* $ Detailed_Input */ - -/* HANDLE is a DAS file handle to validate. For HANDLE to be */ -/* considered valid, it must specify a DAS file that */ -/* is open for the type of access specified by the */ -/* input argument ACCESS. */ - - -/* ACCESS is a string indicating the type of access that */ -/* the DAS file specified by the input argument HANDLE */ -/* must be open for. The values of ACCESS may be */ - -/* 'READ' File must be open for read access */ -/* by DAS routines. DAS files opened */ -/* for read or write access may be */ -/* read. */ - -/* 'WRITE' File must be open for write access */ -/* by DAS routines. Note that files */ -/* open for write access may be read as */ -/* well as written. */ - -/* Leading and trailing blanks in ACCESS are ignored, */ -/* and case is not significant. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input argument ACCESS has an unrecognized value, */ -/* the error SPICE(INVALIDOPTION) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine signals the error SPICE(DASINVALIDACCESS) if the */ -/* DAS designated by the input argument HANDLE is not open */ -/* for the specified type of access. If HANDLE does not designate */ -/* an open DAS file, the error SPICE(DASNOSUCHHANDLE) is signaled. */ - -/* This routine allows subroutines to test file handles for */ -/* validity before attempting to access the files they designate, */ -/* or before performing operations on the handles themselves, such */ -/* as finding the name of the file designated by a handle. This */ -/* routine should be used in situations where the appropriate action */ -/* to take upon determining that a handle is invalid is to signal */ -/* an error. DASSIH centralizes the error response for this type of */ -/* error in a single routine. */ - -/* In cases where it is necessary to determine the validity of a */ -/* file handle, but it is not an error for the handle to refer */ -/* to a closed file, the entry point DASHOF should be used instead */ -/* of DASSIH. */ - -/* $ Examples */ - -/* 1) Make sure that a file handle designates a DAS file that can */ -/* be read. Signal an error if not. */ - -/* Note that if a DAS file is open for reading or writing, read */ -/* access is allowed. */ - -/* CALL DASSIH ( HANDLE, 'READ' ) */ - -/* IF ( FAILED() ) THEN */ -/* RETURN */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.1.0, 26-SEP-2005 (NJB) */ - -/* Local variable DAS was renamed to DASFIL. This */ -/* was done to avoid future conflict with parameters */ -/* in zzddhman.inc. */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* detect invalid DAS handles */ -/* validate DAS handles */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.1.0, 26-SEP-2005 (NJB) */ - -/* Local variable DAS was renamed to DASFIL. This */ -/* was done to avoid future conflict with parameters */ -/* in zzddhman.inc. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASSIH", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* Get an upper case, left-justified copy of ACCESS. */ - - ljust_(access, acc, access_len, (ftnlen)10); - ucase_(acc, acc, (ftnlen)10, (ftnlen)10); - -/* Make sure we recognize the access type specified by the caller. */ - - if (s_cmp(acc, "READ", (ftnlen)10, (ftnlen)4) != 0 && s_cmp(acc, "WRITE", - (ftnlen)10, (ftnlen)5) != 0) { - setmsg_("Unrecognized access type. Type was #. ", (ftnlen)39); - errch_("#", access, (ftnlen)1, access_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("DASSIH", (ftnlen)6); - return 0; - } - -/* See whether the input handle is in our list at all. It's */ -/* unlawful for the handle to be absent. */ - - if (! elemi_(handle, fhlist)) { - setmsg_("Handle # is not attached to an open DAS file.", (ftnlen)45); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(DASNOSUCHHANDLE)", (ftnlen)22); - chkout_("DASSIH", (ftnlen)6); - return 0; - } else { - -/* Find the file table entries for this file. We know they */ -/* must exist. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "dasfm_", (ftnlen)6184)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - -/* At this point, FINDEX points to the file table entries */ -/* for this file. */ - - if (s_cmp(acc, "WRITE", (ftnlen)10, (ftnlen)5) == 0 && ftacc[(i__1 = - findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftacc", i__1, - "dasfm_", (ftnlen)6196)] != 2) { - -/* If the access type is 'WRITE', the DAS file must be open */ -/* for writing. */ - - ioin__1.inerr = 0; - ioin__1.inunit = ftlun[(i__1 = findex - 1) < 21 && 0 <= i__1 ? - i__1 : s_rnge("ftlun", i__1, "dasfm_", (ftnlen)6202)]; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.innamlen = 255; - ioin__1.inname = dasfil; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - f_inqu(&ioin__1); - setmsg_("DAS file not open for writing. Handle = #, file = '#'.", - (ftnlen)54); - errint_("#", handle, (ftnlen)1); - errch_("#", dasfil, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(DASINVALIDACCESS)", (ftnlen)23); - chkout_("DASSIH", (ftnlen)6); - return 0; - } - } - -/* The DAS file's handle is o.k. */ - - chkout_("DASSIH", (ftnlen)6); - return 0; -/* $Procedure DASHAM ( DAS, handle to access method ) */ - -L_dasham: -/* $ Abstract */ - -/* Return the allowed access method for a specified DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) ACCESS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I HANDLE of a DAS file. */ -/* ACCESS O String indicating allowed access method. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* ACCESS is a string indicating the type of access that */ -/* the DAS file specified by the input argument HANDLE */ -/* is open for. The values of ACCESS may be */ - -/* 'READ' File is open for read access by DAS */ -/* routines. Both the data area and */ -/* the comment area may be read. The */ -/* file may not be modified. */ - -/* 'WRITE' File is open for write access by */ -/* DAS routines. Files open for */ -/* write access may be read as well as */ -/* written. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error SPICE(INVALIDHANDLE) */ -/* is signaled. ACCESS is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows subroutines to determine the access methods */ -/* allowed for a given DAS file. */ - -/* $ Examples */ - -/* 1) Make sure that a file handle designates a DAS file that can */ -/* be read. Signal an error if not. */ - -/* Note that if a DAS file is open for reading or writing, read */ -/* access is allowed. */ - -/* CALL DASHAM ( HANDLE, 'READ' ) */ - -/* IF ( FAILED() ) THEN */ -/* RETURN */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input and $ Output sections of the header. This was */ -/* done in order to minimize documentation changes if these open */ -/* routines ever change. */ - -/* - SPICELIB Version 1.0.0, 01-FEB-1993 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* return allowed access methods for DAS files */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 01-NOV-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input and $ Output sections of the header. This was */ -/* done in order to minimize documentation changes if these open */ -/* routines ever change. */ - -/* - SPICELIB Version 1.0.0, 01-FEB-1993 (NJB) (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASHAM", (ftnlen)6); - } - -/* Initialize the file table pool and handle list, if necessary. */ - - if (pass1) { - lnkini_(&c__21, pool); - ssizei_(&c__21, fhlist); - pass1 = FALSE_; - } - -/* See whether the input handle is in our list at all. It's */ -/* unlawful for the handle to be absent. */ - - findex = fthead; - found = FALSE_; - while(! found && findex > 0) { - if (fthan[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("fth" - "an", i__1, "dasfm_", (ftnlen)6435)] == *handle) { - found = TRUE_; - } else { - findex = lnknxt_(&findex, pool); - } - } - if (! found) { - setmsg_("The handle # does not designate a known DAS file ", (ftnlen) - 49); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(INVALIDHANDLE)", (ftnlen)20); - chkout_("DASHAM", (ftnlen)6); - return 0; - } - -/* We know about the file if we got this far. Set the output */ -/* argument accordingly. */ - - if (ftacc[(i__1 = findex - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("ftacc", - i__1, "dasfm_", (ftnlen)6458)] == 1) { - s_copy(access, "READ", access_len, (ftnlen)4); - } else { - s_copy(access, "WRITE", access_len, (ftnlen)5); - } - chkout_("DASHAM", (ftnlen)6); - return 0; -} /* dasfm_ */ - -/* Subroutine */ int dasfm_(char *fname, char *ftype, char *ifname, integer * - handle, integer *unit, integer *free, integer *lastla, integer * - lastrc, integer *lastwd, integer *nresvr, integer *nresvc, integer * - ncomr, integer *ncomc, integer *fhset, char *access, ftnlen fname_len, - ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len) -{ - return dasfm_0_(0, fname, ftype, ifname, handle, unit, free, lastla, - lastrc, lastwd, nresvr, nresvc, ncomr, ncomc, fhset, access, - fname_len, ftype_len, ifname_len, access_len); - } - -/* Subroutine */ int dasopr_(char *fname, integer *handle, ftnlen fname_len) -{ - return dasfm_0_(1, fname, (char *)0, (char *)0, handle, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dasopw_(char *fname, integer *handle, ftnlen fname_len) -{ - return dasfm_0_(2, fname, (char *)0, (char *)0, handle, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dasonw_(char *fname, char *ftype, char *ifname, integer * - ncomr, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen - ifname_len) -{ - return dasfm_0_(3, fname, ftype, ifname, handle, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, ( - integer *)0, ncomr, (integer *)0, (integer *)0, (char *)0, - fname_len, ftype_len, ifname_len, (ftnint)0); - } - -/* Subroutine */ int dasopn_(char *fname, char *ifname, integer *handle, - ftnlen fname_len, ftnlen ifname_len) -{ - return dasfm_0_(4, fname, (char *)0, ifname, handle, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, fname_len, (ftnint)0, ifname_len, (ftnint)0); - } - -/* Subroutine */ int dasops_(integer *handle) -{ - return dasfm_0_(5, (char *)0, (char *)0, (char *)0, handle, (integer *)0, - (integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer * - )0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char - *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dasllc_(integer *handle) -{ - return dasfm_0_(6, (char *)0, (char *)0, (char *)0, handle, (integer *)0, - (integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer * - )0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char - *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dashfs_(integer *handle, integer *nresvr, integer * - nresvc, integer *ncomr, integer *ncomc, integer *free, integer * - lastla, integer *lastrc, integer *lastwd) -{ - return dasfm_0_(7, (char *)0, (char *)0, (char *)0, handle, (integer *)0, - free, lastla, lastrc, lastwd, nresvr, nresvc, ncomr, ncomc, ( - integer *)0, (char *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0); - } - -/* Subroutine */ int dasufs_(integer *handle, integer *nresvr, integer * - nresvc, integer *ncomr, integer *ncomc, integer *free, integer * - lastla, integer *lastrc, integer *lastwd) -{ - return dasfm_0_(8, (char *)0, (char *)0, (char *)0, handle, (integer *)0, - free, lastla, lastrc, lastwd, nresvr, nresvc, ncomr, ncomc, ( - integer *)0, (char *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0); - } - -/* Subroutine */ int dashlu_(integer *handle, integer *unit) -{ - return dasfm_0_(9, (char *)0, (char *)0, (char *)0, handle, unit, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dasluh_(integer *unit, integer *handle) -{ - return dasfm_0_(10, (char *)0, (char *)0, (char *)0, handle, unit, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dashfn_(integer *handle, char *fname, ftnlen fname_len) -{ - return dasfm_0_(11, fname, (char *)0, (char *)0, handle, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dasfnh_(char *fname, integer *handle, ftnlen fname_len) -{ - return dasfm_0_(12, fname, (char *)0, (char *)0, handle, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, (char * - )0, fname_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dashof_(integer *fhset) -{ - return dasfm_0_(13, (char *)0, (char *)0, (char *)0, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, fhset, - (char *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dassih_(integer *handle, char *access, ftnlen access_len) -{ - return dasfm_0_(14, (char *)0, (char *)0, (char *)0, handle, (integer *)0, - (integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer - *)0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, - access, (ftnint)0, (ftnint)0, (ftnint)0, access_len); - } - -/* Subroutine */ int dasham_(integer *handle, char *access, ftnlen access_len) -{ - return dasfm_0_(15, (char *)0, (char *)0, (char *)0, handle, (integer *)0, - (integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer - *)0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, - access, (ftnint)0, (ftnint)0, (ftnint)0, access_len); - } - diff --git a/ext/spice/src/cspice/dasine.c b/ext/spice/src/cspice/dasine.c deleted file mode 100644 index 68e6f51c1d..0000000000 --- a/ext/spice/src/cspice/dasine.c +++ /dev/null @@ -1,176 +0,0 @@ -/* dasine.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DASINE (arc sine of bracketed argument) */ -doublereal dasine_(doublereal *arg, doublereal *tol) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - - /* Builtin functions */ - double asin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* This routine produces a SPICE error if the |argument| exceeds */ -/* 1.D0 by more than TOL. If ARG exceeds 1.D0, the argument is */ -/* evaluated as if it equaled 1.D0, if ARG is less than -1., */ -/* the argument is evaluated as if it equaled -1.D0. */ - -/* $ 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 */ - -/* INTERVALS, NUMBERS, UTILITY, INVERSE TRIGONOMETRIC FUNCTION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARG I Argument to be evaluated. */ -/* TOL I Tolerance. */ -/* DASINE O The function returns the arc sine of ARG. */ - -/* $ Detailed_Input */ - -/* ARG is the arc sine argument that is to be evaluated */ -/* such that if it is less than -1.D0 by more than TOL */ -/* or greater than 1.D0 by more than TOL, an error */ -/* results. */ - -/* TOL is a tolerance such that |ARG| is considered to be */ -/* equal to 1.D0 if |ARG| <= 1.D0 + TOL. TOL must be */ -/* non-negative. */ - -/* $ Detailed_Output */ - -/* DASINE The function returns the arc sine of ARG. If |ARG| */ -/* >= 1.D0, it returns DASIN (1.D0) or DASIN (-1.D0) as */ -/* appropriate. Values range from -PI/2 to PI/2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If |ARG| > 1.D0 + TOL, the error SPICE(INPUTOUTOFBOUNDS) is */ -/* signaled. */ - -/* 2) If TOL is less than zero, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether |ARG| > 1.D0 + TOL. If */ -/* it is, an error will be flagged. In addition, */ -/* the values of ARG are constrained to [-1.D0, 1.D0]. */ - -/* $ Examples */ - -/* The following illustrate the operation of DASINE. */ - -/* DASINE ( -1.D0, 1.D-7 ) = -PI/2 */ -/* DASINE ( -1.00001D0, 1.D-3 ) = -PI/2 */ -/* DASINE ( -1.00001D0, 1.D-7 ) = -PI/2 (error flagged) */ -/* DASINE ( 0.D0, 1.D-7 ) = 0.D0 */ -/* DASINE ( 1.00001D0, 1.D-3 ) = PI/2 */ -/* DASINE ( 1.00001D0, 1.D-7 ) = PI/2 (error flagged) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* L.S. Elson (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 28-FEB-2006 (LSE) */ - -/* -& */ -/* $ Index_Entries */ - -/* check a d.p. argument for ASIN before evaluation */ - -/* -& */ - -/* Bracket ARG. */ - -/* Computing MAX */ - d__1 = -1., d__2 = min(1.,*arg); - ret_val = asin((max(d__1,d__2))); - -/* Check that tolerance is non negative. */ - - if (*tol < 0.) { - chkin_("DASINE", (ftnlen)6); - setmsg_("TOL was #; must be non-negative.", (ftnlen)32); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DASINE", (ftnlen)6); - return ret_val; - } - -/* Check to see if |ARG| is within TOL of 1.D0. Signal error if */ -/* appropriate. */ - - if (abs(*arg) - *tol > 1.) { - chkin_("DASINE", (ftnlen)6); - setmsg_("The |argument| specified was greater than 1.D0 by more than" - " #. The value of the argument is #. ", (ftnlen)95); - errdp_("#", tol, (ftnlen)1); - errdp_("#", arg, (ftnlen)1); - sigerr_("SPICE(INPUTOUTOFBOUNDS)", (ftnlen)23); - chkout_("DASINE", (ftnlen)6); - return ret_val; - } - return ret_val; -} /* dasine_ */ - diff --git a/ext/spice/src/cspice/dasioc.c b/ext/spice/src/cspice/dasioc.c deleted file mode 100644 index 2bf20f22a9..0000000000 --- a/ext/spice/src/cspice/dasioc.c +++ /dev/null @@ -1,299 +0,0 @@ -/* dasioc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure DASIOC ( DAS, Fortran I/O, character ) */ -/* Subroutine */ int dasioc_(char *action, integer *unit, integer *recno, - char *record, ftnlen action_len, ftnlen record_len) -{ - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___2 = { 1, 0, 1, 0, 0 }; - static cilist io___3 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Perform Fortran reads and writes of character records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action to take (read or write). */ -/* UNIT I Fortran unit connected to DAS file. */ -/* RECNO I Number of record to read or write. */ -/* RECORD I-O DAS character record. */ - -/* $ Detailed_Input */ - -/* ACTION is a character string specifying whether to read */ -/* from or write to the specified DAS file. Possible */ -/* values are: */ - -/* 'READ' */ -/* 'WRITE' */ - -/* Case and leading or trailing blanks are not */ -/* significant. */ - - -/* UNIT is the Fortran unit number connected to the DAS */ -/* file that is to be read or written. Given the */ -/* handle of the DAS file, the unit number can be */ -/* obtained using DASHLU. */ - -/* RECNO is the Fortran record number of the record to be */ -/* read or written. */ - -/* RECORD is a character array whose contents are to be */ -/* written to record RECNO, if ACTION is WRITE. */ - -/* $ Detailed_Output */ - -/* RECORD is a character array whose contents are to be */ -/* set equal to those of record RECNO, if ACTION is */ -/* READ. */ - -/* $ Parameters */ - -/* NWC is the number of characters in a DAS character */ -/* record. */ - -/* $ Exceptions */ - -/* 1) If the value of ACTION is not recognized, the error */ -/* SPICE(UNRECOGNIZEDACTION) is signalled. */ - -/* 2) If a Fortran read error occurs, the error */ -/* SPICE(DASFILEREADFAILED) is signalled. */ - -/* 3) If a Fortran write error occurs, the error */ -/* SPICE(DASFILEWRITEFAILED) is signalled. */ - -/* $ Files */ - -/* See the description of the argument UNIT in $Detailed_Input. */ - -/* $ Particulars */ - -/* Normally, routines outside of SPICELIB will not need to call this */ -/* routine directly. Writes to DAS files should be performed using */ -/* the DASADx and DASUDx routines; reads should be performed using */ -/* the DASRDx routines. */ - -/* This routines centralizes I/O and the concommitant error handling */ -/* for DAS character records. */ - -/* Although most DAS routines use file handles to indentify DAS */ -/* files, this routine uses Fortran logical units for this purpose. */ -/* Using unit numbers allows the DASIOx routines to be called from */ -/* any DAS routine, including entry points of DASFM. (DASFM */ -/* contains as entry points the routines DASHLU and DASLUH, which */ -/* map between handles and unit numbers.) */ - -/* $ Examples */ - -/* 1) Read and print to the screen character records number 10 */ -/* through 20 from the DAS file designated by HANDLE. */ - -/* CHARACTER*(NWC) RECORD */ - -/* . */ -/* . */ -/* . */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ -/* CALL DASHFN ( HANDLE, NAME ) */ - -/* DO I = 1, 20 */ - -/* CALL DASIOC ( 'READ', UNIT, 10, RECORD ) */ - -/* LABEL = 'Contents of the # record in DAS file #: ' */ - -/* CALL REPMOT ( LABEL, '#', I, 'L', LABEL ) */ -/* CALL REPMC ( LABEL, '#', NAME, LABEL ) */ - -/* WRITE (*,*) LABEL */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) RECORD */ - -/* END DO */ - - - -/* 2) Write the contents of the string RECORD to record number */ -/* 10 in the DAS file designated by HANDLE. */ - - -/* CHARACTER*(NWC) RECORD */ - -/* . */ -/* . */ -/* . */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ -/* CALL DASIOC ( 'WRITE', UNIT, 10, RECORD ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* perform Fortran reads of character records */ -/* perform Fortran writes of character records */ -/* perform low-level I/O for DAS routines */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - if (eqstr_(action, "READ", action_len, (ftnlen)4)) { - -/* We're supposed to read the file. */ - - io___2.ciunit = *unit; - io___2.cirec = *recno; - iostat = s_rdue(&io___2); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, record, (ftnlen)1024); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - chkin_("DASIOC", (ftnlen)6); - setmsg_("Could not read DAS character record. File = # Record " - "number = #. IOSTAT = #.", (ftnlen)79); - errfnm_("#", unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24); - chkout_("DASIOC", (ftnlen)6); - return 0; - } - } else if (eqstr_(action, "WRITE", action_len, (ftnlen)5)) { - -/* We're supposed to write to the file. */ - - io___3.ciunit = *unit; - io___3.cirec = *recno; - iostat = s_wdue(&io___3); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, record, (ftnlen)1024); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - chkin_("DASIOC", (ftnlen)6); - setmsg_("Could not write DAS character record. File = # Record" - " number = #. IOSTAT = #.", (ftnlen)80); - errfnm_("#", unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25); - chkout_("DASIOC", (ftnlen)6); - return 0; - } - } else { - -/* The requested action is a little too weird. */ - - chkin_("DASIOC", (ftnlen)6); - setmsg_("Action was #; should be READ or WRITE", (ftnlen)37); - errch_("#", action, (ftnlen)1, action_len); - sigerr_("SPICE(UNRECOGNIZEDACTION)", (ftnlen)25); - chkout_("DASIOC", (ftnlen)6); - return 0; - } - return 0; -} /* dasioc_ */ - diff --git a/ext/spice/src/cspice/dasiod.c b/ext/spice/src/cspice/dasiod.c deleted file mode 100644 index b17d4424fa..0000000000 --- a/ext/spice/src/cspice/dasiod.c +++ /dev/null @@ -1,301 +0,0 @@ -/* dasiod.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__128 = 128; - -/* $Procedure DASIOD ( DAS, Fortran I/O, double precision ) */ -/* Subroutine */ int dasiod_(char *action, integer *unit, integer *recno, - doublereal *record, ftnlen action_len) -{ - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___2 = { 1, 0, 1, 0, 0 }; - static cilist io___3 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Perform Fortran reads and writes of double precision records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action to take (read or write). */ -/* UNIT I Fortran unit connected to DAS file. */ -/* RECNO I Number of record to read or write. */ -/* RECORD I-O DAS double precision record. */ - -/* $ Detailed_Input */ - -/* ACTION is a character string specifying whether to read */ -/* from or write to the specified DAS file. Possible */ -/* values are: */ - -/* 'READ' */ -/* 'WRITE' */ - -/* Case and leading or trailing blanks are not */ -/* significant. */ - - -/* UNIT is the Fortran unit number connected to the DAS */ -/* file that is to be read or written. Given the */ -/* handle of the DAS file, the unit number can be */ -/* obtained using DASHLU. */ - -/* RECNO is the Fortran record number of the record to be */ -/* read or written. */ - -/* RECORD is a double precision array whose contents are to */ -/* be written to record RECNO, if ACTION is WRITE. */ - -/* $ Detailed_Output */ - -/* RECORD is a double precision array whose contents are to */ -/* be set equal to those of record RECNO, if ACTION */ -/* is READ. */ - -/* $ Parameters */ - -/* NWD is the number of elements in a DAS double precision */ -/* record. */ - -/* $ Exceptions */ - -/* 1) If the value of ACTION is not recognized, the error */ -/* SPICE(UNRECOGNIZEDACTION) is signalled. */ - -/* 2) If a Fortran read error occurs, the error */ -/* SPICE(DASFILEREADFAILED) is signalled. */ - -/* 3) If a Fortran write error occurs, the error */ -/* SPICE(DASFILEWRITEFAILED) is signalled. */ - -/* $ Files */ - -/* See the description of the argument UNIT in $Detailed_Input. */ - -/* $ Particulars */ - -/* Normally, routines outside of SPICELIB will not need to call this */ -/* routine directly. Writes to DAS files should be performed using */ -/* the DASADx and DASUDx routines; reads should be performed using */ -/* the DASRDx routines. */ - -/* This routines centralizes I/O and the concommitant error handling */ -/* for DAS character records. */ - -/* Although most DAS routines use file handles to indentify DAS */ -/* files, this routine uses Fortran logical units for this purpose. */ -/* Using unit numbers allows the DASIOx routines to be called from */ -/* any DAS routine, including entry points of DASFM. (DASFM */ -/* contains as entry points the routines DASHLU and DASLUH, which */ -/* map between handles and unit numbers.) */ - -/* $ Examples */ - -/* 1) Read and print to the screen double precision records */ -/* number 10 through 20 from the DAS file designated by HANDLE. */ - - -/* DOUBLE PRECISION RECORD ( NWD ) */ -/* . */ -/* . */ -/* . */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ -/* CALL DASHFN ( HANDLE, NAME ) */ - -/* DO I = 1, 20 */ - -/* CALL DASIOD ( 'READ', UNIT, 10, RECORD ) */ - -/* LABEL = 'Contents of the # record in DAS file #: ' */ - -/* CALL REPMOT ( LABEL, '#', I, 'L', LABEL ) */ -/* CALL REPMC ( LABEL, '#', NAME, LABEL ) */ - -/* WRITE (*,*) LABEL */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) RECORD */ - -/* END DO */ - - - -/* 2) Write the contents of the array RECORD to record number */ -/* 10 in the DAS file designated by HANDLE. */ - - -/* DOUBLE PRECISION RECORD ( NWD ) */ - -/* . */ -/* . */ -/* . */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ -/* CALL DASIOD ( 'WRITE', UNIT, 10, RECORD ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* perform Fortran reads of double precision records */ -/* perform Fortran writes of double precision records */ -/* perform low-level I/O for DAS routines */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - if (eqstr_(action, "READ", action_len, (ftnlen)4)) { - -/* We're supposed to read the file. */ - - io___2.ciunit = *unit; - io___2.cirec = *recno; - iostat = s_rdue(&io___2); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - chkin_("DASIOD", (ftnlen)6); - setmsg_("Could not read DAS double precision record. File = # Re" - "cord number = #. IOSTAT = #.", (ftnlen)83); - errfnm_("#", unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24); - chkout_("DASIOD", (ftnlen)6); - return 0; - } - } else if (eqstr_(action, "WRITE", action_len, (ftnlen)5)) { - -/* We're supposed to write to the file. */ - - io___3.ciunit = *unit; - io___3.cirec = *recno; - iostat = s_wdue(&io___3); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - chkin_("DASIOD", (ftnlen)6); - setmsg_("Could not write DAS double precision record. File = # R" - "ecord number = #. IOSTAT = #.", (ftnlen)84); - errfnm_("#", unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25); - chkout_("DASIOD", (ftnlen)6); - return 0; - } - } else { - -/* The requested action is a little too weird. */ - - chkin_("DASIOD", (ftnlen)6); - setmsg_("Action was #; should be READ or WRITE", (ftnlen)37); - errch_("#", action, (ftnlen)1, action_len); - sigerr_("SPICE(UNRECOGNIZEDACTION)", (ftnlen)25); - chkout_("DASIOD", (ftnlen)6); - return 0; - } - return 0; -} /* dasiod_ */ - diff --git a/ext/spice/src/cspice/dasioi.c b/ext/spice/src/cspice/dasioi.c deleted file mode 100644 index 28c82f23cc..0000000000 --- a/ext/spice/src/cspice/dasioi.c +++ /dev/null @@ -1,297 +0,0 @@ -/* dasioi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__256 = 256; - -/* $Procedure DASIOI ( DAS, Fortran I/O, integer ) */ -/* Subroutine */ int dasioi_(char *action, integer *unit, integer *recno, - integer *record, ftnlen action_len) -{ - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___2 = { 1, 0, 1, 0, 0 }; - static cilist io___3 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Perform Fortran reads and writes of integer records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action to take (read or write). */ -/* UNIT I Fortran unit connected to DAS file. */ -/* RECNO I Number of record to read or write. */ -/* RECORD I-O DAS integer record. */ - -/* $ Detailed_Input */ - -/* ACTION is a character string specifying whether to read */ -/* from or write to the specified DAS file. Possible */ -/* values are: */ - -/* 'READ' */ -/* 'WRITE' */ - -/* Case and leading or trailing blanks are not */ -/* significant. */ - - -/* UNIT is the Fortran unit number connected to the DAS */ -/* file that is to be read or written. Given the */ -/* handle of the DAS file, the unit number can be */ -/* obtained using DASHLU. */ - -/* RECNO is the Fortran record number of the record to be */ -/* read or written. */ - -/* RECORD is an integer array whose contents are to be */ -/* written to record RECNO, if ACTION is WRITE. */ - -/* $ Detailed_Output */ - -/* RECORD is an integer array whose contents are to be */ -/* set equal to those of record RECNO, if ACTION */ -/* is READ. */ - -/* $ Parameters */ - -/* NWI is the number of elements in a DAS integer record. */ - -/* $ Exceptions */ - -/* 1) If the value of ACTION is not recognized, the error */ -/* SPICE(UNRECOGNIZEDACTION) is signalled. */ - -/* 2) If a Fortran read error occurs, the error */ -/* SPICE(DASFILEREADFAILED) is signalled. */ - -/* 3) If a Fortran write error occurs, the error */ -/* SPICE(DASFILEWRITEFAILED) is signalled. */ - -/* $ Files */ - -/* See the description of the argument UNIT in $Detailed_Input. */ - -/* $ Particulars */ - -/* Normally, routines outside of SPICELIB will not need to call this */ -/* routine directly. Writes to DAS files should be performed using */ -/* the DASADx and DASUDx routines; reads should be performed using */ -/* the DASRDx routines. */ - -/* This routines centralizes I/O and the concommitant error handling */ -/* for DAS character records. */ - -/* Although most DAS routines use file handles to indentify DAS */ -/* files, this routine uses Fortran logical units for this purpose. */ -/* Using unit numbers allows the DASIOx routines to be called from */ -/* any DAS routine, including entry points of DASFM. (DASFM */ -/* contains as entry points the routines DASHLU and DASLUH, which */ -/* map between handles and unit numbers.) */ - -/* $ Examples */ - -/* 1) Read and print to the screen integer records number 10 */ -/* through 20 from the DAS file designated by HANDLE. */ - -/* INTEGER RECORD ( NWI ) */ -/* . */ -/* . */ -/* . */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ -/* CALL DASHFN ( HANDLE, NAME ) */ - -/* DO I = 1, 20 */ - -/* CALL DASIOI ( 'READ', UNIT, 10, RECORD ) */ - -/* LABEL = 'Contents of the # record in DAS file #: ' */ - -/* CALL REPMOT ( LABEL, '#', I, 'L', LABEL ) */ -/* CALL REPMC ( LABEL, '#', NAME, LABEL ) */ - -/* WRITE (*,*) LABEL */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) RECORD */ - -/* END DO */ - - - -/* 2) Write the contents of the array RECORD to record number */ -/* 10 in the DAS file designated by HANDLE. */ - - -/* INTEGER RECORD ( NWI ) */ - -/* . */ -/* . */ -/* . */ - -/* CALL DASHLU ( HANDLE, UNIT ) */ -/* CALL DASIOI ( 'WRITE', UNIT, 10, RECORD ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* perform Fortran reads of integer records */ -/* perform Fortran writes of integer records */ -/* perform low-level I/O for DAS routines */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - if (eqstr_(action, "READ", action_len, (ftnlen)4)) { - -/* We're supposed to read the file. */ - - io___2.ciunit = *unit; - io___2.cirec = *recno; - iostat = s_rdue(&io___2); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__256, (char *)&record[0], (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - chkin_("DASIOI", (ftnlen)6); - setmsg_("Could not read DAS integer record. File = # Record numb" - "er = #. IOSTAT = #.", (ftnlen)74); - errfnm_("#", unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24); - chkout_("DASIOI", (ftnlen)6); - return 0; - } - } else if (eqstr_(action, "WRITE", action_len, (ftnlen)5)) { - -/* We're supposed to write to the file. */ - - io___3.ciunit = *unit; - io___3.cirec = *recno; - iostat = s_wdue(&io___3); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__256, (char *)&record[0], (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - chkin_("DASIOI", (ftnlen)6); - setmsg_("Could not write DAS integer record. File = # Record num" - "ber = #. IOSTAT = #.", (ftnlen)75); - errfnm_("#", unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25); - chkout_("DASIOI", (ftnlen)6); - return 0; - } - } else { - -/* The requested action is a little too weird. */ - - chkin_("DASIOI", (ftnlen)6); - setmsg_("Action was #; should be READ or WRITE", (ftnlen)37); - errch_("#", action, (ftnlen)1, action_len); - sigerr_("SPICE(UNRECOGNIZEDACTION)", (ftnlen)25); - chkout_("DASIOI", (ftnlen)6); - return 0; - } - return 0; -} /* dasioi_ */ - diff --git a/ext/spice/src/cspice/daslla.c b/ext/spice/src/cspice/daslla.c deleted file mode 100644 index edb4c1015b..0000000000 --- a/ext/spice/src/cspice/daslla.c +++ /dev/null @@ -1,204 +0,0 @@ -/* daslla.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DASLLA ( DAS, last logical addresses ) */ -/* Subroutine */ int daslla_(integer *handle, integer *lastc, integer *lastd, - integer *lasti) -{ - integer free; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc, ncomr; - extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - integer lastla[3], lastrc[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer lastwd[3], nresvc; - extern logical return_(void); - integer nresvr; - -/* $ Abstract */ - -/* Return last DAS logical addresses of character, double precision */ -/* and integer type that are currently in use in a specified DAS */ -/* file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* DAS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* LASTC O Last character address in use. */ -/* LASTD O Last double precision address in use. */ -/* LASTI O Last integer address in use. */ -/* CHR P Parameter indicating character data type. */ -/* DP P Parameter indicating double precision data type. */ -/* INT P Parameter indicating integerer data type. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a DAS file whose active */ -/* logical address ranges are desired. */ - -/* $ Detailed_Output */ - -/* LASTC, */ -/* LASTD, */ -/* LASTI are, respectively, the last logical addresses of */ -/* character, double precision, and integer type in */ -/* use in the specified DAS file. */ - -/* $ Parameters */ - -/* CHR, */ -/* DP, */ -/* INT are data type specifiers which indicate */ -/* `character', `double precision', and `integer' */ -/* respectively. These parameters are used in */ -/* all DAS routines that require a data type */ -/* specifier as input. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a utility that allows a calling program to */ -/* find the range of logical addresses currently in use in any */ -/* DAS file. */ - -/* $ Examples */ - -/* 1) Create a DAS file containing 10 integers, 5 double precision */ -/* numbers, and 4 characters, then use DASLLA to find the logical */ -/* address ranges in use. */ - -/* C */ -/* C Use a scratch file, since there's no reason to keep */ -/* C the file. */ -/* C */ -/* C */ -/* CALL DASOPS ( HANDLE ) */ - -/* DO I = 1, 10 */ -/* CALL DASADI ( HANDLE, 1, I ) */ -/* END DO */ - -/* DO I = 1, 5 */ -/* CALL DASADD ( HANDLE, 1, DBLE(I) ) */ -/* END DO */ - -/* CALL DASADC ( HANDLE, 1, 'SPUD' ) */ - -/* C */ -/* C Now check the logical address ranges. */ -/* C */ -/* CALL DASLLA ( HANDLE, LASTC, LASTD, LASTI ) */ - -/* WRITE (*,*) 'Last character address in use: ', LASTC */ -/* WRITE (*,*) 'Last d.p. address in use: ', LASTD */ -/* WRITE (*,*) 'Last integer address in use: ', LASTI */ - - -/* The output of this code fragment should be: */ - -/* Last character address in use: 4 */ -/* Last d.p. address in use: 5 */ -/* Last integer address in use: 10 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return last logical addresses in DAS file */ -/* return logical address range of DAS file */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASLLA", (ftnlen)6); - } - -/* The file summary for the indicated DAS file contains all of the */ -/* information we need. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - *lastc = lastla[0]; - *lastd = lastla[1]; - *lasti = lastla[2]; - chkout_("DASLLA", (ftnlen)6); - return 0; -} /* daslla_ */ - diff --git a/ext/spice/src/cspice/dasopr_c.c b/ext/spice/src/cspice/dasopr_c.c deleted file mode 100644 index 59eae61dad..0000000000 --- a/ext/spice/src/cspice/dasopr_c.c +++ /dev/null @@ -1,180 +0,0 @@ -/* - --Procedure dasopr_c ( DAS, open for read ) - --Abstract - - Open a DAS file for reading. - --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 - - DAS - --Keywords - - DAS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void dasopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of a DAS file to be opened. - handle O Handle assigned to the opened DAS file. - --Detailed_Input - - fname is the name of a DAS file to be opened with read - access. - --Detailed_Output - - handle is the handle that is associated with the file. This - handle is used to identify the file in subsequent - calls to other DAS routines. - --Parameters - - None. - --Files - - See argument `fname'. - --Exceptions - - 1) If the input filename is blank, the error SPICE(BLANKFILENAME) - will be signaled. - - 2) If the specified file does not exist, the error - SPICE(FILENOTFOUND) will be signaled. - - 3) If the specified file has already been opened for read - access, the handle already associated with the file is - returned. - - 4) If the specified file has already been opened for write - access, the error SPICE(DASRWCONFLICT) is signaled. - - 5) If the specified file has already been opened by a non-DAS - routine, the error SPICE(DASIMPROPOPEN) is signaled. - - 6) If the specified file cannot be opened without exceeding - the maximum allowed number of open DAS files, the error - SPICE(DASFTFULL) is signaled. - - 7) If the named file cannot be opened properly, the error - SPICE(DASOPENFAIL) is signaled. - - 8) If the file record cannot be read, the error - SPICE(FILEREADFAILED) will be signaled. - - 9) If the specified file is not a DAS file, as indicated by the - file's ID word, the error SPICE(NOTADASFILE) is signaled. - - 10) If no logical units are available, the error will be - signaled by routines called by this routine. - --Particulars - - Most DAS files require only read access. If you do not need to - change the contents of a file, you should open it using dasopr_c. - --Examples - - 1) Open the existing DAS file TEST.DAS for reading. - - dasopr_c ( "TEST.DAS", &handle ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 05-OCT-2006 (NJB) (KRG) (WLT) (FST) (IMU) - --Index_Entries - - open a DAS file for reading - open a DAS file for read access - --& -*/ - -{ /* Begin dasopr_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dasopr_c" ); - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "dasopr_c", fname ); - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - dasopr_ ( ( char * ) fname, - ( integer * ) handle, - ( ftnlen ) strlen(fname) ); - - - chkout_c ( "dasopr_c" ); - -} /* End dasopr_c */ diff --git a/ext/spice/src/cspice/dasrcr.c b/ext/spice/src/cspice/dasrcr.c deleted file mode 100644 index 18a8e65507..0000000000 --- a/ext/spice/src/cspice/dasrcr.c +++ /dev/null @@ -1,465 +0,0 @@ -/* dasrcr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__256 = 256; - -/* $Procedure DASRCR ( DAS, remove comment records ) */ -/* Subroutine */ int dasrcr_(integer *handle, integer *n) -{ - /* Initialized data */ - - static integer next[3] = { 2,3,1 }; - static integer prev[3] = { 3,1,2 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base; - char recc[1024]; - doublereal recd[128]; - integer free, reci[256], lrec, nrec, unit, type__, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc; - extern /* Subroutine */ int maxai_(integer *, integer *, integer *, - integer *); - integer ncomr, lword, ltype; - extern logical failed_(void); - extern /* Subroutine */ int cleari_(integer *, integer *), dasioc_(char *, - integer *, integer *, char *, ftnlen, ftnlen), dasiod_(char *, - integer *, integer *, doublereal *, ftnlen); - integer dirrec[256]; - extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *), - dassih_(integer *, char *, ftnlen), dasioi_(char *, integer *, - integer *, integer *, ftnlen); - integer lastla[3]; - extern /* Subroutine */ int dashlu_(integer *, integer *), daswbr_( - integer *); - integer lindex; - extern /* Subroutine */ int dasufs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - integer lastrc[3], nshift; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer lastwd[3], nresvc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - integer nresvr, loc, pos; - -/* $ Abstract */ - -/* Decrease the size of the comment area in a DAS file to reclaim */ -/* space freed by the removal of a specified number of comment */ -/* records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I A DAS file handle. */ -/* N I Number of comment records to remove. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an existing DAS file opened for */ -/* comment area modification by DASOPC. */ - -/* N is the number of records to remove from the end of */ -/* the comment area. of the specified file. If NCOMR */ -/* is the number of comment records present in the */ -/* file on input, then on output the number of comment */ -/* records will be MAX ( 0, NCOMR - N ). */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input handle is invalid, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 2) If an I/O error occurs during the removal process, the error */ -/* will be diagnosed by routines called by this routine. The */ -/* DAS file will probably be corrupted in this case. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is used to reclaim freed space in the comment area */ -/* of a DAS file subsequent to removal of comments from the file. */ -/* Any existing directory records and data records will be shifted */ -/* up by N records. */ - -/* This routine updates the file record of the specified DAS file */ -/* to reflect the addition of records to the file's comment area. */ -/* Also, the file summary obtainable from DASHFS will be updated to */ -/* reflect the addition of comment records. */ - -/* The disk space occupied by the specified DAS file will not */ -/* decrease as a result of calling this routine, but the number of */ -/* records occupied by meaningful data will decrease. The useful */ -/* records in the file can be copied by DAS routines to create a */ -/* new, smaller file which contains only the meaningful data. */ - -/* This routine may be used only on existing DAS files opened by */ -/* DASOPC. */ - -/* The association of DAS logical addresses and data within the */ -/* specified file will remain unaffected by use of this routine. */ - -/* Normally, SPICELIB applications will not call this routine */ -/* directly, but will remove comments by calling DASRC. */ - -/* This routine has an inverse DASACR, which appends a specified */ -/* number of records to the end of the comment area. */ - -/* $ Examples */ - - -/* C */ -/* C Open an existing DAS file for modification of */ -/* C the comment area. We'll presume that the file */ -/* C contains 20 comment records. */ -/* C */ -/* CALL DASOPC ( DAS, HANDLE ) */ - -/* C */ -/* C Remove the last 10 comment records from the file. */ -/* C */ -/* CALL DASRCR ( HANDLE, 10 ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove comment records from a DAS file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Words per data record, for each data type: */ - - -/* Data type parameters */ - - -/* Directory pointer locations (backward and forward): */ - - -/* Directory address range locations */ - - -/* Location of first type descriptor */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* NEXT and PREV map the DAS data type codes to their */ -/* successors and predecessors, respectively. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASRCR", (ftnlen)6); - } - -/* Make sure this DAS file is open for writing. Signal an error if */ -/* not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - -/* Get the logical unit for this DAS file. */ - - dashlu_(handle, &unit); - if (failed_()) { - chkout_("DASRCR", (ftnlen)6); - return 0; - } - -/* It's a mistake to use a negative value of N. */ - - if (*n < 0) { - setmsg_("Number of comment records to remove must be non-negative. " - "Actual number requested was #.", (ftnlen)89); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(DASINVALIDCOUNT)", (ftnlen)22); - chkout_("DASRCR", (ftnlen)6); - return 0; - } - -/* Before doing anything to the file, make sure that the DASRWR */ -/* data buffers do not contain any updated records for this file. */ -/* All of the record numbers that pertain to this file and remain */ -/* in the DASRWR buffers will be invalidated after this routine */ -/* returns. */ - -/* DASWBR flushes buffered records to the file. */ - - daswbr_(handle); - -/* Grab the file summary for this DAS file. Find the number of */ -/* reserved records and the number of the first free record. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - -/* Determine the size of the record shift we'll actually perform. */ - - nshift = min(*n,ncomr); - -/* Find the record and word positions LREC and LWORD of the last */ -/* descriptor in the file, and also find the type of the descriptor */ -/* LTYPE. */ - - maxai_(lastrc, &c__3, &lrec, &loc); - lword = 0; - for (i__ = 1; i__ <= 3; ++i__) { - if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", - i__1, "dasrcr_", (ftnlen)365)] == lrec && lastwd[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dasrc" - "r_", (ftnlen)365)] > lword) { - lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dasrcr_", (ftnlen)368)]; - ltype = i__; - } - } - -/* LREC, LWORD, and LTYPE are now the record, word, and data type */ -/* of the last descriptor in the file. If LREC is zero, there are */ -/* no directories in the file yet. However, even DAS files that */ -/* don't contain any data have their first directory records */ -/* zeroed out, and this should remain true after the removal of */ -/* the comment records. */ - - if (lrec == 0) { - -/* Just write the zero-filled record to record number */ - -/* NRESVR + NCOMR + 2 - NSHIFT */ - - cleari_(&c__256, dirrec); - i__1 = nresvr + ncomr + 2 - nshift; - dasioi_("WRITE", &unit, &i__1, dirrec, (ftnlen)5); - } else { - -/* There really is stuff to move. For each directory record, */ -/* move the record and then all of the records described by that */ -/* record. We start at the beginning of the data area and move */ -/* downwards in the file as we go. */ - - nrec = nresvr + ncomr + 2; - while(nrec <= lrec && nrec != 0) { - -/* Read the current directory record and move it. */ - - dasioi_("READ", &unit, &nrec, dirrec, (ftnlen)4); - i__1 = nrec - nshift; - dasioi_("WRITE", &unit, &i__1, dirrec, (ftnlen)5); - -/* For each descriptor in the current directory, move the */ -/* cluster of data records it refers to. */ - -/* Find the data type, size, and base record number of the */ -/* first cluster described by the current directory. Also */ -/* find the index within the directory of the directory's */ -/* last descriptor. */ - - type__ = dirrec[8]; - base = nrec + 1; - if (nrec == lrec) { - lindex = lword; - } else { - lindex = 256; - } - -/* We'll now traverse the directory in forward order, keeping */ -/* track of cluster sizes and types as we go. */ - -/* POS will be the index of the descriptor of the current */ -/* cluster. */ - - pos = 10; - while(pos <= lindex) { - if (pos > 10) { - -/* We'll need to determine the type of the current */ -/* cluster. If the descriptor contains a positive */ -/* value, the data type of the cluster it refers to is */ -/* the successor of the previous type, according to our */ -/* ordering of types. */ - - if (dirrec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("dirrec", i__1, "dasrcr_", (ftnlen)445)] > - 0) { - type__ = next[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("next", i__1, "dasrcr_", ( - ftnlen)446)]; - } else { - type__ = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("prev", i__1, "dasrcr_", ( - ftnlen)448)]; - } - -/* Update the cluster base record number. */ - - base += (i__2 = dirrec[(i__1 = pos - 2) < 256 && 0 <= - i__1 ? i__1 : s_rnge("dirrec", i__1, "dasrcr_", ( - ftnlen)454)], abs(i__2)); - } - -/* BASE and TYPE now are correctly set for the current */ -/* cluster. Move the cluster. */ - - i__3 = base + (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 <= - i__1 ? i__1 : s_rnge("dirrec", i__1, "dasrcr_", ( - ftnlen)462)], abs(i__2)) - 1; - for (i__ = base; i__ <= i__3; ++i__) { - if (type__ == 1) { - dasioc_("READ", &unit, &i__, recc, (ftnlen)4, (ftnlen) - 1024); - i__1 = i__ - nshift; - dasioc_("WRITE", &unit, &i__1, recc, (ftnlen)5, ( - ftnlen)1024); - } else if (type__ == 2) { - dasiod_("READ", &unit, &i__, recd, (ftnlen)4); - i__1 = i__ - nshift; - dasiod_("WRITE", &unit, &i__1, recd, (ftnlen)5); - } else { - dasioi_("READ", &unit, &i__, reci, (ftnlen)4); - i__1 = i__ - nshift; - dasioi_("WRITE", &unit, &i__1, reci, (ftnlen)5); - } - } - -/* The next descriptor to look at is the next one in the */ -/* current directory. */ - - ++pos; - } - -/* Find the next directory record. */ - - nrec = dirrec[1]; - } - } - -/* Update the file summary. The number of comment records and the */ -/* number of the first free record have been decremented by NSHIFT. */ -/* The numbers of the records containing the last descriptor of each */ -/* type have been decremented by NSHIFT only if they were non-zero. */ - - -/* The call to DASUFS will update the file record as well as the */ -/* file summary. */ - - ncomr -= nshift; - free -= nshift; - for (i__ = 1; i__ <= 3; ++i__) { - if (lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc", - i__3, "dasrcr_", (ftnlen)515)] != 0) { - lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc", - i__3, "dasrcr_", (ftnlen)516)] = lastrc[(i__1 = i__ - 1) - < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", i__1, "dasrcr_" - , (ftnlen)516)] - nshift; - } - } - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - chkout_("DASRCR", (ftnlen)6); - return 0; -} /* dasrcr_ */ - diff --git a/ext/spice/src/cspice/dasrdc.c b/ext/spice/src/cspice/dasrdc.c deleted file mode 100644 index aa7fb7341b..0000000000 --- a/ext/spice/src/cspice/dasrdc.c +++ /dev/null @@ -1,480 +0,0 @@ -/* dasrdc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure DASRDC ( DAS, read data, character ) */ -/* Subroutine */ int dasrdc_(integer *handle, integer *first, integer *last, - integer *bpos, integer *epos, char *data, ftnlen data_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer l, n, nread; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, nmove, rcpos; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int dasrrc_(integer *, integer *, integer *, - integer *, char *, ftnlen); - integer nmoved, clsize; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numchr; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - integer wordno, chr, elt; - -/* $ Abstract */ - -/* Read character data from a range of DAS logical addresses. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* FIRST, */ -/* LAST I Range of DAS character logical addresses. */ -/* BPOS, */ -/* EPOS I Begin and end positions of substrings. */ -/* DATA O Data having addresses FIRST through LAST. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle for an open DAS file. */ - -/* FIRST, */ -/* LAST are a range of DAS character logical addresses. */ -/* FIRST and LAST must be greater than or equal to */ -/* 1 and less than or equal to the highest character */ -/* logical address in the DAS file designated by */ -/* HANDLE. */ - -/* BPOS, */ -/* EPOS are begin and end character positions that define */ -/* the substrings of the elements of the output array */ -/* DATA into which character data is to be read. */ - -/* $ Detailed_Output */ - -/* DATA is an array of character strings. On output, the */ -/* character words in the logical address range */ -/* FIRST through LAST are copied into the characters */ - -/* DATA(1)(BPOS:BPOS), */ -/* DATA(1)(BPOS+1:BPOS+1), */ -/* . */ -/* . */ -/* . */ -/* DATA(1)(EPOS:EPOS), */ -/* DATA(2)(BPOS:BPOS), */ -/* DATA(2)(BPOS+1:BPOS+1), */ -/* . */ -/* . */ -/* . */ - -/* in that order. */ - -/* DATA must have dimension at least */ - -/* ( LAST - FIRST + L ) / L */ - -/* where */ - -/* L = EPOS - BPOS + 1 */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. DATA will */ -/* not be modified. */ - -/* 2) If EPOS or BPOS are outside of the range */ -/* [ 1, LEN( DATA(1) ) ], or if EPOS < BPOS, the error */ -/* SPICE(BADSUBSTRINGBOUNDS) will be signalled. */ - -/* 3) If FIRST or LAST are out of range, the error will be diagnosed */ -/* by routines called by this routine. DATA will not be */ -/* modified. */ - -/* 4) If FIRST is greater than LAST, DATA is left unchanged. */ - -/* 5) If DATA is declared with length less than */ - -/* ( LAST - FIRST + ( EPOS-BPOS+1 ) ) / ( EPOS-BPOS+1 ) */ - -/* the error cannot be diagnosed by this routine. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine provides random read access to the character data in */ -/* a DAS file. This data is logically structured as a */ -/* one-dimensional array of characters. */ - -/* However, since Fortran programs usually use strings rather */ -/* than arrays of individual characters, the interface of this */ -/* routine provides for extraction of data from a DAS file into */ -/* an array of strings. */ - -/* DASRDC allows the caller to control the amount of character data */ -/* read into each array element. This feature allows a program to */ -/* read character data into an array that has a different string */ -/* length from the one used to write the character data, without */ -/* losing the correspondence between input and output array elements. */ -/* For example, an array of strings of 32 characters can be written */ -/* to a DAS file and read back by DASRDC into a buffer of strings */ -/* having length 80 characters, mapping each 32-character string to */ -/* characters 1--32 of the output buffer. */ - - -/* $ Examples */ - -/* 1) Create the new DAS file TEST.DAS and add 240 characters to it. */ -/* Close the file, then re-open it and read the data back out. */ - - -/* PROGRAM TEST_ADD */ - -/* CHARACTER*(40) LINES ( 3 ) */ -/* CHARACTER*(80) BUFFER ( 3 ) */ -/* CHARACTER*(4) TYPE */ - -/* INTEGER FIRST */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER LAST */ - -/* DATA LINES / 'Here is the first line.', */ -/* . 'Here is the second line.', */ -/* . 'Here is the third line.' / */ - -/* C */ -/* C Open a new DAS file. Use the file name as */ -/* C the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Add the contents of the array LINES to the file. */ -/* C */ -/* CALL DASADC ( HANDLE, 120, 1, 40, LINES ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now verify the addition of data by opening the */ -/* C file for read access and retrieving the data. This */ -/* C time, use a buffer of 80-character strings to read */ -/* C the data. Use only the first 40 characters of each */ -/* C buffer element. */ -/* C */ -/* DO I = 1, 3 */ -/* BUFFER(I) = ' ' */ -/* END DO */ - -/* CALL DASRDC ( HANDLE, 1, 120, 1, 40, BUFFER ) */ - -/* C */ -/* C Dump the data to the screen. We should see the */ -/* C sequence */ -/* C */ -/* C Here is the first line. */ -/* C Here is the second line. */ -/* C Here is the third line. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data from TEST.DAS: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) BUFFER */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.2 03-JUL-1996 (NJB) */ - -/* Various errors in the header comments were fixed. */ - -/* - SPICELIB Version 1.2.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.2.0, 03-NOV-1995 (NJB) */ - -/* Routine now uses discovery check-in. FAILED test moved inside */ -/* loops. */ - -/* - SPICELIB Version 1.2.0, 14-SEP-1995 (NJB) */ - -/* Bug fix: reference to DASADS in CHKOUT calls corrected. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination conditions. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read character data from a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 03-NOV-1995 (NJB) */ - -/* Routine now uses discovery check-in. FAILED test moved inside */ -/* loops. */ - -/* - SPICELIB Version 1.2.0, 14-SEP-1995 (NJB) */ - -/* Bug fix: reference to DASADS in CHKOUT calls corrected. */ -/* These references have been changed to 'DASRDC'. */ - - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination conditions. Without */ -/* this test, an infinite loop could result if DASA2L or DASRRC */ -/* signaled an error inside the loops. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Make sure BPOS and EPOS are ok; stop here if not. */ - - if (*bpos < 1 || *epos < 1 || *bpos > i_len(data, data_len) || *epos > - i_len(data, data_len)) { - chkin_("DASRDC", (ftnlen)6); - setmsg_("Substring bounds must be in range [1,#]. Actual range [BPOS" - ",EPOS] was [#,#].", (ftnlen)76); - i__1 = i_len(data, data_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", bpos, (ftnlen)1); - errint_("#", epos, (ftnlen)1); - sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25); - chkout_("DASRDC", (ftnlen)6); - return 0; - } else if (*epos < *bpos) { - chkin_("DASRDC", (ftnlen)6); - setmsg_("Substring upper bound must not be less than lower bound. A" - "ctual range [BPOS,EPOS] was [#,#].", (ftnlen)93); - errint_("#", bpos, (ftnlen)1); - errint_("#", epos, (ftnlen)1); - sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25); - chkout_("DASRDC", (ftnlen)6); - return 0; - } - -/* Find out the physical location of the first character to read. If */ -/* FIRST is out of range, DASA2L will cause an error to be signalled. */ - - dasa2l_(handle, &c__1, first, &clbase, &clsize, &recno, &wordno); - -/* Get the length of the elements of DATA. Count the total number */ -/* of characters to read. */ - - l = *epos - *bpos + 1; - n = *last - *first + 1; - nread = 0; - -/* Read as much data from record RECNO as is necessary and possible. */ - -/* Computing MIN */ - i__1 = n, i__2 = 1024 - wordno + 1; - numchr = min(i__1,i__2); - elt = 1; - chr = *bpos; - nmoved = 0; - rcpos = wordno; - while(nmoved < numchr) { - if (failed_()) { - return 0; - } - if (chr > *epos) { - ++elt; - chr = *bpos; - } - -/* Find out how many characters to move from the current record */ -/* to the current array element. */ - -/* Computing MIN */ - i__1 = numchr - nmoved, i__2 = *epos - chr + 1; - nmove = min(i__1,i__2); - i__1 = rcpos + nmove - 1; - dasrrc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * data_len + - (chr - 1)), chr + nmove - 1 - (chr - 1)); - nmoved += nmove; - rcpos += nmove; - chr += nmove; - } - nread = numchr; - ++recno; - -/* Read from as many additional records as necessary. */ - - while(nread < n) { - if (failed_()) { - return 0; - } - -/* At this point, RECNO is the correct number of the */ -/* record to read from next. CLBASE is the number */ -/* of the first record of the cluster we're about */ -/* to read from. */ - - - if (recno < clbase + clsize) { - -/* We can continue reading from the current cluster. Find */ -/* out how many elements to read from the current record, */ -/* and read them. */ - -/* Computing MIN */ - i__1 = n - nread; - numchr = min(i__1,1024); - nmoved = 0; - rcpos = 1; - while(nmoved < numchr && ! failed_()) { - if (chr > *epos) { - ++elt; - chr = *bpos; - } - -/* Find out how many characters to move from the current */ -/* record to the current array element. */ - -/* Computing MIN */ - i__1 = numchr - nmoved, i__2 = *epos - chr + 1; - nmove = min(i__1,i__2); - i__1 = rcpos + nmove - 1; - dasrrc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * - data_len + (chr - 1)), chr + nmove - 1 - (chr - 1)); - nmoved += nmove; - rcpos += nmove; - chr += nmove; - } - nread += numchr; - ++recno; - } else { - -/* We must find the next character cluster to */ -/* read from. The first character in this */ -/* cluster has address FIRST + NREAD. */ - - i__1 = *first + nread; - dasa2l_(handle, &c__1, &i__1, &clbase, &clsize, &recno, &wordno); - } - } - return 0; -} /* dasrdc_ */ - diff --git a/ext/spice/src/cspice/dasrdd.c b/ext/spice/src/cspice/dasrdd.c deleted file mode 100644 index c91b43c9a2..0000000000 --- a/ext/spice/src/cspice/dasrdd.c +++ /dev/null @@ -1,328 +0,0 @@ -/* dasrdd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; - -/* $Procedure DASRDD ( DAS, read data, double precision ) */ -/* Subroutine */ int dasrdd_(integer *handle, integer *first, integer *last, - doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer n, nread, recno, numdp; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int dasrrd_(integer *, integer *, integer *, - integer *, doublereal *); - integer clsize, wordno; - -/* $ Abstract */ - -/* Read double precision data from a range of DAS logical addresses. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* FIRST, */ -/* LAST I Range of DAS double precision logical addresses. */ -/* DATA O Data having addresses FIRST through LAST. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle for an open DAS file. */ - -/* FIRST, */ -/* LAST are a range of DAS double precision logical */ -/* addresses. FIRST and LAST must be greater than or */ -/* equal to 1 and less than or equal to the highest */ -/* double precision logical address in the DAS file */ -/* designated by HANDLE. */ - -/* $ Detailed_Output */ - -/* DATA is an array of double precision numbers. DATA */ -/* should have length at least LAST - FIRST + 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. DATA will */ -/* not be modified. */ - -/* 2) If FIRST or LAST are out of range, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 3) If FIRST is greater than LAST, DATA is left unchanged. */ - -/* 4) If DATA is declared with length less than FIRST - LAST + 1, */ -/* the error cannot be diagnosed by this routine. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine provides random read access to the double precision */ -/* data in a DAS file. This data is logically structured as a */ -/* one-dimensional array of double precision numbers. */ - -/* $ Examples */ - -/* 1) Create the new DAS file TEST.DAS and add 200 double */ -/* precision numbers to it. Close the file, then re-open */ -/* it and read the data back out. */ - -/* PROGRAM TEST_READ */ - -/* CHARACTER*(4) TYPE */ - -/* DOUBLE PRECISION DATA ( 200 ) */ - -/* INTEGER FIRST */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER LAST */ -/* C */ -/* C Open a new DAS file. Use the file name as */ -/* C the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Fill the array DATA with the double precision */ -/* C numbers 1.D0 through 100.D0, and add this array */ -/* C to the file. */ -/* C */ -/* DO I = 1, 100 */ -/* DATA(I) = DBLE(I) */ -/* END DO */ - -/* CALL DASADD ( HANDLE, 100, DATA, FIRST, LAST ) */ - -/* C */ -/* C Now append the array DATA to the file again. */ -/* C */ -/* CALL DASADD ( HANDLE, 100, DATA, FIRST, LAST ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now verify the addition of data by opening the */ -/* C file for read access and retrieving the data. */ -/* C */ -/* CALL DASRDD ( HANDLE, 1, 200, DATA ) */ - -/* C */ -/* C Dump the data to the screen. We should see the */ -/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. The */ -/* C numbers will be represented as double precision */ -/* C numbers in the output. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data from TEST.DAS: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) DATA */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.2.0, 01-NOV-1995 (NJB) */ - -/* Routine now uses discovery check-in. FAILED test moved inside */ -/* loop. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 13-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read double precision data from a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 30-OCT-1995 (NJB) */ - -/* Routine now uses discovery check-in. FAILED test moved inside */ -/* loop. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L or DASRRD */ -/* signaled an error inside the loop. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 13-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Find out the physical location of the first double precision */ -/* number. If FIRST is invalid, DASA2L will take care of the */ -/* problem. */ - - dasa2l_(handle, &c__2, first, &clbase, &clsize, &recno, &wordno); - -/* Decide how many double precision numbers to read. */ - - numdp = *last - *first + 1; - nread = 0; - -/* Read as much data from record RECNO as necessary. */ - -/* Computing MIN */ - i__1 = numdp, i__2 = 128 - wordno + 1; - n = min(i__1,i__2); - i__1 = wordno + n - 1; - dasrrd_(handle, &recno, &wordno, &i__1, data); - nread = n; - ++recno; - -/* Read from as many additional records as necessary. */ - - while(nread < numdp) { - if (failed_()) { - return 0; - } - -/* At this point, RECNO is the correct number of the */ -/* record to read from next. CLBASE is the number */ -/* of the first record of the cluster we're about */ -/* to read from. */ - - if (recno < clbase + clsize) { - -/* We can continue reading from the current */ -/* cluster. */ - -/* Computing MIN */ - i__1 = numdp - nread; - n = min(i__1,128); - dasrrd_(handle, &recno, &c__1, &n, &data[nread]); - nread += n; - ++recno; - } else { - -/* We must find the next double precision cluster to */ -/* read from. The first double precision number in this */ -/* cluster has address FIRST + NREAD. */ - - i__1 = *first + nread; - dasa2l_(handle, &c__2, &i__1, &clbase, &clsize, &recno, &wordno); - } - } - return 0; -} /* dasrdd_ */ - diff --git a/ext/spice/src/cspice/dasrdi.c b/ext/spice/src/cspice/dasrdi.c deleted file mode 100644 index ba8fd28f72..0000000000 --- a/ext/spice/src/cspice/dasrdi.c +++ /dev/null @@ -1,325 +0,0 @@ -/* dasrdi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure DASRDI ( DAS, read data, integer ) */ -/* Subroutine */ int dasrdi_(integer *handle, integer *first, integer *last, - integer *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer n, nread, recno; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int dasrri_(integer *, integer *, integer *, - integer *, integer *); - integer clsize, wordno, numint; - -/* $ Abstract */ - -/* Read integer data from a range of DAS logical addresses. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* FIRST, */ -/* LAST I Range of DAS integer logical addresses. */ -/* DATA O Data having addresses FIRST through LAST. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle for an open DAS file. */ - -/* FIRST, */ -/* LAST are a range of DAS integer logical addresses. */ -/* FIRST and LAST must be greater than or equal to */ -/* 1 and less than or equal to the highest integer */ -/* logical address in the DAS file designated by */ -/* HANDLE. */ - -/* $ Detailed_Output */ - -/* DATA is an array of integers. DATA should have length */ -/* at least LAST - FIRST + 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. DATA will */ -/* not be modified. */ - -/* 2) If FIRST or LAST are out of range, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 3) If FIRST is greater than LAST, DATA is left unchanged. */ - -/* 4) If DATA is declared with length less than FIRST - LAST + 1, */ -/* the error cannot be diagnosed by this routine. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine provides random read access to the integer data in */ -/* a DAS file. This data is logically structured as a */ -/* one-dimensional array of integers. */ - -/* $ Examples */ - - -/* 1) Create the new DAS file TEST.DAS and add 200 integers to it. */ -/* Close the file, then re-open it and read the data back out. */ - - -/* PROGRAM TEST_READ */ - -/* CHARACTER*(4) TYPE */ - -/* INTEGER DATA ( 200 ) */ - -/* INTEGER FIRST */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER LAST */ -/* C */ -/* C Open a new DAS file. Use the file name as */ -/* C the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Fill the array DATA with the integers 1 through */ -/* C 100, and add this array to the file. */ -/* C */ -/* DO I = 1, 100 */ -/* DATA(I) = I */ -/* END DO */ - -/* CALL DASADI ( HANDLE, 100, DATA, FIRST, LAST ) */ - -/* C */ -/* C Now append the array DATA to the file again. */ -/* C */ -/* CALL DASADI ( HANDLE, 100, DATA, FIRST, LAST ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now verify the addition of data by opening the */ -/* C file for read access and retrieving the data. */ -/* C */ -/* CALL DASRDI ( HANDLE, 1, 200, DATA ) */ - -/* C */ -/* C Dump the data to the screen. We should see the */ -/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data from TEST.DAS: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) DATA */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.2.0, 30-OCT-1995 (NJB) */ - -/* Routine now uses discovery check-in. FAILED test moved inside */ -/* loop. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 13-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read integer data from a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 30-OCT-1995 (NJB) */ - -/* Routine now uses discovery check-in. FAILED test moved inside */ -/* loop. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L or DASRRI */ -/* signaled an error inside the loop. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 13-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Find out the physical location of the first integer. If FIRST */ -/* is invalid, DASA2L will take care of the problem. */ - - dasa2l_(handle, &c__3, first, &clbase, &clsize, &recno, &wordno); - -/* Decide how many integers to read. */ - - numint = *last - *first + 1; - nread = 0; - -/* Read as much data from record RECNO as necessary. */ - -/* Computing MIN */ - i__1 = numint, i__2 = 256 - wordno + 1; - n = min(i__1,i__2); - i__1 = wordno + n - 1; - dasrri_(handle, &recno, &wordno, &i__1, data); - nread = n; - ++recno; - -/* Read from as many additional records as necessary. */ - - while(nread < numint) { - if (failed_()) { - return 0; - } - -/* At this point, RECNO is the correct number of the */ -/* record to read from next. CLBASE is the number */ -/* of the first record of the cluster we're about */ -/* to read from. */ - - if (recno < clbase + clsize) { - -/* We can continue reading from the current */ -/* cluster. */ - -/* Computing MIN */ - i__1 = numint - nread; - n = min(i__1,256); - dasrri_(handle, &recno, &c__1, &n, &data[nread]); - nread += n; - ++recno; - } else { - -/* We must find the next integer cluster to */ -/* read from. The first integer in this */ -/* cluster has address FIRST + NREAD. */ - - i__1 = *first + nread; - dasa2l_(handle, &c__3, &i__1, &clbase, &clsize, &recno, &wordno); - } - } - return 0; -} /* dasrdi_ */ - diff --git a/ext/spice/src/cspice/dasrfr.c b/ext/spice/src/cspice/dasrfr.c deleted file mode 100644 index ff92ad94a2..0000000000 --- a/ext/spice/src/cspice/dasrfr.c +++ /dev/null @@ -1,322 +0,0 @@ -/* dasrfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure DASRFR ( DAS, read file record ) */ -/* Subroutine */ int dasrfr_(integer *handle, char *idword, char *ifname, - integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, - ftnlen idword_len, ftnlen ifname_len) -{ - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen); - char tmpifn[60]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer iostat; - char tmpidw[8]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___3 = { 1, 0, 1, 0, 1 }; - - -/* $ Abstract */ - -/* Return the contents of the file record of a specified DAS */ -/* file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* IDWORD O ID word. */ -/* IFNAME O DAS internal file name. */ -/* NRESVR O Number of reserved records in file. */ -/* NRESVC O Number of characters in use in reserved rec. area. */ -/* NCOMR O Number of comment records in file. */ -/* NCOMC O Number of characters in use in comment area. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle for a previously opened DAS file. */ - -/* $ Detailed_Output */ - -/* IDWORD is the `ID word' contained in the first eight */ -/* characters of the file record. */ - -/* IFNAME is the internal file name of the DAS file. The */ -/* maximum length of the internal file name is 60 */ -/* characters. */ - -/* NRESVR is the number of reserved records in the DAS file */ -/* specified by HANDLE. */ - -/* NRESVC is the number of characters in use in the reserved */ -/* record area of the DAS file specified by HANDLE. */ - -/* NCOMR is the number of comment records in the DAS file */ -/* specified by HANDLE. */ - -/* NCOMC is the number of characters in use in the comment area */ -/* of the DAS file specified by HANDLE. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file read attempted by this routine fails, the error */ -/* SPICE(DASFILEREADFAILED) will be signalled. */ - -/* $ Files */ - -/* See the description of HANDLE under $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine provides a convenient way of retrieving the */ -/* information contained in the file record of a DAS file. */ - -/* $ Examples */ - -/* 1) Obtain the internal file name of an existing DAS file. */ - - -/* C */ -/* C Open the file for reading. */ -/* C */ -/* CALL DASOPR ( FNAME, HANDLE ) */ - -/* C */ -/* C Retrieve the internal file name and print it. */ -/* C */ - -/* CALL DASRFR ( HANDLE, */ -/* . IDWORD, */ -/* . IFNAME, */ -/* . NRESVR, */ -/* . NRESVC, */ -/* . NCOMR, */ -/* . NCOMC ) */ - - -/* WRITE (*,*) 'Internal file name is: ' */ -/* WRITE (*,*) IFNAME */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 25-AUG-1995 (NJB) */ - -/* Bug fix: local variables are now used in the direct */ -/* access of the file record. Previously, the routine read */ -/* directly into the CHARACTER*(*) arguments IDWORD and IFNAME. */ - -/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Removed the DASID parameter which had the value 'NAIF/DAS', as */ -/* it was not used and is also made obsolete by the change in the */ -/* format of the ID word being implemented. */ - -/* Added a check of FAILED after the call to DASHLU which will */ -/* check out and return if DASHLU fails. This is so that when in */ -/* return mode of the error handling the READ following the call */ -/* to DASHLU will not be executed. */ - -/* Reworded some of the descriptions contained in the */ -/* $ Detailed_Output section of the header so that they were more */ -/* clear. */ - -/* Changed the example so that it does not set a value for IFNAME */ -/* before calling DASRFR. This appears to have been a cut and */ -/* paste bug from DASWFR. */ - -/* - SPICELIB Version 1.0.0, 15-JUL-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read DAS file record */ -/* read DAS internal file name */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 25-AUG-1995 (NJB) */ - -/* Bug fix: local variables are now used in the direct */ -/* access of the file record. Previously, the routine read */ -/* directly into the CHARACTER*(*) arguments IDWORD and IFNAME. */ - -/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Removed the DASID parameter which had the value 'NAIF/DAS', as */ -/* it was not used and is also made obsolute by the change in the */ -/* format of the ID word being implemented. */ - -/* Added a check of FAILED after the call to DASHLU which will */ -/* check out and return if DASHLU fails. This is so that when in */ -/* return mode of the error handling the READ following the call */ -/* to DASHLU will not be executed. */ - -/* Reworded some of the descriptions contained in the */ -/* $ Detailed_Output section of the header so that they were more */ -/* clear. */ - -/* Changed the example so that it does not set a value for IFNAME */ -/* before calling DASRFR. This appears to have been a cut and */ -/* paste bug from DASWFR. */ - -/* - SPICELIB Version 1.0.0, 15-JUL-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASRFR", (ftnlen)6); - } - -/* Get the logical unit for this DAS file. */ - - dashlu_(handle, &unit); - if (failed_()) { - chkout_("DASRFR", (ftnlen)6); - return 0; - } - io___3.ciunit = unit; - iostat = s_rdue(&io___3); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, tmpidw, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, tmpifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Could not read file record. File was #. IOSTAT was #.", ( - ftnlen)55); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24); - chkout_("DASRFR", (ftnlen)6); - return 0; - } - s_copy(idword, tmpidw, idword_len, (ftnlen)8); - s_copy(ifname, tmpifn, ifname_len, (ftnlen)60); - chkout_("DASRFR", (ftnlen)6); - return 0; -} /* dasrfr_ */ - diff --git a/ext/spice/src/cspice/dasrwr.c b/ext/spice/src/cspice/dasrwr.c deleted file mode 100644 index 7c80c7eeec..0000000000 --- a/ext/spice/src/cspice/dasrwr.c +++ /dev/null @@ -1,3906 +0,0 @@ -/* dasrwr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__1 = 1; -static integer c__128 = 128; -static integer c__256 = 256; -static integer c__1024 = 1024; - -/* $Procedure DASRWR ( DAS, read/write records ) */ -/* Subroutine */ int dasrwr_0_(int n__, integer *handle, integer *recno, char - *recc, doublereal *recd, integer *reci, integer *first, integer *last, - doublereal *datad, integer *datai, char *datac, ftnlen recc_len, - ftnlen datac_len) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - static integer hnbufi[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer lubufc[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer lubufd[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer lubufi[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static logical upbufc[10] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_ }; - static logical upbufd[10] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_ }; - static logical upbufi[10] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_ }; - static integer headc = 0; - static integer headd = 0; - static integer headi = 0; - static integer usedc = 0; - static integer usedd = 0; - static integer usedi = 0; - static integer rnbufc[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer rnbufd[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer rnbufi[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer hnbufc[10] = { 0,0,0,0,0,0,0,0,0,0 }; - static integer hnbufd[10] = { 0,0,0,0,0,0,0,0,0,0 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer node, next, unit; - extern /* Subroutine */ int chkin_(char *, ftnlen), lnkan_(integer *, - integer *), moved_(doublereal *, integer *, doublereal *); - static integer poolc[32] /* was [2][16] */, poold[32] /* was [2][16] - */; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - static integer pooli[32] /* was [2][16] */; - extern integer lnktl_(integer *, integer *); - extern logical failed_(void); - extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *, - ftnlen, ftnlen), dasiod_(char *, integer *, integer *, doublereal - *, ftnlen); - static char rcbufc[1024*10]; - static doublereal rcbufd[1280] /* was [128][10] */; - extern /* Subroutine */ int dasioi_(char *, integer *, integer *, integer - *, ftnlen); - static integer rcbufi[2560] /* was [256][10] */; - extern /* Subroutine */ int lnkilb_(integer *, integer *, integer *), - dassih_(integer *, char *, ftnlen), lnkini_(integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), dashlu_( - integer *, integer *), errfnm_(char *, integer *, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), - lnkxsl_(integer *, integer *, integer *); - extern logical return_(void); - extern /* Subroutine */ int lnkfsl_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Read and write DAS physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I RRD, RRI, RRC, WRD, WRI, WRC, URD, URI, URC */ -/* RECNO I RRD, RRI, RRC, WRD, WRI, WRC, URD, URI, URC */ -/* RECC I WRC */ -/* RECD I WRD */ -/* RECI I WRI */ -/* FIRST I RRD, RRI, RRC, URD, URI, URC */ -/* LAST I RRD, RRI, RRC, URD, URI, URC */ -/* DATAD O RRD, URD */ -/* DATAI O RRI, URI */ -/* DATAC O RRC, URC */ -/* BUFSZD P RRD, WRD */ -/* BUFSZI P RRI, WRI */ -/* BUFSZC P RRC, WRC */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their outputs. */ - -/* $ Parameters */ - -/* BUFSZD, */ -/* BUFSZI, */ -/* BUFSZC are, respectively, the number of records in the */ -/* data buffers for double precision, integer, and */ -/* character records. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error */ -/* SPICE(BOGUSENTRY) will be signalled. */ - -/* See the entry points for discussions of their exceptions. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in the headers of */ -/* the entry points for a description of files accessed by this */ -/* set of routines. */ - -/* $ Particulars */ - -/* This suite of routines provides buffered read and write access to */ -/* DAS files. The purpose of this feature is to increase the */ -/* performance of application programs that access DAS files: in */ -/* particular, repeated reads from or writes to a given record */ -/* should be relatively fast, because the contents of the most */ -/* recently accessed records are buffered in memory. Thus DASRWR */ -/* and its entry points act as a miniature virtual memory system for */ -/* DAS files. */ - -/* These routines are intended primarily for use by other SPICELIB */ -/* routines; users' application programs will not normally need to */ -/* call these routines. Writing to a DAS file with these routines */ -/* demands a particularly circumspect approach: it's quite easy to */ -/* end up with something other than a DAS file if one misuses the */ -/* routines. */ - -/* The entry points of DASRWR support writing, reading, and updating */ -/* the records in a DAS file. The distinction between writing and */ -/* updating is that any record may be written (as long as the record */ -/* belongs to a file open for writing), but only existing records */ -/* may be updated. `Writing' a record sets the values of all of */ -/* the elements of the record, while a subrange of the elements of an */ -/* existing record may be `updated'. */ - -/* For each of these three operations, there are three DAS routines, */ -/* one for each supported data type. The names of the routines are */ - -/* -- For writing: DASWRC, DASWRD, DASWRI */ -/* -- For updating: DASURC, DASURD, DASURI */ -/* -- For reading: DASRRC, DASRRD, DASRRI */ - -/* Users should note that, unlike in the case of SPICELIB's DAF */ -/* routines, the DAS routines buffer data that is written as well */ -/* as data that is read. Consequently a DAS file does not */ -/* necessarily yet contain, at any moment, all of the data that */ -/* has been written to it by the DASWRx or DASURx routines. The */ -/* written data that is buffered is written out when the need */ -/* to buffer additional data requires it, and also when the user */ -/* commands the closure of a file that has been written. So, at */ -/* the time a DAS file is closed, the contents of the physical file */ -/* do reflect what has been `written' to the file by the DASWRx and */ -/* DASURx entry points. */ - -/* At any time, an application program can force the DAS system to */ -/* write to a DAS file any buffered records maintained for that */ -/* file. The entry point DASWBR (DAS, write buffered records) */ -/* provides this capability. */ - -/* DASRWR contains three record buffers: one of character type, */ -/* one of double precision type, and one of integer type. Each */ -/* buffer has enough room for an integer number of records. The */ -/* sizes of the buffers are parameterized and can be increased if */ -/* necessary. When contemplating the revision of the buffer */ -/* sizes selected by NAIF, SPICELIB users should take note of the */ -/* following points: */ - -/* -- Changing values of parameters in NAIF subroutines may cause */ -/* a maintenance burden for the users of the modified NAIF */ -/* code, since any changes made to a SPICELIB routine will have */ -/* to be made to any new version of that routine released by */ -/* NAIF in a later version of SPICELIB. */ - -/* -- The effect of buffer size on the speed with which an */ -/* application executes is highly dependent on the specific */ -/* application. In some cases, increasing the buffer sizes */ -/* may slow the application down. */ - -/* $ Examples */ - -/* See the entry points for examples specific to those routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-NOV-1995 (NJB) */ - -/* Made modifications to the DASRRx routines to enhance */ -/* efficiency. Removed references to the function RETURN. */ - -/* Removed weird spaces from ENTRY statements. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header for each entry point. */ -/* This was done in order to minimize documentation changes if the */ -/* DAS open routines ever change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read and write DAS physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 17-NOV-1995 (NJB) */ - -/* Made modifications to the DASRRx routines to enhance */ -/* efficiency. Removed references to the function RETURN. */ - -/* Removed weird spaces from ENTRY statements. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header for each entry point. */ -/* This was done in order to minimize documentation changes if the */ -/* DAS open routines ever change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* The data structure maintained by this set of routines consists */ -/* of three record buffers, one each for use with records of double */ -/* precision, integer, and character data types. */ - -/* Each buffer consists of five parallel arrays; the arrays contain: */ - -/* -- data records */ -/* -- Fortran record numbers */ -/* -- file handles */ -/* -- Fortran logical unit numbers */ -/* -- Update flags */ - -/* In addition, for each buffer there is a doubly linked list that */ -/* points to the buffer and keeps track of the order in which the */ -/* records in the buffer were accessed. The three linked lists are */ -/* maintained in a doubly linked list pool structure. The logical */ -/* structure of each buffer is illustrated below. All of the array */ -/* elements in the same row are associated with the data record in */ -/* that row. */ - - - -/* Linked Record Record Handles Unit Update */ -/* List buffer Numbers Numbers Flags */ - -/* +---+ +------------+ +---+ +---+ +---+ +---+ */ -/* | | ---> | | | | | | | | | | */ -/* +---+ +------------+ +---+ +---+ +---+ +---+ */ -/* | | ---> | | | | | | | | | | */ -/* +---+ +------------+ +---+ +---+ +---+ +---+ */ -/* . . . . . . */ -/* . . . . . . */ -/* . . . . . . */ -/* +---+ +------------+ +---+ +---+ +---+ +---+ */ -/* | | ---> | | | | | | | | | | */ -/* +---+ +------------+ +---+ +---+ +---+ +---+ */ - - - -/* Other local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (recd) { - } - if (reci) { - } - if (datad) { - } - if (datai) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_dasrrd; - case 2: goto L_dasrri; - case 3: goto L_dasrrc; - case 4: goto L_daswrd; - case 5: goto L_daswri; - case 6: goto L_daswrc; - case 7: goto L_dasurd; - case 8: goto L_dasuri; - case 9: goto L_dasurc; - case 10: goto L_daswbr; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASRWR", (ftnlen)6); - } - -/* Never come here. */ - - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("DASRWR", (ftnlen)6); - return 0; -/* $Procedure DASRRD ( DAS, read record, double precision ) */ - -L_dasrrd: -/* $ Abstract */ - -/* Read DAS double precision physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* DOUBLE PRECISION DATAD ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* FIRST, */ -/* LAST I First and last indices of range within record. */ -/* DATAD O Double precision data read from record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an open DAS file. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* FIRST, */ -/* LAST are the first and last indices of a range of */ -/* double precision numbers to be read from the */ -/* indicated record. The record contains NWD */ -/* double precision numbers; these have indices */ -/* ranging from 1 to NWD. */ - -/* $ Detailed_Output */ - -/* DATAD is a double precision array containing the */ -/* elements FIRST through LAST of the specified */ -/* record. The record element FIRST is placed */ -/* in DATAD(1), the record element FIRST+1 is placed */ -/* in DATAD(2), and so on; the record element LAST is */ -/* placed in DATAD(LAST-FIRST+1). */ - -/* $ Parameters */ - -/* BUFSZD is the number of records in the double precision */ -/* record buffer. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The */ -/* output argument DATAD will not be modified. */ - -/* 2) If a read operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument DATAD will not be modified. */ - -/* 3) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument DATAD will not be modified. This routine */ -/* may write out updated, buffered records in order to make */ -/* room in the double precision buffer for a newly read record. */ -/* Note that the file written to may be different than the file */ -/* designated by HANDLE if multiple DAS files are open for */ -/* writing. */ - -/* 4) If FIRST or LAST is not in the range [1, NWD], the error */ -/* SPICE(INDEXOUTOFRANGE) will be signalled. The output argument */ -/* DATAD will not be modified. */ - -/* 5) If FIRST > LAST, this routine will return without modifying */ -/* the output argument DATAD. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to read from a DAS file that is open for */ -/* reading or for writing. Any buffered double precision record */ -/* can be read with this routine. In particular, records that have */ -/* been written to the DAS double precision record buffer but have */ -/* not yet been written out to the DAS file they're intended to go */ -/* to ARE visible to this routine. */ - -/* This routine should be used to read only records that contain */ -/* double precision data. */ - -/* $ Examples */ - -/* 1) Read the 10th through 100th d.p. numbers from record number 9 */ -/* in a DAS file designated by HANDLE. */ - -/* CALL DASRRD ( HANDLE, 9, 10, 100, DATAD ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ - -/* Made modifications to enhance efficiency. Removed references */ -/* to the function RETURN. */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read DAS double precision physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ - -/* Made modifications to enhance efficiency. Removed references */ -/* to the function RETURN. For buffered reads, MOVED is not */ -/* called when a single word is to be read. */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* Check FIRST and LAST. Use discovery check-in. */ - - if (*first < 1 || *first > 128 || *last < 1 || *last > 128) { - chkin_("DASRRD", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Array indices FIRST and LAST were #, #; allowed range for " - "both is [#, #]. File was #, record number was #.", (ftnlen) - 107); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &c__128, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("DASRRD", (ftnlen)6); - return 0; - } - -/* There's nothing to do if LAST < FIRST. (We're not checked in at */ -/* this point.) */ - - if (*last < *first) { - return 0; - } - -/* See whether record number RECNO in file HANDLE is buffered. We'll */ -/* search through the list of buffered records starting at the head */ -/* of the list. If we find the desired record, transfer the */ -/* requested data to the array DATAD and return without further ado. */ - - node = headd; - while(node > 0) { - if (*handle == hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufd", i__1, "dasrwr_", (ftnlen)685)] && *recno == - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufd", i__2, "dasrwr_", (ftnlen)685)]) { - -/* Found it. Move this record to the head of the list. */ -/* Update our head pointer as required. */ - - if (node != headd) { - lnkxsl_(&node, &node, poold); - lnkilb_(&node, &headd, poold); - headd = node; - } - -/* Don't forget to return the requested data. */ - - if (*first == *last) { - datad[0] = rcbufd[(i__1 = *first + (node << 7) - 129) < 1280 - && 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_" - , (ftnlen)705)]; - } else { - i__2 = *last - *first + 1; - moved_(&rcbufd[(i__1 = *first + (node << 7) - 129) < 1280 && - 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_", ( - ftnlen)709)], &i__2, datad); - } - -/* We haven't checked in, so don't check out. */ - - return 0; - } - node = poold[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poold", i__1, "dasrwr_", (ftnlen)720)]; - } - -/* The record wasn't buffered. We need to allocate entries to */ -/* hold the record contents. If the buffer isn't full, just */ -/* select a free set of entries. If the buffer is full, use */ -/* the set of entries at the tail of the list. */ - -/* Since we're now going to do a file read, it doesn't slow */ -/* us down much to check in, comparatively speaking. */ - - chkin_("DASRRD", (ftnlen)6); - if (usedd == 10) { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headd, poold); - lnkxsl_(&node, &node, poold); - -/* If the allocated buffer entry was updated, write it out. */ - - if (upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fd", i__1, "dasrwr_", (ftnlen)746)]) { - dasiod_("WRITE", &lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufd", i__1, "dasrwr_", (ftnlen)748)], & - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufd", i__2, "dasrwr_", (ftnlen)748)], &rcbufd[( - i__3 = (node << 7) - 128) < 1280 && 0 <= i__3 ? i__3 : - s_rnge("rcbufd", i__3, "dasrwr_", (ftnlen)748)], (ftnlen) - 5); - } - } else { - -/* Allocate a new set of buffer entries, but don't link */ -/* them into the list yet. */ - - lnkan_(poold, &node); - ++usedd; - } - -/* Try to read the record. */ - - dashlu_(handle, &unit); - dasiod_("READ", &unit, recno, &rcbufd[(i__1 = (node << 7) - 128) < 1280 && - 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_", (ftnlen)770) - ], (ftnlen)4); - if (failed_()) { - chkout_("DASRRD", (ftnlen)6); - return 0; - } - -/* The read was successful. Link the node pointing to the buffer */ -/* entries for this record in before the current head of the */ -/* list, thus putting them at the head. */ - -/* Set the file handle, record number, unit, and update flag for */ -/* this record. */ - - lnkilb_(&node, &headd, poold); - hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufd", i__1, - "dasrwr_", (ftnlen)787)] = *handle; - rnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufd", i__1, - "dasrwr_", (ftnlen)788)] = *recno; - lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufd", i__1, - "dasrwr_", (ftnlen)789)] = unit; - upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufd", i__1, - "dasrwr_", (ftnlen)790)] = FALSE_; - headd = node; - -/* Don't forget to return the requested data. */ - - i__2 = *last - *first + 1; - moved_(&rcbufd[(i__1 = *first + (node << 7) - 129) < 1280 && 0 <= i__1 ? - i__1 : s_rnge("rcbufd", i__1, "dasrwr_", (ftnlen)796)], &i__2, - datad); - chkout_("DASRRD", (ftnlen)6); - return 0; -/* $Procedure DASRRI ( DAS, read record, integer ) */ - -L_dasrri: -/* $ Abstract */ - -/* Read DAS integer physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* INTEGER DATAI ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* FIRST, */ -/* LAST I First and last indices of range within record. */ -/* DATAI O Integer data read from record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an open DAS file. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* FIRST, */ -/* LAST are the first and last indices of a range of */ -/* integers to be read from the indicated record. */ -/* The record contains NWI integers; these have */ -/* indices ranging from 1 to NWI. */ - -/* $ Detailed_Output */ - -/* DATAI is an integer array containing the elements FIRST */ -/* through LAST of the specified record. The record */ -/* element FIRST is placed in DATAI(1), the record */ -/* element FIRST+1 is placed in DATAI(2), and so on; */ -/* the record element LAST is placed in */ -/* DATAI(LAST-FIRST+1). */ - -/* $ Parameters */ - -/* BUFSZI is the number of records in the integer record */ -/* buffer. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The */ -/* output argument DATAI will not be modified. */ - -/* 2) If a read operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument DATAI will not be modified. */ - -/* 3) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument DATAI will not be modified. This routine */ -/* may write out updated, buffered records in order to make room */ -/* in the integer buffer for a newly read record. Note that the */ -/* file written to may be different than the file designated by */ -/* HANDLE if multiple DAS files are open for writing. */ - -/* 4) If FIRST or LAST is not in the range [1, NWI], the error */ -/* SPICE(INDEXOUTOFRANGE) will be signalled. The output argument */ -/* DATAI will not be modified. */ - -/* 5) If FIRST > LAST, this routine will return without modifying */ -/* the output argument DATAI. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to read from a DAS file that is open for */ -/* reading or writing. Any buffered integer record can be read with */ -/* this routine. In particular, records that have been written to */ -/* the DAS integer record buffer but have not yet been written out */ -/* to the DAS file they're intended to go to ARE visible to this */ -/* routine. */ - -/* This routine should be used to read only records that contain */ -/* integer data. */ - -/* $ Examples */ - -/* 1) Read the 10th through 100th integers from record number 9 */ -/* in a DAS file designated by HANDLE. */ - -/* CALL DASRRI ( HANDLE, 9, 10, 100, DATAI ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ - -/* Made modifications to enhance efficiency. Removed references */ -/* to the function RETURN. */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read DAS integer physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ - -/* Made modifications to enhance efficiency. Removed references */ -/* to the function RETURN. For buffered reads, MOVEI is not */ -/* called when a single word is to be read. */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Non-standard SPICE error handling. */ - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* Check FIRST and LAST. Use discovery check-in. */ - - if (*first < 1 || *first > 256 || *last < 1 || *last > 256) { - chkin_("DASRRI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Array indices FIRST and LAST were #, #; allowed range for " - "both is [#, #]. File was #, record number was #.", (ftnlen) - 107); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &c__256, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("DASRRI", (ftnlen)6); - return 0; - } - -/* There's nothing to do if LAST < FIRST. (We're not checked in at */ -/* this point.) */ - - if (*last < *first) { - return 0; - } - -/* See whether record number RECNO in file HANDLE is buffered. We'll */ -/* search through the list of buffered records starting at the head */ -/* of the list. If we find the desired record, transfer the */ -/* requested data to the array DATAI and return without further ado. */ - - node = headi; - while(node > 0) { - if (*handle == hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufi", i__1, "dasrwr_", (ftnlen)1068)] && *recno == - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufi", i__2, "dasrwr_", (ftnlen)1068)]) { - - -/* Found it. Move this record to the head of the list. */ -/* Update our head pointer as required. */ - - if (node != headi) { - lnkxsl_(&node, &node, pooli); - lnkilb_(&node, &headi, pooli); - headi = node; - } - -/* Don't forget to return the requested data. */ - - if (*first == *last) { - datai[0] = rcbufi[(i__1 = *first + (node << 8) - 257) < 2560 - && 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_" - , (ftnlen)1089)]; - } else { - i__2 = *last - *first + 1; - movei_(&rcbufi[(i__1 = *first + (node << 8) - 257) < 2560 && - 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_", ( - ftnlen)1093)], &i__2, datai); - } - -/* We haven't checked in, so don't check out. */ - - return 0; - } - node = pooli[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pooli", i__1, "dasrwr_", (ftnlen)1104)]; - } - -/* The record wasn't buffered. We need to allocate entries to */ -/* hold the record contents. If the buffer isn't full, just */ -/* select a free set of entries. If the buffer is full, use */ -/* the set of entries at the tail of the list. */ - -/* Since we're now going to do a file read, it doesn't slow */ -/* us down much to check in, comparatively speaking. */ - - chkin_("DASRRI", (ftnlen)6); - if (usedi == 10) { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headi, pooli); - lnkxsl_(&node, &node, pooli); - -/* If the allocated buffer entry was updated, write it out. */ - - if (upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fi", i__1, "dasrwr_", (ftnlen)1130)]) { - dasioi_("WRITE", &lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufi", i__1, "dasrwr_", (ftnlen)1132)], & - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufi", i__2, "dasrwr_", (ftnlen)1132)], &rcbufi[ - (i__3 = (node << 8) - 256) < 2560 && 0 <= i__3 ? i__3 : - s_rnge("rcbufi", i__3, "dasrwr_", (ftnlen)1132)], (ftnlen) - 5); - } - } else { - -/* Allocate a new set of buffer entries, but don't link */ -/* them into the list yet. */ - - lnkan_(pooli, &node); - ++usedi; - } - -/* Try to read the record. */ - - dashlu_(handle, &unit); - dasioi_("READ", &unit, recno, &rcbufi[(i__1 = (node << 8) - 256) < 2560 && - 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_", (ftnlen) - 1153)], (ftnlen)4); - if (failed_()) { - chkout_("DASRRI", (ftnlen)6); - return 0; - } - -/* The read was successful. Link the node pointing to the buffer */ -/* entries for this record in before the current head of the */ -/* list, thus putting them at the head. */ - -/* Set the file handle, record number, unit, and update flag for */ -/* this record. */ - - lnkilb_(&node, &headi, pooli); - hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufi", i__1, - "dasrwr_", (ftnlen)1170)] = *handle; - rnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufi", i__1, - "dasrwr_", (ftnlen)1171)] = *recno; - lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufi", i__1, - "dasrwr_", (ftnlen)1172)] = unit; - upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufi", i__1, - "dasrwr_", (ftnlen)1173)] = FALSE_; - headi = node; - -/* Don't forget to return the requested data. */ - - i__2 = *last - *first + 1; - movei_(&rcbufi[(i__1 = *first + (node << 8) - 257) < 2560 && 0 <= i__1 ? - i__1 : s_rnge("rcbufi", i__1, "dasrwr_", (ftnlen)1179)], &i__2, - datai); - chkout_("DASRRI", (ftnlen)6); - return 0; -/* $Procedure DASRRC ( DAS, read record, character ) */ - -L_dasrrc: -/* $ Abstract */ - -/* Read DAS character physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* CHARACTER*(*) DATAC */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* FIRST, */ -/* LAST I First and last indices of range within record. */ -/* DATAC O Character data read from record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an open DAS file. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* FIRST, */ -/* LAST are the first and last indices of a range of */ -/* characters to be read from the indicated record. */ -/* The record contains NWC characters; these have */ -/* indices ranging from 1 to NWC. */ - -/* $ Detailed_Output */ - -/* DATAC is a character string containing the elements */ -/* FIRST through LAST of the specified record. The */ -/* record element FIRST is placed in DATAC(1:1), the */ -/* record element FIRST+1 is placed in DATAC(2:2), */ -/* and so on; the record element LAST is placed in */ -/* DATAC( LAST-FIRST+1 : LAST-FIRST+1 ). */ - -/* $ Parameters */ - -/* BUFSZC is the number of records in the character record */ -/* buffer. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The */ -/* output argument DATAC will not be modified. */ - -/* 2) If a read operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument DATAC will not be modified. */ - -/* 3) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument DATAC will not be modified. This routine */ -/* may write out updated, buffered records in order to make room */ -/* in the character buffer for a newly read record. Note that */ -/* the file written to may be different than the file */ -/* designated by HANDLE if multiple DAS files are open for */ -/* writing. */ - -/* 4) If FIRST or LAST is not in the range [1, NWC], the error */ -/* SPICE(INDEXOUTOFRANGE) will be signalled. The output argument */ -/* DATAC will not be modified. */ - -/* 5) If FIRST > LAST, this routine will return without modifying */ -/* the output argument DATAC. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to read from a DAS file that is open for */ -/* reading or writing. Any buffered character record can be read */ -/* with this routine. In particular, records that have been */ -/* written to the DAS character record buffer but have not yet been */ -/* written out to the DAS file they're intended to go to ARE */ -/* visible to this routine. */ - -/* This routine should be used to read only records that contain */ -/* character data. */ - -/* $ Examples */ - -/* 1) Read the 10th through 100th characters from record number 9 */ -/* in a DAS file designated by HANDLE. */ - -/* CALL DASRRC ( HANDLE, 9, 10, 100, DATAC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-NOV-1995 (NJB) */ - -/* Made modifications to enhance efficiency. Removed references */ -/* to the function RETURN. */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read DAS character physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-NOV-1995 (NJB) */ - -/* Made modifications to enhance efficiency. Removed references */ -/* to the function RETURN. */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* Check FIRST and LAST. Use discovery check-in. */ - - if (*first < 1 || *first > 1024 || *last < 1 || *last > 1024) { - chkin_("DASRRC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Array indices FIRST and LAST were #, #; allowed range for " - "both is [#, #]. File was #, record number was #.", (ftnlen) - 107); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &c__1024, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("DASRRC", (ftnlen)6); - return 0; - } - -/* There's nothing to do if LAST < FIRST. (We're not checked in at */ -/* this point.) */ - - if (*last < *first) { - return 0; - } - -/* See whether record number RECNO in file HANDLE is buffered. We'll */ -/* search through the list of buffered records starting at the head */ -/* of the list. If we find the desired record, transfer the */ -/* requested data to the array DATAC and return without further ado. */ - - node = headc; - while(node > 0) { - if (*handle == hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufc", i__1, "dasrwr_", (ftnlen)1450)] && *recno == - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufc", i__2, "dasrwr_", (ftnlen)1450)]) { - - -/* Found it. Move this record to the head of the list. */ -/* Update our head pointer as required. */ - - if (node != headc) { - lnkxsl_(&node, &node, poolc); - lnkilb_(&node, &headc, poolc); - headc = node; - } - -/* Don't forget to return the requested data. */ - - s_copy(datac, rcbufc + ((((i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("rcbufc", i__1, "dasrwr_", (ftnlen)1469)) << - 10) + (*first - 1)), datac_len, *last - (*first - 1)); - -/* We haven't checked in, so don't check out. */ - - return 0; - } - node = poolc[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poolc", i__1, "dasrwr_", (ftnlen)1478)]; - } - -/* The record wasn't buffered. We need to allocate entries to */ -/* hold the record contents. If the buffer isn't full, just */ -/* select a free set of entries. If the buffer is full, use */ -/* the set of entries at the tail of the list. */ - -/* Since we're now going to do a file read, it doesn't slow */ -/* us down much to check in, comparatively speaking. */ - - chkin_("DASRRC", (ftnlen)6); - if (usedc == 10) { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headc, poolc); - lnkxsl_(&node, &node, poolc); - -/* If the allocated buffer entry was updated, write it out. */ - - if (upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fc", i__1, "dasrwr_", (ftnlen)1504)]) { - dasioc_("WRITE", &lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufc", i__1, "dasrwr_", (ftnlen)1506)], & - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufc", i__2, "dasrwr_", (ftnlen)1506)], rcbufc - + (((i__3 = node - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rcbufc", i__3, "dasrwr_", (ftnlen)1506)) << 10), (ftnlen) - 5, (ftnlen)1024); - } - } else { - -/* Allocate a new set of buffer entries, but don't link */ -/* them into the list yet. */ - - lnkan_(poolc, &node); - ++usedc; - } - -/* Try to read the record. */ - - dashlu_(handle, &unit); - dasioc_("READ", &unit, recno, rcbufc + (((i__1 = node - 1) < 10 && 0 <= - i__1 ? i__1 : s_rnge("rcbufc", i__1, "dasrwr_", (ftnlen)1528)) << - 10), (ftnlen)4, (ftnlen)1024); - if (failed_()) { - chkout_("DASRRC", (ftnlen)6); - return 0; - } - -/* The read was successful. Link the node pointing to the buffer */ -/* entries for this record in before the current head of the */ -/* list, thus putting them at the head. */ - -/* Set the file handle, record number, unit, and update flag for */ -/* this record. */ - - lnkilb_(&node, &headc, poolc); - hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufc", i__1, - "dasrwr_", (ftnlen)1545)] = *handle; - rnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufc", i__1, - "dasrwr_", (ftnlen)1546)] = *recno; - lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufc", i__1, - "dasrwr_", (ftnlen)1547)] = unit; - upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufc", i__1, - "dasrwr_", (ftnlen)1548)] = FALSE_; - headc = node; - -/* Don't forget to return the requested data. */ - - s_copy(datac, rcbufc + ((((i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("rcbufc", i__1, "dasrwr_", (ftnlen)1554)) << 10) + (*first - - 1)), datac_len, *last - (*first - 1)); - chkout_("DASRRC", (ftnlen)6); - return 0; -/* $Procedure DASWRD ( DAS, write record, double precision ) */ - -L_daswrd: -/* $ Abstract */ - -/* Write DAS double precision physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* DOUBLE PRECISION RECD ( NWD ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* RECD I Double precision data to be written to record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* RECD is an array of NWD double precision numbers. The */ -/* contents of this array are to be written to the */ -/* physical file record having number RECNO. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* BUFSZD is the number of records in the double precision */ -/* record buffer. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The DAS file */ -/* designated by HANDLE will not be modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. Note that the file written to may be different than */ -/* the file designated by HANDLE if multiple DAS files are open */ -/* for writing. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to write to only DAS files that are open */ -/* for writing. Records written via this routine will always be */ -/* buffered immediately, but may not be written to the file until */ -/* they are cleared from the double precision buffer to make room */ -/* for other records, or until they are explicitly forced to to be */ -/* written via a call to DASWBR. In any case, at the moment this */ -/* routine returns, the data supplied on input may be read back by */ -/* DASRRD or updated by DASURD. */ - -/* Closing a DAS file via DASCLS forces any remaining updated data */ -/* records buffered by this routine to be written to the file. */ - -/* $ Examples */ - -/* 1) Write an array of NWD double precision numbers to the 9th */ -/* record in a DAS file designated by HANDLE. */ - -/* DOUBLE PRECISION RECD */ - -/* . */ -/* . */ -/* . */ - -/* DO I = 1, NWD */ -/* RECD(I) = DBLE(I) */ -/* END DO */ - -/* CALL DASWRD ( HANDLE, 9, RECD ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write DAS double precision physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASWRD", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASWRD", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* See whether double precision record number RECNO from file HANDLE */ -/* is buffered. We'll search through the list of buffered records */ -/* starting at the head of the list. If the record is already */ -/* buffered, we'll update the buffer entry, but we'll defer writing */ -/* the record out until we need to free a record, or until the */ -/* d.p. buffer is flushed, whichever comes first. */ - - node = headd; - while(node > 0) { - if (*handle == hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufd", i__1, "dasrwr_", (ftnlen)1787)] && *recno == - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufd", i__2, "dasrwr_", (ftnlen)1787)]) { - -/* Found it. Update the buffered record. */ - - moved_(recd, &c__128, &rcbufd[(i__1 = (node << 7) - 128) < 1280 && - 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_", ( - ftnlen)1792)]); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. */ - - upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fd", i__1, "dasrwr_", (ftnlen)1798)] = TRUE_; - -/* Put the information about this record at the head of the */ -/* active list, if it is not already there. */ - - if (node != headd) { - lnkxsl_(&node, &node, poold); - lnkilb_(&node, &headd, poold); - headd = node; - } - chkout_("DASWRD", (ftnlen)6); - return 0; - } - node = poold[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poold", i__1, "dasrwr_", (ftnlen)1817)]; - } - -/* The record we're writing to is not buffered. We'll allocate */ -/* a buffer entry. If the record buffer is full, we'll */ -/* commandeer the least recently accessed record. Before using */ -/* this record, we'll write its contents out to the corresponding */ -/* file, if the record has been updated. */ - - if (usedd < 10) { - -/* There's a free buffer entry available. Just allocate it. */ - - lnkan_(poold, &node); - ++usedd; - } else { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headd, poold); - lnkxsl_(&node, &node, poold); - -/* If the allocated record was updated, write it out. */ - - if (upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fd", i__1, "dasrwr_", (ftnlen)1847)]) { - dasiod_("WRITE", &lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufd", i__1, "dasrwr_", (ftnlen)1849)], & - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufd", i__2, "dasrwr_", (ftnlen)1849)], &rcbufd[ - (i__3 = (node << 7) - 128) < 1280 && 0 <= i__3 ? i__3 : - s_rnge("rcbufd", i__3, "dasrwr_", (ftnlen)1849)], (ftnlen) - 5); - if (failed_()) { - chkout_("DASWRD", (ftnlen)6); - return 0; - } - } - } - -/* Now update the allocated buffer entry with the input data. */ - - moved_(recd, &c__128, &rcbufd[(i__1 = (node << 7) - 128) < 1280 && 0 <= - i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_", (ftnlen)1866)]); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. Also set the handle, unit, and record number */ -/* entries. */ - - dashlu_(handle, &unit); - upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufd", i__1, - "dasrwr_", (ftnlen)1875)] = TRUE_; - hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufd", i__1, - "dasrwr_", (ftnlen)1876)] = *handle; - lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufd", i__1, - "dasrwr_", (ftnlen)1877)] = unit; - rnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufd", i__1, - "dasrwr_", (ftnlen)1878)] = *recno; - -/* Link this buffer entry to the head of the list. */ - - lnkilb_(&node, &headd, poold); - headd = node; - chkout_("DASWRD", (ftnlen)6); - return 0; -/* $Procedure DASWRI ( DAS, write record, integer ) */ - -L_daswri: -/* $ Abstract */ - -/* Write DAS integer physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER RECI ( NWI ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* RECI I Integer data to be written to record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* RECI is an array of NWI integers. The contents of this */ -/* array are to be written to the physical file */ -/* record having number RECNO. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* BUFSZI is the number of records in the integer record */ -/* buffer. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The DAS file */ -/* designated by HANDLE will not be modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. Note that the file written to may be different than */ -/* the file designated by HANDLE if multiple DAS files are open */ -/* for writing. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to write to only DAS files that are open */ -/* for writing. Records written via this routine will always be */ -/* buffered immediately, but may not be written to the file until */ -/* they are cleared from the integer buffer to make room for other */ -/* records, or until they are explicitly forced to to be written via */ -/* a call to DASWBR. In any case, at the moment this routine */ -/* returns, the data supplied on input may be read back by DASRRI */ -/* or updated by DASURI. */ - -/* Closing a DAS file via DASCLS forces any remaining updated data */ -/* records buffered by this routine to be written to the file. */ - -/* $ Examples */ - -/* 1) Write an array of NWI integers to the 9th record in a DAS */ -/* file designated by HANDLE. */ - -/* INTEGER RECI ( NWI ) */ -/* . */ -/* . */ -/* . */ - -/* DO I = 1, NWI */ -/* RECI(I) = I */ -/* END DO */ - -/* CALL DASWRI ( HANDLE, 9, RECI ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write DAS integer physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASWRI", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASWRI", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* See whether integer record number RECNO from file HANDLE is */ -/* buffered. We'll search through the list of buffered records */ -/* starting at the head of the list. If the record is already */ -/* buffered, we'll update the buffer entry, but we'll defer writing */ -/* the record out until we need to free a record, or until the */ -/* integer buffer is flushed, whichever comes first. */ - - node = headi; - while(node > 0) { - if (*handle == hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufi", i__1, "dasrwr_", (ftnlen)2117)] && *recno == - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufi", i__2, "dasrwr_", (ftnlen)2117)]) { - -/* Found it. Update the buffered record. */ - - movei_(reci, &c__256, &rcbufi[(i__1 = (node << 8) - 256) < 2560 && - 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_", ( - ftnlen)2122)]); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. */ - - upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fi", i__1, "dasrwr_", (ftnlen)2128)] = TRUE_; - -/* Put the information about this record at the head of the */ -/* active list, if it is not already there. */ - - if (node != headi) { - lnkxsl_(&node, &node, pooli); - lnkilb_(&node, &headi, pooli); - headi = node; - } - chkout_("DASWRI", (ftnlen)6); - return 0; - } - node = pooli[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pooli", i__1, "dasrwr_", (ftnlen)2147)]; - } - -/* The record we're writing to is not buffered. We'll allocate */ -/* a buffer entry. If the record buffer is full, we'll */ -/* commandeer the least recently accessed record. Before using */ -/* this record, we'll write its contents out to the corresponding */ -/* file, if the record has been updated. */ - - if (usedi < 10) { - -/* There's a free buffer entry available. Just allocate it. */ - - lnkan_(pooli, &node); - ++usedi; - } else { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headi, pooli); - lnkxsl_(&node, &node, pooli); - -/* If the allocated record was updated, write it out. */ - - if (upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fi", i__1, "dasrwr_", (ftnlen)2176)]) { - dasioi_("WRITE", &lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufi", i__1, "dasrwr_", (ftnlen)2178)], & - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufi", i__2, "dasrwr_", (ftnlen)2178)], &rcbufi[ - (i__3 = (node << 8) - 256) < 2560 && 0 <= i__3 ? i__3 : - s_rnge("rcbufi", i__3, "dasrwr_", (ftnlen)2178)], (ftnlen) - 5); - } - } - -/* Now update the allocated buffer entry with the input data. */ - - movei_(reci, &c__256, &rcbufi[(i__1 = (node << 8) - 256) < 2560 && 0 <= - i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_", (ftnlen)2190)]); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. Also set the handle, unit, and record number */ -/* entries. */ - - dashlu_(handle, &unit); - upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufi", i__1, - "dasrwr_", (ftnlen)2199)] = TRUE_; - hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufi", i__1, - "dasrwr_", (ftnlen)2200)] = *handle; - lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufi", i__1, - "dasrwr_", (ftnlen)2201)] = unit; - rnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufi", i__1, - "dasrwr_", (ftnlen)2202)] = *recno; - -/* Link this buffer entry to the head of the list. */ - - lnkilb_(&node, &headi, pooli); - headi = node; - chkout_("DASWRI", (ftnlen)6); - return 0; -/* $Procedure DASWRC ( DAS, write record, character ) */ - -L_daswrc: -/* $ Abstract */ - -/* Write DAS character physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* CHARACTER*(*) RECC */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* RECC I Character data to be written to record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* RECC is a string of length NWC. The contents of this */ -/* string are to be written to the physical file */ -/* record having number RECNO. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* BUFSZC is the number of records in the character record */ -/* buffer. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The DAS file */ -/* designated by HANDLE will not be modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. Note that the file written to may be different than */ -/* the file designated by HANDLE if multiple DAS files are open */ -/* for writing. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to write to only DAS files that are open */ -/* for writing. Records written via this routine will always be */ -/* buffered immediately, but may not be written to the file until */ -/* they are cleared from the character buffer to make room for other */ -/* records, or until they are explicitly forced to to be written via */ -/* a call to DASWBR. In any case, at the moment this routine */ -/* returns, the data supplied on input may be read back by DASRRC */ -/* or updated by DASURC. */ - -/* Closing a DAS file via DASCLS forces any remaining updated data */ -/* records buffered by this routine to be written to the file. */ - -/* $ Examples */ - -/* 1) Write a string of NWC characters to the 9th record in a DAS */ -/* file designated by HANDLE. */ - -/* CHARACTER*(NWC) RECC */ - -/* . */ -/* . */ -/* . */ - -/* RECC = 'This example string is blank-padded on the ' // */ -/* . 'right. All of the trailing blanks will be ' // */ -/* . 'written to the DAS file by the following call.' */ - -/* CALL DASWRC ( HANDLE, 9, RECC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write DAS character physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASWRC", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASWRC", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* See whether character record number RECNO from file HANDLE is */ -/* buffered. We'll search through the list of buffered records */ -/* starting at the head of the list. If the record is already */ -/* buffered, we'll update the buffer entry, but we'll defer writing */ -/* the record out until we need to free a record, or until the */ -/* character buffer is flushed, whichever comes first. */ - - node = headc; - while(node > 0) { - if (*handle == hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufc", i__1, "dasrwr_", (ftnlen)2442)] && *recno == - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufc", i__2, "dasrwr_", (ftnlen)2442)]) { - -/* Found it. Update the buffered record. */ - - s_copy(rcbufc + (((i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("rcbufc", i__1, "dasrwr_", (ftnlen)2447)) << 10), - recc, (ftnlen)1024, recc_len); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. */ - - upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fc", i__1, "dasrwr_", (ftnlen)2453)] = TRUE_; - -/* Put the information about this record at the head of the */ -/* active list, if it is not already there. */ - - if (node != headc) { - lnkxsl_(&node, &node, poolc); - lnkilb_(&node, &headc, poolc); - headc = node; - } - chkout_("DASWRC", (ftnlen)6); - return 0; - } - node = poolc[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poolc", i__1, "dasrwr_", (ftnlen)2472)]; - } - -/* The record we're writing to is not buffered. We'll allocate */ -/* a buffer entry. If the record buffer is full, we'll */ -/* commandeer the least recently accessed record. Before using */ -/* this record, we'll write its contents out to the corresponding */ -/* file, if the record has been updated. */ - - if (usedc < 10) { - -/* There's a free buffer entry available. Just allocate it. */ - - lnkan_(poolc, &node); - ++usedc; - } else { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headc, poolc); - lnkxsl_(&node, &node, poolc); - -/* If the allocated record was updated, write it out. */ - - if (upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fc", i__1, "dasrwr_", (ftnlen)2501)]) { - dasioc_("WRITE", &lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufc", i__1, "dasrwr_", (ftnlen)2503)], & - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufc", i__2, "dasrwr_", (ftnlen)2503)], rcbufc - + (((i__3 = node - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rcbufc", i__3, "dasrwr_", (ftnlen)2503)) << 10), (ftnlen) - 5, (ftnlen)1024); - if (failed_()) { - chkout_("DASWRC", (ftnlen)6); - return 0; - } - } - } - -/* Now update the allocated buffer entry with the input data. */ - - s_copy(rcbufc + (((i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "rcbufc", i__1, "dasrwr_", (ftnlen)2520)) << 10), recc, (ftnlen) - 1024, recc_len); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. Also set the handle, unit, and record number */ -/* entries. */ - - dashlu_(handle, &unit); - upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufc", i__1, - "dasrwr_", (ftnlen)2529)] = TRUE_; - hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufc", i__1, - "dasrwr_", (ftnlen)2530)] = *handle; - lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufc", i__1, - "dasrwr_", (ftnlen)2531)] = unit; - rnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufc", i__1, - "dasrwr_", (ftnlen)2532)] = *recno; - -/* Link this buffer entry to the head of the list. */ - - lnkilb_(&node, &headc, poolc); - headc = node; - chkout_("DASWRC", (ftnlen)6); - return 0; -/* $Procedure DASURD ( DAS, update record, double precision ) */ - -L_dasurd: -/* $ Abstract */ - -/* Update DAS double precision physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* DOUBLE PRECISION DATAD ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* FIRST, */ -/* LAST I First and last indices of range within record. */ -/* DATAD I Double precision data to write to record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* FIRST, */ -/* LAST are the first and last indices of a range of */ -/* elements to be updated in the indicated record. */ -/* The record contains NWD double precision numbers; */ -/* these have indices ranging from 1 to NWD. */ - -/* DATAD is a double precision array to be written to */ -/* elements FIRST through LAST of the specified */ -/* record. The array element DATAD(1) is placed in */ -/* record element FIRST, the array element DATAD(2) */ -/* is placed in record element FIRST+1, and so on; */ -/* the array element DATAD(LAST-FIRST+1) is placed in */ -/* the record element LAST. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* BUFSZD is the number of records in the double precision */ -/* record buffer. */ - -/* $ Exceptions */ - -/* 1) This routine may be used to update only records that have */ -/* already been written by DASWRD or that already exist in the */ -/* file designated by HANDLE. Attempting to update a record */ -/* that hasn't yet been written will cause the read operation */ -/* performed by this routine to fail. */ - -/* If a read operation attempted by this routine fails for this */ -/* or any other reason, the error will be diagnosed by routines */ -/* called by this routine. The indicated record will not be */ -/* modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. Note that the file written to may be different than */ -/* the file designated by HANDLE if multiple DAS files are open */ -/* for writing. */ - -/* 3) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The indicated */ -/* record will not be modified. */ - -/* 4) If FIRST or LAST is not in the range [1, NWD], the error */ -/* SPICE(INDEXOUTOFRANGE) will be signalled. The indicated */ -/* record will not be modified. */ - -/* 5) If FIRST > LAST, this routine will return without modifying */ -/* the indicated record. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to update any existing record in a DAS */ -/* file that is open for writing, or any record that has been */ -/* `written' by DASWRD, whether or not that record has yet been */ -/* physically written to the file it belongs to. Records that have */ -/* never been written cannot be updated. */ - -/* Because the DAS system buffers records that are written, multiple */ -/* updates of parts of a record can be made without incurring a */ -/* large number of file reads and writes. */ - -/* This routine should be used to update only records that contain */ -/* double precision data. */ - -/* $ Examples */ - -/* 1) Update the 10th through 100th d.p. numbers in record number 9 */ -/* in a DAS file designated by HANDLE. */ - -/* DOUBLE PRECISION DATAD ( 100 ) */ - -/* . */ -/* . */ -/* . */ - -/* DO I = 1, 91 */ -/* DATAD = DBLE(I) */ -/* END DO */ - -/* CALL DASURD ( HANDLE, 9, 10, 100, DATAD ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update DAS double precision physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASURD", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASURD", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* If FIRST or LAST are out of range, no dice. */ - - if (*first < 1 || *first > 128 || *last < 1 || *last > 128) { - dashlu_(handle, &unit); - setmsg_("Array indices FIRST and LAST were #, #; allowed range for " - "both is [#, #]. File was #, record number was #.", (ftnlen) - 107); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &c__128, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("DASURD", (ftnlen)6); - return 0; - } - -/* There's nothing to do if LAST < FIRST. */ - - if (*last < *first) { - chkout_("DASURD", (ftnlen)6); - return 0; - } - -/* See whether double precision record number RECNO from file HANDLE */ -/* is buffered. We'll search through the list of buffered records */ -/* starting at the head of the list. If the record is already */ -/* buffered, we'll update the buffer entry, but we'll defer writing */ -/* the record out until we need to free a record, or until the */ -/* d.p. buffer is flushed, whichever comes first. */ - - node = headd; - while(node > 0) { - if (*handle == hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufd", i__1, "dasrwr_", (ftnlen)2840)] && *recno == - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufd", i__2, "dasrwr_", (ftnlen)2840)]) { - -/* Found it. Update the buffered record. */ - - i__2 = *last - *first + 1; - moved_(datad, &i__2, &rcbufd[(i__1 = *first + (node << 7) - 129) < - 1280 && 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasr" - "wr_", (ftnlen)2845)]); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. */ - - upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fd", i__1, "dasrwr_", (ftnlen)2851)] = TRUE_; - -/* Put the information about this record at the head of the */ -/* active list, if it is not already there. */ - - if (node != headd) { - lnkxsl_(&node, &node, poold); - lnkilb_(&node, &headd, poold); - headd = node; - } - chkout_("DASURD", (ftnlen)6); - return 0; - } - node = poold[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poold", i__1, "dasrwr_", (ftnlen)2870)]; - } - -/* The record we're writing to is not buffered. In order to */ -/* update this record, we'll need to read it first. But before */ -/* we do that, we'll need to allocate a buffer entry. If the record */ -/* buffer is full, we'll commandeer the least recently accessed */ -/* record. Before using this record, we'll write its contents out */ -/* to the corresponding file, if the record has been updated. */ - - if (usedd < 10) { - -/* There's a free buffer entry available. Just allocate it. */ - - lnkan_(poold, &node); - ++usedd; - } else { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headd, poold); - lnkxsl_(&node, &node, poold); - -/* If the allocated record was updated, write it out. */ - - if (upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fd", i__1, "dasrwr_", (ftnlen)2901)]) { - dasiod_("WRITE", &lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufd", i__1, "dasrwr_", (ftnlen)2903)], & - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufd", i__2, "dasrwr_", (ftnlen)2903)], &rcbufd[ - (i__3 = (node << 7) - 128) < 1280 && 0 <= i__3 ? i__3 : - s_rnge("rcbufd", i__3, "dasrwr_", (ftnlen)2903)], (ftnlen) - 5); - if (failed_()) { - chkout_("DASURD", (ftnlen)6); - return 0; - } - } - } - -/* Now try to read the record we're going to update. */ - - dashlu_(handle, &unit); - dasiod_("READ", &unit, recno, &rcbufd[(i__1 = (node << 7) - 128) < 1280 && - 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_", (ftnlen) - 2922)], (ftnlen)4); - if (failed_()) { - chkout_("DASURD", (ftnlen)6); - return 0; - } - -/* The read was successful, so set the record number, handle, unit, */ -/* and update flag for this buffer entry, and link these buffer */ -/* entries in before the current head of the list, thus putting */ -/* them at the head. */ - -/* Update the head pointer. */ - - lnkilb_(&node, &headd, poold); - hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufd", i__1, - "dasrwr_", (ftnlen)2939)] = *handle; - rnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufd", i__1, - "dasrwr_", (ftnlen)2940)] = *recno; - lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufd", i__1, - "dasrwr_", (ftnlen)2941)] = unit; - upbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufd", i__1, - "dasrwr_", (ftnlen)2942)] = TRUE_; - headd = node; - -/* At long last, make the requested update. Note that we don't */ -/* have to write the record back to the file; that will get done */ -/* automatically before or at the time the file is closed. */ - - i__2 = *last - *first + 1; - moved_(datad, &i__2, &rcbufd[(i__1 = *first + (node << 7) - 129) < 1280 && - 0 <= i__1 ? i__1 : s_rnge("rcbufd", i__1, "dasrwr_", (ftnlen) - 2950)]); - chkout_("DASURD", (ftnlen)6); - return 0; -/* $Procedure DASURI ( DAS, update record, integer ) */ - -L_dasuri: -/* $ Abstract */ - -/* Update DAS integer physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* INTEGER DATAI ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* FIRST, */ -/* LAST I First and last indices of range within record. */ -/* DATAI I Integer data to write to record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* FIRST, */ -/* LAST are the first and last indices of a range of */ -/* elements to be updated in the indicated record. */ -/* The record contains NWI integers; these have */ -/* indices ranging from 1 to NWI. */ - -/* DATAI is an integer array to be written to elements FIRST */ -/* through LAST of the specified record. The array */ -/* element DATAI(1) is placed in record element FIRST, */ -/* the array element DATAI(2) is placed in record */ -/* element FIRST+1, and so on; the array element */ -/* DATAI(LAST-FIRST+1) is placed in the record element */ -/* LAST. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* BUFSZI is the number of records in the integer record */ -/* buffer. */ - -/* $ Exceptions */ - -/* 1) This routine may be used to update only records that have */ -/* already been written by DASWRI or that already exist in the */ -/* file designated by HANDLE. Attempting to update a record */ -/* that hasn't yet been written will cause the read operation */ -/* performed by this routine to fail. */ - -/* If a read operation attempted by this routine fails for this */ -/* or any other reason, the error will be diagnosed by routines */ -/* called by this routine. The indicated record will not be */ -/* modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. Note that the file written to may be different than */ -/* the file designated by HANDLE if multiple DAS files are open */ -/* for writing. */ - -/* 3) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The indicated */ -/* record will not be modified. */ - -/* 4) If FIRST or LAST is not in the range [1, NWI], the error */ -/* SPICE(INDEXOUTOFRANGE) will be signalled. The indicated */ -/* record will not be modified. */ - -/* 5) If FIRST > LAST, this routine will return without modifying */ -/* the indicated record. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to update any existing record in a DAS */ -/* file that is open for writing, or any record that has been */ -/* `written' by DASWRI, whether or not that record has yet been */ -/* physically written to the file it belongs to. Records that have */ -/* never been written cannot be updated. */ - -/* Because the DAS system buffers records that are written, multiple */ -/* updates of parts of a record can be made without incurring a */ -/* large number of file reads and writes. */ - -/* This routine should be used to update only records that contain */ -/* integer data. */ - -/* $ Examples */ - -/* 1) Update the 10th through 100th integers in record number 9 */ -/* in a DAS file designated by HANDLE. */ - -/* INTEGER DATAI ( 100 ) */ - -/* . */ -/* . */ -/* . */ - -/* DO I = 1, 91 */ -/* DATAI = I */ -/* END DO */ - -/* CALL DASURI ( HANDLE, 9, 10, 100, DATAI ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update DAS integer physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASURI", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASURI", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* If FIRST or LAST are out of range, no dice. */ - - if (*first < 1 || *first > 256 || *last < 1 || *last > 256) { - dashlu_(handle, &unit); - setmsg_("Array indices FIRST and LAST were #, #; allowed range for " - "both is [#, #]. File was #, record number was #.", (ftnlen) - 107); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &c__256, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("DASURI", (ftnlen)6); - return 0; - } - -/* There's nothing to do if LAST < FIRST. */ - - if (*last < *first) { - chkout_("DASURI", (ftnlen)6); - return 0; - } - -/* See whether integer record number RECNO from file HANDLE is */ -/* buffered. We'll search through the list of buffered records */ -/* starting at the head of the list. If the record is already */ -/* buffered, we'll update the buffer entry, but we'll defer writing */ -/* the record out until we need to free a record, or until the */ -/* integer buffer is flushed, whichever comes first. */ - - node = headi; - while(node > 0) { - if (*handle == hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufi", i__1, "dasrwr_", (ftnlen)3251)] && *recno == - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufi", i__2, "dasrwr_", (ftnlen)3251)]) { - -/* Found it. Update the buffered record. */ - - i__2 = *last - *first + 1; - movei_(datai, &i__2, &rcbufi[(i__1 = *first + (node << 8) - 257) < - 2560 && 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasr" - "wr_", (ftnlen)3256)]); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. */ - - upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fi", i__1, "dasrwr_", (ftnlen)3262)] = TRUE_; - -/* Put the information about this record at the head of the */ -/* active list, if it is not already there. */ - - if (node != headi) { - lnkxsl_(&node, &node, pooli); - lnkilb_(&node, &headi, pooli); - headi = node; - } - chkout_("DASURI", (ftnlen)6); - return 0; - } - node = pooli[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pooli", i__1, "dasrwr_", (ftnlen)3281)]; - } - -/* The record we're writing to is not buffered. We'll allocate */ -/* a buffer entry. If the record buffer is full, we'll */ -/* commandeer the least recently accessed record. Before using */ -/* this record, we'll write its contents out to the corresponding */ -/* file, if the record has been updated. */ - - if (usedi < 10) { - -/* There's a free buffer entry available. Just allocate it. */ - - lnkan_(pooli, &node); - ++usedi; - } else { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headi, pooli); - lnkxsl_(&node, &node, pooli); - -/* If the allocated record was updated, write it out. */ - - if (upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fi", i__1, "dasrwr_", (ftnlen)3310)]) { - dasioi_("WRITE", &lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufi", i__1, "dasrwr_", (ftnlen)3312)], & - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufi", i__2, "dasrwr_", (ftnlen)3312)], &rcbufi[ - (i__3 = (node << 8) - 256) < 2560 && 0 <= i__3 ? i__3 : - s_rnge("rcbufi", i__3, "dasrwr_", (ftnlen)3312)], (ftnlen) - 5); - if (failed_()) { - chkout_("DASURI", (ftnlen)6); - return 0; - } - } - } - -/* Now try to read the record we're going to update. */ - - dashlu_(handle, &unit); - dasioi_("READ", &unit, recno, &rcbufi[(i__1 = (node << 8) - 256) < 2560 && - 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_", (ftnlen) - 3330)], (ftnlen)4); - if (failed_()) { - chkout_("DASURI", (ftnlen)6); - return 0; - } - -/* The read was successful, so set the record number, handle, unit, */ -/* and update flag for this buffer entry, and link these buffer */ -/* entries in before the current head of the list, thus putting */ -/* them at the head. */ - -/* Update the head pointer. */ - - lnkilb_(&node, &headi, pooli); - hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufi", i__1, - "dasrwr_", (ftnlen)3347)] = *handle; - rnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufi", i__1, - "dasrwr_", (ftnlen)3348)] = *recno; - lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufi", i__1, - "dasrwr_", (ftnlen)3349)] = unit; - upbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufi", i__1, - "dasrwr_", (ftnlen)3350)] = TRUE_; - headi = node; - -/* At long last, make the requested update. Note that we don't */ -/* have to write the record back to the file; that will get done */ -/* automatically before or at the time the file is closed. */ - - i__2 = *last - *first + 1; - movei_(datai, &i__2, &rcbufi[(i__1 = *first + (node << 8) - 257) < 2560 && - 0 <= i__1 ? i__1 : s_rnge("rcbufi", i__1, "dasrwr_", (ftnlen) - 3358)]); - chkout_("DASURI", (ftnlen)6); - return 0; -/* $Procedure DASURC ( DAS, update record, character ) */ - -L_dasurc: -/* $ Abstract */ - -/* Update DAS character physical records. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER RECNO */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* CHARACTER*(*) DATAC */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ -/* RECNO I Record number. */ -/* FIRST, */ -/* LAST I First and last indices of range within record. */ -/* DATAC I Character data to write to record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* RECNO is the number of a record in a DAS file. */ - -/* FIRST, */ -/* LAST are the first and last indices of a range of */ -/* elements to be updated in the indicated record. */ -/* The record contains NWC characters; these have */ -/* indices ranging from 1 to NWC. */ - -/* DATAC is a character string to be written to elements */ -/* FIRST through LAST of the specified record. The */ -/* character DATAC(1:1) is placed in record element */ -/* FIRST, the character DATAC(2) is placed in record */ -/* element FIRST+1, and so on; the character */ -/* DATAC(LAST-FIRST+1) is placed in the record element */ -/* LAST. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* BUFSZC is the number of records in the character record */ -/* buffer. */ - -/* $ Exceptions */ - -/* 1) This routine may be used to update only records that have */ -/* already been written by DASWRC or that already exist in the */ -/* file designated by HANDLE. Attempting to update a record */ -/* that hasn't yet been written will cause the read operation */ -/* performed by this routine to fail. */ - -/* If a read operation attempted by this routine fails for this */ -/* or any other reason, the error will be diagnosed by routines */ -/* called by this routine. The indicated record will not be */ -/* modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. Note that the file written to may be different than */ -/* the file designated by HANDLE if multiple DAS files are open */ -/* for writing. */ - -/* 3) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The indicated */ -/* record will not be modified. */ - -/* 4) If FIRST or LAST is not in the range [1, NWC], the error */ -/* SPICE(INDEXOUTOFRANGE) will be signalled. The indicated */ -/* record will not be modified. */ - -/* 5) If FIRST > LAST, this routine will return without modifying */ -/* the indicated record. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Routines outside of SPICELIB will normally have no need to call */ -/* this routine. */ - -/* This routine can be used to update any existing record in a DAS */ -/* file that is open for writing, or any record that has been */ -/* `written' by DASWRC, whether or not that record has yet been */ -/* physically written to the file it belongs to. Records that have */ -/* never been written cannot be updated. */ - -/* Because the DAS system buffers records that are written, multiple */ -/* updates of parts of a record can be made without incurring a */ -/* large number of file reads and writes. */ - -/* Any buffered character record can be updated with this routine. */ -/* In particular, records that have been written to the DAS character */ -/* record buffer but have not yet been written out to the DAS file */ -/* they're intended to go to ARE visible to this routine. */ - -/* This routine should be used to update only records that contain */ -/* character data. */ - -/* $ Examples */ - -/* 1) Update the 10th through 100th characters in record number 9 */ -/* in a DAS file designated by HANDLE. */ - -/* CHARACTER*(100) DATAC */ - -/* . */ -/* . */ -/* . */ - -/* DATAC = 'The first 91 characters of this string, ' // */ -/* . 'including trailing blanks, will be written ' // */ -/* . 'to the indicated DAS file.' */ - -/* CALL DASURC ( HANDLE, 9, 10, 100, DATAC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update DAS character physical records */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASURC", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASURC", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* If FIRST or LAST are out of range, no dice. */ - - if (*first < 1 || *first > 1024 || *last < 1 || *last > 1024) { - dashlu_(handle, &unit); - setmsg_("String indices FIRST and LAST were #, #; allowed range for" - " both is [#, #]. File was #, record number was #.", (ftnlen) - 108); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &c__1, (ftnlen)1); - errint_("#", &c__1024, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("DASURC", (ftnlen)6); - return 0; - } - -/* There's nothing to do if LAST < FIRST. */ - - if (*last < *first) { - chkout_("DASURC", (ftnlen)6); - return 0; - } - -/* See whether character record number RECNO from file HANDLE is */ -/* buffered. We'll search through the list of buffered records */ -/* starting at the head of the list. If the record is already */ -/* buffered, we'll update the buffer entry, but we'll defer writing */ -/* the record out until we need to free a record, or until the */ -/* character buffer is flushed, whichever comes first. */ - - node = headc; - while(node > 0) { - if (*handle == hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufc", i__1, "dasrwr_", (ftnlen)3665)] && *recno == - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "rnbufc", i__2, "dasrwr_", (ftnlen)3665)]) { - -/* Found it. Update the buffered record. */ - - s_copy(rcbufc + ((((i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("rcbufc", i__1, "dasrwr_", (ftnlen)3670)) << 10) + - (*first - 1)), datac, *last - (*first - 1), datac_len); - -/* Set the update flag, indicating that this buffer entry */ -/* has been modified. */ - - upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fc", i__1, "dasrwr_", (ftnlen)3676)] = TRUE_; - -/* Put the information about this record at the head of the */ -/* active list, if it is not already there. */ - - if (node != headc) { - lnkxsl_(&node, &node, poolc); - lnkilb_(&node, &headc, poolc); - headc = node; - } - chkout_("DASURC", (ftnlen)6); - return 0; - } - node = poolc[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poolc", i__1, "dasrwr_", (ftnlen)3695)]; - } - -/* The record we're writing to is not buffered. We'll allocate */ -/* a buffer entry. If the record buffer is full, we'll */ -/* commandeer the least recently accessed record. Before using */ -/* this record, we'll write its contents out to the corresponding */ -/* file, if the record has been updated. */ - - if (usedc < 10) { - -/* There's a free buffer entry available. Just allocate it. */ - - lnkan_(poolc, &node); - ++usedc; - } else { - -/* Grab the buffer entry at the tail end of the list. */ - - node = lnktl_(&headc, poolc); - lnkxsl_(&node, &node, poolc); - -/* If the allocated record was updated, write it out. */ - - if (upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbu" - "fc", i__1, "dasrwr_", (ftnlen)3724)]) { - dasioc_("WRITE", &lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufc", i__1, "dasrwr_", (ftnlen)3726)], & - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufc", i__2, "dasrwr_", (ftnlen)3726)], rcbufc - + (((i__3 = node - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rcbufc", i__3, "dasrwr_", (ftnlen)3726)) << 10), (ftnlen) - 5, (ftnlen)1024); - if (failed_()) { - chkout_("DASURC", (ftnlen)6); - return 0; - } - } - } - -/* Now try to read the record we're going to update. */ - - dashlu_(handle, &unit); - dasioc_("READ", &unit, recno, rcbufc + (((i__1 = node - 1) < 10 && 0 <= - i__1 ? i__1 : s_rnge("rcbufc", i__1, "dasrwr_", (ftnlen)3744)) << - 10), (ftnlen)4, (ftnlen)1024); - if (failed_()) { - chkout_("DASURC", (ftnlen)6); - return 0; - } - -/* The read was successful, so set the record number, handle, unit, */ -/* and update flag for this buffer entry, and link these buffer */ -/* entries in before the current head of the list, thus putting */ -/* them at the head. */ - -/* Update the head pointer. */ - - lnkilb_(&node, &headc, poolc); - hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("hnbufc", i__1, - "dasrwr_", (ftnlen)3761)] = *handle; - rnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("rnbufc", i__1, - "dasrwr_", (ftnlen)3762)] = *recno; - lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lubufc", i__1, - "dasrwr_", (ftnlen)3763)] = unit; - upbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("upbufc", i__1, - "dasrwr_", (ftnlen)3764)] = TRUE_; - headc = node; - -/* At long last, make the requested update. Note that we don't */ -/* have to write the record back to the file; that will get done */ -/* automatically before or at the time the file is closed. */ - - s_copy(rcbufc + ((((i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "rcbufc", i__1, "dasrwr_", (ftnlen)3772)) << 10) + (*first - 1)), - datac, *last - (*first - 1), datac_len); - chkout_("DASURC", (ftnlen)6); - return 0; -/* $Procedure DASWBR ( DAS, write buffered records ) */ - -L_daswbr: -/* $ Abstract */ - -/* Write out all buffered records of a specified file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of DAS file. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAS file opened for writing. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. The indicated */ -/* file will not be modified. */ - -/* 2) If a write operation attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The status of the DAS file written to is uncertain in this */ -/* case. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine writes buffered records out to the DAS file to which */ -/* they correspond. After the records are written, the buffer */ -/* elements used to store them are deallocated. */ - -/* Because the DAS system buffers records that are written as well */ -/* as those that are read, data supplied to the DASWRx and DASURx */ -/* routines on input has not necessarily been physically written to */ -/* the DAS file specified by the caller of those routines, at the */ -/* time those routines return. Before closing a DAS file that has */ -/* been opened for writing, the DAS system must write out to the */ -/* file any updated records present in the DAS buffers. The SPICELIB */ -/* routine DASCLS uses this routine to perform this function. The */ -/* SPICELIB routines DASACR and DASRCR, which respectively add */ -/* comment records to or delete comment records from a DAS file, use */ -/* this routine to ensure that the DASRWR record buffers don't */ -/* become out of synch with the file they operate upon. */ - -/* In addition, this routine can be used by application programs */ -/* that create or update DAS files. The reason for calling this */ -/* routine directly would be to provide a measure of safety when */ -/* writing a very large file: if the file creation or update were */ -/* interrupted, the amount of work lost due to the loss of buffered, */ -/* unwritten records could be reduced. */ - -/* However, routines outside of SPICELIB will generally not need to */ -/* call this routine directly. */ - -/* $ Examples */ - -/* 1) Supply a series of double precision records to DASWRD, */ -/* then force a physical write of those records to the file. */ - -/* DO RECNO = 77, 100 */ - -/* CALL FILLD ( DBLE(RECNO), NWD, RECD ) */ -/* CALL DASWRD ( HANDLE, RECNO, RECD ) */ - -/* END DO */ - -/* CALL DASWBR ( HANDLE ) */ - - -/* 2) This is the same as example (1), except we force a physical */ -/* write by closing the file. */ - -/* DO RECNO = 77, 100 */ - -/* CALL FILLD ( DBLE(RECNO), NWD, RECD ) */ -/* CALL DASWRD ( HANDLE, RECNO, RECD ) */ - -/* END DO */ - -/* CALL DASCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-1995 (NJB) */ - -/* Removed weird spaces from ENTRY statement. */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write buffered records to a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 28-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASWBR", (ftnlen)6); - } - -/* Check that the file is open for writing. Signal an error if not. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DASWBR", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, initialize the pointer list pools. */ - - if (pass1) { - lnkini_(&c__10, poold); - lnkini_(&c__10, pooli); - lnkini_(&c__10, poolc); - pass1 = FALSE_; - } - -/* For each buffer, find the records belonging to this file, and */ -/* write them out to the file. */ - -/* Double precision records first. */ - - node = headd; - while(node > 0) { - if (*handle == hnbufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufd", i__1, "dasrwr_", (ftnlen)4014)]) { - -/* This record belongs to the file of interest, so write the */ -/* the record out. */ - - dasiod_("WRITE", &lubufd[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufd", i__1, "dasrwr_", (ftnlen)4019)], & - rnbufd[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufd", i__2, "dasrwr_", (ftnlen)4019)], &rcbufd[ - (i__3 = (node << 7) - 128) < 1280 && 0 <= i__3 ? i__3 : - s_rnge("rcbufd", i__3, "dasrwr_", (ftnlen)4019)], (ftnlen) - 5); - if (failed_()) { - chkout_("DASWBR", (ftnlen)6); - return 0; - } - -/* The record is no longer in use; return it to the */ -/* free list. But grab the successor first. Update */ -/* the head of the list, if the node we're freeing is */ -/* the head node. Decrement the number of used d.p. */ -/* buffer elements. */ - - next = poold[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poold", i__1, "dasrwr_", (ftnlen)4036)]; - if (node == headd) { - headd = next; - } - lnkfsl_(&node, &node, poold); - node = next; - --usedd; - } else { - -/* Just get the next node. */ - - node = poold[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poold", i__1, "dasrwr_", (ftnlen)4051)]; - } - } - -/* Next, integer records. */ - - node = headi; - while(node > 0) { - if (*handle == hnbufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufi", i__1, "dasrwr_", (ftnlen)4066)]) { - -/* This record belongs to the file of interest, so write the */ -/* the record out. */ - - dasioi_("WRITE", &lubufi[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufi", i__1, "dasrwr_", (ftnlen)4071)], & - rnbufi[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufi", i__2, "dasrwr_", (ftnlen)4071)], &rcbufi[ - (i__3 = (node << 8) - 256) < 2560 && 0 <= i__3 ? i__3 : - s_rnge("rcbufi", i__3, "dasrwr_", (ftnlen)4071)], (ftnlen) - 5); - if (failed_()) { - chkout_("DASWBR", (ftnlen)6); - return 0; - } - -/* The record is no longer in use; return it to the */ -/* free list. But grab the successor first. Update */ -/* the head of the list, if the node we're freeing is */ -/* the head node. Decrement the number of used integer */ -/* buffer elements. */ - - next = pooli[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pooli", i__1, "dasrwr_", (ftnlen)4088)]; - if (node == headi) { - headi = next; - } - lnkfsl_(&node, &node, pooli); - node = next; - --usedi; - } else { - -/* Just get the next node. */ - - node = pooli[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pooli", i__1, "dasrwr_", (ftnlen)4103)]; - } - } - -/* And last, character records. */ - - node = headc; - while(node > 0) { - if (*handle == hnbufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("hnbufc", i__1, "dasrwr_", (ftnlen)4118)]) { - -/* This record belongs to the file of interest, so write the */ -/* the record out. */ - - dasioc_("WRITE", &lubufc[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("lubufc", i__1, "dasrwr_", (ftnlen)4123)], & - rnbufc[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("rnbufc", i__2, "dasrwr_", (ftnlen)4123)], rcbufc - + (((i__3 = node - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rcbufc", i__3, "dasrwr_", (ftnlen)4123)) << 10), (ftnlen) - 5, (ftnlen)1024); - if (failed_()) { - chkout_("DASWBR", (ftnlen)6); - return 0; - } - -/* The record is no longer in use; return it to the */ -/* free list. But grab the successor first. Update */ -/* the head of the list, if the node we're freeing is */ -/* the head node. Decrement the number of used character */ -/* buffer elements. */ - - next = poolc[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poolc", i__1, "dasrwr_", (ftnlen)4140)]; - if (node == headc) { - headc = next; - } - lnkfsl_(&node, &node, poolc); - node = next; - --usedc; - } else { - -/* Just get the next node. */ - - node = poolc[(i__1 = (node << 1) + 10) < 32 && 0 <= i__1 ? i__1 : - s_rnge("poolc", i__1, "dasrwr_", (ftnlen)4155)]; - } - } - chkout_("DASWBR", (ftnlen)6); - return 0; -} /* dasrwr_ */ - -/* Subroutine */ int dasrwr_(integer *handle, integer *recno, char *recc, - doublereal *recd, integer *reci, integer *first, integer *last, - doublereal *datad, integer *datai, char *datac, ftnlen recc_len, - ftnlen datac_len) -{ - return dasrwr_0_(0, handle, recno, recc, recd, reci, first, last, datad, - datai, datac, recc_len, datac_len); - } - -/* Subroutine */ int dasrrd_(integer *handle, integer *recno, integer *first, - integer *last, doublereal *datad) -{ - return dasrwr_0_(1, handle, recno, (char *)0, (doublereal *)0, (integer *) - 0, first, last, datad, (integer *)0, (char *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int dasrri_(integer *handle, integer *recno, integer *first, - integer *last, integer *datai) -{ - return dasrwr_0_(2, handle, recno, (char *)0, (doublereal *)0, (integer *) - 0, first, last, (doublereal *)0, datai, (char *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int dasrrc_(integer *handle, integer *recno, integer *first, - integer *last, char *datac, ftnlen datac_len) -{ - return dasrwr_0_(3, handle, recno, (char *)0, (doublereal *)0, (integer *) - 0, first, last, (doublereal *)0, (integer *)0, datac, (ftnint)0, - datac_len); - } - -/* Subroutine */ int daswrd_(integer *handle, integer *recno, doublereal * - recd) -{ - return dasrwr_0_(4, handle, recno, (char *)0, recd, (integer *)0, ( - integer *)0, (integer *)0, (doublereal *)0, (integer *)0, (char *) - 0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int daswri_(integer *handle, integer *recno, integer *reci) -{ - return dasrwr_0_(5, handle, recno, (char *)0, (doublereal *)0, reci, ( - integer *)0, (integer *)0, (doublereal *)0, (integer *)0, (char *) - 0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int daswrc_(integer *handle, integer *recno, char *recc, - ftnlen recc_len) -{ - return dasrwr_0_(6, handle, recno, recc, (doublereal *)0, (integer *)0, ( - integer *)0, (integer *)0, (doublereal *)0, (integer *)0, (char *) - 0, recc_len, (ftnint)0); - } - -/* Subroutine */ int dasurd_(integer *handle, integer *recno, integer *first, - integer *last, doublereal *datad) -{ - return dasrwr_0_(7, handle, recno, (char *)0, (doublereal *)0, (integer *) - 0, first, last, datad, (integer *)0, (char *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int dasuri_(integer *handle, integer *recno, integer *first, - integer *last, integer *datai) -{ - return dasrwr_0_(8, handle, recno, (char *)0, (doublereal *)0, (integer *) - 0, first, last, (doublereal *)0, datai, (char *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int dasurc_(integer *handle, integer *recno, integer *first, - integer *last, char *datac, ftnlen datac_len) -{ - return dasrwr_0_(9, handle, recno, (char *)0, (doublereal *)0, (integer *) - 0, first, last, (doublereal *)0, (integer *)0, datac, (ftnint)0, - datac_len); - } - -/* Subroutine */ int daswbr_(integer *handle) -{ - return dasrwr_0_(10, handle, (integer *)0, (char *)0, (doublereal *)0, ( - integer *)0, (integer *)0, (integer *)0, (doublereal *)0, ( - integer *)0, (char *)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/dassdr.c b/ext/spice/src/cspice/dassdr.c deleted file mode 100644 index da0f576aeb..0000000000 --- a/ext/spice/src/cspice/dassdr.c +++ /dev/null @@ -1,948 +0,0 @@ -/* dassdr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__256 = 256; -static integer c__0 = 0; - -/* $Procedure DASSDR ( DAS, segregate data records ) */ -/* Subroutine */ int dassdr_(integer *handle) -{ - /* Initialized data */ - - static integer next[3] = { 2,3,1 }; - static integer prev[3] = { 3,1,2 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base; - char crec[1024]; - doublereal drec[128]; - integer free, irec[256], lrec, dest; - logical more; - integer unit, type__, i__, j, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc; - extern /* Subroutine */ int maxai_(integer *, integer *, integer *, - integer *); - char savec[1024]; - doublereal saved[128]; - integer recno, savei[256]; - extern integer sumai_(integer *, integer *); - integer ncomr, total, lword, count[4], ltype, start; - extern logical failed_(void); - extern /* Subroutine */ int dasadi_(integer *, integer *, integer *), - cleari_(integer *, integer *); - integer drbase; - extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *, - ftnlen, ftnlen), dasiod_(char *, integer *, integer *, doublereal - *, ftnlen), dasllc_(integer *), dasrdi_(integer *, integer *, - integer *, integer *), dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *), - dasudi_(integer *, integer *, integer *, integer *); - integer minadr, maxadr, scrhan, lastla[3]; - extern /* Subroutine */ int dassih_(integer *, char *, ftnlen), dashlu_( - integer *, integer *), daswbr_(integer *), dasrri_(integer *, - integer *, integer *, integer *, integer *); - integer offset; - extern /* Subroutine */ int dasioi_(char *, integer *, integer *, integer - *, ftnlen); - integer lastrc[3]; - extern /* Subroutine */ int dasops_(integer *), dasufs_(integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *), chkout_(char *, ftnlen); - integer lastwd[3], nresvc; - extern logical return_(void); - integer nresvr, savtyp, prvtyp, loc, pos; - -/* $ Abstract */ - -/* Segregate the data records in a DAS file into clusters, using */ -/* one cluster per data type present in the file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* ORDER */ -/* SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If a Fortran read attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The state of the DAS file undergoing re-ordering will be */ -/* indeterminate. */ - -/* 3) If a Fortran write attempted by this routine fails, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The state of the DAS file undergoing re-ordering will be */ -/* indeterminate. */ - -/* 4) If any other I/O error occurs during the re-arrangement of */ -/* the records in the indicated DAS file, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* Normally, there should be no need for routines outside of */ -/* SPICELIB to call this routine. */ - -/* The effect of this routine is to re-arrange the data records */ -/* in a DAS file so that the file contains a single cluster for */ -/* each data type present in the file: in the general case, there */ -/* will be a single cluster of each of the integer, double */ -/* precision, and character data types. */ - -/* The relative order of data records of a given type is not */ -/* affected by this re-ordering. After the re-ordering, the DAS */ -/* file contains a single directory record that has one descriptor */ -/* for each cluster. After that point, the order in the file of the */ -/* sets of data records of the various data types will be: */ - -/* +-------+ */ -/* | CHAR | */ -/* +-------+ */ -/* | DP | */ -/* +-------+ */ -/* | INT | */ -/* +-------+ */ - -/* Files that contain multiple directory records will have all but */ -/* the first directory record moved to the end of the file when the */ -/* re-ordering is complete. These records are not visible to the */ -/* DAS system and will be overwritten if data is subsequently added */ -/* to the DAS file. */ - -/* The purpose of segregating a DAS file's data records into three */ -/* clusters is to make read access more efficient: when a DAS file */ -/* contains a single directory with at most three cluster type */ -/* descriptors, mapping logical to physical addresses can be done */ -/* in constant time. */ - -/* $ Examples */ - -/* 1) Segregate data records in a DAS file designated by */ -/* HANDLE: */ - -/* CALL DASSDR ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */ - -/* Added test of FAILED after each DAS call, or sequence of calls, */ -/* which returns immediately if FAILED is true. This fixes a bug */ -/* where DASOPS signals an error and then DASSDR has a */ -/* segmentation fault. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */ - -/* Bug fix: call to CLEARD replaced with call to */ -/* CLEARI. */ - -/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) (MJS) */ - -/* Bug fix: extraneous commas removed from argument lists */ -/* in calls to DASADI. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* segregate the data records in a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */ - -/* Added test of failed after each DAS call, or sequence of calls, */ -/* which returns immediately if FAILED is true. This fixes a bug */ -/* where DASOPS signals an error and then DASSDR has a */ -/* segmentation fault. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */ - -/* Bug fix: call to CLEARD replaced with call to */ -/* CLEARI. */ - -/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) */ - -/* Bug fix: extraneous commas removed from argument lists */ -/* in calls to DASADI. This bug had no visible effect on */ -/* VAX and Sun systems, but generated a compile error under */ -/* Lahey Fortran. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Data type parameters */ - - -/* Directory pointer locations (backward and forward): */ - - -/* Directory address range location base */ - - -/* Location of first type descriptor */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* NEXT and PREV map the DAS data type codes to their */ -/* successors and predecessors, respectively. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASSDR", (ftnlen)6); - } - -/* Before starting, make sure that this DAS file is open for */ -/* writing. */ - - dassih_(handle, "WRITE", (ftnlen)5); - -/* Get the logical unit for this file. */ - - dashlu_(handle, &unit); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Write out any buffered records that belong to the file. */ - - daswbr_(handle); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* We're going to re-order the physical records in the DAS file, */ -/* starting with the first record after the first directory. */ -/* The other directory records are moved to the end of the file */ -/* as a result of the re-ordering. */ - -/* The re-ordering algorithm is based on that used in the REORDx */ -/* routines. To use this algorithm, we'll build an order vector */ -/* for the records to be ordered; we'll construct this order vector */ -/* in a scratch DAS file. First, we'll traverse the directories */ -/* to build up a sort of inverse order vector that tells us the */ -/* final destination and data type of each data record; from this */ -/* inverse vector we can easily build a true order vector. The */ -/* cycles of the true order vector can be traversed without */ -/* repetitive searching, and with a minimum of assignment of the */ -/* contents of data records to temporary variables. */ - - -/* Allocate a scratch DAS file to keep our vectors in. */ - - dasops_(&scrhan); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Now build up our `inverse order vector'. This array is an */ -/* inverse order vector only in loose sense: it actually consists */ -/* of an integer array that contains a sequence of pairs of integers, */ -/* the first of which indicates a data type, and the second of which */ -/* is an ordinal number. There is one pair for each data record in */ -/* the file. The ordinal number gives the ordinal position of the */ -/* record described by the number pair, relative to the other records */ -/* of the same type. Directory records are considered to have type */ -/* `directory', which is represented by the code DIR. */ - -/* We also must maintain a count of records of each type. */ - - cleari_(&c__4, count); - -/* Get the file summary for the DAS file to be segregated. */ - - dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Find the record and word positions LREC and LWORD of the last */ -/* descriptor in the file, and also find the type of the descriptor */ -/* LTYPE. */ - - maxai_(lastrc, &c__3, &lrec, &loc); - lword = 0; - for (i__ = 1; i__ <= 3; ++i__) { - if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", - i__1, "dassdr_", (ftnlen)451)] == lrec && lastwd[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dassd" - "r_", (ftnlen)451)] > lword) { - lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dassdr_", (ftnlen)454)]; - ltype = i__; - } - } - -/* The first directory starts after the last comment record. */ - - recno = nresvr + ncomr + 2; - while(recno <= lrec && recno > 0) { - -/* Read the directory record. */ - - dasrri_(handle, &recno, &c__1, &c__256, irec); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Increment the directory count. */ - - ++count[3]; - -/* Add the data type (`directory') and count (1) of the current */ -/* record to the inverse order vector. */ - - dasadi_(&scrhan, &c__1, &c__4); - dasadi_(&scrhan, &c__1, &count[3]); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Set up our `finite state machine' that tells us the data */ -/* types of the records described by the last read directory. */ - - type__ = irec[8]; - prvtyp = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "prev", i__1, "dassdr_", (ftnlen)498)]; - -/* Now traverse the directory and update the inverse order */ -/* vector based on the descriptors we find. */ - - more = TRUE_; - i__ = 10; - while(more) { - -/* Obtain the count for the current descriptor. */ - - n = (i__2 = irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("irec", i__1, "dassdr_", (ftnlen)512)], abs(i__2)); - -/* Update our inverse order vector to describe the positions */ -/* of the N records described by the current descriptor. */ - - i__1 = n; - for (j = 1; j <= i__1; ++j) { - dasadi_(&scrhan, &c__1, &type__); - i__3 = count[(i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : - s_rnge("count", i__2, "dassdr_", (ftnlen)521)] + j; - dasadi_(&scrhan, &c__1, &i__3); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - } - -/* Adjust the count of records of data type TYPE. */ - - count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("count" - , i__1, "dassdr_", (ftnlen)533)] = count[(i__2 = type__ - - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dass" - "dr_", (ftnlen)533)] + n; - -/* Find the next type. */ - - ++i__; - if (i__ > 256 || recno == lrec && i__ > lword) { - more = FALSE_; - } else { - if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "irec", i__1, "dassdr_", (ftnlen)547)] > 0) { - type__ = next[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("next", i__1, "dassdr_", (ftnlen)548)]; - } else if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("irec", i__1, "dassdr_", (ftnlen)550)] < 0) { - type__ = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("prev", i__1, "dassdr_", (ftnlen)551)]; - } else { - more = FALSE_; - } - } - } - -/* The forward pointer in this directory tells us where the */ -/* next directory record is. When there are no more directory */ -/* records, this pointer will be zero. */ - - recno = irec[1]; - } - -/* At this point, the inverse order vector is set up. The array */ -/* COUNT contains counts of the number of records of each type we've */ -/* seen. Set TOTAL to the total number of records that we've going */ -/* to permute. */ - - total = sumai_(count, &c__4); - -/* The next step is to build a true order vector. Let BASE be */ -/* the base address for the order vector; this address is the */ -/* last logical address of the inverse order vector. */ - - base = total << 1; - -/* We'll store the actual order vector in locations BASE + 1 */ -/* through BASE + TOTAL. In addition, we'll build a parallel array */ -/* that contains, for each element of the order vector, the type of */ -/* data corresponding to that element. This type vector will */ -/* reside in locations BASE + TOTAL + 1 through BASE + 2*TOTAL. */ - -/* Before setting the values of the order vector and its parallel */ -/* type vector, we'll allocate space in the scratch DAS file by */ -/* zeroing out the locations we plan to use. After this, locations */ -/* BASE+1 through BASE + 2*TOTAL can be written to in random access */ -/* fashion using DASUDI. */ - - - i__1 = total << 1; - for (i__ = 1; i__ <= i__1; ++i__) { - dasadi_(&scrhan, &c__1, &c__0); - } - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* We note that the way to construct the inverse of a permutation */ -/* SIGMA in a single loop is suggested by the relation */ - -/* -1 */ -/* SIGMA ( SIGMA(I) ) = I */ - -/* We'll use this method. In our case, our order vector plays */ -/* the role of */ - -/* -1 */ -/* SIGMA */ - -/* and the `inverse order vector' plays the role of SIGMA. We'll */ -/* exclude the first directory from the order vector, since it's */ -/* an exception: we wish to reserve this record. Since the first */ -/* element of the order vector (logically) contains the index 1, we */ -/* can ignore it. */ - - - i__1 = total; - for (i__ = 2; i__ <= i__1; ++i__) { - i__2 = (i__ << 1) - 1; - i__3 = (i__ << 1) - 1; - dasrdi_(&scrhan, &i__2, &i__3, &type__); - i__2 = i__ << 1; - i__3 = i__ << 1; - dasrdi_(&scrhan, &i__2, &i__3, &dest); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Set DEST to the destination location, measured as an offset */ -/* from the last comment record, of the Ith record by adding */ -/* on the count of the predecessors of the block of records of */ -/* TYPE. */ - - for (j = 1; j <= 3; ++j) { - if (type__ > j) { - dest += count[(i__2 = j - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge( - "count", i__2, "dassdr_", (ftnlen)648)]; - } - } - -/* The destination offset of each record should be incremented to */ -/* allow room for the first directory record. However, we don't */ -/* need to do this for directory records; they'll already have */ -/* this offset accounted for. */ - - if (type__ != 4) { - ++dest; - } - -/* The value of element DEST of the order vector is I. */ -/* Write this value to location BASE + DEST. */ - - i__2 = base + dest; - i__3 = base + dest; - dasudi_(&scrhan, &i__2, &i__3, &i__); - -/* We want the ith element of the order vector to give us the */ -/* number of the record to move to position i (offset from the */ -/* last comment record), but we want the corresponding element */ -/* of the type array to give us the type of the record currently */ -/* occupying position i. */ - - i__2 = base + i__ + total; - i__3 = base + i__ + total; - dasudi_(&scrhan, &i__2, &i__3, &type__); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - } - -/* Ok, here's what we've got in the scratch file that's still of */ -/* interest: */ - -/* -- In integer logical addresses BASE + 1 : BASE + TOTAL, */ -/* we have an order vector. The Ith element of this */ -/* vector indicates the record that should be moved to */ -/* location DRBASE + I in the DAS file we're re-ordering, */ -/* where DRBASE is the base address of the data records */ -/* (the first directory record follows the record having this */ -/* index). */ - - -/* -- In integer logical addresses BASE + TOTAL + 1 : BASE + */ -/* 2*TOTAL, we have data type indicators for the records to */ -/* be re-ordered. The type for the Ith record in the file, */ -/* counted from the last comment record, is located in logical */ -/* address BASE + TOTAL + I. */ - - - drbase = nresvr + ncomr + 1; - -/* As we traverse the order vector, we flip the sign of elements */ -/* we've accessed, so that we can tell when we encounter an element */ -/* of a cycle that we've already traversed. */ - -/* Traverse the order vector. The variable START indicates the */ -/* first element to look at. Ignore the first element; it's a */ -/* singleton cycle. */ - - - start = 2; - while(start < total) { - -/* Traverse the current cycle of the order vector. */ - -/* We `make a hole' in the file by saving the record in position */ -/* START, then we traverse the cycle in reverse order, filling in */ -/* the hole at the ith position with the record whose number is */ -/* the ith element of the order vector. At the end, we deposit */ -/* the saved record into the `hole' left behind by the last */ -/* record we moved. */ - -/* We're going to read and write records to and from the DAS file */ -/* directly, rather than going through the buffering system. */ -/* This will allow us to avoid any untoward interactions between */ -/* the buffers for different data types. */ - - i__1 = base + total + start; - i__2 = base + total + start; - dasrdi_(&scrhan, &i__1, &i__2, &savtyp); - i__1 = base + start; - i__2 = base + start; - dasrdi_(&scrhan, &i__1, &i__2, &offset); - -/* Save the record at the location DRBASE + START. */ - - if (savtyp == 1) { - i__1 = drbase + start; - dasioc_("READ", &unit, &i__1, savec, (ftnlen)4, (ftnlen)1024); - } else if (savtyp == 2) { - i__1 = drbase + start; - dasiod_("READ", &unit, &i__1, saved, (ftnlen)4); - } else { - i__1 = drbase + start; - dasioi_("READ", &unit, &i__1, savei, (ftnlen)4); - } - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Let I be the index of the record that we are going to move */ -/* data into next. I is an offset from the last comment record. */ - - i__ = start; - while(offset != start) { - -/* Mark the order vector element by writing its negative */ -/* back to the location it came from. */ - - i__1 = base + i__; - i__2 = base + i__; - i__3 = -offset; - dasudi_(&scrhan, &i__1, &i__2, &i__3); - -/* Move the record at location */ - -/* DRBASE + OFFSET */ - -/* to location */ - -/* DRBASE + I */ - -/* There is no need to do anything about the corresponding */ -/* elements of the type vector; we won't need them again. */ - -/* The read and write operations, as well as the temporary */ -/* record required to perform the move, are dependent on the */ -/* data type of the record to be moved. */ - - i__1 = base + total + offset; - i__2 = base + total + offset; - dasrdi_(&scrhan, &i__1, &i__2, &type__); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Only pick records up if we're going to put them down in */ -/* a location other than their original one. */ - - if (i__ != offset) { - if (type__ == 1) { - i__1 = drbase + offset; - dasioc_("READ", &unit, &i__1, crec, (ftnlen)4, (ftnlen) - 1024); - i__1 = drbase + i__; - dasioc_("WRITE", &unit, &i__1, crec, (ftnlen)5, (ftnlen) - 1024); - } else if (type__ == 2) { - i__1 = drbase + offset; - dasiod_("READ", &unit, &i__1, drec, (ftnlen)4); - i__1 = drbase + i__; - dasiod_("WRITE", &unit, &i__1, drec, (ftnlen)5); - } else { - i__1 = drbase + offset; - dasioi_("READ", &unit, &i__1, irec, (ftnlen)4); - i__1 = drbase + i__; - dasioi_("WRITE", &unit, &i__1, irec, (ftnlen)5); - } - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - } - -/* OFFSET is the index of the next order vector element to */ -/* look at. */ - - i__ = offset; - i__1 = base + i__; - i__2 = base + i__; - dasrdi_(&scrhan, &i__1, &i__2, &offset); - i__1 = base + i__ + total; - i__2 = base + i__ + total; - dasrdi_(&scrhan, &i__1, &i__2, &type__); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - } - -/* The last value of I is the location in the cycle that element */ -/* START followed. Therefore, the saved record corresponding */ -/* to index START should be written to this location. */ - - if (savtyp == 1) { - i__1 = drbase + i__; - dasioc_("WRITE", &unit, &i__1, savec, (ftnlen)5, (ftnlen)1024); - } else if (savtyp == 2) { - i__1 = drbase + i__; - dasiod_("WRITE", &unit, &i__1, saved, (ftnlen)5); - } else { - i__1 = drbase + i__; - dasioi_("WRITE", &unit, &i__1, savei, (ftnlen)5); - } - -/* Mark the order vector element by writing its negative */ -/* back to the location it came from. */ - - i__1 = base + i__; - i__2 = base + i__; - i__3 = -start; - dasudi_(&scrhan, &i__1, &i__2, &i__3); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - -/* Update START so that it points to the first element of a cycle */ -/* of the order vector that has not yet been traversed. This will */ -/* be the first positive element of the order vector in a location */ -/* indexed higher than the current value of START. Note that */ -/* this way of updating START guarantees that we don't have to */ -/* backtrack to find an element in the next cycle. */ - - offset = -1; - while(offset < 0 && start < total) { - ++start; - i__1 = base + start; - i__2 = base + start; - dasrdi_(&scrhan, &i__1, &i__2, &offset); - if (failed_()) { - chkout_("DASSDR", (ftnlen)6); - return 0; - } - } - -/* At this point, START is the index of an element in the order */ -/* vector that belongs to a cycle where no routine has gone */ -/* before, or else START is the last index in the order vector, */ -/* in which case we're done. */ - - } - -/* At this point, the records in the DAS are organized as follows: */ - -/* +----------------------------------+ */ -/* | File record | ( 1 ) */ -/* +----------------------------------+ */ -/* | Reserved records | ( 0 or more ) */ -/* | | */ -/* +----------------------------------+ */ -/* | Comment records | ( 0 or more ) */ -/* | | */ -/* | | */ -/* +----------------------------------+ */ -/* | First directory record | ( 1 ) */ -/* +----------------------------------+ */ -/* | Character data records | ( 0 or more ) */ -/* | | */ -/* +----------------------------------+ */ -/* | Double precision data records | ( 0 or more ) */ -/* | | */ -/* +----------------------------------+ */ -/* | Integer data records | ( 0 or more ) */ -/* | | */ -/* +----------------------------------+ */ -/* | Additional directory records | ( 0 or more ) */ -/* | | */ -/* +----------------------------------+ */ - - -/* Not all of the indicated components must be present; only the */ -/* file record and first directory record will exist in all cases. */ -/* The `additional directory records' at the end of the file serve */ -/* no purpose; if more data is appended to the file, they will be */ -/* overwritten. */ - -/* The last step in preparing the file is to fill in the first */ -/* directory record with the correct information, and to update */ -/* the file summary. */ - - - recno = drbase + 1; - cleari_(&c__256, irec); - -/* Set the logical address ranges in the directory record, for each */ -/* data type. */ - - for (type__ = 1; type__ <= 3; ++type__) { - maxadr = lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastla", i__1, "dassdr_", (ftnlen)957)]; - if (maxadr > 0) { - minadr = 1; - } else { - minadr = 0; - } - irec[(i__1 = type__ << 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("irec", - i__1, "dassdr_", (ftnlen)965)] = minadr; - irec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "irec", i__1, "dassdr_", (ftnlen)966)] = maxadr; - } - -/* Set the descriptors in the directory. Determine which type */ -/* comes first: the order of priority is character, double */ -/* precision, integer. */ - - pos = 9; - for (type__ = 1; type__ <= 3; ++type__) { - if (lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("las" - "tla", i__1, "dassdr_", (ftnlen)979)] > 0) { - if (pos == 9) { - -/* This is the first type for which any data is present. */ -/* We must enter a type code at position BEGDSC in the */ -/* directory, and we must enter a count at position */ -/* BEGDSC+1. */ - - irec[8] = type__; - irec[9] = count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("count", i__1, "dassdr_", (ftnlen)989)]; - lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastrc", i__1, "dassdr_", (ftnlen)990)] = recno; - lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dassdr_", (ftnlen)991)] = 10; - pos += 2; - prvtyp = type__; - } else { - -/* Place an appropriately signed count at location POS in */ -/* the directory. */ - - if (type__ == next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("next", i__1, "dassdr_", (ftnlen)1000)]) - { - irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "irec", i__1, "dassdr_", (ftnlen)1001)] = count[( - i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : - s_rnge("count", i__2, "dassdr_", (ftnlen)1001)]; - } else { - irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "irec", i__1, "dassdr_", (ftnlen)1003)] = -count[( - i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 : - s_rnge("count", i__2, "dassdr_", (ftnlen)1003)]; - } - lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastrc", i__1, "dassdr_", (ftnlen)1006)] = recno; - lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "lastwd", i__1, "dassdr_", (ftnlen)1007)] = pos; - ++pos; - prvtyp = type__; - } - } - } - -/* Since we've done away with all but the first directory, the first */ -/* free record is decremented by 1 less than the directory count. */ - - free = free - count[3] + 1; - -/* Write out the new directory record. Don't use the DAS buffered */ -/* write mechanism; this could trash the file by dumping buffered */ -/* records in the wrong places. */ - - dasioi_("WRITE", &unit, &recno, irec, (ftnlen)5); - -/* Write out the updated file summary. */ - - dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc, - lastwd); - -/* Clean up the DAS data buffers: we don't want buffered scratch */ -/* file records hanging around there. Then get rid of the scratch */ -/* file. */ - - daswbr_(&scrhan); - dasllc_(&scrhan); - chkout_("DASSDR", (ftnlen)6); - return 0; -} /* dassdr_ */ - diff --git a/ext/spice/src/cspice/dastb.c b/ext/spice/src/cspice/dastb.c deleted file mode 100644 index 067669a31f..0000000000 --- a/ext/spice/src/cspice/dastb.c +++ /dev/null @@ -1,2249 +0,0 @@ -/* dastb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__4 = 4; - -/* $Procedure DASTB ( DAS, convert transfer file to binary file ) */ -/* Subroutine */ int dastb_(integer *xfrlun, char *binfil, ftnlen binfil_len) -{ - /* System generated locals */ - cilist ci__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), - e_rsle(void), s_cmp(char *, char *, ftnlen, ftnlen), s_rsfe( - cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void); - - /* Local variables */ - char line[255]; - logical more; - char word[255], rest[255]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomc; - logical inblk; - char tarch[8]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer recno, ncomr; - char ttype[8]; - extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), dasadc_(integer *, integer *, integer *, integer - *, char *, ftnlen), dasadd_(integer *, integer *, doublereal *); - extern logical failed_(void); - extern /* Subroutine */ int dasadi_(integer *, integer *, integer *); - integer ncdata, handle, nddata; - extern /* Subroutine */ int dasacr_(integer *, integer *); - char ifname[60]; - integer nidata; - extern /* Subroutine */ int rdencc_(integer *, integer *, char *, ftnlen); - char crecrd[1024]; - extern /* Subroutine */ int rdenci_(integer *, integer *, integer *), - dasioc_(char *, integer *, integer *, char *, ftnlen, ftnlen); - char cbuffr[4*1024]; - doublereal dbuffr[1024]; - integer bindex, blkcnt, dtacnt, eindex, ibuffr[1024], daslun; - char idword[8]; - integer bcount, numblk, numdta, ecount; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen); - char errmsg[320]; - integer nresvc; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer numlft; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), chkout_( - char *, ftnlen), dasonw_(char *, char *, char *, integer *, - integer *, ftnlen, ftnlen, ftnlen), daswfr_(integer *, char *, - char *, integer *, integer *, integer *, integer *, ftnlen, - ftnlen), dascls_(integer *), dashlu_(integer *, integer *); - integer tcount; - extern /* Subroutine */ int nextwd_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - extern logical return_(void); - integer errptr, nresvr; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen), rdencd_(integer *, integer *, doublereal *); - - /* Fortran I/O blocks */ - static cilist io___3 = { 1, 0, 1, 0, 0 }; - static cilist io___7 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Convert the contents of a DAS transfer file into an equivalent */ -/* binary DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* XFRLUN I Logical unit of an open DAS transfer file. */ -/* BINFIL I Name of the binary DAS file to be created. */ - -/* $ Detailed_Input */ - -/* XFRLUN The Fortran logical unit number of a previously opened */ -/* DAS transfer file. */ - -/* The file pointer should be positioned ready to read */ -/* the DAS file ID word. */ - -/* BINFIL The name of the binary DAS file to be created. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments XFRLUN, BINFIL. */ - -/* $ Exceptions */ - -/* 1) If the DAS transfer file cannot be read, the error */ -/* SPICE(FILEREADFAILED) will be signalled. */ - -/* 2) If the specified file is not a DAS file, as indicated by the */ -/* file's ID word, the error SPICE(NOTADASFILE) is signalled. */ - -/* 3) If an error occurs while attempting to decode data in the */ -/* DAS transfer file, the error SPICE(BADDASTRANSFERFILE) will */ -/* be signalled. */ - -/* 4) If the DAS file cannot be written, a DAS file access routine */ -/* will signal an error with an appropriate error message. */ - -/* 5) The binary DAS file opened by this routine, BINFIL, is only */ -/* GUARANTEED to be closed upon successful completion of the */ -/* text to binary conversion process. In the event of an error, */ -/* the caller of this routine is required to close the binary */ -/* DAS file BINFIL. */ - -/* $ Particulars */ - -/* Any binary DAS file may be transferred between heterogeneous */ -/* Fortran environments by converting it to an equivalent file */ -/* containing only ASCII characters called a DAS transfer file. */ -/* Such a file can be transferred almost universally using any number */ -/* of established protocols. Once transferred, the DAS transfer file */ -/* can be converted to a binary file using the representations native */ -/* to the new host environment. */ - -/* This routine provides a mechanism for converting a DAS */ -/* transfer file created by DASBT, or an equivalent procedure, */ -/* into an equivalent binary DAS file which may be used with the */ -/* SPICE system. It is one of a pair of routines for performing */ -/* conversions between the binary format of a DAS file and the DAS */ -/* transfer file. The inverse of this routine is the routine DASTB. */ - -/* Upon successful completion, the binary DAS file specified by */ -/* BINFIL will have been created. The binary DAS file that was */ -/* created will be closed when this routine exits. The DAS transfer */ -/* file will remain open, as it was on entry, and it will be */ -/* positioned to read the first line after the encoded DAS file data. */ - -/* $ Examples */ - -/* Let */ - -/* XFRLUN be the Fortran logical unit attached to a DAS transfer */ -/* file which is to be converted into its binary DAS */ -/* equivalent. */ - -/* BINFIL be the name of the binary DAS file which will be */ -/* created. */ - -/* Then, the following subroutine call would read the DAS transfer */ -/* file attached to the Fortran logical unit XFRLUN, convert its data */ -/* into binary format, and write that data to the binary DAS file */ -/* which is being created: */ - -/* CALL DASTB( XFRLUN, BINFIL ) */ - -/* $ Restrictions */ - -/* 1) This routine assumes that it is positioned ready to read the */ -/* DAS file ID word from the encoded text DAS file. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.0, 06-DEC-1995 (KRG) */ - -/* Updated the call to DASONW; a new argument was added to the */ -/* call for reserving comment records. */ - -/* - SPICELIB Version 3.0.0, 13-AUG-1994 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name XFRLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* Changed the short error message "BADDASTEXTFILE" to the */ -/* message "BADDASTRANSFERFILE". */ - -/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ - -/* Updated the routine to use the new format ID words which */ -/* contain type as well as architecture information. */ -/* C */ -/* Fixed a typo in the description of the DAS encoded text file: */ -/* ncomc appeared where nresvc should have been. */ - -/* - SPICELIB Version 1.0.0, 02-NOV-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert das transfer file to binary das */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.1.0, 06-DEC-1995 (KRG) */ - -/* Updated the call to DASONW; a new argument was added to the */ -/* call for reserving comment records. The value used here is */ -/* zero (0). */ - -/* - SPICELIB Version 3.0.0, 13-AUG-1994 (KRG) */ - -/* Updated the header and in line comments to reflect the change */ -/* from calling files text files to calling them transfer files. */ - -/* Changed the variable name XFRLUN to XFRLUN to make it */ -/* compatible with the change in terminology. */ - -/* Changed the short error message "BADDASTEXTFILE" to the */ -/* message "BADDASTRANSFERFILE". */ - -/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ - -/* Updated the routine to use the new format ID words which */ -/* contain type as well as architecture information. */ - -/* Changed the wording of exception '2)' so that it would make */ -/* sense with the ID word format change that was made. */ - -/* Changed the error */ - -/* SPICE(DASIDWORDNOTKNOWN) */ - -/* to */ - -/* SPICE(NOTADASFILE) */ - -/* Added variables to support the file architecture and type */ -/* stored in the ID word. These are used in order to verify that */ -/* the text file that is to be converted is indeed a DAS file. */ -/* This test is performed instead of testing whether the ID word */ -/* is equal to 'NAIF/DAS'. */ - -/* Modified the long error message that was set to conform to the */ -/* ID word change. */ - -/* Changed the DASOPN call to DASONW to support the addition of */ -/* type information to the ID word. */ - -/* Fixed a typo in the description of the DAS encoded text file: */ -/* ncomc appeared where nresvc should have been. */ - -/* - SPICELIB Version 1.0.0, 02-NOV-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* CHARACTER*(*) BEGRES */ -/* PARAMETER ( BEGRES = 'BEGIN_RESERVED_BLOCK' ) */ - -/* CHARACTER*(*) ENDRES */ -/* PARAMETER ( ENDRES = 'END_RESERVED_BLOCK' ) */ - -/* CHARACTER*(*) TRRBLK */ -/* PARAMETER ( TRRBLK = 'TOTAL_RESERVED_BLOCKS' ) */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASTB", (ftnlen)5); - } - -/* A DAS transfer file contains in an encoded form all of the data */ -/* from the original binary DAS file. This includes the reserved */ -/* record area, the comment area, and the character, double */ -/* precision, and integer data arrays as well. */ - -/* Currently, the reserved record area has not been implemented, as */ -/* there is no need for it at this time. If, or when, the reserved */ -/* record area is implemented, this routine will need to be modified */ -/* in order to support it. See the code for details. */ - -/* The data in the DAS transfer file are available as sequences of */ -/* small blocks of data. This is to provide a means for performing */ -/* some error detection when converting a DAS transfer file into its */ -/* binary equivalent. Each block of data is enclosed within begin and */ -/* end block markers which hold the count of data items in a data */ -/* block. When all of the data blocks for a data area have been */ -/* written, a total blocks line is read to verify that all of the */ -/* data has been converted. */ - -/* The data in the DAS transfer file MUST appear in the following */ -/* order for this routine to work properly. */ - -/* 1) Reserved records (when/if implemented) */ -/* 2) Comment area */ -/* 3) Character data array */ -/* 4) Double precision data array */ -/* 5) Integer data array */ - -/* If the data count for any of these DAS data areas is zero, */ -/* conversion proceeds with the next DAS data area in the list. */ - -/* For example, suppose that we have a binary DAS file where there */ -/* are 0 reserved characters in the reserved record area, 5000 */ -/* comment characters in the comment area, and that the character, */ -/* double precision, and integer array counts are 0, 2300, and */ -/* 6900, respectively. Then, the DAS encoded text file will contain */ -/* no reserved record data blocks, 2 comment data blocks, no */ -/* character data blocks, 3 double precision data blocks, and 7 */ -/* integer data blocks, in that order. */ - -/* DAS encoded text file description. */ -/* ---------------------------------- */ - - -/* A brief description of the DAS encoded file format and its */ -/* intended use follows. This description is intended to provide a */ -/* simple ``picture'' of the DAS transfer file format to aid in the */ -/* understanding of this routine. This description is NOT intended to */ -/* be a detailed specification of the file format. */ - -/* A DAS transfer file contains all of the data from a binary */ -/* DAS file in an encoded ASCII format. It also contains some */ -/* bookkeeping information for maintaining the integrity of the */ -/* data. The DAS transfer file format allows the full precision of */ -/* character, integer, and floating point numeric data to be */ -/* maintained in a portable fashion. The DAS transfer file format is */ -/* intended to provide a reliable and accurate means for porting data */ -/* among multiple computer systems and for the archival storage of */ -/* data. */ - -/* A DAS transfer file is not intended to be used directly to provide */ -/* data to a program. The equivalent binary DAS file is to be used */ -/* for this purpose. In no way should any program, other than a DAS */ -/* binary <-> transfer conversion program, rely on the DAS transfer */ -/* file format. */ - -/* To correctly understand the DAS transfer file description the */ -/* reader should be familiar with the DAS file architecture. Items */ -/* enclosed in angle brackets, '<' and '>', are used to represent the */ -/* data which are to be placed at that position in the file. The */ -/* bookkeeping information which appears is represented exactly as it */ -/* would appear in a DAS transfer file. */ - -/* Let */ - -/* denote the beginning of the file */ -/* denote the end of the file */ - -/* and */ - -/* nresvb denote the number of encoded reserved record data */ -/* blocks generated */ -/* nresvc denote the total number of reserved record characters */ -/* in the reserved record area of a DAS file */ -/* ncomb denote the number of encoded comment data blocks */ -/* generated */ -/* ncomc denote the total number of comment characters in the */ -/* comment area of a DAS file */ -/* nchrb denote the number of encoded character data blocks */ -/* generated */ -/* nchrs denote the count of characters in the DAS character */ -/* data array */ -/* ndpb denote the number of encoded double precision data */ -/* blocks generated */ -/* ndps denote the count of double precision numbers in the DAS */ -/* double precision data array */ -/* nintb denote the number of encoded integer data blocks */ -/* generated */ -/* nints denote the count of integers in the DAS integer data */ -/* array */ - -/* A DAS encoded transfer file has the following format: */ - -/* */ -/* < Information line > */ -/* < DAS file ID word > */ -/* < Internal filename > */ -/* < Encoded count of reserved records > */ -/* < Encoded count of reserved characters > */ -/* < Encoded count of comment records > */ -/* < Encoded count of comment characters > */ -/* < Blocks of encoded reserved record data, if nresvc > 0 > */ -/* TOTAL_RESERVED_BLOCKS nresvb nresvc */ -/* < Blocks of encoded comment data, if ncomc > 0 > */ -/* TOTAL_COMMENT_BLOCKS ncomb ncomc */ -/* < Encoded count of character data > */ -/* < Encoded count of double precision data > */ -/* < Encoded count of integer data > */ -/* < Blocks of encoded character data, if nchrs > 0 > */ -/* TOTAL_CHARACTER_BLOCKS nchrb nchrs */ -/* < Blocks of encoded double precision data, if ndps > 0 > */ -/* TOTAL_DP_BLOCKS ndpb ndps */ -/* < Blocks of encoded integer data, if nints > 0 > */ -/* TOTAL_INTEGER_BLOCKS nintb nints */ -/* */ - -/* This routine will check the SPICELIB function FAILED() after */ -/* each call, or consecutive sequence of calls, to data encoding */ -/* routines, and if an error was signalled it will simply check out */ -/* and return to the caller. */ - -/* This routine will check the SPICELIB function FAILED() after */ -/* each DAS file access call, and if an error was signalled it will */ -/* simply check out and return to the caller. */ - -/* We begin by reading the DAS file ID word from the DAS transfer */ -/* file. We should have been positioned ready to read this. If an */ -/* error occurs, set an appropriate error message and signal the */ -/* error. */ - - s_copy(idword, " ", (ftnlen)8, (ftnlen)1); - io___3.ciunit = *xfrlun; - iostat = s_rsle(&io___3); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, idword, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsle(); -L100001: - if (iostat != 0) { - setmsg_("Error reading the file ID word from the DAS transfer file: " - "#. IOSTAT = #.", (ftnlen)73); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check the DAS ID word. When checking the ID word all we care about */ -/* is that we are attempting to convert a DAS file. So, split the */ -/* ID word into its architecture and type and check the architecture. */ - - idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)8, (ftnlen)8); - if (s_cmp(tarch, "DAS", (ftnlen)8, (ftnlen)3) != 0) { - setmsg_("File architecture was not 'DAS' for file #.", (ftnlen)43); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(NOTADASFILE)", (ftnlen)18); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Read the internal filename for the DAS file. */ - - s_copy(ifname, " ", (ftnlen)60, (ftnlen)1); - io___7.ciunit = *xfrlun; - iostat = s_rsle(&io___7); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__9, &c__1, ifname, (ftnlen)60); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsle(); -L100002: - if (iostat != 0) { - setmsg_("Error reading the internal filename from the DAS transfer f" - "ile: #. IOSTAT = #.", (ftnlen)78); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Open a new binary DAS file and write its file record. */ - - dasonw_(binfil, ttype, ifname, &c__0, &handle, binfil_len, (ftnlen)8, ( - ftnlen)60); - if (failed_()) { - -/* If an error occurred while opening the new DAS file, */ -/* then check out and return. */ - - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Write the initial file record to the newly opened DAS file. This */ -/* call will overwrite the ID word set when we opened the file with */ -/* the ID word from the DAS transfer file. We got to this point, so */ -/* we know that the ID word was a good one. */ - - ncomr = 0; - ncomc = 0; - nresvr = 0; - nresvc = 0; - daswfr_(&handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, ( - ftnlen)8, (ftnlen)60); - if (failed_()) { - -/* If an error occurred while writing the DAS file record, */ -/* attempt to close the binary file, then check out and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Read and decode the number of reserved records and reserved */ -/* characters. */ - - rdenci_(xfrlun, &c__1, &nresvr); - rdenci_(xfrlun, &c__1, &nresvc); - if (failed_()) { - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to be sure that the number of reserved records and the */ -/* number of reserved characters are not being used. The DAS */ -/* reserved record area is not currently implemented, so nobody */ -/* should be using it. */ - - if (nresvc != 0) { - -/* Close the file, signal the error, and exit. */ - - dascls_(&handle); - setmsg_("The number of reserved characters was nonzero (#) in file: " - "#, but the DAS reserved record area has NOT been implemented" - " yet!", (ftnlen)124); - errint_("#", &nresvc, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASFILE)", (ftnlen)17); - chkout_("DASTB", (ftnlen)5); - return 0; - } - if (nresvr != 0) { - -/* Close the file, signal the error, and exit. */ - - dascls_(&handle); - setmsg_("The number of reserved records was nonzero (#) in file: #, " - "but the DAS reserved record area has NOT been implemented ye" - "t!", (ftnlen)121); - errint_("#", &nresvr, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASFILE)", (ftnlen)17); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Read and decode the number of comment records and comment */ -/* characters. */ - - rdenci_(xfrlun, &c__1, &ncomr); - rdenci_(xfrlun, &c__1, &ncomc); - if (failed_()) { - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Begin converting the DAS transfer file into an equivalent */ -/* binary DAS file here. */ - -/* The reserved records, if there are any. */ - -/* ************************************************************** */ -/* When/if the reserved record area is implemented, the code to */ -/* read it from the DAS transfer file and convert it to binary */ -/* should go here. It should be possible to simply copy the code */ -/* for the comment area, making all of the necessary variable */ -/* name changes, etc., since the reserved record area is going */ -/* to contain ONLY character data. */ -/* ************************************************************** */ - - -/* The comments, if there are any. */ - - if (ncomc > 0) { - -/* We assume that the condition NCOMC > 0 and NCOMR <= 0 */ -/* cannot occur. */ - -/* The binary DAS file that we are creating is already open, */ -/* so just add the comments. But first, convert the DAS file */ -/* handle into its equivalent logical unit. */ - - dashlu_(&handle, &daslun); - if (failed_()) { - -/* If an error occurred, attempt to close the binary file, */ -/* then check out and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Allocate the necessary comment records. */ - - dasacr_(&handle, &ncomr); - if (failed_()) { - -/* If an error occurred, attempt to close the binary file, */ -/* then checkout and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Initialize a few things: the block counter, the data */ -/* counter, and the starting record position. The starting */ -/* record position is one short of the actual first comment */ -/* record. We will increment the record number before we */ -/* write anything. */ - - blkcnt = 0; - dtacnt = 0; - recno = nresvr + 1; - -/* We currently have more to process. */ - - more = TRUE_; - -/* We are currently not processing a comment block. */ - - inblk = FALSE_; - while(more) { - s_copy(crecrd, " ", (ftnlen)1024, (ftnlen)1); - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - if (iostat != 0) { - -/* If an error occurred while reading from the DAS transfer */ -/* file close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Error reading from the DAS transfer file #. IOSTAT " - "= #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* At this point, we should be beginning a comment block, */ -/* ending a comment block, or scanning for the total number */ -/* of comment blocks. So look for the appropriate keyword. */ - - nextwd_(line, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - if (s_cmp(word, "BEGIN_COMMENT_BLOCK", (ftnlen)255, (ftnlen)19) == - 0) { - -/* Get the comment block index. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the begin block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin comment block error, could not parse bloc" - "k number. Error: # File: #", (ftnlen)73); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of characters in the block. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the beginning */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin comment block error, could not parse the " - "data count for block: #. Error: # File: #", ( - ftnlen)88); - errint_("#", &bindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we are inside a comment block, so set */ -/* the in block flag, INBLK, to .TRUE. and increment the */ -/* block counter. */ - - inblk = TRUE_; - ++blkcnt; - } else if (s_cmp(word, "END_COMMENT_BLOCK", (ftnlen)255, (ftnlen) - 17) == 0) { - -/* Get the data block index. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &eindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the end comment */ -/* block index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End comment block error, could not parse block " - "number. Error: # File: #", (ftnlen)71); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of characters in the DAS array. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &ecount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the ending data */ -/* count, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End comment block error, could not parse the da" - "ta count for block: #. Error: # File: #", ( - ftnlen)87); - errint_("#", &eindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array indices */ -/* match. */ - - if (eindex != bindex) { - -/* If the begin and end data block indices do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Comment block index mismatch: Beginning index: " - "#; Ending index: #. File: #", (ftnlen)74); - errint_("#", &bindex, (ftnlen)1); - errint_("#", &eindex, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending comment data */ -/* counts match. */ - - if (ecount != bcount) { - -/* If the begin and end data block counts do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Comment block count mismatch: Beginning count: " - "#; Ending count: #. File: #", (ftnlen)74); - errint_("#", &bcount, (ftnlen)1); - errint_("#", &ecount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully ended the */ -/* processing of a comment block, so set the in block */ -/* flag INBLK, to .FALSE.. */ - - inblk = FALSE_; - } else if (s_cmp(word, "TOTAL_COMMENT_BLOCKS", (ftnlen)255, ( - ftnlen)20) == 0) { - -/* We have the total comment blocks keyword to parse, so */ -/* get the total number of comment blocks processed. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &numblk, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the total number of */ -/* data blocks, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Comment block count error, could not parse the " - "total number of character blocks: #. File: #", ( - ftnlen)91); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the total count of comment characters. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &tcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the comment */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Comment count error, could not parse the total " - "count. Error: # File: #", (ftnlen)70); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Compare the computed block count with the block count */ -/* from the file. */ - - if (blkcnt != numblk) { - -/* If the computed number of comment blocks and the */ -/* number of comment blocks from the text file do */ -/* not match, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("The number of comment data blocks processed (#)" - " was not equal to the number of comment data blo" - "cks placed in the DAS text file (#). File: #", ( - ftnlen)139); - errint_("#", &blkcnt, (ftnlen)1); - errint_("#", &numblk, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the total count and the computed count */ -/* match. */ - - if (tcount != dtacnt) { - -/* If the total count and computed count do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Comment count mismatch: computed count: #; expe" - "cted count: #. File: #", (ftnlen)69); - errint_("#", &dtacnt, (ftnlen)1); - errint_("#", &tcount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully processed the */ -/* entire DAS comment area in the text file, so there is */ -/* no more comment data. */ - - more = FALSE_; - } else { - -/* We got an unknown keyword of some sort, so set an */ -/* appropriate error message, close the DAS file, and */ -/* return. */ - - dascls_(&handle); - setmsg_("Unknown keyword '#' encountered while processing th" - "e DAS transfer file #.", (ftnlen)73); - errch_("#", word, (ftnlen)1, (ftnlen)255); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we have begun a block, then process it. Otherwise, we */ -/* have ended a block. */ - - if (inblk) { - -/* Increment the record number by one for each comment */ -/* data block we process, because each block contains a */ -/* comment record. */ - - ++recno; - -/* Set the count of comment characters yet to be decoded and */ -/* placed in the binary DAS file. */ - - numlft = bcount; - while(numlft > 0) { - -/* Now read and decode the data in the current */ -/* comment data block, placing the data in the */ -/* comment area of the binary DAS file. */ - - if (numlft >= 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Read and decode a record of encoded comment data */ -/* from the text file. */ - - rdencc_(xfrlun, &numdta, crecrd, (ftnlen)1024); - -/* Write the comment data to the comment area in the */ -/* binary DAS file. */ - - dasioc_("WRITE", &daslun, &recno, crecrd, (ftnlen)5, ( - ftnlen)1024); - if (failed_()) { - -/* If an error occurred, attempt to close the */ -/* binary file, then checkout and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Decrement the counter for the amount of data */ -/* remaining to be moved from the current comment */ -/* block, NUMLFT. */ - - numlft -= numdta; - -/* Increment the counter for the amount of data that */ -/* has been successfully moved into the comment area */ -/* of the binary DAS file. */ - - dtacnt += numdta; - } - -/* At this point, we have finished reading in an entire */ -/* comment block. */ - - } - -/* If we got to here, we have successfully written a comment */ -/* block to the binary file. */ - - } - -/* At this point, we will have successfully written the entire */ -/* comment area to the binary DAS file, if there was a comment */ -/* area. */ - -/* Write the file record to the DAS file, to update the number */ -/* of comment characters. */ - - daswfr_(&handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc, ( - ftnlen)8, (ftnlen)60); - } - -/* Read the data counts from the DAS transfer file. These will be */ -/* useful in determining which data types to expect in the text file */ -/* when converting back to binary. */ - - rdenci_(xfrlun, &c__1, &ncdata); - rdenci_(xfrlun, &c__1, &nddata); - rdenci_(xfrlun, &c__1, &nidata); - -/* Process the character data array, if there is some character data. */ - - if (ncdata > 0) { - -/* Initialize a few things: the block counter, and the data */ -/* counter. */ - - blkcnt = 0; - dtacnt = 0; - -/* We currently have more to process. */ - - more = TRUE_; - -/* We are currently not processing a data block. */ - - inblk = FALSE_; - while(more) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100004; - } - iostat = e_rsfe(); -L100004: - if (iostat != 0) { - -/* If an error occurred while reading from the encoded text */ -/* DAS file close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Error reading from the DAS transferfile #. IOSTAT =" - " #.", (ftnlen)54); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* At this point, we should be beginning a data block, ending a */ -/* data block, or scanning for the total number of data blocks. */ -/* So look for the appropriate keyword. */ - - nextwd_(line, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - if (s_cmp(word, "BEGIN_CHARACTER_BLOCK", (ftnlen)255, (ftnlen)21) - == 0) { - -/* Get the block number. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the begin block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin character block error, could not parse bl" - "ock number. Error: # File: #", (ftnlen)75); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of characters in the block. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the beginning */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin character block error, could not parse th" - "e data count for block: #. Error: # File: #", ( - ftnlen)90); - errint_("#", &bindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we are inside a data block, so set */ -/* the in block flag, INBLK, to .TRUE. and increment the */ -/* data block counter. */ - - inblk = TRUE_; - ++blkcnt; - } else if (s_cmp(word, "END_CHARACTER_BLOCK", (ftnlen)255, ( - ftnlen)19) == 0) { - -/* Get the data block index. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &eindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the end block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End character block error, could not parse bloc" - "k number. Error: # File: #", (ftnlen)73); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of characters in the DAS array. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &ecount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the ending data */ -/* count, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End character block error, could not parse the " - "data count for block: #. Error: # File: #", ( - ftnlen)88); - errint_("#", &eindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array indices */ -/* match. */ - - if (eindex != bindex) { - -/* If the begin and end data block indices do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Character block index mismatch: Beginning index" - ": #; Ending index: #. File: #", (ftnlen)76); - errint_("#", &bindex, (ftnlen)1); - errint_("#", &eindex, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array data */ -/* counts match. */ - - if (ecount != bcount) { - -/* If the begin and end data block counts do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Character block count mismatch: Beginning count" - ": #; Ending count: #. File: #", (ftnlen)76); - errint_("#", &bcount, (ftnlen)1); - errint_("#", &ecount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully ended the */ -/* processing of a data block, so set the in block flag, */ -/* INBLK, to .FALSE.. */ - - inblk = FALSE_; - } else if (s_cmp(word, "TOTAL_CHARACTER_BLOCKS", (ftnlen)255, ( - ftnlen)22) == 0) { - -/* We have the total data blocks keyword to parse, so get */ -/* the total number of character data blocks processed. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &numblk, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the total number of */ -/* data blocks, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Block count error, could not parse the total nu" - "mber of character blocks: #. File: #", (ftnlen)83) - ; - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the total count of characters. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &tcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the character */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Character count error, could not parse the tota" - "l count. Error: # File: #", (ftnlen)72); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Compare the computed block count with the block count */ -/* from the file. */ - - if (blkcnt != numblk) { - -/* If the calculated data block count and the data */ -/* block count from the text file do not match, close */ -/* the binary file, set an appropriate error message, */ -/* then check out and return. */ - - dascls_(&handle); - setmsg_("The number of character data blocks processed (" - "#) was not equal to the number of character data" - " blocks placed in the DAS transfer file (#). Fil" - "e: #", (ftnlen)147); - errint_("#", &blkcnt, (ftnlen)1); - errint_("#", &numblk, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the total count and the computed count */ -/* match. */ - - if (tcount != dtacnt) { - -/* If the total count and computed count do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Character count mismatch: computed count: #; ex" - "pected count: #. File: #", (ftnlen)71); - errint_("#", &dtacnt, (ftnlen)1); - errint_("#", &tcount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully processed the */ -/* entire character data portion of the DAS transfer file, */ -/* so there is no more character data. */ - - more = FALSE_; - } else { - -/* We got an unknown keyword of some sort, so set an */ -/* appropriate error message, close the DAS file, and */ -/* return. */ - - dascls_(&handle); - setmsg_("Unknown keyword '#' encountered while processing th" - "e DAS trtansfer file #.", (ftnlen)74); - errch_("#", word, (ftnlen)1, (ftnlen)255); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we have begun a block, then process it. Otherwise, we */ -/* have ended a block. */ - - if (inblk) { - -/* Read and decode the data in the current DAS character */ -/* array data block. */ - -/* Set the count of characters yet to be decoded and placed */ -/* in the binary DAS file. */ - - numlft = bcount; - while(numlft > 0) { - -/* Now read and decode the data in the current */ -/* character data block, placing the data in the */ -/* character array in the binary DAS file. */ - - if (numlft >= 4096) { - numdta = 4096; - } else { - numdta = numlft; - } - -/* Read and decode a buffer of encoded character data */ -/* from the text file. */ - - rdencc_(xfrlun, &numdta, cbuffr, (ftnlen)4); - -/* Write the character data to the DAS character */ -/* array in the binary DAS file. */ - - dasadc_(&handle, &numdta, &c__1, &c__4, cbuffr, (ftnlen)4) - ; - if (failed_()) { - -/* If an error occurred, attempt to close the */ -/* binary file, then checkout and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Decrement the counter for the amount of data */ -/* remaining to be moved from the current data block, */ -/* NUMLFT. */ - - numlft -= numdta; - -/* Increment the counter for the amount of data that */ -/* has been successfully moved into the current array */ -/* in the binary DAS file. */ - - dtacnt += numdta; - -/* At this point, we have either finished reading in an */ -/* entire data block, or we have more data to read in */ -/* the current data block. */ - - } - } - -/* If we got to here, we have successfully written a data */ -/* block to the binary file. */ - - } - -/* At this point, we will have successfully written the entire */ -/* character data array to the binary DAS file, if there was */ -/* any character data to be written. */ - } - -/* Process the double precision data array, if there is some */ -/* double precision data. */ - - if (nddata > 0) { - -/* Initialize a few things: the block counter, and the data */ -/* counter. */ - - blkcnt = 0; - dtacnt = 0; - -/* We currently have more to process. */ - - more = TRUE_; - -/* We are currently not processing a data block. */ - - inblk = FALSE_; - while(more) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100005; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100005; - } - iostat = e_rsfe(); -L100005: - if (iostat != 0) { - -/* If an error occurred while reading from the encoded text */ -/* DAS file close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Error reading from the DAS transfer file #. IOSTAT " - "= #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* At this point, we should be beginning a data block, ending a */ -/* data block, or scanning for the total number of data blocks. */ -/* So look for the appropriate keyword. */ - - nextwd_(line, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - if (s_cmp(word, "BEGIN_DP_BLOCK", (ftnlen)255, (ftnlen)14) == 0) { - -/* Get the block number. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the begin block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin double precision block error, could not p" - "arse block number. Error: # File: #", (ftnlen)82); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of double precision numbers in the block. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the beginning */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin double precision block error, could not p" - "arse the data count for block: #. Error: # File:" - " #", (ftnlen)97); - errint_("#", &bindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we are inside a data block, so set */ -/* the in block flag, INBLK, to .TRUE. and increment the */ -/* data block counter. */ - - inblk = TRUE_; - ++blkcnt; - } else if (s_cmp(word, "END_DP_BLOCK", (ftnlen)255, (ftnlen)12) == - 0) { - -/* Get the data block index. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &eindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the end block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End double precision block error, could not par" - "se block number. Error: # File: #", (ftnlen)80); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of double precision numbers in the block. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &ecount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the ending data */ -/* count, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End double precision block error, could not par" - "se the data count for block: #. Error: # File: #", - (ftnlen)95); - errint_("#", &eindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array indices */ -/* match. */ - - if (eindex != bindex) { - -/* If the begin and end data block indices do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Double precision block index mismatch: Beginnin" - "g index: #; Ending index: #. File: #", (ftnlen)83) - ; - errint_("#", &bindex, (ftnlen)1); - errint_("#", &eindex, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array data */ -/* counts match. */ - - if (ecount != bcount) { - -/* If the begin and end data block counts do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Double precision block count mismatch: Beginnin" - "g count: #; Ending count: #. File: #", (ftnlen)83) - ; - errint_("#", &bcount, (ftnlen)1); - errint_("#", &ecount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully ended the */ -/* processing of a data block, so set the in block flag, */ -/* INBLK, to .FALSE.. */ - - inblk = FALSE_; - } else if (s_cmp(word, "TOTAL_DP_BLOCKS", (ftnlen)255, (ftnlen)15) - == 0) { - -/* We have the total data blocks keyword to parse, so get */ -/* the total number of character data blocks processed. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &numblk, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the total number of */ -/* data blocks, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Block count error, could not parse the total nu" - "mber of double precision data blocks: #. File: #", - (ftnlen)95); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the total count of double precision numbers. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &tcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the double */ -/* precision data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Double precision count error, could not parse t" - "he total count. Error: # File: #", (ftnlen)79); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Compare the computed block count with the block count */ -/* from the file. */ - - if (blkcnt != numblk) { - -/* If the calculated data block count and the data */ -/* block count from the text file do not match, close */ -/* the binary file, set an appropriate error message, */ -/* then check out and return. */ - - dascls_(&handle); - setmsg_("The number of double precision data blocks proc" - "essed (#) was not equal to the number of double " - "precision data blocks placed in the DAS transfer" - " file (#). File: #", (ftnlen)161); - errint_("#", &blkcnt, (ftnlen)1); - errint_("#", &numblk, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the total count and the computed count */ -/* match. */ - - if (tcount != dtacnt) { - -/* If the total count and computed count do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Double precision count mismatch: computed count" - ": #; expected count: #. File: #", (ftnlen)78); - errint_("#", &dtacnt, (ftnlen)1); - errint_("#", &tcount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully processed the */ -/* entire DAS double precision data portion of the text */ -/* file, so there is no more double precision data. */ - - more = FALSE_; - } else { - -/* We got an unknown keyword of some sort, so set an */ -/* appropriate error message, close the DAS file, and */ -/* return. */ - - dascls_(&handle); - setmsg_("Unknown keyword '#' encountered while processing th" - "e DAS transfer file #.", (ftnlen)74); - errch_("#", word, (ftnlen)1, (ftnlen)255); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we have begun a block, then process it. Otherwise, we */ -/* have ended a block. */ - if (inblk) { - -/* Read and decode the data in the current DAS double */ -/* precision array data block. */ - -/* Set the count of double precision numbers yet to be */ -/* decoded and placed in the binary DAS file. */ - - numlft = bcount; - while(numlft > 0) { - -/* Now read and decode the data in the current double */ -/* precision data block, placing the data in the double */ -/* precision array in the binary DAS file. */ - - if (numlft >= 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Read and decode a buffer of encoded double precision */ -/* data from the text file. */ - - rdencd_(xfrlun, &numdta, dbuffr); - -/* Write the double precision data to the DAS double */ -/* precision array in the binary DAS file. */ - - dasadd_(&handle, &numdta, dbuffr); - if (failed_()) { - -/* If an error occurred, attempt to close the */ -/* binary file, then checkout and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Decrement the counter for the amount of data */ -/* remaining to be moved from the current data block, */ -/* NUMLFT. */ - - numlft -= numdta; - -/* Increment the counter for the amount of data that */ -/* has been successfully moved into the current array */ -/* in the binary DAS file. */ - - dtacnt += numdta; - -/* At this point, we have either finished reading in an */ -/* entire data block, or there is still some data */ -/* remaining to be read. */ - - } - } - -/* If we got to here, we have successfully written a data */ -/* block to the binary file. */ - - } - -/* At this point, we will have successfully written the entire */ -/* double precision data array to the binary DAS file, if there */ -/* was any double precision data to be written. */ - } - -/* Process the integer data array, if there is some integer data. */ - - if (nidata > 0) { - -/* Initialize a few things: the block counter, and the data */ -/* counter. */ - - blkcnt = 0; - dtacnt = 0; - -/* We currently have more to process. */ - - more = TRUE_; - -/* We are currently not processing a data block. */ - - inblk = FALSE_; - while(more) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *xfrlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100006; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100006; - } - iostat = e_rsfe(); -L100006: - if (iostat != 0) { - -/* If an error occurred while reading from the encoded text */ -/* DAS file close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Error reading from the DAS transfer file #. IOSTAT " - "= #.", (ftnlen)55); - errfnm_("#", xfrlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* At this point, we should be beginning a data block, ending a */ -/* data block, or scanning for the total number of data blocks. */ -/* So look for the appropriate keyword. */ - - nextwd_(line, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen)255); - if (s_cmp(word, "BEGIN_INTEGER_BLOCK", (ftnlen)255, (ftnlen)19) == - 0) { - -/* Get the block number. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the begin block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin integer block error, could not parse bloc" - "k number. Error: # File: #", (ftnlen)73); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of integers in the block. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &bcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the beginning */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Begin integer block error, could not parse the " - "data count for block: #. Error: # File: #", ( - ftnlen)89); - errint_("#", &bindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we are inside a data block, so set */ -/* the in block flag, INBLK, to .TRUE. and increment the */ -/* data block counter. */ - - inblk = TRUE_; - ++blkcnt; - } else if (s_cmp(word, "END_INTEGER_BLOCK", (ftnlen)255, (ftnlen) - 17) == 0) { - -/* Get the data block index. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &eindex, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the end block */ -/* index, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End integer block error, could not parse block " - "number. Error: # File: #", (ftnlen)71); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the count of integers in the block. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &ecount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the ending data */ -/* count, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("End integer block error, could not parse the da" - "ta count for block: #.Error: # File: #", (ftnlen) - 85); - errint_("#", &eindex, (ftnlen)1); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array indices */ -/* match. */ - - if (eindex != bindex) { - -/* If the begin and end data block indices do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Integer block index mismatch: Beginning index: " - "#; Ending index: #. File: #", (ftnlen)74); - errint_("#", &bindex, (ftnlen)1); - errint_("#", &eindex, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the beginning and ending array data */ -/* counts match. */ - - if (ecount != bcount) { - -/* If the begin and end data block counts do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Integer block count mismatch: Beginning count: " - "#; Ending count: #. File: #", (ftnlen)74); - errint_("#", &bcount, (ftnlen)1); - errint_("#", &ecount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully ended the */ -/* processing of a data block, so set the in block flag, */ -/* INBLK, to .FALSE.. */ - - inblk = FALSE_; - } else if (s_cmp(word, "TOTAL_INTEGER_BLOCKS", (ftnlen)255, ( - ftnlen)20) == 0) { - -/* We have the total data blocks keyword to parse, so get */ -/* the total number of character data blocks processed. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &numblk, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the total number of */ -/* data blocks, close the binary file, set an appropriate */ -/* error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Block count error, could not parse the total nu" - "mber of integer data blocks: #. File: #", (ftnlen) - 86); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Parse the total count of integers. */ - - nextwd_(rest, word, rest, (ftnlen)255, (ftnlen)255, (ftnlen) - 255); - nparsi_(word, &tcount, errmsg, &errptr, (ftnlen)255, (ftnlen) - 320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - -/* If an error occurred while parsing the integer */ -/* data count, close the binary file, set an */ -/* appropriate error message, then check out and return. */ - - dascls_(&handle); - setmsg_("Integer count error, could not parse the total " - "count. Error: # File: #", (ftnlen)70); - errch_("#", errmsg, (ftnlen)1, (ftnlen)320); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Compare the computed block count with the block count */ -/* from the file. */ - - if (blkcnt != numblk) { - -/* If the calculated data block count and the data */ -/* block count from the text file do not match, close */ -/* the binary file, set an appropriate error message, */ -/* then check out and return. */ - - dascls_(&handle); - setmsg_("The number of integer data blocks processed (#)" - " was not equal to the number of integer data blo" - "cks placed in the DAS transfer file (#). File: #", - (ftnlen)143); - errint_("#", &blkcnt, (ftnlen)1); - errint_("#", &numblk, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Check to see if the total count and the computed count */ -/* match. */ - - if (tcount != dtacnt) { - -/* If the total count and computed count do not match, */ -/* close the binary file, set an appropriate error */ -/* message, then check out and return. */ - - dascls_(&handle); - setmsg_("Integer count mismatch: computed count: #; expe" - "cted count: #. File: #", (ftnlen)69); - errint_("#", &dtacnt, (ftnlen)1); - errint_("#", &tcount, (ftnlen)1); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we got to here, we have successfully processed the */ -/* entire DAS integer data portion of the text file, so */ -/* there is no more integer data. */ - - more = FALSE_; - } else { - -/* We got an unknown keyword of some sort, so set an */ -/* appropriate error message, close the DAS file, and */ -/* return. */ - - dascls_(&handle); - setmsg_("Unknown keyword '#' encountered while processing th" - "e DAS transfer file #.", (ftnlen)74); - errch_("#", word, (ftnlen)1, (ftnlen)255); - errfnm_("#", xfrlun, (ftnlen)1); - sigerr_("SPICE(BADDASTRANSFERFILE)", (ftnlen)25); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* If we have begun a block, then process it. Otherwise, we */ -/* have ended a block. */ - if (inblk) { - -/* Read and decode the data in the current DAS integer */ -/* array data block. */ - -/* Set the count of integers yet to be decoded and placed */ -/* in the binary DAS file. */ - - numlft = bcount; - while(numlft > 0) { - -/* Now read and decode the data in the current */ -/* integer data block, placing the data in the */ -/* integer precision array in the binary DAS file. */ - - if (numlft >= 1024) { - numdta = 1024; - } else { - numdta = numlft; - } - -/* Read and decode a buffer of encoded integer data */ -/* from the text file. */ - - rdenci_(xfrlun, &numdta, ibuffr); - -/* Write the integer data to the DAS integer array in */ -/* the binary DAS file. */ - - dasadi_(&handle, &numdta, ibuffr); - if (failed_()) { - -/* If an error occurred, attempt to close the */ -/* binary file, then checkout and return. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; - } - -/* Decrement the counter for the amount of data */ -/* remaining to be moved from the current data block, */ -/* NUMLFT. */ - - numlft -= numdta; - -/* Increment the counter for the amount of data that */ -/* has been successfully moved into the current array */ -/* in the binary DAS file. */ - - dtacnt += numdta; - -/* At this point, we have either finished reading in an */ -/* entire data block, or there is still data remaining */ -/* to be read. */ - - } - } - -/* If we got to here, we have successfully written a data */ -/* block to the binary file. */ - - } - -/* At this point, we will have successfully written the entire */ -/* integer data array to the binary DAS file, if there was any */ -/* integer data to be written. */ - } - -/* Close only the binary file. */ - - dascls_(&handle); - chkout_("DASTB", (ftnlen)5); - return 0; -} /* dastb_ */ - diff --git a/ext/spice/src/cspice/dasudc.c b/ext/spice/src/cspice/dasudc.c deleted file mode 100644 index 34ac5232e5..0000000000 --- a/ext/spice/src/cspice/dasudc.c +++ /dev/null @@ -1,477 +0,0 @@ -/* dasudc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure DASUDC ( DAS, update data, character ) */ -/* Subroutine */ int dasudc_(integer *handle, integer *first, integer *last, - integer *bpos, integer *epos, char *data, ftnlen data_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer l, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer lastc, lastd, recno, lasti, nmove, rcpos; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int daslla_(integer *, integer *, integer *, - integer *), dasurc_(integer *, integer *, integer *, integer *, - char *, ftnlen); - integer nmoved, clsize; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numchr; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - integer wordno; - extern logical return_(void); - integer nwritn, chr, elt; - -/* $ Abstract */ - -/* Update character data in a specified range of DAS logical */ -/* addresses with substrings of a character array. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* FIRST, */ -/* LAST I Range of DAS character logical addresses. */ -/* BPOS, */ -/* EPOS I Begin and end positions of substrings. */ -/* DATA I Data having addresses FIRST through LAST. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* FIRST, */ -/* LAST are the first and last of a range of DAS logical */ -/* addresses of characters. These addresses satisfy */ -/* the inequality */ - -/* 1 < FIRST < LAST < LASTC */ -/* _ - - */ - -/* where LASTC is the last character logical address */ -/* in use in the DAS file designated by HANDLE. */ - -/* BPOS, */ -/* EPOS are begin and end character positions that define */ -/* the substrings of the input array that are to be */ -/* added to the DAS file. */ - -/* DATA is an array of character strings. The contents of */ -/* the specified substrings of the elements of the */ -/* array DATA will be written to the indicated DAS */ -/* file in order: DATA(1)(BPOS:BPOS) will be written */ -/* to character logical address FIRST; */ -/* DATA(1)(BPOS+1:BPOS+1) will be written to */ -/* the character logical address FIRST+1, and so on; */ -/* in this ordering scheme, character (BPOS:BPOS) of */ -/* DATA(I+1) is the successor of character (EPOS:EPOS) */ -/* of DATA(I). */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) Only logical addresses that already contain data may be */ -/* updated: if either FIRST or LAST are outside the range */ - -/* [ 1, LASTC ] */ - -/* where LASTC is the last character logical address that */ -/* currently contains data in the indicated DAS file, the error */ -/* SPICE(INVALIDADDRESS) is signalled. The DAS file will not be */ -/* modified. */ - -/* 3) If FIRST > LAST but both addresses are valid, this routine */ -/* will not modify the indicated DAS file. No error will be */ -/* signalled. */ - -/* 4) If an I/O error occurs during the data update attempted */ -/* by this routine, the error will be diagnosed by routines */ -/* called by this routine. FIRST and LAST will not be modified. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine replaces the character data in the specified range */ -/* of logical addresses within a DAS file with the contents of the */ -/* specified substrings of the input array DATA. */ - -/* The actual physical write operations that update the indicated */ -/* DAS file with the contents of the input array DATA may not take */ -/* place before this routine returns, since the DAS system buffers */ -/* data that is written as well as data that is read. In any case, */ -/* the data will be flushed to the file at the time the file is */ -/* closed, if not earlier. A physical write of all buffered */ -/* records can be forced by calling the SPICELIB routine DASWUR */ -/* ( DAS, write updated records ). */ - -/* In order to append character data to a DAS file, filling in a */ -/* range of character logical addresses that starts immediately */ -/* after the last character logical address currently in use, the */ -/* SPICELIB routines DASADS ( DAS add data, substring ) or DASADC */ -/* ( DAS add data, character ) should be used. */ - -/* $ Examples */ - -/* 1) Write to addresses 1 through 320 in a DAS file in */ -/* random-access fashion by updating the file. Recall */ -/* that data must be present in the file before it can */ -/* be updated. */ - - -/* PROGRAM UP */ - -/* CHARACTER*(80) BUFFER ( 10 ) */ -/* CHARACTER*(80) LINE */ -/* CHARACTER*(4) TYPE */ - -/* INTEGER FIRST */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER LAST */ - -/* C */ -/* C Open the new DAS file RAND.DAS. Use the file name */ -/* C as the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Append 320 characters to the file, thereby reserving */ -/* C enough room for 10 strings of 32 characters. After */ -/* C the data is present, we're free to update it in any */ -/* C order we please. */ -/* C */ -/* LINE = ' ' */ - -/* DO I = 1, 10 */ -/* CALL DASADC ( HANDLE, 32, 1, 32, LINE ) */ -/* END DO */ - -/* C */ -/* C Now the character logical addresses 1:320 can be */ -/* C written to in random-access fashion. We'll fill */ -/* C them in by writing 32 characters at a time, starting */ -/* C with addresses 289:320 and working backwards. */ -/* C */ -/* FIRST = 321 */ - -/* DO I = 10, 1, -1 */ - -/* LAST = FIRST - 1 */ -/* FIRST = LAST - 32 */ - -/* LINE = 'This is the # line.' */ -/* CALL REPMOT ( LINE, '#', I, 'L', LINE ) */ -/* CALL DASUDC ( HANDLE, FIRST, LAST, 1, 32, LINE ) */ - -/* END DO */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now make sure that we updated the file properly. */ -/* C Open the file for reading and dump the contents */ -/* C of the character logical addresses 1:320. */ -/* C */ -/* CALL DASOPR ( 'RAND.DAS', HANDLE ) */ - -/* CALL DASRDC ( HANDLE, 1, 320, 1, 32, BUFFER ) */ - -/* WRITE (*,*) 'Contents of RAND.DAS:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) BUFFER(1:32) */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.2.0, 12-MAY-1995 (NJB) */ - -/* Bug fix: routine handled values of BPOS incorrectly when */ -/* BPOS > 1. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination conditions. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update a range of DAS logical addresses using substrings */ -/* write substrings to a range of DAS logical addresses */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 12-MAY-1995 (NJB) */ - -/* Bug fix: routine handled values of BPOS incorrectly when */ -/* BPOS > 1. This was due to the incorrect initialization */ -/* of the internal variables CHR and ELT. The initialization */ -/* was corrected. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Tests of FAILED() added to loop termination conditions. */ -/* Without these tests, infinite loops could result if DASA2L or */ -/* DASURC signaled an error inside the loops. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASUDC", (ftnlen)6); - } - -/* Get the last logical addresses in use in this DAS file. */ - - daslla_(handle, &lastc, &lastd, &lasti); - -/* Validate the input addresses. */ - - if (*first < 1 || *first > lastc || *last < 1 || *last > lastc) { - setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &lastc, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("DASUDC", (ftnlen)6); - return 0; - } - -/* Get the length of the substrings of DATA. Count the total number */ -/* of characters to write. */ - - l = *epos - *bpos + 1; - n = *last - *first + 1; - nwritn = 0; - -/* Find out the physical location of the first character to update. */ - - dasa2l_(handle, &c__1, first, &clbase, &clsize, &recno, &wordno); - -/* Write as much data into record RECNO as is necessary and possible. */ - -/* NUMCHR is the number of characters to write to the current record. */ - -/* ELT is the index of the element of the input array that we're */ -/* taking data from. CHR is the position in that array element of */ -/* the next character to move to the file. */ - -/* NMOVED is the number of characters we've moved into the current */ -/* record so far. */ - -/* RCPOS is the character position we'll write to next in the current */ -/* record. */ - -/* Computing MIN */ - i__1 = n, i__2 = 1024 - wordno + 1; - numchr = min(i__1,i__2); - elt = 1; - chr = *bpos; - nmoved = 0; - rcpos = wordno; - while(nmoved < numchr && ! failed_()) { - if (chr > *epos) { - ++elt; - chr = *bpos; - } - -/* Find out how many characters to move from the current array */ -/* element to the current record. */ - -/* Computing MIN */ - i__1 = numchr - nmoved, i__2 = *epos - chr + 1; - nmove = min(i__1,i__2); - -/* Update the current record. */ - - i__1 = rcpos + nmove - 1; - dasurc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * data_len + - (chr - 1)), chr + nmove - 1 - (chr - 1)); - nmoved += nmove; - rcpos += nmove; - chr += nmove; - } - nwritn = numchr; - ++recno; - -/* Update as many additional records as necessary. */ - - while(nwritn < n && ! failed_()) { - -/* At this point, RECNO is the correct number of the record to */ -/* write to next. CLBASE is the number of the first record of */ -/* the cluster we're about to write to. */ - - if (recno < clbase + clsize) { - -/* We can continue writing the current cluster. Find */ -/* out how many elements to write to the current record, */ -/* and write them. */ - -/* Computing MIN */ - i__1 = n - nwritn; - numchr = min(i__1,1024); - nmoved = 0; - rcpos = 1; - while(nmoved < numchr && ! failed_()) { - if (chr > l) { - ++elt; - chr = *bpos; - } - -/* Find out how many characters to move from the array */ -/* element to the current record. */ - -/* Computing MIN */ - i__1 = numchr - nmoved, i__2 = *epos - chr + 1; - nmove = min(i__1,i__2); - i__1 = rcpos + nmove - 1; - dasurc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * - data_len + (chr - 1)), chr + nmove - 1 - (chr - 1)); - nmoved += nmove; - rcpos += nmove; - chr += nmove; - } - nwritn += numchr; - ++recno; - } else { - -/* We must find the next character cluster to write to. */ -/* The first character in this cluster has address FIRST + */ -/* NWRITN. */ - - i__1 = *first + nwritn; - dasa2l_(handle, &c__1, &i__1, &clbase, &clsize, &recno, &wordno); - } - } - chkout_("DASUDC", (ftnlen)6); - return 0; -} /* dasudc_ */ - diff --git a/ext/spice/src/cspice/dasudd.c b/ext/spice/src/cspice/dasudd.c deleted file mode 100644 index aa1e67465d..0000000000 --- a/ext/spice/src/cspice/dasudd.c +++ /dev/null @@ -1,393 +0,0 @@ -/* dasudd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure DASUDD ( DAS, update data, double precision ) */ -/* Subroutine */ int dasudd_(integer *handle, integer *first, integer *last, - doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer lastc, lastd, recno, lasti, numdp; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int daslla_(integer *, integer *, integer *, - integer *), dasurd_(integer *, integer *, integer *, integer *, - doublereal *); - integer clsize; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer wordno; - extern logical return_(void); - integer nwritn; - -/* $ Abstract */ - -/* Update data in a specified range of double precision addresses */ -/* in a DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* FIRST, */ -/* LAST I Range of d.p. addresses to write to. */ -/* DATA I An array of d.p. numbers. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* FIRST, */ -/* LAST are the first and last of a range of DAS logical */ -/* addresses of double precision numbers. These */ -/* addresses satisfy the inequality */ - -/* 1 < FIRST < LAST < LASTD */ -/* _ - - */ - -/* where LASTD is the last double precision logical */ -/* address in use in the DAS file designated by */ -/* HANDLE. */ - -/* DATA is an array of double precision numbers. The */ -/* array elements DATA(1) through DATA(N) will be */ -/* written to the indicated DAS file, where N is */ -/* LAST - FIRST + 1. */ - -/* $ Detailed_Output */ - -/* See $Particulars for a description of the effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) Only logical addresses that already contain data may be */ -/* updated: if either FIRST or LAST are outside the range */ - -/* [ 1, LASTD ] */ - -/* where LASTD is the last double precision logical address */ -/* that currently contains data in the indicated DAS file, the */ -/* error SPICE(INVALIDADDRESS) is signalled. */ -/* The DAS file will not be modified. */ - -/* 3) If FIRST > LAST but both addresses are valid, this routine */ -/* will not modify the indicated DAS file. No error will be */ -/* signalled. */ - -/* 4) If an I/O error occurs during the data update attempted */ -/* by this routine, the error will be diagnosed by routines */ -/* called by this routine. FIRST and LAST will not be modified. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine replaces the double precision data in the specified */ -/* range of logical addresses within a DAS file with the contents of */ -/* the input array DATA. */ - -/* The actual physical write operations that update the indicated */ -/* DAS file with the contents of the input array DATA may not take */ -/* place before this routine returns, since the DAS system buffers */ -/* data that is written as well as data that is read. In any case, */ -/* the data will be flushed to the file at the time the file is */ -/* closed, if not earlier. A physical write of all buffered */ -/* records can be forced by calling the SPICELIB routine DASWUR */ -/* ( DAS, write updated records ). */ - -/* In order to append double precision data to a DAS file, filling */ -/* in a range of double precision logical addresses that starts */ -/* immediately after the last double precision logical address */ -/* currently in use, the SPICELIB routine DASADD ( DAS add data, */ -/* double precision ) should be used. */ - -/* $ Examples */ - -/* 1) Write to addresses 1 through 500 in a DAS file in */ -/* random-access fashion by updating the file. Recall */ -/* that data must be present in the file before it can */ -/* be updated. */ - - -/* PROGRAM UP */ - -/* CHARACTER*(4) TYPE */ - -/* DOUBLE PRECISION DATA ( 500 ) */ - -/* INTEGER HANDLE */ -/* INTEGER I */ - -/* C */ -/* C Open the new DAS file RAND.DAS. Use the file name */ -/* C as the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Append 500 double precision numbers to the file; */ -/* C after the data is present, we're free to update it */ -/* C in any order we please. (CLEARD zeros out a double */ -/* C precision array.) */ -/* C */ -/* CALL CLEARD ( 500, DATA ) */ -/* CALL DASADD ( HANDLE, 500, DATA ) */ - -/* C */ -/* C Now the double precision logical addresses 1:500 */ -/* C can be written to in random-access fashion. We'll */ -/* C fill them in in reverse order. */ -/* C */ -/* DO I = 500, 1, -1 */ -/* CALL DASUDD ( HANDLE, I, I, DBLE(I) ) */ -/* END DO */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now make sure that we updated the file properly. */ -/* C Open the file for reading and dump the contents */ -/* C of the double precision logical addresses 1:500. */ -/* C */ -/* CALL DASOPR ( 'RAND.DAS', HANDLE ) */ - -/* CALL CLEARD ( 500, DATA ) */ -/* CALL DASRDD ( HANDLE, 1, 500, DATA ) */ - -/* WRITE (*,*) 'Contents of RAND.DAS:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) DATA */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination conditions. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update double precision data in a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L or DASURD */ -/* signaled an error inside the loop. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASUDD", (ftnlen)6); - } - -/* Get the last logical addresses in use in this DAS file. */ - - daslla_(handle, &lastc, &lastd, &lasti); - -/* Validate the input addresses. */ - - if (*first < 1 || *first > lastd || *last < 1 || *last > lastd) { - setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &lastd, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("DASUDD", (ftnlen)6); - return 0; - } - -/* Let N be the number of addresses to update. */ - - n = *last - *first + 1; - -/* We will use the variables RECNO and OFFSET to determine where to */ -/* write data in the DAS file. RECNO will be the record containing */ -/* the physical location to write to; WORDNO will be the word */ -/* location that we will write to next. */ - -/* Find the first location to write to. CLBASE and CLSIZE are the */ -/* base record number and size of the cluster of d.p. records that */ -/* the address FIRST lies within. */ - - dasa2l_(handle, &c__2, first, &clbase, &clsize, &recno, &wordno); - -/* Set the number of double precision words already written. Keep */ -/* writing to the file until this number equals the number of */ -/* elements in DATA. */ - -/* Note that if N is non-positive, the loop doesn't get exercised. */ - - - nwritn = 0; - while(nwritn < n && ! failed_()) { - -/* Write as much data as we can (or need to) into the current */ -/* record. We assume that CLBASE, RECNO, WORDNO, and NWRITN have */ -/* been set correctly at this point. */ - -/* Find out how many words to write into the current record. */ -/* There may be no space left in the current record. */ - -/* Computing MIN */ - i__1 = n - nwritn, i__2 = 128 - wordno + 1; - numdp = min(i__1,i__2); - if (numdp > 0) { - -/* Write NUMDP words into the current record. */ - - i__1 = wordno + numdp - 1; - dasurd_(handle, &recno, &wordno, &i__1, &data[nwritn]); - nwritn += numdp; - wordno += numdp; - } else { - -/* It's time to start on a new record. If the record we */ -/* just finished writing to (or just attempted writing to, */ -/* if it was full) was not the last of the cluster, the next */ -/* record to write to is the immediate successor of the last */ -/* one. Otherwise, we'll have to look up the location of the */ -/* next d.p. logical address. */ - - if (recno < clbase + clsize - 1) { - ++recno; - wordno = 1; - } else { - i__1 = *first + nwritn; - dasa2l_(handle, &c__2, &i__1, &clbase, &clsize, &recno, & - wordno); - } - } - } - chkout_("DASUDD", (ftnlen)6); - return 0; -} /* dasudd_ */ - diff --git a/ext/spice/src/cspice/dasudi.c b/ext/spice/src/cspice/dasudi.c deleted file mode 100644 index eba4d6cca3..0000000000 --- a/ext/spice/src/cspice/dasudi.c +++ /dev/null @@ -1,389 +0,0 @@ -/* dasudi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure DASUDI ( DAS, update data, integer ) */ -/* Subroutine */ int dasudi_(integer *handle, integer *first, integer *last, - integer *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer lastc, lastd, recno, lasti; - extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - extern logical failed_(void); - integer clbase; - extern /* Subroutine */ int daslla_(integer *, integer *, integer *, - integer *), dasuri_(integer *, integer *, integer *, integer *, - integer *); - integer clsize; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer wordno, numint; - extern logical return_(void); - integer nwritn; - -/* $ Abstract */ - -/* Update data in a specified range of integer addresses in a DAS */ -/* file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* DAS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* FIRST, */ -/* LAST I Range of integer addresses to write to. */ -/* DATA I An array of integers. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of a DAS file opened for writing. */ - -/* FIRST, */ -/* LAST are the first and last of a range of DAS logical */ -/* addresses of integers. These addresses satisfy the */ -/* inequality */ - -/* 1 < FIRST < LAST < LASTI */ -/* _ - - */ - -/* where LASTI is the last integer logical address in */ -/* use in the DAS file designated by HANDLE. */ - -/* DATA is an array of integers. The array elements */ -/* DATA(1) through DATA(N) will be written to the */ -/* indicated DAS file, where N is LAST - FIRST + 1. */ - -/* $ Detailed_Output */ - -/* See $Particulars for a description of the effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) Only logical addresses that already contain data may be */ -/* updated: if either FIRST or LAST are outside the range */ - -/* [ 1, LASTI ] */ - -/* where LASTI is the last integer logical address that */ -/* currently contains data in the indicated DAS file, the error */ -/* SPICE(INVALIDADDRESS) is signalled. The DAS file will not be */ -/* modified. */ - -/* 3) If FIRST > LAST but both addresses are valid, this routine */ -/* will not modify the indicated DAS file. No error will be */ -/* signalled. */ - -/* 4) If an I/O error occurs during the data update attempted */ -/* by this routine, the error will be diagnosed by routines */ -/* called by this routine. FIRST and LAST will not be modified. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine replaces the integer data in the specified range of */ -/* logical addresses within a DAS file with the contents of the */ -/* input array DATA. */ - -/* The actual physical write operations that update the indicated */ -/* DAS file with the contents of the input array DATA may not take */ -/* place before this routine returns, since the DAS system buffers */ -/* data that is written as well as data that is read. In any case, */ -/* the data will be flushed to the file at the time the file is */ -/* closed, if not earlier. A physical write of all buffered */ -/* records can be forced by calling the SPICELIB routine DASWUR */ -/* ( DAS, write updated records ). */ - -/* In order to append integer data to a DAS file, filling in a range */ -/* of integer logical addresses that starts immediately after the */ -/* last integer logical address currently in use, the SPICELIB */ -/* routine DASADI ( DAS add data, integer ) should be used. */ - -/* $ Examples */ - -/* 1) Write to addresses 1 through 500 in a DAS file in */ -/* random-access fashion by updating the file. Recall */ -/* that data must be present in the file before it can */ -/* be updated. */ - - -/* PROGRAM UP */ - -/* CHARACTER*(4) TYPE */ - -/* INTEGER DATA ( 500 ) */ - -/* INTEGER HANDLE */ -/* INTEGER I */ - -/* C */ -/* C Open the new DAS file RAND.DAS. Use the file name */ -/* C as the internal file name. */ -/* C */ -/* TYPE = 'TEST' */ -/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */ - -/* C */ -/* C Append 500 integers to the file; after the data is */ -/* C present, we're free to update it in any order we */ -/* C please. (CLEARI zeros out an integer array.) */ -/* C */ -/* CALL CLEARI ( 500, DATA ) */ -/* CALL DASADI ( HANDLE, 500, DATA ) */ - -/* C */ -/* C Now the integer logical addresses 1:500 can be */ -/* C written to in random-access fashion. We'll fill them */ -/* C in in reverse order. */ -/* C */ -/* DO I = 500, 1, -1 */ -/* CALL DASUDI ( HANDLE, I, I, I ) */ -/* END DO */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DASCLS ( HANDLE ) */ - -/* C */ -/* C Now make sure that we updated the file properly. */ -/* C Open the file for reading and dump the contents */ -/* C of the integer logical addresses 1:500. */ -/* C */ -/* CALL DASOPR ( 'RAND.DAS', HANDLE ) */ - -/* CALL CLEARI ( 500, DATA ) */ -/* CALL DASRDI ( HANDLE, 1, 500, DATA ) */ - -/* WRITE (*,*) 'Contents of RAND.DAS:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) DATA */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ - -/* Corrected title of permuted index entry section. */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination conditions. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* update integer data in a DAS file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */ - -/* Test of FAILED() added to loop termination condition. Without */ -/* this test, an infinite loop could result if DASA2L or DASURI */ -/* signaled an error inside the loop. */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if the DAS open routines ever */ -/* change. */ - -/* Modified the $ Examples section to demonstrate the new ID word */ -/* format which includes a file type and to include a call to the */ -/* new routine DASONW, open new for write, which makes use of the */ -/* file type. Also, a variable for the type of the file to be */ -/* created was added. */ - -/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASUDI", (ftnlen)6); - } - -/* Get the last logical addresses in use in this DAS file. */ - - daslla_(handle, &lastc, &lastd, &lasti); - -/* Validate the input addresses. */ - - if (*first < 1 || *first > lasti || *last < 1 || *last > lasti) { - setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - errint_("#", &lasti, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("DASUDI", (ftnlen)6); - return 0; - } - -/* Let N be the number of addresses to update. */ - - n = *last - *first + 1; - -/* We will use the variables RECNO and OFFSET to determine where to */ -/* write data in the DAS file. RECNO will be the record containing */ -/* the physical location to write to; WORDNO will be the word */ -/* location that we will write to next. */ - -/* Find the first location to write to. CLBASE and CLSIZE are the */ -/* base record number and size of the cluster of integer records that */ -/* the address FIRST lies within. */ - - dasa2l_(handle, &c__3, first, &clbase, &clsize, &recno, &wordno); - -/* Set the number of integer words already written. Keep */ -/* writing to the file until this number equals the number of */ -/* elements in DATA. */ - -/* Note that if N is non-positive, the loop doesn't get exercised. */ - - - nwritn = 0; - while(nwritn < n && ! failed_()) { - -/* Write as much data as we can (or need to) into the current */ -/* record. We assume that CLBASE, RECNO, WORDNO, and NWRITN have */ -/* been set correctly at this point. */ - -/* Find out how many words to write into the current record. */ -/* There may be no space left in the current record. */ - -/* Computing MIN */ - i__1 = n - nwritn, i__2 = 256 - wordno + 1; - numint = min(i__1,i__2); - if (numint > 0) { - -/* Write NUMINT words into the current record. */ - - i__1 = wordno + numint - 1; - dasuri_(handle, &recno, &wordno, &i__1, &data[nwritn]); - nwritn += numint; - wordno += numint; - } else { - -/* It's time to start on a new record. If the record we */ -/* just finished writing to (or just attempted writing to, */ -/* if it was full) was not the last of the cluster, the next */ -/* record to write to is the immediate successor of the last */ -/* one. Otherwise, we'll have to look up the location of the */ -/* next integer logical address. */ - - if (recno < clbase + clsize - 1) { - ++recno; - wordno = 1; - } else { - i__1 = *first + nwritn; - dasa2l_(handle, &c__3, &i__1, &clbase, &clsize, &recno, & - wordno); - } - } - } - chkout_("DASUDI", (ftnlen)6); - return 0; -} /* dasudi_ */ - diff --git a/ext/spice/src/cspice/daswfr.c b/ext/spice/src/cspice/daswfr.c deleted file mode 100644 index 219165b1a4..0000000000 --- a/ext/spice/src/cspice/daswfr.c +++ /dev/null @@ -1,474 +0,0 @@ -/* daswfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure DASWFR ( DAS write file record ) */ -/* Subroutine */ int daswfr_(integer *handle, char *idword, char *ifname, - integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, - ftnlen idword_len, ftnlen ifname_len) -{ - /* Builtin functions */ - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_wdue(cilist *), e_wdue(void); - - /* Local variables */ - integer free; - char tail[932]; - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - integer oldcch, locncc, oldcrc; - extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - char locifn[60]; - integer oldrch; - extern /* Subroutine */ int dassih_(integer *, char *, ftnlen); - integer lastla[3]; - char locidw[8]; - integer locncr, locnvc, oldrrc; - char format[8]; - integer lastrc[3]; - extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - integer lastwd[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), dasufs_(integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *), setmsg_(char *, ftnlen); - integer iostat, locnvr; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - char ifn[60]; - - /* Fortran I/O blocks */ - static cilist io___3 = { 1, 0, 1, 0, 1 }; - static cilist io___13 = { 1, 0, 0, 0, 1 }; - - -/* $ Abstract */ - -/* Update the contents of the file record of a specified DAS file. */ - -/* $ 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 */ - -/* DAS */ - -/* $ Keywords */ - -/* DAS */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ -/* IDWORD I ID word. */ -/* IFNAME I DAS internal file name. */ -/* NRESVR I Number of reserved records in file. */ -/* NRESVC I Number of characters in use in reserved rec. area. */ -/* NCOMR I Number of comment records in file. */ -/* NCOMC I Number of characters in use in comment area. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle for a DAS file open for writing. */ - -/* IDWORD is the `ID word' contained in the first eight */ -/* characters of the file record. */ - -/* IFNAME is the internal file name of the DAS file. The */ -/* maximum length of the internal file name is 60 */ -/* characters. */ - -/* NRESVR is the number of reserved records in the DAS file */ -/* specified by HANDLE. */ - -/* NRESVC is the number of characters in use in the reserved */ -/* record area of the DAS file specified by HANDLE. */ - -/* NCOMR is the number of comment records in the DAS file */ -/* specified by HANDLE. */ - -/* NCOMC is the number of characters in use in the comment area */ -/* of the DAS file specified by HANDLE. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the handle passed to this routine is not the handle of an */ -/* open DAS file, the error will be signaled by a routine called */ -/* by this routine. */ - -/* 2) If the specified DAS file is not open for write access, the */ -/* error will be diagnosed by a routine called by this routine. */ - -/* 3) If the attempt to read the file record fails, the error */ -/* SPICE(DASREADFAIL) is signaled. */ - -/* 4) If the file write attempted by this routine fails, the error */ -/* SPICE(DASFILEWRITEFAILED) is signaled. */ - -/* $ Files */ - -/* See the description of HANDLE under $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine provides a convenient way of updating the internal */ -/* file name of a DAS file. */ - -/* The `ID word' contained in the file record is a string of eight */ -/* characters that identifies the file as a DAS file and optionally */ -/* indicates a specific file format, for example, `EK'. */ - -/* $ Examples */ - -/* 1) Update the internal file name of an existing DAS file. */ - -/* C */ -/* C Open the file for writing. */ -/* C */ -/* CALL DASOPW ( FNAME, HANDLE ) */ - -/* C */ -/* C Retrieve the ID word and current reserved record */ -/* C and comment area record and character counts. */ -/* C */ -/* CALL DASRFR ( HANDLE, */ -/* . IDWORD, */ -/* . IFNAME, */ -/* . NRESVR, */ -/* . NRESVC, */ -/* . NCOMR, */ -/* . NCOMC ) */ - -/* C */ -/* C Set the internal file name and update the file */ -/* C with it. */ -/* C */ -/* IFNAME = 'New internal file name' */ - -/* CALL DASWFR ( HANDLE, */ -/* . IDWORD, */ -/* . IFNAME, */ -/* . NRESVR, */ -/* . NRESVC, */ -/* . NCOMR, */ -/* . NCOMC ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */ - -/* This routine was modified to accomodate the preservation */ -/* of the FTP validation and binary file format strings that */ -/* are not part of the DAS file record. */ - -/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Added a check of FAILED after the call to DASHLU which will */ -/* check out and return if DASHLU fails. This is so that when in */ -/* return mode of the error handling the READ following the call */ -/* to DASHLU will not be executed. */ - -/* Reworded some of the descriptions contained in the */ -/* $ Detailed_Output section of the header so that they were more */ -/* clear. */ - -/* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write DAS file record */ -/* write DAS internal file name */ -/* update DAS internal file name */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */ - -/* In order to preserve the additional information that */ -/* now resides in the file record, this routine reads */ -/* the entire record into local buffers, including the */ -/* TAILEN characters that follow the actual data content. */ -/* The contents of the local buffers that correspond to */ -/* information brought in from the call sequence of the */ -/* routine are ignored when the record is rewritten. */ -/* However, the ID word, the file format string, and the */ -/* trailing TAILEN characters that contain the FTP validation */ -/* string are rewritten along with the input values. */ - -/* This routine does not simply replace the FTP validation */ -/* string with the components from ZZFTPSTR, since that */ -/* would possibly validate a corrupt file created using a newer */ -/* Toolkit. */ - -/* The string arguments passed into this routine are now */ -/* copied to local buffers of the appropriate length. */ - -/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ - -/* Removed references to specific DAS file open routines in the */ -/* $ Detailed_Input section of the header. This was done in order */ -/* to minimize documentation changes if these open routines ever */ -/* change. */ - -/* Added a check of FAILED after the call to DASHLU which will */ -/* check out and return if DASHLU fails. This is so that when in */ -/* return mode of the error handling the READ following the call */ -/* to DASHLU will not be executed. */ - -/* Reworded some of the descriptions contained in the */ -/* $ Detailed_Output section of the header so that they were more */ -/* clear. */ - -/* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* The parameter TAILEN determines the tail length of a DAS file */ -/* record. This is the number of bytes (characters) that */ -/* occupy the portion of the file record that follows the */ -/* integer holding the first free address. For environments */ -/* with a 32 bit word length, 1 byte characters, and DAS */ -/* record sizes of 1024 bytes, we have: */ - -/* 8 bytes - IDWORD */ -/* 60 bytes - IFNAME */ -/* 4 bytes - NRESVR (32 bit integer) */ -/* 4 bytes - NRESVC (32 bit integer) */ -/* 4 bytes - NCOMR (32 bit integer) */ -/* + 4 bytes - NCOMC (32 bit integer) */ -/* --------- */ -/* 84 bytes - (All file records utilize this space.) */ - -/* So the size of the remaining portion (or tail) of the DAS */ -/* file record for computing enviroments as described above */ -/* would be: */ - -/* 1024 bytes - DAS record size */ -/* - 8 bytes - DAS Binary File Format Word */ -/* - 84 bytes - (from above) */ -/* ------------ */ -/* 932 bytes - DAS file record tail length */ - -/* Note: environments that do not have a 32 bit word length, */ -/* 1 byte characters, and a DAS record size of 1024 bytes, will */ -/* require the adjustment of this parameter. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DASWFR", (ftnlen)6); - } - -/* Check to be sure that HANDLE is attached to a file that is open */ -/* with write access. If the call fails, check out and return. */ - - dassih_(handle, "WRITE", (ftnlen)5); - -/* Get the logical unit for this DAS file. */ - - dashlu_(handle, &unit); - if (failed_()) { - chkout_("DASWFR", (ftnlen)6); - return 0; - } - -/* In order to maintain the integrity of the file ID word, the */ -/* file FORMAT, and the FTP string if present, we need to */ -/* read the entire file record into the appropriate sized local */ -/* buffers. The values of the LOCxxx variables are simply */ -/* ignored, since the caller passes new values in for updates. */ - - io___3.ciunit = unit; - iostat = s_rdue(&io___3); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locidw, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locnvr, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locnvc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locncr, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locncc, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, format, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, tail, (ftnlen)932); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Attempt to read the file record failed for file '#'. IOSTAT" - " = #", (ftnlen)63); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASREADFAIL)", (ftnlen)18); - chkout_("DASWFR", (ftnlen)6); - return 0; - } - -/* Set the value of the internal file name and IDWORD before */ -/* writing. This is to guarantee that their lengths are ok. */ - - s_copy(ifn, ifname, (ftnlen)60, ifname_len); - s_copy(locidw, idword, (ftnlen)8, idword_len); - io___13.ciunit = unit; - iostat = s_wdue(&io___13); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, locidw, (ftnlen)8); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, ifn, (ftnlen)60); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, format, (ftnlen)8); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, tail, (ftnlen)932); - if (iostat != 0) { - goto L100002; - } - iostat = e_wdue(); -L100002: - if (iostat != 0) { - setmsg_("Could not write file record. File was #. IOSTAT was #.", ( - ftnlen)56); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25); - chkout_("DASWFR", (ftnlen)6); - return 0; - } - -/* Update the file summary, in case the values of the reserved */ -/* record or comment area counts have changed. */ - - dashfs_(handle, &oldrrc, &oldrch, &oldcrc, &oldcch, &free, lastla, lastrc, - lastwd); - dasufs_(handle, nresvr, nresvc, ncomr, ncomc, &free, lastla, lastrc, - lastwd); - chkout_("DASWFR", (ftnlen)6); - return 0; -} /* daswfr_ */ - diff --git a/ext/spice/src/cspice/datanh.c b/ext/spice/src/cspice/datanh.c deleted file mode 100644 index 3182626610..0000000000 --- a/ext/spice/src/cspice/datanh.c +++ /dev/null @@ -1,176 +0,0 @@ -/* datanh.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DATANH ( Double precision arc hyperbolic tangent ) */ -doublereal datanh_(doublereal *x) -{ - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double log(doublereal); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the inverse hyperbolic tangent of a double */ -/* precision argument. */ - -/* $ 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 */ - -/* HYPERBOLIC, MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I Number whose inverse hyperbolic tangent is */ -/* desired. X must lie in the range -1 < X < +1. */ - -/* $ Detailed_Input */ - -/* X is any double precision number greater than or equal to 1. */ - -/* $ Detailed_Output */ - -/* DATANH is the inverse hyperbolic tangent of X. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This function simply implements the definition of the inverse */ -/* hyperbolic tangent as follows: */ - -/* DATANH = 0.5D0 * DLOG ( (1+X) / (1-X) ) */ - -/* If the input value is not valid, an error is signalled. */ - -/* $ Examples */ - -/* The following table gives a few values for X and the resulting */ -/* value of DATANH. */ - -/* X DATANH(X) */ -/* ---------------------------------------------- */ -/* -0.2000000000000000 -0.2027325540540822 */ -/* -0.1000000000000000 -0.1003353477310756 */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* 0.1000000000000000 0.1003353477310756 */ -/* 0.2000000000000000 0.2027325540540822 */ -/* 0.4000000000000000 0.4236489301936018 */ -/* 0.8000000000000000 1.098612288668110 */ - -/* $ Restrictions */ - -/* The value of the input variable X must be between -1.0 and 1.0, */ -/* otherwise an error is signalled. */ - -/* $ Exceptions */ - -/* 1) If X is not between -1.0 and 1.0, the error */ -/* SPICE(INVALIDARGUMENT) is signalled. */ - - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.M. Owen (JPL) */ - -/* $ Literature_References */ - -/* Any good book of mathematical tables and formulae, for example */ -/* the "Standard Mathematical Tables" published by the Chemical */ -/* Rubber Company. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* d.p. arc hyperbolic_tangent */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Set up the error processing. */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } else { - chkin_("DATANH", (ftnlen)6); - ret_val = 0.; - } - -/* Check that -1 < X < +1. */ - - if (abs(*x) >= 1.) { - setmsg_("DATANH: Argument out of range.", (ftnlen)30); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DATANH", (ftnlen)6); - return ret_val; - } - ret_val = log((*x + 1.) / (1. - *x)) * .5; - chkout_("DATANH", (ftnlen)6); - return ret_val; -} /* datanh_ */ - diff --git a/ext/spice/src/cspice/dcbrt.c b/ext/spice/src/cspice/dcbrt.c deleted file mode 100644 index 0d0a7d8690..0000000000 --- a/ext/spice/src/cspice/dcbrt.c +++ /dev/null @@ -1,142 +0,0 @@ -/* dcbrt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b2 = .33333333333333331; - -/* $Procedure DCBRT ( Double precision cube root ) */ -doublereal dcbrt_(doublereal *x) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - - /* Builtin functions */ - double pow_dd(doublereal *, doublereal *), d_sign(doublereal *, - doublereal *); - -/* $ Abstract */ - -/* Return the cube root of a double precision number. */ - -/* $ 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 */ - -/* MATH, ROOT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I Number whose cube root is desired. */ - -/* $ Detailed_Input */ - -/* X may be any double precision value. */ - -/* $ Detailed_Output */ - -/* DCBRT is the cube root of the input value. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* DCBRT calculates the cube root of the input value by using the */ -/* exponentiation operator to raise the input value to the 1/3 */ -/* power. This operation, however, is performed on the absolute */ -/* value of the input variable, and then the sign of the input */ -/* is transferred to the output value. */ - -/* All values of the input variable X should be acceptible to the */ -/* DCBRT. */ - -/* $ Examples */ - -/* The following table gives sample values of the variable X and */ -/* DCBRT(X) */ - -/* X DCBRT(X) */ -/* -------------------------------------------------------------- */ -/* 0.0D0 0.0D0 */ -/* 8.0D0 2.0D0 */ -/* -1.0D3 -1.0D1 */ - -/* $ Restrictions */ - -/* None */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* d.p. cube root */ - -/* -& */ - - d__2 = abs(*x); - d__1 = pow_dd(&d__2, &c_b2); - ret_val = d_sign(&d__1, x); - - return ret_val; -} /* dcbrt_ */ - diff --git a/ext/spice/src/cspice/dcyldr.c b/ext/spice/src/cspice/dcyldr.c deleted file mode 100644 index 39831c9b37..0000000000 --- a/ext/spice/src/cspice/dcyldr.c +++ /dev/null @@ -1,251 +0,0 @@ -/* dcyldr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DCYLDR (Derivative of cylindrical w.r.t. rectangular ) */ -/* Subroutine */ int dcyldr_(doublereal *x, doublereal *y, doublereal *z__, - doublereal *jacobi) -{ - doublereal long__, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), vpack_(doublereal *, - doublereal *, doublereal *, doublereal *); - doublereal injacb[9] /* was [3][3] */, rectan[3]; - extern /* Subroutine */ int reccyl_(doublereal *, doublereal *, - doublereal *, doublereal *), drdcyl_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal zz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invort_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* rectangular to cylindrical coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* X I X-coordinate of point. */ -/* Y I Y-coordinate of point. */ -/* Z I Z-coordinate of point. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* X, */ -/* Y, */ -/* Z are the rectangular coordinates of the point at */ -/* which the Jacobian of the map from rectangular */ -/* to cylindrical coordinates is desired. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between rectangular and cylindrical coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | dr /dx dr /dy dr /dz | */ -/* | dlong/dx dlong/dy dlong/dz | */ -/* | dz /dx dz /dy dz /dz | */ -/* `- -' */ - -/* evaluated at the input values of X, Y, and Z. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input point is on the Z-axis (X and Y = 0), the */ -/* Jacobian is undefined. The error SPICE(POINTONZAXIS) */ -/* will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* When performing vector calculations with velocities it is */ -/* usually most convenient to work in rectangular coordinates. */ -/* However, once the vector manipulations have been performed, */ -/* it is often desirable to convert the rectangular representations */ -/* into cylindrical coordinates to gain insights about phenomena */ -/* in this coordinate frame. */ - -/* To transform rectangular velocities to derivatives of coordinates */ -/* in a cylindrical system, one uses the Jacobian of the */ -/* transformation between the two systems. */ - -/* Given a state in rectangular coordinates */ - -/* ( x, y, z, dx, dy, dz ) */ - -/* the velocity in cylindrical coordinates is given by the matrix */ -/* equation: */ - -/* t | t */ -/* (dr, dlong, dz) = JACOBI| * (dx, dy, dz) */ -/* |(x,y,z) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(x,y,z) */ - -/* $ Examples */ - -/* Suppose one is given the bodyfixed rectangular state of an object */ -/* (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. */ - -/* To find the derivatives of the coordinates of the object in */ -/* bodyfixed cylindrical coordinates, one simply multiplies the */ -/* Jacobian of the transformation from rectangular to cylindrical */ -/* coordinates (evaluated at x(t), y(t), z(t)) by the rectangular */ -/* velocity vector of the object at time t. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the rectangular velocity vector vector RECV. */ -/* C */ -/* RECV(1) = DX_DT ( T ) */ -/* RECV(2) = DY_DT ( T ) */ -/* RECV(3) = DZ_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C rectangular to cylindrical coordinates at the */ -/* C given rectangular coordinates at time T. */ -/* C */ -/* CALL DCYLDR ( X(T), Y(T), Z(T), JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the right by the rectangular */ -/* C velocity to obtain the cylindrical coordinate derivatives */ -/* C CYLV. */ -/* C */ -/* CALL MXV ( JACOBI, RECV, CYLV ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-JUL-2001 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of cylindrical w.r.t. rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DCYLDR", (ftnlen)6); - } - -/* There is a singularity of the Jacobian for points on the z-axis. */ - - if (*x == 0. && *y == 0.) { - setmsg_("The Jacobian of the transformation from rectangular to cyli" - "ndrical coordinates is not defined for points on the z-axis.", - (ftnlen)119); - sigerr_("SPICE(POINTONZAXIS)", (ftnlen)19); - chkout_("DCYLDR", (ftnlen)6); - return 0; - } - -/* We will get the Jacobian of rectangular to cylindrical by */ -/* implicit differentiation. */ - -/* First move the X,Y and Z coordinates into a vector. */ - - vpack_(x, y, z__, rectan); - -/* Convert from rectangular to cylindrical coordinates. */ - - reccyl_(rectan, &r__, &long__, &zz); - -/* Get the Jacobian from cylindrical to rectangular coordinates at */ -/* R, LONG, Z. */ - - drdcyl_(&r__, &long__, &zz, injacb); - -/* Now invert INJACB to get the Jacobian from rectangular to */ -/* cylindrical coordinates. */ - - invort_(injacb, jacobi); - chkout_("DCYLDR", (ftnlen)6); - return 0; -} /* dcyldr_ */ - diff --git a/ext/spice/src/cspice/dcyldr_c.c b/ext/spice/src/cspice/dcyldr_c.c deleted file mode 100644 index 80909b5182..0000000000 --- a/ext/spice/src/cspice/dcyldr_c.c +++ /dev/null @@ -1,213 +0,0 @@ -/* - --Procedure dcyldr_c (Derivative of cylindrical w.r.t. rectangular ) - --Abstract - - This routine computes the Jacobian of the transformation from - rectangular to cylindrical coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void dcyldr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - x I X-coordinate of point. - y I Y-coordinate of point. - z I Z-coordinate of point. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - x, - y, - z are the rectangular coordinates of the point at - which the Jacobian of the map from rectangular - to cylindrical coordinates is desired. - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between rectangular and cylindrical coordinates. It - has the form - - .- -. - | dr /dx dr /dy dr /dz | - | dlon/dx dlon/dy dlon/dz | - | dz /dx dz /dy dz /dz | - `- -' - - evaluated at the input values of x, y, and z. - --Parameters - - None. - --Exceptions - - 1) If the input point is on the z-axis (x and y = 0), the - Jacobian is undefined. The error SPICE(POINTONZAXIS) - will be signaled. - --Files - - None. - --Particulars - - When performing vector calculations with velocities it is - usually most convenient to work in rectangular coordinates. - However, once the vector manipulations have been performed, - it is often desirable to convert the rectangular representations - into cylindrical coordinates to gain insights about phenomena - in this coordinate frame. - - To transform rectangular velocities to derivatives of - coordinates in a cylindrical system, one uses the Jacobian - of the transformation between the two systems. - - Given a state in rectangular coordinates - - ( x, y, z, dx, dy, dz ) - - the velocity in cylindrical coordinates is given by the matrix - equation: - - t | t - (dr, dlon, dz) = jacobi| * (dx, dy, dz) - |(x,y,z) - - This routine computes the matrix - - | - jacobi| - |(x,y,z) - --Examples - - Suppose one is given the bodyfixed rectangular state of an object - (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. - - To find the derivatives of the coordinates of the object in - bodyfixed cylindrical coordinates, one simply multiplies the - Jacobian of the transformation from rectangular to cylindrical - coordinates (evaluated at x(t), y(t), z(t)) by the rectangular - velocity vector of the object at time t. - - In code this looks like: - - #include "SpiceUsr.h" - . - . - . - /. - Load the rectangular velocity vector vector recv. - ./ - recv[0] = dx ( t ); - recv[1] = dy ( t ); - recv[2] = dz ( t ); - - /. - Determine the Jacobian of the transformation from - rectangular to cylindrical coordinates at the - given rectangular coordinates at time T. - ./ - dcyldr_c ( x(t), y(t), z(t), jacobi ); - - /. - Multiply the Jacobian on the right by the rectangular - velocity to obtain the cylindrical coordinate derivatives - cylv. - ./ - mxv_c ( jacobi, recv, cylv ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 19-JUL-2001 (WLT) (NJB) - --Index_Entries - - Jacobian of cylindrical w.r.t. rectangular coordinates - --& -*/ - -{ /* Begin dcyldr_c */ - - chkin_c ( "dcyldr_c" ); - - - dcyldr_ ( (doublereal *) &x, - (doublereal *) &y, - (doublereal *) &z, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "dcyldr_c" ); - -} /* End dcyldr_c */ diff --git a/ext/spice/src/cspice/delfil.c b/ext/spice/src/cspice/delfil.c deleted file mode 100644 index 6bd7bf4524..0000000000 --- a/ext/spice/src/cspice/delfil.c +++ /dev/null @@ -1,286 +0,0 @@ -/* delfil.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DELFIL ( Delete a file ) */ -/* Subroutine */ int delfil_(char *filnam, ftnlen filnam_len) -{ - /* System generated locals */ - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open( - olist *), f_clos(cllist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer lunit; - logical opened; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), getlun_(integer *), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - logical exists; - -/* $ Abstract */ - -/* Delete a file. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILNAM I The name of a file to be deleted. */ - -/* $ Detailed_Input */ - -/* FILNAM is the name of a file that is to be deleted. Upon */ -/* successful completion of this routine this file will */ -/* no longer exist. The file to be deleted must be closed */ -/* when this routine is called. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None */ - -/* $ Exceptions */ - -/* 1) If the file name is blank, the error SPICE(BLANKFILENAME) */ -/* is signalled. */ - -/* 2) If the inquire on the filename specified by FILNAM fails for */ -/* some reason, the error SPICE(INQUIREERROR) will be signalled. */ - -/* 3) If the file specified by FILNAM is already open, the error */ -/* SPICE(FILECURRENTLYOPEN) will be signalled. */ - -/* 4) If the file specified by FILNAM does not exist, the error */ -/* SPICE(NOSUCHFILE) will be signalled. */ - -/* 5) If the attempt to open the file specified by FILNAM fails, */ -/* the error SPICE(FILEOPENFAILED) will be signalled. */ - -/* 6) If the attempt to close the file with STATUS='DELETE' fails */ -/* the error SPICE(FILEDELETEFAILED) will be signalled. */ - -/* $ Files */ - -/* The file specified by FILNAM is opened and then closed by this */ -/* routine with STATUS = 'DELETE' to delete it. The file must be */ -/* closed for this routine to delete it. */ - -/* $ Particulars */ - -/* This subroutine is a support utility that deletes a file. */ - -/* $ Examples */ - -/* Suppose you wish to delete a file named 'delete.me' in the */ -/* current directory. The code fragment below would accomplish this. */ - -/* FILE = 'delete.me' */ -/* CALL DELFIL ( FILE ) */ - -/* $ Restrictions */ - -/* The file to be deleted must be closed when this routine is */ -/* invoked. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-DEC-1995 (KRG) */ - -/* -& */ - -/* $ Index_Entries */ - -/* delete a file */ - -/* -& */ - -/* Spicelib Routines */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DELFIL", (ftnlen)6); - } - -/* Check to see if the filename we got is blank. If it is, signal an */ -/* error and return. */ - - if (s_cmp(filnam, " ", filnam_len, (ftnlen)1) == 0) { - setmsg_("The file name is blank.", (ftnlen)23); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("DELFIL", (ftnlen)6); - return 0; - } - -/* We inquire before we try opening anything to see if the file */ -/* exists or is currently open. */ - - ioin__1.inerr = 1; - ioin__1.infilen = filnam_len; - ioin__1.infile = filnam; - ioin__1.inex = &exists; - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - -/* Not too likely, but if the INQUIRE statement fails signal an error */ -/* and return. */ - - if (iostat != 0) { - setmsg_("INQUIRE statement failed for file '#'. IOSTAT = #.", (ftnlen) - 50); - errch_("#", filnam, (ftnlen)1, filnam_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("DELFIL", (ftnlen)6); - return 0; - } - -/* The file ought to exist if you're trying to delete it. If not, */ -/* signal an error and return. */ - - if (! exists) { - setmsg_("The file '#' does not exist.", (ftnlen)28); - errch_("#", filnam, (ftnlen)1, filnam_len); - sigerr_("SPICE(NOSUCHFILE)", (ftnlen)17); - chkout_("DELFIL", (ftnlen)6); - return 0; - } - -/* The file that is to be deleted should not be in use, indicated by */ -/* it being open, by anything when we try to delete it. If it is */ -/* open, signal an error and return. */ - - if (opened) { - setmsg_("The file '#' is currently open and cannot be deleted.", ( - ftnlen)53); - errch_("#", filnam, (ftnlen)1, filnam_len); - sigerr_("SPICE(FILECURRENTLYOPEN)", (ftnlen)24); - chkout_("DELFIL", (ftnlen)6); - return 0; - } - -/* Get an available logical unit and attempt to open the file. */ - - getlun_(&lunit); - o__1.oerr = 1; - o__1.ounit = lunit; - o__1.ofnmlen = filnam_len; - o__1.ofnm = filnam; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = 0; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we had trouble opening the file, signal an appropriate error */ -/* and return. */ - - if (iostat != 0) { - setmsg_("Attempt to open the file '#' failed.", (ftnlen)36); - errch_("#", filnam, (ftnlen)1, filnam_len); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("DELFIL", (ftnlen)6); - return 0; - } - -/* We opened the file successfully, so let's try to close it with */ -/* STATUS = 'DELETE'. If this fails, attempt to just close the file, */ -/* signal an error and return. */ - - cl__1.cerr = 1; - cl__1.cunit = lunit; - cl__1.csta = "DELETE"; - iostat = f_clos(&cl__1); - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = lunit; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to delete the file '#' failed.", (ftnlen)38); - errch_("#", filnam, (ftnlen)1, filnam_len); - sigerr_("SPICE(FILEDELETEFAILED)", (ftnlen)23); - chkout_("DELFIL", (ftnlen)6); - return 0; - } - chkout_("DELFIL", (ftnlen)6); - return 0; -} /* delfil_ */ - diff --git a/ext/spice/src/cspice/deltet.c b/ext/spice/src/cspice/deltet.c deleted file mode 100644 index ebe40b9a1d..0000000000 --- a/ext/spice/src/cspice/deltet.c +++ /dev/null @@ -1,424 +0,0 @@ -/* deltet.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__200 = 200; -static integer c__400 = 400; - -/* $Procedure DELTET ( Delta ET, ET - UTC ) */ -/* Subroutine */ int deltet_(doublereal *epoch, char *eptype, doublereal * - delta, ftnlen eptype_len) -{ - /* Initialized data */ - - static char missed[20*5] = "DELTET/DELTA_T_A, # " "DELTET/K, # " - "DELTET/EB, # " "DELTET/M, # " "DELTET/DELTA_AT, " - "# "; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - double d_nint(doublereal *), sin(doublereal); - - /* Local variables */ - char type__[4]; - integer i__; - doublereal k, m[2]; - integer n; - doublereal dleap[400] /* was [2][200] */; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nleap; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - doublereal leaps, ettai; - logical found[5]; - char dtype[1]; - doublereal ea, eb, ma, et; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), dtpool_(char *, logical *, integer *, - char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dta, aet; - -/* $ Abstract */ - -/* Return the value of Delta ET (ET-UTC) for an input epoch. */ - -/* $ 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 */ - -/* TIME */ -/* KERNEL */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* EPOCH I Input epoch (seconds past J2000). */ -/* EPTYPE I Type of input epoch ('UTC' or 'ET'). */ -/* DELTA O Delta ET (ET-UTC) at input epoch. */ - -/* $ Detailed_Input */ - -/* EPOCH is the epoch at which Delta ET is to be computed. */ -/* This may be either UTC or ephemeris seconds past */ -/* J2000, as specified by EPTYPE. */ - -/* EPTYPE indicates the type of input epoch. It may be either */ -/* of the following: */ - -/* 'UTC' input is UTC seconds past J2000. */ -/* 'ET' input is ephemeris seconds past J2000. */ - - -/* $ Detailed_Output */ - -/* DELTA is the value of */ - -/* Delta ET = ET - UTC */ - -/* at the input epoch. This is added to UTC to give */ -/* ET, or subtracted from ET to give UTC. The routine */ -/* is reversible: that is, given the following calls, */ - -/* CALL DELTET ( UTC, 'UTC', DEL1 ) */ -/* CALL DELTET ( UTC+DEL1, 'ET', DEL2 ) */ - -/* the expression */ - -/* ( DEL1 .EQ. DEL2 ) */ - -/* is always true. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input epoch is not recognized, the error */ -/* SPICE(INVALIDEPOCH) is signaled. */ - -/* 2) If the variables necessary for the computation of DELTA */ -/* have not been loaded into the kernel pool, the error */ -/* SPICE(KERNELVARNOTFOUND) is signaled. */ - -/* 3) If the number of leapseconds in the pool is greater than */ -/* the local leapseconds buffer size, the error */ -/* SPICE(BUFFEROVERFLOW) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The constants necessary for computing the offset are taken */ -/* from the kernel pool, where they are assumed to have been */ -/* loaded from a kernel file. */ - -/* The tables are consulted to determine the number of leap seconds */ -/* preceding the input epoch. Also, an approximation to the periodic */ -/* yearly variation (which has an amplitude of just under two */ -/* milliseconds) in the difference between ET and TAI (Atomic Time) */ -/* is computed. The final value of Delta ET is given by */ - -/* Delta ET = ( ET - TAI ) + leap seconds */ - -/* $ Examples */ - -/* The following example shows how DELTET may be used to convert */ -/* from UTC seconds past J2000 to ephemeris seconds past J2000. */ - -/* CALL DELTET ( UTCSEC, 'UTC', DELTA ) */ -/* ET = UTCSEC + DELTA */ - -/* The following example shows how DELTET may be used to convert */ -/* from ephemeris seconds past J2000 to UTC seconds past J2000. */ - -/* CALL DELTET ( ET, 'ET', DELTA ) */ -/* UTCSEC = ET - DELTA */ - -/* See the TIME required reading for further examples. */ - -/* $ Restrictions */ - -/* The routines UTC2ET and ET2UTC are preferred for conversions */ -/* between UTC and ET. This routine is provided mainly as a utility */ -/* for UTC2ET and ET2UTC. */ - -/* The kernel pool containing leapseconds and relativistic terms */ -/* MUST be loaded prior to calling this subroutine. Examples */ -/* demonstrating how to load a kernel pool are included in the */ -/* Required Reading file TIME.REQ and in the "Examples" */ -/* section of this header. For more general information about */ -/* kernel pools, please consult the Required Reading file */ -/* KERNEL.REQ. */ - -/* $ Literature_References */ - -/* Astronomical Almanac. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.2.0, 24-AUG-1998 (WLT) */ - -/* The previous upgrade introduced an error in the fetch */ -/* of the variable DELTET/M from the kernel pool. This */ -/* error was corrected. */ - -/* - SPICELIB Version 1.1.0, 20-APR-1998 (NJB) */ - -/* Calls to RTPOOL were replaced with calls to GDPOOL, which */ -/* does more robust error checking. Check for buffer overflow */ -/* was added. Local declarations were re-organized. */ - -/* - 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 (WMO) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* difference between ephemeris time and utc */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 24-AUG-1998 (WLT) */ - -/* The previous upgrade introduced an error in the fetch */ -/* of the variable DELTET/M from the kernel pool. This */ -/* error was corrected. */ - -/* - SPICELIB Version 1.1.0, 20-APR-1998 (NJB) */ - -/* Calls to RTPOOL were replaced with calls to GDPOOL, which */ -/* does more robust error checking. */ - -/* - Beta Version 1.1.0, 06-OCT-1988 (IMU) */ - -/* Tim Colvin of Rand noticed that times returned by UTC2ET */ -/* and TPARSE differed by one second. Upon closer inspection, */ -/* crack NAIF staff members deduced that in fact Mr. Colvin */ -/* had not loaded the kernel pool, and were surprised to learn */ -/* that no error had occurred. */ - -/* Multiple FOUND flags and a bevy of new error messages were */ -/* implemented to cope with this unfortunate oversight. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DELTET", (ftnlen)6); - } - -/* Convert the epoch type to uppercase, to simplify comparisons. */ - - ucase_(eptype, type__, eptype_len, (ftnlen)4); - -/* Extract the necessary constants from the kernel pool. */ -/* Leap seconds and their epochs are interleaved in DELTA_AT. */ - -/* DLEAP(1,i) is the number of leap seconds at DLEAP(2,i) UTC */ -/* seconds past J2000. */ - - gdpool_("DELTET/DELTA_T_A", &c__1, &c__1, &n, &dta, found, (ftnlen)16); - gdpool_("DELTET/K", &c__1, &c__1, &n, &k, &found[1], (ftnlen)8); - gdpool_("DELTET/EB", &c__1, &c__1, &n, &eb, &found[2], (ftnlen)9); - gdpool_("DELTET/M", &c__1, &c__2, &n, m, &found[3], (ftnlen)8); - -/* Check that the number of leapseconds is not too great for our */ -/* buffer size (not likely). */ - - dtpool_("DELTET/DELTA_AT", &found[4], &nleap, dtype, (ftnlen)15, (ftnlen) - 1); - if (nleap > 400) { - setmsg_("Number of leapseconds, #, is greater than the number that c" - "an be buffered, #.", (ftnlen)77); - i__1 = nleap / 2; - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__200, (ftnlen)1); - sigerr_("SPICE(BUFFERTOOSMALL)", (ftnlen)21); - chkout_("DELTET", (ftnlen)6); - return 0; - } - gdpool_("DELTET/DELTA_AT", &c__1, &c__400, &nleap, dleap, &found[4], ( - ftnlen)15); - nleap /= 2; - if (! (found[0] && found[1] && found[2] && found[3] && found[4])) { - setmsg_("The following, needed to compute Delta ET (ET - UTC), could" - " not be found in the kernel pool: #", (ftnlen)94); - for (i__ = 1; i__ <= 5; ++i__) { - if (! found[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "found", i__1, "deltet_", (ftnlen)337)]) { - errch_("#", missed + ((i__1 = i__ - 1) < 5 && 0 <= i__1 ? - i__1 : s_rnge("missed", i__1, "deltet_", (ftnlen)338)) - * 20, (ftnlen)1, (ftnlen)20); - } - } - errch_(", #", ".", (ftnlen)3, (ftnlen)1); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("DELTET", (ftnlen)6); - return 0; - } - -/* There are two separate quantities to be determined. First, */ -/* the appropriate number of leap seconds. Second, the size of */ -/* the periodic term ET-TAI. */ - - -/* For epochs before the first leap second, return Delta ET at */ -/* the epoch of the leap second minus one second. */ - - leaps = dleap[0] - 1; - -/* When counting leap seconds for UTC epochs, we can compare */ -/* directly against the values in DLEAP. */ - - if (s_cmp(type__, "UTC", (ftnlen)4, (ftnlen)3) == 0) { - i__1 = nleap; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*epoch >= dleap[(i__2 = (i__ << 1) - 1) < 400 && 0 <= i__2 ? - i__2 : s_rnge("dleap", i__2, "deltet_", (ftnlen)371)]) { - leaps = dleap[(i__2 = (i__ << 1) - 2) < 400 && 0 <= i__2 ? - i__2 : s_rnge("dleap", i__2, "deltet_", (ftnlen)372)]; - } - } - -/* For ET epochs, things are a little tougher. In order to compare */ -/* the input epoch against the epochs of the leap seconds, we need */ -/* to compute ET-TAI at each of the leap epochs. To make sure that */ -/* the computation is reversible, it is always done at the nearest */ -/* ET second (the "approximate ET", or AET). */ - -/* There must be a hundred ways to do this more efficiently. */ -/* For now, we'll settle for one that works. */ - - } else if (s_cmp(type__, "ET", (ftnlen)4, (ftnlen)2) == 0) { - i__1 = nleap; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*epoch > dleap[(i__2 = (i__ << 1) - 1) < 400 && 0 <= i__2 ? - i__2 : s_rnge("dleap", i__2, "deltet_", (ftnlen)389)]) { - d__1 = dleap[(i__2 = (i__ << 1) - 1) < 400 && 0 <= i__2 ? - i__2 : s_rnge("dleap", i__2, "deltet_", (ftnlen)391)] - + dta + dleap[(i__3 = (i__ << 1) - 2) < 400 && 0 <= - i__3 ? i__3 : s_rnge("dleap", i__3, "deltet_", ( - ftnlen)391)]; - aet = d_nint(&d__1); - ma = m[0] + m[1] * aet; - ea = ma + eb * sin(ma); - ettai = k * sin(ea); - et = dleap[(i__2 = (i__ << 1) - 1) < 400 && 0 <= i__2 ? i__2 : - s_rnge("dleap", i__2, "deltet_", (ftnlen)397)] + dta - + dleap[(i__3 = (i__ << 1) - 2) < 400 && 0 <= i__3 ? - i__3 : s_rnge("dleap", i__3, "deltet_", (ftnlen)397)] - + ettai; - if (*epoch >= et) { - leaps = dleap[(i__2 = (i__ << 1) - 2) < 400 && 0 <= i__2 ? - i__2 : s_rnge("dleap", i__2, "deltet_", (ftnlen) - 400)]; - } - } - } - -/* Uh, those are the only choices. */ - - } else { - setmsg_("Epoch type was #", (ftnlen)16); - errch_("#", type__, (ftnlen)1, (ftnlen)4); - sigerr_("SPICE(INVALIDEPOCH)", (ftnlen)19); - chkout_("DELTET", (ftnlen)6); - return 0; - } - -/* Add the constant offset, leap seconds, and the relativistic term */ -/* (as before, computed at the nearest ET second). */ - - if (s_cmp(type__, "ET", (ftnlen)4, (ftnlen)2) == 0) { - aet = d_nint(epoch); - } else if (s_cmp(type__, "UTC", (ftnlen)4, (ftnlen)3) == 0) { - d__1 = *epoch + dta + leaps; - aet = d_nint(&d__1); - } - ma = m[0] + m[1] * aet; - ea = ma + eb * sin(ma); - ettai = k * sin(ea); - *delta = dta + leaps + ettai; - chkout_("DELTET", (ftnlen)6); - return 0; -} /* deltet_ */ - diff --git a/ext/spice/src/cspice/deltet_c.c b/ext/spice/src/cspice/deltet_c.c deleted file mode 100644 index 8a1a0cb040..0000000000 --- a/ext/spice/src/cspice/deltet_c.c +++ /dev/null @@ -1,211 +0,0 @@ -/* - --Procedure deltet_c ( Delta ET, ET - UTC ) - --Abstract - - Return the value of Delta ET (ET-UTC) for an input epoch. - --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 - - TIME - KERNEL - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void deltet_c ( SpiceDouble epoch, - ConstSpiceChar * eptype, - SpiceDouble * delta ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - epoch I Input epoch (seconds past J2000). - eptype I Type of input epoch ("UTC" or "ET"). - delta O Delta ET (ET-UTC) at input epoch. - --Detailed_Input - - epoch is the epoch at which "delta ET" is to be computed. - `epoch' may be either UTC or ephemeris seconds past - J2000, as specified by EPTYPE. - - eptype indicates the type of input epoch. It may be either - of the following: - - "UTC" UTC seconds past J2000 UTC. - - "ET" Ephemeris seconds past J2000 TDB, - also known as barycentric dynamical - time (TDB). - --Detailed_Output - - delta is the value of - - "delta ET" = ET - UTC - - at the input epoch. This is added to UTC to give - ET, or subtracted from ET to give UTC. The routine - is reversible: that is, given the following calls, - - deltet_c ( utc, "UTC", &del1 ); - deltet_c ( utc+del1, "ET", &del2 ); - - the expression - - ( del1 == del2 ) - - is true. - --Parameters - - None. - --Exceptions - - 1) If the input epoch is not recognized, the error - SPICE(INVALIDEPOCH) is signaled. - - 2) If the variables necessary for the computation of delta - have not been loaded into the kernel pool, the error - SPICE(KERNELVARNOTFOUND) is signaled. - - 3) If the number of leapseconds in the pool is greater than - the local leapseconds buffer size, the error - SPICE(BUFFEROVERFLOW) is signaled. - - 4) The error SPICE(EMPTYSTRING) is signaled if the input - string `eptype' does not contain at least one character, since - the input string cannot be converted to a Fortran-style string in - this case. - - 5) The error SPICE(NULLPOINTER) is signaled if the input string - pointer is null. - --Files - - None. - --Particulars - - The value of Delta ET is given by - - delta = ( ET - TAI ) + leap seconds - - where TAI is the atomic time corresponding to the input epoch. - --Examples - - The following example shows how deltet_c may be used to convert - from UTC seconds past J2000 to TDB seconds past J2000. - - deltet_c ( utcsec, "UTC", &delta ); - et = utcsec + delta - - The following example shows how deltet_c may be used to convert - from ephemeris seconds past J2000 to UTC seconds past J2000. - - deltet_c ( et, "et", &delta ); - utcsec = et - delta; - - See the TIME Required Reading for further examples. - --Restrictions - - The routines str2et_c and timout_c are preferred for conversions - between UTC string and ET represented as seconds past J2000 TDB. - - This routine is provided mainly to provide a method of representing - an epoch as UTC seconds past J2000. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - I.M. Underwood (JPL) - --Literature_References - - [1] Astronomical Almanac. - --Version - - -CSPICE Version 1.0.0, 01-AUG-2003 (NJB) (WMO) (IMU) - --Index_Entries - - difference between ephemeris time and utc - --& -*/ - -{ /* Begin deltet_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "deltet_c" ); - - - /* - Check the input string `eptype' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "deltet_c", eptype ); - - - /* - Call the f2c'd Fortran routine. - */ - deltet_ ( ( doublereal * ) &epoch, - ( char * ) eptype, - ( doublereal * ) delta, - ( ftnlen ) strlen(eptype) ); - - - chkout_c ( "deltet_c" ); - -} /* End deltet_c */ diff --git a/ext/spice/src/cspice/derf_.c b/ext/spice/src/cspice/derf_.c deleted file mode 100644 index 6afaccdaa3..0000000000 --- a/ext/spice/src/cspice/derf_.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double erf(); -double derf_(x) doublereal *x; -#else -extern double erf(double); -double derf_(doublereal *x) -#endif -{ -return( erf(*x) ); -} diff --git a/ext/spice/src/cspice/derfc_.c b/ext/spice/src/cspice/derfc_.c deleted file mode 100644 index e199f91605..0000000000 --- a/ext/spice/src/cspice/derfc_.c +++ /dev/null @@ -1,14 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern double erfc(); - -double derfc_(x) doublereal *x; -#else -extern double erfc(double); - -double derfc_(doublereal *x) -#endif -{ -return( erfc(*x) ); -} diff --git a/ext/spice/src/cspice/det.c b/ext/spice/src/cspice/det.c deleted file mode 100644 index 1f6d8d00a5..0000000000 --- a/ext/spice/src/cspice/det.c +++ /dev/null @@ -1,134 +0,0 @@ -/* det.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DET ( Determinant of a double precision 3x3 matrix ) */ -doublereal det_(doublereal *m1) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Compute the determinant of a double precision 3x3 matrix. */ - -/* $ 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 */ - -/* MATRIX, MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Matrix whose determinant is to be found. */ - -/* $ Detailed_Input */ - -/* M1 This variable may be any double precision, 3x3 matrix. */ - -/* $ Detailed_Output */ - -/* DET This is the value of the determinant found by direct */ -/* application of the definition of the determinant. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* DET calculates the determinant of M1 in a single arithmetic */ -/* expression which is, effectively, the expansion of M1 about its */ -/* first row. Since the calculation of the determinant involves */ -/* the multiplication of numbers whose magnitudes are unrestricted, */ -/* there is the possibility of floating point overflow or underflow. */ -/* NO error checking or recovery is implemented in this routine. */ - -/* $ Examples */ - -/* | 1 2 3 | */ -/* M1 = | 4 5 6 | ----> DET(M1) = 0 */ -/* | 7 8 9 | */ - -/* | 1 2 3 | */ -/* M1 = | 0 5 6 | ----> DET(M1) = 45 */ -/* | 0 0 9 | */ - -/* $ Restrictions */ - -/* No checking is implemented to determine whether M1 will cause */ -/* overflow or underflow in the process of calculating the */ -/* determinant. In most cases, this will not pose a problem. */ -/* The user is required to determine if M1 is suitable matrix */ -/* for DET to operate on. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* determinant of a d.p. 3x3_matrix */ - -/* -& */ - ret_val = m1[0] * (m1[4] * m1[8] - m1[7] * m1[5]) - m1[3] * (m1[1] * m1[8] - - m1[7] * m1[2]) + m1[6] * (m1[1] * m1[5] - m1[4] * m1[2]); - - return ret_val; -} /* det_ */ - diff --git a/ext/spice/src/cspice/det_c.c b/ext/spice/src/cspice/det_c.c deleted file mode 100644 index 58ead2e371..0000000000 --- a/ext/spice/src/cspice/det_c.c +++ /dev/null @@ -1,134 +0,0 @@ -/* - --Procedure det_c ( Determinant of a double precision 3x3 matrix ) - --Abstract - - Compute the determinant of a double precision 3x3 matrix. - --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 - - MATRIX, MATH - -*/ - - #include "SpiceUsr.h" - #undef det_c - - - SpiceDouble det_c ( ConstSpiceDouble m1[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Matrix whose determinant is to be found. - --Detailed_Input - - m1 This variable may be any double precision, 3x3 matrix. - --Detailed_Output - - det_c This is the value of the determinant found by direct - application of the definition of the determinant. - --Parameters - - None. - --Particulars - - det_c calculates the determinant of m1 in a single arithmetic - expression which is, effectively, the expansion of m1 about its - first row. Since the calculation of the determinant involves - the multiplication of numbers whose magnitudes are unrestricted, - there is the possibility of floating point overflow or underflow. - NO error checking or recovery is implemented in this routine. - --Examples - - | 1 2 3 | - M1 = | 4 5 6 | ----> det_c(m1) = 0 - | 7 8 9 | - - | 1 2 3 | - M1 = | 0 5 6 | ----> det_c(m1) = 45 - | 0 0 9 | - --Restrictions - - No checking is implemented to determine whether M1 will cause - overflow or underflow in the process of calculating the - determinant. In most cases, this will not pose a problem. - The user is required to determine if M1 is suitable matrix - for det_c to operate on. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.0.0, 21-OCT-1998 (NJB) - --Index_Entries - - determinant of a d.p. 3x3_matrix - --& -*/ - -{ /* Begin det_c */ - - - return ( ( m1[0][0] * ( m1[1][1]*m1[2][2] - m1[2][1]*m1[1][2] ) ) - - ( m1[0][1] * ( m1[1][0]*m1[2][2] - m1[2][0]*m1[1][2] ) ) - + ( m1[0][2] * ( m1[1][0]*m1[2][1] - m1[2][0]*m1[1][1] ) ) ); - - -} /* End det_c */ diff --git a/ext/spice/src/cspice/dfe.c b/ext/spice/src/cspice/dfe.c deleted file mode 100644 index 6963d5a011..0000000000 --- a/ext/spice/src/cspice/dfe.c +++ /dev/null @@ -1,141 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" - -y_rsk(Void) -{ - if(f__curunit->uend || f__curunit->url <= f__recpos - || f__curunit->url == 1) return 0; - do { - getc(f__cf); - } while(++f__recpos < f__curunit->url); - return 0; -} -y_getc(Void) -{ - int ch; - if(f__curunit->uend) return(-1); - if((ch=getc(f__cf))!=EOF) - { - f__recpos++; - if(f__curunit->url>=f__recpos || - f__curunit->url==1) - return(ch); - else return(' '); - } - if(feof(f__cf)) - { - f__curunit->uend=1; - errno=0; - return(-1); - } - err(f__elist->cierr,errno,"readingd"); -} - - static int -y_rev(Void) -{ - if (f__recpos < f__hiwater) - f__recpos = f__hiwater; - if (f__curunit->url > 1) - while(f__recpos < f__curunit->url) - (*f__putn)(' '); - if (f__recpos) - f__putbuf(0); - f__recpos = 0; - return(0); -} - - static int -y_err(Void) -{ - err(f__elist->cierr, 110, "dfe"); -} - - static int -y_newrec(Void) -{ - y_rev(); - f__hiwater = f__cursor = 0; - return(1); -} - -#ifdef KR_headers -c_dfe(a) cilist *a; -#else -c_dfe(cilist *a) -#endif -{ - f__sequential=0; - f__formatted=f__external=1; - f__elist=a; - f__cursor=f__scale=f__recpos=0; - f__curunit = &f__units[a->ciunit]; - if(a->ciunit>MXUNIT || a->ciunit<0) - err(a->cierr,101,"startchk"); - if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit)) - err(a->cierr,104,"dfe"); - f__cf=f__curunit->ufd; - if(!f__curunit->ufmt) err(a->cierr,102,"dfe") - if(!f__curunit->useek) err(a->cierr,104,"dfe") - f__fmtbuf=a->cifmt; - if(a->cirec <= 0) - err(a->cierr,130,"dfe") - fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET); - f__curunit->uend = 0; - return(0); -} -#ifdef KR_headers -integer s_rdfe(a) cilist *a; -#else -integer s_rdfe(cilist *a) -#endif -{ - int n; - if(!f__init) f_init(); - f__reading=1; - if(n=c_dfe(a))return(n); - if(f__curunit->uwrt && f__nowreading(f__curunit)) - err(a->cierr,errno,"read start"); - f__getn = y_getc; - f__doed = rd_ed; - f__doned = rd_ned; - f__dorevert = f__donewrec = y_err; - f__doend = y_rsk; - if(pars_f(f__fmtbuf)<0) - err(a->cierr,100,"read start"); - fmt_bg(); - return(0); -} -#ifdef KR_headers -integer s_wdfe(a) cilist *a; -#else -integer s_wdfe(cilist *a) -#endif -{ - int n; - if(!f__init) f_init(); - f__reading=0; - if(n=c_dfe(a)) return(n); - if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) - err(a->cierr,errno,"startwrt"); - f__putn = x_putc; - f__doed = w_ed; - f__doned= w_ned; - f__dorevert = y_err; - f__donewrec = y_newrec; - f__doend = y_rev; - if(pars_f(f__fmtbuf)<0) - err(a->cierr,100,"startwrt"); - fmt_bg(); - return(0); -} -integer e_rdfe(Void) -{ - en_fio(); - return 0; -} -integer e_wdfe(Void) -{ - return en_fio(); -} diff --git a/ext/spice/src/cspice/dgeodr.c b/ext/spice/src/cspice/dgeodr.c deleted file mode 100644 index 43c8ba9868..0000000000 --- a/ext/spice/src/cspice/dgeodr.c +++ /dev/null @@ -1,288 +0,0 @@ -/* dgeodr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DGEODR ( Derivative of geodetic w.r.t. rectangular ) */ -/* Subroutine */ int dgeodr_(doublereal *x, doublereal *y, doublereal *z__, - doublereal *re, doublereal *f, doublereal *jacobi) -{ - doublereal long__; - extern /* Subroutine */ int chkin_(char *, ftnlen), vpack_(doublereal *, - doublereal *, doublereal *, doublereal *), errdp_(char *, - doublereal *, ftnlen); - doublereal injacb[9] /* was [3][3] */; - extern /* Subroutine */ int recgeo_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), drdgeo_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal rectan[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invort_(doublereal *, doublereal *); - doublereal lat, alt; - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* rectangular to geodetic coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* X I X-coordinate of point. */ -/* Y I Y-coordinate of point. */ -/* Z I Z-coordinate of point. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* X, */ -/* Y, */ -/* Z are the rectangular coordinates of the point at */ -/* which the Jacobian of the map from rectangular */ -/* to geodetic coordinates is desired. */ - -/* RE Equatorial radius of the reference spheroid. */ - -/* F Flattening coefficient = (RE-RP) / RE, where RP is */ -/* the polar radius of the spheroid. (More importantly */ -/* RP = RE*(1-F).) */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between rectangular and geodetic coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | DLONG/DX DLONG/DY DLONG/DZ | */ -/* | DLAT/DX DLAT/DY DLAT/DZ | */ -/* | DALT/DX DALT/DY DALT/DZ | */ -/* `- -' */ - -/* evaluated at the input values of X, Y, and Z. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input point is on the z-axis (X and Y = 0), the */ -/* Jacobian is undefined. The error SPICE(POINTONZAXIS) */ -/* will be signaled. */ - -/* 2) If the flattening coefficient is greater than or equal to */ -/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 3) If the equatorial radius is not positive, the error */ -/* SPICE(BADRADIUS) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* When performing vector calculations with velocities it is */ -/* usually most convenient to work in rectangular coordinates. */ -/* However, once the vector manipulations have been performed, */ -/* it is often desirable to convert the rectangular representations */ -/* into geodetic coordinates to gain insights about phenomena */ -/* in this coordinate frame. */ - -/* To transform rectangular velocities to derivatives of coordinates */ -/* in a geodetic system, one uses the Jacobian of the transformation */ -/* between the two systems. */ - -/* Given a state in rectangular coordinates */ - -/* ( x, y, z, dx, dy, dz ) */ - -/* the velocity in geodetic coordinates is given by the matrix */ -/* equation: */ -/* t | t */ -/* (dlon, dlat, dalt) = JACOBI| * (dx, dy, dz) */ -/* |(x,y,z) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(x, y, z) */ - -/* $ Examples */ - -/* Suppose one is given the bodyfixed rectangular state of an object */ -/* (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. */ - -/* To find the derivatives of the coordinates of the object in */ -/* bodyfixed geodetic coordinates, one simply multiplies the */ -/* Jacobian of the transformation from rectangular to geodetic */ -/* coordinates (evaluated at x(t), y(t), z(t)) by the rectangular */ -/* velocity vector of the object at time t. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the rectangular velocity vector vector RECV. */ -/* C */ -/* RECV(1) = DX_DT ( T ) */ -/* RECV(2) = DY_DT ( T ) */ -/* RECV(3) = DZ_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C rectangular to geodetic coordinates at the rectangular */ -/* C coordinates at time T. */ -/* C */ -/* CALL DGEODR ( X(T), Y(T), Z(T), RE, F, JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the right by the rectangular */ -/* C velocity to obtain the geodetic coordinate derivatives */ -/* C GEOV. */ -/* C */ -/* CALL MXV ( JACOBI, RECV, GEOV ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-JUL-2001 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of geodetic w.r.t. rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DGEODR", (ftnlen)6); - } - -/* If the flattening coefficient is greater than one, the polar */ -/* radius computed below is negative. If it's equal to one, the */ -/* polar radius is zero. Either case is a problem, so signal an */ -/* error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was *.", (ftnlen)29); - errdp_("*", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DGEODR", (ftnlen)6); - return 0; - } - if (*re <= 0.) { - setmsg_("Equatorial Radius <= 0.0D0. RE = *", (ftnlen)34); - errdp_("*", re, (ftnlen)1); - sigerr_("SPICE(BADRADIUS)", (ftnlen)16); - chkout_("DGEODR", (ftnlen)6); - return 0; - } - -/* There is a singularity of the Jacobian for points on the z-axis. */ - - if (*x == 0. && *y == 0.) { - setmsg_("The Jacobian of the transformation from rectangular to geod" - "etic coordinates is not defined for points on the z-axis.", ( - ftnlen)116); - sigerr_("SPICE(POINTONZAXIS)", (ftnlen)19); - chkout_("DGEODR", (ftnlen)6); - return 0; - } - -/* We will get the Jacobian of rectangular to geodetic by */ -/* implicit differentiation. */ - -/* First move the X,Y and Z coordinates into a vector. */ - - vpack_(x, y, z__, rectan); - -/* Convert from rectangular to geodetic coordinates. */ - - recgeo_(rectan, re, f, &long__, &lat, &alt); - -/* Get the Jacobian of the transformation from geodetic to */ -/* rectangular coordinates at LONG, LAT, ALT. */ - - drdgeo_(&long__, &lat, &alt, re, f, injacb); - -/* Now invert INJACB to get the Jacobian of the transformation */ -/* from rectangular to geodetic coordinates. */ - - invort_(injacb, jacobi); - chkout_("DGEODR", (ftnlen)6); - return 0; -} /* dgeodr_ */ - diff --git a/ext/spice/src/cspice/dgeodr_c.c b/ext/spice/src/cspice/dgeodr_c.c deleted file mode 100644 index 166d691ecc..0000000000 --- a/ext/spice/src/cspice/dgeodr_c.c +++ /dev/null @@ -1,237 +0,0 @@ -/* - --Procedure dgeodr_c ( Derivative of geodetic w.r.t. rectangular ) - --Abstract - - This routine computes the Jacobian of the transformation from - rectangular to geodetic coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dgeodr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - X I X-coordinate of point. - Y I Y-coordinate of point. - Z I Z-coordinate of point. - RE I Equatorial radius of the reference spheroid. - F I Flattening coefficient. - JACOBI O Matrix of partial derivatives. - --Detailed_Input - - x, - y, - z are the rectangular coordinates of the point at - which the Jacobian of the map from rectangular - to geodetic coordinates is desired. - - re Equatorial radius of the reference spheroid. - - f Flattening coefficient = (re-rp) / re, where rp is - the polar radius of the spheroid. (More importantly - rp = re*(1-f).) - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between rectangular and geodetic coordinates. It - has the form - - .- -. - | dlon/dx dlon/dy dlon/dz | - | dlat/dx dlat/dy dlat/dz | - | dalt/dx dalt/dy dalt/dz | - `- -' - - evaluated at the input values of x, y, and z. - --Parameters - - None. - --Exceptions - - 1) If the input point is on the z-axis (x and y = 0), the - Jacobian is undefined. The error SPICE(POINTONZAXIS) - will be signaled. - - 2) If the flattening coefficient is greater than or equal to - one, the error SPICE(VALUEOUTOFRANGE) is signaled. - - 3) If the equatorial radius is not positive, the error - SPICE(BADRADIUS) is signaled. - --Files - - None. - --Particulars - - When performing vector calculations with velocities it is - usually most convenient to work in rectangular coordinates. - However, once the vector manipulations have been performed, - it is often desirable to convert the rectangular representations - into geodetic coordinates to gain insights about phenomena - in this coordinate frame. - - To transform rectangular velocities to derivatives of coordinates - in a geodetic system, one uses the Jacobian of the transformation - between the two systems. - - Given a state in rectangular coordinates - - ( x, y, z, dx, dy, dz ) - - the velocity in geodetic coordinates is given by the matrix - equation: - t | t - (dlon, dlat, dalt) = jacobi| * (dx, dy, dz) - |(x,y,z) - - This routine computes the matrix - - | - jacobi| - |(x, y, z) - - --Examples - - Suppose one is given the bodyfixed rectangular state of an object - (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. - - To find the derivatives of the coordinates of the object in - bodyfixed geodetic coordinates, one simply multiplies the - Jacobian of the transformation from rectangular to geodetic - coordinates (evaluated at x(t), y(t), z(t)) by the rectangular - velocity vector of the object at time t. - - In code this looks like: - - #include "SpiceUsr.h" - . - . - . - - /. - Load the rectangular velocity vector vector recv. - ./ - recv[0] = dx_dt ( t ); - recv[1] = dy_dt ( t ); - recv[2] = dz_dt ( t ); - - /. - Determine the Jacobian of the transformation from - rectangular to geodetic coordinates at the rectangular - coordinates at time t. - ./ - dgeodr_c ( x(t), y(t), z(t), re, f, jacobi ); - - /. - Multiply the Jacobian on the right by the rectangular - velocity to obtain the geodetic coordinate derivatives - geov. - ./ - mxv_c ( jacobi, recv, geov ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 18-JUL-2001 (WLT) (NJB) - --Index_Entries - - Jacobian of geodetic w.r.t. rectangular coordinates - --& -*/ - -{ /* Begin dgeodr_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dgeodr_c" ); - - - dgeodr_ ( (doublereal *) &x, - (doublereal *) &y, - (doublereal *) &z, - (doublereal *) &re, - (doublereal *) &f, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "dgeodr_c" ); - -} /* End dgeodr_c */ diff --git a/ext/spice/src/cspice/dhfa.c b/ext/spice/src/cspice/dhfa.c deleted file mode 100644 index f1f018d21e..0000000000 --- a/ext/spice/src/cspice/dhfa.c +++ /dev/null @@ -1,346 +0,0 @@ -/* dhfa.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DHFA ( Time derivative of half angle ) */ -doublereal dhfa_(doublereal *state, doublereal *bodyr) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - doublereal base; - extern doublereal vdot_(doublereal *, doublereal *); - doublereal p[3], r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen), unorm_(doublereal *, doublereal *, - doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - doublereal rngrat; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Calculate the value of the time derivative of the */ -/* half angle of a spherical body given a state vector */ -/* STATE and body radius BODYR. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STATE I SPICE state vector */ -/* BODYR I Radius of body */ - -/* $ Detailed_Input */ - -/* STATE the state vector of a target body as seen from an */ -/* observer. */ - -/* BODYR the radius of the target body observed from the */ -/* position in STATE; the target body assumed as a sphere. */ - -/* $ Detailed_Output */ - -/* The function returns the double precision value of the time */ -/* derivative of the half angle of a spherical body in radians */ -/* per second. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) A negative value for BODYR causes SPICE(BADRADIUS) to signal. */ - -/* 2) A position component of STATE equaling the zero vector */ -/* causes SPICE(DEGENERATECASE) to signal. */ - -/* 3) A condition where the body radius exceeds the distance from */ -/* the body to the observer causes SPICE(BADGEOMETRY) to signal. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* In this discussion, the notation */ - -/* < V1, V2 > */ - -/* indicates the dot product of vectors V1 and V2. */ - -/* The expression */ - -/* body_radius */ -/* sin(ALPHA) = ----------- (1) */ -/* range */ - -/* describes the half angle (ALPHA) of a spherical body, i.e. the */ -/* angular radius of the spherical body as viewed by an observer at */ -/* distance 'range'. */ - -/* Solve for ALPHA */ - -/* -1 body_radius */ -/* ALPHA = sin ( ----------- ) (2) */ -/* range */ - -/* Take the derivative of ALPHA with respect to time */ - -/* d 1 d body_radius */ -/* --(ALPHA) = --------------------- * __ (----------- ) (3) */ -/* dt 1 - body_radius 2 1/2 dt range */ -/* ( [ ----------- ] ) */ -/* range */ - -/* d - body_radius 1 d */ -/* --(ALPHA) = --------------------- * ------ * __(range) (4) */ -/* dt 1 - body_radius 2 1/2 2 dt */ -/* ( [ ----------- ] ) range */ -/* range */ - -/* With */ -/* _ _ */ -/* d < R, V > - */ -/* -- ( range ) = -------- , range = ||R|| (5) */ -/* dt - */ -/* ||R|| */ - -/* Apply (5) to equation (4) */ -/* _ _ */ -/* d - body_radius 1 < R, V > */ -/* --(ALPHA) = --------------------- * ------ * -------- (6) */ -/* dt 1 - body_radius 2 1/2 2 range */ -/* ( [ ----------- ] ) range */ -/* range */ - -/* Carry range through the denominator gives */ - -/* _ _ */ -/* d - body_radius < R, V > */ -/* --(ALPHA) = --------------------- * -------- (7) */ -/* dt 2 2 1/2 2 */ -/* (range - body_radius ) range */ - -/* So since */ -/* - - _ _ */ -/* ^ - < R, V > < R, V > */ -/* < R, V > = --- = -------- */ -/* - range */ -/* ||R|| */ - -/* ^ _ */ -/* d - body_radius < R, V > */ -/* --(ALPHA) = --------------------- * -------- (8) */ -/* dt 2 2 1/2 */ -/* (range - body_radius ) range */ - - -/* $ Examples */ - -/* PROGRAM DHFA_EX */ -/* IMPLICIT NONE */ - -/* INTEGER DIM */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION DHADT */ -/* DOUBLE PRECISION RAD (3) */ -/* DOUBLE PRECISION STATE (6) */ - -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 64 ) */ - -/* CHARACTER*(STRLEN) BEGSTR */ - - -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION DHFA */ -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ('standard.tm') */ - -/* C */ -/* C An approximate time corresponding to a maximal angular */ -/* C separation between the earth and Moon as seen from the sun. */ -/* C */ -/* BEGSTR = '2007-DEC-17 04:04:46.935443 (TDB)' */ -/* CALL STR2ET( BEGSTR, ET ) */ - -/* CALL BODVRD ('SUN', 'RADII', 3, DIM, RAD ) */ - -/* CALL SPKEZR ('MOON', ET, 'J2000', 'NONE', 'SUN', STATE, LT ) */ - -/* C */ -/* C The derivative of the half angle at ET should have a near-to */ -/* C maximal value as the Moon velocity vector points either */ -/* C towards the sun or away. */ -/* C */ -/* DHADT = DHFA( STATE, RAD(1) ) */ -/* WRITE(*,*) 'Half angle derivative at begin time : ', DHADT */ - -/* C */ -/* C Two weeks later the derivate should have a similar */ -/* C magnitude but the opposite sign. */ -/* C */ -/* ET = SPD() * 14.D0 + ET */ - -/* CALL SPKEZR ('MOON', ET, 'J2000', 'NONE', 'SUN', STATE, LT ) */ - -/* DHADT = DHFA( STATE, RAD(1) ) */ -/* WRITE(*,*) 'Half angle derivative two weeks later: ', DHADT */ - -/* END */ - -/* The program compiled on OS X with g77 outputs (radians/sec): */ - -/* Half angle derivative at begin time : -2.53879935E-11 */ -/* Half angle derivative two weeks later: 2.94362059E-11 */ - -/* As expected, the derivate values have similar magnitudes but */ -/* opposite signs. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 06-JUL-2009 (EDW) */ - -/* Rename of the ZZDHA call to DHFA. */ - -/* - SPICELIB Version 1.0.0, 10-FEB-2009 (EDW) (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* time derivative of half angle */ - -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } else { - chkin_("DHFA", (ftnlen)4); - } - -/* A zero body radius (point object) returns a zero for the */ -/* derivative. A negative value indicates an error */ -/* the caller should diagnose. */ - - if (*bodyr == 0.) { - ret_val = 0.; - chkout_("DHFA", (ftnlen)4); - return ret_val; - } else if (*bodyr < 0.) { - ret_val = 0.; - setmsg_("Non physical case. The input body radius has a negative val" - "ue.", (ftnlen)62); - sigerr_("SPICE(BADRADIUS)", (ftnlen)16); - chkout_("DHFA", (ftnlen)4); - return ret_val; - } - -/* Normalize the position component of STATE. Store the unit vector */ -/* in P. */ - - unorm_(state, p, &r__); - if (vzero_(p)) { - ret_val = 0.; - setmsg_("The position component of the input state vector equals the" - " zero vector.", (ftnlen)72); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("DHFA", (ftnlen)4); - return ret_val; - } - -/* Calculate the range rate. */ - - rngrat = vdot_(p, &state[3]); - -/* Confirm R > BODYR. */ - -/* Computing 2nd power */ - d__1 = r__; -/* Computing 2nd power */ - d__2 = *bodyr; - base = d__1 * d__1 - d__2 * d__2; - if (base <= 0.) { - ret_val = 0.; - setmsg_("Invalid case. The body radius, #1, equals or exceeds the ra" - "nge to the target, #2.", (ftnlen)81); - errdp_("#1", bodyr, (ftnlen)2); - errdp_("#2", &r__, (ftnlen)2); - sigerr_("SPICE(BADGEOMETRY)", (ftnlen)18); - chkout_("DHFA", (ftnlen)4); - return ret_val; - } - -/* Now we safely take the square root of BASE. */ - - base = sqrt(base); - ret_val = -(rngrat * *bodyr) / (base * r__); - chkout_("DHFA", (ftnlen)4); - return ret_val; -} /* dhfa_ */ - diff --git a/ext/spice/src/cspice/diags2.c b/ext/spice/src/cspice/diags2.c deleted file mode 100644 index 787c534219..0000000000 --- a/ext/spice/src/cspice/diags2.c +++ /dev/null @@ -1,574 +0,0 @@ -/* diags2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static doublereal c_b6 = 1.; -static integer c__2 = 2; - -/* $Procedure DIAGS2 ( Diagonalize symmetric 2x2 matrix ) */ -/* Subroutine */ int diags2_(doublereal *symmat, doublereal *diag, doublereal - *rotate) -{ - /* Initialized data */ - - static doublereal ident[4] /* was [2][2] */ = { 1.,0.,0.,1. }; - - /* System generated locals */ - doublereal d__1, d__2, d__3; - - /* Local variables */ - doublereal tmpd, tmpv[2], a, b, c__, root1[2], root2[2], scale; - extern /* Subroutine */ int chkin_(char *, ftnlen), vhatg_(doublereal *, - integer *, doublereal *), moved_(doublereal *, integer *, - doublereal *), rquad_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal eigvec[2]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Diagonalize a symmetric 2x2 matrix. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ - -/* SYMMAT I A symmetric 2x2 matrix. */ -/* DIAG O A diagonal matrix similar to SYMMAT. */ -/* ROTATE O A rotation used as the similarity transformation. */ - -/* $ Detailed_Input */ - -/* SYMMAT A symmetric 2x2 matrix. That is, SYMMAT has the */ -/* form */ - -/* +- -+ */ -/* | A B | */ -/* | |. */ -/* | B C | */ -/* +- -+ */ - -/* This routine uses only the upper-triangular */ -/* elements of SYMMAT, that is, the elements */ - -/* SYMMAT(1,1) */ -/* SYMMAT(1,2) */ -/* SYMMAT(2,2) */ - -/* to determine the outputs DIAG and ROTATE. */ - -/* $ Detailed_Output */ - -/* DIAG, */ -/* ROTATE are, respectively, a diagonal matrix and a 2x2 */ -/* rotation matrix that satisfy the equation */ - -/* T */ -/* DIAG = ROTATE * SYMMAT * ROTATE. */ - -/* In other words, DIAG is similar to SYMMAT, and */ -/* ROTATE is a change-of-basis matrix that */ -/* diagonalizes SYMMAT. DIAGS2 chooses ROTATE so */ -/* that its angle of rotation has the smallest */ -/* possible magnitude. If there are two rotations */ -/* that meet these criteria (they will be inverses of */ -/* one another), either rotation may be chosen. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The matrix element SYMMAT(2,1) is not used in this routine's */ -/* computations, so the condition */ - -/* SYMMAT(1,2) .NE. SYMMAT(2,1) */ - -/* has no effect on this routine's outputs. */ - -/* $ Particulars */ - -/* The capability of diagonalizing a 2x2 symmetric matrix is */ -/* especially useful in a number of geometric applications */ -/* involving quadratic curves such as ellipses. Such curves are */ -/* described by expressions of the form */ - -/* 2 2 */ -/* A x + B xy + C y + D x + E y + F = 0. */ - -/* Diagonalization of the matrix */ - -/* +- -+ */ -/* | A B/2 | */ -/* | | */ -/* | B/2 C | */ -/* +- -+ */ - -/* allows us to perform a coordinate transformation (a rotation, */ -/* specifically) such that the equation of the curve becomes */ - -/* 2 2 */ -/* P u + Q v + R u + S v + T = 0 */ - -/* in the transformed coordinates. This form is much easier to */ -/* handle. If the quadratic curve in question is an ellipse, */ -/* we can easily find its center, semi-major axis, and semi-minor */ -/* axis from the second equation. */ - -/* Ellipses turn up frequently in navigation geometry problems; */ -/* for example, the limb and terminator (if we treat the Sun as a */ -/* point source) of a body modelled as a tri-axial ellipsoid are */ -/* ellipses. */ - -/* A mathematical note: because SYMMAT is symmetric, we can ALWAYS */ -/* find an orthogonal similarity transformation that diagonalizes */ -/* SYMMAT, and we can choose the similarity transformation to be a */ -/* rotation matrix. By `orthogonal' we mean that if the ROTATE is */ -/* the matrix in question, then */ - -/* T T */ -/* ROTATE ROTATE = ROTATE ROTATE = I. */ - -/* The reasons this routine handles only the 2x2 case are: first, */ -/* the 2x2 case is much simpler than the general case, in which */ -/* iterative diagonalization methods must be used, and second, the */ -/* 2x2 case is adequate for solving problems involving ellipses in */ -/* 3 dimensional space. Finally, this routine can be used to */ -/* support a routine that solves the general-dimension */ -/* diagonalization problem for symmetric matrices. */ - -/* Another feature of the routine that might provoke curiosity is */ -/* its insistence on choosing the diagonalization matrix that */ -/* rotates the original basis vectors by the smallest amount. The */ -/* rotation angle of ROTATE is of no concern for most applications, */ -/* but can be important if this routine is used as part of an */ -/* iterative diagonalization method for higher-dimensional matrices. */ -/* In that case, it is most undesirable to interchange diagonal */ -/* matrix elements willy-nilly; the matrix to be diagonalized could */ -/* get ever closer to being diagonal without converging. Choosing */ -/* the smallest rotation angle precludes this possibility. */ - -/* $ Examples */ - -/* 1) A case that can be verified by hand computation: */ -/* Suppose SYMMAT is */ - -/* +- -+ */ -/* | 1.0D0 4.0D0 | */ -/* | | */ -/* | 4.0D0 -5.0D0 | */ -/* +- -+ */ - -/* Then SYMMAT is similar to the diagonal matrix */ - -/* +- -+ */ -/* | 3.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 -7.0D0 | */ -/* +- -+ */ - -/* so */ - -/* DIAG(1,1) = 3.D0 */ -/* DIAG(2,1) = 0.D0 */ -/* DIAG(1,2) = 0.D0 */ -/* DIAG(2,2) = -7.D0 */ - -/* and ROTATE is */ - -/* +- -+ */ -/* | 0.894427191 -0.447213595 | */ -/* | | */ -/* | 0.447213595 0.894427191 | */ -/* +- -+ */ - -/* which is an approximation to */ - -/* +- -+ */ -/* | 0.4 * 5**(1/2) -0.2 * 5**(1/2) | */ -/* | | */ -/* | 0.2 * 5**(1/2) 0.4 * 5**(1/2) | */ -/* +- -+ */ - - -/* 2) Suppose we want to find the semi-axes of the ellipse defined */ -/* by */ -/* 2 2 */ -/* 27 x + 10 xy + 3 y = 1. */ - -/* We can write the above equation as the matrix equation */ - -/* +- -+ +- -+ +- -+ */ -/* | x y | | 27 5 | | x | = 1; */ -/* +- -+ | | | | */ -/* | 5 3 | | y | */ -/* +- -+ +- -+ */ - -/* let SYMMAT be the symmetric matrix on the left. The code */ -/* fragment */ - -/* SYMMAT(1,1) = 27.D0 */ -/* SYMMAT(2,1) = 5.D0 */ -/* SYMMAT(1,2) = 5.D0 */ -/* SYMMAT(2,2) = 3.D0 */ - -/* CALL DIAGS2 ( SYMMAT, DIAG, ROTATE ) */ - -/* will return DIAG, an array containing the eigenvalues of */ -/* SYMMAT, and ROTATE, the coordinate transformation required */ -/* to diagonalize SYMMAT. In this case, */ - -/* DIAG(1,1) = 28.D0 */ -/* DIAG(2,1) = 0.D0 */ -/* DIAG(1,2) = 0.D0 */ -/* DIAG(2,2) = 2.D0 */ - -/* and */ - -/* ROTATE(1,1) = 0.980580676D0 */ -/* ROTATE(2,1) = 0.196116135D0 */ -/* ROTATE(1,2) = -0.196116135D0 */ -/* ROTATE(2,2) = 0.980580676D0 */ - -/* The columns of ROTATE give the ellipse's axes, after scaling */ -/* them by */ - -/* 1 1 */ -/* ---------------- and --------------- */ -/* ____________ ____________ */ -/* \/ DIAG(1,1) \/ DIAG(2,2) */ - -/* respectively. */ - -/* If SMAJOR and SMINOR are semi-major and semi-minor axes, */ -/* we can find them as shown below. For brevity, we omit the */ -/* check for zero or negative eigenvalues. Negative or zero */ -/* eigenvalues will occur only as a result of round-off error; */ -/* mathematically, the eigenvalues of the matrix SYMMAT are */ -/* guaranteed to be positive, since they are the reciprocals of */ -/* the squares of the lengths of the ellipse's semi-axes. */ - -/* DO I = 1, 2 */ -/* SMAJOR(I) = ROTATE(I,1) / DSQRT( DIAG(1,1) ) */ -/* SMINOR(I) = ROTATE(I,2) / DSQRT( DIAG(2,2) ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Calculus, Vol. II. Tom Apostol. John Wiley & Sons, 1969. */ -/* See Chapter 5, `Eigenvalues of Operators Acting on Euclidean */ -/* Spaces'. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHATG and SWAPD calls. */ - -/* - SPICELIB Version 1.1.0, 24-JAN-2002 (EDW) */ - -/* Edited incorrect examples in the header. The example */ -/* outputs did not correspond to the actual function */ -/* of the routine. */ - -/* - 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, 04-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* diagonalize symmetric 2x2_matrix */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHATG and SWAPD calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DIAGS2", (ftnlen)6); - } - -/* We check for the case of a diagonal input matrix, since */ -/* eigenvector determination is simplified by ruling out this */ -/* case. */ - if (symmat[2] == 0.) { - moved_(ident, &c__4, rotate); - moved_(symmat, &c__4, diag); - -/* Explicity zero out the (2,1) entry of DIAG, since DIAG is */ -/* guaranteed to be diagonal. */ - - diag[1] = 0.; - chkout_("DIAGS2", (ftnlen)6); - return 0; - } - -/* Getting here means there's some actual work to do. We start out */ -/* by scaling our matrix, in order to reduce the chance of overflow. */ -/* We divide everything by the largest magnitude of any element of */ -/* SYMMAT. We're guaranteed that SCALE is non-zero, since the 0 */ -/* matrix is diagonal. */ - -/* Computing MAX */ - d__1 = abs(symmat[0]), d__2 = abs(symmat[2]), d__1 = max(d__1,d__2), d__2 - = abs(symmat[3]); - scale = max(d__1,d__2); - a = symmat[0] / scale; - b = symmat[2] / scale; - c__ = symmat[3] / scale; - -/* Compute the eigenvalues of the scaled version of SYMMAT. The */ -/* eigenvalues are roots of the equation */ - -/* DET ( (1 / SCALE) * SYMMAT - x * IDENTITY ) = 0, */ - -/* or equivalently, */ - -/* 2 2 */ -/* x - ( A + C ) x + ( AC - B ) = 0. */ - - - d__1 = -(a + c__); -/* Computing 2nd power */ - d__3 = b; - d__2 = a * c__ - d__3 * d__3; - rquad_(&c_b6, &d__1, &d__2, root1, root2); - -/* ROOT1 is the root corresponding to the positive discriminant term; */ -/* this is guaranteed by RQUAD. */ - - diag[0] = root1[0]; - diag[1] = 0.; - diag[2] = 0.; - diag[3] = root2[0]; - -/* Our next job is to find an eigenvector corresponding to the */ -/* eigenvalue of smaller magnitude. We can unitize it and choose */ -/* an orthogonal unit vector so as to create the desired rotation */ -/* matrix. */ - -/* If our original matrix is */ - -/* +- -+ */ -/* | A B | */ -/* | |, */ -/* | B C | */ -/* +- -+ */ - -/* then the matrix */ - -/* +- -+ */ -/* | A - DIAG(x,x) B | */ -/* | | */ -/* | B C - DIAG(x,x) | */ -/* +- -+ */ - -/* maps to zero all elements of the eigenspace corresponding to */ -/* DIAG(x,x), where x is either 1 or 2. */ - -/* So */ - -/* +- -+ +- -+ */ -/* | B | | DIAG(x,x) - C | */ -/* | | and | | */ -/* | DIAG(x,x) - A | | B | */ -/* +- -+ +- -+ */ - -/* are candidates for eigenvectors for DIAG(x,x). To minimize */ -/* loss of accuracy in our eigenvector due to subtraction of */ -/* nearly equal quantities, we choose the vector in which the */ -/* term involving the eigenvalue has the larger magnitude. The */ -/* rigorous justification of this choice would literally take */ -/* pages of explanation, and we are not going to go through it */ -/* here. In most cases, either choice is satisfactory, and in */ -/* the case where cancellation is a problem, our choice is */ -/* preferable. */ - -/* Note that there is nothing to be gained as far as accuracy is */ -/* concerned by working with one eigenvalue as opposed to the */ -/* other: the magnitudes of the quantities DIAG(x,x) - A and */ -/* DIAG(x,x) - C would be interchanged by taking x = '2' instead */ -/* of x = '1'. */ - - if ((d__1 = diag[0] - a, abs(d__1)) >= (d__2 = diag[0] - c__, abs(d__2))) - { - -/* In this case, the second eigenvector component EIGVEC(2) */ -/* should be larger than |B|; we explain why in detail below. */ -/* We use the MAX function below to guard against reversal of the */ -/* inequality due to round-off error. */ - - eigvec[0] = b; -/* Computing MAX */ - d__1 = diag[0] - a, d__2 = abs(b); - eigvec[1] = max(d__1,d__2); - -/* Recall that DIAG(1,1) is an eigenvalue of the scaled version */ -/* of SYMMAT */ - -/* +- -+ */ -/* | A B | */ -/* | |. */ -/* | B C | */ -/* +- -+ */ - -/* DIAG(1,1) is the positive-discriminant root of this matrix's */ -/* characteristic equation. EIGVEC's y-component */ - -/* DIAG(1,1) - A */ - -/* is positive and of magnitude at least as large as that of B, */ -/* since it is the larger of */ -/* ______________________ */ -/* / 2 */ -/* C - A / ( A - C ) 2 */ -/* DIAG(1,1) - A = ----- + \ / ---------- + B */ -/* 2 \/ 4 */ - -/* and */ -/* ______________________ */ -/* / 2 */ -/* A - C / ( A - C ) 2 */ -/* DIAG(1,1) - C = ----- + \ / ---------- + B */ -/* 2 \/ 4 */ - -/* Equality between these expressions can occur only when A is */ -/* equal to C, in which case both expressions are equal (except */ -/* for round-off error) to |B|. */ - - -/* So the argument of EIGVEC is in the interval [pi/4, 3*pi/4]. */ -/* The second eigenvector is EIGVEC, and the first */ -/* eigenvector is found by rotating EIGVEC by -pi/2. Since */ -/* DIAG(1,1) is the eigenvalue for the SECOND eigenvector, we */ -/* must swap the eigenvalues. */ - - -/* Unitize the eigenvector. */ - - vhatg_(eigvec, &c__2, tmpv); - moved_(tmpv, &c__2, eigvec); - rotate[0] = eigvec[1]; - rotate[1] = -eigvec[0]; - rotate[2] = eigvec[0]; - rotate[3] = eigvec[1]; - -/* Swap DIAG(1,1) and DIAG(2,2). */ - - tmpd = diag[3]; - diag[3] = diag[0]; - diag[0] = tmpd; - } else { -/* Computing MAX */ - d__1 = diag[0] - c__, d__2 = abs(b); - eigvec[0] = max(d__1,d__2); - eigvec[1] = b; - -/* The x-component of EIGVEC is positive and has magnitude */ -/* greater than or equal to that of the y-component of EIGVEC. */ -/* The argument of EIGVEC is in [-pi/4, pi/4], and the second */ -/* eigenvector is found by rotating EIGVEC by pi/2. */ - - -/* Unitize the eigenvector. */ - - vhatg_(eigvec, &c__2, tmpv); - moved_(tmpv, &c__2, eigvec); - rotate[0] = eigvec[0]; - rotate[1] = eigvec[1]; - rotate[2] = -eigvec[1]; - rotate[3] = eigvec[0]; - } - -/* We must scale the eigenvalues. */ - - diag[0] *= scale; - diag[3] *= scale; - chkout_("DIAGS2", (ftnlen)6); - return 0; -} /* diags2_ */ - diff --git a/ext/spice/src/cspice/diags2_c.c b/ext/spice/src/cspice/diags2_c.c deleted file mode 100644 index 7eff8e4734..0000000000 --- a/ext/spice/src/cspice/diags2_c.c +++ /dev/null @@ -1,551 +0,0 @@ -/* - --Procedure diags2_c ( Diagonalize symmetric 2x2 matrix ) - --Abstract - - Diagonalize a symmetric 2x2 matrix. - --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 - - ROTATION - --Keywords - - ELLIPSE - MATRIX - ROTATION - TRANSFORMATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef diags2_c - - - void diags2_c ( ConstSpiceDouble symmat [2][2], - SpiceDouble diag [2][2], - SpiceDouble rotate [2][2] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - - symmat I A symmetric 2x2 matrix. - diag O A diagonal matrix similar to symmat. - rotate O A rotation used as the similarity transformation. - --Detailed_Input - - symmat A symmetric 2x2 matrix. That is, symmat has the - form - - +- -+ - | A B | - | |. - | B C | - +- -+ - - This routine uses only the upper-triangular - elements of symmat, that is, the elements - - symmat[0][0] - symmat[0][1] - symmat[1][1] - - to determine the outputs diag and rotate. - --Detailed_Output - - diag, - rotate are, respectively, a diagonal matrix and a 2x2 - rotation matrix that satisfy the equation - - T - diag = rotate * symmat * rotate. - - In other words, diag is similar to symmat, and - rotate is a change-of-basis matrix that - diagonalizes symmat. diags2_c chooses rotate so - that its angle of rotation has the smallest - possible magnitude. If there are two rotations - that meet these criteria (they will be inverses of - one another), either rotation may be chosen. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - - 1) The matrix element symmat[1][0] is not used in this routine's - computations, so the condition - - symmat[0][1] != symmat[1][0] - - has no effect on this routine's outputs. - --Particulars - - The capability of diagonalizing a 2x2 symmetric matrix is - especially useful in a number of geometric applications - involving quadratic curves such as ellipses. Such curves are - described by expressions of the form - - 2 2 - A x + B xy + C y + D x + E y + F = 0. - - Diagonalization of the matrix - - +- -+ - | A B/2 | - | | - | B/2 C | - +- -+ - - allows us to perform a coordinate transformation (a rotation, - specifically) such that the equation of the curve becomes - - 2 2 - P u + Q v + R u + S v + T = 0 - - in the transformed coordinates. This form is much easier to - handle. If the quadratic curve in question is an ellipse, - we can easily find its center, semi-major axis, and semi-minor - axis from the second equation. - - Ellipses turn up frequently in navigation geometry problems; - for example, the limb and terminator (if we treat the Sun as a - point source) of a body modelled as a tri-axial ellipsoid are - ellipses. - - A mathematical note: because symmat is symmetric, we can ALWAYS - find an orthogonal similarity transformation that diagonalizes - symmat, and we can choose the similarity transformation to be a - rotation matrix. By `orthogonal' we mean that if the rotate is - the matrix in question, then - - T T - rotate rotate = rotate rotate = I. - - The reasons this routine handles only the 2x2 case are: first, - the 2x2 case is much simpler than the general case, in which - iterative diagonalization methods must be used, and second, the - 2x2 case is adequate for solving problems involving ellipses in - 3 dimensional space. Finally, this routine can be used to - support a routine that solves the general-dimension diagonalization - problem for symmetric matrices. - - Another feature of the routine that might provoke curiosity is - its insistence on choosing the diagonalization matrix that - rotates the original basis vectors by the smallest amount. The - rotation angle of rotate is of no concern for most applications, - but can be important if this routine is used as part of an - iterative diagonalization method for higher-dimensional matrices. - In that case, it is most undesirable to interchange diagonal - matrix elements willy-nilly; the matrix to be diagonalized could - get ever closer to being diagonal without converging. Choosing - the smallest rotation angle precludes this possibility. - --Examples - - 1) A case that can be verified by hand computation: - Suppose symmat is - - +- -+ - | 1.0 4.0 | - | | - | 4.0 -5.0 | - +- -+ - - Then symmat is similar to the diagonal matrix - - +- -+ - | 3.0 0.0 | - | | - | 0.0 -7.0 | - +- -+ - - so - - diag[0][0] = 3. - diag[1][0] = 0. - diag[0][1] = 0. - diag[1][1] = -7. - - and rotate is - - +- -+ - | 0.89442719099991588 -0.44721359549995794 | - | | - | 0.44721359549995794 0.89442719099991588 | - +- -+ - - which is an approximation to - - +- -+ - | .4 * 5**(1/2) -.2 * 5**(1/2) | - | | - | .2 * 5**(1/2) .4 * 5**(1/2) | - +- -+ - - - 2) Suppose we want to find the semi-axes of the ellipse defined - by - 2 2 - 27 x + 10 xy + 3 y = 1 - - We can write the above equation as the matrix equation - - +- -+ +- -+ +- -+ - | x y | | 27 5 | | x | = 1 - +- -+ | | | | - | 5 3 | | y | - +- -+ +- -+ - - Let symmat be the symmetric matrix on the left. The code - fragment - - symmat[0][0] = 27.0; - symmat[1][0] = 5.0; - symmat[0][1] = 5.0; - symmat[1][1] = 3.0; - - diags2_c ( symmat, diag, rotate ); - - will return diag, an array containing the eigenvalues of - symmat, and rotate, the coordinate transformation required - to diagonalize symmat. In this case, - - diag[0][0] = 28. - diag[1][0] = 0. - diag[0][1] = 0. - diag[1][1] = 2. - - and - - rotate[0][0] = 0.980580675690920 - rotate[1][0] = 0.196116135138184 - rotate[0][1] = -0.196116135138184 - rotate[1][1] = 0.980580675690920 - - The columns of rotate give the ellipse's axes, after scaling - them by - - 1 1 - ---------------- and --------------- - ____________ ____________ - \/ diag[0][0] \/ diag[1][1] - - respectively. - - If smajor and sminor are semi-major and semi-minor axes, - we can find them as shown below. For brevity, we omit the - check for zero or negative eigenvalues. - - for ( i = 0; i < 2; i++ ) - { - smajor[i] = rotate[i][0] / sqrt( diag[0][0] ); - sminor[i] = rotate[i][1] / sqrt( diag[1][1] ); - } - --Restrictions - - None. - --Literature_References - - [1] Calculus, Vol. II. Tom Apostol. John Wiley & Sons, 1969. - See Chapter 5, `Eigenvalues of Operators Acting on Euclidean - Spaces'. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 13-JUL-1999 (NJB) - --Index_Entries - - diagonalize symmetric 2x2_matrix - --& -*/ - -{ /* Begin diags2_c */ - - /* - Local constants - */ - - - /* - Static variables - */ - static SpiceDouble ident [2][2] = { {1., 0.}, {0., 1.} }; - - - /* - Local variables - */ - SpiceDouble a; - SpiceDouble b; - SpiceDouble c; - SpiceDouble eigvec [2]; - SpiceDouble root1 [2]; - SpiceDouble root2 [2]; - SpiceDouble scale; - - - /* - Error free. - */ - - /* - We check for the case of a diagonal input matrix, since - eigenvector determination is simplified by ruling out this - case. - */ - - if ( symmat [0][1] == 0. ) - { - MOVED ( ident, 4, rotate ); - MOVED ( symmat, 4, diag ); - - /* - Explicitly zero out the [1][0] entry of diag, since diag is - guaranteed to be diagonal. - */ - diag[1][0] = 0.0; - - return; - } - - - /* - Getting here means there's some actual work to do. We start out - by scaling our matrix, in order to reduce the chance of overflow. - We divide everything by the largest magnitude of any element of - symmat. We're guaranteed that scale is non-zero, since the 0 - matrix is diagonal. - */ - - scale = MaxAbs ( symmat[0][0], symmat[0][1] ); - scale = MaxAbs ( scale, symmat[1][1] ); - - a = symmat[0][0] / scale; - b = symmat[0][1] / scale; - c = symmat[1][1] / scale; - - - /* - Compute the eigenvalues of the scaled version of symmat. The - eigenvalues are roots of the equation - - det ( (1 / scale) * symmat - x * identity ) = 0, - - or equivalently, - - 2 2 - x - ( a + c ) x + ( ac - b ) = 0. - - */ - - rquad_c ( 1.0, -(a + c), a*c - b*b, root1, root2 ); - - - /* - root1 is the root corresponding to the positive discriminant term; - this is guaranteed by rquad_c. - */ - diag[0][0] = root1[0]; - diag[1][0] = 0.; - diag[0][1] = 0.; - diag[1][1] = root2[0]; - - - /* - Our next job is to find an eigenvector corresponding to the - eigenvalue of smaller magnitude. We can unitize it and choose - an orthogonal unit vector so as to create the desired rotation - matrix. - - If our original matrix is - - +- -+ - | a b | - | |, - | b c | - +- -+ - - then the matrix - - +- -+ - | a - diag[x][x] b | - | | - | b c - diag[x][x] | - +- -+ - - maps to zero all elements of the eigenspace corresponding to - diag[x][x], where x is either 0 or 1. - - So - - +- -+ +- -+ - | b | | diag[x][x] - c | - | | and | | - | diag[x][x] - a | | b | - +- -+ +- -+ - - are candidates for eigenvectors for diag[x][x]. To minimize - loss of accuracy in our eigenvector due to subtraction of - nearly equal quantities, we choose the vector in which the - term involving the eigenvalue has the larger magnitude. - - Note that there is nothing to be gained as far as accuracy is - concerned by working with one eigenvalue as opposed to the - other: the magnitudes of the quantities diag[x][x] - a and - diag[x][x] - c would be interchanged by taking x = 1 instead - of x = 0. - */ - - if ( fabs( diag[0][0] - a ) >= fabs( diag[0][0] - c ) ) - { - - /* - In this case, the second eigenvector component eigvec[1] - should be larger than |b|; we explain why in detail below. - We use the MaxVal macro below to guard against reversal of the - inequality due to round-off error. - */ - - eigvec[0] = b; - eigvec[1] = MaxVal ( diag[0][0] - a, fabs(b) ); - - /* - Recall that diag[0][0] is an eigenvalue of the scaled version - of symmat - - +- -+ - | a b | - | |. - | b c | - +- -+ - - diag[0][0] is the positive-discriminant root of this matrix's - characteristic equation. eigvec's y-component - - diag[0][0] - a - - is positive and of magnitude at least as large as that of B, - since it is the larger of - ______________________ - / 2 - c - a / ( a - c ) 2 - diag[0][0] - a = ----- + \ / ---------- + b - 2 \/ 4 - - and - ______________________ - / 2 - a - c / ( a - c ) 2 - diag[0][0] - c = ----- + \ / ---------- + b - 2 \/ 4 - - Equality between these expressions can occur only when a is - equal to c, in which case both expressions are equal (except - for round-off error) to |b|. - - So the argument of eigvec is in the interval [pi/4, 3*pi/4]. - The second eigenvector is eigvec, and the first - eigenvector is found by rotating eigvec by -pi/2. Since - diag[0][0] is the eigenvalue for the SECOND eigenvector, we - must swap the eigenvalues. - */ - - /* - Unitize the eigenvector. - */ - vhatg_c ( eigvec, 2, eigvec ); - - rotate[0][0] = eigvec[1]; - rotate[1][0] = -eigvec[0]; - rotate[0][1] = eigvec[0]; - rotate[1][1] = eigvec[1]; - - swapd_ ( &(diag[0][0]), &(diag[1][1]) ); - - } - - else - { - - eigvec[0] = MaxVal ( diag[0][0] - c, fabs(b) ); - eigvec[1] = b; - - /* - The x-component of eigvec is positive and has magnitude - greater than or equal to that of the y-component of eigvec. - The argument of eigvec is in [-pi/4, pi/4], and the second - eigenvector is found by rotating eigvec by pi/2. - */ - - /* - Unitize the eigenvector. - */ - vhatg_c ( eigvec, 2, eigvec ); - - rotate[0][0] = eigvec[0]; - rotate[1][0] = eigvec[1]; - rotate[0][1] = -eigvec[1]; - rotate[1][1] = eigvec[0]; - } - - /* - We must scale the eigenvalues. - */ - diag[0][0] *= scale; - diag[1][1] *= scale; - - -} /* End diags2_c */ - diff --git a/ext/spice/src/cspice/diff_c.c b/ext/spice/src/cspice/diff_c.c deleted file mode 100644 index 7187bf8a9d..0000000000 --- a/ext/spice/src/cspice/diff_c.c +++ /dev/null @@ -1,358 +0,0 @@ -/* - --Procedure diff_c ( Difference of two sets ) - --Abstract - - Take the difference of two sets of any data type to form a third - set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void diff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I First input set. - b I Second input set. - c O Difference of a and b. - --Detailed_Input - - a is a CSPICE set. a must be declared as a SpiceCell - of data type character, double precision, or integer. - - b is a CSPICE set, distinct from a. b must have the - same data type as a. - --Detailed_Output - - c is a CSPICE set, distinct from sets a and b, which - contains the difference of a and b (that is, all of - the elements which are in a but NOT in b). c must - have the same data type as a and b. - - When comparing elements of character sets, this routine - ignores trailing blanks. Trailing blanks will be - trimmed from the members of the output set c. - --Parameters - - None. - --Exceptions - - 1) If the input set arguments don't have identical data types, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the difference of the two sets contains more elements than can - be contained in the output set, the error SPICE(SETEXCESS) is - signaled. - - 3) If the set arguments have character type and the length of the - elements of the output set is less than the maximum of the - lengths of the elements of the input sets, the error - SPICE(ELEMENTSTOOSHORT) is signaled. - - 4) If either of the input arguments may be unordered or contain - duplicates, the error SPICE(NOTASET) is signaled. - --Files - - None. - --Particulars - - This is a generic CSPICE set routine; it operates on sets of any - supported data type. - - The difference of two sets contains every element which is - in the first set, but NOT in the second. - - {a,b} difference {c,d} = {a,b} - {a,b,c} {b,c,d} {a} - {a,b,c,d} {} {a,b,c,d} - {} {a,b,c,d} {} - {} {} {} - - --Examples - - 1) The following code fragment places the difference of the - character sets planets and asteroids into the character set - result. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( asteroids, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( result, MAXSIZ, NAMLEN ); - . - . - . - /. - Compute the difference. - ./ - diff_c ( &planets, &asteroids, &result ); - - - 2) Repeat example #1, this time using integer sets containing - ID codes of the bodies of interest. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( planets, MAXSIZ ); - SPICEINT_CELL ( asteroids, MAXSIZ ); - SPICEINT_CELL ( result, MAXSIZ ); - . - . - . - /. - Compute the difference. - ./ - diff_c ( &planets, &asteroids, &result ); - --Restrictions - - 1) The output set must be distinct from both of the input sets. - For example, the following calls are invalid. - - diff_c ( ¤t, &new, ¤t ); - diff_c ( &new, ¤t, ¤t ); - - In each of the examples above, whether or not the subroutine - signals an error, the results will almost certainly be wrong. - Nearly the same effect can be achieved, however, by placing the - result into a temporary set, which is immediately copied back - into one of the input sets, as shown below. - - diff_c ( ¤t, &new, &temp ); - copy_c ( &temp, &new ); - - - 2) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input sets 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) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 15-FEB-2005 (NJB) - - Bug fix: loop bound changed from 2 to 3 in loop used - to free dynamically allocated arrays. - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - difference of two sets - --& -*/ - - -{ /* Begin diff_c */ - - - /* - Local variables - */ - SpiceChar * fCell[3]; - - SpiceInt fLen [3]; - SpiceInt i; - - - /* - Standard SPICE error handling. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "diff_c" ); - - /* - Make sure data types match. - */ - CELLMATCH3 ( CHK_STANDARD, "diff_c", a, b, c ); - - /* - Make sure the input cells are sets. - */ - CELLISSETCHK2 ( CHK_STANDARD, "diff_c", a, b ); - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - /* - Call the difference routine appropriate for the data type of the - cells. - */ - if ( a->dtype == SPICE_CHR ) - { - - /* - Construct Fortran-style sets suitable for passing to diffc_. - */ - C2F_MAP_CELL3 ( "", - a, fCell, fLen, - b, fCell+1, fLen+1, - c, fCell+2, fLen+2 ); - - - if ( failed_c() ) - { - chkout_c ( "diff_c" ); - return; - } - - - diffc_ ( (char * ) fCell[0], - (char * ) fCell[1], - (char * ) fCell[2], - (ftnlen ) fLen[0], - (ftnlen ) fLen[1], - (ftnlen ) fLen[2] ); - - - /* - Map the diff back to a C style cell. - */ - F2C_MAP_CELL ( fCell[2], fLen[2], c ); - - - /* - We're done with the dynamically allocated Fortran-style arrays. - */ - for ( i = 0; i < 3; i++ ) - { - free ( fCell[i] ); - } - - } - - else if ( a->dtype == SPICE_DP ) - { - diffd_ ( (doublereal * ) (a->base), - (doublereal * ) (b->base), - (doublereal * ) (c->base) ); - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - } - - else if ( a->dtype == SPICE_INT ) - { - diffi_ ( (integer * ) (a->base), - (integer * ) (b->base), - (integer * ) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - } - - else - { - setmsg_c ( "Cell a contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (a->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "diff_c" ); - return; - } - - - /* - Indicate the result is a set. - */ - c->isSet = SPICETRUE; - - - chkout_c ( "diff_c" ); - -} /* End diff_c */ diff --git a/ext/spice/src/cspice/diffc.c b/ext/spice/src/cspice/diffc.c deleted file mode 100644 index b009abb04c..0000000000 --- a/ext/spice/src/cspice/diffc.c +++ /dev/null @@ -1,310 +0,0 @@ -/* diffc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DIFFC ( Difference of two character sets ) */ -/* Subroutine */ int diffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen - b_len, ftnlen c_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer over, acard; - extern integer cardc_(char *, ftnlen); - integer bcard, ccard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - integer csize; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - integer apoint, bpoint; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), excess_(integer *, char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Take the difference of two character sets to form a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Difference of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the difference of A and B (that is, */ -/* all of the elements which are in A, but NOT */ -/* in B). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the difference of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is returned. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The DIFFERENCE of two sets contains every element which is */ -/* in the first set, but NOT in the second. */ - -/* {a,b} difference {c,d} = {a,b} */ -/* {a,b,c} {b,c,d} {a} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL DIFFC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the difference of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL DIFFI ( CURRENT, NEW, CURRENT ) */ -/* CALL DIFFI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL DIFFI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the difference of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* 2) If length of the elements of the output set is less than */ -/* the length of the elements of the FIRST input set, the */ -/* error SPICE(ELEMENTSTOOSHORT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* difference of two character sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 21-DEC-1988 (NJB) */ - -/* Error signalled if output set elements are not long enough. */ -/* Length must be at least max of lengths of input elements. */ -/* Also, calling protocol for EXCESS has been changed. Call to */ -/* SETMSG removed. */ - -/* Also, in the overflow case, the number of excess elements was */ -/* computed incorrectly; this has been fixed. The problem was */ -/* that OVER was incremented in all cases of the overflow IF */ -/* block, rather than only in the cases where the cardinality of */ -/* the output cell would have been incremented if there were */ -/* enough room. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("DIFFC", (ftnlen)5); - -/* Make sure output set elements are long enough. */ - - if (i_len(c__, c_len) < i_len(a, a_len)) { - setmsg_("Length of output cell is #. Length required to contain res" - "ult is #.", (ftnlen)68); - i__1 = i_len(c__, c_len); - errint_("#", &i__1, (ftnlen)1); -/* Computing MAX */ - i__2 = i_len(a, a_len), i__3 = i_len(b, b_len); - i__1 = max(i__2,i__3); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(ELEMENTSTOOSHORT)", (ftnlen)23); - chkout_("DIFFC", (ftnlen)5); - return 0; - } - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardc_(a, a_len); - bcard = cardc_(b, b_len); - csize = sizec_(c__, c_len); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of the first input set is reached, we're done. */ - - while(apoint <= acard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (bpoint > bcard) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - } else if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len) == 0) { - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - } else if (l_lt(b + (bpoint + 5) * b_len, a + (apoint + 5) * - a_len, b_len, a_len)) { - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (bpoint > bcard) { - ++over; - ++apoint; - } else if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len) == 0) { - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++over; - ++apoint; - } else if (l_lt(b + (bpoint + 5) * b_len, a + (apoint + 5) * - a_len, b_len, a_len)) { - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardc_(&ccard, c__, c_len); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("DIFFC", (ftnlen)5); - return 0; -} /* diffc_ */ - diff --git a/ext/spice/src/cspice/diffd.c b/ext/spice/src/cspice/diffd.c deleted file mode 100644 index 5533391f9d..0000000000 --- a/ext/spice/src/cspice/diffd.c +++ /dev/null @@ -1,268 +0,0 @@ -/* diffd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DIFFD ( Difference of two double precision sets ) */ -/* Subroutine */ int diffd_(doublereal *a, doublereal *b, doublereal *c__) -{ - integer over, acard, bcard; - extern integer cardd_(doublereal *); - integer ccard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Take the difference of two double precision sets to form */ -/* a third set. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Difference of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the difference of A and B (that is, */ -/* all of the elements which are in A, but NOT */ -/* in B). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the difference of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is returned. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The DIFFERENCE of two sets contains every element which is */ -/* in the first set, but NOT in the second. */ - -/* {a,b} difference {c,d} = {a,b} */ -/* {a,b,c} {b,c,d} {a} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL DIFFC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the difference of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL DIFFI ( CURRENT, NEW, CURRENT ) */ -/* CALL DIFFI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL DIFFI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the difference of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* difference of two d.p. sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* Also, in the overflow case, the number of excess elements was */ -/* computed incorrectly; this has been fixed. The problem was */ -/* that OVER was incremented in all cases of the overflow IF */ -/* block, rather than only in the cases where the cardinality of */ -/* the output cell would have been incremented if there were */ -/* enough room. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("DIFFD", (ftnlen)5); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of the first input set is reached, we're done. */ - - while(apoint <= acard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (bpoint > bcard) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (bpoint > bcard) { - ++over; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++over; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardd_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("DIFFD", (ftnlen)5); - return 0; -} /* diffd_ */ - diff --git a/ext/spice/src/cspice/diffi.c b/ext/spice/src/cspice/diffi.c deleted file mode 100644 index 1373c69af7..0000000000 --- a/ext/spice/src/cspice/diffi.c +++ /dev/null @@ -1,267 +0,0 @@ -/* diffi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DIFFI ( Difference of two integer sets ) */ -/* Subroutine */ int diffi_(integer *a, integer *b, integer *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Take the difference of two integer sets to form a third set. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Difference of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the difference of A and B (that is, */ -/* all of the elements which are in A, but NOT */ -/* in B). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the difference of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is returned. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The DIFFERENCE of two sets contains every element which is */ -/* in the first set, but NOT in the second. */ - -/* {a,b} difference {c,d} = {a,b} */ -/* {a,b,c} {b,c,d} {a} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL DIFFC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the difference of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL DIFFI ( CURRENT, NEW, CURRENT ) */ -/* CALL DIFFI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL DIFFI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the difference of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* difference of two integer sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* Also, in the overflow case, the number of excess elements was */ -/* computed incorrectly; this has been fixed. The problem was */ -/* that OVER was incremented in all cases of the overflow IF */ -/* block, rather than only in the cases where the cardinality of */ -/* the output cell would have been incremented if there were */ -/* enough room. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("DIFFI", (ftnlen)5); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardi_(a); - bcard = cardi_(b); - csize = sizei_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of the first input set is reached, we're done. */ - - while(apoint <= acard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (bpoint > bcard) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - -/* Otherwise, stop folling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (bpoint > bcard) { - ++over; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++over; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardi_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("DIFFI", (ftnlen)5); - return 0; -} /* diffi_ */ - diff --git a/ext/spice/src/cspice/dlatdr.c b/ext/spice/src/cspice/dlatdr.c deleted file mode 100644 index 44a8111a18..0000000000 --- a/ext/spice/src/cspice/dlatdr.c +++ /dev/null @@ -1,253 +0,0 @@ -/* dlatdr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DLATDR ( Derivative of latitudinal w.r.t. rectangular ) */ -/* Subroutine */ int dlatdr_(doublereal *x, doublereal *y, doublereal *z__, - doublereal *jacobi) -{ - doublereal long__, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), vpack_(doublereal *, - doublereal *, doublereal *, doublereal *); - doublereal injacb[9] /* was [3][3] */; - extern /* Subroutine */ int reclat_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal rectan[3]; - extern /* Subroutine */ int drdlat_(doublereal *, doublereal *, - doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invort_(doublereal *, doublereal *); - doublereal lat; - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* rectangular to latitudinal coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* X I X-coordinate of point. */ -/* Y I Y-coordinate of point. */ -/* Z I Z-coordinate of point. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* X, */ -/* Y, */ -/* Z are the rectangular coordinates of the point at */ -/* which the Jacobian of the map from rectangular */ -/* to latitudinal coordinates is desired. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between rectangular and latitudinal coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | dr/dx dr/dy dr/dz | */ -/* | dlong/dx dlong/dy dlong/dz | */ -/* | dlat/dx dlat/dy dlat/dz | */ -/* `- -' */ - -/* evaluated at the input values of X, Y, and Z. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input point is on the z-axis ( X and Y = 0 ), the */ -/* Jacobian is undefined. The error SPICE(POINTONZAXIS) */ -/* will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* When performing vector calculations with velocities it is */ -/* usually most convenient to work in rectangular coordinates. */ -/* However, once the vector manipulations have been performed */ -/* it is often desirable to convert the rectangular representations */ -/* into latitudinal coordinates to gain insights about phenomena */ -/* in this coordinate frame. */ - -/* To transform rectangular velocities to derivatives of coordinates */ -/* in a latitudinal system, one uses the Jacobian of the */ -/* transformation between the two systems. */ - -/* Given a state in rectangular coordinates */ - -/* ( x, y, z, dx, dy, dz ) */ - -/* the corresponding latitudinal coordinate derivatives are given by */ -/* the matrix equation: */ - -/* t | t */ -/* (dr, dlong, dlat) = JACOBI| * (dx, dy, dz) */ -/* |(x,y,z) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(x, y, z) */ - -/* $ Examples */ - -/* Suppose one is given the bodyfixed rectangular state of an object */ -/* ( x(t), y(t), z(t), dx(t), dy(t), dz(t) ) as a function of time t. */ - -/* To find the derivatives of the coordinates of the object in */ -/* bodyfixed latitudinal coordinates, one simply multiplies the */ -/* Jacobian of the transformation from rectangular to latitudinal */ -/* (evaluated at x(t), y(t), z(t) ) by the rectangular velocity */ -/* vector of the object at time t. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the rectangular velocity vector vector RECV. */ -/* C */ -/* RECV(1) = DX_DT ( T ) */ -/* RECV(3) = DY_DT ( T ) */ -/* RECV(2) = DZ_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C rectangular to latitudinal at the rectangular */ -/* C coordinates at time T. */ -/* C */ -/* CALL DLATDR ( X(T), Y(T), Z(T), JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the right by the rectangular */ -/* C velocity to obtain the latitudinal coordinate */ -/* C derivatives LATV. */ -/* C */ -/* CALL MXV ( JACOBI, RECV, LATV ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-JUL-2001 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of latitudinal w.r.t. rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DLATDR", (ftnlen)6); - } - -/* There is a singularity of the Jacobian for points on the z-axis. */ - - if (*x == 0. && *y == 0.) { - setmsg_("The Jacobian of the transformation from rectangular to lati" - "tudinal coordinates is not defined for points on the z-axis.", - (ftnlen)119); - sigerr_("SPICE(POINTONZAXIS)", (ftnlen)19); - chkout_("DLATDR", (ftnlen)6); - return 0; - } - -/* We will get the Jacobian of the transformation from rectangular */ -/* to latitudinal coordinates by implicit differentiation. */ - -/* First move the X,Y and Z coordinates into a vector. */ - - vpack_(x, y, z__, rectan); - -/* Convert from rectangular to latitudinal coordinates. */ - - reclat_(rectan, &r__, &long__, &lat); - -/* Get the Jacobian of the transformation from latitudinal to */ -/* rectangular coordinates at R, LONG, LAT. */ - - drdlat_(&r__, &long__, &lat, injacb); - -/* Now invert INJACB to get the Jacobian of the transformation from */ -/* rectangular to latitudinal coordinates. */ - - invort_(injacb, jacobi); - chkout_("DLATDR", (ftnlen)6); - return 0; -} /* dlatdr_ */ - diff --git a/ext/spice/src/cspice/dlatdr_c.c b/ext/spice/src/cspice/dlatdr_c.c deleted file mode 100644 index 556397b407..0000000000 --- a/ext/spice/src/cspice/dlatdr_c.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - --Procedure dlatdr_c ( Derivative of latitudinal w.r.t. rectangular ) - --Abstract - - This routine computes the Jacobian of the transformation from - rectangular to latitudinal coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dlatdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - x I X-coordinate of point. - y I Y-coordinate of point. - z I Z-coordinate of point. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - x, - y, - z are the rectangular coordinates of the point at - which the Jacobian of the map from rectangular - to latitudinal coordinates is desired. - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between rectangular and latitudinal coordinates. It - has the form - - .- -. - | dr/dx dr/dy dr/dz | - | dlon/dx dlon/dy dlon/dz | - | dlat/dx dlat/dy dlat/dz | - `- -' - - evaluated at the input values of x, y, and z. - --Parameters - - None. - --Exceptions - - 1) If the input point is on the z-axis (x and y = 0), the - Jacobian is undefined. The error SPICE(POINTONZAXIS) - will be signaled. - --Files - - None. - --Particulars - - When performing vector calculations with velocities it is - usually most convenient to work in rectangular coordinates. - However, once the vector manipulations have been performed - it is often desirable to convert the rectangular representations - into latitudinal coordinates to gain insights about phenomena - in this coordinate frame. - - To transform rectangular velocities to derivatives of coordinates - in a latitudinal system, one uses the Jacobian of the - transformation between the two systems. - - Given a state in rectangular coordinates - - ( x, y, z, dx, dy, dz ) - - the corresponding latitudinal coordinate derivatives are given by - the matrix equation: - - t | t - (dr, dlon, dlat) = jacobi | * (dx, dy, dz) - |(x,y,z) - - This routine computes the matrix - - | - jacobi| - |(x, y, z) - --Examples - - Suppose one is given the bodyfixed rectangular state of an object - ( x(t), y(t), z(t), dx(t), dy(t), dz(t) ) as a function of time t. - - To find the derivatives of the coordinates of the object in - bodyfixed latitudinal coordinates, one simply multiplies the - Jacobian of the transformation from rectangular to latitudinal - coordinates (evaluated at x(t), y(t), z(t) ) by the rectangular - velocity vector of the object at time t. - - In code this looks like: - - #include "SpiceUsr.h" - . - . - . - - /. - Load the rectangular velocity vector vector recv. - ./ - recv[0] = dx ( t ); - recv[1] = dy ( t ); - recv[2] = dz ( t ); - - /. - Determine the Jacobian of the transformation from rectangular to - latitudinal coordinates at the rectangular coordinates at time t. - ./ - dlatdr_c ( x(t), y(t), z(t), jacobi ); - - /. - Multiply the Jacobian on the right by the rectangular - velocity to obtain the latitudinal coordinate derivatives - latv. - ./ - mxv_c ( jacobi, recv, latv ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 13-JUL-2001 (WLT) (NJB) - --Index_Entries - - Jacobian of rectangular w.r.t. latitudinal coordinates - --& -*/ - -{ /* Begin dlatdr_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "dlatdr_c" ); - - - dlatdr_ ( (doublereal *) &x, - (doublereal *) &y, - (doublereal *) &z, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "dlatdr_c" ); - -} /* End dlatdr_c */ diff --git a/ext/spice/src/cspice/dnearp.c b/ext/spice/src/cspice/dnearp.c deleted file mode 100644 index 1b86fe4c6b..0000000000 --- a/ext/spice/src/cspice/dnearp.c +++ /dev/null @@ -1,528 +0,0 @@ -/* dnearp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b16 = 1.; - -/* $Procedure DNEARP ( Derivative of near point ) */ -/* Subroutine */ int dnearp_(doublereal *state, doublereal *a, doublereal *b, - doublereal *c__, doublereal *dnear, doublereal *dalt, logical *found) -{ - /* Initialized data */ - - static doublereal gradm[9] /* was [3][3] */ = { 1.,0.,0.,0.,1.,0.,0.,0., - 1. }; - static doublereal m[9] /* was [3][3] */ = { 1.,0.,0.,0.,1.,0.,0.,0., - 1. }; - - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal grad[3], temp[3]; - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vtmv_(doublereal *, doublereal *, doublereal *); - integer i__; - doublereal l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom, dterm[3]; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - doublereal norml[3]; - extern /* Subroutine */ int unorm_(doublereal *, doublereal *, doublereal - *); - extern logical failed_(void); - doublereal length, lprime; - extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), chkout_( - char *, ftnlen); - doublereal zenith[3]; - extern logical return_(void); - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Compute the ellipsoid surface point nearest to a specified */ -/* position; also compute the velocity of this point. */ - -/* $ 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 */ - -/* ELLIPSOID, GEOMETRY, DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STATE I State of an object in body-fixed coordinates. */ -/* A I Length of semi-axis parallel to x-axis. */ -/* B I Length of semi-axis parallel to y-axis. */ -/* C I Length on semi-axis parallel to z-axis. */ -/* DNEAR O State of the nearest point on the ellipsoid. */ -/* DALT O Altitude and derivative of altitude. */ -/* FOUND O Tells whether DNEAR is degenerate. */ - -/* $ Detailed_Input */ - -/* STATE is a 6-vector giving the position and velocity of */ -/* some object in the body-fixed coordinates of the */ -/* ellipsoid. */ - -/* In body-fixed coordinates, the semi-axes of the */ -/* ellipsoid are aligned with the x, y, and z-axes of the */ -/* coordinate system. */ - -/* A is the length of the semi-axis of the ellipsoid */ -/* that is parallel to the x-axis of the body-fixed */ -/* coordinate system. */ - -/* B is the length of the semi-axis of the ellipsoid */ -/* that is parallel to the y-axis of the body-fixed */ -/* coordinate system. */ - -/* C is the length of the semi-axis of the ellipsoid */ -/* that is parallel to the z-axis of the body-fixed */ -/* coordinate system. */ - -/* $ Detailed_Output */ - - -/* DNEAR is the 6-vector giving the position and velocity */ -/* in body-fixed coordinates of the point on the */ -/* ellipsoid, closest to the object whose position */ -/* and velocity are represented by STATE. */ - -/* While the position component of DNEAR is always */ -/* meaningful, the velocity component of DNEAR will be */ -/* meaningless if FOUND if .FALSE. (See the discussion */ -/* of the meaning of FOUND below.) */ - - -/* DALT is an array of two double precision numbers. The */ -/* first gives the altitude of STATE with respect to */ -/* the ellipsoid. The second gives the rate of */ -/* change of the altitude. */ - -/* Note that the rate of change of altitude is meaningful */ -/* if and only if FOUND is .TRUE. (See the discussion of */ -/* the meaning of FOUND below.) */ - -/* FOUND is a logical flag indicating whether or not the */ -/* velocity portion of DNEAR is meaningful. */ -/* If the velocity portion of DNEAR is meaningful */ -/* FOUND will be returned with a value of .TRUE. */ -/* Under very rare circumstance the velocity of the */ -/* near point is undefined. Under these circumstances */ -/* FOUND will be returned with the value .FALSE. */ - -/* FOUND can be .FALSE. only for states whose position */ -/* components are inside the ellipsoid and then only at */ -/* points on a special surface contained inside the */ -/* ellipsoid called the focal set of the ellipsoid. */ - -/* A point in the interior is on this special surface */ -/* only if there are two or more points on the ellipsoid */ -/* that are closest to it. The origin is such a point */ -/* and the only such point if the ellipsoid is a */ -/* sphere. For non-spheroidal ellipsoids the focal */ -/* set contains small portions of the planes of */ -/* symmetry of the ellipsoid. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) If the axes are non-positive, a routine in the call tree */ -/* of this routine will diagnose the error. */ - -/* 2) If an object is passing through the interior of an ellipsoid */ -/* there are points at which there is more than 1 point on */ -/* the ellipsoid that is closest to the object. At these */ -/* points the velocity of the near point is undefined. (See */ -/* the description of the output variable FOUND). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If an object is moving relative to some triaxial body along */ -/* a trajectory C(t) then there is a companion trajectory N(t) */ -/* that gives the point on the ellipsoid that is closest to */ -/* C(t) as a function of t. The instantaneous position and */ -/* velocity of C(t) (STATE) are sufficient to compute the */ -/* instantaneous position and velocity of N(t) (DNEAR). */ - -/* This routine computes DNEAR from STATE. In addition it returns */ -/* the altitude and rate of change of altitude. */ - -/* Note that this routine can compute DNEAR for STATES outside, */ -/* on, or inside the ellipsoid. However, the velocity of DNEAR */ -/* and derivative of altitude do not exist for a "small" set */ -/* of STATES in the interior of the ellipsoid. See the */ -/* discussion of FOUND above for a description of this set of */ -/* points. */ - -/* $ Examples */ - -/* Example 1. Speed of a ground track. */ -/* ======================================= */ - -/* Suppose you wish to compute the velocity of the ground track */ -/* of a satellite as it passes over a location on the earth */ -/* and that the moment of passage (ET) has been previously */ -/* determined. (We assume that the spacecraft is close enough */ -/* to the surface that light time corrections do not matter.) */ - -/* We let */ - -/* BODY be the idcode for the body */ -/* FRAME be the string representing the body's body-fixed frame */ -/* SCID be the idcode of the spacecraft */ - -/* First get the axes of the body. */ - -/* CALL BODVCD ( BODY, 'RADII', 3, DIM, ABC ) */ - -/* A = ABC(1) */ -/* B = ABC(2) */ -/* C = ABC(3) */ - -/* CALL SPKEZ ( SCID, ET, FRAME, 'NONE', BODY, STATE, LT ) */ -/* CALL DNEARP ( STATE, A, B, C, DNEAR, DALT ) */ - -/* DNEAR contains the state of the subspacecraft point. */ - - -/* Example 2. Doppler shift of an altimeter. */ -/* ========================================= */ - -/* Suppose you wish to compute the one-way doppler shift of a radar */ -/* altimeter mounted on board a spacecraft as it passes */ -/* over some region. Moreover, assume that for your */ -/* purposes it is sufficient to neglect effects of atmosphere, */ -/* topography and antenna pattern for the sake of this */ -/* computation. We use the same notation as in the previous example. */ - -/* First get the axes of the body. */ - -/* CALL BODVCD ( BODY, 'RADII', 3, DIM, ABC ) */ - -/* A = ABC(1) */ -/* B = ABC(2) */ -/* C = ABC(3) */ - -/* CALL SPKEZ ( SCID, ET, FRAME, 'NONE', BODY, STATE, LT ) */ -/* CALL DNEARP ( STATE, A, B, C, DNEAR, DALT ) */ - - -/* The change in frequency is given by multiplying SHIFT times the */ -/* carrier frequency */ - -/* SHIFT = ( DALT(2) / CLIGHT() ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 26-JUN-2008 (NJB) */ - -/* Corrected spelling error in abstract; re-wrote */ -/* abstract text. */ - -/* - SPICELIB Version 1.1.1, 24-OCT-2005 (NJB) */ - -/* Header update: changed references to BODVAR to references */ -/* to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 05-MAR-1998 (WLT) */ - -/* In the previous version of the routine FOUND could be */ -/* returned without being set to TRUE when the velocity */ -/* of the near point and rate of change of altitude */ -/* could be determined. This error has been corrected. */ - -/* - SPICELIB Version 1.0.0, 15-JUN-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Velocity of the nearest point on an ellipsoid */ -/* Rate of change of the altitude over an ellipsoid */ -/* Derivative of altitude over an ellipoid */ -/* Velocity of a ground track */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial Values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("DNEARP", (ftnlen)6); - -/* Until we have reason to believe otherwise, we set FOUND to TRUE. */ - - *found = TRUE_; - -/* First we need to compute the near point. */ - - nearpt_(state, a, b, c__, dnear, dalt); - -/* Make sure nothing went bump in the dark innards of NEARPT. */ - - if (failed_()) { - *found = FALSE_; - chkout_("DNEARP", (ftnlen)6); - return 0; - } - -/* Now for the work of this routine. We need to compute the */ -/* velocity component of DNEAR. */ - -/* In all of the discussions below we let <,> stand for the */ -/* dot product. */ - -/* Let P be the position (first three components) of STATE */ -/* and let N be the position (first three components) of DNEAR. */ - -/* The surface of the ellipsoid is described as the level set */ -/* f(x,y,z) = 1 for the function f defined by */ - -/* f(x,y,z) = x**2/a**2 + y**2/b**2 + z**2/c**2 */ - -/* Let GRAD be the "half" gradiant of f. Then for some L */ - - -/* N + L * GRAD = P ( 1 ) */ - - -/* So that */ -/* < P - N, GRAD > */ -/* L = -------------- */ -/* < GRAD , GRAD > */ - -/* GRAD */ -/* = < P - N, ------ > / | GRAD | */ -/* |GRAD| */ - -/* Since GRAD is computed at a point on the level set f(x,y,z) = 1 */ -/* we don't have to worry about the magnitude of |GRAD| being */ -/* so small that underflow can occur. */ - -/* Note that the half gradiant of f can be computed by simple */ -/* vector multiplication */ - -/* [ 1/A**2 0 0 ] [ x ] */ -/* GRAD(x,y,z) = | 0 1/B**2 0 | | y | */ -/* [ 0 0 1/C**2 ] [ z ] */ - -/* We call the matrix above GRADM. The correct off */ -/* diagonal values have been established in the data statement */ -/* following the declaration section of this routine. */ - - gradm[0] = 1. / (*a * *a); - gradm[4] = 1. / (*b * *b); - gradm[8] = 1. / (*c__ * *c__); - vsub_(state, dnear, zenith); - mxv_(gradm, dnear, grad); - unorm_(grad, norml, &length); - l = vdot_(zenith, norml) / length; - -/* We can rewrite equation (1) as */ - -/* P = N + L * GRADM * N */ - -/* from this it follows that */ - -/* P' = N' + L' * GRADM * N */ -/* + L * GRADM * N' */ - -/* = ( IDENT + L*GRADM ) * N' + L' * GRADM * N */ - -/* = ( IDENT + L*GRADM ) * N' + L' * GRAD */ - -/* where IDENT is the 3x3 identity matrix. */ - -/* Let M be the inverse of the matrix IDENT + L*GRADM. (Provided */ -/* of course that all of the diagonal entries are non-zero). */ - -/* If we multiply both sides of the equation above by M */ -/* we have */ - - -/* M*P' = N' + L'* M * GRAD ( 2 ) */ - - -/* Recall now that N' is orthogonal to GRAD (N' lies in the */ -/* tangent plane to the ellipsoid at N and GRAD is normal */ -/* to this tangent plane). Thus */ - -/* < GRAD, M*P' > = L' < GRAD, M * GRAD > */ - -/* and */ - -/* < GRAD, M*P' > */ -/* L' = ----------------- */ -/* < GRAD, M*GRAD > */ - - -/* = VTMV ( GRAD, M, P' ) / VTMV ( GRAD, M, GRAD ) */ - -/* Let's pause now to compute M and L'. */ - -/* This is where things could go bad. M might not exist (which */ -/* indicates STATE is on the focal set of the ellipsoid). In */ -/* addition it is conceivable that VTMV ( GRAD, M, GRAD ) is */ -/* zero. This turns out not to be possible. However, the */ -/* demonstration of this fact requires delving into the details */ -/* of how N was computed by NEARPT. Rather than spending a */ -/* lot of time explaining the details we will make an */ -/* unnecessary but inexpensive check that we don't divide by */ -/* zero when computing L'. */ - - for (i__ = 1; i__ <= 3; ++i__) { - dterm[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("dterm", i__1, - "dnearp_", (ftnlen)458)] = l * gradm[(i__2 = i__ + i__ * 3 - - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("gradm", i__2, "dnearp_", - (ftnlen)458)] + 1.; - } - for (i__ = 1; i__ <= 3; ++i__) { - if (dterm[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("dterm", - i__1, "dnearp_", (ftnlen)463)] != 0.) { - m[(i__1 = i__ + i__ * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "m", i__1, "dnearp_", (ftnlen)464)] = 1. / dterm[(i__2 = - i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("dterm", i__2, - "dnearp_", (ftnlen)464)]; - } else { - *found = FALSE_; - chkout_("DNEARP", (ftnlen)6); - return 0; - } - } - denom = vtmv_(grad, m, grad); - if (denom == 0.) { - *found = FALSE_; - chkout_("DNEARP", (ftnlen)6); - return 0; - } - lprime = vtmv_(grad, m, &state[3]) / denom; - -/* Now that we have L' we can easily compute N'. Rewriting */ -/* equation (2) from above we have. */ - -/* N' = M * ( P' - L'*GRAD ) */ - - d__1 = -lprime; - vlcom_(&c_b16, &state[3], &d__1, grad, temp); - mxv_(m, temp, &dnear[3]); - -/* Only one thing left to do. Compute the derivative */ -/* of the altitude ALT. Recall that */ - -/* GRAD */ -/* ALT = < P - N, ------ > */ -/* |GRAD| */ - -/* GRAD */ -/* dALT/dt = < P' - N', ------ > */ -/* |GRAD| */ - -/* GRAD */ -/* + < P - N, Deriv of{------} > */ -/* |GRAD| */ - -/* The second term is zero. To see this note that P - N is parallel */ -/* to GRAD. Moreover, since GRAD/|GRAD| is a unit vector its */ -/* derivative is necessarily orthogonal to it. Hence it is */ -/* orthogonal to GRAD and P-N. */ - -/* Thus */ -/* GRAD */ -/* dALT/dt = < P' - N', ------ > */ -/* |GRAD| */ - -/* But as we discussed earlier N' is orthogonal to GRAD. Thus */ - -/* GRAD */ -/* dALT/dt = < P' , ------ > */ -/* |GRAD| */ - -/* We've already computed GRAD/|GRAD| (NORML). Hence */ - -/* dALT/dt = < P', NORML > */ - - dalt[1] = vdot_(&state[3], norml); - chkout_("DNEARP", (ftnlen)6); - return 0; -} /* dnearp_ */ - diff --git a/ext/spice/src/cspice/dolio.c b/ext/spice/src/cspice/dolio.c deleted file mode 100644 index 4b5a2ca658..0000000000 --- a/ext/spice/src/cspice/dolio.c +++ /dev/null @@ -1,20 +0,0 @@ -#include "f2c.h" - -#ifdef __cplusplus -extern "C" { -#endif -#ifdef KR_headers -extern int (*f__lioproc)(); - -integer do_lio(type,number,ptr,len) ftnint *number,*type; char *ptr; ftnlen len; -#else -extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); - -integer do_lio(ftnint *type, ftnint *number, char *ptr, ftnlen len) -#endif -{ - return((*f__lioproc)(number,ptr,len,*type)); -} -#ifdef __cplusplus - } -#endif diff --git a/ext/spice/src/cspice/dp2hx.c b/ext/spice/src/cspice/dp2hx.c deleted file mode 100644 index 19ba07d17a..0000000000 --- a/ext/spice/src/cspice/dp2hx.c +++ /dev/null @@ -1,568 +0,0 @@ -/* dp2hx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure DP2HX ( D.p. number to hexadecimal string ) */ -/* Subroutine */ int dp2hx_(doublereal *number, char *string, integer *length, - ftnlen string_len) -{ - /* Initialized data */ - - static char digits[1*16] = "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" - "B" "C" "D" "E" "F"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int int2hx_(integer *, char *, integer *, ftnlen); - doublereal remndr; - integer explen; - logical negtiv; - integer intexp, positn, result; - doublereal tmpnum; - logical postiv; - char expstr[255], tmpstr[255]; - -/* $ Abstract */ - -/* Convert a double precision number to an equivalent character */ -/* string using a base 16 ``scientific notation.'' */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I D.p. number to be converted. */ -/* STRING O Equivalent character string, left justified. */ -/* LENGTH O Length of the character string produced. */ - -/* $ Detailed_Input */ - -/* NUMBER The double precision number to be converted to a */ -/* character string representation. */ - -/* $ Detailed_Output */ - -/* STRING The character string produced by this routine which */ -/* represents NUMBER in a base 16 ``scientific notation,'' */ -/* e.g.: */ - -/* 672.0 = '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 */ - -/* and */ - -/* -11.0 = '-B^1' = - ( 11/16 ) * 16**1. */ - -/* The following table describes the character set used to */ -/* represent the hexadecimal digits and their corresponding */ -/* values. */ - -/* Character Value Character Value */ -/* --------- ------ --------- ------ */ -/* '0' 0.0D0 '8' 8.0D0 */ -/* '1' 1.0D0 '9' 9.0D0 */ -/* '2' 2.0D0 'A' 10.0D0 */ -/* '3' 3.0D0 'B' 11.0D0 */ -/* '4' 4.0D0 'C' 12.0D0 */ -/* '5' 5.0D0 'D' 13.0D0 */ -/* '6' 6.0D0 'E' 14.0D0 */ -/* '7' 7.0D0 'F' 15.0D0 */ - -/* The carat, or hat, character, '^', is used to */ -/* distinguish the exponent. */ - -/* The plus sign, '+', and the minus sign, '-', are used, */ -/* and they have their usual meanings. */ - -/* In order to obtain the entire character string produced */ -/* by this routine, the output character string should be */ -/* at least N characters long, where */ - - -/* # of bits per double precision mantissa + 3 */ -/* N = 3 + ---------------------------------------------- */ -/* 4 */ - -/* # of bits per double precision exponent + 3 */ -/* + ---------------------------------------------- . */ -/* 4 */ - -/* There should be one character position for the sign of */ -/* the mantissa, one for the sign of the exponent, one for */ -/* the exponentiation character, and one for each */ -/* hexadecimal digit that could be produced from a mantissa */ -/* and an exponent. */ - -/* The following table contains minimum output string */ -/* lengths necessary to obtain the complete character */ -/* string produced by this routine for some typical */ -/* implementations of double precision numbers. */ - -/* Double precision number */ -/* Size Mantissa Exponent Minimum output string length */ -/* bits bits bits */ -/* ---- -------- -------- ---------------------------- */ -/* 64 48 15 3 + 12 + 4 = 19 */ -/* 64 55+1 8 3 + 14 + 2 = 19 (VAX) */ -/* 64 52 11 3 + 13 + 3 = 19 (IEEE) */ - -/* The base 16 ``scientific notation'' character string */ -/* produced by this routine will be left justified and */ -/* consist of a contiguous sequence of characters with one */ -/* of following formats: */ - -/* (1) h h h h ... h ^H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (2) -h h h h ... h ^H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (3) h h h h ... h ^-H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (4) -h h h h ... h ^-H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* where */ - -/* h and H denote hexadecimal digits */ -/* i j */ - -/* '^' denotes exponentiation ( base 16 ) */ - -/* and */ - -/* '+' and '-' have their usual interpretations. */ - -/* The character string produced will be blank padded on */ -/* the right if LENGTH < LEN( STRING ). */ - -/* LENGTH Length of the base 16 ``scientific notation'' character */ -/* string produced by this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the output character string is not long enough to */ -/* contain the entire character string that was produced, */ -/* the string will be truncated on the right. */ - -/* 2) If LEN( STRING ) > LENGTH, the output character string will */ -/* be blank padded on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts a double precision number into an equivalent */ -/* character string using a base 16 ``scientific notation.'' This */ -/* representation allows the full precision of a number to be placed */ -/* in a format that is suitable for porting or archival storage. */ - -/* This routine is one of a pair of routines which are used to */ -/* perform conversions between double precision numbers and */ -/* an equivalent base 16 ``scientific notation'' character string */ -/* representation: */ - -/* DP2HX -- Convert a double precision number into a base 16 */ -/* ``scientific notation'' character string. */ - -/* HX2DP -- Convert a base 16 ``scientific notation'' */ -/* character string into a double precision number. */ - -/* $ Examples */ - -/* The following input and output argument values illustrate the */ -/* action of DP2HX for various input values of NUMBER. */ - -/* Note: The hat or carat, '^', signals an exponent. */ - -/* NUMBER STRING LENGTH */ -/* ----------------- ----------------------------- ------ */ -/* 2.0D-9 89705F4136B4A6^-7 17 */ -/* 1.0D0 1^1 3 */ -/* -1.0D0 -1^1 4 */ -/* 1024.0D0 4^3 3 */ -/* -1024.0D0 -4^3 4 */ -/* 521707.0D0 7F5EB^5 7 */ -/* 27.0D0 1B^2 4 */ -/* 0.0D0 0^0 3 */ - -/* $ Restrictions */ - -/* The maximum number of characters permitted in the output string */ -/* is specified by the local parameter STRLEN. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1994 (KRG) */ - -/* Fixed a typo in the description of the input argument STRING. */ -/* The example showing the expansion of 160 into hexadecimal */ -/* was incorrect. 160 was replaced with 672 which makes the */ -/* example correct. */ - -/* - SPICELIB Version 1.0.0, 26-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert d.p. to signed normalized hexadecimal string */ -/* convert d.p. number to encoded d.p. number */ -/* convert d.p. to base 16 scientific notation */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1994 (KRG) */ - -/* Fixed a typo in the description of the input argument STRING. */ -/* The example showing the expansion of 160 into hexadecimal */ -/* was incorrect. 160 was replaced with 672 which makes the */ -/* example correct. */ - -/* Old Example: */ - -/* 160.0 = '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 */ - -/* New Example: */ - -/* 672.0 = '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 */ - -/* -& */ - -/* Local Parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Make a copy of the input so that it will not be changed by this */ -/* routine. Also, assume that we do not know the sign of the number. */ - - tmpnum = *number; - negtiv = FALSE_; - postiv = FALSE_; - -/* Check to see what the sign of the number is, because we treat */ -/* negative numbers, positive numbers and zero separately. This */ -/* simplifies the testing in the loop boundaries a bit, and removes */ -/* calls to DABS() that would otherwise have been necessary. */ - -/* Set the appropriate logical flag for the sign of the input number. */ - - if (tmpnum < 0.) { - negtiv = TRUE_; - } else if (tmpnum > 0.) { - postiv = TRUE_; - } - -/* If nonzero, a double precision number is first normalized, */ -/* so that it has a value between 1.0D0/BASE and 1.0D0 or -1.0D0 */ -/* and -1/BASE. The hexadecimal digits in the mantissa are found */ -/* by repeated applications of multiplication and truncation */ -/* operations. The hexadecimal digits will be in the correct order */ -/* when finished. The string will be left justified, and its length */ -/* will be set before returning. */ - -/* Calculate the exponent of the number using multiple scaling */ -/* levels. The different scale factors, 16**8, 16**4, and 16, */ -/* provide a significant speed improvement for the normalization */ -/* process. */ - - intexp = 0; - if (negtiv) { - if (tmpnum > -1.) { - -/* ABS(TMPNUM) .LT. 1.0 */ - - while(tmpnum * 4294967296. > -1.) { - -/* Scale the number and decrement the exponent. */ - - tmpnum *= 4294967296.; - intexp += -8; - } - while(tmpnum * 65536. > -1.) { - -/* Scale the number and decrement the exponent. */ - - tmpnum *= 65536.; - intexp += -4; - } - while(tmpnum * 16. > -1.) { - -/* Scale the number and decrement the exponent. */ - - tmpnum *= 16.; - --intexp; - } - -/* At this point, -1 < TMPNUM <= -1/BASE. */ - - } else { - -/* ABS(TMPNUM) .GE. 1.0 */ - - while(tmpnum * 2.3283064365386963e-10 <= -1.) { - -/* Scale the number and increment the exponent. */ - - tmpnum *= 2.3283064365386963e-10; - intexp += 8; - } - while(tmpnum * 1.52587890625e-5 <= -1.) { - -/* Scale the number and increment the exponent. */ - - tmpnum *= 1.52587890625e-5; - intexp += 4; - } - while(tmpnum <= -1.) { - -/* Scale the number and increment the exponent. */ - - tmpnum *= .0625; - ++intexp; - } - -/* At this point, -1 < TMPNUM <= -1/BASE. */ - - } - } else if (postiv) { - if (tmpnum < 1.) { - -/* ABS(TMPNUM) .LT. 1.0 */ - - while(tmpnum * 4294967296. < 1.) { - -/* Scale the number and decrement the exponent. */ - - tmpnum *= 4294967296.; - intexp += -8; - } - while(tmpnum * 65536. < 1.) { - -/* Scale the number and decrement the exponent. */ - - tmpnum *= 65536.; - intexp += -4; - } - while(tmpnum * 16. < 1.) { - -/* Scale the number and decrement the exponent. */ - - tmpnum *= 16.; - --intexp; - } - -/* At this point, 1/BASE <= TMPNUM < 1 */ - - } else { - -/* ABS(TMPNUM) .GE. 1.0 */ - - while(tmpnum * 2.3283064365386963e-10 >= 1.) { - -/* Scale the number and increment the exponent. */ - - tmpnum *= 2.3283064365386963e-10; - intexp += 8; - } - while(tmpnum * 1.52587890625e-5 >= 1.) { - -/* Scale the number and increment the exponent. */ - - tmpnum *= 1.52587890625e-5; - intexp += 4; - } - while(tmpnum >= 1.) { - -/* Scale the number and increment the exponent. */ - - tmpnum *= .0625; - ++intexp; - } - -/* At this point, 1/BASE <= TMPNUM < 1 */ - - } - } - -/* We do different things for the cases where the number to be */ -/* converted is positive, negative, or zero. */ - - if (negtiv) { - -/* Set the beginning position. */ - - positn = 1; - -/* Put the minus sign in place. */ - - *(unsigned char *)&tmpstr[positn - 1] = '-'; - -/* Start with the remainder equal to the normalized value of the */ -/* original number. */ - - remndr = tmpnum; - -/* Collect all of the digits in the string. */ - -/* This stopping test works because the base is a power of */ -/* 2 and the mantissa is composed of a sum of powers of 2. */ - - while(remndr != 0.) { - -/* -1 < REMNDR <= -1/BASE */ - - ++positn; - tmpnum = remndr * 16.; - result = (integer) tmpnum; - remndr = tmpnum - (doublereal) result; - *(unsigned char *)&tmpstr[positn - 1] = *(unsigned char *)&digits[ - (i__1 = -result) < 16 && 0 <= i__1 ? i__1 : s_rnge("digi" - "ts", i__1, "dp2hx_", (ftnlen)554)]; - } - -/* Put the exponent on the end of the number and update the */ -/* position. */ - - int2hx_(&intexp, expstr, &explen, (ftnlen)255); - i__1 = positn; -/* Writing concatenation */ - i__2[0] = 1, a__1[0] = "^"; - i__2[1] = explen, a__1[1] = expstr; - s_cat(tmpstr + i__1, a__1, i__2, &c__2, 255 - i__1); - positn = positn + explen + 1; - } else if (postiv) { - -/* Set the beginning position. */ - - positn = 0; - -/* Start with the remainder equal to the normalized value of the */ -/* original number. */ - - remndr = tmpnum; - -/* Collect all of the digits in the string. */ - -/* This stopping test works because the base is a power of */ -/* 2 and the mantissa is composed of a sum of powers of 2. */ - - while(remndr != 0.) { - -/* 1/BASE <= REMNDR < 1 */ - - ++positn; - tmpnum = remndr * 16.; - result = (integer) tmpnum; - remndr = tmpnum - (doublereal) result; - *(unsigned char *)&tmpstr[positn - 1] = *(unsigned char *)&digits[ - (i__1 = result) < 16 && 0 <= i__1 ? i__1 : s_rnge("digits" - , i__1, "dp2hx_", (ftnlen)589)]; - } - -/* Put the exponent on the end of the number and update the */ -/* position. */ - - int2hx_(&intexp, expstr, &explen, (ftnlen)255); - i__1 = positn; -/* Writing concatenation */ - i__2[0] = 1, a__1[0] = "^"; - i__2[1] = explen, a__1[1] = expstr; - s_cat(tmpstr + i__1, a__1, i__2, &c__2, 255 - i__1); - positn = positn + explen + 1; - } else { - -/* Treat zero as a special case, because it's easier. */ - - positn = 3; - s_copy(tmpstr, "0^0", (ftnlen)3, (ftnlen)3); - } - -/* Set the value for the length of the character string produced */ -/* before returning. */ - - *length = positn; - -/* Set the value of the output string before returning. Let the */ -/* Fortran string assignment deal with the left justification, and */ -/* the truncation on the right if STRING is not long enough to */ -/* contain all of the characters produced. */ - - s_copy(string, tmpstr, string_len, (*length)); - return 0; -} /* dp2hx_ */ - diff --git a/ext/spice/src/cspice/dp2hx_c.c b/ext/spice/src/cspice/dp2hx_c.c deleted file mode 100644 index 110ff59175..0000000000 --- a/ext/spice/src/cspice/dp2hx_c.c +++ /dev/null @@ -1,275 +0,0 @@ -/* - --Procedure dp2hx_c ( D.p. number to hexadecimal string ) - --Abstract - - Convert a double precision number to an equivalent character - string using base 16 ``scientific notation.'' - --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 - - ALPHANUMERIC - CONVERSION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void dp2hx_c ( SpiceDouble number, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * length - ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - number I D.p. number to be converted. - lenout I Available space for output string 'string'. - string O Equivalent character string, left justified. - length O Length of the character string produced. - --Detailed_Input - - number The double precision number to be converted to a - character string representation. - - lenout is the maximum length of the output 'string'. The value - defined by lenout should be one plus the value large - enough to hold any possible output. - --Detailed_Output - - string The character string produced by this routine that - represents 'number' in base 16 ``scientific notation,'' - e.g.: - - 672.0 = '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 - - and - - -11.0 = '-B^1' = - ( 11/16 ) * 16**1. - - The following table describes the character set used to - represent the hexadecimal digits and their corresponding - values. - - Character Value Character Value - --------- ------ --------- ------ - '0' 0.0D0 '8' 8.0D0 - '1' 1.0D0 '9' 9.0D0 - '2' 2.0D0 'A' 10.0D0 - '3' 3.0D0 'B' 11.0D0 - '4' 4.0D0 'C' 12.0D0 - '5' 5.0D0 'D' 13.0D0 - '6' 6.0D0 'E' 14.0D0 - '7' 7.0D0 'F' 15.0D0 - - The caret, or hat, character, '^', is used to distinguish - the exponent. - - The plus sign, '+', and the minus sign, '-' have the expected - meanings. - - In order to obtain the entire character string produced - by this routine, the output character string should be - at least N characters long, where - - - # of bits per double precision mantissa + 3 - N = 3 + ---------------------------------------------- - 4 - - # of bits per double precision exponent + 3 - + ---------------------------------------------- . - 4 - - There should be one character position for the sign of - the mantissa, one for the sign of the exponent, one for - the exponentiation character, and one for each - hexadecimal digit that could be produced from a mantissa - and an exponent. - - The following table contains minimum output string - lengths necessary to obtain the complete character - string produced by this routine for some typical - implementations of double precision numbers. - - Double precision number - Size Mantissa Exponent Minimum output string length - bits bits bits - ---- -------- -------- ---------------------------- - 64 48 15 3 + 12 + 4 = 19 - 64 55+1 8 3 + 14 + 2 = 19 (VAX) - 64 52 11 3 + 13 + 3 = 19 (IEEE) - - The base 16 ``scientific notation'' character string - produced by this routine will be left justified and - consist of a contiguous sequence of characters with one - of the following formats: - - (1) h h h h ... h ^H H ... H - 1 2 3 4 n 1 2 m - - (2) -h h h h ... h ^H H ... H - 1 2 3 4 n 1 2 m - - (3) h h h h ... h ^-H H ... H - 1 2 3 4 n 1 2 m - - (4) -h h h h ... h ^-H H ... H - 1 2 3 4 n 1 2 m - - where - - h and H denote hexadecimal digits - i j - - '^' denotes exponentiation ( base 16 ) - - and - - '+' and '-' have their usual interpretations. - - length the length of the base 16 ``scientific notation'' character - 'string' returned by this routine. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - This routine converts a double precision number into an equivalent - character string using a base 16 ``scientific notation.'' This - representation allows the full precision of a number to be placed - in a format that is suitable for porting or archival storage. - - This routine is one of a pair of routines which are used to - perform conversions between double precision numbers and - an equivalent base 16 ``scientific notation'' character string - representation: - - dp2hx_c -- Convert a double precision number into a base 16 - ``scientific notation'' character string. - - hx2dp_c -- Convert a base 16 ``scientific notation'' - character string into a double precision number. - --Examples - - The following input and output argument values illustrate the - action of dp2hx_c for various input values of 'number'. - - Note: The hat or caret, '^', signals an exponent. - - number string length - ----------------- ----------------------------- ------ - 2.0D-9 89705F4136B4A6^-7 17 - 1.0D0 1^1 3 - -1.0D0 -1^1 4 - 1024.0D0 4^3 3 - -1024.0D0 -4^3 4 - 521707.0D0 7F5EB^5 7 - 27.0D0 1B^2 4 - 0.0D0 0^0 3 - --Restrictions - - The maximum number of characters permitted in the output string - is specified by the variable 'lenout'. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - --Version - - CSPICE Version 1.0.0, 10-APR-2010 (EDW) - --Index_Entries - - convert d.p. to signed normalized hexadecimal string - convert d.p. number to encoded d.p. number - convert d.p. to base 16 scientific notation - --& -*/ - -{ /* Begin dp2hx_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "dp2hx_c" ); - - /* - Make sure the output string has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - - CHKOSTR ( CHK_STANDARD, "dp2hx_c", string, lenout ); - - (void) dp2hx_( ( doublereal * ) &number, - ( char * ) string, - ( integer * ) length, - ( ftnlen ) lenout -1 ); - - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr( lenout, string ); - - chkout_c ( "dp2hx_c" ); - -} /* End dp2hx_c */ diff --git a/ext/spice/src/cspice/dpfmt.c b/ext/spice/src/cspice/dpfmt.c deleted file mode 100644 index cfb0f1572a..0000000000 --- a/ext/spice/src/cspice/dpfmt.c +++ /dev/null @@ -1,623 +0,0 @@ -/* dpfmt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static logical c_true = TRUE_; - -/* $Procedure DPFMT ( Format a double precision number ) */ -/* Subroutine */ int dpfmt_(doublereal *x, char *pictur, char *str, ftnlen - pictur_len, ftnlen str_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char fill[1]; - integer dpat; - char sign[1]; - integer i__; - extern /* Subroutine */ int zzvsbstr_(integer *, integer *, logical *, - char *, logical *, ftnlen); - doublereal y; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), zzvststr_(doublereal *, char *, integer *, - ftnlen); - logical shift; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int dpstr_(doublereal *, integer *, char *, - ftnlen); - integer start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - rjust_(char *, char *, ftnlen, ftnlen); - char mystr[32]; - integer declen, sigdig; - logical needsn; - integer lastch, sgnlen, frstch, intlen, firstb; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - logical ovflow; - integer expsiz, sprsiz, exp__; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Using a picture, create a formatted string that represents a */ -/* double precision number. */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* X I a double precision number. */ -/* PICTUR I a string describing the appearance of the output */ -/* STR O a string representing X as prescribed by PICTUR */ - -/* $ Detailed_Input */ - -/* X is any double precision number. */ - -/* PICTUR is a string used to describe the format of the */ -/* output string. There are four special characters */ -/* recognized by DPFMT --- a leading + or -, a leading */ -/* zero ( '0' ) or a zero that follows a leading + or -, */ -/* and the first decimal point of the string. */ - -/* All other non-blank characters are regarded as */ -/* equivalent. The picture ends at the first blank */ -/* character. The effects associated with the various */ -/* characters in a picture are spelled out in the */ -/* description of the output STRING. */ - -/* The following pictures are treated as errors. */ - -/* ' ', '+', '-', '.', '+.', '-.' */ - -/* $ Detailed_Output */ - -/* STRING is a string representing X that matches the input */ -/* picture. The format of STRING is governed by PICTUR. */ -/* It will represent X rounded to the level of precision */ -/* specified by PICTUR. */ - -/* If the first character of the picture is a minus sign, */ -/* the first character in the output string will be */ -/* a blank if the number is non-negative, a minus sign */ -/* if the number is negative. */ - -/* If the first character of the picture is a plus sign, */ -/* the first character of the output string will be a */ -/* plus if the number is positive, a blank if the number */ -/* is zero, and a minus sign if the number is negative. */ - -/* If the first character of the string is NOT a sign */ -/* (plus or minus) the first character of the output */ -/* string will be a minus sign if the number is negative */ -/* and will be the first character of the integer part */ -/* of the number otherwise. */ - -/* The integer portion of STRING will contain the same */ -/* number of characters as appear before the decimal */ -/* point (or last character if there is no decimal */ -/* point) but after a leading + or -. */ - -/* If the picture begins with any of the following */ - -/* '+0', '-0', or '0' */ - -/* it is said to have a leading zero. If a picture has */ -/* a leading zero and the integer portion is not large */ -/* enough to fill up the integer space specified by */ -/* PICTUR, STRING will be zero padded from the sign (if */ -/* one is required) up to the first character of the */ -/* integer part of the number. */ - -/* If picture does NOT have a leading zero and the */ -/* integer portion is not large enough to fill up the */ -/* space specified by PICTUR, STRING will be blank */ -/* padded on the left between the sign (if one is */ -/* required) and the first character of the integer part */ -/* of the number. */ - -/* If a decimal point ( '.' ) is present in PICTUR it */ -/* will be present following the integer portion of */ -/* STRING. Moreover, the decimal portion of STRING will */ -/* contain the same number of digits as there are */ -/* non-blank characters following the decimal point in */ -/* PICTUR. However, only the first 14 digits starting */ -/* with the first non-zero digit are meaningful. */ - -/* If the format specified by PICTUR does not provide */ -/* enough room for the integer portion of X, the routine */ -/* determines whether or not the number of characters */ -/* present in the picture is sufficient to create a */ -/* representation for X using scientific notation. If */ -/* so, the output is displayed using scientific notation */ -/* (leading signs, if they are present in PICTUR, will */ -/* also appear in STRING). If the format specified by */ -/* PICTUR is too short to accommodate scientific */ -/* notation, the output string is filled with '*' to the */ -/* same length as the length of PICTUR. Leading signs */ -/* are not preserved in this overflow case. */ - -/* STRING may overwrite PICTUR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) A picture that begins with a blank will cause the error */ -/* 'SPICE(NOPICTURE)' to be signalled. */ - -/* 2) A picture that consists only of '+', '-', '.', '+.' or '-.' */ -/* are regarded are regarded as errors (there's no significant */ -/* component to the picture.) These pictures cause the error */ -/* 'SPICE(BADPICTURE)' to be signalled. */ - -/* 3) If the length of STR is less than the length of the first */ -/* non-blank portion of PICTUR, the error 'SPICE(OUTPUTTOOSHORT)' */ -/* will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a mechanism for producing numeric strings */ -/* formatted according to a user supplied picture. We expect that */ -/* the string produced by this routine will be used to assist in */ -/* the construction of a string that can be read by people. */ - -/* Note that the process of converting a double precision number */ -/* to a string, in not precisely invertible even if the string */ -/* contains all of the significant figures allowed by this */ -/* routine. You should not anticipate that the string produced */ -/* by this routine can be "read" into a double precision number */ -/* to reproduce the double precision number X. To the level of */ -/* accuracy implied by the string representation, they will be */ -/* the same. But, they are unlikely to have the same internal */ -/* binary representation. */ - -/* $ Examples */ - -/* Suppose that X has the binary representation of PI. Then the */ -/* table below illustrates the strings that would be produced */ -/* by a variety of different pictures. */ - -/* PICTUR | STRING */ -/* ------------------------------- */ -/* '0x.xxx' | '03.142' */ -/* 'xx.xxx' | ' 3.142' */ -/* '+xxx.yyyy' | '+ 3.1416' */ -/* '-.yyyy' | '******' */ -/* 'xxxxxxxx' | ' 3' */ -/* '00xx' | '0003' */ -/* '-00.0000000' | ' 03.1415927' */ -/* '00' | '03' */ -/* 'x.' | '3.' */ -/* '.mynumber' | '3.142E+00' */ -/* 'my dog spot' | ' 3' */ -/* 'my.dog spot' | ' 3.142' */ -/* '+my.dog,spot' | '+ 3.14159265' */ - - - -/* Suppose that X has the binary representation of 2/3. Then the */ -/* table below illustrates the strings that would be produced */ -/* by a variety of different pictures. */ - -/* PICTUR | STRING */ -/* ------------------------------- */ -/* '+x.xxx' | '+0.667' */ -/* '+xx.xxx' | '+ 0.667' */ -/* 'xxx.yyyy' | ' 0.6667' */ -/* '.yyyy' | '.6667' */ -/* 'xxxxxxxx' | ' 1' */ -/* '00xx' | '0001' */ -/* '-0.0000000' | ' 0.6666667' */ -/* '00' | '01' */ -/* 'x.' | '1.' */ -/* 'mynumber' | ' 1' */ -/* 'my dog spot' | ' 1' */ -/* 'my.dog spot' | ' 0.667' */ -/* 'my.dog,spot' | ' 0.66666667' */ - -/* Suppose that X has the binary representation of -8/9. Then the */ -/* table below illustrates the strings that would be produced */ -/* by a variety of different pictures. */ - - -/* PICTUR | STRING */ -/* ------------------------------- */ -/* '+x.xxx' | '-0.889' */ -/* '-00.xxxx' | '-00.8889' */ -/* 'xxx.xxx' | ' -0.889' */ -/* '000.000' | '-00.889' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - Spicelib Version 1.0.1, 22-JUN-1998 (WLT) */ - -/* A number of typographical and grammatical errors */ -/* were corrected in the header. */ - -/* - Spicelib Version 1.0.0, 17-SEP-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* format a string representing a d.p. number */ -/* string from a d.p. number and format picture */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Initial values */ - - -/* Determine where the picture ends. */ - - firstb = pos_(pictur, " ", &c__1, pictur_len, (ftnlen)1); - if (firstb == 0) { - lastch = i_len(pictur, pictur_len); - } else { - lastch = firstb - 1; - } - -/* Make sure there is a picture to worry about. */ - - if (lastch == 0) { - chkin_("DPFMT", (ftnlen)5); - setmsg_("The format picture must begin with a non-blank character. " - "The picture supplied was began with a blank.", (ftnlen)103); - sigerr_("SPICE(NOPICTURE)", (ftnlen)16); - chkout_("DPFMT", (ftnlen)5); - return 0; - } else if (lastch == 1) { - if (s_cmp(pictur, "+", pictur_len, (ftnlen)1) == 0 || s_cmp(pictur, - "-", pictur_len, (ftnlen)1) == 0 || s_cmp(pictur, ".", - pictur_len, (ftnlen)1) == 0) { - chkin_("DPFMT", (ftnlen)5); - setmsg_("Format pictures must have at least one significant char" - "acter. The picture provided '#' does not. ", (ftnlen)97); - errch_("#", pictur, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(BADPICTURE)", (ftnlen)17); - chkout_("DPFMT", (ftnlen)5); - return 0; - } - } else if (lastch == 2) { - if (s_cmp(pictur, "+.", pictur_len, (ftnlen)2) == 0 || s_cmp(pictur, - "-.", pictur_len, (ftnlen)2) == 0) { - chkin_("DPFMT", (ftnlen)5); - setmsg_("Format pictures must have at least one significant char" - "acter. The picture provided '#' does not. ", (ftnlen)97); - errch_("#", pictur, (ftnlen)1, (ftnlen)2); - sigerr_("SPICE(BADPICTURE)", (ftnlen)17); - chkout_("DPFMT", (ftnlen)5); - return 0; - } - } else if (lastch > i_len(str, str_len)) { - chkin_("DPFMT", (ftnlen)5); - setmsg_("The output string is not long enough to accommodate a numbe" - "r formatted according the the supplied format picture. The " - "output string has length #. The output picture '#' requires" - " # characters. ", (ftnlen)194); - i__1 = i_len(str, str_len); - errint_("#", &i__1, (ftnlen)1); - errch_("#", pictur, (ftnlen)1, lastch); - errint_("#", &lastch, (ftnlen)1); - sigerr_("SPICE(OUTPUTTOOSHORT)", (ftnlen)21); - chkout_("DPFMT", (ftnlen)5); - return 0; - } - -/* If we get this far, the routine can go ahead and do its business. */ -/* Determine the sign of X. Also, determine how many characters */ -/* are needed to represent the sign if leading sign is suppressed for */ -/* positive numbers. */ - - if (*x > 0.) { - *(unsigned char *)sign = '+'; - sprsiz = 0; - } else if (*x < 0.) { - *(unsigned char *)sign = '-'; - sprsiz = 1; - } else { - *(unsigned char *)sign = ' '; - sprsiz = 0; - } - -/* Look at the picture and see if a leading sign is required and */ -/* if so whether the sign just determined should use a different */ -/* character and how many characters are needed for the sign. */ - - if (*(unsigned char *)pictur == '+') { - needsn = TRUE_; - sgnlen = 1; - } else if (*(unsigned char *)pictur == '-') { - needsn = TRUE_; - sgnlen = 1; - if (*x > 0.) { - *(unsigned char *)sign = ' '; - } - } else { - if (*x > 0.) { - *(unsigned char *)sign = ' '; - } - needsn = FALSE_; - sgnlen = sprsiz; - } - -/* If we need a leading sign. The numeric part of the string */ -/* will start at character 2. Otherwise it starts at character 1. */ - - if (needsn) { - start = 2; - } else { - start = 1; - } - -/* We can set the sign portion of the string now. */ - - s_copy(str, sign, str_len, (ftnlen)1); - -/* Determine what character should be use for leading characters */ -/* before the first significant character of the output string. */ - - if (*(unsigned char *)&pictur[start - 1] == '0') { - *(unsigned char *)fill = '0'; - } else { - *(unsigned char *)fill = ' '; - } - -/* See if there is a decimal point. */ - - dpat = pos_(pictur, ".", &c__1, pictur_len, (ftnlen)1); - -/* The integer part is the stuff to the left of the first */ -/* decimal point and that follows the sign (if there is one */ -/* that is explicitly required. The length of the decimal */ -/* portion is the stuff to the right of the decimal point. */ - - if (dpat > 0) { - intlen = dpat - start; - declen = lastch - dpat; - } else { - intlen = lastch - start + 1; - declen = -1; - } - -/* If a sign was not explicitly requested by placing it in */ -/* the first digit of the picture START will be 1. If in */ -/* addition X is less than zero ( SGNLEN will be 1 in this */ -/* case) we have one fewer digits available for the integer */ -/* portion of the string than is currently set in INTLEN. */ -/* Adjust INTLEN to reflect the actual number of digits */ -/* available. */ - -/* Also set the SHIFT flag to .TRUE. so that we know to swap */ -/* the sign and any blanks that might lie between the sign */ -/* and the first significant character of the output string. */ - - if (start == 1 && sgnlen == 1) { - --intlen; - shift = TRUE_; - -/* If INTLEN has become negative (i.e. -1) the picture */ -/* must be of the form .xxxxx and the input number must */ -/* be negative. Add 1 back onto the INTLEN but take one */ -/* away from the decimal length DECLEN. */ - - if (intlen == -1) { - intlen = 0; - --declen; - if (declen == 0 && intlen == 0) { - -/* There is no room for anything other than a */ -/* decimal point. We simply fill the output */ -/* string with the '*' character. */ - - i__1 = lastch; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&str[i__ - 1] = '*'; - } - return 0; - } - } - } else { - shift = FALSE_; - } - -/* Create the "virtual decimal string" associated with the */ -/* unsigned part of X. */ - - y = abs(*x); - zzvststr_(&y, fill, &exp__, (ftnlen)1); - -/* The actual number of digits required to print the unsigned integer */ -/* portion X is EXP + 1 (provided EXP is at least 0.) We have */ -/* INTLEN slots available. So if EXP + 1 is more than INTLEN */ -/* ( which is equivalent to EXP being at least INTLEN) we don't */ -/* have enough room to print the unsigned integer portion of the */ -/* number. */ - - if (exp__ >= intlen && y != 0.) { - -/* See if we have room to print an exponential form. */ -/* First we need the number of characters for the */ -/* exponent which is always of the form 'E+dd...' */ - -/* Computing MIN */ - i__1 = 1, i__2 = exp__ / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = exp__ / 100; - expsiz = min(i__1,i__2) + 4 + min(i__3,i__4); - -/* The number of significant digits that can be printed is the */ -/* size of the picture minus: the size of the sign */ -/* the size of the exponent */ -/* the size of the decimal point. */ - - sigdig = lastch - sgnlen - expsiz - 1; - -/* If we don't have room for at least one significant digit, */ -/* there's not much we can do. Fill the string with '*'. */ - - if (sigdig < 1) { - i__1 = lastch; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&str[i__ - 1] = '*'; - } - } else { - dpstr_(x, &sigdig, mystr, (ftnlen)32); - *(unsigned char *)mystr = *(unsigned char *)sign; - ljust_(mystr, str, (ftnlen)32, str_len); - rjust_(str, str, lastch, lastch); - } - return 0; - } - -/* One more check. If -INTLEN is greater than DECLEN, or if */ -/* both are zero, we don't have room to create an output string. */ - - if (intlen == 0 && declen == 0 || -intlen > declen) { - i__1 = lastch; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&str[i__ - 1] = '*'; - } - return 0; - } - -/* We have a reasonable chance of successfully constructing */ -/* the string without overflow. */ - - start = sgnlen + 1; - i__1 = -intlen; - zzvsbstr_(&i__1, &declen, &c_true, str + (start - 1), &ovflow, str_len - ( - start - 1)); - -/* We might be done at this point. The IF-THEN block below */ -/* handles the one snag that could arise. */ - -/* If the first digit is a zero as a result of rounding it up */ -/* OVFLOW will be true. This means we don't have enough room */ -/* in the picture for the integer portion of the string. We try */ -/* to make an exponential picture. */ - - if (ovflow) { - -/* See if we have room to print an exponential form. */ - -/* Computing MIN */ - i__1 = 1, i__2 = exp__ / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = exp__ / 100; - expsiz = min(i__1,i__2) + 4 + min(i__3,i__4); - -/* The number of significant digits that can be printed is the */ -/* size of the picture minus: the size of the sign */ -/* the size of the exponent */ -/* the size of the decimal point. */ - - sigdig = lastch - sgnlen - expsiz - 1; - if (sigdig < 1) { - i__1 = lastch; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&str[i__ - 1] = '*'; - } - } else { - dpstr_(x, &sigdig, mystr, (ftnlen)32); - *(unsigned char *)mystr = *(unsigned char *)sign; - ljust_(mystr, str, (ftnlen)32, str_len); - rjust_(str, str, lastch, lastch); - return 0; - } - } else if (shift) { - -/* We need to move the sign right until, there are no */ -/* blanks between it and the next character. */ - - frstch = ncpos_(str, " -", &c__1, str_len, (ftnlen)2); - if (frstch > 2) { - i__1 = frstch - 2; - s_copy(str + i__1, str, frstch - 1 - i__1, (ftnlen)1); - *(unsigned char *)str = ' '; - } - } - return 0; -} /* dpfmt_ */ - diff --git a/ext/spice/src/cspice/dpgrdr.c b/ext/spice/src/cspice/dpgrdr.c deleted file mode 100644 index 568f7e6caa..0000000000 --- a/ext/spice/src/cspice/dpgrdr.c +++ /dev/null @@ -1,674 +0,0 @@ -/* dpgrdr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure DPGRDR ( Derivative of planetographic w.r.t. rectangular ) */ -/* Subroutine */ int dpgrdr_(char *body, doublereal *x, doublereal *y, - doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi, - ftnlen body_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - integer i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer sense; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), bods2c_(char *, integer *, logical *, - ftnlen), dgeodr_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - integer bodyid; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen); - char kvalue[80]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char pmkvar[32], pgrlon[4]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen); - extern integer plnsns_(integer *); - extern logical return_(void); - char tmpstr[32]; - -/* $ Abstract */ - -/* This routine computes the Jacobian matrix of the transformation */ -/* from rectangular to planetographic coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Body with which coordinate system is associated. */ -/* X I X-coordinate of point. */ -/* Y I Y-coordinate of point. */ -/* Z I Z-coordinate of point. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* BODY Name of the body with which the planetographic */ -/* coordinate system is associated. */ - -/* BODY is used by this routine to look up from the */ -/* kernel pool the prime meridian rate coefficient giving */ -/* the body's spin sense. See the Files and Particulars */ -/* header sections below for details. */ - -/* X, */ -/* Y, */ -/* Z are the rectangular coordinates of the point at */ -/* which the Jacobian of the map from rectangular */ -/* to planetographic coordinates is desired. */ - -/* RE Equatorial radius of the reference spheroid. */ - -/* F Flattening coefficient = (RE-RP) / RE, where RP is */ -/* the polar radius of the spheroid. (More importantly */ -/* RP = RE*(1-F).) */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* from rectangular to planetographic coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | DLON/DX DLON/DY DLON/DZ | */ -/* | DLAT/DX DLAT/DY DLAT/DZ | */ -/* | DALT/DX DALT/DY DALT/DZ | */ -/* `- -' */ - -/* evaluated at the input values of X, Y, and Z. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */ -/* and if BODY is not a string representation of an integer, */ -/* the error SPICE(IDCODENOTFOUND) will be signaled. */ - -/* 2) If the kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* is present in the kernel pool but has a value other */ -/* than one of */ - -/* 'EAST' */ -/* 'WEST' */ - -/* the error SPICE(INVALIDOPTION) will be signaled. Case */ -/* and blanks are ignored when these values are interpreted. */ - -/* 3) If polynomial coefficients for the prime meridian of BODY */ -/* are not available in the kernel pool, and if the kernel */ -/* variable BODY_PGR_POSITIVE_LON is not present in */ -/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */ - -/* 4) If the equatorial radius is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 5) If the flattening coefficient is greater than or equal to one, */ -/* the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 6) If the input point is on the Z-axis (X = 0 and Y = 0), the */ -/* Jacobian matrix is undefined. The error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - -/* This routine expects a kernel variable giving BODY's prime */ -/* meridian angle as a function of time to be available in the */ -/* kernel pool. Normally this item is provided by loading a PCK */ -/* file. The required kernel variable is named */ - -/* BODY_PM */ - -/* where represents a string containing the NAIF integer */ -/* ID code for BODY. For example, if BODY is 'JUPITER', then */ -/* the name of the kernel variable containing the prime meridian */ -/* angle coefficients is */ - -/* BODY599_PM */ - -/* See the PCK Required Reading for details concerning the prime */ -/* meridian kernel variable. */ - -/* The optional kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* also is normally defined via loading a text kernel. When this */ -/* variable is present in the kernel pool, the prime meridian */ -/* coefficients for BODY are not required by this routine. See the */ -/* Particulars section below for details. */ - -/* $ Particulars */ - -/* When performing vector calculations with velocities it is usually */ -/* most convenient to work in rectangular coordinates. However, once */ -/* the vector manipulations have been performed, it is often */ -/* desirable to convert the rectangular representations into */ -/* planetographic coordinates to gain insights about phenomena in */ -/* this coordinate frame. */ - -/* To transform rectangular velocities to derivatives of coordinates */ -/* in a planetographic system, one uses the Jacobian of the */ -/* transformation between the two systems. */ - -/* Given a state in rectangular coordinates */ - -/* ( x, y, z, dx, dy, dz ) */ - -/* the velocity in planetographic coordinates is given by the matrix */ -/* equation: */ -/* t | t */ -/* (dlon, dlat, dalt) = JACOBI| * (dx, dy, dz) */ -/* |(x,y,z) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(x, y, z) */ - - -/* The planetographic definition of latitude is identical to the */ -/* planetodetic (also called "geodetic" in SPICE documentation) */ -/* definition. In the planetographic coordinate system, latitude is */ -/* defined using a reference spheroid. The spheroid is */ -/* characterized by an equatorial radius and a polar radius. For a */ -/* point P on the spheroid, latitude is defined as the angle between */ -/* the X-Y plane and the outward surface normal at P. For a point P */ -/* off the spheroid, latitude is defined as the latitude of the */ -/* nearest point to P on the spheroid. Note if P is an interior */ -/* point, for example, if P is at the center of the spheroid, there */ -/* may not be a unique nearest point to P. */ - -/* In the planetographic coordinate system, longitude is defined */ -/* using the spin sense of the body. Longitude is positive to the */ -/* west if the spin is prograde and positive to the east if the spin */ -/* is retrograde. The spin sense is given by the sign of the first */ -/* degree term of the time-dependent polynomial for the body's prime */ -/* meridian Euler angle "W": the spin is retrograde if this term is */ -/* negative and prograde otherwise. For the sun, planets, most */ -/* natural satellites, and selected asteroids, the polynomial */ -/* expression for W may be found in a SPICE PCK kernel. */ - -/* The earth, moon, and sun are exceptions: planetographic longitude */ -/* is measured positive east for these bodies. */ - -/* If you wish to override the default sense of positive longitude */ -/* for a particular body, you can do so by defining the kernel */ -/* variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* where represents the NAIF ID code of the body. This */ -/* variable may be assigned either of the values */ - -/* 'WEST' */ -/* 'EAST' */ - -/* For example, you can have this routine treat the longitude */ -/* of the earth as increasing to the west using the kernel */ -/* variable assignment */ - -/* BODY399_PGR_POSITIVE_LON = 'WEST' */ - -/* Normally such assignments are made by placing them in a text */ -/* kernel and loading that kernel via FURNSH. */ - -/* The definition of this kernel variable controls the behavior of */ -/* the SPICELIB planetographic routines */ - -/* PGRREC */ -/* RECPGR */ -/* DPGRDR */ -/* DRDPGR */ - -/* It does not affect the other SPICELIB coordinate conversion */ -/* routines. */ - -/* $ Examples */ - -/* Numerical results shown for this example may differ between */ -/* platforms as the results depend on the SPICE kernels used as */ -/* input and the machine specific arithmetic implementation. */ - - -/* Find the planetographic state of the earth as seen from */ -/* Mars in the J2000 reference frame at January 1, 2005 TDB. */ -/* Map this state back to rectangular coordinates as a check. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION RPD */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION DRECTN ( 3 ) */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION F */ -/* DOUBLE PRECISION JACOBI ( 3, 3 ) */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION PGRVEL ( 3 ) */ -/* DOUBLE PRECISION RADII ( 3 ) */ -/* DOUBLE PRECISION RE */ -/* DOUBLE PRECISION RECTAN ( 3 ) */ -/* DOUBLE PRECISION RP */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* INTEGER N */ -/* C */ -/* C Load a PCK file containing a triaxial */ -/* C ellipsoidal shape model and orientation */ -/* C data for Mars. */ -/* C */ -/* CALL FURNSH ( 'pck00008.tpc' ) */ - -/* C */ -/* C Load an SPK file giving ephemerides of earth and Mars. */ -/* C */ -/* CALL FURNSH ( 'de405.bsp' ) */ - -/* C */ -/* C Load a leapseconds kernel to support time conversion. */ -/* C */ -/* CALL FURNSH ( 'naif0007.tls' ) */ - -/* C */ -/* C Look up the radii for Mars. Although we */ -/* C omit it here, we could first call BADKPV */ -/* C to make sure the variable BODY499_RADII */ -/* C has three elements and numeric data type. */ -/* C If the variable is not present in the kernel */ -/* C pool, BODVRD will signal an error. */ -/* C */ -/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */ - -/* C */ -/* C Compute flattening coefficient. */ -/* C */ -/* RE = RADII(1) */ -/* RP = RADII(3) */ -/* F = ( RE - RP ) / RE */ - -/* C */ -/* C Look up the geometric state of earth as seen from Mars at */ -/* C January 1, 2005 TDB, relative to the J2000 reference */ -/* C frame. */ -/* C */ -/* CALL STR2ET ( 'January 1, 2005 TDB', ET ) */ - -/* CALL SPKEZR ( 'Earth', ET, 'J2000', 'LT+S', */ -/* . 'Mars', STATE, LT ) */ - -/* C */ -/* C Convert position to planetographic coordinates. */ -/* C */ -/* CALL RECPGR ( 'MARS', STATE, RE, F, LON, LAT, ALT ) */ - -/* C */ -/* C Convert velocity to planetographic coordinates. */ -/* C */ - -/* CALL DPGRDR ( 'MARS', STATE(1), STATE(2), STATE(3), */ -/* . RE, F, JACOBI ) */ - -/* CALL MXV ( JACOBI, STATE(4), PGRVEL ) */ - -/* C */ -/* C As a check, convert the planetographic state back to */ -/* C rectangular coordinates. */ -/* C */ -/* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */ - -/* CALL DRDPGR ( 'MARS', LON, LAT, ALT, RE, F, JACOBI ) */ - -/* CALL MXV ( JACOBI, PGRVEL, DRECTN ) */ - - -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular coordinates:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' X (km) = ', STATE(1) */ -/* WRITE(*,*) ' Y (km) = ', STATE(2) */ -/* WRITE(*,*) ' Z (km) = ', STATE(3) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular velocity:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' dX/dt (km/s) = ', STATE(4) */ -/* WRITE(*,*) ' dY/dt (km/s) = ', STATE(5) */ -/* WRITE(*,*) ' dZ/dt (km/s) = ', STATE(6) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Ellipsoid shape parameters: ' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' Equatorial radius (km) = ', RE */ -/* WRITE(*,*) ' Polar radius (km) = ', RP */ -/* WRITE(*,*) ' Flattening coefficient = ', F */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Planetographic coordinates:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' Longitude (deg) = ', LON / RPD() */ -/* WRITE(*,*) ' Latitude (deg) = ', LAT / RPD() */ -/* WRITE(*,*) ' Altitude (km) = ', ALT */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Planetographic velocity:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' d Longitude/dt (deg/s) = ', PGRVEL(1)/RPD() */ -/* WRITE(*,*) ' d Latitude/dt (deg/s) = ', PGRVEL(2)/RPD() */ -/* WRITE(*,*) ' d Altitude/dt (km/s) = ', PGRVEL(3) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular coordinates from inverse ' // */ -/* . 'mapping:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' X (km) = ', RECTAN(1) */ -/* WRITE(*,*) ' Y (km) = ', RECTAN(2) */ -/* WRITE(*,*) ' Z (km) = ', RECTAN(3) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular velocity from inverse mapping:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' dX/dt (km/s) = ', DRECTN(1) */ -/* WRITE(*,*) ' dY/dt (km/s) = ', DRECTN(2) */ -/* WRITE(*,*) ' dZ/dt (km/s) = ', DRECTN(3) */ -/* WRITE(*,*) ' ' */ -/* END */ - - -/* Output from this program should be similar to the following */ -/* (rounding and formatting differ across platforms): */ - - -/* Rectangular coordinates: */ - -/* X (km) = 146039732. */ -/* Y (km) = 278546607. */ -/* Z (km) = 119750315. */ - -/* Rectangular velocity: */ - -/* dX/dt (km/s) = -47.0428824 */ -/* dY/dt (km/s) = 9.07021778 */ -/* dZ/dt (km/s) = 4.75656274 */ - -/* Ellipsoid shape parameters: */ - -/* Equatorial radius (km) = 3396.19 */ -/* Polar radius (km) = 3376.2 */ -/* Flattening coefficient = 0.00588600756 */ - -/* Planetographic coordinates: */ - -/* Longitude (deg) = 297.667659 */ -/* Latitude (deg) = 20.844504 */ -/* Altitude (km) = 336531825. */ - -/* Planetographic velocity: */ - -/* d Longitude/dt (deg/s) = -8.35738632E-06 */ -/* d Latitude/dt (deg/s) = 1.59349355E-06 */ -/* d Altitude/dt (km/s) = -11.2144327 */ - -/* Rectangular coordinates from inverse mapping: */ - -/* X (km) = 146039732. */ -/* Y (km) = 278546607. */ -/* Z (km) = 119750315. */ - -/* Rectangular velocity from inverse mapping: */ - -/* dX/dt (km/s) = -47.0428824 */ -/* dY/dt (km/s) = 9.07021778 */ -/* dZ/dt (km/s) = 4.75656274 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-DEC-2004 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of planetographic w.r.t. rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DPGRDR", (ftnlen)6); - } - -/* Convert the body name to an ID code. */ - - bods2c_(body, &bodyid, &found, body_len); - if (! found) { - setmsg_("The value of the input argument BODY is #, this is not a re" - "cognized name of an ephemeris object. The cause of this prob" - "lem may be that you need an updated version of the SPICE Too" - "lkit. ", (ftnlen)185); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("DPGRDR", (ftnlen)6); - return 0; - } - -/* The equatorial radius must be positive. If not, signal an error */ -/* and check out. */ - - if (*re <= 0.) { - setmsg_("Equatorial radius was #.", (ftnlen)24); - errdp_("#", re, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DPGRDR", (ftnlen)6); - return 0; - } - -/* If the flattening coefficient is greater than 1, the polar radius */ -/* is negative. If F is equal to 1, the polar radius is zero. Either */ -/* case is a problem, so signal an error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was #.", (ftnlen)29); - errdp_("#", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DPGRDR", (ftnlen)6); - return 0; - } - -/* Look up the longitude sense override variable from the */ -/* kernel pool. */ - - repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, ( - ftnlen)1, (ftnlen)32); - gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80); - if (found) { - -/* Make sure we recognize the value of PGRLON. */ - - cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32) - ; - ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4); - if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) { - sense = 1; - } else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) { - sense = -1; - } else { - setmsg_("Kernel variable # may have the values EAST or WEST. Ac" - "tual value was #.", (ftnlen)72); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", kvalue, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("DPGRDR", (ftnlen)6); - return 0; - } - } else { - -/* Look up the spin sense of the body's prime meridian. */ - - sense = plnsns_(&bodyid); - -/* If the required prime meridian rate was not available, */ -/* PLNSNS returns the code 0. Here we consider this situation */ -/* to be an error. */ - - if (sense == 0) { - repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, ( - ftnlen)32); - setmsg_("Prime meridian rate coefficient defined by kernel varia" - "ble # is required but not available for body #. ", ( - ftnlen)103); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(MISSINGDATA)", (ftnlen)18); - chkout_("DPGRDR", (ftnlen)6); - return 0; - } - -/* Handle the special cases: earth, moon, and sun. */ - - if (bodyid == 399 || bodyid == 301 || bodyid == 10) { - sense = 1; - } - } - -/* At this point, SENSE is set to +/- 1. */ - -/* To obtain the Jacobian matrix we want, first find the Jacobian */ -/* matrix of rectangular coordinates with respect to geodetic */ -/* coordinates. */ - - dgeodr_(x, y, z__, re, f, jacobi); - -/* Letting GLON represent geodetic longitude, the matrix JACOBI is */ - -/* .- -. */ -/* | DGLON/DX DGLON/DY DGLON/DZ | */ -/* | DLAT/DX DLAT/DY DLAT/DZ | */ -/* | DALT/DX DALT/DY DALT/DZ | */ -/* `- -' */ - -/* evaluated at the input values of X, Y, and Z. */ - -/* Since planetographic longitude LON satisfies */ - -/* LON = SENSE * GLON */ - -/* applying the chain rule to D(*)/DGLON, the above is equivalent to */ - -/* .- -. */ -/* | (1/SENSE)*DLON/DX (1/SENSE)*DLON/DY (1/SENSE)*DLON/DZ | */ -/* | DLAT/DX DLAT/DY DLAT/DZ | */ -/* | DALT/DX DALT/DY DALT/DZ | */ -/* `- -' */ - -/* So, multiplying the first row of JACOBI by SENSE gives us the */ -/* matrix we actually want to compute: the Jacobian matrix of */ -/* rectangular coordinates with respect to planetographic */ -/* coordinates. */ - - for (i__ = 1; i__ <= 3; ++i__) { - jacobi[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("jacobi", - i__1, "dpgrdr_", (ftnlen)712)] = sense * jacobi[(i__2 = i__ * - 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("jacobi", i__2, - "dpgrdr_", (ftnlen)712)]; - } - chkout_("DPGRDR", (ftnlen)6); - return 0; -} /* dpgrdr_ */ - diff --git a/ext/spice/src/cspice/dpgrdr_c.c b/ext/spice/src/cspice/dpgrdr_c.c deleted file mode 100644 index f05986858b..0000000000 --- a/ext/spice/src/cspice/dpgrdr_c.c +++ /dev/null @@ -1,555 +0,0 @@ -/* - --Procedure dpgrdr_c ( Derivative of planetographic w.r.t. rectangular ) - --Abstract - - This routine computes the Jacobian matrix of the transformation - from rectangular to planetographic coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void dpgrdr_c ( ConstSpiceChar * body, - SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - body I Body with which coordinate system is associated. - x I X-coordinate of point. - y I Y-coordinate of point. - z I Z-coordinate of point. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - body Name of the body with which the planetographic - coordinate system is associated. - - `body' is used by this routine to look up from the - kernel pool the prime meridian rate coefficient giving - the body's spin sense. See the Files and Particulars - header sections below for details. - - x, - y, - z are the rectangular coordinates of the point at - which the Jacobian of the map from rectangular - to planetographic coordinates is desired. - - re Equatorial radius of the reference spheroid. - - f Flattening coefficient = (re-rp) / re, where rp is - the polar radius of the spheroid. (More importantly - rp = re*(1-f).) - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - from rectangular to planetographic coordinates. It - has the form - - .- -. - | DLON/DX DLON/DY DLON/DZ | - | DLAT/DX DLAT/DY DLAT/DZ | - | DALT/DX DALT/DY DALT/DZ | - `- -' - - evaluated at the input values of `x', `y', and `z'. - --Parameters - - None. - --Exceptions - - 1) If the body name `body' cannot be mapped to a NAIF ID code, - and if `body' is not a string representation of an integer, - the error SPICE(IDCODENOTFOUND) will be signaled. - - 2) If the kernel variable - - BODY_PGR_POSITIVE_LON - - is present in the kernel pool but has a value other - than one of - - 'EAST' - 'WEST' - - the error SPICE(INVALIDOPTION) will be signaled. Case - and blanks are ignored when these values are interpreted. - - 3) If polynomial coefficients for the prime meridian of `body' - are not available in the kernel pool, and if the kernel - variable BODY_PGR_POSITIVE_LON is not present in - the kernel pool, the error SPICE(MISSINGDATA) will be signaled. - - 4) If the equatorial radius is non-positive, the error - SPICE(VALUEOUTOFRANGE) is signaled. - - 5) If the flattening coefficient is greater than or equal to one, - the error SPICE(VALUEOUTOFRANGE) is signaled. - - 6) If the input point is on the Z-axis (X = 0 and Y = 0), the - Jacobian matrix is undefined. The error will be diagnosed - by routines in the call tree of this routine. - - 7) The error SPICE(EMPTYSTRING) is signaled if the input - string `body' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 8) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `body' is null. - --Files - - This routine expects a kernel variable giving body's prime - meridian angle as a function of time to be available in the - kernel pool. Normally this item is provided by loading a PCK - file. The required kernel variable is named - - BODY_PM - - where represents a string containing the NAIF integer - ID code for `body'. For example, if `body' is "JUPITER", then - the name of the kernel variable containing the prime meridian - angle coefficients is - - BODY599_PM - - See the PCK Required Reading for details concerning the prime - meridian kernel variable. - - The optional kernel variable - - BODY_PGR_POSITIVE_LON - - also is normally defined via loading a text kernel. When this - variable is present in the kernel pool, the prime meridian - coefficients for `body' are not required by this routine. See the - Particulars section below for details. - --Particulars - - When performing vector calculations with velocities it is usually - most convenient to work in rectangular coordinates. However, once - the vector manipulations have been performed, it is often - desirable to convert the rectangular representations into - planetographic coordinates to gain insights about phenomena in - this coordinate frame. - - To transform rectangular velocities to derivatives of coordinates - in a planetographic system, one uses the Jacobian of the - transformation between the two systems. - - Given a state in rectangular coordinates - - ( x, y, z, dx, dy, dz ) - - the velocity in planetographic coordinates is given by the matrix - equation: - t | t - (dlon, dlat, dalt) = jacobi| * (dx, dy, dz) - |(x,y,z) - - This routine computes the matrix - - | - jacobi| - |(x, y, z) - - - The planetographic definition of latitude is identical to the - planetodetic (also called "geodetic" in SPICE documentation) - definition. In the planetographic coordinate system, latitude is - defined using a reference spheroid. The spheroid is - characterized by an equatorial radius and a polar radius. For a - point P on the spheroid, latitude is defined as the angle between - the X-Y plane and the outward surface normal at P. For a point P - off the spheroid, latitude is defined as the latitude of the - nearest point to P on the spheroid. Note if P is an interior - point, for example, if P is at the center of the spheroid, there - may not be a unique nearest point to P. - - In the planetographic coordinate system, longitude is defined - using the spin sense of the body. Longitude is positive to the - west if the spin is prograde and positive to the east if the spin - is retrograde. The spin sense is given by the sign of the first - degree term of the time-dependent polynomial for the body's prime - meridian Euler angle "W": the spin is retrograde if this term is - negative and prograde otherwise. For the sun, planets, most - natural satellites, and selected asteroids, the polynomial - expression for W may be found in a SPICE PCK kernel. - - The earth, moon, and sun are exceptions: planetographic longitude - is measured positive east for these bodies. - - If you wish to override the default sense of positive longitude - for a particular body, you can do so by defining the kernel - variable - - BODY_PGR_POSITIVE_LON - - where represents the NAIF ID code of the body. This - variable may be assigned either of the values - - 'WEST' - 'EAST' - - For example, you can have this routine treat the longitude - of the earth as increasing to the west using the kernel - variable assignment - - BODY399_PGR_POSITIVE_LON = 'WEST' - - Normally such assignments are made by placing them in a text - kernel and loading that kernel via furnsh_c. - - The definition of this kernel variable controls the behavior of - the CSPICE planetographic routines - - pgrrec_c - recpgr_c - dpgrdr_c - drdpgr_c - - It does not affect the other CSPICE coordinate conversion - routines. - --Examples - - Numerical results shown for this example may differ between - platforms as the results depend on the SPICE kernels used as - input and the machine specific arithmetic implementation. - - - Find the planetographic state of the earth as seen from - Mars in the J2000 reference frame at January 1, 2005 TDB. - Map this state back to rectangular coordinates as a check. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local variables - ./ - SpiceDouble alt; - SpiceDouble drectn [3]; - SpiceDouble et; - SpiceDouble f; - SpiceDouble jacobi [3][3]; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble lt; - SpiceDouble pgrvel [3]; - SpiceDouble radii [3]; - SpiceDouble re; - SpiceDouble rectan [3]; - SpiceDouble rp; - SpiceDouble state [6]; - - SpiceInt n; - - - /. - Load a PCK file containing a triaxial - ellipsoidal shape model and orientation - data for Mars. - ./ - furnsh_c ( "pck00008.tpc" ); - - /. - Load an SPK file giving ephemerides of earth and Mars. - ./ - furnsh_c ( "de405.bsp" ); - - /. - Load a leapseconds kernel to support time conversion. - ./ - furnsh_c ( "naif0007.tls" ); - - /. - Look up the radii for Mars. Although we - omit it here, we could first call badkpv_c - to make sure the variable BODY499_RADII - has three elements and numeric data type. - If the variable is not present in the kernel - pool, bodvrd_c will signal an error. - ./ - bodvrd_c ( "MARS", "RADII", 3, &n, radii ); - - /. - Compute flattening coefficient. - ./ - re = radii[0]; - rp = radii[2]; - f = ( re - rp ) / re; - - /. - Look up the geometric state of earth as seen from Mars at - January 1, 2005 TDB, relative to the J2000 reference - frame. - ./ - str2et_c ( "January 1, 2005 TDB", &et); - - spkezr_c ( "Earth", et, "J2000", "LT+S", - "Mars", state, < ); - - /. - Convert position to planetographic coordinates. - ./ - recpgr_c ( "mars", state, re, f, &lon, &lat, &alt ); - - /. - Convert velocity to planetographic coordinates. - ./ - - dpgrdr_c ( "MARS", state[0], state[1], state[2], - re, f, jacobi ); - - mxv_c ( jacobi, state+3, pgrvel ); - - - /. - As a check, convert the planetographic state back to - rectangular coordinates. - ./ - pgrrec_c ( "mars", lon, lat, alt, re, f, rectan ); - drdpgr_c ( "mars", lon, lat, alt, re, f, jacobi ); - - mxv_c ( jacobi, pgrvel, drectn ); - - printf ( "\n" - "Rectangular coordinates:\n" - "\n" - " X (km) = %18.9e\n" - " Y (km) = %18.9e\n" - " Z (km) = %18.9e\n" - "\n" - "Rectangular velocity:\n" - "\n" - " dX/dt (km/s) = %18.9e\n" - " dY/dt (km/s) = %18.9e\n" - " dZ/dt (km/s) = %18.9e\n" - "\n" - "Ellipsoid shape parameters:\n" - "\n" - " Equatorial radius (km) = %18.9e\n" - " Polar radius (km) = %18.9e\n" - " Flattening coefficient = %18.9e\n" - "\n" - "Planetographic coordinates:\n" - "\n" - " Longitude (deg) = %18.9e\n" - " Latitude (deg) = %18.9e\n" - " Altitude (km) = %18.9e\n" - "\n" - "Planetographic velocity:\n" - "\n" - " d Longitude/dt (deg/s) = %18.9e\n" - " d Latitude/dt (deg/s) = %18.9e\n" - " d Altitude/dt (km/s) = %18.9e\n" - "\n" - "Rectangular coordinates from inverse mapping:\n" - "\n" - " X (km) = %18.9e\n" - " Y (km) = %18.9e\n" - " Z (km) = %18.9e\n" - "\n" - "Rectangular velocity from inverse mapping:\n" - "\n" - " dX/dt (km/s) = %18.9e\n" - " dY/dt (km/s) = %18.9e\n" - " dZ/dt (km/s) = %18.9e\n" - "\n", - state [0], - state [1], - state [2], - state [3], - state [4], - state [5], - re, - rp, - f, - lon / rpd_c(), - lat / rpd_c(), - alt, - pgrvel[0]/rpd_c(), - pgrvel[1]/rpd_c(), - pgrvel[2], - rectan [0], - rectan [1], - rectan [2], - drectn [0], - drectn [1], - drectn [2] ); - - return ( 0 ); - } - - - Output from this program should be similar to the following - (rounding and formatting differ across platforms): - - - Rectangular coordinates: - - X (km) = 1.460397325e+08 - Y (km) = 2.785466068e+08 - Z (km) = 1.197503153e+08 - - Rectangular velocity: - - dX/dt (km/s) = -4.704288238e+01 - dY/dt (km/s) = 9.070217780e+00 - dZ/dt (km/s) = 4.756562739e+00 - - Ellipsoid shape parameters: - - Equatorial radius (km) = 3.396190000e+03 - Polar radius (km) = 3.376200000e+03 - Flattening coefficient = 5.886007556e-03 - - Planetographic coordinates: - - Longitude (deg) = 2.976676591e+02 - Latitude (deg) = 2.084450403e+01 - Altitude (km) = 3.365318254e+08 - - Planetographic velocity: - - d Longitude/dt (deg/s) = -8.357386316e-06 - d Latitude/dt (deg/s) = 1.593493548e-06 - d Altitude/dt (km/s) = -1.121443268e+01 - - Rectangular coordinates from inverse mapping: - - X (km) = 1.460397325e+08 - Y (km) = 2.785466068e+08 - Z (km) = 1.197503153e+08 - - Rectangular velocity from inverse mapping: - - dX/dt (km/s) = -4.704288238e+01 - dY/dt (km/s) = 9.070217780e+00 - dZ/dt (km/s) = 4.756562739e+00 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 26-DEC-2004 (NJB) (WLT) - --Index_Entries - - Jacobian of planetographic w.r.t. rectangular coordinates - --& -*/ - -{ /* Begin dpgrdr_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "dpgrdr_c" ); - - /* - Check the input string body to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "dpgrdr_c", body ); - - /* - Call the f2c'd Fortran routine. - */ - dpgrdr_ ( ( char * ) body, - ( doublereal * ) &x, - ( doublereal * ) &y, - ( doublereal * ) &z, - ( doublereal * ) &re, - ( doublereal * ) &f, - ( doublereal * ) jacobi, - ( ftnlen ) strlen(body) ); - - /* - Convert Jacobian matrix to row-major order. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "dpgrdr_c" ); - -} /* End dpgrdr_c */ diff --git a/ext/spice/src/cspice/dpmax.c b/ext/spice/src/cspice/dpmax.c deleted file mode 100644 index 0f41e76c9c..0000000000 --- a/ext/spice/src/cspice/dpmax.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure dpmax_ ( Largest DP number ) - --Abstract - - Return the value of the largest (positive) number representable - in a double precision variable. - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble dpmax_ () - -/* - --Brief_I/O - - The function returns the value of the largest (positive) number - that can be represented in a double precision variable. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the largest (positive) number - that can be represented in a double precision variable. - - This value varies from machine to machine. The value is defined by - the macro DBL_MAX from the ANSI standard header file float.h. - According to the ANSI standard, DBL_MAX must be at least - - 1.E+37 - - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This function replaces that produced by running f2c on the Fortran - SPICELIB file dpmax.f. - --Examples - - The following code fragments illustrate the use of dpmax_. - Note in the second example that the smallest negative number - is not necessarily the negative of the largest positive number. - - 1) Set a range variable for a star or ephemeris object. - - /. - Compute the distance to each object. For stars, use - a "very large" distance. - ./ - - for ( i = 0; i < n; i++ ) - { - if ( strcmp ( type[i], "star" ) ) - { - /. - The object is not a star. - ./ - - range[i] = vnorm_c ( state[i] ); - } - else - { - range[i] = sqrt ( dpmax_() ) / 2.; - } - } - - - - 2) Initialize a CSPICE "window." - - /. - The window originally has one interval, from "minus - infinity" to "plus infinity". - ./ - - winsiz = 2; - window[0] = dpmin_(); - window[1] = dpmax_() ; - - scardd_ ( &winsiz, window ); - - --Restrictions - - 1) This routine should not be called from within users' applications. - Instead, use dpmax_c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 19-OCT-1998 (NJB) - --Index_Entries - - largest d.p. number - --& -*/ - -{ /* Begin dpmax_ */ - - - return ( DBL_MAX ); - - -} /* End dpmax_ */ - diff --git a/ext/spice/src/cspice/dpmax_c.c b/ext/spice/src/cspice/dpmax_c.c deleted file mode 100644 index 9c8befe490..0000000000 --- a/ext/spice/src/cspice/dpmax_c.c +++ /dev/null @@ -1,185 +0,0 @@ -/* - --Procedure dpmax_c ( Largest DP number ) - --Abstract - - Return the value of the largest (positive) number representable - in a double precision variable. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble dpmax_c () - -/* - --Brief_I/O - - The function returns the value of the largest (positive) number - that can be represented in a double precision variable. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the largest (positive) number - that can be represented in a double precision variable. - - This value varies from machine to machine. The value is defined by - the macro DBL_MAX from the ANSI standard header file float.h. - According to the ANSI standard, DBL_MAX must be at least - - 1.E+37 - - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns a constant value, set by the user - prior to compilation. - --Examples - - The following code fragments illustrate the use of dpmax_c. - Note in the second example that the smallest negative number - is not necessarily the negative of the largest positive number. - - 1) Set a range variable for a star or ephemeris object. - - /. - Compute the distance to each object. For stars, use - a "very large" distance. - ./ - - for ( i = 0; i < n; i++ ) - { - if ( strcmp ( type[i], "star" ) ) - { - /. - The object is not a star. - ./ - - range[i] = vnorm_c ( state[i] ); - } - else - { - range[i] = sqrt ( dpmax_c() ) / 2.; - } - } - - - - 2) Initialize a CSPICE "window." - - /. - The window originally has one interval, from "minus - infinity" to "plus infinity". - ./ - - winsiz = 2; - window[0] = dpmin_c(); - window[1] = dpmax_c() ; - - scardd_ ( &winsiz, window ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.0.0, 16-OCT-1998 (NJB) - --Index_Entries - - largest d.p. number - --& -*/ - -{ /* Begin dpmax_c */ - - /* - Static variables - */ - - static SpiceBoolean first = SPICETRUE; - static SpiceDouble value; - - - - if ( first ) - { - value = dpmax_(); - first = SPICEFALSE; - } - - return ( value ); - - -} /* End dpmax_c */ diff --git a/ext/spice/src/cspice/dpmin.c b/ext/spice/src/cspice/dpmin.c deleted file mode 100644 index 80c998ff89..0000000000 --- a/ext/spice/src/cspice/dpmin.c +++ /dev/null @@ -1,150 +0,0 @@ -/* - --Procedure dpmin_ ( Smallest DP number ) - --Abstract - - Return the value of the smallest (negative) number representable - in a double precision variable. - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble dpmin_ () - -/* - --Brief_I/O - - The function returns the value of the smallest (negative) number - that can be represented in a double precision variable. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the smallest (negative) number - that can be represented in a double precision variable. - - This value varies from machine to machine. Usually, the value is - defined as the negative of the macro DBL_MAX from the ANSI standard - header file float.h. According to the ANSI standard, DBL_MAX must be - at least - - 1.E+37 - - Therefore dpmin_ usually returns a value less than or equal to - - -1.E+37 - - Exceptional systems would be those where DBL_MAX cannot be negated. - Currently no such systems are supported. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns a constant value, set by the user - prior to compilation. - --Examples - - The following code fragments illustrate the use of dpmin_. - Note in the example that the smallest negative number is not assumed - to be the negative of the largest positive number. - - 1) Initialize a CSPICE "window." - - /. - The window originally has one interval, from "minus - infinity" to "plus infinity". - ./ - - winsiz = 2; - window[0] = dpmin_(); - window[1] = dpmax_c() ; - - scardd_ ( &winsiz, window ); - - --Restrictions - - 1) This routine should not be called from within users' applications. - Instead, use dpmin_c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 19-OCT-1998 (NJB) - --Index_Entries - - smallest d.p. number - --& -*/ - -{ /* Begin dpmin_ */ - - return ( - DBL_MAX ); - - -} /* End dpmin_ */ diff --git a/ext/spice/src/cspice/dpmin_c.c b/ext/spice/src/cspice/dpmin_c.c deleted file mode 100644 index 06bdfc5dc7..0000000000 --- a/ext/spice/src/cspice/dpmin_c.c +++ /dev/null @@ -1,163 +0,0 @@ -/* - --Procedure dpmin_c ( Smallest DP number ) - --Abstract - - Return the value of the smallest (negative) number representable - in a double precision variable. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble dpmin_c () - -/* - --Brief_I/O - - The function returns the value of the smallest (negative) number - that can be represented in a double precision variable. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the smallest (negative) number - that can be represented in a double precision variable. - - This value varies from machine to machine. Usually, the value is - defined as the negative of the macro DBL_MAX from the ANSI standard - header file float.h. According to the ANSI standard, DBL_MAX must be - at least - - 1.E+37 - - Therefore dpmin_c usually returns a value less than or equal to - - -1.E+37 - - Exceptional systems would be those where DBL_MAX cannot be negated. - Currently no such systems are supported. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns a constant value, set by the user - prior to compilation. - --Examples - - The following code fragments illustrate the use of dpmin_c. - Note in the example that the smallest negative number is not assumed - to be the negative of the largest positive number. - - 1) Initialize a CSPICE "window." - - /. - The window originally has one interval, from "minus - infinity" to "plus infinity". - ./ - - winsiz = 2; - window[0] = dpmin_c(); - window[1] = dpmax_c() ; - - scardd_ ( &winsiz, window ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 19-OCT-1998 (NJB) - --Index_Entries - - smallest d.p. number - --& -*/ - -{ /* Begin dpmin_c */ - - /* - Static variables - */ - - static SpiceBoolean first = SPICETRUE; - static SpiceDouble value; - - - - if ( first ) - { - value = dpmin_(); - first = SPICEFALSE; - } - - return ( value ); - - -} /* End dpmin_c */ diff --git a/ext/spice/src/cspice/dpr.c b/ext/spice/src/cspice/dpr.c deleted file mode 100644 index bb5fa92710..0000000000 --- a/ext/spice/src/cspice/dpr.c +++ /dev/null @@ -1,158 +0,0 @@ -/* dpr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DPR ( Degrees per radian ) */ -doublereal dpr_(void) -{ - /* Initialized data */ - - static doublereal value = 0.; - - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double acos(doublereal); - -/* $ Abstract */ - -/* Return the number of degrees per radian. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the number of degrees per radian. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the number of degrees per radian: 180/pi. */ -/* The value of pi is determined by the ACOS function. That is, */ - -/* DPR = 180.D0 / ACOS ( -1.D0 ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The first time the function is referenced, the value is computed */ -/* as shown above. The value is saved, and returned directly upon */ -/* subsequent reference. */ - -/* $ Examples */ - -/* The code fragment below illustrates the use of DPR. */ - -/* C */ -/* C Convert all angles to degrees for output. */ -/* C */ -/* CLOCK = CLOCK * DPR() */ -/* CONE = CONE * DPR() */ -/* TWIST = TWIST * DPR() */ - -/* or equivalently, */ - -/* C */ -/* C Convert all input angles to radians. */ -/* C */ -/* CALL VPACK ( CLOCK, CONE, CCTWIST, ALBTGAM ) */ -/* CALL VSCL ( DPR(), ALBTGAM, ALBTGAM ) */ -/* CALL VUPACK ( ALBTGAM, CLOCK, CONE, CCTWIST ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* degrees per radian */ - -/* -& */ - -/* Local variables */ - - -/* Initial values */ - - -/* What is there to say? */ - - if (value == 0.) { - value = 180. / acos(-1.); - } - ret_val = value; - return ret_val; -} /* dpr_ */ - diff --git a/ext/spice/src/cspice/dpr_c.c b/ext/spice/src/cspice/dpr_c.c deleted file mode 100644 index fa06eeed21..0000000000 --- a/ext/spice/src/cspice/dpr_c.c +++ /dev/null @@ -1,141 +0,0 @@ -/* - --Procedure dpr_c ( Degrees per radian ) - --Abstract - - Return the number of degrees per radian. - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble dpr_c ( void ) - -/* - --Brief_I/O - - The function returns the number of degrees per radian. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the number of degrees per radian: 180/pi. - The value of pi is determined by the ACOS function. That is, - - dpr_c = 180. / acos ( -1. ); - --Files - - None. - --Exceptions - - Error free. - --Particulars - - When he function is referenced, the value is computed - as shown above. - --Parameters - - None. - --Examples - - The code fragment below illustrates the use of dpr_c. - - Convert all angles to degrees for output. - - clock = clock * dpr_c(); - cone = cone * dpr_c(); - twist = twist * dpr_c(); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - degrees per radian - --& -*/ - - -/* Begin dpr_c */ - { - - /* - Local Variables - */ - - static SpiceDouble value = 0.; - - if (value == 0.) - { - value = 180. / acos(-1.); - } - - - /* - What is there to say? - */ - - return value; - - } -/* End dpr_c */ diff --git a/ext/spice/src/cspice/dpspce.c b/ext/spice/src/cspice/dpspce.c deleted file mode 100644 index 1f07ca0507..0000000000 --- a/ext/spice/src/cspice/dpspce.c +++ /dev/null @@ -1,795 +0,0 @@ -/* dpspce.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b19 = .66666666666666663; -static doublereal c_b20 = 3.5; -static doublereal c_b21 = 0.; -static doublereal c_b23 = 1.5; -static doublereal c_b24 = 1.; - -/* $Procedure DPSPCE ( Propagate a two line element set for deep space ) */ -/* Subroutine */ int dpspce_(doublereal *time, doublereal *geophs, doublereal - *elems, doublereal *state) -{ - /* Initialized data */ - - static logical doinit = TRUE_; - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double pow_dd(doublereal *, doublereal *), cos(doublereal), sqrt( - doublereal), sin(doublereal), d_mod(doublereal *, doublereal *), - atan2(doublereal, doublereal); - - /* Local variables */ - static doublereal coef, eeta, aodp, delo, capu, uang, xmdf, xinc, xmam, - aynl, elsq, temp; - static logical cont; - static doublereal rdot, cosu, sinu, coef1, t2cof, temp1, temp2, temp3, - temp4, temp5, cos2u, temp6; - extern /* Subroutine */ int zzdpinit_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - static doublereal sin2u, a, e; - static integer i__; - static doublereal m[3], n[3], s, u[3], v[3], betal, scale, betao; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static doublereal epoch, ecose, aycof, esine, a3ovk2, tempa, tempe, bstar, - cosio, xincl, etasq, rfdot, sinio, a1, rdotk, c1, c2, cosuk, c4, - qoms24, sinuk, templ, x1m5th, x1mth2, x3thm1, x7thm1, psisq, - xinck, xlcof, xmdot, xnode, xnodp; - extern doublereal twopi_(void); - static doublereal s4; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - static doublereal betao2, theta2, ae, xhdot1, ao, em, eo, qoms2t, pl, - omgadf, rk, qo, uk, so; - extern doublereal halfpi_(void); - static doublereal xl, xn, omegao; - extern /* Subroutine */ int latrec_(doublereal *, doublereal *, - doublereal *, doublereal *); - static doublereal perige, xnodcf, xnoddf, tsince, xnodek, omgdot, rfdotk, - xnodeo; - extern /* Subroutine */ int chkout_(char *, ftnlen); - static doublereal ck2, lstelm[10], ck4, cosepw, sinepw, xkmper, xnodot, - lstphs[8]; - extern logical return_(void); - static doublereal pinvsq, xj2, xj3, xj4, eta, axn, xke, ayn, epw, tsi, - xll, xmo, xno, tsq, xlt, del1; - extern /* Subroutine */ int zzdpsec_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - static doublereal pio2; - extern /* Subroutine */ int zzdpper_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - static doublereal pix2; - -/* $ Abstract */ - -/* This routine propagates NORAD two-line element data for */ -/* earth orbiting deep space vehicles (a vehicle with an */ -/* orbital period more than 225 minutes). */ - -/* $ 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 */ - -/* EPHEMERIS */ -/* TWO LINE ELEMENTS */ -/* DEEP SPACE PROPAGATOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TIME I Time for state evaluation in seconds past ephemeris */ -/* epoch J2000. */ -/* GEOPHS I The array of geophysical constants */ -/* ELEMS I Array of orbit elements */ -/* STATE O State vector at TIME */ - -/* $ Detailed_Input */ - -/* TIME is the epoch in seconds past ephemeris epoch J2000 */ -/* to produced a state from the input elements. */ - -/* GEOPHS is a collection of 8 geophysical constants needed */ -/* for computing a state. The order of these */ -/* constants must be: */ - -/* GEOPHS(1) = J2 gravitational harmonic for earth */ -/* GEOPHS(2) = J3 gravitational harmonic for earth */ -/* GEOPHS(3) = J4 gravitational harmonic for earth */ - -/* These first three constants are dimensionless. */ - -/* GEOPHS(4) = KE: Square root of the GM for earth where */ -/* GM is expressed in earth radii cubed per */ -/* minutes squared. */ - -/* GEOPHS(5) = QO: Low altitude bound for atmospheric */ -/* model in km. */ - -/* GEOPHS(6) = SO: High altitude bound for atmospheric */ -/* model in km. */ - - -/* GEOPHS(7) = RE: Equatorial radius of the earth in km. */ - - -/* GEOPHS(8) = AE: Distance units/earth radius */ -/* (normally 1) */ - -/* Below are currently recommended values for these */ -/* items: */ - -/* J2 = 1.082616D-3 */ -/* J3 = -2.53881D-6 */ -/* J4 = -1.65597D-6 */ - -/* The next item is the square root of GM for the */ -/* earth given in units of earth-radii**1.5/Minute */ - -/* KE = 7.43669161D-2 */ - -/* The next two items define the top and */ -/* bottom of the atmospheric drag model */ -/* used by the type 10 ephemeris type. */ -/* Don't adjust these unless you understand */ -/* the full implications of such changes. */ - -/* QO = 120.0D0 */ -/* SO = 78.0D0 */ - -/* The ER value is the equatorial radius in km */ -/* of the earth as used by NORAD. */ - -/* ER = 6378.135D0 */ - -/* The value of AE is the number of */ -/* distance units per earth radii used by */ -/* the NORAD state propagation software. */ -/* The value is 1 unless you've got */ -/* a very good understanding of the NORAD */ -/* routine SGP4 and the affect of changing */ -/* this value.. */ - -/* AE = 1.0D0 */ - -/* ELEMS is an array containing two-line element data */ -/* as prescribed below. The elements XNDD6O and BSTAR */ -/* must have been scaled by the proper exponent stored */ -/* in the two line elements set. Moreover, the */ -/* various items must be converted to the units shown */ -/* here. */ - -/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */ -/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */ -/* ELEMS ( 3 ) = BSTAR */ -/* ELEMS ( 4 ) = XINCL in radians */ -/* ELEMS ( 5 ) = XNODEO in radians */ -/* ELEMS ( 6 ) = EO */ -/* ELEMS ( 7 ) = OMEGAO in radians */ -/* ELEMS ( 8 ) = XMO in radians */ -/* ELEMS ( 9 ) = XNO in radians/minute */ -/* ELEMS ( 10 ) = EPOCH of the elements in seconds */ -/* past ephemeris epoch J2000. */ - -/* $ Detailed_Output */ - -/* STATE A 6 vector containing the X, Y, Z, Vx, Vy, Vz */ -/* coordinates in the inertial frame (double */ -/* precision). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This subroutine is an extensive rewrite of the SDP4 */ -/* routine as described in the Spacetrack 3 report. All common */ -/* blocks were removed and all variables are explicitly defined. */ - -/* The removal of common blocks causes the set of routines to */ -/* execute slower than the original version of SDP4. However the */ -/* stability improves especially as concerns memory and */ -/* expanded internal documentation. */ - -/* Trivial or redundant variables have been eliminated. */ - -/* R removed, occurrence replaced with RK */ -/* E6A renamed TOL */ -/* THETA4 removed, relevant equation recast in Horner's form */ -/* i.e. something like x^4 + x^2 -> x^2 ( x^2 + 1 ) */ -/* U renamed UANG, U is now a euclidean 3 vector. */ -/* Ux,Uy,Uz removed, replaced with 3-vector U */ -/* Vx,Vy,Vz removed, replaced with 3-vector V */ -/* OMEGAQ removed, usage replaced with OMEGAO */ -/* OMGDT removed, same variable as OMGDOT, so all occurrences */ -/* replaced with OMGDOT */ -/* SSL,SSG replaced with the 5-vector SSX */ -/* SSH,SSE */ -/* SSI */ - -/* Three functions present in the original Spacetrack report, ACTAN, */ -/* FMOD2P and THETAG, have been either replaced with an intrinsic */ -/* FORTRAN function (ACTAN -> DATAN2, FMOD2P -> DMOD) or recoded */ -/* using SPICELIB calls (THETAG). */ - -/* The code at the end of this subroutine which calculates */ -/* orientation vectors, was replaced with a set of calls to */ -/* SPICELIB vector routines. */ - -/* A direct comparison of output from the original Spacetrack 3 code */ -/* and these NAIF routines for the same elements and time parameters */ -/* will produce unacceptably different results. */ - -/* $ Examples */ - - -/* C--- Load the geophysical constants kernel and the leapsecond */ -/* kernel */ -/* CALL FURNSH( '/Users/ewright/lib/geophysical.ker' ) */ -/* CALL FURNSH( '/kernels/gen/lsk/naif0008.tls' ) */ - - -/* C--- Define a vehicle element array, TDRS 4 Geosynch */ -/* LINES( 1 ) = '1 19883U 89021B 97133.05943164 -.00000277 ' */ -/* .// '00000-0 10000-3 0 3315' */ -/* LINES( 2 ) = '2 19883 0.5548 86.7278 0001786 312.2904 ' */ -/* .// '172.2391 1.00269108202415' */ - - -/* C--- Identify the earliest first year for the elements */ -/* FRSTYR = 1988 */ - - -/* C--- Parse the elements to something SPICE can use */ -/* CALL GETELM ( FRSTYR, LINES, EPOCH, ELEMS ) */ - - -/* C--- Final time past epoch, 1400 mins (in seconds) */ -/* TF = 1440.D0 * 60.D0 */ - -/* C--- Step size for elements output 360 mins (in seconds) */ -/* DELT = 360.D0 * 60.D0 */ - -/* C--- Start time keyed off epoch */ -/* TIME = EPOCH - 2.D0 * DELT */ - -/* DO WHILE ( DABS(TIME - EPOCH) .LE. DABS(TF) ) */ - -/* CALL DPSPCE ( TIME, GEOPHS, ELEMS, STATE ) */ - -/* WRITE(*, FMT ='(7F17.8)' ) (TIME-EPOCH)/60.D0, */ -/* . (STATE(I),I=1,6) */ - -/* TIME = TIME + DELT */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* Spacetrack 3 report. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.2.1, DEC-27-2000 (EDW) */ - -/* Corrected error in header documentation. Horner's Rule */ -/* not Butcher's. */ - -/* - SPICELIB Version 1.2.0, MAR-24-1999 (EDW) */ - -/* Documentation expanded to include modifications made */ -/* to private routines. Some english errors corrected. */ - -/* Alphabetized variable declaration lists. */ - -/* Temporary variable TEMP removed. OMGDOT argument added to */ -/* ZZDPSEC call. */ - -/* - SPICELIB Version 1.1.0, OCT-05-1998 (WLT) */ - -/* Forced initialization section until we can figure out */ -/* why it doesn't work on SUNs. */ - -/* - SPICELIB Version 1.0.1, MAR-11-1998 (EDW) */ - -/* Corrected error in header describing GEOPHS array. */ - -/* - SPICELIB Version 1.0.0, NOV-11-1998 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* NORAD two line elements, deep space, Cheyenne Mountain */ - -/* -& */ - -/* Local variables */ - - -/* Define parameters for convergence tolerance and the value for 2/3, */ -/* 0 and 1. */ - - -/* The geophysical Quantities */ - - -/* Elements */ - - -/* Other quantities */ - - -/* SPICELIB routines */ - - -/* Save everything. */ - - -/* Set initialization flags */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DPSPCE", (ftnlen)6); - } - -/* If this is the very first time into this routine, set these */ -/* values. */ - - if (first) { - pix2 = twopi_(); - pio2 = halfpi_(); - first = FALSE_; - } - -/* If initialization flag is FALSE, then this is not the first */ -/* call to this routine. Check the stuff. */ - - if (! doinit) { - -/* Check whether the current and last constants and elements */ -/* match. If not, we need to reinitialize everything */ -/* since the propagation is dependent on the value of these */ -/* arrays. */ - - for (i__ = 1; i__ <= 8; ++i__) { - if (lstphs[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "lstphs", i__1, "dpspce_", (ftnlen)537)] != geophs[(i__2 = - i__ - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("geophs", i__2, - "dpspce_", (ftnlen)537)]) { - doinit = TRUE_; - } - } - for (i__ = 1; i__ <= 10; ++i__) { - if (lstelm[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "lstelm", i__1, "dpspce_", (ftnlen)546)] != elems[(i__2 = - i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("elems", i__2, - "dpspce_", (ftnlen)546)]) { - doinit = TRUE_; - } - } - } - -/* Initialization block. Always called on the initial entry and */ -/* anytime the geophysical or elements array changes. */ - - if (doinit) { - doinit = FALSE_; - -/* Retrieve the geophysical constants from the GEOPHS array */ - - xj2 = geophs[0]; - xj3 = geophs[1]; - xj4 = geophs[2]; - xke = geophs[3]; - qo = geophs[4]; - so = geophs[5]; - xkmper = geophs[6]; - ae = geophs[7]; - -/* Save the geophysical constants for later comparison */ - - for (i__ = 1; i__ <= 8; ++i__) { - lstphs[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("lstphs", - i__1, "dpspce_", (ftnlen)581)] = geophs[(i__2 = i__ - 1) - < 8 && 0 <= i__2 ? i__2 : s_rnge("geophs", i__2, "dpspce_" - , (ftnlen)581)]; - } - -/* Unpack the elements array. */ - - bstar = elems[2]; - xincl = elems[3]; - xnodeo = elems[4]; - eo = elems[5]; - omegao = elems[6]; - xmo = elems[7]; - xno = elems[8]; - epoch = elems[9]; - -/* Save the elements for later comparison */ - - for (i__ = 1; i__ <= 10; ++i__) { - lstelm[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lstelm" - , i__1, "dpspce_", (ftnlen)601)] = elems[(i__2 = i__ - 1) - < 10 && 0 <= i__2 ? i__2 : s_rnge("elems", i__2, "dpspce_" - , (ftnlen)601)]; - } - -/* Set common variables, the init flag and calculate the */ -/* WGS-72 physical and geopotential constants */ - -/* CK2 = 0.5 * J2 * AE^2 */ -/* CK4 = -0.375 * J4 * AE^4 */ - -/* These are values calculated only once and then saved for */ -/* future access. */ - -/* Computing 2nd power */ - d__1 = ae; - ck2 = xj2 * .5 * (d__1 * d__1); -/* Computing 4th power */ - d__1 = ae, d__1 *= d__1; - ck4 = xj4 * -.375 * (d__1 * d__1); -/* Computing 4th power */ - d__1 = (qo - so) * ae / xkmper, d__1 *= d__1; - qoms2t = d__1 * d__1; - s = ae * (so / xkmper + 1.); - -/* Recover original mean motion (XNODP) and semimajor axis (AODP) */ -/* from input elements */ - - d__1 = xke / xno; - a1 = pow_dd(&d__1, &c_b19); - cosio = cos(xincl); -/* Computing 2nd power */ - d__1 = cosio; - theta2 = d__1 * d__1; - x3thm1 = theta2 * 3. - 1.; -/* Computing 2nd power */ - d__1 = eo; - betao2 = 1. - d__1 * d__1; - betao = sqrt(betao2); -/* Computing 2nd power */ - d__1 = a1; - del1 = ck2 * 1.5 * x3thm1 / (d__1 * d__1 * betao * betao2); - ao = a1 * (1. - del1 * (del1 * (del1 * 1.654320987654321 + 1.) + - .33333333333333331)); -/* Computing 2nd power */ - d__1 = ao; - delo = ck2 * 1.5 * x3thm1 / (d__1 * d__1 * betao * betao2); - xnodp = xno / (delo + 1.); - aodp = ao / (1. - delo); - -/* For perigee below 156 km, the values of S and QOMS2T are */ -/* altered */ - - s4 = s; - qoms24 = qoms2t; - perige = (aodp * (1. - eo) - ae) * xkmper; - if (perige < 156.) { - s4 = perige - 78.; - if (perige > 98.) { -/* Computing 4th power */ - d__1 = (120. - s4) * ae / xkmper, d__1 *= d__1; - qoms24 = d__1 * d__1; - s4 = s4 / xkmper + ae; - } else { - s4 = 20.; - } - } -/* Computing 2nd power */ - d__1 = aodp; -/* Computing 2nd power */ - d__2 = betao2; - pinvsq = 1. / (d__1 * d__1 * (d__2 * d__2)); - tsi = 1. / (aodp - s4); - eta = aodp * eo * tsi; -/* Computing 2nd power */ - d__1 = eta; - etasq = d__1 * d__1; - eeta = eo * eta; - psisq = (d__1 = 1. - etasq, abs(d__1)); -/* Computing 4th power */ - d__1 = tsi, d__1 *= d__1; - coef = qoms24 * (d__1 * d__1); - coef1 = coef / pow_dd(&psisq, &c_b20); - c2 = coef1 * xnodp * (aodp * (etasq * 1.5 + 1. + eeta * (etasq + 4.)) - + ck2 * .75 * tsi / psisq * x3thm1 * (etasq * 3. * (etasq + - 8.) + 8.)); - c1 = bstar * c2; - sinio = sin(xincl); -/* Computing 3rd power */ - d__1 = ae; - a3ovk2 = -xj3 / ck2 * (d__1 * (d__1 * d__1)); - x1mth2 = 1. - theta2; - c4 = xnodp * 2. * coef1 * aodp * betao2 * (eta * (etasq * .5 + 2.) + - eo * (etasq * 2. + .5) - ck2 * 2. * tsi / (aodp * psisq) * ( - x3thm1 * -3. * (1. - eeta * 2. + etasq * (1.5 - eeta * .5)) + - x1mth2 * .75 * (etasq * 2. - eeta * (etasq + 1.)) * cos( - omegao * 2.))); - temp1 = ck2 * 3. * pinvsq * xnodp; - temp2 = temp1 * ck2 * pinvsq; - temp3 = ck4 * 1.25 * pinvsq * pinvsq * xnodp; - xmdot = xnodp + temp1 * .5 * betao * x3thm1 + temp2 * .0625 * betao * - (theta2 * (theta2 * 137. - 78.) + 13.); - x1m5th = 1. - theta2 * 5.; - omgdot = temp1 * -.5 * x1m5th + temp2 * .0625 * (theta2 * (theta2 * - 395. - 114.) + 7.) + temp3 * (theta2 * (theta2 * 49. - 36.) + - 3.); - xhdot1 = -temp1 * cosio; - xnodot = xhdot1 + (temp2 * .5 * (4. - theta2 * 19.) + temp3 * 2. * ( - 3. - theta2 * 7.)) * cosio; - xnodcf = betao2 * 3.5 * xhdot1 * c1; - t2cof = c1 * 1.5; - xlcof = a3ovk2 * .125 * sinio * (cosio * 5. + 3.) / (cosio + 1.); - aycof = a3ovk2 * .25 * sinio; - x7thm1 = theta2 * 7. - 1.; - -/* Initialize for Deep Space */ - - zzdpinit_(&aodp, &xmdot, &omgdot, &xnodot, &xnodp, elems); - -/* Initialize the periodic perturbations to the epoch. */ -/* This is required because perturbations are zero at the */ -/* epoch. */ - - omgadf = elems[6]; - xnoddf = elems[4]; - xmam = elems[7]; - e = elems[5]; - zzdpper_(&c_b21, &e, &xinc, &omgadf, &xnoddf, &xmam); - -/* Initialization complete. Rejoice! */ - - } - -/* Get the time since the EPOCH in minutes. */ - - tsince = (*time - epoch) / 60.; - -/* Update for secular gravity and atmospheric drag */ - - xmdf = xmo + xmdot * tsince; - omgadf = omegao + omgdot * tsince; - xnoddf = xnodeo + xnodot * tsince; - tsq = tsince * tsince; - xnode = xnoddf + xnodcf * tsq; - tempa = 1. - c1 * tsince; - tempe = bstar * c4 * tsince; - templ = t2cof * tsq; - xn = xnodp; - -/* Calculate the secular terms. */ - - zzdpsec_(&xmdf, &omgadf, &xnode, &em, &xinc, &xn, &tsince, elems, &omgdot) - ; - d__1 = xke / xn; -/* Computing 2nd power */ - d__2 = tempa; - a = pow_dd(&d__1, &c_b19) * (d__2 * d__2); - e = em - tempe; - xmam = xmdf + xnodp * templ; - -/* Calculate the periodic terms. */ - - zzdpper_(&tsince, &e, &xinc, &omgadf, &xnode, &xmam); - xl = xmam + omgadf + xnode; - xn = xke / pow_dd(&a, &c_b23); - -/* Long period periodics */ - - axn = e * cos(omgadf); -/* Computing 2nd power */ - d__1 = e; - temp = 1. / (a * (1. - d__1 * d__1)); - xll = temp * xlcof * axn; - aynl = temp * aycof; - xlt = xl + xll; - ayn = e * sin(omgadf) + aynl; - -/* Solve Kepler's equation */ - -/* U = EPW - AXN * SIN(EPW) + AYN * COS(EPW) */ - -/* Where */ - -/* AYN = E * SIN(OMEGA) + AYNL */ -/* AXN = E * COS(OMEGA) */ - -/* And */ - -/* AYNL = -0.50D0 * SINIO * AE * J3 / (J2 * A * (1.0D0 - E^2)) */ - - -/* Get the mod division of CAPU with 2 Pi */ - - d__1 = xlt - xnode; - capu = d_mod(&d__1, &pix2); - if (capu < 0.) { - capu += pix2; - } - -/* Set initial states for the Kepler solution */ - - epw = capu; - cont = TRUE_; - while(cont) { - temp2 = epw; - sinepw = sin(temp2); - cosepw = cos(temp2); - temp3 = axn * sinepw; - temp4 = ayn * cosepw; - temp5 = axn * cosepw; - temp6 = ayn * sinepw; - epw = (capu - temp4 + temp3 - temp2) / (1. - temp5 - temp6) + temp2; - -/* Test for convergence against the defined tolerance */ - - if ((d__1 = epw - temp2, abs(d__1)) <= 1e-6) { - cont = FALSE_; - } - } - -/* Short period preliminary quantities */ - - ecose = temp5 + temp6; - esine = temp3 - temp4; - elsq = axn * axn + ayn * ayn; - temp = 1. - elsq; - pl = a * temp; - rk = a * (1. - ecose); - temp1 = 1. / rk; - rdot = xke * sqrt(a) * esine * temp1; - rfdot = xke * sqrt(pl) * temp1; - temp2 = a * temp1; - betal = sqrt(temp); - temp3 = 1. / (betal + 1.); - cosu = temp2 * (cosepw - axn + ayn * esine * temp3); - sinu = temp2 * (sinepw - ayn - axn * esine * temp3); - -/* Compute the angle from the x-axis of the point ( COSU, SINU ) */ - - if (sinu != 0. || cosu != 0.) { - uang = atan2(sinu, cosu); - if (uang < 0.) { - uang += pix2; - } - } else { - uang = 0.; - } - -/* Boo! */ - - sin2u = sinu * 2. * cosu; - cos2u = cosu * 2. * cosu - 1.; - temp1 = ck2 * (1. / pl); - temp2 = temp1 * (1. / pl); - -/* Update for short periodics */ - - rk = rk * (1. - temp2 * 1.5 * betal * x3thm1) + temp1 * .5 * x1mth2 * - cos2u; - uk = uang - temp2 * .25 * x7thm1 * sin2u; - xnodek = xnode + temp2 * 1.5 * cosio * sin2u; - xinck = xinc + temp2 * 1.5 * cosio * sinio * cos2u; - rdotk = rdot - xn * temp1 * x1mth2 * sin2u; - rfdotk = rfdot + xn * temp1 * (x1mth2 * cos2u + x3thm1 * 1.5); - -/* Orientation vectors are calculated by */ - -/* U = M sin(uk) + N cos(uk) */ -/* V = M cos(uk) - N sin(uk) */ - -/* Where M and N are euclidean 3 vectors */ - -/* M = (-sin(xnodek)cos(xinck), cos(xnodek)cos(xinck), sin(xinck) ) */ -/* N = ( cos(xnodek), sin(xnodek) , 0 ) */ - - sinuk = sin(uk); - cosuk = cos(uk); - -/* Use LATREC to generate M and N. M is a latitude to rectangle */ -/* conversion of a unit vector where PI/2 + XNODEK is the longitude */ - - d__1 = pio2 + xnodek; - latrec_(&c_b24, &d__1, &xinck, m); - latrec_(&c_b24, &xnodek, &c_b21, n); - -/* Sum the components to obtain U and V */ - - vlcom_(&sinuk, m, &cosuk, n, u); - d__1 = -sinuk; - vlcom_(&cosuk, m, &d__1, n, v); - -/* Determine the position and velocity then pack the STATE vector */ -/* with value scaled to KM and KPS. */ - -/* R = RK U + 0 V */ -/* V = RKDOT U + RK RFDOT V */ - - scale = xkmper / ae; - d__1 = rk * scale; - vlcom_(&d__1, u, &c_b21, v, state); - -/* Now scale to KPS for the velocity component */ - - scale /= 60.; - d__1 = rdotk * scale; - d__2 = rfdotk * scale; - vlcom_(&d__1, u, &d__2, v, &state[3]); - -/* All done now.... */ - - chkout_("DPSPCE", (ftnlen)6); - return 0; -} /* dpspce_ */ - diff --git a/ext/spice/src/cspice/dpstr.c b/ext/spice/src/cspice/dpstr.c deleted file mode 100644 index 3e5ef4f917..0000000000 --- a/ext/spice/src/cspice/dpstr.c +++ /dev/null @@ -1,472 +0,0 @@ -/* dpstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure DPSTR ( Double Precision Number to Character ) */ -/* Subroutine */ int dpstr_(doublereal *x, integer *sigdig, char *string, - ftnlen string_len) -{ - /* Initialized data */ - - static doublereal power[18] = { 1.,10.,100.,1e3,1e4,1e5,1e6,1e7,1e8,1e9, - 1e10,1e11,1e12,1e13,1e14,1e15,1e16,1e17 }; - static doublereal ipower[18] = { 1.,.1,.01,.001,1e-4,1e-5,1e-6,1e-7,1e-8, - 1e-9,1e-10,1e-11,1e-12,1e-13,1e-14,1e-15,1e-16,1e-17 }; - static char digits[1*10] = "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"; - static doublereal values[10] = { 0.,1.,2.,3.,4.,5.,6.,7.,8.,9. }; - static char vaxexp[2*41] = "00" "01" "02" "03" "04" "05" "06" "07" "08" - "09" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20" "21" - "22" "23" "24" "25" "26" "27" "28" "29" "30" "31" "32" "33" "34" - "35" "36" "37" "38" "39" "40"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - double d_lg10(doublereal *); - integer s_rnge(char *, integer, char *, integer); - double d_nint(doublereal *); - - /* Local variables */ - doublereal exp10; - char expc[20]; - integer last; - doublereal copy; - char zero[28]; - integer i__, k, postn, maxsig, expont; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - char numstr[32]; - -/* $ Abstract */ - -/* Take a double precision number and convert it to */ -/* an equivalent character string representation (base 10). */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I A double precision number */ -/* SIGDIG I The number of significant digits placed in output */ -/* STRING O A character string representation of X */ - -/* $ Detailed_Input */ - -/* X is a double precision number. */ - -/* SIGDIG is the number of significant digits that are desired */ -/* for the output string. */ - -/* $ Detailed_Output */ - - -/* STRING is a character representation of X to the number of */ -/* significant digits specified by SIGDIG. The number of */ -/* spaces required to return the requested character */ -/* string is SIGDIG + 6. If STRING is not declared to */ -/* have adequate length, the number returned will be */ -/* truncated on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes an approximate character representation */ -/* of the input string X. The maximum number of significant */ -/* digits returned is 14. The representation returned will be */ -/* the same as that given by the FORTRAN write statement */ - -/* WRITE ( STRING, FMT=(P1E23.xx) */ - -/* where xx is a two digit number that represents MIN(14,SIGDIG). */ -/* The last decimal place is rounded. The output string is left */ -/* justified. */ - -/* This routine has the advantage that it does not use an internal */ -/* file and is about 2.3 times as fast as an internal write. It can */ -/* be used as part of character function without fear of introducing */ -/* recursive I/O conflicts. It is intended to be an approximate */ -/* inverse to the subroutine NPARSD. */ - -/* There is of course no formatting of the output string. All */ -/* outputs are written in scientific notation. */ - -/* IF you want the character string representation of a double */ -/* precision number to be the same as that produced by a formatted */ -/* write statement use a FORTRAN write statement. */ - -/* For example the number represented by the string */ - -/* 1.245454545454545454545E+01 */ - -/* when read (via a FORTRAN READ statement) into the DP variable X */ -/* and converted back to a character string having 14 significant */ -/* digits by this routine yields */ - -/* 1.2454545454545E+01 */ - -/* The FORTRAN write statement */ - -/* WRITE ( 6, FMT='(P1E)' ) X */ - -/* yields */ - -/* 1.2454545454545454E+01 */ - -/* If this is too much error for your application DO NOT use this */ -/* routine. You should be aware however, that a character string */ -/* read into a double precision number may not WRITE out with an */ -/* equivalent character representation as was input. */ - -/* For example on a VAX 11/780 if you */ - -/* READ (5,*) X */ -/* WRITE (6,FMT='(E)') X */ - -/* and enter a value of 7.00000001 for the read statement */ -/* the output written will be 0.7000000010000001E+01 */ - - -/* $ Examples */ - -/* This routine is intended for use by routines that manipulate */ -/* character strings. For example, it may be desirable for a */ -/* routine to be able to take a character string input such as */ - -/* 12 miles */ - -/* and convert it to the string */ - -/* 1.932E+02 km */ - -/* or to simply */ - -/* 1.932E+02 */ - -/* The arithmetic is of course most easily handled using numeric */ -/* variables. However, it may be that a string is required for */ -/* subsequent processing of the input. A SPICELIB routine NPARSD */ -/* exists that will take a character representation of a number */ -/* and convert it to a DOUBLE PRECISION number. The 12 above */ -/* can be converted to double precision using NPARSD, the d.p. */ -/* number can then be multiplied by the 1.61... and the result */ -/* converted back to a string using this routine. */ - -/* Suppose the following declarations are made */ - -/* CHARACTER*(80) TEXT */ -/* CHARACTER*(80) NUMBER */ -/* CHARACTER*(80) SCRATCH */ - -/* DOUBLE PRECISION X */ -/* INTEGER I */ - -/* and that TEXT contains the string '12 mi'. Then the following */ -/* code would produce a character string '1.932E+01 KM' */ - -/* CALL NEXTWD ( TEXT, NUMBER, SCRATCH ) */ -/* CALL NPARSD ( NUMBER, X, ERROR, I ) */ - -/* IF ( ERROR .EQ. ' ' ) THEN */ - -/* X = X * 1.61D0 */ -/* CALL DPSTR ( X, 5, NUMBER ) */ -/* TEXT = NUMBER(1:10) // 'KM' */ - -/* ELSE */ -/* . */ -/* . */ -/* create an error message, try again, etc. */ -/* . */ -/* . */ -/* END IF */ - - -/* $ Restrictions */ - -/* Note: The format of the string returned by this routine is */ -/* used in DPSTRF which is in the call tree to DPFMT. Changes */ -/* to the format of the output string may have unexpected */ -/* consequences for these SPICE routines. Please check those */ -/* routines before modifying this routine. */ - -/* The maximum number of significant digits returned is 14. */ - -/* If the output string is not declared to be adequately large */ -/* (at least SIGDIG + 6), the numeric string will be truncated */ -/* to the side opposite its justification. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If SIGDIG is less than one, this routine returns one significant */ -/* digit in the output string. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 09-SEP-1996 (WLT) */ - -/* Added a reference to the header concerning the dependency */ -/* of the SPICE routines DPSTRF and DPFMT on the format of */ -/* the string produced by this routine. */ - -/* - SPICELIB Version 1.1.0, 11-JUN-1992 (WLT) */ - -/* A bug that caused this routine to have a floating point */ -/* overflow for values of X close to zero was corrected. In */ -/* addition the restriction on range of exponents supported */ -/* has been removed. */ - -/* - 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 */ - -/* d.p. number to character */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1992 (WLT) */ - -/* A bug that caused this routine to have a floating point */ -/* overflow for values of X close to zero was corrected. In */ -/* addition the restriction on range of exponents supported */ -/* has been removed. */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (HAN) (NJB) */ - -/* Header was changed to reflect the "error free" status */ -/* of the module, and a comment was added stating what the */ -/* routine does if SIGIDG is less than one. */ - -/* Declaration of the unused variable FRAC removed. */ - -/* -& */ - -/* Maximum number of allowed significant digits. */ - - -/* Local variables */ - - -/* Transfer X to the local variable COPY and leave X alone for the */ -/* rest of the routine. */ - - copy = *x; - -/* Wipe out anything sitting in NUMSTR */ - - s_copy(numstr, " ", (ftnlen)32, (ftnlen)1); - -/* At least 1 significant digit is required. The most allowed is 14. */ -/* MAXSIG is the integer in this range that is closest to SIGDIG. */ - -/* Computing MIN */ - i__1 = 14, i__2 = max(1,*sigdig); - maxsig = min(i__1,i__2); - -/* Examine COPY to see if its positive, zero, or negative. */ -/* This determines whether we need a minus sign and where the */ -/* decimal point needs to go in the output string. */ - - if (copy < 0.) { - *(unsigned char *)numstr = '-'; - copy = -copy; - postn = 2; - *(unsigned char *)&numstr[2] = '.'; - } else if (copy > 0.) { - *(unsigned char *)numstr = ' '; - postn = 2; - *(unsigned char *)&numstr[2] = '.'; - } else { - s_copy(zero, " 0.0000000000000000000000000", (ftnlen)28, (ftnlen)28); -/* Writing concatenation */ - i__3[0] = maxsig + 2, a__1[0] = zero; - i__3[1] = 4, a__1[1] = "E+00"; - s_cat(numstr, a__1, i__3, &c__2, (ftnlen)32); - s_copy(string, numstr, string_len, (ftnlen)32); - return 0; - } - -/* We need a first guess at the exponent string. Compute the LOG */ -/* base 10 of COPY */ - - exp10 = d_lg10(©); - -/* Scale our copy of the input into the range 1 to 10. */ - - if (exp10 < 0.) { - -/* In this case the exponent will be negative. We want the */ -/* largest integer exponent less than EXP10, but the FORTRAN */ -/* INT function gives the INTEGER closest to EXP10 between EXP10 */ -/* and zero. As a result we have to subtract 1 from INT(EXP10). */ - - expont = (integer) exp10 - 1; - k = -expont; - while(k > 16) { - copy *= 1e16; - k += -16; - } - if (k != 0) { - copy *= power[(i__1 = k) < 18 && 0 <= i__1 ? i__1 : s_rnge("power" - , i__1, "dpstr_", (ftnlen)434)]; - } - } else { - expont = (integer) exp10; - k = expont; - while(k > 16) { - copy *= 1e-16; - k += -16; - } - if (k != 0) { - copy *= ipower[(i__1 = k) < 18 && 0 <= i__1 ? i__1 : s_rnge("ipo" - "wer", i__1, "dpstr_", (ftnlen)449)]; - } - } - -/* Round off the last significant digit. */ - - d__1 = copy * power[(i__1 = maxsig - 1) < 18 && 0 <= i__1 ? i__1 : s_rnge( - "power", i__1, "dpstr_", (ftnlen)460)]; - copy = (d_nint(&d__1) + .125) * ipower[(i__2 = maxsig - 1) < 18 && 0 <= - i__2 ? i__2 : s_rnge("ipower", i__2, "dpstr_", (ftnlen)460)]; - -/* We might have accidently made copy as big as 10 by the */ -/* round off process. If we did we need to divide by 10 and add 1 */ -/* to the exponent value. (COPY must always remain between 0 and 10) */ - - if (copy >= 10.) { - copy *= .1; - ++expont; - } - -/* Get the first digit of the decimal expansion of X. */ - - i__ = (integer) copy; - *(unsigned char *)&numstr[postn - 1] = *(unsigned char *)&digits[(i__1 = - i__) < 10 && 0 <= i__1 ? i__1 : s_rnge("digits", i__1, "dpstr_", ( - ftnlen)476)]; - copy = (copy - values[(i__1 = i__) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "values", i__1, "dpstr_", (ftnlen)478)]) * 10.; - -/* Set the string pointer to the next position and compute the */ -/* position of the last significant digit */ - - postn += 2; - last = postn + maxsig - 1; - -/* Fetch digits until we fill in the last available slot for */ -/* significant digits. */ - - while(postn < last) { - i__ = (integer) copy; - *(unsigned char *)&numstr[postn - 1] = *(unsigned char *)&digits[( - i__1 = i__) < 10 && 0 <= i__1 ? i__1 : s_rnge("digits", i__1, - "dpstr_", (ftnlen)494)]; - copy = (copy - values[(i__1 = i__) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "values", i__1, "dpstr_", (ftnlen)495)]) * 10.; - ++postn; - } - -/* Tack on the exponent to the output. Note that the rather odd */ -/* if, else if, else construction below is done to maintain backward */ -/* compatibility of the "look" of the output. */ - -/* First get the exponent symbol and sign of the exponent. */ - - if (expont >= 0) { - s_copy(numstr + (postn - 1), "E+", 32 - (postn - 1), (ftnlen)2); - } else { - expont = -expont; - s_copy(numstr + (postn - 1), "E-", 32 - (postn - 1), (ftnlen)2); - } - postn += 2; - -/* Now get the numeric representation. */ - - if (expont <= 40) { - s_copy(expc, vaxexp + (((i__1 = expont) < 41 && 0 <= i__1 ? i__1 : - s_rnge("vaxexp", i__1, "dpstr_", (ftnlen)524)) << 1), (ftnlen) - 20, (ftnlen)2); - } else { - intstr_(&expont, expc, (ftnlen)20); - } - s_copy(numstr + (postn - 1), expc, 32 - (postn - 1), (ftnlen)20); - s_copy(string, numstr, string_len, (ftnlen)32); - -/* That's all folks. */ - - return 0; -} /* dpstr_ */ - diff --git a/ext/spice/src/cspice/dpstrf.c b/ext/spice/src/cspice/dpstrf.c deleted file mode 100644 index d7be89a07f..0000000000 --- a/ext/spice/src/cspice/dpstrf.c +++ /dev/null @@ -1,366 +0,0 @@ -/* dpstrf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n1 = -1; -static logical c_false = FALSE_; -static logical c_true = TRUE_; - -/* $Procedure DPSTRF ( Double Precision Number to Character ) */ -/* Subroutine */ int dpstrf_(doublereal *x, integer *sigdig, char *format, - char *string, ftnlen format_len, ftnlen string_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer last, i__, j; - extern /* Subroutine */ int zzvsbstr_(integer *, integer *, logical *, - char *, logical *, ftnlen); - doublereal y; - extern /* Subroutine */ int zzvststr_(doublereal *, char *, integer *, - ftnlen); - integer first; - extern /* Subroutine */ int dpstr_(doublereal *, integer *, char *, - ftnlen); - integer maxdig, lastch; - logical ovflow; - integer exp__; - -/* $ Abstract */ - -/* Take a double precision number and convert it to an */ -/* equivalent formatted character string representation (base 10). */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I A double precision number */ -/* SIGDIG I The number of significant digits saved for output */ -/* FORMAT I 'E' for scientific, 'F' for floating point. */ -/* STRING O A character string representation of X */ - -/* $ Detailed_Input */ - -/* X is a double precision number. */ - -/* SIGDIG is the number of significant digits that are desired */ -/* for the output string. */ - -/* FORMAT is a character flag that indicates how the double */ -/* precision number should be represented. The two */ -/* acceptable inputs are 'E' and 'F'. If the input */ -/* is 'E' then the number will be displayed with an */ -/* exponent in scientific notation. It will have the */ -/* form 'sx.xxx - - - xxxxxEsyy' where there are */ -/* SIGDIG x's and s is ' ' or '-' at its first occurrence */ -/* and '-' or '+' in the second. */ - -/* If the input is 'F' then the number will be */ -/* displayed without an exponent --- the representation */ -/* will be strictly decimal. The first symbol will be */ -/* a sign ('-' or ' '). */ - -/* $ Detailed_Output */ - - -/* STRING is a character representation of X to the number of */ -/* significant digits specified by SIGDIG. The number of */ -/* spaces required to return the requested character */ -/* string is SIGDIG + 6. If STRING is not declared to */ -/* have adequate length, the number returned will be */ -/* truncated on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes an approximate character representation */ -/* of the input string X. The maximum number of significant */ -/* digits returned is 14 (in F format there may be many extra */ -/* zeros returned but only a maximum of 14 digits will be */ -/* significant. */ - -/* The output string is left justified. */ - -/* This routine has the advantage that it does not use an internal */ -/* file and is about twice as fast as an internal write. It can */ -/* be used as part of character function without fear of introducing */ -/* recursive I/O conflicts. It is intended to be an approximate */ -/* inverse to the subroutine NPARSD. */ - -/* IF you want the character string representation of a double */ -/* precision number to be the same as that produced by a formatted */ -/* write statement use a FORTRAN write statement. */ - -/* For example the number represented by the string */ - -/* 1.245454545454545454545E+01 */ - -/* when read (via a FORTRAN READ statement) into the DP variable X */ -/* and converted back to a character string having 14 significant */ -/* digits by this routine yields */ - -/* 1.2454545454545E+01 in E format */ -/* 12.454545454545 in F format */ - -/* The FORTRAN write statement */ - -/* WRITE ( 6, FMT='(P1E)' ) X */ - -/* yields */ - -/* 1.2454545454545454E+01 */ - -/* If this is too much error for your application DO NOT use this */ -/* routine. You should be aware however, that a character string */ -/* read into a double precision number may not WRITE out with an */ -/* equivalent character representation as was input. */ - -/* For example on a VAX 11/780 if you */ - -/* READ (5,*) X */ -/* WRITE (6,FMT='(E)') X */ - -/* and enter a value of 7.00000001 for the read statement */ -/* the output written will be 0.7000000010000001E+01 */ - - -/* $ Examples */ - -/* Suppose that you wished to insert the character representation */ -/* of some DOUBLE PRECISION number into a line of text. */ - -/* For example suppose X contains the double precision number */ -/* 4.268176872928187 and you would like to insert the character */ -/* representation of this number to 2 places between the strings */ - -/* 'There are', 'meters between lamp posts' */ - -/* You could perform the following sequence of steps */ - - -/* DOUBLE PRECISION X */ -/* CHARACTER*5 DISTANCE */ -/* CHARACTER*80 MESSAGE */ - -/* CALL DPSTRF ( X, 2, 'F', DISTANCE ) */ - -/* MESSAGE = 'There are ' // */ -/* . DISTANCE // */ -/* . 'meters between lamp posts' */ -/* . */ - -/* C */ -/* C Squeeze any extra spaces out of the message string. */ -/* C */ -/* CALL CMPRSS ( ' ', 1, MESSAGE, MESSAGE ) */ - - - -/* The string MESSAGE would contain: */ - -/* 'There are 4.2 meters between lamp posts' */ - -/* $ Restrictions */ - -/* The maximum number of significant digits returned is 14. */ - -/* If the output string is not declared to be adequately large */ -/* the numeric string will be truncated to the side opposite its */ -/* justification (At least SIGDIG + 6 characters are needed in E */ -/* format, in F format the size required is dependent upon the */ -/* input X and the number of significant digits requested. */ -/* In extreme cases up to 56 characters may be required.) */ - -/* This routine makes explicit use of the format of the string */ -/* returned by DPSTR, should that routine change, substantial */ -/* work may be required to bring this routine back up to snuff. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If SIGDIG is less than one, this routine returns one significant */ -/* digit in the output string. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 17-SEP-1996 (WLT) */ - -/* Upgraded routine to handle arbitrary magnitude d.p. numbers. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 30-JUL-1990 (WLT) */ - -/* The routine was repaired so that references to zero-length */ -/* strings ( for example STRING(4:3) ) are not made. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* d.p. number to character with formatting */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-JUL-1990 (WLT) */ - -/* As previously implemented, one would occasionally reference */ -/* a zero length substring of the variable NUMSTR. This was */ -/* O.K. under VAX Fortran, because it allows such references. */ -/* However, most implementations of Fortran are not as forgiving. */ - -/* -& */ - -/* Local variables */ - -/* Computing MIN */ - i__1 = 14, i__2 = max(1,*sigdig); - maxdig = min(i__1,i__2); - -/* If the format is 'E' we just let DPSTR handle the problem. */ - - if (*(unsigned char *)format == 'E') { - dpstr_(x, &maxdig, string, string_len); - return 0; - } - -/* If we're still here, we have a decimal format requested. Set */ -/* the sign for the number. */ - - if (*x < 0.) { - s_copy(string, "-", string_len, (ftnlen)1); - } else { - s_copy(string, " ", string_len, (ftnlen)1); - } - -/* If X is zero, we can handle this without any regard to the */ -/* exponent. */ - - if (*x == 0.) { - zzvststr_(x, " ", &exp__, (ftnlen)1); - zzvsbstr_(&c_n1, &maxdig, &c_false, string + 1, &ovflow, string_len - - 1); - return 0; - } - -/* We've already set the sign, now we deal with the unsigned */ -/* portion of X. */ - - y = abs(*x); - -/* Create a virtual decimal string for Y. */ - - zzvststr_(&y, " ", &exp__, (ftnlen)1); - -/* Now we can just fill in the string by reading the appropriate */ -/* substring from the virtual decimal string. We need to compute */ -/* the first and last virtual digits to retrieve. To do this */ -/* we look at EXP. */ - - if (exp__ >= 0) { - first = -exp__ - 1; - } else { - first = -exp__; - } - last = first + maxdig - 1; - if (first < 0 && last >= 0) { - ++last; - } - first = min(-1,first); - zzvsbstr_(&first, &last, &c_true, string + 1, &ovflow, string_len - 1); - if (ovflow) { - --first; - zzvsbstr_(&first, &last, &c_true, string + 1, &ovflow, string_len - 1) - ; - -/* We need to blank out the last digit of string. */ - - lastch = last - first + 2; - if (last > 0 && lastch <= i_len(string, string_len)) { - s_copy(string + (lastch - 1), " ", string_len - (lastch - 1), ( - ftnlen)1); - } - } - if (last < 0) { - j = last - first + 3; - for (i__ = last + 1; i__ <= -1; ++i__) { - if (j <= i_len(string, string_len)) { - *(unsigned char *)&string[j - 1] = '0'; - } - ++j; - } - if (j <= i_len(string, string_len)) { - *(unsigned char *)&string[j - 1] = '.'; - } - } - return 0; -} /* dpstrf_ */ - diff --git a/ext/spice/src/cspice/drdcyl.c b/ext/spice/src/cspice/drdcyl.c deleted file mode 100644 index bd94ce27a4..0000000000 --- a/ext/spice/src/cspice/drdcyl.c +++ /dev/null @@ -1,211 +0,0 @@ -/* drdcyl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DRDCYL (Derivative of rectangular w.r.t. cylindrical) */ -/* Subroutine */ int drdcyl_(doublereal *r__, doublereal *long__, doublereal * - z__, doublereal *jacobi) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* cylindrical to rectangular coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* R I Distance of a point from the origin. */ -/* LONG I Angle of the point from the XZ plane in radians. */ -/* Z I Height of the point above the XY plane. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* R Distance of the point of interest from Z axis. */ - -/* LONG Cylindrical angle (in radians) of the point of */ -/* interest from XZ plane. The angle increases in the */ -/* counterclockwise sense about the +Z axis. */ - -/* Z Height of the point above XY plane. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between cylindrical and rectangular coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | dx/dr dx/dlong dx/dz | */ -/* | | */ -/* | dy/dr dy/dlong dy/dz | */ -/* | | */ -/* | dz/dr dz/dlong dz/dz | */ -/* `- -' */ - -/* evaluated at the input values of R, LONG and Z. */ -/* Here x,y, and z are given by the familiar formulae */ - -/* x = r*cos(long) */ -/* y = r*sin(long) */ -/* z = z */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* It is often convenient to describe the motion of an object in */ -/* the cylindrical coordinate system. However, when performing */ -/* vector computations its hard to beat rectangular coordinates. */ - -/* To transform states given with respect to cylindrical coordinates */ -/* to states with respect to rectangular coordinates, one uses */ -/* the Jacobian of the transformation between the two systems. */ - -/* Given a state in cylindrical coordinates */ - -/* ( r, long, z, dr, dlong, dz ) */ - -/* the velocity in rectangular coordinates is given by the matrix */ -/* equation: */ -/* t | t */ -/* (dx, dy, dz) = JACOBI| * (dr, dlong, dz) */ -/* |(r,long,z) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(r,long,z) */ - -/* $ Examples */ - -/* Suppose that one has a model that gives radius, longitude and */ -/* height as a function of time (r(t), long(t), z(t)) for */ -/* which the derivatives ( dr/dt, dlong/dt, dz/dt ) are computable. */ - -/* To find the corresponing velocity in bodyfixed rectangular */ -/* coordinates, one simply multiplies the Jacobian of the */ -/* transformation from cylindrical to rectangular coordinates */ -/* (evaluated at r(t), long(t), z(t) ) by the vector of derivatives */ -/* of the cylindrical coordinates. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the derivatives of r, long, and z into the */ -/* C cylindrical velocity vector SPHV. */ -/* C */ -/* CYLV(1) = DR_DT ( T ) */ -/* CYLV(2) = DLONG_DT ( T ) */ -/* CYLV(3) = DZ_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C cylindrical to rectangular coordinates at the */ -/* C given cylindrical coordinates at time T. */ -/* C */ -/* CALL DRDCYL ( R(T), LONG(T), Z(T), JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the left by the cylindrical */ -/* C velocity to obtain the rectangular velocity RECV. */ -/* C */ -/* CALL MXV ( JACOBI, CYLV, RECV ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-JUL-2001 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of rectangular w.r.t. cylindrical coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Local parameters */ - - jacobi[0] = cos(*long__); - jacobi[1] = sin(*long__); - jacobi[2] = 0.; - jacobi[3] = -sin(*long__) * *r__; - jacobi[4] = cos(*long__) * *r__; - jacobi[5] = 0.; - jacobi[6] = 0.; - jacobi[7] = 0.; - jacobi[8] = 1.; - return 0; -} /* drdcyl_ */ - diff --git a/ext/spice/src/cspice/drdcyl_c.c b/ext/spice/src/cspice/drdcyl_c.c deleted file mode 100644 index e2e8eb9969..0000000000 --- a/ext/spice/src/cspice/drdcyl_c.c +++ /dev/null @@ -1,215 +0,0 @@ -/* - --Procedure drdcyl_c (Derivative of rectangular w.r.t. cylindrical) - --Abstract - - This routine computes the Jacobian of the transformation from - cylindrical to rectangular coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void drdcyl_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble jacobi[3][3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - r I Distance of a point from the origin. - lon I Angle of the point from the xz plane in radians. - z I Height of the point above the xy plane. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - r Distance of the point of interest from z axis. - - lon Cylindrical angle (in radians) of the point of - interest from xz plane. The angle increases in the - counterclockwise sense about the +z axis. - - z Height of the point above xy plane. - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between cylindrical and rectangular coordinates. It - has the form - - .- -. - | dx/dr dx/dlon dx/dz | - | | - | dy/dr dy/dlon dy/dz | - | | - | dz/dr dz/dlon dz/dz | - `- -' - - evaluated at the input values of r, lon and z. - Here x,y, and z are given by the familiar formulae - - x = r*cos(lon) - y = r*sin(lon) - z = z - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - It is often convenient to describe the motion of an object in - the cylindrical coordinate system. However, when performing - vector computations its hard to beat rectangular coordinates. - - To transform states given with respect to cylindrical coordinates - to states with respect to rectangular coordinates, one uses - the Jacobian of the transformation between the two systems. - - Given a state in cylindrical coordinates - - ( r, lon, z, dr, dlon, dz ) - - the velocity in rectangular coordinates is given by the matrix - equation: - t | t - (dx, dy, dz) = jacobi| * (dr, dlon, dz) - |(r,lon,z) - - This routine computes the matrix - - | - jacobi| - |(r,lon,z) - --Examples - - Suppose that one has a model that gives radius, longitude and - height as a function of time (r(t), lon(t), z(t)) for - which the derivatives ( dr/dt, dlon/dt, dz/dt ) are computable. - - To find the corresponing velocity in bodyfixed rectangular - coordinates, one simply multiplies the Jacobian of the - transformation from cylindrical to rectangular coordinates - (evaluated at r(t), lon(t), z(t) ) by the vector of derivatives - of the cylindrical coordinates. - - In code this looks like: - - #include "SpiceUsr.h" - . - . - . - /. - Load the derivatives of r, lon, and z into the - cylindrical velocity vector sphv. - ./ - cylv[0] = dr_dt ( t ); - cylv[1] = dlon_dt ( t ); - cylv[2] = dz_dt ( t ); - - /. - Determine the Jacobian of the transformation from - cylindrical to rectangular at the coordinates at the - given cylindrical coordinates at time t. - ./ - drdcyl_c ( r(t), lon(t), z(t), jacobi ); - - /. - Multiply the Jacobian on the left by the cylindrical - velocity to obtain the rectangular velocity recv. - ./ - mxv_c ( jacobi, cylv, recv ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 19-JUL-2001 (WLT) (IMU) (NJB) - --Index_Entries - - Jacobian of rectangular w.r.t. cylindrical coordinates - --& -*/ - -{ /* Begin drdcyl_c */ - - /* - Don't participate in error tracing; the underlying routine is - error-free. - */ - drdcyl_ ( (doublereal *) &r, - (doublereal *) &lon, - (doublereal *) &z, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - -} /* End drdcyl_c */ diff --git a/ext/spice/src/cspice/drdgeo.c b/ext/spice/src/cspice/drdgeo.c deleted file mode 100644 index 0fea54931b..0000000000 --- a/ext/spice/src/cspice/drdgeo.c +++ /dev/null @@ -1,449 +0,0 @@ -/* drdgeo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DRDGEO ( Derivative of rectangular w.r.t. geodetic ) */ -/* Subroutine */ int drdgeo_(doublereal *long__, doublereal *lat, doublereal * - alt, doublereal *re, doublereal *f, doublereal *jacobi) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal), sqrt(doublereal); - - /* Local variables */ - doublereal clat, flat, clon, slat, slon, flat2, g; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal g2, dgdlat; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* geodetic to rectangular coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LONG I Geodetic longitude of point (radians). */ -/* LAT I Geodetic latitude of point (radians). */ -/* ALT I Altitude of point above the reference spheroid. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* LONG Geodetic longitude of point (radians). */ - -/* LAT Geodetic latitude of point (radians). */ - -/* ALT Altitude of point above the reference spheroid. */ - -/* RE Equatorial radius of the reference spheroid. */ - -/* F Flattening coefficient = (RE-RP) / RE, where RP is */ -/* the polar radius of the spheroid. (More importantly */ -/* RP = RE*(1-F).) */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between geodetic and rectangular coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | DX/DLONG DX/DLAT DX/DALT | */ -/* | DY/DLONG DY/DLAT DY/DALT | */ -/* | DZ/DLONG DZ/DLAT DZ/DALT | */ -/* `- -' */ - -/* evaluated at the input values of LONG, LAT and ALT. */ - -/* The formulae for computing X, Y, and Z from */ -/* geodetic coordinates are given below. */ - -/* X = [ALT + RE/G(LAT,F)]*COS(LONG)*COS(LAT) */ -/* Y = [ALT + RE/G(LAT,F)]*SIN(LONG)*COS(LAT) */ -/* Z = [ALT + RE*(1-F)**2/G(LAT,F)]* SIN(LAT) */ - -/* where */ - -/* RE is the polar radius of the reference spheroid. */ - -/* F is the flattening factor (the polar radius is */ -/* obtained by multiplying the equatorial radius by */ -/* 1-F). */ - -/* G( LAT, F ) is given by */ - -/* sqrt ( cos(lat)**2 + (1-f)**2 * sin(lat)**2 ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the flattening coefficient is greater than or equal to */ -/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 2) If the equatorial radius is non-positive, the error */ -/* SPICE(BADRADIUS) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* It is often convenient to describe the motion of an object in */ -/* the geodetic coordinate system. However, when performing */ -/* vector computations its hard to beat rectangular coordinates. */ - -/* To transform states given with respect to geodetic coordinates */ -/* to states with respect to rectangular coordinates, one makes use */ -/* of the Jacobian of the transformation between the two systems. */ - -/* Given a state in geodetic coordinates */ - -/* ( long, lat, alt, dlong, dlat, dalt ) */ - -/* the velocity in rectangular coordinates is given by the matrix */ -/* equation: */ - -/* t | t */ -/* (dx, dy, dz) = JACOBI| * (dlong, dlat, dalt) */ -/* |(long,lat,alt) */ - - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(long,lat,alt) */ - -/* $ Examples */ - -/* Suppose that one has a model that gives radius, longitude and */ -/* latitude as a function of time (long(t), lat(t), alt(t) ) for */ -/* which the derivatives ( dlong/dt, dlat/dt, dalt/dt ) are */ -/* computable. */ - -/* To find the velocity of the object in bodyfixed rectangular */ -/* coordinates, one simply multiplies the Jacobian of the */ -/* transformation from geodetic to rectangular coordinates, */ -/* evaluated at (long(t), lat(t), alt(t) ), by the vector of */ -/* derivatives of the geodetic coordinates. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the derivatives of long, lat, and alt into the */ -/* C geodetic velocity vector GEOV. */ -/* C */ -/* GEOV(1) = DLONG_DT ( T ) */ -/* GEOV(2) = DLAT_DT ( T ) */ -/* GEOV(3) = DALT_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C geodetic to rectangular coordinates at the geodetic */ -/* C coordinates of time T. */ -/* C */ -/* CALL DRDGEO ( LONG(T), LAT(T), ALT(T), RE, F, JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the right by the geodetic */ -/* C velocity to obtain the rectangular velocity RECV. */ -/* C */ -/* CALL MXV ( JACOBI, GEOV, RECV ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-JUL-2001 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of rectangular w.r.t. geodetic coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DRDGEO", (ftnlen)6); - } - -/* If the flattening coefficient is greater than one, the polar */ -/* radius computed below is negative. If it's equal to one, the */ -/* polar radius is zero. Either case is a problem, so signal an */ -/* error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was *.", (ftnlen)29); - errdp_("*", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DRDGEO", (ftnlen)6); - return 0; - } - if (*re <= 0.) { - setmsg_("Equatorial Radius <= 0.0D0. RE = *", (ftnlen)34); - errdp_("*", re, (ftnlen)1); - sigerr_("SPICE(BADRADIUS)", (ftnlen)16); - chkout_("DRDGEO", (ftnlen)6); - return 0; - } - -/* For the record, here is a derivation of the formulae for the */ -/* values of x, y and z as a function of longitude, latitude and */ -/* altitude. */ - -/* First, let's take the case where the longitude is 0. Moreover, */ -/* lets assume that the length of the equatorial axis is a and */ -/* that the polar axis is b: */ - -/* a = re */ -/* b = re * (1-f) */ - -/* For any point on the spheroid where y is zero we know that there */ -/* is a unique q in the range (-Pi, Pi] such that */ - -/* x = a cos(q) and z = b sin(q). */ - -/* The normal to the surface at such a point is given by */ - -/* cos(q) sin(q) */ -/* ( ------- , ------- ) */ -/* a b */ - -/* The unit vector in the same direction is */ - -/* b cos(q) a sin(q) */ -/* ( -------------------------- , -------------------------- ) */ -/* ______________________ ______________________ */ -/* / 2 2 2 2 / 2 2 2 2 */ -/* \/ b cos (q) + a sin (q) \/ b cos (q) + a sin (q) */ - - -/* The first component of this term is by definition equal to the */ -/* cosine of the geodetic latitude, thus */ - -/* ______________________ */ -/* / 2 2 2 2 */ -/* b cos(q) = cos(lat) \/ b cos (q) + a sin (q) */ - - -/* This can be transformed to the equation */ - -/* ______________________________ */ -/* / 2 2 2 2 */ -/* b cos(q) = cos(lat) \/ ( b - a )cos (q) + a */ - - -/* Squaring both sides and rearranging terms gives: */ - -/* 2 2 2 2 2 2 2 2 */ -/* b cos (q) + cos (lat) ( a - b ) cos (q) = a cos (lat) */ - -/* Thus */ -/* 2 2 */ -/* 2 a cos (lat) */ -/* cos (q) = -------------------------- */ -/* 2 2 2 2 */ -/* b sin (lat) + a cos (lat) */ - - - -/* cos (lat) */ -/* = ------------------------------ */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (b/a) sin (lat) + cos (lat) */ - - - -/* cos (lat) */ -/* = --------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - - -/* From this one can also conclude that */ - - -/* (1-f) sin (lat) */ -/* sin(q) = ---------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - - -/* Thus the point on the surface of the spheroid is given by */ - -/* re * cos (lat) */ -/* x_0 = --------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - - -/* 2 */ -/* re * (1-f) sin (lat) */ -/* z_0 = ---------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - -/* Thus given a point with the same latitude but a non-zero */ -/* longitude, one can conclude that */ - -/* re * cos (long) *cos (lat) */ -/* x_0 = --------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - - -/* re * sin (long) cos (lat) */ -/* y_0 = --------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - -/* 2 */ -/* re * (1-f) sin (lat) */ -/* z_0 = ---------------------------------- */ -/* _____________________________ */ -/* / 2 2 2 */ -/* \/ (1-f) sin (lat) + cos (lat) */ - - -/* The unit normal, n, at this point is simply */ - -/* ( cos(long)cos(lat), sin(long)cos(lat), sin(lat) ) */ - - -/* Thus for a point at altitude alt, we simply add the vector */ - -/* alt*n */ - -/* to the vector ( x_0, y_0, z_0 ). Hence we have */ - -/* x = [ alt + re/g(lat,f) ] * cos(long) * cos(lat) */ -/* y = [ alt + re/g(lat,f) ] * sin(long) * cos(lat) */ -/* z = [ alt + re*(1-f)**2/g(lat,f) ] * sin(lat) */ - - -/* We're going to need the sine and cosine of LAT and LONG many */ -/* times. We'll just compute them once. */ - - clat = cos(*lat); - clon = cos(*long__); - slat = sin(*lat); - slon = sin(*long__); - -/* Referring to the G given in the header we have... */ - - flat = 1. - *f; - flat2 = flat * flat; - g = sqrt(clat * clat + flat2 * slat * slat); - g2 = g * g; - dgdlat = (flat2 - 1.) * slat * clat / g; - -/* Now simply take the partial derivatives of the x,y,z w.r.t. */ -/* long,lat, alt. */ - - jacobi[0] = -(*alt + *re / g) * slon * clat; - jacobi[1] = (*alt + *re / g) * clon * clat; - jacobi[2] = 0.; - jacobi[3] = -(*re) * dgdlat / g2 * clon * clat - (*alt + *re / g) * clon * - slat; - jacobi[4] = -(*re) * dgdlat / g2 * slon * clat - (*alt + *re / g) * slon * - slat; - jacobi[5] = -flat2 * *re * dgdlat / g2 * slat + (*alt + flat2 * *re / g) * - clat; - jacobi[6] = clon * clat; - jacobi[7] = slon * clat; - jacobi[8] = slat; - chkout_("DRDGEO", (ftnlen)6); - return 0; -} /* drdgeo_ */ - diff --git a/ext/spice/src/cspice/drdgeo_c.c b/ext/spice/src/cspice/drdgeo_c.c deleted file mode 100644 index 2cdfe90e55..0000000000 --- a/ext/spice/src/cspice/drdgeo_c.c +++ /dev/null @@ -1,253 +0,0 @@ -/* - --Procedure drdgeo_c ( Derivative of rectangular w.r.t. geodetic ) - --Abstract - - This routine computes the Jacobian of the transformation from - geodetic to rectangular coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void drdgeo_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - lon I Geodetic longitude of point (radians). - lat I Geodetic latitude of point (radians). - alt I Altitude of point above the reference spheroid. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - lon Geodetic longitude of point (radians). - - lat Geodetic latitude of point (radians). - - alt Altitude of point above the reference spheroid. - - re Equatorial radius of the reference spheroid. - - f Flattening coefficient = (re-rp) / re, where rp is - the polar radius of the spheroid. (More importantly - rp = re*(1-f).) - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between geodetic and rectangular coordinates. It - has the form - - .- -. - | dx/dlon dx/dlat dx/dalt | - | dy/dlon dy/dlat dy/dalt | - | dz/dlon dz/dlat dz/dalt | - `- -' - - evaluated at the input values of lon, lat and alt. - - The formulae for computing x, y, and z from - geodetic coordinates are given below. - - x = [alt + re/g(lat,f)]*cos(lon)*cos(lat) - - - y = [alt + re/g(lat,f)]*sin(lon)*cos(lat) - - 2 - z = [alt + re*(1-f) /g(lat,f)]* sin(lat) - - where - - re is the polar radius of the reference spheroid. - - f is the flattening factor (the polar radius is - obtained by multiplying the equatorial radius by 1-f). - - g( lat, f ) is given by - - 2 2 2 - sqrt ( cos (lat) + (1-f) * sin (lat) ) - --Parameters - - None. - --Exceptions - - 1) If the flattening coefficient is greater than or equal to - one, the error SPICE(VALUEOUTOFRANGE) is signaled. - - 2) If the equatorial radius is non-positive, the error - SPICE(BADRADIUS) is signaled. - --Files - - None. - --Particulars - - It is often convenient to describe the motion of an object in - the geodetic coordinate system. However, when performing - vector computations its hard to beat rectangular coordinates. - - To transform states given with respect to geodetic coordinates - to states with respect to rectangular coordinates, one makes use - of the Jacobian of the transformation between the two systems. - - Given a state in geodetic coordinates - - ( lon, lat, alt, dlon, dlat, dalt ) - - the velocity in rectangular coordinates is given by the matrix - equation: - - t | t - (dx, dy, dz) = jacobi| * (dlon, dlat, dalt) - |(lon,lat,alt) - - - This routine computes the matrix - - | - jacobi| - |(lon,lat,alt) - --Examples - - Suppose that one has a model that gives radius, longitude and - latitude as a function of time (lon(t), lat(t), alt(t) ) for - which the derivatives ( dlon/dt, dlat/dt, dalt/dt ) are - computable. - - To find the velocity of the object in bodyfixed rectangular - coordinates, one simply multiplies the Jacobian of the - transformation from geodetic to rectangular coordinates, - evaluated at (lon(t), lat(t), alt(t) ), by the vector of - derivatives of the geodetic coordinates. - - In code this looks like: - - #include "SpiceUsr.h" - . - . - . - /. - Load the derivatives of lon, lat, and alt into the - geodetic velocity vector GEOV. - ./ - geov[0] = dlon_dt ( t ); - geov[1] = dlat_dt ( t ); - geov[2] = dalt_dt ( t ); - - /. - Determine the Jacobian of the transformation from - geodetic to rectangular coordinates at the geodetic - coordinates of time t. - ./ - drdgeo_c ( lon(t), lat(t), alt(t), re, f, jacobi ); - - /. - Multiply the Jacobian on the right by the geodetic - velocity to obtain the rectangular velocity recv. - ./ - mxv_c ( jacobi, geov, recv ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 20-JUL-2001 (WLT) (NJB) - --Index_Entries - - Jacobian of rectangular w.r.t. geodetic coordinates - --& -*/ - -{ /* Begin drdgeo_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "drdgeo_c" ); - - - drdgeo_ ( (doublereal *) &lon, - (doublereal *) &lat, - (doublereal *) &alt, - (doublereal *) &re, - (doublereal *) &f, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "drdgeo_c" ); - -} /* End drdgeo_c */ diff --git a/ext/spice/src/cspice/drdlat.c b/ext/spice/src/cspice/drdlat.c deleted file mode 100644 index 98cd0530e4..0000000000 --- a/ext/spice/src/cspice/drdlat.c +++ /dev/null @@ -1,212 +0,0 @@ -/* drdlat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DRDLAT ( Derivative of rectangular w.r.t. latitudinal ) */ -/* Subroutine */ int drdlat_(doublereal *r__, doublereal *long__, doublereal * - lat, doublereal *jacobi) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - -/* $ Abstract */ - -/* Compute the Jacobian of the transformation from latitudinal to */ -/* rectangular coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* RADIUS I Distance of a point from the origin. */ -/* LONG I Angle of the point from the XZ plane in radians. */ -/* LAT I Angle of the point from the XY plane in radians. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* RADIUS Distance of a point from the origin. */ - -/* LONG Angle of the point from the XZ plane in radians. */ -/* The angle increases in the counterclockwise sense */ -/* about the +Z axis. */ - -/* LAT Angle of the point from the XY plane in radians. */ -/* The angle increases in the direction of the +Z axis. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between latitudinal and rectangular coordinates. It has */ -/* the form */ - -/* .- -. */ -/* | DX/DR DX/DLONG DX/DLAT | */ -/* | | */ -/* | DY/DR DY/DLONG DY/DLAT | */ -/* | | */ -/* | DZ/DR DZ/DLONG DZ/DLAT | */ -/* `- -' */ - -/* evaluated at the input values of R, LONG and LAT. */ -/* Here X, Y, and Z are given by the familiar formulae */ - -/* X = R * COS(LONG) * COS(LAT) */ -/* Y = R * SIN(LONG) * COS(LAT) */ -/* Z = R * SIN(LAT) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* It is often convenient to describe the motion of an object */ -/* in latitudinal coordinates. It is also convenient to manipulate */ -/* vectors associated with the object in rectangular coordinates. */ - -/* The transformation of a latitudinal state into an equivalent */ -/* rectangular state makes use of the Jacobian of the */ -/* transformation between the two systems. */ - -/* Given a state in latitudinal coordinates, */ - -/* ( r, long, lat, dr, dlong, dlat ) */ - -/* the velocity in rectangular coordinates is given by the matrix */ -/* equation */ -/* t | t */ -/* (dx, dy, dz) = JACOBI| * (dr, dlong, dlat) */ -/* |(r,long,lat) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(r,long,lat) */ - -/* $ Examples */ - -/* Suppose you have a model that gives radius, longitude, and */ -/* latitude as functions of time (r(t), long(t), lat(t)), and */ -/* that the derivatives (dr/dt, dlong/dt, dlat/dt) are computable. */ -/* To find the velocity of the object in rectangular coordinates, */ -/* multiply the Jacobian of the transformation from latitudinal */ -/* to rectangular (evaluated at r(t), long(t), lat(t)) by the */ -/* vector of derivatives of the latitudinal coordinates. */ - -/* This is illustrated by the following code fragment. */ - -/* C */ -/* C Load the derivatives of r, long and lat into the */ -/* C latitudinal velocity vector LATV. */ -/* C */ -/* LATV(1) = DR_DT ( T ) */ -/* LATV(2) = DLONG_DT ( T ) */ -/* LATV(3) = DLAT_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C latitudinal to rectangular coordinates, using the */ -/* C latitudinal coordinates at time T. */ -/* C */ -/* CALL DRDLAT ( R(T), LONG(T), LAT(T), JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian by the latitudinal velocity to */ -/* C obtain the rectangular velocity RECV. */ -/* C */ -/* CALL MXV ( JACOBI, LATV, RECV ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-JUL-2001 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of rectangular w.r.t. latitudinal coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Local variables */ - - -/* Construct the matrix directly. */ - - jacobi[0] = cos(*long__) * cos(*lat); - jacobi[1] = sin(*long__) * cos(*lat); - jacobi[2] = sin(*lat); - jacobi[3] = -(*r__) * sin(*long__) * cos(*lat); - jacobi[4] = *r__ * cos(*long__) * cos(*lat); - jacobi[5] = 0.; - jacobi[6] = -(*r__) * cos(*long__) * sin(*lat); - jacobi[7] = -(*r__) * sin(*long__) * sin(*lat); - jacobi[8] = *r__ * cos(*lat); - return 0; -} /* drdlat_ */ - diff --git a/ext/spice/src/cspice/drdlat_c.c b/ext/spice/src/cspice/drdlat_c.c deleted file mode 100644 index cb83c4c788..0000000000 --- a/ext/spice/src/cspice/drdlat_c.c +++ /dev/null @@ -1,213 +0,0 @@ -/* - --Procedure drdlat_c ( Derivative of rectangular w.r.t. latitudinal ) - --Abstract - - Compute the Jacobian of the transformation from latitudinal to - rectangular coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void drdlat_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble jacobi[3][3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - radius I Distance of a point from the origin. - lon I Angle of the point from the XZ plane in radians. - lat I Angle of the point from the XY plane in radians. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - radius Distance of a point from the origin. - - lon Angle of the point from the XZ plane in radians. - The angle increases in the counterclockwise sense - about the +Z axis. - - lat Angle of the point from the XY plane in radians. - The angle increases in the direction of the +Z axis. - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between latitudinal and rectangular coordinates. It has - the form - - .- -. - | dx/dr dx/dlon dx/dlat | - | | - | dy/dr dy/dlon dy/dlat | - | | - | dz/dr dz/dlon dz/dlat | - `- -' - - evaluated at the input values of r, lon and lat. - Here x, y, and z are given by the familiar formulae - - x = r * cos(lon) * cos(lat) - y = r * sin(lon) * cos(lat) - z = r * sin(lat). - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - It is often convenient to describe the motion of an object - in latitudinal coordinates. It is also convenient to manipulate - vectors associated with the object in rectangular coordinates. - - The transformation of a latitudinal state into an equivalent - rectangular state makes use of the Jacobian of the - transformation between the two systems. - - Given a state in latitudinal coordinates, - - ( r, lon, lat, dr, dlon, dlat ) - - the velocity in rectangular coordinates is given by the matrix - equation - t | t - (dx, dy, dz) = jacobi| * (dr, dlon, dlat) - |(r,lon,lat) - - This routine computes the matrix - - | - jacobi| - |(r,lon,lat) - --Examples - - Suppose you have a model that gives radius, longitude, and - latitude as functions of time (r(t), lon(t), lat(t)), and - that the derivatives (dr/dt, dlon/dt, dlat/dt) are computable. - To find the velocity of the object in rectangular coordinates, - multiply the Jacobian of the transformation from latitudinal - to rectangular (evaluated at r(t), lon(t), lat(t)) by the - vector of derivatives of the latitudinal coordinates. - - This is illustrated by the following code fragment. - - #include "SpiceUsr.h" - . - . - . - - /. - Load the derivatives of r, lon and lat into the - latitudinal velocity vector latv. - ./ - latv[0] = dr_dt ( t ); - latv[1] = dlon_dt ( t ); - latv[2] = dlat_dt ( t ); - - /. - Determine the Jacobian of the transformation from - latitudinal to rectangular coordinates, using the latitudinal - coordinates at time t. - ./ - drdlat_c ( r(t), lon(t), lat(t), jacobi ); - - /. - Multiply the Jacobian by the latitudinal velocity to - obtain the rectangular velocity recv. - ./ - mxv_c ( jacobi, latv, recv ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 20-JUL-2001 (WLT) (NJB) - --Index_Entries - - Jacobian of rectangular w.r.t. latitudinal coordinates - --& -*/ - -{ /* Begin drdlat_c */ - - /* - Don't participate in error tracing; the underlying routine is - error-free. - */ - drdlat_ ( (doublereal *) &r, - (doublereal *) &lon, - (doublereal *) &lat, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - -} /* End drdlat_c */ diff --git a/ext/spice/src/cspice/drdpgr.c b/ext/spice/src/cspice/drdpgr.c deleted file mode 100644 index e1a3295d7a..0000000000 --- a/ext/spice/src/cspice/drdpgr.c +++ /dev/null @@ -1,696 +0,0 @@ -/* drdpgr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure DRDPGR ( Derivative of rectangular w.r.t. planetographic ) */ -/* Subroutine */ int drdpgr_(char *body, doublereal *lon, doublereal *lat, - doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi, - ftnlen body_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - integer i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer sense; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), bods2c_(char *, integer *, logical *, - ftnlen), drdgeo_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - integer bodyid; - doublereal geolon; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen); - char kvalue[80]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char pmkvar[32], pgrlon[4]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen); - extern integer plnsns_(integer *); - extern logical return_(void); - char tmpstr[32]; - -/* $ Abstract */ - -/* This routine computes the Jacobian matrix of the transformation */ -/* from planetographic to rectangular coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Name of body with which coordinates are associated. */ -/* LON I Planetographic longitude of a point (radians). */ -/* LAT I Planetographic latitude of a point (radians). */ -/* ALT I Altitude of a point above reference spheroid. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* BODY Name of the body with which the planetographic */ -/* coordinate system is associated. */ - -/* BODY is used by this routine to look up from the */ -/* kernel pool the prime meridian rate coefficient giving */ -/* the body's spin sense. See the Files and Particulars */ -/* header sections below for details. */ - -/* LON Planetographic longitude of the input point. This is */ -/* the angle between the prime meridian and the meridian */ -/* containing the input point. For bodies having */ -/* prograde (aka direct) rotation, the direction of */ -/* increasing longitude is positive west: from the +X */ -/* axis of the rectangular coordinate system toward the */ -/* -Y axis. For bodies having retrograde rotation, the */ -/* direction of increasing longitude is positive east: */ -/* from the +X axis toward the +Y axis. */ - -/* The earth, moon, and sun are exceptions: */ -/* planetographic longitude is measured positive east for */ -/* these bodies. */ - -/* The default interpretation of longitude by this */ -/* and the other planetographic coordinate conversion */ -/* routines can be overridden; see the discussion in */ -/* Particulars below for details. */ - -/* Longitude is measured in radians. On input, the range */ -/* of longitude is unrestricted. */ - -/* LAT Planetographic latitude of the input point. For a */ -/* point P on the reference spheroid, this is the angle */ -/* between the XY plane and the outward normal vector at */ -/* P. For a point P not on the reference spheroid, the */ -/* planetographic latitude is that of the closest point */ -/* to P on the spheroid. */ - -/* Latitude is measured in radians. On input, the */ -/* range of latitude is unrestricted. */ - -/* ALT Altitude of point above the reference spheroid. */ -/* Units of ALT must match those of RE. */ - -/* RE Equatorial radius of a reference spheroid. This */ -/* spheroid is a volume of revolution: its horizontal */ -/* cross sections are circular. The shape of the */ -/* spheroid is defined by an equatorial radius RE and */ -/* a polar radius RP. Units of RE must match those of */ -/* ALT. */ - -/* F Flattening coefficient = */ - -/* (RE-RP) / RE */ - -/* where RP is the polar radius of the spheroid, and the */ -/* units of RP match those of RE. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* from planetographic to rectangular coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | DX/DLON DX/DLAT DX/DALT | */ -/* | DY/DLON DY/DLAT DY/DALT | */ -/* | DZ/DLON DZ/DLAT DZ/DALT | */ -/* `- -' */ - -/* evaluated at the input values of LON, LAT and ALT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */ -/* and if BODY is not a string representation of an integer, */ -/* the error SPICE(IDCODENOTFOUND) will be signaled. */ - -/* 2) If the kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* is present in the kernel pool but has a value other */ -/* than one of */ - -/* 'EAST' */ -/* 'WEST' */ - -/* the error SPICE(INVALIDOPTION) will be signaled. Case */ -/* and blanks are ignored when these values are interpreted. */ - -/* 3) If polynomial coefficients for the prime meridian of BODY */ -/* are not available in the kernel pool, and if the kernel */ -/* variable BODY_PGR_POSITIVE_LON is not present in */ -/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */ - -/* 4) If the equatorial radius is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 5) If the flattening coefficient is greater than or equal to one, */ -/* the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* $ Files */ - -/* This routine expects a kernel variable giving BODY's prime */ -/* meridian angle as a function of time to be available in the */ -/* kernel pool. Normally this item is provided by loading a PCK */ -/* file. The required kernel variable is named */ - -/* BODY_PM */ - -/* where represents a string containing the NAIF integer */ -/* ID code for BODY. For example, if BODY is 'JUPITER', then */ -/* the name of the kernel variable containing the prime meridian */ -/* angle coefficients is */ - -/* BODY599_PM */ - -/* See the PCK Required Reading for details concerning the prime */ -/* meridian kernel variable. */ - -/* The optional kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* also is normally defined via loading a text kernel. When this */ -/* variable is present in the kernel pool, the prime meridian */ -/* coefficients for BODY are not required by this routine. See the */ -/* Particulars section below for details. */ - -/* $ Particulars */ - -/* It is often convenient to describe the motion of an object in the */ -/* planetographic coordinate system. However, when performing */ -/* vector computations it's hard to beat rectangular coordinates. */ - -/* To transform states given with respect to planetographic */ -/* coordinates to states with respect to rectangular coordinates, */ -/* one makes use of the Jacobian of the transformation between the */ -/* two systems. */ - -/* Given a state in planetographic coordinates */ - -/* ( lon, lat, alt, dlon, dlat, dalt ) */ - -/* the velocity in rectangular coordinates is given by the matrix */ -/* equation: */ - -/* t | t */ -/* (dx, dy, dz) = JACOBI| * (dlon, dlat, dalt) */ -/* |(lon,lat,alt) */ - - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(lon,lat,alt) */ - - -/* In the planetographic coordinate system, longitude is defined */ -/* using the spin sense of the body. Longitude is positive to the */ -/* west if the spin is prograde and positive to the east if the spin */ -/* is retrograde. The spin sense is given by the sign of the first */ -/* degree term of the time-dependent polynomial for the body's prime */ -/* meridian Euler angle "W": the spin is retrograde if this term is */ -/* negative and prograde otherwise. For the sun, planets, most */ -/* natural satellites, and selected asteroids, the polynomial */ -/* expression for W may be found in a SPICE PCK kernel. */ - -/* The earth, moon, and sun are exceptions: planetographic longitude */ -/* is measured positive east for these bodies. */ - -/* If you wish to override the default sense of positive longitude */ -/* for a particular body, you can do so by defining the kernel */ -/* variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* where represents the NAIF ID code of the body. This */ -/* variable may be assigned either of the values */ - -/* 'WEST' */ -/* 'EAST' */ - -/* For example, you can have this routine treat the longitude */ -/* of the earth as increasing to the west using the kernel */ -/* variable assignment */ - -/* BODY399_PGR_POSITIVE_LON = 'WEST' */ - -/* Normally such assignments are made by placing them in a text */ -/* kernel and loading that kernel via FURNSH. */ - -/* The definition of this kernel variable controls the behavior of */ -/* the SPICELIB planetographic routines */ - -/* PGRREC */ -/* RECPGR */ -/* DPGRDR */ -/* DRDPGR */ - -/* It does not affect the other SPICELIB coordinate conversion */ -/* routines. */ - -/* $ Examples */ - -/* Numerical results shown for this example may differ between */ -/* platforms as the results depend on the SPICE kernels used as */ -/* input and the machine specific arithmetic implementation. */ - - -/* Find the planetographic state of the earth as seen from */ -/* Mars in the J2000 reference frame at January 1, 2005 TDB. */ -/* Map this state back to rectangular coordinates as a check. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION RPD */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION DRECTN ( 3 ) */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION F */ -/* DOUBLE PRECISION JACOBI ( 3, 3 ) */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION PGRVEL ( 3 ) */ -/* DOUBLE PRECISION RADII ( 3 ) */ -/* DOUBLE PRECISION RE */ -/* DOUBLE PRECISION RECTAN ( 3 ) */ -/* DOUBLE PRECISION RP */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* INTEGER N */ -/* C */ -/* C Load a PCK file containing a triaxial */ -/* C ellipsoidal shape model and orientation */ -/* C data for Mars. */ -/* C */ -/* CALL FURNSH ( 'pck00008.tpc' ) */ - -/* C */ -/* C Load an SPK file giving ephemerides of earth and Mars. */ -/* C */ -/* CALL FURNSH ( 'de405.bsp' ) */ - -/* C */ -/* C Load a leapseconds kernel to support time conversion. */ -/* C */ -/* CALL FURNSH ( 'naif0007.tls' ) */ - -/* C */ -/* C Look up the radii for Mars. Although we */ -/* C omit it here, we could first call BADKPV */ -/* C to make sure the variable BODY499_RADII */ -/* C has three elements and numeric data type. */ -/* C If the variable is not present in the kernel */ -/* C pool, BODVRD will signal an error. */ -/* C */ -/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */ - -/* C */ -/* C Compute flattening coefficient. */ -/* C */ -/* RE = RADII(1) */ -/* RP = RADII(3) */ -/* F = ( RE - RP ) / RE */ - -/* C */ -/* C Look up the geometric state of earth as seen from Mars at */ -/* C January 1, 2005 TDB, relative to the J2000 reference */ -/* C frame. */ -/* C */ -/* CALL STR2ET ( 'January 1, 2005 TDB', ET ) */ - -/* CALL SPKEZR ( 'Earth', ET, 'J2000', 'LT+S', */ -/* . 'Mars', STATE, LT ) */ - -/* C */ -/* C Convert position to planetographic coordinates. */ -/* C */ -/* CALL RECPGR ( 'MARS', STATE, RE, F, LON, LAT, ALT ) */ - -/* C */ -/* C Convert velocity to planetographic coordinates. */ -/* C */ - -/* CALL DPGRDR ( 'MARS', STATE(1), STATE(2), STATE(3), */ -/* . RE, F, JACOBI ) */ - -/* CALL MXV ( JACOBI, STATE(4), PGRVEL ) */ - -/* C */ -/* C As a check, convert the planetographic state back to */ -/* C rectangular coordinates. */ -/* C */ -/* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */ - -/* CALL DRDPGR ( 'MARS', LON, LAT, ALT, RE, F, JACOBI ) */ - -/* CALL MXV ( JACOBI, PGRVEL, DRECTN ) */ - - -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular coordinates:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' X (km) = ', STATE(1) */ -/* WRITE(*,*) ' Y (km) = ', STATE(2) */ -/* WRITE(*,*) ' Z (km) = ', STATE(3) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular velocity:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' dX/dt (km/s) = ', STATE(4) */ -/* WRITE(*,*) ' dY/dt (km/s) = ', STATE(5) */ -/* WRITE(*,*) ' dZ/dt (km/s) = ', STATE(6) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Ellipsoid shape parameters: ' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' Equatorial radius (km) = ', RE */ -/* WRITE(*,*) ' Polar radius (km) = ', RP */ -/* WRITE(*,*) ' Flattening coefficient = ', F */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Planetographic coordinates:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' Longitude (deg) = ', LON / RPD() */ -/* WRITE(*,*) ' Latitude (deg) = ', LAT / RPD() */ -/* WRITE(*,*) ' Altitude (km) = ', ALT */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Planetographic velocity:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' d Longitude/dt (deg/s) = ', PGRVEL(1)/RPD() */ -/* WRITE(*,*) ' d Latitude/dt (deg/s) = ', PGRVEL(2)/RPD() */ -/* WRITE(*,*) ' d Altitude/dt (km/s) = ', PGRVEL(3) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular coordinates from inverse ' // */ -/* . 'mapping:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' X (km) = ', RECTAN(1) */ -/* WRITE(*,*) ' Y (km) = ', RECTAN(2) */ -/* WRITE(*,*) ' Z (km) = ', RECTAN(3) */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) 'Rectangular velocity from inverse mapping:' */ -/* WRITE(*,*) ' ' */ -/* WRITE(*,*) ' dX/dt (km/s) = ', DRECTN(1) */ -/* WRITE(*,*) ' dY/dt (km/s) = ', DRECTN(2) */ -/* WRITE(*,*) ' dZ/dt (km/s) = ', DRECTN(3) */ -/* WRITE(*,*) ' ' */ -/* END */ - - -/* Output from this program should be similar to the following */ -/* (rounding and formatting differ across platforms): */ - - -/* Rectangular coordinates: */ - -/* X (km) = 146039732. */ -/* Y (km) = 278546607. */ -/* Z (km) = 119750315. */ - -/* Rectangular velocity: */ - -/* dX/dt (km/s) = -47.0428824 */ -/* dY/dt (km/s) = 9.07021778 */ -/* dZ/dt (km/s) = 4.75656274 */ - -/* Ellipsoid shape parameters: */ - -/* Equatorial radius (km) = 3396.19 */ -/* Polar radius (km) = 3376.2 */ -/* Flattening coefficient = 0.00588600756 */ - -/* Planetographic coordinates: */ - -/* Longitude (deg) = 297.667659 */ -/* Latitude (deg) = 20.844504 */ -/* Altitude (km) = 336531825. */ - -/* Planetographic velocity: */ - -/* d Longitude/dt (deg/s) = -8.35738632E-06 */ -/* d Latitude/dt (deg/s) = 1.59349355E-06 */ -/* d Altitude/dt (km/s) = -11.2144327 */ - -/* Rectangular coordinates from inverse mapping: */ - -/* X (km) = 146039732. */ -/* Y (km) = 278546607. */ -/* Z (km) = 119750315. */ - -/* Rectangular velocity from inverse mapping: */ - -/* dX/dt (km/s) = -47.0428824 */ -/* dY/dt (km/s) = 9.07021778 */ -/* dZ/dt (km/s) = 4.75656274 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-DEC-2004 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of rectangular w.r.t. planetographic coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("DRDPGR", (ftnlen)6); - -/* Convert the body name to an ID code. */ - - bods2c_(body, &bodyid, &found, body_len); - if (! found) { - setmsg_("The value of the input argument BODY is #, this is not a re" - "cognized name of an ephemeris object. The cause of this prob" - "lem may be that you need an updated version of the SPICE Too" - "lkit. ", (ftnlen)185); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("DRDPGR", (ftnlen)6); - return 0; - } - -/* The equatorial radius must be positive. If not, signal an error */ -/* and check out. */ - - if (*re <= 0.) { - setmsg_("Equatorial radius was #.", (ftnlen)24); - errdp_("#", re, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DRDPGR", (ftnlen)6); - return 0; - } - -/* If the flattening coefficient is greater than 1, the polar radius */ -/* is negative. If F is equal to 1, the polar radius is zero. Either */ -/* case is a problem, so signal an error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was #.", (ftnlen)29); - errdp_("#", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("DRDPGR", (ftnlen)6); - return 0; - } - -/* Look up the longitude sense override variable from the */ -/* kernel pool. */ - - repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, ( - ftnlen)1, (ftnlen)32); - gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80); - if (found) { - -/* Make sure we recognize the value of PGRLON. */ - - cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32) - ; - ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4); - if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) { - sense = 1; - } else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) { - sense = -1; - } else { - setmsg_("Kernel variable # may have the values EAST or WEST. Ac" - "tual value was #.", (ftnlen)72); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", kvalue, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("DRDPGR", (ftnlen)6); - return 0; - } - } else { - -/* Look up the spin sense of the body's prime meridian. */ - - sense = plnsns_(&bodyid); - -/* If the required prime meridian rate was not available, */ -/* PLNSNS returns the code 0. Here we consider this situation */ -/* to be an error. */ - - if (sense == 0) { - repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, ( - ftnlen)32); - setmsg_("Prime meridian rate coefficient defined by kernel varia" - "ble # is required but not available for body #. ", ( - ftnlen)103); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(MISSINGDATA)", (ftnlen)18); - chkout_("DRDPGR", (ftnlen)6); - return 0; - } - -/* Handle the special cases: earth, moon, and sun. */ - - if (bodyid == 399 || bodyid == 301 || bodyid == 10) { - sense = 1; - } - } - -/* At this point, SENSE is set to +/- 1. */ - -/* Adjust the longitude according to the sense of the body's */ -/* spin, or according to the override value if one is provided. */ -/* We want positive east longitude. */ - - geolon = sense * *lon; - -/* Now that we have geodetic longitude in hand, use the */ -/* geodetic equivalent of the input coordinates to find the */ -/* Jacobian matrix of rectangular coordinates with respect */ -/* to geodetic coordinates. */ - - drdgeo_(&geolon, lat, alt, re, f, jacobi); - -/* The matrix JACOBI is */ - -/* .- -. */ -/* | DX/DGEOLON DX/DLAT DX/DALT | */ -/* | DY/DGEOLON DY/DLAT DY/DALT | */ -/* | DZ/DGEOLON DZ/DLAT DZ/DALT | */ -/* `- -' */ - -/* which, applying the chain rule to D(*)/DGEOLON, is equivalent to */ - -/* .- -. */ -/* | (1/SENSE) * DX/DLON DX/DLAT DX/DALT | */ -/* | (1/SENSE) * DY/DLON DY/DLAT DY/DALT | */ -/* | (1/SENSE) * DZ/DLON DZ/DLAT DZ/DALT | */ -/* `- -' */ - -/* So, multiplying the first column of JACOBI by SENSE gives us the */ -/* matrix we actually want to compute: the Jacobian matrix of */ -/* rectangular coordinates with respect to planetographic */ -/* coordinates. */ - - for (i__ = 1; i__ <= 3; ++i__) { - jacobi[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("jacobi", - i__1, "drdpgr_", (ftnlen)736)] = sense * jacobi[(i__2 = i__ - - 1) < 9 && 0 <= i__2 ? i__2 : s_rnge("jacobi", i__2, "drdpgr_", - (ftnlen)736)]; - } - chkout_("DRDPGR", (ftnlen)6); - return 0; -} /* drdpgr_ */ - diff --git a/ext/spice/src/cspice/drdpgr_c.c b/ext/spice/src/cspice/drdpgr_c.c deleted file mode 100644 index c4d6f86afd..0000000000 --- a/ext/spice/src/cspice/drdpgr_c.c +++ /dev/null @@ -1,577 +0,0 @@ -/* - --Procedure drdpgr_c ( Derivative of rectangular w.r.t. planetographic ) - --Abstract - - This routine computes the Jacobian matrix of the transformation - from planetographic to rectangular coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void drdpgr_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - body I Name of body with which coordinates are associated. - lon I Planetographic longitude of a point (radians). - lat I Planetographic latitude of a point (radians). - alt I Altitude of a point above reference spheroid. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - body Name of the body with which the planetographic - coordinate system is associated. - - `body' is used by this routine to look up from the - kernel pool the prime meridian rate coefficient giving - the body's spin sense. See the Files and Particulars - header sections below for details. - - lon Planetographic longitude of the input point. This is - the angle between the prime meridian and the meridian - containing the input point. For bodies having - prograde (aka direct) rotation, the direction of - increasing longitude is positive west: from the +X - axis of the rectangular coordinate system toward the - -Y axis. For bodies having retrograde rotation, the - direction of increasing longitude is positive east: - from the +X axis toward the +Y axis. - - The earth, moon, and sun are exceptions: - planetographic longitude is measured positive east for - these bodies. - - The default interpretation of longitude by this - and the other planetographic coordinate conversion - routines can be overridden; see the discussion in - Particulars below for details. - - Longitude is measured in radians. On input, the range - of longitude is unrestricted. - - lat Planetographic latitude of the input point. For a - point P on the reference spheroid, this is the angle - between the XY plane and the outward normal vector at - P. For a point P not on the reference spheroid, the - planetographic latitude is that of the closest point - to P on the spheroid. - - Latitude is measured in radians. On input, the - range of latitude is unrestricted. - - alt Altitude of point above the reference spheroid. - Units of `alt' must match those of `re'. - - re Equatorial radius of a reference spheroid. This - spheroid is a volume of revolution: its horizontal - cross sections are circular. The shape of the - spheroid is defined by an equatorial radius `re' and - a polar radius `rp'. Units of `re' must match those of - `alt'. - - f Flattening coefficient = - - (re-rp) / re - - where `rp' is the polar radius of the spheroid, and the - units of `rp' match those of `re'. - --Detailed_Output - - JACOBI is the matrix of partial derivatives of the conversion - from planetographic to rectangular coordinates. It - has the form - - .- -. - | DX/DLON DX/DLAT DX/DALT | - | DY/DLON DY/DLAT DY/DALT | - | DZ/DLON DZ/DLAT DZ/DALT | - `- -' - - evaluated at the input values of `lon', `lat' and `alt'. - --Parameters - - None. - --Exceptions - - 1) If the body name `body' cannot be mapped to a NAIF ID code, - and if `body' is not a string representation of an integer, - the error SPICE(IDCODENOTFOUND) will be signaled. - - 2) If the kernel variable - - BODY_PGR_POSITIVE_LON - - is present in the kernel pool but has a value other - than one of - - 'EAST' - 'WEST' - - the error SPICE(INVALIDOPTION) will be signaled. Case - and blanks are ignored when these values are interpreted. - - 3) If polynomial coefficients for the prime meridian of `body' - are not available in the kernel pool, and if the kernel - variable BODY_PGR_POSITIVE_LON is not present in - the kernel pool, the error SPICE(MISSINGDATA) will be signaled. - - 4) If the equatorial radius is non-positive, the error - SPICE(VALUEOUTOFRANGE) is signaled. - - 5) If the flattening coefficient is greater than or equal to one, - the error SPICE(VALUEOUTOFRANGE) is signaled. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input - string `body' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `body' is null. - --Files - - This routine expects a kernel variable giving body's prime - meridian angle as a function of time to be available in the - kernel pool. Normally this item is provided by loading a PCK - file. The required kernel variable is named - - BODY_PM - - where represents a string containing the NAIF integer - ID code for `body'. For example, if `body' is "JUPITER", then - the name of the kernel variable containing the prime meridian - angle coefficients is - - BODY599_PM - - See the PCK Required Reading for details concerning the prime - meridian kernel variable. - - The optional kernel variable - - BODY_PGR_POSITIVE_LON - - also is normally defined via loading a text kernel. When this - variable is present in the kernel pool, the prime meridian - coefficients for `body' are not required by this routine. See the - Particulars section below for details. - --Particulars - - It is often convenient to describe the motion of an object in the - planetographic coordinate system. However, when performing - vector computations it's hard to beat rectangular coordinates. - - To transform states given with respect to planetographic - coordinates to states with respect to rectangular coordinates, - one makes use of the Jacobian of the transformation between the - two systems. - - Given a state in planetographic coordinates - - ( lon, lat, alt, dlon, dlat, dalt ) - - the velocity in rectangular coordinates is given by the matrix - equation: - - t | t - (dx, dy, dz) = jacobi| * (dlon, dlat, dalt) - |(lon,lat,alt) - - - This routine computes the matrix - - | - jacobi| - |(lon,lat,alt) - - - In the planetographic coordinate system, longitude is defined - using the spin sense of the body. Longitude is positive to the - west if the spin is prograde and positive to the east if the spin - is retrograde. The spin sense is given by the sign of the first - degree term of the time-dependent polynomial for the body's prime - meridian Euler angle "W": the spin is retrograde if this term is - negative and prograde otherwise. For the sun, planets, most - natural satellites, and selected asteroids, the polynomial - expression for W may be found in a SPICE PCK kernel. - - The earth, moon, and sun are exceptions: planetographic longitude - is measured positive east for these bodies. - - If you wish to override the default sense of positive longitude - for a particular body, you can do so by defining the kernel - variable - - BODY_PGR_POSITIVE_LON - - where represents the NAIF ID code of the body. This - variable may be assigned either of the values - - 'WEST' - 'EAST' - - For example, you can have this routine treat the longitude - of the earth as increasing to the west using the kernel - variable assignment - - BODY399_PGR_POSITIVE_LON = 'WEST' - - Normally such assignments are made by placing them in a text - kernel and loading that kernel via furnsh_c. - - The definition of this kernel variable controls the behavior of - the CSPICE planetographic routines - - pgrrec_c - recpgr_c - dpgrdr_c - drdpgr_c - - It does not affect the other CSPICE coordinate conversion - routines. - --Examples - - Numerical results shown for this example may differ between - platforms as the results depend on the SPICE kernels used as - input and the machine specific arithmetic implementation. - - - Find the planetographic state of the earth as seen from - Mars in the J2000 reference frame at January 1, 2005 TDB. - Map this state back to rectangular coordinates as a check. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local variables - ./ - SpiceDouble alt; - SpiceDouble drectn [3]; - SpiceDouble et; - SpiceDouble f; - SpiceDouble jacobi [3][3]; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble lt; - SpiceDouble pgrvel [3]; - SpiceDouble radii [3]; - SpiceDouble re; - SpiceDouble rectan [3]; - SpiceDouble rp; - SpiceDouble state [6]; - - SpiceInt n; - - - /. - Load a PCK file containing a triaxial - ellipsoidal shape model and orientation - data for Mars. - ./ - furnsh_c ( "pck00008.tpc" ); - - /. - Load an SPK file giving ephemerides of earth and Mars. - ./ - furnsh_c ( "de405.bsp" ); - - /. - Load a leapseconds kernel to support time conversion. - ./ - furnsh_c ( "naif0007.tls" ); - - /. - Look up the radii for Mars. Although we - omit it here, we could first call badkpv_c - to make sure the variable BODY499_RADII - has three elements and numeric data type. - If the variable is not present in the kernel - pool, bodvrd_c will signal an error. - ./ - bodvrd_c ( "MARS", "RADII", 3, &n, radii ); - - /. - Compute flattening coefficient. - ./ - re = radii[0]; - rp = radii[2]; - f = ( re - rp ) / re; - - /. - Look up the geometric state of earth as seen from Mars at - January 1, 2005 TDB, relative to the J2000 reference - frame. - ./ - str2et_c ( "January 1, 2005 TDB", &et); - - spkezr_c ( "Earth", et, "J2000", "LT+S", - "Mars", state, < ); - - /. - Convert position to planetographic coordinates. - ./ - recpgr_c ( "mars", state, re, f, &lon, &lat, &alt ); - - /. - Convert velocity to planetographic coordinates. - ./ - - dpgrdr_c ( "MARS", state[0], state[1], state[2], - re, f, jacobi ); - - mxv_c ( jacobi, state+3, pgrvel ); - - - /. - As a check, convert the planetographic state back to - rectangular coordinates. - ./ - pgrrec_c ( "mars", lon, lat, alt, re, f, rectan ); - drdpgr_c ( "mars", lon, lat, alt, re, f, jacobi ); - - mxv_c ( jacobi, pgrvel, drectn ); - - printf ( "\n" - "Rectangular coordinates:\n" - "\n" - " X (km) = %18.9e\n" - " Y (km) = %18.9e\n" - " Z (km) = %18.9e\n" - "\n" - "Rectangular velocity:\n" - "\n" - " dX/dt (km/s) = %18.9e\n" - " dY/dt (km/s) = %18.9e\n" - " dZ/dt (km/s) = %18.9e\n" - "\n" - "Ellipsoid shape parameters:\n" - "\n" - " Equatorial radius (km) = %18.9e\n" - " Polar radius (km) = %18.9e\n" - " Flattening coefficient = %18.9e\n" - "\n" - "Planetographic coordinates:\n" - "\n" - " Longitude (deg) = %18.9e\n" - " Latitude (deg) = %18.9e\n" - " Altitude (km) = %18.9e\n" - "\n" - "Planetographic velocity:\n" - "\n" - " d Longitude/dt (deg/s) = %18.9e\n" - " d Latitude/dt (deg/s) = %18.9e\n" - " d Altitude/dt (km/s) = %18.9e\n" - "\n" - "Rectangular coordinates from inverse mapping:\n" - "\n" - " X (km) = %18.9e\n" - " Y (km) = %18.9e\n" - " Z (km) = %18.9e\n" - "\n" - "Rectangular velocity from inverse mapping:\n" - "\n" - " dX/dt (km/s) = %18.9e\n" - " dY/dt (km/s) = %18.9e\n" - " dZ/dt (km/s) = %18.9e\n" - "\n", - state [0], - state [1], - state [2], - state [3], - state [4], - state [5], - re, - rp, - f, - lon / rpd_c(), - lat / rpd_c(), - alt, - pgrvel[0]/rpd_c(), - pgrvel[1]/rpd_c(), - pgrvel[2], - rectan [0], - rectan [1], - rectan [2], - drectn [0], - drectn [1], - drectn [2] ); - - return ( 0 ); - } - - Output from this program should be similar to the following - (rounding and formatting differ across platforms): - - - Rectangular coordinates: - - X (km) = 1.460397325e+08 - Y (km) = 2.785466068e+08 - Z (km) = 1.197503153e+08 - - Rectangular velocity: - - dX/dt (km/s) = -4.704288238e+01 - dY/dt (km/s) = 9.070217780e+00 - dZ/dt (km/s) = 4.756562739e+00 - - Ellipsoid shape parameters: - - Equatorial radius (km) = 3.396190000e+03 - Polar radius (km) = 3.376200000e+03 - Flattening coefficient = 5.886007556e-03 - - Planetographic coordinates: - - Longitude (deg) = 2.976676591e+02 - Latitude (deg) = 2.084450403e+01 - Altitude (km) = 3.365318254e+08 - - Planetographic velocity: - - d Longitude/dt (deg/s) = -8.357386316e-06 - d Latitude/dt (deg/s) = 1.593493548e-06 - d Altitude/dt (km/s) = -1.121443268e+01 - - Rectangular coordinates from inverse mapping: - - X (km) = 1.460397325e+08 - Y (km) = 2.785466068e+08 - Z (km) = 1.197503153e+08 - - Rectangular velocity from inverse mapping: - - dX/dt (km/s) = -4.704288238e+01 - dY/dt (km/s) = 9.070217780e+00 - dZ/dt (km/s) = 4.756562739e+00 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 26-DEC-2004 (NJB) (WLT) - --Index_Entries - - Jacobian of rectangular w.r.t. planetographic coordinates - --& -*/ - -{ /* Begin drdpgr_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "drdpgr_c" ); - - - /* - Check the input string body to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "drdpgr_c", body ); - - - /* - Call the f2c'd Fortran routine. - */ - drdpgr_ ( ( char * ) body, - ( doublereal * ) &lon, - ( doublereal * ) &lat, - ( doublereal * ) &alt, - ( doublereal * ) &re, - ( doublereal * ) &f, - ( doublereal * ) jacobi, - ( ftnlen ) strlen(body) ); - - /* - Convert Jacobian matrix to row-major order. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "drdpgr_c" ); - -} /* End drdpgr_c */ diff --git a/ext/spice/src/cspice/drdsph.c b/ext/spice/src/cspice/drdsph.c deleted file mode 100644 index 66bbde557a..0000000000 --- a/ext/spice/src/cspice/drdsph.c +++ /dev/null @@ -1,224 +0,0 @@ -/* drdsph.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DRDSPH ( Derivative of rectangular w.r.t. spherical ) */ -/* Subroutine */ int drdsph_(doublereal *r__, doublereal *colat, doublereal * - long__, doublereal *jacobi) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal clong, slong, ccolat, scolat; - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* spherical to rectangular coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* R I Distance of a point from the origin. */ -/* COLAT I Angle of the point from the positive Z-axis. */ -/* LONG I Angle of the point from the XY plane. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* R Distance of a point from the origin. */ - -/* COLAT Angle between the point and the positive z-axis, in */ -/* radians. */ - -/* LONG Angle of the point from the XZ plane in radians. */ -/* The angle increases in the counterclockwise sense */ -/* about the +Z axis. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between spherical and rectangular coordinates, */ -/* evaluated at the input coordinates. This matrix has */ -/* the form */ - -/* .- -. */ -/* | DX/DR DX/DCOLAT DX/DLONG | */ -/* | | */ -/* | DY/DR DY/DCOLAT DY/DLONG | */ -/* | | */ -/* | DZ/DR DZ/DCOLAT DZ/DLONG | */ -/* `- -' */ - -/* evaluated at the input values of R, LONG and LAT. */ -/* Here X, Y, and Z are given by the familiar formulae */ - -/* X = R*COS(LONG)*SIN(COLAT) */ -/* Y = R*SIN(LONG)*SIN(COLAT) */ -/* Z = R*COS(COLAT) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* It is often convenient to describe the motion of an object in */ -/* the spherical coordinate system. However, when performing */ -/* vector computations its hard to beat rectangular coordinates. */ - -/* To transform states given with respect to spherical coordinates */ -/* to states with respect to rectangular coordinates, one makes use */ -/* of the Jacobian of the transformation between the two systems. */ - -/* Given a state in spherical coordinates */ - -/* ( r, colat, long, dr, dcolat, dlong ) */ - -/* the velocity in rectangular coordinates is given by the matrix */ -/* equation: */ -/* t | t */ -/* (dx, dy, dz) = JACOBI| * (dr, dcolat, dlong ) */ -/* |(r,colat,long) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(r,colat,long) */ - -/* $ Examples */ - -/* Suppose that one has a model that gives the radius, colatitude */ -/* and longitude as a function of time (r(t), colat(t), long(t)), */ -/* for which the derivatives ( dr/dt, dcolat/dt, dlong/dt ) are */ -/* computable. */ - -/* To find the velocity of the object in bodyfixed rectangular */ -/* coordinates, one simply multiplies the Jacobian of the */ -/* transformation from spherical to rectangular coordinates */ -/* (evaluated at r(t), colat(t), long(t) ) by the vector of */ -/* derivatives of the spherical coordinates. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the derivatives of r, colat, and long into the */ -/* C spherical velocity vector SPHV. */ -/* C */ -/* SPHV(1) = DR_DT ( T ) */ -/* SPHV(2) = DCOLAT_DT ( T ) */ -/* SPHV(3) = DLONG_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C spherical to rectangular coordinates at the given */ -/* C spherical coordinates at time T. */ -/* C */ -/* CALL DRDSPH ( R(T), COLAT(T), LONG(T), JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the left times the spherical */ -/* C velocity to obtain the rectangular velocity RECV. */ -/* C */ -/* CALL MXV ( JACOBI, SPHV, RECV ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-JUL-2001 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of rectangular w.r.t. spherical coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - ccolat = cos(*colat); - scolat = sin(*colat); - clong = cos(*long__); - slong = sin(*long__); - jacobi[0] = clong * scolat; - jacobi[1] = slong * scolat; - jacobi[2] = ccolat; - jacobi[3] = *r__ * clong * ccolat; - jacobi[4] = *r__ * slong * ccolat; - jacobi[5] = -(*r__) * scolat; - jacobi[6] = -(*r__) * slong * scolat; - jacobi[7] = *r__ * clong * scolat; - jacobi[8] = 0.; - return 0; -} /* drdsph_ */ - diff --git a/ext/spice/src/cspice/drdsph_c.c b/ext/spice/src/cspice/drdsph_c.c deleted file mode 100644 index e601dd8683..0000000000 --- a/ext/spice/src/cspice/drdsph_c.c +++ /dev/null @@ -1,220 +0,0 @@ -/* - --Procedure drdsph_c ( Derivative of rectangular w.r.t. spherical ) - --Abstract - - This routine computes the Jacobian of the transformation from - spherical to rectangular coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void drdsph_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble jacobi[3][3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - r I Distance of a point from the origin. - colat I Angle of the point from the positive z-axis. - lon I Angle of the point from the xy plane. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - r Distance of a point from the origin. - - colat Angle between the point and the positive z-axis, in - radians. - - lon Angle of the point from the xz plane in radians. - The angle increases in the counterclockwise sense - about the +z axis. - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between spherical and rectangular coordinates, - evaluated at the input coordinates. This matrix has - the form - - .- -. - | dx/dr dx/dcolat dx/dlon | - | | - | dy/dr dy/dcolat dy/dlon | - | | - | dz/dr dz/dcolat dz/dlon | - `- -' - - evaluated at the input values of r, lon and lat. - Here x, y, and z are given by the familiar formulae - - x = r*cos(lon)*sin(colat) - y = r*sin(lon)*sin(colat) - z = r*cos(colat) - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - It is often convenient to describe the motion of an object in - the spherical coordinate system. However, when performing - vector computations its hard to beat rectangular coordinates. - - To transform states given with respect to spherical coordinates - to states with respect to rectangular coordinates, one uses - the Jacobian of the transformation between the two systems. - - Given a state in spherical coordinates - - ( r, colat, lon, dr, dcolat, dlon ) - - the velocity in rectangular coordinates is given by the matrix - equation: - t | t - (dx, dy, dz) = jacobi| * (dr, dcolat, dlon ) - |(r,colat,lon) - - This routine computes the matrix - - | - jacobi| - |(r,colat,lon) - --Examples - - Suppose that one has a model that gives the radius, colatitude - and longitude as a function of time (r(t), colat(t), lon(t)), - for which the derivatives ( dr/dt, dcolat/dt, dlon/dt ) are - computable. - - To find the velocity of the object in bodyfixed rectangular - coordinates, one simply multiplies the Jacobian of the - transformation from spherical to rectangular coordinates - (evaluated at r(t), colat(t), lon(t) ) by the vector of - derivatives of the spherical coordinates. - - In code this looks like: - - #include "SpiceUsr.h" - . - . - . - /. - Load the derivatives of r, colat, and lon into the - spherical velocity vector sphv. - ./ - sphv[0] = dr_dt ( t ); - sphv[1] = dcolat_dt ( t ); - sphv[2] = dlon_dt ( t ); - - /. - Determine the Jacobian of the transformation from - cylindrical to rectangular at the coordinates at the - given cylindrical coordinates at time t. - ./ - drdsph_c ( r(t), colat(t), lon(t), jacobi ); - - /. - Multiply the Jacobian on the left by the spherical - velocity to obtain the rectangular velocity recv. - ./ - mxv_c ( jacobi, sphv, recv ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 19-JUL-2001 (WLT) (IMU) (NJB) - --Index_Entries - - Jacobian of rectangular w.r.t. spherical coordinates - --& -*/ - -{ /* Begin drdsph_c */ - - - /* - Don't participate in error tracing; the underlying routine is - error-free. - */ - drdsph_ ( (doublereal *) &r, - (doublereal *) &colat, - (doublereal *) &lon, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - - -} /* End drdsph_c */ diff --git a/ext/spice/src/cspice/drotat.c b/ext/spice/src/cspice/drotat.c deleted file mode 100644 index 01af24c49f..0000000000 --- a/ext/spice/src/cspice/drotat.c +++ /dev/null @@ -1,253 +0,0 @@ -/* drotat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DROTAT ( Derivative of a rotation matrix ) */ -/* Subroutine */ int drotat_(doublereal *angle, integer *iaxis, doublereal * - dmout) -{ - /* Initialized data */ - - static integer indexs[5] = { 1,2,3,1,2 }; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - double sin(doublereal), cos(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal c__, s; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer i1, i2, i3; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Calculate the derivative with respect to the angle of rotation */ -/* of a 3x3 coordinate system rotation matrix generated by a */ -/* rotation of a specified angle about a specified axis. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATRIX */ -/* ROTATION */ -/* DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ANGLE I Angle of rotation (radians). */ -/* IAXIS I Coordinate axis number (X=1, Y=2, Z=3). */ -/* DMOUT O Derivative of rotation matrix [ANGLE] w.r.t. angle */ -/* IAXIS */ -/* $ Detailed_Input */ - -/* ANGLE The angle given in radians, through which the rotation */ -/* is performed. */ - -/* IAXIS The coordinate axis number of the rotation. The X, Y, */ -/* and Z axes have indices 1, 2 and 3 respectively. */ - -/* Together ANGLE and IAXIS define the coordinate system */ -/* rotation [ANGLE] . */ -/* IAXIS */ - -/* $ Detailed_Output */ - -/* DMOUT Derivative of rotation matrix with respect to the */ -/* angle of rotation. That is, DMOUT is the derivative */ -/* with respect to ANGLE of the matrix [ANGLE] . */ -/* IAXIS */ - -/* (The rotation matrix being differentiated describes */ -/* the rotation of the COORDINATE system through ANGLE */ -/* radians about the axis whose index is IAXIS.) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A coordinate system rotation by ANGLE radians rotation about */ -/* the first, i.e. x-axis, [ANGLE] is described by */ -/* 1 */ - -/* | 1 0 0 | */ -/* | 0 cos(ANGLE) sin(ANGLE) | */ -/* | 0 -sin(ANGLE) cos(ANGLE) | */ - -/* A coordinate system rotation by ANGLE radians rotation about the */ -/* second, i.e. y-axis, [ANGLE] is described by */ -/* 2 */ - -/* | cos(ANGLE) 0 -sin(ANGLE) | */ -/* | 0 1 0 | */ -/* | sin(ANGLE) 0 cos(ANGLE) | */ - -/* A coordinate system rotation by ANGLE radians rotation about */ -/* the third, i.e. z-axis, [ANGLE] is described by */ -/* 3 */ - -/* | cos(ANGLE) sin(ANGLE) 0 | */ -/* | -sin(ANGLE) cos(ANGLE) 0 | */ -/* | 0 0 1 | */ - -/* The derivatives of these matrices are: */ - -/* about the x-axis */ - -/* | 0 0 0 | */ -/* | 0 -sin(ANGLE) cos(ANGLE) | */ -/* | 0 -cos(ANGLE) -sin(ANGLE) | */ - -/* about the y-axis */ - -/* | -sin(ANGLE) 0 -cos(ANGLE) | */ -/* | 0 0 0 | */ -/* | cos(ANGLE) 0 -sin(ANGLE) | */ - -/* about the z-axis */ - -/* | -sin(ANGLE) cos(ANGLE) 0 | */ -/* | -cos(ANGLE) -sin(ANGLE) 0 | */ -/* | 0 0 0 | */ - -/* $ Examples */ - -/* If ROTATE is called from a FORTRAN program as follows: */ - -/* CALL DROTAT (PI()/4, 3, DMOUT) */ - -/* then DMOUT will be */ - -/* |-SQRT(2)/2 SQRT(2)/2 0 | */ -/* |-SQRT(2)/2 -SQRT(2)/2 0 | */ -/* | 0 0 0 | */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the axis index is not in the range 1 to 3 the error */ -/* 'SPICE(BADAXIS)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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, 5-NOV-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* derivative of a rotation matrix */ - -/* -& */ - -/* First make sure the input axis is reasonable. */ - - if (*iaxis > 3 || *iaxis < 1) { - chkin_("DROTAT", (ftnlen)6); - setmsg_("The input axis is out of range. Its value is #.", (ftnlen) - 48); - errint_("#", iaxis, (ftnlen)1); - sigerr_("SPICE(BADAXIS)", (ftnlen)14); - chkout_("DROTAT", (ftnlen)6); - return 0; - } - -/* Get the sine and cosine of ANGLE */ - - s = sin(*angle); - c__ = cos(*angle); - -/* Get indices for axes. The first index is for the axis of rotation. */ -/* The next two axes follow in right hand order (XYZ). */ - - i1 = indexs[(i__1 = *iaxis - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "drotat_", (ftnlen)223)]; - i2 = indexs[(i__1 = *iaxis) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "drotat_", (ftnlen)224)]; - i3 = indexs[(i__1 = *iaxis + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "drotat_", (ftnlen)225)]; - -/* Construct the rotation matrix */ - - dmout[(i__1 = i1 + i1 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)230)] = 0.; - dmout[(i__1 = i2 + i1 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)231)] = 0.; - dmout[(i__1 = i3 + i1 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)232)] = 0.; - dmout[(i__1 = i1 + i2 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)233)] = 0.; - dmout[(i__1 = i2 + i2 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)234)] = -s; - dmout[(i__1 = i3 + i2 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)235)] = -c__; - dmout[(i__1 = i1 + i3 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)236)] = 0.; - dmout[(i__1 = i2 + i3 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)237)] = c__; - dmout[(i__1 = i3 + i3 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("dmout", - i__1, "drotat_", (ftnlen)238)] = -s; - - return 0; -} /* drotat_ */ - diff --git a/ext/spice/src/cspice/dsphdr.c b/ext/spice/src/cspice/dsphdr.c deleted file mode 100644 index d16cfcd85b..0000000000 --- a/ext/spice/src/cspice/dsphdr.c +++ /dev/null @@ -1,252 +0,0 @@ -/* dsphdr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DSPHDR ( Derivative of spherical w.r.t. rectangular ) */ -/* Subroutine */ int dsphdr_(doublereal *x, doublereal *y, doublereal *z__, - doublereal *jacobi) -{ - doublereal long__, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal colat; - extern /* Subroutine */ int vpack_(doublereal *, doublereal *, doublereal - *, doublereal *); - doublereal injacb[9] /* was [3][3] */, rectan[3]; - extern /* Subroutine */ int recsph_(doublereal *, doublereal *, - doublereal *, doublereal *), drdsph_(doublereal *, doublereal *, - doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invort_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* This routine computes the Jacobian of the transformation from */ -/* rectangular to spherical coordinates. */ - -/* $ 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 */ - -/* COORDINATES */ -/* DERIVATIVES */ -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* X I X-coordinate of point. */ -/* Y I Y-coordinate of point. */ -/* Z I Z-coordinate of point. */ -/* JACOBI O Matrix of partial derivatives. */ - -/* $ Detailed_Input */ - -/* X, */ -/* Y, */ -/* Z are the rectangular coordinates of the point at */ -/* which the Jacobian of the map from rectangular */ -/* to spherical coordinates is desired. */ - -/* $ Detailed_Output */ - -/* JACOBI is the matrix of partial derivatives of the conversion */ -/* between rectangular and spherical coordinates. It */ -/* has the form */ - -/* .- -. */ -/* | DR/DX DR/DY DR/DZ | */ -/* | DCOLAT/DX DCOLAT/DY DCOLAT/DZ | */ -/* | DLONG/DX DLONG/DY DLONG/DZ | */ -/* `- -' */ - -/* evaluated at the input values of X, Y, and Z. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input point is on the Z-axis (X and Y = 0), the */ -/* Jacobian is undefined. The error SPICE(POINTONZAXIS) */ -/* will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* When performing vector calculations with velocities it is */ -/* usually most convenient to work in rectangular coordinates. */ -/* However, once the vector manipulations have been performed */ -/* it is often desirable to convert the rectangular representations */ -/* into spherical coordinates to gain insights about phenomena */ -/* in this coordinate frame. */ - -/* To transform rectangular velocities to derivatives of coordinates */ -/* in a spherical system, one uses the Jacobian of the */ -/* transformation between the two systems. */ - -/* Given a state in rectangular coordinates */ - -/* ( x, y, z, dx, dy, dz ) */ - -/* the corresponding spherical coordinate derivatives are given by */ -/* the matrix equation: */ - -/* t | t */ -/* (dr, dcolat, dlong) = JACOBI| * (dx, dy, dz) */ -/* |(x,y,z) */ - -/* This routine computes the matrix */ - -/* | */ -/* JACOBI| */ -/* |(x, y, z) */ - -/* $ Examples */ - -/* Suppose one is given the bodyfixed rectangular state of an object */ -/* (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. */ - -/* To find the derivatives of the coordinates of the object in */ -/* bodyfixed spherical coordinates, one simply multiplies the */ -/* Jacobian of the transformation from rectangular to spherical */ -/* coordinates (evaluated at x(t), y(t), z(t)) by the rectangular */ -/* velocity vector of the object at time t. */ - -/* In code this looks like: */ - -/* C */ -/* C Load the rectangular velocity vector vector RECV. */ -/* C */ -/* RECV(1) = DX_DT ( T ) */ -/* RECV(3) = DY_DT ( T ) */ -/* RECV(2) = DZ_DT ( T ) */ - -/* C */ -/* C Determine the Jacobian of the transformation from */ -/* C rectangular to spherical coordinates at the given */ -/* C rectangular coordinates at time T. */ -/* C */ -/* CALL DSPHDR ( X(T), Y(T), Z(T), JACOBI ) */ - -/* C */ -/* C Multiply the Jacobian on the right by the rectangular */ -/* C velocity to obtain the spherical coordinate derivatives */ -/* C SPHV. */ -/* C */ -/* CALL MXV ( JACOBI, RECV, SPHV ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-JUL-2001 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Jacobian of spherical w.r.t. rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DSPHDR", (ftnlen)6); - } - -/* There is a singularity of the jacobian for points on the z-axis. */ - - if (*x == 0. && *y == 0.) { - setmsg_("The Jacobian of the transformation from rectangular to sphe" - "rical coordinates is not defined for points on the z-axis.", ( - ftnlen)117); - sigerr_("SPICE(POINTONZAXIS)", (ftnlen)19); - chkout_("DSPHDR", (ftnlen)6); - return 0; - } - -/* We will get the Jacobian of the transformation from rectangular */ -/* to spherical coordinates by implicit differentiation. */ - -/* First move the X,Y and Z coordinates into a vector. */ - - vpack_(x, y, z__, rectan); - -/* Convert from rectangular to spherical coordinates. */ - - recsph_(rectan, &r__, &colat, &long__); - -/* Get the Jacobian of the transformation from spherical to */ -/* rectangular coordinates at R, COLAT, LONG. */ - - drdsph_(&r__, &colat, &long__, injacb); - -/* Now invert INJACB to get the Jacobian of the transformation from */ -/* rectangular to spherical coordinates. */ - - invort_(injacb, jacobi); - chkout_("DSPHDR", (ftnlen)6); - return 0; -} /* dsphdr_ */ - diff --git a/ext/spice/src/cspice/dsphdr_c.c b/ext/spice/src/cspice/dsphdr_c.c deleted file mode 100644 index fb30130422..0000000000 --- a/ext/spice/src/cspice/dsphdr_c.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - --Procedure dsphdr_c ( Derivative of spherical w.r.t. rectangular ) - --Abstract - - This routine computes the Jacobian of the transformation from - rectangular to spherical coordinates. - --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 - - COORDINATES - DERIVATIVES - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void dsphdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - x I x-coordinate of point. - y I y-coordinate of point. - z I z-coordinate of point. - jacobi O Matrix of partial derivatives. - --Detailed_Input - - x, - y, - z are the rectangular coordinates of the point at - which the Jacobian of the map from rectangular - to spherical coordinates is desired. - --Detailed_Output - - jacobi is the matrix of partial derivatives of the conversion - between rectangular and spherical coordinates. It - has the form - - .- -. - | dr/dx dr/dy dr/dz | - | dcolat/dx dcolat/dy dcolat/dz | - | dlon/dx dlon/dy dlon/dz | - `- -' - - evaluated at the input values of x, y, and z. - --Parameters - - None. - --Exceptions - - 1) If the input point is on the z-axis (x and y = 0), the - Jacobian is undefined. The error SPICE(POINTONZAXIS) - will be signaled. - --Files - - None. - --Particulars - - When performing vector calculations with velocities it is - usually most convenient to work in rectangular coordinates. - However, once the vector manipulations have been performed - it is often desirable to convert the rectangular representations - into spherical coordinates to gain insights about phenomena - in this coordinate frame. - - To transform rectangular velocities to derivatives of coordinates - in a spherical system, one uses the Jacobian of the transformation - between the two systems. - - Given a state in rectangular coordinates - - ( x, y, z, dx, dy, dz ) - - the corresponding spherical coordinate derivatives are given by - the matrix equation: - - t | t - (dr, dcolat, dlon) = jacobi| * (dx, dy, dz) - |(x,y,z) - - This routine computes the matrix - - | - jacobi| - |(x, y, z) - --Examples - - Suppose one is given the bodyfixed rectangular state of an object - (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. - - To find the derivatives of the coordinates of the object in - bodyfixed spherical coordinates, one simply multiplies the - Jacobian of the transformation from rectangular to spherical - coordinates (evaluated at x(t), y(t), z(t)) by the rectangular - velocity vector of the object at time t. - - In code this looks like: - - - #include "SpiceUsr.h" - . - . - . - /. - Load the rectangular velocity vector vector recv. - ./ - recv[0] = dx ( t ); - recv[1] = dy ( t ); - recv[2] = dz ( t ); - - /. - Determine the Jacobian of the transformation from rectangular to - spherical coordinates at the rectangular coordinates at time t. - ./ - dsphdr_c ( x(t), y(t), z(t), jacobi ); - - /. - Multiply the Jacobian on the right by the rectangular - velocity to obtain the spherical coordinate derivatives - sphv. - ./ - mxv_c ( jacobi, recv, sphv ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 20-JUL-2001 (WLT) (NJB) - --Index_Entries - - Jacobian of spherical w.r.t. rectangular coordinates - --& -*/ - -{ /* Begin dsphdr_c */ - - /* - Participate in error tracing. - */ - - chkin_c ( "dsphdr_c" ); - - - dsphdr_ ( (doublereal *) &x, - (doublereal *) &y, - (doublereal *) &z, - (doublereal *) jacobi ); - - /* - Transpose the Jacobian to create a C-style matrix. - */ - xpose_c ( jacobi, jacobi ); - - - chkout_c ( "dsphdr_c" ); - -} /* End dsphdr_c */ diff --git a/ext/spice/src/cspice/dtime_.c b/ext/spice/src/cspice/dtime_.c deleted file mode 100644 index 3f665ceb99..0000000000 --- a/ext/spice/src/cspice/dtime_.c +++ /dev/null @@ -1,128 +0,0 @@ -/* - --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. - -*/ - -/* - --Description - - This is a slightly modified version of the f2c library - file dtime_.c, which was included in the 1998-09-13 f2c - distribution. - - This file has been modified as follows: - - 1) This "header" text has been added. - - 2) The file optionally invokes macros that mangle the - external symbols in f2c's F77 and I77 libraries. The - purpose of this is to allow programs to link to - CSPICE and also link to Fortran objects that do - Fortran I/O. - - The mangling is invoked by defining the preprocessor - flag - - MIX_C_AND_FORTRAN - - - The name mangling capability used by this routine should only be - used as a last resort. - --Version - - -CSPICE Version 1.0.0, 19-DEC-2001 (NJB) - --& -*/ - - /* - Mangle external symbols if we're mixing C and Fortran. This - code was not in the original version of dtime_.c obtained with - the f2c distribution. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - /* - End of modification. - */ - - -#include "time.h" - -#ifdef MSDOS -#define USE_CLOCK -#endif - -#ifndef USE_CLOCK -#define _INCLUDE_POSIX_SOURCE /* for HP-UX */ -#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ -#include "sys/types.h" -#include "sys/times.h" -#endif - -#undef Hz -#ifdef CLK_TCK -#define Hz CLK_TCK -#else -#ifdef HZ -#define Hz HZ -#else -#define Hz 60 -#endif -#endif - - double -#ifdef KR_headers -dtime_(tarray) float *tarray; -#else -dtime_(float *tarray) -#endif -{ -#ifdef USE_CLOCK -#ifndef CLOCKS_PER_SECOND -#define CLOCKS_PER_SECOND Hz -#endif - static double t0; - double t = clock(); - tarray[1] = 0; - tarray[0] = (t - t0) / CLOCKS_PER_SECOND; - t0 = t; - return tarray[0]; -#else - struct tms t; - static struct tms t0; - - times(&t); - tarray[0] = (t.tms_utime - t0.tms_utime) / Hz; - tarray[1] = (t.tms_stime - t0.tms_stime) / Hz; - t0 = t; - return tarray[0] + tarray[1]; -#endif - } diff --git a/ext/spice/src/cspice/dtpool_c.c b/ext/spice/src/cspice/dtpool_c.c deleted file mode 100644 index 4ef90d1243..0000000000 --- a/ext/spice/src/cspice/dtpool_c.c +++ /dev/null @@ -1,222 +0,0 @@ -/* - --Procedure dtpool_c (Data for a kernel pool variable) - --Abstract - - Return the data about a kernel pool variable. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void dtpool_c ( ConstSpiceChar * name, - SpiceBoolean * found, - SpiceInt * n, - SpiceChar type [1] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the variable whose value is to be returned. - found O True if variable is in pool. - n O Number of values returned for name. - type O Type of the variable: 'C', 'N', or 'X' - --Detailed_Input - - name is the name of the variable whose values are to be - returned. - --Detailed_Output - - - found is SPICETRUE if the variable is in the pool; - SPICEFALSE if it is not. - - n is the number of values associated with name. - If name is not present in the pool n will be returned - with the value 0. - - type is a single character indicating the type of the variable - associated with name. - - 'C' if the data is character data - 'N' if the data is numeric. - 'X' if there is no variable name in the pool. - --Parameters - - None. - --Exceptions - - 1) If the name requested is not in the kernel pool, found - will be set to SPICEFALSE, n to zero and type to 'X'. - - 2) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 3) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled. - - --Files - - None. - --Particulars - - This routine allows you to determine whether or not a kernel - pool variable is present and to determine its size and type - if it is. - - --Examples - - - The following code fragment demonstrates how to determine the - properties of a stored kernel variable. - - #include - #include "SpiceUsr.h" - . - . - . - dtpool_c ( varnam, &found, &n, &type ); - - if ( found ) - { - printf ( "\n" - "Properties of variable %s:\n" - "\n" - " Size: %d\n", - varnam, - n ); - - if ( type == 'C' ) - { - printf ( " Type: Character\n" ); - } - else - { - printf ( " Type: Numeric\n" ); - } - } - - else - { - printf ( "%s is not present in the kernel pool.\n", varnam ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.0, 17-OCT-1999 (NJB) - - Local type logical variable now used for found flag used in - interface of dtpool_. - - -CSPICE Version 1.0.0, 10-MAR-1999 (NJB) - --Index_Entries - - return summary information about a kernel pool variable - --& -*/ - -{ /* Begin dtpool_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "dtpool_c" ); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "dtpool_c", name ); - - - /* - Call the f2c'd routine. - */ - dtpool_ ( ( char * ) name, - ( logical * ) &fnd, - ( integer * ) n, - ( char * ) type, - ( ftnlen ) strlen(name), - ( ftnlen ) 1 ); - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - chkout_c ( "dtpool_c" ); - -} /* End dtpool_c */ - diff --git a/ext/spice/src/cspice/ducrss.c b/ext/spice/src/cspice/ducrss.c deleted file mode 100644 index 5f8c33f78a..0000000000 --- a/ext/spice/src/cspice/ducrss.c +++ /dev/null @@ -1,194 +0,0 @@ -/* ducrss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DUCRSS ( Unit Normalized Cross Product and Derivative ) */ -/* Subroutine */ int ducrss_(doublereal *s1, doublereal *s2, doublereal *sout) -{ - extern /* Subroutine */ int dvhat_(doublereal *, doublereal *), dvcrss_( - doublereal *, doublereal *, doublereal *); - doublereal tmpsta[6]; - -/* $ Abstract */ - -/* Compute the unit vector parallel to the cross product of */ -/* two 3-dimensional vectors and the derivative of this unit vector. */ - -/* $ 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 */ - -/* VECTOR */ -/* DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S1 I Left hand state for cross product and derivative. */ -/* S2 I Right hand state for cross product and derivative. */ -/* SOUT O Unit vector and derivative of the cross product. */ - -/* $ Detailed_Input */ - -/* S1 This may be any state vector. Typically, this */ -/* might represent the apparent state of a planet or the */ -/* Sun, which defines the orientation of axes of */ -/* some coordinate system. */ - -/* S2 Any state vector. */ - -/* $ Detailed_Output */ - -/* SOUT This variable represents the unit vector parallel to the */ -/* cross product of the position components of S1 and S2 */ -/* and the derivative of the unit vector. */ - -/* If the cross product of the position components is */ -/* the zero vector, then the position component of the */ -/* output will be the zero vector. The velocity component */ -/* of the output will simply be the derivative of the */ -/* cross product of the position components of S1 and S2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the position components of S1 and S2 cross together to */ -/* give a zero vector, the position component of the output */ -/* will be the zero vector. The velocity component of the */ -/* output will simply be the derivative of the cross product */ -/* of the position vectors. */ - -/* 2) If S1 and S2 are large in magnitude (taken together, */ -/* their magnitude surpasses the limit allowed by the */ -/* computer) then it may be possible to generate a */ -/* floating point overflow from an intermediate */ -/* computation even though the actual cross product and */ -/* derivative may be well within the range of double */ -/* precision numbers. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DUCRSS calculates the unit vector parallel to the cross product */ -/* of two vectors and the derivative of that unit vector. */ - -/* $ Examples */ - -/* One often constructs non-inertial coordinate frames from */ -/* apparent positions of objects. However, if one wants to convert */ -/* states in this non-inertial frame to states in an inertial */ -/* reference frame, the derivatives of the axes of the non-inertial */ -/* frame are required. For example consider an Earth meridian */ -/* frame defined as follows. */ - -/* The z-axis of the frame is defined to be the vector */ -/* normal to the plane spanned by the position vectors to the */ -/* apparent Sun and to the apparent body as seen from an observer. */ - -/* Let SUN be the apparent state of the Sun and let BODY be the */ -/* apparent state of the body with respect to the observer. Then */ -/* the unit vector parallel to the z-axis of the Earth meridian */ -/* system and its derivative are given by the call: */ - -/* CALL DUCRSS ( SUN, BODY, ZZDOT ) */ - -/* $ Restrictions */ - -/* No checking of S1 or S2 is done to prevent floating point */ -/* overflow. The user is required to determine that the magnitude */ -/* of each component of the states is within an appropriate range */ -/* so as not to cause floating point overflow. In almost every case */ -/* there will be no problem and no checking actually needs to be */ -/* done. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.1.0, 30-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in DVHAT call. */ - -/* - SPICELIB Version 1.0.0, 15-JUN-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Compute a unit cross product and its derivative */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in DVHAT call. */ - -/* -& */ - -/* Local variables */ - - -/* Not much to this. Just get the cross product and its derivative. */ -/* Using that, get the associated unit vector and its derivative. */ - - dvcrss_(s1, s2, tmpsta); - dvhat_(tmpsta, sout); - return 0; -} /* ducrss_ */ - diff --git a/ext/spice/src/cspice/ducrss_c.c b/ext/spice/src/cspice/ducrss_c.c deleted file mode 100644 index 2d9a62a436..0000000000 --- a/ext/spice/src/cspice/ducrss_c.c +++ /dev/null @@ -1,189 +0,0 @@ -/* - --Procedure ducrss_c ( Unit Normalized Cross Product and Derivative ) - --Abstract - - Compute the unit vector parallel to the cross product of - two 3-dimensional vectors and the derivative of this unit vector. - --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 - - VECTOR - DERIVATIVE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef ducrss_c - - void ducrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ) - -/* - --Brief_I/O - - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s1 I Left hand state for cross product and derivative. - s2 I Right hand state for cross product and derivative. - sout O Unit vector and derivative of the cross product. - --Detailed_Input - - s1 This may be any state vector. Typically, this - might represent the apparent state of a planet or the - Sun, which defines the orientation of axes of - some coordinate system. - - s2 Any state vector. - --Detailed_Output - - sout This variable represents the unit vector parallel to the - cross product of the position components of 's1' and 's2' - and the derivative of the unit vector. - - If the cross product of the position components is - the zero vector, then the position component of the - output will be the zero vector. The velocity component - of the output will simply be the derivative of the - cross product of the position components of 's1' and 's2'. - - 'sout' may overwrite 's1' or 's2'. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If the position components of 's1' and 's2' cross together to - give a zero vector, the position component of the output - will be the zero vector. The velocity component of the - output will simply be the derivative of the cross product - of the position vectors. - - 2) If 's1' and 's2' are large in magnitude (taken together, - their magnitude surpasses the limit allowed by the - computer) then it may be possible to generate a - floating point overflow from an intermediate - computation even though the actual cross product and - derivative may be well within the range of double - precision numbers. - --Files - - None. - --Particulars - - ducrss_c calculates the unit vector parallel to the cross product - of two vectors and the derivative of that unit vector. - The results of the computation may overwrite either of the - input vectors. - --Examples - - One often constructs non-inertial coordinate frames from - apparent positions of objects. However, if one wants to convert - states in this non-inertial frame to states in an inertial - reference frame, the derivatives of the axes of the non-inertial - frame are required. For example consider an Earth meridian - frame defined as follows. - - The z-axis of the frame is defined to be the vector - normal to the plane spanned by the position vectors to the - apparent Sun and to the apparent body as seen from an observer. - - Let 'sun' be the apparent state of the Sun and let 'body' be the - apparent state of the body with respect to the observer. Then - the unit vector parallel to the z-axis of the Earth meridian - system and its derivative are given by the call: - - ducrss_c ( sun, body, zzdot ); - --Restrictions - - No checking of 's1' or 's2' is done to prevent floating point - overflow. The user is required to determine that the magnitude - of each component of the states is within an appropriate range - so as not to cause floating point overflow. In almost every case - there will be no problem and no checking actually needs to be - done. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 23-NOV-2009 (EDW) - --Index_Entries - - Compute a unit cross product and its derivative - --& -*/ - -{ /* Begin ducrss_c */ - - /* - Local variables - */ - - SpiceDouble tmpsta[6]; - - /* - Not much to this. Just get the cross product and its derivative. - Using that, get the associated unit vector and its derivative. - */ - dvcrss_c ( s1, s2, tmpsta ); - dvhat_c ( tmpsta, sout ); - -} /* End ducrss_c */ - - diff --git a/ext/spice/src/cspice/due.c b/ext/spice/src/cspice/due.c deleted file mode 100644 index 83f4dc00a4..0000000000 --- a/ext/spice/src/cspice/due.c +++ /dev/null @@ -1,70 +0,0 @@ -#include "f2c.h" -#include "fio.h" - -#ifdef KR_headers -c_due(a) cilist *a; -#else -c_due(cilist *a) -#endif -{ - if(!f__init) f_init(); - f__sequential=f__formatted=f__recpos=0; - f__external=1; - f__curunit = &f__units[a->ciunit]; - if(a->ciunit>=MXUNIT || a->ciunit<0) - err(a->cierr,101,"startio"); - f__elist=a; - if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due"); - f__cf=f__curunit->ufd; - if(f__curunit->ufmt) err(a->cierr,102,"cdue") - if(!f__curunit->useek) err(a->cierr,104,"cdue") - if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue") - if(a->cirec <= 0) - err(a->cierr,130,"due") - fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET); - f__curunit->uend = 0; - return(0); -} -#ifdef KR_headers -integer s_rdue(a) cilist *a; -#else -integer s_rdue(cilist *a) -#endif -{ - int n; - f__reading=1; - if(n=c_due(a)) return(n); - if(f__curunit->uwrt && f__nowreading(f__curunit)) - err(a->cierr,errno,"read start"); - return(0); -} -#ifdef KR_headers -integer s_wdue(a) cilist *a; -#else -integer s_wdue(cilist *a) -#endif -{ - int n; - f__reading=0; - if(n=c_due(a)) return(n); - if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) - err(a->cierr,errno,"write start"); - return(0); -} -integer e_rdue(Void) -{ - if(f__curunit->url==1 || f__recpos==f__curunit->url) - return(0); - fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR); - if(ftell(f__cf)%f__curunit->url) - err(f__elist->cierr,200,"syserr"); - return(0); -} -integer e_wdue(Void) -{ -#ifdef ALWAYS_FLUSH - if (fflush(f__cf)) - err(f__elist->cierr,errno,"write end"); -#endif - return(e_rdue()); -} diff --git a/ext/spice/src/cspice/dvcrss.c b/ext/spice/src/cspice/dvcrss.c deleted file mode 100644 index 0ab8a4ceab..0000000000 --- a/ext/spice/src/cspice/dvcrss.c +++ /dev/null @@ -1,166 +0,0 @@ -/* dvcrss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DVCRSS ( Derivative of Vector cross product ) */ -/* Subroutine */ int dvcrss_(doublereal *s1, doublereal *s2, doublereal *sout) -{ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal vtemp[3]; - extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal - *); - doublereal dvtmp1[3], dvtmp2[3]; - -/* $ Abstract */ - -/* Compute the cross product of two 3-dimensional vectors */ -/* and the derivative of this cross product. */ - -/* $ 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 */ - -/* VECTOR */ -/* DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S1 I Left hand state for cross product and derivative. */ -/* S2 I Right hand state for cross product and derivative. */ -/* SOUT O State associated with cross product of positions. */ - -/* $ Detailed_Input */ - -/* S1 This may be any state vector. Typically, this */ -/* might represent the apparent state of a planet or the */ -/* Sun, which defines the orientation of axes of */ -/* some coordinate system. */ - -/* S2 A state vector. */ - -/* $ Detailed_Output */ - -/* SOUT This variable represents the state associated with the */ -/* cross product of the position components of S1 and S2. */ -/* In other words, if S1 = (P1,V1) and S2 = (P2,V2) then */ -/* SOUT is ( P1xP2, d/dt{ P1xP2 } ). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If S1 and S2 are large in magnitude (taken together, */ -/* their magnitude surpasses the limit allowed by the */ -/* computer) then it may be possible to generate a */ -/* floating point overflow from an intermediate */ -/* computation even though the actual cross product and */ -/* derivative may be well within the range of double */ -/* precision numbers. */ - -/* DVCRSS does NOT check the magnitude of S1 or S2 to */ -/* insure that overflow will not occur. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DVCRSS calculates the three-dimensional cross product of two */ -/* vectors and the derivative of that cross product according to */ -/* the definition. */ - -/* $ Examples */ - -/* S1 S2 SOUT */ -/* ----------------------------------------------------------------- */ -/* (0, 1, 0, 1, 0, 0) ( 1, 0, 0, 1, 0, 0) (0, 0, -1, 0, 0, -1 ) */ -/* (5, 5, 5, 1, 0, 0) (-1, -1, -1, 2, 0, 0) (0, 0, 0, 0, 11,-11 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.0.0, 15-JUN-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Compute the derivative of a cross product */ - -/* -& */ - - -/* Local Variables */ - - -/* Calculate the cross product of S1 and S2, store it in VTEMP. */ - - vcrss_(s1, s2, vtemp); - -/* Calculate the two components of the derivative of S1 x S2. */ - - vcrss_(&s1[3], s2, dvtmp1); - vcrss_(s1, &s2[3], dvtmp2); - -/* Put all of the pieces into SOUT. */ - - vequ_(vtemp, sout); - vadd_(dvtmp1, dvtmp2, &sout[3]); - return 0; -} /* dvcrss_ */ - diff --git a/ext/spice/src/cspice/dvcrss_c.c b/ext/spice/src/cspice/dvcrss_c.c deleted file mode 100644 index 958ac79afb..0000000000 --- a/ext/spice/src/cspice/dvcrss_c.c +++ /dev/null @@ -1,175 +0,0 @@ -/* - --Procedure dvcrss_c ( Derivative of Vector cross product ) - --Abstract - - Compute the cross product of two 3-dimensional vectors - and the derivative of this cross product. - --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 - - VECTOR - DERIVATIVE - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef dvcrss_c - - void dvcrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s1 I Left hand state for cross product and derivative. - s2 I Right hand state for cross product and derivative. - sout O State associated with cross product of positions. - --Detailed_Input - - s1 This may be any state vector. Typically, this - might represent the apparent state of a planet or the - Sun, which defines the orientation of axes of - some coordinate system. - - s2 A state vector. - --Detailed_Output - - sout This variable represents the state associated with the - cross product of the position components of 's1' and 's2.' - In otherwords if s1 = (P1,V1) and s2 = (P2,V2) then - 'sout' is ( P1xP2, d/dt{ P1xP2 } ) - - 'sout' may overwrite 's1' or 's2'. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If 's1' and 's2' are large in magnitude (taken together, - their magnitude surpasses the limit allow by the - computer) then it may be possible to generate a - floating point overflow from an intermediate - computation even though the actual cross product and - derivative may be well within the range of double - precision numbers. - - dvcrss_c does NOT check the magnitude of 's1' or 's2' to - insure that overflow will not occur. - --Files - - None. - --Particulars - - dvcrss_c calculates the three-dimensional cross product of two - vectors and the derivative of that cross product according to - the definition. The components of this state are stored - in a local buffer vector until the calculation is complete. - Thus sout may overwrite 's1' or 's2' without interfering with - intermediate computations. - --Examples - - s1 s2 sout - ----------------------------------------------------------------- - (0, 1, 0, 1, 0, 0) ( 1, 0, 0, 1, 0, 0) (0, 0, -1, 0, 0, -1 ) - (5, 5, 5, 1, 0, 0) (-1, -1, -1, 2, 0, 0) (0, 0, 0, 0, 11,-11 ) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 23-NOV-2009 (EDW) - --Index_Entries - - Compute the derivative of a cross product - --& -*/ - -{ /* Begin dvcrss_c */ - - /* - Local variables - */ - - SpiceDouble vtemp [3]; - SpiceDouble dvtmp1[6]; - SpiceDouble dvtmp2[6]; - - /* - Calculate the cross product of 's1' and 's2', store it in 'vtemp'. - */ - vcrss_c (s1, s2, vtemp ); - - /* - Calculate the two components of the derivative of s1 x s2. - */ - vcrss_c ( &(s1[3]), s2, dvtmp1 ); - vcrss_c ( s1, &(s2[3]), dvtmp2 ); - - /* - Put all of the pieces into 'sout'. - */ - vequ_c ( vtemp, sout ); - vadd_c ( dvtmp1, dvtmp2, &(sout[3])); - -} /* End dvcrss_c */ - diff --git a/ext/spice/src/cspice/dvdot.c b/ext/spice/src/cspice/dvdot.c deleted file mode 100644 index 7d1683c480..0000000000 --- a/ext/spice/src/cspice/dvdot.c +++ /dev/null @@ -1,158 +0,0 @@ -/* dvdot.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DVDOT ( Derivative of Vector Dot Product, 3-D ) */ -doublereal dvdot_(doublereal *s1, doublereal *s2) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Compute the derivative of the dot product of two double */ -/* precision position vectors. */ - -/* $ 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 */ - -/* VECTOR */ -/* DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S1 I First state vector in the dot product. */ -/* S2 I Second state vector in the dot product. */ - -/* The function returns the derivative of the dot product */ - -/* $ Detailed_Input */ - -/* S1 Any state vector. The componets are in order */ -/* (x, y, z, dx/dt, dy/dt, dz/dt ) */ - -/* S2 Any state vector. */ - -/* $ Detailed_Output */ - -/* The function returns the derivative of the dot product of the */ -/* position portions of the two state vectors S1 and S2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* Given two state vectors S1 and S2 made up of position and */ -/* velocity components (P1,V1) and (P2,V2) respectively, */ -/* DVDOT calculates the derivative of the dot product of P1 and P2, */ -/* i.e. the time derivative */ - -/* d */ -/* -- < P1, P2 > = < V1, P2 > + < P1, V2 > */ -/* dt */ - -/* where <,> denotes the dot product operation. */ - -/* $ Examples */ - -/* Suppose that given two state vectors (S1 and S2)whose position */ -/* components are unit vectors, and that we need to compute the */ -/* rate of change of the angle between the two vectors. */ - -/* We know that the Cosine of the angle THETA between them is given */ -/* by */ - -/* COSINE(THETA) = VDOT(S1,S2) */ - -/* Thus by the chain rule, the derivative of the angle is given */ -/* by: */ - -/* SINE(THETA) dTHETA/dt = DVDOT(S1,S2) */ - -/* Thus for values of THETA away from zero we can compute */ - -/* dTHETA/dt as */ - -/* DTHETA = DVDOT(S1,S2) / SQRT ( 1 - VDOT(S1,S2)**2 ) */ - -/* Note that position components of S1 and S2 are parallel, the */ -/* derivative of the angle between the positions does not */ -/* exist. Any code that computes the derivative of the angle */ -/* between two position vectors should account for the case */ -/* when the position components are parallel. */ - -/* $ Restrictions */ - -/* The user is responsible for determining that the states S1 and */ -/* S2 are not so large as to cause numeric overflow. In most cases */ -/* this won't present a problem. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-MAY-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Compute the derivative of a dot product */ - -/* -& */ - - ret_val = s1[0] * s2[3] + s1[1] * s2[4] + s1[2] * s2[5] + s1[3] * s2[0] + - s1[4] * s2[1] + s1[5] * s2[2]; - return ret_val; -} /* dvdot_ */ - diff --git a/ext/spice/src/cspice/dvdot_c.c b/ext/spice/src/cspice/dvdot_c.c deleted file mode 100644 index cd7f4109ce..0000000000 --- a/ext/spice/src/cspice/dvdot_c.c +++ /dev/null @@ -1,159 +0,0 @@ -/* - --Procedure dvdot_c ( Derivative of Vector Dot Product, 3-D ) - --Abstract - - Compute the derivative of the dot product of two double - precision position vectors. - --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 - - VECTOR - DERIVATIVE - -*/ - - #include "SpiceUsr.h" - #undef dvdot_c - - SpiceDouble dvdot_c ( ConstSpiceDouble s1[6], - ConstSpiceDouble s2[6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s1 I First state vector in the dot product. - s2 I Second state vector in the dot product. - - The function returns the derivative of the dot product - --Detailed_Input - - s1 Any state vector. The components are in order - (x, y, z, dx/dt, dy/dt, dz/dt ) - - s2 Any state vector. - --Detailed_Output - - The function returns the derivative of the dot product of the - position portions of the two state vectors s1 and s2. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - --Particulars - - Given two state vectors s1 and s2 made up of position and - velocity components (p1,v1) and (p2,v2) respectively, - dvdot_c calculates the derivative of the dot product of p1 and p2, - i.e. the time derivative - - d - -- < p1, p2 > = < v1, p2 > + < p1, v2 > - dt - - where <,> denotes the dot product operation. - --Examples - - Suppose that given two state vectors (s1 and s2)whose position - components are unit vectors, and that we need to compute the - rate of change of the angle between the two vectors. - - We know that the Cosine of the angle (theta) between the vectors is - given by - - cosine(theta) = vdot_c(s1,s2) - - Thus by the chain rule, the derivative of the angle is given - by: - - sine(theta) dtheta/dt = dvdot_c(s1,s2) - - Thus for values of theta away from zero we can compute - - dtheta/dt as - - dtheta = dvdot_c(s1,s2) / sqrt ( 1 - vdot_c(s1,s2)**2 ) - - Note if the position components of s1 and s2 are parallel, the - derivative of the angle between the positions does not - exist. Any code that computes the derivative of the angle - between two position vectors should account for the case - when the position components are parallel. - --Restrictions - - The user is responsible for determining that the states s1 and - s2 are not so large as to cause numeric overflow. In most cases - this won't present a problem. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 7-JUL-1999 - --Index_Entries - - Compute the derivative of a dot product - --& -*/ - -{ /* Begin dvdot_c */ - - return ( s1[0]*s2[3] + s1[1]*s2[4] + s1[2]*s2[5] - + s1[3]*s2[0] + s1[4]*s2[1] + s1[5]*s2[2] ); - -} /* End dvdot_c */ diff --git a/ext/spice/src/cspice/dvhat.c b/ext/spice/src/cspice/dvhat.c deleted file mode 100644 index 43ab077863..0000000000 --- a/ext/spice/src/cspice/dvhat.c +++ /dev/null @@ -1,249 +0,0 @@ -/* dvhat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DVHAT ( Derivative and unit vector "V-hat" of a state) */ -/* Subroutine */ int dvhat_(doublereal *s1, doublereal *sout) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), vperp_( - doublereal *, doublereal *, doublereal *), unorm_(doublereal *, - doublereal *, doublereal *); - doublereal length; - extern /* Subroutine */ int vsclip_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Find the unit vector corresponding to a state vector and the */ -/* derivative of the unit vector. */ - -/* $ 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 */ - -/* VECTOR */ -/* DERIVATIVE */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S1 I State to be normalized. */ -/* SOUT O Unit vector S1 / |S1|, and its time derivative. */ - -/* $ Detailed_Input */ - -/* S1 This is any double precision state. If the position */ -/* component of the state is the zero vector, this routine */ -/* will detect it and will not attempt to divide by zero. */ - -/* $ Detailed_Output */ - -/* SOUT SOUT is a state containing the unit vector pointing in */ -/* the direction of position component of S1 and the */ -/* derivative of the unit vector with respect to time. */ - -/* SOUT may overwrite S1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If S1 represents the zero vector, then the position */ -/* component of SOUT will also be the zero vector. The */ -/* velocity component will be the velocity component */ -/* of S1. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let S1 be a state vector with position and velocity components P */ -/* and V respectively. From these components one can compute the */ -/* unit vector parallel to P, call it U and the derivative of U */ -/* with respect to time, DU. This pair (U,DU) is the state returned */ -/* by this routine in SOUT. */ - -/* $ Examples */ - -/* Any numerical results shown for this example may differ between */ -/* platforms as the results depend on the SPICE kernels used as input */ -/* and the machine specific arithmetic implementation. */ - -/* Suppose that STATE gives the apparent state of a body with */ -/* respect to an observer. This routine can be used to compute the */ -/* instantaneous angular rate of the object across the sky as seen */ -/* from the observers vantage. */ - -/* PROGRAM DVHAT_T */ -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION OMEGA */ -/* DOUBLE PRECISION STATE (6) */ -/* DOUBLE PRECISION USTATE (6) */ - -/* DOUBLE PRECISION VNORM */ - -/* CHARACTER*(32) EPOCH */ -/* CHARACTER*(32) TARGET */ -/* CHARACTER*(32) FRAME */ -/* CHARACTER*(32) ABCORR */ -/* CHARACTER*(32) OBSRVR */ - -/* C */ -/* C Load SPK, PCK, and LSK kernels, use a meta kernel for */ -/* C convenience. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Define an arbitrary epoch, convert the epoch to ephemeris */ -/* C time. */ -/* C */ -/* EPOCH = 'Jan 1 2009' */ -/* CALL STR2ET ( EPOCH, ET ) */ - -/* C */ -/* C Calculate the state of the moon with respect to the */ -/* C earth-moon barycenter in J2000, corrected for light time */ -/* C and stellar aberration at ET. */ -/* C */ -/* TARGET = 'MOON' */ -/* FRAME = 'J2000' */ -/* ABCORR = 'LT+S' */ -/* OBSRVR = 'EARTH BARYCENTER' */ - -/* CALL SPKEZR ( TARGET, ET, FRAME, ABCORR, OBSRVR, STATE, LT ) */ - -/* C */ -/* C Calculate the unit vector of STATE and the derivative of the */ -/* C unit vector. */ -/* C */ -/* CALL DVHAT ( STATE, USTATE ) */ - -/* C */ -/* C Calculate the instantaneous angular velocity from the */ -/* C magnitude of the derivative of the unit vector. */ -/* C */ -/* C v = r x omega */ -/* C */ -/* C ||omega|| = ||v|| for r . v = 0 */ -/* C ----- */ -/* C ||r|| */ -/* C */ -/* C ||omega|| = ||v|| for ||r|| = 1 */ -/* C */ -/* OMEGA = VNORM( USTATE(4) ) */ - -/* WRITE(*,*) 'Instantaneous angular velocity, rad/sec', OMEGA */ - -/* END */ - -/* The program outputs: */ - -/* Instantaneous angular velocity, rad/sec 2.48106658E-06 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 06-MAY-2010 (EDW) */ - -/* Expanded the code example into a complete program. */ - -/* Reordered header sections to proper NAIF convention. */ -/* Removed Revision section, it listed a duplication of a */ -/* Version section entry. */ - -/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VPERP and VSCL calls. */ - -/* - SPICELIB Version 1.0.0, 15-JUN-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* State of a unit vector parallel to a state vector */ - -/* -& */ - -/* Get the position portion of the output state and the length of */ -/* the input position. */ - - unorm_(s1, sout, &length); - if (length == 0.) { - -/* If the length of the input position is zero, just copy */ -/* the input velocity to the output velocity. */ - - vequ_(&s1[3], &sout[3]); - } else { - -/* Otherwise the derivative of the unit vector is just the */ -/* component of the input velocity perpendicular to the input */ -/* position, scaled by the reciprocal of the length of the */ -/* input position. */ - - vperp_(&s1[3], sout, &sout[3]); - d__1 = 1. / length; - vsclip_(&d__1, &sout[3]); - } - return 0; -} /* dvhat_ */ - diff --git a/ext/spice/src/cspice/dvhat_c.c b/ext/spice/src/cspice/dvhat_c.c deleted file mode 100644 index c9ca4d25a6..0000000000 --- a/ext/spice/src/cspice/dvhat_c.c +++ /dev/null @@ -1,271 +0,0 @@ -/* - --Procedure dvhat_c ( Derivative and unit vector "V-hat" of a state) - --Abstract - - Find the unit vector corresponding to a state vector and the - derivative of the unit vector. - --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 - - VECTOR - DERIVATIVE - MATH - -*/ - #include "SpiceUsr.h" - #undef dvhat_c - - void dvhat_c ( ConstSpiceDouble s1 [6], - SpiceDouble sout[6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s1 I State to be normalized. - sout O Unit vector s1 / |s1|, and its time derivative. - --Detailed_Input - - s1 This is any double precision state. If the position - component of the state is the zero vector, this routine - will detect it and will not attempt to divide by zero. - --Detailed_Output - - sout sout is a state containing the unit vector pointing in - the direction of position component of s1 and the - derivative of the unit vector with respect to time. - - sout may overwrite s1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If s1 represents the zero vector, then the position - component of sout will also be the zero vector. The - velocity component will be the velocity component - of s1. - --Files - - None. - --Particulars - - Let s1 be a state vector with position and velocity components p - and v respectively. From these components one can compute the - unit vector parallel to p, call it u and the derivative of u - with respect to time, du. This pair (u,du) is the state returned - by this routine in sout. - --Examples - - Any numerical results shown for this example may differ between - platforms as the results depend on the SPICE kernels used as input - and the machine specific arithmetic implementation. - - Suppose that 'state' gives the apparent state of a body with - respect to an observer. This routine can be used to compute the - instantaneous angular rate of the object across the sky as seen - from the observers vantage. - - #include "SpiceUsr.h" - #include - #include - - int main() - { - - SpiceDouble et; - SpiceDouble ltime; - SpiceDouble omega; - SpiceDouble state [6]; - SpiceDouble ustate [6]; - - SpiceChar * epoch = "Jan 1 2009"; - SpiceChar * target = "MOON"; - SpiceChar * frame = "J2000"; - SpiceChar * abcorr = "LT+S"; - SpiceChar * obsrvr = "EARTH BARYCENTER"; - - /. - Load SPK, PCK, and LSK kernels, use a meta kernel for convenience. - ./ - furnsh_c ( "standard.tm" ); - - /. - Define an arbitrary epoch, convert the epoch to ephemeris time. - ./ - str2et_c ( epoch, &et ); - - /. - Calculate the state of the moon with respect to the earth-moon - barycenter in J2000, corrected for light time and stellar aberration - at ET. - ./ - - spkezr_c ( target, et, frame, abcorr, obsrvr, state, <ime ); - - /. - Calculate the unit vector of STATE and the derivative of the - unit vector. - ./ - dvhat_c ( state, ustate ); - - /. - Calculate the instantaneous angular velocity from the magnitude of the - derivative of the unit vector. - - v = r x omega - - ||omega|| = ||v|| for r . v = 0 - ----- - ||r|| - - ||omega|| = ||v|| for ||r|| = 1 - ./ - omega = vnorm_c( &ustate[3] ); - - printf( "Instantaneous angular velocity, rad/sec %.10g\n", omega ); - - return 0; - } - - The program outputs: - - Instantaneous angular velocity, rad/sec 2.48106658e-06 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 06-MAY-2010 (EDW) - - Reordered header sections to proper NAIF convention. - Minor edit to code comments eliminating typo. - - -CSPICE Version 1.0.0, 07-JUL-1999 (EDW) - --Index_Entries - - State of a unit vector parallel to a state vector - --& -*/ - -{ /* Begin dvhat_c */ - - /* - Local variables - */ - SpiceDouble length; - SpiceDouble posin [3]; - SpiceDouble posout[3]; - SpiceDouble velin [3]; - SpiceDouble velout[3]; - - - /* - We'll do this the obvious way for now. Unpack the input vector - into two working vectors. - */ - posin[0] = s1[0]; - posin[1] = s1[1]; - posin[2] = s1[2]; - velin[0] = s1[3]; - velin[1] = s1[4]; - velin[2] = s1[5]; - - - /* - Get the position portion of the output state and the length of - the input position. - */ - unorm_c ( posin, posout, &length ); - - if ( length == 0. ) - { - - /* - If the length of the input position is zero, just copy - the input velocity to the output velocity. - */ - vequ_c ( velin, velout ); - - } - else - { - - /* - Otherwise the derivative of the unit vector is just the - component of the input velocity perpendicular to the input - position, scaled by the reciprocal of the length of the - input position. - */ - vperp_c ( velin , posout, velout ); - vscl_c ( 1./length, velout, velout ); - - } - - - /* - Pack everything and return. Hazar! - */ - sout[0] = posout[0]; - sout[1] = posout[1]; - sout[2] = posout[2]; - sout[3] = velout[0]; - sout[4] = velout[1]; - sout[5] = velout[2]; - -} /* End dvhat_c */ diff --git a/ext/spice/src/cspice/dvnorm.c b/ext/spice/src/cspice/dvnorm.c deleted file mode 100644 index 7accb4043b..0000000000 --- a/ext/spice/src/cspice/dvnorm.c +++ /dev/null @@ -1,254 +0,0 @@ -/* dvnorm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DVNORM ( Derivative of vector norm ) */ -doublereal dvnorm_(doublereal *state) -{ - /* System generated locals */ - doublereal ret_val; - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal xhat[3]; - extern doublereal vdot_(doublereal *, doublereal *), vnorm_(doublereal *); - -/* $ Abstract */ - -/* Function to calculate the derivative of the norm of a 3-vector. */ - -/* $ 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 */ - -/* DERIVATIVE */ -/* MATH */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STATE I A 6-vector composed of three coordinates and their */ -/* derivatives. */ - -/* $ Detailed_Input */ - -/* STATE A double precision 6-vector, the second three */ -/* components being the derivatives of the first three */ -/* with respect to some scalar. */ - -/* STATE = ( x, dx ) */ -/* -- */ -/* ds */ - -/* A common form for STATE would contain position and */ -/* velocity. */ - -/* $ Detailed_Output */ - -/* DVNORM The value of d||x|| corresponding to STATE. */ -/* ------ */ -/* ds */ - -/* 1/2 2 2 2 1/2 */ -/* where ||x|| = < x, x > = ( x1 + x2 + x3 ) */ - - -/* v = ( dx1, dx2, dx3 ) */ -/* --- --- --- */ -/* ds ds ds */ - -/* d||x|| < x, v > */ -/* ------ = ------ = < xhat, v > */ -/* ds 1/2 */ -/* < x, x > */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A common use for this routine is to calculate the time derivative */ -/* of the radius corresponding to a state vector. */ - -/* $ Examples */ - -/* Any numerical results shown for this example may differ between */ -/* platforms as the results depend on the SPICE kernels used as input */ -/* and the machine specific arithmetic implementation. */ - - -/* PROGRAM DVNORM_T */ -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION X (3) */ -/* DOUBLE PRECISION MAG (3) */ -/* DOUBLE PRECISION DVMAG (3) */ -/* DOUBLE PRECISION Y (6) */ - -/* DOUBLE PRECISION DVNORM */ -/* C */ -/* C Create several 6-vectors (6x1 arrays) with the structure */ -/* C */ -/* C s = | x | */ -/* C | | */ -/* C | dx | */ -/* C | -- | */ -/* C | ds | */ -/* C */ -/* C where 'x' is a 3-vector (3x1 array). */ -/* C */ - -/* C */ -/* C Create 's' with 'x' of varying magnitudes. Use 'x' */ -/* C and '-x' to define the derivative as parallel and */ -/* C anti-parallel. */ -/* C */ -/* MAG(1) = -4.D0 */ -/* MAG(2) = 4.D0 */ -/* MAG(3) = 12.D0 */ - -/* X(1) = 1.D0 */ -/* X(2) = DSQRT( 2.D0 ) */ -/* X(3) = DSQRT( 3.D0 ) */ - -/* C */ -/* C Parallel... */ -/* C */ -/* Y(1) = X(1) * 10.D0**MAG(1) */ -/* Y(2) = X(2) * 10.D0**MAG(1) */ -/* Y(3) = X(3) * 10.D0**MAG(1) */ -/* Y(4) = X(1) */ -/* Y(5) = X(2) */ -/* Y(6) = X(3) */ - -/* WRITE(*,*) 'Parallel x, dx/ds : ', DVNORM( Y ) */ - -/* C */ -/* C ... anti-parallel... */ -/* C */ -/* Y(1) = X(1) * 10.D0**MAG(2) */ -/* Y(2) = X(2) * 10.D0**MAG(2) */ -/* Y(3) = X(3) * 10.D0**MAG(2) */ -/* Y(4) = -X(1) */ -/* Y(5) = -X(2) */ -/* Y(6) = -X(3) */ - -/* WRITE(*,*) 'Anti-parallel x, dx/ds : ', DVNORM( Y ) */ - -/* C */ -/* C ... 'x' zero vector */ -/* C */ -/* Y(1) = 0.D0 */ -/* Y(2) = 0.D0 */ -/* Y(3) = 0.D0 */ -/* Y(4) = X(1) * 10.D0**MAG(3) */ -/* Y(5) = X(2) * 10.D0**MAG(3) */ -/* Y(6) = X(3) * 10.D0**MAG(3) */ - -/* WRITE(*,*) 'Zero vector x, large dx/ds: ', DVNORM( Y ) */ -/* END */ - -/* The program outputs: */ - -/* Parallel x, dx/ds : 2.44948974 */ -/* Anti-parallel x, dx/ds : -2.44948974 */ -/* Zero vector x, large dx/ds: 0. */ - -/* $ Restrictions */ - -/* Error free. */ - -/* 1) If the first three components of STATE ("x") describes the */ -/* origin (zero vector) the routine returns zero as the */ -/* derivative of the vector norm. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Ed Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-MAY-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* derivative of 3-vector norm */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local Variables. */ - - -/* If "x" describes the zero vector, return zero as the derivative */ -/* of the vector norm. */ - - if (vnorm_(state) == 0.) { - ret_val = 0.; - return ret_val; - } - -/* Construct a unit vector from the x vector data */ -/* in STATE. */ - - vhat_(state, xhat); - -/* Project the velocity components onto the XHAT vector. */ - -/* d ||x|| x */ -/* ------- = v . ----- */ -/* ds ||x|| */ - - ret_val = vdot_(&state[3], xhat); - return ret_val; -} /* dvnorm_ */ - diff --git a/ext/spice/src/cspice/dvnorm_c.c b/ext/spice/src/cspice/dvnorm_c.c deleted file mode 100644 index 0ca35a7c9c..0000000000 --- a/ext/spice/src/cspice/dvnorm_c.c +++ /dev/null @@ -1,227 +0,0 @@ -/* - --Procedure dvnorm_c ( Derivative of vector norm ) - --Abstract - - Function to calculate the derivative of the norm of a 3-vector. - --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_c 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 - - DERIVATIVES - MATH - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef dvnorm_c - - SpiceDouble dvnorm_c ( ConstSpiceDouble state[6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - state I A 6-vector composed of three coordinates and their - derivatives. - --Detailed_Input - - state A double precision 6-vector, the second three - components being the derivatives of the first three - with respect to some scalar. - - state = ( x, dx ) - -- - ds - - A common form for 'state' would contain position and - velocity. - --Detailed_Output - - dvnorm_c The value of d||x|| corresponding to 'state'. - ------ - ds - - 1/2 2 2 2 1/2 - where ||x|| = < x, x > = ( x1 + x2 + x3 ) - - - v = ( dx1, dx2, dx3 ) - --- --- --- - ds ds ds - - d||x|| < x, v > - ------ = ------ = < xhat, v > - ds 1/2 - < x, x > - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - A common use for this routine is to calculate the time derivative - of the radius corresponding to a state vector. - --Examples - - Any numerical results shown for this example may differ between - platforms as the results depend on the SPICE kernels used as input - and the machine specific arithmetic implementation. - - #include "SpiceUsr.h" - #include - #include - - int main() - { - - SpiceDouble mag [3] = - { -4., 4., 12. }; - - SpiceDouble x1 [3] = - { 1., sqrt(2.), sqrt(3.) }; - - SpiceDouble y [6]; - - /. - Parallel... - ./ - y[0] = x1[0] * pow(10., mag[0] ); - y[1] = x1[1] * pow(10., mag[0] ); - y[2] = x1[2] * pow(10., mag[0] ); - y[3] = x1[0]; - y[4] = x1[1]; - y[5] = x1[2]; - - printf( "Parallel x, dx/ds : %f\n", dvnorm_c( y ) ); - - /. - ...anti-parallel... - ./ - y[0] = x1[0] * pow(10., mag[1] ); - y[1] = x1[1] * pow(10., mag[1] ); - y[2] = x1[2] * pow(10., mag[1] ); - y[3] = -x1[0]; - y[4] = -x1[1]; - y[5] = -x1[2]; - - printf( "Anti-parallel x, dx/ds : %f\n", dvnorm_c( y ) ); - - - /. - ...'x' zero vector. - ./ - y[0] = 0.; - y[1] = 0.; - y[2] = 0.; - y[3] = x1[0] * pow(10., mag[2] ); - y[4] = x1[1] * pow(10., mag[2] ); - y[5] = x1[2] * pow(10., mag[2] ); - - printf( "Zero vector x, large dx/ds: %f\n", dvnorm_c( y ) ); - - return 0; - } - - The program outputs: - - Parallel x, dx/ds : 2.449490 - Anti-parallel x, dx/ds : -2.449490 - Zero vector x, large dx/ds: 0.000000 - --Restrictions - - Error free. - - 1) If the first three components of 'state' ("x") describes the - origin (zero vector) the routine returns zero as the - derivative of the vector norm. - --Literature_References - - None. - --Author_and_Institution - - Ed Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 04-MAY-2010 (EDW) - --Index_Entries - - derivative of 3-vector norm - --& -*/ - -{ /* Begin dvnorm_c */ - - /* - Local variables - */ - SpiceDouble retval; - - /* - Participate in error tracing. - */ - - chkin_c ( "dvnorm_c" ); - - /* - Call the f2c'd Fortran routine. - */ - retval = (SpiceDouble) dvnorm_( (doublereal*) state); - - chkout_c ( "dvnorm_c" ); - - return( retval ); - -} /* End dvnorm_c */ - diff --git a/ext/spice/src/cspice/dvpool_c.c b/ext/spice/src/cspice/dvpool_c.c deleted file mode 100644 index bea35cb34e..0000000000 --- a/ext/spice/src/cspice/dvpool_c.c +++ /dev/null @@ -1,161 +0,0 @@ -/* - --Procedure dvpool_c ( Delete a variable from the kernel pool ) - --Abstract - - Delete a variable from the kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void dvpool_c ( ConstSpiceChar * name ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the kernel variable to be deleted. - --Detailed_Input - - name is the name of the kernel pool variable to delete. - The name and associated values are removed from the - kernel pool, freeing the occupied space. - - If watches are set on the variable designated by - name, the corresponding agents are placed on the list - of agents to be notified of a kernel variable update. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the specified variable is not present in the kernel pool, - this routine simply returns. No error is signaled. - - 2) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 3) If the input name does not contain at least 1 character, the - error SPICE(EMPTYSTRING) will be signaled. - --Files - - None. - --Particulars - - This routine enables users to selectively remove variables from - the kernel pool, as opposed to having to clear the pool and - reload it. - - Note that it is not necessary to remove kernel variables in order - to simply update them; this routine should be used only when - variables are to be removed. - --Examples - - 1) Remove triaxial radii of Jupiter from the kernel pool. - - #include "SpiceUsr.h" - . - . - . - dvpool_c ( "BODY599_RADII" ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 05-JUN-1999 (NJB) (WLT) - --Index_Entries - - delete a kernel pool variable - --& -*/ - -{ /* Begin dvpool_c */ - - - - /* - Use discovery check-in. - */ - - - /* - Check the kernel variable name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "dvpool_c", name ); - - - /* - Call the f2c'd routine. - */ - - dvpool_ ( ( char * ) name, - ( ftnlen ) strlen(name) ); - - -} /* End dvpool_c */ diff --git a/ext/spice/src/cspice/dvsep.c b/ext/spice/src/cspice/dvsep.c deleted file mode 100644 index f6a259e2c4..0000000000 --- a/ext/spice/src/cspice/dvsep.c +++ /dev/null @@ -1,349 +0,0 @@ -/* dvsep.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DVSEP ( Derivative of separation angle ) */ -doublereal dvsep_(doublereal *s1, doublereal *s2) -{ - /* System generated locals */ - doublereal ret_val; - - /* Local variables */ - logical safe; - extern doublereal vdot_(doublereal *, doublereal *); - doublereal numr; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern /* Subroutine */ int dvhat_(doublereal *, doublereal *); - extern doublereal dpmax_(void); - extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal - *); - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *); - doublereal u1[6], u2[6]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal pcross[3]; - extern logical return_(void); - -/* $ Abstract */ - -/* Calculate the time derivative of the separation angle between */ -/* two input states, S1 and S2. */ - -/* $ 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 */ - -/* GEOMETRY */ -/* DERIVATIVES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S1 I State vector of the first body. */ -/* S2 I State vector of the second body. */ - -/* $ Detailed_Input */ - -/* S1 the state vector of the first target body as seen from */ -/* the observer. */ - -/* S2 the state vector of the second target body as seen from */ -/* the observer. */ - -/* An implicit assumption exists that both states lie in the same */ -/* reference frame with the same observer for the same epoch. If this */ -/* is not the case, the numerical result has no meaning. */ - -/* $ Detailed_Output */ - -/* The function returns the double precision value of the time */ -/* derivative of the angular separation between S1 and S2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(NUMERICOVERFLOW) signals if the inputs S1, S2 */ -/* define states with an angular separation rate ~ DPMAX(). */ - -/* 2) If called in RETURN mode, the return has value 0. */ - -/* 3) Linear dependent position components of S1 and S1 constitutes */ -/* a non-error exception. The function returns 0 for this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* In this discussion, the notation */ - -/* < V1, V2 > */ - -/* indicates the dot product of vectors V1 and V2. The notation */ - -/* V1 x V2 */ - -/* indicates the cross product of vectors V1 and V2. */ - -/* To start out, note that we need consider only unit vectors, */ -/* since the angular separation of any two non-zero vectors */ -/* equals the angular separation of the corresponding unit vectors. */ -/* Call these vectors U1 and U2; let their velocities be V1 and V2. */ - -/* For unit vectors having angular separation */ - -/* THETA */ - -/* the identity */ - -/* || U1 x U1 || = ||U1|| * ||U2|| * sin(THETA) (1) */ - -/* reduces to */ - -/* || U1 x U2 || = sin(THETA) (2) */ - -/* and the identity */ - -/* | < U1, U2 > | = || U1 || * || U2 || * cos(THETA) (3) */ - -/* reduces to */ - -/* | < U1, U2 > | = cos(THETA) (4) */ - -/* Since THETA is an angular separation, THETA is in the range */ - -/* 0 : Pi */ - -/* Then letting s be +1 if cos(THETA) > 0 and -1 if cos(THETA) < 0, */ -/* we have for any value of THETA other than 0 or Pi */ - - -/* 2 1/2 */ -/* cos(THETA) = s * ( 1 - sin (THETA) ) (5) */ - -/* or */ - -/* 2 1/2 */ -/* < U1, U2 > = s * ( 1 - sin (THETA) ) (6) */ - - -/* At this point, for any value of THETA other than 0 or Pi, */ -/* we can differentiate both sides with respect to time (T) */ -/* to obtain */ - -/* 2 -1/2 */ -/* < U1, V2 > + < V1, U2 > = s * (1/2)(1 - sin (THETA)) */ - -/* * (-2) sin(THETA)*cos(THETA) */ - -/* * d(THETA)/dT (7a) */ - - -/* Using equation (5), and noting that s = 1/s, we can cancel */ -/* the cosine terms on the right hand side */ - -/* -1 */ -/* < U1, V2 > + < V1, U2 > = (1/2)(cos(THETA)) */ - -/* * (-2) sin(THETA)*cos(THETA) */ - -/* * d(THETA)/dT (7b) */ - -/* With (7b) reducing to */ - -/* < U1, V2 > + < V1, U2 > = - sin(THETA) * d(THETA)/dT (8) */ - -/* Using equation (2) and switching sides, we obtain */ - -/* || U1 x U2 || * d(THETA)/dT = - < U1, V2 > - < V1, U2 > (9) */ - -/* or, provided U1 and U2 are linearly independent, */ - -/* d(THETA)/dT = ( - < U1, V2 > - < V1, U2 > ) / ||U1 x U2|| (10) */ - -/* Note for times when U1 and U2 have angular separation 0 or Pi */ -/* radians, the derivative of angular separation with respect to */ -/* time doesn't exist. (Consider the graph of angular separation */ -/* with respect to time; typically the graph is roughly v-shaped at */ -/* the singular points.) */ - -/* $ Examples */ - -/* PROGRAM DVSEP_T */ -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION DSEPT */ -/* DOUBLE PRECISION STATEE (6) */ -/* DOUBLE PRECISION STATEM (6) */ - -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 64 ) */ - -/* CHARACTER*(STRLEN) BEGSTR */ - -/* DOUBLE PRECISION DVSEP */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ('standard.tm') */ - -/* C */ -/* C An arbitrary time. */ -/* C */ -/* BEGSTR = 'JAN 1 2009' */ -/* CALL STR2ET( BEGSTR, ET ) */ - -/* C */ -/* C Calculate the state vectors sun to Moon, sun to earth at ET. */ -/* C */ -/* C */ -/* CALL SPKEZR ( 'EARTH', ET, 'J2000', 'NONE', 'SUN', */ -/* . STATEE, LT) */ - -/* CALL SPKEZR ( 'MOON', ET, 'J2000', 'NONE', 'SUN', */ -/* . STATEM, LT) */ - -/* C */ -/* C Calculate the time derivative of the angular separation of */ -/* C the earth and Moon as seen from the sun at ET. */ -/* C */ -/* DSEPT = DVSEP( STATEE, STATEM ) */ -/* WRITE(*,*) 'Time derivative of angular separation: ', DSEPT */ - -/* END */ - -/* The program compiled on OS X with g77 outputs (radians/sec): */ - -/* Time derivative of angular separation: 3.81211936E-09 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 15-MAR-2010 (EDW) */ - -/* Trivial header format clean-up. */ - -/* - SPICELIB Version 1.0.1, 31-MAR-2009 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* time derivative of angular separation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } - chkin_("DVSEP", (ftnlen)5); - -/* Compute the unit vectors and corresponding time derivatives */ -/* for the input state vectors. */ - - dvhat_(s1, u1); - dvhat_(s2, u2); - -/* Calculate the cross product vector of U1 and U2. As both vectors */ -/* have magnitude one, the magnitude of the cross product equals */ -/* sin(THETA), with THETA the angle between S1 and S2. */ - - vcrss_(u1, u2, pcross); - -/* Now calculate the time derivate of the angular separation between */ -/* S1 and S2. */ - -/* The routine needs to guard against both division by zero */ -/* and numeric overflow. Before carrying out the division */ -/* indicated by equation (10), the routine should verify that */ - -/* || U1 x U2 || > fudge factor * | numerator | / DPMAX() */ - -/* A fudge factor of 10.D0 should suffice. */ - -/* Note that the inequality is strict. */ - - -/* Handle the parallel and anti-parallel cases. */ - - if (vzero_(pcross)) { - ret_val = 0.; - chkout_("DVSEP", (ftnlen)5); - return ret_val; - } - -/* Now check for possible overflow. */ - - numr = vdot_(u1, &u2[3]) + vdot_(&u1[3], u2); - denom = vnorm_(pcross); - safe = denom > abs(numr) * 10. / dpmax_(); - if (! safe) { - ret_val = 0.; - setmsg_("Numerical overflow event.", (ftnlen)25); - sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22); - chkout_("DVSEP", (ftnlen)5); - return ret_val; - } - ret_val = -numr / denom; - chkout_("DVSEP", (ftnlen)5); - return ret_val; -} /* dvsep_ */ - diff --git a/ext/spice/src/cspice/dvsep_c.c b/ext/spice/src/cspice/dvsep_c.c deleted file mode 100644 index 3b5eccab37..0000000000 --- a/ext/spice/src/cspice/dvsep_c.c +++ /dev/null @@ -1,239 +0,0 @@ -/* - --Procedure dvsep_c ( Time derivative of separation angle ) - --Abstract - - Calculate the time derivative of the separation angle between - two input states, S1 and S2. - --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 - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef dvsep_c - - SpiceDouble dvsep_c (ConstSpiceDouble s1[6], ConstSpiceDouble s2[6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s1 I State vector of the first body - s2 I State vector of the second body - --Detailed_Input - - s1 the state vector of the first target body as seen from - the observer - - s2 the state vector of the second target body as seen from - the observer - - An implicit assumption exists that both states lie in the same - refrence frame with the same observer for the same epoch. If this - is not the case, the numerical result has no meaning. - --Detailed_Output - - The function returns the double precision value of the time derivative - of the angular separation between S1 and S2. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NUMERICOVERFLOW) signals if the inputs S1, S2 - define states with an angular separation rate ~ DPMAX(). - - 2) If called in RETURN mode, the return has value 0. - - 3) Linear dependent position components of S1 and S1 constitutes - a non-error exception. The function returns 0 for this case. - --Files - - None. - --Particulars - - - In this discussion, the notation - - < V1, V2 > - - indicates the dot product of vectors V1 and V2. The notation - - V1 x V2 - - indicates the cross product of vectors V1 and V2. - - To start out, note that we need consider only unit vectors, - since the angular separation of any two non-zero vectors - equals the angular separation of the corresponding unit vectors. - Call these vectors U1 and U2; let their velocities be V1 and V2. - - For unit vectors having angular separation - - THETA - - the identity - - || U1 x U1 || = ||U1|| * ||U2|| * sin(THETA) (1) - - reduces to - - || U1 x U2 || = sin(THETA) (2) - - and the identity - - | < U1, U2 > | = || U1 || * || U2 || * cos(THETA) (3) - - reduces to - - | < U1, U2 > | = cos(THETA) (4) - - Since THETA is an angular separation, THETA is in the range - - 0 : Pi - - Then letting s be +1 if cos(THETA) > 0 and -1 if cos(THETA) < 0, - we have for any value of THETA other than 0 or Pi - - - 2 1/2 - cos(THETA) = s * ( 1 - sin (THETA) ) (5) - - or - - 2 1/2 - < U1, U2 > = s * ( 1 - sin (THETA) ) (6) - - - At this point, for any value of THETA other than 0 or Pi, - we can differentiate both sides with respect to time (T) - to obtain - - 2 -1/2 - < U1, V2 > + < V1, U2 > = s * (1/2)(1 - sin (THETA)) - - * (-2) sin(THETA)*cos(THETA) - - * d(THETA)/dT (7a) - - - Using equation (5), and noting that s = 1/s, we can cancel - the cosine terms on the right hand side - - -1 - < U1, V2 > + < V1, U2 > = (1/2)(cos(THETA)) - - * (-2) sin(THETA)*cos(THETA) - - * d(THETA)/dT (7b) - - With (7b) reducing to - - < U1, V2 > + < V1, U2 > = - sin(THETA) * d(THETA)/dT (8) - - Using equation (2) and switching sides, we obtain - - || U1 x U2 || * d(THETA)/dT = - < U1, V2 > - < V1, U2 > (9) - - or, provided U1 and U2 are linearly independent, - - d(THETA)/dT = ( - < U1, V2 > - < V1, U2 > ) / ||U1 x U2|| (10) - - Note for times when U1 and U2 have angular separation 0 or Pi - radians, the derivative of angular separation with respect to - time doesn't exist. (Consider the graph of angular separation - with respect to time; typically the graph is roughly v-shaped at - the singular points.) - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 09-MAR-2009 (EDW) (NJB) - --Index_Entries - - time derivative of angular separation - --& -*/ - -{ /* Begin dvsep_c */ - - /* - Local variabes. - */ - SpiceDouble retval; - - /* - Participate in error tracing. - */ - chkin_c ( "dvsep_c" ); - - /* - Call the f2c'd Fortran routine. - */ - retval = (SpiceDouble) dvsep_( ( doublereal * ) s1, - ( doublereal * ) s2 ); - - chkout_c ( "dvsep_c" ); - - return(retval); - -} /* End dvsep_c */ diff --git a/ext/spice/src/cspice/dxtrct.c b/ext/spice/src/cspice/dxtrct.c deleted file mode 100644 index 5df7f50cf5..0000000000 --- a/ext/spice/src/cspice/dxtrct.c +++ /dev/null @@ -1,363 +0,0 @@ -/* dxtrct.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DXTRCT (Extract Double Precision Values From A String) */ -/* Subroutine */ int dxtrct_(char *keywd, integer *maxwds, char *string, - integer *nfound, integer *parsed, doublereal *values, ftnlen - keywd_len, ftnlen string_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer pntr, i__, j; - doublereal x; - extern integer nblen_(char *, ftnlen); - char error[80]; - integer start, fallbk, berase, eerase; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - integer length; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - extern integer wdindx_(char *, char *, ftnlen, ftnlen); - integer positn; - -/* $ Abstract */ - -/* Locate a keyword and succeeding numeric words within a string. */ -/* Parse and store the numeric words. Remove the keyword and */ -/* numeric words from the input 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 */ - -/* PARSING, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KEYWD I Keyword used to mark start of a set of numbers. */ -/* MAXWDS I Maximum number of numeric words that can be parsed */ -/* STRING I/O String potentially containing KEYWD and numbers. */ -/* NFOUND O Number of numeric words found following the KEYWD. */ -/* PARSED O Number of numeric words translated and returned. */ -/* VALUES O The double precision values for the numbers. */ - -/* $ Detailed_Input */ - -/* KEYWD is a word used to mark the start of a set of numeric */ -/* words of interest. */ - -/* MAXWDS is the maximum number of numeric words that can be */ -/* parsed and returned. */ - -/* STRING is a string potentially containing KEYWD and numbers. */ - -/* $ Detailed_Output */ - -/* STRING is the input string stripped of all parsed */ -/* numeric words. If there was room available to parse */ -/* all of the numeric words associated with KEYWD, the */ -/* keyword that marked the beginning of the parsed */ -/* numbers in the original string will also be removed. */ - -/* NFOUND is the number of numeric words that were found */ -/* following KEYWD but preceding the next non-numeric */ -/* word of the string. If the KEYWD is not present in */ -/* the string, NFOUND is returned as -1. If the keyword */ -/* is located but the next word in the string is */ -/* non-numeric NFOUND will be returned as 0. */ - -/* PARSED is the number of numeric words that were actually */ -/* parsed and stored in the output array VALUES. If no */ -/* values are parsed PARSED is returned as 0. */ - -/* VALUES are the double precision values for the parsed */ -/* numeric words that follow the first occurance of the */ -/* keyword but precede the next non-numeric word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Definitions: */ - -/* A WORD is a set of consecutive non-blank characters */ -/* delimited by blanks or the end of the string */ -/* that contains them. */ - -/* A NUMERIC WORD a word that can be parsed by the */ -/* SPICELIB routine NPARSD without error. All */ -/* FORTRAN numeric representations are numeric */ -/* words. In addition 'PI', 'Pi', 'pI', and 'pi' */ -/* are all recognized as having the value: */ - -/* 3.1415926535897932384626D0 */ - -/* See NPARSD FOR A a full description of legitimate */ -/* numeric words. */ - -/* Given a string and a keyword this routine locates the first */ -/* occurrance of the keyword in the string and returns the double */ -/* precision representations of up to MAXWDS succeeding numeric */ -/* words. All parsed numeric words are removed from the string. */ -/* If every numeric word following KEYWD but preceding the next */ -/* non-numeric word is parsed, KEYWD will also be removed from */ -/* the string. */ - -/* If the keyword cannot be located in the string, the variable */ -/* NFOUND will be returned as -1 and the string will be unchanged. */ - -/* In all other cases, some part of the string (possibly all of it) */ -/* will be removed. */ - -/* $ Examples */ - -/* Input STRING 'LONGITUDE 39.2829 LATITUDE 24.27682' */ -/* KEYWD 'LONGITUDE' */ -/* MAXWDS 4 */ - -/* Output: STRING ' LATITUDE 24.27682' */ -/* NFOUND 1 */ -/* PARSED 1 */ -/* VALUES 3.92829D+01 */ - - - -/* Input STRING 'THIS IS A BAD STRING FOR NUMBERS' */ -/* KEYWD 'RADIUS' */ -/* MAXWDS 2 */ - -/* Output: STRING 'THIS IS A BAD STRING FOR NUMBERS' */ -/* NFOUND -1 */ -/* PARSED 0 */ -/* VALUES (unchanged) */ - - - -/* Input STRING 'PRIMES 11 13 17 19 23 NON-PRIMES 12 14 15' */ -/* KEYWD 'PRIMES' */ -/* MAXWDS 3 */ - -/* Output: STRING 'PRIMES 19 23 NON-PRIMES 12 14 15' */ -/* NFOUND 5 */ -/* PARSED 3 */ -/* VALUES 1.1D+01 */ -/* 1.3D+01 */ -/* 1.7D+01 */ - -/* Input STRING 'PRIMES 11 13 17 19 23 NON-PRIMES 12 14 15' */ -/* KEYWD 'PRIMES' */ -/* MAXWDS 5 */ - -/* Output: STRING ' NON-PRIMES 12 14 15' */ -/* NFOUND 5 */ -/* PARSED 5 */ -/* VALUES 1.1D+01 */ -/* 1.3D+01 */ -/* 1.7D+01 */ -/* 1.9D+01 */ -/* 2.3D+01 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 23-MAY-1990 (HAN) */ - -/* The variable FOUND was changed to NFOUND. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract d.p. values from a string */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 23-MAY-1990 (HAN) */ - -/* The variable FOUND was changed to NFOUND. Other SPICELIB */ -/* routines that use the variable FOUND declare it as a logical. */ -/* In order to conform to this convention, FOUND was changed to */ -/* NFOUND to indicate that it has an integer value, not a logical */ -/* value. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* No keywords or numbers have been located yet. */ - - *nfound = 0; - *parsed = 0; - -/* Locate the keyword within the string and get the length of the */ -/* string. */ - - positn = wdindx_(string, keywd, string_len, keywd_len); - length = lastnb_(string, string_len); - if (positn == 0) { - *nfound = -1; - *parsed = 0; - return 0; - } - -/* Set the begin erase marker to the start of the current word */ -/* Set the end erase marker to the end of the current word */ - - berase = positn; - eerase = positn + nblen_(keywd, keywd_len) - 1; - start = eerase + 1; - if (start < length) { - -/* Locate the next word and try to parse it ... */ - - fndnwd_(string, &start, &i__, &j, string_len); - nparsd_(string + (i__ - 1), &x, error, &pntr, j - (i__ - 1), (ftnlen) - 80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) == 0) { - -/* ... mark its starting position as a possible starting */ -/* point for deletion if we run out of room for parsed numbers. */ - - fallbk = i__; - eerase = j; - start = j + 1; - ++(*nfound); - ++(*parsed); - values[*parsed - 1] = x; - } - } else { - s_copy(string + (berase - 1), " ", string_len - (berase - 1), (ftnlen) - 1); - return 0; - } - -/* Now find all of the succeeding numeric words until we run out of */ -/* numeric words or string to look at. */ - - while(start < length && s_cmp(error, " ", (ftnlen)80, (ftnlen)1) == 0) { - -/* Find the next word and try to parse it as a number. */ - - fndnwd_(string, &start, &i__, &j, string_len); - nparsd_(string + (i__ - 1), &x, error, &pntr, j - (i__ - 1), (ftnlen) - 80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) == 0) { - -/* It's a number! Congratulations! */ - - ++(*nfound); - -/* If there is room ... */ - - if (*nfound <= *maxwds) { - -/* 1. Increment the counter PARSED. */ -/* 2. Load the DP value into the output array. */ -/* 3. Set the pointer for the end of the erase */ -/* region to be the end of this word. */ - - ++(*parsed); - values[*parsed - 1] = x; - eerase = j; - } else { - -/* Set the pointer of the begin erase region to be the */ -/* the pointer set up just for this occasion. */ - - berase = fallbk; - } - -/* Set the place to begin looking for the next word to be */ -/* at the first character following the end of the current */ -/* word. */ - - start = j + 1; - } - } - -/* Remove the parsed words from the string. */ - - i__ = berase; - j = eerase + 1; - while(j <= length) { - *(unsigned char *)&string[i__ - 1] = *(unsigned char *)&string[j - 1]; - ++i__; - ++j; - } - s_copy(string + (i__ - 1), " ", string_len - (i__ - 1), (ftnlen)1); - return 0; -} /* dxtrct_ */ - diff --git a/ext/spice/src/cspice/edlimb.c b/ext/spice/src/cspice/edlimb.c deleted file mode 100644 index eaff0d48fe..0000000000 --- a/ext/spice/src/cspice/edlimb.c +++ /dev/null @@ -1,446 +0,0 @@ -/* edlimb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b18 = 1.; -static integer c__9 = 9; - -/* $Procedure EDLIMB ( Ellipsoid Limb ) */ -/* Subroutine */ int edlimb_(doublereal *a, doublereal *b, doublereal *c__, - doublereal *viewpt, doublereal *limb) -{ - /* System generated locals */ - doublereal d__1, d__2, d__3; - - /* Local variables */ - doublereal scla, sclb, sclc; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - doublereal scla2, sclb2, sclc2, v[3], scale; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal level; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vsclg_( - doublereal *, doublereal *, integer *, doublereal *); - doublereal tmpel[9]; - extern /* Subroutine */ int nvc2pl_(doublereal *, doublereal *, - doublereal *); - doublereal lplane[4]; - extern /* Subroutine */ int inedpl_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *); - doublereal normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Find the limb of a triaxial ellipsoid, viewed from a specified */ -/* point. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* ELLIPSOID */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* A I Length of ellipsoid semi-axis lying on the x-axis. */ -/* B I Length of ellipsoid semi-axis lying on the y-axis. */ -/* C I Length of ellipsoid semi-axis lying on the z-axis. */ -/* VIEWPT I Location of viewing point. */ -/* LIMB O Limb of ellipsoid as seen from viewing point. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B, */ -/* C are the lengths of the semi-axes of a triaxial */ -/* ellipsoid. The ellipsoid is centered at the */ -/* origin and oriented so that its axes lie on the */ -/* x, y and z axes. A, B, and C are the lengths of */ -/* the semi-axes that point in the x, y, and z */ -/* directions respectively. */ - -/* VIEWPT is a point from which the ellipsoid is viewed. */ -/* VIEWPT must be outside of the ellipsoid. */ - -/* $ Detailed_Output */ - -/* LIMB is a SPICELIB ellipse that represents the limb of */ -/* the ellipsoid. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the length of any semi-axis of the ellipsoid is */ -/* non-positive, the error SPICE(INVALIDAXISLENGTH) is signalled. */ -/* LIMB is not modified. */ - -/* 2) If the length of any semi-axis of the ellipsoid is zero after */ -/* the semi-axis lengths are scaled by the reciprocal of the */ -/* magnitude of the longest semi-axis and then squared, the error */ -/* SPICE(DEGENERATECASE) is signalled. LIMB is not modified. */ - -/* 3) If the viewing point VIEWPT is inside the ellipse, the error */ -/* SPICE(INVALIDPOINT) is signalled. LIMB is not modified. */ - -/* 4) If the geometry defined by the input ellipsoid and viewing */ -/* point is so extreme that the limb cannot be found, the error */ -/* SPICE(DEGENERATECASE) is signalled. */ - -/* 5) If the shape of the ellipsoid and the viewing geometry are */ -/* such that the limb is an excessively flat ellipsoid, the */ -/* limb may be a degenerate ellipse. You must determine whether */ -/* this possibility poses a problem for your application. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The limb of a body, as seen from a viewing point, is the boundary */ -/* of the portion of the body's surface that is visible from that */ -/* viewing point. In this definition, we consider a surface point */ -/* to be `visible' if it can be connected to the viewing point by a */ -/* line segment that doen't pass through the body. This is a purely */ -/* geometrical definition that ignores the matter of which portions */ -/* of the surface are illuminated, or whether the view is obscured by */ -/* any additional objects. */ - -/* If a body is modelled as a triaxial ellipsoid, the limb is always */ -/* an ellipse. The limb is determined by its center, a semi-major */ -/* axis vector, and a semi-minor axis vector. */ - -/* We note that the problem of finding the limb of a triaxial */ -/* ellipsoid is mathematically identical to that of finding its */ -/* terminator, if one makes the simplifying assumption that the */ -/* terminator is the limb of the body as seen from the vertex of the */ -/* umbra. So, this routine can be used to solve this simplified */ -/* version of the problem of finding the terminator. */ - -/* $ Examples */ - -/* 1) We'd like to find the apparent limb of Jupiter, corrected for */ -/* light time, as seen from a spacecraft's position at time ET. */ - -/* C */ -/* C Find the viewing point in Jupiter-centered */ -/* C coordinates. To do this, find the apparent position */ -/* C of Jupiter as seen from the spacecraft and negate */ -/* C this vector. In this case we'll use light time */ -/* C correction to arrive at the apparent limb. JSTAT is */ -/* C the Jupiter's state (position and velocity) as seen */ -/* C from the spacecraft. SCPOS is the spacecraft's */ -/* C position relative to Jupiter. */ -/* C */ -/* CALL SPKEZ ( JUPID, ET, 'J2000', 'LT', SCID, */ -/* . SCSTAT, LT ) */ - -/* CALL VMINUS ( SCSTAT, SCPOS ) */ - -/* C */ -/* C Get Jupiter's semi-axis lengths... */ -/* C */ -/* CALL BODVCD ( JUPID, 'RADII', 3, N, RAD ) */ - -/* C */ -/* C ...and the transformation from J2000 to Jupiter */ -/* C equator and prime meridian coordinates. Note that we */ -/* C use the orientation of Jupiter at the time of */ -/* C emission of the light that arrived at the */ -/* C spacecraft at time ET. */ -/* C */ -/* CALL BODMAT ( JUPID, ET-LT, TIPM ) */ - -/* C */ -/* C Transform the spacecraft's position into Jupiter- */ -/* C fixed coordinates. */ -/* C */ -/* CALL MXV ( TIPM, SCPOS, SCPOS ) */ - -/* C */ -/* C Find the apparent limb. LIMB is a SPICELIB ellipse */ -/* C representing the limb. */ -/* C */ -/* CALL EDLIMB ( RAD(1), RAD(2), RAD(3), SCPOS, LIMB ) */ - -/* C */ -/* C LCENTR, SMAJOR, and SMINOR are the limb's center, */ -/* C semi-major axis of the limb, and a semi-minor axis */ -/* C of the limb. We obtain these from LIMB using the */ -/* C SPICELIB routine EL2CGV ( Ellipse to center and */ -/* C generating vectors ). */ -/* C */ -/* CALL EL2CGV ( LIMB, CENTER, SMAJOR, SMINOR ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCLG call. Updated header to refer to BODVCD instead */ -/* of BODVAR. */ - -/* - SPICELIB Version 1.2.0, 06-OCT-1993 (NJB) */ - -/* Declaration of unused local variable NEAR was removed. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 04-DEC-1990 (NJB) */ - -/* Error message and description changed for non-positive */ -/* axis length error. */ - -/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ellipsoid limb */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCLG call. Updated header to refer to BODVCD instead */ -/* of BODVAR. */ - -/* - SPICELIB Version 1.2.0, 06-OCT-1993 (NJB) */ - -/* Declaration of unused local variable NEAR was removed. */ - -/* - SPICELIB Version 1.1.0, 04-DEC-1990 (NJB) */ - -/* Error message and description changed for non-positive */ -/* axis length error. The former message and description did */ -/* not match, and the description was incorrect: it described */ -/* `zero-length', rather than `non-positive' axes as invalid. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EDLIMB", (ftnlen)6); - } - -/* The semi-axes must have positive length. */ - - if (*a <= 0. || *b <= 0. || *c__ <= 0.) { - setmsg_("Semi-axis lengths: A = #, B = #, C = #. ", (ftnlen)41); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24); - chkout_("EDLIMB", (ftnlen)6); - return 0; - } - -/* Scale the semi-axes lengths for better numerical behavior. */ -/* If squaring any one of the scaled lengths causes it to */ -/* underflow to zero, we cannot continue the computation. Otherwise, */ -/* scale the viewing point too. */ - -/* Computing MAX */ - d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__); - scale = max(d__1,d__2); - scla = *a / scale; - sclb = *b / scale; - sclc = *c__ / scale; -/* Computing 2nd power */ - d__1 = scla; - scla2 = d__1 * d__1; -/* Computing 2nd power */ - d__1 = sclb; - sclb2 = d__1 * d__1; -/* Computing 2nd power */ - d__1 = sclc; - sclc2 = d__1 * d__1; - if (scla2 == 0. || sclb2 == 0. || sclc2 == 0.) { - setmsg_("Semi-axis too small: A = #, B = #, C = #. ", (ftnlen)43); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("EDLIMB", (ftnlen)6); - return 0; - } - d__1 = 1. / scale; - vscl_(&d__1, viewpt, v); - -/* The viewing point must be outside of the ellipsoid. LEVEL is the */ -/* constant of the level surface that V lies on. The ellipsoid */ -/* itself is the level surface corresponding to LEVEL = 1. */ - -/* Computing 2nd power */ - d__1 = v[0]; -/* Computing 2nd power */ - d__2 = v[1]; -/* Computing 2nd power */ - d__3 = v[2]; - level = d__1 * d__1 / scla2 + d__2 * d__2 / sclb2 + d__3 * d__3 / sclc2; - if (level < 1.) { - setmsg_("Viewing point is inside the ellipsoid.", (ftnlen)38); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("EDLIMB", (ftnlen)6); - return 0; - } - -/* Find a normal vector for the limb plane. */ - -/* To compute this vector, we use the fact that the surface normal at */ -/* each limb point is orthogonal to the line segment connecting the */ -/* viewing point and the limb point. Let the notation */ - -/* < a, b > */ - -/* indicate the dot product of the vectors a and b. If we call the */ -/* viewing point V and the limb point X, then */ - - - -/* X(1) X(2) X(3) */ -/* 0 = < V - X, ( -------- , -------- , -------- ) > */ -/* 2 2 2 */ -/* SCLA SCLB SCLC */ - - -/* X(1) X(2) X(3) */ -/* = < V, ( -------- , -------- , -------- ) > */ -/* 2 2 2 */ -/* SCLA SCLB SCLC */ - - -/* X(1) X(2) X(3) */ -/* - < X, ( -------- , -------- , -------- ) > */ -/* 2 2 2 */ -/* SCLA SCLB SCLC */ - -/* 2 2 2 */ -/* X(1) X(2) X(3) */ -/* = -------- + -------- + -------- */ -/* 2 2 2 */ -/* SCLA SCLB SCLC */ - - -/* = 1 */ - - -/* This last equation is just the equation of the scaled ellipsoid. */ -/* We can combine the last two equalities and interchange the */ -/* positions of X and V to obtain */ - - -/* V(1) V(2) V(3) */ -/* < X, ( -------- , -------- , -------- ) > = 1 */ -/* 2 2 2 */ -/* SCLA SCLB SCLC */ - - -/* This is the equation of the limb plane. */ - - -/* Put together a SPICELIB plane, LPLANE, that represents the limb */ -/* plane. */ - - normal[0] = v[0] / scla2; - normal[1] = v[1] / sclb2; - normal[2] = v[2] / sclc2; - nvc2pl_(normal, &c_b18, lplane); - -/* Find the limb by intersecting the limb plane with the ellipsoid. */ - - inedpl_(&scla, &sclb, &sclc, lplane, limb, &found); - -/* FOUND should be true unless we've encountered numerical problems. */ - - if (! found) { - setmsg_("Ellipsoid shape and viewing geometry are too extreme; the l" - "imb was not found. ", (ftnlen)78); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("EDLIMB", (ftnlen)6); - return 0; - } - -/* Undo the scaling before returning the limb. */ - - vsclg_(&scale, limb, &c__9, tmpel); - moved_(tmpel, &c__9, limb); - chkout_("EDLIMB", (ftnlen)6); - return 0; -} /* edlimb_ */ - diff --git a/ext/spice/src/cspice/edlimb_c.c b/ext/spice/src/cspice/edlimb_c.c deleted file mode 100644 index 68a5836a2d..0000000000 --- a/ext/spice/src/cspice/edlimb_c.c +++ /dev/null @@ -1,406 +0,0 @@ -/* - --Procedure edlimb_c ( Ellipsoid Limb ) - --Abstract - - Find the limb of a triaxial ellipsoid, viewed from a specified - point. - --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 - - ELLIPSES - --Keywords - - ELLIPSE - ELLIPSOID - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef edlimb_c - - - void edlimb_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble viewpt[3], - SpiceEllipse * limb ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - a I Length of ellipsoid semi-axis lying on the x-axis. - b I Length of ellipsoid semi-axis lying on the y-axis. - c I Length of ellipsoid semi-axis lying on the z-axis. - viewpt I Location of viewing point. - limb O Limb of ellipsoid as seen from viewing point. - --Detailed_Input - - a, - b, - c are the lengths of the semi-axes of a triaxial - ellipsoid. The ellipsoid is centered at the - origin and oriented so that its axes lie on the - x, y and z axes. a, b, and c are the lengths of - the semi-axes that point in the x, y, and z - directions respectively. - - viewpt is a point from which the ellipsoid is viewed. - viewpt must be outside of the ellipsoid. - --Detailed_Output - - limb is a CSPICE ellipse that represents the limb of - the ellipsoid. - --Parameters - - None. - --Exceptions - - 1) If the length of any semi-axis of the ellipsoid is - non-positive, the error DEGENERATECASE is signaled. - limb is not modified. - - 2) If the length of any semi-axis of the ellipsoid is zero after - the semi-axis lengths are scaled by the reciprocal of the - magnitude of the longest semi-axis and then squared, the error - SPICE(DEGENERATECASE) is signaled. limb is not modified. - - 3) If the viewing point viewpt is inside the ellipse, the error - SPICE(INVALIDPOINT) is signaled. limb is not modified. - - 4) If the geometry defined by the input ellipsoid and viewing - point is so extreme that the limb cannot be found, the error - SPICE(DEGENERATECASE) is signaled. - - 5) If the shape of the ellipsoid and the viewing geometry are - such that the limb is an excessively flat ellipsoid, the - limb may be a degenerate ellipse. You must determine whether - this possibility poses a problem for your application. - --Files - - None. - --Particulars - - The limb of a body, as seen from a viewing point, is the boundary - of the portion of the body's surface that is visible from that - viewing point. In this definition, we consider a surface point - to be `visible' if it can be connected to the viewing point by a - line segment that doen't pass through the body. This is a purely - geometrical definition that ignores the matter of which portions - of the surface are illuminated, or whether the view is obscured by - any additional objects. - - If a body is modelled as a triaxial ellipsoid, the limb is always - an ellipse. The limb is determined by its center, a semi-major - axis vector, and a semi-minor axis vector. - - We note that the problem of finding the limb of a triaxial - ellipsoid is mathematically identical to that of finding its - terminator, if one makes the simplifying assumption that the - terminator is the limb of the body as seen from the vertex of the - umbra. So, this routine can be used to solve this simplified - version of the problem of finding the terminator. - --Examples - - 1) We'd like to find the apparent limb of Jupiter, corrected for - light time and stellar aberration, as seen from a spacecraft's - position at time ET. - - - /. - Find the viewing point in Jupiter-fixed coordinates. To do - this, find the apparent position of Jupiter as seen from the - spacecraft in Jupiter-fixed coordinates and negate this - vector. In this case we'll use light time and stellar - aberration corrections to arrive at the apparent limb. jstat - is the Jupiter's state (position and velocity) as seen - from the spacecraft. scpos is the spacecraft's - position relative to Jupiter. - ./ - spkez_c( jupid, et, "IAU_JUPITER", "LT+S", scid, scstat, <); - - vminus_c ( scstat, scpos ); - - /. - Get Jupiter's semi-axis lengths. - ./ - bodvcd_c ( jupid, "RADII", 3, &n, rad ); - - /. - Find the apparent limb. limb is a CSPICE ellipse - representing the limb. - ./ - edlimb_c ( rad[0], rad[1], rad[2], scpos, &limb ); - - /. - lcentr, smajor, and sminor are the limb's center, - semi-major axis, and semi-minor axis. - ./ - el2cgv_c ( &limb, center, smajor, sminor ); - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 24-OCT-2005 (NJB) - - Header update: reference to bodvar_c was replaced with - reference to bodvcd_c. - - -CSPICE Version 1.0.0, 13-JUN-1999 (NJB) - --Index_Entries - - ellipsoid limb - --& -*/ - -{ /* Begin edlimb_c */ - - - /* - Local variables - */ - - SpiceBoolean found; - - SpiceDouble level; - SpiceDouble normal [3]; - SpiceDouble scale; - SpiceDouble scla; - SpiceDouble scla2; - SpiceDouble sclb; - SpiceDouble sclb2; - SpiceDouble sclc; - SpiceDouble sclc2; - SpiceDouble v [3]; - - SpicePlane lplane; - - - - /* - Participate in error tracing. - */ - - chkin_c ( "edlimb_c" ); - - if ( ( a <= 0. ) - || ( b <= 0. ) - || ( c <= 0. ) ) - { - setmsg_c ( "Semi-axis lengths: a = #, b = #, c = #." ); - errdp_c ( "#", a ); - errdp_c ( "#", b ); - errdp_c ( "#", c ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "inedpl_c" ); - return; - } - - - /* - Scale the semi-axes lengths for better numerical behavior. - If squaring any one of the scaled lengths causes it to - underflow to zero, we cannot continue the computation. Otherwise, - scale the viewing point too. - */ - - scale = MaxAbs ( a, b ); - scale = MaxAbs ( c, scale ); - - scla = a / scale; - sclb = b / scale; - sclc = c / scale; - - scla2 = scla*scla; - sclb2 = sclb*sclb; - sclc2 = sclc*sclc; - - if ( ( scla2 == 0. ) - || ( sclb2 == 0. ) - || ( sclc2 == 0. ) ) - { - setmsg_c ( "Semi-axis too small: a = #, b = #, c = #. " ); - errdp_c ( "#", a ); - errdp_c ( "#", b ); - errdp_c ( "#", c ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "edlimb_c" ); - return; - } - - vscl_c ( 1. / scale, viewpt, v ); - - - /* - The viewing point must be outside of the ellipsoid. level is the - constant of the level surface that v lies on. The ellipsoid - itself is the level surface corresponding to level = 1. - */ - - level = ( v[0]*v[0] / scla2 ) - + ( v[1]*v[1] / sclb2 ) - + ( v[2]*v[2] / sclc2 ); - - if ( level < 1. ) - { - setmsg_c ( "Viewing point is inside the ellipsoid." ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "edlimb_c" ); - return; - } - - - /* - Find a normal vector for the limb plane. - - To compute this vector, we use the fact that the surface normal at - each limb point is orthogonal to the line segment connecting the - viewing point and the limb point. Let the notation - - < a, b > - - indicate the dot product of the vectors a and b. If we call the - viewing point v and the limb point x, then - - - - x[0] x[1] x[2] - 0 = < v - x, ( -------- , -------- , -------- ) > - 2 2 2 - scla sclb sclc - - - x[0] x[1] x[2] - = < v, ( -------- , -------- , -------- ) > - 2 2 2 - scla sclb sclc - - - x[0] x[1] x[2] - - < x, ( -------- , -------- , -------- ) > - 2 2 2 - scla sclb sclc - - 2 2 2 - x[0] x[1] x[2] - = -------- + -------- + -------- - 2 2 2 - scla sclb sclc - - - = 1 - - - This last equation is just the equation of the scaled ellipsoid. - We can combine the last two equalities and interchange the - positions of x and v to obtain - - - v[0] v[1] v[2] - < x, ( -------- , -------- , -------- ) > = 1 - 2 2 2 - scla sclb sclc - - - This is the equation of the limb plane. - */ - - /* - Put together a SPICELIB plane, lplane, that represents the limb - plane. - */ - normal[0] = v[0] / scla2; - normal[1] = v[1] / sclb2; - normal[2] = v[2] / sclc2; - - nvc2pl_c ( normal, 1.0, &lplane ); - - - /* - Find the limb by intersecting the limb plane with the ellipsoid. - */ - inedpl_c ( scla, sclb, sclc, &lplane, limb, &found ); - - - /* - found should be true unless we've encountered numerical problems. - */ - - if ( !found ) - { - setmsg_c ( "Ellipsoid shape and viewing geometry are too " - "extreme; the limb was not found. " ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "edlimb_c" ); - return; - } - - - /* - Undo the scaling before returning the limb. - */ - - vscl_c ( scale, limb->center, limb->center ); - vscl_c ( scale, limb->semiMajor, limb->semiMajor ); - vscl_c ( scale, limb->semiMinor, limb->semiMinor ); - - - chkout_c ( "edlimb_c" ); - -} /* End edlimb_c */ - diff --git a/ext/spice/src/cspice/edterm.c b/ext/spice/src/cspice/edterm.c deleted file mode 100644 index d0e0ad17d5..0000000000 --- a/ext/spice/src/cspice/edterm.c +++ /dev/null @@ -1,766 +0,0 @@ -/* edterm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure EDTERM ( Ellipsoid terminator ) */ -/* Subroutine */ int edterm_(char *trmtyp, char *source, char *target, - doublereal *et, char *fixfrm, char *abcorr, char *obsrvr, integer * - npts, doublereal *trgepc, doublereal *obspos, doublereal *trmpts, - ftnlen trmtyp_len, ftnlen source_len, ftnlen target_len, ftnlen - fixfrm_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - extern /* Subroutine */ int zzcorepc_(char *, doublereal *, doublereal *, - doublereal *, ftnlen), zzedterm_(char *, doublereal *, doublereal - *, doublereal *, doublereal *, doublereal *, integer *, - doublereal *, ftnlen); - integer n; - doublereal r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer trgid; - logical found; - doublereal ltsrc; - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - integer frcode, frclas; - doublereal srcrad[3]; - integer center, clssid; - doublereal trgrad[3]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *), bodvrd_( - char *, char *, integer *, integer *, doublereal *, ftnlen, - ftnlen), sigerr_(char *, ftnlen); - doublereal lttarg; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - doublereal srcpos[3], trgpos[3]; - extern logical return_(void); - extern /* Subroutine */ int spkpos_(char *, doublereal *, char *, char *, - char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen, - ftnlen), vminus_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Compute a set of points on the umbral or penumbral terminator of */ -/* a specified target body, where the target shape is modeled as an */ -/* ellipsoid. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* BODY */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TRMTYP I Terminator type. */ -/* SOURCE I Light source. */ -/* TARGET I Target body. */ -/* ET I Observation epoch. */ -/* FIXFRM I Body-fixed frame associated with target. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Observer. */ -/* NPTS I Number of points in terminator set. */ -/* TRGEPC O Epoch associated with target center. */ -/* OBSPOS O Position of observer in body-fixed frame. */ -/* TRMPTS O Terminator point set. */ - -/* $ Detailed_Input */ - -/* TRMTYP is a string indicating the type of terminator to */ -/* compute: umbral or penumbral. The umbral terminator */ -/* is the boundary of the portion of the ellipsoid */ -/* surface in total shadow. The penumbral terminator is */ -/* the boundary of the portion of the surface that is */ -/* completely illuminated. Note that in astronomy */ -/* references, the unqualified word "terminator" refers */ -/* to the umbral terminator. Here, the unqualified */ -/* word refers to either type of terminator. */ - -/* Possible values of TRMTYP are */ - -/* 'UMBRAL' */ -/* 'PENUMBRAL' */ - -/* Case and leading or trailing blanks in TRMTYP are */ -/* not significant. */ - - -/* SOURCE is the name of the body acting as a light source. */ -/* SOURCE is case-insensitive, and leading and trailing */ -/* blanks in TARGET are not significant. Optionally, you */ -/* may supply a string containing the integer ID code */ -/* for the object. For example both 'SUN' and '10' are */ -/* legitimate strings that indicate the Sun is the light */ -/* source. */ - -/* This routine assumes that a kernel variable */ -/* representing the light source's radii is present in */ -/* the kernel pool. Normally the kernel variable would */ -/* be defined by loading a PCK file. */ - -/* The shape of the light source is always modeled as a */ -/* sphere, regardless of whether radii defining a */ -/* triaxial ellipsoidal shape model are available in the */ -/* kernel pool. The maximum radius of the body is used */ -/* as the radius of the sphere. */ - - -/* TARGET is the name of the target body. TARGET is */ -/* case-insensitive, and leading and trailing blanks in */ -/* TARGET are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the moon is the */ -/* target body. */ - -/* This routine assumes that a kernel variable */ -/* representing the target's radii is present in the */ -/* kernel pool. Normally the kernel variable would be */ -/* defined by loading a PCK file. */ - - -/* ET is the epoch of participation of the observer, */ -/* expressed as ephemeris seconds past J2000 TDB: ET is */ -/* the epoch at which the observer's position is */ -/* computed. */ - -/* When aberration corrections are not used, ET is also */ -/* the epoch at which the position and orientation of the */ -/* target body and position of the light source are */ -/* computed. */ - -/* When aberration corrections are used, ET is the epoch */ -/* at which the observer's position relative to the solar */ -/* system barycenter is computed; in this case the */ -/* position and orientation of the target body are */ -/* computed at ET-LT or ET+LT, where LT is the one-way */ -/* light time between the target body's center and the */ -/* observer, and the sign applied to LT depends on the */ -/* selected correction. See the description of ABCORR */ -/* below for details. */ - - -/* FIXFRM is the name of the reference frame relative to which */ -/* the output terminator points are expressed. This must */ -/* a body-centered, body-fixed frame associated with the */ -/* target. The frame's axes must be compatible with the */ -/* triaxial ellipsoidal shape model associated with the */ -/* target body (normally provide via a PCK): this */ -/* routine assumes that the first, second, and third */ -/* axis lengths correspond, respectively, to the x, y, */ -/* and z-axes of the frame designated by FIXFRM. */ - -/* FIXFRM may refer to a built-in frame (documented in */ -/* the Frames Required Reading) or a frame defined by a */ -/* loaded frame kernel (FK). */ - -/* The orientation of the frame designated by FIXFRM is */ -/* evaluated at epoch of participation of the target */ -/* body. See the descriptions of ET and ABCORR for */ -/* details. */ - - -/* ABCORR indicates the aberration correction to be applied */ -/* when computing the observer-target position, the */ -/* orientation of the target body, and the target- */ -/* source position vector. ABCORR may be any of */ -/* the following. */ - -/* 'NONE' Apply no correction. Compute the */ -/* terminator points using the position */ -/* of the light source and target, and */ -/* the orientation of the target, at ET. */ - -/* Let LT represent the one-way light time between the */ -/* observer and the target body's center. The following */ -/* values of ABCORR apply to the "reception" case in */ -/* which photons depart from the target body's center at */ -/* the light-time corrected epoch ET-LT and *arrive* at */ -/* the observer's location at ET: */ - - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the location of the terminator */ -/* points at the approximate time they */ -/* emitted photons arriving at the */ -/* observer at ET (the difference between */ -/* light time to the target center and */ -/* light time to the terminator points */ -/* is ignored). */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* The target position as seen by the */ -/* observer, the position of the light */ -/* source as seen from the target at */ -/* ET-LT, and the rotation of the target */ -/* body, are corrected for light time. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* positions obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. This correction also */ -/* applies to the position of the light */ -/* source relative to the target. The */ -/* result is the apparent terminator as */ -/* seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges. The */ -/* position and rotation of the target */ -/* body and the position of the light */ -/* source relative to the target are */ -/* corrected for light time. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* OBSRVR is the name of the observing body. This is typically */ -/* a spacecraft, the Earth, or a surface point on the */ -/* Earth. OBSRVR is case-insensitive, and leading and */ -/* trailing blanks in OBSRVR are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'EARTH' and '399' are legitimate strings that indicate */ -/* the Earth is the observer. */ - - -/* NPTS is the number of terminator points to compute. */ - - -/* $ Detailed_Output */ - -/* TRGEPC is the "target epoch." TRGEPC is defined as follows: */ -/* letting LT be the one-way light time between the */ -/* target center and observer, TRGEPC is either the */ -/* epoch ET-LT or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation or omitted. LT is computed using the */ -/* method indicated by ABCORR. */ - -/* TRGEPC is expressed as seconds past J2000 TDB. */ - - -/* OBSPOS is the vector from the center of the target body at */ -/* epoch TRGEPC to the observer at epoch ET. OBSPOS is */ -/* expressed in the target body-fixed reference frame */ -/* FIXFRM, which is evaluated at TRGEPC. */ - -/* OBSPOS is returned to simplify various related */ -/* computations that would otherwise be cumbersome. For */ -/* example, the vector XVEC from the observer to the */ -/* Ith terminator point can be calculated via the call */ - -/* CALL VMINUS ( TRMPTS(1,I), OBSPOS, XVEC ) */ - -/* The components of OBSPOS are given in units of km. */ - - -/* TRMPTS is an array of points on the umbral or penumbral */ -/* terminator of the ellipsoid, as specified by the */ -/* input argument TRMTYP. The Ith point is contained in */ -/* the array elements */ - -/* TRMPTS(J,I), J = 1, 2, 3 */ - -/* Each terminator point is the point of tangency of a */ -/* plane that is also tangent to the light source. These */ -/* associated points of tangency on the light source */ -/* have uniform distribution in longitude when expressed */ -/* in a cylindrical coordinate system whose Z-axis is */ -/* OBSPOS. The magnitude of the separation in longitude */ -/* between the tangency points on the light source is */ - -/* 2*Pi / NPTS */ - -/* If the target is spherical, the terminator points */ -/* also are uniformly distributed in longitude in the */ -/* cylindrical system described above. If the target is */ -/* non-spherical, the longitude distribution of the */ -/* points generally is not uniform. */ - -/* The terminator points are expressed in the body-fixed */ -/* reference frame designated by FIXFRM. Units are km. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input frame name FIXFRM cannot be mapped */ -/* to a frame ID code, the error SPICE(NOTRANSLATION) is */ -/* signaled. */ - -/* 2) If the target name TARGET cannot be mapped */ -/* to a body ID code, the error SPICE(NOTRANSLATION) is */ -/* signaled. */ - -/* 3) If the frame designated by FIXFRM is not centered */ -/* on the target, the error SPICE(INVALIDFIXFRM) is */ -/* signaled. */ - -/* 4) If the terminator type is not recognized, the error */ -/* will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 5) If the set size NPTS is not at least 1, the error */ -/* will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 6) If any of the ellipsoid's semi-axis lengths is non-positive, */ -/* the error will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 7) If the light source has non-positive radius, the error */ -/* will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 8) If the light source intersects the smallest sphere */ -/* centered at the origin and containing the ellipsoid, the */ -/* error will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 9) If radii for the target body or light source are not */ -/* available in the kernel pool, the error will be diagnosed by */ -/* a routine in the call tree of this routine. If radii are */ -/* available but either body does not have three radii, the */ -/* error SPICE(INVALIDCOUNT) will be signaled. */ - -/* 10) If any SPK look-up fails, the error will be diagnosed by */ -/* a routine in the call tree of this routine. */ - -/* $ Files */ - -/* Appropriate SPK, PCK, and frame kernels must be loaded by the */ -/* calling program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target, observer, and light */ -/* source must be loaded. If aberration corrections are used, */ -/* the states of all three objects relative to the solar system */ -/* barycenter must be calculable from the available ephemeris */ -/* data. Typically ephemeris data are made available by loading */ -/* one or more SPK files via FURNSH. */ - -/* - PCK data: triaxial radii for the target body and */ -/* the light source must be loaded into the kernel pool. */ -/* Typically this is done by loading a text PCK file via */ -/* FURNSH. */ - -/* - Further PCK data: rotation data for the target body must */ -/* be loaded. These may be provided in a text or binary PCK */ -/* file. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the target body-fixed */ -/* frame designated by FIXFRM, that definition must be */ -/* available in the kernel pool. Typically the definitions of */ -/* frames not already built-in to SPICE are supplied by loading */ -/* a frame kernel. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine models the boundaries of shadow regions on an */ -/* ellipsoidal target body "illuminated" by a spherical light */ -/* source. Light rays are assumed to travel along straight lines; */ -/* refraction is not modeled. */ - -/* Points on the target body's surface at which the entire cap of */ -/* the light source is visible are considered to be completely */ -/* illuminated. Points on the target's surface at which some portion */ -/* (or all) of the cap of the light source are blocked are */ -/* considered to be in partial (or total) shadow. */ - -/* In this routine, we use the term "umbral terminator" to denote */ -/* the curve ususally called the "terminator": this curve is the */ -/* boundary of the portion of the target body's surface that lies in */ -/* total shadow. We use the term "penumbral terminator" to denote */ -/* the boundary of the completely illuminated portion of the */ -/* surface. */ - -/* In general, the terminator on an ellipsoid is a more complicated */ -/* curve than the limb (which is always an ellipse). Aside from */ -/* various special cases, the terminator does not lie in a plane. */ - -/* However, the condition for a point X on the ellipsoid to lie on */ -/* the terminator is simple: a plane tangent to the ellipsoid at X */ -/* must also be tangent to the light source. If this tangent plane */ -/* does not intersect the vector from the center of the ellipsoid to */ -/* the center of the light source, then X lies on the umbral */ -/* terminator; otherwise X lies on the penumbral terminator. */ - -/* $ Examples */ - -/* 1) Compute a set of umbral terminator points on the Moon. */ -/* Perform a consistency check using the solar incidence angle */ -/* at each point. We expect to see a solar incidence angle of */ -/* approximately 90 degrees. Since the solar incidence angle is */ -/* measured between the local outward normal and the direction */ -/* to the Sun, the solar incidence angle at an umbral terminator */ -/* point should exceed 90 degrees by approximately the angular */ -/* radius of the Sun. */ - -/* This program loads SPICE kernels via a meta-kernel. The ' */ -/* contents of the meta-kernel used to produce the results shown */ -/* below */ - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'naif0008.tls' */ -/* 'pck00008.tpc' */ -/* 'de405s.bsp' ) */ -/* \begintext */ - - -/* Program source code: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION VDIST */ - -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'ex1_meta.ker' ) */ - -/* INTEGER NPTS */ -/* PARAMETER ( NPTS = 3 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 5 ) */ - -/* INTEGER BDNMLN */ -/* PARAMETER ( BDNMLN = 36 ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* CHARACTER*(CORLEN) ABCORR */ -/* CHARACTER*(FRNMLN) FRAME */ -/* CHARACTER*(BDNMLN) SOURCE */ -/* CHARACTER*(BDNMLN) TARGET */ -/* CHARACTER*(BDNMLN) OBSRVR */ -/* CHARACTER*(TIMLEN) UTC */ - -/* DOUBLE PRECISION ANGRAD */ -/* DOUBLE PRECISION EMISSN */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION OBSPOS ( 3 ) */ -/* DOUBLE PRECISION PHASE */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SOLAR */ -/* DOUBLE PRECISION SRCPOS ( 3 ) */ -/* DOUBLE PRECISION SRCRAD ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ -/* DOUBLE PRECISION TRMPTS ( 3, NPTS ) */ - -/* INTEGER I */ -/* INTEGER N */ - - -/* CALL FURNSH ( META ) */ - -/* UTC = '2007 FEB 3 00:00:00.000' */ - -/* CALL STR2ET ( UTC, ET ) */ - -/* OBSRVR = 'EARTH' */ -/* TARGET = 'MOON' */ -/* SOURCE = 'SUN' */ -/* FRAME = 'IAU_MOON' */ -/* ABCORR = 'LT+S' */ - -/* CALL EDTERM ( 'UMBRAL', SOURCE, TARGET, */ -/* . ET, FRAME, ABCORR, */ -/* . OBSRVR, NPTS, TRGEPC, */ -/* . OBSPOS, TRMPTS ) */ - -/* C */ -/* C Find the angular radius of the Sun as */ -/* C seen from the target. First, look up */ -/* C the target-sun vector. */ -/* C */ -/* CALL SPKPOS ( SOURCE, TRGEPC, FRAME, */ -/* . ABCORR, TARGET, SRCPOS, LT ) */ - -/* C */ -/* C Look up the radii of the Sun. */ -/* C */ -/* CALL BODVRD ( SOURCE, 'RADII', 3, N, SRCRAD ) */ - -/* DO I = 1, NPTS */ - -/* WRITE (*,*) ' ' */ - -/* CALL RECLAT ( TRMPTS(1,I), RADIUS, LON, LAT ) */ - -/* WRITE (*,*) 'Terminator point ', I, ':' */ -/* WRITE (*,*) ' Radius (km): ', */ -/* . RADIUS */ -/* WRITE (*,*) ' Planetocentric longitude (deg): ', */ -/* . LON*DPR() */ -/* WRITE (*,*) ' Planetocentric latitude (deg): ', */ -/* . LAT*DPR() */ - -/* C */ -/* C Find the illumination angles at the */ -/* C Ith terminator point. */ -/* C */ -/* CALL ILLUM ( TARGET, ET, ABCORR, */ -/* . OBSRVR, TRMPTS(1,I), PHASE, */ -/* . SOLAR, EMISSN ) */ - -/* WRITE (*,*) */ -/* . ' Solar incidence angle (deg): ', */ -/* . SOLAR*DPR() */ - -/* C */ -/* C Find the angular radius of the Sun as seen from */ -/* C the terminator point. */ -/* C */ -/* ANGRAD = ASIN ( SRCRAD(1) */ -/* . / VDIST ( SRCPOS,TRMPTS(1,I) ) ) */ - -/* C */ -/* C Display the solar incidence angle after */ -/* C subtracting the angular radius of the Sun */ -/* C as seen from the terminator point. The */ -/* C result should be approximately 90 degrees. */ -/* C */ -/* WRITE (*, '(1X,A,2PE22.14)') */ -/* . ' Minus Sun''s ' // */ -/* . 'angular radius (deg): ', */ -/* . (SOLAR-ANGRAD) * DPR() */ - -/* END DO */ - -/* END */ - - -/* When executed, this program produces the output shown */ -/* below. Note that the results may vary slightly from one */ -/* computing platform to another. Results are dependent on */ -/* the kernels used as well as the hardware and system software */ -/* running on the host system. */ - - -/* Terminator point 1: */ -/* Radius (km): 1737.4 */ -/* Planetocentric longitude (deg): -95.0845526 */ -/* Planetocentric latitude (deg): 0.00405276211 */ -/* Solar incidence angle (deg): 90.2697657 */ -/* Minus Sun's angular radius (deg): 90.0000000000000E+00 */ - -/* Terminator point 2: */ -/* Radius (km): 1737.4 */ -/* Planetocentric longitude (deg): 84.2280921 */ -/* Planetocentric latitude (deg): 59.9957555 */ -/* Solar incidence angle (deg): 90.2697657 */ -/* Minus Sun's angular radius (deg): 90.0000000000000E+00 */ - -/* Terminator point 3: */ -/* Radius (km): 1737.4 */ -/* Planetocentric longitude (deg): 87.2164179 */ -/* Planetocentric latitude (deg): -59.9795505 */ -/* Solar incidence angle (deg): 90.2697657 */ -/* Minus Sun's angular radius (deg): 90.0000000000000E+00 */ - - -/* $ Restrictions */ - -/* 1) This routine models light paths as straight lines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-FEB-2007 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find terminator on ellipsoid */ -/* find umbral terminator on ellipsoid */ -/* find penumbral terminator on ellipsoid */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("EDTERM", (ftnlen)6); - -/* Get the input frame code and frame info. */ - - namfrm_(fixfrm, &frcode, fixfrm_len); - if (frcode == 0) { - setmsg_("Input frame # has no associated frame ID code.", (ftnlen)46); - errch_("#", fixfrm, (ftnlen)1, fixfrm_len); - sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20); - chkout_("EDTERM", (ftnlen)6); - return 0; - } - frinfo_(&frcode, ¢er, &frclas, &clssid, &found); - if (! found) { - setmsg_("Input frame # has associated frame ID code #, but no info w" - "as found by FRINFO for this frame.", (ftnlen)93); - errch_("#", fixfrm, (ftnlen)1, fixfrm_len); - errint_("#", &frcode, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("EDTERM", (ftnlen)6); - return 0; - } - -/* Get the ID code of the target. */ - - bods2c_(target, &trgid, &found, target_len); - if (! found) { - setmsg_("Input target # has no associated body ID code.", (ftnlen)46); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20); - chkout_("EDTERM", (ftnlen)6); - return 0; - } - -/* If the frame is not centered on the target, reject it. */ - - if (center != trgid) { - setmsg_("Input frame # is not centered on target body #. This frame " - "must be a body-fixed frame associated with the target.", ( - ftnlen)113); - errch_("#", fixfrm, (ftnlen)1, fixfrm_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(INVALIDFIXFRM)", (ftnlen)20); - chkout_("EDTERM", (ftnlen)6); - return 0; - } - -/* Look up the radii associated with the target body. */ - - bodvrd_(target, "RADII", &c__3, &n, trgrad, target_len, (ftnlen)5); - if (n != 3) { - setmsg_("Three radii are required for the target body's (#) shape mo" - "del, but # were found.", (ftnlen)81); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("EDTERM", (ftnlen)6); - return 0; - } - -/* Look up the radii associated with the light source. */ - - bodvrd_(source, "RADII", &c__3, &n, srcrad, source_len, (ftnlen)5); - if (n != 3) { - setmsg_("Three radii are required for the light source's (#) shape m" - "odel, but # were found.", (ftnlen)82); - errch_("#", source, (ftnlen)1, source_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("EDTERM", (ftnlen)6); - return 0; - } -/* Computing MAX */ - d__1 = max(srcrad[0],srcrad[1]); - r__ = max(d__1,srcrad[2]); - -/* Look up the observer-target vector and the target-source vector. */ -/* Also set the output OBSPOS. */ - - spkpos_(target, et, fixfrm, abcorr, obsrvr, trgpos, <targ, target_len, - fixfrm_len, abcorr_len, obsrvr_len); - zzcorepc_(abcorr, et, <targ, trgepc, abcorr_len); - vminus_(trgpos, obspos); - spkpos_(source, trgepc, fixfrm, abcorr, target, srcpos, <src, - source_len, fixfrm_len, abcorr_len, target_len); - -/* We're ready to compute the terminator. */ - - zzedterm_(trmtyp, trgrad, &trgrad[1], &trgrad[2], &r__, srcpos, npts, - trmpts, trmtyp_len); - chkout_("EDTERM", (ftnlen)6); - return 0; -} /* edterm_ */ - diff --git a/ext/spice/src/cspice/ef1asc_.c b/ext/spice/src/cspice/ef1asc_.c deleted file mode 100644 index 5e9c4fb45d..0000000000 --- a/ext/spice/src/cspice/ef1asc_.c +++ /dev/null @@ -1,35 +0,0 @@ -/* - 06-FEB-1999 (NJB) - - The statement - - return 0; - - for the normal C case was added to suppress compilation warnings. - -*/ - -/* EFL support routine to copy string b to string a */ - -#include "f2c.h" - - -#define M ( (long) (sizeof(long) - 1) ) -#define EVEN(x) ( ( (x)+ M) & (~M) ) - -#ifdef KR_headers -extern VOID s_copy(); -ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; -#else -extern void s_copy(char*,char*,ftnlen,ftnlen); -int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) -#endif -{ -s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); - -return 0; - -#ifdef __cplusplus -return 0; -#endif -} diff --git a/ext/spice/src/cspice/ef1cmc_.c b/ext/spice/src/cspice/ef1cmc_.c deleted file mode 100644 index 8239a6ba2e..0000000000 --- a/ext/spice/src/cspice/ef1cmc_.c +++ /dev/null @@ -1,14 +0,0 @@ -/* EFL support routine to compare two character strings */ - -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -integer ef1cmc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; -#else -extern integer s_cmp(char*,char*,ftnlen,ftnlen); -integer ef1cmc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) -#endif -{ -return( s_cmp( (char *)a, (char *)b, *la, *lb) ); -} diff --git a/ext/spice/src/cspice/ekacec.c b/ext/spice/src/cspice/ekacec.c deleted file mode 100644 index d39e5b572c..0000000000 --- a/ext/spice/src/cspice/ekacec.c +++ /dev/null @@ -1,683 +0,0 @@ -/* ekacec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKACEC ( EK, add character data to column ) */ -/* Subroutine */ int ekacec_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, char *cvals, logical *isnull, ftnlen - column_len, ftnlen cvals_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - zzektrdp_(integer *, integer *, integer *, integer *), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekad03_(integer *, - integer *, integer *, integer *, char *, logical *, ftnlen), - zzekad06_(integer *, integer *, integer *, integer *, integer *, - char *, logical *, ftnlen); - -/* $ Abstract */ - -/* Add data to a character column in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record to which data is to be added. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values to add to column. */ -/* CVALS I Character values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ - -/* SEGNO is the index of the segment to which data is to */ -/* be added. */ - -/* RECNO is the index of the record to which data is to be */ -/* added. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column to which data is to be */ -/* added. */ - -/* NVALS, */ -/* CVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written into the */ -/* specified column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* Only one value can be added to a virtual column. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and CVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and CVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 3) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 4) If COLUMN specifies a column of whose data type is not */ -/* character, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 5) If RECNO is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 6) If the specified column has fixed-size entries and NVALS */ -/* does not match this size, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 7) If the specified column has variable-size entries and NVALS */ -/* is non-positive, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 8) If an attempt is made to add a null value to a column that */ -/* doesn't take null values, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 9) If COLUMN specifies a column of whose class is not */ -/* an character class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified record in the specified */ -/* column. Data may be added to a segment in random order; it is not */ -/* necessary to fill in columns or rows sequentially. Data may only */ -/* be added one column entry at a time. */ - -/* $ Examples */ - -/* 1) Add the value '999' to the third record of the column CCOL in */ -/* the fifth segment of an EK file designated by HANDLE. */ - -/* CALL EKACEC ( HANDLE, 5, 3, 'CCOL', 1, '999', .FALSE. ) */ - - -/* 2) Same as (1), but this time add a null value. The argument */ -/* 999 is ignored because the null flag is set to .TRUE. */ - -/* CALL EKACEC ( HANDLE, 5, 3, 'CCOL', 1, '999', .TRUE. ) */ - - -/* 3) Add an array CBUFF of 10 values to the third record of the */ -/* column CARRAY in the fifth segment of an EK file designated by */ -/* HANDLE. */ - -/* CALL EKACEC ( HANDLE, 5, 3, 'CARRAY', 10, CBUFF, .FALSE. ) */ - - -/* 4) A more detailed example. */ - -/* Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* If we wanted to insert a new record into the DATAORDERS */ -/* table in position 1, we'd make the following calls: */ - -/* C */ -/* C Open the database for write access. This call is */ -/* C made when the file already exists. See EKOPN for */ -/* C an example of creating a new file. */ -/* C */ -/* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */ - -/* C */ -/* C Append a new, empty record to the DATAORDERS */ -/* C table. Recall that the DATAORDERS table */ -/* C is in segment number 1. The call will return */ -/* C the number of the new, empty record. */ -/* C */ -/* CALL EKAPPR ( HANDLE, 1, RECNO ) */ - -/* C */ -/* C At this point, the new record is empty. A valid EK */ -/* C cannot contain empty records. We fill in the data */ -/* C here. Data items are filled in one column at a time. */ -/* C The order in which the columns are filled in is not */ -/* C important. We use the EKACEx (add column entry) */ -/* C routines to fill in column entries. We'll assume */ -/* C that no entries are null. All entries are scalar, */ -/* C so the entry size is 1. */ -/* C */ -/* ISNULL = .FALSE. */ -/* ESIZE = 1 */ - -/* C */ -/* C The following variables will contain the data for */ -/* C the new record. */ -/* C */ -/* ORDID = 10011 */ -/* CUSTID = 531 */ -/* LNAME = 'Scientist' */ -/* FNAME = 'Joe' */ -/* ODATE = '1995-SEP-20' */ -/* COST = 0.D0 */ - -/* C */ -/* C Note that the names of the routines called */ -/* C correspond to the data types of the columns: the */ -/* C last letter of the routine name is C, I, or D, */ -/* C depending on the data type. Time values are */ -/* C converted to ET for storage. */ -/* C */ -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */ -/* . SIZE, ORDID, ISNULL ) */ - -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */ -/* . SIZE, CUSTID, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */ -/* . SIZE, LNAME, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */ -/* . SIZE, FNAME, ISNULL ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */ -/* . SIZE, ET, ISNULL ) */ - -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */ -/* . SIZE, COST, ISNULL ) */ - -/* C */ -/* C Close the file to make the update permanent. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* add character data to EK column */ -/* add data to EK */ -/* write character data to EK column */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of character type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - chkin_("EKACEC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKACEC only works with character col" - "umns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)95); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKACEC", (ftnlen)6); - return 0; - } - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - -/* Now it's time to add data to the file. */ - - class__ = coldsc[0]; - if (class__ == 3) { - -/* Class 3 columns contain scalar character data. */ - - zzekad03_(handle, segdsc, coldsc, &recptr, cvals, isnull, cvals_len); - } else if (class__ == 6) { - -/* Class 6 columns contain array-valued character data. */ - - zzekad06_(handle, segdsc, coldsc, &recptr, nvals, cvals, isnull, - cvals_len); - } else { - -/* This is an unsupported character column class. */ - - chkin_("EKACEC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported cha" - "racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)115); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKACEC", (ftnlen)6); - return 0; - } - return 0; -} /* ekacec_ */ - diff --git a/ext/spice/src/cspice/ekacec_c.c b/ext/spice/src/cspice/ekacec_c.c deleted file mode 100644 index 6b904e5be4..0000000000 --- a/ext/spice/src/cspice/ekacec_c.c +++ /dev/null @@ -1,487 +0,0 @@ -/* - --Procedure ekacec_c ( EK, add character data to column ) - --Abstract - - Add data to a character column in a specified EK record. - --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 - - EK - --Keywords - - EK - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekacec_c - - void ekacec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Index of segment containing record. - recno I Record to which data is to be added. - column I Column name. - nvals I Number of values to add to column. - vallen I Declared length of character values. - cvals I Character values to add to column. - isnull I Flag indicating whether column entry is null. - --Detailed_Input - - handle is the handle of an EK file open for write access. - - segno is the number of the segment to which the record - is to be added. EK segment numbers range from - 0 to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record to which data is to be - added. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column to which data is to be - added. - - - nvals is the number of entries in the value to be added to the - specified column. - - vallen is the length of the strings in the cvals array, where - the length includes space for null terminators. - - If the column has fixed-size entries, then nvals - must equal the entry size for the specified column. - - - cvals is the set of values themselves. The data values are - written into the specified column and record. - - The array cvals should be declared with dimensions - - [nelts][vallen] - - where nelts is greater than or equal to nvals. - - isnull is a logical flag indicating whether the entry is - null. If isnull is SPICEFALSE, the column entry - defined by nvals and cvals is added to the - specified kernel file. - - If isnull is SPICETRUE, nvals and cvals are ignored: - no data are written into the specified column entry. - The column entry is marked as a null value. - - If the column has fixed-length, variable-size - entries, the number of entries is considered to - be 1. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will be diagnosed by - routines called by this routine. - - 3) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 4) If column specifies a column of whose data type is not - character, the error SPICE(WRONGDATATYPE) will be - signaled. - - 5) If recno is out of range, the error will be diagnosed by - routines called by this routine. - - 6) If the specified column has fixed-size entries and nvals - does not match this size, the error will be diagnosed by - routines called by this routine. - - 7) If the specified column has variable-size entries and nvals - is non-positive, the error will be diagnosed by routines - called by this routine. - - 8) If an attempt is made to add a null value to a column that - doesn't take null values, the error will be diagnosed by - routines called by this routine. - - 9) If column specifies a column of whose class is not - a character class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 11) If the input string pointer for column is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If the input string column name has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 13) If the string pointer for cvals is null, the error - SPICE(NULLPOINTER) will be signaled. - - 14) If the string length vallen is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified record in the specified - column. Data may be added to a segment in random order; it is not - necessary to fill in columns or rows sequentially. Data may only - be added one column entry at a time. - --Examples - - 1) Add the value "999" to the third record of the column CCOL in - the fifth segment of an EK file designated by HANDLE. - - #include "SpiceUsr.h" - . - . - . - ekacec_c ( handle, 4, 2, "CCOL", 1, 4, "999", SPICEFALSE ); - - - 2) Same as (1), but this time add a null value. The argument - "999" is ignored because the null flag is set to SPICETRUE. - - #include "SpiceUsr.h" - . - . - . - ekacec_c ( handle, 4, 2, "CCOL", 1, 4, "999", SPICETRUE ); - - - 3) Add an array cbuff of 10 values to the third record of the - column CARRAY in the fifth segment of an EK file designated by - handle. We assume cbuff was declared as shown: - - SpiceChar cbuff[10][CBLEN]; - - - #include "SpiceUsr.h" - . - . - . - ekacec_c ( handle, 4, 2, "CARRAY", - 10, CBLEN, cbuff, SPICEFALSE ); - - - 4) A more detailed example: append a record to a specified - segment. - - Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file order_db.ek contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - If we wanted to insert a new record into the DATAORDERS - table in position 0, we'd make the following calls: - - - #include "SpiceUsr.h" - . - . - . - /. - Open the database for write access. This call is - made when the file already exists. See ekopn_c for - an example of creating a new file. - ./ - ekopw_c ( "order_db.ek", &handle ); - - /. - Append a new, empty record to the DATAORDERS - table. Recall that the DATAORDERS table - is in segment number 0. The call will return - the number of the new, empty record. - ./ - ekappr_c ( handle, 0, &recno ); - - /. - At this point, the new record is empty. A valid EK - cannot contain empty records. We fill in the data - here. Data items are filled in one column at a time. - The order in which the columns are filled in is not - important. We use the ekace*_c (add column entry) - routines to fill in column entries. We'll assume - that no entries are null. All entries are scalar, - so the entry size is 1. - ./ - isnull = SPICEFALSE; - size = 1; - - /. - The following variables will contain the data for - the new record. - ./ - ordid = 10011; - custid = 531; - lname = "scientist"; - fname = "joe"; - odate = "1995-sep-20"; - cost = 5000.; - - /. - Note that the names of the routines called - correspond to the data types of the columns: the - last letter of the routine name is C, I, or D, - depending on the data type. Time values are - converted to ET for storage. - ./ - ekacei_c ( handle, segno, recno, "order_id", - size, ordid, isnull ); - - ekacei_c ( handle, segno, recno, "customer_id", - size, custid, isnull ); - - ekacec_c ( handle, segno, recno, "last_name", - size, vallen, lname, isnull ); - - ekacec_c ( handle, segno, recno, "first_name", - size, vallen, fname, isnull ); - - utc2et_c ( odate, &et ); - - - ekaced_c ( handle, segno, recno, "order_date", - size, et, isnull ); - - ekaced_c ( handle, segno, recno, "cost", - size, cost, isnull ); - - /. - Close the file to make the update permanent. - ./ - ekcls_c ( handle ); - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - add character data to EK column - add data to EK - write character data to EK column - --& -*/ - -{ /* Begin ekacec_c */ - - - /* - Local variables - */ - logical null; - - SpiceChar ** cvalsPtr; - SpiceChar * fCvalsArr; - - SpiceInt i; - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekacec_c" ); - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekacec_c", column ); - - /* - Check the value array to make sure the pointer is non-null - and the string length is non-zero. Note: this check is normally - done for output strings: CHKOSTR is the macro that does the job. - */ - CHKOSTR ( CHK_STANDARD, "ekacec_c", cvals, vallen ); - - /* - We need to make a blank-padded version of the cvals array. - We'll first allocate an array of character pointers to index - the values, initialize this array, and use it to produce - a dynamically allocated array of Fortran-style strings. - */ - cvalsPtr = ( SpiceChar ** ) malloc ( nvals * sizeof(SpiceChar *) ); - - if ( cvalsPtr == 0 ) - { - setmsg_c ( "Failure on malloc call to create pointer array " - "for column values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "ekacec_c" ); - return; - } - - for ( i = 0; i < nvals; i++ ) - { - cvalsPtr[i] = (SpiceChar *)cvals + ( i * vallen ); - } - - C2F_CreateFixStrArr ( nvals, - vallen, - ( ConstSpiceChar ** ) cvalsPtr, - &fCvalsLen, - &fCvalsArr ); - - if ( failed_c() ) - { - free ( cvalsPtr ); - - chkout_c ( "ekacec_c" ); - return; - } - - /* - Map the segment and record numbers to the Fortran range. Get a - local logical variable to represent the null flag. - */ - segno++; - recno++; - - null = isnull; - - ekacec_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) &nvals, - ( char * ) fCvalsArr, - ( logical * ) &null, - ( ftnlen ) strlen(column), - ( ftnlen ) fCvalsLen ); - - - /* - Clean up our dynamically allocated arrays. - */ - free ( cvalsPtr ); - free ( fCvalsArr ); - - - chkout_c ( "ekacec_c" ); - -} /* End ekacec_c */ - - - - - - - - - - diff --git a/ext/spice/src/cspice/ekaced.c b/ext/spice/src/cspice/ekaced.c deleted file mode 100644 index 1aae325d77..0000000000 --- a/ext/spice/src/cspice/ekaced.c +++ /dev/null @@ -1,686 +0,0 @@ -/* ekaced.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKACED ( EK, add d.p. data to column ) */ -/* Subroutine */ int ekaced_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, doublereal *dvals, logical *isnull, - ftnlen column_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - zzektrdp_(integer *, integer *, integer *, integer *), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekad02_(integer *, - integer *, integer *, integer *, doublereal *, logical *), - zzekad05_(integer *, integer *, integer *, integer *, integer *, - doublereal *, logical *); - -/* $ Abstract */ - -/* Add data to an double precision column in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record to which data is to be added. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values to add to column. */ -/* DVALS I Double precision values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ - -/* SEGNO is the index of the segment to which data is to */ -/* be added. */ - -/* RECNO is the index of the record to which data is to be */ -/* added. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column to which data is to be */ -/* added. */ - -/* NVALS, */ -/* DVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written into the */ -/* specified column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* Only one value can be added to a virtual column. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and DVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and DVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 3) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 4) If COLUMN specifies a column of whose data type is not */ -/* double precision, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 5) If RECNO is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 6) If the specified column has fixed-size entries and NVALS */ -/* does not match this size, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 7) If the specified column has variable-size entries and NVALS */ -/* is non-positive, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 8) If an attempt is made to add a null value to a column that */ -/* doesn't take null values, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 9) If COLUMN specifies a column of whose class is not */ -/* an character class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified record in the specified */ -/* column. Data may be added to a segment in random order; it is not */ -/* necessary to fill in columns or rows sequentially. Data may only */ -/* be added one column entry at a time. */ - -/* $ Examples */ - -/* 1) Add the value 999.D0 to the third record of the column DCOL in */ -/* the fifth segment of an EK file designated by HANDLE. */ - -/* CALL EKACED ( HANDLE, 5, 3, 'DCOL', 1, 999.D0, .FALSE. ) */ - - -/* 2) Same as (1), but this time add a null value. The argument */ -/* 999.D0 is ignored because the null flag is set to .TRUE. */ - -/* CALL EKACED ( HANDLE, 5, 3, 'DCOL', 1, 999.D0, .TRUE. ) */ - - -/* 3) Add an array DBUFF of 10 values to the third record of the */ -/* column DARRAY in the fifth segment of an EK file designated by */ -/* HANDLE. */ - -/* CALL EKACED ( HANDLE, 5, 3, 'DARRAY', 10, DBUFF, .FALSE. ) */ - -/* 4) A more detailed example. */ - -/* Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* If we wanted to insert a new record into the DATAORDERS */ -/* table in position 1, we'd make the following calls: */ - -/* C */ -/* C Open the database for write access. This call is */ -/* C made when the file already exists. See EKOPN for */ -/* C an example of creating a new file. */ -/* C */ -/* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */ - -/* C */ -/* C Append a new, empty record to the DATAORDERS */ -/* C table. Recall that the DATAORDERS table */ -/* C is in segment number 1. The call will return */ -/* C the number of the new, empty record. */ -/* C */ -/* CALL EKAPPR ( HANDLE, 1, RECNO ) */ - -/* C */ -/* C At this point, the new record is empty. A valid EK */ -/* C cannot contain empty records. We fill in the data */ -/* C here. Data items are filled in one column at a time. */ -/* C The order in which the columns are filled in is not */ -/* C important. We use the EKACEx (add column entry) */ -/* C routines to fill in column entries. We'll assume */ -/* C that no entries are null. All entries are scalar, */ -/* C so the entry size is 1. */ -/* C */ -/* ISNULL = .FALSE. */ -/* ESIZE = 1 */ - -/* C */ -/* C The following variables will contain the data for */ -/* C the new record. */ -/* C */ -/* ORDID = 10011 */ -/* CUSTID = 531 */ -/* LNAME = 'Scientist' */ -/* FNAME = 'Joe' */ -/* ODATE = '1995-SEP-20' */ -/* COST = 0.D0 */ - -/* C */ -/* C Note that the names of the routines called */ -/* C correspond to the data types of the columns: the */ -/* C last letter of the routine name is C, I, or D, */ -/* C depending on the data type. Time values are */ -/* C converted to ET for storage. */ -/* C */ -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */ -/* . SIZE, ORDID, ISNULL ) */ - -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */ -/* . SIZE, CUSTID, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */ -/* . SIZE, LNAME, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */ -/* . SIZE, FNAME, ISNULL ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */ -/* . SIZE, ET, ISNULL ) */ - -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */ -/* . SIZE, COST, ISNULL ) */ - -/* C */ -/* C Close the file to make the update permanent. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* add double precision data to EK column */ -/* add data to EK */ -/* write double precision data to EK column */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of double precision or `time' type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - chkin_("EKACED", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKACED only works with d.p. or time " - "columns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)98); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKACED", (ftnlen)6); - return 0; - } - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - -/* Now it's time to add data to the file. */ - - class__ = coldsc[0]; - if (class__ == 2) { - -/* Class 2 columns contain scalar d.p. data. */ - - zzekad02_(handle, segdsc, coldsc, &recptr, dvals, isnull); - } else if (class__ == 5) { - -/* Class 5 columns contain array-valued d.p. data. */ - - zzekad05_(handle, segdsc, coldsc, &recptr, nvals, dvals, isnull); - } else { - -/* This is an unsupported d.p. column class. */ - - *segno = segdsc[1]; - chkin_("EKACED", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported d.p" - ". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen) - 110); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKACED", (ftnlen)6); - return 0; - } - return 0; -} /* ekaced_ */ - diff --git a/ext/spice/src/cspice/ekaced_c.c b/ext/spice/src/cspice/ekaced_c.c deleted file mode 100644 index 309430d271..0000000000 --- a/ext/spice/src/cspice/ekaced_c.c +++ /dev/null @@ -1,392 +0,0 @@ -/* - --Procedure ekaced_c ( EK, add d.p. data to column ) - --Abstract - - Add data to an double precision column in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekaced_c - - - void ekaced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Index of segment containing record. - recno I Record to which data is to be added. - column I Column name. - nvals I Number of values to add to column. - dvals I Double precision values to add to column. - isnull I Flag indicating whether column entry is null. - --Detailed_Input - - handle is the handle of an EK file open for write access. - - segno is the number of the segment to which the record - is to be added. EK segment numbers range from - zero to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record to which data is to be - added. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column to which data is to be - added. - nvals, - dvals are, respectively, the number of values to add to - the specified column and the set of values - themselves. The data values are written into the - specified column and record. - - If the column has fixed-size entries, then nvals - must equal the entry size for the specified column. - - - isnull is a logical flag indicating whether the entry is - null. If isnull is SPICEFALSE, the column entry - defined by nvals and dvals is added to the - specified kernel file. - - If isnull is SPICETRUE, nvals and cvals are ignored: - no data are written into the specified column entry. - The column entry is marked as a null value. - - If the column has fixed-length, variable-size - entries, the number of entries is considered to - be 1. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will be diagnosed by - routines called by this routine. - - 3) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 4) If column specifies a column of whose data type is not - double precision, the error SPICE(WRONGDATATYPE) will be - signaled. - - 5) If recno is out of range, the error will be diagnosed by - routines called by this routine. - - 6) If the specified column has fixed-size entries and nvals - does not match this size, the error will be diagnosed by - routines called by this routine. - - 7) If the specified column has variable-size entries and nvals - is non-positive, the error will be diagnosed by routines - called by this routine. - - 8) If an attempt is made to add a null value to a column that - doesn't take null values, the error will be diagnosed by - routines called by this routine. - - 9) If column specifies a column of whose class is not - a double precision class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 11) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If the input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified record in the specified - column. Data may be added to a segment in random order; it is not - necessary to fill in columns or rows sequentially. Data may only - be added one column entry at a time. - --Examples - - 1) Add the value 999. to the third record of the column DCOL in - the fifth segment of an EK file designated by handle. - - ekaced_c ( handle, 4, 2, "DCOL", 1, 999., SPICEFALSE ); - - - 2) Same as (1), but this time add a null value. The argument - 999. is ignored because the null flag is set to SPICETRUE. - - ekaced_c ( handle, 4, 2, "DCOL", 1, 999., SPICETRUE ); - - - 3) Add an array dbuff of 10 values to the third record of the - column darray in the fifth segment of an EK file designated by - handle. - - ekaced_c ( handle, 4, 2, "DARRAY", 10, dbuff, SPICEFALSE ); - - - 4) A more detailed example: append a record to a specified - segment. - - Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file order_db.ek contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - If we wanted to insert a new record into the DATAORDERS - table in position 0, we'd make the following calls: - - - #include "SpiceUsr.h" - . - . - . - /. - Open the database for write access. This call is - made when the file already exists. See ekopn_c for - an example of creating a new file. - ./ - ekopw_c ( "order_db.ek", &handle ); - - /. - Append a new, empty record to the DATAORDERS - table. Recall that the DATAORDERS table - is in segment number 0. The call will return - the number of the new, empty record. - ./ - ekappr_c ( handle, 0, &recno ); - - /. - At this point, the new record is empty. A valid EK - cannot contain empty records. We fill in the data - here. Data items are filled in one column at a time. - The order in which the columns are filled in is not - important. We use the ekace*_c (add column entry) - routines to fill in column entries. We'll assume - that no entries are null. All entries are scalar, - so the entry size is 1. - ./ - isnull = SPICEFALSE; - size = 1; - - /. - The following variables will contain the data for - the new record. - ./ - ordid = 10011; - custid = 531; - lname = "scientist"; - fname = "joe"; - odate = "1995-sep-20"; - cost = 5000.; - - /. - Note that the names of the routines called - correspond to the data types of the columns: the - last letter of the routine name is C, I, or D, - depending on the data type. Time values are - converted to ET for storage. - ./ - - ekacei_c ( handle, segno, recno, "order_id", - size, ordid, isnull ); - - ekacei_c ( handle, segno, recno, "customer_id", - size, custid, isnull ); - - ekacec_c ( handle, segno, recno, "last_name", - size, vallen, lname, isnull ); - - ekacec_c ( handle, segno, recno, "first_name", - size, vallen, fname, isnull ); - - utc2et_c ( odate, &et ); - - - ekaced_c ( handle, segno, recno, "order_date", - size, et, isnull ); - - ekaced_c ( handle, segno, recno, "cost", - size, cost, isnull ); - - - /. - Close the file to make the update permanent. - ./ - ekcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - add double precision data to EK column - add data to EK - write double precision data to EK column - --& -*/ - -{ /* Begin ekaced_c */ - - - /* - Local variables - */ - logical null; - - /* - Participate in error tracing. - */ - chkin_c ( "ekaced_c" ); - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekaced_c", column ); - - /* - Convert the null flag to type logical before passing it to - ekaced_. Also map the segment and record numbers to their - Fortran-style counterparts. - */ - - null = isnull; - - segno++; - recno++; - - ekaced_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) &nvals, - ( doublereal * ) dvals, - ( logical * ) &null, - ( ftnlen ) strlen(column) ); - - - chkout_c ( "ekaced_c" ); - -} /* End ekaced_c */ - - - - diff --git a/ext/spice/src/cspice/ekacei.c b/ext/spice/src/cspice/ekacei.c deleted file mode 100644 index 6bc8127a9d..0000000000 --- a/ext/spice/src/cspice/ekacei.c +++ /dev/null @@ -1,688 +0,0 @@ -/* ekacei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKACEI ( EK, add integer data to column ) */ -/* Subroutine */ int ekacei_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen - column_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - zzektrdp_(integer *, integer *, integer *, integer *), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekad01_(integer *, - integer *, integer *, integer *, integer *, logical *), zzekad04_( - integer *, integer *, integer *, integer *, integer *, integer *, - logical *); - -/* $ Abstract */ - -/* Add data to an integer column in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record to which data is to be added. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values to add to column. */ -/* IVALS I Integer values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ - -/* SEGNO is the index of the segment to which data is to */ -/* be added. */ - -/* RECNO is the index of the record to which data is to be */ -/* added. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column to which data is to be */ -/* added. */ - -/* NVALS, */ -/* IVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written into the */ -/* specified column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* Only one value can be added to a virtual column. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and IVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and IVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 3) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 4) If COLUMN specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 5) If RECNO is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 6) If the specified column has fixed-size entries and NVALS */ -/* does not match this size, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 7) If the specified column has variable-size entries and NVALS */ -/* is non-positive, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 8) If an attempt is made to add a null value to a column that */ -/* doesn't take null values, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 9) If COLUMN specifies a column of whose class is not */ -/* an character class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified record in the specified */ -/* column. Data may be added to a segment in random order; it is not */ -/* necessary to fill in columns or rows sequentially. Data may only */ -/* be added one column entry at a time. */ - -/* $ Examples */ - -/* 1) Add the value 999 to the third record of the column ICOL in */ -/* the fifth segment of an EK file designated by HANDLE. */ - -/* CALL EKACEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .FALSE. ) */ - - -/* 2) Same as (1), but this time add a null value. The argument */ -/* 999 is ignored because the null flag is set to .TRUE. */ - -/* CALL EKACEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .TRUE. ) */ - - -/* 3) Add an array IBUFF of 10 values to the third record of the */ -/* column IARRAY in the fifth segment of an EK file designated by */ -/* HANDLE. */ - -/* CALL EKACEI ( HANDLE, 5, 3, 'IARRAY', 10, IBUFF, .FALSE. ) */ - - -/* 4) A more detailed example. */ - -/* Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* If we wanted to insert a new record into the DATAORDERS */ -/* table in position 1, we'd make the following calls: */ - -/* C */ -/* C Open the database for write access. This call is */ -/* C made when the file already exists. See EKOPN for */ -/* C an example of creating a new file. */ -/* C */ -/* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */ - -/* C */ -/* C Append a new, empty record to the DATAORDERS */ -/* C table. Recall that the DATAORDERS table */ -/* C is in segment number 1. The call will return */ -/* C the number of the new, empty record. */ -/* C */ -/* CALL EKAPPR ( HANDLE, 1, RECNO ) */ - -/* C */ -/* C At this point, the new record is empty. A valid EK */ -/* C cannot contain empty records. We fill in the data */ -/* C here. Data items are filled in one column at a time. */ -/* C The order in which the columns are filled in is not */ -/* C important. We use the EKACEx (add column entry) */ -/* C routines to fill in column entries. We'll assume */ -/* C that no entries are null. All entries are scalar, */ -/* C so the entry size is 1. */ -/* C */ -/* ISNULL = .FALSE. */ -/* ESIZE = 1 */ - -/* C */ -/* C The following variables will contain the data for */ -/* C the new record. */ -/* C */ -/* ORDID = 10011 */ -/* CUSTID = 531 */ -/* LNAME = 'Scientist' */ -/* FNAME = 'Joe' */ -/* ODATE = '1995-SEP-20' */ -/* COST = 0.D0 */ - -/* C */ -/* C Note that the names of the routines called */ -/* C correspond to the data types of the columns: the */ -/* C last letter of the routine name is C, I, or D, */ -/* C depending on the data type. Time values are */ -/* C converted to ET for storage. */ -/* C */ -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */ -/* . SIZE, ORDID, ISNULL ) */ - -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */ -/* . SIZE, CUSTID, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */ -/* . SIZE, LNAME, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */ -/* . SIZE, FNAME, ISNULL ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */ -/* . SIZE, ET, ISNULL ) */ - -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */ -/* . SIZE, COST, ISNULL ) */ - -/* C */ -/* C Close the file to make the update permanent. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* add integer data to EK column */ -/* add data to EK */ -/* write integer data to EK column */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of integer type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - chkin_("EKACEI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKACEI only works with integer colum" - "ns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)93); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKACEI", (ftnlen)6); - return 0; - } - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - - -/* Now it's time to add data to the file. */ - - class__ = coldsc[0]; - if (class__ == 1) { - -/* Class 1 columns contain scalar integer data. */ - - zzekad01_(handle, segdsc, coldsc, &recptr, ivals, isnull); - } else if (class__ == 4) { - -/* Class 4 columns contain array-valued integer data. */ - - zzekad04_(handle, segdsc, coldsc, &recptr, nvals, ivals, isnull); - } else { - -/* This is an unsupported integer column class. */ - - *segno = segdsc[1]; - chkin_("EKACEI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported int" - "eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)113); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKACEI", (ftnlen)6); - return 0; - } - return 0; -} /* ekacei_ */ - diff --git a/ext/spice/src/cspice/ekacei_c.c b/ext/spice/src/cspice/ekacei_c.c deleted file mode 100644 index 04070d9fac..0000000000 --- a/ext/spice/src/cspice/ekacei_c.c +++ /dev/null @@ -1,389 +0,0 @@ -/* - --Procedure ekacei_c ( EK, add integer data to column ) - --Abstract - - Add data to an integer column in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekacei_c - - - void ekacei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Index of segment containing record. - recno I Record to which data is to be added. - column I Column name. - nvals I Number of values to add to column. - ivals I Integer values to add to column. - isnull I Flag indicating whether column entry is null. - --Detailed_Input - - handle is the handle of an EK file open for write access. - - segno is the number of the segment to which the record - is to be added. EK segment numbers range from - 0 to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record to which data is to be - added. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column to which data is to be - added. - - nvals, - ivals are, respectively, the number of values to add to - the specified column and the set of values - themselves. The data values are written into the - specified column and record. - - If the column has fixed-size entries, then NVALS - must equal the entry size for the specified column. - - - isnull is a logical flag indicating whether the entry is - null. If isnull is SPICEFALSE, the column entry - defined by nvals and ivals is added to the - specified kernel file. - - If isnull is SPICETRUE, nvals and cvals are ignored: - no data are written into the specified column entry. - The column entry is marked as a null value. - - If the column has fixed-length, variable-size - entries, the number of entries is considered to - be 1. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will be diagnosed by - routines called by this routine. - - 3) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 4) If column specifies a column of whose data type is not - integer, the error SPICE(WRONGDATATYPE) will be - signaled. - - 5) If recno is out of range, the error will be diagnosed by - routines called by this routine. - - 6) If the specified column has fixed-size entries and nvals - does not match this size, the error will be diagnosed by - routines called by this routine. - - 7) If the specified column has variable-size entries and nvals - is non-positive, the error will be diagnosed by routines - called by this routine. - - 8) If an attempt is made to add a null value to a column that - doesn't take null values, the error will be diagnosed by - routines called by this routine. - - 9) If column specifies a column of whose class is not - an integer class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 11) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If the input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified record in the specified - column. Data may be added to a segment in random order; it is not - necessary to fill in columns or rows sequentially. Data may only - be added one column entry at a time. - --Examples - - 1) Add the value 999 to the third record of the column ICOL in - the fifth segment of an EK file designated by handle. - - ekacei_c ( handle, 4, 2, "ICOL", 1, 999, SPICEFALSE ); - - - 2) Same as (1), but this time add a null value. The argument - 999 is ignored because the null flag is set to SPICETRUE. - - ekacei_c ( handle, 4, 2, "ICOL", 1, 999, SPICETRUE ) - - - 3) Add an array IBUFF of 10 values to the third record of the - column IARRAY in the fifth segment of an EK file designated by - HANDLE. - - ekacei_c ( handle, 4, 2, "IARRAY", 10, ibuff, SPICEFALSE ); - - - 4) A more detailed example: append a record to a specified - segment. - - Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file order_db.ek contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - If we wanted to insert a new record into the DATAORDERS - table in position 0, we'd make the following calls: - - - #include "SpiceUsr.h" - . - . - . - /. - Open the database for write access. This call is - made when the file already exists. See ekopn_c for - an example of creating a new file. - ./ - ekopw_c ( "order_db.ek", &handle ); - - /. - Append a new, empty record to the DATAORDERS - table. Recall that the DATAORDERS table - is in segment number 0. The call will return - the number of the new, empty record. - ./ - ekappr_c ( handle, 0, &recno ); - - /. - At this point, the new record is empty. A valid EK - cannot contain empty records. We fill in the data - here. Data items are filled in one column at a time. - The order in which the columns are filled in is not - important. We use the ekace*_c (add column entry) - routines to fill in column entries. We'll assume - that no entries are null. All entries are scalar, - so the entry size is 1. - ./ - isnull = SPICEFALSE; - size = 1; - - /. - The following variables will contain the data for - the new record. - ./ - ordid = 10011; - custid = 531; - lname = "scientist"; - fname = "joe"; - odate = "1995-sep-20"; - cost = 5000.; - - /. - Note that the names of the routines called - correspond to the data types of the columns: the - last letter of the routine name is C, I, or D, - depending on the data type. Time values are - converted to ET for storage. - ./ - ekacei_c ( handle, segno, recno, "order_id", - size, ordid, isnull ); - - ekacei_c ( handle, segno, recno, "customer_id", - size, custid, isnull ); - - ekacec_c ( handle, segno, recno, "last_name", - size, vallen, lname, isnull ); - - ekacec_c ( handle, segno, recno, "first_name", - size, vallen, fname, isnull ); - - utc2et_c ( odate, &et ); - - - ekaced_c ( handle, segno, recno, "order_date", - size, et, isnull ); - - ekaced_c ( handle, segno, recno, "cost", - size, cost, isnull ); - - /. - Close the file to make the update permanent. - ./ - ekcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - add integer data to EK column - add data to EK - write integer data to EK column - --& -*/ - -{ /* Begin ekacei_c */ - - - /* - Local variables - */ - logical null; - - /* - Participate in error tracing. - */ - chkin_c ( "ekacei_c" ); - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekacei_c", column ); - - /* - Convert the null flag to type logical before passing it to - ekacei_. Also map the segment and record numbers to their - Fortran-style counterparts. - */ - - null = isnull; - - segno++; - recno++; - - ekacei_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) &nvals, - ( integer * ) ivals, - ( logical * ) &null, - ( ftnlen ) strlen(column) ); - - - chkout_c ( "ekacei_c" ); - -} /* End ekacei_c */ - - diff --git a/ext/spice/src/cspice/ekaclc.c b/ext/spice/src/cspice/ekaclc.c deleted file mode 100644 index 5f2bcb201a..0000000000 --- a/ext/spice/src/cspice/ekaclc.c +++ /dev/null @@ -1,730 +0,0 @@ -/* ekaclc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKACLC ( EK, add character column to segment ) */ -/* Subroutine */ int ekaclc_(integer *handle, integer *segno, char *column, - char *cvals, integer *entszs, logical *nlflgs, integer *rcptrs, - integer *wkindx, ftnlen column_len, ftnlen cvals_len) -{ - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekac03_(integer *, integer *, integer *, char *, - logical *, integer *, integer *, ftnlen), zzekac06_(integer *, - integer *, integer *, char *, integer *, logical *, ftnlen), - zzekac09_(integer *, integer *, integer *, char *, logical *, - integer *, ftnlen); - -/* $ Abstract */ - -/* Add an entire character column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Number of segment to add column to. */ -/* COLUMN I Column name. */ -/* CVALS I Character values to add to column. */ -/* ENTSZS I Array of sizes of column entries. */ -/* NLFLGS I Array of null flags for column entries. */ -/* RCPTRS I Record pointers for segment. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A "begin segment for fast write" operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGNO is the number of the segment to which */ -/* data is to be added. */ - -/* COLUMN is the name of the column to be added. All of */ -/* the data for the named column will be added in */ -/* one shot. */ - -/* CVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. For columns having */ -/* fixed-size entries, a null entry must be allocated */ -/* the same amount of space occupied by a non-null */ -/* entry in the array CVALS. For columns having */ -/* variable-size entries, null entries do not require */ -/* any space in the CVALS array, but in any case must */ -/* have their allocated space described correctly by */ -/* the corresponding element of the ENTSZS array */ -/* (described below). */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by CVALS and ENTSZS is added to the */ -/* current segment in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array is obtained as an output */ -/* from EKIFLD, the routine called to initiate a */ -/* fast write. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If COLUMN is not the name of a declared column, the error will */ -/* be diagnosed by routines called by this routine. */ - -/* 3) If COLUMN specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be signalled. */ - -/* 4) If the specified column already contains ANY entries, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEC, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* 1) Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* Below, we show how we'd open a new EK file and create the */ -/* first of the segments described above. */ - - -/* C */ -/* C Open a new EK file. For simplicity, we will not */ -/* C reserve any space for the comment area, so the */ -/* C number of reserved comment characters is zero. */ -/* C The variable IFNAME is the internal file name. */ -/* C */ -/* NRESVC = 0 */ -/* IFNAME = 'Test EK/Created 20-SEP-1995' */ - -/* CALL EKOPN ( 'ORDER_DB.EK', IFNAME, NRESVC, HANDLE ) */ - -/* C */ -/* C Set up the table and column names and declarations */ -/* C for the DATAORDERS segment. We'll index all of */ -/* C the columns. All columns are scalar, so we omit */ -/* C the size declaration. Only the COST column may take */ -/* C null values. */ -/* C */ -/* TABLE = 'DATAORDERS' */ -/* NCOLS = 6 */ - -/* CNAMES(1) = 'ORDER_ID' */ -/* CDECLS(1) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(2) = 'CUSTOMER_ID' */ -/* CDECLS(2) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(3) = 'LAST_NAME' */ -/* CDECLS(3) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(4) = 'FIRST_NAME' */ -/* CDECLS(4) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(5) = 'ORDER_DATE' */ -/* CDECLS(5) = 'DATATYPE = TIME, INDEXED = TRUE' */ - -/* CNAMES(6) = 'COST' */ -/* CDECLS(6) = 'DATATYPE = DOUBLE PRECISION,' // */ -/* . 'INDEXED = TRUE' // */ -/* . 'NULLS_OK = TRUE' */ - -/* C */ -/* C Start the segment. We presume the number of rows */ -/* C of data is known in advance. */ -/* C */ -/* CALL EKIFLD ( HANDLE, TABNAM, NCOLS, NROWS, */ -/* . CNAMES, CDECLS, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, arrays containing data for the */ -/* C segment's columns may be filled in. The names */ -/* C of the data arrays are shown below. */ -/* C */ -/* C Column Data array */ -/* C */ -/* C 'ORDER_ID' ORDIDS */ -/* C 'CUSTOMER_ID' CSTIDS */ -/* C 'LAST_NAME' LNAMES */ -/* C 'FIRST_NAME' FNAMES */ -/* C 'ORDER_DATE' ONAMES */ -/* C 'COST' COSTS */ -/* C */ - -/* [ Fill in data arrays here.] */ - -/* C */ -/* C The SIZES array shown below is ignored for scalar */ -/* C and fixed-size array columns, so we need not */ -/* C initialize it. For variable-size arrays, the */ -/* C Ith element of the SIZES array must contain the size */ -/* C of the Ith column entry in the column being loaded. */ -/* C Normally, the SIZES array would be reset for each */ -/* C variable-size column. */ -/* C */ -/* C The NLFLGS array indicates which entries are null. */ -/* C It is ignored for columns that don't allow null */ -/* C values. In this case, only the COST column allows */ -/* C nulls. */ -/* C */ -/* C Add the columns of data to the segment. All of the */ -/* C data for each column is loaded in one shot. */ -/* C */ -/* CALL EKACLI ( HANDLE, SEGNO, 'ORDER_ID', */ -/* . ORDIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLI ( HANDLE, SEGNO, 'CUSTOMER_ID', */ -/* . CSTIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'LAST_NAME', */ -/* . LNAMES, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'FIRST_NAME', */ -/* . FNAMES, SIZES, NLFLGS, WKINDX ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACLD ( HANDLE, SEGNO, 'ORDER_DATE', */ -/* . ODATES, SIZES, NLFLGS, WKINDX ) */ - - -/* [Set the NLFLGS array here.] */ - -/* CALL EKACLD ( HANDLE, SEGNO, 'COST', */ -/* . COSTS, SIZES, NLFLGS, WKINDX ) */ - -/* C */ -/* C Complete the segment. The RCPTRS array is that */ -/* C returned by EKIFLD. */ -/* C */ -/* CALL EKFFLD ( HANDLE, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, the second segment could be */ -/* C created by an analogous process. In fact, the */ -/* C second segment could be created at any time; it is */ -/* C not necessary to populate the first segment with */ -/* C data before starting the second segment. */ -/* C */ - -/* C */ -/* C The file must be closed by a call to EKCLS. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) Only one segment can be created at a time using the fast */ -/* writer routines. */ - -/* 2) No other EK operation may interrupt a fast write. For */ -/* example, it is not valid to issue a query while a fast write */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write entire character column to EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKACLC", (ftnlen)6); - } - -/* Find the descriptors for the specified segment and column. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - chkout_("EKACLC", (ftnlen)6); - return 0; - } - -/* This column had better be of character type. */ - - class__ = coldsc[0]; - dtype = coldsc[1]; - if (dtype != 1) { - setmsg_("Column # is of type #; EKACLC only works with character col" - "umns.", (ftnlen)64); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKACLC", (ftnlen)6); - return 0; - } - -/* Hand off the task to the routine of the appropriate class. */ - - if (class__ == 3) { - -/* Class 3 columns contain character scalars. */ - - zzekac03_(handle, segdsc, coldsc, cvals, nlflgs, rcptrs, wkindx, - cvals_len); - } else if (class__ == 6) { - -/* Class 6 columns contain character arrays. */ - - zzekac06_(handle, segdsc, coldsc, cvals, entszs, nlflgs, cvals_len); - } else if (class__ == 9) { - -/* Class 9 columns contain fixed-count, fixed-length character */ -/* scalars. */ - - zzekac09_(handle, segdsc, coldsc, cvals, nlflgs, wkindx, cvals_len); - } else { - -/* This is an unsupported column class. */ - - setmsg_("Unsupported column class code # found in descriptor for col" - "umn #.", (ftnlen)65); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("EKACLC", (ftnlen)6); - return 0; - } - chkout_("EKACLC", (ftnlen)6); - return 0; -} /* ekaclc_ */ - diff --git a/ext/spice/src/cspice/ekaclc_c.c b/ext/spice/src/cspice/ekaclc_c.c deleted file mode 100644 index 8a0e54781c..0000000000 --- a/ext/spice/src/cspice/ekaclc_c.c +++ /dev/null @@ -1,696 +0,0 @@ -/* - --Procedure ekaclc_c ( EK, add character column to segment ) - --Abstract - - Add an entire character column to an EK segment. - --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 - - EK - --Keywords - - EK - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekaclc_c - - - void ekaclc_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - SpiceInt vallen, - const void * cvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Number of segment to add column to. - column I Column name. - vallen I Length of character values. - cvals I Character values to add to column. - entszs I Array of sizes of column entries. - nlflgs I Array of null flags for column entries. - rcptrs I Record pointers for segment. - wkindx I-O Work space for column index. - --Detailed_Input - - handle the handle of an EK file that is open for writing. - A "begin segment for fast write" operation must - have already been performed for the designated - segment. - - segno is the number of the segment to which data is to be - added. Segments are numbered from 0 to nseg-1, where - nseg is the count of segments in the file. - - column is the name of the column to be added. All of - the data for the named column will be added in - one shot. - - vallen is the length of the strings in the cvals array. - The array should be declared with dimensions - - [nrows][vallen] - - where nrows is the number of rows in the column. - - cvals is an array containing the entire set of column - entries for the specified column. The entries - are listed in row-order: the column entry for the - first row of the segment is first, followed by the - column entry for the second row, and so on. The - number of column entries must match the declared - number of rows in the segment. For columns having - fixed-size entries, a null entry must be allocated - the same amount of space occupied by a non-null - entry in the array cvals. For columns having - variable-size entries, null entries do not require - any space in the cvals* array, but in any case must - have their allocated space described correctly by - the corresponding element of the entszs array - (described below). - - entszs is an array containing sizes of column entries. - The Ith element of entszs gives the size of the - Ith column entry. entszs is used only for columns - having variable-size entries. For such columns, - the dimension of entszs must be at least nrows. - The size of null entries should be set to zero. - - For columns having fixed-size entries, the - dimension of this array may be any positive value. - - nlflgs is an array of logical flags indicating whether - the corresponding entries are null. If the Ith - element of nlflgs is SPICEFALSE, the Ith column entry - defined by cvals and entszs is added to the - current segment in the specified kernel file. - - If the Ith element of nlfgls is SPICETRUE, the - contents of the Ith column entry are undefined. - - nlflgs is used only for columns that allow null - values; it's ignored for other columns. - - rcptrs is an array of record pointers for the input - segment. This array is obtained as an output - from ekifld_c, the routine called to initiate a - fast write. - - wkindx is a work space array used for building a column - index. If the column is indexed, the dimension of - wkindx_c must be at nrows, where nrows is the number - of rows in the column. If the column is not - indexed, this work space is not used, so the - dimension may be any positive value. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If column is not the name of a declared column, the error - SPICE(NOCOLUMN) will be signaled. - - 3) If column specifies a column of whose data type is not - character, the error SPICE(WRONGDATATYPE) will be - signalled. - - 4) If the specified column already contains ANY entries, the - error will be diagnosed by routines called by this routine. - - 5) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 6) If the string pointer for column is null, the error - SPICE(NULLPOINTER) will be signaled. - - 7) If the input string column has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 8) If the string pointer for cvals is null, the error - SPICE(NULLPOINTER) will be signaled. - - 9) If the string length vallen is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified column. This routine - writes the entire contents of the specified column in one shot. - This routine creates columns much more efficiently than can be - done by sequential calls to ekacec_c, but has the drawback that - the caller must use more memory for the routine's inputs. This - routine cannot be used to add data to a partially completed - column. - --Examples - - 1) Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file ORDER_DB.EK contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - Below, we show how we'd open a new EK file and create the - first of the segments described above. - - #include "SpiceUsr.h" - #include - - - void main() - { - /. - Constants - ./ - #define CNMLEN ( CSPICE_EK_COL_NAM_LEN + 1 ) - #define DECLEN 201 - #define EKNAME "order_db.ek" - #define FNMLEN 50 - #define IFNAME "Test EK/Created 20-SEP-1995" - #define LNMLEN 50 - #define LSK "leapseconds.ker" - #define NCOLS 6 - #define NRESVC 0 - #define NROWS 9 - #define TABLE "DATAORDERS" - #define TNMLEN CSPICE_EK_TAB_NAM_LEN - #define UTCLEN 30 - - - /. - Local variables - ./ - SpiceBoolean nlflgs [ NROWS ]; - - SpiceChar cdecls [ NCOLS ] [ DECLEN ]; - SpiceChar cnames [ NCOLS ] [ CNMLEN ]; - SpiceChar fnames [ NROWS ] [ FNMLEN ]; - SpiceChar lnames [ NROWS ] [ LNMLEN ]; - SpiceChar dateStr [ UTCLEN ]; - - SpiceDouble costs [ NROWS ]; - SpiceDouble ets [ NROWS ]; - - SpiceInt cstids [ NROWS ]; - SpiceInt ordids [ NROWS ]; - SpiceInt handle; - SpiceInt i; - SpiceInt rcptrs [ NROWS ]; - SpiceInt segno; - SpiceInt sizes [ NROWS ]; - SpiceInt wkindx [ NROWS ]; - - - /. - Load a leapseconds kernel for UTC/ET conversion. - ./ - furnsh_c ( LSK ); - - /. - Open a new EK file. For simplicity, we will not - reserve any space for the comment area, so the - number of reserved comment characters is zero. - The constant IFNAME is the internal file name. - ./ - ekopn_c ( EKNAME, IFNAME, NRESVC, &handle ); - - /. - Set up the table and column names and declarations - for the DATAORDERS segment. We'll index all of - the columns. All columns are scalar, so we omit - the size declaration. Only the COST column may take - null values. - ./ - strcpy ( cnames[0], "ORDER_ID" ); - strcpy ( cdecls[0], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[1], "CUSTOMER_ID" ); - strcpy ( cdecls[1], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[2], "LAST_NAME" ); - strcpy ( cdecls[2], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[3], "FIRST_NAME" ); - strcpy ( cdecls[3], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[4], "ORDER_DATE" ); - strcpy ( cdecls[4], "DATATYPE = TIME, INDEXED = TRUE" ); - - strcpy ( cnames[5], "COST" ); - strcpy ( cdecls[5], "DATATYPE = DOUBLE PRECISION," - "INDEXED = TRUE," - "NULLS_OK = TRUE" ); - - /. - Start the segment. We presume the number of rows - of data is known in advance. - ./ - ekifld_c ( handle, TABLE, NCOLS, NROWS, CNMLEN, - cnames, DECLEN, cdecls, &segno, rcptrs ); - - /. - At this point, arrays containing data for the - segment's columns may be filled in. The names - of the data arrays are shown below. - - Column Data array - - "ORDER_ID" ordids - "CUSTOMER_ID" cstids - "LAST_NAME" lnames - "FIRST_NAME" fnames - "ORDER_DATE" odates - "COST" costs - - - The null flags array indicates which entries are null. - It is ignored for columns that don't allow null - values. In this case, only the COST column allows - nulls. - - Fill in data arrays and null flag arrays here. This code - section would normally be replaced by calls to user functions - returning column values. - ./ - - for ( i = 0; i < NROWS; i++ ) - { - ordids[i] = i; - cstids[i] = i*100; - costs [i] = (SpiceDouble) 100*i; - - sprintf ( fnames[i], "Order %d Customer first name", i ); - sprintf ( lnames[i], "Order %d Customer last name", i ); - sprintf ( dateStr, "1998 Mar %d", i ); - - utc2et_c ( dateStr, ets+i ); - - nlflgs[i] = SPICEFALSE; - } - - nlflgs[1] = SPICETRUE; - - - /. - The sizes array shown below is ignored for scalar - and fixed-size array columns, so we need not - initialize it. For variable-size arrays, the - Ith element of the sizes array must contain the size - of the Ith column entry in the column being written. - Normally, the sizes array would be reset for each - variable-size column. - - Add the columns of data to the segment. All of the - data for each column is written in one shot. - ./ - ekacli_c ( handle, segno, "order_id", ordids, - sizes, nlflgs, rcptrs, wkindx ); - - ekacli_c ( handle, segno, "customer_id", cstids, - sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "last_name", LNMLEN, - lnames, sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "first_name", FNMLEN, - fnames, sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "order_date", ets, - sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "cost", costs, - sizes, nlflgs, rcptrs, wkindx ); - - /. - Complete the segment. The rcptrs array is that - returned by ekifld_c. - ./ - ekffld_c ( handle, segno, rcptrs ); - - /. - At this point, the second segment could be - created by an analogous process. In fact, the - second segment could be created at any time; it is - not necessary to populate the first segment with - data before starting the second segment. - - The file must be closed by a call to ekcls_c. - ./ - ekcls_c ( handle ); - } - - --Restrictions - - 1) Only one segment can be created at a time using the fast - write routines. - - 2) No other EK operation may interrupt a fast write. For - example, it is not valid to issue a query while a fast write - is in progress. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.2, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.2.1, 09-JAN-2002 (NJB) - - Documentation change: instances of the phrase "fast load" - were replaced with "fast write." - - Const-qualified input array cvals. - - -CSPICE Version 1.1.0, 12-JUL-1998 (NJB) - - Bug fix: now counts elements rather than rows for vector-valued - columns. - - Bug fix: now uses dynamically allocated array of type logical - to interface with underlying f2c'd function ekaclc_. - - Now maps segno from C to Fortran range. - - Added "undef" of masking macro. Changed input pointer types - to pointers to const objects. - - Replaced eksdsc_ call with ekssum_c call. This removes unsightly - references to segment descriptor alignments. - - Fixed some chkout_c calls which referenced ekifld_c. - - -CSPICE Version 1.0.0, 25-FEB-1999 (NJB) - - Based on SPICELIB Version 1.0.0, 08-NOV-1995 (NJB) - --Index_Entries - - write entire character column to EK segment - --& -*/ - -{ /* Begin ekaclc_c */ - - - /* - Local variables - */ - SpiceBoolean fnd; - - logical * logicalFlags; - - SpiceEKSegSum summary; - - SpiceChar ** cvalsPtr; - SpiceChar * fCvalsArr; - - SpiceInt i; - SpiceInt fCvalsLen; - SpiceInt fSegno; - SpiceInt ncols; - SpiceInt nelts; - SpiceInt nrows; - SpiceInt size; - - - - /* - Participate in error tracing. - */ - chkin_c ( "ekaclc_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekaclc_c", column ); - - - /* - Check the value array to make sure the pointer is non-null - and the string length is non-zero. Note: this check is normally - done for output strings: CHKOSTR is the macro that does the job. - */ - CHKOSTR ( CHK_STANDARD, "ekaclc_c", cvals, vallen ); - - - /* - Get the row count for this segment. - */ - ekssum_c ( handle, segno, &summary ); - - nrows = summary.nrows; - - - /* - Locate the index of this column in the segment descriptor. - */ - ncols = summary.ncols; - i = 0; - fnd = SPICEFALSE; - - while ( ( i < ncols ) && ( !fnd ) ) - { - if ( eqstr_c( column, summary.cnames[i] ) ) - { - fnd = SPICETRUE; - } - else - { - i++; - } - } - - - if ( !fnd ) - { - setmsg_c ( "Column <#> does not belong to segment #. " ); - errch_c ( "#", column ); - errint_c ( "#", segno ); - sigerr_c ( "SPICE(NOCOLUMN)" ); - chkout_c ( "ekaclc_c" ); - return; - } - - - /* - Now i is the index within the segment descriptor of the column - descriptor for the column of interest. Get the dimension information - for this column. - */ - size = summary.cdescrs[i].size; - - - /* - Compute the total string count of the input array. If the column - has fixed-size entries, we ignore the entszs array. Otherwise, the - entszs array tells us how many strings we're getting. - */ - - if ( size == SPICE_EK_VARSIZ ) - { - nelts = sumai_c ( entszs, nrows ); - } - else - { - nelts = nrows * size; - } - - - /* - Allocate an array of logicals and assign values from the input - array of SpiceBooleans. - */ - logicalFlags = ( logical * ) malloc ( nelts * sizeof(logical) ); - - if ( !logicalFlags ) - { - setmsg_c ( "Failure on malloc call to create null flag array " - "for column values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "ekaclc_c" ); - return; - } - - - /* - Copy the input null flags to our array of type logical. - */ - for ( i = 0; i < nrows; i++ ) - { - logicalFlags[i] = nlflgs[i]; - } - - - /* - We need to make a blank-padded version of the cvals array. - We'll first allocate an array of character pointers to index - the values, initialize this array, and use it to produce - a dynamically allocated array of Fortran-style strings. - */ - - cvalsPtr = ( SpiceChar ** ) malloc ( nelts * sizeof(SpiceChar *) ); - - if ( cvalsPtr == 0 ) - { - free ( logicalFlags ); - - - setmsg_c ( "Failure on malloc call to create pointer array " - "for column values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "ekaclc_c" ); - return; - } - - for ( i = 0; i < nelts; i++ ) - { - cvalsPtr[i] = (SpiceChar *)cvals + ( i * vallen ); - } - - C2F_CreateFixStrArr ( nelts, - vallen, - ( ConstSpiceChar ** ) cvalsPtr, - &fCvalsLen, - &fCvalsArr ); - - if ( failed_c() ) - { - free ( logicalFlags ); - free ( cvalsPtr ); - - chkout_c ( "ekaclc_c" ); - return; - } - - /* - Map the segment number to the Fortran range. - */ - fSegno = segno + 1; - - - ekaclc_ ( ( integer * ) &handle, - ( integer * ) &fSegno, - ( char * ) column, - ( char * ) fCvalsArr, - ( integer * ) entszs, - ( logical * ) logicalFlags, - ( integer * ) rcptrs, - ( integer * ) wkindx, - ( ftnlen ) strlen(column), - ( ftnlen ) fCvalsLen ); - - - /* - Clean up all of our dynamically allocated arrays. - */ - free ( cvalsPtr ); - free ( fCvalsArr ); - free ( logicalFlags ); - - - chkout_c ( "ekaclc_c" ); - -} /* End ekaclc_c */ diff --git a/ext/spice/src/cspice/ekacld.c b/ext/spice/src/cspice/ekacld.c deleted file mode 100644 index 77a214db1e..0000000000 --- a/ext/spice/src/cspice/ekacld.c +++ /dev/null @@ -1,728 +0,0 @@ -/* ekacld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKACLD ( EK, add d.p. column to segment ) */ -/* Subroutine */ int ekacld_(integer *handle, integer *segno, char *column, - doublereal *dvals, integer *entszs, logical *nlflgs, integer *rcptrs, - integer *wkindx, ftnlen column_len) -{ - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekac02_(integer *, integer *, integer *, doublereal *, - logical *, integer *, integer *), zzekac05_(integer *, integer *, - integer *, doublereal *, integer *, logical *), zzekac08_(integer - *, integer *, integer *, doublereal *, logical *, integer *); - -/* $ Abstract */ - -/* Add an entire double precision column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Number of segment to add column to. */ -/* COLUMN I Column name. */ -/* DVALS I Double precision values to add to column. */ -/* ENTSZS I Array of sizes of column entries. */ -/* NLFLGS I Array of null flags for column entries. */ -/* RCPTRS I Record pointers for segment. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A "begin segment for fast write" operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGNO is the number of the segment to which */ -/* data is to be added. */ - -/* COLUMN is the name of the column to be added. All of */ -/* the data for the named column will be added in */ -/* one shot. */ - -/* DVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. For columns having */ -/* fixed-size entries, a null entry must be allocated */ -/* the same amount of space occupied by a non-null */ -/* entry in the array DVALS. For columns having */ -/* variable-size entries, null entries do not require */ -/* any space in the DVALS array, but in any case must */ -/* have their allocated space described correctly by */ -/* the corresponding element of the ENTSZS array */ -/* (described below). */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by DVALS and ENTSZS is added to the */ -/* current segment in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array is obtained as an output */ -/* from EKIFLD, the routine called to initiate a */ -/* fast write. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If COLUMN is not the name of a declared column, the error will */ -/* be diagnosed by routines called by this routine. */ - -/* 3) If COLUMN specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be signalled. */ - -/* 4) If the specified column already contains ANY entries, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACED, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* 1) Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* Below, we show how we'd open a new EK file and create the */ -/* first of the segments described above. */ - - -/* C */ -/* C Open a new EK file. For simplicity, we will not */ -/* C reserve any space for the comment area, so the */ -/* C number of reserved comment characters is zero. */ -/* C The variable IFNAME is the internal file name. */ -/* C */ -/* NRESVC = 0 */ -/* IFNAME = 'Test EK/Created 20-SEP-1995' */ - -/* CALL EKOPN ( 'ORDER_DB.EK', IFNAME, NRESVC, HANDLE ) */ - -/* C */ -/* C Set up the table and column names and declarations */ -/* C for the DATAORDERS segment. We'll index all of */ -/* C the columns. All columns are scalar, so we omit */ -/* C the size declaration. Only the COST column may take */ -/* C null values. */ -/* C */ -/* TABLE = 'DATAORDERS' */ -/* NCOLS = 6 */ - -/* CNAMES(1) = 'ORDER_ID' */ -/* CDECLS(1) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(2) = 'CUSTOMER_ID' */ -/* CDECLS(2) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(3) = 'LAST_NAME' */ -/* CDECLS(3) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(4) = 'FIRST_NAME' */ -/* CDECLS(4) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(5) = 'ORDER_DATE' */ -/* CDECLS(5) = 'DATATYPE = TIME, INDEXED = TRUE' */ - -/* CNAMES(6) = 'COST' */ -/* CDECLS(6) = 'DATATYPE = DOUBLE PRECISION,' // */ -/* . 'INDEXED = TRUE' // */ -/* . 'NULLS_OK = TRUE' */ - -/* C */ -/* C Start the segment. We presume the number of rows */ -/* C of data is known in advance. */ -/* C */ -/* CALL EKIFLD ( HANDLE, TABNAM, NCOLS, NROWS, */ -/* . CNAMES, CDECLS, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, arrays containing data for the */ -/* C segment's columns may be filled in. The names */ -/* C of the data arrays are shown below. */ -/* C */ -/* C Column Data array */ -/* C */ -/* C 'ORDER_ID' ORDIDS */ -/* C 'CUSTOMER_ID' CSTIDS */ -/* C 'LAST_NAME' LNAMES */ -/* C 'FIRST_NAME' FNAMES */ -/* C 'ORDER_DATE' ONAMES */ -/* C 'COST' COSTS */ -/* C */ - -/* [ Fill in data arrays here.] */ - -/* C */ -/* C The SIZES array shown below is ignored for scalar */ -/* C and fixed-size array columns, so we need not */ -/* C initialize it. For variable-size arrays, the */ -/* C Ith element of the SIZES array must contain the size */ -/* C of the Ith column entry in the column being loaded. */ -/* C Normally, the SIZES array would be reset for each */ -/* C variable-size column. */ -/* C */ -/* C The NLFLGS array indicates which entries are null. */ -/* C It is ignored for columns that don't allow null */ -/* C values. In this case, only the COST column allows */ -/* C nulls. */ -/* C */ -/* C Add the columns of data to the segment. All of the */ -/* C data for each column is loaded in one shot. */ -/* C */ -/* CALL EKACLI ( HANDLE, SEGNO, 'ORDER_ID', */ -/* . ORDIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLI ( HANDLE, SEGNO, 'CUSTOMER_ID', */ -/* . CSTIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'LAST_NAME', */ -/* . LNAMES, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'FIRST_NAME', */ -/* . FNAMES, SIZES, NLFLGS, WKINDX ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACLD ( HANDLE, SEGNO, 'ORDER_DATE', */ -/* . ODATES, SIZES, NLFLGS, WKINDX ) */ - - -/* [Set the NLFLGS array here.] */ - -/* CALL EKACLD ( HANDLE, SEGNO, 'COST', */ -/* . COSTS, SIZES, NLFLGS, WKINDX ) */ - -/* C */ -/* C Complete the segment. The RCPTRS array is that */ -/* C returned by EKIFLD. */ -/* C */ -/* CALL EKFFLD ( HANDLE, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, the second segment could be */ -/* C created by an analogous process. In fact, the */ -/* C second segment could be created at any time; it is */ -/* C not necessary to populate the first segment with */ -/* C data before starting the second segment. */ -/* C */ - -/* C */ -/* C The file must be closed by a call to EKCLS. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) Only one segment can be created at a time using the fast */ -/* write routines. */ - -/* 2) No other EK operation may interrupt a fast write. For */ -/* example, it is not valid to issue a query while a fast write */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write entire d.p. column to EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKACLD", (ftnlen)6); - } - -/* Find the descriptors for the specified segment and column. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - chkout_("EKACLD", (ftnlen)6); - return 0; - } - -/* This column had better be of d.p. type. */ - - class__ = coldsc[0]; - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - setmsg_("Column # is of type #; EKACLD only works with d.p. or TIME " - "columns.", (ftnlen)67); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKACLD", (ftnlen)6); - return 0; - } - -/* Hand off the task to the routine of the appropriate class. */ - - if (class__ == 2) { - -/* Class 2 columns contain d.p. scalars. */ - - zzekac02_(handle, segdsc, coldsc, dvals, nlflgs, rcptrs, wkindx); - } else if (class__ == 5) { - -/* Class 5 columns contain d.p. arrays. */ - - zzekac05_(handle, segdsc, coldsc, dvals, entszs, nlflgs); - } else if (class__ == 8) { - -/* Class 8 columns contain fixed-count d.p. scalars. */ - - zzekac08_(handle, segdsc, coldsc, dvals, nlflgs, wkindx); - } else { - -/* This is an unsupported column class. */ - - setmsg_("Unsupported column class code # found in descriptor for col" - "umn #.", (ftnlen)65); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("EKACLD", (ftnlen)6); - return 0; - } - chkout_("EKACLD", (ftnlen)6); - return 0; -} /* ekacld_ */ - diff --git a/ext/spice/src/cspice/ekacld_c.c b/ext/spice/src/cspice/ekacld_c.c deleted file mode 100644 index 785a7cecf0..0000000000 --- a/ext/spice/src/cspice/ekacld_c.c +++ /dev/null @@ -1,555 +0,0 @@ -/* - --Procedure ekacld_c ( EK, add double precision column to segment ) - --Abstract - - Add an entire double precision column to an EK segment. - --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 - - EK - --Keywords - - EK - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef ekacld_c - - - void ekacld_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceDouble * dvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Number of segment to add column to. - column I Column name. - dvals I Double precision values to add to column. - entszs I Array of sizes of column entries. - nlflgs I Array of null flags for column entries. - rcptrs I Record pointers for segment. - wkindx I-O Work space for column index. - --Detailed_Input - - handle the handle of an EK file that is open for writing. - A "begin segment for fast write" operation must - have already been performed for the designated - segment. - - segno is the number of the segment to which data is to be - added. Segments are numbered from 0 to nseg-1, where - nseg is the count of segments in the file. - - column is the name of the column to be added. All of - the data for the named column will be added in - one shot. - - dvals is an array containing the entire set of column - entries for the specified column. The entries - are listed in row-order: the column entry for the - first row of the segment is first, followed by the - column entry for the second row, and so on. The - number of column entries must match the declared - number of rows in the segment. For columns having - fixed-size entries, a null entry must be allocated - the same amount of space occupied by a non-null - entry in the array dvals. For columns having - variable-size entries, null entries do not require - any space in the dvals* array, but in any case must - have their allocated space described correctly by - the corresponding element of the entszs array - (described below). - - entszs is an array containing sizes of column entries. - The Ith element of entszs gives the size of the - Ith column entry. entszs is used only for columns - having variable-size entries. For such columns, - the dimension of entszs must be at least nrows. - The size of null entries should be set to zero. - - For columns having fixed-size entries, the - dimension of this array may be any positive value. - - nlflgs is an array of logical flags indicating whether - the corresponding entries are null. If the Ith - element of nlflgs is SPICEFALSE, the Ith column entry - defined by dvals and entszs is added to the - current segment in the specified kernel file. - - If the Ith element of nlfgls is SPICETRUE, the - contents of the Ith column entry are undefined. - - nlflgs is used only for columns that allow null - values; it's ignored for other columns. - - rcptrs is an array of record pointers for the input - segment. This array is obtained as an output - from ekifld_c, the routine called to initiate a - fast write. - - wkindx is a work space array used for building a column - index. If the column is indexed, the dimension of - wkindx_c must be at nrows, where nrows is the number - of rows in the column. If the column is not - indexed, this work space is not used, so the - dimension may be any positive value. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If column is not the name of a declared column, the error will - be diagnosed by routines called by this routine. - - 3) If column specifies a column of whose data type is not - double precision, the error SPICE(WRONGDATATYPE) will be - signaled. - - 4) If the specified column already contains ANY entries, the - error will be diagnosed by routines called by this routine. - - 5) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 6) If the string pointer for column is null, the error - SPICE(NULLPOINTER) will be signaled. - - 7) If the input string column has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified column. This routine - writes the entire contents of the specified column in one shot. - This routine creates columns much more efficiently than can be - done by sequential calls to ekaced_c, but has the drawback that - the caller must use more memory for the routine's inputs. This - routine cannot be used to add data to a partially completed - column. - --Examples - - 1) Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file ORDER_DB.EK contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - Below, we show how we'd open a new EK file and create the - first of the segments described above. - - #include "SpiceUsr.h" - #include - - - void main() - { - /. - Constants - ./ - #define CNMLEN ( CSPICE_EK_COL_NAM_LEN + 1 ) - #define DECLEN 201 - #define EKNAME "order_db.ek" - #define FNMLEN 50 - #define IFNAME "Test EK/Created 20-SEP-1995" - #define LNMLEN 50 - #define LSK "leapseconds.ker" - #define NCOLS 6 - #define NRESVC 0 - #define NROWS 9 - #define TABLE "DATAORDERS" - #define TNMLEN CSPICE_EK_TAB_NAM_LEN - #define UTCLEN 30 - - - /. - Local variables - ./ - SpiceBoolean nlflgs [ NROWS ]; - - SpiceChar cdecls [ NCOLS ] [ DECLEN ]; - SpiceChar cnames [ NCOLS ] [ CNMLEN ]; - SpiceChar fnames [ NROWS ] [ FNMLEN ]; - SpiceChar lnames [ NROWS ] [ LNMLEN ]; - SpiceChar dateStr [ UTCLEN ]; - - SpiceDouble costs [ NROWS ]; - SpiceDouble ets [ NROWS ]; - - SpiceInt cstids [ NROWS ]; - SpiceInt ordids [ NROWS ]; - SpiceInt handle; - SpiceInt i; - SpiceInt rcptrs [ NROWS ]; - SpiceInt segno; - SpiceInt sizes [ NROWS ]; - SpiceInt wkindx [ NROWS ]; - - - /. - Load a leapseconds kernel for UTC/ET conversion. - ./ - furnsh_c ( LSK ); - - /. - Open a new EK file. For simplicity, we will not - reserve any space for the comment area, so the - number of reserved comment characters is zero. - The constant IFNAME is the internal file name. - ./ - ekopn_c ( EKNAME, IFNAME, NRESVC, &handle ); - - /. - Set up the table and column names and declarations - for the DATAORDERS segment. We'll index all of - the columns. All columns are scalar, so we omit - the size declaration. Only the COST column may take - null values. - ./ - strcpy ( cnames[0], "ORDER_ID" ); - strcpy ( cdecls[0], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[1], "CUSTOMER_ID" ); - strcpy ( cdecls[1], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[2], "LAST_NAME" ); - strcpy ( cdecls[2], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[3], "FIRST_NAME" ); - strcpy ( cdecls[3], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[4], "ORDER_DATE" ); - strcpy ( cdecls[4], "DATATYPE = TIME, INDEXED = TRUE" ); - - strcpy ( cnames[5], "COST" ); - strcpy ( cdecls[5], "DATATYPE = DOUBLE PRECISION," - "INDEXED = TRUE," - "NULLS_OK = TRUE" ); - - /. - Start the segment. We presume the number of rows - of data is known in advance. - ./ - ekifld_c ( handle, TABLE, NCOLS, NROWS, CNMLEN, - cnames, DECLEN, cdecls, &segno, rcptrs ); - - /. - At this point, arrays containing data for the - segment's columns may be filled in. The names - of the data arrays are shown below. - - Column Data array - - "ORDER_ID" ordids - "CUSTOMER_ID" cstids - "LAST_NAME" lnames - "FIRST_NAME" fnames - "ORDER_DATE" odates - "COST" costs - - - The null flags array indicates which entries are null. - It is ignored for columns that don't allow null - values. In this case, only the COST column allows - nulls. - - Fill in data arrays and null flag arrays here. This code - section would normally be replaced by calls to user functions - returning column values. - ./ - - for ( i = 0; i < NROWS; i++ ) - { - ordids[i] = i; - cstids[i] = i*100; - costs [i] = (SpiceDouble) 100*i; - - sprintf ( fnames[i], "Order %d Customer first name", i ); - sprintf ( lnames[i], "Order %d Customer last name", i ); - sprintf ( dateStr, "1998 Mar %d", i ); - - utc2et_c ( dateStr, ets+i ); - - nlflgs[i] = SPICEFALSE; - } - - nlflgs[1] = SPICETRUE; - - - /. - The sizes array shown below is ignored for scalar - and fixed-size array columns, so we need not - initialize it. For variable-size arrays, the - Ith element of the sizes array must contain the size - of the Ith column entry in the column being written. - Normally, the sizes array would be reset for each - variable-size column. - - Add the columns of data to the segment. All of the - data for each column is written in one shot. - ./ - ekacli_c ( handle, segno, "order_id", ordids, - sizes, nlflgs, rcptrs, wkindx ); - - ekacli_c ( handle, segno, "customer_id", cstids, - sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "last_name", LNMLEN, - lnames, sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "first_name", FNMLEN, - fnames, sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "order_date", ets, - sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "cost", costs, - sizes, nlflgs, rcptrs, wkindx ); - - /. - Complete the segment. The rcptrs array is that - returned by ekifld_c. - ./ - ekffld_c ( handle, segno, rcptrs ); - - /. - At this point, the second segment could be - created by an analogous process. In fact, the - second segment could be created at any time; it is - not necessary to populate the first segment with - data before starting the second segment. - - The file must be closed by a call to ekcls_c. - ./ - ekcls_c ( handle ); - } - - --Restrictions - - 1) Only one segment can be created at a time using the fast - write routines. - - 2) No other EK operation may interrupt a fast write. For - example, it is not valid to issue a query while a fast write - is in progress. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.2, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.1, 09-JAN-2002 (NJB) - - Documentation change: instances of the phrase "fast load" - were replaced with "fast write." - - -CSPICE Version 1.1.0, 07-JUL-1998 (NJB) - - Bug fix: now uses dynamically allocated array of type logical - to interface with underlying f2c'd function ekacld_. - - Now maps segno from C to Fortran range. - - Added "undef" of masking macro. Changed input pointer types - to pointers to const objects. - - -CSPICE Version 1.0.0, 01-APR-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 08-NOV-1995 (NJB) - --Index_Entries - - write entire double precision column to EK segment - --& -*/ - -{ /* Begin ekacld_c */ - - /* - Local variables - */ - logical * logicalFlags; - - SpiceEKSegSum summary; - - SpiceInt fSegno; - SpiceInt i; - SpiceInt n; - - - - /* - Participate in error tracing. - */ - chkin_c ( "ekacld_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekacld_c", column ); - - - /* - Get the row count for this segment. - */ - ekssum_c ( handle, segno, &summary ); - - n = summary.nrows; - - - /* - Allocate an array of logicals and assign values from the input - array of SpiceBooleans. - */ - - logicalFlags = ( logical * ) malloc ( n * sizeof(logical) ); - - if ( !logicalFlags ) - { - setmsg_c ( "Failure on malloc call to create null flag array " - "for column values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "ekacld_c" ); - return; - } - - - /* - Copy the input null flags to our array of type logical. - */ - for ( i = 0; i < n; i++ ) - { - logicalFlags[i] = nlflgs[i]; - } - - - /* - Map the segment number to the Fortran range. - */ - fSegno = segno + 1; - - /* - Call the f2c'd routine. - */ - ekacld_ ( ( integer * ) &handle, - ( integer * ) &fSegno, - ( char * ) column, - ( doublereal * ) dvals, - ( integer * ) entszs, - ( logical * ) logicalFlags, - ( integer * ) rcptrs, - ( integer * ) wkindx, - ( ftnlen ) strlen(column) ); - - - /* - We're done with the local null flag array. - */ - free ( logicalFlags ); - - - chkout_c ( "ekacld_c" ); - -} /* End ekacld_c */ diff --git a/ext/spice/src/cspice/ekacli.c b/ext/spice/src/cspice/ekacli.c deleted file mode 100644 index c7f466e3a0..0000000000 --- a/ext/spice/src/cspice/ekacli.c +++ /dev/null @@ -1,727 +0,0 @@ -/* ekacli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKACLI ( EK, add integer column to segment ) */ -/* Subroutine */ int ekacli_(integer *handle, integer *segno, char *column, - integer *ivals, integer *entszs, logical *nlflgs, integer *rcptrs, - integer *wkindx, ftnlen column_len) -{ - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekac01_(integer *, integer *, integer *, integer *, - logical *, integer *, integer *), zzekac04_(integer *, integer *, - integer *, integer *, integer *, logical *), zzekac07_(integer *, - integer *, integer *, integer *, logical *, integer *); - -/* $ Abstract */ - -/* Add an entire integer column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Number of segment to add column to. */ -/* COLUMN I Column name. */ -/* IVALS I Integer values to add to column. */ -/* ENTSZS I Array of sizes of column entries. */ -/* NLFLGS I Array of null flags for column entries. */ -/* RCPTRS I Record pointers for segment. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A "begin segment for fast write" operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGNO is the number of the segment to which */ -/* data is to be added. */ - -/* COLUMN is the name of the column to be added. All of */ -/* the data for the named column will be added in */ -/* one shot. */ - -/* IVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. For columns having */ -/* fixed-size entries, a null entry must be allocated */ -/* the same amount of space occupied by a non-null */ -/* entry in the array IVALS. For columns having */ -/* variable-size entries, null entries do not require */ -/* any space in the IVALS array, but in any case must */ -/* have their allocated space described correctly by */ -/* the corresponding element of the ENTSZS array */ -/* (described below). */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by IVALS and ENTSZS is added to the */ -/* current segment in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array is obtained as an output */ -/* from EKIFLD, the routine called to initiate a */ -/* fast write. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If COLUMN is not the name of a declared column, the error will */ -/* be diagnosed by routines called by this routine. */ - -/* 3) If COLUMN specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be signalled. */ - -/* 4) If the specified column already contains ANY entries, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEI, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* 1) Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* Below, we show how we'd open a new EK file and create the */ -/* first of the segments described above. */ - - -/* C */ -/* C Open a new EK file. For simplicity, we will not */ -/* C reserve any space for the comment area, so the */ -/* C number of reserved comment characters is zero. */ -/* C The variable IFNAME is the internal file name. */ -/* C */ -/* NRESVC = 0 */ -/* IFNAME = 'Test EK/Created 20-SEP-1995' */ - -/* CALL EKOPN ( 'ORDER_DB.EK', IFNAME, NRESVC, HANDLE ) */ - -/* C */ -/* C Set up the table and column names and declarations */ -/* C for the DATAORDERS segment. We'll index all of */ -/* C the columns. All columns are scalar, so we omit */ -/* C the size declaration. Only the COST column may take */ -/* C null values. */ -/* C */ -/* TABLE = 'DATAORDERS' */ -/* NCOLS = 6 */ - -/* CNAMES(1) = 'ORDER_ID' */ -/* CDECLS(1) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(2) = 'CUSTOMER_ID' */ -/* CDECLS(2) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(3) = 'LAST_NAME' */ -/* CDECLS(3) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(4) = 'FIRST_NAME' */ -/* CDECLS(4) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(5) = 'ORDER_DATE' */ -/* CDECLS(5) = 'DATATYPE = TIME, INDEXED = TRUE' */ - -/* CNAMES(6) = 'COST' */ -/* CDECLS(6) = 'DATATYPE = DOUBLE PRECISION,' // */ -/* . 'INDEXED = TRUE' // */ -/* . 'NULLS_OK = TRUE' */ - -/* C */ -/* C Start the segment. We presume the number of rows */ -/* C of data is known in advance. */ -/* C */ -/* CALL EKIFLD ( HANDLE, TABNAM, NCOLS, NROWS, */ -/* . CNAMES, CDECLS, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, arrays containing data for the */ -/* C segment's columns may be filled in. The names */ -/* C of the data arrays are shown below. */ -/* C */ -/* C Column Data array */ -/* C */ -/* C 'ORDER_ID' ORDIDS */ -/* C 'CUSTOMER_ID' CSTIDS */ -/* C 'LAST_NAME' LNAMES */ -/* C 'FIRST_NAME' FNAMES */ -/* C 'ORDER_DATE' ONAMES */ -/* C 'COST' COSTS */ -/* C */ - -/* [ Fill in data arrays here.] */ - -/* C */ -/* C The SIZES array shown below is ignored for scalar */ -/* C and fixed-size array columns, so we need not */ -/* C initialize it. For variable-size arrays, the */ -/* C Ith element of the SIZES array must contain the size */ -/* C of the Ith column entry in the column being loaded. */ -/* C Normally, the SIZES array would be reset for each */ -/* C variable-size column. */ -/* C */ -/* C The NLFLGS array indicates which entries are null. */ -/* C It is ignored for columns that don't allow null */ -/* C values. In this case, only the COST column allows */ -/* C nulls. */ -/* C */ -/* C Add the columns of data to the segment. All of the */ -/* C data for each column is loaded in one shot. */ -/* C */ -/* CALL EKACLI ( HANDLE, SEGNO, 'ORDER_ID', */ -/* . ORDIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLI ( HANDLE, SEGNO, 'CUSTOMER_ID', */ -/* . CSTIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'LAST_NAME', */ -/* . LNAMES, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'FIRST_NAME', */ -/* . FNAMES, SIZES, NLFLGS, WKINDX ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACLD ( HANDLE, SEGNO, 'ORDER_DATE', */ -/* . ODATES, SIZES, NLFLGS, WKINDX ) */ - - -/* [Set the NLFLGS array here.] */ - -/* CALL EKACLD ( HANDLE, SEGNO, 'COST', */ -/* . COSTS, SIZES, NLFLGS, WKINDX ) */ - -/* C */ -/* C Complete the segment. The RCPTRS array is that */ -/* C returned by EKIFLD. */ -/* C */ -/* CALL EKFFLD ( HANDLE, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, the second segment could be */ -/* C created by an analogous process. In fact, the */ -/* C second segment could be created at any time; it is */ -/* C not necessary to populate the first segment with */ -/* C data before starting the second segment. */ -/* C */ - -/* C */ -/* C The file must be closed by a call to EKCLS. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) Only one segment can be created at a time using the fast */ -/* write routines. */ - -/* 2) No other EK operation may interrupt a fast write. For */ -/* example, it is not valid to issue a query while a fast write */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write entire integer column to EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKACLI", (ftnlen)6); - } - -/* Find the descriptors for the specified segment and column. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - chkout_("EKACLI", (ftnlen)6); - return 0; - } - -/* This column had better be of integer type. */ - - class__ = coldsc[0]; - dtype = coldsc[1]; - if (dtype != 3) { - setmsg_("Column # is of type #; EKACLI only works with integer colum" - "ns.", (ftnlen)62); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKACLI", (ftnlen)6); - return 0; - } - -/* Hand off the task to the routine of the appropriate class. */ - - if (class__ == 1) { - -/* Class 1 columns contain integer scalars. */ - - zzekac01_(handle, segdsc, coldsc, ivals, nlflgs, rcptrs, wkindx); - } else if (class__ == 4) { - -/* Class 4 columns contain integer arrays. */ - - zzekac04_(handle, segdsc, coldsc, ivals, entszs, nlflgs); - } else if (class__ == 7) { - -/* Class 7 columns contain fixed-count integer scalars. */ - - zzekac07_(handle, segdsc, coldsc, ivals, nlflgs, wkindx); - } else { - -/* This is an unsupported column class. */ - - setmsg_("Unsupported column class code # found in descriptor for col" - "umn #.", (ftnlen)65); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("EKACLI", (ftnlen)6); - return 0; - } - chkout_("EKACLI", (ftnlen)6); - return 0; -} /* ekacli_ */ - diff --git a/ext/spice/src/cspice/ekacli_c.c b/ext/spice/src/cspice/ekacli_c.c deleted file mode 100644 index 5a5b826ad6..0000000000 --- a/ext/spice/src/cspice/ekacli_c.c +++ /dev/null @@ -1,555 +0,0 @@ -/* - --Procedure ekacli_c ( EK, add integer column to segment ) - --Abstract - - Add an entire integer column to an EK segment. - --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 - - EK - --Keywords - - EK - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef ekacli_c - - - void ekacli_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceInt * ivals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Number of segment to add column to. - column I Column name. - ivals I Integer values to add to column. - entszs I Array of sizes of column entries. - nlflgs I Array of null flags for column entries. - rcptrs I Record pointers for segment. - wkindx I-O Work space for column index. - --Detailed_Input - - handle the handle of an EK file that is open for writing. - A "begin segment for fast write" operation must - have already been performed for the designated - segment. - - segno is the number of the segment to which data is to be - added. Segments are numbered from 0 to nseg-1, where - nseg is the count of segments in the file. - - column is the name of the column to be added. All of - the data for the named column will be added in - one shot. - - ivals is an array containing the entire set of column - entries for the specified column. The entries - are listed in row-order: the column entry for the - first row of the segment is first, followed by the - column entry for the second row, and so on. The - number of column entries must match the declared - number of rows in the segment. For columns having - fixed-size entries, a null entry must be allocated - the same amount of space occupied by a non-null - entry in the array ivals. For columns having - variable-size entries, null entries do not require - any space in the ivals* array, but in any case must - have their allocated space described correctly by - the corresponding element of the entszs array - (described below). - - entszs is an array containing sizes of column entries. - The Ith element of entszs gives the size of the - Ith column entry. entszs is used only for columns - having variable-size entries. For such columns, - the dimension of entszs must be at least nrows. - The size of null entries should be set to zero. - - For columns having fixed-size entries, the - dimension of this array may be any positive value. - - nlflgs is an array of logical flags indicating whether - the corresponding entries are null. If the Ith - element of nlflgs is SPICEFALSE, the Ith column entry - defined by ivals and entszs is added to the - current segment in the specified kernel file. - - If the Ith element of nlfgls is SPICETRUE, the - contents of the Ith column entry are undefined. - - nlflgs is used only for columns that allow null - values; it's ignored for other columns. - - rcptrs is an array of record pointers for the input - segment. This array is obtained as an output - from ekifld_c, the routine called to initiate a - fast write. - - wkindx is a work space array used for building a column - index. If the column is indexed, the dimension of - wkindx_c must be at nrows, where nrows is the number - of rows in the column. If the column is not - indexed, this work space is not used, so the - dimension may be any positive value. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If column is not the name of a declared column, the error will - be diagnosed by routines called by this routine. - - 3) If column specifies a column of whose data type is not - integer, the error SPICE(WRONGDATATYPE) will be signalled. - - 4) If the specified column already contains ANY entries, the - error will be diagnosed by routines called by this routine. - - 5) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 6) If the string pointer for column is null, the error - SPICE(NULLPOINTER) will be signaled. - - 7) If the input string column has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified column. This routine - writes the entire contents of the specified column in one shot. - This routine creates columns much more efficiently than can be - done by sequential calls to ekacei_c, but has the drawback that - the caller must use more memory for the routine's inputs. This - routine cannot be used to add data to a partially completed - column. - --Examples - - 1) Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file ORDER_DB.EK contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - Below, we show how we'd open a new EK file and create the - first of the segments described above. - - #include "SpiceUsr.h" - #include - - - void main() - { - /. - Constants - ./ - #define CNMLEN ( CSPICE_EK_COL_NAM_LEN + 1 ) - #define DECLEN 201 - #define EKNAME "order_db.ek" - #define FNMLEN 50 - #define IFNAME "Test EK/Created 20-SEP-1995" - #define LNMLEN 50 - #define LSK "leapseconds.ker" - #define NCOLS 6 - #define NRESVC 0 - #define NROWS 9 - #define TABLE "DATAORDERS" - #define TNMLEN CSPICE_EK_TAB_NAM_LEN - #define UTCLEN 30 - - - /. - Local variables - ./ - SpiceBoolean nlflgs [ NROWS ]; - - SpiceChar cdecls [ NCOLS ] [ DECLEN ]; - SpiceChar cnames [ NCOLS ] [ CNMLEN ]; - SpiceChar fnames [ NROWS ] [ FNMLEN ]; - SpiceChar lnames [ NROWS ] [ LNMLEN ]; - SpiceChar dateStr [ UTCLEN ]; - - SpiceDouble costs [ NROWS ]; - SpiceDouble ets [ NROWS ]; - - SpiceInt cstids [ NROWS ]; - SpiceInt ordids [ NROWS ]; - SpiceInt handle; - SpiceInt i; - SpiceInt rcptrs [ NROWS ]; - SpiceInt segno; - SpiceInt sizes [ NROWS ]; - SpiceInt wkindx [ NROWS ]; - - - /. - Load a leapseconds kernel for UTC/ET conversion. - ./ - furnsh_c ( LSK ); - - /. - Open a new EK file. For simplicity, we will not - reserve any space for the comment area, so the - number of reserved comment characters is zero. - The constant IFNAME is the internal file name. - ./ - ekopn_c ( EKNAME, IFNAME, NRESVC, &handle ); - - /. - Set up the table and column names and declarations - for the DATAORDERS segment. We'll index all of - the columns. All columns are scalar, so we omit - the size declaration. Only the COST column may take - null values. - ./ - strcpy ( cnames[0], "ORDER_ID" ); - strcpy ( cdecls[0], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[1], "CUSTOMER_ID" ); - strcpy ( cdecls[1], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[2], "LAST_NAME" ); - strcpy ( cdecls[2], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[3], "FIRST_NAME" ); - strcpy ( cdecls[3], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[4], "ORDER_DATE" ); - strcpy ( cdecls[4], "DATATYPE = TIME, INDEXED = TRUE" ); - - strcpy ( cnames[5], "COST" ); - strcpy ( cdecls[5], "DATATYPE = DOUBLE PRECISION," - "INDEXED = TRUE," - "NULLS_OK = TRUE" ); - - /. - Start the segment. We presume the number of rows - of data is known in advance. - ./ - ekifld_c ( handle, TABLE, NCOLS, NROWS, CNMLEN, - cnames, DECLEN, cdecls, &segno, rcptrs ); - - /. - At this point, arrays containing data for the - segment's columns may be filled in. The names - of the data arrays are shown below. - - Column Data array - - "ORDER_ID" ordids - "CUSTOMER_ID" cstids - "LAST_NAME" lnames - "FIRST_NAME" fnames - "ORDER_DATE" odates - "COST" costs - - - The null flags array indicates which entries are null. - It is ignored for columns that don't allow null - values. In this case, only the COST column allows - nulls. - - Fill in data arrays and null flag arrays here. This code - section would normally be replaced by calls to user functions - returning column values. - ./ - - for ( i = 0; i < NROWS; i++ ) - { - ordids[i] = i; - cstids[i] = i*100; - costs [i] = (SpiceDouble) 100*i; - - sprintf ( fnames[i], "Order %d Customer first name", i ); - sprintf ( lnames[i], "Order %d Customer last name", i ); - sprintf ( dateStr, "1998 Mar %d", i ); - - utc2et_c ( dateStr, ets+i ); - - nlflgs[i] = SPICEFALSE; - } - - nlflgs[1] = SPICETRUE; - - - /. - The sizes array shown below is ignored for scalar - and fixed-size array columns, so we need not - initialize it. For variable-size arrays, the - Ith element of the sizes array must contain the size - of the Ith column entry in the column being written. - Normally, the sizes array would be reset for each - variable-size column. - - Add the columns of data to the segment. All of the - data for each column is written in one shot. - ./ - ekacli_c ( handle, segno, "order_id", ordids, - sizes, nlflgs, rcptrs, wkindx ); - - ekacli_c ( handle, segno, "customer_id", cstids, - sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "last_name", LNMLEN, - lnames, sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "first_name", FNMLEN, - fnames, sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "order_date", ets, - sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "cost", costs, - sizes, nlflgs, rcptrs, wkindx ); - - /. - Complete the segment. The rcptrs array is that - returned by ekifld_c. - ./ - ekffld_c ( handle, segno, rcptrs ); - - /. - At this point, the second segment could be - created by an analogous process. In fact, the - second segment could be created at any time; it is - not necessary to populate the first segment with - data before starting the second segment. - - The file must be closed by a call to ekcls_c. - ./ - ekcls_c ( handle ); - } - - --Restrictions - - 1) Only one segment can be created at a time using the fast - write routines. - - 2) No other EK operation may interrupt a fast write. For - example, it is not valid to issue a query while a fast write - is in progress. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.2, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.2.1, 09-JAN-2002 (NJB) - - Documentation change: instances of the phrase "fast load" - were replaced with "fast write." - - -CSPICE Version 1.1.0, 12-JUL-1998 (NJB) - - Bug fix: now uses dynamically allocated array of type logical - to interface with underlying f2c'd function ekacli_. - - Now maps segno from C to Fortran range. - - Added "undef" of masking macro. Changed input pointer types - to pointers to const objects. - - -CSPICE Version 1.0.0, 01-APR-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 08-NOV-1995 (NJB) - --Index_Entries - - write entire integer column to EK segment - --& -*/ - -{ /* Begin ekacli_c */ - - /* - Local variables - */ - logical * logicalFlags; - - SpiceEKSegSum summary; - - SpiceInt fSegno; - SpiceInt i; - SpiceInt n; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekacli_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekacli_c", column ); - - - /* - Get the row count for this segment. - */ - - ekssum_c ( handle, segno, &summary ); - - n = summary.nrows; - - - /* - Allocate an array of logicals and assign values from the input - array of SpiceBooleans. - */ - - logicalFlags = ( logical * ) malloc ( n * sizeof(logical) ); - - if ( !logicalFlags ) - { - setmsg_c ( "Failure on malloc call to create null flag array " - "for column values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "ekacli_c" ); - return; - } - - - /* - Copy the input null flags to our array of type logical. - */ - for ( i = 0; i < n; i++ ) - { - logicalFlags[i] = nlflgs[i]; - } - - - /* - Map the segment number to the Fortran range. - */ - fSegno = segno + 1; - - - /* - Call the f2c'd routine. - */ - ekacli_ ( ( integer * ) &handle, - ( integer * ) &fSegno, - ( char * ) column, - ( integer * ) ivals, - ( integer * ) entszs, - ( logical * ) logicalFlags, - ( integer * ) rcptrs, - ( integer * ) wkindx, - ( ftnlen ) strlen(column) ); - - - /* - We're done with the local null flag array. - */ - free ( logicalFlags ); - - - chkout_c ( "ekacli_c" ); - -} /* End ekacli_c */ diff --git a/ext/spice/src/cspice/ekappr.c b/ext/spice/src/cspice/ekappr.c deleted file mode 100644 index 1e8706641f..0000000000 --- a/ext/spice/src/cspice/ekappr.c +++ /dev/null @@ -1,838 +0,0 @@ -/* ekappr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKAPPR ( EK, append record onto segment ) */ -/* Subroutine */ int ekappr_(integer *handle, integer *segno, integer *recno) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer nrec; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekmloc_(integer *, integer *, integer *, integer *); - integer mbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - integer mp, segdsc[24]; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), dasrdi_(integer *, - integer *, integer *, integer *), ekinsr_(integer *, integer *, - integer *); - -/* $ Abstract */ - -/* Append a new, empty record at the end of a specified E-kernel */ -/* segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RECNO O Number of appended record. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGNO is the number of the segment to which the record */ -/* is to be added. */ - -/* $ Detailed_Output */ - -/* RECNO is the number of the record appended by this */ -/* routine. RECNO is used to identify the record */ -/* when writing column entries to it. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If SEGNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: It appends a new, empty */ -/* record structure to an EK segment. The ordinal position of the */ -/* new record is one greater than the previous number of records in */ -/* in the segment. */ - -/* After a new record has been appended to a segment by this routine, */ -/* the record must be populated with data using the EKACEx */ -/* routines. EKs are valid only when all of their column entries */ -/* are initialized. */ - -/* To insert a record into a segment at a specified ordinal position, */ -/* use the routine EKAPPR. */ - -/* This routine cannot be used with the "fast write" suite of */ -/* routines. See the EK Required Reading for a discussion of the */ -/* fast writers. */ - -/* When a record is inserted into an EK file that is not shadowed, */ -/* the status of the record starts out set to OLD. The status */ -/* does not change when data is added to the record. */ - -/* If the target EK is shadowed, the new record will be given the */ -/* status NEW. Updating column values in the record does not change */ -/* its status. When changes are committed, the status is set to OLD. */ -/* If a rollback is performed before changes are committed, the */ -/* record is deleted. Closing the target file without committing */ -/* changes implies a rollback. */ - -/* $ Examples */ - -/* 1) Append a record to a specified segment. */ - -/* Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* If we wanted to insert a new record into the DATAORDERS */ -/* table in position 1, we'd make the following calls: */ - -/* C */ -/* C Open the database for write access. This call is */ -/* C made when the file already exists. See EKOPN for */ -/* C an example of creating a new file. */ -/* C */ -/* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */ - -/* C */ -/* C Append a new, empty record to the DATAORDERS */ -/* C table. Recall that the DATAORDERS table */ -/* C is in segment number 1. The call will return */ -/* C the number of the new, empty record. */ -/* C */ -/* CALL EKAPPR ( HANDLE, 1, RECNO ) */ - -/* C */ -/* C At this point, the new record is empty. A valid EK */ -/* C cannot contain empty records. We fill in the data */ -/* C here. Data items are filled in one column at a time. */ -/* C The order in which the columns are filled in is not */ -/* C important. We use the EKACEx (add column entry) */ -/* C routines to fill in column entries. We'll assume */ -/* C that no entries are null. All entries are scalar, */ -/* C so the entry size is 1. */ -/* C */ -/* ISNULL = .FALSE. */ -/* ESIZE = 1 */ - -/* C */ -/* C The following variables will contain the data for */ -/* C the new record. */ -/* C */ -/* ORDID = 10011 */ -/* CUSTID = 531 */ -/* LNAME = 'Scientist' */ -/* FNAME = 'Joe' */ -/* ODATE = '1995-SEP-20' */ -/* COST = 0.D0 */ - -/* C */ -/* C Note that the names of the routines called */ -/* C correspond to the data types of the columns: the */ -/* C last letter of the routine name is C, I, or D, */ -/* C depending on the data type. Time values are */ -/* C converted to ET for storage. */ -/* C */ -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */ -/* . SIZE, ORDID, ISNULL ) */ - -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */ -/* . SIZE, CUSTID, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */ -/* . SIZE, LNAME, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */ -/* . SIZE, FNAME, ISNULL ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */ -/* . SIZE, ET, ISNULL ) */ - -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */ -/* . SIZE, COST, ISNULL ) */ - -/* C */ -/* C Close the file to make the update permanent. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* append record to EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKAPPR", (ftnlen)6); - } - -/* Before trying to actually write anything, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("EKAPPR", (ftnlen)6); - return 0; - } - -/* Look up the integer metadata page and page base for the segment. */ -/* Given the base address, we can read the pertinent metadata in */ -/* one shot. */ - - zzekmloc_(handle, segno, &mp, &mbase); - if (failed_()) { - chkout_("EKAPPR", (ftnlen)6); - return 0; - } - i__1 = mbase + 1; - i__2 = mbase + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - -/* Obtain the number of records already present. */ - - nrec = segdsc[5]; - -/* Insert the new record at the end of the segment. */ - - *recno = nrec + 1; - ekinsr_(handle, segno, recno); - chkout_("EKAPPR", (ftnlen)6); - return 0; -} /* ekappr_ */ - diff --git a/ext/spice/src/cspice/ekappr_c.c b/ext/spice/src/cspice/ekappr_c.c deleted file mode 100644 index 390d5fbc88..0000000000 --- a/ext/spice/src/cspice/ekappr_c.c +++ /dev/null @@ -1,294 +0,0 @@ -/* - --Procedure ekappr_c ( EK, append record onto segment ) - --Abstract - - Append a new, empty record at the end of a specified E-kernel - segment. - --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 - - EK - --Keywords - - PRIVATE - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ekappr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * recno ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I File handle. - segno I Segment number. - recno O Number of appended record. - --Detailed_Input - - handle is a file handle of an EK open for write access. - - segno is the number of the segment to which the record - is to be added. EK segment numbers range from - zero to N-1, where N is the number of segments - in the kernel. - --Detailed_Output - - recno is the number of the record appended by this - routine. recno is used to identify the record - when writing column entries to it. EK record - numbers range from 0 to N-1, where N is the - number of records in the segment containing - the record. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. The file will not be modified. - - 2) If segno is out of range, the error SPICE(INVALIDINDEX) - will be signalled. The file will not be modified. - - 3) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. The file may be corrupted. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: It appends a new, empty - record structure to an EK segment. The ordinal position of the - new record is one greater than the previous number of records in - in the segment. - - After a new record has been appended to a segment by this routine, - the record must be populated with data using the ekace*_c - routines. EKs are valid only when all of their column entries - are initialized. - - To insert a record into a segment at a specified ordinal position, - use the routine ekappr_c. - - This routine cannot be used with the "fast write" suite of - routines. See the EK Required Reading for a discussion of the - fast writers. - --Examples - - 1) Append a record to a specified segment. - - Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file order_db.ek contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - If we wanted to insert a new record into the DATAORDERS - table in position 0, we'd make the following calls: - - - #include "SpiceUsr.h" - . - . - . - /. - Open the database for write access. This call is - made when the file already exists. See ekopn_c for - an example of creating a new file. - ./ - ekopw_c ( "order_db.ek", &handle ); - - /. - Append a new, empty record to the DATAORDERS - table. Recall that the DATAORDERS table - is in segment number 0. The call will return - the number of the new, empty record. - ./ - ekappr_c ( handle, 0, &recno ); - - /. - At this point, the new record is empty. A valid EK - cannot contain empty records. We fill in the data - here. Data items are filled in one column at a time. - The order in which the columns are filled in is not - important. We use the ekace*_c (add column entry) - routines to fill in column entries. We'll assume - that no entries are null. All entries are scalar, - so the entry size is 1. - ./ - isnull = SPICEFALSE; - size = 1; - - /. - The following variables will contain the data for - the new record. - ./ - ordid = 10011; - custid = 531; - lname = "scientist"; - fname = "joe"; - odate = "1995-sep-20"; - cost = 5000.; - - /. - Note that the names of the routines called - correspond to the data types of the columns: the - last letter of the routine name is C, I, or D, - depending on the data type. Time values are - converted to ET for storage. - ./ - ekacei_c ( handle, segno, recno, "order_id", - size, ordid, isnull ); - - ekacei_c ( handle, segno, recno, "customer_id", - size, custid, isnull ); - - ekacec_c ( handle, segno, recno, "last_name", - size, vallen, lname, isnull ); - - ekacec_c ( handle, segno, recno, "first_name", - size, vallen, fname, isnull ); - - utc2et_c ( odate, &et ); - - - ekaced_c ( handle, segno, recno, "order_date", - size, et, isnull ); - - ekaced_c ( handle, segno, recno, "cost", - size, cost, isnull ); - - /. - Close the file to make the update permanent. - ./ - ekcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 09-JAN-2002 (NJB) - --Index_Entries - - append record to EK segment - --& -*/ - -{ /* Begin ekappr_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "ekappr_c" ); - - /* - Convert the segment number to a Fortran index. - */ - segno++; - - - ekappr_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) recno ); - - /* - Convert the record number to a C style index. - */ - - ( *recno )--; - - - chkout_c ( "ekappr_c" ); - -} /* End ekappr_c */ - - - - diff --git a/ext/spice/src/cspice/ekbseg.c b/ext/spice/src/cspice/ekbseg.c deleted file mode 100644 index e8ecb6e30b..0000000000 --- a/ext/spice/src/cspice/ekbseg.c +++ /dev/null @@ -1,1384 +0,0 @@ -/* ekbseg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__512 = 512; -static integer c__32 = 32; -static integer c__1 = 1; -static integer c__100 = 100; - -/* $Procedure EKBSEG ( EK, start new segment ) */ -/* Subroutine */ int ekbseg_(integer *handle, char *tabnam, integer *ncols, - char *cnames, char *decls, integer *segno, ftnlen tabnam_len, ftnlen - cnames_len, ftnlen decls_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzekpdec_(char *, integer *, ftnlen), - zzekpgch_(integer *, char *, ftnlen); - integer i__; - extern integer zzekstyp_(integer *, integer *); - integer idend; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer stype; - extern logical failed_(void); - extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, - ftnlen); - extern integer lastnb_(char *, ftnlen); - extern logical return_(void); - integer cdscrs[1100] /* was [11][100] */; - static integer idspec[518]; - integer nchars; - extern /* Subroutine */ int chkout_(char *, ftnlen), ssizei_(integer *, - integer *), lxdfid_(integer *), lxidnt_(integer *, char *, - integer *, integer *, integer *, ftnlen), setmsg_(char *, ftnlen), - sigerr_(char *, ftnlen), errint_(char *, integer *, ftnlen), - zzekbs01_(integer *, char *, integer *, char *, integer *, - integer *, ftnlen, ftnlen), zzekbs02_(integer *, char *, integer * - , char *, integer *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Start a new segment in an E-kernel. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TABNAM I Table name. */ -/* NCOLS I Number of columns in the segment. */ -/* CNAMES I Names of columns. */ -/* DECLS I Declarations of columns. */ -/* SEGNO O Segment number. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ - -/* TABNAM is the name of the EK table to which the current */ -/* segment belongs. All segments in the EK file */ -/* designated by HANDLE must have identical column */ -/* attributes. TABNAM must not exceed 32 characters */ -/* in length. Case is not significant. Table names */ -/* must start with a letter and contain only */ -/* characters from the set {A-Z,a-z,0-9,$,_}. */ - -/* NCOLS is the number of columns in a new segment. */ - -/* CNAMES, */ -/* DECLS are, respectively, and array of column names and */ -/* their corresponding declarations: the Ith element */ -/* of CNAMES and the Ith element of DECLS apply to */ -/* the Ith column in the segment. */ - -/* Column names must not exceed CNAMSZ (32) characters */ -/* in length. Case is not significant. Column names */ -/* must start with a letter and contain only */ -/* characters from the set {A-Z,a-z,0-9,$,_}. */ - -/* The declarations are strings that contain */ -/* `keyword=value' assignments that define the */ -/* attributes of the columns to which they apply. The */ -/* column attributes that are defined by a column */ -/* declaration are: */ - -/* DATATYPE */ -/* SIZE */ -/* */ -/* */ - -/* The form of a declaration is */ - -/* 'DATATYPE = , */ -/* SIZE = , */ -/* INDEXED = , */ -/* NULLS_OK = ' */ - -/* For example, an indexed, scalar, integer column */ -/* that allows null values would have the declaration */ - -/* 'DATATYPE = INTEGER, */ -/* SIZE = 1, */ -/* INDEXED = TRUE, */ -/* NULLS_OK = TRUE' */ - -/* Commas are required to separate the assignments */ -/* within declarations; white space is optional; */ -/* case is not significant. */ - -/* The order in which the attribute keywords are */ -/* listed in declaration is not significant. */ - -/* Every column in a segment must be declared. */ - -/* Each column entry is effectively an array, each */ -/* element of which has the declared data type. The */ -/* SIZE keyword indicates how many elements are in */ -/* each entry of the column in whose declaration the */ -/* keyword appears. Note that only scalar-valued */ -/* columns (those for which SIZE = 1) may be */ -/* referenced in query constraints. A size */ -/* assignment has the syntax */ - -/* SIZE = */ - -/* or */ -/* SIZE = VARIABLE */ - -/* The size value defaults to 1 if omitted. */ - -/* The DATATYPE keyword defines the data type of */ -/* column entries. The DATATYPE assignment syntax */ -/* has any of the forms */ - -/* DATATYPE = CHARACTER*() */ -/* DATATYPE = CHARACTER*(*) */ -/* DATATYPE = DOUBLE PRECISION */ -/* DATATYPE = INTEGER */ -/* DATATYPE = TIME */ - -/* As the datatype declaration syntax suggests, */ -/* character strings may have fixed or variable */ -/* length. Variable-length strings are allowed only */ -/* in columns of size 1. */ - -/* Optionally, scalar-valued columns may be indexed. */ -/* To create an index for a column, use the assignment */ - -/* INDEXED = TRUE */ - -/* By default, columns are not indexed. */ - -/* Optionally, any column can allow null values. To */ -/* indicate that a column may allow null values, use */ -/* the assigment */ - -/* NULLS_OK = TRUE */ - -/* in the column declaration. By default, null */ -/* values are not allowed in column entries. */ - -/* $ Detailed_Output */ - -/* SEGNO is the number of the segment created by this */ -/* routine. Segment numbers are used as unique */ -/* identifiers by other EK access routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TABNAM is more than TNAMSZ characters long, the error */ -/* is diagnosed by routines called by this routine. */ - -/* 3) If TABNAM contains any nonprintable characters, the error */ -/* is diagnosed by routines called by this routine. */ - -/* 4) If NCOLS is non-positive or greater than the maximum allowed */ -/* number MXCLSG, the error SPICE(INVALIDCOUNT) is signalled. */ - -/* 5) If any column name exceeds CNAMSZ characters in length, the */ -/* error is diagnosed by routines called by this routine. */ - -/* 6) If any column name contains non-printable characters, the */ -/* error is diagnosed by routines called by this routine. */ - -/* 7) If a declaration cannot be understood by this routine, the */ -/* error is diagnosed by routines called by this routine. */ - -/* 8) If an non-positive string length or element size is specified, */ -/* the error is diagnosed by routines called by this routine. */ - -/* 9) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it prepares an EK for */ -/* the addition of a new segment. It is not necessary to take */ -/* any special action to `complete' a segment; segments are readable */ -/* after the completion of any record insertion, deletion, write, */ -/* or update operation. */ - -/* $ Examples */ - -/* 1) Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* Below, we show how we'd open a new EK file and start the */ -/* first of the segments described above. */ - - -/* C */ -/* C Open a new EK file. For simplicity, we will not */ -/* C reserve any space for the comment area, so the */ -/* C number of reserved comment characters is zero. */ -/* C The variable IFNAME is the internal file name. */ -/* C */ -/* NRESVC = 0 */ -/* IFNAME = 'Test EK/Created 20-SEP-1995' */ - -/* CALL EKOPN ( 'ORDER_DB.EK', IFNAME, NRESVC, HANDLE ) */ - -/* C */ -/* C Set up the table and column names and declarations */ -/* C for the DATAORDERS segment. We'll index all of */ -/* C the columns. All columns are scalar, so we omit */ -/* C the size declaration. Only the COST column may take */ -/* C null values. */ -/* C */ -/* TABLE = 'DATAORDERS' */ -/* NCOLS = 6 */ - -/* CNAMES(1) = 'ORDER_ID' */ -/* CDECLS(1) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(2) = 'CUSTOMER_ID' */ -/* CDECLS(2) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(3) = 'LAST_NAME' */ -/* CDECLS(3) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(4) = 'FIRST_NAME' */ -/* CDECLS(4) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(5) = 'ORDER_DATE' */ -/* CDECLS(5) = 'DATATYPE = TIME, INDEXED = TRUE' */ - -/* CNAMES(6) = 'COST' */ -/* CDECLS(6) = 'DATATYPE = DOUBLE PRECISION,' // */ -/* . 'INDEXED = TRUE' // */ -/* . 'NULLS_OK = TRUE' */ - -/* C */ -/* C Start the segment. */ -/* C */ -/* CALL EKBSEG ( HANDLE, TABNAM, NCOLS, */ -/* . CNAMES, CDECLS, SEGNO ) */ - -/* C */ -/* C Add data to the segment. No special action */ -/* C is required to finish the segment. */ -/* C */ -/* [Data is added via calls to EKAPPR and the */ -/* EKACEC, EKACED, and EKACEI routines. See any */ -/* of these routines for examples.] */ - -/* C */ -/* C At this point, the second segment could be */ -/* C created by an analogous process. In fact, the */ -/* C second segment could be created at any time; it is */ -/* C not necessary to populate the first segment with */ -/* C data before starting the second segment. */ -/* C */ - -/* C */ -/* C The file must be closed by a call to EKCLS. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Erroneous error message for invalid column names was fixed. */ -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* start new E-kernel segment */ -/* start new EK segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Erroneous error message for invalid column names was fixed. */ -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKBSEG", (ftnlen)6); - } - -/* Before trying to actually write anything, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - -/* Get the default identifier specification the first time through. */ - - if (first) { - ssizei_(&c__512, idspec); - lxdfid_(idspec); - first = FALSE_; - } - -/* The table name must not be too long, and all of its characters */ -/* must be printable (it's ok for it to unprintable). */ - - chckid_("EK table name", &c__32, tabnam, (ftnlen)13, tabnam_len); - if (failed_()) { - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - -/* Make sure the table name satisfies all of our restrictions on */ -/* allowed characters. */ - - lxidnt_(idspec, tabnam, &c__1, &idend, &nchars, tabnam_len); - if (nchars == 0 || nchars < lastnb_(tabnam, tabnam_len)) { - setmsg_("Table name <#> violates syntax rules.", (ftnlen)37); - errch_("#", tabnam, (ftnlen)1, tabnam_len); - sigerr_("SPICE(INVALIDNAME)", (ftnlen)18); - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - -/* Check out NCOLS. */ - - if (*ncols < 1 || *ncols > 100) { - setmsg_("Number of columns must be in range 1:#, was #.", (ftnlen)46); - errint_("#", &c__100, (ftnlen)1); - errint_("#", ncols, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - -/* Check the column names for length and printability. */ - - i__1 = *ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - chckid_("EK column name", &c__32, cnames + (i__ - 1) * cnames_len, ( - ftnlen)14, cnames_len); - if (failed_()) { - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - -/* Make sure each column name satisfies all of our restrictions on */ -/* allowed characters. */ - - lxidnt_(idspec, cnames + (i__ - 1) * cnames_len, &c__1, &idend, & - nchars, cnames_len); - if (nchars == 0 || nchars < lastnb_(cnames + (i__ - 1) * cnames_len, - cnames_len)) { - setmsg_("Column name <#> violates syntax rules.", (ftnlen)38); - errch_("#", cnames + (i__ - 1) * cnames_len, (ftnlen)1, - cnames_len); - sigerr_("SPICE(INVALIDNAME)", (ftnlen)18); - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - } - -/* Parse the column declarations before proceeding. */ - - i__1 = *ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Parse the declaration of the Ith column. The descriptor is */ -/* returned with all elements other than pointers initialized. */ - - zzekpdec_(decls + (i__ - 1) * decls_len, &cdscrs[(i__2 = i__ * 11 - - 11) < 1100 && 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, "ekb" - "seg_", (ftnlen)549)], decls_len); - if (failed_()) { - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - } - -/* Determine the segment type. */ - - stype = zzekstyp_(ncols, cdscrs); - -/* Create the segment metadata according to the segment's type. */ - - if (stype == 1) { - zzekbs01_(handle, tabnam, ncols, cnames, cdscrs, segno, tabnam_len, - cnames_len); - } else if (stype == 2) { - zzekbs02_(handle, tabnam, ncols, cnames, cdscrs, segno, tabnam_len, - cnames_len); - } else { - setmsg_("Segment type # is not currently supported.", (ftnlen)42); - errint_("#", &stype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("EKBSEG", (ftnlen)6); - return 0; - } - chkout_("EKBSEG", (ftnlen)6); - return 0; -} /* ekbseg_ */ - diff --git a/ext/spice/src/cspice/ekbseg_c.c b/ext/spice/src/cspice/ekbseg_c.c deleted file mode 100644 index 245df77c68..0000000000 --- a/ext/spice/src/cspice/ekbseg_c.c +++ /dev/null @@ -1,548 +0,0 @@ -/* - --Procedure ekbseg_c ( EK, start new segment ) - --Abstract - - Start a new segment in an E-kernel. - --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 - - EK - --Keywords - - EK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekbseg_c - - void ekbseg_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I File handle. - tabnam I Table name. - ncols I Number of columns in the segment. - cnmlen I Length of names in in column name array. - cnames I Names of columns. - declen I Length of declaration strings in declaration array. - decls I Declarations of columns. - segno O Segment number. - --Detailed_Input - - handle the handle of an EK file that is open for writing. - - tabnam is the name of the EK table to which the current - segment belongs. All segments in the EK file - designated by handle must have identical column - attributes. tabnam must not exceed SPICE_EK_TNAMSZ - characters (see SpiceEK.h) in length. Case is not - significant. Table names must start with a letter and - contain only characters from the set - {A-Z,a-z,0-9,$,_}. - - ncols is the number of columns in a new segment. - - cnmlen, - cnames are, respectively, the length of the column name - strings in the column name array, and the base - address of the array itself. The array should have - dimensions - - [ncols][cnmlen] - - declen, - decls are, respectively, the length of the declaration - strings in the declaration array, and the base - address of the array itself. The array should have - dimensions - - [ncols][declen] - - The Ith element of cnames and the Ith element of decls - apply to the Ith column in the segment. - - Column names must not exceed CSPICE_EK_CNAMSZ - characters (see SpiceEK.h) in length. Case is not - significant. Column names must start with a letter - and contain only characters from the set - {A-Z,a-z,0-9,$,_}. - - The declarations are strings that contain - "keyword=value" assignments that define the - attributes of the columns to which they apply. The - column attributes that are defined by a column - declaration are: - - DATATYPE - SIZE - - - - The form of a declaration is - - "DATATYPE = , - SIZE = , - INDEXED = , - NULLS_OK = " - - For example, an indexed, scalar, integer column - that allows null values would have the declaration - - "DATATYPE = INTEGER, - SIZE = 1, - INDEXED = TRUE, - NULLS_OK = TRUE" - - Commas are required to separate the assignments - within declarations; white space is optional; - case is not significant. - - The order in which the attribute keywords are - listed in declaration is not significant. - - Every column in a segment must be declared. - - Each column entry is effectively an array, each - element of which has the declared data type. The - SIZE keyword indicates how many elements are in - each entry of the column in whose declaration the - keyword appears. Note that only scalar-valued - columns (those for which SIZE = 1) may be - referenced in query constraints. A size - assignment has the syntax - - SIZE = - - or - SIZE = VARIABLE - - The size value defaults to 1 if omitted. - - The DATATYPE keyword defines the data type of - column entries. The DATATYPE assignment syntax - has any of the forms - - DATATYPE = CHARACTER*() - DATATYPE = CHARACTER*(*) - DATATYPE = DOUBLE PRECISION - DATATYPE = INTEGER - DATATYPE = TIME - - As the datatype declaration syntax suggests, - character strings may have fixed or variable - length. Variable-length strings are allowed only - in columns of size 1. - - Optionally, scalar-valued columns may be indexed. - To create an index for a column, use the assignment - - INDEXED = TRUE - - By default, columns are not indexed. - - Optionally, any column can allow null values. To - indicate that a column may allow null values, use - the assigment - - NULLS_OK = TRUE - - in the column declaration. By default, null - values are not allowed in column entries. - - - - --Detailed_Output - - segno is the number of the segment to which data is to be - added. Segments are numbered from 0 to nseg-1, where - nseg is the count of segments in the file. Segment - numbers are used as unique identifiers by other EK - access routines. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If tabnam is more than SPICE_EK_TNAMSZ characters long, the - error is diagnosed by routines called by this routine. - - 3) If tabnam contains any nonprintable characters, the error - is diagnosed by routines called by this routine. - - 4) If ncols is non-positive or greater than the maximum allowed - number SPICE_EK_MXCLSG, the error SPICE(INVALIDCOUNT) is - signaled. - - 5) If any column name exceeds SPICE_EK_CNAMSZ characters in - length, the error is diagnosed by routines called by this - routine. - - 6) If any column name contains non-printable characters, the - error is diagnosed by routines called by this routine. - - 7) If a declaration cannot be understood by this routine, the - error is diagnosed by routines called by this routine. - - 8) If an non-positive string length or element size is specified, - the error is diagnosed by routines called by this routine. - - 9) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 10) If the input string pointer for the table name is null, the - error SPICE(NULLPOINTER) will be signaled. - - 12) If the input tablen name string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 13) If the string pointer for cnames is null, the error - SPICE(NULLPOINTER) will be signaled. - - 14) If the string length cnmlen is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 15) If the string pointer for decls is null, the error - SPICE(NULLPOINTER) will be signaled. - - 16) If the string length declen is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it prepares an EK for - the addition of a new segment. It is not necessary to take - any special action to `complete' a segment; segments are readable - after the completion of any record insertion, deletion, write, - or update operation. - --Examples - - 1) Suppose we have an E-kernel named ORDER_DB.EK which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file ORDER_DB.EK contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - Below, we show how we'd open a new EK file and start the - first of the segments described above. - - - #include "SpiceUsr.h" - #include - - - void main() - { - /. - Constants - ./ - #define CNMLEN SPICE_EK_CSTRLN - #define DECLEN 201 - #define EKNAME "order_db.ek" - #define FNMLEN 50 - #define IFNAME "Test EK/Created 20-SEP-1995" - #define LNMLEN 50 - #define LSK "leapseconds.ker" - #define NCOLS 6 - #define NRESVC 0 - #define TABLE "DATAORDERS" - #define TNMLEN CSPICE_EK_TAB_NAM_LEN - #define UTCLEN 30 - - - /. - Local variables - ./ - SpiceBoolean nlflgs [ NROWS ]; - - SpiceChar cdecls [ NCOLS ] [ DECLEN ]; - SpiceChar cnames [ NCOLS ] [ CNMLEN ]; - SpiceChar fnames [ NROWS ] [ FNMLEN ]; - SpiceChar lnames [ NROWS ] [ LNMLEN ]; - SpiceChar dateStr [ UTCLEN ]; - - SpiceDouble costs [ NROWS ]; - SpiceDouble ets [ NROWS ]; - - SpiceInt cstids [ NROWS ]; - SpiceInt ordids [ NROWS ]; - SpiceInt handle; - SpiceInt i; - SpiceInt segno; - SpiceInt sizes [ NROWS ]; - - - /. - Load a leapseconds kernel for UTC/ET conversion. - ./ - furnsh_c ( LSK ); - - /. - Open a new EK file. For simplicity, we will not - reserve any space for the comment area, so the - number of reserved comment characters is zero. - The constant IFNAME is the internal file name. - ./ - ekopn_c ( EKNAME, IFNAME, NRESVC, &handle ); - - /. - Set up the table and column names and declarations - for the DATAORDERS segment. We'll index all of - the columns. All columns are scalar, so we omit - the size declaration. Only the COST column may take - null values. - ./ - strcpy ( cnames[0], "ORDER_ID" ); - strcpy ( cdecls[0], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[1], "CUSTOMER_ID" ); - strcpy ( cdecls[1], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[2], "LAST_NAME" ); - strcpy ( cdecls[2], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[3], "FIRST_NAME" ); - strcpy ( cdecls[3], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[4], "ORDER_DATE" ); - strcpy ( cdecls[4], "DATATYPE = TIME, INDEXED = TRUE" ); - - strcpy ( cnames[5], "COST" ); - strcpy ( cdecls[5], "DATATYPE = DOUBLE PRECISION," - "INDEXED = TRUE," - "NULLS_OK = TRUE" ); - /. - Start the segment. - ./ - ekbseg_c ( handle, TABLE, NCOLS, CNMLEN, - cnames, DECLEN, cdecls, &segno ); - - /. - Add data to the segment. No special action - is required to finish the segment. - ./ - [Data are added via calls to ekappr_c and the - ekacec_c, ekaced_c, and ekacei_c routines. See any - of these routines for examples.] - - /. - At this point, the second segment could be - created by an analogous process. In fact, the - second segment could be created at any time; it is - not necessary to populate the first segment with - data before starting the second segment. - ./ - - - /. - The file must be closed by a call to ekcls_c. - ./ - ekcls_c ( handle ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 12-JUL-2002 (NJB) - - Call to C2F_CreateStrArr_Sig replaced with call to C2F_MapStrArr. - - -CSPICE Version 1.0.0, 17-NOV-2001 (NJB) - --Index_Entries - - start new E-kernel segment - start new EK segment - --& -*/ - -{ /* Begin ekbseg_c */ - - - - /* - Local variables - */ - SpiceChar * fCnameArr; - SpiceChar * fCdeclArr; - - SpiceInt fCnameLen; - SpiceInt fCdeclLen; - - /* - Participate in error tracing. - */ - chkin_c ( "ekbseg_c" ); - - /* - Check the table name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekbseg_c", tabnam ); - - /* - Check the column name array to make sure the pointer is non-null - and the string length is non-zero. Note: this check is normally - done for output strings: CHKOSTR is the macro that does the job. - */ - CHKOSTR ( CHK_STANDARD, "ekbseg_c", cnames, cnmlen ); - - /* - Check the declaration array to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKOSTR ( CHK_STANDARD, "ekbseg_c", decls, declen ); - - C2F_MapStrArr ( "ekbseg_c", - ncols, cnmlen, cnames, &fCnameLen, &fCnameArr ); - - if ( failed_c() ) - { - chkout_c ( "ekbseg_c" ); - return; - } - - - C2F_MapStrArr ( "ekbseg_c", - ncols, declen, decls, &fCdeclLen, &fCdeclArr ); - - if ( failed_c() ) - { - free ( fCnameArr ); - - chkout_c ( "ekbseg_c" ); - return; - } - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - ekbseg_ ( ( integer * ) &handle, - ( char * ) tabnam, - ( integer * ) &ncols, - ( char * ) fCnameArr, - ( char * ) fCdeclArr, - ( integer * ) segno, - ( ftnlen ) strlen(tabnam), - ( ftnlen ) fCnameLen, - ( ftnlen ) fCdeclLen ); - - /* - Clean up all of our dynamically allocated arrays. - */ - free ( fCnameArr ); - free ( fCdeclArr ); - - /* - Map segno to C style range. - */ - - (*segno)--; - - - chkout_c ( "ekbseg_c" ); - -} /* End ekbseg_c */ - - diff --git a/ext/spice/src/cspice/ekccnt_c.c b/ext/spice/src/cspice/ekccnt_c.c deleted file mode 100644 index f9529665b0..0000000000 --- a/ext/spice/src/cspice/ekccnt_c.c +++ /dev/null @@ -1,273 +0,0 @@ -/* - --Procedure ekccnt_c ( EK, column count ) - --Abstract - - Return the number of distinct columns in a specified, currently - loaded table - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ekccnt_c ( ConstSpiceChar * table, - SpiceInt * ccount ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - table I Name of table. - ccount O Count of distinct, currently loaded columns. - --Detailed_Input - - table is the name of a currently loaded table. Case - is not significant in the table name. - --Detailed_Output - - ccount is the number of distinct columns in table. - Columns that have the same name but belong to - different segments that are considered to be - portions of the same column, if the segments - containing those columns belong to table. - --Parameters - - None. - --Exceptions - - 1) If the specified table is not loaded, the error - SPICE(TABLENOTLOADED) is signaled. - - 2) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If the input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - This routine reads binary "sequence component" EK files. - In order for a binary EK file to be accessible to this routine, - the file must be loaded via a call to furnsh_c or the low-level - EK loader eklef_c. - --Particulars - - This routine is a utility intended for use in conjunction with - the entry point ekcii_c. These routines can be used to find the - names and attributes of the columns that are currently loaded. - --Examples - - 1) Dump the names and attributes of the columns in each loaded - table. ekccnt_c is used to obtain column counts. - - - #include "SpiceUsr.h" - #include "SpiceEK.h" - - #define FILEN 256 - - SpiceChar colnam [ SPICE_EK_CSTRLN ]; - SpiceChar ek [ FILEN ]; - SpiceChar tabnam [ SPICE_EK_TSTRLN ]; - - SpiceChar * typstrs [ 4 ] = - { - "CHR", "DP", "INT", "TIME" - }; - - SpiceEKAttDsc attdsc; - - SpiceInt i; - SpiceInt ncols; - SpiceInt ntab; - SpiceInt tab; - - - prompt_c ( "Enter name of EK to examine > ", FILEN, ek ); - - furnsh_c ( ek ); - - /. - Get the number of loaded tables. - ./ - ekntab_c ( &ntab ); - - for ( tab = 0; tab < ntab; tab++ ) - { - /. - Get the name of the current table, and look up - the column count for this table. - ./ - ektnam_c ( tab, SPICE_EK_TSTRLN, tabnam ); - - ekccnt_c ( tabnam, &ncols ); - - printf ( "Table = %s\n\n", tabnam ); - - - /. - For each column in the current table, look up the - column's attributes. The attribute block - index parameters are defined in the include file - ekattdsc.inc. - ./ - - for ( i = 0; i < ncols; i++ ) - { - ekcii_c ( tabnam, i, SPICE_EK_CSTRLN, colnam, &attdsc ); - - printf ( "Column = %s\n", colnam ); - - - /. - Write out the current column's data type. - ./ - - printf ( "Type = %s\n", typstrs[(int)attdsc.dtype] ); - - if ( attdsc.dtype == SPICE_CHR ) - { - if ( attdsc.strlen == SPICE_EK_VARSIZ ) - { - printf ( "String length = VARIABLE\n" ); - } - else - { - printf ( "String length = %ld\n", - (SpiceInt) attdsc.strlen ); - } - } - - /. - Write out the current column's entry size. - ./ - printf ( "Size = %ld\n", attdsc.size ); - - - /. - Indicate whether the current column is indexed. - ./ - if ( attdsc.indexd == SPICETRUE ) - { - printf ( "Indexed.\n" ); - } - else - { - printf ( "Not indexed.\n" ); - } - - /. - Indicate whether the current column allows - null values. - ./ - if ( attdsc.nullok == SPICETRUE ) - { - printf ( "Null values allowed.\n" ); - } - else - { - printf ( "Null values not allowed.\n" ); - } - } - /. - We're done with the current column. - ./ - } - /. - We're done with the current table. - ./ - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 14-OCT-2001 (NJB) - --Index_Entries - - return the number of loaded EK columns - return the count of loaded EK columns - --& -*/ - -{ /* Begin ekccnt_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ekccnt_c" ); - - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekccnt_c", table ); - - ekccnt_ ( ( char * ) table, - ( integer * ) ccount, - ( ftnlen ) strlen(table) ); - - - chkout_c ( "ekccnt_c" ); - -} /* End ekccnt_c */ diff --git a/ext/spice/src/cspice/ekcii_c.c b/ext/spice/src/cspice/ekcii_c.c deleted file mode 100644 index 5e30355e1a..0000000000 --- a/ext/spice/src/cspice/ekcii_c.c +++ /dev/null @@ -1,354 +0,0 @@ -/* - --Procedure ekcii_c ( EK, column info by index ) - --Abstract - - Return attribute information about a column belonging to a loaded - EK table, specifying the column by table and index. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void ekcii_c ( ConstSpiceChar * table, - SpiceInt cindex, - SpiceInt lenout, - SpiceChar * column, - SpiceEKAttDsc * attdsc ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - table I Name of table containing column. - cindex I Index of column whose attributes are to be found. - lenout I Maximum allowed length of column name. - column O Name of column. - attdsc O Column attribute descriptor. - --Detailed_Input - - table is the name of a loaded EK table. Case is not - significant. - - cindex is the index, within TABLE's column attribute - table, of the column whose attributes are to be - found. The indices of the column table entries - range from 0 to ccount-1, where ccount is the value - returned by the entry point ekccnt_c. - - lenout is the maximum allowed length of the output column - name, including the terminating null. Column names - can be accommodated by a character array of length - SPICE_EK_CSTRLN. This constant is declared in the - header file SpiceEK.h. - --Detailed_Output - - column is the name of the specified column. - - attdsc is an EK column attribute descriptor. See the header - file SpiceEK.h for details. - --Parameters - - None. - --Exceptions - - 1) If the specified table is not loaded, the error - SPICE(TABLENOTLOADED) is signaled. - - 2) If the input argument cindex is less than 0 or greater - than or equal to the number of columns in table, the error - SPICE(INVALIDINDEX) is signaled. - - 3) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 4) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - - 5) If the length of column (indicated by lenout) is at least two - characters but not large enough to contain the output string, - the output string will be truncated on the right. - --Files - - The returned column name and descriptor are based on the currently - loaded EK files. - --Particulars - - This routine is a utility that allows a calling routine to - determine the attributes of the currently loaded columns. - --Examples - - 1) Dump the names and attributes of the columns in each loaded - table. ekcii_c is used to obtain column names and attributes. - - - #include "SpiceUsr.h" - #include "SpiceEK.h" - - #define FILEN 256 - - SpiceChar colnam [ SPICE_EK_CSTRLN ]; - SpiceChar ek [ FILEN ]; - SpiceChar tabnam [ SPICE_EK_TSTRLN ]; - - SpiceChar * typstrs [ 4 ] = - { - "CHR", "DP", "INT", "TIME" - }; - - SpiceEKAttDsc attdsc; - - SpiceInt i; - SpiceInt ncols; - SpiceInt ntab; - SpiceInt tab; - - prompt_c ( "Enter name of EK to examine > ", FILEN, ek ); - - furnsh_c ( ek ); - - /. - Get the number of loaded tables. - ./ - ekntab_c ( &ntab ); - - for ( tab = 0; tab < ntab; tab++ ) - { - /. - Get the name of the current table, and look up - the column count for this table. - ./ - ektnam_c ( tab, SPICE_EK_TSTRLN, tabnam ); - - ekccnt_c ( tabnam, &ncols ); - - printf ( "Table = %s\n\n", tabnam ); - - - /. - For each column in the current table, look up the - column's attributes. The attribute block - index parameters are defined in the include file - ekattdsc.inc. - ./ - - for ( i = 0; i < ncols; i++ ) - { - ekcii_c ( tabnam, i, SPICE_EK_CSTRLN, colnam, &attdsc ); - - printf ( "Column = %s\n", colnam ); - - - /. - Write out the current column's data type. - ./ - - printf ( "Type = %s\n", typstrs[(int)attdsc.dtype] ); - - if ( attdsc.dtype == SPICE_CHR ) - { - if ( attdsc.strlen == SPICE_EK_VARSIZ ) - { - printf ( "String length = VARIABLE\n" ); - } - else - { - printf ( "String length = %ld\n", - (SpiceInt) attdsc.strlen ); - } - } - - /. - Write out the current column's entry size. - ./ - printf ( "Size = %ld\n", attdsc.size ); - - - /. - Indicate whether the current column is indexed. - ./ - if ( attdsc.indexd == SPICETRUE ) - { - printf ( "Indexed.\n" ); - } - else - { - printf ( "Not indexed.\n" ); - } - - /. - Indicate whether the current column allows - null values. - ./ - if ( attdsc.nullok == SPICETRUE ) - { - printf ( "Null values allowed.\n" ); - } - else - { - printf ( "Null values not allowed.\n" ); - } - } - /. - We're done with the current column. - ./ - } - /. - We're done with the current table. - ./ - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 26-MAR-2003 (NJB) - - Fixed description of exception (5): replaced "lenout-1" - with "lenout." Removed spurious word "clock" from string - description. - - -CSPICE Version 1.0.0, 10-JAN-2002 (NJB) - --Index_Entries - - return information on loaded EK column specified by index - --& -*/ - -{ /* Begin ekcii_c */ - - /* - Local constants - */ - #define CLSIDX 0 - #define TYPIDX ( CLSIDX + 1 ) - #define LENIDX ( TYPIDX + 1 ) - #define SIZIDX ( LENIDX + 1 ) - #define IXTIDX ( SIZIDX + 1 ) - #define NULIDX ( IXTIDX + 1 ) - #define DSCSIZ ( NULIDX + 1 ) - - /* - Local variables - */ - integer fAttDsc [ DSCSIZ ]; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekcii_c" ); - - /* - Make sure the output column has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "ekcii_c", column, lenout ); - - /* - Map the column index to a Fortran-style index. - */ - cindex++; - - /* - Call the underlying f2c'd routine. We'll get back individual - attributes which we'll use to populate the output attribute - descriptor. - */ - ekcii_ ( ( char * ) table, - ( integer * ) &cindex, - ( char * ) column, - ( integer * ) fAttDsc, - ( ftnlen ) strlen(table), - ( ftnlen ) lenout-1 ); - - /* - Convert the output column name to a C-style string. - */ - F2C_ConvertStr ( lenout, column ); - - - /* - Fill in the output attribute descriptor. - - Note that the CSPICE integer codes for data types are one less - than their corresponding codes in SPICELIB. - - The integer code indicating "variable array size" is the same - in CSPICE and SPICELIB, so the size attribute may be copied directly - from the integer array fAttDsc. - */ - attdsc->cclass = ( SpiceInt ) fAttDsc[CLSIDX]; - attdsc->dtype = ( SpiceEKDataType ) ( fAttDsc[TYPIDX] - 1 ); - attdsc->strlen = ( SpiceInt ) fAttDsc[LENIDX]; - attdsc->size = ( SpiceInt ) fAttDsc[SIZIDX]; - attdsc->indexd = ( SpiceBoolean ) ( fAttDsc[IXTIDX] >= 0 ); - attdsc->nullok = ( SpiceBoolean ) ( fAttDsc[NULIDX] >= 0 ); - - - chkout_c ( "ekcii_c" ); - -} /* End ekcii_c */ diff --git a/ext/spice/src/cspice/ekcls.c b/ext/spice/src/cspice/ekcls.c deleted file mode 100644 index 52deb61d49..0000000000 --- a/ext/spice/src/cspice/ekcls.c +++ /dev/null @@ -1,157 +0,0 @@ -/* ekcls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKCLS ( EK, close file ) */ -/* Subroutine */ int ekcls_(integer *handle) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), dascls_(integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Close an E-kernel. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an EK to be closed. Note */ -/* that EKs open for writing must be closed by this */ -/* routine in order by be valid. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the indicated file is not recognized, no error is */ -/* signalled. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine should be used to close open EK files. EK files */ -/* open for writing *must* be closed by this routine in order to be */ -/* valid. EK files open for read access should also be closed using */ -/* this routine. */ - -/* EKs open for reading won't be corrupted if closed via a FORTRAN */ -/* CLOSE statement, but the underlying bookkeeping software will */ -/* become confused if an EK is closed this way---so we recommend */ -/* closing EK files with EKCLS exclusively. */ - -/* $ Examples */ - -/* 1) Add data to an existing EK file, then close the file. */ - -/* CALL EKOPW ( 'MY.EK', HANDLE ) */ - -/* [add data] */ - -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) No more than FTSIZE DAS files may be opened simultaneously. */ -/* See DASFM for the value of FTSIZE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 31-MAR-1998 (NJB) */ - -/* Corrected Index_Entries section. */ - -/* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* close EK */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKCLS", (ftnlen)5); - } - -/* Close the file as a DAS file. */ - - dascls_(handle); - chkout_("EKCLS", (ftnlen)5); - return 0; -} /* ekcls_ */ - diff --git a/ext/spice/src/cspice/ekcls_c.c b/ext/spice/src/cspice/ekcls_c.c deleted file mode 100644 index 1c96a3f65f..0000000000 --- a/ext/spice/src/cspice/ekcls_c.c +++ /dev/null @@ -1,151 +0,0 @@ -/* - --Procedure ekcls_c ( EK, close file ) - --Abstract - - Close an E-kernel. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void ekcls_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - --Detailed_Input - - handle is the file handle of an EK to be closed. Note - that EKs open for writing must be closed by this - routine in order by be valid. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the indicated file is not recognized, no error is - signalled. - - 2) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine should be used to close open EK files. EK files - open for writing *must* be closed by this routine in order to be - valid. EK files open for read access should also be closed using - this routine. - --Examples - - 1) Add data to an existing EK file, then close the file. - - ekopw_c ( "my.ek", &handle ); - - [add data] - - ekcls_c ( handle ); - - --Restrictions - - 1) No more than CSPICE_DAS_MAX_OPEN_FILES DAS files may be opened - simultaneously. - - See SpicePar.h for the value of CSPICE_DAS_MAX_OPEN_FILES. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.0.0, 31-MAR-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) - --Index_Entries - - close EK - --& -*/ - -{ /* Begin ekcls_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "ekcls_c" ); - - - ekcls_ ( ( integer * ) &handle ); - - - chkout_c ( "ekcls_c" ); - -} /* End ekcls_c */ diff --git a/ext/spice/src/cspice/ekdelr.c b/ext/spice/src/cspice/ekdelr.c deleted file mode 100644 index 4982d18ee2..0000000000 --- a/ext/spice/src/cspice/ekdelr.c +++ /dev/null @@ -1,734 +0,0 @@ -/* ekdelr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure EKDELR ( EK, delete record from segment ) */ -/* Subroutine */ int ekdelr_(integer *handle, integer *segno, integer *recno) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Local variables */ - integer base, nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekpgch_(integer *, char *, ftnlen), zzekrbck_(char *, - integer *, integer *, integer *, integer *, ftnlen), zzekmloc_( - integer *, integer *, integer *, integer *), zzekglnk_(integer *, - integer *, integer *, integer *), zzekpgpg_(integer *, integer *, - integer *, integer *), zzektrdl_(integer *, integer *, integer *), - zzekslnk_(integer *, integer *, integer *, integer *), zzektrdp_( - integer *, integer *, integer *, integer *); - integer i__, p, mbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, ncols; - extern logical failed_(void); - integer mp, dscbas, coldsc[11], segdsc[24]; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *), - dashlu_(integer *, integer *); - char column[32]; - extern logical return_(void); - integer nlinks, recptr; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), errfnm_(char *, integer *, ftnlen), zzekde01_(integer *, - integer *, integer *, integer *), zzekde02_(integer *, integer *, - integer *, integer *), zzekde03_(integer *, integer *, integer *, - integer *), zzekde04_(integer *, integer *, integer *, integer *), - zzekde05_(integer *, integer *, integer *, integer *), zzekde06_( - integer *, integer *, integer *, integer *), zzekdps_(integer *, - integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified record from a specified E-kernel segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RECNO I Record number. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGNO is the number of the segment from which to */ -/* delete the specified record. */ - -/* RECNO is the index of the record to delete. RECNO must */ -/* be in the range 1 : NREC, where NREC is the */ -/* number of records in the segment prior to the */ -/* insertion. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If SEGNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 3) If RECNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 4) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a record */ -/* from an EK segment. Deleting a record implies: */ - -/* 1) All column entries in the record are deleted. */ - -/* 2) Link counts are decremented for data pages containing */ -/* column entries in the record to be deleted. Pages whose */ -/* link counts drop to zero are freed. */ - -/* 3) All column indexes are updated for the parent segment. */ - -/* 4) The link count is decremented for the page containing the */ -/* record pointer structure of the record to be deleted. If */ -/* the link count drops to zero, the page is freed. */ - -/* 5) The pointer to the deleted record is deleted from the */ -/* record tree for the parent segment. */ - -/* 6) The segment's metadata is updated to reflect the new */ -/* record count. */ - -/* $ Examples */ - -/* 1) Suppose the second segment of an EK file designated by */ -/* HANDLE contains 5 records: */ - -/* +-----------------+ */ -/* | Record 1 | */ -/* +-----------------+ */ -/* | Record 2 | */ -/* +-----------------+ */ -/* | Record 3 | */ -/* +-----------------+ */ -/* | Record 4 | */ -/* +-----------------+ */ -/* | Record 5 | */ -/* +-----------------+ */ - -/* Then the call */ - -/* CALL EKDELR ( HANDLE, 2, 3 ) */ - -/* deletes the third record from the segment, leaving the */ -/* segment's contents as follows: */ - -/* +-----------------+ */ -/* | Record 1 | */ -/* +-----------------+ */ -/* | Record 2 | */ -/* +-----------------+ */ -/* | Record 4 | */ -/* +-----------------+ */ -/* | Record 5 | */ -/* +-----------------+ */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete record from an EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKDELR", (ftnlen)6); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("EKDELR", (ftnlen)6); - return 0; - } - -/* Look up the integer metadata page and page base for the segment. */ -/* Given the base address, we can read the pertinent metadata in */ -/* one shot. */ - - zzekmloc_(handle, segno, &mp, &mbase); - if (failed_()) { - chkout_("EKDELR", (ftnlen)6); - return 0; - } - i__1 = mbase + 1; - i__2 = mbase + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - -/* In case the target EK is shadowed, let the shadow system know */ -/* about the deletion. This must be done before the data is */ -/* deleted. The argument COLDSC is unused on this call. */ - - zzekrbck_("DELETE", handle, segdsc, coldsc, recno, (ftnlen)6); - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - -/* Check the number of records already present. RECNO must not */ -/* exceed this count. */ - - nrec = segdsc[5]; - if (*recno < 1 || *recno > nrec) { - setmsg_("Record number = #; valid range is 1:#.", (ftnlen)38); - errint_("#", recno, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKDELR", (ftnlen)6); - return 0; - } - -/* Delete all of the column entries in the record. The deletion */ -/* routines handle updating column indexes and freeing unlinked */ -/* pages. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - i__1 = ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the descriptor of the Ith column. */ - - dscbas = mbase + 24 + (i__ - 1) * 11; - i__2 = dscbas + 1; - i__3 = dscbas + 11; - dasrdi_(handle, &i__2, &i__3, coldsc); - class__ = coldsc[0]; - -/* Delete the entry in the current column. */ - - if (class__ == 1) { - zzekde01_(handle, segdsc, coldsc, &recptr); - } else if (class__ == 2) { - zzekde02_(handle, segdsc, coldsc, &recptr); - } else if (class__ == 3) { - zzekde03_(handle, segdsc, coldsc, &recptr); - } else if (class__ == 4) { - zzekde04_(handle, segdsc, coldsc, &recptr); - } else if (class__ == 5) { - zzekde05_(handle, segdsc, coldsc, &recptr); - } else if (class__ == 6) { - zzekde06_(handle, segdsc, coldsc, &recptr); - } else { - -/* This is an unsupported class. */ - - *recno = zzekrp2n_(handle, &segdsc[1], &recptr); - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Class # from input column descriptor is not supported. " - " COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen)97); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", recno, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKDELR", (ftnlen)6); - return 0; - } - } - -/* Find the page containing the record pointer. */ - - i__1 = recptr + 1; - zzekpgpg_(&c__3, &i__1, &p, &base); - -/* Get the link count for the page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__3, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__3, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__3, &p); - } - -/* The entry corresponding to the record is deleted from */ -/* the data record tree at index RECNO. The record count gets */ -/* decremented. */ - - zzektrdl_(handle, &segdsc[6], recno); - --segdsc[5]; - -/* Write out the updated segment descriptor. */ - - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - chkout_("EKDELR", (ftnlen)6); - return 0; -} /* ekdelr_ */ - diff --git a/ext/spice/src/cspice/ekdelr_c.c b/ext/spice/src/cspice/ekdelr_c.c deleted file mode 100644 index f244048737..0000000000 --- a/ext/spice/src/cspice/ekdelr_c.c +++ /dev/null @@ -1,211 +0,0 @@ -/* - --Procedure ekdelr_c ( EK, delete record from segment ) - --Abstract - - Delete a specified record from a specified E-kernel segment. - --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 - - EK - --Keywords - - EK - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void ekdelr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I File handle. - segno I Segment number. - recno I Record number. - --Detailed_Input - - handle is a file handle of an EK open for write access. - - segno is the number of the segment to which the record - is to be added. EK segment numbers range from - zero to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record to delete. recno must - be in the range 0 : N, where N is the - number of records in the segment prior to the - insertion. - --Detailed_Output - - None. See the $Particulars section for a description of the - effect of this routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. The file will not be modified. - - 2) If segno is out of range, the error SPICE(INVALIDINDEX) - will be signalled. The file will not be modified. - - 3) If recno is out of range, the error SPICE(INVALIDINDEX) - will be signalled. The file will not be modified. - - 4) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. The file may be corrupted. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it deletes a record - from an EK segment. Deleting a record implies: - - 1) All column entries in the record are deleted. - - 2) Link counts are decremented for data pages containing - column entries in the record to be deleted. Pages whose - link counts drop to zero are freed. - - 3) All column indexes are updated for the parent segment. - - 4) The link count is decremented for the page containing the - record pointer structure of the record to be deleted. If - the link count drops to zero, the page is freed. - - 5) The pointer to the deleted record is deleted from the - record tree for the parent segment. - - 6) The segment's metadata is updated to reflect the new - record count. - --Examples - - 1) Suppose the second segment of an EK file designated by - handle contains 5 records: - - +-----------------+ - | Record 0 | - +-----------------+ - | Record 1 | - +-----------------+ - | Record 2 | - +-----------------+ - | Record 3 | - +-----------------+ - | Record 4 | - +-----------------+ - - Then the call - - ekdelr_c ( handle, 1, 2 ) - - deletes the third record from the segment, leaving the - segment's contents as follows: - - +-----------------+ - | Record 0 | - +-----------------+ - | Record 1 | - +-----------------+ - | Record 3 | - +-----------------+ - | Record 4 | - +-----------------+ - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 16-JUN-2000 (NJB) - --Index_Entries - - delete record from an EK segment - --& -*/ - -{ /* Begin ekdelr_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "ekdelr_c" ); - - /* - Convert indices to Fortran style. - */ - segno++; - recno++; - - ekdelr_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno ); - - - chkout_c ( "ekdelr_c" ); - -} /* End ekdelr_c */ - - - diff --git a/ext/spice/src/cspice/ekffld.c b/ext/spice/src/cspice/ekffld.c deleted file mode 100644 index 81f1566dc6..0000000000 --- a/ext/spice/src/cspice/ekffld.c +++ /dev/null @@ -1,480 +0,0 @@ -/* ekffld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKFFLD ( EK, finish fast write ) */ -/* Subroutine */ int ekffld_(integer *handle, integer *segno, integer *rcptrs) -{ - extern /* Subroutine */ int zzeksdsc_(integer *, integer *, integer *), - chkin_(char *, ftnlen); - integer stype, segdsc[24]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int zzekff01_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Complete a fast write operation on a new E-kernel segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RCPTRS I Record pointers. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A "begin segment for fast write" operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGNO is the number of the segment to complete. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array is obtained as an output */ -/* from EKIFLD, the routine called to initiate a */ -/* fast write. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* See the $Particulars section for a description of the */ -/* effects of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an attempt is made to finish a segment other than the */ -/* one last initialized by EKIFLD, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine completes an EK segment after the data has been */ -/* written via the fast column writer routines. The segment must */ -/* have been created by a call to ELIFLD. The fast column */ -/* writer routines are: */ - -/* EKACLC {EK, add column, character} */ -/* EKACLD {EK, add column, double precision} */ -/* EKACLI {EK, add column, integer} */ - -/* The segment is not guaranteed to be readable until all columns */ -/* have been added. After the columns have been added, the segment */ -/* may be extended by inserting more records and filling in those */ -/* records using the EKACEx routines. */ - -/* $ Examples */ - - -/* 1) Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* Below, we show how we'd open a new EK file and create the */ -/* first of the segments described above. */ - - -/* C */ -/* C Open a new EK file. For simplicity, we will not */ -/* C reserve any space for the comment area, so the */ -/* C number of reserved comment characters is zero. */ -/* C The variable IFNAME is the internal file name. */ -/* C */ -/* NRESVC = 0 */ -/* IFNAME = 'Test EK/Created 20-SEP-1995' */ - -/* CALL EKOPN ( 'ORDER_DB.EK', IFNAME, NRESVC, HANDLE ) */ - -/* C */ -/* C Set up the table and column names and declarations */ -/* C for the DATAORDERS segment. We'll index all of */ -/* C the columns. All columns are scalar, so we omit */ -/* C the size declaration. Only the COST column may take */ -/* C null values. */ -/* C */ -/* TABLE = 'DATAORDERS' */ -/* NCOLS = 6 */ - -/* CNAMES(1) = 'ORDER_ID' */ -/* CDECLS(1) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(2) = 'CUSTOMER_ID' */ -/* CDECLS(2) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(3) = 'LAST_NAME' */ -/* CDECLS(3) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(4) = 'FIRST_NAME' */ -/* CDECLS(4) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(5) = 'ORDER_DATE' */ -/* CDECLS(5) = 'DATATYPE = TIME, INDEXED = TRUE' */ - -/* CNAMES(6) = 'COST' */ -/* CDECLS(6) = 'DATATYPE = DOUBLE PRECISION,' // */ -/* . 'INDEXED = TRUE' // */ -/* . 'NULLS_OK = TRUE' */ - -/* C */ -/* C Start the segment. We presume the number of rows */ -/* C of data is known in advance. */ -/* C */ -/* CALL EKIFLD ( HANDLE, TABNAM, NCOLS, NROWS, */ -/* . CNAMES, CDECLS, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, arrays containing data for the */ -/* C segment's columns may be filled in. The names */ -/* C of the data arrays are shown below. */ -/* C */ -/* C Column Data array */ -/* C */ -/* C 'ORDER_ID' ORDIDS */ -/* C 'CUSTOMER_ID' CSTIDS */ -/* C 'LAST_NAME' LNAMES */ -/* C 'FIRST_NAME' FNAMES */ -/* C 'ORDER_DATE' ONAMES */ -/* C 'COST' COSTS */ -/* C */ - -/* [ Fill in data arrays here.] */ - -/* C */ -/* C The SIZES array shown below is ignored for scalar */ -/* C and fixed-size array columns, so we need not */ -/* C initialize it. For variable-size arrays, the */ -/* C Ith element of the SIZES array must contain the size */ -/* C of the Ith column entry in the column being added. */ -/* C Normally, the SIZES array would be reset for each */ -/* C variable-size column. */ -/* C */ -/* C The NLFLGS array indicates which entries are null. */ -/* C It is ignored for columns that don't allow null */ -/* C values. In this case, only the COST column allows */ -/* C nulls. */ -/* C */ -/* C Add the columns of data to the segment. All of the */ -/* C data for each column is added in one shot. */ -/* C */ -/* CALL EKACLI ( HANDLE, SEGNO, 'ORDER_ID', */ -/* . ORDIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLI ( HANDLE, SEGNO, 'CUSTOMER_ID', */ -/* . CSTIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'LAST_NAME', */ -/* . LNAMES, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'FIRST_NAME', */ -/* . FNAMES, SIZES, NLFLGS, WKINDX ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACLD ( HANDLE, SEGNO, 'ORDER_DATE', */ -/* . ODATES, SIZES, NLFLGS, WKINDX ) */ - - -/* [Set the NLFLGS array here.] */ - -/* CALL EKACLD ( HANDLE, SEGNO, 'COST', */ -/* . COSTS, SIZES, NLFLGS, WKINDX ) */ - -/* C */ -/* C Complete the segment. The RCPTRS array is that */ -/* C returned by EKIFLD. */ -/* C */ -/* CALL EKFFLD ( HANDLE, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, the second segment could be */ -/* C created by an analogous process. In fact, the */ -/* C second segment could be created at any time; it is */ -/* C not necessary to populate the first segment with */ -/* C data before starting the second segment. */ -/* C */ - -/* C */ -/* C The file must be closed by a call to EKCLS. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) Only one segment can be created at a time using the fast */ -/* write routines. */ - -/* 2) No other EK operation may interrupt a fast write. For */ -/* example, it is not valid to issue a query while a fast write */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - SPICELIB Version 1.1.1, 18-JUN-1999 (WLT) */ - -/* Corrected CHKOUT value to be same as CHKIN. */ - -/* - SPICELIB Version 1.0.1, 31-MAR-1998 (NJB) */ - -/* Made miscellaneous header corrections. */ - -/* - SPICELIB Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* finish fast write of an EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKFFLD", (ftnlen)6); - } - -/* Read in the segment descriptor, and get the segment's type. */ - - zzeksdsc_(handle, segno, segdsc); - stype = segdsc[0]; - -/* Complete the fast write preparations appropriate to the segment's */ -/* type. */ - - if (stype == 1) { - zzekff01_(handle, segno, rcptrs); - } else if (stype == 2) { - -/* Currently, no actions are taken to complete a type 2 segment. */ - - } else { - setmsg_("Segment type # is not currently supported.", (ftnlen)42); - errint_("#", &stype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("EKFFLD", (ftnlen)6); - return 0; - } - chkout_("EKFFLD", (ftnlen)6); - return 0; -} /* ekffld_ */ - diff --git a/ext/spice/src/cspice/ekffld_c.c b/ext/spice/src/cspice/ekffld_c.c deleted file mode 100644 index f3df648dad..0000000000 --- a/ext/spice/src/cspice/ekffld_c.c +++ /dev/null @@ -1,416 +0,0 @@ -/* - --Procedure ekffld_c ( EK, finish fast write ) - --Abstract - - Complete a fast write operation on a new E-kernel segment. - --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 - - EK - --Keywords - - EK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void ekffld_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * rcptrs ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I File handle. - segno I Segment number. - rcptrs I Record pointers. - --Detailed_Input - - handle the handle of an EK file that is open for writing. - A "begin segment for fast write" operation must - have already been performed for the designated - segment. - - segno is the number of the segment to which data is to be - added. Segments are numbered from 0 to nseg-1, where - nseg is the count of segments in the file. - - rcptrs is an array of record pointers for the input - segment. This array is obtained as an output - from ekifld_c, the routine called to initiate a - fast write. - --Detailed_Output - - None. - - See the Particulars section for a description of the - effects of this routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If an attempt is made to finish a segment other than the - one last initialized by ekifld_c, the error will be diagnosed by - routines called by this routine. - - 3) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine completes an EK segment after the data has been - written via the fast column writer routines. The segment must - have been created by a call to elifld_c. The fast column - writer routines are: - - ekaclc_c {EK, add column, character} - ekacld_c {EK, add column, double precision} - ekacli_c {EK, add column, integer} - - The segment is not guaranteed to be readable until all columns - have been added. After the columns have been added, the segment - may be extended by inserting more records and filling in those - records using the ekaceX_c routines. - --Examples - - 1) Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file ORDER_DB.EK contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - Below, we show how we'd open a new EK file and create the - first of the segments described above. - - #include "SpiceUsr.h" - #include - - - void main() - { - /. - Constants - ./ - #define CNMLEN ( CSPICE_EK_COL_NAM_LEN + 1 ) - #define DECLEN 201 - #define EKNAME "order_db.ek" - #define FNMLEN 50 - #define IFNAME "Test EK/Created 20-SEP-1995" - #define LNMLEN 50 - #define LSK "leapseconds.ker" - #define NCOLS 6 - #define NRESVC 0 - #define NROWS 9 - #define TABLE "DATAORDERS" - #define TNMLEN CSPICE_EK_TAB_NAM_LEN - #define UTCLEN 30 - - - /. - Local variables - ./ - SpiceBoolean nlflgs [ NROWS ]; - - SpiceChar cdecls [ NCOLS ] [ DECLEN ]; - SpiceChar cnames [ NCOLS ] [ CNMLEN ]; - SpiceChar fnames [ NROWS ] [ FNMLEN ]; - SpiceChar lnames [ NROWS ] [ LNMLEN ]; - SpiceChar dateStr [ UTCLEN ]; - - SpiceDouble costs [ NROWS ]; - SpiceDouble ets [ NROWS ]; - - SpiceInt cstids [ NROWS ]; - SpiceInt ordids [ NROWS ]; - SpiceInt handle; - SpiceInt i; - SpiceInt rcptrs [ NROWS ]; - SpiceInt segno; - SpiceInt sizes [ NROWS ]; - SpiceInt wkindx [ NROWS ]; - - - /. - Load a leapseconds kernel for UTC/ET conversion. - ./ - furnsh_c ( LSK ); - - /. - Open a new EK file. For simplicity, we will not - reserve any space for the comment area, so the - number of reserved comment characters is zero. - The constant IFNAME is the internal file name. - ./ - ekopn_c ( EKNAME, IFNAME, NRESVC, &handle ); - - /. - Set up the table and column names and declarations - for the DATAORDERS segment. We'll index all of - the columns. All columns are scalar, so we omit - the size declaration. Only the COST column may take - null values. - ./ - strcpy ( cnames[0], "ORDER_ID" ); - strcpy ( cdecls[0], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[1], "CUSTOMER_ID" ); - strcpy ( cdecls[1], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[2], "LAST_NAME" ); - strcpy ( cdecls[2], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[3], "FIRST_NAME" ); - strcpy ( cdecls[3], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[4], "ORDER_DATE" ); - strcpy ( cdecls[4], "DATATYPE = TIME, INDEXED = TRUE" ); - - strcpy ( cnames[5], "COST" ); - strcpy ( cdecls[5], "DATATYPE = DOUBLE PRECISION," - "INDEXED = TRUE," - "NULLS_OK = TRUE" ); - - /. - Start the segment. We presume the number of rows - of data is known in advance. - ./ - ekifld_c ( handle, TABLE, NCOLS, NROWS, CNMLEN, - cnames, DECLEN, cdecls, &segno, rcptrs ); - - /. - At this point, arrays containing data for the - segment's columns may be filled in. The names - of the data arrays are shown below. - - Column Data array - - "ORDER_ID" ordids - "CUSTOMER_ID" cstids - "LAST_NAME" lnames - "FIRST_NAME" fnames - "ORDER_DATE" odates - "COST" costs - - - The null flags array indicates which entries are null. - It is ignored for columns that don't allow null - values. In this case, only the COST column allows - nulls. - - Fill in data arrays and null flag arrays here. This code - section would normally be replaced by calls to user functions - returning column values. - ./ - - for ( i = 0; i < NROWS; i++ ) - { - ordids[i] = i; - cstids[i] = i*100; - costs [i] = (SpiceDouble) 100*i; - - sprintf ( fnames[i], "Order %d Customer first name", i ); - sprintf ( lnames[i], "Order %d Customer last name", i ); - sprintf ( dateStr, "1998 Mar %d", i ); - - utc2et_c ( dateStr, ets+i ); - - nlflgs[i] = SPICEFALSE; - } - - nlflgs[1] = SPICETRUE; - - - /. - The sizes array shown below is ignored for scalar - and fixed-size array columns, so we need not - initialize it. For variable-size arrays, the - Ith element of the sizes array must contain the size - of the Ith column entry in the column being written. - Normally, the sizes array would be reset for each - variable-size column. - - Add the columns of data to the segment. All of the - data for each column is written in one shot. - ./ - ekacli_c ( handle, segno, "order_id", ordids, - sizes, nlflgs, rcptrs, wkindx ); - - ekacli_c ( handle, segno, "customer_id", cstids, - sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "last_name", LNMLEN, - lnames, sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "first_name", FNMLEN, - fnames, sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "order_date", ets, - sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "cost", costs, - sizes, nlflgs, rcptrs, wkindx ); - - /. - Complete the segment. The rcptrs array is that - returned by ekifld_c. - ./ - ekffld_c ( handle, segno, rcptrs ); - - /. - At this point, the second segment could be - created by an analogous process. In fact, the - second segment could be created at any time; it is - not necessary to populate the first segment with - data before starting the second segment. - - The file must be closed by a call to ekcls_c. - ./ - ekcls_c ( handle ); - } - - - --Restrictions - - 1) Only one segment can be created at a time using the fast - write routines. - - 2) No other EK operation may interrupt a fast write. For - example, it is not valid to issue a query while a fast write - is in progress. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 2.0.2, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 2.0.1, 09-JAN-2002 (NJB) - - Documentation change: instances of the phrase "fast load" - were replaced with "fast write." - - -CSPICE Version 2.0.0, 07-JUL-1998 (NJB) - - Segment number is now mapped from C to Fortran range. - - -CSPICE Version 1.0.0, 01-APR-1998 (NJB) - - Based on SPICELIB Version 1.0.1, 31-MAR-1998 (NJB) - --Index_Entries - - finish a fast EK segment write - --& -*/ - -{ /* Begin ekffld_c */ - - /* - Local variables - */ - SpiceInt fSegno; - - /* - Participate in error tracing. - */ - chkin_c ( "ekffld_c" ); - - - fSegno = segno + 1; - - ekffld_ ( ( integer * ) &handle, - ( integer * ) &fSegno, - ( integer * ) rcptrs ); - - - chkout_c ( "ekffld_c" ); - -} /* End ekffld_c */ diff --git a/ext/spice/src/cspice/ekfind.c b/ext/spice/src/cspice/ekfind.c deleted file mode 100644 index 60a7d8f86e..0000000000 --- a/ext/spice/src/cspice/ekfind.c +++ /dev/null @@ -1,1333 +0,0 @@ -/* ekfind.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__27869 = 27869; -static integer c__100 = 100; -static integer c__500 = 500; - -/* $Procedure EKFIND ( EK, find data ) */ -/* Subroutine */ int ekfind_(char *query, integer *nmrows, logical *error, - char *errmsg, ftnlen query_len, ftnlen errmsg_len) -{ - extern /* Subroutine */ int zzekscan_(char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, doublereal - *, char *, integer *, integer *, logical *, char *, ftnlen, - ftnlen, ftnlen), zzeksemc_(char *, integer *, char *, logical *, - char *, integer *, ftnlen, ftnlen, ftnlen), zzekqini_(integer *, - integer *, integer *, char *, doublereal *, ftnlen), zzekpars_( - char *, integer *, integer *, integer *, integer *, integer *, - doublereal *, char *, integer *, integer *, integer *, char *, - doublereal *, logical *, char *, ftnlen, ftnlen, ftnlen, ftnlen), - zzeknres_(char *, integer *, char *, logical *, char *, integer *, - ftnlen, ftnlen, ftnlen), zzektres_(char *, integer *, char *, - doublereal *, logical *, char *, integer *, ftnlen, ftnlen, - ftnlen), chkin_(char *, ftnlen); - char eqryc[2000]; - doublereal eqryd[100]; - integer eqryi[27875], chbegs[500], chends[500]; - char chrbuf[2000]; - extern logical return_(void); - doublereal numvls[100]; - integer errptr, lxbegs[500], lxends[500], ntoken, tokens[500], values[500] - ; - extern /* Subroutine */ int chkout_(char *, ftnlen), eksrch_(integer *, - char *, doublereal *, integer *, logical *, char *, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Find E-kernel data that satisfy a set of constraints. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PARSE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I Query specifying data to be found. */ -/* NMROWS O Number of matching rows. */ -/* ERROR O Flag indicating whether query parsed correctly. */ -/* ERRMSG O Parse error description. */ - -/* $ Detailed_Input */ - -/* QUERY is a character string that specifies a set of EK */ -/* data to select from those present in currently */ -/* loaded EK files. The selected data will be */ -/* retrievable via the EK fetch routines EKGC, EKGD, */ -/* and EKGI. */ - -/* The query consists of four clauses, the third and */ -/* fourth of which are optional. The general form */ -/* of a query is */ - -/* SELECT */ -/* FROM */ -/* [WHERE ] */ -/* [ORDER BY ] */ - -/* where brackets indicate optional items. The */ -/* elements of the query shown above are called, */ -/* respectively, the `SELECT clause', the */ -/* `FROM clause', the `WHERE clause', and the */ -/* `ORDER BY clause'. The result of a query may be */ -/* thought of as a new table, whose columns are those */ -/* specified in the SELECT clause, whose rows are */ -/* those satisfying the constraints of the WHERE */ -/* clause, and whose rows are ordered according to */ -/* the ORDER BY clause. */ - -/* The SELECT clause specifies a list of columns */ -/* from which data are to be selected. In a simple */ -/* (non-join) query, these columns must belong to */ -/* the single table specified in the FROM clause. */ - -/* The form of a SELECT clause is */ - -/* SELECT [ ,...] */ - -/* In queries having multiple tables in the FROM */ -/* clause, column names are ambiguous if they occur */ -/* in more than one table in the FROM clause. Such */ -/* column names must be qualified with table */ -/* identifiers. These identifiers may be the names of */ -/* the tables to which the columns belong, or table */ -/* `aliases', names (usually short ones) associated */ -/* with tables in the FROM clause. Table aliases have */ -/* duration limited to the execution of the query to */ -/* which they belong. */ - -/* The form of a qualified column name is */ - -/*
. */ - -/* or */ - -/*
. */ - - -/* The FROM clause specifies the tables from which */ -/* data are to be selected. In simple queries, only */ -/* one table is listed. In this case the form of */ -/* the FROM clause is */ - -/* FROM
*/ - -/* In queries involving multiple tables, the form of */ -/* the FROM clause becomes */ - -/* FROM
[
] */ -/* [ ,
[
] ... ] */ - -/* The aliases associated with the table names must */ -/* be distinct and must not be the actual names of */ -/* loaded EK tables. */ - -/* Queries involving multiple tables are called */ -/* `joins'. */ - -/* The meaning of a FROM clause containing multiple */ -/* tables is that the output is to be a subset of */ -/* the rows of the Cartesian product of the listed */ -/* tables. Normally, WHERE clause constraints are */ -/* supplied to reduce the selected rows to a set of */ -/* interest. */ - -/* The most common example of a join is a query with */ -/* two tables listed in the FROM clause, and a WHERE */ -/* clause constraint enforcing equality of members */ -/* of a column in the first table with members of */ -/* column in the second table. Such a query is */ -/* called an `equi-join'. A join in which columns */ -/* of different tables are related by an inequality */ -/* is called a `non-equi-join'. Any type of join */ -/* other than an equi-join may be very slow to */ -/* evaluate, due to the large number of elements that */ -/* may be contained in the Cartesian */ -/* product of the listed tables. */ - -/* The WHERE clause lists constraints that must */ -/* be met by each row satisfying the query. The */ -/* constraints are specified as a logical combination */ -/* of relational expressions. The form of the */ -/* constraint list is */ - -/* WHERE */ - -/* where each consists of one */ -/* or more simple relational expressions of the form */ - -/* */ - -/* where */ - -/* */ - -/* is a column name, a literal value, or the special */ -/* symbol */ - -/* NULL */ - -/* and */ - -/* */ - -/* is any of */ - -/* EQ, GE, GT, LE, LIKE, LT, NE, NOT LIKE, <, <=, */ -/* =, >, >=, !=, <> */ - -/* For comparison with null values, the special */ -/* syntaxes */ - -/* IS NULL */ -/* IS NOT NULL */ - -/* are allowed, in addition to the standard */ -/* comparison syntaxes using the equality or */ -/* inequality operators. */ - -/* The LIKE operator allows comparison of a string */ -/* value against a template. The template syntax */ -/* is that allowed by the SPICELIB routine MATCHI. */ -/* Templates may include literal characters, the */ -/* wild string marker '*', and the wild character */ -/* marker '%'. Case is significant in templates. */ - -/* Templates are bracketed by quote characters, just */ -/* as are literal strings. */ - -/* The query language also supports the BETWEEN and */ -/* NOT BETWEEN constructs */ - -/* BETWEEN AND */ - -/* NOT BETWEEN AND */ - -/* The tokens */ - -/* */ -/* */ - -/* may be literal values or column names. */ - -/* The BETWEEN operator considers values that match */ -/* the bounds to satisfy the condition: the BETWEEN */ -/* operator tests for inclusion in the closed interval */ -/* defined by the bounds. */ - -/* In the WHERE clause, simple relational expressions */ -/* may be combined using the logical operators AND, */ -/* OR, and NOT, as in the Fortran programming */ -/* language. Parentheses may be used to enforce a */ -/* desired order of evaluation of logical expressions. */ - -/* The expression syntax is NOT symmetric: literal */ -/* values must not appear on the left hand side of the */ -/* operators that apply to them. */ - -/* The columns named in a constraint clause must */ -/* belong to the tables listed in the FROM clause. */ -/* If the query is a join, qualifying table names or */ -/* aliases are required wherever their omission would */ -/* result in ambiguity. */ - -/* Data types of the columns or constants used on the */ -/* right-hand-sides of operators must match the data */ -/* types of the corresponding columns on the */ -/* left-hand-sides, except that comparison of integer */ -/* and double precision quantities is permitted. */ - -/* Literal strings used in constraints are always */ -/* bracketed by quotes. Either single quotes (') */ -/* or double quotes (") may be used, but the same */ -/* quote character must be used to start and end any */ -/* literal string. Within character string values, */ -/* quote characters must be doubled in order to be */ -/* recognized. Case is significant in character */ -/* except in comparisions using the LIKE and NOT LIKE */ -/* operators, which ignore case: the expression */ - -/* ANIMAL LIKE "*A*" */ - -/* would be considered true when ANIMAL takes the */ -/* value */ - -/* "cat" */ - -/* Time values are considered to be strings and */ -/* require bracketing quotes. Currently, the */ -/* only time values allowed are UTC times in ISO */ -/* format, UTC times represented in forms accepted by */ -/* the SPICELIB routine TPARSE, and SCLK strings in */ -/* NAIF format. */ - -/* The ORDER BY clause indicates which columns to */ -/* use to order the output generated by the query. */ -/* The columns in the ORDER BY clause define a */ -/* dictionary ordering, with the first listed column */ -/* acting as a primary key, the second column acting */ -/* as a secondary key, and so on. */ - -/* For each ORDER BY column, the keywords ASC or DESC */ -/* may be supplied to indicate whether the items in */ -/* that column are to be listed in ascending or */ -/* descending order. Ascending order is the default. */ -/* The direction in which data items increase is */ -/* referred to as the `order sense'. */ - -/* The ORDER BY clause, if present, must appear */ -/* last in the query. */ - -/* The form of the ORDER BY clause is */ - -/* ORDER BY [] */ -/* [ , []...] */ - -/* Rows satisfying the query constraints will be */ -/* returned so that the entries of the first column */ -/* specified in the ORDER BY clause will be appear in */ -/* the order specified by the order sense keyword, */ -/* which is assumed to be ASC if absent. When entries */ -/* in the first through Nth ORDER BY column are equal, */ -/* the entries in the (N+1)st ORDER BY column */ -/* determine the order of the rows, and so on. */ - -/* As in the WHERE clause, column names must be */ -/* qualified by table names or table aliases where */ -/* they would otherwise be ambiguous. */ - -/* The query language is word-oriented, and some */ -/* indicate whether the words are reserved. Reserved */ -/* words must be separated from other words by white */ -/* space. It is not necessary to use white space */ -/* to separate words and punctuation characters. */ -/* The list of reserved words is */ - -/* AND */ -/* BETWEEN */ -/* BY */ -/* COLUMN */ -/* EQ */ -/* FROM */ -/* GE */ -/* GT */ -/* IS */ -/* LE */ -/* LT */ -/* LIKE */ -/* NE */ -/* NOT */ -/* NULL */ -/* OR */ -/* ORDER */ -/* SELECT */ -/* WHERE */ - -/* The left and right parenthesis characters are also */ -/* reserved; they may not be used in queries outside */ -/* of quoted strings. */ - -/* Case is not significant in queries, except within */ -/* literal strings. */ - -/* $ Detailed_Output */ - -/* NMROWS is the number of rows that match the query */ -/* criteria. NMROWS is defined if and only if */ -/* ERROR is returned .FALSE. */ - -/* ERROR is a logical flag indicating whether the query */ -/* failed to parse correctly. */ - -/* ERRMSG is a character string that describes EKFIND's */ -/* diagnosis of a parse error, should one occur. */ -/* Otherwise, ERRMSG will be returned blank. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* 1) Most of the exceptions that can occur on a call to */ -/* EKFIND are caused by errors in the input query. EKFIND */ -/* attempts to diagnose these via the output error flag and */ -/* error message, instead of signalling errors. The following */ -/* classes of errors are detected: */ - -/* Scanning errors---these result from badly formed query */ -/* in which EKFIND could not identify all of the tokens. */ -/* When these errors occur, EKFIND may be too confused to */ -/* give a helpful diagnostic message. */ - -/* Parsing errors---these result from a badly formed */ -/* query that EKFIND was able to separate into tokens */ -/* but that EKFIND determined to be syntactically invalid: */ - -/* Name resolution errors---these result from referencing */ -/* invalid or ambiguous column or table names in a query. */ - -/* Time resolution errors---these result from use of time */ -/* strings that cannot be parsed. */ - -/* Semantic errors---these result from a syntactically */ -/* valid query that violates a limit or a restriction on */ -/* values used in a query. */ - - -/* Some problems with queries are not trapped by EKFIND but */ -/* instead cause errors to be signalled. These are listed below. */ - - -/* 2) If no E-kernels are loaded at the time this routine is called, */ -/* an error will be signalled by routines called by this routine. */ - -/* 3) If a leapseconds kernel is is not loaded before this routine */ -/* is called, UTC time values may not be used in queries. If */ -/* they are, an error will be signalled by routines called by */ -/* this routine. */ - -/* 4) If an SCLK kernel for the appropriate spacecraft clock */ -/* has not been loaded before this routine is called, SCLK */ -/* values for that clock may not be used in queries. If */ -/* they are, an error will be signalled by routines called by */ -/* this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine operates almost entirely by side effects: it */ -/* prepares the EK fetch routines to return event data that */ -/* satisfy the input query. See the header of the routine */ -/* EKQMGR or the EK Required Reading for examples of use of this */ -/* routine in conjunction with the EK fetch routines. */ - -/* $ Examples */ - -/* 1) Examples of strings containing syntactically valid queries: */ - -/* SELECT COL1 FROM TAB1 */ - -/* select col1 from tab1 where col1 gt 5 */ - -/* SELECT COL2 FROM TAB1 WHERE COL2 > 5.7D0 ORDER BY COL2 */ - -/* SELECT COL2 FROM TAB1 WHERE COL1 != 5 */ - -/* SELECT COL2 FROM TAB1 WHERE COL1 GE COL2 */ - -/* SELECT COL1, COL2, COL3 FROM TAB1 ORDER BY COL1 */ - -/* SELECT COL3 FROM TAB1 WHERE COL5 EQ "ABC" */ - -/* SELECT COL3 FROM TAB1 WHERE COL5 = 'ABC' */ - -/* SELECT COL3 FROM TAB1 WHERE COL5 LIKE 'A*' */ - -/* SELECT COL3 FROM TAB1 WHERE COL5 LIKE 'A%%' */ - -/* SELECT COL4 FROM TAB1 WHERE COL4 = '1995 JAN 1 12:38:09.7' */ - -/* SELECT COL4 FROM TAB1 WHERE COL4 = "1995 JAN 1 12:38:09.7" */ - -/* SELECT COL4 FROM TAB1 WHERE */ -/* COL4 NE 'GLL SCLK 02724646:67:7:2' */ - -/* SELECT COL1 FROM TAB1 WHERE COL1 != NULL */ - -/* SELECT COL1 FROM TAB1 WHERE COL1 IS NULL */ - -/* SELECT COL1 FROM TAB1 WHERE COL1 IS NOT NULL */ - -/* SELECT COL1, COL2, COL3 FROM TAB1 */ -/* WHERE (COL1 BETWEEN 4 AND 6) AND (COL3 NOT LIKE "A%%") */ -/* ORDER BY COL1, COL3 */ - -/* SELECT COL4 FROM TAB1 */ -/* WHERE COL4 BETWEEN "1995 JAN 1 12:38" AND */ -/* "October 23, 1995" */ - -/* SELECT COL1, COL2 FROM TAB1 WHERE */ -/* NOT ( ( ( COL1 < COL2 ) AND ( COL1 > 5 ) ) OR */ -/* ( ( COL1 >= COL2 ) AND ( COL2 <= 10 ) ) ) */ - - -/* SELECT T1.COL1, T1.COL2, T2.COL2, T2.COL3 */ -/* FROM TABLE1 T1, TABLE2 T2 */ -/* WHERE T1.COL1 = T2.COL1 */ -/* AND T1.COL2 > 5 */ -/* ORDER BY T1.COL1, T2.COL2 */ - - -/* 2) Examples of syntactically invalid queries: */ - -/* SELECT TIME WHERE TIME */ -/* LT 1991 JAN 1 {FROM clause is absent} */ - -/* select time from table1 where */ -/* time lt 1991 jan 1 {time string is not */ -/* quoted} */ - -/* select time from table1 */ -/* where time .lt. '1991 jan 1' {operator should be lt} */ - -/* select cmd from table1 */ -/* where "cmd,6tmchg" != cmd {value is on left side */ -/* of operator} */ - -/* select event_type from table1 */ -/* where event_type eq "" {quoted string is empty */ -/* ---use " " to indicate */ -/* a blank string} */ - -/* select event_type from table1 */ -/* where event_type = "COMMENT" */ -/* order TIME {ORDER BY phrase is */ -/* lacking BY keyword} */ - -/* select COL1 from table where */ -/* where COL1 eq MOC_EVENT {literal string on */ -/* right-hand-side of */ -/* operator is not quoted} */ - - - -/* In the following examples, we'll assume that the program */ -/* calling EKFIND has loaded an EK containing two segments */ -/* having columns having the following names and attributes: */ - - -/* TABLE1: */ -/* ========== */ - -/* Column name Data type Size Indexed? */ -/* ----------- --------- ---- -------- */ -/* EVENT_TYPE CHARACTER*32 1 YES */ -/* EVENT_PARAMETERS CHARACTER*(*) 1 NO */ -/* COMMENT CHARACTER*80 VARIABLE NO */ - - -/* TABLE2: */ -/* ========== */ - -/* Column name Data type Size Indexed? */ -/* ----------- --------- ---- -------- */ -/* EVENT_TYPE CHARACTER*32 1 YES */ -/* EVENT_PARAMETERS CHARACTER*80 1 NO */ -/* COMMENT CHARACTER*80 VARIABLE NO */ -/* COMMAND CHARACTER*80 1 YES */ - - -/* Then the following queries are semantically invalid: */ - -/* SELECT EVENT_PARAMETERS */ -/* FROM TABLE1 */ -/* WHERE EVENT_DURATION = 7.0 {No column called */ -/* EVENT_DURATION */ -/* is present in a loaded */ -/* EK} */ - -/* SELECT COMMENT FROM TABLE2 */ -/* WHERE COMMENT EQ "N/A" {The COMMENT column does */ -/* not have size 1 and */ -/* therefore cannot be */ -/* referenced in a query} */ - -/* $ Restrictions */ - -/* 1) A leapseconds kernel must be loaded before this routine may */ -/* be called, if UTC time values are used in input queries. */ - -/* 2) An appropriate SCLK kernel must be loaded before this routine */ -/* may be called, if SCLK values are used in input queries. */ - -/* 3) Data found in response to a query become unavailable */ -/* when a fast load is initiated via EKIFLD. Any desired */ -/* fetches of the data must be performed before a fast */ -/* load or any other operation that modifies the EK scratch */ -/* area is initiated. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.0.3, 19-DEC-2001 (NJB) */ - -/* Restrictions section was updated. */ - -/* - SPICELIB Version 1.0.2, 14-JAN-1997 (NJB) */ - -/* Syntax descriptions for comparisons using null values have been */ -/* added. The $Examples section was augmented with sample queries */ -/* demonstrating use of the IS NULL and IS NOT NULL comparison */ -/* operators. */ - -/* - SPICELIB Version 1.0.1, 16-AUG-1996 (NJB) */ - -/* Exceptions section of header was updated to indicate that */ -/* calling this routine while no E-kernels are loaded will cause */ -/* an error to be signalled. Previous version line was changed */ -/* from "Beta" to "SPICELIB," and the previous version was */ -/* corrected to 1.0.0. */ - -/* - SPICELIB Version 1.0.0, 24-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find EK data */ -/* issue EK query */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Storage limits: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKFIND", (ftnlen)6); - } - -/* Initialize the encoded query each time, for safety. */ - - zzekqini_(&c__27869, &c__100, eqryi, eqryc, eqryd, (ftnlen)2000); - -/* Find the tokens in the input query. */ - - zzekscan_(query, &c__500, &c__100, &ntoken, tokens, lxbegs, lxends, - values, numvls, chrbuf, chbegs, chends, error, errmsg, query_len, - (ftnlen)2000, errmsg_len); - if (*error) { - chkout_("EKFIND", (ftnlen)6); - return 0; - } - -/* Now parse the query. */ - - zzekpars_(query, &ntoken, lxbegs, lxends, tokens, values, numvls, chrbuf, - chbegs, chends, eqryi, eqryc, eqryd, error, errmsg, query_len, ( - ftnlen)2000, (ftnlen)2000, errmsg_len); - if (*error) { - chkout_("EKFIND", (ftnlen)6); - return 0; - } - -/* Resolve names. */ - - zzeknres_(query, eqryi, eqryc, error, errmsg, &errptr, query_len, (ftnlen) - 2000, errmsg_len); - if (*error) { - chkout_("EKFIND", (ftnlen)6); - return 0; - } - -/* Resolve time values, if necessary. */ - - zzektres_(query, eqryi, eqryc, eqryd, error, errmsg, &errptr, query_len, ( - ftnlen)2000, errmsg_len); - if (*error) { - chkout_("EKFIND", (ftnlen)6); - return 0; - } - -/* Perform semantic checks. */ - - zzeksemc_(query, eqryi, eqryc, error, errmsg, &errptr, query_len, (ftnlen) - 2000, errmsg_len); - if (*error) { - chkout_("EKFIND", (ftnlen)6); - return 0; - } - -/* If we arrived here, the encoded query is ready for execution. */ -/* Find the data satisfying the constraints. */ - - eksrch_(eqryi, eqryc, eqryd, nmrows, error, errmsg, (ftnlen)2000, - errmsg_len); - chkout_("EKFIND", (ftnlen)6); - return 0; -} /* ekfind_ */ - diff --git a/ext/spice/src/cspice/ekfind_c.c b/ext/spice/src/cspice/ekfind_c.c deleted file mode 100644 index 559577ae19..0000000000 --- a/ext/spice/src/cspice/ekfind_c.c +++ /dev/null @@ -1,674 +0,0 @@ -/* - --Procedure ekfind_c ( EK, find data ) - --Abstract - - Find E-kernel data that satisfy a set of constraints. - --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 - - EK - --Keywords - - EK - PARSE - SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ekfind_c ( ConstSpiceChar * query, - SpiceInt lenout, - SpiceInt * nmrows, - SpiceBoolean * error, - SpiceChar * errmsg ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - query I Query specifying data to be found. - lenout I Declared length of output error message string. - nmrows O Number of matching rows. - error O Flag indicating whether query parsed correctly. - errmsg O Parse error description. - --Detailed_Input - - query is a character string that specifies a set of EK - data to select from those present in currently - loaded EK files. The selected data will be - retrievable via the EK fetch routines ekgc_c, ekgd_c, - and ekgi_c. - - The query consists of four clauses, the third and - fourth of which are optional. The general form - of a query is - - SELECT - FROM
- [WHERE ] - [ORDER BY ] - - where brackets indicate optional items. The - elements of the query shown above are called, - respectively, the `SELECT clause', the - `FROM clause', the `WHERE clause', and the - `ORDER BY clause'. The result of a query may be - thought of as a new table, whose columns are those - specified in the SELECT clause, whose rows are - those satisfying the constraints of the WHERE - clause, and whose rows are ordered according to - the ORDER BY clause. - - The SELECT clause specifies a list of columns - from which data are to be selected. In a simple - (non-join) query, these columns must belong to - the single table specified in the FROM clause. - - The form of a SELECT clause is - - SELECT [ ,...] - - In queries having multiple tables in the FROM - clause, column names are ambiguous if they occur - in more than one table in the FROM clause. Such - column names must be qualified with table - identifiers. These identifiers may be the names of - the tables to which the columns belong, or table - `aliases', names (usually short ones) associated - with tables in the FROM clause. Table aliases have - duration limited to the execution of the query to - which they belong. - - The form of a qualified column name is - -
. - - or - -
. - - - The FROM clause specifies the tables from which - data are to be selected. In simple queries, only - one table is listed. In this case the form of - the FROM clause is - - FROM
- - In queries involving multiple tables, the form of - the FROM clause becomes - - FROM
[
] - [ ,
[
] ... ] - - The aliases associated with the table names must - be distinct and must not be the actual names of - loaded EK tables. - - Queries involving multiple tables are called - `joins'. - - The meaning of a FROM clause containing multiple - tables is that the output is to be a subset of - the rows of the Cartesian product of the listed - tables. Normally, WHERE clause constraints are - supplied to reduce the selected rows to a set of - interest. - - The most common example of a join is a query with - two tables listed in the FROM clause, and a WHERE - clause constraint enforcing equality of members - of a column in the first table with members of - column in the second table. Such a query is - called an `equi-join'. A join in which columns - of different tables are related by an inequality - is called a `non-equi-join'. Any type of join - other than an equi-join may be very slow to - evaluate, due to the large number of elements that - may be contained in the Cartesian - product of the listed tables. - - The WHERE clause lists constraints that must - be met by each row satisfying the query. The - constraints are specified as a logical combination - of relational expressions. The form of the - constraint list is - - WHERE - - where each consists of one - or more simple relational expressions of the form - - - - where - - - - is a column name, a literal value, or the special - symbol - - NULL - - and - - - - is any of - - EQ, GE, GT, LE, LIKE, LT, NE, NOT LIKE, <, <=, - =, >, >=, !=, <> - - For comparison with null values, the special - syntaxes - - IS NULL - IS NOT NULL - - are allowed, in addition to the standard - comparison syntaxes using the equality or - inequality operators. - - The LIKE operator allows comparison of a string - value against a template. The template syntax - is that allowed by the CSPICE routine MATCHI. - Templates may include literal characters, the - wild string marker '*', and the wild character - marker '%'. Case is significant in templates. - - Templates are bracketed by quote characters, just - as are literal strings. - - The query language also supports the BETWEEN and - NOT BETWEEN constructs - - BETWEEN AND - - NOT BETWEEN AND - - The tokens - - - - - may be literal values or column names. - - The BETWEEN operator considers values that match - the bounds to satisfy the condition: the BETWEEN - operator tests for inclusion in the closed interval - defined by the bounds. - - In the WHERE clause, simple relational expressions - may be combined using the logical operators AND, - OR, and NOT, as in the Fortran programming - language. Parentheses may be used to enforce a - desired order of evaluation of logical expressions. - - The expression syntax is NOT symmetric: literal - values must not appear on the left hand side of the - operators that apply to them. - - The columns named in a constraint clause must - belong to the tables listed in the FROM clause. - If the query is a join, qualifying table names or - aliases are required wherever their omission would - result in ambiguity. - - Data types of the columns or constants used on the - right-hand-sides of operators must match the data - types of the corresponding columns on the - left-hand-sides, except that comparison of integer - and double precision quantities is permitted. - - Literal strings used in constraints are always - bracketed by quotes. Either single quotes (') - or double quotes (") may be used, but the same - quote character must be used to start and end any - literal string. Within character string values, - quote characters must be doubled in order to be - recognized. Case is significant in character - except in comparisions using the LIKE and NOT LIKE - operators, which ignore case: the expression - - ANIMAL LIKE "*A*" - - would be considered true when ANIMAL takes the - value - - "cat" - - Time values are considered to be strings and - require bracketing quotes. Currently, the - only time values allowed are UTC times in ISO - format, UTC times represented in forms accepted by - the CSPICE routine TPARSE, and SCLK strings in - NAIF format. - - The ORDER BY clause indicates which columns to - use to order the output generated by the query. - The columns in the ORDER BY clause define a - dictionary ordering, with the first listed column - acting as a primary key, the second column acting - as a secondary key, and so on. - - For each ORDER BY column, the keywords ASC or DESC - may be supplied to indicate whether the items in - that column are to be listed in ascending or - descending order. Ascending order is the default. - The direction in which data items increase is - referred to as the `order sense'. - - The ORDER BY clause, if present, must appear - last in the query. - - The form of the ORDER BY clause is - - ORDER BY [] - [ , []...] - - Rows satisfying the query constraints will be - returned so that the entries of the first column - specified in the ORDER BY clause will be appear in - the order specified by the order sense keyword, - which is assumed to be ASC if absent. When entries - in the first through Nth ORDER BY column are equal, - the entries in the (N+1)st ORDER BY column - determine the order of the rows, and so on. - - As in the WHERE clause, column names must be - qualified by table names or table aliases where - they would otherwise be ambiguous. - - The query language is word-oriented, and some - indicate whether the words are reserved. Reserved - words must be separated from other words by white - space. It is not necessary to use white space - to separate words and punctuation characters. - The list of reserved words is - - AND - BETWEEN - BY - COLUMN - EQ - FROM - GE - GT - IS - LE - LT - LIKE - NE - NOT - NULL - OR - ORDER - SELECT - WHERE - - The left and right parenthesis characters are also - reserved; they may not be used in queries outside - of quoted strings. - - Case is not significant in queries, except within - literal strings. - - - lenout is the maximum number of characters that can be - accommodated in the output string. This count - includes room for the terminating null character. - For example, if the maximum allowed length of the - output string, including the terminating null, is 25 - characters, then lenout should be set to 25. - - --Detailed_Output - - nmrows is the number of rows that match the query - criteria. nmrows is defined if and only if - error is returned as SPICEFALSE. - - error is a logical flag indicating whether the query - failed to parse correctly. - - errmsg is a character string that describes ekfind_c's - diagnosis of a parse error, should one occur. - Otherwise, errmsg will be returned blank. - --Parameters - - See the include files. - --Exceptions - - 1) Most of the exceptions that can occur on a call to - ekfind_c are caused by errors in the input query. ekfind_c - attempts to diagnose these via the output error flag and - error message, instead of signalling errors. The following - classes of errors are detected: - - Scanning errors---these result from badly formed query - in which ekfind_c could not identify all of the tokens. - When these errors occur, ekfind_c may be too confused to - give a helpful diagnostic message. - - Parsing errors---these result from a badly formed - query that ekfind_c was able to separate into tokens - but that ekfind_c determined to be syntactically invalid: - - Name resolution errors---these result from referencing - invalid or ambiguous column or table names in a query. - - Time resolution errors---these result from use of time - strings that cannot be parsed. - - Semantic errors---these result from a syntactically - valid query that violates a limit or a restriction on - values used in a query. - - - Some problems with queries are not trapped by ekfind_c but - instead cause errors to be signalled. These are listed below. - - - 2) If no E-kernels are loaded at the time this routine is called, - an error will be signalled by routines called by this routine. - - 3) If a leapseconds kernel is is not loaded before this routine - is called, UTC time values may not be used in queries. If - they are, an error will be signalled by routines called by - this routine. - - 4) If an SCLK kernel for the appropriate spacecraft clock - has not been loaded before this routine is called, SCLK - values for that clock may not be used in queries. If - they are, an error will be signalled by routines called by - this routine. - --Files - - This routine issues queries against one or more binary EKs that - have been loaded into the CSPICE query system. - --Particulars - - This routine operates almost entirely by side effects: it - prepares the EK fetch routines to return event data that - satisfy the input query. See the header of the routine - ekqmgr or the EK Required Reading for examples of use of this - routine in conjunction with the EK fetch routines. - --Examples - - 1) Examples of strings containing syntactically valid queries: - - SELECT COL1 FROM TAB1 - - select col1 from tab1 where col1 gt 5 - - SELECT COL2 FROM TAB1 WHERE COL2 > 5.7 ORDER BY COL2 - - SELECT COL2 FROM TAB1 WHERE COL1 != 5 - - SELECT COL2 FROM TAB1 WHERE COL1 GE COL2 - - SELECT COL1, COL2, COL3 FROM TAB1 ORDER BY COL1 - - SELECT COL3 FROM TAB1 WHERE COL5 EQ "ABC" - - SELECT COL3 FROM TAB1 WHERE COL5 = "ABC" - - SELECT COL3 FROM TAB1 WHERE COL5 LIKE 'A*' - - SELECT COL3 FROM TAB1 WHERE COL5 LIKE 'A%%' - - SELECT COL4 FROM TAB1 WHERE COL4 = '1995 JAN 1 12:38:09.7' - - SELECT COL4 FROM TAB1 WHERE COL4 = "1995 JAN 1 12:38:09.7" - - SELECT COL4 FROM TAB1 WHERE - COL4 NE 'GLL SCLK 02724646:67:7:2' - - SELECT COL1 FROM TAB1 WHERE COL1 != NULL - - SELECT COL1 FROM TAB1 WHERE COL1 IS NULL - - SELECT COL1 FROM TAB1 WHERE COL1 IS NOT NULL - - SELECT COL1, COL2, COL3 FROM TAB1 - WHERE (COL1 BETWEEN 4 AND 6) AND (COL3 NOT LIKE "A%%") - ORDER BY COL1, COL3 - - SELECT COL4 FROM TAB1 - WHERE COL4 BETWEEN "1995 JAN 1 12:38" AND - "October 23, 1995" - - SELECT COL1, COL2 FROM TAB1 WHERE - NOT ( ( ( COL1 < COL2 ) AND ( COL1 > 5 ) ) OR - ( ( COL1 >= COL2 ) AND ( COL2 <= 10 ) ) ) - - - SELECT T1.COL1, T1.COL2, T2.COL2, T2.COL3 - FROM TABLE1 T1, TABLE2 T2 - WHERE T1.COL1 = T2.COL1 - AND T1.COL2 > 5 - ORDER BY T1.COL1, T2.COL2 - - - 2) Examples of syntactically invalid queries: - - SELECT TIME WHERE TIME - LT 1991 JAN 1 {FROM clause is absent} - - select time from table1 where - time lt 1991 jan 1 {time string is not - quoted} - - select time from table1 - where time .lt. '1991 jan 1' {operator should be lt} - - select cmd from table1 - where "cmd,6tmchg" != cmd {value is on left side - of operator} - - select event_type from table1 - where event_type eq "" {quoted string is empty - ---use " " to indicate - a blank string} - - select event_type from table1 - where event_type = "COMMENT" - order TIME {ORDER BY phrase is - lacking BY keyword} - - select COL1 from table where - where COL1 eq MOC_EVENT {literal string on - right-hand-side of - operator is not quoted} - - - - In the following examples, we'll assume that the program - calling ekfind_c has loaded an EK containing two segments - having columns having the following names and attributes: - - - TABLE1: - ========== - - Column name Data type Size Indexed? - ----------- --------- ---- -------- - EVENT_TYPE CHARACTER*32 1 YES - EVENT_PARAMETERS CHARACTER*(*) 1 NO - COMMENT CHARACTER*80 VARIABLE NO - - - TABLE2: - ========== - - Column name Data type Size Indexed? - ----------- --------- ---- -------- - EVENT_TYPE CHARACTER*32 1 YES - EVENT_PARAMETERS CHARACTER*80 1 NO - COMMENT CHARACTER*80 VARIABLE NO - COMMAND CHARACTER*80 1 YES - - - Then the following queries are semantically invalid: - - SELECT EVENT_PARAMETERS - FROM TABLE1 - WHERE EVENT_DURATION = 7.0 {No column called - EVENT_DURATION - is present in a loaded - EK} - - SELECT COMMENT FROM TABLE2 - WHERE COMMENT EQ "N/A" {The COMMENT column does - not have size 1 and - therefore cannot be - referenced in a query} - --Restrictions - - 1) A leapseconds kernel must be loaded before this routine may - be called, if UTC time values are used in input queries. - - 2) An appropriate SCLK kernel must be loaded before this routine - may be called, if SCLK values are used in input queries. - - 3) Data found in response to a query become unavailable - when a fast load is initiated via ekifld_c. Any desired - fetches of the data must be performed before a fast - load or any other operation that modifies the EK scratch - area is initiated. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.2, 19-DEC-2001 (NJB) - - Restrictions section was updated. - - -CSPICE Version 1.1.0, 12-JUL-1998 (NJB) - - Bug fix: now uses local logical variable to capture the - error flag value returned by the underlying f2c'd routine. - - -CSPICE Version 1.0.0, 01-APR-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 25-MAR-1998 - --Index_Entries - - find EK data - issue EK query - --& -*/ - -{ /* Begin ekfind_c */ - - /* - Local variables - */ - logical fError; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekfind_c" ); - - /* - Check the query string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekfind_c", query ); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "ekfind_c", errmsg, lenout ); - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - ekfind_ ( ( char * ) query, - ( integer * ) nmrows, - ( logical * ) &fError, - ( char * ) errmsg, - ( ftnlen ) strlen(query), - ( ftnlen ) lenout-1 ); - - if ( fError ) - { - /* - If a parse error was detected, the output string errmsg will - be set. Convert the Fortran string to a C string by placing a - null after the last non-blank character. This operation is valid - whether or not the SPICELIB routine signaled an error. - */ - - F2C_ConvertStr ( lenout, errmsg ); - } - - else - { - /* - The error message may be uninitialized. Null-terminate - the message string. - */ - errmsg[0] = NULLCHAR; - } - - - *error = fError; - - - chkout_c ( "ekfind_c" ); - -} /* End ekfind_c */ diff --git a/ext/spice/src/cspice/ekgc_c.c b/ext/spice/src/cspice/ekgc_c.c deleted file mode 100644 index ca0302731c..0000000000 --- a/ext/spice/src/cspice/ekgc_c.c +++ /dev/null @@ -1,435 +0,0 @@ -/* - --Procedure ekgc_c ( EK, get event data, character ) - --Abstract - - Return an element of an entry in a column of character - type in a specified row. - --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 - - EK - --Keywords - - ASSIGNMENT - EK - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ekgc_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt lenout, - SpiceChar * cdata, - SpiceBoolean * null, - SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - selidx I Index of parent column in SELECT clause. - row I Row to fetch from. - elment I Index of element, within column entry, to fetch. - lenout I Maximum length of column element. - cdata O Character string element of column entry. - null O Flag indicating whether column entry was null. - found O Flag indicating whether column was present in row. - --Detailed_Input - - selidx is the SELECT clause index of the column to fetch - from. The range of selidx is from 0 to one less than - the number of columns in the SELECT clause. - - row is the output row containing the entry to fetch - from. The range of row is from 0 to one less than - the number of rows satisfying the previous query. - - elment is the index of the element of the column entry - to fetch. The normal range of elment is from 0 to - one less than the size of the column's entry, but - elment is allowed to exceed the number of elements in - the column entry; if it does, found is returned - as SPICEFALSE. This allows the caller to read data - from the column entry in a loop without checking the - number of available elements first. - - Null values in variable-sized columns are - considered to have size 1. - - lenout is the maximum allowed length of a string that - can be fetched into the string cdata. This length - must large enough to hold the specified element of the - column entry, plus a null terminator. If the column - element is expected to have x characters, lenout needs - to be x + 1. - - --Detailed_Output - - cdata is the requested element of the specified column - entry. If the entry is null, cdata is undefined. - - If cdata is too short to accommodate the requested - column entry element, the element is truncated on - the right to fit cdata. - - null is a logical flag indicating whether the entry - belonging to the specified column in the specified - row is null. - - found is a logical flag indicating whether the specified - element was found. If the element does not exist, - found is returned as SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If the input argument elment is less than 0, found is returned as - SPICEFALSE, and the error SPICE(INVALIDINDEX) is signalled. - However, elment is allowed to be greater than or equal to - the number of elements in the specified column entry; this allows - the caller to read data from the column entry in a loop without - checking the number of available elements first. If elment is - greater than or equal to the number of available elements, found - is returned as SPICEFALSE. - - 2) If selidx is outside of the range established by the - last query passed to eksrch_, the error SPICE(INVALIDINDEX) - will be signalled. - - 3) If the input argument row is less than 0 or greater than or - equal to the number of rows matching the query, found is returned - as SPICEFALSE, and the error SPICE(INVALIDINDEX) is signalled. - - 4) If the specified column does not have character type, the - error SPICE(INVALIDTYPE) is signalled. - - 5) If this routine is called when no E-kernels have been loaded, - the error SPICE(NOLOADEDFILES) is signalled. - --Files - - The EK "query and fetch" suite of functions reads binary `sequence - component' EK files. In order for a binary EK file to be - accessible to this routine, the file must be `loaded' via a call - to the function eklef_c. - - Text format EK files cannot be used by this routine; they must - first be converted by binary format by the NAIF Toolkit utility - SPACIT. - --Particulars - - This routine allows retrieval of data from character columns. - - This routine returns one element at a time in order to save the - caller from imposing a limit on the size of the column entries - that can be handled. - --Examples - - 1) Suppose the EK table TAB contains the following columns: - - Column name Data Type Size - ----------- --------- ---- - CHR_COL_1 CHR 1 - CHR_COL_2 CHR VARIABLE - CHR_COL_3 CHR 10 - - - Suppose the query - - query = "SELECT CHR_COL_1 FROM TAB" - - is issued to ekfind_c via the call - - ekfind_c ( query, lenout, nmrows, error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the found flags returned by ekgc_c since we know that every - entry in column CHR_COL_1 contains one element. - - /. - Since CHR_COL_1 was the first column selected, - the selection index selidx is set to 0. - The column is scalar, so the element index eltidx - is set to 0. The variable nmrows is the number of - matching rows returned by ekfind_c. - ./ - - selidx = 0; - eltidx = 0; - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nRow = %d\n\n", row ); - - /. - Fetch values from column CHR_COL_1. - ./ - ekgc_c ( selidx, row, eltidx, lenout, - cval, &isnull, &found ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - printf ( "%s\n", cval ); - } - } - - - 2) Suppose the EK table TAB is as in example 1, and we issue - the query - - query = "SELECT CHR_COL_1, CHR_COL_2, CHR_COL_3 FROM TAB" - - to ekfind_c via the call - - ekfind_c ( query, lenout, &nmrows, &error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the found flags returned by ekgc_c since we know in advance how - many elements are contained in each column entry we fetch. - - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nRow = %d\n\n", row ); - - /. - Fetch values from column CHR_COL_1. Since - CHR_COL_1 was the first column selected, the - selection index selidx is set to 0. - ./ - - selidx = 0; - eltidx = 0; - - ekgc_c ( selidx, row, eltidx, lenout, - cvals[0], &isnull, &found ); - - printf ( "\nColumn = CHR_COL_1\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - printf ( "%s\n", cvals[0] ); - } - - - /. - Fetch values from column CHR_COL_2 in the current - row. Since CHR_COL_2 contains variable-size array - entries, we call eknelt_c to determine how many - elements to fetch. - ./ - selidx = 1; - - eknelt_c ( selidx, row, &nelt ); - - eltidx = 0; - isnull = SPICEFALSE; - - while ( ( eltidx < nelt ) && ( !isnull ) ) - { - - ekgc_c ( selidx, row, eltidx, lenout, - cvals[eltidx], &isnull, &found ); - - eltidx++; - - /. - If the column entry is null, we'll be kicked - out of this loop after the first iteration. - ./ - } - - printf ( "\nColumn = CHR_COL_2\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - for ( i = 0; i < nelt; i++ ) - { - printf ( "%s\n", cvals[i] ); - } - } - - - /. - Fetch values from column CHR_COL_3 in the current - row. We need not call eknelt_c since we know how - many elements are in each column entry. - ./ - selidx = 2; - eltidx = 0; - isnull = SPICEFALSE; - - - while ( ( eltidx < 10 ) && ( !isnull ) ) - { - - ekgc_c ( selidx, row, eltidx, lenout, - cvals[eltidx], &isnull, &found ); - - eltidx++; - } - - - printf ( "\nColumn = CHR_COL_3\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - for ( i = 0; i < 10; i++ ) - { - printf ( "%s\n", cvals[i] ); - } - } - - } - - 3) See the Examples section of the query routine ekfind_c - for an example in which the names and data types of the - columns from which to fetch data are not known in advance. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 09-JUL-1998 (NJB) - - Bug fix: now uses local logical variable to capture the - error flag value returned by the underlying f2c'd routine. - - -CSPICE Version 1.0.0, 27-MAR-1998 - - Based on SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) - --Index_Entries - - fetch element from character column entry - --& -*/ - -{ /* Begin ekgc_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekgc_c" ); - - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "ekgc_c", cdata, lenout ); - - - /* - Convert indices to Fortran-style; increment each index. - */ - selidx ++; - row ++; - elment ++; - - - /* - Call the f2c'd routine. - */ - ekgc_ ( ( integer * ) &selidx, - ( integer * ) &row, - ( integer * ) &elment, - ( char * ) cdata, - ( logical * ) null, - ( logical * ) &fnd, - ( ftnlen ) lenout-1 ); - - /* - Convert the Fortran string to a C string by placing a null after the - last non-blank character. This operation is valid whether or not the - SPICELIB routine signaled an error. - */ - F2C_ConvertStr ( lenout, cdata ); - - - /* - Set the SpiceBoolean output found flag. - */ - - *found = fnd; - - - chkout_c ( "ekgc_c" ); - -} /* End ekgc_c */ diff --git a/ext/spice/src/cspice/ekgd_c.c b/ext/spice/src/cspice/ekgd_c.c deleted file mode 100644 index 35e43e9f39..0000000000 --- a/ext/spice/src/cspice/ekgd_c.c +++ /dev/null @@ -1,408 +0,0 @@ -/* - --Procedure ekgd_c ( EK, get event data, double precision ) - --Abstract - - Return an element of an entry in a column of double precision - type in a specified row. - --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 - - EK - --Keywords - - ASSIGNMENT - EK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ekgd_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceDouble * ddata, - SpiceBoolean * null, - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - selidx I Index of parent column in SELECT clause. - row I Row to fetch from. - elment I Index of element, within column entry, to fetch. - ddata O Double precision element of column entry. - null O Flag indicating whether column entry was null. - found O Flag indicating whether column was present in row. - --Detailed_Input - - selidx is the SELECT clause index of the column to fetch - from. The range of selidx is from 0 to one less than - the number of columns in the SELECT clause. - - row is the output row containing the entry to fetch - from. The range of row is from 0 to one less than - the number of rows satisfying the previous query. - - elment is the index of the element of the column entry - to fetch. The normal range of elment is from 0 to - one less than the size of the column's entry, but - elment is allowed to exceed the number of elements in - the column entry; if it does, found is returned - as SPICEFALSE. This allows the caller to read data - from the column entry in a loop without checking the - number of available elements first. - - Null values in variable-sized columns are - considered to have size 1. - --Detailed_Output - - ddata is the requested element of the specified column - entry. If the entry is null, ddata is undefined. - - null is a logical flag indicating whether the entry - belonging to the specified column in the specified - row is null. - - found is a logical flag indicating whether the specified - element was found. If the element does not exist, - found is returned as SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If the input argument elment is less than 0, found is returned as - SPICEFALSE, and the error SPICE(INVALIDINDEX) is signalled. - However, elment is allowed to be greater than or equal to - the number of elements in the specified column entry; this allows - the caller to read data from the column entry in a loop without - checking the number of available elements first. If elment is - greater than or equal to the number of available elements, found - is returned as SPICEFALSE. - - 2) If selidx is outside of the range established by the - last query passed to eksrch_, the error SPICE(INVALIDINDEX) - will be signalled. - - 3) If the input argument row is less than 0 or greater than or - equal to the number of rows matching the query, found is returned - as SPICEFALSE, and the error SPICE(INVALIDINDEX) is signalled. - - 4) If the specified column does not have double precision type, the - error SPICE(INVALIDTYPE) is signalled. - - 5) If this routine is called when no E-kernels have been loaded, - the error SPICE(NOLOADEDFILES) is signalled. - --Files - - The EK "query and fetch" suite of functions reads binary `sequence - component' EK files. In order for a binary EK file to be - accessible to this routine, the file must be `loaded' via a call - to the function eklef_c. - - Text format EK files cannot be used by this routine; they must - first be converted by binary format by the NAIF Toolkit utility - SPACIT. - --Particulars - - This routine allows retrieval of data from double precision columns. - - This routine returns one element at a time in order to save the - caller from imposing a limit on the size of the column entries - that can be handled. - --Examples - - 1) Suppose the EK table TAB contains the following columns: - - Column name Data Type Size - ----------- --------- ---- - DP_COL_1 DP 1 - DP_COL_2 DP VARIABLE - DP_COL_3 DP 10 - - - Suppose the query - - query = "SELECT DP_COL_1 FROM TAB" - - is issued to ekfind_c via the call - - ekfind_c ( query, lenout, nmrows, error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the found flags returned by ekgd_c since we know that every - entry in column DP_COL_1 contains one element. - - /. - Since DP_COL_1 was the first column selected, - the selection index selidx is set to 0. - The column is scalar, so the element index eltidx - is set to 0. The variable nmrows is the number of - matching rows returned by ekfind_c. - ./ - - selidx = 0; - eltidx = 0; - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nRow = %d\n\n", row ); - - /. - Fetch values from column DP_COL_1. - ./ - ekgd_c ( selidx, row, eltidx, - dval, &isnull, &found ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - printf ( "%f\n", dval ); - } - } - - - 2) Suppose the EK table TAB is as in example 1, and we issue - the query - - query = "SELECT DP_COL_1, DP_COL_2, DP_COL_3 FROM TAB" - - to ekfind_c via the call - - ekfind_c ( query, lenout, &nmrows, &error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the found flags returned by ekgd_c since we know in advance how - many elements are contained in each column entry we fetch. - - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nRow = %d\n\n", row ); - - /. - Fetch values from column DP_COL_1. Since - DP_COL_1 was the first column selected, the - selection index selidx is set to 0. - ./ - - selidx = 0; - eltidx = 0; - - ekgd_c ( selidx, row, eltidx, - dvals[0], &isnull, &found ) - - printf ( "\nColumn = DP_COL_1\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - printf ( "%f\n", dvals[0] ); - } - - - /. - Fetch values from column DP_COL_2 in the current - row. Since DP_COL_2 contains variable-size array - entries, we call eknelt_c to determine how many - elements to fetch. - ./ - selidx = 1; - - eknelt_c ( selidx, row, &nelt ); - - eltidx = 0; - isnull = SPICEFALSE; - - while ( ( eltidx < nelt ) && ( !isnull ) ) - { - - ekgd_c ( selidx, row, eltidx, - dvals[eltidx], &isnull, &found ); - - eltidx++; - - /. - If the column entry is null, we'll be kicked - out of this loop after the first iteration. - ./ - } - - printf ( "\nColumn = DP_COL_2\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - for ( i = 0; i < nelt; i++ ) - { - printf ( "%f\n", dvals[i] ); - } - } - - - /. - Fetch values from column DP_COL_3 in the current - row. We need not call eknelt_c since we know how - many elements are in each column entry. - ./ - selidx = 2; - eltidx = 0; - isnull = SPICEFALSE; - - - while ( ( eltidx < 10 ) && ( !isnull ) ) - { - - ekgd_c ( selidx, row, eltidx, - dvals[eltidx], &isnull, &found ); - - eltidx++; - } - - - printf ( "\nColumn = DP_COL_3\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - for ( i = 0; i < 10; i++ ) - { - printf ( "%f\n", dvals[i] ); - } - } - - } - - 3) See the Examples section of the query routine ekfind_c - for an example in which the names and data types of the - columns from which to fetch data are not known in advance. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.1, 09-FEB-2003 (EDW) - - Minor edit to correct typo in header. - - -CSPICE Version 1.1.0, 09-JUL-1998 (NJB) - - Bug fix: now uses local logical variable to capture the - error flag value returned by the underlying f2c'd routine. - - -CSPICE Version 1.0.0, 27-MAR-1998 - - Based on SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) - --Index_Entries - - fetch element from double precision column entry - --& -*/ - -{ /* Begin ekgd_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekgd_c" ); - - - /* - Convert indices to Fortran-style; increment each index. - */ - selidx ++; - row ++; - elment ++; - - - /* - Call the f2c'd routine. - */ - ekgd_ ( ( integer * ) &selidx, - ( integer * ) &row, - ( integer * ) &elment, - ( doublereal * ) ddata, - ( logical * ) null, - ( logical * ) &fnd ); - - - /* - Set the SpiceBoolean output found flag. - */ - - *found = fnd; - - - chkout_c ( "ekgd_c" ); - -} /* End ekgd_c */ diff --git a/ext/spice/src/cspice/ekgi_c.c b/ext/spice/src/cspice/ekgi_c.c deleted file mode 100644 index c5800ff9bf..0000000000 --- a/ext/spice/src/cspice/ekgi_c.c +++ /dev/null @@ -1,411 +0,0 @@ -/* - --Procedure ekgi_c ( EK, get event data, integer ) - --Abstract - - Return an element of an entry in a column of integer - type in a specified row. - --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 - - EK - --Keywords - - ASSIGNMENT - EK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ekgi_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt * idata, - SpiceBoolean * null, - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - selidx I Index of parent column in SELECT clause. - row I Row to fetch from. - elment I Index of element, within column entry, to fetch. - idata O Integer element of column entry. - null O Flag indicating whether column entry was null. - found O Flag indicating whether column was present in row. - --Detailed_Input - - selidx is the SELECT clause index of the column to fetch - from. The range of selidx is from 0 to one less than - the number of columns in the SELECT clause. - - row is the output row containing the entry to fetch - from. The range of row is from 0 to one less than - the number of rows satisfying the previous query. - - elment is the index of the element of the column entry - to fetch. The normal range of elment is from 0 to - one less than the size of the column's entry, but - elment is allowed to exceed the number of elements in - the column entry; if it does, found is returned - as SPICEFALSE. This allows the caller to read data - from the column entry in a loop without checking the - number of available elements first. - - Null values in variable-sized columns are - considered to have size 1. - --Detailed_Output - - idata is the requested element of the specified column - entry. If the entry is null, idata is undefined. - - If idata is too short to accommodate the requested - column entry element, the element is truncated on - the right to fit idata. - - null is a logical flag indicating whether the entry - belonging to the specified column in the specified - row is null. - - found is a logical flag indicating whether the specified - element was found. If the element does not exist, - found is returned as SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If the input argument elment is less than 0, found is returned as - SPICEFALSE, and the error SPICE(INVALIDINDEX) is signalled. - However, elment is allowed to be greater than or equal to - the number of elements in the specified column entry; this allows - the caller to read data from the column entry in a loop without - checking the number of available elements first. If elment is - greater than or equal to the number of available elements, found - is returned as SPICEFALSE. - - 2) If selidx is outside of the range established by the - last query passed to eksrch_, the error SPICE(INVALIDINDEX) - will be signalled. - - 3) If the input argument row is less than 0 or greater than or - equal to the number of rows matching the query, found is returned - as SPICEFALSE, and the error SPICE(INVALIDINDEX) is signalled. - - 4) If the specified column does not have integer type, the - error SPICE(INVALIDTYPE) is signalled. - - 5) If this routine is called when no E-kernels have been loaded, - the error SPICE(NOLOADEDFILES) is signalled. - --Files - - The EK "query and fetch" suite of functions reads binary `sequence - component' EK files. In order for a binary EK file to be - accessible to this routine, the file must be `loaded' via a call - to the function eklef_c. - - Text format EK files cannot be used by this routine; they must - first be converted by binary format by the NAIF Toolkit utility - SPACIT. - --Particulars - - This routine allows retrieval of data from integer columns. - - This routine returns one element at a time in order to save the - caller from imposing a limit on the size of the column entries - that can be handled. - --Examples - - 1) Suppose the EK table TAB contains the following columns: - - Column name Data Type Size - ----------- --------- ---- - INT_COL_1 INT 1 - INT_COL_2 INT VARIABLE - INT_COL_3 INT 10 - - - Suppose the query - - query = "SELECT INT_COL_1 FROM TAB" - - is issued to ekfind_c via the call - - ekfind_c ( query, lenout, nmrows, error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the found flags returned by ekgi_c since we know that every - entry in column INT_COL_1 contains one element. - - /. - Since INT_COL_1 was the first column selected, - the selection index selidx is set to 0. - The column is scalar, so the element index eltidx - is set to 0. The variable nmrows is the number of - matching rows returned by ekfind_c. - ./ - - selidx = 0; - eltidx = 0; - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nRow = %d\n\n", row ); - - /. - Fetch values from column INT_COL_1. - ./ - ekgi_c ( selidx, row, eltidx, - ival, &isnull, &found ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - printf ( "%d\n", ival ); - } - } - - - 2) Suppose the EK table TAB is as in example 1, and we issue - the query - - query = "SELECT INT_COL_1, INT_COL_2, INT_COL_3 FROM TAB" - - to ekfind_c via the call - - ekfind_c ( query, lenout, &nmrows, &error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the found flags returned by ekgi_c since we know in advance how - many elements are contained in each column entry we fetch. - - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nRow = %d\n\n", row ); - - /. - Fetch values from column INT_COL_1. Since - INT_COL_1 was the first column selected, the - selection index selidx is set to 0. - ./ - - selidx = 0; - eltidx = 0; - - ekgi_c ( selidx, row, eltidx, - ivals[0], &isnull, &found ) - - printf ( "\nColumn = INT_COL_1\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - printf ( "%d\n", ivals[0] ); - } - - - /. - Fetch values from column INT_COL_2 in the current - row. Since INT_COL_2 contains variable-size array - entries, we call eknelt_c to determine how many - elements to fetch. - ./ - selidx = 1; - - eknelt_c ( selidx, row, &nelt ); - - eltidx = 0; - isnull = SPICEFALSE; - - while ( ( eltidx < nelt ) && ( !isnull ) ) - { - - ekgi_c ( selidx, row, eltidx, - ivals[eltidx], &isnull, &found ); - - eltidx++; - - /. - If the column entry is null, we'll be kicked - out of this loop after the first iteration. - ./ - } - - printf ( "\nColumn = INT_COL_2\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - for ( i = 0; i < nelt; i++ ) - { - printf ( "%d\n", ivals[i] ); - } - } - - - /. - Fetch values from column INT_COL_3 in the current - row. We need not call eknelt_c since we know how - many elements are in each column entry. - ./ - selidx = 2; - eltidx = 0; - isnull = SPICEFALSE; - - - while ( ( eltidx < 10 ) && ( !isnull ) ) - { - - ekgi_c ( selidx, row, eltidx, - ivals[eltidx], &isnull, &found ); - - eltidx++; - } - - - printf ( "\nColumn = INT_COL_3\n\n" ); - - if ( isnull ) - { - printf ( "%s\n", "" ); - } - else - { - for ( i = 0; i < 10; i++ ) - { - printf ( "%d\n", ivals[i] ); - } - } - - } - - 3) See the Examples section of the query routine ekfind_c - for an example in which the names and data types of the - columns from which to fetch data are not known in advance. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.1, 09-FEB-2003 (EDW) - - Minor edit to correct typo in header. - - -CSPICE Version 1.1.0, 09-JUL-1998 (NJB) - - Bug fix: now uses local logical variable to capture the - error flag value returned by the underlying f2c'd routine. - - -CSPICE Version 1.0.0, 27-MAR-1998 - - Based on SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) - --Index_Entries - - fetch element from integer column entry - --& -*/ - -{ /* Begin ekgi_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekgi_c" ); - - - /* - Convert indices to Fortran-style; increment each index. - */ - selidx ++; - row ++; - elment ++; - - - /* - Call the f2c'd routine. - */ - ekgi_ ( ( integer * ) &selidx, - ( integer * ) &row, - ( integer * ) &elment, - ( integer * ) idata, - ( logical * ) null, - ( logical * ) &fnd ); - - /* - Set the SpiceBoolean output found flag. - */ - - *found = fnd; - - - chkout_c ( "ekgi_c" ); - -} /* End ekgi_c */ diff --git a/ext/spice/src/cspice/ekifld.c b/ext/spice/src/cspice/ekifld.c deleted file mode 100644 index bde01cf386..0000000000 --- a/ext/spice/src/cspice/ekifld.c +++ /dev/null @@ -1,714 +0,0 @@ -/* ekifld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKIFLD ( EK, initialize segment for fast write ) */ -/* Subroutine */ int ekifld_(integer *handle, char *tabnam, integer *ncols, - integer *nrows, char *cnames, char *decls, integer *segno, integer * - rcptrs, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - extern /* Subroutine */ int zzekmloc_(integer *, integer *, integer *, - integer *), zzeksdsc_(integer *, integer *, integer *); - integer p, mbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer stype; - extern logical failed_(void); - extern /* Subroutine */ int ekbseg_(integer *, char *, integer *, char *, - char *, integer *, ftnlen, ftnlen, ftnlen); - integer segdsc[24]; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int zzekif01_(integer *, integer *, integer *), - zzekif02_(integer *, integer *); - -/* $ Abstract */ - -/* Initialize a new E-kernel segment to allow fast writing. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TABNAM I Table name. */ -/* NCOLS I Number of columns in the segment. */ -/* NROWS I Number of rows in the segment. */ -/* CNAMES I Names of columns. */ -/* DECLS I Declarations of columns. */ -/* SEGNO O Segment number. */ -/* RCPTRS O Array of record pointers. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ -/* A new segment is to be created in this file. */ - -/* TABNAM is the name of the EK table to which the current */ -/* segment belongs. All segments in the EK file */ -/* designated by HANDLE must have identical column */ -/* attributes. TABNAM must not exceed TNAMSZ (64) */ -/* characters in length. Case is not significant. */ -/* Table names must start with a letter and contain */ -/* only characters from the set {A-Z,a-z,0-9,$,_}. */ - -/* NCOLS is the number of columns in a new segment. */ - -/* NROWS is the number of rows in a new segment. Each */ -/* column to be added to the segment must contain */ -/* the number of entries indicated by NROWS. */ - -/* CNAMES, */ -/* DECLS are, respectively, and array of column names and */ -/* their corresponding declarations: the Ith element */ -/* of CNAMES and the Ith element of DECLS apply to */ -/* the Ith column in the segment. */ - -/* Column names must not exceed CNAMSZ (32) characters */ -/* in length. Case is not significant. Column names */ -/* must start with a letter and contain only */ -/* characters from the set {A-Z,a-z,0-9,$,_}. */ - -/* The declarations are strings that contain */ -/* `keyword=value' assignments that define the */ -/* attributes of the columns to which they apply. The */ -/* column attributes that are defined by a column */ -/* declaration are: */ - -/* DATATYPE */ -/* SIZE */ -/* */ -/* */ - -/* The form of a declaration is */ - -/* 'DATATYPE = , */ -/* SIZE = , */ -/* INDEXED = , */ -/* NULLS_OK = ' */ - -/* For example, an indexed, scalar, integer column */ -/* that allows null values would have the declaration */ - -/* 'DATATYPE = INTEGER, */ -/* SIZE = 1, */ -/* INDEXED = TRUE, */ -/* NULLS_OK = TRUE' */ - -/* Commas are required to separate the assignments */ -/* within declarations; white space is optional; */ -/* case is not significant. */ - -/* The order in which the attribute keywords are */ -/* listed in declaration is not significant. */ - -/* Every column in a segment must be declared. */ - -/* Each column entry is effectively an array, each */ -/* element of which has the declared data type. The */ -/* SIZE keyword indicates how many elements are in */ -/* each entry of the column in whose declaration the */ -/* keyword appears. Note that only scalar-valued */ -/* columns (those for which SIZE = 1) may be */ -/* referenced in query constraints. A size */ -/* assignment has the syntax */ - -/* SIZE = */ - -/* or */ -/* SIZE = VARIABLE */ - -/* The size value defaults to 1 if omitted. */ - -/* The DATATYPE keyword defines the data type of */ -/* column entries. The DATATYPE assignment syntax */ -/* has any of the forms */ - -/* DATATYPE = CHARACTER*() */ -/* DATATYPE = CHARACTER*(*) */ -/* DATATYPE = DOUBLE PRECISION */ -/* DATATYPE = INTEGER */ -/* DATATYPE = TIME */ - -/* As the datatype declaration syntax suggests, */ -/* character strings may have fixed or variable */ -/* length. Variable-length strings are allowed only */ -/* in columns of size 1. */ - -/* Optionally, scalar-valued columns may be indexed. */ -/* To create an index for a column, use the assignment */ - -/* INDEXED = TRUE */ - -/* By default, columns are not indexed. */ - -/* Optionally, any column can allow null values. To */ -/* indicate that a column may allow null values, use */ -/* the assigment */ - -/* NULLS_OK = TRUE */ - -/* in the column declaration. By default, null */ -/* values are not allowed in column entries. */ - -/* $ Detailed_Output */ - -/* SEGNO is the number of the segment created by this */ -/* routine. Segment numbers are used as unique */ -/* identifiers by other EK access routines. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array must not be modified by the */ -/* caller. */ - -/* The array RCPTRS must be passed as an input to */ -/* each column addition routine called while */ -/* writing the specified segment. */ - -/* RCPTRS must be declared with dimension NROWS. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TABNAM is more than TNAMSZ characters long, the error */ -/* is diagnosed by routines called by this routine. */ - -/* 3) If TABNAM contains any nonprintable characters, the error */ -/* is diagnosed by routines called by this routine. */ - -/* 4) If NCOLS is non-positive, the error is diagnosed by routines */ -/* called by this routine. */ - -/* 5) If NROWS is non-positive, the error SPICE(INVALIDCOUNT) */ -/* is signalled. */ - -/* 6) If any column name exceeds CNAMSZ characters in length, the */ -/* error is diagnosed by routines called by this routine. */ - -/* 7) If any column name contains non-printable characters, the */ -/* error is diagnosed by routines called by this routine. */ - -/* 8) If a declaration cannot be understood by this routine, the */ -/* error is diagnosed by routines called by this routine. */ - -/* 9) If an non-positive string length or element size is specified, */ -/* the error is diagnosed by routines called by this routine. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine prepares an EK for the creation of a new segment via */ -/* the fast column writer routines. After this routine is called, */ -/* the columns of the segment are filled in by calls to the fast */ -/* column writer routines of the appropriate data types. The fast */ -/* column writer routines are: */ - -/* EKACLC {EK, add column, character} */ -/* EKACLD {EK, add column, double precision} */ -/* EKACLI {EK, add column, integer} */ - -/* When all of the columns have been added, the write operation is */ -/* completed by a call to EKFFLD {EK, finish fast write}. */ - -/* The segment is not valid until EKFFLD has been called. */ - -/* The EK system supports only one fast write at a time. It is */ -/* not possible use the fast write routines to simultaneously write */ -/* multiple segments, either in the same EK file or in different */ -/* files. */ - -/* $ Examples */ - -/* 1) Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* Below, we show how we'd open a new EK file and create the */ -/* first of the segments described above. */ - - -/* C */ -/* C Open a new EK file. For simplicity, we will not */ -/* C reserve any space for the comment area, so the */ -/* C number of reserved comment characters is zero. */ -/* C The variable IFNAME is the internal file name. */ -/* C */ -/* NRESVC = 0 */ -/* IFNAME = 'Test EK/Created 20-SEP-1995' */ - -/* CALL EKOPN ( 'ORDER_DB.EK', IFNAME, NRESVC, HANDLE ) */ - -/* C */ -/* C Set up the table and column names and declarations */ -/* C for the DATAORDERS segment. We'll index all of */ -/* C the columns. All columns are scalar, so we omit */ -/* C the size declaration. Only the COST column may take */ -/* C null values. */ -/* C */ -/* TABLE = 'DATAORDERS' */ -/* NCOLS = 6 */ - -/* CNAMES(1) = 'ORDER_ID' */ -/* CDECLS(1) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(2) = 'CUSTOMER_ID' */ -/* CDECLS(2) = 'DATATYPE = INTEGER, INDEXED = TRUE' */ - -/* CNAMES(3) = 'LAST_NAME' */ -/* CDECLS(3) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(4) = 'FIRST_NAME' */ -/* CDECLS(4) = 'DATATYPE = CHARACTER*(*),' // */ -/* . 'INDEXED = TRUE' */ - -/* CNAMES(5) = 'ORDER_DATE' */ -/* CDECLS(5) = 'DATATYPE = TIME, INDEXED = TRUE' */ - -/* CNAMES(6) = 'COST' */ -/* CDECLS(6) = 'DATATYPE = DOUBLE PRECISION,' // */ -/* . 'INDEXED = TRUE' // */ -/* . 'NULLS_OK = TRUE' */ - -/* C */ -/* C Start the segment. We presume the number of rows */ -/* C of data is known in advance. */ -/* C */ -/* CALL EKIFLD ( HANDLE, TABNAM, NCOLS, NROWS, */ -/* . CNAMES, CDECLS, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, arrays containing data for the */ -/* C segment's columns may be filled in. The names */ -/* C of the data arrays are shown below. */ -/* C */ -/* C Column Data array */ -/* C */ -/* C 'ORDER_ID' ORDIDS */ -/* C 'CUSTOMER_ID' CSTIDS */ -/* C 'LAST_NAME' LNAMES */ -/* C 'FIRST_NAME' FNAMES */ -/* C 'ORDER_DATE' ONAMES */ -/* C 'COST' COSTS */ -/* C */ - -/* [ Fill in data arrays here.] */ - -/* C */ -/* C The SIZES array shown below is ignored for scalar */ -/* C and fixed-size array columns, so we need not */ -/* C initialize it. For variable-size arrays, the */ -/* C Ith element of the SIZES array must contain the size */ -/* C of the Ith column entry in the column being written. */ -/* C Normally, the SIZES array would be reset for each */ -/* C variable-size column. */ -/* C */ -/* C The NLFLGS array indicates which entries are null. */ -/* C It is ignored for columns that don't allow null */ -/* C values. In this case, only the COST column allows */ -/* C nulls. */ -/* C */ -/* C Add the columns of data to the segment. All of the */ -/* C data for each column is written in one shot. */ -/* C */ -/* CALL EKACLI ( HANDLE, SEGNO, 'ORDER_ID', */ -/* . ORDIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLI ( HANDLE, SEGNO, 'CUSTOMER_ID', */ -/* . CSTIDS, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'LAST_NAME', */ -/* . LNAMES, SIZES, NLFLGS, WKINDX ) */ - -/* CALL EKACLC ( HANDLE, SEGNO, 'FIRST_NAME', */ -/* . FNAMES, SIZES, NLFLGS, WKINDX ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACLD ( HANDLE, SEGNO, 'ORDER_DATE', */ -/* . ODATES, SIZES, NLFLGS, WKINDX ) */ - - -/* [Set the NLFLGS array here.] */ - -/* CALL EKACLD ( HANDLE, SEGNO, 'COST', */ -/* . COSTS, SIZES, NLFLGS, WKINDX ) */ - -/* C */ -/* C Complete the segment. The RCPTRS array is that */ -/* C returned by EKIFLD. */ -/* C */ -/* CALL EKFFLD ( HANDLE, SEGNO, RCPTRS ) */ - -/* C */ -/* C At this point, the second segment could be */ -/* C created by an analogous process. In fact, the */ -/* C second segment could be created at any time; it is */ -/* C not necessary to populate the first segment with */ -/* C data before starting the second segment. */ -/* C */ - -/* C */ -/* C The file must be closed by a call to EKCLS. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) Only one segment can be created at a time using the fast */ -/* write routines. */ - -/* 2) No other EK operation may interrupt a fast write. For */ -/* example, it is not valid to issue a query while a fast write */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 10-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." Corrected value of table */ -/* name size in header comment. */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Balanced CHKIN/CHKOUT calls. */ - -/* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* start new E-kernel segment for fast writing */ -/* start new EK segment for fast writing */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKIFLD", (ftnlen)6); - } - -/* Check out NROWS. */ - - if (*nrows < 1) { - setmsg_("Number of rows must be > 0, was #. ", (ftnlen)35); - errint_("#", nrows, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("EKIFLD", (ftnlen)6); - return 0; - } - -/* Create the segment's metadata. */ - - ekbseg_(handle, tabnam, ncols, cnames, decls, segno, tabnam_len, - cnames_len, decls_len); - if (failed_()) { - chkout_("EKIFLD", (ftnlen)6); - return 0; - } - -/* Fill the number of rows into the (file's) segment descriptor. */ - - zzekmloc_(handle, segno, &p, &mbase); - i__1 = mbase + 6; - i__2 = mbase + 6; - dasudi_(handle, &i__1, &i__2, nrows); - -/* Read in the segment descriptor, and get the segment's type. */ - - zzeksdsc_(handle, segno, segdsc); - stype = segdsc[0]; - -/* Complete the fast write preparations appropriate to the segment's */ -/* type. */ - - if (stype == 1) { - zzekif01_(handle, segno, rcptrs); - } else if (stype == 2) { - zzekif02_(handle, segno); - } else { - setmsg_("Segment type # is not currently supported.", (ftnlen)42); - errint_("#", &stype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("EKIFLD", (ftnlen)6); - return 0; - } - chkout_("EKIFLD", (ftnlen)6); - return 0; -} /* ekifld_ */ - diff --git a/ext/spice/src/cspice/ekifld_c.c b/ext/spice/src/cspice/ekifld_c.c deleted file mode 100644 index 779ac1bd99..0000000000 --- a/ext/spice/src/cspice/ekifld_c.c +++ /dev/null @@ -1,677 +0,0 @@ -/* - --Procedure ekifld_c ( EK, initialize segment for fast write ) - --Abstract - - Initialize a new E-kernel segment to allow fast writing. - --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 - - EK - --Keywords - - EK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekifld_c - - - void ekifld_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt nrows, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno, - SpiceInt * rcptrs ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I File handle. - tabnam I Table name. - ncols I Number of columns in the segment. - nrows I Number of rows in the segment. - cnmlen I Length of names in in column name array. - cnames I Names of columns. - declen I Length of declaration strings in declaration array. - decls I Declarations of columns. - segno O Segment number. - rcptrs O Array of record pointers. - --Detailed_Input - - handle is the handle of an EK file open for write access. - A new segment is to be created in this file. - - tabnam is the name of the EK table to which the current - segment belongs. All segments in the EK file - designated by handle must have identical column - attributes. tabnam must not exceed SPICE_EK_TNAMSZ - (see SpiceEK.h) characters in length. Case is not - significant. Table names must start with a letter - and contain only characters from the set - {A-Z,a-z,0-9,$,_}. - - ncols is the number of columns in a new segment. - - nrows is the number of rows in a new segment. Each - column to be added to the segment must contain - the number of entries indicated by nrows. - - cnmlen, - cnames are, respectively, the length of the column name - strings in the column name array, and the base - address of the array itself. The array should have - dimensions - - [ncols][cnmlen] - - declen, - decls are, respectively, the length of the declaration - strings in the declaration array, and the base - address of the array itself. The array should have - dimensions - - [ncols][declen] - - The Ith element of cnames and the Ith element of decls - apply to the Ith column in the segment. - - Column names must not exceed SPICE_EK_CNAMSZ (see - SpiceEK.h) characters in length. Case is not - significant. Column names must start with a letter - and contain only characters from the set - {A-Z,a-z,0-9,$,_}. - - The declarations are strings that contain - `keyword=value' assignments that define the - attributes of the columns to which they apply. The - column attributes that are defined by a column - declaration are: - - DATATYPE - SIZE - - - - The form of a declaration is - - "DATATYPE = , - SIZE = , - INDEXED = , - NULLS_OK = " - - For example, an indexed, scalar, integer column - that allows null values would have the declaration - - "DATATYPE = INTEGER, - SIZE = 1, - INDEXED = TRUE, - NULLS_OK = TRUE" - - Commas are required to separate the assignments - within declarations; white space is optional; - case is not significant. - - The order in which the attribute keywords are - listed in declaration is not significant. - - Every column in a segment must be declared. - - Each column entry is effectively an array, each - element of which has the declared data type. The - SIZE keyword indicates how many elements are in - each entry of the column in whose declaration the - keyword appears. Note that only scalar-valued - columns (those for which SIZE = 1) may be - referenced in query constraints. A size - assignment has the syntax - - SIZE = - - or - SIZE = VARIABLE - - The size value defaults to 1 if omitted. - - The DATATYPE keyword defines the data type of - column entries. The DATATYPE assignment syntax - has any of the forms - - DATATYPE = CHARACTER*() - DATATYPE = CHARACTER*(*) - DATATYPE = DOUBLE PRECISION - DATATYPE = INTEGER - DATATYPE = TIME - - As the datatype declaration syntax suggests, - character strings may have fixed or variable - length. Variable-length strings are allowed only - in columns of size 1. - - Optionally, scalar-valued columns may be indexed. - To create an index for a column, use the assignment - - INDEXED = TRUE - - By default, columns are not indexed. - - Optionally, any column can allow null values. To - indicate that a column may allow null values, use - the assigment - - NULLS_OK = TRUE - - in the column declaration. By default, null - values are not allowed in column entries. - --Detailed_Output - - segno is the number of the segment to which data is to be - added. Segments are numbered from 0 to nseg-1, where - nseg is the count of segments in the file. Segment - numbers are used as unique identifiers by other EK - access routines. - - rcptrs is an array of record pointers for the input - segment. This array must not be modified by the - caller. - - The array rcptrs must be passed as an input to - each column addition routine called while - writing the specified segment. - - rcptrs must be declared with dimension nrows. - - --Parameters - - None. - --Exceptions - - 1) If HANDLE is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If TABNAM is more than SPICE_EK_TNAMSZ characters long, the - error is diagnosed by routines called by this routine. - - 3) If TABNAM contains any nonprintable characters, the error - is diagnosed by routines called by this routine. - - 4) If NCOLS is non-positive, the error is diagnosed by routines - called by this routine. - - 5) If NROWS is non-positive, the error SPICE(INVALIDCOUNT) - is signalled. - - 6) If any column name exceeds SPICE_EK_CNAMSZ characters in length, - the error is diagnosed by routines called by this routine. - - 7) If any column name contains non-printable characters, the - error is diagnosed by routines called by this routine. - - 8) If a declaration cannot be understood by this routine, the - error is diagnosed by routines called by this routine. - - 9) If an non-positive string length or element size is specified, - the error is diagnosed by routines called by this routine. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine prepares an EK for the creation of a new segment via - the fast column writer routines. After this routine is called, - the columns of the segment are filled in by calls to the fast - column writer routines of the appropriate data types. The fast - column writer routines are: - - ekaclc_c {EK, add column, character} - ekacld_c {EK, add column, double precision} - ekacli_c {EK, add column, integer} - - When all of the columns have been added, the write operation is - completed by a call to ekffld_c {EK, finish fast write}. - - The segment is not valid until ekffld_c has been called. - - The EK system supports only one fast write at a time. It is - not possible use the fast write routines to simultaneously write - multiple segments, either in the same EK file or in different - files. - --Examples - - 1) Suppose we have an E-kernel named ORDER_DB.EK which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file ORDER_DB.EK contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - Below, we show how we'd open a new EK file and create the - first of the segments described above. - - - #include "SpiceUsr.h" - #include - - - void main() - { - /. - Constants - ./ - #define CNMLEN ( CSPICE_EK_COL_NAM_LEN + 1 ) - #define DECLEN 201 - #define EKNAME "order_db.ek" - #define FNMLEN 50 - #define IFNAME "Test EK/Created 20-SEP-1995" - #define LNMLEN 50 - #define LSK "leapseconds.ker" - #define NCOLS 6 - #define NRESVC 0 - #define NROWS 9 - #define TABLE "DATAORDERS" - #define TNMLEN CSPICE_EK_TAB_NAM_LEN - #define UTCLEN 30 - - - /. - Local variables - ./ - SpiceBoolean nlflgs [ NROWS ]; - - SpiceChar cdecls [ NCOLS ] [ DECLEN ]; - SpiceChar cnames [ NCOLS ] [ CNMLEN ]; - SpiceChar fnames [ NROWS ] [ FNMLEN ]; - SpiceChar lnames [ NROWS ] [ LNMLEN ]; - SpiceChar dateStr [ UTCLEN ]; - - SpiceDouble costs [ NROWS ]; - SpiceDouble ets [ NROWS ]; - - SpiceInt cstids [ NROWS ]; - SpiceInt ordids [ NROWS ]; - SpiceInt handle; - SpiceInt i; - SpiceInt rcptrs [ NROWS ]; - SpiceInt segno; - SpiceInt sizes [ NROWS ]; - SpiceInt wkindx [ NROWS ]; - - - /. - Load a leapseconds kernel for UTC/ET conversion. - ./ - furnsh_c ( LSK ); - - /. - Open a new EK file. For simplicity, we will not - reserve any space for the comment area, so the - number of reserved comment characters is zero. - The constant IFNAME is the internal file name. - ./ - ekopn_c ( EKNAME, IFNAME, NRESVC, &handle ); - - /. - Set up the table and column names and declarations - for the DATAORDERS segment. We'll index all of - the columns. All columns are scalar, so we omit - the size declaration. Only the COST column may take - null values. - ./ - strcpy ( cnames[0], "ORDER_ID" ); - strcpy ( cdecls[0], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[1], "CUSTOMER_ID" ); - strcpy ( cdecls[1], "DATATYPE = INTEGER, INDEXED = TRUE" ); - - strcpy ( cnames[2], "LAST_NAME" ); - strcpy ( cdecls[2], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[3], "FIRST_NAME" ); - strcpy ( cdecls[3], "DATATYPE = CHARACTER*(*)," - "INDEXED = TRUE" ); - - strcpy ( cnames[4], "ORDER_DATE" ); - strcpy ( cdecls[4], "DATATYPE = TIME, INDEXED = TRUE" ); - - strcpy ( cnames[5], "COST" ); - strcpy ( cdecls[5], "DATATYPE = DOUBLE PRECISION," - "INDEXED = TRUE," - "NULLS_OK = TRUE" ); - - /. - Start the segment. We presume the number of rows - of data is known in advance. - ./ - ekifld_c ( handle, TABLE, NCOLS, NROWS, CNMLEN, - cnames, DECLEN, cdecls, &segno, rcptrs ); - - /. - At this point, arrays containing data for the - segment's columns may be filled in. The names - of the data arrays are shown below. - - Column Data array - - "ORDER_ID" ordids - "CUSTOMER_ID" cstids - "LAST_NAME" lnames - "FIRST_NAME" fnames - "ORDER_DATE" odates - "COST" costs - - - The null flags array indicates which entries are null. - It is ignored for columns that don't allow null - values. In this case, only the COST column allows - nulls. - - Fill in data arrays and null flag arrays here. This code - section would normally be replaced by calls to user functions - returning column values. - ./ - - for ( i = 0; i < NROWS; i++ ) - { - ordids[i] = i; - cstids[i] = i*100; - costs [i] = (SpiceDouble) 100*i; - - sprintf ( fnames[i], "Order %d Customer first name", i ); - sprintf ( lnames[i], "Order %d Customer last name", i ); - sprintf ( dateStr, "1998 Mar %d", i ); - - utc2et_c ( dateStr, ets+i ); - - nlflgs[i] = SPICEFALSE; - } - - nlflgs[1] = SPICETRUE; - - - /. - The sizes array shown below is ignored for scalar - and fixed-size array columns, so we need not - initialize it. For variable-size arrays, the - Ith element of the sizes array must contain the size - of the Ith column entry in the column being written. - Normally, the sizes array would be reset for each - variable-size column. - - Add the columns of data to the segment. All of the - data for each column is written in one shot. - ./ - ekacli_c ( handle, segno, "order_id", ordids, - sizes, nlflgs, rcptrs, wkindx ); - - ekacli_c ( handle, segno, "customer_id", cstids, - sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "last_name", LNMLEN, - lnames, sizes, nlflgs, rcptrs, wkindx ); - - ekaclc_c ( handle, segno, "first_name", FNMLEN, - fnames, sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "order_date", ets, - sizes, nlflgs, rcptrs, wkindx ); - - ekacld_c ( handle, segno, "cost", costs, - sizes, nlflgs, rcptrs, wkindx ); - - /. - Complete the segment. The rcptrs array is that - returned by ekifld_c. - ./ - ekffld_c ( handle, segno, rcptrs ); - - /. - At this point, the second segment could be - created by an analogous process. In fact, the - second segment could be created at any time; it is - not necessary to populate the first segment with - data before starting the second segment. - - The file must be closed by a call to ekcls_c. - ./ - ekcls_c ( handle ); - } - - --Restrictions - - 1) Only one segment can be created at a time using the fast - write routines. - - 2) No other EK operation may interrupt a fast write. For - example, it is not valid to issue a query while a fast write - is in progress. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 2.3.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 2.3.0, 12-JUL-2002 (NJB) - - Call to C2F_CreateStrArr_Sig replaced with call to C2F_MapStrArr. - - -CSPICE Version 2.2.0, 10-JAN-2002 (NJB) - - Const-qualified input arrays. Added casts to type (void *) - to expressions passed to free(), in order to suppress compilation - warnings under MS Visual C++/C. - - Documentation change: instances of the phrase "fast load" - were replaced with "fast write." - - Corrected parameter names giving maximum table and column name - lengths. - - -CSPICE Version 2.1.0, 14-FEB-2000 (NJB) - - Calls to C2F_CreateStrArr replaced with calls to error-signaling - version of this routine: C2F_CreateStrArr_Sig. - - -CSPICE Version 2.0.0, 07-JUL-1999 (NJB) - - Output segment number segno is now mapped to C range. - - -CSPICE Version 1.0.0, 08-MAR-1999 (NJB) - - Based on SPICELIB Version 1.0.0, 25-OCT-1995 (NJB) - --Index_Entries - - start new E-kernel segment for fast writing - start new EK segment for fast writing - --& -*/ - -{ /* Begin ekifld_c */ - - /* - Local variables - */ - SpiceChar * fCnameArr; - SpiceChar * fCdeclArr; - - SpiceInt fCnameLen; - SpiceInt fCdeclLen; - - - - /* - Participate in error tracing. - */ - chkin_c ( "ekifld_c" ); - - - /* - Check the table name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekifld_c", tabnam ); - - /* - Check the column name array to make sure the pointer is non-null - and the string length is non-zero. Note: this check is normally - done for output strings: CHKOSTR is the macro that does the job. - */ - CHKOSTR ( CHK_STANDARD, "ekifld_c", cnames, cnmlen ); - - /* - Check the declaration array to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKOSTR ( CHK_STANDARD, "ekifld_c", decls, declen ); - - /* - Create a Fortran-style array of column names. - */ - - C2F_MapStrArr ( "ekifld_c", - ncols, cnmlen, cnames, &fCnameLen, &fCnameArr ); - - if ( failed_c() ) - { - chkout_c ( "ekifld_c" ); - return; - } - - - /* - Produce a Fortran-style array for the declarations, as we did for - the column names. - */ - C2F_MapStrArr ( "ekifld_c", - ncols, declen, decls, &fCdeclLen, &fCdeclArr ); - - if ( failed_c() ) - { - free ( (void *) fCnameArr ); - - chkout_c ( "ekifld_c" ); - return; - } - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - ekifld_ ( ( integer * ) &handle, - ( char * ) tabnam, - ( integer * ) &ncols, - ( integer * ) &nrows, - ( char * ) fCnameArr, - ( char * ) fCdeclArr, - ( integer * ) segno, - ( integer * ) rcptrs, - ( ftnlen ) strlen(tabnam), - ( ftnlen ) fCnameLen, - ( ftnlen ) fCdeclLen ); - - /* - Clean up all of our dynamically allocated arrays. - */ - free ( (void *) fCnameArr ); - free ( (void *) fCdeclArr ); - - /* - Map segno to C style range. - */ - - (*segno)--; - - - chkout_c ( "ekifld_c" ); - -} /* End ekifld_c */ diff --git a/ext/spice/src/cspice/ekinsr.c b/ext/spice/src/cspice/ekinsr.c deleted file mode 100644 index 5ad01ab023..0000000000 --- a/ext/spice/src/cspice/ekinsr.c +++ /dev/null @@ -1,1094 +0,0 @@ -/* ekinsr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__254 = 254; -static integer c_n1 = -1; -static integer c__252 = 252; -static integer c__3 = 3; -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure EKINSR ( EK, insert record into segment ) */ -/* Subroutine */ int ekinsr_(integer *handle, integer *segno, integer *recno) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Local variables */ - integer base, nrec, size, room; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekrbck_(char *, integer *, integer *, integer *, integer *, - ftnlen), zzekmloc_(integer *, integer *, integer *, integer *), - zzekpgbs_(integer *, integer *, integer *), zzektrin_(integer *, - integer *, integer *, integer *); - integer p, mbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), filli_(integer *, - integer *, integer *); - integer ncols, lastp, lastw; - extern logical failed_(void); - integer coldsc[11], mp; - extern logical return_(void); - integer nlinks, recbas, recptr[254], segdsc[24]; - logical isshad; - extern /* Subroutine */ int chkout_(char *, ftnlen), dasrdi_(integer *, - integer *, integer *, integer *), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), - cleari_(integer *, integer *), ekshdw_(integer *, logical *), - dasudi_(integer *, integer *, integer *, integer *), zzekaps_( - integer *, integer *, integer *, logical *, integer *, integer *); - -/* $ Abstract */ - -/* Add a new, empty record to a specified E-kernel segment at */ -/* a specified index. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RECNO I Record number. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGNO is the number of the segment to which the record */ -/* is to be added. */ - -/* RECNO is the index of the new record. RECNO must be */ -/* in the range 1 : (NREC+1), where NREC is the */ -/* number of records in the segment prior to the */ -/* insertion. If RECNO is equal to NREC+1, the */ -/* new record is appended. Otherwise, the new */ -/* record has the ordinal position specified by */ -/* RECNO, and the records previously occupying */ -/* positions RECNO : NREC have their indexes */ -/* incremented by 1. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If SEGNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 3) If RECNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 4) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: It adds a new, empty */ -/* record structure to an EK segment at a specified ordinal position. */ - -/* After a record has been inserted into a segment by this routine, */ -/* the record must be populated with data using the EKACEx */ -/* routines. EKs are valid only when all of their column entries */ -/* are initialized. */ - -/* To append a record to a segment, use the routine EKAPPR. */ - -/* This routine cannot be used with the "fast write" suite of */ -/* routines. See the EK Required Reading for a discussion of the */ -/* fast writers. */ - -/* When a record is inserted into an EK file that is not shadowed, */ -/* the status of the record starts out set to OLD. The status */ -/* does not change when data is added to the record. */ - -/* If the target EK is shadowed, the new record will be given the */ -/* status NEW. Updating column values in the record does not change */ -/* its status. When changes are committed, the status is set to OLD. */ -/* If a rollback is performed before changes are committed, the */ -/* record is deleted. Closing the target file without committing */ -/* changes implies a rollback. */ - -/* $ Examples */ - -/* 1) Insert a record into a specified E-kernel segment at a */ -/* specified ordinal position. */ - -/* Suppose we have an E-kernel named ORDER_DB.EK which contains */ -/* records of orders for data products. The E-kernel has a */ -/* table called DATAORDERS that consists of the set of columns */ -/* listed below: */ - -/* DATAORDERS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ORDER_ID INTEGER */ -/* CUSTOMER_ID INTEGER */ -/* LAST_NAME CHARACTER*(*) */ -/* FIRST_NAME CHARACTER*(*) */ -/* ORDER_DATE TIME */ -/* COST DOUBLE PRECISION */ - -/* The order database also has a table of items that have been */ -/* ordered. The columns of this table are shown below: */ - -/* DATAITEMS */ - -/* Column Name Data Type */ -/* ----------- --------- */ -/* ITEM_ID INTEGER */ -/* ORDER_ID INTEGER */ -/* ITEM_NAME CHARACTER*(*) */ -/* DESCRIPTION CHARACTER*(*) */ -/* PRICE DOUBLE PRECISION */ - - -/* We'll suppose that the file ORDER_DB.EK contains two segments, */ -/* the first containing the DATAORDERS table and the second */ -/* containing the DATAITEMS table. */ - -/* If we wanted to insert a new record into the DATAORDERS */ -/* table in position 1, we'd make the following calls: */ - -/* C */ -/* C Open the database for write access. */ -/* C */ -/* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */ - -/* C */ -/* C Insert a new, empty record into the DATAORDERS */ -/* C table at record number 1. This moves the existing */ -/* C records down, so the old record 1 becomes record 2, */ -/* C and so on. Recall that the DATAORDERS table */ -/* C is in segment number 1. */ -/* C */ -/* RECNO = 1 */ -/* SEGNO = 1 */ - -/* CALL EKINSR ( HANDLE, SEGNO, RECNO ) */ - -/* C */ -/* C At this point, the new record is empty. A valid EK */ -/* C cannot contain empty records. We fill in the data */ -/* C here. Data items are filled in one column at a time. */ -/* C The order in which the columns are filled in is not */ -/* C important. We use the EKACEx (add column entry) */ -/* C routines to fill in column entries. We'll assume */ -/* C that no entries are null. All entries are scalar, */ -/* C so the entry size is 1. */ -/* C */ -/* ISNULL = .FALSE. */ -/* ESIZE = 1 */ - -/* C */ -/* C The following variables will contain the data for */ -/* C the new record. */ -/* C */ -/* ORDID = 10011 */ -/* CUSTID = 531 */ -/* LNAME = 'Scientist' */ -/* FNAME = 'Joe' */ -/* ODATE = '1995-SEP-20' */ -/* COST = 0.D0 */ - -/* C */ -/* C Note that the names of the routines called */ -/* C correspond to the data types of the columns: the */ -/* C last letter of the routine name is C, I, or D, */ -/* C depending on the data type. Time values are */ -/* C converted to ET for storage. */ -/* C */ -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */ -/* . SIZE, ORDID, ISNULL ) */ - -/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */ -/* . SIZE, CUSTID, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */ -/* . SIZE, LNAME, ISNULL ) */ - -/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */ -/* . SIZE, FNAME, ISNULL ) */ - - -/* CALL UTC2ET ( ODATE, ET ) */ -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */ -/* . SIZE, ET, ISNULL ) */ - -/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */ -/* . SIZE, COST, ISNULL ) */ - -/* C */ -/* C Close the file to make the update permanent. */ -/* C */ -/* CALL EKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert record into EK segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKINSR", (ftnlen)6); - } - -/* Before trying to actually write anything, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("EKINSR", (ftnlen)6); - return 0; - } - -/* Look up the integer metadata page and page base for the segment. */ -/* Given the base address, we can read the pertinent metadata in */ -/* one shot. */ - - zzekmloc_(handle, segno, &mp, &mbase); - if (failed_()) { - chkout_("EKINSR", (ftnlen)6); - return 0; - } - i__1 = mbase + 1; - i__2 = mbase + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - size = ncols + 2; - -/* We're assuming the record pointer can fit on an integer page. */ -/* If this is not the case, we've got a bug. */ - - if (size > 254) { - setmsg_("Record pointer requires # integer words; EK software assume" - "s size is <= #. This is an EK software bug. Contact NAIF.", - (ftnlen)118); - errint_("#", &size, (ftnlen)1); - errint_("#", &c__254, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("EKINSR", (ftnlen)6); - return 0; - } - -/* Check the number of records already present. RECNO must not */ -/* exceed this count by more than 1. */ - - nrec = segdsc[5]; - if (*recno < 1 || *recno > nrec + 1) { - setmsg_("Record number = #; valid range is 1:#.", (ftnlen)38); - errint_("#", recno, (ftnlen)1); - i__1 = nrec + 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKINSR", (ftnlen)6); - return 0; - } - -/* Find the last integer data page and the last word in use in that */ -/* page. If there's enough room, we can store the record pointer */ -/* in the current page. */ - - lastp = segdsc[17]; - lastw = segdsc[20]; - room = 254 - lastw; - -/* Initialize the record pointer: set the record's status and */ -/* set the data pointers to indicate no data is present. To */ -/* determine the status, we must know whether the parent file is */ -/* shadowed. */ - - cleari_(&c__254, recptr); - filli_(&c_n1, &c__252, recptr); - ekshdw_(handle, &isshad); - if (isshad) { - recptr[0] = 3; - } else { - recptr[0] = 1; - } - -/* Find a place to write the record pointer. */ - - if (size <= room) { - -/* Just write the record pointer into the current integer page. */ - - zzekpgbs_(&c__3, &lastp, &base); - recbas = base + lastw; - i__1 = recbas + 1; - i__2 = recbas + size; - dasudi_(handle, &i__1, &i__2, recptr); - -/* Update the page's metadata to reflect the addition. The */ -/* page gains a link. */ - - i__1 = base + 256; - i__2 = base + 256; - dasrdi_(handle, &i__1, &i__2, &nlinks); - i__1 = base + 256; - i__2 = base + 256; - i__3 = nlinks + 1; - dasudi_(handle, &i__1, &i__2, &i__3); - -/* The last integer word in use has changed too. */ - - segdsc[20] += size; - } else { - -/* Allocate an integer page. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &recbas); - -/* Write out the record pointer. */ - - i__1 = recbas + 1; - i__2 = recbas + size; - dasudi_(handle, &i__1, &i__2, recptr); - -/* Update the page's metadata to reflect the addition. The */ -/* page starts out with one link. */ - - i__1 = recbas + 256; - i__2 = recbas + 256; - dasudi_(handle, &i__1, &i__2, &c__1); - -/* Update the segment's metadata to reflect the addition of a */ -/* data page. The last page in use is the one we just wrote to. */ -/* The last word in use is the last word of the record pointer. */ - - segdsc[17] = p; - segdsc[20] = size; - } - -/* Update the segment's metadata to reflect the addition of the */ -/* new record. The base address of the record is inserted into */ -/* the data record tree at index RECNO. The record count gets */ -/* incremented. */ - - zzektrin_(handle, &segdsc[6], recno, &recbas); - ++segdsc[5]; - -/* If the segment is shadowed but no backup segment exists yet, we */ -/* need to create one. We'll let ZZEKRBCK take care of the details. */ -/* Note that for data additions, the input argument COLDSC is */ -/* ignored. */ - - zzekrbck_("ADD", handle, segdsc, coldsc, recno, (ftnlen)3); - -/* Write out the updated segment descriptor. */ - - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - chkout_("EKINSR", (ftnlen)6); - return 0; -} /* ekinsr_ */ - diff --git a/ext/spice/src/cspice/ekinsr_c.c b/ext/spice/src/cspice/ekinsr_c.c deleted file mode 100644 index 0a4c0bdade..0000000000 --- a/ext/spice/src/cspice/ekinsr_c.c +++ /dev/null @@ -1,294 +0,0 @@ -/* - --Procedure ekinsr_c ( EK, insert record into segment ) - --Abstract - - Add a new, empty record to a specified E-kernel segment at - a specified index. - --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 - - EK - --Keywords - - EK - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ekinsr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I File handle. - segno I Segment number. - recno I Record number. - --Detailed_Input - - handle is a file handle of an EK open for write access. - - segno is the number of the segment to which the record - is to be added. - - recno is the index of the new record. recno must be - in the range 0 : NREC, where NREC is the - number of records in the segment prior to the - insertion. If recno is equal to NREC, the - new record is appended. Otherwise, the new - record has the ordinal position specified by - recno, and the records previously occupying - positions recno : NREC-1 have their indices - incremented by 1. - --Detailed_Output - - None. See the $Particulars section for a description of the - effect of this routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. The file will not be modified. - - 2) If segno is out of range, the error SPICE(INVALIDINDEX) - will be signaled. The file will not be modified. - - 3) If recno is out of range, the error SPICE(INVALIDINDEX) - will be signaled. The file will not be modified. - - 4) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. The file may be corrupted. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: It adds a new, empty - record structure to an EK segment at a specified ordinal position. - - After a record has been inserted into a segment by this routine, - the record must be populated with data using the ekace*_c - routines. EKs are valid only when all of their column entries - are initialized. - - To append a record to a segment, use the routine ekappr_c. - - This routine cannot be used with the "fast write" suite of - routines. See the EK Required Reading for a discussion of the - fast writers. - --Examples - - 1) Insert a record into a specified E-kernel segment at a - specified ordinal position. - - Suppose we have an E-kernel named order_db.ek which contains - records of orders for data products. The E-kernel has a - table called DATAORDERS that consists of the set of columns - listed below: - - DATAORDERS - - Column Name Data Type - ----------- --------- - ORDER_ID INTEGER - CUSTOMER_ID INTEGER - LAST_NAME CHARACTER*(*) - FIRST_NAME CHARACTER*(*) - ORDER_DATE TIME - COST DOUBLE PRECISION - - The order database also has a table of items that have been - ordered. The columns of this table are shown below: - - DATAITEMS - - Column Name Data Type - ----------- --------- - ITEM_ID INTEGER - ORDER_ID INTEGER - ITEM_NAME CHARACTER*(*) - DESCRIPTION CHARACTER*(*) - PRICE DOUBLE PRECISION - - - We'll suppose that the file order_db.ek contains two segments, - the first containing the DATAORDERS table and the second - containing the DATAITEMS table. - - If we wanted to insert a new record into the DATAORDERS - table in position 0, we'd make the following calls: - - - - - EKCLS ( HANDLE ) - #include "SpiceUsr.h" - . - . - . - /. - Open the database for write access. This call is - made when the file already exists. See ekopn_c for - an example of creating a new file. - ./ - ekopw_c ( "order_db.ek", &handle ); - - /. - Insert a new, empty record into the DATAORDERS - table at record number 0. This moves the existing - records down, so the old record 0 becomes record 1, - and so on. Recall that the DATAORDERS table - is in segment number 0. - ./ - recno = 0; - segno = 0; - - ekinsr_c ( handle, segno, recno ); - - /. - At this point, the new record is empty. A valid EK - cannot contain empty records. We fill in the data - here. Data items are filled in one column at a time. - The order in which the columns are filled in is not - important. We use the ekace*_c (add column entry) - routines to fill in column entries. We'll assume - that no entries are null. All entries are scalar, - so the entry size is 1. - ./ - isnull = SPICEFALSE; - size = 1; - - /. - The following variables will contain the data for - the new record. - ./ - ordid = 10011; - custid = 531; - lname = "scientist"; - fname = "joe"; - odate = "1995-sep-20"; - cost = 5000.; - - /. - Note that the names of the routines called - correspond to the data types of the columns: the - last letter of the routine name is C, I, or D, - depending on the data type. Time values are - converted to ET for storage. - ./ - ekacei_c ( handle, segno, recno, "order_id", - size, ordid, isnull ); - - ekacei_c ( handle, segno, recno, "customer_id", - size, custid, isnull ); - - ekacec_c ( handle, segno, recno, "last_name", - size, vallen, lname, isnull ); - - ekacec_c ( handle, segno, recno, "first_name", - size, vallen, fname, isnull ); - - utc2et_c ( odate, &et ); - - - ekaced_c ( handle, segno, recno, "order_date", - size, et, isnull ); - - ekaced_c ( handle, segno, recno, "cost", - size, cost, isnull ); - - /. - Close the file to make the update permanent. - ./ - ekcls_c ( handle ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 09-JAN-2002 (NJB) - --Index_Entries - - insert record into EK segment - --& -*/ - -{ /* Begin ekinsr_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ekinsr_c" ); - - /* - Map segment and record numbers to their Fortran ranges. - */ - - segno++; - recno++; - - ekinsr_ ( &handle, &segno, &recno ); - - - chkout_c ( "ekinsr_c" ); - -} /* End ekinsr_c */ diff --git a/ext/spice/src/cspice/eklef_c.c b/ext/spice/src/cspice/eklef_c.c deleted file mode 100644 index 96b40cf976..0000000000 --- a/ext/spice/src/cspice/eklef_c.c +++ /dev/null @@ -1,221 +0,0 @@ -/* - --Procedure eklef_c ( EK, load event file ) - --Abstract - - Load an EK file, making it accessible to the EK readers. - --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 - - EK - --Keywords - - EK - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void eklef_c ( ConstSpiceChar * fname, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of EK file to load. - handle O File handle of loaded EK file. - --Detailed_Input - - fname is the name of a binary EK file to be loaded. - --Detailed_Output - - handle is the handle of the EK file. The file is - accessible by the EK reader routines once it - has been loaded. - --Parameters - - None. - --Exceptions - - 1) If the EK file indicated by fname contains a column whose - name matches that of a column in an already loaded EK, but - whose declared attributes don't match those of the loaded - column of the same name, the error SPICE(BADATTRIBUTES) is - signalled. handle is is undefined in this case. - - 2) Loading an EK file that is already loaded does not cause side - effects. The handle already associated with the file will be - returned. - - 3) If a file open error occurs, the problem will be diagnosed by - routines called by this routine. handle is undefined in - this case. - - 4) If loading the input file would cause the maximum number of - loaded EK files to be exceeded, the error - SPICE(EKFILETABLEFULL) will be signalled. handle is - undefined in this case. This routine will attempt to - unload the file from the DAS system. - - 5) If loading the input file would cause the maximum number of - loaded DAS files to be exceeded, the error will be diagnosed - by routines called by this routine. handle is undefined in - this case. This routine will attempt to unload the file - from the DAS system. - - 6) If loading the input file would cause the maximum number of - segments allowed in loaded EK files to be exceeded, the error - SPICE(EKSEGMENTTABLEFULL) will be signalled. handle is - is undefined in this case. This routine will attempt to - unload the file from the DAS system. - - 7) If loading the input file would cause the maximum number of - columns allowed in loaded EK files to be exceeded, the error - SPICE(EKCOLDESCTABLEFULL) will be signalled. handle is - is undefined in this case. This routine will attempt to - unload the file from the DAS system. - - 8) If loading the input file would cause the maximum allowed - number of columns having distinct attributes in loaded EK - files to be exceeded, the error SPICE(EKCOLATTRTABLEFULL) will - be signalled. handle is is undefined in this case. This - routine will attempt to unload the file from the DAS system. - - 9) If loading the input file would cause the maximum number of - instrument codes allowed in loaded EK files to be exceeded, - the error SPICE(EKIDTABLEFULL) will be signalled. handle is - is undefined in this case. This routine will attempt to - unload the file from the DAS system. - - 10) If the input file does not contain at least one segment, the - error SPICE(EKNOSEGMENTS) will be signalled. - --Files - - This routine loads a binary EK into the CSPICE query system. - --Particulars - - This routine makes EK files known to the EK system. It is - necessary to load EK files using this routine in order to - query the files using the EK readers. - --Examples - - 1) Load three EK files. During query execution, all files - will be searched. - - for ( i = 0; i < 3; i++ ) - { - eklef_c ( ek[i], &handle ); - } - - [Perform queries] - - - 2) Load 25 EK files sequentially, unloading the previous file - before each new file is loaded. Unloading files prevents - them from being searched during query execution. - - for ( i = 0; i < 25; i++ ) - { - eklef_c ( ek[i], &handle ); - - [Perform queries] - - ekuef_c ( handle ); - } - - --Restrictions - - 1) EK files containing columns having the same name but - inconsistent declarations are not diagnosed. Such kernels - are invalid in any case. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 26-MAR-1998 (NJB) - - Based on SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) - --Index_Entries - - load EK file - load E-Kernel - --& -*/ - -{ /* Begin eklef_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "eklef_c" ); - - /* - Check the file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "eklef_c", fname ); - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - eklef_ ( ( char * ) fname, - ( integer * ) handle, - ( ftnlen ) strlen(fname) ); - - - chkout_c ( "eklef_c" ); - -} /* End eklef_c */ diff --git a/ext/spice/src/cspice/eknelt_c.c b/ext/spice/src/cspice/eknelt_c.c deleted file mode 100644 index 49914d0539..0000000000 --- a/ext/spice/src/cspice/eknelt_c.c +++ /dev/null @@ -1,344 +0,0 @@ -/* - --Procedure eknelt_c ( EK, get number of elements in column entry ) - --Abstract - - Return the number of elements in a specified column entry in - the current row. - --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 - - EK - --Keywords - - EK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - SpiceInt eknelt_c ( SpiceInt selidx, - SpiceInt row ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - selidx I Index of parent column in SELECT clause. - row I Row containing element. - - The function returns the number of elements in entry in current row. - --Detailed_Input - - selidx is the SELECT clause index of the column to - fetch from. The range of selidx is 0 : (nsel-1) - inclusive, where nsel is the number of items in - the SELECT clause of the current query. - - row is the index of the row containing the element. - This number refers to a member of the set of rows - matching a query. row must be in the range - - 0 : nmrows-1 - - where nmrows is the matching row count returned - by ekfind_c. - --Detailed_Output - - The function returns the number of elements in the column entry - belonging to the specified column in the current row. - - Null entries in variable-size columns are considered to have size 1. - --Parameters - - None. - --Exceptions - - 1) If this routine is called when no E-kernels have been loaded, - the error SPICE(NOLOADEDFILES) is signalled. - - 2) If selidx is outside of the range established by the - last query passed to ekfind_c, the error SPICE(INVALIDINDEX) - will be signalled. - - 3) If row is outside of the range established by the - last query passed to ekfind_c, the error SPICE(INVALIDINDEX) - will be signalled. - --Files - - At least one E-kernel must be loaded before queries may be passed to - the EK system via ekfind_c. - --Particulars - - This routine is meant to be used in conjunction with the EK - fetch entry points ekgc_c, ekgd_c, and ekgi_c. This routine - allows the caller of those routines to determine appropriate - loop bounds to use to fetch each column entry in the current row. - --Examples - - 1) Suppose the EK table TAB contains the following columns: - - - Column name Data Type Size - ----------- --------- ---- - IARRAY INT 10 - DARRAY DP VARIABLE - CARRAY CHR VARIABLE - - - Suppose the query - - QUERY = "SELECT IARRAY, DARRAY, CARRAY FROM TAB" - - is issued to ekfind_c via the call - - ekfind_c ( query, MSGLEN, &nmrows, &error, errmsg ); - - To fetch and dump column values from the rows that satisfy the - query, the loop below could be used. Note that we don't check - the FOUND flags returned by the fetch routines since we know - in advance how many elements are contained in each column - entry we fetch. - - #include - #include "SpiceUsr.h" - - #define ISIZE 10 - . - . - . - - for ( row = 0; row < nmrows; row++ ) - { - printf ( "\nROW = %d\n\n", row ); - - /. - Fetch values from column IARRAY in the current - row. Since IARRAY was the first column selected, - the selection index SELIDX is set to 0. - ./ - selidx = 0; - eltidx = 0; - isnull = SPICEFALSE; - - while ( ( eltidx < ISIZE ) && ( !isnull ) ) - { - /. - If the column entry is null, we'll be kicked - out of this loop after the first iteration. - ./ - - ekgi_c ( selidx, row, eltidx, - ivals[eltidx], &isnull, &found ); - - eltidx++; - } - - printf ( "\nCOLUMN = IARRAY\n\n" ); - - if ( isnull ) - { - printf ( "\n" ); - } - else - { - for ( i = 0; i < ISIZE; i++ ) - { - printf ( "%d\n", ivals[i] ); - } - } - - /. - Fetch values from column DARRAY in the current - row. Since DARRAY contains variable-size array - elements, we call eknelt_c to determine how many - elements to fetch. - ./ - - selidx = 1; - eltidx = 0; - nelt = eknelt_c ( selidx, row ); - isnull = SPICEFALSE; - - while ( ( eltidx < nelt ) && ( !isnull ) ) - { - /. - If the column entry is null, we'll be kicked - out of this loop after the first iteration. - ./ - - ekgd_c ( selidx, row, eltidx, - dvals[eltidx], &isnull, &found ); - - eltidx++; - } - - printf ( "\nCOLUMN = DARRAY\n\n" ); - - if ( isnull ) - { - printf ( "\n" ); - } - else - { - for ( i = 0; i < nelt; i++ ) - { - printf ( "%f\n", dvals[i] ); - } - } - - /. - Fetch values from column CARRAY in the current row. - ./ - - selidx = 2; - eltidx = 0; - nelt = eknelt_c ( selidx, row ); - isnull = SPICEFALSE; - - while ( ( eltidx < nelt ) && ( !isnull ) ) - { - /. - If the column entry is null, we'll be kicked - out of this loop after the first iteration. - - CVLEN is the declared length of the strings in - the cvals array. - ./ - - ekgc_c ( selidx, row, eltidx, CVLEN, - cvals[eltidx], &isnull, &found ); - - eltidx++; - } - - printf ( "\nCOLUMN = CARRAY\n\n" ); - - if ( isnull ) - { - printf ( "\n" ); - } - else - { - for ( i = 0; i < nelt; i++ ) - { - printf ( "%s\n", cvals[i] ); - } - } - - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.0.0, 24-FEB-1999 (NJB) - --Index_Entries - - return the number of elements in a column entry - --& -*/ - -{ /* Begin eknelt_c */ - - - - /* - Local variables - */ - SpiceInt fIndex; - SpiceInt fRow; - - SpiceInt n; - - - - /* - Participate in error tracing. - */ - - chkin_c ( "eknelt_c" ); - - /* - Convert the SELECT clause index and row number to Fortran-style. - */ - - fIndex = selidx + 1; - fRow = row + 1; - - - /* - Get the number of elements from the f2c'd routine. - */ - - eknelt_ ( ( integer * ) &fIndex, - ( integer * ) &fRow, - ( integer * ) &n ); - - - /* - Check out before returning the output value. - */ - chkout_c ( "eknelt_c" ); - - - return ( n ); - - -} /* End eknelt_c */ - diff --git a/ext/spice/src/cspice/eknseg.c b/ext/spice/src/cspice/eknseg.c deleted file mode 100644 index ac9b887dc0..0000000000 --- a/ext/spice/src/cspice/eknseg.c +++ /dev/null @@ -1,238 +0,0 @@ -/* eknseg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure EKNSEG ( EK, number of segments in file ) */ -integer eknseg_(integer *handle) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - - /* Local variables */ - integer base, tree; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen); - extern integer zzektrbs_(integer *), zzektrsz_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the number of segments in a specified EK. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ - -/* The function returns the number of segments in the specified */ -/* E-kernel. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file opened for read */ -/* access. */ - -/* $ Detailed_Output */ - -/* The function returns the number of segments in the specified */ -/* E-kernel. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. EKNSEG will return the value zero. */ - -/* 2) If an I/O error occurs while trying to read the EK, the error */ -/* will be diagnosed by routines called by this routine. */ -/* EKNSEG will return the value zero. */ - -/* $ Files */ - -/* See the description of HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is used to support the function of summarizing an */ -/* EK file. Given the number of segments in the file, a program */ -/* can use EKSSUM in a loop to summarize each of them. */ - -/* $ Examples */ - -/* 1) Open an EK file and count the segments in it. */ - -/* CALL EKOPR ( EKNAME, HANDLE ) */ -/* N = EKNSEG ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return number of segments in an E-kernel */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Set a default value for EKNSEG. */ - - ret_val = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return ret_val; - } else { - chkin_("EKNSEG", (ftnlen)6); - } - -/* Make sure this is a paged DAS EK. */ - - zzekpgch_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("EKNSEG", (ftnlen)6); - return ret_val; - } - -/* Obtain the base address of the first integer page. */ - - base = zzektrbs_(&c__1); - -/* Look up the head node of the segment tree. */ - - i__1 = base + 1; - i__2 = base + 1; - dasrdi_(handle, &i__1, &i__2, &tree); - -/* Get the entry count for the segment tree. */ - - ret_val = zzektrsz_(handle, &tree); - chkout_("EKNSEG", (ftnlen)6); - return ret_val; -} /* eknseg_ */ - diff --git a/ext/spice/src/cspice/eknseg_c.c b/ext/spice/src/cspice/eknseg_c.c deleted file mode 100644 index fa81108c92..0000000000 --- a/ext/spice/src/cspice/eknseg_c.c +++ /dev/null @@ -1,156 +0,0 @@ -/* - --Procedure eknseg_c ( EK, number of segments in file ) - --Abstract - - Return the number of segments in a specified EK. - --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 - - EK - --Keywords - - EK - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - SpiceInt eknseg_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - - The function returns the number of segments in the specified - E-kernel. - --Detailed_Input - - handle is the handle of an EK file opened for read access. - --Detailed_Output - - The function returns the number of segments in the specified - E-kernel. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. eknseg_c will return the value zero. - - 2) If an I/O error occurs while trying to read the EK, the error - will be diagnosed by routines called by this routine. - eknseg_c will return the value zero. - --Files - - See the description of handle in $Detailed_Input. - --Particulars - - This routine is used to support the function of summarizing an - EK file. Given the number of segments in the file, a program - can use ekssum_c in a loop to summarize each of them. - --Examples - - 1) Open an EK file and count the segments in it. - - ekopr_c ( ekname, &handle ); - n = eknseg_c ( handle ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 24-FEB-1999 (NJB) - --Index_Entries - - return number of segments in an E-kernel - --& -*/ - -{ /* Begin eknseg_c */ - - /* - Local variables - */ - SpiceInt n; - - - /* - Participate in error tracing. - */ - - chkin_c ( "eknseg_c" ); - - /* - We capture the value returned by eknseg_ rather than return it - directly, so we can check out. - */ - - n = eknseg_ ( (integer *) &handle ); - - - /* - Check out here, since it's our last chance. - */ - chkout_c ( "eknseg_c" ); - - - return (n); - - -} /* End eknseg_c */ - diff --git a/ext/spice/src/cspice/ekntab_c.c b/ext/spice/src/cspice/ekntab_c.c deleted file mode 100644 index 9039e6b579..0000000000 --- a/ext/spice/src/cspice/ekntab_c.c +++ /dev/null @@ -1,151 +0,0 @@ -/* - --Procedure ekntab_c ( EK, return number of loaded tables ) - --Abstract - - Return the number of loaded EK tables. - --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 - - EK - --Keywords - - EK - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ekntab_c ( SpiceInt * n ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - n O Number of loaded tables. - --Detailed_Input - - None. - --Detailed_Output - - n is the number of loaded tables. The count refers - to the number of logical tables; if multiple - segments contain data for the same table, these - segments collectively contribute only one table - to the count. - --Parameters - - None. - --Exceptions - - None. - --Files - - The returned count is based on the currently loaded EK files. - --Particulars - - This routine is a utility that provides the caller with the - number of loaded tables. Callers of ektnam_c can use this count - as the upper bound on set of table indices when looking up table - names. - --Examples - - 1) Suppose we have the following list of EK files and tables - contained in those files: - - File name Table name - --------- ---------- - - FILE_1.EK TABLE_1 - TABLE_2 - - FILE_2.EK TABLE_1 - TABLE_3 - - FILE_3.EK TABLE_2 - TABLE_3 - TABLE_4 - - - Then after loading these files, the call - - ekntab_c ( &n ); - - sets n to the value 4. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 14-OCT-2001 (NJB) - --Index_Entries - - return number of loaded tables - --& -*/ - -{ /* Begin ekntab_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ekntab_c" ); - - - ekntab_ ( (integer *) n ); - - - chkout_c ( "ekntab_c" ); - -} /* End ekntab_c */ diff --git a/ext/spice/src/cspice/ekopn.c b/ext/spice/src/cspice/ekopn.c deleted file mode 100644 index da02266213..0000000000 --- a/ext/spice/src/cspice/ekopn.c +++ /dev/null @@ -1,356 +0,0 @@ -/* ekopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure EKOPN ( EK, open new file ) */ -/* Subroutine */ int ekopn_(char *fname, char *ifname, integer *ncomch, - integer *handle, ftnlen fname_len, ftnlen ifname_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekpgan_(integer *, integer *, integer *, - integer *), zzekpgin_(integer *), zzektrit_(integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *), sigerr_(char *, ftnlen), dasonw_(char *, char *, char - *, integer *, integer *, ftnlen, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer ncr; - -/* $ Abstract */ - -/* Open a new E-kernel file and prepare the file for writing. */ - -/* $ 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 */ - -/* EK */ -/* NAIF_IDS */ -/* TIME */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of EK file. */ -/* IFNAME I Internal file name. */ -/* NCOMCH I The number of characters to reserve for comments. */ -/* HANDLE O Handle attached to new EK file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a new E-kernel file to be created. */ - -/* IFNAME is the internal file name of a new E-kernel. The */ -/* internal file name may be up to 60 characters in */ -/* length. */ - -/* NCOMCH is the amount of space, measured in characters, to */ -/* be allocated in the comment area when the new EK */ -/* file is created. It is not necessary to allocate */ -/* space in advance in order to add comments, but */ -/* doing so may greatly increase the efficiency with */ -/* which comments may be added. Making room for */ -/* comments after data has already been added to the */ -/* file involves moving the data, and thus is slower. */ - -/* NCOMCH must be greater than or equal to zero. */ - -/* $ Detailed_Output */ - -/* HANDLE is the EK handle of the file designated by FNAME. */ -/* This handle is used to identify the file to other */ -/* EK routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NCOMCH is less than zero, the error SPICE(INVALIDCOUNT) */ -/* will be signalled. No file will be created. */ - -/* 2) If IFNAME is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If the indicated file cannot be opened, the error will be */ -/* diagnosed by routines called by this routine. The new file */ -/* will be deleted. */ - -/* 4) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it opens and prepares */ -/* an EK for addition of data. */ - -/* $ Examples */ - -/* 1) Open a new EK file with name 'my.ek' and internal file */ -/* name 'test ek/1995-JUL-17': */ - -/* CALL EKOPN ( 'my.ek', 'test ek/1995-JUL-17', HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* open new E-kernel */ -/* open new EK */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKOPN", (ftnlen)5); - } - -/* Check the comment character count. */ - - if (*ncomch < 0) { - setmsg_("The number of reserved comment characters must be non-negat" - "ive but was #.", (ftnlen)73); - errint_("#", ncomch, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("EKOPN", (ftnlen)5); - return 0; - } - -/* A new DAS file is a must. The file type is EK. */ -/* Reserve enough comment records to accommodate the requested */ -/* number of comment characters. */ - - ncr = (*ncomch + 1023) / 1024; - dasonw_(fname, "EK", ifname, &ncr, handle, fname_len, (ftnlen)2, - ifname_len); - if (failed_()) { - chkout_("EKOPN", (ftnlen)5); - return 0; - } - -/* Initialize the file for paged access. The EK architecture */ -/* code is automatically set by the paging initialization routine. */ - - zzekpgin_(handle); - if (failed_()) { - chkout_("EKOPN", (ftnlen)5); - return 0; - } - -/* Allocate the first integer page for the file's metadata. We */ -/* don't need to examine the page number; it's 1. */ - - zzekpgan_(handle, &c__3, &p, &base); - -/* Initialize a new tree. This tree will point to the file's */ -/* segments. */ - - zzektrit_(handle, &p); - -/* Save the segment pointer's root page number. */ - - i__1 = base + 1; - i__2 = base + 1; - dasudi_(handle, &i__1, &i__2, &p); - -/* That's it. We're ready to add data to the file. */ - - chkout_("EKOPN", (ftnlen)5); - return 0; -} /* ekopn_ */ - diff --git a/ext/spice/src/cspice/ekopn_c.c b/ext/spice/src/cspice/ekopn_c.c deleted file mode 100644 index 891000b393..0000000000 --- a/ext/spice/src/cspice/ekopn_c.c +++ /dev/null @@ -1,190 +0,0 @@ -/* - --Procedure ekopn_c ( EK, open new file ) - --Abstract - - Open a new E-kernel file and prepare the file for writing. - --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 - - EK - NAIF_IDS - TIME - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ekopn_c ( ConstSpiceChar * fname, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of EK file. - ifname I Internal file name. - ncomch I The number of characters to reserve for comments. - handle O Handle attached to new EK file. - --Detailed_Input - - fname is the name of a new E-kernel file to be created. - - ifname is the internal file name of a new E-kernel. The - internal file name may be up to 60 characters in - length, not including the null terminator. - - ncomch is the amount of space, measured in characters, to - be allocated in the comment area when the new EK - file is created. It is not necessary to allocate - space in advance in order to add comments, but - doing so may greatly increase the efficiency with - which comments may be added. Making room for - comments after data has already been added to the - file involves moving the data, and thus is slower. - - ncomch must be greater than or equal to zero. - --Detailed_Output - - handle is the EK handle of the file designated by fname. - This handle is used to identify the file to other - EK routines. - --Parameters - - None. - --Exceptions - - 1) If NCOMCH is less than zero, the error SPICE(INVALIDCOUNT) - will be signalled. No file will be created. - - 2) If IFNAME is invalid, the error will be diagnosed by routines - called by this routine. - - 3) If the indicated file cannot be opened, the error will be - diagnosed by routines called by this routine. The new file - will be deleted. - - 4) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it opens and prepares - an EK for addition of data. - --Examples - - 1) Open a new EK file with name "my.ek" and internal file - name "test ek/1995-JUL-17": - - ekopn_c ( "my.ek", "test ek/1995-JUL-17", &handle ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 31-MAR-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) - --Index_Entries - - open new E-kernel - open new EK - --& -*/ - -{ /* Begin ekopn_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ekopn_c" ); - - /* - Check the file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekopn_c", fname ); - - - /* - Check the internal file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekopn_c", ifname ); - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - ekopn_ ( ( char * ) fname, - ( char * ) ifname, - ( integer * ) &ncomch, - ( integer * ) handle, - ( ftnlen ) strlen(fname), - ( ftnlen ) strlen(ifname) ); - - chkout_c ( "ekopn_c" ); - -} /* End ekopn_c */ diff --git a/ext/spice/src/cspice/ekopr.c b/ext/spice/src/cspice/ekopr.c deleted file mode 100644 index b7bfc049b2..0000000000 --- a/ext/spice/src/cspice/ekopr.c +++ /dev/null @@ -1,172 +0,0 @@ -/* ekopr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKOPR ( EK, open file for reading ) */ -/* Subroutine */ int ekopr_(char *fname, integer *handle, ftnlen fname_len) -{ - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), chkin_( - char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasopr_(char *, integer *, ftnlen), chkout_( - char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open an existing E-kernel file for reading. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of EK file. */ -/* HANDLE O Handle attached to EK file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of an existing E-kernel file to be */ -/* opened for read access. */ - -/* $ Detailed_Output */ - -/* HANDLE is the EK file handle of the file designated by */ -/* FNAME. This handle is used to identify the file */ -/* to other EK routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the indicated file cannot be opened, the error will be */ -/* diagnosed by routines called by this routine. The new file */ -/* will be deleted. */ - -/* 2) If the indicated file has the wrong architecture version, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine should be used to open an EK file for read access. */ -/* EKs opened for read access may not be modified. */ - -/* Opening an EK file with this routine makes the EK accessible to */ -/* the SPICELIB EK readers */ - -/* EKRCEC */ -/* EKRCED */ -/* EKRCEI */ - -/* all of which expect an EK file handle as an input argument. These */ -/* readers allow a caller to read individual EK column entries. */ - -/* To make an EK available to the EK query system, the file must be */ -/* loaded via EKLEF, rather than by this routine. See the EK */ -/* Required Reading for further information. */ - -/* $ Examples */ - -/* 1) Open the file MY.EK for read access: */ - -/* CALL EKOPR ( 'MY.EK', HANDLE ) */ - -/* $ Restrictions */ - -/* 1) No more than FTSIZE DAS files may be opened simultaneously. */ -/* See DASFM for the value of FTSIZE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-AUG-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* open EK for reading */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKOPR", (ftnlen)5); - } - -/* Open the file as a DAS file. */ - - dasopr_(fname, handle, fname_len); - if (failed_()) { - chkout_("EKOPR", (ftnlen)5); - return 0; - } - -/* Nothing doing unless the architecture is correct. This file */ -/* should be a paged DAS EK. */ - - zzekpgch_(handle, "READ", (ftnlen)4); - chkout_("EKOPR", (ftnlen)5); - return 0; -} /* ekopr_ */ - diff --git a/ext/spice/src/cspice/ekopr_c.c b/ext/spice/src/cspice/ekopr_c.c deleted file mode 100644 index 849b9d7ac7..0000000000 --- a/ext/spice/src/cspice/ekopr_c.c +++ /dev/null @@ -1,176 +0,0 @@ -/* - --Procedure ekopr_c ( EK, open file for reading ) - --Abstract - - Open an existing E-kernel file for reading. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void ekopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of EK file. - handle O Handle attached to EK file. - --Detailed_Input - - fname is the name of an existing E-kernel file to be - opened for read access. - --Detailed_Output - - handle is the EK file handle of the file designated by - fname. This handle is used to identify the file - to other EK routines. - --Parameters - - None. - --Exceptions - - 1) If the indicated file cannot be opened, the error will be - diagnosed by routines called by this routine. The new file - will be deleted. - - 2) If the indicated file has the wrong architecture version, the - error will be diagnosed by routines called by this routine. - - 3) If an I/O error occurs while reading the indicated file, the - error will be diagnosed by routines called by this routine. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine should be used to open an EK file for read access. - EKs opened for read access may not be modified. - - Opening an EK file with this routine makes the EK accessible to - the CSPICE EK readers - - ekrcec_c - ekrced_c - ekrcei_c - - all of which expect an EK file handle as an input argument. These - readers allow a caller to read individual EK column entries. - - To make an EK available to the EK query system, the file must be - loaded via eklef_c, rather than by this routine. See the EK - Required Reading for further information. - --Examples - - 1) Open the file my.ek for read access: - - ekopr_c ( "my.ek", &handle ); - --Restrictions - - 1) No more than CSPICE_EK_MAX_OPEN_FILES EK files may be opened - or loaded within the EK system simultaneously. See the header - file SpicePar.h for the numeric value of the limit. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.0.0, 27-MAR-1998 - - Based on SPICELIB Version 1.0.0, 26-AUG-1995 (NJB) - --Index_Entries - - open EK for reading - --& -*/ - -{ /* Begin ekopr_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "ekopr_c" ); - - /* - Check the file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekopr_c", fname ); - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - ekopr_ ( ( char * ) fname, - ( integer * ) handle, - ( ftnlen ) strlen(fname) ); - - - chkout_c ( "ekopr_c" ); - -} /* End ekopr_c */ diff --git a/ext/spice/src/cspice/ekops.c b/ext/spice/src/cspice/ekops.c deleted file mode 100644 index 41f98b69ee..0000000000 --- a/ext/spice/src/cspice/ekops.c +++ /dev/null @@ -1,311 +0,0 @@ -/* ekops.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure EKOPS ( EK, open scratch file ) */ -/* Subroutine */ int ekops_(integer *handle) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekpgan_(integer *, integer *, integer *, - integer *), zzekpgin_(integer *), zzektrit_(integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *), dasops_(integer *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open a scratch E-kernel file and prepare the file for writing. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE O File handle attached to new EK file. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* HANDLE is the EK file handle of the file designated by */ -/* FNAME. This handle is used to identify the file */ -/* to other EK routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the indicated file cannot be opened, the error will be */ -/* diagnosed by routines called by this routine. The new file */ -/* will be deleted. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it opens and prepares */ -/* an EK for addition of data. */ - -/* $ Examples */ - -/* 1) Open a scratch EK. The EK should be closed via EKCLS. */ -/* The EK file will be deleted when closed. */ - - -/* CALL EKOPS ( HANDLE ) */ - -/* [Write/Read EK] */ - -/* CALL EKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* 1) No more than FTSIZE DAS files may be opened simultaneously. */ -/* See DASFM for the value of FTSIZE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* open scratch E-kernel */ -/* open scratch EK */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKOPS", (ftnlen)5); - } - dasops_(handle); - if (failed_()) { - chkout_("EKOPS", (ftnlen)5); - return 0; - } - -/* Initialize the file for paged access. The EK architecture */ -/* code is automatically set by the paging initialization routine. */ - - zzekpgin_(handle); - if (failed_()) { - chkout_("EKOPS", (ftnlen)5); - return 0; - } - -/* Allocate the first integer page for the file's metadata. We */ -/* don't need to examine the page number; it's 1. */ - - zzekpgan_(handle, &c__3, &p, &base); - -/* Initialize a new tree. This tree will point to the file's */ -/* segments. */ - - zzektrit_(handle, &p); - -/* Save the segment pointer's root page number. */ - - i__1 = base + 1; - i__2 = base + 1; - dasudi_(handle, &i__1, &i__2, &p); - -/* That's it. We're ready to add data to the file. */ - - chkout_("EKOPS", (ftnlen)5); - return 0; -} /* ekops_ */ - diff --git a/ext/spice/src/cspice/ekops_c.c b/ext/spice/src/cspice/ekops_c.c deleted file mode 100644 index 54c7001ec7..0000000000 --- a/ext/spice/src/cspice/ekops_c.c +++ /dev/null @@ -1,152 +0,0 @@ -/* - --Procedure ekops_c ( EK, open scratch file ) - --Abstract - - Open a scratch (temporary) E-kernel file and prepare the file - for writing. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void ekops_c ( SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle O File handle attached to new EK file. - --Detailed_Input - - None. - --Detailed_Output - - handle is the EK file handle of the file opened by this - routine. This handle is used to identify the file - to other EK routines. - --Parameters - - None. - --Exceptions - - 1) If the indicated file cannot be opened, the error will be - diagnosed by routines called by this routine. The new file - will be deleted. - - 2) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - --Files - - This routine creates a temporary EK file; the file is deleted - when the calling program terminates. - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it opens and prepares - a scratch EK for addition of data. "Scratch" files are automatically - deleted when the calling program terminates normally. - --Examples - - 1) Open a scratch EK. The EK should be closed via EKCLS. - The EK file will be deleted when closed. - - - ekops_c ( &handle ); - - [Write/Read EK] - - ekcls_c ( handle ); - - --Restrictions - - 1) No more than CSPICE_DAS_MXOPFL files may be opened - simultaneously. See the header file SpicePar.h for the value of - CSPICE_DAS_MXOPFL. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 2-APR-1998 - --Index_Entries - - open scratch E-kernel - open scratch EK - --& -*/ - -{ /* Begin ekops_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ekops_c" ); - - - ekops_ ( ( integer * ) handle ); - - - chkout_c ( "ekops_c" ); - -} /* End ekops_c */ diff --git a/ext/spice/src/cspice/ekopw.c b/ext/spice/src/cspice/ekopw.c deleted file mode 100644 index 4fa4469f39..0000000000 --- a/ext/spice/src/cspice/ekopw.c +++ /dev/null @@ -1,215 +0,0 @@ -/* ekopw.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKOPW ( EK, open file for writing ) */ -/* Subroutine */ int ekopw_(char *fname, integer *handle, ftnlen fname_len) -{ - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), chkin_( - char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasopw_(char *, integer *, ftnlen), chkout_( - char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open an existing E-kernel file for writing. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of EK file. */ -/* HANDLE O Handle attached to EK file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of an existing E-kernel file to be */ -/* opened for write access. */ - -/* $ Detailed_Output */ - -/* HANDLE is the DAS file handle of the EK designate by */ -/* FNAME. This handle is used to identify the file */ -/* to other EK routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the indicated file cannot be opened, the error will be */ -/* diagnosed by routines called by this routine. The new file */ -/* will be deleted. */ - -/* 2) If the indicated file has the wrong architecture version, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine should be used to open an EK file for write access. */ - -/* Opening an EK file with this routine makes the EK accessible to */ -/* the following SPICELIB EK access routines, all of which modify */ -/* the target EK file: */ - -/* Begin segment: */ - -/* EKBSEG */ - -/* Append, insert, delete records: */ - -/* EKAPPR */ -/* EKINSR */ -/* EKDELR */ - -/* Add column entries: */ - -/* EKACEC */ -/* EKACED */ -/* EKACEI */ - -/* Update existing column entries: */ - -/* EKUCEC */ -/* EKUCED */ -/* EKUCEI */ - -/* Execute fast write: */ - -/* EKIFLD */ -/* EKFFLD */ -/* EKACEC */ -/* EKACED */ -/* EKACEI */ - -/* An EK opened for write access is also accessible for reading. */ -/* The file may be accessed by the SPICELIB EK readers */ - -/* EKRCEC */ -/* EKRCED */ -/* EKRCEI */ - -/* and summary routines: */ - -/* EKNSEG */ -/* EKSSUM */ - - -/* An EK opened for write access cannot be queried. To make an EK */ -/* available to the EK query system, the file must be loaded via */ -/* EKLEF, rather than by this routine. See the EK Required Reading */ -/* for further information. */ - -/* $ Examples */ - -/* 1) Open the file MY.EK for write access: */ - -/* CALL EKOPW ( 'MY.EK', HANDLE ) */ - -/* $ Restrictions */ - -/* 1) No more than FTSIZE DAS files may be opened simultaneously. */ -/* See DASFM for the value of FTSIZE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */ - -/* Documentation change: instances of the phrase "fast load" */ -/* were replaced with "fast write." */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* open EK for writing */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKOPW", (ftnlen)5); - } - -/* Open the file as a DAS file. */ - - dasopw_(fname, handle, fname_len); - if (failed_()) { - chkout_("EKOPW", (ftnlen)5); - return 0; - } - -/* Nothing doing unless the architecture is correct. This file */ -/* should be a paged DAS EK. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - chkout_("EKOPW", (ftnlen)5); - return 0; -} /* ekopw_ */ - diff --git a/ext/spice/src/cspice/ekopw_c.c b/ext/spice/src/cspice/ekopw_c.c deleted file mode 100644 index 63ac2386a8..0000000000 --- a/ext/spice/src/cspice/ekopw_c.c +++ /dev/null @@ -1,213 +0,0 @@ -/* - --Procedure ekopw_c ( EK, open file for writing ) - --Abstract - - Open an existing E-kernel file for writing. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void ekopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of EK file. - handle O Handle attached to EK file. - --Detailed_Input - - fname is the name of an existing E-kernel file to be - opened for write access. - --Detailed_Output - - handle is the DAS file handle of the EK designate by - fname. This handle is used to identify the file - to other EK routines. - --Parameters - - None. - --Exceptions - - 1) If the indicated file cannot be opened, the error will be - diagnosed by routines called by this routine. The new file - will be deleted. - - 2) If the indicated file has the wrong architecture version, the - error will be diagnosed by routines called by this routine. - - 3) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine should be used to open an EK file for write access. - - Opening an EK file with this routine makes the EK accessible to - the following CSPICE EK access routines, all of which modify - the target EK file: - - Begin segment: - - ekbseg_c - - Append, insert, delete records: - - ekappr_c - ekinsr_c - ekdelr_c - - Add column entries: - - ekacec_c - ekaced_c - ekacei_c - - Update existing column entries: - - ekucec_c - ekuced_c - ekucei_c - - Execute fast write: - - ekifld_c - ekffld_c - ekaclc_c - ekacld_c - ekacli_c - - An EK opened for write access is also accessible for reading. - The file may be accessed by the CSPICE EK readers - - ekrcec_c - ekrced_c - ekrcei_c - - and summary routines: - - eknseg_c - ekssum_c - - - An EK opened for write access cannot be queried. To make an EK - available to the EK query system, the file must be loaded via - EKLEF, rather than by this routine. See the EK Required Reading - for further information. - --Examples - - 1) Open the file MY.EK for write access: - - ekopw_c ( "my.ek", &handle ); - --Restrictions - - 1) No more than FTSIZE DAS files may be opened simultaneously. - See dasfm_ for the value of FTSIZE. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 09-JAN-2002 (NJB) - - Documentation change: instances of the phrase "fast load" - were replaced with "fast write." - - -CSPICE Version 1.0.0, 25-MAY-1999 (NJB) - --Index_Entries - - open EK for writing - --& -*/ - -{ /* Begin ekopw_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ekopw_c" ); - - - /* - Check the file name string. The pointer must be non-null - and the string length must be at least 1. - */ - CHKFSTR ( CHK_STANDARD, "ekopw_c", fname ); - - - /* - Call the f2c'd routine. - */ - ekopw_ ( ( char * ) fname, - ( integer * ) handle, - ( ftnlen ) strlen(fname) ); - - - chkout_c ( "ekopw_c" ); - -} /* End ekopw_c */ diff --git a/ext/spice/src/cspice/ekpsel.c b/ext/spice/src/cspice/ekpsel.c deleted file mode 100644 index c99673f65a..0000000000 --- a/ext/spice/src/cspice/ekpsel.c +++ /dev/null @@ -1,1150 +0,0 @@ -/* ekpsel.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__27869 = 27869; -static integer c__100 = 100; - -/* $Procedure EKPSEL ( EK, parse SELECT clause ) */ -/* Subroutine */ int ekpsel_(char *query, integer *n, integer *xbegs, integer - *xends, char *xtypes, char *xclass, char *tabs, char *cols, logical * - error, char *errmsg, ftnlen query_len, ftnlen xtypes_len, ftnlen - xclass_len, ftnlen tabs_len, ftnlen cols_len, ftnlen errmsg_len) -{ - /* Initialized data */ - - static char chrtyp[4*4] = "CHR " "DP " "INT " "TIME"; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char qtab[64]; - extern /* Subroutine */ int zzekencd_(char *, integer *, char *, - doublereal *, logical *, char *, integer *, ftnlen, ftnlen, - ftnlen), zzekqtab_(integer *, char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), zzekqini_(integer *, integer *, integer * - , char *, doublereal *, ftnlen), zzekreqi_(integer *, char *, - integer *, ftnlen), zzekqsel_(integer *, char *, integer *, - integer *, integer *, char *, integer *, char *, integer *, - ftnlen, ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int ekcii_(char *, integer *, char *, integer *, - ftnlen, ftnlen), chkin_(char *, ftnlen); - char eqryc[2000]; - doublereal eqryd[100]; - integer eqryi[27875]; - extern logical return_(void); - char aka[64], column[32]; - integer attdsc[6], colidx, errptr, tabidx; - extern /* Subroutine */ int chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* Parse the SELECT clause of an EK query, returning full particulars */ -/* concerning each selected item. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Attribute Descriptor Parameters */ - -/* ekattdsc.inc Version 1 23-AUG-1995 (NJB) */ - - -/* This include file declares parameters used in EK column */ -/* attribute descriptors. Column attribute descriptors are */ -/* a simplified version of column descriptors: attribute */ -/* descriptors describe attributes of a column but do not contain */ -/* addresses or pointers. */ - - -/* Size of column attribute descriptor */ - - -/* Indices of various pieces of attribute descriptors: */ - - -/* ATTSIZ is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* ATTTYP is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* ATTLEN is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* ATTSIZ is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* ATTIDX is the location of a flag that indicates whether the column */ -/* is indexed. The flag takes the value ITRUE if the column is */ -/* indexed and otherwise takes the value IFALSE. */ - - -/* ATTNFL is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* End Include Section: EK Column Attribute Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I EK query. */ -/* N O Number of items in SELECT clause of query. */ -/* XBEGS O Begin positions of expressions in SELECT clause. */ -/* XENDS O End positions of expressions in SELECT clause. */ -/* XTYPES O Data types of expressions. */ -/* XCLASS O Classes of expressions. */ -/* TABS O Names of tables qualifying SELECT columns. */ -/* COLS O Names of columns in SELECT clause of query. */ -/* ERROR O Error flag. */ -/* ERRMSG O Parse error message. */ - -/* $ Detailed_Input */ - -/* QUERY is a character string containing an EK query. */ -/* EK queries have the general form */ - -/* SELECT , ... */ -/* FROM
,
, ... */ -/* [WHERE ] */ -/* [ORDER BY ] */ - -/* Here the symbol
. */ -/*
. */ - -/* but more general expressions may also be selected. */ -/* Examples are functions, such as */ - -/* COUNT(*) */ -/* COUNT(
. ) */ -/* MAX (
. ) */ - -/* or expressions involving constants, such as */ - -/* 2 * */ - -/* $ Detailed_Output */ - -/* N is the number of items specified in the */ -/* SELECT clause of the input query. */ - -/* XBEGS, */ -/* XENDS are, respectively, arrays of begin and end */ -/* positions of expressions designating items in the */ -/* SELECT clause of the input query. The Ith */ -/* expression is located in the substring */ - -/* QUERY ( XBEGS(I) : XENDS(I) ) */ - - -/* XTYPES is an array of short strings indicating the data */ -/* types of the expressions in the SELECT clause. */ -/* Values and meanings of XTYPES are: */ - -/* 'CHR' Character type */ -/* 'DP' Double precision type */ -/* 'INT' Integer type */ -/* 'TIME' Time type */ - -/* The Ith element of XTYPES refers to the Ith */ -/* selected item. */ - -/* The data type of an expression indicates which */ -/* fetch routine to use to obtain values of the */ -/* selected expression. The mapping of data types */ -/* to fetch routines is shown below: */ - -/* 'CHR' EKGC */ -/* 'DP' EKGD */ -/* 'INT' EKGI */ -/* 'TIME' EKGD */ - -/* Note that time values are stored as d.p. numbers. */ - - -/* XCLASS is an array of short strings giving the classes */ -/* of the expressions occurring in the SELECT clause */ -/* of the input query. Values and meanings of */ -/* XCLASS are: */ - -/* 'COL' Selected item was a column. The */ -/* column may qualified. */ - -/* 'FUNC' Selected item was a simple */ -/* function invocation of the form */ - -/* F ( ) */ - -/* or else was */ - -/* COUNT(*) */ - -/* 'EXPR' Selected item was a more general */ -/* expression than those shown above. */ - -/* The Ith element of XCLASS refers to the Ith */ -/* selected item. */ - -/* When a selected item is a column, the values of */ -/* the arguments TABS and COLS (discussed below) are */ -/* defined. */ - - -/* TABS is an array of names of tables corresponding to */ -/* the columns in the SELECT clause. The Ith element */ -/* of TABS corresponds to the table containing the */ -/* Ith SELECT column. Table names returned in TABS */ -/* are the actual names of tables in loaded EK, not */ -/* aliases supplied in the input query. Table names */ -/* are supplied even if the corresponding column was */ -/* unqualified in the input query, as long as the */ -/* column name was unambiguous. */ - -/* The contents of TABS(I) are defined if and only if */ -/* the returned value of XCLASS(I) is 'COL'. */ - - -/* COLS is an array containing the columns of the SELECT */ -/* clause. The contents of COLS(I) are defined if and */ -/* only if the returned value of XCLASS(I) is 'COL'. */ - - -/* ERROR is a logical flag indicating whether the input */ -/* QUERY parsed correctly. The other outputs of this */ -/* routine, except for ERRMSG, are undefined if a */ -/* parse error occurred. ERROR is returned .TRUE. if */ -/* a parse error occurred, .FALSE. otherwise. */ - -/* ERRMSG is a character string describing the cause of a */ -/* parse error, if such an error occurred. Otherwise, */ -/* ERRMSG is returned blank. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Parse failures do not cause this routine to signal errors; */ -/* instead, the ERROR and ERRMSG outputs indicate invalid */ -/* QUERIES. */ - -/* 2) Queries cannot be parsed correctly unless at least one EK */ -/* is loaded. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows callers of the EK fetch routines to determine */ -/* at run time the attributes of the columns from which data is to be */ -/* fetched. */ - -/* $ Examples */ - -/* 1) Use of EKPSEL to assist in fetching rows matching queries */ -/* supplied at run time. */ - -/* The code fragment shown here does not rely on advance */ -/* knowledge of the input query or the contents of any loaded EK */ -/* files. */ - -/* To simplify the example, we assume that all data is scalar. */ - -/* C */ -/* C Prompt for query. Parse the SELECT clause using */ -/* C EKPSEL. */ -/* C */ -/* CALL PROMPT ( 'Enter query > ', QUERY ) */ - -/* CALL EKPSEL ( QUERY, */ -/* N, */ -/* XBEGS, */ -/* XENDS, */ -/* XBEGS, */ -/* XTYPES, */ -/* XCLASS, */ -/* TABS, */ -/* COLS, */ -/* ERROR, */ -/* ERRMSG ) */ - - -/* IF ( ERROR ) THEN */ - -/* WRITE (*,*) ERRMSG */ - -/* ELSE */ -/* C */ -/* C Submit query to the EK query system. */ -/* C */ -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* IF ( ERROR ) THEN */ - -/* WRITE (*,*) ERRMSG */ - -/* ELSE */ -/* C */ -/* C Fetch the rows that matched the query. */ -/* C */ -/* DO ROW = 1, NMROWS */ -/* C */ -/* C Fetch data from the Ith row. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ - -/* DO COL = 1, N */ -/* C */ -/* C Fetch the data from the Jth selected */ -/* C column. */ -/* C */ -/* IF ( XCLASS(COL) .EQ. 'COL' ) THEN */ - -/* OUTSTR = COLS(COL) */ -/* CALL PREFIX ( '.', 0, OUTSTR ) */ -/* CALL PREFIX ( TABS(COL), 0, OUTSTR ) */ -/* WRITE (*,*) 'COLUMN = ', OUTSTR */ - -/* ELSE */ - -/* B = XBEGS(COL) */ -/* E = XENDS(COL) */ -/* WRITE (*,*) 'ITEM = ', QUERY(B:E) */ - -/* END IF */ - -/* IF ( XTYPES(COL) .EQ. 'CHR' ) THEN */ - -/* CALL EKGC ( COL, ROW, 1, */ -/* . CDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) CDATA */ -/* END IF */ - - -/* ELSE IF ( XTYPES(COL) .EQ. 'DP' ) THEN */ - -/* CALL EKGD ( COL, ROW, 1, */ -/* . DDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) DDATA */ -/* END IF */ - - -/* ELSE IF ( XTYPES(COL) .EQ. 'INT' ) THEN */ - -/* CALL EKGI ( COL, ROW, 1, */ -/* . IDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) IDATA */ -/* END IF */ - - -/* ELSE */ -/* C */ -/* C The item is a time value. Convert it */ -/* C to UTC for output. */ -/* C */ -/* CALL EKGD ( COL, ROW, 1, */ -/* . TDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* CALL ET2UTC ( TDATA, 'C', 3, UTC ) */ -/* WRITE (*,*) UTC */ -/* END IF */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C We're done with the column having index COL. */ -/* C */ -/* END DO */ -/* C */ -/* C We're done with the row having index ROW. */ -/* C */ -/* END IF */ -/* C */ -/* C We either processed the query or had an error. */ -/* C */ -/* END IF */ -/* C */ -/* C We either parsed the SELECT clause or had an error. */ -/* C */ - - -/* $ Restrictions */ - -/* 1) Currently, column names are the only supported expressions. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse select clause of EK query */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved values */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKPSEL", (ftnlen)6); - } - -/* Initialize the encoded query each time, for safety. */ - - zzekqini_(&c__27869, &c__100, eqryi, eqryc, eqryd, (ftnlen)2000); - -/* Encode the input query. */ - - zzekencd_(query, eqryi, eqryc, eqryd, error, errmsg, &errptr, query_len, ( - ftnlen)2000, errmsg_len); - if (*error) { - chkout_("EKPSEL", (ftnlen)6); - return 0; - } - -/* Look up the number of SELECT columns. For each column, look up */ -/* the parent table, the alias, and the column's name. */ - - zzekreqi_(eqryi, "NUM_SELECT_COLS", n, (ftnlen)15); - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqsel_(eqryi, eqryc, &i__, &xbegs[i__ - 1], &xends[i__ - 1], qtab, - &tabidx, cols + (i__ - 1) * cols_len, &colidx, (ftnlen)2000, ( - ftnlen)64, cols_len); - -/* Make the table index to the table name. */ - - zzekqtab_(eqryi, eqryc, &tabidx, tabs + (i__ - 1) * tabs_len, aka, ( - ftnlen)2000, tabs_len, (ftnlen)64); - -/* Currently, every expression is a column. */ - - s_copy(xclass + (i__ - 1) * xclass_len, "COL", xclass_len, (ftnlen)3); - -/* Look up the data type of the column. */ - - ekcii_(tabs + (i__ - 1) * tabs_len, &colidx, column, attdsc, tabs_len, - (ftnlen)32); - s_copy(xtypes + (i__ - 1) * xtypes_len, chrtyp + (((i__2 = attdsc[1] - - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("chrtyp", i__2, "ekpse" - "l_", (ftnlen)498)) << 2), xtypes_len, (ftnlen)4); - } - chkout_("EKPSEL", (ftnlen)6); - return 0; -} /* ekpsel_ */ - diff --git a/ext/spice/src/cspice/ekpsel_c.c b/ext/spice/src/cspice/ekpsel_c.c deleted file mode 100644 index 2115b87e7d..0000000000 --- a/ext/spice/src/cspice/ekpsel_c.c +++ /dev/null @@ -1,796 +0,0 @@ -/* - --Procedure ekpsel_c ( EK, parse SELECT clause ) - --Abstract - - Parse the SELECT clause of an EK query, returning full particulars - concerning each selected item. - --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 - - PRIVATE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void ekpsel_c ( ConstSpiceChar * query, - SpiceInt msglen, - SpiceInt tablen, - SpiceInt collen, - SpiceInt * n, - SpiceInt * xbegs, - SpiceInt * xends, - SpiceEKDataType * xtypes, - SpiceEKExprClass * xclass, - void * tabs, - void * cols, - SpiceBoolean * error, - SpiceChar * errmsg ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - query I EK query. - msglen I Available space in the output error message string. - n O Number of items in SELECT clause of query. - xbegs O Begin positions of expressions in SELECT clause. - xends O End positions of expressions in SELECT clause. - xtypes O Data types of expressions. - xclass O Classes of expressions. - tabs O Names of tables qualifying SELECT columns. - cols O Names of columns in SELECT clause of query. - error O Error flag. - errmsg O Parse error message. - --Detailed_Input - - query is a character string containing an EK query. - EK queries have the general form - - SELECT , ... - FROM
,
, ... - [WHERE ] - [ORDER BY ] - - Here the symbol
. -
. - - but more general expressions may also be selected. - Examples are functions, such as - - COUNT(*) - COUNT(
. ) - MAX (
. ) - - or expressions involving constants, such as - - 2 * - - - msglen The allowed length for the output message string. - This length must large enough to hold the output - string plus the terminator. If the output string is - expected to have x characters, msglen needs to be - x + 1. - - tablen The length of the strings in the output table array. - This length must large enough to hold the output - strings plus the terminator. If the output strings - are expected to have x characters, tablen needs to be - x + 1. The parameter SPICE_EK_TSTRLN defines a string - length sufficient to hold any table name. This - parameter is defined by SpiceUsr.h. - - collen The length of the strings in the output column array. - This length must large enough to hold the output - strings plus the terminator. If the output strings - are expected to have x characters, collen needs to be - x + 1. The parameter SPICE_EK_CSTRLN defines a string - length sufficient to hold any table name. This - parameter is defined by SpiceUsr.h. - --Detailed_Output - - n is the number of items specified in the - SELECT clause of the input query. - - xbegs, - xends are, respectively, arrays of begin and end - positions of expressions designating items in the - SELECT clause of the input query. The ith - expression is located in the substring - - query[ xbegs[i] ]...query[ xends[i] ] - - - xtypes is an array of values of type SpiceEKDataType giving - types of the expressions in the SELECT clause. - Values and meanings of xtypes are: - - SPICE_CHR Character type - SPICE_DP Double precision type - SPICE_INT Integer type - SPICE_TIME Time type - - The ith element of xtypes refers to the ith - selected item. - - The data type of an expression indicates which - fetch routine to use to obtain values of the - selected expression. The mapping of data types - to fetch routines is shown below: - - SPICE_CHR ekgc_c - SPICE_DP ekgd_c - SPICE_INT ekgi_c - SPICE_TIME ekgd_c - - Note that time values are stored as d.p. numbers. - - - xclass is an array of values of type SpiceEKExprClass giving - the classes of the expressions occurring in the SELECT - clause of the input query. Values and meanings of - xclass are: - - SPICE_EK_EXP_COL Selected item was a column. - The column may qualified by a - table name. - - SPICE_EK_EXP_FUNC Selected item was a simple - function invocation of the - form - - F ( ) - - or else was - - COUNT(*) - - SPICE_EK_EXP_EXPR Selected item was a more - general expression than those - shown above. - - The Ith element of xclass refers to the Ith - selected item. - - When a selected item is a column, the values of - the arguments tabs and cols (discussed below) are - defined. - - - tabs is an array of names of tables corresponding to - the columns in the SELECT clause. The ith element - of tabs corresponds to the table containing the - ith SELECT column. Table names returned in tabs - are the actual names of tables in loaded EKs, not - aliases supplied in the input query. Table names - are supplied even if the corresponding column was - unqualified in the input query, as long as the - column name was unambiguous. - - The contents of tabs[i] are defined if and only if - the returned value of xclass[i] is SPICE_EK_EXP_COL. - - - cols is an array containing the columns of the SELECT - clause. The contents of cols[i] are defined if and - only if the returned value of xclass[i] is - SPICE_EK_EXP_COL. - - - error is a logical flag indicating whether the input - query parsed correctly. The other outputs of this - routine, except for errmsg, are undefined if a - parse error occurred. error is returned SPICETRUE if - a parse error occurred, SPICEFALSE otherwise. - - errmsg is a character string describing the cause of a - parse error, if such an error occurred. Otherwise, - errmsg is returned empty. - --Parameters - - None. - --Exceptions - - 1) Parse failures do not cause this routine to signal errors; - instead, the error and errmsg outputs indicate invalid - QUERIES. - - 2) Queries cannot be parsed correctly unless at least one EK - is loaded. - --Files - - None. - --Particulars - - This routine allows callers of the EK fetch routines to determine - at run time the attributes of the columns from which data is to be - fetched. - --Examples - - 1) Use of ekpsel_c to assist in fetching rows matching queries - supplied at run time. - - The code fragment shown here does not rely on advance - knowledge of the input query or the contents of any loaded EK - files. - - To simplify the example, we assume that all columns are scalar- - valued. - - - #include "SpiceUsr.h" - #include - #include - - - void main() - { - /. - The kernel names that appear here are examples; to use this - program, you would have to replace these names with those of - kernels available on your own system. - ./ - #define EK "/kernels/galileo/ek/EK97148A.BSE" - #define LSK "/kernels/gen/lsk/leapseconds.ker" - #define MSGLEN 320 - #define LNSIZE 80 - #define TIMELEN 25 - - SpiceBoolean error; - SpiceBoolean found; - SpiceBoolean null; - - SpiceChar cdata [LNSIZE]; - SpiceChar cols [SPICE_EK_MAXQSEL] - [SPICE_EK_CSTRLN]; - SpiceChar errmsg [MSGLEN]; - SpiceChar outstr [LNSIZE]; - SpiceChar * query; - SpiceChar tabs [SPICE_EK_MAXQSEL] - [SPICE_EK_TSTRLN]; - SpiceChar utc [TIMELEN]; - - SpiceDouble ddata; - SpiceDouble tdata; - - SpiceEKDataType xtypes [SPICE_EK_MAXQSEL]; - SpiceEKExprClass xclass [SPICE_EK_MAXQSEL]; - - SpiceInt col; - SpiceInt exprlen; - SpiceInt handle; - SpiceInt idata; - SpiceInt n; - SpiceInt nmrows; - SpiceInt row; - - SpiceInt xbegs [SPICE_EK_MAXQSEL]; - SpiceInt xends [SPICE_EK_MAXQSEL]; - - - - /. - Load leapseconds and E-kernels. - ./ - furnsh_c ( LSK ); - eklef_c ( EK, &handle ); - - - while ( SPICETRUE ) - { - - /. - Prompt for query. Parse the SELECT clause using ekpsel_c. - ./ - query = prompt_c ( "Enter query > " ); - - ekpsel_c ( query, - MSGLEN, - &n, - xbegs, - xends, - xtypes, - xclass, - tabs, - cols, - &error, - errmsg ); - - if ( error ) - { - printf ( "Error: <%s>\n", errmsg ); - } - - else - { - /. - Submit query to the EK query system. - ./ - - ekfind_c ( query, MSGLEN, &nmrows, &error, errmsg ); - - if ( error ) - { - printf ( "Error found: %s\n", errmsg ); - } - - else - { - printf ( "Number of matching rows = %d\n", nmrows ); - - /. - Fetch the rows that matched the query. - ./ - - for ( row = 0; row < nmrows; row++ ) - { - /. - Fetch data from the current row. - ./ - - printf ( "\nROW = %d\n", row ); - - - for ( col = 0; col < n; col++ ) - { - /. - Fetch data from the current selected column. - ./ - - if ( xclass[col] == SPICE_EK_EXP_COL ) - { - printf ( "COLUMN = %s.%s\n", - tabs[col], - cols[col] ); - } - else - { - exprlen = xends[col] - xbegs[col] + 1; - - strncpy ( outstr, query+xbegs[col], - exprlen ); - - outstr[exprlen] = (char)0; - - printf ( "%s\n", outstr ); - } - - - /. - Write out the data. - ./ - - switch ( xtypes[col] ) - { - case SPICE_CHR: - - ekgc_c ( col, row, 0, LNSIZE, - cdata, &null, &found ); - - if ( !null ) - { - printf ( "%s\n", cdata ); - } - - break; - - - case SPICE_DP: - - ekgd_c ( col, row, 0, - &ddata, &null, &found ); - - if ( !null ) - { - printf ( "%f\n", ddata ); - } - - break; - - - case SPICE_INT: - - ekgi_c ( col, row, 0, - &idata, &null, &found ); - - if ( !null ) - { - printf ( "%d\n", cdata ); - } - - break; - - - case SPICE_TIME: - - /. - The item is a time value. Convert it - to UTC for output. - ./ - - ekgd_c ( col, row, 0, - &tdata, &null, &found ); - - if ( !null ) - { - et2utc_c ( tdata, "C", 3, - TIMELEN, utc ); - - printf ( "%s\n", utc ); - } - - break; - - - default: - - ; - } - - /. - Handle null values here. - ./ - - if ( null ) - { - printf ( "%s\n", "" ); - } - - /. - End of data type switch. - ./ - - } - /. - We're done with the column having index col. - ./ - } - /. - We're done with the row having index row. - ./ - } - /. - We either processed the query or ekfind_c detected an - error. - ./ - } - /. - We either parsed the SELECT clause or ekpsel_c detected an - error. - ./ - - } - - } - - - - --Restrictions - - 1) Currently, column names are the only supported expressions. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 2.1.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 2.1.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for error flag used in - interface of ekpsel_. - - -CSPICE Version 2.0.0, 19-JUL-1999 (NJB) - - The data types of the tabs and cols arguments were changed - to (void *), and associated string length arguments were added. - This style of interface for string arrays is now standard within - CSPICE. - - Some corrections of the header comments were made. - - -CSPICE Version 1.0.0, 21-FEB-1999 (NJB) - --Index_Entries - - parse select clause of EK query - --& -*/ - -{ /* Begin ekpsel_c */ - - - /* - Local constants - - - XCLASSLEN is the maximum length of a short string indicating the - class of a SELECT clause item in a QUERY. The set of expected - strings is defined by the Fortran SPICELIB routine EKPSEL. The - current set of strings is {"COL", "FUNC", "EXPR"}. - */ - #define XCLASSLEN 4 - - - /* - TYPSIZ is the string length associated with the array locXtypes. - */ - #define TYPSIZ ( SPICE_EK_TYPLEN + 1 ) - - - /* - EXPSIZ is the string length associated with the array locXclass. - */ - #define EXPSIZ ( XCLASSLEN + 1 ) - - - /* - Local variables - */ - logical err; - - SpiceChar locXtypes[SPICE_EK_MXCLSG][TYPSIZ]; - SpiceChar locXclass[SPICE_EK_MXCLSG][EXPSIZ]; - SpiceChar * strptr; - - SpiceInt i; - SpiceInt lastnb; - - - - /* - Participate in error tracing. - */ - - chkin_c ( "ekpsel_c" ); - - /* - Check the input query string to make sure the pointer is non-null and - the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekpsel_c", query ); - - - /* - Make sure the output error message string has at least enough room - for one output character and a null terminator. Also check for a - null pointer. - */ - CHKOSTR ( CHK_STANDARD, "ekpsel_c", errmsg, msglen ); - - - /* - Call the f2c'd function. - */ - ekpsel_ ( ( char * ) query, - ( integer * ) n, - ( integer * ) xbegs, - ( integer * ) xends, - ( char * ) locXtypes, - ( char * ) locXclass, - ( char * ) tabs, - ( char * ) cols, - ( logical * ) &err, - ( char * ) errmsg, - ( ftnlen ) strlen(query), - ( ftnlen ) SPICE_EK_TYPLEN, - ( ftnlen ) XCLASSLEN, - ( ftnlen ) tablen-1, - ( ftnlen ) collen-1, - ( ftnlen ) msglen-1 ); - - - /* - Assign the SpiceBoolean error flag. - */ - - *error = err; - - - if ( failed_c() ) - { - chkout_c ( "ekpsel_c" ); - return; - } - - - /* - Convert the error message to a C style string. - */ - F2C_ConvertStr ( msglen, errmsg ); - - - /* - If there was a parse error, the other outputs are undefined. - */ - if ( *error ) - { - chkout_c ( "ekpsel_c" ); - return; - } - - - /* - Map the token begin and end indices from Fortran to C style. - */ - for ( i = 0; i < *n; i++ ) - { - xbegs[i]--; - xends[i]--; - } - - - /* - Map the expression data types from strings to SpiceEKDataType values. - First, map the Fortran-style strings returned by ekpsel_ to C - style strings. - */ - F2C_ConvertStrArr ( *n, TYPSIZ, (SpiceChar *)locXtypes ); - - - for ( i = 0; i < *n; i++ ) - { - if ( eqstr_c( locXtypes[i], "CHR" ) ) - { - xtypes[i] = SPICE_CHR; - } - - else if ( eqstr_c( locXtypes[i], "DP" ) ) - { - xtypes[i] = SPICE_DP; - } - - else if ( eqstr_c( locXtypes[i], "INT" ) ) - { - xtypes[i] = SPICE_INT; - } - - else if ( eqstr_c( locXtypes[i], "TIME" ) ) - { - xtypes[i] = SPICE_TIME; - } - - else - { - setmsg_c ( "Unrecognized data type string <#> returned " - "by ekpsel_ for item #." ); - errch_c ( "#", locXtypes[i] ); - errint_c ( "#", i ); - sigerr_c ( "SPICE(BUG)" ); - chkout_c ( "ekpsel_c" ); - return; - } - } - - /* - Map the expression classes from strings to SpiceEKExprClass values. - First, map the Fortran-style strings returned by ekpsel_ to C - style strings. - */ - F2C_ConvertStrArr ( *n, EXPSIZ, (SpiceChar *)locXclass ); - - for ( i = 0; i < *n; i++ ) - { - if ( eqstr_c( locXclass[i], "COL" ) ) - { - xclass[i] = SPICE_EK_EXP_COL; - } - - else if ( eqstr_c( locXclass[i], "FUNC" ) ) - { - xclass[i] = SPICE_EK_EXP_FUNC; - } - - else if ( eqstr_c( locXclass[i], "EXPR" ) ) - { - xclass[i] = SPICE_EK_EXP_EXPR; - } - - else - { - setmsg_c ( "Unrecognized item class string <#> returned " - "by ekpsel_ for item #." ); - errch_c ( "#", locXclass[i] ); - errint_c ( "#", i ); - sigerr_c ( "SPICE(BUG)" ); - chkout_c ( "ekpsel_c" ); - return; - } - } - - - /* - Convert the array of table names to a C style array of strings. - Null-terminate each string so as to eliminate trailing blanks. - */ - F2C_ConvertStrArr ( *n, tablen, (SpiceChar *)tabs ); - - for ( i = 0; i < *n; i++ ) - { - strptr = ((SpiceChar *)tabs) + i*tablen; - - lastnb = F_StrLen ( tablen-1, strptr ); - - *( strptr + lastnb ) = (char)0; - } - - /* - Convert the array of column names to a C style array of strings. - Null-terminate each string so as to eliminate trailing blanks. - */ - F2C_ConvertStrArr ( *n, collen, (SpiceChar *)cols ); - - for ( i = 0; i < *n; i++ ) - { - strptr = ((SpiceChar *)cols) + i*collen; - - lastnb = F_StrLen ( collen-1, strptr ); - - *( strptr + lastnb ) = (char)0; - } - - - chkout_c ( "ekpsel_c" ); - -} /* End ekpsel_c */ diff --git a/ext/spice/src/cspice/ekqmgr.c b/ext/spice/src/cspice/ekqmgr.c deleted file mode 100644 index b68dd58ad5..0000000000 --- a/ext/spice/src/cspice/ekqmgr.c +++ /dev/null @@ -1,7491 +0,0 @@ -/* ekqmgr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__20 = 20; -static integer c__200 = 200; -static integer c__10000 = 10000; -static integer c__500 = 500; -static integer c__100 = 100; -static integer c__24 = 24; -static integer c__11 = 11; -static integer c__10 = 10; -static integer c__1000 = 1000; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__11000 = 11000; - -/* $Procedure EKQMGR ( EK, query manager ) */ -/* Subroutine */ int ekqmgr_0_(int n__, integer *cindex, integer *elment, - char *eqryc, doublereal *eqryd, integer *eqryi, char *fname, integer * - row, integer *selidx, char *column, integer *handle, integer *n, char - *table, integer *attdsc, integer *ccount, logical *found, integer * - nelt, integer *nmrows, logical *semerr, char *errmsg, char *cdata, - doublereal *ddata, integer *idata, logical *null, ftnlen eqryc_len, - ftnlen fname_len, ftnlen column_len, ftnlen table_len, ftnlen - errmsg_len, ftnlen cdata_len) -{ - /* Initialized data */ - - static integer lelts[1000] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 }; - static integer oelts[10] = { 1,1,1,1,1,1,1,1,1,1 }; - static integer relts[1000] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 }; - static char chtype[4*4] = "CHR " "DP " "INT " "TIME"; - static integer fthead = 0; - static integer tbhead = 0; - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, - i__11, i__12, i__13, i__14; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char tabvec[64*16]; - static integer begidx, cdscrs[5500] /* was [11][500] */, cjrows, cjsize, - cnstyp[1000], col, colptr, delseg, endidx, key, keydsc[11], - ldscrs[11000] /* was [11][1000] */, ltbidx[1000], new__, - nmatch, norder, nsv, ops[1000], ordbas, nact, ntab, ptroff, rbas[ - 10], conj, rdscrs[11000] /* was [11][1000] */, resbas, nseg, - rowidx, rowvec[10], rtbidx[1000], nsel, rtotal, rwvbas, selcol[50] - , selctp[50], seltab[50], seg, segdsc[24], segvec[10], sgvbas, - tab, next, tabidx, tbcurr, top, tptvec[16], unit, unrows; - static logical activc[1000], activv[1000], attmch, dosort, fnd, indexd, - keyfnd, nulsok, presnt, sorted; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), lnkini_(integer *, integer *), dascls_(integer *), - dashlu_(integer *, integer *), zzekpgch_(integer *, char *, - ftnlen), setmsg_(char *, ftnlen), errfnm_(char *, integer *, - ftnlen), lnkilb_(integer *, integer *, integer *), ssizec_( - integer *, char *, ftnlen), validc_(integer *, integer *, char *, - ftnlen), lnkfsl_(integer *, integer *, integer *), errint_(char *, - integer *, ftnlen); - extern logical zzekrmch_(integer *, logical *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, char *, - integer *, integer *, doublereal *, integer *, ftnlen), zzekvmch_( - integer *, logical *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *); - extern /* Subroutine */ int zzeksinf_(integer *, integer *, char *, - integer *, char *, integer *, ftnlen, ftnlen), zzekreqi_(integer * - , char *, integer *, ftnlen), zzekqtab_(integer *, char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen), ssizei_( - integer *, integer *), appndc_(char *, char *, ftnlen, ftnlen), - appndi_(integer *, integer *), zzeksdec_(integer *), cleari_( - integer *, integer *), zzekqcnj_(integer *, integer *, integer *), - zzekqcon_(integer *, char *, doublereal *, integer *, integer *, - char *, integer *, char *, integer *, integer *, char *, integer * - , char *, integer *, integer *, integer *, integer *, doublereal * - , integer *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern integer zzekesiz_(integer *, integer *, integer *, integer *); - extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *), - zzekkey_(integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, integer *, integer *, - doublereal *, integer *, logical *, integer *, integer *, integer - *, integer *, logical *, ftnlen), zzekspsh_(integer *, integer *), - zzekixlk_(integer *, integer *, integer *, integer *), zzekrplk_( - integer *, integer *, integer *, integer *), zzekjoin_(integer *, - integer *, integer *, logical *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *), zzeksrd_( - integer *, integer *, integer *), zzekweed_(integer *, integer *, - integer *), zzekvset_(integer *, integer *), zzekqsel_(integer *, - char *, integer *, integer *, integer *, char *, integer *, char * - , integer *, ftnlen, ftnlen, ftnlen), zzekstop_(integer *); - static integer i__, cjbeg, j; - extern integer cardc_(char *, ftnlen); - static integer k, cbegs[1000], cjend, l, r__, t, cends[1000]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static logical cmtch; - static integer ubase[200], fthan[20]; - static char cnams[32*500]; - static integer lxbeg, lcidx[1000]; - extern /* Subroutine */ int ekcls_(integer *); - static integer cvlen; - static doublereal dvals[1000]; - static integer lxend, nconj, sthan[200], ivals[1000], ncols; - static char state[80]; - static integer ctnew; - extern integer lnktl_(integer *, integer *); - static integer dtnew, dtype[1000], jsize; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static integer npcol, ocols[10], otabs[10], jbase1, jbase2, rcidx[1000], - rsize[200], sense[10], sizes[1000], stnew, usize; - static logical vmtch; - extern /* Subroutine */ int ekopr_(char *, integer *, ftnlen), lnkan_( - integer *, integer *), movec_(char *, integer *, char *, ftnlen, - ftnlen), movei_(integer *, integer *, integer *), errch_(char *, - char *, ftnlen, ftnlen), zzekjsqz_(integer *), zzekqord_(integer * - , char *, integer *, char *, integer *, char *, integer *, - integer *, ftnlen, ftnlen, ftnlen), zzekjsrt_(integer *, integer * - , integer *, integer *, integer *, integer *, integer *, integer * - , integer *, integer *, integer *, integer *, integer *), - zzekvcal_(integer *, integer *, integer *), zzekrsc_(integer *, - integer *, integer *, integer *, integer *, integer *, char *, - logical *, logical *, ftnlen), zzekrsd_(integer *, integer *, - integer *, integer *, integer *, doublereal *, logical *, logical - *), zzekrsi_(integer *, integer *, integer *, integer *, integer * - , integer *, logical *, logical *); - extern logical failed_(void); - static integer ctclas[500]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - extern integer eknseg_(integer *), lnknxt_(integer *, integer *), lnknfn_( - integer *); - static integer ftpool[52] /* was [2][26] */, tbpool[212] /* was [2][ - 106] */, tbstpt[100], tbncol[100]; - static char tbnams[64*100]; - static integer tbctpt[100], tbfils[2000] /* was [20][100] */, tbflsz[ - 100], stpool[412] /* was [2][206] */, stsidx[200], stdscs[4800] - /* was [24][200] */, stnrow[200], stncol[200], stdtpt[200], - dtpool[20012] /* was [2][10006] */, dtdscs[110000] /* - was [11][10000] */, ctpool[1012] /* was [2][506] */; - static char ctnams[32*500]; - static integer cttyps[500], ctlens[500]; - static logical ctfixd[500]; - static integer ctsizs[500]; - static logical ctindx[500], ctnull[500]; - static char cnmset[32*506], colnam[32], frmals[64*10], frmtab[64*10], - lcname[32], ltname[64], problm[80], rcname[32], rtname[64], - tabnam[64]; - -/* $ Abstract */ - -/* Manage query operations on EK files. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* SEARCH */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Attribute Descriptor Parameters */ - -/* ekattdsc.inc Version 1 23-AUG-1995 (NJB) */ - - -/* This include file declares parameters used in EK column */ -/* attribute descriptors. Column attribute descriptors are */ -/* a simplified version of column descriptors: attribute */ -/* descriptors describe attributes of a column but do not contain */ -/* addresses or pointers. */ - - -/* Size of column attribute descriptor */ - - -/* Indices of various pieces of attribute descriptors: */ - - -/* ATTSIZ is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* ATTTYP is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* ATTLEN is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* ATTSIZ is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* ATTIDX is the location of a flag that indicates whether the column */ -/* is indexed. The flag takes the value ITRUE if the column is */ -/* indexed and otherwise takes the value IFALSE. */ - - -/* ATTNFL is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* End Include Section: EK Column Attribute Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ - - -/* Maximum number of join row sets in a join row set union: */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ -/* +--------------------------------------------+ elements */ - - -/* The following parameters indicate positions of elements in the */ -/* join row set structure: */ - - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* CINDEX I EKCII */ -/* ELMENT I EKGC, EKGD, EKGI */ -/* EQRYC I EKSRCH */ -/* EQRYD I EKSRCH */ -/* EQRYI I EKSRCH */ -/* FNAME I EKLEF */ -/* ROW I EKGC, EKGD, EKGI, EKNELT */ -/* SELIDX I EKGC, EKGD, EKGI, EKNELT */ -/* COLUMN I-O EKCIN, EKGC, EKGD, EKGI, EKNELT, EKCII */ -/* HANDLE I-O EKLEF, EKUEF */ -/* N I-O EKTNAM, EKNTAB */ -/* TABLE I-O EKCCNT, EKCII, EKTNAM */ -/* ATTDSC O EKCII, EKCIN */ -/* CCOUNT O EKCCNT */ -/* FOUND O EKCIN, EKGC, EKGD, EKGI */ -/* NELT O EKNELT */ -/* NMROWS O EKSRCH */ -/* SEMERR O EKSRCH */ -/* ERRMSG O EKSRCH */ -/* CDATA O EKGC */ -/* DDATA O EKGD */ -/* IDATA O EKGI */ -/* NULL O EKGC, EKGD, EKGI */ -/* FTSIZE P All */ -/* MAXCON P All */ -/* MXCLLD P All */ -/* STSIZE P All */ -/* MAXORD P All */ -/* CNAMSZ P All */ -/* ITSIZE P All */ - -/* $ Detailed_Input */ - -/* See the entry points for descriptions of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for descriptions of their outputs. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of EK files that may be */ -/* loaded. Any other DAS files loaded by the calling */ -/* program count against this limit. */ - -/* STSIZE is the size of the segment table; this is the */ -/* maximum number of segments that can be loaded at */ -/* one time. */ - -/* MXTBLD is the maximum number of tables that can be loaded */ -/* at any time. A table can consist of multiple */ -/* segments. */ - -/* MXCLLD is the maximum number of columns that can be loaded */ -/* at any time. A column may be spread across */ -/* multiple segments; in this case, the portions of */ -/* the column contained in each segment count against */ -/* this limit. */ - - -/* Many other parameters are defined in the include files referenced */ -/* above. See those files for details. */ - - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error */ -/* SPICE(BOGUSENTRY) is signalled. */ - -/* See the headers of the entry points for descriptions of exceptions */ -/* specific to those routines. */ - -/* $ Files */ - -/* This suite of routines reads binary `sequence component' EK files. */ -/* In order for a binary EK file to be accessible to this routine, */ -/* the file must be `loaded' via a call to the entry point EKLEF. */ - -/* Text format EK files cannot be used by this routine; they must */ -/* first be converted by binary format by the NAIF Toolkit utility */ -/* SPACIT. */ - -/* $ Particulars */ - -/* EKQMGR is an umbrella routine for its entry points: all variables */ -/* used by the entry points are declared here. */ - -/* EKQMGR supports loading and unloading EK files, executing queries, */ -/* and fetching the results of executed queries. The entry points */ -/* and their functions are: */ - -/* File loading and unloading: */ - -/* EKLEF ( EK, load event file ) */ -/* EKUEF ( EK, unload event file ) */ - -/* Query execution: */ - -/* EKSRCH ( EK, search for events ) */ - -/* Fetching query results: */ - -/* EKGC ( EK, get event data, character ) */ -/* EKGD ( EK, get event data, double precision ) */ -/* EKGI ( EK, get event data, integer ) */ - -/* Utilities: */ - -/* EKNTAB ( EK, return the number of loaded tables ) */ -/* EKTNAM ( EK, return the names of loaded tables ) */ -/* EKCCNT ( EK, return the column count of a table ) */ -/* EKCII ( EK, look up column info by index ) */ -/* EKNELT ( EK, return number of elements in column entry ) */ - - -/* To issue queries to the EK system, users would normally call the */ -/* high-level interface routine EKFIND. EKFIND parses queries and */ -/* converts them to the encoded form expected by EKSRCH. It is */ -/* possible to call EKSRCH directly, but this should not be attempted */ -/* by others than EK masters. EKFIND is not an entry point of */ -/* EKQMGR, but instead is a separate subroutine. */ - -/* $ Examples */ - -/* 1) Query the EK system and fetch data matching queries. */ -/* The code fragment shown here does not rely on advance */ -/* knowledge of the input query or the contents of any loaded EK */ -/* files. */ - -/* To simplify the example, we assume that all data are scalar. */ -/* This assumption relieves us of the need to test the size of */ -/* column entries before fetching them. In the event that a */ -/* column contains variable-size array entries, the entry point */ -/* EKNELT may be called to obtain the size of column entries to */ -/* be fetched. See EKNELT for an example. */ - - -/* C */ -/* C Load EK file. Also load leapseconds file for */ -/* C time conversion. */ -/* C */ -/* CALL EKLEF ( EK, HANDLE ) */ -/* CALL FURNSH ( LEAP ) */ - -/* C */ -/* C Prompt for query. Parse the SELECT clause using */ -/* C EKPSEL. */ -/* C */ -/* CALL PROMPT ( 'Enter query > ', QUERY ) */ - -/* CALL EKPSEL ( QUERY, */ -/* N, */ -/* XBEGS, */ -/* XENDS, */ -/* XBEGS, */ -/* XTYPES, */ -/* XCLASS, */ -/* TABS, */ -/* COLS, */ -/* ERROR, */ -/* ERRMSG ) */ - - -/* IF ( ERROR ) THEN */ - -/* WRITE (*,*) ERRMSG */ - -/* ELSE */ -/* C */ -/* C Submit query to the EK query system. */ -/* C */ -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* IF ( ERROR ) THEN */ - -/* WRITE (*,*) ERRMSG */ - -/* ELSE */ -/* C */ -/* C Fetch the rows that matched the query. */ -/* C */ -/* DO ROW = 1, NMROWS */ -/* C */ -/* C Fetch data from the Ith row. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ - -/* DO COL = 1, N */ -/* C */ -/* C Fetch the data from the Jth selected */ -/* C column. */ -/* C */ -/* IF ( XCLASS(COL) .EQ. 'COL' ) THEN */ - -/* OUTSTR = COLS(COL) */ -/* CALL PREFIX ( '.', 0, OUTSTR ) */ -/* CALL PREFIX ( TABS(COL), 0, OUTSTR ) */ -/* WRITE (*,*) 'COLUMN = ', OUTSTR */ - -/* ELSE */ - -/* B = XBEGS(COL) */ -/* E = XENDS(COL) */ -/* WRITE (*,*) 'ITEM = ', QUERY(B:E) */ - -/* END IF */ - -/* IF ( XTYPES(COL) .EQ. 'CHR' ) THEN */ - -/* CALL EKGC ( COL, ROW, 1, */ -/* . CDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) CDATA */ -/* END IF */ - - -/* ELSE IF ( XTYPES(COL) .EQ. 'DP' ) THEN */ - -/* CALL EKGD ( COL, ROW, 1, */ -/* . DDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) DDATA */ -/* END IF */ - - -/* ELSE IF ( XTYPES(COL) .EQ. 'INT' ) THEN */ - -/* CALL EKGI ( COL, ROW, 1, */ -/* . IDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) IDATA */ -/* END IF */ - - -/* ELSE */ -/* C */ -/* C The item is a time value. Convert it */ -/* C to UTC for output. */ -/* C */ -/* CALL EKGD ( COL, ROW, 1, */ -/* . TDATA, NULL, FOUND ) */ - -/* IF ( NULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* CALL ET2UTC ( TDATA, 'C', 3, UTC ) */ -/* WRITE (*,*) UTC */ -/* END IF */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C We're done with the column having index COL. */ -/* C */ -/* END DO */ -/* C */ -/* C We're done with the row having index ROW. */ -/* C */ -/* END IF */ -/* C */ -/* C We either processed the query or had an error. */ -/* C */ -/* END IF */ -/* C */ -/* C We either parsed the SELECT clause or had an error. */ -/* C */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 2.0.1, 22-SEP-2004 (EDW) */ - -/* Removed from the header descriptions, all occurences of the */ -/* token used to mark the $Procedure section. */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.3.0, 12-FEB-1999 (NJB) */ - -/* Bug fix: in entry point EKNELT, there was a error handling */ -/* branch that called CHKOUT where CHKIN should have been called. */ -/* This has been fixed. */ - -/* - SPICELIB Version 1.2.0, 21-JUL-1998 (NJB) */ - -/* In the entry point EKSRCH, a ZZEKJSQZ call was added after */ -/* the ZZEKJOIN call. This change reduces the scratch area usage */ -/* for intermediate results of joins. It also prevents ZZEKJOIN */ -/* from being handed a join row set containing a segment vector */ -/* having no corresponding row vectors. */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Code fixes were made in routines */ - -/* EKNELT, EKGC, EKGD, EKGI */ - -/* Version lines were fixed in all routines: versions were */ -/* changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Manage EK query operations */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 12-FEB-1999 (NJB) */ - -/* Bug fix: in entry point EKNELT, there was a error handling */ -/* branch that called CHKOUT where CHKIN should have been called. */ -/* This has been fixed. */ - -/* - SPICELIB Version 1.2.0, 21-JUL-1998 (NJB) */ - -/* In the entry point EKSRCH, a ZZEKJSQZ call was added after */ -/* the ZZEKJOIN call. This change reduces the scratch area usage */ -/* for intermediate results of joins. It also prevents ZZEKJOIN */ -/* from being handed a join row set containing a segment vector */ -/* having no corresponding row vectors. */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Code fixes were made in routines */ - -/* EKNELT, EKGC, EKGD, EKGI */ - -/* Version lines were fixed in all routines: versions were */ -/* changed from "Beta" to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Linked list functions: */ - -/* Find next node */ -/* Find tail of list */ -/* Return number of free nodes */ - - - -/* Local parameters */ - - -/* Maximum number of constraints allowed in a single query: */ - - -/* Miscellaneous parameters */ - - -/* Number of data types */ - - -/* Length of strings used for data type names. */ - - -/* Chunk size for buffered DAS integer reads. */ - - -/* Length of status strings. */ - - -/* Local variables */ - - -/* As do the CK and SPK `BSR' entry points, the EKQMGR entry points */ -/* make use of an amusing panoply of tables, linked lists, and */ -/* pointers. Here's where they're declared and described. */ - - -/* The file table contains a list of handles of loaded EK files. */ -/* Entries in the table are organized as a doubly linked list. */ -/* Names of file table variables begin with the string 'FT'. */ - -/* The maximum number of EK files that can be loaded is FTSIZE. */ - -/* The linked list pool used to index table entries is called */ -/* FTPOOL. */ - -/* FTHAN is an array containing file handles of loaded EKs. */ - -/* FTHEAD is the head node of the file list. */ - - -/* The table list contains table names, segment table pointers, */ -/* and column table pointers for every table associated with a */ -/* loaded segment. The segment table pointers indicate the head node */ -/* of the segment list for each table. The column table pointers */ -/* indicate the column names and attributes associated with each */ -/* table. */ - -/* The entries of the table list are organized as a doubly linked */ -/* list. All variables in the table list have names starting with */ -/* the string 'TB'. */ - -/* MXTBLD is the maximum number of tables that can be */ -/* accommodated by the table list. */ - -/* TBPOOL is the doubly linked list pool used to index the */ -/* table list. */ - -/* TBNAMS is an array of table names. */ - -/* TBSTPT is an array containing pointers to the heads of segment */ -/* lists corresponding to segments belonging to the table. */ - -/* TBNCOL is the number of columns in each table. */ - -/* TBCTPT is an array of pointers to lists of column table */ -/* entries giving the names and attributes of the columns in each */ -/* table. */ - -/* TBFILS is an array containing, for each table, handles of the */ -/* files that contain segments belonging to that table. */ - -/* TBFLSZ is an array of sizes of handle lists for each table */ -/* entry. */ - -/* TBHEAD is the head node of the table list. */ - - - - -/* The segment table contains descriptive information for each */ -/* loaded segment. Entries in the table are indexed by a linked */ -/* list pool containing a doubly linked list for each system (or */ -/* instrument) for which segments are loaded. */ - -/* Names of segment table variables begin with the string 'ST'. */ - -/* The maximum number of segments that can be loaded is MAXSEG. */ -/* Currently, the value of MAXSEG is just the size of the segment */ -/* table, STSIZE. */ - -/* The linked list pool used to index segment table entries is */ -/* called STPOOL. */ - -/* For each loaded segment, the following information is stored: */ - -/* -- The file handle of the EK containing the segment. */ - -/* -- The index of the segment within the EK that contains it. */ -/* Indices start at 1 and end with the segment count for the */ -/* EK file. */ - -/* -- The segment descriptor. */ - -/* -- The number of rows in the segment. */ - -/* -- The number of columns in the segment. */ - -/* -- A pointer to a list of column descriptors. The */ -/* column descriptor table contains a complete descriptor */ -/* for every loaded column. */ - - - - -/* The column descriptor table contains a column descriptor for */ -/* every loaded column. This table allows segments to share the */ -/* area used for buffering descriptors, making it reasonable for */ -/* the buffer space to have room for fewer than */ - -/* MXCLLD * MAXSEG */ - -/* column descriptors. */ - -/* The space in the table is organized as a doubly linked list. */ - - -/* The column attribute table contains attribute information for */ -/* every column in every loaded segment. There is one entry per */ -/* column name; columns with the same names and different data */ -/* types may not be loaded simultaneously. */ - -/* The entries of the column table are organized as a doubly linked */ -/* list. All variables in the column table have names starting with */ -/* the string 'CT'. */ - -/* CTSIZE is the maximum number of distinct column declarations */ -/* that can be accommodated by the column table. */ - -/* CTPOOL is the doubly linked list pool used to index the column */ -/* table. */ - -/* CTNAMS is an array containing column names. */ - -/* CTCLAS is an array containing column class specifiers. */ - -/* CTTYPS is an array containing column data types. */ - -/* CTLENS is an array containing column string length specifiers. */ - -/* CTFIXD is an array of logical flags indicating whether the */ -/* columns they correspond to have fixed size. */ - -/* CTSIZS is an array of integers indicating the number of array */ -/* elements per column entry, for fixed-size columns. */ - -/* CTINDX is an array of logical flags that indicate whether the */ -/* columns they correspond to are indexed. */ - -/* CTNULL is an array of logical flags that indicate whether the */ -/* columns they correspond to may contain null values. */ - - - - -/* Other local variables */ - - - -/* Saved variables */ - - - -/* Initial values */ - - /* Parameter adjustments */ - if (eqryd) { - } - if (eqryi) { - } - if (attdsc) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_eklef; - case 2: goto L_ekuef; - case 3: goto L_ekntab; - case 4: goto L_ektnam; - case 5: goto L_ekccnt; - case 6: goto L_ekcii; - case 7: goto L_eksrch; - case 8: goto L_eknelt; - case 9: goto L_ekgc; - case 10: goto L_ekgd; - case 11: goto L_ekgi; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKQMGR", (ftnlen)6); - } - -/* Never come here. */ - - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("EKQMGR", (ftnlen)6); - return 0; -/* $Procedure EKLEF ( EK, load event file ) */ - -L_eklef: -/* $ Abstract */ - -/* Load an EK file, making it accessible to the EK readers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* SEARCH */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of EK file to load. */ -/* HANDLE O File handle of loaded EK file. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a binary EK file to be loaded. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle of the EK file. The file is */ -/* accessible by the EK reader routines once it */ -/* has been loaded. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the EK file indicated by FNAME contains a column whose */ -/* name matches that of a column in an already loaded EK, but */ -/* whose declared attributes don't match those of the loaded */ -/* column of the same name, the error SPICE(BADATTRIBUTES) is */ -/* signalled. HANDLE is is undefined in this case. */ - -/* 2) Loading an EK file that is already loaded does not cause side */ -/* effects. The handle already associated with the file will be */ -/* returned. */ - -/* 3) If a file open error occurs, the problem will be diagnosed by */ -/* routines called by this routine. HANDLE is undefined in */ -/* this case. */ - -/* 4) If loading the input file would cause the maximum number of */ -/* loaded EK files to be exceeded, the error */ -/* SPICE(EKFILETABLEFULL) will be signalled. HANDLE is */ -/* undefined in this case. This routine will attempt to */ -/* unload the file from the DAS system. */ - -/* 5) If loading the input file would cause the maximum number of */ -/* loaded DAS files to be exceeded, the error will be diagnosed */ -/* by routines called by this routine. HANDLE is undefined in */ -/* this case. This routine will attempt to unload the file */ -/* from the DAS system. */ - -/* 6) If loading the input file would cause the maximum number of */ -/* segments allowed in loaded EK files to be exceeded, the error */ -/* SPICE(EKSEGMENTTABLEFULL) will be signalled. HANDLE is */ -/* is undefined in this case. This routine will attempt to */ -/* unload the file from the DAS system. */ - -/* 7) If loading the input file would cause the maximum number of */ -/* columns allowed in loaded EK files to be exceeded, the error */ -/* SPICE(EKCOLDESCTABLEFULL) will be signalled. HANDLE is */ -/* is undefined in this case. This routine will attempt to */ -/* unload the file from the DAS system. */ - -/* 8) If loading the input file would cause the maximum allowed */ -/* number of columns having distinct attributes in loaded EK */ -/* files to be exceeded, the error SPICE(EKCOLATTRTABLEFULL) will */ -/* be signalled. HANDLE is is undefined in this case. This */ -/* routine will attempt to unload the file from the DAS system. */ - -/* 9) If loading the input file would cause the maximum number of */ -/* instrument codes allowed in loaded EK files to be exceeded, */ -/* the error SPICE(EKIDTABLEFULL) will be signalled. HANDLE is */ -/* is undefined in this case. This routine will attempt to */ -/* unload the file from the DAS system. */ - -/* 10) If the input file does not contain at least one segment, the */ -/* error SPICE(EKNOSEGMENTS) will be signalled. */ - -/* $ Files */ - -/* See description of FNAME in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine makes EK files known to the EK system. It is */ -/* necessary to load EK files using this routine in order to */ -/* query the files using the EK readers. */ - -/* $ Examples */ - -/* 1) Load three EK files. During query execution, all files */ -/* will be searched. */ - -/* DO I = 1, 3 */ -/* CALL EKLEF ( EK(I), HANDLE ) */ -/* END DO */ - -/* [Perform queries] */ - - -/* 2) Load 25 EK files sequentially, unloading the previous file */ -/* before each new file is loaded. Unloading files prevents */ -/* them from being searched during query execution. */ - -/* DO I = 1, 25 */ - -/* CALL EKLEF ( EK(I), HANDLE ) */ - -/* [Perform queries] */ - -/* CALL EKUEF ( HANDLE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) EK files containing columns having the same name but */ -/* inconsistent declarations are not diagnosed. Such kernels */ -/* are invalid in any case. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* load EK file */ -/* load E-Kernel */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKLEF", (ftnlen)5); - } - -/* Here's a brief overview of what follows: */ - -/* -- We do some once-per-program run initializations. */ - -/* -- We do some simple error checks. We need to make sure */ -/* that DAS can load the file, and that the EK architecture is */ -/* the right kind. */ - -/* -- We need to make sure that there's enough space in our */ -/* data structures to hold the information about the new */ -/* EK. Some of these checks are simple; we do these first. */ -/* However, checking that we have enough room in the column */ -/* table is best done by simply loading the column data into */ -/* the table. If we run out of room, we abort the load. */ - -/* -- We also need to make sure that the column attributes for */ -/* any two columns with the same name in the same table are */ -/* identical. This is easy to do if the attributes for every */ -/* column we've encountered have been loaded into the column */ -/* table. */ - -/* -- We save the table name and column names and attributes for */ -/* each new table we encounter. For each table, we maintain a */ -/* list of handles of files that contain segments in that */ -/* table. */ - -/* -- We make a segment table entry for each segment we find. */ - -/* -- We save the column descriptor for each column we find, */ -/* associating it with the segment table entry for the segment */ -/* containing the column. The column descriptor entries are */ -/* linked together in the same order that the corresponding */ -/* column names appear in the parent table's column name list; */ -/* this order is not necessarily the order that the columns */ -/* have within the segment. */ - -/* -- We maintain a list of handles of loaded EKs. */ - -/* If we run out of room in the column table, we clean up our */ -/* mess. This means removing the current file's contributions */ -/* to the column table, segment table, file table, and if */ -/* necessary, the table list. */ - - -/* On the first pass through this routine, initialize the tables, */ -/* if it hasn't been done yet. */ - - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* Open the EK file for read access. Bail out now if this doesn't */ -/* work. This retreat will protect the various tables from */ -/* corruption. */ - - ekopr_(fname, handle, fname_len); - if (failed_()) { - chkout_("EKLEF", (ftnlen)5); - return 0; - } - -/* Check to see whether the named EK has already been loaded. */ -/* If so, we've added another link to the EK, which must be */ -/* removed. */ - - i__ = fthead; - while(i__ > 0) { - if (*handle == fthan[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "ekqmgr_", (ftnlen)1201)]) { - -/* The last call we made to EKOPR added another link to */ -/* the EK file. Remove this link. */ - - dascls_(handle); - chkout_("EKLEF", (ftnlen)5); - return 0; - } - i__ = lnknxt_(&i__, ftpool); - } - -/* Nothing doing unless the architecture is correct. This file */ -/* should be a paged DAS EK. */ - - zzekpgch_(handle, "READ", (ftnlen)4); - -/* Before getting too involved with this new EK file, let's check it */ -/* out. We must have enough room to accommodate it in the file */ -/* table, segment table, table list, and column table. */ - -/* Make sure there's enough room in the file table. */ - - if (lnknfn_(ftpool) == 0) { - -/* Sorry, there are no free file table entries left. */ - - dashlu_(handle, &unit); - ekcls_(handle); - setmsg_("The EK file # could not be loaded; the maximum number of lo" - "aded EKs has already been reached.", (ftnlen)93); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(EKFILETABLEFULL)", (ftnlen)22); - chkout_("EKLEF", (ftnlen)5); - return 0; - } - -/* Find out how many segments are in the new kernel, and make */ -/* sure there's enough room in the segment table. */ - - nseg = eknseg_(handle); - if (nseg > lnknfn_(stpool)) { - -/* There are too many segments for the amount of space we've got */ -/* left. */ - - dashlu_(handle, &unit); - ekcls_(handle); - setmsg_("The EK file # could not be loaded; the maximum number of lo" - "aded segments has already been reached.", (ftnlen)98); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(EKSEGTABLEFULL)", (ftnlen)21); - chkout_("EKLEF", (ftnlen)5); - return 0; - } else if (nseg < 1) { - dashlu_(handle, &unit); - ekcls_(handle); - setmsg_("The EK file # contains no segments.", (ftnlen)35); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(EKNOSEGMENTS)", (ftnlen)19); - chkout_("EKLEF", (ftnlen)5); - return 0; - } - -/* At this point, the file has insinuated itself into our confidence, */ -/* justified or not. We'll attempt to load the segment and column */ -/* tables, and we'll update the table list if new tables are */ -/* introduced in this file. */ - - seg = 1; - s_copy(state, "LOAD_FILE_TABLE", (ftnlen)80, (ftnlen)15); - while(s_cmp(state, "DONE", (ftnlen)80, (ftnlen)4) != 0) { - if (s_cmp(state, "LOAD_FILE_TABLE", (ftnlen)80, (ftnlen)15) == 0) { - -/* Allocate a file table entry and link the new entry in before */ -/* the current head of the list. Update the list head pointer. */ -/* Record the file handle in the new file table entry. */ - - lnkan_(ftpool, &new__); - lnkilb_(&new__, &fthead, ftpool); - fthead = new__; - fthan[(i__1 = new__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("fthan" - , i__1, "ekqmgr_", (ftnlen)1303)] = *handle; - s_copy(state, "SUMMARIZE_SEGMENT", (ftnlen)80, (ftnlen)17); - } else if (s_cmp(state, "SUMMARIZE_SEGMENT", (ftnlen)80, (ftnlen)17) - == 0) { - -/* Get the summary information for this segment. */ - - zzeksinf_(handle, &seg, tabnam, segdsc, cnams, cdscrs, (ftnlen)64, - (ftnlen)32); - ncols = segdsc[4]; - -/* Before going further, check the segment for duplicate */ -/* column names. Bail out if we find any. */ - - ssizec_(&c__500, cnmset, (ftnlen)32); - movec_(cnams, &ncols, cnmset + 192, (ftnlen)32, (ftnlen)32); - validc_(&c__500, &ncols, cnmset, (ftnlen)32); - if (cardc_(cnmset, (ftnlen)32) < ncols) { - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "DUPLICATE_COLUMN_NAMES", (ftnlen)80, (ftnlen) - 22); - } else { - s_copy(state, "FIND_TABLE", (ftnlen)80, (ftnlen)10); - } - } else if (s_cmp(state, "FIND_TABLE", (ftnlen)80, (ftnlen)10) == 0) { - -/* Traverse the table list, checking for a match. */ - - tbcurr = tbhead; - presnt = FALSE_; - while(tbcurr > 0 && ! presnt) { - if (s_cmp(tabnam, tbnams + (((i__1 = tbcurr - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("tbnams", i__1, "ekqmgr_", ( - ftnlen)1348)) << 6), (ftnlen)64, (ftnlen)64) == 0) { - presnt = TRUE_; - } else { - tbcurr = lnknxt_(&tbcurr, tbpool); - } - } - -/* If TABNAM is the name of a table we know about, go on to */ -/* fill out the segment list entry for the current segment. */ -/* If we didn't find TABNAM, we have a new table. Make a table */ -/* list entry for it. */ - - if (presnt) { - -/* Before going further, make sure the number of columns */ -/* in the segment matches the number of columns in the */ -/* parent table. */ - - if (ncols != tbncol[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbncol", i__1, "ekqmgr_", (ftnlen)1368) - ]) { - npcol = tbncol[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbncol", i__1, "ekqmgr_", (ftnlen) - 1370)]; - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "COLUMN_NUMBER_MISMATCH", (ftnlen)80, ( - ftnlen)22); - } else { - -/* Add the current file to the list of files containing */ -/* the current table. */ - - tbfils[(i__1 = tbcurr * 20 - 20) < 2000 && 0 <= i__1 ? - i__1 : s_rnge("tbfils", i__1, "ekqmgr_", (ftnlen) - 1379)] = *handle; - tbflsz[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("tbflsz", i__1, "ekqmgr_", (ftnlen)1380)] = - tbflsz[(i__2 = tbcurr - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("tbflsz", i__2, "ekqmgr_", (ftnlen) - 1380)] + 1; - s_copy(state, "MAKE_SEGMENT_TABLE_ENTRY", (ftnlen)80, ( - ftnlen)24); - } - } else { - -/* This segment belongs to a new table. */ - - s_copy(state, "MAKE_TABLE_LIST_ENTRY", (ftnlen)80, (ftnlen)21) - ; - } - } else if (s_cmp(state, "MAKE_TABLE_LIST_ENTRY", (ftnlen)80, (ftnlen) - 21) == 0) { - -/* Allocate a table list entry, if we can. */ - - if (lnknfn_(tbpool) == 0) { - -/* Oops, we're out of room. */ - - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "TABLE_LIST_FULL", (ftnlen)80, (ftnlen)15); - } else { - -/* We have an entry; link it to the tail of the table list. */ -/* For consistency with the case in which the table entry */ -/* already exists, we'll call the table list node TBCURR. */ - -/* If this is the first table in the table list, set the */ -/* table head pointer. */ - - lnkan_(tbpool, &tbcurr); - if (tbhead <= 0) { - tbhead = tbcurr; - } else { - lnkilb_(&tbhead, &tbcurr, tbpool); - } - -/* Fill in the table name. */ - - s_copy(tbnams + (((i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbnams", i__1, "ekqmgr_", (ftnlen)1428) - ) << 6), tabnam, (ftnlen)64, (ftnlen)64); - -/* Since this table is new, the file list for this table */ -/* contains only the handle of the current EK. */ - - tbfils[(i__1 = tbcurr * 20 - 20) < 2000 && 0 <= i__1 ? i__1 : - s_rnge("tbfils", i__1, "ekqmgr_", (ftnlen)1433)] = * - handle; - tbflsz[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbflsz", i__1, "ekqmgr_", (ftnlen)1434)] = 1; - -/* Initialize the column count, column table pointer, and */ -/* segment list pointer for this table. */ - - tbncol[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbncol", i__1, "ekqmgr_", (ftnlen)1440)] = ncols; - tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbctpt", i__1, "ekqmgr_", (ftnlen)1441)] = 0; - tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbstpt", i__1, "ekqmgr_", (ftnlen)1442)] = 0; - -/* Go on to add a segment table entry for the current */ -/* segment. */ - - s_copy(state, "MAKE_SEGMENT_TABLE_ENTRY", (ftnlen)80, (ftnlen) - 24); - } - } else if (s_cmp(state, "MAKE_SEGMENT_TABLE_ENTRY", (ftnlen)80, ( - ftnlen)24) == 0) { - -/* Add the data for the current segment to the segment */ -/* table. */ - -/* Allocate a segment table entry. We've already verified */ -/* that there's enough room. */ - - lnkan_(stpool, &stnew); - -/* Link this segment table entry to the tail of the segment */ -/* list for the parent table, or, if the tail is NIL, just set */ -/* the segment list pointer to the current segment node. */ - - if (tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbstpt", i__1, "ekqmgr_", (ftnlen)1468)] <= 0) { - tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbstpt", i__1, "ekqmgr_", (ftnlen)1470)] = stnew; - } else { - lnkilb_(&tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("tbstpt", i__1, "ekqmgr_", (ftnlen)1474)], & - stnew, stpool); - } - -/* At this point, we can fill in all elements of the segment */ -/* table entry except for the pointers into the column table */ -/* and the column base addresses. */ - - sthan[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("sth" - "an", i__1, "ekqmgr_", (ftnlen)1483)] = *handle; - stsidx[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "stsidx", i__1, "ekqmgr_", (ftnlen)1484)] = seg; - stnrow[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "stnrow", i__1, "ekqmgr_", (ftnlen)1485)] = segdsc[5]; - stncol[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "stncol", i__1, "ekqmgr_", (ftnlen)1486)] = segdsc[4]; - stdtpt[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "stdtpt", i__1, "ekqmgr_", (ftnlen)1487)] = 0; - movei_(segdsc, &c__24, &stdscs[(i__1 = stnew * 24 - 24) < 4800 && - 0 <= i__1 ? i__1 : s_rnge("stdscs", i__1, "ekqmgr_", ( - ftnlen)1489)]); - -/* The next step is to set up the column attributes and */ -/* descriptors. */ - - s_copy(state, "MAKE_COLUMN_TABLE_ENTRIES", (ftnlen)80, (ftnlen)25) - ; - } else if (s_cmp(state, "MAKE_COLUMN_TABLE_ENTRIES", (ftnlen)80, ( - ftnlen)25) == 0) { - if (presnt) { - -/* If the current table was present before loading the */ -/* current segment, we must make sure that the attributes */ -/* of the columns in this segment match those of the table */ -/* to which the segment belongs. */ - -/* We must load the column descriptors for this segment */ -/* in the *same order* as those for every other segment */ -/* in the table. This order matches that of the columns */ -/* in the column attribute list for the table. */ - -/* For each column in the column list of the current table, */ -/* check the list of column names for the current segment, */ -/* looking for a match. */ - - j = tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("tbctpt", i__1, "ekqmgr_", (ftnlen)1518)]; - while(j > 0 && s_cmp(state, "ABORT", (ftnlen)80, (ftnlen)5) != - 0) { - k = isrchc_(ctnams + (((i__1 = j - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("ctnams", i__1, "ekqmgr_", (ftnlen) - 1524)) << 5), &ncols, cnams, (ftnlen)32, (ftnlen) - 32); - if (k > 0) { - -/* We have a name match. At this point, we must */ -/* check that the column's other attributes---data */ -/* type, size, and whether the column is */ -/* indexed---match as well. It's an error if they */ -/* don't. */ - - indexd = cdscrs[(i__1 = k * 11 - 6) < 5500 && 0 <= - i__1 ? i__1 : s_rnge("cdscrs", i__1, "ekqmgr_" - , (ftnlen)1535)] != -1; - nulsok = cdscrs[(i__1 = k * 11 - 4) < 5500 && 0 <= - i__1 ? i__1 : s_rnge("cdscrs", i__1, "ekqmgr_" - , (ftnlen)1536)] != -1; - attmch = cdscrs[(i__1 = k * 11 - 11) < 5500 && 0 <= - i__1 ? i__1 : s_rnge("cdscrs", i__1, "ekqmgr_" - , (ftnlen)1537)] == ctclas[(i__2 = j - 1) < - 500 && 0 <= i__2 ? i__2 : s_rnge("ctclas", - i__2, "ekqmgr_", (ftnlen)1537)] && cdscrs[( - i__3 = k * 11 - 10) < 5500 && 0 <= i__3 ? - i__3 : s_rnge("cdscrs", i__3, "ekqmgr_", ( - ftnlen)1537)] == cttyps[(i__4 = j - 1) < 500 - && 0 <= i__4 ? i__4 : s_rnge("cttyps", i__4, - "ekqmgr_", (ftnlen)1537)] && cdscrs[(i__5 = k - * 11 - 9) < 5500 && 0 <= i__5 ? i__5 : s_rnge( - "cdscrs", i__5, "ekqmgr_", (ftnlen)1537)] == - ctlens[(i__6 = j - 1) < 500 && 0 <= i__6 ? - i__6 : s_rnge("ctlens", i__6, "ekqmgr_", ( - ftnlen)1537)] && cdscrs[(i__7 = k * 11 - 8) < - 5500 && 0 <= i__7 ? i__7 : s_rnge("cdscrs", - i__7, "ekqmgr_", (ftnlen)1537)] == ctsizs[( - i__8 = j - 1) < 500 && 0 <= i__8 ? i__8 : - s_rnge("ctsizs", i__8, "ekqmgr_", (ftnlen) - 1537)] && indexd == ctindx[(i__9 = j - 1) < - 500 && 0 <= i__9 ? i__9 : s_rnge("ctindx", - i__9, "ekqmgr_", (ftnlen)1537)] && nulsok == - ctnull[(i__10 = j - 1) < 500 && 0 <= i__10 ? - i__10 : s_rnge("ctnull", i__10, "ekqmgr_", ( - ftnlen)1537)]; - if (attmch) { - -/* Great, the attributes match. Actually, the */ -/* addition of the current segment can *change* */ -/* one attribute of the current table: the */ -/* maximum non-blank width associated with the */ -/* current column, if the column has character */ -/* type. We'll make this change after we're */ -/* sure we won't have to undo it. */ - -/* Store the column descriptor for this column */ -/* in the descriptor table. We'll need to */ -/* allocate a descriptor table entry first. */ - - if (lnknfn_(dtpool) == 0) { - -/* No free nodes left in the descriptor table. */ - - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "DESCRIPTOR_TABLE_FULL", ( - ftnlen)80, (ftnlen)21); - } else { - -/* A free node is available. Link it in */ -/* at the tail of the descriptor list for */ -/* the current segment. */ - - lnkan_(dtpool, &dtnew); - if (stdtpt[(i__1 = stnew - 1) < 200 && 0 <= - i__1 ? i__1 : s_rnge("stdtpt", i__1, - "ekqmgr_", (ftnlen)1575)] <= 0) { - stdtpt[(i__1 = stnew - 1) < 200 && 0 <= - i__1 ? i__1 : s_rnge("stdtpt", - i__1, "ekqmgr_", (ftnlen)1577)] = - dtnew; - } else { - lnkilb_(&stdtpt[(i__1 = stnew - 1) < 200 - && 0 <= i__1 ? i__1 : s_rnge( - "stdtpt", i__1, "ekqmgr_", ( - ftnlen)1581)], &dtnew, dtpool); - } - -/* Fill in the descriptor. */ - - movei_(&cdscrs[(i__1 = k * 11 - 11) < 5500 && - 0 <= i__1 ? i__1 : s_rnge("cdscrs", - i__1, "ekqmgr_", (ftnlen)1588)], & - c__11, &dtdscs[(i__2 = dtnew * 11 - - 11) < 110000 && 0 <= i__2 ? i__2 : - s_rnge("dtdscs", i__2, "ekqmgr_", ( - ftnlen)1588)]); - } - -/* We filled in a descriptor table entry, or */ -/* else we ran out of room. */ - - } else { - -/* Seriously bad news. Someone's tried to */ -/* load an EK containing a column with */ -/* attributes that conflict with those of a */ -/* loaded column of the same name in the */ -/* current table. */ - - s_copy(colnam, ctnams + (((i__1 = j - 1) < 500 && - 0 <= i__1 ? i__1 : s_rnge("ctnams", i__1, - "ekqmgr_", (ftnlen)1606)) << 5), (ftnlen) - 32, (ftnlen)32); - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "MISMATCHED_COLUMN_ATTRIBUTES", ( - ftnlen)80, (ftnlen)28); - } - } else { - -/* No name match; the current column from the current */ -/* table is not present in the segment we're looking */ -/* at. */ - - s_copy(colnam, ctnams + (((i__1 = j - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("ctnams", i__1, "ekqmg" - "r_", (ftnlen)1619)) << 5), (ftnlen)32, ( - ftnlen)32); - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "MISSING_COLUMN", (ftnlen)80, (ftnlen) - 14); - } - -/* The current column matched one in the column list */ -/* for the current table, or else we have a problem. */ - -/* Advance to the next column in the table's column list. */ - - if (s_cmp(state, "ABORT", (ftnlen)80, (ftnlen)5) != 0) { - j = lnknxt_(&j, ctpool); - } - } - -/* We've made descriptor table entries for each column in */ -/* the current segment, or else we have an error. */ - - } else { - -/* We need to set up the column attribute entries for */ -/* the new table introduced by loading this segment. We */ -/* also need to set up descriptor table entries for the */ -/* segment. We *don't* have to check the consistency of */ -/* the attributes of the columns. */ - - k = 1; - while(k <= ncols && s_cmp(state, "ABORT", (ftnlen)80, (ftnlen) - 5) != 0) { - -/* Allocate a new entry in the column attribute table and */ -/* link it to the tail of the column list for the */ -/* current table. If the column list is empty, update */ -/* the list head. */ - - if (lnknfn_(ctpool) == 0) { - -/* There's no more space to store attribute */ -/* descriptors. */ - - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "ATTRIBUTE_TABLE_FULL", (ftnlen)80, ( - ftnlen)20); - } else { - lnkan_(ctpool, &ctnew); - if (tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbctpt", i__1, "ekqmgr_", ( - ftnlen)1670)] <= 0) { - tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbctpt", i__1, "ekqmgr_", ( - ftnlen)1672)] = ctnew; - } else { - lnkilb_(&tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("tbctpt", i__1, - "ekqmgr_", (ftnlen)1676)], &ctnew, ctpool) - ; - } - -/* Fill in the new column attribute entry with the */ -/* attributes for this column. */ - - s_copy(ctnams + (((i__1 = ctnew - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("ctnams", i__1, "ekqmgr_" - , (ftnlen)1684)) << 5), cnams + (((i__2 = k - - 1) < 500 && 0 <= i__2 ? i__2 : s_rnge("cnams", - i__2, "ekqmgr_", (ftnlen)1684)) << 5), ( - ftnlen)32, (ftnlen)32); - ctclas[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctclas", i__1, "ekqmgr_", (ftnlen) - 1685)] = cdscrs[(i__2 = k * 11 - 11) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1685)]; - cttyps[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("cttyps", i__1, "ekqmgr_", (ftnlen) - 1686)] = cdscrs[(i__2 = k * 11 - 10) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1686)]; - ctlens[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctlens", i__1, "ekqmgr_", (ftnlen) - 1687)] = cdscrs[(i__2 = k * 11 - 9) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1687)]; - ctsizs[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctsizs", i__1, "ekqmgr_", (ftnlen) - 1688)] = cdscrs[(i__2 = k * 11 - 8) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1688)]; - ctindx[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctindx", i__1, "ekqmgr_", (ftnlen) - 1689)] = cdscrs[(i__2 = k * 11 - 6) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1689)] != -1; - ctfixd[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctfixd", i__1, "ekqmgr_", (ftnlen) - 1690)] = cdscrs[(i__2 = k * 11 - 8) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1690)] != -1; - ctnull[(i__1 = ctnew - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctnull", i__1, "ekqmgr_", (ftnlen) - 1691)] = cdscrs[(i__2 = k * 11 - 4) < 5500 && - 0 <= i__2 ? i__2 : s_rnge("cdscrs", i__2, - "ekqmgr_", (ftnlen)1691)] != -1; - -/* Store the column descriptor for this column */ -/* in the descriptor table. We'll need to */ -/* allocate a descriptor table entry first. */ - - if (lnknfn_(dtpool) == 0) { - -/* No free nodes left in the descriptor table. */ - - s_copy(state, "ABORT", (ftnlen)80, (ftnlen)5); - s_copy(problm, "DESCRIPTOR_TABLE_FULL", (ftnlen) - 80, (ftnlen)21); - } else { - -/* A free node is available. Link it in at the */ -/* tail of the descriptor list for the current */ -/* segment. */ - - lnkan_(dtpool, &dtnew); - if (stdtpt[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("stdtpt", i__1, "ekqmgr_", - (ftnlen)1713)] <= 0) { - stdtpt[(i__1 = stnew - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("stdtpt", i__1, "ekqm" - "gr_", (ftnlen)1715)] = dtnew; - } else { - lnkilb_(&stdtpt[(i__1 = stnew - 1) < 200 && 0 - <= i__1 ? i__1 : s_rnge("stdtpt", - i__1, "ekqmgr_", (ftnlen)1719)], & - dtnew, dtpool); - } - -/* Fill in the descriptor. */ - - movei_(&cdscrs[(i__1 = k * 11 - 11) < 5500 && 0 <= - i__1 ? i__1 : s_rnge("cdscrs", i__1, - "ekqmgr_", (ftnlen)1726)], &c__11, & - dtdscs[(i__2 = dtnew * 11 - 11) < 110000 - && 0 <= i__2 ? i__2 : s_rnge("dtdscs", - i__2, "ekqmgr_", (ftnlen)1726)]); - } - } - -/* We created attribute and descriptor entries for the */ -/* current column, or we encountered an error. */ - - if (s_cmp(state, "ABORT", (ftnlen)80, (ftnlen)5) != 0) { - -/* Consider the next column. */ - - ++k; - } - } - -/* We created attribute and descriptor entries for every */ -/* column in the current segment, or we encountered an */ -/* error. */ - - } - -/* We've processed the current segment in the new file, or */ -/* else we have an error condition. */ - - if (s_cmp(state, "ABORT", (ftnlen)80, (ftnlen)5) != 0) { - -/* We're ready to look at the next segment in the new file. */ - - s_copy(state, "NEXT_SEGMENT", (ftnlen)80, (ftnlen)12); - } - } else if (s_cmp(state, "NEXT_SEGMENT", (ftnlen)80, (ftnlen)12) == 0) - { - if (seg < nseg) { - ++seg; - s_copy(state, "SUMMARIZE_SEGMENT", (ftnlen)80, (ftnlen)17); - } else { - -/* We're done with all of the segments. */ - - s_copy(state, "DONE", (ftnlen)80, (ftnlen)4); - } - } else if (s_cmp(state, "ABORT", (ftnlen)80, (ftnlen)5) == 0) { - -/* We must clean up all the data structure additions we made to */ -/* accommodate the new file. */ - -/* Basically, we unload the new file. We defer the call to */ -/* EKCLS until after we've reported the error. */ - -/* The file table is first. The file is at the head of the */ -/* list. If the file has a successor, that file is now at the */ -/* head of the list. */ - - fthead = lnknxt_(&new__, ftpool); - if (fthead < 0) { - -/* There are no files left. Clean up the whole shebang. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - } else { - -/* If we arrived here, the file we're unloading is not the */ -/* only loaded file. */ - -/* Free the file table entry for the file. The entry can be */ -/* regarded as a sublist that starts and ends with the Ith */ -/* node, so we can call the `free sublist' routine to get */ -/* rid of it. */ - - lnkfsl_(&new__, &new__, ftpool); - -/* It's time to clean up the table list, segment table, */ -/* column attribute table, and column descriptor table. The */ -/* plan is to traverse the table list, and for each member */ -/* of the list, traverse the corresponding segment list, */ -/* removing from the list information about segments and */ -/* columns in the file we're unloading. If the segment list */ -/* for any table becomes empty, we remove the entry for that */ -/* table from the table list. */ - - tbcurr = tbhead; - while(tbcurr > 0) { - -/* See whether the current table is in the file we're */ -/* unloading. */ - - i__ = 1; - while(i__ <= tbflsz[(i__1 = tbcurr - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("tbflsz", i__1, "ekqmgr_", ( - ftnlen)1847)] && ! fnd) { - if (tbfils[(i__1 = i__ + tbcurr * 20 - 21) < 2000 && - 0 <= i__1 ? i__1 : s_rnge("tbfils", i__1, - "ekqmgr_", (ftnlen)1850)] == *handle) { - -/* This table is affected by unloading the file. */ - - fnd = TRUE_; - } else { - -/* Look at the next file handle. */ - - ++i__; - } - } - if (fnd) { - -/* Update the information for the current table to */ -/* reflect the unloading of the specified EK. */ - -/* Unloading the specified EK removes one handle from */ -/* the list of file handles associated with this */ -/* table. Compress this handle out of the list. */ - - i__2 = tbflsz[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbflsz", i__1, "ekqmgr_", ( - ftnlen)1876)] - 1; - for (j = i__; j <= i__2; ++j) { - tbfils[(i__1 = j + tbcurr * 20 - 21) < 2000 && 0 - <= i__1 ? i__1 : s_rnge("tbfils", i__1, - "ekqmgr_", (ftnlen)1878)] = tbfils[(i__3 = - j + 1 + tbcurr * 20 - 21) < 2000 && 0 <= - i__3 ? i__3 : s_rnge("tbfils", i__3, - "ekqmgr_", (ftnlen)1878)]; - } - tbflsz[(i__2 = tbcurr - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("tbflsz", i__2, "ekqmgr_", (ftnlen) - 1882)] = tbflsz[(i__1 = tbcurr - 1) < 100 && - 0 <= i__1 ? i__1 : s_rnge("tbflsz", i__1, - "ekqmgr_", (ftnlen)1882)] - 1; - -/* Traverse the segment list for this table, looking */ -/* for segments in the specified EK. */ - - delseg = tbstpt[(i__2 = tbcurr - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("tbstpt", i__2, "ekqmgr_" - , (ftnlen)1888)]; - while(delseg > 0) { - if (sthan[(i__2 = delseg - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("sthan", i__2, "ekqmgr_", ( - ftnlen)1892)] == *handle) { - -/* This segment is aboard the sinking ship. Put */ -/* it out of its misery. */ - -/* First, euthanatize its column descriptors. */ -/* These descriptors are linked together, so we */ -/* can free all of them in one shot. */ - - j = stdtpt[(i__2 = delseg - 1) < 200 && 0 <= - i__2 ? i__2 : s_rnge("stdtpt", i__2, - "ekqmgr_", (ftnlen)1901)]; - if (j > 0) { - k = lnktl_(&j, dtpool); - lnkfsl_(&j, &k, dtpool); - } - -/* Now we can delete the segment table entry */ -/* itself. This deletion may necessitate */ -/* updating the segment list pointer in the */ -/* parent table's table list entry. */ - - if (delseg == tbstpt[(i__2 = tbcurr - 1) < - 100 && 0 <= i__2 ? i__2 : s_rnge( - "tbstpt", i__2, "ekqmgr_", (ftnlen) - 1914)]) { - tbstpt[(i__2 = tbcurr - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("tbstpt", - i__2, "ekqmgr_", (ftnlen)1916)] = - lnknxt_(&delseg, stpool); - } - next = lnknxt_(&delseg, stpool); - lnkfsl_(&delseg, &delseg, stpool); - -/* The segment we just freed may have been the */ -/* last one belonging to this table. We deal */ -/* with this possibility later, below the end of */ -/* the current loop. */ - - delseg = next; - } else { - delseg = lnknxt_(&delseg, stpool); - } - } - -/* We've examined all of the segments in the current */ -/* table. */ - -/* If the segment list for the current table became */ -/* empty as a result of our having plundered the */ -/* segment table, delete the entry for this table from */ -/* the table list. We do *not* need to concern */ -/* ourselves with the possibility that this deletion */ -/* will empty the table list, since we know we're */ -/* not unloading the last loaded file. However, we */ -/* may need to update the head-of-list pointer for the */ -/* table list. */ - - if (tbstpt[(i__2 = tbcurr - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("tbstpt", i__2, "ekqmgr_", ( - ftnlen)1955)] <= 0) { - -/* There are no loaded segments left for this */ -/* table. */ - -/* Delete the list of column attribute entries for */ -/* the columns in this table, then delete the */ -/* table's entry from the table list. */ - -/* The column attribute entries are linked, so we */ -/* can free them in one shot. Don't crash if the */ -/* column attribute list is empty. */ - - j = tbctpt[(i__2 = tbcurr - 1) < 100 && 0 <= i__2 - ? i__2 : s_rnge("tbctpt", i__2, "ekqmgr_", - (ftnlen)1968)]; - if (j > 0) { - k = lnktl_(&j, ctpool); - lnkfsl_(&j, &k, ctpool); - } - if (tbcurr == tbhead) { - -/* The entry for this table is at the head of */ -/* the table list. Update the head of the list. */ - - tbhead = lnknxt_(&tbcurr, tbpool); - next = tbhead; - } else { - next = lnknxt_(&tbcurr, tbpool); - } - -/* Make the entry for this table go away. */ - - lnkfsl_(&tbcurr, &tbcurr, tbpool); - -/* Look at the next table. */ - - tbcurr = next; - } else { - -/* We're done with the current table. Look at the */ -/* next one. */ - - tbcurr = lnknxt_(&tbcurr, tbpool); - } - -/* We've cleaned up the table entry for the current */ -/* table, if it was necessary to do so. */ - - } else { - -/* The current table is not affected by unloading this */ -/* file. Examine the next table. */ - - tbcurr = lnknxt_(&tbcurr, tbpool); - } - -/* We've processed the current table. */ - - } - } - -/* We've cleaned up after the aborted partial load. */ - -/* Now that the mess has been arranged, tell the user what the */ -/* problem was. */ - - dashlu_(handle, &unit); - if (s_cmp(problm, "TABLE_LIST_FULL", (ftnlen)80, (ftnlen)15) == 0) - { - setmsg_("The EK file # could not be loaded; the maximum numb" - "er of distinct tables has already been reached.", ( - ftnlen)98); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(EKTABLELISTFULL)", (ftnlen)22); - } else if (s_cmp(problm, "DUPLICATE_COLUMN_NAMES", (ftnlen)80, ( - ftnlen)22) == 0) { - setmsg_("The EK file # could not be loaded; the segment # co" - "ntains duplicate column names in table #.", (ftnlen) - 92); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &seg, (ftnlen)1); - errch_("#", tabnam, (ftnlen)1, (ftnlen)64); - sigerr_("SPICE(EKCOLNUMMISMATCH)", (ftnlen)23); - } else if (s_cmp(problm, "COLUMN_NUMBER_MISMATCH", (ftnlen)80, ( - ftnlen)22) == 0) { - setmsg_("The EK file # could not be loaded; the number of co" - "lumns (#) in segment # does not match the number of " - "columns (#) in the parent table #.", (ftnlen)137); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &ncols, (ftnlen)1); - errint_("#", &seg, (ftnlen)1); - errint_("#", &npcol, (ftnlen)1); - errch_("#", tabnam, (ftnlen)1, (ftnlen)64); - sigerr_("SPICE(EKCOLNUMMISMATCH)", (ftnlen)23); - } else if (s_cmp(problm, "MISMATCHED_COLUMN_ATTRIBUTES", (ftnlen) - 80, (ftnlen)28) == 0) { - setmsg_("EK file # contains a column whose attributes confli" - "ct with a loaded column. The offending column name " - "is #; the column is in segment #* of the file.", ( - ftnlen)149); - errfnm_("#", &unit, (ftnlen)1); - errch_("#", colnam, (ftnlen)1, (ftnlen)32); - errint_("*", &seg, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTES)", (ftnlen)20); - } else if (s_cmp(problm, "DESCRIPTOR_TABLE_FULL", (ftnlen)80, ( - ftnlen)21) == 0) { - setmsg_("The EK file # could not be loaded; themaximum allow" - "ed number of loaded columns already been reached.", ( - ftnlen)100); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(COLDESCTABLEFULL)", (ftnlen)23); - } else if (s_cmp(problm, "ATTRIBUTE_TABLE_FULL", (ftnlen)80, ( - ftnlen)20) == 0) { - setmsg_("The EK file # could not be loaded; the maximum numb" - "er of columns havingdistinct attributes has already " - "been reached.", (ftnlen)116); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(EKCOLATTRTABLEFULL)", (ftnlen)25); - } else if (s_cmp(problm, "MISSING_COLUMN", (ftnlen)80, (ftnlen)14) - == 0) { - setmsg_("The EK file # could not be loaded; the column # in " - "already loaded table # is not present in segment # i" - "n the EK file.", (ftnlen)117); - errfnm_("#", &unit, (ftnlen)1); - errch_("#", colnam, (ftnlen)1, (ftnlen)32); - errch_("#", tabnam, (ftnlen)1, (ftnlen)64); - errint_("#", &seg, (ftnlen)1); - sigerr_("SPICE(EKMISSINGCOLUMN)", (ftnlen)22); - } else { - setmsg_("The EK file # could not be loaded; the problem \"" - "#\" occurred while attempting to load the file. By " - "way, there is a bug in EKLEF if you see this message." - , (ftnlen)152); - errfnm_("#", &unit, (ftnlen)1); - errch_("#", problm, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(BUG)", (ftnlen)10); - } - ekcls_(handle); - chkout_("EKLEF", (ftnlen)5); - return 0; - } - } - -/* At this point, we've made the file table, table list, segment */ -/* table, column descriptor table, and column attribute table updates */ -/* necessary to reflect the presence of the new file. */ - - chkout_("EKLEF", (ftnlen)5); - return 0; -/* $Procedure EKUEF ( EK, unload event file ) */ - -L_ekuef: -/* $ Abstract */ - -/* Unload an EK file, making its contents inaccessible to the */ -/* EK reader routines, and clearing space in order to allow other */ -/* EK files to be loaded. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of EK file. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle returned by EKLEF. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Unloading a file that is not loaded has no effect. */ - -/* $ Files */ - -/* See the description of the input argument HANDLE in */ -/* $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine removes information about an EK file from the */ -/* EK system, freeing space to increase the number of other EK */ -/* files that can be loaded. The file is also unloaded from */ -/* the DAS system and closed. */ - -/* $ Examples */ - -/* 1) Load 25 EK files sequentially, unloading the previous file */ -/* before each new file is loaded. Unloading files prevents */ -/* them from being searched during query execution. */ - -/* DO I = 1, 25 */ - -/* CALL EKLEF ( EK(I), HANDLE ) */ - -/* [Perform queries] */ - -/* CALL EKUEF ( HANDLE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* unload EK file */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKUEF", (ftnlen)5); - } - -/* On the first pass through this routine, initialize the tables, */ -/* if it hasn't been done yet. */ - - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* Check to see whether the named EK has been loaded. Do nothing */ -/* if not. */ - - i__ = fthead; - fnd = FALSE_; - while(i__ > 0 && ! fnd) { - if (*handle == fthan[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "ekqmgr_", (ftnlen)2330)]) { - fnd = TRUE_; - } else { - i__ = lnknxt_(&i__, ftpool); - } - } - if (! fnd) { - chkout_("EKUEF", (ftnlen)5); - return 0; - } - -/* If we got to here, HANDLE points to a loaded EK file. It's */ -/* time to wipe from the EK tables all trivial fond records */ -/* pertaining to the file in question. */ - -/* The file table is first. */ - - if (i__ == fthead) { - -/* The file is at the head of the list. If the file has a */ -/* successor, that file is now at the head of the list. */ - - fthead = lnknxt_(&i__, ftpool); - if (fthead < 0) { - -/* There are no files left. Clean up the whole shebang. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - -/* Close the EK file, to keep the DAS system's bookkeeping */ -/* up to date. */ - - ekcls_(handle); - chkout_("EKUEF", (ftnlen)5); - return 0; - } - } - -/* If we arrived here, the file we're unloading is not the only */ -/* loaded file. */ - -/* Free the file table entry for the file. The entry can be */ -/* regarded as a sublist that starts and ends with the Ith node, */ -/* so we can call the `free sublist' routine to get rid of it. */ - - lnkfsl_(&i__, &i__, ftpool); - -/* It's time to clean up the table list, segment table, column */ -/* attribute table, and column descriptor table. The plan is */ -/* to traverse the table list, and for each member of the list, */ -/* traverse the corresponding segment list, removing from the list */ -/* information about segments and columns in the file we're */ -/* unloading. If the segment list for any table becomes empty, we */ -/* remove the entry for that table from the table list. */ - - tbcurr = tbhead; - while(tbcurr > 0) { - -/* See whether the current table is in the file we're unloading. */ - - i__ = 1; - while(i__ <= tbflsz[(i__2 = tbcurr - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("tbflsz", i__2, "ekqmgr_", (ftnlen)2410)] && ! fnd) { - if (tbfils[(i__2 = i__ + tbcurr * 20 - 21) < 2000 && 0 <= i__2 ? - i__2 : s_rnge("tbfils", i__2, "ekqmgr_", (ftnlen)2412)] == - *handle) { - -/* This table is affected by unloading the file. */ - - fnd = TRUE_; - } else { - -/* Look at the next file handle. */ - - ++i__; - } - } - if (fnd) { - -/* Update the information for the current table to reflect */ -/* the unloading of the specified EK. */ - -/* Unloading the specified EK removes one handle from the */ -/* list of file handles associated with this table. Compress */ -/* this handle out of the list. */ - - i__1 = tbflsz[(i__2 = tbcurr - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("tbflsz", i__2, "ekqmgr_", (ftnlen)2438)] - 1; - for (j = i__; j <= i__1; ++j) { - tbfils[(i__2 = j + tbcurr * 20 - 21) < 2000 && 0 <= i__2 ? - i__2 : s_rnge("tbfils", i__2, "ekqmgr_", (ftnlen)2440) - ] = tbfils[(i__3 = j + 1 + tbcurr * 20 - 21) < 2000 && - 0 <= i__3 ? i__3 : s_rnge("tbfils", i__3, "ekqmgr_", - (ftnlen)2440)]; - } - tbflsz[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbflsz", i__1, "ekqmgr_", (ftnlen)2444)] = tbflsz[(i__2 = - tbcurr - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("tbflsz", - i__2, "ekqmgr_", (ftnlen)2444)] - 1; - -/* Traverse the segment list for this table, looking */ -/* for segments in the specified EK. */ - - seg = tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("tbstpt", i__1, "ekqmgr_", (ftnlen)2450)]; - while(seg > 0) { - if (sthan[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "ekqmgr_", (ftnlen)2454)] == *handle) { - -/* This segment is aboard the sinking ship. Put it */ -/* out of its misery. */ - -/* First, euthanatize the segment's column descriptors. */ -/* These descriptors are linked together, so we can free */ -/* all of them in one shot. Don't crash if the column */ -/* descriptor list is empty. */ - - j = stdtpt[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("stdtpt", i__1, "ekqmgr_", (ftnlen)2464)]; - if (j > 0) { - k = lnktl_(&j, dtpool); - lnkfsl_(&j, &k, dtpool); - } - -/* Now we can delete the segment table entry itself. */ -/* This deletion may necessitate updating the segment */ -/* list pointer in the parent table's table list entry. */ - - if (seg == tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbstpt", i__1, "ekqmgr_", (ftnlen) - 2476)]) { - tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("tbstpt", i__1, "ekqmgr_", (ftnlen) - 2478)] = lnknxt_(&seg, stpool); - } - next = lnknxt_(&seg, stpool); - lnkfsl_(&seg, &seg, stpool); - seg = next; - } else { - seg = lnknxt_(&seg, stpool); - } - } - -/* We've examined all of the segments in the current table. */ - -/* If the segment list for the current table became empty */ -/* as a result of our having plundered the segment table, */ -/* delete the entry for this table from the table list. We do */ -/* *not* need to concern ourselves with the possibility that */ -/* this deletion will empty the table list, since we know we're */ -/* not unloading the last loaded file. However, we may need to */ -/* update the head-of-list pointer for the table list. */ - - if (tbstpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbstpt", i__1, "ekqmgr_", (ftnlen)2508)] <= 0) { - -/* There are no loaded segments left for this table. */ - -/* Delete the list of column attribute entries for the */ -/* columns in this table, then delete the table's entry from */ -/* the table list. */ - -/* The column attribute entries are linked, so we can free */ -/* them in one shot. */ - - j = tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("tbctpt", i__1, "ekqmgr_", (ftnlen)2519)]; - if (j > 0) { - k = lnktl_(&j, ctpool); - lnkfsl_(&j, &k, ctpool); - } - if (tbcurr == tbhead) { - -/* The entry for this table is at the head of the */ -/* table list. Update the head of the list. */ - - tbhead = lnknxt_(&tbcurr, tbpool); - next = tbhead; - } else { - next = lnknxt_(&tbcurr, tbpool); - } - -/* Make the entry for this table go away. */ - - lnkfsl_(&tbcurr, &tbcurr, tbpool); - -/* The successor of the current node is the next node to */ -/* examine. */ - - tbcurr = next; - } else { - -/* We're done with the current table. Look at the next one. */ - - tbcurr = lnknxt_(&tbcurr, tbpool); - } - -/* We've cleaned up the table entry for the current table, */ -/* if it was necessary to do so. */ - - } else { - -/* The current table is not affected by unloading this file. */ -/* Examine the next table. */ - - tbcurr = lnknxt_(&tbcurr, tbpool); - } - -/* We've processed the current table. */ - - } - -/* Don't forget to unload the EK file from the DAS system. */ - - ekcls_(handle); - chkout_("EKUEF", (ftnlen)5); - return 0; -/* $Procedure EKNTAB ( EK, return number of loaded tables ) */ - -L_ekntab: -/* $ Abstract */ - -/* Return the number of loaded EK tables. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER N */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N O Number of loaded tables. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* N is the number of loaded tables. The count refers */ -/* to the number of logical tables; if multiple */ -/* segments contain data for the same table, these */ -/* segments collectively contribute only one table */ -/* to the count. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* The returned count is based on the currently loaded EK files. */ -/* These files must be loaded via the entry point EKLEF. */ - -/* $ Particulars */ - -/* This routine is a utility that provides the caller with the */ -/* number of loaded tables. Callers of EKTNAM can use this count */ -/* as the upper bound on set of table indices when looking up table */ -/* names. */ - -/* $ Examples */ - -/* 1) Suppose we have the following list of EK files and tables */ -/* contained in those files: */ - -/* File name Table name */ -/* --------- ---------- */ - -/* FILE_1.EK TABLE_1 */ -/* TABLE_2 */ - -/* FILE_2.EK TABLE_1 */ -/* TABLE_3 */ - -/* FILE_3.EK TABLE_2 */ -/* TABLE_3 */ -/* TABLE_4 */ - - -/* Then after loading these files, the call */ - -/* CALL EKNTAB ( N ) */ - -/* returns the value N = 4. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return number of loaded tables */ - -/* -& */ - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* Return the number of loaded tables. */ - - *n = 100 - lnknfn_(tbpool); - return 0; -/* $Procedure EKTNAM ( EK, return name of loaded table ) */ - -L_ektnam: -/* $ Abstract */ - -/* Return the name of a specified, loaded table. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER N */ -/* CHARACTER*(*) TABLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Index of table. */ -/* TABLE O Name of table. */ - -/* $ Detailed_Input */ - -/* N is the index of the table whose name is desired. */ -/* The value of N ranges from 1 to the number of */ -/* loaded tables, which count may be obtained from */ -/* EKNTAB. */ - -/* $ Detailed_Output */ - -/* TABLE is the name of the Nth loaded table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no files are loaded, the */ -/* error SPICE(NOLOADEDFILES) is signalled. */ - -/* 2) If the input N is out of range, the error SPICE(INVALDINDEX) */ -/* is signalled. */ - -/* $ Files */ - -/* The returned name is based on the currently loaded EK files. */ - -/* $ Particulars */ - -/* This routine is a utility that provides the caller with the */ -/* name of a specified loaded table. The index of a table with */ -/* a given name depends on the kernels loaded and possibly on */ -/* the order in which the files have been loaded. */ - -/* $ Examples */ - -/* 1) Dump the names of the loaded tables. */ - -/* CALL EKNTAB ( N ) */ - -/* DO I = 1, N */ -/* CALL EKTNAM ( I, TABLE ) */ -/* WRITE (*,*) TABLE */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return name of a loaded table */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKTNAM", (ftnlen)6); - } - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* There nothing to fetch if no files are loaded. A sure */ -/* symptom of this problem is that the file list is empty. */ - - if (fthead <= 0) { - setmsg_("No E-kernels are currently loaded.", (ftnlen)34); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("EKTNAM", (ftnlen)6); - return 0; - } - tbcurr = tbhead; - fnd = FALSE_; - i__ = 0; - while(tbcurr > 0 && ! fnd) { - ++i__; - if (i__ == *n) { - fnd = TRUE_; - s_copy(table, tbnams + (((i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbnams", i__1, "ekqmgr_", (ftnlen)2944)) << - 6), table_len, (ftnlen)64); - } else { - tbcurr = lnknxt_(&tbcurr, tbpool); - } - } - if (! fnd) { - setmsg_("The index # does not correspond to a loaded table.", (ftnlen) - 50); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - } - chkout_("EKTNAM", (ftnlen)6); - return 0; -/* $Procedure EKCCNT ( EK, column count ) */ - -L_ekccnt: -/* $ Abstract */ - -/* Return the number of distinct columns in a specified, currently */ -/* loaded table */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) TABLE */ -/* INTEGER CCOUNT */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TABLE I Name of table. */ -/* CCOUNT O Count of distinct, currently loaded columns. */ - -/* $ Detailed_Input */ - -/* TABLE is the name of a currently loaded table. Case */ -/* is not significant in the table name. */ - -/* $ Detailed_Output */ - -/* CCOUNT is the number of distinct columns in TABLE. */ -/* Columns that have the same name but belong to */ -/* different segments that are considered to be */ -/* portions of the same column, if the segments */ -/* containing those columns belong to TABLE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified table is not loaded, the error */ -/* SPICE(TABLENOTLOADED) is signalled. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* This routine is a utility intended for use in conjunction with */ -/* the entry point EKCII. These routines can be used to find the */ -/* names and attributes of the columns that are currently loaded. */ - -/* $ Examples */ - -/* 1) Dump the names and attributes of the columns in each loaded */ -/* table. EKCCNT is used to obtain column counts. */ - -/* C */ -/* C Get the number of loaded tables. */ -/* C */ -/* CALL EKNTAB ( NTAB ) */ - -/* DO TAB = 1, NTAB */ -/* C */ -/* C Get the name of the current table, and look up */ -/* C the column count for this table. */ -/* C */ -/* CALL EKTNAM ( TAB, TABNAM ) */ -/* CALL EKCCNT ( TABNAM, NCOLS ) */ - -/* WRITE (*,*) 'TABLE = ', TABNAM */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C For each column in the current table, look up the */ -/* C column's attributes. The attribute block */ -/* C index parameters are defined in the include file */ -/* C ekattdsc.inc. */ -/* C */ -/* DO I = 1, NCOLS */ - -/* CALL EKCII ( TABNAM, I, COLNAM, ATTDSC ) */ - -/* WRITE (*,*) 'COLUMN = ', COLNAM */ - -/* C */ -/* C Write out the current column's data type. */ -/* C */ -/* IF ( ATTDSC(ATTTYP) .EQ. CHR ) THEN */ -/* WRITE (*,*) 'TYPE = CHR' */ - -/* IF ( ATTDSC(ATTLEN) .EQ. -1 ) THEN */ -/* WRITE (*,*) 'STRING LENGTH = VARIABLE.' */ -/* ELSE */ -/* WRITE (*,*) 'STRING LENGTH = ', */ -/* . ATTDSC(ATTLEN) */ -/* END IF */ - -/* ELSE IF ( ATTDSC(ATTTYP) .EQ. DP ) THEN */ -/* WRITE (*,*) 'TYPE = DP' */ - -/* ELSE IF ( ATTDSC(ATTTYP) .EQ. INT ) THEN */ -/* WRITE (*,*) 'TYPE = INT' */ - -/* ELSE */ -/* WRITE (*,*) 'TYPE = TIME' */ -/* END IF */ - -/* C */ -/* C Write out the current column's entry size. */ -/* C */ -/* WRITE (*,*) 'SIZE = ', ATTDSC(ATTSIZ) */ - -/* C */ -/* C Indicate whether the current column is indexed. */ -/* C */ -/* IF ( ATTDSC(ATTIDX) .EQ. -1 ) THEN */ -/* WRITE (*,*) 'NOT INDEXED' */ -/* ELSE */ -/* WRITE (*,*) 'INDEXED' */ -/* END IF */ - -/* C */ -/* C Indicate whether the current column allows */ -/* C null values. */ -/* C */ -/* IF ( ATTDSC(ATTNFL) .EQ. -1 ) THEN */ -/* WRITE (*,*) 'NULL VALUES NOT ALLOWED' */ -/* ELSE */ -/* WRITE (*,*) 'NULL VALUES ALLOWED' */ -/* END IF */ - -/* END DO */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Misspelling of "conjunction" was fixed. */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - - -/* -& */ -/* $ Index_Entries */ - -/* return the number of loaded EK columns */ -/* return the count of loaded EK columns */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKCCNT", (ftnlen)6); - } - -/* On the first pass through this routine, initialize the tables, */ -/* if it hasn't been done yet. */ - - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* Find the table. If there's no match, the number of loaded columns */ -/* is zero. */ - - tbcurr = tbhead; - fnd = FALSE_; - while(tbcurr > 0 && ! fnd) { - if (eqstr_(table, tbnams + (((i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbnams", i__1, "ekqmgr_", (ftnlen)3221)) << 6), - table_len, (ftnlen)64)) { - fnd = TRUE_; - } else { - tbcurr = lnknxt_(&tbcurr, tbpool); - } - } - if (! fnd) { - *ccount = 0; - setmsg_("The table # is not currently loaded.", (ftnlen)36); - errch_("#", table, (ftnlen)1, table_len); - sigerr_("SPICE(TABLENOTLOADED)", (ftnlen)21); - chkout_("EKCCNT", (ftnlen)6); - return 0; - } else { - -/* Count the columns in the attribute table for the current table. */ - - *ccount = 0; - col = tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "tbctpt", i__1, "ekqmgr_", (ftnlen)3244)]; - while(col > 0) { - ++(*ccount); - col = lnknxt_(&col, ctpool); - } - } - chkout_("EKCCNT", (ftnlen)6); - return 0; -/* $Procedure EKCII ( EK, column info by index ) */ - -L_ekcii: -/* $ Abstract */ - -/* Return attribute information about a column belonging to a loaded */ -/* EK table, specifying the column by table and index. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) TABLE */ -/* INTEGER CINDEX */ -/* CHARACTER*(*) COLUMN */ -/* INTEGER ATTDSC ( ADSCSZ ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TABLE I Name of table containing column. */ -/* CINDEX I Index of column whose attributes are to be found. */ -/* COLUMN O Name of column. */ -/* ATTDSC O Column attribute descriptor. */ - -/* $ Detailed_Input */ - -/* TABLE is the name of a loaded EK table. Case is not */ -/* significant. */ - -/* CINDEX is the index, within TABLE's column attribute */ -/* table, of the column whose attributes are to be */ -/* found. The indices of the column table entries */ -/* range from 1 to CCOUNT, where CCOUNT is the value */ -/* returned by the entry point EKCCNT. */ - -/* $ Detailed_Output */ - -/* COLUMN is the name of the specified column. */ - -/* ATTDSC is a column attribute descriptor. ATTDSC is an */ -/* integer array containing descriptive information */ -/* that applies uniformly to all loaded columns */ -/* having the name COLUMN. The following parameter */ -/* values occur in ATTDSC: */ - -/* IFALSE: -1 */ -/* ITRUE: 1 */ -/* CHR: 1 */ -/* DP: 2 */ -/* INT: 3 */ -/* TIME: 4 */ - -/* The meanings of the elements of ATTDSC are given */ -/* below. The indices of the elements are */ -/* parameterized; the parameter values are defined */ -/* in the include file ekattdsc.inc. */ - -/* ATTDSC(ATTCLS): Column class code */ - -/* ATTDSC(ATTTYP): Data type code---CHR, DP, INT, */ -/* or TIME */ - -/* ATTDSC(ATTLEN): String length; applies to CHR */ -/* type. Value is IFALSE for */ -/* variable-length strings. */ - -/* ATTDSC(ATTSIZ): Column entry size; value is */ -/* IFALSE for variable-size */ -/* columns. Here `size' refers */ -/* to the number of array */ -/* elements in a column entry. */ - -/* ATTDSC(ATTIDX): Index flag; value is ITRUE if */ -/* column is indexed, IFALSE */ -/* otherwise. */ - -/* ATTDSC(ATTNFL): Null flag; value is ITRUE if */ -/* column may contain null */ -/* values, IFALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified table is not loaded, the error */ -/* SPICE(TABLENOTLOADED) is signalled. */ - -/* 2) If the input argument CINDEX is less than one or greater */ -/* than the number of columns in TABLE, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* This routine is a utility that allows a calling routine to */ -/* determine the attributes of the currently loaded columns. */ - -/* $ Examples */ - -/* 1) Dump the names and attributes of the columns in each loaded */ -/* table. EKCII is used to obtain column attributes. */ - -/* C */ -/* C Get the number of loaded tables. */ -/* C */ -/* CALL EKNTAB ( NTAB ) */ - -/* DO TAB = 1, NTAB */ -/* C */ -/* C Get the name of the current table, and look up */ -/* C the column count for this table. */ -/* C */ -/* CALL EKTNAM ( TAB, TABNAM ) */ -/* CALL EKCCNT ( TABNAM, NCOLS ) */ - -/* WRITE (*,*) 'TABLE = ', TABNAM */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C For each column in the current table, look up the */ -/* C column's attributes. The attribute block */ -/* C index parameters are defined in the include file */ -/* C ekattdsc.inc. */ -/* C */ -/* DO I = 1, NCOLS */ - -/* CALL EKCII ( TABNAM, I, COLNAM, ATTDSC ) */ - -/* WRITE (*,*) 'COLUMN = ', COLNAM */ - -/* C */ -/* C Write out the current column's data type. */ -/* C */ -/* IF ( ATTDSC(ATTTYP) .EQ. CHR ) THEN */ -/* WRITE (*,*) 'TYPE = CHR' */ - -/* IF ( ATTDSC(ATTLEN) .EQ. -1 ) THEN */ -/* WRITE (*,*) 'STRING LENGTH = VARIABLE.' */ -/* ELSE */ -/* WRITE (*,*) 'STRING LENGTH = ', */ -/* . ATTDSC(ATTLEN) */ -/* END IF */ - -/* ELSE IF ( ATTDSC(ATTTYP) .EQ. DP ) THEN */ -/* WRITE (*,*) 'TYPE = DP' */ - -/* ELSE IF ( ATTDSC(ATTTYP) .EQ. INT ) THEN */ -/* WRITE (*,*) 'TYPE = INT' */ - -/* ELSE */ -/* WRITE (*,*) 'TYPE = TIME' */ -/* END IF */ - -/* C */ -/* C Write out the current column's entry size. */ -/* C */ -/* WRITE (*,*) 'SIZE = ', ATTDSC(ATTSIZ) */ - -/* C */ -/* C Indicate whether the current column is indexed. */ -/* C */ -/* IF ( ATTDSC(ATTIDX) .EQ. -1 ) THEN */ -/* WRITE (*,*) 'NOT INDEXED' */ -/* ELSE */ -/* WRITE (*,*) 'INDEXED' */ -/* END IF */ - -/* C */ -/* C Indicate whether the current column allows */ -/* C null values. */ -/* C */ -/* IF ( ATTDSC(ATTNFL) .EQ. -1 ) THEN */ -/* WRITE (*,*) 'NULL VALUES NOT ALLOWED' */ -/* ELSE */ -/* WRITE (*,*) 'NULL VALUES ALLOWED' */ -/* END IF */ - -/* END DO */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return information on loaded EK column specified by index */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKCII", (ftnlen)5); - } - -/* On the first pass through this routine, initialize the tables, */ -/* if it hasn't been done yet. */ - - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* Find the table. If there's no match, the number of loaded columns */ -/* is zero. */ - - tbcurr = tbhead; - fnd = FALSE_; - while(tbcurr > 0 && ! fnd) { - if (eqstr_(table, tbnams + (((i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("tbnams", i__1, "ekqmgr_", (ftnlen)3561)) << 6), - table_len, (ftnlen)64)) { - fnd = TRUE_; - } else { - tbcurr = lnknxt_(&tbcurr, tbpool); - } - } - if (! fnd) { - setmsg_("The table # is not currently loaded.", (ftnlen)36); - errch_("#", table, (ftnlen)1, table_len); - sigerr_("SPICE(TABLENOTLOADED)", (ftnlen)21); - chkout_("EKCII", (ftnlen)5); - return 0; - } - -/* Locate the named column in the column attribute table. */ - - i__ = 0; - col = tbctpt[(i__1 = tbcurr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("tbc" - "tpt", i__1, "ekqmgr_", (ftnlen)3585)]; - while(col > 0 && i__ < *cindex) { - ++i__; - if (i__ == *cindex) { - -/* We've found the column. Set the output arguments using */ -/* its attributes. */ - - s_copy(column, ctnams + (((i__1 = col - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("ctnams", i__1, "ekqmgr_", (ftnlen)3596)) << - 5), column_len, (ftnlen)32); - attdsc[0] = ctclas[(i__1 = col - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctclas", i__1, "ekqmgr_", (ftnlen)3598)]; - attdsc[1] = cttyps[(i__1 = col - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("cttyps", i__1, "ekqmgr_", (ftnlen)3599)]; - attdsc[2] = ctlens[(i__1 = col - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctlens", i__1, "ekqmgr_", (ftnlen)3600)]; - attdsc[3] = ctsizs[(i__1 = col - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctsizs", i__1, "ekqmgr_", (ftnlen)3601)]; - if (ctindx[(i__1 = col - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "ctindx", i__1, "ekqmgr_", (ftnlen)3603)]) { - attdsc[4] = 1; - } else { - attdsc[4] = -1; - } - if (ctnull[(i__1 = col - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "ctnull", i__1, "ekqmgr_", (ftnlen)3609)]) { - attdsc[5] = 1; - } else { - attdsc[5] = -1; - } - chkout_("EKCII", (ftnlen)5); - return 0; - } else { - col = lnknxt_(&col, ctpool); - } - } - -/* We end up here if we ran out of columns before finding the */ -/* CINDEXth one, or if CINDEX was non-positive. */ - - setmsg_("Column indices for table # range from # to #; requested index w" - "as #.", (ftnlen)68); - errch_("#", tabnam, (ftnlen)1, (ftnlen)64); - i__1 = max(1,i__); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errint_("#", cindex, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKCII", (ftnlen)5); - return 0; -/* $Procedure EKSRCH ( EK, search for events ) */ - -L_eksrch: -/* $ Abstract */ - -/* Search for EK events matching a specified set of constraints. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* EVENT */ -/* FILES */ -/* SEARCH */ - -/* $ Declarations */ - -/* INTEGER EQRYI ( LBCELL : * ) */ -/* CHARACTER*(*) EQRYC */ -/* DOUBLE PRECISION EQRYD ( * ) */ -/* INTEGER NMROWS */ -/* LOGICAL SEMERR */ -/* CHARACTER*(*) ERRMSG */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of encoded query. */ -/* EQRYC I Character component of encoded query. */ -/* EQRYD I D.p. component of encoded query. */ -/* NMROWS O Number of rows matching query constraints. */ -/* SEMERR O Flag indicating whether semantic error occurred. */ -/* ERRMSG O Message describing semantic error, if any. */ - -/* $ Detailed_Input */ - -/* EQRYI, */ -/* EQRYC, */ -/* EQRYD are, respectively, the integer, character, and */ -/* double precision portions of an encoded query. */ -/* The query must have been parsed and must have */ -/* its table and column names resolved. Time values */ -/* must have been resolved. The query is expected */ -/* to be semantically correct. */ - -/* $ Detailed_Output */ - -/* NMROWS is the number of rows matching the input query */ -/* constraints. */ - -/* SEMERR is a logical flag indicating whether a semantic */ -/* error was detected while attempting to respond to */ -/* the input query. */ - -/* ERRMSG is a descriptive error message that is set if a */ -/* semantic error is detected. Otherwise, ERRMSG */ -/* is returned blank. */ - -/* See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no files are loaded, the */ -/* error SPICE(NOLOADEDFILES) is signalled. */ - -/* 2) If the structure of the input query is invalid, this routine */ -/* may fail in mysterious ways. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* NAIF Toolkit-based applications will rarely need to call this */ -/* routine directly; the high-level routine EKFIND should normally */ -/* be used to query the EK system. */ - -/* Because the structure of encoded queries is not part of the */ -/* SPICELIB user interface, we strongly recommend that users' */ -/* applications not call this routine directly. */ - -/* $ Examples */ - -/* See the header of the umbrella subroutine EKQMGR for a */ -/* comprehensive example of the use of EKQMGR's entry points. */ - -/* $ Restrictions */ - -/* 1) This routine should normally not be called directly from */ -/* users' applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.2.0, 21-JUL-1998 (NJB) */ - -/* ZZEKJSQZ call was added after the ZZEKJOIN call. This change */ -/* reduces the scratch area usage for intermediate results of */ -/* joins. It also prevents ZZEKJOIN from being handed a join */ -/* row set containing a segment vector having no corresponding */ -/* row vectors. */ - -/* Removed a comment in the join loop indicating that non-join */ -/* constraints involving comparisons of column entries in the */ -/* table were being activated. This comment was incorrect; the */ -/* constraints in question were applied earlier. */ - -/* - SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) */ - -/* Previous version line was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* search for events in loaded EK files */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKSRCH", (ftnlen)6); - } - -/* There nothing to search if no files are loaded. A sure */ -/* symptom of this problem is that the file list is empty. */ - - if (fthead <= 0) { - setmsg_("No E-kernels are currently loaded.", (ftnlen)34); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("EKSRCH", (ftnlen)6); - return 0; - } - -/* No error to begin with. */ - - *semerr = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *nmrows = 0; - if (first) { - -/* Initialize the file table pool, segment table pool, column */ -/* descriptor pool, column table pool, and table list pool. */ - - lnkini_(&c__20, ftpool); - lnkini_(&c__200, stpool); - lnkini_(&c__10000, dtpool); - lnkini_(&c__500, ctpool); - lnkini_(&c__100, tbpool); - fthead = 0; - tbhead = 0; - first = FALSE_; - } - -/* Read some of our favorite things from the query. We need: */ - -/* - the table count */ -/* - the SELECT clause column count */ -/* - the order-by column count */ -/* - the table and alias list */ - - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_SELECT_COLS", &nsel, (ftnlen)15); - zzekreqi_(eqryi, "NUM_ORDERBY_COLS", &norder, (ftnlen)16); - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqtab_(eqryi, eqryc, &i__, frmtab + (((i__2 = i__ - 1) < 10 && 0 <= - i__2 ? i__2 : s_rnge("frmtab", i__2, "ekqmgr_", (ftnlen)3879) - ) << 6), frmals + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 - : s_rnge("frmals", i__3, "ekqmgr_", (ftnlen)3879)) << 6), - eqryc_len, (ftnlen)64, (ftnlen)64); - } - -/* Initialize the table vectors. Also initialize a vector of column */ -/* list pointers. */ - - ssizec_(&c__10, tabvec, (ftnlen)64); - ssizei_(&c__10, tptvec); - -/* Fill in the FROM table vector and corresponding column pointer */ -/* vector. It's an error if a table referenced in the FROM clause */ -/* can't be found. */ - - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Find the table list entry for this table name. */ - - tbcurr = tbhead; - fnd = FALSE_; - while(tbcurr > 0 && ! fnd) { - if (s_cmp(tbnams + (((i__2 = tbcurr - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("tbnams", i__2, "ekqmgr_", (ftnlen)3903)) << - 6), frmtab + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 - : s_rnge("frmtab", i__3, "ekqmgr_", (ftnlen)3903)) << 6), - (ftnlen)64, (ftnlen)64) == 0) { - -/* We've found the table list entry for the Ith table. */ - - appndc_(frmtab + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("frmtab", i__2, "ekqmgr_", (ftnlen)3907)) << - 6), tabvec, (ftnlen)64, (ftnlen)64); - appndi_(&tbcurr, tptvec); - fnd = TRUE_; - } else { - tbcurr = lnknxt_(&tbcurr, tbpool); - } - } - if (! fnd) { - setmsg_("The table # is not currently loaded.", (ftnlen)36); - errch_("#", frmtab + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("frmtab", i__2, "ekqmgr_", (ftnlen)3918)) << 6), ( - ftnlen)1, (ftnlen)64); - sigerr_("SPICE(INVALIDTABLENAME)", (ftnlen)23); - chkout_("EKSRCH", (ftnlen)6); - return 0; - } - } - -/* Since this is a new search, re-initialize the stack in the EK */ -/* scratch area. Also initialize our total segment list count. */ - - zzekstop_(&top); - zzeksdec_(&top); - -/* Initialize the size of the join row set union for the current */ -/* query. At this point, no matching rows have been found. */ - - usize = 0; - unrows = 0; - -/* Get the number of conjunctions and the sizes of the conjunctions. */ - - zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &nconj, (ftnlen)16); - cleari_(&c__1000, sizes); - i__1 = nconj; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqcnj_(eqryi, &i__, &sizes[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? - i__2 : s_rnge("sizes", i__2, "ekqmgr_", (ftnlen)3947)]); - } - -/* For each conjunction of constraints, we'll build a join row */ -/* set representing the row vectors matching those constraints. */ -/* The final result will be a join row set union representing the */ -/* row vectors satisfying at least one conjunction. */ - -/* We want to build a join row set even if there are *no* */ -/* constraints. Therefore, we always make at least one pass */ -/* through the loop below. */ - - cjend = 0; - i__1 = max(1,nconj); - for (conj = 1; conj <= i__1; ++conj) { - -/* Our objective is to build a join row set representing the table */ -/* defined by the FROM columns and the input constraints. To do */ -/* this, we'll first build a trivial join row set for each table; */ -/* this join row set represents the rows that satisfy constraints */ -/* on columns in that table. Having done this, we'll produce a */ -/* final (for this conjunction) join row set that represents the */ -/* constrained join of the FROM tables. The base address of this */ -/* join row set will be stored in the array UBASE. */ - -/* We'll start out by recording the FROM table indices and column */ -/* list indices of columns listed in the constraints. */ - - if (nconj == 0) { - cjsize = 0; - } else { - cjsize = sizes[(i__2 = conj - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("sizes", i__2, "ekqmgr_", (ftnlen)3979)]; - } - cjbeg = cjend + 1; - cjend += cjsize; - i__2 = cjsize; - for (i__ = 1; i__ <= i__2; ++i__) { - i__14 = cjbeg + i__ - 1; - zzekqcon_(eqryi, eqryc, eqryd, &i__14, &cnstyp[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("cnstyp", i__3, "ekqmg" - "r_", (ftnlen)3987)], ltname, <bidx[(i__4 = i__ - 1) < - 1000 && 0 <= i__4 ? i__4 : s_rnge("ltbidx", i__4, "ekqmg" - "r_", (ftnlen)3987)], lcname, &lcidx[(i__5 = i__ - 1) < - 1000 && 0 <= i__5 ? i__5 : s_rnge("lcidx", i__5, "ekqmgr_" - , (ftnlen)3987)], &ops[(i__6 = i__ - 1) < 1000 && 0 <= - i__6 ? i__6 : s_rnge("ops", i__6, "ekqmgr_", (ftnlen)3987) - ], rtname, &rtbidx[(i__7 = i__ - 1) < 1000 && 0 <= i__7 ? - i__7 : s_rnge("rtbidx", i__7, "ekqmgr_", (ftnlen)3987)], - rcname, &rcidx[(i__8 = i__ - 1) < 1000 && 0 <= i__8 ? - i__8 : s_rnge("rcidx", i__8, "ekqmgr_", (ftnlen)3987)], & - dtype[(i__9 = i__ - 1) < 1000 && 0 <= i__9 ? i__9 : - s_rnge("dtype", i__9, "ekqmgr_", (ftnlen)3987)], &cbegs[( - i__10 = i__ - 1) < 1000 && 0 <= i__10 ? i__10 : s_rnge( - "cbegs", i__10, "ekqmgr_", (ftnlen)3987)], &cends[(i__11 = - i__ - 1) < 1000 && 0 <= i__11 ? i__11 : s_rnge("cends", - i__11, "ekqmgr_", (ftnlen)3987)], &dvals[(i__12 = i__ - 1) - < 1000 && 0 <= i__12 ? i__12 : s_rnge("dvals", i__12, - "ekqmgr_", (ftnlen)3987)], &ivals[(i__13 = i__ - 1) < - 1000 && 0 <= i__13 ? i__13 : s_rnge("ivals", i__13, "ekq" - "mgr_", (ftnlen)3987)], eqryc_len, (ftnlen)64, (ftnlen)32, - (ftnlen)64, (ftnlen)32); - } - i__2 = ntab; - for (t = 1; t <= i__2; ++t) { - -/* We will build a trivial (one-table) join row set for the */ -/* current table. */ - -/* Initialize the join row set. Retain the base address. We */ -/* can fill in the table count right away; the count is 1. */ - - zzekstop_(&rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4005)]); - for (i__ = 1; i__ <= 4; ++i__) { - zzekspsh_(&c__1, &c__0); - } - i__5 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4011)] + 3; - i__6 = rbas[(i__4 = t - 1) < 10 && 0 <= i__4 ? i__4 : s_rnge( - "rbas", i__4, "ekqmgr_", (ftnlen)4011)] + 3; - zzeksupd_(&i__5, &i__6, &c__1); - -/* Count the loaded segments for the current table. We'll */ -/* leave enough room in the join row set for each segment. */ - - tab = tptvec[(i__3 = t + 5) < 16 && 0 <= i__3 ? i__3 : s_rnge( - "tptvec", i__3, "ekqmgr_", (ftnlen)4017)]; - i__ = tbstpt[(i__3 = tab - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "tbstpt", i__3, "ekqmgr_", (ftnlen)4018)]; - nsv = 0; - while(i__ > 0) { - zzekspsh_(&c__1, &c__0); - ++nsv; - i__ = lnknxt_(&i__, stpool); - } - -/* Save room for the row vector base addresses and counts. */ - - i__3 = nsv << 1; - for (i__ = 1; i__ <= i__3; ++i__) { - zzekspsh_(&c__1, &c__0); - } - -/* At this point, we can set the segment vector count in the */ -/* join row set. */ - - i__5 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4041)] + 4; - i__6 = rbas[(i__4 = t - 1) < 10 && 0 <= i__4 ? i__4 : s_rnge( - "rbas", i__4, "ekqmgr_", (ftnlen)4041)] + 4; - zzeksupd_(&i__5, &i__6, &nsv); - -/* Find the matching rows in the segments belonging to the */ -/* current table. */ - - seg = tbstpt[(i__3 = tab - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "tbstpt", i__3, "ekqmgr_", (ftnlen)4047)]; - nseg = 0; - rtotal = 0; - while(seg > 0) { - ++nseg; - -/* The segment vector for this segment is trivial: it's */ -/* just the segment's index in the segment table. */ - - sgvbas = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("rbas", i__3, "ekqmgr_", (ftnlen)4058)] + 4 + ( - nseg - 1); - i__3 = sgvbas + 1; - i__4 = sgvbas + 1; - zzeksupd_(&i__3, &i__4, &seg); - -/* Label as `inactive' any constraints that don't apply to */ -/* this table. Join constraints are inactive at this stage */ -/* of the game. Label all other constraints `active'. */ -/* We'll keep track of column and value constraints */ -/* separately. */ - - i__3 = cjsize; - for (i__ = 1; i__ <= i__3; ++i__) { - -/* Each constraint is active to start with. */ - - activc[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? i__4 : - s_rnge("activc", i__4, "ekqmgr_", (ftnlen)4073)] = - cnstyp[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? - i__5 : s_rnge("cnstyp", i__5, "ekqmgr_", (ftnlen) - 4073)] == 1; - activv[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? i__4 : - s_rnge("activv", i__4, "ekqmgr_", (ftnlen)4074)] = - cnstyp[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? - i__5 : s_rnge("cnstyp", i__5, "ekqmgr_", (ftnlen) - 4074)] == 2; - -/* The parent table of the LHS column must be the Tth */ -/* table, or this constraint does not apply. */ - -/* We'll also exclude join constraints. Note that */ -/* constraints comparing values from two columns need not */ -/* be join constraints: it's possible that the column on */ -/* the right belongs to the same FROM table as the */ -/* column on the left. */ - - if (ltbidx[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? i__4 : - s_rnge("ltbidx", i__4, "ekqmgr_", (ftnlen)4086)] - != t) { - activc[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? i__4 : - s_rnge("activc", i__4, "ekqmgr_", (ftnlen) - 4088)] = FALSE_; - activv[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? i__4 : - s_rnge("activv", i__4, "ekqmgr_", (ftnlen) - 4089)] = FALSE_; - } else if (cnstyp[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? - i__4 : s_rnge("cnstyp", i__4, "ekqmgr_", (ftnlen) - 4092)] == 1) { - if (ltbidx[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? - i__4 : s_rnge("ltbidx", i__4, "ekqmgr_", ( - ftnlen)4094)] != rtbidx[(i__5 = i__ - 1) < - 1000 && 0 <= i__5 ? i__5 : s_rnge("rtbidx", - i__5, "ekqmgr_", (ftnlen)4094)]) { - -/* This is a join constraint; disable it. */ - - activc[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? - i__4 : s_rnge("activc", i__4, "ekqmgr_", ( - ftnlen)4098)] = FALSE_; - } - } - } - -/* At this point, we'll have to search the segment for */ -/* matching rows. Pick a key column for the segment. To */ -/* do this, we'll need to pack an array with column */ -/* descriptors for each active constraint. The */ -/* descriptor for the column on the left side of the Ith */ -/* constraint will be placed in elements LDSCRS(*,I), if */ -/* the Ith constraint is active. */ - - cleari_(&c__11000, ldscrs); - i__3 = cjsize; - for (i__ = 1; i__ <= i__3; ++i__) { - if (activv[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? i__4 : - s_rnge("activv", i__4, "ekqmgr_", (ftnlen)4122)]) - { - -/* Look up the column descriptor for this */ -/* constraint. */ - - j = stdtpt[(i__4 = seg - 1) < 200 && 0 <= i__4 ? i__4 - : s_rnge("stdtpt", i__4, "ekqmgr_", (ftnlen) - 4127)]; - i__5 = lcidx[(i__4 = i__ - 1) < 1000 && 0 <= i__4 ? - i__4 : s_rnge("lcidx", i__4, "ekqmgr_", ( - ftnlen)4129)]; - for (k = 2; k <= i__5; ++k) { - j = lnknxt_(&j, dtpool); - } - movei_(&dtdscs[(i__5 = j * 11 - 11) < 110000 && 0 <= - i__5 ? i__5 : s_rnge("dtdscs", i__5, "ekqmgr_" - , (ftnlen)4133)], &c__11, &ldscrs[(i__4 = i__ - * 11 - 11) < 11000 && 0 <= i__4 ? i__4 : - s_rnge("ldscrs", i__4, "ekqmgr_", (ftnlen) - 4133)]); - } - } - zzekkey_(&sthan[(i__3 = seg - 1) < 200 && 0 <= i__3 ? i__3 : - s_rnge("sthan", i__3, "ekqmgr_", (ftnlen)4140)], & - stdscs[(i__5 = seg * 24 - 24) < 4800 && 0 <= i__5 ? - i__5 : s_rnge("stdscs", i__5, "ekqmgr_", (ftnlen)4140) - ], &stnrow[(i__4 = seg - 1) < 200 && 0 <= i__4 ? i__4 - : s_rnge("stnrow", i__4, "ekqmgr_", (ftnlen)4140)], & - cjsize, lcidx, ldscrs, ops, dtype, eqryc, cbegs, - cends, dvals, ivals, activv, &key, keydsc, &begidx, & - endidx, &keyfnd, eqryc_len); - -/* ZZEKKEY has updated ACTIVV to reflect the application */ -/* of constraints that were used to determine BEGIDX and */ -/* ENDIDX. */ - - if (keyfnd) { - indexd = TRUE_; - } else { - -/* A key column could not be determined from the */ -/* active constraints. We'll use the first column of */ -/* the segment as the key column. */ - - indexd = FALSE_; - begidx = 1; - endidx = stnrow[(i__3 = seg - 1) < 200 && 0 <= i__3 ? - i__3 : s_rnge("stnrow", i__3, "ekqmgr_", (ftnlen) - 4168)]; - } - -/* Whether or not we have any matching rows, we'll need */ -/* to record how many we have. Save the offset from the */ -/* join row set base for the pointer to the row vectors. */ -/* The row vector count follows this pointer. */ - - ptroff = nsv + 4 + (nseg - 1 << 1) + 1; - if (endidx >= begidx) { - -/* Initialize the count of matching rows for this */ -/* segment. The current stack top is the base address */ -/* for the row vectors; save the offset of this */ -/* address from the join row set's base. */ -/* Also compute the base address of the segment vector */ -/* for the current segment. */ - - nmatch = 0; - zzekstop_(&rwvbas); - i__6 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("rbas", i__3, "ekqmgr_", (ftnlen)4193)] + - ptroff; - i__7 = rbas[(i__5 = t - 1) < 10 && 0 <= i__5 ? i__5 : - s_rnge("rbas", i__5, "ekqmgr_", (ftnlen)4193)] + - ptroff; - i__8 = rwvbas - rbas[(i__4 = t - 1) < 10 && 0 <= i__4 ? - i__4 : s_rnge("rbas", i__4, "ekqmgr_", (ftnlen) - 4193)]; - zzeksupd_(&i__6, &i__7, &i__8); - -/* Count the active constraints. While we're at it, */ -/* fill in the descriptor lists LDSCRS and RDSCRS */ -/* with, respectively, the descriptors for the columns */ -/* on the left hand sides and right hand sides of */ -/* these constraints. */ - - cleari_(&c__11000, ldscrs); - cleari_(&c__11000, rdscrs); - nact = 0; - i__3 = cjsize; - for (i__ = 1; i__ <= i__3; ++i__) { - if (activc[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? - i__5 : s_rnge("activc", i__5, "ekqmgr_", ( - ftnlen)4209)] || activv[(i__4 = i__ - 1) < - 1000 && 0 <= i__4 ? i__4 : s_rnge("activv", - i__4, "ekqmgr_", (ftnlen)4209)]) { - ++nact; - -/* Look up the column descriptor for this */ -/* constraint. */ - j = stdtpt[(i__5 = seg - 1) < 200 && 0 <= i__5 ? - i__5 : s_rnge("stdtpt", i__5, "ekqmgr_", ( - ftnlen)4216)]; - i__4 = lcidx[(i__5 = i__ - 1) < 1000 && 0 <= i__5 - ? i__5 : s_rnge("lcidx", i__5, "ekqmgr_", - (ftnlen)4218)]; - for (k = 2; k <= i__4; ++k) { - j = lnknxt_(&j, dtpool); - } - movei_(&dtdscs[(i__4 = j * 11 - 11) < 110000 && 0 - <= i__4 ? i__4 : s_rnge("dtdscs", i__4, - "ekqmgr_", (ftnlen)4222)], &c__11, & - ldscrs[(i__5 = i__ * 11 - 11) < 11000 && - 0 <= i__5 ? i__5 : s_rnge("ldscrs", i__5, - "ekqmgr_", (ftnlen)4222)]); - j = stdtpt[(i__4 = seg - 1) < 200 && 0 <= i__4 ? - i__4 : s_rnge("stdtpt", i__4, "ekqmgr_", ( - ftnlen)4225)]; - i__5 = rcidx[(i__4 = i__ - 1) < 1000 && 0 <= i__4 - ? i__4 : s_rnge("rcidx", i__4, "ekqmgr_", - (ftnlen)4227)]; - for (k = 2; k <= i__5; ++k) { - j = lnknxt_(&j, dtpool); - } - movei_(&dtdscs[(i__5 = j * 11 - 11) < 110000 && 0 - <= i__5 ? i__5 : s_rnge("dtdscs", i__5, - "ekqmgr_", (ftnlen)4231)], &c__11, & - rdscrs[(i__4 = i__ * 11 - 11) < 11000 && - 0 <= i__4 ? i__4 : s_rnge("rdscrs", i__4, - "ekqmgr_", (ftnlen)4231)]); - } - } - if (nact > 0) { - -/* There are still active constraints left, so */ -/* proceed linearly through the remaining rows, */ -/* testing each one against these constraints. Add */ -/* matching rows to the current join row set. */ - - i__3 = endidx; - for (r__ = begidx; r__ <= i__3; ++r__) { - if (indexd) { - zzekixlk_(&sthan[(i__5 = seg - 1) < 200 && 0 - <= i__5 ? i__5 : s_rnge("sthan", i__5, - "ekqmgr_", (ftnlen)4250)], keydsc, & - r__, &rowidx); - } else { - -/* Look up the record pointer for row R. */ - - zzekrplk_(&sthan[(i__5 = seg - 1) < 200 && 0 - <= i__5 ? i__5 : s_rnge("sthan", i__5, - "ekqmgr_", (ftnlen)4258)], &stdscs[( - i__4 = seg * 24 - 24) < 4800 && 0 <= - i__4 ? i__4 : s_rnge("stdscs", i__4, - "ekqmgr_", (ftnlen)4258)], &r__, & - rowidx); - } - -/* Test the row against both value and column */ -/* constraints. For now, we supply an array */ -/* of default column entry element indices. */ - - vmtch = zzekrmch_(&cjsize, activv, &sthan[(i__5 = - seg - 1) < 200 && 0 <= i__5 ? i__5 : - s_rnge("sthan", i__5, "ekqmgr_", (ftnlen) - 4269)], &stdscs[(i__4 = seg * 24 - 24) < - 4800 && 0 <= i__4 ? i__4 : s_rnge("stdscs" - , i__4, "ekqmgr_", (ftnlen)4269)], ldscrs, - &rowidx, lelts, ops, dtype, eqryc, cbegs, - cends, dvals, ivals, eqryc_len); - cmtch = TRUE_; - -/* Note that ZZEKVMCH expects a set of inputs */ -/* that are not really parallel to those */ -/* expected by ZZEKRMCH. We feed the */ -/* column comparison constraints to ZZEKVMCH */ -/* one at a time. */ - - i__5 = cjsize; - for (j = 1; j <= i__5; ++j) { - cmtch = cmtch && zzekvmch_(&c__1, &activc[( - i__4 = j - 1) < 1000 && 0 <= i__4 ? - i__4 : s_rnge("activc", i__4, "ekqmg" - "r_", (ftnlen)4288)], &sthan[(i__6 = - seg - 1) < 200 && 0 <= i__6 ? i__6 : - s_rnge("sthan", i__6, "ekqmgr_", ( - ftnlen)4288)], &stdscs[(i__7 = seg * - 24 - 24) < 4800 && 0 <= i__7 ? i__7 : - s_rnge("stdscs", i__7, "ekqmgr_", ( - ftnlen)4288)], &ldscrs[(i__8 = j * 11 - - 11) < 11000 && 0 <= i__8 ? i__8 : - s_rnge("ldscrs", i__8, "ekqmgr_", ( - ftnlen)4288)], &rowidx, &c__1, &ops[( - i__9 = j - 1) < 1000 && 0 <= i__9 ? - i__9 : s_rnge("ops", i__9, "ekqmgr_", - (ftnlen)4288)], &sthan[(i__10 = seg - - 1) < 200 && 0 <= i__10 ? i__10 : - s_rnge("sthan", i__10, "ekqmgr_", ( - ftnlen)4288)], &stdscs[(i__11 = seg * - 24 - 24) < 4800 && 0 <= i__11 ? i__11 - : s_rnge("stdscs", i__11, "ekqmgr_", ( - ftnlen)4288)], &rdscrs[(i__12 = j * - 11 - 11) < 11000 && 0 <= i__12 ? - i__12 : s_rnge("rdscrs", i__12, "ekq" - "mgr_", (ftnlen)4288)], &rowidx, &c__1) - ; - } - if (cmtch && vmtch) { - -/* Push the `augmented row vector' for the */ -/* current row onto the stack. In this case, */ -/* of course, the augmented row vector is */ -/* trivial: it consists of the row number, */ -/* followed by the base address of the parent */ -/* segment vector. */ - - ++nmatch; - zzekspsh_(&c__1, &rowidx); - i__4 = sgvbas - rbas[(i__5 = t - 1) < 10 && 0 - <= i__5 ? i__5 : s_rnge("rbas", i__5, - "ekqmgr_", (ftnlen)4317)]; - zzekspsh_(&c__1, &i__4); - } - } - } else { - -/* All the rows indicated by BEGIDX and ENDIDX */ -/* match the constraints. This code section should */ -/* be upgraded to transfer the row numbers in */ -/* chunks. */ - - nmatch = endidx - begidx + 1; - i__3 = endidx; - for (r__ = begidx; r__ <= i__3; ++r__) { - if (indexd) { - -/* Look up the record pointer for row R */ -/* from the column index. */ - - zzekixlk_(&sthan[(i__5 = seg - 1) < 200 && 0 - <= i__5 ? i__5 : s_rnge("sthan", i__5, - "ekqmgr_", (ftnlen)4341)], keydsc, & - r__, &rowidx); - } else { - -/* Look up the record pointer for row R. */ - - zzekrplk_(&sthan[(i__5 = seg - 1) < 200 && 0 - <= i__5 ? i__5 : s_rnge("sthan", i__5, - "ekqmgr_", (ftnlen)4349)], &stdscs[( - i__4 = seg * 24 - 24) < 4800 && 0 <= - i__4 ? i__4 : s_rnge("stdscs", i__4, - "ekqmgr_", (ftnlen)4349)], &r__, & - rowidx); - } - zzekspsh_(&c__1, &rowidx); - i__4 = sgvbas - rbas[(i__5 = t - 1) < 10 && 0 <= - i__5 ? i__5 : s_rnge("rbas", i__5, "ekqm" - "gr_", (ftnlen)4357)]; - zzekspsh_(&c__1, &i__4); - } - } - -/* Fill in the row count for this segment in the join row */ -/* set. */ - - i__4 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("rbas", i__3, "ekqmgr_", (ftnlen)4367)] + - ptroff + 1; - i__6 = rbas[(i__5 = t - 1) < 10 && 0 <= i__5 ? i__5 : - s_rnge("rbas", i__5, "ekqmgr_", (ftnlen)4367)] + - ptroff + 1; - zzeksupd_(&i__4, &i__6, &nmatch); - } - -/* Take a look at the next segment. Update the total count */ -/* of matching rows for this table. */ - - seg = lnknxt_(&seg, stpool); - rtotal += nmatch; - } - -/* Fill in the size and count information for the join row set. */ - - zzekstop_(&top); - rsize[(i__3 = t - 1) < 200 && 0 <= i__3 ? i__3 : s_rnge("rsize", - i__3, "ekqmgr_", (ftnlen)4385)] = top - rbas[(i__5 = t - - 1) < 10 && 0 <= i__5 ? i__5 : s_rnge("rbas", i__5, "ekqm" - "gr_", (ftnlen)4385)]; - i__6 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4387)] + 1; - i__7 = rbas[(i__5 = t - 1) < 10 && 0 <= i__5 ? i__5 : s_rnge( - "rbas", i__5, "ekqmgr_", (ftnlen)4387)] + 1; - zzeksupd_(&i__6, &i__7, &rsize[(i__4 = t - 1) < 200 && 0 <= i__4 ? - i__4 : s_rnge("rsize", i__4, "ekqmgr_", (ftnlen)4387)]); - i__4 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4388)] + 2; - i__6 = rbas[(i__5 = t - 1) < 10 && 0 <= i__5 ? i__5 : s_rnge( - "rbas", i__5, "ekqmgr_", (ftnlen)4388)] + 2; - zzeksupd_(&i__4, &i__6, &rtotal); - -/* Compress out any empty segment vectors from the join row */ -/* set. */ - - zzekjsqz_(&rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4394)]); - -/* At this point, we've filled in the entire join row set for */ -/* table T. */ - - } - -/* Join the trivial join row sets, producing a final join row set */ -/* for the current conjunction. Retain the base address of this */ -/* join row set, if it is non-empty. Update the size of the join */ -/* row set union. */ - - - resbas = rbas[0]; - i__2 = ntab; - for (t = 2; t <= i__2; ++t) { - -/* Arm the join constraints! Turn on the constraints that */ -/* have the Tth table on the one side, and tables */ -/* 1, 2, ... , T on the other. */ - - i__3 = cjsize; - for (i__ = 1; i__ <= i__3; ++i__) { - activc[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? i__5 : s_rnge( - "activc", i__5, "ekqmgr_", (ftnlen)4419)] = FALSE_; - if (cnstyp[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? i__5 : - s_rnge("cnstyp", i__5, "ekqmgr_", (ftnlen)4421)] == 1) - { - l = ltbidx[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? i__5 : - s_rnge("ltbidx", i__5, "ekqmgr_", (ftnlen)4423)]; - r__ = rtbidx[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? i__5 : - s_rnge("rtbidx", i__5, "ekqmgr_", (ftnlen)4424)]; - if (l >= 1 && l <= t && r__ >= 1 && r__ <= t && l != r__ - && (r__ == t || l == t)) { - activc[(i__5 = i__ - 1) < 1000 && 0 <= i__5 ? i__5 : - s_rnge("activc", i__5, "ekqmgr_", (ftnlen) - 4434)] = TRUE_; - } - } - } - -/* The base address of the first join row set is the base */ -/* address of the result of the previous join. The first time */ -/* through, the base of the join row set for table 1 is used. */ - - if (t == 2) { - jbase1 = rbas[0]; - } else { - jbase1 = resbas; - } - jbase2 = rbas[(i__3 = t - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "rbas", i__3, "ekqmgr_", (ftnlen)4453)]; - zzekjoin_(&jbase1, &jbase2, &cjsize, activc, ltbidx, lcidx, lelts, - ops, rtbidx, rcidx, relts, sthan, stdscs, stdtpt, dtpool, - dtdscs, &resbas, &jsize); - zzekjsqz_(&resbas); - } - -/* At this point, we've found the matching rows for the current */ -/* query conjunction. Update the size of the join row set union */ -/* corresponding to the current query. Save the base address of */ -/* the final join row set. Update the total number of matching */ -/* rows in the join row set union. */ - - ++usize; - ubase[(i__2 = usize - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("ubase", - i__2, "ekqmgr_", (ftnlen)4473)] = resbas; - i__2 = resbas + 2; - i__3 = resbas + 2; - zzeksrd_(&i__2, &i__3, &cjrows); - unrows += cjrows; - -/* Remove redundant row vectors from the join row set union. */ -/* These row vectors may arise in the execution of queries whose */ -/* WHERE clauses contain multiple conjunctions. */ - - zzekweed_(&usize, ubase, &unrows); - -/* Initialize the addressing function for the current join row */ -/* set union. */ - - if (usize > 0) { - zzekvset_(&usize, ubase); - } - } - -/* At this point, we've formed the join row set union that */ -/* represents the set of row vectors matching the entire query. */ - - *nmrows = unrows; - -/* Get the tables and columns of from the SELECT clause. For */ -/* each qualifying table, we need the index in the FROM clause */ -/* of that table. For each column, we need the column table */ -/* index. */ - - i__1 = nsel; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqsel_(eqryi, eqryc, &i__, &lxbeg, &lxend, tabnam, &tabidx, colnam, - &k, eqryc_len, (ftnlen)64, (ftnlen)32); - -/* Locate the column's attribute information. Retain the column's */ -/* index within the parent table's column list. */ - - tab = tptvec[(i__2 = tabidx + 5) < 16 && 0 <= i__2 ? i__2 : s_rnge( - "tptvec", i__2, "ekqmgr_", (ftnlen)4517)]; - j = tbctpt[(i__2 = tab - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("tbct" - "pt", i__2, "ekqmgr_", (ftnlen)4518)]; - col = 0; - fnd = FALSE_; - while(j > 0 && ! fnd) { - ++col; - if (s_cmp(ctnams + (((i__2 = j - 1) < 500 && 0 <= i__2 ? i__2 : - s_rnge("ctnams", i__2, "ekqmgr_", (ftnlen)4526)) << 5), - colnam, (ftnlen)32, (ftnlen)32) == 0) { - fnd = TRUE_; - } else { - j = lnknxt_(&j, ctpool); - } - } - if (! fnd) { - setmsg_("# is not name of a column in FROM table #.", (ftnlen)42); - errch_("#", colnam, (ftnlen)1, (ftnlen)32); - errint_("#", &tabidx, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("EKSRCH", (ftnlen)6); - return 0; - } - selctp[(i__2 = i__ - 1) < 50 && 0 <= i__2 ? i__2 : s_rnge("selctp", - i__2, "ekqmgr_", (ftnlen)4543)] = j; - selcol[(i__2 = i__ - 1) < 50 && 0 <= i__2 ? i__2 : s_rnge("selcol", - i__2, "ekqmgr_", (ftnlen)4544)] = col; - seltab[(i__2 = i__ - 1) < 50 && 0 <= i__2 ? i__2 : s_rnge("seltab", - i__2, "ekqmgr_", (ftnlen)4545)] = tabidx; - } - -/* Enable sorting of the matching row vectors, if necessary. The */ -/* first fetch request will invoke the sort. */ - - dosort = norder > 0 && *nmrows > 0; - sorted = FALSE_; - if (dosort) { - i__1 = norder; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqord_(eqryi, eqryc, &i__, tabnam, &otabs[(i__2 = i__ - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("otabs", i__2, "ekqmgr_", - (ftnlen)4560)], colnam, &ocols[(i__3 = i__ - 1) < 10 && 0 - <= i__3 ? i__3 : s_rnge("ocols", i__3, "ekqmgr_", (ftnlen) - 4560)], &sense[(i__5 = i__ - 1) < 10 && 0 <= i__5 ? i__5 : - s_rnge("sense", i__5, "ekqmgr_", (ftnlen)4560)], - eqryc_len, (ftnlen)64, (ftnlen)32); - } - } - chkout_("EKSRCH", (ftnlen)6); - return 0; -/* $Procedure EKNELT ( EK, get number of elements in column entry ) */ - -L_eknelt: -/* $ Abstract */ - -/* Return the number of elements in a specified column entry in */ -/* the current row. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ - -/* INTEGER SELIDX */ -/* INTEGER ROW */ -/* INTEGER NELT */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SELIDX I Index of parent column in SELECT clause. */ -/* ROW I Row containing element. */ -/* NELT O Number of elements in entry in current row. */ - -/* $ Detailed_Input */ - -/* SELIDX is the SELECT clause index of the column to */ -/* fetch from. */ - -/* ROW is the index of the row containing the element. */ -/* This number refers to a member of the set of rows */ -/* matching a query. ROW must be in the range */ - -/* 1 : NMROWS */ - -/* where NMROWS is the matching row count returned */ -/* by EKSRCH. */ - -/* $ Detailed_Output */ - -/* NELT is the number of elements in the column entry */ -/* belonging to the specified column in the current */ -/* row. */ - -/* Null entries in variable-size columns are */ -/* considered to have size 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called when no E-kernels have been loaded, */ -/* the error SPICE(NOLOADEDFILES) is signalled. */ - -/* 2) If SELIDX is outside of the range established by the */ -/* last query passed to EKSRCH, the error SPICE(INVALIDINDEX) */ -/* will be signalled. */ - -/* 3) If ROW is outside of the range established by the */ -/* last query passed to EKSRCH, the error SPICE(INVALIDINDEX) */ -/* will be signalled. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* This routine is meant to be used in conjunction with the EKQMGR */ -/* fetch entry points EKGC, EKGD, and EKGI. This routine */ -/* allows the caller of those routines to determine appropriate */ -/* loop bounds to use to fetch each column entry in the current row. */ - -/* $ Examples */ - -/* 1) Suppose the EK table TAB contains the following columns: */ - - -/* Column name Data Type Size */ -/* ----------- --------- ---- */ -/* IARRAY INT 10 */ -/* DARRAY DP VARIABLE */ -/* CARRAY CHR VARIABLE */ - - -/* Suppose the query */ - -/* QUERY = 'SELECT IARRAY, DARRAY, CARRAY FROM TAB' */ - -/* is issued to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by the fetch routines since we know */ -/* in advance how many elements are contained in each column */ -/* entry we fetch. */ - - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column IARRAY in the current */ -/* C row. Since IARRAY was the first column selected, */ -/* C the selection index SELIDX is set to 1. */ -/* C */ -/* SELIDX = 1 */ - -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. 10 ) .AND. .NOT. ISNULL ) */ -/* C */ -/* C If the column entry is null, we'll be kicked */ -/* C out of this loop after the first iteration. */ -/* C */ -/* CALL EKGI ( SELIDX, ROW, ELTIDX, */ -/* IVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = IARRAY' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( IVALS(I), I = 1, 10 ) */ -/* END IF */ - -/* C */ -/* C Fetch values from column DARRAY in the current */ -/* C row. Since DARRAY contains variable-size array */ -/* C elements, we call EKNELT to determine how many */ -/* C elements to fetch. */ -/* C */ -/* SELIDX = 2 */ - -/* CALL EKNELT ( SELIDX, ROW, NELT ) */ - -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. NELT ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGD ( SELIDX, ROW, ELTIDX, */ -/* DVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = DARRAY' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( DVALS(I), I = 1, NELT ) */ -/* END IF */ - -/* C */ -/* C Fetch values from column CARRAY in the current */ -/* C row. */ -/* C */ -/* SELIDX = 3 */ -/* CALL EKNELT ( SELIDX, ROW, NELT ) */ - -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. NELT ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGC ( SELIDX, ROW, ELTIDX, */ -/* CVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = CARRAY' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( CVALS(I), I = 1, NELT ) */ -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.2.0, 12-FEB-1999 (NJB) */ - -/* Bug fix: There was a error handling branch that called CHKOUT */ -/* where CHKIN should have been called. This has been fixed. */ - -/* - SPICELIB Version 1.1.0, 09-JUL-1996 (NJB) */ - -/* Bug fix: EKNELT now initiates a sort operation if sorted */ -/* outputs are required and EKNELT is called after query */ -/* resolution but before the fetch routines. Also, addressing */ -/* for sorted query results has been fixed. */ - -/* Misspelling of "issued" was fixed. Previous version line was */ -/* changed from "Beta" to "SPICELIB." */ - - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return the number of elements in a column entry */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 12-FEB-1999 (NJB) */ - -/* Bug fix: There was a error handling branch that called CHKOUT */ -/* where CHKIN should have been called. This has been fixed. */ - -/* - SPICELIB Version 1.1.0, 09-JUL-1996 (NJB) */ - -/* Bug fix: EKNELT now initiates a sort operation if sorted */ -/* outputs are required and EKNELT is called after query */ -/* resolution but before the fetch routines. Also, addressing */ -/* for sorted query results has been fixed. The fix involved */ -/* copying the sort invocation and addressing code from the */ -/* fetch routines. */ - -/* Misspelling of "issued" was fixed. Previous version line was */ -/* changed from "Beta" to "SPICELIB." */ - -/* -& */ - -/* Use discovery check-in for speed. */ - - if (return_()) { - return 0; - } - -/* The request doesn't make sense if no files are loaded. A sure */ -/* symptom of this problem is that the file list is empty. */ - - if (fthead <= 0) { - chkin_("EKNELT", (ftnlen)6); - setmsg_("No E-kernels are currently loaded.", (ftnlen)34); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("EKNELT", (ftnlen)6); - return 0; - } - -/* The row number must be valid, or we can't proceed. */ - - if (*row < 1 || *row > unrows) { - chkin_("EKNELT", (ftnlen)6); - setmsg_("Row indices for query result range from 1 to #; requested r" - "ow index was #.", (ftnlen)74); - errint_("#", &unrows, (ftnlen)1); - errint_("#", row, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKNELT", (ftnlen)6); - return 0; - } - -/* Make sure the SELECT clause column index is valid. */ - - if (*selidx < 1 || *selidx > nsel) { - chkin_("EKNELT", (ftnlen)6); - setmsg_("The SELECT column index # is out of the valid range 1:#", ( - ftnlen)55); - errint_("#", selidx, (ftnlen)1); - errint_("#", &ntab, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKNELT", (ftnlen)6); - return 0; - } - -/* If it hasn't been done yet, and if it needs to be done, sort the */ -/* matching row vectors. */ - - if (dosort) { - zzekjsrt_(&usize, ubase, &norder, otabs, ocols, oelts, sense, sthan, - stdscs, stdtpt, dtpool, dtdscs, &ordbas); - dosort = FALSE_; - sorted = TRUE_; - } - -/* Look up the segment vector and row vector for the current row. */ - - if (sorted) { - i__1 = ordbas + *row; - i__2 = ordbas + *row; - zzeksrd_(&i__1, &i__2, &i__); - zzekvcal_(&i__, &rwvbas, &sgvbas); - } else { - zzekvcal_(row, &rwvbas, &sgvbas); - } - i__1 = rwvbas + 1; - i__2 = rwvbas + ntab; - zzeksrd_(&i__1, &i__2, rowvec); - i__1 = sgvbas + 1; - i__2 = sgvbas + ntab; - zzeksrd_(&i__1, &i__2, segvec); - tabidx = seltab[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "seltab", i__1, "ekqmgr_", (ftnlen)4958)]; - rowidx = rowvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "rowvec", i__1, "ekqmgr_", (ftnlen)4959)]; - seg = segvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("segv" - "ec", i__1, "ekqmgr_", (ftnlen)4960)]; - col = selcol[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge("sel" - "col", i__1, "ekqmgr_", (ftnlen)4961)]; - colptr = stdtpt[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("std" - "tpt", i__1, "ekqmgr_", (ftnlen)4963)]; - i__1 = col; - for (i__ = 2; i__ <= i__1; ++i__) { - colptr = lnknxt_(&colptr, dtpool); - } - *nelt = zzekesiz_(&sthan[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("sthan", i__1, "ekqmgr_", (ftnlen)4969)], &stdscs[(i__2 = - seg * 24 - 24) < 4800 && 0 <= i__2 ? i__2 : s_rnge("stdscs", i__2, - "ekqmgr_", (ftnlen)4969)], &dtdscs[(i__3 = colptr * 11 - 11) < - 110000 && 0 <= i__3 ? i__3 : s_rnge("dtdscs", i__3, "ekqmgr_", ( - ftnlen)4969)], &rowidx); - return 0; -/* $Procedure EKGC ( EK, get event data, character ) */ - -L_ekgc: -/* $ Abstract */ - -/* Return an element of an entry in a column of character */ -/* type in a specified row. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* EK */ - -/* $ Declarations */ - -/* INTEGER SELIDX */ -/* INTEGER ROW */ -/* INTEGER ELMENT */ -/* CHARACTER*(*) CDATA */ -/* LOGICAL NULL */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SELIDX I Index of parent column in SELECT clause. */ -/* ROW I Row to fetch from. */ -/* ELMENT I Index of element, within column entry, to fetch. */ -/* CDATA O Character string element of column entry. */ -/* NULL O Flag indicating whether column entry was null. */ -/* FOUND O Flag indicating whether column was present in row. */ - -/* $ Detailed_Input */ - -/* SELIDX is the SELECT clause index of the column to */ -/* fetch from. */ - -/* ROW is the output row containing the entry to fetch */ -/* from. */ - -/* ELMENT is the index of the element of the column entry */ -/* to fetch. The normal range of ELMENT is from 1 to */ -/* the size of the column's entry, but ELMENT is */ -/* allowed to exceed the number of elements in the */ -/* column entry; if it does, FOUND is returned .FALSE. */ -/* This allows the caller to read data from the column */ -/* entry in a loop without checking the number of */ -/* available elements first. */ - -/* Null values in variable-sized columns are */ -/* considered to have size 1. */ - -/* $ Detailed_Output */ - -/* CDATA is the requested element of the specified column */ -/* entry. If the entry is null, CDATA is undefined. */ - -/* If CDATA is too short to accommodate the requested */ -/* column entry element, the element is truncated on */ -/* the right to fit CDATA. If CDATA is longer than */ -/* the element, CDATA is returned blank-padded on */ -/* the right. */ - -/* NULL is a logical flag indicating whether the entry */ -/* belonging to the specified column in the specified */ -/* row is null. */ - -/* FOUND is a logical flag indicating whether the specified */ -/* element was found. If the element does not exist, */ -/* FOUND is returned .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input argument ELMENT is less than 1, FOUND is returned */ -/* .FALSE., and the error SPICE(INVALIDINDEX) is signalled. */ -/* However, ELMENT is allowed to be greater than the number of */ -/* elements in the specified column entry; this allows the caller */ -/* to read data from the column entry in a loop without checking */ -/* the number of available elements first. If ELMENT is greater */ -/* than the number of available elements, FOUND is returned */ -/* .FALSE. */ - -/* 2) If SELIDX is outside of the range established by the */ -/* last query passed to EKSRCH, the error SPICE(INVALIDINDEX) */ -/* will be signalled. */ - -/* 3) If the input argument ROW is less than 1 or greater than */ -/* the number of rows matching the query, FOUND is returned */ -/* .FALSE., and the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If the specified column does not have character type, the */ -/* error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If this routine is called when no E-kernels have been loaded, */ -/* the error SPICE(NOLOADEDFILES) is signalled. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* This routine allows retrieval of data from character columns. */ - -/* This routine returns one element at a time in order to save the */ -/* caller from imposing a limit on the size of the column entries */ -/* that can be handled. */ - -/* $ Examples */ - -/* 1) Suppose the EK table TAB contains the following columns: */ - -/* Column name Data Type Size */ -/* ----------- --------- ---- */ -/* CHR_COL_1 CHR 1 */ -/* CHR_COL_2 CHR VARIABLE */ -/* CHR_COL_3 CHR 10 */ - - -/* Suppose the query */ - -/* QUERY = 'SELECT CHR_COL_1 FROM TAB' */ - -/* is issued to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by EKGC since we know that every */ -/* entry in column CHR_COL_1 contains one element. */ - -/* C */ -/* C Since CHR_COL_1was the first column selected, */ -/* C the selection index SELIDX is set to 1. */ -/* C The column is scalar, so the element index ELTIDX */ -/* C is set to 1. The variable NMROWS is the number of */ -/* C matching rows returned by EKFIND. */ -/* C */ - -/* SELIDX = 1 */ -/* ELTIDX = 1 */ - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column CHR_COL_1. */ -/* C */ -/* CALL EKGC ( SELIDX, ROW, ELTIDX, */ -/* CVAL, ISNULL, FOUND ) */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) CVAL */ -/* END IF */ - -/* END DO */ - - - -/* 2) Suppose the EK table TAB is as in example 1, and we issue */ -/* the query */ - -/* QUERY = 'SELECT CHR_COL_1, CHR_COL_2, CHR_COL_3 FROM TAB' */ - -/* to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by EKGC since we know in advance how */ -/* many elements are contained in each column entry we fetch. */ - - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column CHR_COL_1. Since */ -/* C CHR_COL_1 was the first column selected, the */ -/* C selection index SELIDX is set to 1. */ -/* C */ -/* SELIDX = 1 */ -/* ELTIDX = 1 */ -/* CALL EKGC ( SELIDX, ROW, ELTIDX, */ -/* CVALS(1), ISNULL, FOUND ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = CHR_COL_1' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) CVALS(1) */ -/* END IF */ - -/* C */ -/* C Fetch values from column CHR_COL_2 in the current */ -/* C row. Since CHR_COL_2 contains variable-size array */ -/* C elements, we call EKNELT to determine how many */ -/* C elements to fetch. */ -/* C */ -/* SELIDX = 2 */ -/* CALL EKNELT ( SELIDX, ROW, NELT ) */ - -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. NELT ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGC ( SELIDX, ROW, ELTIDX, */ -/* CVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* C */ -/* C If the column entry is null, we'll be kicked */ -/* C out of this loop after the first iteration. */ -/* C */ -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = CHR_COL_2' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( CVALS(I), I = 1, NELT ) */ -/* END IF */ - -/* C */ -/* C Fetch values from column CHR_COL_3 in the current */ -/* C row. We need not call EKNELT since we know how */ -/* C many elements are in each column entry. */ -/* C */ -/* SELIDX = 3 */ -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. 10 ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGC ( SELIDX, ROW, ELTIDX, */ -/* CVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = CHR_COL_3' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( CVALS(I), I = 1, 10 ) */ -/* END IF */ - -/* END DO */ - - -/* 3) See the $Examples section of the umbrella routine EKQMGR */ -/* for an example in which the names and data types of the */ -/* columns from which to fetch data are not known in advance. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Redundant CHKIN call removed from SELIDX error check. */ -/* Misspelling of "issued" was fixed. Previous version line */ -/* was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch element from character column entry */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Redundant CHKIN call removed from SELIDX error check. */ -/* Misspelling of "issued" was fixed. Previous version line */ -/* was changed from "Beta" to "SPICELIB." */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKGC", (ftnlen)4); - } - -/* Nothing found yet. */ - - *found = FALSE_; - -/* There nothing to fetch if no files are loaded. A sure */ -/* symptom of this problem is that the file list is empty. */ - - if (fthead <= 0) { - setmsg_("No E-kernels are currently loaded.", (ftnlen)34); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("EKGC", (ftnlen)4); - return 0; - } - -/* The row number must be valid, or we can't proceed. */ - - if (*row < 1 || *row > unrows) { - setmsg_("Row indices for query result range from 1 to #; requested r" - "ow index was #.", (ftnlen)74); - errint_("#", &unrows, (ftnlen)1); - errint_("#", row, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGC", (ftnlen)4); - return 0; - } - -/* The element index must be positive. */ - - if (*elment < 1) { - setmsg_("ELMENT must be positive but was #.", (ftnlen)34); - errint_("#", elment, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGC", (ftnlen)4); - return 0; - } - -/* Make sure the SELECT clause column index is valid. */ - - if (*selidx < 1 || *selidx > nsel) { - setmsg_("The SELECT column index # is out of the valid range 1:#", ( - ftnlen)55); - errint_("#", selidx, (ftnlen)1); - errint_("#", &ntab, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGC", (ftnlen)4); - return 0; - } - -/* COL is the column's index within the parent */ -/* table's column list. */ - - tabidx = seltab[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "seltab", i__1, "ekqmgr_", (ftnlen)5409)]; - col = selcol[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge("sel" - "col", i__1, "ekqmgr_", (ftnlen)5410)]; - colptr = selctp[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "selctp", i__1, "ekqmgr_", (ftnlen)5411)]; - tab = tptvec[(i__1 = tabidx + 5) < 16 && 0 <= i__1 ? i__1 : s_rnge("tptv" - "ec", i__1, "ekqmgr_", (ftnlen)5412)]; - -/* Make sure the column has character type. */ - - if (cttyps[(i__1 = colptr - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("cttyps" - , i__1, "ekqmgr_", (ftnlen)5417)] != 1) { - setmsg_("Column # has data type #.", (ftnlen)25); - errch_("#", ctnams + (((i__1 = colptr - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctnams", i__1, "ekqmgr_", (ftnlen)5420)) << 5), ( - ftnlen)1, (ftnlen)32); - errch_("#", chtype + (((i__2 = cttyps[(i__1 = colptr - 1) < 500 && 0 - <= i__1 ? i__1 : s_rnge("cttyps", i__1, "ekqmgr_", (ftnlen) - 5421)] - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("chtype", i__2, - "ekqmgr_", (ftnlen)5421)) << 2), (ftnlen)1, (ftnlen)4); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("EKGC", (ftnlen)4); - return 0; - } - -/* If it hasn't been done yet, and if it needs to be done, sort the */ -/* matching row vectors. */ - - if (dosort) { - zzekjsrt_(&usize, ubase, &norder, otabs, ocols, oelts, sense, sthan, - stdscs, stdtpt, dtpool, dtdscs, &ordbas); - dosort = FALSE_; - sorted = TRUE_; - } - -/* Look up the segment vector and row vector for the current row. */ - - if (sorted) { - i__1 = ordbas + *row; - i__2 = ordbas + *row; - zzeksrd_(&i__1, &i__2, &i__); - zzekvcal_(&i__, &rwvbas, &sgvbas); - } else { - zzekvcal_(row, &rwvbas, &sgvbas); - } - i__1 = rwvbas + 1; - i__2 = rwvbas + ntab; - zzeksrd_(&i__1, &i__2, rowvec); - i__1 = sgvbas + 1; - i__2 = sgvbas + ntab; - zzeksrd_(&i__1, &i__2, segvec); - -/* Identify the segment containing the column entry of interest. */ -/* Obtain the column descriptor for the column. */ - - rowidx = rowvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "rowvec", i__1, "ekqmgr_", (ftnlen)5459)]; - seg = segvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("segv" - "ec", i__1, "ekqmgr_", (ftnlen)5460)]; - j = stdtpt[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("stdtpt", - i__1, "ekqmgr_", (ftnlen)5462)]; - i__1 = col; - for (i__ = 2; i__ <= i__1; ++i__) { - j = lnknxt_(&j, dtpool); - } - -/* Look up the element. */ - - zzekrsc_(&sthan[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("sth" - "an", i__1, "ekqmgr_", (ftnlen)5471)], &stdscs[(i__2 = seg * 24 - - 24) < 4800 && 0 <= i__2 ? i__2 : s_rnge("stdscs", i__2, "ekqmgr_", - (ftnlen)5471)], &dtdscs[(i__3 = j * 11 - 11) < 110000 && 0 <= - i__3 ? i__3 : s_rnge("dtdscs", i__3, "ekqmgr_", (ftnlen)5471)], & - rowidx, elment, &cvlen, cdata, null, found, cdata_len); - chkout_("EKGC", (ftnlen)4); - return 0; -/* $Procedure EKGD ( EK, get event data, double precision ) */ - -L_ekgd: -/* $ Abstract */ - -/* Return an element of an entry in a column of double precision */ -/* or `time' type in a specified row. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* EK */ - -/* $ Declarations */ - -/* INTEGER SELIDX */ -/* INTEGER ROW */ -/* INTEGER ELMENT */ -/* DOUBLE PRECISION DDATA */ -/* LOGICAL NULL */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SELIDX I Index of parent column in SELECT clause. */ -/* ROW I Row to fetch from. */ -/* ELMENT I Index of element, within column entry, to fetch. */ -/* DDATA O D.p. element of column entry. */ -/* NULL O Flag indicating whether column entry was null. */ -/* FOUND O Flag indicating whether column was present in row. */ - -/* $ Detailed_Input */ - -/* SELIDX is the SELECT clause index of the column to */ -/* fetch from. */ - -/* ROW is the output row containing the entry to fetch */ -/* from. */ - -/* ELMENT is the index of the element of the column entry */ -/* to fetch. The normal range of ELMENT is from 1 to */ -/* the size of the column's entry, but ELMENT is */ -/* allowed to exceed the number of elements in the */ -/* column entry; if it does, FOUND is returned .FALSE. */ -/* This allows the caller to read data from the column */ -/* entry in a loop without checking the number of */ -/* available elements first. */ - -/* Null values in variable-sized columns are */ -/* considered to have size 1. */ - -/* $ Detailed_Output */ - -/* DDATA is the requested element of the specified column */ -/* entry. If the entry is null, DDATA is undefined. */ - -/* NULL is a logical flag indicating whether the entry */ -/* belonging to the specified column in the specified */ -/* row is null. */ - -/* FOUND is a logical flag indicating whether the specified */ -/* element was found. If the element does not exist, */ -/* FOUND is returned .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input argument ELMENT is less than 1, FOUND is returned */ -/* .FALSE., and the error SPICE(INVALIDINDEX) is signalled. */ -/* However, ELMENT is allowed to be greater than the number of */ -/* elements in the specified column entry; this allows the caller */ -/* to read data from the column entry in a loop without checking */ -/* the number of available elements first. If ELMENT is greater */ -/* than the number of available elements, FOUND is returned */ -/* .FALSE. */ - -/* 2) If SELIDX is outside of the range established by the */ -/* last query passed to EKSRCH, the error SPICE(INVALIDINDEX) */ -/* will be signalled. */ - -/* 3) If the input argument ROW is less than 1 or greater than */ -/* the number of rows matching the query, FOUND is returned */ -/* .FALSE., and the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If the specified column does not have DP or TIME type, the */ -/* error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If this routine is called when no E-kernels have been loaded, */ -/* the error SPICE(NOLOADEDFILES) is signalled. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* This routine allows retrieval of data from double precision or */ -/* `time' columns. */ - -/* This routine returns one element at a time in order to save the */ -/* caller from imposing a limit on the size of the column entries */ -/* that can be handled. */ - -/* $ Examples */ - -/* 1) Suppose the EK table TAB contains the following columns: */ - -/* Column name Data Type Size */ -/* ----------- --------- ---- */ -/* DP_COL_1 DP 1 */ -/* DP_COL_2 DP VARIABLE */ -/* DP_COL_3 DP 10 */ -/* TIME TIME 1 */ - - -/* Suppose the query */ - -/* QUERY = 'SELECT DP_COL_1 FROM TAB' */ - -/* is issued to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by EKGD since we know that every */ -/* entry in column DP_COL_1 contains one element. */ - -/* C */ -/* C Since DP_COL_1was the first column selected, */ -/* C the selection index SELIDX is set to 1. */ -/* C The column is scalar, so the element index ELTIDX */ -/* C is set to 1. The variable NMROWS is the number of */ -/* C matching rows returned by EKFIND. */ -/* C */ - -/* SELIDX = 1 */ -/* ELTIDX = 1 */ - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column DP_COL_1. */ -/* C */ -/* CALL EKGD ( SELIDX, ROW, ELTIDX, */ -/* DVAL, ISNULL, FOUND ) */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) DVAL */ -/* END IF */ - -/* END DO */ - - -/* 2) Suppose the EK table TAB is as in example 1, and we issue */ -/* the query */ - -/* QUERY = 'SELECT TIME FROM TAB' */ - -/* to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* We wish to dump the time values as UTC calendar dates. */ -/* The code fragment below carries out this task. We assume */ -/* a leapseconds kernel is loaded. The variable UTC shown */ -/* below should be declared as a character string. */ - -/* SELIDX = 1 */ -/* ELTIDX = 1 */ - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column TIME. */ -/* C */ -/* CALL EKGD ( SELIDX, ROW, ELTIDX, */ -/* DVAL, ISNULL, FOUND ) */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* CALL ET2UTC ( DVAL, 'C', 3, UTC ) */ -/* WRITE (*,*) UTC */ -/* END IF */ - -/* END DO */ - - -/* 3) Suppose the EK table TAB is as in example 1, and we issue */ -/* the query */ - -/* QUERY = 'SELECT DP_COL_1, DP_COL_2, DP_COL_3 FROM TAB' */ - -/* to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by EKGD since we know in advance how */ -/* many elements are contained in each column entry we fetch. */ - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column DP_COL_1. Since */ -/* C DP_COL_1was the first column selected, the */ -/* C selection index SELIDX is set to 1. */ -/* C */ -/* SELIDX = 1 */ -/* ELTIDX = 1 */ -/* CALL EKGD ( SELIDX, ROW, ELTIDX, */ -/* DVALS(1), ISNULL, FOUND ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = DP_COL_1' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) DVALS(1) */ -/* END IF */ - -/* C */ -/* C Fetch values from column DP_COL_2 in the current */ -/* C row. Since DP_COL_2 contains variable-size array */ -/* C elements, we call EKNELT to determine how many */ -/* C elements to fetch. */ -/* C */ -/* SELIDX = 2 */ -/* CALL EKNELT ( SELIDX, ROW, NELT ) */ - -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. NELT ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGD ( SELIDX, ROW, ELTIDX, */ -/* DVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* C */ -/* C If the column entry is null, we'll be kicked */ -/* C out of this loop after the first iteration. */ -/* C */ -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = DP_COL_2' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( DVALS(I), I = 1, NELT ) */ -/* END IF */ - -/* C */ -/* C Fetch values from column DP_COL_3 in the current */ -/* C row. We need not call EKNELT since we know how */ -/* C many elements are in each column entry. */ -/* C */ -/* SELIDX = 3 */ -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. 10 ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGD ( SELIDX, ROW, ELTIDX, */ -/* DVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = DP_COL_3' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( DVALS(I), I = 1, 10 ) */ -/* END IF */ - -/* END DO */ - - -/* 4) See the $Examples section of the umbrella routine EKQMGR */ -/* for an example in which the names and data types of the */ -/* columns from which to fetch data are not known in advance. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Redundant CHKIN call removed from SELIDX error check. */ -/* Misspelling of "issued" was fixed. Previous version line */ -/* was changed from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch element from double precision column entry */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Redundant CHKIN call removed from SELIDX error check. */ -/* Misspelling of "issued" was fixed. Previous version line */ -/* was changed from "Beta" to "SPICELIB." */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKGD", (ftnlen)4); - } - -/* Nothing found yet. */ - - *found = FALSE_; - -/* There nothing to fetch if no files are loaded. A sure */ -/* symptom of this problem is that the file list is empty. */ - - if (fthead <= 0) { - setmsg_("No E-kernels are currently loaded.", (ftnlen)34); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("EKGD", (ftnlen)4); - return 0; - } - -/* The row number must be valid, or we can't proceed. */ - - if (*row < 1 || *row > unrows) { - setmsg_("Row indices for query result range from 1 to #; requested r" - "ow index was #.", (ftnlen)74); - errint_("#", &unrows, (ftnlen)1); - errint_("#", row, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGD", (ftnlen)4); - return 0; - } - -/* The element index must be positive. */ - - if (*elment < 1) { - setmsg_("ELMENT must be positive but was #.", (ftnlen)34); - errint_("#", elment, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGD", (ftnlen)4); - return 0; - } - -/* Make sure the SELECT clause column index is valid. */ - - if (*selidx < 1 || *selidx > nsel) { - setmsg_("The SELECT column index # is out of the valid range 1:#", ( - ftnlen)55); - errint_("#", selidx, (ftnlen)1); - errint_("#", &ntab, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGD", (ftnlen)4); - return 0; - } - -/* COL is the column's index within the parent */ -/* table's column list. */ - - tabidx = seltab[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "seltab", i__1, "ekqmgr_", (ftnlen)5953)]; - col = selcol[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge("sel" - "col", i__1, "ekqmgr_", (ftnlen)5954)]; - colptr = selctp[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "selctp", i__1, "ekqmgr_", (ftnlen)5955)]; - tab = tptvec[(i__1 = tabidx + 5) < 16 && 0 <= i__1 ? i__1 : s_rnge("tptv" - "ec", i__1, "ekqmgr_", (ftnlen)5956)]; - -/* Make sure the column has double precision or `time' type. */ - - if (cttyps[(i__1 = colptr - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("cttyps" - , i__1, "ekqmgr_", (ftnlen)5961)] != 2 && cttyps[(i__2 = colptr - - 1) < 500 && 0 <= i__2 ? i__2 : s_rnge("cttyps", i__2, "ekqmgr_", ( - ftnlen)5961)] != 4) { - setmsg_("Column # has data type #.", (ftnlen)25); - errch_("#", ctnams + (((i__1 = colptr - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctnams", i__1, "ekqmgr_", (ftnlen)5965)) << 5), ( - ftnlen)1, (ftnlen)32); - errch_("#", chtype + (((i__2 = cttyps[(i__1 = colptr - 1) < 500 && 0 - <= i__1 ? i__1 : s_rnge("cttyps", i__1, "ekqmgr_", (ftnlen) - 5966)] - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("chtype", i__2, - "ekqmgr_", (ftnlen)5966)) << 2), (ftnlen)1, (ftnlen)4); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("EKGD", (ftnlen)4); - return 0; - } - -/* If it hasn't been done yet, and if it needs to be done, sort the */ -/* matching row vectors. */ - - if (dosort) { - zzekjsrt_(&usize, ubase, &norder, otabs, ocols, oelts, sense, sthan, - stdscs, stdtpt, dtpool, dtdscs, &ordbas); - dosort = FALSE_; - sorted = TRUE_; - } - -/* Look up the segment vector and row vector for the current row. */ - - if (sorted) { - i__1 = ordbas + *row; - i__2 = ordbas + *row; - zzeksrd_(&i__1, &i__2, &i__); - zzekvcal_(&i__, &rwvbas, &sgvbas); - } else { - zzekvcal_(row, &rwvbas, &sgvbas); - } - i__1 = rwvbas + 1; - i__2 = rwvbas + ntab; - zzeksrd_(&i__1, &i__2, rowvec); - i__1 = sgvbas + 1; - i__2 = sgvbas + ntab; - zzeksrd_(&i__1, &i__2, segvec); - -/* Identify the segment containing the column entry of interest. */ -/* Obtain the column descriptor for the column. */ - - rowidx = rowvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "rowvec", i__1, "ekqmgr_", (ftnlen)6004)]; - seg = segvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("segv" - "ec", i__1, "ekqmgr_", (ftnlen)6005)]; - j = stdtpt[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("stdtpt", - i__1, "ekqmgr_", (ftnlen)6007)]; - i__1 = col; - for (i__ = 2; i__ <= i__1; ++i__) { - j = lnknxt_(&j, dtpool); - } - -/* Look up the element. */ - - zzekrsd_(&sthan[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("sth" - "an", i__1, "ekqmgr_", (ftnlen)6016)], &stdscs[(i__2 = seg * 24 - - 24) < 4800 && 0 <= i__2 ? i__2 : s_rnge("stdscs", i__2, "ekqmgr_", - (ftnlen)6016)], &dtdscs[(i__3 = j * 11 - 11) < 110000 && 0 <= - i__3 ? i__3 : s_rnge("dtdscs", i__3, "ekqmgr_", (ftnlen)6016)], & - rowidx, elment, ddata, null, found); - chkout_("EKGD", (ftnlen)4); - return 0; -/* $Procedure EKGI ( EK, get event data, integer ) */ - -L_ekgi: -/* $ Abstract */ - -/* Return an element of an entry in a column of integer */ -/* type in a specified row. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* ASSIGNMENT */ -/* EK */ - -/* $ Declarations */ - -/* INTEGER SELIDX */ -/* INTEGER ROW */ -/* INTEGER ELMENT */ -/* INTEGER IDATA */ -/* LOGICAL NULL */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SELIDX I Index of parent column in SELECT clause. */ -/* ROW I Row to fetch from. */ -/* ELMENT I Index of element, within column entry, to fetch. */ -/* IDATA O Integer element of column entry. */ -/* NULL O Flag indicating whether column entry was null. */ -/* FOUND O Flag indicating whether column was present in row. */ - -/* $ Detailed_Input */ - -/* SELIDX is the SELECT clause index of the column to */ -/* fetch from. */ - -/* ROW is the output row containing the entry to fetch */ -/* from. */ - -/* ELMENT is the index of the element of the column entry */ -/* to fetch. The normal range of ELMENT is from 1 to */ -/* the size of the column's entry, but ELMENT is */ -/* allowed to exceed the number of elements in the */ -/* column entry; if it does, FOUND is returned .FALSE. */ -/* This allows the caller to read data from the column */ -/* entry in a loop without checking the number of */ -/* available elements first. */ - -/* Null values in variable-sized columns are */ -/* considered to have size 1. */ - -/* $ Detailed_Output */ - -/* IDATA is the requested element of the specified column */ -/* entry. If the entry is null, IDATA is undefined. */ - -/* NULL is a logical flag indicating whether the entry */ -/* belonging to the specified column in the specified */ -/* row is null. */ - -/* FOUND is a logical flag indicating whether the specified */ -/* element was found. If the element does not exist, */ -/* FOUND is returned .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input argument ELMENT is less than 1, FOUND is returned */ -/* .FALSE., and the error SPICE(INVALIDINDEX) is signalled. */ -/* However, ELMENT is allowed to be greater than the number of */ -/* elements in the specified column entry; this allows the caller */ -/* to read data from the column entry in a loop without checking */ -/* the number of available elements first. If ELMENT is greater */ -/* than the number of available elements, FOUND is returned */ -/* .FALSE. */ - -/* 2) If SELIDX is outside of the range established by the */ -/* last query passed to EKSRCH, the error SPICE(INVALIDINDEX) */ -/* will be signalled. */ - -/* 3) If the input argument ROW is less than 1 or greater than */ -/* the number of rows matching the query, FOUND is returned */ -/* .FALSE., and the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If the specified column does not have integer type, the */ -/* error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If this routine is called when no E-kernels have been loaded, */ -/* the error SPICE(NOLOADEDFILES) is signalled. */ - -/* $ Files */ - -/* See the header of EKQMGR for a description of files used */ -/* by this routine. */ - -/* $ Particulars */ - -/* This routine allows retrieval of data from integer columns. */ - -/* This routine returns one element at a time in order to save the */ -/* caller from imposing a limit on the size of the column entries */ -/* that can be handled. */ - -/* $ Examples */ - -/* 1) Suppose the EK table TAB contains the following columns: */ - -/* Column name Data Type Size */ -/* ----------- --------- ---- */ -/* INT_COL_1 INT 1 */ -/* INT_COL_2 INT VARIABLE */ -/* INT_COL_3 INT 10 */ - - -/* Suppose the query */ - -/* QUERY = 'SELECT INT_COL_1 FROM TAB' */ - -/* is issued to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by EKGI since we know that every */ -/* entry in column INT_COL_1 contains one element. */ - -/* C */ -/* C Since INT_COL_1was the first column selected, */ -/* C the selection index SELIDX is set to 1. */ -/* C The column is scalar, so the element index ELTIDX */ -/* C is set to 1. The variable NMROWS is the number of */ -/* C matching rows returned by EKFIND. */ -/* C */ - -/* SELIDX = 1 */ -/* ELTIDX = 1 */ - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column INT_COL_1. */ -/* C */ -/* CALL EKGI ( SELIDX, ROW, ELTIDX, */ -/* IVAL, ISNULL, FOUND ) */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) IVAL */ -/* END IF */ - -/* END DO */ - - - -/* 2) Suppose the EK table TAB is as in example 1, and we issue */ -/* the query */ - -/* QUERY = 'SELECT INT_COL_1, INT_COL_2, INT_COL_3 FROM TAB' */ - -/* to EKFIND via the call */ - -/* CALL EKFIND ( QUERY, NMROWS, ERROR, ERRMSG ) */ - -/* To fetch and dump column values from the rows that satisfy the */ -/* query, the loop below could be used. Note that we don't check */ -/* the FOUND flags returned by EKGI since we know in advance how */ -/* many elements are contained in each column entry we fetch. */ - - -/* DO ROW = 1, NMROWS */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'ROW = ', ROW */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Fetch values from column INT_COL_1. Since */ -/* C INT_COL_1 was the first column selected, the */ -/* C selection index SELIDX is set to 1. */ -/* C */ -/* SELIDX = 1 */ -/* ELTIDX = 1 */ -/* CALL EKGI ( SELIDX, ROW, ELTIDX, */ -/* IVALS(1), ISNULL, FOUND ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = INT_COL_1' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) IVALS(1) */ -/* END IF */ - -/* C */ -/* C Fetch values from column INT_COL_2 in the current */ -/* C row. Since INT_COL_2 contains variable-size array */ -/* C elements, we call EKNELT to determine how many */ -/* C elements to fetch. */ -/* C */ -/* SELIDX = 2 */ -/* CALL EKNELT ( SELIDX, ROW, NELT ) */ - -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. NELT ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGI ( SELIDX, ROW, ELTIDX, */ -/* IVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* C */ -/* C If the column entry is null, we'll be kicked */ -/* C out of this loop after the first iteration. */ -/* C */ -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = INT_COL_2' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( IVALS(I), I = 1, NELT ) */ -/* END IF */ - -/* C */ -/* C Fetch values from column INT_COL_3 in the current */ -/* C row. We need not call EKNELT since we know how */ -/* C many elements are in each column entry. */ -/* C */ -/* SELIDX = 3 */ -/* ELTIDX = 1 */ -/* ISNULL = .FALSE. */ - -/* DO WHILE ( ( ELTIDX .LE. 10 ) */ -/* . .AND. ( .NOT. ISNULL ) ) */ - -/* CALL EKGI ( SELIDX, ROW, ELTIDX, */ -/* IVALS(ELTIDX), ISNULL, FOUND ) */ - -/* ELTIDX = ELTIDX + 1 */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'COLUMN = INT_COL_3' */ -/* WRITE (*,*) ' ' */ - -/* IF ( ISNULL ) THEN */ -/* WRITE (*,*) '' */ -/* ELSE */ -/* WRITE (*,*) ( IVALS(I), I = 1, 10 ) */ -/* END IF */ - -/* END DO */ - - -/* 3) See the $Examples section of the umbrella routine EKQMGR */ -/* for an example in which the names and data types of the */ -/* columns from which to fetch data are not known in advance. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 22-SEP-2004 (EDW) */ - -/* Edited 1.1.0 Version entry to not include */ -/* the token used to mark the $Procedure section. */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (NJB) */ - -/* Bug fix: When an already loaded kernel is opened with EKOPR, */ -/* it now has its link count reset to 1 via a call to EKCLS. */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Redundant CHKIN call removed from SELIDX error check. */ -/* Misspelling of "issued" was fixed. Previous version line */ -/* was changed from "Beta" to "SPICELIB." Header $Procedure */ -/* line was corrected to indicate integer data type. */ - -/* - SPICELIB Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch element from integer column entry */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.1, 22-SEP-2004 (EDW) */ - -/* Edited 1.1.0 Version entry to not include */ -/* the token used to mark the $Procedure section. */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Redundant CHKIN call removed from SELIDX error check. */ -/* Misspelling of "issued" was fixed. Previous version line */ -/* was changed from "Beta" to "SPICELIB." Header $Procedure */ -/* line was corrected to indicate integer data type. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKGI", (ftnlen)4); - } - -/* Nothing found yet. */ - - *found = FALSE_; - -/* There nothing to fetch if no files are loaded. A sure */ -/* symptom of this problem is that the file list is empty. */ - - if (fthead <= 0) { - setmsg_("No E-kernels are currently loaded.", (ftnlen)34); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("EKGI", (ftnlen)4); - return 0; - } - -/* The row number must be valid, or we can't proceed. */ - - if (*row < 1 || *row > unrows) { - setmsg_("Row indices for query result range from 1 to #; requested r" - "ow index was #.", (ftnlen)74); - errint_("#", &unrows, (ftnlen)1); - errint_("#", row, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGI", (ftnlen)4); - return 0; - } - -/* The element index must be positive. */ - - if (*elment < 1) { - setmsg_("ELMENT must be positive but was #.", (ftnlen)34); - errint_("#", elment, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGI", (ftnlen)4); - return 0; - } - -/* Make sure the SELECT clause column index is valid. */ - - if (*selidx < 1 || *selidx > nsel) { - setmsg_("The SELECT column index # is out of the valid range 1:#", ( - ftnlen)55); - errint_("#", selidx, (ftnlen)1); - errint_("#", &ntab, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("EKGI", (ftnlen)4); - return 0; - } - -/* COL is the column's index within the parent */ -/* table's column list. */ - - tabidx = seltab[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "seltab", i__1, "ekqmgr_", (ftnlen)6469)]; - col = selcol[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge("sel" - "col", i__1, "ekqmgr_", (ftnlen)6470)]; - colptr = selctp[(i__1 = *selidx - 1) < 50 && 0 <= i__1 ? i__1 : s_rnge( - "selctp", i__1, "ekqmgr_", (ftnlen)6471)]; - tab = tptvec[(i__1 = tabidx + 5) < 16 && 0 <= i__1 ? i__1 : s_rnge("tptv" - "ec", i__1, "ekqmgr_", (ftnlen)6472)]; - -/* Make sure the column has integer type. */ - - if (cttyps[(i__1 = colptr - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("cttyps" - , i__1, "ekqmgr_", (ftnlen)6477)] != 3) { - setmsg_("Column # has data type #.", (ftnlen)25); - errch_("#", ctnams + (((i__1 = colptr - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("ctnams", i__1, "ekqmgr_", (ftnlen)6480)) << 5), ( - ftnlen)1, (ftnlen)32); - errch_("#", chtype + (((i__2 = cttyps[(i__1 = colptr - 1) < 500 && 0 - <= i__1 ? i__1 : s_rnge("cttyps", i__1, "ekqmgr_", (ftnlen) - 6481)] - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("chtype", i__2, - "ekqmgr_", (ftnlen)6481)) << 2), (ftnlen)1, (ftnlen)4); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("EKGI", (ftnlen)4); - return 0; - } - -/* If it hasn't been done yet, and if it needs to be done, sort the */ -/* matching row vectors. */ - - if (dosort) { - zzekjsrt_(&usize, ubase, &norder, otabs, ocols, oelts, sense, sthan, - stdscs, stdtpt, dtpool, dtdscs, &ordbas); - dosort = FALSE_; - sorted = TRUE_; - } - -/* Look up the segment vector and row vector for the current row. */ - - if (sorted) { - i__1 = ordbas + *row; - i__2 = ordbas + *row; - zzeksrd_(&i__1, &i__2, &i__); - zzekvcal_(&i__, &rwvbas, &sgvbas); - } else { - zzekvcal_(row, &rwvbas, &sgvbas); - } - i__1 = rwvbas + 1; - i__2 = rwvbas + ntab; - zzeksrd_(&i__1, &i__2, rowvec); - i__1 = sgvbas + 1; - i__2 = sgvbas + ntab; - zzeksrd_(&i__1, &i__2, segvec); - -/* Identify the segment containing the column entry of interest. */ -/* Obtain the column descriptor for the column. */ - - rowidx = rowvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "rowvec", i__1, "ekqmgr_", (ftnlen)6519)]; - seg = segvec[(i__1 = tabidx - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("segv" - "ec", i__1, "ekqmgr_", (ftnlen)6520)]; - j = stdtpt[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("stdtpt", - i__1, "ekqmgr_", (ftnlen)6522)]; - i__1 = col; - for (i__ = 2; i__ <= i__1; ++i__) { - j = lnknxt_(&j, dtpool); - } - -/* Look up the element. */ - - zzekrsi_(&sthan[(i__1 = seg - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("sth" - "an", i__1, "ekqmgr_", (ftnlen)6531)], &stdscs[(i__2 = seg * 24 - - 24) < 4800 && 0 <= i__2 ? i__2 : s_rnge("stdscs", i__2, "ekqmgr_", - (ftnlen)6531)], &dtdscs[(i__3 = j * 11 - 11) < 110000 && 0 <= - i__3 ? i__3 : s_rnge("dtdscs", i__3, "ekqmgr_", (ftnlen)6531)], & - rowidx, elment, idata, null, found); - chkout_("EKGI", (ftnlen)4); - return 0; -} /* ekqmgr_ */ - -/* Subroutine */ int ekqmgr_(integer *cindex, integer *elment, char *eqryc, - doublereal *eqryd, integer *eqryi, char *fname, integer *row, integer - *selidx, char *column, integer *handle, integer *n, char *table, - integer *attdsc, integer *ccount, logical *found, integer *nelt, - integer *nmrows, logical *semerr, char *errmsg, char *cdata, - doublereal *ddata, integer *idata, logical *null, ftnlen eqryc_len, - ftnlen fname_len, ftnlen column_len, ftnlen table_len, ftnlen - errmsg_len, ftnlen cdata_len) -{ - return ekqmgr_0_(0, cindex, elment, eqryc, eqryd, eqryi, fname, row, - selidx, column, handle, n, table, attdsc, ccount, found, nelt, - nmrows, semerr, errmsg, cdata, ddata, idata, null, eqryc_len, - fname_len, column_len, table_len, errmsg_len, cdata_len); - } - -/* Subroutine */ int eklef_(char *fname, integer *handle, ftnlen fname_len) -{ - return ekqmgr_0_(1, (integer *)0, (integer *)0, (char *)0, (doublereal *) - 0, (integer *)0, fname, (integer *)0, (integer *)0, (char *)0, - handle, (integer *)0, (char *)0, (integer *)0, (integer *)0, ( - logical *)0, (integer *)0, (integer *)0, (logical *)0, (char *)0, - (char *)0, (doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, - fname_len, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ekuef_(integer *handle) -{ - return ekqmgr_0_(2, (integer *)0, (integer *)0, (char *)0, (doublereal *) - 0, (integer *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, - handle, (integer *)0, (char *)0, (integer *)0, (integer *)0, ( - logical *)0, (integer *)0, (integer *)0, (logical *)0, (char *)0, - (char *)0, (doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, - (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ekntab_(integer *n) -{ - return ekqmgr_0_(3, (integer *)0, (integer *)0, (char *)0, (doublereal *) - 0, (integer *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, - (integer *)0, n, (char *)0, (integer *)0, (integer *)0, (logical - *)0, (integer *)0, (integer *)0, (logical *)0, (char *)0, (char *) - 0, (doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ektnam_(integer *n, char *table, ftnlen table_len) -{ - return ekqmgr_0_(4, (integer *)0, (integer *)0, (char *)0, (doublereal *) - 0, (integer *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, - (integer *)0, n, table, (integer *)0, (integer *)0, (logical *)0, - (integer *)0, (integer *)0, (logical *)0, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, (ftnint)0, - (ftnint)0, table_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ekccnt_(char *table, integer *ccount, ftnlen table_len) -{ - return ekqmgr_0_(5, (integer *)0, (integer *)0, (char *)0, (doublereal *) - 0, (integer *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, - (integer *)0, (integer *)0, table, (integer *)0, ccount, ( - logical *)0, (integer *)0, (integer *)0, (logical *)0, (char *)0, - (char *)0, (doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, - (ftnint)0, (ftnint)0, table_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ekcii_(char *table, integer *cindex, char *column, - integer *attdsc, ftnlen table_len, ftnlen column_len) -{ - return ekqmgr_0_(6, cindex, (integer *)0, (char *)0, (doublereal *)0, ( - integer *)0, (char *)0, (integer *)0, (integer *)0, column, ( - integer *)0, (integer *)0, table, attdsc, (integer *)0, (logical * - )0, (integer *)0, (integer *)0, (logical *)0, (char *)0, (char *) - 0, (doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, ( - ftnint)0, column_len, table_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int eksrch_(integer *eqryi, char *eqryc, doublereal *eqryd, - integer *nmrows, logical *semerr, char *errmsg, ftnlen eqryc_len, - ftnlen errmsg_len) -{ - return ekqmgr_0_(7, (integer *)0, (integer *)0, eqryc, eqryd, eqryi, ( - char *)0, (integer *)0, (integer *)0, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (integer *)0, (integer *)0, (logical *)0, - (integer *)0, nmrows, semerr, errmsg, (char *)0, (doublereal *)0, - (integer *)0, (logical *)0, eqryc_len, (ftnint)0, (ftnint)0, ( - ftnint)0, errmsg_len, (ftnint)0); - } - -/* Subroutine */ int eknelt_(integer *selidx, integer *row, integer *nelt) -{ - return ekqmgr_0_(8, (integer *)0, (integer *)0, (char *)0, (doublereal *) - 0, (integer *)0, (char *)0, row, selidx, (char *)0, (integer *)0, - (integer *)0, (char *)0, (integer *)0, (integer *)0, (logical *)0, - nelt, (integer *)0, (logical *)0, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (logical *)0, (ftnint)0, (ftnint)0, - (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ekgc_(integer *selidx, integer *row, integer *elment, - char *cdata, logical *null, logical *found, ftnlen cdata_len) -{ - return ekqmgr_0_(9, (integer *)0, elment, (char *)0, (doublereal *)0, ( - integer *)0, (char *)0, row, selidx, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (integer *)0, (integer *)0, found, ( - integer *)0, (integer *)0, (logical *)0, (char *)0, cdata, ( - doublereal *)0, (integer *)0, null, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, cdata_len); - } - -/* Subroutine */ int ekgd_(integer *selidx, integer *row, integer *elment, - doublereal *ddata, logical *null, logical *found) -{ - return ekqmgr_0_(10, (integer *)0, elment, (char *)0, (doublereal *)0, ( - integer *)0, (char *)0, row, selidx, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (integer *)0, (integer *)0, found, ( - integer *)0, (integer *)0, (logical *)0, (char *)0, (char *)0, - ddata, (integer *)0, null, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ekgi_(integer *selidx, integer *row, integer *elment, - integer *idata, logical *null, logical *found) -{ - return ekqmgr_0_(11, (integer *)0, elment, (char *)0, (doublereal *)0, ( - integer *)0, (char *)0, row, selidx, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (integer *)0, (integer *)0, found, ( - integer *)0, (integer *)0, (logical *)0, (char *)0, (char *)0, ( - doublereal *)0, idata, null, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/ekrcec.c b/ext/spice/src/cspice/ekrcec.c deleted file mode 100644 index da8c5611ef..0000000000 --- a/ext/spice/src/cspice/ekrcec.c +++ /dev/null @@ -1,597 +0,0 @@ -/* ekrcec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure EKRCEC ( EK, read column entry element, character ) */ -/* Subroutine */ int ekrcec_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, char *cvals, logical *isnull, ftnlen - column_len, ftnlen cvals_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - zzektrdp_(integer *, integer *, integer *, integer *); - extern integer zzekesiz_(integer *, integer *, integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, cvlen; - logical found; - integer dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrd03_(integer *, - integer *, integer *, integer *, integer *, char *, logical *, - ftnlen), zzekrd06_(integer *, integer *, integer *, integer *, - integer *, integer *, char *, logical *, logical *, ftnlen), - zzekrd09_(integer *, integer *, integer *, integer *, integer *, - char *, logical *, ftnlen); - -/* $ Abstract */ - -/* Read data from a character column in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record from which data is to be read. */ -/* COLUMN I Column name. */ -/* NVALS O Number of values in column entry. */ -/* CVALS O Character values in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* read or write access. */ - -/* SEGNO is the index of the segment from which data is to */ -/* be read. */ - -/* RECNO is the index of the record from which data is to be */ -/* read. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column from which data is to be */ -/* read. */ - - -/* $ Detailed_Output */ - -/* NVALS, */ -/* CVALS are, respectively, the number of values found in */ -/* the specified column entry and the set of values */ -/* themselves. The array CVALS must have sufficient */ -/* string length to accommodate the longest string */ -/* in the returned column entry. */ - -/* For columns having fixed-size entries, when a */ -/* a column entry is null, NVALS is still set to the */ -/* column entry size. For columns having variable- */ -/* size entries, NVALS is set to 1 for null entries. */ - -/* ISNULL is a logical flag indicating whether the returned */ -/* column entry is null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 3) If RECNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 4) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 5) If COLUMN specifies a column of whose data type is not */ -/* character, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 6) If COLUMN specifies a column of whose class is not */ -/* a character class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 7) If an attempt is made to read an uninitialized column entry, */ -/* the error will be diagnosed by routines called by this */ -/* routine. A null entry is considered to be initialized, but */ -/* entries do not contain null values by default. */ - -/* 8) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 9) If any element of the column entry would be truncated when */ -/* assigned to an element of CVALS, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility that allows an EK file to be read */ -/* directly without using the high-level query interface. */ - -/* $ Examples */ - -/* 1) Read the value in the third record of the column CCOL in */ -/* the fifth segment of an EK file designated by HANDLE. */ - -/* CALL EKRCEC ( HANDLE, 5, 3, 'CCOL', N, CVAL, ISNULL ) */ - -/* $ Restrictions */ - -/* 1) EK files open for write access are not necessarily readable. */ -/* In particular, a column entry can be read only if it has been */ -/* initialized. The caller is responsible for determining */ -/* when it is safe to read from files open for write access. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 20-JUN-1999 (WLT) */ - -/* Removed unbalanced call to CHKOUT. */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Bug fix: Record number, not record pointer, is now supplied */ -/* to look up data in the class 9 case. Miscellaneous header */ -/* changes were made as well. Check for string truncation on */ -/* output has been added. */ - -/* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read character data from EK column */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Bug fix: Record number, not record pointer, is now supplied */ -/* to look up data in the class 9 case. For class 9 columns, */ -/* column entry locations are calculated directly from record */ -/* numbers, no indirection is used. */ - -/* Miscellaneous header changes were made as well. */ - -/* The routines */ - -/* ZZEKRD03 */ -/* ZZEKRD06 */ -/* ZZEKRD09 */ - -/* now check for string truncation on output and signal errors */ -/* if truncation occurs. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of character type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - chkin_("EKRCEC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKRCEC only works with character col" - "umns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)95); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKRCEC", (ftnlen)6); - return 0; - } - -/* Now it's time to read data from the file. Call the low-level */ -/* reader appropriate to the column's class. */ - - class__ = coldsc[0]; - if (class__ == 3) { - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - zzekrd03_(handle, segdsc, coldsc, &recptr, &cvlen, cvals, isnull, - cvals_len); - *nvals = 1; - } else if (class__ == 6) { - zzektrdp_(handle, &segdsc[6], recno, &recptr); - *nvals = zzekesiz_(handle, segdsc, coldsc, &recptr); - zzekrd06_(handle, segdsc, coldsc, &recptr, &c__1, nvals, cvals, - isnull, &found, cvals_len); - } else if (class__ == 9) { - -/* Records in class 9 columns are identified by a record number */ -/* rather than a pointer. */ - - zzekrd09_(handle, segdsc, coldsc, recno, &cvlen, cvals, isnull, - cvals_len); - *nvals = 1; - } else { - -/* This is an unsupported character column class. */ - - *segno = segdsc[1]; - chkin_("EKRCEC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported cha" - "racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)115); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKRCEC", (ftnlen)6); - return 0; - } - return 0; -} /* ekrcec_ */ - diff --git a/ext/spice/src/cspice/ekrcec_c.c b/ext/spice/src/cspice/ekrcec_c.c deleted file mode 100644 index 07f2addc13..0000000000 --- a/ext/spice/src/cspice/ekrcec_c.c +++ /dev/null @@ -1,289 +0,0 @@ -/* - --Procedure ekrcec_c ( EK, read column entry element, character ) - --Abstract - - Read data from a character column in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ekrcec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt lenout, - SpiceInt * nvals, - void * cvals, - SpiceBoolean * isnull ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle attached to EK file. - segno I Index of segment containing record. - recno I Record from which data is to be read. - column I Column name. - lenout I Maximum length of output strings. - nvals O Number of values in column entry. - cvals O Character values in column entry. - isnull O Flag indicating whether column entry is null. - --Detailed_Input - - handle is an EK file handle. The file may be open for - read or write access. - - segno is the index of the segment from which data is to - be read. The first segment in the file has index 0. - - recno is the index of the record from which data is to be - read. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column from which data is to be - read. - - lenout is the maximum string length that can be accommodated in - the output array cvals. This length must large enough to - hold the longest element of the specified column entry, - including a null terminator. If the column element contains - strings of length up to n characters, lenout should be set - to n + 1. - - --Detailed_Output - - nvals, - cvals are, respectively, the number of values found in - the specified column entry and the set of values - themselves. The array cvals must have sufficient - string length to accommodate the longest string - in the returned column entry. The calling application - should declare cvals with dimension - - [nelts][lenout] - - where nelts is the maximum number of elements that - occur in any entry of the specified column. - - For columns having fixed-size entries, when a - a column entry is null, nvals is still set to the - column entry size. For columns having variable- - size entries, nvals is set to 1 for null entries. - - isnull is a logical flag indicating whether the returned - column entry is null. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will diagnosed by routines - called by this routine. - - 3) If recno is out of range, the error will diagnosed by routines - called by this routine. - - 4) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 5) If column specifies a column of whose data type is not - character, the error SPICE(WRONGDATATYPE) will be - signaled. - - 6) If column specifies a column of whose class is not - a character class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 7) If an attempt is made to read an uninitialized column entry, - the error will be diagnosed by routines called by this - routine. A null entry is considered to be initialized, but - entries do not contain null values by default. - - 8) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 9) If any element of the column entry would be truncated when - assigned to an element of cvals, the error will be diagnosed - by routines called by this routine. - - 10) If the input column name string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 11) If the input column name string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 12) If the output string pointer cvals is null, the error SPICE(NULLPOINTER) - will be signaled. - - 13) If the output string length indicated by lenout is less than two - characters, it is too short to contain one character of output data - plus a null terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine is a utility that allows an EK file to be read - directly without using the high-level query interface. - --Examples - - 1) Read the value in the third record of the column ccol in - the fifth segment of an EK file designated by handle. - - #include "SpiceUsr.h" - . - . - . - ekrcec_c ( handle, 4, 2, "CCOL", lenout, &nvals, &cval, &isnull ); - --Restrictions - - 1) EK files open for write access are not necessarily readable. - In particular, a column entry can be read only if it has been - initialized. The caller is responsible for determining - when it is safe to read from files open for write access. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 21-MAY-2001 (WLT) - - Added a cast to (char *) in the call to F2C_ConvertStrArr to - support compilation under C++. - - -CSPICE Version 1.0.0, 04-JUL-2000 (NJB) - --Index_Entries - - read character data from EK column - --& -*/ - -{ /* Begin ekrcec_c */ - - - /* - Local variables - */ - logical null; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekrcec_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekrcec_c", column ); - - - /* - Make sure the output array has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "ekrcec_c", cvals, lenout ); - - /* - Map the segment and record numbers to their Fortran-style - values. Pass a flag of type logical to ekrced_. - */ - - segno++; - recno++; - - - ekrcec_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) nvals, - ( char * ) cvals, - ( logical * ) &null, - ( ftnlen ) strlen(column), - ( ftnlen ) lenout-1 ); - - /* - Convert the output array from Fortran to C style. - */ - F2C_ConvertStrArr ( *nvals, lenout, (char *) cvals ); - - - /* - Cast the null flag back to a SpiceBoolean. - */ - *isnull = null; - - - chkout_c ( "ekrcec_c" ); - -} /* End ekrcec_c */ diff --git a/ext/spice/src/cspice/ekrced.c b/ext/spice/src/cspice/ekrced.c deleted file mode 100644 index ba864f9bdf..0000000000 --- a/ext/spice/src/cspice/ekrced.c +++ /dev/null @@ -1,579 +0,0 @@ -/* ekrced.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure EKRCED ( EK, read column entry element, d.p. ) */ -/* Subroutine */ int ekrced_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, doublereal *dvals, logical *isnull, - ftnlen column_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - zzektrdp_(integer *, integer *, integer *, integer *); - extern integer zzekesiz_(integer *, integer *, integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__; - logical found; - integer dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrd02_(integer *, - integer *, integer *, integer *, doublereal *, logical *), - zzekrd05_(integer *, integer *, integer *, integer *, integer *, - integer *, doublereal *, logical *, logical *), zzekrd08_(integer - *, integer *, integer *, integer *, doublereal *, logical *); - -/* $ Abstract */ - -/* Read data from a double precision column in a specified EK */ -/* record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record from which data is to be read. */ -/* COLUMN I Column name. */ -/* NVALS O Number of values in column entry. */ -/* DVALS O D.p. values in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* read or write access. */ - -/* SEGNO is the index of the segment from which data is to */ -/* be read. */ - -/* RECNO is the index of the record from which data is to be */ -/* read. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column from which data is to be */ -/* read. */ - - -/* $ Detailed_Output */ - -/* NVALS, */ -/* DVALS are, respectively, the number of values found in */ -/* the specified column entry and the set of values */ -/* themselves. */ - -/* For columns having fixed-size entries, when a */ -/* a column entry is null, NVALS is still set to the */ -/* column entry size. For columns having variable- */ -/* size entries, NVALS is set to 1 for null entries. */ - -/* ISNULL is a logical flag indicating whether the returned */ -/* column entry is null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 3) If RECNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 4) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 5) If COLUMN specifies a column of whose data type is not */ -/* double precision, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 6) If COLUMN specifies a column of whose class is not */ -/* a double precision class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 7) If an attempt is made to read an uninitialized column entry, */ -/* the error will be diagnosed by routines called by this */ -/* routine. A null entry is considered to be initialized, but */ -/* entries do not contain null values by default. */ - -/* 8) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility that allows an EK file to be read */ -/* directly without using the high-level query interface. */ - -/* $ Examples */ - -/* 1) Read the value in the third record of the column DCOL in */ -/* the fifth segment of an EK file designated by HANDLE. */ - -/* CALL EKRCED ( HANDLE, 5, 3, 'DCOL', N, DVAL, ISNULL ) */ - -/* $ Restrictions */ - -/* 1) EK files open for write access are not necessarily readable. */ -/* In particular, a column entry can be read only if it has been */ -/* initialized. The caller is responsible for determining */ -/* when it is safe to read from files open for write access. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 20-JUN-1999 (WLT) */ - -/* Removed unbalanced call to CHKOUT. */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Bug fix: Record number, not record pointer, is now supplied */ -/* to look up data in the class 8 case. Miscellaneous header */ -/* changes were made as well. */ - -/* - SPICELIB Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read double precision data from EK column */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Bug fix: Record number, not record pointer, is now supplied */ -/* to look up data in the class 8 case. For class 8 columns, */ -/* column entry locations are calculated directly from record */ -/* numbers; no indirection is used. */ - -/* Miscellaneous header changes were made as well. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of d.p. or TIME type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - chkin_("EKRCED", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKRCED only works with d.p. or TIME " - "columns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)99); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKRCED", (ftnlen)6); - return 0; - } - -/* Now it's time to read data from the file. Call the low-level */ -/* reader appropriate to the column's class. */ - - class__ = coldsc[0]; - if (class__ == 2) { - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - zzekrd02_(handle, segdsc, coldsc, &recptr, dvals, isnull); - *nvals = 1; - } else if (class__ == 5) { - zzektrdp_(handle, &segdsc[6], recno, &recptr); - *nvals = zzekesiz_(handle, segdsc, coldsc, &recptr); - zzekrd05_(handle, segdsc, coldsc, &recptr, &c__1, nvals, dvals, - isnull, &found); - } else if (class__ == 8) { - -/* Records in class 8 columns are identified by a record number */ -/* rather than a pointer. */ - - zzekrd08_(handle, segdsc, coldsc, recno, dvals, isnull); - *nvals = 1; - } else { - -/* This is an unsupported d.p. column class. */ - - *segno = segdsc[1]; - chkin_("EKRCED", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported d.p" - ". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen) - 110); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKRCED", (ftnlen)6); - return 0; - } - return 0; -} /* ekrced_ */ - diff --git a/ext/spice/src/cspice/ekrced_c.c b/ext/spice/src/cspice/ekrced_c.c deleted file mode 100644 index 651132f404..0000000000 --- a/ext/spice/src/cspice/ekrced_c.c +++ /dev/null @@ -1,237 +0,0 @@ -/* - --Procedure ekrced_c ( EK, read column entry element, d.p. ) - --Abstract - - Read data from a double precision column in a specified EK - record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ekrced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceDouble * dvals, - SpiceBoolean * isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle attached to EK file. - segno I Index of segment containing record. - recno I Record from which data is to be read. - column I Column name. - nvals O Number of values in column entry. - dvals O D.p. values in column entry. - isnull O Flag indicating whether column entry is null. - --Detailed_Input - - handle is an EK file handle. The file may be open for - read or write access. - - segno is the index of the segment from which data is to - be read. The first segment in the file has index 0. - - recno is the index of the record from which data is to be - read. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column from which data is to be - read. - --Detailed_Output - - nvals, - ivals are, respectively, the number of values found in - the specified column entry and the set of values - themselves. - - For columns having fixed-size entries, when a - a column entry is null, nvals is still set to the - column entry size. For columns having variable- - size entries, nvals is set to 1 for null entries. - - isnull is a logical flag indicating whether the returned - column entry is null. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will diagnosed by routines - called by this routine. - - 3) If recno is out of range, the error will diagnosed by routines - called by this routine. - - 4) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 5) If column specifies a column of whose data type is not - double precision, the error SPICE(WRONGDATATYPE) will be - signaled. - - 6) If column specifies a column of whose class is not a double precision - class known to this routine, the error SPICE(NOCLASS) will be signaled. - - 7) If an attempt is made to read an uninitialized column entry, - the error will be diagnosed by routines called by this - routine. A null entry is considered to be initialized, but - entries do not contain null values by default. - - 8) If an I/O error occurs while reading the indicated file, - the error will be diagnosed by routines called by this - routine. - - 9) If the input column name string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If the input column name string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine is a utility that allows an EK file to be read - directly without using the high-level query interface. - --Examples - - 1) Read the value in the third record of the column DCOL in - the fifth segment of an EK file designated by HANDLE. - - - #include "SpiceUsr.h" - . - . - . - ekrced_c ( handle, 4, 2, "DCOL", &n, &dval, &isnull ); - --Restrictions - - 1) EK files open for write access are not necessarily readable. - In particular, a column entry can be read only if it has been - initialized. The caller is responsible for determining - when it is safe to read from files open for write access. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 04-JUL-2000 (NJB) - --Index_Entries - - read double precision data from EK column - --& -*/ - -{ /* Begin ekrced_c */ - - /* - Local variables - */ - logical null; - - /* - Participate in error tracing. - */ - chkin_c ( "ekrced_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekrced_c", column ); - - - /* - Map the segment and record numbers to their Fortran-style - values. Pass a flag of type logical to ekrced_. - */ - - segno++; - recno++; - - ekrced_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) nvals, - ( doublereal * ) dvals, - ( logical * ) &null, - ( ftnlen ) strlen(column) ); - - /* - Set the output null flag. - */ - - *isnull = null; - - - chkout_c ( "ekrced_c" ); - -} /* End ekrced_c */ diff --git a/ext/spice/src/cspice/ekrcei.c b/ext/spice/src/cspice/ekrcei.c deleted file mode 100644 index 4c86429ae6..0000000000 --- a/ext/spice/src/cspice/ekrcei.c +++ /dev/null @@ -1,578 +0,0 @@ -/* ekrcei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure EKRCEI ( EK, read column entry element, integer ) */ -/* Subroutine */ int ekrcei_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen - column_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), - zzektrdp_(integer *, integer *, integer *, integer *); - extern integer zzekesiz_(integer *, integer *, integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__; - logical found; - integer dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrd01_(integer *, - integer *, integer *, integer *, integer *, logical *), zzekrd04_( - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, logical *, logical *), zzekrd07_(integer *, integer *, - integer *, integer *, integer *, logical *); - -/* $ Abstract */ - -/* Read data from an integer column in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record from which data is to be read. */ -/* COLUMN I Column name. */ -/* NVALS O Number of values in column entry. */ -/* IVALS O Integer values in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* read or write access. */ - -/* SEGNO is the index of the segment from which data is to */ -/* be read. */ - -/* RECNO is the index of the record from which data is to be */ -/* read. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column from which data is to be */ -/* read. */ - - -/* $ Detailed_Output */ - -/* NVALS, */ -/* IVALS are, respectively, the number of values found in */ -/* the specified column entry and the set of values */ -/* themselves. */ - -/* For columns having fixed-size entries, when a */ -/* a column entry is null, NVALS is still set to the */ -/* column entry size. For columns having variable- */ -/* size entries, NVALS is set to 1 for null entries. */ - -/* ISNULL is a logical flag indicating whether the returned */ -/* column entry is null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 3) If RECNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 4) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 5) If COLUMN specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 6) If COLUMN specifies a column of whose class is not */ -/* an integer class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 7) If an attempt is made to read an uninitialized column entry, */ -/* the error will be diagnosed by routines called by this */ -/* routine. A null entry is considered to be initialized, but */ -/* entries do not contain null values by default. */ - -/* 8) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility that allows an EK file to be read */ -/* directly without using the high-level query interface. */ - -/* $ Examples */ - -/* 1) Read the value in the third record of the column ICOL in */ -/* the fifth segment of an EK file designated by HANDLE. */ - -/* CALL EKRCEI ( HANDLE, 5, 3, 'ICOL', N, IVAL, ISNULL ) */ - -/* $ Restrictions */ - -/* 1) EK files open for write access are not necessarily readable. */ -/* In particular, a column entry can be read only if it has been */ -/* initialized. The caller is responsible for determining */ -/* when it is safe to read from files open for write access. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 20-JUN-1999 (WLT) */ - -/* Removed unbalanced call to CHKOUT. */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Bug fix: Record number, not record pointer, is now supplied */ -/* to look up data in the class 7 case. Miscellaneous header */ -/* changes were made as well. */ - -/* - SPICELIB Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read integer data from EK column */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Bug fix: Record number, not record pointer, is now supplied */ -/* to look up data in the class 7 case. For class 7 columns, */ -/* column entry locations are calculated directly from record */ -/* numbers; no indirection is used. */ - -/* Miscellaneous header changes were made as well. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of integer type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - chkin_("EKRCEI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKRCEI only works with integer colum" - "ns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)93); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKRCEI", (ftnlen)6); - return 0; - } - -/* Now it's time to read data from the file. Call the low-level */ -/* reader appropriate to the column's class. */ - - class__ = coldsc[0]; - if (class__ == 1) { - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - zzekrd01_(handle, segdsc, coldsc, &recptr, ivals, isnull); - *nvals = 1; - } else if (class__ == 4) { - zzektrdp_(handle, &segdsc[6], recno, &recptr); - *nvals = zzekesiz_(handle, segdsc, coldsc, &recptr); - zzekrd04_(handle, segdsc, coldsc, &recptr, &c__1, nvals, ivals, - isnull, &found); - } else if (class__ == 7) { - -/* Records in class 7 columns are identified by a record number */ -/* rather than a pointer. */ - - zzekrd07_(handle, segdsc, coldsc, recno, ivals, isnull); - *nvals = 1; - } else { - -/* This is an unsupported integer column class. */ - - *segno = segdsc[1]; - chkin_("EKRCEI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported int" - "eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)113); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKRCEI", (ftnlen)6); - return 0; - } - return 0; -} /* ekrcei_ */ - diff --git a/ext/spice/src/cspice/ekrcei_c.c b/ext/spice/src/cspice/ekrcei_c.c deleted file mode 100644 index ff3d70bd78..0000000000 --- a/ext/spice/src/cspice/ekrcei_c.c +++ /dev/null @@ -1,229 +0,0 @@ -/* - --Procedure ekrcei_c ( EK, read column entry element, integer ) - --Abstract - - Read data from an integer column in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ekrcei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceInt * ivals, - SpiceBoolean * isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle attached to EK file. - segno I Index of segment containing record. - recno I Record from which data is to be read. - column I Column name. - nvals O Number of values in column entry. - ivals O Integer values in column entry. - isnull O Flag indicating whether column entry is null. - --Detailed_Input - - handle is an EK file handle. The file may be open for - read or write access. - - segno is the index of the segment from which data is to - be read. The first segment in the file has index 0. - - recno is the index of the record from which data is to be - read. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column from which data is to be - read. - - --Detailed_Output - - nvals, - ivals are, respectively, the number of values found in - the specified column entry and the set of values - themselves. - - For columns having fixed-size entries, when a - a column entry is null, nvals is still set to the - column entry size. For columns having variable- - size entries, nvals is set to 1 for null entries. - - isnull is a logical flag indicating whether the returned - column entry is null. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will diagnosed by routines - called by this routine. - - 3) If recno is out of range, the error will diagnosed by routines - called by this routine. - - 4) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 5) If column specifies a column of whose data type is not - integer, the error SPICE(WRONGDATATYPE) will be - signaled. - - 6) If column specifies a column of whose class is not - an integer class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 7) If an attempt is made to read an uninitialized column entry, - the error will be diagnosed by routines called by this - routine. A null entry is considered to be initialized, but - entries do not contain null values by default. - - 8) If an I/O error occurs while reading the indicated file, - the error will be diagnosed by routines called by this - routine. - - 9) If the input column name string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If the input column name string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine is a utility that allows an EK file to be read - directly without using the high-level query interface. - --Examples - - 1) Read the value in the third record of the column ICOL in - the fifth segment of an EK file designated by handle. - - #include "SpiceUsr.h" - . - . - . - ekrcei_c ( handle, 4, 2, "ICOL", &n, &ival, &isnull ); - --Restrictions - - 1) EK files open for write access are not necessarily readable. - In particular, a column entry can be read only if it has been - initialized. The caller is responsible for determining - when it is safe to read from files open for write access. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 04-JUL-2000 (NJB) - --Index_Entries - - read integer data from EK column - --& -*/ - -{ /* Begin ekrcei_c */ - - /* - Local variables - */ - logical null; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekrcei_c" ); - - /* - Map the segment and record numbers to their Fortran-style - values. Pass a flag of type logical to ekrcei_. - */ - - segno++; - recno++; - - ekrcei_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) nvals, - ( integer * ) ivals, - ( logical * ) &null, - ( ftnlen ) strlen(column) ); - - /* - Set the output null flag. - */ - - *isnull = null; - - chkout_c ( "ekrcei_c" ); - -} /* End ekrcei_c */ diff --git a/ext/spice/src/cspice/ekshdw.c b/ext/spice/src/cspice/ekshdw.c deleted file mode 100644 index d0dd790970..0000000000 --- a/ext/spice/src/cspice/ekshdw.c +++ /dev/null @@ -1,125 +0,0 @@ -/* ekshdw.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKSHDW ( EK, return shadowing status ) */ -/* Subroutine */ int ekshdw_(integer *handle, logical *isshad) -{ - integer i__; - -/* $ Abstract */ - -/* Return shadowing status of a specified EK file. THIS IS A */ -/* STUB ROUTINE. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* ISSHAD O Logical flag indicating whether EK is shadowed. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an EK open for writing. */ - -/* $ Detailed_Output */ - -/* ISSHAD is a logical flag that is returned .TRUE. if and */ -/* only if the EK file designated by HANDLE is */ -/* shadowed. */ - -/* In this stub version of the routine, ISSHAD is */ -/* always returned .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) It is not an error to supply an input handle that does not */ -/* belong to an EK that is open for write access. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility that allows a program to test the */ -/* shadowing status of a specified EK file. */ - -/* $ Examples */ - -/* See the $Examples section of the umbrella routine EKSHAD. */ - -/* $ Restrictions */ - -/* 1) This is a stub routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return shadowing status of an EK file */ - -/* -& */ - i__ = *handle; - *isshad = FALSE_; - return 0; -} /* ekshdw_ */ - diff --git a/ext/spice/src/cspice/ekssum.c b/ext/spice/src/cspice/ekssum.c deleted file mode 100644 index 864ff60e9a..0000000000 --- a/ext/spice/src/cspice/ekssum.c +++ /dev/null @@ -1,722 +0,0 @@ -/* ekssum.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKSSUM ( EK, return segment summary ) */ -/* Subroutine */ int ekssum_(integer *handle, integer *segno, char *tabnam, - integer *nrows, integer *ncols, char *cnames, char *dtypes, integer * - sizes, integer *strlns, logical *indexd, logical *nullok, ftnlen - tabnam_len, ftnlen cnames_len, ftnlen dtypes_len) -{ - /* Initialized data */ - - static char typstr[4*4] = "CHR " "DP " "INT " "TIME"; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzeksinf_(integer *, integer *, char *, - integer *, char *, integer *, ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - integer segdsc[24], cdscrs[1100] /* was [11][100] */; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* Return summary information for a specified segment in a */ -/* specified EK. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of EK. */ -/* SEGNO I Number of segment to be summarized. */ -/* TABNAM O Name of table containing segment. */ -/* NROWS O Number of rows in segment. */ -/* NCOLS O Number of columns in segment. */ -/* CNAMES O Names of columns in segment. */ -/* DTYPES O Data types of columns in segment. */ -/* SIZES O Entry sizes of columns in segment. */ -/* STRLNS O String lengths of columns in segment. */ -/* INDEXD O Flags indicating whether columns are indexed. */ -/* NULLOK O Flags indicating whether columns allow nulls. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle specifying the EK containing */ -/* the segment to be summarized. */ - -/* SEGNO is the number of the segment whose summary is */ -/* desired. Segments are numbered from 1 to NSEG, */ -/* where NSEG is the count of segments in the file. */ - -/* $ Detailed_Output */ - -/* TABNAM is the name of the table to which the segment */ -/* belongs. */ - -/* NROWS is the number of rows in the segment. */ - -/* NCOLS is the number of columns in the segment. The */ -/* maximum number of columns in a segment is given */ -/* by the parameter MXCLSG, which is defined in the */ -/* include file */ - -/* ekglimit.inc. */ - -/* Currently, this limit is set at 100 columns. */ - -/* CNAMES is an array of names of columns in the segment. */ - -/* DTYPES is an array of data types of columns in the */ -/* segment. Each data type is indicated by a short */ -/* character string. The strings and their meanings */ -/* are: */ - -/* 'CHR' Character type. */ -/* 'DP' Double precision type. */ -/* 'INT' Integer type. */ -/* 'TIME' Time type. */ - -/* The Ith element of DTYPES corresponds to the */ -/* column whose name is the Ith element of CNAMES. */ - -/* SIZES is an array of declared sizes of column entries. */ -/* The Ith element of SIZES is the declared size of */ -/* the column whose name is the Ith element of CNAMES. */ -/* Scalar-valued columns have size 1; fixed-size, */ -/* array-valued columns have size greater than 1. */ -/* Array valued columns of variable size have a size */ -/* value of -1. */ - -/* STRLNS is an array of declared string lengths of */ -/* character column entries. These lengths are */ -/* defined only for columns of character type. */ -/* The Ith element of SIZES is the declared size of */ -/* the column whose name is the Ith element of CNAMES, */ -/* if that column has character type; otherwise, the */ -/* Ith element of STRLNS is undefined. For */ -/* character columns having variable string length, */ -/* the returned value of STRLNS is -1. */ - -/* INDEXD is an array of logical flags indicating whether the */ -/* corresponding columns are indexed. The Ith element */ -/* of INDEXD applies to the column whose name is the */ -/* Ith element of CNAMES. */ - -/* NULLOK is an array of logical flags indicating whether the */ -/* corresponding columns allow null values. The Ith */ -/* element of NULLOK applies to the column whose name */ -/* is the Ith element of CNAMES. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The output arguments will not be */ -/* modified. */ - -/* 2) If SEGNO is not the index of an existing segment in the */ -/* specified file, the error SPICE(INDEXOUTOFRANGE) will be */ -/* signalled. The output arguments will not be modified. */ - -/* 3) If an I/O error occurs while attempting to obtain summary */ -/* information for the specified segment, the error will be */ -/* diagnosed by routines called by this routine. The output */ -/* arguments may be modified in this case. */ - -/* $ Files */ - -/* See the description of HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine supports the function of summarizing a binary */ -/* EK file, allowing NAIF Toolkit users to determine whether it */ -/* contains data of interest. The routine also also provides */ -/* address information necessary to retrieve information from the */ -/* segment. */ - -/* $ Examples */ - -/* 1) Dump the table and column names of the segments in an EK. */ - -/* C */ -/* C Open the EK for read access and get the number of */ -/* C segments it contains. */ -/* C */ -/* CALL EKOPR ( EKNAME, HANDLE ) */ - -/* NSEG = EKNSEG ( HANDLE ) */ - -/* C */ -/* C Loop through the segments, dumping the desired */ -/* C summary information for each one. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Segment summary for file ', EKNAME */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' ' */ - -/* DO I = 1, NSEG */ - -/* CALL EKSSUM ( HANDLE, SEGNO, TABNAM, NROWS, */ -/* . NCOLS, CNAMES, DTYPES, SIZES, */ -/* . STRLNS, INDEXD, NULLOK ) */ - -/* WRITE (*,*) */ -/* . '========================================' // */ -/* . '========================================' */ - - -/* WRITE (*,*) 'Table containing segment: ', TABNAM */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Number of rows: ', NROWS */ -/* WRITE (*,*) 'Number of columns: ', NCOLS */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Column names and attributes: ' */ -/* WRITE (*,*) ' ' */ - -/* DO J = 1, NCOLS */ - -/* WRITE (*,*) 'Column: '//CNAMES(J) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Data type: ', DTYPES(J) */ -/* WRITE (*,*) 'Dimension: ', SIZES(J) */ - -/* IF ( DTYPES(J) .EQ. 'CHR' ) THEN */ -/* WRITE (*,*) 'String length: ', STRLNS(J) */ -/* END IF */ - -/* IF ( INDEXD(J) ) THEN */ -/* WRITE (*,*) 'Indexed' */ -/* END IF */ - -/* IF ( NULLOK(J) ) THEN */ -/* WRITE (*,*) 'Nulls allowed' */ -/* ELSE */ -/* WRITE (*,*) 'Nulls not allowed' */ -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* END DO */ - -/* WRITE (*,*) */ -/* . '========================================' // */ -/* . '========================================' */ - -/* END DO */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Bug fix: correct parameter is now used to set dimension */ -/* of local variable SEGDSC. */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return EK segment summary */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-JUL-1996 (NJB) */ - -/* Bug fix: correct parameter SDSCSZ is now used to set dimension */ -/* of local variable SEGDSC. Previously, the parameter */ -/* CDSCSZ had been used. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EKSSUM", (ftnlen)6); - } - -/* Get the info from a knowledgeable source. */ - - zzeksinf_(handle, segno, tabnam, segdsc, cnames, cdscrs, tabnam_len, - cnames_len); - if (failed_()) { - chkout_("EKSSUM", (ftnlen)6); - return 0; - } - *nrows = segdsc[5]; - *ncols = segdsc[4]; - i__1 = *ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(dtypes + (i__ - 1) * dtypes_len, typstr + (((i__3 = cdscrs[( - i__2 = i__ * 11 - 10) < 1100 && 0 <= i__2 ? i__2 : s_rnge( - "cdscrs", i__2, "ekssum_", (ftnlen)355)] - 1) < 4 && 0 <= - i__3 ? i__3 : s_rnge("typstr", i__3, "ekssum_", (ftnlen)355)) - << 2), dtypes_len, (ftnlen)4); - sizes[i__ - 1] = cdscrs[(i__2 = i__ * 11 - 8) < 1100 && 0 <= i__2 ? - i__2 : s_rnge("cdscrs", i__2, "ekssum_", (ftnlen)357)]; - if (cdscrs[(i__2 = i__ * 11 - 10) < 1100 && 0 <= i__2 ? i__2 : s_rnge( - "cdscrs", i__2, "ekssum_", (ftnlen)359)] == 1) { - strlns[i__ - 1] = cdscrs[(i__2 = i__ * 11 - 9) < 1100 && 0 <= - i__2 ? i__2 : s_rnge("cdscrs", i__2, "ekssum_", (ftnlen) - 360)]; - } else { - strlns[i__ - 1] = 0; - } - indexd[i__ - 1] = cdscrs[(i__2 = i__ * 11 - 6) < 1100 && 0 <= i__2 ? - i__2 : s_rnge("cdscrs", i__2, "ekssum_", (ftnlen)365)] != -1; - nullok[i__ - 1] = cdscrs[(i__2 = i__ * 11 - 4) < 1100 && 0 <= i__2 ? - i__2 : s_rnge("cdscrs", i__2, "ekssum_", (ftnlen)366)] != -1; - } - chkout_("EKSSUM", (ftnlen)6); - return 0; -} /* ekssum_ */ - diff --git a/ext/spice/src/cspice/ekssum_c.c b/ext/spice/src/cspice/ekssum_c.c deleted file mode 100644 index f9cc534287..0000000000 --- a/ext/spice/src/cspice/ekssum_c.c +++ /dev/null @@ -1,446 +0,0 @@ -/* - --Procedure ekssum_c ( EK, return segment summary ) - --Abstract - - Return summary information for a specified segment in a - specified EK. - --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 - - EK - --Keywords - - EK - UTILITY - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ekssum_c ( SpiceInt handle, - SpiceInt segno, - SpiceEKSegSum * segsum ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of EK. - segno I Number of segment to be summarized. - segsum O EK segment summary. - --Detailed_Input - - handle is an EK file handle specifying the EK containing - the segment to be summarized. - - segno is the number of the segment whose summary is - desired. Segments are numbered from 0 to nseg-1, - where nseg is the count of segments in the file. - --Detailed_Output - - - segsum is a pointer to an EK segment summary. The summary is - of type EKSegSum. The structure contains the - following members: - - tabnam The name of the table to which the - segment belongs. - - nrows The number of rows in the segment. - - ncols The number of columns in the segment. - - cnames An array of names of columns in the - segment. Column names may contain - as many as SPICE_EK_CNAMSZ characters. - The array contains room for - SPICE_EK_MXCLSG column names. - - cdescrs An array of column attribute - descriptors of type SpiceEKAttDsc. - The array contains room for - SPICE_EK_MXCLSG descriptors. The Ith - descriptor corresponds to the column - whose name is the Ith element of the - array cnames. - - - The column attribute descriptors have the following - members: - - cclass: Column class code. - - dtype: Data type code: has type - SpiceEKDataType. - - strlen: String length. Applies to SPICE_CHR - type. Value is SPICE_EK_VARSIZ for - variable-length strings. - - size: Column entry size; this is the number - of array elements in a column entry. - The value is SPICE_EK_VARSIZ for - variable-size columns. - - indexd: Index flag; value is SPICETRUE if the - column is indexed, SPICEFALSE - otherwise. - - nullok: Null flag; value is SPICETRUE if the - column may contain null values, - SPICEFALSE otherwise. - --Parameters - - See the Restrictions section. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. The output arguments will not be - modified. - - 2) If segno is not the index of an existing segment in the - specified file, the error SPICE(INDEXOUTOFRANGE) will be - signalled. The output arguments will not be modified. - - 3) If an I/O error occurs while attempting to obtain summary - information for the specified segment, the error will be - diagnosed by routines called by this routine. The output - arguments may be modified in this case. - --Files - - This routine provides summary information for segments belonging - to a binary EK file. - --Particulars - - This routine supports the function of summarizing a binary - EK file, allowing NAIF Toolkit users to determine whether it - contains data of interest. - --Examples - - 1) Dump the attributes of the segments in a specified EK. - - - #include "SpiceUsr.h" - #include - - void main() - { - - SpiceChar * ek; - static SpiceChar chrTypes [4][5] = { "CHR", - "DP", - "INT", - "TIME" }; - SpiceEKSegSum segsum; - - SpiceInt handle; - SpiceInt i; - SpiceInt nseg; - SpiceInt segno; - - - - ek = prompt_c ( "Enter name of EK file > " ); - - /. - Open the EK for read access and get the number of - segments it contains. - ./ - ekopr_c ( ek, &handle ); - - nseg = eknseg_c ( handle ); - - /. - Loop through the segments, dumping the desired - summary information for each one. - ./ - printf ( "\n" - "\n" - "Segment summary for file %s\n" - "\n" - "\n", - ek ); - - for ( segno = 0; segno < nseg; segno++ ) - { - - ekssum_c ( handle, segno, &segsum ); - - - printf ( "========================================" - "========================================" - "\n" - "Table containing segment: %s\n" - "\n" - "Number of rows: %d\n" - "Number of columns: %d\n" - "\n" - "Column names and attributes: \n" - "\n", - segsum.tabnam, - segsum.nrows, - segsum.ncols ); - - - for ( i = 0; i < segsum.ncols; i++ ) - { - - printf ( "\n" - "Column: %s\n" - "\n" - "Data type: %s\n", - segsum.cnames[i], - chrTypes[ segsum.cdescrs[i].dtype ] ); - - - if ( segsum.cdescrs[i].size >= 0 ) - { - printf ( "Dimension: %d\n", - segsum.cdescrs[i].size ); - } - else - { - printf ( "Dimension: Variable\n" ); - } - - - if ( segsum.cdescrs[i].dtype == SPICE_CHR ) - { - if ( segsum.cdescrs[i].strlen >= 0 ) - { - printf ( "String length: %d\n", - segsum.cdescrs[i].strlen ); - } - else - { - printf ( "String length: Variable\n" ); - } - } - - - if ( segsum.cdescrs[i].indexd ) - { - printf ( "Indexed\n" ); - } - - - if ( segsum.cdescrs[i].nullok ) - { - printf ( "Nulls allowed\n" ); - } - - printf ( "\n" ); - - } - - printf ( "\n" - "========================================" - "========================================" - "\n" ); - } - } - - --Restrictions - - Many parameters used internally in this routine are from the - Fortran SPICELIB include files ekcoldsc.inc and eksegdsc.inc. - The parameters used in this routine must be kept in sync with - those used in SPICELIB. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 12-JUL-1999 (NJB) - - Now calls zzeksinf_ instead of ekssum_ to get summary - information. This enables retrieval of column classes and - simplifies the code as well. - - Changed arrays of SpiceBoolean flags passed to ekssum_ to - data type logical. Changed name of "class" member of structure - SpiceEKSegSum to "cclass." The name "class" is a C++ keyword - and prevented clean integration into C++ code. - - -CSPICE Version 1.0.0, 17-FEB-1999 (NJB) - --Index_Entries - - return EK segment summary - --& -*/ - -{ /* Begin ekssum_c */ - - /* - Local constants - */ - #define NTYPES 4 - #define CTYPELEN 5 - #define CDSCSZ 11 - #define SDSCSZ 24 - #define NCIDX 4 - #define NRIDX ( NCIDX + 1 ) - #define CLSIDX 0 - #define TYPIDX ( CLSIDX + 1 ) - #define LENIDX ( TYPIDX + 1 ) - #define SIZIDX ( LENIDX + 1 ) - #define IXTIDX 5 - #define NULIDX ( IXTIDX + 2 ) - - - /* - Local variables - */ - SpiceInt cdescrs [SPICE_EK_MXCLSG][CDSCSZ]; - SpiceInt segdsc [SDSCSZ]; - SpiceInt i; - - - - /* - Participate in error tracing. - */ - chkin_c ( "ekssum_c" ); - - - /* - Convert the segment number to a Fortran-style index. - */ - segno ++; - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - - We have a special case here: the Fortran routine has an output - string array for the column data types. Since the corresponding - member of the segment summary uses an array of the enumerated type - SpiceEKDataType, we must capture the output array, convert it to - a C array, and map the elements to values of this type. - */ - - zzeksinf_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( char * ) segsum->tabnam, - ( integer * ) segdsc, - ( char * ) segsum->cnames, - ( integer * ) cdescrs, - ( ftnlen ) SPICE_EK_TNAMSZ, - ( ftnlen ) SPICE_EK_CNAMSZ ); - - - if ( failed_c() ) - { - chkout_c ( "ekssum_c" ); - return; - } - - /* - Fill in the segment summary values that are not contained in column - descriptors. These are: - - - table name - - number of rows - - number of columns - - array of column names - - */ - - F2C_ConvertStr ( SPICE_EK_TSTRLN, segsum->tabnam ); - - segsum->nrows = segdsc[NRIDX]; - segsum->ncols = segdsc[NCIDX]; - - F2C_ConvertTrStrArr ( segsum -> ncols, - SPICE_EK_CSTRLN, - ( SpiceChar * ) (segsum->cnames) ); - - - /* - Fill the column attribute descriptors. - */ - for ( i = 0; i < segsum->ncols; i++ ) - { - segsum -> cdescrs[i].cclass = cdescrs[i][CLSIDX]; - segsum -> cdescrs[i].size = cdescrs[i][SIZIDX]; - segsum -> cdescrs[i].strlen = cdescrs[i][LENIDX]; - segsum -> cdescrs[i].indexd = cdescrs[i][IXTIDX] >= 0; - segsum -> cdescrs[i].nullok = cdescrs[i][NULIDX] >= 0; - } - - - /* - Convert the Fortran-style string tabnam to a C-style string. - */ - F2C_ConvertStr ( SPICE_EK_TSTRLN, segsum->tabnam ); - - - /* - Convert the Fortran-style string array cnames to a C-style string - array. - */ - - - /* - Assign the segsum->cdescrs member dtype using the data type codes - from the cdescrs array. - */ - for ( i = 0; i < segsum->ncols; i++ ) - { - segsum->cdescrs[i].dtype = (SpiceEKDataType) - ( cdescrs[i][TYPIDX] - 1 ); - } - - - chkout_c ( "ekssum_c" ); - -} /* End ekssum_c */ - diff --git a/ext/spice/src/cspice/ektnam_c.c b/ext/spice/src/cspice/ektnam_c.c deleted file mode 100644 index 634c5202f3..0000000000 --- a/ext/spice/src/cspice/ektnam_c.c +++ /dev/null @@ -1,198 +0,0 @@ -/* - --Procedure ektnam_c ( EK, return name of loaded table ) - --Abstract - - Return the name of a specified, loaded table. - --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 - - EK - --Keywords - - EK - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ektnam_c ( SpiceInt n, - SpiceInt lenout, - SpiceChar * table ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - n I Index of table. - lenout I Maximum table name length. - table O Name of table. - --Detailed_Input - - n is the index of the table whose name is desired. - The value of n ranges from 0 to one less than the - number of loaded tables. - - lenout is the maximum allowed table name length, including - space for the terminating null character. Normally - the caller should allow enough room for - SPICE_EK_TSTRLN characters; this parameter is - declared in the header SpiceEK.h. - --Detailed_Output - - table is the name of the nth loaded table. If table - is too small to accommodate the name, the name will - be truncated on the right. - --Parameters - - None. - --Exceptions - - 1) If this routine is called when no files are loaded, the - error SPICE(NOLOADEDFILES) is signaled. - - 2) If the input n is out of range, the error SPICE(INVALDINDEX) - is signaled. - - 3) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 4) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - - 5) If the length of table (indicated by lenout) is at least two - characters but not large enough to contain the output string, - the output string will be truncated on the right. - --Files - - The returned name is based on the currently loaded EK files. - --Particulars - - This routine is a utility that provides the caller with the - name of a specified loaded table. The index of a table with - a given name depends on the kernels loaded and possibly on - the order in which the files have been loaded. - --Examples - - 1) Dump the names of the loaded tables. - - #include "SpiceUsr.h" - . - . - . - ekntab_c ( &n ); - - for ( i = 0; i < n; i++ ) - { - ektnam_c ( i, table ); - printf ( "%s\n", table ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 26-MAR-2003 (NJB) - - Fixed description of exception (5): replaced "lenout-1" - with "lenout." Removed spurious word "clock" from string - description. - - -CSPICE Version 1.0.0, 07-JAN-2002 (NJB) - --Index_Entries - - return name of a loaded table - --& -*/ - -{ /* Begin ektnam_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ektnam_c" ); - - - /* - Make sure the output table has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "ektnam_c", table, lenout ); - - /* - Map the table index to a Fortran-style index. - */ - n++; - - ektnam_ ( ( integer * ) &n, - ( char * ) table, - ( ftnlen ) lenout-1 ); - - /* - Convert the Fortran string to a C string by placing a null - after the last non-blank character. This operation is valid - whether or not the CSPICE routine signaled an error. - */ - F2C_ConvertStr ( lenout, table ); - - - chkout_c ( "ektnam_c" ); - -} /* End ektnam_c */ diff --git a/ext/spice/src/cspice/ekucec.c b/ext/spice/src/cspice/ekucec.c deleted file mode 100644 index c71daea49f..0000000000 --- a/ext/spice/src/cspice/ekucec.c +++ /dev/null @@ -1,600 +0,0 @@ -/* ekucec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKUCEC ( EK, update d.p. column entry ) */ -/* Subroutine */ int ekucec_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, char *cvals, logical *isnull, ftnlen - column_len, ftnlen cvals_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzekrbck_(char *, integer *, integer *, - integer *, integer *, ftnlen), zzeksdsc_(integer *, integer *, - integer *), zzektrdp_(integer *, integer *, integer *, integer *), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - logical isshad; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), ekshdw_(integer *, - logical *), zzekue03_(integer *, integer *, integer *, integer *, - char *, logical *, ftnlen), zzekue06_(integer *, integer *, - integer *, integer *, integer *, char *, logical *, ftnlen); - -/* $ Abstract */ - -/* Update a character column entry in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record in which entry is to be updated. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values in in new column entry. */ -/* CVALS I Character string values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle attached to an EK open for */ -/* write access. */ - -/* SEGNO is the index of the segment containing the column */ -/* entry to be updated. */ - -/* RECNO is the index of the record containing the column */ -/* entry to be updated. This record number is */ -/* relative to the start of the segment indicated by */ -/* SEGNO; the first record in the segment has index 1. */ - -/* COLUMN is the name of the column containing the entry to */ -/* be updated. */ - -/* NVALS, */ -/* CVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written in to the */ -/* specifed column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* For columns with variable-sized entries, the size */ -/* of the new entry need not match the size of the */ -/* entry it replaces. In particular, the new entry */ -/* may be larger. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and CVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and CVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* The new entry may be null even though it replaces */ -/* a non-null value, and vice versa. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 3) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 4) If COLUMN specifies a column of whose data type is not */ -/* CHARACTER, the error SPICE(WRONGDATATYPE) will */ -/* be signalled. */ - -/* 5) If RECNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 6) If the specified column has fixed-size entries and NVALS */ -/* does not match this size, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 7) If the specified column has variable-size entries and NVALS */ -/* is non-positive, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 8) If an attempt is made to add a null value to a column that */ -/* doesn't take null values, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 9) If COLUMN specifies a column of whose class is not */ -/* a character class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified record in the specified */ -/* column. Data may be added to a segment in random order; it is not */ -/* necessary to fill in columns or rows sequentially. Data may only */ -/* be added one logical element at a time. Partial assignments of */ -/* logical elements are not supported. */ - -/* Since columns of data type TIME are implemented using double */ -/* precision column classes, this routine may be used to update */ -/* columns of type TIME. */ - -/* $ Examples */ - -/* 1) Replace the value in the third record of the column CCOL in */ -/* the fifth segment of an EK file designated by HANDLE. Set */ -/* the new value to '999'. */ - -/* CALL EKUCEC ( HANDLE, 5, 3, 'CCOL', 1, '999', .FALSE. ) */ - - -/* 2) Same as (1), but this time add a null value. The argument */ -/* '999' is ignored because the null flag is set to .TRUE. */ - -/* CALL EKUCEC ( HANDLE, 5, 3, 'CCOL', 1, '999', .TRUE. ) */ - - -/* 3) Replace the entry in the third record of the column CARRAY in */ -/* the fifth segment of an EK file designated by HANDLE. Set */ -/* the new value using an array CBUFF of 10 string values. */ - -/* CALL EKUCEC ( HANDLE, 5, 3, 'CARRAY', 10, CBUFF, .FALSE. ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 20-JUN-1999 (WLT) */ - -/* Removed unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace character entry in an EK column */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of character type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - chkin_("EKUCEC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKUCEC only works with character col" - "umns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)95); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKUCEC", (ftnlen)6); - return 0; - } - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - -/* Determine whether the EK is shadowed. */ - - ekshdw_(handle, &isshad); - -/* If the EK is shadowed, we must back up the current column entry */ -/* if the entry has not already been backed up. ZZEKRBCK will */ -/* handle this task. */ - - if (isshad) { - zzekrbck_("UPDATE", handle, segdsc, coldsc, recno, (ftnlen)6); - } - -/* Now it's time to carry out the replacement. */ - - class__ = coldsc[0]; - if (class__ == 3) { - -/* Class 3 columns contain scalar character data. */ - - zzekue03_(handle, segdsc, coldsc, &recptr, cvals, isnull, cvals_len); - } else if (class__ == 6) { - -/* Class 6 columns contain array-valued character data. */ - - zzekue06_(handle, segdsc, coldsc, &recptr, nvals, cvals, isnull, - cvals_len); - } else { - -/* This is an unsupported character column class. */ - - *segno = segdsc[1]; - chkin_("EKUCEC", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported cha" - "racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)115); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKUCEC", (ftnlen)6); - return 0; - } - return 0; -} /* ekucec_ */ - diff --git a/ext/spice/src/cspice/ekucec_c.c b/ext/spice/src/cspice/ekucec_c.c deleted file mode 100644 index c0e6f9a876..0000000000 --- a/ext/spice/src/cspice/ekucec_c.c +++ /dev/null @@ -1,357 +0,0 @@ -/* - --Procedure ekucec_c ( EK, update character column entry ) - --Abstract - - Update a character column entry in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekucec_c - - - void ekucec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I EK file handle. - segno I Index of segment containing record. - recno I Record to which data is to be updated. - column I Column name. - nvals I Number of values in new column entry. - vallen I Declared length of character values. - cvals I Character values comprising new column entry. - isnull I Flag indicating whether column entry is null. - --Detailed_Input - - handle is the handle of an EK file open for write access. - - segno is the index of the segment containing the column entry - to be updated. EK segment numbers range from - 0 to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record containing the column entry - to be updated. This record number is relative to the start - of the segment indicated by segno; the first - record in the segment has index 0. - - column is the name of the column containing the entry to - be updated. - - nvals is the number of elements in the new value to be inserted - into the specified column. - - vallen is the length of the strings in the cvals array, where - the length includes space for null terminators. - - If the column has fixed-size entries, then nvals - must equal the entry size for the specified column. - - - cvals is the set of replacement values themselves. The values are - written into the specified column and record. - - The array cvals should be declared with dimensions - - [nelts][vallen] - - where nelts is greater than or equal to nvals. - - isnull is a logical flag indicating whether the entry is - null. If isnull is SPICEFALSE, the column entry - defined by nvals and cvals is added to the - specified kernel file. - - If isnull is SPICETRUE, nvals and cvals are ignored: - no data are written into the specified column entry. - The column entry is marked as a null value. - - If the column has fixed-length, variable-size - entries, the number of entries is considered to - be 1. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will be diagnosed by - routines called by this routine. - - 3) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 4) If column specifies a column of whose data type is not - character, the error SPICE(WRONGDATATYPE) will be - signaled. - - 5) If recno is out of range, the error will be diagnosed by - routines called by this routine. - - 6) If the specified column has fixed-size entries and nvals - does not match this size, the error will be diagnosed by - routines called by this routine. - - 7) If the specified column has variable-size entries and nvals - is non-positive, the error will be diagnosed by routines - called by this routine. - - 8) If an attempt is made to add a null value to a column that - doesn't take null values, the error will be diagnosed by - routines called by this routine. - - 9) If column specifies a column of whose class is not - a character class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 11) If the input string pointer for the column name is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If the input string column name has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 13) If the string pointer for cvals is null, the error - SPICE(NULLPOINTER) will be signaled. - - 14) If the string length vallen is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by replacing a specified character column entry. - --Examples - - 1) Replace the value in the third record of the column CCOL in - the fifth segment of an EK file designated by handle. Set - the new value to "999". - - #include "SpiceUsr.h" - . - . - . - ekucec_c ( handle, 4, 2, "CCOL", 1, 4, "999", SPICEFALSE ); - - - 2) Same as (1), but this time insert a null value. The argument - "999" is ignored because the null flag is set to SPICETRUE - - #include "SpiceUsr.h" - . - . - . - ekucec_c ( handle, 4, 2, "CCOL", 1, 4, "999", SPICETRUE ); - - - 3) Replace the entry in the third record of the column CARRAY in - the fifth segment of an EK file designated by handle. Set - the new value using an array cbuff of 10 string values. - We assume cbuff was declared as shown: - - SpiceChar cbuff[10][CBLEN]; - - - - #include "SpiceUsr.h" - . - . - . - ekucec_c ( handle, 4, 2, "CARRAY", - 10, CBLEN, cbuff, SPICEFALSE ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - replace character entry in an EK column - --& -*/ - -{ /* Begin ekucec_c */ - - - /* - Local variables - */ - logical null; - - SpiceChar ** cvalsPtr; - SpiceChar * fCvalsArr; - - SpiceInt i; - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekucec_c" ); - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekucec_c", column ); - - /* - Check the value array to make sure the pointer is non-null - and the string length is non-zero. Note: this check is normally - done for output strings: CHKOSTR is the macro that does the job. - */ - CHKOSTR ( CHK_STANDARD, "ekucec_c", cvals, vallen ); - - /* - We need to make a blank-padded version of the cvals array. - We'll first allocate an array of character pointers to index - the values, initialize this array, and use it to produce - a dynamically allocated array of Fortran-style strings. - */ - cvalsPtr = ( SpiceChar ** ) malloc ( nvals * sizeof(SpiceChar *) ); - - if ( cvalsPtr == 0 ) - { - setmsg_c ( "Failure on malloc call to create pointer array " - "for column values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "ekucec_c" ); - return; - } - - for ( i = 0; i < nvals; i++ ) - { - cvalsPtr[i] = (SpiceChar *)cvals + ( i * vallen ); - } - - C2F_CreateFixStrArr ( nvals, - vallen, - ( ConstSpiceChar ** ) cvalsPtr, - &fCvalsLen, - &fCvalsArr ); - - if ( failed_c() ) - { - free ( cvalsPtr ); - - chkout_c ( "ekucec_c" ); - return; - } - - /* - Map the segment and record numbers to the Fortran range. Get a - local logical variable to represent the null flag. - */ - segno++; - recno++; - - null = isnull; - - ekucec_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) &nvals, - ( char * ) fCvalsArr, - ( logical * ) &null, - ( ftnlen ) strlen(column), - ( ftnlen ) fCvalsLen ); - - - /* - Clean up our dynamically allocated arrays. - */ - free ( cvalsPtr ); - free ( fCvalsArr ); - - - chkout_c ( "ekucec_c" ); - -} /* End ekucec_c */ diff --git a/ext/spice/src/cspice/ekuced.c b/ext/spice/src/cspice/ekuced.c deleted file mode 100644 index 1165542969..0000000000 --- a/ext/spice/src/cspice/ekuced.c +++ /dev/null @@ -1,600 +0,0 @@ -/* ekuced.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKUCED ( EK, update d.p. column entry ) */ -/* Subroutine */ int ekuced_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, doublereal *dvals, logical *isnull, - ftnlen column_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzekrbck_(char *, integer *, integer *, - integer *, integer *, ftnlen), zzeksdsc_(integer *, integer *, - integer *), zzektrdp_(integer *, integer *, integer *, integer *), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - logical isshad; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), ekshdw_(integer *, - logical *), zzekue02_(integer *, integer *, integer *, integer *, - doublereal *, logical *), zzekue05_(integer *, integer *, integer - *, integer *, integer *, doublereal *, logical *); - -/* $ Abstract */ - -/* Update a double precision column entry in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record in which entry is to be updated. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values in in new column entry. */ -/* DVALS I Double precision values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle attached to an EK open for */ -/* write access. */ - -/* SEGNO is the index of the segment containing the column */ -/* entry to be updated. */ - -/* RECNO is the index of the record containing the column */ -/* entry to be updated. This record number is */ -/* relative to the start of the segment indicated by */ -/* SEGNO; the first record in the segment has index 1. */ - -/* COLUMN is the name of the column containing the entry to */ -/* be updated. */ - -/* NVALS, */ -/* DVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written in to the */ -/* specifed column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* For columns with variable-sized entries, the size */ -/* of the new entry need not match the size of the */ -/* entry it replaces. In particular, the new entry */ -/* may be larger. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and DVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and DVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* The new entry may be null even though it replaces */ -/* a non-null value, and vice versa. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 3) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 4) If COLUMN specifies a column of whose data type is not */ -/* DOUBLE PRECISION or TIME, the error SPICE(WRONGDATATYPE) will */ -/* be signalled. */ - -/* 5) If RECNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 6) If the specified column has fixed-size entries and NVALS */ -/* does not match this size, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 7) If the specified column has variable-size entries and NVALS */ -/* is non-positive, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 8) If an attempt is made to add a null value to a column that */ -/* doesn't take null values, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 9) If COLUMN specifies a column of whose class is not */ -/* a double precision class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified record in the specified */ -/* column. Data may be added to a segment in random order; it is not */ -/* necessary to fill in columns or rows sequentially. Data may only */ -/* be added one logical element at a time. Partial assignments of */ -/* logical elements are not supported. */ - -/* Since columns of data type TIME are implemented using double */ -/* precision column classes, this routine may be used to update */ -/* columns of type TIME. */ - -/* $ Examples */ - -/* 1) Replace the value in the third record of the column DCOL in */ -/* the fifth segment of an EK file designated by HANDLE. Set */ -/* the new value to 999.D0. */ - -/* CALL EKUCED ( HANDLE, 5, 3, 'DCOL', 1, 999.D0, .FALSE. ) */ - - -/* 2) Same as (1), but this time add a null value. The argument */ -/* 999.D0 is ignored because the null flag is set to .TRUE. */ - -/* CALL EKUCED ( HANDLE, 5, 3, 'DCOL', 1, 999.D0, .TRUE. ) */ - - -/* 3) Replace the entry in the third record of the column DARRAY in */ -/* the fifth segment of an EK file designated by HANDLE. Set */ -/* the new value using an array DBUFF of 10 d.p. values. */ - -/* CALL EKUCED ( HANDLE, 5, 3, 'DARRAY', 10, DBUFF, .FALSE. ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 20-JUN-1999 (WLT) */ - -/* Removed unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace d.p. entry in an EK column */ -/* replace time entry in an EK column */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of double precision or `time' type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - chkin_("EKUCED", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKUCED only works with d.p. or TIME " - "columns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)98); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKUCED", (ftnlen)6); - return 0; - } - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - -/* Determine whether the EK is shadowed. */ - - ekshdw_(handle, &isshad); - -/* If the EK is shadowed, we must back up the current column entry */ -/* if the entry has not already been backed up. ZZEKRBCK will */ -/* handle this task. */ - - if (isshad) { - zzekrbck_("UPDATE", handle, segdsc, coldsc, recno, (ftnlen)6); - } - -/* Now it's time to carry out the replacement. */ - - class__ = coldsc[0]; - if (class__ == 2) { - -/* Class 2 columns contain scalar d.p. data. */ - - zzekue02_(handle, segdsc, coldsc, &recptr, dvals, isnull); - } else if (class__ == 5) { - -/* Class 5 columns contain array-valued d.p. data. */ - - zzekue05_(handle, segdsc, coldsc, &recptr, nvals, dvals, isnull); - } else { - -/* This is an unsupported d.p. column class. */ - - *segno = segdsc[1]; - chkin_("EKUCED", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported d.p" - ". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen) - 110); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKUCED", (ftnlen)6); - return 0; - } - return 0; -} /* ekuced_ */ - diff --git a/ext/spice/src/cspice/ekuced_c.c b/ext/spice/src/cspice/ekuced_c.c deleted file mode 100644 index da58034c09..0000000000 --- a/ext/spice/src/cspice/ekuced_c.c +++ /dev/null @@ -1,294 +0,0 @@ -/* - --Procedure ekuced_c ( EK, update d.p. column entry ) - --Abstract - - Update a double precision column entry in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekuced_c - - - void ekuced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle attached to EK file. - segno I Index of segment containing record. - recno I Record in which entry is to be updated. - column I Column name. - nvals I Number of values in new column entry. - dvals I Double precision values comprising new column entry. - isnull I Flag indicating whether column entry is null. - --Detailed_Input - - handle is a file handle attached to an EK open for - write access. - - segno is the index of the segment containing the column - entry to be updated. EK segment numbers range from - 0 to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record containing the column - entry to be updated. This record number is - relative to the start of the segment indicated by - segno; the first record in the segment has index 0. - - column is the name of the column containing the entry to - be updated. - - nvals, - dvals are, respectively, the number of values to insert into - the specified column and the set of values - themselves. The data values are written in to the - specifed column and record. - - If the column has fixed-size entries, then nvals - must equal the entry size for the specified column. - - For columns with variable-sized entries, the size - of the new entry need not match the size of the - entry it replaces. In particular, the new entry - may be larger. - - isnull is a logical flag indicating whether the entry is - null. If isnull is SPICEFALSE, the column entry - defined by nvals and dvals is added to the - specified kernel file. - - If isnull is SPICETRUE, nvals and ivals are ignored. - The column entry is marked as a null value. - The contents of the column entry are undefined. - If the column has fixed-length, variable-size - entries, the number of entries is considered to - be 1. - - The new entry may be null even though it replaces - a non-null value, and vice versa. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will diagnosed by routines - called by this routine. - - 3) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 4) If column specifies a column of whose data type is not - double precision, the error SPICE(WRONGDATATYPE) will be - signaled. - - 5) If recno is out of range, the error will diagnosed by routines - called by this routine. - - 6) If the specified column has fixed-size entries and nvals - does not match this size, the error will diagnosed by routines - called by this routine. - - 7) If the specified column has variable-size entries and nvals - is non-positive, the error will diagnosed by routines - called by this routine. - - 8) If an attempt is made to add a null value to a column that - doesn't take null values, the error will diagnosed by routines - called by this routine. - - 9) If COLUMN specifies a column of whose class is not - a double precision class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 11) If the input column name string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If the input column name string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified record in the specified - column. Data may be added to a segment in random order; it is not - necessary to fill in columns or rows sequentially. Data may only - be added one logical element at a time. Partial assignments of - logical elements are not supported. - - Since columns of data type TIME are implemented using double - precision column classes, this routine may be used to update - columns of type TIME. - --Examples - - 1) Replace the value in the third record of the column DCOL in - the fifth segment of an EK file designated by HANDLE. Set - the new value to 999.. - - #include - . - . - . - ekuced_c ( handle, 4, 2, "DCOL", 1, 999.0, SPICEFALSE ); - - - 2) Same as (1), but this time add a null value. The argument - 999. is ignored because the null flag is set to SPICETRUE - - #include - . - . - . - ekuced_c ( handle, 4, 2, "DCOL", 1, 999.0, SPICETRUE ); - - - 3) Replace the entry in the third record of the column DARRAY in - the fifth segment of an EK file designated by HANDLE. Set - the new value using an array DBUFF of 10 d.p. values. - - #include - . - . - . - ekuced_c ( handle, 4, 2, "DARRAY", 10, dbuff, SPICEFALSE ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - replace d.p. entry in an EK column - replace time entry in an EK column - --& -*/ - -{ /* Begin ekuced_c */ - - - /* - Local variables - */ - logical null; - - - /* - Participate in error tracing. - */ - chkin_c ( "ekuced_c" ); - - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekuced_c", column ); - - /* - Convert the null flag to type logical before passing it to - ekuced_. Also map the segment and record numbers to their - Fortran-style counterparts. - */ - - null = isnull; - - segno++; - recno++; - - ekuced_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) &nvals, - ( doublereal * ) dvals, - ( logical * ) &null, - ( ftnlen ) strlen(column) ); - - - chkout_c ( "ekuced_c" ); - -} /* End ekuced_c */ diff --git a/ext/spice/src/cspice/ekucei.c b/ext/spice/src/cspice/ekucei.c deleted file mode 100644 index 5b79a78706..0000000000 --- a/ext/spice/src/cspice/ekucei.c +++ /dev/null @@ -1,595 +0,0 @@ -/* ekucei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EKUCEI ( EK, update integer column entry ) */ -/* Subroutine */ int ekucei_(integer *handle, integer *segno, integer *recno, - char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen - column_len) -{ - integer unit; - extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, - integer *, ftnlen), zzekrbck_(char *, integer *, integer *, - integer *, integer *, ftnlen), zzeksdsc_(integer *, integer *, - integer *), zzektrdp_(integer *, integer *, integer *, integer *), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer class__, dtype; - extern logical failed_(void); - integer coldsc[11], segdsc[24]; - logical isshad; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer recptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), ekshdw_(integer *, - logical *), zzekue01_(integer *, integer *, integer *, integer *, - integer *, logical *), zzekue04_(integer *, integer *, integer *, - integer *, integer *, integer *, logical *); - -/* $ Abstract */ - -/* Update an integer column entry in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record in which entry is to be updated. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values in in new column entry. */ -/* IVALS I Integer values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle attached to an EK open for */ -/* write access. */ - -/* SEGNO is the index of the segment containing the column */ -/* entry to be updated. */ - -/* RECNO is the index of the record containing the column */ -/* entry to be updated. This record number is */ -/* relative to the start of the segment indicated by */ -/* SEGNO; the first record in the segment has index 1. */ - -/* COLUMN is the name of the column containing the entry to */ -/* be updated. */ - -/* NVALS, */ -/* IVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written in to the */ -/* specifed column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* For columns with variable-sized entries, the size */ -/* of the new entry need not match the size of the */ -/* entry it replaces. In particular, the new entry */ -/* may be larger. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and IVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and IVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* The new entry may be null even though it replaces */ -/* a non-null value, and vice versa. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 3) If COLUMN is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 4) If COLUMN specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 5) If RECNO is out of range, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 6) If the specified column has fixed-size entries and NVALS */ -/* does not match this size, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 7) If the specified column has variable-size entries and NVALS */ -/* is non-positive, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 8) If an attempt is made to add a null value to a column that */ -/* doesn't take null values, the error will diagnosed by routines */ -/* called by this routine. */ - -/* 9) If COLUMN specifies a column of whose class is not */ -/* an integer class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 10) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified record in the specified */ -/* column. Data may be added to a segment in random order; it is not */ -/* necessary to fill in columns or rows sequentially. Data may only */ -/* be added one logical element at a time. Partial assignments of */ -/* logical elements are not supported. */ - -/* $ Examples */ - -/* 1) Replace the value in the third record of the column ICOL in */ -/* the fifth segment of an EK file designated by HANDLE. Set */ -/* the new value to 999. */ - -/* CALL EKUCEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .FALSE. ) */ - - -/* 2) Same as (1), but this time add a null value. The argument */ -/* 999 is ignored because the null flag is set to .TRUE. */ - -/* CALL EKUCEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .TRUE. ) */ - - -/* 3) Replace the entry in the third record of the column IARRAY in */ -/* the fifth segment of an EK file designated by HANDLE. Set */ -/* the new value using an array IBUFF of 10 values. */ - -/* CALL EKUCEI ( HANDLE, 5, 3, 'IARRAY', 10, IBUFF, .FALSE. ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 20-JUN-1999 (WLT) */ - -/* Removed unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace integer entry in an EK column */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* First step: find the descriptor for the named segment. Using */ -/* this descriptor, get the column descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - zzekcdsc_(handle, segdsc, column, coldsc, column_len); - if (failed_()) { - return 0; - } - -/* This column had better be of integer type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - chkin_("EKUCEI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; EKUCEI only works with integer colum" - "ns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)93); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &dtype, (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("EKUCEI", (ftnlen)6); - return 0; - } - -/* Look up the record pointer for the target record. */ - - zzektrdp_(handle, &segdsc[6], recno, &recptr); - -/* Determine whether the EK is shadowed. */ - - ekshdw_(handle, &isshad); - -/* If the EK is shadowed, we must back up the current column entry */ -/* if the entry has not already been backed up. ZZEKRBCK will */ -/* handle this task. */ - - if (isshad) { - zzekrbck_("UPDATE", handle, segdsc, coldsc, recno, (ftnlen)6); - } - -/* Now it's time to carry out the replacement. */ - - class__ = coldsc[0]; - if (class__ == 1) { - -/* Class 1 columns contain scalar integer data. */ - - zzekue01_(handle, segdsc, coldsc, &recptr, ivals, isnull); - } else if (class__ == 4) { - -/* Class 4 columns contain array-valued integer data. */ - - zzekue04_(handle, segdsc, coldsc, &recptr, nvals, ivals, isnull); - } else { - -/* This is an unsupported integer column class. */ - - *segno = segdsc[1]; - chkin_("EKUCEI", (ftnlen)6); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported int" - "eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)113); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", recno, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("EKUCEI", (ftnlen)6); - return 0; - } - return 0; -} /* ekucei_ */ - diff --git a/ext/spice/src/cspice/ekucei_c.c b/ext/spice/src/cspice/ekucei_c.c deleted file mode 100644 index dc99404bc4..0000000000 --- a/ext/spice/src/cspice/ekucei_c.c +++ /dev/null @@ -1,287 +0,0 @@ -/* - --Procedure ekucei_c ( EK, update integer column entry ) - --Abstract - - Update an integer column entry in a specified EK record. - --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 - - EK - --Keywords - - EK - FILES - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef ekucei_c - - - void ekucei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle attached to EK file. - segno I Index of segment containing record. - recno I Record in which entry is to be updated. - column I Column name. - nvals I Number of values in new column entry. - ivals I Integer values comprising new column entry. - isnull I Flag indicating whether column entry is null. - --Detailed_Input - - handle is a file handle attached to an EK open for - write access. - - segno is the index of the segment containing the column - entry to be updated. EK segment numbers range from - 0 to N-1, where N is the number of segments - in the kernel. - - recno is the index of the record containing the column - entry to be updated. This record number is - relative to the start of the segment indicated by - segno; the first record in the segment has index 0. - - column is the name of the column containing the entry to - be updated. - - nvals, - ivals are, respectively, the number of values to insert into - the specified column and the set of values - themselves. The data values are written in to the - specifed column and record. - - If the column has fixed-size entries, then nvals - must equal the entry size for the specified column. - - For columns with variable-sized entries, the size - of the new entry need not match the size of the - entry it replaces. In particular, the new entry - may be larger. - - isnull is a logical flag indicating whether the entry is - null. If isnull is SPICEFALSE, the column entry - defined by nvals and ivals is added to the - specified kernel file. - - If ISNULL is SPICETRUE, nvals and ivals are ignored. - The column entry is marked as a null value. - The contents of the column entry are undefined. - If the column has fixed-length, variable-size - entries, the number of entries is considered to - be 1. - - The new entry may be null even though it replaces - a non-null value, and vice versa. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) If handle is invalid, the error will be diagnosed by routines - called by this routine. - - 2) If segno is out of range, the error will diagnosed by routines - called by this routine. - - 3) If column is not the name of a declared column, the error - will be diagnosed by routines called by this routine. - - 4) If column specifies a column of whose data type is not - integer, the error SPICE(WRONGDATATYPE) will be - signaled. - - 5) If recno is out of range, the error will diagnosed by routines - called by this routine. - - 6) If the specified column has fixed-size entries and nvals - does not match this size, the error will diagnosed by routines - called by this routine. - - 7) If the specified column has variable-size entries and nvals - is non-positive, the error will diagnosed by routines - called by this routine. - - 8) If an attempt is made to add a null value to a column that - doesn't take null values, the error will diagnosed by routines - called by this routine. - - 9) If COLUMN specifies a column of whose class is not - an integer class known to this routine, the error - SPICE(NOCLASS) will be signaled. - - 10) If an I/O error occurs while reading or writing the indicated - file, the error will be diagnosed by routines called by this - routine. - - 11) If the input column name string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If the input column name string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - --Files - - See the EK Required Reading for a discussion of the EK file - format. - --Particulars - - This routine operates by side effects: it modifies the named - EK file by adding data to the specified record in the specified - column. Data may be added to a segment in random order; it is not - necessary to fill in columns or rows sequentially. Data may only - be added one logical element at a time. Partial assignments of - logical elements are not supported. - --Examples - - 1) Replace the value in the third record of the column ICOL in - the fifth segment of an EK file designated by handle. Set - the new value to 999. - - #include - . - . - . - ekucei_c ( handle, 4, 2, "ICOL", 1, 999, SPICEFALSE ); - - - 2) Same as (1), but this time add a null value. The argument - 999 is ignored because the null flag is set to SPICETRUE - - #include - . - . - . - ekucei_c ( handle, 4, 2, "ICOL", 1, 999, SPICETRUE ); - - - 3) Replace the entry in the third record of the column IARRAY in - the fifth segment of an EK file designated by handle. Set - the new value using an array ibuff of 10 values. - - #include - . - . - . - ekucei_c ( handle, 4, 2, "IARRAY", 10, ibuff, SPICEFALSE ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - replace integer entry in an EK column - --& -*/ - -{ /* Begin ekucei_c */ - - - /* - Local variables - */ - logical null; - - /* - Participate in error tracing. - */ - chkin_c ( "ekucei_c" ); - - /* - Check the column name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ekucei_c", column ); - - /* - Convert the null flag to type logical before passing it to - ekucei_. Also map the segment and record numbers to their - Fortran-style counterparts. - */ - - null = isnull; - - segno++; - recno++; - - ekucei_ ( ( integer * ) &handle, - ( integer * ) &segno, - ( integer * ) &recno, - ( char * ) column, - ( integer * ) &nvals, - ( integer * ) ivals, - ( logical * ) &null, - ( ftnlen ) strlen(column) ); - - - chkout_c ( "ekucei_c" ); - -} /* End ekucei_c */ diff --git a/ext/spice/src/cspice/ekuef_c.c b/ext/spice/src/cspice/ekuef_c.c deleted file mode 100644 index 18bd471d86..0000000000 --- a/ext/spice/src/cspice/ekuef_c.c +++ /dev/null @@ -1,145 +0,0 @@ -/* - --Procedure ekuef_c ( EK, unload event file ) - --Abstract - - Unload an EK file, making its contents inaccessible to the - EK reader routines, and clearing space in order to allow other - EK files to be loaded. - --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 - - EK - --Keywords - - EK - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void ekuef_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of EK file. - --Detailed_Input - - handle is a file handle returned by eklef_c. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - None. - --Exceptions - - 1) Unloading a file that is not loaded has no effect. - --Files - - This routine unloads a binary EK file from the EK query system. - --Particulars - - This routine removes information about an EK file from the - EK system, freeing space to increase the number of other EK - files that can be loaded. The file is also unloaded from - the DAS system and closed. - --Examples - - 1) Load 25 EK files sequentially, unloading the previous file - before each new file is loaded. Unloading files prevents - them from being searched during query execution. - - for ( i = 0; i < 25; i++ ) - { - eklef_c ( ek[i], &handle ); - - [Perform queries] - - ekuef_c ( handle ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 26-JUL-1998 (NJB) - - Based on SPICELIB Version 1.0.1, 07-JUL-1996 (NJB) - --Index_Entries - - unload EK file - --& -*/ - -{ /* Begin ekuef_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "ekuef_c" ); - - - /* - Call the f2c'd Fortran routine. - */ - ekuef_ ( (integer *) &handle ); - - - chkout_c ( "ekuef_c" ); - -} /* End ekuef_c */ diff --git a/ext/spice/src/cspice/el2cgv.c b/ext/spice/src/cspice/el2cgv.c deleted file mode 100644 index 4d0940ac25..0000000000 --- a/ext/spice/src/cspice/el2cgv.c +++ /dev/null @@ -1,185 +0,0 @@ -/* el2cgv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EL2CGV ( Ellipse to center and generating vectors ) */ -/* Subroutine */ int el2cgv_(doublereal *ellips, doublereal *center, - doublereal *smajor, doublereal *sminor) -{ - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Convert a SPICELIB ellipse to a center vector and two generating */ -/* vectors. The selected generating vectors are semi-axes of the */ -/* ellipse. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELLIPS I A SPICELIB ellipse. */ -/* CENTER, */ -/* SMAJOR, */ -/* SMINOR O Center and semi-axes of ELLIPS. */ - -/* $ Detailed_Input */ - -/* ELLIPS is a SPICELIB ellipse. */ - -/* $ Detailed_Output */ - -/* CENTER, */ -/* SMAJOR, */ -/* SMINOR are, respectively, a center vector, a semi-major */ -/* axis vector, and a semi-minor axis vector that */ -/* generate the input ellipse. This ellipse is the */ -/* set of points */ - -/* CENTER + cos(theta) SMAJOR + sin(theta) SMINOR */ - -/* where theta ranges over the interval (-pi, pi]. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB ellipses serve to simplify calling sequences and reduce */ -/* the chance for error in declaring and describing argument lists */ -/* involving ellipses. */ - -/* The set of ellipse conversion routines is */ - -/* CGV2EL ( Center and generating vectors to ellipse ) */ -/* EL2CGV ( Ellipse to center and generating vectors ) */ - -/* A word about the output of this routine: the semi-major axis of */ -/* an ellipse is a vector of largest possible magnitude in the set */ - -/* cos(theta) VEC1 + sin(theta) VEC2, */ - -/* where theta is in the interval (-pi, pi]. There are two such */ -/* vectors; they are additive inverses of each other. The semi-minor */ -/* axis is an analogous vector of smallest possible magnitude. The */ -/* semi-major and semi-minor axes are orthogonal to each other. If */ -/* SMAJOR and SMINOR are choices of semi-major and semi-minor axes, */ -/* then the input ellipse can also be represented as the set of */ -/* points */ - - -/* CENTER + cos(theta) SMAJOR + sin(theta) SMINOR */ - -/* where theta ranges over the interval (-pi, pi]. */ - -/* $ Examples */ - -/* 1) Find the semi-axes of the limb of an ellipsoid. */ - -/* C */ -/* C Our viewing location is VIEWPT. The radii of the */ -/* C ellipsoid are A, B, and C. */ -/* C */ -/* CALL EDLIMB ( A, B, C, VIEWPT, LIMB ) */ - -/* CALL EL2CGV ( LIMB, CENTER, SMAJOR, SMINOR ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ellipse to center and generating vectors */ - -/* -& */ - -/* Local parameters */ - - -/* SPICELIB ellipses contain a center vector, a semi-major */ -/* axis vector, and a semi-minor axis vector. These are */ -/* located, respectively, in elements */ - -/* CTRPOS through CTRPOS + 1 */ - -/* MAJPOS through MAJPOS + 1 */ - -/* MINPOS through MINPOS + 1 */ - - - -/* The center of the ellipse is held in the first three elements. */ -/* The semi-major and semi-minor axes come next. */ - - vequ_(ellips, center); - vequ_(&ellips[3], smajor); - vequ_(&ellips[6], sminor); - return 0; -} /* el2cgv_ */ - diff --git a/ext/spice/src/cspice/el2cgv_c.c b/ext/spice/src/cspice/el2cgv_c.c deleted file mode 100644 index 897471292c..0000000000 --- a/ext/spice/src/cspice/el2cgv_c.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - --Procedure el2cgv_c ( Ellipse to center and generating vectors ) - --Abstract - - Convert a CSPICE ellipse to a center vector and two generating - vectors. The selected generating vectors are semi-axes of the - ellipse. - --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 - - ELLIPSES - --Keywords - - ELLIPSE - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef el2cgv_c - - - void el2cgv_c ( ConstSpiceEllipse * ellipse, - SpiceDouble center[3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - ellipse I A CSPICE ellipse. - center, - smajor, - sminor O Center and semi-axes of ellipse. - --Detailed_Input - - ellipse is a CSPICE ellipse. - --Detailed_Output - - center, - smajor, - sminor are, respectively, a center vector, a semi-major - axis vector, and a semi-minor axis vector that - generate the input ellipse. This ellipse is the - set of points - - center + cos(theta) smajor + sin(theta) sminor - - where theta ranges over the interval (-pi, pi]. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - CSPICE ellipses serve to simplify calling sequences and reduce - the chance for error in declaring and describing argument lists - involving ellipses. - - The set of ellipse conversion routines is - - cgv2el_c ( Center and generating vectors to ellipse ) - el2cgv_c ( Ellipse to center and generating vectors ) - - A word about the output of this routine: the semi-major axis of - an ellipse is a vector of largest possible magnitude in the set - - cos(theta) vec1 + sin(theta) vec2, - - where theta is in the interval (-pi, pi]. There are two such - vectors; they are additive inverses of each other. The semi-minor - axis is an analogous vector of smallest possible magnitude. The - semi-major and semi-minor axes are orthogonal to each other. If - smajor and sminor are choices of semi-major and semi-minor axes, - then the input ellipse can also be represented as the set of - points - - - center + cos(theta) smajor + sin(theta) sminor - - where theta ranges over the interval (-pi, pi]. - - --Examples - - 1) Find the semi-axes of the limb of an ellipsoid. - - #include "SpiceUsr.h" - . - . - . - /. - Our viewing location is viewpt. The radii of the - ellipsoid are a, b, and c. - ./ - edlimb_c ( a, b, c, viewpt, &limb ); - - el2cgv_c ( &limb, center, smajor, sminor ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 12-JUN-1999 (NJB) - --Index_Entries - - ellipse to center and generating vectors - --& -*/ - -{ /* Begin el2cgv_c */ - - /* - Error free. - */ - - - MOVED ( ellipse->center, 3, center ); - MOVED ( ellipse->semiMajor, 3, smajor ); - MOVED ( ellipse->semiMinor, 3, sminor ); - - -} /* End el2cgv_c */ - diff --git a/ext/spice/src/cspice/elemc.c b/ext/spice/src/cspice/elemc.c deleted file mode 100644 index 459e8c06e1..0000000000 --- a/ext/spice/src/cspice/elemc.c +++ /dev/null @@ -1,190 +0,0 @@ -/* elemc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ELEMC ( Element of a character set ) */ -logical elemc_(char *item, char *a, ftnlen item_len, ftnlen a_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Determine whether an item is an element of a character set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be tested. */ -/* A I Set to be tested. */ - -/* The function returns TRUE if ITEM is an element of set A. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which may or may not be an element of */ -/* the input set. */ - - -/* A is a set. */ - - -/* $ Detailed_Output */ - -/* The function returns TRUE if ITEM is a member of the set A, */ -/* and returns FALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The LOGICAL functions ELEMC and ELEMI correspond to the */ -/* set operator IN in the Pascal language. */ - -/* $ Examples */ - -/* Let the character sets PLANETS and ASTEROIDS contain the */ -/* following elements. */ - -/* PLANETS ASTEROIDS */ -/* -------- ---------- */ -/* 'Earth' 'Apollo' */ -/* 'Mars' 'Ceres' */ -/* 'Pluto' */ -/* 'Venus' */ - -/* Then all of the following expressions are true. */ - -/* ELEMC ( 'Earth', PLANETS ) */ -/* ELEMC ( 'Pluto', PLANETS ) */ -/* ELEMC ( 'Ceres', ASTEROIDS ) */ - -/* And all of the following expressions are false. */ - -/* ELEMC ( 'Saturn', PLANETS ) */ -/* ELEMC ( 'Pluto', ASTEROIDS ) */ -/* ELEMC ( 'CERES', ASTEROIDS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* element of a character set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling: */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("ELEMC", (ftnlen)5); - } - -/* Just a binary search. */ - - i__1 = cardc_(a, a_len); - ret_val = bsrchc_(item, &i__1, a + a_len * 6, item_len, a_len) != 0; - chkout_("ELEMC", (ftnlen)5); - return ret_val; -} /* elemc_ */ - diff --git a/ext/spice/src/cspice/elemc_c.c b/ext/spice/src/cspice/elemc_c.c deleted file mode 100644 index 7311cc2fe1..0000000000 --- a/ext/spice/src/cspice/elemc_c.c +++ /dev/null @@ -1,206 +0,0 @@ -/* - --Procedure elemc_c ( Element of a character set ) - --Abstract - - Determine whether an item is an element of a character set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - SpiceBoolean elemc_c ( ConstSpiceChar * item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be tested. - set I Set to be tested. - - The function returns SPICETRUE if item is an element of set. - --Detailed_Input - - item is an item which may or may not be an element of - the input set. Trailing blanks in item are not - significant. - - set is a CSPICE set. set must be declared as a character - SpiceCell. Trailing blanks in the members of set are - not significant. - --Detailed_Output - - The function returns SPICETRUE if item is a member of the specified - set, and returns SPICEFALSE otherwise. - - The comparison between item and members of set is case-sensitive. - Trailing blanks are ignored. - --Parameters - - None. - --Exceptions - - 1) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - - 2) If the input set does not have character data type, the error - SPICE(TYPEMISMATCH will be signaled. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - --Files - - None. - --Particulars - - The functions - - elemc_c - elemd_c - elemi_c - - provide a convenient shorthand notation for a binary search - on a set's data array for the item of interest. - --Examples - - Let the character sets planets and asteroids contain the - following elements. - - planets asteroids - -------- ---------- - "Earth" "Apollo" - "Mars" "Ceres" - "Pluto" - "Venus" - - Then all of the following expressions are SPICETRUE. - - elemc_c ( "Earth", &planets ) - elemc_c ( "Pluto", &planets ) - elemc_c ( "Ceres", &asteroids ) - - And all of the following expressions are SPICEFALSE. - - elemc_c ( "saturn", &planets ) - elemc_c ( "pluto", &asteroids ) - elemc_c ( "ceres", &asteroids ) - --Restrictions - - 1) 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) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 21-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - element of a character set - --& -*/ - -{ /* Begin elemc_c */ - - - /* - Use discovery check-in. - - Check the input string pointer to make sure it's not null. - */ - CHKPTR_VAL ( CHK_DISCOVER, "elemc_c", item, SPICEFALSE ); - - - /* - Make sure we're working with a character cell. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, "elemc_c", SPICE_CHR, set, SPICEFALSE ); - - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK_VAL ( CHK_DISCOVER, "elemc_c", set, SPICEFALSE ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - - /* - The routine bsrchc_c returns the index of the item in the set, - or -1 if the item is not present. - */ - return ( bsrchc_c ( item, set->card, - set->length, set->data ) != -1 ); - -} /* End elemc_c */ diff --git a/ext/spice/src/cspice/elemd.c b/ext/spice/src/cspice/elemd.c deleted file mode 100644 index 6ccc5a3c3f..0000000000 --- a/ext/spice/src/cspice/elemd.c +++ /dev/null @@ -1,191 +0,0 @@ -/* elemd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ELEMD ( Element of a double precision set ) */ -logical elemd_(doublereal *item, doublereal *a) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchd_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Determine whether an item is an element of a double */ -/* precision set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be tested. */ -/* A I Set to be tested. */ - -/* The function returns TRUE if ITEM is an element of set A. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which may or may not be an element of */ -/* the input set. */ - - -/* A is a set. */ - - -/* $ Detailed_Output */ - -/* The function returns TRUE if ITEM is a member of the set A, */ -/* and returns FALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The LOGICAL functions ELEMC and ELEMI correspond to the */ -/* set operator IN in the Pascal language. */ - -/* $ Examples */ - -/* Let the character sets PLANETS and ASTEROIDS contain the */ -/* following elements. */ - -/* PLANETS ASTEROIDS */ -/* -------- ---------- */ -/* 'Earth' 'Apollo' */ -/* 'Mars' 'Ceres' */ -/* 'Pluto' */ -/* 'Venus' */ - -/* Then all of the following expressions are true. */ - -/* ELEMC ( 'Earth', PLANETS ) */ -/* ELEMC ( 'Pluto', PLANETS ) */ -/* ELEMC ( 'Ceres', ASTEROIDS ) */ - -/* And all of the following expressions are false. */ - -/* ELEMC ( 'Saturn', PLANETS ) */ -/* ELEMC ( 'Pluto', ASTEROIDS ) */ -/* ELEMC ( 'CERES', ASTEROIDS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* element of a d.p. set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling: */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("ELEMD", (ftnlen)5); - } - -/* Just a binary search. */ - - i__1 = cardd_(a); - ret_val = bsrchd_(item, &i__1, &a[6]) != 0; - chkout_("ELEMD", (ftnlen)5); - return ret_val; -} /* elemd_ */ - diff --git a/ext/spice/src/cspice/elemd_c.c b/ext/spice/src/cspice/elemd_c.c deleted file mode 100644 index ba5d0aa23f..0000000000 --- a/ext/spice/src/cspice/elemd_c.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure elemd_c ( Element of a double precision set ) - --Abstract - - Determine whether an item is an element of a double precision set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - SpiceBoolean elemd_c ( SpiceDouble item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be tested. - set I Set to be tested. - - The function returns SPICETRUE if item is an element of set. - --Detailed_Input - - item is an item which may or may not be an element of - the input set. - - - set is a CSPICE set. set must be declared as a double - precision SpiceCell. - --Detailed_Output - - The function returns SPICETRUE if item is a member of the set, - and returns SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - - 2) If the input set does not have double precision data type, - the error SPICE(TYPEMISMATCH will be signaled. - --Files - - None. - --Particulars - - This routine uses a binary search to check for the presence in the set - of the specified item. - --Examples - - Let set contain the elements - - { -1.0, 0.0, 1.0, 3.0, 5.0 } - - The the following expressions have the value SPICETRUE - - elemd_c ( -1.0, &set ) - elemd_c ( 0.0, &set ) - elemd_c ( 3.0, &set ) - - and the following expressions have the value SPICEFALSE - - elemd_c ( -2.0, &set ) - elemd_c ( 2.0, &set ) - elemd_c ( 6.0, &set ) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - element of a d.p. set - --& -*/ -{ - - /* - Use discovery check-in. - - Make sure we're working with a double precision cell. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, "elemd_c", SPICE_DP, set, SPICEFALSE ); - - /* - Make sure the input cell is a set. - */ - CELLISSETCHK_VAL ( CHK_DISCOVER, "elemd_c", set, SPICEFALSE ); - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - /* - The routine bsrchd_c returns the index of the item in the set, - or -1 if the item is not present. - */ - return ( bsrchd_c ( item, set->card, set->data ) != -1 ); -} - - diff --git a/ext/spice/src/cspice/elemi.c b/ext/spice/src/cspice/elemi.c deleted file mode 100644 index 16ebc57ed3..0000000000 --- a/ext/spice/src/cspice/elemi.c +++ /dev/null @@ -1,190 +0,0 @@ -/* elemi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ELEMI ( Element of an integer set ) */ -logical elemi_(integer *item, integer *a) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Determine whether an item is an element of an integer set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be tested. */ -/* A I Set to be tested. */ - -/* The function returns TRUE if ITEM is an element of set A. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which may or may not be an element of */ -/* the input set. */ - - -/* A is a set. */ - - -/* $ Detailed_Output */ - -/* The function returns TRUE if ITEM is a member of the set A, */ -/* and returns FALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The LOGICAL functions ELEMC and ELEMI correspond to the */ -/* set operator IN in the Pascal language. */ - -/* $ Examples */ - -/* Let the character sets PLANETS and ASTEROIDS contain the */ -/* following elements. */ - -/* PLANETS ASTEROIDS */ -/* -------- ---------- */ -/* 'Earth' 'Apollo' */ -/* 'Mars' 'Ceres' */ -/* 'Pluto' */ -/* 'Venus' */ - -/* Then all of the following expressions are true. */ - -/* ELEMC ( 'Earth', PLANETS ) */ -/* ELEMC ( 'Pluto', PLANETS ) */ -/* ELEMC ( 'Ceres', ASTEROIDS ) */ - -/* And all of the following expressions are false. */ - -/* ELEMC ( 'Saturn', PLANETS ) */ -/* ELEMC ( 'Pluto', ASTEROIDS ) */ -/* ELEMC ( 'CERES', ASTEROIDS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* element of an integer set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling: */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("ELEMI", (ftnlen)5); - } - -/* Just a binary search. */ - - i__1 = cardi_(a); - ret_val = bsrchi_(item, &i__1, &a[6]) != 0; - chkout_("ELEMI", (ftnlen)5); - return ret_val; -} /* elemi_ */ - diff --git a/ext/spice/src/cspice/elemi_c.c b/ext/spice/src/cspice/elemi_c.c deleted file mode 100644 index 89c5a5d224..0000000000 --- a/ext/spice/src/cspice/elemi_c.c +++ /dev/null @@ -1,173 +0,0 @@ -/* - --Procedure elemi_c ( Element of an integer set ) - --Abstract - - Determine whether an item is an element of an integer set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - -#include "SpiceUsr.h" -#include "SpiceZfc.h" -#include "SpiceZmc.h" - - - SpiceBoolean elemi_c ( SpiceInt item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be tested. - set I Set to be tested. - - The function returns SPICETRUE if item is an element of set. - --Detailed_Input - - item is an item which may or may not be an element of - the input set. - - - set is a CSPICE set. set must be declared as an integer - SpiceCell. - --Detailed_Output - - The function returns SPICETRUE if item is a member of the set, - and returns SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - - 2) If the input set does not have integer data type, the error - SPICE(TYPEMISMATCH will be signaled. - --Files - - None. - --Particulars - - This routine uses a binary search to check for the presence in the set - of the specified item. - --Examples - - Let set contain the elements - - { -1, 0, 1, 3, 5 } - - The the following expressions have the value SPICETRUE - - elemi_c ( -1, &set ) - elemi_c ( 0, &set ) - elemi_c ( 3, &set ) - - and the following expressions have the value SPICEFALSE - - elemi_c ( -2, &set ) - elemi_c ( 2, &set ) - elemi_c ( 6, &set ) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - - --Index_Entries - - element of an integer set - --& -*/ - -{ - - /* - Use discovery check-in. - - Make sure we're working with an integer cell. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, "elemi_c", SPICE_INT, set, SPICEFALSE ); - - /* - Make sure the input cell is a set. - */ - CELLISSETCHK_VAL ( CHK_DISCOVER, "elemi_c", set, SPICEFALSE ); - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - /* - The routine bsrchi_c returns the index of the item in the set, - or -1 if the item is not present. - */ - return ( ( SpiceBoolean ) - ( bsrchi_c ( item, set->card, set->data ) != -1 ) ); - -} - diff --git a/ext/spice/src/cspice/elltof.c b/ext/spice/src/cspice/elltof.c deleted file mode 100644 index f260729e10..0000000000 --- a/ext/spice/src/cspice/elltof.c +++ /dev/null @@ -1,346 +0,0 @@ -/* elltof.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ELLTOF ( Elliptic time of flight ) */ -/* Subroutine */ int elltof_(doublereal *ma, doublereal *ecc, doublereal *e) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sin(doublereal), sqrt(doublereal), cos(doublereal); - - /* Local variables */ - doublereal a, b, m; - integer n; - doublereal q, r__, y; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal dcbrt_(doublereal *); - doublereal deriv, m0; - extern doublereal twopi_(void); - doublereal deriv2, fn, change; - extern doublereal pi_(void), halfpi_(void); - doublereal qr, mprime; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Solve the time of flight equation MA = E - e sin(E) for the */ -/* elliptic eccentric anomaly E, given mean anomaly the MA and */ -/* the eccentricity ECC. */ - -/* $ 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 */ - -/* CONIC */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MA I Mean anomaly at epoch. */ -/* ECC I Eccentricity. */ -/* E O Elliptic eccentric anomaly. */ - -/* $ Detailed_Input */ - -/* MA is the elliptic mean anomaly of an orbiting body at */ -/* some epoch t, */ - -/* 3 1/2 */ -/* MA = (t-T)(mu/a ) */ - -/* where T is the time of periapsis passage, a is */ -/* the semi-major axis of the orbit, and mu is the */ -/* gravitational parameter of the primary body. */ - -/* ECC is the eccentricity of the orbit. */ - -/* $ Detailed_Output */ - -/* E is the corresponding eccentric anomaly. This is the */ -/* solution to the time of flight equation */ - -/* MA = E - e sin(E) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity (ECC) is outside the range [0,1), */ -/* the error 'SPICE(WRONGCONIC)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Iterate to solve */ - -/* f(E,MA,e) = E - e sin(E) - MA = 0 */ - -/* $ Examples */ - -/* ELLTOF, HYPTOF, and PARTOF are used by CONICS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */ - -/* [2] Ed Ng, "A General Algorithm for the Solution of Kepler's */ -/* Equation for Elliptic Orbits", Cel. Mech. 20, 243, 1979. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* elliptic time of flight */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 8-JAN-1989 (IMU) */ - -/* The routine now verifies that the eccentricity is in the */ -/* proper range---[0,1)---before proceeding. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ELLTOF", (ftnlen)6); - } - if (*ecc < 0. || *ecc >= 1.) { - sigerr_("SPICE(WRONGCONIC)", (ftnlen)17); - chkout_("ELLTOF", (ftnlen)6); - return 0; - } - -/* For reasons of numerical stability, we would like to restrict */ -/* our solution to the interval [0,pi]. Because E, M, and sin E */ -/* are always positive or negative together, we can pretend that M */ -/* is positive and adjust the sign of the result. And for M, E > pi, */ -/* we can define */ - -/* M = 2n pi + M' and E = 2n pi + E' */ - -/* where M' and E' are in the interval [-pi,pi]. Solving for E' */ -/* gives us E. */ - -/* So, we begin by reducing the input mean anomaly to [0,pi]. */ - - m = abs(*ma); - if (m > pi_()) { - n = (integer) ((m - pi_()) / twopi_()) + 1; - mprime = m - n * twopi_(); - } else { - n = 0; - mprime = m; - } - m = abs(mprime); - -/* The convergence of the iterative scheme below depends on a good */ -/* initial estimate for E. */ - -/* For small eccentricity, the initial estimate E = M is sufficient. */ -/* However, as the eccentricity increases, so does the number of */ -/* iterations required for convergence. For sufficiently large */ -/* eccentricity, this estimate leads to divergence. */ - -/* Ng [2] notes that the function y(M,e) */ - -/* E - M */ -/* ------- = sin(e y + M) */ -/* e */ - -/* increases and decreases monotonically when M is in the ranges */ -/* [0,M0] and [m0,pi], respectively. */ - -/* When M0 < M < pi, where M0 = (pi/2) - e, the cubic */ -/* - - */ - -/* pi - M 2 pi - M pi - M */ -/* B(M,e) = 1 - (1 - -------) (1 + 2 ------- - -------) */ -/* pi - M0 pi - M0 1 + e */ - -/* provides a good initial estimate of y for all values of e. */ - - - m0 = halfpi_() - *ecc; - if (m >= m0) { - a = pi_() - m; - b = pi_() - m0; -/* Computing 2nd power */ - d__1 = 1. - a / b; - y = 1. - d__1 * d__1 * (a * 2. / b + 1. - a / (*ecc + 1.)); - *e = *ecc * sin(*ecc * y + m) + m; - -/* The situation is a little more troublesome, however, when M < M0. */ -/* For small eccentricity, the cubic */ - -/* 2 */ -/* A(M,e) = 1 - (1 - M/M0) (1 + 2M/M0 - M/(1-e) ) */ - -/* gives a reasonable first estimate of y. However, as e -> 1, */ -/* successive approximations of the form */ - -/* k k */ -/* C (M,e) = 1 - (-1) (1 - M/M0) */ -/* k */ - -/* are used, where k = 4 for e > 0.7, and k = 8 for e > 0.85. */ - -/* For high eccentricity (e > 0.96) and low mean anomaly (M < 0.05), */ -/* these successive approximations eventually fail. Fortunately, in */ -/* just these cases, the cubic */ - -/* 3 2 1/3 3 2 1/3 */ -/* D(M,e) = [r + (q + r )] + [r - (q + r )] */ - -/* where */ - -/* r = 3M/e, q = (2/e)(1 - e) */ - -/* provides a reasonable estimate of E directly. */ - - - } else if (*ecc <= .7) { -/* Computing 2nd power */ - d__1 = 1. - m / m0; - y = 1. - d__1 * d__1 * (m * 2. / m0 + 1. - m / (1. - *ecc)); - *e = *ecc * sin(*ecc * y + m) + m; - } else if (*ecc <= .85) { -/* Computing 4th power */ - d__1 = 1. - m / m0, d__1 *= d__1; - y = 1. - d__1 * d__1; - *e = *ecc * sin(*ecc * y + m) + m; - } else if (*ecc <= .96 || m > .05) { -/* Computing 8th power */ - d__1 = 1. - m / m0, d__1 *= d__1, d__1 *= d__1; - y = 1. - d__1 * d__1; - *e = *ecc * sin(*ecc * y + m) + m; - } else { - q = 2. / *ecc * (1. - *ecc); - r__ = m / *ecc * 3.; -/* Computing 3rd power */ - d__1 = q; -/* Computing 2nd power */ - d__2 = r__; - qr = sqrt(d__1 * (d__1 * d__1) + d__2 * d__2); - d__1 = r__ + qr; - d__2 = r__ - qr; - *e = dcbrt_(&d__1) + dcbrt_(&d__2); - } - -/* Use the Newton second-order method, */ - -/* 2 */ -/* E = E - (f/f')*(1 + f*f''/2f' ) */ -/* i+1 i */ - -/* where */ - -/* f = E - e sin(E) - M */ -/* f' = 1 - e cos(E) */ -/* f'' = e sin(E) */ - - change = 1.; - while(abs(change) > 1e-15) { - fn = *e - *ecc * sin(*e) - m; - deriv = 1. - *ecc * cos(*e); - deriv2 = *ecc * sin(*e); -/* Computing 2nd power */ - d__1 = deriv; - change = fn / deriv * (fn * deriv2 / (d__1 * d__1 * 2.) + 1.); - *e -= change; - } - -/* "Unwrap" E' into the actual value of E. */ - - if (mprime < 0.) { - *e = -(*e); - } - if (n > 0) { - *e += n * twopi_(); - } - if (*ma < 0.) { - *e = -(*e); - } - chkout_("ELLTOF", (ftnlen)6); - return 0; -} /* elltof_ */ - diff --git a/ext/spice/src/cspice/enchar.c b/ext/spice/src/cspice/enchar.c deleted file mode 100644 index 38059720a8..0000000000 --- a/ext/spice/src/cspice/enchar.c +++ /dev/null @@ -1,400 +0,0 @@ -/* enchar.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ENCHAR ( Encode a character string ) */ -/* Subroutine */ int enchar_0_(int n__, integer *number, char *string, ftnlen - string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer base, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer chbase_(void); - integer remain; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - integer num; - -/* $ Abstract */ - -/* Encode a nonnegative integer number into a character string */ -/* as the expansion of the number in base CHBASE (a function of */ -/* the size of the available character set). */ - -/* $ 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 */ - -/* CELLS, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Number to be encoded. */ -/* STRING O Encoded string. */ -/* MINLEN P Minimum length of string. */ - -/* $ Detailed_Input */ - -/* NUMBER is an arbitrary nonnegative integer. */ - -/* $ Detailed_Output */ - -/* STRING is the character string implied by the ASCII */ -/* interpretation of NUMBER when converted to its */ -/* base CHBASE representation. */ - -/* Let L be the declared length of STRING, and let */ -/* NUMBER be given by */ - -/* 0 1 L-1 */ -/* NUMBER = a CHBASE + a CHBASE + ... + a CHBASE */ -/* 1 2 L */ - -/* Then */ - -/* STRING(i:i) = CHAR(a ) for i = 1, L */ -/* i */ - -/* Note that, just as for any other "numbers", */ -/* the "digits" in STRING are arranged from right */ -/* to left in order of increasing significance. */ -/* The string is, in effect, "padded with nulls" */ -/* on the left. */ - -/* $ Parameters */ - -/* MINLEN is the minimum length of a string into which a */ -/* number may be encoded. In order to avoid padding */ -/* long strings with hundreds, possibly thousands */ -/* of null characters, only the first MINLEN characters */ -/* of the string are actually used. Note that this */ -/* also allows the encoded number to be preserved */ -/* during assignments, */ - -/* STR1 = STR2 */ - -/* so long as both strings are of length MINLEN or */ -/* greater. */ - -/* $ Exceptions */ - -/* 1) If the length of the output string is less than MINLEN, */ -/* the error 'SPICE(INSUFFLEN)' is signalled. */ - -/* 2) If the number to be encoded is negative, the error */ -/* 'SPICE(OUTOFRANGE)' is signalled. */ - -/* MINLEN */ -/* 3) If the number to be encoded is larger than CHBASE - 1, */ -/* the error 'SPICE(OUTOFRANGE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The value of CHBASE, which varies from machine to machine, is */ -/* returned by a constant function of the same name. */ - -/* $ Examples */ - -/* See: SCARDC, SSIZEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 31-JAN-2008 (BVS) */ - -/* Changed header section title '$C Revision' to '$C Revisions'. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* encode a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-JAN-1989 (IMU) */ - -/* Only the first MINLEN characters of the string are now */ -/* used to encode the value. Also, negative values are now */ -/* treated as errors. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_dechar; - } - - if (return_()) { - return 0; - } else if (i_len(string, string_len) < 5) { - chkin_("ENCHAR", (ftnlen)6); - sigerr_("SPICE(INSUFFLEN)", (ftnlen)16); - chkout_("ENCHAR", (ftnlen)6); - return 0; - } else if (*number < 0) { - chkin_("ENCHAR", (ftnlen)6); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - chkout_("ENCHAR", (ftnlen)6); - return 0; - } - -/* Generate the digits from right to left. */ - - base = chbase_(); - num = *number; - for (i__ = 5; i__ >= 1; --i__) { - remain = num % base; - *(unsigned char *)&string[i__ - 1] = (char) remain; - num /= base; - } - -/* More error handling. */ - - if (num > 0) { - chkin_("ENCHAR", (ftnlen)6); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - chkout_("ENCHAR", (ftnlen)6); - } - return 0; -/* $Procedure DECHAR ( Decode a character string ) */ - -L_dechar: -/* $ Abstract */ - -/* Decode a character string encoded by ENCHAR. */ - -/* $ 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 */ - -/* CHARACTER */ - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ -/* INTEGER NUMBER */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Encoded character string. */ -/* NUMBER O Decoded number. */ - -/* $ Detailed_Input */ - -/* STRING is a character string previously encoded by ENCHAR. */ -/* This contains an integer in base CHBASE notation, */ -/* where CHBASE is a function of the size of the */ -/* available character set. See ENCHAR for details */ -/* about the format of STRING. */ - -/* $ Detailed_Output */ - -/* NUMBER is the integer encoded in the input string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the length of the input string is less than MINLEN, */ -/* the error 'SPICE(INSUFFLEN)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DECHAR is the inverse of ENCHAR. In the example below, */ - -/* CALL ENCHAR ( I, STRING ) */ -/* CALL DECHAR ( STRING, J ) */ - -/* IF ( I .EQ. J ) THEN */ -/* . */ -/* . */ -/* END IF */ - -/* the logical test (I .EQ. J) is always true. */ - -/* $ Examples */ - -/* See: CARDC, SIZEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 31-JAN-2008 (BVS) */ - -/* Changed header section title '$C Revision' to '$C Revisions'. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* decode a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-JAN-1989 (IMU) */ - -/* Changed to reflect changes in ENCHAR. In particular, */ -/* it now checks the length of the input string. It is */ -/* also an entry point of ENCHAR, to make sure they always */ -/* have the same value of MINLEN. (Also, if CHBASE is */ -/* changed, ENCHAR and DECHAR will always be recompiled */ -/* simultaneously.) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else if (i_len(string, string_len) < 5) { - chkin_("DECHAR", (ftnlen)6); - sigerr_("SPICE(INSUFFLEN)", (ftnlen)16); - chkout_("DECHAR", (ftnlen)6); - return 0; - } - -/* Sum the products of the 'digits' and the corresponding powers */ -/* of NDCHAR, just like any other base conversion. */ - - base = chbase_(); - *number = 0; - for (i__ = 1; i__ <= 5; ++i__) { - *number = base * *number + *(unsigned char *)&string[i__ - 1]; - } - return 0; -} /* enchar_ */ - -/* Subroutine */ int enchar_(integer *number, char *string, ftnlen string_len) -{ - return enchar_0_(0, number, string, string_len); - } - -/* Subroutine */ int dechar_(char *string, integer *number, ftnlen string_len) -{ - return enchar_0_(1, number, string, string_len); - } - diff --git a/ext/spice/src/cspice/endfile.c b/ext/spice/src/cspice/endfile.c deleted file mode 100644 index d28b6c411d..0000000000 --- a/ext/spice/src/cspice/endfile.c +++ /dev/null @@ -1,119 +0,0 @@ -#include "f2c.h" -#include "fio.h" - -#ifdef KR_headers -extern char *strcpy(); -extern FILE *tmpfile(); -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -#include "string.h" -#endif - -extern char *f__r_mode[], *f__w_mode[]; - -#ifdef KR_headers -integer f_end(a) alist *a; -#else -integer f_end(alist *a) -#endif -{ - unit *b; - FILE *tf; - - if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile"); - b = &f__units[a->aunit]; - if(b->ufd==NULL) { - char nbuf[10]; - sprintf(nbuf,"fort.%ld",a->aunit); - if (tf = fopen(nbuf, f__w_mode[0])) - fclose(tf); - return(0); - } - b->uend=1; - return(b->useek ? t_runc(a) : 0); -} - - static int -#ifdef KR_headers -copy(from, len, to) FILE *from, *to; register long len; -#else -copy(FILE *from, register long len, FILE *to) -#endif -{ - int len1; - char buf[BUFSIZ]; - - while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) { - if (!fwrite(buf, len1, 1, to)) - return 1; - if ((len -= len1) <= 0) - break; - } - return 0; - } - - int -#ifdef KR_headers -t_runc(a) alist *a; -#else -t_runc(alist *a) -#endif -{ - long loc, len; - unit *b; - FILE *bf, *tf; - int rc = 0; - - b = &f__units[a->aunit]; - if(b->url) - return(0); /*don't truncate direct files*/ - loc=ftell(bf = b->ufd); - fseek(bf,0L,SEEK_END); - len=ftell(bf); - if (loc >= len || b->useek == 0 || b->ufnm == NULL) - return(0); - fclose(b->ufd); - if (!loc) { - if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt]))) - rc = 1; - if (b->uwrt) - b->uwrt = 1; - goto done; - } - if (!(bf = fopen(b->ufnm, f__r_mode[0])) - || !(tf = tmpfile())) { - bad: - rc = 1; - goto done; - } - if (copy(bf, loc, tf)) { - bad1: - rc = 1; - goto done1; - } - if (!(bf = freopen(b->ufnm, f__w_mode[0], bf))) - goto bad1; - rewind(tf); - if (copy(tf, loc, bf)) - goto bad1; - b->urw = 2; -#ifdef NON_UNIX_STDIO - if (b->ufmt) { - fclose(bf); - if (!(bf = fopen(b->ufnm, f__w_mode[3]))) - goto bad; - fseek(bf,0L,SEEK_END); - b->urw = 3; - } -#endif -done1: - fclose(tf); -done: - f__cf = b->ufd = bf; - if (rc) - err(a->aerr,111,"endfile"); - return 0; - } diff --git a/ext/spice/src/cspice/eqchr.c b/ext/spice/src/cspice/eqchr.c deleted file mode 100644 index 134984c20e..0000000000 --- a/ext/spice/src/cspice/eqchr.c +++ /dev/null @@ -1,515 +0,0 @@ -/* eqchr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EQCHR (Equivalent characters) */ -logical eqchr_0_(int n__, char *a, char *b, ftnlen a_len, ftnlen b_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__, j, uvalue[256]; - -/* $ Abstract */ - -/* This function determines whether two characters are */ -/* equivalent when the case of the characters is ignored. */ - -/* $ 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 */ - -/* CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I one of the characters to check */ -/* B I the other character to check */ - -/* The function returns .TRUE. if the characters are equivalent */ - -/* $ Detailed_Input */ - -/* A are two characters that are to be compared to see */ -/* B if they are the same letter (although possibly */ -/* having different case such as 'a' and 'A') */ - -/* $ Detailed_Output */ - -/* The function returns the value .TRUE. if the two input characters */ -/* are the same or can be made the same by converting both to */ -/* upper or lower case. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a utility routine for comparing two characters to */ -/* see if they are the same when converted to upper case. It */ -/* is particularly useful when writing string analysis routines */ -/* that should be case insensitive. Instead of writing the */ -/* expression */ - -/* A .EQ. B */ - -/* use the expression */ - -/* EQCHR ( A, B ) */ - -/* in all tests of equivalence for characters. */ - -/* $ Examples */ - -/* Suppose you want to determine whether or not two strings */ -/* are the same if differences in the case of letters are ignored. */ -/* The following code fragment shows how you can use this routine */ -/* to check for the equivalence of character strings. */ - -/* MORE = .TRUE. */ -/* SAME = .TRUE. */ -/* L1 = LEN(STR1) */ -/* L2 = LEN(STR2) */ -/* CHECK = MIN ( L1, L2 ) */ - -/* DO WHILE ( SAME .AND. MORE ) */ - -/* SAME = EQCHR( STR1(I:I), STR2(I:I) ) */ -/* I = I + 1 */ -/* MORE = I .LT. CHECK */ - -/* END DO */ - -/* IF ( .NOT. SAME ) THEN */ - -/* There's nothing to do, we already know the strings */ -/* are not the same. */ - -/* ELSE IF ( L1 .LT. L2 ) THEN */ - -/* The only way the strings can be regarded as being equal */ -/* is if the extra unchecked characters in STR2 are all blank. */ - -/* SAME = STR2(I:) .EQ. ' ' */ - -/* ELSE */ - -/* Same test as previous one but with STR1 this time. */ - -/* SAME = STR1(I:) .EQ. ' ' */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Spicelib Version 2.0.0, 17-SEP-1998 (EDW) */ - -/* Replace the UVALUE data statement with a loop to fill */ -/* UVALUE. The Absoft Mac compiler failed to compile the */ -/* data statement correctly, and so this function failed */ -/* to work properly in all situations on the Mac. The */ -/* corrects the problem and functions on all platforms. */ - -/* - SPICELIB Version 1.0.0, 16-MAY-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Check two characters for case insensitive equality */ - -/* -& */ - -/* Entry points. */ - - -/* Range of characters */ - - -/* Local Variables */ - -/* The array UVALUE contains the ICHAR values for the upper case */ -/* version of each character. */ - - switch(n__) { - case 1: goto L_nechr; - } - - -/* The first time through the loop we set the upper case values */ -/* for each of the lower case letters. */ - - if (first) { - for (i__ = 0; i__ <= 255; ++i__) { - uvalue[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "eqchr_", (ftnlen)206)] = i__; - } - first = FALSE_; - uvalue[(i__1 = 'a') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)211)] = 'A'; - uvalue[(i__1 = 'b') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)212)] = 'B'; - uvalue[(i__1 = 'c') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)213)] = 'C'; - uvalue[(i__1 = 'd') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)214)] = 'D'; - uvalue[(i__1 = 'e') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)215)] = 'E'; - uvalue[(i__1 = 'f') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)216)] = 'F'; - uvalue[(i__1 = 'g') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)217)] = 'G'; - uvalue[(i__1 = 'h') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)218)] = 'H'; - uvalue[(i__1 = 'i') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)219)] = 'I'; - uvalue[(i__1 = 'j') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)220)] = 'J'; - uvalue[(i__1 = 'k') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)221)] = 'K'; - uvalue[(i__1 = 'l') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)222)] = 'L'; - uvalue[(i__1 = 'm') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)223)] = 'M'; - uvalue[(i__1 = 'n') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)224)] = 'N'; - uvalue[(i__1 = 'o') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)225)] = 'O'; - uvalue[(i__1 = 'p') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)226)] = 'P'; - uvalue[(i__1 = 'q') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)227)] = 'Q'; - uvalue[(i__1 = 'r') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)228)] = 'R'; - uvalue[(i__1 = 's') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)229)] = 'S'; - uvalue[(i__1 = 't') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)230)] = 'T'; - uvalue[(i__1 = 'u') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)231)] = 'U'; - uvalue[(i__1 = 'v') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)232)] = 'V'; - uvalue[(i__1 = 'w') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)233)] = 'W'; - uvalue[(i__1 = 'x') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)234)] = 'X'; - uvalue[(i__1 = 'y') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)235)] = 'Y'; - uvalue[(i__1 = 'z') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)236)] = 'Z'; - } - i__ = *(unsigned char *)a; - j = *(unsigned char *)b; - if (i__ > 255 || j > 255) { - ret_val = i__ == j; - } else { - ret_val = uvalue[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "uvalue", i__1, "eqchr_", (ftnlen)246)] == uvalue[(i__2 = j) < - 256 && 0 <= i__2 ? i__2 : s_rnge("uvalue", i__2, "eqchr_", ( - ftnlen)246)]; - } - return ret_val; -/* $Procedure NECHR (Not Equivalent characters) */ - -L_nechr: -/* $ Abstract */ - -/* This function determines whether two characters are */ -/* not equivalent if the case of the characters is ignored. */ - -/* $ 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 */ - -/* CHARACTER */ - -/* $ Declarations */ - -/* CHARACTER*(1) A */ -/* CHARACTER*(1) B */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I one of the characters to check */ -/* B I the other character to check */ - -/* The function returns .TRUE. if the characters are not equivalent */ - -/* $ Detailed_Input */ - -/* A are two characters that are to be compared to see */ -/* B if they are different letters. Letters that have */ -/* the same value when converted to uppercase are */ -/* considered to be equivalent. */ - -/* $ Detailed_Output */ - -/* The function returns the value .FALSE. if the two input characters */ -/* are the same or can be made the same by converting both to */ -/* upper or lower case. Otherwise it returns .TRUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine simply determines the truth value of .NOT. EQCHR. */ -/* See the entry point EQCHR for a discussion of that function. */ - -/* $ Examples */ - -/* Suppose you want to determine whether or not two strings */ -/* are the same up to differences in case. The following */ -/* code fragment shows how you can use this routine to check */ -/* for the equivalence of character strings. */ - -/* MORE = .TRUE. */ -/* SAME = .TRUE. */ -/* L1 = LEN(STR1) */ -/* L2 = LEN(STR2) */ -/* CHECK = MIN ( L1, L2 ) */ - -/* DO WHILE ( SAME .AND. MORE ) */ - -/* IF ( NECHR(STR1(I:I),STR2(I:I) ) THEN */ -/* SAME = .FALSE. */ -/* END IF */ - -/* I = I + 1 */ -/* MORE = I .LT. CHECK */ - -/* END DO */ - -/* IF ( .NOT. SAME ) THEN */ - -/* There's nothing to do, we already know the strings */ -/* are not the same. */ - -/* ELSE IF ( L1 .LT. L2 ) THEN */ - -/* The only way the strings can be regarded as being equal */ -/* is if the extra unchecked characters in STR2 are all blank. */ - -/* SAME = STR2(I:) .EQ. ' ' */ - -/* ELSE */ - -/* Same test as previous one but with STR1 this time. */ - -/* SAME = STR1(I:) .EQ. ' ' */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Spicelib Version 2.0.0, 17-SEP-1998 (EDW) */ - -/* Replace the UVALUE data statement with a loop to fill */ -/* UVALUE. The Absoft Mac compiler failed to compile the */ -/* data statement correctly, and so this function failed */ -/* to work properly in all situations on the Mac. The */ -/* corrects the problem and functions on all platforms. */ - -/* - Spicelib Version 1.0.0, 16-MAY-1995 */ - -/* -& */ -/* $ Index_Entries */ - -/* Check two characters for case insensitive not equal */ - -/* -& */ - if (first) { - first = FALSE_; - for (i__ = 0; i__ <= 255; ++i__) { - uvalue[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "eqchr_", (ftnlen)421)] = i__; - } - uvalue[(i__1 = 'a') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)424)] = 'A'; - uvalue[(i__1 = 'b') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)425)] = 'B'; - uvalue[(i__1 = 'c') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)426)] = 'C'; - uvalue[(i__1 = 'd') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)427)] = 'D'; - uvalue[(i__1 = 'e') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)428)] = 'E'; - uvalue[(i__1 = 'f') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)429)] = 'F'; - uvalue[(i__1 = 'g') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)430)] = 'G'; - uvalue[(i__1 = 'h') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)431)] = 'H'; - uvalue[(i__1 = 'i') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)432)] = 'I'; - uvalue[(i__1 = 'j') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)433)] = 'J'; - uvalue[(i__1 = 'k') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)434)] = 'K'; - uvalue[(i__1 = 'l') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)435)] = 'L'; - uvalue[(i__1 = 'm') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)436)] = 'M'; - uvalue[(i__1 = 'n') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)437)] = 'N'; - uvalue[(i__1 = 'o') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)438)] = 'O'; - uvalue[(i__1 = 'p') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)439)] = 'P'; - uvalue[(i__1 = 'q') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)440)] = 'Q'; - uvalue[(i__1 = 'r') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)441)] = 'R'; - uvalue[(i__1 = 's') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)442)] = 'S'; - uvalue[(i__1 = 't') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)443)] = 'T'; - uvalue[(i__1 = 'u') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)444)] = 'U'; - uvalue[(i__1 = 'v') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)445)] = 'V'; - uvalue[(i__1 = 'w') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)446)] = 'W'; - uvalue[(i__1 = 'x') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)447)] = 'X'; - uvalue[(i__1 = 'y') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)448)] = 'Y'; - uvalue[(i__1 = 'z') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "eqchr_", (ftnlen)449)] = 'Z'; - } - i__ = *(unsigned char *)a; - j = *(unsigned char *)b; - if (i__ > 255 || j > 255) { - ret_val = i__ != j; - } else { - ret_val = uvalue[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "uvalue", i__1, "eqchr_", (ftnlen)459)] != uvalue[(i__2 = j) < - 256 && 0 <= i__2 ? i__2 : s_rnge("uvalue", i__2, "eqchr_", ( - ftnlen)459)]; - } - return ret_val; -} /* eqchr_ */ - -logical eqchr_(char *a, char *b, ftnlen a_len, ftnlen b_len) -{ - return eqchr_0_(0, a, b, a_len, b_len); - } - -logical nechr_(char *a, char *b, ftnlen a_len, ftnlen b_len) -{ - return eqchr_0_(1, a, b, a_len, b_len); - } - diff --git a/ext/spice/src/cspice/eqncpv.c b/ext/spice/src/cspice/eqncpv.c deleted file mode 100644 index 1f795f5b77..0000000000 --- a/ext/spice/src/cspice/eqncpv.c +++ /dev/null @@ -1,548 +0,0 @@ -/* eqncpv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b13 = 1.; - -/* $Procedure EQNCPV (Equinoctial Elements to position and velocity) */ -/* Subroutine */ int eqncpv_(doublereal *et, doublereal *epoch, doublereal * - eqel, doublereal *rapol, doublereal *decpol, doublereal *state) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double sqrt(doublereal), sin(doublereal), cos(doublereal), d_mod( - doublereal *, doublereal *); - - /* Local variables */ - doublereal nfac, node, mldt, temp[3], a, b, h__, k, l, eecan, p, q, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal dlpdt, prate; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal xhold[6]; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - doublereal trans[9] /* was [3][3] */; - extern doublereal twopi_(void); - doublereal x1, y1; - extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - doublereal ca, cd, cf, di, cn, ra, sa, rb, sd, dt, sf, ml, dx, dy, vf[3], - vg[3], sn, nodedt; - extern doublereal kepleq_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - static doublereal pi2; - doublereal dx1, dy1; - extern logical return_(void); - doublereal ecc, can, dlp, san; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Compute the state (position and velocity of an object whose */ -/* trajectory is described via equinoctial elements relative to some */ -/* fixed plane (usually the equatorial plane of some planet). */ - -/* $ 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 */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch in seconds past J2000 to find state */ -/* EPOCH I Epoch of elements in seconds past J2000 */ -/* EQEL I Array of equinoctial elements */ -/* RAPOL I Right Ascension of the pole of the reference plane */ -/* DECPOL I Declination of the pole of the reference plane */ -/* STATE O State of the object described by EQEL. */ - -/* $ Detailed_Input */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. ET is measured */ -/* in seconds past the J2000 epoch. */ - -/* EPOCH is the epoch of the equinoctial elements in seconds */ -/* past the J2000 epoch. */ - -/* EQEL is an array of 9 double precision numbers that */ -/* are the equinoctial elements for some orbit expressed */ -/* relative to the equatorial frame of the central body. */ -/* (The z-axis of the equatorial frame is the direction */ -/* of the pole of the central body relative to some */ -/* inertial frame. The x-axis is given by the cross */ -/* product of the Z-axis of the inertial frame */ -/* with the direction of the pole of the central body. */ -/* The Y-axis completes a right handed frame. */ -/* (If the z-axis of the equatorial frame is aligned */ -/* with the z-axis of the inertial frame, then the */ -/* x-axis of the equatorial frame will be located at */ -/* 90 degrees + RAPOL in the inertial frame.) */ - -/* The specific arrangement of the elements is spelled */ -/* out below. The following terms are used in the */ -/* discussion of elements of EQEL */ - -/* INC --- inclination of the orbit */ -/* ARGP --- argument of periapse */ -/* NODE --- longitude of the ascending node */ -/* E --- eccentricity of the orbit */ - -/* EQEL(1) is the semi-major axis (A) of the orbit in km. */ - -/* EQEL(2) is the value of H at the specified epoch. */ -/* ( E*SIN(ARGP+NODE) ). */ - -/* EQEL(3) is the value of K at the specified epoch */ -/* ( E*COS(ARGP+NODE) ). */ - -/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */ -/* the epoch of the elements measured in radians. */ - -/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */ -/* the specified epoch. */ - -/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */ -/* the specified epoch. */ - -/* EQEL(7) is the rate of the longitude of periapse */ -/* (dARGP/dt + dNODE/dt ) at the epoch of */ -/* the elements. This rate is assumed to hold */ -/* for all time. The rate is measured in */ -/* radians per second. */ - -/* EQEL(8) is the derivative of the mean longitude */ -/* ( dM/dt + dARGP/dt + dNODE/dt ). This */ -/* rate is assumed to be constant and is */ -/* measured in radians/second. */ - -/* EQEL(9) is the rate of the longitude of the ascending */ -/* node ( dNODE/dt). This rate is measured */ -/* in radians per second. */ - -/* RAPOL Right Ascension of the pole of the reference plane */ -/* with respect to some inertial frame (measured in */ -/* radians). */ - -/* DECPOL Declination of the pole of the reference plane */ -/* with respect to some inertial frame (measured in */ -/* radians). */ - -/* $ Detailed_Output */ - -/* STATE State of the object described by EQEL relative to the */ -/* inertial frame used to define RAPOL and DECPOL. Units */ -/* are in km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity corresponding to the input elements is */ -/* greater than 0.9, the error SPICE(ECCOUTOFRANGE) is signalled. */ - -/* 2) If the semi-major axis of the elements is non-positive, the */ -/* error SPICE(BADSEMIAXIS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine evaluates the input equinoctial elements for */ -/* the specified epoch and return the corresponding state. */ - -/* This routine was adapted from a routine provided by */ -/* Bob Jacobson of the Planetary Dynamics Group of */ -/* the Navigation and Flight Mechanics Section at JPL. */ - -/* $ Examples */ - -/* Suppose you have classical elements and rates of */ -/* change of the ascending node and argument of periapse */ -/* for some satellite of the earth. */ - -/* By transforming the classical elements */ -/* this routine can be used to compute the state of the */ -/* object at an arbitrary epoch. The code below illustrates */ -/* how you might do this. */ - -/* The table below illustrates the meanings of the various */ -/* variables used in the discussion below. */ - -/* Variable Meaning */ -/* -------- ---------------------------------- */ -/* A Semi-major axis in km */ -/* ECC Eccentricity of orbit */ -/* INC Inclination of orbit */ -/* NODE Longitude of the ascending node at epoch */ -/* OMEGA Argument of periapse at epoch */ -/* M Mean anomaly at epoch */ -/* DMDT Mean anomaly rate in radians/second */ -/* DNODE Rate of change of longitude of ascending node */ -/* in radians/second */ -/* DARGP Rate of change of argument of periapse in */ -/* radians/second */ -/* EPOCH is the epoch of the elements in seconds past */ -/* the J2000 epoch. */ - - -/* EQEL(1) = A */ -/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */ -/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */ - -/* EQEL(4) = M + OMEGA + NODE */ - -/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */ -/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */ - -/* EQEL(7) = DARGP */ -/* EQEL(8) = DARGP + DMDT + DNODE */ -/* EQEL(9) = DNODE */ - - -/* We shall compute the state of the satellite in the */ -/* pole and equator reference system. */ - -/* RAPOL = -HALFPI() */ -/* DECPOL = HALFPI() */ - - -/* Now compute the state at the desired epoch ET. */ - -/* CALL EQNCPV ( ET, EPOCH, EQEL, RAPOL, DECPOL, STATE ) */ - -/* $ Restrictions */ - -/* The equinoctial elements used by this routine are taken */ -/* from "Tangent" formulation of equinoctial elements */ - -/* p = Tan(inclination/2) * Sin(R.A. of ascending node) */ -/* q = Tan(inclination/2) * Cos(R.A. of ascending node) */ - -/* Other formulations use Sine instead of Tangent. We shall */ -/* call these the "Sine" formulations. */ - -/* p = Sin(inclination/2) * Sin(R.A. of ascending node) */ -/* q = Sin(inclination/2) * Cos(R.A. of ascending node) */ - -/* If you have equinoctial elements from this alternative */ -/* formulation you should replace p and q by the */ -/* expressions below. */ - -/* P = P / DSQRT ( 1.0D0 - P*P - Q*Q ) */ -/* Q = Q / DSQRT ( 1.0D0 - P*P - Q*Q ) */ - -/* This will convert the Sine formulation to the Tangent formulation. */ - -/* $ Literature_References */ - -/* JPL Engineering Memorandum 314-513 "Optical Navigation Program */ -/* Mathematical Models" by William M. Owen, Jr. and Robin M Vaughan */ -/* August 9, 1991 */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* R.A. Jacobson (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.0.1, 31-JAN-2008 (BVS) */ - -/* Removed non-standard header section heading */ -/* 'Declarations_of_external_functions'. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1997 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Compute a state from equinoctial elements */ - -/* -& */ - -/* SPICELIB Functions. */ - - -/* LOCAL VARIABLES */ - - -/* Constants computed on first pass */ - - -/* Standard SPICE exception handling code. */ - - if (return_()) { - return 0; - } - chkin_("EQNCPV", (ftnlen)6); - -/* The first time through this routine we fetch the various */ -/* constants we need for this routine. */ - - if (first) { - first = FALSE_; - pi2 = twopi_(); - } - -/* Take care of the various errors that can arise with the */ -/* input elements. */ - - if (eqel[0] <= 0.) { - setmsg_("The semi-major axis supplied to EQNCPV was non-positive. Th" - "e value is required to be positive by this routine. The valu" - "e supplied was #. ", (ftnlen)137); - errdp_("#", eqel, (ftnlen)1); - sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18); - chkout_("EQNCPV", (ftnlen)6); - return 0; - } - ecc = sqrt(eqel[1] * eqel[1] + eqel[2] * eqel[2]); - if (ecc > .9) { - setmsg_("The routine EQNCPV can reliably evaluate states from equino" - "ctial elements if the eccentricity of the orbit associated w" - "ith the elements is less than 0.9. The eccentricity associa" - "ted with the elements supplies is #. The values of H and K " - "are: # and # respectively. ", (ftnlen)266); - errdp_("#", &ecc, (ftnlen)1); - errdp_("#", &eqel[1], (ftnlen)1); - errdp_("#", &eqel[2], (ftnlen)1); - sigerr_("SPICE(ECCOUTOFRANGE)", (ftnlen)20); - chkout_("EQNCPV", (ftnlen)6); - return 0; - } - -/* Form the transformation from planetary equator to the inertial */ -/* reference frame. */ - - sa = sin(*rapol); - ca = cos(*rapol); - sd = sin(*decpol); - cd = cos(*decpol); - trans[0] = -sa; - trans[3] = -ca * sd; - trans[6] = ca * cd; - trans[1] = ca; - trans[4] = -sa * sd; - trans[7] = sa * cd; - trans[2] = 0.; - trans[5] = cd; - trans[8] = sd; - -/* Compute the offset of the input epoch (ET) from the */ -/* epoch of the elements. */ - - dt = *et - *epoch; - -/* Obtain the elements, rates, and other parameters. First get */ -/* the semi-major axis. */ - - a = eqel[0]; - -/* Recall that H and K at the epoch of the elements are in */ -/* EQEL(2) and EQEL(3) respectively. */ - -/* H_0 = E*Sin(ARGP_0 + NODE_0 ) */ -/* K_0 = E*Cos(ARGP_0 + NODE_0 ) */ - -/* The values of H and K at the epoch of interest is */ - -/* H_dt = E*Sin(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */ -/* K_dt = E*Cos(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */ - -/* But using the identities Sin(A+B) = Sin(A)Cos(B) + Sin(B)Cos(A) */ -/* Cos(A+B) = Cos(A)Cos(B) - Sin(A)Sin(B) */ - -/* We can re-write the expression for H_dt and K_dt as */ - -/* H_dt = E*Sin(ARGP_0 + NODE_0 )Cos(dt*d(ARGP+NODE)/dt ) */ -/* + E*Cos(ARGP_0 + NODE_0 )Sin(dt*d(ARGP+NODE)/dt ) */ - - -/* = H_0 * Cos(dt*d(ARGP+NODE)/dt ) */ -/* + K_0 * Sin(dt*d(ARGP+NODE)/dt ) */ -/* and */ - -/* K_dt = E*Cos(ARGP_0 + NODE_0)Cos(dt*d(ARGP+NODE)/dt) */ -/* - E*Sin(ARGP_0 + NODE_0)Sin(dt*d(ARGP+NODE)/dt) */ - -/* = K_0 * Cos(dt*d(ARGP+NODE)/dt) */ -/* - H_0 * Sin(dt*d(ARGP+NODE)/dt) */ - -/* Thus we can easily compute H and K at the current epoch. */ -/* Recall that the derivative of the longitude of periapse is */ -/* in entry 7 of EQEL. */ - - dlpdt = eqel[6]; - dlp = dt * dlpdt; - can = cos(dlp); - san = sin(dlp); - h__ = eqel[1] * can + eqel[2] * san; - k = eqel[2] * can - eqel[1] * san; - -/* The mean longitude at epoch is in the 4th element of EQEL. */ - - l = eqel[3]; - -/* The values for P and Q at epoch are stored in entries 5 and 6 */ -/* of the array EQEL. Recall that */ - -/* P_0 = TAN(INC/2)*SIN(NODE_0) */ -/* Q_0 = TAN(INC/2)*COS(NODE_0) */ - -/* We need P and Q offset from the initial epoch by DT. */ - -/* P = TAN(INC/2)*SIN(NODE_0 + dt*dNODE/dt) */ -/* Q = TAN(INC/2)*COS(NODE_0 + dt*dNODE/dt) */ - -/* Applying the same identities as we did before we have */ - -/* P = P_0 * Cos( dt*dNODE/dt ) + Q_0 * Sin( dt*dNODE/dt ) */ -/* Q = Q_0 * Cos( dt*dNODE/dt ) - P_0 * Sin( dt*dNODE/dt ) */ - - nodedt = eqel[8]; - node = dt * nodedt; - cn = cos(node); - sn = sin(node); - p = eqel[4] * cn + eqel[5] * sn; - q = eqel[5] * cn - eqel[4] * sn; - mldt = eqel[7]; - -/* We compute the rate of change of the argument of periapse */ -/* by taking the difference between the rate of the longitude */ -/* of periapse and the rate of the node. */ - - prate = dlpdt - nodedt; - -/* Form Broucke's beta parameter */ - - b = sqrt(1. - h__ * h__ - k * k); - b = 1. / (b + 1.); - -/* Construct the coordinate axes */ - - di = 1. / (p * p + 1. + q * q); - vf[0] = (1. - p * p + q * q) * di; - vf[1] = p * 2. * q * di; - vf[2] = p * -2. * di; - vg[0] = p * 2. * q * di; - vg[1] = (p * p + 1. - q * q) * di; - vg[2] = q * 2. * di; - -/* Compute the mean longitude */ - - d__1 = mldt * dt; - ml = l + d_mod(&d__1, &pi2); - -/* Obtain the eccentric longitude from Kepler's equation */ - - eecan = kepleq_(&ml, &h__, &k); - -/* Trigonometric functions of the eccentric longitude */ - - sf = sin(eecan); - cf = cos(eecan); - -/* Position in the orbit plane */ - -/* Computing 2nd power */ - d__1 = h__; - x1 = a * ((1. - b * (d__1 * d__1)) * cf + (h__ * k * b * sf - k)); -/* Computing 2nd power */ - d__1 = k; - y1 = a * ((1. - b * (d__1 * d__1)) * sf + (h__ * k * b * cf - h__)); - -/* Radial distance and functions of the radial distance */ - - rb = h__ * sf + k * cf; - r__ = a * (1. - rb); - ra = mldt * a * a / r__; - - -/* Velocity in the orbit plane */ - - dx1 = ra * (-sf + h__ * b * rb); - dy1 = ra * (cf - k * b * rb); - -/* Correction factor for periapsis rate */ - - nfac = 1. - dlpdt / mldt; - -/* Include precession in velocity */ - - dx = nfac * dx1 - prate * y1; - dy = nfac * dy1 + prate * x1; - -/* Form the planetary mean equator position vector */ - - vlcom_(&x1, vf, &y1, vg, xhold); - -/* Form the planetary mean equator velocity vector */ - - temp[0] = -nodedt * xhold[1]; - temp[1] = nodedt * xhold[0]; - temp[2] = 0.; - vlcom3_(&c_b13, temp, &dx, vf, &dy, vg, &xhold[3]); - -/* Transform to an inertial state vector */ - - mxv_(trans, xhold, state); - mxv_(trans, &xhold[3], &state[3]); - chkout_("EQNCPV", (ftnlen)6); - return 0; -} /* eqncpv_ */ - diff --git a/ext/spice/src/cspice/eqstr.c b/ext/spice/src/cspice/eqstr.c deleted file mode 100644 index 5382c6a1cf..0000000000 --- a/ext/spice/src/cspice/eqstr.c +++ /dev/null @@ -1,387 +0,0 @@ -/* eqstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EQSTR ( Equivalent strings ) */ -logical eqstr_(char *a, char *b, ftnlen a_len, ftnlen b_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - integer lena, lenb; - logical done; - integer delta, ca, cb, pa, pb, lbound, ubound; - -/* $ Abstract */ - -/* Determine whether two strings are equivalent. */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* ASCII */ -/* CHARACTER */ -/* COMPARE */ -/* PARSING */ -/* SEARCH */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A, */ -/* B I Arbitrary character strings. */ - -/* The function returns TRUE if A and B are equivalent. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are arbitrary character strings. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if A and B are equivalent: that is, */ -/* if A and B contain the same characters in the same order, */ -/* when blanks are ignored and uppercase and lowercase characters */ -/* are considered equal. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is provided for those cases in which two strings */ -/* must be compared, and in which allowances are to be made for */ -/* extra (leading, trailing, and embedded) blanks and differences */ -/* in case. For the most part, */ - -/* IF ( EQSTR ( A, B ) ) THEN */ -/* . */ -/* . */ - -/* is true whenever */ - -/* CALL CMPRSS ( ' ', 0, A, TEMPA ) */ -/* CALL UCASE ( TEMPA, TEMPA ) */ - -/* CALL CMPRSS ( ' ', 0, B, TEMPB ) */ -/* CALL UCASE ( TEMPB, TEMPB ) */ - -/* IF ( TEMPA .EQ. TEMPB ) THEN */ -/* . */ -/* . */ - -/* is true. There are two important differences, however. */ - -/* 1) The single reference to EQSTR is much simpler to */ -/* write, and simpler to understand. */ - -/* 2) The reference to EQSTR does not require any temporary */ -/* storage, nor does it require that the strings A and B */ -/* be changed. This feature is especially useful when */ -/* comparing strings recieved as subprogram arguments */ -/* against strings stored internally within the subprogram. */ - -/* $ Examples */ - -/* Usage */ -/* -------------------------------------------- */ - -/* All of the following are TRUE. */ - -/* EQSTR ( 'A short string ', */ -/* . 'ashortstring' ) */ - -/* EQSTR ( 'Embedded blanks', */ -/* . 'Em be dd ed bl an ks' ) */ - -/* EQSTR ( 'Embedded blanks', */ -/* . ' Embeddedblanks' ) */ - -/* EQSTR ( ' ', */ -/* . ' ' ) */ - -/* All of the following are FALSE. */ - -/* EQSTR ( 'One word left out', */ -/* . 'WORD LEFT OUT' ) */ - -/* EQSTR ( 'Extra [] delimiters', */ -/* . 'extradelimiters' ) */ - -/* EQSTR ( 'Testing 1, 2, 3', */ -/* . 'TESTING123' ) */ - - -/* Use */ -/* -------------------------------------------- */ - -/* The following illustrates a typical use for EQSTR. */ - -/* SUBROUTINE GREETING ( WHO, WHAT ) */ - -/* CHARACTER*(*) WHO */ -/* CHARACTER*(*) WHAT */ - -/* IF ( EQSTR ( WHO, 'Steve' ) ) THEN */ -/* WHAT = 'Yes, sir?' */ - -/* ELSE IF ( EQSTR ( WHO, 'Chuck' ) ) THEN */ -/* WHAT = 'What can I do for you?' */ - -/* ELSE */ -/* WHAT = 'Whaddya want?' */ -/* END IF */ - -/* RETURN */ -/* END */ - -/* Note that all of the following calls will elicit the */ -/* greeting 'Yes, sir?': */ - -/* CALL GREETING ( 'STEVE', WHAT ) */ -/* CALL GREETING ( 'steve', WHAT ) */ -/* CALL GREETING ( 'Steve', WHAT ) */ -/* CALL GREETING ( 'sTEVE', WHAT ) */ -/* CALL GREETING ( ' S T E V E ', WHAT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 03-AUG-1994 (NJB) */ - -/* Code changed to eliminate DO WHILE ( .TRUE. ) construct. */ -/* The purpose of the change was to eliminate compilation */ -/* diagnostics relating to unreachable statements. The code */ -/* ran just fine before this change. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 10-MAY-1990 (NJB) */ - -/* Loop termination condition fixed. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* equivalent strings */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 07-JUL-1994 (NJB) */ - -/* Code changed to eliminate DO WHILE ( .TRUE. ) construct. */ -/* The purpose of the change was to eliminate compilation */ -/* diagnostics relating to unreachable statements. */ - -/* Changed some statements of form */ - -/* IF */ - -/* to */ - -/* IF THEN */ - -/* */ - -/* END IF */ - - -/* - SPICELIB Version 1.1.0, 10-MAY-1990 (NJB) */ - -/* Loop termination condition fixed. The routine now checks */ -/* the termination case where both string pointers are pointing */ -/* to blanks, and at least one pointer has a value greater than */ -/* the length of the string it corresponds to. Internal comments */ -/* were updated accordingly. */ - -/* -& */ - -/* Local variables */ - - -/* The general plan is to move a pair of pointers (PA, PB) */ -/* through strings A and B, skipping blank characters and */ -/* comparing others one-for-one. */ - -/* Repeat: */ - -/* If (A is blank) then */ -/* Increment A */ - -/* Else if (B is blank) then */ -/* Increment B */ - -/* Else */ -/* If (A and B are equivalent) then */ -/* Increment A and B */ -/* Else */ -/* Return FALSE */ - -/* If (A and B are past end) then */ -/* Return TRUE */ - -/* Else if (A or B is past end and other is non-blank) then */ -/* Return FALSE */ - -/* Else if (A or B is past end and other is blank) then */ -/* Return TRUE */ - -/* Note that no pointer gets incremented more than once on each */ -/* pass through the loop. */ - -/* On the other hand, in many cases the strings will be exactly */ -/* equal. If so, why knock ourselves out? */ - - if (s_cmp(a, b, a_len, b_len) == 0) { - ret_val = TRUE_; - return ret_val; - } else { - pa = 1; - pb = 1; - lena = i_len(a, a_len); - lenb = i_len(b, b_len); - lbound = 'a'; - ubound = 'z'; - delta = 'A' - 'a'; - done = FALSE_; - while(! done) { - -/* At this point, we're guaranteed that */ - -/* ( PA .LE. LENA ) and ( PB .LE. LENB ) */ - - if (*(unsigned char *)&a[pa - 1] == ' ') { - ++pa; - } else if (*(unsigned char *)&b[pb - 1] == ' ') { - ++pb; - } else { - ca = *(unsigned char *)&a[pa - 1]; - cb = *(unsigned char *)&b[pb - 1]; - if (ca >= lbound && ca <= ubound) { - ca += delta; - } - if (cb >= lbound && cb <= ubound) { - cb += delta; - } - if (ca == cb) { - ++pa; - ++pb; - } else { - ret_val = FALSE_; - done = TRUE_; - -/* We'll return from this point, having taken no further */ -/* action. */ - - } - } - if (! done) { - if (pa > lena) { - -/* Whichever of the following tests passes, we're going */ -/* to have a verdict at the end of the IF block below. */ - - if (pb > lenb) { - ret_val = TRUE_; - } else if (s_cmp(b + (pb - 1), " ", b_len - (pb - 1), ( - ftnlen)1) != 0) { - ret_val = FALSE_; - } else { - ret_val = TRUE_; - } - done = TRUE_; - -/* We'll return from this point, having taken no further */ -/* action. */ - - } else if (pb > lenb) { - -/* Whichever of the following tests passes, we're going */ -/* to have a verdict at the end of the IF block below. */ - - if (s_cmp(a + (pa - 1), " ", a_len - (pa - 1), (ftnlen)1) - != 0) { - ret_val = FALSE_; - } else { - ret_val = TRUE_; - } - done = TRUE_; - -/* We'll return from this point, having taken no further */ -/* action. */ - - } - } - } - } - return ret_val; -} /* eqstr_ */ - diff --git a/ext/spice/src/cspice/eqstr_c.c b/ext/spice/src/cspice/eqstr_c.c deleted file mode 100644 index 48a3e46788..0000000000 --- a/ext/spice/src/cspice/eqstr_c.c +++ /dev/null @@ -1,487 +0,0 @@ -/* - --Procedure eqstr_c ( Equivalent strings ) - --Abstract - - Determine whether two strings are equivalent. - --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 - - ALPHANUMERIC - ASCII - CHARACTER - COMPARE - PARSING - SEARCH - STRING - TEXT - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceBoolean eqstr_c ( ConstSpiceChar * a, ConstSpiceChar * b ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a, - b I Arbitrary character strings. - - The function returns SPICETRUE if A and B are equivalent. - --Detailed_Input - - a, - b are arbitrary character strings. - --Detailed_Output - - The function returns TRUE if A and B are equivalent: that is, - if A and B contain the same characters in the same order, - when white space characters are ignored and uppercase and lowercase - characters are considered equal. - - White space characters are those in the set - - { ' ', '\f', '\n', '\r', '\t', '\v' } - - Note that this specification differs from that of the Fortran version - of this routine, which considers the blank ( ' ' ) to be the only - white space character. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If either input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - --Particulars - - This routine is provided for those cases in which two strings - must be compared, and in which allowances are to be made for - extra (leading, trailing, and embedded) blanks and differences - in case. For the most part, - - if ( eqstr_c ( A, B ) ) - . - . - - is true whenever - - cmprss_c ( ' ', 0, a, MAXLEN, tempa ); - ucase_c ( tempa, MAXLEN, tempa ); - - cmprss_c ( ' ', 0, b, MAXLEN, tempb ); - ucase_c ( tempb, MAXLEN, tempb ); - - - if ( !strcmp ( tempa, tempb ) ) - . - . - - is true. There are two important differences, however. - - 1) The single reference to eqstr_c is much simpler to - write, and simpler to understand. - - 2) The reference to eqstr_c does not require any temporary - storage, nor does it require that the strings a and b - be changed. This feature is especially useful when - comparing strings recieved as subprogram arguments - against strings stored internally within the subprogram. - - --Examples - - - Usage - -------------------------------------------- - - All of the following are TRUE. - - eqstr_c ( "A short string ", - "ashortstring" ); - - eqstr_c ( "Embedded blanks", - "Em be dd ed bl an ks" ); - - eqstr_c ( "Embedded blanks", - " Embeddedblanks" ); - - eqstr_c ( " ", - " " ); - - - All of the following are FALSE. - - eqstr_c ( "One word left out", - "WORD LEFT OUT" ); - - eqstr_c ( "Extra [] delimiters", - "extradelimiters" ); - - eqstr_c ( "Testing 1, 2, 3", - "TESTING123" ); - - - Use - -------------------------------------------- - - The following illustrates a typical use for eqstr_c. - - #include "SpiceUsr.h" - . - . - . - SpiceChar * greeting ( SpiceChar *who ) - { - - if ( eqstr_c ( who, "Steve" ) ) - { - return ( "Yes, sir?" ); - } - else if ( eqstr_c ( who, "Chuck" ) ) - { - return ( "What can I do for you?" ); - } - else - { - return ( "Whaddya want?" ); - } - } - - Note that all of the following calls will elicit the - greeting "Yes, sir?": - - greeting ( "STEVE" ); - greeting ( "steve" ); - greeting ( "Steve" ); - greeting ( "sTEVE" ); - greeting ( " S T E V E " ); - --Restrictions - - None. - --Literature_References - - 1) "American National Standard for Programming Languages -- C," - Published by the American National Standards Institute, 1990. - Section 7.3.1.9., p. 104. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.3.0, 27-AUG-1999 (NJB) - - Added check for null input strings. Added logic to handle the - case where at least one input string is empty. - - -CSPICE Version 1.2.0, 24-FEB-1999 (NJB) - - Arguments passed to isspace are now cast to unsigned char to - suppress compilation warnings on some systems. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - Initial assignment of return value added to suppress compilation - warnings on some systems. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.2.0, 03-AUG-1994 (NJB) - --Index_Entries - - equivalent strings - --& -*/ - -{ /* Begin eqstr_c */ - - /* - Local constants - */ - #define LBOUND ( (SpiceInt) 'a' ) - #define UBOUND ( (SpiceInt) 'z' ) - #define DELTA ( ( (SpiceInt) 'A' ) - LBOUND ) - - - /* - Local variables - */ - SpiceBoolean done; - SpiceBoolean retval; - - ConstSpiceChar * pa; - ConstSpiceChar * pb; - - SpiceInt ca; - SpiceInt cb; - - SpiceInt lenA; - SpiceInt lenB; - - - /* - Initialize the return value retval in order to make certain - compilers happy. This initial value is not used later; retval - is set explicitly in each case below. - */ - retval = SPICEFALSE; - - - /* - Check the input string pointers to make sure they're non-null. - */ - CHKPTR_VAL ( CHK_DISCOVER, "eqstr_c", a, retval ); - CHKPTR_VAL ( CHK_DISCOVER, "eqstr_c", b, retval ); - - - /* - The general plan is to move a pair of pointers (PA, PB) - through strings A and B, skipping blank characters and - comparing others one-for-one. - - Repeat: - - If (A is blank) then - Increment A - - Else if (B is blank) then - Increment B - - Else - If (A and B are equivalent) then - Increment A and B - Else - Return FALSE - - If (A and B are past end) then - Return TRUE - - Else if (A or B is past end and other is non-blank) then - Return FALSE - - Else if (A or B is past end and other is blank) then - Return TRUE - - Note that no pointer gets incremented more than once on each - pass through the loop. - - On the other hand, in many cases the strings will be exactly - equal. If so, why knock ourselves out? - */ - - if ( !strcmp( a, b ) ) - { - return ( SPICETRUE ); - } - - pa = a; - pb = b; - lenA = strlen(a); - lenB = strlen(b); - - - /* - The possibility of an input string being empty does not occur in - Fortran, but it does here. Handle these cases (the case where both - are empty was handled by the strcmp test above). - */ - - if ( ( lenA == 0 ) && ( lenB > 0 ) ) - { - return ( SPICEFALSE ); - } - - if ( ( lenB == 0 ) && ( lenA > 0 ) ) - { - return ( SPICEFALSE ); - } - - - /* - On with the normal path. - */ - - done = SPICEFALSE; - - - while ( !done ) - { - - /* - At this point, we're guaranteed that strings a and b have more - characters to examine, that is: - - ( pa <= a+lenA-1 ) and ( pb <= b+lenB-1 ) - - */ - - - if ( isspace( (unsigned char) *pa ) ) - { - pa++; - } - else if ( isspace( (unsigned char) *pb) ) - { - pb++; - } - else - { - - ca = (SpiceInt)(*pa); - cb = (SpiceInt)(*pb); - - if ( ( ca >= LBOUND ) && ( ca <= UBOUND ) ) - { - ca = ca + DELTA; - } - - if ( ( cb >= LBOUND ) && ( cb <= UBOUND ) ) - { - cb = cb + DELTA; - } - - if ( ca == cb ) - { - pa++; - pb++; - } - else - { - /* - We now know the strings don't match. - */ - retval = SPICEFALSE; - done = SPICETRUE; - } - } - - if ( !done ) - { - /* - At this point, the strings still match and we've advanced - at least one of the pointers. - */ - - - if ( ( (SpiceInt)(pa-a) ) == lenA ) - { - /* - There are no more characters in string a to examine. The - rest of string b had better be white space, or else we had - better be at the end of string b. - */ - - if ( ( (SpiceInt)(pb-b) ) == lenB ) - { - /* - We've seen all of string b. - */ - - retval = SPICETRUE; - done = SPICETRUE; - } - else if ( iswhsp_c(pb) ) - { - retval = SPICETRUE; - done = SPICETRUE; - } - else - { - retval = SPICEFALSE; - done = SPICETRUE; - } - } - /* - End of "no more characters in string a" case. - */ - - else if ( ( (SpiceInt)(pb-b) ) == lenB ) - { - /* - There are no more characters in string b to examine. The - rest of string a had better be white space. - */ - if ( iswhsp_c(pa) ) - { - retval = SPICETRUE; - done = SPICETRUE; - } - else - { - retval = SPICEFALSE; - done = SPICETRUE; - } - } - - /* - End of "no more characters in string b" case. - */ - } - /* - At this point, we've handled the cases where at least one - string is out of characters. If such a case occurred, done - has been set to SPICETRUE. - */ - - } - /* - End of while loop. retval has been set. - */ - - return (retval); - - -} /* End eqstr_c */ diff --git a/ext/spice/src/cspice/erf_.c b/ext/spice/src/cspice/erf_.c deleted file mode 100644 index f7565ae6ae..0000000000 --- a/ext/spice/src/cspice/erf_.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double erf(); -double erf_(x) real *x; -#else -extern double erf(double); -double erf_(real *x) -#endif -{ -return( erf(*x) ); -} diff --git a/ext/spice/src/cspice/erfc_.c b/ext/spice/src/cspice/erfc_.c deleted file mode 100644 index 56adb2f910..0000000000 --- a/ext/spice/src/cspice/erfc_.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double erfc(); -double erfc_(x) real *x; -#else -extern double erfc(double); -double erfc_(real *x) -#endif -{ -return( erfc(*x) ); -} diff --git a/ext/spice/src/cspice/err.c b/ext/spice/src/cspice/err.c deleted file mode 100644 index e25d19f20b..0000000000 --- a/ext/spice/src/cspice/err.c +++ /dev/null @@ -1,270 +0,0 @@ -#ifndef NON_UNIX_STDIO -#define _INCLUDE_POSIX_SOURCE /* for HP-UX */ -#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ -#include "sys/types.h" -#include "sys/stat.h" -#endif -#include "f2c.h" -#ifdef KR_headers -extern char *malloc(); -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -#endif -#include "fio.h" -#include "fmt.h" /* for struct syl */ - -/*global definitions*/ -unit f__units[MXUNIT]; /*unit table*/ -flag f__init; /*0 on entry, 1 after initializations*/ -cilist *f__elist; /*active external io list*/ -icilist *f__svic; /*active internal io list*/ -flag f__reading; /*1 if reading, 0 if writing*/ -flag f__cplus,f__cblank; -char *f__fmtbuf; -flag f__external; /*1 if external io, 0 if internal */ -#ifdef KR_headers -int (*f__doed)(),(*f__doned)(); -int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)(); -int (*f__getn)(); /* for formatted input */ -void (*f__putn)(); /* for formatted output */ -#else -int (*f__getn)(void); /* for formatted input */ -void (*f__putn)(int); /* for formatted output */ -int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); -int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void); -#endif -flag f__sequential; /*1 if sequential io, 0 if direct*/ -flag f__formatted; /*1 if formatted io, 0 if unformatted*/ -FILE *f__cf; /*current file*/ -unit *f__curunit; /*current unit*/ -int f__recpos; /*place in current record*/ -int f__cursor, f__hiwater, f__scale; -char *f__icptr; - -/*error messages*/ -char *F_err[] = -{ - "error in format", /* 100 */ - "illegal unit number", /* 101 */ - "formatted io not allowed", /* 102 */ - "unformatted io not allowed", /* 103 */ - "direct io not allowed", /* 104 */ - "sequential io not allowed", /* 105 */ - "can't backspace file", /* 106 */ - "null file name", /* 107 */ - "can't stat file", /* 108 */ - "unit not connected", /* 109 */ - "off end of record", /* 110 */ - "truncation failed in endfile", /* 111 */ - "incomprehensible list input", /* 112 */ - "out of free space", /* 113 */ - "unit not connected", /* 114 */ - "read unexpected character", /* 115 */ - "bad logical input field", /* 116 */ - "bad variable type", /* 117 */ - "bad namelist name", /* 118 */ - "variable not in namelist", /* 119 */ - "no end record", /* 120 */ - "variable count incorrect", /* 121 */ - "subscript for scalar variable", /* 122 */ - "invalid array section", /* 123 */ - "substring out of bounds", /* 124 */ - "subscript out of bounds", /* 125 */ - "can't read file", /* 126 */ - "can't write file", /* 127 */ - "'new' file exists", /* 128 */ - "can't append to file", /* 129 */ - "non-positive record number" /* 130 */ -}; -#define MAXERR (sizeof(F_err)/sizeof(char *)+100) - -#ifdef KR_headers -f__canseek(f) FILE *f; /*SYSDEP*/ -#else -f__canseek(FILE *f) /*SYSDEP*/ -#endif -{ -#ifdef NON_UNIX_STDIO - return !isatty(fileno(f)); -#else - struct stat x; - - if (fstat(fileno(f),&x) < 0) - return(0); -#ifdef S_IFMT - switch(x.st_mode & S_IFMT) { - case S_IFDIR: - case S_IFREG: - if(x.st_nlink > 0) /* !pipe */ - return(1); - else - return(0); - case S_IFCHR: - if(isatty(fileno(f))) - return(0); - return(1); -#ifdef S_IFBLK - case S_IFBLK: - return(1); -#endif - } -#else -#ifdef S_ISDIR - /* POSIX version */ - if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) { - if(x.st_nlink > 0) /* !pipe */ - return(1); - else - return(0); - } - if (S_ISCHR(x.st_mode)) { - if(isatty(fileno(f))) - return(0); - return(1); - } - if (S_ISBLK(x.st_mode)) - return(1); -#else - Help! How does fstat work on this system? -#endif -#endif - return(0); /* who knows what it is? */ -#endif -} - - void -#ifdef KR_headers -f__fatal(n,s) char *s; -#else -f__fatal(int n, char *s) -#endif -{ - if(n<100 && n>=0) perror(s); /*SYSDEP*/ - else if(n >= (int)MAXERR || n < -1) - { fprintf(stderr,"%s: illegal error number %d\n",s,n); - } - else if(n == -1) fprintf(stderr,"%s: end of file\n",s); - else - fprintf(stderr,"%s: %s\n",s,F_err[n-100]); - if (f__curunit) { - fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); - fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", - f__curunit->ufnm); - } - else - fprintf(stderr,"apparent state: internal I/O\n"); - if (f__fmtbuf) - fprintf(stderr,"last format: %s\n",f__fmtbuf); - fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", - f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", - f__external?"external":"internal"); - sig_die(" IO", 1); -} -/*initialization routine*/ - VOID -f_init(Void) -{ unit *p; - - f__init=1; - p= &f__units[0]; - p->ufd=stderr; - p->useek=f__canseek(stderr); - p->ufmt=1; - p->uwrt=1; - p = &f__units[5]; - p->ufd=stdin; - p->useek=f__canseek(stdin); - p->ufmt=1; - p->uwrt=0; - p= &f__units[6]; - p->ufd=stdout; - p->useek=f__canseek(stdout); - p->ufmt=1; - p->uwrt=1; -} -#ifdef KR_headers -f__nowreading(x) unit *x; -#else -f__nowreading(unit *x) -#endif -{ - long loc; - int ufmt, urw; - extern char *f__r_mode[], *f__w_mode[]; - - if (x->urw & 1) - goto done; - if (!x->ufnm) - goto cantread; - ufmt = x->url ? 0 : x->ufmt; - loc = ftell(x->ufd); - urw = 3; - if (!freopen(x->ufnm, f__w_mode[ufmt|2], x->ufd)) { - urw = 1; - if(!freopen(x->ufnm, f__r_mode[ufmt], x->ufd)) { - cantread: - errno = 126; - return 1; - } - } - fseek(x->ufd,loc,SEEK_SET); - x->urw = urw; - done: - x->uwrt = 0; - return 0; -} -#ifdef KR_headers -f__nowwriting(x) unit *x; -#else -f__nowwriting(unit *x) -#endif -{ - long loc; - int ufmt; - extern char *f__w_mode[]; - - if (x->urw & 2) - goto done; - if (!x->ufnm) - goto cantwrite; - ufmt = x->url ? 0 : x->ufmt; - if (x->uwrt == 3) { /* just did write, rewind */ - if (!(f__cf = x->ufd = - freopen(x->ufnm,f__w_mode[ufmt],x->ufd))) - goto cantwrite; - x->urw = 2; - } - else { - loc=ftell(x->ufd); - if (!(f__cf = x->ufd = - freopen(x->ufnm, f__w_mode[ufmt |= 2], x->ufd))) - { - x->ufd = NULL; - cantwrite: - errno = 127; - return(1); - } - x->urw = 3; - fseek(x->ufd,loc,SEEK_SET); - } - done: - x->uwrt = 1; - return 0; -} - - int -#ifdef KR_headers -err__fl(f, m, s) int f, m; char *s; -#else -err__fl(int f, int m, char *s) -#endif -{ - if (!f) - f__fatal(m, s); - if (f__doend) - (*f__doend)(); - return errno = m; - } diff --git a/ext/spice/src/cspice/erract.c b/ext/spice/src/cspice/erract.c deleted file mode 100644 index aecf6b0f08..0000000000 --- a/ext/spice/src/cspice/erract.c +++ /dev/null @@ -1,495 +0,0 @@ -/* erract.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__2 = 2; - -/* $Procedure ERRACT ( Get/Set Default Error Action ) */ -/* Subroutine */ int erract_(char *op, char *action, ftnlen op_len, ftnlen - action_len) -{ - /* Initialized data */ - - static char actns[7*5] = "ABORT " "REPORT " "RETURN " "IGNORE " "DEFAULT" - ; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2]; - char ch__1[73], ch__2[65]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - integer iact; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - char locop[3]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char locact[7]; - extern /* Subroutine */ int getact_(integer *); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), putact_(integer *), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Retrieve or set the default error action. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OP I Operation -- 'GET' or 'SET' */ -/* ACTION I/O Error response action */ - -/* $ Detailed_Input */ - -/* OP Indicates the operation -- 'GET' or 'SET'. 'GET' means, */ -/* "Set ACTION to the current value of the error response */ -/* action." */ -/* 'SET' means, "update the error response action to the */ -/* value indicated by ACTION." */ - -/* OP may be in mixed case; for example, */ - -/* CALL ERRACT ( 'gEt', ACTION ) */ - -/* will work. */ - - -/* ACTION When OP is 'SET', ACTION is an input argument. It */ -/* takes the values, 'ABORT', 'IGNORE', */ -/* 'REPORT', 'RETURN', and 'DEFAULT'. */ - -/* Please read the "required reading" file if you */ -/* haven't already done so! */ - -/* Briefly, the meanings of the error response */ -/* choices are as follows: */ - -/* 1. 'ABORT' -- When an error is detected by a */ -/* SPICELIB routine, or when */ -/* ANY routine signals detection */ -/* of an error via a call to SIGERR, the */ -/* toolkit will output any error messages that */ -/* it has been enabled to output (see ERRPRT */ -/* and ERRDEV also ), and then execute a */ -/* FORTRAN STOP statement. */ - -/* 2. 'REPORT' -- In this mode, the toolkit does */ -/* NOT abort when errors are detected. */ -/* When SIGERR is called to report */ -/* an error, all error messages that the toolkit */ -/* is enabled to output will be sent to the */ -/* designated error output device. Similarly, */ -/* a call to SETMSG will result in the long */ -/* error message being output, if the toolkit */ -/* is enabled to output it. */ - - -/* 3. 'RETURN' -- In this mode, the toolkit also */ -/* does NOT abort when errors are */ -/* detected. Instead, error messages */ -/* are output if the toolkit is enabled to do */ -/* so, and subsequently, ALL TOOLKIT ROUTINES */ -/* RETURN IMMEDIATELY UPON ENTRY until the */ -/* error status is reset via a call to RESET. */ -/* (No, RESET itself doesn't return on entry). */ -/* Resetting the error status will cause the */ -/* toolkit routines to resume their normal */ -/* execution threads. */ - - - -/* 4. 'IGNORE' -- The toolkit will not take any */ -/* action in response to errors; */ -/* calls to SIGERR will have no */ -/* effect. */ - - -/* 5. 'DEFAULT' -- This mode is the same as 'ABORT', */ -/* except that an additional error */ -/* message is output. The additional */ -/* message informs the user that the */ -/* error response action can be */ -/* modified, and refers to documentation */ -/* of the error handling feature. */ - - - -/* ACTION may be in mixed case; for example, */ - -/* CALL ERRACT ( 'SET', 'igNORe' ) */ - -/* will work. */ - -/* $ Detailed_Output */ - -/* ACTION When OP is 'GET', ACTION is the current error response */ -/* action. Possible values are: 'ABORT', 'REPORT', */ -/* 'RETURN', and 'IGNORE'. See "Detailed Input" */ -/* for descriptions of the meanings of these values. */ - -/* ACTION is not an output unless OP is 'GET'. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine detects invalid values of OP and ACTION. */ - -/* The short error messages set by this routine are: */ - -/* 1. 'SPICE(INVALIDOPERATION)' -- bad OP value */ -/* 2. 'SPICE(INVALIDACTION)' -- bad ACTION value. */ - - -/* Also, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* First of all, please read the ``required reading'' file. */ -/* The information below will make a lot more sense if you do. */ - -/* Here is a brief discussion of how to use this routine. */ - -/* If you are a user, you will probably be interested */ -/* in only the 'SET' operation (as far as this routine is */ -/* concerned, ok?). As indicated in the "detailed */ -/* input" section above, the choices for ACTION are */ -/* 'ABORT', 'REPORT', 'RETURN', 'IGNORE', and 'DEFAULT'. These */ -/* choices control the way the toolkit behaves when an */ -/* error is detected. The toolkit thinks an error has */ -/* been detected when SIGERR is called. */ - -/* 1. 'ABORT' In this mode, the toolkit sends error messages */ -/* to the error output device and then stops. */ -/* This is the default mode. It is probably */ -/* the one to choose for running non-interactive programs. */ -/* You may also wish to use this for programs which */ -/* have many bugs, or in other cases where continued */ -/* operation following detection of an error isn't useful. */ - -/* 2. 'REPORT' In this mode, the toolkit sends error messages */ -/* to the error output device and keeps going. This mode */ -/* may be useful if you are debugging a large program, */ -/* since you can get more information from a single test run. */ -/* You will probably want to use ERRDEV to indicate a file */ -/* where your error messages should be sent. */ - -/* 3. 'RETURN' In this mode, the toolkit also sends error messages */ -/* to the error output device and "keeps going". But */ -/* instead of following their normal execution threads, */ -/* the toolkit routines will simply return immediately upon */ -/* entry, once an error has been detected. */ -/* The availability of this feature makes it safe to call */ -/* multiple toolkit routines without checking the error */ -/* status after each one returns; if one routine detects */ -/* an error, subsequent calls to toolkit routines will have */ -/* no effect; therefore, no crash will occur. The error */ -/* messages set by the routine which detected the error */ -/* will remain available for retrieval by GETMSG. */ - -/* 4. 'IGNORE' This mode can be dangerous! It is best */ -/* used when running a program whose behavior you */ -/* understand well, in cases where you wish to suppress */ -/* annoying messages. BUT, if an unexpected error */ -/* occurs, you won't hear about it from anyone, except */ -/* possibly your run-time system. */ - -/* 5. 'DEFAULT' As the name suggests, this is the default */ -/* error handling mode. The error handling mechanism */ -/* starts out in this mode when a program using the */ -/* toolkit is run, and the mode remains 'DEFAULT' until */ -/* it is changed via a call to this routine. */ -/* This mode is the same as 'ABORT', */ -/* except that an additional error message is output. */ -/* The additional message informs the user that the */ -/* error response action can be modified, and refers */ -/* to documentation of the error handling feature. */ - - -/* NOTE: */ - -/* By default, error messages are printed to the screen */ -/* when errors are detected. You may want to send them */ -/* to a different output device, or choose a subset to */ -/* output. Use the routines ERRDEV and ERRPRT to choose */ -/* the output device and select the messages to output, */ -/* respectively. */ - -/* You can also suppress the automatic output of messages */ -/* and retrieve them directly in your own program. GETMSG */ -/* can be used for this. To make sure that the messages */ -/* retrieved correspond to the FIRST error that occurred, */ -/* use 'RETURN' mode. In 'REPORT' mode, new messages */ -/* overwrite old ones in the SPICELIB message storage */ -/* area, so GETMSG will get the messages from the LATEST */ -/* error that occurred. */ - - -/* $ Examples */ - - -/* 1. Setting up 'ABORT' mode: */ - - -/* C */ -/* C We wish to have our program abort if an error */ -/* C is detected. But instead of having the error */ -/* C messages printed on the screen, we want them */ -/* C to be written to the file, ERROR_LOG.DAT */ -/* C (This is valid VAX/VMS file name; syntax */ -/* C on your system may be different ). */ -/* C */ -/* C We want to see all of the messages, so we */ -/* C call ERRPRT, using the 'ALL' option. */ -/* C */ -/* C Finally, we call ERRACT to set the action to 'ABORT': */ -/* C */ - -/* CALL ERRDEV ( 'SET', 'ERROR_LOG.DAT' ) */ - -/* CALL ERRPRT ( 'SET', 'ALL' ) */ - -/* CALL ERRACT ( 'SET', 'ABORT' ) */ - - - -/* 2. Setting up 'REPORT' mode: */ - -/* C */ -/* C This is the same thing as before, except */ -/* C that the argument supplied to ERRACT */ -/* C is different. */ -/* C */ - -/* CALL ERRDEV ( 'SET', 'ERROR_LOG.DAT' ) */ - -/* CALL ERRPRT ( 'SET', 'ALL' ) */ - -/* CALL ERRACT ( 'SET', 'REPORT' ) */ - - -/* 3. Setting up 'RETURN' mode: This is the same */ -/* as example #2, except that the ERRACT call becomes: */ - -/* CALL ERRACT ( 'SET', 'RETURN' ) */ - - - -/* 4. Setting up 'IGNORE' mode: */ - -/* C In this case, we aren't going to have */ -/* C ANY error messages (unless the call */ -/* C to ERRACT itself fails), so we don't */ -/* C really need to call ERRPRT and ERRDEV. */ -/* C (If the call to ERRACT DOES fail, which */ -/* C it can do only if we misspell "IGNORE," */ -/* C the resulting error messages will go to */ -/* C the screen). */ - - -/* CALL ERRACT ( 'SET', 'IGNORE' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the error action passed to PUTACT from a short */ -/* character string to an integer. This change is backwardly */ -/* incompatible because the type of the input argument has */ -/* changed. This should pose no difficulties because PUTACT is a */ -/* private subroutine used by the error handling system, and */ -/* hence isolated from direct use. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get/set default error action */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the error action passed to PUTACT from a short */ -/* character string to an integer. This change is backwardly */ -/* incompatible because the type of the input argument has */ -/* changed. This should pose no difficulties because PUTACT is a */ -/* private subroutine used by the error handling system, and */ -/* hence isolated from direct use. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - Beta Version 1.1.0, 28-FEB-1989 (NJB) */ - -/* Trace participation added. This routine now checks in */ -/* and checks out. However, it does not test RETURN, */ -/* because it should be able to execute in RETURN mode when */ -/* an error condition exists. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - -/* Define the length of an option. */ - - -/* Define the maximum length of an action. */ - - -/* Define the number of actions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial Values: */ - - -/* Executable Code: */ - - chkin_("ERRACT", (ftnlen)6); - -/* We convert the input values to upper case, as needed. Note: we */ -/* only check the first character of the input variable OP, as that */ -/* is sufficient to distinguish 'GET' from 'SET' */ - - ljust_(op, locop, op_len, (ftnlen)3); - ucase_(locop, locop, (ftnlen)3, (ftnlen)3); - if (s_cmp(locop, "GET", (ftnlen)3, (ftnlen)3) == 0) { - getact_(&iact); - s_copy(action, actns + ((i__1 = iact - 1) < 5 && 0 <= i__1 ? i__1 : - s_rnge("actns", i__1, "erract_", (ftnlen)442)) * 7, - action_len, (ftnlen)7); - } else if (s_cmp(locop, "SET", (ftnlen)3, (ftnlen)3) == 0) { - ljust_(action, locact, action_len, (ftnlen)7); - ucase_(locact, locact, (ftnlen)7, (ftnlen)7); - iact = isrchc_(locact, &c__5, actns, (ftnlen)7, (ftnlen)7); - if (iact > 0) { - putact_(&iact); - } else { - -/* We have an invalid value of ACTION */ - - s_copy(locact, action, (ftnlen)7, action_len); -/* Writing concatenation */ - i__2[0] = 66, a__1[0] = "ERRACT: An invalid value of ACTION was " - "supplied. The value was: "; - i__2[1] = 7, a__1[1] = locact; - s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)73); - setmsg_(ch__1, (ftnlen)73); - sigerr_("SPICE(INVALIDACTION)", (ftnlen)20); - } - -/* We've set the error action, or signalled an error. */ - - } else { - -/* We have an invalid value of OP */ - - s_copy(locop, op, (ftnlen)3, op_len); -/* Writing concatenation */ - i__2[0] = 62, a__1[0] = "ERRACT: An invalid value of OP was supplied" - ". The value was: "; - i__2[1] = 3, a__1[1] = locop; - s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)65); - setmsg_(ch__2, (ftnlen)65); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - } - -/* We've performed the requested operation, or signalled an */ -/* error. */ - - chkout_("ERRACT", (ftnlen)6); - return 0; -} /* erract_ */ - diff --git a/ext/spice/src/cspice/erract_c.c b/ext/spice/src/cspice/erract_c.c deleted file mode 100644 index c7efcd43d3..0000000000 --- a/ext/spice/src/cspice/erract_c.c +++ /dev/null @@ -1,432 +0,0 @@ -/* - --Procedure erract_c ( Get/Set Default Error Action ) - --Abstract - - Retrieve or set the default error action. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void erract_c ( ConstSpiceChar * op, - SpiceInt lenout, - SpiceChar * action ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - op I Operation -- "GET" or "SET" - lenout I Length of list for output. - action I/O Error response action - --Detailed_Input - - op indicates the operation -- "GET" or "SET". "GET" means, - "Set action to the current value of the error response - action." "SET" means, "update the error response action to - the value indicated by action." - - op may be in mixed case; for example, - - erract_c ( "gEt", lenout, action ); - - will work. - - lenout is the string size of output 'action' when op equals "GET." - The size described by lenout should be large enough to - hold all characters of any possible output string - plus 1 (to accommodate the C null terminator). - - action is an input argument when op is "SET." It takes the - values, "ABORT", "IGNORE", "REPORT", "RETURN", and - "DEFAULT". - - Briefly, the meanings of the error response - choices are as follows: - - 1. "ABORT" -- When an error is detected by a - CSPICE routine, or when - ANY routine signals detection - of an error via a call to sigerr_c, the - toolkit will output any error messages that - it has been enabled to output (see errprt_c - and errdev_c also ), and then execute an - exit statement. - - 2. "REPORT" -- In this mode, the toolkit does - NOT abort when errors are detected. - When sigerr_c is called to report - an error, all error messages that the toolkit - is enabled to output will be sent to the - designated error output device. Similarly, - a call to setmsg_c will result in the long - error message being output, if the toolkit - is enabled to output it. - - - 3. "RETURN" -- In this mode, the toolkit also - does NOT abort when errors are - detected. Instead, error messages - are output if the toolkit is enabled to do - so, and subsequently, ALL TOOLKIT ROUTINES - RETURN IMMEDIATELY UPON ENTRY until the - error status is reset via a call to RESET. - (No, RESET itself doesn't return on entry). - Resetting the error status will cause the - toolkit routines to resume their normal - execution threads. - - - - 4. "IGNORE" -- The toolkit will not take any - action in response to errors; - calls to sigerr_c will have no - effect. - - - 5. "DEFAULT" -- This mode is the same as "ABORT", - except that an additional error - message is output. The additional - message informs the user that the - error response action can be - modified, and refers to documentation - of the error handling feature. - - - action may be in mixed case; for example, - - erract_c ( "SET", lenout,"igNORe" ); - - will work. - --Detailed_Output - - action is an output argument returning the current error - response action when 'op' equals "GET." Possible values - are: "ABORT", "REPORT", "RETURN", and "IGNORE". - See "Detailed Input" for descriptions of these values. - --Parameters - - None. - --Exceptions - - 1) If the input argument op does not indicate a valid operation, - the error SPICE(INVALIDOPERATION) will be signaled. - - 2) When op is "SET", if the input argument action does not indicate a - valid error handling action, the error SPICE(INVALIDACTION) will - be signaled. - - 3) The error SPICE(EMPTYSTRING) is signaled if either input string - does not contain at least one character, since an input string - cannot be converted to a Fortran-style string in this case. This - check always applies to op; it applies to action only when - action is an input, that is, when op is "SET." - - 4) The error SPICE(NULLPOINTER) is signaled if either string pointer - argument is null. - - 5) The caller must pass a value indicating the length of the output - string, when action is an output. If this value is not at least - 2, the error SPICE(STRINGTOOSHORT) is signaled. - --Files - - None. - --Particulars - - As indicated in the "detailed input" section above, the choices for - the Toolkit's error handling action are designated by the strings - "ABORT", "REPORT", "RETURN", "IGNORE", and "DEFAULT". These - choices control the way the toolkit behaves when an error is - detected. The toolkit thinks an error has been detected when - sigerr_c is called. - - 1. "ABORT" In this mode, the toolkit sends error messages - to the error output device and then stops. - This is the default mode. It is probably - the one to choose for running non-interactive programs. - You may also wish to use this for programs which - have many bugs, or in other cases where continued - operation following detection of an error isn't useful. - - 2. "REPORT" In this mode, the toolkit sends error messages - to the error output device and keeps going. This mode - may be useful if you are debugging a large program, - since you can get more information from a single test run. - You will probably want to use errdev_c to indicate a file - where your error messages should be sent. - - 3. "RETURN" In this mode, the toolkit also sends error messages - to the error output device and "keeps going". But - instead of following their normal execution threads, - the toolkit routines will simply return immediately upon - entry, once an error has been detected. - The availability of this feature makes it safe to call - multiple toolkit routines without checking the error - status after each one returns; if one routine detects - an error, subsequent calls to toolkit routines will have - no effect; therefore, no crash will occur. The error - messages set by the routine which detected the error - will remain available for retrieval by getmsg_. - - 4. "IGNORE" This mode can be dangerous! It is best - used when running a program whose behavior you - understand well, in cases where you wish to suppress - annoying messages. BUT, if an unexpected error - occurs, you won't hear about it from anyone, except - possibly your run-time system. - - 5. "DEFAULT" As the name suggests, this is the default - error handling mode. The error handling mechanism - starts out in this mode when a program using the - toolkit is run, and the mode remains "DEFAULT" until - it is changed via a call to this routine. - This mode is the same as "ABORT", - except that an additional error message is output. - The additional message informs the user that the - error response action can be modified, and refers - to documentation of the error handling feature. - - - NOTE: - - By default, error messages are printed to the screen - when errors are detected. You may want to send them - to a different output device, or choose a subset to - output. Use the routines errdev_c and errprt_c to choose - the output device and select the messages to output, - respectively. - - You can also suppress the automatic output of messages - and retrieve them directly in your own program. getmsg_ - can be used for this. To make sure that the messages - retrieved correspond to the FIRST error that occurred, - use "RETURN" mode. In "REPORT" mode, new messages - overwrite old ones in the CSPICE message storage - area, so getmsg_ will get the messages from the LATEST - error that occurred. - - --Examples - - - 1. Setting up "ABORT" mode: - - /. - We wish to have our program abort if an error - is detected. But instead of having the error - messages printed on the screen, we want them - to be written to the file, ERROR_LOG.TXT - - We want to see all of the messages, so we - call errprt_c, using the "ALL" option. - - Finally, we call erract_c to set the action to "ABORT": - ./ - - errdev_c ( "SET", lenout, "ERROR_LOG.DAT" ); - - errprt_c ( "SET", lenout, "ALL" ); - - erract_c ( "SET", lenout, "ABORT" ); - - - - 2. Setting up "REPORT" mode: - - errdev_c ( "SET", lenout, "ERROR_LOG.DAT" ); - - errprt_c ( "SET", lenout, "ALL" ); - - erract_c ( "SET", lenout, "REPORT" ); - - - 3. Setting up "RETURN" mode: This is the same - as example #2, except that the erract_c call becomes: - - erract_c ( "SET", lenout, "RETURN" ); - - - - 4. Setting up "IGNORE" mode: - - /. - In this case, we aren't going to have - ANY error messages (unless the call - to erract_c itself fails), so we don't - really need to call errprt_c and errdev_c. - (If the call to erract_c DOES fail, which - it can do only if we misspell "IGNORE," - the resulting error messages will go to - the screen). - ./ - - erract_c ( "SET", lenout, "IGNORE" ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.3.1, 25-SEP-2003 (EDW) - - Corrected confusing description of 'lenout' argument. - - -CSPICE Version 1.3.0, 24-JUN-2003 (NJB) - - Bug fix: case of invalid operation keyword is now - diagnosed, as per the Exceptions section of the header. - - -CSPICE Version 1.2.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.1, 30-OCT-1997 (EDW) - - Corrected errors in examples in which the call sequence - was incorrect. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - get/set default error action - --& -*/ - -{ /* Begin erract_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "erract_c" ); - - - /* - Check the input string op to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "erract_c", op ); - - - if( eqstr_c ( op, "SET") ) - { - - /* - Operation is SET. "action" will be an input string. Check - action as well. - */ - CHKFSTR ( CHK_STANDARD, "erract_c", action ); - - /* - Call the f2c'd Fortran routine. - */ - erract_ ( ( char * ) op, - ( char * ) action, - ( ftnlen ) strlen(op), - ( ftnlen ) strlen(action) ); - } - - else if ( eqstr_c (op, "GET" ) ) - { - - /* - Operation is GET. "action" will be an output string. Make sure - the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "erract_c", action, lenout ); - - - /* - Call the f2c'd Fortran routine. - */ - erract_ ( ( char * ) op, - ( char * ) action, - ( ftnlen ) strlen(op), - ( ftnlen ) lenout-1 ); - - - F2C_ConvertStr( lenout, action ); - } - - else - { - setmsg_c ( "Input argument op had value: # " - "Valid choices are GET or SET." ); - errch_c ( "#", op ); - sigerr_c ( "SPICE(INVALIDOPERATION)" ); - chkout_c ( "erract_c" ); - return; - } - - - chkout_c ( "erract_c" ); - -} /* End erract_c */ - - diff --git a/ext/spice/src/cspice/errch.c b/ext/spice/src/cspice/errch.c deleted file mode 100644 index e5cc2a880a..0000000000 --- a/ext/spice/src/cspice/errch.c +++ /dev/null @@ -1,445 +0,0 @@ -/* errch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure ERRCH ( Insert String into Error Message Text ) */ -/* Subroutine */ int errch_(char *marker, char *string, ftnlen marker_len, - ftnlen string_len) -{ - /* System generated locals */ - address a__1[3], a__2[2]; - integer i__1, i__2, i__3[3], i__4[2]; - - /* Builtin functions */ - integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer nblen_(char *, ftnlen); - extern logical allowd_(void); - extern integer lastnb_(char *, ftnlen); - char lngmsg[1840]; - extern /* Subroutine */ int getlms_(char *, ftnlen); - extern integer frstnb_(char *, ftnlen); - char tmpmsg[1840]; - integer mrkpos; - extern /* Subroutine */ int putlms_(char *, ftnlen); - -/* $ Abstract */ - -/* Substitute a character string for the first occurrence of */ -/* a marker in the current long error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ -/* CONVERSION */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* MARKER I A substring of the error message to be replaced. */ -/* STRING I The character string to substitute for MARKER. */ - -/* $ Detailed_Input */ - - -/* MARKER is a character string that marks a position in */ -/* the long error message where a character string */ -/* is to be substituted. Leading and trailing blanks */ -/* in MARKER are not significant. */ - -/* Case IS significant: 'XX' is considered to be */ -/* a different marker from 'xx'. */ - -/* STRING is a character string that will be substituted for */ -/* the first occurrence of MARKER in the long error */ -/* message. This occurrence of the substring indicated */ -/* by MARKER will be removed and replaced by STRING. */ -/* Leading and trailing blanks in STRING are not */ -/* significant. However, if STRING is completely blank, */ -/* a single blank character will be substituted for */ -/* the marker. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* LMSGLN is the maximum length of the long error message. See */ -/* the include file errhnd.inc for the value of LMSGLN. */ - -/* $ Exceptions */ - -/* 1) If the character string resulting from the substitution */ -/* exceeds the maximum length of the long error message, the */ -/* long error message is truncated on the right. No error is */ -/* signalled. */ - -/* 2) If MARKER is blank, no substitution is performed. No error */ -/* is signalled. */ - -/* 3) If STRING is blank, then the first occurrence of MARKER is */ -/* replaced by a single blank. */ - -/* 4) If MARKER does not appear in the long error message, no */ -/* substitution is performed. No error is signalled. */ - -/* 5) If changes to the long error message are disabled, this */ -/* routine has no effect. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The purpose of this routine is to allow you to tailor the long */ -/* error message to include specific information that is available */ -/* only at run time. This capability is somewhat like being able to */ -/* put variables in your error messages. */ - -/* $ Examples */ - -/* 1) In this example, the marker is '#'. We'll signal a file */ -/* open error, and we'll include in the error message the name */ -/* of the file we tried to open. There are three steps: */ - -/* -- Set the long message, using a marker for the location */ -/* where a value is to be substituted. */ - -/* -- Substitute the file name into the error message. */ - -/* -- Signal the error (causing output of error messages) */ -/* using the SPICELIB routine SIGERR. */ - -/* C */ -/* C Error on file open attempt. Signal an error. */ -/* C The character string variable FILE contains the */ -/* C file name. */ -/* C */ -/* C After the call to ERRCH, the long error message */ -/* C will contain the file name held in the string */ -/* C FILE. For example, if FILE contains the name */ -/* C 'MYFILE.DAT', the long error message will be */ -/* C */ -/* C 'File open error. File is MYFILE.DAT.' */ -/* C */ - -/* CALL SETMSG ( 'File open error. File is #.' ) */ -/* CALL ERRCH ( '#', FILE ) */ -/* CALL SIGERR ( 'SPICE(FILEOPENFAILED)' ) */ - - -/* 2) Same example as (1), except this time we'll use a better- */ -/* looking and more descriptive marker than '#'. Instead, */ -/* we'll use the marker 'FILENAME'. This does not affect the */ -/* long error message; it just makes the code more readable. */ - -/* C */ -/* C Error on file open attempt. Signal an error. */ -/* C The character string variable FILE contains the */ -/* C file name. */ -/* C */ -/* CALL SETMSG ( 'File open error. File is FILENAME.') */ -/* CALL ERRCH ( 'FILENAME', FILE ) */ -/* CALL SIGERR ( 'SPICE(FILEOPENFAILED)' ) */ - - -/* 3) Same example as (2), except this time there's a problem with */ -/* the variable FILE: it's blank. This time, the code fragment */ - -/* C */ -/* C Error on file open attempt. Signal an error. */ -/* C The character string variable FILE contains the */ -/* C file name. */ -/* C */ -/* CALL SETMSG ( 'File open error. File is FILENAME.') */ -/* CALL ERRCH ( 'FILENAME', FILE ) */ - -/* sets the long error message to */ - -/* 'File open error. File is '. */ - - -/* $ Restrictions */ - -/* 1) The caller must ensure that the message length, after sub- */ -/* stitution is performed, doesn't exceed LMSGLN characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0 25-MAR-1991 (JEM) (NJB) */ - -/* When the input value of STRING is blank, this version */ -/* replaces the first occurrence of MARKER with a */ -/* single blank character. Header was edited to improve */ -/* clarity. Cosmetic changes to code were made. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert string into error message text */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. */ - -/* - SPICELIB Version 2.0.0 25-MAR-1991 (JEM) (NJB) */ - -/* When the input value of STRING is blank, this version */ -/* replaces the first occurrence of MARKER with a */ -/* single blank character. The previous version made */ -/* no substitution, leaving the marker in the long error */ -/* message. */ - -/* The $Exceptions, $Examples, and $Particulars sections were */ -/* updated to improve accuracy and clarity. Some cosmetic */ -/* changes were made as well. */ - -/* Also, some cosmetic changes to the code were made. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables: */ - - -/* Changes to the long error message must be allowed, or we do */ -/* nothing. */ - - if (! allowd_()) { - return 0; - } - -/* MARKER must have some non-blank characters, or we do nothing. */ - - if (lastnb_(marker, marker_len) == 0) { - return 0; - } - -/* Get a copy of the current long error message. */ - - getlms_(lngmsg, (ftnlen)1840); - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks): */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(lngmsg, marker + i__1, (ftnlen)1840, lastnb_(marker, - marker_len) - i__1); - if (mrkpos == 0) { - -/* MARKER does not occur in the long error message, so there's */ -/* no subsitution to perform. */ - - return 0; - } else { - -/* We put together TMPMSG, a copy of LNGMSG with MARKER */ -/* replaced by STRING. */ - - if (mrkpos > 1) { - -/* MARKER is not at the beginning of the long error message. */ - - if (mrkpos + nblen_(marker, marker_len) <= lastnb_(lngmsg, ( - ftnlen)1840)) { - -/* There's more of the long message after the marker. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) != 0) { - i__1 = frstnb_(string, string_len) - 1; - i__2 = mrkpos + nblen_(marker, marker_len) - 1; -/* Writing concatenation */ - i__3[0] = mrkpos - 1, a__1[0] = lngmsg; - i__3[1] = lastnb_(string, string_len) - i__1, a__1[1] = - string + i__1; - i__3[2] = 1840 - i__2, a__1[2] = lngmsg + i__2; - s_cat(tmpmsg, a__1, i__3, &c__3, (ftnlen)1840); - } else { - i__1 = mrkpos + nblen_(marker, marker_len) - 1; -/* Writing concatenation */ - i__3[0] = mrkpos - 1, a__1[0] = lngmsg; - i__3[1] = 1, a__1[1] = " "; - i__3[2] = 1840 - i__1, a__1[2] = lngmsg + i__1; - s_cat(tmpmsg, a__1, i__3, &c__3, (ftnlen)1840); - } - } else { - -/* The long error message ends with MARKER. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) != 0) { - i__1 = frstnb_(string, string_len) - 1; -/* Writing concatenation */ - i__4[0] = mrkpos - 1, a__2[0] = lngmsg; - i__4[1] = lastnb_(string, string_len) - i__1, a__2[1] = - string + i__1; - s_cat(tmpmsg, a__2, i__4, &c__2, (ftnlen)1840); - } else { -/* Writing concatenation */ - i__4[0] = mrkpos - 1, a__2[0] = lngmsg; - i__4[1] = 1, a__2[1] = " "; - s_cat(tmpmsg, a__2, i__4, &c__2, (ftnlen)1840); - } - } - } else { - -/* The long error message starts with MARKER (MRKPOS is 1). */ - - if (nblen_(marker, marker_len) < lastnb_(lngmsg, (ftnlen)1840)) { - -/* There's more of the long message after the marker... */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) != 0) { - i__1 = frstnb_(string, string_len) - 1; - i__2 = nblen_(marker, marker_len); -/* Writing concatenation */ - i__4[0] = lastnb_(string, string_len) - i__1, a__2[0] = - string + i__1; - i__4[1] = 1840 - i__2, a__2[1] = lngmsg + i__2; - s_cat(tmpmsg, a__2, i__4, &c__2, (ftnlen)1840); - } else { - i__1 = nblen_(marker, marker_len); -/* Writing concatenation */ - i__4[0] = 1, a__2[0] = " "; - i__4[1] = 1840 - i__1, a__2[1] = lngmsg + i__1; - s_cat(tmpmsg, a__2, i__4, &c__2, (ftnlen)1840); - } - } else { - -/* The marker's the whole string: */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) != 0) { - i__1 = frstnb_(string, string_len) - 1; - s_copy(tmpmsg, string + i__1, (ftnlen)1840, lastnb_( - string, string_len) - i__1); - } else { - s_copy(tmpmsg, " ", (ftnlen)1840, (ftnlen)1); - } - } - } - -/* Update the long error message: */ - - putlms_(tmpmsg, (ftnlen)1840); - } - return 0; -} /* errch_ */ - diff --git a/ext/spice/src/cspice/errch_c.c b/ext/spice/src/cspice/errch_c.c deleted file mode 100644 index cf418a6a58..0000000000 --- a/ext/spice/src/cspice/errch_c.c +++ /dev/null @@ -1,247 +0,0 @@ -/* - --Procedure errch_c ( Insert String into Error Message Text ) - --Abstract - - Substitute a character string for the first occurrence of - a marker in the current long error message. - --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 - - ERROR - --Keywords - - ERROR - CONVERSION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void errch_c ( ConstSpiceChar * marker, - ConstSpiceChar * string ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- --------------------------------------------------- - marker I A substring of the error message to be replaced. - string I The character string to substitute for marker. - --Detailed_Input - - - marker is a character string that marks a position in - the long error message where a character string - is to be substituted. Leading and trailing blanks - in marker are not significant. - - Case IS significant: "XX" is considered to be - a different marker from "xx". - - string is a character string that will be substituted for - the first occurrence of marker in the long error - message. This occurrence of the substring indicated - by marker will be removed and replaced by string. - Leading and trailing blanks in string are not - significant. However, if string is completely blank, - a single blank character will be substituted for - the marker. - --Detailed_Output - - None. - --Parameters - - LMSGLN is the maximum length of the long error message. See - the include file errhnd.inc for the value of LMSGLN. - --Exceptions - - 1) If the character string resulting from the substitution - exceeds the maximum length of the long error message, the - long error message is truncated on the right. No error is - signaled. - - 2) If marker is blank, no substitution is performed. No error - is signaled. - - 3) If string is blank, then the first occurrence of marker is - replaced by a single blank. - - 4) If marker does not appear in the long error message, no - substitution is performed. No error is signaled. - - 5) If changes to the long error message are disabled, this - routine has no effect. - - 6) The error SPICE(EMPTYSTRING) is signaled if either input string - does not contain at least one character, since an input string - cannot be converted to a Fortran-style string in this case. - - 7) The error SPICE(NULLPOINTER) is signalled if either string pointer - argument is null. - --Files - - None. - --Particulars - - The purpose of this routine is to allow you to tailor the long - error message to include specific information that is available - only at run time. This capability is somewhat like being able to - put variables in your error messages. - --Examples - - 1) In this example, the marker is "#". We'll signal a file - open error, and we'll include in the error message the name - of the file we tried to open. There are three steps: - - -- Set the long message, using a marker for the location - where a value is to be substituted. - - -- Substitute the file name into the error message. - - -- Signal the error (causing output of error messages) - using the CSPICE routine sigerr_c. - - /. - Error on file open attempt. Signal an error. - The character string variable FILE contains the - file name. - - After the call to errch_c, the long error message - will contain the file name held in the string - FILE. For example, if FILE contains the name - "MYFILE.DAT", the long error message will be - - "File open error. File is MYFILE.DAT." - - ./ - - setmsg_c ( "File open error. File is #." ); - errch_c ( "#", FILE ); - sigerr_c ( "SPICE(FILEOPENFAILED)" ); - - - 2) Same example as (1), except this time we'll use a better- - looking and more descriptive marker than "#". Instead, - we'll use the marker "FILENAME". This does not affect the - long error message; it just makes the code more readable. - - /. - Error on file open attempt. Signal an error. - The character string variable FILE contains the - file name. - ./ - - setmsg_c ( "File open error. File is FILENAME."); - errch_c ( "FILENAME", FILE ); - sigerr_c ( "SPICE(FILEOPENFAILED)" ); - - - 3) Same example as (2), except this time there's a problem with - the variable FILE: it's blank. This time, the code fragment - - /. - Error on file open attempt. Signal an error. - The character string variable FILE contains the - file name. - ./ - setmsg_c ( "File open error. File is FILENAME." ); - errch_c ( "FILENAME", FILE ); - - sets the long error message to - - "File open error. File is " - - --Restrictions - - 1) The caller must ensure that the message length, after sub- - stitution is performed, doesn't exceed LMSGLN characters. - See errch.c. - --Literature_References - - None. - --Author_and_Institution - - J.E. McLean (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - insert string into error message text - --& -*/ - -{ /* Begin errch_c */ - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. Since we don't check in - prior to this, use the discovery check-in option. - */ - CHKFSTR ( CHK_DISCOVER, "errch_c", marker ); - CHKFSTR ( CHK_DISCOVER, "errch_c", string ); - - - /* - Call the f2c'd Fortran routine. - */ - errch_ ( ( char * ) marker, - ( char * ) string, - ( ftnlen ) strlen(marker), - ( ftnlen ) strlen(string) ); - - -} /* End errch_c */ diff --git a/ext/spice/src/cspice/errdev.c b/ext/spice/src/cspice/errdev.c deleted file mode 100644 index 67b52e1d0d..0000000000 --- a/ext/spice/src/cspice/errdev.c +++ /dev/null @@ -1,420 +0,0 @@ -/* errdev.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ERRDEV ( Get/Set Error Output Device Name ) */ -/* Subroutine */ int errdev_(char *op, char *device, ftnlen op_len, ftnlen - device_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1[2]; - char ch__1[378], ch__2[65]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - char upop[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - char locop[3], upnam[255]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char locnam[255]; - extern /* Subroutine */ int getdev_(char *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), putdev_(char *, ftnlen); - -/* $ Abstract */ - -/* Retrieve or set the name of the current output */ -/* device for error messages. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OP I The operation: 'GET' or 'SET'. */ -/* DEVICE I/O The device name. */ -/* FILEN P Maximum length of file name. */ - -/* $ Detailed_Input */ - -/* OP indicates the operation to be performed. Possible */ -/* values are 'GET' and 'SET'. 'GET' means, "set */ -/* DEVICE equal to the name of the current error */ -/* output device" 'SET' means, "set the name of the */ -/* current error output device equal to the value of */ -/* DEVICE." */ - -/* DEVICE is an input when OP has the value, 'SET'. It */ -/* indicates an output device to which error messages */ -/* are to be sent. Possible values for DEVICE are: */ - -/* 1. A file name. Note that the name must not */ -/* be any of the reserved strings below. */ - -/* 2. 'SCREEN' The output will go to the */ -/* screen. This is the default device. */ - -/* 3. 'NULL' The data will not be output. */ - -/* 'SCREEN' and 'NULL' can be written in mixed */ -/* case. For example, the following call will work: */ - -/* CALL ERRDEV ( 'SET' , 'screEn' ) */ - -/* $ Detailed_Output */ - -/* DEVICE is an output when OP is 'GET'. It is the */ -/* current error output device. See "Detailed */ -/* Input" for possible values and meanings. */ - -/* $ Parameters */ - -/* FILEN The maximum length of a file name that can be */ -/* processed by this routine. See the Literature_References */ -/* section for more information. */ - -/* $ Exceptions */ - -/* This routine detects the following errors: */ - -/* 1. 'SPICE(INVALIDOPERATION)' ...Invalid value of the */ -/* argument, OP. */ - -/* 2. 'SPICE(DEVICENAMETOOLONG)' ...Device name exceeds */ -/* FILEN characters */ - - -/* Also, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Please read the "required reading"! */ - -/* This routine can't tell whether the name supplied */ -/* to indicate the output device is valid. Be careful! */ - -/* $ Examples */ - -/* 1. In this example, we select as the output device */ -/* the file, SPUD.DAT. */ - -/* C */ -/* C Set the error output device to SPUD.DAT: */ -/* C */ - -/* CALL ERRDEV ( 'SET', 'SPUD.DAT' ) */ - - -/* $ Restrictions */ - -/* This routine has no capability of determining the validity */ -/* of the name of an output device. Care must be taken */ -/* to ensure that the file named is the correct one. */ - -/* The device name is assumed to be no longer than FILEN characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 2.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 2.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 2.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 05-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* - SPICELIB Version 1.2.0, 3-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 1.1.0, 9-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get/set error output device name */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 05-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* - SPICELIB Version 1.2.0, 3-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 1.1.0, 9-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (NJB) */ - -/* File name length parameter added to parameters section. */ -/* Declaration of the unused function FRSTNB removed. */ -/* Trace participation added. This routine now checks in */ -/* and checks out. However, it does not test RETURN, */ -/* because it should be able to execute in RETURN mode when */ -/* an error condition exists. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables: */ - - -/* Initial Values: */ - - -/* Executable Code: */ - - chkin_("ERRDEV", (ftnlen)6); - -/* We save the operation string as input, and get */ -/* an upper case version for our own use: */ - - ljust_(op, upop, op_len, (ftnlen)3); - ucase_(upop, upop, (ftnlen)3, (ftnlen)3); - if (s_cmp(upop, "GET", (ftnlen)3, (ftnlen)3) == 0) { - getdev_(device, device_len); - } else if (s_cmp(upop, "SET", (ftnlen)3, (ftnlen)3) == 0) { - -/* We want the reserved words to be in upper */ -/* case for our own use. So, save the input value */ -/* and get an upper case version: */ - - ljust_(device, upnam, device_len, (ftnlen)255); - ucase_(upnam, upnam, (ftnlen)255, (ftnlen)255); - if (lastnb_(upnam, (ftnlen)255) > 255) { - s_copy(locnam, device, (ftnlen)255, device_len); -/* Writing concatenation */ - i__1[0] = 123, a__1[0] = "ERRDEV: Device name exceeds FILEN cha" - "racters; device selection not updated. The first FILEN c" - "haracters of the name were: "; - i__1[1] = 255, a__1[1] = locnam; - s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)378); - setmsg_(ch__1, (ftnlen)378); - sigerr_("SPICE(DEVICENAMETOOLONG)", (ftnlen)24); - chkout_("ERRDEV", (ftnlen)6); - return 0; - } - if (s_cmp(upnam, "SCREEN", (ftnlen)255, (ftnlen)6) == 0 || s_cmp( - upnam, "NULL", (ftnlen)255, (ftnlen)4) == 0) { - -/* Store upper case version of DEVICE: */ - - putdev_(upnam, (ftnlen)255); - } else { - -/* We assume we've got a file name... */ -/* Store it as it was input. */ - - putdev_(device, device_len); - } - } else { - -/* An invalid value of OP was supplied. */ - - s_copy(locop, op, (ftnlen)3, op_len); -/* Writing concatenation */ - i__1[0] = 62, a__1[0] = "ERRDEV: An invalid value of OP was supplie" - "d. The value was: "; - i__1[1] = 3, a__1[1] = locop; - s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)65); - setmsg_(ch__2, (ftnlen)65); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - } - chkout_("ERRDEV", (ftnlen)6); - return 0; -} /* errdev_ */ - diff --git a/ext/spice/src/cspice/errdev_c.c b/ext/spice/src/cspice/errdev_c.c deleted file mode 100644 index e2f02ed82f..0000000000 --- a/ext/spice/src/cspice/errdev_c.c +++ /dev/null @@ -1,277 +0,0 @@ -/* - --Procedure errdev_c ( Get/Set Error Output Device Name ) - --Abstract - - Retrieve or set the name of the current output - device for error messages. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void errdev_c ( ConstSpiceChar * op, - SpiceInt lenout, - SpiceChar * device ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - op I The operation: "GET" or "SET". - lenout I Length of device for output. - device I/O The device name. - --Detailed_Input - - op indicates the operation to be performed. Possible - values are "GET" and "SET". "GET" means, "set - device equal to the name of the current error - output device" "SET" means, "set the name of the - current error output device equal to the value of - device." - - lenout the string size of output 'device' when op equals "GET." - The size described by lenout should be large enough to - hold all characters of any possible output string - plus 1 (to accommodate the C null terminator). - - device is an input when op has the value, "SET". It - indicates an output device to which error messages - are to be sent. Possible values for device are: - - 1. A file name. Note that the name must not - use one of the reserved strings below. - - 2. "SCREEN" The output will go to the - screen. This is the default device. - - 3. "NULL" The data will not be output. - - "SCREEN" and "NULL" can be written in mixed - case. For example, the following call will work: - - errdev_c ( "SET", lenout, "screEn" ); - --Detailed_Output - - device is an output returning the current error output device - when 'op' equals "GET." See "Detailed Input" - descriptions of these values. - --Parameters - - None. - --Exceptions - - 1) If the input argument op does not indicate a valid operation, - the error SPICE(INVALIDOPERATION) will be signaled. - - 2) When op is "SET", if the input argument device has length greater - than FILEN characters, the error SPICE(DEVICENAMETOOLONG) will - be signaled. - - 3) The error SPICE(EMPTYSTRING) is signaled if either input string - does not contain at least one character, since an input string - cannot be converted to a Fortran-style string in this case. This - check always applies to op; it applies to device only when - device is an input, that is, when op is "SET." - - 4) The error SPICE(NULLPOINTER) is signaled if either string pointer - argument is null. - - 5) The caller must pass a value indicating the length of the output - string, when device is an output. If this value is not at least - 2, the error SPICE(STRINGTOOSHORT) is signaled. - --Files - - None. - --Particulars - - This routine supports spooling of error messages to log files. - --Examples - - 1. In this example, we select as the output device - the file, SPUD.DAT. - - /. - Set the error output device to the file SPUD.DAT: - ./ - errdev_c ( "SET", lenout, "SPUD.DAT" ); - - --Restrictions - - This routine has no capability of determining the validity - of the name of an output device. Care must be taken - to ensure that the file named is the correct one. - - The device name is assumed to be no longer than FILEN characters. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.3.1, 25-SEP-2003 (EDW) - - Corrected confusing description of 'lenout' argument. - - -CSPICE Version 1.3.0, 24-JUN-2003 (NJB) - - Bug fix: case of invalid operation keyword is now - diagnosed, as per the Exceptions section of the header. - - -CSPICE Version 1.2.0, 28-AUG-1999 (NJB) - - Bug fix: changed errprt_ call to call to errdev_. - - -CSPICE Version 1.2.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.1, 30-OCT-1997 (EDW) - - Corrected errors in examples in which the call sequence - was incorrect. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - get/set error output device name - --& -*/ - - -{ /* Begin errdev_c.c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "errdev_c" ); - - - /* - Check the input string op to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "errdev_c", op ); - - - if( eqstr_c (op, "SET") ) - { - - /* - The operation is SET. The argument "device" will be an input - string. - */ - CHKFSTR ( CHK_STANDARD, "errdev_c", device ); - - /* - Call the f2c'd Fortran routine. - */ - errdev_ ( ( char * ) op, - ( char * ) device, - ( ftnlen ) strlen(op), - ( ftnlen ) strlen(device) ); - - } - - else if ( eqstr_c (op, "GET") ) - { - - /* - Operation is GET. "device" will be an output string. - - Make sure the output string has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "errdev_c", device, lenout ); - - /* - After the routine call, create a C string from the - Fortran output string. - */ - errdev_( ( char * ) op, - ( char * ) device, - ( ftnlen ) strlen(op), - ( ftnlen ) lenout-1 ); - - - F2C_ConvertStr( lenout, device ); - } - - else - { - setmsg_c ( "Input argument op had value: # " - "Valid choices are GET or SET." ); - errch_c ( "#", op ); - sigerr_c ( "SPICE(INVALIDOPERATION)" ); - chkout_c ( "errdev_c" ); - return; - } - - chkout_c ( "errdev_c" ); - -} /* End errdev_c */ diff --git a/ext/spice/src/cspice/errdp.c b/ext/spice/src/cspice/errdp.c deleted file mode 100644 index 0255044612..0000000000 --- a/ext/spice/src/cspice/errdp.c +++ /dev/null @@ -1,381 +0,0 @@ -/* errdp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__14 = 14; -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure ERRDP ( Insert D.P. Number into Error Message Text ) */ -/* Subroutine */ int errdp_(char *marker, doublereal *dpnum, ftnlen - marker_len) -{ - /* System generated locals */ - address a__1[3], a__2[2]; - integer i__1, i__2[3], i__3[2]; - - /* Builtin functions */ - integer i_indx(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int dpstr_(doublereal *, integer *, char *, - ftnlen), ljust_(char *, char *, ftnlen, ftnlen); - extern logical allowd_(void); - extern integer lastnb_(char *, ftnlen); - char lngmsg[1840]; - extern /* Subroutine */ int getlms_(char *, ftnlen); - extern integer frstnb_(char *, ftnlen); - char dpstrg[21], tmpmsg[1840]; - extern /* Subroutine */ int putlms_(char *, ftnlen); - integer strpos; - -/* $ Abstract */ - -/* Substitute a double precision number for the first occurrence of */ -/* a marker found in the current long error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR, CONVERSION */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARKER I A substring of the error message to be replaced. */ -/* DPNUM I The d.p. number to substitute for MARKER. */ - -/* $ Detailed_Input */ - - -/* MARKER is a character string which marks a position in */ -/* the long error message where a character string */ -/* representing an double precision number is to be */ -/* substituted. Leading and trailing blanks in MARKER */ -/* are not significant. */ - -/* Case IS significant; 'XX' is considered to be */ -/* a different marker from 'xx'. */ - -/* DPNUM is an double precision number whose character */ -/* representation will be substituted for the first */ -/* occurrence of MARKER in the long error message. */ -/* This occurrence of the substring indicated by MARKER */ -/* will be removed, and replaced by a character string, */ -/* with no leading or trailing blanks, representing */ -/* DPNUM. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* LMSGLN is the maximum length of the long error message. See */ -/* the include file errhnd.inc for the value of LMSGLN. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The effect of this routine is to update the current long */ -/* error message. If no marker is found, (e.g., in the */ -/* case that the long error message is blank), the routine */ -/* has no effect. If multiple instances of the marker */ -/* designated by MARKER are found, only the first one is */ -/* replaced. */ - -/* If the character string resulting from the substitution */ -/* exceeds the maximum length of the long error message, the */ -/* characters on the right are lost. No error is signalled. */ - -/* This routine has no effect if changes to the long message */ -/* are not allowed. */ - -/* $ Examples */ - - -/* 1. In this example, the marker is: # */ - - -/* The current long error message is: */ - -/* 'Invalid operation value. The value was #'. */ - - -/* After the call, */ - - -/* CALL ERRDP ( '#', 5.0 ) */ - -/* The long error message becomes: */ - -/* 'Invalid operation value. The value was 5.0'. */ - - - - -/* 2. In this example, the marker is: XX */ - - -/* The current long error message is: */ - -/* 'Left endpoint exceeded right endpoint. The left'// */ -/* 'endpoint was: XX. The right endpoint was: XX.' */ - - -/* After the call, */ - -/* CALL ERRDP ( 'XX', 5.0 ) */ - -/* The long error message becomes: */ - -/* 'Left endpoint exceeded right endpoint. The left'// */ -/* 'endpoint was: 5.0. The right endpoint was: XX.' */ - - -/* $ Restrictions */ - -/* The caller must ensure that the message length, after sub- */ -/* stitution is performed, doesn't exceed LMSGLN characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 29-JUL-2005 (NJB) */ - -/* Bug fix: increased length of internal string DPSTRG to */ -/* handle 3-digit exponents. */ - -/* - SPICELIB Version 2.1.0, 29-JUL-1997 (NJB) */ - -/* Bug fix: extraneous leading blank has been removed from */ -/* numeric string substituted for marker. */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous format changes to the */ -/* header, code and in-line comments were made. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert d.p. number into error message text */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 29-JUL-1997 (NJB) */ - -/* Bug fix: extraneous leading blank has been removed from */ -/* numeric string substituted for marker. */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous format changes to the */ -/* header, code and in-line comments were made. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables: */ - - -/* Length of DPSTRG is number of significant digits plus 7 */ -/* (see DPSTR header) */ - - -/* Executable Code: */ - - -/* Changes to the long error message have to be allowed, or we */ -/* do nothing. */ - - if (! allowd_()) { - return 0; - } - -/* MARKER has to have some non-blank characters, or we do nothing. */ - - if (lastnb_(marker, marker_len) == 0) { - return 0; - } - -/* Get a copy of the current long error message. Convert DPNUM */ -/* to a character string. Ask for 14 significant digits in */ -/* string. */ - - getlms_(lngmsg, (ftnlen)1840); - dpstr_(dpnum, &c__14, dpstrg, (ftnlen)21); - ljust_(dpstrg, dpstrg, (ftnlen)21, (ftnlen)21); - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks): */ - - i__1 = frstnb_(marker, marker_len) - 1; - strpos = i_indx(lngmsg, marker + i__1, (ftnlen)1840, lastnb_(marker, - marker_len) - i__1); - if (strpos == 0) { - return 0; - } else { - -/* We put together TMPMSG, a copy of LNGMSG with MARKER */ -/* replaced by the character representation of DPNUM: */ - - if (strpos > 1) { - if (strpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len) < lastnb_(lngmsg, (ftnlen)1840)) { - -/* There's more of the long message after the marker... */ - - i__1 = strpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); -/* Writing concatenation */ - i__2[0] = strpos - 1, a__1[0] = lngmsg; - i__2[1] = lastnb_(dpstrg, (ftnlen)21), a__1[1] = dpstrg; - i__2[2] = 1840 - i__1, a__1[2] = lngmsg + i__1; - s_cat(tmpmsg, a__1, i__2, &c__3, (ftnlen)1840); - } else { -/* Writing concatenation */ - i__3[0] = strpos - 1, a__2[0] = lngmsg; - i__3[1] = lastnb_(dpstrg, (ftnlen)21), a__2[1] = dpstrg; - s_cat(tmpmsg, a__2, i__3, &c__2, (ftnlen)1840); - } - } else { - -/* We're starting with the d.p. number, so we know it fits... */ - - if (lastnb_(marker, marker_len) - frstnb_(marker, marker_len) < - lastnb_(lngmsg, (ftnlen)1840)) { - -/* There's more of the long message after the marker... */ - - i__1 = strpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); -/* Writing concatenation */ - i__3[0] = lastnb_(dpstrg, (ftnlen)21), a__2[0] = dpstrg; - i__3[1] = 1840 - i__1, a__2[1] = lngmsg + i__1; - s_cat(tmpmsg, a__2, i__3, &c__2, (ftnlen)1840); - } else { - -/* The marker's the whole string: */ - - s_copy(tmpmsg, dpstrg, (ftnlen)1840, (ftnlen)21); - } - } - -/* Update the long message: */ - - putlms_(tmpmsg, (ftnlen)1840); - } - return 0; -} /* errdp_ */ - diff --git a/ext/spice/src/cspice/errdp_c.c b/ext/spice/src/cspice/errdp_c.c deleted file mode 100644 index 4a194c02c2..0000000000 --- a/ext/spice/src/cspice/errdp_c.c +++ /dev/null @@ -1,208 +0,0 @@ -/* - --Procedure errdp_c ( Insert D.P. Number into Error Message Text ) - --Abstract - - Substitute a double precision number for the first occurrence of - a marker found in the current long error message. - --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 - - ERROR - --Keywords - - ERROR, CONVERSION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void errdp_c ( ConstSpiceChar * marker, - SpiceDouble number ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - marker I A substring of the error message to be replaced. - number I The d.p. number to substitute for marker. - --Detailed_Input - - - marker is a character string which marks a position in - the long error message where a character string - representing an double precision number is to be - substituted. Leading and trailing blanks in marker - are not significant. - - Case IS significant; "XX" is considered to be - a different marker from "xx". - - number is an double precision number whose character - representation will be substituted for the first - occurrence of marker in the long error message. - This occurrence of the substring indicated by marker - will be removed, and replaced by a character string, - with no leading or trailing blanks, representing - number. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 2) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - --Files - - None. - --Particulars - - The effect of this routine is to update the current long - error message. If no marker is found, (e.g., in the - case that the long error message is blank), the routine - has no effect. If multiple instances of the marker - designated by marker are found, only the first one is - replaced. - - If the character string resulting from the substitution - exceeds the maximum length of the long error message, the - characters on the right are lost. No error is signalled. - - This routine has no effect if changes to the long message - are not allowed. - --Examples - - - 1. In this example, the marker is: # - - - The current long error message is: - - "Invalid operation value. The value was #". - - - After the call, - - errdp_c ( "#", 5.0 ); - - The long error message becomes: - - "Invalid operation value. The value was 5.0". - - - - - 2. In this example, the marker is: XX - - - The current long error message is: - - "Left endpoint exceeded right endpoint. The left"// - "endpoint was: XX. The right endpoint was: XX." - - - After the call, - - errdp_c ( "XX", 5.0 ); - - The long error message becomes: - - "Left endpoint exceeded right endpoint. The left"// - "endpoint was: 5.0. The right endpoint was: XX." - - --Restrictions - - The caller must ensure that the message length, after sub- - stitution is performed, doesn't exceed LMSGLN characters. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - insert d.p. number into error message text - --& -*/ - -{ - /* - Check the input string marker to make sure the pointer is non-null - and the string length is non-zero. Since we don't check in - prior to this, use the discovery check-in option. - */ - CHKFSTR ( CHK_DISCOVER, "errdp_c", marker ); - - - /* - Call the f2c'd Fortran routine. - */ - errdp_ ( ( char * ) marker, - ( doublereal * ) &number, - ( ftnlen ) strlen(marker) ); - - -} /* end errdp_c */ diff --git a/ext/spice/src/cspice/errfnm.c b/ext/spice/src/cspice/errfnm.c deleted file mode 100644 index 2eef249177..0000000000 --- a/ext/spice/src/cspice/errfnm.c +++ /dev/null @@ -1,271 +0,0 @@ -/* errfnm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ERRFNM ( Insert filename into long error message text ) */ -/* Subroutine */ int errfnm_(char *marker, integer *unit, ftnlen marker_len) -{ - /* System generated locals */ - inlist ioin__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer f_inqu(inlist *), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[128]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer iostat; - -/* $ Abstract */ - -/* Substitute the first occurrence of a marker in the current long */ -/* error message with the name of the file attached to the logical */ -/* unit number. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ -/* STRING */ -/* UNITS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MARKER I A substring in the error message that is to be */ -/* replaced. */ -/* UNIT I Logical unit number attached to a file. */ -/* FILEN P Maximum length of filename. */ - -/* $ Detailed_Input */ - -/* MARKER is a character string which marks a position in */ -/* the long error message where a character string */ -/* is to be substituted. Leading and trailing blanks */ -/* in MARKER are not significant. */ - -/* Case IS significant; 'XX' is considered to be */ -/* a different marker from 'xx'. */ - -/* UNIT is the logical unit number attached to a file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN is the maximum file name length that can be */ -/* accommodated by this routine. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the logical unit number is not attached to a file, the */ -/* string inserted into the long error message is: */ - -/* '' */ - -/* 2) If the FORTRAN INQUIRE statement fails to execute properly, */ -/* the string inserted into the long error message is: */ - -/* '' */ - -/* $ Files */ - -/* See "Detailed_Input" description of the variable UNIT. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* 1. The following code fragment reads a record from a file */ -/* then checks to see if the read was successful. If the */ -/* read failed, an error message is constructed that */ -/* specifies the record number, the filename and the value */ -/* of IOSTAT. */ - -/* ERRFNM is used to replace the marker in the long error */ -/* message with the name of the file. */ - - -/* READ ( UNIT, REC=RECNUM, IOSTAT=IOSTAT ) RECORD */ - -/* IF ( IOSTAT .NE. 0 ) THEN */ - -/* CALL SETMSG ( 'Error reading record number # from ' // */ -/* . 'file FILENAME. The value of IOSTAT ' // */ -/* . 'was #.' ) */ - -/* CALL ERRINT ( '#', RECNUM ) */ -/* CALL ERRFNM ( 'FILENAME', UNIT ) */ -/* CALL ERRINT ( '#', IOSTAT ) */ -/* CALL SIGERR ( 'SPICE(READFAILURE)' ) */ -/* CALL CHKOUT ( 'SAMPLE' ) */ -/* RETURN */ - -/* END IF */ - - -/* If the unit is attached to the file SAMPLE.DAT, RECNUM */ -/* is 15 and IOSTAT is 36, and the INQUIRE statement in */ -/* this routine executed successfully, the long error */ -/* message is: */ - -/* 'Error reading record number 15 from file SAMPLE.DAT. */ -/* The value of IOSTAT was 36.' */ - - -/* If the unit is not attached to a file or if the INQUIRE */ -/* statement in this routine failed to execute successfully, */ -/* the long error message is: */ - -/* 'Error reading record number 15 from file */ -/* . The value of IOSTAT */ -/* was 36.' */ - - -/* 2. Note that the case of the marker is significant. The following */ -/* code fragment contains a call to ERRFNM using a marker */ -/* that does not appear in the long error message. */ - - -/* READ ( UNIT, REC=RECNUM, IOSTAT=IOSTAT ) RECORD */ - -/* IF ( IOSTAT .NE. 0 ) THEN */ - -/* CALL SETMSG ( 'Error reading record number # from ' // */ -/* . 'file FILENAME. The value of IOSTAT ' // */ -/* . 'was #.' ) */ - -/* CALL ERRINT ( '#', RECNUM ) */ -/* CALL ERRFNM ( 'filename', UNIT ) */ -/* CALL ERRINT ( '#', IOSTAT ) */ -/* CALL SIGERR ( 'SPICE(READFAILURE)' ) */ -/* CALL CHKOUT ( 'SAMPLE' ) */ -/* RETURN */ - -/* END IF */ - - -/* If the marker is not found, ERRFNM does not substitute */ -/* the filename for the marker. The long error message in */ -/* this case is: */ - -/* 'Error reading record number 15 from file FILENAME. */ -/* The value of IOSTAT was 36.' */ - -/* $ Restrictions */ - -/* The filename length is restricted by the parameter FILEN. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ 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, 05-APR-1991 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert filename into long error message */ - -/* -& */ - -/* Local variables */ - - -/* Initialize the variables. */ - - s_copy(name__, " ", (ftnlen)128, (ftnlen)1); - -/* Get the name of the file attached to the logical unit number. */ - - ioin__1.inerr = 1; - ioin__1.inunit = *unit; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.innamlen = 128; - ioin__1.inname = name__; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - -/* If the INQUIRE statement executed successfully and the unit */ -/* was attached to a file, we have a filename. */ - -/* If the INQUIRE statement didn't execute successfully the value */ -/* of IOSTAT is not equal to zero. If the unit is not connected to */ -/* a file the filename is blank. If either of these two things */ -/* are true, we must construct a string indicating that the */ -/* filename was unavailable from the system. */ - - if (iostat != 0 || s_cmp(name__, " ", (ftnlen)128, (ftnlen)1) == 0) { - s_copy(name__, "", (ftnlen)128, (ftnlen) - 29); - } - -/* Let the error handling routine take it from here. */ - - errch_(marker, name__, marker_len, (ftnlen)128); - return 0; -} /* errfnm_ */ - diff --git a/ext/spice/src/cspice/errhan.c b/ext/spice/src/cspice/errhan.c deleted file mode 100644 index c124120407..0000000000 --- a/ext/spice/src/cspice/errhan.c +++ /dev/null @@ -1,438 +0,0 @@ -/* errhan.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure ERRHAN ( Insert DAF/DAS file name into long error message ) */ -/* Subroutine */ int errhan_(char *marker, integer *handle, ftnlen marker_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzddhnfo_(integer *, char *, integer *, - integer *, integer *, logical *, ftnlen); - char fname[255]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - logical found; - integer intbff, intarc, intamh; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen), intstr_(integer *, char *, ftnlen); - char numstr[32]; - -/* $ Abstract */ - -/* Substitute the first occurrence of a marker in the current long */ -/* error message with the file name associated with a given */ -/* DAF/DAS handle. (Works for DAF only for N0052.) */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* DAF */ -/* DAS */ -/* ERROR */ -/* STRING */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MARKER I A substring in the long error message to be */ -/* replaced. */ -/* HANDLE I DAF/DAS handle associated with a file. */ -/* FILEN P Maximum length of filename. */ - -/* $ Detailed_Input */ - -/* MARKER is a character string that marks a position in */ -/* the long error message where a file name is to be */ -/* substituted. Leading and trailing blanks in MARKER */ -/* are not significant. */ - -/* Case IS significant; 'XX' is considered to be */ -/* a different marker from 'xx'. */ - -/* HANDLE is the DAF/DAS handle associated with the file of */ -/* interest. HANDLE must be associated with a currently */ -/* loade DAF or DAS file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN is the maximum file name length that can be */ -/* accommodated by this routine. Currently this */ -/* parameter is defined in the include file */ -/* zzddhman.inc. */ - -/* $ Exceptions */ - -/* Error free. */ - - -/* 1) If HANDLE refers to a scratch DAS file, the string inserted */ -/* into the long error message is */ - -/* 'DAS SCRATCH FILE' */ - -/* 2) If HANDLE is not associated with a loaded DAF or DAS file, */ -/* the string inserted into the long error message is: */ - -/* '' */ - -/* where the handle number is substituted for the marker '#'. */ - -/* $ Files */ - -/* See "Detailed_Input" description of the variable HANDLE. */ - -/* $ Particulars */ - -/* This routine provides a convenient and error-free mechanism */ -/* for inserting a DAF or DAS file name into an error message, */ -/* given the file handle associated with the file of interest. */ - -/* $ Examples */ - -/* 1) Create an error message pertaining to an SPK file */ -/* designated by HANDLE, then signal an error. */ - -/* CALL SETMSG ( 'SPK file # contains a type 3 segment ' // */ -/* . 'with invalid polynomial degree #. ' // */ -/* . 'Segment index in file is #.' ) */ -/* CALL ERRHAN ( '#', HANDLE ) */ -/* CALL ERRINT ( '#', DEGREE ) */ -/* CALL ERRINT ( '#', I ) */ -/* CALL SIGERR ( 'SPICE(INVALIDDEGREE)' ) */ - -/* $ Restrictions */ - -/* 1) This routine works only for DAF files in the N0052 Toolkit */ -/* version. It will for for both DAF and DAS files for later */ -/* Toolkit versions. */ - -/* 2) The supported filename length is limited by the parameter */ -/* FILEN. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 04-JAN-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert filename into long error message */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Get the name of the file designated by the input handle. */ - - zzddhnfo_(handle, fname, &intarc, &intbff, &intamh, &found, (ftnlen)255); - if (! found) { - intstr_(handle, numstr, (ftnlen)32); - s_copy(fname, "", &c__0, fname, (ftnlen)1, (ftnlen)255); - } - -/* Insert the file name string into the long error message. */ - - errch_(marker, fname, marker_len, (ftnlen)255); - return 0; -} /* errhan_ */ - diff --git a/ext/spice/src/cspice/errint.c b/ext/spice/src/cspice/errint.c deleted file mode 100644 index eebd1a3795..0000000000 --- a/ext/spice/src/cspice/errint.c +++ /dev/null @@ -1,354 +0,0 @@ -/* errint.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure ERRINT ( Insert Integer into Error Message Text ) */ -/* Subroutine */ int errint_(char *marker, integer *integr, ftnlen marker_len) -{ - /* System generated locals */ - address a__1[3], a__2[2]; - integer i__1, i__2[3], i__3[2]; - - /* Builtin functions */ - integer i_indx(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical allowd_(void); - extern integer lastnb_(char *, ftnlen); - char lngmsg[1840]; - extern /* Subroutine */ int getlms_(char *, ftnlen); - extern integer frstnb_(char *, ftnlen); - char istrng[11], tmpmsg[1840]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), putlms_( - char *, ftnlen); - integer strpos; - -/* $ Abstract */ - -/* Substitute an integer for the first occurrence of a marker found */ -/* in the current long error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR, CONVERSION */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARKER I A substring of the error message to be replaced. */ -/* INTEGR I The integer to substitute for MARKER. */ - -/* $ Detailed_Input */ - -/* MARKER is a character string which marks a position in */ -/* the long error message where a character string */ -/* representing an integer is to be substituted. */ -/* Leading and trailing blanks in MARKER are not */ -/* significant. */ - -/* Case IS significant; 'XX' is considered to be */ -/* a different marker from 'xx'. */ - -/* INTEGR is an integer whose character representation will */ -/* be substituted for the first occurrence of MARKER */ -/* in the long error message. This occurrence of the */ -/* substring indicated by MARKER will be removed, and */ -/* replaced by a character string, with no leading or */ -/* trailing blanks, representing INTEGR. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* LMSGLN is the maximum length of the long error message. See */ -/* the include file errhnd.inc for the value of LMSGLN. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine updates the current long error message. If no marker */ -/* is found, (e.g., in the case that the long error message is */ -/* blank), the routine has no effect. If multiple instances of the */ -/* marker designated by MARKER are found, only the first one is */ -/* replaced. */ - -/* If the character string resulting from the substitution */ -/* exceeds the maximum length of the long error message, the */ -/* characters on the right are lost. No error is signalled. */ - -/* This routine has no effect if changes to the long message */ -/* are not allowed. */ - -/* $ Examples */ - - -/* 1. In this example, the marker is: # */ - - -/* The current long error message is: */ - -/* 'Invalid operation value. The value was #'. */ - - -/* After the call, */ - - -/* CALL ERRINT ( '#', 5 ) */ - -/* The long error message becomes: */ - -/* 'Invalid operation value. The value was 5'. */ - - - -/* 2. In this example, the marker is: XX */ - - -/* The current long error message is: */ - -/* 'Left endpoint exceeded right endpoint. The left'// */ -/* 'endpoint was: XX. The right endpoint was: XX.' */ - - -/* After the call, */ - -/* CALL ERRINT ( 'XX', 5 ) */ - -/* The long error message becomes: */ - -/* 'Left endpoint exceeded right endpoint. The left'// */ -/* 'endpoint was: 5. The right endpoint was: XX.' */ - - -/* $ Restrictions */ - -/* The caller must ensure that the message length, after sub- */ -/* stitution is performed, doesn't exceed LMSGLN characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous format changes to the */ -/* header, code and in-line comments were made. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert integer into error message text */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous format changes to the */ -/* header, code and in-line comments were made. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables: */ - - -/* Changes to the long error message have to be allowed, or we */ -/* do nothing. */ - - if (! allowd_()) { - return 0; - } - -/* MARKER has to have some non-blank characters, or we do nothing. */ - - if (lastnb_(marker, marker_len) == 0) { - return 0; - } - -/* Get a copy of the current long error message. Convert INTEGR */ -/* to a character string. */ - - getlms_(lngmsg, (ftnlen)1840); - intstr_(integr, istrng, (ftnlen)11); - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks): */ - - i__1 = frstnb_(marker, marker_len) - 1; - strpos = i_indx(lngmsg, marker + i__1, (ftnlen)1840, lastnb_(marker, - marker_len) - i__1); - if (strpos == 0) { - return 0; - } else { - -/* We put together TMPMSG, a copy of LNGMSG with MARKER */ -/* replaced by the character representation of INTEGR: */ - - if (strpos > 1) { - if (strpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len) < lastnb_(lngmsg, (ftnlen)1840)) { - -/* There's more of the long message after the marker... */ - - i__1 = strpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); -/* Writing concatenation */ - i__2[0] = strpos - 1, a__1[0] = lngmsg; - i__2[1] = lastnb_(istrng, (ftnlen)11), a__1[1] = istrng; - i__2[2] = 1840 - i__1, a__1[2] = lngmsg + i__1; - s_cat(tmpmsg, a__1, i__2, &c__3, (ftnlen)1840); - } else { -/* Writing concatenation */ - i__3[0] = strpos - 1, a__2[0] = lngmsg; - i__3[1] = lastnb_(istrng, (ftnlen)11), a__2[1] = istrng; - s_cat(tmpmsg, a__2, i__3, &c__2, (ftnlen)1840); - } - } else { - -/* We're starting with the integer, so we know it fits... */ - - if (lastnb_(marker, marker_len) - frstnb_(marker, marker_len) < - lastnb_(lngmsg, (ftnlen)1840)) { - -/* There's more of the long message after the marker... */ - - i__1 = strpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); -/* Writing concatenation */ - i__3[0] = lastnb_(istrng, (ftnlen)11), a__2[0] = istrng; - i__3[1] = 1840 - i__1, a__2[1] = lngmsg + i__1; - s_cat(tmpmsg, a__2, i__3, &c__2, (ftnlen)1840); - } else { - -/* The marker's the whole string: */ - - s_copy(tmpmsg, istrng, (ftnlen)1840, (ftnlen)11); - } - } - -/* Update the long message: */ - - putlms_(tmpmsg, (ftnlen)1840); - } - return 0; -} /* errint_ */ - diff --git a/ext/spice/src/cspice/errint_c.c b/ext/spice/src/cspice/errint_c.c deleted file mode 100644 index 5c80196fed..0000000000 --- a/ext/spice/src/cspice/errint_c.c +++ /dev/null @@ -1,206 +0,0 @@ -/* - --Procedure errint_c ( Insert Integer into Error Message Text ) - --Abstract - - Substitute an integer for the first occurrence of a marker found - in the current long error message. - --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 - - ERROR - --Keywords - - ERROR, CONVERSION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void errint_c ( ConstSpiceChar * marker, - SpiceInt number ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - marker I A substring of the error message to be replaced. - number I The integer to substitute for marker. - --Detailed_Input - - marker is a character string which marks a position in - the long error message where a character string - representing an integer is to be substituted. - Leading and trailing blanks in marker are not - significant. - - Case IS significant; "XX" is considered to be - a different marker from "xx". - - number is an integer whose character representation will - be substituted for the first occurrence of marker - in the long error message. This occurrence of the - substring indicated by marker will be removed, and - replaced by a character string, with no leading or - trailing blanks, representing number. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 2) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - --Files - - None. - --Particulars - - This routine updates the current long error message. If no marker - is found, (e.g., in the case that the long error message is - blank), the routine has no effect. If multiple instances of the - marker designated by marker are found, only the first one is - replaced. - - If the character string resulting from the substitution - exceeds the maximum length of the long error message, the - characters on the right are lost. No error is signalled. - - This routine has no effect if changes to the long message - are not allowed. - --Examples - - - 1. In this example, the marker is: # - - - The current long error message is: - - "Invalid operation value. The value was #". - - - After the call, - - - errint_c ( "#", 5 ); - - The long error message becomes: - - "Invalid operation value. The value was 5". - - - - 2. In this example, the marker is: XX - - - The current long error message is: - - "Left endpoint exceeded right endpoint. The left"// - "endpoint was: XX. The right endpoint was: XX." - - - After the call, - - errint_c ( "XX", 5 ); - - The long error message becomes: - - "Left endpoint exceeded right endpoint. The left"// - "endpoint was: 5. The right endpoint was: XX." - - --Restrictions - - The caller must ensure that the message length, after sub- - stitution is performed, doesn't exceed LMSGLN characters. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - insert integer into error message text - --& -*/ - -{ /* Begin errint_c */ - - - /* - Check the input string marker to make sure the pointer is non-null - and the string length is non-zero. Since we don't check in - prior to this, use the discovery check-in option. - */ - CHKFSTR ( CHK_DISCOVER, "errint_c", marker ); - - - /* - Call the f2c'd Fortran routine. - */ - errint_ ( ( char * ) marker, - ( integer * ) &number, - ( ftnlen ) strlen(marker) ); - - -} /* End errint_c */ diff --git a/ext/spice/src/cspice/errprt.c b/ext/spice/src/cspice/errprt.c deleted file mode 100644 index 5403238c75..0000000000 --- a/ext/spice/src/cspice/errprt.c +++ /dev/null @@ -1,479 +0,0 @@ -/* errprt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__10 = 10; -static integer c__2 = 2; - -/* $Procedure ERRPRT ( Get/Set Error Output Items ) */ -/* Subroutine */ int errprt_(char *op, char *list, ftnlen op_len, ftnlen - list_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - char ch__1[89], ch__2[65]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - logical long__, expl; - char upop[3]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical trace; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - char locop[3], words[9*10]; - logical short__; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - logical dfault; - extern /* Subroutine */ int lparse_(char *, char *, integer *, integer *, - char *, ftnlen, ftnlen, ftnlen); - extern logical msgsel_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), suffix_(char *, integer *, char - *, ftnlen, ftnlen); - integer numwrd; - char upword[9]; - extern logical setprt_(logical *, logical *, logical *, logical *, - logical *); - logical status; - -/* $ Abstract */ - -/* Retrieve or set the list of error message items */ -/* to be output when an error is detected. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OP I The operation: 'GET' or 'SET'. */ -/* LIST I/O Specification of error messages to be output. */ - -/* $ Detailed_Input */ - -/* OP indicates the operation to be performed. Possible */ -/* values are 'GET' and 'SET'. */ - -/* 'SET' means, "the following list specifies the default */ -/* selection of error messages to be output." These are */ -/* the messages that will be output to the default error */ -/* output device (selected by ERRDEV) when an error is */ -/* detected. */ - -/* 'GET' means, "return the current list of error output */ -/* items." This is the exact list that was set by the */ -/* last call to this routine with the 'SET' option. */ - -/* The option can be specified in mixed case. For example, */ -/* the following call will work: */ - -/* CALL ERRPRT ( 'SeT' , 'ALL' ) */ - - -/* LIST is a list of error message items. The items */ -/* are delimited by commas. The items that can be */ -/* in the list are the words: */ - -/* 1. SHORT ...indicates the short error message */ -/* 2. EXPLAIN ...the explanation of the short message */ -/* 3. LONG ...the long error message */ -/* 4. TRACEBACK ...the traceback */ -/* 5. ALL ...indicates "output all messages" */ -/* 6. NONE ...indicates "don't output any messages" */ -/* 7. DEFAULT ...same as ALL, but includes default */ -/* message */ - -/* A "list" is a character string containing some or */ -/* all of the above words, delimited by commas. Examples */ -/* are: */ - -/* 1. 'SHORT, EXPLAIN' */ -/* 2. 'SHORT, LONG' */ -/* 3. 'ALL' */ -/* 4. 'NONE' */ -/* 5. 'ALL, NONE, ALL, SHORT, NONE' */ - -/* Each word in the list can be thought of as */ -/* "flipping a switch" to enable or disable the output */ -/* of the message(s) indicated by the word. The */ -/* words are acted on in the order they occur in the */ -/* list, starting with the leftmost word. As examples, */ -/* consider the sample lists above. */ - -/* The effect of the first list above, 'SHORT, EXPLAIN', */ -/* is to enable the output of the short error message */ -/* and the explanatory text corresponding to it. */ - -/* The effect of the second list is to enable the output */ -/* of the short and long messages. */ - -/* The effect of the third list is to enable the output of */ -/* all of the error messages (short, long, explanation */ -/* of the short message, and traceback). */ - -/* The effect of the fourth list is to disable output of */ -/* all of the messages. */ - -/* The effect of the fifth list is to disable output of */ -/* all of the messages. The reason for this is that */ -/* the words in the list are responded to in order, */ -/* from left to right, and "NONE" is the last word. */ - -/* If any words other than SHORT, LONG, EXPLAIN, ALL, */ -/* DEFAULT, TRACEBACK or NONE appear in LIST, those words */ -/* that are recognized are responded to. The words */ -/* that are not recognized are diagnosed as */ -/* erroneous, and error messages are generated */ -/* for each such unrecognized word. */ - -/* The length of LIST is caller-defined, but only */ -/* the first 100 characters of LIST will be saved */ -/* for later retrieval. */ - -/* Only the first 10 items in the list are used; */ -/* the rest are ignored. */ - -/* $ Detailed_Output */ - -/* LIST is a list of error message items. The value of */ -/* LIST is that set by the last call to this routine */ -/* using the 'SET' option. See "Detailed Input" */ -/* for a description of the possible values and */ -/* meanings of LIST. */ - -/* The initial value returned is 'DEFAULT'. */ - -/* Only the first 100 characters of LIST are saved */ -/* when the list is set; any additional characters */ -/* are truncated. Therefore, the first 100 */ -/* characters, at most, of the saved value of LIST */ -/* will be returned. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine detects invalid values of the argument, OP. */ -/* Invalid words in LIST are also detected. The short */ -/* error messages corresponding to these errors are: */ - -/* 1. 'SPICE(INVALIDOPERATION)' ... bad value of OP */ -/* 2. 'SPICE(INVALIDLISTITEM)' ... bad value in LIST */ - - -/* Also, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Please read the "required reading"! */ - -/* This routine is intended to be used in conjunction with */ -/* ERRDEV, which selects the default output device to which */ -/* the error messages selected by this routine will be */ -/* output. */ - -/* Additionally, the error response action must be */ -/* something other than 'IGNORE' if the error messages */ -/* are to be output. Possible choices of the error */ -/* response action are 'RETURN', 'REPORT', 'ABORT', 'DEFAULT', and */ -/* 'IGNORE'. Use ERRACT to set the error response action. */ - - -/* Only the first 100 characters of LIST are saved. */ - -/* The default set of error messages that are output is the */ -/* set specified by 'DEFAULT'; i.e., all of them, including */ -/* the 'default' message. */ - - -/* $ Examples */ - -/* 1. In this example, we select as the output device */ -/* the file, SPUD.DAT, and then select the error */ -/* messages to be output. We choose the short */ -/* error message and the traceback. Since a */ -/* different set of messages may have been selected */ -/* previously, we clear the old setting by putting */ -/* the word, 'NONE', at the beginning of the list. */ - -/* C */ -/* C Set the error output device to SPUD.DAT: */ -/* C */ - -/* CALL ERRDEV ( 'SET', 'SPUD.DAT' ) */ - -/* C */ -/* C Choose error messages: */ -/* C */ - -/* CALL ERRPRT ( 'SET', 'NONE, SHORT, TRACEBACK' ) */ - - - -/* $ Restrictions */ - -/* The device to which the selected error messages will */ -/* be written must be selected via ERRDEV; otherwise, */ -/* messages will be written to the initial default device. */ - -/* Only the first 100 characters of LIST are saved. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 28-AUG-1999 (NJB) */ - -/* Output string is now built on the fly. The routine previously */ -/* returned a saved string which could fail to represent correctly */ -/* the set of selected message types. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get/set error output items */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 28-AUG-1999 (NJB) */ - -/* Output string is now built on the fly. The routine previously */ -/* returned a saved string which could fail to represent correctly */ -/* the set of selected message types. */ - -/* - Beta Version 1.2.0, 16-FEB-1988 (NJB) */ - -/* Declaration of the unused variable TMPLST removed. */ -/* Trace participation added. This routine now checks in */ -/* and checks out. However, it does not test RETURN, */ -/* because it should be able to execute in RETURN mode when */ -/* an error condition exists. */ - -/* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */ - -/* Superfluous references to LASTNB removed. These references */ -/* were so many tonsils; they really had no function. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables: */ - - -/* Executable Code: */ - - chkin_("ERRPRT", (ftnlen)6); - -/* We first initialize the message selection flags to */ -/* correspond to the current selection of error messages: */ - - short__ = msgsel_("SHORT", (ftnlen)5); - long__ = msgsel_("LONG", (ftnlen)4); - expl = msgsel_("EXPLAIN", (ftnlen)7); - trace = msgsel_("TRACEBACK", (ftnlen)9); - dfault = msgsel_("DEFAULT", (ftnlen)7); - -/* We save the operation string as input, and get */ -/* an upper case version for our own use: */ - - ljust_(op, upop, op_len, (ftnlen)3); - ucase_(upop, upop, (ftnlen)3, (ftnlen)3); - if (s_cmp(upop, "GET", (ftnlen)3, (ftnlen)3) == 0) { - -/* Construct a string indicating which messages are enabled. */ - - s_copy(list, " ", list_len, (ftnlen)1); - if (short__) { - s_copy(list, "SHORT", list_len, (ftnlen)5); - } - if (long__) { - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - s_copy(list, "LONG", list_len, (ftnlen)4); - } else { - suffix_(", LONG", &c__0, list, (ftnlen)6, list_len); - } - } - if (expl) { - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - s_copy(list, "EXPLAIN", list_len, (ftnlen)7); - } else { - suffix_(", EXPLAIN", &c__0, list, (ftnlen)9, list_len); - } - } - if (trace) { - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - s_copy(list, "TRACEBACK", list_len, (ftnlen)9); - } else { - suffix_(", TRACEBACK", &c__0, list, (ftnlen)11, list_len); - } - } - if (dfault) { - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - s_copy(list, "DEFAULT", list_len, (ftnlen)7); - } else { - suffix_(", DEFAULT", &c__0, list, (ftnlen)9, list_len); - } - } - } else if (s_cmp(upop, "SET", (ftnlen)3, (ftnlen)3) == 0) { - -/* We parse the list of words, converting each word */ -/* to upper case, testing each word for validity, */ -/* and "flipping the switches" to enable or disable */ -/* the output of the various error messages as */ -/* directed by each word, starting with the leftmost. */ -/* We update local flags according to the words we */ -/* recognize, and update the global flags when we're */ -/* done parsing the list. */ - -/* If an invalid word is encountered, we signal an */ -/* error, and continue parsing the list. */ - - - lparse_(list, ",", &c__10, &numwrd, words, list_len, (ftnlen)1, ( - ftnlen)9); - i__1 = numwrd; - for (i__ = 1; i__ <= i__1; ++i__) { - ucase_(words + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("words", i__2, "errprt_", (ftnlen)434)) * 9, - upword, (ftnlen)9, (ftnlen)9); - if (s_cmp(upword, "SHORT", (ftnlen)9, (ftnlen)5) == 0) { - short__ = TRUE_; - } else if (s_cmp(upword, "LONG", (ftnlen)9, (ftnlen)4) == 0) { - long__ = TRUE_; - } else if (s_cmp(upword, "EXPLAIN", (ftnlen)9, (ftnlen)7) == 0) { - expl = TRUE_; - } else if (s_cmp(upword, "TRACEBACK", (ftnlen)9, (ftnlen)9) == 0) - { - trace = TRUE_; - } else if (s_cmp(upword, "ALL", (ftnlen)9, (ftnlen)3) == 0) { - short__ = TRUE_; - long__ = TRUE_; - expl = TRUE_; - trace = TRUE_; - } else if (s_cmp(upword, "DEFAULT", (ftnlen)9, (ftnlen)7) == 0) { - short__ = TRUE_; - long__ = TRUE_; - expl = TRUE_; - trace = TRUE_; - dfault = TRUE_; - } else if (s_cmp(upword, "NONE", (ftnlen)9, (ftnlen)4) == 0) { - short__ = FALSE_; - long__ = FALSE_; - expl = FALSE_; - trace = FALSE_; - dfault = FALSE_; - } else if (s_cmp(upword, " ", (ftnlen)9, (ftnlen)1) != 0) { - -/* Oops! Invalid word... */ - -/* Writing concatenation */ - i__3[0] = 80, a__1[0] = "ERRPRT: An invalid list item was fo" - "und in the error message list. The word was:"; - i__3[1] = 9, a__1[1] = words + ((i__2 = i__ - 1) < 10 && 0 <= - i__2 ? i__2 : s_rnge("words", i__2, "errprt_", ( - ftnlen)480)) * 9; - s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)89); - setmsg_(ch__1, (ftnlen)89); - sigerr_("SPICE(INVALIDLISTITEM)", (ftnlen)22); - } - -/* At this point, we have either set some set of */ -/* flags in response to WORD, or determined that */ -/* WORD was invalid. */ - - } - -/* We've now responded to all words in LIST. */ - - -/* Now we store the flag values we've set, for global */ -/* consumption (SETPRT doesn't actually detect errors). */ - - status = setprt_(&short__, &expl, &long__, &trace, &dfault); - } else { - -/* An invalid value of OP was supplied. */ - - s_copy(locop, op, (ftnlen)3, op_len); -/* Writing concatenation */ - i__3[0] = 62, a__1[0] = "ERRPRT: An invalid value of OP was supplie" - "d. The value was: "; - i__3[1] = 3, a__1[1] = locop; - s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)65); - setmsg_(ch__2, (ftnlen)65); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - } - chkout_("ERRPRT", (ftnlen)6); - return 0; -} /* errprt_ */ - diff --git a/ext/spice/src/cspice/errprt_c.c b/ext/spice/src/cspice/errprt_c.c deleted file mode 100644 index a3c252b19d..0000000000 --- a/ext/spice/src/cspice/errprt_c.c +++ /dev/null @@ -1,376 +0,0 @@ -/* - --Procedure errprt_c ( Get/Set Error Output Items ) - --Abstract - - Retrieve or set the list of error message items - to be output when an error is detected. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void errprt_c ( ConstSpiceChar * op, - SpiceInt lenout, - SpiceChar * list ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - op I The operation: "GET" or "SET". - lenout I Length of list for output. - list I/O Specification of error messages to be output. - --Detailed_Input - - op indicates the operation to be performed. Possible - values are "GET" and "SET". - - "SET" means, "the following list specifies the default - selection of error messages to be output." These are - the messages that will be output to the default error - output device (selected by errdev_c) when an error is - detected. - - "GET" means, "return the current list of error output - items." This is the exact list that was set by the - last call to this routine with the "SET" option. - - The option can be specified in mixed case. For example, - the following call will work: - - errprt_c ( "SeT", lenout, "ALL" ) - - - lenout is the allowed length of list when list is returning a - the error message list. The size described by lenout - should be large enough to hold any possible output plus 1. - - - list is a list of error message items. The items - are delimited by commas. The items that can be - in the list are the words: - - 1. SHORT ...indicates the short error message - 2. EXPLAIN ...the explanation of the short message - 3. LONG ...the long error message - 4. TRACEBACK ...the traceback - 5. ALL ...indicates "output all messages" - 6. NONE ...indicates "don't output any messages" - 7. DEFAULT ...same as ALL, but includes default - message - - A "list" is a character string containing some or - all of the above words, delimited by commas. Examples - are: - - 1. "SHORT, EXPLAIN" - 2. "SHORT, LONG" - 3. "ALL" - 4. "NONE" - 5. "ALL, NONE, ALL, SHORT, NONE" - - Each word in the list can be thought of as - "flipping a switch" to enable or disable the output - of the message(s) indicated by the word. The - words are acted on in the order they occur in the - list, starting with the leftmost word. As examples, - consider the sample lists above. - - The effect of the first list above, "SHORT, EXPLAIN", - is to enable the output of the short error message - and the explanatory text corresponding to it. - - The effect of the second list is to enable the output - of the short and long messages. - - The effect of the third list is to enable the output of - all of the error messages (short, long, explanation - of the short message, and traceback). - - The effect of the fourth list is to disable output of - all of the messages. - - The effect of the fifth list is to disable output of - all of the messages. The reason for this is that - the words in the list are responded to in order, - from left to right, and "NONE" is the last word. - - If any words other than SHORT, LONG, EXPLAIN, ALL, - DEFAULT, TRACEBACK or NONE appear in list, those words - that are recognized are responded to. The words - that are not recognized are diagnosed as - erroneous, and error messages are generated - for each such unrecognized word. - - The length of list is caller-defined, but only - the first 100 characters of list will be saved - for later retrieval. - - Only the first 10 items in the list are used; - the rest are ignored. - --Detailed_Output - - list is a list of error message items. The value of - list is that set by the last call to this routine - using the "SET" option. See "Detailed Input" - for a description of the possible values and - meanings of list. - - The initial value returned is "DEFAULT". - - Only the first 100 characters of list are saved - when the list is set; any additional characters - are truncated. Therefore, the first 100 - characters, at most, of the saved value of list - will be returned. - --Parameters - - None. - --Exceptions - - 1) If the input argument op does not indicate a valid operation, - the error SPICE(INVALIDOPERATION) will be signaled. - - 2) If the input argument list does not indicate a valid list of - error message types, the error SPICE(INVALIDLISTITEM) will be - signaled. - - 3) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 4) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - - 5) The user must pass a value indicating the length of the output - string, when list is an output. If this value is not at least 2, - the error SPICE(STRINGTOOSHORT) is signaled. - - Also, this routine is part of the CSPICE error - handling mechanism. - --Files - - None. - --Particulars - - Please read the "required reading"! - - This routine is intended to be used in conjunction with - errdev_c, which selects the default output device to which - the error messages selected by this routine will be - output. - - Additionally, the error response action must be - something other than "IGNORE" if the error messages - are to be output. Possible choices of the error - response action are "RETURN", "REPORT", "ABORT", "DEFAULT", and - "IGNORE". Use erract_c to set the error response action. - - - Only the first 100 characters of list are saved. - - The default set of error messages that are output is the - set specified by "DEFAULT"; i.e., all of them, including - the "default" message. - - --Examples - - 1. In this example, we select as the output device - the file, SPUD.DAT, and then select the error - messages to be output. We choose the short - error message and the traceback. Since a - different set of messages may have been selected - previously, we clear the old setting by putting - the word, "NONE", at the beginning of the list. - - /. - Set the error output device to SPUD.DAT: - ./ - errdev_c ( "SET", lenout, "SPUD.DAT" ); - - /. - Choose error messages: - ./ - errprt_c ( "SET", lenout, "NONE, SHORT, TRACEBACK" ); - - - 2. In this example we are retrieving the error message list. - - /. - Declare the output string and its size. - ./ - - #define LENOUT 50 - - SpiceChar list[ LENOUT ]; - - errdev_c ( "GET", LENOUT, list ); - - --Restrictions - - The device to which the selected error messages will - be written must be selected via errdev_c; otherwise, - messages will be written to the initial default device. - - Only the first 100 characters of list are saved. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.3.0, 24-JUN-2003 (NJB) - - Bug fix: case of invalid operation keyword is now - diagnosed, as per the Exceptions section of the header. - - -CSPICE Version 2.0.0, 09-FEB-1998 (NJB) (EDW) - - Input argument op was changed to type ConstSpiceChar *. - - Re-implemented routine without dynamically allocated, temporary - strings. - - Corrected errors in examples in which the call sequence - was incorrect. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - get/set error output items - --& -*/ - -{ /* Begin errprt_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "errprt_c" ); - - - /* - Check the input string op to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "errprt_c", op ); - - - if ( eqstr_c ( op, "SET") ) - { - - /* - Operation is SET. The argument "list" will be an input string. - Check "list" as well. - */ - CHKFSTR ( CHK_STANDARD, "errprt_c", list ); - - - errprt_( ( char * ) op, - ( char * ) list, - ( ftnlen ) strlen(op), - ( ftnlen ) strlen(list) ); - } - - else if ( eqstr_c (op, "GET" ) ) - { - - /* - Operation is GET. "list" will be an output string. - - Make sure the output string has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "errprt_c", list, lenout ); - - /* - After the routine call, create a C string from the - Fortran output string. - */ - errprt_( ( char * ) op, - ( char * ) list, - ( ftnlen ) strlen(op), - ( ftnlen ) lenout-1 ); - - - F2C_ConvertStr( lenout, list ); - } - - else - { - setmsg_c ( "Input argument op had value: # " - "Valid choices are GET or SET." ); - errch_c ( "#", op ); - sigerr_c ( "SPICE(INVALIDOPERATION)" ); - chkout_c ( "errprt_c" ); - return; - } - - - chkout_c ( "errprt_c" ); - - -} /* End errprt_c */ diff --git a/ext/spice/src/cspice/esrchc.c b/ext/spice/src/cspice/esrchc.c deleted file mode 100644 index 10669e6e0c..0000000000 --- a/ext/spice/src/cspice/esrchc.c +++ /dev/null @@ -1,173 +0,0 @@ -/* esrchc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ESRCHC ( Equivalence search, character ) */ -integer esrchc_(char *value, integer *ndim, char *array, ftnlen value_len, - ftnlen array_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer i__; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Search for a given value within a character string array. */ -/* Return the index of the first equivalent array entry, or zero */ -/* if no equivalent element is found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Key value to be found in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Character string array to search. */ - -/* The function returns the index of the first array entry */ -/* equivalent to VALUE, or zero if none is found. */ - -/* $ Detailed_Input */ - -/* VALUE I is an arbitrary character string. */ - -/* NDIM I is the dimension of (number of elements in) */ -/* an array of character strings. */ - -/* ARRAY I is the array. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the first element of the */ -/* input array equivalent to the input value, or zero if the */ -/* array contains no such elements. */ - -/* Two strings are equivalent if they contain the same characters */ -/* in the same order, when blanks are ignored and uppercase and */ -/* lowercase characters are considered equal. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* ESRCHC is identical to ISRCHC, except that it looks for */ -/* the first equivalent string (as defined by EQSTR) instead */ -/* of the first identical one. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* ARRAY(1) = 'This' */ -/* ARRAY(2) = 'little' */ -/* ARRAY(3) = 'piggy' */ -/* ARRAY(4) = 'went' */ -/* ARRAY(5) = 'to' */ -/* ARRAY(6) = 'market' */ - -/* Then */ - -/* ESRCHC ( 'PIGGY', 6, ARRAY ) = 3 */ -/* ESRCHC ( ' LiTtLe ', 6, ARRAY ) = 2 */ -/* ESRCHC ( 'W e n t', 6, ARRAY ) = 4 */ -/* ESRCHC ( 'mall', 6, ARRAY ) = 0 */ - -/* $ Restrictions */ - -/* ESRCHC assumes that the function EQSTR does not participate */ -/* in normal SPICELIB error handling. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* search array for equivalent character_string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Just like ISRCHC. */ - - ret_val = 0; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if (eqstr_(array + (i__ - 1) * array_len, value, array_len, value_len) - ) { - ret_val = i__; - return ret_val; - } - } - return ret_val; -} /* esrchc_ */ - diff --git a/ext/spice/src/cspice/esrchc_c.c b/ext/spice/src/cspice/esrchc_c.c deleted file mode 100644 index 496088594b..0000000000 --- a/ext/spice/src/cspice/esrchc_c.c +++ /dev/null @@ -1,230 +0,0 @@ -/* - --Procedure esrchc_c ( Equivalence search, character ) - --Abstract - - Search for a given value within a character string array. - Return the index of the first equivalent array entry, or -1 - if no equivalent element is found. - --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 - - ARRAY, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef esrchc_c - - SpiceInt esrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Key value to be found in array. - ndim I Dimension of array. - lenvals I String length. - array I Character string array to search. - - The function returns the index of the first array entry - equivalent to value, or -1 if none is found. - --Detailed_Input - - value is the key value to be found in the array. Trailing - blanks in this key are not significant: string matches - found by this routine do not require trailing blanks in - value to match those in the corresponding element of - array. - - ndim 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 - - [ndim][lenvals] - - array is the array of character srings to be searched. Trailing - blanks in the strings in this array are not significant. - --Detailed_Output - - The function returns the index of the first element of the - input array equivalent to the input value, or -1 if the - array contains no such elements. - - Two strings are equivalent if they contain the same characters - in the same order, when blanks are ignored and uppercase and - lowercase characters are considered equal. - --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 - - esrchc_c is identical to isrchc_c, except that it looks for - the first equivalent string (as defined by eqstr_c) instead - of the first identical one. - --Examples - - Let array be declared with dimension - - [NDIM][STRLEN] - - and contain the following elements: - - array[0] == "This" - array[1] == "little" - array[2] == "piggy" - array[3] == "went" - array[4] == "to" - array[5] == "market" - - Then - - esrchc_c ( "PIGGY", NDIM, STRLEN, array ) == 2 - esrchc_c ( " LiTtLe ", NDIM, STRLEN, array ) == 1 - esrchc_c ( "W e n t", NDIM, STRLEN, array ) == 3 - esrchc_c ( "mall", NDIM, STRLEN, array ) == -1 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 22-JUL-2002 (NJB) (IMU) - --Index_Entries - - search array for equivalent character_string - --& -*/ - -{ /* Begin esrchc_c */ - - - /* - Local macros - */ - #define ARRAY( i ) ( ( (SpiceChar *)array ) + (i)*lenvals ) - - /* - Local variables - */ - SpiceInt i; - - - /* - Use discovery check-in. - - Return immediately if the array dimension is non-positive. - */ - if ( ndim < 1 ) - { - return ( -1 ); - } - - - /* - Make sure the input pointer for the key value is non-null - and that the length is adequate. - */ - CHKPTR_VAL ( CHK_DISCOVER, "esrchc_c", value, -1 ); - - - /* - Make sure the input pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR_VAL ( CHK_DISCOVER, "esrchc_c", array, lenvals, -1 ); - - - for ( i = 0; i < ndim; i++ ) - { - if ( eqstr_c( value, ARRAY(i) ) ) - { - return ( i ); - } - } - - /* - Indicate no match was found. - */ - return ( -1 ); - - - -} /* End esrchc_c */ diff --git a/ext/spice/src/cspice/et2lst.c b/ext/spice/src/cspice/et2lst.c deleted file mode 100644 index 455c451fd8..0000000000 --- a/ext/spice/src/cspice/et2lst.c +++ /dev/null @@ -1,592 +0,0 @@ -/* et2lst.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b4 = 0.; -static doublereal c_b6 = 1.; -static integer c__10 = 10; -static integer c__2 = 2; -static integer c__1 = 1; -static doublereal c_b32 = -43200.; -static doublereal c_b33 = 43200.; -static doublereal c_b34 = 3600.; -static doublereal c_b35 = 60.; -static integer c__5 = 5; -static integer c__7 = 7; - -/* $Procedure ET2LST ( ET to Local Solar Time ) */ -/* Subroutine */ int et2lst_(doublereal *et, integer *body, doublereal * - long__, char *type__, integer *hr, integer *mn, integer *sc, char * - time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len) -{ - /* System generated locals */ - address a__1[5], a__2[7]; - integer i__1[5], i__2[7]; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - doublereal rate, slat, mins; - char h__[2], m[2]; - integer n; - doublereal q; - char s[2]; - doublereal angle; - char frame[32]; - doublereal range; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), dpfmt_( - doublereal *, char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal state[6], slong; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen); - doublereal hours; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern doublereal twopi_(void); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern doublereal pi_(void); - char bodnam[36]; - doublereal lt; - integer frcode; - extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical - *, ftnlen); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int reclat_(doublereal *, doublereal *, - doublereal *, doublereal *), rmaind_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal secnds; - extern /* Subroutine */ int pgrrec_(char *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, ftnlen); - char bpmkwd[32]; - integer hrampm; - doublereal tmpang; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen); - char amorpm[4]; - doublereal tmpsec; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - doublereal mylong, spoint[3]; - extern logical return_(void); - char kwtype[1]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - char mytype[32]; - doublereal lat; - -/* $ Abstract */ - -/* Given an ephemeris epoch ET, compute the local solar time for */ -/* an object on the surface of a body at a specified longitude. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch in seconds past J2000 epoch */ -/* BODY I ID-code of the body of interest */ -/* LONG I Longitude of surface point (RADIANS) */ -/* TYPE I Type of longitude 'PLANETOCENTRIC', etc. */ -/* HR O Local hour on a "24 hour" clock */ -/* MN O Minutes past the hour */ -/* SC O Seconds past the minute */ -/* TIME O String giving local time on 24 hour clock */ -/* AMPM O String giving time on A.M./ P.M. scale */ - -/* $ Detailed_Input */ - -/* ET is the epoch expressed in TDB seconds past */ -/* the J2000 epoch at which a local time is desired. */ - -/* BODY is the NAIF ID-code of a body on which local */ -/* time is to be measured. */ - -/* LONG is the longitude (either planetocentric or */ -/* planetographic) in radians of the site on the */ -/* surface of body for which local time should be */ -/* computed. */ - -/* TYPE is the form of longitude supplied by the variable */ -/* LONG. Allowed values are 'PLANETOCENTRIC' and */ -/* 'PLANETOGRAPHIC'. Note the case of the letters */ -/* in TYPE is insignificant. Both 'PLANETOCENTRIC' */ -/* and 'planetocentric' are recognized. */ - -/* $ Detailed_Output */ - -/* HR is the local "hour" of the site specified at the */ -/* epoch ET. Note that an "hour" of local time does not */ -/* have the same duration as an hour measured by */ -/* conventional clocks. It is simply a representation */ -/* of an angle. See the "Particulars" section for a more */ -/* complete discussion of the meaning of local time. */ - -/* MN is the number of "minutes" past the hour of the */ -/* local time of the site at the epoch ET. Again note */ -/* that a "local minute" is not the same as a minute */ -/* you would measure with conventional clocks. */ - -/* SC is the number of "seconds" past the minute of the */ -/* local time of the site at the epoch ET. Again note */ -/* that a "local second" is not the same as a second */ -/* you would measure with conventional clocks. */ - -/* TIME is a string expressing the local time */ -/* on a "24 hour" local clock. */ - -/* AMPM is a string expressing the local time on a "12 hour" */ -/* local clock together with the traditional AM/PM */ -/* label to indicate whether the sun has crossed */ -/* the local zenith meridian. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine defines local solar time for any point on the */ -/* surface of the Sun to be 12:00:00 noon. */ - -/* 2) If the TYPE of the coordinates is not recognized, the */ -/* error 'SPICE(UNKNOWNSYSTEM)' will be signaled. */ - -/* 3) If the body-fixed frame to associate with BODY cannot be */ -/* determined, the error 'SPICE(CANTFINDFRAME)' is signaled. */ - -/* 4) If insufficient data is available to compute the */ -/* location of the sun in body-fixed coordinates, the */ -/* error will be diagnosed by a routine called by this one. */ - -/* 5) If the BODY#_PM keyword required to determine the body */ -/* rotation sense is not found in the POOL or if it is found but */ -/* is not a numeric keyword with at least two elements, the error */ -/* 'SPICE(CANTGETROTATIONTYPE)' is signaled. */ - -/* $ Files */ - -/* Suitable SPK and PCK files must be loaded prior to calling this */ -/* routine so that the body-fixed position of the sun relative to */ -/* BODY can be computed. The PCK files must contain the standard */ -/* BODY#_PM keyword need by this routine to determine the body */ -/* rotation sense. */ - -/* When the input longitude is planetographic, the default */ -/* interpretation of this value can be overridden using the optional */ -/* kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* which is normally defined via loading a text kernel. */ - -/* $ Particulars */ - -/* This routine returns the local solar time at a user */ -/* specified location on a user specified body. */ - -/* Let SUNLNG be the planetocentric longitude (in degrees) of */ -/* the sun as viewed from the center of the body of interest. */ - -/* Let SITLNG be the planetocentric longitude (in degrees) of */ -/* the site for which local time is desired. */ - -/* We define local time to be 12 + (SITLNG - SUNLNG)/15 */ - -/* (where appropriate care is taken to map ( SITLNG - SUNLNG ) */ -/* into the range from -180 to 180). */ - -/* Using this definition, we see that from the point of view */ -/* of this routine, local solar time is simply a measure of angles */ -/* between meridians on the surface of a body. Consequently, */ -/* this routine is not appropriate for computing "local times" */ -/* in the sense of Pacific Standard Time. For computing times */ -/* relative to standard time zones on earth, see the routines */ -/* TIMOUT and STR2ET. */ - - -/* Regarding planetographic longitude */ -/* ---------------------------------- */ - -/* In the planetographic coordinate system, longitude is defined */ -/* using the spin sense of the body. Longitude is positive to the */ -/* west if the spin is prograde and positive to the east if the spin */ -/* is retrograde. The spin sense is given by the sign of the first */ -/* degree term of the time-dependent polynomial for the body's prime */ -/* meridian Euler angle "W": the spin is retrograde if this term is */ -/* negative and prograde otherwise. For the sun, planets, most */ -/* natural satellites, and selected asteroids, the polynomial */ -/* expression for W may be found in a SPICE PCK kernel. */ - -/* The earth, moon, and sun are exceptions: planetographic longitude */ -/* is measured positive east for these bodies. */ - -/* If you wish to override the default sense of positive */ -/* planetographic longitude for a particular body, you can do so by */ -/* defining the kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* where represents the NAIF ID code of the body. This */ -/* variable may be assigned either of the values */ - -/* 'WEST' */ -/* 'EAST' */ - -/* For example, you can have this routine treat the longitude */ -/* of the earth as increasing to the west using the kernel */ -/* variable assignment */ - -/* BODY399_PGR_POSITIVE_LON = 'WEST' */ - -/* Normally such assignments are made by placing them in a text */ -/* kernel and loading that kernel via FURNSH. */ - - -/* $ Examples */ - -/* The following code fragment illustrates how you */ -/* could print the local time at a site on Mars with */ -/* planetographic longitude 326.17 deg E at epoch ET. */ - -/* (This example assumes all required SPK and PCK files have */ -/* been loaded). */ - -/* Convert the longitude to radians, set the type of the longitude */ -/* and make up a mnemonic for Mars' ID-code. */ - -/* LONG = 326.17 * RPD() */ -/* TYPE = 'PLANETOGRAPHIC' */ -/* MARS = 499 */ - -/* CALL ET2LST ( ET, MARS, LONG, TYPE, HR, MN, SC, TIME, AMPM ) */ - -/* WRITE (*,*) 'The local time at Mars 326.17 degrees E ' */ -/* WRITE (*,*) 'planetographic longitude is: ', AMPM */ - -/* $ Restrictions */ - -/* This routine relies on being able to determine the name */ -/* of the body-fixed frame associated with BODY through the */ -/* frames subsystem. If the BODY specified is NOT one of the */ -/* nine planets or their satellites, you will need to load */ -/* an appropriate frame definition kernel that contains */ -/* the relationship between the body id and the body-fixed frame */ -/* name. See the FRAMES required reading for more details */ -/* on specifying this relationship. */ - -/* The routine determines the body rotation sense using the PCK */ -/* keyword BODY#_PM. Therefore, you will need to a text PCK file */ -/* defining the complete set of the standard PCK body rotation */ -/* keywords for the body of interest. The text PCK file must be */ -/* loaded independently of whether a binary PCK file providing */ -/* rotation data for the same body is loaded or not. */ - -/* Although it is not currently the case for any of the Solar System */ -/* bodies, it is possible that the retrograde rotation rate of a */ -/* body would be slower than the orbital rate of the body rotation */ -/* around the Sun. The routine does not account for such cases; for */ -/* them it will compute incorrect the local time progressing */ -/* backwards. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.1, 09-SEP-2009 (EDW) */ - -/* Header edits: deleted a spurious C$ marker from the */ -/* "Detailed_Output" section. The existence of the marker */ -/* caused a failure in the HTML documentation creation script. */ - -/* Deleted the "Revisions" section as it contained several */ -/* identical entries from the "Version" section. */ - -/* Corrected order of header sections. */ - -/* - SPICELIB Version 3.0.0, 28-OCT-2006 (BVS) */ - -/* Bug fix: incorrect computation of the local time for the */ -/* bodies with the retrograde rotation causing the local time to */ -/* flow backwards has been fixed. The local time for all types of */ -/* bodies now progresses as expected -- midnight, increasing AM */ -/* hours, noon, increasing PM hours, next midnight, and so on. */ - -/* - SPICELIB Version 2.0.0, 03-NOV-2005 (NJB) */ - -/* Bug fix: treatment of planetographic longitude has been */ -/* updated to be consistent with the SPICE planetographic/ */ -/* rectangular coordinate conversion routines. The effect of */ -/* this change is that the default sense of positive longitude */ -/* for the moon is now east; also, the default sense of positive */ -/* planetographic longitude now may be overridden for any body */ -/* (see Particulars above). */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAIND calls. */ - -/* - SPICELIB Version 1.1.0, 24-MAR-1998 (WLT) */ - -/* The integer variable SUN was never initialized in the */ -/* previous version of the routine. Now it is set to */ -/* the proper value of 10. */ - -/* - SPICELIB Version 1.0.0, 9-JUL-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Compute the local time for a point on a body. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local parameters */ - - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ET2LST", (ftnlen)6); - ljust_(type__, mytype, type_len, (ftnlen)32); - ucase_(mytype, mytype, (ftnlen)32, (ftnlen)32); - if (s_cmp(mytype, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - -/* Find planetocentric longitude corresponding to the input */ -/* longitude. We first represent in rectangular coordinates */ -/* a surface point having zero latitude, zero altitude, and */ -/* the input planetographic longitude. We then find the */ -/* planetocentric longitude of this point. */ - -/* Since PGRREC accepts a body name, map the input code to */ -/* a name, if possible. Otherwise, just convert the input code */ -/* to a string. */ - - bodc2n_(body, bodnam, &found, (ftnlen)36); - if (! found) { - intstr_(body, bodnam, (ftnlen)36); - } - -/* Convert planetographic coordinates to rectangular coordinates. */ -/* All we care about here is longitude. Set the other inputs */ -/* as follows: */ - -/* Latitude = 0 */ -/* Altitude = 0 */ -/* Equatorial radius = 1 */ -/* Flattening factor = 0 */ - - pgrrec_(bodnam, long__, &c_b4, &c_b4, &c_b6, &c_b4, spoint, (ftnlen) - 36); - -/* The output MYLONG is planetocentric longitude. The other */ -/* outputs are not used. Note that the variable RANGE appears */ -/* later in another RECLAT call; it's not used after that. */ - - reclat_(spoint, &range, &mylong, &lat); - } else if (s_cmp(mytype, "PLANETOCENTRIC", (ftnlen)32, (ftnlen)14) == 0) { - mylong = *long__; - } else { - setmsg_("The coordinate system '#' is not a recognized system of lon" - "gitude. The recognized systems are 'PLANETOCENTRIC' and 'PL" - "ANETOGRAPHIC'. ", (ftnlen)134); - errch_("#", type__, (ftnlen)1, type_len); - sigerr_("SPICE(UNKNOWNSYSTEM)", (ftnlen)20); - chkout_("ET2LST", (ftnlen)6); - return 0; - } - -/* It's always noon on the surface of the sun. */ - - if (*body == 10) { - *hr = 12; - *mn = 0; - *sc = 0; - s_copy(time, "12:00:00", time_len, (ftnlen)8); - s_copy(ampm, "12:00:00 P.M.", ampm_len, (ftnlen)13); - chkout_("ET2LST", (ftnlen)6); - return 0; - } - -/* Get the body-fixed position of the sun. */ - - cidfrm_(body, &frcode, frame, &found, (ftnlen)32); - if (! found) { - setmsg_("The body-fixed frame associated with body # could not be de" - "termined. This information needs to be \"loaded\" via a fra" - "mes definition kernel. See FRAMES.REQ for more details. ", ( - ftnlen)174); - errint_("#", body, (ftnlen)1); - sigerr_("SPICE(CANTFINDFRAME)", (ftnlen)20); - chkout_("ET2LST", (ftnlen)6); - return 0; - } - spkez_(&c__10, et, frame, "LT+S", body, state, <, (ftnlen)32, (ftnlen)4) - ; - reclat_(state, &range, &slong, &slat); - angle = mylong - slong; - -/* Force the angle into the region from -PI to PI */ - - d__1 = twopi_(); - rmaind_(&angle, &d__1, &q, &tmpang); - angle = tmpang; - if (angle > pi_()) { - angle -= twopi_(); - } - -/* Get the rotation sense of the body and invert the angle if the */ -/* rotation sense is retrograde. Use the BODY#_PM PCK keyword to */ -/* determine the sense of the body rotation. */ - - s_copy(bpmkwd, "BODY#_PM", (ftnlen)32, (ftnlen)8); - repmi_(bpmkwd, "#", body, bpmkwd, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(bpmkwd, &found, &n, kwtype, (ftnlen)32, (ftnlen)1); - if (! found || *(unsigned char *)kwtype != 'N' || n < 2) { - setmsg_("The rotation type for the body # could not be determined be" - "cause the # keyword was either not found in the POOL or or i" - "t was not of the expected type and/or dimension. This keywor" - "d is usually provided via a planetary constants kernel. See " - "PCK.REQ for more details. ", (ftnlen)265); - errint_("#", body, (ftnlen)1); - errch_("#", bpmkwd, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(CANTGETROTATIONTYPE)", (ftnlen)26); - chkout_("ET2LST", (ftnlen)6); - return 0; - } else { - -/* If the rotation rate is negative, invert the angle. */ - - gdpool_(bpmkwd, &c__2, &c__1, &n, &rate, &found, (ftnlen)32); - if (rate < 0.) { - angle = -angle; - } - } - -/* Convert the angle to "angle seconds" before or after local noon. */ - - secnds = angle * 86400. / twopi_(); - secnds = brcktd_(&secnds, &c_b32, &c_b33); - -/* Get the hour, and minutes components of the local time. */ - - rmaind_(&secnds, &c_b34, &hours, &tmpsec); - rmaind_(&tmpsec, &c_b35, &mins, &secnds); - -/* Construct the integer components of the local time. */ - - *hr = (integer) hours + 12; - *mn = (integer) mins; - *sc = (integer) secnds; - -/* Set the A.M./P.M. components of local time. */ - - if (*hr == 24) { - *hr = 0; - hrampm = 12; - s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4); - } else if (*hr > 12) { - hrampm = *hr - 12; - s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4); - } else if (*hr == 12) { - hrampm = 12; - s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4); - } else if (*hr == 0) { - hrampm = 12; - s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4); - } else { - hrampm = *hr; - s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4); - } - -/* Now construct the two strings we need. */ - - hours = (doublereal) (*hr); - mins = (doublereal) (*mn); - secnds = (doublereal) (*sc); - dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2); - dpfmt_(&mins, "0x", m, (ftnlen)2, (ftnlen)2); - dpfmt_(&secnds, "0x", s, (ftnlen)2, (ftnlen)2); -/* Writing concatenation */ - i__1[0] = 2, a__1[0] = h__; - i__1[1] = 1, a__1[1] = ":"; - i__1[2] = 2, a__1[2] = m; - i__1[3] = 1, a__1[3] = ":"; - i__1[4] = 2, a__1[4] = s; - s_cat(time, a__1, i__1, &c__5, time_len); - hours = (doublereal) hrampm; - dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2); -/* Writing concatenation */ - i__2[0] = 2, a__2[0] = h__; - i__2[1] = 1, a__2[1] = ":"; - i__2[2] = 2, a__2[2] = m; - i__2[3] = 1, a__2[3] = ":"; - i__2[4] = 2, a__2[4] = s; - i__2[5] = 1, a__2[5] = " "; - i__2[6] = 4, a__2[6] = amorpm; - s_cat(ampm, a__2, i__2, &c__7, ampm_len); - chkout_("ET2LST", (ftnlen)6); - return 0; -} /* et2lst_ */ - diff --git a/ext/spice/src/cspice/et2lst_c.c b/ext/spice/src/cspice/et2lst_c.c deleted file mode 100644 index 7365ff575f..0000000000 --- a/ext/spice/src/cspice/et2lst_c.c +++ /dev/null @@ -1,389 +0,0 @@ -/* - --Procedure et2lst_c ( ET to Local Solar Time ) - --Abstract - - Given an ephemeris epoch, compute the local solar time for - an object on the surface of a body at a specified longitude. - --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 - - TIME - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void et2lst_c ( SpiceDouble et, - SpiceInt body, - SpiceDouble lon, - ConstSpiceChar * type, - SpiceInt timlen, - SpiceInt ampmlen, - SpiceInt * hr, - SpiceInt * mn, - SpiceInt * sc, - SpiceChar * time, - SpiceChar * ampm ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - et I Epoch in seconds past J2000 epoch. - body I ID-code of the body of interest. - lon I Longitude of surface point (RADIANS). - type I Type of longitude "PLANETOCENTRIC", etc. - timlen I Available room in output time string. - ampmlen I Available room in output `ampm' string. - hr O Local hour on a "24 hour" clock. - mn O Minutes past the hour. - sc O Seconds past the minute. - time O String giving local time on 24 hour clock. - ampm O String giving time on A.M./ P.M. scale. - --Detailed_Input - - `et' is the epoch expressed in TDB seconds past - the J2000 epoch at which a local time is desired. - - body is the NAIF ID-code of a body on which local - time is to be measured. - - lon is the longitude (either planetocentric or - planetographic) in radians of the site on the - surface of body for which local time should be - computed. - - type is the form of longitude supplied by the variable - lon. Allowed values are "PLANETOCENTRIC" and - "PLANETOGRAPHIC". Note the case of the letters - in type is insignificant. Both "PLANETOCENTRIC" - and "planetocentric" are recognized. Leading and - trailing blanks in type are not significant. - - timlen The maximum allowed length of the output time string. - This length must large enough to hold the time string - plus the terminator. If the output string is expected to - have x characters, timlen needs to be x + 1. - - ampmlen The maximum allowed length of the output `ampm' string. - This length must large enough to hold the apmpm string - plus the terminator. If the output string is expected to - have x characters, ampmlen needs to be x + 1. - --Detailed_Output - - hr is the local "hour" of the site specified at the epoch - `et'. Note that an "hour" of local time does not have the - same duration as an hour measured by conventional clocks. - It is simply a representation of an angle. See - Particulars for a more complete discussion of the meaning - of local time. - - mn is the number of "minutes" past the hour of the local - time of the site at the epoch `et'. Again note that a - "local minute" is not the same as a minute you would - measure with conventional clocks. - - sc is the number of "seconds" past the minute of the local - time of the site at the epoch `et'. Again note that a - "local second" is not the same as a second you would - measure with conventional clocks. - - time is a string expressing the local time on a "24 hour" - local clock. - - ampm is a string expressing the local time on a "12 hour" - local clock together with the traditional AM/PM label to - indicate whether the sun has crossed the local zenith - meridian. - --Parameters - - None. - --Exceptions - - 1) This routine defines local solar time for any point on the - surface of the Sun to be 12:00:00 noon. - - 2) If the type of the coordinates is not recognized, the - error SPICE(UNKNOWNSYSTEM) will be signaled. - - 3) If the bodyfixed frame to associate with body cannot be - determined, the error SPICE(CANTFINDFRAME) is signaled. - - 4) If insufficient data are available to compute the - location of the sun in bodyfixed coordinates, the - error will be diagnosed by a routine called by this one. - - 5) If the input type string is empty, the error SPICE(EMPTYSTRING) - will be signaled. - - 6) If any of the routine's string arguments have null pointers, the - error SPICE(NULLPOINTER) will be signaled. - - 7) If either of the output strings are too short to accommodate - at least one character of data in addition to a terminating - null character, the error SPICE(STRINGTOOSHORT) will be - signaled. - --Files - - Suitable SPK and PCK files must be loaded prior to calling this - routine so that the bodyfixed position of the sun relative to `body' - can be computed. - - When the input longitude is planetographic, the default - interpretation of this value can be overridden using the optional - kernel variable - - BODY_PGR_POSITIVE_LON - - which is normally defined via loading a text kernel. - --Particulars - - This routine returns the local solar time at a user - specified location on a user specified body. - - Let SUNLNG be the planetocentric longitude (in degrees) of - the sun as viewed from the center of the body of interest. - - Let SITLNG be the planetocentric longitude (in degrees) of - the site for which local time is desired. - - We define local time to be 12 + (SITLNG - SUNLNG)/15 - - (where appropriate care is taken to map ( SITLNG - SUNLNG ) - into the range from -180 to 180). - - Using this definition, we see that from the point of view - of this routine, local solar time is simply a measure of angles - between meridians on the surface of a body. Consequently, - this routine is not appropriate for computing "local times" - in the sense of Pacific Standard Time. For computing times - relative to standard time zones on earth, see the routines - timout_c and str2et_c. - - Regarding planetographic longitude - ---------------------------------- - - In the planetographic coordinate system, longitude is defined using - the spin sense of the body. Longitude is positive to the west if - the spin is prograde and positive to the east if the spin is - retrograde. The spin sense is given by the sign of the first degree - term of the time-dependent polynomial for the body's prime meridian - Euler angle "W": the spin is retrograde if this term is negative - and prograde otherwise. For the sun, planets, most natural - satellites, and selected asteroids, the polynomial expression for W - may be found in a SPICE PCK kernel. - - The earth, moon, and sun are exceptions: planetographic longitude - is measured positive east for these bodies. - - If you wish to override the default sense of positive planetographic - longitude for a particular body, you can do so by defining the - kernel variable - - BODY_PGR_POSITIVE_LON - - where represents the NAIF ID code of the body. This - variable may be assigned either of the values - - 'WEST' - 'EAST' - - For example, you can have this routine treat the longitude of the - earth as increasing to the west using the kernel variable assignment - - BODY399_PGR_POSITIVE_LON = 'WEST' - - Normally such assignments are made by placing them in a text kernel - and loading that kernel via furnsh_c. - --Examples - - The following code fragment illustrates how you could print the - local time at a site on Mars with planetographic longitude 326.17 - deg E at epoch et. - - Convert the longitude to radians, set the type of the longitude and - make up a mnemonic for MARS's ID-code. - - #include - #include "SpiceUsr.h" - - int main () - { - /. - In a user's program, the LSK, PCK and SPK files named - below should be replaced with names of applicable - files. - ./ - #define LSK "naif0007.tls" - #define PCK "pck00007.tpc" - #define SPK "de405s.bsp" - - #define TIMLEN 51 - #define AMPMLEN 51 - #define MARS 499 - #define TYPE "PLANETOGRAPHIC" - - SpiceChar ampm [ AMPMLEN ]; - SpiceChar time [ TIMLEN ]; - - SpiceDouble dlon; - SpiceDouble et; - SpiceDouble rlon; - - SpiceInt hr; - SpiceInt mn; - SpiceInt sc; - - furnsh_c ( PCK ); - furnsh_c ( SPK ); - furnsh_c ( LSK ); - - dlon = 326.17; - rlon = dlon * rpd_c(); - - str2et_c ( "2002 sep 2 00:00:00", &et ); - - et2lst_c ( et, MARS, rlon, TYPE, TIMLEN, AMPMLEN, - &hr, &mn, &sc, time, ampm ); - - printf ( "The local time at Mars %6.2f degrees E " - "planetographic longitude is: %s\n", - dlon, ampm ); - - return ( 0 ); - } - - - --Restrictions - - This routine relies on being able to determine the name of the - bodyfixed frame associated with body through the frames subsystem. - If the body specified is NOT one of the nine planets or their - satellites, you will need to load an appropriate frame definition - kernel that contains the relationship between the body ID and the - bodyfixed frame name. See the FRAMES Required Reading for more - details on specifying this relationship. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 2.0.0, 03-NOV-2005 (NJB) - - Bug fix: treatment of planetographic longitude has been - updated to be consistent with the SPICE planetographic/ - rectangular coordinate conversion routines. The effect of - this change is that the default sense of positive longitude - for the moon is now east; also, the default sense of positive - planetographic longitude now may be overridden for any body - (see Particulars above). - - -CSPICE Version 1.0.0, 02-SEP-2002 (NJB) (WLT) - --Index_Entries - - Compute the local time for a point on a body. - --& -*/ - -{ /* Begin et2lst_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "et2lst_c" ); - - /* - Check the input type argument. - */ - CHKFSTR ( CHK_STANDARD, "et2lst_c", type ); - - /* - Check the output arguments. - */ - CHKOSTR ( CHK_STANDARD, "et2lst_c", time, timlen ); - CHKOSTR ( CHK_STANDARD, "et2lst_c", ampm, ampmlen ); - - - et2lst_ ( ( doublereal * ) &et, - ( integer * ) &body, - ( doublereal * ) &lon, - ( char * ) type, - ( integer * ) hr, - ( integer * ) mn, - ( integer * ) sc, - ( char * ) time, - ( char * ) ampm, - ( ftnlen ) strlen(type), - ( ftnlen ) timlen-1, - ( ftnlen ) ampmlen-1 ); - - /* - Convert the output strings from Fortran to C style. - */ - F2C_ConvertStr ( timlen, time ); - F2C_ConvertStr ( ampmlen, ampm ); - - - chkout_c ( "et2lst_c" ); - -} /* End et2lst_c */ - diff --git a/ext/spice/src/cspice/et2utc.c b/ext/spice/src/cspice/et2utc.c deleted file mode 100644 index 555b8275fd..0000000000 --- a/ext/spice/src/cspice/et2utc.c +++ /dev/null @@ -1,816 +0,0 @@ -/* et2utc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static doublereal c_b22 = 10.; -static integer c__1 = 1; - -/* $Procedure ET2UTC ( Ephemeris Time to UTC ) */ -/* Subroutine */ int et2utc_(doublereal *et, char *format, integer *prec, - char *utcstr, ftnlen format_len, ftnlen utcstr_len) -{ - /* Initialized data */ - - static char mthnam[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" - "AUG" "SEP" "OCT" "NOV" "DEC"; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double d_int(doublereal *), pow_di(doublereal *, integer *), d_nint( - doublereal *); - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer), - i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer bday, eday, year; - static doublereal tvec[8]; - static integer hour, i__; - static doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char fract[80]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - static integer month; - extern logical failed_(void); - static doublereal frcsec; - static integer second; - static doublereal whlsec; - static integer bmonth, emonth; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen); - static char endstr[80]; - static integer myprec, minute; - extern /* Subroutine */ int setmsg_(char *, ftnlen), dpstrf_(doublereal *, - integer *, char *, char *, ftnlen, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen); - extern doublereal unitim_(doublereal *, char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), ttrans_( - char *, char *, doublereal *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - static integer bsc, esc, bhr, bmn; - static doublereal tai; - static integer day, ehr, emn; - static char fmt[4], str[80]; - -/* $ Abstract */ - -/* Convert an input time from ephemeris seconds past J2000 */ -/* to Calendar, Day-of-Year, or Julian Date format, UTC. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch, given in ephemeris seconds past J2000. */ -/* FORMAT I Format of output epoch. */ -/* PREC I Digits of precision in fractional seconds or days. */ -/* UTCSTR O Output time string, UTC. */ - -/* $ Detailed_Input */ - -/* ET is the input epoch, ephemeris seconds past J2000. */ - -/* FORMAT is the format of the output time string. It may be */ -/* any of the following: */ - - -/* 'C' Calendar format, UTC. */ - -/* 'D' Day-of-Year format, UTC. */ - -/* 'J' Julian Date format, UTC. */ - -/* 'ISOC' ISO Calendar format, UTC. */ - -/* 'ISOD' ISO Day-of-Year format, UTC. */ - -/* PREC is the number of digits of precision to which */ -/* fractional seconds (for Calendar and Day-of-Year */ -/* formats) or days (for Julian Date format) are to */ -/* be computed. If PREC is zero or smaller, no decimal */ -/* point is appended to the output string. If PREC is */ -/* greater than 14, it is treated as 14. */ - -/* $ Detailed_Output */ - -/* UTCSTR is the output time string equivalent to the input */ -/* epoch, in the specified format. Some examples are */ -/* shown below. */ - -/* 'C' '1986 APR 12 16:31:09.814' */ -/* 'D' '1986-102 // 16:31:12.814' */ -/* 'J' 'JD 2446533.18834276' */ -/* 'ISOC' '1987-04-12T16:31:12.814' */ -/* 'ISOD' '1987-102T16:31:12.814' */ - -/* If an error occurs, UTCSTR is not changed. */ - -/* Fractional seconds, or for Julian dates, fractional */ -/* days, are rounded to the precision level specified */ -/* by the input argument PREC. */ - -/* UTCSTR should be declared to be at least */ -/* 20 + PREC characters in length to ensure */ -/* sufficient room to hold calendar strings */ -/* for modern epochs. For epochs prior to */ -/* 1000 A.D. at least 24 + PREC characters in */ -/* length are required to hold the output */ -/* calendar string. */ - -/* For epochs prior to 1000 A.D. Jan 1 calendar */ -/* and day of year formats are returned with the */ -/* era (A.D. or B.C.) attached to the year. For */ -/* example */ - -/* '877 A.D. MAR 17 13:29:11.829' */ -/* '471 B.C. Jan 01 12:00:00.000' */ -/* '471 B.C. 001 // 12:00:00.000' */ - -/* ISO formats do not support the inclusion of an era. */ -/* For years prior to 1 A.D. an error will be signaled */ -/* if ISO format has been requested. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the format for the output string is not recognized, the */ -/* error SPICE(INVALIDTIMEFORMAT) is signaled. */ - -/* 2) If PREC is less than or equal to zero, it is treated as */ -/* zero. If PREC is greater than 14, it is treated as 14. */ - -/* 3) If one of the ISO formats is specified (ISOC or ISOD) but */ -/* the year corresponding to ET is prior to 1 A.D. on the */ -/* Gregorian Calendar, the error SPICE(YEAROUTOFRANGE) will */ -/* be signaled. */ - -/* 4) Epochs prior to 15 Oct, 1582 on the Gregorian calendar (the */ -/* calendar commonly used in western societies) are returned in */ -/* the "extended" Gregorian Calendar. To convert epochs to the */ -/* Julian calendar see the entry point GR2JUL in the routine */ -/* JUL2GR. */ - -/* 5) This routine does not attempt to account for variations */ -/* in the length of the second that were in effect prior */ -/* to Jan 1, 1972. For days prior to that date, we assume */ -/* there are exactly 86400 ephemeris seconds. Consequently */ -/* the UTC Gregorian calendar strings produced for epochs */ -/* prior to Jan 1, 1972 differ from the corresponding */ -/* TDB calendar strings by approximately 41.18 seconds. */ -/* (TDB Gregorian calendar strings are produced by the */ -/* routine ETCAL). */ - -/* 6) If a leapseconds kernel has not been loaded prior to calling */ -/* this routine, an error will be signaled by a routine in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine handles the task of converting a double precision */ -/* representation of an epoch to a character string suitable for */ -/* human consumption. The more general routine TIMOUT may also be */ -/* used to convert ET to time strings. */ - -/* $ Examples */ - -/* Let the value of ET be -527644192.5403653 ephemeris seconds */ -/* past J2000. Assuming that the nominal values in the kernel pool */ -/* have not been altered, the following calls */ - -/* CALL ET2UTC ( ET, 'C', 0, UTCSTR ) */ -/* CALL ET2UTC ( ET, 'C', 3, UTCSTR ) */ -/* CALL ET2UTC ( ET, 'D', 5, UTCSTR ) */ -/* CALL ET2UTC ( ET, 'J', 7, UTCSTR ) */ - -/* produce the following output strings */ - -/* '1983 APR 13 12:09:14' */ -/* '1983 APR 13 12:09:14.274' */ -/* '1983-103 // 12:09:14.27400' */ -/* 'JD 2445438.0064152' */ - -/* respectively. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* Jesperson and Fitz-Randolph, From Sundials to Atomic Clocks, */ -/* Dover Publications, New York, 1977. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* W.M. Owen (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.4, 06-APR-2009 (NJB) */ - -/* Header was updated to state that fractional */ -/* seconds or days are rounded in the output */ -/* string. */ - -/* - SPICELIB Version 3.0.3, 28-JAN-2008 (BVS) */ - -/* Fixed typo in the ISOC example string in Detailed_Output. */ - -/* - SPICELIB Version 3.0.2, 29-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity and */ -/* more fully explain the routine's functionality. */ - -/* - SPICELIB Version 3.0.1, 14-SEP-2000 (EDW) */ - -/* Added FAILED check after TTRANS call during the calendar "C" */ -/* format processing to catch failure signal from TTRANS. */ -/* Lack of this check caused CSPICE based programs to core dump */ -/* if ET2UTC was called without a leapseconds kernel while */ -/* error action was set to RETURN. */ - -/* - SPICELIB Version 3.0.0, 13-MAR-1996 (WLT) */ - -/* The construction of the numerical components of the */ -/* output string are now handled by the SPICELIB routine */ -/* TTRANS. */ - -/* In addition the routine now supports the ISO formats and */ -/* the era associated with an epoch (B.C. or A.D.) in non */ -/* ISO formats. */ - -/* - SPICELIB Version 2.1.0, 11-JUL-1995 (KRG) */ - -/* Removed some potential compile warnings that could be caused */ -/* by truncation of double precision values to integers through */ -/* a direct assignment. The direct assignment has been replaced */ -/* with a call to the intrinsic function IDINT. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 21-MAR-1991 (NJB) (JML) */ - -/* Two bugs involving rounding errors were corrected. One of */ -/* the bugs caused conversion errors of magnitude as large as */ -/* 1 second. See $Revisions for details. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* ephemeris time to utc */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 13-MAR-1995 (WLT) */ - -/* The construction of the numerical components of the */ -/* output string are now handled by the SPICELIB routine */ -/* TTRANS. */ - -/* In addition the routine now supports the era associated */ -/* with an epoch (B.C. or A.D.) */ - -/* - SPICELIB Version 2.1.0, 11-JUL-1995 (KRG) */ - -/* Removed some potential compile warnings that could be caused */ -/* by truncation of double precision values to integers through */ -/* a direct assignment. The direct assignment has been replaced */ -/* with a call to the intrinsic function IDINT. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 21-MAR-1991 (NJB) (JML) */ - -/* 1) In the previous version of this routine, the algorithm */ -/* that was used permitted inconsistent conversion of the */ -/* integer and fractional parts of the UTC value corresponding */ -/* to the input ET value. */ - -/* In the case where rounding the double precision UTC time */ -/* corresponding to the input ET value to PREC decimal places */ -/* resulted in a carry (to the integer portion of the UTC */ -/* value), the integer portion of the UTC value was treated */ -/* correctly, but the fraction was not always rounded correctly. */ -/* The specific case where the problem occurred was when the */ -/* input ET value mapped to a UTC time having a fractional */ -/* part that rounded up to 1.0 when rounded PREC decimal places, */ -/* but that did not round up to 1.0 when rounded to the nearest */ -/* PREC+1 decimal places. The set of such fractions can be */ -/* represented as */ - -/* { 1 - EPSILON : EPSILON < 5 * ( 10 ** -(PREC+1) ) */ -/* - */ -/* and */ - -/* EPSILON > 5 * ( 10 ** -(PREC+2) ) */ - -/* } */ - -/* For example, if the input ET mapped to the UTC time */ - -/* 2 JAN 1991 00:34:12.99994, */ - -/* then a call to this routine with PREC set to 3 would result */ -/* in the output */ - -/* 2 JAN 1991 00:34:13.999 */ - -/* instead of the correct value */ - -/* 2 JAN 1991 00:34:13.000 */ - -/* On the other hand, if the input ET mapped to the UTC time */ - -/* 2 JAN 1991 00:34:12.99996, */ - -/* then a call to this routine with PREC set to 3 would result */ -/* in the correct output. */ - - -/* This error was apparently difficult to generate: it has */ -/* never been reported by any SPICELIB users, and was eventually */ -/* discovered by NAIF staff. */ - - - -/* 2) The second bug is somewhat less severe, as far as the */ -/* magnitude of the error is concerned. However, it's easier */ -/* to generate this error. Namely, in some cases, the */ -/* fractional part of the input ET value is rounded to PREC */ -/* SIGNIFICANT DIGITS, rather than to PREC decimal places. */ -/* The effect of this is that the fraction is occasionally */ -/* truncated rather than rounded. For example, the ET value */ -/* equivalent to the UTC string */ - -/* 1991 JAN 2 00:34:12.0009 */ - -/* would be converted to */ - -/* 1991 JAN 2 00:34:12.000 */ - -/* instead of the correct value */ - -/* 1991 JAN 2 00:34:12.001 */ - -/* when the input argument PREC was set equal to 3. */ - - - -/* The modifications made to solve these problems are as */ -/* follows: */ - -/* 1) The input ET value, after conversion to `UTC seconds */ -/* past 2000', is broken up into the sum of a whole */ -/* number of seconds and a non-negative, fractional */ -/* number of seconds. The fact that the fractional */ -/* part is non-negative simplifies the conversion of the */ -/* fraction. */ - -/* 2) The fraction is rounded to PREC decimal places--- */ -/* that is, to the nearest integer multiple of */ -/* 10**(-PREC). If the rounding results in a carry, */ -/* the whole number portion of the time value is */ -/* incremented by 1 second. After this step, the */ -/* whole number of seconds correctly accounts for */ -/* any necessary rounding of the fraction. */ - -/* 3) The whole number portion of the time value is passed */ -/* through the inverse Muller-Wimberly algorithm to */ -/* obtain years, months, days, hours, minutes, and */ -/* whole seconds. A small fraction is added to the */ -/* whole number to prevent round-off error from occurring */ -/* when divisions are performed. */ - -/* 4) The fraction is converted to a string using the */ -/* SPICELIB routine DPSTRF. To ensure that DPSTRF */ -/* produces an output string containing PREC decimal */ -/* places, an integer is added to the fraction value */ -/* before supplying it to DPSTRF. This integer */ -/* `anchors' the first significant digit of the input */ -/* value in the units place. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Functions (Statement Functions) */ - - -/* Local variables */ - - -/* Save everything between calls */ - - -/* Initial values */ - - -/* The function NDIGIT gives the number of digits required to */ -/* display a non-negative integer that is less than 10000 */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ET2UTC", (ftnlen)6); - -/* Convert FORMAT to uppercase for ease of comparison. Make sure it's */ -/* one of the recognized formats. */ - - ucase_(format, fmt, format_len, (ftnlen)4); - if (s_cmp(fmt, "J", (ftnlen)4, (ftnlen)1) != 0 && s_cmp(fmt, "C", (ftnlen) - 4, (ftnlen)1) != 0 && s_cmp(fmt, "D", (ftnlen)4, (ftnlen)1) != 0 - && s_cmp(fmt, "ISOD", (ftnlen)4, (ftnlen)4) != 0 && s_cmp(fmt, - "ISOC", (ftnlen)4, (ftnlen)4) != 0) { - setmsg_("ET2UTC: Format specification for output time string is not " - "recognized. Valid specifications are: 'C', 'D', 'J', 'ISOC'," - " or 'ISOD'. The supplied format was '#'. ", (ftnlen)160); - errch_("#", format, (ftnlen)1, format_len); - sigerr_("SPICE(INVALIDTIMEFORMAT)", (ftnlen)24); - chkout_("ET2UTC", (ftnlen)6); - return 0; - } - -/* Force PREC into an acceptable range */ - -/* Computing MAX */ - i__1 = 0, i__2 = min(14,*prec); - myprec = max(i__1,i__2); - -/* If the output is Julian Date, we're ready to go. Remember that */ -/* the day part of Julian Date already has seven digits built in. */ - - if (s_cmp(fmt, "J", (ftnlen)4, (ftnlen)1) == 0) { - tvec[0] = *et; - ttrans_("TDB", "JDUTC", tvec, (ftnlen)3, (ftnlen)5); - if (failed_()) { - chkout_("ET2UTC", (ftnlen)6); - return 0; - } - i__1 = myprec + 7; - dpstrf_(tvec, &i__1, "F", str, (ftnlen)1, (ftnlen)80); - prefix_("JD", &c__0, str, (ftnlen)2, (ftnlen)80); - s_copy(utcstr, str, utcstr_len, (ftnlen)80); - chkout_("ET2UTC", (ftnlen)6); - return 0; - } - -/* If we've dropped past the IF-THEN block above, we need */ -/* to construct a calendar format string. First thing to */ -/* do is convert from ET to TAI. */ - - tai = unitim_(et, "TDB", "TAI", (ftnlen)3, (ftnlen)3); - -/* We're going to break up TAI into an integer and a */ -/* fractional part. The integer will be the greatest */ -/* integer less than or equal to TAI, and the fraction */ -/* will be the difference between TAI and the integer */ -/* part. The fraction will always be in the interval */ - -/* [0, 1) */ - -/* After making this decomposition, we'll adjust the integer */ -/* and fraction to take rounding into account. The result */ -/* of the adjustment is that the fraction will be an integer */ -/* number of time units of length 10**(-MYPREC) seconds, where */ -/* the integer is in the range [0, (10**MYPREC)-1]. If the */ -/* fraction rounds up to 1, the fraction will be set to zero, */ -/* and the whole number portion of TAI will be incremented. */ - -/* Since the integers involved may be too large to represent */ -/* using the INTEGER data type, we'll represent them with */ -/* double precision numbers. We'll use the intrinsic ANINT */ -/* function to keep round-off from creeping into these d.p. */ -/* numbers representing integers. */ - -/* Find the greatest integer less than or equal to TAI. */ -/* Recall that INT truncates toward the origin. If TAI */ -/* is negative and is not already an integer, the result we */ -/* want is one less than AINT(TAI). */ - - whlsec = d_int(&tai); - if (tai < 0. && tai != whlsec) { - whlsec += -1.; - } - -/* The fractional part of TAI must be rounded to the */ -/* nearest multiple of 10**(-MYPREC). Fractions that are */ -/* equidistant from two multiples of 10**(-MYPREC) are */ -/* rounded up. */ - -/* To accomplish the rounding, we scale the fraction by */ -/* 10**MYPREC. */ - - - d__1 = pow_di(&c_b22, &myprec); - scale = d_nint(&d__1); - d__1 = scale * (tai - whlsec); - frcsec = d_nint(&d__1); - -/* If a carry occurred, the fraction becomes zero, and */ -/* we must increment WHLSEC. */ - - if (frcsec == scale) { - whlsec += 1.; - frcsec = 0.; - } - frcsec /= scale; - -/* Now, we let TTRANS handle the transformation to */ -/* the desired components for output. */ - -/* FRCSEC will be converted to a string containing MYPREC digits. */ -/* This will be done later on when the output string is */ -/* assembled. */ - - tvec[0] = whlsec; - if (s_cmp(fmt, "C", (ftnlen)4, (ftnlen)1) == 0 || s_cmp(fmt, "ISOC", ( - ftnlen)4, (ftnlen)4) == 0) { - ttrans_("TAI", "YMD", tvec, (ftnlen)3, (ftnlen)3); - if (failed_()) { - chkout_("ET2UTC", (ftnlen)6); - return 0; - } - year = i_dnnt(tvec); - month = i_dnnt(&tvec[1]); - day = i_dnnt(&tvec[2]); - hour = i_dnnt(&tvec[3]); - minute = i_dnnt(&tvec[4]); - second = i_dnnt(&tvec[5]); - -/* The beginning of the string is going to be the year. */ -/* Depending upon the size of the year, it may or */ -/* may not have an era label. However the end of the */ -/* string has a fixed size. We set up that portion of the */ -/* string now. First fill in the month... */ - - if (s_cmp(fmt, "C", (ftnlen)4, (ftnlen)1) == 0) { - s_copy(endstr, " MMM 00 00:00:00", (ftnlen)80, (ftnlen)16); - s_copy(endstr + 1, mthnam + ((i__1 = month - 1) < 12 && 0 <= i__1 - ? i__1 : s_rnge("mthnam", i__1, "et2utc_", (ftnlen)650)) * - 3, (ftnlen)3, (ftnlen)3); - -/* ... and then fill in the day portion of the string. */ - - eday = 7; -/* Computing MIN */ - i__1 = 1, i__2 = day / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = day / 100; -/* Computing MIN */ - i__5 = 1, i__6 = day / 10; - bday = eday - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + - 1) + 1; - intstr_(&day, endstr + (bday - 1), eday - (bday - 1)); - ehr = 10; - emn = 13; - esc = 16; - } else { - s_copy(endstr, "-0M-00T00:00:00", (ftnlen)80, (ftnlen)15); - eday = 6; -/* Computing MIN */ - i__1 = 1, i__2 = day / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = day / 100; -/* Computing MIN */ - i__5 = 1, i__6 = day / 10; - bday = eday - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + - 1) + 1; - emonth = 3; -/* Computing MIN */ - i__1 = 1, i__2 = month / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = month / 100; -/* Computing MIN */ - i__5 = 1, i__6 = month / 10; - bmonth = emonth - (min(i__1,i__2) + min(i__3,i__4) + min(i__5, - i__6) + 1) + 1; - intstr_(&month, endstr + (bmonth - 1), emonth - (bmonth - 1)); - intstr_(&day, endstr + (bday - 1), eday - (bday - 1)); - ehr = 9; - emn = 12; - esc = 15; - } - } else { - -/* We must have day of year format. Convert TAI to that */ -/* format. */ - - ttrans_("TAI", "YD", tvec, (ftnlen)3, (ftnlen)2); - if (failed_()) { - chkout_("ET2UTC", (ftnlen)6); - return 0; - } - year = i_dnnt(tvec); - month = 1; - day = i_dnnt(&tvec[1]); - hour = i_dnnt(&tvec[2]); - minute = i_dnnt(&tvec[3]); - second = i_dnnt(&tvec[4]); - -/* As in the previous case, the end of the output string will */ -/* have a fixed size. We fill in the day portion of the string */ -/* now. Note that we have set things up so that the hour, */ -/* minutes and seconds appear in the same location in both */ -/* day of year and calendar format of strings. */ - - if (s_cmp(fmt, "D", (ftnlen)4, (ftnlen)1) == 0) { - s_copy(endstr, "-000 // 00:00:00", (ftnlen)80, (ftnlen)16); - eday = 4; -/* Computing MIN */ - i__1 = 1, i__2 = day / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = day / 100; -/* Computing MIN */ - i__5 = 1, i__6 = day / 10; - bday = eday - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + - 1) + 1; - intstr_(&day, endstr + (bday - 1), eday - (bday - 1)); - ehr = 10; - emn = 13; - esc = 16; - } else { - s_copy(endstr, "-000T00:00:00", (ftnlen)80, (ftnlen)13); - eday = 4; -/* Computing MIN */ - i__1 = 1, i__2 = day / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = day / 100; -/* Computing MIN */ - i__5 = 1, i__6 = day / 10; - bday = eday - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + - 1) + 1; - intstr_(&day, endstr + (bday - 1), eday - (bday - 1)); - ehr = 7; - emn = 10; - esc = 13; - } - } - -/* Fill out the hours, minutes and integer portion of */ -/* seconds in the output string. */ - -/* Computing MIN */ - i__1 = 1, i__2 = hour / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = hour / 100; -/* Computing MIN */ - i__5 = 1, i__6 = hour / 10; - bhr = ehr - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + 1) + 1; -/* Computing MIN */ - i__1 = 1, i__2 = minute / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = minute / 100; -/* Computing MIN */ - i__5 = 1, i__6 = minute / 10; - bmn = emn - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + 1) + 1; -/* Computing MIN */ - i__1 = 1, i__2 = second / 1000; -/* Computing MIN */ - i__3 = 1, i__4 = second / 100; -/* Computing MIN */ - i__5 = 1, i__6 = second / 10; - bsc = esc - (min(i__1,i__2) + min(i__3,i__4) + min(i__5,i__6) + 1) + 1; - intstr_(&hour, endstr + (bhr - 1), ehr - (bhr - 1)); - intstr_(&minute, endstr + (bmn - 1), emn - (bmn - 1)); - intstr_(&second, endstr + (bsc - 1), esc - (bsc - 1)); - -/* Append the fractional part of the seconds component. */ - - if (myprec > 0) { - -/* DPSTRF gives MYPREC significant digits in the output, */ -/* not necessarily MYPREC digits to the right of the */ -/* decimal point. We will add a one-digit integer to */ -/* FRCSEC to `anchor' the first significant digit of */ -/* FRCSEC in a known place. That way, we can get DPSTRF */ -/* to give us a known number of digits after the decimal */ -/* point. */ - -/* The integer part of FRCSEC will not affect the output */ -/* string. */ - - frcsec += 1.; - i__1 = myprec + 1; - dpstrf_(&frcsec, &i__1, "F", fract, (ftnlen)1, (ftnlen)80); - i__ = i_indx(fract, ".", (ftnlen)80, (ftnlen)1); - i__1 = esc; - s_copy(endstr + i__1, fract + (i__ - 1), 80 - i__1, i__ + myprec - ( - i__ - 1)); - } - -/* The end of the time string is now complete. We need to */ -/* construct the year portion of the string. We are going to */ -/* append an era if the year is before 1000 A.D. Note that */ -/* we make sure the first character in the ending string */ -/* is a blank (' ') if the era is to be attached. Otherwise */ -/* we'd get confusing day of year formats like */ -/* 999 A.D.-019 // 12:13:18. */ - - if (year >= 1000) { - intstr_(&year, str, (ftnlen)80); - } else if (year > 0) { - intstr_(&year, str, (ftnlen)80); - if (s_cmp(fmt, "C", (ftnlen)4, (ftnlen)1) == 0 || s_cmp(fmt, "D", ( - ftnlen)4, (ftnlen)1) == 0) { - suffix_("A.D.", &c__1, str, (ftnlen)4, (ftnlen)80); - *(unsigned char *)endstr = ' '; - } - } else if (year <= 0) { - if (s_cmp(fmt, "C", (ftnlen)4, (ftnlen)1) == 0 || s_cmp(fmt, "D", ( - ftnlen)4, (ftnlen)1) == 0) { - year = -year + 1; - intstr_(&year, str, (ftnlen)80); - suffix_("B.C.", &c__1, str, (ftnlen)4, (ftnlen)80); - *(unsigned char *)endstr = ' '; - } else { - year = -year + 1; - setmsg_("The year of the ET epoch supplied is # B.C. Years in t" - "his era are not supported in ISO format. ", (ftnlen)96); - errint_("#", &year, (ftnlen)1); - sigerr_("SPICE(YEAROUTOFRANGE)", (ftnlen)21); - chkout_("ET2UTC", (ftnlen)6); - return 0; - } - } - -/* Finally append the ENDSTR to STR to get the fully formatted */ -/* string. */ - - suffix_(endstr, &c__0, str, (ftnlen)80, (ftnlen)80); - s_copy(utcstr, str, utcstr_len, (ftnlen)80); - chkout_("ET2UTC", (ftnlen)6); - return 0; -} /* et2utc_ */ - diff --git a/ext/spice/src/cspice/et2utc_c.c b/ext/spice/src/cspice/et2utc_c.c deleted file mode 100644 index 2a3c4b5ac4..0000000000 --- a/ext/spice/src/cspice/et2utc_c.c +++ /dev/null @@ -1,370 +0,0 @@ -/* - --Procedure et2utc_c ( Ephemeris Time to UTC ) - --Abstract - - Convert an input time from ephemeris seconds past J2000 - to Calendar, Day-of-Year, or Julian Date format, UTC. - --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 - - TIME - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void et2utc_c ( SpiceDouble et, - ConstSpiceChar * format, - SpiceInt prec, - SpiceInt lenout, - SpiceChar * utcstr ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - et I Input epoch, given in ephemeris seconds past J2000. - format I Format of output epoch. - prec I Digits of precision in fractional seconds or days. - lenout I The length of the output string plus 1. - utcstr O Output time string, UTC. - --Detailed_Input - - et is the input epoch, ephemeris seconds past J2000. - - format is the format of the output time string. It may be - any of the following: - - - "C" Calendar format, UTC. - - "D" Day-of-Year format, UTC. - - "J" Julian Date format, UTC. - - "ISOC" ISO Calendar format, UTC. - - "ISOD" ISO Day-of-Year format, UTC. - - prec is the number of digits of precision to which - fractional seconds (for Calendar and Day-of-Year - formats) or days (for Julian Date format) are to - be computed. If PREC is zero or smaller, no decimal - point is appended to the output string. If PREC is - greater than 14, it is treated as 14. - - lenout The allowed length of the output string. This length - must large enough to hold the output string plus the - null terminator. If the output string is expected to - have x characters, lenout must be x + 1. - --Detailed_Output - - utcstr is the output time string equivalent to the input - epoch, in the specified format. Some examples are - shown below. - - "C" "1986 APR 12 16:31:09.814" - "D" "1986-102 // 16:31:12.814" - "J" "JD 2446533.18834276" - "ISOC" "1987-04-12T16:31:12.814" - "ISOD" "1987-102T16:31:12.814" - - If an error occurs, utcstr is not changed. - - Fractional seconds, or for Julian dates, fractional - days, are rounded to the precision level specified - by the input argument `prec'. - - utcstr should be declared to be at least - 20 + prec characters in length to ensure - sufficient room to hold calendar strings - for modern epochs. For epochs prior to - 1000 A.D. at least 24 + prec characters in - length are required to hold the output - calendar string. - - For epochs prior to 1000 A.D. Jan 1 calendar - and day of year formats are returned with the - era (A.D. or B.C.) attached to the year. For - example - - "877 A.D. MAR 17 13:29:11.829" - "471 B.C. Jan 01 12:00:00.000" - "471 B.C. 001 // 12:00:00.000" - - ISO formats do not support the inclusion of - an era. For years prior to 1 A.D. an error - will be signaled if ISO format has been requested. - --Parameters - - None. - --Exceptions - - 1) If the format for the output string is not recognized, the - error SPICE(INVALIDTIMEFORMAT) is signaled. - - 2) If prec is less than or equal to zero, it is treated as - zero. If prec is greater than 14, it is treated as 14. - - 3) If one of the ISO formats is specified (ISOC or ISOD) but - the year corresponding to ET is prior to 1 A.D. on the - Gregorian Calendar, the error SPICE(YEAROUTOFRANGE) will - be signaled. - - 4) Epochs prior to 15 Oct, 1582 on the Gregorian calendar (the - calendar commonly used in western societies) are returned in the - "extended" Gregorian Calendar. To convert epochs to the Julian - calendar see the header of the function gr2jul_ in the file - jul2gr.c. - - 5) This routine does not attempt to account for variations - in the length of the second that were in effect prior - to Jan 1, 1972. For days prior to that date, we assume - there are exactly 86400 ephemeris seconds. Consequently - the UTC gregorian calendar strings produced for epochs - prior to Jan 1, 1972 differ from the corresponding - TDB calendar strings by approximately 41.18 seconds. - (TDB gregorian calendar strings are produced by the - routine ETCAL). - - 6) The error SPICE(NULLPOINTER) is signaled if either of - the input or output string pointers is null. - - 7) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled. - - 8) The caller must pass a value indicating the length of the output - string. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) is signaled. - - 9) The user's processing environment must be properly initialized by - loading a leapseconds kernel via the routine furnsh_c before - calling this routine. If a leapsecond kernel has not been - loaded, an error will be signaled by a routine in the call tree - of this routine. - --Files - - A leapseconds kernel must be loaded via furnsh_c prior to - calling this routine. The kernel need be loaded only - once during a program run. - --Particulars - - This routine handles the task of converting a double precision - representation of an epoch to a character string suitable for human - consumption. The more general routine timout_c may also be used to - convert ET to time strings. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - Let the value of ET be -527644192.5403653 ephemeris seconds - past J2000. Assuming that the nominal values in the kernel pool - have not been altered, the following calls - - et2utc_c ( et, "C", 0, lenout, utcstr ); - et2utc_c ( et, "C", 3, lenout, utcstr ); - et2utc_c ( et, "D", 5, lenout, utcstr ); - et2utc_c ( et, "J", 7, lenout, utcstr ); - - produce the following output strings - - 1983 APR 13 12:09:14 - 1983 APR 13 12:09:14.274 - 1983-103 // 12:09:14.27400 - JD 2445438.0064152 - - respectively, where lenout is the length of utcstr. - - An example program. - - #include - - #include "SpiceUsr.h" - - int main() - { - /. - Local variables - ./ - SpiceDouble et = -527644192.5403653; - - SpiceChar * leap = "naif0007.tls"; - ConstSpiceChar * format; - SpiceChar * utcstr; - - SpiceInt prec; - - SpiceInt lenout = 35; - - format = "J"; - prec = 6; - - /. - Load the leapseconds kernel. - ./ - furnsh_c ( leap ); - et2utc_c ( et , format, prec, lenout, utcstr ); - - printf ( "ET: %18.7f\n" - "Converted output: %s\n", - et, - utcstr ); - - return ( 0 ); - } - - - The program output is - - ET: -527644192.5403653 - Converted output: JD 2445438.006415 - - --Restrictions - - None. - --Literature_References - - Jesperson and Fitz-Randolph, From Sundials to Atomic Clocks, - Dover Publications, New York, 1977. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - W.M. Owen (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.5, 06-APR-2009 (NJB) - - Header was updated to state that fractional - seconds or days are rounded in the output - string. - - -CSPICE Version 1.1.4, 28-JAN-2008 (BVS) - - Fixed typo in the ISOC example string in Detailed_Output. - - -CSPICE Version 1.1.3, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.1.2, 11-JAN-2006 (EDW) - - Added a CHKFSTR check call on the 'format' input string. - - -CSPICE Version 1.1.1, 29-JUL-2003 (NJB) (CHA) - - Various header changes were made to improve clarity and - more fully explain the routine's functionality. - - -CSPICE Version 1.1.0, 09-FEB-1998 (NJB) (EDW) - - Re-implemented routine without dynamically allocated, temporary - strings. Added Exceptions section and corrected typo in chkout_c - module name. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - ephemeris time to utc - --& -*/ - -{ /* Begin et2utc_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "et2utc_c" ); - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "et2utc_c", format ); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "et2utc_c", utcstr, lenout ); - - - /* - Call the f2c'd Fortran routine. - */ - et2utc_( ( doublereal * ) &et, - ( char * ) format, - ( integer * ) &prec, - ( char * ) utcstr, - ( ftnlen ) strlen(format), - ( ftnlen ) lenout-1 ); - - /* - The string returned, utcstr, is a Fortranish type string. - Convert the string to C type. - */ - F2C_ConvertStr ( lenout, utcstr ); - - chkout_c ( "et2utc_c" ); - - -} /* End et2utc_c */ diff --git a/ext/spice/src/cspice/etcal.c b/ext/spice/src/cspice/etcal.c deleted file mode 100644 index bc01bcb339..0000000000 --- a/ext/spice/src/cspice/etcal.c +++ /dev/null @@ -1,630 +0,0 @@ -/* etcal.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2000 = 2000; -static integer c__1 = 1; -static integer c__12 = 12; -static integer c__6 = 6; - -/* $Procedure ETCAL ( Convert ET to Calendar format ) */ -/* Subroutine */ int etcal_(doublereal *et, char *string, ftnlen string_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer extra[12] = { 0,0,1,1,1,1,1,1,1,1,1,1 }; - static integer dpjan0[12] = { 0,31,59,90,120,151,181,212,243,273,304,334 } - ; - static integer dpbegl[12] = { 0,31,60,91,121,152,182,213,244,274,305,335 } - ; - static char months[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" - "AUG" "SEP" "OCT" "NOV" "DEC"; - - /* System generated locals */ - address a__1[12]; - integer i__1, i__2, i__3[12]; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double d_int(doublereal *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - static integer dn2000; - static doublereal dp2000, frac; - static char date[180]; - static doublereal remd, secs; - static integer year, mins; - static char dstr[16], hstr[16], mstr[16], sstr[16], ystr[16]; - static doublereal halfd, q; - static integer tsecs, dofyr, month, hours; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static doublereal mynum; - static integer bh, bm, iq; - static doublereal secspd; - static char messge[16]; - static integer offset; - static doublereal dmnint; - static logical adjust; - static integer daynum; - extern integer intmin_(void), intmax_(void); - extern /* Subroutine */ int dpstrf_(doublereal *, integer *, char *, char - *, ftnlen, ftnlen); - static doublereal dmxint, mydnom; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern integer lstlti_(integer *, integer *, integer *); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - static integer yr1, yr4; - static char era[16]; - static integer day, rem; - extern doublereal spd_(void); - static integer yr100, yr400; - -/* $ Abstract */ - - -/* Convert from an ephemeris epoch measured in seconds past */ -/* the epoch of J2000 to a calendar string format using a */ -/* formal calendar free of leapseconds. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris time measured in seconds past J2000. */ -/* STRING O A standard calendar representation of ET. */ - -/* $ Detailed_Input */ - -/* ET is an epoch measured in ephemeris seconds */ -/* past the epoch of J2000. */ - -/* $ Detailed_Output */ - -/* STRING is a calendar string representing the input ephemeris */ -/* epoch. This string is based upon extending the */ -/* Gregorian Calendar backward and forward indefinitely */ -/* keeping the same rules for determining leap years. */ -/* Moreover, there is no accounting for leapseconds. */ - -/* To be sure that all of the date can be stored in */ -/* STRING, it should be declared to have length at */ -/* least 48 characters. */ - -/* The string will have the following format */ - -/* year (era) mon day hr:mn:sc.sss */ - -/* Where: */ - -/* year --- is the year */ -/* era --- is the chronological era associated with */ -/* the date. For years after 999 A.D. */ -/* the era is omitted. For years */ -/* between 1 A.D. and 999 A.D. (inclusive) */ -/* era is the string 'A.D.' For epochs */ -/* before 1 A.D. Jan 1 00:00:00, era is */ -/* given as 'B.C.' and the year is converted */ -/* to years before the "Christian Era". */ -/* The last B.C. epoch is */ - -/* 1 B.C. DEC 31 23:59:59.999 */ - -/* The first A.D. epoch (which occurs .001 */ -/* seconds after the last B.C. epoch) is: */ - -/* 1 A.D. JAN 1 00:00:00.000 */ - -/* Note: there is no year 0 A.D. or 0 B.C. */ -/* mon --- is a 3-letter abbreviation for the month */ -/* in all capital letters. */ -/* day --- is the day of the month */ -/* hr --- is the hour of the day (between 0 and 23) */ -/* leading zeros are added to hr if the */ -/* numeric value is less than 10. */ -/* mn --- is the minute of the hour (0 to 59) */ -/* leading zeros are added to mn if the */ -/* numeric value is less than 10. */ -/* sc.sss is the second of the minute to 3 decimal */ -/* places ( 0 to 59.999). Leading zeros */ -/* are added if the numeric value is less */ -/* than 10. Seconds are truncated, not */ -/* rounded. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input ET is so large that the corresponding */ -/* number of days since 1 A.D. Jan 1, 00:00:00 is */ -/* within 1 of overflowing or underflowing an integer, */ -/* ET will not be converted to the correct string */ -/* representation rather, the string returned will */ -/* state that the epoch was before or after the day */ -/* that is INTMIN +1 or INTMAX - 1 days after */ -/* 1 A.D. Jan 1, 00:00:00. */ - -/* 2) If the output string is not sufficiently long to hold */ -/* the full date, it will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is an error free routine for converting ephemeris epochs */ -/* represented as seconds past the J2000 epoch to formal */ -/* calendar strings based upon the Gregorian Calendar. This formal */ -/* time is often useful when one needs a human recognizable */ -/* form of an ephemeris epoch. There is no accounting for leap */ -/* seconds in the output times produced. */ - -/* Note: The calendar epochs produced are not the same as the */ -/* UTC calendar epochs that correspond to ET. The strings */ -/* produced by this routine may vary from the corresponding */ -/* UTC epochs by more than 1 minute. */ - -/* This routine can be used in creating error messages or */ -/* in routines and programs in which one prefers to report */ -/* times without employing leapseconds to produce exact UTC */ -/* epochs. */ - - -/* $ Examples */ - -/* Suppose you wish to report that no data is */ -/* available at a particular ephemeris epoch ET. The following */ -/* code shows how you might accomplish this task. */ - -/* CALL DPSTRF ( ET, 6, 'F', ETSTR ) */ -/* CALL ETCAL ( ET, STRING ) */ - -/* E1 = RTRIM ( STRING ) */ -/* E2 = RTRIM ( ETSTR ) */ - -/* WRITE (*,*) 'There is no data available for the body ' */ -/* WRITE (*,*) 'at requested time: ' */ -/* WRITE (*,*) ' ', STRING(1:E1), ' (', ETSTR(1:E2), ')' */ - - -/* $ Restrictions */ - -/* One must keep in mind when using this routine that */ -/* ancient times are not based upon the Gregorian */ -/* calendar. For example the 0 point of the Julian */ -/* Date system is 4713 B.C. Jan 1, 12:00:00 on the Julian */ -/* Calendar. If one formalized the Gregorian calendar */ -/* and extended it indefinitely, the zero point of the Julian */ -/* date system corresponds to 4714 B.C. NOV 24 12:00:00 on */ -/* the Gregorian calendar. There are several reasons for this. */ -/* Leap years in the Julian calendar occur every */ -/* 4 years (including *all* centuries). Moreover, the */ -/* Gregorian calendar "effectively" begins on 15 Oct, 1582 A.D. */ -/* which is 5 Oct, 1582 A.D. in the Julian Calendar. */ - -/* Therefore you must be careful in your interpretation */ -/* of ancient dates produced by this routine. */ - -/* $ Literature_References */ - -/* 1. "From Sundial to Atomic Clocks---Understanding Time and */ -/* Frequency" by James Jespersen and Jane Fitz-Randolph */ -/* Dover Publications, Inc. New York (1982). */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 05-MAR-1998 (WLT) */ - -/* The documentation concerning the appearance of the output */ -/* time string was corrected so that it does not suggest */ -/* a comma is inserted after the day of the month. The */ -/* comma was removed from the output string in Version 2.0.0 */ -/* (see the note below) but the documentation was not upgraded */ -/* accordingly. */ - -/* - SPICELIB Version 2.1.0, 20-MAY-1996 (WLT) */ - -/* Two arrays that were initialized but never used were */ -/* removed. */ - -/* - SPICELIB Version 2.0.0, 16-AUG-1995 (KRG) */ - -/* If the day number was less than 10, the spacing was off for */ -/* the rest of the time by one space, that for the "tens" digit. */ -/* This has been fixed by using a leading zero when the number of */ -/* days is < 10. */ - -/* Also, the comma that appeared between the month/day/year */ -/* and the hour:minute:seconds tokens has been removed. This was */ -/* done in order to make the calendar date format of ETCAL */ -/* consistent with the calendar date format of ET2UTC. */ - - -/* - SPICELIB Version 1.0.0, 14-DEC-1993 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Convert ephemeris time to a formal calendar date */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 20-MAY-1996 (WLT) */ - -/* Two arrays that were initialized but never used were */ -/* removed. */ - -/* - SPICELIB Version 2.0.0, 16-AUG-1995 (KRG) */ - -/* If the day number was less than 10, the spacing was off for */ -/* the rest of the time by one space, that for the "tens" digit. */ -/* This has been fixed byusing a leading zero when the number of */ -/* days is < 10. */ - -/* Also, the comma that appeared between the month/day/year */ -/* and the hour:minute:seconds tokens has been removed. This was */ -/* done in order to make the calendar date format of ETCAL */ -/* consistent with the calendar date format of ET2UTC. */ - -/* - SPICELIB Version 1.0.0, 14-DEC-1993 (WLT) */ - -/* -& */ - -/* Spicelib Functions. */ - - -/* We declare the variables that contain the number of days in */ -/* 400 years, 100 years, 4 years and 1 year. */ - - -/* The following integers give the number of days during the */ -/* associated month of a non-leap year. */ - - -/* The integers that follow give the number of days in a normal */ -/* year that precede the first of the month. */ - - -/* The integers that follow give the number of days in a leap */ -/* year that precede the first of the month. */ - - -/* The variables below hold the components of the output string */ -/* before they are put together. */ - - -/* We will construct our string using the local variable DATE */ -/* and transfer the results to the output STRING when we are */ -/* done. */ - - -/* MONTHS contains 3-letter abbreviations for the months of the year */ - - -/* The array EXTRA contains the number of additional days that */ -/* appear before the first of a month during a leap year (as opposed */ -/* to a non-leap year). */ - - -/* DPJAN0(I) gives the number of days that occur before the I'th */ -/* month of a normal year. */ - - -/* Definitions of statement functions. */ - - -/* The number of days elapsed since Jan 1, of year 1 A.D. to */ -/* Jan 1 of YEAR is given by: */ - - -/* The number of leap days in a year is given by: */ - - -/* To compute the day of the year we */ - -/* look up the number of days to the beginning of the month, */ - -/* add on the number leap days that occurred prior to that */ -/* time */ - -/* add on the number of days into the month */ - - -/* The number of days since 1 Jan 1 A.D. is given by: */ - - if (first) { - first = FALSE_; - halfd = spd_() / 2.; - secspd = spd_(); - dn2000 = (c__2000 - 1) * 365 + (c__2000 - 1) / 4 - (c__2000 - 1) / - 100 + (c__2000 - 1) / 400 + (dpjan0[(i__1 = c__1 - 1) < 12 && - 0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "etcal_", (ftnlen) - 571)] + extra[(i__2 = c__1 - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("extra", i__2, "etcal_", (ftnlen)571)] * ((c__2000 / 4 - << 2) / c__2000 - c__2000 / 100 * 100 / c__2000 + c__2000 / - 400 * 400 / c__2000) + c__1) - 1; - dmxint = (doublereal) intmax_(); - dmnint = (doublereal) intmin_(); - } - -/* Now we "in-line" compute the following call. */ - -/* call rmaind ( et + halfd, secspd, dp2000, secs ) */ - -/* because we can't make a call to rmaind. */ - -/* The reader may wonder why we use et + halfd. The value */ -/* et is seconds past the ephemeris epoch of J2000 which */ -/* is at 2000 Jan 1, 12:00:00. We want to compute days past */ -/* 2000 Jan 1, 00:00:00. The seconds past THAT epoch is et + halfd. */ -/* We add on 0.0005 seconds so that the string produced will be */ -/* rounded to the nearest millisecond. */ - - mydnom = secspd; - mynum = *et + halfd; - d__1 = mynum / mydnom; - q = d_int(&d__1); - remd = mynum - q * mydnom; - if (remd < 0.) { - q += -1.; - remd += mydnom; - } - secs = remd; - dp2000 = q; - -/* Do something about the problem when ET is vastly */ -/* out of range. (Day number outside MAX and MIN integer). */ - - if (dp2000 + dn2000 < dmnint + 1) { - dp2000 = dmnint - dn2000 + 1; - s_copy(messge, "Epoch before ", (ftnlen)16, (ftnlen)13); - secs = 0.; - } else if (dp2000 + dn2000 > dmxint - 1) { - dp2000 = dmxint - dn2000 - 1; - s_copy(messge, "Epoch after ", (ftnlen)16, (ftnlen)12); - secs = 0.; - } else { - s_copy(messge, " ", (ftnlen)16, (ftnlen)1); - } - -/* Compute the number of days since 1 .A.D. Jan 1, 00:00:00. */ -/* From the tests in the previous IF-ELSE IF-ELSE block this */ -/* addition is guaranteed not to overflow. */ - - daynum = (integer) (dp2000 + (doublereal) dn2000); - -/* If the number of days is negative, we need to do a little */ -/* work so that we can represent the date in the B.C. era. */ -/* We add enough multiples of 400 years so that the year will */ -/* be positive and then we subtract off the appropriate multiple */ -/* of 400 years later. */ - - if (daynum < 0) { - -/* Since we can't make the call below and remain */ -/* error free, we compute it ourselves. */ - -/* call rmaini ( daynum, dp400y, offset, daynum ) */ - - iq = daynum / 146097; - rem = daynum - iq * 146097; - if (rem < 0) { - --iq; - rem += 146097; - } - offset = iq; - daynum = rem; - adjust = TRUE_; - } else { - adjust = FALSE_; - } - -/* Next we compute the year. Divide out multiples of 400, 100 */ -/* 4 and 1 year. Finally combine these to get the correct */ -/* value for year. (Note this is all integer arithmetic.) */ - -/* Recall that DP1Y = 365 */ -/* DP4Y = 4*DPY + 1 */ -/* DP100Y = 25*DP4Y - 1 */ -/* DP400Y = 4*DP100Y + 1 */ - - yr400 = daynum / 146097; - rem = daynum - yr400 * 146097; -/* Computing MIN */ - i__1 = 3, i__2 = rem / 36524; - yr100 = min(i__1,i__2); - rem -= yr100 * 36524; -/* Computing MIN */ - i__1 = 24, i__2 = rem / 1461; - yr4 = min(i__1,i__2); - rem -= yr4 * 1461; -/* Computing MIN */ - i__1 = 3, i__2 = rem / 365; - yr1 = min(i__1,i__2); - rem -= yr1 * 365; - dofyr = rem + 1; - year = yr400 * 400 + yr100 * 100 + (yr4 << 2) + yr1 + 1; - -/* Get the month, and day of month (depending upon whether */ -/* we have a leap year or not). */ - - if ((year / 4 << 2) / year - year / 100 * 100 / year + year / 400 * 400 / - year == 0) { - month = lstlti_(&dofyr, &c__12, dpjan0); - day = dofyr - dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpjan0", i__1, "etcal_", (ftnlen)698)]; - } else { - month = lstlti_(&dofyr, &c__12, dpbegl); - day = dofyr - dpbegl[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpbegl", i__1, "etcal_", (ftnlen)701)]; - } - -/* If we had to adjust the year to make it positive, we now */ -/* need to correct it and then convert it to a B.C. year. */ - - if (adjust) { - year += offset * 400; - year = -year + 1; - s_copy(era, " B.C. ", (ftnlen)16, (ftnlen)6); - } else { - -/* If the year is less than 1000, we can't just write it */ -/* out. We need to add the era. If we don't do this */ -/* the dates look very confusing. */ - - if (year < 1000) { - s_copy(era, " A.D. ", (ftnlen)16, (ftnlen)6); - } else { - s_copy(era, " ", (ftnlen)16, (ftnlen)1); - } - } - -/* Convert Seconds to Hours, Minute and Seconds. */ -/* We work with thousandths of a second in integer arithmetic */ -/* so that all of the truncation work with seconds will already */ -/* be done. (Note that we already know that SECS is greater than */ -/* or equal to zero so we'll have no problems with HOURS, MINS */ -/* or SECS becoming negative.) */ - - tsecs = (integer) (secs * 1e3); - frac = secs - (doublereal) tsecs; - hours = tsecs / 3600000; - tsecs -= hours * 3600000; - mins = tsecs / 60000; - tsecs -= mins * 60000; - secs = (doublereal) tsecs / 1e3; - -/* We round seconds if we can do so without getting seconds to be */ -/* bigger than 60. */ - - if (secs + 5e-4 < 60.) { - secs += 5e-4; - } - -/* Finally, get the components of our date string. */ - - intstr_(&year, ystr, (ftnlen)16); - if (day >= 10) { - intstr_(&day, dstr, (ftnlen)16); - } else { - s_copy(dstr, "0", (ftnlen)16, (ftnlen)1); - intstr_(&day, dstr + 1, (ftnlen)15); - } - -/* We want to zero pad the hours minutes and seconds. */ - - if (hours < 10) { - bh = 2; - } else { - bh = 1; - } - if (mins < 10) { - bm = 2; - } else { - bm = 1; - } - s_copy(mstr, "00", (ftnlen)16, (ftnlen)2); - s_copy(hstr, "00", (ftnlen)16, (ftnlen)2); - s_copy(sstr, " ", (ftnlen)16, (ftnlen)1); - -/* Now construct the string components for hours, minutes and */ -/* seconds. */ - - secs = (integer) (secs * 1e3) / 1e3; - intstr_(&hours, hstr + (bh - 1), 16 - (bh - 1)); - intstr_(&mins, mstr + (bm - 1), 16 - (bm - 1)); - dpstrf_(&secs, &c__6, "F", sstr, (ftnlen)1, (ftnlen)16); - -/* The form of the output for SSTR has a leading blank followed by */ -/* the first significant digit. If a decimal point is in the */ -/* third slot, then SSTR is of the form ' x.xxxxx' and we need */ -/* to insert a leading zero. */ - - if (*(unsigned char *)&sstr[2] == '.') { - *(unsigned char *)sstr = '0'; - } - -/* We don't want any leading spaces in SSTR, (HSTR and MSTR don't */ -/* have leading spaces by construction. */ - - ljust_(sstr, sstr, (ftnlen)16, (ftnlen)16); - -/* Now form the date string, squeeze out extra spaces and */ -/* left justify the whole thing. */ - -/* Writing concatenation */ - i__3[0] = 16, a__1[0] = messge; - i__3[1] = 16, a__1[1] = ystr; - i__3[2] = 16, a__1[2] = era; - i__3[3] = 3, a__1[3] = months + ((i__1 = month - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("months", i__1, "etcal_", (ftnlen)810)) * 3; - i__3[4] = 1, a__1[4] = " "; - i__3[5] = 3, a__1[5] = dstr; - i__3[6] = 1, a__1[6] = " "; - i__3[7] = 2, a__1[7] = hstr; - i__3[8] = 1, a__1[8] = ":"; - i__3[9] = 2, a__1[9] = mstr; - i__3[10] = 1, a__1[10] = ":"; - i__3[11] = 6, a__1[11] = sstr; - s_cat(date, a__1, i__3, &c__12, (ftnlen)180); - cmprss_(" ", &c__1, date, date, (ftnlen)1, (ftnlen)180, (ftnlen)180); - ljust_(date, date, (ftnlen)180, (ftnlen)180); - s_copy(string, date, string_len, (ftnlen)180); - return 0; -} /* etcal_ */ - diff --git a/ext/spice/src/cspice/etcal_c.c b/ext/spice/src/cspice/etcal_c.c deleted file mode 100644 index cd225854b4..0000000000 --- a/ext/spice/src/cspice/etcal_c.c +++ /dev/null @@ -1,255 +0,0 @@ -/* - --Procedure etcal_c ( Convert ET to Calendar format ) - --Abstract - - Convert from an ephemeris epoch measured in seconds past - the epoch of J2000 to a calendar string format using a - formal calendar free of leapseconds. - --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 - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void etcal_c ( SpiceDouble et, - SpiceInt lenout, - SpiceChar * string ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - et I Ephemeris time measured in seconds past J2000. - lenout I Length of output string. - string O A standard calendar representation of et. - --Detailed_Input - - et is an epoch measured in ephemeris seconds - past the epoch of J2000. - - lenout is the user defined length of the output string. - The value should be at least 48 characters. - --Detailed_Output - - string is a calendar string representing the input ephemeris - epoch. This string is based upon extending the - Gregorian Calendar backward and forward indefinitely - keeping the same rules for determining leap years. - Moreover, there is no accounting for leapseconds. - - To be sure that all of the date can be stored in - string, it should be declared to have length at - least 48 characters. - - The string will have the following format - - year (era) mon day, hr:mn:sc.sss - - Where: - - year --- is the year - era --- is the chronological era associated with - the date. For years after 999 A.D. - the era is omitted. For years - between 1 A.D. and 999 A.D. (inclusive) - era is the string 'A.D.' For epochs - before 1 A.D. Jan 1 00:00:00, era is - given as 'B.C.' and the year is converted - to years before the "Christian Era". - The last B.C. epoch is - - 1 B.C. DEC 31, 23:59:59.999 - - The first A.D. epoch (which occurs .001 - seconds after the last B.C. epoch) is: - - 1 A.D. JAN 1, 00:00:00.000 - - Note: there is no year 0 A.D. or 0 B.C. - mon --- is a 3-letter abbreviation for the month - in all capital letters. - day --- is the day of the month - hr --- is the hour of the day (between 0 and 23) - leading zeros are added to hr if the - numeric value is less than 10. - mn --- is the minute of the hour (0 to 59) - leading zeros are added to mn if the - numeric value is less than 10. - sc.sss is the second of the minute to 3 decimal - places ( 0 to 59.999). Leading zeros - are added if the numeric value is less - than 10. Seconds are truncated, not - rounded. - - --Parameters - - None. - --Exceptions - - Error free. - - 1) If the input et is so large that the corresponding - number of days since 1 A.D. Jan 1, 00:00:00 is - within 1 of overflowing or underflowing an integer, - et will not be converted to the correct string - representation rather, the string returned will - state that the epoch was before or after the day - that is min_integer_val + 1 or max_integer_val - 1 days - after 1 A.D. Jan 1, 00:00:00. - - 2) If the output string is not sufficiently long to hold - the full date, it will be truncated on the right. - --Files - - None. - --Particulars - - This is an error free routine for converting ephemeris epochs - represented as seconds past the J2000 epoch to formal - calendar strings based upon the Gregorian Calendar. This formal - time is often useful when one needs a human recognizable - form of an ephemeris epoch. There is no accounting for leap - seconds in the output times produced. - - Note: The calendar epochs produced are not the same as the - UTC calendar epochs that correspond to et. The strings - produced by this routine may vary from the corresponding - UTC epochs by more than 1 minute. - - This routine can be used in creating error messages or - in routines and programs in which one prefers to report - times without employing leapseconds to produce exact UTC - epochs. - - --Examples - - Suppose you wish to report that no data is - available at a particular ephemeris epoch et. The following - code shows how you might accomplish this task. - - #define STRLEN 48 - - etcal_c ( et, STRLEN, string ) - - printf ( "There is no data available for the body " ); - printf ( "at requested time: %s ( %f )", string, et ); - - --Restrictions - - One must keep in mind when using this routine that - ancient times are not based upon the Gregorian - calendar. For example the 0 point of the Julian - Date system is 4713 B.C. Jan 1, 12:00:00 on the Julian - Calendar. If one formalized the Gregorian calendar - and extended it indefinitely, the zero point of the Julian - date system corresponds to 4714 B.C. NOV 24 12:00:00 on - the Gregorian calendar. There are several reasons for this. - Leap years in the Julian calendar occur every - 4 years (including *all* centuries). Moreover, the - Gregorian calendar "effectively" begins on 15 Oct, 1582 A.D. - which is 5 Oct, 1582 A.D. in the Julian Calendar. - - Therefore you must be careful in your interpretation - of ancient dates produced by this routine. - --Literature_References - - 1. "From Sundial to Atomic Clocks---Understanding Time and - Frequency" by James Jespersen and Jane Fitz-Randolph - Dover Publications, Inc. New York (1982). - --Author_and_Institution - - W.L. Taber (JPL) - K.R. Gehringer (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 5-MAR-1998 (EDW) - --Index_Entries - - Convert ephemeris time to a formal calendar date - --& -*/ - -{ /* Begin etcal_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "etcal_c" ); - - - /* - Make sure the output string has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - - CHKOSTR ( CHK_STANDARD, "etcal_c", string, lenout ); - - - etcal_( ( doublereal * ) &et, - ( char * ) string, - ( ftnlen ) lenout - 1 ); - - - /* Convert the output string to C. */ - - F2C_ConvertStr( lenout, string ); - - - chkout_c ( "etcal_c" ); - -} /* End etcal_c */ diff --git a/ext/spice/src/cspice/etime_.c b/ext/spice/src/cspice/etime_.c deleted file mode 100644 index 2b2b20465b..0000000000 --- a/ext/spice/src/cspice/etime_.c +++ /dev/null @@ -1,121 +0,0 @@ -/* - --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. - -*/ - -/* - --Description - - This is a slightly modified version of the f2c library - file etime_.c, which was included in the 1998-09-13 f2c - distribution. - - This file has been modified as follows: - - 1) This "header" text has been added. - - 2) The file optionally invokes macros that mangle the - external symbols in f2c's F77 and I77 libraries. The - purpose of this is to allow programs to link to - CSPICE and also link to Fortran objects that do - Fortran I/O. - - The mangling is invoked by defining the preprocessor - flag - - MIX_C_AND_FORTRAN - - - The name mangling capability used by this routine should only be - used as a last resort. - --Version - - -CSPICE Version 1.0.0, 19-DEC-2001 (NJB) - --& -*/ - - /* - Mangle external symbols if we're mixing C and Fortran. This - code was not in the original version of etime_.c obtained with - the f2c distribution. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - /* - End of modification. - */ - - -#include "time.h" - -#ifdef MSDOS -#define USE_CLOCK -#endif - -#ifndef USE_CLOCK -#define _INCLUDE_POSIX_SOURCE /* for HP-UX */ -#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ -#include "sys/types.h" -#include "sys/times.h" -#endif - -#undef Hz -#ifdef CLK_TCK -#define Hz CLK_TCK -#else -#ifdef HZ -#define Hz HZ -#else -#define Hz 60 -#endif -#endif - - double -#ifdef KR_headers -etime_(tarray) float *tarray; -#else -etime_(float *tarray) -#endif -{ -#ifdef USE_CLOCK -#ifndef CLOCKS_PER_SECOND -#define CLOCKS_PER_SECOND Hz -#endif - double t = clock(); - tarray[1] = 0; - return tarray[0] = t / CLOCKS_PER_SECOND; -#else - struct tms t; - - times(&t); - return (tarray[0] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz); -#endif - } diff --git a/ext/spice/src/cspice/eul2m.c b/ext/spice/src/cspice/eul2m.c deleted file mode 100644 index b61592cfe4..0000000000 --- a/ext/spice/src/cspice/eul2m.c +++ /dev/null @@ -1,484 +0,0 @@ -/* eul2m.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EUL2M ( Euler angles to matrix ) */ -/* Subroutine */ int eul2m_(doublereal *angle3, doublereal *angle2, - doublereal *angle1, integer *axis3, integer *axis2, integer *axis1, - doublereal *r__) -{ - logical badax; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal r1[9] /* was [3][3] */; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), rotate_(doublereal *, integer *, doublereal *), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), rotmat_( - doublereal *, doublereal *, integer *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Construct a rotation matrix from a set of Euler angles. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ANGLE3, */ -/* ANGLE2, */ -/* ANGLE1 I Rotation angles about third, second, and first */ -/* rotation axes (radians). */ -/* AXIS3, */ -/* AXIS2, */ -/* AXIS1 I Axis numbers of third, second, and first rotation */ -/* axes. */ - -/* R O Product of the 3 rotations. */ - -/* $ Detailed_Input */ - -/* ANGLE3, */ -/* ANGLE2, */ -/* ANGLE1, */ - -/* AXIS3, */ -/* AXIS2, */ -/* AXIS1 are, respectively, a set of three angles and three */ -/* coordinate axis numbers; each pair ANGLEx and */ -/* AXISx specifies a coordinate transformation */ -/* consisting of a rotation by ANGLEx radians about */ -/* the coordinate axis indexed by AXISx. These */ -/* coordinate transformations are typically */ -/* symbolized by */ - -/* [ ANGLEx ] . */ -/* AXISx */ - -/* See the $ Particulars section below for details */ -/* concerning this notation. */ - -/* Note that these coordinate transformations rotate */ -/* vectors by */ - -/* -ANGLEx */ - -/* radians about the axis indexed by AXISx. */ - -/* The values of AXISx may be 1, 2, or 3, indicating */ -/* the x, y, and z axes respectively. */ - -/* $ Detailed_Output */ - -/* R is a rotation matrix representing the composition */ -/* of the rotations defined by the input angle-axis */ -/* pairs. Together, the three pairs specify a */ -/* composite transformation that is the result of */ -/* performing the rotations about the axes indexed */ -/* by AXIS1, AXIS2, and AXIS3, in that order. So, */ - -/* R = [ ANGLE3 ] [ ANGLE2 ] [ ANGLE1 ] */ -/* AXIS3 AXIS2 AXIS1 */ - -/* See the $ Particulars section below for details */ -/* concerning this notation. */ - -/* The resulting matrix R may be thought of as a */ -/* coordinate transformation; applying it to a vector */ -/* yields the vector's coordinates in the rotated */ -/* system. */ - -/* Viewing R as a coordinate transformation matrix, */ -/* the basis that R transforms vectors to is created */ -/* by rotating the original coordinate axes first by */ -/* ANGLE1 radians about the coordinate axis indexed */ -/* by AXIS1, next by ANGLE2 radians about the */ -/* coordinate axis indexed by AXIS2, and finally by */ -/* ANGLE3 radians about coordinate axis indexed by */ -/* AXIS3. At the second and third steps of this */ -/* process, the coordinate axes about which rotations */ -/* are performed belong to the bases resulting from */ -/* the previous rotations. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any of AXIS3, AXIS2, or AXIS1 do not have values in */ - -/* { 1, 2, 3 }, */ - -/* the error SPICE(BADAXISNUMBERS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A word about notation: the symbol */ - -/* [ x ] */ -/* i */ - -/* indicates a rotation of x radians about the ith coordinate axis. */ -/* To be specific, the symbol */ - -/* [ x ] */ -/* 1 */ - -/* indicates a coordinate system rotation of x radians about the */ -/* first, or x-, axis; the corresponding matrix is */ - -/* +- -+ */ -/* | 1 0 0 | */ -/* | | */ -/* | 0 cos(x) sin(x) |. */ -/* | | */ -/* | 0 -sin(x) cos(x) | */ -/* +- -+ */ - -/* Remember, this is a COORDINATE SYSTEM rotation by x radians; this */ -/* matrix, when applied to a vector, rotates the vector by -x */ -/* radians, not x radians. Applying the matrix to a vector yields */ -/* the vector's representation relative to the rotated coordinate */ -/* system. */ - -/* The analogous rotation about the second, or y-, axis is */ -/* represented by */ - -/* [ x ] */ -/* 2 */ - -/* which symbolizes the matrix */ - -/* +- -+ */ -/* | cos(x) 0 -sin(x) | */ -/* | | */ -/* | 0 1 0 |, */ -/* | | */ -/* | sin(x) 0 cos(x) | */ -/* +- -+ */ - -/* and the analogous rotation about the third, or z-, axis is */ -/* represented by */ - -/* [ x ] */ -/* 3 */ - -/* which symbolizes the matrix */ - -/* +- -+ */ -/* | cos(x) sin(x) 0 | */ -/* | | */ -/* | -sin(x) cos(x) 0 |. */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - -/* From time to time, (depending on one's line of work, perhaps) one */ -/* may happen upon a pair of coordinate systems related by a */ -/* sequence of rotations. For example, the coordinate system */ -/* defined by an instrument such as a camera is sometime specified */ -/* by RA, DEC, and twist; if alpha, delta, and phi are the rotation */ -/* angles, then the series of rotations */ - -/* [ phi ] [ pi/2 - delta ] [ alpha ] */ -/* 3 2 3 */ - -/* produces a transformation from inertial to camera coordinates. */ - -/* This routine is related to the SPICELIB routine M2EUL, which */ -/* produces a sequence of Euler angles, given a rotation matrix. */ -/* This routine is a `left inverse' of M2EUL: the sequence of */ -/* calls */ - -/* CALL M2EUL ( R, AXIS3, AXIS2, AXIS1, */ -/* . ANGLE3, ANGLE2, ANGLE1 ) */ - -/* CALL EUL2M ( ANGLE3, ANGLE2, ANGLE1, */ -/* . AXIS3, AXIS2, AXIS1, R ) */ - -/* preserves R, except for round-off error. */ - - -/* On the other hand, the sequence of calls */ - -/* CALL EUL2M ( ANGLE3, ANGLE2, ANGLE1, */ -/* . AXIS3, AXIS2, AXIS1, R ) */ - -/* CALL M2EUL ( R, AXIS3, AXIS2, AXIS1, */ -/* . ANGLE3, ANGLE2, ANGLE1 ) */ - -/* preserve ANGLE3, ANGLE2, and ANGLE1 only if these angles start */ -/* out in the ranges that M2EUL's outputs are restricted to. */ - -/* $ Examples */ - -/* 1) Create a coordinate transformation matrix by rotating */ -/* the original coordinate axes first by 30 degrees about */ -/* the z axis, next by 60 degrees about the y axis resulting */ -/* from the first rotation, and finally by -50 degrees about */ -/* the z axis resulting from the first two rotations. */ - - -/* C */ -/* C Create the coordinate transformation matrix */ -/* C */ -/* C o o o */ -/* C R = [ -50 ] [ 60 ] [ 30 ] */ -/* C 3 2 3 */ -/* C */ -/* C All angles in radians, please. The SPICELIB */ -/* C function RPD (radians per degree) gives the */ -/* C conversion factor. */ -/* C */ -/* C The z axis is `axis 3'; the y axis is `axis 2'. */ -/* C */ -/* ANGLE1 = RPD() * 30.D0 */ -/* ANGLE2 = RPD() * 60.D0 */ -/* ANGLE3 = RPD() * -50.D0 */ - -/* AXIS1 = 3 */ -/* AXIS2 = 2 */ -/* AXIS3 = 3 */ - -/* CALL EUL2M ( ANGLE3, ANGLE2, ANGLE1, */ -/* . AXIS3, AXIS2, AXIS1, R ) */ - - -/* 2) A trivial example using actual numbers. */ - -/* The code fragment */ - -/* CALL EUL2M ( 0.D0, 0.D0, HALFPI(), */ -/* . 1, 1, 3, R ) */ - -/* sets R equal to the matrix */ - -/* +- -+ */ -/* | 0 1 0 | */ -/* | | */ -/* | -1 0 0 |. */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - - -/* 3) Finding the rotation matrix specified by a set of `clock, */ -/* cone, and twist' angles, as defined on the Voyager 2 project: */ - -/* Voyager 2 narrow angle camera pointing, relative to the */ -/* Sun-Canopus coordinate system, was frequently specified */ -/* by a set of Euler angles called `clock, cone, and twist'. */ -/* These defined a 3-2-3 coordinate transformation matrix */ -/* TSCTV as the product */ - -/* [ twist ] [ cone ] [ clock ] . */ -/* 3 2 3 */ - -/* Given the angles CLOCK, CONE, and TWIST (in units of */ -/* radians), we can compute TSCTV with the code fragment */ - -/* CALL EUL2M ( TWIST, CONE, CLOCK, */ -/* . 3, 2, 3, TSCTV ) */ - - -/* 4) Finding the rotation matrix specified by a set of `right */ -/* ascension, declination, and twist' angles, as defined on the */ -/* Galileo project: */ - -/* Galileo scan platform pointing, relative to an inertial */ -/* reference frame, (EME50 variety) is frequently specified */ -/* by a set of Euler angles called `right ascension (RA), */ -/* declination (Dec), and twist'. These define a 3-2-3 */ -/* coordinate transformation matrix TISP as the product */ - -/* [ Twist ] [ pi/2 - Dec ] [ RA ] . */ -/* 3 2 3 */ - -/* Given the angles RA, DEC, and TWIST (in units of radians), */ -/* we can compute TISP with the code fragment */ - -/* CALL EUL2M ( TWIST, HALFPI()-DEC, RA, */ -/* . 3, 2, 3, TISP ) */ - - -/* $ Restrictions */ - -/* Beware: more than one definition of "RA, DEC and twist" exists. */ - -/* $ Literature_References */ - -/* [1] `Galileo Attitude and Camera Models', JPL IOM 314-323, */ -/* W. M. Owen, Jr., Nov. 11, 1983. NAIF document number */ -/* 204.0. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 26-DEC-2006 (NJB) */ - -/* Corrected header typo. */ - -/* - SPICELIB Version 1.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in ROTMAT calls. */ - -/* - SPICELIB Version 1.1.2, 14-OCT-2004 (LSE) */ - -/* Corrected a typo in the header. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (NJB) */ - -/* Names of input arguments changed to reflect the order in */ -/* which the rotations are applied when their product is */ -/* computed. The header was upgraded to describe notation in */ -/* more detail. Examples were added. */ - -/* - SPICELIB Version 1.0.0, 30-AUG-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* euler angles to matrix */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in ROTMAT calls. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (NJB) */ - -/* Argument names were changed to describe the use of the */ -/* arguments more accurately. The axis and angle numbers */ -/* now decrease, rather than increase, from left to right. */ -/* The current names reflect the order of operator application */ -/* when the Euler angle rotations are applied to a vector: the */ -/* rightmost matrix */ - -/* [ ANGLE1 ] */ -/* AXIS1 */ - -/* is applied to the vector first, followed by */ - -/* [ ANGLE2 ] */ -/* AXIS2 */ - -/* and then */ - -/* [ ANGLE3 ] */ -/* AXIS3 */ - -/* Previously, the names reflected the order in which the Euler */ -/* angle matrices appear on the page, from left to right. This */ -/* naming convention was found to be a bit obtuse by a various */ -/* users. */ - -/* No change in functionality was made; the operation of the */ -/* routine is identical to that of the previous version. */ - -/* Two new examples were added to assist users in verifying */ -/* their understanding of the routine. */ - -/* Also, the header was upgraded to describe the notation in more */ -/* detail. The symbol */ - -/* [ x ] */ -/* i */ - -/* is explained at mind-numbing length. An example was added */ -/* that shows a specific set of inputs and the resulting output */ -/* matrix. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EUL2M", (ftnlen)5); - } - -/* Make sure the axis numbers are all right: They must belong to */ -/* the set {1, 2, 3}. */ - - badax = *axis3 < 1 || *axis3 > 3 || (*axis2 < 1 || *axis2 > 3) || (*axis1 - < 1 || *axis1 > 3); - if (badax) { - setmsg_("Axis numbers are #, #, #. ", (ftnlen)28); - errint_("#", axis3, (ftnlen)1); - errint_("#", axis2, (ftnlen)1); - errint_("#", axis1, (ftnlen)1); - sigerr_("SPICE(BADAXISNUMBERS)", (ftnlen)21); - chkout_("EUL2M", (ftnlen)5); - return 0; - } - -/* Just do it. */ - - rotate_(angle1, axis1, r__); - rotmat_(r__, angle2, axis2, r1); - rotmat_(r1, angle3, axis3, r__); - chkout_("EUL2M", (ftnlen)5); - return 0; -} /* eul2m_ */ - diff --git a/ext/spice/src/cspice/eul2m_c.c b/ext/spice/src/cspice/eul2m_c.c deleted file mode 100644 index c577595d01..0000000000 --- a/ext/spice/src/cspice/eul2m_c.c +++ /dev/null @@ -1,414 +0,0 @@ -/* - --Procedure eul2m_c ( Euler angles to matrix ) - --Abstract - - Construct a rotation matrix from a set of Euler angles. - --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 - - ROTATION - --Keywords - - MATRIX - ROTATION - TRANSFORMATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void eul2m_c ( SpiceDouble angle3, - SpiceDouble angle2, - SpiceDouble angle1, - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble r [3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - angle3, - angle2, - angle1 I Rotation angles about third, second, and first - rotation axes (radians). - axis3, - axis2, - axis1 I Axis numbers of third, second, and first rotation - axes. - - r O Product of the 3 rotations. - --Detailed_Input - - angle3, - angle2, - angle1, - - axis3, - axis2, - axis1 are, respectively, a set of three angles and three - coordinate axis numbers; each pair angleX and - axisX specifies a coordinate transformation - consisting of a rotation by angleX radians about - the coordinate axis indexed by axisX. These - coordinate transformations are typically - symbolized by - - [ angleX ] . - axisX - - See the -Particulars section below for details - concerning this notation. - - Note that these coordinate transformations rotate - vectors by - - -angleX - - radians about the axis indexed by axisX. - - The values of axisX may be 1, 2, or 3, indicating - the x, y, and z axes respectively. - --Detailed_Output - - r is a rotation matrix representing the composition - of the rotations defined by the input angle-axis - pairs. Together, the three pairs specify a - composite transformation that is the result of - performing the rotations about the axes indexed - by axis1, axis2, and axis3, in that order. So, - - r = [ angle3 ] [ angle2 ] [ angle1 ] - axis3 axis2 axis1 - - See the -Particulars section below for details - concerning this notation. - - The resulting matrix r may be thought of as a - coordinate transformation; applying it to a vector - yields the vector's coordinates in the rotated - system. - - Viewing r as a coordinate transformation matrix, - the basis that r transforms vectors to is created - by rotating the original coordinate axes first by - angle1 radians about the coordinate axis indexed - by axis1, next by angle2 radians about the - coordinate axis indexed by axis2, and finally by - angle3 radians about coordinate axis indexed by - axis3. At the second and third steps of this - process, the coordinate axes about which rotations - are performed belong to the bases resulting from - the previous rotations. - --Parameters - - None. - --Exceptions - - 1) If any of axis3, axis2, or axis1 do not have values in - - { 1, 2, 3 }, - - the error SPICE(BADAXISNUMBERS) is signalled. - --Files - - None. - --Particulars - - A word about notation: the symbol - - [ x ] - i - - indicates a rotation of x radians about the ith coordinate axis. - To be specific, the symbol - - [ x ] - 1 - - indicates a coordinate system rotation of x radians about the - first, or x-, axis; the corresponding matrix is - - +- -+ - | 1 0 0 | - | | - | 0 cos(x) sin(x) |. - | | - | 0 -sin(x) cos(x) | - +- -+ - - Remember, this is a COORDINATE SYSTEM rotation by x radians; this - matrix, when applied to a vector, rotates the vector by -x - radians, not x radians. Applying the matrix to a vector yields - the vector's representation relative to the rotated coordinate - system. - - The analogous rotation about the second, or y-, axis is - represented by - - [ x ] - 2 - - which symbolizes the matrix - - +- -+ - | cos(x) 0 -sin(x) | - | | - | 0 1 0 |, - | | - | sin(x) 0 cos(x) | - +- -+ - - and the analogous rotation about the third, or z-, axis is - represented by - - [ x ] - 3 - - which symbolizes the matrix - - +- -+ - | cos(x) sin(x) 0 | - | | - | -sin(x) cos(x) 0 |. - | | - | 0 0 1 | - +- -+ - - From time to time, (depending on one's line of work, perhaps) one - may happen upon a pair of coordinate systems related by a - sequence of rotations. For example, the coordinate system - defined by an instrument such as a camera is sometime specified - by RA, DEC, and twist; if alpha, delta, and phi are the rotation - angles, then the series of rotations - - [ phi ] [ pi/2 - delta ] [ alpha ] - 3 2 3 - - produces a transformation from inertial to camera coordinates. - - This routine is related to the CSPICE routine m2eul_c, which - produces a sequence of Euler angles, given a rotation matrix. - This routine is a `left inverse' of m2eul_c: the sequence of - calls - - m2eul_c ( r, axis3, axis2, axis1, - &angle3, &angle2, &angle1 ); - - eul2m_c ( angle3, angle2, angle1, - axis3, axis2, axis1, r ); - - preserves r, except for round-off error. - - - On the other hand, the sequence of calls - - eul2m_c ( angle3, angle2, angle1, - axis3, axis2, axis1, r ); - - m2eul_c ( r, axis3, axis2, axis1, - &angle3, &angle2, &angle1 ); - - preserve angle3, angle2, and angle1 only if these angles start - out in the ranges that m2eul_c's outputs are restricted to. - --Examples - - 1) Create a coordinate transformation matrix by rotating - the original coordinate axes first by 30 degrees about - the z axis, next by 60 degrees about the y axis resulting - from the first rotation, and finally by -50 degrees about - the z axis resulting from the first two rotations. - - /. - - Create the coordinate transformation matrix - - o o o - R = [ -50 ] [ 60 ] [ 30 ] - 3 2 3 - - All angles in radians, please. The CSPICE - function rpd_c (radians per degree) gives the - conversion factor. - - The z axis is `axis 3'; the y axis is `axis 2'. - ./ - - angle1 = rpd_c() * 30.; - angle2 = rpd_c() * 60.; - angle3 = rpd_c() * -50.; - - axis1 = 3; - axis2 = 2; - axis3 = 3; - - eul2m_c ( angle3, angle2, angle1, - axis3, axis2, axis1, r ); - - - 2) A trivial example using actual numbers. - - The call - - eul2m_c ( 0., 0., halfpi_c(), - 1, 1, 3, r ); - - sets r equal to the matrix - - +- -+ - | 0 1 0 | - | | - | -1 0 0 |. - | | - | 0 0 1 | - +- -+ - - - 3) Finding the rotation matrix specified by a set of `clock, - cone, and twist' angles, as defined on the Voyager 2 project: - - Voyager 2 narrow angle camera pointing, relative to the - Sun-Canopus coordinate system, was frequently specified - by a set of Euler angles called `clock, cone, and twist'. - These defined a 3-2-3 coordinate transformation matrix - TSCTV as the product - - [ twist ] [ cone ] [ clock ] . - 3 2 3 - - Given the angles clock, cone, and twist (in units of - radians), we can compute tsctv with the call - - eul2m_c ( twist, cone, clock, - 3, 2, 3, tsctv ); - - - 4) Finding the rotation matrix specified by a set of `right - ascension, declination, and twist' angles, as defined on the - Galileo project: - - Galileo scan platform pointing, relative to an inertial - reference frame, (EME50 variety) is frequently specified - by a set of Euler angles called `right ascension (RA), - declination (Dec), and twist'. These define a 3-2-3 - coordinate transformation matrix TISP as the product - - [ Twist ] [ pi/2 - Dec ] [ RA ] . - 3 2 3 - - Given the angles ra, dec, and twist (in units of radians), - we can compute tisp with the code fragment - - eul2m_c ( twist, halfpi_c()-dec, ra, - 3, 2, 3, tisp ); - - --Restrictions - - Beware: more than one definition of "RA, DEC and twist" exists. - --Literature_References - - [1] `Galileo Attitude and Camera Models', JPL IOM 314-323, - W. M. Owen, Jr., Nov. 11, 1983. NAIF document number - 204.0. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.2, 26-DEC-2006 (NJB) - - Fixed header typo. - - -CSPICE Version 1.0.1, 13-OCT-2004 (NJB) - - Fixed header typo. - - -CSPICE Version 1.0.0 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) - --Index_Entries - - euler angles to matrix - --& -*/ - -{ /* Begin eul2m_c */ - - - /* - Local variables - */ - SpiceDouble loc_r[3][3]; - - /* - Participate in error handling - */ - - chkin_c ( "eul2m_c"); - - - /* - Call the f2c'd version of eul2m: - */ - eul2m_ ( (doublereal *) &angle3, - (doublereal *) &angle2, - (doublereal *) &angle1, - (integer *) &axis3, - (integer *) &axis2, - (integer *) &axis1, - (doublereal *) loc_r ); - - /* - Transpose the output matrix to put it in row-major order. - */ - xpose_c ( loc_r, r ); - - - chkout_c ( "eul2m_c"); - -} /* End eul2m_c */ diff --git a/ext/spice/src/cspice/eul2xf_c.c b/ext/spice/src/cspice/eul2xf_c.c deleted file mode 100644 index b15873feb1..0000000000 --- a/ext/spice/src/cspice/eul2xf_c.c +++ /dev/null @@ -1,367 +0,0 @@ -/* - --Procedure eul2xf_c ( Euler angles and derivative to transformation) - --Abstract - - This routine computes a state transformation from an Euler angle - factorization of a rotation and the derivatives of those Euler - angles. - --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 - - ROTATION - --Keywords - - ANGLES - STATE - DERIVATIVES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef eul2xf_c - - - void eul2xf_c ( ConstSpiceDouble eulang[6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble xform [6][6] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - eulang I An array of Euler angles and their derivatives. - axisa I Axis A of the Euler angle factorization. - axisb I Axis B of the Euler angle factorization. - axisc I Axis C of the Euler angle factorization. - xform O A state transformation matrix. - --Detailed_Input - - - eulang is the set of Euler angles corresponding to the - specified factorization. - - If we represent r as shown here: - - r = [ alpha ] [ beta ] [ gamma ] - axisa axisb axisc - - then - - - eulang[0] = alpha - eulang[1] = beta - eulang[2] = gamma - eulang[3] = dalpha/dt - eulang[4] = dbeta/dt - eulang[5] = dgamma/dt - - - axisa are the axes desired for the factorization of r. - axisb All must be in the range from 1 to 3. Moreover - axisc it must be the case that axisa and axisb are distinct - and that axisb and axisc are distinct. - - Every rotation matrix can be represented as a product - of three rotation matrices about the principal axes - of a reference frame. - - r = [ alpha ] [ beta ] [ gamma ] - axisa axisb axisc - - The value 1 corresponds to the X axis. - The value 2 corresponds to the Y axis. - The value 3 corresponds to the Z axis. - - --Detailed_Output - - xform is the state transformation corresponding r and dr/dt - as described above. Pictorially, - - [ | ] - | r | 0 | - | | | - |-------+--------| - | | | - | dr/dt | r | - [ | ] - - where r is a rotation that varies with respect to time - and dr/dt is its time derivative. - --Parameters - - None. - --Exceptions - - All erroneous inputs are diagnosed by routines in the call - tree to this routine. These include - - 1) If any of axisa, axisb, or axisc do not have values in - - { 1, 2, 3 }, - - then the error SPICE(INPUTOUTOFRANGE) is signaled. - --Files - - None. - --Particulars - - This function is intended to provide an inverse for the function - xf2eul_c. - - - A word about notation: the symbol - - [ x ] - i - - indicates a coordinate system rotation of x radians about the - ith coordinate axis. To be specific, the symbol - - [ x ] - 1 - - indicates a coordinate system rotation of x radians about the - first, or x-, axis; the corresponding matrix is - - +- -+ - | 1 0 0 | - | | - | 0 cos(x) sin(x) |. - | | - | 0 -sin(x) cos(x) | - +- -+ - - Remember, this is a COORDINATE SYSTEM rotation by x radians; this - matrix, when applied to a vector, rotates the vector by -x - radians, not x radians. Applying the matrix to a vector yields - the vector's representation relative to the rotated coordinate - system. - - The analogous rotation about the second, or y-, axis is - represented by - - [ x ] - 2 - - which symbolizes the matrix - - +- -+ - | cos(x) 0 -sin(x) | - | | - | 0 1 0 |, - | | - | sin(x) 0 cos(x) | - +- -+ - - and the analogous rotation about the third, or z-, axis is - represented by - - [ x ] - 3 - - which symbolizes the matrix - - +- -+ - | cos(x) sin(x) 0 | - | | - | -sin(x) cos(x) 0 |. - | | - | 0 0 1 | - +- -+ - - - The input matrix is assumed to be the product of three - rotation matrices, each one of the form - - +- -+ - | 1 0 0 | - | | - | 0 cos(r) sin(r) | (rotation of r radians about the - | | x-axis), - | 0 -sin(r) cos(r) | - +- -+ - - - +- -+ - | cos(s) 0 -sin(s) | - | | - | 0 1 0 | (rotation of s radians about the - | | y-axis), - | sin(s) 0 cos(s) | - +- -+ - - or - - +- -+ - | cos(t) sin(t) 0 | - | | - | -sin(t) cos(t) 0 | (rotation of t radians about the - | | z-axis), - | 0 0 1 | - +- -+ - - where the second rotation axis is not equal to the first or - third. Any rotation matrix can be factored as a sequence of - three such rotations, provided that this last criterion is met. - - This routine is related to the routine eul2xf_c which produces - a state transformation from an input set of axes, Euler angles - and derivatives. - - The two function calls shown here will not change xform except for - round off errors. - - xf2eul_c ( xform, axisa, axisb, axisc, eulang, &unique ); - eul2xf_c ( eulang, axisa, axisb, axisc, xform ); - - On the other hand the two calls - - eul2xf_c ( eulang, axisa, axisb, axisc, xform ); - xf2eul_c ( xform, axisa, axisb, axisc, eulang, &unique ); - - will leave eulang unchanged only if the components of eulang - are in the range produced by xf2eul_c and the Euler representation - of the rotation component of xform is unique within that range. - - --Examples - - Suppose you have a set of Euler angles and their derivatives - for a 3 1 3 rotation, and that you would like to determine - the equivalent angles and derivatives for a 1 2 3 rotation. - - r = [alpha] [beta] [gamma] - 3 1 3 - - r = [roll] [pitch] [yaw] - 1 2 3 - - The following code fragment will perform the desired computation. - - abgang[0] = alpha; - abgang[1] = beta; - abgang[2] = gamma; - abgang[3] = dalpha; - abgang[4] = dbeta; - abgang[5] = dgamma; - - eul2xf_c ( abgang, 3, 1, 3, xform ); - xf2eul_c ( xform, 1, 2, 3, rpyang, &unique ); - - roll = rpyang[0]; - pitch = rpyang[1]; - yaw = rpyang[2]; - droll = rpyang[3]; - dpitch = rpyang[4]; - dyaw = rpyang[5]; - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 2.0.1, 25-APR-2007 (EDW) - - Corrected code in Examples section, example showed - a xf2eul_c call: - - xf2eul_c( xform, 1, 2, 3, rpyang); - - The proper form of the call: - - xf2eul_c( xform, 1, 2, 3, rpyang, &unique ); - - -CSPICE Version 2.0.0, 31-OCT-2005 (NJB) - - Restriction that second axis must differ from the first - and third was removed. - - -CSPICE Version 1.0.1, 03-JUN-2003 (EDW) - - Correct typo in Procedure line. - - -CSPICE Version 1.0.0, 18-MAY-1999 (WLT) (NJB) - --Index_Entries - - State transformation from Euler angles and derivatives - --& -*/ - - - -{ /* Begin xf2eul_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "eul2xf_c" ); - - - eul2xf_ ( ( doublereal * ) eulang, - ( integer * ) &axisa, - ( integer * ) &axisb, - ( integer * ) &axisc, - ( doublereal * ) xform ); - - /* - Convert the output matrix to row-major order. - */ - xpose6_c ( xform, xform ); - - - chkout_c ( "eul2xf_c" ); - -} /* End xf2eul_c */ - diff --git a/ext/spice/src/cspice/ev2lin.c b/ext/spice/src/cspice/ev2lin.c deleted file mode 100644 index 620a194459..0000000000 --- a/ext/spice/src/cspice/ev2lin.c +++ /dev/null @@ -1,1268 +0,0 @@ -/* ev2lin.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b90 = .66666666666666663; -static doublereal c_b91 = 3.5; -static doublereal c_b152 = 1.5; - -/* $Procedure EV2LIN ( Evaluate "two-line" element data) */ -/* Subroutine */ int ev2lin_(doublereal *et, doublereal *geophs, doublereal * - elems, doublereal *state) -{ - /* Initialized data */ - - static logical doinit = TRUE_; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double cos(doublereal), sin(doublereal), sqrt(doublereal), pow_dd( - doublereal *, doublereal *), d_mod(doublereal *, doublereal *), - atan2(doublereal, doublereal); - - /* Local variables */ - static integer head; - static doublereal coef, eeta, delm, aodp, delo, capu, xmdf, aynl, elsq, - temp; - static integer last; - static doublereal rdot, cosu, tokm; - static integer list[12] /* was [2][6] */; - static doublereal sinu, coef1, t2cof, t3cof, t4cof, t5cof, temp1, temp2, - temp3, temp4, temp5, cos2u, temp6, mov1m, sin2u, a, e, f; - static integer i__, j; - static doublereal m; - static integer n; - static doublereal r__, s, u, betal, omega, betao, epoch, ecose, aycof, - delmo, esine, a3ovk2, tcube, cosik, tempa, bstar, cosio, xincl, - etasq, rfdot, sinik, a1, rdotk, c1, c2, c3, c4, c5, cosuk, d2, d3, - j2, j3, j4, qomso, d4, lower; - extern doublereal twopi_(void); - static doublereal q1, q2, psisq, qoms24, s4, sinio, sinmo, sinuk, tempe, - betao2, betao3, betao4, templ, tfour, upper, x1m5th, x1mth2, - x3thm1, x7thm1, fmod2p, theta2, theta4, xinck, xlcof, xmcof, - xmdot, xnode, xnodp; - static integer count; - static doublereal xndd6o; - static integer after; - static logical recog, unrec; - static doublereal ae, xhdot1, xndt2o, ke, ao, fl, eo, qoms2t, er, fu, pl, - omgadf, rk, qo, uk, so, xl; - static integer before; - static doublereal xn, omegao, delomg; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - static doublereal omgcof, perige, ux, uy, uz, fprime, elemnt[60] /* - was [10][6] */, tsince, ae2, ae3, ae4, epsiln, xnodeo, cosnok, - lstgeo[8], omgdot, ck2, cosepw, ck4, prelim[174] /* was [29][6] - */, rfdotk, sinepw, sinnok, vx, tokmps, vy, pinvsq, vz, xnodcf, - xnoddf, xnodek, epwnxt, xnodot; - static logical newgeo; - static doublereal eta, axn, ayn, epw, est, tsi, xll, xmo, xno, xmp, tsq, - xlt, xmx, xmy, del1, c1sq, pix2; - -/* $ Abstract */ - -/* This routine evaluates NORAD two-line element data for */ -/* near-earth orbiting spacecraft (that is spacecraft with */ -/* orbital periods less than 225 minutes). */ - -/* $ 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 */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch in seconds past ephemeris epoch J2000. */ -/* GEOPHS I Geophysical constants */ -/* ELEMS I Two-line element data */ -/* STATE O Evaluated state */ -/* NMODL P Parameter controlling number of buffered elements. */ - -/* $ Detailed_Input */ - -/* ET is the poch in seconds past ephemeris epoch J2000 */ -/* at which a state should be produced from the */ -/* input elements. */ - -/* GEOPHS is a collection of 8 geophysical constants needed */ -/* for computing a state. The order of these */ -/* constants must be: */ - -/* GEOPHS(1) = J2 gravitational harmonic for earth */ -/* GEOPHS(2) = J3 gravitational harmonic for earth */ -/* GEOPHS(3) = J4 gravitational harmonic for earth */ - -/* These first three constants are dimensionless. */ - -/* GEOPHS(4) = KE: Square root of the GM for earth where */ -/* GM is expressed in earth radii cubed per */ -/* minutes squared. */ - -/* GEOPHS(5) = QO: Low altitude bound for atmospheric */ -/* model in km. */ - -/* GEOPHS(6) = SO: High altitude bound for atmospheric */ -/* model in km. */ - -/* GEOPHS(7) = RE: Equatorial radius of the earth in km. */ - - -/* GEOPHS(8) = AE: Distance units/earth radius */ -/* (normally 1) */ - -/* Below are currently recommended values for these */ -/* items: */ - -/* J2 = 1.082616D-3 */ -/* J3 = -2.53881D-6 */ -/* J4 = -1.65597D-6 */ - -/* The next item is the square root of GM for the */ -/* earth given in units of earth-radii**1.5/Minute */ - -/* KE = 7.43669161D-2 */ - -/* The next two items give the top and */ -/* bottom of the atmospheric drag model */ -/* used by the type 10 ephemeris type. */ -/* Don't adjust these unless you understand */ -/* the full implications of such changes. */ - -/* QO = 120.0D0 */ -/* SO = 78.0D0 */ - -/* The following is the equatorial radius */ -/* of the earth as used by NORAD in km. */ - -/* ER = 6378.135D0 */ - -/* The value of AE is the number of */ -/* distance units per earth radii used by */ -/* the NORAD state propagation software. */ -/* The value should be 1 unless you've got */ -/* a very good understanding of the NORAD */ -/* routine SGP4 and the affect of changing */ -/* this value.. */ - -/* AE = 1.0D0 */ - -/* ELEMS is an array containg two-line element data */ -/* as prescribed below. The elements XNDD6O and BSTAR */ -/* must already be scaled by the proper exponent stored */ -/* in the two line elements set. Moreover, the */ -/* various items must be converted to the units shown */ -/* here. */ - -/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */ -/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */ -/* ELEMS ( 3 ) = BSTAR */ -/* ELEMS ( 4 ) = XINCL in radians */ -/* ELEMS ( 5 ) = XNODEO in radians */ -/* ELEMS ( 6 ) = EO */ -/* ELEMS ( 7 ) = OMEGAO in radians */ -/* ELEMS ( 8 ) = XMO in radians */ -/* ELEMS ( 9 ) = XNO in radians/minute */ -/* ELEMS ( 10 ) = EPOCH of the elements in seconds */ -/* past ephemeris epoch J2000. */ - -/* $ Detailed_Output */ - -/* STATE is the state produced by evaluating the input elements */ -/* at the input epoch ET. Units are km and km/sec. */ - -/* $ Parameters */ - -/* NMODL is a parameter that controls how many element sets */ -/* can be buffered internally. Since there are a lot */ -/* of computations that are independent of time these */ -/* are buffered and only computed if an unbuffered */ -/* model is supplied. This value should always */ -/* be at least 2. Increasing it a great deal is not */ -/* advised since the time needed to search the */ -/* buffered elements for a match increases linearly */ -/* with the NMODL. Imperically, 6 seems to be a good */ -/* break even value for NMODL. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) No checks are made on the reasonableness of the inputs. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine evaluates NORAD two-line element sets for */ -/* near-earth orbitting satellites. Near earth is defined to */ -/* be a satellite with an orbital period of less than 225 */ -/* minutes. This code is an adaptation of the NORAD routine */ -/* SGP4 to elliminate common blocks, allow buffering of models */ -/* and intermediate parameters and double precision calculations. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 02-JAN-2008 (EDW) */ - -/* Corrected error in the calculation of the C4 term */ -/* identified by Curtis Haase. */ - -/* Minor edit to the COEF1 declaration strictly */ -/* identifying the constant as a double. */ - -/* From: */ - -/* COEF1 = COEF / PSISQ**3.5 */ - -/* To: */ - -/* COEF1 = COEF / PSISQ**3.5D0 */ - -/* - SPICELIB Version 1.0.2, 08-JUL-2004 (EDW) */ - -/* Corrected error in the calculation of the C2 term. */ -/* Reordered C1, C2 calculations to avoid division */ -/* by BSTAR. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1998 (EDW) */ - -/* Corrected error in header describing the GEOPHS array. */ - -/* - SPICELIB Version 1.0.0, 14-JAN-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Evaluate NORAD two-line element data. */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Parameters */ - - -/* The following parameters give the location of the various */ -/* geophysical parameters needed for the two line element */ -/* sets. */ - -/* KJ2 --- location of J2 */ -/* KJ3 --- location of J3 */ -/* KJ4 --- location if J4 */ -/* KKE --- location of KE = sqrt(GM) in eart-radii**1.5/MIN */ -/* KQO --- upper bound of atmospheric model in KM */ -/* KSO --- lower bound of atmospheric model in KM */ -/* KER --- earth equatorial radius in KM. */ -/* KAE --- distance units/earth radius */ - - - -/* An enumeration of the various components of the */ -/* elements array---ELEMS */ - -/* KNDT20 */ -/* KNDD60 */ -/* KBSTAR */ -/* KINCL */ -/* KNODE0 */ -/* KECC */ -/* KOMEGA */ -/* KMO */ -/* KNO */ - - -/* The parameters NEXT and PREV are used in our linked list */ -/* LIST(NEXT,I) points to the list item the occurs after */ -/* list item I. LIST ( PREV, I ) points to the list item */ -/* that preceeds list item I. */ -/* NEXT */ -/* PREV */ - - -/* There are a number of preliminary quantities that are needed */ -/* to compute the state. Those that are not time dependent and */ -/* depend only upon the elements are stored in a buffer so that */ -/* if an element set matches a saved set, these preliminary */ -/* quantities will not be recomputed. PRSIZE is the parameter */ -/* used to declare the needed room. */ - - -/* When we perform bisection in the solution of Kepler's equation */ -/* we don't want to bisect too many times. */ - - -/* Numerical Constants */ - - -/* Local variables */ - -/* Geophysical Quantities */ - - -/* Elements */ - - -/* Intermediate quantities. The time independent quantities */ -/* are calculated only as new elements come into the routine. */ - - -/* Rather than always making function calls we store the */ -/* values of the PI dependent constants the first time */ -/* through the routine. */ - - if (doinit) { - doinit = FALSE_; - pix2 = twopi_(); - for (i__ = 1; i__ <= 8; ++i__) { - lstgeo[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("lstgeo", - i__1, "ev2lin_", (ftnlen)598)] = 0.; - } - for (i__ = 1; i__ <= 6; ++i__) { - for (j = 1; j <= 10; ++j) { - elemnt[(i__1 = j + i__ * 10 - 11) < 60 && 0 <= i__1 ? i__1 : - s_rnge("elemnt", i__1, "ev2lin_", (ftnlen)603)] = 0.; - } - } - -/* Set up our doubly linked list of most recently used */ -/* models. Here's how things are supposed to be arranged: */ - -/* LIST(NEXT,I) points to the ephemeris model that was used */ -/* most recently after ephemeris model I. */ -/* LIST(PREV,I) points to the latest ephemeris model used */ -/* that was used more recently than I. */ - -/* HEAD points to the most recently used ephemris */ -/* model. */ - - - head = 1; - list[(i__1 = (head << 1) - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge("list" - , i__1, "ev2lin_", (ftnlen)622)] = 0; - list[0] = 2; - for (i__ = 2; i__ <= 5; ++i__) { - list[(i__1 = (i__ << 1) - 2) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)627)] = i__ + 1; - list[(i__1 = (i__ << 1) - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)628)] = i__ - 1; - } - list[10] = 0; - list[11] = 5; - } - -/* We update the geophysical parameters only if there */ -/* has been a change from the last time they were */ -/* supplied. */ - - if (lstgeo[7] != geophs[7] || lstgeo[6] != geophs[6] || lstgeo[0] != - geophs[0] || lstgeo[1] != geophs[1] || lstgeo[2] != geophs[2] || - lstgeo[3] != geophs[3] || lstgeo[4] != geophs[4] || lstgeo[5] != - geophs[5]) { - for (i__ = 1; i__ <= 8; ++i__) { - lstgeo[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("lstgeo", - i__1, "ev2lin_", (ftnlen)650)] = geophs[i__ - 1]; - } - j2 = geophs[0]; - j3 = geophs[1]; - j4 = geophs[2]; - ke = geophs[3]; - qo = geophs[4]; - so = geophs[5]; - er = geophs[6]; - ae = geophs[7]; - ae2 = ae * ae; - ae3 = ae * ae2; - ae4 = ae * ae3; - ck2 = j2 * .5 * ae2; - a3ovk2 = j3 * -2. * ae / j2; - ck4 = j4 * -.375 * ae4; - qomso = qo - so; - q1 = qomso * ae / er; - q2 = q1 * q1; - qoms2t = q2 * q2; - s = ae * (so / er + 1.); - -/* When we've finished up we will need to convert everything */ -/* back to KM and KM/SEC the two variables below give the */ -/* factors we shall need to do this. */ - - tokm = er / ae; - tokmps = tokm / 60.; - newgeo = TRUE_; - } else { - newgeo = FALSE_; - } - -/* Fetch all of the pieces of this model. */ - - epoch = elems[9]; - xndt2o = elems[0]; - xndd6o = elems[1]; - bstar = elems[2]; - xincl = elems[3]; - xnodeo = elems[4]; - eo = elems[5]; - omegao = elems[6]; - xmo = elems[7]; - xno = elems[8]; - -/* See if this model is already buffered, start at the first */ -/* model in the list (the most recently used model). */ - - unrec = TRUE_; - n = head; - while(n != 0 && unrec) { - -/* The actual order of the elements is such that we can */ -/* usually tell that a stored model is different from */ -/* the one under consideration by looking at the */ -/* end of the list first. Hence we start with I = NELEMS */ -/* and decrement I until we have looked at everything */ -/* or found a mismatch. */ - - recog = TRUE_; - i__ = 10; - while(recog && i__ > 0) { - recog = recog && elemnt[(i__1 = i__ + n * 10 - 11) < 60 && 0 <= - i__1 ? i__1 : s_rnge("elemnt", i__1, "ev2lin_", (ftnlen) - 725)] == elems[i__ - 1]; - --i__; - } - unrec = ! recog; - if (unrec) { - last = n; - n = list[(i__1 = (n << 1) - 2) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)733)]; - } - } - if (n == 0) { - n = last; - } - -/* Either N points to a recognized item or it points to the */ -/* tail of the list where the least recently used items is */ -/* located. In either case N must be made the head of the */ -/* list. (If it is already the head of the list we don't */ -/* have to bother with anything.) */ - - if (n != head) { - -/* Find the items that come before and after N and */ -/* link them together. */ - - before = list[(i__1 = (n << 1) - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)754)]; - after = list[(i__1 = (n << 1) - 2) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)755)]; - list[(i__1 = (before << 1) - 2) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)757)] = after; - if (after != 0) { - list[(i__1 = (after << 1) - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "list", i__1, "ev2lin_", (ftnlen)760)] = before; - } - -/* Now the guy that will come after N is the current */ -/* head of the list. N will have no predecessor. */ - - list[(i__1 = (n << 1) - 2) < 12 && 0 <= i__1 ? i__1 : s_rnge("list", - i__1, "ev2lin_", (ftnlen)766)] = head; - list[(i__1 = (n << 1) - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge("list", - i__1, "ev2lin_", (ftnlen)767)] = 0; - -/* The predecessor the current head of the list becomes N */ - - list[(i__1 = (head << 1) - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge("list" - , i__1, "ev2lin_", (ftnlen)771)] = n; - -/* and finally, N becomes the head of the list. */ - - head = n; - } - if (recog && ! newgeo) { - -/* We can just look up the intermediate values from */ -/* computations performed on a previous call to this */ -/* routine. */ - - aodp = prelim[(i__1 = n * 29 - 29) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)786)]; - aycof = prelim[(i__1 = n * 29 - 28) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)787)]; - c1 = prelim[(i__1 = n * 29 - 27) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)788)]; - c4 = prelim[(i__1 = n * 29 - 26) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)789)]; - c5 = prelim[(i__1 = n * 29 - 25) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)790)]; - cosio = prelim[(i__1 = n * 29 - 24) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)791)]; - d2 = prelim[(i__1 = n * 29 - 23) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)792)]; - d3 = prelim[(i__1 = n * 29 - 22) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)793)]; - d4 = prelim[(i__1 = n * 29 - 21) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)794)]; - delmo = prelim[(i__1 = n * 29 - 20) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)795)]; - eta = prelim[(i__1 = n * 29 - 19) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)796)]; - omgcof = prelim[(i__1 = n * 29 - 18) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)797)]; - omgdot = prelim[(i__1 = n * 29 - 17) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)798)]; - perige = prelim[(i__1 = n * 29 - 16) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)799)]; - sinio = prelim[(i__1 = n * 29 - 15) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)800)]; - sinmo = prelim[(i__1 = n * 29 - 14) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)801)]; - t2cof = prelim[(i__1 = n * 29 - 13) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)802)]; - t3cof = prelim[(i__1 = n * 29 - 12) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)803)]; - t4cof = prelim[(i__1 = n * 29 - 11) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)804)]; - t5cof = prelim[(i__1 = n * 29 - 10) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)805)]; - x1mth2 = prelim[(i__1 = n * 29 - 9) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)806)]; - x3thm1 = prelim[(i__1 = n * 29 - 8) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)807)]; - x7thm1 = prelim[(i__1 = n * 29 - 7) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)808)]; - xlcof = prelim[(i__1 = n * 29 - 6) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)809)]; - xmcof = prelim[(i__1 = n * 29 - 5) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)810)]; - xmdot = prelim[(i__1 = n * 29 - 4) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)811)]; - xnodcf = prelim[(i__1 = n * 29 - 3) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)812)]; - xnodot = prelim[(i__1 = n * 29 - 2) < 174 && 0 <= i__1 ? i__1 : - s_rnge("prelim", i__1, "ev2lin_", (ftnlen)813)]; - xnodp = prelim[(i__1 = n * 29 - 1) < 174 && 0 <= i__1 ? i__1 : s_rnge( - "prelim", i__1, "ev2lin_", (ftnlen)814)]; - } else { - -/* Compute all of the intermediate items needed. */ -/* First, the inclination dependent constants. */ - - cosio = cos(xincl); - sinio = sin(xincl); - theta2 = cosio * cosio; - theta4 = theta2 * theta2; - x3thm1 = theta2 * 3. - 1.; - x7thm1 = theta2 * 7. - 1.; - x1mth2 = 1. - theta2; - x1m5th = 1. - theta2 * 5.; - -/* Eccentricity dependent constants */ - - betao = sqrt(1. - eo * eo); - betao2 = 1. - eo * eo; - betao3 = betao * betao2; - betao4 = betao2 * betao2; - -/* Semi-major axis and ascending node related constants. */ - - d__1 = ke / xno; - a1 = pow_dd(&d__1, &c_b90); - del1 = ck2 * 1.5 * x3thm1 / (a1 * a1 * betao3); - ao = a1 * (1. - del1 * (del1 * (del1 * 134. / 81. + 1.) + - .33333333333333331)); - delo = ck2 * 1.5 * x3thm1 / (ao * ao * betao3); - xnodp = xno / (delo + 1.); - aodp = ao / (1. - delo); - s4 = s; - qoms24 = qoms2t; - perige = er * (aodp * (1. - eo) - ae); - -/* For perigee below 156 km, the values of S and QOMS2T are */ -/* altered. */ - - if (perige < 156.) { - s4 = perige - 78.; - if (perige <= 98.) { - s4 = 20.; - } -/* Computing 4th power */ - d__1 = (120. - s4) * ae / er, d__1 *= d__1; - qoms24 = d__1 * d__1; - s4 = ae + s4 / er; - } - -/* The next block is simply a pretty print of the code in */ -/* sgp4 from label number 10 through the label 90. */ - - pinvsq = 1. / (aodp * aodp * betao4); - tsi = 1. / (aodp - s4); - eta = aodp * eo * tsi; - etasq = eta * eta; - eeta = eo * eta; -/* Computing 4th power */ - d__1 = tsi, d__1 *= d__1; - coef = qoms24 * (d__1 * d__1); - psisq = (d__1 = 1. - etasq, abs(d__1)); - coef1 = coef / pow_dd(&psisq, &c_b91); - c2 = coef1 * xnodp * (aodp * (etasq * 1.5 + 1. + eeta * (etasq + 4.)) - + ck2 * .75 * (tsi / psisq) * x3thm1 * (etasq * (etasq * 3. + - 24.) + 8.)); - c1 = c2 * bstar; - c3 = coef * tsi * a3ovk2 * xnodp * ae * sinio / eo; - c4 = xnodp * 2. * coef1 * aodp * betao2 * (eta * (etasq * .5 + 2.) + - eo * (etasq * 2. + .5) - ck2 * tsi / (aodp * psisq) * 2. * ( - x3thm1 * -3. * (1. - eeta * 2. + etasq * (1.5 - eeta * .5)) + - cos(omegao * 2.) * .75 * x1mth2 * (etasq * 2. - eeta * (etasq - + 1.)))); - c5 = coef1 * 2. * aodp * betao2 * ((etasq + eeta) * 2.75 + 1. + eeta * - etasq); - temp1 = ck2 * 3. * pinvsq * xnodp; - temp2 = temp1 * ck2 * pinvsq; - temp3 = ck4 * 1.25 * pinvsq * pinvsq * xnodp; - xmdot = xnodp + temp1 * .5 * betao * x3thm1 + temp2 * .0625 * betao * - (13. - theta2 * 78. + theta4 * 137.); - omgdot = temp1 * -.5 * x1m5th + temp2 * .0625 * (7. - theta2 * 114. + - theta4 * 395.) + temp3 * (3. - theta2 * 36. + theta4 * 49.); - xhdot1 = -temp1 * cosio; - xnodot = xhdot1 + cosio * (temp2 * .5 * (4. - theta2 * 19.) + temp3 * - 2. * (3. - theta2 * 7.)); - omgcof = bstar * c3 * cos(omegao); - xmcof = -bstar * .66666666666666663 * coef * ae / eeta; - xnodcf = betao2 * 3.5 * xhdot1 * c1; - t2cof = c1 * 1.5; - aycof = a3ovk2 * .25 * sinio; - xlcof = aycof * .5 * (cosio * 5. + 3.) / (cosio + 1.); -/* Computing 3rd power */ - d__1 = eta * cos(xmo) + 1.; - delmo = d__1 * (d__1 * d__1); - sinmo = sin(xmo); - -/* For perigee less than 220 kilometers, the ISIMP flag is set */ -/* and the equations are truncated to linear variation in SQRT */ -/* A and quadratic variation in mean anomaly. Also, the C3 */ -/* term, the Delta OMEGA term, and the Delta M term are */ -/* dropped. (Note: Normally we would just use */ - - if (perige >= 220.) { - c1sq = c1 * c1; - d2 = tsi * 4. * c1sq * aodp; - temp = d2 * tsi * c1 * .33333333333333331; - d3 = temp * (s4 + aodp * 17.); - d4 = temp * tsi * c1 * aodp * .5 * (aodp * 221. + s4 * 31.); - t3cof = d2 + c1sq * 2.; - t4cof = (d3 * 3. + c1 * (d2 * 12. + c1sq * 10.)) * .25; - t5cof = (d4 * 3. + c1 * 12. * d3 + d2 * 6. * d2 + c1sq * 15. * ( - d2 * 2. + c1sq)) * .2; - } - -/* Now store the intermediate computations so that if we */ -/* should hit this model again we can just look up the needed */ -/* results from the above computations. */ - - prelim[(i__1 = n * 29 - 29) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)984)] = aodp; - prelim[(i__1 = n * 29 - 28) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)985)] = aycof; - prelim[(i__1 = n * 29 - 27) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)986)] = c1; - prelim[(i__1 = n * 29 - 26) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)987)] = c4; - prelim[(i__1 = n * 29 - 25) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)988)] = c5; - prelim[(i__1 = n * 29 - 24) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)989)] = cosio; - prelim[(i__1 = n * 29 - 23) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)990)] = d2; - prelim[(i__1 = n * 29 - 22) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)991)] = d3; - prelim[(i__1 = n * 29 - 21) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)992)] = d4; - prelim[(i__1 = n * 29 - 20) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)993)] = delmo; - prelim[(i__1 = n * 29 - 19) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)994)] = eta; - prelim[(i__1 = n * 29 - 18) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)995)] = omgcof; - prelim[(i__1 = n * 29 - 17) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)996)] = omgdot; - prelim[(i__1 = n * 29 - 16) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)997)] = perige; - prelim[(i__1 = n * 29 - 15) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)998)] = sinio; - prelim[(i__1 = n * 29 - 14) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)999)] = sinmo; - prelim[(i__1 = n * 29 - 13) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)1000)] = t2cof; - prelim[(i__1 = n * 29 - 12) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)1001)] = t3cof; - prelim[(i__1 = n * 29 - 11) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)1002)] = t4cof; - prelim[(i__1 = n * 29 - 10) < 174 && 0 <= i__1 ? i__1 : s_rnge("prel" - "im", i__1, "ev2lin_", (ftnlen)1003)] = t5cof; - prelim[(i__1 = n * 29 - 9) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1004)] = x1mth2; - prelim[(i__1 = n * 29 - 8) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1005)] = x3thm1; - prelim[(i__1 = n * 29 - 7) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1006)] = x7thm1; - prelim[(i__1 = n * 29 - 6) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1007)] = xlcof; - prelim[(i__1 = n * 29 - 5) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1008)] = xmcof; - prelim[(i__1 = n * 29 - 4) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1009)] = xmdot; - prelim[(i__1 = n * 29 - 3) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1010)] = xnodcf; - prelim[(i__1 = n * 29 - 2) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1011)] = xnodot; - prelim[(i__1 = n * 29 - 1) < 174 && 0 <= i__1 ? i__1 : s_rnge("prelim" - , i__1, "ev2lin_", (ftnlen)1012)] = xnodp; - -/* Finally, move these elements in the storage area */ -/* for checking the next time through. */ - - for (i__ = 1; i__ <= 10; ++i__) { - elemnt[(i__1 = i__ + n * 10 - 11) < 60 && 0 <= i__1 ? i__1 : - s_rnge("elemnt", i__1, "ev2lin_", (ftnlen)1018)] = elems[ - i__ - 1]; - } - } - -/* Now that all of the introductions are out of the way */ -/* we can get down to business. */ - -/* Compute the time since the epoch for this model. */ - - tsince = *et - epoch; - -/* and convert it to minutes */ - - tsince /= 60.; - xmdf = xmo + xmdot * tsince; - omgadf = omegao + omgdot * tsince; - xnoddf = xnodeo + xnodot * tsince; - omega = omgadf; - xmp = xmdf; - tsq = tsince * tsince; - xnode = xnoddf + xnodcf * tsq; - tempa = 1. - c1 * tsince; - tempe = bstar * c4 * tsince; - templ = t2cof * tsq; - if (perige > 220.) { - tcube = tsq * tsince; - tfour = tcube * tsince; - delomg = omgcof * tsince; -/* Computing 3rd power */ - d__1 = eta * cos(xmdf) + 1.; - delm = xmcof * (d__1 * (d__1 * d__1) - delmo); - temp = delomg + delm; - xmp = xmdf + temp; - omega = omgadf - temp; - tempa = tempa - d2 * tsq - d3 * tcube - d4 * tfour; - tempe += bstar * c5 * (sin(xmp) - sinmo); - templ = templ + tcube * t3cof + tfour * (t4cof + tsince * t5cof); - } -/* Computing 2nd power */ - d__1 = tempa; - a = aodp * (d__1 * d__1); - xl = xmp + omega + xnode + xnodp * templ; - e = eo - tempe; - -/* The parameter BETA used to be needed, but it's only use */ -/* was in the computation of TEMP below where it got squared */ -/* so we'll remove it from the list of things to compute. */ - -/* BETA = DSQRT( 1.0D0 - E*E ) */ - - xn = ke / pow_dd(&a, &c_b152); - -/* Long period periodics */ - - temp = 1. / (a * (1. - e * e)); - aynl = temp * aycof; - ayn = e * sin(omega) + aynl; - axn = e * cos(omega); - xll = temp * xlcof * axn; - xlt = xl + xll; - -/* Solve keplers equation. */ - -/* We are going to solve for the roots of this equation by */ -/* using a mixture of Newton's method and the prescription for */ -/* root finding outlined in the SPICE routine UNITIM. */ - -/* We are going to solve the equation */ - -/* U = EPW - AXN * SIN(EPW) + AYN * COS(EPW) */ - -/* Where */ - -/* AYN = E * SIN(OMEGA) + AYNL */ -/* AXN = E * COS(OMEGA) */ - -/* And */ - -/* AYNL = -0.50D0 * SINIO * AE * J3 / (J2*A*(1.0D0 - E*E)) */ - -/* Since this is a low earth orbiter (period less than 225 minutes) */ -/* The maximum value E can take (without having the orbiter */ -/* plowing fields) is approximately 0.47 and AYNL will not be */ -/* more than about .01. ( Typically E will be much smaller */ -/* on the order of about .1 ) Thus we can initially */ -/* view the problem of solving the equation for EPW as a */ -/* function of the form */ - -/* U = EPW + F ( EPW ) (1) */ - -/* Where F( EPW ) = -AXN*SIN(EPW) + AYN*COS(EPW) */ - -/* Note that | F'(EPW) | < M = DSQRT( AXN**2 + AYN**2 ) < 0.48 */ - -/* From the above discussion it is evident that F is a contraction */ -/* mapping. So that we can employ the same techniques as were */ -/* used in the routine UNITIM to get our first approximations of */ -/* the root. Once we have some good first approximations, we */ -/* will speed up the root finding by using Newton's method for */ -/* finding a zero of a function. The function we will work on */ -/* is */ - -/* f (x) = x - U - AXN*SIN(x) + AYN*COS(x) (2) */ - -/* By applying Newton's method we will go from linear to */ -/* quadratic convergence. */ - -/* We will keep track of our error bounds along the way so */ -/* that we will know how many iterations to perform in each */ -/* phase of the root extraction. */ - -/* few steps using bisection. */ - - -/* For the benefit of those interested */ -/* here's the basics of what we'll do. */ - -/* Whichever EPW satisfies equation (1) will be */ -/* unique. The uniqueness of the solution is ensured because the */ -/* expression on the right-hand side of the equation is */ -/* monotone increasing in EPW. */ - -/* Let's suppose that EPW is the solution, then the following */ -/* is true. */ - -/* EPW = U - F(EPW) */ - -/* but we can also replace the EPW on the right hand side of the */ -/* equation by U - F(EPW). Thus */ - -/* EPW = U - F( U - F(EPW)) */ - -/* = U - F( U - F( U - F(EPW))) */ - -/* = U - F( U - F( U - F( U - F(EPW)))) */ - -/* = U - F( U - F( U - F( U - F( U - F(EPW))))) */ -/* . */ -/* . */ -/* . */ -/* = U - F( U - F( U - F( U - F( U - F(U - ... ))) */ - -/* and so on, for as long as we have patience to perform the */ -/* substitutions. */ - -/* The point of doing this recursive substitution is that we */ -/* hope to move EPW to an insignificant part of the computation. */ -/* This would seem to have a reasonable chance of success since */ -/* F is a bounded and has a small derivative. */ - -/* Following this idea, we will attempt to solve for EPW using */ -/* the recursive method outlined below. */ - -/* We will make our first guess at EPW, call it EPW_0. */ - -/* EPW_0 = U */ - -/* Our next guess, EPW_1, is given by: */ - -/* EPW_1 = U - F(EPW_0) */ - -/* And so on: */ - -/* EPW_2 = U - F(EPW_1) [ = U - F(U - F(U)) ] */ -/* EPW_3 = U - F(EPW_2) [ = U - F(U - F(U - F(U))) ] */ -/* . */ -/* . */ -/* . */ -/* EPW_n = U - F(EPW_(n-1)) [ = U - F(U - F(U - F(U...)))] */ - -/* The questions to ask at this point are: */ - -/* 1) Do the EPW_i's converge? */ -/* 2) If they converge, do they converge to EPW? */ -/* 3) If they converge to EPW, how fast do they get there? */ - -/* 1) The sequence of approximations converges. */ - -/* | EPW_n - EPW_(n-1) | = [ U - F( EPW_(n-1) ) ] */ -/* - [ U - F( EPW_(n-2) ) ] */ - -/* = [ F( EPW_(n-2) ) - F( EPW_(n-1)) ] */ - -/* The function F has an important property. The absolute */ -/* value of its derivative is always less than M. */ -/* This means that for any pair of real numbers s,t */ - -/* | F(t) - F(s) | < M*| t - s |. */ - -/* From this observation, we can see that */ - -/* | EPW_n - EPW_(n-1) | < M*| EPW_(n-1) - EPW_(n-2) | */ - -/* With this fact available, we could (with a bit more work) */ -/* conclude that the sequence of EPW_i's converges and that */ -/* it converges at a rate that is at least as fast as the */ -/* sequence M, M**2, M**3. In fact the difference */ -/* |EPW - EPW_N| < M/(1-M) * | EPW_N - EPW_(N-1) | */ - -/* < M/(1-M) * M**N | EPW_1 - EPW_0 | */ - -/* 2) If we let EPW be the limit of the EPW_i's then it follows */ -/* that */ - -/* EPW = U - F(EPW). */ - - -/* or that */ - -/* U = EPW + F(EPW). */ - -/* We will use this technique to get an approximation that */ -/* is within a tolerance of EPW and then switch to */ -/* a Newton's method. (We'll compute the tolerance using */ -/* the value of M given above). */ - - -/* For the Newton's method portion of the problem, recall */ -/* from Taylor's formula that: */ - -/* f(x) = f(x_0) + f'(x_0)(x-x_0) + f''(c)/2 (x-x_0)**2 */ - -/* for some c between x and x_0 */ - -/* If x happens to be a zero of f then we can rearrange the */ -/* terms above to get */ - -/* f(x_0) f''(c) */ -/* x = x_0 - ------- + -------- ( x - x_0)**2 */ -/* f'(x_0) f'(x_0) */ - -/* Thus the error in the Newton approximation */ - - -/* f(x_0) */ -/* x = x_0 - ------- */ -/* f'(x_0) */ - -/* is */ - -/* f''(c) */ -/* -------- ( x - x_0)**2 */ -/* f'(x_0) */ - -/* Thus if we can bound f'' and pick a good first */ -/* choice for x_0 (using the first method outlined */ -/* above we can get quadratic convergence.) */ - -/* In our case we have */ - -/* f (x) = x - U - AXN*SIN(x) + AYN*COS(x) */ -/* f' (x) = 1 - AXN*COS(x) - AYN*SIN(x) */ -/* f''(x) = AXN*SIN(x) - AYN*COS(x) */ - -/* So that: */ - -/* f' (x) > 1 - M */ - -/* f''(x) < M */ - -/* Thus the error in the Newton's approximation is */ -/* at most */ - -/* M/(1-M) * ( x - x_0 )**2 */ - -/* Thus as long as our original estimate (determined using */ -/* the contraction method) gets within a reasonable tolerance */ -/* of x, we can use Newton's method to acheive faster */ -/* convergence. */ - - m = sqrt(axn * axn + ayn * ayn); - mov1m = (d__1 = m / (1. - m), abs(d__1)); - d__1 = xlt - xnode; - fmod2p = d_mod(&d__1, &pix2); - if (fmod2p < 0.) { - fmod2p += pix2; - } - capu = fmod2p; - epw = capu; - est = 1.; - while(est > .125) { - epwnxt = capu - axn * sin(epw) + ayn * cos(epw); - est = mov1m * (d__1 = epwnxt - epw, abs(d__1)); - epw = epwnxt; - } - -/* We need to be able to add something to EPW and not */ -/* get EPW (but not too much). */ - - epsiln = est; - if (epsiln + epw != epw) { - -/* Now we switch over to Newton's method. Note that */ -/* since our error estimate is less than 1/8, six iterations */ -/* of Newton's method should get us to within 1/2**96 of */ -/* the correct answer (If there were no round off to contend */ -/* with). */ - - for (i__ = 1; i__ <= 5; ++i__) { - sinepw = sin(epw); - cosepw = cos(epw); - f = epw - capu - axn * sinepw + ayn * cosepw; - fprime = 1. - axn * cosepw - ayn * sinepw; - epwnxt = epw - f / fprime; - -/* Our new error estimate comes from the discussion */ -/* of convergence of Newton's method. */ - - epw = epwnxt; - if (epw + est != epw) { - epsiln = est; - est = mov1m * est * est; - } - } - } - -/* Finally, we use bisection to avoid the problems of */ -/* round-off that may be present in Newton's method. Since */ -/* we've gotten quite close to the answer (theoretically */ -/* anyway) we won't have to perform many bisection passes. */ - -/* First we must bracket the root. Note that we will */ -/* increase EPSILN so that we don't spend much time */ -/* determining the bracketing interval. Also if the first */ -/* addition of EPSILN to EPW doesn't modify it, were set up */ -/* to just quit. This happens only if F is sufficiently */ -/* close to zero that it can't alter EPW by adding it to */ -/* or subtracting it from EPW. */ - - sinepw = sin(epw); - cosepw = cos(epw); - f = epw - capu - axn * sinepw + ayn * cosepw; -/* Computing MAX */ - d__1 = abs(f); - epsiln = max(d__1,epsiln); - if (f == 0.) { - lower = epw; - upper = epw; - } else if (f > 0.) { - fu = f; - upper = epw; - lower = epw - epsiln; - epw = lower; - while(f > 0. && lower != upper) { - epw -= epsiln; - f = epw - capu - axn * sin(epw) + ayn * cos(epw); - epsiln *= 2.; - } - lower = epw; - fl = f; - if (f == 0.) { - upper = lower; - } - } else if (f < 0.) { - fl = f; - lower = epw; - upper = epw + epsiln; - epw = upper; - while(f < 0. && lower != upper) { - epw += epsiln; - f = epw - capu - axn * sin(epw) + ayn * cos(epw); - epsiln *= 2.; - } - upper = epw; - fu = f; - if (f == 0.) { - lower = epw; - } - } - -/* Finally, bisect until we can do no more. */ - - count = 0; - while(upper > lower && count < 20) { - ++count; - d__1 = (upper + lower) * .5; - epw = brcktd_(&d__1, &lower, &upper); - -/* EPW eventually will not be different from one of the */ -/* two bracketing values. If this is the time, we need */ -/* to decide on a value for EPW. That's done below. */ - - if (epw == upper || epw == lower) { - if (-fl < fu) { - epw = lower; - upper = lower; - } else { - epw = upper; - lower = upper; - } - } else { - f = epw - capu - axn * sin(epw) + ayn * cos(epw); - if (f > 0.) { - upper = epw; - fu = f; - } else if (f < 0.) { - lower = epw; - fl = f; - } else { - lower = epw; - upper = epw; - } - } - } - -/* Short period preliminary quantities */ - - sinepw = sin(epw); - cosepw = cos(epw); - temp3 = axn * sinepw; - temp4 = ayn * cosepw; - temp5 = axn * cosepw; - temp6 = ayn * sinepw; - ecose = temp5 + temp6; - esine = temp3 - temp4; - elsq = axn * axn + ayn * ayn; - temp = 1. - elsq; - pl = a * temp; - r__ = a * (1. - ecose); - temp1 = 1. / r__; - rdot = ke * temp1 * sqrt(a) * esine; - rfdot = ke * temp1 * sqrt(pl); - temp2 = a * temp1; - betal = sqrt(temp); - temp3 = 1. / (betal + 1.); - cosu = temp2 * (cosepw - axn + ayn * esine * temp3); - sinu = temp2 * (sinepw - ayn - axn * esine * temp3); - -/* Compute the angle from the x-axis of the point ( COSU, SINU ) */ - - if (sinu != 0. || cosu != 0.) { - u = atan2(sinu, cosu); - if (u < 0.) { - u += pix2; - } - } else { - u = 0.; - } - sin2u = sinu * 2. * cosu; - cos2u = cosu * 2. * cosu - 1.; - temp = 1. / pl; - temp1 = ck2 * temp; - temp2 = temp1 * temp; - -/* Update for short periodics */ - - rk = r__ * (1. - temp2 * 1.5 * betal * x3thm1) + temp1 * .5 * x1mth2 * - cos2u; - uk = u - temp2 * .25 * x7thm1 * sin2u; - xnodek = xnode + temp2 * 1.5 * cosio * sin2u; - xinck = xincl + temp2 * 1.5 * cosio * cos2u * sinio; - rdotk = rdot - xn * temp1 * x1mth2 * sin2u; - rfdotk = rfdot + xn * temp1 * (x1mth2 * cos2u + x3thm1 * 1.5); - -/* Orientation vectors */ - - sinuk = sin(uk); - cosuk = cos(uk); - sinik = sin(xinck); - cosik = cos(xinck); - sinnok = sin(xnodek); - cosnok = cos(xnodek); - xmx = -sinnok * cosik; - xmy = cosnok * cosik; - ux = xmx * sinuk + cosnok * cosuk; - uy = xmy * sinuk + sinnok * cosuk; - uz = sinik * sinuk; - vx = xmx * cosuk - cosnok * sinuk; - vy = xmy * cosuk - sinnok * sinuk; - vz = sinik * cosuk; - -/* Position and velocity */ - - state[0] = tokm * rk * ux; - state[1] = tokm * rk * uy; - state[2] = tokm * rk * uz; - state[3] = tokmps * (rdotk * ux + rfdotk * vx); - state[4] = tokmps * (rdotk * uy + rfdotk * vy); - state[5] = tokmps * (rdotk * uz + rfdotk * vz); - return 0; -} /* ev2lin_ */ - diff --git a/ext/spice/src/cspice/even.c b/ext/spice/src/cspice/even.c deleted file mode 100644 index 12d5c3d2b7..0000000000 --- a/ext/spice/src/cspice/even.c +++ /dev/null @@ -1,146 +0,0 @@ -/* even.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EVEN ( Is an integer even? ) */ -logical even_(integer *i__) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Determine whether an integer is even. */ - -/* $ 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 */ - -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* I I The integer in question. */ -/* EVEN O True if I is even, otherwise false. */ - -/* $ Detailed_Input */ - -/* I is the integer to be tested for evenness. */ - -/* $ Detailed_Output */ - -/* EVEN is true if I is even, false if I is odd. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let ENDPTS contain a series of endpoints, */ - -/* a , b , ..., a , b */ -/* 1 1 n n */ - -/* representing an ordered collection of disjoint intervals, */ - -/* a < b < a */ -/* i - i i+1 */ - -/* The following code fragment uses EVEN to determine whether */ -/* an arbitrary value X is contained in any of the intervals. */ - -/* CONTAINED = .FALSE. */ - -/* DO I = 1, N-1 */ -/* IF ( X .GE. ENDPTS(I) .AND. X .LE. ENDPTS(I+1) ) THEN */ -/* CONTAINED = ( .NOT. EVEN ( I ) ) */ -/* END IF */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether an integer is even */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* Self-explanatory. */ - - ret_val = *i__ % 2 == 0; - return ret_val; -} /* even_ */ - diff --git a/ext/spice/src/cspice/exact.c b/ext/spice/src/cspice/exact.c deleted file mode 100644 index 00c44279b0..0000000000 --- a/ext/spice/src/cspice/exact.c +++ /dev/null @@ -1,140 +0,0 @@ -/* exact.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EXACT ( Round to exact value ) */ -doublereal exact_(doublereal *number, doublereal *value, doublereal *tol) -{ - /* System generated locals */ - doublereal ret_val, d__1; - -/* $ Abstract */ - -/* Round an input double precision number to a specified exact value */ -/* if the number and the value are equal to within some tolerance. */ - -/* $ 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 */ - -/* COMPARE */ -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Double precision number. */ -/* VALUE I Target value. */ -/* TOL I Tolerance. */ - -/* The function returns VALUE whenever |NUMBER - VALUE| < TOL. */ -/* - */ - -/* $ Detailed_Input */ - -/* NUMBER is an arbitrary double precision number. */ - -/* VALUE is a target value. */ - -/* TOL is a tolerance. NUMBER and VALUE are considered to */ -/* be equal if they differ by no more than this amount. */ -/* If TOL is negative, they are never considered equal. */ - -/* $ Detailed_Output */ - -/* The function returns VALUE whenever |NUMBER - VALUE| < TOL, and */ -/* otherwise returns NUMBER. - */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* C */ -/* C If the eccentricity is near one, make this a parabola. */ -/* C */ -/* ECC = EXACT ( ECC, 1.D0, 10.D-12 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* round to exact value */ - -/* -& */ - -/* Just shorthand, really. */ - - if ((d__1 = *number - *value, abs(d__1)) <= *tol) { - ret_val = *value; - } else { - ret_val = *number; - } - return ret_val; -} /* exact_ */ - diff --git a/ext/spice/src/cspice/excess.c b/ext/spice/src/cspice/excess.c deleted file mode 100644 index b90a321c36..0000000000 --- a/ext/spice/src/cspice/excess.c +++ /dev/null @@ -1,242 +0,0 @@ -/* excess.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure EXCESS ( Report an excess of elements in a cell ) */ -/* Subroutine */ int excess_(integer *number, char *struct__, ftnlen - struct_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - char error[320]; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Set the long error message so as to indicate the number of excess */ -/* elements encountered by a routine operating on cells or on data */ -/* structures based on cells. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS, ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Number of excess elements. */ -/* STRUCT I Name of the data structure. */ - -/* $ Detailed_Input */ - - -/* NUMBER is the number of excess elements encountered. */ -/* This may be zero or negative, which indicates */ -/* no excess. */ - -/* STRUCT is the name of the data structure being manipulated. */ -/* Typically, this is one of the strings: 'cell', 'set', */ -/* or 'symbol table'. However, it may be any character */ -/* string. STRUCT should NOT end in a period. */ -/* The period at the end of the message is supplied */ -/* automatically. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* EXCESS sets the long error message. The message has the form: */ - -/* An excess of element(s) could */ -/* not be accomodated in the output . */ - -/* Leading and trailing blanks in STRUCT are removed. If there is */ -/* no excess (NUMBER is zero or negative), then is blank. */ - -/* $ Examples */ - -/* The response of EXCESS to a variety of inputs is illustrated */ -/* below. */ - -/* NUMBER = 1 */ -/* STRUCT = 'set' */ -/* ERROR = 'An excess of 1 element could not */ -/* be accomodated in the output set.' */ - -/* NUMBER = 5 */ -/* STRUCT = 'stack' */ -/* ERROR = An excess of 5 elements could not */ -/* be accomodated in the output stack.' */ - -/* NUMBER = 0 */ -/* STRUCT = */ -/* ERROR = ' ' */ - -/* NUMBER = -6 */ -/* STRUCT = */ -/* ERROR = ' ' */ - -/* In particular, note that EXCESS does not set the long error */ -/* message when the number of excess elements is not positive. Also, */ -/* the singular 'element' is used for an excess of one, while */ -/* the plural 'elements' is used for all other positive excesses. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* This subprogram does not detect any errors. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* report an excess of elements in a cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 11-JAN-1989 (NJB) */ - -/* Sets the long error message directly. No longer returns */ -/* an error message. Message no longer contains name of */ -/* routine which detected the error. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("EXCESS", (ftnlen)6); - -/* If there is no excess, don't report one. */ - - if (*number > 0) { - -/* Begin with the number. We will build the rest of the */ -/* message around it. */ - - intstr_(number, error, (ftnlen)320); - -/* A short blurb goes in front of the number. */ - - prefix_("An excess of", &c__1, error, (ftnlen)12, (ftnlen)320); - -/* Singular or plural? */ - - if (*number == 1) { - suffix_("element", &c__1, error, (ftnlen)7, (ftnlen)320); - } else { - suffix_("elements", &c__1, error, (ftnlen)8, (ftnlen)320); - } - -/* Another short blurb. */ - - suffix_("could not be accommodated in the output", &c__1, error, ( - ftnlen)39, (ftnlen)320); - -/* And the name of the structure. */ - - suffix_(struct__, &c__1, error, struct_len, (ftnlen)320); - -/* And a period at the end, to complete the sentence. */ - - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)320); - -/* Set the long error message: */ - - setmsg_(error, (ftnlen)320); - } else { - s_copy(error, " ", (ftnlen)320, (ftnlen)1); - } - chkout_("EXCESS", (ftnlen)6); - return 0; -} /* excess_ */ - diff --git a/ext/spice/src/cspice/exists.c b/ext/spice/src/cspice/exists.c deleted file mode 100644 index aa74d63b59..0000000000 --- a/ext/spice/src/cspice/exists.c +++ /dev/null @@ -1,264 +0,0 @@ -/* exists.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EXISTS ( Does the file exist? ) */ -logical exists_(char *file, ftnlen file_len) -{ - /* System generated locals */ - logical ret_val; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *); - - /* Local variables */ - integer r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - logical myexst; - -/* $ Abstract */ - -/* Determine whether a file exists. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I Name of the file in question. */ - -/* The function returns the value TRUE if the file exists, FALSE */ -/* otherwise. */ - -/* $ Detailed_Input */ - -/* FILE is the name of the file in question. This may be */ -/* a system name, e.g. */ - -/* 'DISK:[USER.SUB1.SUB2]DATA.DAT' */ -/* '\usr\dir1\dir2\data.dat' */ - -/* or a logical name, e.g. */ - -/* 'EPHEMERIS' */ -/* 'DATA$DIR:SAMPLE.DAT' */ - -/* $ Detailed_Output */ - -/* The function returns the value TRUE if the file exists, FALSE */ -/* otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Use the Fortran INQUIRE statement to determine the existence */ -/* of FILE. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of EXISTS. */ - -/* IF ( EXISTS ( FILE ) ) THEN */ -/* CALL UPDATE ( FILE ) */ -/* ELSE */ -/* ERROR = 'Input file does not exist.' */ -/* RETURN */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the filename is blank, the error SPICE(BLANKFILENAME) will */ -/* be signalled. */ - -/* 2) If an error occurs during the execution of the Fortran INQUIRE */ -/* statement, the error SPICE(INQUIREFAILED) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 9-DEC-1999 (WLT) */ - -/* The input file name is now "trimmed" of trailing blanks */ -/* before checking its existance. */ - -/* - SPICELIB Version 2.1.0, 4-MAR-1996 (KRG) */ - -/* Added a local logical variable that is used as temporary */ -/* storage for the results from the INQUIRE statement rather */ -/* than using the function name. This solved a problem on the */ -/* macintosh. */ - -/* - SPICELIB Version 2.0.0, 04-AUG-1994 (KRG) */ - -/* Added a test to see if the filename was blank before the */ -/* INQUIRE statement. This allows a meaningful error message to */ -/* be presented. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* does the file exist */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 4-MAR-1996 (KRG) */ - -/* Added a local logical variable that is used as temporary */ -/* storage for the results from the INQUIRE statement rather */ -/* than using the function name. This solved a problem on the */ -/* macintosh. */ - -/* - Beta Version 2.0.0, 29-DEC-1988 (HAN) */ - -/* The IOSTAT specifier was added to the INQUIRE statement. */ -/* If the value of IOSTAT is not equal to zero, an error */ -/* occurred during the execution of the INQUIRE statement. */ -/* In this case, a SPICELIB error is signalled and the routine */ -/* checks out. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("EXISTS", (ftnlen)6); - } - -/* Initialize the local variable MYEXST to be .FALSE. */ - - myexst = FALSE_; - -/* First we test to see if the filename is blank. */ - - if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) { - ret_val = FALSE_; - setmsg_("The file name is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("EXISTS", (ftnlen)6); - return ret_val; - } - r__ = rtrim_(file, file_len); - -/* So simple, it defies explanation. */ - - ioin__1.inerr = 1; - ioin__1.infilen = r__; - ioin__1.infile = file; - ioin__1.inex = &myexst; - ioin__1.inopen = 0; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - ret_val = FALSE_; - setmsg_("Value of IOSTAT was *.", (ftnlen)22); - errint_("*", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("EXISTS", (ftnlen)6); - return ret_val; - } - -/* Set the value of the function, check out and return. */ - - ret_val = myexst; - chkout_("EXISTS", (ftnlen)6); - return ret_val; -} /* exists_ */ - diff --git a/ext/spice/src/cspice/exists_c.c b/ext/spice/src/cspice/exists_c.c deleted file mode 100644 index c2c4ace109..0000000000 --- a/ext/spice/src/cspice/exists_c.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - --Procedure exists_c ( Does the file exist? ) - --Abstract - - Determine whether a file exists. - --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 - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceBoolean exists_c ( ConstSpiceChar * fname ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - fname I Name of the file in question. - - The function returns the value SPICETRUE if the file exists, - SPICEFALSE otherwise. - --Detailed_Input - - fname is the name of the file in question. This may be - a system name, e.g. - - "DISK:[USER.SUB1.SUB2]DATA.DAT" - "\usr\dir1\dir2\data.dat" - - or a logical name, e.g. - - "EPHEMERIS" - "DATA$DIR:SAMPLE.DAT" - --Detailed_Output - - The function returns the value SPICETRUE if the file exists, - SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) If the input name is blank, the error SPICE(BLANKFILENAME) will - be signalled. (This test is currently unimplemented.) - - 2) If an error occurs during the execution existence test, - the error SPICE(INQUIREFAILED) is signalled. - --Particulars - - Uses the f2c I/O libraries to implement the existence test. - --Examples - - The following code fragment illustrates the use of exists_c. - - if ( exists_c ( file ) ) - { - update ( file ); - } - else - { - setmsg_c ( "Input file does not exist." ); - sigerr_c ( "FILENOTFOUND" ); - return; - } - --Restrictions - - None. - --Files - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - H.A. Neilan (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR_VAL. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 2.1.0, 4-MAR-1996 (KRG) - --Index_Entries - - does the file exist - --& -*/ - -{ /* Begin exists_c */ - - - /* - Local variables - */ - SpiceBoolean fileExists; - - - /* - Participate in error tracing. - */ - chkin_c ( "exists_c"); - - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "exists_c", fname, SPICEFALSE ); - - - /* - Do the existence test. - */ - fileExists = (SpiceBoolean) exists_( ( char * ) fname, - ( ftnlen ) strlen(fname) ); - - chkout_c ( "exists_c" ); - return ( fileExists ); - - -} /* End exists_c */ diff --git a/ext/spice/src/cspice/exit_.c b/ext/spice/src/cspice/exit_.c deleted file mode 100644 index da3ab5c10e..0000000000 --- a/ext/spice/src/cspice/exit_.c +++ /dev/null @@ -1,37 +0,0 @@ -/* This gives the effect of - - subroutine exit(rc) - integer*4 rc - stop - end - - * with the added side effect of supplying rc as the program's exit code. - */ - -#include "f2c.h" -#undef abs -#undef min -#undef max -#ifndef KR_headers -#include "stdlib.h" -#ifdef __cplusplus -extern "C" { -#endif -extern void f_exit(void); -#endif - - void -#ifdef KR_headers -exit_(rc) integer *rc; -#else -exit_(integer *rc) -#endif -{ -#ifdef NO_ONEXIT - f_exit(); -#endif - exit(*rc); - } -#ifdef __cplusplus -} -#endif diff --git a/ext/spice/src/cspice/expln.c b/ext/spice/src/cspice/expln.c deleted file mode 100644 index 561a3dbef1..0000000000 --- a/ext/spice/src/cspice/expln.c +++ /dev/null @@ -1,332 +0,0 @@ -/* expln.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EXPLN ( Get Explanation for Short Error Message ) */ -/* Subroutine */ int expln_(char *msg, char *expl, ftnlen msg_len, ftnlen - expl_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Return the explanation of a short error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MSG I A short error message. */ -/* EXPL O The explanation of the short error message. */ - -/* $ Detailed_Input */ - -/* MSG A ``short'' error message. */ -/* MSG indicates the type of error that has occurred. */ - -/* The exact format that MSG must follow is */ -/* described in the required reading file, ERROR.REQ. */ - -/* $ Detailed_Output */ - -/* EXPL is a character string containing an one-line */ -/* explanation of the short error message, MSG. */ - -/* If there is no explanatory text corresponding */ -/* to the input string, MSG, EXPL is blank. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the interface to the */ -/* SPICELIB error handling mechanism. For this reason, */ -/* this routine does not participate in the trace scheme, */ -/* even though it has external references. */ - - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - - -/* C */ -/* C We want to find the explanation corresponding to */ -/* C the short message, 'SPICE(ZERORADIUS)' : */ -/* C */ - -/* CALL EXPLN ( 'SPICE(ZERORADIUS)', EXPL ) */ - - -/* Now, EXPL = */ - -/* 'Invalid Radius--Equatorial or Polar Radius is Zero' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get explanation for short error message */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 27-OCT-1988 (NJB) */ - -/* Removed code used to create upper case, left-justified */ -/* copy of the short error message. The resulting message */ -/* was not used. */ - -/* -& */ - -/* Executable Code: */ - - -/* Note: the short error messages should be ordered */ -/* alphabetically. */ - - if (s_cmp(msg, "SPICE(BADENDPOINTS)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "Invalid Endpoints--Left Endpoint Exceeds Right Endpoint" - , expl_len, (ftnlen)55); - } else if (s_cmp(msg, "SPICE(BADGEFVERSION)", msg_len, (ftnlen)20) == 0) { - s_copy(expl, "Version Identification of GEF File is Invalid", - expl_len, (ftnlen)45); - } else if (s_cmp(msg, "SPICE(BLANKMODULENAME)", msg_len, (ftnlen)22) == 0) - { - s_copy(expl, "A blank string was used as a module name", expl_len, ( - ftnlen)40); - } else if (s_cmp(msg, "SPICE(BOGUSENTRY)", msg_len, (ftnlen)17) == 0) { - s_copy(expl, "This Entry Point Contains No Executable Code", expl_len, - (ftnlen)44); - } else if (s_cmp(msg, "SPICE(CELLTOOSMALL)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "Cardinality of Output Cell is Too Small", expl_len, ( - ftnlen)39); - } else if (s_cmp(msg, "SPICE(CLUSTERWRITEERROR)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "Error Writing to Ephemeris File", expl_len, (ftnlen)31); - } else if (s_cmp(msg, "SPICE(DATATYPENOTRECOG)", msg_len, (ftnlen)23) == - 0) { - s_copy(expl, "Unrecognized Data Type Specification was Encountered", - expl_len, (ftnlen)52); - } else if (s_cmp(msg, "SPICE(DATEEXPECTED)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "The Value in the Kernel File was Expected to be a date." - , expl_len, (ftnlen)55); - } else if (s_cmp(msg, "SPICE(DEVICENAMETOOLONG)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "Name of Device Exceeds 128-Character Limit", expl_len, ( - ftnlen)42); - } else if (s_cmp(msg, "SPICE(EMBEDDEDBLANK)", msg_len, (ftnlen)20) == 0) { - s_copy(expl, "Invalid embedded blank was found in character string", - expl_len, (ftnlen)52); - } else if (s_cmp(msg, "SPICE(FILEALREADYOPEN)", msg_len, (ftnlen)22) == 0) - { - s_copy(expl, "File Open Failed Because the File was Already Open", - expl_len, (ftnlen)50); - } else if (s_cmp(msg, "SPICE(FILEOPENFAILED)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "An Attempt to Open a File Failed", expl_len, (ftnlen)32) - ; - } else if (s_cmp(msg, "SPICE(FILEREADFAILED)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "An Attempt to Read a File Failed", expl_len, (ftnlen)32) - ; - } else if (s_cmp(msg, "SPICE(FILEWRITEFAILED)", msg_len, (ftnlen)22) == 0) - { - s_copy(expl, "An Attempt to Write a File Failed", expl_len, (ftnlen) - 33); - } else if (s_cmp(msg, "SPICE(INCOMPATIBLEUNITS)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "The Input and Output Units are Incompatible", expl_len, - (ftnlen)43); - } else if (s_cmp(msg, "SPICE(INVALIDACTION)", msg_len, (ftnlen)20) == 0) { - s_copy(expl, "An Invalid Action Value Was Supplied", expl_len, ( - ftnlen)36); - } else if (s_cmp(msg, "SPICE(INVALIDARGUMENT)", msg_len, (ftnlen)22) == 0) - { - s_copy(expl, "An Invalid Function Argument was Supplied", expl_len, ( - ftnlen)41); - } else if (s_cmp(msg, "SPICE(INVALIDCHECKOUT)", msg_len, (ftnlen)22) == 0) - { - s_copy(expl, "Checkout Was Attempted When No Routines Were Checked In" - , expl_len, (ftnlen)55); - } else if (s_cmp(msg, "SPICE(INVALIDCLUSTERNUM)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "Invalid Cluster Number -- Cluster Numbers Must Exceed " - "1 ", expl_len, (ftnlen)56); - } else if (s_cmp(msg, "SPICE(INVALIDEPOCH)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "An Invalid Epoch Type Specification Was Supplied", - expl_len, (ftnlen)48); - } else if (s_cmp(msg, "SPICE(INVALIDINDEX)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "There Is No Element Corresponding to the Supplied Index" - , expl_len, (ftnlen)55); - } else if (s_cmp(msg, "SPICE(INVALIDTIMESTRING)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "Time String Could Not Be Parsed", expl_len, (ftnlen)31); - } else if (s_cmp(msg, "SPICE(INVALIDLISTITEM)", msg_len, (ftnlen)22) == 0) - { - s_copy(expl, "An Invalid Item Was Found in a List", expl_len, (ftnlen) - 35); - } else if (s_cmp(msg, "SPICE(INVALIDMSGTYPE)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "An Invalid Error Message Type Was Specified", expl_len, - (ftnlen)43); - } else if (s_cmp(msg, "SPICE(INVALIDOPERATION)", msg_len, (ftnlen)23) == - 0) { - s_copy(expl, "An Invalid Operation Value Was Supplied", expl_len, ( - ftnlen)39); - } else if (s_cmp(msg, "SPICE(INVALIDOPTION)", msg_len, (ftnlen)20) == 0) { - s_copy(expl, "An Invalid Option Value Was Supplied", expl_len, ( - ftnlen)36); - } else if (s_cmp(msg, "SPICE(INVALIDTIMEFORMAT)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "Specification of Time String Format Was Not Recognized", - expl_len, (ftnlen)54); - } else if (s_cmp(msg, "SPICE(KERNELVARNOTFOUND)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "The Variable Was not Found in the Kernel Pool.", - expl_len, (ftnlen)46); - } else if (s_cmp(msg, "SPICE(NAMETABLEFULL)", msg_len, (ftnlen)20) == 0) { - s_copy(expl, "No Further Symbols Can be Inserted; the Name Table is " - "Full", expl_len, (ftnlen)58); - } else if (s_cmp(msg, "SPICE(NOFREELOGICALUNIT)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "No More Logical Units are Available for Allocation", - expl_len, (ftnlen)50); - } else if (s_cmp(msg, "SPICE(NOINTERVAL)", msg_len, (ftnlen)17) == 0) { - s_copy(expl, "Window Does Not Contain Interval Corresponding to the " - "Supplied Index", expl_len, (ftnlen)68); - } else if (s_cmp(msg, "SPICE(NOSEGMENT)", msg_len, (ftnlen)16) == 0) { - s_copy(expl, "No Applicable Segment Found in Ephemeris File", - expl_len, (ftnlen)45); - } else if (s_cmp(msg, "SPICE(NOSUCHSYMBOL)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "The Symbol Does Not Exist in the Symbol Table", - expl_len, (ftnlen)45); - } else if (s_cmp(msg, "SPICE(NOTDISTINCT)", msg_len, (ftnlen)18) == 0) { - s_copy(expl, "The Elements Must Be Distinct", expl_len, (ftnlen)29); - } else if (s_cmp(msg, "SPICE(NUMBEREXPECTED)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "The Value in the Kernel File was Expected to be a Numb" - "er.", expl_len, (ftnlen)57); - } else if (s_cmp(msg, "SPICE(POINTERTABLEFULL)", msg_len, (ftnlen)23) == - 0) { - s_copy(expl, "No Further Symbols Can be Inserted; the Pointer Table " - "is Full", expl_len, (ftnlen)61); - } else if (s_cmp(msg, "SPICE(REFNOTREC)", msg_len, (ftnlen)16) == 0) { - s_copy(expl, "A Reference Frame Specification was Not Recognized", - expl_len, (ftnlen)50); - } else if (s_cmp(msg, "SPICE(SETEXCESS)", msg_len, (ftnlen)16) == 0) { - s_copy(expl, "Cardinality of Set Is Too Small to Contain Result of t" - "he Requested Operation", expl_len, (ftnlen)76); - } else if (s_cmp(msg, "SPICE(TOOMANYFILESOPEN)", msg_len, (ftnlen)23) == - 0) { - s_copy(expl, "The SPICELIB Limit for Number of Open Files Has Alread" - "y Been Reached", expl_len, (ftnlen)68); - } else if (s_cmp(msg, "SPICE(TRACEBACKOVERFLOW)", msg_len, (ftnlen)24) == - 0) { - s_copy(expl, "No More Entries Can Be Added to the Traceback Represen" - "tation", expl_len, (ftnlen)60); - } else if (s_cmp(msg, "SPICE(UNITSNOTREC)", msg_len, (ftnlen)18) == 0) { - s_copy(expl, "The Input or Output Units Were Not Recognized", - expl_len, (ftnlen)45); - } else if (s_cmp(msg, "SPICE(UNMATCHENDPTS)", msg_len, (ftnlen)20) == 0) { - s_copy(expl, "Window Does Not Have an Even Number of Endpoints", - expl_len, (ftnlen)48); - } else if (s_cmp(msg, "SPICE(VALUETABLEFULL)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "No Further Symbols Can be Inserted; the Value Table is" - " Full", expl_len, (ftnlen)59); - } else if (s_cmp(msg, "SPICE(WINDOWEXCESS)", msg_len, (ftnlen)19) == 0) { - s_copy(expl, "Cardinality of Window Is Too Small to Contain Result o" - "f the Requested Operation", expl_len, (ftnlen)79); - } else if (s_cmp(msg, "SPICE(WINDOWTOOSMALL)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "Cardinality of Output Window is Too Small", expl_len, ( - ftnlen)41); - } else if (s_cmp(msg, "SPICE(WRITEERROR)", msg_len, (ftnlen)17) == 0) { - s_copy(expl, "An Attempt to write to a specified unit failed.", - expl_len, (ftnlen)47); - } else if (s_cmp(msg, "SPICE(ZERORADIUS)", msg_len, (ftnlen)17) == 0) { - s_copy(expl, "Invalid Radius--Equatorial or Polar Radius is Zero", - expl_len, (ftnlen)50); - } else if (s_cmp(msg, "SPICE(ZEROVECTOR)", msg_len, (ftnlen)17) == 0) { - s_copy(expl, "Input Vector is the Zero Vector", expl_len, (ftnlen)31); - } else if (s_cmp(msg, "SPICE(ZEROAXISLENGTH)", msg_len, (ftnlen)21) == 0) - { - s_copy(expl, "Input Axis Length is Zero", expl_len, (ftnlen)25); - } else { - s_copy(expl, " ", expl_len, (ftnlen)1); - } - return 0; -} /* expln_ */ - diff --git a/ext/spice/src/cspice/expool_c.c b/ext/spice/src/cspice/expool_c.c deleted file mode 100644 index 24706a7622..0000000000 --- a/ext/spice/src/cspice/expool_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure expool_c ( Confirm the existence of a pool kernel variable ) - --Abstract - - Confirm the existence of a kernel variable in the kernel - pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void expool_c ( ConstSpiceChar * name, - SpiceBoolean * found ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the variable whose value is to be returned. - found O True when the variable is in the pool. - --Detailed_Input - - name is the name of the variable whose values are to be - returned. - --Detailed_Output - - found is true whenever the specified variable is included - in the pool. - --Parameters - - None. - --Exceptions - - 1) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 2) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled - --Files - - None. - --Particulars - - This routine determines whether or not a numeric kernel pool - variable exists. It does not detect the existence of - string valued kernel pool variables. - - A better routine for determining the existence of kernel pool - variables is dtpool_ which determines the - existence, size and type of kernel pool variables. - --Examples - - - expool_c ( "BODY399_RADII", &found ); - - if ( found ) - { - printf( "BODY399_RADII is present in the kernel pool\n"); - } - - - See bodfnd_c. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.2.0 22-JUN-1999 (EDW) - - Added local variable to return boolean/logical values. This - fix allows the routine to function if int and long are different - sizes. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - CONFIRM the existence of a pooled kernel variable - --& -*/ - -{ /* Begin expool_c */ - - /* - Local variables. - */ - logical yes; - - - /* - Participate in error tracing. - */ - chkin_c ( "expool_c" ); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "expool_c", name ); - - - /* - Call the f2c'd routine. - */ - expool_( ( char * ) name, - ( logical * ) &yes, - ( ftnlen ) strlen(name) ); - - - /* Cast back to a SpiceBoolean. */ - *found = yes; - - - /* Done. Checkout. */ - chkout_c ( "expool_c" ); - - -} /* End expool_c */ diff --git a/ext/spice/src/cspice/f2c.h b/ext/spice/src/cspice/f2c.h deleted file mode 100644 index 079fdaf490..0000000000 --- a/ext/spice/src/cspice/f2c.h +++ /dev/null @@ -1,654 +0,0 @@ -/* - --Header_File f2c.h ( CSPICE version of the f2c standard header file ) - --Abstract - - Perform standard f2c declarations, customized for the host - environment. - --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. - --Particulars - - The standard f2c header file f2c.h must be included by every function - generated by running f2c on Fortran source code. The header f2c.h - includes typedefs used to provide a level of indirection in mapping - Fortran data types to native C data types. For example, Fortran - INTEGER variables are mapped to variables of type integer, where - integer is a C typedef. In the standard f2c.h header, the typedef - integer translates to the C type long. - - Because the standard version of f2c.h does not work on all platforms, - this header file contains two platform-dependent versions of it, - meant to be selected at build time via precompiler switches. The - precompiler switches reference macros defined in SpiceZpl.h to - determine for which host platform the code is targeted. The first - version of f2c.h, which works on most platforms, is copied directly - from the standard version of f2c.h. The second version is intended - for use on the DEC Alpha running Digital Unix and the Sun/Solaris - platform using 64 bit mode and running gcc. On those systems, longs - occupy 8 bytes, as do doubles. Because the Fortran standard requires - that INTEGERS occupy half the storage of DOUBLE PRECISION numbers, - INTEGERS should be mapped to 4-byte ints rather than 8-byte longs - on the platforms having 8-byte longs. In order to achieve this, the - header f2c.h was transformed using the sed command - - sed 's/long //' f2c.h - - The high-level structure of this file is then: - - # if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) ) - - - [ Alpha/Digital Unix and Sun Solaris 64 bit mode/gcc - version of f2c.h source code ] - - # else - - [ Standard version of f2c.h source code ] - - # endif - - --Restrictions - - 1) This header file must be updated whenever the f2c processor - or the f2c libraries libI77 and libF77 are updated. - - 2) This header may need to be updated to support new platforms. - The supported platforms at the time of the 31-JAN-1999 release - are: - - ALPHA-DIGITAL-UNIX - HP - NEXT - PC-LINUX - PC-MS - SGI-IRIX-N32 - SGI-IRIX-NO2 - SUN-SOLARIS - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 4.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 4.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 3.0.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - - Updated to support linking CSPICE into executables that - also link in objects compiled from Fortran, in particular - ones that perform Fortran I/O. To enable this odd mix, - one defines the preprocessor flag - - MIX_C_AND_FORTRAN - - This macro is undefined by default, since the action it invokes - is usually not desirable. See the header - - f2cMang.h - - for further information. - - -CSPICE Version 1.0.0, 07-FEB-1999 (NJB) - -*/ - - - /* - Optionally include name-mangling macros for f2c external symbols. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - - - /* - Include CSPICE platform macro definitions. - */ - #include "SpiceZpl.h" - - -#if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - - /* - MODIFICATION - - The following code is intended to be used on the platforms where - a long is the size of a double and an int is half the - size of a double. - - Note that the comment line below indicating that the header is - "Standard" has been retained from the original, but is no longer - true. - */ - - - - - -/* f2c.h -- Standard Fortran to C header file */ - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef int integer; -typedef unsigned uinteger; -typedef char *address; -typedef short int shortint; -typedef float real; -typedef double doublereal; -typedef struct { real r, i; } complex; -typedef struct { doublereal r, i; } doublecomplex; -typedef int logical; -typedef short int shortlogical; -typedef char logical1; -typedef char integer1; -#if 0 /* Adjust for integer*8. */ -typedef long longint; /* system-dependent */ -typedef unsigned long ulongint; /* system-dependent */ -#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) -#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) -#endif - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef int flag; -typedef int ftnlen; -typedef int ftnint; -#endif - -/*external read, write*/ -typedef struct -{ flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} cilist; - -/*internal read, write*/ -typedef struct -{ flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} icilist; - -/*open*/ -typedef struct -{ flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} olist; - -/*close*/ -typedef struct -{ flag cerr; - ftnint cunit; - char *csta; -} cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ flag aerr; - ftnint aunit; -} alist; - -/* inquire */ -typedef struct -{ flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - integer1 g; - shortint h; - integer i; - /* longint j; */ - real r; - doublereal d; - complex c; - doublecomplex z; - }; - -typedef union Multitype Multitype; - -/*typedef int Long;*/ /* No longer used; formerly in Namelist */ - -struct Vardesc { /* for Namelist */ - char *name; - char *addr; - ftnlen *dims; - int type; - }; -typedef struct Vardesc Vardesc; - -struct Namelist { - char *name; - Vardesc **vars; - int nvars; - }; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) -#define bit_test(a,b) ((a) >> (b) & 1) -#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) -#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint (*J_fp)(...); -typedef integer (*I_fp)(...); -typedef real (*R_fp)(...); -typedef doublereal (*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID (*C_fp)(...); -typedef /* Double Complex */ VOID (*Z_fp)(...); -typedef logical (*L_fp)(...); -typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); -typedef /* Subroutine */ int (*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint (*J_fp)(); -typedef integer (*I_fp)(); -typedef real (*R_fp)(); -typedef doublereal (*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID (*C_fp)(); -typedef /* Double Complex */ VOID (*Z_fp)(); -typedef logical (*L_fp)(); -typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_fp)(); -typedef /* Subroutine */ int (*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - /* - This marks the end of the MODIFICATION section version of f2c.h. - */ - -#else - - /* - The following code is the standard f2c.h header. In this - header, an "integer" is defined to be of type long. - - Because the code is copied verbatim, it does not follow the usual - CSPICE indentation pattern. - */ - - -/* f2c.h -- Standard Fortran to C header file */ - - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef long int integer; -typedef unsigned long uinteger; -typedef char *address; -typedef short int shortint; -typedef float real; -typedef double doublereal; -typedef struct { real r, i; } complex; -typedef struct { doublereal r, i; } doublecomplex; -typedef long int logical; -typedef short int shortlogical; -typedef char logical1; -typedef char integer1; -#if 0 /* Adjust for integer*8. */ -typedef long long longint; /* system-dependent */ -typedef unsigned long long ulongint; /* system-dependent */ -#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) -#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) -#endif - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef long int flag; -typedef long int ftnlen; -typedef long int ftnint; -#endif - -/*external read, write*/ -typedef struct -{ flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} cilist; - -/*internal read, write*/ -typedef struct -{ flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} icilist; - -/*open*/ -typedef struct -{ flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} olist; - -/*close*/ -typedef struct -{ flag cerr; - ftnint cunit; - char *csta; -} cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ flag aerr; - ftnint aunit; -} alist; - -/* inquire */ -typedef struct -{ flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - integer1 g; - shortint h; - integer i; - /* longint j; */ - real r; - doublereal d; - complex c; - doublecomplex z; - }; - -typedef union Multitype Multitype; - -/*typedef long int Long;*/ /* No longer used; formerly in Namelist */ - -struct Vardesc { /* for Namelist */ - char *name; - char *addr; - ftnlen *dims; - int type; - }; -typedef struct Vardesc Vardesc; - -struct Namelist { - char *name; - Vardesc **vars; - int nvars; - }; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) -#define bit_test(a,b) ((a) >> (b) & 1) -#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) -#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint (*J_fp)(...); -typedef integer (*I_fp)(...); -typedef real (*R_fp)(...); -typedef doublereal (*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID (*C_fp)(...); -typedef /* Double Complex */ VOID (*Z_fp)(...); -typedef logical (*L_fp)(...); -typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); -typedef /* Subroutine */ int (*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint (*J_fp)(); -typedef integer (*I_fp)(); -typedef real (*R_fp)(); -typedef doublereal (*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID (*C_fp)(); -typedef /* Double Complex */ VOID (*Z_fp)(); -typedef logical (*L_fp)(); -typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_fp)(); -typedef /* Subroutine */ int (*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - #endif - diff --git a/ext/spice/src/cspice/f2cMang.h b/ext/spice/src/cspice/f2cMang.h deleted file mode 100644 index f18fded688..0000000000 --- a/ext/spice/src/cspice/f2cMang.h +++ /dev/null @@ -1,390 +0,0 @@ -/* - --Header_File f2cMang.h ( f2c external symbol mangling ) - --Abstract - - Define macros that mangle the external symbols in the f2c F77 and I77 - libraries. - --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. - --Particulars - - This header supports linking CSPICE into executables that - also link in objects compiled from Fortran, in particular - ones that perform Fortran I/O. To enable this odd mix, - one defines the preprocessor flag - - MIX_C_AND_FORTRAN - - This macro is undefined by default, since the action it invokes - is usually not desirable. When the flag is defined, this header - defines macros that mangle the f2c library external symbols: - the symbol - - xxx - - gets mapped to - - xxx_f2c - - This mangling prevents name collisions between the f2c - implementations of the F77 and I77 library routines and those - in the corresponding Fortran libraries on a host system. - - The set of external symbols defined in the f2c libraries can - be determined by combining objects from both F77 and I77 into - a single Unix archive libarary, then running the Unix utility - nm on the that archive. If available, an nm option that selects - only external symbols should be invoked. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - 1) It is recommended that use of the features implemented by this - header be avoided if at all possible. There are robustness and - portability problems associated with linking Fortran and C objects - together in one executable. - - 2) When f2c external symbol name mangling is invoked, objects - derived from C code translated from Fortran by f2c won't - link against CSPICE any longer, if these objects reference - the standard f2c external symbols. - - 3) The features implemented by this header have been tested only - under the Sun Solaris GCC, Sun Solaris native ANSI C, and - PC/Linux/gcc environments. - --Version - - -CSPICE Version 2.0.1, 07-MAR-2009 (NJB) - - Restrictions header section was updated to note successful - testing on the PC/Linux/gcc platform. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - -*/ - - - /* - Define masking macros for f2c external symbols. - */ - #ifdef MIX_C_AND_FORTRAN - - /* - Define the macros only once, if they need to be defined. - */ - #ifndef F2C_MANGLING_DONE - - #define F77_aloc F77_aloc_f2c - #define F_err F_err_f2c - #define L_len L_len_f2c - #define abort_ abort__f2c - #define b_char b_char_f2c - #define c_abs c_abs_f2c - #define c_cos c_cos_f2c - #define c_dfe c_dfe_f2c - #define c_div c_div_f2c - #define c_due c_due_f2c - #define c_exp c_exp_f2c - #define c_le c_le_f2c - #define c_log c_log_f2c - #define c_sfe c_sfe_f2c - #define c_si c_si_f2c - #define c_sin c_sin_f2c - #define c_sqrt c_sqrt_f2c - #define c_sue c_sue_f2c - #define d_abs d_abs_f2c - #define d_acos d_acos_f2c - #define d_asin d_asin_f2c - #define d_atan d_atan_f2c - #define d_atn2 d_atn2_f2c - #define d_cnjg d_cnjg_f2c - #define d_cos d_cos_f2c - #define d_cosh d_cosh_f2c - #define d_dim d_dim_f2c - #define d_exp d_exp_f2c - #define d_imag d_imag_f2c - #define d_int d_int_f2c - #define d_lg10 d_lg10_f2c - #define d_log d_log_f2c - #define d_mod d_mod_f2c - #define d_nint d_nint_f2c - #define d_prod d_prod_f2c - #define d_sign d_sign_f2c - #define d_sin d_sin_f2c - #define d_sinh d_sinh_f2c - #define d_sqrt d_sqrt_f2c - #define d_tan d_tan_f2c - #define d_tanh d_tanh_f2c - #define derf_ derf__f2c - #define derfc_ derfc__f2c - #define do_fio do_fio_f2c - #define do_lio do_lio_f2c - #define do_ud do_ud_f2c - #define do_uio do_uio_f2c - #define do_us do_us_f2c - #define dtime_ dtime__f2c - #define e_rdfe e_rdfe_f2c - #define e_rdue e_rdue_f2c - #define e_rsfe e_rsfe_f2c - #define e_rsfi e_rsfi_f2c - #define e_rsle e_rsle_f2c - #define e_rsli e_rsli_f2c - #define e_rsue e_rsue_f2c - #define e_wdfe e_wdfe_f2c - #define e_wdue e_wdue_f2c - #define e_wsfe e_wsfe_f2c - #define e_wsfi e_wsfi_f2c - #define e_wsle e_wsle_f2c - #define e_wsli e_wsli_f2c - #define e_wsue e_wsue_f2c - #define ef1asc_ ef1asc__f2c - #define ef1cmc_ ef1cmc__f2c - #define en_fio en_fio_f2c - #define erf_ erf__f2c - #define erfc_ erfc__f2c - #define err__fl err__fl_f2c - #define etime_ etime__f2c - #define exit_ exit__f2c - #define f__Aquote f__Aquote_f2c - #define f__buflen f__buflen_f2c - #define f__cabs f__cabs_f2c - #define f__canseek f__canseek_f2c - #define f__cblank f__cblank_f2c - #define f__cf f__cf_f2c - #define f__cnt f__cnt_f2c - #define f__cp f__cp_f2c - #define f__cplus f__cplus_f2c - #define f__cursor f__cursor_f2c - #define f__curunit f__curunit_f2c - #define f__doed f__doed_f2c - #define f__doend f__doend_f2c - #define f__doned f__doned_f2c - #define f__donewrec f__donewrec_f2c - #define f__dorevert f__dorevert_f2c - #define f__elist f__elist_f2c - #define f__external f__external_f2c - #define f__fatal f__fatal_f2c - #define f__fmtbuf f__fmtbuf_f2c - #define f__formatted f__formatted_f2c - #define f__getn f__getn_f2c - #define f__hiwater f__hiwater_f2c - #define f__icend f__icend_f2c - #define f__icnum f__icnum_f2c - #define f__icptr f__icptr_f2c - #define f__icvt f__icvt_f2c - #define f__init f__init_f2c - #define f__inode f__inode_f2c - #define f__lchar f__lchar_f2c - #define f__lcount f__lcount_f2c - #define f__lioproc f__lioproc_f2c - #define f__lquit f__lquit_f2c - #define f__ltab f__ltab_f2c - #define f__ltype f__ltype_f2c - #define f__lx f__lx_f2c - #define f__ly f__ly_f2c - #define f__nonl f__nonl_f2c - #define f__nowreading f__nowreading_f2c - #define f__nowwriting f__nowwriting_f2c - #define f__parenlvl f__parenlvl_f2c - #define f__pc f__pc_f2c - #define f__putbuf f__putbuf_f2c - #define f__putn f__putn_f2c - #define f__r_mode f__r_mode_f2c - #define f__reading f__reading_f2c - #define f__reclen f__reclen_f2c - #define f__recloc f__recloc_f2c - #define f__recpos f__recpos_f2c - #define f__ret f__ret_f2c - #define f__revloc f__revloc_f2c - #define f__rp f__rp_f2c - #define f__scale f__scale_f2c - #define f__sequential f__sequential_f2c - #define f__svic f__svic_f2c - #define f__typesize f__typesize_f2c - #define f__units f__units_f2c - #define f__w_mode f__w_mode_f2c - #define f__workdone f__workdone_f2c - #define f_back f_back_f2c - #define f_clos f_clos_f2c - #define f_end f_end_f2c - #define f_exit f_exit_f2c - #define f_init f_init_f2c - #define f_inqu f_inqu_f2c - #define f_open f_open_f2c - #define f_rew f_rew_f2c - #define fk_open fk_open_f2c - #define flush_ flush__f2c - #define fmt_bg fmt_bg_f2c - #define fseek_ fseek__f2c - #define ftell_ ftell__f2c - #define g_char g_char_f2c - #define getenv_ getenv__f2c - #define h_abs h_abs_f2c - #define h_dim h_dim_f2c - #define h_dnnt h_dnnt_f2c - #define h_indx h_indx_f2c - #define h_len h_len_f2c - #define h_mod h_mod_f2c - #define h_nint h_nint_f2c - #define h_sign h_sign_f2c - #define hl_ge hl_ge_f2c - #define hl_gt hl_gt_f2c - #define hl_le hl_le_f2c - #define hl_lt hl_lt_f2c - #define i_abs i_abs_f2c - #define i_dim i_dim_f2c - #define i_dnnt i_dnnt_f2c - #define i_indx i_indx_f2c - #define i_len i_len_f2c - #define i_mod i_mod_f2c - #define i_nint i_nint_f2c - #define i_sign i_sign_f2c - #define iw_rev iw_rev_f2c - #define l_eof l_eof_f2c - #define l_ge l_ge_f2c - #define l_getc l_getc_f2c - #define l_gt l_gt_f2c - #define l_le l_le_f2c - #define l_lt l_lt_f2c - #define l_read l_read_f2c - #define l_ungetc l_ungetc_f2c - #define l_write l_write_f2c - #define lbit_bits lbit_bits_f2c - #define lbit_cshift lbit_cshift_f2c - #define lbit_shift lbit_shift_f2c - #define mk_hashtab mk_hashtab_f2c - #define nml_read nml_read_f2c - #define pars_f pars_f_f2c - #define pow_ci pow_ci_f2c - #define pow_dd pow_dd_f2c - #define pow_di pow_di_f2c - #define pow_hh pow_hh_f2c - #define pow_ii pow_ii_f2c - #define pow_ri pow_ri_f2c - #define pow_zi pow_zi_f2c - #define pow_zz pow_zz_f2c - #define r_abs r_abs_f2c - #define r_acos r_acos_f2c - #define r_asin r_asin_f2c - #define r_atan r_atan_f2c - #define r_atn2 r_atn2_f2c - #define r_cnjg r_cnjg_f2c - #define r_cos r_cos_f2c - #define r_cosh r_cosh_f2c - #define r_dim r_dim_f2c - #define r_exp r_exp_f2c - #define r_imag r_imag_f2c - #define r_int r_int_f2c - #define r_lg10 r_lg10_f2c - #define r_log r_log_f2c - #define r_mod r_mod_f2c - #define r_nint r_nint_f2c - #define r_sign r_sign_f2c - #define r_sin r_sin_f2c - #define r_sinh r_sinh_f2c - #define r_sqrt r_sqrt_f2c - #define r_tan r_tan_f2c - #define r_tanh r_tanh_f2c - #define rd_ed rd_ed_f2c - #define rd_ned rd_ned_f2c - #define s_cat s_cat_f2c - #define s_cmp s_cmp_f2c - #define s_copy s_copy_f2c - #define s_paus s_paus_f2c - #define s_rdfe s_rdfe_f2c - #define s_rdue s_rdue_f2c - #define s_rnge s_rnge_f2c - #define s_rsfe s_rsfe_f2c - #define s_rsfi s_rsfi_f2c - #define s_rsle s_rsle_f2c - #define s_rsli s_rsli_f2c - #define s_rsne s_rsne_f2c - #define s_rsni s_rsni_f2c - #define s_rsue s_rsue_f2c - #define s_stop s_stop_f2c - #define s_wdfe s_wdfe_f2c - #define s_wdue s_wdue_f2c - #define s_wsfe s_wsfe_f2c - #define s_wsfi s_wsfi_f2c - #define s_wsle s_wsle_f2c - #define s_wsli s_wsli_f2c - #define s_wsne s_wsne_f2c - #define s_wsni s_wsni_f2c - #define s_wsue s_wsue_f2c - #define sig_die sig_die_f2c - #define signal_ signal__f2c - #define system_ system__f2c - #define t_getc t_getc_f2c - #define t_runc t_runc_f2c - #define w_ed w_ed_f2c - #define w_ned w_ned_f2c - #define wrt_E wrt_E_f2c - #define wrt_F wrt_F_f2c - #define wrt_L wrt_L_f2c - #define x_endp x_endp_f2c - #define x_getc x_getc_f2c - #define x_putc x_putc_f2c - #define x_rev x_rev_f2c - #define x_rsne x_rsne_f2c - #define x_wSL x_wSL_f2c - #define x_wsne x_wsne_f2c - #define xrd_SL xrd_SL_f2c - #define y_getc y_getc_f2c - #define y_rsk y_rsk_f2c - #define z_abs z_abs_f2c - #define z_cos z_cos_f2c - #define z_div z_div_f2c - #define z_exp z_exp_f2c - #define z_getc z_getc_f2c - #define z_log z_log_f2c - #define z_putc z_putc_f2c - #define z_rnew z_rnew_f2c - #define z_sin z_sin_f2c - #define z_sqrt z_sqrt_f2c - #define z_wnew z_wnew_f2c - - #define F2C_MANGLING_DONE - - #endif - - - #endif - diff --git a/ext/spice/src/cspice/failed_c.c b/ext/spice/src/cspice/failed_c.c deleted file mode 100644 index 117bf2a77b..0000000000 --- a/ext/spice/src/cspice/failed_c.c +++ /dev/null @@ -1,254 +0,0 @@ -/* - --Procedure failed_c ( Error Status Indicator ) - --Abstract - - True if an error condition has been signalled via sigerr_c. - failed_c is the CSPICE status indicator. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - SpiceBoolean failed_c () - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - The function takes the value SPICETRUE if an error condition - was detected; it is SPICEFALSE otherwise. - - --Detailed_Input - - None. - --Detailed_Output - - Please read the required reading file before reading this! - - The value taken by failed_c indicates status. - - The status value applies to the CSPICE routines, - and to any other routines which call the status-setting - routine, sigerr_c. - - When failed_c has the value, SPICETRUE, an error condition - exists. SPICEFALSE means "no error." - - More specifically, when failed_c has the value SPICETRUE, - some routine has indicated an error by calling the - CSPICE routine, sigerr_c. All CSPICE routines - which can detect errors do this. Non-CSPICE - routines may also reference sigerr_c if desired. - - When failed_c has the value SPICEFALSE, either no routine - has yet signalled an error via sigerr_c, or the status - has been reset using, what else, reset_c. - - failed_c is initialized to have the value, SPICEFALSE - This indicates a "no error" status. - - See "particulars" below for (slightly) more information. - --Parameters - - None. - --Exceptions - - None. - - However, this routine is part of the CSPICE error - handling mechanism. - --Files - - None. - --Particulars - - See the required reading file for details of error - processing. However, here are some notes: - - When any CSPICE routine detects an error, the - status is set to indicate an error condition via - a call to sigerr_c. After sigerr_c - returns, further calls to failed_c will return the - value, SPICETRUE, indicating an error condition. - - Non-CSPICE routines may also call sigerr_c to indicate - an error condition; failed_c will reflect such calls - as well. - - It is possible to re-set the error status to indicate - "no error" using the CSPICE routine, reset_c (see). - - The effect on failed_c of resetting the status is - that failed_c will again return the value SPICEFALSE, - indicating "no error." - - One of the main virtues of the CSPICE error - handling mechanism is that you don't HAVE to test the - error status after every call to a CSPICE routine. - If you set the error handling mode to "RETURN", using - the routine, erract_c, CSPICE routines won't crash - when an error occurs; following the detection of the - error, each routine will return immediately upon entry. - Therefore, you call several CSPICE routines in a - row, and just test status at the end of the sequence - of calls, if you wish. See "examples" below. - - --Examples - - 1. Here's an example of a simple call to rdtext_c, followed - by a test of the status. - - - /. - We read a line of text from file SPUD.DAT: - ./ - - rdtext_c ( "SPUD.DAT", line, LENOUT, &eof ); - - if ( failed_c() ) - { - - /. An error occurred during the read. ./ - - [respond to error here] - - } - - - 2. Here's an example in which we don't want to - put the error test inside our loop. We just - test the error status after the loop terminates. - We can do this because we (that is, you, the user) - have made the call, - - erract_c ( "RETURN", LENOUT, msg ); - - prior to execution of the following code. If an - error does occur, the remaining calls to rdtext_c - will have no effect. Here's the example: - - /. - We read the first 5000 lines of a file, or until - EOF is reached, whichever comes first: - ./ - - lcount = 0; - - do { - - rdtext_c ( "SPUD.DAT", line[lcount], LENOUT, &eof ); - - lcount++; - - } - while ( !( eof ) && ( lcount <= 5000 ) ); - - - if ( failed_c() ) - { - - /. An error occurred during the read. ./ - - [respond to error here] - - } - - - --Restrictions - - This routine automatically detects errors occurring in - the CSPICE code. To make this routine work for your own - routines, your routines must call sigerr_c to report errors. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Minor corrections to header information. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - error status indicator - --& -*/ - - - -{ /* Begin failed_c */ - - /* - Call the f2c'd Fortran routine and return the status. Not much else - to say. - */ - - if ( (SpiceBoolean) failed_() ) - { - return SPICETRUE; - } - else - { - return SPICEFALSE; - } - - -} /* End failed_c */ diff --git a/ext/spice/src/cspice/fetchc.c b/ext/spice/src/cspice/fetchc.c deleted file mode 100644 index 03ef003c17..0000000000 --- a/ext/spice/src/cspice/fetchc.c +++ /dev/null @@ -1,222 +0,0 @@ -/* fetchc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FETCHC ( Fetch from a character set ) */ -integer fetchc_(integer *nth, char *set, ftnlen set_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Returns the location within the set array of the NTH element */ -/* within the order imposed by the ASCII collating sequence. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NTH I Index of a particular element. */ -/* SET I Input set. */ - -/* The function returns the location of the NTH element in the set. */ - -/* $ Detailed_Input */ - -/* NTH is an index to an element of a set. If the set is to */ -/* be conceived as sorted in increasing order, then the */ -/* NTH element of a set is well defined. */ - -/* SET is a set. */ - - -/* $ Detailed_Output */ - -/* The function returns the location within the set array of the */ -/* NTH element within the order imposed by the ASCII collating */ -/* sequence. Thus, a set may be traversed in order: */ - -/* SET( FETCHC ( 1 ) ) */ -/* SET( FETCHC ( 2 ) ) */ -/* . */ -/* . */ -/* SET( FETCHC ( CARDC ( SET ) ) ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Within a set, the elements may be stored in arbitrary */ -/* order. The elements of a set may be retrieved by stepping */ -/* through the set array: */ - -/* SET( 1 ) */ -/* SET( 2 ) */ -/* . */ -/* . */ -/* SET( CARDC ( SET ) ) */ - -/* Likewise, the elements may be retreived in the order imposed by */ -/* the ASCII collating sequence, by using FETCHC: */ - -/* SET( FETCHC ( 1, SET ) ) */ -/* SET( FETCHC ( 2, SET ) ) */ -/* . */ -/* . */ -/* SET( FETCHC ( CARDC ( SET ), SET ) ) */ - -/* In general, FETCHC ( I, SET ) is not equal to I. */ - -/* $ Examples */ - -/* Let SET contain the following elements. */ - -/* 'Feynman' */ -/* 'Einstein' */ -/* 'Bohr' */ -/* 'Newton' */ - -/* Then the code fragment */ - -/* DO I = 1, CARDC ( SET ) */ -/* WRITE (*,*) SET(FETCHC(I,SET)) */ -/* END DO */ - -/* always produces the following output. */ - -/* Bohr */ -/* Einstein */ -/* Feynman */ -/* Newton */ - -/* The code fragment */ - -/* DO I = 1, CARDC ( SET ) */ -/* WRITE (*,*) SET(I) */ -/* END DO */ - -/* produces the same elements in unspecified order. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the element does not exist, the error SPICE(INVALIDINDEX) */ -/* is signalled, and the value of FETCHC is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch from a character set */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Set up the error processing. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("FETCHC", (ftnlen)6); - } - -/* Check to see if the N'TH element exists. */ - - if (*nth < 1 || *nth > cardc_(set, set_len)) { - ret_val = 0; - setmsg_("NTH element does not exist. NTH was *.", (ftnlen)38); - errint_("*", nth, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - -/* The great secret is that, for now, sets really are maintained */ -/* in order, for reasons of efficiency. */ - - } else { - ret_val = *nth; - } - chkout_("FETCHC", (ftnlen)6); - return ret_val; -} /* fetchc_ */ - diff --git a/ext/spice/src/cspice/fetchd.c b/ext/spice/src/cspice/fetchd.c deleted file mode 100644 index c2f6232fd3..0000000000 --- a/ext/spice/src/cspice/fetchd.c +++ /dev/null @@ -1,227 +0,0 @@ -/* fetchd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FETCHD ( Fetch from a DP set ) */ -integer fetchd_(integer *nth, doublereal *set) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the location within the set array of the NTH element */ -/* within the order imposed by the values of the elements. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NTH I Index of a particular element. */ -/* SET I Input set. */ - -/* The function returns the location of the NTH element in the set. */ - -/* $ Detailed_Input */ - -/* NTH is an index to an element of a set. If the set is to */ -/* be conceived as sorted in increasing order, then the */ -/* NTH element of a set is well defined. */ - -/* SET is a set. */ - - -/* $ Detailed_Output */ - -/* The function returns the location within the set array of the NTH */ -/* element within the order imposed by the values of the elements, */ - -/* ... -1.D0 < 0.D0 < 1.D0 < 2.D0 < 3.D0 ... */ - -/* Thus, a set may be traversed in order: */ - -/* SET( FETCHD ( 1 ) ) */ -/* SET( FETCHD ( 2 ) ) */ -/* . */ -/* . */ -/* SET( FETCHD ( CARDD ( SET ) ) ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Within a set, the elements may be stored in arbitrary order. */ -/* The elements of a set may be retrieved by stepping through the */ -/* set array: */ - -/* SET( 1 ) */ -/* SET( 2 ) */ -/* . */ -/* . */ -/* SET( CARDD ( SET ) ) */ - -/* Likewise, the elements may be retreived in the order imposed by */ -/* their values: */ - -/* SET( FETCHD ( 1, SET ) ) */ -/* SET( FETCHD ( 2, SET ) ) */ -/* . */ -/* . */ -/* SET( FETCHD ( CARDD ( SET ), SET ) ) */ - -/* In general, FETCHD ( I, SET ) is not equal to I. */ - -/* $ Examples */ - -/* Let SET contain the following elements. */ - -/* 8.D0 */ -/* 32.D0 */ -/* 2.D0 */ -/* 16.D0 */ -/* 4.D0 */ - -/* Then the code fragment */ - -/* DO I = 1, CARDD ( SET ) */ -/* WRITE (*,*) SET(FETCHD(I,SET)) */ -/* END DO */ - -/* always produces the following output. */ - -/* 2.D0 */ -/* 4.D0 */ -/* 8.D0 */ -/* 16.D0 */ -/* 32.D0 */ - -/* The code fragment */ - -/* DO I = 1, CARDD ( SET ) */ -/* WRITE (*,*) SET(I) */ -/* END DO */ - -/* produces the same elements in unspecified order. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the element does not exist, the error SPICE(INVALIDINDEX) */ -/* is signalled, and the value of FETCHD is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch from a d.p. set */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Set up the error processing. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("FETCHD", (ftnlen)6); - } - -/* Check to see if the N'TH element exists. */ - - if (*nth < 1 || *nth > cardd_(set)) { - ret_val = 0; - setmsg_("NTH element does not exist. NTH was *.", (ftnlen)38); - errint_("*", nth, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - -/* The great secret is that, for now, sets really are maintained */ -/* in order, for reasons of efficiency. */ - - } else { - ret_val = *nth; - } - chkout_("FETCHD", (ftnlen)6); - return ret_val; -} /* fetchd_ */ - diff --git a/ext/spice/src/cspice/fetchi.c b/ext/spice/src/cspice/fetchi.c deleted file mode 100644 index 482c5a16c1..0000000000 --- a/ext/spice/src/cspice/fetchi.c +++ /dev/null @@ -1,227 +0,0 @@ -/* fetchi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FETCHI ( Fetch from an integer set ) */ -integer fetchi_(integer *nth, integer *set) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the location within the set array of the NTH element */ -/* within the order imposed by the values of the elements. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NTH I Index of a particular element. */ -/* SET I Input set. */ - -/* The function returns the location of the NTH element in the set. */ - -/* $ Detailed_Input */ - -/* NTH is an index to an element of a set. If the set is to */ -/* be conceived as sorted in increasing order, then the */ -/* NTH element of a set is well defined. */ - -/* SET is a set. */ - - -/* $ Detailed_Output */ - -/* The function returns the location within the set array of the NTH */ -/* element within the order imposed by the values of the elements, */ - -/* ... -1 < 0 < 1 < 2 < 3 ... */ - -/* Thus, a set may be traversed in order: */ - -/* SET( FETCHI ( 1 ) ) */ -/* SET( FETCHI ( 2 ) ) */ -/* . */ -/* . */ -/* SET( FETCHI ( CARDI ( SET ) ) ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Within a set, the elements may be stored in arbitrary order. */ -/* The elements of a set may be retrieved by stepping through the */ -/* set array: */ - -/* SET( 1 ) */ -/* SET( 2 ) */ -/* . */ -/* . */ -/* SET( CARDI ( SET ) ) */ - -/* Likewise, the elements may be retreived in the order imposed by */ -/* their values: */ - -/* SET( FETCHI ( 1, SET ) ) */ -/* SET( FETCHI ( 2, SET ) ) */ -/* . */ -/* . */ -/* SET( FETCHI ( CARDI ( SET ), SET ) ) */ - -/* In general, FETCHI ( I, SET ) is not equal to I. */ - -/* $ Examples */ - -/* Let SET contain the following elements. */ - -/* 8 */ -/* 32 */ -/* 2 */ -/* 16 */ -/* 4 */ - -/* Then the code fragment */ - -/* DO I = 1, CARDI ( SET ) */ -/* WRITE (*,*) SET(FETCHI(I,SET)) */ -/* END DO */ - -/* always produces the following output. */ - -/* 2 */ -/* 4 */ -/* 8 */ -/* 16 */ -/* 32 */ - -/* The code fragment */ - -/* DO I = 1, CARDI ( SET ) */ -/* WRITE (*,*) SET(I) */ -/* END DO */ - -/* produces the same elements in unspecified order. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the element does not exist, the error SPICE(INVALIDINDEX) */ -/* is signalled, and the value of FETCHI is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch from an integer set */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Set up the error processing. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("FETCHI", (ftnlen)6); - } - -/* Check to see if the N'TH element exists. */ - - if (*nth < 1 || *nth > cardi_(set)) { - ret_val = 0; - setmsg_("NTH element does not exist. NTH was *.", (ftnlen)38); - errint_("*", nth, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - -/* The great secret is that, for now, sets really are maintained */ -/* in order, for reasons of efficiency. */ - - } else { - ret_val = *nth; - } - chkout_("FETCHI", (ftnlen)6); - return ret_val; -} /* fetchi_ */ - diff --git a/ext/spice/src/cspice/fillc.c b/ext/spice/src/cspice/fillc.c deleted file mode 100644 index 91d72404d1..0000000000 --- a/ext/spice/src/cspice/fillc.c +++ /dev/null @@ -1,145 +0,0 @@ -/* fillc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FILLC ( Fill a character array ) */ -/* Subroutine */ int fillc_(char *value, integer *ndim, char *array, ftnlen - value_len, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Fill a character string array with a specified 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* VALUE I Character string value to be placed in ARRAY. */ -/* NDIM I The number of elements in ARRAY. */ -/* ARRAY O Character string array which is to be filled. */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be assigned to the array elements */ -/* 1 through NDIM. */ - -/* NDIM is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* ARRAY is a character string array whose elements are to be */ -/* set to VALUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let VALUE = '*' */ -/* NDIM = 4 */ - -/* then the contents of ARRAY are: */ - -/* ARRAY (1) = '*' */ -/* ARRAY (2) = '*' */ -/* ARRAY (3) = '*' */ -/* ARRAY (4) = '*' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* fill a character array */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(array + (i__ - 1) * array_len, value, array_len, value_len); - } - return 0; -} /* fillc_ */ - diff --git a/ext/spice/src/cspice/filld.c b/ext/spice/src/cspice/filld.c deleted file mode 100644 index 39e9e819d9..0000000000 --- a/ext/spice/src/cspice/filld.c +++ /dev/null @@ -1,143 +0,0 @@ -/* filld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FILLD ( Fill a double precision array ) */ -/* Subroutine */ int filld_(doublereal *value, integer *ndim, doublereal * - array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Fill a double precision array with a specified value. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------------ */ -/* VALUE I Double precision value to be placed in all the */ -/* elements of ARRAY. */ -/* NDIM I The number of elements in ARRAY. */ -/* ARRAY O Double precision array which is to be filled. */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be assigned to the array elements */ -/* 1 through NDIM. */ - -/* NDIM is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* ARRAY is a double precision array whose elements are to be */ -/* set to VALUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let VALUE = 1.0D0 */ -/* NDIM = 4 */ - -/* then the contents of ARRAY are: */ - -/* ARRAY (1) = 1.0D0 */ -/* ARRAY (2) = 1.0D0 */ -/* ARRAY (3) = 1.0D0 */ -/* ARRAY (4) = 1.0D0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* fill a d.p. array */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - array[i__ - 1] = *value; - } - return 0; -} /* filld_ */ - diff --git a/ext/spice/src/cspice/filli.c b/ext/spice/src/cspice/filli.c deleted file mode 100644 index c91d5efa91..0000000000 --- a/ext/spice/src/cspice/filli.c +++ /dev/null @@ -1,142 +0,0 @@ -/* filli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FILLI ( Fill an integer array ) */ -/* Subroutine */ int filli_(integer *value, integer *ndim, integer *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Fill an integer array with a specified value. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------------ */ -/* VALUE I Integer value to be placed in all the elements of */ -/* ARRAY. */ -/* NDIM I The number of elements in ARRAY. */ -/* ARRAY O Integer array which is to be filled. */ - -/* $ Detailed_Input */ - -/* VALUE is the value to be assigned to the array elements */ -/* 1 through NDIM. */ - -/* NDIM is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* ARRAY is a integer array whose elements are to be set */ -/* to VALUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let VALUE = 1 */ -/* NDIM = 4 */ - -/* then the contents of ARRAY are: */ - -/* ARRAY (1) = 1 */ -/* ARRAY (2) = 1 */ -/* ARRAY (3) = 1 */ -/* ARRAY (4) = 1 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* fill an integer array */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - array[i__ - 1] = *value; - } - return 0; -} /* filli_ */ - diff --git a/ext/spice/src/cspice/fio.h b/ext/spice/src/cspice/fio.h deleted file mode 100644 index bb20dd2ca0..0000000000 --- a/ext/spice/src/cspice/fio.h +++ /dev/null @@ -1,107 +0,0 @@ -#include "stdio.h" -#include "errno.h" -#ifndef NULL -/* ANSI C */ -#include "stddef.h" -#endif - -#ifndef SEEK_SET -#define SEEK_SET 0 -#define SEEK_CUR 1 -#define SEEK_END 2 -#endif - -#ifdef MSDOS -#ifndef NON_UNIX_STDIO -#define NON_UNIX_STDIO -#endif -#endif - -#ifdef UIOLEN_int -typedef int uiolen; -#else -typedef long uiolen; -#endif - -/*units*/ -typedef struct -{ FILE *ufd; /*0=unconnected*/ - char *ufnm; -#ifndef MSDOS - long uinode; - int udev; -#endif - int url; /*0=sequential*/ - flag useek; /*true=can backspace, use dir, ...*/ - flag ufmt; - flag urw; /* (1 for can read) | (2 for can write) */ - flag ublnk; - flag uend; - flag uwrt; /*last io was write*/ - flag uscrtch; -} unit; - -extern flag f__init; -extern cilist *f__elist; /*active external io list*/ -extern flag f__reading,f__external,f__sequential,f__formatted; -#undef Void -#ifdef KR_headers -#define Void /*void*/ -extern int (*f__getn)(); /* for formatted input */ -extern void (*f__putn)(); /* for formatted output */ -extern void x_putc(); -extern long f__inode(); -extern VOID sig_die(); -extern int (*f__donewrec)(), t_putc(), x_wSL(); -extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf(); -#else -#define Void void -#ifdef __cplusplus -extern "C" { -#endif -extern int (*f__getn)(void); /* for formatted input */ -extern void (*f__putn)(int); /* for formatted output */ -extern void x_putc(int); -extern long f__inode(char*,int*); -extern void sig_die(char*,int); -extern void f__fatal(int,char*); -extern int t_runc(alist*); -extern int f__nowreading(unit*), f__nowwriting(unit*); -extern int fk_open(int,int,ftnint); -extern int en_fio(void); -extern void f_init(void); -extern int (*f__donewrec)(void), t_putc(int), x_wSL(void); -extern void b_char(char*,char*,ftnlen), g_char(char*,ftnlen,char*); -extern int c_sfe(cilist*), z_rnew(void); -extern int isatty(int); -extern int err__fl(int,int,char*); -extern int xrd_SL(void); -extern int f__putbuf(int); -#ifdef __cplusplus - } -#endif -#endif -extern int (*f__doend)(Void); -extern FILE *f__cf; /*current file*/ -extern unit *f__curunit; /*current unit*/ -extern unit f__units[]; -#define err(f,m,s) {if(f) errno= m; else f__fatal(m,s); return(m);} -#define errfl(f,m,s) return err__fl((int)f,m,s) - -/*Table sizes*/ -#define MXUNIT 100 - -extern int f__recpos; /*position in current record*/ -extern int f__cursor; /* offset to move to */ -extern int f__hiwater; /* so TL doesn't confuse us */ - -#define WRITE 1 -#define READ 2 -#define SEQ 3 -#define DIR 4 -#define FMT 5 -#define UNF 6 -#define EXT 7 -#define INT 8 - -#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ) diff --git a/ext/spice/src/cspice/fmt.c b/ext/spice/src/cspice/fmt.c deleted file mode 100644 index 364210c262..0000000000 --- a/ext/spice/src/cspice/fmt.c +++ /dev/null @@ -1,516 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" -#define skip(s) while(*s==' ') s++ -#ifdef interdata -#define SYLMX 300 -#endif -#ifdef pdp11 -#define SYLMX 300 -#endif -#ifdef vax -#define SYLMX 300 -#endif -#ifndef SYLMX -#define SYLMX 300 -#endif -#define GLITCH '\2' - /* special quote character for stu */ -extern int f__cursor,f__scale; -extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/ -static struct syl f__syl[SYLMX]; -int f__parenlvl,f__pc,f__revloc; - - static -#ifdef KR_headers -char *ap_end(s) char *s; -#else -char *ap_end(char *s) -#endif -{ char quote; - quote= *s++; - for(;*s;s++) - { if(*s!=quote) continue; - if(*++s!=quote) return(s); - } - if(f__elist->cierr) { - errno = 100; - return(NULL); - } - f__fatal(100, "bad string"); - /*NOTREACHED*/ return 0; -} - static -#ifdef KR_headers -op_gen(a,b,c,d) -#else -op_gen(int a, int b, int c, int d) -#endif -{ struct syl *p= &f__syl[f__pc]; - if(f__pc>=SYLMX) - { fprintf(stderr,"format too complicated:\n"); - sig_die(f__fmtbuf, 1); - } - p->op=a; - p->p1=b; - p->p2.i[0]=c; - p->p2.i[1]=d; - return(f__pc++); -} -#ifdef KR_headers -static char *f_list(); -static char *gt_num(s,n,n1) char *s; int *n, n1; -#else -static char *f_list(char*); -static char *gt_num(char *s, int *n, int n1) -#endif -{ int m=0,f__cnt=0; - char c; - for(c= *s;;c = *s) - { if(c==' ') - { s++; - continue; - } - if(c>'9' || c<'0') break; - m=10*m+c-'0'; - f__cnt++; - s++; - } - if(f__cnt==0) { - if (!n1) - s = 0; - *n=n1; - } - else *n=m; - return(s); -} - - static -#ifdef KR_headers -char *f_s(s,curloc) char *s; -#else -char *f_s(char *s, int curloc) -#endif -{ - skip(s); - if(*s++!='(') - { - return(NULL); - } - if(f__parenlvl++ ==1) f__revloc=curloc; - if(op_gen(RET1,curloc,0,0)<0 || - (s=f_list(s))==NULL) - { - return(NULL); - } - skip(s); - return(s); -} - - static -#ifdef KR_headers -ne_d(s,p) char *s,**p; -#else -ne_d(char *s, char **p) -#endif -{ int n,x,sign=0; - struct syl *sp; - switch(*s) - { - default: - return(0); - case ':': (void) op_gen(COLON,0,0,0); break; - case '$': - (void) op_gen(NONL, 0, 0, 0); break; - case 'B': - case 'b': - if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0); - else (void) op_gen(BN,0,0,0); - break; - case 'S': - case 's': - if(*(s+1)=='s' || *(s+1) == 'S') - { x=SS; - s++; - } - else if(*(s+1)=='p' || *(s+1) == 'P') - { x=SP; - s++; - } - else x=S; - (void) op_gen(x,0,0,0); - break; - case '/': (void) op_gen(SLASH,0,0,0); break; - case '-': sign=1; - case '+': s++; /*OUTRAGEOUS CODING TRICK*/ - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - if (!(s=gt_num(s,&n,0))) { - bad: *p = 0; - return 1; - } - switch(*s) - { - default: - return(0); - case 'P': - case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break; - case 'X': - case 'x': (void) op_gen(X,n,0,0); break; - case 'H': - case 'h': - sp = &f__syl[op_gen(H,n,0,0)]; - sp->p2.s = s + 1; - s+=n; - break; - } - break; - case GLITCH: - case '"': - case '\'': - sp = &f__syl[op_gen(APOS,0,0,0)]; - sp->p2.s = s; - if((*p = ap_end(s)) == NULL) - return(0); - return(1); - case 'T': - case 't': - if(*(s+1)=='l' || *(s+1) == 'L') - { x=TL; - s++; - } - else if(*(s+1)=='r'|| *(s+1) == 'R') - { x=TR; - s++; - } - else x=T; - if (!(s=gt_num(s+1,&n,0))) - goto bad; - s--; - (void) op_gen(x,n,0,0); - break; - case 'X': - case 'x': (void) op_gen(X,1,0,0); break; - case 'P': - case 'p': (void) op_gen(P,1,0,0); break; - } - s++; - *p=s; - return(1); -} - - static -#ifdef KR_headers -e_d(s,p) char *s,**p; -#else -e_d(char *s, char **p) -#endif -{ int i,im,n,w,d,e,found=0,x=0; - char *sv=s; - s=gt_num(s,&n,1); - (void) op_gen(STACK,n,0,0); - switch(*s++) - { - default: break; - case 'E': - case 'e': x=1; - case 'G': - case 'g': - found=1; - if (!(s=gt_num(s,&w,0))) { - bad: - *p = 0; - return 1; - } - if(w==0) break; - if(*s=='.') { - if (!(s=gt_num(s+1,&d,0))) - goto bad; - } - else d=0; - if(*s!='E' && *s != 'e') - (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */ - else { - if (!(s=gt_num(s+1,&e,0))) - goto bad; - (void) op_gen(x==1?EE:GE,w,d,e); - } - break; - case 'O': - case 'o': - i = O; - im = OM; - goto finish_I; - case 'Z': - case 'z': - i = Z; - im = ZM; - goto finish_I; - case 'L': - case 'l': - found=1; - if (!(s=gt_num(s,&w,0))) - goto bad; - if(w==0) break; - (void) op_gen(L,w,0,0); - break; - case 'A': - case 'a': - found=1; - skip(s); - if(*s>='0' && *s<='9') - { s=gt_num(s,&w,1); - if(w==0) break; - (void) op_gen(AW,w,0,0); - break; - } - (void) op_gen(A,0,0,0); - break; - case 'F': - case 'f': - if (!(s=gt_num(s,&w,0))) - goto bad; - found=1; - if(w==0) break; - if(*s=='.') { - if (!(s=gt_num(s+1,&d,0))) - goto bad; - } - else d=0; - (void) op_gen(F,w,d,0); - break; - case 'D': - case 'd': - found=1; - if (!(s=gt_num(s,&w,0))) - goto bad; - if(w==0) break; - if(*s=='.') { - if (!(s=gt_num(s+1,&d,0))) - goto bad; - } - else d=0; - (void) op_gen(D,w,d,0); - break; - case 'I': - case 'i': - i = I; - im = IM; - finish_I: - if (!(s=gt_num(s,&w,0))) - goto bad; - found=1; - if(w==0) break; - if(*s!='.') - { (void) op_gen(i,w,0,0); - break; - } - if (!(s=gt_num(s+1,&d,0))) - goto bad; - (void) op_gen(im,w,d,0); - break; - } - if(found==0) - { f__pc--; /*unSTACK*/ - *p=sv; - return(0); - } - *p=s; - return(1); -} - static -#ifdef KR_headers -char *i_tem(s) char *s; -#else -char *i_tem(char *s) -#endif -{ char *t; - int n,curloc; - if(*s==')') return(s); - if(ne_d(s,&t)) return(t); - if(e_d(s,&t)) return(t); - s=gt_num(s,&n,1); - if((curloc=op_gen(STACK,n,0,0))<0) return(NULL); - return(f_s(s,curloc)); -} - - static -#ifdef KR_headers -char *f_list(s) char *s; -#else -char *f_list(char *s) -#endif -{ - for(;*s!=0;) - { skip(s); - if((s=i_tem(s))==NULL) return(NULL); - skip(s); - if(*s==',') s++; - else if(*s==')') - { if(--f__parenlvl==0) - { - (void) op_gen(REVERT,f__revloc,0,0); - return(++s); - } - (void) op_gen(GOTO,0,0,0); - return(++s); - } - } - return(NULL); -} - -#ifdef KR_headers -pars_f(s) char *s; -#else -pars_f(char *s) -#endif -{ - f__parenlvl=f__revloc=f__pc=0; - if(f_s(s,0) == NULL) - { - return(-1); - } - return(0); -} -#define STKSZ 10 -int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp; -flag f__workdone, f__nonl; - - static -#ifdef KR_headers -type_f(n) -#else -type_f(int n) -#endif -{ - switch(n) - { - default: - return(n); - case RET1: - return(RET1); - case REVERT: return(REVERT); - case GOTO: return(GOTO); - case STACK: return(STACK); - case X: - case SLASH: - case APOS: case H: - case T: case TL: case TR: - return(NED); - case F: - case I: - case IM: - case A: case AW: - case O: case OM: - case L: - case E: case EE: case D: - case G: case GE: - case Z: case ZM: - return(ED); - } -} -#ifdef KR_headers -integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr; -#else -integer do_fio(ftnint *number, char *ptr, ftnlen len) -#endif -{ struct syl *p; - int n,i; - for(i=0;i<*number;i++,ptr+=len) - { -loop: switch(type_f((p= &f__syl[f__pc])->op)) - { - default: - fprintf(stderr,"unknown code in do_fio: %d\n%s\n", - p->op,f__fmtbuf); - err(f__elist->cierr,100,"do_fio"); - case NED: - if((*f__doned)(p)) - { f__pc++; - goto loop; - } - f__pc++; - continue; - case ED: - if(f__cnt[f__cp]<=0) - { f__cp--; - f__pc++; - goto loop; - } - if(ptr==NULL) - return((*f__doend)()); - f__cnt[f__cp]--; - f__workdone=1; - if((n=(*f__doed)(p,ptr,len))>0) - errfl(f__elist->cierr,errno,"fmt"); - if(n<0) - err(f__elist->ciend,(EOF),"fmt"); - continue; - case STACK: - f__cnt[++f__cp]=p->p1; - f__pc++; - goto loop; - case RET1: - f__ret[++f__rp]=p->p1; - f__pc++; - goto loop; - case GOTO: - if(--f__cnt[f__cp]<=0) - { f__cp--; - f__rp--; - f__pc++; - goto loop; - } - f__pc=1+f__ret[f__rp--]; - goto loop; - case REVERT: - f__rp=f__cp=0; - f__pc = p->p1; - if(ptr==NULL) - return((*f__doend)()); - if(!f__workdone) return(0); - if((n=(*f__dorevert)()) != 0) return(n); - goto loop; - case COLON: - if(ptr==NULL) - return((*f__doend)()); - f__pc++; - goto loop; - case NONL: - f__nonl = 1; - f__pc++; - goto loop; - case S: - case SS: - f__cplus=0; - f__pc++; - goto loop; - case SP: - f__cplus = 1; - f__pc++; - goto loop; - case P: f__scale=p->p1; - f__pc++; - goto loop; - case BN: - f__cblank=0; - f__pc++; - goto loop; - case BZ: - f__cblank=1; - f__pc++; - goto loop; - } - } - return(0); -} -en_fio(Void) -{ ftnint one=1; - return(do_fio(&one,(char *)NULL,(ftnint)0)); -} - VOID -fmt_bg(Void) -{ - f__workdone=f__cp=f__rp=f__pc=f__cursor=0; - f__cnt[0]=f__ret[0]=0; -} diff --git a/ext/spice/src/cspice/fmt.h b/ext/spice/src/cspice/fmt.h deleted file mode 100644 index 19065a2f04..0000000000 --- a/ext/spice/src/cspice/fmt.h +++ /dev/null @@ -1,100 +0,0 @@ -struct syl -{ int op; - int p1; - union { int i[2]; char *s;} p2; - }; -#define RET1 1 -#define REVERT 2 -#define GOTO 3 -#define X 4 -#define SLASH 5 -#define STACK 6 -#define I 7 -#define ED 8 -#define NED 9 -#define IM 10 -#define APOS 11 -#define H 12 -#define TL 13 -#define TR 14 -#define T 15 -#define COLON 16 -#define S 17 -#define SP 18 -#define SS 19 -#define P 20 -#define BN 21 -#define BZ 22 -#define F 23 -#define E 24 -#define EE 25 -#define D 26 -#define G 27 -#define GE 28 -#define L 29 -#define A 30 -#define AW 31 -#define O 32 -#define NONL 33 -#define OM 34 -#define Z 35 -#define ZM 36 -extern int f__pc,f__parenlvl,f__revloc; -typedef union -{ real pf; - doublereal pd; -} ufloat; -typedef union -{ short is; -#ifndef KR_headers - signed -#endif - char ic; - integer il; -#ifdef Allow_TYQUAD - longint ili; -#endif -} Uint; -#ifdef KR_headers -extern int (*f__doed)(),(*f__doned)(); -extern int (*f__dorevert)(); -extern int rd_ed(),rd_ned(); -extern int w_ed(),w_ned(); -#else -#ifdef __cplusplus -extern "C" { -#endif -extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); -extern int (*f__dorevert)(void); -extern void fmt_bg(void); -extern int pars_f(char*); -extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*); -extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*); -extern int wrt_E(ufloat*, int, int, int, ftnlen); -extern int wrt_F(ufloat*, int, int, ftnlen); -extern int wrt_L(Uint*, int, ftnlen); -#ifdef __cplusplus - } -#endif -#endif -extern flag f__cblank,f__cplus,f__workdone, f__nonl; -extern char *f__fmtbuf; -extern int f__scale; -#define GET(x) if((x=(*f__getn)())<0) return(x) -#define VAL(x) (x!='\n'?x:' ') -#define PUT(x) (*f__putn)(x) -extern int f__cursor; - -#undef TYQUAD -#ifndef Allow_TYQUAD -#undef longint -#define longint long -#else -#define TYQUAD 14 -#endif - -#ifdef KR_headers -extern char *f__icvt(); -#else -extern char *f__icvt(longint, int*, int*, int); -#endif diff --git a/ext/spice/src/cspice/fmtlib.c b/ext/spice/src/cspice/fmtlib.c deleted file mode 100644 index 91483fc529..0000000000 --- a/ext/spice/src/cspice/fmtlib.c +++ /dev/null @@ -1,45 +0,0 @@ -/* @(#)fmtlib.c 1.2 */ -#define MAXINTLENGTH 23 - -#include "f2c.h" -#ifndef Allow_TYQUAD -#undef longint -#define longint long -#undef ulongint -#define ulongint unsigned long -#endif - -#ifdef KR_headers -char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign; - register int base; -#else -char *f__icvt(longint value, int *ndigit, int *sign, int base) -#endif -{ - static char buf[MAXINTLENGTH+1]; - register int i; - ulongint uvalue; - - if(value > 0) { - uvalue = value; - *sign = 0; - } - else if (value < 0) { - uvalue = -value; - *sign = 1; - } - else { - *sign = 0; - *ndigit = 1; - buf[MAXINTLENGTH-1] = '0'; - return &buf[MAXINTLENGTH-1]; - } - i = MAXINTLENGTH; - do { - buf[--i] = (uvalue%base) + '0'; - uvalue /= base; - } - while(uvalue > 0); - *ndigit = MAXINTLENGTH - i; - return &buf[i]; - } diff --git a/ext/spice/src/cspice/fn2lun.c b/ext/spice/src/cspice/fn2lun.c deleted file mode 100644 index aaf66bd323..0000000000 --- a/ext/spice/src/cspice/fn2lun.c +++ /dev/null @@ -1,227 +0,0 @@ -/* fn2lun.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FN2LUN ( Map name of open file to its logical unit. ) */ -/* Subroutine */ int fn2lun_(char *filnam, integer *lunit, ftnlen filnam_len) -{ - /* System generated locals */ - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical opened; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - logical exists; - -/* $ Abstract */ - -/* Map the name of an open file to its associated logical unit. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILNAM I Name of the file to be mapped to its logical unit. */ -/* LUNIT O The logical unit associated with the filename. */ - -/* $ Detailed_Input */ - -/* FILNAM is the filename that is to be mapped to its associated */ -/* Fortran logical unit. */ - -/* $ Detailed_Output */ - -/* LUNIT is the Fortran logical unit that is associated with the */ -/* filename FILNAM. The file must be open for this routine */ -/* to work properly. */ - -/* $ Parameters */ - -/* None. */ - - -/* $ Exceptions */ - -/* 1) If the filename is blank, the error SPICE(BLANKFILENAME) will */ -/* be signalled. */ - -/* 2) If an error occurs during the execution of the Fortran INQUIRE */ -/* statement, the error SPICE(INQUIREFAILED) is signalled. */ - -/* 3) If the filename is not associated with an open file, the */ -/* error SPICE(FILENOTOPEN) will be signalled. */ - -/* 4) If the filename is not associated with an existing file, the */ -/* error SPICE(FILEDOESNOTEXIST) will be signalled. */ - -/* 5) In the event of an error the contents of the variable LUNIT */ -/* are not defined, and should not be used. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Use the Fortran INQUIRE statement to determine the filename */ -/* that is associated with the Fortran logical unit LUNIT. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of FN2LUN. */ - -/* C */ -/* C Convert the logical unit to its filename and display it. */ -/* C */ -/* CALL FN2LUN ( FNAME, LUNIT ) */ -/* WRITE (*,*) 'The logical unit is: ', LUNIT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* map filename to logical unit */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("FN2LUN", (ftnlen)6); - } - -/* First we test to see if the filename is blank. */ - - if (s_cmp(filnam, " ", filnam_len, (ftnlen)1) == 0) { - setmsg_("The filename is blank.", (ftnlen)22); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("FN2LUN", (ftnlen)6); - return 0; - } - -/* So simple, it defies explanation: just INQUIRE. */ - - ioin__1.inerr = 1; - ioin__1.infilen = filnam_len; - ioin__1.infile = filnam; - ioin__1.inex = &exists; - ioin__1.inopen = &opened; - ioin__1.innum = &*lunit; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - setmsg_("INQUIRE error on file '#'. The value of IOSTAT is: #.", ( - ftnlen)53); - errch_("#", filnam, (ftnlen)1, filnam_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("FN2LUN", (ftnlen)6); - return 0; - } - -/* A file cannot be open if it does not exist. We need to check this */ -/* because for some environments files are considered to be open if */ -/* they do not exist. */ - - if (! exists) { - setmsg_("No file with the name '#' was found.", (ftnlen)36); - errch_("#", filnam, (ftnlen)1, filnam_len); - sigerr_("SPICE(FILEDOESNOTEXIST)", (ftnlen)23); - chkout_("FN2LUN", (ftnlen)6); - return 0; - } - -/* Now check to see if the file is opened. If not, then it is an */ -/* error, there cannot be a logical unit associated with it.. */ - - if (! opened) { - setmsg_("There was not an open file associated with the filename '#'." - , (ftnlen)60); - errch_("#", filnam, (ftnlen)1, filnam_len); - sigerr_("SPICE(FILENOTOPEN)", (ftnlen)18); - chkout_("FN2LUN", (ftnlen)6); - return 0; - } - chkout_("FN2LUN", (ftnlen)6); - return 0; -} /* fn2lun_ */ - diff --git a/ext/spice/src/cspice/fndlun.c b/ext/spice/src/cspice/fndlun.c deleted file mode 100644 index a7b6dbe347..0000000000 --- a/ext/spice/src/cspice/fndlun.c +++ /dev/null @@ -1,1037 +0,0 @@ -/* fndlun.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FNDLUN ( Find a free logical unit ) */ -/* Subroutine */ int fndlun_0_(int n__, integer *unit) -{ - /* Initialized data */ - - static integer last = 1; - static logical first = TRUE_; - static integer resnum[3] = { 5,6,7 }; - - /* System generated locals */ - integer i__1, i__2; - inlist ioin__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), f_inqu(inlist *); - - /* Local variables */ - static integer i__; - static logical resvd[99], opened; - static integer iostat; - -/* $ Abstract */ - -/* Return the number of a free logical unit, if one is available. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT O The number of a free logical unit. */ -/* MINLUN P Minimum logical unit number. */ -/* MAXLUN P Maximum logical unit number. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* UNIT is the number of a free logical unit (also called */ -/* an "external unit"). A "free" logical unit is one */ -/* that is not reserved and is not currently connected to */ -/* and open file. If no free units are available, the */ -/* value of UNIT is 0. */ - -/* $ Parameters */ - -/* MINLUN is the minimum logical unit number. The Fortran */ -/* standard states that unit numbers must be zero or */ -/* positive. However, the value 0 is reserved as a */ -/* status code for this routine, so MINLUN must be */ -/* assigned a value greater than 0. */ - -/* MAXLUN is the maximum logical unit number allowed by the */ -/* VAX Fortran compiler. This may differ for other */ -/* machines. */ - -/* Listed below are the values for several machines: */ - -/* Environment: VAX/VMS, VAX FORTRAN */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* Environment: Sun, Sun FORTRAN */ -/* MINLUN: 1 */ -/* MAXLUN: 63 */ - -/* Environment: PC, MS FORTRAN * */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* Environment: PC/Linux, Fort77 */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* MINLUN: 1 */ -/* MAXLUN: 61 */ - -/* Environment: Silicon Graphics, SGI f77 */ -/* MINLUN: 1 */ -/* MAXLUN: 63 */ - -/* Environment: DEC Alpha OSF/1, DEC FORTRAN */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* Environment: NeXT, Absoft Fortran */ -/* MINLUN: 1 */ -/* MAXLUN: 99 */ - -/* * 32767 is the actual value a logical unit may be assigned to */ -/* on the IBM PC, however, using this value increases the memory */ -/* requirements of a program calling this routine by 128K. */ - -/* $ Exceptions */ - -/* Error free. */ - - -/* 1) If no logical units are available, UNIT is set equal */ -/* to 0. */ - -/* 2) This routine performs a Fortran INQUIRE operation. If */ -/* the INQUIRE fails, UNIT is set equal to the negative */ -/* of the INQUIRE iostat ( UNIT will thus have a negative */ -/* value). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* FNDLUN returns the number of the first (unreserved) unit not */ -/* currently connected to a file. It thus frees the user from */ -/* having to maintain an accounting of which units are open, which */ -/* are closed, and which are available. */ - -/* This routine is related to the routines GETLUN, RESLUN, and */ -/* FRELUN. Together, these routines support coordinated usage of */ -/* Fortran logical units. FNDLUN (Find a free logical unit) and */ -/* GETLUN (Get a free logical unit) both have the function of */ -/* returning a logical unit number that is not reserved or already */ -/* in use. The principal difference between the functionality of */ -/* these routines is that GETLUN both returns a status code and */ -/* signals an error if a free unit is not found, while FNDLUN */ -/* merely returns a status code. */ - -/* RESLUN is used to reserve logical unit numbers, so that they will */ -/* not be returned by GETLUN or FNDLUN; FRELUN frees logical units */ -/* previously reserved via calls to RESLUN. */ - -/* On the VAX, SUN, PC, and HP logical units 5-7 are reserved by */ -/* default. On the Macintosh logical units 5,6 and 9 are reserved */ -/* by default. Other units may be reserved by calling RESLUN. Once */ -/* reserved, units (except ones reserved by default) may be */ -/* unreserved by calling FRELUN. */ - -/* To reserve logical unit numbers for special use, refer to */ -/* RESLUN. To make reserved units available to FNDLUN and GETLUN, */ -/* refer to FRELUN. */ - -/* A unit returned by FNDLUN does NOT automatically become a */ -/* reserved unit. If the user wishes to reserve a unit found by */ -/* FNDLUN, the call to FNDLUN must be followed by a call to RESLUN. */ - -/* Note that although 0 is a valid logical unit number on some */ -/* systems, a value of 0 returned by FNDLUN indicates that no free */ -/* logical unit was available, rather than that logical unit 0 is */ -/* available. Similarly, negative values returned by FNDLUN are */ -/* status codes, not logical unit numbers. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of FNDLUN. */ - -/* CALL FNDLUN ( UNIT ) */ - -/* IF ( UNIT .LT. 0 ) THEN */ -/* RETURN */ -/* END IF */ - -/* $ Restrictions */ - -/* This routine never returns logical unit numbers that are less */ -/* than or equal to 0. */ - -/* $ Literature_References */ - -/* 1. "Programming in VAX FORTRAN", Digital Equipment Corporation, */ -/* September 1984, Section 11.1.1, page 11-2. */ - -/* 2. "Microsoft FORTRAN Reference", Microsoft Corporation */ -/* 1989, Section 3.2.2, page 61. */ - -/* 3. "Sun FORTRAN Programmer's Guide", Sun Microsystems, */ -/* Revision A of 6 May 1988, Section 7.2, page 73. */ - -/* 4. "Language Systems FORTRAN Reference Manual", Version 2.1, */ -/* page 193. */ - -/* 5. "Lahey F77L EM/32 Programmers Reference Manual", version 4.0, */ -/* page 94. */ - -/* 6. "FORTRAN/9000 Reference HP 9000 Series 700 Computers", */ -/* First Edition, June 1991, Hewlett Packard Company, pages 6-2 */ -/* and 6-4. */ - -/* 7. Silicon Graphics "Fortran 77 Programmer's Guide", */ -/* Document number 007-0711-030, page 1-20. */ - -/* 8. "Language Reference Manual", Absoft Fortran V3.2, 1993, */ -/* page 7-4, section 7.3.1 (for the NeXT). */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.21.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 6.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 6.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 6.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 6.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 6.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 6.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 6.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 6.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 6.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 6.11.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 6.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 6.9.0, 16-MAR-2009 (BVS) */ - -/* Changed MAXLUN from 99 to 61 for HP and HP_C environments. The */ -/* value 61 was determined by trial-n-error while preparing a */ -/* special HP toolkit delivery for GSFC in July 2008. */ - -/* - SPICELIB Version 6.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 6.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 6.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 6.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 6.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 6.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 6.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 6.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 6.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 6.0.0, 05-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* - SPICELIB Version 5.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the logical unit values */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. */ - -/* - SPICELIB Version 4.0.0, 6-OCT-1992 (HAN) */ - -/* Module was updated to include the logical unit values for */ -/* the Hewlett Packard UX 9000/750 environment. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1992 (MJS) */ - -/* IOSTAT check now placed directly after the INQUIRE */ -/* statement. */ - -/* - SPICELIB Version 2.2.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.2.0, 13-NOV-1991 (MJS) */ - -/* Module was updated to include the value of MAXLUN */ -/* for the Lahey F77L EM/32 environment (PC). */ - -/* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */ - -/* Module was updated to allow portability to the Macintosh */ -/* environment. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */ - -/* The array RESNUM now contains the default reserved */ -/* logical units. All the elements of the array RESVD */ -/* were initialized. The value of MAXLUN for the IBM PC */ -/* was changed from 32767 to 99. Some header comments */ -/* were clarified. */ - -/* - SPICELIB Version 1.0.1, 20-MAR-1990 (HAN) */ - -/* Parameters section was updated to include the values */ -/* of MINLUN and MAXLUN for several machines. Sources of */ -/* these values are listed in the Literature References */ -/* section. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find a free logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.0.0, 05-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* - SPICELIB Version 5.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the logical unit values */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. */ - -/* The values used for the DEC Alpha worked in all of the */ -/* porting tests, but NAIF has no documentation for this */ -/* platform. */ - -/* - SPICELIB Version 1.4.0, 6-OCT-1992 (HAN) */ - -/* Module was updated to include the logical unit values for */ -/* the Hewlett Packard UX 9000/750 environment. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 3.0.0, 20-MAR-1992 (MJS) */ - -/* IOSTAT check now placed directly after the INQUIRE */ -/* statement. Previously, IOSTAT could have been checked */ -/* without first being assigned a value. */ - -/* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */ - -/* Module was updated to allow portability to the Macintosh */ -/* environment. Literature References section was updated. */ -/* Some header comments were clarified. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */ - -/* The default reserved logical units are now declared in the */ -/* array RESNUM. All the elements of the array RESVD were */ -/* initialized. These two changes allow FNDLUN to be ported */ -/* to other platforms more easily. The value of MAXLUN for the */ -/* IBM PC was decreased from 32767 to 99. */ - -/* Some cosmetic changes to variable declarations were made. */ -/* Also, some header comments were added to make the header's */ -/* discussion clearer. */ - -/* - Beta Version 1.1.0, 09-MAR-1989 (HAN) */ - -/* Declaration of the variable RETURN was removed from the code. */ -/* The variable was declared, but not used. */ - -/* -& */ - -/* Parameters */ - - -/* Local variables */ - - -/* Save everything between calls. */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_reslun; - case 2: goto L_frelun; - } - - -/* VAX, SUN, PC, HP, SGI, DEC Alpha-OSF/1, and PC/Lunix */ -/* reserved units. */ - - -/* Initialize RESVD if it hasn't already been done. */ - - if (first) { - for (i__ = 1; i__ <= 99; ++i__) { - resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd", - i__1, "fndlun_", (ftnlen)513)] = FALSE_; - } - for (i__ = 1; i__ <= 3; ++i__) { - resvd[(i__2 = resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("resnum", i__1, "fndlun_", (ftnlen)517)] - 1) < 99 - && 0 <= i__2 ? i__2 : s_rnge("resvd", i__2, "fndlun_", ( - ftnlen)517)] = TRUE_; - } - first = FALSE_; - } - -/* Begin with the unit following the last one returned. */ -/* Cycle through the available units. Skip reserved units, */ -/* INQUIRE about others. */ - - for (i__ = last + 1; i__ <= 99; ++i__) { - if (resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd", - i__1, "fndlun_", (ftnlen)531)]) { - opened = TRUE_; - } else { - ioin__1.inerr = 1; - ioin__1.inunit = i__; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat > 0) { - *unit = -iostat; - return 0; - } - } - if (! opened) { - *unit = i__; - last = *unit; - return 0; - } - } - -/* If we've come this far, we need to search the first part of */ -/* the list again, up to the last unit returned. Once again, */ -/* skip reserved units, INQUIRE about others. */ - - i__1 = last; - for (i__ = 1; i__ <= i__1; ++i__) { - if (resvd[(i__2 = i__ - 1) < 99 && 0 <= i__2 ? i__2 : s_rnge("resvd", - i__2, "fndlun_", (ftnlen)558)]) { - opened = TRUE_; - } else { - ioin__1.inerr = 1; - ioin__1.inunit = i__; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat > 0) { - *unit = -iostat; - return 0; - } - } - if (! opened) { - *unit = i__; - last = *unit; - return 0; - } - } - -/* If we've come this far, there are no free units to be had. */ -/* C'est la vie. Assign 0 to the unit number. */ - - *unit = 0; - return 0; -/* $Procedure RESLUN ( Reserve a logical unit ) */ - -L_reslun: -/* $ Abstract */ - -/* Reserve a logical unit number. Reserved units are never returned */ -/* by FNDLUN or GETLUN. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Number of the logical unit to be reserved. */ - -/* $ Detailed_Input */ - -/* UNIT is the number of the logical unit to be reserved. */ -/* Once reserved, the unit number will not be returned */ -/* by the routines FNDLUN or GETLUN, even if it is not */ -/* connected to a file. */ - -/* On the VAX, SUN, PC, and HP logical units 5-7 are */ -/* reserved by default. On the Macintosh logical units */ -/* 5,6 and 9 are reserved by default. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* FNDLUN maintains an array of logical flags, one for each positive */ -/* unit number offered by the system. RESLUN sets the value of the */ -/* flag for UNIT to TRUE. */ - -/* Once reserved, units (except units reserved by default) may be */ -/* unreserved by calling FRELUN. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of RESLUN. */ - -/* C */ -/* C Units 17-23 are used by non-NAIF file readers. */ -/* C Reserve these, so that they will not be returned */ -/* C by FNDLUN or GETLUN. */ -/* C */ -/* DO I = 17, 23 */ -/* CALL RESLUN ( I ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See the module FNDLUN. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */ - -/* RESVD is now initialized on entry to this routine if */ -/* it hasn't been done previously. */ - -/* - 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 (CAC) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* reserve a logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */ - -/* RESVD is now initialized on entry to this routine if */ -/* it hasn't been done previously. Prior to this fix, any actions */ -/* taken by RESLUN or FRELUN before FNDLUN was called would have */ -/* been discarded. FIRST is now checked on entry to all entry */ -/* points. */ - -/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) (NJB) */ - -/* This routine is now an entry point of FNDLUN rather than */ -/* GETLUN. The code of this entry point itself has not changed */ -/* however. References to the routine FNDLUN were added to the */ -/* header. The restrictions section was updated to read "none." */ -/* This module was declared "error free", which means */ -/* that it will never participate in error handling. */ - -/* -& */ - -/* Initialize RESVD if it hasn't already been done. */ - - if (first) { - for (i__ = 1; i__ <= 99; ++i__) { - resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd", - i__1, "fndlun_", (ftnlen)781)] = FALSE_; - } - for (i__ = 1; i__ <= 3; ++i__) { - resvd[(i__2 = resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("resnum", i__1, "fndlun_", (ftnlen)785)] - 1) < 99 - && 0 <= i__2 ? i__2 : s_rnge("resvd", i__2, "fndlun_", ( - ftnlen)785)] = TRUE_; - } - first = FALSE_; - } - -/* If UNIT is in the proper range, set the corresponding flag */ -/* to TRUE. */ - - if (*unit >= 1 && *unit <= 99) { - resvd[(i__1 = *unit - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd", - i__1, "fndlun_", (ftnlen)797)] = TRUE_; - } - return 0; -/* $Procedure FRELUN ( Free a reserved logical unit ) */ - -L_frelun: -/* $ Abstract */ - -/* Unreserve a logical unit number reserved by RESLUN. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ - -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Number of the logical unit to be unreserved. */ - -/* $ Detailed_Input */ - -/* UNIT is the number of the logical unit to be unreserved. */ -/* Once unreserved, the unit number may be returned by */ -/* the routines GETLUN or FNDLUN whenever not connected to */ -/* a file. */ - -/* On the VAX, SUN, PC, and HP logical units 5-7 are */ -/* reserved by default. On the Macintosh logical units */ -/* 5,6 and 9 are reserved by default. These may not be */ -/* unreserved. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* FNDLUN maintains an array of logical flags, one for each unit */ -/* offered by the system. FRELUN sets the value of the flag for */ -/* UNIT to FALSE. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of FRELUN. */ - -/* C */ -/* C Free the units used by the non-NAIF file readers, */ -/* C so that they may be returned by FNDLUN or GETLUN. */ -/* C */ -/* DO I = 17, 23 */ -/* CALL FRELUN ( I ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See the module FNDLUN. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 6.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */ - -/* RESVD is now initialized on entry to this routine if */ -/* it hasn't been done previously. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 12-MAR-1991 (MJS) */ - -/* The array RESNUM now contains the default reserved */ -/* logical units. All the elements of the array RESVD */ -/* were initialized. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* free a reserved logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */ - -/* RESVD is now initialized on entry to this routine if */ -/* it hasn't been done previously. Prior to this fix, any actions */ -/* taken by RESLUN or FRELUN before FNDLUN was called would have */ -/* been discarded. FIRST is now checked on entry to all entry */ -/* points. */ - -/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) (NJB) */ - -/* This routine is now an entry point of FNDLUN rather than */ -/* GETLUN. The code of this entry point itself has not changed */ -/* however. References to the routine FNDLUN were added to the */ -/* header. The restrictions section was updated to read "none." */ -/* This module was declared "error free", which means */ -/* that it will never participate in error handling. */ - -/* -& */ - -/* Initialize RESVD if it hasn't already been done. */ - - if (first) { - for (i__ = 1; i__ <= 99; ++i__) { - resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd", - i__1, "fndlun_", (ftnlen)1002)] = FALSE_; - } - for (i__ = 1; i__ <= 3; ++i__) { - resvd[(i__2 = resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("resnum", i__1, "fndlun_", (ftnlen)1006)] - 1) < - 99 && 0 <= i__2 ? i__2 : s_rnge("resvd", i__2, "fndlun_", - (ftnlen)1006)] = TRUE_; - } - first = FALSE_; - } - -/* If UNIT is in the proper range and it has not been reserved by */ -/* default, set the corresponding flag to FALSE. */ - - if (*unit >= 1 && *unit <= 99) { - for (i__ = 1; i__ <= 3; ++i__) { - if (*unit == resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("resnum", i__1, "fndlun_", (ftnlen)1020)]) { - return 0; - } - } - resvd[(i__1 = *unit - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd", - i__1, "fndlun_", (ftnlen)1025)] = FALSE_; - } - return 0; -} /* fndlun_ */ - -/* Subroutine */ int fndlun_(integer *unit) -{ - return fndlun_0_(0, unit); - } - -/* Subroutine */ int reslun_(integer *unit) -{ - return fndlun_0_(1, unit); - } - -/* Subroutine */ int frelun_(integer *unit) -{ - return fndlun_0_(2, unit); - } - diff --git a/ext/spice/src/cspice/fndnwd.c b/ext/spice/src/cspice/fndnwd.c deleted file mode 100644 index 71338822c9..0000000000 --- a/ext/spice/src/cspice/fndnwd.c +++ /dev/null @@ -1,224 +0,0 @@ -/* fndnwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FNDNWD ( Find the next word after an index ) */ -/* Subroutine */ int fndnwd_(char *string, integer *start, integer *b, - integer *e, ftnlen string_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer size, i__, l, n, blank; - logical thisb, lastn; - -/* $ Abstract */ - -/* Find the beginning and end of the first word starting at */ -/* or after a specified 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 */ - -/* None. */ - -/* $ Keywords */ - -/* PARSING, SEARCH, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A string to examine for words. */ -/* START I Position in the string to start looking for words. */ -/* B O String position of first character of the word. */ -/* E O String position of last character of the word. */ - -/* $ Detailed_Input */ - -/* STRING Is a character string that potentially consists of */ -/* words of text. */ - -/* START Is the index of a letter within the string from which */ -/* to start looking for the next word. */ - -/* $ Detailed_Output */ - -/* B Is the index of the first letter of the word substring */ -/* of STRING that begins at or after position START. If */ -/* there are no such substrings I is returned as 0. */ - -/* E Is the index of the last letter of the word substring */ -/* of STRING that begins at or after position START. If */ -/* there are no such substrings J is returned as 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Given a character string and location of a character within that */ -/* string, this routine finds the first full word of the string */ -/* that starts on or after the specified location. */ - -/* $ Examples */ -/* 1 2 3 4 5 */ -/* 12345678901234567890123456789012345678901234567890 */ -/* STRING: 'Now is the time for all good men to go home to bed' */ - -/* START I J */ -/* ----- --- --- */ -/* 1 1 3 */ -/* 2 5 6 */ -/* 3 5 6 */ -/* 4 5 6 */ -/* 5 5 6 */ -/* 6 8 10 */ -/* 7 8 10 */ -/* 8 8 10 */ -/* 9 12 15 */ - -/* 48 48 50 */ -/* 49 0 0 */ -/* 111 0 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 15-OCT-1993 (WLT) */ - -/* The routine was completely rewritten with a resulting */ -/* increase in execution speed of between 2000% and 6000%. */ - -/* - 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 */ - -/* find the next word after an index */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 15-OCT-1993 (WLT) */ - -/* The routine was completely rewritten with a resulting */ -/* increase in execution speed of between 2000% and 6000%. */ -/* It was tested against the old version of the routine to */ -/* ensure that the functionality was exactly duplicated. */ - -/* -& */ - -/* Local Variables */ - - -/* Set up neede parameters and check obvious out-of-bound cases. */ - - blank = ' '; - size = i_len(string, string_len); - if (*start > size) { - *b = 0; - *e = 0; - return 0; - } - n = max(1,*start); - l = n - 1; - if (l <= 0) { - lastn = FALSE_; - } else { - lastn = *(unsigned char *)&string[l - 1] != blank; - } - thisb = *(unsigned char *)&string[n - 1] == blank; - -/* Search for the beginning of a word (the last character */ -/* blank and the current non-blank). */ - - while(thisb || lastn) { - ++n; - if (n > size) { - *b = 0; - *e = 0; - return 0; - } - lastn = ! thisb; - thisb = *(unsigned char *)&string[n - 1] == blank; - } - -/* If we get this far, we found the beginning of the */ -/* string. To find the end look for the next blank and */ -/* back up one. */ - - *b = n; - i__1 = size; - for (i__ = n + 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&string[i__ - 1] == blank) { - *e = i__ - 1; - return 0; - } - } - -/* If we get this far, the word ends at the end of the */ -/* string. */ - - *e = size; - return 0; -} /* fndnwd_ */ - diff --git a/ext/spice/src/cspice/fp.h b/ext/spice/src/cspice/fp.h deleted file mode 100644 index 40743d79f7..0000000000 --- a/ext/spice/src/cspice/fp.h +++ /dev/null @@ -1,28 +0,0 @@ -#define FMAX 40 -#define EXPMAXDIGS 8 -#define EXPMAX 99999999 -/* FMAX = max number of nonzero digits passed to atof() */ -/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */ - -#ifdef V10 /* Research Tenth-Edition Unix */ -#include "local.h" -#endif - -/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily - tight) on the maximum number of digits to the right and left of - * the decimal point. - */ - -#ifdef VAX -#define MAXFRACDIGS 56 -#define MAXINTDIGS 38 -#else -#ifdef CRAY -#define MAXFRACDIGS 9880 -#define MAXINTDIGS 9864 -#else -/* values that suffice for IEEE double */ -#define MAXFRACDIGS 344 -#define MAXINTDIGS 308 -#endif -#endif diff --git a/ext/spice/src/cspice/frame.c b/ext/spice/src/cspice/frame.c deleted file mode 100644 index 0dc567ce05..0000000000 --- a/ext/spice/src/cspice/frame.c +++ /dev/null @@ -1,285 +0,0 @@ -/* frame.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FRAME ( Build a right handed coordinate frame ) */ -/* Subroutine */ int frame_(doublereal *x, doublereal *y, doublereal *z__) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - double sqrt(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal a, b, c__, f; - integer s1, s2, s3; - extern /* Subroutine */ int vhatip_(doublereal *); - -/* $ Abstract */ - -/* Given a vector X, this routine builds a right handed */ -/* orthonormal frame X,Y,Z where the output X is parallel to */ -/* the input X. */ - -/* $ 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 */ - -/* AXES, FRAME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------ */ -/* X I/0 Input vector. A parallel unit vector on output. */ -/* Y O Unit vector in the plane orthogonal to X. */ -/* Z O Unit vector given by X x Y. */ - -/* $ Detailed_Input */ - - -/* X This vector is used to form the first vector of a */ -/* right-handed orthonormal triple. */ - -/* $ Detailed_Output */ - -/* X, */ -/* Y, */ -/* Z form a right handed orthonormal frame, where X is */ -/* now a unit vector parallel to the original input */ -/* vector in X. There are no special geometric properties */ -/* connected to Y and Z (other than that they complete the */ -/* right handed frame). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Given an input vector X, this routine returns unit vectors X, */ -/* Y, and Z such that XYZ forms a right-handed orthonormal frame */ -/* where the output X is parallel to the input X. */ - -/* This routine is intended primarily to provide a basis for */ -/* the plane orthogonal to X. There are no special properties */ -/* associated with Y and Z other than that the resulting XYZ frame */ -/* is right handed and orthonormal. There are an infinite */ -/* collection of pairs (Y,Z) that could be used to this end. */ -/* Even though for a given X, Y and Z are uniquely */ -/* determined, users */ -/* should regard the pair (Y,Z) as a random selection from this */ -/* infinite collection. */ - -/* For instance, when attempting to determine the locus of points */ -/* that make up the limb of a triaxial body, it is a straightforward */ -/* matter to determine the normal to the limb plane. To find */ -/* the actual parametric equation of the limb one needs to have */ -/* a basis of the plane. This routine can be used to get a basis */ -/* in which one can describe the curve and from which one can */ -/* then determine the principal axes of the limb ellipse. */ - -/* $ Examples */ - -/* In addition to using a vector to construct a right handed frame */ -/* with the x-axis aligned with the input vector, one can construct */ -/* right handed frames with any of the axes aligned with the input */ -/* vector. */ - -/* For example suppose we want a right hand frame XYZ with the */ -/* Z-axis aligned with some vector V. Assign V to Z */ - -/* Z(1) = V(1) */ -/* Z(2) = V(2) */ -/* Z(3) = V(3) */ - -/* Then call FRAME with the arguements X,Y,Z cycled so that Z */ -/* appears first. */ - -/* CALL FRAME (Z, X, Y) */ - -/* The resulting XYZ frame will be orthonormal with Z parallel */ -/* to the vector V. */ - -/* To get an XYZ frame with Y parallel to V perform the following */ - -/* Y(1) = V(1) */ -/* Y(2) = V(2) */ -/* Y(3) = V(3) */ - -/* CALL FRAME (Y, Z, X) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free */ - -/* 1) If X on input is the zero vector the ``standard'' frame (ijk) */ -/* is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT call. */ - -/* - 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 */ - -/* build a right handed coordinate frame */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT call. */ - -/* - Beta Version 2.0.0, 29-DEC-1988 (WLT) (IMU) */ - -/* The routine was modified so that it now accepts any input */ -/* vector in the X slot (it originally was assumed to be a unit */ -/* vector). Moreover, the original algorithm has been streamlined */ -/* a great deal to take advantage of our knowledge of the */ -/* internal structure of the orthonormal triple. */ - -/* -& */ - - -/* Local variables */ - - -/* First make X into a unit vector. */ - - vhatip_(x); - -/* We'll need the squares of the components of X in a bit. */ - - a = x[0] * x[0]; - b = x[1] * x[1]; - c__ = x[2] * x[2]; - -/* If X is zero, then just return the ijk frame. */ - - if (a + b + c__ == 0.) { - x[0] = 1.; - x[1] = 0.; - x[2] = 0.; - y[0] = 0.; - y[1] = 1.; - y[2] = 0.; - z__[0] = 0.; - z__[1] = 0.; - z__[2] = 1.; - return 0; - } - -/* If we make it this far, determine which component of X has the */ -/* smallest magnitude. This component will be zero in Y. The other */ -/* two components of X will put into Y swapped with the sign of */ -/* the first changed. From there, Z can have only one possible */ -/* set of values which it gets from the smallest component */ -/* of X, the non-zero components of Y and the length of Y. */ - - if (a <= b && a <= c__) { - f = sqrt(b + c__); - s1 = 1; - s2 = 2; - s3 = 3; - } else if (b <= a && b <= c__) { - f = sqrt(a + c__); - s1 = 2; - s2 = 3; - s3 = 1; - } else { - f = sqrt(a + b); - s1 = 3; - s2 = 1; - s3 = 2; - } - -/* Note: by construction, F is the magnitude of the large components */ -/* of X. With this in mind, one can verify by inspection that X, Y */ -/* and Z yield an orthonormal frame. The right handedness follows */ -/* from the assignment of values to S1, S2 and S3 (they are merely */ -/* cycled from one case to the next). */ - - y[(i__1 = s1 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("y", i__1, "frame_", ( - ftnlen)285)] = 0.; - y[(i__1 = s2 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("y", i__1, "frame_", ( - ftnlen)286)] = -x[(i__2 = s3 - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("x", i__2, "frame_", (ftnlen)286)] / f; - y[(i__1 = s3 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("y", i__1, "frame_", ( - ftnlen)287)] = x[(i__2 = s2 - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "x", i__2, "frame_", (ftnlen)287)] / f; - z__[(i__1 = s1 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("z", i__1, "frame_", - (ftnlen)289)] = f; - z__[(i__1 = s2 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("z", i__1, "frame_", - (ftnlen)290)] = -x[(i__2 = s1 - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("x", i__2, "frame_", (ftnlen)290)] * y[(i__3 = s3 - 1) < 3 - && 0 <= i__3 ? i__3 : s_rnge("y", i__3, "frame_", (ftnlen)290)]; - z__[(i__1 = s3 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("z", i__1, "frame_", - (ftnlen)291)] = x[(i__2 = s1 - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("x", i__2, "frame_", (ftnlen)291)] * y[(i__3 = s2 - 1) < 3 - && 0 <= i__3 ? i__3 : s_rnge("y", i__3, "frame_", (ftnlen)291)]; - return 0; -} /* frame_ */ - diff --git a/ext/spice/src/cspice/frame_c.c b/ext/spice/src/cspice/frame_c.c deleted file mode 100644 index 01c86e12dd..0000000000 --- a/ext/spice/src/cspice/frame_c.c +++ /dev/null @@ -1,270 +0,0 @@ -/* - --Procedure frame_c ( Build a right handed coordinate frame ) - --Abstract - - Given a vector x, this routine builds a right handed - orthonormal frame x,y,z where the output x is parallel to - the input x. - --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 - - AXES, FRAME - -*/ - #include - #include "SpiceUsr.h" - - - void frame_c ( SpiceDouble x[3], - SpiceDouble y[3], - SpiceDouble z[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------ - x I/O Input vector. A parallel unit vector on output. - y O Unit vector in the plane orthogonal to x. - z O Unit vector given by x X y. - --Detailed_Input - - - x This vector is used to form the first vector of a - right-handed orthonormal triple. - --Detailed_Output - - x, - y, - z form a right handed orthonormal frame, where x is - now a unit vector parallel to the original input - vector x. There are no special geometric properties - connected to y and z (other than that they complete the - right handed frame). - --Parameters - - None. - --Exceptions - - Error Free. - - 1) If x on input is the zero vector the ``standard'' frame (ijk) - is returned. - --Particulars - - Given an input vector x, this routine returns unit vectors x, - y, and z such that xyz forms a right-handed orthonormal frame - where the output x is parallel to the input x. - - This routine is intended primarily to provide a basis for - the plane orthogonal to x. There are no special properties - associated with y and z other than that the resulting xyz frame - is right handed and orthonormal. There are an infinite - collection of pairs (y,z) that could be used to this end. - Even though for a given x, y and z are uniquely determined, users - should regard the pair (y,z) as a random selection from this - infinite collection. - - For instance, when attempting to determine the locus of points - that make up the limb of a triaxial body, it is a straightforward - matter to determine the normal to the limb plane. To find - the actual parametric equation of the limb one needs to have - a basis of the plane. This routine can be used to get a basis - in which one can describe the curve and from which one can - then determine the principal axes of the limb ellipse. - --Examples - - In addition to using a vector to construct a right handed frame - with the x-axis aligned with the input vector, one can construct - right handed frames with any of the axes aligned with the input - vector. - - For example suppose we want a right hand frame xyz with the - z-axis aligned with some vector v. Assign v to z - - z[0] = v[0]; - z[1] = v[1]; - z[2] = v[2]; - - Then call frame_c with the arguments x,y,z cycled so that z - appears first. - - frame_c (z, x, y); - - The resulting xyz frame will be orthonormal with z parallel - to the vector v. - - To get an xyz frame with y parallel to v perform the following - - y[0] = v[0]; - y[1] = v[1]; - y[2] = v[2]; - - frame_c (y, z, x); - --Restrictions - - None. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 26-MAR-1999 (NJB) - --Index_Entries - - build a right handed coordinate frame - --& -*/ - -{ /* Begin frame_c */ - - - SpiceDouble a; - SpiceDouble b; - SpiceDouble c; - SpiceDouble f; - - SpiceInt s0; - SpiceInt s1; - SpiceInt s2; - - - /* - First make x into a unit vector. - */ - vhat_c ( x, x ); - - - /* - We'll need the squares of the components of x in a bit. - */ - a = x[0] * x[0]; - b = x[1] * x[1]; - c = x[2] * x[2]; - - - /* - If X is zero, then just return the ijk frame. - */ - if ( a+b+c == 0.0 ) - { - x[0] = 1.0; - x[1] = 0.0; - x[2] = 0.0; - - y[0] = 0.0; - y[1] = 1.0; - y[2] = 0.0; - - z[0] = 0.0; - z[1] = 0.0; - z[2] = 1.0; - - return; - } - - - /* - If we make it this far, determine which component of x has the - smallest magnitude. This component will be zero in y. The other - two components of x will put into y swapped with the sign of - the first changed. From there, z can have only one possible - set of values which it gets from the smallest component - of x, the non-zero components of y and the length of y. - */ - - if ( ( a <= b ) && ( a <= c ) ) - { - f = sqrt ( b + c ); - s0 = 0; - s1 = 1; - s2 = 2; - } - - else if ( ( b <= a ) && ( b <= c ) ) - { - f = sqrt ( a + c ); - s0 = 1; - s1 = 2; - s2 = 0; - } - - else - { - f = sqrt ( a + b ); - s0 = 2; - s1 = 0; - s2 = 1; - } - - /* - Note: by construction, f is the magnitude of the large components - of x. With this in mind, one can verify by inspection that x, y - and z yield an orthonormal frame. The right handedness follows - from the assignment of values to s0, s1 and s2 (they are merely - cycled from one case to the next). - */ - - y[s0] = 0.0; - y[s1] = - x[s2] / f; - y[s2] = x[s1] / f; - - z[s0] = f; - z[s1] = - x[s0] * y[s2]; - z[s2] = x[s0] * y[s1]; - - -} /* End frame_c */ - diff --git a/ext/spice/src/cspice/framex.c b/ext/spice/src/cspice/framex.c deleted file mode 100644 index ee7e41c707..0000000000 --- a/ext/spice/src/cspice/framex.c +++ /dev/null @@ -1,2589 +0,0 @@ -/* framex.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__121 = 121; -static integer c__0 = 0; -static integer c__1 = 1; -static integer c__8 = 8; -static integer c__100 = 100; - -/* $Procedure FRAMEX (Frame Expert) */ -/* Subroutine */ int framex_0_(int n__, char *cname, char *frname, integer * - frcode, integer *cent, integer *class__, integer *clssid, logical * - found, ftnlen cname_len, ftnlen frname_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char name__[32*121], line[80*8]; - static integer item, type__[121]; - extern /* Subroutine */ int zzdynbid_(char *, integer *, char *, integer * - , ftnlen, ftnlen); - static char look2[32]; - extern /* Subroutine */ int zzdynvai_(char *, integer *, char *, integer * - , integer *, integer *, ftnlen, ftnlen); - static integer i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char pname[32]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen), repmc_(char *, char *, - char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), repmi_(char *, - char *, integer *, char *, ftnlen, ftnlen, ftnlen); - static logical gotit; - static integer start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - bodc2n_(integer *, char *, logical *, ftnlen), bodn2c_(char *, - integer *, logical *, ftnlen); - static integer id; - extern logical failed_(void); - static integer idcode[121]; - static char lcname[36]; - extern integer bschoc_(char *, integer *, char *, integer *, ftnlen, - ftnlen); - static char lcfram[32]; - extern integer bschoi_(integer *, integer *, integer *, integer *); - static integer kvclid, corder[121], centrd[121], center[121]; - static char kvbuff[32*100]; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen); - static integer norder[121]; - extern /* Subroutine */ int gipool_(char *, integer *, integer *, integer - *, integer *, logical *, ftnlen), sigerr_(char *, ftnlen); - static integer typeid[121], values[8]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), zzfdat_(integer *, char *, integer *, integer *, integer - *, integer *, integer *, integer *, integer *, ftnlen); - static char dattyp[1], lookup[32]; - static integer kvclss; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen, - ftnlen), gnpool_(char *, integer *, integer *, integer *, char *, - logical *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static logical fnd; - -/* $ Abstract */ - -/* This is an umbrella routine for the entry points available */ -/* for manipulating different reference frames. It should not */ -/* be called directly. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* This file contains the number of non-inertial reference */ -/* frames that are currently built into the SPICE toolkit */ -/* software. */ - - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of built-in non-inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of built-in non-inertial reference */ -/* frames. This value is needed by both ZZFDAT, and */ -/* FRAMEX. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.4.0, 11-MAY-2010 (BVS) */ - -/* Increased the number of non-inertial frames from 96 to 100 */ -/* in order to accomodate the following PCK based frames: */ - -/* IAU_BORRELLY */ -/* IAU_TEMPEL_1 */ -/* IAU_VESTA */ -/* IAU_ITOKAWA */ - -/* - SPICELIB Version 1.3.0, 12-DEC-2002 (BVS) */ - -/* Increased the number of non-inertial frames from 85 to 96 */ -/* in order to accomodate the following PCK based frames: */ - -/* IAU_CALLIRRHOE */ -/* IAU_THEMISTO */ -/* IAU_MAGACLITE */ -/* IAU_TAYGETE */ -/* IAU_CHALDENE */ -/* IAU_HARPALYKE */ -/* IAU_KALYKE */ -/* IAU_IOCASTE */ -/* IAU_ERINOME */ -/* IAU_ISONOE */ -/* IAU_PRAXIDIKE */ - -/* - SPICELIB Version 1.2.0, 02-AUG-2002 (FST) */ - -/* Increased the number of non-inertial frames from 81 to 85 */ -/* in order to accomodate the following PCK based frames: */ - -/* IAU_PAN */ -/* IAU_GASPRA */ -/* IAU_IDA */ -/* IAU_EROS */ - -/* - SPICELIB Version 1.1.0, 20-FEB-1997 (WLT) */ - -/* Increased the number of non-inertial frames from 79 to 81 */ -/* in order to accomodate the following earth rotation */ -/* models: */ - -/* ITRF93 */ -/* EARTH_FIXED */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O ENTRY POINT */ -/* -------- --- -------------------------------------------------- */ -/* CNAME I CNMFRM */ -/* FRNAME I/O NAMFRM, FRMNAM, CCIFRM */ -/* FRCODE I/O NAMFRM, FRMNAM, FRINFO, CIDFRM, CCIFRM */ -/* CENT I/O FRINFO, CIDFRM, CCIFRM */ -/* CLASS I/O FRINFO, CCIFRM */ -/* CLSSID I/O FRINFO, CCIFRM */ -/* FOUND O FRINFO */ - - -/* $ Detailed_Input */ - -/* See individual entry points for details concerning inputs. */ - -/* $ Detailed_Output */ - -/* See individual entry points for details concerning inputs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly the error */ -/* 'SPICE(BOGUSENTRY)' will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is an umbrella routine that comprises the SPICE */ -/* interface to the reference frame transformation software. */ - -/* There are 5 entry points. */ - -/* NAMFRM converts string to the id-codes used by low level */ -/* SPICE software */ - -/* FRMNAM converts frame id-codes to the more familiar names */ -/* used to describe various reference frames. */ - -/* FRINFO returns the center associated with a reference frame. */ - -/* CIDFRM given the id-code of an object, returns the bodyfixed */ -/* frame associated with it. */ - -/* CNMFRM given the name of an object, returns the bodyfixed */ -/* frame associated with it. */ - -/* CCIFRM given a frame's class and class ID, returns */ -/* the frame's ID code, name, and center. */ - -/* $ Examples */ - -/* Suppose that you needed to transform between two reference */ -/* frames on the basis of their names and that you wanted to */ -/* correct for light time to the center of the second frame */ -/* as seen from an observer with idcode OBS. */ - -/* The code fragment below illustrates how you could use the */ -/* entry points gathered in this routine to retrieve the */ -/* state transformation matrix. */ - - -/* First convert names to frame id codes. */ - -/* CHARACTER*(32) NAME1 */ -/* CHARACTER*(32) NAME2 */ - -/* INTEGER FRAME1 */ -/* INTEGER FRAME2 */ -/* INTEGER CENT */ -/* INTEGER OBS */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ - -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION XFORM ( 6, 6 ) */ - - -/* First we use the entry points NAMFRM to convert the frame */ -/* names to id codes. */ - -/* CALL NAMFRM ( NAME1, FRAME1 ) */ -/* CALL NAMFRM ( NAME2, FRAME2 ) */ - -/* Next we determine the center of the second frame */ - -/* CALL FRINFO ( FRAME2, CENT, CLASS, CLSSID, FOUND ) */ - -/* Determine the light time to the center of the second frame. */ - -/* CALL SPKGEO ( CENT, ET, 'J2000', OBS, STATE, LT ) */ - -/* Finally get the state transformation from FRAME1 to FRAME2 */ -/* at time ET - LT */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET-LT, XFORM ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.0.1, 17-MAR-2009 (EDW) */ - -/* Entry point NAMFRM: Typo correction in Required_Reading, */ -/* changed FRAME to FRAMES. */ - -/* - SPICELIB Version 5.0.0, 05-NOV-2007 (NJB) */ - -/* Entry point CCIFRM (map frame class and class ID */ -/* to frame ID code, name, and center) has been added. */ - -/* - SPICELIB Version 4.0.0, 13-SEP-2005 (NJB) */ - -/* Entry point FRINFO is no longer error-free. Various frame */ -/* definition errors that were previously ignored are now */ -/* diagnosed. */ - -/* Entry point FRINFO has been updated to support specification */ -/* of frame center by name or ID code. Previously only ID codes */ -/* could be used to identify frame centers. */ - -/* - SPICELIB Version 3.2.0, 20-DEC-2004 (BVS) */ - -/* Added parameter incorporating maximum body name length and set */ -/* it to the same value as MAXL from zzbodtrn.inc. Used this */ -/* parameter to declare local variable that holds frame center */ -/* name (LCNAME). */ - -/* In FRINFO entry: removed special handling of the frame IDs */ -/* less than -999. If they cannot be ``resolved'' using kernel */ -/* pool keywords, the frame is NOT declared CK-based with center */ -/* ID derived by dividing frame ID by a 1000 and class ID */ -/* assigned the frame ID anymore. In the current practice with */ -/* multitude of TK frames with IDs set instrument IDs this */ -/* default behavior is simply not valid. */ - -/* - SPICELIB Version 3.1.0, 28-NOV-2002 (NJB) */ - -/* Bug fix: updated CNMFRM so a TK frame specified by name and */ -/* designated as an object's preferred frame via kernel pool */ -/* assignments is found, and so that the correct name of this */ -/* frame is returned. */ - -/* - SPICELIB Version 3.0.1, 25-JUN-1999 (WLT) */ - -/* Extended documentation of entry point CNMFRM and */ -/* corrected example for that entry point. */ - -/* - SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) */ - -/* The entry points CIDFRM and CNMFRM were added so that */ -/* user's may determine the frame-id and name to associated */ -/* with a planetary object. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame idcodes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* The values NINERT and NNINRT are included instead of */ -/* being declared locally. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Frame Transformation */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 12-SEP-2005 (NJB) */ - -/* Entry point FRINFO is no longer error-free. Various frame */ -/* definition errors that were previously ignored are now */ -/* diagnosed. */ - -/* Entry point FRINFO has been updated to support specification */ -/* of frame center by name or ID code. Previously only ID codes */ -/* could be used to identify frame centers. */ - -/* - SPICELIB Version 3.1.0, 28-NOV-2002 (NJB) */ - -/* Bug fix: updated CNMFRM so a TK frame specified by name and */ -/* designated as an object's preferred frame via kernel pool */ -/* assignments is found, and so that the correct name of this */ -/* frame is returned. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame idcodes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - -/* Accompanying documentation is provided in the appendix */ -/* ``DSN Frames'' of the SPICE document FRAMES.REQ. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local parameters */ - - -/* Body name length. The value BDNMLN used here must be the */ -/* same as the value of MAXL defined in the INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36. */ - - -/* Frame name length. */ - - -/* Kernel variable name length. */ - - -/* Kernel variable buffer size. */ - - -/* Local Variables */ - - -/* Saved variables */ - -/* Because we need to save almost everything we save everything */ -/* rather than taking a chance and accidentally leaving something */ -/* off the list. */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_namfrm; - case 2: goto L_frmnam; - case 3: goto L_frinfo; - case 4: goto L_cidfrm; - case 5: goto L_cnmfrm; - case 6: goto L_ccifrm; - } - - chkin_("FRAMEX", (ftnlen)6); - setmsg_("A call has been made to the umbrella routine FRAMEX. This rout" - "ine doesn't do anything. It acts only as an umbrella routine fo" - "r its entry points. This call probably indicates a misunderstan" - "ding in programming. ", (ftnlen)212); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("FRAMEX", (ftnlen)6); - return 0; -/* $Procedure NAMFRM (Name to frame) */ - -L_namfrm: -/* $ Abstract */ - -/* Look up the frame id code associated with a 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 */ - -/* FRAMES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FRNAME */ -/* INTEGER FRCODE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRNAME I The name of some reference frame */ -/* FRCODE O The SPICE id code of the frame. */ - -/* $ Detailed_Input */ - -/* FRNAME is a character string that stands for some */ -/* reference frame (either inertial or non-inertial). */ - -/* Leading blanks in FRNAME are ignored. And the */ -/* case of the letters in FRNAME are insignificant. */ - -/* Note that all legitimate frame names contain */ -/* 32 or fewer characters. */ - -/* $ Detailed_Output */ - -/* FRCODE is the SPICE integer code used for internal */ -/* representation of the named reference frame. */ - -/* If the name input through FRNAME is not recognized */ -/* FRCODE will be returned with a value of zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input name is not recognized, FRCODE will be */ -/* returned with a value of 0. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a low level interface routine intended primarily for */ -/* use within the SPK and CK systems to assist in the transformation */ -/* to user specified reference frames. */ - -/* The routine first consults a stored list of reference frame */ -/* names in an attempt to determine the appropriate reference */ -/* frame code. */ - -/* If this search is unsuccessful, the routine then examines the */ -/* kernel pool to determine whether or not a variable of the */ -/* form */ - -/* 'FRAME_' // FRNAME */ - -/* (where leading blanks of FRNAME are ignored) */ - -/* is present. If it is and the number of values associated with the */ -/* name is 1, this value is taken to be the frame id code. */ - -/* Note: It is NOT possible to override the default names and */ -/* id codes stored locally in this routine by placing an */ -/* appropriately variable in the kernel pool with a different */ -/* id code. The predefined values always take precedence. */ - -/* Consult the FRAMES required reading document for more details */ -/* about constructing your own frame definitions. */ - -/* $ Examples */ - -/* Suppose that you needed to find the SPICE id code for the */ -/* bodyfixed reference frame for Mars as modeled by the */ -/* IAU cartographic working group. Use the following code */ -/* to perform this task. */ - -/* CALL NAMFRM ( 'IAU_MARS', FRCODE ) */ - -/* WRITE (*,*) 'The SPICE code for the Mars bodyfixed frame is: ', */ -/* . FRCODE. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.2, 17-MAR-2009 (EDW) */ - -/* Typo correction in Required_Reading, changed FRAME to FRAMES. */ - -/* - SPICELIB Version 3.0.1, 25-JUN-1999 (WLT) */ - -/* Extended documentation of entry point CNMFRM and */ -/* corrected example for that entry point. */ - -/* - SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) */ - -/* The entry points CIDFRM and CNMFRM were added so that */ -/* user's may determine the frame-id and name to associated */ -/* with a planetary object. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame idcodes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* The values NINERT and NNINRT are included instead of */ -/* being declared locally. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Frame name to frame idcode translation */ - -/* -& */ - *frcode = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("NAMFRM", (ftnlen)6); - -/* Perform any needed first pass initializations. */ - - if (first) { - first = FALSE_; - zzfdat_(&c__121, name__, idcode, center, type__, typeid, norder, - corder, centrd, (ftnlen)32); - } - -/* Determine the location of the requested item in the array */ -/* of names. */ - - ljust_(frname, pname, frname_len, (ftnlen)32); - ucase_(pname, pname, (ftnlen)32, (ftnlen)32); - item = bschoc_(pname, &c__121, name__, norder, (ftnlen)32, (ftnlen)32); - -/* If the name is in our list, we can just look up its idcode in */ -/* the parallel array. */ - - if (item > 0) { - *frcode = idcode[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : s_rnge( - "idcode", i__1, "framex_", (ftnlen)627)]; - } else { - -/* The items wasn't in the list, see if it's in the kernel pool. */ - - prefix_("FRAME_", &c__0, pname, (ftnlen)6, (ftnlen)32); - gipool_(pname, &c__1, &c__8, &n, values, &gotit, (ftnlen)32); - if (n == 1 && gotit) { - *frcode = values[0]; - } else { - *frcode = 0; - } - } - chkout_("NAMFRM", (ftnlen)6); - return 0; -/* $Procedure FRMNAM (Frame to Name) */ - -L_frmnam: -/* $ Abstract */ - -/* Retrieve the name of a reference frame associated with */ -/* a SPICE id code. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ - -/* INTEGER FRCODE */ -/* CHARACTER*(*) FRNAME */ - - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRCODE I an integer code for a reference frame */ -/* FRNAME O the name associated with the reference frame. */ - -/* $ Detailed_Input */ - -/* FRCODE is an integer code for a reference frame. */ - -/* $ Detailed_Output */ - -/* FRNAME is the name associated with the reference frame. */ -/* It will be returned left justified. */ - -/* If FRCODE is not recognized as the name of a */ -/* known reference frame FRNAME will be returned */ -/* as a blank. */ - -/* If FRNAME is not sufficiently long to hold the */ -/* name, it will be truncated on the right. */ - -/* All reference frame names are 32 or fewer characters */ -/* in length. Thus declaring FRNAME to be CHARACTER*(32) */ -/* will ensure that the returned name will not be */ -/* truncated. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If FRCODE is not recognized as the name of a */ -/* known reference frame FRNAME will be returned */ -/* as a blank. */ - -/* 2) If FRNAME is not sufficiently long to hold the */ -/* name, it will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine retrieves the name of a reference frame associated */ -/* with a SPICE frame id code. */ - -/* The id codes stored locally are scanned for a match with FRCODE. */ -/* If a match is found, the name stored locally will be returned */ -/* as the name for the frame. */ - -/* If FRCODE is not a member of the list of internally stored */ -/* id codes, the kernel pool will be examined to see if the */ -/* variable */ - -/* FRAME_idcode_NAME */ - -/* is present (where idcode is the decimal character equivalent */ -/* of FRCODE). If the variable is located and it has both */ -/* character type and dimension 1, the string value of the */ -/* kernel pool variable is returned as the name of the reference */ -/* frame. */ - -/* Note that because the local information is always examined */ -/* first and searches of the kernel pool are performed only */ -/* after exhausting local information, it is not possible to */ -/* override the local name for any reference frame that is */ -/* known by this routine. */ - -/* $ Examples */ - -/* Suppose you needed to create a message concerning a reference */ -/* frame and wish to use the name of the frame in the message. */ -/* Suppose further that you have only the frame id code at your */ -/* disposal. You can capture the frame name using this routine */ -/* as shown here. */ - -/* CHARACTER*(32) FRNAME */ - -/* CALL FRMNAM ( FRCODE, FRNAME ) */ - -/* IF ( FRNAME .EQ. ' ' ) THEN */ -/* CALL INTSTR ( FRCODE, FRNAME ) */ -/* END IF */ - -/* WRITE (*,*) 'Concerning reference frame:', FRNAME */ - -/* print the rest of your message. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.1, 25-JUN-1999 (WLT) */ - -/* Extended documentation of entry point CNMFRM and */ -/* corrected example for that entry point. */ - -/* - SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) */ - -/* The entry points CIDFRM and CNMFRM were added so that */ -/* user's may determine the frame-id and name to associated */ -/* with a planetary object. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame idcodes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* The values NINERT and NNINRT are included instead of */ -/* being declared locally. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Frame idcode to frame name translation */ - -/* -& */ - -/* Standard SPICE error handling. */ - - s_copy(frname, " ", frname_len, (ftnlen)1); - if (return_()) { - return 0; - } - chkin_("FRMNAM", (ftnlen)6); - -/* Perform any needed first pass initializations. */ - - if (first) { - first = FALSE_; - zzfdat_(&c__121, name__, idcode, center, type__, typeid, norder, - corder, centrd, (ftnlen)32); - } - item = bschoi_(frcode, &c__121, idcode, corder); - if (item != 0) { - s_copy(frname, name__ + (((i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 - : s_rnge("name", i__1, "framex_", (ftnlen)868)) << 5), - frname_len, (ftnlen)32); - } else { - s_copy(pname, "FRAME_#_NAME", (ftnlen)32, (ftnlen)12); - repmi_(pname, "#", frcode, pname, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gcpool_(pname, &c__1, &c__8, &n, line, &gotit, (ftnlen)32, (ftnlen)80) - ; - if (n == 1 && gotit) { - ljust_(line, frname, (ftnlen)80, frname_len); - } else { - s_copy(frname, " ", frname_len, (ftnlen)1); - } - } - chkout_("FRMNAM", (ftnlen)6); - return 0; -/* $Procedure FRINFO ( Frame Information ) */ - -L_frinfo: -/* $ Abstract */ - -/* Retrieve the minimal attributes associated with a frame */ -/* needed for converting transformations to and from it. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* INTEGER FRCODE */ -/* INTEGER CENT */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRCODE I the idcode for some frame */ -/* CENT O the center of the frame */ -/* CLASS O the class (type) of the frame */ -/* CLSSID O the idcode for the frame within its class. */ -/* FOUND O TRUE if the requested information is available. */ - -/* $ Detailed_Input */ - -/* FRCODE is the id code for some reference frame. */ - -/* $ Detailed_Output */ - -/* CENT is the body id code for the center of the reference */ -/* frame (if such an id code is appropriate). */ - -/* CLASS is the class or type of the frame. This identifies */ -/* which subsystem will be used to perform frame */ -/* transformations. */ - -/* CLSSID is the id-code used for the frame within its class. */ -/* This may be different from the frame id-code. */ - -/* FOUND is TRUE if CENT, CLASS and CCODE are available. */ -/* Otherwise, FOUND is returned with the value FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a frame definition is encountered that does not define */ -/* a central body for the frame, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 2) If a frame definition is encountered that does not define */ -/* a class for the frame, the error will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* 3) If a frame definition is encountered that does not define */ -/* a class ID for the frame, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 4) If a kernel variable defining a frame name is found, but */ -/* that variable has dimension greater than 1, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a low level routine needed by state transformation */ -/* software to transform states and attitudes between different */ -/* reference frames. */ - -/* The routine first examines local "hard-coded" information about */ -/* reference frames to see if the requested frame belongs to this */ -/* set. If it does that information is returned. */ - -/* If the requested information is not stored locally, the routine */ -/* then examines the kernel pool to see if the requested information */ -/* is stored there. If it is and has the expected format, the data */ -/* is retrieved and returned. */ - -/* $ Examples */ - -/* Suppose that you needed to determine the center of some */ -/* reference frame. The following code fragment illustrates */ -/* how to use this routine to determine this information. */ - -/* CALL FRINFO ( FRCODE, CENT, CLASS, CLSSID, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* WRITE (*,*) 'The center of reference frame ', FRCODE */ -/* WRITE (*,*) 'has body id code : ', CENT */ - -/* ELSE */ - -/* WRITE (*,*) 'There is insufficient data for frame ', FRCODE */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 12-SEP-2005 (NJB) */ - -/* Entry point FRINFO is no longer error-free. Various frame */ -/* definition errors that were previously ignored are now */ -/* diagnosed. */ - -/* Specification of frame center by name or ID is now supported. */ -/* Previously only ID codes could be used to identify frame */ -/* centers. Various frame definition errors that were previously */ -/* ignored are now diagnosed. */ - -/* - SPICELIB Version 3.1.0, 20-DEC-2004 (BVS) */ - -/* Removed special handling of the frame IDs less than -999. If */ -/* they cannot be ``resolved'' using kernel pool keywords, the */ -/* frame is NOT declared CK-based with center ID derived by */ -/* dividing frame ID by a 1000 and class ID assigned the frame ID */ -/* anymore. In the current practice with multitude of TK frames */ -/* with IDs set instrument IDs this default behavior is simply */ -/* not valid. */ - -/* - SPICELIB Version 3.0.1, 25-JUN-1999 (WLT) */ - -/* Extended documentation of entry point CNMFRM and */ -/* corrected example for that entry point. */ - -/* - SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) */ - -/* The entry points CIDFRM and CNMFRM were added so that */ -/* user's may determine the frame-id and name to associated */ -/* with a planetary object. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame idcodes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* The values NINERT and NNINRT are included instead of */ -/* being declared locally. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Fetch reference frame attributes */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 12-SEP-2005 (NJB) */ - -/* Entry point FRINFO is no longer error-free. */ -/* The following errors are now diagnosed: */ - -/* - Invalid dimension of frame name variable */ - -/* - If a valid frame name assignment is present: */ - -/* + Missing frame ID code assignment */ -/* + Missing class assignment */ -/* + Missing class ID assignment */ - -/* Specification of frame center by name or ID is now supported. */ -/* Previously only ID codes could be used to identify frame */ -/* centers. */ - - -/* - SPICELIB Version 3.1.0, 20-DEC-2004 (BVS) */ - -/* Removed special handling of the frame IDs less than -999. If */ -/* they cannot be ``resolved'' using kernel pool keywords, the */ -/* frame is NOT declared CK-based with center ID derived by */ -/* dividing frame ID by a 1000 and class ID assigned the frame ID */ -/* anymore. In the current practice with multitude of TK frames */ -/* with IDs set instrument IDs this default behavior is simply */ -/* not valid. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("FRINFO", (ftnlen)6); - -/* No frame information has been found yet. */ - - *found = FALSE_; - -/* Perform any needed first pass initializations. */ - - if (first) { - first = FALSE_; - zzfdat_(&c__121, name__, idcode, center, type__, typeid, norder, - corder, centrd, (ftnlen)32); - } - -/* Determine the location of the requested item in the array */ -/* of ID codes. */ - - item = bschoi_(frcode, &c__121, idcode, corder); - -/* If the name is in our list, we can just look up its ID code in */ -/* the parallel array. */ - - if (item > 0) { - *cent = center[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : s_rnge( - "center", i__1, "framex_", (ftnlen)1173)]; - *class__ = type__[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "framex_", (ftnlen)1174)]; - *clssid = typeid[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : s_rnge( - "typeid", i__1, "framex_", (ftnlen)1175)]; - *found = TRUE_; - } else { - -/* The frame ID wasn't in the list; see if the frame name */ -/* is in the kernel pool. */ - - s_copy(pname, "FRAME_#_NAME", (ftnlen)32, (ftnlen)12); - repmi_(pname, "#", frcode, pname, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gcpool_(pname, &c__1, &c__8, &n, line, &gotit, (ftnlen)32, (ftnlen)80) - ; - if (gotit) { - if (n > 1) { - -/* We have an array-valued variable that looks like */ -/* a frame name. We consider this an error. */ - - setmsg_("Kernel variable # is array-valued; Frame name varia" - "bles must be scalar-valued.", (ftnlen)78); - errch_("#", pname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("FRINFO", (ftnlen)6); - return 0; - } - ljust_(line, lcfram, (ftnlen)80, (ftnlen)32); - -/* Start by looking up the central body of the frame. The name */ -/* of the kernel variable for the body could refer to the */ -/* frame by name or frame ID; the body itself could be */ -/* specified by name or body ID. */ - - zzdynbid_(lcfram, frcode, "CENTER", cent, (ftnlen)32, (ftnlen)6); - if (failed_()) { - chkout_("FRINFO", (ftnlen)6); - return 0; - } - *found = TRUE_; - -/* FOUND has been set to indicate whether we found the frame's */ -/* center. If we did, CENT has been assigned. */ - -/* Next look up the frame class and class ID. */ - - zzdynvai_(lcfram, frcode, "CLASS", &c__1, &n, values, (ftnlen)32, - (ftnlen)5); - *class__ = values[0]; - zzdynvai_(lcfram, frcode, "CLASS_ID", &c__1, &n, values, (ftnlen) - 32, (ftnlen)8); - *clssid = values[0]; - if (failed_()) { - chkout_("FRINFO", (ftnlen)6); - return 0; - } - } - -/* In support of the DSN, NAIF has reserved a block of */ -/* ID-codes for DSN specific frames from 13000 to 13999. */ -/* These are always PCK based frames for the earth. */ -/* The PCK ID code is just FRCODE - 10000. */ - - if (! (*found) && *frcode >= 13000 && *frcode < 14000) { - *cent = 399; - *class__ = 2; - *clssid = *frcode - 10000; - *found = TRUE_; - } - } - chkout_("FRINFO", (ftnlen)6); - return 0; -/* $Procedure CIDFRM ( center SPK id frame ) */ - -L_cidfrm: -/* $ Abstract */ - -/* Retrieve frame ID code and name to associate with a frame center. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* INTEGER CENT */ -/* INTEGER FRCODE */ -/* CHARACTER*(*) FRNAME */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CENT I an object to associate a frame with. */ -/* FRCODE O the ID code of the frame associated with CENT */ -/* FRNAME O the name of the frame with id FRCODE */ -/* FOUND O TRUE if the requested information is available. */ - -/* $ Detailed_Input */ - -/* CENT is the id code for object for which there is a */ -/* preferred reference frame. */ - -/* $ Detailed_Output */ - -/* FRCODE is the frame id-code to associate with a the object */ -/* specified by CENT. */ - -/* FRNAME is the name of the frame that should be associated */ -/* with the object specified by CNAME. FRNAME should be */ -/* declared as CHARACTER*(32) to ensure that it can */ -/* contain the full name of the frame. If FRNAME does */ -/* not have enough room to hold the full name of the */ -/* frame, the name will be truncated on the right. */ - -/* FOUND is TRUE if the appropriate frame id-code and frame */ -/* name can be determined. Otherwise FOUND is returned */ -/* with the value FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If FRNAME is not have room to contain the frame name, the name */ -/* will be truncated on the right. ( Declaring FRNAME to be */ -/* CHARACTER*(32) will ensure that the name will not be */ -/* truncated. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows the user to determine the frame that should */ -/* be associated with a particular object. For example, if you */ -/* need the frame to associate with the Io, you can call CIDFRM */ -/* to determine the frame name and id-code for the bodyfixed frame */ -/* of Io. */ - -/* The preferred frame to use with an object is specified via one */ -/* of the kernel pool variables: */ - -/* OBJECT__FRAME */ - -/* where is the decimal representation of the integer CENT. */ - -/* For those PCK objects that have "built-in" frame names this */ -/* routine returns the corresponding "IAU" frame and frame ID code. */ - -/* $ Examples */ - -/* Suppose that you want to determine the state of a target */ -/* in the preferred reference frame of some observer. This */ -/* routine can be used in conjunction with SPKEZ to compute */ -/* the state. */ - -/* CALL CIDFRM ( OBS, FRCODE, FRNAME, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* WRITE (*,*) 'The bodyfixed frame for object ', OBS */ -/* WRITE (*,*) 'could not be identified.' */ -/* STOP */ - -/* END IF */ - -/* CALL SPKEZ ( TARG, ET, FRNAME, ABCORR, OBS, STATE, LT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.1, 25-JUN-1999 (WLT) */ - -/* Extended documentation of entry point CNMFRM and */ -/* corrected example for that entry point. */ - -/* - SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) */ - -/* The entry points CIDFRM and CNMFRM were added so that */ -/* user's may determine the frame-id and name to associated */ -/* with a planetary object. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame ID codes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* The values NINERT and NNINRT are included instead of */ -/* being declared locally. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find the bodyfixed frame associated with an object */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CIDFRM", (ftnlen)6); - -/* Perform any needed first pass initializations. */ - - if (first) { - first = FALSE_; - zzfdat_(&c__121, name__, idcode, center, type__, typeid, norder, - corder, centrd, (ftnlen)32); - } - -/* First look up in the kernel pool the frame associated with this */ -/* center. */ - - s_copy(lookup, "OBJECT_#_FRAME", (ftnlen)32, (ftnlen)14); - repmi_(lookup, "#", cent, lookup, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(lookup, &gotit, &n, dattyp, (ftnlen)32, (ftnlen)1); - -/* If we didn't find this object in the form OBJECT__FRAME */ -/* maybe it is present in the form OBJECT__FRAME. It's */ -/* worth a try. */ - - if (! gotit) { - -/* See if we can get the name for this center's id-code. */ - - bodc2n_(cent, lcname, &gotit, (ftnlen)36); - if (gotit) { - -/* Construct and look up the alternative name in the */ -/* kernel pool. */ - - s_copy(lookup, "OBJECT_#_FRAME", (ftnlen)32, (ftnlen)14); - repmc_(lookup, "#", lcname, lookup, (ftnlen)32, (ftnlen)1, ( - ftnlen)36, (ftnlen)32); - ucase_(lookup, lookup, (ftnlen)32, (ftnlen)32); - dtpool_(lookup, &gotit, &n, dattyp, (ftnlen)32, (ftnlen)1); - } - } - -/* There are two cases. The user may specify either a name */ -/* or id-code for the frame to use to model the orientation of */ -/* an object. We assume they'll opt for the character string */ -/* form so we test that case first. */ - - if (gotit) { - if (*(unsigned char *)dattyp == 'C') { - gcpool_(lookup, &c__1, &c__1, &n, pname, &gotit, (ftnlen)32, ( - ftnlen)32); - -/* We've got the name: See if we have this in our handy list */ -/* of built-in names. */ - - item = bschoc_(pname, &c__121, name__, norder, (ftnlen)32, ( - ftnlen)32); - if (item > 0) { - s_copy(frname, pname, frname_len, (ftnlen)32); - *frcode = idcode[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : - s_rnge("idcode", i__1, "framex_", (ftnlen)1517)]; - *found = TRUE_; - } else { - -/* Nope. look in the kernel pool for the data associated */ -/* with this frame. */ - - s_copy(frname, pname, frname_len, (ftnlen)32); - prefix_("FRAME_", &c__0, pname, (ftnlen)6, (ftnlen)32); - gipool_(pname, &c__1, &c__8, &n, values, &gotit, (ftnlen)32); - if (n == 1 && gotit) { - *frcode = values[0]; - *found = TRUE_; - } else { - *frcode = 0; - s_copy(frname, " ", frname_len, (ftnlen)1); - *found = FALSE_; - } - } - } else if (*(unsigned char *)dattyp == 'N') { - -/* Ok. They decided to use the numeric form to specify */ -/* the frame id. We need to figure out the name of the frame. */ -/* First we retrieve the frame id they've loaded into the */ -/* kernel pool. */ - - gipool_(lookup, &c__1, &c__1, &n, values, &gotit, (ftnlen)32); - -/* We've got the frame ID, see if we already know about this */ -/* id-code. */ - - item = bschoi_(values, &c__121, center, centrd); - if (item != 0) { - -/* Just look up the name and set the frame code. */ - - s_copy(frname, name__ + (((i__1 = item - 1) < 121 && 0 <= - i__1 ? i__1 : s_rnge("name", i__1, "framex_", (ftnlen) - 1565)) << 5), frname_len, (ftnlen)32); - *frcode = values[0]; - *found = TRUE_; - } else { - -/* Hmmm. Not on the built-in list. See if it's in the */ -/* kernel pool somewhere. */ - - s_copy(pname, "FRAME_#_NAME", (ftnlen)32, (ftnlen)12); - repmi_(pname, "#", values, pname, (ftnlen)32, (ftnlen)1, ( - ftnlen)32); - gcpool_(pname, &c__1, &c__8, &n, line, &gotit, (ftnlen)32, ( - ftnlen)80); - if (n == 1 && gotit) { - ljust_(line, frname, (ftnlen)80, frname_len); - *frcode = values[0]; - *found = TRUE_; - } else { - *frcode = values[0]; - s_copy(frname, " ", frname_len, (ftnlen)1); - *found = FALSE_; - } - } - } - -/* One way or the other we've filled in the values at this */ -/* point. Nothing left to do but check out and return. */ - - chkout_("CIDFRM", (ftnlen)6); - return 0; - } - -/* The only way to reach this point is if the user did not */ -/* specify via the kernel pool a frame to use for this center. */ - -/* We have a special case for EARTH. */ - - if (*cent == 399) { - *frcode = 10013; - s_copy(frname, "IAU_EARTH", frname_len, (ftnlen)9); - *found = TRUE_; - chkout_("CIDFRM", (ftnlen)6); - return 0; - } - -/* Determine the location of the requested item in the array */ -/* of centers. */ - - item = bschoi_(cent, &c__121, center, centrd); - -/* If the name is in our list, we can just look up its ID code and */ -/* name in the parallel array. */ - - if (item > 0) { - *frcode = idcode[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : s_rnge( - "idcode", i__1, "framex_", (ftnlen)1632)]; - s_copy(frname, name__ + (((i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 - : s_rnge("name", i__1, "framex_", (ftnlen)1633)) << 5), - frname_len, (ftnlen)32); - *found = TRUE_; - } else { - -/* There's nothing we can do now. We don't know what frame */ -/* might be associated with this object. */ - - s_copy(frname, " ", frname_len, (ftnlen)1); - *frcode = 0; - *found = FALSE_; - } - chkout_("CIDFRM", (ftnlen)6); - return 0; -/* $Procedure CNMFRM ( Center name to associated frame ) */ - -L_cnmfrm: -/* $ Abstract */ - -/* Retrieve frame ID code and name to associate with an object. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) CNAME */ -/* INTEGER FRCODE */ -/* CHARACTER*(*) FRNAME */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CNAME I name of the object to find a frame for */ -/* FRCODE O the ID code of the frame associated with CNAME */ -/* FRNAME O the name of the frame with id FRCODE */ -/* FOUND O TRUE if the requested information is available. */ - -/* $ Detailed_Input */ - -/* CNAME is the name for object for which there is a */ -/* preferred reference frame */ - -/* $ Detailed_Output */ - -/* FRCODE is the frame id-code to associate with a the object */ -/* specified by CNAME. */ - -/* FRNAME is the name of the frame that should be associated */ -/* with the object specified by CNAME. FRNAME should be */ -/* declared as CHARACTER*(32) to ensure that it can */ -/* contain the full name of the frame. If FRNAME does */ -/* not have enough room to hold the full name of the */ -/* frame, the name will be truncated on the right. */ - -/* FOUND is TRUE if the appropriate frame id-code and frame */ -/* name can be determined. Otherwise FOUND is returned */ -/* with the value FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If FRNAME is not have room to contain the frame name, the name */ -/* will be truncated on the right. ( Declaring FRNAME to be */ -/* CHARACTER*(32) will ensure that the name will not be */ -/* truncated. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows the user to determine the frame that should */ -/* be associated with a particular object. For example, if you */ -/* need the frame to associate with the Io, you can call CNMFRM */ -/* to determine the frame name and id-code for the bodyfixed frame */ -/* of Io. */ - -/* The preferred frame to use with an object is specified via one */ -/* of the kernel pool variables: */ - -/* OBJECT__FRAME */ - -/* where is the non-blank portion of the string CNAME. */ - -/* For those PCK objects that have "built-in" frame names this */ -/* routine returns the corresponding "IAU" frame and frame ID code. */ - -/* $ Examples */ - -/* Suppose that you want to determine the state of a target */ -/* in the preferred reference frame of some observer. This */ -/* routine can be used in conjunction with SPKEZR to compute */ -/* the state. */ - -/* CALL CNMFRM ( OBSNAM, FRCODE, FRNAME, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* WRITE (*,*) 'The bodyfixed frame for object ', OBSNAM */ -/* WRITE (*,*) 'could not be identified.' */ -/* STOP */ - -/* END IF */ - -/* CALL SPKEZR ( TARGET, ET, FRNAME, ABCORR, OBSNAM, STATE, LT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.0, 28-NOV-2002 (NJB) */ - -/* Bug fix: updated this routine so a TK frame specified by name */ -/* and designated as an object's preferred frame via kernel pool */ -/* assignments is found, and so that the correct name of this */ -/* frame is returned. */ - -/* - SPICELIB Version 3.0.1, 25-JUN-1999 (WLT) */ - -/* Extended documentation of entry point CNMFRM and */ -/* corrected example for that entry point. */ - -/* - SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) */ - -/* The entry points CIDFRM and CNMFRM were added so that */ -/* user's may determine the frame-id and name to associated */ -/* with a planetary object. */ - -/* - SPICELIB Version 2.0.0, 04-APR-1997 (WLT) */ - -/* The routine was upgraded to reflect that a block of */ -/* frame ID codes have been reserved for use by the DSN. */ -/* Id-codes 13001 to 13999 have been set aside for DSN */ -/* models for the orientation of the earth. These frames */ -/* are all PCK frames. Moreover, the PCK id-code to */ -/* use with these frames is simply the Frame-Code minus 10000. */ -/* All of these frames are centered at the earth (body 399). */ - - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* The values NINERT and NNINRT are included instead of */ -/* being declared locally. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find the bodyfixed frame associated with an object */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.1.0, 28-NOV-2002 (NJB) */ - -/* Bug fix: updated this routine so a TK frame specified by name */ -/* and designated as an object's preferred frame via kernel pool */ -/* assignments is found, and so that the correct name of this */ -/* frame is returned. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CNMFRM", (ftnlen)6); - -/* Perform any needed first pass initializations. */ - - if (first) { - first = FALSE_; - zzfdat_(&c__121, name__, idcode, center, type__, typeid, norder, - corder, centrd, (ftnlen)32); - } - -/* First look up in the kernel pool the frame associated with this */ -/* center. */ - - s_copy(lookup, "OBJECT_#_FRAME", (ftnlen)32, (ftnlen)14); - repmc_(lookup, "#", cname, lookup, (ftnlen)32, (ftnlen)1, cname_len, ( - ftnlen)32); - ucase_(lookup, lookup, (ftnlen)32, (ftnlen)32); - dtpool_(lookup, &gotit, &n, dattyp, (ftnlen)32, (ftnlen)1); - -/* If we didn't find this object in the form OBJECT__FRAME */ -/* maybe it is present in the form OBJECT__FRAME. It's */ -/* worth a try. */ - - if (! gotit) { - -/* See if we can get the name for this center's id-code. */ - - bodn2c_(cname, &id, &gotit, cname_len); - if (gotit) { - -/* Construct and look up the alternative name in the */ -/* kernel pool. */ - - s_copy(lookup, "OBJECT_#_FRAME", (ftnlen)32, (ftnlen)14); - repmi_(lookup, "#", &id, lookup, (ftnlen)32, (ftnlen)1, (ftnlen) - 32); - dtpool_(lookup, &gotit, &n, dattyp, (ftnlen)32, (ftnlen)1); - } - } - -/* There are two cases. The user may specify either a name */ -/* or id-code for the frame to use to model the orientation of */ -/* an object. We assume they'll opt for the character string */ -/* form so we test that case first. */ - - if (gotit) { - if (*(unsigned char *)dattyp == 'C') { - gcpool_(lookup, &c__1, &c__1, &n, pname, &gotit, (ftnlen)32, ( - ftnlen)32); - -/* We've got the name: See if we have this in our handy list */ -/* of built-in names. */ - - item = bschoc_(pname, &c__121, name__, norder, (ftnlen)32, ( - ftnlen)32); - if (item > 0) { - s_copy(frname, pname, frname_len, (ftnlen)32); - *frcode = idcode[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : - s_rnge("idcode", i__1, "framex_", (ftnlen)1926)]; - *found = TRUE_; - } else { - -/* Nope. look in the kernel pool for the data associated */ -/* with this frame. */ - -/* Capture the frame name now, since we're going to modify */ -/* PNAME. */ - - s_copy(frname, pname, frname_len, (ftnlen)32); - prefix_("FRAME_", &c__0, pname, (ftnlen)6, (ftnlen)32); - gipool_(pname, &c__1, &c__8, &n, values, &gotit, (ftnlen)32); - if (n == 1 && gotit) { - *frcode = values[0]; - *found = TRUE_; - } else { - *frcode = 0; - s_copy(frname, " ", frname_len, (ftnlen)1); - *found = FALSE_; - } - } - } else if (*(unsigned char *)dattyp == 'N') { - -/* Ok. They decided to use the numeric form to specify */ -/* the frame id. We need to figure out the name of the frame. */ -/* First we retrieve the frame id they've loaded into the */ -/* kernel pool. */ - - gipool_(lookup, &c__1, &c__1, &n, values, &gotit, (ftnlen)32); - -/* We've got the frame ID, see if we already know about this */ -/* id-code. */ - - item = bschoi_(values, &c__121, idcode, corder); - if (item != 0) { - -/* Just look up the name and set the frame code. */ - - s_copy(frname, name__ + (((i__1 = item - 1) < 121 && 0 <= - i__1 ? i__1 : s_rnge("name", i__1, "framex_", (ftnlen) - 1977)) << 5), frname_len, (ftnlen)32); - *frcode = values[0]; - *found = TRUE_; - } else { - -/* Hmmm. Not on the built-in list. See if it's in the */ -/* kernel pool somewhere. */ - - s_copy(pname, "FRAME_#_NAME", (ftnlen)32, (ftnlen)12); - repmi_(pname, "#", values, pname, (ftnlen)32, (ftnlen)1, ( - ftnlen)32); - gcpool_(pname, &c__1, &c__8, &n, line, &gotit, (ftnlen)32, ( - ftnlen)80); - if (n == 1 && gotit) { - ljust_(line, frname, (ftnlen)80, frname_len); - *frcode = values[0]; - *found = TRUE_; - } else { - *frcode = values[0]; - s_copy(frname, " ", frname_len, (ftnlen)1); - *found = FALSE_; - } - } - } - -/* One way or the other we've filled in the values at this */ -/* point. Nothing left to do but check out and return. */ - - chkout_("CNMFRM", (ftnlen)6); - return 0; - } - -/* The only way to reach this point is if the user did not */ -/* specify via the kernel pool a frame to use for this center. */ - - - s_copy(frname, "IAU_#", frname_len, (ftnlen)5); - repmc_(frname, "#", cname, frname, frname_len, (ftnlen)1, cname_len, - frname_len); - ucase_(frname, frname, frname_len, frname_len); - -/* Determine the location of the requested item in the array */ -/* of centers. */ - - item = bschoc_(frname, &c__121, name__, norder, frname_len, (ftnlen)32); - -/* If the name is in our list, we can just look up its ID code and */ -/* name in the parallel array. */ - - if (item > 0) { - *frcode = idcode[(i__1 = item - 1) < 121 && 0 <= i__1 ? i__1 : s_rnge( - "idcode", i__1, "framex_", (ftnlen)2038)]; - *found = TRUE_; - } else { - -/* There's nothing we can do now. We don't know what frame */ -/* might be associated with this object. */ - - *frcode = 0; - *found = FALSE_; - } - chkout_("CNMFRM", (ftnlen)6); - return 0; -/* $Procedure CCIFRM ( Class and class ID to associated frame ) */ - -L_ccifrm: -/* $ Abstract */ - -/* Return the frame name, frame ID, and center associated with */ -/* a given frame class and class ID. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* FRAMES */ - -/* $ Declarations */ - -/* INTEGER CLASS */ -/* INTEGER CLSSID */ -/* INTEGER FRCODE */ -/* CHARACTER*(*) FRNAME */ -/* INTEGER CENT */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CLASS I Class of frame. */ -/* CLSSID I Class ID of frame. */ -/* FRCODE O ID code of the frame identified by CLASS, CLSSID. */ -/* FRNAME O Name of the frame identified by CLASS, CLSSID. */ -/* CENT O Center of the frame identified by CLASS, CLSSID. */ -/* FOUND O TRUE if the requested information is available. */ - -/* $ Detailed_Input */ - -/* CLASS is the class or type of the frame. This identifies */ -/* which subsystem will be used to perform frame */ -/* transformations. */ - -/* CLSSID is the ID code used for the frame within its class. */ -/* This may be different from the frame ID code. */ - -/* $ Detailed_Output */ - -/* FRCODE is the frame ID code for the reference frame */ -/* identified by CLASS and CLSSID. */ - -/* FRNAME is the name of the frame identified by CLASS and */ -/* CLSSID. FRNAME should be declared as CHARACTER*(32) */ -/* to ensure that it can contain the full name of the */ -/* frame. If FRNAME does not have enough room to hold */ -/* the full name of the frame, the name will be */ -/* truncated on the right. */ - -/* CENT is the body ID code for the center of the reference */ -/* frame identified by CLASS and CLSSID. */ - -/* FOUND is .TRUE. if FRCODE, FRNAME, and CENT are available. */ -/* Otherwise, FOUND is returned with the value .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that the first frame found with matching */ -/* class and class ID is the correct one. SPICE's frame system */ -/* does not diagnose the situation where there are multiple, */ -/* distinct frames with matching classes and class ID codes, but */ -/* this situation could occur if such conflicting frame */ -/* specifications are loaded via one or more frame kernels. The */ -/* user is responsible for avoiding such frame specification */ -/* conflicts. */ - -/* 2) If FRNAME does not have room to contain the frame name, the */ -/* name will be truncated on the right. ( Declaring FRNAME to be */ -/* CHARACTER*(32) will ensure that the name will not be */ -/* truncated. */ - -/* 3) If a frame class assignment is found that associates a */ -/* string (as opposed to numeric) value with a frame class */ -/* keyword, the error SPICE(INVALIDFRAMEDEF) will be signaled. */ - -/* 4) If a frame class assignment is found that matches the input */ -/* class, but a corresponding class ID assignment is not */ -/* found in the kernel pool, the error SPICE(INVALIDFRAMEDEF) */ -/* will be signaled. */ - -/* 5) If a frame specification is found in the kernel pool with */ -/* matching frame class and class ID, but either the frame name */ -/* or frame ID code are not found, the error */ -/* SPICE(INVALIDFRAMEDEF) will be signaled. */ - -/* 6) If a frame specification is found in the kernel pool with */ -/* matching frame class and class ID, but the frame center */ -/* is not found, the error will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows the user to determine the frame associated */ -/* with a given frame class and class ID code. The kernel pool is */ -/* searched first for a matching frame; if no match is found, then */ -/* the set of built-in frames is searched. */ - -/* Since the neither the frame class nor the class ID are primary */ -/* keys, searching for matching frames is a linear (and therefore */ -/* typically slow) process. */ - -/* $ Examples */ - -/* Suppose that you want to find the name of a frame associated */ -/* with a PCK class ID, such as that found in a binary PCK. */ -/* One could use the following code fragment: */ - -/* CALL CCIFRM ( 2, CLSSID, FRCODE, FRNAME, CENT, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* WRITE (*,*) 'The PCK frame for class ID ', CLSSID */ -/* WRITE (*,*) 'could not be identified.' */ -/* STOP */ - -/* END IF */ - -/* WRITE (*,*) 'The PCK frame having class ID ', CLSSID, ' is ' */ -/* WRITE (*,*) FRNAME */ - -/* $ Restrictions */ - -/* See item (1) in the Exceptions section above. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-NOV-2007 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find info associated with a frame class and class id */ -/* Map frame class and class id to frame info */ -/* Map frame class and class id to frame name, id, and center */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("CCIFRM", (ftnlen)6); - -/* No frame found so far. */ - - *found = FALSE_; - -/* Perform any needed first pass initializations. */ - - if (first) { - first = FALSE_; - zzfdat_(&c__121, name__, idcode, center, type__, typeid, norder, - corder, centrd, (ftnlen)32); - } - -/* First try to look up from the kernel pool the frame associated */ -/* with the input class and class ID. Since neither of these input */ -/* values appears in a kernel variable name, we may have to look at */ -/* all of the frame specifications in the kernel pool. Start out by */ -/* looking the frame class assignments from any loaded frame */ -/* specifications. */ - - s_copy(lookup, "FRAME_*_CLASS", (ftnlen)32, (ftnlen)13); - start = 1; - gnpool_(lookup, &start, &c__100, &n, kvbuff, &fnd, (ftnlen)32, (ftnlen)32) - ; - while(fnd && n > 0) { - -/* For each kernel variable name found in the buffer, look up the */ -/* associated class. If the class matches the input class, look */ -/* up the class ID as well. Set the output arguments and return */ -/* if we get a complete match. */ - - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - gipool_(kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("kvbuff", i__2, "framex_", (ftnlen)2293)) << 5), & - c__1, &c__1, &n, &kvclss, &fnd, (ftnlen)32); - if (! fnd) { - setmsg_("Invalid frame specification found in kernel pool: f" - "rame class keyword is # but integer class was not as" - "sociated with this keyword.", (ftnlen)130); - errch_("#", kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("kvbuff", i__2, "framex_", (ftnlen)2301) - ) << 5), (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(INVALIDFRAMEDEF)", (ftnlen)22); - chkout_("CCIFRM", (ftnlen)6); - return 0; - } - if (kvclss == *class__) { - -/* Get the class ID for the current frame. */ - - s_copy(look2, kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("kvbuff", i__2, "framex_", (ftnlen) - 2312)) << 5), (ftnlen)32, (ftnlen)32); - suffix_("_ID", &c__0, look2, (ftnlen)3, (ftnlen)32); - gipool_(look2, &c__1, &c__1, &n, &kvclid, &fnd, (ftnlen)32); - if (! fnd) { - setmsg_("Invalid frame specification found in kernel poo" - "l: frame class keyword is # but associated integ" - "er class ID assignment was not found.", (ftnlen) - 132); - errch_("#", kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("kvbuff", i__2, "framex_", ( - ftnlen)2325)) << 5), (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(INVALIDFRAMEDEF)", (ftnlen)22); - chkout_("CCIFRM", (ftnlen)6); - return 0; - } - -/* Check the class ID for the current kernel variable */ -/* against the input value. */ - - if (kvclid == *clssid) { - -/* We have a match. We need to return the frame */ -/* ID, frame name, and center. As long as we're */ -/* looking at a valid frame specification, this is */ -/* no problem. */ - -/* Look up the frame name first. Create the frame */ -/* name keyword. */ - - repmc_(kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("kvbuff", i__2, "framex_", (ftnlen) - 2346)) << 5), "_CLASS", "_NAME", look2, (ftnlen) - 32, (ftnlen)6, (ftnlen)5, (ftnlen)32); - gcpool_(look2, &c__1, &c__1, &n, frname, &fnd, (ftnlen)32, - frname_len); - if (! fnd) { - setmsg_("Invalid frame specification found in kernel" - " pool: frame class keyword is # but associat" - "ed frame name assignment was not found.", ( - ftnlen)126); - errch_("#", kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("kvbuff", i__2, "framex_" - , (ftnlen)2356)) << 5), (ftnlen)1, (ftnlen)32) - ; - sigerr_("SPICE(INVALIDFRAMEDEF)", (ftnlen)22); - chkout_("CCIFRM", (ftnlen)6); - return 0; - } - -/* We could extract the frame ID code from KVBUFF(I), but */ -/* instead we'll make sure that the ID is defined in the */ -/* kernel pool. */ - - s_copy(look2, frname, (ftnlen)32, frname_len); - prefix_("FRAME_", &c__0, look2, (ftnlen)6, (ftnlen)32); - gipool_(look2, &c__1, &c__1, &n, frcode, &fnd, (ftnlen)32) - ; - if (! fnd) { - setmsg_("Invalid frame specification found in kernel" - " pool: frame name is is # but associated fra" - "me ID assignment was not found.", (ftnlen)118) - ; - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(INVALIDFRAMEDEF)", (ftnlen)22); - chkout_("CCIFRM", (ftnlen)6); - return 0; - } - -/* Look up the frame center. Whether the frame center */ -/* has been specified by name or ID code, the ID code */ -/* will be returned by ZZDYNBID. */ - - zzdynbid_(frname, frcode, "CENTER", cent, frname_len, ( - ftnlen)6); - -/* As long as we looked up the center successfully, */ -/* we're done. */ - - if (! failed_()) { - *found = TRUE_; - } - -/* Exit here, whether or not we looked up the frame's */ -/* center succesfully. */ - - chkout_("CCIFRM", (ftnlen)6); - return 0; - } - } - -/* Getting to this point means we didn't have a match; */ -/* examine the next buffer entry. */ - - } - -/* Get the next buffer full of frame class keywords. */ - - start += n; - gnpool_(lookup, &start, &c__100, &n, kvbuff, &fnd, (ftnlen)32, ( - ftnlen)32); - } - -/* Getting to this point means we didn't find a matching */ -/* frame specification in the kernel pool. Check the built-in */ -/* frame list. Unfortunately, this is a linear search. */ - - for (i__ = 1; i__ <= 121; ++i__) { - if (type__[(i__1 = i__ - 1) < 121 && 0 <= i__1 ? i__1 : s_rnge("type", - i__1, "framex_", (ftnlen)2434)] == *class__ && typeid[(i__2 = - i__ - 1) < 121 && 0 <= i__2 ? i__2 : s_rnge("typeid", i__2, - "framex_", (ftnlen)2434)] == *clssid) { - -/* We have a match. Assign the output arguments and return. */ - - s_copy(frname, name__ + (((i__1 = i__ - 1) < 121 && 0 <= i__1 ? - i__1 : s_rnge("name", i__1, "framex_", (ftnlen)2439)) << - 5), frname_len, (ftnlen)32); - *frcode = idcode[(i__1 = i__ - 1) < 121 && 0 <= i__1 ? i__1 : - s_rnge("idcode", i__1, "framex_", (ftnlen)2440)]; - *cent = center[(i__1 = i__ - 1) < 121 && 0 <= i__1 ? i__1 : - s_rnge("center", i__1, "framex_", (ftnlen)2441)]; - *found = TRUE_; - chkout_("CCIFRM", (ftnlen)6); - return 0; - } - } - -/* We drop down to this point only if no matching frame was found. */ -/* The FOUND flag has already been set to .FALSE. */ - - chkout_("CCIFRM", (ftnlen)6); - return 0; -} /* framex_ */ - -/* Subroutine */ int framex_(char *cname, char *frname, integer *frcode, - integer *cent, integer *class__, integer *clssid, logical *found, - ftnlen cname_len, ftnlen frname_len) -{ - return framex_0_(0, cname, frname, frcode, cent, class__, clssid, found, - cname_len, frname_len); - } - -/* Subroutine */ int namfrm_(char *frname, integer *frcode, ftnlen frname_len) -{ - return framex_0_(1, (char *)0, frname, frcode, (integer *)0, (integer *)0, - (integer *)0, (logical *)0, (ftnint)0, frname_len); - } - -/* Subroutine */ int frmnam_(integer *frcode, char *frname, ftnlen frname_len) -{ - return framex_0_(2, (char *)0, frname, frcode, (integer *)0, (integer *)0, - (integer *)0, (logical *)0, (ftnint)0, frname_len); - } - -/* Subroutine */ int frinfo_(integer *frcode, integer *cent, integer *class__, - integer *clssid, logical *found) -{ - return framex_0_(3, (char *)0, (char *)0, frcode, cent, class__, clssid, - found, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int cidfrm_(integer *cent, integer *frcode, char *frname, - logical *found, ftnlen frname_len) -{ - return framex_0_(4, (char *)0, frname, frcode, cent, (integer *)0, ( - integer *)0, found, (ftnint)0, frname_len); - } - -/* Subroutine */ int cnmfrm_(char *cname, integer *frcode, char *frname, - logical *found, ftnlen cname_len, ftnlen frname_len) -{ - return framex_0_(5, cname, frname, frcode, (integer *)0, (integer *)0, ( - integer *)0, found, cname_len, frname_len); - } - -/* Subroutine */ int ccifrm_(integer *class__, integer *clssid, integer * - frcode, char *frname, integer *cent, logical *found, ftnlen - frname_len) -{ - return framex_0_(6, (char *)0, frname, frcode, cent, class__, clssid, - found, (ftnint)0, frname_len); - } - diff --git a/ext/spice/src/cspice/frinfo_c.c b/ext/spice/src/cspice/frinfo_c.c deleted file mode 100644 index 0ca660845f..0000000000 --- a/ext/spice/src/cspice/frinfo_c.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - --Procedure frinfo_c ( Frame Information ) - --Abstract - - Retrieve the minimal attributes associated with a frame - needed for converting transformations to and from it. - --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 - - FRAMES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void frinfo_c ( SpiceInt frcode, - SpiceInt *cent, - SpiceInt *frclss, - SpiceInt *clssid, - SpiceBoolean *found ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - frcode I the idcode for some frame - cent O the center of the frame - frclss O the class (type) of the frame - clssid O the idcode for the frame within its class. - found O SPICETRUE if the requested information is available. - --Detailed_Input - - frcode is the ID code for some reference frame. - --Detailed_Output - - cent is the body ID code for the center of the reference - frame (if such an ID code is appropriate). - - frclss is the class or type of the frame. This identifies - which subsystem will be used to perform frame - transformations. - - clssid is the ID-code used for the frame within its class. - This may be different from the frame ID-code. - - found is SPICETRUE if cent, frclss and frcode are available. - Otherwise, found is returned with the value SPICEFALSE. - --Parameters - - None. - --Files - - None. - --Exceptions - - None. - --Particulars - - This is a low level routine needed by state transformation - software to transform states and attitudes between different - reference frames. - - The routine first examines local "hard-coded" information about - reference frames to see if the requested frame belongs to this - set. If it does that information is returned. - - If the requested information is not stored locally, the routine - then examines the kernel pool to see if the requested information - is stored there. If it is and has the expected format, the data - is retrieved and returned. - --Examples - - Suppose that you needed to determine the center of some - reference frame. The following code fragment illustrates - how to use this routine to determine this information. - - frinfo_c ( frcode, ¢, &frclss, &clssid, &found ); - - if ( found ) - { - printf ( "The center of reference frame %\n" - "has body ID code: %d\n", - frcode, - cent ); - } - else - { - printf ( "There is insufficient data for frame %s\n", frcode ); - } - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.2.0, 22-JUL-1999 (NJB) - - Now uses logical local variable for found flag. - - -CSPICE Version 1.1.0, 16-MAY-1999 (NJB) - - Changed name of argument "class" to frclss for C++ - compatibility. - - -CSPICE Version 1.0.0, 21-JUN-1998 (NJB) (WLT) - - Based on SPICELIB Version 3.0.0, 03-JUN-1997 (WLT) - --Index_Entries - - Fetch reference frame attributes - --& -*/ - -{ /* Begin frinfo_c */ - - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "frinfo_c" ); - - - frinfo_ ( ( integer * ) &frcode, - ( integer * ) cent, - ( integer * ) frclss, - ( integer * ) clssid, - ( logical * ) &fnd ); - - - *found = fnd; - - chkout_c ( "frinfo_c" ); - -} /* End frinfo_c */ - diff --git a/ext/spice/src/cspice/frmchg.c b/ext/spice/src/cspice/frmchg.c deleted file mode 100644 index 7273691850..0000000000 --- a/ext/spice/src/cspice/frmchg.c +++ /dev/null @@ -1,875 +0,0 @@ -/* frmchg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure FRMCHG (Frame Change) */ -/* Subroutine */ int frmchg_(integer *frame1, integer *frame2, doublereal *et, - doublereal *xform) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, - i__11, i__12, i__13; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer node; - logical done; - integer cent, this__; - extern /* Subroutine */ int zznofcon_(doublereal *, integer *, integer *, - integer *, integer *, char *, ftnlen); - integer i__, j, k, l, frame[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer class__; - logical found; - integer relto; - doublereal trans[504] /* was [6][6][14] */, trans2[72] /* - was [6][6][2] */; - extern logical failed_(void); - integer cmnode; - extern integer isrchi_(integer *, integer *, integer *); - integer clssid; - extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, - integer *, logical *), frmget_(integer *, doublereal *, - doublereal *, integer *, logical *); - logical gotone; - extern /* Subroutine */ int chkout_(char *, ftnlen); - char errmsg[1840]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *, - ftnlen); - doublereal tempxf[36] /* was [6][6] */; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *), zzmsxf_( - doublereal *, integer *, doublereal *); - integer inc, get, put; - -/* $ Abstract */ - -/* Return the state transformation matrix from one */ -/* frame to another. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRAME1 I the frame id-code for some reference frame */ -/* FRAME2 I the frame id-code for some reference frame */ -/* ET I an epoch in TDB seconds past J2000. */ -/* XFORM O a state transformation matrix */ - -/* $ Detailed_Input */ - -/* FRAME1 is the frame id-code in which some states are known. */ - -/* FRAME2 is the frame id-code for some frame in which you */ -/* would like to represent states. */ - -/* ET is the epoch at which to compute the state */ -/* transformation matrix. This epoch should be */ -/* in TDB seconds past the ephemeris epoch of J2000. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6 x 6 state transformation matrix that can */ -/* be used to transform states relative to the frame */ -/* correspsonding to frame FRAME2 to states relative */ -/* to the frame FRAME2. More explicitely, if STATE */ -/* is the state of some object relative to the reference */ -/* frame of FRAME1 then STATE2 is the state of the */ -/* same object relative to FRAME2 where STATE2 is */ -/* computed via the subroutine call below */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, STATE2 ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the reference frames is unrecognized, the error */ -/* SPICE(UNKNOWNFRAME) will be signalled. */ - -/* 2) If the auxillary information needed to compute a non-inertial */ -/* frame is not available an error will be diagnosed and signalled */ -/* by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to compute the state transformation matrix */ -/* between two reference frames. */ - -/* The currently supported reference frames are IAU bodyfixed frames */ -/* and inertial reference frames. */ - -/* $ Examples */ - -/* Example 1. Suppose that you have a state STATE1 at epoch ET */ -/* relative to FRAME1 and wish to determine its representation */ -/* STATE2 relative to FRAME2. The following subroutine calls */ -/* would suffice to make this transformation. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, XFORM ) */ -/* CALL MXVG ( XFORM, STATE1, 6, 6, STATE2 ) */ - - - -/* Example 2. Suppose that you have the angular velocity, W, of some */ -/* rotation relative to FRAME1 at epoch ET and that you wish to */ -/* express this angular velocity with respect to FRAME2. The */ -/* following subroutines will suffice to perform this computation. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */ - -/* Recall that a state transformation matrix has the following form. */ - - -/* - - */ -/* | | */ -/* | R 0 | */ -/* | | */ -/* | | */ -/* | dR | */ -/* | -- R | */ -/* | dt | */ -/* | | */ -/* - - */ - - -/* The velocity of an arbitrary point P undergoing rotation with the */ -/* angular velocity W is W x P */ - -/* Thus the velocity of P in FRAME2 is: */ - - -/* dR */ -/* -- P + R (W x P ) */ -/* dt */ - -/* dR t */ -/* = ( -- R R P + W x P ) ( 1 ) */ -/* dt */ - - -/* dR t t */ -/* But -- R is skew symmetric (simply differentiate R*R to see */ -/* dt */ -/* dR t */ -/* this ). Hence -- R R P can be written as Ax(R*P) for some fixed */ -/* dt */ - -/* vector A. Moreover the vector A can be read from the upper */ - -/* dR t */ -/* triangular portion of -- R . So that equation (1) above can */ -/* dt */ - -/* be re-written as */ - -/* dR t */ -/* = ( -- R R*P + R*(WxP) ) */ -/* dt */ - -/* = Ax(R*P) + R*W x R*P */ - -/* = ( [A+R*W] x R*P ) */ - - -/* From this final expression it follows that in FRAME2 the angular */ -/* velocity vector is given by [A+R*W]. */ - -/* The code below implements these ideas. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */ - - -/* DO I = 1, 3 */ -/* DO J = 1, 3 */ - -/* RT ( I, J ) = STXFRM ( I, J ) */ -/* DRDT( I, J ) = STXFRM ( I+3, J ) */ - -/* END DO */ -/* END DO */ - -/* CALL MXMT ( DRDT, R, AMATRIX ) */ - -/* Read the angular velocity of R from the skew symmetric matrix */ - -/* dR t */ -/* -- R */ -/* dt */ - -/* Recall that if A has components A1, A2, A3 then the matrix */ -/* cooresponding to the cross product linear mapping is: */ - -/* - - */ -/* | 0 -A3 A2 | */ -/* | | */ -/* | A3 0 -A1 | */ -/* | | */ -/* | -A2 A1 0 | */ -/* - - */ - -/* A(1) = -AMATRIX(2,3) */ -/* A(2) = AMATRIX(1,3) */ -/* A(3) = -AMATRIX(1,2) */ - -/* CALL MXV ( R, W1, W ) */ -/* CALL VADD ( A, W, W2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ - -/* Upgraded long error message associated with frame */ -/* connection failure. */ - -/* - SPICELIB Version 1.1.0, 25-JUL-1996 (WLT) */ - -/* Bug Fix: */ - -/* The previous edition of the routine had a bug in the */ -/* first pass of the DO WHILE that looks for a frame */ -/* in the chain of frames associated with FRAME2 that is */ -/* in common with the chain of frames for FRAME1. */ - -/* On machines where variables are created as static */ -/* variables, this error could lead to finding a frame */ -/* when a legitimate path between FRAME1 and FRAME2 */ -/* did not exist. */ - -/* - SPICELIB Version 1.0.1, 06-MAR-1996 (WLT) */ - -/* An typo was fixed in the Brief I/O section. It used */ -/* to say TDT instead of the correct time system TDB. */ - -/* - SPICELIB Version 1.0.0, 28-SEP-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Transform states from one frame to another */ - -/* -& */ - -/* SPICE functions */ - - -/* Local Parameters */ - - -/* The root of all reference frames is J2000 (Frame ID = 1). */ - - -/* Local Variables */ - - -/* TRANS contains the transformations from FRAME1 to FRAME2 */ -/* TRANS(1...6,1...6,I) has the transfromation from FRAME(I) */ -/* to FRAME(I+1). We make extra room in TRANS because we */ -/* plan to add transformations beyond the obvious chain from */ -/* FRAME1 to a root node. */ - - -/* TRANS2 is used to store intermediate transformations from */ -/* FRAME2 to some node in the chain from FRAME1 to PCK or */ -/* INERTL frames. */ - - -/* FRAME contains the frames we transform from in going from */ -/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ - - -/* NODE counts the number of transformations needed to go */ -/* from FRAME1 to FRAME2. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("FRMCHG", (ftnlen)6); - -/* Do the obvious thing first. If FRAME1 and FRAME2 are the */ -/* same then we simply return the identity matrix. */ - - if (*frame1 == *frame2) { - for (i__ = 1; i__ <= 6; ++i__) { - xform[(i__1 = i__ + i__ * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "frmchg_", (ftnlen)371)] = 1.; - i__1 = i__ - 1; - for (j = 1; j <= i__1; ++j) { - xform[(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "frmchg_", (ftnlen)374)] = 0.; - xform[(i__2 = j + i__ * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "frmchg_", (ftnlen)375)] = 0.; - } - } - chkout_("FRMCHG", (ftnlen)6); - return 0; - } - -/* Now perform the obvious check to make sure that both */ -/* frames are recognized. */ - - frinfo_(frame1, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame1, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("FRMCHG", (ftnlen)6); - return 0; - } - frinfo_(frame2, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame2, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("FRMCHG", (ftnlen)6); - return 0; - } - node = 1; - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, - "frmchg_", (ftnlen)418)] = *frame1; - found = TRUE_; - -/* Follow the chain of transformations until we run into */ -/* one that transforms to J2000 (frame id = 1) or we hit FRAME2. */ - - while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "frmchg_", (ftnlen)424)] != 1 && node < 10 && frame[(i__2 = - node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "frmc" - "hg_", (ftnlen)424)] != *frame2 && found) { - -/* Find out what transformation is available for this */ -/* frame. */ - - frmget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "frmchg_", (ftnlen)432)], et, &trans[(i__2 = ( - node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "frmchg_", (ftnlen)432)], &frame[(i__3 = node) - < 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "frmchg_", ( - ftnlen)432)], &found); - if (found) { - -/* We found a transformation matrix. TRANS(1,1,NODE) */ -/* now contains the transformation from FRAME(NODE) */ -/* to FRAME(NODE+1). We need to look up the information */ -/* for the next NODE. */ - - ++node; - } - } - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "frmchg_", (ftnlen)448)] == 1 || frame[(i__2 = node - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "frmchg_", (ftnlen) - 448)] == *frame2 || ! found; - while(! done) { - -/* The only way to get to this point is to have run out of */ -/* room in the array of reference frame transformation */ -/* buffers. We will now build the transformation from */ -/* the previous NODE to whatever the next node in the */ -/* chain is. We'll do this until we get to one of the */ -/* root classes or we run into FRAME2. */ - - frmget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "frmchg_", (ftnlen)462)], et, &trans[(i__2 = ( - node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "frmchg_", (ftnlen)462)], &relto, &found); - if (found) { - -/* Recall that TRANS(1,1,NODE-1) contains the transformation */ -/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ -/* FRAME(NODE) with the frame indicated by RELTO. This means */ -/* that TRANS(1,1,NODE-1) should be replaced with the */ -/* transformation from FRAME(NODE) to RELTO. */ - - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "frmchg_", (ftnlen)473)] = relto; - zzmsxf_(&trans[(i__1 = ((node - 1) * 6 + 1) * 6 - 42) < 504 && 0 - <= i__1 ? i__1 : s_rnge("trans", i__1, "frmchg_", (ftnlen) - 474)], &c__2, tempxf); - for (i__ = 1; i__ <= 6; ++i__) { - for (j = 1; j <= 6; ++j) { - trans[(i__1 = i__ + (j + (node - 1) * 6) * 6 - 43) < 504 - && 0 <= i__1 ? i__1 : s_rnge("trans", i__1, "frm" - "chg_", (ftnlen)478)] = tempxf[(i__2 = i__ + j * 6 - - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("tempxf", - i__2, "frmchg_", (ftnlen)478)]; - } - } - } - -/* We are done if the class of the last frame is J2000 */ -/* or if the last frame is FRAME2 or if we simply couldn't get */ -/* another transformation. */ - - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "frmchg_", (ftnlen)488)] == 1 || frame[(i__2 = - node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "frmchg_", (ftnlen)488)] == *frame2 || ! found; - } - -/* Right now we have the following situation. We have in hand */ -/* a collection of transformations between frames. (Assuming */ -/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ -/* no transformations computed yet. */ - - -/* TRANS(1...6, 1...6, 1 ) transforms FRAME1 to FRAME(2) */ -/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */ -/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */ -/* . */ -/* . */ -/* . */ -/* TRANS(1...6, 1...6, NODE-1 ) transforms FRAME(NODE-1) */ -/* to FRAME(NODE) */ - - -/* One of the following situations is true. */ - -/* 1) FRAME(NODE) is the root of all frames, J2000. */ - -/* 2) FRAME(NODE) is the same as FRAME2 */ - -/* 3) There is no transformation from FRAME(NODE) to another */ -/* more fundamental frame. The chain of transformations */ -/* from FRAME1 stops at FRAME(NODE). This means that the */ -/* "frame atlas" is incomplete because we can't get to the */ -/* root frame. */ - -/* We now have to do essentially the same thing for FRAME2. */ - - if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "frmchg_", (ftnlen)526)] == *frame2) { - -/* We can handle this one immediately with the private routine */ -/* ZZMSXF which multiplies a series of state transformation */ -/* matrices. */ - - i__1 = node - 1; - zzmsxf_(trans, &i__1, xform); - chkout_("FRMCHG", (ftnlen)6); - return 0; - } - -/* We didn't luck out above. So we follow the chain of */ -/* transformation for FRAME2. Note that at the moment the */ -/* chain of transformations from FRAME2 to other frames */ -/* does not share a node in the chain for FRAME1. */ -/* ( GOTONE = .FALSE. ) . */ - - this__ = *frame2; - gotone = FALSE_; - -/* First see if there is any chain to follow. */ - - done = this__ == 1; - -/* Set up the matrices TRANS2(,,1) and TRANS(,,2) and set up */ -/* PUT and GET pointers so that we know where to GET the partial */ -/* transformation from and where to PUT partial results. */ - - if (! done) { - for (k = 1; k <= 2; ++k) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 4; j <= 6; ++j) { - trans2[(i__1 = i__ + (j + k * 6) * 6 - 43) < 72 && 0 <= - i__1 ? i__1 : s_rnge("trans2", i__1, "frmchg_", ( - ftnlen)563)] = 0.; - } - } - } - put = 1; - get = 1; - inc = 1; - } - -/* Follow the chain of transformations until we run into */ -/* one that transforms to the root frame or we land in the */ -/* chain of nodes for FRAME1. */ - -/* Note that this time we will simply keep track of the full */ -/* translation from FRAME2 to the last node. */ - - while(! done) { - -/* Find out what transformation is available for this */ -/* frame. */ - - if (this__ == *frame2) { - -/* This is the first pass, just put the transformation */ -/* directly into TRANS2(,,PUT). */ - - frmget_(&this__, et, &trans2[(i__1 = (put * 6 + 1) * 6 - 42) < 72 - && 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, "frmchg_", ( - ftnlen)592)], &relto, &found); - if (found) { - this__ = relto; - get = put; - put += inc; - inc = -inc; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } else { - -/* Fetch the transformation into a temporary spot TEMPXF */ - - frmget_(&this__, et, tempxf, &relto, &found); - if (found) { - -/* Next multiply TEMPXF on the right by the last partial */ -/* product (in TRANS2(,,GET) ). We do this in line because */ -/* we can cut down the number of multiplies to 3/8 of the */ -/* normal result of MXMG. For a discussion of why this */ -/* works see ZZMSXF. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "frmchg_", (ftnlen)621)] = tempxf[(i__2 = i__ - - 1) < 36 && 0 <= i__2 ? i__2 : s_rnge("temp" - "xf", i__2, "frmchg_", (ftnlen)621)] * trans2[( - i__3 = (j + get * 6) * 6 - 42) < 72 && 0 <= - i__3 ? i__3 : s_rnge("trans2", i__3, "frmchg_" - , (ftnlen)621)] + tempxf[(i__4 = i__ + 5) < - 36 && 0 <= i__4 ? i__4 : s_rnge("tempxf", - i__4, "frmchg_", (ftnlen)621)] * trans2[(i__5 - = (j + get * 6) * 6 - 41) < 72 && 0 <= i__5 ? - i__5 : s_rnge("trans2", i__5, "frmchg_", ( - ftnlen)621)] + tempxf[(i__6 = i__ + 11) < 36 - && 0 <= i__6 ? i__6 : s_rnge("tempxf", i__6, - "frmchg_", (ftnlen)621)] * trans2[(i__7 = (j - + get * 6) * 6 - 40) < 72 && 0 <= i__7 ? i__7 - : s_rnge("trans2", i__7, "frmchg_", (ftnlen) - 621)]; - } - } - for (i__ = 4; i__ <= 6; ++i__) { - for (j = 1; j <= 3; ++j) { - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "frmchg_", (ftnlen)630)] = tempxf[(i__2 = i__ - - 1) < 36 && 0 <= i__2 ? i__2 : s_rnge("temp" - "xf", i__2, "frmchg_", (ftnlen)630)] * trans2[( - i__3 = (j + get * 6) * 6 - 42) < 72 && 0 <= - i__3 ? i__3 : s_rnge("trans2", i__3, "frmchg_" - , (ftnlen)630)] + tempxf[(i__4 = i__ + 5) < - 36 && 0 <= i__4 ? i__4 : s_rnge("tempxf", - i__4, "frmchg_", (ftnlen)630)] * trans2[(i__5 - = (j + get * 6) * 6 - 41) < 72 && 0 <= i__5 ? - i__5 : s_rnge("trans2", i__5, "frmchg_", ( - ftnlen)630)] + tempxf[(i__6 = i__ + 11) < 36 - && 0 <= i__6 ? i__6 : s_rnge("tempxf", i__6, - "frmchg_", (ftnlen)630)] * trans2[(i__7 = (j - + get * 6) * 6 - 40) < 72 && 0 <= i__7 ? i__7 - : s_rnge("trans2", i__7, "frmchg_", (ftnlen) - 630)] + tempxf[(i__8 = i__ + 17) < 36 && 0 <= - i__8 ? i__8 : s_rnge("tempxf", i__8, "frmchg_" - , (ftnlen)630)] * trans2[(i__9 = (j + get * 6) - * 6 - 39) < 72 && 0 <= i__9 ? i__9 : s_rnge( - "trans2", i__9, "frmchg_", (ftnlen)630)] + - tempxf[(i__10 = i__ + 23) < 36 && 0 <= i__10 ? - i__10 : s_rnge("tempxf", i__10, "frmchg_", ( - ftnlen)630)] * trans2[(i__11 = (j + get * 6) * - 6 - 38) < 72 && 0 <= i__11 ? i__11 : s_rnge( - "trans2", i__11, "frmchg_", (ftnlen)630)] + - tempxf[(i__12 = i__ + 29) < 36 && 0 <= i__12 ? - i__12 : s_rnge("tempxf", i__12, "frmchg_", ( - ftnlen)630)] * trans2[(i__13 = (j + get * 6) * - 6 - 37) < 72 && 0 <= i__13 ? i__13 : s_rnge( - "trans2", i__13, "frmchg_", (ftnlen)630)]; - } - } - -/* Note that we don't have to compute the upper right */ -/* hand block. It's already set to zero by construction. */ - -/* Finally we can just copy the lower right hand block */ -/* from the upper left hand block of the matrix. */ - - for (i__ = 4; i__ <= 6; ++i__) { - k = i__ - 3; - for (j = 4; j <= 6; ++j) { - l = j - 3; - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "frmchg_", (ftnlen)649)] = trans2[(i__2 = k + - (l + put * 6) * 6 - 43) < 72 && 0 <= i__2 ? - i__2 : s_rnge("trans2", i__2, "frmchg_", ( - ftnlen)649)]; - } - } - -/* Adjust GET and PUT so that GET points to the slots */ -/* where we just stored the result of our multiply and */ -/* so that PUT points to the next available storage */ -/* locations. */ - - get = put; - put += inc; - inc = -inc; - this__ = relto; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } - -/* See if we have a common node and determine whether or not */ -/* we are done with this loop. */ - - done = this__ == 1 || gotone || ! found; - } - -/* There are two possible scenarios. Either the chain of */ -/* transformations from FRAME2 ran into a node in the chain for */ -/* FRAME1 or it didn't. (The common node might very well be */ -/* the root node.) If we didn't run into a common one, then */ -/* the two chains don't intersect and there is no way to */ -/* get from FRAME1 to FRAME2. */ - - if (! gotone) { - zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("frame", i__1, "frmchg_", (ftnlen)692)], frame2, - &this__, errmsg, (ftnlen)1840); - if (failed_()) { - -/* We were unable to create the error message. This */ -/* unfortunate situation could arise if a frame kernel */ -/* is corrupted. */ - - chkout_("FRMCHG", (ftnlen)6); - return 0; - } - -/* The normal case: signal an error with a descriptive long */ -/* error message. */ - - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); - chkout_("FRMCHG", (ftnlen)6); - return 0; - } - -/* Recall that we have the following. */ - -/* TRANS(1...6, 1...6, 1 ) transforms FRAME(1) to FRAME(2) */ -/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */ -/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */ - -/* TRANS(1...6, 1...6, CMNODE-1) transforms FRAME(CMNODE-1) */ -/* to FRAME(CMNODE) */ - -/* and that TRANS2(1,1,GET) transforms from FRAME2 to CMNODE. */ -/* Hence the inverse of TRANS2(1,1,GET) transforms from CMNODE */ -/* to FRAME2. */ - -/* If we compute the inverse of TRANS2 and store it in */ -/* the next available slot of TRANS (.i.e. TRANS(1,1,CMNODE) */ -/* we can simply apply our custom routine that multiplies a */ -/* sequence of transformation matrices together to get the */ -/* result from FRAME1 to FRAME2. */ - - invstm_(&trans2[(i__1 = (get * 6 + 1) * 6 - 42) < 72 && 0 <= i__1 ? i__1 : - s_rnge("trans2", i__1, "frmchg_", (ftnlen)735)], &trans[(i__2 = ( - cmnode * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "frmchg_", (ftnlen)735)]); - zzmsxf_(trans, &cmnode, xform); - chkout_("FRMCHG", (ftnlen)6); - return 0; -} /* frmchg_ */ - diff --git a/ext/spice/src/cspice/frmget.c b/ext/spice/src/cspice/frmget.c deleted file mode 100644 index 8041b91309..0000000000 --- a/ext/spice/src/cspice/frmget.c +++ /dev/null @@ -1,360 +0,0 @@ -/* frmget.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure FRMGET (Frame get transformation) */ -/* Subroutine */ int frmget_(integer *infrm, doublereal *et, doublereal * - xform, integer *outfrm, logical *found) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer cent, type__; - extern /* Subroutine */ int zzdynfrm_(integer *, integer *, doublereal *, - doublereal *, integer *); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal tsipm[36] /* was [6][6] */; - char versn[6]; - extern logical failed_(void); - extern /* Subroutine */ int ckfxfm_(integer *, doublereal *, doublereal *, - integer *, logical *), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - tisbod_(char *, integer *, doublereal *, doublereal *, ftnlen), - tkfram_(integer *, doublereal *, integer *, logical *), sigerr_( - char *, ftnlen); - integer typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *); - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Find the transformation from a user specified frame to */ -/* another frame at a user specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRM I The integer code for a SPICE reference frame. */ -/* ET I An epoch in seconds past J2000. */ -/* XFORM O A state transformation matrix. */ -/* OUTFRM O The frame that XFORM transforms INFRM to. */ -/* FOUND O TRUE if a frame transformation can be found. */ - -/* $ Detailed_Input */ - -/* INFRM is the SPICE id-code for some reference frame. */ - -/* ET is an epoch in ephemeris seconds past J2000 at */ -/* which the user wishes to retrieve a state */ -/* transformation matrix. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6x6 matrix that transforms states relative to */ -/* INFRM to states relative to OUTFRM. (Assuming such */ -/* a transformation can be found.) */ - -/* OUTFRM is a reference frame. The 6x6 matrix XFORM transforms */ -/* states relative to INFRM to states relative to OUTFRM. */ -/* The state transformation is achieved by multiplying */ -/* XFORM on the right by a state relative to INFRM. This */ -/* is easily accomplished via the subroutine call */ -/* shown below. */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, OSTATE ) */ - -/* FOUND is a logical flag indicating whether or not a */ -/* transformation matrix could be found from INFRM */ -/* to some other frame. If a transformation matrix */ -/* cannot be found OUTFRM will be set to zero, FOUND */ -/* will be set to FALSE and XFORM will be returned */ -/* as the zero matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a transformation matrix cannot be located, then */ -/* FOUND will be set to FALSE, OUTFRM will be set to zero */ -/* and XFORM will be set to the zero 6x6 matrix. */ - -/* 2) If the class of the requested frame is not recognized the */ -/* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */ - -/* $ Particulars */ - -/* This is a low level routine used for determining a chain */ -/* of state transformation matrices from one frame to another. */ - -/* $ Examples */ - -/* See FRMCHG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 18-DEC-2004 (NJB) */ - -/* Added the new frame type 'DYN' to the list of frame */ -/* types recognized by FRMGET. */ - -/* - SPICELIB Version 2.0.0, 03-APR-1997 (WLT) */ - -/* Added the new frame type 'TK' to the list of frame */ -/* types recognized by FRMGET. In addition the routine */ -/* now checks FAILED after "getting" the frame transformation. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Find a frame transformation matrix from a specified frame */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - s_copy(versn, "3.0.0", (ftnlen)6, (ftnlen)5); - *found = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("FRMGET", (ftnlen)6); - -/* Get all the needed information about this frame. */ - - frinfo_(infrm, ¢, &type__, &typeid, found); - if (! (*found)) { - chkout_("FRMGET", (ftnlen)6); - return 0; - } - if (type__ == 2) { - tisbod_("J2000", &typeid, et, tsipm, (ftnlen)5); - invstm_(tsipm, xform); - namfrm_("J2000", outfrm, (ftnlen)5); - } else if (type__ == 1) { - irfrot_(infrm, &c__1, rot); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "frmget_", (ftnlen)218)] = rot[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "frmget_", (ftnlen)218)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "frmget_", (ftnlen)219)] - = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("rot", i__2, "frmget_", (ftnlen)219)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "frmget_", (ftnlen)220)] = 0.; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "frmget_", (ftnlen)221)] = 0.; - } - } - *outfrm = 1; - } else if (type__ == 3) { - ckfxfm_(&typeid, et, xform, outfrm, found); - } else if (type__ == 4) { - tkfram_(&typeid, rot, outfrm, found); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "frmget_", (ftnlen)238)] = rot[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "frmget_", (ftnlen)238)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "frmget_", (ftnlen)239)] - = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("rot", i__2, "frmget_", (ftnlen)239)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "frmget_", (ftnlen)240)] = 0.; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "frmget_", (ftnlen)241)] = 0.; - } - } - } else if (type__ == 5) { - -/* Unlike the other frame classes, the dynamic frame evaluation */ -/* routine ZZDYNFRM requires the input frame ID rather than the */ -/* dynamic frame class ID. ZZDYNFRM also requires the center ID */ -/* we found via the FRINFO call. */ - zzdynfrm_(infrm, ¢, et, xform, outfrm); - -/* The FOUND flag was set by FRINFO earlier; we don't touch */ -/* it here. If ZZDYNFRM signaled an error, FOUND will be set */ -/* to .FALSE. at end of this routine. */ - - } else { - setmsg_("The reference frame # has class id-code #. This form of ref" - "erence frame is not supported in version # of FRMGET. You ne" - "ed to update your version of SPICELIB to the latest version " - "in order to support this frame. ", (ftnlen)211); - errint_("#", infrm, (ftnlen)1); - errint_("#", &type__, (ftnlen)1); - errch_("#", versn, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23); - chkout_("FRMGET", (ftnlen)6); - return 0; - } - if (failed_()) { - *found = FALSE_; - } - chkout_("FRMGET", (ftnlen)6); - return 0; -} /* frmget_ */ - diff --git a/ext/spice/src/cspice/frmnam_c.c b/ext/spice/src/cspice/frmnam_c.c deleted file mode 100644 index 0a08e1b991..0000000000 --- a/ext/spice/src/cspice/frmnam_c.c +++ /dev/null @@ -1,238 +0,0 @@ -/* - --Procedure frmnam_c (Frame to Name) - --Abstract - - Retrieve the name of a reference frame associated with - a SPICE ID code. - --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 - - FRAMES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - void frmnam_c ( SpiceInt frcode, - SpiceInt lenout, - SpiceChar * frname ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - frcode I an integer code for a reference frame - lenout I Maximum length of output string. - frname O the name associated with the reference frame. - --Detailed_Input - - frcode is an integer code for a reference frame. - - lenout is the maximum number of characters that can be - accommodated in the output string. This count - includes room for the terminating null character. - For example, if the maximum allowed length of the - output string, including the terminating null, is 33 - characters, then lenout should be set to 33. - --Detailed_Output - - frname is the name associated with the reference frame. - It will be returned left-justified. - - If frcode is not recognized as the name of a - known reference frame, frname will be returned - as an empty string. - - If frname is not sufficiently long to hold the - name, it will be truncated on the right. - - All reference frame names are 32 or fewer characters - in length. Thus declaring frname to be SpiceChar[33] - will ensure that the returned name will not be - truncated. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If frcode is not recognized as the name of a known reference - frame, frname will be returned as a blank. - - 2) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 3) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - - 4) If the length of frname (indicated by lenout) is at least two - characters but not large enough to contain the output string, - the output string will be truncated on the right. - --Particulars - - This routine retrieves the name of a reference frame associated - with a SPICE frame ID code. - - The ID codes stored locally are scanned for a match with frcode. - If a match is found, the name stored locally will be returned - as the name for the frame. - - If frcode is not a member of the list of internally stored - ID codes, the kernel pool will be examined to see if the - variable - - FRAME_idcode_NAME - - is present (where idcode is the decimal character equivalent - of frcode). If the variable is located and it has both - character type and dimension 1, the string value of the - kernel pool variable is returned as the name of the reference - frame. - - Note that because the local information is always examined - first and searches of the kernel pool are performed only - after exhausting local information, it is not possible to - override the local name for any reference frame that is - known by this routine. - --Examples - - Suppose you needed to create a message concerning a reference - frame and wish to use the name of the frame in the message. - Suppose further that you have only the frame ID code at your - disposal. You can capture the frame name using this routine - as shown here. - - #include "SpiceUsr.h" - . - . - . - #define NAMELEN 33 - - SpiceChar frname [NAMELEN]; - SpiceInt frcode; - - - frname_c ( frcode, NAMELEN, frname ); - - if ( iswhsp_c(frname) ) - { - sprintf ( frname, "%ld", frcode ); - } - - printf ( "Concerning reference frame: %s\n", frname ); - - [Print the rest of your message.] - - --Restrictions - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 26-MAR-2003 (NJB) - - Fixed description of exception (4): replaced "lenout-1" - with "lenout." Removed spurious word "clock" from string - description. - - -CSPICE Version 1.0.0, 13-AUG-2001 (NJB) (WLT) - --Index_Entries - - Frame idcode to frame name translation - --& -*/ - -{ /* Begin frmnam_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "frmnam_c" ); - - /* - Make sure the output frmnam has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "frmnam_c", frname, lenout ); - - - /* - Do the conversion. - */ - frmnam_ ( ( integer * ) &frcode, - ( char * ) frname, - ( ftnlen ) lenout-1 ); - - /* - Convert the Fortran string to a C string by placing a null - after the last non-blank character. This operation is valid - whether or not the CSPICE routine signaled an error. - */ - F2C_ConvertStr ( lenout, frname ); - - - chkout_c ( "frmnam_c" ); - -} /* End frmnam_c */ - diff --git a/ext/spice/src/cspice/frstnb.c b/ext/spice/src/cspice/frstnb.c deleted file mode 100644 index 8e54fb0bbc..0000000000 --- a/ext/spice/src/cspice/frstnb.c +++ /dev/null @@ -1,159 +0,0 @@ -/* frstnb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FRSTNB ( First non-blank character ) */ -integer frstnb_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Return the index of the first non-blank character in */ -/* a character 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 */ - -/* ASCII, CHARACTER, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* FRSTNB O Index of the first non-blank character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* FRSTNB is the index if the first non-blank character */ -/* in the input string. If there are no non-blank */ -/* characters in the string, FRSTNB is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* If the string is blank, return zero. Otherwise, step through */ -/* the string one character at a time until something other than */ -/* a blank is found. Return the index of that something within */ -/* the string. */ - -/* $ Examples */ - -/* The following examples illustrate the use of FRSTNB. */ - -/* FRSTNB ( 'ABCDE' ) = 1 */ -/* FRSTNB ( 'AN EXAMPLE' ) = 1 */ -/* FRSTNB ( ' AN EXAMPLE' ) = 4 */ -/* FRSTNB ( ' ' ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* Modified the comparison to use integer values and the ICHAR() */ -/* function. This improves the performance of the subroutine. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* first non-blank character */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Just like it says in the header. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - ret_val = 0; - } else { - i__1 = i_len(string, string_len); - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&string[i__ - 1] != 32) { - ret_val = i__; - return ret_val; - } - } - } - return ret_val; -} /* frstnb_ */ - diff --git a/ext/spice/src/cspice/frstnp.c b/ext/spice/src/cspice/frstnp.c deleted file mode 100644 index 7b9f90abe8..0000000000 --- a/ext/spice/src/cspice/frstnp.c +++ /dev/null @@ -1,178 +0,0 @@ -/* frstnp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FRSTNP ( First non-printable character ) */ -integer frstnp_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Return the index of the first non-printable character in a */ -/* character string. ASCII characters 32-126 are considered */ -/* printable by this routine. (Blanks are considered printable.) */ - -/* $ 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 */ - -/* ASCII */ -/* CHARACTER */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* FRSTNP O Index of first non-printable character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* FRSTNP is the index of the first non-printable character */ -/* in the input string. Characters having integer */ -/* codes outside the range 32-126 are considered to be */ -/* non-printable characters. Blanks are considered to */ -/* be printable characters. If the input string */ -/* contains no non-printable characters, FRSTNP is */ -/* zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine may be used to assist in validating strings that */ -/* are intended to be free of non-printable characters. */ - -/* This routine and LASTNP treat blanks as printable characters. */ -/* This choice prevents embedded blanks from causing false positive */ -/* results in tests of strings for invalid characters. Note that the */ -/* routines FRSTPC and LASTPC treat blanks as non-printable. */ - -/* $ Examples */ - -/* The program */ - -/* INTEGER FRSTNP */ -/* INTEGER LASTNP */ - -/* CHARACTER*10 S */ - -/* S( 1: 1) = 'A' */ -/* S( 2: 2) = CHAR ( 2 ) */ -/* S( 3: 3) = CHAR ( 3 ) */ -/* S( 4: 4) = 'A' */ -/* S( 5: 5) = 'B' */ -/* S( 6: 6) = 'C' */ -/* S( 7: 7) = CHAR ( 7 ) */ -/* S( 8: 8) = CHAR ( 8 ) */ -/* S( 9: 9) = CHAR ( 9 ) */ -/* S(10:10) = ' ' */ - -/* WRITE (*,*) 'Non-printable characters found in range ' */ -/* . FRSTNP(S), ' to ', LASTNP(S) */ - -/* END */ - -/* produces the following output: */ - -/* Non-printable characters found in range 2 to 9. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-JUN-1995 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* first non-printable character */ - -/* -& */ - -/* Local variables */ - - -/* Look for the first character outside the range [32,126], and */ -/* return its index. */ - - i__1 = i_len(string, string_len); - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&string[i__ - 1] < 32 || *(unsigned char *)& - string[i__ - 1] > 126) { - ret_val = i__; - return ret_val; - } - } - -/* Still here? All characters are printable. Return zero. */ - - ret_val = 0; - return ret_val; -} /* frstnp_ */ - diff --git a/ext/spice/src/cspice/frstpc.c b/ext/spice/src/cspice/frstpc.c deleted file mode 100644 index 0445a3abf1..0000000000 --- a/ext/spice/src/cspice/frstpc.c +++ /dev/null @@ -1,185 +0,0 @@ -/* frstpc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FRSTPC ( First printable character ) */ -integer frstpc_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Return the index of the first printable character in a character */ -/* string. ASCII characters 33-126 are printable. (Blanks are not */ -/* considered printable.) */ - -/* $ 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 */ - -/* ASCII, CHARACTER, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* FRSTPC O Index of the first printable character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* FRSTPC is the index of the first printable character */ -/* in the input string. Characters 33-126 are */ -/* considered to be printable characters. Blanks */ -/* are not considered printable characters. If */ -/* the input string contains no printable characters, */ -/* FRSTPC is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This works exactly like FRSTNB, except that it skips */ -/* non-printable characters (ASCII control characters) as */ -/* well as blanks. */ - -/* $ Examples */ - -/* The program */ - -/* INTEGER FRSTNB */ -/* INTEGER FRSTPC */ -/* INTEGER LASTNB */ -/* INTEGER LASTPC */ - -/* CHARACTER*10 S */ - -/* S( 1: 1) = ' ' */ -/* S( 2: 2) = CHAR ( 2 ) */ -/* S( 3: 3) = CHAR ( 3 ) */ -/* S( 4: 4) = 'A' */ -/* S( 5: 5) = 'B' */ -/* S( 6: 6) = 'C' */ -/* S( 7: 7) = CHAR ( 7 ) */ -/* S( 8: 8) = CHAR ( 8 ) */ -/* S( 9: 9) = CHAR ( 9 ) */ -/* S(10:10) = ' ' */ - -/* WRITE (*,*) 'Non-blank from ', FRSTNB(S), ' to ', LASTNB(S) */ -/* WRITE (*,*) 'Printable from ', FRSTPC(S), ' to ', LASTPC(S) */ - -/* END */ - -/* produces te following output: */ - -/* Non-blank from 2 to 9. */ -/* Printable from 4 to 6. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* first printable character */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* Local variables */ - - -/* Look for the first character in the range [33,126], and return */ -/* its index. */ - - i__1 = i_len(string, string_len); - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&string[i__ - 1] >= 33 && *(unsigned char *)& - string[i__ - 1] <= 126) { - ret_val = i__; - return ret_val; - } - } - -/* Still here? No printable characters. Return zero. */ - - ret_val = 0; - return ret_val; -} /* frstpc_ */ - diff --git a/ext/spice/src/cspice/ftell_.c b/ext/spice/src/cspice/ftell_.c deleted file mode 100644 index 2d3aad999a..0000000000 --- a/ext/spice/src/cspice/ftell_.c +++ /dev/null @@ -1,46 +0,0 @@ -#include "f2c.h" -#include "fio.h" - - static FILE * -#ifdef KR_headers -unit_chk(Unit, who) integer Unit; char *who; -#else -unit_chk(integer Unit, char *who) -#endif -{ - if (Unit >= MXUNIT || Unit < 0) - f__fatal(101, who); - return f__units[Unit].ufd; - } - - integer -#ifdef KR_headers -ftell_(Unit) integer *Unit; -#else -ftell_(integer *Unit) -#endif -{ - FILE *f; - return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L; - } - - int -#ifdef KR_headers -fseek_(Unit, offset, whence) integer *Unit, *offset, *whence; -#else -fseek_(integer *Unit, integer *offset, integer *whence) -#endif -{ - FILE *f; - int w = (int)*whence; -#ifdef SEEK_SET - static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; -#endif - if (w < 0 || w > 2) - w = 0; -#ifdef SEEK_SET - w = wohin[w]; -#endif - return !(f = unit_chk(*Unit, "fseek")) - || fseek(f, *offset, w) ? 1 : 0; - } diff --git a/ext/spice/src/cspice/ftncls_c.c b/ext/spice/src/cspice/ftncls_c.c deleted file mode 100644 index 0c26153969..0000000000 --- a/ext/spice/src/cspice/ftncls_c.c +++ /dev/null @@ -1,219 +0,0 @@ -/* - --Procedure ftncls_c ( Close file designated by Fortran unit ) - --Abstract - - Close a file designated by a Fortran-style integer logical unit. - --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 - - FILES - -*/ - - #include "SpiceUsr.h" - #include "f2c.h" - - - void ftncls_c ( SpiceInt unit ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - unit I Fortran-style logical unit. - - --Detailed_Input - - unit is an integer representing a Fortran logical unit. - - Fortran logical units are integers which in the - Fortran language play a role analogous to pointers to - FILE structures in C. In Fortran, when a file is - opened and a logical unit is associated with the - file, the file and unit are said to be ``connected.'' - A logical unit, once connected to a file, may be used - to refer to the file in Fortran I/O statements. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - The file connnected to unit would normally have been opened via a - call to a function generated by running f2c on a Fortran SPICELIB - routine. Examples of such functions are - - txtopn_ - txtopr_ - --Particulars - - This function is provided in order to fully support the file I/O - interface provided by those CSPICE functions generated by running f2c - on Fortran SPICELIB routines. ftncls_c should be used to close files - opened by these functions ONLY IF the files in question would - normally be closed, after having been opened by a Fortran program, - by a Fortran CLOSE statement. If a file has been opened by a - function that has a corresponding "close file" function, the latter - should be used to close a file. Examples are the DAF and DAS - families of functions: DAFs are normally closed via dafcls_ and - DAS files are normally closed via dascls_. - --Examples - - 1) Extract comments from a DAF-based kernel---an SPK file for - example---into a text file. - - #include - #include "SpiceUsr.h" - . - . - . - - #define SPK "my.bsp" - #define OUTFILE "my.txt" - - SpiceInt handle; - SpiceInt unit; - - /. - Open a new text file for write access, obtaining a Fortran - logical unit. - ./ - - txtopn_ ( OUTFILE, &unit, strlen(OUTFILE) ); - - /. - Open the SPK file from which comments are to be extracted. - ./ - dafopr_ ( SPK, &handle, strlen(SPK) ); - - /. - Extract comments into the text file. - ./ - spcec_ ( &handle, &unit ); - - /. - Close the text file. - ./ - ftncls_c ( unit ); - - - --Restrictions - - 1) - - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Literature_References - - 1) Refer to the SPK required reading file for a complete list of - the NAIF integer ID codes for bodies. - --Version - - -CSPICE Version 1.0.0, 24-MAY-1999 (NJB) - --Index_Entries - - close file designated by Fortran logical unit - --& -*/ - - -{ /* Begin ftncls_c */ - - - - /* - The following Fortran subroutine was used to generate code - that closes a logical unit. The corresponding C code was - generated by running f2c (version 19980913) on the Fortran source - using the -A (ANSI output) option. - - - SUBROUTINE FORU ( UNIT ) - INTEGER UNIT - CLOSE ( UNIT ) - END - - The output code is included below. The code has been reformatted - slightly, and the assignment - - cl__1.cunit = *unit; - - has been modified so as to not dereference the variable unit, which - is a SpiceInt rather than a pointer to SpiceInt in this routine. - - */ - - - /* - System generated locals - */ - cllist cl__1; - - /* - Builtin functions - */ - integer f_clos(cllist *); - - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - - f_clos(&cl__1); - - -} /* End ftncls_c*/ - diff --git a/ext/spice/src/cspice/furnsh_c.c b/ext/spice/src/cspice/furnsh_c.c deleted file mode 100644 index 71c05f1e08..0000000000 --- a/ext/spice/src/cspice/furnsh_c.c +++ /dev/null @@ -1,383 +0,0 @@ -/* - --Procedure furnsh_c ( Furnish a program with SPICE kernels ) - --Abstract - - Load one or more SPICE kernels into a program. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void furnsh_c ( ConstSpiceChar * file ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - file I Name of SPICE kernel file (text or binary). - --Detailed_Input - - file is the name of a SPICE kernel file. The file may be - either binary or text. If the file is a binary SPICE - kernel it will be loaded into the appropriate SPICE - subsystem. If `file' is a SPICE text kernel it will be - loaded into the kernel pool. If `file' is a SPICE - meta-kernel containing initialization instructions - (through use of the correct kernel pool variables), the - files specified in those variables will be loaded into - the appropriate SPICE subsystem. - - The SPICE text kernel format supports association of - names and data values using a "keyword = value" format. - The keyword-value pairs thus defined are called "kernel - variables." - - While any information can be placed in a text kernel - file, the following string valued kernel variables are - recognized by SPICE as meta-kernel keywords: - - KERNELS_TO_LOAD - PATH_SYMBOLS - PATH_VALUES - - Each kernel variable is discussed below. - - KERNELS_TO_LOAD is a list of SPICE kernels to be - loaded into a program. If file - names do not fit within the kernel - pool 80 character limit, they may be - continued to subsequent array - elements by placing the continuation - character ('+') at the end of an - element and then placing the - remainder of the file name in the - next array element. (See the - examples below for an illustration - of this technique or consult the - routine stpool_c for further - details.) - - Alternatively you may use a - PATH_SYMBOL (see below) to - substitute for some part of a file - name. - - PATH_SYMBOLS is a list of strings (without - embedded blanks), which if - encountered following the '$' - character will be replaced with the - corresponding PATH_VALUES string. - Note that PATH_SYMBOLS are - interpreted only in the - KERNELS_TO_LOAD variable. There must - be a one-to-one correspondence - between the values supplied for - PATH_SYMBOLS and PATH_VALUES. - - PATH_VALUES is a list of expansions to use when - PATH_SYMBOLS are encountered. See - the examples section for an - illustration of use of PATH_SYMBOLS - and PATH_VALUES. - - These kernel pool variables persist within the kernel - pool only until all kernels associated with the - variable KERNELS_TO_LOAD have been loaded. Once all - specified kernels have been loaded, the variables - KERNELS_TO_LOAD, PATH_SYMBOLS and PATH_VALUES are - removed from the kernel pool. - --Detailed_Output - - None. The routine loads various SPICE kernels for use by your - application. - --Parameters - - None. - --Exceptions - - 1) If a problem is encountered while trying to load `file', it will - be diagnosed by a routine from the appropriate SPICE subsystem. - - 2) If the input `file' is a meta-kernel and some file in - the KERNELS_TO_LOAD assignment cannot be found, the error - SPICE(CANTFINDFILE) will be signaled and the routine will - return. Any files loaded prior to encountering the missing - file will remain loaded. - - 3) If an error is encountered while trying to load one of the files - specified by the KERNELS_TO_LOAD assignment, the routine will - discontinue attempting to perform any other tasks and return. - - 4) If a PATH_SYMBOLS assignment is specified without a corresponding - PATH_VALUES assignment, the error SPICE(NOPATHVALUE) will be - signaled. - - 5) If a meta-kernel is supplied that contains instructions - specifying that another meta-text kernel be loaded, the error - SPICE(RECURSIVELOADING) will be signaled. - - 6) If the input `file' argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 7) If the input `file' argument is the empty string, the error - SPICE(EMPTYSTRING) will be signaled. - - 6) The error 'SPICE(BADVARNAME)' signals if the a pool - variable name length exceeds 32. - --Files - - The input file is examined and loaded into the appropriate - SPICE subsystem. If the file is a meta-kernel, any kernels - specified by the KERNELS_TO_LOAD keyword (and if present, - the PATH_SYMBOLS and PATH_VALUES keywords) are loaded as well. - --Particulars - - This routine provides a uniform interface to the SPICE kernel - loading systems. It allows you to easily assemble a list of - SPICE kernels required by your application and to modify that set - without modifying the source code of programs that make use of - these kernels. - - Text kernels input to this routine need not have native line - terminators for the platform. Lower level CSPICE routines can - read and process non-native text files. This functionality does - not exist in the Fortran SPICELIB. - - Only text kernel readers include the non-native read capability, - (ldpool_c and furnsh_c), the generic text file line reader, rdtext_c - requires native text files. - - Please refer to kernel.req for additional information. - - Kernel pool variable names are restricted to a length of 32 - characters or less. - --Examples - - Example 1 - --------- - - Load the leapseconds kernel naif0007.tls and the planetary ephemeris - SPK file de405s.bsp. - - furnsh_c ( "naif0007.tls" ); - furnsh_c ( "de405s.bsp" ); - - - Example 2 - --------- - - This example illustrates how you could create a meta-kernel file for - a program that requires several text and binary kernels. - - First create a list of the kernels you need in a text file as - shown below. - - \begintext - - Here are the SPICE kernels required for my application - program. - - Note that kernels are loaded in the order listed. Thus we - need to list the highest priority kernel last. - - - \begindata - - KERNELS_TO_LOAD = ( '/home/mydir/kernels/spk/lowest_priority.bsp', - '/home/mydir/kernels/spk/next_priority.bsp', - '/home/mydir/kernels/spk/highest_priority.bsp', - '/home/mydir/kernels/text/leapsecond.ker', - '/home/mydir/kernels+', - '/custom+', - '/kernel_data/constants.ker', - '/home/mydir/kernels/text/sclk.tsc', - '/home/mydir/kernels/ck/c-kernel.bc' ) - - - Note that the file name - - /home/mydir/kernels/custom/kernel_data/constants.ker - - is continued across several lines in the right hand side of the - assignment of the kernel variable KERNELS_TO_LOAD. - - Once you've created your list of kernels, call furnsh_c near the - beginning of your application program to load the meta-kernel - automatically at program start up. - - furnsh_c ( "myfile.txt" ); - - This will cause each of the kernels listed in your meta-kernel - to be loaded. - - - Example 3 - --------- - - This example illustrates how you can simplify the previous - kernel list by using PATH_SYMBOLS. - - - \begintext - - Here are the SPICE kernels required for my application - program. - - We are going to let A substitute for the directory that - contains SPK files; B substitute for the directory that - contains C-kernels; and C substitute for the directory that - contains text kernels. And we'll let D substitute for - a "custom" directory that contains a special planetary - constants kernel made just for our mission. - - Note that the order in which we list our PATH_VALUES must be - the same order that the corresponding PATH_SYMBOLS are - listed. - - - \begindata - - PATH_VALUES = ( '/home/mydir/kernels/spk', - '/home/mydir/kernels/ck', - '/home/mydir/kernels/text', - '/home/mydir/kernels/custom/kernel_data' ) - - PATH_SYMBOLS = ( 'A', - 'B', - 'C' - 'D' ) - - - KERNELS_TO_LOAD = ( '$A/lowest_priority.bsp', - '$A/next_priority.bsp', - '$A/highest_priority.bsp', - '$C/leapsecond.ker', - '$D/constants.ker', - '$C/sclk.tsc', - '$B/c-kernel.bc' ) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.3.2, 10-FEB-2010 (EDW) - - Corrected header section order. Added mention of the - restriction on kernel pool variable names to 32 characters - or less. - - -CSPICE Version 1.0.4, 17-OCT-2005 (EDW) - - Added text to Particulars section informing of the - non-native kernel text file reading capability. - - -CSPICE Version 1.0.3, 29-JUL-2003 (NJB) (CHA) - - Numerous updates to improve clarity. Some corrections - were made. - - -CSPICE Version 1.0.2, 03-JUL-2002 (NJB) - - Documentation fix: corrected second code example. The example - previously used the kernel variable PATH_NAMES; that name has been - replaced with the correct name PATH_VALUES. - - -CSPICE Version 1.0.1, 13-APR-2000 (NJB) - - Replaced single quotes with double quotes in a code example. - - -CSPICE Version 1.0.0, 01-SEP-1999 (NJB) (WLT) - --Index_Entries - - Load SPICE data from a list of items - --& -*/ - -{ /* Begin furnsh_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "furnsh_c" ); - - - /* - Check the input filename to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "furnsh_c", file ); - - - /* - Call the f2c'd Fortran routine. - */ - furnsh_ ( ( char * ) file, - ( ftnlen ) strlen(file) ); - - - chkout_c ( "furnsh_c" ); - -} /* End furnsh_c */ diff --git a/ext/spice/src/cspice/gcd.c b/ext/spice/src/cspice/gcd.c deleted file mode 100644 index 4b89ceaa7b..0000000000 --- a/ext/spice/src/cspice/gcd.c +++ /dev/null @@ -1,176 +0,0 @@ -/* gcd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure GCD ( Greatest Common Divisor ) */ -integer gcd_(integer *a, integer *b) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer absa, absb, p, q, remndr; - -/* $ Abstract */ - -/* Return the greatest common divisor of two integers. */ - -/* $ 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 */ - -/* MATH, NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I Any integer */ -/* B I Any integer */ -/* GCD I The greatest common divisor of A and B. */ - -/* $ Detailed_Input */ - -/* A An integer */ - -/* B An integer */ - -/* $ Detailed_Output */ - -/* GCD The greatest common divisor of A and B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If both A and B are zero, we return 0 as the GCD. */ - -/* 2) If exactly one of A and B is zero, then the GCD is by */ -/* definition the maximum of the absolute values of A and B. */ - -/* $ Particulars */ - -/* This routine uses Euclid's Algorithm to find the greatest common */ -/* divisor (GCD) of the integers A and B. In other words the */ -/* largest integer, G, such that A = k*G for some k and B = j*G for */ -/* some G. Note if either A or B is zero, then we return the */ -/* maximum of the two integers ABS(A) and ABS(B). If one is */ -/* non-zero we have just what the definition says. If both are zero */ -/* the definition above does not give us a GCD, so we take the GCD */ -/* of 0 and 0 to be 0. */ - - -/* $ Examples */ - -/* A B GCD */ -/* ----- ----- ----- */ -/* 8 4 4 */ -/* 120 44 4 */ -/* 15 135 15 */ -/* 101 97 1 */ -/* 119 221 17 */ -/* 144 81 9 */ -/* 0 111 111 */ -/* 0 0 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* The Art of Computer Programming Vol 1. "Fundamental Algorithms" */ -/* by Donald Knuth */ - -/* $ 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 */ - -/* greatest common divisor */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 29-DEC-1988 (WLT) */ - -/* This revision simply cleared up questions regarding the input of */ -/* zeros to the routine. */ - -/* -& */ - -/* Local variables */ - - absa = abs(*a); - absb = abs(*b); - if (absa > absb) { - p = absa; - q = absb; - } else { - p = absb; - q = absa; - } - remndr = 1; - if (q != 0) { - while(remndr != 0) { - ret_val = q; - remndr = p - p / q * q; - p = q; - q = remndr; - } - } else { - ret_val = p; - } - return ret_val; -} /* gcd_ */ - diff --git a/ext/spice/src/cspice/gcpool_c.c b/ext/spice/src/cspice/gcpool_c.c deleted file mode 100644 index 5c53f4ecc7..0000000000 --- a/ext/spice/src/cspice/gcpool_c.c +++ /dev/null @@ -1,359 +0,0 @@ -/* - --Procedure gcpool_c (Get character data from the kernel pool) - --Abstract - - Return the character value of a kernel variable from the - kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void gcpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * cvals, - SpiceBoolean * found ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the variable whose value is to be returned. - start I Which component to start retrieving for name - room I The largest number of values to return. - lenout I The length of the output string. - n O Number of values returned for name. - cvals O Values associated with name. - found O True if variable is in pool. - --Detailed_Input - - name is the name of the variable whose values are to be - returned. If the variable is not in the pool with - character type, found will be SPICEFALSE. - - start is the index of the first component of name to return. - The index follows the C convention of being 0 based. - If start is less than 0, it will be treated as 0. If - start is greater than the total number of components - available for name, no values will be returned (n will - be set to zero). However, found will still be set to - SPICETRUE - - room is the maximum number of components that should be - returned for this variable. (Usually it is the amount - of room available in the array cvals). If room is - less than 1 the error SPICE(BADARRAYSIZE) will be - signaled. - - lenout The allowed length of the output string. This length - must large enough to hold the output string plus the - terminator. If the output string is expected to have x - characters, lenout needs to be x + 1. - --Detailed_Output - - n is the number of values associated with name that - are returned. It will always be less than or equal - to room. - - If name is not in the pool with character type, no - value is given to n. - - cvals is the array of values associated with name. - If name is not in the pool with character type, no - values are given to the elements of cvals. - - If the length of cvals is less than the length of - strings stored in the kernel pool (see MAXCHR) the - values returned will be truncated on the right. - - found is SPICETRUE if the variable is in the pool and has - character type, SPICEFALSE if it is not. - --Parameters - - None. - --Exceptions - - 1) If the value of room is less than one the error - SPICE(BADARRAYSIZE) is signaled. - - 2) If cvals has declared length less than the size of a - string to be returned, the value will be truncated on - the right. See MAXCHR in pool.c for the maximum stored size of - string variables. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 4) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled. - - 5) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - --Files - - None. - --Particulars - - This routine provides the user interface to retrieving - character data stored in the kernel pool. This interface - allows you to retrieve the data associated with a variable - in multiple accesses. Under some circumstances this alleviates - the problem of having to know in advance the maximum amount - of space needed to accommodate all kernel variables. - - However, this method of access does come with a price. It is - always more efficient to retrieve all of the data associated - with a kernel pool data in one call than it is to retrieve - it in sections. - - C requires the length of the output character array to be defined - prior to calling the converted gcpool_c routine. The size of the - cvals output array is user defined and passed as the variable - lenout. - - Also see the entry points gdpool_c and gipool_c. - --Examples - - The following code fragment demonstrates how the data stored - in a kernel pool variable can be retrieved in pieces. Using the - kernel "test.ker" which contains - - \begindata - - CTEST_VAL = ('LARRY', 'MOE', 'CURLY' ) - - ITEST_VAL = ( 3141, 186, 282 ) - - DTEST_VAL = ( 3.1415, 186. , 282.397 ) - - - The program... - - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - #define LENOUT 20 - #define NUMVALS 2 - #define START 1 - - void main() - { - - SpiceInt n; - SpiceChar cvals[NUMVALS][LENOUT]; - SpiceBoolean found; - SpiceInt i; - - - ldpool_c ( "test.ker" ); - - - /. - Get 2 values (NUMVALs) starting at the second value - in the list (START). Each value will be of length LENOUT. - ./ - - gcpool_c ( "CTEST_VAL", START, NUMVALS, LENOUT, &n, cvals, - &found ); - - for ( i = 0; i < NUMVALS; i++ ) - { - printf("%s\n", cvals[i] ); - } - - exit(0); - } - - - Will give output of - MOE - CURLY - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Version - - -CSPICE Version 2.2.1 07-SEP-2007 (EDW) - - Edited the 'lenout' description in the Detailed_Input to - remove the recommendation of 32 as a general use value - for 'lenout'. - - -CSPICE Version 2.2.0 18-MAY-2001 (WLT) - - Added a cast to (char *) in the call to F2C_ConvertStrArr. - - -CSPICE Version 2.1.0 22-JUN-1999 (EDW) - - Added local variable to return boolean/logical values. This - fix allows the routine to function if int and long are different - sizes. - - -CSPICE Version 2.0.3 09-FEB-1998 (EDW) - - Removed the output dynamically allocated string. Conversion - of cval from string to array now accomplished via the - F2C_ConvertStrArray call. - - -CSPICE Version 2.0.2 01-FEB-1998 (EDW) - - Removed the input and work dynamically allocated strings. - - -CSPICE Version 2.0.1 28-JAN-1998 (EDW) - - The start parameter is now zero based as per C convention. - Adjusted the amount of memory for the strings to lenout-1. - - -CSPICE Version 2.0.0 07-JAN-1998 (EDW) - - The routine now function properly for room > 1. Previously - only a single value could be returned. - - -CSPICE Version 1.0.0 23-OCT-1997 (EDW) - - --Index_Entries - - RETURN the character value of a pooled kernel variable - RETURN the string value of a pooled kernel variable - --& -*/ - -{ /* Begin gcpool_c */ - - - /* - Local variables. - */ - logical yes; - - - /* The index is zero based here but not in gcpool_. */ - start = start + 1; - - - /* - Participate in error tracing. - */ - chkin_c ( "gcpool_c"); - - - /* - Check the input string utcstr to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gcpool_c", name ); - - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "gcpool_c", cvals, lenout ); - - - - /* - Call the f2c'd routine - */ - - gcpool_( ( char * ) name, - ( integer * ) &start, - ( integer * ) &room, - ( integer * ) n, - ( char * ) cvals, - ( logical * ) &yes, - ( ftnlen ) strlen(name), - ( ftnlen ) lenout - 1 ); - - - /* Cast back to a SpiceBoolean. */ - *found = yes; - - if ( *found ) - { - /* - cvals now contains the requested data in a single string - lenout * n long. We need to reform cvals into an array - of n strings each lenout long. - */ - F2C_ConvertTrStrArr ( *n, lenout, (char *)cvals ); - } - - - /* Done. Checkout. */ - chkout_c ( "gcpool_c"); - -} /* End gcpool_c */ - - diff --git a/ext/spice/src/cspice/gdpool_c.c b/ext/spice/src/cspice/gdpool_c.c deleted file mode 100644 index f759c0d04f..0000000000 --- a/ext/spice/src/cspice/gdpool_c.c +++ /dev/null @@ -1,306 +0,0 @@ -/* - --Procedure gdpool_c (Get d.p. values from the kernel pool) - --Abstract - - Return the d.p. value of a kernel variable from the kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void gdpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceDouble * values, - SpiceBoolean * found ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the variable whose value is to be returned. - start I Which component to start retrieving for name - room I The largest number of values to return. - n O Number of values returned for name. - values O Values associated with name. - found O True if variable is in pool. - --Detailed_Input - - name is the name of the variable whose values are to be - returned. If the variable is not in the pool with - numeric type, found will be SPICEFALSE. - - start is the index of the first component of name to return. - The index follows the C convention of being 0 based. - If start is less than 0, it will be treated as 0. If - start is greater than the total number of components - available for name, no values will be returned (n will - be set to zero). However, found will still be set to - SPICETRUE - - room is the maximum number of components that should be - returned for this variable. (Usually it is the amount - of room available in the array values). If room is - less than 1 the error SPICE(BADARRAYSIZE) will be - signaled. - --Detailed_Output - - n is the number of values associated with name that - are returned. It will always be less than or equal - to room. - - If name is not in the pool with numeric type, no value - is given to n. - - values is the array of values associated with name. - If name is not in the pool with numeric type, no - values are given to the elements of values. - - found is SPICETRUE if the variable is in the pool and has - numeric type, SPICEFALSE if it is not. - --Parameters - - None. - --Exceptions - - 1) If the value of room is less than one the error - SPICE(BADARRAYSIZE) is signaled. - - 2) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 3) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled. - --Files - - None. - --Particulars - - This routine provides the user interface to retrieving - numeric data stored in the kernel pool. This interface - allows you to retrieve the data associated with a variable - in multiple accesses. Under some circumstances this alleviates - the problem of having to know in advance the maximum amount - of space needed to accommodate all kernel variables. - - However, this method of access does come with a price. It is - always more efficient to retrieve all of the data associated - with a kernel pool data in one call than it is to retrieve - it in sections. - - This routine should be used in place of rtpool_c when possible - as it avoids errors associated with writing data past the - end of an array. - - See also the entry points gipool_c and gcpool_c. - --Examples - - - The following code fragment demonstrates how the data stored - in a kernel pool variable can be retrieved in pieces. Using the - kernel "test.ker" which contains - - \begindata - - CTEST_VAL = ('LARRY', 'MOE', 'CURLY' ) - - ITEST_VAL = ( 3141, 186, 282 ) - - DTEST_VAL = ( 3.1415, 186.282, .0175 ) - - - The program... - - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - #define NUMVALS 2 - - - void main() - { - - SpiceInt n; - SpiceInt i; - - SpiceBoolean found; - - SpiceDouble vals[NUMVALS]; - - - ldpool_c ( "test.ker" ); - - - /. Is data available by that name. ./ - - gdpool_c ( "DTEST_VAL", 0, NUMVALS, &n, vals, &found ); - - - /. If so, show me the values. ./ - - if ( !found ) - { - printf ( "No dp data available for DTEST_VAL.\n" ); - } - - else - { - - for ( i=0; i < NUMVALS; i++ ) - { - gdpool_c ( "DTEST_VAL", i, NUMVALS, &n, vals, &found ); - - printf ( "%f \n", vals[i] ); - } - - } - - exit(0); - } - - - Output should be - - 186.282000 - 0.017500 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.1.0 22-JUN-1999 (EDW) - - Re-implemented routine without dynamically allocated, temporary - strings. - - Added local variable to return boolean/logical values. This - fix allows the routine to function if int and long are different - sizes. - - -CSPICE Version 2.0.1 08-FEB-1998 (EDW) - - The start parameter is now zero based as per C convention. - - -CSPICE Version 1.0.1, 6-JAN-1998 (EDW) - - Replaced example routine. Included the data for a test kernel. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - RETURN the d.p. value of a pooled kernel variable - RETURN the numeric value of a pooled kernel variable - --& -*/ - -{ /* Begin gdpool_c */ - - /* - Local variables. - */ - logical yes; - - - /* The index is zero based here but not in gdpool_. */ - start = start + 1; - - - /* - Participate in error handling - */ - chkin_c ( "gdpool_c"); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gdpool_c", name ); - - - /* - Call the f2c'd routine - */ - gdpool_( ( char * ) name, - ( integer * ) &start, - ( integer * ) &room, - ( integer * ) n, - ( doublereal * ) values, - ( logical * ) &yes, - ( ftnlen ) strlen(name) ); - - - - /* Cast back to a SpiceBoolean. */ - *found = yes; - - - /* Done. Checkout. */ - chkout_c ( "gdpool_c"); - - -} /* End gdpool_c */ diff --git a/ext/spice/src/cspice/georec.c b/ext/spice/src/cspice/georec.c deleted file mode 100644 index 056b433ed8..0000000000 --- a/ext/spice/src/cspice/georec.c +++ /dev/null @@ -1,340 +0,0 @@ -/* georec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b11 = 1.; - -/* $Procedure GEOREC ( Geodetic to rectangular coordinates ) */ -/* Subroutine */ int georec_(doublereal *long__, doublereal *lat, doublereal * - alt, doublereal *re, doublereal *f, doublereal *rectan) -{ - /* System generated locals */ - doublereal d__1, d__2, d__3, d__4; - - /* Builtin functions */ - double cos(doublereal), sin(doublereal), sqrt(doublereal); - - /* Local variables */ - doublereal base[3], cphi, sphi, scale, x, y; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen), vlcom_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - doublereal clmbda, rp, slmbda, height, normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), surfnm_(doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - extern logical return_(void); - doublereal big; - -/* $ Abstract */ - -/* Convert geodetic coordinates to rectangular coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LONG I Geodetic longitude of point (radians). */ -/* LAT I Geodetic latitude of point (radians). */ -/* ALT I Altitude of point above the reference spheroid. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* RECTAN O Rectangular coordinates of point. */ - -/* $ Detailed_Input */ - -/* LONG Geodetic longitude of the input point. This is the */ -/* angle between the prime meridian and the meridian */ -/* containing RECTAN. The direction of increasing */ -/* longitude is from the +X axis towards the +Y axis. */ - -/* Longitude is measured in radians. On input, the */ -/* range of longitude is unrestricted. */ - -/* LAT Geodetic latitude of the input point. For a point P */ -/* on the reference spheroid, this is the angle between */ -/* the XY plane and the outward normal vector at P. */ -/* For a point P not on the reference spheroid, the */ -/* geodetic latitude is that of the closest point to P on */ -/* the spheroid. */ - -/* Latitude is measured in radians. On input, the */ -/* range of latitude is unrestricted. */ - -/* ALT Altitude of point above the reference spheroid. */ - -/* RE Equatorial radius of a reference spheroid. This */ -/* spheroid is a volume of revolution: its horizontal */ -/* cross sections are circular. The shape of the */ -/* spheroid is defined by an equatorial radius RE and */ -/* a polar radius RP. */ - -/* F Flattening coefficient = (RE-RP) / RE, where RP is */ -/* the polar radius of the spheroid. */ - -/* $ Detailed_Output */ - -/* RECTAN The rectangular coordinates of a point. */ - -/* The units associated with RECTAN are those associated */ -/* with the input ALT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the flattening coefficient is greater than or equal to */ -/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 2) If the equatorial radius is less than or equal to zero, */ -/* the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given the geodetic coordinates of a point, and the constants */ -/* describing the reference spheroid, this routine returns the */ -/* bodyfixed rectangular coordinates of the point. The bodyfixed */ -/* rectangular frame is that having the x-axis pass through the */ -/* 0 degree latitude 0 degree longitude point. The y-axis passes */ -/* through the 0 degree latitude 90 degree longitude. The z-axis */ -/* passes through the 90 degree latitude point. For some bodies */ -/* this coordinate system may not be a right-handed coordinate */ -/* system. */ - -/* $ Examples */ - -/* This routine can be used to convert body fixed geodetic */ -/* coordinates (such as the used for United States Geological */ -/* Survey topographic maps) to bodyfixed rectangular coordinates */ -/* such as the Satellite Tracking and Data Network of 1973. */ - -/* The code would look something like this */ - -/* C */ -/* C Using the equatorial radius of the Clark66 spheroid */ -/* C (CLARKR = 6378.2064 km) and the Clark 66 flattening */ -/* C factor (CLARKF = 1.0D0 / 294.9787D0 ) convert to */ -/* C body fixed rectangular coordinates. */ -/* C */ -/* CALL GEOREC ( LONG, LAT, ALT, CLARKR, CLARKF, X ) */ - -/* C */ -/* C Add the North American Datum of 1927 to STDN 73 center */ -/* C offset */ -/* C */ -/* CALL VADD ( X, OFFSET, STDNX ) */ - - -/* Below are two tables. */ - -/* Listed in the first table (under LONG, LAT, and ALT ) are */ -/* geodetic coordinate triples that approximately represent points */ -/* whose rectangular coordinates are taken from the set {-1, 0, 1}. */ -/* (Angular quantities are given in degrees.) */ - -/* The result of the code fragment */ - -/* C */ -/* C Use the SPICELIB routine CONVRT to convert the angular */ -/* C quantities to degrees. */ -/* C */ -/* CALL CONVRT ( LAT, 'DEGREES', 'RADIANS', LAT ) */ -/* CALL CONVRT ( LONG, 'DEGREES', 'RADIANS', LONG ) */ - -/* CALL GEOREC ( LONG, LAT, ALT, CLARKR, CLARKF, X ) */ - - -/* are listed in the second parallel table under X(1), X(2) and X(3). */ - - -/* LONG LAT ALT X(1) X(2) X(3) */ -/* ------------------------------ -------------------------- */ -/* 0.0000 90.0000 -6356.5838 0.0000 0.0000 0.0000 */ -/* 0.0000 0.0000 -6377.2063 1.0000 0.0000 0.0000 */ -/* 90.0000 0.0000 -6377.2063 0.0000 1.0000 0.0000 */ -/* 0.0000 90.0000 -6355.5838 0.0000 0.0000 1.0000 */ -/* 180.0000 0.0000 -6377.2063 -1.0000 0.0000 0.0000 */ -/* -90.0000 0.0000 -6377.2063 0.0000 -1.0000 0.0000 */ -/* 0.0000 -90.0000 -6355.5838 0.0000 0.0000 -1.0000 */ -/* 45.0000 0.0000 -6376.7921 1.0000 1.0000 0.0000 */ -/* 0.0000 88.7070 -6355.5725 1.0000 0.0000 1.0000 */ -/* 90.0000 88.7070 -6355.5725 0.0000 1.0000 1.0000 */ -/* 45.0000 88.1713 -6355.5612 1.0000 1.0000 1.0000 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* See FUNDAMENTALS OF ASTRODYNAMICS, Bate, Mueller, White */ -/* published by Dover for a description of geodetic coordinates. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 29-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - 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 */ - -/* geodetic to rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 3.0.0, 9-JUN-1989 (HAN) */ - -/* Error handling added to detect equatorial radius out of */ -/* range. If the equatorial radius is less than or equal to */ -/* zero, an error is signaled. */ - -/* - Beta Version 2.0.0, 21-DEC-1988 (HAN) */ - -/* Error handling to detect invalid flattening coefficients */ -/* was added. Because the flattening coefficient is used to */ -/* compute the polar radius, it must be checked so that the */ -/* polar radius greater than zero. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GEOREC", (ftnlen)6); - } - -/* The equatorial radius must be greater than zero. */ - - if (*re <= 0.) { - setmsg_("Equatorial radius was *.", (ftnlen)24); - errdp_("*", re, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("GEOREC", (ftnlen)6); - return 0; - } - -/* If the flattening coefficient is greater than one, the polar */ -/* radius computed below is negative. If it's equal to one, the */ -/* polar radius is zero. Either case is a problem, so signal an */ -/* error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was *.", (ftnlen)29); - errdp_("*", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("GEOREC", (ftnlen)6); - return 0; - } - -/* Move the altitude to a temporary variable. */ - - height = *alt; - -/* Compute the polar radius of the spheroid. */ - - rp = *re - *f * *re; - -/* Compute a scale factor needed for finding the rectangular */ -/* coordinates of a point with altitude 0 but the same geodetic */ -/* latitude and longitude as the input point. */ - - cphi = cos(*lat); - sphi = sin(*lat); - clmbda = cos(*long__); - slmbda = sin(*long__); -/* Computing MAX */ - d__3 = (d__1 = *re * cphi, abs(d__1)), d__4 = (d__2 = rp * sphi, abs(d__2) - ); - big = max(d__3,d__4); - x = *re * cphi / big; - y = rp * sphi / big; - scale = 1. / (big * sqrt(x * x + y * y)); - -/* Compute the rectangular coordinates of the point with zero */ -/* altitude. */ - - base[0] = scale * *re * *re * clmbda * cphi; - base[1] = scale * *re * *re * slmbda * cphi; - base[2] = scale * rp * rp * sphi; - -/* Fetch the normal to the ellipsoid at this point. */ - - surfnm_(re, re, &rp, base, normal); - -/* Move along the normal to the input point. */ - - vlcom_(&c_b11, base, &height, normal, rectan); - chkout_("GEOREC", (ftnlen)6); - return 0; -} /* georec_ */ - diff --git a/ext/spice/src/cspice/georec_c.c b/ext/spice/src/cspice/georec_c.c deleted file mode 100644 index 14b63fe561..0000000000 --- a/ext/spice/src/cspice/georec_c.c +++ /dev/null @@ -1,257 +0,0 @@ -/* - --Procedure georec_c ( Geodetic to rectangular coordinates ) - --Abstract - - Convert geodetic coordinates to rectangular coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void georec_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - lon I Geodetic longitude of point (radians). - lat I Geodetic latitude of point (radians). - alt I Altitude of point above the reference spheroid. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - rectan O Rectangular coordinates of point. - --Detailed_Input - - lon Geodetic longitude of the input point. This is the - angle between the prime meridian and the meridian - containing `rectan'. The direction of increasing - longitude is from the +X axis towards the +Y axis. - - Longitude is measured in radians. On input, the - range of longitude is unrestricted. - - - lat Geodetic latitude of the input point. For a point P on - the reference spheroid, this is the angle between the XY - plane and the outward normal vector at P. For a point P - not on the reference spheroid, the geodetic latitude is - that of the closest point to P on the spheroid. - - Latitude is measured in radians. On input, the - range of latitude is unrestricted. - - - alt Altitude of point above the reference spheroid. - - - re Equatorial radius of a reference spheroid. This spheroid - is a volume of revolution: its horizontal cross sections - are circular. The shape of the spheroid is defined by - an equatorial radius `re' and a polar radius `rp'. - - - f Flattening coefficient = (re-rp) / re, where `rp' is - the polar radius of the spheroid. - --Detailed_Output - - rectan Rectangular coordinates of the input point. - - The units associated with `rectan' are those associated - with the input `alt'. - --Parameters - - None. - --Exceptions - - 1) If the equatorial radius is less than or equal to zero, - the error SPICE(VALUEOUTOFRANGE) is signaled. - - 2) If the flattening coefficient is greater than or equal to - one, the error SPICE(VALUEOUTOFRANGE) is signaled. - --Files - - None. - --Particulars - - Given the geodetic coordinates of a point, and the constants - describing the reference spheroid, this routine returns the - bodyfixed rectangular coordinates of the point. The bodyfixed - rectangular frame is that having the x-axis pass through the 0 - degree latitude 0 degree longitude point. The y-axis passes through - the 0 degree latitude 90 degree longitude. The z-axis passes - through the 90 degree latitude point. For some bodies this - coordinate system may not be a right-handed coordinate system. - --Examples - - This routine can be used to convert body fixed geodetic - coordinates (such as the used for United States Geological - Survey topographic maps) to bodyfixed rectangular coordinates - such as the Satellite Tracking and Data Network of 1973. - - The code would look something like this - - /. - Using the equatorial radius of the Clark66 spheroid - (CLARKR = 6378.2064 km) and the Clark 66 flattening - factor (CLARKF = 1.0 / 294.9787 ) convert to - body fixed rectangular coordinates. - ./ - - georec_c ( lon, lat, alt, CLARKR, CLARKF, x ); - - /. - Add the North American Datum of 1927 to STDN 73 center - offset - ./ - - vadd_c ( x, offset, stdnx ); - - - Below are two tables. - - Listed in the first table (under lon, lat, and alt ) are - geodetic coordinate triples that approximately represent points - whose rectangular coordinates are taken from the set {-1, 0, 1}. - (Angular quantities are given in degrees.) - - The results of the code fragment - - /. - Convert the angular quantities to degrees - ./ - lat = lat * rpd_c(); - lon = lon * rpd_c(); - - georec_c ( lon, lat, alt, CLARKR, CLARKF, x ); - - - are listed in the second parallel table under x[0], x[1] and x[2]. - - - lon lat alt x[0] x[1] x[2] - ------------------------------ -------------------------- - 0.0000 90.0000 -6356.5838 0.0000 0.0000 0.0000 - 0.0000 0.0000 -6377.2063 1.0000 0.0000 0.0000 - 90.0000 0.0000 -6377.2063 0.0000 1.0000 0.0000 - 0.0000 90.0000 -6355.5838 0.0000 0.0000 1.0000 - 180.0000 0.0000 -6377.2063 -1.0000 0.0000 0.0000 - -90.0000 0.0000 -6377.2063 0.0000 -1.0000 0.0000 - 0.0000 -90.0000 -6355.5838 0.0000 0.0000 -1.0000 - 45.0000 0.0000 -6376.7921 1.0000 1.0000 0.0000 - 0.0000 88.7070 -6355.5725 1.0000 0.0000 1.0000 - 90.0000 88.7070 -6355.5725 0.0000 1.0000 1.0000 - 45.0000 88.1713 -6355.5612 1.0000 1.0000 1.0000 - - --Restrictions - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - See FUNDAMENTALS OF ASTRODYNAMICS, Bate, Mueller, White - published by Dover for a description of geodetic coordinates. - --Version - - -CSPICE Version 1.0.2, 30-JUL-2003 (NJB) - - Various header corrections were made. - - -CSPICE Version 1.0.1, 11-JAN-2003 (EDW) - - Removed a spurious non-printing character. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - geodetic to rectangular coordinates - --& -*/ - -{ /* Begin georec_c */ - - /* - Participate in error handling - */ - - chkin_c ( "georec_c"); - - - /* - Call the f2c'd routine. - */ - - georec_( ( doublereal * ) &lon, - ( doublereal * ) &lat, - ( doublereal * ) &alt, - ( doublereal * ) &re, - ( doublereal * ) &f, - ( doublereal * ) rectan ); - - - chkout_c ( "georec_c"); - - -} /* End georec_c */ diff --git a/ext/spice/src/cspice/getcml_c.c b/ext/spice/src/cspice/getcml_c.c deleted file mode 100644 index 5a281011b1..0000000000 --- a/ext/spice/src/cspice/getcml_c.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - --Procedure getcml_c ( Get the command line ) - --Abstract - - Store the contents of argv and argc for later access.. - --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 - - UTILITY - -*/ - - #include - #include - - #include "SpiceUsr.h" - - void getcml_c ( SpiceInt * argc, - SpiceChar *** argv ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - argc O The number of command line arguments. - argv O The vector of command line arguments. - --Detailed_Input - - None. - --Detailed_Output - - argc is the number of command line arguments. - - argv is the vector of space delimited command line arguments. - Each entry entry contains one argument. argv[0] is the - command name. - --Parameters - - None. - --Exceptions - - This routines participates in error tracing but detects no errors. - Error detection is done in zzgetcml_c.c. - --Files - - None. - --Particulars - - This routine is a wrapper function for zzgetcml_c.c. getcml_c - allows a user to access the argv and argc values from any program - module. - --Examples - - #include - #include - - #include "SpiceUsr.h" - - void main( int argc, char *argv[] ) - { - - - /. Store argv and argc for latter access. ./ - - putcml_c (argc, argv ); - - - ..... other stuff ..... - ..... ..... - - } - - - void goop () - { - ..... new module ..... - - SpiceInt argc; - SpiceChar ** argv; - - - ..... - ..... - - /. Now get the stored information. ./ - - getcml_c ( &argc, &argv ); - - } - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 08-FEB-1998 (EDW) - - Routine rewritten to use private routine zzgetcml_c.c. - - -CSPICE Version 1.0.1, 14-JAN-1997 (EDW) - - Replaced a defined variable type for argv with a *** declaration. - - -CSPICE Version 1.0.0, 6-JAN-1997 (EDW) - --Index_Entries - - store/retrieve argc argv - --& -*/ - -{ - - /* - 'zzgetcml_c' does all the real work. Make the call. The SPICEFALSE - boolean indicates the call is comming from getcml_c.c and not - putcml_c.c - */ - - chkin_c( "getcml_c" ); - - zzgetcml_c ( argc, argv, SPICEFALSE ); - - chkout_c( "getcml_c" ); - -} - diff --git a/ext/spice/src/cspice/getelm.c b/ext/spice/src/cspice/getelm.c deleted file mode 100644 index 5c739ebcb8..0000000000 --- a/ext/spice/src/cspice/getelm.c +++ /dev/null @@ -1,306 +0,0 @@ -/* getelm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure GETELM ( Get the components from two-line elements) */ -/* Subroutine */ int getelm_(integer *frstyr, char *lines, doublereal *epoch, - doublereal *elems, ftnlen lines_len) -{ - extern /* Subroutine */ int zzgetelm_(integer *, char *, doublereal *, - doublereal *, logical *, char *, ftnlen, ftnlen), chkin_(char *, - ftnlen), errch_(char *, char *, ftnlen, ftnlen); - char error[256]; - logical ok; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Given a the "lines" of a two-line element set, parse the */ -/* lines and return the elements in units suitable for use */ -/* in SPICE software. */ - -/* $ 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 */ - -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRSTYR I year of earliest representable two-line elements */ -/* LINES I a pair of "lines" containing two-line elements */ -/* EPOCH O The epoch of the elements in seconds past J2000 */ -/* ELEMS O The elements converted to SPICE units. */ - -/* $ Detailed_Input */ - -/* FRSTYR is the first year possible for two line elements. */ -/* Since two line elements allow only two digits for */ -/* the year, some conventions must be followed concerning */ -/* which century the two digits refer to . FRSTYR */ -/* is the year of the earliest representable elements. */ -/* The two-digit year is mapped to the year in */ -/* the interval from FRSTYR to FRSTYR + 99 that */ -/* has the same last two digits as the two digit */ -/* year in the element set. For example if FRSTYR */ -/* is set to 1960 then the two digit years are mapped */ -/* as shown in the table below: */ - -/* Two-line Maps to */ -/* element year */ -/* 00 2000 */ -/* 01 2001 */ -/* 02 2002 */ -/* . . */ -/* . . */ -/* . . */ -/* 58 2058 */ -/* 59 2059 */ -/* -------------------- */ -/* 60 1960 */ -/* 61 1961 */ -/* 62 1962 */ -/* . . */ -/* . . */ -/* . . */ -/* 99 1999 */ - -/* Note that if Space Command should decide to represent */ -/* years in 21st century as 100 + the last two digits */ -/* of the year (for example: 2015 is represented as 115) */ -/* instead of simply dropping the first two digits of */ -/* the year, this routine will correctly map the year */ -/* as long as you set FRSTYR to some value between 1900 */ -/* and 1999. */ - -/* LINES is a pair of lines of text that comprise a Space */ -/* command ``two-line element'' set. These text lines */ -/* should be the same as they are presented in the */ -/* two-line element files available from Space Command */ -/* (formerly NORAD). Below is an example of a two-line */ -/* set for TOPEX. */ - -/* TOPEX */ -/* 1 22076U 92052A 97173.53461370 -.00000038 00000-0 10000-3 0 594 */ -/* 2 22076 66.0378 163.4372 0008359 278.7732 81.2337 12.80930736227550 */ - - -/* $ Detailed_Output */ - -/* EPOCH is the epoch of the two line elements supplied via */ -/* the input array LINES. Epoch is returned in TDB */ -/* seconds past J2000. */ - -/* ELEMS is an array containing the elements from the two line */ -/* set supplied via the array LINES. The elements are */ -/* in units suitable for use by the SPICE routine */ -/* EV2LIN. */ - -/* Also note that the elements XNDD6O and BSTAR */ -/* incorporate the exponential factor present in the */ -/* input two line elements in LINES. (See particulars */ -/* below. */ - -/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */ -/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */ -/* ELEMS ( 3 ) = BSTAR */ -/* ELEMS ( 4 ) = XINCL in radians */ -/* ELEMS ( 5 ) = XNODEO in radians */ -/* ELEMS ( 6 ) = EO */ -/* ELEMS ( 7 ) = OMEGAO in radians */ -/* ELEMS ( 8 ) = XMO in radians */ -/* ELEMS ( 9 ) = XNO in radians/minute */ -/* ELEMS ( 10 ) = EPOCH of the elements in seconds */ -/* past ephemeris epoch J2000. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* You must have loaded a SPICE leapseconds kernel into the */ -/* kernel pool prior to caling this routine. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while trying to parse the two-line element */ -/* set, the error 'SPICE(BADTLE)' signals. */ - -/* $ Particulars */ - -/* This routine passes a Space Command Two-line element set */ -/* to the parsing routine ZZGETELM. Input elements have the */ -/* form: */ - -/* 1 22076U 92052A 97173.53461370 -.00000038 00000-0 10000-3 0 594 */ -/* 2 22076 66.0378 163.4372 0008359 278.7732 81.2337 12.80930736227550 */ -/* ^ */ -/* 123456789012345678901234567890123456789012345678901234567890123456789 */ -/* 1 2 3 4 5 6 */ - -/* $ Examples */ - -/* Suppose you have a set of two-line elements and an array */ -/* containing the related geophysical constants necessary */ -/* to evaluate a state. The example below shows how you */ -/* can use this routine together with the routine EV2LIN to */ -/* propagate a state to an epoch of interest. */ - - -/* The parameters below will make it easier to make assignments */ -/* to the array GEOPHS required by EV2LIN. */ - -/* J2 --- location of J2 */ -/* J3 --- location of J3 */ -/* J4 --- location if J4 */ -/* KE --- location of KE = sqrt(GM) in eart-radii**1.5/MIN */ -/* QO --- location of upper bound of atmospheric model in KM */ -/* SO --- location of lower bound of atmospheric model in KM */ -/* ER --- location of earth equatorial radius in KM. */ -/* AE --- location of distance units/earth radius */ - -/* PARAMETER ( J2 = 1 ) */ -/* PARAMETER ( J3 = 2 ) */ -/* PARAMETER ( J4 = 3 ) */ -/* PARAMETER ( KE = 4 ) */ -/* PARAMETER ( QO = 5 ) */ -/* PARAMETER ( SO = 6 ) */ -/* PARAMETER ( ER = 7 ) */ -/* PARAMETER ( AE = 8 ) */ - - -/* We set the lower bound for the years to be the beginning */ -/* of the space age. */ - -/* FRSTYR = 1957 */ - -/* Read in the next two lines from the text file that contains */ -/* the two-line elements. We assume that file has been opened */ -/* properly and that we have set the ``file pointer'' to the */ -/* correct location for reading the next set of elements. */ - -/* READ (UNIT,FMT='(A)' ) LINE(1) */ -/* READ (UNIT,FMT='(A)' ) LINE(2) */ - -/* CALL GETELM ( FRSTYR, LINE, EPOCH, ELEMS ) */ - -/* Set up the geophysical quantities. At last check these */ -/* were the values used by Space Command. */ - -/* GEOPHS( J2 ) = 1.082616D-3 */ -/* GEOPHS( J3 ) = -2.53881D-6 */ -/* GEOPHS( J4 ) = -1.65597D-6 */ -/* GEOPHS( KE ) = 7.43669161D-2 */ -/* GEOPHS( QO ) = 120.0D0 */ -/* GEOPHS( SO ) = 78.0D0 */ -/* GEOPHS( ER ) = 6378.135D0 */ -/* GEOPHS( AE ) = 1.0D0 */ - -/* Now propagate the state using EV2LIN to the epoch of */ -/* interest. */ - -/* CALL EV2LIN ( ET, GEOPHS, ELEMS, STATE ) */ - - -/* $ Restrictions */ - -/* Please refer to the header of ZZGETELM. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 30-MAR-2004 (EDW) */ - -/* Routine now passes inputs to ZZGETELM then reponds to */ -/* any error condition. */ - -/* - SPICELIB Version 2.0.0, 03-MAR-2000 (WLT) */ - -/* The routine was modified to check that all of the terms */ -/* in the two-line element set are parsed correctly. */ - -/* - SPICELIB Version 1.0.0, 26-JUN-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Parse two-line elements */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GETELM", (ftnlen)6); - -/* Pass the input to the parse routine... */ - - zzgetelm_(frstyr, lines, epoch, elems, &ok, error, lines_len, (ftnlen)256) - ; - -/* ...check for an error parsing the TLE pair. Signal an */ -/* error if OK equals .FALSE. */ - - if (! ok) { - setmsg_("Error in TLE set. #", (ftnlen)19); - errch_("#", error, (ftnlen)1, (ftnlen)256); - sigerr_("SPICE(BADTLE)", (ftnlen)13); - chkout_("GETELM", (ftnlen)6); - return 0; - } - chkout_("GETELM", (ftnlen)6); - return 0; -} /* getelm_ */ - diff --git a/ext/spice/src/cspice/getelm_c.c b/ext/spice/src/cspice/getelm_c.c deleted file mode 100644 index 0e2a69202c..0000000000 --- a/ext/spice/src/cspice/getelm_c.c +++ /dev/null @@ -1,443 +0,0 @@ -/* - --Procedure getelm_c ( Get the components from two-line elements) - --Abstract - - Given a the "lines" of a two-line element set, parse the - lines and return the elements in units suitable for use - in SPICE software. - --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 - - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef getelm_c - - - void getelm_c ( SpiceInt frstyr, - SpiceInt lineln, - const void * lines, - SpiceDouble * epoch, - SpiceDouble * elems ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - frstyr I Year of earliest representable two-line elements. - lineln I Length of strings in lines array. - lines I A pair of "lines" containing two-line elements. - epoch O The epoch of the elements in seconds past J2000. - elems O The elements converted to SPICE units. - --Detailed_Input - - frstyr is the first year possible for two line elements. Since - two line elements allow only two digits for the year, some - conventions must be followed concerning which century the - two digits refer to. frstyr is the year of the earliest - representable elements. The two-digit year is mapped to - the year in the interval from frstyr to frstyr + 99 that - has the same last two digits as the two digit year in the - element set. For example if frstyr is set to 1960 then - the two digit years are mapped as shown in the table - below: - - Two-line Maps to - element year - - 00 2000 - 01 2001 - 02 2002 - . . - . . - . . - 58 2058 - 59 2059 - -------------------- - 60 1960 - 61 1961 - 62 1962 - . . - . . - . . - 99 1999 - - Note that if Space Command should decide to represent - years in 21st century as 100 + the last two digits of the - year (for example: 2015 is represented as 115) instead of - simply dropping the first two digits of the year, this - routine will correctly map the year as long as you set - frstyr to some value between 1900 and 1999. - - lines is a pair of lines of text that comprise a Space command - ``two-line element'' set. lines should be declared - - SpiceChar lines[2][lineln]; - - These text lines should be the same as they are presented - in the two-line element files available from Space - Command (formerly NORAD). Below is an example of a - two-line set for TOPEX. - - TOPEX - 1 22076U 92052A 97173.53461370 -.00000038 00000-0 10000-3 0 594 - 2 22076 66.0378 163.4372 0008359 278.7732 81.2337 12.80930736227550 - - - - --Detailed_Output - - epoch is the epoch of the two line elements supplied via - the input array lines. Epoch is returned in TDB - seconds past J2000. - - elems is an array containing the elements from the two line - set supplied via the array lines. The elements are - in units suitable for use by the CSPICE routine - ev2lin_. - - Also note that the elements XNDD6O and BSTAR - incorporate the exponential factor present in the - input two line elements in LINES. (See particulars - below. - - ELEMS [ 0 ] = XNDT2O in radians/minute**2 - ELEMS [ 1 ] = XNDD6O in radians/minute**3 - ELEMS [ 2 ] = BSTAR - ELEMS [ 3 ] = XINCL in radians - ELEMS [ 4 ] = XNODEO in radians - ELEMS [ 5 ] = EO - ELEMS [ 6 ] = OMEGAO in radians - ELEMS [ 7 ] = XMO in radians - ELEMS [ 8 ] = XNO in radians/minute - ELEMS [ 9 ] = EPOCH of the elements in seconds - past ephemeris epoch J2000. - --Parameters - - None. - --Exceptions - - No checking of the inputs is performed in this routine. However, this - routine does call other CSPICE routines. If one of these routines - detects an error it will diagnose it and signal an error. - --Files - - You must have loaded a SPICE leapseconds kernel into the - kernel pool prior to caling this routine. - --Particulars - - This routine parses a Space Command Two-line element set and returns - the orbital elements properly scaled and in units suitable for use - by other SPICE software. Input elements look like the following - ---------------------------------------------------------------------- -1 22076U 92052A 97173.53461370 -.00000038 00000-0 10000-3 0 594 -2 22076 66.0378 163.4372 0008359 278.7732 81.2337 12.80930736227550 ---------------------------------------------------------------------- -^ -123456789012345678901234567890123456789012345678901234567890123456789 - 1 2 3 4 5 6 - - The ``raw'' elements in the first and second lines are marked below. - Note that in several instances exponents and decimal points are - implied. Also note that input units are degrees, degrees/day**n and - revolutions/day. - - - DAY OF YEAR NDD60 BSTAR - vvvvvvvvvvvv vvvvvv vvvvvv ---------------------------------------------------------------------- -1 22076U 92052A 97173.53461370 -.00000038 00000-0 10000-3 0 594 ---------------------------------------------------------------------- - ^^ ^^^^^^^^^^ ^^ ^^ - YEAR NDT20 IEXP IBEXP - - - - The ``raw'' elements in the second line are marked below - NODE0 OMEGA N0 - vvvvvvvv vvvvvvvv vvvvvvvvvvv ---------------------------------------------------------------------- -2 22076 66.0378 163.4372 0008359 278.7732 81.2337 12.80930736227550 ---------------------------------------------------------------------- - ^^^^^^^^ ^^^^^^^ ^^^^^^^^ - Inclination Eccentricity M0 - - This routine extracts these values ``inserts'' the implied - decimal points and exponents and then converts the inputs - to units of radians, radians/minute, radians/minute**2, and - radians/minute**3 - --Examples - - Suppose you have a set of two-line elements and an array containing - the related geophysical constants necessary to evaluate a state. - The example below shows how you can use this routine together with - the routine EV2LIN to propagate a state to an epoch of interest. - - #include - #include - #include "SpiceUsr.h" - - SpiceDouble et; - SpiceDouble epoch; - SpiceInt frstyr; - . - . - . - /. - The parameters below will make it easier to make assignments - to the array GEOPHS required by EV2LIN. - - J2 --- location of J2 - J3 --- location of J3 - J4 --- location if J4 - KE --- location of KE = sqrt(GM) in eart-radii**1.5/MIN - QO --- location of upper bound of atmospheric model in KM - SO --- location of lower bound of atmospheric model in KM - ER --- location of earth equatorial radius in KM. - AE --- location of distance units/earth radius - ./ - - #define J2 0 - #define J3 1 - #define J4 2 - #define KE 3 - #define QO 4 - #define SO 5 - #define ER 6 - #define AE 7 - - /. - We set the lower bound for the years to be the beginning - of the space age. - ./ - frstyr = 1957; - - /. - Read in the next two lines from the text file that contains - the two-line elements. We assume that file has been opened - properly and that we have set the ``file pointer'' to the - correct location for reading the next set of elements. - ./ - - for ( i = 0; i < 2; i++ ) - { - fgets ( line[i], lineln, textfile ); - line[i][ strlen(line[i]) ] = '\0'; - } - - getelm_c ( frstyr, lineln, line, &epoch, elems ); - - - /. - Set up the geophysical quantities. At last check these - were the values used by Space Command. - ./ - - geophs[ J2 ] = 1.082616e-3; - geophs[ J3 ] = -2.53881e-6; - geophs[ J4 ] = -1.65597e-6; - geophs[ KE ] = 7.43669161e-2; - geophs[ QO ] = 120.0; - geophs[ SO ] = 78.0; - geophs[ ER ] = 6378.135; - geophs[ AE ] = 1.0; - - - /. - Now propagate the state using ev2lin_ to the epoch of - interest. - ./ - ev2lin_ ( &et, geophs, elems, state ); - - --Restrictions - - The format of the two-line elements suffer from a "millenium" - problem---only two digits are used for the year of the elements. It - is not clear how Space Command will deal with this problem as the - year 2000 comes and goes. We hope that by adjusting the input frstyr - you should be able to use this routine well into the 21st century. - However, since we can't predict how others will resolve the millenium - problem we can't be sure that our approach will be addequate to deal - with the problem. - - The approach taken to mapping the two-digit year to the full year is - given by the code below. Here, yr is the integer obtained by parsing - the two-digit year from the first line of the elements. - - begyr = (frstyr/100)*100; - year = begyr + yr; - - if ( year < frstyr ) - { - year += 100; - } - - This mapping will be changed if future two-line element - representations make this method of computing the full year - inaccurate. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 15-NOV-2007 (EDW) - - Minor edits to example section; the getelm_c call lacked - the 'lineln' argument, the use of 'et' implied a pointer - rather than a value. - - -CSPICE Version 1.0.0, 06-AUG-1999 (NJB) (WLT) - --Index_Entries - - Parse two-line elements - --& -*/ - -{ /* Begin getelm_c */ - - - /* - Local constants - */ - #define NELTS 2 - - - /* - Local variables - */ - SpiceChar ** cvalsPtr; - SpiceChar * fCvalsArr; - - SpiceInt i; - SpiceInt fCvalsLen; - - SpiceStatus status; - - /* - Participate in error tracing. - */ - chkin_c ( "getelm_c" ); - - - /* - Check the input line array for null pointer of insufficient string - length. - */ - CHKOSTR ( CHK_STANDARD, "getelm_c", lines, lineln ); - - - /* - Convert the input string array to a Fortran-style string array. - - We'll first allocate an array of character pointers to index - the values, initialize this array, and use it to produce - a dynamically allocated array of Fortran-style strings. - */ - - cvalsPtr = ( SpiceChar ** ) malloc ( NELTS * sizeof(SpiceChar *) ); - - if ( cvalsPtr == 0 ) - { - setmsg_c ( "Failure on malloc call to create pointer array " - "for line values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "getelm_c" ); - return; - } - - for ( i = 0; i < NELTS; i++ ) - { - cvalsPtr[i] = (SpiceChar *)lines + ( i * lineln ); - } - - status = C2F_CreateStrArr ( NELTS, - ( ConstSpiceChar ** ) cvalsPtr, - &fCvalsLen, - &fCvalsArr ); - /* fCvalsArr[2*fCvalsLen] = '\0'; */ - - if ( status == SPICEFAILURE ) - { - free ( cvalsPtr ); - - setmsg_c ( "C to Fortran string array conversion for `lines' " - "failed." ); - sigerr_c ( "SPICE(STRINGCONVERROR)" ); - chkout_c ( "getelm_c" ); - return; - } - - /* - Call the f2c'd routine. - */ - getelm_ ( ( integer * ) &frstyr, - ( char * ) fCvalsArr, - ( doublereal * ) epoch, - ( doublereal * ) elems, - ( ftnlen ) fCvalsLen ); - - /* - Clean up all of our dynamically allocated arrays. - */ - free ( cvalsPtr ); - free ( fCvalsArr ); - - - chkout_c ( "getelm_c" ); - -} /* End getelm_c */ diff --git a/ext/spice/src/cspice/getenv_.c b/ext/spice/src/cspice/getenv_.c deleted file mode 100644 index 02721aa31a..0000000000 --- a/ext/spice/src/cspice/getenv_.c +++ /dev/null @@ -1,194 +0,0 @@ -/* - --Procedure getenv_ ( CSPICE version of the getenv_.c routine ) - --Abstract - - This file replaces the standard f2c getenv_.c library file. The getenv_ - code now branches to Mac classic and non Mac classic code. The non Mac - code matches the standard f2c library version, the Mac classic code - returns a 0 as Mac classic has no environmental variable facility. - --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 - - TBD. - --Brief_I/O - - TBD. - --Detailed_Input - - TBD. - --Detailed_Output - - TBD. - --Parameters - - TBD. - --Exceptions - - TBD. - --Files - - TBD. - --Particulars - - getenv - f77 subroutine to return environment variables - - called by: - call getenv (ENV_NAME, char_var) - where: - ENV_NAME is the name of an environment variable - char_var is a character variable which will receive - the current value of ENV_NAME, or all blanks - if ENV_NAME is not defined - --Examples - - TBD. - --Restrictions - - 1) Requires CSPICE f2c.h header file. - - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.2, 03-APR-2009 (EDW) - - Undefined the "min" and "max" macros prior to the #include "f2c.h" - directive. f2c.h defines "min" and "max" as part of f2c. - - -CSPICE Version 1.0.1, 31-MAY-2007 (EDW) - - Added include for stdlib.h. Corrected typo in header description. - Removed CSPICE_MACPPC ifdef. - - -CSPICE Version 1.0.0, 02-JAN-2002 (EDW) - --Index_Entries - - None. - --& -*/ - -#include - -/* -Undefine min and max macros to prevent a macro redefine warning -from the min and max defintions in f2c.h. -*/ -#undef min -#undef max - -#include "f2c.h" - -#ifdef KR_headers - -void getenv_(fname, value, flen, vlen) char *value, *fname; - ftnlen vlen , flen; - -#else - -void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) - -#endif - { - - extern char **environ; - register char *ep, *fp, *flast; - register char **env = environ; - - flast = fname + flen; - - for(fp = fname ; fp < flast ; ++fp) - { - - if(*fp == ' ') - { - flast = fp; - break; - } - - } - - while (ep = *env++) - { - - for(fp = fname; fp 0) { - dashlu_(&handles[(i__1 = which + 5) < 106 && 0 <= i__1 ? i__1 - : s_rnge("handles", i__1, "getfat_", (ftnlen)634)], & - myunit); - if (unit == myunit) { - number = myunit; - which = 0; - notdas = FALSE_; - } else { - --which; - } - } - -/* If we reach this point and do not have a DAS, there */ -/* is no point in going on. The user has opened this */ -/* file outside the SPICE system. We shall not attempt */ -/* to determine its type. */ - - if (notdas) { - setmsg_("The file '#' is already open.", (ftnlen)29); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(EXTERNALOPEN)", (ftnlen)19); - chkout_("GETFAT", (ftnlen)6); - return 0; - } -/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */ -/* DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS */ -/* =================================================== */ - - } - } - -/* Open the file with a record length of RECL (the length of the */ -/* DAF and DAS records). We assume, for now, that opening the file as */ -/* a direct access file will work. */ - - diropn = TRUE_; - -/* If the file is not already open (probably the case that */ -/* happens most frequently) we try opening it for direct access */ -/* and see if we can locate the idword. */ - - if (! opened) { - getlun_(&number); - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we had trouble opening the file, try opening it as a */ -/* sequential file. */ - - if (iostat != 0) { - diropn = FALSE_; - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we still have problems opening the file, we don't have a */ -/* clue about the file architecture and type. */ - - if (iostat != 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(kertyp, "?", kertyp_len, (ftnlen)1); - setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", ( - ftnlen)48); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("GETFAT", (ftnlen)6); - return 0; - } - } - } - -/* We opened the file successfully, so let's try to read from the */ -/* file. We need to be sure to use the correct form of the read */ -/* statement, depending on whether the file was opened with direct */ -/* acces or sequential access. */ - - if (diropn) { - io___19.ciunit = number; - iostat = s_rdue(&io___19); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - -/* If we couldn't read from the file as a direct access file with */ -/* a fixed record length, then try to open the file as a */ -/* sequential file and read from it. */ - - if (iostat != 0) { - if (opened) { - -/* Something has gone wrong here. The file was opened */ -/* as either a DAF or DAS prior to the call to GETFAT. */ -/* We retrieved the unit number maintained by the */ -/* underlying binary file management system, but we */ -/* were unable to read the file as direct access. */ -/* There's nothing we can do but abandon our quest to */ -/* determine the type of the file. */ - - setmsg_("The file '#' is opened as a binary SPICE kernel. B" - "ut it cannot be read using a direct access read. The" - " value of IOSTAT returned by the attempted READ is #" - ". ", (ftnlen)157); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("GETFAT", (ftnlen)6); - return 0; - } - -/* If we reach this point, the file was opened locally */ -/* as a direct access file. We could not read it that */ -/* way, so we'll try using a sequential read. However, */ -/* we first need to close the file and then reopen it */ -/* for sequential reading. */ - - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - o__1.oerr = 1; - o__1.ounit = number; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we could not open the file, we don't have a clue about */ -/* the file architecture and type. */ - - if (iostat != 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(kertyp, "?", kertyp_len, (ftnlen)1); - setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", ( - ftnlen)48); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("GETFAT", (ftnlen)6); - return 0; - } - -/* Try to read from the file. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = number; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - ; - } - } else { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = number; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - ; - } - -/* If we had an error while reading, we don't recognize this file. */ - - if (iostat != 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(kertyp, "?", kertyp_len, (ftnlen)1); - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to read from file '#' failed. IOSTAT = #.", (ftnlen) - 49); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("GETFAT", (ftnlen)6); - return 0; - } - -/* Close the file (if we opened it here), as we do not need it */ -/* to be open any more. */ - - if (! opened) { - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - } - -/* At this point, we have a candidate for an ID word. To avoid */ -/* difficulties with Fortran I/O and other things, we will now */ -/* replace any non printing ASCII characters with blanks. */ - - for (i__ = 1; i__ <= 12; ++i__) { - if (*(unsigned char *)&tmpwrd[i__ - 1] < 32 || *(unsigned char *)& - tmpwrd[i__ - 1] > 126) { - *(unsigned char *)&tmpwrd[i__ - 1] = ' '; - } - } - -/* Identify the architecture and type, if we can. */ - - ljust_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12); - ucase_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12); - nextwd_(tmpwrd, idword, tmpwrd, (ftnlen)12, (ftnlen)12, (ftnlen)12); - if (s_cmp(idword, "DAFETF", (ftnlen)12, (ftnlen)6) == 0) { - -/* We have a DAF encoded transfer file. */ - - s_copy(arch, "XFR", arch_len, (ftnlen)3); - s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3); - } else if (s_cmp(idword, "DASETF", (ftnlen)12, (ftnlen)6) == 0) { - -/* We have a DAS encoded transfer file. */ - - s_copy(arch, "XFR", arch_len, (ftnlen)3); - s_copy(kertyp, "DAS", kertyp_len, (ftnlen)3); - } else if (s_cmp(idword, "'NAIF/DAF'", (ftnlen)10, (ftnlen)10) == 0) { - -/* We have an old DAF decimal text file. */ - - s_copy(arch, "DEC", arch_len, (ftnlen)3); - s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3); - } else if (s_cmp(idword, "NAIF/DAS", (ftnlen)8, (ftnlen)8) == 0) { - -/* We have a pre release DAS binary file. */ - - s_copy(arch, "DAS", arch_len, (ftnlen)3); - s_copy(kertyp, "PRE", kertyp_len, (ftnlen)3); - } else { - -/* Get the architecture and type from the ID word, if we can. */ - - idw2at_(idword, arch, kertyp, (ftnlen)8, arch_len, kertyp_len); - } - -/* If the architecture is DAF and the type is unknown, '?', then we */ -/* have either an SPK file, a CK file, or something we don't */ -/* understand. Let's check it out. */ - - if (s_cmp(arch, "DAF", arch_len, (ftnlen)3) == 0 && s_cmp(kertyp, "?", - kertyp_len, (ftnlen)1) == 0) { - -/* We have a DAF file and we do not know what the type is. This */ -/* situation can occur for older SPK and CK files, before the ID */ -/* word was used to store type information. */ - -/* We use Bill's (WLT'S) magic heuristics to determine the type */ -/* of the file. */ - -/* Open the file and pass the handle to the private routine */ -/* that deals with the dirty work. */ - - dafopr_(file, &handle, file_len); - zzckspk_(&handle, kertyp, kertyp_len); - dafcls_(&handle); - } - chkout_("GETFAT", (ftnlen)6); - return 0; -} /* getfat_ */ - diff --git a/ext/spice/src/cspice/getfat_c.c b/ext/spice/src/cspice/getfat_c.c deleted file mode 100644 index 2959c69701..0000000000 --- a/ext/spice/src/cspice/getfat_c.c +++ /dev/null @@ -1,282 +0,0 @@ -/* - --Procedure getfat_c ( Get file architecture and type ) - --Abstract - - Determine the file architecture and file type of most SPICE kernel - files. - --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 - - KERNEL - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void getfat_c ( ConstSpiceChar * file, - SpiceInt arclen, - SpiceInt typlen, - SpiceChar * arch, - SpiceChar * type ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - file I The name of a file to be examined. - arclen I Maximum length of output architecture string. - typlen I Maximum length of output type - string. - arch O The architecture of the kernel file. - type O The type of the kernel file. - --Detailed_Input - - arclen is the maximum length of output architecture string arch, - including the terminating null. For example, if arch - is to hold strings having 10 characters of actual data, - arclen should be set to 1l. - - typlen is the maximum length of output file type string type, - including the terminating null. For example, if type - is to hold strings having 10 characters of actual data, - arclen should be set to 1l. - - file is the name of a SPICE kernel file whose architecture - and type are desired. This file must be closed when - this routine is called. - --Detailed_Output - - arch is the file architecture of the SPICE kernel file - specified by file. If the architecture cannot be - determined or is not recognized the value "?" is - returned. - - Architectures currently recognized are: - - DAF - The file is based on the DAF architecture. - DAS - The file is based on the DAS architecture. - XFR - The file is in a SPICE transfer file format. - DEC - The file is an old SPICE decimal text file. - ASC -- An ASCII text file. - KPL -- Kernel Pool File (i.e., a text kernel) - TXT -- An ASCII text file. - TE1 -- Text E-Kernel type 1. - ? - The architecture could not be determined. - - This variable must be at least 3 characters long. - - type is the type of the SPICE kernel file. If the type - can not be determined the value "?" is returned. - - Kernel file types may be any sequence of at most four - printing characters. NAIF has reserved for its use - types which contain all upper case letters. - - A file type of "PRE" means that the file is a - pre-release file. - - This variable may be at most 4 characters long. - --Parameters - - None. - --Exceptions - - 1) The underlying code translated to C from Fortran effectively - performs a Fortran INQUIRE on the specified file. If this - operation fails for some reason, the error SPICE(INQUIREERROR) - will be signaled. - - 2) If the file specified by FILE is already open, the error - SPICE(FILECURRENTLYOPEN) will be signaled. - - 3) If the file specified by FILE does not exist, the error - SPICE(NOSUCHFILE) will be signaled. - - 4) If the attempt to open the file specified by FILE fails, the - error SPICE(FILEOPENFAILED) will be signaled. - - 5) If all attempts to open the file specified by FILE fail, the - error SPICE(FILEOPENFAILED) will be signaled. - - 6) If all attempts to read from the file specified be FILE - fail, the error SPICE(FILEREADFAILED) will be signaled. - - 7) The error SPICE(EMPTYSTRING) is signaled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 8) The error SPICE(NULLPOINTER) is signaled if the input string - pointer is null. - - 9) If either output string pointer is null, the error - SPICE(NULLPOINTER) is signaled. - - 10) If an output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - - --Files - - The SPICE kernel file specified by FILE is opened and then - closed by this routine to determine its file architecture and - type. Names of open files should not be passed to this routine. - --Particulars - - This subroutine is a support utility routine that determines the - architecture and type of a SPICE kernel file. - --Examples - - Suppose you wish to write a single routine for loading binary - kernels. You can use this routine to determine the type of the - file and then pass the file to the appropriate low level file - loader to handle the actual loading of the file. - - getfat_c ( file, arch, type ); - - if ( eqstr_c( type, "spk" ) ) - { - spklef_c ( file, &handle ); - } - - else if ( eqstr_c( type, "ck" ) ) - { - cklpf_c ( file, &handle ); - } - - else if ( eqstr_c( type, "ek" ) ) - { - eklef ( file, handle ); - } - - else - { - printf ( "%s\n", - "The file could not be identified as aknown\n" - "kernel type. Did you load the wrong file\n" - "by mistake?" ); - } - - --Restrictions - - The file to be examined must be closed when this routine is - invoked. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 18-AUG-1998 (NJB) - --Index_Entries - - determine the architecture and type of a kernel file - --& -*/ - -{ /* Begin getfat_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "getfat_c" ); - - /* - Check the input file name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "getfat_c", file ); - - /* - Make sure the output architecture string has at least enough room - for one output character and a null terminator. Also check for a - null pointer. - */ - CHKOSTR ( CHK_STANDARD, "getfat_c", arch, arclen ); - - /* - Make sure the output file type string has at least enough room - for one output character and a null terminator. Also check for a - null pointer. - */ - CHKOSTR ( CHK_STANDARD, "getfat_c", type, typlen ); - - getfat_ ( ( char * ) file, - ( char * ) arch, - ( char * ) type, - ( ftnlen ) strlen(file), - ( ftnlen ) arclen-1, - ( ftnlen ) typlen-1 ); - - - /* - Convert each Fortran output string to a C string by placing a - null after the last non-blank character. This operation is valid - whether or not the CSPICE routine signaled an error. - */ - - F2C_ConvertStr ( arclen, arch ); - F2C_ConvertStr ( typlen, type ); - - - chkout_c ( "getfat_c" ); - -} /* End getfat_c */ diff --git a/ext/spice/src/cspice/getfov.c b/ext/spice/src/cspice/getfov.c deleted file mode 100644 index 878f8eeb0a..0000000000 --- a/ext/spice/src/cspice/getfov.c +++ /dev/null @@ -1,1319 +0,0 @@ -/* getfov.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__4 = 4; -static integer c__3 = 3; -static integer c__0 = 0; - -/* $Procedure GETFOV ( Fetch instrument FOV parameters ) */ -/* Subroutine */ int getfov_(integer *instid, integer *room, char *shape, - char *frame, doublereal *bsight, integer *n, doublereal *bounds, - ftnlen shape_len, ftnlen frame_len) -{ - /* Initialized data */ - - static char shapid[32*4] = "CIRCLE " "ELLIPSE " - " " "POLYGON " "REC" - "TANGLE "; - static char angshp[32*3] = "CIRCLE " "ELLIPSE " - " " "RECTANGLE "; - - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal bmag; - char spec[80]; - doublereal vmag; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_( - doublereal *, doublereal *, doublereal *), vequ_(doublereal *, - doublereal *); - char type__[1]; - doublereal b[3]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), vlcom_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - doublereal b1[3], b2[3]; - integer mxcmp; - char kword[32]; - extern /* Subroutine */ int vperp_(doublereal *, doublereal *, doublereal - *); - extern integer rtrim_(char *, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal - *); - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - unorm_(doublereal *, doublereal *, doublereal *), vrotv_( - doublereal *, doublereal *, doublereal *, doublereal *); - doublereal refang; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - doublereal coscan; - char kwcang[32]; - doublereal refvec[3], sincan, crsang; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen), gdpool_(char *, integer *, - integer *, integer *, doublereal *, logical *, ftnlen); - doublereal cosran, tmpang; - char kwfram[32], kwbore[32], angunt[80], kwrang[32], kwrvec[32], kwshap[ - 32], kwboun[32], kwspec[32]; - doublereal normal[12] /* was [3][4] */, sinran; - char kwaunt[32]; - doublereal tmpvec[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int dtpool_(char *, logical *, integer *, char *, - ftnlen, ftnlen), suffix_(char *, integer *, char *, ftnlen, - ftnlen), convrt_(doublereal *, char *, char *, doublereal *, - ftnlen, ftnlen); - -/* $ Abstract */ - -/* This subroutine returns the field-of-view (FOV) parameters for */ -/* a specified instrument. */ - -/* $ 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 */ - -/* IK */ - -/* $ Keywords */ - -/* INSTRUMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INSTID I NAIF ID of an instrument */ -/* ROOM I Maximum number of vectors that can be returned. */ -/* SHAPE O Instrument FOV shape. */ -/* FRAME O Name of the frame in which FOV vectors are defined. */ -/* BSIGHT O Boresight vector. */ -/* N O Number of boundary vectors returned. */ -/* BOUNDS O FOV boundary vectors. */ - -/* $ Detailed_Input */ - -/* INSTID is the NAIF ID of an instrument. */ - -/* ROOM is the maximum number of 3D vectors that can be */ -/* returned in BOUNDS. */ - -/* $ Detailed_Output */ - -/* SHAPE is a character string that describes the "shape" of */ -/* the field of view. Possible values returned are: */ - -/* 'POLYGON' */ -/* 'RECTANGLE' */ -/* 'CIRCLE' */ -/* 'ELLIPSE' */ - -/* If the value of SHAPE is 'POLYGON' the field of view */ -/* of the instrument is a pyramidal polyhedron. The */ -/* vertex of the pyramid is at the instrument focal */ -/* point. The rays along the edges of the pyramid are */ -/* parallel to the vectors returned in BOUNDS. */ - -/* If the value of SHAPE is 'RECTANGLE' the field of view */ -/* of the instrument is a rectangular pyramid. The vertex */ -/* of the pyramid is at the instrument focal point. The */ -/* rays along the edges of the pyramid are parallel to */ -/* the vectors returned in BOUNDS. Moreover, in this */ -/* case, the boresight points along the axis of symmetry */ -/* of the rectangular pyramid. */ - -/* If the value of SHAPE is 'CIRCLE' the field of view of */ -/* the instrument is a circular cone about the boresight */ -/* vector. The vertex of the cone is at the instrument */ -/* focal point. A single vector will be returned in */ -/* BOUNDS. This vector will be parallel to a ray that */ -/* lies in the cone that makes up the boundary of the */ -/* field of view. */ - -/* If the value of SHAPE is 'ELLIPSE' the field of view */ -/* of the instrument is a elliptical cone with the */ -/* boresight vector as the axis of the cone. In this */ -/* case two vectors are returned in BOUNDS. One of the */ -/* vectors returned in BOUNDS points to the end of the */ -/* semi-major axis of a perpendicular cross section of */ -/* the elliptic cone. The other vector points to the end */ -/* of the semi-minor axis of a perpendicular cross */ -/* section of the cone. */ - -/* FRAME is the name of the reference frame in which the field */ -/* of view boundary vectors are defined. */ - -/* BSIGHT is a vector that points in the direction of the */ -/* center of the field of view. The length of BSIGHT */ -/* is not specified other than being non-zero. */ - -/* N is the number of boundary vectors returned. */ - -/* BOUNDS is an array of vectors that point to the "corners" of */ -/* the instrument field of view. (See the discussion */ -/* accompanying shape for an expansion of the term */ -/* "corner of the field of view.") Note that the vectors */ -/* returned in BOUNDS are not necessarily unit vectors. */ - -/* $ Parameters */ - -/* MINCOS This parameter is the lower limit on the value of the */ -/* cosine of the cross or reference angles in the ANGLES */ -/* specification cases. (see Particulars for further */ -/* discussion). */ -/* $ Exceptions */ - -/* 1) The error SPICE(FRAMEMISSING) is signaled if the frame */ -/* associated with the instrument can not be found in the kernel */ -/* pool. */ - -/* 2) The error SPICE(SHAPEMISSING) is signaled if the shape of the */ -/* instrument field of view can not be found in the kernel pool. */ - -/* 3) The error 'SPICE(SHAPENOTSUPPORTED)' is signaled if the shape */ -/* specified by the instrument kernel is not one of the four */ -/* values: 'CIRCLE', 'POLYGON', 'ELLIPSE', 'RECTANGLE'. If the */ -/* ANGLES specification is used it must be: 'CIRCLE', 'ELLIPSE', */ -/* or 'RECTANGLE'. */ - -/* 4) The error 'SPICE(BORESIGHTMISSING)' is signaled if */ -/* the direction of the boresight cannot be located in the */ -/* kernel pool. */ - -/* 5) The error 'SPICE(BADBORESIGHTSPEC)' is signaled if */ -/* the number of components for the boresight vector */ -/* in the kernel pool is not 3. */ - -/* 6) The error 'SPICE(BOUNDARYMISSING)' is signaled if */ -/* the boundary vectors for the edge of the field of view */ -/* cannot be found in the kernel pool. */ - -/* 7) The error 'SPICE(BOUNDARYTOOBIG)' is signaled if there */ -/* is insufficient room (as specified by the variable ROOM) */ -/* to return all of the vectors associated with the boundary */ -/* of the field of view. */ - -/* 8) The error 'SPICE(BADBOUNDARY)' is signaled if the number */ -/* of components of vectors making up the field of view is */ -/* not a multiple of 3. */ - -/* 9) The error 'SPICE(BADBOUNDARY)' is signaled if the number */ -/* of components of vectors making up the field of view is */ -/* not compatible with the shape specified for the field of */ -/* view. */ - -/* 10) The error 'SPICE(REFVECTORMISSING)' is signaled if the */ -/* reference vector for the ANGLES spec can not be found */ -/* in the kernel pool. */ - -/* 11) The error 'SPICE(BADREFVECTORSPEC)' is signaled if the */ -/* reference vector stored in the kernel pool to support */ -/* the ANGLES spec contains an in correct number of components, */ -/* contains 3 character components, or is parallel to the */ -/* boresight. */ - -/* 12) The error 'SPICE(REFANGLEMISSING)' is signaled if the */ -/* reference angle stored in the kernel pool to support */ -/* the ANGLES spec is absent from the kernel pool. */ - -/* 13) The error 'SPICE(UNITSMISSING)' is signaled if the */ -/* keyword that stores the angular units for the angles */ -/* used in the ANGLES spec is absent from the kernel pool. */ - -/* 14) The error 'SPICE(CROSSANGLEMISSING)' is signaled if the */ -/* keyword that stores the cross angle for the ANGLES spec */ -/* is needed and is absent from the kernel pool. */ - -/* 15) The error 'SPICE(BADBOUNDARY)' is signaled if the angles */ -/* for the RECTANGLE/ANGLES spec case have cosines that */ -/* are less than those stored in the parameter MINCOS. */ - -/* 16) The error 'SPICE(UNSUPPORTEDSPEC)' is signaled if the */ -/* class specification contains something other than 'ANGLES' */ -/* or 'CORNERS'. */ - -/* 17) In the event that the CLASS_SPEC keyword is absent from the */ -/* kernel pool for the instrument whose FOV is sought, this */ -/* module assumes the default CORNERS specification is to be */ -/* utilized. */ - -/* $ Files */ - -/* This routine relies upon having successfully loaded an instrument */ -/* kernel (IK-file) via the routine FURNSH prior to calling this */ -/* routine. */ - -/* $ Particulars */ - -/* This routine provides a common interface to retrieving */ -/* the geometric characteristics of an instrument field of */ -/* view for a wide variety of remote sensing instruments */ -/* across many different space missions. */ - -/* Given the NAIF instrument ID, (and having "loaded" the */ -/* instrument field of view description via the routine FURNSH) */ -/* this routine returns the bore-sight of the instrument, the */ -/* "shape" of the field of view, a collection of vectors */ -/* that point along the edges of the field of view, and the */ -/* name of the reference frame in which these vectors are defined. */ - -/* Currently this routine supports two classes of specifications */ -/* for FOV definitions: "corners" and "angles". */ - -/* The "corners" specification requires the following keywords */ -/* defining the shape, boresight, boundary vectors, and reference */ -/* frame of the FOV be provided in one of the text kernel files */ -/* (normally an IK file) loaded into the kernel pool (in the */ -/* keywords below is replaced with the instrument ID as */ -/* passed into the module): */ - -/* INS_FOV_CLASS_SPEC must be set to 'CORNERS' or */ -/* omitted to indicate the */ -/* "corners"-class */ -/* specification. */ - - -/* INS_FOV_SHAPE must be set to one of these */ -/* values: */ - -/* 'CIRCLE' */ -/* 'ELLIPSE' */ -/* 'RECTANGLE' */ -/* 'POLYGON' */ - -/* INS_FOV_FRAME must contain the name of */ -/* the frame in which the */ -/* boresight and boundary */ -/* corner vectors are defined. */ - -/* INS_BORESIGHT must be set to a 3D vector */ -/* defining the boresight in */ -/* the FOV frame specified in */ -/* the FOV_FRAME keyword. */ - -/* INS_FOV_BOUNDARY or */ -/* INS_FOV_BOUNDARY_CORNERS must be set to one (for */ -/* FOV_SHAPE = 'CIRCLE'), two */ -/* (for FOV_SHAPE = */ -/* 'ELLIPSE'), three (for */ -/* FOV_SHAPE = 'RECTANGLE'), */ -/* or three or more (for */ -/* 'POLYGON') 3D vectors */ -/* defining the corners of the */ -/* FOV in the FOV frame */ -/* specified in the FOV_FRAME */ -/* keyword. */ - -/* The "angles" specification requires the following keywords */ -/* defining the shape, boresight, reference vector, reference and */ -/* cross angular extents of the FOV be provided in one of the text */ -/* kernel files (normally an IK file) loaded into the kernel */ -/* pool (in the keywords below is replaced with the */ -/* instrument ID as passed into the module): */ - -/* INS_FOV_CLASS_SPEC must be set to 'ANGLES' to */ -/* indicate the "angles"-class */ -/* specification. */ - -/* INS_FOV_SHAPE must be set to one of these */ -/* values: */ - -/* 'CIRCLE' */ -/* 'ELLIPSE' */ -/* 'RECTANGLE' */ - -/* INS_FOV_FRAME must contain the name of */ -/* the frame in which the */ -/* boresight and the computed */ -/* boundary corner vectors are */ -/* defined. */ - -/* INS_BORESIGHT must be set to a 3D vector */ -/* defining the boresight in */ -/* the FOV frame specified in */ -/* the FOV_FRAME keyword. */ - -/* INS_FOV_REF_VECTOR must be set to a 3D vector */ -/* that together with the */ -/* boresight vector defines */ -/* the plane in which the */ -/* first angular extent of the */ -/* FOV specified in the */ -/* FOV_REF_ANGLE keyword is */ -/* measured. */ - -/* INS_FOV_REF_ANGLE must be set to the angle */ -/* that is 1/2 of the total */ -/* FOV angular extent in the */ -/* plane defined by the */ -/* boresight and the vector */ -/* specified in the */ -/* FOV_REF_VECTOR keyword. */ - -/* INS_FOV_CROSS_ANGLE must be set to the angle */ -/* that is 1/2 of the total */ -/* FOV angular extent in the */ -/* plane containing the */ -/* boresight and perpendicular */ -/* to the plane defined by the */ -/* boresight and the vector */ -/* specified in the */ -/* FOV_REF_VECTOR keyword. */ -/* This keyword is not */ -/* required for FOV_SHAPE = */ -/* 'CIRCLE'. */ - -/* INS_FOV_ANGLE_UNITS must specify units for the */ -/* angles given in the */ -/* FOV_REF_ANGLE and */ -/* FOV_CROSS_ANGLE keywords. */ -/* Any angular units */ -/* recognized by CONVRT are */ -/* acceptable. */ - -/* This routine is intended to be an intermediate level routine. */ -/* It is expected that users of this routine will be familiar */ -/* with the SPICE frames subsystem and will be comfortable writing */ -/* software to further manipulate the vectors retrieved by this */ -/* routine. */ - -/* $ Examples */ - -/* The example program in this section loads the IK file */ -/* 'example.ti' with the following contents defining four FOVs of */ -/* various shapes and sizes: */ - -/* KPL/IK */ - -/* The keywords below define a circular, 10-degree wide FOV with */ -/* the boresight along the +Z axis of the 'SC999_INST001' frame */ -/* for an instrument with ID -999001 using the "angles"-class */ -/* specification. */ - -/* \begindata */ -/* INS-999001_FOV_CLASS_SPEC = 'ANGLES' */ -/* INS-999001_FOV_SHAPE = 'CIRCLE' */ -/* INS-999001_FOV_FRAME = 'SC999_INST001' */ -/* INS-999001_BORESIGHT = ( 0.0, 0.0, 1.0 ) */ -/* INS-999001_FOV_REF_VECTOR = ( 1.0, 0.0, 0.0 ) */ -/* INS-999001_FOV_REF_ANGLE = ( 5.0 ) */ -/* INS-999001_FOV_ANGLE_UNITS = ( 'DEGREES' ) */ -/* \begintext */ - -/* The keywords below define an elliptical FOV with 2- and */ -/* 4-degree angular extents in the XZ and XY planes and the */ -/* boresight along the +X axis of the 'SC999_INST002' frame for */ -/* an instrument with ID -999002 using the "corners"-class */ -/* specification. */ - -/* \begindata */ -/* INS-999002_FOV_SHAPE = 'ELLIPSE' */ -/* INS-999002_FOV_FRAME = 'SC999_INST002' */ -/* INS-999002_BORESIGHT = ( 1.0, 0.0, 0.0 ) */ -/* INS-999002_FOV_BOUNDARY_CORNERS = ( 1.0, 0.0, 0.01745506, */ -/* 1.0, 0.03492077, 0.0 ) */ -/* \begintext */ - -/* The keywords below define a rectangular FOV with 1.2- and */ -/* 0.2-degree angular extents in the ZX and ZY planes and the */ -/* boresight along the +Z axis of the 'SC999_INST003' frame for */ -/* an instrument with ID -999003 using the "angles"-class */ -/* specification. */ - -/* \begindata */ -/* INS-999003_FOV_CLASS_SPEC = 'ANGLES' */ -/* INS-999003_FOV_SHAPE = 'RECTANGLE' */ -/* INS-999003_FOV_FRAME = 'SC999_INST003' */ -/* INS-999003_BORESIGHT = ( 0.0, 0.0, 1.0 ) */ -/* INS-999003_FOV_REF_VECTOR = ( 1.0, 0.0, 0.0 ) */ -/* INS-999003_FOV_REF_ANGLE = ( 0.6 ) */ -/* INS-999003_FOV_CROSS_ANGLE = ( 0.1 ) */ -/* INS-999003_FOV_ANGLE_UNITS = ( 'DEGREES' ) */ -/* \begintext */ - -/* The keywords below define a triangular FOV with the boresight */ -/* along the +Y axis of the 'SC999_INST004' frame for an */ -/* instrument with ID -999004 using the "corners"-class */ -/* specification. */ - -/* \begindata */ -/* INS-999004_FOV_SHAPE = 'POLYGON' */ -/* INS-999004_FOV_FRAME = 'SC999_INST004' */ -/* INS-999004_BORESIGHT = ( 0.0, 1.0, 0.0 ) */ -/* INS-999004_FOV_BOUNDARY_CORNERS = ( 0.0, 0.8, 0.5, */ -/* 0.4, 0.8, -0.2, */ -/* -0.4, 0.8, -0.2 ) */ -/* \begintext */ - -/* The program shown below loads the IK, fetches parameters for each */ -/* of the four FOVs and prints these parameters to the screen. */ - -/* IMPLICIT NONE */ - -/* INTEGER MAXBND */ -/* PARAMETER ( MAXBND = 4 ) */ - -/* INTEGER NUMINS */ -/* PARAMETER ( NUMINS = 4 ) */ - -/* INTEGER WDSIZE */ -/* PARAMETER ( WDSIZE = 32 ) */ - -/* CHARACTER*(WDSIZE) FRAME */ -/* CHARACTER*(WDSIZE) SHAPE */ - -/* DOUBLE PRECISION BOUNDS ( 3, MAXBND ) */ -/* DOUBLE PRECISION BSIGHT ( 3 ) */ - -/* INTEGER I */ -/* INTEGER INSIDS ( NUMINS ) */ -/* INTEGER J */ -/* INTEGER N */ - -/* DATA INSIDS / -999001, -999002, -999003, -999004 / */ - -/* CALL FURNSH( 'example.ti' ) */ - -/* WRITE (*,*) '--------------------------------------' */ -/* DO I = 1, NUMINS */ - -/* CALL GETFOV ( INSIDS(I), MAXBND, */ -/* . SHAPE, FRAME, BSIGHT, N, BOUNDS ) */ - -/* WRITE (*,*) 'Instrument ID: ', INSIDS(I) */ -/* WRITE (*,*) ' FOV shape: ', SHAPE */ -/* WRITE (*,*) ' FOV frame: ', frame */ -/* WRITE (*,*) 'FOV boresight: ', BSIGHT */ -/* WRITE (*,*) ' FOV corners: ' */ -/* DO J = 1, N */ -/* WRITE (*,*) ' ', */ -/* . BOUNDS(1,J), BOUNDS(2,J), BOUNDS(3,J) */ -/* END DO */ -/* WRITE (*,*) '--------------------------------------' */ - -/* END DO */ - -/* END */ - -/* The program produces the following output: */ - -/* -------------------------------------- */ -/* Instrument ID: -999001 */ -/* FOV shape: CIRCLE */ -/* FOV frame: SC999_INST001 */ -/* FOV boresight: 0. 0. 1. */ -/* FOV corners: */ -/* 0.0871557427 0. 0.996194698 */ -/* -------------------------------------- */ -/* Instrument ID: -999002 */ -/* FOV shape: ELLIPSE */ -/* FOV frame: SC999_INST002 */ -/* FOV boresight: 1. 0. 0. */ -/* FOV corners: */ -/* 1. 0. 0.01745506 */ -/* 1. 0.03492077 0. */ -/* -------------------------------------- */ -/* Instrument ID: -999003 */ -/* FOV shape: RECTANGLE */ -/* FOV frame: SC999_INST003 */ -/* FOV boresight: 0. 0. 1. */ -/* FOV corners: */ -/* 0.0104717682 0.00174523267 0.999943647 */ -/* -0.0104717682 0.00174523267 0.999943647 */ -/* -0.0104717682 -0.00174523267 0.999943647 */ -/* 0.0104717682 -0.00174523267 0.999943647 */ -/* -------------------------------------- */ -/* Instrument ID: -999004 */ -/* FOV shape: POLYGON */ -/* FOV frame: SC999_INST004 */ -/* FOV boresight: 0. 1. 0. */ -/* FOV corners: */ -/* 0. 0.8 0.5 */ -/* 0.4 0.8 -0.2 */ -/* -0.4 0.8 -0.2 */ -/* -------------------------------------- */ - -/* $ Restrictions */ - -/* An I-kernel for the instrument specified in INSTID must have been */ -/* loaded via a call to FURNSH prior to calling this routine and */ -/* must contain the specification for the instrument field of view */ -/* consistent with the expectations of this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.1 05-FEB-2009 (BVS) */ - -/* Header updates: added information about required IK keywords; */ -/* replaced old example with a new one more focused on GETFOV and */ -/* IK keywords. */ - -/* - SPICELIB Version 2.1.0 23-OCT-2005 (NJB) (BVS) */ - -/* Fixed bug causing incorrect computation of the boundary */ -/* vectors for a rectangular FOV specified using the angular */ -/* extents method if the reference vector was provided as a */ -/* non-unit vector and/or was non-perpendicular to the */ -/* specified boresight. */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CONVRT, UNORM, VHAT, VSCL and VCROSS calls. */ - -/* Replaced header reference to LDPOOL with reference to FURNSH. */ - -/* - SPICELIB Version 2.0.1 29-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - SPICELIB Version 2.0.0 15-MAY-2001 (FST) */ - -/* Updated the routine to support the new ANGLES specification */ -/* for RECTANGLE, ELLIPSE, and CIRCLE. */ - -/* - SPICELIB Version 1.1.2 10-MAY-2000 (WLT) */ - -/* Removed the unused variable INDEX. */ - -/* - SPICELIB Version 1.1.1 13-APR-2000 (WLT) */ - -/* This routine was harvested from the NEAR specific routine */ -/* of the same name. It was enhanced to support the 'RECTANGLE' */ -/* shape for a field of view (a special case of 'POLYGON' */ -/* added for the sake of Cassini users). */ - -/* -& */ -/* $ Index_Entries */ - -/* return instrument's FOV parameters */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0 23-OCT-2005 (NJB) (BVS) */ - -/* Fixed bug causing incorrect computation of the boundary */ -/* vectors for a rectangular FOV specified using the angular */ -/* extents method if the reference vector was provided as a */ -/* non-unit vector and/or was non-perpendicular to the */ -/* specified boresight. */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CONVRT, UNORM, VHAT, VSCL and VCROSS calls. */ - -/* Replaced header reference to LDPOOL with reference to FURNSH. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Keyword Name Length. */ - - -/* Maximum Number of Normal Vectors. */ - - -/* Number of CORNER Shapes Supported. */ - - -/* Number of ANGLE Shapes Supported. */ - - -/* Maximum Length of String Data from the kernel pool. */ - - -/* Local variables */ - - -/* Allowed values of shape identifier. Note that these must be */ -/* supplied in ascending order */ - - -/* Allowed values of the shape identifier for the ANGLES */ -/* specification. Note that these must be supplied in ascending */ -/* order. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETFOV", (ftnlen)6); - } - s_copy(kwboun, "INS#_FOV_BOUNDARY", (ftnlen)32, (ftnlen)17); - s_copy(kwbore, "INS#_BORESIGHT", (ftnlen)32, (ftnlen)14); - s_copy(kwshap, "INS#_FOV_SHAPE", (ftnlen)32, (ftnlen)14); - s_copy(kwfram, "INS#_FOV_FRAME", (ftnlen)32, (ftnlen)14); - s_copy(kwspec, "INS#_FOV_CLASS_SPEC", (ftnlen)32, (ftnlen)19); - s_copy(kwrvec, "INS#_FOV_REF_VECTOR", (ftnlen)32, (ftnlen)19); - s_copy(kwrang, "INS#_FOV_REF_ANGLE", (ftnlen)32, (ftnlen)18); - s_copy(kwcang, "INS#_FOV_CROSS_ANGLE", (ftnlen)32, (ftnlen)20); - s_copy(kwaunt, "INS#_FOV_ANGLE_UNITS", (ftnlen)32, (ftnlen)20); - mxcmp = *room * 3; - -/* Look for the frame keyword and get frame name if found, */ -/* complain if not. */ - - repmi_(kwfram, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gcpool_(kword, &c__1, &c__1, &i__, frame, &found, (ftnlen)32, frame_len); - if (! found) { - setmsg_("The variable, '#', specifying the frame which instrument # " - "FOV components are defined relative to was not found in the " - "kernel pool. Check whether IK file for the instrument was lo" - "aded into the program and whether this variable is specified" - " in that file.", (ftnlen)253); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(FRAMEMISSING)", (ftnlen)19); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Look for the shape keyword and get shape identifier if found, */ -/* complain if not. */ - - repmi_(kwshap, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gcpool_(kword, &c__1, &c__1, &i__, shape, &found, (ftnlen)32, shape_len); - if (! found) { - setmsg_("The variable, '#', specifying the shape of the instrument #" - " FOV was not found in the kernel pool. Check whether IK file" - " for the instrument was loaded into the program and whether " - "this variable is specified in that file.", (ftnlen)219); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(SHAPEMISSING)", (ftnlen)19); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Create an upper case, left justified value for SHAPE. This will */ -/* provide the desired case-insensitivity to the keyword value. */ - - ucase_(shape, shape, shape_len, shape_len); - ljust_(shape, shape, shape_len, shape_len); - -/* Check whether shape identified that we got is one from the list */ -/* of supported, complain if not. */ - - if (bsrchc_(shape, &c__4, shapid, rtrim_(shape, shape_len), (ftnlen)32) == - 0) { - setmsg_("The FOV shape, '#', specified in the keyword, '#', for the " - "instrument # is not supported. See GETFOV subroutine header " - "for the list of supported instrument FOV shapes.", (ftnlen) - 167); - errch_("#", shape, (ftnlen)1, rtrim_(shape, shape_len)); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(SHAPENOTSUPPORTED)", (ftnlen)24); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Look for the boresight keyword and get boresight vector if found, */ -/* complain if not. */ - - repmi_(kwbore, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(kword, &found, &i__, type__, (ftnlen)32, (ftnlen)1); - if (! found) { - setmsg_("The variable, '#', specifying the boresight of the instrume" - "nt # was not found in the kernel pool. Check whether IK file" - " for the instrument was loaded into the program and whether " - "this variable is specified in that file.", (ftnlen)219); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(BORESIGHTMISSING)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Check whether boresight specified by three coordinates; */ -/* complain if not. */ - - if (i__ != 3) { - setmsg_("The number of the boresight vector components specified in " - "the '#' variable is not 3, it is #. Correct it in the corres" - "ponding IK file to be a 3-dimensional vector. ", (ftnlen)165); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BADBORESIGHTSPEC)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } else if (*(unsigned char *)type__ != 'N') { - setmsg_("The boresight vector, stored in the '#' variable, has not b" - "een stored as a vector of three numbers. It has been stored" - " as a vector of three strings. ", (ftnlen)150); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - sigerr_("SPICE(BADBORESIGHTSPEC)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - gdpool_(kword, &c__1, &c__3, &i__, bsight, &found, (ftnlen)32); - -/* At this point we have gotten all the specification independent */ -/* information. Now check for the presence of the FOV class */ -/* specification keyword. If it's absent, we default to CORNERS. */ - - s_copy(spec, "CORNERS", (ftnlen)80, (ftnlen)7); - repmi_(kwspec, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gcpool_(kword, &c__1, &c__1, &i__, spec, &found, (ftnlen)32, (ftnlen)80); - if (eqstr_("CORNERS", spec, (ftnlen)7, (ftnlen)80)) { - -/* Look for the FOV boundary vectors, check whether output array */ -/* is big enough to hold them; complain if not. */ - - repmi_(kwboun, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(kword, &found, n, type__, (ftnlen)32, (ftnlen)1); - if (! found) { - suffix_("_CORNERS", &c__0, kword, (ftnlen)8, (ftnlen)32); - dtpool_(kword, &found, n, type__, (ftnlen)32, (ftnlen)1); - } - if (! found) { - repmi_(kwboun, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen) - 32); - setmsg_("The variable, '#', specifying the boundary vectors of t" - "he instrument # FOV was not found in the kernel pool. Ch" - "eck whether IK file for the instrument was loaded into t" - "he program and whether this variable is specified in tha" - "t file.", (ftnlen)230); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(BOUNDARYMISSING)", (ftnlen)22); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Check whether we have enough room to get all boundary vectors, */ -/* complain if not. */ - - if (*n > mxcmp) { - setmsg_("The number of boundary vector components specified in t" - "he '#' pool variable is bigger than room to hold them in" - " output array specified by the ROOM input variable of th" - "e GETFOV subroutine.", (ftnlen)187); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - sigerr_("SPICE(BOUNDARYTOOBIG)", (ftnlen)21); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Check whether number of boundary components can be divided by 3 */ -/* without reminder. */ - - if (*n % 3 != 0) { - setmsg_("The boundary vector components specified in the '#' poo" - "l variable do not represent a set of 3-dimensional vect" - "ors. Number of components assigned to the variable canno" - "t be divided by 3 without reminder. ", (ftnlen)203); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - sigerr_("SPICE(BADBOUNDARY)", (ftnlen)18); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Boundaries are OK. Get them. */ - - gdpool_(kword, &c__1, &mxcmp, n, bounds, &found, (ftnlen)32); - *n /= 3; - if (s_cmp(shape, "CIRCLE", shape_len, (ftnlen)6) == 0 && *n != 1) { - setmsg_("The boundary is specified to be circular, and as such, " - "the values associated with keyword, '#', should contain " - "one vector. There are #.", (ftnlen)136); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADBOUNDARY)", (ftnlen)18); - chkout_("GETFOV", (ftnlen)6); - return 0; - } else if (s_cmp(shape, "ELLIPSE", shape_len, (ftnlen)7) == 0 && *n != - 2) { - setmsg_("The boundary is specified to be elliptical, and as such" - ", the values associated with keyword, '#', should contai" - "n two vectors. There are #.", (ftnlen)139); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADBOUNDARY)", (ftnlen)18); - chkout_("GETFOV", (ftnlen)6); - return 0; - } else if (s_cmp(shape, "RECTANGLE", shape_len, (ftnlen)9) == 0 && *n - != 4) { - setmsg_("The boundary is specified to be rectangular, and as suc" - "h, the values associated with keyword, '#', should conta" - "in four vectors. There are #.", (ftnlen)141); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADBOUNDARY)", (ftnlen)18); - chkout_("GETFOV", (ftnlen)6); - return 0; - } else if (s_cmp(shape, "POLYGON", shape_len, (ftnlen)7) == 0 && *n < - 3) { - setmsg_("The boundary is specified to be polygonal, and as such," - " the values associated with keyword, '#', should contain" - " at least three vectors. There are #.", (ftnlen)149); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADBOUNDARY)", (ftnlen)18); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Now check to see if the FOV specification is ANGLES and */ -/* compute the boundary corner vectors. */ - - } else if (eqstr_("ANGLES", spec, (ftnlen)6, (ftnlen)80)) { - -/* Check whether shape identified that we got is one from the list */ -/* of supported shapes for the ANGLE specification; complain */ -/* if not. */ - - if (bsrchc_(shape, &c__3, angshp, rtrim_(shape, shape_len), (ftnlen) - 32) == 0) { - setmsg_("The FOV shape, '#', specified in the keyword, '#', for " - "the instrument # is not supported for the ANGLES specifi" - "cation.", (ftnlen)118); - errch_("#", shape, (ftnlen)1, rtrim_(shape, shape_len)); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(SHAPENOTSUPPORTED)", (ftnlen)24); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Now fetch all of the elements independent of shape from the */ -/* ANGLES specification. Start by looking for the reference */ -/* vector keyword. If found, fetch it otherwise complain. */ - - repmi_(kwrvec, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(kword, &found, &i__, type__, (ftnlen)32, (ftnlen)1); - if (! found) { - setmsg_("The variable, '#', specifying the FOV reference vector " - "of the instrument # was not found in the kernel pool. Ch" - "eck whether IK file for the instrument was loaded into t" - "he program and whether this variable is specified in tha" - "t file.", (ftnlen)230); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(REFVECTORMISSING)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Now check whether reference vector is specified by three */ -/* coordinates; complain if not. */ - - if (i__ != 3) { - setmsg_("The number of the reference vector components specified" - " in the '#' keyword is not 3, it is #. Check the corresp" - "onding IK FOV definition for errors.", (ftnlen)147); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BADREFVECTORSPEC)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } else if (*(unsigned char *)type__ != 'N') { - setmsg_("The reference vector, stored in '#', has not been store" - "d as a vector of three numbers. It has been stored as a" - " vector of three strings. ", (ftnlen)137); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - sigerr_("SPICE(BADREFVECTORSPEC)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - gdpool_(kword, &c__1, &c__3, &i__, refvec, &found, (ftnlen)32); - -/* We require that the reference vector is not parallel */ -/* to the boresight vector. Use NORMAL(1,1) to temporarily */ -/* store the result of the cross product. */ - - vcrss_(bsight, refvec, normal); - if (vnorm_(normal) == 0.) { - setmsg_("The reference vector, stored in '#', is parallel to the" - " instrument boresight vector. This is not allowed by th" - "e ANGLES FOV specification.", (ftnlen)138); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - sigerr_("SPICE(BADREFVECTORSPEC)", (ftnlen)23); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Retrieve the reference angle from the kernel pool. */ - - repmi_(kwrang, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(kword, &c__1, &c__1, &i__, &refang, &found, (ftnlen)32); - if (! found) { - setmsg_("The variable, '#', specifying the reference angle which" - " describes instrument # FOV angular extent was not found" - " in the kernel pool. Check whether IK file for the instr" - "ument was loaded into the program and whether this varia" - "ble is specified in that file.", (ftnlen)253); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(REFANGLEMISSING)", (ftnlen)22); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Retrieve the angle units from the kernel pool. */ - - repmi_(kwaunt, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gcpool_(kword, &c__1, &c__1, &i__, angunt, &found, (ftnlen)32, ( - ftnlen)80); - if (! found) { - setmsg_("The variable, '#', specifying the angular units in whic" - "h instrument # FOV extent is defined was not found in th" - "e kernel pool. Check whether IK file for the instrument " - "was loaded into the program and whether this variable is" - " specified in that file.", (ftnlen)247); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(UNITSMISSING)", (ftnlen)19); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Convert the reference angle to radians. */ - - convrt_(&refang, angunt, "RADIANS", &tmpang, (ftnlen)80, (ftnlen)7); - refang = tmpang; - -/* Branch to shape specific code. */ - - if (s_cmp(shape, "CIRCLE", shape_len, (ftnlen)6) == 0) { - -/* First check to see that the caller left enough room */ -/* to store the required number of boundary corner */ -/* vectors. */ - - if (*room < 1) { - setmsg_("The FOV shape for instrument # is specified to be c" - "ircular. There should be room for at least one boun" - "dary vector. There is room for #. ", (ftnlen)138); - errint_("#", instid, (ftnlen)1); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BOUNDARYTOOBIG)", (ftnlen)21); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* The plan to compute the boundary corner vector is to */ -/* rotate the BSIGHT by REFANG towards REFVEC. To do */ -/* this first compute the axis we need to rotate about. */ - - vcrss_(bsight, refvec, normal); - -/* Now rotate by REFANG about NORMAL(1,1) using the routine */ -/* VROTV. */ - - vrotv_(bsight, normal, &refang, bounds); - -/* Lastly, since we computed a single boundary corner vector, */ -/* set N = 1. */ - - *n = 1; - } else if (s_cmp(shape, "ELLIPSE", shape_len, (ftnlen)7) == 0) { - -/* The elliptical case requires the additional cross angle */ -/* keyword's presence in the kernel pool. Attempt to */ -/* retrieve it. */ - - repmi_(kwcang, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen) - 32); - gdpool_(kword, &c__1, &c__1, &i__, &crsang, &found, (ftnlen)32); - if (! found) { - setmsg_("The variable, '#', specifying the cross angle which" - " describes instrument # FOV angular extent was not f" - "ound in the kernel pool. Check whether IK file for t" - "he instrument was loaded into the program and whethe" - "r this variable is specified in that file.", (ftnlen) - 249); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(CROSSANGLEMISSING)", (ftnlen)24); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Convert the cross angle to radians. */ - - convrt_(&crsang, angunt, "RADIANS", &tmpang, (ftnlen)80, (ftnlen) - 7); - crsang = tmpang; - -/* Now check to see that the caller left enough room */ -/* to store the required number of boundary corner */ -/* vectors. */ - - if (*room < 2) { - setmsg_("The FOV shape for instrument # is specified to be e" - "lliptical. There should be room for at least two bo" - "undary vectors. There is room for #. ", (ftnlen)141); - errint_("#", instid, (ftnlen)1); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BOUNDARYTOOBIG)", (ftnlen)21); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* The plan to compute the first boundary corner vector is */ -/* to rotate the BSIGHT by REFANG towards REFVEC. To */ -/* do this first compute the axis we need to rotate about. */ - - vcrss_(bsight, refvec, normal); - -/* Now rotate by REFANG about NORMAL(1,1) using the routine */ -/* VROTV. */ - - vrotv_(bsight, normal, &refang, bounds); - -/* At this point we have one boundary vector. We need the */ -/* second and final one. The strategy we will use is the */ -/* following: rotate BSIGHT by CRSANG towards NORMAL(1,1). */ -/* This will give us boundary corner vectors listed in a */ -/* counter-clockwise fashion about the boresight. */ - - vcrss_(bsight, normal, tmpvec); - vequ_(tmpvec, &normal[3]); - -/* Now rotate BSIGHT by CRSANG about the NORMAL(1,2) using */ -/* the routine VROTV. */ - - vrotv_(bsight, &normal[3], &crsang, &bounds[3]); - -/* Lastly, since we computed two boundary corner vectors, */ -/* set N = 2. */ - - *n = 2; - } else if (s_cmp(shape, "RECTANGLE", shape_len, (ftnlen)9) == 0) { - -/* The rectangular case requires the additional cross angle */ -/* keyword's presence in the kernel pool. Attempt to */ -/* retrieve it. */ - - repmi_(kwcang, "#", instid, kword, (ftnlen)32, (ftnlen)1, (ftnlen) - 32); - gdpool_(kword, &c__1, &c__1, &i__, &crsang, &found, (ftnlen)32); - if (! found) { - setmsg_("The variable, '#', specifying the cross angle which" - " describes instrument # FOV angular extent was not f" - "ound in the kernel pool. Check whether IK file for t" - "he instrument was loaded into the program and whethe" - "r this variable is specified in that file.", (ftnlen) - 249); - errch_("#", kword, (ftnlen)1, rtrim_(kword, (ftnlen)32)); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(CROSSANGLEMISSING)", (ftnlen)24); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Convert the cross angle to radians. */ - - convrt_(&crsang, angunt, "RADIANS", &tmpang, (ftnlen)80, (ftnlen) - 7); - crsang = tmpang; - -/* Now check to see that the caller left enough room */ -/* to store the required number of boundary corner */ -/* vectors. */ - - if (*room < 4) { - setmsg_("The FOV shape for instrument # is specified to be r" - "ectangular. There should be room for at least four " - "boundary vectors. There is room for #. ", (ftnlen) - 143); - errint_("#", instid, (ftnlen)1); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BOUNDARYTOOBIG)", (ftnlen)21); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Here's the general strategy laid out in simple terms: */ - -/* (1) Normalize BSIGHT, label it B. */ - -/* (2) Compute the unit vector in the plane defined by REFVEC */ -/* and B that is normal to B and pointing towards */ -/* REFVEC, label this B1. */ - -/* (3) Cross B and B1 to obtain B2. These three vectors */ -/* form a basis that is 'aligned' with the FOV cone. */ - -/* (4) Compute the inward normals to the sides of the */ -/* rectangular cone in a counter-clockwise order */ -/* about the boresight: */ - -/* NORMAL(1) = -COS(REFANG)*B1 + SIN(REFANG)*B */ -/* NORMAL(2) = -COS(CRSANG)*B2 + SIN(CRSANG)*B */ -/* NORMAL(3) = COS(REFANG)*B1 + SIN(REFANG)*B */ -/* NORMAL(4) = COS(CRSANG)*B2 + SIN(CRSANG)*B */ - -/* (5) Compute the appropriate cross products to obtain */ -/* a set of boundary corner vectors: */ - -/* BOUNDS(1) = NORMAL(1) x NORMAL(2) */ -/* BOUNDS(2) = NORMAL(2) x NORMAL(3) */ -/* BOUNDS(3) = NORMAL(3) x NORMAL(4) */ -/* BOUNDS(4) = NORMAL(4) x NORMAL(1) */ - -/* (6) Unitize and scale BOUNDS to match the length */ -/* of the BSIGHT. */ - -/* Start with step (1). */ - - unorm_(bsight, b, &bmag); - -/* Now proceed to (2). Since we already know that REFVEC */ -/* and BSIGHT are not parallel, the following yields a */ -/* non-zero vector: */ - - vperp_(refvec, bsight, b1); - -/* Unitize B1. */ - - vhat_(b1, tmpvec); - vequ_(tmpvec, b1); - -/* Step (3), compute B2 by crossing B and B1. */ - - vcrss_(b, b1, b2); - -/* Before proceeding onto step (4), verify that the */ -/* results of the calculations in step (4) will make */ -/* sense. Check the cosines of CRSANG and REFANG. */ -/* Signal an error if both are not positive numbers. */ -/* Use MINCOS as a tolerance. */ - - cosran = cos(refang); - coscan = cos(crsang); - if (cosran < 1e-15 || coscan < 1e-15) { - setmsg_("The angular extents specified in the FOV definition" - " for instrument # result in degenerate or improper b" - "oundary corner vectors. This usually is the case wh" - "en one or both of the angles specified is 90 degrees." - , (ftnlen)208); - errint_("#", instid, (ftnlen)1); - sigerr_("SPICE(BADBOUNDARY)", (ftnlen)18); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Compute the NORMAL vectors to complete step (4). */ - - sinran = sin(refang); - sincan = sin(crsang); - d__1 = -cosran; - vlcom_(&d__1, b1, &sinran, b, normal); - d__1 = -coscan; - vlcom_(&d__1, b2, &sincan, b, &normal[3]); - vlcom_(&cosran, b1, &sinran, b, &normal[6]); - vlcom_(&coscan, b2, &sincan, b, &normal[9]); - -/* We are almost finished. Compute the boundary corner */ -/* vectors completing step (5). */ - - vcrss_(normal, &normal[3], bounds); - vcrss_(&normal[3], &normal[6], &bounds[3]); - vcrss_(&normal[6], &normal[9], &bounds[6]); - vcrss_(&normal[9], normal, &bounds[9]); - -/* Step (6), normalize the boundary corner vectors */ -/* and scale by BMAG, the magnitude of BSIGHT. */ - - for (i__ = 1; i__ <= 4; ++i__) { - unorm_(&bounds[i__ * 3 - 3], tmpvec, &vmag); - vscl_(&bmag, tmpvec, &bounds[i__ * 3 - 3]); - } - -/* Lastly since we are returning 4 boundary corner vectors, */ -/* set N = 4. */ - - *n = 4; - } else { - -/* If we end up here something is terribly wrong with */ -/* this module or SPICE in general. */ - - setmsg_("This error is never supposed to occur. We have an undef" - "ined shape for the ANGLES specification that passed the " - "shape check.", (ftnlen)123); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - } else { - setmsg_("The FOV class specification is set to '#' which is currentl" - "y unsupported. See the GETFOV subroutine header for more inf" - "ormation.", (ftnlen)128); - errch_("#", spec, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(UNSUPPORTEDSPEC)", (ftnlen)22); - chkout_("GETFOV", (ftnlen)6); - return 0; - } - -/* Standard SPICE error handling. */ - - chkout_("GETFOV", (ftnlen)6); - return 0; -} /* getfov_ */ - diff --git a/ext/spice/src/cspice/getfov_c.c b/ext/spice/src/cspice/getfov_c.c deleted file mode 100644 index ba16ab52fc..0000000000 --- a/ext/spice/src/cspice/getfov_c.c +++ /dev/null @@ -1,624 +0,0 @@ -/* - --Procedure getfov_c (Get instrument FOV parameters) - --Abstract - - This routine returns the field-of-view (FOV) parameters for a - specified instrument. - --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 - - INSTRUMENT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void getfov_c ( SpiceInt instid, - SpiceInt room, - SpiceInt shapelen, - SpiceInt framelen, - SpiceChar * shape, - SpiceChar * frame, - SpiceDouble bsight [3], - SpiceInt * n, - SpiceDouble bounds [][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - instid I NAIF ID of an instrument. - room I Maximum number of vectors that can be returned. - shapelen I Space available in the string `shape'. - framelen I Space available in the string `frame'. - shape O Instrument FOV shape. - frame O Name of the frame in which FOV vectors are defined. - bsight O Boresight vector. - n O Number of boundary vectors returned. - bounds O FOV boundary vectors. - --Detailed_Input - - instid is the NAIF ID of an instrument. - - room is the maximum number of 3D vectors that can be returned - in `bounds'. - - shapelen is the available space in the `shape' string, counting - room for the terminating null. Up to shapelen-1 "data" - characters will be assigned to the output string `shape'. - - framelen is the available space in the `frame' string, counting - room for the terminating null. Up to framelen-1 "data" - characters will be assigned to the output string `frame'. - --Detailed_Output - - shape is a character string that describes the "shape" of - the field of view. Possible values returned are: - - "POLYGON" - "RECTANGLE" - "CIRCLE" - "ELLIPSE" - - If the value of `shape' is "POLYGON" the field of view of - the instrument is a pyramidal polyhedron. The vertex of - the pyramid is at the instrument focal point. The rays - along the edges of the pyramid are parallel to the - vectors returned in `bounds'. - - If the value of `shape' is "RECTANGLE" the field of view - of the instrument is a rectangular pyramid. The vertex of - the pyramid is at the instrument focal point. The rays - along the edges of the pyramid are parallel to the - vectors returned in `bounds'. Moreover, in this case, - the boresight points along the axis of symmetry of the - rectangular pyramid. - - If the value of `shape' is "CIRCLE" the field of view of - the instrument is a circular cone about the boresight - vector. The vertex of the cone is at the instrument - focal point. A single vector will be returned in - `bounds'. This vector will be parallel to a ray that - lies in the cone that makes up the boundary of the field - of view. - - If the value of `shape' is "ELLIPSE" the field of view of - the instrument is an elliptical cone with the boresight - vector as the axis of the cone. The vertex of the cone - is at the instrument focal point. Two vectors are - returned in `bounds'. One of the vectors points to the - end of the semi-major axis of a perpendicular cross - section of the elliptic cone. The other vector points to - the end of the semi-minor axis of a perpendicular cross - section of the cone. - - - frame is the name of the reference frame in which the field of - view boundary vectors are defined. - - bsight is a vector that points in the direction of the - center of the field of view. The length of bsight - is not specified other than being non-zero. - - n is the number of boundary vectors returned. - - bounds is an array of vectors that point to the "corners" - of the instrument field of view. (See the discussion - accompanying `shape' for an expansion of the term - "corner of the field of view.") Note that the vectors - returned in `bounds' are not necessarily unit vectors. - --Parameters - - MINCOS This parameter is the lower limit on the value of the - cosine of the cross or reference angles in the ANGLES - specification cases (see Particulars for further - discussion). The parameter and its current value, - 1.0x10^(-15), are employed in the C code derived from the - Fortran version of GETFOV that this wrapper invokes. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either the `shape' or - `frame' string pointers are null. - - 2) The user must pass values indicating the length of the `shape' - and `frame' strings. If these values are not at least 2, the - error SPICE(STRINGTOOSHORT) is signaled. - - 3) The error SPICE(FRAMEMISSING) is signaled if the reference frame - associated with the instrument can not be found in the kernel - pool. - - 4) The error SPICE(SHAPEMISSING) is signaled if the shape of the - instrument field of view can not be found in the kernel pool. - - 5) The error SPICE(SHAPENOTSUPPORTED) is signaled if the shape - specified by the instrument kernel is not one of the four - values: 'CIRCLE', 'POLYGON', 'ELLIPSE', 'RECTANGLE'. If the - ANGLES specification is used it must be: 'CIRCLE', 'ELLIPSE', or - 'RECTANGLE'. - - 6) The error SPICE(BORESIGHTMISSING) is signaled if the direction - of the boresight cannot be located in the kernel pool. - - 7) The error SPICE(BADBORESIGHTSPEC) is signaled if the number of - components for the boresight vector in the kernel pool is not 3. - - 8) The error SPICE(BOUNDARYMISSING) is signaled if the boundary - vectors for the edge of the field of view cannot be found in the - kernel pool. - - 9) The error SPICE(BOUNDARYTOOBIG) is signaled if there is - insufficient room (as specified by the variable `room') to return - all of the vectors associated with the boundary of the field of - view. - - 10) The error SPICE(BADBOUNDARY) is signaled if the number of - components of vectors making up the field of view is not a - multiple of 3. - - 11) The error SPICE(BADBOUNDARY) is signaled if the number of - components of vectors making up the field of view is not - compatible with the shape specified for the field of view. - - 12) The error SPICE(REFVECTORMISSING) is signaled if the - reference vector for the ANGLES spec can not be found - in the kernel pool. - - 13) The error SPICE(BADREFVECTORSPEC) is signaled if the - reference vector stored in the kernel pool to support - the ANGLES spec contains an incorrect number of components, - contains 3 character components, or is parallel to the - boresight. - - 14) The error SPICE(REFANGLEMISSING) is signaled if the reference - angle that supports the ANGLES spec is absent from the kernel - pool. - - 15) The error SPICE(UNITSMISSING) is signaled if the - keyword that stores the angular units for the angles - used in the ANGLES spec is absent from the kernel pool. - - 16) The error SPICE(CROSSANGLEMISSING) is signaled if the - keyword that stores the cross angle for the ANGLES spec - is needed and is absent from the kernel pool. - - 17) The error SPICE(BADBOUNDARY) is signaled if the angles - for the RECTANGLE/ANGLES spec case have cosines that - are less than those stored in the parameter MINCOS. - - 18) The error SPICE(UNSUPPORTEDSPEC) is signaled if the - class specification contains something other than 'ANGLES' - or 'CORNERS'. - - 19) In the event that the CLASS_SPEC keyword is absent from the - kernel pool for the instrument whose FOV is sought, this - module assumes the default CORNERS specification is to be - utilized. - --Files - - This routine relies upon having successfully loaded an instrument - kernel (IK-file) via the routine furnsh_c prior to calling this - routine. - --Particulars - - This routine provides a common interface to retrieving - the geometric characteristics of an instrument field of - view for a wide variety of remote sensing instruments - across many different space missions. - - Given the NAIF instrument ID, (and having "loaded" the - instrument field of view description via the routine furnsh_c) - this routine returns the bore-sight of the instrument, the - "shape" of the field of view, a collection of vectors - that point along the edges of the field of view, and the - name of the reference frame in which these vectors are defined. - - Currently this routine supports two classes of specifications - for FOV definitions: "corners" and "angles". - - The "corners" specification requires the following keywords - defining the shape, boresight, boundary vectors, and reference - frame of the FOV be provided in one of the text kernel files - (normally an IK file) loaded into the kernel pool (in the - keywords below is replaced with the instrument ID as - passed into the module): - - INS_FOV_CLASS_SPEC must be set to 'CORNERS' or - omitted to indicate the - "corners"-class - specification. - - - INS_FOV_SHAPE must be set to one of these - values: - - 'CIRCLE' - 'ELLIPSE' - 'RECTANGLE' - 'POLYGON' - - INS_FOV_FRAME must contain the name of - the frame in which the - boresight and boundary - corner vectors are defined. - - INS_BORESIGHT must be set to a 3D vector - defining the boresight in - the FOV frame specified in - the FOV_FRAME keyword. - - INS_FOV_BOUNDARY or - INS_FOV_BOUNDARY_CORNERS must be set to one (for - FOV_SHAPE = 'CIRCLE'), two - (for FOV_SHAPE = - 'ELLIPSE'), three (for - FOV_SHAPE = 'RECTANGLE'), - or three or more (for - 'POLYGON') 3D vectors - defining the corners of the - FOV in the FOV frame - specified in the FOV_FRAME - keyword. - - The "angles" specification requires the following keywords - defining the shape, boresight, reference vector, reference and - cross angular extents of the FOV be provided in one of the text - kernel files (normally an IK file) loaded into the kernel - pool (in the keywords below is replaced with the - instrument ID as passed into the module): - - INS_FOV_CLASS_SPEC must be set to 'ANGLES' to - indicate the "angles"-class - specification. - - INS_FOV_SHAPE must be set to one of these - values: - - 'CIRCLE' - 'ELLIPSE' - 'RECTANGLE' - - INS_FOV_FRAME must contain the name of - the frame in which the - boresight and the computed - boundary corner vectors are - defined. - - INS_BORESIGHT must be set to a 3D vector - defining the boresight in - the FOV frame specified in - the FOV_FRAME keyword. - - INS_FOV_REF_VECTOR must be set to a 3D vector - that together with the - boresight vector defines - the plane in which the - first angular extent of the - FOV specified in the - FOV_REF_ANGLE keyword is - measured. - - INS_FOV_REF_ANGLE must be set to the angle - that is 1/2 of the total - FOV angular extent in the - plane defined by the - boresight and the vector - specified in the - FOV_REF_VECTOR keyword. - - INS_FOV_CROSS_ANGLE must be set to the angle - that is 1/2 of the total - FOV angular extent in the - plane containing the - boresight and perpendicular - to the plane defined by the - boresight and the vector - specified in the - FOV_REF_VECTOR keyword. - This keyword is not - required for FOV_SHAPE = - 'CIRCLE'. - - INS_FOV_ANGLE_UNITS must specify units for the - angles given in the - FOV_REF_ANGLE and - FOV_CROSS_ANGLE keywords. - Any angular units - recognized by convrt_c are - acceptable. - - This routine is intended to be an intermediate level routine. - It is expected that users of this routine will be familiar - with the SPICE frames subsystem and will be comfortable writing - software to further manipulate the vectors retrieved by this - routine. - --Examples - - The example program in this section loads the IK file - 'example.ti' with the following contents defining four FOVs of - various shapes and sizes: - - KPL/IK - - The keywords below define a circular, 10-degree wide FOV with - the boresight along the +Z axis of the 'SC999_INST001' frame - for an instrument with ID -999001 using the "angles"-class - specification. - - \begindata - INS-999001_FOV_CLASS_SPEC = 'ANGLES' - INS-999001_FOV_SHAPE = 'CIRCLE' - INS-999001_FOV_FRAME = 'SC999_INST001' - INS-999001_BORESIGHT = ( 0.0, 0.0, 1.0 ) - INS-999001_FOV_REF_VECTOR = ( 1.0, 0.0, 0.0 ) - INS-999001_FOV_REF_ANGLE = ( 5.0 ) - INS-999001_FOV_ANGLE_UNITS = ( 'DEGREES' ) - \begintext - - The keywords below define an elliptical FOV with 2- and - 4-degree angular extents in the XZ and XY planes and the - boresight along the +X axis of the 'SC999_INST002' frame for - an instrument with ID -999002 using the "corners"-class - specification. - - \begindata - INS-999002_FOV_SHAPE = 'ELLIPSE' - INS-999002_FOV_FRAME = 'SC999_INST002' - INS-999002_BORESIGHT = ( 1.0, 0.0, 0.0 ) - INS-999002_FOV_BOUNDARY_CORNERS = ( 1.0, 0.0, 0.01745506, - 1.0, 0.03492077, 0.0 ) - \begintext - - The keywords below define a rectangular FOV with 1.2- and - 0.2-degree angular extents in the ZX and ZY planes and the - boresight along the +Z axis of the 'SC999_INST003' frame for - an instrument with ID -999003 using the "angles"-class - specification. - - \begindata - INS-999003_FOV_CLASS_SPEC = 'ANGLES' - INS-999003_FOV_SHAPE = 'RECTANGLE' - INS-999003_FOV_FRAME = 'SC999_INST003' - INS-999003_BORESIGHT = ( 0.0, 0.0, 1.0 ) - INS-999003_FOV_REF_VECTOR = ( 1.0, 0.0, 0.0 ) - INS-999003_FOV_REF_ANGLE = ( 0.6 ) - INS-999003_FOV_CROSS_ANGLE = ( 0.1 ) - INS-999003_FOV_ANGLE_UNITS = ( 'DEGREES' ) - \begintext - - The keywords below define a triangular FOV with the boresight - along the +Y axis of the 'SC999_INST004' frame for an - instrument with ID -999004 using the "corners"-class - specification. - - \begindata - INS-999004_FOV_SHAPE = 'POLYGON' - INS-999004_FOV_FRAME = 'SC999_INST004' - INS-999004_BORESIGHT = ( 0.0, 1.0, 0.0 ) - INS-999004_FOV_BOUNDARY_CORNERS = ( 0.0, 0.8, 0.5, - 0.4, 0.8, -0.2, - -0.4, 0.8, -0.2 ) - \begintext - - The program shown below loads the IK, fetches parameters for each - of the four FOVs and prints these parameters to the screen. - - #include "SpiceUsr.h" - - #define MAXBND 4 - #define NUMINS 4 - #define WDSIZE 32 - - int main (void) - { - - SpiceChar frame [WDSIZE]; - SpiceChar shape [WDSIZE]; - - SpiceDouble bounds [MAXBND][3]; - SpiceDouble bsight [3]; - - SpiceInt i; - SpiceInt insids [NUMINS] = - { -999001, -999002, -999003, -999004}; - SpiceInt j; - SpiceInt n; - - furnsh_c( "example.ti" ); - - printf( "--------------------------------------\n" ); - for ( i = 0; i < NUMINS; i++ ) { - - getfov_c ( insids[i], MAXBND, WDSIZE, WDSIZE, - shape, frame, bsight, &n, bounds ); - - printf( "Instrument ID: %ld\n", insids[i] ); - printf( " FOV shape: %s\n", shape ); - printf( " FOV frame: %s\n", frame ); - printf( "FOV boresight: %f %f %f\n", - bsight[0], bsight[1], bsight[2] ); - printf( " FOV corners: \n" ); - for ( j = 0; j < n; j++ ) { - printf( " %f %f %f\n", - bounds[j][0], bounds[j][1], bounds[j][2] ); - } - printf( "--------------------------------------\n" ); - } - return(0); - } - - The program produces the following output: - - -------------------------------------- - Instrument ID: -999001 - FOV shape: CIRCLE - FOV frame: SC999_INST001 - FOV boresight: 0.000000 0.000000 1.000000 - FOV corners: - 0.087156 0.000000 0.996195 - -------------------------------------- - Instrument ID: -999002 - FOV shape: ELLIPSE - FOV frame: SC999_INST002 - FOV boresight: 1.000000 0.000000 0.000000 - FOV corners: - 1.000000 0.000000 0.017455 - 1.000000 0.034921 0.000000 - -------------------------------------- - Instrument ID: -999003 - FOV shape: RECTANGLE - FOV frame: SC999_INST003 - FOV boresight: 0.000000 0.000000 1.000000 - FOV corners: - 0.010472 0.001745 0.999944 - -0.010472 0.001745 0.999944 - -0.010472 -0.001745 0.999944 - 0.010472 -0.001745 0.999944 - -------------------------------------- - Instrument ID: -999004 - FOV shape: POLYGON - FOV frame: SC999_INST004 - FOV boresight: 0.000000 1.000000 0.000000 - FOV corners: - 0.000000 0.800000 0.500000 - 0.400000 0.800000 -0.200000 - -0.400000 0.800000 -0.200000 - -------------------------------------- - --Restrictions - - An I-kernel for the instrument specified in INSTID must have been - loaded via a call to furnsh_c prior to calling this routine and - must contain the specification for the instrument field of view - consistent with the expectations of this routine. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - --Version - - -CSPICE Version 1.0.5, 05-FEB-2009 (BVS) - - Header update: added information about required IK keywords; - replaced old example with a new one more focused on getfov_c and - IK keywords. - - -CSPICE Version 1.0.4, 27-OCT-2005 (NJB) - - Header update: replaced reference to bodvar_c with - reference to bodvcd_c. - - -CSPICE Version 1.0.3, 28-DEC-2004 (BVS) - - Fixed typo in the header example. - - -CSPICE Version 1.0.2, 29-JUL-2003 (NJB) (CHA) - - Various header changes were made to improve clarity. Some - minor header corrections were made. - - -CSPICE Version 1.0.1, 18-DEC-2001 (FST) - - Updated the header of this wrapper to document the changes - in GETFOV regarding the addition of support for the ANGLES - specification. - - -CSPICE Version 1.0.0, 13-APR-2000 (FST) - --Index_Entries - - return instrument's FOV parameters - --& -*/ - -{ /* Begin getfov_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "getfov_c" ); - - /* - Make sure the output strings have at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "getfov_c", shape, shapelen ); - CHKOSTR ( CHK_STANDARD, "getfov_c", frame, framelen ); - - /* - Call the f2c converted routine. - */ - getfov_ ( ( integer * ) &instid, - ( integer * ) &room, - ( char * ) shape, - ( char * ) frame, - ( doublereal * ) bsight, - ( integer * ) n, - ( doublereal * ) bounds, - ( ftnlen ) shapelen-1, - ( ftnlen ) framelen-1 ); - - /* - The strings returned, shape and frame, are Fortranish type strings. - Convert the strings to C type. - */ - F2C_ConvertStr ( shapelen, shape ); - F2C_ConvertStr ( framelen, frame ); - - chkout_c ( "getfov_c" ); - -} /* End getfov_c */ diff --git a/ext/spice/src/cspice/getlun.c b/ext/spice/src/cspice/getlun.c deleted file mode 100644 index a757aea84e..0000000000 --- a/ext/spice/src/cspice/getlun.c +++ /dev/null @@ -1,240 +0,0 @@ -/* getlun.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure GETLUN ( Get a free logical unit ) */ -/* Subroutine */ int getlun_(integer *unit) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), fndlun_(integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the number of a free logical unit. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT O The number of a free logical unit. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* UNIT is the number of a free logical unit (also called */ -/* an "external unit"). If no free units are available, */ -/* the value of UNIT is 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there are no free logical units available, UNIT is assigned */ -/* the value 0, and the error SPICE(NOFREELOGICALUNIT) is */ -/* signalled. */ - -/* 2) This routine obtains a logical unit number from FNDLUN. */ -/* FNDLUN executes a Fortran INQUIRE statement; if that statement */ -/* fails to execute properly, FNDLUN returns a negative unit */ -/* number. In this case, GETLUN assigns the value 0 to UNIT, */ -/* and the error SPICE(INQUIREFAILED) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* GETLUN returns the number of the first (unreserved) unit not */ -/* currently connected to a file. It thus frees the user from */ -/* having to maintain an accounting of which units are open, which */ -/* are closed, and which are available. */ - -/* This routine is related to the routines FNDLUN, RESLUN, and */ -/* FRELUN. Together, these routines support coordinated usage of */ -/* Fortran logical units. GETLUN (Get a free logical unit) and */ -/* FNDLUN (Find a free logical unit) both have the function of */ -/* returning a logical unit number that is not reserved or already */ -/* in use. The principal difference between the functionality of */ -/* these routines is that GETLUN both returns a status code and */ -/* signals an error if a free unit is not found, while FNDLUN */ -/* merely returns a status code. */ - -/* RESLUN is used to reserve logical unit numbers, so that they will */ -/* not be returned by GETLUN or FNDLUN; FRELUN frees logical units */ -/* previously reserved via calls to RESLUN. */ - -/* Logical units 5-7 are reserved by default. Other units may be */ -/* reserved by calling RESLUN. Once reserved, units (except 5-7) may */ -/* be unreserved by calling FRELUN. */ - -/* To reserve logical unit numbers for special use, refer to */ -/* RESLUN. To make reserved units available to GETLUN or FNDLUN, */ -/* refer to FRELUN. */ - -/* A unit returned by GETLUN does NOT automatically become a */ -/* reserved unit. If the user wishes to reserve a unit found by */ -/* GETLUN, the call to GETLUN must be followed by a call to RESLUN. */ - -/* This routine obtains a logical unit number via a call to FNDLUN. */ -/* FNDLUN uses an INQUIRE statement; if that statement doesn't */ -/* execute properly, GETLUN will signal the error. This arrangement */ -/* allows FNDLUN to be error free. */ - -/* The range of possible unit numbers returned by GETLUN is dependent */ -/* on the parameters MINLUN and MAXLUN, which are defined in FNDLUN. */ - -/* Note that although 0 is a valid logical unit number on some */ -/* systems, a value of 0 returned by GETLUN indicates that no free */ -/* logical unit was available, rather than that logical unit 0 is */ -/* available. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of GETLUN. */ - -/* CALL GETLUN ( UNIT ) */ - -/* IF ( UNIT .EQ. 0 ) THEN */ -/* RETURN */ -/* END IF */ - -/* $ Restrictions */ - -/* This routine never returns a logical unit number of 0. The */ -/* value 0 is used to indicate that no free logical unit was */ -/* found. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - 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 (CAC) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* get a free logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 24-FEB-1989 (HAN) (NJB) */ - -/* This routine has been substantially re-written so as to */ -/* obtain a free logical unit number via a call to FNDLUN. */ - -/* If there are no free logical units available, UNIT */ -/* is assigned the value 0, and an error is signalled. */ - -/* The "Parameters" section was added to the header. */ - -/* -& */ - -/* Spicelib functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETLUN", (ftnlen)6); - } - -/* Find a free logical unit, if there's one to be had. */ - - fndlun_(unit); - if (*unit == 0) { - -/* There are no free units to be had. C'est la vie. Signal an */ -/* error. */ - - setmsg_("No free logical units are available.", (ftnlen)36); - sigerr_("SPICE(NOFREELOGICALUNIT)", (ftnlen)24); - chkout_("GETLUN", (ftnlen)6); - return 0; - } else if (*unit < 0) { - -/* There are no free units to be had. In this case, we know the */ -/* "INQUIRE" attempted by FNDLUN failed. Assign 0 to the unit */ -/* number, and signal an error. */ - - setmsg_("INQUIRE iostat was #.", (ftnlen)21); - i__1 = -(*unit); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - *unit = 0; - chkout_("GETLUN", (ftnlen)6); - return 0; - } - chkout_("GETLUN", (ftnlen)6); - return 0; -} /* getlun_ */ - diff --git a/ext/spice/src/cspice/getmsg.c b/ext/spice/src/cspice/getmsg.c deleted file mode 100644 index 623eb7ee49..0000000000 --- a/ext/spice/src/cspice/getmsg.c +++ /dev/null @@ -1,309 +0,0 @@ -/* getmsg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure GETMSG ( Get Error Message ) */ -/* Subroutine */ int getmsg_(char *option, char *msg, ftnlen option_len, - ftnlen msg_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1[2]; - char ch__1[144]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - expln_(char *, char *, ftnlen, ftnlen), ljust_(char *, char *, - ftnlen, ftnlen); - char upopt[10]; - extern /* Subroutine */ int getlms_(char *, ftnlen), sigerr_(char *, - ftnlen); - char locopt[10]; - extern /* Subroutine */ int getsms_(char *, ftnlen), setmsg_(char *, - ftnlen); - char shrtms[25]; - -/* $ Abstract */ - -/* Retrieve the current short error message, */ -/* the explanation of the short error message, or the */ -/* long error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OPTION I Indicates type of error message. */ -/* MSG O The error message to be retrieved. */ - - -/* $ Detailed_Input */ - -/* OPTION Indicates the type of error message to be retrieved. */ -/* The choices are: The current short error message, */ -/* the explanation of the short error message, */ -/* or the current long error message. */ - -/* Possible values of OPTION are: */ - -/* 'SHORT' -- indicates that the short message is to */ -/* be retrieved */ - -/* 'EXPLAIN' -- indicates that the explanation of the */ -/* short message is to be retrieved */ - -/* 'LONG' -- indicates that the long message is to */ -/* be retrieved */ - -/* The input strings indicating the choice of option */ -/* may be in mixed case. For example, there is no */ -/* problem with the call, */ - -/* CALL GETMSG ( 'loNg' , MSG ) */ - -/* $ Detailed_Output */ - -/* MSG Is the error message to be retrieved. */ -/* Its value depends on OPTION, and on whether */ -/* an error condition exists. */ - -/* When there is no error condition, MSG is blank. */ - - -/* If an error condition does exist, */ - -/* When OPTION is */ - -/* 'SHORT' -- MSG is the current short error message. */ -/* This is a very condensed, 25-character */ -/* description of the error. */ - -/* 'EXPLAIN' -- MSG is the explanation of the current */ -/* short error message. This is a one-line */ -/* expansion of the text of the short */ -/* message. */ - -/* All SPICELIB short error messages */ -/* do have corresponding explanation text. */ -/* For other short error messages, if */ -/* there is no explanation text, MSG */ -/* will be blank. */ - -/* 'LONG' -- MSG is the current long error message. */ -/* The long error message is a detailed */ -/* explanation of the error, possibly */ -/* containing data specific to the */ -/* particular occurrence of the error. */ -/* Not all errors have long error messages. */ -/* If there is none, MSG will be blank. */ -/* Long error messages are no longer than */ -/* 320 characters. */ - -/* invalid -- MSG will remain unchanged from */ -/* its value on input. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Errors detected: */ - -/* 1. SPICE(INVALIDMSGTYPE) */ - -/* This routine signals an error condition if the input, */ -/* OPTION, is invalid. In that case no messages are */ -/* returned; MSG retains the value it had on input. */ - - -/* This routine is part of the interface to the */ -/* SPICELIB error handling mechanism. For this reason, */ -/* this routine does not participate in the trace scheme, */ -/* even though it has external references. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Please read the "required reading" first! */ - -/* A good time to call this routine would be when an error */ -/* condition exists, as indicated by the SPICELIB function, */ -/* FAILED. */ - -/* See the example below for a serving suggestion. */ - -/* GETMSG isn't too useful if an error condition doesn't */ -/* exist, since it will return a blank string in that case. */ - - -/* $ Examples */ - - -/* Here's an example of a real-life call to GETMSG to get the */ -/* explanation of the current short error message. */ - -/* In this example, a SPICELIB routine, RDTEXT, is called. */ -/* Following the return from RDTEXT, the logical function, */ -/* FAILED, is tested to see whether an error occurred. */ -/* If it did, the message is retrieved and output via */ -/* a user-defined output routine: */ - - -/* C */ -/* C We call RDTEXT; then test for errors... */ -/* C */ -/* CALL RDTEXT ( FILE, LINE, EOF ) */ - -/* IF ( FAILED ) THEN */ - -/* C */ -/* C Get explanation text for the current short message */ -/* C and print it: */ -/* C */ - -/* CALL GETMSG ( 'EXPLAIN', TEXT ) */ - -/* CALL USER_DEFINED_OUTPUT ( TEXT ) */ - -/* . */ -/* . [Do more stuff here] */ -/* . */ - -/* END IF */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get error message */ - -/* -& */ - -/* Local Variables: */ - - -/* Length of short error message: */ - - -/* Upper case version of the option: */ - - -/* Heeeeeeeeeeeeeeeeeeeeer's the code! */ - - -/* We only speak upper case in this routine, */ -/* so convert any lower case letters in OPTION */ -/* to upper case. We save the original OPTION */ -/* string just in case we need to echo it in */ -/* an error message. */ - - ljust_(option, upopt, option_len, (ftnlen)10); - ucase_(upopt, upopt, (ftnlen)10, (ftnlen)10); - if (s_cmp(upopt, "SHORT", (ftnlen)10, (ftnlen)5) == 0) { - -/* Retrieve short message: */ - - getsms_(msg, msg_len); - } else if (s_cmp(upopt, "EXPLAIN", (ftnlen)10, (ftnlen)7) == 0) { - -/* Get current short message; then get explanation */ -/* corresponding to current short error message: */ - - getsms_(shrtms, (ftnlen)25); - expln_(shrtms, msg, (ftnlen)25, msg_len); - } else if (s_cmp(upopt, "LONG", (ftnlen)10, (ftnlen)4) == 0) { - -/* Grab long error message: */ - - getlms_(msg, msg_len); - } else { - -/* Invalid value of OPTION!! Signal error, and set long */ -/* error message as well: */ - - s_copy(locopt, option, (ftnlen)10, option_len); -/* Writing concatenation */ - i__1[0] = 134, a__1[0] = "GETMSG: An invalid value of OPTION was inp" - "ut. Valid choices are 'SHORT', 'EXPLAIN', or 'LONG'. " - " The value that was input was: "; - i__1[1] = 10, a__1[1] = locopt; - s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)144); - setmsg_(ch__1, (ftnlen)144); - sigerr_("SPICE(INVALIDMSGTYPE)", (ftnlen)21); - } - return 0; -} /* getmsg_ */ - diff --git a/ext/spice/src/cspice/getmsg_c.c b/ext/spice/src/cspice/getmsg_c.c deleted file mode 100644 index 5ce04c202e..0000000000 --- a/ext/spice/src/cspice/getmsg_c.c +++ /dev/null @@ -1,282 +0,0 @@ -/* - --Procedure getmsg_c ( Get Error Message ) - --Abstract - - Retrieve the current short error message, - the explanation of the short error message, or the - long error message. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void getmsg_c ( ConstSpiceChar * option, - SpiceInt lenout, - SpiceChar * msg ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - option I Indicates type of error message. - lenout I Available space in the output string msg. - msg O The error message to be retrieved. - - --Detailed_Input - - option Indicates the type of error message to be retrieved. - The choices are: The current short error message, - the explanation of the short error message, - or the current long error message. - - Possible values of option are: - - "SHORT" -- indicates that the short message is to - be retrieved - - "EXPLAIN" -- indicates that the explanation of the - short message is to be retrieved - - "LONG" -- indicates that the long message is to - be retrieved - - The input strings indicating the choice of option - may be in mixed case. For example, there is no - problem with the call, - - getmsg_c ( "loNg", MSGLEN, msg ); - - - - lenout is the maximum allowed length of the output message string, - including the terminating null character. For example, - if the caller wishes to be able to accept an 1840-character - message, lenout must be set to (at least) 1841. The current - maximum long error message length is in fact 1840 characters. - - --Detailed_Output - - msg is the error message to be retrieved. Its value depends on - option, and on whether an error condition exists. - - When there is no error condition, msg is empty. - - If an error condition does exist, - - When option is - - "SHORT" -- msg is the current short error message. - This is a very condensed, 25-character - description of the error. - - "EXPLAIN" -- msg is the explanation of the current - short error message. This is a one-line - expansion of the text of the short - message. - - Most CSPICE short error messages - have corresponding explanation text. - For other short error messages, if - there is no explanation text, msg - will be blank. - - "LONG" -- msg is the current long error message. - The long error message is a detailed - explanation of the error, possibly - containing data specific to the - particular occurrence of the error. - Not all errors have long error messages. - If there is none, msg will be empty. - Long error messages are no longer than - 320 characters. - - invalid -- msg will remain unchanged from - its value on input. - - --Parameters - - None. - --Exceptions - - 1) If the input string option is invalid, the error - SPICE(INVALIDMSGTYPE) will be signaled. In that case no message - is returned; msg retains the value it had on input. - - 2) The error SPICE(NULLPOINTER) is signaled if either string pointer - argument is null. - - 3) The caller must pass a value indicating the length of the output - string. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) is signaled. - - This routine is part of the interface to the - CSPICE error handling mechanism. For this reason, - this routine does not participate in the trace scheme, - even though it has external references. - --Files - - None. - --Particulars - - Please read the "required reading" first! - - A good time to call this routine would be when an error - condition exists, as indicated by the CSPICE function, - failed_c. - --Examples - - - Here's an example of a real-life call to getmsg_c to get the - explanation of the current short error message. - - In this example, a CSPICE routine, ckopn_c, is called. - Following the return from ckopn_c, the logical function, - failed_c, is tested to see whether an error occurred. - If it did, the message is retrieved and output via - a user-defined output routine: - - #include "SpiceUsr.h" - #include - - #define MSGLEN 1841 - - SpiceChar msg [ MSGLEN ]; - - . - . - . - /. - We call ckopn_c; then test for errors... - ./ - - ckopn_c ( filename, ifname, ncomch, &handle ); - - if ( failed_c() ) - { - /. - Get explanation text for the current short message - and print it: - ./ - - getmsg_c ( "EXPLAIN", MSGLEN, msg ); - - [Output message] - . - . - . - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 5-APR-1999 (NJB) - --Index_Entries - - get error message - --& -*/ - -{ /* Begin getmsg_c */ - - - - /* - Participate in error tracing. - */ - - chkin_c ( "getmsg_c" ); - - - /* - Check the input string op to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "getmsg_c", option ); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "getmsg_c", msg, lenout ); - - - /* - Call the f2c'd Fortran routine. - */ - getmsg_ ( ( char * ) option, - ( char * ) msg, - ( ftnlen ) strlen(option), - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran-style to C-style. - */ - F2C_ConvertStr( lenout, msg ); - - - chkout_c ( "getmsg_c" ); - -} /* End getmsg_c */ - diff --git a/ext/spice/src/cspice/gfbail.c b/ext/spice/src/cspice/gfbail.c deleted file mode 100644 index 40037facf4..0000000000 --- a/ext/spice/src/cspice/gfbail.c +++ /dev/null @@ -1,215 +0,0 @@ -/* gfbail.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure GFBAIL ( Bailout ) */ -logical gfbail_(void) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* This routine serves as a placeholder for an interrupt */ -/* detection function. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* INTERRUPT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* This function always returns the value .FALSE. */ - -/* $ Detailed_Input */ - -/* None */ - -/* $ Detailed_Output */ - -/* This function always returns the value .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as a stub for interrupt function input */ -/* arguments in GF mid-level search routines such as */ - -/* GFEVNT */ -/* GFOCCE */ -/* GFFOVE */ - -/* Those routines allow the caller to pass in a custom interrupt */ -/* detection function. */ - -/* Searches conducted with the GF APIs can be unexpectedly */ -/* time-consuming. When such searches are carried out by an */ -/* interactive application, it can be useful to be able to stop a */ -/* search without stopping the application itself. This enables a */ -/* user to avoid loss of previous work that may have been performed */ -/* during the program run. */ - -/* The mid-level GF search APIs named above provide partial support */ -/* for interrupt handling. They allow the caller to pass in an */ -/* interrupt detection function; when their input "bail-out" flag */ -/* argument is set to .TRUE. by the caller, the low-level GF */ -/* root-finding routines invoked by these APIs will, over regular, */ -/* short time intervals (these intervals are usually determined by */ -/* the completion of loop passes), call the interrupt detection */ -/* function. These routines will return immediately if the function */ -/* indicates that an interrupt has occurred. */ - -/* However, SPICELIB doesn't fully support interrupt handling */ -/* because ANSI Fortran 77 doesn't provide the features necessary to */ -/* implement an interrupt detection function. */ - -/* Some Fortran platforms do provide non-standard routines that */ -/* support interrupt handling, so for these systems, SPICE users may */ -/* be able to create their own interrupt detection routines. Such */ -/* routines should have calling sequences identical to that of this */ -/* function. These routines should have a "reset" feature that */ -/* enables an application to make them return .FALSE. after an */ -/* interrupt has been indicated and processed. */ - -/* For platforms where interrupt detection can't be implemented, or */ -/* in cases where applications must call mid-level GF APIs but don't */ -/* need interrupt handling, this routine can be used. */ - -/* This routine has no interrupt detection capability: it always */ -/* returns the value .FALSE. */ - -/* Developers of SPICE-based applications who have the choice of */ -/* writing code in Fortran or C may wish to consider the fact that */ -/* the CSPICE Toolkit does support interrupt detection: gfbail_c, */ -/* the CSPICE analog of this routine, is fully functional on all */ -/* platforms on which CSPICE is supported. */ - -/* $ Examples */ - -/* This example shows how to call a mid-level GF search API that */ -/* requires an input interrupt detection function. */ - -/* If a custom interrupt detection function is available, it */ -/* can be referenced exactly as is GFBAIL in this example. */ - -/* The code fragment below is from the first code example in the */ -/* header of */ - -/* gfocce.for */ - -/* Only the portions of that program relevant to use of GFBAIL are */ -/* copied here. Deleted portions of code are indicated by ellipses. */ - -/* Note that GFBAIL is the third-to-last argument in the */ -/* GFOCCE call. */ - - -/* PROGRAM EX1 */ - -/* IMPLICIT NONE */ - -/* ... */ - -/* LOGICAL GFBAIL */ -/* EXTERNAL GFBAIL */ - -/* ... */ - -/* C */ -/* C Turn on progress reporting; turn off interrupt */ -/* C handling. */ -/* C */ - -/* ... */ - -/* BAIL = .FALSE. */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFOCCE ( 'ANY', */ -/* . 'MOON', 'ellipsoid', 'IAU_MOON', */ -/* . 'SUN', 'ellipsoid', 'IAU_SUN', */ -/* . 'LT', 'EARTH', CNVTOL, */ -/* . GFSTEP, GFREFN, RPT, */ -/* . GFREPI, GFREPU, GFREPF, */ -/* . BAIL, GFBAIL, CNFINE, RESULT ) */ - - -/* ... */ - - - -/* $ Restrictions */ - -/* This is a stub routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF standard bail out routine */ - -/* -& */ - ret_val = FALSE_; - return ret_val; -} /* gfbail_ */ - diff --git a/ext/spice/src/cspice/gfbail_c.c b/ext/spice/src/cspice/gfbail_c.c deleted file mode 100644 index e1dc2c5aef..0000000000 --- a/ext/spice/src/cspice/gfbail_c.c +++ /dev/null @@ -1,189 +0,0 @@ -/* - --Procedure gfbail_c ( GF, interrupt signal indicator ) - --Abstract - - Indicate whether an interrupt signal (SIGINT) has been received. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - - SpiceBoolean gfbail_c () - -/* - --Brief_I/O - - The function returns SPICETRUE if an interrupt signal has - been received by the GF handler. - --Detailed_Input - - None - --Detailed_Output - - The function returns SPICETRUE if an interrupt signal has been - received by the GF handler gfinth_c since the first setting of the - handler or the last call to gfclrh_c, whichever is most recent. - Otherwise the function returns SPICEFALSE. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This routine returns the interrupt signal handler status maintained - by the GF subsystem. - - User applications that use default GF interrupt handling should call - this routine after each call to a GF API that can process an - interrupt signal. In general, if this routine indicates that an - interrupt signal was received, any GF processing that was interrupted - should be presumed to have invalid results. - --Examples - - 1) The code fragment below is from an example program in - the header of gfocce_c. The code includes a search, - a call to gfbail_c, which is made to determine whether - an interrupt signal was received, and a call to - gfclrh_c to clear the interrupt signal status. - - ... - - /. - Turn on interrupt handling and progress reporting. - ./ - bail = SPICETRUE; - rpt = SPICETRUE; - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, &cnfine, - &result ); - - - if ( gfbail_c() ) - { - /. - Clear the CSPICE interrupt indication. This is - an essential step for programs that continue - running after an interrupt; gfbail_c will - continue to return SPICETRUE until this step - has been performed. - ./ - gfclrh_c(); - - - /. - We've trapped an interrupt signal. In a realistic - application, the program would continue operation - from this point. In this simple example, we simply - display a message and quit. - ./ - printf ( "\nSearch was interrupted.\n\nThis message " - "was written after an interrupt signal\n" - "was trapped. By default, the program " - "would have terminated \nbefore this message " - "could be written.\n\n" ); - } - else - - - ... - - --Restrictions - - This routine has no visible effect on operation of user applications - unless GF interrupt handling is enabled and this routine is used as - the interrupt signal receipt indicator. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - --Version - - -CSPICE Version 1.0.0, 05-FEB-2009 (NJB) (LSE) - --Index_Entries - - GF interrupt signal receipt indicator - --& -*/ - -{ /* Begin gfbail_c */ - - /* - Return the saved interrupt status. - */ - return ( zzgfgeth_c() ); - - -} /* End gfbail_c */ - - diff --git a/ext/spice/src/cspice/gfclrh_c.c b/ext/spice/src/cspice/gfclrh_c.c deleted file mode 100644 index f27b11e95e..0000000000 --- a/ext/spice/src/cspice/gfclrh_c.c +++ /dev/null @@ -1,186 +0,0 @@ -/* - --Procedure gfclrh_c ( GF, clear interrupt signal handler status ) - --Abstract - - Clear the interrupt signal handler status, so that future calls - to gfbail_c will indicate no interrupt was received. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - - void gfclrh_c ( void ) - -/* - --Brief_I/O - - None. This routine operates by side effects; see Particulars - below. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This routine clears the interrupt signal handler status maintained - by the GF subsystem. Calling this routine causes the GF interrupt - signal receipt indicator function gfbail_c to return SPICEFALSE - until the next interrupt signal is received by a signal handler - established by the GF system. - - User applications that use default GF interrupt handling should call - this routine after processing an interrupt signal. - --Examples - - 1) The code fragment below is from an example program in - the header of gfocce_c. The code includes a search, - a call to gfbail_c, which is made to determine whether - an interrupt signal was received, and a call to - gfclrh_c to clear the interrupt signal status. - - ... - - /. - Turn on interrupt handling and progress reporting. - ./ - bail = SPICETRUE; - rpt = SPICETRUE; - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, &cnfine, - &result ); - - - if ( gfbail_c() ) - { - /. - Clear the CSPICE interrupt indication. This is - an essential step for programs that continue - running after an interrupt; gfbail_c will - continue to return SPICETRUE until this step - has been performed. - ./ - gfclrh_c(); - - - /. - We've trapped an interrupt signal. In a realistic - application, the program would continue operation - from this point. In this simple example, we simply - display a message and quit. - ./ - printf ( "\nSearch was interrupted.\n\nThis message " - "was written after an interrupt signal\n" - "was trapped. By default, the program " - "would have terminated \nbefore this message " - "could be written.\n\n" ); - } - else - - - ... - - --Restrictions - - This routine has no visible effect on operation of user applications - unless GF interrupt handling is enabled and gfbail_c is used as - the interrupt signal receipt indicator. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - --Version - - -CSPICE Version 1.0.0, 05-FEB-2009 (NJB) (LSE) - --Index_Entries - - GF clear interrupt signal status - --& -*/ - -{ /* Begin gfclrh_c */ - - - /* - Clear the saved interrupt signal handler status. - */ - - zzgfsavh_c ( SPICEFALSE ); -} diff --git a/ext/spice/src/cspice/gfdist.c b/ext/spice/src/cspice/gfdist.c deleted file mode 100644 index 3e6e548b4f..0000000000 --- a/ext/spice/src/cspice/gfdist.c +++ /dev/null @@ -1,1382 +0,0 @@ -/* gfdist.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b27 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFDIST ( GF, distance search ) */ -/* Subroutine */ int gfdist_(char *target, char *abcorr, char *obsrvr, char * - relate, doublereal *refval, doublereal *adjust, doublereal *step, - doublereal *cnfine, integer *mw, integer *nw, doublereal *work, - doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen - obsrvr_len, ftnlen relate_len) -{ - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_(), gfrepu_(), - gfstep_(); - char qcpars[80*3], qpnams[80*3]; - extern logical return_(void); - doublereal qdpars[3]; - integer qipars[3]; - logical qlpars[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *, - integer *, char *, char *, doublereal *, integer *, logical *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *, - logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Return the time window over which a specified constraint on */ -/* observer-target distance is met. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* GEOMETRY */ -/* EPHEMERIS */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance */ -/* NWDIST P Number of workspace windows for distance search. */ -/* TARGET I Name of the target body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* RELATE I Relational operator. */ -/* REFVAL I Reference value. */ -/* ADJUST I Adjustment value for absolute extrema searches. */ -/* STEP I Step size used for locating extrema and roots. */ -/* CNFINE I SPICE window to which the search is confined. */ -/* MW I Workspace window size. */ -/* NW I Workspace window count. */ -/* WORK I-O Array of workspace windows. */ -/* RESULT I-O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* TARGET is the name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector which */ -/* points from the observer to the target; the length of */ -/* this vector is the "distance" that serves as the */ -/* subject of the search performed by this routine. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TARGET. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the observer-target position vector to account for */ -/* one-way light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string ABCORR. */ - - -/* OBSRVR is the name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to supply to indicate the */ -/* observer is Earth. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* RELATE is a relational operator used to define a constraint */ -/* on the observer-target distance. The result window */ -/* found by this routine indicates the time intervals */ -/* where the constraint is satisfied. Supported values */ -/* of RELATE and corresponding meanings are shown below: */ - -/* '>' Distance is greater than the reference */ -/* value REFVAL. */ - -/* '=' Distance is equal to the reference */ -/* value REFVAL. */ - -/* '<' Distance is less than the reference */ -/* value REFVAL. */ - - -/* 'ABSMAX' Distance is at an absolute maximum. */ - -/* 'ABSMIN' Distance is at an absolute minimum. */ - -/* 'LOCMAX' Distance is at a local maximum. */ - -/* 'LOCMIN' Distance is at a local minimum. */ - -/* The caller may indicate that the region of interest is */ -/* the set of time intervals where the distance is within */ -/* a specified offset relative to an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this offset. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string RELATE. */ - - -/* REFVAL is the reference value used together with the argument */ -/* RELATE to define an equality or inequality to be */ -/* satisfied by the distance between the specified target */ -/* and observer. See the discussion of RELATE above for */ -/* further information. */ - -/* The units of REFVAL are km. */ - - -/* ADJUST is a parameter used to modify searches for absolute */ -/* extrema: when RELATE is set to ABSMAX or ABSMIN and */ -/* ADJUST is set to a positive value, GFDIST */ -/* will find times when the observer-target distance is */ -/* within ADJUST km of the specified extreme value. */ - -/* If ADJUST is non-zero and a search for an absolute */ -/* minimum AMIN is performed, the result window contains */ -/* time intervals when the observer-target distance has */ -/* values between AMIN and AMIN + ADJUST. */ - -/* If the search is for an absolute maximum AMAX, the */ -/* corresponding range is between AMAX - ADJUST and */ -/* AMAX. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions. */ - - -/* STEP is the step size to be used in the search. STEP must */ -/* be shorter than any maximal time interval on which the */ -/* specified distance function is monotone increasing or */ -/* decreasing. That is, if the confinement window is */ -/* partitioned into alternating intervals on which the */ -/* distance function is either monotone increasing or */ -/* decreasing, STEP must be shorter than any of these */ -/* intervals. */ - -/* However, STEP must not be *too* short, or the search */ -/* will take an unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* The endpoints of the time intervals comprising CNFINE */ -/* are interpreted as seconds past J2000 TDB. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. NW should be set to the */ -/* parameter NWDIST; this parameter is declared in the */ -/* include file gf.inc. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* INCLUDE 'gf.inc' */ -/* ... */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWDIST ) */ - -/* where MW is a constant declared by the caller and */ -/* NWDIST is a constant defined in the SPICELIB INCLUDE */ -/* file gf.inc. See the discussion of MW above. */ - -/* WORK need not be initialized by the caller. */ - -/* $ Detailed_Output */ - -/* WORK is the input workspace array, modified by this */ -/* routine. The caller should re-initialize this array */ -/* before attempting to use it for any other purpose. */ - - -/* RESULT is the window of intervals, contained within the */ -/* confinement window CNFINE, on which the specified */ -/* constraint is satisfied. */ - -/* The endpoints of the time intervals comprising RESULT */ -/* are interpreted as seconds past J2000 TDB. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFDIST conducts its */ -/* search. */ - -/* $ Parameters */ - -/* LBCELL is the lower bound for SPICE Cell arrays. */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the specified distance is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* NWDIST is the number of workspace windows required by */ -/* this routine. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEP) is signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results. The SPICE window routine */ -/* WNCOND can be used to contract the result window. */ - -/* 3) If an error (typically cell overflow) occurs while performing */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 4) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 5) If the aberration correction specifier contains an */ -/* unrecognized value, an error is signaled by a routine in the */ -/* call tree of this routine */ - -/* 6) If ADJUST is negative, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 7) If either of the input body names do not map to NAIF ID */ -/* codes, an error is signaled by a routine in the call tree of */ -/* this routine. */ - -/* 8) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* 9) If the window size MW is less than 2, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 10) If the window count NW is less than NWDIST, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 11) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* distance condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(INVALIDDIMENSION) */ -/* will be signaled by this routine. */ - - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer for the */ -/* time period defined by the confinement window must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when the distance between the */ -/* specified target and observer satisfies a caller-specified */ -/* constraint. The resulting set of intervals is returned as a SPICE */ -/* window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* distance function is monotone increasing and monotone decreasing. */ -/* Each of these time periods is represented by a SPICE window. */ -/* Having found these windows, all of the distance function's local */ -/* extrema within the confinement window are known. Absolute extrema */ -/* then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. With these solutions */ -/* in hand, solutions of inequalities are easily found as well. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found via a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is the time */ -/* separation at which the sign of the rate of change of distance */ -/* ("range rate") is sampled. Starting at the left endpoint of the */ -/* interval, samples will be taken at each step. If a change of sign */ -/* is found, a root has been bracketed; at that point, the time at */ -/* which the range rate is zero can be found by a refinement */ -/* process, for example, via binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the distance function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* As described above, the root-finding process used by this routine */ -/* involves first bracketing roots and then using a search process */ -/* to locate them. "Roots" include times when extrema are attained */ -/* and times when the distance function is equal to a reference */ -/* value or adjusted extremum. All endpoints of the intervals */ -/* comprising the result window are either endpoints of intervals of */ -/* the confinement window or roots. */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set via the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't limit the accuracy of solutions found by this */ -/* routine. In general the accuracy of input data will be the */ -/* limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFENVT must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater affect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. See the "CASCADE" */ -/* example program in gf.req for a demonstration. */ - - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) Find times during the first three months of the year 2007 when */ -/* the geometric Earth-Moon distance is greater than 400000 km. */ -/* Display the start and stop times of the time intervals over */ -/* which this constraint is met, along with the Earth-Moon */ -/* distance at each interval endpoint. */ - -/* We expect the Earth-Moon distance to be an oscillatory */ -/* function with extrema roughly two weeks apart. Using */ -/* a step size of one day guarantees that the GF system */ -/* won't fail to find any distance extrema. (Recall that a */ -/* search for distance extrema is an intermediate step */ -/* in the GF search process.) */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File name: standard.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de421.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0009.tls Leapseconds */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de421.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0009.tls' ) */ - -/* \begintext */ - -/* End of meta-kernel */ - - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION VNORM */ -/* INTEGER WNCARD */ -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ -/* C */ -/* C Use the parameter MAXWIN for both */ -/* C the result window size and the workspace */ -/* C size. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 20000 ) */ -/* C */ -/* C Length of output time string: */ -/* C */ -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 26 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION ADJUST */ -/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */ -/* DOUBLE PRECISION DIST */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION FINISH */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 3 ) */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION START */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWDIST ) */ - -/* INTEGER I */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 1', ET0 ) */ -/* CALL STR2ET ( '2007 APR 1', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ -/* C */ -/* C Search using a step size of 1 day (in units of */ -/* C seconds). The reference value is 450000 km. */ -/* C We're not using the adjustment feature, so */ -/* C we set ADJUST to zero. */ -/* C */ -/* STEP = SPD() */ -/* REFVAL = 4.D5 */ -/* ADJUST = 0.D0 */ - -/* C */ -/* C Perform the search. The set of times when the */ -/* C constraint is met will be stored in the SPICE */ -/* C window RESULT. */ -/* C */ -/* CALL GFDIST ( 'MOON', 'NONE', 'EARTH', '>', */ -/* . REFVAL, ADJUST, STEP, CNFINE, */ -/* . MAXWIN, NWDIST, WORK, RESULT ) */ -/* C */ -/* C Display the results. */ -/* C */ -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ -/* WRITE (*, '(A)') 'Result window is empty.' */ -/* ELSE */ -/* DO I = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, I, START, FINISH ) */ -/* C */ -/* C Check the distance at the start and stop times. */ -/* C */ -/* CALL SPKPOS ( 'MOON', START, 'J2000', 'NONE', */ -/* . 'EARTH', POS, LT ) */ -/* DIST = VNORM(POS) */ - -/* CALL TIMOUT ( START, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) 'Start time, distance = '// */ -/* . TIMSTR, DIST */ - -/* CALL SPKPOS ( 'MOON', FINISH, 'J2000', 'NONE', */ -/* . 'EARTH', POS, LT ) */ -/* DIST = VNORM(POS) */ - -/* CALL TIMOUT ( FINISH, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) 'Stop time, distance = '// */ -/* . TIMSTR, DIST */ -/* END DO */ - -/* END IF */ -/* END */ - - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Start time, distance = 2007-JAN-08 00:10:02.439 399999.999999989 */ -/* Stop time, distance = 2007-JAN-13 06:36:42.770 400000.000000010 */ -/* Start time, distance = 2007-FEB-04 07:01:30.094 399999.999999990 */ -/* Stop time, distance = 2007-FEB-10 09:29:56.659 399999.999999998 */ -/* Start time, distance = 2007-MAR-03 00:19:19.998 400000.000000006 */ -/* Stop time, distance = 2007-MAR-10 14:03:33.312 400000.000000007 */ -/* Start time, distance = 2007-MAR-29 22:52:52.961 399999.999999995 */ -/* Stop time, distance = 2007-APR-01 00:00:00.000 404531.955232216 */ - -/* Note that at the final solutions interval's stop time is not */ -/* close to the reference value of 400000 km. This is because the */ -/* interval's stop time was determined by the stop time of the */ -/* confinement window. */ - - - -/* 2) Extend the first example to demonstrate use of all supported */ -/* relational operators. Find times when */ - -/* Earth-Moon distance is = 400000 km */ -/* Earth-Moon distance is < 400000 km */ -/* Earth-Moon distance is > 400000 km */ -/* Earth-Moon distance is at a local minimum */ -/* Earth-Moon distance is at a absolute minimum */ -/* Earth-Moon distance is > the absolute minimum + 100 km */ -/* Earth-Moon distance is at a local maximum */ -/* Earth-Moon distance is at a absolute maximum */ -/* Earth-Moon distance is > the absolute maximum - 100 km */ - -/* To shorten the search time and output, use the */ -/* shorter search interval */ - -/* 2007 JAN 15 00:00:00 UTC to */ -/* 2007 MAR 15 00:00:00 UTC */ - -/* As before, use geometric (uncorrected) positions, so */ -/* set the aberration correction flag to 'NONE'. */ - -/* Use the meta-kernel from the first example. */ - - -/* Example code begins here. */ - - -/* PROGRAM EX2 */ -/* IMPLICIT NONE */ -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION VNORM */ -/* INTEGER WNCARD */ -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ -/* C */ -/* C Use the parameter MAXWIN for both */ -/* C the result window size and the workspace */ -/* C size. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 20000 ) */ -/* C */ -/* C Length of output time string: */ -/* C */ -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 26 ) */ - -/* C */ -/* C Number of relational operators: */ -/* C */ -/* INTEGER NRELOP */ -/* PARAMETER ( NRELOP = 9 ) */ - -/* C */ -/* C Operator name length: */ -/* C */ -/* INTEGER OPNMLN */ -/* PARAMETER ( OPNMLN = 6 ) */ - -/* C */ -/* C Output line length: */ -/* C */ -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(OPNMLN) RELATE ( NRELOP ) */ -/* CHARACTER*(LNSIZE) TEMPLT ( NRELOP ) */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(LNSIZE) TITLE */ - -/* DOUBLE PRECISION ADJUST ( NRELOP ) */ -/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */ -/* DOUBLE PRECISION DIST */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION FINISH */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 3 ) */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION START */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWDIST ) */ - -/* INTEGER I */ -/* INTEGER J */ - -/* C */ -/* C Saved variables */ -/* C */ -/* SAVE ADJUST */ -/* SAVE RELATE */ -/* SAVE TEMPLT */ - -/* C */ -/* C Initial values */ -/* C */ -/* DATA ADJUST / 0.D0, */ -/* . 0.D0, */ -/* . 0.D0, */ -/* . 0.D0, */ -/* . 0.D0, */ -/* . 100.D0, */ -/* . 0.D0, */ -/* . 0.D0, */ -/* . 100.D0 / */ - -/* DATA RELATE / '=', */ -/* . '<', */ -/* . '>', */ -/* . 'LOCMIN', */ -/* . 'ABSMIN', */ -/* . 'ABSMIN', */ -/* . 'LOCMAX', */ -/* . 'ABSMAX', */ -/* . 'ABSMAX' / */ - -/* DATA TEMPLT / */ -/* . 'Condition: distance = # km', */ -/* . 'Condition: distance < # km', */ -/* . 'Condition: distance > # km', */ -/* . 'Condition: distance is a local minimum', */ -/* . 'Condition: distance is the absolute minimum', */ -/* . 'Condition: distance < the absolute minimum + * km', */ -/* . 'Condition: distance is a local maximum', */ -/* . 'Condition: distance is the absolute maximum', */ -/* . 'Condition: distance > the absolute maximum - * km' / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 15', ET0 ) */ -/* CALL STR2ET ( '2007 MAR 15', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Search using a step size of 1 day (in units of */ -/* C seconds). Use a reference value of 400000 km. */ -/* C */ -/* STEP = SPD() */ -/* REFVAL = 4.D5 */ - -/* DO I = 1, NRELOP */ - -/* CALL GFDIST ( 'MOON', 'NONE', 'EARTH', RELATE(I), */ -/* . REFVAL, ADJUST(I), STEP, CNFINE, */ -/* . MAXWIN, NWDIST, WORK, RESULT ) */ -/* C */ -/* C Display the results. */ -/* C */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Substitute the reference and adjustment values, */ -/* C where applicable, into the title string: */ -/* C */ -/* CALL REPMD ( TEMPLT(I), '#', REFVAL, 6, TITLE ) */ -/* CALL REPMD ( TITLE, '*', ADJUST(I), 6, TITLE ) */ - -/* WRITE (*, '(A)' ) TITLE */ - -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ -/* WRITE (*, '(A)' ) ' Result window is empty.' */ -/* ELSE */ -/* WRITE (*, '(A)' ) ' Result window:' */ - -/* DO J = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch the endpoints of the Jth interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, J, START, FINISH ) */ -/* C */ -/* C Check the distance at the start and stop times. */ -/* C */ -/* CALL SPKPOS ( 'MOON', START, 'J2000', 'NONE', */ -/* . 'EARTH', POS, LT ) */ -/* DIST = VNORM(POS) */ - -/* CALL TIMOUT ( START, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) ' Start time, distance = ' */ -/* . // TIMSTR, DIST */ - -/* CALL SPKPOS ( 'MOON', FINISH, 'J2000', 'NONE', */ -/* . 'EARTH', POS, LT ) */ -/* DIST = VNORM(POS) */ - -/* CALL TIMOUT ( FINISH, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) ' Stop time, distance = ' */ -/* . // TIMSTR, DIST */ -/* END DO */ - -/* END IF */ - -/* END DO */ - -/* WRITE (*,*) ' ' */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Condition: distance = 4.00000E+05 km */ -/* Result window: */ -/* Start time, distance = 2007-FEB-04 07:01:30.094 399999.999999998 */ -/* Stop time, distance = 2007-FEB-04 07:01:30.094 399999.999999998 */ -/* Start time, distance = 2007-FEB-10 09:29:56.659 399999.999999989 */ -/* Stop time, distance = 2007-FEB-10 09:29:56.659 399999.999999989 */ -/* Start time, distance = 2007-MAR-03 00:19:19.998 399999.999999994 */ -/* Stop time, distance = 2007-MAR-03 00:19:19.998 399999.999999994 */ -/* Start time, distance = 2007-MAR-10 14:03:33.312 400000.000000000 */ -/* Stop time, distance = 2007-MAR-10 14:03:33.312 400000.000000000 */ - -/* Condition: distance < 4.00000E+05 km */ -/* Result window: */ -/* Start time, distance = 2007-JAN-15 00:00:00.000 393018.609906208 */ -/* Stop time, distance = 2007-FEB-04 07:01:30.094 399999.999999990 */ -/* Start time, distance = 2007-FEB-10 09:29:56.659 399999.999999998 */ -/* Stop time, distance = 2007-MAR-03 00:19:19.998 400000.000000006 */ -/* Start time, distance = 2007-MAR-10 14:03:33.312 400000.000000010 */ -/* Stop time, distance = 2007-MAR-15 00:00:00.000 376255.453934464 */ - -/* Condition: distance > 4.00000E+05 km */ -/* Result window: */ -/* Start time, distance = 2007-FEB-04 07:01:30.094 399999.999999990 */ -/* Stop time, distance = 2007-FEB-10 09:29:56.659 399999.999999998 */ -/* Start time, distance = 2007-MAR-03 00:19:19.998 400000.000000006 */ -/* Stop time, distance = 2007-MAR-10 14:03:33.312 400000.000000010 */ - -/* Condition: distance is a local minimum */ -/* Result window: */ -/* Start time, distance = 2007-JAN-22 12:30:49.458 366925.804109350 */ -/* Stop time, distance = 2007-JAN-22 12:30:49.458 366925.804109350 */ -/* Start time, distance = 2007-FEB-19 09:36:29.968 361435.646812061 */ -/* Stop time, distance = 2007-FEB-19 09:36:29.968 361435.646812061 */ - -/* Condition: distance is the absolute minimum */ -/* Result window: */ -/* Start time, distance = 2007-FEB-19 09:36:29.968 361435.646812061 */ -/* Stop time, distance = 2007-FEB-19 09:36:29.968 361435.646812061 */ - -/* Condition: distance < the absolute minimum + 1.00000E+02 km */ -/* Result window: */ -/* Start time, distance = 2007-FEB-19 01:09:52.706 361535.646812062 */ -/* Stop time, distance = 2007-FEB-19 18:07:45.136 361535.646812061 */ - -/* Condition: distance is a local maximum */ -/* Result window: */ -/* Start time, distance = 2007-FEB-07 12:38:29.870 404992.424288620 */ -/* Stop time, distance = 2007-FEB-07 12:38:29.870 404992.424288620 */ -/* Start time, distance = 2007-MAR-07 03:37:02.122 405853.452130754 */ -/* Stop time, distance = 2007-MAR-07 03:37:02.122 405853.452130754 */ - -/* Condition: distance is the absolute maximum */ -/* Result window: */ -/* Start time, distance = 2007-MAR-07 03:37:02.122 405853.452130754 */ -/* Stop time, distance = 2007-MAR-07 03:37:02.122 405853.452130754 */ - -/* Condition: distance > the absolute maximum - 1.00000E+02 km */ -/* Result window: */ -/* Start time, distance = 2007-MAR-06 15:56:00.957 405753.452130753 */ -/* Stop time, distance = 2007-MAR-07 15:00:38.674 405753.452130753 */ - - -/* $ Restrictions */ - -/* 1) The kernel files to be used by this routine must be loaded */ -/* (normally via the SPICELIB routine FURNSH) before this routine */ -/* is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-APR-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF distance search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* External functions */ - - -/* Interrupt indicator function: */ - - -/* Routines to set step size, refine transition times */ -/* and report work. */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Quantity definition parameter arrays: */ - - -/* Standard SPICE error handling. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - if (return_()) { - return 0; - } - chkin_("GFDIST", (ftnlen)6); - -/* Check the workspace window dimensions. */ - - if (*mw < 2) { - setmsg_("Workspace window size was #; size must be at least 2.", ( - ftnlen)53); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFDIST", (ftnlen)6); - return 0; - } - if (*nw < 5) { - setmsg_("Workspace window count was #; count must be at least #.", ( - ftnlen)55); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__5, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFDIST", (ftnlen)6); - return 0; - } - -/* Check the result window size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size was #; size must be at least 2.", (ftnlen) - 50); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFDIST", (ftnlen)6); - return 0; - } - -/* Set up a call to GFEVNT, which will handle the search. */ - - s_copy(qpnams, "TARGET", (ftnlen)80, (ftnlen)6); - s_copy(qcpars, target, (ftnlen)80, target_len); - s_copy(qpnams + 80, "OBSERVER", (ftnlen)80, (ftnlen)8); - s_copy(qcpars + 80, obsrvr, (ftnlen)80, obsrvr_len); - s_copy(qpnams + 160, "ABCORR", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 160, abcorr, (ftnlen)80, abcorr_len); - -/* Set the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFDIST", (ftnlen)6); - return 0; - } - gfsstp_(step); - -/* Initialize the RESULT window. */ - - scardd_(&c__0, result); - -/* Look for solutions. */ - -/* Progress report and bail-out options are set to .FALSE. */ - - gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "DISTANCE", &c__3, qpnams, qcpars, - qdpars, qipars, qlpars, relate, refval, &c_b27, adjust, cnfine, & - c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw, &c__5, - work, &c_false, (L_fp)gfbail_, result, (ftnlen)8, (ftnlen)80, ( - ftnlen)80, relate_len); - chkout_("GFDIST", (ftnlen)6); - return 0; -} /* gfdist_ */ - diff --git a/ext/spice/src/cspice/gfdist_c.c b/ext/spice/src/cspice/gfdist_c.c deleted file mode 100644 index 0c77417332..0000000000 --- a/ext/spice/src/cspice/gfdist_c.c +++ /dev/null @@ -1,1139 +0,0 @@ -/* - --Procedure gfdist_c ( GF, distance search ) - --Abstract - - Return the time window over which a specified constraint on - observer-target distance is met. - --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 - - GF - NAIF_IDS - SPK - TIME - WINDOWS - --Keywords - - EPHEMERIS - EVENT - GEOMETRY - SEARCH - WINDOW - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void gfdist_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) -/* - --Brief_I/O - - Variable I/O Description - --------------- --- ------------------------------------------------ - SPICE_GF_CNVTOL P Convergence tolerance - target I Name of the target body. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - relate I Relational operator. - refval I Reference value. - adjust I Adjustment value for absolute extrema searches. - step I Step size used for locating extrema and roots. - nintvls I Workspace window interval count. - cnfine I-O SPICE window to which the search is confined. - result O SPICE window containing results. - --Detailed_Input - - target is the name of a target body. Optionally, you may supply - a string containing the integer ID code for the object. - For example both "MOON" and "301" are legitimate strings - that indicate the Moon is the target body. - - The target and observer define a position vector which - points from the observer to the target; the length of - this vector is the "distance" that serves as the subject - of the search performed by this routine. - - Case and leading or trailing blanks are not significant - in the string `target'. - - - abcorr indicates the aberration corrections to be applied to - the observer-target position vector to account for - one-way light time and stellar aberration. - - Any aberration correction accepted by the SPICE - routine spkezr_c is accepted here. See the header - of spkezr_c for a detailed description of the - aberration correction options. For convenience, - the options are listed below: - - "NONE" Apply no correction. - - "LT" "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - "LT+S" "Reception" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - "CN" "Reception" case: converged - Newtonian light time correction. - - "CN+S" "Reception" case: converged - Newtonian light time and stellar - aberration corrections. - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - Case and leading or trailing blanks are not significant - in the string `abcorr'. - - - obsrvr is the name of the observing body. Optionally, you may - supply a string containing the integer ID code for the - object. For example both "MOON" and "301" are legitimate - strings that indicate the Moon is the observer. - - Case and leading or trailing blanks are not significant - in the string `obsrvr'. - - - relate is a relational operator used to define a constraint on - the observer-target distance. The result window found by - this routine indicates the time intervals where the - constraint is satisfied. Supported values of `relate' - and corresponding meanings are shown below: - - ">" Distance is greater than the reference - value `refval'. - - "=" Distance is equal to the reference - value `refval'. - - "<" Distance is less than the reference - value `refval'. - - "ABSMAX" Distance is at an absolute maximum. - - "ABSMIN" Distance is at an absolute minimum. - - "LOCMAX" Distance is at a local maximum. - - "LOCMIN" Distance is at a local minimum. - - `relate' may be used to specify an "adjusted" absolute - extremum constraint: this requires the distance - to be within a specified offset relative to an - absolute extremum. The argument `adjust' (described - below) is used to specify this offset. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - Case and leading or trailing blanks are not significant - in the string `relate'. - - - `refval' is the reference value used together with the argument - `relate' to define an equality or inequality to be - satisfied by the distance between the specified target - and observer. See the discussion of `relate' above for - further information. - - The units of `refval' are km. - - - adjust is a parameter used to modify searches for absolute - extrema: when `relate' is set to "ABSMAX" or "ABSMIN" - and `adjust' is set to a positive value, gfdist_c will - find times when the observer-target distance is within - `adjust' km of the specified extreme value. - - If `adjust' is non-zero and a search for an absolute - minimum `min' is performed, the result window contains - time intervals when the observer-target distance has - values between `min' and min+adjust. - - If the search is for an absolute maximum `max', the - corresponding range is from max-adjust to `max'. - - `adjust' is not used for searches for local extrema, - equality or inequality conditions. - - - step is the step size to be used in the search. `step' must - be shorter than any maximal time interval on which the - specified distance function is monotone increasing or - decreasing. That is, if the confinement window is - partitioned into alternating intervals on which the - distance function is either monotone increasing or - decreasing, `step' must be shorter than any of these - intervals. - - However, `step' must not be *too* short, or the search - will take an unreasonable amount of time. - - The choice of `step' affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - STEP has units of TDB seconds. - - - - nintvls is a parameter specifying the number of intervals that - can be accommodated by each of the dynamically allocated - workspace windows used internally by this routine. - - In many cases, it's not necessary to compute an accurate - estimate of how many intervals are needed; rather, the - user can pick a size considerably larger than what's - really required. - - However, since excessively large arrays can prevent - applications from compiling, linking, or running - properly, sometimes `nintvls' must be set according to - the actual workspace requirement. A rule of thumb for - the number of intervals needed is - - nintvls = 2*n + ( m / step ) - - where - - n is the number of intervals in the confinement - window - - m is the measure of the confinement window, in - units of seconds - - step is the search step size in seconds - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - The endpoints of the time intervals comprising `cnfine' - are interpreted as seconds past J2000 TDB. - - See the Examples section below for a code example that - shows how to create a confinement window. - - --Detailed_Output - - - cnfine is the input confinement window, updated if necessary so - the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is the window of intervals, contained within the - confinement window `cnfine', on which the specified - distance constraint is satisfied. - - The endpoints of the time intervals comprising `result' - are interpreted as seconds past J2000 TDB. - - If `result' is non-empty on input, its contents will be - discarded before gfdist_c conducts its search. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary - searches for roots should terminate: when a root is - bracketed within an interval of length SPICE_GF_CNVTOL, - the root is considered to have been found. - - The accuracy, as opposed to precision, of roots found by - this routine depends on the accuracy of the input data. - In most cases, the accuracy of solutions will be - inferior to their precision. - - SPICE_GF_CNVTOL is declared in the header file - SpiceGF.h. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If the aberration correction specifier contains an - unrecognized value, an error is signaled by a routine in the - call tree of this routine. - - 6) If `adjust' is negative, an error is signaled by a routine in - the call tree of this routine. - - 7) If either of the input body names do not map to NAIF ID - codes, an error is signaled by a routine in the call tree of - this routine. - - 8) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 9) If the workspace interval count is less than 1, the error - SPICE(VALUEOUTOFRANGE) will be signaled. - - 10) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - - 11) If the output SPICE window `result' has insufficient capacity to - contain the number of intervals on which the specified distance - condition is met, the error will be diagnosed by a routine in - the call tree of this routine. If the result window has size - less than 2, the error SPICE(INVALIDDIMENSION) will be signaled - by this routine. - - 12) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 13) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 14) If either input cell has type other than SpiceDouble, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - Appropriate SPICE kernels must be loaded by the calling program before - this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target and observer for the - time period defined by the confinement window must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - If non-inertial reference frames are used by the SPK files, - then PCK files, frame kernels, C-kernels, and SCLK kernels may - be needed. - - Kernel data are normally loaded once per program run, NOT every time - this routine is called. - --Particulars - - This routine determines a set of one or more time intervals - within the confinement window when the distance between the - specified target and observer satisfies a caller-specified - constraint. The resulting set of intervals is returned as a SPICE - window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - distance function is monotone increasing and monotone decreasing. - Each of these time periods is represented by a SPICE window. Having - found these windows, all of the distance function's local extrema - within the confinement window are known. Absolute extrema then can - be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. With these solutions - in hand, solutions of inequalities are easily found as well. - - - Step Size - ========= - - The monotone windows (described above) are found via a two-step - search process. Each interval of the confinement window is searched - as follows: first, the input step size is the time separation at - which the sign of the rate of change of distance ("range rate") is - sampled. Starting at the left endpoint of the interval, samples will - be taken at each step. If a change of sign is found, a root has been - bracketed; at that point, the time at which the range rate is zero - can be found by a refinement process, for example, via binary - search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the distance function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - As described above, the root-finding process used by this routine - involves first bracketing roots and then using a search process to - locate them. "Roots" include times when extrema are attained and - times when the distance function is equal to a reference value or - adjusted extremum. All endpoints of the intervals comprising the - result window are either endpoints of intervals of the confinement - window or roots. - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set via the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't limit the accuracy of solutions found by this - routine. In general the accuracy of input data will be the limiting - factor. - - To use a different tolerance value, a lower-level GF routine such - as gfevnt_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater affect on processing time than would the convergence - tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. See the "CASCADE" - example program in gf.req for a demonstration. - - --Examples - - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Find times during the first three months of the year 2007 - when the Earth-Moon distance is greater than 400000 km. - Display the start and stop times of the time intervals - over which this constraint is met, along with the Earth-Moon - distance at each interval endpoint. - - We expect the Earth-Moon distance to be an oscillatory function - with extrema roughly two weeks apart. Using a step size of one - day will guarantee that the GF system will find all distance - extrema. (Recall that a search for distance extrema is an - intermediate step in the GF search process.) - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File name: standard.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de421.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0009.tls Leapseconds - - - \begindata - - KERNELS_TO_LOAD = ( 'de421.bsp', - 'pck00008.tpc', - 'naif0009.tls' ) - - \begintext - - End of meta-kernel - - - Example code begins here. - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Constants - ./ - #define TIMFMT "YYYY MON DD HR:MN:SC.###" - #define MAXWIN 200 - #define NINTVL 100 - #define TIMLEN 41 - - /. - Local variables - ./ - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceDouble adjust; - SpiceDouble dist; - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble lt; - SpiceDouble pos [3]; - SpiceDouble refval; - SpiceDouble start; - SpiceDouble step; - SpiceDouble stop; - - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c ( "standard.tm" ); - - /. - Store the time bounds of our search interval in - the confinement window. - ./ - str2et_c ( "2007 JAN 1", &et0 ); - str2et_c ( "2007 APR 1", &et1 ); - - wninsd_c ( et0, et1, &cnfine ); - - /. - Search using a step size of 1 day (in units of - seconds). The reference value is 400000 km. - We're not using the adjustment feature, so - we set `adjust' to zero. - ./ - step = spd_c(); - refval = 4.e5; - adjust = 0.0; - - /. - Perform the search. The set of times when the - constraint is met will be stored in the SPICE - window `result'. - ./ - gfdist_c ( "MOON", "NONE", "EARTH", ">", refval, - adjust, step, NINTVL, &cnfine, &result ); - - /. - Display the results. - ./ - if ( wncard_c(&result) == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < wncard_c(&result); i++ ) - { - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result, i, &start, &stop ); - - /. - Check the distance at the interval's - start and stop times. - ./ - spkpos_c ( "MOON", start, "J2000", "NONE", - "EARTH", pos, < ); - - dist = vnorm_c(pos); - - timout_c ( start, TIMFMT, TIMLEN, begstr ); - - printf ( "Start time, distance = %s %17.9f\n", - begstr, dist ); - - spkpos_c ( "MOON", stop, "J2000", "NONE", - "EARTH", pos, < ); - - dist = vnorm_c(pos); - - timout_c ( stop, TIMFMT, TIMLEN, endstr ); - - printf ( "Stop time, distance = %s %17.9f\n", - endstr, dist ); - } - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Start time, distance = 2007 JAN 08 00:10:02.439 399999.999999989 - Stop time, distance = 2007 JAN 13 06:36:42.770 400000.000000010 - Start time, distance = 2007 FEB 04 07:01:30.094 399999.999999990 - Stop time, distance = 2007 FEB 10 09:29:56.659 399999.999999998 - Start time, distance = 2007 MAR 03 00:19:19.998 400000.000000006 - Stop time, distance = 2007 MAR 10 14:03:33.312 400000.000000007 - Start time, distance = 2007 MAR 29 22:52:52.961 399999.999999995 - Stop time, distance = 2007 APR 01 00:00:00.000 404531.955232216 - - Note that the distance at the final solutions interval's stop - time is not close to the reference value of 400000 km. This is - because the interval's stop time was determined by the stop time - of the confinement window. - - - 2) Extend the first example to demonstrate use of all supported - relational operators. Find times when - - Earth-Moon distance is = 400000 km - Earth-Moon distance is < 400000 km - Earth-Moon distance is > 400000 km - Earth-Moon distance is at a local minimum - Earth-Moon distance is at a absolute minimum - Earth-Moon distance is > the absolute minimum + 100 km - Earth-Moon distance is at a local maximum - Earth-Moon distance is at a absolute maximum - Earth-Moon distance is > the absolute maximum - 100 km - - To shorten the search time and output, use the - shorter search interval - - 2007 JAN 15 00:00:00 UTC to - 2007 MAR 15 00:00:00 UTC - - As before, use geometric (uncorrected) positions, so - set the aberration correction flag to 'NONE'. - - Use the meta-kernel from the first example. - - Example code begins here. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Constants - ./ - #define TIMFMT "YYYY MON DD HR:MN:SC.###" - #define LNSIZE 81 - #define MAXWIN 200 - #define NINTVL 100 - #define TIMLEN 41 - #define NRELOP 9 - - /. - Local variables - ./ - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - static ConstSpiceChar * relate [NRELOP] = - { - "=", - "<", - ">", - "LOCMIN", - "ABSMIN", - "ABSMIN", - "LOCMAX", - "ABSMAX", - "ABSMAX" - }; - - static ConstSpiceChar * templt [NRELOP] = - { - "Condition: distance = # km", - "Condition: distance < # km", - "Condition: distance > # km", - "Condition: distance is a local minimum", - "Condition: distance is the absolute minimum", - "Condition: distance < the absolute minimum + * km", - "Condition: distance is a local maximum", - "Condition: distance is the absolute maximum", - "Condition: distance > the absolute maximum - * km" - }; - - SpiceChar title [ LNSIZE ]; - - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - static SpiceDouble adjust [NRELOP] = - { - 0.0, - 0.0, - 0.0, - 0.0, - 0.0, - 100.0, - 0.0, - 0.0, - 100.0 - }; - - SpiceDouble dist; - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble lt; - SpiceDouble pos [3]; - SpiceDouble refval; - SpiceDouble start; - SpiceDouble step; - SpiceDouble stop; - - SpiceInt i; - SpiceInt j; - - /. - Load kernels. - ./ - furnsh_c ( "standard.tm" ); - - /. - Store the time bounds of our search interval in - the confinement window. - ./ - str2et_c ( "2007 JAN 15", &et0 ); - str2et_c ( "2007 MAR 15", &et1 ); - - wninsd_c ( et0, et1, &cnfine ); - - /. - Search using a step size of 1 day (in units of - seconds). Use a reference value of 400000 km. - ./ - refval = 400000.0; - step = spd_c(); - - for ( i = 0; i < NRELOP; i++ ) - { - gfdist_c ( "MOON", "NONE", "EARTH", relate[i], refval, - adjust[i], step, NINTVL, &cnfine, &result ); - - /. - Display the results. - ./ - printf ( "\n" ); - - /. - Substitute the reference and adjustment values, - where applicable, into the title string: - ./ - repmd_c ( templt[i], "#", refval, 6, LNSIZE, title ); - repmd_c ( title, "*", adjust[i], 6, LNSIZE, title ); - - printf ( "%s\n", title ); - - if ( wncard_c(&result) == 0 ) - { - printf ( " Result window is empty.\n" ); - } - else - { - printf ( " Result window:\n" ); - - for ( j = 0; j < wncard_c(&result); j++ ) - { - /. - Fetch the endpoints of the jth interval - of the result window. - ./ - wnfetd_c ( &result, j, &start, &stop ); - - /. - Check the distance at the interval's - start and stop times. - ./ - spkpos_c ( "MOON", start, "J2000", "NONE", - "EARTH", pos, < ); - - dist = vnorm_c(pos); - - timout_c ( start, TIMFMT, TIMLEN, begstr ); - - printf ( " Start time, distance = %s %17.9f\n", - begstr, dist ); - - spkpos_c ( "MOON", stop, "J2000", "NONE", - "EARTH", pos, < ); - - dist = vnorm_c(pos); - - timout_c ( stop, TIMFMT, TIMLEN, endstr ); - - printf ( " Stop time, distance = %s %17.9f\n", - endstr, dist ); - } - } - } - printf ( "\n" ); - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Condition: distance = 4.00000E+05 km - Result window: - Start time, distance = 2007 FEB 04 07:01:30.094 399999.999999998 - Stop time, distance = 2007 FEB 04 07:01:30.094 399999.999999998 - Start time, distance = 2007 FEB 10 09:29:56.659 399999.999999989 - Stop time, distance = 2007 FEB 10 09:29:56.659 399999.999999989 - Start time, distance = 2007 MAR 03 00:19:19.998 399999.999999994 - Stop time, distance = 2007 MAR 03 00:19:19.998 399999.999999994 - Start time, distance = 2007 MAR 10 14:03:33.312 400000.000000000 - Stop time, distance = 2007 MAR 10 14:03:33.312 400000.000000000 - - Condition: distance < 4.00000E+05 km - Result window: - Start time, distance = 2007 JAN 15 00:00:00.000 393018.609906208 - Stop time, distance = 2007 FEB 04 07:01:30.094 399999.999999990 - Start time, distance = 2007 FEB 10 09:29:56.659 399999.999999998 - Stop time, distance = 2007 MAR 03 00:19:19.998 400000.000000006 - Start time, distance = 2007 MAR 10 14:03:33.312 400000.000000010 - Stop time, distance = 2007 MAR 15 00:00:00.000 376255.453934464 - - Condition: distance > 4.00000E+05 km - Result window: - Start time, distance = 2007 FEB 04 07:01:30.094 399999.999999990 - Stop time, distance = 2007 FEB 10 09:29:56.659 399999.999999998 - Start time, distance = 2007 MAR 03 00:19:19.998 400000.000000006 - Stop time, distance = 2007 MAR 10 14:03:33.312 400000.000000010 - - Condition: distance is a local minimum - Result window: - Start time, distance = 2007 JAN 22 12:30:49.458 366925.804109350 - Stop time, distance = 2007 JAN 22 12:30:49.458 366925.804109350 - Start time, distance = 2007 FEB 19 09:36:29.968 361435.646812061 - Stop time, distance = 2007 FEB 19 09:36:29.968 361435.646812061 - - Condition: distance is the absolute minimum - Result window: - Start time, distance = 2007 FEB 19 09:36:29.968 361435.646812061 - Stop time, distance = 2007 FEB 19 09:36:29.968 361435.646812061 - - Condition: distance < the absolute minimum + 1.00000E+02 km - Result window: - Start time, distance = 2007 FEB 19 01:09:52.706 361535.646812062 - Stop time, distance = 2007 FEB 19 18:07:45.136 361535.646812061 - - Condition: distance is a local maximum - Result window: - Start time, distance = 2007 FEB 07 12:38:29.870 404992.424288620 - Stop time, distance = 2007 FEB 07 12:38:29.870 404992.424288620 - Start time, distance = 2007 MAR 07 03:37:02.122 405853.452130754 - Stop time, distance = 2007 MAR 07 03:37:02.122 405853.452130754 - - Condition: distance is the absolute maximum - Result window: - Start time, distance = 2007 MAR 07 03:37:02.122 405853.452130754 - Stop time, distance = 2007 MAR 07 03:37:02.122 405853.452130754 - - Condition: distance > the absolute maximum - 1.00000E+02 km - Result window: - Start time, distance = 2007 MAR 06 15:56:00.957 405753.452130753 - Stop time, distance = 2007 MAR 07 15:00:38.674 405753.452130753 - - --Restrictions - - 1) The kernel files to be used by this routine must be loaded - (normally via the CSPICE routine furnsh_c) before this routine - is called. - - 2) This routine has the side effect of re-initializing the - distance quantity utility package. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 15-APR-2009 (NJB) (EDW) - --Index_Entries - - GF distance search - --& -*/ - -{ /* Begin gfdist_c */ - - - /* - Static local variables - */ - static SpiceInt nw = SPICE_GF_NWDIST; - - /* - Local variables - */ - doublereal * work; - - SpiceInt nBytes; - SpiceInt worksz; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfdist_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfdist_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfdist_c", target ); - CHKFSTR ( CHK_STANDARD, "gfdist_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfdist_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "gfdist_c", relate ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfdist_c" ); - return; - } - - /* - Allocate the workspace. - - We have `nw' "doublereal" cells, each having cell size 2*nintvls. - Each cell also has a control area containing SPICE_CELL_CTRLSZ - double precision values. - */ - - worksz = nintvls * 2; - - nBytes = ( worksz + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) malloc ( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILURE)" ); - chkout_c ( "gfdist_c" ); - return; - } - - /* - Let the f2'd routine do the work. - */ - gfdist_ ( ( char * ) target, - ( char * ) abcorr, - ( char * ) obsrvr, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &worksz, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr), - ( ftnlen ) strlen(relate) ); - - /* - De-allocate the workspace. - */ - free ( work ); - - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - - chkout_c ( "gfdist_c" ); - -} /* End gfdist_c */ diff --git a/ext/spice/src/cspice/gfevnt.c b/ext/spice/src/cspice/gfevnt.c deleted file mode 100644 index 4d85ddb5a8..0000000000 --- a/ext/spice/src/cspice/gfevnt.c +++ /dev/null @@ -1,2414 +0,0 @@ -/* gfevnt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__7 = 7; -static integer c__10 = 10; - -/* $Procedure GFEVNT ( GF, Geometric event finder ) */ -/* Subroutine */ int gfevnt_(U_fp udstep, U_fp udrefn, char *gquant, integer * - qnpars, char *qpnams, char *qcpars, doublereal *qdpars, integer * - qipars, logical *qlpars, char *op, doublereal *refval, doublereal * - tol, doublereal *adjust, doublereal *cnfine, logical *rpt, U_fp - udrepi, U_fp udrepu, U_fp udrepf, integer *mw, integer *nw, - doublereal *work, logical *bail, L_fp udbail, doublereal *result, - ftnlen gquant_len, ftnlen qpnams_len, ftnlen qcpars_len, ftnlen - op_len) -{ - /* Initialized data */ - - static char dref[80] = " " - " "; - static logical first = TRUE_; - static char qnames[80*7] = "ANGULAR SEPARATION " - " " "DISTANCE " - " " "COORDI" - "NATE " - " " "RANGE RATE " - " " " " - " " " " - " " - " " " " - " "; - static char cnames[80*7] = "> " - " " "= " - " " "< " - " " - " " "ABSMAX " - " " "ABSMIN " - " " "LOCMAX " - " " - " " "LOCMIN " - " "; - static char qpars[80*10*7] = "TARGET1 " - " " "FRAME1 " - " " "SHAP" - "E1 " - " " "TARGET2 " - " " "FRAME2 " - " " "SHAPE2 " - " " - " " "OBSERVER " - " " "ABCORR " - " " " " - " " - " " - " " "TARGET " - " " "OBSERVER " - " " "ABCORR" - " " - " " " " - " " " " - " " " " - " " - " " " " - " " " " - " " " " - " " - " " - " " "TARGET " - " " "OBSERVER " - " " "ABCORR" - " " - " " "COORDINATE SYSTEM " - " " "COORDINATE " - " " "REFERENCE FRA" - "ME " - " " "VECTOR DEFINITION " - " " "METHOD " - " " "DVEC " - " " - "DREF " - " " "TARGET " - " " "OBSERVER " - " " "ABCORR" - " " - " " " " - " " " " - " " " " - " " - " " " " - " " " " - " " " " - " " - " " - " " "TARGET1 " - " " "TARGET2 " - " " "OBSERV" - "ER " - " " "ABCORR " - " " "REFERENCE FRAME " - " " " " - " " - " " " " - " " " " - " " " " - " " - " " - " " "TARGET " - " " "OBSERVER " - " " "ABCORR" - " " - " " "REFERENCE FRAME " - " " " " - " " " " - " " - " " " " - " " " " - " " " " - " " - " " - " " "TARGET " - " " "OBSERVER " - " " "ABCORR" - " " - " " "REFERENCE FRAME " - " " " " - " " " " - " " - " " " " - " " " " - " " " " - " " - " " - " "; - - /* System generated locals */ - integer work_dim1, work_offset, i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - doublereal dvec[3]; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - extern /* Subroutine */ int zzgfdidc_(); - extern /* Subroutine */ int zzgfdiin_(char *, char *, char *, doublereal * - , ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int zzgfdigq_(), zzgfspdc_(), zzgfrrdc_(), - zzgfdilt_(), zzgfgsep_(), zzgfdiur_(); - extern /* Subroutine */ int zzgfcslv_(char *, char *, char *, char *, - char *, char *, char *, doublereal *, char *, char *, char *, - doublereal *, doublereal *, doublereal *, U_fp, U_fp, logical *, - U_fp, U_fp, U_fp, logical *, L_fp, integer *, integer *, - doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), - zzgfspin_(char *, char *, char *, char *, doublereal *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), zzgfrrin_(char *, char *, - char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int zzgfrrgq_(), zzgfsplt_(), zzgfrrlt_(), - zzgfspur_(), zzgfrrur_(); - integer i__; - char frame[80*2]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char shape[80*2]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - char cpars[80*10]; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char quant[80]; - integer npass; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer qtnum; - char of[80*2]; - doublereal dt; - char vecdef[80]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - char abcorr[80], cornam[80], corsys[80], method[80], obsrvr[80], pnames[ - 80*10], rptpre[55*2]; - static char srcpre[55*2*7], srcsuf[13*2*7]; - char target[80]; - logical localx, noadjx; - char ref[80]; - integer loc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - char uop[6]; - extern /* Subroutine */ int zzgfrel_(U_fp, U_fp, U_fp, U_fp, U_fp, U_fp, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - integer *, integer *, doublereal *, logical *, U_fp, U_fp, U_fp, - char *, char *, logical *, L_fp, doublereal *, ftnlen, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Determine time intervals when a specified geometric quantity */ -/* satisfies a specified mathematical condition. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* EVENT */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UDSTEP I Name of the routine that computes and returns a */ -/* time step. */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* GQUANT I Type of geometric quantity. */ -/* QNPARS I Number of quantity definition parameters. */ -/* QPNAMS I Names of quantity definition parameters. */ -/* QCPARS I Array of character quantity definition parameters. */ -/* QDPARS I Array of double precision quantity definition */ -/* parameters. */ -/* QIPARS I Array of integer quantity definition parameters. */ -/* QLPARS I Array of logical quantity definition parameters. */ -/* OP I Operator that either looks for an extreme value */ -/* (max, min, local, absolute) or compares the */ -/* geometric quantity value and a number. */ -/* REFVAL I Reference value. */ -/* TOL I Convergence tolerance in seconds */ -/* ADJUST I Absolute extremum adjustment value. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* RPT I Progress reporter on (.TRUE.) or off (.FALSE.) */ -/* UDREPI I Function that initializes progress reporting. */ -/* UDREPU I Function that updates the progress report. */ -/* UDREPF I Function that finalizes progress reporting. */ -/* MW I Size of workspace windows. */ -/* NW I The number of workspace windows needed for the */ -/* search. */ -/* WORK I-O Array containing workspace windows. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* RESULT O SPICE window containing results. */ - - -/* $ Detailed_Input */ - -/* UDSTEP the name of the user specified routine that computes */ -/* a time step in an attempt to find a transition of the */ -/* state of the specified coordinate. In the context */ -/* of this routine's algorithm, a "state transition" */ -/* occurs where the geometric state changes from being */ -/* in the desired geometric condition event to not, */ -/* or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine */ - -/* GFSTEP */ - -/* may be used. This is the default option. If using */ -/* GFSTEP, the step size must be set by calling */ - -/* GFSSTP(STEP) */ - -/* prior to calling this routine. */ - -/* UDREFN the name of the user specified routine that computes */ -/* a refinement in the times that bracket a transition */ -/* point. In other words, once a pair of times have been */ -/* detected such that the system is in different states at */ -/* each of the two times, UDREFN selects an intermediate */ -/* time which should be closer to the transition state */ -/* than one of the two known times. */ - -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 is a time when the system is in state S1. T1 */ -/* is expressed as seconds past J2000 TDB. */ - -/* T2 is a time when the system is in state S2. T2 */ -/* is expressed as seconds past J2000 TDB. T2 */ -/* is assumed to be larger than T1. */ - -/* S1 is the state of the system at time T1. */ -/* S1 is a LOGICAL value. */ - -/* S2 is the state of the system at time T2. */ -/* S2 is a LOGICAL value. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T is next time to check for a state transition. */ -/* T has value between T1 and T2. T is */ -/* expressed as seconds past J2000 TDB. */ - -/* If a simple bisection method is desired, the routine */ - -/* GFREFN */ - -/* may be used. This is the default option. */ - -/* GQUANT is a string containing the name of a geometric */ -/* quantity. The times when this quantity satisfies */ -/* a condition specified by the arguments OP */ -/* and ADJUST (described below) are to be found. */ - -/* Each quantity is specified by the quantity name */ -/* given in argument GQUANT, and by a set of parameters */ -/* specified by the arguments */ - -/* QNPARS */ -/* QPNAMS */ -/* QCPARS */ -/* QDPARS */ -/* QIPARS */ -/* QLPARS */ - -/* For each quantity listed here, we also show how to */ -/* set up the input arguments to define the quantity. */ -/* See the detailed discussion of these arguments */ -/* below for further information. */ - -/* GQUANT may be any of the strings: */ - -/* 'COORDINATE' */ -/* 'DISTANCE' */ -/* 'ANGULAR SEPARATION' */ -/* 'RANGE RATE' */ - -/* GQUANT strings are case insensitive. Values, */ -/* meanings, and associated parameters are discussed */ -/* below. */ - -/* COORDINATE */ - -/* is a coordinate of a specified vector in a specified */ -/* reference frame and coordinate system. For example, */ -/* a coordinate can be the Z component of the earth-sun */ -/* vector in the J2000 reference frame, or the latitude */ -/* of the nearest point on Mars to an orbiting */ -/* spacecraft, expressed relative to the IAU_MARS */ -/* reference frame. */ - -/* The method by which the vector is defined is */ -/* indicated by the */ - -/* 'VECTOR DEFINITION' */ - -/* parameter. Allowed values and meanings of this */ -/* parameter are: */ - -/* 'POSITION' */ - -/* The vector is defined by the */ -/* position of a target relative to */ -/* an observer. */ - -/* 'SUB-OBSERVER POINT' */ - -/* The vector is the sub-observer point */ -/* on a specified target body. */ - -/* 'SURFACE INTERCEPT POINT' */ - -/* The vector is defined as the */ -/* intercept point of a vector from the */ -/* observer to the target body. */ - -/* Some vector definitions such as the sub-observer */ -/* point may be specified by a variety of methods, so */ -/* a parameter is provided to select the computation */ -/* method. The computation method parameter name is */ - -/* 'METHOD' */ - -/* If the vector definition is */ - -/* 'POSITION' */ - -/* the METHOD parameter must be set to blank: */ - -/* ' ' */ - -/* If the vector definition is */ - -/* 'SUB-OBSERVER POINT' */ - -/* the METHOD parameter must be set to either: */ - -/* 'Near point: ellipsoid' */ -/* 'Intercept: ellipsoid' */ - -/* If the vector definition is */ - -/* 'SURFACE INTERCEPT POINT' */ - -/* the METHOD parameter must be set to: */ - -/* 'Ellipsoid' */ - -/* The intercept computation uses */ -/* a triaxial ellipsoid to model */ -/* the surface of the target body. */ -/* The ellipsoid's radii must be */ -/* available in the kernel pool. */ - -/* The supported coordinate systems and coordinate */ -/* names: */ - -/* Coordinate System Coordinates Range */ - -/* 'RECTANGULAR' 'X' */ -/* 'Y' */ -/* 'Z' */ - -/* 'LATITUDINAL' 'RADIUS' */ -/* 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ - -/* 'RA/DEC' 'RANGE' */ -/* 'RIGHT ASCENSION' [0,2Pi) */ -/* 'DECLINATION' [-Pi/2,Pi/2] */ - -/* 'SPHERICAL' 'RADIUS' */ -/* 'COLATITUDE' [0,Pi] */ -/* 'LONGITUDE' (-Pi,Pi] */ - -/* 'CYLINDRICAL' 'RADIUS' */ -/* 'LONGITUDE' [0,2Pi) */ -/* 'Z' */ - -/* 'GEODETIC' 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* When geodetic coordinates are selected, the radii */ -/* used are those of the central body associated with */ -/* the reference frame. For example, if IAU_MARS is the */ -/* reference frame, then geodetic coordinates are */ -/* calculated using the radii of Mars taken from a */ -/* SPICE planetary constants kernel. One cannot ask for */ -/* geodetic coordinates for a frame which doesn't have */ -/* an extended body as its center. */ - -/* Reference frame names must be recognized by the */ -/* SPICE frame subsystem. */ - -/* Quantity Parameters: */ - -/* QNPARS = 10 */ -/* QPNAMS(1) = 'TARGET' */ -/* QPNAMS(2) = 'OBSERVER' */ -/* QPNAMS(3) = 'ABCORR' */ -/* QPNAMS(4) = 'COORDINATE SYSTEM' */ -/* QPNAMS(5) = 'COORDINATE' */ -/* QPNAMS(6) = 'REFERENCE FRAME' */ -/* QPNAMS(7) = 'VECTOR DEFINITION' */ -/* QPNAMS(8) = 'METHOD' */ -/* QPNAMS(9) = 'DREF' */ -/* QPNAMS(10) = 'DVEC' */ - -/* Only 'SUB-OBSERVER POINT' searches make */ -/* use of the DREF and DVEC parameters. */ - -/* QCPARS(1) = */ -/* QCPARS(2) = */ -/* QCPARS(3) = */ -/* QCPARS(4) = */ -/* QCPARS(5) = */ -/* QCPARS(6) = */ -/* QCPARS(7) = */ -/* QCPARS(8) = */ -/* QCPARS(9) = */ - -/* QDPARS(1) = */ -/* QDPARS(2) = */ -/* QDPARS(3) = */ - -/* DISTANCE */ - -/* is the apparent distance between a target body and */ -/* an observing body. Distances are always measured */ -/* between centers of mass. */ - -/* Quantity Parameters: */ - -/* QNPARS = 3 */ -/* QPNAMS(1) = 'TARGET' */ -/* QPNAMS(2) = 'OBSERVER' */ -/* QPNAMS(3) = 'ABCORR' */ - -/* QCPARS(1) = */ -/* QCPARS(2) = */ -/* QCPARS(3) = */ - -/* ANGULAR SEPARATION */ - -/* is the apparent angular separation of two target */ -/* bodies as seen from an observing body. */ - -/* Quantity Parameters: */ - -/* QNPARS = 8 */ -/* QPNAMS(1) = 'TARGET1' */ -/* QPNAMS(2) = 'FRAME1' */ -/* QPNAMS(3) = 'SHAPE1' */ -/* QPNAMS(4) = 'TARGET2' */ -/* QPNAMS(5) = 'FRAME2' */ -/* QPNAMS(6) = 'SHAPE2' */ -/* QPNAMS(7) = 'OBSERVER' */ -/* QPNAMS(8) = 'ABCORR' */ - -/* QCPARS(1) = */ -/* QCPARS(2) = */ -/* QCPARS(3) = */ -/* QCPARS(4) = */ -/* QCPARS(5) = */ -/* QCPARS(6) = */ -/* QCPARS(7) = */ -/* QCPARS(8) = */ - -/* The target shape model specifiers may be set to */ -/* either of the values */ - -/* 'POINT' */ -/* 'SPHERE' */ - -/* The shape models for the two bodies need not match. */ - -/* Spherical models have radii equal to the longest */ -/* equatorial radius of the PCK-based tri-axial */ -/* ellipsoids used to model the respective bodies. */ -/* When both target bodies are modeled as spheres, the */ -/* angular separation between the bodies is the angle */ -/* between the closest points on the limbs of the */ -/* spheres, as viewed from the vantage point of the */ -/* observer. If the limbs overlap, the angular */ -/* separation is negative. */ - -/* (In this case, the angular separation is the angle */ -/* between the centers of the spheres minus the sum of */ -/* the apparent angular radii of the spheres.) */ - -/* RANGE RATE */ - -/* is the apparent range rate between a target body */ -/* and an observing body. */ - -/* QNPARS = 3 */ -/* QPNAMS(1) = 'TARGET' */ -/* QPNAMS(2) = 'OBSERVER' */ -/* QPNAMS(3) = 'ABCORR' */ - -/* QCPARS(1) = */ -/* QCPARS(2) = */ -/* QCPARS(3) = */ - -/* The aberration correction parameter indicates the */ -/* aberration corrections to be applied to the state of */ -/* the target body to account for one-way light time and */ -/* stellar aberration. If relevant, it applies to the */ -/* rotation of the target body as well. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only. */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. */ - -/* Case, leading and trailing blanks are not significant */ -/* in aberration correction parameter strings. */ - -/* QNPARS is the count of quantity parameter definition */ -/* parameters. These parameters supply the quantity- */ -/* specific information needed to fully define the */ -/* quantity used in the search performed by this routine. */ - -/* QPNAMS is an array of names of quantity definition parameters. */ -/* The names occupy elements 1:QNPARS of this array. */ -/* The value associated with the Ith element of QPNAMS */ -/* is located in element I of the parameter value argument */ -/* having data type appropriate for the parameter: */ - -/* Data Type Argument */ -/* --------- -------- */ -/* Character strings QCPARS */ -/* Double precision numbers QDPARS */ -/* Integers QIPARS */ -/* Logicals QLPARS */ - -/* The order in which the parameter names are listed */ -/* is unimportant, as long as the corresponding */ -/* parameter values are listed in the same order. */ - -/* The names in QPNAMS are case-insensitive. */ - -/* See the description of the input argument GQUANT */ -/* for a discussion of the parameter names and values */ -/* associated with a given quantity. */ - -/* QCPARS, */ -/* QDPARS, */ -/* QIPARS, */ -/* QLPARS are, respectively, parameter value arrays of types */ - -/* CHARACTER*(*) QCPARS */ -/* DOUBLE PRECISION QDPARS */ -/* INTEGER QIPARS */ -/* LOGICAL QLPARS */ - -/* The value associated with the Ith name in the array */ -/* QPNAMS resides in the Ith element of whichever of */ -/* these arrays has the appropriate data type. */ - -/* All of these arrays should be declared with dimension */ -/* at least QNPARS. */ - -/* The names in the array QCPARS are case-insensitive. */ - -/* Note that there is no required order for QPNAMS/Q*PARS */ -/* pairs. */ - -/* See the description of the input argument GQUANT */ -/* for a discussion of the parameter names and values */ -/* associated with a given quantity. */ - -/* OP is a scalar string comparison operator indicating */ -/* the numeric constraint of interest. Values are: */ - -/* '>' value of geometric quantity greater than some */ -/* reference (REFVAL). */ - -/* '=' value of geometric quantity equal to some */ -/* reference (REFVAL). */ - -/* '<' value of geometric quantity less than some */ -/* reference (REFVAL). */ - -/* 'ABSMAX' The geometric quantity is at an absolute */ -/* maximum. */ - -/* 'ABSMIN' The geometric quantity is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' The geometric quantity is at a local */ -/* maximum. */ - -/* 'LOCMIN' The geometric quantity is at a local */ -/* minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified distance of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specified this distance. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* Case is not significant in the string OP. */ - -/* REFVAL is the reference value used to define an equality or */ -/* inequality to be satisfied by the geometric quantity. */ -/* The units of REFVAL are radians, radians/sec, km, or */ -/* km/sec as appropriate. */ - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in ephemeris */ -/* seconds and must be greater than zero. */ - -/* ADJUST the amount by which the quantity is allowed to vary */ -/* from an absolute extremum. */ - -/* If the search is for an absolute minimum is performed, */ -/* the resulting window contains time intervals when the */ -/* geometric quantity 'gquant' has values between */ -/* ABSMIN and ABSMIN + 'adjust'. */ - -/* If the search is for an absolute maximum, the */ -/* corresponding range is between ABSMAX - 'adjust' and */ -/* ABSMAX. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions and must have value */ -/* zero for such searches. ADJUST must not be */ -/* negative. */ - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is enabled. When RPT is TRUE, */ -/* progress reporting is enabled and the routines */ -/* UDREPI, UDREPU, and UDREPF (see descriptions below) */ -/* are used to report progress. */ - -/* UDREPI the name of the user specified routine that initializes */ -/* a progress report. When progress reporting is */ -/* enabled, UDREPI is called at the start */ -/* of a search. The calling sequence of UDREPI is */ - -/* UDREPI ( CNFINE, SRCPRE, SRCSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) SRCPRE */ -/* CHARACTER*(*) SRCSUF */ - -/* where */ - -/* CNFINE */ - -/* is a confinement window specifying the time period */ -/* over which a search is conducted, and */ - -/* SRCPRE */ -/* SRCSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. For */ -/* example, when the progress reporting functions */ -/* are used, if SRCPRE and SRCSUF are, respectively, */ - -/* 'Occultation/transit search' */ -/* 'done.' */ - -/* the progress report display at the end of */ -/* the search will be: */ - -/* Occultation/transit search 100.00% done. */ - -/* If the user doesn't wish to provide a custom set of */ -/* progress reporting functions, the routine */ - -/* GFREPI */ - -/* may be used. */ - -/* UDREPU the name of the user specified routine that updates */ -/* the progress report for a search. The calling sequence */ -/* of UDREPU is */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the searches */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - -/* If the user doesn't wish to provide a custom set of */ -/* progress reporting functions, the routine */ - -/* GFREPU */ - -/* may be used. */ - -/* UDREPF the name of the user specified routine that finalizes */ -/* a progress report. UDREPF has no arguments. */ - -/* If the user doesn't wish to provide a custom set of */ -/* progress reporting functions, the routine */ - -/* GFREPF */ - -/* may be used. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NW ) */ - -/* WORK need not be initialized by the caller. */ - -/* BAIL is a logical indicating whether or not interrupt */ -/* signaling is enabled. When `bail' is set to TRUE, */ -/* the input function UDBAIL (see description below) */ -/* is used to determine whether an interrupt has been */ -/* issued. */ - -/* UDBAIL the name of the user specified routine that */ -/* indicates whether an interrupt signal has been */ -/* issued (for example, from the keyboard). UDBAIL */ -/* has no arguments and returns a LOGICAL value. */ -/* The return value is .TRUE. if an interrupt has */ -/* been issued; otherwise the value is .FALSE. */ - -/* GFEVNT uses UDBAIL only when BAIL (see above) is set */ -/* to .TRUE., indicating that interrupt handling is */ -/* enabled. When interrupt handling is enabled, GFEVNT */ -/* and routines in its call tree will call UDBAIL to */ -/* determine whether to terminate processing and return */ -/* immediately. */ - -/* If interrupt handing is not enabled, a logical */ -/* function must still be passed as an input argument. */ -/* The function */ - -/* GFBAIL */ - -/* may be used for this purpose. */ - -/* $ Detailed_Output */ - -/* WORK has undefined contents on output. */ - -/* RESULT is a SPICE window representing the set of time */ -/* intervals, within the confinement period, when the */ -/* specified geometric event occurs. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFEVNT conducts its */ -/* search. */ - -/* RESULT must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* $ Exceptions */ - -/* 1) There are varying requirements on how distinct the three */ -/* objects, QCPARS, must be. If the requirements are not met, */ -/* the error, SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* When GQUANT has value 'ANGULAR SEPARATION' then all three */ -/* must be distinct. */ - -/* When GQUANT has value of either */ - -/* 'DISTANCE' */ -/* 'COORDINATE' */ -/* 'RANGE RATE' */ - -/* the QCPARS(1) and QCPARS(2) objects must be distinct. */ - -/* 2) If any of the bodies involved do not have NAIF ID codes, the */ -/* error SPICE(IDCODENOTFOUND) will be signaled. */ - -/* 3) If the value of GQUANT is not recognized as a valid value, */ -/* the error SPICE(NOTRECOGNIZED) will be signaled. */ - -/* 4) If the number of quantity definition parameters, QNPARS is */ -/* greater than the maximum allowed value, MAXPAR, the error */ -/* SPICE(INVALIDCOUNT) will be signaled. */ - -/* 5) If the proper required parameters, QPARS, are not supplied, */ -/* the error SPICE(MISSINGVALUE) will be signaled. */ - -/* 6) If the comparison operator, OP, is not recognized, the error */ -/* SPICE(NOTRECOGNIZED) is signaled. */ - -/* 7) If the sizes of the workspace windows are too small, */ -/* the error SPICE(ARRAYTOOSMALL) is signaled by routines */ -/* called by this routine. */ - -/* 8) If TOL is not greater than zero, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled by routines called by */ -/* this routine. */ - -/* 9) If ADJUST is negative, the error SPICE(VALUEOUTOFRANGE) will */ -/* signal from a routine in the call tree of this routine. */ - -/* A non-zero value for ADJUST when OP has any value other than */ -/* "ABSMIN" or "ABSMAX" causes the error SPICE(INVALIDVALUE) to */ -/* signal from a routine in the call tree of this routine. */ - -/* 10) The user must take care when searching for an extremum */ -/* (ABSMAX, ABSMIN, LOCMAX, LOCMIN) of an angular quantity. */ -/* Problems are most common when using the COORDINATE value of */ -/* GQUANT with LONGITUDE or RIGHT ASCENSION values for the */ -/* coordinate name. Since these quantities are cyclical, rather */ -/* than monotonically increasing or decreasing, an extremum may */ -/* be hard to interpret. In particular, if an extremum is found */ -/* near the cycle boundary (- PI for longitude, 2 PI for */ -/* RIGHT ASCENSION) it may not be numerically reasonable. For */ -/* example, the search for times when a longitude coordinate is */ -/* at its absolute maximum may result in a time when the */ -/* longitude value is - PI, due to roundoff error. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the */ -/* calling program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target, source and observer that */ -/* describes the ephemeris of these objects for the period */ -/* defined by the confinement window, CNFINE must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: bodies are assumed to be spherical and must have a */ -/* radius loaded from the kernel pool. Typically this is done by */ -/* loading a text PCK file via FURNSH. If the bodies are */ -/* triaxial, the largest radius is chosen as that of the */ -/* equivalent spherical body. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides the SPICE GF subsystem's general interface */ -/* to determines time intervals when the value of some */ -/* geometric quantity related to one or more objects and an observer */ -/* satisfies a user specified constraint. It puts these times in a */ -/* result window called RESULT. It does this by first finding */ -/* windows when the quantity of interest is either monotonically */ -/* increasing or decreasing. These windows are then manipulated to */ -/* give the final result. */ - -/* Applications that require do not require support for progress */ -/* reporting, interrupt handling, non-default step or refinement */ -/* functions, or non-default convergence tolerance normally should */ -/* call GFSEP, GFDIST, GFPOSC, GFSUBC, GFRR, or GFSNTC rather than */ -/* this routine. */ - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* geometric quantity function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the quantity */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of quantity function will be sampled. Starting at */ -/* the left endpoint of an interval, samples will be taken at each */ -/* step. If a change of sign is found, a root has been bracketed; at */ -/* that point, the time at which the time derivative of the quantity */ -/* function is zero can be found by a refinement process, for */ -/* example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the quantity function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the targets and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance," passed to this routine as 'tol'. */ - -/* The GF subsystem defines a parameter, CNVTOL (from gf.inc), as a */ -/* default tolerance. This represents a "tight" tolerance value */ -/* so that the tolerance doesn't become the limiting factor in the */ -/* accuracy of solutions found by this routine. In general the */ -/* accuracy of input data will be the limiting factor. */ - -/* Making the tolerance tighter than CNVTOL is unlikely to */ -/* be useful, since the results are unlikely to be more accurate. */ -/* Making the tolerance looser will speed up searches somewhat, */ -/* since a few convergence steps will be omitted. However, in most */ -/* cases, the step size is likely to have a much greater affect */ -/* on processing time than would the convergence tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* Conduct a DISTANCE search using the default GF progress reporting */ -/* capability. */ - -/* The program will use console I/O to display a simple */ -/* ASCII-based progress report. */ - -/* The program will find local maximums of the distance from earth to */ -/* Moon with light time and stellar aberration corrections to model */ -/* the apparent positions of the Moon. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* File name: standard.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de414.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0009.tls' ) */ - -/* \begintext */ - -/* Code: */ - -/* PROGRAM GFEVNT_EX */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* INTEGER WNCARD */ - -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C Local variables and initial parameters. */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* INTEGER MAXPAR */ -/* PARAMETER ( MAXPAR = 8 ) */ - -/* INTEGER MAXVAL */ -/* PARAMETER ( MAXVAL = 20000 ) */ - - -/* INTEGER STRSIZ */ -/* PARAMETER ( STRSIZ = 40 ) */ - -/* INTEGER I */ - -/* C */ -/* C Confining window */ -/* C */ -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXVAL ) */ - -/* C */ -/* C Confining window beginning and ending time strings. */ -/* C */ -/* CHARACTER*(STRSIZ) BEGSTR */ -/* CHARACTER*(STRSIZ) ENDSTR */ - -/* C */ -/* C Confining window beginning and ending times */ -/* C */ -/* DOUBLE PRECISION BEGTIM */ -/* DOUBLE PRECISION ENDTIM */ - -/* C */ -/* C Result window beginning and ending times for intervals. */ -/* C */ -/* DOUBLE PRECISION BEG */ -/* DOUBLE PRECISION END */ - -/* C */ -/* C Geometric quantity results window, work window, */ -/* C bail switch and progress reporter switch. */ -/* C */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXVAL ) */ -/* DOUBLE PRECISION WORK ( LBCELL : MAXVAL, NWDIST ) */ - -/* LOGICAL BAIL */ -/* LOGICAL GFBAIL */ -/* EXTERNAL GFBAIL */ -/* LOGICAL RPT */ - -/* C */ -/* C Step size. */ -/* C */ -/* DOUBLE PRECISION STEP */ - -/* C */ -/* C Geometric quantity name. */ -/* C */ -/* CHARACTER*(LNSIZE) EVENT */ - -/* C */ -/* C Relational string */ -/* C */ -/* CHARACTER*(STRSIZ) RELATE */ - -/* C */ -/* C Quantity definition parameter arrays: */ -/* C */ -/* INTEGER QNPARS */ -/* CHARACTER*(LNSIZE) QPNAMS ( MAXPAR ) */ -/* CHARACTER*(LNSIZE) QCPARS ( MAXPAR ) */ -/* DOUBLE PRECISION QDPARS ( MAXPAR ) */ -/* INTEGER QIPARS ( MAXPAR ) */ -/* LOGICAL QLPARS ( MAXPAR ) */ - -/* C */ -/* C Routines to set step size, refine transition times */ -/* C and report work. */ -/* C */ -/* EXTERNAL GFREFN */ -/* EXTERNAL GFREPI */ -/* EXTERNAL GFREPU */ -/* EXTERNAL GFREPF */ -/* EXTERNAL GFSTEP */ - - -/* C */ -/* C Reference and adjustment values. */ -/* C */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION ADJUST */ - -/* INTEGER COUNT */ - - -/* C Load leapsecond and spk kernels. The name of the */ -/* C meta kernel file shown here is fictitious; you */ -/* C must supply the name of a file available */ -/* C on your own computer system. */ - -/* CALL FURNSH ('standard.tm') */ - - -/* C */ -/* C Set a beginning and end time for confining window. */ -/* C */ -/* BEGSTR = '2001 jan 01 00:00:00.000' */ -/* ENDSTR = '2001 dec 31 00:00:00.000' */ - -/* CALL STR2ET ( BEGSTR, BEGTIM ) */ -/* CALL STR2ET ( ENDSTR, ENDTIM ) */ - -/* C */ -/* C Set condition for extremum. */ -/* C */ -/* RELATE = 'LOCMAX' */ - -/* C */ -/* C Set reference value (if needed) and absolute extremum */ -/* C adjustment (if needed). */ -/* C */ -/* REFVAL = 0.D0 */ -/* ADJUST = 0.D0 */ - -/* C */ -/* C Set quantity. */ -/* C */ -/* EVENT = 'DISTANCE' */ - -/* C */ -/* C Turn on progress reporter and initialize the windows. */ -/* C */ -/* RPT = .TRUE. */ -/* BAIL = .FALSE. */ - -/* CALL SSIZED ( MAXVAL, CNFINE ) */ -/* CALL SSIZED ( MAXVAL, RESULT ) */ - -/* C */ -/* C Add 2 points to the confinement interval window. */ -/* C */ -/* CALL WNINSD ( BEGTIM, ENDTIM, CNFINE ) */ - -/* C */ -/* C Define input quantities. */ -/* C */ -/* QPNAMS(1) = 'TARGET' */ -/* QCPARS(1) = 'MOON' */ - -/* QPNAMS(2) = 'OBSERVER' */ -/* QCPARS(2) = 'EARTH' */ - -/* QPNAMS(3) = 'ABCORR' */ -/* QCPARS(3) = 'LT+S' */ - -/* QNPARS =3 */ - -/* C */ -/* C Set the step size to 1 day and convert to seconds. */ -/* C */ -/* STEP = 1.D-3*SPD() */ - -/* CALL GFSSTP ( STEP ) */ - -/* C */ -/* C Look for solutions. */ -/* C */ -/* CALL GFEVNT ( GFSTEP, GFREFN, EVENT, */ -/* . QNPARS, QPNAMS, QCPARS, */ -/* . QDPARS, QIPARS, QLPARS, */ -/* . RELATE, REFVAL, CNVTOL, */ -/* . ADJUST, CNFINE, RPT, */ -/* . GFREPI, GFREPU, GFREPF, */ -/* . MAXVAL, NWDIST, WORK, */ -/* . BAIL, GFBAIL, RESULT ) */ - - -/* C */ -/* C Check the number of intervals in the result window. */ -/* C */ -/* COUNT = WNCARD(RESULT) */ - -/* WRITE (*,*) 'Found ', COUNT, ' intervals in RESULT' */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C List the beginning and ending points in each interval. */ -/* C */ -/* DO I = 1, COUNT */ - -/* CALL WNFETD ( RESULT, I, BEG, END ) */ - -/* CALL TIMOUT ( BEG, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', BEGSTR ) */ -/* CALL TIMOUT ( END, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', ENDSTR ) */ - -/* WRITE (*,*) 'Interval ', I */ -/* WRITE (*,*) 'Beginning TDB ', BEGSTR */ -/* WRITE (*,*) 'Ending TDB ', ENDSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - -/* The program compiled on OS X with g77: */ - -/* The run output; the progress report had the format shown below: */ - -/* Distance pass 1 of 2 50.62% done. */ - -/* Found 13 intervals in RESULT */ - -/* Interval 1 */ -/* Beginning TDB 2001-JAN-24 19:22:01.436672 (TDB) */ -/* Ending TDB 2001-JAN-24 19:22:01.436672 (TDB) */ - -/* Interval 2 */ -/* Beginning TDB 2001-FEB-20 21:52:07.914964 (TDB) */ -/* Ending TDB 2001-FEB-20 21:52:07.914964 (TDB) */ -/* Interval 3 */ - -/* ... */ - -/* Interval 12 */ -/* Beginning TDB 2001-NOV-23 15:45:23.027511 (TDB) */ -/* Ending TDB 2001-NOV-23 15:45:23.027511 (TDB) */ - -/* Interval 13 */ -/* Beginning TDB 2001-DEC-21 13:04:47.124241 (TDB) */ -/* Ending TDB 2001-DEC-21 13:04:47.124241 (TDB) */ - -/* $ Restrictions */ - -/* 1) The kernel files to be used by GFEVNT must be loaded (normally */ -/* via the SPICELIB routine FURNSH) before GFEVNT is called. */ - -/* 2) If using the default, constant step size routine, GFSTEP, the */ -/* entry point GFSSTP must be called prior to calling this */ -/* routine. The call syntax for GFSSTP: */ - -/* CALL GFSSTP ( STEP ) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-OCT-2009 (NJB) (EDW) */ - -/* Edits to argument descriptions. */ - -/* Added geometric quantities: */ - -/* Range Rate */ - -/* - SPICELIB Version 1.0.0, 19-MAR-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF low-level geometric condition solver */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Angular separation routines. */ - - -/* Distance routines. */ - - -/* Range rate routines. */ - - -/* Quantity codes: */ - - -/* Number of supported quantities: */ - - -/* Number of supported comparison operators: */ - - -/* Assorted string lengths: */ - -/* BDNMLN is the maximum length of a body name. */ - - -/* NAMLEN is the maximum length of both a frame name and of */ -/* any kernel pool variable name. */ - - -/* ABCLEN is the maximum length of any aberration correction */ -/* specification string. Room for expansion is included. */ - - -/* MAXPAR is the maximum number of parameters required to define */ -/* any quantity. MAXPAR may grow if new quantities require */ -/* more parameters. */ - - -/* MAXOP is the maximum string length for comparison operators. */ -/* MAXOP may grow if new comparisons are added. */ - - -/* MAXCLN is the maximum character string length of the quantity */ -/* parameter names and character quantity parameters. */ - - -/* NAIF ID code for the sun: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Below we initialize the list of quantity names. Restrict this list */ -/* to those events supported with test families. */ - - -/* Below we initialize the list of comparison operator names. */ - - -/* Below we initialize the list of quantity parameter names. */ -/* Each quantity has its own list of parameter names. */ - -/* NOTE: ALL of the initializers below must be updated when */ -/* the parameter MAXPAR is increased. The number blank string */ -/* initial values must be increased so that the total number */ -/* of values for each array is MAXPAR. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFEVNT", (ftnlen)6); - if (first) { - -/* Set the progress report prefix and suffix strings for */ -/* each quantity. No need to set coordinate quantity strings. */ -/* The coordinate solver performs that function. */ - - first = FALSE_; - s_copy(srcpre, "Angular separation pass 1 of #", (ftnlen)55, (ftnlen) - 30); - s_copy(srcpre + 55, "Angular separation pass 2 of #", (ftnlen)55, ( - ftnlen)30); - s_copy(srcpre + 110, "Distance pass 1 of # ", (ftnlen)55, (ftnlen)21); - s_copy(srcpre + 165, "Distance pass 2 of # ", (ftnlen)55, (ftnlen)21); - s_copy(srcpre + 440, "Angular Rate pass 1 of #", (ftnlen)55, (ftnlen) - 24); - s_copy(srcpre + 495, "Angular Rate pass 2 of #", (ftnlen)55, (ftnlen) - 24); - s_copy(srcpre + 330, "Range Rate pass 1 of #", (ftnlen)55, (ftnlen)22) - ; - s_copy(srcpre + 385, "Range Rate pass 2 of #", (ftnlen)55, (ftnlen)22) - ; - s_copy(srcpre + 550, "Phase search pass 1 of #", (ftnlen)55, (ftnlen) - 24); - s_copy(srcpre + 605, "Phase search pass 2 of #", (ftnlen)55, (ftnlen) - 24); - s_copy(srcpre + 660, "Diameter pass 1 of #", (ftnlen)55, (ftnlen)20); - s_copy(srcpre + 715, "Diameter pass 2 of #", (ftnlen)55, (ftnlen)20); - s_copy(srcsuf, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 13, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 26, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 39, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 104, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 117, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 78, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 91, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 130, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 143, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 156, "done.", (ftnlen)13, (ftnlen)5); - s_copy(srcsuf + 169, "done.", (ftnlen)13, (ftnlen)5); - } - -/* Make sure the requested quantity is one we recognize. */ - - ljust_(gquant, quant, gquant_len, (ftnlen)80); - ucase_(quant, quant, (ftnlen)80, (ftnlen)80); - qtnum = isrchc_(quant, &c__7, qnames, (ftnlen)80, (ftnlen)80); - if (qtnum == 0) { - setmsg_("The geometric quantity, # is not recognized. Supported qua" - "ntities are: DISTANCE, PHASE, ANGULAR SEPARATION.", (ftnlen) - 108); - errch_("#", gquant, (ftnlen)1, gquant_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("GFEVNT", (ftnlen)6); - return 0; - } - -/* Check number of quantity definition parameters. */ - - if (*qnpars < 0 || *qnpars > 10) { - setmsg_("Number of quantity definition parameters = #; must be in r" - "ange 0:#.", (ftnlen)68); - errint_("#", qnpars, (ftnlen)1); - errint_("#", &c__10, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("GFEVNT", (ftnlen)6); - return 0; - } - -/* Make left-justified, upper case copies of parameter names. */ - - i__1 = *qnpars; - for (i__ = 1; i__ <= i__1; ++i__) { - ljust_(qpnams + (i__ - 1) * qpnams_len, pnames + ((i__2 = i__ - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("pnames", i__2, "gfevnt_", ( - ftnlen)1720)) * 80, qpnams_len, (ftnlen)80); - ucase_(pnames + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "pnames", i__2, "gfevnt_", (ftnlen)1721)) * 80, pnames + (( - i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("pnames", - i__3, "gfevnt_", (ftnlen)1721)) * 80, (ftnlen)80, (ftnlen)80); - ljust_(qcpars + (i__ - 1) * qcpars_len, cpars + ((i__2 = i__ - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("cpars", i__2, "gfevnt_", ( - ftnlen)1723)) * 80, qcpars_len, (ftnlen)80); - ucase_(cpars + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cpars", i__2, "gfevnt_", (ftnlen)1724)) * 80, cpars + ((i__3 - = i__ - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("cpars", i__3, - "gfevnt_", (ftnlen)1724)) * 80, (ftnlen)80, (ftnlen)80); - } - -/* Make sure all parameters have been supplied for the requested */ -/* quantity. */ - - for (i__ = 1; i__ <= 10; ++i__) { - if (s_cmp(qpars + ((i__1 = i__ + qtnum * 10 - 11) < 70 && 0 <= i__1 ? - i__1 : s_rnge("qpars", i__1, "gfevnt_", (ftnlen)1734)) * 80, - " ", (ftnlen)80, (ftnlen)1) != 0) { - -/* The Ith parameter must be supplied by the caller. */ - - loc = isrchc_(qpars + ((i__1 = i__ + qtnum * 10 - 11) < 70 && 0 <= - i__1 ? i__1 : s_rnge("qpars", i__1, "gfevnt_", (ftnlen) - 1738)) * 80, qnpars, pnames, (ftnlen)80, (ftnlen)80); - if (loc == 0) { - setmsg_("The parameter # is required in order to compute eve" - "nts pertaining to the quantity #; this parameter was" - " not supplied.", (ftnlen)117); - errch_("#", qpars + ((i__1 = i__ + qtnum * 10 - 11) < 70 && 0 - <= i__1 ? i__1 : s_rnge("qpars", i__1, "gfevnt_", ( - ftnlen)1747)) * 80, (ftnlen)1, (ftnlen)80); - errch_("#", qnames + ((i__1 = qtnum - 1) < 7 && 0 <= i__1 ? - i__1 : s_rnge("qnames", i__1, "gfevnt_", (ftnlen)1748) - ) * 80, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(MISSINGVALUE)", (ftnlen)19); - chkout_("GFEVNT", (ftnlen)6); - return 0; - } - } - } - -/* Capture as local variables those parameters passed from the */ -/* callers. */ - -/* If the PNAMES array contains any of the parameters */ - -/* TARGET */ -/* OBSERVER */ -/* TARGET1 */ -/* FRAME1 */ -/* SHAPE1 */ -/* TARGET2 */ -/* FRAME2 */ -/* SHAPE2 */ -/* ABCORR */ -/* REFERENCE FRAME */ -/* DREF */ -/* DVEC */ - -/* copy the value corresponding to the parameter to a local variable. */ - -/* These operations demonstrate the need for associative arrays */ -/* as part of Fortran. */ - - -/* -TARGET- */ - - loc = isrchc_("TARGET", qnpars, pnames, (ftnlen)6, (ftnlen)80); - if (loc > 0) { - s_copy(target, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1792)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -OBSERVER- */ - - loc = isrchc_("OBSERVER", qnpars, pnames, (ftnlen)8, (ftnlen)80); - if (loc > 0) { - s_copy(obsrvr, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1804)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -TARGET1- */ - - loc = isrchc_("TARGET1", qnpars, pnames, (ftnlen)7, (ftnlen)80); - if (loc > 0) { - s_copy(of, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1816)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -TARGET2- */ - - loc = isrchc_("TARGET2", qnpars, pnames, (ftnlen)7, (ftnlen)80); - if (loc > 0) { - s_copy(of + 80, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1828)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -FRAME1- */ - - loc = isrchc_("FRAME1", qnpars, pnames, (ftnlen)6, (ftnlen)80); - if (loc > 0) { - s_copy(frame, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1840)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -FRAME2- */ - - loc = isrchc_("FRAME2", qnpars, pnames, (ftnlen)6, (ftnlen)80); - if (loc > 0) { - s_copy(frame + 80, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1851)) * 80, ( - ftnlen)80, (ftnlen)80); - } - -/* -SHAPE1- */ - - loc = isrchc_("SHAPE1", qnpars, pnames, (ftnlen)6, (ftnlen)80); - if (loc > 0) { - s_copy(shape, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1863)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -SHAPE2- */ - - loc = isrchc_("SHAPE2", qnpars, pnames, (ftnlen)6, (ftnlen)80); - if (loc > 0) { - s_copy(shape + 80, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1875)) * 80, ( - ftnlen)80, (ftnlen)80); - } - -/* -ABCORR- */ - - loc = isrchc_("ABCORR", qnpars, pnames, (ftnlen)6, (ftnlen)80); - if (loc > 0) { - s_copy(abcorr, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1887)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -REFERENCE FRAME- */ - - loc = isrchc_("REFERENCE FRAME", qnpars, pnames, (ftnlen)15, (ftnlen)80); - if (loc > 0) { - s_copy(ref, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1899)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* -COORDINATE SYSTEM- */ - - loc = isrchc_("COORDINATE SYSTEM", qnpars, qpnams, (ftnlen)17, qpnams_len) - ; - if (loc > 0) { - s_copy(corsys, qcpars + (loc - 1) * qcpars_len, (ftnlen)80, - qcpars_len); - } - -/* -COORDINATE- */ - - loc = isrchc_("COORDINATE", qnpars, qpnams, (ftnlen)10, qpnams_len); - if (loc > 0) { - s_copy(cornam, qcpars + (loc - 1) * qcpars_len, (ftnlen)80, - qcpars_len); - } - -/* -VECTOR DEFINITION- */ - - loc = isrchc_("VECTOR DEFINITION", qnpars, qpnams, (ftnlen)17, qpnams_len) - ; - if (loc > 0) { - s_copy(vecdef, qcpars + (loc - 1) * qcpars_len, (ftnlen)80, - qcpars_len); - } - -/* -DVEC- */ - - loc = isrchc_("DVEC", qnpars, pnames, (ftnlen)4, (ftnlen)80); - if (loc > 0) { - vequ_(qdpars, dvec); - } - -/* -METHOD- */ - - loc = isrchc_("METHOD", qnpars, qpnams, (ftnlen)6, qpnams_len); - if (loc > 0) { - s_copy(method, qcpars + (loc - 1) * qcpars_len, (ftnlen)80, - qcpars_len); - } - -/* -DREF- */ - - loc = isrchc_("DREF", qnpars, pnames, (ftnlen)4, (ftnlen)80); - if (loc > 0) { - s_copy(dref, cpars + ((i__1 = loc - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("cpars", i__1, "gfevnt_", (ftnlen)1970)) * 80, (ftnlen) - 80, (ftnlen)80); - } - -/* Make sure that the requested comparison operation is one we */ -/* recognize. */ - - ljust_(op, uop, op_len, (ftnlen)6); - ucase_(uop, uop, (ftnlen)6, (ftnlen)6); - loc = isrchc_(uop, &c__7, cnames, (ftnlen)6, (ftnlen)80); - if (loc == 0) { - setmsg_("The comparison operator, # is not recognized. Supported op" - "erators are: >,=,<,ABSMAX,ABSMIN,LOCMAX,LOCMIN.", (ftnlen)106) - ; - errch_("#", op, (ftnlen)1, op_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("GFEVNT", (ftnlen)6); - return 0; - } - -/* If progress reporting is enabled, set the report prefix array */ -/* according to the quantity and the relational operator. */ - - if (*rpt) { - -/* We'll use the logical flag LOCALX to indicate a local extremum */ -/* operator and the flag NOADJX to indicate an absolute extremum */ -/* operator with zero adjustment. */ - - localx = s_cmp(uop, "LOCMIN", (ftnlen)6, (ftnlen)6) == 0 || s_cmp(uop, - "LOCMAX", (ftnlen)6, (ftnlen)6) == 0; - noadjx = *adjust == 0. && (s_cmp(uop, "ABSMIN", (ftnlen)6, (ftnlen)6) - == 0 || s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0); - if (localx || noadjx) { - -/* These operators correspond to 1-pass searches. */ - - npass = 1; - } else { - npass = 2; - } - -/* Fill in the prefix strings. */ - -/* Note that we've already performed error checks on QTNUM. */ - - i__1 = npass; - for (i__ = 1; i__ <= i__1; ++i__) { - repmi_(srcpre + ((i__2 = i__ + (qtnum << 1) - 3) < 14 && 0 <= - i__2 ? i__2 : s_rnge("srcpre", i__2, "gfevnt_", (ftnlen) - 2035)) * 55, "#", &npass, rptpre + ((i__3 = i__ - 1) < 2 - && 0 <= i__3 ? i__3 : s_rnge("rptpre", i__3, "gfevnt_", ( - ftnlen)2035)) * 55, (ftnlen)55, (ftnlen)1, (ftnlen)55); - } - } - -/* Here's where the real work gets done: we solve for the */ -/* result window. The code below is quantity-specific. However, */ -/* in each case, we always initialize the utility routines for */ -/* the quantity of interest, then call the generic relation */ -/* pre-image solver ZZGFREL. */ - - if (qtnum == 1) { - -/* Separation condition initializer. */ - - zzgfspin_(of, obsrvr, shape, frame, refval, abcorr, (ftnlen)80, ( - ftnlen)80, (ftnlen)80, (ftnlen)80, (ftnlen)80); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfspdc_, (U_fp)zzgfsplt_, - (U_fp)zzgfgsep_, (U_fp)zzgfspur_, op, refval, tol, adjust, - cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp) - udrepf, rptpre, srcsuf, bail, (L_fp)udbail, result, op_len, ( - ftnlen)55, (ftnlen)13); - } else if (qtnum == 2) { - -/* Distance condition initializer. */ - - zzgfdiin_(target, abcorr, obsrvr, refval, (ftnlen)80, (ftnlen)80, ( - ftnlen)80); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfdidc_, (U_fp)zzgfdilt_, - (U_fp)zzgfdigq_, (U_fp)zzgfdiur_, op, refval, tol, adjust, - cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp) - udrepf, rptpre, srcsuf + 26, bail, (L_fp)udbail, result, - op_len, (ftnlen)55, (ftnlen)13); - } else if (qtnum == 3) { - -/* Solve for a coordinate condition. ZZGFCSLV calls the coordinate */ -/* event initializer. */ - - zzgfcslv_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - corsys, cornam, op, refval, tol, adjust, (U_fp)udstep, (U_fp) - udrefn, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp)udrepf, bail, ( - L_fp)udbail, mw, nw, work, cnfine, result, (ftnlen)80, ( - ftnlen)80, (ftnlen)80, (ftnlen)80, (ftnlen)80, (ftnlen)80, ( - ftnlen)80, (ftnlen)80, (ftnlen)80, op_len); - } else if (qtnum == 5) { - -/* d( sep ) */ -/* -------- */ -/* dt */ - -/* ---Not yet implemented--- */ - } else if (qtnum == 4) { - -/* Range rate condition initializer. */ - - -/* Set the interval for the QDERIV call in ZZGFRRDC to one */ -/* TDB second. */ - - dt = 1.; - zzgfrrin_(target, abcorr, obsrvr, refval, &dt, (ftnlen)80, (ftnlen)80, - (ftnlen)80); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfrrdc_, (U_fp)zzgfrrlt_, - (U_fp)zzgfrrgq_, (U_fp)zzgfrrur_, op, refval, tol, adjust, - cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp) - udrepf, rptpre, srcsuf + 78, bail, (L_fp)udbail, result, - op_len, (ftnlen)55, (ftnlen)13); - } else if (qtnum == 6) { -/* ---Not yet implemented--- */ - } else if (qtnum == 7) { -/* ---Not yet implemented--- */ - } else { - -/* QTNUM is not a recognized event code. This block should */ -/* never execute since we already checked the input quantity */ -/* name string. */ - - setmsg_("Unknown event '#'. This error indicates a bug. Please conta" - "ct NAIF.", (ftnlen)67); - errch_("#", gquant, (ftnlen)1, gquant_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("GFEVNT", (ftnlen)6); - return 0; - } - chkout_("GFEVNT", (ftnlen)6); - return 0; -} /* gfevnt_ */ - diff --git a/ext/spice/src/cspice/gfevnt_c.c b/ext/spice/src/cspice/gfevnt_c.c deleted file mode 100644 index ffe0ee23a0..0000000000 --- a/ext/spice/src/cspice/gfevnt_c.c +++ /dev/null @@ -1,1561 +0,0 @@ -/* - --Procedure gfevnt_c (GF, geometric event finder ) - --Abstract - - Determine time intervals when a specified geometric quantity - satisfies a specified mathematical condition. - --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 - - GF - WINDOWS - --Keywords - - EVENT - GEOMETRY - SEARCH - WINDOW - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZfc.h" - #include "SpiceZad.h" - #include "SpiceZst.h" - #include "zzalloc.h" - #undef gfevnt_c - - void gfevnt_c ( void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - ConstSpiceChar * gquant, - SpiceInt qnpars, - SpiceInt lenvals, - const void * qpnams, - const void * qcpars, - ConstSpiceDouble * qdpars, - ConstSpiceInt * qipars, - ConstSpiceBoolean * qlpars, - ConstSpiceChar * op, - SpiceDouble refval, - SpiceDouble tol, - SpiceDouble adjust, - SpiceBoolean rpt, - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - - void ( * udrepf ) ( void ), - SpiceInt nintvls, - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - udstep I Name of the routine that computes and returns a - time step. - udrefn I Name of the routine that computes a refined time. - gquant I Type of geometric quantity. - qnpars I Number of quantity definition parameters. - lenvals I Length of strings in 'qpnams' and 'qcpars'. - qpnams I Names of quantity definition parameters. - qcpars I Array of character quantity definition parameters. - qdpars I Array of double precision quantity definition - parameters. - qipars I Array of integer quantity definition parameters. - qlpars I Array of logical quantity definition parameters. - op I Operator that either looks for an extreme value - (max, min, local, absolute) or compares the - geometric quantity value and a number. - refval I Reference value. - tol I Convergence tolerance in seconds - adjust I Absolute extremum adjustment value. - rpt I Progress reporter on (.TRUE.) or off (.FALSE.) - udrepi I Function that initializes progress reporting. - udrepu I Function that updates the progress report. - udrepf I Function that finalizes progress reporting. - nintvls I Workspace window interval count - bail I Logical indicating program interrupt monitoring. - udbail I Name of a routine that signals a program interrupt. - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - --Detailed_Input - - udstep is an externally specified routine that computes a - time step in an attempt to find a transition of the - state being considered. In the context of this - routine's algorithm, a "state transition" occurs where - the geometric state changes from being in the desired - geometric condition event to not, or vice versa. - - This routine relies on `udstep' returning step sizes - small enough so that state transitions within the - confinement window are not overlooked. There must - never be two roots A and B separated by less than - `step', where `step' is the minimum step size returned by - `udstep' for any value of `et; in the interval [A, B]. - - The prototype for `udstep' is - - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ) - - where: - - et is the input start time from which the - algorithm is to search forward for a state - transition. `et' is expressed as seconds past - J2000 TDB. - - step is the output step size. `step' indicates - how far to advance `et' so that `et' and - et+step may bracket a state transition and - definitely do not bracket more than one - state transition. Units are TDB seconds. - - If a constant step size is desired, the CSPICE routine - - gfstep_c - - may be used as the step size function. If gfstep_c is - used, the step size must be set by calling - - gfsstp_c - - prior to calling this routine. - - - udrefn is the name of the externally specified routine that - computes a refinement in the times that bracket a - transition point. In other words, once a pair of - times have been detected such that the system is in - different states at each of the two times, `udrefn' - selects an intermediate time which should be closer to - the transition state than one of the two known times. - The prototype for `udrefn' is: - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ) - - where the inputs are: - - t1 is a time when the system is in state `s1'. `t1' - is expressed as seconds past J2000 TDB. - - t2 is a time when the system is in state `s2'. `t2' - is expressed as seconds past J2000 TDB. `t2' is - assumed to be larger than `t1'. - - s1 is the state of the system at time t1. - - s2 is the state of the system at time t2. - - udrefn may use or ignore the S1 and S2 values. - - The output is: - - t is next time to check for a state transition. - `t' has value between `t1' and `t2'. `t' is - expressed as seconds past J2000 TDB. - - If a simple bisection method is desired, the CSPICE routine - gfrefn_c may be used as the refinement function. - - - gquant is a string containing the name of a geometric - quantity. The times when this quantity satisfies - a condition specified by the arguments OP - and ADJUST (described below) are to be found. - - Each quantity is specified by the quantity name - given in argument 'gquant', and by a set of parameters - specified by the arguments - - qnpars - qpnams - qcpars - qdpars - qipars - qlpars - - For each quantity listed here, we also show how to - set up these input arguments to define the quantity. - See the detailed discussion of these arguments - below for further information. - - 'gquant' may be any of the strings: - - "COORDINATE" - "DISTANCE" - "ANGULAR SEPARATION" - - 'gquant' strings are case insensitive. Values, - meanings, and associated parameters are discussed - below. - - COORDINATE is a coordinate of a specified vector in - a specified reference frame and coordinate - system. For example, a coordinate can - be the Z component of the earth-sun vector - in the J2000 reference frame, or the - latitude of the nearest point on Mars to - an orbiting spacecraft, expressed relative - to the IAU_MARS reference frame. - - The method by which the vector is defined - is indicated by the - - "VECTOR DEFINITION" - - parameter. Allowed values and meanings of - this parameter are: - - "POSITION" - - The vector is defined by the - position of a target relative to - an observer. - - "SUB-OBSERVER POINT" - - The vector is the sub-observer point - on a specified target body. - - "SURFACE INTERCEPT POINT" - - The vector is defined as the - intercept point of a vector from the - observer to the target body. - - Some vector definitions, such as the - sub-observer point may be specified by a - variety of methods, so a parameter is - provided to select the computation method. - The computation method parameter name is - - "METHOD" - - If the vector definition is - - "POSITION" - - the METHOD parameter should be set to - blank: - - " " - - If the vector definition is - - "SUB-OBSERVER POINT" - - the METHOD parameter should be set to - either: - - "Near point: ellipsoid" - "Intercept: ellipsoid" - - If the vector definition is - - "SURFACE INTERCEPT POINT" - - the METHOD parameter should be set to: - - "Ellipsoid" - - The intercept computation uses - a triaxial ellipsoid to model - the surface of the target body. - The ellipsoid's radii must be - available in the kernel pool. - - The supported coordinate systems and coordinate names: - - Coordinate System Coordinates Range - - "RECTANGULAR" "X" - "Y" - "Z" - - "LATITUDINAL" "RADIUS" - "LONGITUDE" (-Pi,Pi] - "LATITUDE" [-Pi/2,Pi/2] - - "RA/DEC" "RANGE" - "RIGHT ASCENSION" [0,2Pi) - "DECLINATION" [-Pi/2,Pi/2] - - "SPHERICAL" "RADIUS" - "COLATITUDE" [0,Pi] - "LONGITUDE" (-Pi,Pi] - - "CYLINDRICAL" "RADIUS" - "LONGITUDE" [0,2Pi) - "Z" - - "GEODETIC" "LONGITUDE" (-Pi,Pi] - "LATITUDE" [-Pi/2,Pi/2] - "ALTITUDE" - - "PLANETOGRAPHIC" "LONGITUDE" [0,2Pi) - "LATITUDE" [-Pi/2,Pi/2] - "ALTITUDE" - - - When geodetic coordinates are selected, - the radii used are those of the central - body associated with the reference frame. - For example, if IAU_MARS is the reference - frame, then geodetic coordinates defined - using the radii of Mars. One cannot ask - for geodetic coordinates for a frame which - doesn't have an extended body as its - center. - - Reference frame names must be recognized - by the SPICE frame subsystem. - - Quantity Parameters: - - qnpars = 10 - - SpiceChar qpnams[SPICE_GFEVNT_MAXPAR][LNSIZE] = - { "TARGET", - "OBSERVER", - "ABCORR", - "COORDINATE SYSTEM", - "COORDINATE", - "REFERENCE FRAME", - "VECTOR DEFINITION", - "METHOD", - "DREF", - "DVEC" }; - - Only "SUB-OBSERVER POINT" searches make - use of the "DREF" and "DVEC" parameters. - - Only "SUB-OBSERVER POINT" searches make - use of the "DREF" and "DVEC" parameters. - - SpiceChar qcpars[SPICE_GFEVNT_MAXPAR][LNSIZE] = - { , - , - , - , - , - , - , - , - }; - - qdpars[0] = - qdpars[1] = - qdpars[2] = - - - DISTANCE is the apparent distance between a target - body and an observing body. Distances are - always measured between centers of mass. - - Quantity Parameters: - - QNPARS = 3 - - SpiceChar qpnams[SPICE_GFEVNT_MAXPAR][LNSIZE] = - { "TARGET", - "OBSERVER", - "ABCORR" }; - - SpiceChar qcpars[MAXPAR][LNSIZE] = - { , - , - }; - - - ANGULAR SEPARATION is the apparent angular separation of - two target bodies as seen from an observing - body. - - Quantity Parameters: - - qnpars = 8 - - SpiceChar qpnams[SPICE_GFEVNT_MAXPAR][LNSIZE] = - { "TARGET1", - "FRAME1", - "SHAPE1", - "TARGET2", - "FRAME2", - "SHAPE2", - "OBSERVER", - "ABCORR" }; - - SpiceChar qcpars[SPICE_GFEVNT_MAXPAR][LNSIZE] = - { , - , - , - , - , - , - , - }; - - The target shape model specifiers may be - set to either of the values - - "POINT" - "SPHERE" - - The shape models for the two bodies need - not match. - - Spherical models have radii equal to the - longest equatorial radius of the - PCK-based, tri-axial ellipsoids used to - model the respective bodies. When both - target bodies are modeled as spheres, the - angular separation between the bodies is - the angle between the closest points on - the limbs of the spheres, as viewed from - the vantage point of the observer. If the - limbs overlap, the angular separation is - negative. - - (In this case, the angular separation is - the angle between the centers of the - spheres minus the sum of the apparent - angular radii of the spheres.) - - A note on aberration correction parameters: the - aberration correction parameter indicates the - aberration corrections to be applied to the state of - the target body to account for one-way light time and - stellar aberration. If relevant, it applies to the - rotation of the target body as well. - - Supported aberration correction options for - observation (case where radiation is received by - observer at ET) are: - - "NONE" No correction. - "LT" Light time only. - "LT+S" Light time and stellar aberration. - "CN" Converged Newtonian (CN) light time. - "CN+S" CN light time and stellar aberration. - - Supported aberration correction options for - transmission (case where radiation is emitted from - observer at ET) are: - - "XLT" Light time only. - "XLT+S" Light time and stellar aberration. - "XCN" Converged Newtonian (CN) light time. - "XCN+S" CN light time and stellar aberration. - - For detailed information, see the geometry finder - required reading, gf.req. - - Case, leading and trailing blanks are not significant - in aberration correction parameter strings. - - - qnpars is the count of quantity parameter definition - parameters. These parameters supply the quantity- - specific information needed to fully define the - quantity used in the search performed by this routine. - - - lenvals the length of the string in arrays 'qpnames' and 'qcpars', - including the null terminators. - - - qpnams is an array of names of quantity definition parameters. - The names occupy elements 0:QNPARS-1 of this array. - The value associated with the Ith element of QPNAMS - is located in element I of the parameter value argument - having data type appropriate for the parameter: - - Data Type Argument - --------- -------- - Character strings qcpars - Double precision numbers qdpars - Integers qipars - Logicals qlpars - - The order in which the parameter names are listed - is unimportant, as long as the corresponding - parameter values are listed in the same order. - - The names in 'qpnams' are case-insensitive. - - See the description of the input argument 'gquant' - for a discussion of the parameter names and values - associated with a given quantity. - - - qcpars, - qdpars, - qipars, - qlpars are, respectively, parameter arrays of types - - const void * qcpars, - ConstSpiceDouble * qdpars, - ConstSpiceInt * qipars, - ConstSpiceBoolean * qlpars, - - The value associated with the Ith name in the array - 'qpnams'' resides in the Ith element of whichever of - these arrays has the appropriate data type. - - All of these arrays should be declared with dimension - at least 'qnpars'. 'qcpars' should have the same dimension - and shape as 'qpnams' - - The names in the array 'qcpars' are case-insensitive. - - Note that there is no required order for 'qpnams'/'q*pars' - pairs. - - See the description of the input argument 'gquant' - for a discussion of the parameter names and values - associated with a given quantity. - - - op is a scalar string comparison operator indicating the numeric - constraint of interest. Values are: - - '>' value of geometric quantity greater than some - reference (REFVAL). - - '=' value of geometric quantity equal to some - reference (REFVAL). - - '<' value of geometric quantity less than some - reference (REFVAL). - - 'ABSMAX' The geometric quantity is at an absolute - maximum. - - 'ABSMIN' The geometric quantity is at an absolute - minimum. - - 'LOCMAX' The geometric quantity is at a local - maximum. - - 'LOCMIN' The geometric quantity is at a local - minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified distance of an absolute extremum. - The argument 'adjust' (described below) is used to - specified this distance. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - Case is not significant in the string 'op'. - - - refval is the reference value used to define an equality or - inequality to be satisfied by the geometric quantity. - The units of 'refval' are radians, radians/sec, km, or - km/sec as appropriate. - - - tol is a tolerance value used to determine convergence of - root-finding operations. 'tol' is measured in ephemeris - seconds and must be greater than zero. - - - adjust the amount by which the quantity is allowed to vary - from an absolute extremum. - - If the search is for an absolute minimum is performed, - the resulting window contains time intervals when the - geometric quantity 'gquant' has values between - ABSMIN and ABSMIN + 'adjust'. - - If the search is for an absolute maximum, the - corresponding range is between ABSMAX - 'adjust' and - ABSMAX. - - 'adjust' is not used for searches for local extrema, - equality or inequality conditions and must have value - zero for such searches. 'adjust' must not be - negative. - - - rpt is a logical variable which controls whether - progress reporting is enabled. When `rpt' is SPICETRUE, - progress reporting is enabled and the routines - udrepi, udrepu, and udpref (see descriptions below) - are used to report progress. - - - udrepi is a user-defined subroutine that initializes a - progress report. When progress reporting is - enabled, `udrepi' is called at the start - of a search. The prototype for `udrepi' is - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ) - - where - - cnfine - - is a confinement window specifying the time period - over which a search is conducted, and - - srcpre - srcsuf - - are prefix and suffix strings used in the progress - report: these strings are intended to bracket a - representation of the fraction of work done. For - example, when the CSPICE progress reporting functions - are used, if srcpre and srcsuf are, respectively, - - "Occultation/transit search" - "done." - - the progress report display at the end of - the search will be: - - Occultation/transit search 100.00% done. - - If the user doesn't wish to provide a custom set of - progress reporting functions, the CSPICE routine - - gfrepi_c - - may be used. - - - udrepu is a user-defined subroutine that updates the - progress report for a search. The prototype - of `udrepu' is - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ) - - where `et' is an epoch belonging to the confinement - window, `ivbeg' and `ivend' are the start and stop times, - respectively of the current confinement window - interval. The ratio of the measure of the portion - of `cnfine' that precedes `et' to the measure of `cnfine' - would be a logical candidate for the searches - completion percentage; however the method of - measurement is up to the user. - - If the user doesn't wish to provide a custom set of - progress reporting functions, the CSPICE routine - - gfrepu_c - - may be used. - - - udrepf is a user-defined subroutine that finalizes a - progress report. `udrepf' has no arguments. - - If the user doesn't wish to provide a custom set of - progress reporting functions, the CSPICE routine - - gfrepf_c - - may be used. - - - nintvls an integer value specifying the number of intervals in the - the internal workspace array used by this routine. 'nintvls' - should be at least as large as the number of intervals - within the search region on which the specified geometric - event function is monotone increasing or decreasing. - It does no harm to pick a value of 'nintvls' larger than the - minimum required to execute the specified search, but if chosen - too small, the search will fail. - - - bail is a logical variable indicating whether or not - interrupt handling is enabled. When `bail' is - set to SPICETRUE, the input function `udbail' (see - description below) is used to determine whether - an interrupt has been issued. - - - udbail is the name of a user defined logical function that - indicates whether an interrupt signal has been - issued (for example, from the keyboard). udbail - has the prototype - - SpiceBoolean ( * udbail ) ( void ) - - The return value is SPICETRUE if an interrupt has - been issued; otherwise the value is SPICEFALSE. - - gfevnt_c uses `udbail' only when `bail' (see above) is set - to SPICETRUE, indicating that interrupt handling is - enabled. When interrupt handling is enabled, gfevnt_c - and routines in its call tree will call `udbail' to - determine whether to terminate processing and return - immediately. - - If the user doesn't wish to provide a custom interrupt - handling function, the CSPICE routine - - gfbail_c - - may be used. - - The function `udbail' will be usually be tested - multiple times by the GF system between the time - an interrupt is issued and the time when - control is returned to the calling program, so - `udbail' must continue to return SPICETRUE - until explicitly reset by the calling application. - So `udbail' must provide a "reset" mechanism." - In the case of gfbail_c, the reset function is - - gfclrh_c - - If interrupt handing is not enabled, a logical - function must still be passed as an input argument. - The CSPICE function - - gfbail_c - - may be used for this purpose. - - See the Examples header section below for a complete code - example demonstrating use of the CSPICE interrupt - handling capability. - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - specified geometric event occurs. - - If `result' is non-empty on input, its contents - will be discarded before gfevnt_c conducts its - search. - --Parameters - - None. - --Exceptions - - 1) There are varying requirements on how distinct the three - objects, QCPARS, must be. If the requirements are not met, - the error, SPICE(BODIESNOTDISTINCT) will signal from - this routine. - - When 'gquant' has value "ANGULAR SEPARATION" then all three must - be distinct. - - When 'gquant' has value "DISTANCE" or "COORDINATE" then - - The 'qcpas[0]' and 'qcpas[1]' objects must be distinct. - - 2) If any of the bodies involved do not have NAIF ID codes, the - error SPICE(IDCODENOTFOUND) will signal from this routine. - - 3) If the value of 'gquant' is not recognized as a valid value, - the error SPICE(NOTRECOGNIZED) will signal from this routine. - - 4) If the number of quantity definition parameters, QNPARS is - greater than the maximum allowed value, MAXPAR, the error - SPICE(INVALIDCOUNT) will signal from this routine. - - 5) If the proper required parameters, 'qpars', are not supplied, - the error SPICE(MISSINGVALUE) will signal from this routine. - - 6) If the comparison operator, 'op', is not recognized, the error - SPICE(NOTRECOGNIZED) will signal from this routine. - - 7) If the sizes of the workspace windows are too small, - the error SPICE(ARRAYTOOSMALL) will signal from routines - called by this routine. - - 8) If 'tol' is not greater than zero, the error - SPICE(VALUEOUTOFRANGE) will signal from routines called by - this routine. - - 9) If 'adjust' is negative, the error SPICE(VALUEOUTOFRANGE) will - signal from routines called by this routine. A non-zero - value for 'adjust' when 'op' has any value other than - "ABSMIN" or "ABSMAX" causes routines called by this - routine to signal the error SPICE(INVALIDVALUE). - - 10) The user must take care when searching for an extremum - ("ABSMAX", "ABSMIN", "LOCMAX", "LOCMIN") of an angular quantity. - Problems are most common when using the "COORDINATE" value of - 'gquant' with "LONGITUDE" or "RIGHT ASCENSION" values for the - coordinate name. Since these quantities are cyclical, rather - than monotonically increasing or decreasing, an extremum may - be hard to interpret. In particular, if an extremum is found - near the cycle boundary (-PI for longitude, 2 PI for - "RIGHT ASCENSION") it may not be numerically reasonable. For - example, the search for times when a longitude coordinate is - at its absolute maximum may result in a time when the - longitude value is -PI, due to roundoff error. - - 11) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will signal - from this routine. - - 12) If any attempt to change the handler for the interrupt - signal SIGINT fails, the error SPICE(SIGNALFAILURE) is - signaled. - - 13) If operation of this routine is interrupted, the output result - window will be invalid. - --Files - - Appropriate kernels must be loaded by the - calling program before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the target, source and observer that cover the time - period specified by the window `cnfine'. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files via - furnsh_c. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - This routine provides the SPICE GF subsystem's general interface - to determine time intervals when the value of some geometric - quantity related to one or more objects and an observer - satisfies a user specified constraint. It puts these times in a - result window called 'result'. It does this by first finding - windows when the quantity of interest is either monotonically - increasing or decreasing. These windows are then manipulated to - give the final result. - - Applications that require do not require support for progress - reporting, interrupt handling, non-default step or refinement - functions, or non-default convergence tolerance normally should - call gfsep_c, gfdist_c, gfposc_c, gfsubc_c, or gfsntc_c rather than - this routine. - - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - geometric quantity function is monotone increasing and monotone - decreasing. Each of these time periods is represented by a SPICE - window. Having found these windows, all of the quantity - function's local extrema within the confinement window are known. - Absolute extrema then can be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - - Step Size - ========= - - The monotone windows (described above) are found using a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of quantity function will be sampled. Starting at - the left endpoint of an interval, samples will be taken at each - step. If a change of sign is found, a root has been bracketed; at - that point, the time at which the time derivative of the quantity - function is zero can be found by a refinement process, for example, - using a binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the quantity function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the targets and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance," passed to this routine as 'tol'. - - The GF subsystem defines a parameter, SPICE_GF_CNVTOL (from SpiceGF.h), - as a default tolerance. This represents a "tight" tolerance value - so that the tolerance doesn't become the limiting factor in the - accuracy of solutions found by this routine. In general the accuracy - of input data will be the limiting factor. - - Making the tolerance tighter than SPICE_GF_CNVTOL is unlikely to - be useful, since the results are unlikely to be more accurate. - Making the tolerance looser will speed up searches somewhat, - since a few convergence steps will be omitted. However, in most - cases, the step size is likely to have a much greater affect - on processing time than would the convergence tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - Conduct a DISTANCE search using the default GF progress reporting - capability. - - The program will use console I/O to display a simple - ASCII-based progress report. - - The program will find local maximums of the distance from earth to - Moon with light time and stellar aberration corrections to model - the apparent positions of the Moon. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File name: standard.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de414.bsp', - 'pck00008.tpc', - 'naif0009.tls' ) - - \begintext - - Code: - - #include "SpiceUsr.h" - #include "SpiceGF.h" - #include - #include - - int main() - { - - /. - Constants - ./ - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND" - #define MAXVAL 10000 - #define STRSIZ 41 - #define LNSIZE 81 - #define MAXPAR 10 - - /. - Local variables - ./ - SpiceBoolean bail; - SpiceBoolean rpt; - - /. - Confining window beginning and ending time strings. - ./ - SpiceChar begstr [LNSIZE] = "2001 jan 01 00:00:00.000"; - SpiceChar endstr [LNSIZE] = "2001 dec 31 00:00:00.000"; - SpiceChar event [] = "DISTANCE"; - SpiceChar relate [] = "LOCMAX"; - - - /. - Declare qpnams and qcpars with the same dimensions. - SPICE_GFEVNT_MAXPAR defined in SpiceGF.h. - ./ - SpiceChar qpnams[SPICE_GFEVNT_MAXPAR][LNSIZE] = { "TARGET", - "OBSERVER", - "ABCORR" }; - - SpiceChar qcpars[SPICE_GFEVNT_MAXPAR][LNSIZE] = { "MOON", - "EARTH", - "LT+S" }; - - SpiceDouble qdpars[SPICE_GFEVNT_MAXPAR]; - SpiceInt qipars[SPICE_GFEVNT_MAXPAR]; - SpiceBoolean qlpars[SPICE_GFEVNT_MAXPAR]; - - - SPICEDOUBLE_CELL ( cnfine, MAXVAL ); - SPICEDOUBLE_CELL ( result, MAXVAL ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble refval; - SpiceDouble adjust; - SpiceDouble tol; - SpiceDouble beg; - SpiceDouble end; - - - SpiceInt lenvals; - SpiceInt nintvls; - SpiceInt count; - SpiceInt qnpars; - SpiceInt i; - - - /. - Load leapsecond and spk kernels. The name of the - meta kernel file shown here is fictitious; you - must supply the name of a file available - on your own computer system. - ./ - furnsh_c ( "standard.tm" ); - - /. - Set a beginning and end time for confining window. - ./ - - str2et_c ( begstr, &begtim ); - str2et_c ( endstr, &endtim ); - - - /. - Add 2 points to the confinement interval window. - ./ - wninsd_c ( begtim, endtim, &cnfine ); - - - /. - Check the number of intervals in confining window. - ./ - count = wncard_c( &cnfine ); - printf( "Found %ld intervals in cnfine\n", count ); - - - /. - Set the step size to 1/1000 day and convert to seconds. - One day would be a reasonable stepsize for this - search, but the run would not last long enough to issue - an interrupt. - ./ - step = 0.001 * spd_c(); - gfsstp_c ( step ); - - - /. - Set interrupt handling and progress reporting. - ./ - bail = SPICETRUE; - rpt = SPICETRUE; - - lenvals= LNSIZE; - qnpars = 3; - tol = SPICE_GF_CNVTOL; - refval = 0.; - adjust = 0.; - nintvls= MAXVAL; - - /. - Perform the search. - ./ - gfevnt_c ( gfstep_c, - gfrefn_c, - event, - qnpars, - lenvals, - qpnams, - qcpars, - qdpars, - qipars, - qlpars, - relate, - refval, - tol, - adjust, - rpt, - &gfrepi_c, - gfrepu_c, - gfrepf_c, - nintvls, - bail, - gfbail_c, - &cnfine, - &result ); - - if ( gfbail_c() ) - { - /. - Clear the CSPICE interrupt indication. This is - an essential step for programs that continue - running after an interrupt; gfbail_c will - continue to return SPICETRUE until this step - has been performed. - ./ - gfclrh_c(); - - - /. - We've trapped an interrupt signal. In a realistic - application, the program would continue operation - from this point. In this simple example, we simply - display a message and quit. - ./ - printf ( "\nSearch was interrupted.\n\nThis message " - "was written after an interrupt signal\n" - "was trapped. By default, the program " - "would have terminated \nbefore this message " - "could be written.\n\n" ); - } - else - { - count = wncard_c( &result); - printf( "Found %ld intervals in result\n", count ); - - /. - List the beginning and ending points in each interval. - ./ - for( i=0; ibase), - ( logical * ) &rpt, - ( S_fp ) zzadrepi_c, - ( U_fp ) zzadrepu_c, - ( S_fp ) zzadrepf_c, - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( logical * ) &bail, - ( L_fp ) zzadbail_c, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(gquant), - ( ftnlen ) fstr_Len_qpnams, - ( ftnlen ) fstr_Len_qcpars, - ( ftnlen ) strlen(op) ); - - /* - Always restore the previous signal handler and free dynamically - allocated memory. - */ - free_SpiceMemory( work ); - free ( fstr_qpnams ); - free ( fstr_qcpars ); - - /* - If we've changed the signal handler, restore the previous one. - */ - if ( newHandler ) - { - sigPtr = signal ( SIGINT, defSigHandler ); - - if ( sigPtr == SIG_ERR ) - { - setmsg_c ( "Attempt to restore the previous handler " - "for the interrupt signal SIGINT failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - chkout_c ( "gfevnt_c" ); - return; - } - } - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - ALLOC_CHECK; - - chkout_c ( "gfevnt_c" ); - - } - - diff --git a/ext/spice/src/cspice/gffove.c b/ext/spice/src/cspice/gffove.c deleted file mode 100644 index 14fe8199e1..0000000000 --- a/ext/spice/src/cspice/gffove.c +++ /dev/null @@ -1,1708 +0,0 @@ -/* gffove.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static logical c_false = FALSE_; -static doublereal c_b16 = 1.; - -/* $Procedure GFFOVE ( GF, is target in FOV? ) */ -/* Subroutine */ int gffove_(char *inst, char *tshape, doublereal *raydir, - char *target, char *tframe, char *abcorr, char *obsrvr, doublereal * - tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, - S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, - doublereal *result, ftnlen inst_len, ftnlen tshape_len, ftnlen - target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int zzgffvin_(char *, char *, doublereal *, char * - , char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, - ftnlen); - extern /* Subroutine */ int zzgffvst_(); - extern /* Subroutine */ int zzgfsolv_(U_fp, U_fp, U_fp, logical *, L_fp, - logical *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, doublereal *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - integer count; - doublereal start; - extern logical failed_(void); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern integer wncard_(doublereal *); - doublereal finish; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), wnfetd_(doublereal *, integer *, doublereal *, - doublereal *); - -/* $ Abstract */ - -/* Determine time intervals when a specified target body or ray */ -/* intersects the space bounded by the field-of-view (FOV) of a */ -/* specified instrument. Report progress and handle interrupts if so */ -/* commanded. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* GF */ -/* KERNEL */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* FOV */ -/* GEOMETRY */ -/* INSTRUMENT */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* MAXVRT P Maximum number of FOV boundary vertices. */ -/* INST I Name of the instrument. */ -/* TSHAPE I Type of shape model used for target body. */ -/* RAYDIR I Ray's direction vector. */ -/* TARGET I Name of the target body. */ -/* TFRAME I Body-fixed, body-centered frame for target body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* TOL I Convergence tolerance in seconds. */ -/* UDSTEP I Name of routine that returns a time step. */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* RPT I Progress report flag. */ -/* UDREPI I Function that initializes progress reporting. */ -/* UDREPU I Function that updates the progress report. */ -/* UDREPF I Function that finalizes progress reporting. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* RESULT O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* INST indicates the name of an instrument, such as a */ -/* spacecraft-mounted framing camera, the field of view */ -/* (FOV) of which is to be used for a target intersection */ -/* search: times when the specified target intersects the */ -/* region of space corresponding to the FOV are sought. */ - -/* INST must have a corresponding NAIF ID and a frame */ -/* defined, as is normally done in a frame kernel. It */ -/* must also have an associated reference frame and a FOV */ -/* shape, boresight and boundary vertices (or reference */ -/* vector and reference angles) defined, as is usually */ -/* done in an instrument kernel. */ - -/* See the header of the SPICELIB routine GETFOV for a */ -/* description of the required parameters associated with */ -/* an instrument. */ - - -/* TSHAPE is a string indicating the geometric model used to */ -/* represent the location and shape of the target body. */ -/* The target body may be represented by either an */ -/* ephemeris object or a ray emanating from the observer. */ - -/* The supported values of TSHAPE are: */ - -/* 'ELLIPSOID' The target is an ephemeris object. */ - -/* The target's shape is represented */ -/* using triaxial ellipsoid model, */ -/* with radius values provided via the */ -/* kernel pool. A kernel variable */ -/* having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF */ -/* integer code associated with the */ -/* body, must be present in the kernel */ -/* pool. This variable must be */ -/* associated with three numeric */ -/* values giving the lengths of the */ -/* ellipsoid's X, Y, and Z semi-axes. */ - -/* 'POINT' The target is an ephemeris object. */ -/* The body is treated as a single */ -/* point. */ - -/* 'RAY' The target is NOT an ephemeris */ -/* object. Instead, the target is */ -/* represented by the ray emanating */ -/* from the observer's location and */ -/* having direction vector RAYDIR. The */ -/* target is considered to be visible */ -/* if and only if the ray is contained */ -/* within the space bounded by the */ -/* instrument FOV. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TSHAPE. */ - - -/* RAYDIR is the direction vector associated with a ray */ -/* representing the target. RAYDIR is used if and only */ -/* if TSHAPE (see description above) indicates the */ -/* target is modeled as a ray. */ - - -/* TARGET is the name of the target body, the appearances of */ -/* which in the specified instrument's field of view are */ -/* sought. The body must be an ephemeris object. */ - -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. For example both 'MOON' and */ -/* '301' are legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TARGET. */ - -/* The input argument TARGET is used if and only if the */ -/* target is NOT modeled as ray, as indicated by the */ -/* input argument TSHAPE. */ - -/* TARGET may be set to a blank string if the target is */ -/* modeled as a ray. */ - - -/* TFRAME is the name of the reference frame associated with the */ -/* target. Examples of such names are 'IAU_SATURN' */ -/* (for Saturn) and 'ITRF93' (for the Earth). */ - -/* If the target is an ephemeris object modeled as an */ -/* ellipsoid, TFRAME must designate a body-fixed */ -/* reference frame centered on the target body. */ - -/* If the target is an ephemeris object modeled as a */ -/* point, TFRAME is ignored; TFRAME should be left blank. */ - -/* If the target is modeled as a ray, TFRAME may */ -/* designate any reference frame. Since light time */ -/* corrections are not supported for rays, the */ -/* orientation of the frame is always evaluated at the */ -/* epoch associated with the observer, as opposed to the */ -/* epoch associated with the light-time corrected */ -/* position of the frame center. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* TFRAME. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the target's position and orientation. */ -/* The supported values of ABCORR depend on the target */ -/* representation. */ - -/* If the target is represented by a ray, the aberration */ -/* correction options are */ - -/* 'NONE' No correction. */ -/* 'S' Stellar aberration correction, */ -/* reception case. */ -/* 'XS' Stellar aberration correction, */ -/* transmission case. */ - -/* If the target is an ephemeris object, the aberration */ -/* correction options are those supported by the SPICE */ -/* SPK system. For remote sensing applications, where the */ -/* apparent position and orientation of the target seen */ -/* by the observer are desired, normally either of the */ -/* corrections */ - -/* 'LT+S' */ -/* 'CN+S' */ - -/* should be used. These and the other supported options */ -/* are described below. */ - -/* Supported aberration correction options for */ -/* observation (the case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (the case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the body from which the target is */ -/* observed. The instrument designated by INST is treated */ -/* as if it were co-located with the observer. */ - -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in TDB */ -/* seconds and must be greater than zero. */ - - -/* UDSTEP is an externally specified routine that computes a */ -/* time step used to find transitions of the state being */ -/* considered. A state transition occurs where the state */ -/* changes from being "visible" to being "not visible" or */ -/* vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. ET is a DOUBLE PRECISION number. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. STEP is a DOUBLE */ -/* PRECISION number. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine GFSTEP */ -/* may be used. If GFSTEP is used, the step size must be */ -/* set by calling GFSSTP prior to calling this routine. */ - - -/* UDREFN is the name of the externally specified routine that */ -/* refines the times that bracket a transition point. In */ -/* other words, once a pair of times, T1 and T2, that */ -/* bracket a state transition have been found, UDREFN */ -/* computes an intermediate time T such that either */ -/* [T1, T] or [T, T2] contains the time of the state */ -/* transition. The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 is a time when the visibility state is S1. T1 */ -/* is expressed as seconds past J2000 TDB. */ - -/* T2 is a time when the visibility state is S2. T2 */ -/* is expressed as seconds past J2000 TDB. and */ -/* is assumed to be larger than T1. */ - -/* S1 is the visibility state at time T1. S1 is a */ -/* LOGICAL value. */ - -/* S2 is the visibility state at time T2. S2 is a */ -/* LOGICAL value. */ - -/* The output is: */ - -/* T is the next time to check for a state */ -/* transition. T is expressed as seconds past */ -/* J2000 TDB and is between T1 and T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. */ - - -/* RPT is a logical variable that controls whether */ -/* progress reporting is enabled. When RPT is .TRUE., */ -/* progress reporting is enabled and the routines */ -/* UDREPI, UDREPU, and UDPREF (see descriptions below) */ -/* are used to report progress. */ - - -/* UDREPI is a user-defined subroutine that initializes a */ -/* progress report. When progress reporting is */ -/* enabled, UDREPI is called at the start */ -/* of a search. The calling sequence of UDREPI is */ - -/* UDREPI ( CNFINE, SRCPRE, SRCSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) SRCPRE */ -/* CHARACTER*(*) SRCSUF */ - -/* where */ - -/* CNFINE */ - -/* is the confinement window and */ - -/* SRCPRE */ -/* SRCSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. For */ -/* example, when the SPICELIB progress reporting functions */ -/* are used, if SRCPRE and SRCSUF are, respectively, */ - -/* 'FOV search' */ -/* 'done.' */ - -/* the progress report display at the end of the */ -/* search will be: */ - -/* FOV search 100.00% done. */ - -/* The SPICELIB routine GFREPI may be used as the */ -/* actual argument corresponding to UDREPI. If so, */ -/* the SPICELIB routines GFREPU and GFREPF must be */ -/* the actual arguments corresponding to UDREPU and */ -/* UDREPF. */ - - -/* UDREPU is a user-defined subroutine that updates the */ -/* progress report for a search. The calling sequence */ -/* of UDREPU is */ - -/* UDREPU ( IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ -/* DOUBLE PRECISION ET */ - -/* Here IVBEG, IVEND are the bounds of an interval that */ -/* is contained in some interval belonging to the */ -/* confinement window. The confinement window is */ -/* associated with some root finding activity. It is used */ -/* to determine how much total time is being searched in */ -/* order to find the events of interest. */ - -/* ET is an epoch belonging to the interval [IVBEG, */ -/* IVEND]. */ - -/* In order for a meaningful progress report to be */ -/* displayed, IVBEG and IVEND must satisfy the following */ -/* constraints: */ - -/* - IVBEG must be less than or equal to IVEND. */ - -/* - The interval [ IVBEG, IVEND ] must be contained in */ -/* some interval of the confinement window. It can be */ -/* a proper subset of the containing interval; that */ -/* is, it can be smaller than the interval of the */ -/* confinement window that contains it. */ - -/* - Over a search, the sum of the differences */ - -/* IVEND - IVBEG */ - -/* for all calls to this routine made during the search */ -/* must equal the measure of the confinement window. */ - -/* The SPICELIB routine GFREPU may be used as the */ -/* actual argument corresponding to UDREPU. If so, */ -/* the SPICELIB routines GFREPI and GFREPF must be */ -/* the actual arguments corresponding to UDREPI and */ -/* UDREPF. */ - - -/* UDREPF is a user-defined subroutine that finalizes a */ -/* progress report. UDREPF has no arguments. */ - -/* The SPICELIB routine GFREPF may be used as the */ -/* actual argument corresponding to UDREPF. If so, */ -/* the SPICELIB routines GFREPI and GFREPU must be */ -/* the actual arguments corresponding to UDREPI and */ -/* UDREPU. */ - - -/* BAIL is a logical variable indicating whether or not */ -/* interrupt handling is enabled. When BAIL is */ -/* set to .TRUE., the input function UDBAIL (see */ -/* description below) is used to determine whether */ -/* an interrupt has been issued. */ - - -/* UDBAIL is the name of a user defined logical function that */ -/* indicates whether an interrupt signal has been */ -/* issued (for example, from the keyboard). UDBAIL */ -/* has no arguments and returns a LOGICAL value. */ -/* The return value is .TRUE. if an interrupt has */ -/* been issued; otherwise the value is .FALSE. */ - -/* GFFOVE uses UDBAIL only when BAIL (see above) is set */ -/* to .TRUE., indicating that interrupt handling is */ -/* enabled. When interrupt handling is enabled, GFFOVE */ -/* and routines in its call tree will call UDBAIL to */ -/* determine whether to terminate processing and return */ -/* immediately. */ - -/* If interrupt handing is not enabled, a logical */ -/* function must still be passed to GFFOVE as */ -/* an input argument. The SPICE function */ - -/* GFBAIL */ - -/* may be used for this purpose. */ - - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* The endpoints of the time intervals comprising CNFINE */ -/* are interpreted as seconds past J2000 TDB. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window representing the set of time */ -/* intervals, within the confinement period, when image */ -/* of the target body is partially or completely within */ -/* the specified instrument field of view. */ - -/* The endpoints of the time intervals comprising RESULT */ -/* are interpreted as seconds past J2000 TDB. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFFOVE conducts its */ -/* search. */ - -/* $ Parameters */ - -/* LBCELL is the lower bound for SPICE cell arrays. */ - - -/* MAXVRT is the maximum number of vertices that may be used */ -/* to define the boundary of the specified instrument's */ -/* field of view. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEPSIZE) will be signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results. The SPICE window routine */ -/* WNCOND can be used to contract the result window. */ - -/* 3) If the name of either the target or observer cannot be */ -/* translated to a NAIF ID code, the error will be diagnosed by */ -/* a routine in the call tree of this routine. */ - -/* 4) If the specified aberration correction is not a supported */ -/* value for the target type (ephemeris object or ray), the */ -/* error will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 5) If the radii of a target body modeled as an ellipsoid cannot */ -/* be determined by searching the kernel pool for a kernel */ -/* variable having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF integer code associated with */ -/* the body, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* 6) If the target body coincides with the observer body OBSRVR, */ -/* the error will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 7) If the body model specifier TSHAPE is not recognized, the */ -/* error will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 8) If a target body-fixed reference frame associated with a */ -/* non-point target is not recognized, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 9) If a target body-fixed reference frame is not centered at */ -/* the corresponding target body, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 10) If the instrument name INST does not have corresponding NAIF */ -/* ID code, the error will be diagnosed by a routine in the call */ -/* tree of this routine. */ - -/* 11) If the FOV parameters of the instrument are not present in */ -/* the kernel pool, the error will be be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* 12) If the FOV boundary has more than MAXVRT vertices, the error */ -/* will be be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* 13) If the instrument FOV is polygonal, and this routine cannot */ -/* find a ray R emanating from the FOV vertex such that maximum */ -/* angular separation of R and any FOV boundary vector is within */ -/* the limit (pi/2)-SPICE_GF_MARGIN radians, the error will be */ -/* diagnosed by a routine in the call tree of this routine. If */ -/* the FOV is any other shape, the same error check will be */ -/* applied with the instrument boresight vector serving the role */ -/* of R. */ - -/* 14) If the loaded kernels provide insufficient data to compute a */ -/* requested state vector, the error will be diagnosed by a */ -/* routine in the call tree of this routine. */ - -/* 15) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 16) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* visibility condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* 17) If the convergence tolerance size is non-positive, the error */ -/* SPICE(INVALIDTOLERANCE) will be signaled. */ - -/* 18) If the step size is non-positive, the error */ -/* SPICE(INVALIDSTEP) will be signaled. */ - -/* 19) If the ray's direction vector is zero, the error */ -/* SPICE(ZEROVECTOR) is signaled. */ - - -/* $ Files */ - -/* Appropriate SPICE ernels must be loaded by the calling program */ -/* before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer that */ -/* describes the ephemeris of these objects for the period */ -/* defined by the confinement window, 'CNFINE' must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the body-fixed frame of */ -/* the target, that definition must be available in the kernel */ -/* pool. Typically the definitions of frames not already */ -/* built-in to SPICE are supplied by loading a frame kernel. */ - -/* Data defining the reference frame associated with the */ -/* instrument designated by INST must be available in the kernel */ -/* pool. Additionally the name INST must be associated with an */ -/* ID code. Normally these data are made available by loading */ -/* a frame kernel via FURNSH. */ - -/* - IK data: the kernel pool must contain data such that */ -/* the SPICELIB routine GETFOV may be called to obtain */ -/* parameters for INST. Normally such data are provided by */ -/* an IK via FURNSH. */ - -/* The following data may be required: */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* orientation data provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file via FURNSH. */ - -/* Bodies modeled as triaxial ellipsoids must have semi-axis */ -/* lengths provided by variables in the kernel pool. Typically */ -/* these data are made available by loading a text PCK file via */ -/* FURNSH. */ - -/* - CK data: if the instrument frame is fixed to a spacecraft, */ -/* at least one CK file will be needed to permit transformation */ -/* of vectors between that frame and both J2000 and the target */ -/* body-fixed frame. */ - -/* - SCLK data: if a CK file is needed, an associated SCLK */ -/* kernel is required to enable conversion between encoded SCLK */ -/* (used to time-tag CK data) and barycentric dynamical time */ -/* (TDB). */ - -/* - Since the input ray direction may be expressed in any */ -/* frame, FKs, CKs, SCLK kernels, PCKs, and SPKs may be */ -/* required to map the direction to the J2000 frame. */ -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when a specified ray or any portion */ -/* of a specified target body appears within the field of view of a */ -/* specified instrument. We'll use the term "visibility event" to */ -/* designate such an appearance. The set of time intervals resulting */ -/* from the search is returned as a SPICE window. */ - -/* This routine provides the SPICE GF system's most flexible */ -/* interface for searching for FOV intersection events. */ - -/* Applications that require do not require support for progress */ -/* reporting, interrupt handling, non-default step or refinement */ -/* functions, or non-default convergence tolerance normally should */ -/* call either GFTFOV or GFRFOV rather than this routine. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient use */ -/* of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* The search for visibility events is treated as a search for state */ -/* transitions: times are sought when the state of the target ray or */ -/* body changes from "not visible" to "visible" or vice versa. */ - -/* Step Size */ -/* ========= */ - -/* Each interval of the confinement window is searched as follows: */ -/* first, the input step size is used to determine the time */ -/* separation at which the visibility state will be sampled. */ -/* Starting at the left endpoint of an interval, samples will be */ -/* taken at each step. If a state change is detected, a root has */ -/* been bracketed; at that point, the "root"--the time at which the */ -/* state change occurs---is found by a refinement process, for */ -/* example, via binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the visibility state is constant: */ -/* the step size should be shorter than the shortest visibility event */ -/* duration and the shortest period between visibility events, within */ -/* the confinement window. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* The times of state transitions are called ``roots.'' */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." */ - -/* The convergence tolerance used by high-level GF routines that */ -/* call this routine is set via the parameter CNVTOL, which is */ -/* declared in the INCLUDE file gf.inc. The value of CNVTOL is set */ -/* to a "tight" value so that the tolerance doesn't become the */ -/* limiting factor in the accuracy of solutions found by this */ -/* routine. In general the accuracy of input data will be the */ -/* limiting factor. */ - -/* Setting the input tolerance TOL tighter than CNVTOL is unlikely */ -/* to be useful, since the results are unlikely to be more accurate. */ -/* Making the tolerance looser will speed up searches somewhat, */ -/* since a few convergence steps will be omitted. However, in most */ -/* cases, the step size is likely to have a much greater effect on */ -/* processing time than would the convergence tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. For an example, see */ -/* the program CASCADE in the GF Example Programs chapter of the GF */ -/* Required Reading, gf.req. */ - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) Search for times when Saturn's satellite Phoebe is within */ -/* the FOV of the Cassini narrow angle camera (CASSINI_ISS_NAC). */ -/* To simplify the problem, restrict the search to a short time */ -/* period where continuous Cassini bus attitude data are */ -/* available. */ - -/* Use default SPICELIB progress reporting. */ - -/* Use a step size of 1 second to reduce chances of missing */ -/* short visibility events and to make the search slow enough */ -/* so the progress report's updates are visible. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File name: gftfov_ex1.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* naif0009.tls Leapseconds */ -/* cpck05Mar2004.tpc Satellite orientation and */ -/* radii */ -/* 981005_PLTEPH-DE405S.bsp Planetary ephemeris */ -/* 020514_SE_SAT105.bsp Satellite ephemeris */ -/* 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris */ -/* cas_v37.tf Cassini FK */ -/* 04135_04171pc_psiv2.bc Cassini bus CK */ -/* cas00084.tsc Cassini SCLK kernel */ -/* cas_iss_v09.ti Cassini IK */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'naif0009.tls', */ -/* 'cpck05Mar2004.tpc', */ -/* '981005_PLTEPH-DE405S.bsp', */ -/* '020514_SE_SAT105.bsp', */ -/* '030201AP_SK_SM546_T45.bsp', */ -/* 'cas_v37.tf', */ -/* '04135_04171pc_psiv2.bc', */ -/* 'cas00084.tsc', */ -/* 'cas_iss_v09.ti' ) */ -/* \begintext */ - - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ - -/* C */ -/* C SPICELIB default functions for */ -/* C */ -/* C - Interrupt handling (no-op function): GFBAIL */ -/* C - Search refinement: GFREFN */ -/* C - Progress report termination: GFREPF */ -/* C - Progress report initialization: GFREPI */ -/* C - Progress report update: GFREPU */ -/* C - Search step size "get" function: GFSTEP */ -/* C */ -/* EXTERNAL GFBAIL */ -/* EXTERNAL GFREFN */ -/* EXTERNAL GFREPF */ -/* EXTERNAL GFREPI */ -/* EXTERNAL GFREPU */ -/* EXTERNAL GFSTEP */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'gftfov_ex1.tm' ) */ - -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY-MON-DD HR:MN:SC.######::TDB (TDB)' ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 10000 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 10 ) */ - -/* INTEGER BDNMLN */ -/* PARAMETER ( BDNMLN = 36 ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER SHPLEN */ -/* PARAMETER ( SHPLEN = 25 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 35 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR */ -/* CHARACTER*(BDNMLN) INST */ -/* CHARACTER*(LNSIZE) LINE */ -/* CHARACTER*(BDNMLN) OBSRVR */ -/* CHARACTER*(BDNMLN) TARGET */ -/* CHARACTER*(FRNMLN) TFRAME */ -/* CHARACTER*(TIMLEN) TIMSTR ( 2 ) */ -/* CHARACTER*(SHPLEN) TSHAPE */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION ENDPT ( 2 ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION RAYDIR ( 3 ) */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION TOL */ - -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER N */ - -/* LOGICAL BAIL */ -/* LOGICAL RPT */ - -/* C */ -/* C Since we're treating the target as an ephemeris object, */ -/* C the ray direction is unused. We simply initialize the */ -/* C direction vector to avoid portability problems. */ -/* C */ -/* DATA RAYDIR / 3*0.D0 / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Insert search time interval bounds into the */ -/* C confinement window. */ -/* C */ -/* CALL STR2ET ( '2004 JUN 11 06:30:00 TDB', ET0 ) */ -/* CALL STR2ET ( '2004 JUN 11 12:00:00 TDB', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Initialize inputs for the search. */ -/* C */ -/* INST = 'CASSINI_ISS_NAC' */ -/* TARGET = 'PHOEBE' */ -/* TSHAPE = 'ELLIPSOID' */ -/* TFRAME = 'IAU_PHOEBE' */ -/* ABCORR = 'LT+S' */ -/* OBSRVR = 'CASSINI' */ - -/* C */ -/* C Use a particularly short step size to make the progress */ -/* C report's updates visible. */ -/* C */ -/* C Pass the step size (1 second) to the GF default step size */ -/* C put/get system. */ -/* C */ -/* CALL GFSSTP ( 1.D0 ) */ - -/* C */ -/* C Set the convergence tolerance to 1 microsecond. */ -/* C */ -/* TOL = 1.D-6 */ - -/* C */ -/* C Use progress reporting; turn off interrupt handling. */ -/* C */ -/* RPT = .TRUE. */ -/* BAIL = .FALSE. */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*, '(A)' ) 'Instrument: '//INST */ -/* WRITE (*, '(A)' ) 'Target: '//TARGET */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFFOVE ( INST, TSHAPE, RAYDIR, */ -/* . TARGET, TFRAME, ABCORR, OBSRVR, TOL, */ -/* . GFSTEP, GFREFN, RPT, GFREPI, GFREPU, */ -/* . GFREPF, BAIL, GFBAIL, CNFINE, RESULT ) */ - -/* N = WNCARD( RESULT ) */ - -/* IF ( N .EQ. 0 ) THEN */ - -/* WRITE (*, '(A)' ) 'No FOV intersection found.' */ - -/* ELSE */ - -/* WRITE (*, '(A)' ) */ -/* . ' Visibility start time Stop time' */ - -/* DO I = 1, N */ - -/* CALL WNFETD ( RESULT, I, ENDPT(1), ENDPT(2) ) */ - -/* DO J = 1, 2 */ -/* CALL TIMOUT ( ENDPT(J), TIMFMT, TIMSTR(J) ) */ -/* END DO */ - -/* LINE( :3) = ' ' */ -/* LINE(2: ) = TIMSTR(1) */ -/* LINE(37:) = TIMSTR(2) */ - -/* WRITE (*,*) LINE */ - -/* END DO */ - -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* final output (the progress report is overwritten when it is */ -/* updated, so only the final update is captured here) was: */ - - -/* Instrument: CASSINI_ISS_NAC */ -/* Target: PHOEBE */ - - -/* Target visibility search 100.00% done. */ - -/* Visibility start time Stop time */ -/* 2004-JUN-11 07:35:49.958590 (TDB) 2004-JUN-11 08:48:27.485965 (TDB) */ -/* 2004-JUN-11 09:03:19.767799 (TDB) 2004-JUN-11 09:35:27.634790 (TDB) */ -/* 2004-JUN-11 09:50:19.585474 (TDB) 2004-JUN-11 10:22:27.854254 (TDB) */ -/* 2004-JUN-11 10:37:19.332696 (TDB) 2004-JUN-11 11:09:28.116016 (TDB) */ -/* 2004-JUN-11 11:24:19.049484 (TDB) 2004-JUN-11 11:56:28.380304 (TDB) */ - - -/* 2) A variation of example (1): search the same confinement */ -/* window for times when a selected background star is visible. */ -/* We use the FOV of the Cassini ISS wide angle camera */ -/* (CASSINI_ISS_WAC) to enhance the probability of viewing the */ -/* star. */ - -/* The star we'll use has catalog number 6000 in the Hipparcos */ -/* Catalog. The star's J2000 right ascension and declination, */ -/* proper motion, and parallax are taken from that catalog. */ - -/* Use the meta-kernel from the first example. */ - -/* Example code begins here. */ - - -/* PROGRAM EX2 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION J1950 */ -/* DOUBLE PRECISION J2000 */ -/* DOUBLE PRECISION JYEAR */ -/* DOUBLE PRECISION RPD */ - -/* INTEGER WNCARD */ - -/* C SPICELIB default functions for */ -/* C */ -/* C - Interrupt handling (no-op function): GFBAIL */ -/* C - Search refinement: GFREFN */ -/* C - Progress report termination: GFREPF */ -/* C - Progress report initialization: GFREPI */ -/* C - Progress report update: GFREPU */ -/* C - Search step size "get" function: GFSTEP */ -/* C */ -/* EXTERNAL GFBAIL */ -/* EXTERNAL GFREFN */ -/* EXTERNAL GFREPF */ -/* EXTERNAL GFREPI */ -/* EXTERNAL GFREPU */ -/* EXTERNAL GFSTEP */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'gftfov_ex1.tm' ) */ - -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY-MON-DD HR:MN:SC.######::TDB (TDB)' ) */ - - -/* DOUBLE PRECISION AU */ -/* PARAMETER ( AU = 149597870.693D0 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 10000 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 10 ) */ - -/* INTEGER BDNMLN */ -/* PARAMETER ( BDNMLN = 36 ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER SHPLEN */ -/* PARAMETER ( SHPLEN = 25 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 35 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR */ -/* CHARACTER*(BDNMLN) INST */ -/* CHARACTER*(LNSIZE) LINE */ -/* CHARACTER*(BDNMLN) OBSRVR */ -/* CHARACTER*(FRNMLN) RFRAME */ -/* CHARACTER*(BDNMLN) TARGET */ -/* CHARACTER*(TIMLEN) TIMSTR ( 2 ) */ -/* CHARACTER*(SHPLEN) TSHAPE */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION DEC */ -/* DOUBLE PRECISION DECEPC */ -/* DOUBLE PRECISION DECPM */ -/* DOUBLE PRECISION DECDEG */ -/* DOUBLE PRECISION DECDG0 */ -/* DOUBLE PRECISION DTDEC */ -/* DOUBLE PRECISION DTRA */ -/* DOUBLE PRECISION ENDPT ( 2 ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION PARLAX */ -/* DOUBLE PRECISION PLXDEG */ -/* DOUBLE PRECISION POS ( 3 ) */ -/* DOUBLE PRECISION PSTAR ( 3 ) */ -/* DOUBLE PRECISION RA */ -/* DOUBLE PRECISION RADEG */ -/* DOUBLE PRECISION RADEG0 */ -/* DOUBLE PRECISION RAEPC */ -/* DOUBLE PRECISION RAPM */ -/* DOUBLE PRECISION RAYDIR ( 3 ) */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION RSTAR */ -/* DOUBLE PRECISION T */ -/* DOUBLE PRECISION TOL */ - -/* INTEGER CATNO */ -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER N */ - -/* LOGICAL BAIL */ -/* LOGICAL RPT */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Insert search time interval bounds into the */ -/* C confinement window. */ -/* C */ -/* CALL STR2ET ( '2004 JUN 11 06:30:00 TDB', ET0 ) */ -/* CALL STR2ET ( '2004 JUN 11 12:00:00 TDB', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Initialize inputs for the search. */ -/* C */ -/* INST = 'CASSINI_ISS_WAC' */ -/* TARGET = ' ' */ -/* TSHAPE = 'RAY' */ - -/* C */ -/* C Create a unit direction vector pointing from */ -/* c observer to star. We'll assume the direction */ -/* C is constant during the confinement window, and */ -/* C we'll use et0 as the epoch at which to compute the */ -/* C direction from the spacecraft to the star. */ -/* C */ -/* C The data below are for the star with catalog */ -/* C number 6000 in the Hipparcos catalog. Angular */ -/* C units are degrees; epochs have units of Julian */ -/* C years and have a reference epoch of J1950. */ -/* C The reference frame is J2000. */ -/* C */ -/* CATNO = 6000 */ - -/* PLXDEG = 0.000001056D0 */ - -/* RADEG0 = 19.290789927D0 */ -/* RAPM = -0.000000720D0 */ -/* RAEPC = 41.2000D0 */ - -/* DECDG0 = 2.015271007D0 */ -/* DECPM = 0.000001814D0 */ -/* DECEPC = 41.1300D0 */ - -/* RFRAME = 'J2000' */ - -/* C */ -/* C Correct the star's direction for proper motion. */ -/* C */ -/* C The argument t represents et0 as Julian years */ -/* C past J1950. */ -/* C */ -/* T = ET0/JYEAR() */ -/* . + ( J2000()- J1950() ) / 365.25D0 */ - -/* DTRA = T - RAEPC */ -/* DTDEC = T - DECEPC */ - -/* RADEG = RADEG0 + DTRA * RAPM */ -/* DECDEG = DECDG0 + DTDEC * DECPM */ - -/* RA = RADEG * RPD() */ -/* DEC = DECDEG * RPD() */ - -/* CALL RADREC ( 1.D0, RA, DEC, PSTAR ) */ - -/* C */ -/* C Correct star position for parallax applicable at */ -/* C the Cassini orbiter's position. (The parallax effect */ -/* C is negligible in this case; we're simply demonstrating */ -/* C the computation.) */ -/* C */ -/* PARLAX = PLXDEG * RPD() */ -/* RSTAR = AU / TAN(PARLAX) */ - -/* C */ -/* C Scale the star's direction vector by its distance from */ -/* C the solar system barycenter. Subtract off the position */ -/* C of the spacecraft relative to the solar system barycenter; */ -/* C the result is the ray's direction vector. */ -/* C */ -/* CALL VSCLIP ( RSTAR, PSTAR ) */ - -/* CALL SPKPOS ( 'CASSINI', ET0, 'J2000', 'NONE', */ -/* . 'SOLAR SYSTEM BARYCENTER', POS, LT ) */ - -/* CALL VSUB ( PSTAR, POS, RAYDIR ) */ - -/* C */ -/* C Correct the star direction for stellar aberration when */ -/* C we conduct the search. */ -/* C */ -/* ABCORR = 'S' */ -/* OBSRVR = 'CASSINI' */ - -/* C */ -/* C Use a particularly short step size to make the progress */ -/* C report's updates visible. */ -/* C */ -/* C Pass the step size (1 second) to the GF default step size */ -/* C put/get system. */ -/* C */ -/* CALL GFSSTP ( 1.D0 ) */ - -/* C */ -/* C Set the convergence tolerance to 1 microsecond. */ -/* C */ -/* TOL = 1.D-6 */ - -/* C */ -/* C Use progress reporting; turn off interrupt handling. */ -/* C */ -/* RPT = .TRUE. */ -/* BAIL = .FALSE. */ - - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Instrument: '//INST */ -/* WRITE (*,*) 'Star''s catalog number: ', CATNO */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFFOVE ( INST, TSHAPE, RAYDIR, */ -/* . TARGET, RFRAME, ABCORR, OBSRVR, TOL, */ -/* . GFSTEP, GFREFN, RPT, GFREPI, GFREPU, */ -/* . GFREPF, BAIL, GFBAIL, CNFINE, RESULT ) */ - -/* N = WNCARD( RESULT ) */ - -/* IF ( N .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'No FOV intersection found.' */ - -/* ELSE */ - -/* WRITE (*,*) */ -/* . ' Visibility start time Stop time' */ - -/* DO I = 1, N */ - -/* CALL WNFETD ( RESULT, I, ENDPT(1), ENDPT(2) ) */ - -/* DO J = 1, 2 */ -/* CALL TIMOUT ( ENDPT(J), TIMFMT, TIMSTR(J) ) */ -/* END DO */ - -/* LINE( :3) = ' ' */ -/* LINE(2: ) = TIMSTR(1) */ -/* LINE(37:) = TIMSTR(2) */ - -/* WRITE (*,*) LINE */ - -/* END DO */ - -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Instrument: CASSINI_ISS_WAC */ -/* Star's catalog number: 6000 */ - -/* Target visibility search 100.00% done. */ - -/* Visibility start time Stop time */ -/* 2004-JUN-11 06:30:00.000000 (TDB) 2004-JUN-11 12:00:00.000000 (TDB) */ - - - -/* $ Restrictions */ - -/* The kernel files to be used by GFFOVE must be loaded (normally via */ -/* the SPICELIB routine FURNSH) before GFFOVE is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 15-APR-2009 (NJB) (LSE) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF mid-level target in instrument FOV search */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* External routines */ - - -/* Local parameters */ - - -/* STEP is a step size initializer for the unused, dummy step size */ -/* argument to ZZGFSOLV. The routine UDSTEP, which is passed to */ -/* ZZGFSOLV, will be used by that routine to obtain the step size. */ - - -/* CSTEP indicates whether a constant step size, provided */ -/* via the input argument STEP, is to be used by ZZGFSOLV. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFFOVE", (ftnlen)6); - -/* Check the result window's size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size must be at least 2 but was #.", (ftnlen) - 48); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21); - chkout_("GFFOVE", (ftnlen)6); - return 0; - } - -/* Empty the RESULT window. */ - - scardd_(&c__0, result); - -/* Check the convergence tolerance. */ - - if (*tol <= 0.) { - setmsg_("Tolerance must be positive but was #.", (ftnlen)37); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(INVALIDTOLERANCE)", (ftnlen)23); - chkout_("GFFOVE", (ftnlen)6); - return 0; - } - -/* Note to maintenance programmer: most input exception checks are */ -/* delegated to ZZGFFVIN. If the implementation of that routine */ -/* changes, or if this routine is modified to call a different */ -/* routine in place of ZZGFFVIN, then the error handling performed */ -/* by ZZGFFVIN will have to be performed here or in a routine called */ -/* by this routine. */ - - -/* Initialize the visibility calculation. */ - - zzgffvin_(inst, tshape, raydir, target, tframe, abcorr, obsrvr, inst_len, - tshape_len, target_len, tframe_len, abcorr_len, obsrvr_len); - if (failed_()) { - chkout_("GFFOVE", (ftnlen)6); - return 0; - } - -/* Prepare the progress reporter if appropriate. */ - - if (*rpt) { - (*udrepi)(cnfine, "Target visibility search ", "done.", (ftnlen)25, ( - ftnlen)5); - } - -/* Cycle over the intervals in the confinement window. */ - - count = wncard_(cnfine); - i__1 = count; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Retrieve the bounds for the Ith interval of the confinement */ -/* window. Search this interval for visibility events. Union the */ -/* result with the contents of the RESULT window. */ - - wnfetd_(cnfine, &i__, &start, &finish); - zzgfsolv_((U_fp)zzgffvst_, (U_fp)udstep, (U_fp)udrefn, bail, (L_fp) - udbail, &c_false, &c_b16, &start, &finish, tol, rpt, (U_fp) - udrepu, result); - if (failed_()) { - chkout_("GFFOVE", (ftnlen)6); - return 0; - } - if (*bail) { - -/* Interrupt handling is enabled. */ - - if ((*udbail)()) { - -/* An interrupt has been issued. Return now regardless of */ -/* whether the search has been completed. */ - - chkout_("GFFOVE", (ftnlen)6); - return 0; - } - } - } - -/* End the progress report. */ - - if (*rpt) { - (*udrepf)(); - } - chkout_("GFFOVE", (ftnlen)6); - return 0; -} /* gffove_ */ - diff --git a/ext/spice/src/cspice/gffove_c.c b/ext/spice/src/cspice/gffove_c.c deleted file mode 100644 index 119bdef061..0000000000 --- a/ext/spice/src/cspice/gffove_c.c +++ /dev/null @@ -1,1638 +0,0 @@ -/* - --Procedure gffove_c ( GF, is target in FOV? ) - --Abstract - - Determine time intervals when a specified target body or ray - intersects the space bounded by the field-of-view (FOV) of a - specified instrument. Report progress and handle interrupts if so - commanded. - --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 - - CK - FRAMES - GF - KERNEL - NAIF_IDS - PCK - SPK - TIME - WINDOWS - --Keywords - - EVENT - FOV - GEOMETRY - INSTRUMENT - SEARCH - WINDOW - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZad.h" - #include "SpiceZmc.h" - #undef gffove_c - - void gffove_c ( ConstSpiceChar * inst, - ConstSpiceChar * tshape, - ConstSpiceDouble raydir [3], - ConstSpiceChar * target, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - SPICE_GF_MARGIN - P Minimum complement of FOV cone angle. - SPICE_GF_CNVTOL - P Convergence tolerance. - SPICE_GF_MAXVRT - P Maximum number of FOV boundary vertices. - inst I Name of the instrument. - tshape I Type of shape model used for target body. - raydir I Ray's direction vector. - target I Name of the target body. - tframe I Body-fixed, body-centered frame for target body. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - tol I Convergence tolerance in seconds. - udstep I Name of the routine returns a time step. - udrefn I Name of the routine that computes a refined time. - rpt I Progress report flag. - udrepi I Function that initializes progress reporting. - udrepu I Function that updates the progress report. - udrepf I Function that finalizes progress reporting. - bail I Logical indicating program interrupt monitoring. - udbail I Name of a routine that signals a program interrupt. - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - --Detailed_Input - - inst indicates the name of an instrument, such as a - spacecraft-mounted framing camera, the field of view - (FOV) of which is to be used for a target intersection - search: times when the specified target intersects the - region of space corresponding to the FOV are sought. - - `inst' must have a corresponding NAIF ID and a frame - defined, as is normally done in a frame kernel. It - must also have an associated reference frame and a FOV - shape, boresight and boundary vertices (or reference - vector and reference angles) defined, as is usually - done in an instrument kernel. - - See the header of the CSPICE routine getfov_c for a - description of the required parameters associated with - an instrument. - - - tshape is a string indicating the geometric model used to - represent the location and shape of the target body. - The target body may be represented by either an - ephemeris object or a ray emanating from the observer. - - The supported values of `tshape' are: - - "ELLIPSOID" The target is an ephemeris object. - - The target's shape is represented - using triaxial ellipsoid model, - with radius values provided via the - kernel pool. A kernel variable - having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF - integer code associated with the - body, must be present in the kernel - pool. This variable must be - associated with three numeric - values giving the lengths of the - ellipsoid's X, Y, and Z semi-axes. - - "POINT" The target is an ephemeris object. - The body is treated as a single - point. - - "RAY" The target is NOT an ephemeris - object. Instead, the target is - represented by the ray emanating from - the observer's location and having - direction vector `raydir'. The target - is considered to be visible if and - only if the ray is contained within - the space bounded by the instrument - FOV. - - Case and leading or trailing blanks are not - significant in the string `tshape'. - - - raydir is the direction vector associated with a ray - representing the target. `raydir' is used if and only - if `tshape' (see description above) indicates the - target is modeled as a ray. - - - target is the name of the target body, the appearances of - which in the specified instrument's field of view are - sought. The body must be an ephemeris object. - - Optionally, you may supply the integer NAIF ID code - for the body as a string. For example both "MOON" and - "301" are legitimate strings that designate the Moon. - - Case and leading or trailing blanks are not - significant in the string `target'. - - The input argument `target' is used if and only if the - target is NOT modeled as ray, as indicated by the - input argument `tshape'. - - `target' may be set to a blank string if the target is - modeled as a ray. - - - tframe is the name of the reference frame associated with the - target. Examples of such names are "IAU_SATURN" - (for Saturn) and "ITRF93" (for the Earth). - - If the target is an ephemeris object modeled as an - ellipsoid, `tframe' must designate a body-fixed - reference frame centered on the target body. - - If the target is an ephemeris object modeled as a point, - `tframe' is ignored; `tframe' should be left blank. - - If the target is modeled as a ray, `tframe' may - designate any reference frame. Since light time - corrections are not supported for rays, the - orientation of the frame is always evaluated at the - epoch associated with the observer, as opposed to the - epoch associated with the light-time corrected - position of the frame center. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `tframe'. - - - abcorr indicates the aberration corrections to be applied - when computing the target's position and orientation. - The supported values of `abcorr' depend on the target - representation. - - If the target is represented by a ray, the aberration - correction options are - - "NONE" No correction. - "S" Stellar aberration correction, - reception case. - "XS" Stellar aberration correction, - transmission case. - - If the target is an ephemeris object, the aberration - correction options are those supported by the SPICE - SPK system. For remote sensing applications, where the - apparent position and orientation of the target seen - by the observer are desired, normally either of the - corrections - - 'LT+S' - 'CN+S' - - should be used. These and the other supported options - are described below. - - Supported aberration correction options for - observation (the case where radiation is received by - observer at ET) are: - - "NONE" No correction. - "LT" Light time only - 'LT+S' Light time and stellar aberration. - "CN" Converged Newtonian (CN) light time. - 'CN+S' CN light time and stellar aberration. - - Supported aberration correction options for - transmission (the case where radiation is emitted from - observer at ET) are: - - "XLT" Light time only. - 'XLT+S' Light time and stellar aberration. - "XCN" Converged Newtonian (CN) light time. - 'XCN+S' CN light time and stellar aberration. - - For detailed information, see the geometry finder - required reading, gf.req. - - Case, leading and trailing blanks are not significant - in the string `abcorr'. - - - obsrvr is the name of the body from which the target is - observed. The instrument designated by `inst' is treated - as if it were co-located with the observer. - - Optionally, you may supply the integer NAIF ID code - for the body as a string. - - Case and leading or trailing blanks are not - significant in the string `obsrvr'. - - - tol is a tolerance value used to determine convergence of - root-finding operations. `tol' is measured in TDB seconds - and must be greater than zero. - - - udstep is an externally specified routine that computes a time - step used to find transitions of the state being - considered. A state transition occurs where the state - changes from being "in view" to being "not in view" or - vice versa. - - This routine relies on `udstep' returning step sizes - small enough so that state transitions within the - confinement window are not overlooked. - - The prototype for `udstep' is - - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ) - - where: - - et is the input start time from which the - algorithm is to search forward for a state - transition. `et' is expressed as seconds past - J2000 TDB. - - step is the output step size. `step' indicates - how far to advance `et' so that `et' and - et+step may bracket a state transition and - definitely do not bracket more than one - state transition. Units are TDB seconds. - - If a constant step size is desired, the CSPICE routine - - gfstep_c - - may be used as the step size function. If gfstep_c is - used, the step size must be set by calling gfsstp_c prior - to calling this routine. - - - udrefn is the name of the externally specified routine that - computes a refinement in the times that bracket a - transition point. In other words, once a pair of - times have been detected such that the system is in - different states at each of the two times, `udrefn' - selects an intermediate time which should be closer to - the transition state than one of the two known times. - The prototype for `udrefn' is: - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ) - - where the inputs are: - - t1 is a time when the visibility state is `s1'. `t1' - is expressed as seconds past J2000 TDB. - - t2 is a time when the system is in state `s2'. `t2' - is expressed as seconds past J2000 TDB. `t2' is - assumed to be larger than `t1'. - - s1 is the visibility state at time at time t1. - - s2 is the visibility state at time at time t2. - - The output is: - - t is next time to check for a state transition. - `t' is a number between `t1' and `t2'. `t' is - expressed as seconds past J2000 TDB. - - If a simple bisection method is desired, the CSPICE routine - gfrefn_c may be used as the refinement function. - - - rpt is a logical variable that controls whether - progress reporting is enabled. When `rpt' is SPICETRUE, - progress reporting is enabled and the routines - udrepi, udrepu, and udpref (see descriptions below) - are used to report progress. - - - udrepi is a user-defined subroutine that initializes a - progress report. When progress reporting is - enabled, `udrepi' is called at the start - of a search. The prototype for `udrefi' is - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ) - - where - - cnfine - - is a confinement window specifying the time period - over which a search is conducted, and - - srcpre - srcsuf - - are prefix and suffix strings used in the progress - report: these strings are intended to bracket a - representation of the fraction of work done. For - example, when the CSPICE progress reporting functions - are used, if srcpre and srcsuf are, respectively, - - "FOV search" - "done." - - the progress report display at the end of - the search will be: - - FOV search 100.00% done. - - The CSPICE routine gfrepi_c may be used as the - actual argument corresponding to `udrepi'. If so, - the CSPICE routines gfrepu_c and gfrepf_c must be - the actual arguments corresponding to `udrepu' and - `udrepf'. - - - udrepu is a user-defined subroutine that updates the - progress report for a search. The prototype - of `udrepu' is - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ) - - In order for a meaningful progress report to be displayed, - `ivbeg' and `ivend' must satisfy the following constraints: - - - `ivbeg' must be less than or equal to `ivend'. - - - Over a search, the sum of the differences - - ivend - ivbeg - - for all calls to this routine made during the search - must equal the measure (that is, the sum of the - lengths of the intervals) of the confinement window - `cnfine'. - - `et' is the current time reached in the search for an event. - `et' must lie in the interval - - ivbeg : ivend - - inclusive. The input values of `et' for a given interval - need not form an increasing sequence. - - The CSPICE routine gfrepu_c may be used as the actual - argument corresponding to `udrepu'. If so, the CSPICE - routines gfrepi_c and gfrepf_c must be the actual - arguments corresponding to `udrepi' and `udrepf'. - - - udrepf is a user-defined subroutine that finalizes a progress - report. `udrepf' has no arguments. - - The CSPICE routine gfrepf_c may be used as the actual - argument corresponding to `udrepf'. If so, the CSPICE - routines gfrepi_c and gfrepu_c must be the actual - arguments corresponding to `udrepi' and `udrepu'. - - - bail is a logical variable indicating whether or not interrupt - handling is enabled. When `bail' is set to SPICETRUE, the - input function `udbail' (see description below) is used - to determine whether an interrupt has been issued. - - - udbail is the name of a user defined logical function that - indicates whether an interrupt signal has been issued - (for example, from the keyboard). udbail has the - prototype - - SpiceBoolean ( * udbail ) ( void ) - - The return value is SPICETRUE if an interrupt has - been issued; otherwise the value is SPICEFALSE. - - gffove_c uses `udbail' only when `bail' (see above) is set - to SPICETRUE, indicating that interrupt handling is - enabled. When interrupt handling is enabled, gffove_c - and routines in its call tree will call `udbail' to - determine whether to terminate processing and return - immediately. - - If the user doesn't wish to provide a custom interrupt - handling function, the CSPICE routine - - gfbail_c - - may be used. - - The function `udbail' will be usually be tested - multiple times by the GF system between the time - an interrupt is issued and the time when - control is returned to the calling program, so - `udbail' nmust continue to return SPICETRUE - until explicitly reset by the calling application. - So `udbail' must provide a "reset" mechanism." - In the case of gfbail_c, the reset function is - - gfclrh_c - - If interrupt handing is not enabled, a logical - function must still be passed to gffove_c as - an input argument. The CSPICE function - - gfbail_c - - may be used for this purpose. - - See the Examples header section below for a complete code - example demonstrating use of the CSPICE interrupt - handling capability. - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - The endpoints of the time intervals comprising `cnfine' - are interpreted as seconds past J2000 TDB. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - specified target intersection with the FOV occurs. - - The endpoints of the time intervals comprising `result' - are interpreted as seconds past J2000 TDB. - - If `result' is non-empty on input, its contents - will be discarded before gffove_c conducts its - search. - --Parameters - - - All parameters described here are declared in the header file - SpiceGF.h. See that file for parameter values. - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL; the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found by - this routine depends on the accuracy of the input data. - In most cases, the accuracy of solutions will be inferior - to their precision. - - - SPICE_GF_MAXVRT - - is the maximum number of vertices that may be used - to define the boundary of the specified instrument's - field of view. - - - SPICE_GF_MARGIN - - is a small positive number used to constrain the - orientation of the boundary vectors of polygonal - FOVs. Such FOVs must satisfy the following constraints: - - 1) The boundary vectors must be contained within - a right circular cone of angular radius less - than than (pi/2) - SPICE_GF_MARGIN radians; in other - words, there must be a vector A such that all - boundary vectors have angular separation from - A of less than (pi/2)-SPICE_GF_MARGIN radians. - - 2) There must be a pair of boundary vectors U, V - such that all other boundary vectors lie in the - same half space bounded by the plane containing U - and V. Furthermore, all other boundary vectors - must have orthogonal projections onto a specific - plane normal to this plane (the normal plane - contains the angle bisector defined by U and V) - such that the projections have angular separation - of at least 2*SPICE_GF_MARGIN radians from the - plane spanned by U and V. - - See header file SpiceGF.h for declarations and descriptions of - parameters used throughout the GF system. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, the error - SPICE(INVALIDSTEPSIZE) will be signaled. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If the name of either the target or observer cannot be - translated to a NAIF ID code, the error will be diagnosed by - a routine in the call tree of this routine. - - 4) If the specified aberration correction is not a supported value - for the target type (ephemeris object or ray), the error will be - diagnosed by a routine in the call tree of this routine. - - 5) If the radii of a target body modeled as an ellipsoid cannot - be determined by searching the kernel pool for a kernel - variable having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF integer code associated with - the body, the error will be diagnosed by a routine in the - call tree of this routine. - - 6) If the target body coincides with the observer body `obsrvr', - the error will be diagnosed by a routine in the call tree of - this routine. - - 7) If the body model specifier `tshape' is not recognized, the - error will be diagnosed by a routine in the call tree of this - routine. - - 8) If a target body-fixed reference frame associated with a - non-point target is not recognized, the error will be - diagnosed by a routine in the call tree of this routine. - - 9) If a target body-fixed reference frame is not centered at - the corresponding target body, the error will be - diagnosed by a routine in the call tree of this routine. - - 10) If the instrument name `inst' does not have corresponding NAIF - ID code, the error will be diagnosed by a routine in the call - tree of this routine. - - 11) If the FOV parameters of the instrument are not present in - the kernel pool, the error will be be diagnosed by routines - in the call tree of this routine. - - 12) If the FOV boundary has more than SPICE_GF_MAXVRT vertices, - the error will be be diagnosed by routines in the call tree of - this routine. - - 13) If the instrument FOV is polygonal, and this routine cannot - find a ray R emanating from the FOV vertex such that maximum - angular separation of R and any FOV boundary vector is within - the limit (pi/2)-SPICE_GF_MARGIN radians, the error will be - diagnosed by a routine in the call tree of this routine. If the - FOV is any other shape, the same error check will be applied - with the instrument boresight vector serving the role of R. - - 14) If the loaded kernels provide insufficient data to compute a - requested state vector, the error will be diagnosed by a - routine in the call tree of this routine. - - 15) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - - 16) If the output SPICE window `result' has insufficient capacity - to contain the number of intervals on which the specified - visibility condition is met, the error will be diagnosed - by a routine in the call tree of this routine. - - 17) If the convergence tolerance size is non-positive, the error - SPICE(INVALIDTOLERANCE) will be signaled. - - 18) If the step size is non-positive, the error - SPICE(INVALIDSTEP) will be signaled. - - 19) If the ray's direction vector is zero, the error - SPICE(ZEROVECTOR) is signaled. - - 20) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 21) If any input string argument other than `tframe', `target', - or `obsrvr' is empty, the error SPICE(EMPTYSTRING) will be - signaled. - - 22) If any attempt to change the handler for the interrupt - signal SIGINT fails, the error SPICE(SIGNALFAILURE) is - signaled. - - 23) If operation of this routine is interrupted, the output result - window will be invalid. - --Files - - Appropriate SPICE kernels must be loaded by the - calling program before this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target and observer that - describes the ephemeris of these objects for the period - defined by the confinement window, `cnfine' must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - Frame data: if a frame definition is required to convert - the observer and target states to the body-fixed frame of - the target, that definition must be available in the kernel - pool. Typically the definitions of frames not already - built-in to SPICE are supplied by loading a frame kernel. - - Data defining the reference frame associated with the - instrument designated by `inst' must be available in the kernel - pool. Additionally the name `inst' must be associated with an - ID code. Normally these data are made available by loading - a frame kernel via furnsh_c. - - - IK data: the kernel pool must contain data such that - the CSPICE routine getfov_c may be called to obtain - parameters for `inst'. Normally such data are provided by - an IK via furnsh_c. - - The following data may be required: - - - PCK data: bodies modeled as triaxial ellipsoids must have - orientation data provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file via furnsh_c. - - Bodies modeled as triaxial ellipsoids must have semi-axis - lengths provided by variables in the kernel pool. Typically - these data are made available by loading a text PCK file via - furnsh_c. - - - CK data: if the instrument frame is fixed to a spacecraft, - at least one CK file will be needed to permit transformation - of vectors between that frame and both J2000 and the target - body-fixed frame. - - - SCLK data: if a CK file is needed, an associated SCLK - kernel is required to enable conversion between encoded SCLK - (used to time-tag CK data) and barycentric dynamical time - (TDB). - - - Since the input ray direction may be expressed in any - frame, FKs, CKs, SCLK kernels, PCKs, and SPKs may be - required to map the direction to the J2000 frame. - - Kernel data are normally loaded once per program run, NOT every - time this routine is called. - --Particulars - - This routine determines a set of one or more time intervals within - the confinement window when a specified ray or any portion of a - specified target body appears within the field of view of a - specified instrument. We'll use the term "visibility event" to - designate such an appearance. The set of time intervals resulting - from the search is returned as a SPICE window. - - This routine provides the SPICE GF system's most flexible - interface for searching for FOV intersection events. - - Applications that require do not require support for progress - reporting, interrupt handling, non-default step or refinement - functions, or non-default convergence tolerance normally should - call either gftfov_c or gfrfov_c rather than this routine. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient use - of this routine in user applications. - - - The Search Process - ================== - - The search for visibility events is treated as a search for state - transitions: times are sought when the state of the target ray or - body changes from "not visible" to "visible" or vice versa. - - Step Size - ========= - - Each interval of the confinement window is searched as follows: - first, the input step size is used to determine the time - separation at which the visibility state will be sampled. - Starting at the left endpoint of an interval, samples will be - taken at each step. If a state change is detected, a root has - been bracketed; at that point, the "root"--the time at which the - state change occurs---is found by a refinement process, for - example, via binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the visibility state is constant: - the step size should be shorter than the shortest visibility event - duration and the shortest period between visibility events, within - the confinement window. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - The times of state transitions are called ``roots.'' - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. This - refinement process terminates when the location of the root has been - determined to within an error margin called the "convergence - tolerance." - - The convergence tolerance used by high-level GF routines that call - this routine is set via the parameter SPICE_GF_CNVTOL, which is - declared in the header file SpiceGF.h. The value of SPICE_GF_CNVTOL - is set to a "tight" value so that the tolerance doesn't become the - limiting factor in the accuracy of solutions found by this routine. - In general the accuracy of input data will be the limiting factor. - - Setting the input tolerance `tol' tighter than SPICE_GF_CNVTOL is - unlikely to be useful, since the results are unlikely to be more - accurate. Making the tolerance looser will speed up searches - somewhat, since a few convergence steps will be omitted. However, in - most cases, the step size is likely to have a much greater effect on - processing time than would the convergence tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the confinement - window can, in some cases, be used to make searches more efficient. - Sometimes it's possible to do an efficient search to reduce the size - of the time period over which a relatively slow search of interest - must be performed. For an example, see the program CASCADE in the - GF Example Programs chapter of the GF Required Reading, gf.req. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Conduct a search using default GF progress reporting - and interrupt handling capabilities. - - The program will use console I/O to display a simple - ASCII-based progress report. - - The program will trap keyboard interrupts (on most systems, - generated by typing the "control C" key combination). This - feature can be used in non-trivial applications to allow - the application to continue after a search as been interrupted. - - Search for times when Saturn's satellite Phoebe is within - the FOV of the Cassini narrow angle camera (CASSINI_ISS_NAC). - To simplify the problem, restrict the search to a short time - period where continuous Cassini bus attitude data are - available. - - Use a step size of 1 second to reduce chances of missing - short visibility events. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - - KPL/MK - - File name: gffove_ex1.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - naif0009.tls Leapseconds - cpck05Mar2004.tpc Satellite orientation and - radii - 981005_PLTEPH-DE405S.bsp Planetary ephemeris - 020514_SE_SAT105.bsp Satellite ephemeris - 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris - cas_v37.tf Cassini FK - 04135_04171pc_psiv2.bc Cassini bus CK - cas00084.tsc Cassini SCLK kernel - cas_iss_v09.ti Cassini IK - - - \begindata - - KERNELS_TO_LOAD = ( 'naif0009.tls', - 'cpck05Mar2004.tpc', - '981005_PLTEPH-DE405S.bsp', - '020514_SE_SAT105.bsp', - '030201AP_SK_SM546_T45.bsp', - 'cas_v37.tf', - '04135_04171pc_psiv2.bc', - 'cas00084.tsc', - 'cas_iss_v09.ti' ) - \begintext - - - - Example code begins here. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - PROGRAM EX1 - ./ - - /. - Local constants - ./ - #define META "gffove_ex1.tm" - #define TIMFMT "YYYY-MON-DD HR:MN:SC.######::TDB (TDB)" - #define TIMLEN 41 - #define MAXWIN 10000 - #define TIMTOL 1.e-6 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceBoolean bail; - SpiceBoolean rpt; - - SpiceChar * abcorr; - SpiceChar * inst; - SpiceChar * obsrvr; - SpiceChar * target; - SpiceChar * tframe; - SpiceChar timstr [2][ TIMLEN ]; - SpiceChar * tshape; - - SpiceDouble endpt [2]; - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble raydir [3]; - - SpiceInt i; - SpiceInt j; - SpiceInt n; - - /. - Load kernels. - ./ - furnsh_c ( META ); - - /. - Insert search time interval bounds into the - confinement window. - ./ - str2et_c ( "2004 JUN 11 06:30:00 TDB", &et0 ); - str2et_c ( "2004 JUN 11 12:00:00 TDB", &et1 ); - - wninsd_c ( et0, et1, &cnfine ); - - /. - Initialize inputs for the search. - ./ - inst = "CASSINI_ISS_NAC"; - target = "PHOEBE"; - tshape = "ELLIPSOID"; - tframe = "IAU_PHOEBE"; - abcorr = "LT+S"; - obsrvr = "CASSINI"; - - /. - Select a 1-second step. We'll ignore any target - appearances lasting less than 1 second. - ./ - gfsstp_c ( 1.0 ); - - printf ( "\n" - "Instrument: %s\n" - "Target: %s\n", - inst, - target ); - - /. - Turn on interrupt handling and progress reporting. - ./ - bail = SPICETRUE; - rpt = SPICETRUE; - - /. - Perform the search. - ./ - gffove_c ( inst, tshape, raydir, target, tframe, - abcorr, obsrvr, TIMTOL, gfstep_c, gfrefn_c, - rpt, gfrepi_c, gfrepu_c, gfrepf_c, bail, - gfbail_c, &cnfine, &result ); - - if ( gfbail_c() ) - { - /. - Clear the CSPICE interrupt indication. This is - an essential step for programs that continue - running after an interrupt; gfbail_c will - continue to return SPICETRUE until this step - has been performed. - ./ - gfclrh_c(); - - /. - We've trapped an interrupt signal. In a realistic - application, the program would continue operation - from this point. In this simple example, we simply - display a message and quit. - ./ - printf ( "\nSearch was interrupted.\n\nThis message " - "was written after an interrupt signal\n" - "was trapped. By default, the program " - "would have terminated \nbefore this message " - "could be written.\n\n" ); - } - else - { - - n = wncard_c ( &result ); - - if ( n == 0 ) - { - printf ( "No FOV intersection found.\n" ); - } - else - { - printf ( " Visibility start time Stop time\n" ); - - for ( i = 0; i < n; i++ ) - { - wnfetd_c ( &result, i, endpt, endpt+1 ); - - for ( j = 0; j < 2; j++ ) - { - timout_c ( endpt[j], TIMFMT, TIMLEN, timstr[j] ); - } - - printf ( " %s %s\n", timstr[0], timstr[1] ); - } - } - - printf ( "\n" ); - - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - progress report had the format shown below: - - Target visibility search 2.66% done. - - The completion percentage was updated approximately once per - second. - - When this program completed execution, the output was: - - - Instrument: CASSINI_ISS_NAC - Target: PHOEBE - - Target visibility search 100.00% done. - - Visibility start time Stop time - 2004-JUN-11 07:35:49.958590 (TDB) 2004-JUN-11 08:48:27.485965 (TDB) - 2004-JUN-11 09:03:19.767799 (TDB) 2004-JUN-11 09:35:27.634790 (TDB) - 2004-JUN-11 09:50:19.585474 (TDB) 2004-JUN-11 10:22:27.854254 (TDB) - 2004-JUN-11 10:37:19.332696 (TDB) 2004-JUN-11 11:09:28.116016 (TDB) - 2004-JUN-11 11:24:19.049484 (TDB) 2004-JUN-11 11:56:28.380304 (TDB) - - - - 2) A variation of example (1): search the same confinement - window for times when a selected background star is visible. - We use the FOV of the Cassini ISS wide angle camera - (CASSINI_ISS_WAC) to enhance the probability of viewing the - star. - - The star we'll use has catalog number 6000 in the Hipparcos - Catalog. The star's J2000 right ascension and declination, - proper motion, and parallax are taken from that catalog. - - Use the meta-kernel from the first example. - - Example code begins here. - - - #include - #include - #include "SpiceUsr.h" - - int main() - { - /. - PROGRAM EX2 - ./ - - /. - Local constants - ./ - #define META "gffove_ex1.tm" - #define TIMFMT "YYYY-MON-DD HR:MN:SC.######::TDB (TDB)" - #define TIMLEN 41 - #define MAXWIN 10000 - #define TIMTOL 1.e-6 - #define AU 149597870.693 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceBoolean bail; - SpiceBoolean rpt; - - SpiceChar * abcorr; - SpiceChar * inst; - SpiceChar * obsrvr; - SpiceChar * rframe; - SpiceChar * target; - SpiceChar timstr [2][ TIMLEN ]; - SpiceChar * tshape; - - SpiceDouble dec; - SpiceDouble decdeg; - SpiceDouble decdg0; - SpiceDouble decepc; - SpiceDouble decpm; - SpiceDouble dtdec; - SpiceDouble dtra; - SpiceDouble endpt [2]; - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble lt; - SpiceDouble parlax; - SpiceDouble plxdeg; - SpiceDouble pos [3]; - SpiceDouble pstar [3]; - SpiceDouble ra; - SpiceDouble radeg0; - SpiceDouble radeg; - SpiceDouble raepc; - SpiceDouble rapm; - SpiceDouble raydir [3]; - SpiceDouble rstar; - SpiceDouble t; - - SpiceInt catno; - SpiceInt i; - SpiceInt j; - SpiceInt n; - - /. - Load kernels. - ./ - furnsh_c ( META ); - - /. - Insert search time interval bounds into the - confinement window. - ./ - str2et_c ( "2004 JUN 11 06:30:00 TDB", &et0 ); - str2et_c ( "2004 JUN 11 12:00:00 TDB", &et1 ); - - wninsd_c ( et0, et1, &cnfine ); - - /. - Initialize inputs for the search. - ./ - inst = "CASSINI_ISS_WAC"; - target = " "; - tshape = "RAY"; - - /. - Create a unit direction vector pointing from - observer to star. We'll assume the direction - is constant during the confinement window, and - we'll use et0 as the epoch at which to compute the - direction from the spacecraft to the star. - - The data below are for the star with catalog - number 6000 in the Hipparcos catalog. Angular - units are degrees; epochs have units of Julian - years and have a reference epoch of J1950. - The reference frame is J2000. - ./ - catno = 6000; - - plxdeg = 0.000001056; - - radeg0 = 19.290789927; - rapm = -0.000000720; - raepc = 41.2000; - - decdg0 = 2.015271007; - decpm = 0.000001814; - decepc = 41.1300; - - rframe = "j2000"; - - /. - Correct the star's direction for proper motion. - - The argument t represents et0 as Julian years - past J1950. - ./ - t = ( et0 / jyear_c() ) - + ( j2000_c()- j1950_c() ) / 365.25; - - dtra = t - raepc; - dtdec = t - decepc; - - radeg = radeg0 + dtra * rapm; - decdeg = decdg0 + dtdec * decpm; - - ra = radeg * rpd_c(); - dec = decdeg * rpd_c(); - - radrec_c ( 1.0, ra, dec, pstar ); - - /. - Correct star position for parallax applicable at - the Cassini orbiter's position. (The parallax effect - is negligible in this case; we're simply demonstrating - the computation.) - ./ - parlax = plxdeg * rpd_c(); - rstar = AU / tan(parlax); - - /. - Scale the star's direction vector by its distance from - the solar system barycenter. Subtract off the position - of the spacecraft relative to the solar system barycenter; - the result is the ray's direction vector. - ./ - vscl_c ( rstar, pstar, pstar ); - - spkpos_c ( "cassini", et0, "j2000", "none", - "solar system barycenter", pos, < ); - - vsub_c ( pstar, pos, raydir ); - - /. - Correct the star direction for stellar aberration when - we conduct the search. - ./ - abcorr = "S"; - obsrvr = "CASSINI"; - - /. - Select a 1-second step. We'll ignore any target - appearances lasting less than 1 second. - ./ - gfsstp_c ( 1.0 ); - - /. - Turn on interrupt handling and progress reporting. - ./ - bail = SPICETRUE; - rpt = SPICETRUE; - - - printf ( "\n" - "Instrument: %s\n" - "Star's catalog number: %ld\n", - inst, - catno ); - - /. - Perform the search. - ./ - gffove_c ( inst, tshape, raydir, target, rframe, - abcorr, obsrvr, TIMTOL, gfstep_c, gfrefn_c, - rpt, gfrepi_c, gfrepu_c, gfrepf_c, bail, - gfbail_c, &cnfine, &result ); - - if ( gfbail_c() ) - { - /. - Clear the CSPICE interrupt indication. This is - an essential step for programs that continue - running after an interrupt; gfbail_c will - continue to return SPICETRUE until this step - has been performed. - ./ - gfclrh_c(); - - /. - We've trapped an interrupt signal. In a realistic - application, the program would continue operation - from this point. In this simple example, we simply - display a message and quit. - ./ - printf ( "\nSearch was interrupted.\n\nThis message " - "was written after an interrupt signal\n" - "was trapped. By default, the program " - "would have terminated \nbefore this message " - "could be written.\n\n" ); - } - else - { - - n = wncard_c ( &result ); - - if ( n == 0 ) - { - printf ( "No FOV intersection found.\n" ); - } - else - { - printf ( " Visibility start time Stop time\n" ); - - for ( i = 0; i < n; i++ ) - { - wnfetd_c ( &result, i, endpt, endpt+1 ); - - for ( j = 0; j < 2; j++ ) - { - timout_c ( endpt[j], TIMFMT, TIMLEN, timstr[j] ); - } - - printf ( " %s %s\n", timstr[0], timstr[1] ); - } - } - - printf ( "\n" ); - - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Instrument: CASSINI_ISS_WAC - Star's catalog number: 6000 - - Target visibility search 100.00% done. - - Visibility start time Stop time - 2004-JUN-11 06:30:00.000000 (TDB) 2004-JUN-11 12:00:00.000000 (TDB) - - - --Restrictions - - The kernel files to be used by gffove_c must be loaded (normally via - the CSPICE routine furnsh_c) before gffove_c is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 15-APR-2009 (NJB) (EDW) - --Index_Entries - - GF low-level target in instrument FOV search - --& -*/ - -{ /* Begin gffove_c */ - - - /* - Prototypes - */ - void ( * defSigHandler ) (int); - void ( * sigPtr ) (int); - - /* - Local variables - */ - logical interrupt; - logical rep; - - SpiceBoolean newHandler; - - SpiceChar * obsStr; - SpiceChar * targStr; - SpiceChar * tFrameStr; - - /* - Static variables - */ - static const SpiceChar * blankStr = " "; - - - - /* - Participate in error tracing. - */ - chkin_c ( "gffove_c" ); - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gffove_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Make sure the frame name, target, and observer pointers - are non-null. - */ - CHKPTR ( CHK_STANDARD, "gffove_c", tframe ); - CHKPTR ( CHK_STANDARD, "gffove_c", target ); - CHKPTR ( CHK_STANDARD, "gffove_c", obsrvr ); - - /* - The input frame name, observer name, and target name are special - cases because we allow the caller to pass in an empty strings for - any of these. If any of one of these strings is empty, we pass in - its place a null-terminated string containing one blank character to - the underlying f2c'd routine. - */ - if ( tframe[0] ) - { - tFrameStr = (SpiceChar *) tframe; - } - else - { - tFrameStr = (SpiceChar *) blankStr; - } - - if ( target[0] ) - { - targStr = (SpiceChar *) target; - } - else - { - targStr = (SpiceChar *) blankStr; - } - - if ( obsrvr[0] ) - { - obsStr = (SpiceChar *) obsrvr; - } - else - { - obsStr = (SpiceChar *) blankStr; - } - - - /* - Check the other input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gffove_c", inst ); - CHKFSTR ( CHK_STANDARD, "gffove_c", tshape ); - CHKFSTR ( CHK_STANDARD, "gffove_c", abcorr ); - - rep = (logical) rpt; - interrupt = (logical) bail; - - - /* - Store the input function pointers so these functions can be - called by the GF adapters. - */ - zzadsave_c ( UDSTEP, (void *)(udstep) ); - zzadsave_c ( UDREFN, (void *)(udrefn) ); - zzadsave_c ( UDREPF, (void *)(udrepf) ); - zzadsave_c ( UDREPI, (void *)(udrepi) ); - zzadsave_c ( UDREPU, (void *)(udrepu) ); - zzadsave_c ( UDBAIL, (void *)(udbail) ); - - - /* - If interrupt handling is enabled, and if the default bail-out - routine gfbail_c is being used, set the SPICE interrupt - handler. - */ - - newHandler = SPICEFALSE; - - if ( bail ) - { - newHandler = ( (void *)udbail == (void *)gfbail_c ); - - if ( newHandler ) - { - defSigHandler = signal ( SIGINT, gfinth_c ); - - if ( defSigHandler == SIG_ERR ) - { - setmsg_c ( "Attempt to establish the CSPICE routine " - "gfinth_c as the handler for the interrupt " - "signal SIGINT failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - chkout_c ( "gffove_c" ); - return; - } - } - } - - gffove_ ( ( char * ) inst, - ( char * ) tshape, - ( doublereal * ) raydir, - ( char * ) target, - ( char * ) tFrameStr, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) &tol, - ( U_fp ) zzadstep_c, - ( U_fp ) zzadrefn_c, - ( logical * ) &rep, - ( S_fp ) zzadrepi_c, - ( U_fp ) zzadrepu_c, - ( S_fp ) zzadrepf_c, - ( logical * ) &interrupt, - ( L_fp ) zzadbail_c, - ( doublereal * ) (cnfine->base), - ( doublereal * ) (result->base), - ( ftnlen ) strlen(inst), - ( ftnlen ) strlen(tshape), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(tframe), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - /* - If we've changed the signal handler, restore the previous one. - */ - if ( newHandler ) - { - sigPtr = signal ( SIGINT, defSigHandler ); - - if ( sigPtr == SIG_ERR ) - { - setmsg_c ( "Attempt to restore the previous handler " - "for the interrupt signal SIGINT failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - chkout_c ( "gffove_c" ); - return; - } - } - - /* - Sync the output result cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ); - } - - chkout_c ( "gffove_c" ); - -} /* End gffove_c */ diff --git a/ext/spice/src/cspice/gfinth_c.c b/ext/spice/src/cspice/gfinth_c.c deleted file mode 100644 index d34cfe5ffc..0000000000 --- a/ext/spice/src/cspice/gfinth_c.c +++ /dev/null @@ -1,233 +0,0 @@ -/* - --Procedure gfinth_c ( GF, interrupt signal handler ) - --Abstract - - Respond to the interrupt signal SIGINT: save an indication - that the signal has been received. This routine restores - itself as the handler for SIGINT. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include - #include "SpiceUsr.h" - - - void gfinth_c ( int sigcode ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - sigcode I Interrupt signal ID code. - --Detailed_Input - - sigcode is a signal code. `sigcode' is expected to be the - ANSI C parameter SIGINT, which represents the - interrupt signal. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If `sigcode' is not SIGINT, the error SPICE(INVALIDSIGNAL) - is signaled (in the SPICE error handling sense). - - 2) If the call to the ANSI C function `signal' made - by this routine fails, the error SPICE(SIGNALFAILED) - is signaled (via SPICE error handling). - --Files - - None. - --Particulars - - This interrupt handler should be used by routines that - participate in GF interrupt handling. Such routines should - call the ANSI C library routine `signal' with the ANSI C - macro SIGINT and this routine as the input arguments. - - When this routine executes, it re-establishes itself as the - handler for the interrupt signal SIGINT. Code that uses - CSPICE interrupt handling must restore the previous - handler before returning. - - Once this routine is established as the handler for the - interrupt signal SIGINT, the GF "bail out" test routine - gfbail_c will return SPICETRUE until the interrupt status - is cleared via a call to gfclrh_c. - --Examples - - 1) Make this routine the GF signal handler, then restore - the previous handler. This example serves only to - demonstrate the use of signal; the example code - performs no useful function. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Prototypes - ./ - static void ( * previousHandler )(int); - static void ( * handlerPtr )(int); - - /. - Make gfinth_c the handler for the SIGINT signal. - ./ - previousHandler = signal ( SIGINT, gfinth_c ); - - if ( previousHandler == SIG_ERR ) - { - setmsg_c ( "Attempt to establish gfinth_c as the " - "handler for the SIGINT signal failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - } - - /. - Restore the previous handler. - ./ - handlerPtr = signal ( SIGINT, previousHandler ); - - if ( handlerPtr == SIG_ERR ) - { - setmsg_c ( "Attempt to re-establish the previous " - "handler for the SIGINT signal failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - } - - return ( 0 ); - - } - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 25-FEB-2009 (NJB) - --Index_Entries - - GF handle interrupt signal - --& -*/ - -{ /* Begin gfinth_c */ - - /* - Prototypes - */ - void zzgfsavh_c ( SpiceBoolean status ); - - - /* - Local variables - */ - void ( * handler )( int ); - - - /* - This routine uses discovery check-in. - */ - - if ( sigcode == SIGINT ) - { - /* - Re-establish this routine as the signal handler - for SIGINT. - */ - handler = signal ( SIGINT, gfinth_c ); - - if ( handler == SIG_ERR ) - { - setmsg_c ( "Attempt to establish gfinth_c as the " - "handler for the SIGINT signal failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - } - - - /* - An interrupt signal has been received. Update the - signal status. - */ - zzgfsavh_c ( SPICETRUE ); - } - else - { - /* - This handler should not receive any other signal. - */ - chkin_c ( "gfinth_c" ); - setmsg_c ( "A signal other than SIGINT was received. " - "The signal code was #." ); - errint_c ( "#", (SpiceInt)sigcode ); - sigerr_c ( "SPICE(INVALIDSIGNAL)" ); - chkout_c ( "gfinth_c" ); - } - - -} /* End gfinth_c */ - diff --git a/ext/spice/src/cspice/gfocce.c b/ext/spice/src/cspice/gfocce.c deleted file mode 100644 index d48f3bbeb1..0000000000 --- a/ext/spice/src/cspice/gfocce.c +++ /dev/null @@ -1,1267 +0,0 @@ -/* gfocce.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static logical c_false = FALSE_; -static doublereal c_b21 = 1.; - -/* $Procedure GFOCCE ( GF, occultation event ) */ -/* Subroutine */ int gfocce_(char *occtyp, char *front, char *fshape, char * - fframe, char *back, char *bshape, char *bframe, char *abcorr, char * - obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp - udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, - doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen - front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, - ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen - obsrvr_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzgfocin_(char *, char *, char *, char *, - char *, char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int zzgfocst_(); - extern /* Subroutine */ int zzgfsolv_(U_fp, U_fp, U_fp, logical *, L_fp, - logical *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, doublereal *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen); - extern integer sized_(doublereal *); - integer count; - doublereal start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - char lbshap[9], lfshap[9]; - extern integer wncard_(doublereal *); - doublereal finish; - extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), wnfetd_(doublereal *, - integer *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Determine time intervals when an observer sees one target */ -/* occulted by another. Report progress and handle interrupts */ -/* if so commanded. */ - -/* $ 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 */ - -/* FRAMES */ -/* GF */ -/* KERNEL */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* GEOMETRY */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* OCCTYP I Type of occultation. */ -/* FRONT I Name of body occulting the other. */ -/* FSHAPE I Type of shape model used for front body. */ -/* FFRAME I Body-fixed, body-centered frame for front body. */ -/* BACK I Name of body occulted by the other. */ -/* BSHAPE I Type of shape model used for back body. */ -/* BFRAME I Body-fixed, body-centered frame for back body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* TOL I Convergence tolerance in seconds. */ -/* UDSTEP I Name of the routine that returns a time step. */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* RPT I Progress report flag. */ -/* UDREPI I Function that initializes progress reporting. */ -/* UDREPU I Function that updates the progress report. */ -/* UDREPF I Function that finalizes progress reporting. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* RESULT O SPICE window containing results. */ - -/* $ Detailed_Input */ - - -/* OCCTYP indicates the type of occultation that is to be found. */ -/* Supported values and corresponding definitions are: */ - -/* 'FULL' denotes the full occultation */ -/* of the body designated by */ -/* BACK by the body designated */ -/* by FRONT, as seen from */ -/* the location of the observer. */ -/* In other words, the occulted */ -/* body is completely invisible */ -/* as seen from the observer's */ -/* location. */ - -/* 'ANNULAR' denotes an annular */ -/* occultation: the body */ -/* designated by FRONT blocks */ -/* part of, but not the limb of, */ -/* the body designated by BACK, */ -/* as seen from the location of */ -/* the observer. */ - -/* 'PARTIAL' denotes an partial, */ -/* non-annular occultation: the */ -/* body designated by FRONT */ -/* blocks part, but not all, of */ -/* the limb of the body */ -/* designated by BACK, as seen */ -/* from the location of the */ -/* observer. */ - -/* 'ANY' denotes any of the above three */ -/* types of occultations: */ -/* 'PARTIAL', 'ANNULAR', or */ -/* 'FULL'. */ - -/* 'ANY' should be used to search */ -/* for times when the body */ -/* designated by FRONT blocks */ -/* any part of the body designated */ -/* by BACK. */ - -/* The option 'ANY' must be used */ -/* if either the front or back */ -/* target body is modeled as */ -/* a point. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OCCTYP. */ - - -/* FRONT is the name of the target body that occults---that is, */ -/* passes in front of---the other. Optionally, you may */ -/* supply the integer NAIF ID code for the body as a */ -/* string. For example both 'MOON' and '301' are */ -/* legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string FRONT. */ - - -/* FSHAPE is a string indicating the geometric model used */ -/* to represent the shape of the front body. The */ -/* supported options are: */ - -/* 'ELLIPSOID' Use a triaxial ellipsoid model, */ -/* with radius values provided via the */ -/* kernel pool. A kernel variable */ -/* having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF */ -/* integer code associated with the */ -/* body, must be present in the kernel */ -/* pool. This variable must be */ -/* associated with three numeric */ -/* values giving the lengths of the */ -/* ellipsoid's X, Y, and Z semi-axes. */ - -/* 'POINT' Treat the body as a single point. */ -/* When a point target is specified, */ -/* the occultation type must be */ -/* set to 'ANY'. */ - -/* At least one of the target bodies FRONT and BACK must */ -/* be modeled as an ellipsoid. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string FSHAPE. */ - - -/* FFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the front target body. Examples */ -/* of such names are 'IAU_SATURN' (for Saturn) and */ -/* 'ITRF93' (for the Earth). */ - -/* If the front target body is modeled as a point, FFRAME */ -/* should be left blank. */ -/* Case and leading or trailing blanks are not */ -/* significant in the string FFRAME. */ - - -/* BACK is the name of the target body that is occulted */ -/* by---that is, passes in back of---the other. */ -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. For example both 'MOON' and */ -/* '301' are legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string BACK. */ - - -/* BSHAPE is the shape specification for the body designated */ -/* by BACK. The supported options are those for */ -/* FSHAPE. See the description of FSHAPE above for */ -/* details. */ - - -/* BFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the ``back'' target body. See */ -/* the description of FFRAME above for details. */ -/* Examples of such names are 'IAU_SATURN' (for Saturn) */ -/* and 'ITRF93' (for the Earth). */ - -/* If the back target body is modeled as a point, BFRAME */ -/* should be left blank. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* BFRAME. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time. Stellar aberration corrections are */ -/* ignored if specified, since these corrections don't */ -/* improve the accuracy of the occultation determination. */ - -/* See the header of the SPICE routine SPKEZR for a */ -/* detailed description of the aberration correction */ -/* options. For convenience, the options supported by */ -/* this routine are listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* OBSRVR is the name of the body from which the occultation is */ -/* observed. Optionally, you may supply the integer NAIF */ -/* ID code for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in TDB seconds */ -/* and must be greater than zero. */ - - -/* UDSTEP is an externally specified routine that computes a */ -/* time step used to find transitions of the state being */ -/* considered. A state transition occurs where the state */ -/* changes from being "in occultation" to being "not in */ -/* occultation" or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. ET is a DOUBLE PRECISION number. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. STEP is a DOUBLE */ -/* PRECISION number. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine GFSTEP */ -/* may be used. If GFSTEP is used, the step size must be */ -/* set by calling GFSSTP prior to calling this routine. */ - - -/* UDREFN is the name of the externally specified routine that */ -/* refines the times that bracket a transition point. In */ -/* other words, once a pair of times, T1 and T2, that */ -/* bracket a state transition have been found, UDREFN */ -/* computes an intermediate time T such that either */ -/* [T1, T] or [T, T2] contains the time of the state */ -/* transition. The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 is a time when the visibility state is S1. T1 */ -/* is expressed as seconds past J2000 TDB. */ - -/* T2 is a time when the visibility state is S2. T2 */ -/* is expressed as seconds past J2000 TDB. and */ -/* is assumed to be larger than T1. */ - -/* S1 is the visibility state at time T1. S1 is a */ -/* LOGICAL value. */ - -/* S2 is the visibility state at time T2. S2 is a */ -/* LOGICAL value. */ - -/* The output is: */ - -/* T is the next time to check for a state */ -/* transition. T is expressed as seconds past */ -/* J2000 TDB and is between T1 and T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. */ - - -/* RPT is a logical variable which controls whether */ -/* progress reporting is enabled. When RPT is .TRUE., */ -/* progress reporting is enabled and the routines */ -/* UDREPI, UDREPU, and UDPREF (see descriptions below) */ -/* are used to report progress. */ - - -/* UDREPI is a user-defined subroutine that initializes a */ -/* progress report. When progress reporting is */ -/* enabled, UDREPI is called at the start */ -/* of a search. The calling sequence of UDREPI is */ - -/* UDREPI ( CNFINE, SRCPRE, SRCSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) SRCPRE */ -/* CHARACTER*(*) SRCSUF */ - -/* where */ - -/* CNFINE */ - -/* is the confinement window and */ - -/* SRCPRE */ -/* SRCSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. For */ -/* example, when the CSPICE progress reporting functions */ -/* are used, if srcpre and srcsuf are, respectively, */ - -/* "Occultation search" */ -/* "done." */ - -/* the progress report display at the end of the */ -/* search will be: */ - -/* FOV search 100.00% done. */ - -/* The SPICELIB routine GFREPI may be used as the */ -/* actual argument corresponding to UDREPI. If so, */ -/* the SPICELIB routines GFREPU and GFREPF must be */ -/* the actual arguments corresponding to UDREPU and */ -/* UDREPF. */ - - -/* UDREPU is a user-defined subroutine that updates the */ -/* progress report for a search. The calling sequence */ -/* of UDREPU is */ - -/* UDREPU ( IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ -/* DOUBLE PRECISION ET */ - -/* Here IVBEG, IVEND are the bounds of an interval that */ -/* is contained in some interval belonging to the */ -/* confinement window. The confinement window is */ -/* associated with some root finding activity. It is used */ -/* to determine how much total time is being searched in */ -/* order to find the events of interest. */ - -/* ET is an epoch belonging to the interval */ -/* [IVBEG, IVEND]. */ - -/* In order for a meaningful progress report to be */ -/* displayed, IVBEG and IVEND must satisfy the following */ -/* constraints: */ - -/* - IVBEG must be less than or equal to IVEND. */ - -/* - The interval [ IVBEG, IVEND ] must be contained in */ -/* some interval of the confinement window. It can be */ -/* a proper subset of the containing interval; that */ -/* is, it can be smaller than the interval of the */ -/* confinement window that contains it. */ - -/* - Over a search, the sum of the differences */ - -/* IVEND - IVBEG */ - -/* for all calls to this routine made during the search */ -/* must equal the measure of the confinement window. */ - -/* The SPICELIB routine GFREPU may be used as the */ -/* actual argument corresponding to UDREPU. If so, */ -/* the SPICELIB routines GFREPI and GFREPF must be */ -/* the actual arguments corresponding to UDREPI and */ -/* UDREPF. */ - - -/* UDREPF is a user-defined subroutine that finalizes a */ -/* progress report. UDREPF has no arguments. */ - -/* The SPICELIB routine GFREPF may be used as the */ -/* actual argument corresponding to UDREPF. If so, */ -/* the SPICELIB routines GFREPI and GFREPU must be */ -/* the actual arguments corresponding to UDREPI and */ -/* UDREPU. */ - - -/* BAIL is a logical variable indicating whether or not */ -/* interrupt handling is enabled. When BAIL is */ -/* set to .TRUE., the input function UDBAIL (see */ -/* description below) is used to determine whether */ -/* an interrupt has been issued. */ - - -/* UDBAIL is the name of a user defined logical function that */ -/* indicates whether an interrupt signal has been */ -/* issued (for example, from the keyboard). UDBAIL */ -/* has no arguments and returns a LOGICAL value. */ -/* The return value is .TRUE. if an interrupt has */ -/* been issued; otherwise the value is .FALSE. */ - -/* GFOCCE uses UDBAIL only when BAIL (see above) is set */ -/* to .TRUE., indicating that interrupt handling is */ -/* enabled. When interrupt handling is enabled, GFOCCE */ -/* and routines in its call tree will call UDBAIL to */ -/* determine whether to terminate processing and return */ -/* immediately. */ - -/* If interrupt handing is not enabled, a logical */ -/* function must still be passed to GFOCCE as */ -/* an input argument. The SPICE function */ - -/* GFBAIL */ - -/* may be used for this purpose. */ - - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* The endpoints of the time intervals comprising CNFINE */ -/* are interpreted as seconds past J2000 TDB.. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window representing the set of time */ -/* intervals, within the confinement period, when the */ -/* specified occultation occurs. */ - -/* The endpoints of the time intervals comprising RESULT */ -/* are interpreted as seconds past J2000 TDB. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFOCCE conducts its */ -/* search. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEP) will be signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results. The SPICE window routine */ -/* WNCOND can be used to contract the result window. */ - -/* 3) If name of either target or the observer cannot be translated */ -/* to a NAIF ID code, the error SPICE(IDCODENOTFOUND) is */ -/* signaled. */ - -/* 4) If the radii of a target body modeled as an ellipsoid cannot */ -/* be determined by searching the kernel pool for a kernel */ -/* variable having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF integer code associated with */ -/* the body, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* 5) If either of the target bodies FRONT or BACK coincides with */ -/* the observer body OBSRVR, the error SPICE(BODIESNOTDISTINCT) */ -/* will be signaled. */ - -/* 6) If the body designated by FRONT coincides with that */ -/* designated by BACK, the error SPICE(BODIESNOTDISTINCT) will */ -/* be signaled. */ - -/* 7) If either of the body model specifiers FSHAPE or BSHAPE */ -/* is not recognized, the error SPICE(INVALIDSHAPE) will be */ -/* signaled. */ - -/* 8) If both of the body model specifiers FSHAPE and BSHAPE */ -/* specify point targets, the error SPICE(INVALIDSHAPECOMBO) */ -/* will be signaled. */ - -/* 9) If a target body-fixed reference frame associated with a */ -/* non-point target is not recognized, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 10) If a target body-fixed reference frame is not centered at */ -/* the corresponding target body, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 11) If the loaded kernels provide insufficient data to */ -/* compute the requested state vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 12) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 13) If a point target is specified and the occultation */ -/* type is set to a valid value other than 'ANY', the */ -/* error SPICE(BADTYPESHAPECOMBO) will be signaled. */ - -/* 14) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* visibility condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* 15) Invalid occultation types will be diagnosed by a routine in */ -/* the call tree of this routine. */ - -/* 16) Invalid aberration correction specifications will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 17) If the convergence tolerance size is non-positive, the error */ -/* SPICE(INVALIDTOLERANCE) will be signaled. */ - - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the target, source and observer that cover the time */ -/* period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files via */ -/* FURNSH. */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* semi-axis lengths provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file via FURNSH. */ - -/* - FK data: if either of the reference frames designated by */ -/* BFRAME or FFRAME are not built in to the SPICE system, */ -/* one or more FKs specifying these frames must be loaded. */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides the SPICE GF system's most flexible */ -/* interface for searching for occultation events. */ - -/* Applications that require do not require support for progress */ -/* reporting, interrupt handling, non-default step or refinement */ -/* functions, or non-default convergence tolerance normally should */ -/* call GFOCLT rather than this routine. */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when a specified type of */ -/* occultation occurs. The resulting set of intervals is returned as */ -/* a SPICE window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* The search for occultations is treated as a search for state */ -/* transitions: times are sought when the state of the BACK body */ -/* changes from "not occulted" to "occulted" or vice versa. */ - -/* Step Size */ -/* ========= */ - -/* Each interval of the confinement window is searched as follows: */ -/* first, the input step size is used to determine the time */ -/* separation at which the occultation state will be sampled. */ -/* Starting at the left endpoint of an interval, samples will be */ -/* taken at each step. If a state change is detected, a root has */ -/* been bracketed; at that point, the "root"--the time at which the */ -/* state change occurs---is found by a refinement process, for */ -/* example, via binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the occultation state is constant: */ -/* the step size should be shorter than the shortest occultation */ -/* duration and the shortest period between occultations, within */ -/* the confinement window. */ - -/* Having some knowledge of the relative geometry of the targets and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." */ - -/* The convergence tolerance used by high-level GF routines that */ -/* call this routine is set via the parameter CNVTOL, which is */ -/* declared in the INCLUDE file gf.inc. The value of CNVTOL is set */ -/* to a "tight" value so that the tolerance doesn't become the */ -/* limiting factor in the accuracy of solutions found by this */ -/* routine. In general the accuracy of input data will be the */ -/* limiting factor. */ - -/* Setting the input tolerance TOL tighter than CNVTOL is unlikely */ -/* to be useful, since the results are unlikely to be more accurate. */ -/* Making the tolerance looser will speed up searches somewhat, */ -/* since a few convergence steps will be omitted. However, in most */ -/* cases, the step size is likely to have a much greater effect on */ -/* processing time than would the convergence tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. For an example, see */ -/* the program CASCADE in the GF Example Programs chapter of the GF */ -/* Required Reading, gf.req. */ - - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* 1) Conduct a search using the default GF progress reporting */ -/* capability. */ - -/* The program will use console I/O to display a simple */ -/* ASCII-based progress report. */ - -/* The program will find occultations of the Sun by the Moon as */ -/* seen from the center of the Earth over the month December, */ -/* 2001. */ - -/* We use light time corrections to model apparent positions of */ -/* Sun and Moon. Stellar aberration corrections are not specified */ -/* because they don't affect occultation computations. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* File name: standard.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de421.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0009.tls' ) */ - -/* \begintext */ - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ - -/* IMPLICIT NONE */ - -/* EXTERNAL GFSTEP */ -/* EXTERNAL GFREFN */ -/* EXTERNAL GFREPI */ -/* EXTERNAL GFREPU */ -/* EXTERNAL GFREPF */ - -/* INTEGER WNCARD */ -/* LOGICAL GFBAIL */ -/* EXTERNAL GFBAIL */ - - -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY MON DD HR:MN:SC.###### ::TDB (TDB)' ) */ - -/* DOUBLE PRECISION CNVTOL */ -/* PARAMETER ( CNVTOL = 1.D-6 ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 2 * 100 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 40 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* CHARACTER*(TIMLEN) WIN0 */ -/* CHARACTER*(TIMLEN) WIN1 */ -/* CHARACTER*(TIMLEN) BEGSTR */ -/* CHARACTER*(TIMLEN) ENDSTR */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION LEFT */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION RIGHT */ - -/* INTEGER I */ - -/* LOGICAL BAIL */ -/* LOGICAL RPT */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Initialize the confinement and result windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Obtain the TDB time bounds of the confinement */ -/* C window, which is a single interval in this case. */ -/* C */ -/* WIN0 = '2001 DEC 01 00:00:00 TDB' */ -/* WIN1 = '2002 JAN 01 00:00:00 TDB' */ - -/* CALL STR2ET ( WIN0, ET0 ) */ -/* CALL STR2ET ( WIN1, ET1 ) */ - -/* C */ -/* C Insert the time bounds into the confinement */ -/* C window. */ -/* C */ -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Select a 20 second step. We'll ignore any occultations */ -/* C lasting less than 20 seconds. */ -/* C */ -/* CALL GFSSTP ( 20.D0 ) */ - -/* C */ -/* C Turn on progress reporting; turn off interrupt */ -/* C handling. */ -/* C */ -/* RPT = .TRUE. */ -/* BAIL = .FALSE. */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFOCCE ( 'ANY', */ -/* . 'MOON', 'ellipsoid', 'IAU_MOON', */ -/* . 'SUN', 'ellipsoid', 'IAU_SUN', */ -/* . 'LT', 'EARTH', CNVTOL, */ -/* . GFSTEP, GFREFN, RPT, */ -/* . GFREPI, GFREPU, GFREPF, */ -/* . BAIL, GFBAIL, CNFINE, RESULT ) */ - - -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'No occultation was found.' */ - -/* ELSE */ - -/* DO I = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch and display each occultation interval. */ -/* C */ -/* CALL WNFETD ( RESULT, I, LEFT, RIGHT ) */ - -/* CALL TIMOUT ( LEFT, TIMFMT, BEGSTR ) */ -/* CALL TIMOUT ( RIGHT, TIMFMT, ENDSTR ) */ - -/* WRITE (*,*) 'Interval ', I */ -/* WRITE (*,*) ' Start time: '//BEGSTR */ -/* WRITE (*,*) ' Stop time: '//ENDSTR */ - -/* END DO */ - -/* END IF */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* progress report had the format shown below: */ - -/* Occultation/transit search 6.02% done. */ - -/* The completion percentage was updated approximately once per */ -/* second. */ - -/* When this program completed execution, the output was: */ - -/* Occultation/transit search 100.00% done. */ -/* Interval 1 */ -/* Start time: 2001 DEC 14 20:10:14.195952 (TDB) */ -/* Stop time: 2001 DEC 14 21:35:50.317994 (TDB) */ - - -/* $ Restrictions */ - -/* 1) If the caller passes in the default, constant step */ -/* size routine, GFSTEP, the caller must set the step */ -/* size by calling the entry point GFSSTP before */ -/* calling GFOCCE. The call syntax for GFSSTP is */ - -/* CALL GFSSTP ( STEP ) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 15-APR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF mid-level occultation search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* External routines */ - - -/* Local parameters */ - - -/* STEP is a step size initializer for the unused, dummy step size */ -/* argument to ZZGFSOLV. The routine UDSTEP, which is passed to */ -/* ZZGFSOLV, will be used by that routine to obtain the step size. */ - - -/* CSTEP indicates whether a constant step size, provided */ -/* via the input argument STEP, is to be used by ZZGFSOLV. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFOCCE", (ftnlen)6); - -/* Check the result window's size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size must be at least 2 but was #.", (ftnlen) - 48); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21); - chkout_("GFOCCE", (ftnlen)6); - return 0; - } - -/* Empty the RESULT window. */ - - scardd_(&c__0, result); - -/* Check the convergence tolerance. */ - - if (*tol <= 0.) { - setmsg_("Tolerance must be positive but was #.", (ftnlen)37); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(INVALIDTOLERANCE)", (ftnlen)23); - chkout_("GFOCCE", (ftnlen)6); - return 0; - } - -/* Check the target shape specifications. */ - - ljust_(bshape, lbshap, bshape_len, (ftnlen)9); - ucase_(lbshap, lbshap, (ftnlen)9, (ftnlen)9); - ljust_(fshape, lfshap, fshape_len, (ftnlen)9); - ucase_(lfshap, lfshap, (ftnlen)9, (ftnlen)9); - -/* Note for maintenance programmer: these checks will */ -/* require modification to handle DSK-based shapes. */ - - if (s_cmp(lfshap, "POINT", (ftnlen)9, (ftnlen)5) == 0 && s_cmp(lbshap, - "POINT", (ftnlen)9, (ftnlen)5) == 0) { - setmsg_("The front and back target shape specifications are both PTS" - "HAP; at least one of these targets must be an extended objec" - "t.", (ftnlen)121); - sigerr_("SPICE(INVALIDSHAPECOMBO)", (ftnlen)24); - chkout_("GFOCCE", (ftnlen)6); - return 0; - } - -/* Initialize the occultation calculation. */ - - zzgfocin_(occtyp, front, lfshap, fframe, back, lbshap, bframe, obsrvr, - abcorr, occtyp_len, front_len, (ftnlen)9, fframe_len, back_len, ( - ftnlen)9, bframe_len, obsrvr_len, abcorr_len); - if (failed_()) { - chkout_("GFOCCE", (ftnlen)6); - return 0; - } - -/* Prepare the progress reporter if appropriate. */ - - if (*rpt) { - (*udrepi)(cnfine, "Occultation/transit search ", "done.", (ftnlen)27, - (ftnlen)5); - } - -/* Cycle over the intervals in the confining window. */ - - count = wncard_(cnfine); - i__1 = count; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Retrieve the bounds for the Ith interval of the confinement */ -/* window. Search this interval for occultation events. Union the */ -/* result with the contents of the RESULT window. */ - - wnfetd_(cnfine, &i__, &start, &finish); - zzgfsolv_((U_fp)zzgfocst_, (U_fp)udstep, (U_fp)udrefn, bail, (L_fp) - udbail, &c_false, &c_b21, &start, &finish, tol, rpt, (U_fp) - udrepu, result); - if (failed_()) { - chkout_("GFOCCE", (ftnlen)6); - return 0; - } - if (*bail) { - -/* Interrupt handling is enabled. */ - - if ((*udbail)()) { - -/* An interrupt has been issued. Return now regardless of */ -/* whether the search has been completed. */ - - chkout_("GFOCCE", (ftnlen)6); - return 0; - } - } - } - -/* End the progress report. */ - - if (*rpt) { - (*udrepf)(); - } - chkout_("GFOCCE", (ftnlen)6); - return 0; -} /* gfocce_ */ - diff --git a/ext/spice/src/cspice/gfocce_c.c b/ext/spice/src/cspice/gfocce_c.c deleted file mode 100644 index 00c7a1c018..0000000000 --- a/ext/spice/src/cspice/gfocce_c.c +++ /dev/null @@ -1,1247 +0,0 @@ -/* - --Procedure gfocce_c ( GF, occultation event ) - --Abstract - - Determine time intervals when an observer sees one target - occulted by another. Report progress and handle interrupts - if so commanded. - --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 - - FRAMES - GF - KERNEL - NAIF_IDS - SPK - TIME - WINDOWS - --Keywords - - EVENT - GEOMETRY - SEARCH - WINDOW - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZfc.h" - #include "SpiceZad.h" - - - void gfocce_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble tol, - - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - occtyp I Type of occultation. - front I Name of body occulting the other. - fshape I Type of shape model used for front body. - fframe I Body-fixed, body-centered frame for front body. - back I Name of body occulted by the other. - bshape I Type of shape model used for back body. - bframe I Body-fixed, body-centered frame for back body. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - tol I Convergence tolerance in seconds. - udstep I Name of the routine that returns a time step. - udrefn I Name of the routine that computes a refined time. - rpt I Progress report flag. - udrepi I Function that initializes progress reporting. - udrepu I Function that updates the progress report. - udrepf I Function that finalizes progress reporting. - bail I Logical indicating program interrupt monitoring. - udbail I Name of a routine that signals a program interrupt. - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - --Detailed_Input - - - occtyp indicates the type of occultation that is to be found. - Supported values and corresponding definitions are: - - "FULL" denotes the full occultation - of the body designated by - `back' by the body designated - by `front', as seen from - the location of the observer. - In other words, the occulted - body is completely invisible - as seen from the observer's - location. - - "ANNULAR" denotes an annular - occultation: the body - designated by `front' blocks - part of, but not the limb of, - the body designated by `back', - as seen from the location of - the observer. - - "PARTIAL" denotes an partial, - non-annular occultation: the - body designated by `front' - blocks part, but not all, of - the limb of the body - designated by `back', as seen - from the location of the - observer. - - "ANY" denotes any of the above three - types of occultations: - "PARTIAL", "ANNULAR", or - "FULL". - - "ANY" should be used to search - for times when the body - designated by `front' blocks - any part of the body designated - by `back'. - - The option "ANY" must be used - if either the front or back - target body is modeled as - a point. - - Case and leading or trailing blanks are not - significant in the string `occtyp'. - - - front is the name of the target body that occults---that is, - passes in front of---the other. Optionally, you may - supply the integer NAIF ID code for the body as a - string. For example both "MOON" and "301" are - legitimate strings that designate the Moon. - - Case and leading or trailing blanks are not - significant in the string `front'. - - - fshape is a string indicating the geometric model used - to represent the shape of the front body. The - supported options are: - - "ELLIPSOID" Use a triaxial ellipsoid model, - with radius values provided via the - kernel pool. A kernel variable - having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF - integer code associated with the - body, must be present in the kernel - pool. This variable must be - associated with three numeric - values giving the lengths of the - ellipsoid's X, Y, and Z semi-axes. - - "POINT" Treat the body as a single point. - When a point target is specified, - the occultation type must be - set to "ANY". - - At least one of the target bodies `front' and `back' must - be modeled as an ellipsoid. - - Case and leading or trailing blanks are not - significant in the string `fshape'. - - - fframe is the name of the body-fixed, body-centered reference - frame associated with the front target body. Examples - of such names are "IAU_SATURN" (for Saturn) and - "ITRF93" (for the Earth). - - If the front target body is modeled as a point, `fframe' - should be left empty or blank. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `fframe'. - - - back is the name of the target body that is occulted - by---that is, passes in back of---the other. - Optionally, you may supply the integer NAIF ID code - for the body as a string. For example both "MOON" and - "301" are legitimate strings that designate the Moon. - - Case and leading or trailing blanks are not - significant in the string `back'. - - - bshape is the shape specification for the body designated - by `back'. See the description of `fshape' above for - details. - - - bframe is the name of the body-fixed, body-centered reference - frame associated with the ``back'' target body. - Examples of such names are "IAU_SATURN" (for Saturn) - and "ITRF93" (for the Earth). - - If the back target body is modeled as a point, `bframe' - should be left empty or blank. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `bframe'. - - - abcorr indicates the aberration corrections to be applied to - the state of the target body to account for one-way - light time. Stellar aberration corrections are - ignored if specified, since these corrections don't - improve the accuracy of the occultation determination. - - See the header of the SPICE routine spkezr_c for a - detailed description of the aberration correction - options. For convenience, the options supported by - this routine are listed below: - - "NONE" Apply no correction. - - "LT" "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - "CN" "Reception" case: converged - Newtonian light time correction. - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - Case and blanks are not significant in the string - `abcorr'. - - - obsrvr is the name of the body from which the occultation is - observed. Optionally, you may supply the integer NAIF - ID code for the body as a string. - - Case and leading or trailing blanks are not - significant in the string `obsrvr'. - - - tol is a tolerance value used to determine convergence of - root-finding operations. `tol' is measured in TDB seconds - and must be greater than zero. - - - udstep is an externally specified routine that computes a - time step in an attempt to find a transition of the - state being considered. In the context of this - routine's algorithm, a "state transition" occurs where - the state changes from being "in occultation" to being - "not in occultation" or vice versa. - - This routine relies on `udstep' returning step sizes - small enough so that state transitions within the - confinement window are not overlooked. There must - never be two roots A and B separated by less than - `step', where `step' is the minimum step size returned by - `udstep' for any value of `et'; in the interval [A, B]. - - The prototype for `udstep' is - - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ) - - where: - - et is the input start time from which the - algorithm is to search forward for a state - transition. `et' is expressed as seconds past - J2000 TDB. - - step is the output step size. `step' indicates - how far to advance `et' so that `et' and - et+step may bracket a state transition and - definitely do not bracket more than one - state transition. Units are TDB seconds. - - If a constant step size is desired, the CSPICE routine - - gfstep_c - - may be used as the step size function. If gfstep_c is - used, the step size must be set by calling gfsstp_c prior - to calling this routine. - - - udrefn is the name of the externally specified routine that - computes a refinement in the times that bracket a - transition point. In other words, once a pair of - times have been detected such that the system is in - different states at each of the two times, `udrefn' - selects an intermediate time which should be closer to - the transition state than one of the two known times. - The prototype for `udrefn' is: - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ) - - where the inputs are: - - t1 is a time when the system is in state `s1'. `t1' - is expressed as seconds past J2000 TDB. - - t2 is a time when the system is in state `s2'. `t2' - is expressed as seconds past J2000 TDB. `t2' is - assumed to be larger than `t1'. - - s1 is the state of the system at time t1. - - s2 is the state of the system at time t2. - - The output is: - - t is next time to check for a state transition. - `t' is a number between `t1' and `t2'. `t' is - expressed as seconds past J2000 TDB. - - If a simple bisection method is desired, the CSPICE routine - gfrefn_c may be used as the refinement function. - - - rpt is a logical variable which controls whether - progress reporting is enabled. When `rpt' is SPICETRUE, - progress reporting is enabled and the routines - udrepi, udrepu, and udpref (see descriptions below) - are used to report progress. - - - udrepi is a user-defined subroutine that initializes a - progress report. When progress reporting is - enabled, `udrepi' is called at the start - of a search. The prototype for `udrefi' is - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ) - - where - - cnfine - - is a confinement window specifying the time period - over which a search is conducted, and - - srcpre - srcsuf - - are prefix and suffix strings used in the progress - report: these strings are intended to bracket a - representation of the fraction of work done. For - example, when the CSPICE progress reporting functions - are used, if srcpre and srcsuf are, respectively, - - "Occultation/transit search" - "done." - - the progress report display at the end of - the search will be: - - Occultation/transit search 100.00% done. - - The CSPICE routine gfrepi_c may be used as the - actual argument corresponding to `udrepi'. If so, - the CSPICE routines gfrepu_c and gfrepf_c must be - the actual arguments corresponding to `udrepu' and - `udrepf'. - - - udrepu is a user-defined subroutine that updates the - progress report for a search. The prototype - of `udrepu' is - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ) - - In order for a meaningful progress report to be displayed, - `ivbeg' and `ivend' must satisfy the following constraints: - - - `ivbeg' must be less than or equal to `ivend'. - - - Over a search, the sum of the differences - - ivend - ivbeg - - for all calls to this routine made during the search - must equal the measure (that is, the sum of the - lengths of the intervals) of the confinement window - `cnfine'. - - `et' is the current time reached in the search for an event. - `et' must lie in the interval - - ivbeg : ivend - - inclusive. The input values of `et' for a given interval - need not form an increasing sequence. - - The CSPICE routine gfrepu_c may be used as the actual - argument corresponding to `udrepu'. If so, the CSPICE - routines gfrepi_c and gfrepf_c must be the actual - arguments corresponding to `udrepi' and `udrepf'. - - - udrepf is a user-defined subroutine that finalizes a progress - report. `udrepf' has no arguments. - - The CSPICE routine gfrepf_c may be used as the actual - argument corresponding to `udrepf'. If so, the CSPICE - routines gfrepi_c and gfrepu_c must be the actual - arguments corresponding to `udrepi' and `udrepu'. - - - bail is a logical variable indicating whether or not - interrupt handling is enabled. When `bail' is - set to SPICETRUE, the input function `udbail' (see - description below) is used to determine whether - an interrupt has been issued. - - - udbail is the name of a user defined logical function that - indicates whether an interrupt signal has been - issued (for example, from the keyboard). udbail - has the prototype - - SpiceBoolean ( * udbail ) ( void ) - - The return value is SPICETRUE if an interrupt has - been issued; otherwise the value is SPICEFALSE. - - gfocce_c uses `udbail' only when `bail' (see above) is set - to SPICETRUE, indicating that interrupt handling is - enabled. When interrupt handling is enabled, gfocce_c - and routines in its call tree will call `udbail' to - determine whether to terminate processing and return - immediately. - - If the user doesn't wish to provide a custom interrupt - handling function, the CSPICE routine - - gfbail_c - - may be used. - - The function `udbail' will be usually be tested - multiple times by the GF system between the time - an interrupt is issued and the time when - control is returned to the calling program, so - `udbail' nmust continue to return SPICETRUE - until explicitly reset by the calling application. - So `udbail' must provide a "reset" mechanism." - In the case of gfbail_c, the reset function is - - gfclrh_c - - If interrupt handing is not enabled, a logical - function must still be passed to gfocce_c as - an input argument. The CSPICE function - - gfbail_c - - may be used for this purpose. - - See the Examples header section below for a complete code - example demonstrating use of the CSPICE interrupt - handling capability. - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - The endpoints of the time intervals comprising `cnfine' - are interpreted as seconds past J2000 TDB. - - See the Examples section below for a code example - that shows how to create a confinement window. - - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - specified occultation occurs. - - The endpoints of the time intervals comprising `result' - are interpreted as seconds past J2000 TDB. - - If `result' is non-empty on input, its contents - will be discarded before gfocce_c conducts its - search. - --Parameters - - None. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, the error - SPICE(INVALIDSTEPSIZE) will be signaled. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If name of either target or the observer cannot be translated - to a NAIF ID code, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the radii of a target body modeled as an ellipsoid cannot - be determined by searching the kernel pool for a kernel - variable having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF integer code associated with - the body, the error will be diagnosed by a routine in the - call tree of this routine. - - 5) If either of the target bodies `front' or `back' coincides with - the observer body `obsrvr', the error will be diagnosed by a - routine in the call tree of this routine. - - 6) If the body designated by `front' coincides with that - designated by `back', the error will be diagnosed by a routine - in the call tree of this routine. - - 7) If either of the body model specifiers `fshape' or `bshape' - is not recognized, the error will be diagnosed by a routine - in the call tree of this routine. - - 8) If both of the body model specifiers `fshape' and `bshape' - specify point targets, the error will be diagnosed by a - routine in the call tree of this routine. - - 9) If a target body-fixed reference frame associated with a - non-point target is not recognized, the error will be - diagnosed by a routine in the call tree of this routine. - - 10) If a target body-fixed reference frame is not centered at - the corresponding target body, the error will be - diagnosed by a routine in the call tree of this routine. - - 11) If the loaded kernels provide insufficient data to - compute the requested state vector, the deficiency will - be diagnosed by a routine in the call tree of this routine. - - 12) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - - 13) If the output SPICE window `result' has insufficient capacity - to contain the number of intervals on which the specified - occultation condition is met, the error will be diagnosed - by a routine in the call tree of this routine. - - 14) If a point target is specified and the occultation - type is set to a valid value other than "ANY", the - error will be diagnosed by a routine in the call tree - of this routine. - - 15) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 16) If any input string argument, other than `fframe' or `bframe', - is empty, the error SPICE(EMPTYSTRING) will be signaled. - - 17) If the convergence tolerance size is non-positive, the error - SPICE(INVALIDTOLERANCE) will be signaled. - - 18) If the occultation type is not recognized, the error - SPICE(INVALIDOCCTYPE) is signaled. - - 19) If any attempt to change the handler for the interrupt - signal SIGINT fails, the error SPICE(SIGNALFAILURE) is - signaled. - - 20) If operation of this routine is interrupted, the output result - window will be invalid. - - --Files - - Appropriate SPICE kernels must be loaded by the calling program - before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the target, source and observer that cover the time - period specified by the window `cnfine'. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files via - furnsh_c. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - This routine provides the SPICE GF system's most flexible - interface for searching for occultation events. - - Applications that require do not require support for progress - reporting, interrupt handling, non-default step or refinement - functions, or non-default convergence tolerance normally should - call gfoclt_c rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window when a specified type of - occultation occurs. The resulting set of intervals is returned as - a SPICE window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - - The Search Process - ================== - - The search for occultations is treated as a search for state - transitions: times are sought when the state of the BACK body - changes from "not occulted" to "occulted" or vice versa. - - Step Size - ========= - - Each interval of the confinement window is searched as follows: - first, the input step size is used to determine the time - separation at which the occultation state will be sampled. - Starting at the left endpoint of an interval, samples will be - taken at each step. If a state change is detected, a root has - been bracketed; at that point, the "root"--the time at which the - state change occurs---is found by a refinement process, for - example, via binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the occultation state is constant: - the step size should be shorter than the shortest occultation - duration and the shortest period between occultations, within - the confinement window. - - Having some knowledge of the relative geometry of the targets and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. This - refinement process terminates when the location of the root has been - determined to within an error margin called the "convergence - tolerance." The convergence tolerance used by high-level GF routines - that call this routine is set via the parameter SPICE_GF_CNVTOL, - which is declared in the header file SpiceGF.h. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't become the limiting factor in the accuracy of - solutions found by this routine. In general the accuracy of input - data will be the limiting factor. - - Making the tolerance tighter than SPICE_GF_CNVTOL is unlikely to be - useful, since the results are unlikely to be more accurate. Making - the tolerance looser will speed up searches somewhat, since a few - convergence steps will be omitted. However, in most cases, the step - size is likely to have a much greater affect on processing time than - would the convergence tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the confinement - window can, in some cases, be used to make searches more efficient. - Sometimes it's possible to do an efficient search to reduce the size - of the time period over which a relatively slow search of interest - must be performed. For an example, see the program CASCADE in the GF - Example Programs chapter of the GF Required Reading, gf.req. - - --Examples - - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Conduct a search using default GF progress reporting - and interrupt handling capabilities. - - The program will use console I/O to display a simple - ASCII-based progress report. - - The program will trap keyboard interrupts (on most systems, - generated by typing the "control C" key combination). This - feature can be used in non-trivial applications to allow - the application to continue after a search as been interrupted. - - The program will find occultations of the Sun by the Moon as seen - from the center of the Earth over the month December, 2001. - - Use light time corrections to model apparent positions of Sun - and Moon. Stellar aberration corrections are not specified - because they don't affect occultation computations. - - We select a step size of 20 seconds, which implies we ignore - occultation events lasting less than 20 seconds, if any exist. - Given this step size and the length of the search interval, the - user has time to interrupt the computation. In an interactive - setting, the user might speed up the search by lengthening the - step size or shortening the search interval, as long as these - adjustments don't prevent the search from finding the correct - solution. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File name: standard.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de421.bsp', - 'pck00008.tpc', - 'naif0009.tls' ) - - \begintext - - - Example code begins here. - - - #include "SpiceUsr.h" - #include - - int main() - { - /. - Constants - ./ - #define TIMFMT "YYYY MON DD HR:MN:SC.###### ::TDB (TDB)" - #define CNVTOL 1.e-6 - #define MAXWIN 200 - #define TIMLEN 41 - - /. - Local variables - ./ - SpiceBoolean bail; - SpiceBoolean rpt; - - SpiceChar * win0; - SpiceChar * win1; - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble left; - SpiceDouble right; - - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c ( "standard.tm" ); - - /. - Obtain the TDB time bounds of the confinement - window, which is a single interval in this case. - ./ - win0 = "2001 DEC 10 00:00:00 TDB"; - win1 = "2002 JAN 01 00:00:00 TDB"; - - str2et_c ( win0, &et0 ); - str2et_c ( win1, &et1 ); - - /. - Insert the time bounds into the confinement - window. - ./ - wninsd_c ( et0, et1, &cnfine ); - - /. - Select a twenty-second step. We'll ignore any occultations - lasting less than 20 seconds. - ./ - gfsstp_c ( 20.0 ); - - /. - Turn on interrupt handling and progress reporting. - ./ - bail = SPICETRUE; - rpt = SPICETRUE; - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, &cnfine, - &result ); - - - if ( gfbail_c() ) - { - /. - Clear the CSPICE interrupt indication. This is - an essential step for programs that continue - running after an interrupt; gfbail_c will - continue to return SPICETRUE until this step - has been performed. - ./ - gfclrh_c(); - - - /. - We've trapped an interrupt signal. In a realistic - application, the program would continue operation - from this point. In this simple example, we simply - display a message and quit. - ./ - printf ( "\nSearch was interrupted.\n\nThis message " - "was written after an interrupt signal\n" - "was trapped. By default, the program " - "would have terminated \nbefore this message " - "could be written.\n\n" ); - } - else - { - - if ( wncard_c(&result) == 0 ) - { - printf ( "No occultation was found.\n" ); - } - else - { - for ( i = 0; i < wncard_c(&result); i++ ) - { - /. - fetch and display each occultation interval. - ./ - wnfetd_c ( &result, i, &left, &right ); - - timout_c ( left, TIMFMT, TIMLEN, begstr ); - timout_c ( right, TIMFMT, TIMLEN, endstr ); - - printf ( "Interval %ld\n", i ); - printf ( " Start time: %s\n", begstr ); - printf ( " Stop time: %s\n", endstr ); - } - } - - } - - return ( 0 ); - } - - When this program was executed on a PC/Linux/gcc platform, the - progress report had the format shown below: - - Occultation/transit search 6.02% done. - - The completion percentage was updated approximately once per - second. - - When this program completed execution, the output was: - - - Occultation/transit search 100.00% done. - - interval 0 - start time: 2001 DEC 14 20:10:14.195952 (TDB) - stop time: 2001 DEC 14 21:35:50.317994 (TDB) - - - When the program was interrupted at an arbitrary time, - the output was: - - Occultation/transit search 13.63% done. - Search was interrupted. - - This message was written after an interrupt signal - was trapped. By default, the program would have terminated - before this message could be written. - - --Restrictions - - 1) If the caller passes in the default, constant step - size routine, gfstep_c, the caller must set the step - size by calling the entry point gfsstp_c before - calling gfocce_c. The call syntax for gfsstp_c is - - gfsstp_c ( step ); - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 15-APR-2009 (NJB) (LSE) (WLT) (IMU) (EDW ) - --Index_Entries - - GF mid-level occultation search - --& -*/ - -{ /* Begin gfocce_c */ - - /* - Prototypes - */ - void ( * defSigHandler ) (int); - void ( * sigPtr ) (int); - - /* - Local variables - */ - logical interrupt; - logical rep; - - SpiceBoolean newHandler; - - static const SpiceChar * blankStr = " "; - - SpiceChar * bFrameStr; - SpiceChar * fFrameStr; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfocce_c" ); - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfocce_c", SPICE_DP, cnfine, result ); - - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - - /* - The input frame names are special cases because we allow the caller - to pass in empty strings. If either of these strings are empty, - we pass a null-terminated string containing one blank character to - the underlying f2c'd routine. - - First make sure the frame name pointers are non-null. - */ - CHKPTR ( CHK_STANDARD, "gfocce_c", bframe ); - CHKPTR ( CHK_STANDARD, "gfocce_c", fframe ); - - /* - Use the input frame strings if they're non-empty; otherwise - use blank strings for the frame names. - */ - - if ( bframe[0] ) - { - bFrameStr = (SpiceChar *) bframe; - } - else - { - bFrameStr = (SpiceChar *) blankStr; - } - - if ( fframe[0] ) - { - fFrameStr = (SpiceChar *) fframe; - } - else - { - fFrameStr = (SpiceChar *) blankStr; - } - - - /* - Check the other input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfocce_c", occtyp ); - CHKFSTR ( CHK_STANDARD, "gfocce_c", front ); - CHKFSTR ( CHK_STANDARD, "gfocce_c", fshape ); - CHKFSTR ( CHK_STANDARD, "gfocce_c", back ); - CHKFSTR ( CHK_STANDARD, "gfocce_c", bshape ); - CHKFSTR ( CHK_STANDARD, "gfocce_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfocce_c", obsrvr ); - - - /* - Assign the SpiceBoolean report and interrupt flags. - */ - rep = rpt ; - interrupt = bail; - - - /* - Store the input function pointers so these functions can be - called by the GF adapters. - */ - zzadsave_c ( UDSTEP, (void *)(udstep) ); - zzadsave_c ( UDREFN, (void *)(udrefn) ); - zzadsave_c ( UDREPF, (void *)(udrepf) ); - zzadsave_c ( UDREPI, (void *)(udrepi) ); - zzadsave_c ( UDREPU, (void *)(udrepu) ); - zzadsave_c ( UDBAIL, (void *)(udbail) ); - - - /* - If interrupt handling is enabled, and if the default bail-out - routine gfbail_c is being used, set the SPICE interrupt - handler. - */ - - newHandler = SPICEFALSE; - - if ( bail ) - { - newHandler = ( (void *)udbail == (void *)gfbail_c ); - - if ( newHandler ) - { - defSigHandler = signal ( SIGINT, gfinth_c ); - - if ( defSigHandler == SIG_ERR ) - { - setmsg_c ( "Attempt to establish the CSPICE routine " - "gfinth_c as the handler for the interrupt " - "signal SIGINT failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - chkout_c ( "gfocce_c" ); - return; - } - } - } - - - /* - Let the f2c'd routine do the work. - - We pass the adapter functions, not those provided as inputs, - to the f2c'd routine. - */ - - gfocce_ ( ( char * ) occtyp, - ( char * ) front, - ( char * ) fshape, - ( char * ) fframe, - ( char * ) back, - ( char * ) bshape, - ( char * ) bframe, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) &tol, - ( U_fp ) zzadstep_c, - ( U_fp ) zzadrefn_c, - ( logical * ) &rep, - ( S_fp ) zzadrepi_c, - ( U_fp ) zzadrepu_c, - ( S_fp ) zzadrepf_c, - ( logical * ) &interrupt, - ( L_fp ) zzadbail_c, - ( doublereal * ) (cnfine->base), - ( doublereal * ) (result->base), - ( ftnlen ) strlen(occtyp), - ( ftnlen ) strlen(front), - ( ftnlen ) strlen(fshape), - ( ftnlen ) strlen(fframe), - ( ftnlen ) strlen(back), - ( ftnlen ) strlen(bshape), - ( ftnlen ) strlen(bframe), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - /* - If we've changed the signal handler, restore the previous one. - */ - if ( newHandler ) - { - sigPtr = signal ( SIGINT, defSigHandler ); - - if ( sigPtr == SIG_ERR ) - { - setmsg_c ( "Attempt to restore the previous handler " - "for the interrupt signal SIGINT failed." ); - sigerr_c ( "SPICE(SIGNALFAILED)" ); - chkout_c ( "gfocce_c" ); - return; - } - } - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - - chkout_c ( "gfocce_c" ); - -} /* End gfocce_c */ diff --git a/ext/spice/src/cspice/gfoclt.c b/ext/spice/src/cspice/gfoclt.c deleted file mode 100644 index 82a55de584..0000000000 --- a/ext/spice/src/cspice/gfoclt.c +++ /dev/null @@ -1,1342 +0,0 @@ -/* gfoclt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b11 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFOCLT ( GF, find occultation ) */ -/* Subroutine */ int gfoclt_(char *occtyp, char *front, char *fshape, char * - fframe, char *back, char *bshape, char *bframe, char *abcorr, char * - obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, - ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen - fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, - ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int gfocce_(char *, char *, char *, char *, char * - , char *, char *, char *, char *, doublereal *, U_fp, U_fp, - logical *, U_fp, U_fp, U_fp, logical *, L_fp, doublereal *, - doublereal *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_(), gfrepu_(), - gfstep_(); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int gfsstp_(doublereal *); - -/* $ Abstract */ - -/* Determine time intervals when an observer sees one target */ -/* body occulted by, or in transit across, another. */ - -/* $ 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 */ - -/* FRAMES */ -/* GF */ -/* KERNEL */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* GEOMETRY */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance. */ -/* OCCTYP I Type of occultation. */ -/* FRONT I Name of body occulting the other. */ -/* FSHAPE I Type of shape model used for front body. */ -/* FFRAME I Body-fixed, body-centered frame for front body. */ -/* BACK I Name of body occulted by the other. */ -/* BSHAPE I Type of shape model used for back body. */ -/* BFRAME I Body-fixed, body-centered frame for back body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* STEP I Step size in seconds for finding occultation */ -/* events. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* RESULT O SPICE window containing results. */ - -/* $ Detailed_Input */ - - -/* OCCTYP indicates the type of occultation that is to be found. */ -/* Note that transits are considered to be a type of */ -/* occultation. */ - -/* Supported values and corresponding definitions are: */ - -/* 'FULL' denotes the full occultation */ -/* of the body designated by */ -/* BACK by the body designated */ -/* by FRONT, as seen from */ -/* the location of the observer. */ -/* In other words, the occulted */ -/* body is completely invisible */ -/* as seen from the observer's */ -/* location. */ - -/* 'ANNULAR' denotes an annular */ -/* occultation: the body */ -/* designated by FRONT blocks */ -/* part of, but not the limb of, */ -/* the body designated by BACK, */ -/* as seen from the location of */ -/* the observer. */ - -/* 'PARTIAL' denotes a partial, */ -/* non-annular occultation: the */ -/* body designated by FRONT */ -/* blocks part, but not all, of */ -/* the limb of the body */ -/* designated by BACK, as seen */ -/* from the location of the */ -/* observer. */ - -/* 'ANY' denotes any of the above three */ -/* types of occultations: */ -/* 'PARTIAL', 'ANNULAR', or */ -/* 'FULL'. */ - -/* 'ANY' should be used to search */ -/* for times when the body */ -/* designated by FRONT blocks */ -/* any part of the body designated */ -/* by BACK. */ - -/* The option 'ANY' must be used */ -/* if either the front or back */ -/* target body is modeled as */ -/* a point. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OCCTYP. */ - - - -/* FRONT is the name of the target body that occults---that is, */ -/* passes in front of---the other. Optionally, you may */ -/* supply the integer NAIF ID code for the body as a */ -/* string. For example both 'MOON' and '301' are */ -/* legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string FRONT. */ - - -/* FSHAPE is a string indicating the geometric model used to */ -/* represent the shape of the front target body. The */ -/* supported options are: */ - -/* 'ELLIPSOID' Use a triaxial ellipsoid model */ -/* with radius values provided via the */ -/* kernel pool. A kernel variable */ -/* having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF */ -/* integer code associated with the */ -/* body, must be present in the kernel */ -/* pool. This variable must be */ -/* associated with three numeric */ -/* values giving the lengths of the */ -/* ellipsoid's X, Y, and Z semi-axes. */ - -/* 'POINT' Treat the body as a single point. */ -/* When a point target is specified, */ -/* the occultation type must be */ -/* set to 'ANY'. */ - -/* At least one of the target bodies FRONT and BACK must */ -/* be modeled as an ellipsoid. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string FSHAPE. */ - - -/* FFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the front target body. Examples */ -/* of such names are 'IAU_SATURN' (for Saturn) and */ -/* 'ITRF93' (for the Earth). */ - -/* If the front target body is modeled as a point, FFRAME */ -/* should be left blank. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* FFRAME. */ - - -/* BACK is the name of the target body that is occulted */ -/* by---that is, passes in back of---the other. */ -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. For example both 'MOON' and */ -/* '301' are legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string BACK. */ - - -/* BSHAPE is the shape specification for the body designated */ -/* by BACK. The supported options are those for */ -/* FSHAPE. See the description of FSHAPE above for */ -/* details. */ - - -/* BFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the ``back'' target body. */ -/* Examples of such names are 'IAU_SATURN' (for Saturn) */ -/* and 'ITRF93' (for the Earth). */ - -/* If the back target body is modeled as a point, BFRAME */ -/* should be left blank. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* BFRAME. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of each target body to account for one-way */ -/* light time. Stellar aberration corrections are */ -/* ignored if specified, since these corrections don't */ -/* improve the accuracy of the occultation determination. */ - -/* See the header of the SPICE routine SPKEZR for a */ -/* detailed description of the aberration correction */ -/* options. For convenience, the options supported by */ -/* this routine are listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* OBSRVR is the name of the body from which the occultation is */ -/* observed. Optionally, you may supply the integer NAIF */ -/* ID code for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* STEP is the step size to be used in the search. STEP must */ -/* be shorter than any interval, within the confinement */ -/* window, over which the specified occultation condition */ -/* is met. In other words, STEP must be shorter than the */ -/* shortest occultation event that the user wishes to */ -/* detect; STEP must also be shorter than the shortest */ -/* time interval between two occultation events that */ -/* occur within the confinement window (see below). */ -/* However, STEP must not be *too* short, or the search */ -/* will take an unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* The endpoints of the time intervals comprising CNFINE */ -/* are interpreted as seconds past J2000 TDB. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window representing the set of time */ -/* intervals, within the confinement window, when the */ -/* specified occultation occurs. */ - -/* The endpoints of the time intervals comprising RESULT */ -/* are interpreted as seconds past J2000 TDB. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFOCLT conducts its */ -/* search. */ - -/* $ Parameters */ - -/* LBCELL is the lower bound for SPICE cell arrays. */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL, the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEPSIZE) will be signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results. The SPICE window routine */ -/* WNCOND can be used to contract the result window. */ - -/* 3) If name of either target or the observer cannot be translated */ -/* to a NAIF ID code, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 4) If the radii of a target body modeled as an ellipsoid cannot */ -/* be determined by searching the kernel pool for a kernel */ -/* variable having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF integer code associated with */ -/* the body, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* 5) If either of the target bodies FRONT or BACK coincides with */ -/* the observer body OBSRVR, the error will be diagnosed by a */ -/* routine in the call tree of this routine. */ - -/* 6) If the body designated by FRONT coincides with that */ -/* designated by BACK, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 7) If either of the body model specifiers FSHAPE or BSHAPE */ -/* is not recognized, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 8) If both of the body model specifiers FSHAPE and BSHAPE */ -/* specify point targets, the error will be diagnosed by a */ -/* routine in the call tree of this routine. */ - -/* 9) If a target body-fixed reference frame associated with a */ -/* non-point target is not recognized, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 10) If a target body-fixed reference frame is not centered at */ -/* the corresponding target body, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 11) If the loaded kernels provide insufficient data to */ -/* compute any required state vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 12) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 13) If a point target is specified and the occultation */ -/* type is set to a valid value other than 'ANY', the */ -/* error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 14) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* occultation condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* 15) Invalid occultation types will be diagnosed by a routine in */ -/* the call tree of this routine. */ - -/* 16) Invalid aberration correction specifications will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* Appropriate SPICE kernels must be loaded by the calling program */ -/* before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the target, source and observer that cover the time */ -/* period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of the target bodies and of */ -/* the observer relative to the solar system barycenter must be */ -/* calculable from the available ephemeris data. Typically */ -/* ephemeris data */ -/* are made available by loading one or more SPK files via */ -/* FURNSH. */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* semi-axis lengths provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file via FURNSH. */ - -/* - FK data: if either of the reference frames designated by */ -/* BFRAME or FFRAME are not built in to the SPICE system, */ -/* one or more FKs specifying these frames must be loaded. */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides a simpler, but less flexible, interface */ -/* than does the SPICELIB routine GFOCCE for conducting searches for */ -/* occultation events. Applications that require support for */ -/* progress reporting, interrupt handling, non-default step or */ -/* refinement functions, or non-default convergence tolerance should */ -/* call GFOCCE rather than this routine. */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when a specified type of */ -/* occultation occurs. The resulting set of intervals is returned as */ -/* a SPICE window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* The search for occultations is treated as a search for state */ -/* transitions: times are sought when the state of the BACK body */ -/* changes from "not occulted" to "occulted" or vice versa. */ - -/* Step Size */ -/* ========= */ - -/* Each interval of the confinement window is searched as follows: */ -/* first, the input step size is used to determine the time */ -/* separation at which the occultation state will be sampled. */ -/* Starting at the left endpoint of the interval, samples of the */ -/* occultation state will be taken at each step. If a state change */ -/* is detected, a root has been bracketed; at that point, the */ -/* "root"--the time at which the state change occurs---is found by a */ -/* refinement process, for example, via binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the occultation state is constant: */ -/* the step size should be shorter than the shortest occultation */ -/* duration and the shortest period between occultations, within */ -/* the confinement window. */ - -/* Having some knowledge of the relative geometry of the targets and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set via the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't limit the accuracy of solutions found by this */ -/* routine. In general the accuracy of input data will be the */ -/* limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFOCCE must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. */ - -/* The confinement window also can be used to restrict a search to */ -/* a time window over which required data (typically ephemeris */ -/* data, in the case of occultation searches) are known to be */ -/* available. */ - -/* In some cases, the confinement window be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. See the "CASCADE" */ -/* example program in gf.req for a demonstration. */ - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* 1) Find occultations of the Sun by the Moon (that is, solar */ -/* eclipses) as seen from the center of the Earth over the month */ -/* December, 2001. */ - -/* Use light time corrections to model apparent positions of Sun */ -/* and Moon. Stellar aberration corrections are not specified */ -/* because they don't affect occultation computations. */ - -/* We select a step size of 3 minutes, which means we */ -/* ignore occultation events lasting less than 3 minutes, */ -/* if any exist. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* File name: standard.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de421.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0009.tls' ) */ - -/* \begintext */ - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ - -/* IMPLICIT NONE */ - -/* INTEGER WNCARD */ - -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY MON DD HR:MN:SC.###### (TDB)::TDB' ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 2 * 100 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 40 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* CHARACTER*(TIMLEN) WIN0 */ -/* CHARACTER*(TIMLEN) WIN1 */ -/* CHARACTER*(TIMLEN) BEGSTR */ -/* CHARACTER*(TIMLEN) ENDSTR */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION LEFT */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION RIGHT */ -/* DOUBLE PRECISION STEP */ - -/* INTEGER I */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Initialize the confinement and result windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Obtain the TDB time bounds of the confinement */ -/* C window, which is a single interval in this case. */ -/* C */ -/* WIN0 = '2001 DEC 01 00:00:00 TDB' */ -/* WIN1 = '2002 JAN 01 00:00:00 TDB' */ - -/* CALL STR2ET ( WIN0, ET0 ) */ -/* CALL STR2ET ( WIN1, ET1 ) */ - -/* C */ -/* C Insert the time bounds into the confinement */ -/* C window. */ -/* C */ -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Select a 3-minute step. We'll ignore any occultations */ -/* C lasting less than 3 minutes. Units are TDB seconds. */ -/* C */ -/* STEP = 180.D0 */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFOCLT ( 'ANY', */ -/* . 'MOON', 'ellipsoid', 'IAU_MOON', */ -/* . 'SUN', 'ellipsoid', 'IAU_SUN', */ -/* . 'LT', 'EARTH', STEP, */ -/* . CNFINE, RESULT ) */ - - -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'No occultation was found.' */ - -/* ELSE */ - -/* DO I = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch and display each occultation interval. */ -/* C */ -/* CALL WNFETD ( RESULT, I, LEFT, RIGHT ) */ - -/* CALL TIMOUT ( LEFT, TIMFMT, BEGSTR ) */ -/* CALL TIMOUT ( RIGHT, TIMFMT, ENDSTR ) */ - -/* WRITE (*,*) 'Interval ', I */ -/* WRITE (*,*) ' Start time: '//BEGSTR */ -/* WRITE (*,*) ' Stop time: '//ENDSTR */ - -/* END DO */ - -/* END IF */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - -/* Interval 1 */ -/* Start time: 2001 DEC 14 20:10:14.195952 (TDB) */ -/* Stop time: 2001 DEC 14 21:35:50.317994 (TDB) */ - - - -/* 2) Find occultations of Titan by Saturn or of Saturn by */ -/* Titan as seen from the center of the Earth over the */ -/* last four months of 2008. Model both target bodies as */ -/* ellipsoids. Search for every type of occultation. */ - -/* Use light time corrections to model apparent positions of */ -/* Saturn and Titan. Stellar aberration corrections are not */ -/* specified because they don't affect occultation computations. */ - -/* We select a step size of 15 minutes, which means we */ -/* ignore occultation events lasting less than 15 minutes, */ -/* if any exist. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File name: gfoclt_ex2.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de421.bsp Planetary ephemeris */ -/* sat288.bsp Satellite ephemeris for */ -/* Saturn */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0009.tls Leapseconds */ - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de421.bsp', */ -/* 'sat286.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0009.tls' ) */ - -/* \begintext */ - -/* End of meta-kernel */ - - -/* Example code begins here. */ - - -/* PROGRAM EX2 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY MON DD HR:MN:SC.###### (TDB)::TDB' ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 2 * 100 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 40 ) */ - -/* INTEGER BDNMLN */ -/* PARAMETER ( BDNMLN = 36 ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ -/* C */ -/* C Number of occultation types: */ -/* C */ -/* INTEGER NTYPES */ -/* PARAMETER ( NTYPES = 4 ) */ -/* C */ -/* C Occultation type name length: */ -/* C */ -/* INTEGER OCNMLN */ -/* PARAMETER ( OCNMLN = 10 ) */ -/* C */ -/* C Output line length: */ -/* C */ -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* CHARACTER*(BDNMLN) BACK */ -/* CHARACTER*(FRNMLN) BFRAME */ -/* CHARACTER*(FRNMLN) FFRAME */ -/* CHARACTER*(BDNMLN) FRONT */ -/* CHARACTER*(LNSIZE) LINE */ -/* CHARACTER*(BDNMLN) OBSRVR */ -/* CHARACTER*(OCNMLN) OCCTYP ( NTYPES ) */ -/* CHARACTER*(LNSIZE) TEMPLT ( NTYPES ) */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(LNSIZE) TITLE */ -/* CHARACTER*(TIMLEN) WIN0 */ -/* CHARACTER*(TIMLEN) WIN1 */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION FINISH */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION START */ -/* DOUBLE PRECISION STEP */ - -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER K */ -/* C */ -/* C Saved variables */ -/* C */ -/* C The confinement and result windows CNFINE */ -/* C and RESULT are saved because this practice */ -/* C helps to prevent stack overflow. */ -/* C */ -/* C The variables OCCTYP and TEMPLT are */ -/* C saved to facilitate turning this main program into */ -/* C a subroutine. In a main program, it's not */ -/* C necessary to save these variables. */ -/* C */ -/* SAVE CNFINE */ -/* SAVE OCCTYP */ -/* SAVE RESULT */ -/* SAVE TEMPLT */ -/* C */ -/* C Initial values */ -/* C */ -/* DATA OCCTYP / 'FULL', */ -/* . 'ANNULAR', */ -/* . 'PARTIAL', */ -/* . 'ANY' / */ - -/* DATA TEMPLT / */ -/* . 'Condition: # occultation of # by #', */ -/* . 'Condition: # occultation of # by #', */ -/* . 'Condition: # occultation of # by #', */ -/* . 'Condition: # occultation of # by #' / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'gfoclt_ex2.tm' ) */ - -/* C */ -/* C Initialize the confinement and result windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Obtain the TDB time bounds of the confinement */ -/* C window, which is a single interval in this case. */ -/* C */ -/* WIN0 = '2008 SEP 01 00:00:00 TDB' */ -/* WIN1 = '2009 JAN 01 00:00:00 TDB' */ - -/* CALL STR2ET ( WIN0, ET0 ) */ -/* CALL STR2ET ( WIN1, ET1 ) */ -/* C */ -/* C Insert the time bounds into the confinement */ -/* C window. */ -/* C */ -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ -/* C */ -/* C Select a 15-minute step. We'll ignore any occultations */ -/* C lasting less than 15 minutes. Units are TDB seconds. */ -/* C */ -/* STEP = 900.D0 */ -/* C */ -/* C The observation location is the Earth. */ -/* C */ -/* OBSRVR = 'EARTH' */ - -/* C */ -/* C Loop over the occultation types. */ -/* C */ -/* DO I = 1, NTYPES */ -/* C */ -/* C For each type, do a search for both transits of */ -/* C Titan across Saturn and occultations of Titan by */ -/* C Saturn. */ -/* C */ -/* DO J = 1, 2 */ - -/* IF ( J .EQ. 1 ) THEN */ - -/* FRONT = 'TITAN' */ -/* FFRAME = 'IAU_TITAN' */ -/* BACK = 'SATURN' */ -/* BFRAME = 'IAU_SATURN' */ - -/* ELSE */ - -/* FRONT = 'SATURN' */ -/* FFRAME = 'IAU_SATURN' */ -/* BACK = 'TITAN' */ -/* BFRAME = 'IAU_TITAN' */ - -/* END IF */ -/* C */ -/* C Perform the search. The target body shapes */ -/* C are modeled as ellipsoids. */ -/* C */ -/* CALL GFOCLT ( OCCTYP(I), */ -/* . FRONT, 'ELLIPSOID', FFRAME, */ -/* . BACK, 'ELLIPSOID', BFRAME, */ -/* . 'LT', OBSRVR, STEP, */ -/* . CNFINE, RESULT ) */ -/* C */ -/* C Display the results. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* C */ -/* C Substitute the occultation type and target */ -/* C body names into the title string: */ -/* C */ -/* CALL REPMC ( TEMPLT(I), '#', OCCTYP(I), TITLE ) */ -/* CALL REPMC ( TITLE, '#', BACK, TITLE ) */ -/* CALL REPMC ( TITLE, '#', FRONT, TITLE ) */ - -/* WRITE (*, '(A)' ) TITLE */ - -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ - -/* WRITE (*, '(A)' ) ' Result window is empty: ' */ -/* . // 'no occultation was found.' */ - -/* ELSE */ - -/* WRITE (*, '(A)' ) ' Result window start, ' */ -/* . // 'stop times:' */ - -/* DO K = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch the endpoints of the Kth interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, K, START, FINISH ) */ - -/* LINE = ' # #' */ - -/* CALL TIMOUT ( START, TIMFMT, TIMSTR ) */ - -/* CALL REPMC ( LINE, '#', TIMSTR, LINE ) */ - -/* CALL TIMOUT ( FINISH, TIMFMT, TIMSTR ) */ - -/* CALL REPMC ( LINE, '#', TIMSTR, LINE ) */ - -/* WRITE ( *, '(A)' ) LINE */ - -/* END DO */ - -/* END IF */ -/* C */ -/* C We've finished displaying the results of the */ -/* C current search. */ -/* C */ -/* END DO */ -/* C */ -/* C We've finished displaying the results of the */ -/* C searches using the current occultation type. */ -/* C */ -/* END DO */ - -/* WRITE (*,*) ' ' */ - -/* END */ - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Condition: FULL occultation of SATURN by TITAN */ -/* Result window is empty: no occultation was found. */ - -/* Condition: FULL occultation of TITAN by SATURN */ -/* Result window start, stop times: */ -/* 2008 OCT 27 22:08:01.627053 (TDB) 2008 OCT 28 01:05:03.375236 (TDB) */ -/* 2008 NOV 12 21:21:59.252262 (TDB) 2008 NOV 13 02:06:05.053051 (TDB) */ -/* 2008 NOV 28 20:49:02.402832 (TDB) 2008 NOV 29 02:13:58.986344 (TDB) */ -/* 2008 DEC 14 20:05:09.246177 (TDB) 2008 DEC 15 01:44:53.523002 (TDB) */ -/* 2008 DEC 30 19:00:56.577073 (TDB) 2008 DEC 31 00:42:43.222909 (TDB) */ - -/* Condition: ANNULAR occultation of SATURN by TITAN */ -/* Result window start, stop times: */ -/* 2008 OCT 19 21:29:20.599087 (TDB) 2008 OCT 19 22:53:34.518737 (TDB) */ -/* 2008 NOV 04 20:15:38.620368 (TDB) 2008 NOV 05 00:18:59.139978 (TDB) */ -/* 2008 NOV 20 19:38:59.647712 (TDB) 2008 NOV 21 00:35:26.725908 (TDB) */ -/* 2008 DEC 06 18:58:34.073268 (TDB) 2008 DEC 07 00:16:17.647040 (TDB) */ -/* 2008 DEC 22 18:02:46.288289 (TDB) 2008 DEC 22 23:26:52.712459 (TDB) */ - -/* Condition: ANNULAR occultation of TITAN by SATURN */ -/* Result window is empty: no occultation was found. */ - -/* Condition: PARTIAL occultation of SATURN by TITAN */ -/* Result window start, stop times: */ -/* 2008 OCT 19 20:44:30.326771 (TDB) 2008 OCT 19 21:29:20.599087 (TDB) */ -/* 2008 OCT 19 22:53:34.518737 (TDB) 2008 OCT 19 23:38:26.250580 (TDB) */ -/* 2008 NOV 04 19:54:40.339331 (TDB) 2008 NOV 04 20:15:38.620368 (TDB) */ -/* 2008 NOV 05 00:18:59.139978 (TDB) 2008 NOV 05 00:39:58.612935 (TDB) */ -/* 2008 NOV 20 19:21:46.689523 (TDB) 2008 NOV 20 19:38:59.647712 (TDB) */ -/* 2008 NOV 21 00:35:26.725908 (TDB) 2008 NOV 21 00:52:40.604703 (TDB) */ -/* 2008 DEC 06 18:42:36.100544 (TDB) 2008 DEC 06 18:58:34.073268 (TDB) */ -/* 2008 DEC 07 00:16:17.647040 (TDB) 2008 DEC 07 00:32:16.324244 (TDB) */ -/* 2008 DEC 22 17:47:10.776722 (TDB) 2008 DEC 22 18:02:46.288289 (TDB) */ -/* 2008 DEC 22 23:26:52.712459 (TDB) 2008 DEC 22 23:42:28.850542 (TDB) */ - -/* Condition: PARTIAL occultation of TITAN by SATURN */ -/* Result window start, stop times: */ -/* 2008 OCT 27 21:37:16.970175 (TDB) 2008 OCT 27 22:08:01.627053 (TDB) */ -/* 2008 OCT 28 01:05:03.375236 (TDB) 2008 OCT 28 01:35:49.266506 (TDB) */ -/* 2008 NOV 12 21:01:47.105498 (TDB) 2008 NOV 12 21:21:59.252262 (TDB) */ -/* 2008 NOV 13 02:06:05.053051 (TDB) 2008 NOV 13 02:26:18.227357 (TDB) */ -/* 2008 NOV 28 20:31:28.522707 (TDB) 2008 NOV 28 20:49:02.402832 (TDB) */ -/* 2008 NOV 29 02:13:58.986344 (TDB) 2008 NOV 29 02:31:33.691598 (TDB) */ -/* 2008 DEC 14 19:48:27.094229 (TDB) 2008 DEC 14 20:05:09.246177 (TDB) */ -/* 2008 DEC 15 01:44:53.523002 (TDB) 2008 DEC 15 02:01:36.360243 (TDB) */ -/* 2008 DEC 30 18:44:23.485898 (TDB) 2008 DEC 30 19:00:56.577073 (TDB) */ -/* 2008 DEC 31 00:42:43.222909 (TDB) 2008 DEC 31 00:59:17.030568 (TDB) */ - -/* Condition: ANY occultation of SATURN by TITAN */ -/* Result window start, stop times: */ -/* 2008 OCT 19 20:44:30.326771 (TDB) 2008 OCT 19 23:38:26.250580 (TDB) */ -/* 2008 NOV 04 19:54:40.339331 (TDB) 2008 NOV 05 00:39:58.612935 (TDB) */ -/* 2008 NOV 20 19:21:46.689523 (TDB) 2008 NOV 21 00:52:40.604703 (TDB) */ -/* 2008 DEC 06 18:42:36.100544 (TDB) 2008 DEC 07 00:32:16.324244 (TDB) */ -/* 2008 DEC 22 17:47:10.776722 (TDB) 2008 DEC 22 23:42:28.850542 (TDB) */ - -/* Condition: ANY occultation of TITAN by SATURN */ -/* Result window start, stop times: */ -/* 2008 OCT 27 21:37:16.970175 (TDB) 2008 OCT 28 01:35:49.266506 (TDB) */ -/* 2008 NOV 12 21:01:47.105498 (TDB) 2008 NOV 13 02:26:18.227357 (TDB) */ -/* 2008 NOV 28 20:31:28.522707 (TDB) 2008 NOV 29 02:31:33.691598 (TDB) */ -/* 2008 DEC 14 19:48:27.094229 (TDB) 2008 DEC 15 02:01:36.360243 (TDB) */ -/* 2008 DEC 30 18:44:23.485898 (TDB) 2008 DEC 31 00:59:17.030568 (TDB) */ - - -/* $ Restrictions */ - -/* The kernel files to be used by GFOCLT must be loaded (normally via */ -/* the SPICELIB routine FURNSH) before GFOCLT is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N. J. Bachman (JPL) */ -/* L. S. Elson (JPL) */ -/* E. D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 07-APR-2009 (NJB) (LSE) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF occultation search */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* External routines */ - - -/* Interrupt handler: */ - - -/* Routines to set step size, refine transition times */ -/* and report work: */ - - -/* Local parameters */ - - -/* Geometric quantity bail switch: */ - - -/* Progress report switch: */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFOCLT", (ftnlen)6); - -/* Note to maintenance programmer: input exception checks */ -/* are delegated to GFOCCE. If the implementation of that */ -/* routine changes, or if this routine is modified to call */ -/* a different routine in place of GFOCCE, then the error */ -/* handling performed by GFOCCE will have to be performed */ -/* here or in a routine called by this routine. */ - -/* Check the result window's size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size must be at least 2 but was #.", (ftnlen) - 48); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21); - chkout_("GFOCLT", (ftnlen)6); - return 0; - } - -/* Check step size. */ - - if (*step <= 0.) { - setmsg_("Step size must be positive but was #.", (ftnlen)37); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFOCLT", (ftnlen)6); - return 0; - } - -/* Set the step size. */ - - gfsstp_(step); - -/* Look for solutions. */ - - gfocce_(occtyp, front, fshape, fframe, back, bshape, bframe, abcorr, - obsrvr, &c_b11, (U_fp)gfstep_, (U_fp)gfrefn_, &c_false, (U_fp) - gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, &c_false, (L_fp)gfbail_, - cnfine, result, occtyp_len, front_len, fshape_len, fframe_len, - back_len, bshape_len, bframe_len, abcorr_len, obsrvr_len); - chkout_("GFOCLT", (ftnlen)6); - return 0; -} /* gfoclt_ */ - diff --git a/ext/spice/src/cspice/gfoclt_c.c b/ext/spice/src/cspice/gfoclt_c.c deleted file mode 100644 index 6e74279701..0000000000 --- a/ext/spice/src/cspice/gfoclt_c.c +++ /dev/null @@ -1,1172 +0,0 @@ -/* - --Procedure gfoclt_c ( GF, find occultation ) - --Abstract - - Determine time intervals when an observer sees one target - occulted by, or in transit across, another. - --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 - - FRAMES - GF - KERNEL - NAIF_IDS - SPK - TIME - WINDOWS - --Keywords - - EVENT - GEOMETRY - SEARCH - WINDOW - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void gfoclt_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - --------------- --- ------------------------------------------------- - SPICE_GF_CNVTOL P Convergence tolerance. - occtyp I Type of occultation. - front I Name of body occulting the other. - fshape I Type of shape model used for front body. - fframe I Body-fixed, body-centered frame for front body. - back I Name of body occulted by the other. - bshape I Type of shape model used for back body. - bframe I Body-fixed, body-centered frame for back body. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - step I Step size in seconds for finding occultation - events. - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - --Detailed_Input - - - occtyp indicates the type of occultation that is to be found. - Note that transits are considered to be a type of - occultation. - - Supported values and corresponding definitions are: - - "FULL" denotes the full occultation - of the body designated by - `back' by the body designated - by `front', as seen from - the location of the observer. - In other words, the occulted - body is completely invisible - as seen from the observer's - location. - - "ANNULAR" denotes an annular - occultation: the body - designated by `front' blocks - part of, but not the limb of, - the body designated by `back', - as seen from the location of - the observer. - - "PARTIAL" denotes a partial, non-annular - occultation: the body designated - by `front' blocks part, but not - all, of the limb of the body - designated by `back', as seen - from the location of the - observer. - - "ANY" denotes any of the above three - types of occultations: - "PARTIAL", "ANNULAR", or - "FULL". - - "ANY" should be used to search - for times when the body - designated by `front' blocks - any part of the body designated - by `back'. - - The option "ANY" must be used - if either the front or back - target body is modeled as - a point. - - Case and leading or trailing blanks are not - significant in the string `occtyp'. - - - front is the name of the target body that occults---that is, - passes in front of---the other. Optionally, you may - supply the integer NAIF ID code for the body as a - string. For example both "MOON" and "301" are - legitimate strings that designate the Moon. - - Case and leading or trailing blanks are not - significant in the string `front'. - - - fshape is a string indicating the geometric model used to - represent the shape of the front target body. The - supported options are: - - "ELLIPSOID" Use a triaxial ellipsoid model - with radius values provided via the - kernel pool. A kernel variable - having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF - integer code associated with the - body, must be present in the kernel - pool. This variable must be - associated with three numeric - values giving the lengths of the - ellipsoid's X, Y, and Z semi-axes. - - "POINT" Treat the body as a single point. - When a point target is specified, - the occultation type must be - set to "ANY". - - At least one of the target bodies `front' and `back' must - be modeled as an ellipsoid. - - Case and leading or trailing blanks are not - significant in the string `fshape'. - - - fframe is the name of the body-fixed, body-centered reference - frame associated with the front target body. Examples - of such names are "IAU_SATURN" (for Saturn) and - "ITRF93" (for the Earth). - - If the front target body is modeled as a point, `fframe' - should be left empty or blank. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `fframe'. - - - back is the name of the target body that is occulted - by---that is, passes in back of---the other. - Optionally, you may supply the integer NAIF ID code - for the body as a string. For example both "MOON" and - "301" are legitimate strings that designate the Moon. - - Case and leading or trailing blanks are not - significant in the string `back'. - - - bshape is the shape specification for the body designated by - `back'. The supported options are those for `fshape'. See - the description of `fshape' above for details. - - - bframe is the name of the body-fixed, body-centered reference - frame associated with the ``back'' target body. - Examples of such names are "IAU_SATURN" (for Saturn) - and "ITRF93" (for the Earth). - - If the back target body is modeled as a point, `bframe' - should be left empty or blank. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `bframe'. - - - abcorr indicates the aberration corrections to be applied to - the state of each target body to account for one-way - light time. Stellar aberration corrections are - ignored if specified, since these corrections don't - improve the accuracy of the occultation determination. - - See the header of the SPICE routine spkezr_c for a - detailed description of the aberration correction - options. For convenience, the options supported by - this routine are listed below: - - "NONE" Apply no correction. - - "LT" "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - "CN" "Reception" case: converged - Newtonian light time correction. - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - Case and blanks are not significant in the string - `abcorr'. - - - obsrvr is the name of the body from which the occultation is - observed. Optionally, you may supply the integer NAIF - ID code for the body as a string. - - Case and leading or trailing blanks are not - significant in the string `obsrvr'. - - - step is the step size to be used in the search. `step' must - be shorter than any interval, within the confinement - window, over which the specified condition is met. In - other words, `step' must be shorter than the shortest - occultation event that the user wishes to detect; `step' - must also be shorter than the shortest time interval - between two occultation events that occur within the - confinement window (see below). However, `step' must not - be *too* short, or the search will take an unreasonable - amount of time. - - The choice of `step' affects the completeness but not the - precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. See - the discussion of the parameter SPICE_GF_CNVTOL for - details. - - `step' has units of TDB seconds. - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - The endpoints of the time intervals comprising `cnfine' - are interpreted as seconds past J2000 TDB. - - See the Examples section below for a code example - that shows how to create a confinement window. - - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - specified occultation occurs. - - The endpoints of the time intervals comprising `result' - are interpreted as seconds past J2000 TDB. - - If `result' is non-empty on input, its contents - will be discarded before gfoclt_c conducts its - search. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL, the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found - by this routine depends on the accuracy of the input - data. In most cases, the accuracy of solutions will be - inferior to their precision. - - SPICE_GF_CNVTOL is declared in the header file - - SpiceGF.h - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, the error - SPICE(INVALIDSTEPSIZE) will be signaled. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If name of either target or the observer cannot be translated - to a NAIF ID code, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the radii of a target body modeled as an ellipsoid cannot - be determined by searching the kernel pool for a kernel - variable having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF integer code associated with - the body, the error will be diagnosed by a routine in the - call tree of this routine. - - 5) If either of the target bodies `front' or `back' coincides with - the observer body `obsrvr', the error will be diagnosed by a - routine in the call tree of this routine. - - 6) If the body designated by `front' coincides with that - designated by `back', the error will be diagnosed by a routine - in the call tree of this routine. - - 7) If either of the body model specifiers `fshape' or `bshape' - is not recognized, the error will be diagnosed by a routine - in the call tree of this routine. - - 8) If both of the body model specifiers `fshape' and `bshape' - specify point targets, the error will be diagnosed by a - routine in the call tree of this routine. - - 9) If a target body-fixed reference frame associated with a - non-point target is not recognized, the error will be - diagnosed by a routine in the call tree of this routine. - - 10) If a target body-fixed reference frame is not centered at - the corresponding target body, the error will be - diagnosed by a routine in the call tree of this routine. - - 11) If the loaded kernels provide insufficient data to - compute any required state vector, the deficiency will - be diagnosed by a routine in the call tree of this routine. - - 12) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - - 13) If the output SPICE window `result' has insufficient capacity - to contain the number of intervals on which the specified - occultation condition is met, the error will be diagnosed - by a routine in the call tree of this routine. - - 14) If a point target is specified and the occultation - type is set to a valid value other than "ANY", the - error will be diagnosed by a routine in the call tree - of this routine. - - 15) Invalid occultation types will be diagnosed by a routine in - the call tree of this routine. - - 16) Invalid aberration correction specifications will be - diagnosed by a routine in the call tree of this routine. - - 17) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 18) If any input string argument, other than `fframe' or `bframe', - is empty, the error SPICE(EMPTYSTRING) will be signaled. - --Files - - Appropriate SPICE kernels must be loaded by the calling program - before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the target, source and observer that cover the time - period specified by the window `cnfine'. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files via - furnsh_c. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file via furnsh_c. - - - FK data: if either of the reference frames designated by - `bframe' or `fframe' are not built in to the SPICE system, - one or more FKs specifying these frames must be loaded. - - Kernel data are normally loaded once per program run, NOT every time - this routine is called. - --Particulars - - This routine provides a simpler, but less flexible, interface - than does the CSPICE routine gfocce_c for conducting searches for - occultation events. Applications that require support for - progress reporting, interrupt handling, non-default step or - refinement functions, or non-default convergence tolerance should - call gfocce_c rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window when a specified type of - occultation occurs. The resulting set of intervals is returned as - a SPICE window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - - The Search Process - ================== - - The search for occultations is treated as a search for state - transitions: times are sought when the state of the `back' body - changes from "not occulted" to "occulted" or vice versa. - - Step Size - ========= - - Each interval of the confinement window is searched as follows: - first, the input step size is used to determine the time separation - at which the occultation state will be sampled. Starting at the left - endpoint of the interval, samples of the occultation state will be - taken at each step. If a state change is detected, a root has been - bracketed; at that point, the "root"--the time at which the state - change occurs---is found by a refinement process, for example, via - binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the occultation state is constant: - the step size should be shorter than the shortest occultation - duration and the shortest period between occultations, within - the confinement window. - - Having some knowledge of the relative geometry of the targets and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. This - refinement process terminates when the location of the root has been - determined to within an error margin called the "convergence - tolerance." The convergence tolerance used by this routine is set - via the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't limit the accuracy of solutions found by this - routine. In general the accuracy of input data will be the limiting - factor. - - To use a different tolerance value, a lower-level GF routine such as - gfocce_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are - unlikely to be more accurate. Making the tolerance looser will speed - up searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. - - The confinement window also can be used to restrict a search to - a time window over which required data (typically ephemeris - data, in the case of occultation searches) are known to be - available. - - In some cases, the confinement window be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. See the "CASCADE" - example program in gf.req for a demonstration. - --Examples - - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Find occultations of the Sun by the Moon (that is, solar - eclipses) as seen from the center of the Earth over the month - December, 2001. - - Use light time corrections to model apparent positions of Sun - and Moon. Stellar aberration corrections are not specified - because they don't affect occultation computations. - - We select a step size of 3 minutes, which means we - ignore occultation events lasting less than 3 minutes, - if any exist. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File name: standard.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de421.bsp', - 'pck00008.tpc', - 'naif0009.tls' ) - - \begintext - - - - Example code begins here. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - ./ - - #define TIMFMT "YYYY MON DD HR:MN:SC.###### (TDB)::TDB" - #define MAXWIN 200 - #define TIMLEN 41 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceChar * win0; - SpiceChar * win1; - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble left; - SpiceDouble right; - SpiceDouble step; - - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c ( "standard.tm" ); - - /. - Obtain the TDB time bounds of the confinement - window, which is a single interval in this case. - ./ - win0 = "2001 DEC 01 00:00:00 TDB"; - win1 = "2002 JAN 01 00:00:00 TDB"; - - str2et_c ( win0, &et0 ); - str2et_c ( win1, &et1 ); - - /. - Insert the time bounds into the confinement - window. - ./ - wninsd_c ( et0, et1, &cnfine ); - - /. - Select a 3-minute step. We'll ignore any occultations - lasting less than 3 minutes. Units are TDB seconds. - ./ - step = 180.0; - - /. - Perform the search. - ./ - gfoclt_c ( "any", - "moon", "ellipsoid", "iau_moon", - "sun", "ellipsoid", "iau_sun", - "lt", "earth", step, - &cnfine, &result ); - - if ( wncard_c(&result) == 0 ) - { - printf ( "No occultation was found.\n" ); - } - else - { - for ( i = 0; i < wncard_c(&result); i++ ) - { - /. - Fetch and display each occultation interval. - ./ - wnfetd_c ( &result, i, &left, &right ); - - timout_c ( left, TIMFMT, TIMLEN, begstr ); - timout_c ( right, TIMFMT, TIMLEN, endstr ); - - printf ( "Interval %ld\n" - " Start time: %s\n" - " Stop time: %s\n", - i, begstr, endstr ); - } - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - Interval 0 - Start time: 2001 DEC 14 20:10:14.195952 (TDB) - Stop time: 2001 DEC 14 21:35:50.317994 (TDB) - - - 2) Find occultations of Titan by Saturn or of Saturn by - Titan as seen from the center of the Earth over the - last four months of 2008. Model both target bodies as - ellipsoids. Search for every type of occultation. - - Use light time corrections to model apparent positions of - Saturn and Titan. Stellar aberration corrections are not - specified because they don't affect occultation computations. - - We select a step size of 15 minutes, which means we - ignore occultation events lasting less than 15 minutes, - if any exist. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - - KPL/MK - - File name: gfoclt_ex2.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de421.bsp Planetary ephemeris - sat288.bsp Satellite ephemeris for - Saturn - pck00008.tpc Planet orientation and - radii - naif0009.tls Leapseconds - - \begindata - - KERNELS_TO_LOAD = ( 'de421.bsp', - 'sat288.bsp', - 'pck00008.tpc', - 'naif0009.tls' ) - - \begintext - - End of meta-kernel - - - Example code begins here. - - #include - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - ./ - #define TIMFMT "YYYY MON DD HR:MN:SC.###### (TDB)::TDB" - #define MAXWIN 200 - #define TIMLEN 41 - #define LNSIZE 81 - #define NTYPES 4 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceChar * back; - SpiceChar * bframe; - SpiceChar * front; - SpiceChar * fframe; - SpiceChar line [ LNSIZE ]; - SpiceChar * obsrvr; - - SpiceChar * occtyp [ NTYPES ] = - { - "FULL", - "ANNULAR", - "PARTIAL", - "ANY" - }; - - SpiceChar * templt [ NTYPES ] = - { - "Condition: # occultation of # by #", - "Condition: # occultation of # by #", - "Condition: # occultation of # by #", - "Condition: # occultation of # by #" - }; - - SpiceChar timstr [ TIMLEN ]; - SpiceChar title [ LNSIZE ]; - SpiceChar * win0; - SpiceChar * win1; - - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble finish; - SpiceDouble start; - SpiceDouble step; - - SpiceInt i; - SpiceInt j; - SpiceInt k; - - /. - Load kernels. - ./ - furnsh_c ( "gfoclt_ex2.tm" ); - - /. - Obtain the TDB time bounds of the confinement - window, which is a single interval in this case. - ./ - win0 = "2008 SEP 01 00:00:00 TDB"; - win1 = "2009 JAN 01 00:00:00 TDB"; - - str2et_c ( win0, &et0 ); - str2et_c ( win1, &et1 ); - - /. - Insert the time bounds into the confinement - window. - ./ - wninsd_c ( et0, et1, &cnfine ); - - /. - Select a 15-minute step. We'll ignore any occultations - lasting less than 15 minutes. Units are TDB seconds. - ./ - step = 900.0; - - /. - The observation location is the Earth. - ./ - obsrvr = "Earth"; - - /. - Loop over the occultation types. - ./ - for ( i = 0; i < NTYPES; i++ ) - { - /. - For each type, do a search for both transits of - Titan across Saturn and occultations of Titan by - Saturn. - ./ - for ( j = 0; j < 2; j++ ) - { - if ( j == 0 ) - { - front = "TITAN"; - fframe = "IAU_TITAN"; - back = "SATURN"; - bframe = "IAU_SATURN"; - } - else - { - front = "SATURN"; - fframe = "IAU_SATURN"; - back = "TITAN"; - bframe = "IAU_TITAN"; - } - - /. - Perform the search. The target body shapes - are modeled as ellipsoids. - ./ - gfoclt_c ( occtyp[i], - front, "ellipsoid", fframe, - back, "ellipsoid", bframe, - "lt", obsrvr, step, - &cnfine, &result ); - - /. - Display the results. - ./ - printf ( "\n" ); - - /. - Substitute the occultation type and target - body names into the title string: - ./ - repmc_c ( templt[i], "#", occtyp[i], LNSIZE, title ); - repmc_c ( title, "#", back, LNSIZE, title ); - repmc_c ( title, "#", front, LNSIZE, title ); - - printf ( "%s\n", title ); - - if ( wncard_c(&result) == 0 ) - { - printf ( " Result window is empty: " - "no occultation was found.\n" ); - } - else - { - printf ( " Result window start, stop times:\n" ); - - for ( k = 0; k < wncard_c(&result); k++ ) - { - /. - Fetch the endpoints of the kth interval - of the result window. - ./ - wnfetd_c ( &result, k, &start, &finish ); - - /. - Call strncpy with a length of 7 to include - a terminating null. - ./ - strncpy ( line, " # #", 7 ); - - timout_c ( start, TIMFMT, TIMLEN, timstr ); - - repmc_c ( line, "#", timstr, LNSIZE, line ); - - timout_c ( finish, TIMFMT, TIMLEN, timstr ); - - repmc_c ( line, "#", timstr, LNSIZE, line ); - - printf ( "%s\n", line ); - } - } - /. - We've finished displaying the results of the - current search. - ./ - } - /. - We've finished displaying the results of the - searches using the current occultation type. - ./ - } - printf ( "\n" ); - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Condition: FULL occultation of SATURN by TITAN - Result window is empty: no occultation was found. - - Condition: FULL occultation of TITAN by SATURN - Result window start, stop times: - 2008 OCT 27 22:08:01.627053 (TDB) 2008 OCT 28 01:05:03.375236 (TDB) - 2008 NOV 12 21:21:59.252262 (TDB) 2008 NOV 13 02:06:05.053051 (TDB) - 2008 NOV 28 20:49:02.402832 (TDB) 2008 NOV 29 02:13:58.986344 (TDB) - 2008 DEC 14 20:05:09.246177 (TDB) 2008 DEC 15 01:44:53.523002 (TDB) - 2008 DEC 30 19:00:56.577073 (TDB) 2008 DEC 31 00:42:43.222909 (TDB) - - Condition: ANNULAR occultation of SATURN by TITAN - Result window start, stop times: - 2008 OCT 19 21:29:20.599087 (TDB) 2008 OCT 19 22:53:34.518737 (TDB) - 2008 NOV 04 20:15:38.620368 (TDB) 2008 NOV 05 00:18:59.139978 (TDB) - 2008 NOV 20 19:38:59.647712 (TDB) 2008 NOV 21 00:35:26.725908 (TDB) - 2008 DEC 06 18:58:34.073268 (TDB) 2008 DEC 07 00:16:17.647040 (TDB) - 2008 DEC 22 18:02:46.288289 (TDB) 2008 DEC 22 23:26:52.712459 (TDB) - - Condition: ANNULAR occultation of TITAN by SATURN - Result window is empty: no occultation was found. - - Condition: PARTIAL occultation of SATURN by TITAN - Result window start, stop times: - 2008 OCT 19 20:44:30.326771 (TDB) 2008 OCT 19 21:29:20.599087 (TDB) - 2008 OCT 19 22:53:34.518737 (TDB) 2008 OCT 19 23:38:26.250580 (TDB) - 2008 NOV 04 19:54:40.339331 (TDB) 2008 NOV 04 20:15:38.620368 (TDB) - 2008 NOV 05 00:18:59.139978 (TDB) 2008 NOV 05 00:39:58.612935 (TDB) - 2008 NOV 20 19:21:46.689523 (TDB) 2008 NOV 20 19:38:59.647712 (TDB) - 2008 NOV 21 00:35:26.725908 (TDB) 2008 NOV 21 00:52:40.604703 (TDB) - 2008 DEC 06 18:42:36.100544 (TDB) 2008 DEC 06 18:58:34.073268 (TDB) - 2008 DEC 07 00:16:17.647040 (TDB) 2008 DEC 07 00:32:16.324244 (TDB) - 2008 DEC 22 17:47:10.776722 (TDB) 2008 DEC 22 18:02:46.288289 (TDB) - 2008 DEC 22 23:26:52.712459 (TDB) 2008 DEC 22 23:42:28.850542 (TDB) - - Condition: PARTIAL occultation of TITAN by SATURN - Result window start, stop times: - 2008 OCT 27 21:37:16.970175 (TDB) 2008 OCT 27 22:08:01.627053 (TDB) - 2008 OCT 28 01:05:03.375236 (TDB) 2008 OCT 28 01:35:49.266506 (TDB) - 2008 NOV 12 21:01:47.105498 (TDB) 2008 NOV 12 21:21:59.252262 (TDB) - 2008 NOV 13 02:06:05.053051 (TDB) 2008 NOV 13 02:26:18.227357 (TDB) - 2008 NOV 28 20:31:28.522707 (TDB) 2008 NOV 28 20:49:02.402832 (TDB) - 2008 NOV 29 02:13:58.986344 (TDB) 2008 NOV 29 02:31:33.691598 (TDB) - 2008 DEC 14 19:48:27.094229 (TDB) 2008 DEC 14 20:05:09.246177 (TDB) - 2008 DEC 15 01:44:53.523002 (TDB) 2008 DEC 15 02:01:36.360243 (TDB) - 2008 DEC 30 18:44:23.485898 (TDB) 2008 DEC 30 19:00:56.577073 (TDB) - 2008 DEC 31 00:42:43.222909 (TDB) 2008 DEC 31 00:59:17.030568 (TDB) - - Condition: ANY occultation of SATURN by TITAN - Result window start, stop times: - 2008 OCT 19 20:44:30.326771 (TDB) 2008 OCT 19 23:38:26.250580 (TDB) - 2008 NOV 04 19:54:40.339331 (TDB) 2008 NOV 05 00:39:58.612935 (TDB) - 2008 NOV 20 19:21:46.689523 (TDB) 2008 NOV 21 00:52:40.604703 (TDB) - 2008 DEC 06 18:42:36.100544 (TDB) 2008 DEC 07 00:32:16.324244 (TDB) - 2008 DEC 22 17:47:10.776722 (TDB) 2008 DEC 22 23:42:28.850542 (TDB) - - Condition: ANY occultation of TITAN by SATURN - Result window start, stop times: - 2008 OCT 27 21:37:16.970175 (TDB) 2008 OCT 28 01:35:49.266506 (TDB) - 2008 NOV 12 21:01:47.105498 (TDB) 2008 NOV 13 02:26:18.227357 (TDB) - 2008 NOV 28 20:31:28.522707 (TDB) 2008 NOV 29 02:31:33.691598 (TDB) - 2008 DEC 14 19:48:27.094229 (TDB) 2008 DEC 15 02:01:36.360243 (TDB) - 2008 DEC 30 18:44:23.485898 (TDB) 2008 DEC 31 00:59:17.030568 (TDB) - - --Restrictions - - The kernel files to be used by gfoclt_c must be loaded (normally via - the CSPICE routine furnsh_c) before gfoclt_c is called. - --Literature_References - - None. - --Author_and_Institution - - N. J. Bachman (JPL) - L. S. Elson (JPL) - E. D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 07-APR-2009 (NJB) (LSE) (EDW) - --Index_Entries - - GF occultation search - --& -*/ - -{ /* Begin gfoclt_c */ - - - /* - Local variables - */ - static const SpiceChar * blankStr = " "; - - SpiceChar * bFrameStr; - SpiceChar * fFrameStr; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfoclt_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfoclt_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - The input frame names are special cases because we allow the caller - to pass in empty strings. If either of these strings are empty, - we pass a null-terminated string containing one blank character to - the underlying f2c'd routine. - - First make sure the frame name pointers are non-null. - */ - CHKPTR ( CHK_STANDARD, "gfoclt_c", bframe ); - CHKPTR ( CHK_STANDARD, "gfoclt_c", fframe ); - - /* - Use the input frame strings if they're non-empty; otherwise - use blank strings for the frame names. - */ - - if ( bframe[0] ) - { - bFrameStr = (SpiceChar *) bframe; - } - else - { - bFrameStr = (SpiceChar *) blankStr; - } - - if ( fframe[0] ) - { - fFrameStr = (SpiceChar *) fframe; - } - else - { - fFrameStr = (SpiceChar *) blankStr; - } - - - /* - Check the other input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfoclt_c", occtyp ); - CHKFSTR ( CHK_STANDARD, "gfoclt_c", front ); - CHKFSTR ( CHK_STANDARD, "gfoclt_c", fshape ); - CHKFSTR ( CHK_STANDARD, "gfoclt_c", back ); - CHKFSTR ( CHK_STANDARD, "gfoclt_c", bshape ); - CHKFSTR ( CHK_STANDARD, "gfoclt_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfoclt_c", obsrvr ); - - - /* - Let the f2c'd routine do the work. - */ - gfoclt_ ( (char *) occtyp, - (char *) front, - (char *) fshape, - (char *) fFrameStr, - (char *) back, - (char *) bshape, - (char *) bFrameStr, - (char *) abcorr, - (char *) obsrvr, - (doublereal *) &step, - (doublereal *) cnfine->base, - (doublereal *) result->base, - (ftnlen ) strlen(occtyp), - (ftnlen ) strlen(front), - (ftnlen ) strlen(fshape), - (ftnlen ) strlen(fframe), - (ftnlen ) strlen(back), - (ftnlen ) strlen(bshape), - (ftnlen ) strlen(bframe), - (ftnlen ) strlen(abcorr), - (ftnlen ) strlen(obsrvr) ); - - /* - Sync the output result cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ); - } - - - chkout_c ( "gfoclt_c" ); - -} /* End gfoclt_c */ diff --git a/ext/spice/src/cspice/gfposc.c b/ext/spice/src/cspice/gfposc.c deleted file mode 100644 index 8eda0d42c5..0000000000 --- a/ext/spice/src/cspice/gfposc.c +++ /dev/null @@ -1,1556 +0,0 @@ -/* gfposc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__10 = 10; -static doublereal c_b30 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFPOSC (GF, observer-target vector coordinate search ) */ -/* Subroutine */ int gfposc_(char *target, char *frame, char *abcorr, char * - obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, - doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, - integer *nw, doublereal *work, doublereal *result, ftnlen target_len, - ftnlen frame_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen - crdsys_len, ftnlen coord_len, ftnlen relate_len) -{ - /* Initialized data */ - - static doublereal dvec[3] = { 0.,0.,0. }; - static char dref[80] = " " - " "; - - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical even_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int gfrefn_(), gfrepi_(), gfrepu_(), gfrepf_(), - gfstep_(); - char qcpars[80*10], qpnams[80*10]; - doublereal qdpars[10]; - integer qipars[10]; - logical qlpars[10]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *, - integer *, char *, char *, doublereal *, integer *, logical *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *, - logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine time intervals for which a coordinate of an */ -/* observer-target position vector satisfies a numerical constraint. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* CK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* COORDINATE */ -/* GEOMETRY */ -/* SEARCH */ -/* EVENT */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound */ -/* CNVTOL P Convergence tolerance */ -/* TARGET I Name of the target body */ -/* FRAME I Name of the reference frame for coordinate */ -/* calculations */ -/* ABCORR I Aberration correction flag */ -/* OBSRVR I Name of the observing body */ -/* CRDSYS I Name of the coordinate system containing COORD */ -/* COORD I Name of the coordinate of interest */ -/* RELATE I Relational operator */ -/* REFVAL I Reference value */ -/* ADJUST I Adjustment value for absolute extrema searches */ -/* STEP I Step size used for locating extrema and roots */ -/* CNFINE I SPICE window to which the search is confined */ -/* MW I Workspace window size */ -/* NW I The number of workspace windows needed for */ -/* the search */ -/* WORK I-O Array of workspace windows */ -/* RESULT I-O SPICE window containing results */ - -/* $ Detailed_Input */ - -/* TARGET the string name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector */ -/* that points from the observer to the target. */ - -/* FRAME the string name of the reference frame in which to */ -/* perform state look-ups and coordinate calculations. */ - -/* The SPICE frame subsystem must recognize the 'frame' */ -/* name. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* OBSRVR the string name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to indicate the observer as Earth. */ - -/* CRDSYS the string name of the coordinate system for which the */ -/* coordinate of interest is a member */ - -/* COORD the string name of the coordinate of interest in CRDSYS */ - -/* The supported coordinate systems and coordinate names: */ - -/* Coordinate System (CRDSYS) Coordinates (COORD) Range */ - -/* 'RECTANGULAR' 'X' */ -/* 'Y' */ -/* 'Z' */ - -/* 'LATITUDINAL' 'RADIUS' */ -/* 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ - -/* 'RA/DEC' 'RANGE' */ -/* 'RIGHT ASCENSION' [0,2Pi) */ -/* 'DECLINATION' [-Pi/2,Pi/2] */ - -/* 'SPHERICAL' 'RADIUS' */ -/* 'COLATITUDE' [0,Pi] */ -/* 'LONGITUDE' (-Pi,Pi] */ - -/* 'CYLINDRICAL' 'RADIUS' */ -/* 'LONGITUDE' [0,2Pi) */ -/* 'Z' */ - -/* 'GEODETIC' 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* The ALTITUDE coordinates have a constant value */ -/* of zero +/- roundoff for ellipsoid targets. */ - -/* Limit searches for coordinate events in the GEODETIC */ -/* and PLANETOGRAPHIC coordinate systems to TARGET bodies */ -/* with axial symmetry in the equatorial plane, i.e. */ -/* equality of the body X and Y radii (oblate or prolate */ -/* spheroids). */ - -/* RELATE the string or character describing the relational */ -/* operator used to define a constraint on the selected */ -/* coordinate of the observer-target vector. The result */ -/* window found by this routine indicates the time intervals */ -/* where the constraint is satisfied. Supported values of */ -/* RELATE and corresponding meanings are shown below: */ - -/* '>' The coordinate value is greater than the */ -/* reference value REFVAL. */ - -/* '=' The coordinate value is equal to the */ -/* reference value REFVAL. */ - -/* '<' The coordinate value is less than the */ -/* reference value REFVAL. */ - -/* 'ABSMAX' The coordinate value is at an absolute */ -/* maximum. */ - -/* 'ABSMIN' The coordinate value is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' The coordinate value is at a local */ -/* maximum. */ - -/* 'LOCMIN' The coordinate value is at a local */ -/* minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified measure of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this measure. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* The RELATE string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* REFVAL the double precision reference value used together with */ -/* the argument RELATE to define an equality or inequality */ -/* to satisfy by the selected coordinate of the observer- */ -/* target vector. See the discussion of RELATE above for */ -/* further information. */ - -/* The units of REFVAL correspond to the type as defined */ -/* by COORD, radians for angular measures, kilometers for */ -/* distance measures. */ - -/* ADJUST a double precision value used to modify searches for */ -/* absolute extrema: when RELATE is set to ABSMAX or ABSMIN */ -/* and ADJUST is set to a positive value, GFPOSC finds */ -/* times when the position vector coordinate is within */ -/* ADJUST radians/kilometers of the specified extreme value. */ - -/* For RELATE set to ABSMAX, the RESULT window contains */ -/* time intervals when the position vector coordinate has */ -/* values between ABSMAX - ADJUST and ABSMAX. */ - -/* For RELATE set to ABSMIN, the RESULT window contains */ -/* time intervals when the position vector coordinate has */ -/* values between ABSMIN and ABSMIN + ADJUST. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions. */ - -/* STEP the double precision time step size to use in the search. */ - -/* STEP must be short enough to for a search using this step */ -/* size to locate the time intervals where coordinate */ -/* function of the position vector is monotone increasing or */ -/* decreasing. However, STEP must not be *too* short, or */ -/* the search will take an unreasonable amount of time. */ - -/* For coordinates other than LONGITUDE and RIGHT ASCENSION, */ -/* the step size must be shorter than the shortest interval, */ -/* within the confinement window, over which the coordinate */ -/* is monotone increasing or decreasing. */ - -/* For LONGITUDE and RIGHT ASCENSION, the step size must */ -/* be shorter than the shortest interval, within the */ -/* confinement window, over which either the sin or cos */ -/* of the coordinate is monotone increasing or decreasing. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of seconds. */ - -/* CNFINE a double precision SPICE window that confines the time */ -/* period over which the specified search is conducted. */ -/* CNFINE may consist of a single interval or a collection */ -/* of intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller using the */ -/* SPICELIB routine SSIZED. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. NW should be set to the */ -/* parameter NWMAX; this parameter is declared in the */ -/* include file gf.inc. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* INCLUDE 'gf.inc' */ -/* ... */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* where MW is a constant declared by the caller and */ -/* NWMAX is a constant defined in the SPICELIB INCLUDE */ -/* file gf.inc. See the discussion of MW above. */ - -/* WORK need not be initialized by the caller. */ - -/* RESULT a double precision SPICE window which will contain the */ -/* search results. RESULT must be initialized using */ -/* a call to SSIZED. RESULT must be declared and initialized */ -/* with sufficient size to capture the full set of time */ -/* intervals within the search region on which the specified */ -/* constraint is satisfied. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFPOSC conducts its */ -/* search. */ - -/* $ Detailed_Output */ - -/* WORK the input workspace array, modified by this */ -/* routine. The caller should re-initialize this array */ -/* before attempting to use it for any other purpose. */ - -/* RESULT the SPICE window of intervals, contained within the */ -/* confinement window CNFINE, on which the specified */ -/* constraint is satisfied. */ - -/* If the search is for local extrema, or for absolute */ -/* extrema with ADJUST set to zero, then normally each */ -/* interval of RESULT will be a singleton: the left and */ -/* right endpoints of each interval will be identical. */ - -/* If no times within the confinement window satisfy the */ -/* constraint, RESULT will be returned with a */ -/* cardinality of zero. */ - -/* $ Parameters */ - -/* LBCELL the integer value defining the lower bound for */ -/* SPICE Cell arrays (a SPICE window is a kind of cell). */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the specified coordinate is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, an error is signaled */ -/* by a routine in the call tree of this routine. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - truncation error in time values */ -/* - finite tolerance value */ -/* - errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* RESULT window. One technique to handle such a situation, */ -/* slightly contract RESULT using the window routine WNCOND. */ - -/* 3) If the window size MW is less than 2 or not an even value, */ -/* the error SPICE(INVALIDDIMENSION) will signal. */ - -/* 4) If the window size of RESULT is less than 2, the error */ -/* SPICE(INVALIDDIMENSION) will signal. */ - -/* 5) If an error (typically cell overflow) occurs during */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 6) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 7) If the size of the workspace is too small, an error is */ -/* signaled by a routine in the call tree of this routine. */ - -/* 8) If ADJUST is negative, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 9) If either of the input body names do not map to NAIF ID */ -/* codes, an error is signaled by a routine in the call tree of */ -/* this routine. */ - -/* 10) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* 11) If a body has unequal equatorial radii, a search for */ -/* coordinate events in the GEODETIC or PLANETOGRAPHIC coordinate */ -/* systems will cause the SPICE(NOTSUPPORTED) error to signal. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the calling */ -/* program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer that cover the */ -/* time period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files using */ -/* FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Such kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides a simpler, but less flexible interface */ -/* than does the routine GFEVNT for conducting searches for */ -/* observer-target position vector coordinate value events. */ -/* Applications that require support for progress reporting, */ -/* interrupt handling, non-default step or refinement functions, */ -/* or non-default convergence tolerance should call GFEVNT rather */ -/* than this routine. */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when the selected coordinate of */ -/* the observer-target position vector satisfies a caller-specified */ -/* constraint. The resulting set of intervals is returned as a SPICE */ -/* window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* coordinate function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the coordinate */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of coordinate will be sampled. Starting at */ -/* the left endpoint of an interval, samples will be taken at each */ -/* step. If a change of sign is found, a root has been bracketed; at */ -/* that point, the time at which the time derivative of the */ -/* coordinate is zero can be found by a refinement process, for */ -/* example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the coordinate function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* As described above, the root-finding process used by this routine */ -/* involves first bracketing roots and then using a search process */ -/* to locate them. "Roots" are both times when local extrema are */ -/* attained and times when the coordinate function is equal to a */ -/* reference value. All endpoints of the intervals comprising the */ -/* result window are either endpoints of intervals of the */ -/* confinement window or roots. */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set by the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFEVNT must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - -/* Practical use of the coordinate search capability would likely */ -/* consist of searches over multiple coordinate constraints to find */ -/* time intervals that satisfies the constraints. An */ -/* effective technique to accomplish such a search is */ -/* to use the result window from one search as the confinement window */ -/* of the next. */ - -/* Longitude and Right Ascension */ -/* ============================= */ - -/* The cyclic nature of the longitude and right ascension coordinates */ -/* produces branch cuts at +/- 180 degrees longitude and 0-360 */ -/* longitude. Round-off error may cause solutions near these branches */ -/* to cross the branch. Use of the SPICE routine WNCOND will contract */ -/* solution windows by some epsilon, reducing the measure of the */ -/* windows and eliminating the branch crossing. A one millisecond */ -/* contraction will in most cases eliminate numerical round-off */ -/* caused branch crossings. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* The examples shown below require a "standard" set of SPICE */ -/* kernels. We list these kernels in a meta kernel named */ -/* 'standard.tm'. */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de414.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0009.tls Leapseconds kernel */ -/* earthstns_itrf93_050714.bsp SPK for DSN station */ -/* locations */ -/* earth_topo_050714.tf Topocentric DSN stations */ -/* frame definitions */ -/* earth_000101_080120_071029.bpc High precision earth PCK */ - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( */ -/* '/kernels/gen/lsk/naif0008.tls' */ -/* '/kernels/gen/spk/de414.bsp' */ -/* '/kernels/gen/pck/pck00008.tpc' */ -/* '/kernels/gen/spk/earthstns_itrf93_050714.bsp', */ -/* '/kernels/gen/fk/earth_topo_050714.tf', */ -/* '/kernels/gen/pck/earth_000101_080120_071029.bpc', */ -/* ) */ - -/* Example(1): */ - -/* Find the time during 2007 for which the latitude of the */ -/* Earth-Sun vector in IAU_EARTH frame has the maximum value, */ -/* i.e. the latitude of the Tropic of Cancer. */ - -/* PROGRAM GFPOSC_EX */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION RPD */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Use the parameter MAXWIN for both */ -/* C the result window size and the workspace */ -/* C size. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 750 ) */ - -/* C */ -/* C String length. */ -/* C */ -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 64 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(STRLEN) TIMSTR */ -/* CHARACTER*(STRLEN) TIMFIN */ -/* CHARACTER*(STRLEN) RELATE */ -/* CHARACTER*(STRLEN) CRDSYS */ -/* CHARACTER*(STRLEN) COORD */ -/* CHARACTER*(STRLEN) ABCORR */ -/* CHARACTER*(STRLEN) TARG */ -/* CHARACTER*(STRLEN) OBSRVR */ -/* CHARACTER*(STRLEN) FRAME */ -/* CHARACTER*(STRLEN) TIMFMT */ - - -/* DOUBLE PRECISION ADJUST */ -/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION FINISH */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION START */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWMAX ) */ - -/* INTEGER I */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* TIMFMT = 'YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND' */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the confinement window. */ -/* C */ - -/* CALL STR2ET ( '2007 JAN 1', ET0 ) */ -/* CALL STR2ET ( '2008 JAN 1', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C The latitude varies relatively slowly, ~46 degrees during */ -/* C the year. The extrema occur approximately every six months. */ -/* C Search using a step size less than half that value */ -/* C (180 days). For this example use ninety days */ -/* C (in units of seconds). */ -/* C */ -/* STEP = SPD() * 90.D0 */ -/* ADJUST = 0.D0 */ -/* REFVAL = 0.D0 */ - -/* C */ -/* C Search for the date on which the CRDSYS system */ -/* C coordinate COORD satisfies the RELATE constraint. */ -/* C */ -/* RELATE = 'ABSMAX' */ -/* CRDSYS = 'LATITUDINAL' */ -/* COORD = 'LATITUDE' */ -/* TARG = 'SUN' */ -/* OBSRVR = 'EARTH' */ -/* FRAME = 'IAU_EARTH' */ -/* ABCORR = 'NONE' */ - - -/* C */ -/* C Perform this search using the geometric position */ -/* C of the bodies; set the aberration correction to 'NONE'. */ -/* C */ -/* CALL GFPOSC ( TARG, FRAME, ABCORR, */ -/* . OBSRVR, CRDSYS, COORD, */ -/* . RELATE, REFVAL, ADJUST, */ -/* . STEP, CNFINE, MAXWIN, */ -/* . NWMAX, WORK, RESULT ) */ - -/* C */ -/* C Display the results. */ -/* C */ -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'Result window is empty.' */ - -/* ELSE */ - -/* DO I = 1, WNCARD(RESULT) */ - -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, I, START, FINISH ) */ - -/* IF( START .EQ. FINISH ) THEN */ - -/* C */ -/* C The result window contains singleton */ -/* C intervals, so we need display only the */ -/* C start times. */ -/* C */ -/* CALL TIMOUT ( START, TIMFMT, TIMSTR ) */ -/* WRITE (*, *) 'Event time: ', TIMSTR */ - -/* ELSE */ - -/* CALL TIMOUT ( START, TIMFMT, TIMSTR ) */ -/* CALL TIMOUT ( FINISH, TIMFMT, TIMFIN ) */ - -/* WRITE(*, *) 'From : ', TIMSTR */ -/* WRITE(*, *) 'To : ', TIMFIN */ -/* WRITE(*, *) ' ' */ - -/* END IF */ - -/* END DO */ - -/* END IF */ - -/* END */ - -/* The program outputs: */ - -/* Event time: 2007-JUN-21 17:54:13.166910 (TDB) */ - -/* Example(2): */ - -/* A minor modification of the program listed in Example 1; find */ -/* the time during 2007 for which the latitude of the Earth-Sun */ -/* vector in IAU_EARTH frame has the minimum value, i.e. the */ -/* latitude of the Tropic of Capricorn. */ - -/* Edit the GFPOSC_EX program, assign */ - -/* RELATE = 'ABSMIN' */ - -/* The program outputs: */ - -/* Event time: 2007-DEC-22 06:04:32.630160 (TDB) */ - -/* Example(3): */ - -/* Find the time during 2007 for which the Z component of the */ -/* Earth-Sun vector in IAU_EARTH frame has value 0, i.e. crosses */ -/* the equatorial plane (this also defines a zero latitude). */ -/* The search should return two times, one for an ascending */ -/* passage and one for descending. */ - -/* Edit the GFPOSC_EX program above, assign: */ - -/* RELATE = '=' */ -/* CRDSYS = 'RECTANGULAR' */ -/* COORD = 'Z' */ - -/* Note, this RELATE operator refers to the REFVAL value, */ -/* assigned to 0.D0 for this example. */ - -/* The program outputs: */ - -/* Event time: 2007-MAR-21 00:01:25.495120 (TDB) */ -/* Event time: 2007-SEP-23 09:46:39.574123 (TDB) */ - -/* Example(4): */ - -/* Find the times between Jan 1, 2007 and Jan 1, 2008 */ -/* corresponding to the apoapsis on the Moon's orbit around the */ -/* Earth (note, the GFDIST routine can also perform this search). */ - -/* Edit the GFPOSC_EX program above, assign: */ - -/* This search requires a change in the step size since the */ -/* Moon's orbit about the earth (earth-moon barycenter) has a */ -/* twenty-eight day period. Use a step size something less */ -/* than half that value. In this case, we use twelve days. */ - -/* STEP = SPD() * 12.D0 */ -/* RELATE = 'LOCMAX' */ -/* CRDSYS = 'SPHERICAL' */ -/* COORD = 'RADIUS' */ -/* TARG = 'MOON' */ -/* OBSRVR = 'EARTH' */ -/* FRAME = 'J2000' */ - -/* The program outputs: */ - -/* Event time: 2007-JAN-10 16:26:18.805837 (TDB) */ -/* Event time: 2007-FEB-07 12:39:35.078525 (TDB) */ -/* Event time: 2007-MAR-07 03:38:07.334769 (TDB) */ -/* Event time: 2007-APR-03 08:38:55.222606 (TDB) */ -/* Event time: 2007-APR-30 10:56:49.847028 (TDB) */ -/* Event time: 2007-MAY-27 22:03:28.857783 (TDB) */ -/* Event time: 2007-JUN-24 14:26:23.639351 (TDB) */ -/* Event time: 2007-JUL-22 08:43:50.135565 (TDB) */ -/* Event time: 2007-AUG-19 03:28:33.538170 (TDB) */ -/* Event time: 2007-SEP-15 21:07:13.964698 (TDB) */ -/* Event time: 2007-OCT-13 09:52:30.819371 (TDB) */ -/* Event time: 2007-NOV-09 12:32:50.070555 (TDB) */ -/* Event time: 2007-DEC-06 16:54:31.225504 (TDB) */ - -/* Example(5): */ - -/* Find times between Jan 1, 2007 and Jan 1, 2008 when the */ -/* latitude (elevation) of the observer-target vector between */ -/* DSS 17 and the Moon, as observed in the DSS 17 topocentric */ -/* (station) frame, exceeds 83 degrees. */ - -/* Edit the GFPOSC_EX program above, assign: */ - -/* This search uses a step size of four hours since the time */ -/* for all declination zero-to-max-to-zero passes within */ -/* the search window exceeds eight hours. */ - -/* STEP = SPD() * (4.D0/24.D0) */ -/* REFVAL = 83.D0 * RPD() */ -/* RELATE = '>' */ -/* CRDSYS = 'LATITUDINAL' */ -/* COORD = 'LATITUDE' */ -/* TARG = 'MOON' */ -/* OBSRVR = 'DSS-17' */ -/* FRAME = 'DSS-17_TOPO' */ - -/* The example uses an 83 degree elevation because of its rare */ -/* occurrence and short duration. */ - -/* The program outputs: */ - -/* From : 2007-FEB-26 03:18:48.229806 (TDB) */ -/* To : 2007-FEB-26 03:31:29.734169 (TDB) */ - -/* From : 2007-MAR-25 01:12:38.551183 (TDB) */ -/* To : 2007-MAR-25 01:23:53.908601 (TDB) */ - -/* $ Restrictions */ - -/* 1) The kernel files to be used by this routine must be loaded */ -/* (normally using the SPICELIB routine FURNSH) before this */ -/* routine is called. */ - -/* 2) This routine has the side effect of re-initializing the */ -/* coordinate quantity utility package. Callers may */ -/* need to re-initialize the package after calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 10-JUN-2009 (NJB) (EDW) */ - -/* Edited argument descriptions. */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF position coordinate search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Routines to set step size, refine transition times */ -/* and report work. */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Quantity definition parameter arrays: */ - - -/* Define no-use values for DVEC and DREF */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Check into the error subsystem. */ - - chkin_("GFPOSC", (ftnlen)6); - -/* Confirm minimum window sizes. */ - - if (*mw < 2 || ! even_(mw)) { - setmsg_("Workspace window size was #; size must be at least 2 and an" - " even value.", (ftnlen)71); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFPOSC", (ftnlen)6); - return 0; - } - if (sized_(result) < 2) { - setmsg_("Result window size was #; size must be at least 2.", (ftnlen) - 50); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFPOSC", (ftnlen)6); - return 0; - } - -/* Set up a call to GFEVNT specific to the observer-target */ -/* coordinate search. */ - - s_copy(qpnams, "TARGET", (ftnlen)80, (ftnlen)6); - s_copy(qcpars, target, (ftnlen)80, target_len); - s_copy(qpnams + 80, "OBSERVER", (ftnlen)80, (ftnlen)8); - s_copy(qcpars + 80, obsrvr, (ftnlen)80, obsrvr_len); - s_copy(qpnams + 160, "ABCORR", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 160, abcorr, (ftnlen)80, abcorr_len); - s_copy(qpnams + 240, "COORDINATE SYSTEM", (ftnlen)80, (ftnlen)17); - s_copy(qcpars + 240, crdsys, (ftnlen)80, crdsys_len); - s_copy(qpnams + 320, "COORDINATE", (ftnlen)80, (ftnlen)10); - s_copy(qcpars + 320, coord, (ftnlen)80, coord_len); - s_copy(qpnams + 400, "REFERENCE FRAME", (ftnlen)80, (ftnlen)15); - s_copy(qcpars + 400, frame, (ftnlen)80, frame_len); - s_copy(qpnams + 480, "VECTOR DEFINITION", (ftnlen)80, (ftnlen)17); - s_copy(qcpars + 480, "POSITION", (ftnlen)80, (ftnlen)8); - s_copy(qpnams + 560, "METHOD", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 560, " ", (ftnlen)80, (ftnlen)1); - s_copy(qpnams + 640, "DREF", (ftnlen)80, (ftnlen)4); - s_copy(qcpars + 640, dref, (ftnlen)80, (ftnlen)80); - s_copy(qpnams + 720, "DVEC", (ftnlen)80, (ftnlen)4); - qdpars[0] = dvec[0]; - qdpars[1] = dvec[1]; - qdpars[2] = dvec[2]; - -/* Set the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFPOSC", (ftnlen)6); - return 0; - } - gfsstp_(step); - -/* Initialize the RESULT window to empty. */ - - scardd_(&c__0, result); - -/* Look for solutions. */ - -/* Progress report and interrupt options are set to .FALSE. */ - - gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "COORDINATE", &c__10, qpnams, - qcpars, qdpars, qipars, qlpars, relate, refval, &c_b30, adjust, - cnfine, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw, - nw, work, &c_false, (L_fp)gfbail_, result, (ftnlen)10, (ftnlen) - 80, (ftnlen)80, relate_len); - chkout_("GFPOSC", (ftnlen)6); - return 0; -} /* gfposc_ */ - diff --git a/ext/spice/src/cspice/gfposc_c.c b/ext/spice/src/cspice/gfposc_c.c deleted file mode 100644 index 95f574bcda..0000000000 --- a/ext/spice/src/cspice/gfposc_c.c +++ /dev/null @@ -1,1039 +0,0 @@ -/* - --Procedure gfposc_c (GF, observer-target vector coordinate search) - --Abstract - - Determine time intervals for which a coordinate of an - observer-target position vector satisfies a numerical constraint. - --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 - - GF - NAIF_IDS - SPK - TIME - WINDOWS - --Keywords - - SEPARATION - GEOMETRY - SEARCH - EVENT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceGF.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "zzalloc.h" - - void gfposc_c ( ConstSpiceChar * target, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - SPICE_GF_CNVTOL - P Convergence tolerance. - target I Name of the target body - frame I Name of the reference frame for coordinate calculations - abcorr I Aberration correction flag - obsrvr I Name of the observing body - crdsys I Name of the coordinate system containing COORD - coord I Name of the coordinate of interest - relate I Operator that either looks for an extreme value - (max, min, local, absolute) or compares the - coordinate value and refval - refval I Reference value - adjust I Adjustment value for absolute extrema searches - step I Step size used for locating extrema and roots - nintvls I Workspace window interval count - cnfine I-O SPICE window to which the search is restricted - result O SPICE window containing results - --Detailed_Input - - target the string name of a target body. Optionally, you may - supply the integer ID code for the object as an - integer string. For example both 'MOON' and '301' - are legitimate strings that indicate the moon is the - target body. - - The target and observer define a position vector - that points from the observer to the target. - - frame the string name of the reference frame in which to perform - state look-ups and coordinate calculations. - - The SPICE frame subsystem must recognize the 'frame' name. - - abcorr the string description of the aberration corrections to apply - to the state evaluations to account for one-way light time - and stellar aberration. - - This routine accepts the same aberration corrections as does - the SPICE routine SPKEZR. See the header of SPKEZR for a - detailed description of the aberration correction options. - For convenience, the options are listed below: - - 'NONE' Apply no correction. - - 'LT' "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - 'LT+S' "Reception" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'CN' "Reception" case: converged - Newtonian light time correction. - - 'CN+S' "Reception" case: converged - Newtonian light time and stellar - aberration corrections. - - 'XLT' "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - 'XLT+S' "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'XCN' "Transmission" case: converged - Newtonian light time correction. - - 'XCN+S' "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - The abcorr string lacks sensitivity to case, and to embedded, - leading and trailing blanks. - - obsrvr the string naming the observing body. Optionally, you - may supply the ID code of the object as an integer - string. For example, both 'EARTH' and '399' are - legitimate strings to supply to indicate the - observer is Earth. - - crdsys the string name of the coordinate system for which the - coordinate of interest is a member. - - coord the string name of the coordinate of interest in crdsys. - - The supported coordinate systems and coordinate names are: - - Coordinate System (CRDSYS) Coordinates (COORD) Range - - 'RECTANGULAR' 'X' - 'Y' - 'Z' - - 'LATITUDINAL' 'RADIUS' - 'LONGITUDE' (-Pi,Pi] - 'LATITUDE' [-Pi/2,Pi/2] - - 'RA/DEC' 'RANGE' - 'RIGHT ASCENSION' [0,2Pi) - 'DECLINATION' [-Pi/2,Pi/2] - - 'SPHERICAL' 'RADIUS' - 'COLATITUDE' [0,Pi] - 'LONGITUDE' (-Pi,Pi] - - 'CYLINDRICAL' 'RADIUS' - 'LONGITUDE' [0,2Pi) - 'Z' - - 'GEODETIC' 'LONGITUDE' (-Pi,Pi] - 'LATITUDE' [-Pi/2,Pi/2] - 'ALTITUDE' - - 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) - 'LATITUDE' [-Pi/2,Pi/2] - 'ALTITUDE' - - Limit searches for coordinate events in the GEODETIC and - PLANETOGRAPHIC coordinate systems to TARGET bodies with - axial symmetry in the equatorial plane, i.e. equality - of the body X and Y radii (oblate or prolate spheroids). - - relate the string or character describing the relational operator - used to define a constraint on the selected coordinate of the - observer-target vector. The result window found by this routine - indicates the time intervals where the constraint is satisfied. - Supported values of relate and corresponding meanings are - shown below: - - '>' Separation is greater than the reference - value refval. - - '=' Separation is equal to the reference - value refval. - - '<' Separation is less than the reference - value refval. - - 'ABSMAX' Separation is at an absolute maximum. - - 'ABSMIN' Separation is at an absolute minimum. - - 'LOCMAX' Separation is at a local maximum. - - 'LOCMIN' Separation is at a local minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified measure of an absolute extremum. - The argument ADJUST (described below) is used to - specify this measure. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - The relate string lacks sensitivity to case, leading - and trailing blanks. - - refval the double precision reference value used together with - relate argument to define an equality or inequality to - satisfy by the selected coordinate of the observer-target - vector. See the discussion of relate above for - further information. - - The units of refval correspond to the type as defined - by coord, radians for angular measures, kilometers for - distance measures. - - adjust a double precision value used to modify searches for - absolute extrema: when relate is set to ABSMAX or ABSMIN and - adjust is set to a positive value, gfposc_c finds times when the - observer-target vector coordinate is within adjust - radians/kilometers of the specified extreme value. - - For relate set to ABSMAX, the result window contains - time intervals when the observer-target vector coordinate has - values between ABSMAX - adjust and ABSMAX. - - For relate set to ABSMIN, the result window contains - time intervals when the observer-target vector coordinate has - values between ABSMIN and ABSMIN + adjust. - - adjust is not used for searches for local extrema, - equality or inequality conditions. - - step the double precision time step size to use in the search. - step must be short enough for a search using this step - size to locate the time intervals where coordinate function - of the observer-target vector is monotone increasing or - decreasing. However, step must not be *too* short, or - the search will take an unreasonable amount of time. - - The choice of step affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - - step has units of seconds. - - nintvls an integer value specifying the number of intervals in the - the internal workspace array used by this routine. 'nintvls' - should be at least as large as the number of intervals - within the search region on which the specified observer-target - vector coordinate function is monotone increasing or decreasing. - It does no harm to pick a value of 'nintvls' larger than the - minimum required to execute the specified search, but if chosen - too small, the search will fail. - - cnfine a double precision SPICE window that confines the time - period over which the specified search is conducted. - cnfine may consist of a single interval or a collection - of intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - result the SPICE window of intervals, contained within the - confinement window cnfine, on which the specified - constraint is satisfied. - - If result is non-empty on input, its contents - will be discarded before gfposc_c conducts its - search. - - result must be declared and initialized with sufficient - size to capture the full set of time intervals - within the search region on which the specified constraint - is satisfied. - - If the search is for local extrema, or for absolute - extrema with adjust set to zero, then normally each - interval of result will be a singleton: the left and - right endpoints of each interval will be identical. - - If no times within the confinement window satisfy the - constraint, result will be returned with a - cardinality of zero. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL; the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found by - this routine depends on the accuracy of the input data. - In most cases, the accuracy of solutions will be inferior - to their precision. - - SPICE_GF_CNVTOL has the value 1.0e-6. Units are TDB - seconds. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If the aberration correction specifier contains an - unrecognized value, an error is signaled by a routine in the - call tree of this routine. - - 6) If `adjust' is negative, an error is signaled by a routine in - the call tree of this routine. - - 7) If either of the input body names do not map to NAIF ID - codes, an error is signaled by a routine in the call tree of - this routine. - - 8) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 9) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 11) If the workspace interval count 'nintvls' is less than 1, the - error SPICE(VALUEOUTOFRANGE) will be signaled. - - 12) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - --Files - - Appropriate SPK and PCK kernels must be loaded by the - calling program before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the targets, observer, and any intermediate objects in - a chain connecting the targets and observer that cover the time - period specified by the window CNFINE. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files using - FURNSH. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file using FURNSH. - - - If non-inertial reference frames are used, then PCK - files, frame kernels, C-kernels, and SCLK kernels may be - needed. - - Such kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - This routine provides a simpler, but less flexible interface - than does the routine gfevnt_c for conducting searches for - observer-target vector coordinate value events. Applications - that require support for progress reporting, interrupt - handling, non-default step or refinement functions, or non-default - convergence tolerance should call gfevnt_c rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window when the selected coordinate of - the observer-target vector satisfies a caller-specified - constraint. The resulting set of intervals is returned as a SPICE - window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - coordinate function is monotone increasing and monotone - decreasing. Each of these time periods is represented by a SPICE - window. Having found these windows, all of the coordinate - function's local extrema within the confinement window are known. - Absolute extrema then can be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - - Step Size - ========= - - The monotone windows (described above) are found using a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of coordinate will be sampled. Starting at - the left endpoint of an interval, samples will be taken at each - step. If a change of sign is found, a root has been bracketed; at - that point, the time at which the time derivative of the coordinate - is zero can be found by a refinement process, for example, - using a binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the coordinate function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - Convergence Tolerance - ===================== - - As described above, the root-finding process used by this routine - involves first bracketing roots and then using a search process - to locate them. "Roots" are both times when local extrema are - attained and times when the distance function is equal to a - reference value. All endpoints of the intervals comprising the - result window are either endpoints of intervals of the - confinement window or roots. - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set by the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value in the f2c'd - routine so that the tolerance doesn't become the limiting factor - in the accuracy of solutions found by this routine. In general the - accuracy of input data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such - as gfevnt_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - - Practical use of the coordinate search capability would likely - consist of searches over multiple coordinate constraints to find - time intervals that satisfies the constraints. An effective - technique to accomplish such a search is to use the result - window from one search as the confinement window of the next. - - Longitude and Right Ascension - ============================= - - The cyclic nature of the longitude and right ascension coordinates - produces branch cuts at +/- 180 degrees longitude and 0-360 - longitude. Round-off error may cause solutions near these branches - to cross the branch. Use of the SPICE routine wncond_c will contract - solution windows by some epsilon, reducing the measure of the - windows and eliminating the branch crossing. A one millisecond - contraction will in most cases eliminate numerical round-off caused - branch crossings. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - The examples shown below require a "standard" set of SPICE - kernels. We list these kernels in a meta kernel named 'standard.tm'. - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de414.bsp Planetary ephemeris - pck00008.tpc Planet orientation and radii - naif0009.tls Leapseconds kernel - earthstns_itrf93_050714.bsp SPK for DSN Station Locations - earth_topo_050714.tf Topocentric DSN stations frame - definitions - earth_000101_080120_071029.bpc High precision earth PCK - - \begindata - - KERNELS_TO_LOAD = ( - '/kernels/gen/lsk/naif0008.tls' - '/kernels/gen/spk/de414.bsp' - '/kernels/gen/pck/pck00008.tpc' - '/kernels/gen/spk/earthstns_itrf93_050714.bsp', - '/kernels/gen/fk/earth_topo_050714.tf', - '/kernels/gen/pck/earth_000101_080120_071029.bpc', - ) - - Example(1): - - Find the time during 2007 for which the latitude of the - Earth-Sun vector in IAU_EARTH frame has the maximum value, - i.e. the latitude of the Tropic of Cancer. - - #include - #include - #include - - #include "SpiceUsr.h" - - #define MAXWIN 750 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND" - #define TIMLEN 41 - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one window - consists of two values, so the total number - of cell values to allocate is twice - the number of intervals. - ./ - SPICEDOUBLE_CELL ( result, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - SpiceChar * relate = "ABSMAX"; - SpiceChar * crdsys = "LATITUDINAL"; - SpiceChar * coord = "LATITUDE"; - SpiceChar * targ = "SUN"; - SpiceChar * obsrvr = "EARTH"; - SpiceChar * frame = "IAU_EARTH"; - SpiceChar * abcorr = "NONE"; - - SpiceInt count; - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - - /. - Store the time bounds of our search interval in - the cnfine confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2008 JAN 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - The latitude varies relatively slowly, ~46 degrees during the - year. The extrema occur approximately every six months. - Search using a step size less than half that value (180 days). - For this example use ninety days (in units of seconds). - ./ - step = (90.)*spd_c(); - adjust = 0.; - refval = 0; - - /. - List the beginning and ending points in each interval - if result contains data. - ./ - gfposc_c ( targ, - frame, - abcorr, - obsrvr, - crdsys, - coord, - relate, - refval, - adjust, - step, - MAXWIN, - &cnfine, - &result ); - - count = wncard_c( &result ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result, i, &beg, &end ); - - if ( beg == end ) - { - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - printf ( "Event time: %s\n", begstr ); - } - else - { - - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - timout_c ( end, TIMFMT, TIMLEN, endstr ); - - printf ( "Interval %d\n", i + 1); - printf ( "From : %s \n", begstr ); - printf ( "To : %s \n", endstr ); - printf( " \n" ); - } - - } - } - - kclear_c(); - return( 0 ); - } - - The program outputs: - - Event time: 2007-JUN-21 17:54:13.166910 (TDB) - - Example(2): - - A minor modification of the program listed in Example 1; find the - time during 2007 for which the latitude of the Earth-Sun vector - in IAU_EARTH frame has the minimum value, i.e. the latitude of - the Tropic of Capricorn. - - Edit the example program, assign: - - SpiceChar * relate = "ABSMIN"; - - The program outputs: - - Event time: 2007-DEC-22 06:04:32.630160 (TDB) - - Example(3): - - Find the time during 2007 for which the Z component of the - Earth-Sun vector in IAU_EARTH frame has value 0, i.e. crosses - the equatorial plane (this also defines a zero latitude). - The search should return two times, one for an ascending - passage and one for descending. - - Edit the example program, assign: - - SpiceChar * relate = "="; - SpiceChar * crdsys = "RECTANGULAR"; - SpiceChar * coord = "Z"; - - Note, this RELATE operator refers to the REFVAL value, - assigned to 0.D0 for this example. - - The program outputs: - - Event time: 2007-MAR-21 00:01:25.495120 (TDB) - Event time: 2007-SEP-23 09:46:39.574124 (TDB) - - Example(4): - - Find the times between Jan 1, 2007 and Jan 1, 2008 corresponding - to the apoapsis on the Moon's orbit around the Earth (note, the - GFDIST routine can also perform this search). - - Edit the example program, assign: - - This search requires a change in the step size since the Moon's - orbit about the earth (earth-moon barycenter) has a twenty-eight - day period. Use a step size something less than half that value. - In this case, we use twelve days. - - SpiceChar * relate = "LOCMAX"; - SpiceChar * crdsys = "SPHERICAL"; - SpiceChar * coord = "RADIUS"; - SpiceChar * targ = "MOON"; - SpiceChar * frame = "J2000"; - - step = 12.*spd_c(); - - The program outputs: - - Event time: 2007-JAN-10 16:26:18.805837 (TDB) - Event time: 2007-FEB-07 12:39:35.078525 (TDB) - Event time: 2007-MAR-07 03:38:07.334769 (TDB) - Event time: 2007-APR-03 08:38:55.222606 (TDB) - Event time: 2007-APR-30 10:56:49.847027 (TDB) - Event time: 2007-MAY-27 22:03:28.857783 (TDB) - Event time: 2007-JUN-24 14:26:23.639351 (TDB) - Event time: 2007-JUL-22 08:43:50.135565 (TDB) - Event time: 2007-AUG-19 03:28:33.538169 (TDB) - Event time: 2007-SEP-15 21:07:13.964698 (TDB) - Event time: 2007-OCT-13 09:52:30.819372 (TDB) - Event time: 2007-NOV-09 12:32:50.070555 (TDB) - Event time: 2007-DEC-06 16:54:31.225504 (TDB) - - Example(5): - - Find times between Jan 1, 2007 and Jan 1, 2008 when the latitude - (elevation) of the observer-target vector between DSS 17 and the - Moon, as observed in the DSS 17 topocentric (station) frame, - exceeds 83 degrees. - - Edit the example program, assign: - - This search uses a step size of four hours since the time - for all declination zero-to-max-to-zero passes within - the search window exceeds eight hours. - - SpiceChar * relate = ">"; - SpiceChar * crdsys = "LATITUDINAL"; - SpiceChar * coord = "LATITUDE"; - SpiceChar * targ = "MOON"; - SpiceChar * obsrvr = "DSS-17"; - SpiceChar * frame = "DSS-17_TOPO"; - - step = (4./24.)*spd_c(); - refval = 83. * rpd_c(); - - The program outputs: - - Interval 1 - From : 2007-FEB-26 03:18:48.229806 (TDB) - To : 2007-FEB-26 03:31:29.734169 (TDB) - - Interval 2 - From : 2007-MAR-25 01:12:38.551183 (TDB) - To : 2007-MAR-25 01:23:53.908601 (TDB) - --Restrictions - - 1) The kernel files to be used by this routine must be loaded - (normally via the CSPICE routine furnsh_c) before this routine - is called. - - 2) This routine has the side effect of re-initializing the - coordinate quantity utility package. Callers may - need to re-initialize the package after calling this routine. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 26-AUG-2009 (EDW) - - Correction of several typos. - - -CSPICE Version 1.0.0, 10-FEB-2009 (NJB) (EDW) - --Index_Entries - - GF position coordinate search - --& -*/ - - { /* Begin gfposc_c */ - - /* - Local variables - */ - doublereal * work; - - SpiceInt nBytes; - - static SpiceInt nw = SPICE_GF_NWMAX; - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfposc_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfposc_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfposc_c", target ); - CHKFSTR ( CHK_STANDARD, "gfposc_c", frame ); - CHKFSTR ( CHK_STANDARD, "gfposc_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfposc_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "gfposc_c", crdsys ); - CHKFSTR ( CHK_STANDARD, "gfposc_c", coord ); - CHKFSTR ( CHK_STANDARD, "gfposc_c", relate ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value of one (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfposc_c" ); - return; - } - - /* - Allocate the workspace. 'nintvls' indicates the maximum number of - intervals returned in 'result'. An interval consists of - two values. - */ - - nintvls = 2 * nintvls; - - nBytes = ( nintvls + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) alloc_SpiceMemory( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "gfposc_c" ); - return; - } - - - /* - Let the f2'd routine do the work. - */ - - gfposc_( ( char * ) target, - ( char * ) frame, - ( char * ) abcorr, - ( char * ) obsrvr, - ( char * ) crdsys, - ( char * ) coord, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr), - ( ftnlen ) strlen(crdsys), - ( ftnlen ) strlen(coord), - ( ftnlen ) strlen(relate) ); - - /* - De-allocate the workspace. - */ - free_SpiceMemory( work ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - ALLOC_CHECK; - - chkout_c ( "gfposc_c" ); - - } /* End gfposc_c */ diff --git a/ext/spice/src/cspice/gfrefn.c b/ext/spice/src/cspice/gfrefn.c deleted file mode 100644 index 39e548aad2..0000000000 --- a/ext/spice/src/cspice/gfrefn.c +++ /dev/null @@ -1,168 +0,0 @@ -/* gfrefn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure GFREFN ( GF, default refinement estimator) */ -/* Subroutine */ int gfrefn_(doublereal *t1, doublereal *t2, logical *s1, - logical *s2, doublereal *t) -{ - doublereal x; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* For those times when we can't do better, we use a bisection */ -/* method to find the next estimate of state change. */ - -/* $ 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 */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* T1 I One of two values bracketing a state change. */ -/* T2 I The other value that brackets a state change. */ -/* S1 I State at T1. */ -/* S2 I State at T2. */ -/* T O New value at which to check for transition. */ - -/* $ Detailed_Input */ - -/* T1 One of two abscissa values (usually times) */ -/* bracketing a state change. */ - -/* T2 The other abscissa value that brackets a state change. */ - -/* S1 System state at T1. This argument is provided */ -/* for forward compatibility; it's not currently used. */ - -/* S2 System state at T2. This argument is provided */ -/* for forward compatibility; it's not currently used. */ - -/* $ Detailed_Output */ - -/* T the midpoint of T1 and T2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* "Refinement" means reducing the size of a bracketing interval on the */ -/* real line in which a solution is known to lie. In the GF setting, */ -/* the solution is the time of a state transition of a binary function. */ - -/* This routine supports solving for locations of bracketed state */ -/* transitions by the bisection method. This is the default refinement */ -/* method used by the GF system. */ - -/* The argument list of this routine is compatible with the GF system's */ -/* general root finding routine. Refinement routines created by users */ -/* must have the same argument list in order to be used by the GF */ -/* mid-level APIs such as GFOCCE and GFFOVE. */ - -/* $ Examples */ - -/* The following code fragment from an example program in the header of */ -/* GFOCCE shows the routine passed as the 12th argument. */ - -/* C */ -/* C Define as EXTERNAL the routines to pass to GFOCCE. */ -/* C */ -/* EXTERNAL GFSTEP */ -/* EXTERNAL GFREFN */ -/* EXTERNAL GFREPI */ -/* EXTERNAL GFREPU */ -/* EXTERNAL GFREPF */ -/* EXTERNAL GFBAIL */ - -/* ... initialize for the search ... */ - -/* CALL GFOCCE ( 'ANY', */ -/* . 'MOON', 'ellipsoid', 'IAU_MOON', */ -/* . 'SUN', 'ellipsoid', 'IAU_SUN', */ -/* . 'LT', 'EARTH', CNVTOL, */ -/* . GFSTEP, GFREFN, RPT, */ -/* . GFREPI, GFREPU, GFREPF, */ -/* . BAIL, GFBAIL, CNFINE, RESULT ) */ - -/* $ Restrictions */ - -/* No errors are returned by this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* SPICELIB Version 1.0.0, 03-MAR-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF standard step refinement */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables. */ - - x = *t1 * .5 + *t2 * .5; - *t = brcktd_(&x, t1, t2); - return 0; -} /* gfrefn_ */ - diff --git a/ext/spice/src/cspice/gfrefn_c.c b/ext/spice/src/cspice/gfrefn_c.c deleted file mode 100644 index 25d33e839f..0000000000 --- a/ext/spice/src/cspice/gfrefn_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure gfrefn_c (GF, default refinement estimator) - --Abstract - - For those times when we can't do better, we use a bisection - method to find the next time at which to test for state change. - --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 - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void gfrefn_c ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - t1 I One of two values bracketing a state change. - t2 I The other value that brackets a state change. - s1 I State at t1. - s2 I State at t2. - t O New value at which to check for transition. - --Detailed_Input - - t1 One of two abscissa values (usually times) - bracketing a state change. - - t2 The other abscissa value that brackets a state change. - - s1 System state at t1. This argument is provided - for forward compatibility; it's not currently used. - - s2 System state at t2. This argument is provided - for forward compatibility; it's not currently used. - --Detailed_Output - - t is the midpoint of t1 and t2. - --Parameters - - None. - --Exceptions - - Error free - --Files - - None. - --Particulars - - "Refinement" means reducing the size of a bracketing interval on the - real line in which a solution is known to lie. In the GF setting, - the solution is the time of a state transition of a binary function. - - This routine supports solving for locations of bracketed state - transitions by the bisection method. This is the default refinement - method used by the GF system. - - The argument list of this routine is compatible with the GF system's - general root finding routine. Refinement routines created by users - must have the same argument list in order to be used by the GF - mid-level APIs such as gfocce_c and gffove_c. - --Examples - - The following code fragment from an example program in the header of - gfocce_c shows the address of this routine passed as the 12th argument. - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - &gfstep_c, &gfrefn_c, rpt, - &gfrepi_c, &gfrepu_c, &gfrepf_c, - bail, &gfbail_c, &cnfine, - &result ); - - --Restrictions - - No errors are returned by this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 15-APR-2009 (NJB) (EDW) - --Index_Entries - - GF standard step refinement - --& -*/ - -{ /* Begin gfrefn_c */ - - - /* - Local variables - */ - logical ls1; - logical ls2; - - - /* - This routine is error free; tracing is not performed. - */ - - /* - Let the f2c'd routine do the work. - */ - ls1 = (logical) s1; - ls2 = (logical) s2; - - gfrefn_ ( ( doublereal * ) &t1, - ( doublereal * ) &t2, - ( logical * ) &ls1, - ( logical * ) &ls2, - ( doublereal * ) t ); - -} /* End gfrefn_c */ diff --git a/ext/spice/src/cspice/gfrepf_c.c b/ext/spice/src/cspice/gfrepf_c.c deleted file mode 100644 index bc7aa53d3c..0000000000 --- a/ext/spice/src/cspice/gfrepf_c.c +++ /dev/null @@ -1,206 +0,0 @@ -/* - --Procedure gfrepf_c ( GF, progress report finalization ) - --Abstract - - Finish a GF progress report. - --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 - - GF - TIME - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - void gfrepf_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - None. - --Detailed_Input - - None. - --Detailed_Output - - None. This routine does perform console I/O when progress - reporting is enabled. - --Parameters - - None - --Exceptions - - 1) Any I/O errors resulting from writing to standard output - will be diagnosed by routines in the call tree of this - routine. - --Files - - None. - --Particulars - - This is one of three GF progress reporting routines that cooperate - in order to display a report via console I/O. These routines may - be used by SPICE-based applications as inputs to mid-level GF - search routines. - - Developers wishing to use their own GF progress reporting routines - must design them with the same interfaces and should assign them the - same progress reporting roles as those of these routines. - - The GF progress reporting API routines are written to simplify - reporting of work (such as searching for a geometric event) over a - particular window. This is an important feature for interactive - programs that may "go away" from the user's control for a - considerable length of time. It allows the user to see that - something is still going on (although maybe not too quickly). - - The three routines constituting the GF progress reporting API - are: - - gfrepi_c is used to prepare the reporting mechanism for a search - pass. It is used to store the confinement window and - progress report message prefix and suffix, and to - initialize parameters associated with the reporting of - the job in progress. - - gfrepu_c is used to notify the progress reporting system that - a specified increment of work has been completed - since the last call to gfrepu_c or gfrepi_c, whichever - occurred most recently. - - gfrepf_c is used to "finish" the reporting of work (set the - completion value to 100%. - - --Examples - - - 1) This example shows how to call a mid-level GF search API that - requires as input progress reporting routines. - - If custom progress reporting routines are available, they - can replace gfrepi_c, gfrepu_c, and gfrepf_c in any GF API calls. - - The code fragment below is from the first code example in the - header of - - gfocce_c.c - - Only the portions of that program relevant to use of the - progress reporting routines are copied here. Deleted portions - of code are indicated by ellipses. - - /. - Select a twenty-second step. We'll ignore any occultations - lasting less than 20 seconds. - ./ - gfsstp_c ( 20.0 ); - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, &cnfine, - &result ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 28-FEB-2009 (NJB) (LSE) (WLT) (IMU) (EDW) - - --Index_Entries - - GF finish a progress report - --& -*/ - -{ /* Begin gfrepf_c */ - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "gfrepf_c" ); - - /* - Let the f2c'd routine do the work. - */ - gfrepf_ () ; - - - chkout_c ( "gfrepf_c" ); - -} /* End gfrepf_c */ diff --git a/ext/spice/src/cspice/gfrepi_c.c b/ext/spice/src/cspice/gfrepi_c.c deleted file mode 100644 index 5a3d6dd03f..0000000000 --- a/ext/spice/src/cspice/gfrepi_c.c +++ /dev/null @@ -1,291 +0,0 @@ -/* - --Procedure gfrepi_c ( GF, progress report initialization ) - --Abstract - - This entry point initializes a search progress report. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #undef gfrepi_c - - - void gfrepi_c ( SpiceCell * window, - ConstSpiceChar * begmss, - ConstSpiceChar * endmss ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - MXBEGM P Maximum progress report message prefix length. - MXENDM P Maximum progress report message suffix length. - window I A window over which a job is to be performed. - begmss I Beginning of the text portion of the output message. - endmss I End of the text portion of the output message. - --Detailed_Input - - window is the name of a constraint window. This is the window - associated with some root finding activity. It is - used to determine how much total time is being searched - in order to find the events of interest. - - - begmss is the beginning of the progress report message - written to standard output by the GF subsystem. - This output message has the form - - begmss xxx.xx% endmss - - For example, the progress report message created - by the CSPICE routine gfocce_c at the completion - of a search is - - Occultation/transit search 100.00% done. - - In this message, begmss is - - "Occultation/transit search" - - The total length of `begmss' must be less than - MXBEGM characters. - - All characters of `begmss' must be printable. - - - endmss is the last portion of the output message - written to standard output by the GF subsystem. - - The total length of `endmss' must be less than - MXENDM characters. - - All characters of `endmss' must be printable. - - --Detailed_Output - - None. - --Parameters - - MXBEGM, - MXENDM are, respectively, the maximum lengths of the progress - report message prefix and suffix. - - Normally CSPICE developers will not need to reference - these parameters; these are discussed only to help - explain the functionality of this routine. - - The values of these parameters are defined in the - SPICELIB Fortran INCLUDE file - - zzgf.inc - --Exceptions - - 1) If `begmss' has length greater than MXBEGM characters, or if - `endmss' has length greater than MXENDM characters, the error - SPICE(MESSAGETOOLONG) is signaled. - - 2) If either `begmss' or `endmss' contains non-printing characters, - the error SPICE(NOTPRINTABLECHARS) is signaled. - - 3) The error SPICE(EMPTYSTRING) is signaled if the either input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 4) The error SPICE(NULLPOINTER) is signaled if either input string - pointer is null. - --Files - - None. - --Particulars - - This is one of three GF progress reporting routines that cooperate - in order to display a report via console I/O. These routines may - be used by SPICE-based applications as inputs to mid-level GF - search routines. - - Developers wishing to use their own GF progress reporting routines - must design them with the same interfaces and should assign them the - same progress reporting roles as those of these routines. - - The GF progress reporting API routines are written to simplify - reporting of work (such as searching for a geometric event) over a - particular window. This is an important feature for interactive - programs that may "go away" from the user's control for a - considerable length of time. It allows the user to see that - something is still going on (although maybe not too quickly). - - The three routines constituting the GF progress reporting API - are: - - gfrepi_c is used to prepare the reporting mechanism for a search - pass. It is used to store the confinement window and - progress report message prefix and suffix, and to - initialize parameters associated with the reporting of - the job in progress. - - gfrepu_c is used to notify the progress reporting system that - a specified increment of work has been completed - since the last call to gfrepu_c or gfrepi_c, whichever - occurred most recently. - - gfrepf_c is used to "finish" the reporting of work (set the - completion value to 100%. - - --Examples - - - 1) This example shows how to call a mid-level GF search API that - requires as input progress reporting routines. - - If custom progress reporting routines are available, they - can replace gfrepi_c, gfrepu_c, and gfrepf_c in any GF API calls. - - The code fragment below is from the first code example in the - header of - - gfocce_c.c - - Only the portions of that program relevant to use of the - progress reporting routines are copied here. - - - /. - Select a twenty-second step. We'll ignore any occultations - lasting less than 20 seconds. - ./ - gfsstp_c ( 20.0 ); - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, &cnfine, - &result ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 28-FEB-2009 (NJB) (LSE) (WLT) (IMU) (EDW) - --Index_Entries - - GF initialize progress report - --& -*/ - -{ /* Begin gfrepi_c */ - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfrepi_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfrepi_c", begmss ); - CHKFSTR ( CHK_STANDARD, "gfrepi_c", endmss ); - - /* - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "gfrepi_c", SPICE_DP, window ); - - /* - Initialize the window if necessary. - */ - CELLINIT ( window ); - - - /* - Let the f2c'd routine do the work. - */ - gfrepi_ ( ( doublereal * ) (window->base), - ( char * ) begmss, - ( char * ) endmss, - ( ftnlen ) strlen(begmss), - ( ftnlen ) strlen(endmss) ); - - /* - The cell is an input argument so no sync is necessary. - */ - - chkout_c ( "gfrepi_c" ); - -} /* End gfrepi_c */ diff --git a/ext/spice/src/cspice/gfrepu_c.c b/ext/spice/src/cspice/gfrepu_c.c deleted file mode 100644 index d381d6cdc4..0000000000 --- a/ext/spice/src/cspice/gfrepu_c.c +++ /dev/null @@ -1,238 +0,0 @@ -/* - --Procedure gfrepu_c ( GF, progress report update ) - --Abstract - - This function tells the progress reporting system - how far a search has progressed. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - void gfrepu_c ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble time ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - ivbeg I Start time of work interval. - ivend I End time of work interval. - time I Current time being examined in the search process. - --Detailed_Input - - ivbeg, - ivend are the bounds of a time interval. Normally this interval - is contained within the confinement window `cnfine' passed to - gfrepi_c on the latest call to that function, but this is - not a requirement. - - In order for a meaningful progress report to be displayed, - `ivbeg' and `ivend' must satisfy the following constraints: - - - `ivbeg' must be less than or equal to `ivend'. - - - Over a search pass, the sum of the differences - - ivend - ivbeg - - for all calls to this routine made during the pass - must equal the measure (that is, the sum of the - lengths of the intervals) of the confinement window - `cnfine'. - - - time is the current time reached in the search for an event. - `time' must lie in the interval - - ivbeg : ivend - - inclusive. The input values of `time' for a given interval - need not form an increasing sequence. - - --Detailed_Output - - None. This routine does perform console I/O when progress - reporting is enabled. - --Parameters - - None. - --Exceptions - - 1) If `ivbeg' and `ivend' are in decreasing order, the error - SPICE(BADENDPOINTS) is signaled. - - 2) If `time' is not in the closed interval [ivbeg, ivend], the - error SPICE(VALUEOUTOFRANGE) is signaled. - - 3) Any I/O errors resulting from writing to standard output will be - diagnosed by routines in the call tree of this routine. - --Files - - None. - --Particulars - - This is one of three GF progress reporting routines that cooperate - in order to display a report via console I/O. These routines may - be used by SPICE-based applications as inputs to mid-level GF - search routines. - - Developers wishing to use their own GF progress reporting routines - must design them with the same interfaces and should assign them the - same progress reporting roles as those of these routines. - - The GF progress reporting API routines are written to simplify - reporting of work (such as searching for a geometric event) over a - particular window. This is an important feature for interactive - programs that may "go away" from the user's control for a - considerable length of time. It allows the user to see that - something is still going on (although maybe not too quickly). - - The three routines constituting the GF progress reporting API - are: - - gfrepi_c is used to prepare the reporting mechanism for a search - pass. It is used to store the confinement window and - progress report message prefix and suffix, and to - initialize parameters associated with the reporting of - the job in progress. - - gfrepu_c is used to notify the progress reporting system that - a specified increment of work has been completed - since the last call to gfrepu_c or gfrepi_c, whichever - occurred most recently. - - gfrepf_c is used to "finish" the reporting of work (set the - completion value to 100%. - --Examples - - - 1) This example shows how to call a mid-level GF search API that - requires as input progress reporting routines. - - If custom progress reporting routines are available, they - can replace gfrepi_c, gfrepu_c, and gfrepf_c in any GF API calls. - - The code fragment below is from the first code example in the - header of - - gfocce_c.c - - Only the portions of that program relevant to use of the - progress reporting routines are copied here. - - /. - Select a twenty-second step. We'll ignore any occultations - lasting less than 20 seconds. - ./ - gfsstp_c ( 20.0 ); - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, &cnfine, - &result ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - - --Version - - -CSPICE Version 1.0.0, 28-FEB-2009 (NJB) (LSE) (WLT) (IMU) (EDW) - --Index_Entries - - GF update progress report - --& - -*/{ /* Begin gfrepu_c */ - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return; - } - chkin_c ( "gfrepu_c" ); - - /* - Let the f2c'd routine do the work. - */ - gfrepu_ ( ( doublereal * ) &ivbeg, - ( doublereal * ) &ivend, - ( doublereal * ) &time ); - - chkout_c ( "gfrepu_c" ); - -} /* End gfrepu_c */ diff --git a/ext/spice/src/cspice/gfrfov.c b/ext/spice/src/cspice/gfrfov.c deleted file mode 100644 index 5cd851d27d..0000000000 --- a/ext/spice/src/cspice/gfrfov.c +++ /dev/null @@ -1,1085 +0,0 @@ -/* gfrfov.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b13 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFRFOV ( GF, is ray in FOV? ) */ -/* Subroutine */ int gfrfov_(char *inst, doublereal *raydir, char *rframe, - char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, - doublereal *result, ftnlen inst_len, ftnlen rframe_len, ftnlen - abcorr_len, ftnlen obsrvr_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_(); - extern /* Subroutine */ int gffove_(char *, char *, doublereal *, char *, - char *, char *, char *, doublereal *, U_fp, U_fp, logical *, U_fp, - U_fp, U_fp, logical *, L_fp, doublereal *, doublereal *, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int gfrepu_(), gfstep_(); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), gfsstp_(doublereal *) - ; - -/* $ Abstract */ - -/* Determine time intervals when a specified ray intersects the */ -/* space bounded by the field-of-view (FOV) of a specified */ -/* instrument. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* GF */ -/* KERNEL */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* FOV */ -/* GEOMETRY */ -/* INSTRUMENT */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARGIN P Minimum complement of FOV cone angle. */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance. */ -/* MAXVRT P Maximum number of FOV boundary vertices. */ -/* INST I Name of the instrument. */ -/* RAYDIR I Ray's direction vector. */ -/* RFRAME I Reference frame of ray's direction vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* STEP I Step size in seconds for finding FOV events. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* RESULT O SPICE window containing results. */ - - -/* $ Detailed_Input */ - - -/* INST indicates the name of an instrument, such as a */ -/* spacecraft-mounted framing camera, the field of view */ -/* (FOV) of which is to be used for an target intersection */ -/* search: the direction from the observer to a target */ -/* is represented by a ray, and times when the specified */ -/* ray intersects the region of space bounded by the FOV */ -/* are sought. */ - -/* The position of the instrument designated by INST is */ -/* considered to coincide with that of the ephemeris */ -/* object designated by the input argument OBSRVR (see */ -/* description below). */ - -/* INST must have a corresponding NAIF ID and a frame */ -/* defined, as is normally done in a frame kernel. It */ -/* must also have an associated reference frame and a FOV */ -/* shape, boresight and boundary vertices (or reference */ -/* vector and reference angles) defined, as is usually */ -/* done in an instrument kernel. */ - -/* See the header of the SPICELIB routine GETFOV for a */ -/* description of the required parameters associated with */ -/* an instrument. */ - - -/* RAYDIR is the direction vector associated with a ray */ -/* representing a target. The ray emanates from the */ -/* location of the ephemeris object designated by the */ -/* input argument OBSRVR and is expressed relative to the */ -/* reference frame designated by RFRAME (see descriptions */ -/* below). */ - - -/* RFRAME is the name of the reference frame associated with */ -/* the input ray's direction vector RAYDIR. */ - -/* Since light time corrections are not supported for */ -/* rays, the orientation of the frame is always evaluated */ -/* at the epoch associated with the observer, as opposed */ -/* to the epoch associated with the light-time corrected */ -/* position of the frame center. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* RFRAME. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the ray's direction. */ - -/* The supported aberration correction options are */ - -/* 'NONE' No correction. */ -/* 'S' Stellar aberration correction, */ -/* reception case. */ -/* 'XS' Stellar aberration correction, */ -/* transmission case. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the body from which the target */ -/* represented by RAYDIR is observed. The instrument */ -/* designated by INST is treated as if it were co-located */ -/* with the observer. */ -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* STEP is the step size to be used in the search. STEP must */ -/* be shorter than any interval, within the confinement */ -/* window, over which the specified condition is met. In */ -/* other words, STEP must be shorter than the shortest */ -/* visibility event that the user wishes to detect. STEP */ -/* also must be shorter than the minimum duration */ -/* separating any two visibility events. However, STEP */ -/* must not be *too* short, or the search will take an */ -/* unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of seconds. */ - - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* The endpoints of the time intervals comprising CNFINE */ -/* are interpreted as seconds past J2000 TDB. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* $ Detailed_Output */ - - -/* RESULT is a SPICE window representing the set of time */ -/* intervals, within the confinement period, when the */ -/* input ray is "visible"; that is, when the ray is */ -/* contained in the space bounded by the specified */ -/* instrument's field of view. */ - -/* The endpoints of the time intervals comprising RESULT */ -/* are interpreted as seconds past J2000 TDB. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFRFOV conducts its */ -/* search. */ - -/* $ Parameters */ - -/* LBCELL is the lower bound for SPICE cell arrays. */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* MAXVRT is the maximum number of vertices that may be used */ -/* to define the boundary of the specified instrument's */ -/* field of view. */ - -/* MARGIN is a small positive number used to constrain the */ -/* orientation of the boundary vectors of polygonal */ -/* FOVs. Such FOVs must satisfy the following constraints: */ - -/* 1) The boundary vectors must be contained within */ -/* a right circular cone of angular radius less */ -/* than than (pi/2) - MARGIN radians; in other */ -/* words, there must be a vector A such that all */ -/* boundary vectors have angular separation from */ -/* A of less than (pi/2)-MARGIN radians. */ - -/* 2) There must be a pair of boundary vectors U, V */ -/* such that all other boundary vectors lie in */ -/* the same half space bounded by the plane */ -/* containing U and V. Furthermore, all other */ -/* boundary vectors must have orthogonal */ -/* projections onto a specific plane normal to */ -/* this plane (the normal plane contains the angle */ -/* bisector defined by U and V) such that the */ -/* projections have angular separation of at least */ -/* 2*MARGIN radians from the plane spanned by U */ -/* and V. */ - -/* MARGIN is currently set to 1.D-12. */ - - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEPSIZE) will be signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results. The SPICE window routine */ -/* WNCOND can be used to contract the result window. */ - -/* 3) If the observer's name cannot be mapped to an ID code, the */ -/* error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 4) If the aberration correction flag calls for light time */ -/* correction, the error SPICE(INVALIDOPTION) is signaled. */ - -/* 5) If the ray's direction vector is zero, the error */ -/* SPICE(ZEROVECTOR) is signaled. */ - -/* 6) If the instrument name INST does not have corresponding NAIF */ -/* ID code, the error will be diagnosed by a routine in the call */ -/* tree of this routine. */ - -/* 7) If the FOV parameters of the instrument are not present in */ -/* the kernel pool, the error will be be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* 8) If the FOV boundary has more than MAXVRT vertices, the error */ -/* will be be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* 9) If the instrument FOV is polygonal, and this routine cannot */ -/* find a ray R emanating from the FOV vertex such that maximum */ -/* angular separation of R and any FOV boundary vector is within */ -/* the limit (pi/2)-MARGIN radians, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the FOV */ -/* is any other shape, the same error check will be applied with */ -/* the instrument boresight vector serving the role of R. */ - -/* 10) If the loaded kernels provide insufficient data to compute a */ -/* requested state vector, the error will be diagnosed by a */ -/* routine in the call tree of this routine. */ - -/* 11) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 12) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* visibility condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* $ Files */ - -/* Appropriate SPICE kernels must be loaded by the calling program */ -/* before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for the observer for the period */ -/* defined by the confinement window 'CNFINE' must be loaded. */ -/* If aberration corrections are used, the state of the */ -/* observer relative to the solar system barycenter must be */ -/* calculable from the available ephemeris data. Typically */ -/* ephemeris data are made available by loading one or more SPK */ -/* files via FURNSH. */ - -/* - Data defining the reference frame associated with the */ -/* instrument designated by INST must be available in the kernel */ -/* pool. Additionally the name INST must be associated with an */ -/* ID code. Normally these data are made available by loading */ -/* a frame kernel via FURNSH. */ - -/* - IK data: the kernel pool must contain data such that */ -/* the SPICELIB routine GETFOV may be called to obtain */ -/* parameters for INST. Normally such data are provided by */ -/* an IK via FURNSH. */ - -/* The following data may be required: */ - -/* - CK data: if the instrument frame is fixed to a spacecraft, */ -/* at least one CK file will be needed to permit transformation */ -/* of vectors between that frame and the J2000 frame. */ - -/* - SCLK data: if a CK file is needed, an associated SCLK */ -/* kernel is required to enable conversion between encoded SCLK */ -/* (used to time-tag CK data) and barycentric dynamical time */ -/* (TDB). */ - -/* - Since the input ray direction may be expressed in any */ -/* frame, FKs, CKs, SCLK kernels, PCKs, and SPKs may be */ -/* required to map the direction to the J2000 frame. */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine determines a set of one or more time intervals when */ -/* the specified ray in contained within the field of view of a */ -/* specified instrument. We'll use the term "visibility event" to */ -/* designate such an appearance. The set of time intervals resulting */ -/* from the search is returned as a SPICE window. */ - -/* This routine provides a simpler, but less flexible, interface */ -/* than does the SPICELIB routine GFFOVE for conducting searches for */ -/* visibility events. Applications that require support for progress */ -/* reporting, interrupt handling, non-default step or refinement */ -/* functions, or non-default convergence tolerance should call */ -/* GFFOVE rather than this routine. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient use */ -/* of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* The search for visibility events is treated as a search for state */ -/* transitions: times are sought when the state of the ray */ -/* changes from "not visible" to "visible" or vice versa. */ - -/* Step Size */ -/* ========= */ - -/* Each interval of the confinement window is searched as follows: */ -/* first, the input step size is used to determine the time */ -/* separation at which the visibility state will be sampled. */ -/* Starting at the left endpoint of an interval, samples will be */ -/* taken at each step. If a state change is detected, a root has */ -/* been bracketed; at that point, the "root"--the time at which the */ -/* state change occurs---is found by a refinement process, for */ -/* example, via binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the visibility state is constant: */ -/* the step size should be shorter than the shortest visibility event */ -/* duration and the shortest period between visibility events, within */ -/* the confinement window. */ - -/* Having some knowledge of the relative geometry of the ray and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set via the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFFOVE must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. For an example, see */ -/* the program CASCADE in the GF Example Programs chapter of the GF */ -/* Required Reading, gf.req. */ - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) This example is an extension of example #1 in the */ -/* header of */ - -/* GFTFOV */ - -/* The problem statement for that example is */ - -/* Search for times when Saturn's satellite Phoebe is within */ -/* the FOV of the Cassini narrow angle camera */ -/* (CASSINI_ISS_NAC). To simplify the problem, restrict the */ -/* search to a short time period where continuous Cassini bus */ -/* attitude data are available. */ - -/* Use a step size of 10 seconds to reduce chances of missing */ -/* short visibility events. */ - -/* Here we search the same confinement window for times when a */ -/* selected background star is visible. We use the FOV of the */ -/* Cassini ISS wide angle camera (CASSINI_ISS_WAC) to enhance the */ -/* probability of viewing the star. */ - -/* The star we'll use has catalog number 6000 in the Hipparcos */ -/* Catalog. The star's J2000 right ascension and declination, */ -/* proper motion, and parallax are taken from that catalog. */ - -/* Use the meta-kernel from the GFTFOV example: */ - - -/* KPL/MK */ - -/* File name: gftfov_ex1.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* naif0009.tls Leapseconds */ -/* cpck05Mar2004.tpc Satellite orientation and */ -/* radii */ -/* 981005_PLTEPH-DE405S.bsp Planetary ephemeris */ -/* 020514_SE_SAT105.bsp Satellite ephemeris */ -/* 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris */ -/* cas_v37.tf Cassini FK */ -/* 04135_04171pc_psiv2.bc Cassini bus CK */ -/* cas00084.tsc Cassini SCLK kernel */ -/* cas_iss_v09.ti Cassini IK */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'naif0009.tls', */ -/* 'cpck05Mar2004.tpc', */ -/* '981005_PLTEPH-DE405S.bsp', */ -/* '020514_SE_SAT105.bsp', */ -/* '030201AP_SK_SM546_T45.bsp', */ -/* 'cas_v37.tf', */ -/* '04135_04171pc_psiv2.bc', */ -/* 'cas00084.tsc', */ -/* 'cas_iss_v09.ti' ) */ -/* \begintext */ - - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION J1950 */ -/* DOUBLE PRECISION J2000 */ -/* DOUBLE PRECISION JYEAR */ -/* DOUBLE PRECISION RPD */ - -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'gftfov_ex1.tm' ) */ - -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY-MON-DD HR:MN:SC.######::TDB (TDB)' ) */ - - -/* DOUBLE PRECISION AU */ -/* PARAMETER ( AU = 149597870.693D0 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 10000 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 10 ) */ - -/* INTEGER BDNMLN */ -/* PARAMETER ( BDNMLN = 36 ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 35 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR */ -/* CHARACTER*(BDNMLN) INST */ -/* CHARACTER*(LNSIZE) LINE */ -/* CHARACTER*(BDNMLN) OBSRVR */ -/* CHARACTER*(FRNMLN) RFRAME */ -/* CHARACTER*(TIMLEN) TIMSTR ( 2 ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION DEC */ -/* DOUBLE PRECISION DECEPC */ -/* DOUBLE PRECISION DECPM */ -/* DOUBLE PRECISION DECDEG */ -/* DOUBLE PRECISION DECDG0 */ -/* DOUBLE PRECISION DTDEC */ -/* DOUBLE PRECISION DTRA */ -/* DOUBLE PRECISION ENDPT ( 2 ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION PARLAX */ -/* DOUBLE PRECISION PLXDEG */ -/* DOUBLE PRECISION POS ( 3 ) */ -/* DOUBLE PRECISION PSTAR ( 3 ) */ -/* DOUBLE PRECISION RA */ -/* DOUBLE PRECISION RADEG */ -/* DOUBLE PRECISION RADEG0 */ -/* DOUBLE PRECISION RAEPC */ -/* DOUBLE PRECISION RAPM */ -/* DOUBLE PRECISION RAYDIR ( 3 ) */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION RSTAR */ -/* DOUBLE PRECISION STEPSZ */ -/* DOUBLE PRECISION T */ - -/* INTEGER CATNO */ -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER N */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Insert search time interval bounds into the */ -/* C confinement window. */ -/* C */ -/* CALL STR2ET ( '2004 JUN 11 06:30:00 TDB', ET0 ) */ -/* CALL STR2ET ( '2004 JUN 11 12:00:00 TDB', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Initialize inputs for the search. */ -/* C */ -/* INST = 'CASSINI_ISS_WAC' */ - -/* C */ -/* C Create a unit direction vector pointing from */ -/* c observer to star. We'll assume the direction */ -/* C is constant during the confinement window, and */ -/* C we'll use et0 as the epoch at which to compute the */ -/* C direction from the spacecraft to the star. */ -/* C */ -/* C The data below are for the star with catalog */ -/* C number 6000 in the Hipparcos catalog. Angular */ -/* C units are degrees; epochs have units of Julian */ -/* C years and have a reference epoch of J1950. */ -/* C The reference frame is J2000. */ -/* C */ -/* CATNO = 6000 */ - -/* PLXDEG = 0.000001056D0 */ - -/* RADEG0 = 19.290789927D0 */ -/* RAPM = -0.000000720D0 */ -/* RAEPC = 41.2000D0 */ - -/* DECDG0 = 2.015271007D0 */ -/* DECPM = 0.000001814D0 */ -/* DECEPC = 41.1300D0 */ - -/* RFRAME = 'J2000' */ - -/* C */ -/* C Correct the star's direction for proper motion. */ -/* C */ -/* C The argument t represents et0 as Julian years */ -/* C past J1950. */ -/* C */ -/* T = ET0/JYEAR() */ -/* . + ( J2000()- J1950() ) / 365.25D0 */ - -/* DTRA = T - RAEPC */ -/* DTDEC = T - DECEPC */ - -/* RADEG = RADEG0 + DTRA * RAPM */ -/* DECDEG = DECDG0 + DTDEC * DECPM */ - -/* RA = RADEG * RPD() */ -/* DEC = DECDEG * RPD() */ - -/* CALL RADREC ( 1.D0, RA, DEC, PSTAR ) */ - -/* C */ -/* C Correct star position for parallax applicable at */ -/* C the Cassini orbiter's position. (The parallax effect */ -/* C is negligible in this case; we're simply demonstrating */ -/* C the computation.) */ -/* C */ -/* PARLAX = PLXDEG * RPD() */ -/* RSTAR = AU / TAN(PARLAX) */ - -/* C */ -/* C Scale the star's direction vector by its distance from */ -/* C the solar system barycenter. Subtract off the position */ -/* C of the spacecraft relative to the solar system barycenter; */ -/* C the result is the ray's direction vector. */ -/* C */ -/* CALL VSCLIP ( RSTAR, PSTAR ) */ - -/* CALL SPKPOS ( 'CASSINI', ET0, 'J2000', 'NONE', */ -/* . 'SOLAR SYSTEM BARYCENTER', POS, LT ) */ - -/* CALL VSUB ( PSTAR, POS, RAYDIR ) */ - -/* C */ -/* C Correct the star direction for stellar aberration when */ -/* C we conduct the search. */ -/* C */ -/* ABCORR = 'S' */ -/* OBSRVR = 'CASSINI' */ -/* STEPSZ = 10.D0 */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Instrument: '//INST */ -/* WRITE (*,*) 'Star''s catalog number: ', CATNO */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFRFOV ( INST, RAYDIR, RFRAME, ABCORR, */ -/* . OBSRVR, STEPSZ, CNFINE, RESULT ) */ - -/* N = WNCARD( RESULT ) */ - -/* IF ( N .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'No FOV intersection found.' */ - -/* ELSE */ - -/* WRITE (*,*) */ -/* . ' Visibility start time Stop time' */ - -/* DO I = 1, N */ - -/* CALL WNFETD ( RESULT, I, ENDPT(1), ENDPT(2) ) */ - -/* DO J = 1, 2 */ -/* CALL TIMOUT ( ENDPT(J), TIMFMT, TIMSTR(J) ) */ -/* END DO */ - -/* LINE( :3) = ' ' */ -/* LINE(2: ) = TIMSTR(1) */ -/* LINE(37:) = TIMSTR(2) */ - -/* WRITE (*,*) LINE */ - -/* END DO */ - -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Instrument: CASSINI_ISS_WAC */ -/* Star's catalog number: 6000 */ - -/* Visibility start time Stop time */ -/* 2004-JUN-11 06:30:00.000000 (TDB) 2004-JUN-11 12:00:00.000000 (TDB) */ - - -/* The star is visible throughout the confinement window. */ - - -/* $ Restrictions */ - -/* The kernel files to be used by GFRFOV must be loaded (normally via */ -/* the SPICELIB routine FURNSH) before GFRFOV is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 15-APR-2009 (NJB) (LSE) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF ray in instrument FOV search */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* External routines */ - - -/* Interrupt handler: */ - - -/* Routines to set step size, refine transition times */ -/* and report work: */ - - -/* Local parameters */ - - -/* Geometric quantity bail switch: */ - - -/* Progress report switch: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFRFOV", (ftnlen)6); - -/* Note to maintenance programmer: input exception checks */ -/* are delegated to GFFOVE. If the implementation of that */ -/* routine changes, or if this routine is modified to call */ -/* a different routine in place of GFFOVE, then the error */ -/* handling performed by GFFOVE will have to be performed */ -/* here or in a routine called by this routine. */ - -/* Check the result window's size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size must be at least 2 but was #.", (ftnlen) - 48); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21); - chkout_("GFRFOV", (ftnlen)6); - return 0; - } - -/* Check step size. */ - - if (*step <= 0.) { - setmsg_("Step size must be positive but was #.", (ftnlen)37); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFRFOV", (ftnlen)6); - return 0; - } - -/* Set the step size. */ - - gfsstp_(step); - -/* Look for solutions. */ - - gffove_(inst, "RAY", raydir, " ", rframe, abcorr, obsrvr, &c_b13, (U_fp) - gfstep_, (U_fp)gfrefn_, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, ( - U_fp)gfrepf_, &c_false, (L_fp)gfbail_, cnfine, result, inst_len, ( - ftnlen)3, (ftnlen)1, rframe_len, abcorr_len, obsrvr_len); - chkout_("GFRFOV", (ftnlen)6); - return 0; -} /* gfrfov_ */ - diff --git a/ext/spice/src/cspice/gfrfov_c.c b/ext/spice/src/cspice/gfrfov_c.c deleted file mode 100644 index ee61127a84..0000000000 --- a/ext/spice/src/cspice/gfrfov_c.c +++ /dev/null @@ -1,898 +0,0 @@ -/* - --Procedure gfrfov_c ( GF, is ray in FOV? ) - --Abstract - - Determine time intervals when a specified ray intersects the - space bounded by the field-of-view (FOV) of a specified - instrument. - --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 - - CK - FRAMES - GF - KERNEL - NAIF_IDS - PCK - SPK - TIME - WINDOWS - --Keywords - - EVENT - FOV - GEOMETRY - INSTRUMENT - SEARCH - WINDOW - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef gfrfov_c - - void gfrfov_c ( ConstSpiceChar * inst, - ConstSpiceDouble raydir [3], - ConstSpiceChar * rframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - --------------- --- ------------------------------------------------ - SPICE_GF_MARGIN P Minimum complement of FOV cone angle. - SPICE_GF_CNVTOL P Convergence tolerance. - SPICE_GF_MAXVRT P Maximum number of FOV boundary vertices. - inst I Name of the instrument. - raydir I Ray's direction vector. - rframe I Reference frame of ray's direction vector. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - step I Step size in seconds for finding FOV events. - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - - --Detailed_Input - - - inst indicates the name of an instrument, such as a - spacecraft-mounted framing camera, the field of view - (FOV) of which is to be used for an target intersection - search: the direction from the observer to a target - is represented by a ray, and times when the specified - ray intersects the region of space bounded by the FOV - are sought. - - The position of the instrument designated by `inst' is - considered to coincide with that of the ephemeris - object designated by the input argument `obsrvr' (see - description below). - - `inst' must have a corresponding NAIF ID and a frame - defined, as is normally done in a frame kernel. It - must also have an associated reference frame and a FOV - shape, boresight and boundary vertices (or reference - vector and reference angles) defined, as is usually - done in an instrument kernel. - - See the header of the CSPICE routine getfov_c for a - description of the required parameters associated with - an instrument. - - - raydir is the direction vector associated with a ray - representing a target. The ray emanates from the - location of the ephemeris object designated by the - input argument `obsrvr' and is expressed relative to the - reference frame designated by `rframe' (see descriptions - below). - - - rframe is the name of the reference frame associated with - the input ray's direction vector `raydir'. - - Since light time corrections are not supported for - rays, the orientation of the frame is always evaluated - at the epoch associated with the observer, as opposed - to the epoch associated with the light-time corrected - position of the frame center. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `rframe'. - - - abcorr indicates the aberration corrections to be applied - when computing the ray's direction. - - The supported aberration correction options are - - "NONE" No correction. - "S" Stellar aberration correction, - reception case. - "XS" Stellar aberration correction, - transmission case. - - For detailed information, see the geometry finder - required reading, gf.req. - - Case, leading and trailing blanks are not significant - in the string `abcorr'. - - - obsrvr is the name of the body from which the target - represented by `raydir' is observed. The instrument - designated by `inst' is treated as if it were co-located - with the observer. - - - step is the step size to be used in the search. `step' must - be shorter than any interval, within the confinement - window, over which the specified condition is met. In - other words, `step' must be shorter than the shortest - visibility event that the user wishes to detect. `step' - also must be shorter than the minimum duration - separating any two visibility events. However, `step' - must not be *too* short, or the search will take an - unreasonable amount of time. - - The choice of `step' affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - `step' has units of seconds. - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - The endpoints of the time intervals comprising `cnfine' - are interpreted as seconds past J2000 TDB. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - input ray is "visible"; that is, when the ray is - contained in the space bounded by the specified - instrument's field of view. - - The endpoints of the time intervals comprising `result' - are interpreted as seconds past J2000 TDB. - - If `result' is non-empty on input, its contents - will be discarded before gfrfov_c conducts its - search. - --Parameters - - All parameters described here are declared in the header file - SpiceGF.h. See that file for parameter values. - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL, the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found - by this routine depends on the accuracy of the input - data. In most cases, the accuracy of solutions will be - inferior to their precision. - - - SPICE_GF_MAXVRT - - is the maximum number of vertices that may be used - to define the boundary of the specified instrument's - field of view. - - - SPICE_GF_MARGIN - - is a small positive number used to constrain the - orientation of the boundary vectors of polygonal - FOVs. Such FOVs must satisfy the following constraints: - - 1) The boundary vectors must be contained within - a right circular cone of angular radius less - than than (pi/2) - SPICE_GF_MARGIN radians; in other - words, there must be a vector A such that all - boundary vectors have angular separation from - A of less than (pi/2)-SPICE_GF_MARGIN radians. - - 2) There must be a pair of boundary vectors U, V - such that all other boundary vectors lie in the - same half space bounded by the plane containing U - and V. Furthermore, all other boundary vectors - must have orthogonal projections onto a specific - plane normal to this plane (the normal plane - contains the angle bisector defined by U and V) - such that the projections have angular separation - of at least 2*SPICE_GF_MARGIN radians from the - plane spanned by U and V. - --Exceptions - - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, the error - SPICE(INVALIDSTEPSIZE) will be signaled. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - WNCOND can be used to contract the result window. - - 3) If the observer's name cannot be mapped to an ID code, the - error SPICE(IDCODENOTFOUND) is signaled. - - 4) If the aberration correction flag calls for light time - correction, the error SPICE(INVALIDOPTION) is signaled. - - 5) If the ray's direction vector is zero, the error - SPICE(ZEROVECTOR) is signaled. - - 6) If the instrument name `inst' does not have corresponding NAIF - ID code, the error will be diagnosed by a routine in the call - tree of this routine. - - 7) If the FOV parameters of the instrument are not present in - the kernel pool, the error will be be diagnosed by routines - in the call tree of this routine. - - 8) If the FOV boundary has more than SPICE_GF_MAXVRT vertices, the error - will be be diagnosed by routines in the call tree of this - routine. - - 9) If the instrument FOV is polygonal, and this routine cannot - find a ray R emanating from the FOV vertex such that maximum - angular separation of R and any FOV boundary vector is within - the limit (pi/2)-SPICE_GF_MARGIN radians, the error will be diagnosed - by a routine in the call tree of this routine. If the FOV - is any other shape, the same error check will be applied with - the instrument boresight vector serving the role of R. - - 10) If the loaded kernels provide insufficient data to compute a - requested state vector, the error will be diagnosed by a - routine in the call tree of this routine. - - 11) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - - 12) If the output SPICE window `result' has insufficient capacity - to contain the number of intervals on which the specified - visibility condition is met, the error will be diagnosed - by a routine in the call tree of this routine. If the result - window has size less than 2, the error SPICE(WINDOWTOOSMALL) - will be signaled by this routine. - - 13) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 14) If any input string argument other than `tframe' is empty, the - error SPICE(EMPTYSTRING) will be signaled. - --Files - - Appropriate SPICE kernels must be loaded by the calling program - before this routine is called. - - The following data are required: - - - SPK data: ephemeris data for the observer for the period - defined by the confinement window `cnfine' must be loaded. - If aberration corrections are used, the state of the - observer relative to the solar system barycenter must be - calculable from the available ephemeris data. Typically - ephemeris data are made available by loading one or more SPK - files via furnsh_c. - - - Data defining the reference frame associated with the - instrument designated by `inst' must be available in the kernel - pool. Additionally the name `inst' must be associated with an - ID code. Normally these data are made available by loading a - frame kernel via furnsh_c. - - - IK data: the kernel pool must contain data such that - the CSPICE routine getfov_c may be called to obtain - parameters for `inst'. Normally such data are provided by - an IK via furnsh_c. - - The following data may be required: - - - CK data: if the instrument frame is fixed to a spacecraft, - at least one CK file will be needed to permit transformation - of vectors between that frame and the J2000 frame. - - - SCLK data: if a CK file is needed, an associated SCLK - kernel is required to enable conversion between encoded SCLK - (used to time-tag CK data) and barycentric dynamical time - (TDB). - - - Since the input ray direction may be expressed in any - frame, FKs, CKs, SCLK kernels, PCKs, and SPKs may be - required to map the direction to the J2000 frame. - - Kernel data are normally loaded once per program run, NOT every - time this routine is called. - --Particulars - - This routine determines a set of one or more time intervals when - the specified ray in contained within the field of view of a - specified instrument. We'll use the term "visibility event" to - designate such an appearance. The set of time intervals resulting - from the search is returned as a SPICE window. - - This routine provides a simpler, but less flexible, interface - than does the CSPICE routine gffove_c for conducting searches for - visibility events. Applications that require support for progress - reporting, interrupt handling, non-default step or refinement - functions, or non-default convergence tolerance should call - gffove_c rather than this routine. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient use - of this routine in user applications. - - - The Search Process - ================== - - The search for visibility events is treated as a search for state - transitions: times are sought when the state of the ray - changes from "not visible" to "visible" or vice versa. - - Step Size - ========= - - Each interval of the confinement window is searched as follows: - first, the input step size is used to determine the time - separation at which the visibility state will be sampled. - Starting at the left endpoint of an interval, samples will be - taken at each step. If a state change is detected, a root has - been bracketed; at that point, the "root"--the time at which the - state change occurs---is found by a refinement process, for - example, via binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the visibility state is constant: - the step size should be shorter than the shortest visibility event - duration and the shortest period between visibility events, within - the confinement window. - - Having some knowledge of the relative geometry of the ray and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set via the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't become the limiting factor in the accuracy of - solutions found by this routine. In general the accuracy of input - data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such - as gffove_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the confinement - window can, in some cases, be used to make searches more efficient. - Sometimes it's possible to do an efficient search to reduce the size - of the time period over which a relatively slow search of interest - must be performed. For an example, see the program CASCADE in the GF - Example Programs chapter of the GF Required Reading, gf.req. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) This example is an extension of example #1 in the - header of - - gftfov_c - - The problem statement for that example is - - Search for times when Saturn's satellite Phoebe is within the - FOV of the Cassini narrow angle camera (CASSINI_ISS_NAC). To - simplify the problem, restrict the search to a short time - period where continuous Cassini bus attitude data are - available. - - Use a step size of 10 seconds to reduce chances of missing - short visibility events. - - Here we search the same confinement window for times when a - selected background star is visible. We use the FOV of the - Cassini ISS wide angle camera (CASSINI_ISS_WAC) to enhance the - probability of viewing the star. - - The star we'll use has catalog number 6000 in the Hipparcos - Catalog. The star's J2000 right ascension and declination, proper - motion, and parallax are taken from that catalog. - - Use the meta-kernel from the gftfov_c example: - - - KPL/MK - - File name: gftfov_ex1.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - naif0009.tls Leapseconds - cpck05Mar2004.tpc Satellite orientation and - radii - 981005_PLTEPH-DE405S.bsp Planetary ephemeris - 020514_SE_SAT105.bsp Satellite ephemeris - 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris - cas_v37.tf Cassini FK - 04135_04171pc_psiv2.bc Cassini bus CK - cas00084.tsc Cassini SCLK kernel - cas_iss_v09.ti Cassini IK - - - \begindata - - KERNELS_TO_LOAD = ( 'naif0009.tls', - 'cpck05Mar2004.tpc', - '981005_PLTEPH-DE405S.bsp', - '020514_SE_SAT105.bsp', - '030201AP_SK_SM546_T45.bsp', - 'cas_v37.tf', - '04135_04171pc_psiv2.bc', - 'cas00084.tsc', - 'cas_iss_v09.ti' ) - \begintext - - - - Example code begins here. - - - #include - #include - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - int main() - { - /. - PROGRAM EX1 - ./ - - /. - Local constants - ./ - #define AU 149597870.693 - #define META "gftfov_ex1.tm" - #define TIMFMT "YYYY-MON-DD HR:MN:SC.######::TDB (TDB)" - #define TIMLEN 41 - #define MAXWIN 10000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceChar * abcorr; - SpiceChar * inst; - SpiceChar * obsrvr; - SpiceChar * rframe; - SpiceChar timstr [2][ TIMLEN ]; - - SpiceDouble dec; - SpiceDouble dec_deg; - SpiceDouble dec_deg_0; - SpiceDouble dec_epoch; - SpiceDouble dec_pm; - SpiceDouble dtdec; - SpiceDouble dtra; - SpiceDouble endpt [2]; - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble lt; - SpiceDouble parallax; - SpiceDouble parallax_deg; - SpiceDouble pos [3]; - SpiceDouble ra; - SpiceDouble ra_deg; - SpiceDouble ra_deg_0; - SpiceDouble ra_epoch; - SpiceDouble ra_pm; - SpiceDouble raydir [3]; - SpiceDouble stardist; - SpiceDouble starpos [3]; - SpiceDouble stepsz; - SpiceDouble t; - - SpiceInt catno; - SpiceInt i; - SpiceInt j; - SpiceInt n; - - /. - Load kernels. - ./ - furnsh_c ( META ); - - /. - Insert search time interval bounds into the - confinement window. - ./ - str2et_c ( "2004 JUN 11 06:30:00 TDB", &et0 ); - str2et_c ( "2004 JUN 11 12:00:00 TDB", &et1 ); - - wninsd_c ( et0, et1, &cnfine ); - - /. - Initialize inputs for the search. - ./ - inst = "CASSINI_ISS_WAC"; - - /. - Create a unit direction vector pointing from observer to star. - We'll assume the direction is constant during the confinement - window, and we'll use et0 as the epoch at which to compute the - direction from the spacecraft to the star. - - The data below are for the star with catalog number 6000 - in the Hipparcos catalog. Angular units are degrees; epochs - have units of Julian years and have a reference epoch of J1950. - The reference frame is J2000. - ./ - catno = 6000; - - parallax_deg = 0.000001056; - - ra_deg_0 = 19.290789927; - ra_pm = -0.000000720; - ra_epoch = 41.2000; - - dec_deg_0 = 2.015271007; - dec_pm = 0.000001814; - dec_epoch = 41.1300; - - rframe = "J2000"; - - /. - Correct the star's direction for proper motion. - - The argument t represents et0 as Julian years past J1950. - ./ - t = et0/jyear_c() + ( j2000_c()- j1950_c() )/365.25; - - dtra = t - ra_epoch; - dtdec = t - dec_epoch; - - ra_deg = ra_deg_0 + dtra * ra_pm; - dec_deg = dec_deg_0 + dtdec * dec_pm; - - ra = ra_deg * rpd_c(); - dec = dec_deg * rpd_c(); - - radrec_c ( 1.0, ra, dec, starpos ); - - /. - Correct star position for parallax applicable at - the Cassini orbiter's position. (The parallax effect - is negligible in this case; we're simply demonstrating - the computation.) - ./ - parallax = parallax_deg * rpd_c(); - stardist = AU / tan(parallax); - - /. - Scale the star's direction vector by its distance from - the solar system barycenter. Subtract off the position - of the spacecraft relative to the solar system barycenter; - the result is the ray's direction vector. - ./ - vscl_c ( stardist, starpos, starpos ); - - spkpos_c ( "cassini", et0, "J2000", "NONE", - "solar system barycenter", pos, < ); - - vsub_c ( starpos, pos, raydir ); - - /. - Correct the star direction for stellar aberration when - we conduct the search. - ./ - abcorr = "S"; - obsrvr = "CASSINI"; - stepsz = 10.0; - - printf ( "\n" - " Instrument: %s\n" - " Star's catalog number: %ld\n" - "\n", - inst, - catno ); - - /. - Perform the search. - ./ - gfrfov_c ( inst, raydir, rframe, abcorr, - obsrvr, stepsz, &cnfine, &result ); - - - n = wncard_c ( &result ); - - if ( n == 0 ) - { - printf ( "No FOV intersection found.\n" ); - } - else - { - printf ( " Visibility start time Stop time\n" ); - - for ( i = 0; i < n; i++ ) - { - wnfetd_c ( &result, i, endpt, endpt+1 ); - - for ( j = 0; j < 2; j++ ) - { - timout_c ( endpt[j], TIMFMT, TIMLEN, timstr[j] ); - } - - printf ( " %s %s\n", - timstr[0], - timstr[1] ); - } - } - - printf ( "\n" ); - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Instrument: CASSINI_ISS_WAC - Star's catalog number: 6000 - - Visibility start time Stop time - 2004-JUN-11 06:30:00.000000 (TDB) 2004-JUN-11 12:00:00.000000 (TDB) - - - The star is visible throughout the confinement window. - - --Restrictions - - The kernel files to be used by gfrfov_c must be loaded (normally via - the CSPICE routine furnsh_c) before gfrfov_c is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 12-FEB-2009 (NJB) (LSE) (EDW) - --Index_Entries - - GF ray in instrument FOV search - --& -*/ - -{ /* Begin gfrfov_c */ - - - /* - Local variables - */ - SpiceChar * obsrvrStr; - - /* - Static variables - */ - static const SpiceChar * blankStr = " "; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfrfov_c" ); - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfrfov_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - The input observer name is a special case because we allow the - caller to pass in an empty string. If this string is empty, we pass - a null-terminated string containing one blank character to the - underlying f2c'd routine. - - First make sure the observer name pointer is non-null. - */ - CHKPTR ( CHK_STANDARD, "gfrfov_c", obsrvr ); - - /* - Use the input observer name string if it's non-empty; otherwise - use a blank string for the instr name. - */ - - if ( obsrvr[0] ) - { - obsrvrStr = (SpiceChar *) obsrvr; - } - else - { - obsrvrStr = (SpiceChar *) blankStr; - } - - /* - Check the other input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfrfov_c", inst ); - CHKFSTR ( CHK_STANDARD, "gfrfov_c", rframe ); - CHKFSTR ( CHK_STANDARD, "gfrfov_c", abcorr ); - - /* - Let the f2c'd routine do the work. - */ - gfrfov_ ( (char *) inst, - (doublereal *) raydir, - (char *) rframe, - (char *) abcorr, - (char *) obsrvrStr, - (doublereal *) &step, - (doublereal *) cnfine->base, - (doublereal *) result->base, - (ftnlen ) strlen(inst), - (ftnlen ) strlen(rframe), - (ftnlen ) strlen(abcorr), - (ftnlen ) strlen(obsrvrStr) ); - - /* - Sync the output result cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ); - } - - chkout_c ( "gfrfov_c" ); - -} /* End gfrfov_c */ - diff --git a/ext/spice/src/cspice/gfrprt.c b/ext/spice/src/cspice/gfrprt.c deleted file mode 100644 index c3da240712..0000000000 --- a/ext/spice/src/cspice/gfrprt.c +++ /dev/null @@ -1,1121 +0,0 @@ -/* gfrprt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__55 = 55; -static integer c__13 = 13; -static doublereal c_b26 = 1.; -static integer c__4 = 4; -static doublereal c_b44 = 0.; -static integer c__1 = 1; - -/* $Procedure GFRPRT ( GF, progress reporting package ) */ -/* Subroutine */ int gfrprt_0_(int n__, doublereal *window, char *begmss, - char *endmss, doublereal *ivbeg, doublereal *ivend, doublereal *time, - ftnlen begmss_len, ftnlen endmss_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal incr, freq; - integer long__, unit; - extern /* Subroutine */ int zzgfwkad_(doublereal *, integer *, char *, - char *, ftnlen, ftnlen), zzgfwkin_(doublereal *), zzgfdsps_( - integer *, char *, char *, integer *, ftnlen, ftnlen), zzgfwkmo_( - integer *, doublereal *, doublereal *, integer *, char *, char *, - doublereal *, ftnlen, ftnlen), zzgftswk_(doublereal *, doublereal - *, integer *, char *, char *, ftnlen, ftnlen); - integer i__; - extern integer cardd_(doublereal *); - char begin[55]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char copyb[55]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - static char copye[13]; - extern /* Subroutine */ int stdio_(char *, integer *, ftnlen); - doublereal total; - integer short__; - static doublereal t0; - extern logical failed_(void); - integer tcheck, chrcod; - static doublereal remain; - extern integer lastnb_(char *, ftnlen); - doublereal stddev; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - doublereal measur; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), wnsumd_(doublereal *, - doublereal *, doublereal *, doublereal *, integer *, integer *); - extern logical return_(void); - integer stdout; - char end[13]; - doublereal ave; - -/* $ Abstract */ - -/* The entry points contained under this routine provide users */ -/* information regarding the status of a GF search in progress. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P The SPICELIB cell lower bound. */ -/* MXBEGM P Maximum progress report message prefix length. */ -/* MXENDM P Maximum progress report message suffix length. */ -/* WINDOW I A window over which a job is to be performed. */ -/* BEGMSS I Beginning of the text portion of the output message */ -/* ENDMSS I End of the text portion of the output message */ -/* IVBEG I Current confinement window interval start time. */ -/* IVEND I Current confinement window interval stop time. */ -/* TIME I Input to the reporting routine. */ - -/* $ Detailed_Input */ - -/* See the individual entry points. */ - -/* $ Detailed_Output */ - -/* See the individual entry points. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* $ Exceptions */ - -/* See the individual entry points. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This umbrella routine contains default progress reporting entry */ -/* points that display a report via console I/O. These routines may */ -/* be used by SPICE-based applications as inputs to mid-level GF */ -/* search routines. These routines may be useful even when progress */ -/* reporting is not desired, since the mid-level search routines */ -/* provide some capabilities that aren't supported by the top-level */ -/* GF routines. */ - -/* Developers wishing to use their own GF progress reporting */ -/* routines must design them with the same interfaces and should */ -/* assign them the same progress reporting roles as the entry points */ -/* of these routines. */ - -/* The entry points contained in this routine are written to */ -/* make reporting of work (such as searching for a geometric event) */ -/* over a particular window easy. This is an important feature for */ -/* interactive programs that may "go away" from the user's control */ -/* for a considerable length of time. It allows the user to see that */ -/* something is still going on (although maybe not too quickly). */ - -/* The three entry points contained under this module are: */ - -/* GFREPI used to set up the reporting mechanism. It lets GFRPRT */ -/* know that some task is about to begin that involves */ -/* interaction with some window of times. It is used */ -/* only to set up and store the constants associated with */ -/* the reporting of the job in progress. */ - -/* GFREPU is used to notify the reporter that work has */ -/* progressed to a given point with respect to the start */ -/* of the confinement window. */ - -/* GFREPF is used to "finish" the reporting of work (set the */ -/* completion value to 100%. */ - -/* The progress reporting utilities are called by GF search routines */ -/* as follows: */ - -/* 1) Given a window over which some work is to be performed, */ -/* CALL GFREPI with the appropriate inputs, to let the routine */ -/* know the intervals over which some work is to be done. */ - -/* 2) Each time some "good" amount of work has been done, call */ -/* GFREPU so that the total amount of work done can be updated */ -/* and can be reported. */ - -/* 3) When work is complete call GFREPF to "clean up" the end of */ -/* the progress report. */ - -/* $ Examples */ - -/* 1) This example shows how to call a mid-level GF search API that */ -/* requires as input progress reporting routines. */ - -/* If custom progress reporting routines are available, they */ -/* can replace GFREPI, GFREPU, and GFREPF in any GF API calls. */ - -/* The code fragment below is from the first code example in the */ -/* header of */ - -/* gfocce.for */ - -/* Only the portions of that program relevant to use of the */ -/* progress reporting routines are copied here. Deleted portions */ -/* of code are indicated by ellipses. */ - - -/* PROGRAM EX1 */ - -/* IMPLICIT NONE */ - -/* ... */ - -/* EXTERNAL GFREPI */ -/* EXTERNAL GFREPU */ -/* EXTERNAL GFREPF */ - -/* ... */ - -/* C */ -/* C Turn on progress reporting; turn off interrupt */ -/* C handling. */ -/* C */ -/* RPT = .TRUE. */ -/* ... */ - -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFOCCE ( 'ANY', */ -/* . 'MOON', 'ellipsoid', 'IAU_MOON', */ -/* . 'SUN', 'ellipsoid', 'IAU_SUN', */ -/* . 'LT', 'EARTH', CNVTOL, */ -/* . GFSTEP, GFREFN, RPT, */ -/* . GFREPI, GFREPU, GFREPF, */ -/* . BAIL, GFBAIL, CNFINE, RESULT ) */ - - -/* ... */ - - - -/* 2) The following piece of code provides a more concrete example */ -/* of how these routines might be used. It is part of code that */ -/* performs a search for the time of an occultation of one body */ -/* by another. It is intended only for illustration and is not */ -/* recommended for use in code that has to do real work. */ - -/* C */ -/* C Prepare the progress reporter if appropriate. */ -/* C */ -/* IF ( RPT ) THEN */ -/* CALL UDREPI ( CNFINE, 'Occultation/transit search ', */ -/* . 'done.' ) */ -/* END IF */ - -/* C */ -/* C Cycle over the intervals in the confining window. */ -/* C */ -/* COUNT = WNCARD(CNFINE) */ - -/* DO I = 1, COUNT */ -/* C */ -/* C Retrieve the bounds for the Ith interval of the confinement */ -/* C window. Search this interval for occultation events. */ -/* C Union the result with the contents of the RESULT window. */ -/* C */ -/* CALL WNFETD ( CNFINE, I, START, FINISH ) */ - -/* CALL ZZGFSOLV ( ZZGFOCST, UDSTEP, UDREFN, BAIL, */ -/* . UDBAIL, CSTEP, STEP, START, */ -/* . FINISH, TOL, RPT, UDREPU, */ -/* . RESULT ) */ - - -/* IF ( FAILED() ) THEN */ -/* CALL CHKOUT ( 'GFOCCE' ) */ -/* RETURN */ -/* END IF */ - -/* IF ( BAIL ) THEN */ -/* C */ -/* C Interrupt handling is enabled. */ -/* C */ -/* IF ( UDBAIL () ) THEN */ -/* C */ -/* C An interrupt has been issued. Return now regardless of */ -/* C whether the search has been completed. */ -/* C */ -/* CALL CHKOUT ( 'GFOCCE' ) */ -/* RETURN */ - -/* END IF */ - -/* END IF */ - -/* END DO */ - -/* C */ -/* C End the progress report. */ -/* C */ -/* IF ( RPT ) THEN */ -/* CALL UDREPF */ -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 06-MAR-2009 (NJB) (LSE) (WLT) (IMU) */ - - -/* -& */ -/* $ Index_Entries */ - -/* GF progress report umbrella */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - /* Parameter adjustments */ - if (window) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_gfrepi; - case 2: goto L_gfrepu; - case 3: goto L_gfrepf; - } - - chkin_("GFRPRT", (ftnlen)6); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("GFRPRT", (ftnlen)6); - return 0; -/* $Procedure GFREPI ( GF, progress report initialization ) */ - -L_gfrepi: -/* $ Abstract */ - -/* This entry point initializes a search progress report. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) WINDOW */ -/* CHARACTER*(*) BEGMSS */ -/* CHARACTER*(*) ENDMSS */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MXBEGM P Maximum progress report message prefix length. */ -/* MXENDM P Maximum progress report message suffix length. */ -/* WINDOW I A window over which a job is to be performed. */ -/* BEGMSS I Beginning of the text portion of the output message */ -/* ENDMSS I End of the text portion of the output message */ - -/* $ Detailed_Input */ - -/* WINDOW is the name of a constraint window. This is the window */ -/* associated with some root finding activity. It is */ -/* used to determine how much total time is being searched */ -/* in order to find the events of interest. */ - -/* BEGMSS is the beginning of the output message reported by the */ -/* routine GFRPWK. This output message has the form */ - -/* BEGMSS(1:LASTNB(BEGMSS)) // ' xx.xx% ' // ENDMSS */ - -/* BEGMSS must have length not greater han MXBEGM */ -/* characters. All characters of BEGMSS must be printable. */ - -/* ENDMSS is the last portion of the output message reported by */ -/* the routine GFRPWK. */ - -/* ENDMSS must have length not greater han MXBENM */ -/* characters. All characters of ENDMSS must be printable. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. See the INCLUDE file */ -/* zzgf.inc for details. */ - -/* $ Exceptions */ - -/* 1) If BEGMSS has length greater than MXBEGM characters, or if */ -/* ENDMSS has length greater than MXENDM characters, the error */ -/* SPICE(MESSAGETOOLONG) is signaled. */ - -/* 2) If either BEGMSS or ENDMSS contains non-printing characters, */ -/* the error SPICE(NOTPRINTABLECHARS) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point initializes the GF progress reporting system. It */ -/* is called by the GF root finding utilities once at the start of */ -/* each search pass. See the Particulars section of the main */ -/* subroutine header for further details of its function. */ - -/* $ Examples */ - -/* See the header of the umbrella routine GFRPRT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF initialize a progress report */ - -/* -& */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFREPI", (ftnlen)6); - -/* Check to see if either the message prefix or suffix */ -/* is too long. */ - - if (lastnb_(begmss, begmss_len) > 55) { - setmsg_("Progress report prefix message contains # characters; limit" - " is #.", (ftnlen)65); - i__1 = lastnb_(begmss, begmss_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__55, (ftnlen)1); - sigerr_("SPICE(MESSAGETOOLONG)", (ftnlen)21); - chkout_("GFREPI", (ftnlen)6); - return 0; - } - if (lastnb_(endmss, endmss_len) > 13) { - setmsg_("Progress report suffix message contains # characters; limit" - " is #.", (ftnlen)65); - i__1 = lastnb_(endmss, endmss_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__13, (ftnlen)1); - sigerr_("SPICE(MESSAGETOOLONG)", (ftnlen)21); - chkout_("GFREPI", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the message prefix and */ -/* suffix can be printed. */ - - i__1 = lastnb_(begmss, begmss_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&begmss[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The progress report message prefix contains a nonprinta" - "ble character; ASCII code is #.", (ftnlen)86); - errint_("#", &chrcod, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("GFREPI", (ftnlen)6); - return 0; - } - } - i__1 = lastnb_(endmss, endmss_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&endmss[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The progress report message suffix contains a nonprinta" - "ble character; ASCII code is #.", (ftnlen)86); - errint_("#", &chrcod, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("GFREPI", (ftnlen)6); - return 0; - } - } - s_copy(copyb, begmss, (ftnlen)55, begmss_len); - s_copy(copye, endmss, (ftnlen)13, endmss_len); - -/* Find the length of the window. Use that to initialize the work */ -/* reporter. */ - - wnsumd_(window, &measur, &ave, &stddev, &short__, &long__); - zzgftswk_(&measur, &c_b26, &c__4, begmss, endmss, begmss_len, endmss_len); - if (failed_()) { - chkout_("GFREPI", (ftnlen)6); - return 0; - } - -/* Initialize the time to the start of the confinement window. */ -/* The remaining amount of work in the current interval is */ -/* the measure of the interval. */ - - if (cardd_(window) >= 2) { - t0 = window[6]; - remain = window[7] - t0; - } else { - remain = 0.; - } - chkout_("GFREPI", (ftnlen)6); - return 0; -/* $Procedure GFREPU ( GF, progress report update ) */ - -L_gfrepu: -/* $ Abstract */ - -/* This entry point tells the progress reporting system */ -/* how far a search has progressed. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ - -/* DOUBLE PRECISION TIME */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IVBEG I Start time of work interval. */ -/* IVEND I End time of work interval. */ -/* TIME I Current time being examined in the search process */ - -/* $ Detailed_Input */ - -/* IVBEG, */ -/* IVEND are the bounds of an interval that is contained in some */ -/* interval belonging to the confinement window. The */ -/* confinement window is associated with some root finding */ -/* activity. It is used to determine how much total time is */ -/* being searched in order to find the events of interest. */ - -/* In order for a meaningful progress report to be */ -/* displayed, IVBEG and IVEND must satisfy the following */ -/* constraints: */ - -/* - IVBEG must be less than or equal to IVEND. */ - -/* - The interval [ IVBEG, IVEND ] must be contained in */ -/* some interval of the confinement window. It can be */ -/* a proper subset of the containing interval; that */ -/* is, it can be smaller than the interval of the */ -/* confinement window that contains it. */ - -/* - Over a search pass, the sum of the differences */ - -/* IVEND - IVBEG */ - -/* for all calls to this routine made during the pass */ -/* must equal the measure of the confinement window. */ - - -/* TIME is the current time reached in the search for an event. */ -/* TIME must lie in the interval */ - -/* IVBEG : IVEND */ - -/* inclusive. The input values of TIME for a given interval */ -/* need not form an increasing sequence. */ - -/* $ Detailed_Output */ - -/* None. This routine does perform console I/O when progress */ -/* reporting is enabled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If IVBEG and IVEND are in decreasing order, the error */ -/* SPICE(BADENDPOINTS) is signaled. */ - -/* 2) If TIME is not in the closed interval [IVBEG, IVEND], the */ -/* error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 3) Any I/O errors resulting from writing to standard output */ -/* will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to indicate the current progress of a */ -/* search. Using information recorded through the initialization */ -/* entry point of this routine, the progress reporting system */ -/* determines how much work has been completed and whether or not to */ -/* report it on the users screen. */ - -/* $ Examples */ - -/* See the header of the umbrella routine GFRPRT. */ - -/* $ Restrictions */ - -/* This routine has no way of enforcing that the input values of */ -/* IVBEG and IVEND are compatible with the input window passed to */ -/* GFREPI. Callers of this routine are responsible for ensuring */ -/* that this requirement is obeyed. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF update a progress report */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("GFREPU", (ftnlen)6); - -/* Do a few error checks before getting started. */ - -/* We expect the endpoints of the current window to be in order. */ - - if (*ivend < *ivbeg) { - setmsg_("Interval endpoints are #:#; endpoints must be in increasing" - " order.", (ftnlen)66); - errdp_("#", ivbeg, (ftnlen)1); - errdp_("#", ivend, (ftnlen)1); - sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19); - chkout_("GFREPU", (ftnlen)6); - return 0; - } - -/* We expect TIME to be in the current interval of the confinement */ -/* window. */ - - if (*time < *ivbeg || *time > *ivend) { - setmsg_("TIME should be in interval #:# but is #.", (ftnlen)40); - errdp_("#", time, (ftnlen)1); - errdp_("#", ivbeg, (ftnlen)1); - errdp_("#", ivend, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("GFREPU", (ftnlen)6); - return 0; - } - -/* The amount of work done is the difference between the current */ -/* time and the previous time T0, presuming both times are in */ -/* the current interval. Note this work amount may be negative. */ - - if (t0 >= *ivbeg && t0 <= *ivend) { - incr = *time - t0; - } else { - -/* T0 is in the previous interval. The amount of work */ -/* done to complete processing of that interval is REMAIN. */ -/* The amount of work done in the current interval is */ -/* the difference of TIME and the left endpoint of the */ -/* interval. */ - - incr = remain + *time - *ivbeg; - } - -/* The remaining work is the distance from TIME to the right */ -/* endpoint of the current interval. */ - - remain = *ivend - *time; - -/* Record the current time as T0. */ - - t0 = *time; - -/* Report the work increment. */ - - zzgfwkin_(&incr); - chkout_("GFREPU", (ftnlen)6); - return 0; -/* $Procedure GFREPF ( GF, progress report finalization ) */ - -L_gfrepf: -/* $ Abstract */ - -/* Finish a progress report. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. This routine does perform console I/O when progress */ -/* reporting is enabled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any I/O errors resulting from writing to standard output */ -/* will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point "finishes" a progress report, i.e. updates the */ -/* report to indicate the underlying task is 100% complete. */ - -/* $ Examples */ - -/* See the header of the umbrella routine GFRPRT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF finish a progress report */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("GFREPF", (ftnlen)6); - zzgfwkad_(&c_b44, &c__1, copyb, copye, (ftnlen)55, (ftnlen)13); - zzgfwkin_(&c_b44); - -/* Determine whether progress report output is currently */ -/* being sent to standard output. Fetch the output unit. */ - - zzgfwkmo_(&unit, &total, &freq, &tcheck, begin, end, &incr, (ftnlen)55, ( - ftnlen)13); - stdio_("STDOUT", &stdout, (ftnlen)6); - if (unit != stdout) { - -/* We're not currently writing to standard output, so we're */ -/* done. */ - - chkout_("GFREPF", (ftnlen)6); - return 0; - } - -/* Emit a final blank line by moving the cursor down two */ -/* spaces. */ - -/* The set of actual arguments passed here is rather funky */ -/* and deserves some explanation: */ - -/* The first argument, calling for a leading blank line, moves */ -/* the cursor down so that the next blank line written won't */ -/* overwrite the final status message. That blank line is */ -/* followed with a cursor repositioning command that moves the */ -/* cursor to the beginning of the line that was just written. The */ -/* last argument, calling for another blank line, moves the */ -/* cursor down again. The total cursor movement is down 2 lines. */ -/* This results in one skipped line. */ - -/* We could accomplish the same results more simply if were */ -/* were to use I/O statements in this routine; however, in the */ -/* interest of minimizing the number of places where I/O is */ -/* performed, we rely on ZZGFDSPS to do that job. */ - - zzgfdsps_(&c__1, " ", "A", &c__1, (ftnlen)1, (ftnlen)1); - chkout_("GFREPF", (ftnlen)6); - return 0; -} /* gfrprt_ */ - -/* Subroutine */ int gfrprt_(doublereal *window, char *begmss, char *endmss, - doublereal *ivbeg, doublereal *ivend, doublereal *time, ftnlen - begmss_len, ftnlen endmss_len) -{ - return gfrprt_0_(0, window, begmss, endmss, ivbeg, ivend, time, - begmss_len, endmss_len); - } - -/* Subroutine */ int gfrepi_(doublereal *window, char *begmss, char *endmss, - ftnlen begmss_len, ftnlen endmss_len) -{ - return gfrprt_0_(1, window, begmss, endmss, (doublereal *)0, (doublereal * - )0, (doublereal *)0, begmss_len, endmss_len); - } - -/* Subroutine */ int gfrepu_(doublereal *ivbeg, doublereal *ivend, doublereal - *time) -{ - return gfrprt_0_(2, (doublereal *)0, (char *)0, (char *)0, ivbeg, ivend, - time, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int gfrepf_(void) -{ - return gfrprt_0_(3, (doublereal *)0, (char *)0, (char *)0, (doublereal *) - 0, (doublereal *)0, (doublereal *)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/gfrr.c b/ext/spice/src/cspice/gfrr.c deleted file mode 100644 index 04c1b275b4..0000000000 --- a/ext/spice/src/cspice/gfrr.c +++ /dev/null @@ -1,1253 +0,0 @@ -/* gfrr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b27 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFRR ( GF, range rate search ) */ -/* Subroutine */ int gfrr_(char *target, char *abcorr, char *obsrvr, char * - relate, doublereal *refval, doublereal *adjust, doublereal *step, - doublereal *cnfine, integer *mw, integer *nw, doublereal *work, - doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen - obsrvr_len, ftnlen relate_len) -{ - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical even_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern /* Subroutine */ int gfrefn_(), gfrepi_(), gfrepu_(); - extern logical return_(void); - extern /* Subroutine */ int gfrepf_(), gfstep_(); - char qcpars[80*3], qpnams[80*3]; - doublereal qdpars[3]; - integer qipars[3]; - logical qlpars[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *, - integer *, char *, char *, doublereal *, integer *, logical *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *, - logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine time intervals for which a specified constraint */ -/* on the observer-target range rate is met. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* GEOMETRY */ -/* EPHEMERIS */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance. */ -/* TARGET I Name of the target body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* RELATE I Relational operator. */ -/* REFVAL I Reference value. */ -/* ADJUST I Adjustment value for absolute extrema searches. */ -/* STEP I Step size used for locating extrema and roots. */ -/* CNFINE I SPICE window to which the search is confined. */ -/* MW I Workspace window size. */ -/* NW I The number of workspace windows needed for */ -/* the search. */ -/* WORK I-O Array of workspace windows. */ -/* RESULT I-O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* TARGET the string name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector that */ -/* points from the observer to the target. The derivative */ -/* with respect to time of the length of this vector */ -/* is the "range rate" used by this routine as the geometric */ -/* quantity of interest. */ - -/* Case and leading or trailing blanks are not significant */ -/* in the string TARGET. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Case and leading or trailing blanks are not significant */ -/* in the string ABCORR. */ - -/* OBSRVR the string name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to indicate the observer as Earth. */ - -/* Case and leading or trailing blanks are not significant */ -/* in the string OBSRVR. */ - -/* RELATE the string or character describing the relational */ -/* operator that defines the constraint on the */ -/* range rate of the observer-target vector. The result */ -/* window found by this routine indicates the time intervals */ -/* where the constraint is satisfied. Supported values of */ -/* RELATE and corresponding meanings are shown below: */ - -/* '>' The range rate value is greater than the */ -/* reference value REFVAL. */ - -/* '=' The range rate value is equal to the */ -/* reference value REFVAL. */ - -/* '<' The range rate value is less than the */ -/* reference value REFVAL. */ - -/* 'ABSMAX' The range rate value is at an absolute */ -/* maximum. */ - -/* 'ABSMIN' The range rate value is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' The range rate value is at a local */ -/* maximum. */ - -/* 'LOCMIN' The range rate value is at a local */ -/* minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified measure of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this measure. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string RELATE. */ - -/* REFVAL the double precision reference value used together with */ -/* the argument RELATE to define an equality or inequality */ -/* to satisfy by the range rate of the observer-target */ -/* vector. See the discussion of RELATE above for */ -/* further information. */ - -/* The units of REFVAL are km/s. */ - -/* ADJUST a double precision value used to modify searches for */ -/* absolute extrema: when RELATE is set to ABSMAX or ABSMIN */ -/* and ADJUST is set to a positive value, GFRR finds */ -/* times when the range rate is within */ -/* ADJUST kilometers/second of the specified extreme value. */ - -/* For RELATE set to ABSMAX, the RESULT window contains */ -/* time intervals when the range rate has */ -/* values between ABSMAX - ADJUST and ABSMAX. */ - -/* For RELATE set to ABSMIN, the RESULT window contains */ -/* time intervals when the range rate has */ -/* values between ABSMIN and ABSMIN + ADJUST. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions. */ - -/* STEP the double precision time step size to use in the search. */ - -/* STEP must be short enough for a search using this step */ -/* size to locate the time intervals where the range rate */ -/* function is monotone increasing or decreasing. However, */ -/* STEP must not be *too* short, or the search will take an */ -/* unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - -/* CNFINE a double precision SPICE window that confines the time */ -/* period over which the specified search is conducted. */ -/* CNFINE may consist of a single interval or a collection */ -/* of intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller using the */ -/* SPICELIB routine SSIZED. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. NW should be set to the */ -/* parameter NWRR; this parameter is declared in the */ -/* include file gf.inc. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* INCLUDE 'gf.inc' */ -/* ... */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWRR ) */ - -/* where MW is a constant declared by the caller and */ -/* NWRR is a constant defined in the SPICELIB INCLUDE */ -/* file gf.inc. See the discussion of MW above. */ - -/* WORK need not be initialized by the caller. */ - -/* RESULT a double precision SPICE window that will contain the */ -/* search results. RESULT must be initialized using */ -/* a call to SSIZED. RESULT must be declared and initialized */ -/* with sufficient size to capture the full set of time */ -/* intervals within the search region on which the specified */ -/* constraint is satisfied. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFRR conducts its */ -/* search. */ - -/* $ Detailed_Output */ - -/* WORK the input workspace array, modified by this */ -/* routine. */ - -/* RESULT the SPICE window of intervals, contained within the */ -/* confinement window CNFINE, on which the specified */ -/* constraint is satisfied. */ - -/* If the search is for local extrema, or for absolute */ -/* extrema with ADJUST set to zero, then normally each */ -/* interval of RESULT will be a singleton: the left and */ -/* right endpoints of each interval will be identical. */ - -/* If no times within the confinement window satisfy the */ -/* constraint, RESULT will be returned with a */ -/* cardinality of zero. */ - -/* $ Parameters */ - -/* LBCELL the integer value defining the lower bound for */ -/* SPICE Cell arrays (a SPICE window is a kind of cell). */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the range rate is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEP) is signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - truncation error in time values */ -/* - finite tolerance value */ -/* - errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* RESULT window. One technique to handle such a situation, */ -/* slightly contract RESULT using the window routine WNCOND. */ - -/* 3) If the workspace window size MW is less than 2 or not an even */ -/* value, the error SPICE(INVALIDDIMENSION) will signal. If the */ -/* size of the workspace is too small, an error is signaled by a */ -/* routine in the call tree of this routine. */ - -/* 4) If the size of the SPICE window RESULT is less than 2 or */ -/* not an even value, the error SPICE(INVALIDDIMENSION) will */ -/* signal. If RESULT has insufficient capacity to contain the */ -/* number of intervals on which the specified distance condition */ -/* is met, the error will be diagnosed by a routine in the call */ -/* tree of this routine. */ - -/* 5) If the window count NW is less than NWRR, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 6) If an error (typically cell overflow) occurs during */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 7) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 8) If ADJUST is negative, the error SPICE(VALUEOUTOFRANGE) will */ -/* signal from a routine in the call tree of this routine. */ - -/* A non-zero value for ADJUST when RELATE has any value other */ -/* than "ABSMIN" or "ABSMAX" causes the error SPICE(INVALIDVALUE) */ -/* to signal from a routine in the call tree of this routine. */ - -/* 9) If either of the input body names do not map to NAIF ID */ -/* codes, an error is signaled by a routine in the call tree of */ -/* this routine. */ - -/* 10) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the calling */ -/* program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer that cover the */ -/* time period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files using */ -/* FURNSH. */ - -/* - If bodies with ephemeris relative to non-inertial reference */ -/* frames are used, then PCK files, frame kernels, C-kernels, */ -/* and SCLK kernels may be needed. */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine determines if the caller-specified constraint */ -/* condition on the geometric event (range rate) is satisfied for */ -/* any time intervals within the confinement window CNFINE. If one */ -/* or more such time intervals exist, those intervals are added */ -/* to the RESULT window. */ - -/* This routine provides a simpler, but less flexible interface */ -/* than does the routine GFEVNT for conducting searches for */ -/* observer-target range rate value events. Applications that */ -/* require support for progress reporting, interrupt handling, */ -/* non-default step or refinement functions, or non-default */ -/* convergence tolerance should call GFEVNT rather than this routine. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the */ -/* range rate function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the range rate */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of range rate will be sampled. Starting at */ -/* the left endpoint of an interval, samples will be taken at each */ -/* step. If a change of sign is found, a root has been bracketed; at */ -/* that point, the time at which the time derivative of the */ -/* range rate is zero can be found by a refinement process, for */ -/* example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the range rate function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* As described above, the root-finding process used by this routine */ -/* involves first bracketing roots and then using a search process */ -/* to locate them. "Roots" are both times when local extrema are */ -/* attained and times when the range rate function is equal to a */ -/* reference value. All endpoints of the intervals comprising the */ -/* result window are either endpoints of intervals of the */ -/* confinement window or roots. */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set by the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFEVNT must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* The examples shown below require a "standard" set of SPICE */ -/* kernels. We list these kernels in a meta kernel named */ -/* 'standard.tm'. */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION DVNORM */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Use the parameter MAXWIN for both the result window size and */ -/* C the workspace size. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 20000 ) */ - -/* C */ -/* C Length of strings: */ -/* C */ -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 26 ) */ - -/* INTEGER NLOOPS */ -/* PARAMETER ( NLOOPS = 7 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(TIMLEN) RELATE (NLOOPS) */ - -/* DOUBLE PRECISION ADJUST */ -/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */ -/* DOUBLE PRECISION DRDT */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION FINISH */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 6 ) */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION START */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWRR ) */ - -/* INTEGER I */ -/* INTEGER J */ - - -/* DATA RELATE / '=', */ -/* . '<', */ -/* . '>', */ -/* . 'LOCMIN', */ -/* . 'ABSMIN', */ -/* . 'LOCMAX', */ -/* . 'ABSMAX' / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 1', ET0 ) */ -/* CALL STR2ET ( '2007 APR 1', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Search using a step size of 1 day (in units of seconds). */ -/* C The reference value is .3365 km/s. We're not using the */ -/* C adjustment feature, so we set ADJUST to zero. */ -/* C */ -/* STEP = SPD() */ -/* REFVAL = .3365D0 */ -/* ADJUST = 0.D0 */ - -/* DO J=1, NLOOPS */ - -/* WRITE(*,*) 'Relation condition: ', RELATE(J) */ - -/* C */ -/* C Perform the search. The SPICE window RESULT contains */ -/* C the set of times when the condition is met. */ -/* C */ -/* CALL GFRR ( 'MOON', 'NONE', 'SUN', RELATE(J), */ -/* . REFVAL, ADJUST, STEP, CNFINE, */ -/* . MAXWIN, NWRR, WORK, RESULT ) */ -/* C */ -/* C Display the results. */ -/* C */ -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ - -/* WRITE (*, '(A)') 'Result window is empty.' */ - -/* ELSE */ - -/* DO I = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, I, START, FINISH ) */ - -/* CALL SPKEZR ( 'MOON', START, 'J2000', 'NONE', */ -/* . 'SUN', POS, LT ) */ -/* DRDT = DVNORM(POS) */ - -/* CALL TIMOUT ( START, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) 'Start time, drdt = '// */ -/* . TIMSTR, DRDT */ - -/* CALL SPKEZR ( 'MOON', FINISH, 'J2000', 'NONE', */ -/* . 'SUN', POS, LT ) */ -/* DRDT = DVNORM(POS) */ - -/* CALL TIMOUT ( FINISH, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) 'Stop time, drdt = '// */ -/* . TIMSTR, DRDT */ -/* END DO */ - -/* END IF */ - -/* WRITE(*,*) ' ' */ - -/* END DO */ - -/* END */ - -/* The program outputs: */ - -/* Relation condition: = */ -/* Start time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Stop time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Start time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Stop time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Start time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Stop time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Start time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Stop time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Start time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Stop time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Start time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ -/* Stop time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ - -/* Relation condition: < */ -/* Start time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Stop time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Start time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Stop time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Start time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Stop time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ - -/* Relation condition: > */ -/* Start time, drdt = 2007-JAN-01 00:00:00.000 0.515522367 */ -/* Stop time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Start time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Stop time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Start time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Stop time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Start time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ -/* Stop time, drdt = 2007-APR-01 00:00:00.000 0.793546222 */ - -/* Relation condition: LOCMIN */ -/* Start time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ -/* Stop time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ -/* Start time, drdt = 2007-FEB-10 06:26:15.439 -0.575837623 */ -/* Stop time, drdt = 2007-FEB-10 06:26:15.439 -0.575837623 */ -/* Start time, drdt = 2007-MAR-12 03:28:36.404 -0.441800446 */ -/* Stop time, drdt = 2007-MAR-12 03:28:36.404 -0.441800446 */ - -/* Relation condition: ABSMIN */ -/* Start time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ -/* Stop time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ - -/* Relation condition: LOCMAX */ -/* Start time, drdt = 2007-JAN-26 02:27:33.766 1.154648992 */ -/* Stop time, drdt = 2007-JAN-26 02:27:33.766 1.154648992 */ -/* Start time, drdt = 2007-FEB-24 09:35:07.816 1.347132236 */ -/* Stop time, drdt = 2007-FEB-24 09:35:07.816 1.347132236 */ -/* Start time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ -/* Stop time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ - -/* Relation condition: ABSMAX */ -/* Start time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ -/* Stop time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ - -/* $ Restrictions */ - -/* 1) The kernel files to be used by this routine must be loaded */ -/* (normally using the SPICELIB routine FURNSH) before this */ -/* routine is called. */ - -/* 2) This routine has the side effect of re-initializing the */ -/* range rate quantity utility package. Callers may themselves */ -/* need to re-initialize the range rate quantity utility */ -/* package after calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 24-JUN-2009 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF range rate search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Routines to set step size, refine transition times */ -/* and report work. */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Quantity definition parameter arrays: */ - - -/* Standard SPICE error handling. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - if (return_()) { - return 0; - } - -/* Check into the error subsystem. */ - - chkin_("GFRR", (ftnlen)4); - -/* Confirm minimum window sizes. */ - - if (*mw < 2 || ! even_(mw)) { - setmsg_("Workspace window size was #; size must be at least 2 and an" - " even value.", (ftnlen)71); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFRR", (ftnlen)4); - return 0; - } - if (*nw < 5) { - setmsg_("Workspace window count was #; count must be at least #.", ( - ftnlen)55); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__5, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFRR", (ftnlen)4); - return 0; - } - -/* Check the result window size. */ - - i__1 = sized_(result); - if (sized_(result) < 2 || ! even_(&i__1)) { - setmsg_("Result window size was #; size must be at least 2 and an ev" - "en value.", (ftnlen)68); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFRR", (ftnlen)4); - return 0; - } - -/* Set up a call to GFEVNT specific to the range rate search. */ - - s_copy(qpnams, "TARGET", (ftnlen)80, (ftnlen)6); - s_copy(qcpars, target, (ftnlen)80, target_len); - s_copy(qpnams + 80, "OBSERVER", (ftnlen)80, (ftnlen)8); - s_copy(qcpars + 80, obsrvr, (ftnlen)80, obsrvr_len); - s_copy(qpnams + 160, "ABCORR", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 160, abcorr, (ftnlen)80, abcorr_len); - -/* Check the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFRR", (ftnlen)4); - return 0; - } - -/* Set the step size. */ - - gfsstp_(step); - -/* Initialize the RESULT window to empty. */ - - scardd_(&c__0, result); - -/* Look for solutions. */ - -/* Progress report and interrupt options are set to .FALSE. */ - - gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "RANGE RATE", &c__3, qpnams, qcpars, - qdpars, qipars, qlpars, relate, refval, &c_b27, adjust, cnfine, & - c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw, &c__5, - work, &c_false, (L_fp)gfbail_, result, (ftnlen)10, (ftnlen)80, ( - ftnlen)80, relate_len); - chkout_("GFRR", (ftnlen)4); - return 0; -} /* gfrr_ */ - diff --git a/ext/spice/src/cspice/gfrr_c.c b/ext/spice/src/cspice/gfrr_c.c deleted file mode 100644 index 58608d0268..0000000000 --- a/ext/spice/src/cspice/gfrr_c.c +++ /dev/null @@ -1,889 +0,0 @@ -/* - --Procedure gfrr_c (GF, range rate search ) - --Abstract - - Determine time intervals for which a specified constraint - on the observer-target range rate is met. - --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 - - GF - NAIF_IDS - SPK - TIME - WINDOWS - --Keywords - - EVENT - GEOMETRY - EPHEMERIS - SEARCH - WINDOW - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceGF.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "zzalloc.h" - - void gfrr_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - SPICE_GF_CNVTOL P Convergence tolerance - target I Name of the target body. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - relate I Relational operator. - refval I Reference value. - adjust I Adjustment value for absolute extrema searches. - step I Step size used for locating extrema and roots. - nintvls I Workspace window interval count. - cnfine I-O SPICE window to which the search is confined. - result O SPICE window containing results. - --Detailed_Input - - target is the name of a target body. The target body is - an ephemeris object; its trajectory is given by - SPK data. - - The string `target' is case-insensitive, and leading - and trailing blanks in `target' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both - "MOON" and "301" are legitimate strings that indicate - the Moon is the target body. - - The target and observer define a position vector which - points from the observer to the target; the time derivative - length of this vector is the "range rate" that serves as - the subject of the search performed by this routine. - - - abcorr indicates the aberration corrections to be applied to - the observer-target state vector to account for - one-way light time and stellar aberration. - - Any aberration correction accepted by the SPICE - routine spkezr_c is accepted here. See the header - of spkezr_c for a detailed description of the - aberration correction options. For convenience, - the options are listed below: - - "NONE" Apply no correction. - - "LT" "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - "LT+S" "Reception" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - "CN" "Reception" case: converged - Newtonian light time correction. - - "CN+S" "Reception" case: converged - Newtonian light time and stellar - aberration corrections. - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - Case and blanks are not significant in the string - `abcorr'. - - obsrvr is the name of the observing body. The observing body is - an ephemeris object; its trajectory is given by SPK - data. `obsrvr' is case-insensitive, and leading and - trailing blanks in `obsrvr' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both "MOON" - and "301" are legitimate strings that indicate the Moon - is the observer. - - relate is a relational operator used to define a constraint - on observer-target range rate. The result window found - by this routine indicates the time intervals where - the constraint is satisfied. Supported values of - `relate' and corresponding meanings are shown below: - - ">" Distance is greater than the reference - value `refval'. - - "=" Distance is equal to the reference - value `refval'. - - "<" Distance is less than the reference - value `refval'. - - - "ABSMAX" Distance is at an absolute maximum. - - "ABSMIN" Distance is at an absolute minimum. - - "LOCMAX" Distance is at a local maximum. - - "LOCMIN" Distance is at a local minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified distance of an absolute extremum. - The argument `adjust' (described below) is used to - specify this distance. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - Case is not significant in the string `relate'. - - refval is the reference value used together with the argument - `relate' to define an equality or inequality to be - satisfied by the range rate between the specified target - and observer. See the discussion of `relate' above for - further information. - - The units of `refval' are km/sec. - - adjust is a parameter used to modify searches for absolute - extrema: when `relate' is set to "ABSMAX" or "ABSMIN" and - `adjust' is set to a positive value, gfdist_c will find - times when the observer-target range rate is within - `adjust' km/sec of the specified extreme value. - - If `adjust' is non-zero and a search for an absolute - minimum `min' is performed, the result window contains - time intervals when the observer-target range rate has - values between `min' and min+adjust. - - If the search is for an absolute maximum `max', the - corresponding range is from max-adjust to `max'. - - `adjust' is not used for searches for local extrema, - equality or inequality conditions. - - step is the step size to be used in the search. `step' must - be short enough for a search using this step size - to locate the time intervals where the specified - range rate function is monotone increasing or - decreasing. However, `step' must not be *too* short, or - the search will take an unreasonable amount of time. - - The choice of `step' affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - `step' has units of TDB seconds. - - nintvls is a parameter specifying the number of intervals that - can be accommodated by each of the dynamically allocated - windows used internally by this routine. `nintvls' should - be at least as large as the number of intervals within - the search region on which the specified range rate - function is monotone increasing or decreasing. See - the Examples section below for code examples illustrating - the use of this parameter. - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is the window of intervals, contained within the - confinement window `cnfine', on which the specified - constraint is satisfied. - - If `result' is non-empty on input, its contents will be - discarded before 'gfrr_c' conducts its search. - - `result' must be declared with sufficient size to capture - the full set of time intervals within the search region - on which the specified constraint is satisfied. - - If the search is for local extrema, or for absolute - extrema with `adjust' set to zero, then normally each - interval of `result' will be a singleton: the left and - right endpoints of each interval will be identical. - - If no times within the confinement window satisfy the - constraint, `result' will be returned with a cardinality - of zero. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL, the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found - by this routine depends on the accuracy of the input - data. In most cases, the accuracy of solutions will be - inferior to their precision. - - SPICE_GF_CNVTOL is declared in the header file SpiceGF.h. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If the aberration correction specifier contains an - unrecognized value, an error is signaled by a routine in the - call tree of this routine. - - 6) If 'adjust' is negative, the error SPICE(VALUEOUTOFRANGE) will - signal from a routine in the call tree of this routine. - - A non-zero value for 'adjust' when 'relate' has any value other than - "ABSMIN" or "ABSMAX" causes the error SPICE(INVALIDVALUE) to - signal from a routine in the call tree of this routine. - - 7) If either of the input body names do not map to NAIF ID - codes, an error is signaled by a routine in the call tree of - this routine. - - 8) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 9) If the workspace interval count is less than 1, the error - SPICE(VALUEOUTOFRANGE) will be signaled. - - 10) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - - 11) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 13) If either input cell has type other than SpiceDouble, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - Appropriate kernels must be loaded by the calling program before - this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target and observer for the - time period defined by the confinement window must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - If non-inertial reference frames are used by the SPK files, - then PCK files, frame kernels, C-kernels, and SCLK kernels may - be needed. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - This routine determines if the caller-specified constraint condition - on the geometric event (range rate) is satisfied for any time intervals - within the confinement window 'cnfine'. If one or more such time - intervals exist, those intervals are added to the 'result' window. - - This routine provides a simpler, but less flexible interface - than does the routine gfevnt_c for conducting the searches for - observer-target range rate value events. Applications that require - support for progress reporting, interrupt handling, non-default step - or refinement functions, or non-default convergence tolerance should - call gfevnt_c rather than this routine. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - range rate function is monotone increasing and monotone decreasing. - Each of these time periods is represented by a SPICE window. Having - found these windows, all of the range rate function's local extrema - within the confinement window are known. Absolute extrema then can - be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - - Step Size - ========= - - The monotone windows (described above) are found via a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of range rate will be sampled. Starting at - the left endpoint of an interval, samples will be taken at each - step. If a change of sign is found, a root has been bracketed; at - that point, the time at which the range rate is zero can be - found by a refinement process, for example, via binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the range rate function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - As described above, the root-finding process used by this routine - involves first bracketing roots and then using a search process - to locate them. "Roots" are either times when local extrema are - attained or times when the range rate function is equal to a - reference value. All endpoints of the intervals comprising the - result window are either endpoints of intervals of the - confinement window or roots. - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set via the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't become the limiting factor in the accuracy of - solutions found by this routine. In general the accuracy of input - data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such - as gfevnt_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater affect on processing time than would the convergence - tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - - Consider the following example: suppose one wishes to find the - times when the range rate between Io and the Earth attains a global - minimum over some (lengthy) time interval. There is one local - minimum every few days. The required step size for this search - must be smaller than the shortest interval on which the range rate - is monotone increasing or decreasing; this step size will be less - than half the average time between local minima. However, we know - that a global minimum can't occur when the Jupiter-Sun-Earth - angle is greater than 90 degrees. We can use a step size of a - half year to find the time period, within our original time - interval, during which this angle is less than 90 degrees; this - time period becomes the confinement window for our Earth-Io - range rate search. This way we've used a quick (due to the large - step size) search to cut out about half of the search period over - which we must perform a slower search using a small step size. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - The examples shown below require a "standard" set of SPICE - kernels. We list these kernels in a meta kernel named - 'standard.tm'. - - #include - #include - #include - - #include "SpiceUsr.h" - - #define MAXWIN 20000 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###" - #define TIMLEN 41 - #define NLOOPS 7 - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one window - consists of two values, so the total number - of cell values to allocate is twice - the number of intervals. - ./ - SPICEDOUBLE_CELL ( result, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - SpiceChar * target = "MOON"; - SpiceChar * abcorr = "NONE"; - SpiceChar * obsrvr = "SUN"; - - SpiceInt count; - SpiceInt i; - SpiceInt j; - - ConstSpiceChar * relate [NLOOPS] = { "=", - "<", - ">", - "LOCMIN", - "ABSMIN", - "LOCMAX", - "ABSMAX", - }; - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - - /. - Store the time bounds of our search interval in - the cnfine confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2007 APR 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - Search using a step size of 1 day (in units of seconds). - The reference value is .3365 km/s. We're not using the - adjustment feature, so we set 'adjust' to zero. - ./ - step = spd_c(); - adjust = 0.; - refval = .3365; - - for ( j = 0; j < NLOOPS; j++ ) - { - - printf ( "Relation condition: %s \n", relate[j] ); - - /. - Perform the search. The SPICE window 'result' contains - the set of times when the condition is met. - ./ - gfrr_c ( target, - abcorr, - obsrvr, - relate[j], - refval, - adjust, - step, - MAXWIN, - &cnfine, - &result ); - - count = wncard_c( &result ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result, i, &beg, &end ); - - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - timout_c ( end, TIMFMT, TIMLEN, endstr ); - - printf ( "Start time, drdt = %s \n", begstr ); - printf ( "Stop time, drdt = %s \n", endstr ); - - } - - } - - printf("\n"); - - } - - /. - It's always good form to unload kernels after use, - particularly in IDL due to data persistence. - ./ - kclear_c(); - - return( 0 ); - } - - - The program outputs: - - Relation condition: = - Start time, drdt = 2007-JAN-02 00:35:19.574 - Stop time, drdt = 2007-JAN-02 00:35:19.574 - Start time, drdt = 2007-JAN-19 22:04:54.899 - Stop time, drdt = 2007-JAN-19 22:04:54.899 - Start time, drdt = 2007-FEB-01 23:30:13.428 - Stop time, drdt = 2007-FEB-01 23:30:13.428 - Start time, drdt = 2007-FEB-17 11:10:46.540 - Stop time, drdt = 2007-FEB-17 11:10:46.540 - Start time, drdt = 2007-MAR-04 15:50:19.929 - Stop time, drdt = 2007-MAR-04 15:50:19.929 - Start time, drdt = 2007-MAR-18 09:59:05.959 - Stop time, drdt = 2007-MAR-18 09:59:05.959 - - Relation condition: < - Start time, drdt = 2007-JAN-02 00:35:19.574 - Stop time, drdt = 2007-JAN-19 22:04:54.899 - Start time, drdt = 2007-FEB-01 23:30:13.428 - Stop time, drdt = 2007-FEB-17 11:10:46.540 - Start time, drdt = 2007-MAR-04 15:50:19.929 - Stop time, drdt = 2007-MAR-18 09:59:05.959 - - Relation condition: > - Start time, drdt = 2007-JAN-01 00:00:00.000 - Stop time, drdt = 2007-JAN-02 00:35:19.574 - Start time, drdt = 2007-JAN-19 22:04:54.899 - Stop time, drdt = 2007-FEB-01 23:30:13.428 - Start time, drdt = 2007-FEB-17 11:10:46.540 - Stop time, drdt = 2007-MAR-04 15:50:19.929 - Start time, drdt = 2007-MAR-18 09:59:05.959 - Stop time, drdt = 2007-APR-01 00:00:00.000 - - Relation condition: LOCMIN - Start time, drdt = 2007-JAN-11 07:03:58.988 - Stop time, drdt = 2007-JAN-11 07:03:58.988 - Start time, drdt = 2007-FEB-10 06:26:15.439 - Stop time, drdt = 2007-FEB-10 06:26:15.439 - Start time, drdt = 2007-MAR-12 03:28:36.404 - Stop time, drdt = 2007-MAR-12 03:28:36.404 - - Relation condition: ABSMIN - Start time, drdt = 2007-JAN-11 07:03:58.988 - Stop time, drdt = 2007-JAN-11 07:03:58.988 - - Relation condition: LOCMAX - Start time, drdt = 2007-JAN-26 02:27:33.766 - Stop time, drdt = 2007-JAN-26 02:27:33.766 - Start time, drdt = 2007-FEB-24 09:35:07.816 - Stop time, drdt = 2007-FEB-24 09:35:07.816 - Start time, drdt = 2007-MAR-25 17:26:56.150 - Stop time, drdt = 2007-MAR-25 17:26:56.150 - - Relation condition: ABSMAX - Start time, drdt = 2007-MAR-25 17:26:56.150 - Stop time, drdt = 2007-MAR-25 17:26:56.150 - --Restrictions - - 1) The kernel files to be used by this routine must be loaded - (normally using the CSPICE routine furnsh_c) before this - routine is called. - - 2) This routine has the side effect of re-initializing the - range rate quantity utility package. Callers may themselves - need to re-initialize the range rate quantity utility - package after calling this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 26-AUG-2009 (EDW) - --Index_Entries - - GF range rate search - --& -*/ - -{ /* Begin gfrr_c */ - - /* - Local variables - */ - doublereal * work; - - static SpiceInt nw = SPICE_GF_NWDIST; - SpiceInt nBytes; - - /* - Participate in error tracing. - */ - - chkin_c ( "gfrr_c" ); - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfrr_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfrr_c", target ); - CHKFSTR ( CHK_STANDARD, "gfrr_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfrr_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "gfrr_c", relate ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value of one (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfrr_c" ); - return; - } - - /* - Allocate the workspace. 'nintvls' indicates the maximum number of - intervals returned in 'result'. An interval consists of - two values. - */ - - nintvls = 2 * nintvls; - - nBytes = ( nintvls + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) alloc_SpiceMemory( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "gfrr_c" ); - return; - } - - /* - Let the f2'd routine do the work. - */ - - gfrr_( ( char * ) target, - ( char * ) abcorr, - ( char * ) obsrvr, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr), - ( ftnlen ) strlen(relate) ); - - /* - De-allocate the workspace. - */ - free_SpiceMemory( work ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - ALLOC_CHECK; - - chkout_c ( "gfrr_c" ); - -} /* End gfrr_c */ diff --git a/ext/spice/src/cspice/gfsep.c b/ext/spice/src/cspice/gfsep.c deleted file mode 100644 index 6e8ed9783e..0000000000 --- a/ext/spice/src/cspice/gfsep.c +++ /dev/null @@ -1,1332 +0,0 @@ -/* gfsep.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__0 = 0; -static integer c__8 = 8; -static doublereal c_b32 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFSEP (GF, angular separation search) */ -/* Subroutine */ int gfsep_(char *targ1, char *shape1, char *frame1, char * - targ2, char *shape2, char *frame2, char *abcorr, char *obsrvr, char * - relate, doublereal *refval, doublereal *adjust, doublereal *step, - doublereal *cnfine, integer *mw, integer *nw, doublereal *work, - doublereal *result, ftnlen targ1_len, ftnlen shape1_len, ftnlen - frame1_len, ftnlen targ2_len, ftnlen shape2_len, ftnlen frame2_len, - ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len) -{ - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical even_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern /* Subroutine */ int gfrefn_(), gfrepi_(), gfrepf_(), gfrepu_(), - gfstep_(); - extern logical return_(void); - char qcpars[80*8], qpnams[80*8]; - doublereal qdpars[8]; - integer qipars[8]; - logical qlpars[8]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *, - integer *, char *, char *, doublereal *, integer *, logical *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *, - logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine time intervals when the angular separation between */ -/* the position vectors of two target bodies relative to an observer */ -/* satisfies a numerical relationship. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* ANGULAR SEPARATION */ -/* GEOMETRY */ -/* SEARCH */ -/* EVENT */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance. */ -/* TARG1 I Name of first body */ -/* SHAPE1 I Name of shape model describing the first body */ -/* FRAME1 I The body-fixed reference frame of the first body */ -/* TARG2 I Name of second body */ -/* SHAPE2 I Name of the shape model describing the second body */ -/* FRAME2 I The body-fixed reference frame of the second body */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* RELATE I Operator that either looks for an extreme value */ -/* (max, min, local, absolute) or compares the */ -/* angular separation value and REFVAL. */ -/* REFVAL I Reference value. */ -/* ADJUST I Absolute extremum adjustment value. */ -/* STEP I Step size in seconds for finding angular separation */ -/* events. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* MW I Size of workspace windows. */ -/* NW I The number of workspace windows needed for the */ -/* search */ -/* WORK I/O Array containing workspace windows. */ -/* RESULT I/O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* TARG1 the string naming the first body of interest. You can */ -/* also supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* SHAPE1 the string naming the geometric model used to */ -/* represent the shape of the TARG1 body. Models */ -/* supported by this routine: */ - -/* 'SPHERE' Treat the body as a sphere with */ -/* radius equal to the maximum value of */ -/* BODYnnn_RADII */ - -/* 'POINT' Treat the body as a point; */ -/* radius has value zero. */ - -/* The SHAPE1 string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* FRAME1 the string naming the body-fixed reference frame */ -/* corresponding to TARG1. GFSEP does not currently use */ -/* this argument's value, its use is reserved for future */ -/* shape models. The value 'NULL' will suffice for */ -/* "POINT" and "SPHERE" shaped bodies. */ - -/* TARG2 the string naming the second body of interest. You can */ -/* also supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* SHAPE2 the string naming the geometric model used to */ -/* represent the shape of the TARG2. Models supported by */ -/* this routine: */ - -/* 'SPHERE' Treat the body as a sphere with */ -/* radius equal to the maximum value of */ -/* BODYnnn_RADII */ - -/* 'POINT' Treat the body as a single point; */ -/* radius has value zero. */ - -/* The SHAPE2 string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* FRAME2 the string naming the body-fixed reference frame */ -/* corresponding to TARG2. GFSEP does not currently use */ -/* this argument's value, its use is reserved for future */ -/* shape models. The value 'NULL' will suffice for */ -/* "POINT" and "SPHERE" shaped bodies. */ - -/* ABCORR the string description of the aberration corrections */ -/* to apply to the state evaluations to account for */ -/* one-way light time and stellar aberration. */ - -/* This routine accepts the same aberration corrections */ -/* as does the SPICE routine SPKEZR. See the header of */ -/* SPKEZR for a detailed description of the aberration */ -/* correction options. For convenience, the options are */ -/* listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* OBSRVR the string naming the observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to supply to indicate the */ -/* observer is Earth. */ - -/* RELATE the string identifying the relational operator used to */ -/* define a constraint on the angular separation. The */ -/* result window found by this routine indicates the time */ -/* intervals where the constraint is satisfied. Supported */ -/* values of RELATE and corresponding meanings are shown */ -/* below: */ - -/* '>' Separation is greater than the reference */ -/* value REFVAL. */ - -/* '=' Separation is equal to the reference */ -/* value REFVAL. */ - -/* '<' Separation is less than the reference */ -/* value REFVAL. */ - -/* 'ABSMAX' Separation is at an absolute maximum. */ - -/* 'ABSMIN' Separation is at an absolute minimum. */ - -/* 'LOCMAX' Separation is at a local maximum. */ - -/* 'LOCMIN' Separation is at a local minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified angular separation of an absolute */ -/* extremum. The argument ADJUST (described below) is used */ -/* to specify this angular separation. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* The RELATE string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* REFVAL the double precision reference value used together with */ -/* RELATE argument to define an equality or inequality to */ -/* be satisfied by the angular separation between the */ -/* specified target and observer. See the discussion of */ -/* RELATE above for further information. */ - -/* The units of REFVAL are radians. */ - -/* ADJUST a double precision value used to modify searches for */ -/* absolute extrema: when RELATE is set to ABSMAX or */ -/* ABSMIN and ADJUST is set to a positive value, GFSEP */ -/* finds times when the angular separation between the */ -/* bodies is within ADJUST radians of the specified */ -/* extreme value. */ - -/* For RELATE set to ABSMAX, the RESULT window contains */ -/* time intervals when the angular separation has */ -/* values between ABSMAX - ADJUST and ABSMAX. */ - -/* For RELATE set to ABSMIN, the RESULT window contains */ -/* time intervals when the angular separation has */ -/* values between ABSMIN and ABSMIN + ADJUST. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions. */ - -/* CNFINE a double precision SPICE window that confines the time */ -/* period over which the specified search is conducted. */ -/* CNFINE may consist of a single interval or a collection */ -/* of intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller using the */ -/* SPICELIB routine SSIZED. */ - -/* STEP the double precision time step size to use in the */ -/* search. */ - -/* STEP must be short enough to for a search using this */ -/* step size to locate the time intervals where the */ -/* specified angular separation function is monotone */ -/* increasing or decreasing. However, STEP must not be */ -/* *too* short, or the search will take an unreasonable */ -/* amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. NW should be set to the */ -/* parameter NWSEP; this parameter is declared in the */ -/* include file gf.inc. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* INCLUDE 'gf.inc' */ -/* ... */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWSEP ) */ - -/* where MW is a constant declared by the caller and */ -/* NWSEP is a constant defined in the SPICELIB INCLUDE */ -/* file gf.inc. See the discussion of MW above. */ - -/* WORK need not be initialized by the caller. */ - -/* RESULT a double precision SPICE window which will contain the */ -/* search results. RESULT must be initialized using */ -/* a call to SSIZED. RESULT must be declared and */ -/* initialized with sufficient size to capture the full */ -/* set of time intervals within the search region on which */ -/* the specified constraint is satisfied. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFSEP conducts its */ -/* search. */ - -/* $ Detailed_Output */ - -/* WORK the input workspace array, modified by this */ -/* routine. The caller should re-initialize this array */ -/* before attempting to use it for any other purpose. */ - -/* RESULT the SPICE window of intervals, contained within the */ -/* confinement window CNFINE, on which the specified */ -/* constraint is satisfied. */ - -/* If the search is for local extrema, or for absolute */ -/* extrema with ADJUST set to zero, then normally each */ -/* interval of RESULT will be a singleton: the left and */ -/* right endpoints of each interval will be identical. */ - -/* If no times within the confinement window satisfy the */ -/* constraint, RESULT will be returned with a */ -/* cardinality of zero. */ - -/* $ Parameters */ - -/* LBCELL the integer value defining the lower bound for */ -/* SPICE Cell arrays (a SPICE window is a kind of cell). */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the specified distance is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, an error is signaled */ -/* by a routine in the call tree of this routine. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - truncation error in time values */ -/* - finite tolerance value */ -/* - errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* RESULT window. One technique to handle such a situation, */ -/* slightly contract RESULT using the window routine WNCOND. */ - -/* 3) If the workspace window size MW is less than 2 or not an even */ -/* value, the error SPICE(INVALIDDIMENSION) will signal. If the */ -/* size of the workspace is too small, an error is signaled by a */ -/* routine in the call tree of this routine. */ - -/* 4) If the size of the SPICE window RESULT is less than 2 or */ -/* not an even value, the error SPICE(INVALIDDIMENSION) will */ -/* signal. If RESULT has insufficient capacity to contain the */ -/* number of intervals on which the specified distance condition */ -/* is met, the error will be diagnosed by a routine in the call */ -/* tree of this routine. */ - -/* 5) If the window count NW is less than NWSEP, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 6) If an error (typically cell overflow) occurs during */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 7) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 8) If ADJUST is negative, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 9) If either of the input body names do not map to NAIF ID */ -/* codes, an error is signaled by a routine in the call tree of */ -/* this routine. */ - -/* 10) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the */ -/* calling program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer that cover the */ -/* time period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files using */ -/* FURNSH. */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* semi-axis lengths provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file using FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Such kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides a simpler, but less flexible interface */ -/* than does the routine GFEVNT for conducting searches for */ -/* angular separation events. Applications that require support for */ -/* progress reporting, interrupt handling, non-default step or */ -/* refinement functions, or non-default convergence tolerance should */ -/* call GFEVNT rather than this routine. */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window for which the angular separation */ -/* between the two bodies satisfies some defined relationship. */ -/* The resulting set of intervals is returned as a SPICE window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* angular separation function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the angular separation */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of angular separation (angular separation rate) will be */ -/* sampled. Starting at the left endpoint of an interval, samples */ -/* will be taken at each step. If a change of sign is found, a */ -/* root has been bracketed; at that point, the time at which the */ -/* angular separation rate is zero can be found by a refinement */ -/* process, for example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the distance function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* As described above, the root-finding process used by this routine */ -/* involves first bracketing roots and then using a search process */ -/* to locate them. "Roots" are both times when local extrema are */ -/* attained and times when the distance function is equal to a */ -/* reference value. All endpoints of the intervals comprising the */ -/* result window are either endpoints of intervals of the */ -/* confinement window or roots. */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set by the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFEVNT must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - - -/* Negative Angular Separation */ -/* =========================== */ - -/* For those searches using a SPHERE shape identifier for both */ -/* target bodies, the angular separation function returns a */ -/* negative value when the bodies overlap (occult), e.g. */ -/* a search for an ABSMIN of angular separation in a */ -/* confinement window covering an occultation event will */ -/* return the time when the apparent center of the */ -/* occulting body passes closest to the apparent center of */ -/* the occulted body. */ - - -/* Elongation */ -/* =========================== */ - -/* The angular separation of two targets as seen from an observer */ -/* where one of those targets is the sun is known as elongation. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* The examples shown below require a "standard" set of SPICE */ -/* kernels. We list these kernels in a meta kernel named */ -/* 'standard.tm'. */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de414.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( '/kernels/gen/lsk/naif0008.tls' */ -/* '/kernels/gen/spk/de414.bsp' */ -/* '/kernels/gen/pck/pck00008.tpc' */ -/* ) */ - -/* Example(1): */ - -/* Determine the times of local maxima of the angular separation */ -/* between the moon and earth as observed from the sun from */ -/* Jan 1, 2007 to Jan 1 2008. */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION RPD */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local variables and initial parameters. */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Create 50 windows. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 50 ) */ - -/* C */ -/* C One window consists of two intervals. */ -/* C */ -/* INTEGER NINTRVL */ -/* PARAMETER ( NINTRVL = MAXWIN *2 ) */ - -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 64 ) */ - -/* CHARACTER*(STRLEN) BEGSTR */ -/* CHARACTER*(STRLEN) ENDSTR */ -/* CHARACTER*(STRLEN) TARG1 */ -/* CHARACTER*(STRLEN) TARG2 */ -/* CHARACTER*(STRLEN) OBSRVR */ -/* CHARACTER*(STRLEN) SHAPE1 */ -/* CHARACTER*(STRLEN) SHAPE2 */ -/* CHARACTER*(STRLEN) FRAME1 */ -/* CHARACTER*(STRLEN) FRAME2 */ -/* CHARACTER*(STRLEN) ABCORR */ - -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION CNFINE ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION WORK ( LBCELL : NINTRVL, NWSEP ) */ -/* DOUBLE PRECISION BEGTIM */ -/* DOUBLE PRECISION ENDTIM */ -/* DOUBLE PRECISION BEG */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION ADJUST */ - -/* INTEGER COUNT */ -/* INTEGER I */ - - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ('standard.tm') */ - -/* C */ -/* C Initialize windows RESULT and CNFINE. */ -/* C */ -/* CALL SSIZED ( NINTRVL, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the CNFINE confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 01', BEGTIM ) */ -/* CALL STR2ET ( '2008 JAN 01', ENDTIM ) */ - -/* CALL WNINSD ( BEGTIM, ENDTIM, CNFINE ) */ - -/* C */ -/* C Search using a step size of 6 days (in units of seconds). */ -/* C */ -/* STEP = 6.D0 * SPD() */ -/* ADJUST = 0.D0 */ -/* REFVAL = 0.D0 */ - -/* TARG1 = 'MOON' */ -/* SHAPE1 = 'SPHERE' */ -/* FRAME1 = 'NULL' */ - -/* TARG2 = 'EARTH' */ -/* SHAPE2 = 'SPHERE' */ -/* FRAME2 = 'NULL' */ -/* ABCORR = 'NONE' */ - -/* OBSRVR = 'SUN' */ - -/* CALL GFSEP ( TARG1, SHAPE1, FRAME1, */ -/* . TARG2, SHAPE2, FRAME2, */ -/* . ABCORR, OBSRVR, 'LOCMAX', */ -/* . REFVAL, ADJUST, STEP, */ -/* . CNFINE, NINTRVL, NWSEP, WORK, */ -/* . RESULT ) */ - -/* C */ -/* C Check the number of intervals in the result window. */ -/* C */ -/* COUNT = WNCARD(RESULT) */ - -/* C */ -/* C List the beginning and ending points in each interval */ -/* C if RESULT contains data. */ -/* C */ -/* IF ( COUNT .EQ. 0 ) THEN */ -/* WRITE (*, '(A)') 'Result window is empty.' */ -/* ELSE */ - -/* DO I = 1, COUNT */ - -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, I, BEG, END ) */ - -/* CALL TIMOUT ( BEG, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', BEGSTR ) */ -/* CALL TIMOUT ( END, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', ENDSTR ) */ - -/* WRITE (*,*) 'Interval ', I */ -/* WRITE (*,*) 'Beginning TDB ', BEGSTR */ -/* WRITE (*,*) 'Ending TDB ', ENDSTR */ - -/* END DO */ - -/* END IF */ - -/* END */ - -/* The program's partial output: */ - -/* Interval 1 */ -/* Beginning TDB 2007-JAN-11 11:21:20.213872 (TDB) */ -/* Ending TDB 2007-JAN-11 11:21:20.213872 (TDB) */ - -/* Interval 2 */ -/* Beginning TDB 2007-JAN-26 01:43:41.029955 (TDB) */ -/* Ending TDB 2007-JAN-26 01:43:41.029955 (TDB) */ - -/* ... */ - -/* Interval 24 */ -/* Beginning TDB 2007-DEC-17 04:04:46.935442 (TDB) */ -/* Ending TDB 2007-DEC-17 04:04:46.935442 (TDB) */ - -/* Interval 25 */ -/* Beginning TDB 2007-DEC-31 13:43:52.558897 (TDB) */ -/* Ending TDB 2007-DEC-31 13:43:52.558897 (TDB) */ - -/* Example(2): */ - -/* Determine the time of local maxima elongation of the */ -/* Moon as seen from earth for the same time interval */ -/* as the previous example: */ - -/* Edit the Example(1) program to use the assignments: */ - -/* TARG1 = 'MOON' */ -/* TARG2 = 'SUN' */ -/* OBSRVR = 'EARTH' */ - -/* The program's partial output: */ - -/* Interval 1 */ -/* Beginning TDB 2007-JAN-03 14:20:24.618884 (TDB) */ -/* Ending TDB 2007-JAN-03 14:20:24.618884 (TDB) */ - -/* Interval 2 */ -/* Beginning TDB 2007-FEB-02 06:16:24.101655 (TDB) */ -/* Ending TDB 2007-FEB-02 06:16:24.101655 (TDB) */ - -/* ... */ - -/* Interval 12 */ -/* Beginning TDB 2007-NOV-24 14:31:04.334590 (TDB) */ -/* Ending TDB 2007-NOV-24 14:31:04.334590 (TDB) */ - -/* Interval 13 */ -/* Beginning TDB 2007-DEC-24 01:40:12.238389 (TDB) */ -/* Ending TDB 2007-DEC-24 01:40:12.238389 (TDB) */ - -/* $ Restrictions */ - - -/* 1) The kernel files to be used by this routine must be loaded */ -/* (normally using the SPICELIB routine FURNSH) before this */ -/* routine is called. */ - -/* 2) This routine has the side effect of re-initializing the */ -/* angular separation quantity utility package. Callers may */ -/* need to re-initialize the package after calling this routine. */ - -/* 3) Due to the current logic implemented in ZZGFSPU, a direct */ -/* search for zero angular separation of two point targets will */ -/* always fails, i.e., */ - -/* RELATE = '=' */ -/* REFVAL = 0.D0 */ - -/* Use RELATE values of 'ABSMIN' or 'LOCMIN' to detect such an */ -/* event(s). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 29-DEC-2009 (EDW) */ - -/* Edited argument descriptions. Removed mention of "ELLIPSOID" */ -/* shape from SHAPE1 and SHAPE2 as that option is not yet */ -/* implemented. */ - -/* - SPICELIB Version 1.0.0, 19-FEB-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF angular separation search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Routines to set step size, refine transition times */ -/* and report work. */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Quantity definition parameter arrays: */ - - -/* Standard SPICE error handling. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - if (return_()) { - return 0; - } - chkin_("GFSEP", (ftnlen)5); - -/* Check the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFSEP", (ftnlen)5); - return 0; - } - if (*mw < 2 || ! even_(mw)) { - setmsg_("Workspace window size was #; size must be at least 2 and an" - " even value.", (ftnlen)71); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSEP", (ftnlen)5); - return 0; - } - if (*nw < 5) { - setmsg_("Workspace window count was #; count must be at least #.", ( - ftnlen)55); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__5, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSEP", (ftnlen)5); - return 0; - } - i__1 = sized_(result); - if (sized_(result) < 2 || ! even_(&i__1)) { - setmsg_("Result window size was #; size must be at least 2 and an ev" - "en value.", (ftnlen)68); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSEP", (ftnlen)5); - return 0; - } - -/* Set the TARGET1 body-fixed frame name and shape model identifier. */ - - s_copy(qpnams, "TARGET1", (ftnlen)80, (ftnlen)7); - s_copy(qcpars, targ1, (ftnlen)80, targ1_len); - s_copy(qpnams + 80, "FRAME1", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 80, frame1, (ftnlen)80, frame1_len); - s_copy(qpnams + 160, "SHAPE1", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 160, shape1, (ftnlen)80, shape1_len); - -/* Set the TARGET2 body-fixed frame name and shape model identifier. */ - - s_copy(qpnams + 240, "TARGET2", (ftnlen)80, (ftnlen)7); - s_copy(qcpars + 240, targ2, (ftnlen)80, targ2_len); - s_copy(qpnams + 320, "FRAME2", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 320, frame2, (ftnlen)80, frame2_len); - s_copy(qpnams + 400, "SHAPE2", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 400, shape2, (ftnlen)80, shape2_len); - -/* Observer, aberration and calculation reference frame settings. */ - - s_copy(qpnams + 480, "OBSERVER", (ftnlen)80, (ftnlen)8); - s_copy(qcpars + 480, obsrvr, (ftnlen)80, obsrvr_len); - s_copy(qpnams + 560, "ABCORR", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 560, abcorr, (ftnlen)80, abcorr_len); - -/* Set the step size. */ - - gfsstp_(step); - -/* Initialize the RESULT window to empty. */ - - scardd_(&c__0, result); - -/* Look for solutions. */ - -/* Progress report and bail-out options are set to .FALSE. */ - - gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "ANGULAR SEPARATION", &c__8, qpnams, - qcpars, qdpars, qipars, qlpars, relate, refval, &c_b32, adjust, - cnfine, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw, - &c__5, work, &c_false, (L_fp)gfbail_, result, (ftnlen)18, ( - ftnlen)80, (ftnlen)80, relate_len); - chkout_("GFSEP", (ftnlen)5); - return 0; -} /* gfsep_ */ - diff --git a/ext/spice/src/cspice/gfsep_c.c b/ext/spice/src/cspice/gfsep_c.c deleted file mode 100644 index fb266206b7..0000000000 --- a/ext/spice/src/cspice/gfsep_c.c +++ /dev/null @@ -1,1015 +0,0 @@ -/* - --Procedure gfsep_c (GF, angular separation search) - --Abstract - - Determine time intervals when the angular separation between - the position vectors of two target bodies relative to an observer - satisfies a numerical relationship. - --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 - - GF - NAIF_IDS - SPK - TIME - WINDOWS - --Keywords - - SEPARATION - GEOMETRY - SEARCH - EVENT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceGF.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "zzalloc.h" - - void gfsep_c ( ConstSpiceChar * targ1, - ConstSpiceChar * shape1, - ConstSpiceChar * frame1, - ConstSpiceChar * targ2, - ConstSpiceChar * shape2, - ConstSpiceChar * frame2, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - SPICE_GF_CNVTOL - P Convergence tolerance. - targ1 I Name of first body - shape1 I Name of shape model describing the first body - frame1 I The body-fixed reference frame of the first body - targ2 I Name of second body - shape2 I Name of the shape model describing the second body - frame2 I The body-fixed reference frame of the second body - abcorr I Aberration correction flag - obsrvr I Name of the observing body - relate I Operator that either looks for an extreme value - (max, min, local, absolute) or compares the - angular separation value and refval - refval I Reference value - adjust I Absolute extremum adjustment value - step I Step size in seconds for finding angular separation - events - nintvls I Workspace window interval count - cnfine I-O SPICE window to which the search is restricted - result O SPICE window containing results - --Detailed_Input - - targ1 the string naming the first body of interest. You can - also supply the integer ID code for the object as an - integer string. For example both 'MOON' and '301' - are legitimate strings that indicate the moon is the - target body. - - shape1 the string naming the geometric model used to represent - the shape of the targ1 body. Models supported by this routine: - - 'ELLIPSOID' Use a triaxial ellipsoid model, - with radius values provided by the - kernel pool. A kernel variable - having a name of the form - - 'BODYnnn_RADII' - - where nnn represents the NAIF - integer code associated with the - body, must be present in the kernel - pool. This variable must be - associated with three numeric - values giving the lengths of the - ellipsoid's X, Y, and Z semi-axes. - - *This option not yet implemented.* - - 'SPHERE' Treat the body as a sphere with radius - equal to the maximum value of - BODYnnn_RADII - - 'POINT' Treat the body as a point; - radius has value zero. - - The shape1 string lacks sensitivity to case, leading - and trailing blanks. - - frame1 the string naming the body-fixed reference frame - corresponding to targ1. - - targ2 the string naming the second body of interest. You can - also supply the integer ID code for the object as an - integer string. For example both 'MOON' and '301' - are legitimate strings that indicate the moon is the - target body. - - shape2 the string naming the geometric model used to represent - the shape of the targ2. Models supported by this routine: - - 'ELLIPSOID' Use a triaxial ellipsoid model, - with radius values provided by the - kernel pool. A kernel variable - having a name of the form - - 'BODYnnn_RADII' - - where nnn represents the NAIF - integer code associated with the - body, must be present in the kernel - pool. This variable must be - associated with three numeric - values giving the lengths of the - ellipsoid's X, Y, and Z semi-axes. - - 'SPHERE' Treat the body as a sphere with radius - equal to the maximum value of - BODYnnn_RADII - - 'POINT' Treat the body as a single point; - radius has value zero. - - The shape2 string lacks sensitivity to case, leading - and trailing blanks. - - frame2 the string naming the body-fixed reference frame - corresponding to targ2. - - abcorr the string indicating the aberration corrections to apply - to the observer-target position vector to account for - one-way light time and stellar aberration. - - This routine accepts the same aberration corrections as does - the SPICE routine SPKEZR. See the header of SPKEZR for a - detailed description of the aberration correction options. - For convenience, the options are listed below: - - 'NONE' Apply no correction. - - 'LT' "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - 'LT+S' "Reception" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'CN' "Reception" case: converged - Newtonian light time correction. - - 'CN+S' "Reception" case: converged - Newtonian light time and stellar - aberration corrections. - - 'XLT' "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - 'XLT+S' "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'XCN' "Transmission" case: converged - Newtonian light time correction. - - 'XCN+S' "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - The abcorr string lacks sensitivity to case, leading - and trailing blanks. - - obsrvr the string naming the observing body. Optionally, you - may supply the ID code of the object as an integer - string. For example, both 'EARTH' and '399' are - legitimate strings to supply to indicate the - observer is Earth. - - relate the string identifying the relational operator used to - define a constraint on the angular separation. The result - window found by this routine indicates the time intervals - where the constraint is satisfied. Supported values of - relate and corresponding meanings are shown below: - - '>' Separation is greater than the reference - value refval. - - '=' Separation is equal to the reference - value refval. - - '<' Separation is less than the reference - value refval. - - 'ABSMAX' Separation is at an absolute maximum. - - 'ABSMIN' Separation is at an absolute minimum. - - 'LOCMAX' Separation is at a local maximum. - - 'LOCMIN' Separation is at a local minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified angular separation of an absolute extremum. - The argument adjust (described below) is used to - specify this angular separation. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - The relate string lacks sensitivity to case, leading - and trailing blanks. - - refval the double precision reference value used together with - relate argument to define an equality or inequality to be - satisfied by the angular separation between the specified target - and observer. See the discussion of relate above for - further information. - - The units of refval are radians. - - adjust a double precision value used to modify searches for - absolute extrema: when relate is set to ABSMAX or ABSMIN and - adjust is set to a positive value, GFSEP finds times when the - angular separation between the bodies is within adjust radians - of the specified extreme value. - - For relate set to ABSMAX, the result window contains - time intervals when the angular separation has - values between ABSMAX - adjust and ABSMAX. - - For relate set to ABSMIN, the result window contains - time intervals when the angular separation has - values between ABSMIN and ABSMIN + adjust. - - adjust is not used for searches for local extrema, - equality or inequality conditions. - - step a double precision value defining the step size to use in - the search. step must be short enough for a search using step - to locate the time intervals where the specified - angular separation function is monotone increasing or - decreasing. However, step must not be *too* short, or - the search will take an unreasonable amount of time. - - The choice of step affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - 'step' has units of TDB seconds. - - nintvls an integer value specifying the number of intervals in the - the internal workspace array used by this routine. 'nintvls' - should be at least as large as the number of intervals - within the search region on which the specified observer-target - vector coordinate function is monotone increasing or decreasing. - It does no harm to pick a value of 'nintvls' larger than the - minimum required to execute the specified search, but if chosen - too small, the search will fail. - - cnfine a double precision SPICE window that confines the time - period over which the specified search is conducted. - cnfine may consist of a single interval or a collection - of intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - result the SPICE window of intervals, contained within the - confinement window cnfine, on which the specified - constraint is satisfied. - - If result is non-empty on input, its contents - will be discarded before gfsep_c conducts its - search. - - result must be declared and initialized with sufficient - size to capture the full set of time intervals - within the search region on which the specified constraint - is satisfied. - - If the search is for local extrema, or for absolute - extrema with adjust set to zero, then normally each - interval of result will be a singleton: the left and - right endpoints of each interval will be identical. - - If no times within the confinement window satisfy the - constraint, result will be returned with a - cardinality of zero. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL; the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found by - this routine depends on the accuracy of the input data. - In most cases, the accuracy of solutions will be inferior - to their precision. - - SPICE_GF_CNVTOL has the value 1.0e-6. Units are TDB - seconds. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If the aberration correction specifier contains an - unrecognized value, an error is signaled by a routine in the - call tree of this routine. - - 6) If `adjust' is negative, an error is signaled by a routine in - the call tree of this routine. - - 7) If either of the input body names do not map to NAIF ID - codes, an error is signaled by a routine in the call tree of - this routine. - - 8) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 9) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 11) If the workspace interval count 'nintvls' is less than 1, the - error SPICE(VALUEOUTOFRANGE) will be signaled. - - 12) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - --Files - - Appropriate SPK and PCK kernels must be loaded by the - calling program before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the targets, observer, and any intermediate objects in - a chain connecting the targets and observer that cover the time - period specified by the window CNFINE. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files using - FURNSH. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file using FURNSH. - - - If non-inertial reference frames are used, then PCK - files, frame kernels, C-kernels, and SCLK kernels may be - needed. - - Such kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - - This routine provides a simpler, but less flexible interface - than does the routine gfevnt_c for conducting searches for - angular separation events. Applications that require support for - progress reporting, interrupt handling, non-default step or - refinement functions, or non-default convergence tolerance should - call gfevnt_c rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window for which the angular separation - between the two bodies satisfies some defined relationship. - The resulting set of intervals is returned as a SPICE window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - angular separation function is monotone increasing and monotone - decreasing. Each of these time periods is represented by a SPICE window. - Having found these windows, all of the angular separation function's - local extrema within the confinement window are known. Absolute extrema - then can be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - - Step Size - ========= - - The monotone windows (described above) are found using a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of angular separation (angular separation rate) will be - sampled. Starting at the left endpoint of an interval, samples - will be taken at each step. If a change of sign is found, a - root has been bracketed; at that point, the time at which the - angular separation rate is zero can be found by a refinement - process, for example, using a binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the distance function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - As described above, the root-finding process used by this routine - involves first bracketing roots and then using a search process - to locate them. "Roots" are both times when local extrema are - attained and times when the distance function is equal to a - reference value. All endpoints of the intervals comprising the - result window are either endpoints of intervals of the - confinement window or roots. - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set by the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value in the f2c'd - routine so that the tolerance doesn't become the limiting factor - in the accuracy of solutions found by this routine. In general the - accuracy of input data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such - as gfevnt_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - - - Negative Angular Separation - =========================== - - For those searches using a SPHERE shape identifier for both - target bodies, the angular separation function returns a - negative value when the bodies overlap (occult), e.g. - a search for an ABSMIN of angular separation in a - confinement window covering an occultation event will - return the time when the apparent center of the - occulting body passes closest to the apparent center of - the occulted body. - - - Elongation - =========================== - - The angular separation of two targets as seen from an observer - where one of those targets is the sun is known as elongation. - --Examples - - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - The examples shown below require a "standard" set of SPICE - kernels. We list these kernels in a meta kernel named 'standard.tm'. - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de414.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - - - \begindata - - KERNELS_TO_LOAD = ( '/kernels/gen/lsk/naif0008.tls' - '/kernels/gen/spk/de414.bsp' - '/kernels/gen/pck/pck00008.tpc' - ) - - - Example(1): - - Determine the times of local maxima of the angular separation - between the moon and earth as observed from the sun from - Jan 1, 2007 to Jan 1 2008. - - #include - #include - #include - - #include "SpiceUsr.h" - - #define MAXWIN 1000 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND" - #define TIMLEN 41 - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one window - consists of two values, so the total number - of cell values to allocate equals twice - the number of windows. - ./ - SPICEDOUBLE_CELL ( result, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - SpiceChar * targ1 = "MOON"; - SpiceChar * frame1 = "NULL"; - SpiceChar * shape1 = "SPHERE"; - - SpiceChar * targ2 = "EARTH"; - SpiceChar * frame2 = "NULL"; - SpiceChar * shape2 = "SPHERE"; - - SpiceChar * abcorr = "NONE"; - SpiceChar * relate = "LOCMAX"; - - SpiceChar * obsrvr = "SUN"; - - SpiceInt count; - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - - /. - Store the time bounds of our search interval in - the cnfine confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2008 JAN 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - Search using a step size of 6 days (in units of seconds). - ./ - step = 6.*spd_c(); - adjust = 0.; - refval = 0.; - - /. - List the beginning and ending points in each interval - if result contains data. - ./ - gfsep_c ( targ1, - shape1, - frame1, - targ2, - shape2, - frame2, - abcorr, - obsrvr, - relate, - refval, - adjust, - step, - MAXWIN, - &cnfine, - &result ); - - count = wncard_c( &result ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result, i, &beg, &end ); - - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - timout_c ( end, TIMFMT, TIMLEN, endstr ); - - printf ( "Interval %d\n", i + 1); - printf ( "Beginning TDB %s \n", begstr ); - printf ( "Ending TDB %s \n", endstr ); - - } - } - - kclear_c(); - return( 0 ); - } - - The program's partial output: - - Interval 1 - Beginning TDB 2007-JAN-11 11:21:20.213872 (TDB) - Ending TDB 2007-JAN-11 11:21:20.213872 (TDB) - - Interval 2 - Beginning TDB 2007-JAN-26 01:43:41.029955 (TDB) - Ending TDB 2007-JAN-26 01:43:41.029955 (TDB) - - ... - - Interval 24 - Beginning TDB 2007-DEC-17 04:04:46.935442 (TDB) - Ending TDB 2007-DEC-17 04:04:46.935442 (TDB) - - Interval 25 - Beginning TDB 2007-DEC-31 13:43:52.558897 (TDB) - Ending TDB 2007-DEC-31 13:43:52.558897 (TDB) - - Example(2): - - Determine the time of local maxima elongation of the - Moon as seen from earth for the same time interval - as the previous example: - - Edit the Example(1) program to use the assignments: - - SpiceChar * targ1 = "MOON"; - SpiceChar * targ2 = "SUN"; - SpiceChar * obsrvr = "EARTH"; - - The program's partial output: - - Interval 1 - Beginning TDB 2007-JAN-03 14:20:24.618884 (TDB) - Ending TDB 2007-JAN-03 14:20:24.618884 (TDB) - - Interval 2 - Beginning TDB 2007-FEB-02 06:16:24.101655 (TDB) - Ending TDB 2007-FEB-02 06:16:24.101655 (TDB) - - ... - - Interval 12 - Beginning TDB 2007-NOV-24 14:31:04.334590 (TDB) - Ending TDB 2007-NOV-24 14:31:04.334590 (TDB) - - Interval 13 - Beginning TDB 2007-DEC-24 01:40:12.238389 (TDB) - Ending TDB 2007-DEC-24 01:40:12.238389 (TDB) - --Restrictions - - 1) The kernel files to be used by this routine must be loaded - (normally via the CSPICE routine furnsh_c) before this routine - is called. - - 2) This routine has the side effect of re-initializing the - angular separation quantity utility package. Callers may - need to re-initialize the package after calling this routine. - - 3) Due to the current logic implemented in zzgfspu, a direct - search for zero angular separation of two point targets will - always fails, i.e., - - 'relate' has value "=" - 'refval' has value 0. - - Use 'relate' values of "ABSMIN" or "LOCMIN" to detect such an event(s). - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 19-AUG-2009 (EDW) - - Corrected typo in the VALUEOUTOFRANGE error message. Corrected - the routine name in "chkout_c" call, "gfposc_c", with correct - name "gfrr_c." - - -CSPICE Version 1.0.0, 10-FEB-2009 (NJB) (EDW) - --Index_Entries - - GF angular separation search - --& -*/ - - { /* Begin gfsep_c */ - - /* - Local variables - */ - doublereal * work; - - static SpiceInt nw = SPICE_GF_NWSEP; - SpiceInt nBytes; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfsep_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfsep_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfsep_c", targ1 ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", shape1 ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", frame1 ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", targ2 ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", shape2 ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", frame2 ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "gfsep_c", relate ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value of one (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfsep_c" ); - return; - } - - /* - Allocate the workspace. 'nintvls' indicates the maximum number of - intervals returned in 'result'. An interval consists of - two values. - */ - - nintvls = 2 * nintvls; - - nBytes = ( nintvls + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) alloc_SpiceMemory( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "gfsep_c" ); - return; - } - - /* - Let the f2'd routine do the work. - */ - - gfsep_( ( char * ) targ1, - ( char * ) shape1, - ( char * ) frame1, - ( char * ) targ2, - ( char * ) shape2, - ( char * ) frame2, - ( char * ) abcorr, - ( char * ) obsrvr, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(targ1), - ( ftnlen ) strlen(shape1), - ( ftnlen ) strlen(frame1), - ( ftnlen ) strlen(targ2), - ( ftnlen ) strlen(shape2), - ( ftnlen ) strlen(frame2), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr), - ( ftnlen ) strlen(relate) ); - - /* - De-allocate the workspace. - */ - free_SpiceMemory( work ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - ALLOC_CHECK; - - chkout_c ( "gfsep_c" ); - - } /* End gfsep_c */ diff --git a/ext/spice/src/cspice/gfsntc.c b/ext/spice/src/cspice/gfsntc.c deleted file mode 100644 index 2665480132..0000000000 --- a/ext/spice/src/cspice/gfsntc.c +++ /dev/null @@ -1,1708 +0,0 @@ -/* gfsntc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__10 = 10; -static doublereal c_b29 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFSNTC (GF, surface intercept vector coordinate search) */ -/* Subroutine */ int gfsntc_(char *target, char *fixref, char *method, char * - abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, - char *coord, char *relate, doublereal *refval, doublereal *adjust, - doublereal *step, doublereal *cnfine, integer *mw, integer *nw, - doublereal *work, doublereal *result, ftnlen target_len, ftnlen - fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, - ftnlen dref_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen - relate_len) -{ - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical even_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int gfrefn_(), gfrepi_(), gfrepu_(), gfrepf_(), - gfstep_(); - char qcpars[80*10], qpnams[80*10]; - doublereal qdpars[10]; - integer qipars[10]; - logical qlpars[10]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *, - integer *, char *, char *, doublereal *, integer *, logical *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *, - logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine time intervals for which a coordinate of an */ -/* surface intercept position vector satisfies a numerical */ -/* constraint. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* CK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* COORDINATE */ -/* GEOMETRY */ -/* SEARCH */ -/* EVENT */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound */ -/* CNVTOL P Convergence tolerance */ -/* TARGET I Name of the target body */ -/* FIXREF I Body fixed frame associated with TARGET */ -/* METHOD I Name of method type for surface intercept */ -/* calculation */ -/* ABCORR I Aberration correction flag */ -/* OBSRVR I Name of the observing body */ -/* DREF I Reference frame of direction vector DVEC. */ -/* DVEC I Pointing direction vector from OBSRVR. */ -/* CRDSYS I Name of the coordinate system containing COORD */ -/* COORD I Name of the coordinate of interest */ -/* RELATE I Relational operator */ -/* REFVAL I Reference value */ -/* ADJUST I Adjustment value for absolute extrema searches */ -/* STEP I Step size used for locating extrema and roots */ -/* CNFINE I SPICE window to which the search is confined */ -/* MW I Workspace window size */ -/* NW I The number of workspace windows needed for the */ -/* search */ -/* WORK I-O Array of workspace windows */ -/* RESULT I-O SPICE window containing results */ - -/* $ Detailed_Input */ - -/* TARGET the string name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* On calling GFSNTC, the kernel pool must contain the radii */ -/* data corresponding to TARGET. */ - -/* FIXREF the string name of the body-fixed, body-centered */ -/* reference frame associated with the target body TARGET. */ - -/* The SPICE frame subsystem must recognize the 'fixref' */ -/* name. */ - -/* METHOD the string name of the method to use for the surface */ -/* intercept calculation. The accepted values for METHOD: */ - -/* 'Ellipsoid' The intercept computation uses */ -/* a triaxial ellipsoid to model */ -/* the surface of the target body. */ -/* The ellipsoid's radii must be */ -/* available in the kernel pool. */ - -/* The METHOD string lacks sensitivity to case, embedded, */ -/* leading and trailing blanks. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* *Note* */ - -/* When using a reference frame defined as a dynamic frame, */ -/* the user should realize defining an aberration correction */ -/* for the search different from that in the frames */ -/* definition will affect the search results. */ - -/* In general, use the same aberration correction for */ -/* intercept point searches as used in the definition of a */ -/* dynamic frame (if applicable). */ - -/* OBSRVR the string name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to indicate the observer as Earth. */ - -/* DREF the string name of the reference frame corresponding to */ -/* DVEC. */ - -/* The DREF string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* DVEC the pointing or boresight vector from the observer. The */ -/* intercept of this vector and TARGET is the event of */ -/* interest. */ - -/* CRDSYS the string name of the coordinate system for which the */ -/* coordinate of interest is a member */ - -/* COORD the string name of the coordinate of interest in CRDSYS */ - -/* The supported coordinate systems and coordinate names: */ - -/* Coordinate System (CRDSYS) Coordinates (COORD) Range */ - -/* 'RECTANGULAR' 'X' */ -/* 'Y' */ -/* 'Z' */ - -/* 'LATITUDINAL' 'RADIUS' */ -/* 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ - -/* 'RA/DEC' 'RANGE' */ -/* 'RIGHT ASCENSION' [0,2Pi) */ -/* 'DECLINATION' [-Pi/2,Pi/2] */ - -/* 'SPHERICAL' 'RADIUS' */ -/* 'COLATITUDE' [0,Pi] */ -/* 'LONGITUDE' (-Pi,Pi] */ - -/* 'CYLINDRICAL' 'RADIUS' */ -/* 'LONGITUDE' [0,2Pi) */ -/* 'Z' */ - -/* 'GEODETIC' 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* The ALTITUDE coordinates have a constant value */ -/* of zero +/- roundoff for ellipsoid targets. */ - -/* Limit searches for coordinate events in the GEODETIC */ -/* and PLANETOGRAPHIC coordinate systems to TARGET bodies */ -/* with axial symmetry in the equatorial plane, i.e. */ -/* equality of the body X and Y radii (oblate or prolate */ -/* spheroids). */ - -/* RELATE the string or character describing the relational */ -/* operator used to define a constraint on the selected */ -/* coordinate of the surface intercept vector. The result */ -/* window found by this routine indicates the time intervals */ -/* where the constraint is satisfied. Supported values of */ -/* RELATE and corresponding meanings are shown below: */ - -/* '>' The coordinate value is greater than the */ -/* reference value REFVAL. */ - -/* '=' The coordinate value is equal to the */ -/* reference value REFVAL. */ - -/* '<' The coordinate value is less than the */ -/* reference value REFVAL. */ - -/* 'ABSMAX' The coordinate value is at an absolute */ -/* maximum. */ - -/* 'ABSMIN' The coordinate value is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' The coordinate value is at a local */ -/* maximum. */ - -/* 'LOCMIN' The coordinate value is at a local */ -/* minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified measure of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this measure. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* The RELATE string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* REFVAL the double precision reference value used together with */ -/* the argument RELATE to define an equality or inequality */ -/* to satisfy by the selected coordinate of the surface */ -/* intercept vector. See the discussion of RELATE above for */ -/* further information. */ - -/* The units of REFVAL correspond to the type as defined */ -/* by COORD, radians for angular measures, kilometers for */ -/* distance measures. */ - -/* ADJUST a double precision value used to modify searches for */ -/* absolute extrema: when RELATE is set to ABSMAX or ABSMIN */ -/* and ADJUST is set to a positive value, GFSNTC finds times */ -/* when the intercept vector coordinate is within ADJUST */ -/* radians/kilometers of the specified extreme value. */ - -/* For RELATE set to ABSMAX, the RESULT window contains */ -/* time intervals when the intercept vector coordinate has */ -/* values between ABSMAX - ADJUST and ABSMAX. */ - -/* For RELATE set to ABSMIN, the RESULT window contains */ -/* time intervals when the intercept vector coordinate has */ -/* values between ABSMIN and ABSMIN + ADJUST. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions. */ - -/* STEP the double precision time step size to use in the search. */ - -/* Selection of the time step for surface intercept geometry */ -/* requires consideration of the mechanics of a surface */ -/* intercept event. In most cases, two distinct searches */ -/* will be needed, one to determine the windows when the */ -/* boresight vector intercepts the surface and then the */ -/* search based on the user defined constraints within those */ -/* windows. The boresight of nadir pointing instrument may */ -/* continually intercept a body, but an instrument scanning */ -/* across a disc will have configurations when the */ -/* boresight does not intercept the body. */ - -/* The step size must be smaller than the shortest interval */ -/* within the confinement window over which the intercept */ -/* exists and also smaller than the shortest interval over */ -/* which the intercept does not exist. */ - -/* For coordinates other than LONGITUDE and RIGHT ASCENSION, */ -/* the step size must be shorter than the shortest interval, */ -/* within the confinement window, over which the coordinate */ -/* is monotone increasing or decreasing. */ - -/* For LONGITUDE and RIGHT ASCENSION, the step size must */ -/* be shorter than the shortest interval, within the */ -/* confinement window, over which either the sin or cosine */ -/* of the coordinate is monotone increasing or decreasing. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - -/* CNFINE a double precision SPICE window that confines the time */ -/* period over which the specified search is conducted. */ -/* CNFINE may consist of a single interval or a collection */ -/* of intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller using the */ -/* SPICELIB routine SSIZED. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. NW should be set to the */ -/* parameter NWMAX; this parameter is declared in the */ -/* include file gf.inc. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* INCLUDE 'gf.inc' */ -/* ... */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* where MW is a constant declared by the caller and */ -/* NWMAX is a constant defined in the SPICELIB INCLUDE */ -/* file gf.inc. See the discussion of MW above. */ - -/* WORK need not be initialized by the caller. */ - -/* RESULT a double precision SPICE window which will contain the */ -/* search results. RESULT must be initialized using */ -/* a call to SSIZED. RESULT must be declared and initialized */ -/* with sufficient size to capture the full set of time */ -/* intervals within the search region on which the specified */ -/* constraint is satisfied. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFSNTC conducts its */ -/* search. */ - -/* $ Detailed_Output */ - -/* WORK the input workspace array, modified by this */ -/* routine. */ - -/* RESULT the SPICE window of intervals, contained within the */ -/* confinement window CNFINE, on which the specified */ -/* constraint is satisfied. */ - -/* If the search is for local extrema, or for absolute */ -/* extrema with ADJUST set to zero, then normally each */ -/* interval of RESULT will be a singleton: the left and */ -/* right endpoints of each interval will be identical. */ - -/* If no times within the confinement window satisfy the */ -/* constraint, RESULT will be returned with a */ -/* cardinality of zero. */ - -/* $ Parameters */ - -/* LBCELL the integer value defining the lower bound for */ -/* SPICE Cell arrays (a SPICE window is a kind of cell). */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the specified coordinate is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, an error is signaled */ -/* by a routine in the call tree of this routine. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - truncation error in time values */ -/* - finite tolerance value */ -/* - errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* RESULT window. One technique to handle such a situation, */ -/* slightly contract RESULT using the window routine WNCOND. */ - -/* 3) If the window size MW is less than 2 or not an even value, */ -/* the error SPICE(INVALIDDIMENSION) will signal. */ - -/* 4) If the window size of RESULT is less than 2, the error */ -/* SPICE(INVALIDDIMENSION) will signal. */ - -/* 5) If an error (typically cell overflow) occurs during */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 6) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 7) If the size of the workspace is too small, an error is */ -/* signaled by a routine in the call tree of this routine. */ - -/* 8) If ADJUST is negative, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 9) If either of the input body names do not map to NAIF ID */ -/* codes, an error is signaled by a routine in the call tree of */ -/* this routine. */ - -/* 10) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* 11) If a body has unequal equatorial radii, a search for */ -/* coordinate events in the GEODETIC or PLANETOGRAPHIC coordinate */ -/* systems will cause the SPICE(NOTSUPPORTED) error to signal. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the calling */ -/* program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer that cover the */ -/* time period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files using */ -/* FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Such kernel data are normally loaded once per program run, NOT */ -/* every time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides a simpler, but less flexible interface */ -/* than does the routine GFEVNT for conducting searches for */ -/* surface intercept vector coordinate value events. */ -/* Applications that require support for progress reporting, */ -/* interrupt handling, non-default step or refinement functions, or */ -/* non-default convergence tolerance should call GFEVNT rather than */ -/* this routine. */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when the selected coordinate of */ -/* the surface intercept position vector satisfies a caller-specified */ -/* constraint. The resulting set of intervals is returned as a SPICE */ -/* window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* coordinate function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the coordinate */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of coordinate will be sampled. Starting at */ -/* the left endpoint of an interval, samples will be taken at each */ -/* step. If a change of sign is found, a root has been bracketed; at */ -/* that point, the time at which the time derivative of the */ -/* coordinate is zero can be found by a refinement process, for */ -/* example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the coordinate function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* As described above, the root-finding process used by this routine */ -/* involves first bracketing roots and then using a search process */ -/* to locate them. "Roots" are both times when local extrema are */ -/* attained and times when the coordinate function is equal to a */ -/* reference value. All endpoints of the intervals comprising the */ -/* result window are either endpoints of intervals of the */ -/* confinement window or roots. */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set by the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFEVNT must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - -/* Practical use of the coordinate search capability would likely */ -/* consist of searches over multiple coordinate constraints to find */ -/* time intervals that satisfies the constraints. An */ -/* effective technique to accomplish such a search is */ -/* to use the result window from one search as the confinement window */ -/* of the next. */ - -/* Longitude and Right Ascension */ -/* ============================= */ - -/* The cyclic nature of the longitude and right ascension coordinates */ -/* produces branch cuts at +/- 180 degrees longitude and 0-360 */ -/* longitude. Round-off error may cause solutions near these branches */ -/* to cross the branch. Use of the SPICE routine WNCOND will contract */ -/* solution windows by some epsilon, reducing the measure of the */ -/* windows and eliminating the branch crossing. A one millisecond */ -/* contraction will in most cases eliminate numerical round-off */ -/* caused branch crossings. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* The examples shown below require a "standard" set of SPICE */ -/* kernels. We list these kernels in a meta kernel named */ -/* 'standard.tm'. */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de414.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( '/kernels/gen/lsk/naif0008.tls' */ -/* '/kernels/gen/spk/de414.bsp' */ -/* '/kernels/gen/pck/pck00008.tpc' */ -/* ) */ - - -/* The examples shown below require a frames kernel defining a */ -/* a dynamic frame, Sun-Earth Motion. The frame defined by the */ -/* sun-to-earth direction vector as the X axis. The Y axis in the */ -/* earth orbital plane, and Z completing the right hand system. */ - -/* We name this frames kernel "sem.tf". */ - -/* \begindata */ - -/* FRAME_SEM = 10100000 */ -/* FRAME_10100000_NAME = 'SEM' */ -/* FRAME_10100000_CLASS = 5 */ -/* FRAME_10100000_CLASS_ID = 10100000 */ -/* FRAME_10100000_CENTER = 10 */ -/* FRAME_10100000_RELATIVE = 'J2000' */ -/* FRAME_10100000_DEF_STYLE = 'PARAMETERIZED' */ -/* FRAME_10100000_FAMILY = 'TWO-VECTOR' */ -/* FRAME_10100000_PRI_AXIS = 'X' */ -/* FRAME_10100000_PRI_VECTOR_DEF = 'OBSERVER_TARGET_POSITION' */ -/* FRAME_10100000_PRI_OBSERVER = 'SUN' */ -/* FRAME_10100000_PRI_TARGET = 'EARTH' */ -/* FRAME_10100000_PRI_ABCORR = 'NONE' */ -/* FRAME_10100000_SEC_AXIS = 'Y' */ -/* FRAME_10100000_SEC_VECTOR_DEF = 'OBSERVER_TARGET_VELOCITY' */ -/* FRAME_10100000_SEC_OBSERVER = 'SUN' */ -/* FRAME_10100000_SEC_TARGET = 'EARTH' */ -/* FRAME_10100000_SEC_ABCORR = 'NONE' */ -/* FRAME_10100000_SEC_FRAME = 'J2000' */ - -/* Example(1) */ - -/* Find the time during 2007 for which the latitude of the */ -/* intercept point of the vector pointing from the sun towards */ -/* the earth in the IAU_EARTH frame equals zero i.e. the intercept */ -/* point crosses the equator. */ - -/* PROGRAM GFSNTC_EX1 */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local variables and initial parameters. */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Create 50 windows. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 1000 ) */ - -/* C */ -/* C One window consists of two intervals. */ -/* C */ -/* INTEGER NINTRVL */ -/* PARAMETER ( NINTRVL = MAXWIN *2 ) */ - -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 64 ) */ - -/* CHARACTER*(STRLEN) BEGSTR */ -/* CHARACTER*(STRLEN) ENDSTR */ -/* CHARACTER*(STRLEN) TARGET */ -/* CHARACTER*(STRLEN) OBSRVR */ -/* CHARACTER*(STRLEN) DREF */ -/* CHARACTER*(STRLEN) ABCORR */ -/* CHARACTER*(STRLEN) METHOD */ -/* CHARACTER*(STRLEN) FIXREF */ -/* CHARACTER*(STRLEN) CRDSYS */ -/* CHARACTER*(STRLEN) COORD */ -/* CHARACTER*(STRLEN) RELATE */ - -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION DVEC ( 3 ) */ -/* DOUBLE PRECISION CNFINE ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION WORK ( LBCELL : NINTRVL, NWMAX ) */ - - -/* DOUBLE PRECISION BEGTIM */ -/* DOUBLE PRECISION ENDTIM */ -/* DOUBLE PRECISION BEG */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION ADJUST */ -/* INTEGER COUNT */ - -/* INTEGER I */ - - -/* C */ -/* C The SEM frame defines the X axis as always earth pointing. */ -/* C */ -/* C Define the earth pointing vector in the SEM frame. */ -/* C */ -/* DATA DVEC / 1.D0, 0.D0, 0.D0 / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ('standard.tm') */ -/* CALL FURNSH ('sem.tf') */ - -/* C */ -/* C Initialize windows RESULT and CNFINE. */ -/* C */ -/* CALL SSIZED ( NINTRVL, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the CNFINE confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 01', BEGTIM ) */ -/* CALL STR2ET ( '2008 JAN 01', ENDTIM ) */ - -/* CALL WNINSD ( BEGTIM, ENDTIM, CNFINE ) */ - -/* C */ -/* C Search using a step size of 1 day (in units of seconds). */ -/* C */ -/* STEP = SPD() */ - -/* C */ -/* C Search for a condition where the latitudinal system */ -/* C coordinate latitude in the IAU_EARTH frame has value zero. */ -/* C In this case, the pointing vector, 'DVEC', defines the */ -/* C vector direction pointing at the earth from the sun. */ -/* C */ -/* ADJUST = 0.D0 */ -/* REFVAL = 0.D0 */ -/* TARGET = 'EARTH' */ -/* OBSRVR = 'SUN' */ -/* DREF = 'SEM' */ -/* METHOD = 'Ellipsoid' */ -/* FIXREF = 'IAU_EARTH' */ -/* CRDSYS = 'LATITUDINAL' */ -/* COORD = 'LATITUDE' */ -/* RELATE = '=' */ - -/* C */ -/* C Use the same aberration correction flag as that in the SEM */ -/* C frame definition. */ -/* C */ -/* ABCORR = 'NONE' */ - -/* CALL GFSNTC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . DREF, DVEC, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, STEP, CNFINE, */ -/* . NINTRVL, NWMAX, WORK, RESULT ) */ - -/* C */ -/* C Check the number of intervals in the result window. */ -/* C */ -/* COUNT = WNCARD(RESULT) */ - -/* C */ -/* C List the beginning and ending points in each interval */ -/* C if RESULT contains data. */ -/* C */ -/* IF ( COUNT .EQ. 0 ) THEN */ -/* WRITE (*, '(A)') 'Result window is empty.' */ -/* ELSE */ - -/* DO I = 1, COUNT */ - -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, I, BEG, END ) */ - -/* CALL TIMOUT ( BEG, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', BEGSTR ) */ -/* CALL TIMOUT ( END, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', ENDSTR ) */ - -/* WRITE (*,*) 'Interval ', I */ -/* WRITE (*,*) 'Beginning TDB ', BEGSTR */ -/* WRITE (*,*) 'Ending TDB ', ENDSTR */ - -/* END DO */ - -/* END IF */ - -/* END */ - -/* The program outputs: */ - -/* Interval 1 */ -/* Beginning TDB 2007-MAR-21 00:01:25.495120 (TDB) */ -/* Ending TDB 2007-MAR-21 00:01:25.495120 (TDB) */ - -/* Interval 2 */ -/* Beginning TDB 2007-SEP-23 09:46:39.574123 (TDB) */ -/* Ending TDB 2007-SEP-23 09:46:39.574123 (TDB) */ - -/* Example(2) */ - -/* Find the time during 2007 for which the intercept point on the */ -/* earth of the sun-to-earth vector as described in Example 1 in */ -/* the IAU_EARTH frame lies within a geodetic latitude-longitude */ -/* "box" defined as */ - -/* 16 degrees <= latitude <= 17 degrees */ -/* 85 degrees <= longitude <= 86 degrees */ - -/* This problem requires four searches, each search on one of the */ -/* box restrictions. The user needs also realize the temporal */ -/* behavior of latitude greatly differs from that of the longitude. */ -/* The intercept latitude varies between approximately 23.44 degrees */ -/* and -23.44 degrees during the year. The intercept longitude */ -/* varies between -180 degrees and 180 degrees in one day. */ - -/* PROGRAM GFSNTC_EX2 */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION RPD */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local variables and initial parameters. */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Create 50 windows. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 1000 ) */ - -/* C */ -/* C One window consists of two intervals. */ -/* C */ -/* INTEGER NINTRVL */ -/* PARAMETER ( NINTRVL = MAXWIN *2 ) */ - -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 64 ) */ - -/* CHARACTER*(STRLEN) BEGSTR */ -/* CHARACTER*(STRLEN) ENDSTR */ -/* CHARACTER*(STRLEN) TARGET */ -/* CHARACTER*(STRLEN) OBSRVR */ -/* CHARACTER*(STRLEN) DREF */ -/* CHARACTER*(STRLEN) ABCORR */ -/* CHARACTER*(STRLEN) METHOD */ -/* CHARACTER*(STRLEN) FIXREF */ -/* CHARACTER*(STRLEN) CRDSYS */ -/* CHARACTER*(STRLEN) COORD */ -/* CHARACTER*(STRLEN) RELATE */ - -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION DVEC ( 3 ) */ -/* DOUBLE PRECISION CNFINE ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT1 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT2 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT3 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT4 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION WORK ( LBCELL : NINTRVL, NWMAX ) */ - - -/* DOUBLE PRECISION BEGTIM */ -/* DOUBLE PRECISION ENDTIM */ -/* DOUBLE PRECISION BEG */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION ADJUST */ - -/* INTEGER COUNT */ -/* INTEGER I */ - - -/* C */ -/* C The SEM frame defines the X axis as always earth pointing. */ -/* C */ -/* C Define the earth pointing vector in the SEM frame. */ -/* C */ -/* DATA DVEC / 1.D0, 0.D0, 0.D0 / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ('standard.tm') */ -/* CALL FURNSH ('sem.tf') */ - -/* C */ -/* C Initialize windows RESULT and CNFINE. */ -/* C */ -/* CALL SSIZED ( NINTRVL, RESULT1 ) */ -/* CALL SSIZED ( NINTRVL, RESULT2 ) */ -/* CALL SSIZED ( NINTRVL, RESULT3 ) */ -/* CALL SSIZED ( NINTRVL, RESULT4 ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the CNFINE confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 01', BEGTIM ) */ -/* CALL STR2ET ( '2008 JAN 01', ENDTIM ) */ - -/* CALL WNINSD ( BEGTIM, ENDTIM, CNFINE ) */ - -/* C */ -/* C The latitude varies relatively slowly, ~46 degrees during */ -/* C the year. The extrema occur approximately every six months. */ -/* C Search using a step size less than half that value */ -/* C (180 days). For this example use ninety days (in units */ -/* C of seconds). */ -/* C */ -/* STEP = SPD()*90.D0 */ - -/* C */ -/* C Perform four searches to determine the times when the */ -/* C latitude-longitude box restriction conditions apply. In */ -/* C this case, the pointing vector, 'DVEC', defines the vector */ -/* C direction pointing at the earth from the sun. */ -/* C */ -/* C Use geodetic coordinates. */ -/* C */ -/* ADJUST = 0.D0 */ -/* TARGET = 'EARTH' */ -/* OBSRVR = 'SUN' */ -/* DREF = 'SEM' */ -/* METHOD = 'Ellipsoid' */ -/* FIXREF = 'IAU_EARTH' */ -/* CRDSYS = 'GEODETIC' */ - - -/* C */ -/* C Use the same aberration correction flag as that in the SEM */ -/* C frame definition. */ -/* C */ -/* ABCORR = 'NONE' */ - -/* C */ -/* C Perform the searches such that the result window of a search */ -/* C serves as the confinement window of the subsequent search. */ -/* C */ - -/* C */ -/* C Since the latitude coordinate varies slowly and is well */ -/* C behaved over the time of the confinement window, search */ -/* C first for the windows satisfying the latitude requirements, */ -/* C then use that result as confinement for the longitude */ -/* C search. */ -/* C */ -/* COORD = 'LATITUDE' */ -/* REFVAL = 16.D0 * RPD() */ -/* RELATE = '>' */ - -/* CALL GFSNTC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . DREF, DVEC, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, CNFINE, STEP, */ -/* . NINTRVL, NWMAX, WORK, RESULT1 ) */ - -/* REFVAL = 17.D0 * RPD() */ -/* RELATE = '<' */ - -/* CALL GFSNTC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . DREF, DVEC, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, RESULT1, STEP, */ -/* . NINTRVL, NWMAX, WORK, RESULT2 ) */ - - -/* C */ -/* C Now the longitude search. */ -/* C */ -/* COORD = 'LONGITUDE' */ - -/* C */ -/* C Reset the stepsize to something appropriate for the 360 */ -/* C degrees in 24 hours domain. The longitude shows near */ -/* C linear behavior so use a stepsize less than half the period */ -/* C of twelve hours. Ten hours will suffice in this case. */ -/* C */ -/* STEP = SPD() * (10.D0/24.D0) */ - -/* REFVAL = 85.D0 * RPD() */ -/* RELATE = '>' */ - -/* CALL GFSNTC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . DREF, DVEC, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, RESULT2, STEP, */ -/* . NINTRVL, NWMAX, WORK, RESULT3 ) */ - -/* C */ -/* C Contract the endpoints of each window to account */ -/* C for possible round-off error at the -180/180 degree branch. */ -/* C */ -/* C A contraction value of a millisecond should eliminate */ -/* C any round-off caused branch crossing. */ -/* C */ -/* CALL WNCOND ( 1D-3, 1D-3, RESULT3 ) */ - -/* REFVAL = 86.D0 * RPD() */ -/* RELATE = '<' */ - -/* CALL GFSNTC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . DREF, DVEC, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, RESULT3, STEP, */ -/* . NINTRVL, NWMAX, WORK, RESULT4 ) */ - -/* C */ -/* C Check the number of intervals in the result window. */ -/* C */ -/* COUNT = WNCARD(RESULT4) */ - -/* C */ -/* C List the beginning and ending points in each interval */ -/* C if RESULT contains data. */ -/* C */ -/* IF ( COUNT .EQ. 0 ) THEN */ -/* WRITE(*, '(A)') 'Result window is empty.' */ -/* ELSE */ - -/* DO I = 1, COUNT */ - -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT4, I, BEG, END ) */ - -/* CALL TIMOUT ( BEG, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', BEGSTR ) */ -/* CALL TIMOUT ( END, */ -/* . 'YYYY-MON-DD HR:MN:SC.###### ' */ -/* . // '(TDB) ::TDB ::RND', ENDSTR ) */ - -/* WRITE(*,*) 'Interval ', I */ -/* WRITE(*,*) 'Beginning TDB ', BEGSTR */ -/* WRITE(*,*) 'Ending TDB ', ENDSTR */ -/* WRITE(*,*) ' ' */ - -/* END DO */ - -/* END IF */ - -/* END */ - -/* The program outputs: */ - -/* Interval 1 */ -/* Beginning TDB 2007-MAY-05 06:14:04.637735 (TDB) */ -/* Ending TDB 2007-MAY-05 06:18:03.621908 (TDB) */ - -/* Interval 2 */ -/* Beginning TDB 2007-MAY-06 06:13:59.583484 (TDB) */ -/* Ending TDB 2007-MAY-06 06:17:58.569239 (TDB) */ - -/* Interval 3 */ -/* Beginning TDB 2007-MAY-07 06:13:55.102940 (TDB) */ -/* Ending TDB 2007-MAY-07 06:17:54.090299 (TDB) */ - -/* Interval 4 */ -/* Beginning TDB 2007-AUG-06 06:23:17.282927 (TDB) */ -/* Ending TDB 2007-AUG-06 06:27:16.264009 (TDB) */ - -/* Interval 5 */ -/* Beginning TDB 2007-AUG-07 06:23:10.545441 (TDB) */ -/* Ending TDB 2007-AUG-07 06:27:09.524926 (TDB) */ - -/* Interval 6 */ -/* Beginning TDB 2007-AUG-08 06:23:03.233996 (TDB) */ -/* Ending TDB 2007-AUG-08 06:27:02.211889 (TDB) */ - -/* Interval 7 */ -/* Beginning TDB 2007-AUG-09 06:22:55.351256 (TDB) */ -/* Ending TDB 2007-AUG-09 06:26:54.327566 (TDB) */ - -/* $ Restrictions */ - -/* 1) The kernel files to be used by this routine must be loaded */ -/* (normally using the SPICELIB routine FURNSH) before this */ -/* routine is called. */ - -/* 2) This routine has the side effect of re-initializing the */ -/* coordinate quantity utility package. Callers may */ -/* need to re-initialize the package after calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 16-FEB-2010 (NJB) (EDW) */ - -/* Edits to and corrections of argument descriptions and */ -/* header. */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF surface intercept coordinate search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Routines to set step size, refine transition times */ -/* and report work. */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Quantity definition parameter arrays: */ - - -/* Standard SPICE error handling. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - if (return_()) { - return 0; - } - -/* Check into the error subsystem. */ - - chkin_("GFSNTC", (ftnlen)6); - -/* Confirm minimum window sizes. */ - - if (*mw < 2 || ! even_(mw)) { - setmsg_("Workspace window size was #; size must be at least 2 and an" - " even value.", (ftnlen)71); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSNTC", (ftnlen)6); - return 0; - } - if (sized_(result) < 2) { - setmsg_("Result window size was #; size must be at least 2.", (ftnlen) - 50); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSNTC", (ftnlen)6); - return 0; - } - -/* Set up a call to GFEVNT specific to the surface intercept */ -/* coordinate search. */ - - s_copy(qpnams, "TARGET", (ftnlen)80, (ftnlen)6); - s_copy(qcpars, target, (ftnlen)80, target_len); - s_copy(qpnams + 80, "OBSERVER", (ftnlen)80, (ftnlen)8); - s_copy(qcpars + 80, obsrvr, (ftnlen)80, obsrvr_len); - s_copy(qpnams + 160, "ABCORR", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 160, abcorr, (ftnlen)80, abcorr_len); - s_copy(qpnams + 240, "COORDINATE SYSTEM", (ftnlen)80, (ftnlen)17); - s_copy(qcpars + 240, crdsys, (ftnlen)80, crdsys_len); - s_copy(qpnams + 320, "COORDINATE", (ftnlen)80, (ftnlen)10); - s_copy(qcpars + 320, coord, (ftnlen)80, coord_len); - s_copy(qpnams + 400, "REFERENCE FRAME", (ftnlen)80, (ftnlen)15); - s_copy(qcpars + 400, fixref, (ftnlen)80, fixref_len); - s_copy(qpnams + 480, "VECTOR DEFINITION", (ftnlen)80, (ftnlen)17); - s_copy(qcpars + 480, "SURFACE INTERCEPT POINT", (ftnlen)80, (ftnlen)23); - s_copy(qpnams + 560, "METHOD", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 560, method, (ftnlen)80, method_len); - s_copy(qpnams + 640, "DREF", (ftnlen)80, (ftnlen)4); - s_copy(qcpars + 640, dref, (ftnlen)80, dref_len); - s_copy(qpnams + 720, "DVEC", (ftnlen)80, (ftnlen)4); - qdpars[0] = dvec[0]; - qdpars[1] = dvec[1]; - qdpars[2] = dvec[2]; - -/* Set the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFSNTC", (ftnlen)6); - return 0; - } - gfsstp_(step); - -/* Initialize the RESULT window to empty. */ - - scardd_(&c__0, result); - -/* Look for solutions. */ - -/* Progress report and interrupt options are set to .FALSE. */ - - gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "COORDINATE", &c__10, qpnams, - qcpars, qdpars, qipars, qlpars, relate, refval, &c_b29, adjust, - cnfine, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw, - nw, work, &c_false, (L_fp)gfbail_, result, (ftnlen)10, (ftnlen) - 80, (ftnlen)80, relate_len); - chkout_("GFSNTC", (ftnlen)6); - return 0; -} /* gfsntc_ */ - diff --git a/ext/spice/src/cspice/gfsntc_c.c b/ext/spice/src/cspice/gfsntc_c.c deleted file mode 100644 index 66213de371..0000000000 --- a/ext/spice/src/cspice/gfsntc_c.c +++ /dev/null @@ -1,1300 +0,0 @@ -/* - --Procedure gfsntc_c (GF, surface intercept vector coordinate search) - --Abstract - - Determine time intervals for which a coordinate of an - surface intercept position vector satisfies a numerical constraint. - --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 - - GF - SPK - CK - TIME - WINDOWS - --Keywords - - SEPARATION - GEOMETRY - SEARCH - EVENT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceGF.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "zzalloc.h" - #undef gfsntc_c - - void gfsntc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - SPICE_GF_CNVTOL - P Convergence tolerance - target I Name of the target body - fixref I Body fixed frame associated with 'target' - method I Name of method type for surface intercept calculation - abcorr I Aberration correction flag - obsrvr I Name of the observing body - dref I Reference frame of direction vector 'dvec' - dvec I Pointing direction vector from 'obsrvr' - crdsys I Name of the coordinate system containing COORD - coord I Name of the coordinate of interest - relate I Operator that either looks for an extreme value - (max, min, local, absolute) or compares the - coordinate value and refval - refval I Reference value - adjust I Adjustment value for absolute extrema searches - step I Step size used for locating extrema and roots - nintvls I Workspace window interval count - cnfine I-O SPICE window to which the search is restricted - result O SPICE window containing results - --Detailed_Input - - target the string name of a target body. Optionally, you may - supply the integer ID code for the object as an - integer string. For example both 'MOON' and '301' - are legitimate strings that indicate the moon is the - target body. - - On calling gfsntc_c, the kernel pool must contain the - radii data corresponding to 'target'. - - fixref the string name of the body-fixed, body-centered - reference frame associated with the target body target. - - The SPICE frame subsystem must recognize the 'fixref' name. - - method the string name of the method to use for the surface intercept - calculation. The accepted values for method: - - 'Ellipsoid' The intercept computation uses - a triaxial ellipsoid to model - the surface of the target body. - The ellipsoid's radii must be - available in the kernel pool. - - The method string lacks sensitivity to case, and to leading - and trailing blanks. - - abcorr the string description of the aberration corrections to apply - to the state evaluations to account for one-way light time - and stellar aberration. - - This routine accepts the same aberration corrections as does - the SPICE routine SPKEZR. See the header of SPKEZR for a - detailed description of the aberration correction options. - For convenience, the options are listed below: - - 'NONE' Apply no correction. - - 'LT' "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - 'LT+S' "Reception" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'CN' "Reception" case: converged - Newtonian light time correction. - - 'CN+S' "Reception" case: converged - Newtonian light time and stellar - aberration corrections. - - 'XLT' "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - 'XLT+S' "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'XCN' "Transmission" case: converged - Newtonian light time correction. - - 'XCN+S' "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - The abcorr string lacks sensitivity to case, and to embedded, - leading and trailing blanks. - - obsrvr the string naming the observing body. Optionally, you - may supply the ID code of the object as an integer - string. For example, both 'EARTH' and '399' are - legitimate strings to supply to indicate the - observer is Earth. - - dref the string name of the reference frame corresponding to dvec. - - The dref string lacks sensitivity to case, leading - and trailing blanks. - - dvec the pointing or boresight vector from the observer. The - intercept of this vector and target is the event of interest. - - crdsys the string name of the coordinate system for which the - coordinate of interest is a member. - - coord the string name of the coordinate of interest in crdsys. - - The supported coordinate systems and coordinate names are: - - Coordinate System (CRDSYS) Coordinates (COORD) Range - - 'RECTANGULAR' 'X' - 'Y' - 'Z' - - 'LATITUDINAL' 'RADIUS' - 'LONGITUDE' (-Pi,Pi] - 'LATITUDE' [-Pi/2,Pi/2] - - 'RA/DEC' 'RANGE' - 'RIGHT ASCENSION' [0,2Pi) - 'DECLINATION' [-Pi/2,Pi/2] - - 'SPHERICAL' 'RADIUS' - 'COLATITUDE' [0,Pi] - 'LONGITUDE' (-Pi,Pi] - - 'CYLINDRICAL' 'RADIUS' - 'LONGITUDE' [0,2Pi) - 'Z' - - 'GEODETIC' 'LONGITUDE' (-Pi,Pi] - 'LATITUDE' [-Pi/2,Pi/2] - 'ALTITUDE' - - 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) - 'LATITUDE' [-Pi/2,Pi/2] - 'ALTITUDE' - - The ALTITUDE coordinates have a constant value - of zero +/- roundoff for ellipsoid targets. - - Limit searches for coordinate events in the GEODETIC and - PLANETOGRAPHIC coordinate systems to TARGET bodies with - axial symmetry in the equatorial plane, i.e. equality - of the body X and Y radii (oblate or prolate spheroids). - - relate the string or character describing the relational operator - used to define a constraint on the selected coordinate of the - surface intercept vector. The result window found by this routine - indicates the time intervals where the constraint is satisfied. - Supported values of relate and corresponding meanings are - shown below: - - '>' Separation is greater than the reference - value refval. - - '=' Separation is equal to the reference - value refval. - - '<' Separation is less than the reference - value refval. - - 'ABSMAX' Separation is at an absolute maximum. - - 'ABSMIN' Separation is at an absolute minimum. - - 'LOCMAX' Separation is at a local maximum. - - 'LOCMIN' Separation is at a local minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified measure of an absolute extremum. - The argument ADJUST (described below) is used to - specify this measure. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - The relate string lacks sensitivity to case, leading - and trailing blanks. - - refval the double precision reference value used together with - relate argument to define an equality or inequality to - satisfy by the selected coordinate of the surface intercept - vector. See the discussion of relate above for - further information. - - The units of refval correspond to the type as defined - by coord, radians for angular measures, kilometers for - distance measures. - - adjust a double precision value used to modify searches for - absolute extrema: when relate is set to ABSMAX or ABSMIN and - adjust is set to a positive value, gfsntc_c finds times when the - position vector coordinate is within adjust radians/kilometers - of the specified extreme value. - - For relate set to ABSMAX, the result window contains - time intervals when the position vector coordinate has - values between ABSMAX - adjust and ABSMAX. - - For relate set to ABSMIN, the result window contains - time intervals when the position vector coordinate has - values between ABSMIN and ABSMIN + adjust. - - adjust is not used for searches for local extrema, - equality or inequality conditions. - - step the double precision time step size to use in the search. - - Selection of the time step for surface intercept geometry - requires consideration of the mechanics of a surface intercept - event. In most cases, two distinct searches will be needed, - one to determine the windows when the boresight vector - intercepts the surface and then the search based on the user - defined constraints within those windows. The boresight of - nadir pointing instrument may continually intercept a body, but - an instrument scanning across a disc will have configurations - when the boresight does not intercept the body. - - The step size must be smaller than the shortest interval - within the confinement window over which the intercept exists - and also smaller than the shortest interval over which the - intercept does not exist. - - For coordinates other than LONGITUDE and RIGHT ASCENSION, - the step size must be shorter than the shortest interval, - within the confinement window, over which the coordinate - is monotone increasing or decreasing. - - For LONGITUDE and RIGHT ASCENSION, the step size must - be shorter than the shortest interval, within the - confinement window, over which either the sin or cos - of the coordinate is monotone increasing or decreasing. - - The choice of 'step' affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - 'step' has units of TDB seconds. - - nintvls an integer value specifying the number of intervals in the - the internal workspace array used by this routine. 'nintvls' - should be at least as large as the number of intervals - within the search region on which the specified intercept - vector coordinate function is monotone increasing or decreasing. - It does no harm to pick a value of 'nintvls' larger than the - minimum required to execute the specified search, but if chosen - too small, the search will fail. - - cnfine a double precision SPICE window that confines the time - period over which the specified search is conducted. - cnfine may consist of a single interval or a collection - of intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - result the SPICE window of intervals, contained within the - confinement window cnfine, on which the specified - constraint is satisfied. - - If result is non-empty on input, its contents - will be discarded before gfsntc_c conducts its - search. - - result must be declared and initialized with sufficient - size to capture the full set of time intervals - within the search region on which the specified constraint - is satisfied. - - If the search is for local extrema, or for absolute - extrema with adjust set to zero, then normally each - interval of result will be a singleton: the left and - right endpoints of each interval will be identical. - - If no times within the confinement window satisfy the - constraint, result will be returned with a - cardinality of zero. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL; the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found by - this routine depends on the accuracy of the input data. - In most cases, the accuracy of solutions will be inferior - to their precision. - - SPICE_GF_CNVTOL has the value 1.0e-6. Units are TDB - seconds. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If the aberration correction specifier contains an - unrecognized value, an error is signaled by a routine in the - call tree of this routine. - - 6) If `adjust' is negative, an error is signaled by a routine in - the call tree of this routine. - - 7) If either of the input body names do not map to NAIF ID - codes, an error is signaled by a routine in the call tree of - this routine. - - 8) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 9) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 11) If the workspace interval count 'nintvls' is less than 1, the - error SPICE(VALUEOUTOFRANGE) will be signaled. - - 12) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - --Files - - Appropriate SPK and PCK kernels must be loaded by the - calling program before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the targets, observer, and any intermediate objects in - a chain connecting the targets and observer that cover the time - period specified by the window CNFINE. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files using - FURNSH. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file using FURNSH. - - - If non-inertial reference frames are used, then PCK - files, frame kernels, C-kernels, and SCLK kernels may be - needed. - - Such kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - This routine provides a simpler, but less flexible interface - than does the routine gfevnt_c for conducting searches for - surface intercept vector coordinate value events. - Applications that require support for progress reporting, interrupt - handling, non-default step or refinement functions, or non-default - convergence tolerance should call gfevnt_c rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window when the selected coordinate of - the surface intercept vector satisfies a caller-specified - constraint. The resulting set of intervals is returned as a SPICE - window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - coordinate function is monotone increasing and monotone - decreasing. Each of these time periods is represented by a SPICE - window. Having found these windows, all of the coordinate - function's local extrema within the confinement window are known. - Absolute extrema then can be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - - Step Size - ========= - - The monotone windows (described above) are found using a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of coordinate will be sampled. Starting at - the left endpoint of an interval, samples will be taken at each - step. If a change of sign is found, a root has been bracketed; at - that point, the time at which the time derivative of the coordinate - is zero can be found by a refinement process, for example, - using a binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the coordinate function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - Convergence Tolerance - ===================== - - As described above, the root-finding process used by this routine - involves first bracketing roots and then using a search process - to locate them. "Roots" are both times when local extrema are - attained and times when the distance function is equal to a - reference value. All endpoints of the intervals comprising the - result window are either endpoints of intervals of the - confinement window or roots. - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set by the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value in the f2c'd - routine so that the tolerance doesn't become the limiting factor - in the accuracy of solutions found by this routine. In general the - accuracy of input data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such - as gfevnt_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - - Practical use of the coordinate search capability would likely - consist of searches over multiple coordinate constraints to find - time intervals that satisfies the constraints. An effective - technique to accomplish such a search is to use the result - window from one search as the confinement window of the next. - - Longitude and Right Ascension - ============================= - - The cyclic nature of the longitude and right ascension coordinates - produces branch cuts at +/- 180 degrees longitude and 0-360 - longitude. Round-off error may cause solutions near these branches - to cross the branch. Use of the SPICE routine wncond_c will contract - solution windows by some epsilon, reducing the measure of the - windows and eliminating the branch crossing. A one millisecond - contraction will in most cases eliminate numerical round-off caused - branch crossings. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - The examples shown below require a "standard" set of SPICE - kernels. We list these kernels in a meta kernel named 'standard.tm'. - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de414.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - - \begindata - - KERNELS_TO_LOAD = ( '/kernels/gen/lsk/naif0008.tls' - '/kernels/gen/spk/de414.bsp' - '/kernels/gen/pck/pck00008.tpc' - ) - - - The examples shown below require a frames kernel defining a - a dynamic frame, Sun-Earth Motion. The frame defined by the - sun-to-earth direction vector as the X axis. The Y axis in the - earth orbital plane, and Z completing the right hand system. - - We name this frames kernel "sem.tf". - - \begindata - - FRAME_SEM = 10100000 - FRAME_10100000_NAME = 'SEM' - FRAME_10100000_CLASS = 5 - FRAME_10100000_CLASS_ID = 10100000 - FRAME_10100000_CENTER = 10 - FRAME_10100000_RELATIVE = 'J2000' - FRAME_10100000_DEF_STYLE = 'PARAMETERIZED' - FRAME_10100000_FAMILY = 'TWO-VECTOR' - FRAME_10100000_PRI_AXIS = 'X' - FRAME_10100000_PRI_VECTOR_DEF = 'OBSERVER_TARGET_POSITION' - FRAME_10100000_PRI_OBSERVER = 'SUN' - FRAME_10100000_PRI_TARGET = 'EARTH' - FRAME_10100000_PRI_ABCORR = 'NONE' - FRAME_10100000_SEC_AXIS = 'Y' - FRAME_10100000_SEC_VECTOR_DEF = 'OBSERVER_TARGET_VELOCITY' - FRAME_10100000_SEC_OBSERVER = 'SUN' - FRAME_10100000_SEC_TARGET = 'EARTH' - FRAME_10100000_SEC_ABCORR = 'NONE' - FRAME_10100000_SEC_FRAME = 'J2000' - - Example(1): - - Find the time during 2007 for which the latitude of the - intercept point of the vector pointing from the sun towards - the earth in the IAU_EARTH frame equals zero i.e. the intercept - point crosses the equator. - - #include - #include - #include - - #include "SpiceUsr.h" - - #define MAXWIN 1000 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND" - #define TIMLEN 64 - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one window - consists of two values, so the total number - of cell values to allocate is twice - the number of intervals. - ./ - SPICEDOUBLE_CELL ( result, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - SpiceChar * relate = "="; - SpiceChar * crdsys = "LATITUDINAL"; - SpiceChar * coord = "LATITUDE"; - SpiceChar * method = "Ellipsoid"; - SpiceChar * targ = "EARTH"; - SpiceChar * obsrvr = "SUN"; - SpiceChar * dref = "SEM"; - SpiceDouble dvec[] = { 1, 0, 0 }; - SpiceChar * fixref = "IAU_EARTH"; - SpiceChar * abcorr = "NONE"; - - SpiceInt count; - SpiceInt i; - - - /. - Search for a condition where the latitudinal system coordinate - latitude in the IAU_EARTH frame has value zero. In this case, - the pointing vector, 'DVEC', defines the vector direction - pointing at the earth from the sun. - ./ - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - furnsh_c( "sem.tf" ); - - /. - Store the time bounds of our search interval in - the cnfine confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2008 JAN 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - The latitude varies relatively slowly, ~46 degrees during the - year. The extrema occur approximately every six months. - Search using a step size less than half that value (180 days). - For this example use ninety days (in units of seconds). - ./ - step = (90.)*spd_c(); - adjust = 0.; - refval = 0; - - /. - List the beginning and ending points in each interval - if result contains data. - ./ - gfsntc_c ( targ, - fixref, - method, - abcorr, - obsrvr, - dref, - dvec, - crdsys, - coord, - relate, - refval, - adjust, - step, - MAXWIN, - &cnfine, - &result ); - - count = wncard_c( &result ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result, i, &beg, &end ); - - if ( beg == end ) - { - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - printf ( "Event time: %s\n", begstr ); - } - else - { - - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - timout_c ( end, TIMFMT, TIMLEN, endstr ); - - printf ( "Interval %d\n", i + 1); - printf ( "From : %s \n", begstr ); - printf ( "To : %s \n", endstr ); - printf( " \n" ); - } - - } - } - - kclear_c(); - return( 0 ); - } - - The program outputs: - - Event time: 2007-MAR-21 00:01:25.495120 (TDB) - Event time: 2007-SEP-23 09:46:39.574124 (TDB) - - Example(2): - - Find the time during 2007 for which the intercept point on the - earth of the sun-to-earth vector as described in Example 1 in - the IAU_EARTH frame lies within a geodetic latitude-longitude - "box" defined as - - 16 degrees <= latitude <= 17 degrees - 85 degrees <= longitude <= 86 degrees - - This problem requires four searches, each search on one of the - box restrictions. The user needs also realize the temporal behavior - of latitude greatly differs from that of the longitude. The - the intercept latitude varies between approximately 23.44 degrees - and -23.44 degrees during the year. The intercept longitude varies - between -180 degrees and 180 degrees in one day. - - #include - #include - #include - - #include "SpiceUsr.h" - - #define MAXWIN 100 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND" - #define STRLEN 64 - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one window - consists of two values, so the total number - of cell values to allocate equals twice - the number of intervals. - ./ - SPICEDOUBLE_CELL ( result1, 2*MAXWIN ); - SPICEDOUBLE_CELL ( result2, 2*MAXWIN ); - SPICEDOUBLE_CELL ( result3, 2*MAXWIN ); - SPICEDOUBLE_CELL ( result4, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ STRLEN ]; - SpiceChar endstr [ STRLEN ]; - SpiceChar * target = "EARTH"; - SpiceChar * obsrvr = "SUN"; - SpiceChar * dref = "SEM"; - SpiceDouble dvec[] = { 1, 0, 0 }; - SpiceChar * fixref = "IAU_EARTH"; - SpiceChar * method = "Ellipsoid"; - SpiceChar * crdsys = "GEODETIC"; - - /. - Use the same aberration correction flag as that in the SEM frame - definition. - ./ - SpiceChar * abcorr = "NONE"; - - SpiceInt count; - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - furnsh_c( "sem.tf" ); - - /. - Store the time bounds of our search interval in - the cnfine confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2008 JAN 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - Perform four searches to determine the times when the - latitude-longitude box restriction conditions apply. In this case, - the pointing vector, 'dvec', defines the vector direction - pointing at the earth from the sun. - - - Perform the searches such that the result window of a search - serves as the confinement window of the subsequent search. - - Since the latitude coordinate varies slowly and is well behaved - over the time of the confinement window, search first for the - windows satisfying the latitude requirements, then use that result - as confinement for the longitude search. - ./ - - /. - The latitude varies relatively slowly, ~46 degrees during the - year. The extrema occur approximately every six months. - Search using a step size less than half that value (180 days). - For this example use ninety days (in units of seconds). - ./ - - step = (90.)*spd_c(); - adjust = 0.; - - { - SpiceChar * coord = "LATITUDE"; - SpiceChar * relate = ">"; - - refval = 16. *rpd_c(); - - gfsntc_c ( target, fixref, - method, abcorr, obsrvr, - dref, dvec, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &cnfine, &result1 ); - } - - - { - SpiceChar * coord = "LATITUDE"; - SpiceChar * relate = "<"; - - refval = 17. *rpd_c(); - - gfsntc_c ( target, fixref, - method, abcorr, obsrvr, - dref, dvec, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &result1, &result2 ); - } - - - /. - Now the longitude search. - ./ - - /. - Reset the stepsize to something appropriate for the 360 - degrees in 24 hours domain. The longitude shows near - linear behavior so use a stepsize less than half the period - of twelve hours. Ten hours will suffice in this case. - ./ - step = (10./24.)*spd_c(); - - { - SpiceChar * coord = "LONGITUDE"; - SpiceChar * relate = ">"; - - refval = 85. *rpd_c(); - - gfsntc_c ( target, fixref, - method, abcorr, obsrvr, - dref, dvec, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &result2, &result3 ); - - /. - Contract the endpoints of each window to account - for possible round-off error at the -180/180 degree branch. - - A contraction value of a millisecond should eliminate - any round-off caused branch crossing. - ./ - - wncond_c( 1e-3, 1e-3, &result3 ); - } - - - { - SpiceChar * coord = "LONGITUDE"; - SpiceChar * relate = "<"; - - refval = 86. *rpd_c(); - - gfsntc_c ( target, fixref, - method, abcorr, obsrvr, - dref, dvec, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &result3, &result4 ); - } - - - /. - List the beginning and ending points in each interval - if result contains data. - ./ - count = wncard_c( &result4 ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result4, i, &beg, &end ); - - timout_c ( beg, TIMFMT, STRLEN, begstr ); - timout_c ( end, TIMFMT, STRLEN, endstr ); - - printf ( "Interval %d\n", i + 1); - printf ( "Beginning TDB %s \n", begstr ); - printf ( "Ending TDB %s \n\n", endstr ); - - } - } - - kclear_c(); - return( 0 ); - } - - The program outputs: - - Interval 1 - Beginning TDB 2007-MAY-05 06:14:04.637735 (TDB) - Ending TDB 2007-MAY-05 06:18:03.621907 (TDB) - - Interval 2 - Beginning TDB 2007-MAY-06 06:13:59.583483 (TDB) - Ending TDB 2007-MAY-06 06:17:58.569239 (TDB) - - Interval 3 - Beginning TDB 2007-MAY-07 06:13:55.102940 (TDB) - Ending TDB 2007-MAY-07 06:17:54.090299 (TDB) - - Interval 4 - Beginning TDB 2007-AUG-06 06:23:17.282927 (TDB) - Ending TDB 2007-AUG-06 06:27:16.264009 (TDB) - - Interval 5 - Beginning TDB 2007-AUG-07 06:23:10.545441 (TDB) - Ending TDB 2007-AUG-07 06:27:09.524926 (TDB) - - Interval 6 - Beginning TDB 2007-AUG-08 06:23:03.233996 (TDB) - Ending TDB 2007-AUG-08 06:27:02.211889 (TDB) - - Interval 7 - Beginning TDB 2007-AUG-09 06:22:55.351256 (TDB) - Ending TDB 2007-AUG-09 06:26:54.327566 (TDB) - --Restrictions - - 1) The kernel files to be used by this routine must be loaded - (normally via the CSPICE routine furnsh_c) before this routine - is called. - - 2) This routine has the side effect of re-initializing the - coordinate quantity utility package. Callers may - need to re-initialize the package after calling this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 16-FEB-2010 (NJB) (EDW) - - Edits to and corrections of argument descriptions and - header. - - -CSPICE Version 1.0.0, 17-FEB-2009, EDW (JPL) - --Index_Entries - - GF surface intercept coordinate search - --& -*/ - - { /* Begin gfsntc_c */ - - /* - Local variables - */ - doublereal * work; - - SpiceInt nBytes; - - static SpiceInt nw = SPICE_GF_NWMAX; - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfsntc_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfsntc_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfsntc_c", target ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", fixref ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", method ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", dref ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", crdsys ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", coord ); - CHKFSTR ( CHK_STANDARD, "gfsntc_c", relate ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value of one (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfposc_c" ); - return; - } - - /* - Allocate the workspace. 'nintvls' indicates the maximum number of - intervals returned in 'result'. An interval consists of - two values. - */ - - nintvls = 2 * nintvls; - - nBytes = ( nintvls + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) alloc_SpiceMemory( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "gfsntc_c" ); - return; - } - - - /* - Let the f2'd routine do the work. - */ - - gfsntc_ ( ( char * ) target, - ( char * ) fixref, - ( char * ) method, - ( char * ) abcorr, - ( char * ) obsrvr, - ( char * ) dref, - ( doublereal * ) dvec, - ( char * ) crdsys, - ( char * ) coord, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(fixref), - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr), - ( ftnlen ) strlen(dref), - ( ftnlen ) strlen(crdsys), - ( ftnlen ) strlen(coord), - ( ftnlen ) strlen(relate) ); - - - /* - De-allocate the workspace. - */ - free_SpiceMemory( work ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - ALLOC_CHECK; - - chkout_c ( "gfsntc_c" ); - - } /* End gfsntc_c */ diff --git a/ext/spice/src/cspice/gfsstp_c.c b/ext/spice/src/cspice/gfsstp_c.c deleted file mode 100644 index 55ba194f11..0000000000 --- a/ext/spice/src/cspice/gfsstp_c.c +++ /dev/null @@ -1,174 +0,0 @@ -/* - --Procedure gfsstp_c ( Geometry finder set step size ) - --Abstract - - Set the step size to be returned by gfstep_c. - --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 - - GF - TIME - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void gfsstp_c ( SpiceDouble step ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - step I Time step to take. - --Detailed_Input - - step is the output step size to be returned by the next call - to gfstep_c. Units are TDB seconds. - - `step' is used in the GF search root-bracketing process. - `step' indicates how far to advance the gfstep_c input - argument `time' so that `time' and time+step may bracket a - state transition and definitely do not bracket more than - one state transition. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the input step size is non-positive, the error - SPICE(INVALIDSTEP) is signaled. The stored step value - is not updated. - --Files - - None. - --Particulars - - This routine sets the step size to be returned by the - next call to gfstep_c. - --Examples - - - 1) User applications can pass gfstep_c to mid-level GF API routines - expecting a step size routine as an input argument. Before such - a call is made, the value of the step to be returned by gfstep_c - must be set via a call to this routine. - - For example, the GF API routine gfocce_c can be called as shown - in the code fragment below. - - /. - Select a twenty-second step. We'll ignore any occultations - lasting less than 20 seconds. - ./ - step = 20.0; - gfsstp_c ( step ); - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, cnfine, - &result ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.0.1, 15-APR-2009 (LSE) (NJB) - --Index_Entries - - GF set constant step size --& -*/ - -{ /* Begin gfsstp_c */ - - - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return; - } - - chkin_c ( "gfsstp_c" ); - - /* - Let the f2c'd routine do the work. - */ - - gfsstp_ ( (doublereal * ) &step ); - - chkout_c ( "gfsstp_c" ); - -} /* End gfsstp_c */ diff --git a/ext/spice/src/cspice/gfstep.c b/ext/spice/src/cspice/gfstep.c deleted file mode 100644 index 1946f3349a..0000000000 --- a/ext/spice/src/cspice/gfstep.c +++ /dev/null @@ -1,340 +0,0 @@ -/* gfstep.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure GFSTEP ( GF, step size ) */ -/* Subroutine */ int gfstep_0_(int n__, doublereal *time, doublereal *step) -{ - /* Initialized data */ - - static logical svinit = FALSE_; - static doublereal svstep = -1.; - - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Return the time step set by the most recent call to GFSSTP. */ - -/* $ 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 */ - -/* GF */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TIME I Ignored ET value. */ -/* STEP O Time step to take. */ - -/* $ Detailed_Input */ - -/* TIME is an ignored double precision number. This argument */ -/* is present so the argument list of this routine is */ -/* compatible with the GF step size routine argument list */ -/* specification. */ - -/* When this routine is called from within the GF */ -/* root-finding system, either the initial ET value of the */ -/* current interval of the confinement window, or the */ -/* value resulting from the last search step, is passed in */ -/* via the TIME argument. */ - -/* $ Detailed_Output */ - -/* STEP is the output step size. This is the value set by the */ -/* most recent call to GFSSTP. Units are TDB seconds. */ - -/* STEP is used in the GF search root-bracketing process. */ -/* STEP indicates how far to advance TIME so that TIME and */ -/* TIME+STEP may bracket a state transition and definitely */ -/* do not bracket more than one state transition. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called before a step size has been */ -/* set via a call to GFSSTP, the error SPICE(NOTINITIALIZED) */ -/* is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the time step set by the most recent call to */ -/* GFSSTP. */ - -/* $ Examples */ - -/* 1) In normal usage of a high-level GF API routine, the caller */ -/* will pass in a constant step size STEP. The API routine will */ -/* then make the call */ - -/* CALL GFSSTP ( STEP ) */ - -/* Subsequent calls to GFSTEP during the search process conducted */ -/* by the API routine will return STEP. */ - - -/* 2) User applications can pass GFSTEP to mid-level GF API routines */ -/* expecting a step size routine as an input argument. For */ -/* example, the GF API routine GFOCCE can be called as follows: */ - - -/* Set the step size. */ - -/* CALL GFSSTP ( STEP ) */ - - -/* Look for solutions. (GFSTEP is the 11th argument.) */ - -/* CALL GFOCCE ( OCCTYP, FRONT, FSHAPE, FFRAME, */ -/* . BACK, BSHAPE, BFRAME, ABCORR, */ -/* . OBSRVR, CNVTOL, GFSTEP, GFREFN, */ -/* . RPT, GFREPI, GFREPU, GFREPF, */ -/* . BAIL, GFBAIL, CNFINE, RESULT ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (IMU) (WLT) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF get constant step size */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_gfsstp; - } - - -/* Discovery check-in. */ - - if (! svinit) { - chkin_("GFSTEP", (ftnlen)6); - setmsg_("Step size was never initialized.", (ftnlen)32); - sigerr_("SPICE(NOTINITIALIZED)", (ftnlen)21); - chkout_("GFSTEP", (ftnlen)6); - return 0; - } - -/* Set STEP to the saved value from the last call to GFSSTP. */ - - *step = svstep; - return 0; -/* $Procedure GFSSTP ( Geometry finder set step size ) */ - -L_gfsstp: -/* $ Abstract */ - -/* Set the step size to be returned by GFSTEP. */ - - -/* $ 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 */ - -/* GF */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ - -/* DOUBLE PRECISION STEP */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STEP I Time step to take. */ - -/* $ Detailed_Input */ - -/* STEP is the output step size to be returned by the next call */ -/* GFSTEP. Units are TDB seconds. */ - -/* STEP is used in the GF search root-bracketing process. */ -/* STEP indicates how far to advance TIME so that TIME and */ -/* TIME+STEP may bracket a state transition and definitely */ -/* do not bracket more than one state transition. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input step size is non-positive, the error */ -/* SPICE(INVALIDSTEP) is signaled. The stored step value */ -/* is not updated. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* See the header of GFSTEP above. */ - -/* $ Examples */ - -/* See the header of GFSTEP above. */ - -/* $ Restrictions */ - -/* This routine must be called before the first time */ -/* GFSTEP is called during a program run. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 15-APR-2009 (LSE) (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF set constant step size */ - -/* -& */ - -/* Discovery check-in. */ - - if (*step <= 0.) { - chkin_("GFSSTP", (ftnlen)6); - setmsg_("Step size was #.", (ftnlen)16); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFSSTP", (ftnlen)6); - return 0; - } - svstep = *step; - svinit = TRUE_; - return 0; -} /* gfstep_ */ - -/* Subroutine */ int gfstep_(doublereal *time, doublereal *step) -{ - return gfstep_0_(0, time, step); - } - -/* Subroutine */ int gfsstp_(doublereal *step) -{ - return gfstep_0_(1, (doublereal *)0, step); - } - diff --git a/ext/spice/src/cspice/gfstep_c.c b/ext/spice/src/cspice/gfstep_c.c deleted file mode 100644 index 5c1f0a2191..0000000000 --- a/ext/spice/src/cspice/gfstep_c.c +++ /dev/null @@ -1,186 +0,0 @@ -/* - --Procedure gfstep_c ( Geometry finder step size ) - --Abstract - - Return the time step set by the most recent call to gfsstp_c. - --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 - - GF - TIME - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void gfstep_c ( SpiceDouble time, - SpiceDouble * step ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - time I Ignored ET value. - step O Time step to take. - --Detailed_Input - - time is an ignored double precision number. This argument - is present so the argument list of this routine is - compatible with the GF step size routine argument list - specification. - - When this routine is called from within the GF - root-finding system, either the initial ET value of the - current interval of the confinement window, or the - value resulting from the last search step, is passed in - via the `time' argument. - - - --Detailed_Output - - step is the output step size. This is the value set by the - most recent call to gfsstp_c. Units are TDB seconds. - - `step' is used in the GF search root-bracketing process. - `step' indicates how far to advance `time' so that `time' and - time+step may bracket a state transition and definitely - do not bracket more than one state transition. - --Parameters - - None. - --Exceptions - - 1) If this routine is called before a step size has been - set via a call to gfsstp_c, the error SPICE(NOTINITIALIZED) - is signaled. - --Files - - None. - --Particulars - - This routine returns the time step set by the most recent call to - gfsstp_c. - --Examples - - - 1) User applications can pass gfstep_c to mid-level GF API routines - expecting a step size routine as an input argument. For - example, the GF API routine gfocce_c can be called as shown - in the code fragment below. - - /. - Select a twenty-second step. We'll ignore any occultations - lasting less than 20 seconds. - ./ - step = 20.0; - gfsstp_c ( step ); - - /. - Perform the search. - ./ - gfocce_c ( "ANY", - "MOON", "ellipsoid", "IAU_MOON", - "SUN", "ellipsoid", "IAU_SUN", - "LT", "EARTH", CNVTOL, - gfstep_c, gfrefn_c, rpt, - gfrepi_c, gfrepu_c, gfrepf_c, - bail, gfbail_c, cnfine, - &result ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 15-APR-2009 (LSE) (NJB) - --Index_Entries - - GF get constant step size - - --& -*/ - -{ /* Begin gfstep_c */ - - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return; - } - - chkin_c ( "gfstep_c" ); - - /* - Let the f2c'd routine do the work. - */ - - gfstep_ ( ( doublereal * ) &time, - ( doublereal * ) step ); - - chkout_c ( "gfstep_c" ); - -} /* End gfstep_c */ diff --git a/ext/spice/src/cspice/gfsubc.c b/ext/spice/src/cspice/gfsubc.c deleted file mode 100644 index 72a46c7192..0000000000 --- a/ext/spice/src/cspice/gfsubc.c +++ /dev/null @@ -1,1588 +0,0 @@ -/* gfsubc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__10 = 10; -static doublereal c_b29 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFSUBC (GF, subpoint vector coordinate search ) */ -/* Subroutine */ int gfsubc_(char *target, char *fixref, char *method, char * - abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, - doublereal *refval, doublereal *adjust, doublereal *step, doublereal * - cnfine, integer *mw, integer *nw, doublereal *work, doublereal * - result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, - ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen - coord_len, ftnlen relate_len) -{ - /* Initialized data */ - - static doublereal dvec[3] = { 0.,0.,0. }; - static char dref[80] = " " - " "; - - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical even_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int gfrefn_(), gfrepi_(), gfrepu_(), gfrepf_(), - gfstep_(); - char qcpars[80*10], qpnams[80*10]; - doublereal qdpars[10]; - integer qipars[10]; - logical qlpars[10]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *, - integer *, char *, char *, doublereal *, integer *, logical *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *, - logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine time intervals for which a coordinate of an */ -/* subpoint position vector satisfies a numerical constraint. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* CK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* COORDINATE */ -/* GEOMETRY */ -/* SEARCH */ -/* EVENT */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound */ -/* CNVTOL P Convergence tolerance */ -/* TARGET I Name of the target body */ -/* FIXREF I Body fixed frame associated with TARGET */ -/* METHOD I Name of method type for subpoint calculation */ -/* ABCORR I Aberration correction flag */ -/* OBSRVR I Name of the observing body */ -/* CRDSYS I Name of the coordinate system containing COORD */ -/* COORD I Name of the coordinate of interest */ -/* RELATE I Relational operator */ -/* REFVAL I Reference value */ -/* ADJUST I Adjustment value for absolute extrema searches */ -/* STEP I Step size used for locating extrema and roots */ -/* CNFINE I SPICE window to which the search is confined */ -/* MW I Workspace window size */ -/* NW I The number of workspace windows needed for */ -/* the search */ -/* WORK I-O Array of workspace windows */ -/* RESULT I-O SPICE window containing results */ - -/* $ Detailed_Input */ - -/* TARGET the string name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector */ -/* that points from the observer to the target. */ - -/* FIXREF the string name of the body-fixed, body-centered */ -/* reference frame associated with the target body TARGET. */ - -/* The SPICE frame subsystem must recognize the 'fixref' */ -/* name. */ - -/* METHOD the string name of the method to use for the subpoint */ -/* calculation. The accepted values for METHOD: */ - -/* 'Near point: ellipsoid' The sub-observer point */ -/* computation uses a */ -/* triaxial ellipsoid to */ -/* model the surface of the */ -/* target body. The */ -/* sub-observer point is */ -/* defined as the nearest */ -/* point on the target */ -/* relative to the */ -/* observer. */ - -/* 'Intercept: ellipsoid' The sub-observer point */ -/* computation uses a */ -/* triaxial ellipsoid to */ -/* model the surface of the */ -/* target body. The */ -/* sub-observer point is */ -/* defined as the target */ -/* surface intercept of the */ -/* line containing the */ -/* observer and the */ -/* target's center. */ - -/* The METHOD string lacks sensitivity to case, embedded, */ -/* leading and trailing blanks. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* OBSRVR the string name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to indicate the observer as Earth. */ - -/* CRDSYS the string name of the coordinate system for which the */ -/* coordinate of interest is a member */ - -/* COORD the string name of the coordinate of interest in CRDSYS */ - -/* The supported coordinate systems and coordinate names: */ - -/* Coordinate System (CRDSYS) Coordinates (COORD) Range */ - -/* 'RECTANGULAR' 'X' */ -/* 'Y' */ -/* 'Z' */ - -/* 'LATITUDINAL' 'RADIUS' */ -/* 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ - -/* 'RA/DEC' 'RANGE' */ -/* 'RIGHT ASCENSION' [0,2Pi) */ -/* 'DECLINATION' [-Pi/2,Pi/2] */ - -/* 'SPHERICAL' 'RADIUS' */ -/* 'COLATITUDE' [0,Pi] */ -/* 'LONGITUDE' (-Pi,Pi] */ - -/* 'CYLINDRICAL' 'RADIUS' */ -/* 'LONGITUDE' [0,2Pi) */ -/* 'Z' */ - -/* 'GEODETIC' 'LONGITUDE' (-Pi,Pi] */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) */ -/* 'LATITUDE' [-Pi/2,Pi/2] */ -/* 'ALTITUDE' */ - -/* The ALTITUDE coordinates have a constant value */ -/* of zero +/- roundoff for ellipsoid targets. */ - -/* Limit searches for coordinate events in the GEODETIC */ -/* and PLANETOGRAPHIC coordinate systems to TARGET bodies */ -/* with axial symmetry in the equatorial plane, i.e. */ -/* equality of the body X and Y radii (oblate or prolate */ -/* spheroids). */ - -/* RELATE the string or character describing the relational */ -/* operator used to define a constraint on the selected */ -/* coordinate of the subpoint vector. The result */ -/* window found by this routine indicates the time intervals */ -/* where the constraint is satisfied. Supported values of */ -/* RELATE and corresponding meanings are shown below: */ - -/* '>' The coordinate value is greater than the */ -/* reference value REFVAL. */ - -/* '=' The coordinate value is equal to the */ -/* reference value REFVAL. */ - -/* '<' The coordinate value is less than the */ -/* reference value REFVAL. */ - -/* 'ABSMAX' The coordinate value is at an absolute */ -/* maximum. */ - -/* 'ABSMIN' The coordinate value is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' The coordinate value is at a local */ -/* maximum. */ - -/* 'LOCMIN' The coordinate value is at a local */ -/* minimum. */ -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified measure of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this measure. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* The RELATE string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* REFVAL the double precision reference value used together with */ -/* the argument RELATE to define an equality or inequality */ -/* to satisfy by the selected coordinate of the subpoint */ -/* vector. See the discussion of RELATE above for */ -/* further information. */ - -/* The units of REFVAL correspond to the type as defined */ -/* by COORD, radians for angular measures, kilometers for */ -/* distance measures. */ - -/* ADJUST a double precision value used to modify searches for */ -/* absolute extrema: when RELATE is set to ABSMAX or ABSMIN */ -/* and ADJUST is set to a positive value, GFSUBC finds */ -/* times when the subpoint position vector coordinate is */ -/* within ADJUST radians/kilometers of the specified */ -/* extreme value. */ - -/* For RELATE set to ABSMAX, the RESULT window contains */ -/* time intervals when the position vector coordinate has */ -/* values between ABSMAX - ADJUST and ABSMAX. */ - -/* For RELATE set to ABSMIN, the RESULT window contains */ -/* time intervals when the position vector coordinate has */ -/* values between ABSMIN and ABSMIN + ADJUST. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions. */ - -/* STEP the double precision time step size to use in the search. */ - -/* STEP must be short enough to for a search using this step */ -/* size to locate the time intervals where coordinate */ -/* function of the subpoint vector is monotone increasing or */ -/* decreasing. However, STEP must not be *too* short, or */ -/* the search will take an unreasonable amount of time. */ - -/* For coordinates other than LONGITUDE and RIGHT ASCENSION, */ -/* the step size must be shorter than the shortest interval, */ -/* within the confinement window, over which the coordinate */ -/* is monotone increasing or decreasing. */ - -/* For LONGITUDE and RIGHT ASCENSION, the step size must */ -/* be shorter than the shortest interval, within the */ -/* confinement window, over which either the sin or cos */ -/* of the coordinate is monotone increasing or decreasing. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - -/* CNFINE a double precision SPICE window that confines the time */ -/* period over which the specified search is conducted. */ -/* CNFINE may consist of a single interval or a collection */ -/* of intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller using the */ -/* SPICELIB routine SSIZED. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. NW should be set to the */ -/* parameter NWMAX; this parameter is declared in the */ -/* include file gf.inc. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* INCLUDE 'gf.inc' */ -/* ... */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* where MW is a constant declared by the caller and */ -/* NWMAX is a constant defined in the SPICELIB INCLUDE */ -/* file gf.inc. See the discussion of MW above. */ - -/* WORK need not be initialized by the caller. */ - -/* RESULT a double precision SPICE window which will contain the */ -/* search results. RESULT must be initialized using */ -/* a call to SSIZED. RESULT must be declared and initialized */ -/* with sufficient size to capture the full set of time */ -/* intervals within the search region on which the */ -/* specified constraint is satisfied. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFSUBC conducts its */ -/* search. */ - -/* $ Detailed_Output */ - -/* WORK the input workspace array, modified by this */ -/* routine. The caller should re-initialize this array */ -/* before attempting to use it for any other purpose. */ - -/* RESULT the SPICE window of intervals, contained within the */ -/* confinement window CNFINE, on which the specified */ -/* constraint is satisfied. */ - -/* If the search is for local extrema, or for absolute */ -/* extrema with ADJUST set to zero, then normally each */ -/* interval of RESULT will be a singleton: the left and */ -/* right endpoints of each interval will be identical. */ - -/* If no times within the confinement window satisfy the */ -/* constraint, RESULT will be returned with a */ -/* cardinality of zero. */ - -/* $ Parameters */ - -/* LBCELL the integer value defining the lower bound for */ -/* SPICE Cell arrays (a SPICE window is a kind of cell). */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the specified coordinate is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, an error is signaled */ -/* by a routine in the call tree of this routine. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - truncation error in time values */ -/* - finite tolerance value */ -/* - errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* RESULT window. One technique to handle such a situation, */ -/* slightly contract RESULT using the window routine WNCOND. */ - -/* 3) If the window size MW is less than 2 or not an even value, */ -/* the error SPICE(INVALIDDIMENSION) will signal. */ - -/* 4) If the window size of RESULT is less than 2, the error */ -/* SPICE(INVALIDDIMENSION) will signal. */ - -/* 5) If an error (typically cell overflow) occurs during */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 6) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 7) If the size of the workspace is too small, an error is */ -/* signaled by a routine in the call tree of this routine. */ - -/* 8) If ADJUST is negative, an error is signaled by a routine in */ -/* the call tree of this routine. */ - -/* 9) If either of the input body names do not map to NAIF ID */ -/* codes, an error is signaled by a routine in the call tree of */ -/* this routine. */ - -/* 10) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* 11) If a body has unequal equatorial radii, a search for */ -/* coordinate events in the GEODETIC or PLANETOGRAPHIC */ -/* coordinate systems will cause the SPICE(NOTSUPPORTED) error */ -/* to signal. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the calling */ -/* program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer that cover the */ -/* time period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files using */ -/* FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Such kernel data are normally loaded once per program run, NOT */ -/* every time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides a simpler, but less flexible interface */ -/* than does the routine GFEVNT for conducting searches for */ -/* subpoint position vector coordinate value events. */ -/* Applications that require support for progress reporting, */ -/* interrupt handling, non-default step or refinement functions, or */ -/* non-default convergence tolerance should call GFEVNT rather than */ -/* this routine. */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when the selected coordinate of */ -/* the subpoint position vector satisfies a caller-specified */ -/* constraint. The resulting set of intervals is returned as a SPICE */ -/* window. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient */ -/* use of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* coordinate function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the coordinate */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of coordinate will be sampled. Starting at */ -/* the left endpoint of an interval, samples will be taken at each */ -/* step. If a change of sign is found, a root has been bracketed; at */ -/* that point, the time at which the time derivative of the */ -/* coordinate is zero can be found by a refinement process, for */ -/* example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the coordinate function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* As described above, the root-finding process used by this routine */ -/* involves first bracketing roots and then using a search process */ -/* to locate them. "Roots" are both times when local extrema are */ -/* attained and times when the coordinate function is equal to a */ -/* reference value. All endpoints of the intervals comprising the */ -/* result window are either endpoints of intervals of the */ -/* confinement window or roots. */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set by the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFEVNT must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - -/* Practical use of the coordinate search capability would likely */ -/* consist of searches over multiple coordinate constraints to find */ -/* time intervals that satisfies the constraints. An */ -/* effective technique to accomplish such a search is */ -/* to use the result window from one search as the confinement window */ -/* of the next. */ - -/* Longitude and Right Ascension */ -/* ============================= */ - -/* The cyclic nature of the longitude and right ascension coordinates */ -/* produces branch cuts at +/- 180 degrees longitude and 0-360 */ -/* longitude. Round-off error may cause solutions near these branches */ -/* to cross the branch. Use of the SPICE routine WNCOND will contract */ -/* solution windows by some epsilon, reducing the measure of the */ -/* windows and eliminating the branch crossing. A one millisecond */ -/* contraction will in most cases eliminate numerical round-off */ -/* caused branch crossings. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* The examples shown below require a "standard" set of SPICE */ -/* kernels. We list these kernels in a meta kernel named */ -/* 'standard.tm'. */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de414.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( '/kernels/gen/lsk/naif0008.tls' */ -/* '/kernels/gen/spk/de414.bsp' */ -/* '/kernels/gen/pck/pck00008.tpc' */ -/* ) */ - -/* Example(1): */ - -/* Find the time during 2007 for which the subpoint position vector */ -/* of the sun on earth in the IAU_EARTH frame lies within a geodetic */ -/* latitude-longitude "box" defined as */ - -/* 16 degrees <= latitude <= 17 degrees */ -/* 85 degrees <= longitude <= 86 degrees */ - -/* This problem requires four searches, each search on one of the */ -/* box restrictions. The user needs also realize the temporal */ -/* behavior of latitude greatly differs from that of the longitude. */ -/* The sub-observer point latitude varies between approximately */ -/* 23.44 degrees and -23.44 degrees during the year. The */ -/* sub-observer point longitude varies between -180 degrees and */ -/* 180 degrees in one day. */ - -/* PROGRAM GFSUBC_EX1 */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION RPD */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local variables and initial parameters. */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Create 50 windows. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 1000 ) */ - -/* C */ -/* C One window consists of two intervals. */ -/* C */ -/* INTEGER NINTRVL */ -/* PARAMETER ( NINTRVL = MAXWIN *2 ) */ - -/* INTEGER STRLEN */ -/* PARAMETER ( STRLEN = 40 ) */ - -/* CHARACTER*(STRLEN) TIMFMT */ -/* CHARACTER*(STRLEN) BEGSTR */ -/* CHARACTER*(STRLEN) ENDSTR */ -/* CHARACTER*(STRLEN) TARGET */ -/* CHARACTER*(STRLEN) OBSRVR */ -/* CHARACTER*(STRLEN) ABCORR */ -/* CHARACTER*(STRLEN) METHOD */ -/* CHARACTER*(STRLEN) FIXREF */ -/* CHARACTER*(STRLEN) CRDSYS */ -/* CHARACTER*(STRLEN) COORD */ -/* CHARACTER*(STRLEN) RELATE */ - -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION CNFINE ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT1 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT2 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT3 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION RESULT4 ( LBCELL : NINTRVL ) */ -/* DOUBLE PRECISION WORK ( LBCELL : NINTRVL, NWMAX ) */ -/* DOUBLE PRECISION BEGTIM */ -/* DOUBLE PRECISION ENDTIM */ -/* DOUBLE PRECISION LEFT */ -/* DOUBLE PRECISION RIGHT */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION ADJUST */ -/* DOUBLE PRECISION RAD ( 2 ) */ -/* DOUBLE PRECISION LON ( 2 ) */ -/* DOUBLE PRECISION LAT ( 2 ) */ -/* DOUBLE PRECISION TRGEPC */ -/* DOUBLE PRECISION LPOS ( 3 ) */ -/* DOUBLE PRECISION RPOS ( 3 ) */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ - -/* INTEGER COUNT */ -/* INTEGER I */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ('/kernels/standard.tm') */ - -/* TIMFMT = 'YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND' */ - -/* C */ -/* C Initialize windows RESULT and CNFINE. */ -/* C */ -/* CALL SSIZED ( NINTRVL, RESULT1 ) */ -/* CALL SSIZED ( NINTRVL, RESULT2 ) */ -/* CALL SSIZED ( NINTRVL, RESULT3 ) */ -/* CALL SSIZED ( NINTRVL, RESULT4 ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the CNFINE confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 01', BEGTIM ) */ -/* CALL STR2ET ( '2008 JAN 01', ENDTIM ) */ - -/* CALL WNINSD ( BEGTIM, ENDTIM, CNFINE ) */ - -/* C */ -/* C The latitude varies relatively slowly (46 degrees) during */ -/* C the year. The extrema occur approximately every six months. */ -/* C Search using a step size less than half that value */ -/* C (180 days). For this example use ninety days (in units */ -/* C of seconds). */ -/* C */ -/* STEP = SPD()*90.D0 */ - -/* C */ -/* C Perform four searches to determine the times when the */ -/* C latitude- longitude box restriction conditions apply to the */ -/* C subpoint vector. */ -/* C */ -/* C Use geodetic coordinates. */ -/* C */ -/* ADJUST = 0.D0 */ -/* TARGET = 'EARTH' */ -/* OBSRVR = 'SUN' */ -/* METHOD = 'Near point: ellipsoid' */ -/* FIXREF = 'IAU_EARTH' */ -/* CRDSYS = 'GEODETIC' */ -/* ABCORR = 'NONE' */ - -/* C */ -/* C Perform the searches such that the result window of a search */ -/* C serves as the confinement window of the subsequent search. */ -/* C */ - -/* C */ -/* C Since the latitude coordinate varies slowly and is well */ -/* C behaved over the time of the confinement window, search */ -/* C first for the windows satisfying the latitude requirements, */ -/* C then use that result as confinement for the */ -/* C longitude search. */ -/* C */ -/* COORD = 'LATITUDE' */ -/* REFVAL = 16.D0 * RPD() */ -/* RELATE = '>' */ - -/* CALL GFSUBC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, STEP, CNFINE, */ -/* . NINTRVL, NWMAX, WORK, RESULT1 ) */ - -/* REFVAL = 17.D0 * RPD() */ -/* RELATE = '<' */ - -/* CALL GFSUBC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, STEP, RESULT1, */ -/* . NINTRVL, NWMAX, WORK, RESULT2 ) */ - -/* C */ -/* C Now the longitude search. */ -/* C */ -/* COORD = 'LONGITUDE' */ - -/* C */ -/* C Reset the step size to something appropriate for the 360 */ -/* C degrees in 24 hours domain. The longitude shows near */ -/* C linear behavior so use a step size less than half the period */ -/* C of twelve hours. Ten hours will suffice in this case. */ -/* C */ -/* STEP = SPD() * (10.D0/24.D0) */ - -/* REFVAL = 85.D0 * RPD() */ -/* RELATE = '>' */ - - -/* CALL GFSUBC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, STEP, RESULT2, */ -/* . NINTRVL, NWMAX, WORK, RESULT3 ) */ - -/* C */ -/* C Contract the endpoints of each window to account */ -/* C for possible round-off error at the -180/180 degree branch. */ -/* C */ -/* C A contraction value of a millisecond should eliminate */ -/* C any round-off caused branch crossing. */ -/* C */ -/* CALL WNCOND ( 1D-3, 1D-3, RESULT3 ) */ - -/* REFVAL = 86.D0 * RPD() */ -/* RELATE = '<' */ - -/* CALL GFSUBC ( TARGET, FIXREF, */ -/* . METHOD, ABCORR, OBSRVR, */ -/* . CRDSYS, COORD, */ -/* . RELATE, REFVAL, */ -/* . ADJUST, STEP, RESULT3, */ -/* . NINTRVL, NWMAX, WORK, RESULT4 ) */ - -/* C */ -/* C Check the number of intervals in the result window. */ -/* C */ -/* COUNT = WNCARD(RESULT4) */ - -/* C */ -/* C List the beginning and ending points in each interval */ -/* C if RESULT contains data. */ -/* C */ -/* IF ( COUNT .EQ. 0 ) THEN */ -/* WRITE(*, '(A)') 'Result window is empty.' */ -/* ELSE */ - -/* DO I = 1, COUNT */ - -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT4, I, LEFT, RIGHT ) */ - -/* CALL TIMOUT ( LEFT, TIMFMT, BEGSTR ) */ -/* CALL TIMOUT ( RIGHT, TIMFMT, ENDSTR ) */ - -/* C */ -/* C Determine the latitude and longitude of the subpoint */ -/* C at the event interval boundaries. */ -/* C */ -/* CALL SUBPNT ( METHOD, TARGET, LEFT, FIXREF, ABCORR, */ -/* . OBSRVR, LPOS, TRGEPC, SRFVEC ) */ -/* CALL RECLAT ( LPOS, RAD(1), LON(1), LAT(1) ) */ - -/* CALL SUBPNT ( METHOD, TARGET, RIGHT, FIXREF, ABCORR, */ -/* . OBSRVR, RPOS, TRGEPC, SRFVEC ) */ -/* CALL RECLAT ( RPOS, RAD(2), LON(2), LAT(2) ) */ - - -/* WRITE(*,*) 'From : ',BEGSTR,LAT(1)*DPR(),LON(1)*DPR() */ -/* WRITE(*,*) 'To : ',ENDSTR,LAT(2)*DPR(),LON(2)*DPR() */ -/* WRITE(*,*) ' ' */ - -/* END DO */ - -/* END IF */ - -/* END */ - -/* The program outputs: */ - -/* Time intervals Lat Lon */ - -/* From : 2007-MAY-05 06:14:04.637734 (TDB) 16.0543561 86. */ -/* To : 2007-MAY-05 06:18:04.621907 (TDB) 16.0551478 85.0000042 */ - -/* From : 2007-MAY-06 06:13:59.583483 (TDB) 16.3371472 86. */ -/* To : 2007-MAY-06 06:17:59.569239 (TDB) 16.3379265 85.0000042 */ - -/* From : 2007-MAY-07 06:13:55.102939 (TDB) 16.6154436 86. */ -/* To : 2007-MAY-07 06:17:55.090299 (TDB) 16.6162103 85.0000042 */ - -/* From : 2007-MAY-08 06:13:51.202604 (TDB) 16.8891626 86. */ -/* To : 2007-MAY-08 06:17:51.191583 (TDB) 16.8899165 85.0000042 */ - -/* From : 2007-AUG-06 06:23:17.282927 (TDB) 16.6807174 86. */ -/* To : 2007-AUG-06 06:27:17.264009 (TDB) 16.6799616 85.0000042 */ - -/* From : 2007-AUG-07 06:23:10.545441 (TDB) 16.4064108 86. */ -/* To : 2007-AUG-07 06:27:10.524925 (TDB) 16.4056426 85.0000042 */ - -/* From : 2007-AUG-08 06:23:03.233995 (TDB) 16.1276778 86. */ -/* To : 2007-AUG-08 06:27:03.211889 (TDB) 16.1268975 85.0000042 */ - -/* $ Restrictions */ - -/* 1) The kernel files to be used by this routine must be loaded */ -/* (normally using the SPICELIB routine FURNSH) before this */ -/* routine is called. */ - -/* 2) This routine has the side effect of re-initializing the */ -/* coordinate quantity utility package. Callers may */ -/* need to re-initialize the package after calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 22-AUG-2009 (EDW) */ - -/* Edited argument descriptions. */ - -/* Edit to Example description, replaced "intercept" with */ -/* "sub-observer point." */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF subpoint coordinate search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Routines to set step size, refine transition times */ -/* and report work. */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Quantity definition parameter arrays: */ - - -/* Define no-use values for DVEC and DREF */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Check into the error subsystem. */ - - chkin_("GFSUBC", (ftnlen)6); - -/* Confirm minimum window sizes. */ - - if (*mw < 2 || ! even_(mw)) { - setmsg_("Workspace window size was #; size must be at least 2 and an" - " even value.", (ftnlen)71); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSUBC", (ftnlen)6); - return 0; - } - if (sized_(result) < 2) { - setmsg_("Result window size was #; size must be at least 2.", (ftnlen) - 50); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFSUBC", (ftnlen)6); - return 0; - } - -/* Set up a call to GFEVNT specific to the subpoint coordinate */ -/* search. */ - - s_copy(qpnams, "TARGET", (ftnlen)80, (ftnlen)6); - s_copy(qcpars, target, (ftnlen)80, target_len); - s_copy(qpnams + 80, "OBSERVER", (ftnlen)80, (ftnlen)8); - s_copy(qcpars + 80, obsrvr, (ftnlen)80, obsrvr_len); - s_copy(qpnams + 160, "ABCORR", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 160, abcorr, (ftnlen)80, abcorr_len); - s_copy(qpnams + 240, "COORDINATE SYSTEM", (ftnlen)80, (ftnlen)17); - s_copy(qcpars + 240, crdsys, (ftnlen)80, crdsys_len); - s_copy(qpnams + 320, "COORDINATE", (ftnlen)80, (ftnlen)10); - s_copy(qcpars + 320, coord, (ftnlen)80, coord_len); - s_copy(qpnams + 400, "REFERENCE FRAME", (ftnlen)80, (ftnlen)15); - s_copy(qcpars + 400, fixref, (ftnlen)80, fixref_len); - s_copy(qpnams + 480, "VECTOR DEFINITION", (ftnlen)80, (ftnlen)17); - s_copy(qcpars + 480, "SUB-OBSERVER POINT", (ftnlen)80, (ftnlen)18); - s_copy(qpnams + 560, "METHOD", (ftnlen)80, (ftnlen)6); - s_copy(qcpars + 560, method, (ftnlen)80, method_len); - s_copy(qpnams + 640, "DREF", (ftnlen)80, (ftnlen)4); - s_copy(qcpars + 640, dref, (ftnlen)80, (ftnlen)80); - s_copy(qpnams + 720, "DVEC", (ftnlen)80, (ftnlen)4); - qdpars[0] = dvec[0]; - qdpars[1] = dvec[1]; - qdpars[2] = dvec[2]; - -/* Set the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFSUBC", (ftnlen)6); - return 0; - } - gfsstp_(step); - -/* Initialize the RESULT window to empty. */ - - scardd_(&c__0, result); - -/* Look for solutions. */ - -/* Progress report and interrupt options are set to .FALSE. */ - - gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "COORDINATE", &c__10, qpnams, - qcpars, qdpars, qipars, qlpars, relate, refval, &c_b29, adjust, - cnfine, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw, - nw, work, &c_false, (L_fp)gfbail_, result, (ftnlen)10, (ftnlen) - 80, (ftnlen)80, relate_len); - chkout_("GFSUBC", (ftnlen)6); - return 0; -} /* gfsubc_ */ - diff --git a/ext/spice/src/cspice/gfsubc_c.c b/ext/spice/src/cspice/gfsubc_c.c deleted file mode 100644 index 24cf6f219b..0000000000 --- a/ext/spice/src/cspice/gfsubc_c.c +++ /dev/null @@ -1,1086 +0,0 @@ -/* - --Procedure gfsubc_c (GF, subpoint vector coordinate search) - --Abstract - - Determine time intervals for which a coordinate of an - subpoint position vector satisfies a numerical constraint. - --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 - PUBLICL Y 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 - - GF - SPK - CK - TIME - WINDOWS - --Keywords - - COORDINATE - GEOMETRY - SEARCH - EVENT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceGF.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "zzalloc.h" - - void gfsubc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - SPICE_GF_CNVTOL - P Convergence tolerance. - target I Name of the target body - fixref I Body fixed frame associated with 'target' - method I Name of method type for subpoint calculation - abcorr I Aberration correction flag - obsrvr I Name of the observing body - crdsys I Name of the coordinate system containing 'coord' - coord I Name of the coordinate of interest - relate I Operator that either looks for an extreme value - (max, min, local, absolute) or compares the - coordinate value and refval - refval I Reference value - adjust I Adjustment value for absolute extrema searches - step I Step size used for locating extrema and roots - nintvls I Workspace window interval count - cnfine I-O SPICE window to which the search is restricted - result O SPICE window containing results - --Detailed_Input - - target the string name of a target body. Optionally, you may - supply the integer ID code for the object as an - integer string. For example both 'MOON' and '301' - are legitimate strings that indicate the moon is the - target body. - - The target and observer define a position vector - that points from the observer to the target. - - fixref the string name of the body-fixed, body-centered - reference frame associated with the target body target. - - The SPICE frame subsystem must recognize the 'fixref' name. - - method the string name of the method to use for the subpoint - calculation. The accepted values for method: - - 'Near point: ellipsoid' The sub-observer point - computation uses a - triaxial ellipsoid to - model the surface of the - target body. The - sub-observer point is - defined as the nearest - point on the target - relative to the - observer. - - 'Intercept: ellipsoid' The sub-observer point - computation uses a - triaxial ellipsoid to - model the surface of the - target body. The - sub-observer point is - defined as the target - surface intercept of the - line containing the - observer and the - target's center. - - The method string lacks sensitivity to case, embedded, leading - and trailing blanks. - - abcorr the string description of the aberration corrections to apply - to the state evaluations to account for one-way light time - and stellar aberration. - - This routine accepts the same aberration corrections as does - the SPICE routine SPKEZR. See the header of SPKEZR for a - detailed description of the aberration correction options. - For convenience, the options are listed below: - - 'NONE' Apply no correction. - - 'LT' "Reception" case: correct for - one-way light time using a Newtonian - formulation. - - 'LT+S' "Reception" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'CN' "Reception" case: converged - Newtonian light time correction. - - 'CN+S' "Reception" case: converged - Newtonian light time and stellar - aberration corrections. - - 'XLT' "Transmission" case: correct for - one-way light time using a Newtonian - formulation. - - 'XLT+S' "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation. - - 'XCN' "Transmission" case: converged - Newtonian light time correction. - - 'XCN+S' "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - The abcorr string lacks sensitivity to case, and to embedded, - leading and trailing blanks. - - obsrvr the string naming the observing body. Optionally, you - may supply the ID code of the object as an integer - string. For example, both 'EARTH' and '399' are - legitimate strings to supply to indicate the - observer is Earth. - - crdsys the string name of the coordinate system for which the - coordinate of interest is a member. - - coord the string name of the coordinate of interest in crdsys. - - The supported coordinate systems and coordinate names are: - - The supported coordinate systems and coordinate names are: - - Coordinate System (CRDSYS) Coordinates (COORD) Range - - 'RECTANGULAR' 'X' - 'Y' - 'Z' - - 'LATITUDINAL' 'RADIUS' - 'LONGITUDE' (-Pi,Pi] - 'LATITUDE' [-Pi/2,Pi/2] - - 'RA/DEC' 'RANGE' - 'RIGHT ASCENSION' [0,2Pi) - 'DECLINATION' [-Pi/2,Pi/2] - - 'SPHERICAL' 'RADIUS' - 'COLATITUDE' [0,Pi] - 'LONGITUDE' (-Pi,Pi] - - 'CYLINDRICAL' 'RADIUS' - 'LONGITUDE' [0,2Pi) - 'Z' - - 'GEODETIC' 'LONGITUDE' (-Pi,Pi] - 'LATITUDE' [-Pi/2,Pi/2] - 'ALTITUDE' - - 'PLANETOGRAPHIC' 'LONGITUDE' [0,2Pi) - 'LATITUDE' [-Pi/2,Pi/2] - 'ALTITUDE' - - The ALTITUDE coordinates have a constant value - of zero +/- roundoff for ellipsoid targets. - - Limit searches for coordinate events in the GEODETIC and - PLANETOGRAPHIC coordinate systems to TARGET bodies with - axial symmetry in the equatorial plane, i.e. equality - of the body X and Y radii (oblate or prolate spheroids). - - relate the string or character describing the relational operator - used to define a constraint on the selected coordinate of the - subpoint vector. The result window found by this routine - indicates the time intervals where the constraint is satisfied. - Supported values of relate and corresponding meanings are - shown below: - - '>' Separation is greater than the reference - value refval. - - '=' Separation is equal to the reference - value refval. - - '<' Separation is less than the reference - value refval. - - 'ABSMAX' Separation is at an absolute maximum. - - 'ABSMIN' Separation is at an absolute minimum. - - 'LOCMAX' Separation is at a local maximum. - - 'LOCMIN' Separation is at a local minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified measure of an absolute extremum. - The argument ADJUST (described below) is used to - specify this measure. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - The relate string lacks sensitivity to case, leading - and trailing blanks. - - refval the double precision reference value used together with - relate argument to define an equality or inequality to - satisfy by the selected coordinate of the subpoint - vector. See the discussion of relate above for - further information. - - The units of refval correspond to the type as defined - by coord, radians for angular measures, kilometers for - distance measures. - - adjust a double precision value used to modify searches for - absolute extrema: when 'relate' is set to ABSMAX or ABSMIN and - 'adjust' is set to a positive value, gfsubc_c finds times - when the position vector coordinate is within adjust - radians/kilometers of the specified extreme value. - - For 'relate' set to ABSMAX, the result window contains - time intervals when the position vector coordinate has - values between ABSMAX - adjust and ABSMAX. - - For 'relate' set to ABSMIN, the result window contains - time intervals when the position vector coordinate has - values between ABSMIN and ABSMIN + adjust. - - 'adjust' is not used for searches for local extrema, - equality or inequality conditions. - - step the double precision time step size to use in the search. - step must be short enough for a search using this step - size to locate the time intervals where coordinate function - of the subpoint vector is monotone increasing or - decreasing. However, step must not be *too* short, or - the search will take an unreasonable amount of time. - - The choice of step affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - - step has units of TDB seconds. - - nintvls an integer value specifying the number of intervals in the - the internal workspace array used by this routine. 'nintvls' - should be at least as large as the number of intervals - within the search region on which the specified observer-target - vector coordinate function is monotone increasing or decreasing. - It does no harm to pick a value of 'nintvls' larger than the - minimum required to execute the specified search, but if chosen - too small, the search will fail. - - cnfine a double precision SPICE window that confines the time - period over which the specified search is conducted. - cnfine may consist of a single interval or a collection - of intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - result the SPICE window of intervals, contained within the - confinement window cnfine, on which the specified - constraint is satisfied. - - If result is non-empty on input, its contents - will be discarded before gfsubc_c conducts its - search. - - result must be declared and initialized with sufficient - size to capture the full set of time intervals - within the search region on which the specified constraint - is satisfied. - - If the search is for local extrema, or for absolute - extrema with adjust set to zero, then normally each - interval of result will be a singleton: the left and - right endpoints of each interval will be identical. - - If no times within the confinement window satisfy the - constraint, result will be returned with a - cardinality of zero. - --Parameters - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints - of the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL; the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found by - this routine depends on the accuracy of the input data. - In most cases, the accuracy of solutions will be inferior - to their precision. - - SPICE_GF_CNVTOL has the value 1.0e-6. Units are TDB - seconds. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If the aberration correction specifier contains an - unrecognized value, an error is signaled by a routine in the - call tree of this routine. - - 6) If `adjust' is negative, an error is signaled by a routine in - the call tree of this routine. - - 7) If either of the input body names do not map to NAIF ID - codes, an error is signaled by a routine in the call tree of - this routine. - - 8) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 9) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 11) If the workspace interval count 'nintvls' is less than 1, the - error SPICE(VALUEOUTOFRANGE) will be signaled. - - 12) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - --Files - - Appropriate SPK and PCK kernels must be loaded by the - calling program before this routine is called. - - The following data are required: - - - SPK data: the calling application must load ephemeris data - for the targets, observer, and any intermediate objects in - a chain connecting the targets and observer that cover the time - period specified by the window CNFINE. If aberration - corrections are used, the states of target and observer - relative to the solar system barycenter must be calculable - from the available ephemeris data. Typically ephemeris data - are made available by loading one or more SPK files using - FURNSH. - - - PCK data: bodies modeled as triaxial ellipsoids must have - semi-axis lengths provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file using FURNSH. - - - If non-inertial reference frames are used, then PCK - files, frame kernels, C-kernels, and SCLK kernels may be - needed. - - Such kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - - This routine provides a simpler, but less flexible interface - than does the routine gfevnt_c for conducting searches for - subpoint position vector coordinate value events. - Applications that require support for progress reporting, interrupt - handling, non-default step or refinement functions, or non-default - convergence tolerance should call gfevnt_c rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window when the selected coordinate of - the subpoint position vector satisfies a caller-specified - constraint. The resulting set of intervals is returned as a SPICE - window. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - coordinate function is monotone increasing and monotone - decreasing. Each of these time periods is represented by a SPICE - window. Having found these windows, all of the coordinate - function's local extrema within the confinement window are known. - Absolute extrema then can be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - - Step Size - ========= - - The monotone windows (described above) are found using a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of coordinate will be sampled. Starting at - the left endpoint of an interval, samples will be taken at each - step. If a change of sign is found, a root has been bracketed; at - that point, the time at which the time derivative of the coordinate - is zero can be found by a refinement process, for example, - using a binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the coordinate function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - Convergence Tolerance - ===================== - - As described above, the root-finding process used by this routine - involves first bracketing roots and then using a search process - to locate them. "Roots" are both times when local extrema are - attained and times when the distance function is equal to a - reference value. All endpoints of the intervals comprising the - result window are either endpoints of intervals of the - confinement window or roots. - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set by the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value in the f2c'd - routine so that the tolerance doesn't become the limiting factor - in the accuracy of solutions found by this routine. In general the - accuracy of input data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such - as gfevnt_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are unlikely - to be more accurate. Making the tolerance looser will speed up - searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - - Practical use of the coordinate search capability would likely - consist of searches over multiple coordinate constraints to find - time intervals that satisfies the constraints. An effective - technique to accomplish such a search is to use the result - window from one search as the confinement window of the next. - - Longitude and Right Ascension - ============================= - - The cyclic nature of the longitude and right ascension coordinates - produces branch cuts at +/- 180 degrees longitude and 0-360 - longitude. Round-off error may cause solutions near these branches - to cross the branch. Use of the SPICE routine wncond_c will contract - solution windows by some epsilon, reducing the measure of the - windows and eliminating the branch crossing. A one millisecond - contraction will in most cases eliminate numerical round-off caused - branch crossings. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - The example shown below requires a "standard" set of SPICE - kernels. We list these kernels in a meta kernel named 'standard.tm'. - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de414.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - - - \begindata - - KERNELS_TO_LOAD = ( '/kernels/gen/lsk/naif0008.tls' - '/kernels/gen/spk/de414.bsp' - '/kernels/gen/pck/pck00008.tpc' - ) - - - Example: - - Find the time during 2007 for which the subpoint position vector - of the sun on earth in the IAU_EARTH frame lies within a geodetic - latitude-longitude "box" defined as - - 16 degrees <= latitude <= 17 degrees - 85 degrees <= longitude <= 86 degrees - - This problem requires four searches, each search on one of the - box restrictions. The user needs also realize the temporal - behavior of latitude greatly differs from that of the longitude. The - sub-observer point latitude varies between approximately 23.44 degrees - and -23.44 degrees during the year. The sub-observer point longitude - varies between -180 degrees and 180 degrees in one day. - - #include - #include - #include - - #include "SpiceUsr.h" - - #define MAXWIN 100 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###### (TDB) ::TDB ::RND" - #define STRLEN 64 - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one window - consists of two values, so the total number - of cell values to allocate equals twice - the number of intervals. - ./ - SPICEDOUBLE_CELL ( result1, 2*MAXWIN ); - SPICEDOUBLE_CELL ( result2, 2*MAXWIN ); - SPICEDOUBLE_CELL ( result3, 2*MAXWIN ); - SPICEDOUBLE_CELL ( result4, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ STRLEN ]; - SpiceChar endstr [ STRLEN ]; - SpiceChar * target = "EARTH"; - SpiceChar * obsrvr = "SUN"; - SpiceChar * fixref = "IAU_EARTH"; - SpiceChar * method = "Near point: ellipsoid"; - SpiceChar * crdsys = "GEODETIC"; - SpiceChar * abcorr = "NONE"; - - SpiceInt count; - SpiceInt i; - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - - /. - Store the time bounds of our search interval in - the cnfine confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2008 JAN 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - Perform four searches to determine the times when the - latitude-longitude box restriction conditions apply to - the subpoint vector. - - Perform the searches such that the result window of a search - serves as the confinement window of the subsequent search. - - Since the latitude coordinate varies slowly and is well behaved - over the time of the confinement window, search first for the - windows satisfying the latitude requirements, then use that result - as confinement for the longitude search. - ./ - - /. - The latitude varies relatively slowly, ~46 degrees during the - year. The extrema occur approximately every six months. - Search using a step size less than half that value (180 days). - For this example use ninety days (in units of seconds). - ./ - - step = (90.)*spd_c(); - adjust = 0.; - - { - SpiceChar * coord = "LATITUDE"; - SpiceChar * relate = ">"; - - refval = 16. *rpd_c(); - - gfsubc_c ( target, fixref, - method, abcorr, obsrvr, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &cnfine, &result1 ); - } - - - { - SpiceChar * coord = "LATITUDE"; - SpiceChar * relate = "<"; - - refval = 17. *rpd_c(); - - gfsubc_c ( target, fixref, - method, abcorr, obsrvr, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &result1, &result2 ); - } - - - /. - Now the longitude search. - ./ - - /. - Reset the stepsize to something appropriate for the 360 - degrees in 24 hours domain. The longitude shows near - linear behavior so use a stepsize less than half the period - of twelve hours. Ten hours will suffice in this case. - ./ - step = (10./24.)*spd_c(); - - { - SpiceChar * coord = "LONGITUDE"; - SpiceChar * relate = ">"; - - refval = 85. *rpd_c(); - - gfsubc_c ( target, fixref, - method, abcorr, obsrvr, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &result2, &result3 ); - - /. - Contract the endpoints of each window to account - for possible round-off error at the -180/180 degree branch. - - A contraction value of a millisecond should eliminate - any round-off caused branch crossing. - ./ - - wncond_c( 1e-3, 1e-3, &result3 ); - } - - - { - SpiceChar * coord = "LONGITUDE"; - SpiceChar * relate = "<"; - - refval = 86. *rpd_c(); - - gfsubc_c ( target, fixref, - method, abcorr, obsrvr, - crdsys, coord, - relate, refval, - adjust, step, - MAXWIN, - &result3, &result4 ); - } - - - /. - List the beginning and ending points in each interval - if result contains data. - ./ - count = wncard_c( &result4 ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result4, i, &beg, &end ); - - timout_c ( beg, TIMFMT, STRLEN, begstr ); - timout_c ( end, TIMFMT, STRLEN, endstr ); - - printf ( "Interval %d\n", i + 1); - printf ( "Beginning TDB %s \n", begstr ); - printf ( "Ending TDB %s \n\n", endstr ); - - } - } - - kclear_c(); - return( 0 ); - } - - The program outputs: - - Interval 1 - Beginning TDB 2007-MAY-05 06:14:04.637735 (TDB) - Ending TDB 2007-MAY-05 06:18:04.621908 (TDB) - - Interval 2 - Beginning TDB 2007-MAY-06 06:13:59.583483 (TDB) - Ending TDB 2007-MAY-06 06:17:59.569239 (TDB) - - Interval 3 - Beginning TDB 2007-MAY-07 06:13:55.102939 (TDB) - Ending TDB 2007-MAY-07 06:17:55.090299 (TDB) - - Interval 4 - Beginning TDB 2007-MAY-08 06:13:51.202604 (TDB) - Ending TDB 2007-MAY-08 06:17:51.191583 (TDB) - - Interval 5 - Beginning TDB 2007-AUG-06 06:23:17.282927 (TDB) - Ending TDB 2007-AUG-06 06:27:17.264009 (TDB) - - Interval 6 - Beginning TDB 2007-AUG-07 06:23:10.545441 (TDB) - Ending TDB 2007-AUG-07 06:27:10.524926 (TDB) - - Interval 7 - Beginning TDB 2007-AUG-08 06:23:03.233996 (TDB) - Ending TDB 2007-AUG-08 06:27:03.211889 (TDB) - --Restrictions - - 1) The kernel files to be used by this routine must be loaded - (normally via the CSPICE routine furnsh_c) before this routine - is called. - - 2) This routine has the side effect of re-initializing the - coordinate quantity utility package. Callers may - need to re-initialize the package after calling this routine. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.1, 26-AUG-2009, EDW (JPL) - - Edit to Example description, replaced "intercept" with - "sub-observer point." - - Correction of several typos. - - -CSPICE Version 1.0.0, 10-FEB-2009 (NJB) (EDW) - --Index_Entries - - GF subpoint coordinate search - --& -*/ - - { /* Begin gfsubc_c */ - - /* - Local variables - */ - doublereal * work; - - SpiceInt nBytes; - - static SpiceInt nw = SPICE_GF_NWMAX; - - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfsubc_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfsubc_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfsubc_c", target ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", fixref ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", method ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", crdsys ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", coord ); - CHKFSTR ( CHK_STANDARD, "gfsubc_c", relate ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value of one (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfposc_c" ); - return; - } - - /* - Allocate the workspace. 'nintvls' indicates the maximum number of - intervals returned in 'result'. An interval consists of - two values. - */ - - nintvls = 2 * nintvls; - - nBytes = ( nintvls + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) alloc_SpiceMemory( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "gfsubc_c" ); - return; - } - - - /* - Let the f2'd routine do the work. - */ - - gfsubc_ ( ( char * ) target, - ( char * ) fixref, - ( char * ) method, - ( char * ) abcorr, - ( char * ) obsrvr, - ( char * ) crdsys, - ( char * ) coord, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(fixref), - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr), - ( ftnlen ) strlen(crdsys), - ( ftnlen ) strlen(coord), - ( ftnlen ) strlen(relate) ); - - /* - De-allocate the workspace. - */ - free_SpiceMemory( work ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ) ; - } - - ALLOC_CHECK; - - chkout_c ( "gfsubc_c" ); - - } /* End gfsubc_c */ diff --git a/ext/spice/src/cspice/gftfov.c b/ext/spice/src/cspice/gftfov.c deleted file mode 100644 index 4c96e47e8b..0000000000 --- a/ext/spice/src/cspice/gftfov.c +++ /dev/null @@ -1,1098 +0,0 @@ -/* gftfov.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b15 = 1e-6; -static logical c_false = FALSE_; - -/* $Procedure GFTFOV ( GF, is target in FOV? ) */ -/* Subroutine */ int gftfov_(char *inst, char *target, char *tshape, char * - tframe, char *abcorr, char *obsrvr, doublereal *step, doublereal * - cnfine, doublereal *result, ftnlen inst_len, ftnlen target_len, - ftnlen tshape_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen - obsrvr_len) -{ - /* Initialized data */ - - static doublereal raydir[3] = { 0.,0.,0. }; - - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern logical eqstr_(char *, char *, ftnlen, ftnlen), gfbail_(); - extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_(); - extern /* Subroutine */ int gffove_(char *, char *, doublereal *, char *, - char *, char *, char *, doublereal *, U_fp, U_fp, logical *, U_fp, - U_fp, U_fp, logical *, L_fp, doublereal *, doublereal *, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int gfrepu_(), gfstep_(); - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), gfsstp_( - doublereal *); - -/* $ Abstract */ - -/* Determine time intervals when a specified ephemeris object */ -/* intersects the space bounded by the field-of-view (FOV) of a */ -/* specified instrument. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* GF */ -/* KERNEL */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* FOV */ -/* GEOMETRY */ -/* INSTRUMENT */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARGIN P Minimum complement of FOV cone angle. */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance. */ -/* MAXVRT P Maximum number of FOV boundary vertices. */ -/* INST I Name of the instrument. */ -/* TARGET I Name of the target body. */ -/* TSHAPE I Type of shape model used for target body. */ -/* TFRAME I Body-fixed, body-centered frame for target body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ -/* STEP I Step size in seconds for finding FOV events. */ -/* CNFINE I SPICE window to which the search is restricted. */ -/* RESULT O SPICE window containing results. */ - - -/* $ Detailed_Input */ - -/* INST indicates the name of an instrument, such as a */ -/* spacecraft-mounted framing camera, the field of view */ -/* (FOV) of which is to be used for a target intersection */ -/* search: times when the specified target intersects the */ -/* region of space corresponding to the FOV are sought. */ - -/* The position of the instrument designated by INST is */ -/* considered to coincide with that of the ephemeris */ -/* object designated by the input argument OBSRVR (see */ -/* description below). */ - -/* INST must have a corresponding NAIF ID and a frame */ -/* defined, as is normally done in a frame kernel. It */ -/* must also have an associated reference frame and a FOV */ -/* shape, boresight and boundary vertices (or reference */ -/* vector and reference angles) defined, as is usually */ -/* done in an instrument kernel. */ - -/* See the header of the SPICELIB routine GETFOV for a */ -/* description of the required parameters associated with */ -/* an instrument. */ - - -/* TARGET is the name of the target body, the appearances of */ -/* which in the specified instrument's field of view are */ -/* sought. The body must be an ephemeris object. */ - -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. For example both 'MOON' and */ -/* '301' are legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TARGET. */ - - -/* TSHAPE is a string indicating the geometric model used to */ -/* represent the shape of the target body. The supported */ -/* options are: */ - -/* 'ELLIPSOID' Use a triaxial ellipsoid model, */ -/* with radius values provided via the */ -/* kernel pool. A kernel variable */ -/* having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF */ -/* integer code associated with the */ -/* body, must be present in the kernel */ -/* pool. This variable must be */ -/* associated with three numeric */ -/* values giving the lengths of the */ -/* ellipsoid's X, Y, and Z semi-axes. */ - -/* 'POINT' Treat the body as a single point. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TSHAPE. */ - - -/* TFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the target body. Examples of */ -/* such names are 'IAU_SATURN' (for Saturn) and 'ITRF93' */ -/* (for the Earth). */ - -/* If the target body is modeled as a point, TFRAME */ -/* is ignored and should be left blank. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* TFRAME. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the target's position and orientation. */ - -/* For remote sensing applications, where the apparent */ -/* position and orientation of the target seen by the */ -/* observer are desired, normally either of the */ -/* corrections */ - -/* 'LT+S' */ -/* 'CN+S' */ - -/* should be used. These and the other supported options */ -/* are described below. */ - -/* Supported aberration correction options for */ -/* observation (the case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (the case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the GF Required Reading, */ -/* gf.req. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the body from which the target is */ -/* observed. The instrument designated by INST is treated */ -/* as if it were co-located with the observer. */ - -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* STEP is the step size to be used in the search. STEP must */ -/* be shorter than any interval, within the confinement */ -/* window, over which the specified condition is met. In */ -/* other words, STEP must be shorter than the shortest */ -/* visibility event that the user wishes to detect. STEP */ -/* also must be shorter than the minimum duration */ -/* separating any two visibility events. However, STEP */ -/* must not be *too* short, or the search will take an */ -/* unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of seconds. */ - - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* The endpoints of the time intervals comprising CNFINE */ -/* are interpreted as seconds past J2000 TDB. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window representing the set of time */ -/* intervals, within the confinement period, when the */ -/* target body is visible; that is, when the target body */ -/* intersects the space bounded by the specified */ -/* instrument's field of view. */ - -/* The endpoints of the time intervals comprising RESULT */ -/* are interpreted as seconds past J2000 TDB. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFTFOV conducts its */ -/* search. */ - -/* $ Parameters */ - -/* LBCELL is the lower bound for SPICE cell arrays. */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL, the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* MAXVRT is the maximum number of vertices that may be used */ -/* to define the boundary of the specified instrument's */ -/* field of view. */ - -/* MARGIN is a small positive number used to constrain the */ -/* orientation of the boundary vectors of polygonal */ -/* FOVs. Such FOVs must satisfy the following constraints: */ - -/* 1) The boundary vectors must be contained within */ -/* a right circular cone of angular radius less */ -/* than than (pi/2) - MARGIN radians; in other */ -/* words, there must be a vector A such that all */ -/* boundary vectors have angular separation from */ -/* A of less than (pi/2)-MARGIN radians. */ - -/* 2) There must be a pair of boundary vectors U, V */ -/* such that all other boundary vectors lie in */ -/* the same half space bounded by the plane */ -/* containing U and V. Furthermore, all other */ -/* boundary vectors must have orthogonal */ -/* projections onto a specific plane normal to */ -/* this plane (the normal plane contains the angle */ -/* bisector defined by U and V) such that the */ -/* projections have angular separation of at least */ -/* 2*MARGIN radians from the plane spanned by U */ -/* and V. */ - -/* MARGIN is currently set to 1.D-12. */ - - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEPSIZE) will be signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results. The SPICE window routine */ -/* WNCOND can be used to contract the result window. */ - -/* 3) If the name of either the target or observer cannot be */ -/* translated to a NAIF ID code, the error will be diagnosed by */ -/* a routine in the call tree of this routine. */ - -/* 4) If the specified aberration correction is an unrecognized */ -/* value, the error will be diagnosed and signaled by a routine */ -/* in the call tree of this routine. */ - -/* 5) If the radii of a target body modeled as an ellipsoid cannot */ -/* be determined by searching the kernel pool for a kernel */ -/* variable having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF integer code associated with */ -/* the body, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* 6) If the target body coincides with the observer body OBSRVR, */ -/* the error will be diagnosed by a routine in the call tree of */ -/* this routine. */ - -/* 7) If the body model specifier TSHAPE is invalid, the error will */ -/* be diagnosed either here or by a routine in the call tree of */ -/* this routine. */ - -/* 8) If a target body-fixed reference frame associated with a */ -/* non-point target is not recognized, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 9) If a target body-fixed reference frame is not centered at */ -/* the corresponding target body, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* 10) If the instrument name INST does not have corresponding NAIF */ -/* ID code, the error will be diagnosed by a routine in the call */ -/* tree of this routine. */ - -/* 11) If the FOV parameters of the instrument are not present in */ -/* the kernel pool, the error will be be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* 12) If the FOV boundary has more than MAXVRT vertices, the error */ -/* will be be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* 13) If the instrument FOV is polygonal, and this routine cannot */ -/* find a ray R emanating from the FOV vertex such that maximum */ -/* angular separation of R and any FOV boundary vector is within */ -/* the limit (pi/2)-MARGIN radians, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the FOV */ -/* is any other shape, the same error check will be applied with */ -/* the instrument boresight vector serving the role of R. */ - -/* 14) If the loaded kernels provide insufficient data to compute a */ -/* requested state vector, the error will be diagnosed by a */ -/* routine in the call tree of this routine. */ - -/* 15) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 16) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* visibility condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* $ Files */ - -/* Appropriate SPICE kernels must be loaded by the calling program */ -/* before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer that */ -/* describes the ephemeris of these objects for the period */ -/* defined by the confinement window, 'CNFINE' must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the body-fixed frame of */ -/* the target, that definition must be available in the kernel */ -/* pool. Typically the definitions of frames not already */ -/* built-in to SPICE are supplied by loading a frame kernel. */ - -/* Data defining the reference frame associated with the */ -/* instrument designated by INST must be available in the */ -/* kernel pool. Additionally the name INST must be associated */ -/* with an ID code. Normally these data are made available by */ -/* loading a frame kernel via FURNSH. */ - -/* - IK data: the kernel pool must contain data such that */ -/* the SPICELIB routine GETFOV may be called to obtain */ -/* parameters for INST. Normally such data are provided by */ -/* an IK via FURNSH. */ - -/* The following data may be required: */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* orientation data provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file via FURNSH. */ - -/* Bodies modeled as triaxial ellipsoids must have semi-axis */ -/* lengths provided by variables in the kernel pool. Typically */ -/* these data are made available by loading a text PCK file via */ -/* FURNSH. */ - -/* - CK data: if the instrument frame is fixed to a spacecraft, */ -/* at least one CK file will be needed to permit transformation */ -/* of vectors between that frame and both J2000 and the target */ -/* body-fixed frame. */ - -/* - SCLK data: if a CK file is needed, an associated SCLK */ -/* kernel is required to enable conversion between encoded SCLK */ -/* (used to time-tag CK data) and barycentric dynamical time */ -/* (TDB). */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when any portion of a specified */ -/* target body appears within the field of view of a specified */ -/* instrument. We'll use the term "visibility event" to designate */ -/* such an appearance. The set of time intervals resulting from the */ -/* search is returned as a SPICE window. */ - -/* This routine provides a simpler, but less flexible, interface */ -/* than does the SPICELIB routine GFFOVE for conducting searches for */ -/* visibility events. Applications that require support for progress */ -/* reporting, interrupt handling, non-default step or refinement */ -/* functions, or non-default convergence tolerance should call */ -/* GFFOVE rather than this routine. */ - -/* To treat the target as a ray rather than as an ephemeris object, */ -/* use either the higher-level SPICELIB routine GFRFOV or GFFOVE. */ -/* Those routines may be used to search for times when distant */ -/* target objects such as stars are visible in an instrument FOV, as */ -/* long the direction from the observer to the target can be modeled */ -/* as a ray. */ - -/* Below we discuss in greater detail aspects of this routine's */ -/* solution process that are relevant to correct and efficient use */ -/* of this routine in user applications. */ - - -/* The Search Process */ -/* ================== */ - -/* The search for visibility events is treated as a search for state */ -/* transitions: times are sought when the state of the target body */ -/* changes from "not visible" to "visible" or vice versa. */ - -/* Step Size */ -/* ========= */ - -/* Each interval of the confinement window is searched as follows: */ -/* first, the input step size is used to determine the time */ -/* separation at which the visibility state will be sampled. */ -/* Starting at the left endpoint of an interval, samples will be */ -/* taken at each step. If a state change is detected, a root has */ -/* been bracketed; at that point, the "root"--the time at which the */ -/* state change occurs---is found by a refinement process, for */ -/* example, via binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the visibility state is constant: */ -/* the step size should be shorter than the shortest visibility event */ -/* duration and the shortest period between visibility events, within */ -/* the confinement window. */ - -/* Having some knowledge of the relative geometry of the target and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." The convergence tolerance used by this */ -/* routine is set via the parameter CNVTOL. */ - -/* The value of CNVTOL is set to a "tight" value so that the */ -/* tolerance doesn't become the limiting factor in the accuracy of */ -/* solutions found by this routine. In general the accuracy of input */ -/* data will be the limiting factor. */ - -/* To use a different tolerance value, a lower-level GF routine such */ -/* as GFFOVE must be called. Making the tolerance tighter than */ -/* CNVTOL is unlikely to be useful, since the results are unlikely */ -/* to be more accurate. Making the tolerance looser will speed up */ -/* searches somewhat, since a few convergence steps will be omitted. */ -/* However, in most cases, the step size is likely to have a much */ -/* greater effect on processing time than would the convergence */ -/* tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. For an example, see */ -/* the program CASCADE in the GF Example Programs chapter of the GF */ -/* Required Reading, gf.req. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) Search for times when Saturn's satellite Phoebe is within */ -/* the FOV of the Cassini narrow angle camera (CASSINI_ISS_NAC). */ -/* To simplify the problem, restrict the search to a short time */ -/* period where continuous Cassini bus attitude data are */ -/* available. */ - -/* Use a step size of 10 seconds to reduce chances of missing */ -/* short visibility events. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File name: gftfov_ex1.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* naif0009.tls Leapseconds */ -/* cpck05Mar2004.tpc Satellite orientation and */ -/* radii */ -/* 981005_PLTEPH-DE405S.bsp Planetary ephemeris */ -/* 020514_SE_SAT105.bsp Satellite ephemeris */ -/* 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris */ -/* cas_v37.tf Cassini FK */ -/* 04135_04171pc_psiv2.bc Cassini bus CK */ -/* cas00084.tsc Cassini SCLK kernel */ -/* cas_iss_v09.ti Cassini IK */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'naif0009.tls', */ -/* 'cpck05Mar2004.tpc', */ -/* '981005_PLTEPH-DE405S.bsp', */ -/* '020514_SE_SAT105.bsp', */ -/* '030201AP_SK_SM546_T45.bsp', */ -/* 'cas_v37.tf', */ -/* '04135_04171pc_psiv2.bc', */ -/* 'cas00084.tsc', */ -/* 'cas_iss_v09.ti' ) */ -/* \begintext */ - - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'gftfov_ex1.tm' ) */ - -/* CHARACTER*(*) TIMFMT */ -/* PARAMETER ( TIMFMT = */ -/* . 'YYYY-MON-DD HR:MN:SC.######::TDB (TDB)' ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 10000 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 10 ) */ - -/* INTEGER BDNMLN */ -/* PARAMETER ( BDNMLN = 36 ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER SHPLEN */ -/* PARAMETER ( SHPLEN = 25 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 35 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR */ -/* CHARACTER*(BDNMLN) INST */ -/* CHARACTER*(LNSIZE) LINE */ -/* CHARACTER*(BDNMLN) OBSRVR */ -/* CHARACTER*(BDNMLN) TARGET */ -/* CHARACTER*(FRNMLN) TFRAME */ -/* CHARACTER*(TIMLEN) TIMSTR ( 2 ) */ -/* CHARACTER*(SHPLEN) TSHAPE */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION ENDPT ( 2 ) */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION STEPSZ */ - -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER N */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, CNFINE ) */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ - -/* C */ -/* C Insert search time interval bounds into the */ -/* C confinement window. */ -/* C */ -/* CALL STR2ET ( '2004 JUN 11 06:30:00 TDB', ET0 ) */ -/* CALL STR2ET ( '2004 JUN 11 12:00:00 TDB', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Initialize inputs for the search. */ -/* C */ -/* INST = 'CASSINI_ISS_NAC' */ -/* TARGET = 'PHOEBE' */ -/* TSHAPE = 'ELLIPSOID' */ -/* TFRAME = 'IAU_PHOEBE' */ -/* ABCORR = 'LT+S' */ -/* OBSRVR = 'CASSINI' */ -/* STEPSZ = 10.D0 */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Instrument: '//INST */ -/* WRITE (*,*) 'Target: '//TARGET */ -/* WRITE (*,*) ' ' */ -/* C */ -/* C Perform the search. */ -/* C */ -/* CALL GFTFOV ( INST, TARGET, TSHAPE, TFRAME, */ -/* . ABCORR, OBSRVR, STEPSZ, CNFINE, RESULT ) */ - -/* N = WNCARD( RESULT ) */ - -/* IF ( N .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'No FOV intersection found.' */ - -/* ELSE */ - -/* WRITE (*,*) ' Visibility start time Stop time' */ - -/* DO I = 1, N */ - -/* CALL WNFETD ( RESULT, I, ENDPT(1), ENDPT(2) ) */ - -/* DO J = 1, 2 */ -/* CALL TIMOUT ( ENDPT(J), TIMFMT, TIMSTR(J) ) */ -/* END DO */ - -/* LINE( :3) = ' ' */ -/* LINE(2: ) = TIMSTR(1) */ -/* LINE(37:) = TIMSTR(2) */ - -/* WRITE (*,*) LINE */ - -/* END DO */ - -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Instrument: CASSINI_ISS_NAC */ -/* Target: PHOEBE */ - -/* Visibility start time Stop time */ -/* 2004-JUN-11 07:35:49.958590 (TDB) 2004-JUN-11 08:48:27.485965 (TDB) */ -/* 2004-JUN-11 09:03:19.767799 (TDB) 2004-JUN-11 09:35:27.634790 (TDB) */ -/* 2004-JUN-11 09:50:19.585474 (TDB) 2004-JUN-11 10:22:27.854253 (TDB) */ -/* 2004-JUN-11 10:37:19.332696 (TDB) 2004-JUN-11 11:09:28.116016 (TDB) */ -/* 2004-JUN-11 11:24:19.049485 (TDB) 2004-JUN-11 11:56:28.380304 (TDB) */ - - - -/* $ Restrictions */ - -/* 1) The reference frame associated with INST must be */ -/* centered at the observer or must be inertial. No check is done */ -/* to ensure this. */ - -/* 2) The kernel files to be used by GFTFOV must be loaded (normally */ -/* via the SPICELIB routine FURNSH) before GFTFOV is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 15-APR-2009 (NJB) (LSE) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF target in instrument FOV search */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* External routines */ - - -/* Interrupt handler: */ - - -/* Routines to set step size, refine transition times */ -/* and report work: */ - - -/* Local parameters */ - - -/* Geometric quantity bail switch: */ - - -/* Progress report switch: */ - - -/* Local variables */ - - -/* Ray direction vector required by GFFOVE. This is */ -/* an unused variable as far is this routine is concerned: */ -/* the target is an ephemeris object. We initialize the */ -/* ray to prevent portability problems. */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GFTFOV", (ftnlen)6); - -/* Reject the target shape 'RAY'. */ - - if (eqstr_(tshape, "RAY", tshape_len, (ftnlen)3)) { - setmsg_("The target shape RAY is not supported by this routine. Use " - "the routine GFRFOV instead.", (ftnlen)86); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("GFTFOV", (ftnlen)6); - return 0; - } - -/* Note to maintenance programmer: input exception checks */ -/* are delegated to GFFOVE. If the implementation of that */ -/* routine changes, or if this routine is modified to call */ -/* a different routine in place of GFFOVE, then the error */ -/* handling performed by GFFOVE will have to be performed */ -/* here or in a routine called by this routine. */ - -/* Check the result window's size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size must be at least 2 but was #.", (ftnlen) - 48); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21); - chkout_("GFTFOV", (ftnlen)6); - return 0; - } - -/* Check step size. */ - - if (*step <= 0.) { - setmsg_("Step size must be positive but was #.", (ftnlen)37); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFTFOV", (ftnlen)6); - return 0; - } - -/* Set the step size. */ - - gfsstp_(step); - -/* Look for solutions. */ - - gffove_(inst, tshape, raydir, target, tframe, abcorr, obsrvr, &c_b15, ( - U_fp)gfstep_, (U_fp)gfrefn_, &c_false, (U_fp)gfrepi_, (U_fp) - gfrepu_, (U_fp)gfrepf_, &c_false, (L_fp)gfbail_, cnfine, result, - inst_len, tshape_len, target_len, tframe_len, abcorr_len, - obsrvr_len); - chkout_("GFTFOV", (ftnlen)6); - return 0; -} /* gftfov_ */ - diff --git a/ext/spice/src/cspice/gftfov_c.c b/ext/spice/src/cspice/gftfov_c.c deleted file mode 100644 index 376105947a..0000000000 --- a/ext/spice/src/cspice/gftfov_c.c +++ /dev/null @@ -1,904 +0,0 @@ -/* - --Procedure gftfov_c ( GF, is target in FOV? ) - --Abstract - - Determine time intervals when a specified ephemeris object - intersects the space bounded by the field-of-view (FOV) of a - specified instrument. - --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 - - CK - FRAMES - GF - KERNEL - NAIF_IDS - PCK - SPK - TIME - WINDOWS - --Keywords - - EVENT - FOV - GEOMETRY - INSTRUMENT - SEARCH - WINDOW - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void gftfov_c ( ConstSpiceChar * inst, - ConstSpiceChar * target, - ConstSpiceChar * tshape, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - --------------- --- ------------------------------------------------ - SPICE_GF_MARGIN P Minimum complement of FOV cone angle. - SPICE_GF_CNVTOL P Convergence tolerance. - SPICE_GF_MAXVRT P Maximum number of FOV boundary vertices. - inst I Name of the instrument. - target I Name of the target body. - tshape I Type of shape model used for target body. - tframe I Body-fixed, body-centered frame for target body. - abcorr I Aberration correction flag. - obsrvr I Name of the observing body. - step I Step size in seconds for finding FOV events. - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - - --Detailed_Input - - inst indicates the name of an instrument, such as a - spacecraft-mounted framing camera, the field of view - (FOV) of which is to be used for a target intersection - search: times when the specified target intersects the - region of space corresponding to the FOV are sought. - - The position of the instrument designated by `inst' is - considered to coincide with that of the ephemeris - object designated by the input argument `obsrvr' (see - description below). - - `inst' must have a corresponding NAIF ID and a frame - defined, as is normally done in a frame kernel. It - must also have an associated reference frame and a FOV - shape, boresight and boundary vertices (or reference - vector and reference angles) defined, as is usually - done in an instrument kernel. - - See the header of the CSPICE routine getfov_c for a - description of the required parameters associated with - an instrument. - - - target is the name of the target body, the appearances of - which in the specified instrument's field of view are - sought. The body must be an ephemeris object. - - Optionally, you may supply the integer NAIF ID code - for the body as a string. For example both "MOON" and - "301" are legitimate strings that designate the Moon. - - Case and leading or trailing blanks are not - significant in the string `target'. - - - tshape is a string indicating the geometric model used to - represent the shape of the target body. The supported - options are: - - "ELLIPSOID" Use a triaxial ellipsoid model, - with radius values provided via the - kernel pool. A kernel variable - having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF - integer code associated with the - body, must be present in the kernel - pool. This variable must be - associated with three numeric - values giving the lengths of the - ellipsoid's X, Y, and Z semi-axes. - - "POINT" Treat the body as a single point. - - Case and leading or trailing blanks are not - significant in the string `tshape'. - - - tframe is the name of the body-fixed, body-centered reference - frame associated with the target body. Examples of - such names are "IAU_SATURN" (for Saturn) and "ITRF93" - (for the Earth). - - If the target body is modeled as a point, `tframe' - is ignored and should be left blank. - - Case and leading or trailing blanks bracketing a - non-blank frame name are not significant in the string - `tframe'. - - - abcorr indicates the aberration corrections to be applied - when computing the target's position and orientation. - - For remote sensing applications, where the apparent - position and orientation of the target seen by the - observer are desired, normally either of the - corrections - - "LT+S" - "CN+S" - - should be used. These and the other supported options - are described below. - - Supported aberration correction options for - observation (the case where radiation is received by - observer at ET) are: - - "NONE" No correction. - "LT" Light time only - "LT+S" Light time and stellar aberration. - "CN" Converged Newtonian (CN) light time. - "CN+S" CN light time and stellar aberration. - - Supported aberration correction options for - transmission (the case where radiation is emitted from - observer at ET) are: - - "XLT" Light time only. - "XLT+S" Light time and stellar aberration. - "XCN" Converged Newtonian (CN) light time. - "XCN+S" CN light time and stellar aberration. - - For detailed information, see the GF Required Reading, - gf.req. - - Case, leading and trailing blanks are not significant - in the string `abcorr'. - - - obsrvr is the name of the body from which the target is - observed. The instrument designated by `inst' is treated - as if it were co-located with the observer. - - Optionally, you may supply the integer NAIF ID code - for the body as a string. - - Case and leading or trailing blanks are not - significant in the string `obsrvr'. - - - step is the step size to be used in the search. `step' must - be shorter than any interval, within the confinement - window, over which the specified condition is met. In - other words, `step' must be shorter than the shortest - visibility event that the user wishes to detect. `step' - also must be shorter than the minimum duration - separating any two visibility events. However, `step' - must not be *too* short, or the search will take an - unreasonable amount of time. - - The choice of `step' affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - `step' has units of seconds. - - - cnfine is a SPICE window that confines the time period over - which the specified search is conducted. `cnfine' may - consist of a single interval or a collection of - intervals. - - The endpoints of the time intervals comprising `cnfine' - are interpreted as seconds past J2000 TDB. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - target body is visible; that is, when the target body - intersects the space bounded by the specified - instrument's field of view. - - The endpoints of the time intervals comprising `result' - are interpreted as seconds past J2000 TDB. - - If `result' is non-empty on input, its contents - will be discarded before gftfov_c conducts its - search. - --Parameters - - - All parameters described here are declared in the header file - SpiceGF.h. See that file for parameter values. - - SPICE_GF_CNVTOL - - is the convergence tolerance used for finding endpoints of - the intervals comprising the result window. - SPICE_GF_CNVTOL is used to determine when binary searches - for roots should terminate: when a root is bracketed - within an interval of length SPICE_GF_CNVTOL, the root is - considered to have been found. - - The accuracy, as opposed to precision, of roots found - by this routine depends on the accuracy of the input - data. In most cases, the accuracy of solutions will be - inferior to their precision. - - - SPICE_GF_MAXVRT - - is the maximum number of vertices that may be used - to define the boundary of the specified instrument's - field of view. - - - SPICE_GF_MARGIN - - is a small positive number used to constrain the - orientation of the boundary vectors of polygonal - FOVs. Such FOVs must satisfy the following constraints: - - 1) The boundary vectors must be contained within - a right circular cone of angular radius less - than than (pi/2) - SPICE_GF_MARGIN radians; in other - words, there must be a vector A such that all - boundary vectors have angular separation from - A of less than (pi/2)-SPICE_GF_MARGIN radians. - - 2) There must be a pair of boundary vectors U, V - such that all other boundary vectors lie in the - same half space bounded by the plane containing U - and V. Furthermore, all other boundary vectors - must have orthogonal projections onto a specific - plane normal to this plane (the normal plane - contains the angle bisector defined by U and V) - such that the projections have angular separation - of at least 2*SPICE_GF_MARGIN radians from the - plane spanned by U and V. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, the error - SPICE(INVALIDSTEPSIZE) will be signaled. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - WNCOND can be used to contract the result window. - - 3) If the name of either the target or observer cannot be - translated to a NAIF ID code, the error will be diagnosed by - a routine in the call tree of this routine. - - 4) If the specified aberration correction is an unrecognized - value, the error will be diagnosed and signaled by a routine - in the call tree of this routine. - - 5) If the radii of a target body modeled as an ellipsoid cannot - be determined by searching the kernel pool for a kernel - variable having a name of the form - - "BODYnnn_RADII" - - where nnn represents the NAIF integer code associated with - the body, the error will be diagnosed by a routine in the - call tree of this routine. - - 6) If the target body coincides with the observer body `obsrvr', - the error will be diagnosed by a routine in the call tree of - this routine. - - 7) If the body model specifier `tshape' is invalid, the error will - be diagnosed either here or by a routine in the call tree of - this routine. - - 8) If a target body-fixed reference frame associated with a - non-point target is not recognized, the error will be - diagnosed by a routine in the call tree of this routine. - - 9) If a target body-fixed reference frame is not centered at - the corresponding target body, the error will be - diagnosed by a routine in the call tree of this routine. - - 10) If the instrument name `inst' does not have corresponding NAIF - ID code, the error will be diagnosed by a routine in the call - tree of this routine. - - 11) If the FOV parameters of the instrument are not present in - the kernel pool, the error will be be diagnosed by routines - in the call tree of this routine. - - 12) If the FOV boundary has more than SPICE_GF_MAXVRT vertices, the - error will be be diagnosed by routines in the call tree of this - routine. - - 13) If the instrument FOV is polygonal, and this routine cannot - find a ray R emanating from the FOV vertex such that maximum - angular separation of R and any FOV boundary vector is within - the limit (pi/2)-SPICE_GF_MARGIN radians, the error will be diagnosed - by a routine in the call tree of this routine. If the FOV - is any other shape, the same error check will be applied with - the instrument boresight vector serving the role of R. - - 14) If the loaded kernels provide insufficient data to compute a - requested state vector, the error will be diagnosed by a - routine in the call tree of this routine. - - 15) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - - 16) If the output SPICE window `result' has insufficient capacity - to contain the number of intervals on which the specified - visibility condition is met, the error will be diagnosed - by a routine in the call tree of this routine. If the result - window has size less than 2, the error SPICE(WINDOWTOOSMALL) - will be signaled by this routine. - - 17) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 18) If any input string argument other than `tframe' is empty, the - error SPICE(EMPTYSTRING) will be signaled. - --Files - - Appropriate SPICE kernels must be loaded by the calling program - before this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target and observer that - describes the ephemeris of these objects for the period - defined by the confinement window CNFINE must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - Frame data: if a frame definition is required to convert - the observer and target states to the body-fixed frame of - the target, that definition must be available in the kernel - pool. Typically the definitions of frames not already - built-in to SPICE are supplied by loading a frame kernel. - - Data defining the reference frame associated with the - instrument designated by `inst' must be available in the - kernel pool. Additionally the name `inst' must be associated - with an ID code. Normally these data are made available by - loading a frame kernel via furnsh_c. - - - IK data: the kernel pool must contain data such that - the CSPICE routine getfov_c may be called to obtain - parameters for `inst'. Normally such data are provided by - an IK via furnsh_c. - - The following data may be required: - - - PCK data: bodies modeled as triaxial ellipsoids must have - orientation data provided by variables in the kernel pool. - Typically these data are made available by loading a text - PCK file via furnsh_c. - - Bodies modeled as triaxial ellipsoids must have semi-axis - lengths provided by variables in the kernel pool. Typically - these data are made available by loading a text PCK file via - furnsh_c. - - - CK data: if the instrument frame is fixed to a spacecraft, - at least one CK file will be needed to permit transformation - of vectors between that frame and both J2000 and the target - body-fixed frame. - - - SCLK data: if a CK file is needed, an associated SCLK - kernel is required to enable conversion between encoded SCLK - (used to time-tag CK data) and barycentric dynamical time - (TDB). - - Kernel data are normally loaded once per program run, NOT every - time this routine is called. - --Particulars - - This routine determines a set of one or more time intervals - within the confinement window when any portion of a specified - target body appears within the field of view of a specified - instrument. We'll use the term "visibility event" to designate - such an appearance. The set of time intervals resulting from the - search is returned as a SPICE window. - - This routine provides a simpler, but less flexible, interface - than does the CSPICE routine gffove_c for conducting searches for - visibility events. Applications that require support for progress - reporting, interrupt handling, non-default step or refinement - functions, or non-default convergence tolerance should call - gffove_c rather than this routine. - - To treat the target as a ray rather than as an ephemeris object, - use either the higher-level CSPICE routine gfrfov_c or gffove_c. - Those routines may be used to search for times when distant - target objects such as stars are visible in an instrument FOV, as - long the direction from the observer to the target can be modeled - as a ray. - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient use - of this routine in user applications. - - - The Search Process - ================== - - The search for visibility events is treated as a search for state - transitions: times are sought when the state of the target body - changes from "not visible" to "visible" or vice versa. - - Step Size - ========= - - Each interval of the confinement window is searched as follows: - first, the input step size is used to determine the time - separation at which the visibility state will be sampled. - Starting at the left endpoint of an interval, samples will be - taken at each step. If a state change is detected, a root has - been bracketed; at that point, the "root"--the time at which the - state change occurs---is found by a refinement process, for - example, via binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the visibility state is constant: - the step size should be shorter than the shortest visibility event - duration and the shortest period between visibility events, within - the confinement window. - - Having some knowledge of the relative geometry of the target and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. This - refinement process terminates when the location of the root has been - determined to within an error margin called the "convergence - tolerance." The convergence tolerance used by this routine is set - via the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't become the limiting factor in the accuracy of - solutions found by this routine. In general the accuracy of input - data will be the limiting factor. - - To use a different tolerance value, a lower-level GF routine such as - gffove_c must be called. Making the tolerance tighter than - SPICE_GF_CNVTOL is unlikely to be useful, since the results are - unlikely to be more accurate. Making the tolerance looser will speed - up searches somewhat, since a few convergence steps will be omitted. - However, in most cases, the step size is likely to have a much - greater effect on processing time than would the convergence - tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the confinement - window can, in some cases, be used to make searches more efficient. - Sometimes it's possible to do an efficient search to reduce the size - of the time period over which a relatively slow search of interest - must be performed. For an example, see the program CASCADE in the GF - Example Programs chapter of the GF Required Reading, gf.req. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Search for times when Saturn's satellite Phoebe is within - the FOV of the Cassini narrow angle camera (CASSINI_ISS_NAC). - To simplify the problem, restrict the search to a short time - period where continuous Cassini bus attitude data are - available. - - Use a step size of 10 seconds to reduce chances of missing - short visibility events. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - - KPL/MK - - File name: gftfov_ex1.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - naif0009.tls Leapseconds - cpck05Mar2004.tpc Satellite orientation and - radii - 981005_PLTEPH-DE405S.bsp Planetary ephemeris - 020514_SE_SAT105.bsp Satellite ephemeris - 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris - cas_v37.tf Cassini FK - 04135_04171pc_psiv2.bc Cassini bus CK - cas00084.tsc Cassini SCLK kernel - cas_iss_v09.ti Cassini IK - - - \begindata - - KERNELS_TO_LOAD = ( 'naif0009.tls', - 'cpck05Mar2004.tpc', - '981005_PLTEPH-DE405S.bsp', - '020514_SE_SAT105.bsp', - '030201AP_SK_SM546_T45.bsp', - 'cas_v37.tf', - '04135_04171pc_psiv2.bc', - 'cas00084.tsc', - 'cas_iss_v09.ti' ) - \begintext - - - - Example code begins here. - - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - int main() - { - /. - PROGRAM EX1 - ./ - - /. - Local constants - ./ - #define META "gftfov_ex1.tm" - #define TIMFMT "YYYY-MON-DD HR:MN:SC.######::TDB (TDB)" - #define TIMLEN 41 - #define MAXWIN 10000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cnfine, MAXWIN ); - SPICEDOUBLE_CELL ( result, MAXWIN ); - - SpiceChar * abcorr; - SpiceChar * inst; - SpiceChar * obsrvr; - SpiceChar * target; - SpiceChar * tframe; - SpiceChar timstr [2][ TIMLEN ]; - SpiceChar * tshape; - - SpiceDouble endpt [2]; - SpiceDouble et0; - SpiceDouble et1; - SpiceDouble stepsz; - - SpiceInt i; - SpiceInt j; - SpiceInt n; - - /. - Load kernels. - ./ - furnsh_c ( META ); - - /. - Insert search time interval bounds into the - confinement window. - ./ - str2et_c ( "2004 JUN 11 06:30:00 TDB", &et0 ); - str2et_c ( "2004 JUN 11 12:00:00 TDB", &et1 ); - - wninsd_c ( et0, et1, &cnfine ); - - /. - Initialize inputs for the search. - ./ - inst = "CASSINI_ISS_NAC"; - target = "PHOEBE"; - tshape = "ELLIPSOID"; - tframe = "IAU_PHOEBE"; - abcorr = "LT+S"; - obsrvr = "CASSINI"; - stepsz = 10.0; - - printf ( "\n" - " Instrument: %s\n" - " Target: %s\n" - "\n", - inst, - target ); - - /. - Perform the search. - ./ - gftfov_c ( inst, target, tshape, tframe, - abcorr, obsrvr, stepsz, &cnfine, &result ); - - - n = wncard_c ( &result ); - - if ( n == 0 ) - { - printf ( "No FOV intersection found.\n" ); - } - else - { - printf ( " Visibility start time Stop time\n" ); - - for ( i = 0; i < n; i++ ) - { - wnfetd_c ( &result, i, endpt, endpt+1 ); - - for ( j = 0; j < 2; j++ ) - { - timout_c ( endpt[j], TIMFMT, TIMLEN, timstr[j] ); - } - - printf ( " %s %s\n", - timstr[0], - timstr[1] ); - } - } - - printf ( "\n" ); - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Instrument: CASSINI_ISS_NAC - Target: PHOEBE - - Visibility start time Stop time - 2004-JUN-11 07:35:49.958589 (TDB) 2004-JUN-11 08:48:27.485965 (TDB) - 2004-JUN-11 09:03:19.767799 (TDB) 2004-JUN-11 09:35:27.634790 (TDB) - 2004-JUN-11 09:50:19.585474 (TDB) 2004-JUN-11 10:22:27.854253 (TDB) - 2004-JUN-11 10:37:19.332696 (TDB) 2004-JUN-11 11:09:28.116016 (TDB) - 2004-JUN-11 11:24:19.049485 (TDB) 2004-JUN-11 11:56:28.380304 (TDB) - - --Restrictions - - 1) The reference frame associated with `inst' must be - centered at the observer or must be inertial. No check is done - to ensure this. - - 2) The kernel files to be used by gftfov_c must be loaded (normally - via the CSPICE routine furnsh_c) before gftfov_c is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 15-APR-2009 (NJB) (LSE) (EDW) - --Index_Entries - - GF target in instrument FOV search - --& -*/ - -{ /* Begin gftfov_c */ - - - /* - Local variables - */ - SpiceChar * tFrameStr; - - /* - Static variables - */ - static const SpiceChar * blankStr = " "; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gftfov_c" ); - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gftfov_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - The input frame name is a special case because we allow the caller - to pass in an empty string. If this string is empty, - we pass a null-terminated string containing one blank character to - the underlying f2c'd routine. - - First make sure the frame name pointer is non-null. - */ - CHKPTR ( CHK_STANDARD, "gftfov_c", tframe ); - - /* - Use the input frame string if it's non-empty; otherwise - use a blank string for the frame name. - */ - - if ( tframe[0] ) - { - tFrameStr = (SpiceChar *) tframe; - } - else - { - tFrameStr = (SpiceChar *) blankStr; - } - - - /* - Check the other input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gftfov_c", inst ); - CHKFSTR ( CHK_STANDARD, "gftfov_c", target ); - CHKFSTR ( CHK_STANDARD, "gftfov_c", tshape ); - CHKFSTR ( CHK_STANDARD, "gftfov_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "gftfov_c", obsrvr ); - - - /* - Let the f2c'd routine do the work. - */ - gftfov_ ( (char *) inst, - (char *) target, - (char *) tshape, - (char *) tFrameStr, - (char *) abcorr, - (char *) obsrvr, - (doublereal *) &step, - (doublereal *) cnfine->base, - (doublereal *) result->base, - (ftnlen ) strlen(inst), - (ftnlen ) strlen(target), - (ftnlen ) strlen(tshape), - (ftnlen ) strlen(tframe), - (ftnlen ) strlen(abcorr), - (ftnlen ) strlen(obsrvr) ); - - /* - Sync the output result cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ); - } - - chkout_c ( "gftfov_c" ); - -} /* End gftfov_c */ diff --git a/ext/spice/src/cspice/gfuds.c b/ext/spice/src/cspice/gfuds.c deleted file mode 100644 index 24ee8c2684..0000000000 --- a/ext/spice/src/cspice/gfuds.c +++ /dev/null @@ -1,1303 +0,0 @@ -/* gfuds.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__0 = 0; -static logical c_false = FALSE_; - -/* $Procedure GFUDS ( GF, user defined scalar ) */ -/* Subroutine */ int gfuds_(U_fp udfunc, U_fp udqdec, char *relate, - doublereal *refval, doublereal *adjust, doublereal *step, doublereal * - cnfine, integer *mw, integer *nw, doublereal *work, doublereal * - result, ftnlen relate_len) -{ - /* System generated locals */ - integer work_dim1, work_offset, i__1; - - /* Local variables */ - extern /* Subroutine */ int zzgfudlt_(); - extern /* Subroutine */ int zzgfrelx_(U_fp, U_fp, U_fp, U_fp, U_fp, S_fp, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - integer *, integer *, doublereal *, logical *, U_fp, U_fp, U_fp, - char *, char *, logical *, L_fp, doublereal *, ftnlen, ftnlen, - ftnlen), chkin_(char *, ftnlen), errdp_(char *, doublereal *, - ftnlen); - extern integer sized_(doublereal *); - extern logical gfbail_(); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_(), gfrepu_(), - gfstep_(); - char rptpre[1*2], rptsuf[1*2]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen), gfsstp_(doublereal *); - extern logical odd_(integer *); - doublereal tol; - extern /* Subroutine */ int zzgfref_(doublereal *); - -/* $ Abstract */ - -/* Perform a GF search on a user defined scalar quantity. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EVENT */ -/* EPHEMERIS */ -/* SEARCH */ -/* WINDOW */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICE Cell lower bound. */ -/* CNVTOL P Convergence tolerance. */ -/* UDFUNC I Name of the routine that computes the scalar value */ -/* of interest at some time. */ -/* UDQDEC I Name of the routine that computes whether the */ -/* current state is decreasing. */ -/* RELATE I Operator that either looks for an extreme value */ -/* (max, min, local, absolute) or compares the */ -/* geometric quantity value and a number. */ -/* REFVAL I Value used as reference for geometric quantity */ -/* condition. */ -/* ADJUST I Allowed variation for absolute extremal */ -/* geometric conditions. */ -/* STEP I Step size used for locating extrema and roots. */ -/* CNFINE I SPICE window to which the search is confined. */ -/* MW I Size of workspace windows. */ -/* NW I Number of workspace windows. */ -/* WORK I Array containing workspace windows. */ -/* RESULT I-O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* UDFUNC the routine that returns the value of the scalar */ -/* quantity of interest at time ET. The calling sequence */ -/* for UDFUNC is: */ - -/* CALL UDFUNC ( ET, VALUE ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine the scalar */ -/* value. */ - -/* VALUE is the value of the scalar quantity */ -/* at ET. */ - -/* UDQDEC the name of the routine that determines if the scalar */ -/* quantity calculated by UDFUNC is decreasing. */ - -/* The calling sequence: */ - -/* CALL UDQDEC ( UDFUNC, ET, ISDECR ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine the time */ -/* derivative of UDFUNC. */ - -/* ISDECR a logical return indicating whether */ -/* or not the scalar value returned by UDFUNC */ -/* is decreasing. ISDECR returns true if the */ -/* time derivative of UDFUNC at ET is */ -/* negative. */ - -/* RELATE the scalar string comparison operator indicating */ -/* the numeric constraint of interest. Values are: */ - -/* '>' value of scalar quantity greater than some */ -/* reference (REFVAL). */ - -/* '=' value of scalar quantity equal to some */ -/* reference (REFVAL). */ - -/* '<' value of scalar quantity less than some */ -/* reference (REFVAL). */ - -/* 'ABSMAX' The scalar quantity is at an absolute */ -/* maximum. */ - -/* 'ABSMIN' The scalar quantity is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' The scalar quantity is at a local */ -/* maximum. */ - -/* 'LOCMIN' The scalar quantity is at a local */ -/* minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified distance of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specified this distance. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* RELATE is insensitive to case, leading and */ -/* trailing blanks. */ - -/* REFVAL is the reference value used to define an equality or */ -/* inequality to satisfied by the scalar quantity. */ -/* The units of REFVAL are those of the scalar quantity. */ - -/* ADJUST the amount by which the quantity is allowed to vary */ -/* from an absolute extremum. */ - -/* If the search is for an absolute minimum is performed, */ -/* the resulting window contains time intervals when the */ -/* geometric quantity value has values between */ -/* ABSMIN and ABSMIN + ADJUST. */ - -/* If the search is for an absolute maximum, the */ -/* corresponding range is between ABSMAX - ADJUST and */ -/* ABSMAX. */ - -/* ADJUST is not used for searches for local extrema, */ -/* equality or inequality conditions and must have value */ -/* zero for such searches. */ - -/* STEP the double precision time step size to use in */ -/* the search. */ - -/* STEP must be short enough to for a search using this */ -/* step size to locate the time intervals where the */ -/* scalar quantity function is monotone increasing or */ -/* decreasing. However, STEP must not be *too* short, */ -/* or the search will take an unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; the */ -/* precision is controlled by the convergence tolerance. */ -/* See the discussion of the parameter CNVTOL for */ -/* details. */ - -/* STEP has units of TDB seconds. */ - -/* CNFINE is a SPICE window that confines the time period over */ -/* which the specified search is conducted. CNFINE may */ -/* consist of a single interval or a collection of */ -/* intervals. */ - -/* In some cases the confinement window can be used to */ -/* greatly reduce the time period that must be searched */ -/* for the desired solution. See the Particulars section */ -/* below for further discussion. */ - -/* See the Examples section below for a code example */ -/* that shows how to create a confinement window. */ - -/* CNFINE must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* MW is a parameter specifying the length of the SPICE */ -/* windows in the workspace array WORK (see description */ -/* below) used by this routine. */ - -/* MW should be set to a number at least twice as large */ -/* as the maximum number of intervals required by any */ -/* workspace window. In many cases, it's not necessary to */ -/* compute an accurate estimate of how many intervals are */ -/* needed; rather, the user can pick a size considerably */ -/* larger than what's really required. */ - -/* However, since excessively large arrays can prevent */ -/* applications from compiling, linking, or running */ -/* properly, sometimes MW must be set according to */ -/* the actual workspace requirement. A rule of thumb */ -/* for the number of intervals NINTVLS needed is */ - -/* NINTVLS = 2*N + ( M / STEP ) */ - -/* where */ - -/* N is the number of intervals in the confinement */ -/* window */ - -/* M is the measure of the confinement window, in */ -/* units of seconds */ - -/* STEP is the search step size in seconds */ - -/* MW should then be set to */ - -/* 2 * NINTVLS */ - -/* NW is a parameter specifying the number of SPICE windows */ -/* in the workspace array WORK (see description below) */ -/* used by this routine. (The reason this dimension is */ -/* an input argument is that this allows run-time */ -/* error checking to be performed.) */ - -/* NW must be at least as large as the parameter NWUDS. */ - -/* WORK is an array used to store workspace windows. This */ -/* array should be declared by the caller as shown: */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NW ) */ - -/* WORK need not be initialized by the caller. */ - -/* RESULT a double precision SPICE window which will contain the */ -/* search results. RESULT must be declared and initialized */ -/* with sufficient size to capture the full set of time */ -/* intervals within the search region on which the */ -/* specified constraint is satisfied. */ - -/* RESULT must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* If RESULT is non-empty on input, its contents */ -/* will be discarded before GFUDS conducts its search. */ - -/* $ Detailed_Output */ - -/* WORK the input workspace array, modified by this */ -/* routine. */ - -/* RESULT is a SPICE window containing the time intervals within */ -/* the confinement window, during which the specified */ -/* condition on the scalar quantity is met. */ - -/* If the search is for local extrema, or for absolute */ -/* extrema with ADJUST set to zero, then normally each */ -/* interval of RESULT will be a singleton: the left and */ -/* right endpoints of each interval will be identical. */ - -/* If no times within the confinement window satisfy the */ -/* search, RESULT will be returned with a cardinality */ -/* of zero. */ - -/* $ Parameters */ - -/* LBCELL the integer value defining the lower bound for */ -/* SPICE Cell arrays (a SPICE window is a kind of cell). */ - -/* CNVTOL is the convergence tolerance used for finding */ -/* endpoints of the intervals comprising the result */ -/* window. CNVTOL is also used for finding intermediate */ -/* results; in particular, CNVTOL is used for finding the */ -/* windows on which the range rate is increasing */ -/* or decreasing. CNVTOL is used to determine when binary */ -/* searches for roots should terminate: when a root is */ -/* bracketed within an interval of length CNVTOL; the */ -/* root is considered to have been found. */ - -/* The accuracy, as opposed to precision, of roots found */ -/* by this routine depends on the accuracy of the input */ -/* data. In most cases, the accuracy of solutions will be */ -/* inferior to their precision. */ - -/* See INCLUDE file gf.inc for declarations and descriptions of */ -/* parameters used throughout the GF system. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the step size must be appropriate for the problem at hand. */ -/* Step sizes that are too large may cause this routine to miss */ -/* roots; step sizes that are too small may cause this routine */ -/* to run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, except */ -/* that if the step size is non-positive, the error */ -/* SPICE(INVALIDSTEP) is signaled. */ - -/* 2) Due to numerical errors, in particular, */ - -/* - truncation error in time values */ -/* - finite tolerance value */ -/* - errors in computed geometric quantities */ - -/* it is *normal* for the condition of interest to not always be */ -/* satisfied near the endpoints of the intervals comprising the */ -/* RESULT window. One technique to handle such a situation, */ -/* slightly contract RESULT using the window routine WNCOND. */ - -/* 3) If the workspace window size MW is less than 2 or not an even */ -/* value, the error SPICE(INVALIDDIMENSION) will signal. If the */ -/* size of the workspace is too small, an error is signaled by a */ -/* routine in the call tree of this routine. */ - -/* 4) If the size of the SPICE window RESULT is less than 2 or */ -/* not an even value, the error SPICE(INVALIDDIMENSION) will */ -/* signal. If RESULT has insufficient capacity to contain the */ -/* number of intervals on which the specified distance condition */ -/* is met, the error will be diagnosed by a routine in the call */ -/* tree of this routine. */ - -/* 5) If the window count NW is less than NWUDS, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 6) If an error (typically cell overflow) occurs during */ -/* window arithmetic, the error will be diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 7) If the relational operator RELATE is not recognized, an */ -/* error is signaled by a routine in the call tree of this */ -/* routine. */ - -/* 8) If ADJUST is negative, the error SPICE(VALUEOUTOFRANGE) will */ -/* signal from a routine in the call tree of this routine. */ - -/* A non-zero value for ADJUST when RELATE has any value other */ -/* than "ABSMIN" or "ABSMAX" causes the error SPICE(INVALIDVALUE) */ -/* to signal from a routine in the call tree of this routine. */ - -/* 9) If required ephemerides or other kernel data are not */ -/* available, an error is signaled by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* If the scalar function requires access to ephemeris data: */ - -/* - SPK data: ephemeris data for any body over the */ -/* time period defined by the confinement window must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine determines a set of one or more time intervals */ -/* within the confinement window when the scalar function */ -/* satisfies a caller-specified constraint. The resulting set of */ -/* intervals is returned as a SPICE window. */ - -/* UDQDEC Default Template */ -/* ======================= */ - -/* The user must supply a routine to determine whether sign of the */ -/* time derivative of UDFUNC is positive or negative at ET. For */ -/* cases where UDFUNC is numerically well behaved, the user */ -/* may find it convenient to use a routine based on the below */ -/* template. UDDC determines the truth of the expression */ - -/* d (UDFUNC) */ -/* -- < 0 */ -/* dt */ - -/* using the library routine UDDF to numerically calculate the */ -/* derivative of UDFUNC using a three-point estimation. */ -/* Please see the Examples section for an example of GFDECR use. */ - -/* SUBROUTINE GFDECR ( UDFUNC, ET, ISDECR ) */ -/* IMPLICIT NONE */ - -/* EXTERNAL UDFUNC */ -/* EXTERNAL UDDF */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL ISDECR */ - -/* DOUBLE PRECISION DT */ - -/* DT = h, double precision interval size */ - -/* CALL UDDC ( UDFUNC, ET, DT, ISDECR ) */ - -/* END */ - -/* The Search Process */ -/* ================== */ - -/* Regardless of the type of constraint selected by the caller, this */ -/* routine starts the search for solutions by determining the time */ -/* periods, within the confinement window, over which the specified */ -/* scalar function is monotone increasing and monotone */ -/* decreasing. Each of these time periods is represented by a SPICE */ -/* window. Having found these windows, all of the quantity */ -/* function's local extrema within the confinement window are known. */ -/* Absolute extrema then can be found very easily. */ - -/* Within any interval of these "monotone" windows, there will be at */ -/* most one solution of any equality constraint. Since the boundary */ -/* of the solution set for any inequality constraint is the set */ -/* of points where an equality constraint is met, the solutions of */ -/* both equality and inequality constraints can be found easily */ -/* once the monotone windows have been found. */ - - -/* Step Size */ -/* ========= */ - -/* The monotone windows (described above) are found using a two-step */ -/* search process. Each interval of the confinement window is */ -/* searched as follows: first, the input step size is used to */ -/* determine the time separation at which the sign of the rate of */ -/* change of quantity function will be sampled. Starting at */ -/* the left endpoint of an interval, samples will be taken at each */ -/* step. If a change of sign is found, a root has been bracketed; at */ -/* that point, the time at which the time derivative of the quantity */ -/* function is zero can be found by a refinement process, for */ -/* example, using a binary search. */ - -/* Note that the optimal choice of step size depends on the lengths */ -/* of the intervals over which the quantity function is monotone: */ -/* the step size should be shorter than the shortest of these */ -/* intervals (within the confinement window). */ - -/* The optimal step size is *not* necessarily related to the lengths */ -/* of the intervals comprising the result window. For example, if */ -/* the shortest monotone interval has length 10 days, and if the */ -/* shortest result window interval has length 5 minutes, a step size */ -/* of 9.9 days is still adequate to find all of the intervals in the */ -/* result window. In situations like this, the technique of using */ -/* monotone windows yields a dramatic efficiency improvement over a */ -/* state-based search that simply tests at each step whether the */ -/* specified constraint is satisfied. The latter type of search can */ -/* miss solution intervals if the step size is shorter than the */ -/* shortest solution interval. */ - -/* Having some knowledge of the relative geometry of the targets and */ -/* observer can be a valuable aid in picking a reasonable step size. */ -/* In general, the user can compensate for lack of such knowledge by */ -/* picking a very short step size; the cost is increased computation */ -/* time. */ - -/* Note that the step size is not related to the precision with which */ -/* the endpoints of the intervals of the result window are computed. */ -/* That precision level is controlled by the convergence tolerance. */ - - -/* Convergence Tolerance */ -/* ===================== */ - -/* Once a root has been bracketed, a refinement process is used to */ -/* narrow down the time interval within which the root must lie. */ -/* This refinement process terminates when the location of the root */ -/* has been determined to within an error margin called the */ -/* "convergence tolerance." */ - -/* The GF subsystem defines a parameter, CNVTOL (from gf.inc), as a */ -/* default tolerance. This represents a "tight" tolerance value */ -/* so that the tolerance doesn't become the limiting factor in the */ -/* accuracy of solutions found by this routine. In general the */ -/* accuracy of input data will be the limiting factor. */ - -/* Making the tolerance tighter than CNVTOL is unlikely to */ -/* be useful, since the results are unlikely to be more accurate. */ -/* Making the tolerance looser will speed up searches somewhat, */ -/* since a few convergence steps will be omitted. However, in most */ -/* cases, the step size is likely to have a much greater affect */ -/* on processing time than would the convergence tolerance. */ - - -/* The Confinement Window */ -/* ====================== */ - -/* The simplest use of the confinement window is to specify a time */ -/* interval within which a solution is sought. However, the */ -/* confinement window can, in some cases, be used to make searches */ -/* more efficient. Sometimes it's possible to do an efficient search */ -/* to reduce the size of the time period over which a relatively */ -/* slow search of interest must be performed. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* Conduct a search on the range-rate of the vector from the Sun */ -/* to the Moon. Define a function to calculate the value. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* File name: standard.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de414.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0009.tls' ) */ - -/* \begintext */ - - -/* Code: */ - -/* PROGRAM GFUDS_T */ -/* IMPLICIT NONE */ - -/* C */ -/* C Include GF parameter declarations: */ -/* C */ -/* INCLUDE 'gf.inc' */ - -/* EXTERNAL GFQ */ -/* EXTERNAL GFDECR */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION SPD */ -/* DOUBLE PRECISION DVNORM */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* C */ -/* C Use the parameter MAXWIN for both the result window size */ -/* C and the workspace size. */ -/* C */ -/* INTEGER MAXWIN */ -/* PARAMETER ( MAXWIN = 20000 ) */ - -/* C */ -/* C Length of strings: */ -/* C */ -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 26 ) */ - -/* INTEGER NLOOPS */ -/* PARAMETER ( NLOOPS = 7 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(TIMLEN) RELATE (NLOOPS) */ - -/* DOUBLE PRECISION ADJUST */ -/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */ -/* DOUBLE PRECISION DRDT */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION ET1 */ -/* DOUBLE PRECISION FINISH */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 6 ) */ -/* DOUBLE PRECISION REFVAL */ -/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */ -/* DOUBLE PRECISION START */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWUDS ) */ - -/* INTEGER I */ -/* INTEGER J */ - - -/* DATA RELATE / '=', */ -/* . '<', */ -/* . '>', */ -/* . 'LOCMIN', */ -/* . 'ABSMIN', */ -/* . 'LOCMAX', */ -/* . 'ABSMAX' / */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Initialize windows. */ -/* C */ -/* CALL SSIZED ( MAXWIN, RESULT ) */ -/* CALL SSIZED ( 2, CNFINE ) */ - -/* CALL SCARDD ( 0, CNFINE ) */ - -/* C */ -/* C Store the time bounds of our search interval in */ -/* C the confinement window. */ -/* C */ -/* CALL STR2ET ( '2007 JAN 1', ET0 ) */ -/* CALL STR2ET ( '2007 APR 1', ET1 ) */ - -/* CALL WNINSD ( ET0, ET1, CNFINE ) */ - -/* C */ -/* C Search using a step size of 1 day (in units of seconds). */ -/* C The reference value is .3365 km/s - a range rate value known */ -/* C to exist during the confinement window. We're not using the */ -/* C adjustment feature, so we set ADJUST to zero. */ -/* C */ -/* STEP = SPD() */ -/* REFVAL = .3365D0 */ -/* ADJUST = 0.D0 */ - -/* DO J=1, NLOOPS */ - -/* WRITE(*,*) 'Relation condition: ', RELATE(J) */ - -/* C */ -/* C Perform the search. The SPICE window RESULT contains */ -/* C the set of times when the condition is met. */ -/* C */ -/* CALL GFUDS ( GFQ, GFDECR, */ -/* . RELATE(J), REFVAL, ADJUST, STEP, CNFINE, */ -/* . MAXWIN, NWUDS, WORK, RESULT ) */ - - -/* C */ -/* C Display the results. */ -/* C */ -/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */ - -/* WRITE (*, '(A)') 'Result window is empty.' */ - -/* ELSE */ - -/* DO I = 1, WNCARD(RESULT) */ -/* C */ -/* C Fetch the endpoints of the Ith interval */ -/* C of the result window. */ -/* C */ -/* CALL WNFETD ( RESULT, I, START, FINISH ) */ - -/* CALL SPKEZR ( 'MOON', START, 'J2000', 'NONE', */ -/* . 'SUN', POS, LT ) */ -/* DRDT = DVNORM(POS) */ - -/* CALL TIMOUT ( START, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) 'Start time, drdt = '// */ -/* . TIMSTR, DRDT */ - -/* CALL SPKEZR ( 'MOON', FINISH, 'J2000', 'NONE', */ -/* . 'SUN', POS, LT ) */ -/* DRDT = DVNORM(POS) */ - -/* CALL TIMOUT ( FINISH, 'YYYY-MON-DD HR:MN:SC.###', */ -/* . TIMSTR ) */ - -/* WRITE (*, '(A,F16.9)' ) 'Stop time, drdt = '// */ -/* . TIMSTR, DRDT */ -/* END DO */ - -/* END IF */ - -/* WRITE(*,*) ' ' */ - -/* END DO */ - -/* END */ - - - -/* C-Procedure GFQ */ - -/* SUBROUTINE GFQ ( ET, VALUE ) */ -/* IMPLICIT NONE */ - -/* C- Abstract */ -/* C */ -/* C User defined geometric quantity function. In this case, */ -/* C the range from the sun to the Moon at TDB time ET. */ -/* C */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION VALUE */ - -/* C */ -/* C Local variables. */ -/* C */ -/* INTEGER TARG */ -/* INTEGER OBS */ - -/* CHARACTER*(12) REF */ -/* CHARACTER*(12) ABCORR */ - -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION DVNORM */ - -/* C */ -/* C Initialization. Retrieve the vector from the Sun to */ -/* C the Moon in the J2000 frame, without aberration */ -/* C correction. */ -/* C */ -/* TARG = 301 */ -/* REF = 'J2000' */ -/* ABCORR = 'NONE' */ -/* OBS = 10 */ - -/* CALL SPKEZ ( TARG, ET, REF, ABCORR, OBS, STATE, LT ) */ - -/* C */ -/* C Calculate the scalar range rate corresponding the */ -/* C STATE vector. */ -/* C */ -/* VALUE = DVNORM( STATE ) */ - -/* END */ - - - - -/* C-Procedure GFDECR */ - -/* SUBROUTINE GFDECR ( UDFUNC, ET, ISDECR ) */ -/* IMPLICIT NONE */ - -/* C- Abstract */ -/* C */ -/* C User defined function to detect if the function derivative */ -/* C is negative (the function is decreasing) at TDB time ET. */ -/* C */ - -/* EXTERNAL UDFUNC */ -/* EXTERNAL UDDF */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL ISDECR */ - -/* DOUBLE PRECISION DT */ - -/* DT = 1.D0 */ - -/* C */ -/* C Determine if GFQ is decreasing at ET. */ -/* C */ -/* C UDDC - the default GF function to determine if */ -/* C the derivative of the user defined */ -/* C function is negative at ET. */ -/* C */ -/* C UDFUNC - the user defined scalar quantity function. */ -/* C */ -/* CALL UDDC ( UDFUNC, ET, DT, ISDECR ) */ - -/* END */ - -/* The program outputs: */ - -/* Relation condition: = */ -/* Start time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Stop time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Start time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Stop time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Start time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Stop time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Start time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Stop time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Start time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Stop time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Start time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ -/* Stop time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ - -/* Relation condition: < */ -/* Start time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Stop time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Start time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Stop time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Start time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Stop time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ - -/* Relation condition: > */ -/* Start time, drdt = 2007-JAN-01 00:00:00.000 0.515522367 */ -/* Stop time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */ -/* Start time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */ -/* Stop time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */ -/* Start time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */ -/* Stop time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */ -/* Start time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */ -/* Stop time, drdt = 2007-APR-01 00:00:00.000 0.793546222 */ - -/* Relation condition: LOCMIN */ -/* Start time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ -/* Stop time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ -/* Start time, drdt = 2007-FEB-10 06:26:15.439 -0.575837623 */ -/* Stop time, drdt = 2007-FEB-10 06:26:15.439 -0.575837623 */ -/* Start time, drdt = 2007-MAR-12 03:28:36.404 -0.441800446 */ -/* Stop time, drdt = 2007-MAR-12 03:28:36.404 -0.441800446 */ - -/* Relation condition: ABSMIN */ -/* Start time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ -/* Stop time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */ - -/* Relation condition: LOCMAX */ -/* Start time, drdt = 2007-JAN-26 02:27:33.766 1.154648992 */ -/* Stop time, drdt = 2007-JAN-26 02:27:33.766 1.154648992 */ -/* Start time, drdt = 2007-FEB-24 09:35:07.816 1.347132236 */ -/* Stop time, drdt = 2007-FEB-24 09:35:07.816 1.347132236 */ -/* Start time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ -/* Stop time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ - -/* Relation condition: ABSMAX */ -/* Start time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ -/* Stop time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */ - -/* $ Restrictions */ - -/* 1) Any kernel files required by this routine must be loaded */ -/* (normally via the SPICELIB routine FURNSH) before this routine */ -/* is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 16-FEB-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF user defined scalar function search */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local variables. */ - - -/* Dummy variables. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_offset = work_dim1 - 5; - - /* Function Body */ - chkin_("GFUDS", (ftnlen)5); - -/* Check the step size. */ - - if (*step <= 0.) { - setmsg_("Step size was #; step size must be positive.", (ftnlen)44); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18); - chkout_("GFUDS", (ftnlen)5); - return 0; - } - -/* Confirm minimum number of windows. */ - - if (*nw < 5) { - setmsg_("Workspace window count was #; count must be at least #.", ( - ftnlen)55); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__5, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFUDS", (ftnlen)5); - return 0; - } - -/* Confirm minimum window sizes. */ - - if (*mw < 2 || odd_(mw)) { - setmsg_("Workspace window size was #; size must be at least 2 and an" - " even value.", (ftnlen)71); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFUDS", (ftnlen)5); - return 0; - } - -/* Check the result window size. */ - - i__1 = sized_(result); - if (sized_(result) < 2 || odd_(&i__1)) { - setmsg_("Result window size was #; size must be at least 2 and an ev" - "en value.", (ftnlen)68); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("GFUDS", (ftnlen)5); - return 0; - } - -/* Set the step size. */ - - gfsstp_(step); - -/* Set the reference value. */ - - zzgfref_(refval); - -/* Use the default GF convergence tolerance. */ - - tol = 1e-6; - -/* Initialize the RESULT window to empty. */ - - scardd_(&c__0, result); - -/* Call ZZGFRELX to do the event detection work. */ - - zzgfrelx_((U_fp)gfstep_, (U_fp)gfrefn_, (U_fp)udqdec, (U_fp)zzgfudlt_, ( - U_fp)udfunc, (S_fp)zzgfref_, relate, refval, &tol, adjust, cnfine, - mw, nw, work, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp) - gfrepf_, rptpre, rptsuf, &c_false, (L_fp)gfbail_, result, - relate_len, (ftnlen)1, (ftnlen)1); - chkout_("GFUDS", (ftnlen)5); - return 0; -} /* gfuds_ */ - diff --git a/ext/spice/src/cspice/gfuds_c.c b/ext/spice/src/cspice/gfuds_c.c deleted file mode 100644 index 16dae197fc..0000000000 --- a/ext/spice/src/cspice/gfuds_c.c +++ /dev/null @@ -1,957 +0,0 @@ -/* - --Procedure gfuds_c ( GF, user defined scalar ) - --Abstract - - Perform a GF search on a user defined scalar quantity. - --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 - - GF - WINDOWS - --Keywords - - EVENT - GEOMETRY - SEARCH - WINDOW - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZfc.h" - #include "SpiceZad.h" - #include "SpiceZst.h" - #include "zzalloc.h" - #undef gfuds_c - - void gfuds_c ( void ( * udfunc ) ( SpiceDouble et, - SpiceDouble * value ), - - void ( * udqdec ) ( void ( * udfunc ) - ( SpiceDouble et, - SpiceDouble * value ), - - SpiceDouble et, - SpiceBoolean * isdecr ), - - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - udfunc I Name of the routine that computes the scalar value - of interest at some time. - udqdec I Name of the routine that computes whether the - current state is decreasing. - relate I Operator that either looks for an extreme value - (max, min, local, absolute) or compares the - geometric quantity value and a number. - refval I Value used as reference for geometric quantity - condition. - adjust I Allowed variation for absolute extremal - geometric conditions. - step I Step size used for locating extrema and roots. - nintvls I Workspace window interval count - cnfine I-O SPICE window to which the search is restricted. - result O SPICE window containing results. - --Detailed_Input - - udfunc the name of the external routine that returns the - value of the scalar quantity of interest at time ET. - The calling sequence for "udfunc" is: - - udfunc ( et, &value ) - - where: - - et an input double precision value - representing the TDB ephemeris seconds time - at which to determine the scalar value. - - value is the value of the geometric quantity - at 'et'. - - udqdec the name of the external routine that determines if - the scalar quantity calculated by "udfunc" is decreasing. - - The calling sequence: - - udqdec ( et, &isdecr ) - - where: - - et an input double precision value representing - the TDB ephemeris seconds time at at which - to determine the time derivative of 'udfunc'. - - isdecr a logical variable indicating whether - or not the scalar value returned by udfunc - is decreasing. 'isdecr' returns true if the - time derivative of "udfunc" at 'et' is negative. - - relate the scalar string comparison operator indicating - the numeric constraint of interest. Values are: - - ">" value of scalar quantity greater than some - reference (refval). - - "=" value of scalar quantity equal to some - reference (refval). - - "<" value of scalar quantity less than some - reference (refval). - - "ABSMAX" The scalar quantity is at an absolute - maximum. - - "ABSMIN" The scalar quantity is at an absolute - minimum. - - "LOCMAX" The scalar quantity is at a local - maximum. - - "LOCMIN" The scalar quantity is at a local - minimum. - - The caller may indicate that the region of interest - is the set of time intervals where the quantity is - within a specified distance of an absolute extremum. - The argument 'adjust' (described below) is used to - specified this distance. - - Local extrema are considered to exist only in the - interiors of the intervals comprising the confinement - window: a local extremum cannot exist at a boundary - point of the confinement window. - - relate is insensitive to case, leading and - trailing blanks. - - refval is the reference value used to define an equality or - inequality to satisfied by the scalar quantity. - The units of refval are those of the scalar quantity. - - adjust the amount by which the quantity is allowed to vary - from an absolute extremum. - - If the search is for an absolute minimum is performed, - the resulting window contains time intervals when the - geometric quantity value has values between ABSMIN and - ABSMIN + adjust. - - If the search is for an absolute maximum, the - corresponding range is between ABSMAX - adjust and - ABSMAX. - - 'adjust' is not used for searches for local extrema, - equality or inequality conditions and must have value - zero for such searches. - - step the double precision time step size to use in - the search. - - 'step' must be short enough to for a search using this - step size to locate the time intervals where the - scalar quantity function is monotone increasing or - decreasing. However, 'step' must not be *too* short, - or the search will take an - - The choice of 'step' affects the completeness but not - the precision of solutions found by this routine; the - precision is controlled by the convergence tolerance. - See the discussion of the parameter SPICE_GF_CNVTOL for - details. - - 'step' has units of TDB seconds. - - nintvls an integer value specifying the number of intervals in the - the internal workspace array used by this routine. 'nintvls' - should be at least as large as the number of intervals - within the search region on which the specified observer-target - vector coordinate function is monotone increasing or decreasing. - It does no harm to pick a value of 'nintvls' larger than the - minimum required to execute the specified search, but if chosen - too small, the search will fail. - - cnfine a double precision SPICE window that confines the time - period over which the specified search is conducted. - cnfine may consist of a single interval or a collection - of intervals. - - In some cases the confinement window can be used to - greatly reduce the time period that must be searched - for the desired solution. See the Particulars section - below for further discussion. - - See the Examples section below for a code example - that shows how to create a confinement window. - --Detailed_Output - - cnfine is the input confinement window, updated if necessary - so the control area of its data array indicates the - window's size and cardinality. The window data are - unchanged. - - result is a SPICE window representing the set of time - intervals, within the confinement period, when the - specified geometric event occurs. - - If `result' is non-empty on input, its contents - will be discarded before gfuds_c conducts its - search. - --Parameters - - None. - --Exceptions - - 1) In order for this routine to produce correct results, - the step size must be appropriate for the problem at hand. - Step sizes that are too large may cause this routine to miss - roots; step sizes that are too small may cause this routine - to run unacceptably slowly and in some cases, find spurious - roots. - - This routine does not diagnose invalid step sizes, except - that if the step size is non-positive, an error is signaled - by a routine in the call tree of this routine. - - 2) Due to numerical errors, in particular, - - - Truncation error in time values - - Finite tolerance value - - Errors in computed geometric quantities - - it is *normal* for the condition of interest to not always be - satisfied near the endpoints of the intervals comprising the - result window. - - The result window may need to be contracted slightly by the - caller to achieve desired results. The SPICE window routine - wncond_c can be used to contract the result window. - - 3) If an error (typically cell overflow) occurs while performing - window arithmetic, the error will be diagnosed by a routine - in the call tree of this routine. - - 4) If the relational operator `relate' is not recognized, an - error is signaled by a routine in the call tree of this - routine. - - 5) If 'adjust' is negative, the error SPICE(VALUEOUTOFRANGE) will - signal from a routine in the call tree of this routine. - - A non-zero value for 'adjust' when 'relate' has any value other than - "ABSMIN" or "ABSMAX" causes the error SPICE(INVALIDVALUE) to - signal from a routine in the call tree of this routine. - - 6) If required ephemerides or other kernel data are not - available, an error is signaled by a routine in the call tree - of this routine. - - 7) If the workspace interval count is less than 1, the error - SPICE(VALUEOUTOFRANGE) will be signaled. - - 8) If the required amount of workspace memory cannot be - allocated, the error SPICE(MALLOCFAILURE) will be - signaled. - - 9) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 10) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - 11) If either input cell has type other than SpiceDouble, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - Appropriate kernels must be loaded by the calling program before - this routine is called. - - If the scalar function requires access to ephemeris data: - - - SPK data: ephemeris data for any body over the - time period defined by the confinement window must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - If non-inertial reference frames are used, then PCK - files, frame kernels, C-kernels, and SCLK kernels may be - needed. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - This routine provides a simpler, but less flexible interface - than does the routine zzgfrel_ for conducting searches for events - corresponding to an arbitrary user defined scalar quantity - function. Applications that require support for progress - reporting, interrupt handling, non-default step or refinement - functions, or non-default convergence tolerance should call - zzgfrel_ rather than this routine. - - This routine determines a set of one or more time intervals - within the confinement window when the scalar function - satisfies a caller-specified constraint. The resulting set of - intervals is returned as a SPICE window. - - udqdec Default Template - ======================= - - The user must supply a routine to determine whether sign of the - time derivative of udfunc is positive or negative at 'et'. For - cases where udfunc is numerically well behaved, the user - may find it convenient to use a routine based on the below - template. uddc_c determines the truth of the expression - - d (udfunc) - -- < 0 - dt - - using the library routine uddf_c to numerically calculate the - derivative of udfunc using a three-point estimation. Use - of gfdecr requires only changing the "udfunc" argument - to that of the user provided scalar function passed to gfuds_c - and defining the differential interval size, 'dt'. Please see - the Examples section for an example of gfdecr use. - - void gfdecr ( SpiceDouble et, SpiceBoolean * isdecr ) - { - - SpiceDouble dt = h, double precision interval size; - - uddc_c( udfunc, uddf_c, et, dt, isdecr ); - - return; - } - - Below we discuss in greater detail aspects of this routine's - solution process that are relevant to correct and efficient - use of this routine in user applications. - - The Search Process - ================== - - Regardless of the type of constraint selected by the caller, this - routine starts the search for solutions by determining the time - periods, within the confinement window, over which the specified - scalar function is monotone increasing and monotone - decreasing. Each of these time periods is represented by a SPICE - window. Having found these windows, all of the quantity - function's local extrema within the confinement window are known. - Absolute extrema then can be found very easily. - - Within any interval of these "monotone" windows, there will be at - most one solution of any equality constraint. Since the boundary - of the solution set for any inequality constraint is the set - of points where an equality constraint is met, the solutions of - both equality and inequality constraints can be found easily - once the monotone windows have been found. - - Step Size - ========= - - The monotone windows (described above) are found using a two-step - search process. Each interval of the confinement window is - searched as follows: first, the input step size is used to - determine the time separation at which the sign of the rate of - change of quantity function will be sampled. Starting at - the left endpoint of an interval, samples will be taken at each - step. If a change of sign is found, a root has been bracketed; at - that point, the time at which the time derivative of the quantity - function is zero can be found by a refinement process, for - example, using a binary search. - - Note that the optimal choice of step size depends on the lengths - of the intervals over which the quantity function is monotone: - the step size should be shorter than the shortest of these - intervals (within the confinement window). - - The optimal step size is *not* necessarily related to the lengths - of the intervals comprising the result window. For example, if - the shortest monotone interval has length 10 days, and if the - shortest result window interval has length 5 minutes, a step size - of 9.9 days is still adequate to find all of the intervals in the - result window. In situations like this, the technique of using - monotone windows yields a dramatic efficiency improvement over a - state-based search that simply tests at each step whether the - specified constraint is satisfied. The latter type of search can - miss solution intervals if the step size is shorter than the - shortest solution interval. - - Having some knowledge of the relative geometry of the targets and - observer can be a valuable aid in picking a reasonable step size. - In general, the user can compensate for lack of such knowledge by - picking a very short step size; the cost is increased computation - time. - - Note that the step size is not related to the precision with which - the endpoints of the intervals of the result window are computed. - That precision level is controlled by the convergence tolerance. - - - Convergence Tolerance - ===================== - - Once a root has been bracketed, a refinement process is used to - narrow down the time interval within which the root must lie. - This refinement process terminates when the location of the root - has been determined to within an error margin called the - "convergence tolerance." The convergence tolerance used by this - routine is set via the parameter SPICE_GF_CNVTOL. - - The value of SPICE_GF_CNVTOL is set to a "tight" value so that the - tolerance doesn't become the limiting factor in the accuracy of - solutions found by this routine. In general the accuracy of input - data will be the limiting factor. - - Making the tolerance tighter than SPICE_GF_CNVTOL is unlikely to - be useful, since the results are unlikely to be more accurate. - Making the tolerance looser will speed up searches somewhat, - since a few convergence steps will be omitted. However, in most - cases, the step size is likely to have a much greater affect - on processing time than would the convergence tolerance. - - - The Confinement Window - ====================== - - The simplest use of the confinement window is to specify a time - interval within which a solution is sought. However, the - confinement window can, in some cases, be used to make searches - more efficient. Sometimes it's possible to do an efficient search - to reduce the size of the time period over which a relatively - slow search of interest must be performed. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - Conduct a search on the range-rate of the vector from the Sun - to the Moon. Define a function to calculate the value. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File name: standard.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de414.bsp', - 'pck00008.tpc', - 'naif0009.tls' ) - - \begintext - - Code: - - #include - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZad.h" - - - #define MAXWIN 20000 - #define TIMFMT "YYYY-MON-DD HR:MN:SC.###" - #define TIMLEN 41 - #define NLOOPS 7 - - void gfq ( SpiceDouble et, SpiceDouble * value ); - void gfdecrx ( void ( * udfunc ) ( SpiceDouble et, - SpiceDouble * value ), - SpiceDouble et, - SpiceBoolean * isdecr ); - - doublereal dvnorm_(doublereal *state); - - - int main( int argc, char **argv ) - { - - /. - Create the needed windows. Note, one interval - consists of two values, so the total number - of cell values to allocate is twice - the number of intervals. - ./ - SPICEDOUBLE_CELL ( result, 2*MAXWIN ); - SPICEDOUBLE_CELL ( cnfine, 2 ); - - SpiceDouble begtim; - SpiceDouble endtim; - SpiceDouble step; - SpiceDouble adjust; - SpiceDouble refval; - SpiceDouble beg; - SpiceDouble end; - - SpiceChar begstr [ TIMLEN ]; - SpiceChar endstr [ TIMLEN ]; - - SpiceInt count; - SpiceInt i; - SpiceInt j; - - ConstSpiceChar * relate [NLOOPS] = { "=", - "<", - ">", - "LOCMIN", - "ABSMIN", - "LOCMAX", - "ABSMAX" - }; - - printf( "Compile date %s, %s\n\n", __DATE__, __TIME__ ); - - /. - Load kernels. - ./ - furnsh_c( "standard.tm" ); - - /. - Store the time bounds of our search interval in the 'cnfine' - confinement window. - ./ - str2et_c( "2007 JAN 01", &begtim ); - str2et_c( "2007 APR 01", &endtim ); - - wninsd_c ( begtim, endtim, &cnfine ); - - /. - Search using a step size of 1 day (in units of seconds). The reference - value is .3365 km/s. We're not using the adjustment feature, so - we set 'adjust' to zero. - ./ - step = spd_c(); - adjust = 0.; - refval = .3365; - - for ( j = 0; j < NLOOPS; j++ ) - { - - printf ( "Relation condition: %s \n", relate[j] ); - - /. - Perform the search. The SPICE window 'result' contains - the set of times when the condition is met. - ./ - - gfuds_c ( gfq, - gfdecrx, - relate[j], - refval, - adjust, - step, - MAXWIN, - &cnfine, - &result ); - - count = wncard_c( &result ); - - /. - Display the results. - ./ - if (count == 0 ) - { - printf ( "Result window is empty.\n\n" ); - } - else - { - for ( i = 0; i < count; i++ ) - { - - /. - Fetch the endpoints of the Ith interval - of the result window. - ./ - wnfetd_c ( &result, i, &beg, &end ); - - timout_c ( beg, TIMFMT, TIMLEN, begstr ); - timout_c ( end, TIMFMT, TIMLEN, endstr ); - - printf ( "Start time, drdt = %s \n", begstr ); - printf ( "Stop time, drdt = %s \n", endstr ); - - } - - } - - printf("\n"); - - } - - kclear_c(); - return( 0 ); - } - - - - /. - The user defined functions required by GFUDS. - - gfq for udfunc - gfdecr for udqdec - ./ - - - - /. - -Procedure Procedure gfq - ./ - - void gfq ( SpiceDouble et, SpiceDouble * value ) - - /. - -Abstract - - User defined geometric quantity function. In this case, - the range from the sun to the Moon at TDB time 'et'. - - ./ - { - - /. Initialization ./ - SpiceInt targ = 301; - SpiceInt obs = 10; - - SpiceChar * ref = "J2000"; - SpiceChar * abcorr = "NONE"; - - SpiceDouble state [6]; - SpiceDouble lt; - - /. - Retrieve the vector from the Sun to the Moon in the J2000 - frame, without aberration correction. - ./ - spkez_c ( targ, et, ref, abcorr, obs, state, < ); - - /. - Calculate the scalar range rate corresponding the - 'state' vector. - ./ - - *value = dvnorm_( state ); - - return; - } - - - - /. - -Procedure gfdecrx - ./ - - void gfdecrx ( void ( * udfunc ) ( SpiceDouble et, - SpiceDouble * value ), - SpiceDouble et, - SpiceBoolean * isdecr ) - - /. - -Abstract - - User defined function to detect if the function derivative - is negative (the function is decreasing) at TDB time 'et'. - ./ - { - - SpiceDouble dt = 10.; - - /. - Determine if "udfunc" is decreasing at 'et'. - - uddc_c - the GF function to determine if - the derivative of the user defined - function is negative at 'et'. - - uddf_c - the SPICE function to numerically calculate the - derivative of 'udfunc' at 'et' for the - interval [et-dt, et+dt]. - ./ - - uddc_c( udfunc, et, dt, isdecr ); - - return; - } - - - The program outputs: - - Relation condition: = - Start time, drdt = 2007-JAN-02 00:35:19.574 - Stop time, drdt = 2007-JAN-02 00:35:19.574 - Start time, drdt = 2007-JAN-19 22:04:54.899 - Stop time, drdt = 2007-JAN-19 22:04:54.899 - Start time, drdt = 2007-FEB-01 23:30:13.428 - Stop time, drdt = 2007-FEB-01 23:30:13.428 - Start time, drdt = 2007-FEB-17 11:10:46.540 - Stop time, drdt = 2007-FEB-17 11:10:46.540 - Start time, drdt = 2007-MAR-04 15:50:19.929 - Stop time, drdt = 2007-MAR-04 15:50:19.929 - Start time, drdt = 2007-MAR-18 09:59:05.959 - Stop time, drdt = 2007-MAR-18 09:59:05.959 - - Relation condition: < - Start time, drdt = 2007-JAN-02 00:35:19.574 - Stop time, drdt = 2007-JAN-19 22:04:54.899 - Start time, drdt = 2007-FEB-01 23:30:13.428 - Stop time, drdt = 2007-FEB-17 11:10:46.540 - Start time, drdt = 2007-MAR-04 15:50:19.929 - Stop time, drdt = 2007-MAR-18 09:59:05.959 - - Relation condition: > - Start time, drdt = 2007-JAN-01 00:00:00.000 - Stop time, drdt = 2007-JAN-02 00:35:19.574 - Start time, drdt = 2007-JAN-19 22:04:54.899 - Stop time, drdt = 2007-FEB-01 23:30:13.428 - Start time, drdt = 2007-FEB-17 11:10:46.540 - Stop time, drdt = 2007-MAR-04 15:50:19.929 - Start time, drdt = 2007-MAR-18 09:59:05.959 - Stop time, drdt = 2007-APR-01 00:00:00.000 - - Relation condition: LOCMIN - Start time, drdt = 2007-JAN-11 07:03:58.988 - Stop time, drdt = 2007-JAN-11 07:03:58.988 - Start time, drdt = 2007-FEB-10 06:26:15.439 - Stop time, drdt = 2007-FEB-10 06:26:15.439 - Start time, drdt = 2007-MAR-12 03:28:36.404 - Stop time, drdt = 2007-MAR-12 03:28:36.404 - - Relation condition: ABSMIN - Start time, drdt = 2007-JAN-11 07:03:58.988 - Stop time, drdt = 2007-JAN-11 07:03:58.988 - - Relation condition: LOCMAX - Start time, drdt = 2007-JAN-26 02:27:33.766 - Stop time, drdt = 2007-JAN-26 02:27:33.766 - Start time, drdt = 2007-FEB-24 09:35:07.816 - Stop time, drdt = 2007-FEB-24 09:35:07.816 - Start time, drdt = 2007-MAR-25 17:26:56.150 - Stop time, drdt = 2007-MAR-25 17:26:56.150 - - Relation condition: ABSMAX - Start time, drdt = 2007-MAR-25 17:26:56.150 - Stop time, drdt = 2007-MAR-25 17:26:56.150 - --Restrictions - - 1) Any kernel files required by this routine must be loaded - before this routine is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 22-FEB-2010 (EDW) - --Index_Entries - - GF user defined scalar function search - --& -*/ - - { /* Begin gfuds_c */ - - /* - Local variables - */ - - doublereal * work; - - static SpiceInt nw = SPICE_GF_NWMAX; - - SpiceInt nBytes; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "gfuds_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "gfuds_c", SPICE_DP, cnfine, result ); - - /* - Initialize the input cells if necessary. - */ - CELLINIT2 ( cnfine, result ); - - /* - Check the other input strings to make sure each pointer is non-null - and each string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gfuds_c", relate ); - - /* - Store the input function pointers so these functions can be - called by the GF adapters. - */ - zzadsave_c ( UDFUNC, (void *)(udfunc) ); - zzadsave_c ( UDQDEC, (void *)(udqdec) ); - - /* - Check the workspace size; some mallocs have a violent - dislike for negative allocation amounts. To be safe, - rule out a count of zero intervals as well. - */ - - if ( nintvls < 1 ) - { - setmsg_c ( "The specified workspace interval count # was " - "less than the minimum allowed value of one (1)." ); - errint_c ( "#", nintvls ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "gfuds_c" ); - return; - } - - - /* - Allocate the workspace. 'nintvls' indicates the maximum number of - intervals returned in 'result'. An interval consists of - two values. - */ - - nintvls = 2 * nintvls; - - nBytes = (nintvls + SPICE_CELL_CTRLSZ ) * nw * sizeof(SpiceDouble); - - work = (doublereal *) alloc_SpiceMemory( nBytes ); - - if ( !work ) - { - setmsg_c ( "Workspace allocation of # bytes failed due to " - "malloc failure" ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "gfuds_c" ); - return; - } - - - /* - Let the f2c'd routine do the work. - - We pass the adapter functions, not those provided as inputs, - to the f2c'd routine: - - zzadfunc_c adapter for udfunc - zzadqdec_c '' udqdec - - */ - - (void) gfuds_( ( U_fp ) zzadfunc_c, - ( U_fp ) zzadqdec_c, - ( char * ) relate, - ( doublereal * ) &refval, - ( doublereal * ) &adjust, - ( doublereal * ) &step, - ( doublereal * ) (cnfine->base), - ( integer * ) &nintvls, - ( integer * ) &nw, - ( doublereal * ) work, - ( doublereal * ) (result->base), - ( ftnlen ) strlen(relate) ); - - - /* - Always free dynamically allocated memory. - */ - free_SpiceMemory( work ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ); - } - - ALLOC_CHECK; - - chkout_c ( "gfuds_c" ); - - } /* End gfuds_c */ diff --git a/ext/spice/src/cspice/gipool_c.c b/ext/spice/src/cspice/gipool_c.c deleted file mode 100644 index f351b67612..0000000000 --- a/ext/spice/src/cspice/gipool_c.c +++ /dev/null @@ -1,306 +0,0 @@ -/* - --Procedure gipool_c (Get integers from the kernel pool) - --Abstract - - Return the integer value of a kernel variable from the - kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void gipool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceInt * ivals, - SpiceBoolean * found ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the variable whose value is to be returned. - start I Which component to start retrieving for name - room I The largest number of values to return. - n O Number of values returned for name. - ivals O Values associated with name. - found O True if variable is in pool. - --Detailed_Input - - name is the name of the variable whose values are to be - returned. If the variable is not in the pool with - numeric type, found will be SPICEFALSE. - - start is the index of the first component of name to return. - The index follows the C convention of being 0 based. - If start is less than 0, it will be treated as 0. If - start is greater than the total number of components - available for name, no values will be returned (n will - be set to zero). However, found will still be set to - SPICETRUE - - room is the maximum number of components that should be - returned for this variable. (Usually it is the amount - of room available in the array ivals). If room is - less than 1 the error SPICE(BADARRAYSIZE) will be - signaled. - --Detailed_Output - - n is the number of values associated with name that - are returned. It will always be less than or equal - to room. - - If name is not in the pool with numeric type, no value - is given to n. - - ivals is the array of values associated with name. - If name is not in the pool with numeric type, no - values are given to the elements of ivals. - - found is SPICETRUE if the variable is in the pool and has - numeric type, SPICEFALSE if it is not. - --Parameters - - None. - --Exceptions - - 1) If the value of room is less than one the error - SPICE(BADARRAYSIZE) is signaled. - - 2) If a value requested is outside the valid range - of integers, the error SPICE(INTOUTOFRANGE) is signaled. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 4) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled. - --Files - - None. - --Particulars - - This routine provides the user interface for retrieving - integer data stored in the kernel pool. This interface - allows you to retrieve the data associated with a variable - in multiple accesses. Under some circumstances this alleviates - the problem of having to know in advance the maximum amount - of space needed to accommodate all kernel variables. - - However, this method of access does come with a price. It is - always more efficient to retrieve all of the data associated - with a kernel pool data in one call than it is to retrieve - it in sections. - - See also the entry points gdpool_c and gcpool_c. - --Examples - - - The following code fragment demonstrates how the data stored - in a kernel pool variable can be retrieved in pieces. Using the - kernel "test.ker" which contains - - \begindata - - CTEST_VAL = ('LARRY', 'MOE', 'CURLY' ) - - ITEST_VAL = ( 3141, 186, 282 ) - - DTEST_VAL = ( 3.1415, 186.282, .0175 ) - - - The program... - - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - #define NUMVALS 2 - - - void main() - { - - SpiceInt n; - SpiceInt i; - - SpiceBoolean found; - - SpiceInt ivals[NUMVALS]; - - - ldpool_c ( "test.ker" ); - - - /. Is data available by that name. ./ - - gipool_c ( "ITEST_VAL", 0, NUMVALS, &n, ivals, &found ); - - - /. If so, show me the values. ./ - - if ( !found ) - { - printf ( "No int data available for ITEST_VAL.\n" ); - } - - else - { - - for ( i=0; i < NUMVALS; i++ ) - { - gipool_c ( "ITEST_VAL", 1, NUMVALS, &n, ivals, &found ); - - printf ( "%d \n", ivals[i] ); - } - - } - - exit(0); - } - - - Output should be - - 186 - 282 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.1.0 22-JUN-1999 (EDW) - - Re-implemented routine without dynamically allocated, temporary - strings. - - Added local variable to return boolean/logical values. This - fix allows the routine to function if int and long are different - sizes. - - -CSPICE Version 2.0.1 08-FEB-1998 (EDW) - - The start parameter is now zero based as per C convention. - - -CSPICE Version 1.0.0, 6-JAN-1998 (EDW) - - Replaced example routine. Included the data for a test kernel. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - RETURN the integer value of a pooled kernel variable - --& -*/ - -{ /* Begin gipool_c */ - - /* - Local variables - */ - logical yes; - - - /* The index is zero based here but not in gipool_. */ - start = start + 1; - - - /* - Participate in error handling - */ - - chkin_c ( "gipool_c"); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "gipool_c", name ); - - - /* - Call the f2c'd routine - */ - - gipool_( ( char * ) name, - ( integer * ) &start, - ( integer * ) &room, - ( integer * ) n, - ( integer * ) ivals, - ( logical * ) &yes, - ( ftnlen ) strlen(name) ); - - - /* Cast back to a SpiceBoolean. */ - *found = yes; - - - chkout_c ( "gipool_c"); - - -} /* End gipool_c */ diff --git a/ext/spice/src/cspice/gnpool_c.c b/ext/spice/src/cspice/gnpool_c.c deleted file mode 100644 index 86b2c74a13..0000000000 --- a/ext/spice/src/cspice/gnpool_c.c +++ /dev/null @@ -1,380 +0,0 @@ -/* - --Procedure gnpool_c (Get names of kernel pool variables) - --Abstract - - Return names of kernel variables matching a specified template. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void gnpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * kvars, - SpiceBoolean * found ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Template that names should match. - start I Index of first matching name to retrieve. - room I The largest number of values to return. - lenout I Length of strings in output array kvars. - n O Number of values returned for name. - kvars O Kernel pool variables whose names match name. - found O True if there is at least one match. - --Detailed_Input - - name is a matchi_c template which will be used when searching - for variable names in the kernel pool. The characters - '*' and '%' are used for the wild string and wild - characters respectively. For details of string - pattern matching see the header of the routine matchi_c. - 'name' is restricted to a length of 32 characters or less. - - start is the index of the first variable name to return that - matches the name template. The matching names are - assigned indices ranging from 0 to NVAR-1, where NVAR is - the number of matching names. The index of a name does - not indicate how it compares alphabetically to another - name. - - If start is less than 0, it will be treated as 0. If - start is greater than the total number of matching - variable names, no values will be returned and N will - be set to zero. However, found will still be set to - SPICETRUE. - - - room is the maximum number of variable names that should - be returned for this template. If room is less than 1 - the error SPICE(BADARRAYSIZE) will be signaled. - - lenout is the length of strings in the output array kvars. This - length includes room for the terminating null in each - string. To ensure that the output names are not - truncated, lenout should be at least 33. - - --Detailed_Output - - n is the number of variable names matching name that are - returned. It will always be less than or equal to - room. - - If no variable names match name, n is set to zero. - - - kvars is an array of kernel pool variables whose names match - the template name and which have indices ranging from - start to start+n-1. - - Note that in general the names returned in kvars are - not sorted. - - If no variables match name, no values are assigned to - the elements of kvars. - - If the length of kvars is less than the length of the - variable names, the values returned will be truncated - on the right. - - The declaration of kvars should be equivalent to - - SpiceChar kvars [room][lenout]; - - - found is SPICETRUE if the some variable name in the kernel pool - matches name, SPICEFALSE if it is not. - --Parameters - - None. - --Exceptions - - 1) If the value of room is less than one, the error - SPICE(BADARRAYSIZE) is signaled. - - 2) If kvars has declared length less than the size (including - terminating null character) of a name to be returned, the name - will be truncated on the right. The parameter MAXCHR sets - the maximum stored size of string variables. - - 3) If either the input or output string pointers are null, the error - SPICE(NULLPOINTER) will be signaled. - - 4) If the input string has length zero, the error SPICE(EMPTYSTRING) - will be signaled. - - 5) The caller must pass a value indicating the length of the output - string. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 6) The error 'SPICE(BADVARNAME)' signals if the kernel pool - variable name length exceeds 32. - --Files - - None. - --Particulars - - This routine provides the user interface for retrieving the names - of kernel pool variables. This interface allows you to retrieve - the names matching a template via multiple accesses. Under some - circumstances this alleviates the problem of having to know in - advance the maximum amount of space needed to accommodate all - matching names. - - However, this method of access does come with a price. It is - always more efficient to retrieve all of the data associated with - a kernel pool variable in one call than it is to retrieve it in - sections. The parameter MAXVAR defines the upper bound on the - number of possible matching names. - --Examples - - - The following code demonstrates how the names of kernel pool - variables matching a template can be retrieved in pieces. - - #include - #include "SpiceUsr.h" - - int main() - { - - #define ROOM 3 - #define LNSIZE 81 - #define TEMPLATE "BODY599*" - - SpiceBoolean found; - - SpiceChar kvars [ROOM][LNSIZE]; - - SpiceInt i; - SpiceInt n; - SpiceInt start; - - /. - Load the data in the file "typical.ker" into the kernel pool. - ./ - ldpool_c ( "typical.ker" ); - - /. - Print the names of kernel variables that match TEMPLATE. - ./ - - start = 0; - - gnpool_c ( TEMPLATE, start, ROOM, LNSIZE, &n, kvars, &found ); - - if ( !found ) - { - printf ( "There are no matching variables in the " - "kernel pool\n" ); - } - else - { - printf ( "Kernel pool variables:\n" - "\n" ); - - for ( i = 0; i < n; i++ ) - { - printf ( " %s\n", kvars[i] ); - } - - while ( n == ROOM ) - { - start += n; - - gnpool_c ( TEMPLATE, start, ROOM, LNSIZE, - &n, kvars, &found ); - - for ( i = 0; i < n; i++ ) - { - printf ( " %s\n", kvars[i] ); - } - } - } - /. - This is the end of the if block following the first gnpool_c - call. - ./ - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.1, 10-FEB-2010 (EDW) - - Added mention of the restriction on kernel pool variable - names to 32 characters or less. - - -CSPICE Version 1.1.0, 18-MAY-2001 (WLT) - - Added a cast to (char *) in the call to F2C_ConvertStrArr - - -CSPICE Version 1.0.0, 08-JUN-1999 (NJB) (WLT) - --Index_Entries - - return names of kernel pool variables matching a template - --& -*/ - -{ /* Begin gnpool_c */ - - - - /* - Local variables - */ - SpiceChar * endptr; - SpiceChar * strptr; - - SpiceInt fstart; - SpiceInt i; - - logical fnd; - - - - /* - Participate in error tracing. - */ - chkin_c ( "gnpool_c" ); - - - /* - Check the input string to make sure the pointer is non-null and - the string is non-empty. - */ - CHKFSTR ( CHK_STANDARD, "gnpool_c", name ); - - - /* - Check the output string array to make sure the pointer is non-null - and that each string has room for at least one character plus a null - terminator. - */ - CHKOSTR ( CHK_STANDARD, "gnpool_c", kvars, lenout ); - - - /* - Call the f2c'd routine. First map the start index to the Fortran - style range of 1 : #of matching strings. - */ - - fstart = start + 1; - - gnpool_ ( ( char * ) name, - ( integer * ) &fstart, - ( integer * ) &room, - ( integer * ) n, - ( char * ) kvars, - ( logical * ) &fnd, - ( ftnlen ) strlen(name), - ( ftnlen ) lenout-1 ); - - /* - Convert the output array from Fortran to C style. - */ - F2C_ConvertStrArr ( *n, lenout, (char * ) kvars ); - - /* - Eliminate any trailing white space left by F2C_ConvertStrArr. - */ - - for ( i = 0; i < *n; i++ ) - { - strptr = ( (SpiceChar *) kvars ) + i*lenout; - endptr = strptr + lenout - 2; - - if ( *endptr == BLANK ) - { - /* - The last data character in this string is blank, so there is - trailing white space to remove. Treat the first lenout-1 - characters of the string as a Fortran string to be converted. - The length expected by F2C_ConvertStr is the C string length, - so we pass in lenout. - */ - F2C_ConvertStr ( lenout, strptr ); - } - } - - /* - Set the SpiceBoolean found flag. - */ - - *found = fnd; - - - chkout_c ( "gnpool_c" ); - -} /* End gnpool_c */ diff --git a/ext/spice/src/cspice/h_abs.c b/ext/spice/src/cspice/h_abs.c deleted file mode 100644 index 73b82151ac..0000000000 --- a/ext/spice/src/cspice/h_abs.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint h_abs(x) shortint *x; -#else -shortint h_abs(shortint *x) -#endif -{ -if(*x >= 0) - return(*x); -return(- *x); -} diff --git a/ext/spice/src/cspice/h_dim.c b/ext/spice/src/cspice/h_dim.c deleted file mode 100644 index ceff660e26..0000000000 --- a/ext/spice/src/cspice/h_dim.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint h_dim(a,b) shortint *a, *b; -#else -shortint h_dim(shortint *a, shortint *b) -#endif -{ -return( *a > *b ? *a - *b : 0); -} diff --git a/ext/spice/src/cspice/h_dnnt.c b/ext/spice/src/cspice/h_dnnt.c deleted file mode 100644 index 6ffae9877b..0000000000 --- a/ext/spice/src/cspice/h_dnnt.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -shortint h_dnnt(x) doublereal *x; -#else -#undef abs -#include "math.h" -shortint h_dnnt(doublereal *x) -#endif -{ -return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x)); -} diff --git a/ext/spice/src/cspice/h_indx.c b/ext/spice/src/cspice/h_indx.c deleted file mode 100644 index a211cc7fa0..0000000000 --- a/ext/spice/src/cspice/h_indx.c +++ /dev/null @@ -1,26 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; -#else -shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -ftnlen i, n; -char *s, *t, *bend; - -n = la - lb + 1; -bend = b + lb; - -for(i = 0 ; i < n ; ++i) - { - s = a + i; - t = b; - while(t < bend) - if(*s++ != *t++) - goto no; - return((shortint)i+1); - no: ; - } -return(0); -} diff --git a/ext/spice/src/cspice/h_len.c b/ext/spice/src/cspice/h_len.c deleted file mode 100644 index 00a2151bfa..0000000000 --- a/ext/spice/src/cspice/h_len.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint h_len(s, n) char *s; ftnlen n; -#else -shortint h_len(char *s, ftnlen n) -#endif -{ -return(n); -} diff --git a/ext/spice/src/cspice/h_mod.c b/ext/spice/src/cspice/h_mod.c deleted file mode 100644 index 43431c1c50..0000000000 --- a/ext/spice/src/cspice/h_mod.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint h_mod(a,b) short *a, *b; -#else -shortint h_mod(short *a, short *b) -#endif -{ -return( *a % *b); -} diff --git a/ext/spice/src/cspice/h_nint.c b/ext/spice/src/cspice/h_nint.c deleted file mode 100644 index 1cd87df34f..0000000000 --- a/ext/spice/src/cspice/h_nint.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -shortint h_nint(x) real *x; -#else -#undef abs -#include "math.h" -shortint h_nint(real *x) -#endif -{ -return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x)); -} diff --git a/ext/spice/src/cspice/h_sign.c b/ext/spice/src/cspice/h_sign.c deleted file mode 100644 index 7b06c157a7..0000000000 --- a/ext/spice/src/cspice/h_sign.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint h_sign(a,b) shortint *a, *b; -#else -shortint h_sign(shortint *a, shortint *b) -#endif -{ -shortint x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); -} diff --git a/ext/spice/src/cspice/halfpi.c b/ext/spice/src/cspice/halfpi.c deleted file mode 100644 index 7c420d4358..0000000000 --- a/ext/spice/src/cspice/halfpi.c +++ /dev/null @@ -1,175 +0,0 @@ -/* halfpi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HALFPI ( Half the value of pi ) */ -doublereal halfpi_(void) -{ - /* Initialized data */ - - static doublereal value = 0.; - - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double acos(doublereal); - -/* $ Abstract */ - -/* Return half the value of pi (the ratio of the circumference of */ -/* a circle to its diameter). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns half the value of pi. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns half the value of pi (the ratio of */ -/* a circle's circumference to its diameter), determined by */ -/* the ACOS function. That is, */ - -/* HALFPI = ACOS ( -1.D0 ) * 0.5D0 */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The first time the function is referenced, the value is computed */ -/* as shown above. The value is saved, and returned directly upon */ -/* subsequent reference. */ - -/* $ Examples */ - -/* The subroutine shown below illustrates the use of HALFPI. */ - -/* SUBROUTINE BFTRAN ( RA, DEC, W, TIPM ) */ - -/* C */ -/* C Compute the transformation from inertial to body */ -/* C fixed coordinates, given the directions of the north */ -/* C pole and prime meridian of the body. */ -/* C */ -/* DOUBLE PRECISION RA */ -/* DOUBLE PRECISION DEC */ -/* DOUBLE PRECISION W */ -/* DOUBLE PRECISION TIPM ( 3,3 ) */ - -/* C */ -/* SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION HALFPI */ - -/* C */ -/* C The transformation is defined by the compund */ -/* C rotation */ -/* C */ -/* C [W] [pi/2 - Dec] [RA + pi/2] */ -/* C 3 1 3 */ -/* C */ -/* CALL ROTATE ( RA + HALFPI(), 3, TIPM) */ -/* CALL ROTMAT (TIPM, HALFPI() - DEC, 1, TIPM) */ -/* CALL ROTMAT (TIPM, W, 3, TIPM) */ - -/* RETURN */ -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* half the value of pi */ - -/* -& */ - -/* Local variables */ - - -/* Initial values */ - - -/* What is there to say? */ - - if (value == 0.) { - value = acos(-1.) * .5; - } - ret_val = value; - return ret_val; -} /* halfpi_ */ - diff --git a/ext/spice/src/cspice/halfpi_c.c b/ext/spice/src/cspice/halfpi_c.c deleted file mode 100644 index f311158e30..0000000000 --- a/ext/spice/src/cspice/halfpi_c.c +++ /dev/null @@ -1,163 +0,0 @@ -/* - --Procedure halfpi_c ( Half the value of pi ) - --Abstract - - Return half the value of pi (the ratio of the circumference of - a circle to its diameter). - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble halfpi_c ( void ) - -/* - --Brief_I/O - - The function returns half the value of pi. - --Detailed_Input - - None. - --Detailed_Output - - The function returns half the value of pi (the ratio of - a circle's circumference to its diameter), determined by - the ACOS function. That is, - - halfpi_c = acos ( -1.0 ) * 0.50 - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The first time the function is referenced, the value is computed - as shown above. The value is saved, and returned directly upon - subsequent reference. - --Examples - - The subroutine shown below illustrates the use of halfpi_c. - - void bftran ( ra, dec, w, tipm ) - { - - /. - Compute the transformation from inertial to body - fixed coordinates, given the directions of the north - pole and prime meridian of the body. - ./ - - SpiceDouble ra; - SpiceDouble dec; - SpiceDouble w; - SpiceDouble tipm [3][3]; - - - /. - The transformation is defined by the compund - rotation - - [W] [pi/2 - Dec] [RA + pi/2] - 3 1 3 - ./ - - - rotate_c ( ra + halfpi_c(), 3, tipm ); - rotmat_c ( tipm, halfpi_c() - dec, 1, tipm ); - rotmat_c ( tipm, w, 3, tipm ); - - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - half the value of pi - --& -*/ - -{ /* Begin halfpi_c */ - - /* - Local Variables - */ - - static SpiceDouble value = 0.; - - - if ( value == 0.) - { - value = 0.5 * acos( -1. ); - } - - - return value; - - -} /* End halfpi_c */ diff --git a/ext/spice/src/cspice/hl_ge.c b/ext/spice/src/cspice/hl_ge.c deleted file mode 100644 index 4c29527065..0000000000 --- a/ext/spice/src/cspice/hl_ge.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) >= 0); -} diff --git a/ext/spice/src/cspice/hl_gt.c b/ext/spice/src/cspice/hl_gt.c deleted file mode 100644 index c4f345a085..0000000000 --- a/ext/spice/src/cspice/hl_gt.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) > 0); -} diff --git a/ext/spice/src/cspice/hl_le.c b/ext/spice/src/cspice/hl_le.c deleted file mode 100644 index a9cce596c7..0000000000 --- a/ext/spice/src/cspice/hl_le.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) <= 0); -} diff --git a/ext/spice/src/cspice/hl_lt.c b/ext/spice/src/cspice/hl_lt.c deleted file mode 100644 index 162d919c3b..0000000000 --- a/ext/spice/src/cspice/hl_lt.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) < 0); -} diff --git a/ext/spice/src/cspice/hrmesp.c b/ext/spice/src/cspice/hrmesp.c deleted file mode 100644 index 234adbc8af..0000000000 --- a/ext/spice/src/cspice/hrmesp.c +++ /dev/null @@ -1,484 +0,0 @@ -/* hrmesp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HRMESP ( Hermite polynomial interpolation, equal spacing ) */ -/* Subroutine */ int hrmesp_(integer *n, doublereal *first, doublereal *step, - doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, - doublereal *df) -{ - /* System generated locals */ - integer yvals_dim1, work_dim1, work_offset, i__1, i__2, i__3, i__4, i__5, - i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal temp; - integer this__, prev, next; - doublereal newx; - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom, c1, c2, xi; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal xij; - -/* $ Abstract */ - -/* Evaluate, at a specified point, an Hermite interpolating */ -/* polynomial for a specified set of coordinate pairs whose */ -/* abscissas are equally spaced. */ - -/* $ 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 */ - -/* INTERPOLATION */ -/* POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of points defining the polynomial. */ -/* FIRST I First abscissa value. */ -/* STEP I Step size. */ -/* YVALS I Ordinate and derivative values. */ -/* X I Point at which to interpolate the polynomial. */ -/* WORK I-O Work space array. */ -/* F O Interpolated function value at X. */ -/* DF O Interpolated function's derivative at X. */ - -/* $ Detailed_Input */ - -/* N is the number of points defining the polynomial. */ -/* The array YVALS contains 2*N elements. */ - -/* FIRST, */ -/* STEP are, respectively, a starting abscissa value and a */ -/* step size that define the set of abscissa values */ - -/* FIRST + (I-1) * STEP, I = 1, ..., N */ - -/* STEP must be non-zero. */ - - -/* YVALS is an array of length 2*N containing ordinate and */ -/* derivative values for each point in the domain */ -/* defined by FIRST, STEP, and N. The elements */ - -/* YVALS( 2*I - 1 ) */ -/* YVALS( 2*I ) */ - -/* give the value and first derivative of the output */ -/* polynomial at the abscissa value */ - -/* FIRST + I * STEP */ - -/* where I ranges from 1 to N. */ - - -/* WORK is a work space array. It is used by this routine */ -/* as a scratch area to hold intermediate results. */ - - -/* X is the abscissa value at which the interpolating */ -/* polynomial and its derivative are to be evaluated. */ - -/* $ Detailed_Output */ - -/* F, */ -/* DF are the value and derivative at X of the unique */ -/* polynomial of degree 2N-1 that fits the points and */ -/* derivatives defined by FIRST, STEP, and YVALS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If STEP is zero, the error SPICE(INVALIDSTEPSIZE) will be */ -/* signaled. */ - -/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */ -/* signaled. */ - -/* 3) This routine does not attempt to ward off or diagnose */ -/* arithmetic overflows. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of this routine must choose the number of points to use */ -/* in their interpolation method. The authors of Reference [1] have */ -/* this to say on the topic: */ - -/* Unless there is solid evidence that the interpolating function */ -/* is close in form to the true function f, it is a good idea to */ -/* be cautious about high-order interpolation. We */ -/* enthusiastically endorse interpolations with 3 or 4 points, we */ -/* are perhaps tolerant of 5 or 6; but we rarely go higher than */ -/* that unless there is quite rigorous monitoring of estimated */ -/* errors. */ - -/* The same authors offer this warning on the use of the */ -/* interpolating function for extrapolation: */ - -/* ...the dangers of extrapolation cannot be overemphasized: */ -/* An interpolating function, which is perforce an extrapolating */ -/* function, will typically go berserk when the argument x is */ -/* outside the range of tabulated values by more than the typical */ -/* spacing of tabulated points. */ - -/* $ Examples */ - - -/* 1) Fit a 7th degree polynomial through the points ( x, y, y' ) */ - -/* ( -1, 6, 3 ) */ -/* ( 1, 8, 11 ) */ -/* ( 3, 2210, 5115 ) */ -/* ( 5, 78180, 109395 ) */ - -/* and evaluate this polynomial at x = 2. */ - - -/* PROGRAM TEST_HRMINT */ - -/* DOUBLE PRECISION ANSWER */ -/* DOUBLE PRECISION DERIV */ -/* DOUBLE PRECISION FIRST */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION YVALS (8) */ -/* DOUBLE PRECISION WORK (8,2) */ -/* INTEGER N */ - - -/* N = 4 */ - -/* YVALS(1) = 6.D0 */ -/* YVALS(2) = 3.D0 */ -/* YVALS(3) = 8.D0 */ -/* YVALS(4) = 11.D0 */ -/* YVALS(5) = 2210.D0 */ -/* YVALS(6) = 5115.D0 */ -/* YVALS(7) = 78180.D0 */ -/* YVALS(8) = 109395.D0 */ - -/* FIRST = -1.D0 */ -/* STEP = 2.D0 */ - -/* CALL HRMESP ( N, FIRST, STEP, YVALS, */ -/* . 2.D0, WORK, ANSWER, DERIV ) */ - -/* WRITE (*,*) 'ANSWER = ', ANSWER */ -/* WRITE (*,*) 'DERIV = ', DERIV */ -/* END */ - - -/* The returned value of ANSWER should be 141.D0, and the returned */ -/* derivative value should be 456.D0, since the unique 7th degree */ -/* polynomial that fits these constraints is */ - -/* 7 2 */ -/* f(x) = x + 2x + 5 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] "Numerical Recipes---The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* William T. Vetterling (see sections 3.0 and 3.1). */ - -/* [2] "Elementary Numerical Analysis---An Algorithmic Approach" */ -/* by S. D. Conte and Carl de Boor. See p. 64. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 31-JAN-2002 (EDW) */ - -/* Added the use of DBLE to convert integer values */ -/* used in DOUBLE PRECISION calculations. */ - -/* - SPICELIB Version 1.1.0, 28-DEC-2001 (NJB) */ - -/* Blanks following final newline were truncated to */ -/* suppress compilation warnings on the SGI-N32 platform. */ - -/* - SPICELIB Version 1.0.0, 01-MAR-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* interpolate function using Hermite polynomial */ -/* Hermite interpolation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check in only if an error is detected. */ - - /* Parameter adjustments */ - work_dim1 = *n << 1; - work_offset = work_dim1 + 1; - yvals_dim1 = *n << 1; - - /* Function Body */ - if (return_()) { - return 0; - } - -/* No data, no interpolation. */ - - if (*n < 1) { - chkin_("HRMESP", (ftnlen)6); - setmsg_("Array size must be positive; was #.", (ftnlen)35); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("HRMESP", (ftnlen)6); - return 0; - } - -/* The step size must be non-zero. */ - - if (*step == 0.) { - chkin_("HRMESP", (ftnlen)6); - setmsg_("Step size was zero.", (ftnlen)19); - sigerr_("SPICE(INVALIDSTEPSIZE)", (ftnlen)22); - chkout_("HRMESP", (ftnlen)6); - return 0; - } - -/* We can simplify the interpolation problem by shifting */ -/* and scaling the abscissa values so that they start at 1 */ -/* and are separated by a unit step. All we need to do here is */ -/* shift and scale X. */ - - newx = (*x - *first) / *step + 1.; - -/* For consistency with our scaled horizontal axis, we'll have */ -/* scale our local derivative values by STEP, and scale our final */ -/* computed derivative by 1/STEP. */ - -/* Copy the input array into WORK. Scale the derivatives at this */ -/* step. After this, the first column of WORK represents the first */ -/* column of our triangular interpolation table. */ - - i__1 = (*n << 1) - 1; - for (i__ = 1; i__ <= i__1; i__ += 2) { - work[(i__2 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", (ftnlen)327)] = - yvals[(i__3 = i__ - 1) < yvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("yvals", i__3, "hrmesp_", (ftnlen)327)]; - } - i__1 = *n << 1; - for (i__ = 2; i__ <= i__1; i__ += 2) { - work[(i__2 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", (ftnlen)331)] = - yvals[(i__3 = i__ - 1) < yvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("yvals", i__3, "hrmesp_", (ftnlen)331)] * *step; - } - -/* Compute the second column of the interpolation table: this */ -/* consists of the N-1 values obtained by evaluating the first-degree */ -/* interpolants at NEWX. We'll also evaluate the derivatives of */ -/* these interpolants at NEWX and save the results in the second */ -/* column of WORK. Because the derivative computations depend on the */ -/* function computations from the previous column in the */ -/* interpolation table, and because the function interpolation */ -/* overwrites the previous column of interpolated function values, */ -/* we must evalute the derivatives first. */ - - i__1 = *n - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - c1 = (doublereal) (i__ + 1) - newx; - c2 = newx - (doublereal) i__; - -/* The second column of WORK contains interpolated derivative */ -/* values. */ - -/* The odd-indexed interpolated derivatives are simply the input */ -/* derivatives, after scaling. */ - - prev = (i__ << 1) - 1; - this__ = prev + 1; - next = this__ + 1; - work[(i__2 = prev + (work_dim1 << 1) - work_offset) < work_dim1 << 1 - && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", (ftnlen) - 363)] = work[(i__3 = this__ + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "hrmesp_", (ftnlen)363)]; - -/* The even-indexed interpolated derivatives are the slopes of */ -/* the linear interpolating polynomials for adjacent input */ -/* abscissa/ordinate pairs. No scaling is needed here. */ - - work[(i__2 = this__ + (work_dim1 << 1) - work_offset) < work_dim1 << - 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", ( - ftnlen)370)] = work[(i__3 = next + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "hrmesp_", (ftnlen)370)] - work[(i__4 = prev + work_dim1 - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge( - "work", i__4, "hrmesp_", (ftnlen)370)]; - -/* The first column of WORK contains interpolated function values. */ -/* The odd-indexed entries are the linear Taylor polynomials, */ -/* each input abscissa value, evaluated at NEWX. */ - - temp = work[(i__2 = this__ + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", ( - ftnlen)377)] * (newx - (doublereal) i__) + work[(i__3 = prev - + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= i__3 ? - i__3 : s_rnge("work", i__3, "hrmesp_", (ftnlen)377)]; - work[(i__2 = this__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", (ftnlen)380)] - = c1 * work[(i__3 = prev + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "hrmesp_", (ftnlen)380)] + c2 * work[(i__4 = next + work_dim1 - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge( - "work", i__4, "hrmesp_", (ftnlen)380)]; - work[(i__2 = prev + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", (ftnlen)383)] = - temp; - } - -/* The last column entries were not computed by the preceding loop; */ -/* compute them now. */ - - work[(i__1 = (*n << 1) - 1 + (work_dim1 << 1) - work_offset) < work_dim1 - << 1 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmesp_", ( - ftnlen)392)] = work[(i__2 = (*n << 1) + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrme" - "sp_", (ftnlen)392)]; - work[(i__1 = (*n << 1) - 1 + work_dim1 - work_offset) < work_dim1 << 1 && - 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmesp_", (ftnlen)393)] = - work[(i__2 = (*n << 1) + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmesp_", (ftnlen) - 393)] * (newx - *n) + work[(i__3 = (*n << 1) - 1 + work_dim1 - - work_offset) < work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", - i__3, "hrmesp_", (ftnlen)393)]; - -/* Compute columns 3 through 2*N of the table. */ - - i__1 = (*n << 1) - 1; - for (j = 2; j <= i__1; ++j) { - i__2 = (*n << 1) - j; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* In the theoretical construction of the interpolation table, */ -/* there are 2*N abscissa values, since each input abcissa */ -/* value occurs with multiplicity two. In this theoretical */ -/* construction, the Jth column of the interpolation table */ -/* contains results of evaluating interpolants that span J+1 */ -/* consecutive abscissa values. The indices XI and XIJ below */ -/* are used to pick the correct abscissa values out of this */ -/* sequence of 2*N values. */ - - xi = (doublereal) ((i__ + 1) / 2); - xij = (doublereal) ((i__ + j + 1) / 2); - c1 = xij - newx; - c2 = newx - xi; - denom = xij - xi; - -/* Compute the interpolated derivative at NEWX for the Ith */ -/* interpolant. This is the derivative with respect to NEWX of */ -/* the expression for the interpolated function value, which is */ -/* the second expression below. This derivative computation */ -/* is done first because it relies on the interpolated function */ -/* values from the previous column of the interpolation table. */ - -/* The derivative expression here corresponds to equation */ -/* 2.35 on page 64 in reference [2]. */ - - work[(i__3 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 << - 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "hrmesp_", ( - ftnlen)432)] = (c1 * work[(i__4 = i__ + (work_dim1 << 1) - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : - s_rnge("work", i__4, "hrmesp_", (ftnlen)432)] + c2 * work[ - (i__5 = i__ + 1 + (work_dim1 << 1) - work_offset) < - work_dim1 << 1 && 0 <= i__5 ? i__5 : s_rnge("work", i__5, - "hrmesp_", (ftnlen)432)] + (work[(i__6 = i__ + 1 + - work_dim1 - work_offset) < work_dim1 << 1 && 0 <= i__6 ? - i__6 : s_rnge("work", i__6, "hrmesp_", (ftnlen)432)] - - work[(i__7 = i__ + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__7 ? i__7 : s_rnge("work", i__7, "hrmesp_", ( - ftnlen)432)])) / denom; - -/* Compute the interpolated function value at NEWX for the Ith */ -/* interpolant. */ - - work[(i__3 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 - <= i__3 ? i__3 : s_rnge("work", i__3, "hrmesp_", (ftnlen) - 439)] = (c1 * work[(i__4 = i__ + work_dim1 - work_offset) - < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge("work", - i__4, "hrmesp_", (ftnlen)439)] + c2 * work[(i__5 = i__ + - 1 + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__5 ? i__5 : s_rnge("work", i__5, "hrmesp_", (ftnlen)439) - ]) / denom; - } - } - -/* Our interpolated function value is sitting in WORK(1,1) at this */ -/* point. The interpolated derivative is located in WORK(1,2). */ -/* We must undo the scaling of the derivative. We've already */ -/* checked that STEP is non-zero. */ - - *f = work[(i__1 = work_dim1 + 1 - work_offset) < work_dim1 << 1 && 0 <= - i__1 ? i__1 : s_rnge("work", i__1, "hrmesp_", (ftnlen)451)]; - *df = work[(i__1 = (work_dim1 << 1) + 1 - work_offset) < work_dim1 << 1 && - 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmesp_", (ftnlen)452)] - / *step; - return 0; -} /* hrmesp_ */ - diff --git a/ext/spice/src/cspice/hrmint.c b/ext/spice/src/cspice/hrmint.c deleted file mode 100644 index be4964d291..0000000000 --- a/ext/spice/src/cspice/hrmint.c +++ /dev/null @@ -1,486 +0,0 @@ -/* hrmint.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HRMINT ( Hermite polynomial interpolation ) */ -/* Subroutine */ int hrmint_(integer *n, doublereal *xvals, doublereal *yvals, - doublereal *x, doublereal *work, doublereal *f, doublereal *df) -{ - /* System generated locals */ - integer xvals_dim1, yvals_dim1, work_dim1, work_offset, i__1, i__2, i__3, - i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal temp; - integer this__, prev, next, i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal c1, c2; - integer xi; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer xij; - -/* $ Abstract */ - -/* Evaluate a Hermite interpolating polynomial at a specified */ -/* abscissa value. */ - -/* $ 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 */ - -/* INTERPOLATION */ -/* POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of points defining the polynomial. */ -/* XVALS I Abscissa values. */ -/* YVALS I Ordinate and derivative values. */ -/* X I Point at which to interpolate the polynomial. */ -/* WORK I-O Work space array. */ -/* F O Interpolated function value at X. */ -/* DF O Interpolated function's derivative at X. */ - -/* $ Detailed_Input */ - -/* N is the number of points defining the polynomial. */ -/* The arrays XVALS and YVALS contain N and 2*N */ -/* elements respectively. */ - -/* XVALS is an array of length N containing abscissa values. */ - -/* YVALS is an array of length 2*N containing ordinate and */ -/* derivative values for each point in the domain */ -/* defined by FIRST, STEP, and N. The elements */ - -/* YVALS( 2*I - 1 ) */ -/* YVALS( 2*I ) */ - -/* give the value and first derivative of the output */ -/* polynomial at the abscissa value */ - -/* XVALS(I) */ - -/* where I ranges from 1 to N. */ - - -/* WORK is a work space array. It is used by this routine */ -/* as a scratch area to hold intermediate results. */ - - -/* X is the abscissa value at which the interpolating */ -/* polynomial and its derivative are to be evaluated. */ - -/* $ Detailed_Output */ - -/* F, */ -/* DF are the value and derivative at X of the unique */ -/* polynomial of degree 2N-1 that fits the points and */ -/* derivatives defined by XVALS and YVALS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If two input abscissas are equal, the error */ -/* SPICE(DIVIDEBYZERO) will be signaled. */ - -/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */ -/* signaled. */ - -/* 3) This routine does not attempt to ward off or diagnose */ -/* arithmetic overflows. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of this routine must choose the number of points to use */ -/* in their interpolation method. The authors of Reference [1] have */ -/* this to say on the topic: */ - -/* Unless there is solid evidence that the interpolating function */ -/* is close in form to the true function f, it is a good idea to */ -/* be cautious about high-order interpolation. We */ -/* enthusiastically endorse interpolations with 3 or 4 points, we */ -/* are perhaps tolerant of 5 or 6; but we rarely go higher than */ -/* that unless there is quite rigorous monitoring of estimated */ -/* errors. */ - -/* The same authors offer this warning on the use of the */ -/* interpolating function for extrapolation: */ - -/* ...the dangers of extrapolation cannot be overemphasized: */ -/* An interpolating function, which is perforce an extrapolating */ -/* function, will typically go berserk when the argument x is */ -/* outside the range of tabulated values by more than the typical */ -/* spacing of tabulated points. */ - -/* $ Examples */ - -/* 1) Fit a 7th degree polynomial through the points ( x, y, y' ) */ - -/* ( -1, 6, 3 ) */ -/* ( 0, 5, 0 ) */ -/* ( 3, 2210, 5115 ) */ -/* ( 5, 78180, 109395 ) */ - -/* and evaluate this polynomial at x = 2. */ - - -/* PROGRAM TEST_HRMINT */ - -/* DOUBLE PRECISION ANSWER */ -/* DOUBLE PRECISION DERIV */ -/* DOUBLE PRECISION XVALS (4) */ -/* DOUBLE PRECISION YVALS (8) */ -/* DOUBLE PRECISION WORK (8,2) */ -/* INTEGER N */ - -/* N = 4 */ - -/* XVALS(1) = -1.D0 */ -/* XVALS(2) = 0.D0 */ -/* XVALS(3) = 3.D0 */ -/* XVALS(4) = 5.D0 */ - -/* YVALS(1) = 6.D0 */ -/* YVALS(2) = 3.D0 */ -/* YVALS(3) = 5.D0 */ -/* YVALS(4) = 0.D0 */ -/* YVALS(5) = 2210.D0 */ -/* YVALS(6) = 5115.D0 */ -/* YVALS(7) = 78180.D0 */ -/* YVALS(8) = 109395.D0 */ - -/* CALL HRMINT ( N, XVALS, YVALS, 2.D0, WORK, ANSWER, DERIV ) */ - -/* WRITE (*,*) 'ANSWER = ', ANSWER */ -/* WRITE (*,*) 'DERIV = ', DERIV */ -/* END */ - - -/* The returned value of ANSWER should be 141.D0, and the returned */ -/* derivative value should be 456.D0, since the unique 7th degree */ -/* polynomial that fits these constraints is */ - -/* 7 2 */ -/* f(x) = x + 2x + 5 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] "Numerical Recipes---The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* William T. Vetterling (see sections 3.0 and 3.1). */ - -/* [2] "Elementary Numerical Analysis---An Algorithmic Approach" */ -/* by S. D. Conte and Carl de Boor. See p. 64. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 01-FEB-2002 (NJB) (EDW) */ - -/* Bug fix: declarations of local variables XI and XIJ */ -/* were changed from DOUBLE PRECISION to INTEGER. */ -/* Note: bug had no effect on behavior of this routine. */ - -/* - SPICELIB Version 1.1.0, 28-DEC-2001 (NJB) */ - -/* Blanks following final newline were truncated to */ -/* suppress compilation warnings on the SGI-N32 platform. */ - -/* - SPICELIB Version 1.0.0, 01-MAR-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* interpolate function using Hermite polynomial */ -/* Hermite interpolation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check in only if an error is detected. */ - - /* Parameter adjustments */ - work_dim1 = *n << 1; - work_offset = work_dim1 + 1; - yvals_dim1 = *n << 1; - xvals_dim1 = *n; - - /* Function Body */ - if (return_()) { - return 0; - } - -/* No data, no interpolation. */ - - if (*n < 1) { - chkin_("HRMINT", (ftnlen)6); - setmsg_("Array size must be positive; was #.", (ftnlen)35); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("HRMINT", (ftnlen)6); - return 0; - } - -/* Copy the input array into WORK. After this, the first column */ -/* of WORK represents the first column of our triangular */ -/* interpolation table. */ - - i__1 = *n << 1; - for (i__ = 1; i__ <= i__1; ++i__) { - work[(i__2 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)289)] = - yvals[(i__3 = i__ - 1) < yvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("yvals", i__3, "hrmint_", (ftnlen)289)]; - } - -/* Compute the second column of the interpolation table: this */ -/* consists of the N-1 values obtained by evaluating the first-degree */ -/* interpolants at X. We'll also evaluate the derivatives of these */ -/* interpolants at X and save the results in the second column of */ -/* WORK. Because the derivative computations depend on the */ -/* function computations from the previous column in the */ -/* interpolation table, and because the function interpolation */ -/* overwrites the previous column of interpolated function values, */ -/* we must evalute the derivatives first. */ - - i__1 = *n - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - c1 = xvals[(i__2 = i__) < xvals_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "xvals", i__2, "hrmint_", (ftnlen)306)] - *x; - c2 = *x - xvals[(i__2 = i__ - 1) < xvals_dim1 && 0 <= i__2 ? i__2 : - s_rnge("xvals", i__2, "hrmint_", (ftnlen)307)]; - denom = xvals[(i__2 = i__) < xvals_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "xvals", i__2, "hrmint_", (ftnlen)308)] - xvals[(i__3 = i__ - - 1) < xvals_dim1 && 0 <= i__3 ? i__3 : s_rnge("xvals", i__3, - "hrmint_", (ftnlen)308)]; - if (denom == 0.) { - chkin_("HRMINT", (ftnlen)6); - setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23); - errint_("#", &i__, (ftnlen)1); - i__2 = i__ + 1; - errint_("#", &i__2, (ftnlen)1); - errdp_("#", &xvals[(i__2 = i__ - 1) < xvals_dim1 && 0 <= i__2 ? - i__2 : s_rnge("xvals", i__2, "hrmint_", (ftnlen)317)], ( - ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("HRMINT", (ftnlen)6); - return 0; - } - -/* The second column of WORK contains interpolated derivative */ -/* values. */ - -/* The odd-indexed interpolated derivatives are simply the input */ -/* derivatives. */ - - prev = (i__ << 1) - 1; - this__ = prev + 1; - next = this__ + 1; - work[(i__2 = prev + (work_dim1 << 1) - work_offset) < work_dim1 << 1 - && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen) - 335)] = work[(i__3 = this__ + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "hrmint_", (ftnlen)335)]; - -/* The even-indexed interpolated derivatives are the slopes of */ -/* the linear interpolating polynomials for adjacent input */ -/* abscissa/ordinate pairs. */ - - work[(i__2 = this__ + (work_dim1 << 1) - work_offset) < work_dim1 << - 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", ( - ftnlen)342)] = (work[(i__3 = next + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "hrmint_", (ftnlen)342)] - work[(i__4 = prev + work_dim1 - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge( - "work", i__4, "hrmint_", (ftnlen)342)]) / denom; - -/* The first column of WORK contains interpolated function values. */ -/* The odd-indexed entries are the linear Taylor polynomials, */ -/* each input abscissa value, evaluated at X. */ - - temp = work[(i__2 = this__ + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", ( - ftnlen)349)] * (*x - xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 - <= i__3 ? i__3 : s_rnge("xvals", i__3, "hrmint_", (ftnlen)349) - ]) + work[(i__4 = prev + work_dim1 - work_offset) < work_dim1 - << 1 && 0 <= i__4 ? i__4 : s_rnge("work", i__4, "hrmint_", ( - ftnlen)349)]; - work[(i__2 = this__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)352)] - = (c1 * work[(i__3 = prev + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "hrmint_", (ftnlen)352)] + c2 * work[(i__4 = next + work_dim1 - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge( - "work", i__4, "hrmint_", (ftnlen)352)]) / denom; - work[(i__2 = prev + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)355)] = - temp; - } - -/* The last column entries were not computed by the preceding loop; */ -/* compute them now. */ - - work[(i__1 = (*n << 1) - 1 + (work_dim1 << 1) - work_offset) < work_dim1 - << 1 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", ( - ftnlen)364)] = work[(i__2 = (*n << 1) + work_dim1 - work_offset) < - work_dim1 << 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmi" - "nt_", (ftnlen)364)]; - work[(i__1 = (*n << 1) - 1 + work_dim1 - work_offset) < work_dim1 << 1 && - 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (ftnlen)365)] = - work[(i__2 = (*n << 1) + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen) - 365)] * (*x - xvals[(i__3 = *n - 1) < xvals_dim1 && 0 <= i__3 ? - i__3 : s_rnge("xvals", i__3, "hrmint_", (ftnlen)365)]) + work[( - i__4 = (*n << 1) - 1 + work_dim1 - work_offset) < work_dim1 << 1 - && 0 <= i__4 ? i__4 : s_rnge("work", i__4, "hrmint_", (ftnlen)365) - ]; - -/* Compute columns 3 through 2*N of the table. */ - - i__1 = (*n << 1) - 1; - for (j = 2; j <= i__1; ++j) { - i__2 = (*n << 1) - j; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* In the theoretical construction of the interpolation table, */ -/* there are 2*N abscissa values, since each input abcissa */ -/* value occurs with multiplicity two. In this theoretical */ -/* construction, the Jth column of the interpolation table */ -/* contains results of evaluating interpolants that span J+1 */ -/* consecutive abscissa values. The indices XI and XIJ below */ -/* are used to pick the correct abscissa values out of the */ -/* physical XVALS array, in which the abscissa values are not */ -/* repeated. */ - - xi = (i__ + 1) / 2; - xij = (i__ + j + 1) / 2; - c1 = xvals[(i__3 = xij - 1) < xvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("xvals", i__3, "hrmint_", (ftnlen)389)] - *x; - c2 = *x - xvals[(i__3 = xi - 1) < xvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("xvals", i__3, "hrmint_", (ftnlen)390)]; - denom = xvals[(i__3 = xij - 1) < xvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("xvals", i__3, "hrmint_", (ftnlen)392)] - xvals[( - i__4 = xi - 1) < xvals_dim1 && 0 <= i__4 ? i__4 : s_rnge( - "xvals", i__4, "hrmint_", (ftnlen)392)]; - if (denom == 0.) { - chkin_("HRMINT", (ftnlen)6); - setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23); - errint_("#", &xi, (ftnlen)1); - errint_("#", &xij, (ftnlen)1); - errdp_("#", &xvals[(i__3 = xi - 1) < xvals_dim1 && 0 <= i__3 ? - i__3 : s_rnge("xvals", i__3, "hrmint_", (ftnlen)400)] - , (ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("HRMINT", (ftnlen)6); - return 0; - } - -/* Compute the interpolated derivative at X for the Ith */ -/* interpolant. This is the derivative with respect to X of */ -/* the expression for the interpolated function value, which is */ -/* the second expression below. This derivative computation */ -/* is done first because it relies on the interpolated function */ -/* values from the previous column of the interpolation table. */ - -/* The derivative expression here corresponds to equation */ -/* 2.35 on page 64 in reference [2]. */ - - work[(i__3 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 << - 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "hrmint_", ( - ftnlen)418)] = (c1 * work[(i__4 = i__ + (work_dim1 << 1) - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : - s_rnge("work", i__4, "hrmint_", (ftnlen)418)] + c2 * work[ - (i__5 = i__ + 1 + (work_dim1 << 1) - work_offset) < - work_dim1 << 1 && 0 <= i__5 ? i__5 : s_rnge("work", i__5, - "hrmint_", (ftnlen)418)] + (work[(i__6 = i__ + 1 + - work_dim1 - work_offset) < work_dim1 << 1 && 0 <= i__6 ? - i__6 : s_rnge("work", i__6, "hrmint_", (ftnlen)418)] - - work[(i__7 = i__ + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__7 ? i__7 : s_rnge("work", i__7, "hrmint_", ( - ftnlen)418)])) / denom; - -/* Compute the interpolated function value at X for the Ith */ -/* interpolant. */ - - work[(i__3 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 - <= i__3 ? i__3 : s_rnge("work", i__3, "hrmint_", (ftnlen) - 425)] = (c1 * work[(i__4 = i__ + work_dim1 - work_offset) - < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge("work", - i__4, "hrmint_", (ftnlen)425)] + c2 * work[(i__5 = i__ + - 1 + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__5 ? i__5 : s_rnge("work", i__5, "hrmint_", (ftnlen)425) - ]) / denom; - } - } - -/* Our interpolated function value is sitting in WORK(1,1) at this */ -/* point. The interpolated derivative is located in WORK(1,2). */ - - *f = work[(i__1 = work_dim1 + 1 - work_offset) < work_dim1 << 1 && 0 <= - i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (ftnlen)435)]; - *df = work[(i__1 = (work_dim1 << 1) + 1 - work_offset) < work_dim1 << 1 && - 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (ftnlen)436)]; - return 0; -} /* hrmint_ */ - diff --git a/ext/spice/src/cspice/hx2dp.c b/ext/spice/src/cspice/hx2dp.c deleted file mode 100644 index c937487b3d..0000000000 --- a/ext/spice/src/cspice/hx2dp.c +++ /dev/null @@ -1,730 +0,0 @@ -/* hx2dp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HX2DP ( Hexadecimal string to d.p. number ) */ -/* Subroutine */ int hx2dp_(char *string, doublereal *number, logical *error, - char *errmsg, ftnlen string_len, ftnlen errmsg_len) -{ - /* Initialized data */ - - static doublereal dpval[16] = { 0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12., - 13.,14.,15. }; - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - char ch__1[1]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer ival[32]; - logical more; - integer i__; - extern doublereal dpmin_(void); - static doublereal mindp; - extern doublereal dpmax_(void); - static doublereal maxdp; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - static integer iplus; - extern /* Subroutine */ int hx2int_(char *, integer *, logical *, char *, - ftnlen, ftnlen); - static integer lccbeg, digbeg, lccend, uccbeg, digend, uccend, ispace; - static doublereal scales[31]; - integer ndigit; - static integer iexpch; - logical fndexp; - integer strbeg; - logical negtiv; - integer letter, strend, iexpon; - static integer iminus; - integer positn; - doublereal tmpnum; - -/* $ Abstract */ - -/* Convert a string representing a double precision number in a */ -/* base 16 ``scientific notation'' into its equivalent double */ -/* precision number. */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ - -/* $ Declarations */ - - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to be converted to double precision. */ -/* NUMBER O Double precision value to be returned. */ -/* ERROR O A logical flag which is .TRUE. on error. */ -/* ERRMSG O A descriptive error message. */ - -/* $ Detailed_Input */ - -/* STRING A character string containing a base 16 ``scientific */ -/* notation'' representation of a double precision number */ -/* which is to be converted to a double precision number, */ -/* e.g.: */ - -/* '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 = 672.0 */ - -/* and */ - -/* '-B^1' = - ( 11/16 ) * 16**1 = -11.0 */ - -/* The following table describes the character set used to */ -/* represent the hexadecimal digits and their corresponding */ -/* values. */ - -/* Character Value Character Value */ -/* --------- ------- --------- ------- */ -/* '0' 0.0D0 '8' 8.0D0 */ -/* '1' 1.0D0 '9' 9.0D0 */ -/* '2' 2.0D0 'A','a' 10.0D0 */ -/* '3' 3.0D0 'B','b' 11.0D0 */ -/* '4' 4.0D0 'C','c' 12.0D0 */ -/* '5' 5.0D0 'D','d' 13.0D0 */ -/* '6' 6.0D0 'E','e' 14.0D0 */ -/* '7' 7.0D0 'F','f' 15.0D0 */ - -/* The carat, or hat, character, '^', is used to */ -/* distinguish the exponent. */ - -/* The plus sign, '+', and the minus sign, '-', are used, */ -/* and they have their usual meanings. */ - -/* A base 16 ``scientific notation'' character string which */ -/* is to be parsed by this routine should consist of a sign, */ -/* '+' or '-' (the plus sign is optional for nonnegative */ -/* numbers), followed immediately by a contiguous sequence */ -/* of hexadecimal digits, the exponent character, and a */ -/* signed hexadecimal exponent. The exponent is required, */ -/* but the sign is optional for a nonnegative exponent. */ - -/* A number in base 16 ``scientific notation'' consists of */ -/* a contiguous sequence of characters with one of the */ -/* following formats: */ - -/* (1) h h h h ... h ^H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (2) +h h h h ... h ^H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (3) -h h h h ... h ^H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (4) h h h h ... h ^+H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (5) +h h h h ... h ^+H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (6) -h h h h ... h ^+H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (7) h h h h ... h ^-H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (8) +h h h h ... h ^-H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* (9) -h h h h ... h ^-H H ... H */ -/* 1 2 3 4 n 1 2 m */ - -/* where */ - -/* h and H denote hexadecimal digits; */ -/* i j */ - -/* ^ denotes exponentiation; */ - -/* and */ - -/* + and - have their usual interpretations. */ - -/* STRING may have leading and trailing blanks, but blanks */ -/* embedded within the significant portion of the input */ -/* string are not allowed. */ - -/* $ Detailed_Output */ - -/* NUMBER The double precision value to be returned. The value of */ -/* this argument is not changed if an error occurs while */ -/* parsing the input string. */ - -/* ERROR A logical flag which indicates whether an error occurred */ -/* while attempting to parse NUMBER from the input */ -/* character string STRING. ERROR will have the value */ -/* .TRUE. if an error occurs. It will have the value */ -/* .FALSE. otherwise. */ - -/* ERRMSG Contains a descriptive error message if an error */ -/* occurs while attempting to parse the number NUMBER */ -/* from the hexadecimal character string STRING, blank */ -/* otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If an unexpected character is encountered, an appropriate */ -/* error message will be set, and the routine will exit. The */ -/* value of NUMBER will be unchanged. */ - -/* 2) If the input string represents a number that is larger in */ -/* absolute magnitude than the maximum representable */ -/* double precision number an appropriate error message */ -/* will be set, and the routine will exit. The value of */ -/* NUMBER will be unchanged. */ - -/* 3) If the input string is blank, an appropriate error message */ -/* will be set, and the routine will exit. The value of */ -/* NUMBER will be unchanged. */ - -/* 4) If the string has too many digits in the mantissa, > MAXMAN, */ -/* then an appropriate error message will be set, and the */ -/* routine will exit. The value of NUMBER will be unchanged. */ - -/* 5) If the error message string is not long enough to contain */ -/* the entire error message, the error message will be */ -/* truncated on the right. */ - -/* 6) This routine does NOT check for underflow errors when */ -/* constructing a double precision number. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will convert a character string containing a number */ -/* in base 16 ``scientific notation'' into its equivalent double */ -/* precision number. */ - -/* This routine is one of a pair of routines which are used to */ -/* perform conversions between double precision numbers and */ -/* an equivalent base 16 ``scientific notation'' character string */ -/* representation: */ - -/* DP2HX -- Convert a double precision number into a base 16 */ -/* ``scientific notation'' character string. */ - -/* HX2DP -- Convert a base 16 ``scientific notation'' */ -/* character string into a double precision number. */ - -/* $ Examples */ - -/* The following argument values illustrate the action of HX2DP. */ - -/* Note: The hat or carat, '^', signals an exponent. */ - - -/* STRING NUMBER ERROR ERRMSG */ -/* ---------------------- ------------- ------ ------ */ -/* 89705F4136B4A6^-7 2.0D-9 .FALSE. ' ' */ -/* 1^1 1.0D0 .FALSE. ' ' */ -/* -1^1 -1.0D0 .FALSE. ' ' */ -/* 4^3 1024.0D0 .FALSE. ' ' */ -/* -4^3 -1024.0D0 .FALSE. ' ' */ -/* 7F5EB^5 521707.0D0 .FALSE. ' ' */ -/* 7F5eb^5 521707.0D0 .FALSE. ' ' */ -/* 7f5eb^5 521707.0D0 .FALSE. ' ' */ -/* 1B^2 27.0D0 .FALSE. ' ' */ -/* +1B^2 27.0D0 .FALSE. ' ' */ -/* +1B^+2 27.0D0 .FALSE. ' ' */ -/* 0^0 0.0D0 .FALSE. ' ' */ - -/* STRING = ' ' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: A blank input string is not allowed.' */ - -/* STRING = '-AB238Z^2' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Illegal character ''Z'' encountered.' */ - -/* STRING = '234ABC' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Missing exponent.' */ - -/* STRING = '234ABC^' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Missing exponent.' */ - -/* STRING = '4ABC123AB346523BDC568798C247367^1' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Too many digits in the mantissa.' */ - -/* The following examples are machine dependent. */ - -/* For a VAX using D_floating arithmetic we get: */ - -/* STRING = '23BCE^30' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Number is too large to be represented.' */ - -/* STRING = '-2abc3^22' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Number is too small to be represented.' */ - -/* $ Restrictions */ - -/* The maximum number of digits in a hexadecimal mantissa is given */ -/* by the parameter MAXMAN. The current value of MAXMAN is more */ -/* than sufficient for most double precision implementations, */ -/* providing almost twice as many digits as can actually be */ -/* produced. This value may be changed when a greater precision is */ -/* known to exist among all of the supported platforms. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1994 (KRG) */ - -/* Fixed a typo in the description of the input argument STRING. */ -/* The example showing the expansion of 160 into hexadecimal */ -/* was incorrect. 160 was replaced with 672 which makes the */ -/* example correct. */ - -/* - SPICELIB Version 1.0.0, 26-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert signed normalized hexadecimal string to d.p. */ -/* convert encoded d.p. number to d.p. number */ -/* convert base 16 scientific notation d.p. number */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1994 (KRG) */ - -/* Fixed a typo in the description of the input argument STRING. */ -/* The example showing the expansion of 160 into hexadecimal */ -/* was incorrect. 160 was replaced with 672 which makes the */ -/* example correct. */ - -/* Old Example: */ - -/* '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 = 160.0 */ - -/* New Example: */ - -/* '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 = 672.0 */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Here is a brief outline of the algorithm used to convert the */ -/* character string into its equivalent double precision number. */ - -/* The input hexadecimal string is scanned from left to right. */ - -/* 0) Any leading white space is skipped. */ - -/* 1) The length of the significant portion of the string */ -/* is determined. */ - -/* 2) The sign of the mantissa is determined. */ - -/* 3) The digits of the hexadecimal mantissa are parsed. */ - -/* 4) The exponent of the number is parsed. */ - -/* 5) The mantissa of the double precision number is generated */ -/* by summing appropriately scaled values of the hexadecimal */ -/* mantissa digits which were collected in step 2. The */ -/* summation is performed so that the summands are added */ -/* in order of increasing magnitude to eliminate a potential */ -/* loss of significance which might occur otherwise. This */ -/* yields a number in the range of 1/BASE and 1.0 or zero. */ - -/* 6) The double precision number is then scaled by the exponent */ -/* obtained in step 3. */ - - if (first) { - -/* If this is the first call, set up the array that is used to */ -/* properly scale each of the hexadecimal digits when summing */ -/* them to build a double precision number. Right now, the value */ -/* of MAXMAN, the maximum number of digits in a hexadecimal */ -/* mantissa, is 31. MAXMAN = 31 is more than sufficient for most */ -/* current double precision implementations, providing almost */ -/* twice as many digits as can actually be produced. This value */ -/* may be changed when a greater precision is known to exist on */ -/* any of the supported platforms. */ - - first = FALSE_; - scales[0] = .0625; - for (i__ = 2; i__ <= 31; ++i__) { - scales[(i__1 = i__ - 1) < 31 && 0 <= i__1 ? i__1 : s_rnge("scales" - , i__1, "hx2dp_", (ftnlen)473)] = scales[(i__2 = i__ - 2) - < 31 && 0 <= i__2 ? i__2 : s_rnge("scales", i__2, "hx2dp_" - , (ftnlen)473)] * .0625; - } - -/* Initialize the upper and lower bounds for the decimal digits, */ -/* the upper and lower bounds for the uppercase hexadecimal */ -/* digits, the upper and lower bounds for the lowercase */ -/* hexadecimal digits, the space, the plus sign, and the minus */ -/* sign in the character sequence. */ - - digbeg = '0'; - digend = '9'; - uccbeg = 'A'; - uccend = 'F'; - lccbeg = 'a'; - lccend = 'f'; - iminus = '-'; - iplus = '+'; - ispace = ' '; - -/* Also get the integer value for the exponent character. */ - - iexpch = '^'; - -/* Initialize some boundary values for error checking while */ -/* constructing the desired double precision number. These */ -/* are used to help determine whether an overflow condition */ -/* is imminent due to the overly large magnitude of a positive */ -/* or negative number. */ - - mindp = dpmin_() * .0625; - maxdp = dpmax_() * .0625; - } - -/* There are no errors initially, so set the error flag to */ -/* .FALSE. */ - - *error = FALSE_; - -/* If the string is blank, set the error flag and return immediately. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - *error = TRUE_; - s_copy(errmsg, "ERROR: A blank input string is not allowed.", - errmsg_len, (ftnlen)43); - return 0; - } - -/* Initialize a few other things. */ - - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - tmpnum = 0.; - -/* Assume that the number is nonnegative. */ - - negtiv = FALSE_; - -/* Skip any leading white space. We know that there is at least */ -/* one nonblank character at this point, so we will not loop */ -/* off the end of the string. */ - - strbeg = 1; - while(*(unsigned char *)&string[strbeg - 1] == ispace) { - ++strbeg; - } - -/* Now, we want to find the end of the significant portion of */ -/* the input string and the position of the exponent character. */ - - strend = strbeg + 1; - more = TRUE_; - while(more) { - if (strend <= i_len(string, string_len)) { - if (s_cmp(string + (strend - 1), " ", string_len - (strend - 1), ( - ftnlen)1) != 0) { - ++strend; - } else { - more = FALSE_; - } - } else { - more = FALSE_; - } - } - -/* At this point, STREND is one larger than the length of the */ -/* significant portion of the string because we incremented */ -/* its value after the test. We will subtract one from the */ -/* value of STREND so that it exactly represents the position */ -/* of the last significant character in the string. */ - - --strend; - -/* Set the position pointer to the beginning of the significant */ -/* part, i.e., the nonblank part, of the string, because we are */ -/* now ready to try and parse the number. */ - - positn = strbeg; - -/* The first character should be either a plus sign, '+', a */ -/* minus sign, '-', or a digit, '0' - '9', 'A' - 'F', or */ -/* 'a' - 'f'. Anything else is bogus and we will catch it in */ -/* the main loop below. */ - -/* If the character is a minus sign, we want to set the value of */ -/* NEGTIV to .TRUE. and increment the position. */ - -/* If the character is a plus sign, we want to increment the */ -/* position. */ - - if (*(unsigned char *)&string[positn - 1] == iminus) { - negtiv = TRUE_; - ++positn; - } else if (*(unsigned char *)&string[positn - 1] == iplus) { - ++positn; - } - -/* Collect all of the digits in the mantissa, storing them */ -/* for later conversion. We do this because we want to add */ -/* the digits of the mantissa in increasing order so that we */ -/* do not lose any significance. */ - -/* A normalized hexadecimal number must have an exponent, */ -/* which is represented by the hat character, EXPCHR, which */ -/* s why that test is part of the loop termination. */ - -/* We currently have no digits, and we have not found the */ -/* exponent character yet. */ - - ndigit = 0; - fndexp = FALSE_; - while(positn <= strend && ! fndexp) { - letter = *(unsigned char *)&string[positn - 1]; - if (letter >= digbeg && letter <= digend) { - ++positn; - ++ndigit; - ival[(i__1 = ndigit - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ival", - i__1, "hx2dp_", (ftnlen)631)] = letter - digbeg; - } else if (letter >= uccbeg && letter <= uccend) { - ++positn; - ++ndigit; - ival[(i__1 = ndigit - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ival", - i__1, "hx2dp_", (ftnlen)638)] = letter + 10 - uccbeg; - } else if (letter >= lccbeg && letter <= lccend) { - ++positn; - ++ndigit; - ival[(i__1 = ndigit - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ival", - i__1, "hx2dp_", (ftnlen)645)] = letter + 10 - lccbeg; - } else if (letter == iexpch) { - -/* We have found the exponent character, so set the */ -/* indicator and increment the position. */ - - fndexp = TRUE_; - ++positn; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Illegal character '#' encountered.", - errmsg_len, (ftnlen)41); - *(unsigned char *)&ch__1[0] = letter; - repmc_(errmsg, "#", ch__1, errmsg, errmsg_len, (ftnlen)1, (ftnlen) - 1, errmsg_len); - return 0; - } - -/* We need to make sure that the number of mantissa digits */ -/* remains less than or equal to the number of mantissa */ -/* digits that we declared, see the MAXMAN parameter. */ - - if (ndigit > 31) { - *error = TRUE_; - s_copy(errmsg, "ERROR: Too many digits in the mantissa.", - errmsg_len, (ftnlen)39); - return 0; - } - } - -/* At this point, we have found an exponent character, and: */ - -/* 1) We are beyond the end of the significant portion of the */ -/* string, which is an error: no exponent digits were found. */ - -/* 2) We are positioned on the first digit of the exponent, */ -/* and are ready to try and parse it. */ - - if (positn <= strend) { - -/* If there is at least one significant character left in the */ -/* string, we need to try and parse it as an exponent. */ - - hx2int_(string + (positn - 1), &iexpon, error, errmsg, string_len - ( - positn - 1), errmsg_len); - if (*error) { - -/* If an error occurred while attempting to parse the */ -/* exponent, we simply want to exit. The error message */ -/* is already set. */ - - return 0; - } - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Missing exponent.", errmsg_len, (ftnlen)24); - return 0; - } - -/* We now have everything that we need to build the double */ -/* precision number, a mantissa and an exponent. So, let's */ -/* start building the number. We need to be careful that we */ -/* do not overflow when we scale the number using the exponent. */ - -/* First, we build up the mantissa ... */ - - if (negtiv) { - while(ndigit > 0) { - tmpnum -= dpval[(i__2 = ival[(i__1 = ndigit - 1) < 32 && 0 <= - i__1 ? i__1 : s_rnge("ival", i__1, "hx2dp_", (ftnlen)722)] - ) < 16 && 0 <= i__2 ? i__2 : s_rnge("dpval", i__2, "hx2d" - "p_", (ftnlen)722)] * scales[(i__3 = ndigit - 1) < 31 && 0 - <= i__3 ? i__3 : s_rnge("scales", i__3, "hx2dp_", (ftnlen) - 722)]; - --ndigit; - } - } else { - while(ndigit > 0) { - tmpnum += dpval[(i__2 = ival[(i__1 = ndigit - 1) < 32 && 0 <= - i__1 ? i__1 : s_rnge("ival", i__1, "hx2dp_", (ftnlen)731)] - ) < 16 && 0 <= i__2 ? i__2 : s_rnge("dpval", i__2, "hx2d" - "p_", (ftnlen)731)] * scales[(i__3 = ndigit - 1) < 31 && 0 - <= i__3 ? i__3 : s_rnge("scales", i__3, "hx2dp_", (ftnlen) - 731)]; - --ndigit; - } - } - -/* At this point, one of the following is true: */ - -/* 1) -1 < TMPNUM <= -1/BASE */ - -/* 2) 1/BASE <= TMPNUM < 1 */ - -/* or */ - -/* 3) TMPNUM = 0.0D0 */ - -/* Now we to scale the normalized number using the exponent. If */ -/* the exponent is zero, we will simply fall through the loop */ -/* structures below at no greater cost than a few comparisons. */ - - if (iexpon < 0) { - -/* We do not check for any sort of underflow conditions. */ - - i__1 = -iexpon; - for (i__ = 1; i__ <= i__1; ++i__) { - tmpnum *= .0625; - } - } else { - if (negtiv) { - i__1 = iexpon; - for (i__ = 1; i__ <= i__1; ++i__) { - if (tmpnum >= mindp) { - tmpnum *= 16.; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Number is too small to be represe" - "nted.", errmsg_len, (ftnlen)45); - return 0; - } - } - } else { - i__1 = iexpon; - for (i__ = 1; i__ <= i__1; ++i__) { - if (tmpnum <= maxdp) { - tmpnum *= 16.; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Number is too large to be represe" - "nted.", errmsg_len, (ftnlen)45); - return 0; - } - } - } - } - -/* If we got to here, we have successfully parsed the hexadecimal */ -/* string into a double precision number. So, set the value and */ -/* return. */ - - *number = tmpnum; - return 0; -} /* hx2dp_ */ - diff --git a/ext/spice/src/cspice/hx2dp_c.c b/ext/spice/src/cspice/hx2dp_c.c deleted file mode 100644 index 3b3b667748..0000000000 --- a/ext/spice/src/cspice/hx2dp_c.c +++ /dev/null @@ -1,293 +0,0 @@ -/* - --Procedure hx2dp_c ( Hexadecimal string to d.p. number ) - --Abstract - - Convert a string representing a double precision number in a - base 16 ``scientific notation'' into its equivalent double - precision number. - --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 - - ALPHANUMERIC - CONVERSION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void hx2dp_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * number, - SpiceBoolean * error, - SpiceChar * errmsg ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Hex form string to convert to double precision. - lenout I Available space for output string 'errmsg'. - number O Double precision value to be returned. - error O A logical flag which is true on error. - errmsg O A descriptive error message. - --Detailed_Input - - string a character string containing a base 16 ``scientific - notation'' representation of a double precision number - which is to be converted to a double precision number, - e.g.: - - '2A^3' = ( 2/16 + 10/( 16**2 ) ) * 16**3 = 672.0 - - and - - '-B^1' = - ( 11/16 ) * 16**1 = -11.0 - - The following table describes the character set used to - represent the hexadecimal digits and their corresponding - values. - - Character Value Character Value - --------- ------- --------- ------- - '0' 0.0D0 '8' 8.0D0 - '1' 1.0D0 '9' 9.0D0 - '2' 2.0D0 'A','a' 10.0D0 - '3' 3.0D0 'B','b' 11.0D0 - '4' 4.0D0 'C','c' 12.0D0 - '5' 5.0D0 'D','d' 13.0D0 - '6' 6.0D0 'E','e' 14.0D0 - '7' 7.0D0 'F','f' 15.0D0 - - The caret, or hat, character, '^', is used to - distinguish the exponent. - - The plus sign, '+', and the minus sign, '-', are used, - and they have their usual meanings. - - A base 16 ``scientific notation'' character string which - is to be parsed by this routine should consist of a sign, - '+' or '-' (the plus sign is optional for nonnegative - numbers), followed immediately by a contiguous sequence - of hexadecimal digits, the exponent character, and a - signed hexadecimal exponent. The exponent is required, - but the sign is optional for a nonnegative exponent. - - A number in base 16 ``scientific notation'' consists of - a contiguous sequence of characters with one of the - following formats: - - (1) h h h h ... h ^H H ... H - 1 2 3 4 n 1 2 m - - (2) +h h h h ... h ^H H ... H - 1 2 3 4 n 1 2 m - - (3) -h h h h ... h ^H H ... H - 1 2 3 4 n 1 2 m - - (4) h h h h ... h ^+H H ... H - 1 2 3 4 n 1 2 m - - (5) +h h h h ... h ^+H H ... H - 1 2 3 4 n 1 2 m - - (6) -h h h h ... h ^+H H ... H - 1 2 3 4 n 1 2 m - - (7) h h h h ... h ^-H H ... H - 1 2 3 4 n 1 2 m - - (8) +h h h h ... h ^-H H ... H - 1 2 3 4 n 1 2 m - - (9) -h h h h ... h ^-H H ... H - 1 2 3 4 n 1 2 m - - where - - h and H denote hexadecimal digits; - i j - - '^' denotes exponentiation; - - and - - + and - have their usual interpretations. - - 'string' may have leading and trailing blanks, but blanks - embedded within the significant portion of the input - string are not allowed. - - lenout the maximum length of the output 'errmsg'. The value - defined by lenout should be one plus the value large - enough to hold any possible output. - --Detailed_Output - - number the double precision value to be returned. The value of - this argument is not changed if an error occurs while - parsing the input string. - - error a logical flag which indicates whether an error occurred - while attempting to parse 'number' from the input - character string 'string'. 'error' will have the value - true if an error occurs. It will have the value - false otherwise. - - errmsg contains a descriptive error message if an error - occurs while attempting to parse the number 'number' - from the hexadecimal character string 'string', blank - otherwise. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - This routine will convert a character string containing a number - in base 16 ``scientific notation'' into its equivalent double - precision number. - - This routine is one of a pair of routines which are used to - perform conversions between double precision numbers and - an equivalent base 16 ``scientific notation'' character string - representation: - - dp2hx_c -- Convert a double precision number into a base 16 - ``scientific notation'' character string. - - hx2dp_c -- Convert a base 16 ``scientific notation'' - character string into a double precision number. - --Examples - - The following input and output argument values illustrate the - action of hx2dp_c for various input values of 'string'. - - Note: The hat or caret, '^', signals an exponent. - - string number error errmsg - ---------------------- ------------- ------ ------ - 89705F4136B4A6^-7 2.0D-9 false " " - 1^1 1.0D0 false " " - -1^1 -1.0D0 false " " - 4^3 1024.0D0 false " " - -4^3 -1024.0D0 false " " - 7F5EB^5 521707.0D0 false " " - 7F5eb^5 521707.0D0 false " " - 7f5eb^5 521707.0D0 false " " - 1B^2 27.0D0 false " " - +1B^2 27.0D0 false " " - +1B^+2 27.0D0 false " " - 0^0 0.0D0 false " " - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - --Version - - CSPICE Version 1.0.0, 10-APR-2010 (EDW) - --Index_Entries - - convert signed normalized hexadecimal string to d.p. - convert encoded d.p. number to d.p. number - convert base 16 scientific notation d.p. number - --& -*/ - -{ /* Begin hx2dp_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "hx2dp_c" ); - - /* - Check the input time string to make sure the pointer is non-null and - the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "hx2dp_c", string ); - - /* - Check the output error message string to make sure the pointer is - non-null and the string length is at least 2. - */ - CHKOSTR ( CHK_DISCOVER, "hx2dp_c", errmsg, lenout ); - - /* - Call the f2c'd routine. - */ - - (void) hx2dp_ ( ( char * ) string, - ( doublereal * ) number, - ( logical * ) error, - ( char * ) errmsg, - ( ftnlen ) strlen(string), - ( ftnlen ) lenout - 1); - - /* - Convert the error message from Fortran to C style. - */ - F2C_ConvertStr ( lenout, errmsg ); - - chkout_c ( "hx2dp_c" ); - -} /* End hx2dp_c */ - diff --git a/ext/spice/src/cspice/hx2int.c b/ext/spice/src/cspice/hx2int.c deleted file mode 100644 index 04c90995ea..0000000000 --- a/ext/spice/src/cspice/hx2int.c +++ /dev/null @@ -1,552 +0,0 @@ -/* hx2int.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HX2INT ( Signed hexadecimal string to integer ) */ -/* Subroutine */ int hx2int_(char *string, integer *number, logical *error, - char *errmsg, ftnlen string_len, ftnlen errmsg_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - char ch__1[1]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - static integer mini, maxi; - logical more; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - static integer iplus, lccbeg, digbeg, lccend, uccbeg, digend, uccend, - ispace; - integer idigit; - static integer minmod, maxmod; - integer strbeg; - logical negtiv; - extern integer intmin_(void), intmax_(void); - integer letter, strend; - static integer iminus; - integer tmpnum, pos; - -/* $ Abstract */ - -/* Convert a signed hexadecimal string representation of an integer */ -/* to its equivalent integer. */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ - -/* $ Declarations */ - - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Hexadecimal string to be converted to an integer. */ -/* NUMBER O Integer value to be returned. */ -/* ERROR O A logical flag which is .TRUE. on error. */ -/* ERRMSG O A descriptive error message. */ - -/* $ Detailed_Input */ - -/* STRING The hexadecimal string to be converted to an integer. */ - -/* The following table describes the character set used */ -/* to represent the hexadecimal digits and their */ -/* corresponding values. */ - -/* Character Value Character Value */ -/* --------- ----- --------- ----- */ -/* '0' 0 '8' 8 */ -/* '1' 1 '9' 9 */ -/* '2' 2 'A','a' 10 */ -/* '3' 3 'B','b' 11 */ -/* '4' 4 'C','c' 12 */ -/* '5' 5 'D','d' 13 */ -/* '6' 6 'E','e' 14 */ -/* '7' 7 'F','f' 15 */ - -/* The plus sign, '+', and the minus sign, '-', are used as */ -/* well, and they have their usual meanings. */ - -/* A hexadecimal character string parsed by this routine */ -/* should consist of a sign, '+' or '-' (the plus sign is */ -/* optional for nonnegative numbers), followed immediately */ -/* by a contiguous sequence of hexadecimal digits, e.g.: */ - -/* (1) +h h ... h */ -/* 1 2 n */ - -/* (2) -h h ... h */ -/* 1 2 n */ - -/* (3) h h ... h */ -/* 1 2 n */ - -/* where h represents an hexadecimal digit. */ -/* i */ - -/* STRING may have leading and trailing blanks, but blanks */ -/* embedded within the signficant portion of the character */ -/* string are not allowed. This includes any blanks which */ -/* appear between the sign character and the first */ -/* hexadecimal digit. */ - -/* $ Detailed_Output */ - -/* NUMBER The integer value to be returned. The value of this */ -/* variable is not changed if an error occurs while parsing */ -/* the hexadecimal character string. */ - -/* ERROR A logical flag which indicates whether an error occurred */ -/* while attempting to parse NUMBER from the hexadecimal */ -/* character string STRING. ERROR will have the value */ -/* .TRUE. if an error occurs. It will have the value */ -/* .FALSE. otherwise. */ - -/* ERRMSG Contains a descriptive error message if an error */ -/* occurs while attempting to parse NUMBER from the */ -/* hexadecimal character string STRING, blank otherwise. */ -/* The error message will be left justified. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If an unexpected character is encountered while parsing the */ -/* hexadecimal character string, an appropriate error message */ -/* will be set, and the routine will exit. The value of NUMBER */ -/* will be unchanged. */ - -/* 2) If the string represents a number that is larger than */ -/* the maximum representable integer an appropriate error */ -/* message will be set, and the routine will exit. The value */ -/* of NUMBER will be unchanged. */ - -/* 3) If the string represents a number that is smaller than */ -/* the minimum representable integer, an appropriate error */ -/* message will be set, and the routine will exit. The value */ -/* of NUMBER will be unchanged. */ - -/* 4) If the input string is blank, an appropriate error message */ -/* will be set, and the routine will exit. The value of NUMBER */ -/* will be unchanged. */ - -/* 5) If the error message string is not long enough to contain */ -/* the entire error message, the error message will be */ -/* truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will convert a signed hexadecimal character string */ -/* representation of an integer into its equivalent integer. This */ -/* provides a machine independent mechanism for storing or porting */ -/* integer values. This routine is used by the routine HX2DP which */ -/* converts a character string representation of a double precision */ -/* into its equivalent double precision value. */ - -/* This routine is one of a pair of routines which are used to */ -/* perform conversions between integers and equivalent signed */ -/* hexadecimal character strings: */ - -/* INT2HX -- Convert an integer into a signed hexadecimal */ -/* character string. */ - -/* HX2INT -- Convert a signed hexadecimal character string */ -/* into an integer. */ - -/* $ Examples */ - -/* All of the values shown are for a two's complement 32 bit */ -/* representation for signed integers. */ - -/* The following argument values illustrate the action of HX2INT for */ -/* various input values. */ - -/* STRING NUMBER ERROR ERRMSG */ -/* --------------------- ------------ ------ ------ */ -/* '1' 1 .FALSE. ' ' */ -/* '-1' -1 .FALSE. ' ' */ -/* 'DF' 223 .FALSE. ' ' */ -/* 'Df' 223 .FALSE. ' ' */ -/* '+3ABC' 15036 .FALSE. ' ' */ -/* 'ff' 255 .FALSE. ' ' */ -/* '-20' -32 .FALSE. ' ' */ -/* '0' 0 .FALSE. ' ' */ - -/* '7FFFFFFF' 2147483647 .FALSE. ' ' */ -/* (Maximum 32 bit integer) */ - -/* '-7FFFFFFF' -2147483647 .FALSE. ' ' */ -/* (Minimum 32 bit integer + 1) */ - -/* '-80000000' -2147483648 .FALSE. ' ' */ -/* (Minimum 32 bit integer) */ - -/* STRING = ' ' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: A blank input string is not allowed.' */ - -/* STRING = '-AB238Q' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Illegal character ''Q'' encountered.' */ - -/* STRING = '- AAA' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Illegal character '' '' encountered.' */ - -/* STRING = '80000000' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Integer too large to be represented.' */ - -/* STRING = '-800F0000' */ -/* NUMBER = ( Not defined ) */ -/* ERROR = .TRUE. */ -/* ERRMSG = 'ERROR: Integer too small to be represented.' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 10-MAR-1994 (KRG) */ - -/* Changed an IF test operand from .LE. to .LT. so that */ -/* the ELSE IF clause could be reached. This change has */ -/* NO effect on the execution of the routine because it */ -/* makes use of a base that is a power of 2 (16), so the */ -/* ELSE IF clause never needs to be reached. The algorithm */ -/* was meant to be as general as possible, however, so that */ -/* only the base and digits would need to be changed in order to */ -/* implement a different number base. */ - -/* - SPICELIB Version 1.0.0, 22-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert signed hexadecimal string to integer */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 10-MAR-1994 (KRG) */ - -/* Changed an IF test operand from .LE. to .LT. so that */ -/* the ELSE IF clause could be reached. This change has */ -/* NO effect on the execution of the routine because it */ -/* makes use of a base that is a power of 2 (16), so the */ -/* ELSE IF clause never needs to be reached. The algorithm */ -/* was meant to be as general as possible, however, so that */ -/* only the base and digits would need to be changed in order to */ -/* implement a different number base. */ - -/* Old code was: */ - -/* IF ( TMPNUM .LE. MAXI ) THEN */ - -/* TMPNUM = TMPNUM * BASE + IDIGIT */ -/* POS = POS + 1 */ - -/* ELSE IF ( ( TMPNUM .EQ. MAXI ) .AND. */ -/* . ( IDIGIT .LE. MAXMOD ) ) THEN */ - -/* TMPNUM = TMPNUM * BASE + IDIGIT */ -/* POS = POS + 1 */ - -/* ELSE ... */ - -/* New code: */ - -/* IF ( TMPNUM .LT. MAXI ) THEN */ - -/* TMPNUM = TMPNUM * BASE + IDIGIT */ -/* POS = POS + 1 */ - -/* ELSE IF ( ( TMPNUM .EQ. MAXI ) .AND. */ -/* . ( IDIGIT .LE. MAXMOD ) ) THEN */ - -/* TMPNUM = TMPNUM * BASE + IDIGIT */ -/* POS = POS + 1 */ - -/* ELSE ... */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* The input hexadecimal string is scanned from left to right, and */ -/* the integer is generated by repeated multiplications and additions */ -/* or subtractions. */ - -/* If this is the first time that this routine has been called, */ -/* we need to do some setup stuff. */ - - if (first) { - first = FALSE_; - -/* Initialize the upper and lower bounds for the decimal digits, */ -/* the upper and lower bounds for the uppercase hexadecimal */ -/* digits, the upper and lower bounds for the lowercase */ -/* hexadecimal digits, the space, the plus sign, and the minus */ -/* sign in the character sequence. */ - - digbeg = '0'; - digend = '9'; - uccbeg = 'A'; - uccend = 'F'; - lccbeg = 'a'; - lccend = 'f'; - iminus = '-'; - iplus = '+'; - ispace = ' '; - -/* Initialize some boundary values for error checking while */ -/* constructing the desired integer. These are used to help */ -/* determine integer overflow or integer underflow errors. */ - - mini = intmin_() / 16; - minmod = (mini << 4) - intmin_(); - maxi = intmax_() / 16; - maxmod = intmax_() - (maxi << 4); - } - -/* There are no errors initially, so set the error flag to */ -/* .FALSE. */ - - *error = FALSE_; - -/* If the string is blank, set the error flag and return immediately. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - *error = TRUE_; - s_copy(errmsg, "ERROR: A blank input string is not allowed.", - errmsg_len, (ftnlen)43); - return 0; - } - -/* Initialize a few other things. */ - - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - tmpnum = 0; - -/* Assume that the number is nonnegative. */ - - negtiv = FALSE_; - -/* Skip any leading white space. We know that there is at least */ -/* one nonblank character at this point, so we will not loop */ -/* off the end of the string. */ - - strbeg = 1; - while(*(unsigned char *)&string[strbeg - 1] == ispace) { - ++strbeg; - } - -/* Now, we want to find the end of the significant portion of */ -/* the input string. */ - - strend = strbeg + 1; - more = TRUE_; - while(more) { - if (strend <= i_len(string, string_len)) { - if (s_cmp(string + (strend - 1), " ", string_len - (strend - 1), ( - ftnlen)1) != 0) { - ++strend; - } else { - more = FALSE_; - } - } else { - more = FALSE_; - } - } - -/* At this point, STREND is one larger than the length of the */ -/* significant portion of the string because we incremented */ -/* its value after the test. We will subtract one from the */ -/* value of STREND so that it exactly represents the position */ -/* of the last significant character in the string. */ - - --strend; - -/* Set the position pointer to the beginning of the significant */ -/* part, i.e., the nonblank part, of the string, because we are */ -/* now ready to try and parse the number. */ - - pos = strbeg; - -/* The first character should be a plus sign, '+', a minus sign, */ -/* '-', or a digit, '0' - '9', 'A' - 'F', or 'a' - 'f'. Anything */ -/* else is bogus, and we will catch it in the main loop below. */ - -/* If the character is a minus sign, we want to set the value of */ -/* NEGTIV to .TRUE. and increment the position. */ - -/* If the character is a plus sign, we want to increment the */ -/* position. */ - - if (*(unsigned char *)&string[pos - 1] == iminus) { - negtiv = TRUE_; - ++pos; - } else if (*(unsigned char *)&string[pos - 1] == iplus) { - ++pos; - } - -/* When we build up the number from the hexadecimal string we */ -/* need to treat nonnegative numbers differently from negative */ -/* numbers. This is because on many computers the minimum */ -/* integer is one less than the negation of the maximum integer. */ -/* Negative numbers are the ones which truly might cause */ -/* problems, because ABS(minimum integer) may equal ABS(maximum */ -/* integer) + 1, on some machines. For example, on many machines */ -/* with 32 bit numbers, INTMIN = -2147483648 and INTMAX = */ -/* 2147483647. */ - -/* Build up the number from the hexadecimal character string. */ - - if (negtiv) { - while(pos <= strend) { - letter = *(unsigned char *)&string[pos - 1]; - if (letter >= digbeg && letter <= digend) { - idigit = letter - digbeg; - } else if (letter >= uccbeg && letter <= uccend) { - idigit = letter + 10 - uccbeg; - } else if (letter >= lccbeg && letter <= lccend) { - idigit = letter + 10 - lccbeg; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Illegal character '#' encountered.", - errmsg_len, (ftnlen)41); - *(unsigned char *)&ch__1[0] = letter; - repmc_(errmsg, "#", ch__1, errmsg, errmsg_len, (ftnlen)1, ( - ftnlen)1, errmsg_len); - return 0; - } - if (tmpnum > mini) { - tmpnum = (tmpnum << 4) - idigit; - ++pos; - } else if (tmpnum == mini && idigit <= minmod) { - tmpnum = (tmpnum << 4) - idigit; - ++pos; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Integer too small to be represented.", - errmsg_len, (ftnlen)43); - return 0; - } - } - } else { - while(pos <= strend) { - letter = *(unsigned char *)&string[pos - 1]; - if (letter >= digbeg && letter <= digend) { - idigit = letter - digbeg; - } else if (letter >= uccbeg && letter <= uccend) { - idigit = letter + 10 - uccbeg; - } else if (letter >= lccbeg && letter <= lccend) { - idigit = letter + 10 - lccbeg; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Illegal character '#' encountered.", - errmsg_len, (ftnlen)41); - *(unsigned char *)&ch__1[0] = letter; - repmc_(errmsg, "#", ch__1, errmsg, errmsg_len, (ftnlen)1, ( - ftnlen)1, errmsg_len); - return 0; - } - if (tmpnum < maxi) { - tmpnum = (tmpnum << 4) + idigit; - ++pos; - } else if (tmpnum == maxi && idigit <= maxmod) { - tmpnum = (tmpnum << 4) + idigit; - ++pos; - } else { - *error = TRUE_; - s_copy(errmsg, "ERROR: Integer too large to be represented.", - errmsg_len, (ftnlen)43); - return 0; - } - } - } - -/* If we got to here, we have successfully parsed the hexadecimal */ -/* string into an integer. Set the value and return. */ - - *number = tmpnum; - return 0; -} /* hx2int_ */ - diff --git a/ext/spice/src/cspice/hyptof.c b/ext/spice/src/cspice/hyptof.c deleted file mode 100644 index 3eae421611..0000000000 --- a/ext/spice/src/cspice/hyptof.c +++ /dev/null @@ -1,426 +0,0 @@ -/* hyptof.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HYPTOF ( Hyperbolic time of flight ) */ -/* Subroutine */ int hyptof_(doublereal *ma, doublereal *ecc, doublereal *f) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - doublereal d__1, d__2, d__3, d__4; - - /* Builtin functions */ - double log(doublereal), sqrt(doublereal), sinh(doublereal); - - /* Local variables */ - doublereal diff, m; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal dcbrt_(doublereal *), dpmax_(void); - integer count; - doublereal lower, upper, middle, midval, lastdf; - static doublereal maxlog; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer mcount; - extern logical return_(void); - -/* $ Abstract */ - -/* Solve the time of flight equation MA = e sinh(F) - F for the */ -/* hyperbolic eccentric anomaly F, given the mean anomaly, MA, */ -/* and the eccentricity, e. */ - -/* $ 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 */ - -/* CONIC */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MA I Mean anomaly at epoch. */ -/* ECC I Eccentricity. */ -/* F O Hyperbolic eccentric anomaly. */ - -/* $ Detailed_Input */ - -/* MA is the hyperbolic mean anomaly of an orbiting body at */ -/* some epoch t, */ - -/* 3 1/2 */ -/* MA = (t-T)(mu/(-a) ) */ - -/* where T is the time of periapsis passage, a is */ -/* the semi-major axis of the orbit, and mu is the */ -/* gravitational parameter of the primary body. */ - -/* ECC is the eccentricity of the orbit. */ - -/* $ Detailed_Output */ - -/* F is the corresponding eccentric anomaly. This is the */ -/* solution to the time of flight equation */ - -/* MA = e sinh(F) - F */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity (ECC) is less than one, the error */ -/* 'SPICE(WRONGCONIC)' is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Iterate to solve */ - -/* f(F,MA,e) = e sinh(F) - F - MA = 0 */ - -/* $ Examples */ - -/* ELLTOF, HYPTOF, and PARTOF are used by CONICS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.0, 13-JUL-2007 (NJB) */ - -/* Bug fix: MAXLOG is now saved. */ - -/* - SPICELIB Version 3.0.0, 14-DEC-1994 (WLT) */ - -/* A counter was placed in the loop which bisects to a */ -/* solution to the hyperbolic version of Kepler's equation. */ -/* This addition forces the loop to terminate. On some platforms */ -/* the loop would not terminate without this additional */ -/* check. This was due to the compiler performing tests on */ -/* extended precision registers. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 19-APR-1990 (WLT) */ - -/* A bad initial guess at bracketing the solution to the */ -/* hyperbolic time of flight equation was corrected so that */ -/* floating point overflows are now avoided. In addition, the */ -/* Newton's method used before has been replaced by simply */ -/* bisection. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* hyperbolic time of flight */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 14-DEC-1994 (WLT) */ - -/* A counter was placed in the loop which bisects to a */ -/* solution to the hyperbolic version of Kepler's equation. */ -/* This addition forces the loop to terminate. On some platforms */ -/* the loop would not terminate without this additional */ -/* check. This was due to the compiler performing tests on */ -/* extended precision registers. */ - -/* This is not due to a bug in the algorithm but rather to */ -/* what NAIF feels is an error on the part of some compiler */ -/* vendors. If the difference between two d.p. numbers is */ -/* zero to double precision we feel that that is the number */ -/* that should be used in subsequent statements---ESPECIALLY */ -/* in comparisons. However, since we don't have control */ -/* over how compiler writers decide to compile code, we have */ -/* added the loop counter to guarantee that the loop solving */ -/* the hyperbolic Kepler's equation terminates. */ - -/* - SPICELIB Version 2.0.0, 19-APR-1990 (WLT) */ - -/* A bad initial guess at bracketing the solution to the */ -/* hyperbolic time of flight equation was corrected so that */ -/* floating point overflows are now avoided. In addition, the */ -/* Newton's method used before has been replaced by simply */ -/* bisection. */ - -/* - Beta Version 1.1.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 8-JAN-1989 (IMU) */ - -/* The routine now verifies that the eccentricity is in the */ -/* proper range---(1,+infinity)---before proceeding. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("HYPTOF", (ftnlen)6); - } - if (first) { - first = FALSE_; - maxlog = log(dpmax_()); - } - if (*ecc < 1.) { - sigerr_("SPICE(WRONGCONIC)", (ftnlen)17); - chkout_("HYPTOF", (ftnlen)6); - return 0; - } - -/* For reasons of numerical stability, we have to intercept cases */ -/* where the mean anomaly is zero or negative (since log x is not */ -/* defined for non-positive x). If the mean anomaly is zero, the */ -/* eccentric anomaly is also zero (by inspection). */ - -/* Since the function e sinh(F) - F is an odd function, we can */ -/* solve the equation ABS(MA) = e sinh(F) - F for F and get */ -/* the solution to MA = e sinh(F) - F by negating F if MA is */ -/* less than 0. */ - - if (*ma == 0.) { - *f = 0.; - chkout_("HYPTOF", (ftnlen)6); - return 0; - } else { - m = abs(*ma); - } - -/* The initial bounds for the eccentric anomaly F are determined */ -/* as follows: */ - -/* For the value of F we seek, */ - -/* M = e sinh F - F */ - -/* Thus */ - -/* M < e sinh F = (e/2) { Exp(F) - Exp(-F)} */ - -/* Hence */ - -/* 2 M 1 */ -/* --- < Exp(F) - ----- */ -/* e Exp(F) */ - -/* which yields */ - - -/* 2 M Exp(F) */ -/* ---------- < Exp(F)**2 - 1 */ -/* e */ - -/* and */ - -/* M**2 2M Exp(F) M**2 */ -/* 1 + ---- < Exp(F)**2 - --------- + ---- = {Exp(F) - (M/e)}**2 */ -/* e**2 e e**2 */ - - -/* Therefore we must have one of the following be true. */ - - -/* SQRT( 1 + (M/e)**2 ) < Exp(F) - (M/e) */ - -/* or */ - -/* - SQRT( 1 + (M/e)**2 ) > Exp(F) - (M/e) */ - -/* The second case implies that */ - -/* 0 > (M/e) - SQRT( 1 + (M/e)**2 ) > Exp(F) */ - -/* but since Exp(F) > 0 for all F it must be the case that */ - -/* (M/e) + SQRT( 1 + (M/e)**2 ) < Exp(F) */ - - -/* Hence */ - -/* Log ( (M/e) + SQRT(1 + (M/e)**2) ) < F */ - - - -/* Returning to our initial equation: */ - -/* M = e sinh F - F */ - -/* 3 5 */ -/* F F */ -/* = e ( F + --- + --- + ... ) - F */ -/* 3! 5! */ - -/* 3 */ -/* > eF / 6 */ - -/* Thus */ - - -/* 3 __________ */ -/* F < \/ 6M / e */ - - -/* Thus our solution must satisfy the inequalities */ - - -/* 3 __________ */ -/* LOG ( (M/e) + SQRT(1 + (M/e)**2) ) < F < \/ 6M/e */ - - -/* In addition we know that the solution must lie somewhere */ -/* in the region between 0 and the maximum value of F for which */ -/* (e sinh F - F) can be computed. This turns out to be */ -/* approximately LOG( DPMAX() / e ) = LOG(DPMAX()) - LOG(e) . */ - - -/* Computing 2nd power */ - d__1 = m / *ecc; - lower = log(m / *ecc + sqrt(d__1 * d__1 + 1.)); -/* Computing MIN */ - d__3 = m * 6. / *ecc; - d__1 = dcbrt_(&d__3), d__2 = maxlog - log(*ecc); - upper = min(d__1,d__2); - upper = max(lower,upper); - -/* Perform some simple checks first to avoid problems with */ -/* convergence of the loop below. If LOWER is zero, then */ -/* M/ECC is so small that when added to 1 it doesn't make */ -/* any difference ( dLOG/dt = 1 at 1 after all). So in this */ -/* case we will just solve the linear portion of the */ -/* expansion of e SINH(F) - F = M */ - - -/* Now we simply perform bisection to locate the root. */ - -/* Computing MAX */ -/* Computing MIN */ - d__3 = upper, d__4 = upper * .5 + lower * .5; - d__1 = lower, d__2 = min(d__3,d__4); - middle = max(d__1,d__2); - midval = *ecc * sinh(middle) - middle - m; - diff = upper - lower; - -/* Finally pick a reasonable upper bound on the number of loop */ -/* iterations we shall need to perform. */ - - mcount = 100; - count = 0; - while(diff > 0. && count < mcount) { - -/* Move one of the endpoints to the middle. */ - - if (midval > 0.) { - upper = middle; - } else if (midval < 0.) { - lower = middle; - } else { - lower = middle; - upper = middle; - } - -/* Compute the next middle point. */ - -/* Computing MAX */ -/* Computing MIN */ - d__3 = upper, d__4 = upper * .5 + lower * .5; - d__1 = lower, d__2 = min(d__3,d__4); - middle = max(d__1,d__2); - lastdf = diff; - ++count; - -/* If we are on an endpoint, we are ready to call it quits. */ - - if (middle == lower || middle == upper) { - diff = 0.; - } else { - diff = upper - lower; - midval = *ecc * sinh(middle) - middle - m; - } - } - -/* Restore the proper sign, if necessary. */ - - if (*ma < 0.) { - *f = -middle; - } else { - *f = middle; - } - chkout_("HYPTOF", (ftnlen)6); - return 0; -} /* hyptof_ */ - diff --git a/ext/spice/src/cspice/i_abs.c b/ext/spice/src/cspice/i_abs.c deleted file mode 100644 index be21295aaa..0000000000 --- a/ext/spice/src/cspice/i_abs.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer i_abs(x) integer *x; -#else -integer i_abs(integer *x) -#endif -{ -if(*x >= 0) - return(*x); -return(- *x); -} diff --git a/ext/spice/src/cspice/i_dim.c b/ext/spice/src/cspice/i_dim.c deleted file mode 100644 index 6e1b1707b5..0000000000 --- a/ext/spice/src/cspice/i_dim.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer i_dim(a,b) integer *a, *b; -#else -integer i_dim(integer *a, integer *b) -#endif -{ -return( *a > *b ? *a - *b : 0); -} diff --git a/ext/spice/src/cspice/i_dnnt.c b/ext/spice/src/cspice/i_dnnt.c deleted file mode 100644 index b5d5006f66..0000000000 --- a/ext/spice/src/cspice/i_dnnt.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -integer i_dnnt(x) doublereal *x; -#else -#undef abs -#include "math.h" -integer i_dnnt(doublereal *x) -#endif -{ -return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x)); -} diff --git a/ext/spice/src/cspice/i_indx.c b/ext/spice/src/cspice/i_indx.c deleted file mode 100644 index 96e7bc51ba..0000000000 --- a/ext/spice/src/cspice/i_indx.c +++ /dev/null @@ -1,26 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; -#else -integer i_indx(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -ftnlen i, n; -char *s, *t, *bend; - -n = la - lb + 1; -bend = b + lb; - -for(i = 0 ; i < n ; ++i) - { - s = a + i; - t = b; - while(t < bend) - if(*s++ != *t++) - goto no; - return(i+1); - no: ; - } -return(0); -} diff --git a/ext/spice/src/cspice/i_len.c b/ext/spice/src/cspice/i_len.c deleted file mode 100644 index 4020fee461..0000000000 --- a/ext/spice/src/cspice/i_len.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer i_len(s, n) char *s; ftnlen n; -#else -integer i_len(char *s, ftnlen n) -#endif -{ -return(n); -} diff --git a/ext/spice/src/cspice/i_mod.c b/ext/spice/src/cspice/i_mod.c deleted file mode 100644 index 6937c42135..0000000000 --- a/ext/spice/src/cspice/i_mod.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer i_mod(a,b) integer *a, *b; -#else -integer i_mod(integer *a, integer *b) -#endif -{ -return( *a % *b); -} diff --git a/ext/spice/src/cspice/i_nint.c b/ext/spice/src/cspice/i_nint.c deleted file mode 100644 index 676f9b3474..0000000000 --- a/ext/spice/src/cspice/i_nint.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -integer i_nint(x) real *x; -#else -#undef abs -#include "math.h" -integer i_nint(real *x) -#endif -{ -return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x)); -} diff --git a/ext/spice/src/cspice/i_sign.c b/ext/spice/src/cspice/i_sign.c deleted file mode 100644 index 94009b86e6..0000000000 --- a/ext/spice/src/cspice/i_sign.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer i_sign(a,b) integer *a, *b; -#else -integer i_sign(integer *a, integer *b) -#endif -{ -integer x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); -} diff --git a/ext/spice/src/cspice/ident.c b/ext/spice/src/cspice/ident.c deleted file mode 100644 index 914d9334d4..0000000000 --- a/ext/spice/src/cspice/ident.c +++ /dev/null @@ -1,139 +0,0 @@ -/* ident.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure IDENT (Return the 3x3 identity matrix) */ -/* Subroutine */ int ident_(doublereal *matrix) -{ -/* $ Abstract */ - -/* This routine returns the 3x3 identity matrix. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX O is the 3x3 identity matrix */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* MATRIX is the 3x3 Identity matrix. That is MATRIX is */ -/* the following */ -/* _ _ */ -/* | 1.0D0 0.0D0 0.0D0 | */ -/* | 0.0D0 1.0D0 0.0D0 | */ -/* | 0.0D0 0.0D0 1.0D0 | */ -/* - - */ -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a utility routine for obtaining the 3x3 identity matrix */ -/* so that you may avoid having to write the loop or assignments */ -/* needed to get the matrix. */ - -/* $ Examples */ - -/* Suppose that you need to construct the matrix sum */ - -/* I + OMEGA */ - -/* where OMEGA is some matrix you have already computed. */ - -/* The code fragment below shows how you could accomplish this */ -/* with this routine. */ - -/* First get the Identity matrix */ - -/* DOUBLE PRECISION I ( 3, 3 ) */ - -/* CALL IDENT( I ) */ -/* CALL VSUMG( I, OMEGA, 9, SUM ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 5-FEB-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the 3x3 identity matrix */ - -/* -& */ - matrix[0] = 1.; - matrix[1] = 0.; - matrix[2] = 0.; - matrix[3] = 0.; - matrix[4] = 1.; - matrix[5] = 0.; - matrix[6] = 0.; - matrix[7] = 0.; - matrix[8] = 1.; - return 0; -} /* ident_ */ - diff --git a/ext/spice/src/cspice/ident_c.c b/ext/spice/src/cspice/ident_c.c deleted file mode 100644 index 71a36f9e8f..0000000000 --- a/ext/spice/src/cspice/ident_c.c +++ /dev/null @@ -1,149 +0,0 @@ -/* - --Procedure ident_c (Return the 3x3 identity matrix) - --Abstract - - This routine returns the 3x3 identity matrix. - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - void ident_c ( SpiceDouble matrix[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - matrix O is the 3x3 identity matrix. - --Detailed_Input - - None. - --Detailed_Output - - matrix is the 3x3 Identity matrix. That is MATRIX is - the following - _ _ - | 1.0 0.0 0.0 | - | 0.0 1.0 0.0 | - | 0.0 0.0 1.0 | - - - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - --Particulars - - This is a utility routine for obtaining the 3x3 identity matrix - so that you may avoid having to write the loop or assignments - needed to get the matrix. - --Examples - - Suppose that you need to construct the matrix sum - - ident + omega - - where omega is some matrix you have already computed. - - The code fragment below shows how you could accomplish this - with this routine. - - First get the Identity matrix - - #include "SpiceUsr.h" - . - . - . - - SpiceDouble ident[3][3]; - - ident_c ( ident ); - vaddg_c ( ident, omega, 9, sum ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 1-JUN-1999 (NJB) (WLT) - --Index_Entries - - Get the 3x3 identity matrix - --& -*/ - -{ /* Begin ident_c */ - - - matrix[0][0] = 1.0; - matrix[0][1] = 0.0; - matrix[0][2] = 0.0; - matrix[1][0] = 0.0; - matrix[1][1] = 1.0; - matrix[1][2] = 0.0; - matrix[2][0] = 0.0; - matrix[2][1] = 0.0; - matrix[2][2] = 1.0; - -} /* End ident_c */ diff --git a/ext/spice/src/cspice/idw2at.c b/ext/spice/src/cspice/idw2at.c deleted file mode 100644 index 7d581d4a24..0000000000 --- a/ext/spice/src/cspice/idw2at.c +++ /dev/null @@ -1,385 +0,0 @@ -/* idw2at.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure IDW2AT ( Get file architecture and type from ID word ) */ -/* Subroutine */ int idw2at_(char *idword, char *arch, char *type__, ftnlen - idword_len, ftnlen arch_len, ftnlen type_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char part1[8], part2[8]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer slash; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Extract the architecture and type of a SPICE binary kernel file */ -/* from a file ID word. */ - -/* $ 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 */ - -/* KERNEL */ -/* UTILITY */ - -/* $ Declarations */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IDWORD I The IDWORD to be examined. */ -/* ARCH O The file architecture DAS or DAF. */ -/* TYPE O The type of the file. */ - -/* $ Detailed_Input */ - -/* IDWORD is the ID word from a SPICE binary kernel file or a */ -/* text version of a binary kernel file whose */ -/* architecture and type are to be extracted. */ - -/* $ Detailed_Output */ - -/* ARCH is the file architecture used to store the data in */ -/* a SPICE binary kernel file. If the architecture cannot */ -/* be extracted or is not recognized the value '?' is */ -/* returned. */ - -/* The possible architectures are: */ - -/* ASC -- An ASCII text file. */ -/* DAF -- A DAF based file. */ -/* DAS -- A DAS based file. */ -/* KPL -- Kernel Pool File (i.e., a text kernel) */ -/* TXT -- An ASCII text file. */ -/* TE1 -- Text E-Kernel type 1. */ - -/* TYPE is the type of the SPICE file. If the type can not be */ -/* extracted or if it is blank, the value '?' is */ -/* returned. */ - -/* The type can only be extracted by this routine if */ -/* the ID word follows the convention */ - -/* / */ - -/* where is one of the file architectures */ -/* specified above, and */ - -/* = 'xxxx' */ - -/* where 'xxxx' represents a four character mnemonic or */ -/* code for the file type. */ - -/* This subroutine does not do any checking of the file */ -/* types. If a valid architecture is found and the type */ -/* is non-blank, that is what will be returned. It is up */ -/* to a higher level athority to determine whether a type */ -/* is valid. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the variable ID word is blank, both the architecture and */ -/* type will be unknown, specified by '?'. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This subroutine is a support utility routine that attempts */ -/* to extract the architecture and type of a file from its ID word. */ -/* It may not be possible to determine the type of the file from the */ -/* ID word alone. Older files which contain the ID words 'NAIF/NIP', */ -/* or 'NAIF/DAF' do not have sufficient information in the ID word to */ -/* determine the type of the file. A type for the ID word 'NAIF/DAS' */ -/* is always 'PRE ', since files with this ID word were pre-release */ -/* DAS files. */ - -/* A file architecture can always be extracted from a valid SPICE */ -/* ID word. */ - -/* This subroutine and the subroutine GETFAT (get file architecture */ -/* and type) are intimately related. Whenever one of them is modified */ -/* the other should be checked to see if the modifications affect it. */ -/* Whenever a new architecture is added, both of the subroutines are */ -/* affected. */ - -/* $ Examples */ - -/* Suppose you wish to write a single routine for converting files */ -/* between text and binary formats. You can use this routine to */ -/* determine the architecture and type of the file and then pass the */ -/* file to the appropriate low level file conversion routine to */ -/* handle the actual conversion. */ - -/* CALL IDW2AT ( IDWORD, ARCH, TYPE ) */ - -/* IF ( ARCH .EQ. 'DAF' ) THEN */ - -/* convert a DAF file */ - -/* ELSE IF ( ARCH .EQ. 'DAS' ) THEN */ - -/* convert a DAS file */ - -/* ELSE */ - -/* WRITE(*,*) 'File architecture not supported.' */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 26-OCT-1995 (KRG) */ - -/* Changed the Version line from "Beta" to "SPICELIB" for the */ -/* current revisions. The subroutine was already in SPICELIB, */ -/* but the Version line said "Beta." */ - -/* Added several new architectures: */ - -/* KPL -- Kernel Pool File (i.e., a text kernel) */ -/* TXT -- An ASCII text file. */ -/* ASC -- An ASCII text file. */ -/* TE1 -- Text E-Kernel type 1. */ - -/* Changed the response foe the ID word 'NAIF/DAS' to be */ -/* consistent with GETFAT. It now sets the architecture to 'DAS' */ -/* and the type to 'PRE', for pre-release version. */ - -/* - Beta Version 1.0.0, 30-SEP-1993 (KRG) */ - -/* -& */ - -/* $ Index_Entries */ - -/* extract architecture and type from an id word */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 26-OCT-1995 (KRG) */ - -/* Changed the Version line from "Beta" to "SPICELIB" for the */ -/* current revisions. The subroutine was already in SPICELIB, */ -/* but the Version line said "Beta." */ - -/* Added several new architectures: */ - -/* KPL -- Kernel Pool File (i.e., a text kernel) */ -/* TXT -- An ASCII text file. */ -/* ASC -- An ASCII text file. */ -/* TE1 -- Text E-Kernel type 1. */ - -/* Changed the response foe the ID word 'NAIF/DAS' to be */ -/* consistent with GETFAT. It now sets the architecture to 'DAS' */ -/* and the type to 'PRE', for pre-release version. */ - -/* -& */ - -/* Spicelib Routines */ - - -/* Set the length of a SPICE file ID word. */ - - -/* Local Variables */ - - -/* Standard obligatory error handling stuff. */ - - if (return_()) { - return 0; - } else { - chkin_("IDW2AT", (ftnlen)6); - } - -/* Check to see if we got a blank string for the ID word. If we did, */ -/* set the architecture and type to unknown. */ - - if (s_cmp(idword, " ", idword_len, (ftnlen)1) == 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - chkout_("IDW2AT", (ftnlen)6); - return 0; - } - -/* Initialize the temporary storage variables that we use. */ - - s_copy(part1, " ", (ftnlen)8, (ftnlen)1); - s_copy(part2, " ", (ftnlen)8, (ftnlen)1); - -/* See if we can get the architecture and type from the ID word. */ - -/* Look for a '/' in the string. If we can't find it, we don't */ -/* recognize the architecture or the type, so set the architecture */ -/* and type to unknown. */ - - slash = pos_(idword, "/", &c__1, idword_len, (ftnlen)1); - if (slash == 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - chkout_("IDW2AT", (ftnlen)6); - return 0; - } - -/* The part before the slash is the architecture or the word 'NAIF' */ -/* in older files and the part after the slash is the type of file or */ -/* the architecture in older files. */ - - s_copy(part1, idword, (ftnlen)8, slash - 1); - i__1 = slash; - s_copy(part2, idword + i__1, (ftnlen)8, idword_len - i__1); - -/* Let's now do some testing to try and figure out what's going on. */ - -/* First we look for the information in the ID word format: */ - -/* /, */ - -/* then we look for the things that begin with the word 'NAIF' */ - - if (s_cmp(part1, "DAF", (ftnlen)8, (ftnlen)3) == 0) { - -/* We have a DAF file, so set the architecture and type. */ - - s_copy(arch, "DAF", arch_len, (ftnlen)3); - if (s_cmp(part2, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(type__, part2, type_len, (ftnlen)8); - } else { - s_copy(type__, "?", type_len, (ftnlen)1); - } - } else if (s_cmp(part1, "DAS", (ftnlen)8, (ftnlen)3) == 0) { - -/* We have a DAS file, so set the architecture and type. */ - - s_copy(arch, "DAS", arch_len, (ftnlen)3); - if (s_cmp(part2, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(type__, part2, type_len, (ftnlen)8); - } else { - s_copy(type__, "?", type_len, (ftnlen)1); - } - } else if (s_cmp(part1, "TXT", (ftnlen)8, (ftnlen)3) == 0) { - -/* We have an ASCII text file, so set the architecture and type. */ - - s_copy(arch, "TXT", arch_len, (ftnlen)3); - if (s_cmp(part2, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(type__, part2, type_len, (ftnlen)8); - } else { - s_copy(type__, "?", type_len, (ftnlen)1); - } - } else if (s_cmp(part1, "ASC", (ftnlen)8, (ftnlen)3) == 0) { - -/* We have an ASCII text file, so set the architecture and type. */ - - s_copy(arch, "TXT", arch_len, (ftnlen)3); - if (s_cmp(part2, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(type__, part2, type_len, (ftnlen)8); - } else { - s_copy(type__, "?", type_len, (ftnlen)1); - } - } else if (s_cmp(part1, "KPL", (ftnlen)8, (ftnlen)3) == 0) { - -/* We have a kernel pool file, so set the architecture and type. */ - - s_copy(arch, "KPL", arch_len, (ftnlen)3); - if (s_cmp(part2, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(type__, part2, type_len, (ftnlen)8); - } else { - s_copy(type__, "?", type_len, (ftnlen)1); - } - } else if (s_cmp(part1, "NAIF", (ftnlen)8, (ftnlen)4) == 0) { - -/* We have a DAF (or NIP, these are equivalent) or DAS file, */ -/* identified by the value of PART2, but we have no idea what the */ -/* type is, unless the file is a DAS file, in which case it is a */ -/* pre-release EK file, since these are the only DAS files which */ -/* used the 'NAIF/DAS' ID word. */ - -/* First, we determine the architecture from PART2, then if it is */ -/* DAF or NIP, we give up on the type. As mentioned above, if */ -/* PART2 contains DAS, we know a priori the type of the file. */ - - if (s_cmp(part2, "DAF", (ftnlen)8, (ftnlen)3) == 0 || s_cmp(part2, - "NIP", (ftnlen)8, (ftnlen)3) == 0) { - s_copy(arch, "DAF", arch_len, (ftnlen)3); - s_copy(type__, "?", type_len, (ftnlen)1); - } else if (s_cmp(part2, "DAS", (ftnlen)8, (ftnlen)3) == 0) { - s_copy(arch, "DAS", arch_len, (ftnlen)3); - s_copy(type__, "PRE", type_len, (ftnlen)3); - } else { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - } - } else { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - } - chkout_("IDW2AT", (ftnlen)6); - return 0; -} /* idw2at_ */ - diff --git a/ext/spice/src/cspice/iio.c b/ext/spice/src/cspice/iio.c deleted file mode 100644 index 58b2a75cdd..0000000000 --- a/ext/spice/src/cspice/iio.c +++ /dev/null @@ -1,148 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" -extern char *f__icptr; -char *f__icend; -extern icilist *f__svic; -int f__icnum; -extern int f__hiwater; -z_getc(Void) -{ - if(f__recpos++ < f__svic->icirlen) { - if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile"); - return(*(unsigned char *)f__icptr++); - } - return '\n'; -} - - void -#ifdef KR_headers -z_putc(c) -#else -z_putc(int c) -#endif -{ - if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen) - *f__icptr++ = c; -} -z_rnew(Void) -{ - f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen; - f__recpos = 0; - f__cursor = 0; - f__hiwater = 0; - return 1; -} - - static int -z_endp(Void) -{ - (*f__donewrec)(); - return 0; - } - -#ifdef KR_headers -c_si(a) icilist *a; -#else -c_si(icilist *a) -#endif -{ - f__elist = (cilist *)a; - f__fmtbuf=a->icifmt; - f__curunit = 0; - f__sequential=f__formatted=1; - f__external=0; - if(pars_f(f__fmtbuf)<0) - err(a->icierr,100,"startint"); - fmt_bg(); - f__cblank=f__cplus=f__scale=0; - f__svic=a; - f__icnum=f__recpos=0; - f__cursor = 0; - f__hiwater = 0; - f__icptr = a->iciunit; - f__icend = f__icptr + a->icirlen*a->icirnum; - f__cf = 0; - return(0); -} - - int -iw_rev(Void) -{ - if(f__workdone) - z_endp(); - f__hiwater = f__recpos = f__cursor = 0; - return(f__workdone=0); - } - -#ifdef KR_headers -integer s_rsfi(a) icilist *a; -#else -integer s_rsfi(icilist *a) -#endif -{ int n; - if(n=c_si(a)) return(n); - f__reading=1; - f__doed=rd_ed; - f__doned=rd_ned; - f__getn=z_getc; - f__dorevert = z_endp; - f__donewrec = z_rnew; - f__doend = z_endp; - return(0); -} - -z_wnew(Void) -{ - if (f__recpos < f__hiwater) { - f__icptr += f__hiwater - f__recpos; - f__recpos = f__hiwater; - } - while(f__recpos++ < f__svic->icirlen) - *f__icptr++ = ' '; - f__recpos = 0; - f__cursor = 0; - f__hiwater = 0; - f__icnum++; - return 1; -} -#ifdef KR_headers -integer s_wsfi(a) icilist *a; -#else -integer s_wsfi(icilist *a) -#endif -{ int n; - if(n=c_si(a)) return(n); - f__reading=0; - f__doed=w_ed; - f__doned=w_ned; - f__putn=z_putc; - f__dorevert = iw_rev; - f__donewrec = z_wnew; - f__doend = z_endp; - return(0); -} -integer e_rsfi(Void) -{ int n = en_fio(); - f__fmtbuf = NULL; - return(n); -} -integer e_wsfi(Void) -{ - int n; - n = en_fio(); - f__fmtbuf = NULL; - if(f__svic->icirnum != 1 - && (f__icnum > f__svic->icirnum - || (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater)))) - err(f__svic->icierr,110,"inwrite"); - if (f__recpos < f__hiwater) - f__recpos = f__hiwater; - if (f__recpos >= f__svic->icirlen) - err(f__svic->icierr,110,"recend"); - if (!f__recpos && f__icnum) - return n; - while(f__recpos++ < f__svic->icirlen) - *f__icptr++ = ' '; - return n; -} diff --git a/ext/spice/src/cspice/illum.c b/ext/spice/src/cspice/illum.c deleted file mode 100644 index 603b93ee58..0000000000 --- a/ext/spice/src/cspice/illum.c +++ /dev/null @@ -1,748 +0,0 @@ -/* illum.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__3 = 3; - -/* $Procedure ILLUM ( Illumination angles ) */ -/* Subroutine */ int illum_(char *target, doublereal *et, char *abcorr, char * - obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar, - doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen - obsrvr_len) -{ - extern doublereal vsep_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer n; - doublereal radii[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - integer obscde; - doublereal lt; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer frcode; - extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical - *, ftnlen); - char frname[80]; - integer trgcde; - doublereal offobs[3], obsvec[3], tepoch, normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal offsun[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - doublereal sstate[6], sunvec[3], tstate[6]; - extern /* Subroutine */ int surfnm_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - doublereal lts; - -/* $ Abstract */ - -/* Deprecated: This routine has been superseded by the SPICELIB */ -/* routine ILUMIN. This routine is supported for purposes of */ -/* backward compatibility only. */ - -/* Find the illumination angles at a specified surface point of a */ -/* target body. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MOSPICE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000. */ -/* ABCORR I Desired aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* SPOINT I Body-fixed coordinates of a target surface point. */ -/* PHASE O Phase angle at the surface point. */ -/* SOLAR O Solar incidence angle at the surface point. */ -/* EMISSN O Emission angle at the surface point. */ - -/* $ Detailed_Input */ - -/* TARGET is the name of the target body. TARGET is */ -/* case-insensitive, and leading and trailing blanks */ -/* in TARGET are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the moon is the */ -/* target body. */ - -/* ET is the epoch, specified in ephemeris seconds past */ -/* J2000, at which the apparent illumination angles at */ -/* the specified surface point on the target body, as */ -/* seen from the observing body, are to be computed. */ - -/* ABCORR is the aberration correction to be used in */ -/* computing the location and orientation of the */ -/* target body and the location of the Sun. Possible */ -/* values are: */ - -/* 'NONE' No aberration correction. */ - -/* 'LT' Correct the position and */ -/* orientation of target body for */ -/* light time, and correct the */ -/* position of the Sun for light */ -/* time. */ - -/* 'LT+S' Correct the observer-target vector */ -/* for light time and stellar */ -/* aberration, correct the */ -/* orientation of the target body */ -/* for light time, and correct the */ -/* target-Sun vector for light time */ -/* and stellar aberration. */ - -/* 'CN' Converged Newtonian light time */ -/* corrections. This is the same as */ -/* LT corrections but with further */ -/* iterations to a converged */ -/* Newtonian light time solution. */ -/* Given that relativistic effects */ -/* may be as large as the higher */ -/* accuracy achieved by this */ -/* computation, this is correction */ -/* is seldom worth the additional */ -/* computations required unless the */ -/* user incorporates additional */ -/* relativistic corrections. Both */ -/* the state and rotation of the */ -/* target body are corrected for */ -/* light time. */ - -/* 'CN+S' Converged Newtonian light time */ -/* corrections and stellar */ -/* aberration. Both the state and */ -/* rotation of the target body are */ -/* corrected for light time. */ - -/* OBSRVR is the name of the observing body, typically a */ -/* spacecraft, the earth, or a surface point on the */ -/* earth. OBSRVR is case-insensitive, and leading */ -/* and trailing blanks in OBSRVR are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'EARTH' and '399' are legitimate strings that */ -/* indicate the earth is the observer. */ - -/* OBSRVR may be not be identical to TARGET. */ - -/* SPOINT is a surface point on the target body, expressed */ -/* in rectangular body-fixed (body equator and prime */ -/* meridian) coordinates. SPOINT need not be visible */ -/* from the observer's location at time ET. */ - -/* $ Detailed_Output */ - - -/* PHASE is the phase angle at SPOINT, as seen from OBSRVR */ -/* at time ET. This is the angle between the */ -/* SPOINT-OBSRVR vector and the SPOINT-Sun vector. */ -/* Units are radians. The range of PHASE is [0, pi]. */ -/* See Particulars below for a detailed discussion of */ -/* the definition. */ - -/* SOLAR is the solar incidence angle at SPOINT, as seen */ -/* from OBSRVR at time ET. This is the angle */ -/* between the surface normal vector at SPOINT and the */ -/* SPOINT-Sun vector. Units are radians. The range */ -/* of SOLAR is [0, pi]. See Particulars below for a */ -/* detailed discussion of the definition. */ - -/* EMISSN is the emission angle at SPOINT, as seen from */ -/* OBSRVR at time ET. This is the angle between the */ -/* surface normal vector at SPOINT and the */ -/* SPOINT-observer vector. Units are radians. The */ -/* range of EMISSN is [0, pi]. See Particulars below */ -/* for a detailed discussion of the definition. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If TARGET and OBSRVR are not distinct, the error */ -/* SPICE(BODIESNOTDISTINCT) will be signaled. */ - -/* 2) If no SPK (ephemeris) data are available for the observer, */ -/* target, and Sun at the time specified by ET, the error will */ -/* be diagnosed by routines called by this routine. If light */ -/* time corrections are used, SPK data for the target body must */ -/* be available at the time ET - LT, where LT is the one-way */ -/* light time from the target to the observer at ET. */ -/* Additionally, SPK data must be available for the Sun at the */ -/* time ET - LT - LT2, where LT2 is the light time from the Sun */ -/* to the target body at time ET - LT. */ - -/* 3) If PCK data defining the orientation or shape of the target */ -/* body are unavailable, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 4) If no body-fixed frame is associated with the target body, */ -/* the error SPICE(NOFRAME) is signaled. */ - -/* 5) If name of target or observer cannot be translated to its */ -/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* $ Files */ - -/* No files are input to this routine. However, ILLUM expects */ -/* that the appropriate SPK and PCK files have been loaded via */ -/* FURNSH. */ - -/* $ Particulars */ - - -/* The term "illumination angles" refers to following set of */ -/* angles: */ - - -/* solar incidence angle Angle between the surface normal at */ -/* the specified surface point and the */ -/* vector from the surface point to the */ -/* Sun. */ - -/* emission angle Angle between the surface normal at */ -/* the specified surface point and the */ -/* vector from the surface point to the */ -/* observer. */ - -/* phase angle Angle between the vectors from the */ -/* surface point to the observing body's */ -/* location and from the surface point */ -/* to the Sun. */ - - -/* The diagram below illustrates the geometrical relationships */ -/* defining these angles. The labels for the solar incidence, */ -/* emission, and phase angles are "s.i.", "e.", and "phase". */ - - -/* * */ -/* Sun */ - -/* surface normal vector */ -/* ._ _. */ -/* |\ /| Sun vector */ -/* \ phase / */ -/* \ . . / */ -/* . . */ -/* \ ___ / */ -/* . \/ \/ */ -/* _\ s.i./ */ -/* . / \ / */ -/* . | e. \ / */ -/* * <--------------- * surface point on */ -/* viewing vector target body */ -/* location to viewing */ -/* (observer) location */ - - -/* Note that if the target-observer vector, the target normal vector */ -/* at the surface point, and the target-sun vector are coplanar, */ -/* then phase is the sum of incidence and emission. This is rarely */ -/* true; usually */ - -/* phase angle < solar incidence angle + emission angle */ - -/* All of the above angles can be computed using light time */ -/* corrections, light time and stellar aberration corrections, or */ -/* no aberration corrections. The way aberration corrections */ -/* are used is described below. */ - -/* Care must be used in computing light time corrections. The */ -/* guiding principle used here is "describe what appears in */ -/* an image." We ignore differential light time; the light times */ -/* from all points on the target to the observer are presumed to be */ -/* equal. */ - - -/* Observer-target body vector */ -/* --------------------------- */ - -/* Let ET be the epoch at which an observation or remote */ -/* sensing measurement is made, and let ET - LT ("LT" stands */ -/* for "light time") be the epoch at which the photons received */ -/* at ET were emitted from the body (we use the term "emitted" */ -/* loosely here). */ - -/* The correct observer-target vector points from the observer's */ -/* location at ET to the target body's location at ET - LT. */ -/* The target-observer vector points in the opposite direction. */ - -/* Since light time corrections are not symmetric, the correct */ -/* target-observer vector CANNOT be found by computing the light */ -/* time corrected position of the observer as seen from the */ -/* target body. */ - - -/* Target body's orientation */ -/* ------------------------- */ - -/* Using the definitions of ET and LT above, the target */ -/* body's orientation at ET - LT is used. The surface */ -/* normal is dependent on the target body's orientation, so */ -/* the body's orientation model must be evaluated for the correct */ -/* epoch. */ - - -/* Target body -- Sun vector */ -/* ------------------------- */ - -/* All surface features on the target body will appear in */ -/* a measurement made at ET as they were at ET-LT. In */ -/* particular, lighting on the target body is dependent on */ -/* the apparent location of the Sun as seen from the target */ -/* body at ET-LT. So, a second light time correction is used */ -/* in finding the apparent location of the Sun. */ - - -/* Stellar aberration corrections, when used, are applied as follows: */ - - -/* Observer-target body vector */ -/* --------------------------- */ - -/* In addition to light time correction, stellar aberration is */ -/* used in computing the apparent target body position as seen */ -/* from the observer's location at time ET. This apparent */ -/* position defines the observer-target body vector. */ - - -/* Target body-Sun vector */ -/* ---------------------- */ - -/* The target body-Sun vector is the apparent position of the Sun, */ -/* corrected for light time and stellar aberration, as seen from */ -/* the target body at time ET-LT. Note that the target body's */ -/* position is not affected by the stellar aberration correction */ -/* applied in finding its apparent position as seen by the */ -/* observer. */ - - -/* Once all of the vectors, as well as the target body's */ -/* orientation, have been computed with the proper aberration */ -/* corrections, the element of time is eliminated from the */ -/* computation. The problem becomes a purely geometrical one, */ -/* and is described by the diagram above. */ - - -/* $ Examples */ - -/* The numerical results shown for this example may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* In the following example program, the file */ - -/* spk_m_031103-040201_030502.bsp */ - -/* is a binary SPK file containing data for Mars Global Surveyor, */ -/* Mars, and the Sun for a time interval bracketing the date */ - -/* 2004 JAN 1 12:00:00 UTC. */ - -/* pck00007.tpc is a planetary constants kernel file containing */ -/* radii and rotation model constants. naif0007.tls is a */ -/* leapseconds kernel. */ - -/* Find the phase, solar incidence, and emission angles at the */ -/* sub-solar and sub-spacecraft points on Mars as seen from the */ -/* Mars Global Surveyor spacecraft at a specified UTC time. */ -/* Use light time and stellar aberration corrections. */ - -/* PROGRAM ANGLES */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER NAMLEN */ -/* PARAMETER ( NAMLEN = 32 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 25 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(NAMLEN) OBSRVR */ -/* CHARACTER*(NAMLEN) TARGET */ -/* CHARACTER*(TIMLEN) UTC */ - -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION SSCEMI */ -/* DOUBLE PRECISION SSCPHS */ -/* DOUBLE PRECISION SSCSOL */ -/* DOUBLE PRECISION SSLEMI */ -/* DOUBLE PRECISION SSLPHS */ -/* DOUBLE PRECISION SSLSOL */ -/* DOUBLE PRECISION SSOLPT ( 3 ) */ -/* DOUBLE PRECISION SSCPT ( 3 ) */ - -/* C */ -/* C Load kernel files. */ -/* C */ -/* CALL FURNSH ( 'naif0007.tls' ) */ -/* CALL FURNSH ( 'pck00007.tpc' ) */ -/* CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */ - - -/* C */ -/* C Convert our UTC time to ephemeris seconds past J2000. */ -/* C */ -/* UTC = '2004 JAN 1 12:00:00' */ - -/* CALL UTC2ET ( UTC, ET ) */ - -/* C */ -/* C Assign observer and target names. The acronym MGS */ -/* C indicates Mars Global Surveyor. See NAIF_IDS for a */ -/* C list of names recognized by SPICE. */ -/* C */ -/* TARGET = 'Mars' */ -/* OBSRVR = 'MGS' */ - -/* C */ -/* C Find the sub-solar point on the Earth as seen from */ -/* C the MGS spacecraft at ET. Use the "surface intercept" */ -/* C style of sub-point definition. This makes it easy */ -/* C to verify the solar incidence angle. */ -/* C */ -/* CALL SUBSOL ( 'Near point', TARGET, ET, */ -/* . 'LT+S', OBSRVR, SSOLPT ) */ - -/* C */ -/* C Now find the sub-spacecraft point. Use the */ -/* C "nearest point" definition of the sub-point */ -/* C here---this makes it easy to verify the emission angle. */ -/* C */ -/* CALL SUBPT ( 'Near point', TARGET, ET, */ -/* . 'LT+S', OBSRVR, SSCPT, ALT ) */ - -/* C */ -/* C Find the phase, solar incidence, and emission */ -/* C angles at the sub-solar point on the Earth as seen */ -/* C from Mars Observer at time ET. */ -/* C */ -/* CALL ILLUM ( TARGET, ET, 'LT+S', OBSRVR, */ -/* . SSOLPT, SSLPHS, SSLSOL, SSLEMI ) */ - -/* C */ -/* C Do the same for the sub-spacecraft point. */ -/* C */ -/* CALL ILLUM ( TARGET, ET, 'LT+S', OBSRVR, */ -/* . SSCPT, SSCPHS, SSCSOL, SSCEMI ) */ - -/* C */ -/* C Convert the angles to degrees and write them out. */ -/* C */ -/* SSLPHS = DPR() * SSLPHS */ -/* SSLSOL = DPR() * SSLSOL */ -/* SSLEMI = DPR() * SSLEMI */ - -/* SSCPHS = DPR() * SSCPHS */ -/* SSCSOL = DPR() * SSCSOL */ -/* SSCEMI = DPR() * SSCEMI */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'UTC epoch is ', UTC */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Illumination angles at the sub-solar point:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Phase angle (deg.): ', SSLPHS */ -/* WRITE (*,*) 'Solar incidence angle (deg.): ', SSLSOL */ -/* WRITE (*,*) 'Emission angle (deg.): ', SSLEMI */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'The solar incidence angle should be 0.' */ -/* WRITE (*,*) 'The emission and phase angles should be equal.' */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Illumination angles at the sub-s/c point:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Phase angle (deg.): ', SSCPHS */ -/* WRITE (*,*) 'Solar incidence angle (deg.): ', SSCSOL */ -/* WRITE (*,*) 'Emission angle (deg.): ', SSCEMI */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'The emission angle should be 0.' */ -/* WRITE (*,*) 'The solar incidence and phase angles should '// */ -/* . 'be equal.' */ - -/* END */ - - -/* When this program is executed, the output will be: */ - - -/* UTC epoch is 2004 JAN 1 12:00:00 */ - -/* Illumination angles at the sub-solar point: */ - -/* Phase angle (deg.): 150.210714 */ -/* Solar incidence angle (deg.): 6.3735213E-15 */ -/* Emission angle (deg.): 150.210714 */ - -/* The solar incidence angle should be 0. */ -/* The emission and phase angles should be equal. */ - -/* Illumination angles at the sub-s/c point: */ - -/* Phase angle (deg.): 123.398202 */ -/* Solar incidence angle (deg.): 123.398202 */ -/* Emission angle (deg.): 6.36110936E-15 */ - -/* The emission angle should be 0. */ -/* The solar incidence and phase angles should be equal. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.2, 18-MAY-2010 (BVS) */ - -/* Index lines now state that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */ - -/* Abstract now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB calls. Replaced call to BODVAR with call to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to support representations of integers in the input */ -/* arguments TARGET and OBSRVR. */ - -/* - SPICELIB Version 1.0.2, 27-JUL-2003 (NJB) (CHA) */ - -/* Various header corrections were made. The example program */ -/* was upgraded to use real kernels, and the program's output is */ -/* shown. */ - -/* - SPICELIB Version 1.0.1, 10-JUL-2002 (NJB) */ - -/* Updated Index_Entries header section. */ - -/* - SPICELIB Version 1.0.0, 21-MAR-1999 (NJB) */ - -/* Adapted from the MGSSPICE version dated 10-MAR-1992. */ -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED illumination angles */ -/* DEPRECATED lighting angles */ -/* DEPRECATED phase angle */ -/* DEPRECATED solar incidence angle */ -/* DEPRECATED emission angle */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB calls. Replaced call to BODVAR with call to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to support representations of integers in the */ -/* input arguments TARGET and OBSRVR: calls to BODN2C */ -/* were replaced by calls to BODS2C. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ILLUM", (ftnlen)5); - } - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &found, target_len); - if (! found) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ILLUM", (ftnlen)5); - return 0; - } - bods2c_(obsrvr, &obscde, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ILLUM", (ftnlen)5); - return 0; - } - -/* The observer and target must be distinct. */ - - if (trgcde == obscde) { - setmsg_("Target is #; observer is #.", (ftnlen)27); - errch_("#", target, (ftnlen)1, target_len); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ILLUM", (ftnlen)5); - return 0; - } - -/* Find the name of the body-fixed frame associated with the */ -/* target body. We'll want the state of the target relative to */ -/* the observer in this body-fixed frame. */ - - cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80); - if (! found) { - setmsg_("No body-fixed frame is associated with target body #; a fra" - "me kernel must be loaded to make this association. Consult " - "the FRAMES Required Reading for details.", (ftnlen)159); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ILLUM", (ftnlen)5); - return 0; - } - -/* Find the body-fixed state of the target as seen from the observer */ -/* at ET. The appropriate aberration corrections will be used in */ -/* evaluating this state. */ - - spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, <, (ftnlen)80, - abcorr_len); - -/* Determine the epoch to be used in computing the target-Sun vector. */ - - if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) { - tepoch = *et; - } else { - tepoch = *et - lt; - } - -/* Find the body-fixed state of the Sun as seen from the target at */ -/* TEPOCH. */ - - spkez_(&c__10, &tepoch, frname, abcorr, &trgcde, sstate, <s, (ftnlen)80, - abcorr_len); - -/* Grab the position portions of the states (the first three */ -/* elements of each state). Negate the observer-target vector, */ -/* since the vector required for the illumination angle */ -/* computation is the target-observer vector. The vectors we've */ -/* found point from the target body center to the observer and */ -/* Sun, and already take light time corrections into account. */ - - vminus_(tstate, obsvec); - vequ_(sstate, sunvec); - -/* Now we'll modify target-observer and target-Sun vectors to */ -/* take into account the offset between the target center and the */ -/* surface point of interest; we want the vectors to point from */ -/* the surface point to the observer and Sun respectively. */ - - vsub_(obsvec, spoint, offobs); - vsub_(sunvec, spoint, offsun); - -/* Find the surface normal at SPOINT. We'll need the radii of the */ -/* target body. */ - - bodvcd_(&trgcde, "RADII", &c__3, &n, radii, (ftnlen)5); - surfnm_(radii, &radii[1], &radii[2], spoint, normal); - -/* Find the illumination angles. VSEP will give us angular */ -/* separation in radians. */ - - *phase = vsep_(offsun, offobs); - *solar = vsep_(normal, offsun); - *emissn = vsep_(normal, offobs); - chkout_("ILLUM", (ftnlen)5); - return 0; -} /* illum_ */ - diff --git a/ext/spice/src/cspice/illum_c.c b/ext/spice/src/cspice/illum_c.c deleted file mode 100644 index 5e73751d79..0000000000 --- a/ext/spice/src/cspice/illum_c.c +++ /dev/null @@ -1,625 +0,0 @@ -/* - --Procedure illum_c ( Illumination angles ) - --Abstract - - Deprecated: This routine has been superseded by the CSPICE - routine ilumin_c. This routine is supported for purposes of - backward compatibility only. - - Find the illumination angles at a specified surface point of a - target body. - --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 - - KERNEL - NAIF_IDS - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef illum_c - - - void illum_c ( ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - target I Name of target body. - et I Epoch in ephemeris seconds past J2000. - abcorr I Desired aberration correction. - obsrvr I Name of observing body. - spoint I Body-fixed coordinates of a target surface point. - phase O Phase angle at the surface point. - solar O Solar incidence angle at the surface point. - emissn O Emission angle at the surface point. - --Detailed_Input - - target is the name of the target body. `target' is - case-insensitive, and leading and trailing blanks in - `target' are not significant. Optionally, you may - supply a string containing the integer ID code for - the object. For example both "MOON" and "301" are - legitimate strings that indicate the moon is the - target body. - - et is the epoch, specified in ephemeris seconds past - J2000, at which the apparent illumination angles at - the specified surface point on the target body, as - seen from the observing body, are to be computed. - - abcorr is the aberration correction to be used in - computing the location and orientation of the - target body and the location of the Sun. Possible - values are: - - "NONE" No aberration correction. - - "LT" Correct the position and - orientation of target body for - light time, and correct the - position of the Sun for light - time. - - "LT+S" Correct the observer-target vector - for light time and stellar - aberration, correct the - orientation of the target body - for light time, and correct the - target-Sun vector for light time - and stellar aberration. - - "CN" Converged Newtonian light time - corrections. This is the same as LT - corrections but with further - iterations to a converged Newtonian - light time solution. Given that - relativistic effects may be as large - as the higher accuracy achieved by - this computation, this is correction - is seldom worth the additional - computations required unless the - user incorporates additional - relativistic corrections. Both the - state and rotation of the target - body are corrected for light time. - - "CN+S" Converged Newtonian light time - corrections and stellar aberration. - Both the state and rotation of the - target body are corrected for light - time. - - obsrvr is the name of the observing body. This is - typically a spacecraft, the earth, or a surface point - on the earth. `obsrvr' is case-insensitive, and - leading and trailing blanks in `obsrvr' are not - significant. Optionally, you may supply a string - containing the integer ID code for the object. For - example both "EARTH" and "399" are legitimate strings - that indicate the earth is the observer. - - `obsrvr' may be not be identical to `target'. - - spoint is a surface point on the target body, expressed - in rectangular body-fixed (body equator and prime - meridian) coordinates. `spoint' need not be visible - from the observer's location at time `et'. - --Detailed_Output - - - phase is the phase angle at `spoint', as seen from `obsrvr' - at time `et'. This is the angle between the - spoint-obsrvr vector and the spoint-sun vector. - Units are radians. The range of `phase' is [0, pi]. - See Particulars below for a detailed discussion of - the definition. - - solar is the solar incidence angle at `spoint', as seen - from `obsrvr' at time `et'. This is the angle - between the surface normal vector at `spoint' and the - spoint-sun vector. Units are radians. The range - of `solar' is [0, pi]. See Particulars below for a - detailed discussion of the definition. - - emissn is the emission angle at `spoint', as seen from - `obsrvr' at time `et'. This is the angle between the - surface normal vector at `spoint' and the - spoint-observer vector. Units are radians. The - range of `emissn' is [0, pi]. See Particulars below - for a detailed discussion of the definition. - --Parameters - - None. - --Exceptions - - - 1) If `target' and `obsrvr' are not distinct, the error - SPICE(BODIESNOTDISTINCT) will be signaled. - - 2) If no SPK (ephemeris) data are available for the observer, - target, and Sun at the time specified by `et', the error will - be diagnosed by routines called by this routine. If light - time corrections are used, SPK data for the target body must - be available at the time et - lt, where `lt' is the one-way - light time from the target to the observer at `et'. - Additionally, SPK data must be available for the Sun at the - time et - lt - lt2, where lt2 is the light time from the Sun - to the target body at time et - lt. - - 3) If PCK data defining the orientation or shape of the target - body are unavailable, the error will be diagnosed by routines - called by this routine. - - 4) If no body-fixed frame is associated with the target body, - the error SPICE(NOFRAME) is signaled. - - 5) If name of `target' or `obsrvr' cannot be translated to its - NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. - --Files - - No files are input to this routine. However, illum_c expects - that the appropriate SPK and PCK files have been loaded via - furnsh_c. - --Particulars - - - The term "illumination angles" refers to following set of - angles: - - - solar incidence angle Angle between the surface normal at the - specified surface point and the vector - from the surface point to the Sun. - - emission angle Angle between the surface normal at the - specified surface point and the vector - from the surface point to the observer. - - phase angle Angle between the vectors from the - surface point to the observing body and - from the surface point to the Sun. - - - The diagram below illustrates the geometric relationships defining - these angles. The labels for the solar incidence, emission, and - phase angles are "s.i.", "e.", and "phase". - - - * - Sun - - surface normal vector - ._ _. - |\ /| Sun vector - \ phase / - \ . . / - . . - \ ___ / - . \/ \/ - _\ s.i./ - . / \ / - . | e. \ / - * <--------------- * surface point on - viewing vector target body - location to viewing - (observer) location - - - Note that if the target-observer vector, the target normal vector - at the surface point, and the target-sun vector are coplanar, then - phase is the sum of incidence and emission. This is rarely true; - usually - - phase angle < solar incidence angle + emission angle - - - All of the above angles can be computed using light time - corrections, light time and stellar aberration corrections, or - no aberration corrections. The way aberration corrections - are used is described below. - - Care must be used in computing light time corrections. The - guiding principle used here is "describe what appears in - an image." We ignore differential light time; the light times - from all points on the target to the observer are presumed to be - equal. - - - Observer-target body vector - --------------------------- - - Let `et' be the epoch at which an observation or remote - sensing measurement is made, and let et - lt ("lt" stands - for "light time") be the epoch at which the photons received - at `et' were emitted from the body (we use the term "emitted" - loosely here). - - The correct observer-target vector points from the observer's - location at `et' to the target body's location at et - lt. - The target-observer vector points in the opposite direction. - - Since light time corrections are not symmetric, the correct - target-observer vector CANNOT be found by computing the light - time corrected position of the observer as seen from the - target body. - - - Target body's orientation - ------------------------- - - Using the definitions of `et' and `lt' above, the target - body's orientation at et - lt is used. The surface - normal is dependent on the target body's orientation, so - the body's orientation model must be evaluated for the correct - epoch. - - - Target body -- Sun vector - ------------------------- - - All surface features on the target body will appear in - a measurement made at `et' as they were at et-lt. In - particular, lighting on the target body is dependent on - the apparent location of the Sun as seen from the target - body at et-lt. So, a second light time correction is used - in finding the apparent location of the Sun. - - - Stellar aberration corrections, when used, are applied as follows: - - - Observer-target body vector - --------------------------- - - In addition to light time correction, stellar aberration is - used in computing the apparent target body position as seen - from the observer's location at time `et'. This apparent - position defines the observer-target body vector. - - - Target body-Sun vector - ---------------------- - - The target body-Sun vector is the apparent position of the Sun, - corrected for light time and stellar aberration, as seen from - the target body at time et-lt. Note that the target body's - position is not affected by the stellar aberration correction - applied in finding its apparent position as seen by the - observer. - - - Once all of the vectors, as well as the target body's - orientation, have been computed with the proper aberration - corrections, the element of time is eliminated from the - computation. The problem becomes a purely geometric one, - and is described by the diagram above. - - --Examples - - The numerical results shown for this example may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - In the following example program, the file - - spk_m_031103-040201_030502.bsp - - is a binary SPK file containing data for Mars Global Surveyor, - Mars, and the Sun for a time interval bracketing the date - - 2004 JAN 1 12:00:00 UTC. - - pck00007.tpc is a planetary constants kernel file containing - radii and rotation model constants. naif0007.tls is a - leapseconds kernel. - - Find the phase, solar incidence, and emission angles at the - sub-solar and sub-spacecraft points on Mars as seen from the Mars - global surveyor spacecraft at a user-specified UTC time. Use light - time and stellar aberration corrections. - - #include - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local variables - ./ - SpiceChar * obsrvr; - SpiceChar * target; - SpiceChar * utc; - - SpiceDouble alt; - SpiceDouble et; - SpiceDouble sscemi; - SpiceDouble sscphs; - SpiceDouble sscsol; - SpiceDouble sslphs; - SpiceDouble sslsol; - SpiceDouble sslemi; - SpiceDouble ssolpt [3]; - SpiceDouble sscpt [3]; - - - /. - Load kernel files. - ./ - furnsh_c ( "naif0007.tls" ); - furnsh_c ( "pck00007.tpc" ); - furnsh_c ( "spk_m_031103-040201_030502.bsp" ); - - /. - Convert the UTC request time to ET (seconds past J2000 TDB). - ./ - utc = "2004 JAN 1 12:00:00"; - - str2et_c ( utc, &et ); - - /. - Assign observer and target names. The acronym MGS - indicates Mars Global Surveyor. See NAIF_IDS for a list - of names recognized by SPICE. - ./ - target = "Mars"; - obsrvr = "MGS"; - - /. - Find the sub-solar point on the Earth as seen from - the MGS spacecraft at et. Use the "near point" - style of sub-point definition. This makes it easy - to verify the solar incidence angle. - ./ - subsol_c ( "near point", target, et, - "LT+S", obsrvr, ssolpt ); - - /. - Now find the sub-spacecraft point. Use the - "nearest point" definition of the sub-point - here---this makes it easy to verify the emission - angle. - ./ - subpt_c ( "near point", target, et, - "LT+S", obsrvr, sscpt, &alt ); - - /. - Find the phase, solar incidence, and emission - angles at the sub-solar point on the Earth as seen - from Mars Observer at time et. - ./ - illum_c ( target, et, "LT+S", obsrvr, - ssolpt, &sslphs, &sslsol, &sslemi ); - - /. - Do the same for the sub-spacecraft point. - ./ - illum_c ( target, et, "LT+S", obsrvr, - sscpt, &sscphs, &sscsol, &sscemi ); - - /. - Convert the angles to degrees and write them out. - ./ - sslphs *= dpr_c(); - sslsol *= dpr_c(); - sslemi *= dpr_c(); - - sscphs *= dpr_c(); - sscsol *= dpr_c(); - sscemi *= dpr_c(); - - printf ( "\n" - "UTC epoch is %s\n" - "\n" - "Illumination angles at the sub-solar point:\n" - "\n" - "Phase angle (deg): %f\n" - "Solar incidence angle (deg): %f\n" - "Emission angle (deg): %f\n" - "\n" - "The solar incidence angle should be 0.\n" - "The emission and phase angles should be " - "equal.\n" - "\n" - "\n" - "Illumination angles at the sub-s/c point:\n" - "\n" - "Phase angle (deg): %f\n" - "Solar incidence angle (deg): %f\n" - "Emission angle (deg): %f\n" - "\n" - "The emission angle should be 0.\n" - "The solar incidence and phase angles " - "should be equal.\n" - "\n" - "\n", - utc, - sslphs, - sslsol, - sslemi, - sscphs, - sscsol, - sscemi ); - - printf ( "\n" ); - - return ( 0 ); - } - - - When this program is executed, the output will be: - - - UTC epoch is 2004 JAN 1 12:00:00 - - Illumination angles at the sub-solar point: - - Phase angle (deg): 150.210714 - Solar incidence angle (deg): 0.000000 - Emission angle (deg): 150.210714 - - The solar incidence angle should be 0. - The emission and phase angles should be equal. - - - Illumination angles at the sub-s/c point: - - Phase angle (deg): 123.398202 - Solar incidence angle (deg): 123.398202 - Emission angle (deg): 0.000000 - - The emission angle should be 0. - The solar incidence and phase angles should be equal. - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.4, 19-MAY-2010 (BVS) - - Index lines now state that this routine is deprecated. - - -CSPICE Version 1.0.3, 07-FEB-2008 (NJB) - - Abstract now states that this routine is deprecated. - - -CSPICE Version 1.0.2, 22-JUL-2004 (NJB) - - Updated header to indicate that the `target' and `observer' - input arguments can now contain string representations of - integers. - - -CSPICE Version 1.1.2, 27-JUL-2003 (NJB) (CHA) - - Various header corrections were made. The example program - was upgraded to use real kernels, and the program's output is - shown. - - -CSPICE Version 1.1.1, 04-SEP-2002 (NJB) - - Updated Index_Entries header section. Corrected error in - erract_c call in header example. - - -CSPICE Version 1.1.0, 24-JUL-2001 (NJB) - - Changed prototype: input spoint is now type - (ConstSpiceDouble [3]). Implemented interface macro for - casting spoint array to const. - - -CSPICE Version 1.0.0, 25-MAY-1999 (NJB) - --Index_Entries - - DEPRECATED illumination angles - DEPRECATED lighting angles - DEPRECATED phase angle - DEPRECATED emission angle - DEPRECATED solar incidence angle - --& -*/ - -{ /* Begin illum_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "illum_c" ); - - /* - Check the input strings: target, abcorr, and obsrvr. Make sure - none of the pointers are null and that each string contains at - least one non-null character. - */ - CHKFSTR ( CHK_STANDARD, "illum_c", target ); - CHKFSTR ( CHK_STANDARD, "illum_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "illum_c", obsrvr ); - - - /* - Call the f2c'd routine. - */ - illum_ ( ( char * ) target, - ( doublereal * ) &et, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) spoint, - ( doublereal * ) phase, - ( doublereal * ) solar, - ( doublereal * ) emissn, - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - - chkout_c ( "illum_c" ); - -} /* End illum_c */ - diff --git a/ext/spice/src/cspice/ilnw.c b/ext/spice/src/cspice/ilnw.c deleted file mode 100644 index aff3831534..0000000000 --- a/ext/spice/src/cspice/ilnw.c +++ /dev/null @@ -1,77 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "lio.h" -extern char *f__icptr; -extern char *f__icend; -extern icilist *f__svic; -extern int f__icnum; -#ifdef KR_headers -extern void z_putc(); -#else -extern void z_putc(int); -#endif - - static int -z_wSL(Void) -{ - while(f__recpos < f__svic->icirlen) - z_putc(' '); - return z_rnew(); - } - - static void -#ifdef KR_headers -c_liw(a) icilist *a; -#else -c_liw(icilist *a) -#endif -{ - f__reading = 0; - f__external = 0; - f__formatted = 1; - f__putn = z_putc; - L_len = a->icirlen; - f__donewrec = z_wSL; - f__svic = a; - f__icnum = f__recpos = 0; - f__cursor = 0; - f__cf = 0; - f__curunit = 0; - f__icptr = a->iciunit; - f__icend = f__icptr + a->icirlen*a->icirnum; - f__elist = (cilist *)a; - } - - integer -#ifdef KR_headers -s_wsni(a) icilist *a; -#else -s_wsni(icilist *a) -#endif -{ - cilist ca; - - c_liw(a); - ca.cifmt = a->icifmt; - x_wsne(&ca); - z_wSL(); - return 0; - } - - integer -#ifdef KR_headers -s_wsli(a) icilist *a; -#else -s_wsli(icilist *a) -#endif -{ - f__lioproc = l_write; - c_liw(a); - return(0); - } - -integer e_wsli(Void) -{ - z_wSL(); - return(0); - } diff --git a/ext/spice/src/cspice/ilumin.c b/ext/spice/src/cspice/ilumin.c deleted file mode 100644 index 85147773d4..0000000000 --- a/ext/spice/src/cspice/ilumin.c +++ /dev/null @@ -1,1396 +0,0 @@ -/* ilumin.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__10 = 10; -static integer c__3 = 3; - -/* $Procedure ILUMIN ( Illumination angles ) */ -/* Subroutine */ int ilumin_(char *method, char *target, doublereal *et, char - *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal * - trgepc, doublereal *srfvec, doublereal *phase, doublereal *solar, - doublereal *emissn, ftnlen method_len, ftnlen target_len, ftnlen - fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* Initialized data */ - - static logical elipsd = TRUE_; - static logical first = TRUE_; - static char prvcor[5] = " "; - static char prvmth[80] = "Ellipsoid " - " "; - - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal dist; - integer nitr; - extern doublereal vsep_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer type__; - logical xmit; - doublereal tpos[3]; - extern /* Subroutine */ int mtxv_(doublereal *, doublereal *, doublereal * - ); - doublereal j2pos[3]; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer n; - doublereal s, radii[3], range; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical usecn; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal vtemp[3], xform[9] /* was [3][3] */; - static logical uselt; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - doublereal corvj2[3], subvj2[3]; - extern logical failed_(void); - integer refcde, obscde; - doublereal lt, etdiff; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - doublereal ltdiff; - extern doublereal clight_(void); - integer trgcde; - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *); - doublereal offobs[3]; - integer center; - extern doublereal touchd_(doublereal *); - char locmth[80]; - doublereal normal[3], offsun[3], stloff[3], subvec[3]; - integer typeid; - doublereal corpos[3], obspos[3], prevet; - logical attblk[15]; - extern logical return_(void); - doublereal prevlt, ssbost[6], ssbtst[6]; - static logical usestl; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal sunpos[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *, - integer *, integer *, integer *, logical *), errint_(char *, - integer *, ftnlen), cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), spkezp_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vminus_(doublereal *, doublereal *), spkssb_(integer *, - doublereal *, char *, doublereal *, ftnlen), pxform_(char *, char - *, doublereal *, doublereal *, ftnlen, ftnlen), surfnm_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - logical fnd; - doublereal slt; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Find the illumination angles (phase, solar incidence, and */ -/* emission) at a specified surface point of a target body. */ - -/* This routine supersedes ILLUM. */ - -/* $ 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 */ - -/* FRAMES */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MOSPICE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* FIXREF I Body-fixed, body-centered target body frame. */ -/* ABCORR I Desired aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* SPOINT I Body-fixed coordinates of a target surface point. */ -/* TRGEPC O Target surface point epoch. */ -/* SRFVEC O Vector from observer to target surface point. */ -/* PHASE O Phase angle at the surface point. */ -/* SOLAR O Solar incidence angle at the surface point. */ -/* EMISSN O Emission angle at the surface point. */ - -/* $ Detailed_Input */ - - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. Parameters */ -/* include, but are not limited to, the shape model */ -/* used to represent the surface of the target body. */ - -/* The only choice currently supported is */ - -/* 'Ellipsoid' The illumination angle */ -/* computation uses a triaxial */ -/* ellipsoid to model the surface */ -/* of the target body. The */ -/* ellipsoid's radii must be */ -/* available in the kernel pool. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string ' eLLipsoid ' is */ -/* valid. */ - - -/* TARGET is the name of the target body. TARGET is */ -/* case-insensitive, and leading and trailing blanks in */ -/* TARGET are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the Moon is the */ -/* target body. */ - -/* ET is the epoch, expressed as seconds past J2000 TDB, */ -/* for which the apparent illumination angles at the */ -/* specified surface point on the target body, as seen */ -/* from the observing body, are to be computed. */ - - -/* FIXREF is the name of the body-fixed, body-centered */ -/* reference frame associated with the target body. The */ -/* input surface point SPOINT and the output vector */ -/* SRFVEC are expressed relative to this reference */ -/* frame. The string FIXREF is case-insensitive, and */ -/* leading and trailing blanks in FIXREF are not */ -/* significant. */ - - -/* ABCORR is the aberration correction to be used in computing */ -/* the position and orientation of the target body and */ -/* the location of the Sun. */ - -/* For remote sensing applications, where the apparent */ -/* illumination angles seen by the observer are desired, */ -/* normally either of the corrections */ - -/* 'LT+S' */ -/* 'CN+S' */ - -/* should be used. These and the other supported options */ -/* are described below. ABCORR may be any of the */ -/* following: */ - -/* 'NONE' No aberration correction. */ - -/* Let LT represent the one-way light time between the */ -/* observer and SPOINT (note: NOT between the observer */ -/* and the target body's center). The following values */ -/* of ABCORR apply to the "reception" case in which */ -/* photons depart from SPOINT at the light-time */ -/* corrected epoch ET-LT and *arrive* at the observer's */ -/* location at ET: */ - -/* 'LT' Correct both the position of SPOINT as */ -/* seen by the observer, and the position */ -/* of the Sun as seen by the target, for */ -/* light time. */ - -/* 'LT+S' Correct both the position of SPOINT as */ -/* seen by the observer, and the position */ -/* of the Sun as seen by the target, for */ -/* light time and stellar aberration. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equations for target and the Sun, the */ -/* "CN" correction iterates until the */ -/* solution converges. */ - -/* 'CN+S' Converged Newtonian light time and */ -/* stellar aberration corrections. This */ -/* option produces a solution that is at */ -/* least as accurate at that obtainable */ -/* with the 'LT+S' option. Whether the */ -/* 'CN+S' solution is substantially more */ -/* accurate depends on the geometry of the */ -/* participating objects and on the */ -/* accuracy of the input data. In all */ -/* cases this routine will execute more */ -/* slowly when a converged solution is */ -/* computed. */ - -/* Neither case nor white space are significant in */ -/* ABCORR. For example, the string */ - -/* 'Lt + s' */ - -/* is valid. */ - - -/* OBSRVR is the name of the observing body. The observing body */ -/* is an ephemeris object: it typically is a spacecraft, */ -/* the earth, or a surface point on the earth. OBSRVR is */ -/* case-insensitive, and leading and trailing blanks in */ -/* OBSRVR are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the Moon is the */ -/* observer. */ - -/* OBSRVR may be not be identical to TARGET. */ - - -/* SPOINT is a surface point on the target body, expressed in */ -/* Cartesian coordinates, relative to the body-fixed */ -/* target frame designated by FIXREF. */ - -/* SPOINT need not be visible from the observer's */ -/* location at the epoch ET. */ - -/* The components of SPOINT have units of km. */ - - -/* $ Detailed_Output */ - - -/* TRGEPC is the "surface point epoch." TRGEPC is defined as */ -/* follows: letting LT be the one-way light time between */ -/* the observer and the input surface point SPOINT, */ -/* TRGEPC is either the epoch ET-LT or ET depending on */ -/* whether the requested aberration correction is, */ -/* respectively, for received radiation or omitted. LT */ -/* is computed using the method indicated by ABCORR. */ - -/* TRGEPC is expressed as seconds past J2000 TDB. */ - - -/* SRFVEC is the vector from the observer's position at ET to */ -/* the aberration-corrected (or optionally, geometric) */ -/* position of SPOINT, where the aberration corrections */ -/* are specified by ABCORR. SRFVEC is expressed in the */ -/* target body-fixed reference frame designated by */ -/* FIXREF, evaluated at TRGEPC. */ - -/* The components of SRFVEC are given in units of km. */ - -/* One can use the SPICELIB function VNORM to obtain the */ -/* distance between the observer and SPOINT: */ - -/* DIST = VNORM ( SRFVEC ) */ - -/* The observer's position OBSPOS, relative to the */ -/* target body's center, where the center's position is */ -/* corrected for aberration effects as indicated by */ -/* ABCORR, can be computed via the call: */ - -/* CALL VSUB ( SPOINT, SRFVEC, OBSPOS ) */ - -/* To transform the vector SRFVEC to a time-dependent */ -/* reference frame REF at ET, a sequence of two frame */ -/* transformations is required. For example, let MFIX */ -/* and MREF be 3x3 matrices respectively describing the */ -/* target body-fixed to J2000 frame transformation at */ -/* TRGEPC and the J2000 to (time-dependent frame) REF */ -/* transformation at ET, and let XFORM be the 3x3 matrix */ -/* representing the composition of MREF with MFIX. Then */ -/* SRFVEC can be transformed to the result REFVEC as */ -/* follows: */ - -/* CALL PXFORM ( FIXREF, 'J2000', TRGEPC, MFIX ) */ -/* CALL PXFORM ( 'J2000', REF, ET, MREF ) */ -/* CALL MXM ( MREF, MFIX, XFORM ) */ -/* CALL MXV ( XFORM, SRFVEC, REFVEC ) */ - - -/* PHASE is the phase angle at SPOINT, as seen from OBSRVR at */ -/* time ET. This is the angle between the negative of */ -/* the vector SRFVEC and the SPOINT-Sun vector at */ -/* TRGEPC. Units are radians. The range of PHASE is */ -/* [0, pi]. */ - -/* SOLAR is the solar incidence angle at SPOINT, as seen from */ -/* OBSRVR at time ET. This is the angle between the */ -/* surface normal vector at SPOINT and the SPOINT-Sun */ -/* vector at TRGEPC. Units are radians. The range of */ -/* SOLAR is [0, pi]. */ - -/* EMISSN is the emission angle at SPOINT, as seen from OBSRVR */ -/* at time ET. This is the angle between the surface */ -/* normal vector at SPOINT and the negative of the */ -/* vector SRFVEC. Units are radians. The range of EMISSN */ -/* is [0, pi]. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) If the specified aberration correction is relativistic or */ -/* calls for stellar aberration but not light time correction, */ -/* the error SPICE(NOTSUPPORTED) is signaled. If the specified */ -/* aberration correction is any other unrecognized value, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 2) If either the target or observer input strings cannot be */ -/* converted to an integer ID code, the error */ -/* SPICE(IDCODENOTFOUND) is signaled. */ - -/* 3) If OBSRVR and TARGET map to the same NAIF integer ID code, */ -/* the error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If the input target body-fixed frame FIXREF is not */ -/* recognized, the error SPICE(NOFRAME) is signaled. A frame */ -/* name may fail to be recognized because a required frame */ -/* specification kernel has not been loaded; another cause is a */ -/* misspelling of the frame name. */ - -/* 5) If the input frame FIXREF is not centered at the target body, */ -/* the error SPICE(INVALIDFRAME) is signaled. */ - -/* 6) If the input argument METHOD is not recognized, the error */ -/* SPICE(INVALIDMETHOD) is signaled. */ - -/* 7) If the target and observer have distinct identities but are */ -/* at the same location (for example, the target is Mars and the */ -/* observer is the Mars barycenter), the error */ -/* SPICE(NOSEPARATION) is signaled. */ - -/* 8) If insufficient ephemeris data have been loaded prior to */ -/* calling ILUMIN, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. Note that when */ -/* light time correction is used, sufficient ephemeris data must */ -/* be available to propagate the states of observer, target, and */ -/* the Sun to the solar system barycenter. */ - -/* 9) If the computation method specifies an ellipsoidal target */ -/* shape and triaxial radii of the target body have not been */ -/* loaded into the kernel pool prior to calling ILUMIN, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 10) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be */ -/* diagnosed and signaled by routines in the call tree of this */ -/* routine. */ - -/* 11) If PCK data specifying the target body-fixed frame */ -/* orientation have not been loaded prior to calling ILUMIN, */ -/* the error will be diagnosed and signaled by a routine in the */ -/* call tree of this routine. */ - - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target, observer, and the */ -/* Sun must be loaded. If aberration corrections are used, the */ -/* states of target, observer, and the Sun relative to the */ -/* solar system barycenter must be calculable from the */ -/* available ephemeris data. Typically ephemeris data are made */ -/* available by loading one or more SPK files via FURNSH. */ - -/* - PCK data: if the target body shape is modeled as an */ -/* ellipsoid, triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must be */ -/* loaded. These may be provided in a text or binary PCK file. */ - -/* - Frame data: if a frame definition is required to convert the */ -/* observer and target states to the body-fixed frame of the */ -/* target, that definition must be available in the kernel */ -/* pool. Typically the definition is supplied by loading a */ -/* frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - - -/* $ Particulars */ - - -/* The term "illumination angles" refers to following set of */ -/* angles: */ - - -/* phase angle Angle between the vectors from the */ -/* surface point to the observer and */ -/* from the surface point to the Sun. */ - -/* solar incidence angle Angle between the surface normal at */ -/* the specified surface point and the */ -/* vector from the surface point to the */ -/* Sun. */ - -/* emission angle Angle between the surface normal at */ -/* the specified surface point and the */ -/* vector from the surface point to the */ -/* observer. */ - -/* The diagram below illustrates the geometric relationships */ -/* defining these angles. The labels for the solar incidence, */ -/* emission, and phase angles are "s.i.", "e.", and "phase". */ - - -/* * */ -/* Sun */ - -/* surface normal vector */ -/* ._ _. */ -/* |\ /| Sun vector */ -/* \ phase / */ -/* \ . . / */ -/* . . */ -/* \ ___ / */ -/* . \/ \/ */ -/* _\ s.i./ */ -/* . / \ / */ -/* . | e. \ / */ -/* * <--------------- * surface point on */ -/* viewing vector target body */ -/* location to viewing */ -/* (observer) location */ - - -/* Note that if the target-observer vector, the target normal vector */ -/* at the surface point, and the target-sun vector are coplanar, */ -/* then phase is the sum of incidence and emission. This is rarely */ -/* true; usually */ - -/* phase angle < solar incidence angle + emission angle */ - -/* All of the above angles can be computed using light time */ -/* corrections, light time and stellar aberration corrections, or */ -/* no aberration corrections. In order to describe apparent */ -/* geometry as observed by a remote sensing instrument, both */ -/* light time and stellar aberration corrections should be used. */ - -/* The way aberration corrections are applied by this routine */ -/* is described below. */ - -/* Light time corrections */ -/* ====================== */ - -/* Observer-target surface point vector */ -/* ------------------------------------ */ - -/* Let ET be the epoch at which an observation or remote */ -/* sensing measurement is made, and let ET - LT ("LT" stands */ -/* for "light time") be the epoch at which the photons */ -/* received at ET were emitted from the surface point SPOINT. */ -/* Note that the light time between the surface point and */ -/* observer will generally differ from the light time between */ -/* the target body's center and the observer. */ - - -/* Target body's orientation */ -/* ------------------------- */ - -/* Using the definitions of ET and LT above, the target body's */ -/* orientation at ET - LT is used. The surface normal is */ -/* dependent on the target body's orientation, so the body's */ -/* orientation model must be evaluated for the correct epoch. */ - - -/* Target body -- Sun vector */ -/* ------------------------- */ - -/* The surface features on the target body near SPOINT will */ -/* appear in a measurement made at ET as they were at ET-LT. */ -/* In particular, lighting on the target body is dependent on */ -/* the apparent location of the Sun as seen from the target */ -/* body at ET-LT. So, a second light time correction is used */ -/* to compute the position of the Sun relative to the surface */ -/* point. */ - - -/* Stellar aberration corrections */ -/* ============================== */ - -/* Stellar aberration corrections are applied only if */ -/* light time corrections are applied as well. */ - -/* Observer-target surface point body vector */ -/* ----------------------------------------- */ - -/* When stellar aberration correction is performed, the */ -/* direction vector SRFVEC is adjusted so as to point to the */ -/* apparent position of SPOINT: considering SPOINT to be an */ -/* ephemeris object, SRFVEC points from the observer's */ -/* position at ET to the light time and stellar aberration */ -/* corrected position of SPOINT. */ - -/* Target body-Sun vector */ -/* ---------------------- */ - -/* The target body-Sun vector is the apparent position of the */ -/* Sun, corrected for light time and stellar aberration, as */ -/* seen from the target body at time ET-LT. */ - - -/* $ Examples */ - -/* The numerical results shown for this example may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* 1) Find the phase, solar incidence, and emission angles at the */ -/* sub-solar and sub-spacecraft points on Mars as seen from the */ -/* Mars Global Surveyor spacecraft at a specified UTC time. Use */ -/* light time and stellar aberration corrections. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* File: mgs_example.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de418.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ -/* mgs_ext13_ipng_mgs95j.bsp MGS ephemeris */ - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls', */ -/* 'mgs_ext13_ipng_mgs95j.bsp' ) */ -/* \begintext */ - - -/* Example code begins here. */ - -/* PROGRAM ANGLES */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'mgs_example.tm' ) */ - -/* INTEGER NAMLEN */ -/* PARAMETER ( NAMLEN = 32 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 25 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR */ -/* CHARACTER*(NAMLEN) OBSRVR */ -/* CHARACTER*(NAMLEN) TARGET */ -/* CHARACTER*(TIMLEN) UTC */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ -/* DOUBLE PRECISION SSCEMI */ -/* DOUBLE PRECISION SSCPHS */ -/* DOUBLE PRECISION SSCPT ( 3 ) */ -/* DOUBLE PRECISION SSCSOL */ -/* DOUBLE PRECISION SSLEMI */ -/* DOUBLE PRECISION SSLPHS */ -/* DOUBLE PRECISION SSLSOL */ -/* DOUBLE PRECISION SSOLPT ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ - -/* C */ -/* C Load kernel files. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the UTC request time string to seconds past */ -/* C J2000 TDB. */ -/* C */ -/* UTC = '2004 JAN 1 12:00:00' */ - -/* CALL UTC2ET ( UTC, ET ) */ - -/* C */ -/* C Assign observer and target names. The acronym MGS */ -/* C indicates Mars Global Surveyor. See NAIF_IDS for a */ -/* C list of names recognized by SPICE. Also set the */ -/* C aberration correction flag. */ -/* C */ -/* TARGET = 'Mars' */ -/* OBSRVR = 'MGS' */ -/* ABCORR = 'CN+S' */ -/* C */ -/* C Find the sub-solar point on the Earth as seen from */ -/* C the MGS spacecraft at ET. Use the "near point: ellipsoid" */ -/* C style of sub-point definition. This makes it easy */ -/* C to verify the solar incidence angle. */ -/* C */ -/* CALL SUBSLR ( 'Near point: ellipsoid', */ -/* . TARGET, ET, 'IAU_MARS', */ -/* . ABCORR, OBSRVR, SSOLPT, TRGEPC, SRFVEC ) */ -/* C */ -/* C Now find the sub-spacecraft point. */ -/* C */ -/* CALL SUBPNT ( 'Near point: ellipsoid', */ -/* . TARGET, ET, 'IAU_MARS', */ -/* . ABCORR, OBSRVR, SSCPT, TRGEPC, SRFVEC ) */ -/* C */ -/* C Find the phase, solar incidence, and emission */ -/* C angles at the sub-solar point on the Earth as seen */ -/* C from MGS at time ET. */ -/* C */ -/* CALL ILUMIN ( 'Ellipsoid', TARGET, ET, 'IAU_MARS', */ -/* . ABCORR, OBSRVR, SSOLPT, TRGEPC, */ -/* . SRFVEC, SSLPHS, SSLSOL, SSLEMI ) */ -/* C */ -/* C Do the same for the sub-spacecraft point. */ -/* C */ -/* CALL ILUMIN ( 'Ellipsoid', TARGET, ET, 'IAU_MARS', */ -/* . ABCORR, OBSRVR, SSCPT, TRGEPC, */ -/* . SRFVEC, SSCPHS, SSCSOL, SSCEMI ) */ -/* C */ -/* C Convert the angles to degrees and write them out. */ -/* C */ -/* SSLPHS = DPR() * SSLPHS */ -/* SSLSOL = DPR() * SSLSOL */ -/* SSLEMI = DPR() * SSLEMI */ - -/* SSCPHS = DPR() * SSCPHS */ -/* SSCSOL = DPR() * SSCSOL */ -/* SSCEMI = DPR() * SSCEMI */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'UTC epoch is ', UTC */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Illumination angles at the sub-solar point:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Phase angle (deg.): ', SSLPHS */ -/* WRITE (*,*) 'Solar incidence angle (deg.): ', SSLSOL */ -/* WRITE (*,*) 'Emission angle (deg.): ', SSLEMI */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'The solar incidence angle should be 0.' */ -/* WRITE (*,*) 'The emission and phase angles should be equal.' */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Illumination angles at the sub-s/c point:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Phase angle (deg.): ', SSCPHS */ -/* WRITE (*,*) 'Solar incidence angle (deg.): ', SSCSOL */ -/* WRITE (*,*) 'Emission angle (deg.): ', SSCEMI */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'The emission angle should be 0.' */ -/* WRITE (*,*) 'The solar incidence and phase angles should ' */ -/* .// 'be equal.' */ -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, */ -/* the output was: */ - -/* UTC epoch is 2004 JAN 1 12:00:00 */ - -/* Illumination angles at the sub-solar point: */ - -/* Phase angle (deg.): 115.542001 */ -/* Solar incidence angle (deg.): 3.20530645E-15 */ -/* Emission angle (deg.): 115.542001 */ - -/* The solar incidence angle should be 0. */ -/* The emission and phase angles should be equal. */ - -/* Illumination angles at the sub-s/c point: */ - -/* Phase angle (deg.): 62.0840031 */ -/* Solar incidence angle (deg.): 62.0840031 */ -/* Emission angle (deg.): 6.46461886E-11 */ - -/* The emission angle should be 0. */ -/* The solar incidence and phase angles should be equal. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-2010 (NJB) */ - -/* Bug fix: ILUMIN now returns immediately if a target */ -/* radius lookup fails. */ - -/* - SPICELIB Version 1.0.1, 06-FEB-2009 (NJB) */ - -/* Typo correction: changed FIXFRM to FIXREF in header */ -/* documentation. Meta-kernel name suffix was changed to */ -/* ".tm" in header code example. */ - -/* - SPICELIB Version 1.0.0, 02-MAR-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* illumination angles */ -/* lighting angles */ -/* phase angle */ -/* solar incidence angle */ -/* emission angle */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* This value will become system-dependent when systems */ -/* using 128-bit d.p. numbers are supported by SPICELIB. */ -/* CNVLIM, when added to 1.0D0, should yield 1.0D0. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Note: XMIT need not be saved, since it's used only */ -/* for error checking when an aberration correction flag */ -/* is parsed. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ILUMIN", (ftnlen)6); - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* USESTL indicates stellar aberration corrections. */ - - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - -/* Reject an aberration correction flag calling for transmission */ -/* corrections. */ - - if (xmit) { - setmsg_("Aberration correction flag # calls for transmission-sty" - "le corrections.", (ftnlen)70); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Reject an aberration correction flag calling for stellar */ -/* aberration but not light time correction. */ - - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } else if (attblk[5]) { - -/* Also reject flags calling for relativistic corrections. */ - - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - } - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &fnd, target_len); - if (! fnd) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - bods2c_(obsrvr, &obscde, &fnd, obsrvr_len); - if (! fnd) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the sub-solar point, the observing body and ta" - "rget body are the same. Both are #.", (ftnlen)94); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Determine the attributes of the frame designated by FIXREF. */ - - namfrm_(fixref, &refcde, fixref_len); - frinfo_(&refcde, ¢er, &type__, &typeid, &fnd); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - if (! fnd) { - setmsg_("Reference frame # is not recognized by the SPICE frame subs" - "ystem. Possibly a required frame definition kernel has not b" - "een loaded.", (ftnlen)130); - errch_("#", fixref, (ftnlen)1, fixref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Make sure that FIXREF is centered at the target body's center. */ - - if (center != trgcde) { - setmsg_("Reference frame # is not centered at the target body #. The" - " ID code of the frame center is #.", (ftnlen)93); - errch_("#", fixref, (ftnlen)1, fixref_len); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", ¢er, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* If necessary, parse the method specification. PRVMTH */ -/* and the derived flags NEAR and ELIPSD start out with */ -/* valid values. PRVMTH records the last valid value of */ -/* METHOD; ELIPSD is the corresponding shape flag. */ - - if (s_cmp(method, prvmth, method_len, (ftnlen)80) != 0) { - -/* Parse the computation method specification. Work with a local */ -/* copy of the method specification that contains no leading or */ -/* embedded blanks. */ - - cmprss_(" ", &c__0, method, locmth, (ftnlen)1, method_len, (ftnlen)80) - ; - ucase_(locmth, locmth, (ftnlen)80, (ftnlen)80); - -/* Check the shape specification. */ - - if (s_cmp(locmth, "ELLIPSOID", (ftnlen)80, (ftnlen)9) != 0) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBSLR for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* At this point the method specification has passed our tests. */ -/* Use the flag ELIPSD to indicate that the shape is modeled as */ -/* an ellipsoid (which is true, for now). */ - - elipsd = TRUE_; - -/* Save the current value of METHOD. */ - - s_copy(prvmth, method, (ftnlen)80, method_len); - } - -/* Get the sign S prefixing LT in the expression for TRGEPC. */ -/* When light time correction is not used, setting S = 0 */ -/* allows us to seamlessly set TRGEPC equal to ET. */ - - if (uselt) { - s = -1.; - } else { - s = 0.; - } - -/* Determine the position of the observer in target body-fixed */ -/* coordinates. This is a first estimate. */ - -/* - Call SPKEZP to compute the position of the target body as */ -/* seen from the observing body and the light time (LT) */ -/* between them. We request that the coordinates of POS be */ -/* returned relative to the body fixed reference frame */ -/* associated with the target body, using aberration */ -/* corrections specified by the input argument ABCORR. */ - -/* - Call VMINUS to negate the direction of the vector (OBSPOS) */ -/* so it will be the position of the observer as seen from */ -/* the target body in target body fixed coordinates. */ - -/* Note that this result is not the same as the result of */ -/* calling SPKEZP with the target and observer switched. We */ -/* computed the vector FROM the observer TO the target in */ -/* order to get the proper light time and stellar aberration */ -/* corrections (if requested). Now we need the inverse of */ -/* that corrected vector in order to compute the sub-solar */ -/* point. */ - - spkezp_(&trgcde, et, fixref, abcorr, &obscde, tpos, <, fixref_len, - abcorr_len); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Negate the target's position to obtain the position of the */ -/* observer relative to the target. */ - - vminus_(tpos, obspos); - range = vnorm_(obspos); - if (range == 0.) { - -/* We've already ensured that observer and target are */ -/* distinct, so this should be a very unusual occurrence. */ - - setmsg_("Observer-target distance is zero. Observer is #; target is " - "#.", (ftnlen)61); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOSEPARATION)", (ftnlen)19); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Make a first estimate of the light time and target epoch. Note */ -/* that TRGEPC will equal ET if we're performing an uncorrected */ -/* computation, since in that case, S will be zero. */ - - vsub_(spoint, obspos, srfvec); - dist = vnorm_(srfvec); - lt = dist / clight_(); - *trgepc = *et + s * lt; - -/* If we're using light time corrections, refine our light time, */ -/* target epoch, and observer position estimates. */ - - if (uselt) { - -/* We'll now make improved light time, target epoch, and observer */ -/* position estimates using the previous estimates. The number of */ -/* iterations depends on the light time correction type. */ - - if (usecn) { - nitr = 5; - } else { - nitr = 1; - } - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Initialize the variables required to evaluate the */ -/* loop termination condition. */ - - i__ = 0; - ltdiff = 1.; - etdiff = 1.; - prevlt = lt; - prevet = *trgepc; - while(i__ < nitr && ltdiff > abs(lt) * 1e-17 && etdiff > 0.) { - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", fixref, trgepc, xform, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - mxv_(xform, j2pos, obspos); - -/* If we're using stellar aberration corrections, adjust the */ -/* observer position to account for the stellar aberration */ -/* correction applicable to SPOINT. */ - - if (usestl) { - -/* We want to apply the stellar aberration correction that */ -/* applies to our current estimate of the sub-solar point */ -/* location, NOT the correction for the target body's */ -/* center. In most cases the two corrections will be */ -/* similar, but they might not be---consider the case of a */ -/* highly prolate target body where the observer is close */ -/* to one "end" of the body. */ - -/* Find the vector from the observer to the estimated */ -/* sub-solar point. Find the stellar aberration offset */ -/* STLOFF for this vector. Note that all vectors are */ -/* expressed relative to the target body-fixed frame at */ -/* TRGEPC. We must perform our corrections in an inertial */ -/* frame. */ - - vsub_(spoint, obspos, subvec); - mtxv_(xform, subvec, subvj2); - -/* Note that we don't handle the transmission */ -/* case here. */ - - stelab_(subvj2, &ssbost[3], corvj2); - mxv_(xform, corvj2, corpos); - vsub_(corpos, subvec, stloff); - -/* In principle, we want to shift the target body position */ -/* relative to the solar system barycenter by STLOFF, but */ -/* we can skip this step and just re-compute the observer's */ -/* location relative to the target body's center by */ -/* subtracting off STLOFF. */ - - vsub_(obspos, stloff, vtemp); - vequ_(vtemp, obspos); - } - dist = vdist_(obspos, spoint); - -/* Compute a new light time estimate and new target epoch. */ - - lt = dist / clight_(); - *trgepc = *et + s * lt; - -/* At this point, we have new estimates of the sub-solar point */ -/* SPOINT, the observer altitude DIST, the target epoch TRGEPC, */ -/* and the position of the observer relative to the target */ -/* OBSPOS. */ - -/* We use the d.p. identity function TOUCHD to force the */ -/* compiler to create double precision arguments from the */ -/* differences LT-PREVLT and TRGEPC-PREVET. Some compilers */ -/* will perform extended-precision register arithmetic, which */ -/* can prevent a difference from rounding to zero. Simply */ -/* storing the result of the subtraction in a double precision */ -/* variable doesn't solve the problem, because that variable */ -/* can be optimized out of existence. */ - - d__2 = lt - prevlt; - ltdiff = (d__1 = touchd_(&d__2), abs(d__1)); - d__2 = *trgepc - prevet; - etdiff = (d__1 = touchd_(&d__2), abs(d__1)); - prevlt = lt; - prevet = *trgepc; - ++i__; - } - } - -/* Find the body-fixed position of the Sun as seen from the target */ -/* at TRGEPC. */ - - spkezp_(&c__10, trgepc, fixref, abcorr, &trgcde, sunpos, &slt, fixref_len, - abcorr_len); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Now we'll modify the target-Sun vector to take into account the */ -/* offset between the target center and the surface point of */ -/* interest; we want the vector to point from the surface point to */ -/* Sun. */ - - vsub_(sunpos, spoint, offsun); - -/* Let OFFOBS be the offset observer position: this vector */ -/* points from SPOINT to the observer. */ - - vsub_(spoint, obspos, srfvec); - vminus_(srfvec, offobs); - -/* Find the surface normal at SPOINT. This computation depends */ -/* on target body shape model. */ - - if (elipsd) { - -/* We'll need the radii of the target body. */ - - bodvcd_(&trgcde, "RADII", &c__3, &n, radii, (ftnlen)5); - if (failed_()) { - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - surfnm_(radii, &radii[1], &radii[2], spoint, normal); - } else { - -/* We've already checked the computation method input argument, */ -/* so we don't expect to arrive here. This code is present for */ -/* safety. */ - - setmsg_("The computation method # was not recognized. ", (ftnlen)45); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("ILUMIN", (ftnlen)6); - return 0; - } - -/* Find the illumination angles. VSEP will give us angular */ -/* separation in radians. */ - - *phase = vsep_(offsun, offobs); - *solar = vsep_(normal, offsun); - *emissn = vsep_(normal, offobs); - -/* TRGEPC and SRFVEC have already been set. */ - - chkout_("ILUMIN", (ftnlen)6); - return 0; -} /* ilumin_ */ - diff --git a/ext/spice/src/cspice/ilumin_c.c b/ext/spice/src/cspice/ilumin_c.c deleted file mode 100644 index 1d5e9cc974..0000000000 --- a/ext/spice/src/cspice/ilumin_c.c +++ /dev/null @@ -1,800 +0,0 @@ -/* - --Procedure ilumin_c ( Illumination angles ) - --Abstract - - Find the illumination angles (phase, solar incidence, and - emission) at a specified surface point of a target body. - - This routine supersedes illum_c. - --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 - - FRAMES - NAIF_IDS - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef ilumin_c - - void ilumin_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - fixref I Body-fixed, body-centered target body frame. - abcorr I Desired aberration correction. - obsrvr I Name of observing body. - spoint I Body-fixed coordinates of a target surface point. - trgepc O Target surface point epoch. - srfvec O Vector from observer to target surface point. - phase O Phase angle at the surface point. - solar O Solar incidence angle at the surface point. - emissn O Emission angle at the surface point. - --Detailed_Input - - - method is a short string providing parameters defining - the computation method to be used. Parameters - include, but are not limited to, the shape model - used to represent the surface of the target body. - - The only choice currently supported is - - "Ellipsoid" The illumination angle computation - uses a triaxial ellipsoid to model - the surface of the target body. - The ellipsoid's radii must be - available in the kernel pool. - - Neither case nor white space are significant in - `method'. For example, the string ' eLLipsoid ' is - valid. - - - target is the name of the target body. `target' is - case-insensitive, and leading and trailing blanks in - `target' are not significant. Optionally, you may supply - a string containing the integer ID code for the object. - For example both "MOON" and "301" are legitimate strings - that indicate the Moon is the target body. - - - et is the epoch, specified as ephemeris seconds past J2000 - TDB, at which the apparent illumination angles at the - specified surface point on the target body, as seen from - the observing body, are to be computed. - - - fixref is the name of the body-fixed, body-centered reference - frame associated with the target body. The input surface - point `spoint' and the output vector `srfvec' are - expressed relative to this reference frame. The string - `fixref' is case-insensitive, and leading and trailing - blanks in `fixref' are not significant. - - - abcorr is the aberration correction to be used in computing the - position and orientation of the target body and the - location of the Sun. - - For remote sensing applications, where the apparent - illumination angles seen by the observer are desired, - normally either of the corrections - - "LT+S" - "CN+S" - - should be used. These and the other supported options - are described below. `abcorr' may be any of the - following: - - "NONE" No aberration correction. - - - Let `lt' represent the one-way light time between the - observer and `spoint' (note: NOT between the observer - and the target body's center). The following values of - `abcorr' apply to the "reception" case in which photons - depart from `spoint' at the light-time corrected epoch - et-lt and *arrive* at the observer's location at `et': - - "LT" Correct both the position of `spoint' as - seen by the observer, and the position of - the Sun as seen by the target, for light - time. - - "LT+S" Correct both the position of `spoint' as - seen by the observer, and the position of - the Sun as seen by the target, for light - time and stellar aberration. - - "CN" Converged Newtonian light time correction. - In solving the light time equations for - target and the Sun, the "CN" correction - iterates until the solution converges. - - "CN+S" Converged Newtonian light time and - stellar aberration corrections. This - option produces a solution that is at - least as accurate at that obtainable - with the "LT+S" option. Whether the - "CN+S" solution is substantially more - accurate depends on the geometry of the - participating objects and on the - accuracy of the input data. In all - cases this routine will execute more - slowly when a converged solution is - computed. - - Neither case nor white space are significant in - `abcorr'. For example, the string - - "Lt + s" - - is valid. - - - obsrvr is the name of the observing body. This is typically a - spacecraft, the earth, or a surface point on the earth. - `obsrvr' is case-insensitive, and leading and trailing - blanks in `obsrvr' are not significant. Optionally, you - may supply a string containing the integer ID code for - the object. For example both "MOON" and "301" are - legitimate strings that indicate the Moon is the - observer. - - `obsrvr' may be not be identical to `target'. - - - spoint is a surface point on the target body, expressed in - Cartesian coordinates, relative to the body-fixed - target frame designated by `fixref'. - - `spoint' need not be visible from the observer's - location at the epoch `et'. - - The components of `spoint' have units of km. - - --Detailed_Output - - trgepc is the "surface point point epoch." `trgepc' is defined - as follows: letting `lt' be the one-way light time - between the observer and the input surface point - `spoint', `trgepc' is either the epoch et-lt or `et' - depending on whether the requested aberration correction - is, respectively, for received radiation or omitted. - `lt' is computed using the method indicated by `abcorr'. - - `trgepc' is expressed as seconds past J2000 TDB. - - - srfvec is the vector from the observer's position at `et' to - the aberration-corrected (or optionally, geometric) - position of `spoint', where the aberration corrections - are specified by `abcorr'. `srfvec' is expressed in the - target body-fixed reference frame designated by - `fixref', evaluated at `trgepc'. - - The components of `srfvec' are given in units of km. - - One can use the CSPICE function vnorm_c to obtain the - distance between the observer and `spoint': - - dist = vnorm_c ( srfvec ); - - The observer's position `obspos', relative to the - target body's center, where the center's position is - corrected for aberration effects as indicated by - `abcorr', can be computed via the call: - - vsub_c ( spoint, srfvec, obspos ); - - To transform the vector `srfvec' to a time-dependent - reference frame `ref' at `et', a sequence of two frame - transformations is required. For example, let `mfix' - and `mref' be 3x3 matrices respectively describing the - target body-fixed to J2000 frame transformation at - `trgepc' and the J2000 to (time-dependent frame) `ref' - transformation at `et', and let `xform' be the 3x3 matrix - representing the composition of `mref' with `mfix'. Then - `srfvec' can be transformed to the result `refvec' as - follows: - - pxform_c ( fixref, "j2000", trgepc, mfix ); - pxform_c ( "j2000", ref, et, mref ); - mxm_c ( mref, mfix, xform ); - mxv_c ( xform, srfvec, refvec ); - - - phase is the phase angle at `spoint', as seen from `obsrvr' at - time `et'. This is the angle between the spoint-obsrvr - vector and the spoint-sun vector. Units are radians. The - range of `phase' is [0, pi]. See Particulars below for a - detailed discussion of the definition. - - - solar is the solar incidence angle at `spoint', as seen from - `obsrvr' at time `et'. This is the angle between the - surface normal vector at `spoint' and the spoint-sun - vector. Units are radians. The range of `solar' is [0, - pi]. See Particulars below for a detailed discussion of - the definition. - - - emissn is the emission angle at `spoint', as seen from `obsrvr' - at time `et'. This is the angle between the surface - normal vector at `spoint' and the spoint-observer - vector. Units are radians. The range of `emissn' is [0, - pi]. See Particulars below for a detailed discussion of - the definition. - --Parameters - - None. - --Exceptions - - - 1) If the specified aberration correction is relativistic or - calls for stellar aberration but not light time correction, - the error SPICE(NOTSUPPORTED) is signaled. If the specified - aberration correction is any other unrecognized value, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 2) If either the target or observer input strings cannot be - converted to an integer ID code, the error SPICE(IDCODENOTFOUND) - is signaled. - - 3) If `obsrvr' and `target' map to the same NAIF integer ID code, - the error SPICE(BODIESNOTDISTINCT) is signaled. - - 4) If the input target body-fixed frame `fixref' is not recognized, - the error SPICE(NOFRAME) is signaled. A frame name may fail - to be recognized because a required frame specification kernel - has not been loaded; another cause is a misspelling of the - frame name. - - 5) If the input frame `fixref' is not centered at the target body, - the error SPICE(INVALIDFRAME) is signaled. - - 6) If the input argument `method' is not recognized, the error - SPICE(INVALIDMETHOD) is signaled. - - 7) If the target and observer have distinct identities but are - at the same location (for example, the target is Mars and - the observer is the Mars barycenter), the error - SPICE(NOSEPARATION) is signaled. - - 8) If insufficient ephemeris data have been loaded prior to - calling ilumin_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. Note that when - light time correction is used, sufficient ephemeris data - must be available to propagate the states of observer, - target, and the Sun to the solar system barycenter. - - 9) If the computation method specifies an ellipsoidal target shape - and triaxial radii of the target body have not been loaded - into the kernel pool prior to calling ilumin_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 10) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 11) If PCK data specifying the target body-fixed frame orientation - have not been loaded prior to calling ilumin_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 12) The error SPICE(EMPTYSTRING) is signaled if any input string - argument does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 13) The error SPICE(NULLPOINTER) is signaled if any input - string argument pointer is null. - - --Files - - - Appropriate kernels must be loaded by the calling program before - this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target, observer, and the - Sun must be loaded. If aberration corrections are used, the - states of target, observer, and the Sun relative to the - solar system barycenter must be calculable from the - available ephemeris data. Typically ephemeris data are made - available by loading one or more SPK files via furnsh_c. - - - PCK data: if the target body shape is modeled as an - ellipsoid, triaxial radii for the target body must be loaded - into the kernel pool. Typically this is done by loading a - text PCK file via furnsh_c. - - - Further PCK data: rotation data for the target body must be - loaded. These may be provided in a text or binary PCK file. - - - Frame data: if a frame definition is required to convert the - observer and target states to the body-fixed frame of the - target, that definition must be available in the kernel - pool. Typically the definition is supplied by loading a - frame kernel via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - - --Particulars - - - The term "illumination angles" refers to following set of - angles: - - - phase angle Angle between the vectors from the - surface point to the observer and from - the surface point to the Sun. - - solar incidence angle Angle between the surface normal at - the specified surface point and the - vector from the surface point to the - Sun. - - emission angle Angle between the surface normal at - the specified surface point and the - vector from the surface point to the - observer. - - - The diagram below illustrates the geometric relationships - defining these angles. The labels for the solar incidence, - emission, and phase angles are "s.i.", "e.", and "phase". - - - * - Sun - - surface normal vector - ._ _. - |\ /| Sun vector - \ phase / - \ . . / - . . - \ ___ / - . \/ \/ - _\ s.i./ - . / \ / - . | e. \ / - * <--------------- * surface point on - viewing vector target body - location to viewing - (observer) location - - - Note that if the target-observer vector, the target normal vector - at the surface point, and the target-sun vector are coplanar, - then phase is the sum of incidence and emission. This is rarely - true; usually - - phase angle < solar incidence angle + emission angle - - All of the above angles can be computed using light time - corrections, light time and stellar aberration corrections, or - no aberration corrections. In order to describe apparent - geometry as observed by a remote sensing instrument, both - light time and stellar aberration corrections should be used. - - The way aberration corrections are applied by this routine - is described below. - - Light time corrections - ====================== - - Observer-target surface point body vector - ----------------------------------------- - - Let `et' be the epoch at which an observation or remote - sensing measurement is made, and let et - lt ("lt" stands - for "light time") be the epoch at which the photons - received at `et' were emitted from the surface point `spoint'. - Note that the light time between the surface point and - observer will generally differ from the light time between - the target body's center and the observer. - - - Target body's orientation - ------------------------- - - Using the definitions of `et' and `lt' above, the target body's - orientation at et-lt is used. The surface normal is - dependent on the target body's orientation, so the body's - orientation model must be evaluated for the correct epoch. - - - Target body -- Sun vector - ------------------------- - - The surface features on the target body near `spoint' will - appear in a measurement made at `et' as they were at et-lt. In - particular, lighting on the target body is dependent on the - apparent location of the Sun as seen from the target body at - et-lt. So, a second light time correction is used to compute - the position of the Sun relative to the surface point. - - - Stellar aberration corrections - ============================== - - Stellar aberration corrections are applied only if - light time corrections are applied as well. - - Observer-target surface point vector - ------------------------------------ - - When stellar aberration correction is performed, the direction - vector `srfvec' is adjusted so as to point to the apparent - position of `spoint': considering `spoint' to be an ephemeris - object, `srfvec' points from the observer's position at `et' - to the light time and stellar aberration corrected position of - `spoint'. - - Target body-Sun vector - ---------------------- - - The target body-Sun vector is the apparent position of the - Sun, corrected for light time and stellar aberration, as - seen from the target body at time et-lt. - - --Examples - - The numerical results shown for this example may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Find the phase, solar incidence, and emission angles at the - sub-solar and sub-spacecraft points on Mars as seen from the Mars - Global Surveyor spacecraft at a user-specified UTC time. Use - light time and stellar aberration corrections. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File: mgs_example.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de418.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - mgs_ext13_ipng_mgs95j.bsp MGS ephemeris - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls', - 'mgs_ext13_ipng_mgs95j.bsp' ) - \begintext - - - Example code begins here. - - - #include - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - ./ - #define META "mgs_example.tm" - - /. - Local variables - ./ - SpiceChar * abcorr; - SpiceChar * obsrvr; - SpiceChar * target; - SpiceChar * utc; - - SpiceDouble et; - SpiceDouble srfvec [3]; - SpiceDouble sscemi; - SpiceDouble sscphs; - SpiceDouble sscpt [3]; - SpiceDouble sscsol; - SpiceDouble sslemi; - SpiceDouble sslphs; - SpiceDouble sslsol; - SpiceDouble ssolpt [3]; - SpiceDouble trgepc; - - /. - Load kernel files. - ./ - furnsh_c ( META ); - - /. - Convert the UTC request time string to seconds past J2000 TDB. - ./ - utc = "2004 JAN 1 12:00:00"; - - str2et_c ( utc, &et ); - - /. - Assign observer and target names. The acronym MGS - indicates Mars Global Surveyor. See NAIF_IDS for a - list of names recognized by SPICE. Also set the - aberration correction flag. - ./ - target = "Mars"; - obsrvr = "MGS"; - abcorr = "CN+S"; - - /. - Find the sub-solar point on the Earth as seen from - the MGS spacecraft at et. Use the "near point: ellipsoid" - style of sub-point definition. - ./ - subslr_c ( "near point: ellipsoid", - target, et, "iau_mars", abcorr, - obsrvr, ssolpt, &trgepc, srfvec ); - - /. - Now find the sub-spacecraft point. - ./ - subpnt_c ( "near point: ellipsoid", - target, et, "iau_mars", abcorr, - obsrvr, sscpt, &trgepc, srfvec ); - - /. - Find the phase, solar incidence, and emission - angles at the sub-solar point on the Earth as seen - from MGS at time et. - ./ - ilumin_c ( "Ellipsoid", - target, et, "IAU_MARS", abcorr, - obsrvr, ssolpt, &trgepc, srfvec, - &sslphs, &sslsol, &sslemi ); - - /. - Do the same for the sub-spacecraft point. - ./ - ilumin_c ( "Ellipsoid", - target, et, "IAU_MARS", abcorr, - obsrvr, sscpt, &trgepc, srfvec, - &sscphs, &sscsol, &sscemi ); - - /. - Convert the angles to degrees and write them out. - ./ - sslphs *= dpr_c(); - sslsol *= dpr_c(); - sslemi *= dpr_c(); - - sscphs *= dpr_c(); - sscsol *= dpr_c(); - sscemi *= dpr_c(); - - printf ( "\n" - "UTC epoch is %s\n" - "\n" - "Illumination angles at the sub-solar point:\n" - "\n" - "Phase angle (deg): %f\n" - "Solar incidence angle (deg): %f\n" - "Emission angle (deg): %f\n" - "\n" - "The solar incidence angle should be 0.\n" - "The emission and phase angles should be " - "equal.\n" - "\n" - "\n" - "Illumination angles at the sub-s/c point:\n" - "\n" - "Phase angle (deg): %f\n" - "Solar incidence angle (deg): %f\n" - "Emission angle (deg): %f\n" - "\n" - "The emission angle should be 0.\n" - "The solar incidence and phase angles " - "should be equal.\n" - "\n", - utc, - sslphs, - sslsol, - sslemi, - sscphs, - sscsol, - sscemi ); - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, - the output was: - - UTC epoch is 2004 JAN 1 12:00:00 - - Illumination angles at the sub-solar point: - - Phase angle (deg): 115.542001 - Solar incidence angle (deg): 0.000000 - Emission angle (deg): 115.542001 - - The solar incidence angle should be 0. - The emission and phase angles should be equal. - - - Illumination angles at the sub-s/c point: - - Phase angle (deg): 62.084003 - Solar incidence angle (deg): 62.084003 - Emission angle (deg): 0.000000 - - The emission angle should be 0. - The solar incidence and phase angles should be equal. - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 06-FEB-2009 (NJB) - - Incorrect frame name fixfrm was changed to fixref in - documentation. - - In the header examples, meta-kernel names were updated to use - the suffix - - ".tm" - - -CSPICE Version 1.0.0, 02-MAR-2008 (NJB) - --Index_Entries - - illumination angles - lighting angles - phase angle - emission angle - solar incidence angle - --& -*/ - -{ /* Begin ilumin_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "ilumin_c" ); - - /* - Check the input strings: target, fixref, abcorr, and obsrvr. Make - sure none of the pointers are null and that each string contains at - least one non-null character. - */ - CHKFSTR ( CHK_STANDARD, "ilumin_c", method ); - CHKFSTR ( CHK_STANDARD, "ilumin_c", target ); - CHKFSTR ( CHK_STANDARD, "ilumin_c", fixref ); - CHKFSTR ( CHK_STANDARD, "ilumin_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "ilumin_c", obsrvr ); - - /* - Call the f2c'd routine. - */ - ilumin_ ( ( char * ) method, - ( char * ) target, - ( doublereal * ) &et, - ( char * ) fixref, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) spoint, - ( doublereal * ) trgepc, - ( doublereal * ) srfvec, - ( doublereal * ) phase, - ( doublereal * ) solar, - ( doublereal * ) emissn, - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(fixref), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - chkout_c ( "ilumin_c" ); - -} /* End ilumin_c */ - diff --git a/ext/spice/src/cspice/inedpl.c b/ext/spice/src/cspice/inedpl.c deleted file mode 100644 index 913c6b023b..0000000000 --- a/ext/spice/src/cspice/inedpl.c +++ /dev/null @@ -1,521 +0,0 @@ -/* inedpl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b32 = 0.; -static doublereal c_b33 = 1.; - -/* $Procedure INEDPL ( Intersection of ellipsoid and plane ) */ -/* Subroutine */ int inedpl_(doublereal *a, doublereal *b, doublereal *c__, - doublereal *plane, doublereal *ellips, logical *found) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double sqrt(doublereal); - - /* Local variables */ - doublereal dist, span1[3], span2[3]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal const__, point[3]; - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int cgv2el_(doublereal *, doublereal *, - doublereal *, doublereal *), pl2nvc_(doublereal *, doublereal *, - doublereal *), pl2psv_(doublereal *, doublereal *, doublereal *, - doublereal *), psv2pl_(doublereal *, doublereal *, doublereal *, - doublereal *); - doublereal dplane[4]; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - doublereal maxrad, rcircl, center[3], normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *, - ftnlen); - doublereal invdst[3]; - extern logical return_(void); - doublereal dstort[3], vec1[3], vec2[3]; - -/* $ Abstract */ - -/* Find the intersection of a triaxial ellipsoid and a plane. */ - -/* $ 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 */ - -/* ELLIPSES */ -/* PLANES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* ELLIPSOID */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* A I Length of ellipsoid semi-axis lying on the x-axis. */ -/* B I Length of ellipsoid semi-axis lying on the y-axis. */ -/* C I Length of ellipsoid semi-axis lying on the z-axis. */ -/* PLANE I Plane that intersects ellipsoid. */ -/* ELLIPS O Intersection ellipse, when FOUND is .TRUE. */ -/* FOUND O Flag indicating whether ellipse was found. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B, */ -/* C are the lengths of the semi-axes of a triaxial */ -/* ellipsoid. The ellipsoid is centered at the */ -/* origin and oriented so that its axes lie on the */ -/* x, y and z axes. A, B, and C are the lengths of */ -/* the semi-axes that point in the x, y, and z */ -/* directions respectively. */ - -/* PLANE is a SPICELIB plane. */ - -/* $ Detailed_Output */ - -/* ELLIPS is the SPICELIB ellipse formed by the intersection */ -/* of the input plane and ellipsoid. ELLIPS will */ -/* represent a single point if the ellipsoid and */ -/* plane are tangent. */ - -/* If the intersection of the ellipsoid and plane is */ -/* empty, ELLIPS is not modified. */ - - -/* FOUND is .TRUE. if and only if the intersection of the */ -/* ellipsoid and plane is non-empty. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any of the lengths of the semi-axes of the input ellipsoid */ -/* are non-positive, the error SPICE(DEGENERATECASE) is */ -/* signaled. ELLIPS is not modified. FOUND is set to .FALSE. */ - -/* 2) If the input plane in invalid, in other words, if the input */ -/* plane as the zero vector as its normal vector, the error */ -/* SPICE(INVALIDPLANE) is signaled. ELLIPS is not modified. */ -/* FOUND is set to .FALSE. */ - -/* 3) If the input plane and ellipsoid are very nearly tangent, */ -/* roundoff error may cause this routine to give unreliable */ -/* results. */ - -/* 4) If the input plane and ellipsoid are precisely tangent, the */ -/* intersection is a single point. In this case, the output */ -/* ellipse is degenerate, but FOUND will still have the value */ -/* .TRUE. You must decide whether this output makes sense for */ -/* your application. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* An ellipsoid and a plane can intersect in an ellipse, a single */ -/* point, or the empty set. */ - -/* $ Examples */ - -/* 1) Suppose we wish to find the limb of a body, as observed from */ -/* location LOC in body-fixed coordinates. The SPICELIB routine */ -/* EDLIMB solves this problem. Here's how INEDPL is used in */ -/* that solution. */ - -/* We assume LOC is outside of the body. The body is modelled as */ -/* a triaxial ellipsoid with semi-axes of length A, B, and C. */ -/* The notation */ - -/* < X, Y > */ - -/* indicates the inner product of the vectors X and Y. */ - -/* The limb lies on the plane defined by */ - -/* < X, N > = 1, */ - -/* where the vector N is defined as */ - -/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */ - -/* The assignments */ - -/* N(1) = LOC(1) / A**2 */ -/* N(2) = LOC(2) / B**2 */ -/* N(3) = LOC(3) / C**2 */ - -/* and the calls */ - -/* CALL NVC2PL ( N, 1.0D0, PLANE ) */ - -/* CALL INEDPL ( A, B, C, PLANE, LIMB, FOUND ) */ - -/* CALL EL2CGV ( LIMB, CENTER, SMAJOR, SMINOR ) */ - -/* will return the center and semi-axes of the limb. */ - - -/* How do we know that < X, N > = 1 for all X on the limb? */ -/* This is because all limb points X satisfy */ - -/* < LOC - X, SURFNM(X) > = 0, */ - -/* where SURFNM(X) is a surface normal at X. SURFNM(X) is */ -/* parallel to the vector */ - -/* V = ( X(1) / A**2, X(2) / B**2, X(3) / C**2 ) */ - -/* so we have */ - -/* < LOC - X, V > = 0, */ - -/* < LOC, V > = < X, V > = 1 (from the original */ -/* ellipsoid */ -/* equation); */ -/* and finally */ - -/* < X, N > = 1, */ - -/* where the vector N is defined as */ - -/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */ - - -/* 2) Suppose we wish to find the terminator of a body. We can */ -/* make a fair approximation to the location of the terminator */ -/* by finding the limb of the body as seen from the vertex of */ -/* the umbra; then the problem is essentially the same as in */ -/* example 1. Let VERTEX be this location. We make the */ -/* assignments */ - -/* P(1) = VERTEX(1) / A**2 */ -/* P(2) = VERTEX(2) / B**2 */ -/* P(3) = VERTEX(3) / C**2 */ - -/* and then make the calls */ - -/* CALL NVC2PL ( P, 1.0D0, PLANE ) */ - -/* CALL INEDPL ( A, B, C, PLANE, TERM, FOUND ) */ - -/* The SPICELIB ellipse TERM represents the terminator of the */ -/* body. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */ - -/* Bug fix: error detection for case of invalid input plane was */ -/* added. */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL calls. */ - -/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */ - -/* Removed potential numerical precision problems that could be */ -/* caused by using a REAL constant in a double precision */ -/* computation. The value 1.0 was repaced with the value 1.0D0 in */ -/* the following three lines: */ - -/* DSTORT(1) = 1.0 / A */ -/* DSTORT(2) = 1.0 / B */ -/* DSTORT(3) = 1.0 / C */ - -/* Also changed was a numeric constant from 1.D0 to the */ -/* equivalent, but more aesthetically pleasing 1.0D0. */ - -/* - 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, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersection of ellipsoid and plane */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */ - -/* Bug fix: error detection for case of invalid input plane was */ -/* added. */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL calls. */ - -/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */ - -/* Removed potential numerical precision problems that could be */ -/* caused by using a REAL constant in a double precision */ -/* computation. The value 1.0 was repaced with the value 1.0D0 in */ -/* the following three lines: */ - -/* DSTORT(1) = 1.0 / A */ -/* DSTORT(2) = 1.0 / B */ -/* DSTORT(3) = 1.0 / C */ - -/* Also changed was a numeric constant from 1.D0 to the */ -/* equivalent, but more aesthetically pleasing 1.0D0. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("INEDPL", (ftnlen)6); - } - -/* We don't want to worry about flat ellipsoids: */ - - if (*a <= 0. || *b <= 0. || *c__ <= 0.) { - *found = FALSE_; - setmsg_("Semi-axes: A = #, B = #, C = #.", (ftnlen)33); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("INEDPL", (ftnlen)6); - return 0; - } - -/* Check input plane for zero normal vector. */ - - pl2nvc_(plane, normal, &const__); - if (vzero_(normal)) { - setmsg_("Normal vector of the input PLANE is the zero vector.", ( - ftnlen)52); - sigerr_("SPICE(INVALIDPLANE)", (ftnlen)19); - chkout_("INEDPL", (ftnlen)6); - return 0; - } - -/* This algorithm is partitioned into a series of steps: */ - - -/* 1) Identify a linear transformation that maps the input */ -/* ellipsoid to the unit sphere. We'll call this mapping the */ -/* `distortion' mapping. Apply the distortion mapping to both */ -/* the input plane and ellipsoid. The image of the plane under */ -/* this transformation will be a plane. */ - -/* 2) Find the intersection of the transformed plane and the unit */ -/* sphere. */ - -/* 3) Apply the inverse of the distortion mapping to the */ -/* intersection ellipse to find the undistorted intersection */ -/* ellipse. */ - - -/* Step 1: */ - -/* Find the image of the ellipsoid and plane under the distortion */ -/* matrix. Since the image of the ellipsoid is the unit sphere, */ -/* only the plane transformation requires any work. */ - -/* If the input plane is too far from the origin to possibly */ -/* intersect the ellipsoid, return now. This can save us */ -/* some numerical problems when we scale the plane and ellipsoid. */ - -/* The point returned by PL2PSV is the closest point in PLANE */ -/* to the origin, so its norm gives the distance of the plane */ -/* from the origin. */ - - pl2psv_(plane, point, span1, span2); -/* Computing MAX */ - d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__); - maxrad = max(d__1,d__2); - if (vnorm_(point) > maxrad) { - *found = FALSE_; - chkout_("INEDPL", (ftnlen)6); - return 0; - } - -/* The distortion matrix and its inverse are */ - -/* +- -+ +- -+ */ -/* | 1/A 0 0 | | A 0 0 | */ -/* | 0 1/B 0 |, | 0 B 0 |. */ -/* | 0 0 1/C | | 0 0 C | */ -/* +- -+ +- -+ */ - -/* We declare them with length three, since we are going to make */ -/* use of the diagonal elements only. */ - - dstort[0] = 1. / *a; - dstort[1] = 1. / *b; - dstort[2] = 1. / *c__; - invdst[0] = *a; - invdst[1] = *b; - invdst[2] = *c__; - -/* Apply the distortion mapping to the input plane. Applying */ -/* the distortion mapping to a point and two spanning vectors that */ -/* define the input plane yields a point and two spanning vectors */ -/* that define the distorted plane. */ - - for (i__ = 1; i__ <= 3; ++i__) { - point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("point", i__1, - "inedpl_", (ftnlen)449)] = dstort[(i__2 = i__ - 1) < 3 && 0 - <= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen) - 449)] * point[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : - s_rnge("point", i__3, "inedpl_", (ftnlen)449)]; - span1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span1", i__1, - "inedpl_", (ftnlen)450)] = dstort[(i__2 = i__ - 1) < 3 && 0 - <= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen) - 450)] * span1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : - s_rnge("span1", i__3, "inedpl_", (ftnlen)450)]; - span2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span2", i__1, - "inedpl_", (ftnlen)451)] = dstort[(i__2 = i__ - 1) < 3 && 0 - <= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen) - 451)] * span2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : - s_rnge("span2", i__3, "inedpl_", (ftnlen)451)]; - } - psv2pl_(point, span1, span2, dplane); - -/* Step 2: */ - -/* Find the intersection of the distorted plane and unit sphere. */ - - -/* The intersection of the distorted plane and the unit sphere */ -/* may be a circle, a point, or the empty set. The distance of the */ -/* plane from the origin determines which type of intersection we */ -/* have. If we represent the distorted plane by a unit normal */ -/* vector and constant, the size of the constant gives us the */ -/* distance of the plane from the origin. If the distance is greater */ -/* than 1, the intersection of plane and unit sphere is empty. If */ -/* the distance is equal to 1, we have the tangency case. */ - -/* The routine PL2PSV always gives us an output point that is the */ -/* closest point to the origin in the input plane. This point is */ -/* the center of the intersection circle. The spanning vectors */ -/* returned by PL2PSV, after we scale them by the radius of the */ -/* intersection circle, become an orthogonal pair of vectors that */ -/* extend from the center of the circle to the circle itself. So, */ -/* the center and these scaled vectors define the intersection */ -/* circle. */ - - pl2psv_(dplane, center, vec1, vec2); - dist = vnorm_(center); - if (dist > 1.) { - *found = FALSE_; - chkout_("INEDPL", (ftnlen)6); - return 0; - } - -/* Scale the generating vectors by the radius of the intersection */ -/* circle. */ - -/* Computing 2nd power */ - d__2 = dist; - d__1 = 1. - d__2 * d__2; - rcircl = sqrt(brcktd_(&d__1, &c_b32, &c_b33)); - vsclip_(&rcircl, vec1); - vsclip_(&rcircl, vec2); - -/* Step 3: */ - -/* Apply the inverse distortion to the intersection circle to find */ -/* the actual intersection ellipse. */ - - for (i__ = 1; i__ <= 3; ++i__) { - center[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("center", - i__1, "inedpl_", (ftnlen)511)] = invdst[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", ( - ftnlen)511)] * center[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? - i__3 : s_rnge("center", i__3, "inedpl_", (ftnlen)511)]; - vec1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec1", i__1, - "inedpl_", (ftnlen)512)] = invdst[(i__2 = i__ - 1) < 3 && 0 <= - i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)512)] - * vec1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge( - "vec1", i__3, "inedpl_", (ftnlen)512)]; - vec2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec2", i__1, - "inedpl_", (ftnlen)513)] = invdst[(i__2 = i__ - 1) < 3 && 0 <= - i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)513)] - * vec2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge( - "vec2", i__3, "inedpl_", (ftnlen)513)]; - } - -/* Make an ellipse from the center and generating vectors. */ - - cgv2el_(center, vec1, vec2, ellips); - *found = TRUE_; - chkout_("INEDPL", (ftnlen)6); - return 0; -} /* inedpl_ */ - diff --git a/ext/spice/src/cspice/inedpl_c.c b/ext/spice/src/cspice/inedpl_c.c deleted file mode 100644 index c18a3938a8..0000000000 --- a/ext/spice/src/cspice/inedpl_c.c +++ /dev/null @@ -1,459 +0,0 @@ -/* - --Procedure inedpl_c ( Intersection of ellipsoid and plane ) - --Abstract - - Find the intersection of a triaxial ellipsoid and a plane. - --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 - - ELLIPSES - PLANES - --Keywords - - ELLIPSE - ELLIPSOID - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef inedpl_c - - - void inedpl_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpicePlane * plane, - SpiceEllipse * ellipse, - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - a I Length of ellipsoid semi-axis lying on the x-axis. - b I Length of ellipsoid semi-axis lying on the y-axis. - c I Length of ellipsoid semi-axis lying on the z-axis. - plane I Plane that intersects ellipsoid. - ellipse O Intersection ellipse, when found is SPICETRUE. - found O Flag indicating whether ellipse was found. - --Detailed_Input - - a, - b, - c are the lengths of the semi-axes of a triaxial - ellipsoid. The ellipsoid is centered at the - origin and oriented so that its axes lie on the - x, y and z axes. a, b, and c are the lengths of - the semi-axes that point in the x, y, and z - directions respectively. - - plane is a CSPICE plane. - --Detailed_Output - - ellipse is the CSPICE ellipse formed by the intersection - of the input plane and ellipsoid. ellipse will - represent a single point if the ellipsoid and - plane are tangent. - - If the intersection of the ellipsoid and plane is - empty, ellipse is not modified. - - - found is SPICETRUE if and only if the intersection of the - ellipsoid and plane is non-empty. - --Parameters - - None. - --Exceptions - - 1) If any of the lengths of the semi-axes of the input ellipsoid - are non-positive, the error SPICE(DEGENERATECASE) is - signalled. ellipse is not modified. found is set to SPICEFALSE. - - 2) If the input plane in invalid, the error will be diagnosed by - routines called by this routine. ellipse is not modified. - found is set to SPICEFALSE. - - 3) If the input plane and ellipsoid are very nearly tangent, - roundoff error may cause this routine to give unreliable - results. - - 4) If the input plane and ellipsoid are precisely tangent, the - intersection is a single point. In this case, the output - ellipse is degenerate, but found will still have the value - SPICETRUE. You must decide whether this output makes sense for - your application. - --Files - - None. - --Particulars - - An ellipsoid and a plane can intersect in an ellipse, a single - point, or the empty set. - --Examples - - 1) Suppose we wish to find the limb of a body, as observed from - location loc in body-fixed coordinates. The CSPICE routine - edlimb_c solves this problem. Here's how inedpl_c is used in - that solution. - - We assume loc is outside of the body. The body is modelled as - a triaxial ellipsoid with semi-axes of length a, b, and c. - The notation - - < x, y > - - indicates the inner product of the vectors x and y. - - The limb lies on the plane defined by - - < x, n > = 1, - - where the vector n is defined as - - 2 2 2 - ( loc[0] / a , loc[1] / b , loc[2] / c ) - - The assignments - - n[0] = loc[0] / (a*a); - n[1] = loc[1] / (b*b); - n[2] = loc[2] / (c*c); - - and the calls - - nvc2pl_c ( n, 1.0, &plane ); - - inedpl_c ( a, b, c, &plane, &limb, &found ); - - el2cgv_c ( limb, center, smajor, sminor ); - - will return the center and semi-axes of the limb. - - - How do we know that < x, n > = 1 for all x on the limb? - This is because all limb points x satisfy - - < loc - x, surfnm(x) > = 0, - - where surfnm(x) is any surface normal at x. surfnm(x) is - parallel to the vector - - 2 2 2 - v = ( x[0] / a , x[1] / b , x[2] / c ) - - so we have - - < loc - x, v > = 0, - - < loc, v > = < x, v > = 1 (from the original - ellipsoid - equation) - and finally - - < x, n > = 1 - - where n is as defined above. - - - - 2) Suppose we wish to find the terminator of a body. We can - make a fair approximation to the location of the terminator - by finding the limb of the body as seen from the vertex of - the umbra; then the problem is essentially the same as in - example 1. Let VERTEX be this location. We make the - assignments - - p[0] = vertex[0] / (a*a); - p[1] = vertex[1] / (b*b); - p[2] = vertex[2] / (c*c); - - and then make the calls - - nvc2pl_c ( p, 1.0, &plane ); - - inedpl_c ( a, b, c, &plane, &term, &found ); - - The CSPICE ellipse term represents the terminator of the - body. - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.5, 06-FEB-2003 (EDW) - - Corrected a typo in the header documentation, - input variable 'ellipse' not 'ellips' - - -CSPICE Version 1.0.0, 13-JUN-1999 (NJB) - --Index_Entries - - intersection of ellipsoid and plane - --& -*/ - -{ /* Begin inedpl_c */ - - /* - Local variables - */ - - SpiceDouble center [3]; - SpiceDouble dist; - SpiceDouble dstort [3]; - SpiceDouble invdst [3]; - SpiceDouble maxrad; - SpiceDouble point [3]; - SpiceDouble rcircl; - SpiceDouble span1 [3]; - SpiceDouble span2 [3]; - SpiceDouble vec1 [3]; - SpiceDouble vec2 [3]; - - SpiceInt i; - - SpicePlane dplane; - - - /* - Participate in error tracing. - */ - - chkin_c ( "inedpl_c" ); - - - /* - We don't want to worry about flat ellipsoids: - */ - if ( ( a <= 0. ) - || ( b <= 0. ) - || ( c <= 0. ) ) - { - - *found = SPICEFALSE; - - setmsg_c ( "semi-axes: a = #, b = #, c = #." ); - errdp_c ( "#", a ); - errdp_c ( "#", b ); - errdp_c ( "#", c ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "inedpl_c" ); - return; - } - - - /* - This algorithm is partitioned into a series of steps: - - - 1) Identify a linear transformation that maps the input - ellipsoid to the unit sphere. We'll this mapping the - `distortion' mapping. Apply the distortion mapping to both - the input plane and ellipsoid. The image of the plane under - this transformation will be a plane. - - 2) Find the intersection of the transformed plane and the unit - sphere. - - 3) Apply the inverse of the distortion mapping to the - intersection ellipse to find the undistorted intersection - ellipse. - - - - Step 1: - - Find the image of the ellipsoid and plane under the distortion - matrix. Since the image of the ellipsoid is the unit sphere, - only the plane transformation requires any work. - - If the input plane is too far from the origin to possibly - intersect the ellipsoid, return now. This can save us - some numerical problems when we scale the plane and ellipsoid. - - The point returned by PL2PSV is the closest point in PLANE - to the origin, so its norm gives the distance of the plane - from the origin. - */ - - pl2psv_c ( plane, point, span1, span2 ); - - maxrad = MaxAbs ( a, b ); - maxrad = MaxAbs ( c, maxrad ); - - - if ( vnorm_c(point) > maxrad ) - { - *found = SPICEFALSE; - chkout_c ( "inedpl_c" ); - return; - } - - - /* - The distortion matrix and its inverse are - - +- -+ +- -+ - | 1/a 0 0 | | a 0 0 | - | 0 1/b 0 |, | 0 b 0 |. - | 0 0 1/c | | 0 0 c | - +- -+ +- -+ - - We declare them with length three, since we are going to make - use of the diagonal elements only. - */ - - dstort[0] = 1. / a; - dstort[1] = 1. / b; - dstort[2] = 1. / c; - - invdst[0] = a; - invdst[1] = b; - invdst[2] = c; - - - /* - Apply the distortion mapping to the input plane. Applying - the distortion mapping to a point and two spanning vectors that - define the input plane yields a point and two spanning vectors - that define the distorted plane. - */ - - for ( i = 0; i < 3; i++ ) - { - point[i] = dstort[i] * point[i]; - span1[i] = dstort[i] * span1[i]; - span2[i] = dstort[i] * span2[i]; - } - - psv2pl_c ( point, span1, span2, &dplane ); - - - /* - Step 2: - - Find the intersection of the distorted plane and unit sphere. - - - The intersection of the distorted plane and the unit sphere - may be a circle, a point, or the empty set. The distance of the - plane from the origin determines which type of intersection we - have. If we represent the distorted plane by a unit normal - vector and constant, the size of the constant gives us the - distance of the plane from the origin. If the distance is greater - than 1, the intersection of plane and unit sphere is empty. If - the distance is equal to 1, we have the tangency case. - - The routine PL2PSV always gives us an output point that is the - closest point to the origin in the input plane. This point is - the center of the intersection circle. The spanning vectors - returned by PL2PSV, after we scale them by the radius of the - intersection circle, become an orthogonal pair of vectors that - extend from the center of the circle to the circle itself. So, - the center and these scaled vectors define the intersection - circle. - */ - - pl2psv_c ( &dplane, center, vec1, vec2 ); - - dist = vnorm_c ( center ); - - if ( dist > 1. ) - { - *found = SPICEFALSE; - chkout_c ( "inedpl_c" ); - return; - } - - - /* - Scale the generating vectors by the radius of the intersection - circle. - */ - - rcircl = sqrt ( brcktd_c ( 1. - dist*dist, 0., 1. ) ); - - vscl_c ( rcircl, vec1, vec1 ); - vscl_c ( rcircl, vec2, vec2 ); - - - /* - Step 3: - - Apply the inverse distortion to the intersection circle to find - the actual intersection ellipse. - */ - - for ( i = 0; i < 3; i++ ) - { - center[i] = invdst[i] * center[i]; - vec1[i] = invdst[i] * vec1[i]; - vec2[i] = invdst[i] * vec2[i]; - } - - - /* - Make an ellipse from the center and generating vectors. - */ - cgv2el_c ( center, vec1, vec2, ellipse ); - - *found = SPICETRUE; - - - chkout_c ( "inedpl_c" ); - -} /* End inedpl_c */ diff --git a/ext/spice/src/cspice/inelpl.c b/ext/spice/src/cspice/inelpl.c deleted file mode 100644 index f59373f1d6..0000000000 --- a/ext/spice/src/cspice/inelpl.c +++ /dev/null @@ -1,565 +0,0 @@ -/* inelpl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static doublereal c_b26 = 1.; - -/* $Procedure INELPL ( Intersection of ellipse and plane ) */ -/* Subroutine */ int inelpl_(doublereal *ellips, doublereal *plane, integer * - nxpts, doublereal *xpt1, doublereal *xpt2) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double acos(doublereal), atan2(doublereal, doublereal), cos(doublereal), - sin(doublereal); - - /* Local variables */ - doublereal beta; - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal alpha, v[2]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal const__, trans[4], point[3]; - extern logical vzero_(doublereal *); - doublereal angle1, angle2; - extern /* Subroutine */ int el2cgv_(doublereal *, doublereal *, - doublereal *, doublereal *), vlcom3_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), pl2nvc_(doublereal *, doublereal *, doublereal *), - pl2nvp_(doublereal *, doublereal *, doublereal *), nvp2pl_( - doublereal *, doublereal *, doublereal *); - extern doublereal halfpi_(void); - doublereal center[3], inpcon, normal[3], smajor[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal tmpvec[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - doublereal sminor[3]; - extern doublereal vnormg_(doublereal *, integer *); - extern logical vzerog_(doublereal *, integer *), return_(void); - doublereal sep; - -/* $ Abstract */ - -/* Find the intersection of an ellipse and a plane. */ - -/* $ 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 */ - -/* ELLIPSES */ -/* PLANES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELLIPS I A SPICELIB ellipse. */ -/* PLANE I A SPICELIB plane. */ -/* NXPTS O Number of intersection points of plane and ellipse. */ -/* XPT1, */ -/* XPT2 O Intersection points. */ - -/* $ Detailed_Input */ - -/* ELLIPS is a SPICELIB ellipse. The ellipse is allowed to */ -/* be degenerate: one or both semi-axes may have */ -/* zero length. */ - -/* PLANE is a SPICELIB plane. */ - -/* $ Detailed_Output */ - -/* NXPTS is the number of points of intersection of the */ -/* geometric plane and ellipse represented by PLANE */ -/* and ELLIPS. NXPTS may take the values 0, 1, 2 or */ -/* -1. The value -1 indicates that the ellipse */ -/* consists of more than one point and lies in the */ -/* plane, so the number of intersection points is */ -/* infinite. */ - -/* When the ellipse consists of a single point and */ -/* lies in the plane, NXPTS is set to 1. */ - -/* XPT1, */ -/* XPT2 are the points of intersection of the input plane */ -/* and ellipse. If there is only one intersection */ -/* point, both XPT1 and XPT2 contain that point. If */ -/* the number of intersection points is zero or */ -/* infinite, the contents of XPT1 and XPT2 are */ -/* undefined. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The input plane must be a SPICE plane: the normal vector must */ -/* be non-zero and the constant must be non-negative. */ -/* If the input plane is invalid, the error SPICE(INVALIDPLANE) */ -/* will be signaled. */ - -/* 2) If the input ellipse has non-orthogonal axes, the error */ -/* SPICE(INVALIDELLIPSE) will be signaled. */ - -/* 3) The input ellipse is allowed to be a line segment or a point; */ -/* these cases are not considered to be errors. If the ellipse */ -/* consists of a single point and lies in the plane, the number */ -/* of intersection points is set to 1 (rather than -1) and */ -/* the output arguments XPT1 and XPT2 are assigned the value */ -/* of the ellipse's center. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the intersection set of a non-degenerate */ -/* plane with a possibly degenerate ellipse. The ellipse is allowed */ -/* to consist of a line segment or a point. */ - -/* A plane may intersect an ellipse in 0, 1, 2, or infinitely many */ -/* points. For there to be an infinite set of intersection points, */ -/* the ellipse must lie in the plane and consist of more than one */ -/* point. */ - -/* $ Examples */ - -/* 1) If we want to find the angle of some ray above the limb of an */ -/* ellipsoid, where the angle is measured in a plane containing */ -/* the ray and a `down' vector, we can follow the procedure */ -/* given below. We assume the ray does not intersect the */ -/* ellipsoid. The result we seek is called ANGLE, imaginatively */ -/* enough. */ - -/* We assume that all vectors are given in body-fixed */ -/* coordinates. */ - -/* C */ -/* C Find the limb of the ellipsoid as seen from the */ -/* C point OBSERV. Here A, B, and C are the lengths of */ -/* C the semi-axes of the ellipsoid. */ -/* C */ -/* CALL EDLIMB ( A, B, C, OBSERV, LIMB ) */ - -/* C */ -/* C The ray direction vector is RAYDIR, so the ray is the */ -/* C set of points */ -/* C */ -/* C OBSERV + t * RAYDIR */ -/* C */ -/* C where t is any non-negative real number. */ -/* C */ -/* C The `down' vector is just -OBSERV. The vectors */ -/* C OBSERV and RAYDIR are spanning vectors for the plane */ -/* C we're interested in. We can use PSV2PL to represent */ -/* C this plane by a SPICELIB plane. */ -/* C */ -/* CALL PSV2PL ( OBSERV, OBSERV, RAYDIR, PLANE ) */ - -/* C */ -/* C Find the intersection of the plane defined by OBSERV */ -/* C and RAYDIR with the limb. */ -/* C */ -/* CALL INELPL ( LIMB, PLANE, NXPTS, XPT1, XPT2 ) */ - -/* C */ -/* C We always expect two intersection points, if DOWN */ -/* C is valid. */ -/* C */ -/* IF ( NXPTS .LT. 2 ) THEN */ - -/* [ do something about the error ] */ - -/* ENDIF */ - -/* C */ -/* C Form the vectors from OBSERV to the intersection */ -/* C points. Find the angular separation between the */ -/* C boresight ray and each vector from OBSERV to the */ -/* C intersection points. */ -/* C */ -/* CALL VSUB ( XPT1, OBSERV, VEC1 ) */ -/* CALL VSUB ( XPT2, OBSERV, VEC2 ) */ - -/* SEP1 = VSEP ( VEC1, RAYDIR ) */ -/* SEP2 = VSEP ( VEC2, RAYDIR ) */ - -/* C */ -/* C The angular separation we're after is the minimum of */ -/* C the two separations we've computed. */ -/* C */ -/* ANGLE = MIN ( SEP1, SEP2 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-JAN-2008 (NJB) */ - -/* Bug fix: the routine's specification and behavior have been */ -/* updated so the routine now returns a meaningful result for the */ -/* case of an ellipse consisting of a single point. */ - -/* Bug fix: in the degenerate case where the input ellipse is a */ -/* line segment of positive length, and this segment intersects */ -/* the plane, the number of intersection points is set to 1 */ -/* rather than 2. */ - -/* Invalid input planes and ellipses are now diagnosed. */ - -/* - SPICELIB Version 1.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* - SPICELIB Version 1.1.0, 24-MAR-1992 (NJB) (WLT) */ - -/* Output arguments XPT1, XPT2 are now correctly declared */ -/* with length 3. Comment section for permuted index source */ -/* lines was added following the header. */ - -/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersection of ellipse and plane */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 14-JAN-2008 (NJB) */ - -/* Bug fix: the routine's specification and behavior have been */ -/* updated so the routine now returns a meaningful result for the */ -/* case of an ellipse consisting of a single point. In this case, */ -/* if an intersection is found, the number of intersection points */ -/* is set to 1 and both intersection arguments are set equal to */ -/* the ellipse's center. */ - -/* Bug fix: in the degenerate case where the input ellipse is a */ -/* line segment of positive length, and this segment intersects */ -/* the plane, the number of intersection points is set to 1 */ -/* rather than 2. */ - -/* Invalid input planes and ellipses are now diagnosed. */ -/* Error handling code has been added to trap errors that had */ -/* been erroneously passed off to lower level routines for */ -/* diagnosis. */ - -/* - SPICELIB Version 1.2.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* - SPICELIB Version 1.1.0, 24-MAR-1992 (NJB) (WLT) */ - -/* Output arguments XPT1, XPT2 are now correctly declared */ -/* with length 3. They formerly were declared as scalars. */ -/* The correction will not affect the behavior of the routine */ -/* in programs that already declared the correponding arguments */ -/* correctly. */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("INELPL", (ftnlen)6); - -/* Check the input plane. */ - - pl2nvc_(plane, normal, &inpcon); - if (vzero_(normal)) { - setmsg_("Input SPICE plane has zero normal vector.", (ftnlen)41); - sigerr_("SPICE(INVALIDPLANE)", (ftnlen)19); - chkout_("INELPL", (ftnlen)6); - return 0; - } else if (inpcon < 0.) { - setmsg_("Input SPICE plane has non-positive constant #. Properly con" - "structed SPICE planes always have non-negative constants.", ( - ftnlen)116); - errdp_("#", &inpcon, (ftnlen)1); - sigerr_("SPICE(INVALIDPLANE)", (ftnlen)19); - chkout_("INELPL", (ftnlen)6); - return 0; - } - -/* Get the components of the input ellipse; check for */ -/* invalid semi-axes. The semi-axes may have zero length */ -/* but they must always be orthogonal. We require this */ -/* check only if both semi-axes have non-zero length. */ - - el2cgv_(ellips, center, smajor, sminor); - if (! vzero_(sminor)) { - sep = vsep_(smajor, sminor); - if ((d__1 = sep - halfpi_(), abs(d__1)) > 1e-12) { - setmsg_("Input SPICE ellipse has non-orthogonal semi-axes: (#,#," - "#) and (#,#,#). Angular separation of these vectors is #" - " radians. Properly constructed SPICE ellipses always hav" - "e orthogonal semi-axes.", (ftnlen)190); - errdp_("#", smajor, (ftnlen)1); - errdp_("#", &smajor[1], (ftnlen)1); - errdp_("#", &smajor[2], (ftnlen)1); - errdp_("#", sminor, (ftnlen)1); - errdp_("#", &sminor[1], (ftnlen)1); - errdp_("#", &sminor[2], (ftnlen)1); - errdp_("#", &sep, (ftnlen)1); - sigerr_("SPICE(INVALIDELLIPSE)", (ftnlen)21); - chkout_("INELPL", (ftnlen)6); - return 0; - } - } - -/* If the input ellipse is a single point, decide now */ -/* whether the ellipse lies in the plane. */ - - if (vzero_(smajor)) { - -/* The ellipse is a single point. If the ellipse's center */ -/* lies in the plane, the whole ellipse is the one */ -/* intersection point. Check the inner product of the */ -/* center and the plane's normal vector. */ - - if (vdot_(center, normal) == inpcon) { - -/* The center does in fact lie in the plane. */ - - *nxpts = 1; - vequ_(center, xpt1); - vequ_(center, xpt2); - } else { - -/* There's no intersection: the intersection arguments */ -/* are left undefined in this case. */ - - *nxpts = 0; - } - -/* Return now; this simplifies the logic to follow. */ - - chkout_("INELPL", (ftnlen)6); - return 0; - } - -/* At this point the ellipse may still be degenerate: it can be a */ -/* line segment. We'll need to compute the intersection point or */ -/* points if we have a positive, finite intersection set. */ - -/* The first thing we want to do is translate the plane and the */ -/* ellipse so as to center the ellipse at the origin. To translate */ -/* the plane, just get a point and normal vector, and translate */ -/* the point. Find the plane constant of the translated plane. */ - - pl2nvp_(plane, normal, tmpvec); - vsub_(tmpvec, center, point); - nvp2pl_(normal, point, trans); - pl2nvc_(trans, normal, &const__); - -/* Ok, we can get to work. The locus of the ellipse is */ - -/* cos(theta) SMAJOR + sin(theta) SMINOR, */ - -/* and any point X of the ellipse that intersects the input plane */ -/* satisfies */ - -/* < X, NORMAL > = CONST. */ - -/* Substituting our expression for points on the ellipse into the */ -/* second equation, we arrive at */ - -/* cos(theta) < SMAJOR, NORMAL > */ -/* + sin(theta) < SMINOR, NORMAL > = CONST. (1) */ - -/* This equation merits a little analysis. First, if NORMAL */ -/* is orthogonal to SMAJOR and SMINOR, the plane and ellipse must */ -/* be parallel. Also, the left side of the equation is zero in */ -/* this case. If CONST is non-zero, there are no solutions: */ -/* the ellipse and plane are parallel but do not intersect. If */ -/* CONST is zero, the ellipse lies in the plane: all values of */ -/* theta are solutions. Let's get this case out of the way */ -/* right now, shall we? */ - - v[0] = vdot_(smajor, normal); - v[1] = vdot_(sminor, normal); - -/* Test whether the plane and ellipse are parallel: */ - - if (vzerog_(v, &c__2)) { - -/* The ellipse lies in the plane if and only if CONST is zero. */ -/* In any case, we don't modify XPT1 or XPT2. */ - - if (const__ == 0.) { - *nxpts = -1; - } else { - *nxpts = 0; - } - chkout_("INELPL", (ftnlen)6); - return 0; - } - -/* Now if NORMAL is not orthogonal to both SMAJOR and SMINOR, */ -/* the vector */ - -/* V = ( < SMAJOR, NORMAL >, < SMINOR, NORMAL > ) */ - -/* is non-zero. We can re-write (1) as */ - -/* < U, V > = CONST, */ - -/* where */ - -/* U = ( cos(theta), sin(theta) ). */ - -/* If alpha is the angle between U and V, we have */ - -/* < U, V > = || U || * || V || * cos(alpha), */ - -/* so */ - -/* || V || * cos(alpha) = CONST. (2) */ - -/* CONST is positive, since PL2NVC returns the distance */ -/* of between its input plane and the origin as the output */ -/* plane constant. */ - -/* Equation (2) has solutions if and only if */ - -/* || V || > CONST. (3) */ -/* - */ - -/* Let's return right now if there are no solutions. */ - - if (vnormg_(v, &c__2) < const__) { - *nxpts = 0; - chkout_("INELPL", (ftnlen)6); - return 0; - } - -/* Since (3) above is satisfied, the plane and ellipse intersect. */ -/* We can find alpha using the formula */ - -/* alpha = + arccos ( CONST / || V || ) */ - -/* Since alpha is the angular separation between U and V, we */ -/* can find U once we have the angular position of V; let's */ -/* call that beta. The angular position of U (which we called */ -/* theta earlier) will be */ - -/* theta = beta + alpha. */ -/* - */ - -/* The values of theta are the angles we seek. */ - - alpha = acos(const__ / vnormg_(v, &c__2)); - beta = atan2(v[1], v[0]); - angle1 = beta - alpha; - angle2 = beta + alpha; - -/* Determine the number of intersection points. We have a special */ -/* case if the semi-minor axis has length zero: in that case BETA is */ -/* zero or Pi, and although ANGLE1 and ANGLE2 may differ, the */ -/* cosines of these angles are identical. Since in this case */ -/* the solutions corresponding to ANGLE1 and ANGLE2 have the */ -/* form */ - -/* CENTER + cos(ANGLE1)*SMAJOR */ -/* CENTER + cos(ANGLE2)*SMAJOR */ - -/* the solutions are identical. */ - - - if (vzero_(sminor)) { - *nxpts = 1; - } else { - if (angle1 == angle2) { - -/* This case occurs when ALPHA is zero. */ - - *nxpts = 1; - } else { - *nxpts = 2; - } - } - -/* Compute the intersection points. */ - - d__1 = cos(angle1); - d__2 = sin(angle1); - vlcom3_(&c_b26, center, &d__1, smajor, &d__2, sminor, xpt1); - d__1 = cos(angle2); - d__2 = sin(angle2); - vlcom3_(&c_b26, center, &d__1, smajor, &d__2, sminor, xpt2); - chkout_("INELPL", (ftnlen)6); - return 0; -} /* inelpl_ */ - diff --git a/ext/spice/src/cspice/inelpl_c.c b/ext/spice/src/cspice/inelpl_c.c deleted file mode 100644 index 7919079d03..0000000000 --- a/ext/spice/src/cspice/inelpl_c.c +++ /dev/null @@ -1,585 +0,0 @@ -/* - --Procedure inelpl_c ( Intersection of ellipse and plane ) - --Abstract - - Find the intersection of an ellipse and a plane. - --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 - - ELLIPSES - PLANES - --Keywords - - ELLIPSE - GEOMETRY - MATH - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZim.h" - #undef inelpl_c - - - void inelpl_c ( ConstSpiceEllipse * ellips, - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt1[3], - SpiceDouble xpt2[3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - ellips I A CSPICE ellipse. - plane I A CSPICE plane. - nxpts O Number of intersection points of plane and ellipse. - xpt1, - xpt2 O Intersection points. - --Detailed_Input - - ellips is a CSPICE ellipse. The ellipse is allowed to - be degenerate: one or both semi-axes may have - zero length. - - plane is a CSPICE plane. The intersection of plane - and ellipse is sought. - --Detailed_Output - - nxpts is the number of points of intersection of the - geometric plane and ellipse represented by `plane' and - `ellips'. `nxpts' may take the values 0, 1, 2 or -1. - The value -1 indicates that the ellipse consists of - more than one point lies in the plane, so the number - of intersection points is infinite. - - When the ellipse consists of a single point and - lies in the plane, `nxpts' is set to 1. - - xpt1, - xpt2 are the points of intersection of the input plane - and ellipse. If there is only one intersection - point, both xpt1 and xpt2 contain that point. If - the number of intersection points is zero or - infinite, the contents of xpt1 and xpt2 are - undefined. - --Parameters - - None. - --Exceptions - - 1) The input plane must be a CSPICE plane: the normal vector must - be non-zero and the constant must be non-negative. - If the input plane is invalid, the error SPICE(INVALIDPLANE) - will be signaled. - - 2) If the input ellipse has non-orthogonal axes, the error - SPICE(INVALIDELLIPSE) will be signaled. - - 3) The input ellipse is allowed to be a line segment or a point; - these cases are not considered to be errors. If the ellipse - consists of a single point and lies in the plane, the number - of intersection points is set to 1 (rather than -1) and - the output arguments `xpt1' and `xpt2' are assigned the value - of the ellipse's center. - --Files - - None. - --Particulars - - This routine computes the intersection set of a non-degenerate - plane with a possibly degenerate ellipse. The ellipse is allowed - to consist of a line segment or a point. - - A plane may intersect an ellipse in 0, 1, 2, or infinitely many - points. For there to be an infinite set of intersection points, - the ellipse must lie in the plane and consist of more than one - --Examples - - 1) If we want to find the angle of some ray above the limb of an - ellipsoid, where the angle is measured in a plane containing - the ray and a "down" vector, we can follow the procedure - given below. We assume the ray does not intersect the - ellipsoid. The result we seek is called angle, imaginatively - enough. - - We assume that all vectors are given in body-fixed - coordinates. - - #include "SpiceUsr.h" - . - . - . - /. - Find the limb of the ellipsoid as seen from the - point observ. Here a, b, and c are the lengths of - the semi-axes of the ellipsoid. The limb is - returned as a SpiceEllipse. - ./ - - edlimb_c ( a, b, c, observ, &limb ); - - /. - The ray direction vector is raydir, so the ray is the - set of points - - observ + t * raydir - - where t is any non-negative real number. - - The `down' vector is just -observ. The vectors - observ and raydir are spanning vectors for the plane - we're interested in. We can use psv2pl_c to represent - this plane by a CSPICE plane. - ./ - psv2pl_c ( observ, observ, raydir, &plane ); - - /. - Find the intersection of the plane defined by observ - and raydir with the limb. - ./ - inelpl_c ( limb, plane, nxpts, xpt1, xpt2 ); - - /. - We always expect two intersection points, if the vector - down is valid. - ./ - if ( nxpts < 2 ) - { - [ do something about the error ] - } - - /. - Form the vectors from observ to the intersection - points. Find the angular separation between the - boresight ray and each vector from observ to the - intersection points. - ./ - vsub_c ( xpt1, observ, vec1 ); - vsub_c ( xpt2, observ, vec2 ); - - sep1 = vsep_c ( vec1, raydir ); - sep2 = vsep_c ( vec2, raydir ); - - /. - The angular separation we're after is the minimum of - the two separations we've computed. - ./ - angle = mind_c ( 2, sep1, sep2 ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 2.0.0, 14-JAN-2008 (NJB) - - Bug fix: the routine's specification and behavior have been - updated so the routine now returns a meaningful result for the - case of an ellipse consisting of a single point. - - Bug fix: in the degenerate case where the input ellipse is a - line segment of positive length, and this segment intersects - the plane, the number of intersection points is set to 1 - rather than 2. - - Invalid input planes and ellipses are now diagnosed. - - -CSPICE Version 1.0.0, 28-AUG-2001 (NJB) - --Index_Entries - - intersection of ellipse and plane - --& -*/ - - -/* --Revisions - - -CSPICE Version 2.0.0, 14-JAN-2008 (NJB) - - Bug fix: the routine's specification and behavior have been - updated so the routine now returns a meaningful result for the - case of an ellipse consisting of a single point. In this case, - if an intersection is found, the number of intersection points - is set to 1 and both intersection arguments are set equal to - the ellipse's center. - - Bug fix: in the degenerate case where the input ellipse is a - line segment of positive length, and this segment intersects - the plane, the number of intersection points is set to 1 - rather than 2. - - Invalid input planes and ellipses are now diagnosed. - Error handling code has been added to trap errors that had - been erroneously passed off to lower level routines for - diagnosis. --& -*/ - - - -{ /* Begin inelpl_c */ - - - /* - Local constants - */ - #define SEPLIM ( 1.0e-12 ) - - /* - Local variables - */ - SpiceDouble alpha; - SpiceDouble angle1; - SpiceDouble angle2; - SpiceDouble beta; - SpiceDouble center [3]; - SpiceDouble constant; - SpiceDouble inpcon; - SpiceDouble normal [3]; - SpiceDouble point [3]; - SpiceDouble sep; - SpiceDouble smajor [3]; - SpiceDouble sminor [3]; - SpiceDouble v [2]; - - SpicePlane trans; - - - - /* - Participate in error tracing. - */ - chkin_c ( "inelpl_c" ); - - - /* - Check the input plane. - */ - pl2nvc_c ( plane, normal, &inpcon ); - - if ( vzero_c(normal) ) - { - setmsg_c ( "Input SPICE plane has zero normal vector." ); - sigerr_c ( "SPICE(INVALIDPLANE)" ); - chkout_c ( "inelpl_c" ); - return; - } - else if ( inpcon < 0.0 ) - { - setmsg_c ( "Input SPICE plane has non-positive " - "constant #. Properly constructed " - "SPICE planes always have non-negative " - "constants." ); - errdp_c ( "#", inpcon ); - sigerr_c ( "SPICE(INVALIDPLANE)" ); - chkout_c ( "inelpl_c" ); - return; - } - - /* - Get the components of the input ellipse; check for - invalid semi-axes. The semi-axes may have zero length - but they must always be orthogonal. We require this - check only if both semi-axes have non-zero length. - */ - el2cgv_c ( ellips, center, smajor, sminor ); - - if ( !vzero_c(sminor) ) - { - sep = vsep_c( smajor, sminor ); - - if ( fabs( sep-halfpi_c() ) > SEPLIM ) - { - setmsg_c ( "Input SPICE ellipse has non-orthogonal " - "semi-axes: (#,#,#) and (#,#,#). Angular " - "separation of these vectors is # radians. " - "Properly constructed SPICE ellipses " - "always have orthogonal semi-axes." ); - errdp_c ( "#", smajor[0] ); - errdp_c ( "#", smajor[1] ); - errdp_c ( "#", smajor[2] ); - errdp_c ( "#", sminor[0] ); - errdp_c ( "#", sminor[1] ); - errdp_c ( "#", sminor[2] ); - errdp_c ( "#", sep ); - sigerr_c ( "SPICE(INVALIDELLIPSE)" ); - chkout_c ( "inelpl_c" ); - return; - } - } - - /* - If the input ellipse is a single point, decide now - whether the ellipse lies in the plane. - */ - - if ( vzero_c(smajor) ) - { - /* - The ellipse is a single point. If the ellipse's center - lies in the plane, the whole ellipse is the one - intersection point. Check the inner product of the - center and the plane's normal vector. - */ - - if ( vdot_c(center, normal) == inpcon ) - { - /* - The center does in fact lie in the plane. - */ - - *nxpts = 1; - - vequ_c ( center, xpt1 ); - vequ_c ( center, xpt2 ); - } - else - { - /* - There's no intersection: the intersection arguments - are left undefined in this case. - */ - - *nxpts = 0; - } - - /* - Return now; this simplifies the logic to follow. - */ - chkout_c ( "inelpl_c" ); - return; - } - - /* - At this point the ellipse may still be degenerate: it can be a - line segment. We'll need to compute the intersection point or - points if we have a positive, finite intersection set. - - The first thing we want to do is translate the plane and the - ellipse so as to center the ellipse at the origin. To translate - the plane, just get a point and normal vector, and translate - the point. Find the plane constant of the translated plane. - */ - pl2nvp_c ( plane, normal, point ); - vsub_c ( point, center, point ); - nvp2pl_c ( normal, point, &trans ); - pl2nvc_c ( &trans, normal, &constant ); - - /* - Ok, we can get to work. The locus of the ellipse is - - cos(theta) smajor + sin(theta) sminor, - - and any point x of the ellipse that intersects the input plane - satisfies - - < x, normal > = constant. - - Substituting our expression for points on the ellipse into the - second equation, we arrive at - - cos(theta) < smajor, normal > - + sin(theta) < sminor, normal > = constant. (1) - - This equation merits a little analysis. First, if `normal' - is orthogonal to `smajor' and `sminor, the plane and ellipse must - be parallel. Also, the left side of the equation is zero in - this case. If `constant' is non-zero, there are no solutions: - the ellipse and plane are parallel but do not intersect. If - `constant' is zero, the ellipse lies in the plane: all values of - theta are solutions. Let's get this case out of the way - right now, shall we? - */ - v[0] = vdot_c ( smajor, normal ); - v[1] = vdot_c ( sminor, normal ); - - /* - Test whether the plane and ellipse are parallel. - */ - if ( vzerog_c( v, 2 ) ) - { - /* - The ellipse lies in the plane if and only if constant is zero. - In any case, we don't modify xpt1 or xpt2. - */ - if ( constant == 0.0 ) - { - *nxpts = -1; - } - else - { - *nxpts = 0; - } - - chkout_c ( "inelpl_c" ); - return; - } - - - /* - Now if `normal' is not orthogonal to both `smajor' and `sminor', - the vector - - v = ( < smajor, normal >, < sminor, normal > ) - - is non-zero. We can re-write (1) as - - < u, v > = constant, - - where - - u = ( cos(theta), sin(theta) ). - - If alpha is the angle between u and v, we have - - < u, v > = || u || * || v || * cos(alpha), - - so - - || v || * cos(alpha) = constant. (2) - - `constant' is positive, since pl2nvc_c returns the distance - between its input plane and the origin as the output - plane constant. - - Equation (2) has solutions if and only if - - || v || > constant. (3) - - - - - Let's return right now if there are no solutions. - */ - if ( vnormg_c ( v, 2 ) < constant ) - { - *nxpts = 0; - - chkout_c ( "inelpl_c" ); - return; - } - - - /* - Since (3) above is satisfied, the plane and ellipse intersect. - We can find alpha by the formula - - alpha = + arccos ( constant / || v || ) - - Since `alpha' is the angular separation between `u' and `v', we - can find `u' once we have the angular position of `v'; let's - call that `beta'. The angular position of `u'(which we called - `theta' earlier) will be - - theta = beta + alpha. - - - - The values of `theta' are the angles we seek. - */ - alpha = acos ( constant / vnormg_c ( v, 2 ) ); - - beta = atan2 ( v[1], v[0] ); - - angle1 = beta - alpha; - angle2 = beta + alpha; - - /* - Determine the number of intersection points. We have a special - case if the semi-minor axis has length zero: in that case `beta' is - zero or Pi, and although `angle1' and `angle2' may differ, the - cosines of these angles are identical. Since in this case - the solutions corresponding to `angle1' and `angle2' have the - form - - center + cos(angle1)*smajor - center + cos(angle2)*smajor - - the solutions are identical. - */ - - if ( vzero_c(sminor) ) - { - *nxpts = 1; - } - else - { - if ( angle1 == angle2 ) - { - /* - This case occurs when `alpha' is zero. - */ - - *nxpts = 1; - } - else - { - *nxpts = 2; - } - } - - /* - Compute the intersection points. - */ - vlcom3_c ( 1.0, center, - cos(angle1), smajor, - sin(angle1), sminor, xpt1 ); - - vlcom3_c ( 1.0, center, - cos(angle2), smajor, - sin(angle2), sminor, xpt2 ); - - chkout_c ( "inelpl_c" ); - -} /* End inelpl_c */ - diff --git a/ext/spice/src/cspice/inquire.c b/ext/spice/src/cspice/inquire.c deleted file mode 100644 index 29491659a6..0000000000 --- a/ext/spice/src/cspice/inquire.c +++ /dev/null @@ -1,106 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "string.h" -#ifdef KR_headers -integer f_inqu(a) inlist *a; -#else -#ifdef MSDOS -#undef abs -#undef min -#undef max -#include "io.h" -#endif -integer f_inqu(inlist *a) -#endif -{ flag byfile; - int i, n; - unit *p; - char buf[256]; - long x; - if(a->infile!=NULL) - { byfile=1; - g_char(a->infile,a->infilen,buf); -#ifdef NON_UNIX_STDIO - x = access(buf,0) ? -1 : 0; - for(i=0,p=NULL;iinunitinunit>=0) - { - p= &f__units[a->inunit]; - } - else - { - p=NULL; - } - } - if(a->inex!=NULL) - if(byfile && x != -1 || !byfile && p!=NULL) - *a->inex=1; - else *a->inex=0; - if(a->inopen!=NULL) - if(byfile) *a->inopen=(p!=NULL); - else *a->inopen=(p!=NULL && p->ufd!=NULL); - if(a->innum!=NULL) *a->innum= p-f__units; - if(a->innamed!=NULL) - if(byfile || p!=NULL && p->ufnm!=NULL) - *a->innamed=1; - else *a->innamed=0; - if(a->inname!=NULL) - if(byfile) - b_char(buf,a->inname,a->innamlen); - else if(p!=NULL && p->ufnm!=NULL) - b_char(p->ufnm,a->inname,a->innamlen); - if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL) - if(p->url) - b_char("DIRECT",a->inacc,a->inacclen); - else b_char("SEQUENTIAL",a->inacc,a->inacclen); - if(a->inseq!=NULL) - if(p!=NULL && p->url) - b_char("NO",a->inseq,a->inseqlen); - else b_char("YES",a->inseq,a->inseqlen); - if(a->indir!=NULL) - if(p==NULL || p->url) - b_char("YES",a->indir,a->indirlen); - else b_char("NO",a->indir,a->indirlen); - if(a->infmt!=NULL) - if(p!=NULL && p->ufmt==0) - b_char("UNFORMATTED",a->infmt,a->infmtlen); - else b_char("FORMATTED",a->infmt,a->infmtlen); - if(a->inform!=NULL) - if(p!=NULL && p->ufmt==0) - b_char("NO",a->inform,a->informlen); - else b_char("YES",a->inform,a->informlen); - if(a->inunf) - if(p!=NULL && p->ufmt==0) - b_char("YES",a->inunf,a->inunflen); - else if (p!=NULL) b_char("NO",a->inunf,a->inunflen); - else b_char("UNKNOWN",a->inunf,a->inunflen); - if(a->inrecl!=NULL && p!=NULL) - *a->inrecl=p->url; - if(a->innrec!=NULL && p!=NULL && p->url>0) - *a->innrec=ftell(p->ufd)/p->url+1; - if(a->inblank && p!=NULL && p->ufmt) - if(p->ublnk) - b_char("ZERO",a->inblank,a->inblanklen); - else b_char("NULL",a->inblank,a->inblanklen); - return(0); -} diff --git a/ext/spice/src/cspice/inrypl.c b/ext/spice/src/cspice/inrypl.c deleted file mode 100644 index 6913825940..0000000000 --- a/ext/spice/src/cspice/inrypl.c +++ /dev/null @@ -1,791 +0,0 @@ -/* inrypl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static doublereal c_b17 = 1.; - -/* $Procedure INRYPL ( Intersection of ray and plane ) */ -/* Subroutine */ int inrypl_(doublereal *vertex, doublereal *dir, doublereal * - plane, integer *nxpts, doublereal *xpt) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - doublereal udir[3]; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_( - doublereal *, doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal dpmax_(void); - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - doublereal const__, prjvn; - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, - doublereal *), cleard_(integer *, doublereal *); - doublereal mscale, prjdif, sclcon, toobig, normal[3], prjdir; - extern logical smsgnd_(doublereal *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *, - ftnlen); - extern logical return_(void); - doublereal sclvtx[3]; - -/* $ Abstract */ - -/* Find the intersection of a ray and a plane. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VERTEX, */ -/* DIR I Vertex and direction vector of ray. */ -/* PLANE I A SPICELIB plane. */ -/* NXPTS O Number of intersection points of ray and plane. */ -/* XPT O Intersection point, if NXPTS = 1. */ - -/* $ Detailed_Input */ - -/* VERTEX, */ -/* DIR are a point and direction vector that define a */ -/* ray in three-dimensional space. */ - -/* PLANE is a SPICELIB plane. */ - -/* $ Detailed_Output */ - -/* NXPTS is the number of points of intersection of the */ -/* input ray and plane. Values and meanings of */ -/* NXPTS are: */ - -/* 0 No intersection. */ - -/* 1 One point of intersection. Note that */ -/* this case may occur when the ray's */ -/* vertex is in the plane. */ - -/* -1 An infinite number of points of */ -/* intersection; the ray lies in the plane. */ - - -/* XPT is the point of intersection of the input ray */ -/* and plane, when there is exactly one point of */ -/* intersection. Otherwise, XPT is the zero vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the ray's direction vector is the zero vector, the error */ -/* SPICE(ZEROVECTOR) is signaled. NXPTS and XPT are not */ -/* modified. */ - - -/* 2) If the ray's vertex is further than DPMAX() / 3 from the */ -/* origin, the error SPICE(VECTORTOOBIG) is signaled. NXPTS */ -/* and XPT are not modified. */ - - -/* 3) If the input plane is s further than DPMAX() / 3 from the */ -/* origin, the error SPICE(VECTORTOOBIG) is signaled. NXPTS */ -/* and XPT are not modified. */ - - -/* 4) The input plane should be created by one of the SPICELIB */ -/* routines */ - -/* NVC2PL */ -/* NVP2PL */ -/* PSV2PL */ - -/* Invalid input planes will cause unpredictable results. */ - - -/* 5) In the interest of good numerical behavior, in the case */ -/* where the ray's vertex is not in the plane, this routine */ -/* considers that an intersection of the ray and plane occurs */ -/* only if the distance between the ray's vertex and the */ -/* intersection point is less than DPMAX() / 3. */ - -/* If VERTEX is not in the plane and this condition is not */ -/* met, then NXPTS is set to 0 and XPT is set to the zero */ -/* vector. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The intersection of a ray and plane in three-dimensional space */ -/* can be a the empty set, a single point, or the ray itself. */ - -/* $ Examples */ - -/* 1) Find the camera projection of the center of an extended */ -/* body. For simplicity, we assume: */ - -/* -- The camera has no distortion; the image of a point */ -/* is determined by the intersection of the focal plane */ -/* and the line determined by the point and the camera's */ -/* focal point. */ - -/* -- The camera's pointing matrix (C-matrix) is available */ -/* in a C-kernel. */ - - -/* C */ -/* C Load Leapseconds and SCLK kernels to support time */ -/* C conversion. */ -/* C */ -/* CALL FURNSH ( 'LEAP.KER' ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* C */ -/* C Load an SPK file containing ephemeris data for */ -/* C observer (a spacecraft, whose NAIF integer code */ -/* C is SC) and target at the UTC epoch of observation. */ -/* C */ -/* CALL FURNSH ( 'SPK.BSP' ) */ - -/* C */ -/* C Load a C-kernel containing camera pointing for */ -/* C the UTC epoch of observation. */ -/* C */ -/* CALL FURNSH ( 'CK.BC' ) */ - -/* C */ -/* C Find the ephemeris time (barycentric dynamical time) */ -/* C and encoded spacecraft clock times corresponding to */ -/* C the UTC epoch of observation. */ -/* C */ -/* CALL UTC2ET ( UTC, ET ) */ -/* CALL SCE2C ( SC, ET, SCLKDP ) */ - -/* C */ -/* C Encode the pointing lookup tolerance. */ -/* C */ -/* CALL SCTIKS ( SC, TOLCH, TOLDP ) */ - -/* C */ -/* C Find the observer-target vector at the observation */ -/* C epoch. In this example, we'll use a light-time */ -/* C corrected state vector. */ -/* C */ -/* CALL SPKEZ ( TARGET, ET, 'J2000', 'LT', SC, */ -/* . STATE, LT ) */ - -/* C */ -/* C Look up camera pointing. */ -/* C */ -/* CALL CKGP ( CAMERA, SCLKDP, TOLDP, 'J2000', CMAT, */ -/* . CLKOUT, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* [Handle this case...] */ - -/* END IF */ - -/* C */ -/* C Negate the spacecraft-to-target body vector and */ -/* C convert it to camera coordinates. */ -/* C */ -/* CALL VMINUS ( STATE, DIR ) */ -/* CALL MXV ( CMAT, DIR, DIR ) */ - -/* C */ -/* C If FL is the camera's focal length, the effective */ -/* C focal point is */ -/* C */ -/* C FL * ( 0, 0, 1 ) */ -/* C */ -/* CALL VSCL ( FL, ZVEC, FOCUS ) */ - -/* C */ -/* C The camera's focal plane contains the origin in */ -/* C camera coordinates, and the z-vector is orthogonal */ -/* C to the plane. Make a SPICELIB plane representing */ -/* C the focal plane. */ -/* C */ -/* CALL NVC2PL ( ZVEC, 0.D0, FPLANE ) */ - -/* C */ -/* C The image of the target body's center in the focal */ -/* C plane is defined by the intersection with the focal */ -/* C plane of the ray whose vertex is the focal point and */ -/* C whose direction is DIR. */ -/* C */ -/* CALL INRYPL ( FOCUS, DIR, FPLANE, NXPTS, IMAGE ) */ - -/* IF ( NXPTS .EQ. 1 ) THEN */ -/* C */ -/* C The body center does project to the focal plane. */ -/* C Check whether the image is actually in the */ -/* C camera's field of view... */ -/* C */ -/* . */ -/* . */ -/* . */ -/* ELSE */ - -/* C */ -/* C The body center does not map to the focal plane. */ -/* C Handle this case... */ -/* C */ -/* . */ -/* . */ -/* . */ -/* END IF */ - - - -/* 2) Find the Saturn ring plane intercept of a spacecraft-mounted */ -/* instrument's boresight vector. We want the find the point */ -/* in the ring plane that will be observed by an instrument */ -/* with a give boresight direction at a specified time. We */ -/* must account for light time and stellar aberration in order */ -/* to find this point. The intercept point will be expressed */ -/* in Saturn body-fixed coordinates. */ - -/* In this example, we assume */ - -/* -- The ring plane is equatorial. */ - -/* -- Light travels in a straight line. */ - -/* -- The light time correction for the ring plane intercept */ -/* can be obtained by performing three light-time */ -/* correction iterations. If this assumption does not */ -/* lead to a sufficiently accurate result, additional */ -/* iterations can be performed. */ - -/* -- A Newtonian approximation of stellar aberration */ -/* suffices. */ - -/* -- The boresight vector is given in J2000 coordinates. */ - -/* -- The observation epoch is ET ephemeris seconds past */ -/* J2000. */ - -/* -- The boresight vector, spacecraft and planetary */ -/* ephemerides, and ring plane orientation are all known */ -/* with sufficient accuracy for the application. */ - -/* -- All necessary kernels are loaded by the caller of */ -/* this example routine. */ - - -/* SUBROUTINE RING_XPT ( SC, ET, BORVEC, SBFXPT, FOUND ) */ -/* IMPLICIT NONE */ - -/* CHARACTER*(*) SC */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION BORVEC ( 3 ) */ -/* DOUBLE PRECISION SBFXPT ( 3 ) */ -/* LOGICAL FOUND */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION CLIGHT */ -/* DOUBLE PRECISION VDIST */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER UBPL */ -/* PARAMETER ( UBPL = 4 ) */ - -/* INTEGER SATURN */ -/* PARAMETER ( SATURN = 699 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION BORV2 ( 3 ) */ -/* DOUBLE PRECISION CORVEC ( 3 ) */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION PLANE ( UBPL ) */ -/* DOUBLE PRECISION SATSSB ( 6 ) */ -/* DOUBLE PRECISION SCPOS ( 3 ) */ -/* DOUBLE PRECISION SCSSB ( 6 ) */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STCORR ( 3 ) */ -/* DOUBLE PRECISION TAU */ -/* DOUBLE PRECISION TPMI ( 3, 3 ) */ -/* DOUBLE PRECISION XPT ( 3 ) */ -/* DOUBLE PRECISION ZVEC ( 3 ) */ - -/* INTEGER I */ -/* INTEGER NXPTS */ -/* INTEGER SCID */ - -/* LOGICAL FND */ - -/* C */ -/* C First step: account for stellar aberration. Since the */ -/* C instrument pointing is given, we need to find the intercept */ -/* C point such that, when the stellar aberration correction is */ -/* C applied to the vector from the spacecraft to that point, */ -/* C the resulting vector is parallel to BORVEC. An easy */ -/* C solution is to apply the inverse of the normal stellar */ -/* C aberration correction to BORVEC, and then solve the */ -/* C intercept problem with this corrected boresight vector. */ -/* C */ -/* C Find the position of the observer relative */ -/* C to the solar system barycenter at ET. */ -/* C */ -/* CALL BODN2C ( SC, SCID, FND ) */ - -/* IF ( .NOT. FND ) THEN */ - -/* CALL SETMSG ( 'ID code for body # was not found.' ) */ -/* CALL ERRCH ( '#', SC ) */ -/* CALL SIGERR ( 'SPICE(NOTRANSLATION' ) */ -/* RETURN */ - -/* END IF */ - -/* CALL SPKSSB ( SCID, ET, 'J2000', SCSSB ) */ - -/* C */ -/* C We now wish to find the vector CORVEC that, when */ -/* C corrected for stellar aberration, yields BORVEC. */ -/* C A good first approximation is obtained by applying */ -/* C the stellar aberration correction for transmission */ -/* C to BORVEC. */ -/* C */ -/* CALL STLABX ( BORVEC, SCSSB(4), CORVEC ) */ - -/* C */ -/* C The inverse of the stellar aberration correction */ -/* C applicable to CORVEC should be a very good estimate of */ -/* C the correction we need to apply to BORVEC. Apply */ -/* C this correction to BORVEC to obtain an improved estimate */ -/* C of CORVEC. */ -/* C */ -/* CALL STELAB ( CORVEC, SCSSB(4), BORV2 ) */ -/* CALL VSUB ( BORV2, CORVEC, STCORR ) */ -/* CALL VSUB ( BORVEC, STCORR, CORVEC ) */ - -/* C */ -/* C Because the ring plane intercept may be quite far from */ -/* C Saturn's center, we cannot assume light time from the */ -/* C intercept to the observer is well approximated by */ -/* C light time from Saturn's center to the observer. */ -/* C We compute the light time explicitly using an iterative */ -/* C approach. */ -/* C */ -/* C We can however use the light time from Saturn's center to */ -/* C the observer to obtain a first estimate of the actual light */ -/* C time. */ -/* C */ -/* CALL SPKEZR ( 'SATURN', ET, 'J2000', 'LT', SC, */ -/* . STATE, LT ) */ -/* TAU = LT */ - -/* C */ -/* C Find the ring plane intercept and calculate the */ -/* C light time from it to the spacecraft. */ -/* C Perform three iterations. */ -/* C */ -/* I = 1 */ -/* FOUND = .TRUE. */ - -/* DO WHILE ( ( I .LE. 3 ) .AND. ( FOUND ) ) */ -/* C */ -/* C Find the position of Saturn relative */ -/* C to the solar system barycenter at ET-TAU. */ -/* C */ -/* CALL SPKSSB ( SATURN, ET-TAU, 'J2000', SATSSB ) */ - -/* C */ -/* C Find the Saturn-to-observer vector defined by these */ -/* C two position vectors. */ -/* C */ -/* CALL VSUB ( SCSSB, SATSSB, SCPOS ) */ - -/* C */ -/* C Look up Saturn's pole at ET-TAU; this is the third */ -/* C column of the matrix that transforms Saturn body-fixed */ -/* C coordinates to J2000 coordinates. */ -/* C */ -/* CALL PXFORM ( 'IAU_SATURN', 'J2000', ET-TAU, TPMI ) */ - -/* CALL MOVED ( TPMI(1,3), 3, ZVEC ) */ - -/* C */ -/* C Make a SPICELIB plane representing the ring plane. */ -/* C We're treating Saturn's center as the origin, so */ -/* C the plane constant is 0. */ -/* C */ -/* CALL NVC2PL ( ZVEC, 0.D0, PLANE ) */ - -/* C */ -/* C Find the intersection of the ring plane and the */ -/* C ray having vertex SCPOS and direction vector */ -/* C CORVEC. */ -/* C */ -/* CALL INRYPL ( SCPOS, CORVEC, PLANE, NXPTS, XPT ) */ - -/* C */ -/* C If the number of intersection points is 1, */ -/* C find the next light time estimate. */ -/* C */ -/* IF ( NXPTS .EQ. 1 ) THEN */ -/* C */ -/* C Find the light time (zero-order) from the */ -/* C intercept point to the spacecraft. */ -/* C */ -/* TAU = VDIST ( SCPOS, XPT ) / CLIGHT() */ -/* I = I + 1 */ - -/* ELSE */ - -/* FOUND = .FALSE. */ - -/* END IF */ - -/* END DO */ - -/* C */ -/* C At this point, if FOUND is .TRUE., we iterated */ -/* C 3 times, and XPT is our estimate of the */ -/* C position of the ring plane intercept point */ -/* C relative to Saturn in the J2000 frame. This is the */ -/* C point observed by an instrument pointed in direction */ -/* C BORVEC at ET at mounted on the spacecraft SC. */ -/* C */ -/* C If FOUND is .FALSE., the boresight ray does not */ -/* C intersect the ring plane. */ -/* C */ -/* C As a final step, transform XPT to Saturn body-fixed */ -/* C coordinates. */ -/* C */ -/* IF ( FOUND ) THEN */ - -/* CALL MTXV ( TPMI, XPT, SBFXPT ) */ - -/* END IF */ - -/* END */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 07-FEB-2008 (BVS) */ - -/* Fixed a few typos in the header. */ - -/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - SPICELIB Version 1.0.3, 12-DEC-2002 (NJB) */ - -/* Header fix: ring plane intercept algorithm was corrected. */ -/* Now light time is computed accurately, and stellar aberration */ -/* is accounted for. Example was turned into a complete */ -/* subroutine. */ - -/* - SPICELIB Version 1.0.2, 09-MAR-1999 (NJB) */ - -/* Reference to SCE2T replaced by reference to SCE2C. An */ -/* occurrence of ENDIF was replaced by END IF. */ - -/* - 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, 01-APR-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersection of ray and plane */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("INRYPL", (ftnlen)6); - } - -/* We'll give the name TOOBIG to the bound DPMAX() / MARGIN. */ -/* If we let VTXPRJ be the orthogonal projection of VERTEX onto */ -/* PLANE, and let DIFF be the vector VTXPRJ - VERTEX, then */ -/* we know that */ - -/* || DIFF || < 2 * TOOBIG */ - -/* Check the distance of the ray's vertex from the origin. */ - - toobig = dpmax_() / 3.; - if (vnorm_(vertex) >= toobig) { - setmsg_("Ray's vertex is too far from the origin.", (ftnlen)40); - sigerr_("SPICE(VECTORTOOBIG)", (ftnlen)19); - chkout_("INRYPL", (ftnlen)6); - return 0; - } - -/* Check the distance of the plane from the origin. (The returned */ -/* plane constant IS this distance.) */ - - pl2nvc_(plane, normal, &const__); - if (const__ >= toobig) { - setmsg_("Plane is too far from the origin.", (ftnlen)33); - sigerr_("SPICE(VECTORTOOBIG)", (ftnlen)19); - chkout_("INRYPL", (ftnlen)6); - return 0; - } - -/* Check the ray's direction vector. */ - - vhat_(dir, udir); - if (vzero_(udir)) { - setmsg_("Ray's direction vector is the zero vector.", (ftnlen)42); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("INRYPL", (ftnlen)6); - return 0; - } - -/* That takes care of the error cases. Now scale the input vertex */ -/* and plane to improve numerical behavior. */ - -/* Computing MAX */ - d__1 = const__, d__2 = vnorm_(vertex); - mscale = max(d__1,d__2); - if (mscale != 0.) { - d__1 = 1. / mscale; - vscl_(&d__1, vertex, sclvtx); - sclcon = const__ / mscale; - } else { - vequ_(vertex, sclvtx); - sclcon = const__; - } - if (mscale > 1.) { - toobig /= mscale; - } -/* Find the projection (coefficient) of the ray's vertex along the */ -/* plane's normal direction. */ - - prjvn = vdot_(sclvtx, normal); - -/* If this projection is the plane constant, the ray's vertex lies in */ -/* the plane. We have one intersection or an infinite number of */ -/* intersections. It all depends on whether the ray actually lies */ -/* in the plane. */ - -/* The absolute value of PRJDIF is the distance of the ray's vertex */ -/* from the plane. */ - - prjdif = sclcon - prjvn; - if (prjdif == 0.) { - -/* XPT is the original, unscaled vertex. */ - - vequ_(vertex, xpt); - if (vdot_(normal, udir) == 0.) { - -/* The ray's in the plane. */ - - *nxpts = -1; - } else { - *nxpts = 1; - } - chkout_("INRYPL", (ftnlen)6); - return 0; - } - -/* Ok, the ray's vertex is not in the plane. The ray may still be */ -/* parallel to or may point away from the plane. If the ray does */ -/* point towards the plane, mathematicians would say that the */ -/* ray does intersect the plane, but the computer may disagree. */ - -/* For this routine to find an intersection, both of the following */ -/* conditions must be met: */ - -/* -- The ray must point toward the plane; this happens when */ -/* PRJDIF has the same sign as < UDIR, NORMAL >. */ - -/* -- The vector difference XPT - SCLVTX must not overflow. */ - -/* Qualitatively, the case of interest looks something like the */ -/* picture below: */ - - -/* * SCLVTX */ -/* |\ */ -/* | \ <-- UDIR */ -/* | \ */ -/* length of this | \| */ -/* segment is | -* */ -/* | */ -/* | PRJDIF | --> | ___________________________ */ -/* |/ / */ -/* | * / <-- PLANE */ -/* /| XPT / */ -/* / ^ / */ -/* / | NORMAL / */ -/* / | . / */ -/* / |/| / */ -/* / .---| / / */ -/* / | |/ / */ -/* / `---* / */ -/* / Projection of SCLVTX onto the plane */ -/* / / */ -/* / / */ -/* ---------------------------- */ - - - - -/* Find the projection of the direction vector along the plane's */ -/* normal vector. */ - - prjdir = vdot_(udir, normal); - -/* We're done if the ray doesn't point toward the plane. PRJDIF */ -/* has already been found to be non-zero at this point; PRJDIR is */ -/* zero if the ray and plane are parallel. The SPICELIB routine */ -/* SMSGND will return a value of .FALSE. if PRJDIR is zero. */ - - if (! smsgnd_(&prjdir, &prjdif)) { - -/* The ray is parallel to or points away from the plane. */ - - *nxpts = 0; - cleard_(&c__3, xpt); - chkout_("INRYPL", (ftnlen)6); - return 0; - } - -/* The difference XPT - SCLVTX is the hypotenuse of a right triangle */ -/* formed by SCLVTX, XPT, and the orthogonal projection of SCLVTX */ -/* onto the plane. We'll obtain the hypotenuse by scaling UDIR. */ -/* We must make sure that this hypotenuse does not overflow. The */ -/* scale factor has magnitude */ - -/* | PRJDIF | */ -/* -------------- */ -/* | PRJDIR | */ - -/* and UDIR is a unit vector, so as long as */ - -/* | PRJDIF | < | PRJDIR | * TOOBIG */ - -/* the hypotenuse is no longer than TOOBIG. The product can be */ -/* computed safely since PRJDIR has magnitude 1 or less. */ - - if (abs(prjdif) >= abs(prjdir) * toobig) { - -/* If the hypotenuse is too long, we say that no intersection */ -/* exists. */ - - *nxpts = 0; - cleard_(&c__3, xpt); - chkout_("INRYPL", (ftnlen)6); - return 0; - } - -/* We conclude that it's safe to compute XPT. Scale UDIR and add */ -/* the result to SCLVTX. The addition is safe because both addends */ -/* have magnitude no larger than TOOBIG. The vector thus obtained */ -/* is the intersection point. */ - - *nxpts = 1; - scale = abs(prjdif) / abs(prjdir); - vlcom_(&c_b17, sclvtx, &scale, udir, xpt); - -/* Re-scale XPT. This is safe, since TOOBIG has already been */ -/* scaled to allow for any growth of XPT at this step. */ - - vsclip_(&mscale, xpt); - chkout_("INRYPL", (ftnlen)6); - return 0; -} /* inrypl_ */ - diff --git a/ext/spice/src/cspice/inrypl_c.c b/ext/spice/src/cspice/inrypl_c.c deleted file mode 100644 index cb6ebd004e..0000000000 --- a/ext/spice/src/cspice/inrypl_c.c +++ /dev/null @@ -1,838 +0,0 @@ -/* - --Procedure inrypl_c ( Intersection of ray and plane ) - --Abstract - - Find the intersection of a ray and a plane. - --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 - - PLANES - --Keywords - - GEOMETRY - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef inrypl_c - - - void inrypl_c ( ConstSpiceDouble vertex [3], - ConstSpiceDouble dir [3], - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt [3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - vertex, - dir I Vertex and direction vector of ray. - plane I A CSPICE plane. - nxpts O Number of intersection points of ray and plane. - xpt O Intersection point, if nxpts = 1. - --Detailed_Input - - vertex, - dir are a point and direction vector that define a - ray in three-dimensional space. - - plane is a CSPICE plane. - --Detailed_Output - - nxpts is the number of points of intersection of the - input ray and plane. Values and meanings of - nxpts are: - - 0 No intersection. - - 1 One point of intersection. Note that - this case may occur when the ray's - vertex is in the plane. - - -1 An infinite number of points of - intersection; the ray lies in the plane. - - - xpt is the point of intersection of the input ray - and plane, when there is exactly one point of - intersection. - - If the ray lies in the plane, xpt is set equal to - vertex. - - If there is no intersection, xpt is the zero vector. - --Parameters - - None. - --Exceptions - - 1) If the ray's direction vector is the zero vector, the error - SPICE(ZEROVECTOR) is signaled. nxpts and xpt are not - modified. - - - 2) If the ray's vertex is further than dpmax_c() / 3 from the - origin, the error SPICE(VECTORTOOBIG) is signaled. nxpts - and xpt are not modified. - - - 3) If the input plane is s further than dpmax_c() / 3 from the - origin, the error SPICE(VECTORTOOBIG) is signaled. nxpts - and xpt are not modified. - - - 4) The input plane should be created by one of the CSPICE - routines - - nvc2pl_c - pnv2pl_c - psv2pl_c - - Invalid input planes will cause unpredictable results. - - - 5) In the interest of good numerical behavior, in the case - where the ray's vertex is not in the plane, this routine - considers that an intersection of the ray and plane occurs - only if the distance between the ray's vertex and the - intersection point is less than dpmax_c() / 3. - - If vertex is not in the plane and this condition is not - met, then nxpts is set to 0 and xpt is set to the zero - vector. - --Files - - None. - --Particulars - - The intersection of a ray and plane in three-dimensional space - can be a the empty set, a single point, or the ray itself. - --Examples - - 1) Find the camera projection of the center of an extended - body. For simplicity, we assume: - - -- The camera has no distortion; the image of a point - is determined by the intersection of the focal plane - and the line determined by the point and the camera's - focal point. - - -- The camera's pointing matrix (C-matrix) is available - in a C-kernel. - - - /. - Load Leapseconds and SCLK kernels to support time - conversion. - ./ - - furnsh_c ( "leap.ker" ); - furnsh_c ( "sclk.ker" ); - - /. - Load an SPK file containing ephemeris data for - observer (a spacecraft, whose NAIF integer code - is sc) and target at the UTC epoch of observation. - ./ - furnsh_c ( "spk.bsp" ); - - /. - Load a C-kernel containing camera pointing for - the UTC epoch of observation. - ./ - furnsh_c ( "ck.bc" ) ; - - - /. - Find the ephemeris time (barycentric dynamical time) - and encoded spacecraft clock times corresponding to - the UTC epoch of observation. - ./ - utc2et_c ( utc, &et ); - sce2c_c ( sc, et, &sclkdp ); - - /. - Encode the pointing lookup tolerance. - ./ - sctiks_c ( sc, tolch, &toldp ); - - - /. - Find the observer-target vector at the observation - epoch. In this example, we'll use a light-time and stellar - aberration corrected state vector. - ./ - - spkez_c ( target, et, "J2000", "LT+S", sc, state, < ); - - /. - Look up camera pointing. - ./ - ckgp_c ( camera, sclkdp, toldp, "J2000", cmat, &clkout, - &found ); - - if ( !found ) - { - /. - No pointing was available. - ./ - - [Handle this case...] - - return; - } - - /. - Negate the spacecraft-to-target body vector and - convert it to camera coordinates. - ./ - vminus_c ( state, dir ); - mxv_c ( cmat, dir, dir ); - - - /. - If FL is the camera's focal length, the effective - focal point is - - FL * ( 0, 0, 1 ) - ./ - - vscl_c ( FL, zvec, focus ); - - - /. - The camera's focal plane contains the origin in - camera coordinates, and the z-vector is orthogonal - to the plane. Make a CSPICE plane representing - the focal plane. - ./ - nvc2pl_c ( zvec, 0., &fplane ); - - /. - The image of the target body's center in the focal - plane is defined by the intersection with the focal - plane of the ray whose vertex is the focal point and - whose direction is dir. - ./ - - inrypl_c ( focus, dir, fplane, &nxpts, image ); - - if ( nxpts == 1 ) - { - /. - The body center does project to the focal plane. - Check whether the image is actually in the - camera's field of view... - ./ - - [Handle this case...] - } - else - { - /. - The body center does not map to the focal plane. - ./ - - [Handle this case...] - } - - - 2) Find the Saturn ring plane intercept of a spacecraft-mounted - instrument's boresight vector. We want the find the point - in the ring plane that will be observed by an instrument - with a give boresight direction at a specified time. We - must account for light time and stellar aberration in order - to find this point. The intercept point will be expressed - in Saturn body-fixed coordinates. - - -- The ring plane is equatorial. - - -- Light travels in a straight line. - - -- The light time correction for the ring plane intercept - can be obtained by performing three light-time - correction iterations. If this assumption does not - lead to a sufficiently accurate result, additional - iterations can be performed. - - -- A Newtonian approximation of stellar aberration - suffices. - - -- The boresight vector is given in J2000 coordinates. - - -- The observation epoch is et ephemeris seconds past - J2000. - - -- The boresight vector, spacecraft and planetary - ephemerides, and ring plane orientation are all known - with sufficient accuracy for the application. - - -- All necessary kernels are loaded by the caller of - this example routine. - - - (A similar technique could be used to obtain low-accuracy - predictions of radio occultations. In that case, the - instrument boresight ray's direction vector would be replaced - by the vector from the observer to the light-time corrected - radio source position.) - - We omit display of the portion of the code that loads SPICE - kernels. - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void ring_xpt ( ConstSpiceChar * sc, - SpiceDouble et, - ConstSpiceDouble borvec[3], - SpiceDouble * sbfxpt, - SpiceBoolean * found ) - { - - /. - Local constants - ./ - #define SATURN 699 - - /. - Local variables - ./ - SpiceBoolean fnd; - - SpiceDouble borv2 [3]; - SpiceDouble corvec [3]; - SpiceDouble lt; - SpiceDouble satssb [6]; - SpiceDouble scpos [3]; - SpiceDouble scssb [6]; - SpiceDouble state [6]; - SpiceDouble stcorr [3]; - SpiceDouble tau; - SpiceDouble tipm [3][3]; - SpiceDouble xpt [3]; - SpiceDouble zvec [3]; - - SpiceInt i; - SpiceInt nxpts; - SpiceInt scid; - - SpicePlane plane; - - - /. - First step: account for stellar aberration. Since the - instrument pointing is given, we need to find the intercept - point such that, when the stellar aberration correction is - applied to the vector from the spacecraft to that point, - the resulting vector is parallel to borvec. An easy solution - is to apply the inverse of the normal stellar aberration - correction to borvec, and then solve the intercept problem - with this corrected boresight vector. - - Find the position of the observer relative - to the solar system barycenter at et. - ./ - bodn2c_c ( sc, &scid, &fnd ); - - if ( !fnd ) - { - setmsg_c ( "ID code for body # was not found." ); - errch_c ( "#", sc ); - sigerr_c ( "SPICE(NOTRANSLATION" ); - return; - } - - spkssb_c ( scid, et, "j2000", scssb ); - - - /. - We now wish to find the vector corvec that, when corrected for - stellar aberration, yields borvec. A good first approximation is - obtained by applying the stellar aberration correction for - transmission to borvec. Note that the routine called is not - a wrapper, so there is no letter 'c' at the end of its name. - The prototype for this routine is declared in SpiceZfc.h. - ./ - stlabx_ ( (doublereal *) borvec, scssb+3, corvec ); - - /. - The inverse of the stellar aberration correction - applicable to corvec should be a very good estimate of - the correction we need to apply to borvec. Apply - this correction to borvec to obtain an improved estimate - of corvec. - ./ - stelab_c ( corvec, scssb+3, borv2 ); - vsub_c ( borv2, corvec, stcorr ); - vsub_c ( borvec, stcorr, corvec ); - - /. - Because the ring plane intercept may be quite far from - Saturn's center, we cannot assume light time from the intercept - to the observer is well approximated by light time from - Saturn's center to the observer. We compute the light time - explicitly using an iterative approach. - - We can however use the light time from Saturn's center to - the observer to obtain a first estimate of the actual light - time. - ./ - spkezr_c ( "SATURN", et, "J2000", "LT", sc, state, < ); - - tau = lt; - - /. - Find the ring plane intercept and calculate the - light time from it to the spacecraft. - Perform three iterations. - ./ - i = 0; - *found = SPICETRUE; - - while ( ( i < 3 ) && ( *found ) ) - { - /. - Find the position of Saturn relative - to the solar system barycenter at et-tau. - ./ - spkssb_c ( SATURN, et-tau, "J2000", satssb ); - - /. - Find the Saturn-to-observer vector defined by these - two position vectors. - ./ - vsub_c ( scssb, satssb, scpos ); - - /. - Look up Saturn's pole at et-tau; this is the third - row of the matrix that transforms J2000 - coordinates to Saturn body-fixed coordinates. - ./ - pxform_c ( "J2000", "IAU_SATURN", et-tau, tipm ); - - vequ_c ( tipm[2], zvec ); - - /. - Make a CSPICE plane representing the ring plane. - We're treating Saturn's center as the origin, so - the plane constant is 0. - ./ - nvc2pl_c ( zvec, 0.0, &plane ); - - /. - Find the intersection of the ring plane and the - ray having vertex scpos and direction vector - corvec. - ./ - inrypl_c ( scpos, corvec, &plane, &nxpts, xpt ); - - /. - If the number of intersection points is 1, - find the next light time estimate. - ./ - if ( nxpts == 1 ) - { - /. - Find the light time (zero-order) from the - intercept point to the spacecraft. - ./ - tau = vdist_c ( scpos, xpt ) / clight_c(); - i++; - } - else - { - *found = SPICEFALSE; - } - } - /. - At this point, if found is SPICETRUE, we iterated - three times, and xpt is our estimate of the - position of the ring plane intercept point - relative to Saturn in the J2000 frame. This is the - point observed by an instrument pointed in direction - borvec at et at mounted on the spacecraft sc. - - If found is SPICEFALSE, the boresight ray does not - intersect the ring plane. - - As a final step, tranform xpt to Saturn body-fixed - coordinates. - ./ - if ( *found ) - { - mxv_c ( tipm, xpt, sbfxpt ); - } - - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 12-DEC-2002 (NJB) - - Header fix: ring plane intercept algorithm was corrected. - Now light time is computed accurately, and stellar aberration - is accounted for. Example was turned into a complete - subroutine. - - -CSPICE Version 1.0.0, 26-JUN-1999 (NJB) - --Index_Entries - - intersection of ray and plane - --& -*/ - -{ /* Begin inrypl_c */ - - /* - Local constants - */ - - #define MARGIN 3.0 - - - /* - Local macros - */ - #define CLEAR_VEC( v ) (v)[0] = 0.; (v)[1] = 0.; (v)[2] = 0.; - - /* - Local variables - */ - SpiceDouble constant; - SpiceDouble prjdif; - SpiceDouble prjdir; - SpiceDouble prjvn; - SpiceDouble mscale; - SpiceDouble normal [3]; - SpiceDouble scale; - SpiceDouble sclcon; - SpiceDouble sclvtx [3]; - SpiceDouble toobig; - SpiceDouble udir [3]; - - - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return; - } - - chkin_c ( "inrypl_c" ); - - - - /* - We'll give the name toobig to the bound dpmax_c() / MARGIN. - If we let vtxprj be the orthogonal projection of vertex onto - plane, and let diff be the vector vtxprj - vertex, then - we'll ensure that - - || diff || < 2 * toobig - - Check the distance of the ray's vertex from the origin. - */ - - toobig = dpmax_c() / MARGIN; - - if ( vnorm_c (vertex) >= toobig ) - { - setmsg_c ( "Ray's vertex is too far from the origin." ); - sigerr_c ( "SPICE(VECTORTOOBIG)" ); - chkout_c ( "inrypl_c" ); - return; - } - - - /* - Check the distance of the plane from the origin. (The returned - plane constant IS this distance.) - */ - pl2nvc_c ( plane, normal, &constant ); - - if ( constant >= toobig ) - { - setmsg_c ( "Plane is too far from the origin." ); - sigerr_c ( "SPICE(VECTORTOOBIG)" ); - chkout_c ( "inrypl_c" ); - return; - } - - - /* - Check the ray's direction vector. - */ - vhat_c ( dir, udir ); - - if ( vzero_c (udir) ) - { - setmsg_c ( "Ray's direction vector is the zero vector." ); - sigerr_c ( "SPICE(ZEROVECTOR)" ); - chkout_c ( "inrypl_c" ); - return; - } - - - /* - That takes care of the error cases. Now scale the input vertex - and plane to improve numerical behavior. - */ - mscale = MaxAbs ( constant, vnorm_c(vertex) ); - - if ( mscale != 0. ) - { - vscl_c ( 1.0 / mscale, vertex, sclvtx ); - sclcon = constant / mscale; - } - else - { - vequ_c ( vertex, sclvtx ); - sclcon = constant; - } - - - if ( mscale > 1.0 ) - { - toobig = toobig / mscale; - } - - - /* - Find the projection (coefficient) of the ray's vertex along the - plane's normal direction. - */ - - prjvn = vdot_c ( sclvtx, normal ); - - /* - If this projection is the plane constant, the ray's vertex lies in - the plane. We have one intersection or an infinite number of - intersections. It all depends on whether the ray actually lies - in the plane. - - The absolute value of prjdif is the distance of the ray's vertex - from the plane. - */ - - prjdif = sclcon - prjvn; - - if ( prjdif == 0. ) - { - /* - xpt is the original, unscaled vertex. - */ - - vequ_c ( vertex, xpt ); - - if ( vdot_c ( normal, udir ) == 0. ) - { - /* - The ray's in the plane. - */ - - *nxpts = -1; - } - else - { - *nxpts = 1; - } - - chkout_c ( "inrypl_c" ); - return; - } - - - - /* - Ok, the ray's vertex is not in the plane. The ray may still be - parallel to or may point away from the plane. If the ray does - point towards the plane, mathematicians would say that the - ray does intersect the plane, but the computer may disagree. - - For this routine to find an intersection, both of the following - conditions must be met: - - -- The ray must point toward the plane; this happens when - prjdif has the same sign as < udir, normal >. - - -- The vector difference (xpt - sclvtx) must not overflow. - - Qualitatively, the case of interest looks something like the - picture below: - - - * sclvtx - |\ - | \ <-- udir - | \ - length of this | \| - segment is | -* - | - | prjdif | --> | ___________________________ - |/ / - | * / <-- plane - /| xpt / - / ^ / - / | normal / - / | . / - / |/| / - / .---| / / - / | |/ / - / `---* / - / Projection of sclvtx onto the plane - / / - / / - ---------------------------- - - - */ - - - /* - Find the projection of the direction vector along the plane's - normal vector. - */ - - prjdir = vdot_c ( udir, normal ); - - - /* - We're done if the ray doesn't point toward the plane. prjdif - has already been found to be non-zero at this point; prjdir is - zero if the ray and plane are parallel. The CSPICE routine - smsgnd_ will return a value of SPICEFALSE if prjdir is zero. - */ - - if ( ! smsgnd_ (&prjdir, &prjdif) ) - { - /* - The ray is parallel to or points away from the plane. - */ - *nxpts = 0; - - CLEAR_VEC ( xpt ); - - chkout_c ( "inrypl_c" ); - return; - } - - - /* - The difference xpt - sclvtx is the hypotenuse of a right triangle - formed by sclvtx, xpt, and the orthogonal projection of sclvtx - onto the plane. We'll obtain the hypotenuse by scaling udir. - We must make sure that this hypotenuse does not overflow. The - scale factor has magnitude - - | prjdif | - -------------- - | prjdir | - - and UDIR is a unit vector, so as long as - - | prjdif | < | prjdir | * toobig - - the hypotenuse is no longer than toobig. The product can be - computed safely since prjdir has magnitude 1 or less. - */ - - - if ( fabs(prjdif) >= fabs(prjdir) * toobig ) - { - /* - If the hypotenuse is too long, we say that no intersection exists. - */ - *nxpts = 0; - CLEAR_VEC ( xpt ); - - chkout_c ( "inrypl_c" ); - return; - } - - - /* - We conclude that it's safe to compute xpt. Scale udir and add - the result to sclvtx. The addition is safe because both addends - have magnitude no larger than toobig. The vector thus obtained - is the intersection point. - */ - - *nxpts = 1; - scale = fabs (prjdif) / fabs (prjdir); - - vlcom_c ( 1.0, sclvtx, scale, udir, xpt ); - - /* - Re-scale xpt. This is safe, since toobig has already been - scaled to allow for any growth of xpt at this step. - */ - - vscl_c ( mscale, xpt, xpt ); - - - chkout_c ( "inrypl_c" ); - -} /* End inrypl_c */ - diff --git a/ext/spice/src/cspice/inslac.c b/ext/spice/src/cspice/inslac.c deleted file mode 100644 index 1722affc06..0000000000 --- a/ext/spice/src/cspice/inslac.c +++ /dev/null @@ -1,267 +0,0 @@ -/* inslac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSLAC ( Insert at location in a character array ) */ -/* Subroutine */ int inslac_(char *elts, integer *ne, integer *loc, char * - array, integer *na, ftnlen elts_len, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer size, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert one or more elements into a character array at the */ -/* indicated location. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ELTS I Elements to be inserted. */ -/* NE I Number of elements to be inserted. */ -/* LOC I Location of the first inserted element. */ -/* ARRAY I/O Input/output array. */ -/* NA I/O Number of elements in the input/output array. */ - -/* $ Detailed_Input */ - -/* ELTS contains one or more elements which are to be */ -/* inserted into the input array. */ - -/* NE is the number of elements to be inserted. */ - -/* LOC is the location in the array at which the first */ -/* element of ELTS is to be inserted. LOC must be */ -/* within the interval [1, NA+1]. To append to */ -/* ARRAY, set LOC equal to NA+1. */ - -/* ARRAY on input, is the original array. */ - -/* NA on input, is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the original array with the elements */ -/* of ELT inserted into positions LOC through LOC+NE-1. */ -/* The original elements in these positions are moved */ -/* back to make room for the inserted elements. If the */ -/* new elements are longer than the declared lengths */ -/* of the elements of ARRAY, the new elements are */ -/* truncated on the right. */ - -/* NA on output, is the number of elements in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The elements in positions LOC through LOC+NE-1 are moved back */ -/* by NE spaces to make room for the new elements, which are then */ -/* inserted into the vacated spaces. */ - -/* $ Examples */ - -/* Let */ - -/* ELTS(1) = 'very' NA = 4 ARRAY(1) = 'I' */ -/* ELTS(2) = 'big' ARRAY(2) = 'saw' */ -/* ELTS(3) = 'brown' ARRAY(3) = 'a' */ -/* ARRAY(4) = 'dog' */ - -/* Then the call */ - -/* CALL INSLAC ( ELTS, 3, 4, ARRAY, NA ) */ - -/* yields the following result: */ - -/* NA = 7 ARRAY(1) = 'I' */ -/* ARRAY(2) = 'saw' */ -/* ARRAY(3) = 'a' */ -/* ARRAY(4) = 'very' */ -/* ARRAY(5) = 'big' */ -/* ARRAY(6) = 'brown' */ -/* ARRAY(7) = 'dog' */ - - -/* The following calls to INSLAC signal errors. */ - -/* CALL INSLAC ( ELTS, 3, -1, ARRAY, NA ) */ -/* CALL INSLAC ( ELTS, 3, 6, ARRAY, NA ) */ -/* CALL INSLAC ( ELTS, 3, 2, ARRAY, -1 ) */ -/* CALL INSLAC ( ELTS, 3, -1, ARRAY, -1 ) */ - -/* $ Restrictions */ - -/* The array must be large enough to contain both the original */ -/* and the inserted elements. */ - -/* $ Exceptions */ - -/* 1) The dimension of the array is set equal to zero if its */ -/* input value is less than one. */ - -/* 2) If LOC is not in the interval [1, NA+1], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the number of elements to be inserted is less than one, */ -/* the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert at location in a character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 30-DEC-1988 (HAN) */ - -/* If the location at which the elements are to be inserted is */ -/* not in the interval [1, NA+1], an error is signalled. */ -/* Locations not within that interval refer to non-exixtent */ -/* array elements. (To append to the array, the location */ -/* should be equal to NA+1.) */ - -/* A negative dimension bug was fixed. The results of the */ -/* old version were unpredictable if the input array dimension */ -/* was negative. To avoid this problem the maximum of zero and */ -/* the input dimension becomes the dimension used by the */ -/* the routine. In this case, the only valid location at which */ -/* to insert is 1. If it is not 1, an error is signalled */ -/* when the location is checked. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("INSLAC", (ftnlen)6); - } - -/* Check the dimension of the array. */ - - size = max(0,*na); - -/* Make sure the location at which the elements are to be inserted */ -/* is not out of range. If it is, signal an error and bail out. */ - - if (*loc < 1 || *loc > size + 1) { - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("INSLAC", (ftnlen)6); - return 0; - } - -/* If the number of elements to be inserted is greater than zero, */ -/* insert them. If not, do not modify the array. */ - - if (*ne > 0) { - -/* Move the trailing elements back to make room for the new ones. */ - - i__1 = *loc; - for (i__ = size; i__ >= i__1; --i__) { - s_copy(array + (i__ + *ne - 1) * array_len, array + (i__ - 1) * - array_len, array_len, array_len); - } - -/* Now put the new elements in the vacated spaces. */ - - i__1 = *ne; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(array + (*loc + i__ - 2) * array_len, elts + (i__ - 1) * - elts_len, array_len, elts_len); - } - -/* Update the number of elements in the array. */ - - *na = size + *ne; - } - chkout_("INSLAC", (ftnlen)6); - return 0; -} /* inslac_ */ - diff --git a/ext/spice/src/cspice/inslad.c b/ext/spice/src/cspice/inslad.c deleted file mode 100644 index 26437fef3c..0000000000 --- a/ext/spice/src/cspice/inslad.c +++ /dev/null @@ -1,259 +0,0 @@ -/* inslad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSLAD (Insert at location in double precision array) */ -/* Subroutine */ int inslad_(doublereal *elts, integer *ne, integer *loc, - doublereal *array, integer *na) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer size, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert one or more elements into a double precision array at */ -/* the indicated location. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ELTS I Elements to be inserted. */ -/* NE I Number of elements to be inserted. */ -/* LOC I Location of the first inserted element. */ -/* ARRAY I/O Input/output array. */ -/* NA I/O Number of elements in the input/output array. */ - -/* $ Detailed_Input */ - -/* ELTS contains one or more elements which are to be */ -/* inserted into the input array. */ - -/* NE is the number of elements to be inserted. */ - -/* LOC is the location in the array at which the first */ -/* element of ELTS is to be inserted. LOC must be */ -/* within the interval [1, NA+1]. To append to */ -/* ARRAY, set LOC equal to NA+1. */ - -/* ARRAY on input, is the original array. */ - -/* NA on input, is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the original array with the elements */ -/* of ELT inserted into positions LOC through LOC+NE-1. */ -/* The original elements in these positions are moved */ -/* back to make room for the inserted elements. */ - -/* NA on output, is the number of elements in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The elements in positions LOC through LOC+NE-1 are moved back */ -/* by NE spaces to make room for the new elements, which are then */ -/* inserted into the vacated spaces. */ - -/* $ Examples */ - -/* Let */ - -/* ELTS(1) = 5.0D0 NA = 4 ARRAY(1) = 1.0D0 */ -/* ELTS(2) = 6.0D0 ARRAY(2) = 2.0D0 */ -/* ELTS(3) = 7.0D0 ARRAY(3) = 3.0D0 */ -/* ARRAY(4) = 4.0D0 */ - -/* Then the call */ - -/* CALL INSLAD ( ELTS, 3, 3, ARRAY, NA ) */ - -/* yields the following result: */ - -/* NA = 7 ARRAY(1) = 1.0D0 */ -/* ARRAY(2) = 2.0D0 */ -/* ARRAY(3) = 5.0D0 */ -/* ARRAY(4) = 6.0D0 */ -/* ARRAY(5) = 7.0D0 */ -/* ARRAY(6) = 3.0D0 */ -/* ARRAY(7) = 4.0D0 */ - - -/* The following calls to INSLAD signal errors. */ - -/* CALL INSLAD ( ELTS, 3, -1, ARRAY, NA ) */ -/* CALL INSLAD ( ELTS, 3, 6, ARRAY, NA ) */ -/* CALL INSLAD ( ELTS, 3, 2, ARRAY, -1 ) */ -/* CALL INSLAD ( ELTS, 3, -1, ARRAY, -1 ) */ - -/* $ Restrictions */ - -/* The array must be large enough to contain both the original */ -/* and the inserted elements. */ - -/* $ Exceptions */ - -/* 1) The dimension of the array is set equal to zero if its */ -/* input value is less than one. */ - -/* 2) If LOC is not in the interval [1, NA+1], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the number of elements to be inserted is less than one, */ -/* the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert at location in d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 30-DEC-1988 (HAN) */ - -/* If the location at which the elements are to be inserted is */ -/* not in the interval [1, NA+1], an error is signalled. */ -/* Locations not within that interval refer to non-exixtent */ -/* array elements. (To append to the array, the location */ -/* should be equal to NA+1.) */ - -/* A negative dimension bug was fixed. The results of the */ -/* old version were unpredictable if the input array dimension */ -/* was negative. To avoid this problem the maximum of zero and */ -/* the input dimension becomes the dimension used by the */ -/* the routine. In this case, the only valid location at which */ -/* to insert is 1. If it is not 1, an error is signalled */ -/* when the location is checked. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("INSLAD", (ftnlen)6); - } - -/* Check the dimension of the array. */ - - size = max(0,*na); - -/* Make sure the location at which the elements are to be inserted */ -/* is not out of range. If it is, signal an error and bail out. */ - - if (*loc < 1 || *loc > size + 1) { - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("INSLAD", (ftnlen)6); - return 0; - } - -/* If the number of elements to be inserted is greater than zero, */ -/* insert them. If not, do not modify the array. */ - - if (*ne > 0) { - -/* Move the trailing elements back to make room for the new ones. */ - - i__1 = *loc; - for (i__ = size; i__ >= i__1; --i__) { - array[i__ + *ne - 1] = array[i__ - 1]; - } - -/* Now put the new elements in the vacated spaces. */ - - i__1 = *ne; - for (i__ = 1; i__ <= i__1; ++i__) { - array[*loc + i__ - 2] = elts[i__ - 1]; - } - -/* Update the number of elements in the array. */ - - *na = size + *ne; - } - chkout_("INSLAD", (ftnlen)6); - return 0; -} /* inslad_ */ - diff --git a/ext/spice/src/cspice/inslai.c b/ext/spice/src/cspice/inslai.c deleted file mode 100644 index ec64abd0c3..0000000000 --- a/ext/spice/src/cspice/inslai.c +++ /dev/null @@ -1,259 +0,0 @@ -/* inslai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSLAI (Insert at location in an integer array) */ -/* Subroutine */ int inslai_(integer *elts, integer *ne, integer *loc, - integer *array, integer *na) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer size, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert one or more elements into an integer array at */ -/* the indicated location. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ELTS I Elements to be inserted. */ -/* NE I Number of elements to be inserted. */ -/* LOC I Location of the first inserted element. */ -/* ARRAY I/O Input/output array. */ -/* NA I/O Number of elements in the input/output array. */ - -/* $ Detailed_Input */ - -/* ELTS contains one or more elements which are to be */ -/* inserted into the input array. */ - -/* NE is the number of elements to be inserted. */ - -/* LOC is the location in the array at which the first */ -/* element of ELTS is to be inserted. LOC must be */ -/* within the interval [1, NA+1]. To append to */ -/* ARRAY, set LOC equal to NA+1. */ - -/* ARRAY on input, is the original array. */ - -/* NA on input, is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the original array with the elements */ -/* of ELT inserted into positions LOC through LOC+NE-1. */ -/* The original elements in these positions are moved */ -/* back to make room for the inserted elements. */ - -/* NA on output, is the number of elements in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The elements in positions LOC through LOC+NE-1 are moved back */ -/* by NE spaces to make room for the new elements, which are then */ -/* inserted into the vacated spaces. */ - -/* $ Examples */ - -/* Let */ - -/* ELTS(1) = 5 NA = 4 ARRAY(1) = 1 */ -/* ELTS(2) = 6 ARRAY(2) = 2 */ -/* ELTS(3) = 7 ARRAY(3) = 3 */ -/* ARRAY(4) = 4 */ - -/* Then the call */ - -/* CALL INSLAI ( ELTS, 3, 3, ARRAY, NA ) */ - -/* yields the following result: */ - -/* NA = 7 ARRAY(1) = 1 */ -/* ARRAY(2) = 2 */ -/* ARRAY(3) = 5 */ -/* ARRAY(4) = 6 */ -/* ARRAY(5) = 7 */ -/* ARRAY(6) = 3 */ -/* ARRAY(7) = 4 */ - - -/* The following calls to INSLAI signal errors. */ - -/* CALL INSLAI ( ELTS, 3, -1, ARRAY, NA ) */ -/* CALL INSLAI ( ELTS, 3, 6, ARRAY, NA ) */ -/* CALL INSLAI ( ELTS, 3, 2, ARRAY, -1 ) */ -/* CALL INSLAI ( ELTS, 3, -1, ARRAY, -1 ) */ - -/* $ Restrictions */ - -/* The array must be large enough to contain both the original */ -/* and the inserted elements. */ - -/* $ Exceptions */ - -/* 1) The dimension of the array is set equal to zero if its */ -/* input value is less than one. */ - -/* 2) If LOC is not in the interval [1, NA+1], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the number of elements to be inserted is less than one, */ -/* the array is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert at location in an integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 30-DEC-1988 (HAN) */ - -/* If the location at which the elements are to be inserted is */ -/* not in the interval [1, NA+1], an error is signalled. */ -/* Locations not within that interval refer to non-exixtent */ -/* array elements. (To append to the array, the location */ -/* should be equal to NA+1.) */ - -/* A negative dimension bug was fixed. The results of the */ -/* old version were unpredictable if the input array dimension */ -/* was negative. To avoid this problem the maximum of zero and */ -/* the input dimension becomes the dimension used by the */ -/* the routine. In this case, the only valid location at which */ -/* to insert is 1. If it is not 1, an error is signalled */ -/* when the location is checked. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("INSLAI", (ftnlen)6); - } - -/* Check the dimension of the array. */ - - size = max(0,*na); - -/* Make sure the location at which the elements are to be inserted */ -/* is not out of range. If it is, signal an error and bail out. */ - - if (*loc < 1 || *loc > size + 1) { - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("INSLAI", (ftnlen)6); - return 0; - } - -/* If the number of elements to be inserted is greater than zero, */ -/* insert them. If not, do not modify the array. */ - - if (*ne > 0) { - -/* Move the trailing elements back to make room for the new ones. */ - - i__1 = *loc; - for (i__ = size; i__ >= i__1; --i__) { - array[i__ + *ne - 1] = array[i__ - 1]; - } - -/* Now put the new elements in the vacated spaces. */ - - i__1 = *ne; - for (i__ = 1; i__ <= i__1; ++i__) { - array[*loc + i__ - 2] = elts[i__ - 1]; - } - -/* Update the number of elements in the array. */ - - *na = size + *ne; - } - chkout_("INSLAI", (ftnlen)6); - return 0; -} /* inslai_ */ - diff --git a/ext/spice/src/cspice/insrtc.c b/ext/spice/src/cspice/insrtc.c deleted file mode 100644 index b86749e6db..0000000000 --- a/ext/spice/src/cspice/insrtc.c +++ /dev/null @@ -1,270 +0,0 @@ -/* insrtc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSRTC ( Insert an item into a character set ) */ -/* Subroutine */ int insrtc_(char *item, char *a, ftnlen item_len, ftnlen - a_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer card, slen, last, size, i__; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - logical in; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert an item into a character set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be inserted. */ -/* A I/O Insertion set. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which is to be inserted into the */ -/* specified set. ITEM may or may not already be an */ -/* element of the set. If ITEM is longer than the */ -/* length SLEN of the elements of A, only the substring */ -/* consisting of the first SLEN characters of ITEM will */ -/* be inserted into the set; any trailing non-blank */ -/* characters in ITEM are ignored. */ - - -/* A is a set. */ - -/* On input, A may or may not contain the input item */ -/* as an element. */ - -/* $ Detailed_Output */ - -/* A on output contains the union of the input set and */ -/* the singleton set containing the input item, unless */ -/* there was not sufficient room in the set for the */ -/* item to be included, in which case the set is not */ -/* changed and an error is signaled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the insertion of the item into the set causes an excess */ -/* of elements, the error SPICE(SETEXCESS) is signaled. */ - -/* 2) If the item to be inserted has greater length than the string */ -/* length of the elements of the set, the item will be truncated */ -/* on the right when it is inserted. The insertion point of */ -/* the element will be determined by the comparison of the */ -/* truncated item to members of the set. If, after truncation, */ -/* the item to be inserted matches an element already present */ -/* in the set, no insertion occurs. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 'PLUTO' is removed from */ -/* the character set PLANETS and inserted into the character set */ -/* ASTEROIDS. */ - -/* CALL REMOVC ( 'PLUTO', PLANETS ) */ -/* CALL INSRTC ( 'PLUTO', ASTEROIDS ) */ - -/* If 'PLUTO' is not an element of PLANETS, then the contents of */ -/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */ -/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */ - -/* Because inserting an element into a set can increase the */ -/* cardinality of the set, an error may occur in the insertion */ -/* routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */ - -/* Bug fix: when the item to be inserted would, after */ -/* truncation to the set's string length, match an item */ -/* already in the set, no insertion is performed. Previously */ -/* the truncated string was inserted, corrupting the set. */ - -/* Long error message was updated to include size of */ -/* set into which insertion was attempted. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert an item into a character set */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */ - -/* Bug fix: when the item to be inserted would, after */ -/* truncation to the set's string length, match an item */ -/* already in the set, no insertion is performed. Previously */ -/* the truncated string was inserted, corrupting the set. */ - -/* Long error message was updated to include size of */ -/* set into which insertion was attempted. */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("INSRTC", (ftnlen)6); - -/* What are the size and cardinality of the set? */ - - size = sizec_(a, a_len); - card = cardc_(a, a_len); - -/* When we insert an item into the set, any trailing characters */ -/* that don't fit are truncated. So in deciding where to insert */ -/* the item, we ignore any characters that won't remain after */ -/* insertion. */ - -/* We're going to consider only the initial substring of ITEM */ -/* whose length doesn't exceed the string length of the set's */ -/* members. */ - -/* Computing MIN */ - i__1 = i_len(item, item_len), i__2 = i_len(a + a_len * 6, a_len); - slen = min(i__1,i__2); - -/* Find the last element of the set which would come before the */ -/* input item. This will be the item itself, if it is already an */ -/* element of the set. */ - - last = lstlec_(item, &card, a + a_len * 6, slen, a_len); - -/* Is the item already in the set? If not, it needs to be inserted. */ - - if (last > 0) { - in = s_cmp(a + (last + 5) * a_len, item, a_len, slen) == 0; - } else { - in = FALSE_; - } - if (! in) { - -/* If there is room in the set for the new element, then move */ -/* the succeeding elements back to make room. And update the */ -/* cardinality for future reference. */ - - if (card < size) { - i__1 = last + 1; - for (i__ = card; i__ >= i__1; --i__) { - s_copy(a + (i__ + 6) * a_len, a + (i__ + 5) * a_len, a_len, - a_len); - } - s_copy(a + (last + 6) * a_len, item, a_len, slen); - i__1 = card + 1; - scardc_(&i__1, a, a_len); - } else { - setmsg_("An element could not be inserted into the set due to la" - "ck of space; set size is #.", (ftnlen)82); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - } - chkout_("INSRTC", (ftnlen)6); - return 0; -} /* insrtc_ */ - diff --git a/ext/spice/src/cspice/insrtc_c.c b/ext/spice/src/cspice/insrtc_c.c deleted file mode 100644 index cde781fa8e..0000000000 --- a/ext/spice/src/cspice/insrtc_c.c +++ /dev/null @@ -1,307 +0,0 @@ -/* - --Procedure insrtc_c ( Insert an item into a character set ) - --Abstract - - Insert an item into a character set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - -#include "SpiceUsr.h" -#include "SpiceZfc.h" -#include "SpiceZmc.h" -#include "f2cMang.h" - - - void insrtc_c ( ConstSpiceChar * item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be inserted. - set I/O Insertion set. - --Detailed_Input - - item is an item which is to be inserted into the specified - set. item may or may not already be an element of the - set. Trailing blanks in item are not significant. - - - set is a CSPICE set. set must be declared as a character - SpiceCell. - - On input, set may or may not contain the input item - as an element. - --Detailed_Output - - set on output contains the union of the input set and - the singleton set containing the input item. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - character, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the insertion of the element into the set causes an excess - of elements, the error SPICE(SETEXCESS) is signaled. - - 3) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - - 4) If the input string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following example, the element "PLUTO" is removed from - the character set planets and inserted into the character set - asteroids. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( asteroids, MAXSIZ, NAMLEN ); - . - . - . - removc_c ( "PLUTO", &planets ); - insrtc_c ( "PLUTO", &asteroids ); - - - If "PLUTO" is not an element of planets, then the contents of - planets are not changed. Similarly, if "PLUTO" is already an - element of asteroids, the contents of asteroids remain unchanged. - - Because inserting an element into a set can increase the - cardinality of the set, an error may occur in the insertion - routines. - --Restrictions - - 1) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input set 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) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 2.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 2.0.0, 01-NOV-2005 (NJB) - - Bug fix: when the item to be inserted would, after - truncation to the set's string length, match an item - already in the set, no insertion is performed. Previously - the truncated string was inserted, corrupting the set. - - Long error message was updated to include size of - set into which insertion was attempted. - - -CSPICE Version 1.0.0, 21-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - insert an item into a character set - --& -*/ -{ - /* - f2c library utility prototypes - */ - extern integer s_cmp (char *a, char *b, ftnlen la, ftnlen lb ); - - - /* - Local macros - */ - #define ARRAY( i ) ( (SpiceChar *)(set->data) + (i)*(set->length) ) - - - /* - local variables - */ - SpiceBoolean inSet; - - SpiceChar * cdata; - - SpiceInt i; - SpiceInt loc; - SpiceInt slen; - - - - /* - Use discovery check-in. - - Check the input string pointer to make sure it's not null. - */ - CHKPTR ( CHK_DISCOVER, "insrtc_c", item ); - - - /* - Make sure we're working with a character cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "insrtc_c", SPICE_CHR, set ); - - - /* - Make sure the input cell is a set. - */ - CELLISSETCHK ( CHK_DISCOVER, "insrtc_c", set ); - - - /* - Initialize the set if it's not already initialized. - */ - CELLINIT ( set ); - - - /* - Let slen be the effective string length of the input item. - Characters beyond the string length of the set are ignored. - */ - slen = mini_c ( 2, set->length, strlen(item) ); - - - /* - Is the item already in the set? If not, it needs to be inserted. - */ - cdata = (SpiceChar *) (set->data); - - /* - The following call will give the location of the last element - less than or equal to the item to be inserted. If the item - differs from an element of the set only in characters that would - be truncated, no insertion will occur. Even in this case, the - insertion point `loc' returned by lstlec_c will be correct. - */ - loc = lstlec_c ( item, set->card, set->length, cdata ); - - inSet = ( loc > -1 ) - - && ( s_cmp( (SpiceChar *)item, ARRAY(loc), - slen, strlen(ARRAY(loc)) ) == 0 ); - - if ( inSet ) - { - return; - } - - - /* - It's an error if the set has no room left. - */ - if ( set->card == set->size ) - { - chkin_c ( "insrtc_c" ); - setmsg_c ( "An element could not be inserted into the set " - "due to lack of space; set size is #." ); - errint_c ( "#", set->size ); - sigerr_c ( "SPICE(SETEXCESS)" ); - chkout_c ( "insrtc_c" ); - return; - } - - - /* - Make room by moving the items that come after index loc in the set. - Insert the item after index loc. - */ - for ( i = (set->card); i > (loc+1); i-- ) - { - SPICE_CELL_SET_C( ARRAY(i-1), i, set ); - } - - /* - This insertion macro will truncate the item to be inserted, if - necessary. The input item will be null-terminated. - */ - SPICE_CELL_SET_C( item, loc+1, set ); - - - /* - Increment the set's cardinality. - */ - (set->card) ++; - -} - diff --git a/ext/spice/src/cspice/insrtd.c b/ext/spice/src/cspice/insrtd.c deleted file mode 100644 index c7c78e0099..0000000000 --- a/ext/spice/src/cspice/insrtd.c +++ /dev/null @@ -1,236 +0,0 @@ -/* insrtd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSRTD ( Insert an item into a double precision set ) */ -/* Subroutine */ int insrtd_(doublereal *item, doublereal *a) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, last, size, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sized_(doublereal *); - logical in; - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern integer lstled_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert an item into a double precision set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS */ -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be inserted. */ -/* A I/O Insertion set. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which is to be inserted into the */ -/* specified set. ITEM may or may not already */ -/* be an element of the set. */ - - -/* A is a set. */ - -/* On input, A may or may not contain the input item */ -/* as an element. */ - -/* $ Detailed_Output */ - -/* A on output contains the union of the input set and */ -/* the singleton set containing the input item, unless */ -/* there was not sufficient room in the set for the */ -/* item to be included, in which case the set is not */ -/* changed and an error is signaled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the insertion of the element into the set causes an excess */ -/* of elements, the error SPICE(SETEXCESS) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 'PLUTO' is removed from */ -/* the character set PLANETS and inserted into the character set */ -/* ASTEROIDS. */ - -/* CALL REMOVC ( 'PLUTO', PLANETS ) */ -/* CALL INSRTC ( 'PLUTO', ASTEROIDS ) */ - -/* If 'PLUTO' is not an element of PLANETS, then the contents of */ -/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */ -/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */ - -/* Because inserting an element into a set can increase the */ -/* cardinality of the set, an error may occur in the insertion */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */ - -/* Code was modified slightly to keep logical structure parallel */ -/* to that of INSRTC. */ - -/* Long error message was updated to include size of */ -/* set into which insertion was attempted. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert an item into a d.p. set */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */ - -/* Code was modified slightly to keep logical structure parallel */ -/* to that of INSRTC. */ - -/* Long error message was updated to include size of set into */ -/* which insertion was attempted. */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("INSRTD", (ftnlen)6); - -/* What are the size and cardinality of the set? */ - - size = sized_(a); - card = cardd_(a); - -/* Find the last element of the set which would come before the */ -/* input item. This will be the item itself, if it is already an */ -/* element of the set. */ - - last = lstled_(item, &card, &a[6]); - -/* Is the item already in the set? If not, it needs to be inserted. */ - - if (last > 0) { - in = a[last + 5] == *item; - } else { - in = FALSE_; - } - if (! in) { - -/* If there is room in the set for the new element, then move */ -/* the succeeding elements back to make room. And update the */ -/* cardinality for future reference. */ - - if (card < size) { - i__1 = last + 1; - for (i__ = card; i__ >= i__1; --i__) { - a[i__ + 6] = a[i__ + 5]; - } - a[last + 6] = *item; - i__1 = card + 1; - scardd_(&i__1, a); - } else { - setmsg_("An element could not be inserted into the set due to la" - "ck of space; set size is #.", (ftnlen)82); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - } - chkout_("INSRTD", (ftnlen)6); - return 0; -} /* insrtd_ */ - diff --git a/ext/spice/src/cspice/insrtd_c.c b/ext/spice/src/cspice/insrtd_c.c deleted file mode 100644 index ca51b983ff..0000000000 --- a/ext/spice/src/cspice/insrtd_c.c +++ /dev/null @@ -1,261 +0,0 @@ -/* - --Procedure insrtd_c ( Insert an item into a double precision set ) - --Abstract - - Insert an item into a double precision set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - -#include "SpiceUsr.h" -#include "SpiceZfc.h" -#include "SpiceZmc.h" - - - void insrtd_c ( SpiceDouble item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be inserted. - set I/O Insertion set. - --Detailed_Input - - item is an item which is to be inserted into the - specified set. item may or may not already - be an element of the set. - - - set is a CSPICE set. set must be declared as a double - precision SpiceCell. - - On input, set may or may not contain the input item - as an element. - --Detailed_Output - - set on output contains the union of the input set and - the singleton set containing the input item. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - double precision, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the insertion of the element into the set causes an excess - of elements, the error SPICE(SETEXCESS) is signaled. - - 3) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following code fragment, a list of camera exposure - durations are taken from the array expList and inserted into the - set expDur. - - - #include "SpiceUsr.h" - . - . - . - /. - The number of list items is NLIST. - ./ - SpiceDouble expList[NLIST] = - { - 0.5, 2.0, 0.5, 30.0, 0.01, 30.0 - }; - - /. - Declare the set with maximum number of elements MAXSIZ. - ./ - SPICEDOUBLE_CELL ( expDur, MAXSIZ ); - . - . - . - for ( i = 0; i < NLIST; i++ ) - { - insrtd_c ( expList[i], &expDur ); - } - - /. - At this point expDur contains the set - - { 0.01, 0.5, 2.0, 30.0 } - - ./ - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 2.0.0, 01-NOV-2005 (NJB) - - Long error message was updated to include size of - set into which insertion was attempted. - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - insert an item into a d.p. set - --& -*/ -{ - /* - local variables - */ - SpiceBoolean inSet; - - SpiceDouble * ddata; - - SpiceInt i; - SpiceInt loc; - - - /* - Use discovery check-in. - */ - - /* - Make sure we're working with a double precision cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "insrtd_c", SPICE_DP, set ); - - ddata = (SpiceDouble *) (set->data); - - /* - Make sure the input cell is a set. - */ - CELLISSETCHK ( CHK_DISCOVER, "insrtd_c", set ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - - /* - Is the item already in the set? If not, it needs to be inserted. - */ - loc = lstled_c ( item, set->card, ddata ); - - inSet = ( loc > -1 ) && ( item == ddata[loc] ); - - if ( inSet ) - { - return; - } - - - /* - It's an error if the set has no room left. - */ - - if ( set->card == set->size ) - { - chkin_c ( "insrtd_c" ); - setmsg_c ( "An element could not be inserted into the set " - "due to lack of space; set size is #." ); - errint_c ( "#", set->size ); - sigerr_c ( "SPICE(SETEXCESS)" ); - chkout_c ( "insrtd_c" ); - return; - } - - - /* - Make room by moving the items that come after index loc in the set. - Insert the item after index loc. - */ - - for ( i = (set->card); i > loc+1; i-- ) - { - ddata[i] = ddata[i-1]; - } - - ddata[loc+1] = item; - - - /* - Increment the set's cardinality. - */ - (set->card) ++; - - - /* - Sync the set. - */ - zzsynccl_c ( C2F, set ); -} - diff --git a/ext/spice/src/cspice/insrti.c b/ext/spice/src/cspice/insrti.c deleted file mode 100644 index fc0d10d829..0000000000 --- a/ext/spice/src/cspice/insrti.c +++ /dev/null @@ -1,236 +0,0 @@ -/* insrti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSRTI ( Insert an item into an integer set ) */ -/* Subroutine */ int insrti_(integer *item, integer *a) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, last, size, i__; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - logical in; - extern /* Subroutine */ int scardi_(integer *, integer *), sigerr_(char *, - ftnlen); - extern integer lstlei_(integer *, integer *, integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert an item into an integer set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be inserted. */ -/* A I/O Insertion set. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which is to be inserted into the */ -/* specified set. ITEM may or may not already */ -/* be an element of the set. */ - - -/* A is a set. */ - - -/* On input, A may or may not contain the input item */ -/* as an element. */ - -/* $ Detailed_Output */ - -/* A on output contains the union of the input set and */ -/* the singleton set containing the input item, unless */ -/* there was not sufficient room in the set for the */ -/* item to be included, in which case the set is not */ -/* changed and an error is returned. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the insertion of the element into the set causes an excess */ -/* of elements, the error SPICE(SETEXCESS) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 'PLUTO' is removed from */ -/* the character set PLANETS and inserted into the character set */ -/* ASTEROIDS. */ - -/* CALL REMOVC ( 'PLUTO', PLANETS ) */ -/* CALL INSRTC ( 'PLUTO', ASTEROIDS ) */ - -/* If 'PLUTO' is not an element of PLANETS, then the contents of */ -/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */ -/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */ - -/* Because inserting an element into a set can increase the */ -/* cardinality of the set, an error may occur in the insertion */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */ - -/* Code was modified slightly to keep logical structure parallel */ -/* to that of INSRTC. */ - -/* Long error message was updated to include size of */ -/* set into which insertion was attempted. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert an item into an integer set */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */ - -/* Code was modified slightly to keep logical structure parallel */ -/* to that of INSRTC. */ - -/* Long error message was updated to include size of set into */ -/* which insertion was attempted. */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("INSRTI", (ftnlen)6); - -/* What are the size and cardinality of the set? */ - - size = sizei_(a); - card = cardi_(a); - -/* Find the last element of the set which would come before the */ -/* input item. This will be the item itself, if it is already an */ -/* element of the set. */ - - last = lstlei_(item, &card, &a[6]); - -/* Is the item already in the set? If not, it needs to be inserted. */ - - if (last > 0) { - in = a[last + 5] == *item; - } else { - in = FALSE_; - } - if (! in) { - -/* If there is room in the set for the new element, then move */ -/* the succeeding elements back to make room. And update the */ -/* cardinality for future reference. */ - - if (card < size) { - i__1 = last + 1; - for (i__ = card; i__ >= i__1; --i__) { - a[i__ + 6] = a[i__ + 5]; - } - a[last + 6] = *item; - i__1 = card + 1; - scardi_(&i__1, a); - } else { - setmsg_("An element could not be inserted into the set due to la" - "ck of space; set size is #.", (ftnlen)82); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - } - chkout_("INSRTI", (ftnlen)6); - return 0; -} /* insrti_ */ - diff --git a/ext/spice/src/cspice/insrti_c.c b/ext/spice/src/cspice/insrti_c.c deleted file mode 100644 index 5b45c5aa9f..0000000000 --- a/ext/spice/src/cspice/insrti_c.c +++ /dev/null @@ -1,242 +0,0 @@ -/* - --Procedure insrti_c ( Insert an item into an integer set ) - --Abstract - - Insert an item into an integer set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - -#include "SpiceUsr.h" -#include "SpiceZfc.h" -#include "SpiceZmc.h" - - - void insrti_c ( SpiceInt item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be inserted. - set I/O Insertion set. - --Detailed_Input - - item is an item which is to be inserted into the - specified set. item may or may not already - be an element of the set. - - - set is a CSPICE set. set must be declared as an integer - SpiceCell. - - On input, set may or may not contain the input item - as an element. - --Detailed_Output - - set on output contains the union of the input set and - the singleton set containing the input item. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - integer, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the insertion of the element into the set causes an excess - of elements, the error SPICE(SETEXCESS) is signaled. - - 3) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following example, the NAIF ID code of Pluto is removed from - the integer set planets and inserted into the integer set - asteroids. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( planets, MAXSIZ ); - SPICEINT_CELL ( asteroids, MAXSIZ ); - . - . - . - removi_c ( 999, &planets ); - insrti_c ( 999, &asteroids ); - - - If 999 is not an element of planets, then the contents of - planets are not changed. Similarly, if 999 is already an - element of asteroids, the contents of asteroids remain unchanged. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 2.0.0, 01-NOV-2005 (NJB) - - Long error message was updated to include size of - set into which insertion was attempted. - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - insert an item into an integer set - --& -*/ -{ - /* - local variables - */ - SpiceBoolean inSet; - - SpiceInt i; - SpiceInt * idata; - SpiceInt loc; - - - /* - Use discovery check-in. - */ - - /* - Make sure we're working with an integer cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "insrti_c", SPICE_INT, set ); - - idata = (SpiceInt *) (set->data); - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK ( CHK_DISCOVER, "insrti_c", set ); - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - /* - Is the item already in the set? If not, it needs to be inserted. - */ - loc = lstlei_c ( item, set->card, idata ); - - inSet = ( loc > -1 ) && ( item == idata[loc] ); - - if ( inSet ) - { - return; - } - - /* - It's an error if the set has no room left. - */ - if ( set->card == set->size ) - { - chkin_c ( "insrti_c" ); - setmsg_c ( "An element could not be inserted into the set " - "due to lack of space; set size is #." ); - errint_c ( "#", set->size ); - sigerr_c ( "SPICE(SETEXCESS)" ); - chkout_c ( "insrti_c" ); - return; - } - - /* - Make room by moving the items that come after item in the set. - Insert the item after index loc. - */ - - for ( i = (set->card); i > loc+1; i-- ) - { - idata[i] = idata[i-1]; - } - - idata[loc+1] = item; - - /* - Increment the set's cardinality. - */ - (set->card) ++; - - /* - Sync the set. - */ - zzsynccl_c ( C2F, set ); -} - - - diff --git a/ext/spice/src/cspice/inssub.c b/ext/spice/src/cspice/inssub.c deleted file mode 100644 index e246ebed9b..0000000000 --- a/ext/spice/src/cspice/inssub.c +++ /dev/null @@ -1,303 +0,0 @@ -/* inssub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INSSUB ( Insert a substring ) */ -/* Subroutine */ int inssub_(char *in, char *sub, integer *loc, char *out, - ftnlen in_len, ftnlen sub_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical same; - integer from, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer inlen, nmove, to, subend, sublen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer outlen; - char chr[1]; - -/* $ Abstract */ - -/* Insert a substring into a character string at a specified */ -/* location. */ - -/* $ 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 */ - -/* ASSIGNMENT */ -/* CHARACTER */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* SUB I Substring to be inserted. */ -/* LOC I Position at which substring is to be inserted. */ -/* OUT O Output string. */ - -/* $ Detailed_Input */ - -/* IN is an input character string, into which a substring */ -/* is to be inserted. */ - -/* SUB is the substring to be inserted. Leading and trailing */ -/* blanks are significant. */ - -/* LOC is the position in the input string at which the */ -/* substring is to be inserted. To append to the */ -/* string, set LOC equal to LEN(IN) + 1. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is equivalent to the */ -/* string that would be created by the concatenation */ - -/* OUT = IN(1:LOC-1) // SUB // IN(LOC: ) */ - -/* If the output string is too long, it is truncated */ -/* on the right. */ - -/* OUT may overwrite IN. OUT may NOT overwrite SUB. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If LOC is not in the interval [1, LEN(IN)+1], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Shift the end of the input string, beginning with LOC, to the */ -/* right, leaving space for the substring. Then insert the substring */ -/* into the vacated space in the middle of the string. This has */ -/* the same effect as the concatenation */ - -/* OUT = IN(1:LOC-1) // SUB // IN(LOC: ) */ - -/* Because this operation is not standard for strings of length (*), */ -/* this routine does not use concatenation. */ - -/* $ Examples */ - -/* The following examples illustrate the use of INSSUB. */ - -/* IN SUB LOC OUT */ -/* ----------------- ------- --- ------------------------ */ -/* 'ABCDEFGHIJ' ' YXZ ' 3 'AB XYZ CDEFGHIJ' */ -/* 'The rabbit' 'best ' 5 'The best rabbit' */ -/* ' other woman' 'The' 1 'The other woman' */ -/* 'An Apple a day' ' keeps' 15 'An Apple a day keeps' */ -/* 'Apple a day' 'An ' 0 An error is signalled. */ -/* 'Apple a day' 'An ' -3 An error is signalled. */ -/* 'An Apple a day' ' keeps' 16 An error is signalled. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 24-OCT-1994 (NJB) */ - -/* Bug fixes made. Now does discovery check-in. Header sections */ -/* re-arranged. Some clean-up of header format done. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert a substring */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 24-OCT-1994 (NJB) */ - -/* Bug fix: case where insertion location follows end of */ -/* input string is now handled correctly. Formerly, an */ -/* out-of-range substring bound violation was incurred in this */ -/* case. */ - -/* Bug fix: use of SHIFTC routine in old implementation */ -/* resulted in output string being truncated at length */ -/* LEN(IN), which is not consistent with the routine's */ -/* specification. */ - -/* Now does discovery check-in. Header sections re-arranged. */ -/* Some clean-up of header format done. */ - -/* - Beta Version 2.0.0, 4-JAN-1989 (HAN) */ - -/* If the location at which the substring is to be inserted is */ -/* not in the interval [1, LEN(IN)+1], an error is signalled. */ -/* Locations not within that interval refer to non-existent */ -/* characters positions. (To append to the string, set the */ -/* location equal to LEN(IN)+1.) */ - -/* -& */ - -/* Local Variables */ - - -/* Discovery check-in is used in this routine. */ - -/* Note to the careful reader: in order to scrupulously avoid */ -/* non-standard assignments of characters from a substring of IN to */ -/* an overlapping substring of OUT, in the case where IN and OUT */ -/* refer to the same memory, we'll test whether the output and */ -/* input strings are the same. If they're the same, we can avoid */ -/* various assignments that could cause trouble if IN and OUT */ -/* actually refer to the same memory. This test has little effect on */ -/* performance, and allows the author to sleep more soundly at night. */ - -/* Capture the lengths of the input, output, and substitution */ -/* strings. */ - - inlen = i_len(in, in_len); - outlen = i_len(out, out_len); - sublen = i_len(sub, sub_len); - -/* If insertion occurs before the beginning of the string */ -/* or after INLEN + 1, signal an error. */ - - if (*loc < 1 || *loc > inlen + 1) { - chkin_("INSSUB", (ftnlen)6); - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("INSSUB", (ftnlen)6); - return 0; - } - -/* If the insertion occurs after the end of the output string, */ -/* just return the original string. Don't do the assignment if */ -/* the output and input strings have equal values; the assignment */ -/* is not needed in this cause and could cause a run-time error if */ -/* OUT and IN refer to the same memory. */ - - same = s_cmp(out, in, out_len, in_len) == 0; - if (*loc > outlen) { - if (! same) { - s_copy(out, in, out_len, in_len); - } - return 0; - } - -/* At this point, we're guaranteed that */ - -/* LOC < OUTLEN */ -/* - */ - -/* LOC < INLEN + 1 */ -/* - */ - -/* LOC > 0 */ - - -/* The first part of the input string is copied without change */ -/* to the output string, if this first part is non-empty. */ - - if (*loc > 1) { - -/* Again, do the assignment only if it's required. */ - - if (! same) { - s_copy(out, in, *loc - 1, in_len); - } - } - -/* The part following the new substring is shifted into place, if */ -/* there's both something to move and a place to put it. Move the */ -/* rightmost characters first. */ - - subend = *loc - 1 + sublen; - if (*loc <= inlen && subend < outlen) { -/* Computing MIN */ - i__1 = outlen - subend, i__2 = inlen - *loc + 1; - nmove = min(i__1,i__2); - for (i__ = nmove; i__ >= 1; --i__) { - from = *loc + i__ - 1; - to = subend + i__; - *(unsigned char *)chr = *(unsigned char *)&in[from - 1]; - *(unsigned char *)&out[to - 1] = *(unsigned char *)chr; - } - } - -/* And the new word is dropped into the middle. */ - - s_copy(out + (*loc - 1), sub, min(subend,outlen) - (*loc - 1), sub_len); - -/* Blank-pad the output string if necessary. */ - - if (outlen > inlen + sublen) { - i__1 = inlen + sublen; - s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1); - } - return 0; -} /* inssub_ */ - diff --git a/ext/spice/src/cspice/int2hx.c b/ext/spice/src/cspice/int2hx.c deleted file mode 100644 index 6c06971793..0000000000 --- a/ext/spice/src/cspice/int2hx.c +++ /dev/null @@ -1,334 +0,0 @@ -/* int2hx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INT2HX ( Integer to signed hexadecimal string ) */ -/* Subroutine */ int int2hx_(integer *number, char *string, integer *length, - ftnlen string_len) -{ - /* Initialized data */ - - static char digits[1*16] = "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" - "B" "C" "D" "E" "F"; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer begin, itemp, remndr, result; - char tmpstr[255]; - -/* $ Abstract */ - -/* Convert an integer to an equivalent signed hexadecimal 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Integer to be converted. */ -/* STRING O Equivalent hexadecimal string, left justified. */ -/* LENGTH O The length of the hexadecimal string produced. */ - -/* $ Detailed_Input */ - -/* NUMBER The integer to be converted. */ - -/* $ Detailed_Output */ - -/* STRING The signed hexadecimal string representing the integer */ -/* NUMBER. */ - -/* The following table describes the character set used */ -/* to represent the hexadecimal digits and their */ -/* corresponding values. */ - -/* Character Value Character Value */ -/* --------- ----- --------- ----- */ -/* '0' 0 '8' 8 */ -/* '1' 1 '9' 9 */ -/* '2' 2 'A' 10 */ -/* '3' 3 'B' 11 */ -/* '4' 4 'C' 12 */ -/* '5' 5 'D' 13 */ -/* '6' 6 'E' 14 */ -/* '7' 7 'F' 15 */ - -/* In order to obtain the entire signed hexadecimal number, */ -/* the output character string should be at least N */ -/* characters long, where */ - -/* # of bits per integer + 3 */ -/* N = 1 + ---------------------------- . */ -/* 4 */ - -/* There should be 1 character position for the sign, and */ -/* one character position for each hexadecimal digit that */ -/* could be produced from any integer which can be */ -/* represented by a particular computer system. */ - -/* The following table contains minimum output string */ -/* lengths necessary to obtain the complete hexadecimal */ -/* string for various integer sizes. */ - -/* Integer size in bits Minimum output length */ -/* -------------------- --------------------- */ -/* 8 3 */ -/* 16 5 */ -/* 32 9 */ -/* 36 (really,it exists) 10 */ -/* 64 17 */ -/* etc. */ - -/* The hexadecimal character string produced by this */ -/* routine will be left justified and consist of a */ -/* contiguous sequence of hexadecimal digits, or in the */ -/* case of a negative number, a contiguous sequence of */ -/* hexadecimal digits immediately preceded by a minus */ -/* sign, '-', e.g.: */ - -/* (1) h h ... h */ -/* 1 2 n */ - -/* (2) -h h ... h */ -/* 1 2 n */ - -/* where h represents an hexadecimal digit. */ -/* i */ - -/* The character string produced will be blank padded on */ -/* the right if LENGTH < LEN( STRING ). */ - -/* LENGTH The length of the hexadecimal character string produced */ -/* by the conversion. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the output character string is not long enough to */ -/* contain the entire hexadecimal string that was produced, */ -/* the hexadecimal string will be truncated on the right. */ - -/* 2) If LEN( STRING ) > LENGTH, the output character string will */ -/* be blank padded on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will convert a signed integer into an equivalent */ -/* signed hexadecimal character string. This provides a machine */ -/* independent mechanism for storing or porting integer values. */ -/* This routine is used by the routine DP2HX which converts a */ -/* double precision value into an equivalent character string. */ - -/* This routine is one of a pair of routines which are used to */ -/* perform conversions between integers and equivalent signed */ -/* hexadecimal character strings: */ - -/* INT2HX -- Convert an integer into a signed hexadecimal */ -/* character string. */ - -/* HX2INT -- Convert a signed hexadecimal character string */ -/* into an integer. */ - -/* $ Examples */ - -/* All of the values shown are for a two's complement representation */ -/* for signed integers. */ - -/* The following input and output argument values illustrate the */ -/* action of INT2HX for various input values of NUMBER. */ - -/* NUMBER STRING LENGTH */ -/* ----------- --------------- ------ */ -/* 1 '1' 1 */ -/* -1 '-1' 2 */ -/* 223 'DF' 2 */ -/* -32 '-20' 3 */ -/* 0 '0' 1 */ - -/* 2147483647 '7FFFFFFF' 8 */ -/* (Maximum 32 bit integer) */ - -/* -2147483647 '-7FFFFFFF' 9 */ -/* (Minimum 32 bit integer + 1) */ - -/* -2147483648 '-80000000' 9 */ -/* (Minimum 32 bit integer) */ - -/* $ Restrictions */ - -/* The maximum number of characters permitted in the output string */ -/* is specified by the local parameter STRLEN. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 22-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert integer to signed hexadecimal string */ - -/* -& */ - -/* Local Parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Local variables */ - - -/* The hexadecimal digits in the integer are found by repeated */ -/* applications of the "modulus" and division operations. We fill */ -/* the string in reverse order so that the digits are in the */ -/* correct order when we have finished building the string. We then */ -/* left justify the resulting string and set the value for its */ -/* length before returning. */ - -/* Make a copy of the input so that it will not be changed by this */ -/* routine. */ - - itemp = *number; - -/* We need to do different things for the cases where the integer to */ -/* be converted is positive, negative, or zero. ( Actually, the */ -/* positive case and the zero case are the same, but since we can */ -/* test for integer zero exactly it will save a few arithmetic */ -/* operations if we treat it as a special case. ) The case for a */ -/* negative integer is the only one which truly might cause problems, */ -/* because ABS(minimum integer) may equal ABS(maximum integer) + 1, */ -/* on some machines. For example, on many machines with 32 bit */ -/* integers, INTMIN = -2147483648 and INTMAX = 2147483647. */ - -/* Set the beginning position of the hexadecimal number to be */ -/* one past the end of the character string that will hold the */ -/* hexadecimal representation of the input number. Before each */ -/* digit of the hexadecimal number is inserted into the character */ -/* string, the beginning position is decremented, so we always know */ -/* exactly where the hexadecimal string begins. This simplifies the */ -/* calculation of the length of the hexadecimal character string at */ -/* the end of the routine. */ - - begin = 256; - if (itemp < 0) { - -/* Collect all of the digits in the string. We know we're done */ -/* when the value of ITEMP is equal to zero, thanks to the fact */ -/* that integer arithmetic operations are exact. */ - - while(itemp != 0) { - --begin; - result = itemp / 16; - remndr = (result << 4) - itemp; - itemp = result; - *(unsigned char *)&tmpstr[begin - 1] = *(unsigned char *)&digits[( - i__1 = remndr) < 16 && 0 <= i__1 ? i__1 : s_rnge("digits", - i__1, "int2hx_", (ftnlen)301)]; - } - -/* Put the minus sign in place. */ - - --begin; - *(unsigned char *)&tmpstr[begin - 1] = '-'; - } else if (itemp > 0) { - -/* Collect all of the digits in the string. We know we're done */ -/* when the value of ITEMP is equal to zero, thanks to the fact */ -/* that integer arithmetic operations are exact. */ - - while(itemp != 0) { - --begin; - result = itemp / 16; - remndr = itemp - (result << 4); - itemp = result; - *(unsigned char *)&tmpstr[begin - 1] = *(unsigned char *)&digits[( - i__1 = remndr) < 16 && 0 <= i__1 ? i__1 : s_rnge("digits", - i__1, "int2hx_", (ftnlen)322)]; - } - } else { - -/* Treat zero as a special case, because it's easier. */ - - --begin; - *(unsigned char *)&tmpstr[begin - 1] = *(unsigned char *)&digits[0]; - } - -/* Set the value of the output string before returning. Let the */ -/* Fortran string assignment deal with the left justification, and */ -/* the truncation on the right if the output string STRING is not */ -/* long enough to contain all of the characters in the string */ -/* that was produced. */ - - s_copy(string, tmpstr + (begin - 1), string_len, 255 - (begin - 1)); - -/* Also, set the value for the length of the hexadecimal string */ -/* before returning. */ - - *length = 255 - begin + 1; - return 0; -} /* int2hx_ */ - diff --git a/ext/spice/src/cspice/inter_c.c b/ext/spice/src/cspice/inter_c.c deleted file mode 100644 index 54bb1c813c..0000000000 --- a/ext/spice/src/cspice/inter_c.c +++ /dev/null @@ -1,350 +0,0 @@ -/* - --Procedure inter_c ( Intersection of two sets ) - --Abstract - - Intersect two sets of any data type to form a third set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void inter_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I First input set. - b I Second input set. - c O Intersection of a and b. - --Detailed_Input - - a is a CSPICE set. a must be declared as a SpiceCell - of data type character, double precision, or integer. - - b is a CSPICE set, distinct from a. b must have the - same data type as a. - --Detailed_Output - - c is a CSPICE set, distinct from sets a and b, which - contains the intersection of a and b (that is, all of - the elements which are in a AND b). c must have the - same data type as a and b. - - When comparing elements of character sets, this routine - ignores trailing blanks. Trailing blanks will be - trimmed from the members of the output set c. - --Parameters - - None. - --Exceptions - - 1) If the input set arguments don't have identical data types, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the intersection of the two sets contains more elements than - can be contained in the output set, the error SPICE(SETEXCESS) is - signaled. - - 3) If the set arguments have character type and the length of the - elements of the output set is less than the maximum of the - lengths of the elements of the input sets, the error - SPICE(ELEMENTSTOOSHORT) is signaled. - - 4) If any of the arguments may be unordered or contain - duplicates, the error SPICE(NOTASET) is signaled. - --Files - - None. - --Particulars - - This is a generic CSPICE set routine; it operates on sets of any - supported data type. - - The intersection of two sets contains every element - which is in the first set and in the second set. - - {a,b} intersect {c,d} = {} - {a,b,c} {b,c,d} {b,c} - {a,b,c,d} {} {} - {} {a,b,c,d} {} - --Examples - - 1) The following code fragment places the intersection of the character - sets planets and asteroids into the character set result. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( asteroids, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( result, MAXSIZ, NAMLEN ); - . - . - . - /. - Compute the intersection. - ./ - inter_c ( &planets, &asteroids, &result ); - - - 2) Repeat example #1, this time using integer sets containing - ID codes of the bodies of interest. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( planets, MAXSIZ ); - SPICEINT_CELL ( asteroids, MAXSIZ ); - SPICEINT_CELL ( result, MAXSIZ ); - . - . - . - /. - Compute the intersection. - ./ - inter_c ( &planets, &asteroids, &result ); - - --Restrictions - - 1) The output set must be distinct from both of the input sets. - For example, the following calls are invalid. - - inter_c ( ¤t, &new, ¤t ); - inter_c ( &new, ¤t, ¤t ); - - In each of the examples above, whether or not the subroutine - signals an error, the results will almost certainly be wrong. - Nearly the same effect can be achieved, however, by placing the - result into a temporary set, which is immediately copied back - into one of the input sets, as shown below. - - inter_c ( ¤t, &new, &temp ); - copy_c ( &temp, &new ); - - - 2) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input sets 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) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 15-FEB-2005 (NJB) - - Bug fix: loop bound changed from 2 to 3 in loop used - to free dynamically allocated arrays. - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - intersection of two sets - --& -*/ - - -{ - /* - Local variables - */ - SpiceChar * fCell[3]; - - SpiceInt fLen [3]; - SpiceInt i; - - - /* - Standard SPICE error handling. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "inter_c" ); - - /* - Make sure data types match. - */ - CELLMATCH3 ( CHK_STANDARD, "inter_c", a, b, c ); - - /* - Make sure the input cells are sets. - */ - CELLISSETCHK2 ( CHK_STANDARD, "inter_c", a, b ); - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - /* - Call the intersection routine appropriate for the data type of the - cells. - */ - if ( a->dtype == SPICE_CHR ) - { - - /* - Construct Fortran-style sets suitable for passing to interc_. - */ - C2F_MAP_CELL3 ( "", - a, fCell, fLen, - b, fCell+1, fLen+1, - c, fCell+2, fLen+2 ); - - if ( failed_c() ) - { - chkout_c ( "inter_c" ); - return; - } - - interc_ ( (char * ) fCell[0], - (char * ) fCell[1], - (char * ) fCell[2], - (ftnlen ) fLen[0], - (ftnlen ) fLen[1], - (ftnlen ) fLen[2] ); - - /* - Map the intersection back to a C style cell. - */ - F2C_MAP_CELL ( fCell[2], fLen[2], c ); - - - /* - We're done with the dynamically allocated Fortran-style arrays. - */ - for ( i = 0; i < 3; i++ ) - { - free ( fCell[i] ); - } - - } - - else if ( a->dtype == SPICE_DP ) - { - interd_ ( (doublereal * ) (a->base), - (doublereal * ) (b->base), - (doublereal * ) (c->base) ); - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - } - - else if ( a->dtype == SPICE_INT ) - { - interi_ ( (integer * ) (a->base), - (integer * ) (b->base), - (integer * ) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - } - - else - { - setmsg_c ( "Cell a contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (a->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "inter_c" ); - return; - } - - - /* - Indicate the result is a set. - */ - c->isSet = SPICETRUE; - - - chkout_c ( "inter_c" ); - -} /* End inter_c */ diff --git a/ext/spice/src/cspice/interc.c b/ext/spice/src/cspice/interc.c deleted file mode 100644 index 2752522b38..0000000000 --- a/ext/spice/src/cspice/interc.c +++ /dev/null @@ -1,297 +0,0 @@ -/* interc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INTERC ( Intersect two character sets ) */ -/* Subroutine */ int interc_(char *a, char *b, char *c__, ftnlen a_len, - ftnlen b_len, ftnlen c_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer over, acard, bcard; - extern integer cardc_(char *, ftnlen); - integer ccard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - integer csize; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - integer apoint, bpoint; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), excess_(integer *, char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Intersect two character sets to form a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Intersection of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the intersection of A and B (that is, */ -/* all of the elements which are in A, AND in B). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the intersection of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The INTERSECTION of two sets contains every element */ -/* which is in the first set AND in the second set. */ - -/* {a,b} intersect {c,d} = {} */ -/* {a,b,c} {b,c,d} {b,c} */ -/* {a,b,c,d} {} {} */ -/* {} {a,b,c,d} {} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL INTERC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the intersection of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL INTERI ( CURRENT, NEW, CURRENT ) */ -/* CALL INTERI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL INTERI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the intersection of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* 2) If length of the elements of the output set is < the */ -/* maximum of the lengths of the elements of the input */ -/* sets, the error SPICE(ELEMENTSTOOSHORT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Fixed call to CHKOUT to be consistent with CHKIN. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersect two character sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 05-JAN-1989 (NJB) */ - -/* Error signalled if output set elements are not long enough. */ -/* Length must be at least max of lengths of input elements. */ -/* Also, calling protocol for EXCESS has been changed. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("INTERC", (ftnlen)6); - -/* Make sure output set elements are long enough. */ - -/* Computing MAX */ - i__1 = i_len(a, a_len), i__2 = i_len(b, b_len); - if (i_len(c__, c_len) < max(i__1,i__2)) { - setmsg_("Length of output cell is #. Length required to contain res" - "ult is #.", (ftnlen)68); - i__1 = i_len(c__, c_len); - errint_("#", &i__1, (ftnlen)1); -/* Computing MAX */ - i__2 = i_len(a, a_len), i__3 = i_len(b, b_len); - i__1 = max(i__2,i__3); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(ELEMENTSTOOSHORT)", (ftnlen)23); - chkout_("INTERC", (ftnlen)6); - return 0; - } -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardc_(a, a_len); - bcard = cardc_(b, b_len); - csize = sizec_(c__, c_len); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of either input set is reached, we're done. */ - - while(apoint <= acard && bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * b_len, - a_len, b_len) == 0) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++apoint; - } else if (l_lt(b + (bpoint + 5) * b_len, a + (apoint + 5) * - a_len, b_len, a_len)) { - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * b_len, - a_len, b_len) == 0) { - ++over; - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++apoint; - } else if (l_lt(b + (bpoint + 5) * b_len, a + (apoint + 5) * - a_len, b_len, a_len)) { - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardc_(&ccard, c__, c_len); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("INTERC", (ftnlen)6); - return 0; -} /* interc_ */ - diff --git a/ext/spice/src/cspice/interd.c b/ext/spice/src/cspice/interd.c deleted file mode 100644 index 32cc292a84..0000000000 --- a/ext/spice/src/cspice/interd.c +++ /dev/null @@ -1,252 +0,0 @@ -/* interd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INTERD ( Intersect two double precision sets ) */ -/* Subroutine */ int interd_(doublereal *a, doublereal *b, doublereal *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Intersect two double precision sets to form a third set. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Intersection of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the intersection of A and B (that is, */ -/* all of the elements which are in A, AND in B). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the intersection of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The INTERSECTION of two sets contains every element */ -/* which is in the first set AND in the second set. */ - -/* {a,b} intersect {c,d} = {} */ -/* {a,b,c} {b,c,d} {b,c} */ -/* {a,b,c,d} {} {} */ -/* {} {a,b,c,d} {} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL INTERC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the intersection of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL INTERI ( CURRENT, NEW, CURRENT ) */ -/* CALL INTERI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL INTERI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the intersection of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersect two d.p. sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("INTERD", (ftnlen)6); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of either input set is reached, we're done. */ - - while(apoint <= acard && bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (a[apoint + 5] == b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - -/* Otherwise, stop folling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (a[apoint + 5] == b[bpoint + 5]) { - ++over; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardd_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("INTERD", (ftnlen)6); - return 0; -} /* interd_ */ - diff --git a/ext/spice/src/cspice/interi.c b/ext/spice/src/cspice/interi.c deleted file mode 100644 index 380ccf86c3..0000000000 --- a/ext/spice/src/cspice/interi.c +++ /dev/null @@ -1,252 +0,0 @@ -/* interi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INTERI ( Intersect two integer sets ) */ -/* Subroutine */ int interi_(integer *a, integer *b, integer *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Intersect two integer sets to form a third set. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Intersection of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the intersection of A and B (that is, */ -/* all of the elements which are in A, AND in B). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the intersection of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The INTERSECTION of two sets contains every element */ -/* which is in the first set AND in the second set. */ - -/* {a,b} intersect {c,d} = {} */ -/* {a,b,c} {b,c,d} {b,c} */ -/* {a,b,c,d} {} {} */ -/* {} {a,b,c,d} {} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL INTERC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the intersection of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL INTERI ( CURRENT, NEW, CURRENT ) */ -/* CALL INTERI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL INTERI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the intersection of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersect two integer sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("INTERI", (ftnlen)6); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardi_(a); - bcard = cardi_(b); - csize = sizei_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of either input set is reached, we're done. */ - - while(apoint <= acard && bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (a[apoint + 5] == b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - -/* Otherwise, stop folling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (a[apoint + 5] == b[bpoint + 5]) { - ++over; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardi_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("INTERI", (ftnlen)6); - return 0; -} /* interi_ */ - diff --git a/ext/spice/src/cspice/intmax.c b/ext/spice/src/cspice/intmax.c deleted file mode 100644 index b2e9b44d89..0000000000 --- a/ext/spice/src/cspice/intmax.c +++ /dev/null @@ -1,255 +0,0 @@ -/* - --Procedure intmax_ ( Largest integer number ) - --Abstract - - Return the value of the largest positive number representable - in a variable of type "integer." - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceInt intmax_ () - -/* - --Brief_I/O - - The function returns the value of the largest positive number - that can be represented in a variable of type "integer." - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the largest positive number - that can be represented in an "integer" variable, where integer - is a typedef defined in f2c.h. The typedef SpiceInt always maps - to the same type as does the f2c typedef integer. - - The returned value will be greater than or equal to 2147483647. - See the Particulars section for details. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This function replaces that produced by running f2c on the Fortran - SPICELIB file intmax.f. - - When translating Fortran code, f2c maps Fortran variables of type - INTEGER to C variables of type "integer," where integer is a typedef - defined in the f2c header file f2c.h. On all supported platforms, - Fortran INTEGERS occupy at least 32 bits. On most platforms, this - means that the typedef integer translates to type long. There are - some exceptional platforms on which an integer translates to type - int. The mapping must provide compatibility with the f2c typedef - doublereal: integers must occupy half the storage of doublereals in - order for these types to correctly represent the Fortran types - INTEGER and DOUBLE PRECISION. - - On systems where the typedef integer maps to type long, the return - value is defined by the macro LONG_MAX from the ANSI standard header - file limits.h. According to the ANSI standard, LONG_MAX must be at - least - - 2147483647 - - This is - - 31 - 2 - 1 - - On systems where the typedef integer maps to type int, the value is - defined by the macro INT_MAX from the ANSI standard header file - limits.h. According to the ANSI standard, INT_MAX must be at least - - 32767 - - This is - - 15 - 2 - 1 - - In practice however, the typedef integer will map to type int only - if ints occupy at least four bytes, so the value of INT_MAX will - actually be at least 2147483647. - - --Examples - - The following code fragment illustrates the use of intmax_. - - /. - Separate a double into integer and fractional components. - If the integer component is out of range, avoid overflow - by making it as large as possible. - ./ - #include - . - . - . - fract = modf ( dvalue, &integralDP ); - - if ( integralDP > (double)intmax_() ) - { - ivalue = intmax_(); - } - else if ( integralDP < (double)intmin_() ) - { - ivalue = intmin_(); - } - else - { - ivalue = (long)( integralDP ); - } - - --Restrictions - - 1) This routine should not be called from within users' applications. - Instead, use intmax_c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - B.V. Semenov (JPL) - M.J. Spencer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - PC-64BIT-MS_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_PC_64BIT_MS - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 2.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 1.2.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 1.1.0, 29-JAN-1999 (NJB) - - Updated to select INT_MAX or LONG_MAX depending on the - host environment. - - -CSPICE Version 1.0.0, 16-OCT-1998 (NJB) - --Index_Entries - - largest integer number - --& -*/ - -{ /* Begin intmax_ */ - - #ifdef CSPICE_ALPHA_DIGITAL_UNIX - - return ( INT_MAX ); - - #elif defined( CSPICE_PC_LINUX_64BIT_GCC ) - - return ( INT_MAX ); - - #elif defined( CSPICE_SUN_SOLARIS_64BIT_GCC ) - - return ( INT_MAX ); - - #elif defined( CSPICE_MAC_OSX_INTEL_64BIT_GCC ) - - return ( INT_MAX ); - - #elif defined( CSPICE_PC_64BIT_MS ) - - return ( INT_MAX ); - - #elif defined( CSPICE_SUN_SOLARIS_64BIT_NATIVE ) - - return ( INT_MAX ); - - #elif defined( CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) - - return ( INT_MAX ); - - #else - - return ( LONG_MAX ); - - #endif - - -} /* End intmax_ */ - diff --git a/ext/spice/src/cspice/intmax_c.c b/ext/spice/src/cspice/intmax_c.c deleted file mode 100644 index bc2dfc8804..0000000000 --- a/ext/spice/src/cspice/intmax_c.c +++ /dev/null @@ -1,209 +0,0 @@ -/* - --Procedure intmax_c ( Largest integer number ) - --Abstract - - Return the value of the largest (positive) number representable - in a SpiceInt variable. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceInt intmax_c () - -/* - --Brief_I/O - - The function returns the value of the largest (positive) number - that can be represented in a SpiceInt variable. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the largest (positive) number - that can be represented in an SpiceInt variable, where SpiceInt - is a typedef defined in SpiceZdf.h. - - The returned value will be greater than or equal to 2147483647. - See the Particulars section for details. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The typedef SpiceInt is used throughout the CSPICE API to refer to - integers; the precise type of integer is platform-dependent. A - SpiceInt always maps to the same type as does the f2c typedef - integer. - - When translating Fortran code, f2c maps Fortran variables of type - INTEGER to C variables of type "integer," where integer is a typedef - defined in the f2c header file f2c.h. On all supported platforms, - Fortran INTEGERS occupy at least 32 bits. On most platforms, this - means that the typedef integer translates to type long. There are - some exceptional platforms on which an integer translates to type - int. The mapping must provide compatibility with the f2c typedef - doublereal: integers must occupy half the storage of doublereals in - order for these types to correctly represent the Fortran types - INTEGER and DOUBLE PRECISION. - - On systems where the typedef integer maps to type long, the return - value is defined by the macro LONG_MAX from the ANSI standard header - file limits.h. According to the ANSI standard, LONG_MAX must be at - least - - 2147483647 - - This is - - 31 - 2 - 1 - - On systems where the typedef integer maps to type int, the value is - defined by the macro INT_MAX from the ANSI standard header file - limits.h. According to the ANSI standard, INT_MAX must be at least - - 32767 - - This is - - 15 - 2 - 1 - - In practice however, the typedef integer will map to type int only - if ints occupy at least four bytes, so the value of INT_MAX will - actually be at least 2147483647. - - --Examples - - The following code fragment illustrates the use of intmax_c. - - /. - Separate a double into integer and fractional components. - If the integer component is out of range, avoid overflow - by making it as large as possible. - ./ - #include - . - . - . - fract = modf ( dvalue, &integralDP ); - - if ( integralDP > (double)intmax_c() ) - { - ivalue = intmax_c(); - } - else if ( integralDP < (double)intmin_c() ) - { - ivalue = intmin_c(); - } - else - { - ivalue = (long)( integralDP ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 29-JAN-1999 (NJB) - - Header has been updated to describe in more detail the - choice of return value, and the dependency of the value on the - host environment. - - -CSPICE Version 1.0.0, 16-OCT-1998 (NJB) - --Index_Entries - - largest integer number - --& -*/ - -{ /* Begin intmax_c */ - - - /* - Static variables - */ - - static SpiceBoolean first = SPICETRUE; - static SpiceInt value; - - - - if ( first ) - { - value = intmax_(); - first = SPICEFALSE; - } - - return ( value ); - - -} /* End intmax_c */ - diff --git a/ext/spice/src/cspice/intmin.c b/ext/spice/src/cspice/intmin.c deleted file mode 100644 index c145dcddb9..0000000000 --- a/ext/spice/src/cspice/intmin.c +++ /dev/null @@ -1,257 +0,0 @@ -/* - --Procedure intmin_ ( Smallest integer number ) - --Abstract - - Return the value of the smallest (negative) number representable - in a variable of type "integer." - --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 - - CONSTANTS - -*/ - #include - #include "SpiceUsr.h" - - SpiceInt intmin_ () - -/* - --Brief_I/O - - The function returns the value of the smallest (negative) number - that can be represented in a variable of type "integer." - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the smallest negative number - (negative number of largest magnitude) that can be represented in an - "integer" variable, where integer is a typedef defined in f2c.h. The - typedef SpiceInt always maps to the same type as does the f2c typedef - integer. - - The returned value will be less than or equal to -2147483647. - See the Particulars section for details. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This function replaces that produced by running f2c on the Fortran - SPICELIB file intmin.f. - - When translating Fortran code, f2c maps Fortran variables of type - INTEGER to C variables of type "integer," where integer is a typedef - defined in the f2c header file f2c.h. On all supported platforms, - Fortran INTEGERS occupy at least 32 bits. On most platforms, this - means that the typedef integer translates to type long. There are - some exceptional platforms on which an integer translates to type - int. The mapping must provide compatibility with the f2c typedef - doublereal: integers must occupy half the storage of doublereals in - order for these types to correctly represent the Fortran types - INTEGER and DOUBLE PRECISION. - - On systems where the typedef integer maps to type long, the return - value is defined by the macro LONG_MIN from the ANSI standard header - file limits.h. According to the ANSI standard, LONG_MIN must be no - greater than - - -2147483647 - - This is - - 31 - - ( 2 - 1 ) - - On systems where the typedef integer maps to type int, the value is - defined by the macro INT_MIN from the ANSI standard header file - limits.h. According to the ANSI standard, INT_MIN must be no greater - than - - -32767 - - This is - - 15 - -( 2 - 1 ) - - In practice however, the typedef integer will map to type int only - if ints occupy at least four bytes, so the value of INT_MIN will - actually be no greater than -2147483647. - - --Examples - - The following code fragment illustrates the use of intmin_. - - /. - Separate a double into integer and fractional components. - If the integer component is out of range, avoid overflow - by making it as large as possible. - ./ - #include - . - . - . - fract = modf ( dvalue, &integralDP ); - - if ( integralDP > (double)intmax_() ) - { - ivalue = intmax_(); - } - else if ( integralDP < (double)intmin_() ) - { - ivalue = intmin_(); - } - else - { - ivalue = (long)( integralDP ); - } - - --Restrictions - - 1) This routine should not be called from within users' applications. - Instead, use intmin_c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - B.V. Semenov (JPL) - M.J. Spencer (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - PC-64BIT-MS_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_PC_64BIT_MS - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 2.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 1.2.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 1.1.0, 29-JAN-1999 (NJB) - - Updated to select INT_MIN or LONG_MIN depending on the - host environment. - - -CSPICE Version 1.0.0, 19-OCT-1998 (NJB) - --Index_Entries - - smallest integer number - --& -*/ - -{ /* Begin intmin_ */ - - - #ifdef CSPICE_ALPHA_DIGITAL_UNIX - - return ( INT_MIN ); - - #elif defined( CSPICE_PC_LINUX_64BIT_GCC ) - - return ( INT_MIN ); - - #elif defined( CSPICE_SUN_SOLARIS_64BIT_GCC ) - - return ( INT_MIN ); - - #elif defined( CSPICE_MAC_OSX_INTEL_64BIT_GCC ) - - return ( INT_MIN ); - - #elif defined( CSPICE_PC_64BIT_MS ) - - return ( INT_MIN ); - - #elif defined( CSPICE_SUN_SOLARIS_64BIT_NATIVE ) - - return ( INT_MIN ); - - #elif defined( CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) - - return ( INT_MIN ); - - #else - - return ( LONG_MIN ); - - #endif - - -} /* End intmin_ */ - diff --git a/ext/spice/src/cspice/intmin_c.c b/ext/spice/src/cspice/intmin_c.c deleted file mode 100644 index 350136c41b..0000000000 --- a/ext/spice/src/cspice/intmin_c.c +++ /dev/null @@ -1,204 +0,0 @@ -/* - --Procedure intmin_c ( Smallest integer number ) - --Abstract - - Return the value of the smallest (negative) number representable - in a SpiceInt variable. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceInt intmin_c () - -/* - --Brief_I/O - - The function returns the value of the smallest (negative) number - that can be represented in a SpiceInt variable. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of the smallest (negative) number - that can be represented in an SpiceInt variable, where SpiceInt - is a typedef defined in SpiceZdf.h. - - The returned value will be less than or equal to -2147483647. - See the Particulars section for details. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The typedef SpiceInt is used throughout the CSPICE API to refer to - integers; the precise type of integer is platform-dependent. A - SpiceInt always maps to the same type as does the f2c typedef - integer. - - When translating Fortran code, f2c maps Fortran variables of type - INTEGER to C variables of type "integer," where integer is a typedef - defined in the f2c header file f2c.h. On all supported platforms, - Fortran INTEGERS occupy at least 32 bits. On most platforms, this - means that the typedef integer translates to type long. There are - some exceptional platforms on which an integer translates to type - int. The mapping must provide compatibility with the f2c typedef - doublereal: integers must occupy half the storage of doublereals in - order for these types to correctly represent the Fortran types - INTEGER and DOUBLE PRECISION. - - On systems where the typedef integer maps to type long, the return - value is defined by the macro LONG_MIN from the ANSI standard header - file limits.h. According to the ANSI standard, LONG_MIN must be no - greater than - - -2147483647 - - This is - - 31 - - ( 2 - 1 ) - - On systems where the typedef integer maps to type int, the value is - defined by the macro INT_MIN from the ANSI standard header file - limits.h. According to the ANSI standard, INT_MIN must be no greater - than - - -32767 - - This is - - 15 - -( 2 - 1 ) - - In practice however, the typedef integer will map to type int only - if ints occupy at least four bytes, so the value of INT_MIN will - actually be no greater than -2147483647. - - --Examples - - The following code fragment illustrates the use of intmin_c. - - /. - Separate a double into integer and fractional components. - If the integer component is out of range, avoid overflow - by making it as large as possible. - ./ - #include - . - . - . - fract = modf ( dvalue, &integralDP ); - - if ( integralDP > (double)intmax_c() ) - { - ivalue = intmax_c(); - } - else if ( integralDP < (double)intmin_c() ) - { - ivalue = intmin_c(); - } - else - { - ivalue = (long)( integralDP ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JAN-1999 (NJB) - --Index_Entries - - smallest integer number - --& -*/ - -{ /* Begin intmin_c */ - - - /* - Static variables - */ - - static SpiceBoolean first = SPICETRUE; - static SpiceInt value; - - - - if ( first ) - { - value = intmin_(); - first = SPICEFALSE; - } - - return ( value ); - - -} /* End intmin_c */ - diff --git a/ext/spice/src/cspice/intord.c b/ext/spice/src/cspice/intord.c deleted file mode 100644 index 6e10cf1357..0000000000 --- a/ext/spice/src/cspice/intord.c +++ /dev/null @@ -1,229 +0,0 @@ -/* intord.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure INTORD ( Convert an integer to ordinal text ) */ -/* Subroutine */ int intord_(integer *n, char *string, ftnlen string_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, i__; - char mystr[148]; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen), inttxt_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Convert an integer to an equivalent written ordinal phrase. */ -/* For example, convert 121 to 'ONE HUNDRED TWENTY-FIRST'. */ - -/* $ 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 */ - -/* CONVERSION */ -/* PARSING */ -/* STRING */ -/* UNITS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I An integer (less than 10**12 in absolute value). */ -/* STRING O An English string representing the ordinal of N. */ - -/* $ Detailed_Input */ - -/* N is an integer (less than 10**12 in absolute value). */ -/* Moreover, if N is less than zero, -N must be a */ -/* a legitimate number on the host machine. */ - -/* In the context of this routine N represents the */ -/* ranking of some item within a group. */ - - -/* $ Detailed_Output */ - -/* STRING is the English ordinal equivalent of N. STRING will */ -/* contain only upper case letters. */ - -/* $ Parameters */ - -/* MAXORD is one more than the length of the longest ordinal */ -/* string that can be produced by a call to this routine: */ -/* One string of maximum length is: */ - -/* 'NEGATIVE ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN BILLION ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN MILLION ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN THOUSAND ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVENTH' */ - -/* It has 147 characters. */ - -/* The parameter MAXORD is used to declare a local string */ -/* of sufficient length to allow the construction of */ -/* any ordinal string. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the resulting ordinal is longer than the output string, */ -/* it will be truncated on the right, leaving only the most */ -/* significant portion of the ordinal. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is used primarily for generating error messages. For example, */ -/* if the third letter or token in a string is in error, it might */ -/* be desirable to supply a message like the following: */ - -/* 'The third token of 31-JAN-198$ is not a valid year.' */ - -/* $ Examples */ - -/* N STRING */ -/* ------ ------------------------------------------- */ -/* -6 NEGATIVE SIXTH */ -/* 1 FIRST */ -/* 2 SECOND */ -/* 3 THIRD */ -/* 4 FOURTH */ -/* 20 TWENTIETH */ -/* 21 TWENTY-FIRST */ -/* 99 NINETY-NINTH */ -/* 82131 EIGHTY-TWO THOUSAND ONE HUNDRED THIRTY-FIRST */ - -/* $ Restrictions */ - -/* 1) Whatever restrictions apply to INTTXT apply to this routine */ -/* as well. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 15-AUG-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert an integer to ordinal text */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* First get the English equivalent of the cardinal N. */ - - s_copy(mystr, " ", (ftnlen)148, (ftnlen)1); - inttxt_(n, mystr, (ftnlen)148); - last = lastnb_(mystr, (ftnlen)148); - i__ = last; - -/* Find the beginning of the last number of MYSTR. */ - - while(*(unsigned char *)&mystr[i__ - 1] != '-' && *(unsigned char *)& - mystr[i__ - 1] != ' ' && i__ > 1) { - --i__; - } - if (*(unsigned char *)&mystr[i__ - 1] == ' ' || *(unsigned char *)&mystr[ - i__ - 1] == '-') { - ++i__; - } - -/* Now convert the last cardinal to an ordinal. */ - - if (s_cmp(mystr + (i__ - 1), "ONE", last - (i__ - 1), (ftnlen)3) == 0) { - s_copy(mystr + (i__ - 1), "FIRST", 148 - (i__ - 1), (ftnlen)5); - } else if (s_cmp(mystr + (i__ - 1), "TWO", last - (i__ - 1), (ftnlen)3) == - 0) { - s_copy(mystr + (i__ - 1), "SECOND", 148 - (i__ - 1), (ftnlen)6); - } else if (s_cmp(mystr + (i__ - 1), "THREE", last - (i__ - 1), (ftnlen)5) - == 0) { - s_copy(mystr + (i__ - 1), "THIRD", 148 - (i__ - 1), (ftnlen)5); - } else if (s_cmp(mystr + (i__ - 1), "FIVE", last - (i__ - 1), (ftnlen)4) - == 0) { - s_copy(mystr + (i__ - 1), "FIFTH", 148 - (i__ - 1), (ftnlen)5); - } else if (s_cmp(mystr + (i__ - 1), "EIGHT", last - (i__ - 1), (ftnlen)5) - == 0) { - s_copy(mystr + (i__ - 1), "EIGHTH", 148 - (i__ - 1), (ftnlen)6); - } else if (s_cmp(mystr + (i__ - 1), "NINE", last - (i__ - 1), (ftnlen)4) - == 0) { - s_copy(mystr + (i__ - 1), "NINTH", 148 - (i__ - 1), (ftnlen)5); - } else if (s_cmp(mystr + (i__ - 1), "TWELVE", last - (i__ - 1), (ftnlen)6) - == 0) { - s_copy(mystr + (i__ - 1), "TWELFTH", 148 - (i__ - 1), (ftnlen)7); - } else if (*(unsigned char *)&mystr[last - 1] == 'Y') { - s_copy(mystr + (last - 1), "IETH", 148 - (last - 1), (ftnlen)4); - } else { - suffix_("TH", &c__0, mystr, (ftnlen)2, (ftnlen)148); - } - -/* Now simply put MYSTR into STRING and return. */ - - s_copy(string, mystr, string_len, (ftnlen)148); - return 0; -} /* intord_ */ - diff --git a/ext/spice/src/cspice/intstr.c b/ext/spice/src/cspice/intstr.c deleted file mode 100644 index a3149c3c15..0000000000 --- a/ext/spice/src/cspice/intstr.c +++ /dev/null @@ -1,262 +0,0 @@ -/* intstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INTSTR ( Integer to character string ) */ -/* Subroutine */ int intstr_(integer *number, char *string, ftnlen string_len) -{ - /* Initialized data */ - - static char digits[1*10] = "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, remndr, result, tmpnum; - char tmpstr[80]; - -/* $ Abstract */ - -/* Convert an integer to an equivalent character 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Integer to be converted. */ -/* STRING O Equivalent character string, left justified. */ - -/* $ Detailed_Input */ - -/* NUMBER The integer to be converted into a character string. */ - -/* $ Detailed_Output */ - -/* STRING The character string representing the integer NUMBER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the output character string is not large enough to */ -/* contain the entire character string produced, the output */ -/* character string will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will convert a signed integer into an equivalent */ -/* decimal character string representation. The decimal digits of */ -/* the integer NUMBER are found by repeated applications of */ -/* "modulus" and division operations. */ - -/* $ Examples */ - -/* The following argument values illustrate the use of INTSTR. */ - -/* NUMBER STRING */ -/* ------------ --------------------- */ -/* 1 '-1' */ -/* -1 '-1' */ -/* 223 '223' */ -/* -32 '-32' */ -/* 0 '0' */ -/* 2147483647 '2147483647' ( Maximum 32 bit integer ) */ -/* -2147483647 '-2147483647' ( Minimum 32 bit integer + 1 ) */ -/* -2147483647 '-2147483648' ( Minimum 32 bit integer ) */ - -/* $ Restrictions */ - -/* This routine assumes that all signed integers will fit into a */ -/* character string with LINLEN or fewer digits. See the parameter */ -/* LINLEN below for the current value. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 11-MAY-1993 (HAN) (MJS) */ - -/* DATA statement came before the SAVE statement. This is */ -/* a violation of the ANSI Standard. It is now the other way */ -/* around. */ - -/* - SPICELIB Version 2.0.0, 14-OCT-1992 (KRG) */ - -/* The routine was rewritten to fix a bug concerning the minimum */ -/* representable integer. */ - -/* This routine used to negate a negative number before it began */ -/* generating its digits. This was a bad thing to do, because on */ -/* many machines the minimum representable integer and the */ -/* maximum representable integer have the following relationship: */ - -/* ABS( minimum integer ) = 1 + ABS( maximum integer ). */ - -/* Changing the sign of a negative number before converting it */ -/* to a character string would cause a program to crash if it */ -/* were attempting to convert the minimum representable integer */ -/* into a character string. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1 7-DEC-1990 (WLT) */ - -/* References to the old name INT2CH were removed and */ -/* an exception added to that section. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert integer to character string */ - -/* -& */ - -/* Local Parameters */ - - -/* Local variables */ - - -/* Saved values */ - - -/* The digits are generated in reverse order, so we fill the */ -/* character string in reverse order, from `right' to `left', */ -/* so that the digits are in the correct order when we are */ -/* done converting the integer. This is to avoid reversing the */ -/* character string before returning. The output character */ -/* string is then left justified upon exit. */ - -/* Make a copy of the input so that it will not be modified. */ - - tmpnum = *number; - -/* Initialize the temporary character buffer used to store the */ -/* character string as it is generated to blanks. */ - - s_copy(tmpstr, " ", (ftnlen)80, (ftnlen)1); - -/* We need to do different things for the cases where the number to */ -/* be converted is positive, negative, or zero. ( Actually, the */ -/* positive case and the zero case are the same, but since we can */ -/* test for integer zero exactly it will save a few arithmetic */ -/* operations if we treat it as a special case. ) The case for a */ -/* negative number is the only one which truly might cause problems, */ -/* because ABS(minimum integer) may equal ABS(maximum integer) + 1. */ -/* For 32 bit numbers, INTMIN = -214748368 and INTMAX = 214748367. */ -/* You should be able to see the repercussions of this. */ - - i__ = i_len(tmpstr, (ftnlen)80) + 1; - if (tmpnum < 0) { - -/* Collect all of the digits in the string. */ - - while(tmpnum != 0) { - --i__; - result = tmpnum / 10; - remndr = result * 10 - tmpnum; - tmpnum = result; - *(unsigned char *)&tmpstr[i__ - 1] = *(unsigned char *)&digits[( - i__1 = remndr) < 10 && 0 <= i__1 ? i__1 : s_rnge("digits", - i__1, "intstr_", (ftnlen)237)]; - } - -/* Put the minus sign in place. */ - - --i__; - *(unsigned char *)&tmpstr[i__ - 1] = '-'; - } else if (tmpnum > 0) { - -/* Collect all of the digits in the string. */ - - while(tmpnum != 0) { - --i__; - result = tmpnum / 10; - remndr = tmpnum - result * 10; - tmpnum = result; - *(unsigned char *)&tmpstr[i__ - 1] = *(unsigned char *)&digits[( - i__1 = remndr) < 10 && 0 <= i__1 ? i__1 : s_rnge("digits", - i__1, "intstr_", (ftnlen)257)]; - } - } else { - -/* Treat zero as a special case, because it's easier. */ - - --i__; - *(unsigned char *)&tmpstr[i__ - 1] = *(unsigned char *)&digits[0]; - } - -/* Set the value of the output string before returning. Let the */ -/* Fortran string equals deal with the left justification, and the */ -/* truncation on the right if the string STRING is not long enough */ -/* to contain all of the characters necessary. */ - - s_copy(string, tmpstr + (i__ - 1), string_len, i_len(tmpstr, (ftnlen)80) - - (i__ - 1)); - return 0; -} /* intstr_ */ - diff --git a/ext/spice/src/cspice/inttxt.c b/ext/spice/src/cspice/inttxt.c deleted file mode 100644 index 57221d1daa..0000000000 --- a/ext/spice/src/cspice/inttxt.c +++ /dev/null @@ -1,291 +0,0 @@ -/* inttxt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure INTTXT ( Convert an integer to text ) */ -/* Subroutine */ int inttxt_(integer *n, char *string, ftnlen string_len) -{ - /* Initialized data */ - - static char tens[9*9] = "TEN " "TWENTY " "THIRTY " "FORTY " - "FIFTY " "SIXTY " "SEVENTY " "EIGHTY " "NINETY "; - static char number[9*19] = "ONE " "TWO " "THREE " "FOUR " - "FIVE " "SIX " "SEVEN " "EIGHT " "NINE " - "TEN " "ELEVEN " "TWELVE " "THIRTEEN " "FOURTEEN " "FIF" - "TEEN " "SIXTEEN " "SEVENTEEN" "EIGHTEEN " "NINETEEN "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - char suff[9]; - integer x, y, space; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - integer pad, num; - -/* $ Abstract */ - -/* Convert an integer to an equivalent written phrase. */ -/* For example, convert 121 to 'ONE HUNDRED TWENTY-ONE'. */ - -/* $ 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 */ - -/* CONVERSION */ -/* PARSING */ -/* STRING */ -/* UNITS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I An integer (less than 10**12 in absolute value). */ -/* STRING O An English string representing the cardinal of N. */ - -/* $ Detailed_Input */ - -/* N is any integer (less than 10**12 in absolute value). */ -/* If N is less than 0, -N must be a legitimate number. */ - -/* $ Detailed_Output */ - -/* STRING is the English cardinal equivalent of N. STRING will */ -/* contain only upper case letters. */ - -/* The longest possible output string contains 145 */ -/* characters. One such string is: */ - -/* 'NEGATIVE ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN BILLION ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN MILLION ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN THOUSAND ' // */ -/* 'SEVEN HUNDRED SEVENTY-SEVEN' */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the resulting text is longer than the output string, */ -/* it will be truncated on the right, leaving only the most */ -/* significant portion of the number. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is used primarily for constructing error messages. */ -/* For example, an overflow message might look like the following: */ - -/* 'An excess of seventy-four parameters was detected.' */ - -/* A second use might be to write dollar amounts: it's much harder */ -/* to tamper with a string like */ - -/* 'Two thousand four hundred seventy-one dollars' */ - -/* than with the equivalent string */ - -/* '$ 2471.00' */ - -/* $ Examples */ - -/* N STRING */ -/* ------ ------------------------------------------ */ -/* -43 NEGATIVE FORTY-THREE */ -/* 1 ONE */ -/* 2 TWO */ -/* 3 THREE */ -/* 4 FOUR */ -/* 20 TWENTY */ -/* 21 TWENTY-ONE */ -/* 99 NINETY-NINE */ -/* 82131 EIGHTY-TWO THOUSAND ONE HUNDRED THIRTY-ONE */ - -/* $ Restrictions */ - -/* 1) This routine assumes that N will always be less than */ -/* a trillion (10**12) in absolute value. */ - -/* 2) In the event that N is less than zero, this routine assumes */ -/* that -N is a legitimate integer on the host machine. */ - -/* 3) This routine assumes that an integer as large as 10**9 */ -/* (one billion) is representable on the host machine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 15-AUG-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert an integer to text */ - -/* -& */ - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Zero is easy. */ - - if (*n == 0) { - s_copy(string, "ZERO", string_len, (ftnlen)4); - return 0; - } - -/* If the number is negative, the string begins with the word */ -/* `NEGATIVE', and otherwise the number can be treated as though */ -/* it were positive. */ - - if (*n < 0) { - num = -(*n); - s_copy(string, "NEGATIVE", string_len, (ftnlen)8); - } else { - num = *n; - s_copy(string, " ", string_len, (ftnlen)1); - } - -/* Construct the number portion, from left to right: billions, */ -/* then millions, and so on. In case of overflow, SUFFIX simply */ -/* leaves the output string unchanged, so there is no need to */ -/* check explicitly for truncation. */ - - while(num > 0) { - -/* Find the right unit (billion, million, or whatever), */ -/* and the number (X) of those units. X should always */ -/* be between zero and 999, regardless of the units. */ - - if (num >= 1000000000) { - x = num / 1000000000; - s_copy(suff, "BILLION", (ftnlen)9, (ftnlen)7); - num -= x * 1000000000; - } else if (num >= 1000000) { - x = num / 1000000; - s_copy(suff, "MILLION", (ftnlen)9, (ftnlen)7); - num -= x * 1000000; - } else if (num >= 1000) { - x = num / 1000; - s_copy(suff, "THOUSAND", (ftnlen)9, (ftnlen)8); - num -= x * 1000; - } else { - x = num; - s_copy(suff, " ", (ftnlen)9, (ftnlen)1); - num = 0; - } - -/* Convert X to text, ... */ - - space = 1; - while(x > 0) { - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - pad = 0; - } else { - pad = 1; - } - if (x >= 100) { - y = x / 100; - x -= y * 100; - suffix_(number + ((i__1 = y - 1) < 19 && 0 <= i__1 ? i__1 : - s_rnge("number", i__1, "inttxt_", (ftnlen)290)) * 9, & - pad, string, (ftnlen)9, string_len); - suffix_("HUNDRED", &c__1, string, (ftnlen)7, string_len); - } else if (x >= 20) { - y = x / 10; - x -= y * 10; - suffix_(tens + ((i__1 = y - 1) < 9 && 0 <= i__1 ? i__1 : - s_rnge("tens", i__1, "inttxt_", (ftnlen)298)) * 9, & - pad, string, (ftnlen)9, string_len); - if (x != 0) { - suffix_("-", &c__0, string, (ftnlen)1, string_len); - space = 0; - } - } else { - y = x; - x = 0; - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - space = 0; - } - suffix_(number + ((i__1 = y - 1) < 19 && 0 <= i__1 ? i__1 : - s_rnge("number", i__1, "inttxt_", (ftnlen)314)) * 9, & - space, string, (ftnlen)9, string_len); - } - } - -/* ... then add the units. Repeat as necessary. */ - - suffix_(suff, &c__1, string, (ftnlen)9, string_len); - } - return 0; -} /* inttxt_ */ - diff --git a/ext/spice/src/cspice/invert.c b/ext/spice/src/cspice/invert.c deleted file mode 100644 index 98d324a7ab..0000000000 --- a/ext/spice/src/cspice/invert.c +++ /dev/null @@ -1,195 +0,0 @@ -/* invert.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b2 = 0.; -static integer c__9 = 9; - -/* $Procedure INVERT ( Invert a 3x3 matrix ) */ -/* Subroutine */ int invert_(doublereal *m1, doublereal *mout) -{ - doublereal mdet; - extern /* Subroutine */ int filld_(doublereal *, integer *, doublereal *), - vsclg_(doublereal *, doublereal *, integer *, doublereal *); - doublereal mtemp[9] /* was [3][3] */, invdet; - extern doublereal det_(doublereal *); - -/* $ Abstract */ - -/* Generate the inverse of a 3x3 matrix. */ - -/* $ 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 */ - -/* MATRIX, MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Matrix to be inverted. */ -/* MOUT O Inverted matrix (M1)**-1. If M1 is singular, then */ -/* MOUT will be the zero matrix. */ - -/* $ Detailed_Input */ - -/* M1 An arbitrary 3x3 matrix. The limits on the size of */ -/* elements of M1 are determined by the process of calculating */ -/* the cofactors of each element of the matrix. For a 3x3 */ -/* matrix this amounts to the differencing of two terms, each */ -/* of which consists of the multiplication of two matrix */ -/* elements. This multiplication must not exceed the range of */ -/* double precision numbers or else an overflow error will */ -/* occur. */ - -/* $ Detailed_Output */ - -/* MOUT is the inverse of M1 and is calculated explicitly using */ -/* the matrix of cofactors. MOUT is set to be the zero matrix */ -/* if M1 is singular. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* First the determinant is explicitly calculated using the */ -/* fundamental definition of the determinant. If this value is less */ -/* that 10**-16 then the matrix is deemed to be singular and the */ -/* output value is filled with zeros. Otherwise, the output matrix */ -/* is calculated an element at a time by generating the cofactor of */ -/* each element. Finally, each element in the matrix of cofactors */ -/* is multiplied by the reciprocal of the determinant and the result */ -/* is the inverse of the original matrix. */ - -/* NO INTERNAL CHECKING ON THE INPUT MATRIX M1 IS PERFORMED EXCEPT */ -/* ON THE SIZE OF ITS DETERMINANT. THUS IT IS POSSIBLE TO GENERATE */ -/* A FLOATING POINT OVERFLOW OR UNDERFLOW IN THE PROCESS OF */ -/* CALCULATING THE MATRIX OF COFACTORS. */ - -/* $ Examples */ - -/* Suppose that M1 is given by the following matrix equation: */ - -/* | 0 -1 0 | */ -/* M1 = | 0.5 0 0 | */ -/* | 0 0 1 | */ - -/* If INVERT is called according to the FORTRAN code: */ - -/* CALL INVERT (M1, M1) */ - -/* then M1 will be set to be: */ - -/* | 0 2 0 | */ -/* M1 = |-1 0 0 | */ -/* | 0 0 1 | */ - -/* $ Restrictions */ - -/* The input matrix must be such that generating the cofactors will */ -/* not cause a floating point overflow or underflow. The strictness */ -/* of this condition depends, of course, on the computer */ -/* installation and the resultant maximum and minimum values of */ -/* double precision numbers. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* invert a 3x3_matrix */ - -/* -& */ - -/* Find the determinant of M1 and check for singularity */ - - mdet = det_(m1); - if (abs(mdet) < 1e-16) { - filld_(&c_b2, &c__9, mout); - return 0; - } - -/* Get the cofactors of each element of M1 */ - - mtemp[0] = m1[4] * m1[8] - m1[5] * m1[7]; - mtemp[3] = -(m1[3] * m1[8] - m1[5] * m1[6]); - mtemp[6] = m1[3] * m1[7] - m1[4] * m1[6]; - mtemp[1] = -(m1[1] * m1[8] - m1[2] * m1[7]); - mtemp[4] = m1[0] * m1[8] - m1[2] * m1[6]; - mtemp[7] = -(m1[0] * m1[7] - m1[1] * m1[6]); - mtemp[2] = m1[1] * m1[5] - m1[2] * m1[4]; - mtemp[5] = -(m1[0] * m1[5] - m1[2] * m1[3]); - mtemp[8] = m1[0] * m1[4] - m1[1] * m1[3]; - -/* Multiply the cofactor matrix by 1/MDET to obtain the inverse */ - - invdet = 1. / mdet; - vsclg_(&invdet, mtemp, &c__9, mout); - - return 0; -} /* invert_ */ - diff --git a/ext/spice/src/cspice/invert_c.c b/ext/spice/src/cspice/invert_c.c deleted file mode 100644 index 94493079a6..0000000000 --- a/ext/spice/src/cspice/invert_c.c +++ /dev/null @@ -1,212 +0,0 @@ -/* - --Procedure invert_c ( Invert a 3x3 matrix ) - --Abstract - - Generate the inverse of a 3x3 matrix. - --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 - - MATRIX, MATH - -*/ - #include - #include "SpiceUsr.h" - #undef invert_c - - - void invert_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Matrix to be inverted. - mout O Inverted matrix (m1)**-1. If m1 is singular, then - mout will be the zero matrix. mout can - overwrite m1. - --Detailed_Input - - m1 An arbitrary 3x3 matrix. The limits on the size of - elements of m1 are determined by the process of calculating - the cofactors of each element of the matrix. For a 3x3 - matrix this amounts to the differencing of two terms, each - of which consists of the multiplication of two matrix - elements. This multiplication must not exceed the range - of double precision numbers or else an overflow error will - occur. - --Detailed_Output - - mout is the inverse of m1 and is calculated explicitly using - the matrix of cofactors. mout is set to be the zero matrix - if m1 is singular. - --Parameters - - None. - --Exceptions - - 1) No internal checking on the input matrix m1 is performed except on - the size of its determinant. Thus it is possible to generate a - floating point overflow or underflow in the process of - calculating the matrix of cofactors. - - 2) If the determinant is less than 10**-16, the matrix is deemed to - be singular and the output matrix is filled with zeros. - --Particulars - - A temporary matrix is used to compute the result, so the output - matrix may overwrite the input matrix. - --Examples - - Suppose that m1 is given by the following matrix equation: - - | 0 -1 0 | - m1 = | 0.5 0 0 | - | 0 0 1 | - - If invert_c is called as shown - - invert_c (m1, m1); - - then m1 will be set to be: - - | 0 2 0 | - m1 = |-1 0 0 | - | 0 0 1 | - --Restrictions - - The input matrix must be such that generating the cofactors will - not cause a floating point overflow or underflow. The - strictness of this condition depends, of course, on the computer - installation and the resultant maximum and minimum values of - double precision numbers. - --Files - - None - --Author_and_Institution - - W.M. Owen (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.0.0, 13-SEP-1999 (NJB) (WMO) - --Index_Entries - - invert a 3x3_matrix - --& -*/ - -{ /* Begin invert_c */ - - /* - Local constants - */ - - #define SINGULAR_DET 1.e-16 - - - - /* - Local variables - */ - SpiceInt i; - - SpiceDouble invdet; - SpiceDouble mdet; - SpiceDouble mtemp[3][3]; - - - /* - Find the determinant of m1 and check for singularity. - */ - - mdet = det_c(m1); - - if ( fabs(mdet) < SINGULAR_DET ) - { - - /* - The matrix is considered to be singular. - */ - - for ( i = 0; i < 9; i++ ) - { - *( (SpiceDouble*)mout+i ) = 0.; - } - - return; - } - - - /* - Get the cofactors of each element of m1. - */ - mtemp[0][0] = ( m1[1][1]*m1[2][2] - m1[2][1]*m1[1][2] ); - mtemp[0][1] = -( m1[0][1]*m1[2][2] - m1[2][1]*m1[0][2] ); - mtemp[0][2] = ( m1[0][1]*m1[1][2] - m1[1][1]*m1[0][2] ); - mtemp[1][0] = -( m1[1][0]*m1[2][2] - m1[2][0]*m1[1][2] ); - mtemp[1][1] = ( m1[0][0]*m1[2][2] - m1[2][0]*m1[0][2] ); - mtemp[1][2] = -( m1[0][0]*m1[1][2] - m1[1][0]*m1[0][2] ); - mtemp[2][0] = ( m1[1][0]*m1[2][1] - m1[2][0]*m1[1][1] ); - mtemp[2][1] = -( m1[0][0]*m1[2][1] - m1[2][0]*m1[0][1] ); - mtemp[2][2] = ( m1[0][0]*m1[1][1] - m1[1][0]*m1[0][1] ); - - /* - Multiply the cofactor matrix by 1/mdet to obtain the inverse matrix. - */ - - invdet = 1. / mdet; - - vsclg_c ( invdet, (SpiceDouble *)mtemp, 9, (SpiceDouble *)mout ); - - -} /* End invert_c */ - diff --git a/ext/spice/src/cspice/invort.c b/ext/spice/src/cspice/invort.c deleted file mode 100644 index 2d370ea260..0000000000 --- a/ext/spice/src/cspice/invort.c +++ /dev/null @@ -1,257 +0,0 @@ -/* invort.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure INVORT ( Invert nearly orthogonal matrices ) */ -/* Subroutine */ int invort_(doublereal *m, doublereal *mit) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal temp[9] /* was [3][3] */; - integer i__; - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static doublereal bound; - extern doublereal dpmax_(void); - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), xpose_( - doublereal *, doublereal *), unorm_(doublereal *, doublereal *, - doublereal *); - doublereal length; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Given a matrix, construct the matrix whose rows are the */ -/* columns of the first divided by the length squared of the */ -/* the corresponding columns of the input matrix. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* M I A 3x3 matrix. */ -/* MIT I M after transposition and scaling of rows. */ - -/* $ Detailed_Input */ - -/* M is a 3x3 matrix. */ - -/* $ Detailed_Output */ - -/* MIT is the matrix obtained by transposing M and dividing */ -/* the rows by squares of their norms. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any of the columns of M have zero length, the error */ -/* SPICE(ZEROLENGTHCOLUMN) will be signaled. */ - -/* 2) If any column is too short to allow computation of the */ -/* reciprocal of its length without causing a floating */ -/* point overflow, the error SPICE(COLUMNTOOSMALL) will */ -/* be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Suppose that M is the matrix */ - -/* - - */ -/* | A*u B*v C*w | */ -/* | 1 1 1 | */ -/* | | */ -/* | A*u B*v C*w | */ -/* | 2 2 2 | */ -/* | | */ -/* | A*u B*v C*w | */ -/* | 3 3 3 | */ -/* - - */ - -/* where the vectors (u , u , u ), (v , v , v ), and (w , w , w ) */ -/* 1 2 3 1 2 3 1 2 3 */ -/* are unit vectors. This routine produces the matrix: */ - - -/* - - */ -/* | a*u a*u a*u | */ -/* | 1 2 3 | */ -/* | | */ -/* | b*v b*v b*v | */ -/* | 1 2 3 | */ -/* | | */ -/* | c*w c*w c*w | */ -/* | 1 2 3 | */ -/* - - */ - -/* where a = 1/A, b = 1/B, and c = 1/C. */ - -/* $ Examples */ - -/* Suppose that you have a matrix M whose columns are orthogonal */ -/* and have non-zero norm (but not necessarily norm 1). Then the */ -/* routine INVORT can be used to construct the inverse of M: */ - -/* CALL INVORT ( M, INVERS ) */ - -/* This method is numerically more robust than calling the */ -/* routine INVERT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - SPICELIB Version 1.0.0, 02-JAN-2002 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Transpose a matrix and invert the lengths of the rows */ -/* Invert a pseudo orthogonal matrix */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. */ - - -/* The first time through, get a copy of DPMAX. */ - - if (first) { - bound = dpmax_(); - first = FALSE_; - } - -/* For each column, construct a scaled copy. However, make sure */ -/* everything is do-able before trying something. */ - - for (i__ = 1; i__ <= 3; ++i__) { - unorm_(&m[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("m", - i__1, "invort_", (ftnlen)214)], &temp[(i__2 = i__ * 3 - 3) < - 9 && 0 <= i__2 ? i__2 : s_rnge("temp", i__2, "invort_", ( - ftnlen)214)], &length); - if (length == 0.) { - chkin_("INVORT", (ftnlen)6); - setmsg_("Column # of the input matrix has a norm of zero. ", ( - ftnlen)49); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(ZEROLENGTHCOLUMN)", (ftnlen)23); - chkout_("INVORT", (ftnlen)6); - return 0; - } - -/* Make sure we can actually rescale the rows. */ - - if (length < 1.) { - if (length * bound < 1.) { - chkin_("INVORT", (ftnlen)6); - setmsg_("The length of column # is #. This number cannot be " - "inverted. For this reason, the scaled transpose of " - "the input matrix cannot be formed. ", (ftnlen)138); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &length, (ftnlen)1); - sigerr_("SPICE(COLUMNTOOSMALL)", (ftnlen)21); - chkout_("INVORT", (ftnlen)6); - return 0; - } - } - scale = 1. / length; - vsclip_(&scale, &temp[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : - s_rnge("temp", i__1, "invort_", (ftnlen)252)]); - } - -/* If we make it this far, we just need to transpose TEMP into MIT. */ - - xpose_(temp, mit); - return 0; -} /* invort_ */ - diff --git a/ext/spice/src/cspice/invort_c.c b/ext/spice/src/cspice/invort_c.c deleted file mode 100644 index abb560fe21..0000000000 --- a/ext/spice/src/cspice/invort_c.c +++ /dev/null @@ -1,194 +0,0 @@ -/* - --Procedure invort_c ( Invert nearly orthogonal matrices ) - --Abstract - - Given a matrix, construct the matrix whose rows are the - columns of the first divided by the length squared of the - the corresponding columns of the input matrix. - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef invort_c - - - void invort_c ( ConstSpiceDouble m [3][3], - SpiceDouble mit[3][3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - m I A 3x3 matrix. - mit I m after transposition and scaling of rows. - --Detailed_Input - - m is a 3x3 matrix. - --Detailed_Output - - mit is the matrix obtained by transposing m and dividing - the rows by squares of their norms. - --Parameters - - None. - --Exceptions - - 1) If any of the columns of m have zero length, the error - SPICE(ZEROLENGTHCOLUMN) will be signaled. - - 2) If any column is too short to allow computation of the - reciprocal of its length without causing a floating - point overflow, the error SPICE(COLUMNTOOSMALL) will - be signalled. - --Files - - None. - --Particulars - - Suppose that m is the matrix - - - - - | A*u B*v C*w | - | 1 1 1 | - | | - | A*u B*v C*w | - | 2 2 2 | - | | - | A*u B*v C*w | - | 3 3 3 | - - - - - where the vectors (u , u , u ), (v , v , v ), and (w , w , w ) - 1 2 3 1 2 3 1 2 3 - - are unit vectors. This routine produces the matrix: - - - - - - | a*u a*u a*u | - | 1 2 3 | - | | - | b*v b*v b*v | - | 1 2 3 | - | | - | c*w c*w c*w | - | 1 2 3 | - - - - - where a = 1/A, b = 1/B, and c = 1/C. - --Examples - - Suppose that you have a matrix m whose columns are orthogonal - and have non-zero norm (but not necessarily norm 1). Then the - routine invort_c can be used to construct the inverse of m: - - #include "SpiceUsr.h" - . - . - . - invort_c ( m, invers ); - - This method is numerically more robust than calling the - routine invert_c. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 02-JAN-2002 (WLT) (NJB) - --Index_Entries - - Transpose a matrix and invert the lengths of the rows - Invert a pseudo orthogonal matrix - --& -*/ - -{ /* Begin invort_c */ - - /* - Local variables - */ - SpiceDouble temp[3][3]; - - - /* - Participate in error tracing. - */ - chkin_c ( "invort_c" ); - - /* - Transpose the input matrix to obtain a Fortran-style matrix. - */ - xpose_c ( m, temp ); - - invort_ ( (SpiceDouble * )temp, - (SpiceDouble * )mit ); - - /* - Transpose the output matrix to obtain a C-style matrix. - */ - xpose_c ( mit, mit ); - - - chkout_c ( "invort_c" ); - -} /* End invort_c */ diff --git a/ext/spice/src/cspice/invstm.c b/ext/spice/src/cspice/invstm.c deleted file mode 100644 index 6429828478..0000000000 --- a/ext/spice/src/cspice/invstm.c +++ /dev/null @@ -1,219 +0,0 @@ -/* invstm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__3 = 3; - -/* $Procedure INVSTM ( Inverse of state transformation matrix) */ -/* Subroutine */ int invstm_(doublereal *mat, doublereal *invmat) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen), xposbl_(doublereal *, integer *, integer *, integer *, - doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the inverse of a state transformation matrix. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATH */ -/* MATRIX */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MAT I A state transformation matrix. */ -/* INVMAT O The inverse of MAT. */ - -/* $ Detailed_Input */ - -/* MAT is a state transformation matrix for converting states */ -/* relative to one frame to states relative to another. */ -/* The state transformation of a state vector, S, is */ -/* performed by the matrix-vector product. */ - -/* MAT * S. */ - -/* For MAT to be a "true" state transformation matrix */ -/* it must have the form */ - -/* - - */ -/* | : | */ -/* | R : 0 | */ -/* |.......:......| */ -/* | : | */ -/* | W*R : R | */ -/* | : | */ -/* - - */ - -/* where R is a 3x3 rotation matrix and, 0 is the 3x3 zero */ -/* matrix and W is a 3x3 skew-symmetric matrix. */ - -/* NOTE: no checks are performed on MAT to ensure that it */ -/* does indeed have the form described above. */ - -/* $ Detailed_Output */ - -/* INVMAT is the inverse of MAT under the operation of matrix */ -/* multiplication. */ - -/* If MAT has the form described above, then INVMAT has */ -/* the form shown below. */ - -/* - - */ -/* | t : | */ -/* | R : 0 | */ -/* |........:......| */ -/* | t : t | */ -/* | (W*R) : R | */ -/* | : | */ -/* - - */ - -/* (The superscript "t" denotes the matrix transpose */ -/* operation.) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) No checks are performed, to insure that the input matrix is */ -/* indeed a state transformation matrix. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given a matrix for transforming states relative frame 1 to */ -/* states relative frame 2, the routine produces the inverse */ -/* matrix. That is, it returns the matrix for transforming states */ -/* relative to frame 2 to states relative to frame 1. */ - -/* This special routine exists because unlike the inverse of a */ -/* rotation matrix, the inverse of a state transformation matrix, */ -/* is NOT simply the transpose of the of the matrix. */ - -/* $ Examples */ - -/* Suppose you had a geometric state, STATE, of a spacecraft in */ -/* earth bodyfixed coordinates and wished to express this state */ -/* relative to earth centered J2000 coordinates. The following */ -/* code fragment illustrates how to carry out this computation. */ - -/* C */ -/* C First get the state transformation from J2000 to earth */ -/* C bodyfixed coordinates at the time of interest ET. */ -/* C */ -/* EARTH = 399 */ -/* J2000 = 'J2000' */ - -/* CALL TISBOD ( J2000, EARTH, ET, MAT ) */ - -/* C */ -/* C Get the inverse of MAT */ -/* C */ -/* CALL INVSTM ( MAT, INVMAT ) */ - -/* C */ -/* C Transform from bodyfixed state to inertial state. */ -/* C */ -/* CALL MXVG ( INVMAT, STATE, 6, 6, ISTATE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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, 29-OCT-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* inverse of state transformation matrix */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("INVSTM", (ftnlen)6); - } - -/* Not much to this. Just call the more general routine XPOSBL. */ - - xposbl_(mat, &c__6, &c__6, &c__3, invmat); - -/* That's all folks. */ - - chkout_("INVSTM", (ftnlen)6); - return 0; -} /* invstm_ */ - diff --git a/ext/spice/src/cspice/ioerr.c b/ext/spice/src/cspice/ioerr.c deleted file mode 100644 index 6c468e872d..0000000000 --- a/ext/spice/src/cspice/ioerr.c +++ /dev/null @@ -1,250 +0,0 @@ -/* ioerr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__2 = 2; - -/* $Procedure IOERR ( I/O error message writer ) */ -/* Subroutine */ int ioerr_(char *action, char *file, integer *iostat, ftnlen - action_len, ftnlen file_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char error[320], iochar[10]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen), intstr_(integer *, char *, - ftnlen); - -/* $ Abstract */ - -/* Set the long error message equal to a standard I/O error message */ -/* composed from an action, the name of a file, and a value of */ -/* IOSTAT. */ - -/* $ 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 */ - -/* ERROR, FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action which caused the error. */ -/* FILE I The name of the file involved. */ -/* IOSTAT I The value of IOSTAT returned by ACTION. */ - -/* $ Detailed_Input */ - - -/* ACTION is the action which caused the error. This may */ -/* be the name of a basic operation, such as 'OPEN', */ -/* 'READ', or 'WRITE', or may be more sophisticated, */ -/* for example, 'add an empty cluster header to'. */ - -/* FILE is the name of the file involved in the error. */ -/* This may be the system or logical name of a file */ -/* ('USER$DISK:[USER.SUB]TEMP.DAT', 'PLNEPH'), or one */ -/* of the standard files ('SYS$INPUT', 'SYS$OUTPUT'). */ - -/* IOSTAT is the value of IOSTAT returned by ACTION. This */ -/* is appended to the end of the error message. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The input arguments are inserted into the standard form shown */ -/* below. Spaces are inserted where needed. Leading and trailing */ -/* spaces are removed. */ - -/* The long error message is set equal to a standard I/O error */ -/* message, of the form: */ - -/* An error occurred while --------1---------- */ -/* -------2-------. The value of IOSTAT returned */ -/* was --3--. */ - -/* where the values of ACTION, FILE, and IOSTAT are */ -/* assigned to positions 1, 2 and 3 */ -/* respectively. */ - -/* If the length of the entire composed message exceeds 320 */ -/* characters, it is truncated. */ - -/* SIGERR must be called following a call to this routine to */ -/* actually output the resulting long error message to the error */ -/* output device. */ - -/* $ Examples */ - -/* The following example illustrates the use of IOERR. */ - -/* CALL IOERR ( 'adding a new header to', */ -/* EPHEM, */ -/* 24 ) */ - -/* The resulting error message would be: */ - -/* 'An error occurred while adding a new header */ -/* to LIBDISK:[EPHEM.NESYS]VGR2_T860502.GEF. The value */ -/* of IOSTAT returned was 24.' */ - -/* Note that the user is not responsible for adding and eliminating */ -/* spaces to make the string readable. That is all done */ -/* automatically. */ - -/* It is possible to omit the name of the file entirely, as in the */ -/* following (somewhat frivolous) example. */ - -/* CALL IOERR ( 'cleaning a fish', */ -/* ' ', */ -/* -3 ) */ - -/* The resulting error message would be: */ - -/* 'An error occurred while cleaning a fish. */ -/* The value of IOSTAT returned was -3.' */ - -/* In fact, if the value of IOSTAT is zero, the last part of the */ -/* message is omitted entirely, as in the following example. */ - -/* CALL IOERR ( 'writing the status line to', */ -/* 'SYS$OUTPUT', */ -/* 0 ) */ - -/* The resulting error message would be: */ - -/* 'An error occurred while writing the status */ -/* line to SYS$OUTPUT.' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* i/o error message writer */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 20-DEC-1988 (NJB) */ - -/* IOERR now sets the long error message equal to the */ -/* constructed message, rather than returning the constructed */ -/* message to the caller. IOERR's argument list has been */ -/* changed accordingly, and a call to SETMSG has been added. */ -/* Also, the name of the calling routine no longer appears */ -/* in the constructed message. */ -/* -& */ - -/* Local variables */ - - -/* First comes some standard stuff. */ - - s_copy(error, "An error occurred while", (ftnlen)320, (ftnlen)23); - -/* Next comes the action that caused the error, and the file name. */ -/* There should be at least one space between each of these pieces, */ -/* but not more than one. */ - - suffix_(action, &c__1, error, action_len, (ftnlen)320); - suffix_(file, &c__1, error, file_len, (ftnlen)320); - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)320); - -/* More standard stuff. If IOSTAT is zero, there is no need for this */ -/* part of the message. */ - - if (*iostat != 0) { - suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)32, - (ftnlen)320); - -/* IOSTAT must be written to a character variable first. */ -/* Attempting to write it directly to ERROR could cause a */ -/* boo-boo if we have already overrun the length of ERROR. */ - - intstr_(iostat, iochar, (ftnlen)10); - suffix_(iochar, &c__1, error, (ftnlen)10, (ftnlen)320); - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)320); - } - -/* The message has been constructed. Set the long error message */ -/* equal to the constructed message. */ - - setmsg_(error, (ftnlen)320); - return 0; -} /* ioerr_ */ - diff --git a/ext/spice/src/cspice/irftrn.c b/ext/spice/src/cspice/irftrn.c deleted file mode 100644 index ccd786654c..0000000000 --- a/ext/spice/src/cspice/irftrn.c +++ /dev/null @@ -1,206 +0,0 @@ -/* irftrn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure IRFTRN ( Inertial reference frame transformation ) */ -/* Subroutine */ int irftrn_(char *refa, char *refb, doublereal *rotab, - ftnlen refa_len, ftnlen refb_len) -{ - integer codea, codeb; - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the matrix that transforms vectors from one specified */ -/* inertial reference frame to another. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* REFA I Name of reference frame to transform vectors FROM. */ -/* REFB I Name of reference frame to transform vectors TO. */ -/* ROTAB O REFA-to-REFB transformation matrix. */ - -/* $ Detailed_Input */ - -/* REFA, */ -/* REFB Names of two inertial reference frames. Any names */ -/* accepted by the routine IRFNUM may be used. See */ -/* $Particulars for a list of some of the more */ -/* commonly used inertial reference frame names. */ - -/* $ Detailed_Output */ - -/* ROTAB is a rotation matrix that transforms the */ -/* coordinates of a vector V relative to the */ -/* reference frame specified by REFA to the */ -/* coordinates of V relative to the reference frame */ -/* specified by REFB. The transformation is carried */ -/* out by the matrix multiplication */ - -/* V = ROTAB * V. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the input reference frame names is invalid, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Normally applications should call the more general, higher level */ -/* routine PXFORM instead of this routine. */ - -/* This routine is a macro that replaces the code fragment */ - -/* CALL IRFNUM ( REFA, CODEA ) */ -/* CALL IRFNUM ( REFB, CODEB ) */ -/* CALL IRFROT ( CODEA, CODEB, ROTAB ) */ - - -/* Among the reference frame names accepted by IRFNUM are: */ - -/* 'J2000' */ -/* 'B1950' */ -/* 'FK4' */ -/* 'DE-96' */ -/* 'DE-102' */ -/* 'DE-108' */ -/* 'DE-111' */ -/* 'DE-114' */ -/* 'DE-118' */ -/* 'DE-122' */ -/* 'DE-125' */ -/* 'DE-130' */ -/* 'DE-200' */ -/* 'DE-202' */ -/* 'GALACTIC' */ - -/* See the SPICELIB routine GHGIRF for details. */ - - -/* $ Examples */ - -/* 1) Transform a vector V1950 from the B1950 to the J2000 */ -/* reference frame. */ - -/* C */ -/* C Ask IRFTRN for the matrix that transforms vectors */ -/* C from the B1950 to the J2000 reference frame. */ -/* C */ -/* CALL IRFTRN ( 'B1950', 'J2000', TRANS ) */ - -/* C */ -/* C Now transform V1950 to the J2000 reference frame. */ -/* C */ -/* CALL MXV ( TRANS, V1950, V2000 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 28-SEP-2004 (NJB) */ - -/* Corrected comment in code example in header. Made other minor */ -/* updates to header. */ - -/* - 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, 30-AUG-1991 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* tranformation from one inertial frame to another */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("IRFTRN", (ftnlen)6); - } - -/* Encode the reference frame names, and find the transformation */ -/* matrix. */ - - irfnum_(refa, &codea, refa_len); - irfnum_(refb, &codeb, refb_len); - irfrot_(&codea, &codeb, rotab); - chkout_("IRFTRN", (ftnlen)6); - return 0; -} /* irftrn_ */ - diff --git a/ext/spice/src/cspice/iso2utc.c b/ext/spice/src/cspice/iso2utc.c deleted file mode 100644 index 94c19e93ab..0000000000 --- a/ext/spice/src/cspice/iso2utc.c +++ /dev/null @@ -1,446 +0,0 @@ -/* iso2utc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__3 = 3; -static integer c__4 = 4; -static integer c__5 = 5; -static integer c__6 = 6; -static integer c__7 = 7; -static integer c__8 = 8; -static integer c__9 = 9; -static integer c__10 = 10; -static integer c__12 = 12; -static integer c__11 = 11; -static integer c__13 = 13; -static integer c__14 = 14; -static integer c__15 = 15; -static integer c__16 = 16; -static integer c__17 = 17; -static integer c__18 = 18; -static integer c__19 = 19; - -/* $Procedure ISO2UTC ( Convert ISO time strings to UTC strings. ) */ -/* Subroutine */ int iso2utc_(char *tstrng, char *utcstr, char *error, ftnlen - tstrng_len, ftnlen utcstr_len, ftnlen error_len) -{ - /* Initialized data */ - - static char months[3*13] = "???" "JAN" "FEB" "MAR" "APR" "MAY" "JUN" - "JUL" "AUG" "SEP" "OCT" "NOV" "DEC"; - static char imonth[2*12] = "01" "02" "03" "04" "05" "06" "07" "08" "09" - "10" "11" "12"; - - /* System generated locals */ - address a__1[3], a__2[5]; - integer i__1[3], i__2, i__3[5]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer); - logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen, - ftnlen); - - /* Local variables */ - integer l, m; - char ascii[100]; - extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *, - char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char mystr[128]; - logical change; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* This routine converts date-time strings represented in */ -/* the format adopted by the International Standards Organization */ -/* (ISO) to equivalent UTC time strings recognized by the SPICELIB */ -/* routine TPARSE. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TSTRNG I String representing a calendar or julian date epoch */ -/* UTCSTR O SPICELIB UTC string corresponding to TSTRNG */ -/* ERROR O Error message if something went wrong. */ - -/* $ Detailed_Input */ - -/* TSTRNG is an input time string, containing a time string */ -/* in ISO format. This routine is not sensitive to */ -/* the case of the characters that make up TSTRNG. */ -/* Thus 1992-192t12:29:28 and 1992-192T12:29:28 */ -/* are equivalent. */ - -/* The ISO standard time formats are: */ - -/* Year Month Day yyyy-mm-ddThh:mm:ss[.sss...] */ -/* yyyy-mm-dd */ - -/* Day of Year yyyy-dddThh:mm:ss[.sss...] */ -/* yyyy-ddd */ - -/* The letters y,m,d,h,m,s can stand for any digit. */ -/* All digits are required in these formats. Moreover */ -/* the year portion of these strings must be between */ -/* 1000 and 2999 inclusive. */ - -/* The length of TSTRNG should not exceed 80 characters. */ - -/* We point out that the format yyyy-ddd may be */ -/* interpreted very differently by routine UTC2ET. */ -/* 1992-003 is interpreted by UTC2ET as March 1, 1992 */ -/* whereas it is interpret as January 3, 1992 by ISO2ET. */ - -/* User's should be aware of these differences in */ -/* interpretation and exercise adequate care in their */ -/* programs to avoid this possible confusion. */ - -/* $ Detailed_Output */ - -/* UTCSTR is the equivalent of TSTRNG, expressed in a UTC */ -/* time string that can be parsed by the SPICELIB */ -/* routine TPARSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the string is interpreted as an ISO format string and */ -/* the year portion is not within the range [1000, 2999] the */ -/* error SPICE(YEAROUTOFBOUNDS) is signalled. UTCSTR is */ -/* not changed. */ - -/* 2) If the string does not clearly match the ISO format */ -/* the error SPICE(NOTISOFORMAT) is signalled. UTCSTR is not */ -/* changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The input string is converted to a UTC time string as defined */ -/* by the SPICELIB routine TPARSE. */ - -/* $ Examples */ - -/* To convert the time string 1992-04-03T14:12:28 to the */ -/* corresponding ephemeris time, execute the following instructions: */ - -/* TSTRNG = '1992-04-03T14:12:28' */ - -/* CALL ISO2UTC ( TSTRNG, UTCSTR, ERROR ) */ - -/* CALL TPARSE ( UTCSTR, UTCSEC, ERROR ) */ - -/* CALL DELTET ( UTCSEC, 'UTC', DELTA ) */ - -/* ET = DELTA + UTCSEC */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* Jesperson and Fitz-Randolph, From Sundials to Atomic Clocks, */ -/* Dover Publications, New York, 1977. */ - -/* Software Interface Specification: SFOC-2-SYS-Any-TimeForms */ -/* prepared by D. Wagner, Revision Date: Feb 6, 1990. */ -/* Document Identifier SFOC0038-01-09-03 (NAIF Document 268.00) */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.1.1, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Restrictions section. */ - -/* - EKLIB Version 1.1.0, 11-JUL-1995 (KRG) */ - -/* Fixed a typo in the $ Detailed_Output section of the header. */ -/* The output variable was listed as ET when it should have been */ -/* UTCSTR. */ - -/* Changed the length of ASCII to be 100 rather than 128. This */ -/* removes possible wcompiler warning messages for truncating */ -/* character variables on assignments. The maximum nonblank length */ -/* for an input time ISO string is 80 characters, so placing it */ -/* into a temporary array of 100 characters should pose no */ -/* difficulties. */ - -/* - EKLIB Version 1.0.0, 25-FEB-1993 (JML) */ - -/* -& */ -/* $ Index_Entries */ - - -/* Transform ISO time strings to UTC strings */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* In-line functions. */ - - -/* Local Variables */ - - -/* Initial Values */ - - -/* In-line Function Definitions */ - - -/* Standard SPICELIB exception handling */ - - if (return_()) { - return 0; - } else { - chkin_("ISO2UTC", (ftnlen)7); - } - -/* Left justify the input time string, and determine the location of */ -/* it's last non-blank character. Finally make some local copies. */ - - ljust_(tstrng, ascii, tstrng_len, (ftnlen)100); - l = rtrim_(ascii, (ftnlen)100); - s_copy(mystr, ascii, (ftnlen)128, (ftnlen)100); - change = FALSE_; - -/* Next check for one of the ISO allowed formats. */ - - if (l == 8) { - -/* The possible format is: yyyy-ddd. If we get a */ -/* match construct the corresponding SPICE day of */ -/* year format using JAN (e.g. 1991-JAN-261). */ - - if (*(unsigned char *)&ascii[c__1 - 1] >= '0' && *(unsigned char *)& - ascii[c__1 - 1] <= '9' && (*(unsigned char *)&ascii[c__2 - 1] - >= '0' && *(unsigned char *)&ascii[c__2 - 1] <= '9') && (*( - unsigned char *)&ascii[c__3 - 1] >= '0' && *(unsigned char *)& - ascii[c__3 - 1] <= '9') && (*(unsigned char *)&ascii[c__4 - 1] - >= '0' && *(unsigned char *)&ascii[c__4 - 1] <= '9') && *( - unsigned char *)&ascii[c__5 - 1] == '-' && (*(unsigned char *) - &ascii[c__6 - 1] >= '0' && *(unsigned char *)&ascii[c__6 - 1] - <= '9') && (*(unsigned char *)&ascii[c__7 - 1] >= '0' && *( - unsigned char *)&ascii[c__7 - 1] <= '9') && (*(unsigned char * - )&ascii[c__8 - 1] >= '0' && *(unsigned char *)&ascii[c__8 - 1] - <= '9')) { -/* Writing concatenation */ - i__1[0] = 5, a__1[0] = ascii; - i__1[1] = 3, a__1[1] = "JAN"; - i__1[2] = 96, a__1[2] = ascii + 4; - s_cat(mystr, a__1, i__1, &c__3, (ftnlen)128); - change = TRUE_; - } - } else if (l == 10) { - -/* The possible format is: yyyy-mm-dd. If we get a match */ -/* construct the corresponding SPICE yyyy-mm-dd format. */ - - if (*(unsigned char *)&ascii[c__1 - 1] >= '0' && *(unsigned char *)& - ascii[c__1 - 1] <= '9' && (*(unsigned char *)&ascii[c__2 - 1] - >= '0' && *(unsigned char *)&ascii[c__2 - 1] <= '9') && (*( - unsigned char *)&ascii[c__3 - 1] >= '0' && *(unsigned char *)& - ascii[c__3 - 1] <= '9') && (*(unsigned char *)&ascii[c__4 - 1] - >= '0' && *(unsigned char *)&ascii[c__4 - 1] <= '9') && *( - unsigned char *)&ascii[c__5 - 1] == '-' && (*(unsigned char *) - &ascii[c__6 - 1] >= '0' && *(unsigned char *)&ascii[c__6 - 1] - <= '9') && (*(unsigned char *)&ascii[c__7 - 1] >= '0' && *( - unsigned char *)&ascii[c__7 - 1] <= '9') && *(unsigned char *) - &ascii[c__8 - 1] == '-' && (*(unsigned char *)&ascii[c__9 - 1] - >= '0' && *(unsigned char *)&ascii[c__9 - 1] <= '9') && (*( - unsigned char *)&ascii[c__10 - 1] >= '0' && *(unsigned char *) - &ascii[c__10 - 1] <= '9')) { - m = bsrchc_(ascii + 5, &c__12, imonth, (ftnlen)2, (ftnlen)2); -/* Writing concatenation */ - i__1[0] = 5, a__1[0] = ascii; - i__1[1] = 3, a__1[1] = months + ((i__2 = m) < 13 && 0 <= i__2 ? - i__2 : s_rnge("months", i__2, "iso2utc_", (ftnlen)318)) * - 3; - i__1[2] = 93, a__1[2] = ascii + 7; - s_cat(mystr, a__1, i__1, &c__3, (ftnlen)128); - change = TRUE_; - } - } else if (l >= 17) { - -/* There are two possible formats yyyy-dddThh:mm:ss.ssssss */ -/* yyyy-mm-ddThh:mm:ss.ssssss */ -/* As above, if we get a match up to the first character following */ -/* a 'T', convert this to a standard SPICE time string. */ - - if (*(unsigned char *)&ascii[c__1 - 1] >= '0' && *(unsigned char *)& - ascii[c__1 - 1] <= '9' && (*(unsigned char *)&ascii[c__2 - 1] - >= '0' && *(unsigned char *)&ascii[c__2 - 1] <= '9') && (*( - unsigned char *)&ascii[c__3 - 1] >= '0' && *(unsigned char *)& - ascii[c__3 - 1] <= '9') && (*(unsigned char *)&ascii[c__4 - 1] - >= '0' && *(unsigned char *)&ascii[c__4 - 1] <= '9') && *( - unsigned char *)&ascii[c__5 - 1] == '-' && (*(unsigned char *) - &ascii[c__6 - 1] >= '0' && *(unsigned char *)&ascii[c__6 - 1] - <= '9') && (*(unsigned char *)&ascii[c__7 - 1] >= '0' && *( - unsigned char *)&ascii[c__7 - 1] <= '9') && (*(unsigned char * - )&ascii[c__8 - 1] >= '0' && *(unsigned char *)&ascii[c__8 - 1] - <= '9') && (*(unsigned char *)&ascii[c__9 - 1] == 'T' || *( - unsigned char *)&ascii[c__9 - 1] == 't') && (*(unsigned char * - )&ascii[c__10 - 1] >= '0' && *(unsigned char *)&ascii[c__10 - - 1] <= '9') && (*(unsigned char *)&ascii[c__11 - 1] >= '0' && * - (unsigned char *)&ascii[c__11 - 1] <= '9') && *(unsigned char - *)&ascii[c__12 - 1] == ':' && (*(unsigned char *)&ascii[c__13 - - 1] >= '0' && *(unsigned char *)&ascii[c__13 - 1] <= '9') && - (*(unsigned char *)&ascii[c__14 - 1] >= '0' && *(unsigned - char *)&ascii[c__14 - 1] <= '9') && *(unsigned char *)&ascii[ - c__15 - 1] == ':' && (*(unsigned char *)&ascii[c__16 - 1] >= - '0' && *(unsigned char *)&ascii[c__16 - 1] <= '9') && (*( - unsigned char *)&ascii[c__17 - 1] >= '0' && *(unsigned char *) - &ascii[c__17 - 1] <= '9')) { -/* Writing concatenation */ - i__3[0] = 5, a__2[0] = ascii; - i__3[1] = 3, a__2[1] = "JAN"; - i__3[2] = 4, a__2[2] = ascii + 4; - i__3[3] = 1, a__2[3] = " "; - i__3[4] = 91, a__2[4] = ascii + 9; - s_cat(mystr, a__2, i__3, &c__5, (ftnlen)128); - change = TRUE_; - } else if (*(unsigned char *)&ascii[c__1 - 1] >= '0' && *(unsigned - char *)&ascii[c__1 - 1] <= '9' && (*(unsigned char *)&ascii[ - c__2 - 1] >= '0' && *(unsigned char *)&ascii[c__2 - 1] <= '9') - && (*(unsigned char *)&ascii[c__3 - 1] >= '0' && *(unsigned - char *)&ascii[c__3 - 1] <= '9') && (*(unsigned char *)&ascii[ - c__4 - 1] >= '0' && *(unsigned char *)&ascii[c__4 - 1] <= '9') - && *(unsigned char *)&ascii[c__5 - 1] == '-' && (*(unsigned - char *)&ascii[c__6 - 1] >= '0' && *(unsigned char *)&ascii[ - c__6 - 1] <= '9') && (*(unsigned char *)&ascii[c__7 - 1] >= - '0' && *(unsigned char *)&ascii[c__7 - 1] <= '9') && *( - unsigned char *)&ascii[c__8 - 1] == '-' && (*(unsigned char *) - &ascii[c__9 - 1] >= '0' && *(unsigned char *)&ascii[c__9 - 1] - <= '9') && (*(unsigned char *)&ascii[c__10 - 1] >= '0' && *( - unsigned char *)&ascii[c__10 - 1] <= '9') && (*(unsigned char - *)&ascii[c__11 - 1] == 'T' || *(unsigned char *)&ascii[c__11 - - 1] == 't') && (*(unsigned char *)&ascii[c__12 - 1] >= '0' && - *(unsigned char *)&ascii[c__12 - 1] <= '9') && (*(unsigned - char *)&ascii[c__13 - 1] >= '0' && *(unsigned char *)&ascii[ - c__13 - 1] <= '9') && *(unsigned char *)&ascii[c__14 - 1] == - ':' && (*(unsigned char *)&ascii[c__15 - 1] >= '0' && *( - unsigned char *)&ascii[c__15 - 1] <= '9') && (*(unsigned char - *)&ascii[c__16 - 1] >= '0' && *(unsigned char *)&ascii[c__16 - - 1] <= '9') && *(unsigned char *)&ascii[c__17 - 1] == ':' && - (*(unsigned char *)&ascii[c__18 - 1] >= '0' && *(unsigned - char *)&ascii[c__18 - 1] <= '9') && (*(unsigned char *)&ascii[ - c__19 - 1] >= '0' && *(unsigned char *)&ascii[c__19 - 1] <= - '9')) { - m = bsrchc_(ascii + 5, &c__12, imonth, (ftnlen)2, (ftnlen)2); -/* Writing concatenation */ - i__3[0] = 5, a__2[0] = ascii; - i__3[1] = 3, a__2[1] = months + ((i__2 = m) < 13 && 0 <= i__2 ? - i__2 : s_rnge("months", i__2, "iso2utc_", (ftnlen)365)) * - 3; - i__3[2] = 3, a__2[2] = ascii + 7; - i__3[3] = 1, a__2[3] = " "; - i__3[4] = 89, a__2[4] = ascii + 11; - s_cat(mystr, a__2, i__3, &c__5, (ftnlen)128); - change = TRUE_; - } - } - -/* If we didn't make some change to the input string, it's NOT */ -/* an ISO format string. Say so in an error message and return. */ - - if (! change) { - s_copy(error, "The input string does not match the format expected o" - "f ISO time strings. The acceptable formats are: yyyy-ddd, yy" - "yy-mm-dd, yyyy-dddThh:mm:ss[.ss...], and yyyy-mm-ddThh:mm:ss" - "[.ss...]. The input string was #. ", error_len, (ftnlen)208); - repmc_(error, "#", mystr, error, error_len, (ftnlen)1, l, error_len); - chkout_("ISO2UTC", (ftnlen)7); - return 0; - } - -/* Check for a year out of the range from 1000 to 2999 */ - - if (change && (l_lt(ascii, "1000", (ftnlen)4, (ftnlen)4) || l_gt(ascii, - "2999", (ftnlen)4, (ftnlen)4))) { - s_copy(error, "Years outside the range from 1000 to 2999 are not sup" - "ported in SPICE-ISO format. You've supplied a time string of" - " the form # ... ", error_len, (ftnlen)129); - repmc_(error, "#", ascii, error, error_len, (ftnlen)1, (ftnlen)7, - error_len); - chkout_("ISO2UTC", (ftnlen)7); - return 0; - } - -/* That's it. */ - - s_copy(error, " ", error_len, (ftnlen)1); - s_copy(utcstr, mystr, utcstr_len, (ftnlen)128); - chkout_("ISO2UTC", (ftnlen)7); - return 0; -} /* iso2utc_ */ - diff --git a/ext/spice/src/cspice/isopen.c b/ext/spice/src/cspice/isopen.c deleted file mode 100644 index 211c271b2b..0000000000 --- a/ext/spice/src/cspice/isopen.c +++ /dev/null @@ -1,213 +0,0 @@ -/* isopen.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ISOPEN ( Is a file currently open? ) */ -logical isopen_(char *file, ftnlen file_len) -{ - /* System generated locals */ - logical ret_val; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - logical myopen; - extern logical return_(void); - logical exists; - -/* $ Abstract */ - -/* Determine whether a named file is currently open. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I Name of the file in question. */ - -/* The function returns the value TRUE if the file is open, FALSE */ -/* otherwise. */ - -/* $ Detailed_Input */ - -/* FILE is the name of the file in question. */ - -/* $ Detailed_Output */ - -/* The function returns the value TRUE if the file is open, FALSE */ -/* otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the filename is blank, the error SPICE(BLANKFILENAME) will */ -/* be signalled. */ - -/* 2) If an error occurs during the execution of the Fortran INQUIRE */ -/* statement, the error SPICE(INQUIREFAILED) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Use the Fortran INQUIRE statement to determine the open status */ -/* of FILE. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of ISOPEN. */ - -/* IF ( .NOT. ISOPEN ( FILE ) ) THEN */ -/* Open the file here */ -/* ELSE */ -/* ERROR = 'Input file is already open.' */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* Added a local logical variable that is used as temporary */ -/* storage for the results from the INQUIRE statement rather */ -/* than using the function name. This solved a problem on the */ -/* macintosh. */ - -/* - SPICELIB Version 1.0.0, 05-OCT-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* test for file already open */ -/* is a file open */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("ISOPEN", (ftnlen)6); - } - -/* First we test to see if the filename is blank. */ - - if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) { - ret_val = FALSE_; - setmsg_("The file name is blank. ", (ftnlen)24); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("ISOPEN", (ftnlen)6); - return ret_val; - } - -/* So simple, it defies explanation. */ - - ioin__1.inerr = 1; - ioin__1.infilen = file_len; - ioin__1.infile = file; - ioin__1.inex = &exists; - ioin__1.inopen = &myopen; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - ret_val = FALSE_; - setmsg_("Value of IOSTAT was *.", (ftnlen)22); - errint_("*", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("ISOPEN", (ftnlen)6); - return ret_val; - } - -/* A file cannot be open if it does not exist. We do actually need to */ -/* check this because some operating environments return .TRUE. for */ -/* the value of OPENED if a file does not exist. */ - - if (! exists) { - myopen = FALSE_; - } - -/* Set the function value, check out, and return. */ - - ret_val = myopen; - chkout_("ISOPEN", (ftnlen)6); - return ret_val; -} /* isopen_ */ - diff --git a/ext/spice/src/cspice/isordv.c b/ext/spice/src/cspice/isordv.c deleted file mode 100644 index 617d8bc6d7..0000000000 --- a/ext/spice/src/cspice/isordv.c +++ /dev/null @@ -1,297 +0,0 @@ -/* isordv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ISORDV ( Is it an order vector ) */ -logical isordv_(integer *array, integer *n) -{ - /* System generated locals */ - integer i__1, i__2; - logical ret_val; - - /* Local variables */ - integer i__, j; - -/* $ Abstract */ - -/* Determine whether an array of N items contains the integers */ -/* 1 through N. */ - -/* $ 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 */ -/* SORT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Array of integers. */ -/* N I Number of integers in ARRAY. */ - -/* The function returns TRUE if the array contains the integers */ -/* 1 through N, otherwise it returns FALSE. */ - -/* $ Detailed_Input */ - -/* ARRAY is an array of integers. Often this will be an array */ -/* that is a candidate order vector to be passed to */ -/* a routine for re-ordering some parallel array. */ - -/* N is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if the array contains the integers */ -/* 1 through N. Otherwise it returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If N < 1, the function returns .FALSE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function provides a simple means of determining whether */ -/* or not an array of N integers contains exactly the integers */ -/* 1 through N. */ - -/* $ Examples */ - -/* 1) Suppose you wished to reorder an array of strings based upon */ -/* a ranking array supplied by a user. If the ranking array */ -/* contains any duplicates or refers to indices that are out */ -/* of the range of valid indices for the array of strings, */ -/* the attempt to reorder the array of strings cannot succeed. */ -/* Its usually better to detect such a possibility before */ -/* you begin trying to reorder the array of strings. This routine */ -/* will detect the error. */ - -/* The block of code below illustrates this idea. */ - - -/* IF ( ISORDV ( ORDVEC, N ) ) THEN */ - -/* ...reorder the input array of strings */ - -/* CALL REORDC ( ORDVEC, N, STRNGS ) */ - -/* ELSE */ - -/* ...state the problem and let the user decide what */ -/* to do about it. */ -/* . */ -/* . */ -/* . */ - -/* END IF */ - - -/* 2) This routine can also be used to determine whether or not an */ -/* array contains every integer between K and N (where K < N ). */ - - -/* First subtract K-1 from each integer */ - -/* DO I = 1, N-K+1 */ -/* ARRAY(I) = ARRAY(I) - K + 1 */ -/* END DO */ - -/* See if the modified array is an order vector */ - -/* OK = ISORDV ( ARRAY, N-K ) */ - -/* Return the array to its original state. */ - -/* DO I = 1, N-K+1 */ -/* ARRAY(I) = ARRAY(I) + K - 1 */ -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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, 6-MAR-1991 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether an integer array is an order vector */ - -/* -& */ - -/* Local variables */ - - -/* Let's take care of the goofy case first. */ - - if (*n < 1) { - ret_val = FALSE_; - return ret_val; - } else if (*n == 1) { - ret_val = array[0] == 1; - return ret_val; - } - -/* Make an initial pass through the array to be sure we */ -/* have legitimate values. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (array[i__ - 1] < 1 || array[i__ - 1] > *n) { - ret_val = FALSE_; - return ret_val; - } - } - -/* Ok. All of the values are in range. We just need to check */ -/* that this array could actually be used as an order vector. */ - -/* For each I between 1 and N, ARRAY(I) is some integer between 1 */ -/* and N. The only question remaining is whether the set */ -/* { ARRAY(I), I=1,N } contains every integer between 1 and N. */ - -/* Suppose for a moment we could allocate a logical array called HITS */ - -/* LOGICAL HITS(N) */ - -/* Then the following scheme could be used to determine whether or */ -/* not { ARRAY(I), I=1,N } contains every integer between 1 and N. */ - -/* Initialize every entry of HITS to .FALSE. */ - -/* DO I = 1, N */ -/* HITS(I) = .FALSE. */ -/* END DO */ - -/* Then for each I set HITS(ARRAY(I)) to .TRUE. */ - -/* DO I = 1, N */ -/* HITS(ARRAY(I)) = .TRUE. */ -/* END DO */ - -/* What can be said about HITS at this point? If for any entry J, */ -/* HITS(J) is true then some ARRAY(I) is equal to J. */ - -/* If all HITS are .TRUE. then {ARRAY(I), I=1,N} is in fact the */ -/* set of integers 1 to N. Otherwise those J such that */ -/* HITS(J) = .FALSE. are the integers between 1 and N that are */ -/* missed by ARRAY. */ - -/* It turns out we don't need to allocate an array of logicals; */ -/* we can use just use part of the input array, ARRAY. */ - -/* The storage locations ARRAY(1) through ARRAY(N) can be viewed */ -/* as two parallel arrays: SIGN_BIT and UNSIGNED */ - -/* SIGN */ -/* BIT UNSIGNED PORTION */ -/* +----+-----------------+ */ -/* 1 | | | */ -/* +----+-----------------+ */ -/* 2 | | | */ -/* +----+-----------------+ */ -/* 3 | | | */ -/* +----+-----------------+ */ - -/* . */ -/* . */ -/* . */ - -/* +----+-----------------+ */ -/* N-1 | | | */ -/* +----+-----------------+ */ -/* N | | | */ -/* +----+-----------------+ */ - - -/* Since we know the value of all of the sign bits (it's '+') we can */ -/* alter them and then reset them once we are done. */ - -/* We will choose for our array of HITS the SIGN_BITS of ARRAY. */ -/* We regard '+' as FALSE and '-' as TRUE. */ - -/* DO I = 1, N */ -/* SIGN_BIT ( UNSIGNED(I) ) = '-' */ -/* END DO */ - -/* Then check to make sure that all of the sign bits are '-'. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - j = (i__2 = array[i__ - 1], abs(i__2)); - array[j - 1] = -array[j - 1]; - } - -/* Check each item to see if it's been hit. */ - - ret_val = TRUE_; - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - ret_val = ret_val && array[i__ - 1] < 0; - array[i__ - 1] = (i__2 = array[i__ - 1], abs(i__2)); - } - return ret_val; -} /* isordv_ */ - diff --git a/ext/spice/src/cspice/isordv_c.c b/ext/spice/src/cspice/isordv_c.c deleted file mode 100644 index bfcd813de8..0000000000 --- a/ext/spice/src/cspice/isordv_c.c +++ /dev/null @@ -1,245 +0,0 @@ -/* - --Procedure isordv_c ( Is array an order vector? ) - --Abstract - - Determine whether an array of n items contains the integers - 0 through n-1. - --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 - SORT - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef isordv_c - - SpiceBoolean isordv_c ( ConstSpiceInt * array, - SpiceInt n ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - array I Array of integers. - n I Number of integers in array. - - The function returns SPICETRUE if the array contains the integers - 0 through n-1, otherwise it returns SPICEFALSE. - --Detailed_Input - - array is an array of integers. Often this will be an array - that is a candidate order vector to be passed to - a routine for re-ordering some parallel array. - - n is the number of elements in array. - --Detailed_Output - - The function returns SPICETRUE if the array contains the integers - 1 through n. Otherwise it returns SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If n < 1, the function returns SPICEFALSE. - - 2) If memory is not available to create a local copy of the order - vector, the error SPICE(MALLOCFAILED) is signaled. - --Files - - None. - --Particulars - - This function provides a simple means of determining whether - or not an array of n integers contains exactly the integers - 0 through n-1. An array with this property is called an - "order vector." Order vectors are returned by the CSPICE - routines - - orderc_c - orderd_c - orderi_c - - and are accepted as input by the CSPICE routines - - reordc_c - reordd_c - reordi_c - reordl_c - --Examples - - 1) Suppose you wished to reorder an array of strings based upon - a ranking array supplied by a user. If the ranking array - contains any duplicates or refers to indices that are out - of the range of valid indices for the array of strings, - the attempt to reorder the array of strings cannot succeed. - Its usually better to detect such a possibility before - you begin trying to reorder the array of strings. This routine - will detect the error. - - The code fragment below illustrates this idea. - - #include "SpiceUsr.h" - . - . - . - - if ( isordv_c ( ordvec, n ) ) - { - ...reorder the input array of strings - - reordc_c ( ordvec, n, lenvals, strings ); - } - else - { - ...state the problem and let the user decide what - to do about it. - . - . - . - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 16-FEB-2005 (NJB) - - Bug fix: dynamic memory is now freed. - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) (IMU) - --Index_Entries - - test whether an integer array is an order vector - --& -*/ - -{ /* Begin isordv_c */ - - - /* - Local variables - */ - SpiceBoolean retval; - - SpiceInt i; - SpiceInt vSize; - SpiceInt * ordvec; - - - - - /* - This routine uses discovery check-in. - - Initialize the return value. - */ - retval = SPICEFALSE; - - /* - Nothing to check if the array is empty. - */ - if ( n < 1 ) - { - return ( retval ); - } - - /* - Get a local copy of the input array; increment each element - of this local array. If the array is a C-style order vector, this - operation maps the vector to Fortran style. - */ - vSize = n * sizeof(SpiceInt); - - ordvec = (SpiceInt *) malloc( vSize ); - - if ( ordvec == 0 ) - { - chkin_c ( "isordv_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", vSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "isordv_c" ); - return ( retval ); - } - - for ( i = 0; i < n; i++ ) - { - ordvec[i] = array[i] + 1; - } - - - retval = (SpiceBoolean) isordv_ ( (integer *) ordvec, - (integer *) &n ); - - free ( ordvec ); - - return ( retval ); - -} /* End isordv_c */ - - - - - diff --git a/ext/spice/src/cspice/isrchc.c b/ext/spice/src/cspice/isrchc.c deleted file mode 100644 index 3dd5221209..0000000000 --- a/ext/spice/src/cspice/isrchc.c +++ /dev/null @@ -1,155 +0,0 @@ -/* isrchc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ISRCHC ( Search in a character array ) */ -integer isrchc_(char *value, integer *ndim, char *array, ftnlen value_len, - ftnlen array_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Search for a given value within a character string array. Return */ -/* the index of the first matching array entry, or zero if the key */ -/* value was not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Key value to be found in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Character string array to search. */ - -/* The function returns the index of the first matching array */ -/* element or zero if the value is not found. */ - -/* $ Detailed_Input */ - -/* VALUE is the key value to be found in the array. */ - -/* NDIM is the dimension of the array. */ - -/* ARRAY is the character array to be searched. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the first matching array */ -/* element in ARRAY. If VALUE is not found, ISRCHC is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following table shows the value of ISRCHC given the contents */ -/* of ARRAY and VALUE: */ - -/* ARRAY VALUE ISRCHC */ -/* ----------------- ----- ------ */ -/* '1', '0', '4', '2' '4' 3 */ -/* '1', '0', '4', '2' '2' 4 */ -/* '1', '0', '4', '2' '3' 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the function value is zero. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* search in a character array */ - -/* -& */ - -/* Local variables */ - - ret_val = 0; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(array + (i__ - 1) * array_len, value, array_len, value_len) - == 0) { - ret_val = i__; - return ret_val; - } - } - return ret_val; -} /* isrchc_ */ - diff --git a/ext/spice/src/cspice/isrchc_c.c b/ext/spice/src/cspice/isrchc_c.c deleted file mode 100644 index 02a2a44a78..0000000000 --- a/ext/spice/src/cspice/isrchc_c.c +++ /dev/null @@ -1,239 +0,0 @@ -/* - --Procedure isrchc_c ( Search in a character array ) - --Abstract - - Search for a given value within a character string array. Return - the index of the first matching array entry, or -1 if the key - value was not found. - --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 - - ARRAY, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "f2cMang.h" - #undef isrchc_c - - - SpiceInt isrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Key value to be found in array. - ndim I Dimension of array. - lenvals I String length. - array I Character string array to search. - - The function returns the index of the first matching array - element or -1 if the value is not found. - --Detailed_Input - - value is the key value to be found in the array. Trailing - blanks in this key are not significant: string matches - found by this routine do not require trailing blanks in - value to match those in the corresponding element of - array. - - ndim 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 - - [ndim][lenvals] - - array is the array of character srings to be searched. Trailing - blanks in the strings in this array are not significant. - --Detailed_Output - - The function returns the index of the first matching array - element in array. If value is not found, isrchc_c 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 - - None. - --Examples - - The following table shows the value of isrchc_c given the contents - of array and value: - - array value isrchc_c - ----------------- ----- -------- - "1", "0", "4", "2" "4" 2 - "1", "0", "4", "2" "2" 3 - "1", "0", "4", "2" "3" -1 - --Restrictions - - 1) 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. - - None. - --Literature_References - - None - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (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. - - Header sections were re-ordered. - - -CSPICE Version 1.0.0, 22-JUL-2002 (NJB) (WMO) - --Index_Entries - - search in a character array - --& -*/ - -{ /* Begin isrchc_c */ - - - /* - f2c library utility prototypes - */ - extern integer s_cmp (char *a, char *b, ftnlen la, ftnlen lb ); - - /* - Local macros - */ - #define ARRAY( i ) ( ( (SpiceChar *)array ) + i*lenvals ) - - /* - Local variables - */ - SpiceInt i; - - - /* - Use discovery check-in. - - Return immediately if the array dimension is non-positive. - */ - if ( ndim < 1 ) - { - return ( -1 ); - } - - - /* - Make sure the input pointer for the key value is non-null - and that the length is adequate. - */ - CHKPTR_VAL ( CHK_DISCOVER, "isrchc_c", value, -1 ); - - - /* - Make sure the input pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR_VAL ( CHK_DISCOVER, "isrchc_c", array, lenvals, -1 ); - - - for ( i = 0; i < ndim; i++ ) - { - if ( s_cmp ( (char *) value, - (char *) ARRAY(i), - (ftnlen ) strlen(value), - (ftnlen ) strlen(ARRAY(i)) ) == 0 ) - { - return ( i ); - } - } - - /* - Indicate no match was found. - */ - return ( -1 ); - - -} /* End isrchc_c */ - diff --git a/ext/spice/src/cspice/isrchd.c b/ext/spice/src/cspice/isrchd.c deleted file mode 100644 index 67f40700b0..0000000000 --- a/ext/spice/src/cspice/isrchd.c +++ /dev/null @@ -1,155 +0,0 @@ -/* isrchd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ISRCHD ( Search in a double precision array ) */ -integer isrchd_(doublereal *value, integer *ndim, doublereal *array) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Search for a given value within a double precision array. Return */ -/* the index of the first matching array entry, or zero if the key */ -/* value was not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Key value to be found in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Double precision array to search. */ - -/* The function returns the index of the first matching array */ -/* element or zero if the value is not found. */ - -/* $ Detailed_Input */ - -/* VALUE is the key value to be found in the array. */ - -/* NDIM is the dimension of the array. */ - -/* ARRAY is the double precision array to be searched. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the first matching array */ -/* element in ARRAY. If VALUE is not found, ISRCHD is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following table shows the value of ISRCHD given the contents */ -/* of ARRAY and VALUE: */ - -/* ARRAY VALUE ISRCHD */ -/* --------------------------- ----- ------ */ -/* 1.0D0, 0.0D0, 4.0D0, 2.0D0 4.0D0 3 */ -/* 1.0D0, 0.0D0, 4.0D0, 2.0D0 2.OD0 4 */ -/* 1.0D0, 0.0D0, 4.0D0, 2.0D0 3.0D0 0 */ - -/* $ Restrictions */ - -/* CAUTION must be exercised when comparing floating point numbers */ -/* for equality. If the numbers in ARRAY or the number in VALUE */ -/* are the result of computations, then it is likely that strict */ -/* equality between VALUE and some element of ARRAY will NOT hold */ -/* (even if the two numbers are very close) unless the numbers are */ -/* the result of exactly the same computations. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the function value is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* search in a d.p. array */ - -/* -& */ - -/* Local variables */ - - ret_val = 0; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if (array[i__ - 1] == *value) { - ret_val = i__; - return ret_val; - } - } - return ret_val; -} /* isrchd_ */ - diff --git a/ext/spice/src/cspice/isrchd_c.c b/ext/spice/src/cspice/isrchd_c.c deleted file mode 100644 index fa6b54ea86..0000000000 --- a/ext/spice/src/cspice/isrchd_c.c +++ /dev/null @@ -1,157 +0,0 @@ -/* - --Procedure isrchd_c ( Search in a double precision array ) - --Abstract - - Search for a given value within a double precision array. Return - the index of the first matching array entry, or -1 if the key value - was not found. - --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 - - ARRAY, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef isrchd_c - - SpiceInt isrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Key value to be found in array. - ndim I Dimension of array. - array I Double Precision array to search. - - The function returns the index of the first matching array - element or -1 if the value is not found. - --Detailed_Input - - value is the key value to be found in the array. - - ndim is the dimension of the array. - - array is the double precision array to be searched. - --Detailed_Output - - The function returns the index of the first matching array - element in array. If value is not found, isrchd_c returns -1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If ndim < 1, the function value is -1. - --Particulars - - None. - --Examples - - The following table shows the value of isrchd_c given the contents - of array and value: - - - array value isrchd_c - -------------------------- ----- -------- - 1.0D0, 0.0D0, 4.0D0, 2.0D0 4.0D0 2 - 1.0D0, 0.0D0, 4.0D0, 2.0D0 2.OD0 3 - 1.0D0, 0.0D0, 4.0D0, 2.0D0 3.0D0 -1 - --Restrictions - - None. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-JUL-2002 (NJB) (WMO) - --Index_Entries - - search in an double precision array - --& -*/ - -{ /* Begin isrchd_c */ - - /* - Local variables - */ - SpiceInt loc ; - - - /* - Call the f2c'd routine. - */ - loc = (SpiceInt) isrchd_ ( (doublereal *) &value, - (integer *) &ndim, - (doublereal *) array ); - - /* - Convert loc to a C-style index. - */ - loc-- ; - - return ( loc ); - -} /* End isrchd_c */ diff --git a/ext/spice/src/cspice/isrchi.c b/ext/spice/src/cspice/isrchi.c deleted file mode 100644 index 6b5d9caadd..0000000000 --- a/ext/spice/src/cspice/isrchi.c +++ /dev/null @@ -1,150 +0,0 @@ -/* isrchi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ISRCHI ( Search in an integer array ) */ -integer isrchi_(integer *value, integer *ndim, integer *array) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Search for a given value within a integer array. Return */ -/* the index of the first matching array entry, or zero if */ -/* the key value was not found. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Key value to be found in ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I Integer array to search. */ - -/* The function returns the index of the first matching array */ -/* element or zero if the value is not found. */ - -/* $ Detailed_Input */ - -/* VALUE is the key value to be found in the array. */ - -/* NDIM is the dimension of the array. */ - -/* ARRAY is the integer array to be searched. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the first matching array */ -/* element in ARRAY. If VALUE is not found, ISRCHI is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following table shows the value of ISRCHI given the contents */ -/* of ARRAY and VALUE: */ - -/* ARRAY VALUE ISRCHI */ -/* ---------- ----- ------ */ -/* 1, 0, 4, 2 4 3 */ -/* 1, 0, 4, 2 2 4 */ -/* 1, 0, 4, 2 3 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NDIM < 1 the function value is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* search in an integer array */ - -/* -& */ - -/* Local variables */ - - ret_val = 0; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if (array[i__ - 1] == *value) { - ret_val = i__; - return ret_val; - } - } - return ret_val; -} /* isrchi_ */ - diff --git a/ext/spice/src/cspice/isrchi_c.c b/ext/spice/src/cspice/isrchi_c.c deleted file mode 100644 index c9c87fe899..0000000000 --- a/ext/spice/src/cspice/isrchi_c.c +++ /dev/null @@ -1,156 +0,0 @@ -/* - --Procedure isrchi_c ( Search in an integer array ) - --Abstract - - Search for a given value within an integer array. Return - the index of the first matching array entry, or -1 if the key - value was not found. - --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 - - ARRAY, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef isrchi_c - - SpiceInt isrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - value I Key value to be found in array. - ndim I Dimension of array. - array I Integer array to search. - - The function returns the index of the first matching array - element or -1 if the value is not found. - --Detailed_Input - - value is the key value to be found in the array. - - ndim is the dimension of the array. - - array is the integer array to be searched. - --Detailed_Output - - The function returns the index of the first matching array - element in array. If value is not found, isrchi_c returns -1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If ndim < 1, the function value is -1. - --Files - - None. - --Particulars - - None. - --Examples - - The following table shows the value of isrchi_c given the contents - of ARRAY and VALUE: - - ARRAY VALUE isrchi_c - ---------- ----- -------- - 1, 0, 4, 2 4 2 - 1, 0, 4, 2 2 3 - 1, 0, 4, 2 3 -1 - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2000 (NJB) (WMO) - --Index_Entries - - search in an integer array - --& -*/ - -{ /* Begin isrchi_c */ - - /* - Local variables - */ - SpiceInt loc ; - - - /* - Call the f2c'd routine. - */ - loc = (SpiceInt) isrchi_ ( (integer *) &value, - (integer *) &ndim, - (integer *) array ); - - /* - Convert loc to a C-style index. - */ - loc-- ; - - return ( loc ); - -} /* End isrchi_c */ diff --git a/ext/spice/src/cspice/isrot.c b/ext/spice/src/cspice/isrot.c deleted file mode 100644 index 420bcae955..0000000000 --- a/ext/spice/src/cspice/isrot.c +++ /dev/null @@ -1,296 +0,0 @@ -/* isrot.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ISROT ( Indicate whether a matrix is a rotation matrix ) */ -logical isrot_(doublereal *m, doublereal *ntol, doublereal *dtol) -{ - /* System generated locals */ - doublereal d__1, d__2, d__3, d__4, d__5, d__6; - logical ret_val; - - /* Local variables */ - doublereal unit[9] /* was [3][3] */, d__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical detok; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal n1, n2, n3; - extern /* Subroutine */ int unorm_(doublereal *, doublereal *, doublereal - *); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - logical normok; - extern logical return_(void); - extern doublereal det_(doublereal *); - -/* $ Abstract */ - -/* Indicate whether a 3x3 matrix is a rotation matrix. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* ERROR */ -/* MATRIX */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* M I A matrix to be tested. */ -/* NTOL I Tolerance for the norms of the columns of M. */ -/* DTOL I Tolerance for the determinant of a matrix whose */ -/* columns are the unitized columns of M. */ - -/* The function returns the value .TRUE. if and only if M is */ -/* a rotation matrix. */ - -/* $ Detailed_Input */ - -/* M is a 3x3 matrix to be tested. */ - -/* NTOL is the tolerance for the norms of the columns */ -/* of M. */ - -/* DTOL is the tolerance for the determinant of a matrix */ -/* whose columns are the unitized columns of M. */ - -/* $ Detailed_Output */ - -/* The function returns the value .TRUE. if and only if M is found */ -/* to be a rotation matrix. The criteria that M must meet are: */ - - -/* 1) The norm of each column of M must satisfy the relation */ - -/* 1.D0 - NTOL < || column || < 1.D0 + NTOL. */ -/* - - */ - -/* 2) The determinant of the matrix whose columns are the */ -/* unitized columns of M must satisfy */ - -/* 1.D0 - DTOL < determinant < 1.D0 + DTOL. */ -/* - - */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of NTOL or DTOL is negative, the error */ -/* SPICE(VALUEOUTOFRANGE) is signalled. ISROT returns the */ -/* value .FALSE. in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is an error checking `filter'; its purpose is to */ -/* detect gross errors, such as uninitialized matrices. Matrices */ -/* that do not pass the tests used by this routine hardly qualify as */ -/* rotation matrices. The test criteria can be adjusted by varying */ -/* the parameters NTOL and DTOL. */ - -/* A property of rotation matrices is that their columns form a */ -/* right-handed, orthonormal basis in 3-dimensional space. The */ -/* converse is true: all 3x3 matrices with this property are */ -/* rotation matrices. */ - -/* An ordered set of three vectors V1, V2, V3 forms a right-handed, */ -/* orthonormal basis if and only if */ - -/* 1) || V1 || = || V2 || = || V3 || = 1 */ - -/* 2) V3 = V1 x V2. Since V1, V2, and V3 are unit vectors, */ -/* we also have */ - -/* < V3, V1 x V2 > = 1. */ - -/* This quantity is the determinant of the matrix whose */ -/* colums are V1, V2 and V3. */ - -/* When finite precision numbers are used, rotation matrices will */ -/* usually fail to satisfy these criteria exactly. We must use */ -/* criteria that indicate approximate conformance to the criteria */ -/* listed above. We choose */ - -/* 1) | || Vi || - 1 | < NTOL, i = 1, 2, 3. */ -/* - */ - -/* 2) Let */ - -/* Vi */ -/* Ui = ------ , i = 1, 2, 3. */ -/* ||Vi|| */ - -/* Then we require */ - -/* | < U3, U1 x U2 > - 1 | < DTOL; */ -/* - */ - -/* equivalently, letting U be the matrix whose columns */ -/* are U1, U2, and U3, we insist on */ - -/* | det(U) - 1 | < DTOL. */ -/* _ */ -/* $ Examples */ - -/* 1) We have obtained an instrument pointing matrix C from a */ -/* C-kernel, and we wish to test whether it is in fact a */ -/* rotation matrix. We can use ISROT to check this: */ - -/* C */ -/* C Obtain pointing matrix: */ -/* C */ -/* CALL CKGP ( INST, TIMEIN, TOL, REF, C, TIMOUT, FOUND ) */ - -/* C */ -/* C Verify that C is a rotation: */ -/* C */ -/* IF ( .NOT. ISROT ( C ) ) THEN */ - -/* [ perform exception handling ] */ - -/* ELSE */ - -/* [ code for the normal case goes here ] */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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, 06-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* indicate whether a matrix is a rotation matrix */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("ISROT", (ftnlen)5); - } - -/* Tolerances must be non-negative. */ - - if (*ntol < 0.) { - ret_val = FALSE_; - setmsg_("NTOL should be non-negaitve; it is #.", (ftnlen)37); - errdp_("#", ntol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ISROT", (ftnlen)5); - return ret_val; - } else if (*dtol < 0.) { - ret_val = FALSE_; - setmsg_("DTOL should be non-negaitve; it is #.", (ftnlen)37); - errdp_("#", dtol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ISROT", (ftnlen)5); - return ret_val; - } - -/* The columns of M must resemble unit vectors. If the norms are */ -/* outside of the allowed range, M is not a rotation matrix. */ - -/* Also, the columns of M are required to be pretty nearly */ -/* orthogonal. The discrepancy is gauged by taking the determinant */ -/* of the matrix UNIT, computed below, whose columns are the */ -/* unitized columns of M. */ - - unorm_(m, unit, &n1); - unorm_(&m[3], &unit[3], &n2); - unorm_(&m[6], &unit[6], &n3); - d__ = det_(unit); - d__1 = 1. - *ntol; - d__2 = *ntol + 1.; - d__3 = 1. - *ntol; - d__4 = *ntol + 1.; - d__5 = 1. - *ntol; - d__6 = *ntol + 1.; - normok = n1 == brcktd_(&n1, &d__1, &d__2) && n2 == brcktd_(&n2, &d__3, & - d__4) && n3 == brcktd_(&n3, &d__5, &d__6); - d__1 = 1. - *dtol; - d__2 = *dtol + 1.; - detok = d__ == brcktd_(&d__, &d__1, &d__2); - if (normok && detok) { - ret_val = TRUE_; - } else { - ret_val = FALSE_; - } - chkout_("ISROT", (ftnlen)5); - return ret_val; -} /* isrot_ */ - diff --git a/ext/spice/src/cspice/isrot_c.c b/ext/spice/src/cspice/isrot_c.c deleted file mode 100644 index 9a2faee576..0000000000 --- a/ext/spice/src/cspice/isrot_c.c +++ /dev/null @@ -1,285 +0,0 @@ -/* - --Procedure isrot_c ( Indicate whether a matrix is a rotation matrix ) - --Abstract - - Indicate whether a 3x3 matrix is a rotation matrix. - --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 - - ROTATION - --Keywords - - ERROR - MATRIX - ROTATION - -*/ - - #include "SpiceUsr.h" - #undef isrot_c - - - SpiceBoolean isrot_c ( ConstSpiceDouble m [3][3], - SpiceDouble ntol, - SpiceDouble dtol ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - m I A matrix to be tested. - ntol I Tolerance for the norms of the columns of m. - dtol I Tolerance for the determinant of a matrix whose - columns are the unitized columns of m. - - The function returns the value SPICETRUE if and only if m is - a rotation matrix. - --Detailed_Input - - m is a 3x3 matrix to be tested. - - ntol is the tolerance for the norms of the columns - of m. - - dtol is the tolerance for the determinant of a matrix - whose columns are the unitized columns of m. - --Detailed_Output - - The function returns the value SPICETRUE if and only if m is found - to be a rotation matrix. The criteria that m must meet are: - - - 1) The norm of each column of m must satisfy the relation - - 1. - ntol < || column || < 1. + ntol. - - - - - 2) The determinant of the matrix whose columns are the - unitized columns of m must satisfy - - 1. - dtol < determinant < 1. + dtol. - - - --Parameters - - None. - --Exceptions - - 1) If either of ntol or dtol is negative, the error - SPICE(VALUEOUTOFRANGE) is signaled. isrot_c returns the - value SPICEFALSE in this case. - --Files - - None. - --Particulars - - This routine is an error checking "filter"; its purpose is to - detect gross errors, such as uninitialized matrices. Matrices - that do not pass the tests used by this routine hardly qualify as - rotation matrices. The test criteria can be adjusted by varying - the parameters ntol and dtol. - - A property of rotation matrices is that their columns form a - right-handed, orthonormal basis in 3-dimensional space. The - converse is true: all 3x3 matrices with this property are - rotation matrices. - - An ordered set of three vectors V1, V2, V3 forms a right-handed, - orthonormal basis if and only if - - 1) || V1 || = || V2 || = || V3 || = 1 - - 2) V3 = V1 x V2. Since V1, V2, and V3 are unit vectors, - we also have - - < V3, V1 x V2 > = 1. - - This quantity is the determinant of the matrix whose - columns are V1, V2 and V3. - - When finite precision numbers are used, rotation matrices will - usually fail to satisfy these criteria exactly. We must use - criteria that indicate approximate conformance to the criteria - listed above. We choose - - 1) | || Vi || - 1 | < ntol, i = 1, 2, 3. - - - - 2) Let - - Vi - Ui = ------ , i = 1, 2, 3. - ||Vi|| - - Then we require - - | < U3, U1 x U2 > - 1 | < dtol; - - - - equivalently, letting U be the matrix whose columns - are U1, U2, and U3, we insist on - - | det(U) - 1 | < dtol. - _ --Examples - - 1) We have obtained an instrument pointing matrix C from a - C-kernel, and we wish to test whether it is in fact a - rotation matrix. We can use isrot_c to check this: - - #include "SpiceUsr.h" - . - . - . - /. - Obtain pointing matrix: - ./ - ckgp_c ( inst, timein, tol, ref, c, &timout, &found ); - - - /. - Verify that c is a rotation: - ./ - - if ( !isrot_c( c ) ) - { - - [ perform exception handling ] - - } - else - { - - [ code for the normal case goes here ] - - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - --Version - - -CSPICE Version 1.0.0, 16-AUG-1999 (NJB) (HAN) - --Index_Entries - - indicate whether a matrix is a rotation matrix - --& -*/ - -{ /* Begin isrot_c */ - - - /* - Local variables - */ - SpiceBoolean detok; - SpiceBoolean normok; - - SpiceDouble d; - SpiceDouble mtrans[3][3]; - SpiceDouble n0; - SpiceDouble n1; - SpiceDouble n2; - SpiceDouble unit [3][3]; - - - - /* - Tolerances must be non-negative. - */ - if ( ntol < 0.0 ) - { - chkin_c ( "isrot_c" ); - setmsg_c ( "ntol should be non-negative; it is #." ); - errdp_c ( "#", ntol ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "isrot_c" ); - return ( SPICEFALSE ); - } - else if ( dtol < 0.0 ) - { - chkin_c ( "isrot_c" ); - setmsg_c ( "dtol should be non-negative; it is #." ); - errdp_c ( "#", dtol ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "isrot_c" ); - return ( SPICEFALSE ); - } - - - /* - The columns of m must resemble unit vectors. If the norms are - outside of the allowed range, m is not a rotation matrix. - - Also, the columns of m are required to be pretty nearly - orthogonal. The discrepancy is gauged by taking the determinant - of the matrix unit, computed below, whose columns are the - unitized columns of m. - */ - - xpose_c ( m, mtrans ); - - unorm_c ( mtrans[0], unit[0], &n0 ); - unorm_c ( mtrans[1], unit[1], &n1 ); - unorm_c ( mtrans[2], unit[2], &n2 ); - - - normok = ( n0 == brcktd_c ( n0, 1.0 - ntol, 1.0 + ntol ) ) - && ( n1 == brcktd_c ( n1, 1.0 - ntol, 1.0 + ntol ) ) - && ( n2 == brcktd_c ( n2, 1.0 - ntol, 1.0 + ntol ) ); - - d = det_c ( unit ); - detok = ( d == brcktd_c ( d, 1.0 - dtol, 1.0 + dtol ) ); - - - return ( normok && detok ); - - -} /* End isrot_c */ diff --git a/ext/spice/src/cspice/iswhsp_c.c b/ext/spice/src/cspice/iswhsp_c.c deleted file mode 100644 index 9612ca9377..0000000000 --- a/ext/spice/src/cspice/iswhsp_c.c +++ /dev/null @@ -1,205 +0,0 @@ -/* - --Procedure iswhsp_c ( Determine whether a string is white space ) - --Abstract - - Return a boolean value indicating whether a string contains - only white space characters. - --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 - - FILES, TEXT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceBoolean iswhsp_c ( ConstSpiceChar * string ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - string I String to be tested. - - The function returns the boolean value SPICETRUE if the string is - empty or contains only white space characters; otherwise it returns - the value SPICEFALSE. - --Detailed_Input - - string is a character pointer designating a string to be - searched for non-white-space characters. - --Detailed_Output - - The function returns the boolean value SPICETRUE if the string - contains only white space characters; otherwise it returns the - value SPICEFALSE. - - White space characters are those in the set - - { ' ', '\f', '\n', '\r', '\t', '\v' } - - --Parameters - - None. - --Exceptions - - 1) If the input string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 2) An empty string, that is a string with a null character - at index 0, is considered to be blank. - --Files - - None. - --Particulars - - This routine provides a short cut for testing lines for the presence - of non-blank characters; this is a test which is performed frequently - in CSPICE. - --Examples - - 1) Read a text file; print the non-blank lines. - - #include - #include "SpiceUsr.h" - - void main() - { - #define MAXLEN 82 - - FILE *fptr; - SpiceBoolean eof; - SpiceChar line [MAXLEN]; - - - txtopr_c ( "myfile", &fptr ); - - readln_c ( fptr, MAXLEN, line, &eof ); - - while ( !eof ) - { - if ( !iswhsp_c(line) ) - { - printf ( "%s\n", line ); - } - - readln_c ( fptr, MAXLEN, line, &eof ); - } - } - --Restrictions - - None. - --Literature_References - - 1) "American National Standard for Programming Languages -- C," - Published by the American National Standards Institute, 1990. - Section 7.3.1.9., p. 104. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 27-AUG-1999 (NJB) - - Now checks for null input string. - - -CSPICE Version 1.0.0, 24-FEB-1999 (NJB) - - Arguments passed to isspace are now cast to unsigned char to - suppress compilation warnings on some systems. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - --Index_Entries - - read a non-blank line from a text file - --& -*/ - -{ /* Begin iswhsp_c */ - - - /* - Local variables - */ - SpiceBoolean blank; - ConstSpiceChar * sptr; - - - /* - Check the input string pointer to make sure it's non-null. - */ - CHKPTR_VAL ( CHK_DISCOVER, "iswhsp_c", string, SPICEFALSE ); - - - /* - Start out assuming the string is blank. If the string is empty, - we've got the right return value already. - */ - - blank = SPICETRUE; - sptr = string; - - while ( blank && ( (SpiceBoolean) *sptr ) ) - { - if ( !isspace( (unsigned char) *sptr ) ) - { - blank = SPICEFALSE; - } - - sptr++; - } - - - return ( blank ); - - -} /* End iswhsp_c */ diff --git a/ext/spice/src/cspice/j1900.c b/ext/spice/src/cspice/j1900.c deleted file mode 100644 index e718b5a74d..0000000000 --- a/ext/spice/src/cspice/j1900.c +++ /dev/null @@ -1,126 +0,0 @@ -/* j1900.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure J1900 ( Julian Date of 1900.0 JAN 0.5 ) */ -doublereal j1900_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the Julian Date of 1899 DEC 31 12:00:00 (1900 JAN 0.5). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the Julian Date of 1899 DEC 31 12:00:00 */ -/* (1900 JAN 0.5). */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns 2415020.0, the Julian Date corresponding */ -/* to 1899 DEC 31 12:00:00 (1900 JAN 0.5). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of J1900. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (J1900). */ -/* C */ -/* SPREF = ( JD - J1900() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* julian date of 1900.0 jan 0.5 */ - -/* -& */ - ret_val = 2415020.; - return ret_val; -} /* j1900_ */ - diff --git a/ext/spice/src/cspice/j1900_c.c b/ext/spice/src/cspice/j1900_c.c deleted file mode 100644 index 93b5621949..0000000000 --- a/ext/spice/src/cspice/j1900_c.c +++ /dev/null @@ -1,120 +0,0 @@ -/* - --Procedure j1900_c ( Julian Date of 1900.0 JAN 0.5 ) - --Abstract - - Return the Julian Date of 1899 DEC 31 12:00:00 (1900 JAN 0.5). - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble j1900_c ( void ) - -/* - --Brief_I/O - - The function returns the Julian Date of 1899 DEC 31 12:00:00 - (1900 JAN 0.5). - --Detailed_Input - - None. - --Detailed_Output - - The function returns 2415020.0, the Julian Date corresponding - to 1899 DEC 31 12:00:00 (1900 JAN 0.5). - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns the constant value shown above. - --Examples - - The following code fragment illustrates the use of j1900_c. - - /. - Convert Julian Date to UTC seconds past the reference - epoch (J1900). - ./ - - spref = ( jd - j1900_c() ) * spd_c(); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - julian date of 1900.0 jan 0.5 - --& -*/ - -{ /* Begin j1900_c */ - - return 2415020.0; - -} /* End j1900_c */ diff --git a/ext/spice/src/cspice/j1950.c b/ext/spice/src/cspice/j1950.c deleted file mode 100644 index c9a0e52499..0000000000 --- a/ext/spice/src/cspice/j1950.c +++ /dev/null @@ -1,126 +0,0 @@ -/* j1950.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure J1950 ( Julian Date of 1950.0 JAN 1.0 ) */ -doublereal j1950_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the Julian Date of 1950 JAN 01 00:00:00 (1950 JAN 1.0). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the Julian Date of 1950 JAN 01 00:00:00 */ -/* (1950 JAN 1.0). */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns 2433282.5, the Julian Date corresponding */ -/* to 1950 JAN 01 00:00:00 (1950 JAN 1.0). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of J1950. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (J1950). */ -/* C */ -/* SPREF = ( JD - J1950() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* julian date of 1950.0 jan 1.0 */ - -/* -& */ - ret_val = 2433282.5; - return ret_val; -} /* j1950_ */ - diff --git a/ext/spice/src/cspice/j1950_c.c b/ext/spice/src/cspice/j1950_c.c deleted file mode 100644 index db3773d4a3..0000000000 --- a/ext/spice/src/cspice/j1950_c.c +++ /dev/null @@ -1,120 +0,0 @@ -/* - --Procedure j1950_c ( Julian Date of 1950.0 JAN 1.0 ) - --Abstract - - Return the Julian Date of 1950 JAN 01 00:00:00 (1950 JAN 1.0). - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble j1950_c ( void ) - -/* - --Brief_I/O - - The function returns the Julian Date of 1950 JAN 01 00:00:00 - (1950 JAN 1.0). - --Detailed_Input - - None. - --Detailed_Output - - The function returns 2433282.5, the Julian Date corresponding - to 1950 JAN 01 00:00:00 (1950 JAN 1.0). - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns the constant value shown above. - --Examples - - The following code fragment illustrates the use of j1950_c. - - /. - Convert Julian Date to UTC seconds past the reference - epoch (j1950_c). - ./ - - spref = ( jd - j1950_c() ) * spd_c() - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - julian date of 1950.0 jan 1.0 - --& -*/ - -{ /* Begin j1950_c */ - - return 2433282.5; - -} /* End j1950_c */ diff --git a/ext/spice/src/cspice/j2000.c b/ext/spice/src/cspice/j2000.c deleted file mode 100644 index cc6d97dad6..0000000000 --- a/ext/spice/src/cspice/j2000.c +++ /dev/null @@ -1,126 +0,0 @@ -/* j2000.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure J2000 ( Julian Date of 2000 JAN 1.5 ) */ -doublereal j2000_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the Julian Date of 2000 JAN 01 12:00:00 (2000 JAN 1.5). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the Julian Date of 2000 JAN 01 12:00:00 */ -/* (2000 JAN 1.5). */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns 2451545.0, the Julian Date corresponding */ -/* to 2000 JAN 01 12:00:00 (2000 JAN 1.5). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of J2000. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (J2000). */ -/* C */ -/* SPREF = ( JD - J2000() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* julian date of 2000 jan 1.5 */ - -/* -& */ - ret_val = 2451545.; - return ret_val; -} /* j2000_ */ - diff --git a/ext/spice/src/cspice/j2000_c.c b/ext/spice/src/cspice/j2000_c.c deleted file mode 100644 index 639667551a..0000000000 --- a/ext/spice/src/cspice/j2000_c.c +++ /dev/null @@ -1,134 +0,0 @@ -/* - --Procedure j2000_c ( Julian Date of 2000 JAN 1.5 ) - --Abstract - - Return the Julian Date of 2000 JAN 01 12:00:00 (2000 JAN 1.5). - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble j2000_c ( void ) - -/* - --Brief_I/O - - The function returns the Julian Date of 2000 JAN 01 12:00:00 - (2000 JAN 1.5). - --Detailed_Input - - None. - --Detailed_Output - - The function returns 2451545.0, the Julian Date corresponding - to 2000 JAN 01 12:00:00 (2000 JAN 1.5). - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns the constant value shown above. - --Examples - - The following code fragment illustrates the use of j2000_c(). - - - Convert Julian ephemeris date to TDB seconds past the reference - epoch (J2000). - - spref = ( jed - j2000_c() ) * spd_c(); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.1, 10-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - julian date of 2000 jan 1.5 - --& -*/ - - -{ /* Begin j2000_c */ - - - return 2451545.; - - -} /* End j2000_c */ diff --git a/ext/spice/src/cspice/j2100.c b/ext/spice/src/cspice/j2100.c deleted file mode 100644 index e8f0d03892..0000000000 --- a/ext/spice/src/cspice/j2100.c +++ /dev/null @@ -1,126 +0,0 @@ -/* j2100.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure J2100 ( Julian Date of 2100 JAN 1.5 ) */ -doublereal j2100_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the Julian Date of 2100 JAN 01 12:00:00 (2100 JAN 1.5). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the Julian Date of 2100 JAN 01 12:00:00 */ -/* (2100 JAN 1.5). */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns 2488070.0, the Julian Date corresponding */ -/* to 2100 JAN 01 12:00:00 (2100 JAN 1.5). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of J2100. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (J2100). */ -/* C */ -/* SPREF = ( JD - J2100() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* julian date of 2100 jan 1.5 */ - -/* -& */ - ret_val = 2488070.; - return ret_val; -} /* j2100_ */ - diff --git a/ext/spice/src/cspice/j2100_c.c b/ext/spice/src/cspice/j2100_c.c deleted file mode 100644 index d678df7e50..0000000000 --- a/ext/spice/src/cspice/j2100_c.c +++ /dev/null @@ -1,122 +0,0 @@ -/* - --Procedure j2100_c ( Julian Date of 2100 JAN 1.5 ) - --Abstract - - Return the Julian Date of 2100 JAN 01 12:00:00 (2100 JAN 1.5). - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble j2100_c ( void ) - -/* - --Brief_I/O - - The function returns the Julian Date of 2100 JAN 01 12:00:00 - (2100 JAN 1.5). - --Detailed_Input - - None. - --Detailed_Output - - The function returns 2488070.0, the Julian Date corresponding - to 2100 JAN 01 12:00:00 (2100 JAN 1.5). - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns the constant value shown above. - --Examples - - The following code fragment illustrates the use of j2100_c. - - /. - Convert Julian Date to UTC seconds past the reference - epoch (j2100_c). - ./ - - spref = ( jd - j2100_c() ) * spd_c() - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - julian date of 2100 jan 1.5 - --& -*/ - -{ /* Begin j2100_c */ - - - return 2488070.0; - - -} /* End j2100_c */ diff --git a/ext/spice/src/cspice/jul2gr.c b/ext/spice/src/cspice/jul2gr.c deleted file mode 100644 index 85b9d85c13..0000000000 --- a/ext/spice/src/cspice/jul2gr.c +++ /dev/null @@ -1,796 +0,0 @@ -/* jul2gr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1582 = 1582; -static integer c__10 = 10; -static integer c__15 = 15; -static integer c__4 = 4; -static integer c__100 = 100; -static integer c__400 = 400; -static integer c__5 = 5; -static integer c__12 = 12; -static integer c_b27 = 146097; -static integer c__1461 = 1461; - -/* $Procedure JUL2GR (Julian to Gregorian Calendar) */ -/* Subroutine */ int jul2gr_0_(int n__, integer *year, integer *month, - integer *day, integer *doy) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer extra[12] = { 0,0,1,1,1,1,1,1,1,1,1,1 }; - static integer dpjan0[12] = { 0,31,59,90,120,151,181,212,243,273,304,334 } - ; - static integer dpbegl[12] = { 0,31,60,91,121,152,182,213,244,274,305,335 } - ; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer dayg, dayj, m, rdayg, rdayj, dofyr, yroff, m4, tmpyr, dy, - yr; - extern /* Subroutine */ int rmaini_(integer *, integer *, integer *, - integer *); - static integer offset, offstg, offstj, m100, tmpday, m400; - extern integer lstlti_(integer *, integer *, integer *); - static integer mon; - -/* $ Abstract */ - -/* Convert Year Month and Day on the Julian Calendar */ -/* to the Gregorian Calendar */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* YEAR I/O Year of Julian Calendar/Gregorian Calendar */ -/* MONTH I/O Month of Julian Calendar/Gregorian Calendar */ -/* DAY I/O Day of Month in Julian Calendar/Gregorian Calendar */ -/* DOY O Day of Year in Gregorian Calendar */ - -/* $ Detailed_Input */ - -/* YEAR is an integer representing the year of an epoch, E, in */ -/* the Julian proleptic calendar. Note that the year 0 */ -/* and negative values are required to represent */ -/* years in the pre-Christian era (B.C.) A year, Y B.C., */ -/* should be represented as -(Y-1). For example the year */ -/* 435 B.C. should be input as -434. */ - -/* MONTH is an integer representing the month of some epoch, E, */ -/* in the Julian proleptic calendar. Months */ -/* outside the usual range from 1 to 12 are converted */ -/* to the standard range using modular arithmetic and */ -/* the input year is adjusted appropriately. */ - - -/* DAY is the day of the month of some epoch, E, in the Julian */ -/* proleptic calendar. */ - -/* Note to input an epoch as the day of a year, set MONTH */ -/* to 1 and DAY to the day of the year. */ - -/* $ Detailed_Output */ - -/* YEAR is an integer representing the year of the epoch, E, */ -/* above in the Gregorian calendar. Note that the year */ -/* 0 (zero) and negative values are used to represent */ -/* years in the pre-Christian era (B.C.) A year, Y B.C., */ -/* is be reprented as -(Y-1). For example the year */ -/* 435 B.C. will be returned as -434. */ - -/* MONTH is an integer representing the month of the epoch, E, */ -/* above in the Gregorian Calendar calendar. */ - -/* DAY is the day of the month of the epoch, E, above in the */ -/* Gregorian Calendar */ - -/* DOY is the day of the year of the epoch, E, above in the */ -/* Gregorian Calendar. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This is a mid-level utility routine to assist in the assignment */ -/* and presentation of ancient epochs. */ - -/* The SPICE software deals primarily with epochs represented on */ -/* in the Gregororian Calendar. However, the Gregorian calendar */ -/* was not adopted until October 15, 1582. As a result, epochs */ -/* prior to that time are usually represented in the Julian */ -/* proleptic calendar. */ - -/* Formally, both calendars can be extended indefinitely forward */ -/* and backward in time due the algorithmic nature of the */ -/* determination of calendar representation. */ - -/* When converting "parsed" calendar epochs in the SPICE system, */ -/* you need to first convert to the Gregorian Calendar. From that */ -/* point the SPICE toolkit can easily convert the epoch to Julian */ -/* date or seconds past the J2000 epoch. */ - -/* This routine allows you to take a numeric representation of */ -/* an epoch represented in the Julian proleptic calendar and */ -/* convert that to an epoch in the Gregorian calendar. */ - -/* To convert from Gregorian Calendar to Julian proleptic */ -/* calendar, use the entry point GR2JUL. */ - -/* $ Examples */ - -/* Suppose you need to find the epoch (in seconds past the */ -/* J2000) of some ancient epoch that occurred at */ -/* 3:00 on March 4 of the year 121 B.C. And that this epoch */ -/* is based on the Julian proleptic calendar. We first need */ -/* to convert the Julian Calendar date to the Gregorian Calendar. */ - -/* Here's the declarations we'll need */ - -/* INTEGER YEAR */ -/* INTEGER MONTH */ -/* INTEGER DAY */ -/* INTEGER DOY */ - -/* DOUBLE PRECISION TVEC ( 6 ) */ -/* DOUBLE PRECISION TDB */ - -/* You first need to convert the calendar date of this epoch */ -/* integers. (We don't need to worry about the hours for a moment). */ - -/* YEAR = -120 */ -/* MONTH = 3 */ -/* DAY = 4 */ - -/* Convert this Year, Month and Day to the Gregorian Calendar. */ - -/* CALL JUL2GR ( YEAR, MONTH, DAY, DOY ) */ - -/* Now construct a time vector for use in the routine TTRANS. */ -/* Note now we use the hour component of the epoch (the fourth */ -/* component of the time vector TVEC). */ - -/* TVEC(1) = DBLE( YEAR ) */ -/* TVEC(2) = DBLE( MONTH ) */ -/* TVEC(3) = DBLE( DAY ) */ -/* TVEC(4) = 3.0D0 */ -/* TVEC(5) = 0.0D0 */ -/* TVEC(6) = 0.0D0 */ - -/* Now the routine TTRANS can convert the time vector from */ -/* the input YMD format to barycentric dynamical time. */ - -/* CALL TTRANS ( 'YDM', 'TDB', TVEC ) */ - -/* TDB = TVEC(1) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 26-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAINI calls. */ - -/* - SPICELIB Version 1.1.1, 23-SEP-1999 (WLT) */ - -/* Removed the unused variable DPMON. */ - -/* - SPICELIB Version 1.1.0, 23-FEB-1998 (WLT) */ - -/* The routine was upgraded so that it will handle without */ -/* error months that are outside the range from 1 to 12. */ - -/* - SPICELIB Version 1.0.0, 13-MAR-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Convert from Julian proleptic to Gregorian Calendar */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 26-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAINI calls. */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local (in-line) Functions */ - - -/* Local parameters */ - -/* We declare the variables that contain the number of days in */ -/* 400 years (Gregorian), 100 years (Gregorian), 4 years and 1 year. */ - - -/* The following integers give the number of days during the */ -/* associated month of a non-leap year. */ - - -/* The integers that follow give the number of days in a normal */ -/* year that precede the first of the month. */ - - -/* The integers that follow give the number of days in a leap */ -/* year that precede the first of the month. */ - - -/* Local variables */ - - -/* The array EXTRA contains the number of additional days that */ -/* appear before the first of a month during a leap year (as opposed */ -/* to a non-leap year). */ - - -/* DPJAN0(I) gives the number of days that occur before the I'th */ -/* month of a normal year. */ - - -/* Saved variables */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_gr2jul; - } - - -/* Definitions of statment functions. */ - -/* The number of days ellapsed since Gregorian Jan 1, of year 1 A.D. */ -/* to Jan 1 of YR is given by: */ - - -/* The number of days ellapsed since Julian Jan 1, of year 1 A.D. */ -/* to Jan 1 of YR is given by: */ - - -/* Return 1 if YR is divisible by M, otherwise return 0. */ - - -/* The number of leap days in a Gregorian year is given by: */ - - -/* The number of leap days in a Julian year is given by: */ - - -/* To compute the day of the year we */ - -/* look up the number of days to the beginning of the month, */ - -/* add on the number leap days that occurred prior to that */ -/* time */ - -/* add on the number of days into the month */ - - -/* The number of days since 1 Jan 1 A.D. (Gregorian) is given by: */ - - -/* The number of days since 1 Jan 1 A.D. (Julianis given by: */ - - -/* If this is the first pass through this entry point (or the */ -/* companion entry point) we need to set up some reference points. */ - -/* RDAYG is the number of days past 1 A.D. Jan 1 of the Gregorian */ -/* calendar of the date Oct 15, 1582 */ - -/* RDAYJ is the number of days past 1 A.D. Jan 1 of the Julian */ -/* calendar of the date Oct 5, 1582. */ - -/* OFFSTJ and OFFSTG are just the offset from one count of days */ -/* to the other. */ - - if (first) { - first = FALSE_; -/* Computing MAX */ - i__3 = 0, i__4 = abs(c__1582) / c__4 * c__4 + 1 - abs(c__1582); -/* Computing MAX */ - i__5 = 0, i__6 = abs(c__1582) / c__100 * c__100 + 1 - abs(c__1582); -/* Computing MAX */ - i__7 = 0, i__8 = abs(c__1582) / c__400 * c__400 + 1 - abs(c__1582); - rdayg = (c__1582 - 1) * 365 + (c__1582 - 1) / 4 - (c__1582 - 1) / 100 - + (c__1582 - 1) / 400 + (dpjan0[(i__1 = c__10 - 1) < 12 && 0 - <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "jul2gr_", (ftnlen) - 535)] + extra[(i__2 = c__10 - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("extra", i__2, "jul2gr_", (ftnlen)535)] * (max(i__3, - i__4) - max(i__5,i__6) + max(i__7,i__8)) + c__15) - 1; -/* Computing MAX */ - i__3 = 0, i__4 = abs(c__1582) / c__4 * c__4 + 1 - abs(c__1582); - rdayj = (c__1582 - 1) * 365 + (c__1582 - 1) / 4 + (dpjan0[(i__1 = - c__10 - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, - "jul2gr_", (ftnlen)536)] + extra[(i__2 = c__10 - 1) < 12 && 0 - <= i__2 ? i__2 : s_rnge("extra", i__2, "jul2gr_", (ftnlen)536) - ] * max(i__3,i__4) + c__5) - 1; - offstj = rdayj - rdayg; - offstg = rdayg - rdayj; - } - -/* Make local copies of the year, month and day. Then get the */ -/* YEARs into a positive range. */ - - i__1 = *month - 1; - rmaini_(&i__1, &c__12, &yroff, &mon); - yr = *year + yroff; - ++mon; - dy = *day; - if (yr <= 0) { - rmaini_(&yr, &c__4, &m4, &tmpyr); - yr = tmpyr; - if (yr == 0) { - yr += 4; - --m4; - } - offset = m4 * 1461; - } else { - offset = 0; - } - -/* First get the day number (Julian) for the input */ -/* year month and day. */ - -/* Computing MAX */ - i__3 = 0, i__4 = abs(yr) / c__4 * c__4 + 1 - abs(yr); - dayj = (yr - 1) * 365 + (yr - 1) / 4 + (dpjan0[(i__1 = mon - 1) < 12 && 0 - <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "jul2gr_", (ftnlen)574)] - + extra[(i__2 = mon - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge("extra" - , i__2, "jul2gr_", (ftnlen)574)] * max(i__3,i__4) + dy) - 1 + - offset; - -/* This day is DAYJ - RDAYJ days after 1582 Oct 5 on the */ -/* julian calendar. But this is the same as the number */ -/* of days past 1582 Oct 15 on the Gregorian Calendar */ -/* So the Gregorian day number is DAYJ - RDAYJ + RDAYG */ -/* which is the same as DAYJ + OFFSTG. */ - - dayg = dayj + offstg; - -/* Now that we have the Gregorian day number it's a fairly */ -/* straight forward task to get the year, month and day */ -/* on the Gregorian calendar. */ - - rmaini_(&dayg, &c_b27, &m400, &tmpday); - dayg = tmpday; -/* Computing MIN */ - i__1 = 3, i__2 = dayg / 36524; - m100 = min(i__1,i__2); - dayg -= m100 * 36524; -/* Computing MIN */ - i__1 = 24, i__2 = dayg / 1461; - m4 = min(i__1,i__2); - dayg -= m4 * 1461; -/* Computing MIN */ - i__1 = 3, i__2 = dayg / 365; - m = min(i__1,i__2); - dayg -= m * 365; - dofyr = dayg + 1; - yr = m400 * 400 + m100 * 100 + (m4 << 2) + m + 1; - -/* Now look up the month number and compute the day of the month. */ -/* How we do this depends on whether or not this is a leap year. */ - -/* Computing MAX */ - i__1 = 0, i__2 = abs(yr) / c__4 * c__4 + 1 - abs(yr); -/* Computing MAX */ - i__3 = 0, i__4 = abs(yr) / c__100 * c__100 + 1 - abs(yr); -/* Computing MAX */ - i__5 = 0, i__6 = abs(yr) / c__400 * c__400 + 1 - abs(yr); - if (max(i__1,i__2) - max(i__3,i__4) + max(i__5,i__6) == 0) { - mon = lstlti_(&dofyr, &c__12, dpjan0); - dy = dofyr - dpjan0[(i__1 = mon - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpjan0", i__1, "jul2gr_", (ftnlen)616)]; - } else { - mon = lstlti_(&dofyr, &c__12, dpbegl); - dy = dofyr - dpbegl[(i__1 = mon - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpbegl", i__1, "jul2gr_", (ftnlen)619)]; - } - *year = yr; - *month = mon; - *day = dy; - *doy = dofyr; - return 0; -/* $Procedure GR2JUL (Gregorian to Julian Calendar) */ - -L_gr2jul: -/* $ Abstract */ - -/* Convert Year Month and Day on the Gregorian Calendar */ -/* to the Julian Calendar */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ - -/* INTEGER YEAR */ -/* INTEGER MONTH */ -/* INTEGER DAY */ -/* INTEGER DOY */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* YEAR I/O Year of Gregorian Calendar/Julian Calendar */ -/* MONTH I/O Month of Gregorian Calendar/Julian Calendar */ -/* DAY I/O Day of Month in Gregorian Calendar/Julian Calendar */ -/* DOY O Day of Year in Julian Calendar */ - -/* $ Detailed_Input */ - -/* YEAR is an integer representing the year of an epoch, E, in */ -/* the Gregorian calendar. Note that the year 0 (zero) */ -/* and negative values are required to represent */ -/* years in the pre-Christian era (B.C.) A year, Y B.C. */ -/* should be reprented as -(Y-1). For example the year */ -/* 435 B.C. should be input as -434. */ - -/* MONTH is an integer representing the month of some epoch, E, */ -/* in the Gregorian calendar. Months */ -/* outside the usual range from 1 to 12 are converted */ -/* to the standard range using modular arithmetic and */ -/* the input year is adjusted appropriately. */ - -/* DAY is the day of the month of some epoch, E, in the */ -/* Gregorian calendar. */ - -/* Note to input an epoch as the day of a year, set MONTH */ -/* to 1 and DAY to the day of the year. */ - -/* $ Detailed_Output */ - -/* YEAR is an integer representing the year of the epoch, E, */ -/* above in the Julian calendar. Note that the year 0 */ -/* (zero) and negative values are used to represent */ -/* years in the pre-Christian era (B.C.) A year, Y B.C., */ -/* is be reprented as -(Y-1). For example the year */ -/* 435 B.C. will be returned as -434. */ - -/* MONTH is an integer representing the month of the epoch, E, */ -/* above in the Julian Calendar calendar. */ - -/* DAY is the day of the month of the epoch, E, above in the */ -/* Julian Calendar */ - -/* DOY is the day of the year of the epoch, E, above in the */ -/* Julian Calendar. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This is a mid-level utility routine to assist in the assignment */ -/* and presentation of Ancient epochs. */ - -/* The SPICE software deals primarily with epochs represented on */ -/* in the Gregororian Calendar. However, the Gregorian calendar */ -/* was not adopted until October 15, 1582. As a result, epochs */ -/* prior to that time are usually represented in the Julian */ -/* proleptic calendar. */ - -/* Formally, both calendars can be extended indefinitely forward */ -/* and backward in time due the algorithmic nature of the */ -/* determination of calendar representation. */ - -/* This routine allows you to take a numeric representation of */ -/* an epoch represented in the Gregorian calendar and */ -/* convert that to an epoch in the Julian calendar. */ - -/* To convert from Julian Calendar to Gregorian */ -/* calendar, use the entry point JUL2GR. */ - -/* $ Examples */ - -/* Suppose you need to print an epoch (given in seconds past the */ -/* J2000 epoch) of some ancient epoch that occured during */ -/* pre-Christian era, and that you want to represent this epoch */ -/* using the Julian proleptic calendar. */ - -/* Here's the declarations we'll need */ - -/* INTEGER YEAR */ -/* INTEGER MONTH */ -/* INTEGER DAY */ -/* INTEGER DOY */ - -/* DOUBLE PRECISION TVEC ( 6 ) */ -/* DOUBLE PRECISION TDB */ - -/* You first need to convert TDB (the epoch in Seconds past J2000) */ -/* to a calendar representation. */ - -/* TVEC(1) = TDB. */ - -/* CALL TTRANS ( 'TDB', 'YMD', TVEC ) */ - -/* The output time vector will be relative to the Gregorian */ -/* Calendar. Collect the year, month and day from the time */ -/* vectory. */ - -/* YEAR = INT ( TVEC(1) ) */ -/* MONTH = INT ( TVEC(2) ) */ -/* DAY = INT ( TVEC(3) ) */ - -/* The hours, minutes and seconds appear in components 4 through 6 */ -/* of the time vector. We can ignore them in the conversion */ -/* of the calendar from Gregorian to Julian. */ - -/* CALL GR2JUL ( YEAR, MONTH, DAY, DOY ) */ - -/* Now create a string from the YEAR, MONTH, DAY and TVEC(4) */ -/* through TVEC(6). */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 23-FEB-1998 (WLT) */ - -/* The routine was upgraded so that it will handle without */ -/* error months that are outside the range from 1 to 12. */ - -/* - SPICELIB Version 1.0.0, 13-MAR-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Convert from Gregorian to Julian Calendar */ - -/* -& */ - -/* If this is the first pass through this entry point (or the */ -/* companion entry point) we need to set up some reference points. */ - -/* RDAYG is the number of days past 1 A.D. Jan 1 of the Gregorian */ -/* calendar of the date Oct 15, 1582 */ - -/* RDAYJ is the number of days past 1 A.D. Jan 1 of the Julian */ -/* calendar of the date Oct 5, 1582. */ - -/* OFFSTJ and OFFSTG are just the offset from one count of days */ -/* to the other. */ - - if (first) { - first = FALSE_; -/* Computing MAX */ - i__3 = 0, i__4 = abs(c__1582) / c__4 * c__4 + 1 - abs(c__1582); -/* Computing MAX */ - i__5 = 0, i__6 = abs(c__1582) / c__100 * c__100 + 1 - abs(c__1582); -/* Computing MAX */ - i__7 = 0, i__8 = abs(c__1582) / c__400 * c__400 + 1 - abs(c__1582); - rdayg = (c__1582 - 1) * 365 + (c__1582 - 1) / 4 - (c__1582 - 1) / 100 - + (c__1582 - 1) / 400 + (dpjan0[(i__1 = c__10 - 1) < 12 && 0 - <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "jul2gr_", (ftnlen) - 850)] + extra[(i__2 = c__10 - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("extra", i__2, "jul2gr_", (ftnlen)850)] * (max(i__3, - i__4) - max(i__5,i__6) + max(i__7,i__8)) + c__15) - 1; -/* Computing MAX */ - i__3 = 0, i__4 = abs(c__1582) / c__4 * c__4 + 1 - abs(c__1582); - rdayj = (c__1582 - 1) * 365 + (c__1582 - 1) / 4 + (dpjan0[(i__1 = - c__10 - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, - "jul2gr_", (ftnlen)851)] + extra[(i__2 = c__10 - 1) < 12 && 0 - <= i__2 ? i__2 : s_rnge("extra", i__2, "jul2gr_", (ftnlen)851) - ] * max(i__3,i__4) + c__5) - 1; - offstj = rdayj - rdayg; - offstg = rdayg - rdayj; - } - -/* Make Local Copies of YEAR, MONTH and DAY and get YEAR into */ -/* a positive range. */ - - i__1 = *month - 1; - rmaini_(&i__1, &c__12, &yroff, &mon); - yr = *year + yroff; - ++mon; - dy = *day; - if (yr <= 0) { - rmaini_(&yr, &c__400, &m400, &tmpyr); - yr = tmpyr; - if (yr == 0) { - yr += 400; - --m400; - } - offset = m400 * 146097; - } else { - offset = 0; - } - -/* First get the day number (Gregorian) for the input */ -/* year month and day. */ - -/* Computing MAX */ - i__3 = 0, i__4 = abs(yr) / c__4 * c__4 + 1 - abs(yr); -/* Computing MAX */ - i__5 = 0, i__6 = abs(yr) / c__100 * c__100 + 1 - abs(yr); -/* Computing MAX */ - i__7 = 0, i__8 = abs(yr) / c__400 * c__400 + 1 - abs(yr); - dayg = (yr - 1) * 365 + (yr - 1) / 4 - (yr - 1) / 100 + (yr - 1) / 400 + ( - dpjan0[(i__1 = mon - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge("dpjan0" - , i__1, "jul2gr_", (ftnlen)888)] + extra[(i__2 = mon - 1) < 12 && - 0 <= i__2 ? i__2 : s_rnge("extra", i__2, "jul2gr_", (ftnlen)888)] - * (max(i__3,i__4) - max(i__5,i__6) + max(i__7,i__8)) + dy) - 1 + - offset; - -/* This day is DAYG - RDAYG days after 1582 Oct 15 on the */ -/* Gregorian calendar. But this is the same as the number */ -/* of days past 1582 Oct 5 on the Julian Calendar */ -/* So the Julian day number is DAYG - RDAYG + RDAYJ */ -/* which is the same as DAYG + OFFSTJ. */ - - dayj = dayg + offstj; - -/* Now that we have the Julian day number it's a fairly */ -/* straight forward task to get the year, month and day */ -/* on the Julian calendar. */ - - rmaini_(&dayj, &c__1461, &m4, &tmpday); - dayj = tmpday; -/* Computing MIN */ - i__1 = 3, i__2 = dayj / 365; - m = min(i__1,i__2); - dayj -= m * 365; - dofyr = dayj + 1; - yr = (m4 << 2) + m + 1; - -/* Now look up the month number and compute the day of the month. */ -/* How we do this depends on whether or not this is a leap year. */ - -/* Computing MAX */ - i__1 = 0, i__2 = abs(yr) / c__4 * c__4 + 1 - abs(yr); - if (max(i__1,i__2) == 0) { - mon = lstlti_(&dofyr, &c__12, dpjan0); - dy = dofyr - dpjan0[(i__1 = mon - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpjan0", i__1, "jul2gr_", (ftnlen)922)]; - } else { - mon = lstlti_(&dofyr, &c__12, dpbegl); - dy = dofyr - dpbegl[(i__1 = mon - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpbegl", i__1, "jul2gr_", (ftnlen)925)]; - } - *year = yr; - *month = mon; - *day = dy; - *doy = dofyr; - return 0; -} /* jul2gr_ */ - -/* Subroutine */ int jul2gr_(integer *year, integer *month, integer *day, - integer *doy) -{ - return jul2gr_0_(0, year, month, day, doy); - } - -/* Subroutine */ int gr2jul_(integer *year, integer *month, integer *day, - integer *doy) -{ - return jul2gr_0_(1, year, month, day, doy); - } - diff --git a/ext/spice/src/cspice/jyear.c b/ext/spice/src/cspice/jyear.c deleted file mode 100644 index 0744aa8677..0000000000 --- a/ext/spice/src/cspice/jyear.c +++ /dev/null @@ -1,128 +0,0 @@ -/* jyear.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure JYEAR ( Seconds per julian year ) */ -doublereal jyear_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the number of seconds in a julian year. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* JYEAR O The number of seconds/julian year */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the number of seconds per julian */ -/* year. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The julian year is often used as a fundamental unit */ -/* of time when dealing with ephemeris data. For this */ -/* reason its value in terms of ephemeris seconds is */ -/* recorded in this function. */ - -/* $ Examples */ - -/* Suppose you wish to compute the number of julian centuries */ -/* that have elapsed since the ephemeris epoch J1950 (beginning */ -/* of the julian year 1950) at a particular ET epoch. The */ -/* following line of code will do the trick. */ - - -/* CENTRY = ( ET - UNITIM ( J1950(), 'JED', 'ET' ) ) */ -/* . / ( 100.0D0 * JYEAR() ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Explanatory Supplement to the Astronomical Almanac. */ -/* Page 8. University Science Books, 20 Edgehill Road, */ -/* Mill Valley, CA 94941 */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 13-JUL-1993 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Number of seconds per julian year */ - -/* -& */ - ret_val = 31557600.; - return ret_val; -} /* jyear_ */ - diff --git a/ext/spice/src/cspice/jyear_c.c b/ext/spice/src/cspice/jyear_c.c deleted file mode 100644 index 53a14c79f4..0000000000 --- a/ext/spice/src/cspice/jyear_c.c +++ /dev/null @@ -1,126 +0,0 @@ -/* - --Procedure jyear_c ( Seconds per julian year ) - --Abstract - - Return the number of seconds in a julian year. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble jyear_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - jyear_c O The number of seconds/julian year - --Detailed_Input - - None. - --Detailed_Output - - The function returns the number of seconds per julian - year. - --Parameters - - None. - --Particulars - - The julian year is often used as a fundamental unit - of time when dealing with ephemeris data. For this - reason its value in terms of ephemeris seconds is - recorded in this function. - --Examples - - Suppose you wish to compute the number of julian centuries - that have elapsed since the ephemeris epoch J1950 (beginning - of the julian year 1950) at a particular ET epoch. The - following lines of code will do the trick. - - - century = ( et - unitim_c ( j1950_c(), "JED", "ET" ) ); - century = century / ( 100.0 * jyear_c() ); - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - --Literature_References - - Explanatory Supplement to the Astronomical Almanac. - Page 8. University Science Books, 20 Edgehill Road, - Mill Valley, CA 94941 - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - Number of seconds per julian year - --& -*/ - -{ /* Begin jyear_c */ - - return 31557600.0; - -} /* End jyear_c */ diff --git a/ext/spice/src/cspice/kclear_c.c b/ext/spice/src/cspice/kclear_c.c deleted file mode 100644 index 06849a183e..0000000000 --- a/ext/spice/src/cspice/kclear_c.c +++ /dev/null @@ -1,163 +0,0 @@ -/* - --Procedure kclear_c ( Keeper clear ) - --Abstract - - Clear the KEEPER system: unload all kernels, clear the kernel - pool, and re-initialize the system. - --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 - - KERNEL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void kclear_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - None. - --Detailed_Input - - None. This routine operates by side effects. See Particulars - below. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - See Particulars. - --Exceptions - - 1) Any errors that occur when setting a kernel pool watch - or checking watched variables will be diagnosed by - routines in the call tree of this routine. - --Particulars - - This entry point allows you re-initialize the KEEPER system with - a single call. The KEEPER system is the kernel management system - underlying the set of CSPICE APIs - - furnsh_c - ktotal_c - kdata_c - kinfo_c - kclear_c - unload_c - - This routine unloads all kernels from their kernel-type-specific - kernel management subsystems (SPKBSR, CKBSR, etc.), clears the - kernel pool, clears KEEPER's internal file database, and re-sets - the watch status for the kernel variables used to load kernels - via meta-kernels. - - This capability, though implemented in Fortran, is particularly - relevant to SPICE implementations such as Icy, for which the - state of the KEEPER system persists after any Icy-based IDL - script is run. Successive runs of Icy-based scripts may perform - in unexpected ways when scripts access data loaded during runs of - previous scripts. - - Cleaning up after such programs using explicit unload_c commands is - tedious and error-prone. One call to this routine sets the - KEEPER system to its initial state, preventing unintentional - interaction between scripts via KEEPER's state. - --Examples - - Clear the KEEPER system; check for residual loaded files. - We shouldn't find any. - - kclear_c (); - ktotal_c ( "ALL", &n ); - - printf ( "Count of loaded kernels after kclear_c call\n", n ); - - --Restrictions - - Calling this routine will wipe out any kernel pool data - inserted via the p*pool_c API routines. - --Author_and_Institution - - N.J. Bachman (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 15-NOV-2006 (NJB) - --Index_Entries - - Re-initialize the keeper system - Clear the keeper system - Unload all kernels - --& -*/ - -{ /* Begin kclear_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "kclear_c" ); - - - kclear_(); - - - chkout_c ( "kclear_c" ); - -} /* End kclear_c */ diff --git a/ext/spice/src/cspice/kdata_c.c b/ext/spice/src/cspice/kdata_c.c deleted file mode 100644 index 8fa7937057..0000000000 --- a/ext/spice/src/cspice/kdata_c.c +++ /dev/null @@ -1,355 +0,0 @@ -/* - --Procedure kdata_c ( Kernel Data ) - --Abstract - - Return data for the nth kernel that is among a list of specified - kernel types. - --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 - - KERNEL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void kdata_c ( SpiceInt which, - ConstSpiceChar * kind, - SpiceInt fillen, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * file, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - which I Index of kernel to fetch from the list of kernels. - kind I The kind of kernel to which fetches are limited. - fillen I Available space in output file string. - typlen I Available space in output kernel type string. - srclen I Available space in output source string. - file O The name of the kernel file. - filtyp O The type of the kernel. - source O Name of the source file used to load file. - handle O The handle attached to file. - found O SPICETRUE if the specified file could be located. - --Detailed_Input - - which is the number of the kernel to fetch (matching the - type specified by kind) from the list of kernels that - have been loaded through the entry point furnsh_c but - that have not been unloaded through the entry point - unload_c. - - The range of which is 0 to count-1, where count is - the number of kernels loaded via furnsh_c. This - count may be obtained by calling ktotal_c. See the - Examples section for an illustrative code fragment. - - - kind is a list of types of kernels to be considered when - fetching kernels from the list of loaded kernels. KIND - should consist of a list of words of kernels to - examine. Recognized types are - - SPK --- All SPK files are counted in the total. - CK --- All CK files are counted in the total. - PCK --- All binary PCK files are counted in the - total. - EK --- All EK files are counted in the total. - TEXT --- All text kernels that are not meta-text - kernels are included in the total. - META --- All meta-text kernels are counted in the - total. - ALL --- Every type of kernel is counted in the - total. - - kind is case insensitive. If a word appears in kind - that is not one of those listed above it is ignored. - - See the entry point ktotal_c for examples of the use - of kind. - - fillen is the amount of available space in the output file - string, including room for the terminating null. - Normally, this is the declared length of the output - string. - - typlen is the amount of available space in the output kernel - type string. - - srclen is the amount of available space in the output kernel - source string. - - --Detailed_Output - - - file is the name of the file having index which in the - sequence of files of type kind currently loaded via - furnsh_c. file will be blank if there is no such kernel - is loaded. - - filtyp is the type of the kernel specified by file. filtyp - will be empty if there is no file matching the - specification of which and kind. - - source is the name of the source file that was used to - specify file as one to load. If file was loaded - directly via a call to furnsh_c, source will be empty. - If there is no file matching the specification of - which and kind, source will be empty. - - handle is the handle attached to file if it is a binary - kernel. If file is a text kernel or meta-text kernel - handle will be zero. If there is no file matching - the specification of which and kind, handle will be - set to zero. - - found is returned SPICETRUE if a file matching the - specification of which and kind exists. If there is no - such file, found will be set to SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If a file is not loaded matching the specification of which - and kind, found will be SPICEFALSE; file, filtyp, and source - will be empty and handle will be set to zero. - - 2) If any input or output character argument pointer is null, the - error SPICE(NULLPOINTER) will be signaled. - - 3) If any of the output string length arguments are less than 1, the - error SPICE(STRINGTOOSHORT) will be signaled. - - 4) If any output string has length at least 1 but is too short to - contain the output string, the corresponding is truncated on the - right. The output string is still null-terminated. - --Files - - None. - --Particulars - - This entry point allows you to determine which kernels have - been loaded via furnsh_c and to obtain information sufficient - to directly query those files. - --Examples - - The following example shows how you could print a summary - of SPK files that have been loaded through the interface - furnsh_c. - - #include - #include "SpiceUsr.h" - - #define FILLEN 128 - #define TYPLEN 32 - #define SRCLEN 128 - - SpiceInt which; - SpiceInt count; - SpiceInt handle; - - SpiceChar file [FILLEN]; - SpiceChar filtyp[TYPLEN]; - SpiceChar source[SRCLEN]; - - SpiceBoolean found; - - int main() - { - furnsh_c( "/kernels/standard.tm" ); - - ktotal_c ( "spk", &count ); - - if ( count == 0 ) - { - printf ( "No SPK files loaded at this time.\n" ); - } - else - { - printf ( "The loaded SPK files are: \n\n" ); - } - - for ( which = 0; which < count; which++ ) - { - kdata_c ( which, "spk", FILLEN, TYPLEN, SRCLEN, - file, filtyp, source, &handle, &found ); - printf ( "%s\n", file ); - } - - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.3, 02-MAY-2008 (EDW) - - standard.ker renamed standard.tm - - -CSPICE Version 1.1.2, 05-SEP-2007 (EDW) - - Expanded Examples section to a full, compilable program. - - -CSPICE Version 1.1.1, 29-DEC-2004 (LSE) - - Corrected example code to match routine's argument list. - (2 arguments reversed) - - -CSPICE Version 1.1.0, 02-FEB-2003 (EDW) - - Corrected example code to match routine's argument list. - - -CSPICE Version 1.0.0, 12-SEP-1999 (NJB) (WLT) - --Index_Entries - - Retrieve information on loaded SPICE kernels - --& -*/ - -{ /* Begin kdata_c */ - - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "kdata_c" ); - - - /* - Check the input string kind to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "kdata_c", kind ); - - - /* - Make sure the output string file has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "kdata_c", file, fillen ); - - - /* - Make sure the output string filtyp has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "kdata_c", filtyp, typlen ); - - - /* - Make sure the output string source has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "kdata_c", source, srclen ); - - - /* - Map the input index from C to Fortran style. - */ - - which++; - - - /* - Call the f2c'd routine. - */ - kdata_ ( ( integer * ) &which, - ( char * ) kind, - ( char * ) file, - ( char * ) filtyp, - ( char * ) source, - ( integer * ) handle, - ( logical * ) &fnd, - ( ftnlen ) strlen(kind), - ( ftnlen ) fillen-1, - ( ftnlen ) typlen-1, - ( ftnlen ) srclen-1 ); - - - /* - Convert the output strings from Fortran style to C style. Set - the SpiceBoolean output found flag. - */ - F2C_ConvertStr( fillen, file ); - F2C_ConvertStr( typlen, filtyp ); - F2C_ConvertStr( srclen, source ); - - *found = fnd; - - - chkout_c ( "kdata_c" ); - -} /* End kdata_c */ diff --git a/ext/spice/src/cspice/keeper.c b/ext/spice/src/cspice/keeper.c deleted file mode 100644 index c554ba136d..0000000000 --- a/ext/spice/src/cspice/keeper.c +++ /dev/null @@ -1,2812 +0,0 @@ -/* keeper.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__255 = 255; -static integer c__1300 = 1300; -static integer c__1 = 1; - -/* $Procedure KEEPER ( Keeps track of SPICE kernels ) */ -/* Subroutine */ int keeper_0_(int n__, integer *which, char *kind, char * - file, integer *count, char *filtyp, integer *handle, char *source, - logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, - ftnlen source_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer loaded = 0; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - logical dock, doek; - char norc[1]; - integer hits, size, b, d__, e, i__, j, k, n; - logical didck, didek; - integer r__; - extern /* Subroutine */ int eklef_(char *, integer *, ftnlen), chkin_( - char *, ftnlen), ekuef_(integer *); - logical dopck; - extern /* Subroutine */ int cklpf_(char *, integer *, ftnlen); - static char files[255*1300]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen), ckupf_(integer *); - static integer srces[1300]; - logical dospk, paths, gotit; - static char known[32*3]; - extern integer rtrim_(char *, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - integer n1, n2, n3, start; - static char types[8*1300]; - char fil2ld[255]; - extern logical failed_(void); - logical ok, didpck; - extern /* Subroutine */ int remlac_(integer *, integer *, char *, integer - *, ftnlen); - static integer handls[1300]; - logical dometa; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - char nofile[500]; - integer dollar, fnmlen, myhand; - logical didspk, update; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen), fndnwd_(char *, integer *, - integer *, integer *, ftnlen), pckuof_(integer *), clpool_(void), - remlai_(integer *, integer *, integer *, integer *); - extern logical samsub_(char *, integer *, integer *, char *, integer *, - integer *, ftnlen, ftnlen); - integer filnum; - char pvalue[255]; - integer npaths; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer cursrc, npvals; - char symbol[80]; - logical didtxt, dotext; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), errint_( - char *, integer *, ftnlen), swpool_(char *, integer *, char *, - ftnlen, ftnlen), dtpool_(char *, logical *, integer *, char *, - ftnlen, ftnlen), stpool_(char *, integer *, char *, char *, - integer *, logical *, ftnlen, ftnlen, ftnlen), repsub_(char *, - integer *, integer *, char *, char *, ftnlen, ftnlen, ftnlen), - repmot_(char *, char *, integer *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen), dvpool_(char *, ftnlen); - char thstyp[8]; - extern /* Subroutine */ int spkuef_(integer *), ldpool_(char *, ftnlen), - spklef_(char *, integer *, ftnlen), pcklof_(char *, integer *, - ftnlen); - logical add, fnd; - integer src, use; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int zzldker_(char *, char *, char *, integer *, - ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine is an umbrella for a collection of entry points */ -/* that manage the loading and unloading of SPICE kernels from */ -/* an application program. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O ENTRY POINT */ -/* -------- --- -------------------------------------------------- */ -/* KIND I KTOTAL, KDATA */ -/* FILE I/O FURNSH, KDATA, UNLOAD, KINFO */ -/* FILTYP I/O KTOTAL, KDATA, KINFO */ -/* COUNT O KTOTAL */ -/* HANDLE O KDATA, KINFO */ -/* SOURCE O KDATA. KINFO */ -/* FOUND O KDATA. KINFO */ -/* FILSIZ P Maximum file name length. */ -/* MAXFIL P Is the maximum number of files that can be loaded. */ - - -/* $ Detailed_Input */ - -/* See Individual Entry points. */ - -/* $ Detailed_Output */ - -/* See Individual Entry points. */ - -/* $ Parameters */ - -/* FILSIZ is the maximum file name length that can be */ -/* accommodated by this set of routines. */ - - -/* MAXFIL is the number of entries that can be stored in KEEPER's */ -/* kernel database. Each time a kernel is loaded via */ -/* FURNSH, a database entry is created for that kernel. */ -/* If a meta-kernel is loaded, a database entry is created */ -/* for the meta-kernel itself and for all files referenced */ -/* in the meta-kernel's KERNELS_TO_LOAD specification. */ -/* Unloading a kernel or meta-kernel deletes database */ -/* entries created when the file was loaded. */ - -/* The parameter MAXFIL is an upper bound on number of */ -/* SPICE kernels that can be loaded at any time via the */ -/* KEEPER interface, but the number of kernels that can be */ -/* loaded may be smaller, since re-loading a loaded kernel */ -/* or meta-kernel results in creation of additional */ -/* database entries. */ - -/* Kernels loaded into the KEEPER system are subject to */ -/* constraints imposed by lower-level subsystems. The */ -/* binary kernel systems (SPK, CK, binary PCK, and EK) */ -/* have their own limits on the maximum number of kernels */ -/* that may be loaded. */ - -/* The total number of DAF-based files (this set includes */ -/* SPKs, CKs, and binary PCKs) that may be loaded at any */ -/* time may not exceed 1000. This limit applies whether */ -/* the files are loaded via FURNSH or lower-level loaders */ -/* such as SPKLEF or DAFOPR. File access performance */ -/* normally will degrade as the number of loaded kernels */ -/* increases. */ - -/* The total number of DAS-based files that may be loaded */ -/* at any time is currently limited to 20 files. */ - -/* $ Exceptions */ - -/* 1) If the main routine KEEPER is called, the error */ -/* 'SPICE(BOGUSENTRY)' will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as an umbrella for a collection of */ -/* entry points that unify the task of loading, tracking, */ -/* and unloading SPICE kernels. A description of each entry */ -/* point is given below: */ - -/* FURNSH Furnish a kernel to a program. This entry point */ -/* provides a single interface for loading kernels into */ -/* your application program. All SPICE kernels (Text */ -/* kernels, SPK, CK, Binary PCK, and EK) can be loaded */ -/* through this entry point. In addition, special text */ -/* kernels, called meta-Text kernels, that contain a list */ -/* of other kernels to load can be processed by FURNSH. */ - -/* Meta-text kernels allow you to easily control which */ -/* kernels will be loaded by your program without having */ -/* to write your own kernel managing routines. */ - -/* KTOTAL returns the number of kernels that are currently */ -/* available to your program as a result of previous calls */ -/* to FURNSH and UNLOAD. */ - -/* KDATA provides an interface for retrieving (in order of their */ -/* specification through FURNSH) kernels that are active in */ -/* your application. */ - -/* KINFO allows you to retrieve information about a loaded */ -/* kernel using the name of that kernel. */ - -/* KCLEAR Unloads all kernels that were loaded via the KEEPER */ -/* system, clears the kernel pool, and re-initializes the */ -/* KEEPER system. */ - -/* UNLOAD provides an interface for unloading kernels that have */ -/* been loaded via the routine FURNSH. */ - -/* For more details concerning any particular entry point, see the */ -/* header for that entry point. */ - -/* $ Examples */ - -/* The code fragment below illustrates the use of the various entry */ -/* points of KEEPER. The details of creating meta-text kernels are */ -/* not discussed here, but are spelled out in the entry point */ -/* FURNSH. */ - - -/* Load several kernels into the program. */ - - -/* CALL FURNSH ( 'myspk.bsp' ) */ -/* CALL FURNSH ( 'myck.bc' ) */ -/* CALL FURNSH ( 'leapsecs.ker' ) */ -/* CALL FURNSH ( 'sclk.tsc' ) */ -/* CALL FURNSH ( 'metatext.ker' ) */ - -/* See how many kernels have been loaded. */ - -/* CALL KTOTAL ( 'ALL', COUNT ) */ - -/* WRITE (*,*) 'The total number of kernels is: ', COUNT */ - -/* Summarize the kernels and types. */ - -/* DO WHICH = 1, COUNT */ - -/* CALL KDATA( WHICH, 'ALL', FILE, FILTYP, SOURCE, HANDLE, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* WRITE (*,*) 'This is NOT supposed to happen. Call NAIF' */ -/* WRITE (*,*) 'and let them know of this problem.' */ - -/* ELSE */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'File : ', FILE */ -/* WRITE (*,*) 'Type : ', FILTYP */ -/* WRITE (*,*) 'Handle: ', HANDLE */ - -/* IF ( SOURCE .NE. ' ' ) THEN */ -/* WRITE (*,*) 'This file was loaded via meta-text kernel:' */ -/* WRITE (*,*) SOURCE */ -/* END IF */ - -/* END IF */ - -/* END DO */ - - -/* Unload the first kernel we loaded. */ - -/* CALL UNLOAD ( 'myspk.bsp' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.1, 10-FEB-2010 (EDW) */ - -/* Added mention of the restriction on kernel pool variable */ -/* names to MAXLEN (defined in pool.f) characters or less. */ - -/* - SPICELIB Version 4.0.0, 02-APR-2009 (NJB) */ - -/* Continued path values are now supported. FURNSH now rejects */ -/* file names longer than FILSIZ characters. */ - -/* Deleted references to unneeded variable DOALL. Made */ -/* THSTYP declaration compatible with TYPES array. */ - -/* - SPICELIB Version 3.0.1, 27-APR-2007 (NJB) */ - -/* Fixed header typo: added quotes to literal string */ -/* input arguments in example FURNSH calls. */ - -/* - SPICELIB Version 3.0.0, 15-NOV-2006 (NJB) */ - -/* Added entry point KCLEAR. Bug fix: meta-kernel unloading bug */ -/* in UNLOAD was corrected. Some header updates were made. */ - -/* - SPICELIB Version 2.0.2, 29-JUL-2003 (NJB) (CHA) */ - -/* Only the header of the entry point FURNSH was modified. */ -/* Numerous updates were made to improve clarity. Some */ -/* corrections were made. */ - -/* - SPICELIB VERSION 2.0.1, 06-DEC-2002 (NJB) */ - -/* Typo in header example was corrected. */ - -/* - SPICELIB VERSION 2.0.0, 07-JAN-2002 (WLT) */ - -/* Added a call to CVPOOL in FURNSH so that watches that are */ -/* triggered are triggered by loading Meta-kernels and not by */ -/* some external interaction with the kernel pool. */ - -/* Added code to make sure that UNLOAD has the effect of */ -/* loading all remaining kernels in the order they were first */ -/* introduced. */ - -/* - SPICELIB Version 1.1.0, 19-SEP-2000 (WLT) */ - -/* Corrected the error message template used */ -/* by ZZLDKER */ - -/* - SPICELIB Version 1.0.1, 16-DEC-1999 (NJB) */ - -/* Documentation fix: corrected second code example in the */ -/* header of the entry point FURNSH. The example previously used */ -/* the kernel variable PATH_NAMES; that name has been replaced */ -/* with the correct name PATH_VALUES. */ - -/* - SPICELIB Version 1.0.0, 01-JUL-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Generic loading and unloading of SPICE kernels */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Here we set up the database of loaded kernels */ - -/* The name of every file loaded through this interface will */ -/* be stored in the array FILES. */ - - -/* The handle of every loaded file will be stored in the array */ -/* HANDLS. If the file is a text kernel it will be assigned the */ -/* handle 0. */ - - -/* The source of each file specified will be stored in the integer */ -/* array SOURCE. If the file is loaded directly, its source */ -/* will be zero. If it is loaded as the result of meta-information */ -/* in a text kernel, the index of the source file in FILES will */ -/* be stored in SRCES. */ - - -/* The file type of every loaded kernel will be stored in the array */ -/* TYPES. */ - - -/* The number of files loaded through this interfaces is kept in the */ -/* integer LOADED. */ - - switch(n__) { - case 1: goto L_furnsh; - case 2: goto L_ktotal; - case 3: goto L_kdata; - case 4: goto L_kinfo; - case 5: goto L_kclear; - case 6: goto L_unload; - } - - chkin_("KEEPER", (ftnlen)6); - setmsg_("The routine KEEPER is an umbrella for a collection of entry poi" - "nts that manage the loading, tracking and unloading of SPICE ker" - "nels. KEEPER should not be called directly. It is likely that a" - " programming error has been made. ", (ftnlen)225); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("KEEPER", (ftnlen)6); - return 0; -/* $Procedure FURNSH ( Furnish a program with SPICE kernels ) */ - -L_furnsh: -/* $ Abstract */ - -/* Load one or more SPICE kernels into a program. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) FILE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I SPICE kernel file (text or binary). */ -/* FILSIZ P Maximum file name length. */ - -/* $ Detailed_Input */ - -/* FILE is a SPICE kernel file. The file may be either binary */ -/* or text. If the file is a binary SPICE kernel it will */ -/* be loaded into the appropriate SPICE subsystem. If */ -/* FILE is a SPICE text kernel it will be loaded into the */ -/* kernel pool. If FILE is a SPICE meta-kernel containing */ -/* initialization instructions (through use of the */ -/* correct kernel pool variables), the files specified in */ -/* those variables will be loaded into the appropriate */ -/* SPICE subsystem. */ - -/* The SPICE text kernel format supports association of */ -/* names and data values using a "keyword = value" */ -/* format. The keyword-value pairs thus defined are */ -/* called "kernel variables." */ - -/* While any information can be placed in a text kernel */ -/* file, the following string valued kernel variables are */ -/* recognized by SPICE as meta-kernel keywords: */ - -/* KERNELS_TO_LOAD */ -/* PATH_SYMBOLS */ -/* PATH_VALUES */ - -/* Each kernel variable is discussed below. */ - -/* KERNELS_TO_LOAD is a list of SPICE kernels to be */ -/* loaded into a program. If file */ -/* names do not fit within the kernel */ -/* pool 80 character limit, they may be */ -/* continued to subsequent array */ -/* elements by placing the continuation */ -/* character ('+') at the end of an */ -/* element and then placing the */ -/* remainder of the file name in the */ -/* next array element. (See the */ -/* examples below for an illustration */ -/* of this technique or consult the */ -/* routine STPOOL for further details.) */ - -/* You may use one or more PATH_SYMBOL */ -/* assignments (see below) to specify */ -/* strings to be substituted for some */ -/* part of a file name. */ - -/* PATH_SYMBOLS is a list of strings (without */ -/* embedded blanks) which if */ -/* encountered following the '$' */ -/* character will be replaced with the */ -/* corresponding PATH_VALUES string. */ -/* Note that PATH_SYMBOLS are */ -/* interpreted only in values */ -/* associated with the KERNELS_TO_LOAD */ -/* variable. There must be a one-to-one */ -/* correspondence between the values */ -/* supplied for PATH_SYMBOLS and */ -/* PATH_VALUES. For the purpose of */ -/* determining this correspondence, any */ -/* path value that is continued over */ -/* multiple array elements counts as a */ -/* single value. */ - -/* PATH_VALUES is a list of expansions to use when */ -/* PATH_SYMBOLS are encountered. If */ -/* path values do not fit within the */ -/* kernel pool 80 character limit, they */ -/* may be continued in the same way as */ -/* file names (see the KERNELS_TO_LOAD */ -/* description above). */ - -/* These kernel pool variables persist within the kernel */ -/* pool only until all kernels associated with the */ -/* variable KERNELS_TO_LOAD have been loaded. Once all */ -/* specified kernels have been loaded, the variables */ -/* KERNELS_TO_LOAD, PATH_SYMBOLS and PATH_VALUES are */ -/* removed from the kernel pool. */ - -/* $ Detailed_Output */ - -/* None. The routine loads various SPICE kernels for use by your */ -/* application. */ - -/* $ Parameters */ - -/* FILSIZ is the maximum file name length that can be */ -/* accommodated by this routine. */ - -/* MAXFIL is the number of entries that can be stored in KEEPER's */ -/* kernel database. Each time a kernel is loaded via */ -/* FURNSH, a database entry is created for that kernel. */ -/* If a meta-kernel is loaded, a database entry is created */ -/* for the meta-kernel itself and for all files referenced */ -/* in the meta-kernel's KERNELS_TO_LOAD specification. */ -/* Unloading a kernel or meta-kernel deletes database */ -/* entries created when the file was loaded. */ - -/* The parameter MAXFIL is an upper bound on number of */ -/* SPICE kernels that can be loaded at any time via the */ -/* KEEPER interface, but the number of kernels that can be */ -/* loaded may be smaller, since re-loading a loaded kernel */ -/* or meta-kernel results in creation of additional */ -/* database entries. */ - -/* Kernels loaded into the KEEPER system are subject to */ -/* constraints imposed by lower-level subsystems. The */ -/* binary kernel systems (SPK, CK, binary PCK, and EK) */ -/* have their own limits on the maximum number of kernels */ -/* that may be loaded. */ - -/* The total number of DAF-based files (this set includes */ -/* SPKs, CKs, and binary PCKs) that may be loaded at any */ -/* time may not exceed 1000. This limit applies whether */ -/* the files are loaded via FURNSH or lower-level loaders */ -/* such as SPKLEF or DAFOPR. File access performance */ -/* normally will degrade as the number of loaded kernels */ -/* increases. */ - -/* The total number of DAS-based files that may be loaded */ -/* at any time is currently limited to 20 files. */ - -/* $ Exceptions */ - -/* 1) If a problem is encountered while trying to load FILE, */ -/* it will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If the input FILE is a meta-kernel and some file in the */ -/* KERNELS_TO_LOAD assignment cannot be found, or if an error */ -/* occurs while trying to load a file specified by this */ -/* assignment, the error will be diagnosed by a routine in the */ -/* call tree of this routine, and this routine will return. Any */ -/* files loaded prior to encountering the missing file will */ -/* remain loaded. */ - -/* 3) If a PATH_SYMBOLS assignment is specified without a */ -/* corresponding PATH_VALUES assignment, the error */ -/* SPICE(NOPATHVALUE) will be signaled. */ - -/* 4) If a meta-text kernel is supplied to FURNSH that contains */ -/* instructions specifying that another meta-text kernel be */ -/* loaded, the error SPICE(RECURSIVELOADING) will be signaled. */ - -/* 5) If the input file name has non-blank length exceeding FILSIZ */ -/* characters, the error SPICE(FILENAMETOOLONG) is signaled. */ - -/* 6) If the input file is a meta-kernel and some file in the */ -/* KERNELS_TO_LOAD assignment has name length exceeding FILSIZ */ -/* characters, the error SPICE(FILENAMETOOLONG) is signaled. */ - -/* 7) If the input file is a meta-kernel and some value in the */ -/* PATH_VALUES assignment has length exceeding FILSIZ */ -/* characters, the error SPICE(PATHTOOLONG) is signaled. */ - -/* 8) If the input file is a meta-kernel and some file in the */ -/* KERNELS_TO_LOAD assignment has, after symbol substitution, */ -/* combined name and path length exceeding FILSIZ characters, the */ -/* error SPICE(FILENAMETOOLONG) is signaled. */ - -/* 9) The error 'SPICE(BADVARNAME)' signals from a routine in the */ -/* call tree of FURNSH if a kernel pool variable name length */ -/* exceeds MAXLEN characters (defined in pool.f). */ - -/* $ Files */ - -/* The input FILE is examined and loaded into the appropriate SPICE */ -/* subsystem. If the file is a meta-kernel, any kernels specified */ -/* by the KERNELS_TO_LOAD keyword (and if present, the PATH_SYMBOLS */ -/* and PATH_VALUES keywords) are loaded as well. */ - -/* $ Particulars */ - -/* This routine provides a uniform interface to the SPICE kernel */ -/* loading systems. It allows you to easily assemble a list of */ -/* SPICE kernels required by your application and to modify that set */ -/* without modifying the source code of programs that make use of */ -/* these kernels. */ - -/* $ Examples */ - -/* Example 1 */ -/* --------- */ - -/* Load the leapseconds kernel naif0007.tls and the planetary */ -/* ephemeris SPK file de405s.bsp. */ - -/* CALL FURNSH ( 'naif0007.tls' ) */ -/* CALL FURNSH ( 'de405s.bsp' ) */ - - -/* Example 2 */ -/* --------- */ - -/* This example illustrates how you could create a meta-kernel file */ -/* for a program that requires several text and binary kernels. */ - -/* First create a list of the kernels you need in a text file as */ -/* shown below. */ - -/* \begintext */ - -/* Here are the SPICE kernels required for my application */ -/* program. */ - -/* Note that kernels are loaded in the order listed. Thus we */ -/* need to list the highest priority kernel last. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( */ - -/* '/home/mydir/kernels/spk/lowest_priority.bsp', */ -/* '/home/mydir/kernels/spk/next_priority.bsp', */ -/* '/home/mydir/kernels/spk/highest_priority.bsp', */ -/* '/home/mydir/kernels/text/leapsecond.ker', */ -/* '/home/mydir/kernels+', */ -/* '/custom+', */ -/* '/kernel_data/constants.ker', */ -/* '/home/mydir/kernels/text/sclk.tsc', */ -/* '/home/mydir/kernels/ck/c-kernel.bc' ) */ - - -/* Note that the file name */ - -/* /home/mydir/kernels/custom/kernel_data/constants.ker */ - -/* is continued across several lines in the right hand side of the */ -/* assignment of the kernel variable KERNELS_TO_LOAD. */ - -/* Once you've created your list of kernels, call FURNSH near the */ -/* beginning of your application program to load the meta-kernel */ -/* automatically at program start up. */ - -/* CALL FURNSH ( 'myfile.txt' ) */ - -/* This will cause each of the kernels listed in your meta-kernel */ -/* to be loaded. */ - - -/* Example 3 */ -/* --------- */ - -/* This example illustrates how you can simplify the previous */ -/* kernel list by using PATH_SYMBOLS. */ - - -/* \begintext */ - -/* Here are the SPICE kernels required for my application */ -/* program. */ - -/* We are going to let A substitute for the directory that */ -/* contains SPK files; B substitute for the directory that */ -/* contains C-kernels; and C substitute for the directory that */ -/* contains text kernels. And we'll let D substitute for */ -/* a "custom" directory that contains a special planetary */ -/* constants kernel made just for our mission. */ - -/* Note that our PATH_VALUES and the corresponding */ -/* PATH_SYMBOLS must be listed in the same order. */ - - -/* \begindata */ - -/* PATH_VALUES = ( '/home/mydir/kernels/spk', */ -/* '/home/mydir/kernels/ck', */ -/* '/home/mydir/kernels/text', */ -/* '/home/mydir/kernels/custom/kernel_data' ) */ - -/* PATH_SYMBOLS = ( 'A', */ -/* 'B', */ -/* 'C', */ -/* 'D' ) */ - -/* KERNELS_TO_LOAD = ( '$A/lowest_priority.bsp', */ -/* '$A/next_priority.bsp', */ -/* '$A/highest_priority.bsp', */ -/* '$C/leapsecond.ker', */ -/* '$D/constants.ker', */ -/* '$C/sclk.tsc', */ -/* '$B/c-kernel.bc' ) */ - - -/* Example 4 */ -/* --------- */ - -/* This example illustrates continuation of path values. The */ -/* meta-kernel shown here is a modified version of that from */ -/* example 3. */ - -/* \begintext */ - -/* Here are the SPICE kernels required for my application */ -/* program. */ - -/* We are going to let A substitute for the directory that */ -/* contains SPK files; B substitute for the directory that */ -/* contains C-kernels; and C substitute for the directory that */ -/* contains text kernels. And we'll let D substitute for */ -/* a "custom" directory that contains a special planetary */ -/* constants kernel made just for our mission. */ - -/* Note that our PATH_VALUES and the corresponding */ -/* PATH_SYMBOLS must be listed in the same order. */ - -/* The values for path symbols A and D are continued over */ -/* multiple lines. */ - -/* \begindata */ - -/* PATH_VALUES = ( '/very_long_top_level_path_name/mydir/+', */ -/* 'kernels/spk', */ -/* '/home/mydir/kernels/ck', */ -/* '/home/mydir/kernels/text', */ -/* '/very_long_top_level_path_name+', */ -/* '/mydir/kernels/custom+', */ -/* '/kernel_data' ) */ - -/* PATH_SYMBOLS = ( 'A', */ -/* 'B', */ -/* 'C', */ -/* 'D' ) */ - -/* KERNELS_TO_LOAD = ( '$A/lowest_priority.bsp', */ -/* '$A/next_priority.bsp', */ -/* '$A/highest_priority.bsp', */ -/* '$C/leapsecond.ker', */ -/* '$D/constants.ker', */ -/* '$C/sclk.tsc', */ -/* '$B/c-kernel.bc' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.1, 10-FEB-2010 (EDW) */ - -/* Added mention of the restriction on kernel pool variable */ -/* names to MAXLEN (defined in pool.f) characters or less. */ - -/* - SPICELIB Version 4.0.0, 02-APR-2009 (NJB) */ - -/* Continued path values are now supported. FURNSH now rejects */ -/* file names longer than FILSIZ characters. */ - -/* - SPICELIB Version 2.0.3, 27-APR-2007 (NJB) */ - -/* Fixed header typo: added quotes to literal string */ -/* input arguments in example FURNSH calls. */ - -/* - SPICELIB Version 2.0.2, 15-NOV-2006 (NJB) */ - -/* Added description of parameter MAXFIL to header. */ - -/* - SPICELIB Version 2.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Numerous updates to improve clarity. Some corrections were */ -/* made. */ - -/* - SPICELIB VERSION 2.0.0, 23-AUG-2001 (WLT) */ - -/* Added a call to CVPOOL in FURNSH so that watches that are */ -/* triggered are triggered by loading Meta-kernels and not by */ -/* some external interaction with the kernel pool. */ - -/* - SPICELIB Version 1.1.0, 19-SEP-2000 (WLT) */ - -/* Corrected the error message template used */ -/* by ZZLDKER */ - -/* - SPICELIB Version 1.0.1, 16-DEC-1999 (NJB) */ - -/* Documentation fix: corrected second code example in the */ -/* header of this entry point. The example previously used the */ -/* kernel variable PATH_NAMES; that name has been replaced with */ -/* the correct name PATH_VALUES. */ - -/* - SPICELIB Version 1.0.0, 01-JUL-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Load SPICE kernels from a list of kernels */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("FURNSH", (ftnlen)6); - if (first) { - first = FALSE_; - s_copy(known, "KERNELS_TO_LOAD", (ftnlen)32, (ftnlen)15); - s_copy(known + 32, "PATH_SYMBOLS", (ftnlen)32, (ftnlen)12); - s_copy(known + 64, "PATH_VALUES", (ftnlen)32, (ftnlen)11); - loaded = 0; - swpool_("FURNSH", &c__3, known, (ftnlen)6, (ftnlen)32); - cvpool_("FURNSH", &update, (ftnlen)6); - } - -/* Reject excessively long file names. */ - - if (rtrim_(file, file_len) > 255) { - setmsg_("Input file name <#> has length @ characters. The limit on t" - "he length of file names stored by FURNSH is @ characters.", ( - ftnlen)116); - errch_("#", file, (ftnlen)1, file_len); - i__1 = rtrim_(file, file_len); - errint_("@", &i__1, (ftnlen)1); - errint_("@", &c__255, (ftnlen)1); - sigerr_("SPICE(FILENAMETOOLONG)", (ftnlen)22); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - -/* Make sure we have room to load at least one more file. */ - - if (loaded == 1300) { - setmsg_("There is no room left in KEEPER to load another SPICE kerne" - "l. The current limit on the number of files that can be loa" - "ded is #. If you really need more than this many files, you" - " should increase the parameter MAXFIL in the subroutine KEEP" - "ER. ", (ftnlen)243); - errint_("#", &c__1300, (ftnlen)1); - sigerr_("SPICE(NOMOREROOM)", (ftnlen)17); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - -/* We don't want external interactions with the kernel pool to */ -/* have any affect on FURNSH's watch so we check the watcher */ -/* here prior to the call to ZZLDKER. */ - - cvpool_("FURNSH", &update, (ftnlen)6); - -/* Set a preliminary value for the error message in case the */ -/* call to ZZLDKER doesn't succeed. */ - - s_copy(nofile, "The attempt to load \"#\" by the routine FURNSH failed. " - "It #", (ftnlen)500, (ftnlen)58); - zzldker_(file, nofile, thstyp, &myhand, file_len, (ftnlen)500, (ftnlen)8); - if (failed_()) { - chkout_("FURNSH", (ftnlen)6); - return 0; - } - ++loaded; - cursrc = loaded; - s_copy(files + ((i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "files", i__1, "keeper_", (ftnlen)1001)) * 255, file, (ftnlen)255, - file_len); - s_copy(types + (((i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "types", i__1, "keeper_", (ftnlen)1002)) << 3), thstyp, (ftnlen)8, - (ftnlen)8); - handls[(i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge("handls", - i__1, "keeper_", (ftnlen)1003)] = myhand; - srces[(i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge("srces", - i__1, "keeper_", (ftnlen)1004)] = 0; - cvpool_("FURNSH", &update, (ftnlen)6); - if (! update) { - -/* Nothing to do. None of the control variables */ -/* were set in FILE. */ - - chkout_("FURNSH", (ftnlen)6); - return 0; - } - -/* See what is present in the kernel pool: Are any path symbols */ -/* defined? */ - - dtpool_("PATH_SYMBOLS", &paths, &npaths, norc, (ftnlen)12, (ftnlen)1); - if (paths && *(unsigned char *)norc == 'C') { - -/* Make sure that the values are equal in number. We need to */ -/* use STPOOL to count the path values, since some of them */ -/* might span multiple array elements. */ - - i__ = 1; - stpool_("PATH_VALUES", &i__, "+", pvalue, &size, &ok, (ftnlen)11, ( - ftnlen)1, (ftnlen)255); - while(ok && ! failed_()) { - -/* Reject excessively long path names. */ - - if (size > 255) { - setmsg_("In meta-kernel <#>, the path at index # in the PATH" - "_VALUES list has length # characters; the limit is #" - " characters.", (ftnlen)115); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &i__, (ftnlen)1); - errint_("#", &size, (ftnlen)1); - errint_("#", &c__255, (ftnlen)1); - sigerr_("SPICE(PATHTOOLONG)", (ftnlen)18); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - ++i__; - stpool_("PATH_VALUES", &i__, "+", pvalue, &size, &ok, (ftnlen)11, - (ftnlen)1, (ftnlen)255); - } - if (failed_()) { - chkout_("FURNSH", (ftnlen)6); - return 0; - } - npvals = i__ - 1; - if (npvals != npaths) { - setmsg_("Number of path symbols is #; number of path values is #" - "; counts must match.", (ftnlen)75); - errint_("#", &npaths, (ftnlen)1); - errint_("#", &npvals, (ftnlen)1); - sigerr_("SPICE(PATHMISMATCH)", (ftnlen)19); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - } else { - paths = FALSE_; - } - -/* This kernel appears to be a legitimate meta-text kernel. Mark */ -/* it as such and then process its contents. */ - - s_copy(types + (((i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "types", i__1, "keeper_", (ftnlen)1087)) << 3), "META", (ftnlen)8, - (ftnlen)4); - -/* Now load all kernels specified in the KERNELS_TO_LOAD variable. */ - - filnum = 1; - stpool_("KERNELS_TO_LOAD", &filnum, "+", fil2ld, &fnmlen, &ok, (ftnlen)15, - (ftnlen)1, (ftnlen)255); - while(ok && ! failed_()) { - -/* Reject excessively long file names. */ - - if (fnmlen > 255) { - setmsg_("In meta-kernel <#>, the file name at index # in the KER" - "NELS_TO_LOAD list has length # characters; the limit is " - "# characters.", (ftnlen)124); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &filnum, (ftnlen)1); - errint_("#", &fnmlen, (ftnlen)1); - errint_("#", &c__255, (ftnlen)1); - sigerr_("SPICE(FILENAMETOOLONG)", (ftnlen)22); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - -/* Make sure we have room to load at least one more file. */ - - if (loaded == 1300) { - setmsg_("There is no room left in KEEPER to load another SPICE k" - "ernel. The current limit on the number of files that can" - " be loaded is #.", (ftnlen)127); - errint_("#", &c__1300, (ftnlen)1); - sigerr_("SPICE(NOMOREROOM)", (ftnlen)17); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - -/* Resolve any path symbols that may be present. */ -/* Make sure we have room to load at least one more file. */ - - if (paths) { - start = 1; - dollar = pos_(fil2ld, "$", &start, (ftnlen)255, (ftnlen)1); - while(dollar > 0) { - -/* Determine the longest path symbol that fits into the */ -/* current file name. We fetch path symbols one at a */ -/* time and see if they match the portion of the */ -/* string that follows the '$'. The longest match */ -/* is the one we use as a symbol. */ - - size = 0; - use = 0; - d__ = dollar; - i__1 = npaths; - for (i__ = 1; i__ <= i__1; ++i__) { - gcpool_("PATH_SYMBOLS", &i__, &c__1, &n, symbol, &fnd, ( - ftnlen)12, (ftnlen)80); - r__ = rtrim_(symbol, (ftnlen)80); - i__2 = d__ + 1; - i__3 = d__ + r__; - if (r__ > size && samsub_(symbol, &c__1, &r__, fil2ld, & - i__2, &i__3, (ftnlen)80, (ftnlen)255)) { - use = i__; - size = r__; - } - } - -/* If we found a matching path symbol, get the corresponding */ -/* value and put it into the file name. */ - - if (use > 0) { - -/* Get the path value having index USE in the set of */ -/* path values. Note that we've already checked that */ -/* the path value will fit in PVALUE. */ - - stpool_("PATH_VALUES", &use, "+", pvalue, &n, &fnd, ( - ftnlen)11, (ftnlen)1, (ftnlen)255); - -/* When the path is substituted for the symbol, the */ -/* total length of the path and file name must fit in */ -/* the name buffer. */ - - if (fnmlen + n - size - 1 > 255) { - setmsg_("In meta-kernel <#>, the path at index # in " - "the PATH_SYMBOLS list has # characters and t" - "he file name at index # has # characters. Th" - "e combined path and file name has # characte" - "rs; the limit is # characters.", (ftnlen)205); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &use, (ftnlen)1); - errint_("#", &n, (ftnlen)1); - errint_("#", &filnum, (ftnlen)1); - errint_("#", &fnmlen, (ftnlen)1); - i__1 = fnmlen + n; - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__255, (ftnlen)1); - sigerr_("SPICE(FILENAMETOOLONG)", (ftnlen)22); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - i__1 = d__ + size; - repsub_(fil2ld, &d__, &i__1, pvalue, fil2ld, (ftnlen)255, - n, (ftnlen)255); - } - -/* Look for the next occurrence of a '$' after the last */ -/* place we found one. */ - - start = dollar + 1; - dollar = pos_(fil2ld, "$", &start, (ftnlen)255, (ftnlen)1); - } - } - -/* If any path symbols were present, they have now been */ -/* resolved. Let ZZLDKER handle the task of loading this */ -/* kernel. Make up a message template for use if ZZLDKER */ -/* runs into a problem. */ - - s_copy(nofile, "The @ file '#' specified by KERNELS_TO_LOAD in the f" - "ile @ #", (ftnlen)500, (ftnlen)59); - repmot_(nofile, "@", &filnum, "L", nofile, (ftnlen)500, (ftnlen)1, ( - ftnlen)1, (ftnlen)500); - repmc_(nofile, "@", file, nofile, (ftnlen)500, (ftnlen)1, file_len, ( - ftnlen)500); - zzldker_(fil2ld, nofile, thstyp, &myhand, (ftnlen)255, (ftnlen)500, ( - ftnlen)8); - if (failed_()) { - chkout_("FURNSH", (ftnlen)6); - return 0; - } - if (s_cmp(thstyp, "TEXT", (ftnlen)8, (ftnlen)4) == 0) { - -/* See if we stepped on any of the recognized variables. If */ -/* we did, there's no point in trying to continue. */ - - cvpool_("FURNSH", &update, (ftnlen)6); - if (update) { - -/* First clean up the debris created by this attempt */ -/* at recursion. */ - - for (i__ = 1; i__ <= 3; ++i__) { - dvpool_(known + (((i__1 = i__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("known", i__1, "keeper_", (ftnlen) - 1252)) << 5), (ftnlen)32); - } - -/* Take care of any watcher activation caused by the */ -/* mop-up of the preceding loop. */ - - cvpool_("FURNSH", &update, (ftnlen)6); - setmsg_("Hmmm. This is interesting. In the meta-text kernel" - " '#' you've requested that the text kernel '#' be lo" - "aded. This second file is also a \"meta-text\" kerne" - "l and specifies new kernel loading instructions. Alt" - "hough you receive high marks for creativity, this pa" - "th is fraught with peril and can not be supported by" - " FURNSH. ", (ftnlen)318); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", fil2ld, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(RECURSIVELOADING)", (ftnlen)23); - chkout_("FURNSH", (ftnlen)6); - return 0; - } - } - -/* Add the latest file loaded to our database of loaded */ -/* files. */ - - ++loaded; - s_copy(files + ((i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("files", i__1, "keeper_", (ftnlen)1284)) * 255, fil2ld, - (ftnlen)255, (ftnlen)255); - s_copy(types + (((i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)1285)) << 3), thstyp, - (ftnlen)8, (ftnlen)8); - handls[(i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge("hand" - "ls", i__1, "keeper_", (ftnlen)1286)] = myhand; - srces[(i__1 = loaded - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge("srces", - i__1, "keeper_", (ftnlen)1287)] = cursrc; - -/* Get the name of the next file to load. */ - - ++filnum; - stpool_("KERNELS_TO_LOAD", &filnum, "+", fil2ld, &fnmlen, &ok, ( - ftnlen)15, (ftnlen)1, (ftnlen)255); - } - -/* Last Step. Remove the special variables from the kernel pool. */ - - for (i__ = 1; i__ <= 3; ++i__) { - dvpool_(known + (((i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "known", i__1, "keeper_", (ftnlen)1303)) << 5), (ftnlen)32); - } - cvpool_("FURNSH", &update, (ftnlen)6); - chkout_("FURNSH", (ftnlen)6); - return 0; -/* $Procedure KTOTAL ( Kernel Totals ) */ - -L_ktotal: -/* $ Abstract */ - -/* Return the number of kernels that are currently loaded */ -/* via the KEEPER interface and that are of a specified type. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Declarations */ - -/* CHARACTER*(*) KIND */ -/* INTEGER COUNT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KIND I A list of kinds of kernels to count. */ -/* COUNT O The number of kernels of type KIND. */ - -/* $ Detailed_Input */ - -/* KIND is a list of types of kernels to count when */ -/* computing loaded kernels. KIND should consist */ -/* of a list of words of kernels to examine. Recognized */ -/* types are */ - -/* SPK --- all SPK files are counted in the total. */ -/* CK --- all CK files are counted in the total. */ -/* PCK --- all binary PCK files are counted in the */ -/* total. */ -/* EK --- all EK files are counted in the total. */ -/* TEXT --- all text kernels that are not meta-text */ -/* kernels are included in the total. */ -/* META --- all meta-text kernels are counted in the */ -/* total. */ -/* ALL --- every type of kernel is counted in the */ -/* total. */ - -/* KIND is case insensitive. If a word appears in KIND */ -/* that is not one of those listed above it is ignored. */ - -/* See the Examples section for illustrations of the */ -/* use of KIND. */ - -/* $ Detailed_Output */ - -/* COUNT is the number of kernels loaded through FURNSH that */ -/* belong to the list specified by KIND. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a word on the list specified by KIND is not recognized */ -/* it is ignored. */ - -/* 2) If KIND is blank, or none of the words in KIND is on the */ -/* list specified above, COUNT will be returned as zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* KTOTAL allows you to easily determine the number of kernels */ -/* loaded via the interface FURNSH that are of a type of interest. */ - -/* $ Examples */ - -/* Suppose you wish to determine the number of SPK kernels that */ -/* have been loaded via the interface FURNSH. Assign KIND */ -/* the value 'SPK' and call KTOTAL as shown: */ - - -/* KIND = 'SPK' */ -/* CALL KTOTAL ( KIND, COUNT ) */ - -/* WRITE (*,*) 'The number of loaded SPK files is: ', COUNT */ - -/* To determine the number of text kernels that are loaded that */ -/* are not meta-kernels: */ - -/* KIND = 'TEXT' */ -/* CALL KTOTAL ( KIND, NTEXT ) */ - -/* WRITE (*,*) 'The number of non-meta-text kernels loaded is: ' */ -/* . NTEXT */ - -/* To determine the number of SPK, CK and PCK kernels loaded */ -/* make the following call: */ - -/* KIND = 'SPK PCK CK' */ -/* CALL KTOTAL ( KIND, COUNT ) */ - - -/* To get a count of all loaded kernels */ - -/* KIND = 'ALL' */ -/* CALL KTOTAL ( KIND, COUNT ) */ - -/* WRITE (*,*) 'There are ', COUNT, ' SPICE kernels loaded.' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 02-APR-2009 (NJB) */ - -/* Deleted reference to unneeded variable DOALL. */ - -/* - SPICELIB Version 1.0.0, 01-JUL-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Number of loaded kernels of a given type */ - -/* -& */ - if (loaded == 0) { - *count = 0; - return 0; - } - chkin_("KTOTAL", (ftnlen)6); - -/* Parse KIND to see which kernels are of interest. */ - - dospk = FALSE_; - dock = FALSE_; - dotext = FALSE_; - dometa = FALSE_; - doek = FALSE_; - dopck = FALSE_; - start = 1; - fndnwd_(kind, &start, &b, &e, kind_len); - while(b > 0) { - if (eqstr_(kind + (b - 1), "ALL", e - (b - 1), (ftnlen)3)) { - *count = loaded; - chkout_("KTOTAL", (ftnlen)6); - return 0; - } else { - dock = dock || eqstr_(kind + (b - 1), "CK", e - (b - 1), (ftnlen) - 2); - doek = doek || eqstr_(kind + (b - 1), "EK", e - (b - 1), (ftnlen) - 2); - dometa = dometa || eqstr_(kind + (b - 1), "META", e - (b - 1), ( - ftnlen)4); - dopck = dopck || eqstr_(kind + (b - 1), "PCK", e - (b - 1), ( - ftnlen)3); - dospk = dospk || eqstr_(kind + (b - 1), "SPK", e - (b - 1), ( - ftnlen)3); - dotext = dotext || eqstr_(kind + (b - 1), "TEXT", e - (b - 1), ( - ftnlen)4); - } - start = e + 1; - fndnwd_(kind, &start, &b, &e, kind_len); - } - *count = 0; - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - add = s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)1529)) << 3), "CK", ( - ftnlen)8, (ftnlen)2) == 0 && dock || s_cmp(types + (((i__3 = - i__ - 1) < 1300 && 0 <= i__3 ? i__3 : s_rnge("types", i__3, - "keeper_", (ftnlen)1529)) << 3), "EK", (ftnlen)8, (ftnlen)2) - == 0 && doek || s_cmp(types + (((i__4 = i__ - 1) < 1300 && 0 - <= i__4 ? i__4 : s_rnge("types", i__4, "keeper_", (ftnlen) - 1529)) << 3), "META", (ftnlen)8, (ftnlen)4) == 0 && dometa || - s_cmp(types + (((i__5 = i__ - 1) < 1300 && 0 <= i__5 ? i__5 : - s_rnge("types", i__5, "keeper_", (ftnlen)1529)) << 3), "PCK", - (ftnlen)8, (ftnlen)3) == 0 && dopck || s_cmp(types + (((i__6 = - i__ - 1) < 1300 && 0 <= i__6 ? i__6 : s_rnge("types", i__6, - "keeper_", (ftnlen)1529)) << 3), "SPK", (ftnlen)8, (ftnlen)3) - == 0 && dospk || s_cmp(types + (((i__7 = i__ - 1) < 1300 && 0 - <= i__7 ? i__7 : s_rnge("types", i__7, "keeper_", (ftnlen) - 1529)) << 3), "TEXT", (ftnlen)8, (ftnlen)4) == 0 && dotext; - if (add) { - ++(*count); - } - } - chkout_("KTOTAL", (ftnlen)6); - return 0; -/* $Procedure KDATA ( Kernel Data ) */ - -L_kdata: -/* $ Abstract */ - -/* Return data for the nth kernel that is among a list of specified */ -/* kernel types. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Declarations */ - -/* INTEGER WHICH */ -/* CHARACTER*(*) KIND */ -/* CHARACTER*(*) FILE */ -/* CHARACTER*(*) FILTYP */ -/* CHARACTER*(*) SOURCE */ -/* INTEGER HANDLE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WHICH I Index of kernel to fetch from the list of kernels. */ -/* KIND I The kind of kernel to which fetches are limited. */ -/* FILE O The name of the kernel file. */ -/* FILTYP O The type of the kernel. */ -/* SOURCE O Name of the source file used to load FILE. */ -/* HANDLE O The handle attached to FILE. */ -/* FOUND O TRUE if the specified file could be located. */ - -/* $ Detailed_Input */ - -/* WHICH is the number of the kernel to fetch (matching the */ -/* type specified by KIND) from the list of kernels that */ -/* have been loaded through the entry point FURNSH but */ -/* that have not been unloaded through the entry point */ -/* UNLOAD. */ - -/* KIND is a list of types of kernels to be considered when */ -/* fetching kernels from the list of loaded kernels. KIND */ -/* should consist of words from list of kernel types */ -/* given below. */ - -/* SPK --- All SPK files are counted in the total. */ -/* CK --- All CK files are counted in the total. */ -/* PCK --- All binary PCK files are counted in the */ -/* total. */ -/* EK --- All EK files are counted in the total. */ -/* TEXT --- All text kernels that are not meta-text */ -/* kernels are included in the total. */ -/* META --- All meta-text kernels are counted in the */ -/* total. */ -/* ALL --- Every type of kernel is counted in the */ -/* total. */ - -/* KIND is case insensitive. If a word appears in KIND */ -/* that is not one of those listed above it is ignored. */ - -/* See the entry point KTOTAL for examples of the use */ -/* of KIND. */ - -/* $ Detailed_Output */ - -/* FILE is the name of the WHICH'th file of a type matching */ -/* KIND that is currently loaded via FURNSH. FILE */ -/* will be blank if there is not a WHICH'th kernel. */ - -/* FILTYP is the type of the kernel specified by FILE. FILE */ -/* will be blank if there is no file matching the */ -/* specification of WHICH and KIND. */ - -/* SOURCE is the name of the source file that was used to */ -/* specify FILE as one to load. If FILE was loaded */ -/* directly via a call to FURNSH, SOURCE will be blank. */ -/* If there is no file matching the specification of */ -/* WHICH and KIND, SOURCE will be blank. */ - -/* HANDLE is the handle attached to FILE if it is a binary */ -/* kernel. If FILE is a text kernel or meta-text kernel */ -/* HANDLE will be zero. If there is no file matching */ -/* the specification of WHICH and KIND, HANDLE will be */ -/* set to zero. */ - -/* FOUND is returned TRUE if a FILE matching the specification */ -/* of WHICH and KIND exists. If there is no such file, */ -/* FOUND will be set to FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If a file is not loaded matching the specification of WHICH */ -/* and KIND, FOUND will be FALSE, FILE, FILTYP, and SOURCE */ -/* will be blank and HANDLE will be set to zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point allows you to determine which kernels have */ -/* been loaded via FURNSH and to obtain information sufficient */ -/* to directly query those files. */ - -/* $ Examples */ - -/* The following example shows how you could print a summary */ -/* of SPK files that have been loaded through the interface */ -/* FURNSH. */ - - -/* CALL KTOTAL ( 'SPK', COUNT ) */ - -/* IF ( COUNT .EQ. 0 ) THEN */ -/* WRITE (*,*) 'There are no SPK files loaded at this time.' */ -/* ELSE */ -/* WRITE (*,*) 'The loaded SPK files are: ' */ -/* WRITE (*,*) */ -/* END IF */ - -/* DO WHICH = 1, COUNT */ - -/* CALL KDATA( WHICH, 'SPK', FILE, FILTYP, SOURCE, HANDLE, FOUND ) */ -/* WRITE (*,*) FILE */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 02-APR-2009 (NJB) */ - -/* Deleted reference to unneeded variable DOALL. */ - -/* - SPICELIB Version 1.0.1, 06-DEC-2002 (NJB) */ - -/* Typo in header example was corrected. */ - -/* - SPICELIB Version 1.0.0, 01-JUL-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Retrieve information on loaded SPICE kernels */ - -/* -& */ - s_copy(file, " ", file_len, (ftnlen)1); - s_copy(filtyp, " ", filtyp_len, (ftnlen)1); - s_copy(source, " ", source_len, (ftnlen)1); - *handle = 0; - *found = FALSE_; - if (*which < 1 || *which > loaded) { - return 0; - } - -/* Parse KIND to see which kernels are of interest. */ - - dospk = FALSE_; - dock = FALSE_; - dotext = FALSE_; - dometa = FALSE_; - doek = FALSE_; - dopck = FALSE_; - start = 1; - fndnwd_(kind, &start, &b, &e, kind_len); - while(b > 0) { - if (eqstr_(kind + (b - 1), "ALL", e - (b - 1), (ftnlen)3)) { - -/* There's no point in going on, we can fill in the output */ -/* variables right now. */ - - *found = TRUE_; - s_copy(file, files + ((i__1 = *which - 1) < 1300 && 0 <= i__1 ? - i__1 : s_rnge("files", i__1, "keeper_", (ftnlen)1774)) * - 255, file_len, (ftnlen)255); - s_copy(filtyp, types + (((i__1 = *which - 1) < 1300 && 0 <= i__1 ? - i__1 : s_rnge("types", i__1, "keeper_", (ftnlen)1775)) << - 3), filtyp_len, (ftnlen)8); - *handle = handls[(i__1 = *which - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("handls", i__1, "keeper_", (ftnlen)1776)]; - if (srces[(i__1 = *which - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "srces", i__1, "keeper_", (ftnlen)1778)] != 0) { - s_copy(source, files + ((i__2 = srces[(i__1 = *which - 1) < - 1300 && 0 <= i__1 ? i__1 : s_rnge("srces", i__1, - "keeper_", (ftnlen)1779)] - 1) < 1300 && 0 <= i__2 ? - i__2 : s_rnge("files", i__2, "keeper_", (ftnlen)1779)) - * 255, source_len, (ftnlen)255); - } - return 0; - } else { - dock = dock || eqstr_(kind + (b - 1), "CK", e - (b - 1), (ftnlen) - 2); - doek = doek || eqstr_(kind + (b - 1), "EK", e - (b - 1), (ftnlen) - 2); - dometa = dometa || eqstr_(kind + (b - 1), "META", e - (b - 1), ( - ftnlen)4); - dopck = dopck || eqstr_(kind + (b - 1), "PCK", e - (b - 1), ( - ftnlen)3); - dospk = dospk || eqstr_(kind + (b - 1), "SPK", e - (b - 1), ( - ftnlen)3); - dotext = dotext || eqstr_(kind + (b - 1), "TEXT", e - (b - 1), ( - ftnlen)4); - } - start = e + 1; - fndnwd_(kind, &start, &b, &e, kind_len); - } - -/* Examine the loaded kernels one at a time until we match */ -/* WHICH files of the specified KIND. */ - - hits = 0; - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - add = s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)1805)) << 3), "CK", ( - ftnlen)8, (ftnlen)2) == 0 && dock || s_cmp(types + (((i__3 = - i__ - 1) < 1300 && 0 <= i__3 ? i__3 : s_rnge("types", i__3, - "keeper_", (ftnlen)1805)) << 3), "EK", (ftnlen)8, (ftnlen)2) - == 0 && doek || s_cmp(types + (((i__4 = i__ - 1) < 1300 && 0 - <= i__4 ? i__4 : s_rnge("types", i__4, "keeper_", (ftnlen) - 1805)) << 3), "META", (ftnlen)8, (ftnlen)4) == 0 && dometa || - s_cmp(types + (((i__5 = i__ - 1) < 1300 && 0 <= i__5 ? i__5 : - s_rnge("types", i__5, "keeper_", (ftnlen)1805)) << 3), "PCK", - (ftnlen)8, (ftnlen)3) == 0 && dopck || s_cmp(types + (((i__6 = - i__ - 1) < 1300 && 0 <= i__6 ? i__6 : s_rnge("types", i__6, - "keeper_", (ftnlen)1805)) << 3), "SPK", (ftnlen)8, (ftnlen)3) - == 0 && dospk || s_cmp(types + (((i__7 = i__ - 1) < 1300 && 0 - <= i__7 ? i__7 : s_rnge("types", i__7, "keeper_", (ftnlen) - 1805)) << 3), "TEXT", (ftnlen)8, (ftnlen)4) == 0 && dotext; - if (add) { - ++hits; - -/* If we've reached the specified number, fill in the */ -/* requested information and return. */ - - if (hits == *which) { - *found = TRUE_; - s_copy(file, files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? - i__2 : s_rnge("files", i__2, "keeper_", (ftnlen)1822)) - * 255, file_len, (ftnlen)255); - s_copy(filtyp, types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 - ? i__2 : s_rnge("types", i__2, "keeper_", (ftnlen) - 1823)) << 3), filtyp_len, (ftnlen)8); - *handle = handls[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)1824)]; - if (srces[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("srces", i__2, "keeper_", (ftnlen)1826)] != 0) - { - s_copy(source, files + ((i__3 = srces[(i__2 = i__ - 1) < - 1300 && 0 <= i__2 ? i__2 : s_rnge("srces", i__2, - "keeper_", (ftnlen)1827)] - 1) < 1300 && 0 <= - i__3 ? i__3 : s_rnge("files", i__3, "keeper_", ( - ftnlen)1827)) * 255, source_len, (ftnlen)255); - } - return 0; - } - } - } - return 0; -/* $Procedure KINFO ( Kernel Information ) */ - -L_kinfo: -/* $ Abstract */ - -/* Return information about a specific kernel */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Declarations */ - -/* CHARACTER*(*) FILE */ -/* CHARACTER*(*) FILTYP */ -/* CHARACTER*(*) SOURCE */ -/* INTEGER HANDLE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I Name of a kernel to fetch information for */ -/* FILTYP O The type of the kernel */ -/* SOURCE O Name of the source file used to load FILE. */ -/* HANDLE O The handle attached to FILE. */ -/* FOUND O TRUE if the specified file could be located. */ - -/* $ Detailed_Input */ - -/* FILE is the name of a kernel file for which KEEPER */ -/* information is desired. */ - -/* $ Detailed_Output */ - -/* FILTYP is the type of the kernel specified by FILE. FILE */ -/* will be blank if FILE is not on the list of loaded */ -/* kernels. */ - -/* SOURCE is the name of the source file that was used to */ -/* specify FILE as one to load. If FILE was loaded */ -/* directly via a call to FURNSH, SOURCE will be blank. */ -/* If FILE is not on the list of loaded kernels, SOURCE */ -/* will be blank */ - -/* HANDLE is the handle attached to FILE if it is a binary */ -/* kernel. If FILE is a text kernel or meta-text kernel */ -/* HANDLE will be zero. If FILE is not on the list of */ -/* loaded kernels, HANDLE will be set to zero. */ - -/* FOUND is returned TRUE if FILE is on the KEEPER list of */ -/* loaded kernels. If there is no such file, FOUND will */ -/* be set to FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the specified file is not on the list of files that */ -/* are currently loaded via the interface FURNSH, FOUND */ -/* will be FALSE, HANDLE will be set to zero and FILTYP */ -/* and SOURCE will be set to blanks. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point allows you to request information directly */ -/* for a specific SPICE kernel. */ - -/* $ Examples */ - -/* Suppose you wish to determine the type of a loaded kernel */ -/* so that you can call the correct summarizing routines */ -/* for the kernel. The following bit of pseudo code shows */ -/* how you might use this entry point together with summarizing */ -/* code to produce a report on the file. (Note that the */ -/* routines SPK_SUMMRY, CK_SUMMRY, PCK_SUMMRY and EK_SUMMRY */ -/* are simply names to indicate what you might do with the */ -/* information returned by KINFO. They are not routines that */ -/* are part of the SPICE toolkit.) */ - -/* FILE = '' */ - -/* CALL KINFO ( FILE, FILTYP, SOURCE, HANDLE, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is not loaded at this time.' */ -/* ELSE */ - -/* IF ( FILTYP .EQ. 'SPK' ) THEN */ - -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is an SPK file.' */ - -/* CALL SPK_SUMMRY ( HANDLE ) */ - -/* ELSE IF ( FILTYP .EQ. 'CK' ) THEN */ - -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is a CK file.' */ - -/* CALL CK_SUMMRY ( HANDLE ) */ - -/* ELSE IF ( FILTYP .EQ. 'PCK' ) THEN */ - -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is a PCK file.' */ - -/* CALL PCK_SUMMRY ( HANDLE ) */ - -/* ELSE IF ( FILTYP .EQ. 'EK' ) THEN */ - -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is an EK file.' */ - -/* CALL EK_SUMMRY ( HANDLE ) */ - -/* ELSE IF ( FILTYP .EQ. 'META') THEN */ -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is a meta-text kernel.' */ -/* ELSE */ -/* WRITE (*,*) FILE */ -/* WRITE (*,*) 'is a text kernel.' */ -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-JUL-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Fetch information about a loaded SPICE kernel */ - -/* -& */ - s_copy(filtyp, " ", filtyp_len, (ftnlen)1); - s_copy(source, " ", source_len, (ftnlen)1); - *handle = 0; - *found = FALSE_; - i__ = isrchc_(file, &loaded, files, file_len, (ftnlen)255); - if (i__ > 0) { - *found = TRUE_; - s_copy(filtyp, types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)2041)) << 3), - filtyp_len, (ftnlen)8); - *handle = handls[(i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "handls", i__1, "keeper_", (ftnlen)2042)]; - if (srces[(i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge("srces" - , i__1, "keeper_", (ftnlen)2044)] != 0) { - s_copy(source, files + ((i__2 = srces[(i__1 = i__ - 1) < 1300 && - 0 <= i__1 ? i__1 : s_rnge("srces", i__1, "keeper_", ( - ftnlen)2045)] - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge( - "files", i__2, "keeper_", (ftnlen)2045)) * 255, - source_len, (ftnlen)255); - } - } - return 0; -/* $Procedure KCLEAR ( Keeper clear ) */ - -L_kclear: -/* $ Abstract */ - -/* Clear the KEEPER system: unload all kernels, clear the kernel */ -/* pool, and re-initialize the system. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* None. */ - -/* $ Detailed_Input */ - -/* None. This routine operates by side effects. See Particulars */ -/* below. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors that occur when setting a kernel pool watch */ -/* or checking watched variables will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See Particulars. */ - -/* $ Particulars */ - -/* This entry point allows you re-initialize the KEEPER system with */ -/* a single call. */ - -/* This routine unloads all kernels from their kernel-type-specific */ -/* kernel management subsystems (SPKBSR, CKBSR, etc.), clears the */ -/* kernel pool, clears KEEPER's internal file database, and re-sets */ -/* the watch status for the kernel variables used to load kernels */ -/* via meta-kernels. */ - -/* This capability, though implemented in Fortran, is particularly */ -/* relevant to SPICE implementations such as Icy, for which the */ -/* state of the KEEPER system persists after any Icy-based IDL */ -/* script is run. Successive runs of Icy-based scripts may perform */ -/* in unexpected ways when scripts access data loaded during runs of */ -/* previous scripts. */ - -/* Cleaning up after such programs using explicit UNLOAD commands is */ -/* tedious and error-prone. One call to this routine sets the */ -/* KEEPER system to its initial state, preventing unintentional */ -/* interaction between scripts via KEEPER's state. */ - -/* $ Examples */ - -/* Clear the KEEPER system; check for residual loaded files. */ -/* We shouldn't find any. */ - -/* CALL KCLEAR */ -/* CALL KTOTAL ( 'ALL', N ) */ -/* WRITE (*,*) 'Count of loaded kernels after KCLEAR call: ', N */ - -/* $ Restrictions */ - -/* Calling this routine will wipe out any kernel pool data */ -/* inserted via the P*POOL API routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-NOV-2006 (NJB) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Re-initialize the keeper system */ -/* Clear the keeper system */ -/* Unload all kernels */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("KCLEAR", (ftnlen)6); - -/* Unloading all kernels is actually much less work than */ -/* unloading just a few of them. We unload all of the */ -/* binary kernels via the "unload" routines for their */ -/* respective subsystems, then clear the kernel pool. */ - - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)2204)) << 3), "SPK", - (ftnlen)8, (ftnlen)3) == 0) { - spkuef_(&handls[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)2206)]); - } else if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? - i__2 : s_rnge("types", i__2, "keeper_", (ftnlen)2208)) << 3), - "CK", (ftnlen)8, (ftnlen)2) == 0) { - ckupf_(&handls[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)2210)]); - } else if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? - i__2 : s_rnge("types", i__2, "keeper_", (ftnlen)2212)) << 3), - "PCK", (ftnlen)8, (ftnlen)3) == 0) { - pckuof_(&handls[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)2214)]); - } else if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? - i__2 : s_rnge("types", i__2, "keeper_", (ftnlen)2216)) << 3), - "EK", (ftnlen)8, (ftnlen)2) == 0) { - ekuef_(&handls[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)2218)]); - } - } - clpool_(); - -/* Although it's not strictly necessary, we initialize */ -/* KEEPER's database arrays. This step may occasionally */ -/* be helpful for debugging. */ - - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge( - "files", i__2, "keeper_", (ftnlen)2233)) * 255, " ", (ftnlen) - 255, (ftnlen)1); - handls[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge("handls", - i__2, "keeper_", (ftnlen)2234)] = 0; - srces[(i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge("srces", - i__2, "keeper_", (ftnlen)2235)] = 0; - s_copy(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge( - "types", i__2, "keeper_", (ftnlen)2236)) << 3), " ", (ftnlen) - 8, (ftnlen)1); - } - -/* There's just one counter that indicates the number of */ -/* database entries: LOADED. Set this counter to */ -/* its initial state. */ - - loaded = 0; - -/* Calling CLPOOL doesn't remove watches, but it does send a message */ -/* to each agent indicating that its variables have been touched. */ -/* Clear this indication by calling CVPOOL. (This is done for */ -/* safety; the current implementation of FURNSH doesn't require it.) */ - - cvpool_("FURNSH", &update, (ftnlen)6); - chkout_("KCLEAR", (ftnlen)6); - return 0; -/* $Procedure UNLOAD ( Unload a kernel ) */ - -L_unload: -/* $ Abstract */ - -/* Unload a SPICE kernel. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Declarations */ - -/* CHARACTER*(*) FILE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I The name of a kernel to unload. */ - -/* $ Detailed_Input */ - -/* FILE is the name of a file to unload. This file */ -/* should be one loaded through the interface FURNSH. */ -/* If the file is not on the list of loaded kernels */ -/* no action is taken. */ - -/* Note that if FILE is a meta-text kernel, all of */ -/* the files loaded as a result of loading the meta-text */ -/* kernel will be unloaded. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the specified kernel is not on the list of loaded kernels */ -/* no action is taken. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The call */ - -/* CALL UNLOAD ( FILE ) */ - -/* has the effect of "erasing" the last previous call: */ - -/* CALL FURNSH ( FILE ) */ - -/* This interface allows you to unload binary and text kernels. */ -/* Moreover, if you used a meta-text kernel to set up your */ -/* working environment, you can unload all of the kernels loaded */ -/* through the meta-kernel by unloading the meta-kernel. */ - -/* The usual usage of FURNSH is to load each file needed by your */ -/* program exactly one time. However, it is possible to load a */ -/* kernel more than one time. (Usually, this is a result of loading */ -/* meta-kernels without taking the care needed to ensure that the */ -/* meta-kernels do not specify the same file more than once.) The */ -/* effect of unloading a kernel that has been loaded more than once */ -/* is to "undo" the last loading of the kernel. Depending upon the */ -/* kernel and its relationship to other loaded kernels, this may */ -/* have no visible effect on the working of your program. To */ -/* illustrate this behavior suppose that you have a collection of */ -/* files FILE1, FILE2, FILE3, FILE4, FILE5, FILE6, FILE7, FILE8, */ -/* META1, META2 where FILE1 ... FILE8 are SPICE kernels and META1 */ -/* and META2 are meta-kernels with the specified kernels to load as */ -/* shown below. */ - - -/* META1: */ -/* KERNELS_TO_LOAD = ( FILE2, */ -/* FILE3, */ -/* FILE4, */ -/* FILE5 ) */ - -/* META2: */ -/* KERNELS_TO_LOAD = ( FILE2, */ -/* FILE3, */ -/* FILE7, */ -/* FILE8 ) */ - - -/* The following sequence of calls */ - -/* CALL FURNSH ( FILE1 ) */ -/* CALL FURNSH ( FILE2 ) */ -/* CALL FURNSH ( FILE3 ) */ -/* CALL FURNSH ( META1 ) */ -/* CALL FURNSH ( FILE6 ) */ -/* CALL FURNSH ( META2 ) */ - -/* has the effect: */ - -/* "Load" FILE1 */ -/* "Load" FILE2 */ -/* "Load" FILE3 */ -/* "Load" META1 as a text kernel and then... */ -/* "Load" FILE2 (note that it was loaded from META1) */ -/* "Load" FILE3 (note that it was loaded from META1) */ -/* "Load" FILE4 (note that it was loaded from META1) */ -/* "Load" FILE5 (note that it was loaded from META1) */ -/* "Load" FILE6 */ -/* "Load" META2 as a text kernel and then... */ -/* "Load" FILE2 (note that it was loaded from META2) */ -/* "Load" FILE3 (note that it was loaded from META2) * */ -/* "Load" FILE7 (note that it was loaded from META2) */ -/* "Load" FILE8 (note that it was loaded from META2) */ - -/* If we UNLOAD FILE3 */ - -/* CALL UNLOAD ( FILE3 ) */ - -/* we locate the last time FILE3 was loaded (* above) and modify the */ -/* state of loaded kernels so that it looks as if we had made the */ -/* following sequence of "load" operations. */ - -/* "Load" FILE1 */ -/* "Load" FILE2 */ -/* "Load" FILE3 */ -/* "Load" META1 as a text kernel and then... */ -/* "Load" FILE2 (note that it was loaded from META1) */ -/* "Load" FILE3 (note that it was loaded from META1) */ -/* "Load" FILE4 (note that it was loaded from META1) */ -/* "Load" FILE5 (note that it was loaded from META1) */ -/* "Load" FILE6 */ -/* "Load" META2 as a text kernel and then... */ -/* "Load" FILE2 (note that it was loaded from META2) */ -/* "Load" FILE7 (note that it was loaded from META2) */ -/* "Load" FILE8 (note that it was loaded from META2) */ - -/* As you can see, the data from FILE3 is still available to the */ -/* program. All that may have changed is the usage priority */ -/* associated with that data. */ - -/* If we unload META2 (or META1) we remove all remaining files that */ -/* are noted as being loaded from META2 (or META1) */ - -/* CALL UNLOAD ( META2 ) */ - -/* produces the following load state for the program: */ - -/* "Load" FILE1 */ -/* "Load" FILE2 */ -/* "Load" FILE3 */ -/* "Load" META1 as a text kernel and then... */ -/* "Load" FILE2 (note that it was loaded from META1) */ -/* "Load" FILE3 (note that it was loaded from META1) */ -/* "Load" FILE4 (note that it was loaded from META1) */ -/* "Load" FILE5 (note that it was loaded from META1) */ -/* "Load" FILE6 */ - -/* If we had unloaded META1 instead, we would have this load state. */ - -/* "Load" FILE1 */ -/* "Load" FILE2 */ -/* "Load" FILE3 */ -/* "Load" FILE6 */ -/* "Load" META2 as a text kernel and then... */ -/* "Load" FILE2 (note that it was loaded from META2) */ -/* "Load" FILE7 (note that it was loaded from META2) */ -/* "Load" FILE8 (note that it was loaded from META2) */ - -/* So we see that unloading a file does not necessarily make its */ -/* data unavailable to your program. Unloading modifies the */ -/* precedence of the files loaded in your program. The data */ -/* associated with an unloaded file becomes unavailable only when */ -/* the file has been unloaded as many times as it was loaded. */ - -/* When would you encounter such a scenario? The situation of */ -/* loading a file more than once might appear if you were trying to */ -/* contrast the results of computations performed with two */ -/* different meta-kernels. In such a scenario you might load a */ -/* "baseline" set of kernels early in your program and then load */ -/* and unload meta-kernels to compare results between the two */ -/* different sets of data. */ - -/* Unloading Text or Meta-text Kernels. */ - -/* Part of the action of unloading text (or meta-text kernels) is */ -/* the clearing of the kernel pool and re-loading any kernels that */ -/* were not in the specified set of kernels to unload. Since */ -/* loading of text kernels is not a very fast process, unloading */ -/* text kernels takes considerably longer than unloading binary */ -/* kernels. Moreover, since the kernel pool is cleared, any kernel */ -/* pool variables you have set from your program by using one of the */ -/* interfaces PCPOOL, PDPOOL, PIPOOL, or LMPOOL will be removed from */ -/* the kernel pool. For this reason, if you plan to use this */ -/* feature in your program, together with one of the routines */ -/* specified above, you will need to take special precautions to */ -/* make sure kernel pool variables required by your program, do not */ -/* inadvertently disappear. */ - -/* $ Examples */ - -/* Suppose that you wish to compare two different sets of kernels */ -/* used to describe the geometry of a mission (for example a predict */ -/* model and a reconstructed model). You can place all of the */ -/* kernels for one model in one meta-text kernel, and the other set */ -/* in a second meta-text kernel. Let's call these PREDICT.MTA and */ -/* ACTUAL.MTA. */ - -/* CALL FURNSH ( 'PREDCT.MTA' ) */ - -/* compute quantities of interest and store them */ -/* for comparison with results of reconstructed */ -/* (actual) kernels. */ - -/* Now unload the predict model and load the reconstructed */ -/* model. */ - -/* CALL UNLOAD ( 'PREDCT.MTA' ) */ -/* CALL FURNSH ( 'ACTUAL.MTA' ) */ - -/* re-compute quantities of interest and compare them */ -/* with the stored quantities. */ - -/* $ Restrictions */ - -/* See the note regarding the unloading of Text and meta-text */ -/* Kernels. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0 15-NOV-2006 (NJB) */ - -/* Bug fix: corrected update of source pointers when a */ -/* meta-kernel is unloaded. Previously source pointers */ -/* having higher indices than those of the files referenced */ -/* by the meta kernel were not adjusted when the database */ -/* was compressed. */ - -/* - SPICELIB VERSION 2.0.0, 23-AUG-2001 (WLT) */ - -/* Added code to make sure that UNLOAD has the effect of */ -/* loading all remaining kernels in the order they were first */ -/* introduced. */ - -/* - SPICELIB Version 1.0.0, 01-JUL-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Unload a SPICE kernel */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("UNLOAD", (ftnlen)6); - didspk = FALSE_; - didpck = FALSE_; - didck = FALSE_; - didek = FALSE_; - didtxt = FALSE_; - -/* First locate the file we need to unload, we search backward */ -/* through the list of loaded files so that we unload in the right */ -/* order. */ - - gotit = FALSE_; - i__ = loaded; - while(! gotit && i__ > 0) { - if (s_cmp(files + ((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("files", i__1, "keeper_", (ftnlen)2587)) * 255, file, ( - ftnlen)255, file_len) == 0) { - gotit = TRUE_; - } else { - --i__; - } - } - -/* If we didn't locate the requested file, there is nothing to do. */ - - if (! gotit) { - chkout_("UNLOAD", (ftnlen)6); - return 0; - } - -/* We need to know what type of file we've got so that we */ -/* can take the correct "unload" action. */ - - if (s_cmp(types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "types", i__1, "keeper_", (ftnlen)2607)) << 3), "SPK", (ftnlen)8, - (ftnlen)3) == 0) { - spkuef_(&handls[(i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "handls", i__1, "keeper_", (ftnlen)2608)]); - didspk = TRUE_; - } else if (s_cmp(types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)2610)) << 3), "CK", ( - ftnlen)8, (ftnlen)2) == 0) { - ckupf_(&handls[(i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "handls", i__1, "keeper_", (ftnlen)2611)]); - didck = TRUE_; - } else if (s_cmp(types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)2613)) << 3), "PCK", ( - ftnlen)8, (ftnlen)3) == 0) { - pckuof_(&handls[(i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "handls", i__1, "keeper_", (ftnlen)2614)]); - didpck = TRUE_; - } else if (s_cmp(types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)2616)) << 3), "EK", ( - ftnlen)8, (ftnlen)2) == 0) { - ekuef_(&handls[(i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : s_rnge( - "handls", i__1, "keeper_", (ftnlen)2617)]); - didek = TRUE_; - } else if (s_cmp(types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)2619)) << 3), "TEXT", ( - ftnlen)8, (ftnlen)4) == 0) { - clpool_(); - didtxt = TRUE_; - } else if (s_cmp(types + (((i__1 = i__ - 1) < 1300 && 0 <= i__1 ? i__1 : - s_rnge("types", i__1, "keeper_", (ftnlen)2622)) << 3), "META", ( - ftnlen)8, (ftnlen)4) == 0) { - -/* This is a special case, we need to undo the effect of loading */ -/* the meta-kernel. This means we need to unload all kernels */ -/* that were loaded using this meta-kernel. */ - - didtxt = TRUE_; - src = i__; - i__1 = src + 1; - for (j = loaded; j >= i__1; --j) { - if (srces[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge( - "srces", i__2, "keeper_", (ftnlen)2634)] == src) { - -/* This file was loaded by the meta-kernel of interest. */ -/* We only need to unload the binary kernels as we */ -/* will get rid of all text kernels by clearing the */ -/* kernel pool. */ - - if (s_cmp(types + (((i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 - : s_rnge("types", i__2, "keeper_", (ftnlen)2641)) << - 3), "SPK", (ftnlen)8, (ftnlen)3) == 0) { - spkuef_(&handls[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 - : s_rnge("handls", i__2, "keeper_", (ftnlen)2642)] - ); - didspk = TRUE_; - } else if (s_cmp(types + (((i__2 = j - 1) < 1300 && 0 <= i__2 - ? i__2 : s_rnge("types", i__2, "keeper_", (ftnlen) - 2644)) << 3), "CK", (ftnlen)8, (ftnlen)2) == 0) { - ckupf_(&handls[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)2645)]) - ; - didck = TRUE_; - } else if (s_cmp(types + (((i__2 = j - 1) < 1300 && 0 <= i__2 - ? i__2 : s_rnge("types", i__2, "keeper_", (ftnlen) - 2647)) << 3), "PCK", (ftnlen)8, (ftnlen)3) == 0) { - pckuof_(&handls[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 - : s_rnge("handls", i__2, "keeper_", (ftnlen)2648)] - ); - didpck = TRUE_; - } else if (s_cmp(types + (((i__2 = j - 1) < 1300 && 0 <= i__2 - ? i__2 : s_rnge("types", i__2, "keeper_", (ftnlen) - 2650)) << 3), "EK", (ftnlen)8, (ftnlen)2) == 0) { - ekuef_(&handls[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("handls", i__2, "keeper_", (ftnlen)2651)]) - ; - didek = TRUE_; - } - n1 = loaded; - n2 = loaded; - n3 = loaded; - remlac_(&c__1, &j, files, &n1, (ftnlen)255); - remlac_(&c__1, &j, types, &n2, (ftnlen)8); - remlai_(&c__1, &j, srces, &n3); - remlai_(&c__1, &j, handls, &loaded); - -/* Each time we delete an item from the database, any */ -/* pointer to a location past the deletion point must be */ -/* updated to reflect the compression of the database. */ -/* Files loaded from meta kernels are always recorded */ -/* in the database *after* their sources, so each pointer */ -/* value is less than the index at which it occurs. */ -/* So, we need examine only those entries from index J */ -/* upwards. */ - - i__2 = loaded; - for (k = j; k <= i__2; ++k) { - if (srces[(i__3 = k - 1) < 1300 && 0 <= i__3 ? i__3 : - s_rnge("srces", i__3, "keeper_", (ftnlen)2675)] > - j) { - -/* This pointer is affected by the deletion of */ -/* the Jth database entry. */ - - srces[(i__3 = k - 1) < 1300 && 0 <= i__3 ? i__3 : - s_rnge("srces", i__3, "keeper_", (ftnlen)2680) - ] = srces[(i__4 = k - 1) < 1300 && 0 <= i__4 ? - i__4 : s_rnge("srces", i__4, "keeper_", ( - ftnlen)2680)] - 1; - } - } - } - } - -/* Now clear the kernel pool. */ - - clpool_(); - } - -/* Remove the I'th kernel from our local database. */ - - n1 = loaded; - n2 = loaded; - n3 = loaded; - remlac_(&c__1, &i__, files, &n1, (ftnlen)255); - remlac_(&c__1, &i__, types, &n2, (ftnlen)8); - remlai_(&c__1, &i__, srces, &n3); - remlai_(&c__1, &i__, handls, &loaded); - -/* Update any source pointers affected by the deletion of the Ith */ -/* database entry. */ - - i__1 = loaded; - for (j = i__; j <= i__1; ++j) { - if (srces[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge("srces", - i__2, "keeper_", (ftnlen)2712)] > i__) { - -/* This pointer is affected by the deletion of the Ith */ -/* database entry. */ - - srces[(i__2 = j - 1) < 1300 && 0 <= i__2 ? i__2 : s_rnge("srces", - i__2, "keeper_", (ftnlen)2717)] = srces[(i__3 = j - 1) < - 1300 && 0 <= i__3 ? i__3 : s_rnge("srces", i__3, "keeper_" - , (ftnlen)2717)] - 1; - } - } - -/* If we unloaded a text kernel, we now need to reload all */ -/* of the text kernels that were not unloaded. */ - - if (didtxt) { - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)2731)) << 3), - "TEXT", (ftnlen)8, (ftnlen)4) == 0 || s_cmp(types + ((( - i__3 = i__ - 1) < 1300 && 0 <= i__3 ? i__3 : s_rnge("typ" - "es", i__3, "keeper_", (ftnlen)2731)) << 3), "META", ( - ftnlen)8, (ftnlen)4) == 0) { - ldpool_(files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("files", i__2, "keeper_", (ftnlen)2734)) * - 255, (ftnlen)255); - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? - i__2 : s_rnge("types", i__2, "keeper_", (ftnlen)2736)) - << 3), "META", (ftnlen)8, (ftnlen)4) == 0) { - -/* Clean up any debris that may have been left lying */ -/* around because we reloaded a meta-text kernel. */ - - for (j = 1; j <= 3; ++j) { - dvpool_(known + (((i__2 = j - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("known", i__2, "keeper_", ( - ftnlen)2742)) << 5), (ftnlen)32); - } - cvpool_("FURNSH", &update, (ftnlen)6); - } - } - } - } - -/* If any SPK files were unloaded, we need to reload everything */ -/* to establish the right priority sequence for segments. */ - - if (didspk) { - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)2762)) << 3), - "SPK", (ftnlen)8, (ftnlen)3) == 0) { - spklef_(files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("files", i__2, "keeper_", (ftnlen)2763)) * - 255, &handls[(i__3 = i__ - 1) < 1300 && 0 <= i__3 ? - i__3 : s_rnge("handls", i__3, "keeper_", (ftnlen)2763) - ], (ftnlen)255); - } - } - } - -/* If any CK files were unloaded, we need to reload all of the */ -/* C-kernels to make sure that we have the correct priorities */ -/* for the remaining C-kernels. */ - - if (didck) { - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)2776)) << 3), - "CK", (ftnlen)8, (ftnlen)2) == 0) { - cklpf_(files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("files", i__2, "keeper_", (ftnlen)2777)) * 255, - &handls[(i__3 = i__ - 1) < 1300 && 0 <= i__3 ? i__3 : - s_rnge("handls", i__3, "keeper_", (ftnlen)2777)], ( - ftnlen)255); - } - } - } - -/* If any binary PCK files were unloaded, we need to reload any */ -/* remaining ones to re-establish the correct priorities for */ -/* kernels. */ - - if (didpck) { - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)2791)) << 3), - "PCK", (ftnlen)8, (ftnlen)3) == 0) { - pcklof_(files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("files", i__2, "keeper_", (ftnlen)2792)) * - 255, &handls[(i__3 = i__ - 1) < 1300 && 0 <= i__3 ? - i__3 : s_rnge("handls", i__3, "keeper_", (ftnlen)2792) - ], (ftnlen)255); - } - } - } - -/* Finally, if any E-kernels were unloaded, we reload the remaining */ -/* kernels to make sure the state is restored to the correct set */ -/* of loaded kernels. */ - - if (didek) { - i__1 = loaded; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(types + (((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("types", i__2, "keeper_", (ftnlen)2805)) << 3), - "EK", (ftnlen)8, (ftnlen)2) == 0) { - eklef_(files + ((i__2 = i__ - 1) < 1300 && 0 <= i__2 ? i__2 : - s_rnge("files", i__2, "keeper_", (ftnlen)2806)) * 255, - &handls[(i__3 = i__ - 1) < 1300 && 0 <= i__3 ? i__3 : - s_rnge("handls", i__3, "keeper_", (ftnlen)2806)], ( - ftnlen)255); - } - } - } - chkout_("UNLOAD", (ftnlen)6); - return 0; -} /* keeper_ */ - -/* Subroutine */ int keeper_(integer *which, char *kind, char *file, integer * - count, char *filtyp, integer *handle, char *source, logical *found, - ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen - source_len) -{ - return keeper_0_(0, which, kind, file, count, filtyp, handle, source, - found, kind_len, file_len, filtyp_len, source_len); - } - -/* Subroutine */ int furnsh_(char *file, ftnlen file_len) -{ - return keeper_0_(1, (integer *)0, (char *)0, file, (integer *)0, (char *) - 0, (integer *)0, (char *)0, (logical *)0, (ftnint)0, file_len, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ktotal_(char *kind, integer *count, ftnlen kind_len) -{ - return keeper_0_(2, (integer *)0, kind, (char *)0, count, (char *)0, ( - integer *)0, (char *)0, (logical *)0, kind_len, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int kdata_(integer *which, char *kind, char *file, char * - filtyp, char *source, integer *handle, logical *found, ftnlen - kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len) -{ - return keeper_0_(3, which, kind, file, (integer *)0, filtyp, handle, - source, found, kind_len, file_len, filtyp_len, source_len); - } - -/* Subroutine */ int kinfo_(char *file, char *filtyp, char *source, integer * - handle, logical *found, ftnlen file_len, ftnlen filtyp_len, ftnlen - source_len) -{ - return keeper_0_(4, (integer *)0, (char *)0, file, (integer *)0, filtyp, - handle, source, found, (ftnint)0, file_len, filtyp_len, - source_len); - } - -/* Subroutine */ int kclear_(void) -{ - return keeper_0_(5, (integer *)0, (char *)0, (char *)0, (integer *)0, ( - char *)0, (integer *)0, (char *)0, (logical *)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int unload_(char *file, ftnlen file_len) -{ - return keeper_0_(6, (integer *)0, (char *)0, file, (integer *)0, (char *) - 0, (integer *)0, (char *)0, (logical *)0, (ftnint)0, file_len, ( - ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/kepleq.c b/ext/spice/src/cspice/kepleq.c deleted file mode 100644 index 68f0f21757..0000000000 --- a/ext/spice/src/cspice/kepleq.c +++ /dev/null @@ -1,234 +0,0 @@ -/* kepleq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure KEPLEQ ( Kepler's Equation - Equinoctial Version ) */ -doublereal kepleq_(doublereal *ml, doublereal *h__, doublereal *k) -{ - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal evec[2]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal e2; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern doublereal kpsolv_(doublereal *); - -/* $ Abstract */ - -/* This function solves the equinoctial version of Kepler's */ -/* equation. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ML I Mean longitude */ -/* H I h component of equinoctial elements */ -/* K I k component of equinoctial elements */ - -/* $ Detailed_Input */ - -/* ML mean longitude of some body following two body */ -/* motion. (Mean longitude = Mean anomaly + argument */ -/* of periapse + longitude of ascending node.) */ - -/* H The h component of the equinoctial element set */ -/* ( h = ECC*SIN( arg of periapse + long ascending node) ) */ - -/* K The k component of the equinoctial element set */ -/* ( k = ECC*COS( arg of periapse + long ascending node) ) */ - -/* Note that ECC = DSQRT ( K*K + H*H ) */ - -/* $ Detailed_Output */ - -/* The function returns the value of F such that */ -/* ML = F + h*COS(F) - k*SIN(F) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the sum of the squares of F and K is not less than .9 */ -/* the error 'SPICE(ECCOUTOFBOUNDS)' will be signalled. */ - -/* 2) If the iteration for a solution to the equinoctial Kepler's */ -/* equation does not converge in 10 or fewer steps, the error */ -/* 'SPICE(NOCONVERGENCE)' is signalled. */ - -/* $ Particulars */ - -/* This routine solves the equinoctial element version of */ -/* Kepler's equation. */ - -/* ML = F + h*COS(F) - k*SIN(F) */ - -/* Here F is an offset from the eccentric anomaly E. */ - -/* F = E - argument of periapse - longitude of ascending node. */ - -/* where E is eccentric anomaly. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* "Optical Navigation Program Mathematical Models" JPL */ -/* Engineering Memorandum 314-513. By William M. Owen */ -/* August 9, 1991. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-DEC-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Solve the equinoctial version of Kepler's equation */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local variables */ - - -/* Make sure that H and K are in the expected range. */ - - e2 = *h__ * *h__ + *k * *k; - if (e2 >= .81) { - ret_val = 0.; - chkin_("KEPLEQ", (ftnlen)6); - setmsg_("The values of H and K supplied to KEPLEQ must satisfy the i" - "nequality H*H + K*K < ECC**2 where ECC is the eccentricity t" - "hreshold of 0.9. The values of H and K are: # and # respect" - "ively. H*H + K*K = #. ", (ftnlen)201); - errdp_("#", h__, (ftnlen)1); - errdp_("#", k, (ftnlen)1); - errdp_("#", &e2, (ftnlen)1); - sigerr_("SPICE(ECCOUTOFBOUNDS)", (ftnlen)21); - chkout_("KEPLEQ", (ftnlen)6); - return ret_val; - } - -/* Instead of solving the equation */ - -/* ML = F + H*DCOS(F) - K*DSIN(F) */ - -/* We set X equal to F - ML and solve the equivalent equation */ - -/* 0 = X + H*DCOS(ML+X) - K*DSIN(ML+X) */ - -/* = X + H*{DCOS(ML)*DCOS(X) - DSIN(ML)*DSIN(X)} */ -/* - K*{DSIN(ML)*DCOS(X) + DCOS(ML)*DSIN(X)} */ - -/* = X + { H*DCOS(ML) - K*DSIN(ML) }*DCOS(X) */ -/* - { H*DSIN(ML) + K*DCOS(ML) }*DSIN(X) */ - - -/* We can rearrange this to: */ - -/* - - - - */ -/* | DCOS(ML) -DSIN(ML) | | DCOS(X) | */ -/* 0 = X + [ H -K ] * | DSIN(ML) DCOS(ML) | * | DSIN(X) | */ -/* - - - - */ - -/* Finally if we let */ - -/* C - - */ -/* | DCOS(ML) -DSIN(ML) | */ -/* EVEC = [ EX EY ] = [ -H K ] * | DSIN(ML) DCOS(ML) | */ -/* - - */ - -/* and */ - -/* DCOS(X) */ -/* U(X) = DSIN(X) */ - -/* Then we can rewrite the equation as: */ - -/* 0 = X - < EVEC, U(X) > */ - -/* where <,> denotes the dot product operation. Note that X */ -/* is necessarily in the range from -ECC to ECC where ECC = | EVEC | */ - -/* Once we've computed X, F is just ML + X. */ - -/* For those of you who are fans of the classical keplerian */ -/* elements: */ - -/* x = F - ML = E - M */ - -/* where E denotes eccentric anomaly and M denotes mean anomaly. */ - -/* The routine KPEVEC returns the value of X that solves */ -/* the equation X - < EVEC, UVEC(X) > */ - - evec[0] = -(*h__) * cos(*ml) + *k * sin(*ml); - evec[1] = *h__ * sin(*ml) + *k * cos(*ml); - ret_val = *ml + kpsolv_(evec); - return ret_val; -} /* kepleq_ */ - diff --git a/ext/spice/src/cspice/kinfo_c.c b/ext/spice/src/cspice/kinfo_c.c deleted file mode 100644 index a3dd328d4a..0000000000 --- a/ext/spice/src/cspice/kinfo_c.c +++ /dev/null @@ -1,314 +0,0 @@ -/* - --Procedure kinfo_c ( Kernel Information ) - --Abstract - - Return information about a loaded kernel specified by name. - --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 - - KERNEL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void kinfo_c ( ConstSpiceChar * file, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - file I Name of a kernel to fetch information for - typlen I Available space in output kernel type string. - srclen I Available space in output source string. - filtyp O The type of the kernel. - source O Name of the source file used to load file. - handle O The handle attached to file. - found O SPICETRUE if the specified file could be located. - --Detailed_Input - - file is the name of a kernel file for which descriptive - information is desired. - - typlen is the amount of available space in the output kernel - type string. - - srclen is the amount of available space in the output kernel - source string. - - --Detailed_Output - - filtyp is the type of the kernel specified by file. filtyp - will be empty if file is not on the list of kernels - loaded via furnsh_c. - - source is the name of the source file that was used to - specify file as one to load. If file was loaded - directly via a call to furnsh_c, source will be empty. - If file is not on the list of kernels loaded via - furnsh_c, source will be empty. - - handle is the handle attached to file if it is a binary - kernel. If file is a text kernel or meta-text kernel - handle will be zero. If file is not on the list of - kernels loaded via furnsh_c, handle will be set to zero. - - found is returned SPICETRUE if the specified file exists. - If there is no such file, found will be set to - SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) If the specified file is not on the list of files that - are currently loaded via the interface furnsh_c, found - will be SPICEFALSE, handle will be set to zero and filtyp - and source will be set to empty strings. - - 2) If any input or output character argument pointer is null, the - error SPICE(NULLPOINTER) will be signaled. - - 3) If either output string length argument is less than 1, the - error SPICE(STRINGTOOSHORT) will be signaled. - - 4) If either output string has length at least 1 but is too short to - contain the output string, the corresponding is truncated on the - right. The output string is still null-terminated. - --Files - - None. - --Particulars - - This entry point allows you to request information directly - for a specific SPICE kernel. - --Examples - - Suppose you wish to determine the type of a loaded kernel - so that you can call the correct summarizing routines - for the kernel. The following bit of pseudo code shows - how you might use this entry point together with summarizing - code to produce a report on the file. (Note that the - routines spk_summry, ck_summry, pck_summry and ek_summry - are simply names to indicate what you might do with the - information returned by kinfo_c. They are not routines that - are part of the SPICE Toolkit.) - - #include - #include "SpiceUsr.h" - - #define FILLEN 128 - #define TYPLEN 32 - #define SRCLEN 128 - - SpiceInt which; - SpiceInt count; - SpiceInt handle; - - SpiceChar file [FILLEN]; - SpiceChar filtyp[TYPLEN]; - SpiceChar source[SRCLEN]; - - SpiceBoolean found; - - int main() - { - furnsh_c( "/kernels/standard.tm" ); - - ktotal_c ( "all", &count ); - - if ( count == 0 ) - { - printf ( "No files loaded at this time.\n" ); - } - else - { - printf ( "The loaded files files are: \n\n" ); - } - - for ( which = 0; which < count; which++ ) - { - - kdata_c ( which, "all", FILLEN, TYPLEN, SRCLEN, - file, filtyp, source, &handle, &found ); - - kinfo_c ( file, TYPLEN, SRCLEN, filtyp, source, &handle, &found ); - - if ( eqstr_c ( filtyp, "SPK" ) ) - { - printf ( "%s is an SPK file.\n", file ); - } - else if ( eqstr_c ( filtyp, "CK" ) ) - { - printf ( "%s is a CK file.\n", file ); - } - else if ( eqstr_c ( filtyp, "PCK" ) ) - { - printf ( "%s is a PCK file.\n", file ); - } - else if ( eqstr_c ( filtyp, "EK" ) ) - { - printf ( "%s is an EK file.\n", file ); - } - else if ( eqstr_c ( filtyp, "META" ) ) - { - printf ( "%s is a meta-text kernel.\n", file ); - } - else - { - printf ( "%s is a text kernel.\n", file ); - } - - } - - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.2, 02-MAY-2008 (EDW) - - standard.ker renamed standard.tm - - -CSPICE Version 1.1.1, 05-SEP-2007 (EDW) - - Expanded Examples section to a full, compilable program. - - -CSPICE Version 1.1.0, 02-FEB-2003 (EDW) - - Corrected example code to match routine's argument list. - - -CSPICE Version 1.0.0, 01-SEP-1999 (NJB) (WLT) - --Index_Entries - - Fetch information about a loaded SPICE kernel - --& -*/ - -{ /* Begin kinfo_c */ - - /* - Local variables - */ - logical fnd; - - - - /* - Participate in error tracing. - */ - chkin_c ( "kinfo_c" ); - - - /* - Check the input string file to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "kinfo_c", file ); - - - /* - Make sure the output string filtyp has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "kinfo_c", filtyp, typlen ); - - - /* - Make sure the output string source has at least enough room for one - output character and a null terminator. Also check for a null - pointer. - */ - CHKOSTR ( CHK_STANDARD, "kinfo_c", source, srclen ); - - /* - Call the f2c'd routine. - */ - kinfo_ ( ( char * ) file, - ( char * ) filtyp, - ( char * ) source, - ( integer * ) handle, - ( logical * ) &fnd, - ( ftnlen ) strlen(file), - ( ftnlen ) typlen-1, - ( ftnlen ) srclen-1 ); - - - /* - Convert the output strings from Fortran style to C style. Set - the SpiceBoolean output found flag. - */ - F2C_ConvertStr( typlen, filtyp ); - F2C_ConvertStr( srclen, source ); - - *found = fnd; - - - chkout_c ( "kinfo_c" ); - -} /* End kinfo_c */ diff --git a/ext/spice/src/cspice/kpsolv.c b/ext/spice/src/cspice/kpsolv.c deleted file mode 100644 index 70200497d9..0000000000 --- a/ext/spice/src/cspice/kpsolv.c +++ /dev/null @@ -1,292 +0,0 @@ -/* kpsolv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure KPSOLV ( Solve Keplers Equation --- Vector Form ) */ -doublereal kpsolv_(doublereal *evec) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - doublereal ret_val, d__1, d__2, d__3, d__4; - - /* Builtin functions */ - double sqrt(doublereal); - integer i_dnnt(doublereal *); - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal cosx, sinx, h__; - integer i__; - doublereal k, x; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - integer maxit; - doublereal y0, xl, xm, xu, yx; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal ecc, ecc2, yxm, ypx; - -/* $ Abstract */ - -/* This routine solves the equation X = < EVEC, U(X) > where */ -/* U(X) is the unit vector [ Cos(X), SIN(X) ] and < , > denotes */ -/* the two-dimensional dot product. */ - -/* $ 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 */ - -/* ROOTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* EVEC I A 2-vector whose magnitude is less than 1. */ - -/* The function returns the solution to X = < EVEC, U(X) > */ - -/* $ Detailed_Input */ - -/* EVEC is any two dimensional vector whose magnitude is */ -/* less than 1. */ - -/* $ Detailed_Output */ - -/* The function returns the value X such that the equation */ - -/* X = EVEC(1)COS(X) + EVEC(2)SIN(X). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the magnitude of EVEC is greater than or equal to 1 */ -/* the error SPICE(EVECOUTOFRANGE) is signalled. */ - -/* $ Particulars */ - -/* This routine uses bisection and Newton's method to find */ -/* the root of the equation */ - -/* X = EVEC(1)COS(X) + EVEC(2)SIN(X). */ - -/* This equation is just a "vector form" of Kepler's equation. */ - - -/* $ Examples */ - -/* Suppose you need to solve the equation */ - -/* M = E - e SIN(E) [ 1 ] */ - -/* for E. If we let X = E - M the equation is transformed to */ - -/* 0 = X - e SIN( X + M ) */ - -/* = X - e SIN( M ) COS(X) - e COS(M) SIN ( X ) */ - -/* Thus if we solve the equation */ - -/* X = e SIN(M) COS(X) + e COS(M) SIN(X) */ - -/* we can find the value of X we can compute E. */ - -/* The code fragment below illustrates how this routine can */ -/* be used to solve equation [1]. */ - -/* EVEC(1) = ECC * DSIN(M) */ -/* EVEC(2) = ECC * DCOS(M) */ -/* E = M + KPSOLV( EVEC ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 26-AUG-1997 (WLT) */ - -/* KPSOLV is now given an initial value of zero so that */ -/* if an error condition is detected, KPSOLV will have */ -/* a return value. */ - -/* - SPICELIB Version 1.0.0, 03-JAN-1997 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Solve the vector form of the Kepler equation */ - -/* -& */ - -/* MXNEWT is the number of iterations we will perform */ -/* in the Newtons method for finding the solution to */ -/* the vector form of Kepler's equation. It has been */ -/* empirically determined that 5 iterations is always */ -/* sufficient on computers have 64 bit double precision */ -/* numbers. */ - - -/* We give the function an initial value, just in case */ -/* we exit without solving Kepler's equation. */ - - ret_val = 0.; - h__ = evec[0]; - k = evec[1]; - ecc2 = h__ * h__ + k * k; - if (ecc2 >= 1.) { - chkin_("KPSOLV", (ftnlen)6); - setmsg_("The magnitude of the vector EVEC = ( #, # ) must be less th" - "an 1. However, the magnitude of this vector is #.", (ftnlen) - 109); - errdp_("#", &h__, (ftnlen)1); - errdp_("#", &k, (ftnlen)1); - d__1 = sqrt(ecc2); - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(EVECOUTOFRANGE)", (ftnlen)21); - chkout_("KPSOLV", (ftnlen)6); - return ret_val; - } - -/* We first approximate the equation 0 = X - H * COS(X) - K * SIN(X) */ -/* using bisection. If we let Y(X) = X - H * COS(X) - K * SIN(X) */ - -/* Y( ECC) = ECC - = ECC - ECC*COS(ANGLE_X) > 0 */ -/* Y(-ECC) = -ECC - = -ECC - ECC*COS(ANGLE_X) < 0 */ - -/* where ANGLE_X is the angle between U(X) and EVEC. Thus -ECC */ -/* and ECC necessarily bracket the root of the equation Y(X) = 0. */ - -/* Also note that Y'(X) = 1 - < EVEC, V(X) > where V(X) is the */ -/* unit vector given by U'(X). Thus Y is an increasing function */ -/* over the interval from -ECC to ECC. */ - -/* The mid point of ECC and -ECC is 0 and Y(0) = -H. Thus */ -/* we can do the first bisection step without doing */ -/* much in the way of computations. */ - - y0 = -h__; - xm = 0.; - ecc = sqrt(ecc2); - if (y0 > 0.) { - xu = 0.; - xl = -ecc; - } else if (y0 < 0.) { - xu = ecc; - xl = 0.; - } else { - ret_val = 0.; - return ret_val; - } - -/* Iterate until we are assured of being in a region where */ -/* Newton's method will converge quickly. The formula */ -/* below was empirically determined to give good results. */ - -/* Computing MIN */ -/* Computing MAX */ - d__1 = 1. / (1. - ecc); - i__3 = 1, i__4 = i_dnnt(&d__1); - i__1 = 32, i__2 = max(i__3,i__4); - maxit = min(i__1,i__2); - i__1 = maxit; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute the next midpoint. We bracket XM by XL and XU just in */ -/* case some kind of strange rounding occurs in the computation */ -/* of the midpoint. */ - -/* Computing MAX */ -/* Computing MIN */ - d__3 = xu, d__4 = (xl + xu) * .5; - d__1 = xl, d__2 = min(d__3,d__4); - xm = max(d__1,d__2); - -/* Compute Y at the midpoint of XU and XL */ - - yxm = xm - h__ * cos(xm) - k * sin(xm); - -/* Determine the new upper and lower bounds. */ - - if (yxm > 0.) { - xu = xm; - } else { - xl = xm; - } - } - -/* We've bisected into a region where we can now get rapid */ -/* convergence using Newton's method. */ - - x = xm; - for (i__ = 1; i__ <= 5; ++i__) { - cosx = cos(x); - sinx = sin(x); - -/* Compute Y and Y' at X. Use these to get the next */ -/* iteration for X. */ - -/* For those of you who might be wondering, "Why not put */ -/* in a check for YX .EQ. 0 and return early if we get */ -/* an exact solution?" Here's why. An empirical check */ -/* of those cases where you can actually escape from the */ -/* Do-loop showed that the test YX .EQ. 0 is true */ -/* only about once in every 10000 case of random inputs */ -/* of EVEC. Thus on average the check is a waste of */ -/* time and we don't bother with it. */ - - yx = x - h__ * cosx - k * sinx; - ypx = h__ * sinx + 1. - k * cosx; - x -= yx / ypx; - } - ret_val = x; - return ret_val; -} /* kpsolv_ */ - diff --git a/ext/spice/src/cspice/ktotal_c.c b/ext/spice/src/cspice/ktotal_c.c deleted file mode 100644 index 7aab4974eb..0000000000 --- a/ext/spice/src/cspice/ktotal_c.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - --Procedure ktotal_c ( Kernel Totals ) - --Abstract - - Return the current number of kernels that have been loaded - via the KEEPER interface that are of a specified type. - --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 - - KERNEL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void ktotal_c ( ConstSpiceChar * kind, - SpiceInt * count ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - kind I A list of kinds of kernels to count. - count O The number of kernels of type kind. - --Detailed_Input - - kind is a list of types of kernels to count when computing - loaded kernels. kind should consist of a list of words - of kernels to examine. Recognized types are - - SPK --- All SPK files are counted in the total. - CK --- All CK files are counted in the total. - PCK --- All binary PCK files are counted in the - total. - EK --- All EK files are counted in the total. - TEXT --- All text kernels that are not meta-text. - kernels are included in the total. - META --- All meta-text kernels are counted in the - total. - ALL --- Every type of kernel is counted in the - total. - - kind is case insensitive. If a word appears in kind - that is not one of those listed above, it is ignored. - - See the Examples section for illustrations of the - use of kind. - --Detailed_Output - - count is the number of kernels loaded through furnsh_c that - belong to the list specified by kind. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If a word on the list specified by kind is not recognized - it is ignored. - - 2) If kind is blank, or none of the words in kind is on the - list specified above, count will be returned as zero. - - 3) If the input file kind argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 4) If the input file kind argument pointer is the empty string, the - error SPICE(EMPTYSTRING) will be signaled. - --Particulars - - ktotal_c allows you to easily determine the number of kernels - loaded via the interface furnsh_c that are of a type of interest. - --Examples - - Suppose you wish to determine the number of SPK kernels that - have been loaded via the interface furnsh_c. Assign kind - the value "SPK" and call ktotal_c as shown: - - #include "SpiceUsr.h" - . - . - . - ktotal_c ( "spk", &count ); - - printf ( "The number of loaded SPK files is: %d\n", count ); - - - To determine the number of text kernels that are loaded that - are not meta-kernels: - - ktotal_c ( "TEXT", &ntext ); - - printf ( "The number of non-meta-text kernels loaded is: %d\n", - ntext ); - - To determine the number of SPK, CK and PCK kernels loaded, make the - following call: - - ktotal_c ( "SPK PCK CK", &count ); - - - To get a count of all loaded kernels: - - ktotal_c ( "ALL", &count ); - - printf ( "There are %d SPICE kernels loaded.\n", count ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 01-SEP-1999 (NJB) (WLT) - --Index_Entries - - Number of loaded kernels of a given type - --& -*/ - -{ /* Begin ktotal_c */ - - - /* - Use discovery check-in. - - Check the input file kind to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "ktotal_c", kind ); - - - ktotal_ ( ( char * ) kind, - ( integer * ) count, - ( ftnlen ) strlen(kind) ); - - -} /* End ktotal_c */ - diff --git a/ext/spice/src/cspice/kxtrct.c b/ext/spice/src/cspice/kxtrct.c deleted file mode 100644 index f05f975fe5..0000000000 --- a/ext/spice/src/cspice/kxtrct.c +++ /dev/null @@ -1,335 +0,0 @@ -/* kxtrct.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure KXTRCT ( Extract a substring starting with a keyword ) */ -/* Subroutine */ int kxtrct_(char *keywd, char *terms, integer *nterms, char * - string, logical *found, char *substr, ftnlen keywd_len, ftnlen - terms_len, ftnlen string_len, ftnlen substr_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, e; - extern integer nblen_(char *, ftnlen); - integer start, berase, eerase; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer delims; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - integer begstr; - extern /* Subroutine */ int shiftl_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern integer wdindx_(char *, char *, ftnlen, ftnlen); - integer endstr, positn; - -/* $ Abstract */ - -/* Locate a keyword in a string and extract the substring from */ -/* the beginning of the first word following the keyword to the */ -/* beginning of the first subsequent recognized terminator of a list. */ - -/* $ 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, PARSING, PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KEYWD I Word that marks the beginning of text of interest. */ -/* TERMS I Set of words, any of which marks the end of text. */ -/* NTERMS I Number of TERMS. */ -/* STRING I/O String containing a sequence of words. */ -/* FOUND O TRUE if the keyword is found in the string. */ -/* SUBSTR O String from end of KEYWD to beginning of first */ -/* TERMS item found. */ - -/* $ Detailed_Input */ - -/* KEYWD is a word used to mark the start of text of interest. */ - -/* TERMS is a set of words, any one of which may signal the */ -/* end of text of interest. */ - -/* NTERMS is the number of TERMS. */ - -/* STRING is a character string made up of words, that may */ -/* contain the keyword in KEYWD. */ - -/* $ Detailed_Output */ - -/* STRING is the input string stripped of all words from */ -/* the beginning of the keyword KEYWD to the end of */ -/* the last word preceding one of the words in TERMS */ -/* (or the end of the string if none of the TERMS follows */ -/* KEYWD in the string). */ - -/* FOUND is .TRUE. if KEYWD is present in the input STRING. */ - -/* SUBSTR is the substring that begins with the first word */ -/* following KEYWD up to the beginning of any of the */ -/* words in TERM or the end of the string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Definitions: */ - -/* A WORD is a set of consecutive non-blank characters */ -/* delimited by blanks or either end of the string */ -/* that contains them. */ - -/* Given a string and a keyword this routine locates the first */ -/* occurrence of the keyword in the string and returns the */ -/* substring between the end of the keyword and the first occurrence */ -/* of any of the words in a list of terminating words. If none */ -/* of the terminating words follows the keyword in the string, */ -/* the routine returns all of the string following the keyword. */ - -/* If the next word following the keyword is a terminating word, */ -/* the substring returned will be a blank. */ - -/* If the keyword can not be located in the string, the variable */ -/* FOUND will be returned as .FALSE. and the input string will be */ -/* unchanged. The substring will be returned as a blank. */ - -/* In all other cases, the part of the input string from the */ -/* beginning of the keyword to the start of the first terminating */ -/* word will be removed. If no terminating word follows the keyword */ -/* the portion of the string from the keyword to the last non-blank */ -/* character of the string will be removed. */ - -/* $ Examples */ - -/* Example 1. */ -/* ---------- */ -/* Input: STRING 'FROM 1 October 1984 12:00:00 TO 1 January 1987' */ -/* KEYWD 'TO' */ -/* TERMS 'FROM' */ -/* 'TO' */ -/* 'BEGINNING' */ -/* 'ENDING' */ - -/* Output: STRING 'FROM 1 October 1984 12:00:00 ' */ -/* FOUND .TRUE. */ -/* SUBSTR '1 January 1987' */ - - - -/* Example 2. */ -/* ---------- */ -/* Input: STRING 'FROM 1 October 1984 12:00:00 TO 1 January 1987' */ -/* KEYWD 'FROM' */ -/* TERMS 'FROM' */ -/* 'TO' */ -/* 'BEGINNING' */ -/* 'ENDING' */ - -/* Output: STRING ' TO 1 January 1987' */ -/* FOUND .TRUE. */ -/* SUBSTR '1 October 1984 12:00:00' */ - - - -/* Example 3. */ -/* ---------- */ -/* Input: STRING 'ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 ' */ -/* KEYWD 'ADDRESS:' */ -/* TERMS 'ADDRESS:' */ -/* 'PHONE:' */ -/* 'NAME:' */ - -/* Output: STRING ' PHONE: 354-4321 ' */ -/* FOUND .TRUE. */ -/* SUBSTR '4800 OAK GROVE DRIVE' */ - - -/* Example 4. */ -/* ---------- */ -/* Input: STRING 'ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 ' */ -/* KEYWD 'NAME:' */ -/* TERMS 'ADDRESS:' */ -/* 'PHONE:' */ -/* 'NAME:' */ - -/* Output: STRING 'ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 ' */ -/* FOUND .FALSE. */ -/* SUBSTR ' ' */ - -/* $ Restrictions */ - -/* It is the user's responsibility to make sure there is adequate */ -/* room in SUBSTR to contain the substring. */ - -/* SUBSTR cannot overwrite STRING. */ - -/* $ 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 */ - -/* extract a substring starting with a keyword */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 28-FEB-1989 (WLT) */ - -/* Reference to REMSUB replaced by SHIFTL. */ - -/* - Beta Version 1.0.1, 10-FEB-1989 (HAN) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Locate the keyword within the string. */ - - positn = wdindx_(string, keywd, string_len, keywd_len); - -/* If the keyword wasn't found, set the outputs and head for home. */ - - if (positn == 0) { - *found = FALSE_; - s_copy(substr, " ", substr_len, (ftnlen)1); - return 0; - } else { - *found = TRUE_; - } - -/* Set the begin erase marker to the start of the current word */ -/* Set the end erase marker to the end of the current word */ - - berase = positn; - eerase = positn + nblen_(keywd, keywd_len) - 1; - start = eerase + 1; - -/* Find the begin and end of the next word. */ - - fndnwd_(string, &start, &b, &e, string_len); - -/* If there is a next word ( E came back non-zero ) see if its a */ -/* terminator. */ - - if (e != 0) { - delims = isrchc_(string + (b - 1), nterms, terms, e - (b - 1), - terms_len); - } - -/* If we found a terminator, or were already at the end of the */ -/* string, we are done. Remove the keyword and put a blank in */ -/* SUBSTR */ - - if (e == 0 || delims != 0) { - i__1 = eerase - berase + 1; - shiftl_(string + (berase - 1), &i__1, " ", string + (berase - 1), - string_len - (berase - 1), (ftnlen)1, string_len - (berase - - 1)); - s_copy(substr, " ", substr_len, (ftnlen)1); - return 0; - } - -/* Ok. If we made it this far, we have at least one legitimate word */ -/* following the keyword, set the pointer for the start of the */ -/* substring (to return) to the beginning of this word. */ - - begstr = b; - -/* Now we just examine each word until we run out of string or we */ -/* run into a terminator. */ - - while(e != 0 && delims == 0) { - endstr = e; - eerase = e; - start = e + 1; - fndnwd_(string, &start, &b, &e, string_len); - if (e != 0) { - delims = isrchc_(string + (b - 1), nterms, terms, e - (b - 1), - terms_len); - } - } - -/* That's it, load the substring variable and remove the keyword */ -/* and words up to the terminator or end of the string --- whichever */ -/* came first. */ - - s_copy(substr, string + (begstr - 1), substr_len, endstr - (begstr - 1)); - i__1 = eerase - berase + 1; - shiftl_(string + (berase - 1), &i__1, " ", string + (berase - 1), - string_len - (berase - 1), (ftnlen)1, string_len - (berase - 1)); - return 0; -} /* kxtrct_ */ - diff --git a/ext/spice/src/cspice/kxtrct_c.c b/ext/spice/src/cspice/kxtrct_c.c deleted file mode 100644 index 1ef41d66c4..0000000000 --- a/ext/spice/src/cspice/kxtrct_c.c +++ /dev/null @@ -1,385 +0,0 @@ -/* - --Procedure kxtrct_c ( Extract a substring starting with a keyword ) - --Abstract - - Locate a keyword in a string and extract the substring from - the beginning of the first word following the keyword to the - beginning of the first subsequent recognized terminator of a list. - --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, PARSING, PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void kxtrct_c ( ConstSpiceChar * keywd, - SpiceInt termlen, - const void * terms, - SpiceInt nterms, - SpiceInt stringlen, - SpiceInt substrlen, - SpiceChar * string, - SpiceBoolean * found, - SpiceChar * substr ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - keywd I Word that marks the beginning of text of interest. - termlen I Length of strings in string array term. - terms I Set of words, any of which marks the end of text. - nterms I Number of terms. - stringlen I Available space in argument string. - substrlen I Available space in output substring. - string I/O String containing a sequence of words. - found O SPICETRUE if the keyword is found in the string. - substr O String from end of keywd to beginning of first - terms item found. - --Detailed_Input - - keywd is a word used to mark the start of text of interest. - - termlen is the maximum number of characters that can be - accommodated in the each element of the input argument - terms. This count includes room for the terminating null - characters. - - terms is a set of words, any one of which may signal the - end of text of interest. - - The array terms should be declared with dimensions - - [nterms][termlen] - - nterms is the number of elements in the array terms. - - stringlen is the maximum number of characters that can be - accommodated in the in/out argument string. This count - includes room for the terminating null character. - For example, if the maximum allowed length of the - output string, including the terminating null, is 25 - characters, then stringlen should be set to 25. - - substrlen is the maximum number of characters that can be - accommodated in the output argument substr. This count - includes room for the terminating null character. - - string is a character string made up of words, which may - contain the keyword in keywd. - --Detailed_Output - - string is the input string stripped of all words from - the beginning of the keyword keywd to the end of - the last word preceding one of the words in terms - (or the end of the string if none of the terms follows - keywd in the string). - - found is a flag indicating whether keywd is present in the - input string. found is set to SPICETRUE if the keyword - is present and SPICEFALSE otherwise. - - substr is the substring that begins with the first word - following keywd up to the beginning of any of the - words in term or the end of the string. If no words - are found between the keyword and the next terminator, - substr is returned empty. - - substr cannot overwrite string. - --Parameters - - None. - --Exceptions - - 1) If any string pointer argument is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If keywd has string length zero, the error SPICE(EMPTYSTRING) - will be signaled. - - 3) If any of the arguments terms, string, or substr has length - less than 2, as indicated by their associated length arguments - termlen, stringlen and substrlen, the error SPICE(STRINGTOOSHORT) - will be signaled. - --Files - - None. - --Particulars - - Definitions: - - A WORD is a set of consecutive non-blank characters - delimited by blanks or either end of the string - that contains them. - - Given a string and a keyword this routine locates the first - occurrence of the keyword in the string and returns the - substring between the end of the keyword and the first occurrence - of any of the words in a list of terminating words. If none - of the terminating words follows the keyword in the string, - the routine returns all of the string following the keyword. - - If the next word following the keyword is a terminating word, - the substring returned will be empty. - - If the keyword can not be located in the string, the variable - found will be returned as SPICEFALSE and the input string will be - unchanged. The substring will be returned empty. - - In all other cases, the part of the input string from the - beginning of the keyword to the start of the first terminating - word will be removed. If no terminating word follows the keyword - the portion of the string from the keyword to the last non-blank - character of the string will be removed. - --Examples - - Example 1. - ---------- - Input: string "FROM 1 October 1984 12:00:00 TO 1 January 1987" - keywd "TO" - terms "FROM" - "TO" - "BEGINNING" - "ENDING" - - Output: string "FROM 1 October 1984 12:00:00" - found SPICETRUE - substr "1 January 1987" - - - - Example 2. - ---------- - Input: string "FROM 1 October 1984 12:00:00 TO 1 January 1987" - keywd "FROM" - terms "FROM" - "TO" - "BEGINNING" - "ENDING" - - Output: string " TO 1 January 1987" - found SPICETRUE - substr "1 October 1984 12:00:00" - - - - Example 3. - ---------- - Input: string "ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 " - keywd "ADDRESS:" - terms "ADDRESS:" - "PHONE:" - "NAME:" - - Output: string " PHONE: 354-4321" - found SPICETRUE - substr "4800 OAK GROVE DRIVE" - - - Example 4. - ---------- - Input: string "ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 " - keywd "NAME:" - terms "ADDRESS:" - "PHONE:" - "NAME:" - - Output: string "ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321" - found SPICEFALSE - substr "" - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-AUG-2002 (NJB) (HAN) (WLT) - --Index_Entries - - extract a substring starting with a keyword - --& -*/ - -{ /* Begin kxtrct_c */ - - - /* - Local variables - */ - logical fnd; - - SpiceChar * fTermsArr; - SpiceChar ** strptrs; - - SpiceInt fTermsLen; - SpiceInt i; - - - /* - Participate in error tracing. - */ - chkin_c ( "kxtrct_c" ); - - /* - Check the input keyword to make sure the pointer is - non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "kxtrct_c", keywd ); - - /* - Make sure the input string pointer for the terms array is non-null - and that the length termlen is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "kxtrct_c", terms, termlen ); - - /* - Make sure the string pointer for the argument "string" is non-null - and that the length stringlen is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "kxtrct_c", string, stringlen ); - - /* - Make sure the string pointer for the argument "substr" is non-null - and that the length substrlen is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "kxtrct_c", substr, substrlen ); - - - /* - We're going to need a Fortran style array of strings to pass to - the f2c'd routine kxtrct_. We can create such an array using - dynamically allocated memory by calling C2F_CreateStrArr_Sig. But - first, we'll need an array of character pointers, each one pointing - to a string in the input terms array. - */ - - strptrs = (SpiceChar **) malloc( (size_t) nterms * sizeof(SpiceChar *) ); - - if ( strptrs == 0 ) - { - setmsg_c ( "Failure on malloc call to create pointer array " - "for terms values." ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "kxtrct_c" ); - return; - } - - /* - Getting this far means we succeeded in allocating our character - pointer array. Assign the pointers. - */ - - for ( i = 0; i < nterms; i++ ) - { - strptrs[i] = ( (SpiceChar *) terms ) + i * termlen; - } - - /* - Create a Fortran-style string array. - */ - C2F_CreateStrArr_Sig ( nterms, - ( ConstSpiceChar ** ) strptrs, - &fTermsLen, - &fTermsArr ); - - if ( failed_c() ) - { - free ( strptrs ); - - chkout_c ( "kxtrct_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - kxtrct_ ( ( char * ) keywd, - ( char * ) fTermsArr, - ( integer * ) &nterms, - ( char * ) string, - ( logical * ) &fnd, - ( char * ) substr, - ( ftnlen ) strlen(keywd), - ( ftnlen ) fTermsLen, - ( ftnlen ) stringlen-1, - ( ftnlen ) substrlen-1 ); - - /* - Free the dynamically allocated arrays. - */ - free ( fTermsArr ); - free ( strptrs ); - - /* - Convert the output strings to C style. Also set the output found flag. - */ - F2C_ConvertStr ( stringlen, string ); - F2C_ConvertStr ( substrlen, substr ); - - *found = fnd; - - - chkout_c ( "kxtrct_c" ); - -} /* End kxtrct_c */ - - - diff --git a/ext/spice/src/cspice/l_ge.c b/ext/spice/src/cspice/l_ge.c deleted file mode 100644 index 86b4a1f5a7..0000000000 --- a/ext/spice/src/cspice/l_ge.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_ge(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) >= 0); -} diff --git a/ext/spice/src/cspice/l_gt.c b/ext/spice/src/cspice/l_gt.c deleted file mode 100644 index c4b52f5bf7..0000000000 --- a/ext/spice/src/cspice/l_gt.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_gt(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) > 0); -} diff --git a/ext/spice/src/cspice/l_le.c b/ext/spice/src/cspice/l_le.c deleted file mode 100644 index f2740a2381..0000000000 --- a/ext/spice/src/cspice/l_le.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_le(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) <= 0); -} diff --git a/ext/spice/src/cspice/l_lt.c b/ext/spice/src/cspice/l_lt.c deleted file mode 100644 index c48dc946f9..0000000000 --- a/ext/spice/src/cspice/l_lt.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern integer s_cmp(); -logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; -#else -extern integer s_cmp(char *, char *, ftnlen, ftnlen); -logical l_lt(char *a, char *b, ftnlen la, ftnlen lb) -#endif -{ -return(s_cmp(a,b,la,lb) < 0); -} diff --git a/ext/spice/src/cspice/lastnb.c b/ext/spice/src/cspice/lastnb.c deleted file mode 100644 index 72a9032b3d..0000000000 --- a/ext/spice/src/cspice/lastnb.c +++ /dev/null @@ -1,162 +0,0 @@ -/* lastnb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LASTNB ( Last non-blank character ) */ -integer lastnb_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Return the index of the last non-blank character in */ -/* a character 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 */ - -/* ASCII, CHARACTER, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* LASTNB O Index of the last non-blank character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* LASTNB is the index of the last non-blank character */ -/* in the input string. If there are no non-blank */ -/* characters in the string, LASTNB is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* If the string is blank, return zero. Otherwise, step through */ -/* the string one character at a time until something other than */ -/* a blank is found. Return the index of that something within */ -/* the string. */ - -/* $ Examples */ - -/* The following examples illustrate the use of LASTNB. */ - -/* LASTNB ( 'ABCDE' ) = 5 */ -/* LASTNB ( 'AN EXAMPLE' ) = 10 */ -/* LASTNB ( 'AN EXAMPLE ' ) = 10 */ -/* LASTNB ( ' ' ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* Modified the comparison to use integer values and the ICHAR() */ -/* function. This improves the performance of the subroutine. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 7-DEC-1990 (IMU) */ - -/* Corrected a misprint in the description of LASTNB. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* last non-blank character */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Just like it says in the header. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - ret_val = 0; - } else { - for (i__ = i_len(string, string_len); i__ >= 1; --i__) { - if (*(unsigned char *)&string[i__ - 1] != 32) { - ret_val = i__; - return ret_val; - } - } - } - return ret_val; -} /* lastnb_ */ - diff --git a/ext/spice/src/cspice/lastnb_c.c b/ext/spice/src/cspice/lastnb_c.c deleted file mode 100644 index 0a071eb0d2..0000000000 --- a/ext/spice/src/cspice/lastnb_c.c +++ /dev/null @@ -1,173 +0,0 @@ -/* - --Procedure lastnb_c ( Last non-blank character ) - --Abstract - - Return the zero based index of the last non-blank character in - a character 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 - - ASCII, CHARACTER, SEARCH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - SpiceInt lastnb_c ( ConstSpiceChar * string ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Input character string. - - The function returns the zero-based index of the last non-blank - character in a character string. - --Detailed_Input - - string is the input character string. - --Detailed_Output - - The function returns the zero-based index of the last non-blank - character in a character string. If the string is entirely blank - or is empty, the value -1 is returned. - --Parameters - - None. - --Particulars - - If the string is blank or null, return -1. Otherwise, step through - the string one character at a time until something other than - a blank is found. Return the zero based index of that something - within the string. - - Note that if the length of the string to the last non-blank - character is of interest, that value is the returned value plus one. - --Examples - - The following examples illustrate the use of lastnb_c. - - last = lastnb_c ( "ABCDE" ); - last is 4 - - last = lastnb_c ( "AN EXAMPLE" ); - last is 9 - - last = lastnb_c ( "AN EXAMPLE " ); - last is 9 - - last = lastnb_c ( " " ) - last is -1 - --Restrictions - - None. - --Exceptions - - 1) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 27-AUG-1999 (NJB) - - Added check for null input string. Added some further comments - to the Brief_I/O and Detailed_Output header sections. - - -CSPICE Version 1.0.0, 08-FEB-1998 (KRG) (IMU) (EDW) - --Index_Entries - - last non-blank character - --& -*/ - -{ /* Begin lastnb_c */ - - /* - Local variables - */ - SpiceInt i; - - - - /* - Check the input string pointer to make sure it's non-null. - */ - CHKPTR_VAL ( CHK_DISCOVER, "lastnb_c", string, -1 ); - - - i = strlen(string) - 1; - - - /* - Start at the end of the string, moving backwards until a non blank - character is found. Once found return the index value. - */ - - while ( ( i >= 0 ) && ( string[i] == BLANK ) ) - { - i--; - } - - - return i; - - -} /* End lastnb_c */ diff --git a/ext/spice/src/cspice/lastpc.c b/ext/spice/src/cspice/lastpc.c deleted file mode 100644 index c6561d9a43..0000000000 --- a/ext/spice/src/cspice/lastpc.c +++ /dev/null @@ -1,184 +0,0 @@ -/* lastpc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LASTPC ( Last printable character ) */ -integer lastpc_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Return the index of the last printable character in a character */ -/* string. ASCII characters 33-126 are printable. (Blanks are not */ -/* considered printable.) */ - -/* $ 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 */ - -/* ASCII, CHARACTER, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* LASTPC O Index of the last printable character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* LASTPC is the index of the last printable character */ -/* in the input string. Characters 33-126 are */ -/* considered to be printable characters. Blanks */ -/* are not considered printable characters. If */ -/* the input string contains no printable characters, */ -/* LASTPC is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This works exactly like LASTNB, except that it skips */ -/* non-printable characters (ASCII control characters) as */ -/* well as blanks. */ - -/* $ Examples */ - -/* The program */ - -/* INTEGER FRSTNB */ -/* INTEGER FRSTPC */ -/* INTEGER LASTNB */ -/* INTEGER LASTPC */ - -/* CHARACTER*10 S */ - -/* S( 1: 1) = ' ' */ -/* S( 2: 2) = CHAR ( 2 ) */ -/* S( 3: 3) = CHAR ( 3 ) */ -/* S( 4: 4) = 'A' */ -/* S( 5: 5) = 'B' */ -/* S( 6: 6) = 'C' */ -/* S( 7: 7) = CHAR ( 7 ) */ -/* S( 8: 8) = CHAR ( 8 ) */ -/* S( 9: 9) = CHAR ( 9 ) */ -/* S(10:10) = ' ' */ - -/* WRITE (*,*) 'Non-blank from ', FRSTNB(S), ' to ', LASTNB(S) */ -/* WRITE (*,*) 'Printable from ', FRSTPC(S), ' to ', LASTPC(S) */ - -/* END */ - -/* produces te following output: */ - -/* Non-blank from 2 to 9. */ -/* Printable from 4 to 6. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* last printable character */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* Local variables */ - - -/* Look for the last character in the range [33,126], and return */ -/* its index. */ - - for (i__ = i_len(string, string_len); i__ >= 1; --i__) { - if (*(unsigned char *)&string[i__ - 1] >= 33 && *(unsigned char *)& - string[i__ - 1] <= 126) { - ret_val = i__; - return ret_val; - } - } - -/* Still here? No printable characters. Return zero. */ - - ret_val = 0; - return ret_val; -} /* lastpc_ */ - diff --git a/ext/spice/src/cspice/latcyl.c b/ext/spice/src/cspice/latcyl.c deleted file mode 100644 index e1a955d28f..0000000000 --- a/ext/spice/src/cspice/latcyl.c +++ /dev/null @@ -1,173 +0,0 @@ -/* latcyl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LATCYL ( Latitudinal to cylindrical coordinates ) */ -/* Subroutine */ int latcyl_(doublereal *radius, doublereal *long__, - doublereal *lat, doublereal *r__, doublereal *longc, doublereal *z__) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal rh, zz; - -/* $ Abstract */ - -/* Convert from latitudinal coordinates to cylindrical coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RADIUS I Distance of a point from the origin. */ -/* LONG I Angle of the point from the XZ plane in radians. */ -/* LAT I Angle of the point from the XY plane in radians. */ -/* R O Distance of the point from the Z axis. */ -/* LONGC O Angle of the point from the XZ plane in radians. */ -/* Z O Height of the point above the XY plane. */ - -/* $ Detailed_Input */ - -/* RADIUS Distance of a point from the origin. */ - -/* LONG Angle of the point from the XZ plane in radians. */ - -/* LAT Angle of the point from the XY plane in radians. */ - -/* $ Detailed_Output */ - -/* R Distance of the point from the Z axis. */ - -/* LONGC Angle of the point from the XZ plane in radians. */ - -/* Z Height of the point above the XY plane. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the cylindrical coordinates of a point */ -/* whose position is input in latitudinal coordinates. */ - -/* Latitudinal coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* above the equator of a sphere centered at the central reference */ -/* point. */ - -/* $ Examples */ - -/* Other than the obvious conversion between coordinate systems */ -/* this routine could be used to obtain the axial projection */ -/* from a sphere to a cylinder about the z-axis that contains */ -/* the equator of the sphere. The following code fragment */ -/* illustrates this idea. */ - -/* CALL LATCYL ( RADIUS, LONG, LAT, R, LONG, Z ) */ -/* R = RADIUS */ - -/* R, LONG, and Z now contain the coordinates of the projected */ -/* point. Such a projection is valuable because it preserves the */ -/* areas between regions on the sphere and their projections to the */ -/* cylinder. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* latitudinal to cylindrical coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Local variables */ - - -/* Convert to cylindrical, storing in temporary variables */ - - rh = *radius * cos(*lat); - zz = *radius * sin(*lat); - -/* Move the results to output variables. */ - - *longc = *long__; - *r__ = rh; - *z__ = zz; - - return 0; -} /* latcyl_ */ - diff --git a/ext/spice/src/cspice/latcyl_c.c b/ext/spice/src/cspice/latcyl_c.c deleted file mode 100644 index 227b81e9b4..0000000000 --- a/ext/spice/src/cspice/latcyl_c.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure latcyl_c ( Latitudinal to cylindrical coordinates ) - --Abstract - - Convert from latitudinal coordinates to cylindrical coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - - - void latcyl_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * r, - SpiceDouble * lonc, - SpiceDouble * z ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - radius I Distance of a point from the origin. - lon I Angle of the point from the XZ plane in radians. - lat I Angle of the point from the XY plane in radians. - r O Distance of the point from the z axis. - lonc O Angle of the point from the XZ plane in radians. - z O Height of the point above the XY plane. - --Detailed_Input - - radius Distance of a point from the origin. - - lon Angle of the point from the XZ plane in radians. - - lat Angle of the point from the XY plane in radians. - --Detailed_Output - - r Distance of the point from the z axis. - - lonc Angle of the point from the XZ plane in radians. - - z Height of the point above the XY plane. - --Parameters - - None. - --Particulars - - This routine returns the cylindrical coordinates of a point - whose position is input in latitudinal coordinates. - - Latitudinal coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - above the equator of a sphere centered at the central reference - point. - --Examples - - Other than the obvious conversion between coordinate systems - this routine could be used to obtain the axial projection - from a sphere to a cylinder about the z-axis that contains - the equator of the sphere. The following code fragment - illustrates this idea. - - latcyl_c ( radius, lon, lat, &r, &lon, &z ); - r = radius; - - r, lon, and z now contain the coordinates of the projected - point. Such a projection is valuable because it preserves the - areas between regions on the sphere and their projections to the - cylinder. - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - latitudinal to cylindrical coordinates - --& -*/ - -{ /* Begin latcyl_c */ - - /* - Local variables - */ - - SpiceDouble rh; - SpiceDouble zz; - - - /* Convert to cylindrical, storing in temporary variables */ - - rh = radius * cos( lat ); - zz = radius * sin( lat ); - - - /* Move the results to output variables. */ - - *lonc = lon; - *r = rh; - *z = zz; - - -} /* End latcyl_c */ diff --git a/ext/spice/src/cspice/latrec.c b/ext/spice/src/cspice/latrec.c deleted file mode 100644 index a1e006bbde..0000000000 --- a/ext/spice/src/cspice/latrec.c +++ /dev/null @@ -1,208 +0,0 @@ -/* latrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LATREC ( Latitudinal to rectangular coordinates ) */ -/* Subroutine */ int latrec_(doublereal *radius, doublereal *long__, - doublereal *lat, doublereal *rectan) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal x, y, z__; - -/* $ Abstract */ - -/* Convert from latitudinal coordinates to rectangular coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RADIUS I Distance of a point from the origin. */ -/* LONG I Longitude of point in radians. */ -/* LAT I Latitude of point in radians. */ -/* RECTAN O Rectangular coordinates of the point. */ - -/* $ Detailed_Input */ - -/* RADIUS Distance of a point from the origin. */ - -/* LONG Longitude of the input point. This is the angle */ -/* between the prime meridian and the meridian */ -/* containing the point. The direction of increasing */ -/* longitude is from the +X axis towards the +Y axis. */ - -/* Longitude is measured in radians. On input, the */ -/* range of longitude is unrestricted. */ - -/* LAT Latitude of the input point. This is the angle from */ -/* the XY plane of the ray from the origin through the */ -/* point. */ - -/* Latitude is measured in radians. On input, the range */ -/* of latitude is unrestricted. */ - -/* $ Detailed_Output */ - -/* RECTAN The rectangular coordinates of the input point. */ -/* RECTAN is a 3-vector. */ - -/* The units associated with RECTAN are those */ -/* associated with the input RADIUS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the rectangular coordinates of a point */ -/* whose position is input in latitudinal coordinates. */ - -/* Latitudinal coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* above the equator of a sphere centered at the central reference */ -/* point. */ - -/* $ Examples */ - -/* Below are two tables. */ - -/* Listed in the first table (under R, LONG and LAT) are */ -/* latitudinal coordinate triples that approximately represent */ -/* points whose rectangular coordinates are taken from the set */ -/* {-1, 0, 1}. (Angular quantities are given in degrees.) */ - -/* The results of the code fragment */ - -/* C */ -/* C Use the SPICELIB routine CONVRT to convert the angular */ -/* C quantities to radians */ -/* C */ -/* CALL CONVRT ( LAT, 'DEGREES', 'RADIANS', LAT ) */ -/* CALL CONVRT ( LONG, 'DEGREES', 'RADIANS', LONG ) */ - -/* CALL LATREC ( R, LONG, LAT, X ) */ - - -/* are listed in the second parallel table under X(1), X(2) and X(3). */ - - -/* R LONG LAT X(1) X(2) X(3) */ -/* -------------------------- -------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 */ -/* 1.0000 90.0000 0.0000 0.0000 1.0000 0.0000 */ -/* 1.0000 0.0000 90.0000 0.0000 0.0000 1.0000 */ -/* 1.0000 180.0000 0.0000 -1.0000 0.0000 0.0000 */ -/* 1.0000 -90.0000 0.0000 0.0000 -1.0000 0.0000 */ -/* 1.0000 0.0000 -90.0000 0.0000 0.0000 -1.0000 */ -/* 1.4142 45.0000 0.0000 1.0000 1.0000 0.0000 */ -/* 1.4142 0.0000 45.0000 1.0000 0.0000 1.0000 */ -/* 1.4142 90.0000 45.0000 0.0000 1.0000 1.0000 */ -/* 1.7320 45.0000 35.2643 1.0000 1.0000 1.0000 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 29-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - 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 */ - -/* latitudinal to rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Convert to rectangular coordinates, storing the results in */ -/* temporary variables. */ - - x = *radius * cos(*long__) * cos(*lat); - y = *radius * sin(*long__) * cos(*lat); - z__ = *radius * sin(*lat); - -/* Move the results to the output variables. */ - - rectan[0] = x; - rectan[1] = y; - rectan[2] = z__; - return 0; -} /* latrec_ */ - diff --git a/ext/spice/src/cspice/latrec_c.c b/ext/spice/src/cspice/latrec_c.c deleted file mode 100644 index 0551a9b2d7..0000000000 --- a/ext/spice/src/cspice/latrec_c.c +++ /dev/null @@ -1,188 +0,0 @@ -/* - --Procedure latrec_c ( Latitudinal to rectangular coordinates ) - --Abstract - - Convert from latitudinal coordinates to rectangular coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - - void latrec_c ( SpiceDouble radius, - SpiceDouble longitude, - SpiceDouble latitude, - SpiceDouble rectan[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - radius I Distance of a point from the origin. - longitude I Longitude of point in radians. - latitude I Latitude of point in radians. - rectan O Rectangular coordinates of the point. - --Detailed_Input - - radius Distance of a point from the origin. - - longitude Longitude of the input point. This is the angle between - the prime meridian and the meridian containing `rectan'. - The direction of increasing longitude is from the +X axis - towards the +Y axis. - - Longitude is measured in radians. On input, the range - of longitude is unrestricted. - - latitude Latitude of the input point. This is the angle from - the XY plane of the ray from the origin through the - point. - - Latitude is measured in radians. On input, the range of - latitude is unrestricted. - --Detailed_Output - - rectan The rectangular coordinates of the input point. - `rectan' is a 3 vector. - - The units associated with `rectan' are those - associated with the input radius. --Files - - None. - --Exceptions - - Error free. - --Particulars - - This routine returns the rectangular coordinates of a point - whose position is input in latitudinal coordinates. - - Latitudinal coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - above the equator of a sphere centered at the central reference - point. - --Parameters - - None. - --Examples - - Below are two tables. - - Listed in the first table (under r, longitude and latitude ) are - latitudinal coordinate triples that approximately represent - points whose rectangular coordinates are taken from the set - {-1, 0, 1}. (Angular quantities are given in degrees.) - - The results of the code fragment - - /. - Use the CSPICE routine rpd_c() to convert the angular - quantities to radians - ./ - latitude *= rpd_c(); - longitude *= rpd_c(); - - latrec_c ( r, longitude, latitude, rectan ); - - - are listed in the second parallel table under rectan[0], rectan[1], - and rectan[2]. - - - r longitude latitude rectan[0] rectan[1] rectan[2]. - ---------------------------- ------------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 - 1.0000 90.0000 0.0000 0.0000 1.0000 0.0000 - 1.0000 0.0000 90.0000 0.0000 0.0000 1.0000 - 1.0000 180.0000 0.0000 -1.0000 0.0000 0.0000 - 1.0000 -90.0000 0.0000 0.0000 -1.0000 0.0000 - 1.0000 0.0000 -90.0000 0.0000 0.0000 -1.0000 - 1.4142 45.0000 0.0000 1.0000 1.0000 0.0000 - 1.4142 0.0000 45.0000 1.0000 0.0000 1.0000 - 1.4142 90.0000 45.0000 0.0000 1.0000 1.0000 - 1.7320 45.0000 35.2643 1.0000 1.0000 1.0000 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - E.D. Wright (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 29-JUL-2003 (NJB) (CHA) - - Various header corrections were made. - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - latitudinal to rectangular coordinates - --& -*/ - -{ /* Begin latrec_c */ - - /* Function Body */ - - rectan[0] = radius * cos( longitude ) * cos( latitude ); - rectan[1] = radius * sin( longitude ) * cos( latitude ); - rectan[2] = radius * sin( latitude ); - -} /* End latrec_c */ diff --git a/ext/spice/src/cspice/latsph.c b/ext/spice/src/cspice/latsph.c deleted file mode 100644 index 5c19345764..0000000000 --- a/ext/spice/src/cspice/latsph.c +++ /dev/null @@ -1,178 +0,0 @@ -/* latsph.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LATSPH ( Latitudinal to spherical coordinates ) */ -/* Subroutine */ int latsph_(doublereal *radius, doublereal *long__, - doublereal *lat, doublereal *rho, doublereal *colat, doublereal * - longs) -{ - doublereal ph, th; - extern doublereal halfpi_(void); - -/* $ Abstract */ - -/* Convert from latitudinal coordinates to spherical coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RADIUS I Distance of a point from the origin. */ -/* LONG I Angle of the point from the XZ plane in radians. */ -/* LAT I Angle of the point from the XY plane in radians. */ -/* RHO O Distance of the point from the origin. */ -/* COLAT O Angle of the point from positive Z axis (radians). */ -/* LONGS O Angle of the point from the XZ plane (radians). */ - -/* $ Detailed_Input */ - -/* RADIUS Distance of a point from the origin. */ - -/* LONG Angle of the point from the XZ plane in radians. */ - -/* LAT Angle of the point from the XY plane in radians. */ - -/* $ Detailed_Output */ - -/* RHO Distance of the point from the origin. */ - -/* COLAT Angle between the vector from the origin to the point */ -/* and the positive Z axis in radians. */ - -/* LONGS Angle of the point from the XZ plane (radians). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the spherical coordinates of a point */ -/* whose position is input in latitudinal coordinates. */ - -/* Latitudinal coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* above the equator of a sphere centered at the central reference */ -/* point. */ - -/* Spherical coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* from the z-axis. */ - -/* $ Examples */ - -/* Co-latitude is obtained by subtracting latitude from HALFPI() */ -/* Radius and longitude mean the same thing in both latitudinal */ -/* and spherical coordinates. The table below lists LAT */ -/* corresponding COLAT in terms of degrees. */ - -/* LAT COLAT */ -/* ------ ------ */ -/* 0 90 */ -/* 20 70 */ -/* 45 45 */ -/* -30 120 */ -/* 90 0 */ -/* -45 135 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* latitudinal to spherical coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Convert to spherical coordinates, storing the results in */ -/* temporary variables */ - - th = halfpi_() - *lat; - ph = *long__; - -/* Move results to output variables */ - - *rho = *radius; - *colat = th; - *longs = ph; - return 0; -} /* latsph_ */ - diff --git a/ext/spice/src/cspice/latsph_c.c b/ext/spice/src/cspice/latsph_c.c deleted file mode 100644 index 5df1487d03..0000000000 --- a/ext/spice/src/cspice/latsph_c.c +++ /dev/null @@ -1,180 +0,0 @@ -/* - --Procedure latsph_c ( Latitudinal to spherical coordinates ) - --Abstract - - Convert from latitudinal coordinates to spherical coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include "SpiceUsr.h" - - - void latsph_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * rho, - SpiceDouble * colat, - SpiceDouble * lons ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - radius I Distance of a point from the origin. - lon I Angle of the point from the XZ plane in radians. - lat I Angle of the point from the XY plane in radians. - rho O Distance of the point from the origin. - colat O Angle of the point from positive z axis (radians). - lons O Angle of the point from the XZ plane (radians). - --Detailed_Input - - radius Distance of a point from the origin. - - lon Angle of the point from the XZ plane in radians. - - lat Angle of the point from the XY plane in radians. - --Detailed_Output - - rho Distance of the point from the origin. - - colat Angle between the vector from the origin to the point - and the positive z axis in radians. - - lons Angle of the point from the XZ plane (radians). - --Parameters - - None. - --Particulars - - This routine returns the spherical coordinates of a point - whose position is input in latitudinal coordinates. - - Latitudinal coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - above the equator of a sphere centered at the central reference - point. - - Spherical coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - from the z-axis. - --Examples - - Co-latitude is obtained by subtracting latitude from HALFPI() - Radius and longitude mean the same thing in both latitudinal - and spherical coordinates. The table below lists lat - corresponding lat in terms of degrees. - - lat lat - ------ ------ - 0 90 - 20 70 - 45 45 - -30 120 - 90 0 - -45 135 - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 13-DEC-2005 (EDW) - - Corrected typo in Deatiled_Output, substituted - "colat" for "lat." - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - latitudinal to spherical coordinates - --& -*/ - -{ /* Begin latsph_c */ - - /* - Local variables - */ - - SpiceDouble th; - SpiceDouble ph; - - - /* - Convert to spherical coordinates, storing the results in - temporary variables - */ - - th = halfpi_c() - lat; - ph = lon; - - - /* Move results to output variables */ - - *rho = radius; - *colat = th; - *lons = ph; - - -} /* End latsph_c */ diff --git a/ext/spice/src/cspice/lbitbits.c b/ext/spice/src/cspice/lbitbits.c deleted file mode 100644 index 75e9f9c603..0000000000 --- a/ext/spice/src/cspice/lbitbits.c +++ /dev/null @@ -1,62 +0,0 @@ -#include "f2c.h" - -#ifndef LONGBITS -#define LONGBITS 32 -#endif - - integer -#ifdef KR_headers -lbit_bits(a, b, len) integer a, b, len; -#else -lbit_bits(integer a, integer b, integer len) -#endif -{ - /* Assume 2's complement arithmetic */ - - unsigned long x, y; - - x = (unsigned long) a; - y = (unsigned long)-1L; - x >>= b; - y <<= len; - return (integer)(x & ~y); - } - - integer -#ifdef KR_headers -lbit_cshift(a, b, len) integer a, b, len; -#else -lbit_cshift(integer a, integer b, integer len) -#endif -{ - unsigned long x, y, z; - - x = (unsigned long)a; - if (len <= 0) { - if (len == 0) - return 0; - goto full_len; - } - if (len >= LONGBITS) { - full_len: - if (b >= 0) { - b %= LONGBITS; - return (integer)(x << b | x >> LONGBITS -b ); - } - b = -b; - b %= LONGBITS; - return (integer)(x << LONGBITS - b | x >> b); - } - y = z = (unsigned long)-1; - y <<= len; - z &= ~y; - y &= x; - x &= z; - if (b >= 0) { - b %= len; - return (integer)(y | z & (x << b | x >> len - b)); - } - b = -b; - b %= len; - return (integer)(y | z & (x >> b | x << len - b)); - } diff --git a/ext/spice/src/cspice/lbitshft.c b/ext/spice/src/cspice/lbitshft.c deleted file mode 100644 index 81b0fdbeab..0000000000 --- a/ext/spice/src/cspice/lbitshft.c +++ /dev/null @@ -1,11 +0,0 @@ -#include "f2c.h" - - integer -#ifdef KR_headers -lbit_shift(a, b) integer a; integer b; -#else -lbit_shift(integer a, integer b) -#endif -{ - return b >= 0 ? a << b : (integer)((uinteger)a >> -b); - } diff --git a/ext/spice/src/cspice/lbuild.c b/ext/spice/src/cspice/lbuild.c deleted file mode 100644 index e3ab3f8efd..0000000000 --- a/ext/spice/src/cspice/lbuild.c +++ /dev/null @@ -1,235 +0,0 @@ -/* lbuild.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LBUILD ( Build a list in a character string ) */ -/* Subroutine */ int lbuild_(char *items, integer *n, char *delim, char *list, - ftnlen items_len, ftnlen delim_len, ftnlen list_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer dlen, ilen, llen, last, lpos, i__, first; - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Build a list of items delimited by a 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 */ - -/* None. */ - -/* $ Keywords */ - -/* CHARACTER, LIST, STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEMS I Items in the list. */ -/* N I Number of items in the list. */ -/* DELIM I String used to delimit items. */ -/* LIST O List of items delimited by DELIM. */ - -/* $ Detailed_Input */ - -/* ITEMS are the items to be combined to make the output */ -/* list. Leading and trailing blanks are ignored. */ -/* (Only the non-blank parts of the items are used.) */ - -/* N is the number of items. */ - -/* DELIM is the string used to delimit the items in the */ -/* output list. DELIM may contain any number of */ -/* characters, including blanks. */ - -/* $ Detailed_Output */ - -/* LIST is the output list, containing the N elements of */ -/* ITEMS delimited by DELIM. If LIST is not long enough */ -/* to contain the output list, it is truncated on the */ -/* right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The non-blank parts of the elements of the ITEMS array are */ -/* appended to the list, one at a time, separated by DELIM. */ - -/* $ Examples */ - -/* The following examples illustrate the operation of LBUILD. */ - -/* 1) Let */ -/* DELIM = ' ' */ - -/* ITEMS(1) = 'A' */ -/* ITEMS(2) = ' number' */ -/* ITEMS(3) = 'of' */ -/* ITEMS(4) = ' words' */ -/* ITEMS(5) = 'separated' */ -/* ITEMS(6) = ' by' */ -/* ITEMS(7) = 'spaces' */ - -/* Then */ -/* LIST = 'A number of words separated by spaces' */ - -/* 2) Let */ -/* DELIM = '/' */ - -/* ITEMS(1) = ' ' */ -/* ITEMS(2) = ' ' */ -/* ITEMS(3) = 'option1' */ -/* ITEMS(4) = ' ' */ -/* ITEMS(5) = 'option2' */ -/* ITEMS(6) = ' ' */ -/* ITEMS(7) = ' ' */ -/* ITEMS(8) = ' ' */ - -/* Then */ -/* LIST = '//option1//option2///' */ - -/* 3) Let */ -/* DELIM = ' and ' */ - -/* ITEMS(1) = 'Bob' */ -/* ITEMS(2) = 'Carol' */ -/* ITEMS(3) = 'Ted' */ -/* ITEMS(4) = 'Alice' */ - -/* Then */ -/* LIST = 'Bob and Carol and Ted and Alice' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* build a list in a character_string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Find the non-blank part of each item. Move it to the */ -/* end of the list, followed by a delimiter. If the item is */ -/* blank, don't move anything but the delimiter. */ - -/* LPOS is the next position in the output list to be filled. */ -/* LLEN is the length of the output list. */ -/* DLEN is the length of DELIM. */ -/* ILEN is the length of the next item in the list. */ - - s_copy(list, " ", list_len, (ftnlen)1); - lpos = 1; - llen = i_len(list, list_len); - dlen = i_len(delim, delim_len); - if (*n > 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (lpos <= llen) { - if (s_cmp(items + (i__ - 1) * items_len, " ", items_len, ( - ftnlen)1) == 0) { - s_copy(list + (lpos - 1), delim, list_len - (lpos - 1), - delim_len); - lpos += dlen; - } else { - first = frstnb_(items + (i__ - 1) * items_len, items_len); - last = lastnb_(items + (i__ - 1) * items_len, items_len); - ilen = last - first + 1; - s_copy(list + (lpos - 1), items + ((i__ - 1) * items_len - + (first - 1)), list_len - (lpos - 1), last - ( - first - 1)); - suffix_(delim, &c__0, list, delim_len, list_len); - lpos = lpos + ilen + dlen; - } - } - } - -/* We're at the end of the list. Right now, the list ends in */ -/* a delimiter. Drop it. */ - - if (lpos - dlen <= llen) { - i__1 = lpos - dlen - 1; - s_copy(list + i__1, " ", list_len - i__1, (ftnlen)1); - } - } - return 0; -} /* lbuild_ */ - diff --git a/ext/spice/src/cspice/lcase.c b/ext/spice/src/cspice/lcase.c deleted file mode 100644 index 91b40fc4bb..0000000000 --- a/ext/spice/src/cspice/lcase.c +++ /dev/null @@ -1,184 +0,0 @@ -/* lcase.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LCASE ( Convert to lowercase ) */ -/* Subroutine */ int lcase_(char *in, char *out, ftnlen in_len, ftnlen - out_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - static integer shift, uppera, upperz; - integer ich; - -/* $ Abstract */ - -/* Convert the characters in a string to lowercase. */ - -/* $ 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 */ - -/* ASCII, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* OUT O Output string, all lowercase. */ - -/* $ Detailed_Input */ - -/* IN is the input string. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is the input string */ -/* with all uppercase letters converted to lowercase. */ -/* Non-letters are not affected. */ - -/* OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Convert each uppercase character in IN to lowercase. */ - -/* $ Examples */ - -/* 'This is an EXAMPLE' becomes 'this is an example' */ -/* '12345 +-=? > * $ &' '12345 +-=? > * $ &' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* K.R. Gehringer (JPL) */ -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 13-MAR-1996 (KRG) */ - -/* Removed the calls to the string lexicographic functions. */ - -/* Modified the algorithm to use the ICHAR() intrinsic function */ -/* and some local integer storage for the bases of the lower and */ -/* upper case letters. */ - -/* Added a "FIRST" clause to the code so that the lower and */ -/* upper case bases and the separation between them are only */ -/* initialized the first time the subroutine is called rather */ -/* than every time. */ - -/* These changes were made to improve the execution speed of */ -/* the subroutine */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert to lowercase */ - -/* -& */ - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial Data */ - - -/* Do some set up stuff the first time through so that we do not */ -/* need to reinitialize the boundary values used for comparisons */ -/* and the shift on each call. */ - - if (first) { - first = FALSE_; - uppera = 'A'; - upperz = 'Z'; - shift = 'a' - uppera; - } - -/* Move the string from IN to OUT. Step through OUT one character */ -/* at a time, translating letters between 'A' and 'Z' to lowercase. */ - - s_copy(out, in, out_len, in_len); - i__1 = i_len(out, out_len); - for (i__ = 1; i__ <= i__1; ++i__) { - ich = *(unsigned char *)&out[i__ - 1]; - if (ich >= uppera && ich <= upperz) { - *(unsigned char *)&out[i__ - 1] = (char) (ich + shift); - } - } - return 0; -} /* lcase_ */ - diff --git a/ext/spice/src/cspice/lcase_c.c b/ext/spice/src/cspice/lcase_c.c deleted file mode 100644 index 66cd69f70c..0000000000 --- a/ext/spice/src/cspice/lcase_c.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - --Procedure lcase_c ( Convert to lowercase ) - --Abstract - - Convert the characters in a string to lowercase. - --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 - - ASCII, CHARACTER - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - void lcase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - lenout I Maximum length of output string. - out O Output string, all lowercase. - --Detailed_Input - - in is the input string. - - lenout is the maximum allowed length of the output string, - including the terminating null. - --Detailed_Output - - out is the output string. This is the input string - with all lowercase letters converted to lowercase. - Non-letters are not affected. - - If - - lenout < strlen(in)+1 - - the output string will be truncated on the right. - - A terminating null will be placed in out at position - - MinVal ( strlen(in), lenout-1 ) - - unless lenout is less than or equal to zero. - - - out may overwrite in. - --Parameters - - None. - --Exceptions - - 1) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the output string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If lenout is less than or equal to zero, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 4) If the output string is shorter than the input string, the - result will be truncated on the right. - --Files - - None. - --Particulars - - Convert each lowercase character in IN to lowercase. - --Examples - - "This is an example" becomes "THIS IS AN EXAMPLE" - "12345 +-=? > * $ &" "12345 +-=? > * $ &" - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 26-JAN-2005 (NJB) - - Cast to SpiceInt was applied to strlen output to suppress - compiler warnings about comparison of signed and unsigned types. - - -CSPICE Version 1.0.0, 26-AUG-1999 (NJB) - - Based on SPICELIB Version 1.1.0, 13-MAR-1996 (KRG) - - --Index_Entries - - convert to lowercase - --& -*/ - -{ /* Begin lcase_c */ - - - /* - Local macros - */ - #define UPPERA ( (SpiceInt) ('A') ) - #define UPPERZ ( (SpiceInt) ('Z') ) - #define SHIFT ( UPPERA - (SpiceInt) ('a') ) - - - /* - Local variables - */ - SpiceInt i; - SpiceInt ich; - SpiceInt nmove; - - - /* - Check the input string pointer to make sure it's non-null. - */ - CHKPTR( CHK_DISCOVER, "lcase_c", in ); - - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_DISCOVER, "lcase_c", out, lenout ); - - - /* - Move the string from in to out. Step through in one character - at a time, translating letters between 'a' and 'z' to lowercase. - - First, determine how many characters to move. - */ - nmove = MinVal ( (SpiceInt)strlen(in), lenout-1 ); - - - for ( i = 0; i < nmove; i++ ) - { - ich = (SpiceInt) in[i]; - - if ( ( ich >= UPPERA ) && ( ich <= UPPERZ ) ) - { - out[i] = (char) ( ich - SHIFT ); - } - else - { - out[i] = in[i]; - } - } - - - /* - Terminate the output string with a null. We know it has room for at - least one character. - */ - out[nmove] = NULLCHAR; - - -} /* End lcase_c */ diff --git a/ext/spice/src/cspice/ldpool_c.c b/ext/spice/src/cspice/ldpool_c.c deleted file mode 100644 index a4f71f739f..0000000000 --- a/ext/spice/src/cspice/ldpool_c.c +++ /dev/null @@ -1,203 +0,0 @@ -/* - --Procedure ldpool_c ( Load variables from a kernel file into the pool ) - --Abstract - - Load the variables contained in a NAIF ASCII kernel file into the - kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void ldpool_c ( ConstSpiceChar * filename ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - filename I Name of the kernel file. - --Detailed_Input - - filename is the name of the kernel file whose variables will be - loaded into the pool. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 2) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - --Files - - The NAIF ASCII kernel file kernel is opened by rdknew_. - --Particulars - - Text kernels input to this routine need not have native line - terminators for the platform. Lower level CSPICE routines can - read and process non-native text files. This functionality does - not exist in the Fortran SPICELIB. - - Only text kernel readers include the non-native read capability, - (ldpool_c and furnsh_c), the generic text file line reader, rdtext_c - requires native text files. - - Please refer to kernel.req for additiional information. - --Examples - - The following code fragment demonstrates how the data from - several kernel files can be loaded into a kernel pool. After the - pool is loaded, the values in the pool are written to a kernel - file. - - /. - Store in an array the names of the kernel files whose - values will be loaded into the kernel pool. - ./ - kernel [0] = "AXES.KER"; - kernel [1] = "GM.KER"; - kernel [2] = "LEAP_SECONDS.KER"; - - /. - Clear the kernel pool. (This is optional.) - ./ - clpool_c(); - - /. - Load the variables from the three kernel files into the - the kernel pool. - ./ - for ( i = 0; i < 3; i++ ) - { - ldpool_c ( kernel [i] ); - } - --Restrictions - - None. - --Literature_References - - kernel.req - --Author_and_Institution - - R.E. Thurman (JPL) - I.M. Underwood (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.0.2, 27-FEB-2008 (BVS) - - Corrected the contents of the Required_Reading section of - the header. - - -CSPICE Version 2.0.1, 17-OCT-2005 (EDW) - - Added text to Particulars section informing of the - non-native kernel text file reading capability. - - -CSPICE Version 2.0.0, 08-FEB-1998 (NJB) - - Input argument kernel was changed to type ConstSpiceChar * and - was given the new name "filename." - - Re-implemented routine without dynamically allocated, temporary - strings. Made several corrections to the code example. Renamed - the argument "filename" to "kernel" for consistency with the - header comments. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - LOAD variables from a text kernel file into the pool - --& -*/ - -{ /* Begin ldpool_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ldpool_c" ); - - - /* - Check the input string filename to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "ldpool_c", filename ); - - - /* - Call the f2c'd Fortran routine. - */ - ldpool_ ( ( char * ) filename, - ( ftnlen ) strlen(filename) ); - - - chkout_c ( "ldpool_c" ); - - -} /* End ldpool_c */ diff --git a/ext/spice/src/cspice/lgresp.c b/ext/spice/src/cspice/lgresp.c deleted file mode 100644 index a1f6674f2a..0000000000 --- a/ext/spice/src/cspice/lgresp.c +++ /dev/null @@ -1,427 +0,0 @@ -/* lgresp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LGRESP ( Lagrange interpolation on equally spaced points ) */ -doublereal lgresp_(integer *n, doublereal *first, doublereal *step, - doublereal *yvals, doublereal *work, doublereal *x) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal ret_val; - - /* Local variables */ - doublereal newx; - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal c1, c2; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Evaluate a Lagrange interpolating polynomial for a specified */ -/* set of coordinate pairs whose first components are equally */ -/* spaced, at a specified abcissisa value. */ - -/* $ 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 */ - -/* INTERPOLATION */ -/* POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of points defining the polynomial. */ -/* FIRST I First abscissa value. */ -/* STEP I Step size. */ -/* YVALS I Ordinate values. */ -/* WORK I-O Work space array. */ -/* X I Point at which to interpolate the polynomial. */ - -/* The function returns the value at X of the unique polynomial of */ -/* degree N-1 that fits the points in the plane defined by FIRST, */ -/* STEP, and YVALS. */ - -/* $ Detailed_Input */ - -/* N is the number of points defining the polynomial. */ -/* The arrays XVALS and YVALS contain N elements. */ - -/* FIRST, */ -/* STEP are, respectively, a starting abscissa value and a */ -/* step size that define the set of abscissa values */ -/* at which a Lagrange interpolating polynomial is to */ -/* be defined. The set of abscissa values is */ - -/* FIRST + I * STEP, I = 0, ..., N-1 */ - -/* STEP must be non-zero. */ - - -/* YVALS is an array of ordinate values that, together with */ -/* the abscissa values defined by FIRST and STEP, */ -/* define N ordered pairs belonging to the graph of */ -/* a function. The set of points */ - -/* ( FIRST + (I-1)*STEP, YVALS(I) ) */ - -/* where I ranges from 1 to N, define the Lagrange */ -/* polynomial used for interpolation. */ - - -/* WORK is a work space array of the same dimension as */ -/* XVALS and YVALS. It is used by this routine as a */ -/* scratch area to hold intermediate results. WORK */ -/* is permitted to coincide with YVALS. */ - - -/* X is the abscissa value at which the interpolating */ -/* polynomial is to be evaluated. */ - -/* $ Detailed_Output */ - -/* The function returns the value at X of the unique polynomial of */ -/* degree N-1 that fits the points in the plane defined by FIRST, */ -/* STEP, and YVALS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If STEP is zero, the error SPICE(INVALIDSTEPSIZE) will */ -/* be signalled. The function will return the value 0.D0. */ - -/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */ -/* signalled. The function will return the value 0.D0. */ - -/* 3) This routine does not attempt to ward off or diagnose */ -/* arithmetic overflows. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given a set of N distinct abscissa values and corresponding */ -/* ordinate values, there is a unique polynomial of degree N-1, */ -/* often called the `Lagrange polynomial', that fits the graph */ -/* defined by these values. The Lagrange polynomial can be used to */ -/* interpolate the value of a function at a specified point, given a */ -/* discrete set of values of the function. */ - -/* Users of this routine must choose the number of points to use */ -/* in their interpolation method. The authors of Reference [1] have */ -/* this to say on the topic: */ - -/* Unless there is solid evidence that the interpolating function */ -/* is close in form to the true function f, it is a good idea to */ -/* be cautious about high-order interpolation. We */ -/* enthusiastically endorse interpolations with 3 or 4 points, we */ -/* are perhaps tolerant of 5 or 6; but we rarely go higher than */ -/* that unless there is quite rigorous monitoring of estimated */ -/* errors. */ - -/* The same authors offer this warning on the use of the */ -/* interpolating function for extrapolation: */ - -/* ...the dangers of extrapolation cannot be overemphasized: */ -/* An interpolating function, which is perforce an extrapolating */ -/* function, will typically go berserk when the argument x is */ -/* outside the range of tabulated values by more than the typical */ -/* spacing of tabulated points. */ - - -/* For Lagrange interpolation on unequally spaced abscissa values, */ -/* see the SPICELIB routine LGRINT. */ - -/* $ Examples */ - -/* 1) Fit a cubic polynomial through the points */ - -/* ( -1, -2 ) */ -/* ( 1, -8 ) */ -/* ( 3, 26 ) */ -/* ( 5, 148 ) */ - -/* and evaluate this polynomial at x = 2. */ - - -/* PROGRAM TEST_LGRESP */ - -/* DOUBLE PRECISION LGRESP */ -/* DOUBLE PRECISION ANSWER */ -/* DOUBLE PRECISION FIRST */ -/* DOUBLE PRECISION STEP */ -/* DOUBLE PRECISION YVALS (4) */ -/* DOUBLE PRECISION WORK (4) */ -/* INTEGER N */ - -/* N = 4 */ -/* FIRST = -1.D0 */ -/* STEP = 2.D0 */ - -/* YVALS(1) = -2.D0 */ -/* YVALS(2) = -8.D0 */ -/* YVALS(3) = 26.D0 */ -/* YVALS(4) = 148.D0 */ - -/* ANSWER = LGRESP ( N, FIRST, STEP, YVALS, WORK, 2.D0 ) */ - -/* WRITE (*,*) 'ANSWER = ', ANSWER */ -/* END */ - - -/* The returned value of ANSWER should be 1.D0, since the */ -/* unique cubic polynomial that fits these points is */ - -/* 3 2 */ -/* f(x) = x + 2x - 4x - 7 */ - - -/* We also could have invoked LGRESP with the reference */ - -/* ANSWER = LGRESP ( N, FIRST, STEP, YVALS, YVALS, 2.D0 ) */ - -/* if we wished to; in this case YVALS would have been */ -/* modified on output. */ - -/* If we had solved the same problem using a negative step, */ -/* we would have set the elements of YVALS in reverse order, */ -/* as shown below: */ - -/* FIRST = 5.D0 */ -/* STEP = -2.D0 */ - -/* YVALS(1) = 148.D0 */ -/* YVALS(2) = 26.D0 */ -/* YVALS(3) = -8.D0 */ -/* YVALS(4) = -2.D0 */ - -/* ANSWER = LGRESP ( N, FIRST, STEP, YVALS, WORK, 2.D0 ) */ - -/* The returned value of ANSWER would still be 1.D0. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] "Numerical Recipes---The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* William T. Vetterling (see sections 3.0 and 3.1). */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 14-AUG-1993 (NJB) */ - -/* -& */ - -/* $ Index_Entries */ - -/* interpolate function using Lagrange polynomial */ -/* Lagrange interpolation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check in only if an error is detected. */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } - -/* No data, no interpolation. */ - - if (*n < 1) { - ret_val = 0.; - chkin_("LGRESP", (ftnlen)6); - setmsg_("Array size must be positive; was #.", (ftnlen)35); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("LGRESP", (ftnlen)6); - return ret_val; - } - -/* The step size must be non-zero. */ - - if (*step == 0.) { - ret_val = 0.; - chkin_("LGRESP", (ftnlen)6); - setmsg_("Step size was zero.", (ftnlen)19); - sigerr_("SPICE(INVALIDSTEPSIZE)", (ftnlen)22); - chkout_("LGRESP", (ftnlen)6); - return ret_val; - } - -/* We can simplify the interpolation problem by shifting */ -/* and scaling the abscissa values so that they start at 1 */ -/* and are separated by a unit step. All we need to do is */ -/* shift and scale X. */ - - newx = (*x - *first) / *step + 1.; - -/* We're going to compute the value of our interpolating polynomial */ -/* at X by taking advantage of a recursion relation between */ -/* Lagrange polynomials of order n+1 and order n. The method works */ -/* as follows for the case of abscissa values that are not */ -/* necessarily uniformly spaced: */ - -/* Define */ - -/* P (x) */ -/* i(i+1)...(i+j) */ - -/* to be the unique Lagrange polynomial that interpolates our */ -/* input function at the abscissa values */ - -/* x , x , ... x . */ -/* i i+1 i+j */ - - -/* Then we have the recursion relation */ - -/* P (x) = */ -/* i(i+1)...(i+j) */ - -/* x - x */ -/* i */ -/* ----------- * P (x) */ -/* x - x (i+1)...(i+j) */ -/* i i+j */ - - -/* x - x */ -/* i+j */ -/* + ----------- * P (x) */ -/* x - x i(i+1)...(i+j-1) */ -/* i i+j */ - - -/* Repeated application of this relation allows us to build */ -/* successive columns, in left-to-right order, of the */ -/* triangular table */ - - -/* P (x) */ -/* 1 */ -/* P (x) */ -/* 12 */ -/* P (x) P (x) */ -/* 2 123 */ -/* P (x) */ -/* 23 . */ -/* P (x) */ -/* . 234 . */ -/* . */ -/* . . . */ -/* . */ -/* . . P (x) */ -/* . . 12...N */ -/* . */ -/* . */ - -/* . */ - - -/* P (x) */ -/* (N-2)(N-1)N */ -/* P (x) */ -/* (N-1)N */ -/* P (x) */ -/* N */ - - -/* and after N-1 steps arrive at our desired result, */ - - -/* P (x). */ -/* 12...N */ - -/* In the current case, we've arranged the problem so that */ - -/* x = i. */ -/* i */ - -/* We'll use the scratch array WORK to contain the current column of */ -/* our interpolation table. To start out with, WORK(I) will contain */ - -/* P (x). */ -/* I */ - - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - work[i__ - 1] = yvals[i__ - 1]; - } - -/* Compute columns 2 through N of the table. */ - - i__1 = *n - 1; - for (j = 1; j <= i__1; ++j) { - i__2 = *n - j; - for (i__ = 1; i__ <= i__2; ++i__) { - c1 = (doublereal) (i__ + j) - newx; - c2 = newx - (doublereal) i__; - work[i__ - 1] = (c1 * work[i__ - 1] + c2 * work[i__]) / ( - doublereal) j; - } - } - -/* Our result is sitting in WORK(1) at this point. */ - - ret_val = work[0]; - return ret_val; -} /* lgresp_ */ - diff --git a/ext/spice/src/cspice/lgrind.c b/ext/spice/src/cspice/lgrind.c deleted file mode 100644 index 82e4b3925d..0000000000 --- a/ext/spice/src/cspice/lgrind.c +++ /dev/null @@ -1,455 +0,0 @@ -/* lgrind.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LGRIND (Lagrange polynomial interpolation with derivative) */ -/* Subroutine */ int lgrind_(integer *n, doublereal *xvals, doublereal *yvals, - doublereal *work, doublereal *x, doublereal *p, doublereal *dp) -{ - /* System generated locals */ - integer xvals_dim1, yvals_dim1, work_dim1, work_offset, i__1, i__2, i__3, - i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal c1, c2; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Evaluate a Lagrange interpolating polynomial for a specified */ -/* set of coordinate pairs, at a specified abcissisa value. */ -/* Return the value of both polynomial and derivative. */ - -/* $ 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 */ - -/* INTERPOLATION */ -/* POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of points defining the polynomial. */ -/* XVALS I Abscissa values. */ -/* YVALS I Ordinate values. */ -/* WORK I-O Work space array. */ -/* X I Point at which to interpolate the polynomial. */ -/* P O Polynomial value at X. */ -/* DP O Polynomial derivative at X. */ - -/* $ Detailed_Input */ - -/* N is the number of points defining the polynomial. */ -/* The arrays XVALS and YVALS contain N elements. */ - - -/* XVALS, */ -/* YVALS are arrays of abscissa and ordinate values that */ -/* together define N ordered pairs. The set of points */ - -/* ( XVALS(I), YVALS(I) ) */ - -/* define the Lagrange polynomial used for */ -/* interpolation. The elements of XVALS must be */ -/* distinct and in increasing order. */ - - -/* WORK is an N x 2 work space array, where N is the same */ -/* dimension as that of XVALS and YVALS. It is used */ -/* by this routine as a scratch area to hold */ -/* intermediate results. WORK is permitted to */ -/* coincide with YVALS. */ - - -/* X is the abscissa value at which the interpolating */ -/* polynomial is to be evaluated. */ - -/* $ Detailed_Output */ - -/* P is the value at X of the unique polynomial of */ -/* degree N-1 that fits the points in the plane */ -/* defined by XVALS and YVALS. */ - -/* DP is the derivative at X of the interpolating */ -/* polynomial described above. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any two elements of the array XVALS are equal the error */ -/* SPICE(DIVIDEBYZERO) will be signaled. */ - -/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */ -/* signaled. */ - -/* 3) This routine does not attempt to ward off or diagnose */ -/* arithmetic overflows. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given a set of N distinct abscissa values and corresponding */ -/* ordinate values, there is a unique polynomial of degree N-1, often */ -/* called the `Lagrange polynomial', that fits the graph defined by */ -/* these values. The Lagrange polynomial can be used to interpolate */ -/* the value of a function at a specified point, given a discrete */ -/* set of values of the function. */ - -/* Users of this routine must choose the number of points to use */ -/* in their interpolation method. The authors of Reference [1] have */ -/* this to say on the topic: */ - -/* Unless there is solid evidence that the interpolating function */ -/* is close in form to the true function f, it is a good idea to */ -/* be cautious about high-order interpolation. We */ -/* enthusiastically endorse interpolations with 3 or 4 points, we */ -/* are perhaps tolerant of 5 or 6; but we rarely go higher than */ -/* that unless there is quite rigorous monitoring of estimated */ -/* errors. */ - -/* The same authors offer this warning on the use of the */ -/* interpolating function for extrapolation: */ - -/* ...the dangers of extrapolation cannot be overemphasized: */ -/* An interpolating function, which is perforce an extrapolating */ -/* function, will typically go berserk when the argument x is */ -/* outside the range of tabulated values by more than the typical */ -/* spacing of tabulated points. */ - -/* $ Examples */ - -/* 1) Fit a cubic polynomial through the points */ - -/* ( -1, -2 ) */ -/* ( 0, -7 ) */ -/* ( 1, -8 ) */ -/* ( 3, 26 ) */ - -/* and evaluate this polynomial at x = 2. */ - - -/* PROGRAM TEST_LGRIND */ - -/* DOUBLE PRECISION P */ -/* DOUBLE PRECISION DP */ -/* DOUBLE PRECISION XVALS (4) */ -/* DOUBLE PRECISION YVALS (4) */ -/* DOUBLE PRECISION WORK (4,2) */ -/* INTEGER N */ - -/* N = 4 */ - -/* XVALS(1) = -1 */ -/* XVALS(2) = 0 */ -/* XVALS(3) = 1 */ -/* XVALS(4) = 3 */ - -/* YVALS(1) = -2 */ -/* YVALS(2) = -7 */ -/* YVALS(3) = -8 */ -/* YVALS(4) = 26 */ - -/* CALL LGRIND ( N, XVALS, YVALS, WORK, 2.D0, P, DP ) */ - -/* WRITE (*,*) 'P, DP = ', P, DP */ -/* END */ - - -/* The returned value of P should be 1.D0, since the */ -/* unique cubic polynomial that fits these points is */ - -/* 3 2 */ -/* f(x) = x + 2x - 4x - 7 */ - - -/* The returned value of DP should be 1.6D1, since the */ -/* derivative of f(x) is */ - -/* ' 2 */ -/* f (x) = 3x + 4x - 4 */ - - -/* We also could have invoked LGRIND with the reference */ - -/* CALL LGRIND ( N, XVALS, YVALS, YVALS, 2.D0, P, DP ) */ - -/* if we wished to; in this case YVALS would have been */ -/* modified on output. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] "Numerical Recipes---The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* William T. Vetterling (see sections 3.0 and 3.1). */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* interpolate function using Lagrange polynomial */ -/* Lagrange interpolation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check in only if an error is detected. */ - - /* Parameter adjustments */ - work_dim1 = *n; - work_offset = work_dim1 + 1; - yvals_dim1 = *n; - xvals_dim1 = *n; - - /* Function Body */ - if (return_()) { - return 0; - } - -/* No data, no interpolation. */ - - if (*n < 1) { - chkin_("LGRIND", (ftnlen)6); - setmsg_("Array size must be positive; was #.", (ftnlen)35); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("LGRIND", (ftnlen)6); - return 0; - } - -/* We're going to compute the value of our interpolating polynomial */ -/* at X by taking advantage of a recursion relation between */ -/* Lagrange polynomials of order n+1 and order n. The method works */ -/* as follows: */ - -/* Define */ - -/* P (x) */ -/* i(i+1)...(i+j) */ - -/* to be the unique Lagrange polynomial that interpolates our */ -/* input function at the abscissa values */ - -/* x , x , ... x . */ -/* i i+1 i+j */ - - -/* Then we have the recursion relation */ - -/* P (x) = */ -/* i(i+1)...(i+j) */ - -/* x - x */ -/* i */ -/* ----------- * P (x) */ -/* x - x (i+1)...(i+j) */ -/* i i+j */ - - -/* x - x */ -/* i+j */ -/* + ----------- * P (x) */ -/* x - x i(i+1)...(i+j-1) */ -/* i i+j */ - - -/* Repeated application of this relation allows us to build */ -/* successive columns, in left-to-right order, of the */ -/* triangular table */ - - -/* P (x) */ -/* 1 */ -/* P (x) */ -/* 12 */ -/* P (x) P (x) */ -/* 2 123 */ -/* P (x) */ -/* 23 . */ -/* P (x) */ -/* . 234 . */ -/* . */ -/* . . . */ -/* . */ -/* . . P (x) */ -/* . . 12...N */ -/* . */ -/* . */ - -/* . */ - - -/* P (x) */ -/* (N-2)(N-1)N */ -/* P (x) */ -/* (N-1)N */ -/* P (x) */ -/* N */ - - -/* and after N-1 steps arrive at our desired result, */ - - -/* P (x). */ -/* 12...N */ - - -/* The computation is easier to do than to describe. */ - - -/* We'll use the scratch array WORK to contain the current column of */ -/* our interpolation table. To start out with, WORK(I) will contain */ - -/* P (x). */ -/* I */ - -/* For columns 2...N of the table, we'll also carry along the */ -/* derivative at X of each interpolating polynomial. This will */ -/* allow us to find the derivative of the Lagrange polynomial */ -/* at X. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - work[(i__2 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "lgrind_", (ftnlen)374)] = - yvals[(i__3 = i__ - 1) < yvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("yvals", i__3, "lgrind_", (ftnlen)374)]; - work[(i__2 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 << 1 && - 0 <= i__2 ? i__2 : s_rnge("work", i__2, "lgrind_", (ftnlen) - 375)] = 0.; - } - -/* Compute columns 2 through N of the table. Note that DENOM must */ -/* be non-zero, or else a divide-by-zero error will occur. */ - - i__1 = *n - 1; - for (j = 1; j <= i__1; ++j) { - i__2 = *n - j; - for (i__ = 1; i__ <= i__2; ++i__) { - denom = xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("xvals", i__3, "lgrind_", (ftnlen)387)] - xvals[( - i__4 = i__ + j - 1) < xvals_dim1 && 0 <= i__4 ? i__4 : - s_rnge("xvals", i__4, "lgrind_", (ftnlen)387)]; - if (denom == 0.) { - chkin_("LGRIND", (ftnlen)6); - setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23); - errint_("#", &i__, (ftnlen)1); - i__3 = i__ + j; - errint_("#", &i__3, (ftnlen)1); - errdp_("#", &xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 <= i__3 - ? i__3 : s_rnge("xvals", i__3, "lgrind_", (ftnlen)395) - ], (ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("LGRIND", (ftnlen)6); - return 0; - } - c1 = *x - xvals[(i__3 = i__ + j - 1) < xvals_dim1 && 0 <= i__3 ? - i__3 : s_rnge("xvals", i__3, "lgrind_", (ftnlen)402)]; - c2 = xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 <= i__3 ? i__3 : - s_rnge("xvals", i__3, "lgrind_", (ftnlen)403)] - *x; - -/* Use the chain rule to compute the derivatives. Do this */ -/* before computing the function value, because the latter */ -/* computation will overwrite the first column of WORK. */ - - work[(i__3 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 << - 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "lgrind_", ( - ftnlen)410)] = (c1 * work[(i__4 = i__ + (work_dim1 << 1) - - work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : - s_rnge("work", i__4, "lgrind_", (ftnlen)410)] + c2 * work[ - (i__5 = i__ + 1 + (work_dim1 << 1) - work_offset) < - work_dim1 << 1 && 0 <= i__5 ? i__5 : s_rnge("work", i__5, - "lgrind_", (ftnlen)410)] + (work[(i__6 = i__ + work_dim1 - - work_offset) < work_dim1 << 1 && 0 <= i__6 ? i__6 : - s_rnge("work", i__6, "lgrind_", (ftnlen)410)] - work[( - i__7 = i__ + 1 + work_dim1 - work_offset) < work_dim1 << - 1 && 0 <= i__7 ? i__7 : s_rnge("work", i__7, "lgrind_", ( - ftnlen)410)])) / denom; - -/* Compute the Ith entry in the Jth column. */ - - work[(i__3 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 - <= i__3 ? i__3 : s_rnge("work", i__3, "lgrind_", (ftnlen) - 416)] = (c1 * work[(i__4 = i__ + work_dim1 - work_offset) - < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge("work", - i__4, "lgrind_", (ftnlen)416)] + c2 * work[(i__5 = i__ + - 1 + work_dim1 - work_offset) < work_dim1 << 1 && 0 <= - i__5 ? i__5 : s_rnge("work", i__5, "lgrind_", (ftnlen)416) - ]) / denom; - } - } - -/* Our results are sitting in WORK(1,1) and WORK(1,2) at this point. */ - - *p = work[(i__1 = work_dim1 + 1 - work_offset) < work_dim1 << 1 && 0 <= - i__1 ? i__1 : s_rnge("work", i__1, "lgrind_", (ftnlen)425)]; - *dp = work[(i__1 = (work_dim1 << 1) + 1 - work_offset) < work_dim1 << 1 && - 0 <= i__1 ? i__1 : s_rnge("work", i__1, "lgrind_", (ftnlen)426)]; - return 0; -} /* lgrind_ */ - diff --git a/ext/spice/src/cspice/lgrint.c b/ext/spice/src/cspice/lgrint.c deleted file mode 100644 index fcabf7c588..0000000000 --- a/ext/spice/src/cspice/lgrint.c +++ /dev/null @@ -1,392 +0,0 @@ -/* lgrint.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LGRINT ( Lagrange polynomial interpolation ) */ -doublereal lgrint_(integer *n, doublereal *xvals, doublereal *yvals, - doublereal *work, doublereal *x) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal ret_val; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal c1, c2; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Evaluate a Lagrange interpolating polynomial for a specified */ -/* set of coordinate pairs, at a specified abcissisa value. */ - -/* $ 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 */ - -/* INTERPOLATION */ -/* POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of points defining the polynomial. */ -/* XVALS I Abscissa values. */ -/* YVALS I Ordinate values. */ -/* WORK I-O Work space array. */ -/* X I Point at which to interpolate the polynomial. */ - -/* The function returns the value at X of the unique polynomial of */ -/* degree N-1 that fits the points in the plane defined by XVALS and */ -/* YVALS. */ - -/* $ Detailed_Input */ - -/* N is the number of points defining the polynomial. */ -/* The arrays XVALS and YVALS contain N elements. */ - - -/* XVALS, */ -/* YVALS are arrays of abscissa and ordinate values that */ -/* together define N ordered pairs. The set of points */ - -/* ( XVALS(I), YVALS(I) ) */ - -/* define the Lagrange polynomial used for */ -/* interpolation. The elements of XVALS must be */ -/* distinct and in increasing order. */ - - -/* WORK is a work space array of the same dimension as */ -/* XVALS and YVALS. It is used by this routine as a */ -/* scratch area to hold intermediate results. WORK */ -/* is permitted to coincide with YVALS. */ - - -/* X is the abscissa value at which the interpolating */ -/* polynomial is to be evaluated. */ - -/* $ Detailed_Output */ - -/* The function returns the value at X of the unique polynomial of */ -/* degree N-1 that fits the points in the plane defined by XVALS and */ -/* YVALS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any two elements of the array XVALS are equal the error */ -/* SPICE(DIVIDEBYZERO) will be signalled. The function will */ -/* return the value 0.D0. */ - -/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */ -/* signalled. The function will return the value 0.D0. */ - -/* 3) This routine does not attempt to ward off or diagnose */ -/* arithmetic overflows. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given a set of N distinct abscissa values and corresponding */ -/* ordinate values, there is a unique polynomial of degree N-1, often */ -/* called the `Lagrange polynomial', that fits the graph defined by */ -/* these values. The Lagrange polynomial can be used to interpolate */ -/* the value of a function at a specified point, given a discrete */ -/* set of values of the function. */ - -/* Users of this routine must choose the number of points to use */ -/* in their interpolation method. The authors of Reference [1] have */ -/* this to say on the topic: */ - -/* Unless there is solid evidence that the interpolating function */ -/* is close in form to the true function f, it is a good idea to */ -/* be cautious about high-order interpolation. We */ -/* enthusiastically endorse interpolations with 3 or 4 points, we */ -/* are perhaps tolerant of 5 or 6; but we rarely go higher than */ -/* that unless there is quite rigorous monitoring of estimated */ -/* errors. */ - -/* The same authors offer this warning on the use of the */ -/* interpolating function for extrapolation: */ - -/* ...the dangers of extrapolation cannot be overemphasized: */ -/* An interpolating function, which is perforce an extrapolating */ -/* function, will typically go berserk when the argument x is */ -/* outside the range of tabulated values by more than the typical */ -/* spacing of tabulated points. */ - -/* $ Examples */ - -/* 1) Fit a cubic polynomial through the points */ - -/* ( -1, -2 ) */ -/* ( 0, -7 ) */ -/* ( 1, -8 ) */ -/* ( 3, 26 ) */ - -/* and evaluate this polynomial at x = 2. */ - - -/* PROGRAM TEST_LGRINT */ - -/* DOUBLE PRECISION LGRINT */ -/* DOUBLE PRECISION ANSWER */ -/* DOUBLE PRECISION XVALS (4) */ -/* DOUBLE PRECISION YVALS (4) */ -/* DOUBLE PRECISION WORK (4) */ -/* INTEGER N */ - -/* N = 4 */ - -/* XVALS(1) = -1 */ -/* XVALS(2) = 0 */ -/* XVALS(3) = 1 */ -/* XVALS(4) = 3 */ - -/* YVALS(1) = -2 */ -/* YVALS(2) = -7 */ -/* YVALS(3) = -8 */ -/* YVALS(4) = 26 */ - -/* ANSWER = LGRINT ( N, XVALS, YVALS, WORK, 2.D0 ) */ - -/* WRITE (*,*) 'ANSWER = ', ANSWER */ -/* END */ - - -/* The returned value of ANSWER should be 1.D0, since the */ -/* unique cubic polynomial that fits these points is */ - -/* 3 2 */ -/* f(x) = x + 2x - 4x - 7 */ - - -/* We also could have invoked LGRINT with the reference */ - -/* ANSWER = LGRINT ( N, XVALS, YVALS, YVALS, 2.D0 ) */ - -/* if we wished to; in this case YVALS would have been */ -/* modified on output. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] "Numerical Recipes---The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* William T. Vetterling (see sections 3.0 and 3.1). */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-1993 (NJB) */ - -/* -& */ - -/* $ Index_Entries */ - -/* interpolate function using Lagrange polynomial */ -/* Lagrange interpolation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check in only if an error is detected. */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } - -/* No data, no interpolation. */ - - if (*n < 1) { - ret_val = 0.; - chkin_("LGRINT", (ftnlen)6); - setmsg_("Array size must be positive; was #.", (ftnlen)35); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("LGRINT", (ftnlen)6); - return ret_val; - } - -/* We're going to compute the value of our interpolating polynomial */ -/* at X by taking advantage of a recursion relation between */ -/* Lagrange polynomials of order n+1 and order n. The method works */ -/* as follows: */ - -/* Define */ - -/* P (x) */ -/* i(i+1)...(i+j) */ - -/* to be the unique Lagrange polynomial that interpolates our */ -/* input function at the abscissa values */ - -/* x , x , ... x . */ -/* i i+1 i+j */ - - -/* Then we have the recursion relation */ - -/* P (x) = */ -/* i(i+1)...(i+j) */ - -/* x - x */ -/* i */ -/* ----------- * P (x) */ -/* x - x (i+1)...(i+j) */ -/* i i+j */ - - -/* x - x */ -/* i+j */ -/* + ----------- * P (x) */ -/* x - x i(i+1)...(i+j-1) */ -/* i i+j */ - - -/* Repeated application of this relation allows us to build */ -/* successive columns, in left-to-right order, of the */ -/* triangular table */ - - -/* P (x) */ -/* 1 */ -/* P (x) */ -/* 12 */ -/* P (x) P (x) */ -/* 2 123 */ -/* P (x) */ -/* 23 . */ -/* P (x) */ -/* . 234 . */ -/* . */ -/* . . . */ -/* . */ -/* . . P (x) */ -/* . . 12...N */ -/* . */ -/* . */ - -/* . */ - - -/* P (x) */ -/* (N-2)(N-1)N */ -/* P (x) */ -/* (N-1)N */ -/* P (x) */ -/* N */ - - -/* and after N-1 steps arrive at our desired result, */ - - -/* P (x). */ -/* 12...N */ - - -/* The computation is easier to do than to describe. */ - - -/* We'll use the scratch array WORK to contain the current column of */ -/* our interpolation table. To start out with, WORK(I) will contain */ - -/* P (x). */ -/* I */ - - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - work[i__ - 1] = yvals[i__ - 1]; - } - -/* Compute columns 2 through N of the table. Note that DENOM must */ -/* be non-zero, or else a divide-by-zero error will occur. */ - - i__1 = *n - 1; - for (j = 1; j <= i__1; ++j) { - i__2 = *n - j; - for (i__ = 1; i__ <= i__2; ++i__) { - denom = xvals[i__ - 1] - xvals[i__ + j - 1]; - if (denom == 0.) { - ret_val = 0.; - chkin_("LGRINT", (ftnlen)6); - setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23); - errint_("#", &i__, (ftnlen)1); - i__3 = i__ + j; - errint_("#", &i__3, (ftnlen)1); - errdp_("#", &xvals[i__ - 1], (ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("LGRINT", (ftnlen)6); - return ret_val; - } - c1 = *x - xvals[i__ + j - 1]; - c2 = xvals[i__ - 1] - *x; - work[i__ - 1] = (c1 * work[i__ - 1] + c2 * work[i__]) / denom; - } - } - -/* Our result is sitting in WORK(1) at this point. */ - - ret_val = work[0]; - return ret_val; -} /* lgrint_ */ - diff --git a/ext/spice/src/cspice/lio.h b/ext/spice/src/cspice/lio.h deleted file mode 100644 index 012317206a..0000000000 --- a/ext/spice/src/cspice/lio.h +++ /dev/null @@ -1,74 +0,0 @@ -/* copy of ftypes from the compiler */ -/* variable types - * numeric assumptions: - * int < reals < complexes - * TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX - */ - -/* 0-10 retain their old (pre LOGICAL*1, etc.) */ -/* values to allow mixing old and new objects. */ - -#define TYUNKNOWN 0 -#define TYADDR 1 -#define TYSHORT 2 -#define TYLONG 3 -#define TYREAL 4 -#define TYDREAL 5 -#define TYCOMPLEX 6 -#define TYDCOMPLEX 7 -#define TYLOGICAL 8 -#define TYCHAR 9 -#define TYSUBR 10 -#define TYINT1 11 -#define TYLOGICAL1 12 -#define TYLOGICAL2 13 -#ifdef Allow_TYQUAD -#undef TYQUAD -#define TYQUAD 14 -#endif - -#define LINTW 24 -#define LINE 80 -#define LLOGW 2 -#ifdef Old_list_output -#define LLOW 1.0 -#define LHIGH 1.e9 -#define LEFMT " %# .8E" -#define LFFMT " %# .9g" -#else -#define LGFMT "%.9G" -#endif -/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */ -#define LEFBL 24 - -typedef union -{ - char flchar; - short flshort; - ftnint flint; -#ifdef Allow_TYQUAD - longint fllongint; -#endif - real flreal; - doublereal fldouble; -} flex; -extern int f__scale; -#ifdef KR_headers -extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); -extern int l_read(), l_write(); -#else -#ifdef __cplusplus -extern "C" { -#endif -extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); -extern int l_write(ftnint*, char*, ftnlen, ftnint); -extern void x_wsne(cilist*); -extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*); -extern int l_read(ftnint*,char*,ftnlen,ftnint); -extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*); -extern int z_rnew(void); -#ifdef __cplusplus - } -#endif -#endif -extern ftnint L_len; diff --git a/ext/spice/src/cspice/ljust.c b/ext/spice/src/cspice/ljust.c deleted file mode 100644 index 569acf869d..0000000000 --- a/ext/spice/src/cspice/ljust.c +++ /dev/null @@ -1,173 +0,0 @@ -/* ljust.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LJUST ( Left justify a character string ) */ -/* Subroutine */ int ljust_(char *input, char *output, ftnlen input_len, - ftnlen output_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__, j, li, lo, pos; - -/* $ Abstract */ - -/* Left justify a character 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 */ - -/* ASCII, CHARACTER, STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INPUT I Input character string. */ -/* OUTPUT O Output character string, left justified. */ - -/* $ Detailed_Input */ - -/* INPUT is the input character string. */ - -/* $ Detailed_Output */ - -/* OUTPUT is the output character string, left justified. */ - -/* OUTPUT may overwrite INPUT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* Leading blanks are removed from the input character string. */ -/* If the output string is not large enough to hold the left */ -/* justified string, it is truncated on the right. */ - -/* $ Examples */ - -/* The following examples illustrate the use of LJUST. */ - -/* 'ABCDE' becomes 'ABCDE' */ -/* 'AN EXAMPLE' 'AN EXAMPLE' */ -/* ' AN EXAMPLE ' 'AN EXAMPLE' */ -/* ' ' ' ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* left justify a character_string */ - -/* -& */ - -/* Local variables */ - - -/* Blank string? */ - - if (s_cmp(input, " ", input_len, (ftnlen)1) == 0) { - s_copy(output, " ", output_len, (ftnlen)1); - -/* Get the first non-blank character. Start OUTPUT at that point. */ - - } else { - li = i_len(input, input_len); - lo = i_len(output, output_len); - j = 1; - -/* Set I equal to position of first non-blank character of */ -/* INPUT: */ - - i__ = 0; - pos = 1; - while(i__ == 0) { - if (*(unsigned char *)&input[pos - 1] != ' ') { - i__ = pos; - } else { - ++pos; - } - } - -/* I is now the index of the first non-blank character of INPUT; */ -/* I is zero if INPUT is blank. */ - - while(i__ <= li && j <= lo) { - *(unsigned char *)&output[j - 1] = *(unsigned char *)&input[i__ - - 1]; - ++j; - ++i__; - } - if (j <= lo) { - s_copy(output + (j - 1), " ", output_len - (j - 1), (ftnlen)1); - } - } - return 0; -} /* ljust_ */ - diff --git a/ext/spice/src/cspice/lmpool_c.c b/ext/spice/src/cspice/lmpool_c.c deleted file mode 100644 index 8af64b2505..0000000000 --- a/ext/spice/src/cspice/lmpool_c.c +++ /dev/null @@ -1,260 +0,0 @@ -/* - --Procedure lmpool_c ( Load variables from memory into the pool ) - --Abstract - - Load the variables contained in an internal buffer into the - kernel pool. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef lmpool_c - - - void lmpool_c ( const void * cvals, - SpiceInt lenvals, - SpiceInt n ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - cvals I An array that contains a SPICE text kernel. - lenvals I Length of strings in cvals. - n I The number of entries in cvals. - --Detailed_Input - - cvals is an array of strings that contains lines of text - that could serve as a SPICE text kernel. cvals is - declared as follows: - - ConstSpiceChar cvals [n][lenvals] - - Each string in cvals is null-terminated. - - lenvals is the common length of the strings in cvals, - including the terminating nulls. - - n is the number of strings in cvals. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 2) If the input string length lenvals is not at least 2, the error - SPICE(STRINGTOOLSHORT) will be signaled. - - 3) The error 'SPICE(BADVARNAME)' signals if a kernel pool - variable name length exceeds 32. - - 4) Other exceptions are diagnosed by routines in the call tree of - this routine. --Files - - None. - --Particulars - - This routine allows you to store a text kernel in an internal - array of your program and load this array into the kernel pool - without first storing its contents as a text kernel. - - Kernel pool variable names are restricted to a length of 32 - characters or less. - --Examples - - Suppose that your application is not particularly sensitive - to the current number of leapseconds but that you would - still like to use a relatively recent leapseconds kernel - without requiring users to load a leapseconds kernel into - the program. The example below shows how you might set up - the initialization portion of your program. - - #include "SpiceUsr.h" - - #define LNSIZE 81 - #define NLINES 27 - - SpiceChar textbuf[NLINES][LNSIZE] = - { - "DELTET/DELTA_T_A = 32.184", - "DELTET/K = 1.657D-3", - "DELTET/EB = 1.671D-2", - "DELTET/M = ( 6.239996 1.99096871D-7 )", - "DELTET/DELTA_AT = ( 10, @1972-JAN-1", - " 11, @1972-JUL-1", - " 12, @1973-JAN-1", - " 13, @1974-JAN-1", - " 14, @1975-JAN-1", - " 15, @1976-JAN-1", - " 16, @1977-JAN-1", - " 17, @1978-JAN-1", - " 18, @1979-JAN-1", - " 19, @1980-JAN-1", - " 20, @1981-JUL-1", - " 21, @1982-JUL-1", - " 22, @1983-JUL-1", - " 23, @1985-JUL-1", - " 24, @1988-JAN-1", - " 25, @1990-JAN-1", - " 26, @1991-JAN-1", - " 27, @1992-JUL-1", - " 28, @1993-JUL-1", - " 29, @1994-JUL-1", - " 30, @1996-JAN-1", - " 31, @1997-JUL-1", - " 32, @1999-JAN-1 )" - }; - - lmpool_c ( textbuf, LNSIZE, NLINES ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.3.1, 10-FEB-2010 (EDW) - - Added mention of the restriction on kernel pool variable - names to 32 characters or less. - - -CSPICE Version 1.3.0, 12-JUL-2002 (NJB) - - Call to C2F_CreateStrArr_Sig replaced with call to C2F_MapStrArr. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input array. - - -CSPICE Version 1.1.0, 14-FEB-2000 (NJB) - - Calls to C2F_CreateStrArr replaced with calls to error-signaling - version of this routine: C2F_CreateStrArr_Sig. - - -CSPICE Version 1.0.0, 08-JUN-1999 (NJB) (WLT) - --Index_Entries - - Load the kernel pool from an internal text buffer - --& -*/ - -{ /* Begin lmpool_c */ - - - - /* - Local variables - */ - - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - chkin_c ( "lmpool_c" ); - - /* - Make sure the input string pointer is non-null and that the - length lenvals is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "lmpool_c", cvals, lenvals ); - - - /* - Create a Fortran-style string array. - */ - C2F_MapStrArr ( "lmpool_c", n, lenvals, cvals, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - chkout_c ( "lmpool_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - lmpool_ ( ( char * ) fCvalsArr, - ( integer * ) &n, - ( ftnlen ) fCvalsLen ); - - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - chkout_c ( "lmpool_c" ); - -} /* End lmpool_c */ - diff --git a/ext/spice/src/cspice/lnkan.c b/ext/spice/src/cspice/lnkan.c deleted file mode 100644 index 85755a0686..0000000000 --- a/ext/spice/src/cspice/lnkan.c +++ /dev/null @@ -1,239 +0,0 @@ -/* lnkan.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LNKAN ( LNK, allocate node ) */ -/* Subroutine */ int lnkan_(integer *pool, integer *new__) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Allocate a node in a doubly linked list pool. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POOL I-O A doubly linked list pool. */ -/* NEW O Number of new node that was allocated. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* $ Detailed_Input */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* POOL is the input pool, with the following */ -/* modifications: */ - -/* -- NEW is an allocated node: both the forward */ -/* and backward pointers of NEW are -NEW. */ - -/* -- The node that was the successor of NEW on */ -/* input is the head of the free list on output. */ - - -/* NEW is the number of the newly allocated node. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If no free nodes are available for allocation, the error */ -/* SPICE(NOFREENODES) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* In a doubly linked list pool, an `allocated node' is one that has */ -/* been removed from the free list. An allocated node may be linked */ -/* to other nodes or may be unlinked; in the latter case, both the */ -/* forward and backward pointers of the node will be the negative of */ -/* the node number. */ - -/* A node must be allocated before it can be linked to another */ -/* node. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool. To build a new list */ -/* of ten nodes, the code fragment below can be used: */ - -/* C */ -/* C We'll use LNKILA ( LNK, insert list after */ -/* C a specified node ) to add nodes to the tail of the */ -/* C list. */ -/* C */ -/* PREV = 0 */ - -/* DO I = 1, 10 */ - -/* CALL LNKAN ( POOL, NODE ) */ -/* CALL LNKILA ( PREV, NODE, POOL ) */ -/* PREV = NODE */ - -/* END DO */ - - -/* 2) In this version of example (1), we check that a sufficient */ -/* number of free nodes are available before building the list: */ - -/* C */ -/* C Make sure we have 10 free nodes available. */ -/* C Signal an error if not. Use LNKNFN to obtain */ -/* C the number of free nodes. */ -/* C */ -/* IF ( LNKNFN(POOL) .LT. 10 ) THEN */ - -/* CALL SETMSG ( 'Only # free nodes are available '// */ -/* . 'but 10 are required.' ) */ -/* CALL ERRINT ( '#', LNKNFN(POOL) ) */ -/* CALL SIGERR ( 'POOL_TOO_SMALL' ) */ -/* RETURN */ - -/* END IF */ - -/* [ Build list ] */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* allocate node from linked list pool */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Discovery check-in is used in place of standard SPICE error */ -/* handling. */ - - if (pool[11] == 0) { - chkin_("LNKAN", (ftnlen)5); - setmsg_("There are no free nodes left for allocating in the supplied" - " linked list pool. ", (ftnlen)78); - sigerr_("SPICE(NOFREENODES)", (ftnlen)18); - chkout_("LNKAN", (ftnlen)5); - return 0; - } - -/* The caller gets the first free node. The forward pointer of */ -/* this node indicates the next free node. After this, there's one */ -/* less free node. */ - - *new__ = pool[8]; - pool[8] = pool[(*new__ << 1) + 10]; - --pool[11]; - -/* The forward and backward pointers of the allocated node become */ -/* the negatives of the node numbers of the head and tail nodes */ -/* of the list containing NEW. Since this is a singleton list, */ -/* both pointers are -NEW. */ - - pool[(*new__ << 1) + 10] = -(*new__); - pool[(*new__ << 1) + 11] = -(*new__); - return 0; -} /* lnkan_ */ - diff --git a/ext/spice/src/cspice/lnkfsl.c b/ext/spice/src/cspice/lnkfsl.c deleted file mode 100644 index 386d9d6b54..0000000000 --- a/ext/spice/src/cspice/lnkfsl.c +++ /dev/null @@ -1,376 +0,0 @@ -/* lnkfsl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKFSL ( LNK, free sublist of a list ) */ -/* Subroutine */ int lnkfsl_(integer *head, integer *tail, integer *pool) -{ - integer node, prev, next; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer count; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Free a specified sublist in a list. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HEAD, */ -/* TAIL I Head and tail nodes of a sublist to be freed. */ -/* POOL I-O A doubly linked list pool. */ - -/* $ Detailed_Input */ - -/* HEAD, */ -/* TAIL are, respectively, the head and tail nodes of a */ -/* sublist to be extracted. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* POOL is the input pool, with the following */ -/* modifications: */ - -/* -- All of the nodes of the sublist bounded by */ -/* HEAD and by TAIL have now been returned to */ -/* the free list. */ - -/* If on input, HEAD was preceded by the node */ -/* PREV, and tail was followed by the node */ -/* NEXT, then on output */ - -/* -- The successor of PREV is NEXT. */ -/* -- The predecessor of NEXT is PREV. */ - - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If either of HEAD or TAIL are not valid node numbers, the */ -/* error SPICE(INVALIDNODE) will be signalled. POOL will not be */ -/* modified. */ - -/* 2) If either of HEAD or TAIL are valid node numbers but are */ -/* not allocated, the error SPICE(UNALLOCATEDNODE) will be */ -/* signalled. POOL will not be modified. */ - -/* 3) If TAIL cannot be reached by forward traversal of the list */ -/* containing HEAD, the error SPICE(INVALIDSUBLIST) is signalled. */ -/* POOL will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Deleting a sublist from a list returns all of the nodes in */ -/* the sublist to the free list. */ - -/* To remove a sublist from a list and retain the sublist */ -/* as a second list, use the routine LNKXSL ( LNK, extract */ -/* sublist ). */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool containing the list */ - -/* 1002 <--> 3 <--> 7 <--> 88 <--> 2 */ - -/* To delete the sublist */ - -/* 3 <--> 7 <--> 88 */ - -/* the call */ - -/* CALL LNKFSL ( 3, 88, POOL ) */ - -/* can be used. The resulting list will be: */ - -/* 1002 <--> 2 */ - -/* The nodes 3, 7, and 88 will now be on the free list. */ - - - -/* 2) Let POOL be a doubly linked list pool containing the list */ - -/* 1002 <--> 3 <--> 7 <--> 88 <--> 2 */ - -/* To free the entire list, the call */ - -/* CALL LNKFSL ( 1002, 2, POOL ) */ - -/* should be used. */ - - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* free sublist of linked list */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* HEAD and TAIL must be valid node numbers. These nodes */ -/* must be allocated as well. */ - - if (*head < 1 || *head > pool[10] || *tail < 1 || *tail > pool[10]) { - chkin_("LNKFSL", (ftnlen)6); - setmsg_("HEAD was #. TAIL was #. Valid range is 1 to #.", (ftnlen)47) - ; - errint_("#", head, (ftnlen)1); - errint_("#", tail, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKFSL", (ftnlen)6); - return 0; - } else if (pool[(*head << 1) + 11] == 0 || pool[(*tail << 1) + 11] == 0) { - chkin_("LNKFSL", (ftnlen)6); - setmsg_("Node HEAD: node number = #; backward pointer = #; forward " - "pointer = #. Node TAIL: node number = #; backward pointer = " - "#; forward pointer = #. (\"FREE\" is #)", (ftnlen)157); - errint_("#", head, (ftnlen)1); - errint_("#", &pool[(*head << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*head << 1) + 10], (ftnlen)1); - errint_("#", tail, (ftnlen)1); - errint_("#", &pool[(*tail << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*tail << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKFSL", (ftnlen)6); - return 0; - } - -/* Starting at HEAD, search forward, looking for TAIL (apologies to */ -/* ZZ Top). Count the nodes in the sublist, while we're at it. */ - - count = 1; - node = *head; - while(node != *tail && node > 0) { - ++count; - node = pool[(node << 1) + 10]; - } - -/* If we didn't find TAIL, that's an error. */ - - if (node != *tail) { - chkin_("LNKFSL", (ftnlen)6); - setmsg_("Node # cannot be found by forward traversal, starting at no" - "de #.", (ftnlen)64); - errint_("#", tail, (ftnlen)1); - errint_("#", head, (ftnlen)1); - sigerr_("SPICE(INVALIDSUBLIST)", (ftnlen)21); - chkout_("LNKFSL", (ftnlen)6); - return 0; - } - -/* We reached TAIL. Extract the sublist between HEAD and TAIL */ -/* inclusive. */ - - -/* Find the predecessor of HEAD and the successor of TAIL. */ - - prev = pool[(*head << 1) + 11]; - next = pool[(*tail << 1) + 10]; - -/* If the input list did not start with HEAD, then we must update */ -/* the forward pointer of the tail node, as well as the backward */ -/* pointer of the head node, of the sublist that preceded HEAD. */ - - if (prev > 0) { - -/* Update the forward pointer of PREV with the forward pointer of */ -/* TAIL. */ - -/* If TAIL had a successor, the predecessor of HEAD will now */ -/* point forward to it. If TAIL was the tail of the input list, */ -/* the forward pointer of TAIL was the negative of the head of */ -/* the input list---this is the correct forward pointer for the */ -/* predecessor of HEAD in this case, since the predecessor of */ -/* HEAD will become the tail of the main list after the sublist */ -/* ranging from HEAD to TAIL is removed. */ - - pool[(prev << 1) + 10] = next; - -/* If TAIL is the tail of the input list, we must update the */ -/* backward pointer of the head of the input list to point to */ -/* the negative of the new tail of the list, which now is PREV. */ - - if (next <= 0) { - -/* In this case, we can read off the number of the head */ -/* node from NEXT: it is just -NEXT. */ - - pool[(-next << 1) + 11] = -prev; - } - } - -/* The portion of the input list that preceded HEAD (if such */ -/* portion existed) has now been taken care of. */ - -/* We now must perform the analogous updates to the portion of */ -/* the input list that followed TAIL. */ - -/* If the input list did not end with TAIL, then we must update */ -/* the backward pointer of the head node, as well as the forward */ -/* pointer of the tail node, of the sublist that followed TAIL. */ - - if (next > 0) { - -/* Update the backward pointer of NEXT with the backward pointer */ -/* of HEAD. */ - -/* If HEAD had a predecessor, the successor of TAIL will now */ -/* point backward to it. If HEAD was the head of the input list, */ -/* the backward pointer of HEAD was the negative of the tail of */ -/* the input list---this is the correct backward pointer for the */ -/* successor of TAIL in this case, since the successor of TAIL */ -/* will become the head of the main list after the sublist */ -/* ranging from HEAD to TAIL is removed. */ - - pool[(next << 1) + 11] = prev; - -/* If HEAD is the head of the input list, we must update the */ -/* forward pointer of the tail of the input list to point to */ -/* the negative of the new head of the list, which now is NEXT. */ - - if (prev <= 0) { - -/* In this case, we can read off the number of the tail */ -/* node from PREV: it is just -PREV. */ - - pool[(-prev << 1) + 10] = -next; - } - } - -/* The portion of the input list that followed TAIL (if such */ -/* portion existed) has now been taken care of. */ - - -/* Set the backward pointers of the freed nodes to FREE. */ - - node = *head; - while(node != next) { - pool[(node << 1) + 11] = 0; - node = pool[(node << 1) + 10]; - } - -/* Return the sublist to the free list. Update the free node */ -/* count. */ - - pool[(*tail << 1) + 10] = pool[8]; - pool[8] = *head; - pool[11] += count; - return 0; -} /* lnkfsl_ */ - diff --git a/ext/spice/src/cspice/lnkhl.c b/ext/spice/src/cspice/lnkhl.c deleted file mode 100644 index 59a662e69d..0000000000 --- a/ext/spice/src/cspice/lnkhl.c +++ /dev/null @@ -1,255 +0,0 @@ -/* lnkhl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKHL ( LNK, head of list ) */ -integer lnkhl_(integer *node, integer *pool) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer prev; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Return the head node of the list containing a specified node. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NODE I Number of a node. */ -/* POOL I A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* The function returns the number of the head node of the list */ -/* containing NODE. */ - -/* $ Detailed_Input */ - -/* NODE is the number of a node in POOL. Normally, */ -/* NODE will designate an allocated node, but NODE */ -/* is permitted to be less than or equal to zero. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* The function returns the number of the head node of the list */ -/* containing NODE. If NODE is non-positive, the function returns */ -/* zero. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If the NODE is less than or equal to zero, NODE is not */ -/* considered to be erroneous. The value 0 is returned. */ - -/* 2) If NODE is greater than the size of the pool, the error */ -/* SPICE(INVALIDNODE) is signalled. The value 0 is returned. */ - -/* 3) If NODE is not the number of an allocated node, the error */ -/* SPICE(UNALLOCATEDNODE) is signalled. The value 0 is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a convenient way to find the head of a list */ -/* in a doubly linked list pool. The need to find the head of a */ -/* list arises in applications such as buffer management. For */ -/* example, in a system using a "least recently used" buffer */ -/* replacement policy, the head of a list may point to the most */ -/* recently accessed buffer element. */ - -/* $ Examples */ - -/* 1) If POOL is a doubly linked list pool that contains the list */ - -/* 3 <--> 7 <--> 1 <--> 44 */ - -/* any of function references */ - -/* HEAD = LNKHL ( 3, POOL ) */ -/* HEAD = LNKHL ( 7, POOL ) */ -/* HEAD = LNKHL ( 44, POOL ) */ - -/* will assign the value 3 to HEAD. */ - - -/* 2) If POOL is a doubly linked list pool that contains the */ -/* singleton list consisting of the allocated node */ - -/* 44 */ - -/* the function reference */ - -/* HEAD = LNKHL ( 44, POOL ) */ - -/* will assign the value 44 to HEAD. */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return head of linked list */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* If the node is non-positive, we regard it as the nil node. */ - - if (*node < 1) { - ret_val = 0; - return ret_val; - -/* If the node is out of range, something's very wrong. */ - - } else if (*node > pool[10]) { - ret_val = 0; - chkin_("LNKHL", (ftnlen)5); - setmsg_("NODE was #; valid range is 1 to #.", (ftnlen)34); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKHL", (ftnlen)5); - return ret_val; - -/* We don't do free nodes. */ - - } else if (pool[(*node << 1) + 11] == 0) { - ret_val = 0; - chkin_("LNKHL", (ftnlen)5); - setmsg_("NODE was #; backward pointer = #; forward pointer = #. \"FR" - "EE\" is #)", (ftnlen)67); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[(*node << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*node << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKHL", (ftnlen)5); - return ret_val; - } - -/* Find the head of the list. */ - - ret_val = *node; - prev = pool[(*node << 1) + 11]; - while(prev > 0) { - ret_val = prev; - prev = pool[(ret_val << 1) + 11]; - } - -/* LNKHL is now the head of the list. */ - - return ret_val; -} /* lnkhl_ */ - diff --git a/ext/spice/src/cspice/lnkila.c b/ext/spice/src/cspice/lnkila.c deleted file mode 100644 index ac0c019947..0000000000 --- a/ext/spice/src/cspice/lnkila.c +++ /dev/null @@ -1,317 +0,0 @@ -/* lnkila.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKILA ( LNK, insert list after node ) */ -/* Subroutine */ int lnkila_(integer *prev, integer *list, integer *pool) -{ - integer head, tail, next; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Insert the list containing a specified node into a another list, */ -/* following a specified node. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PREV I Node after which a new list is to be inserted. */ -/* LIST I Node in the list to be inserted. */ -/* POOL I-O A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* $ Detailed_Input */ - -/* PREV is a node in a list. PREV is permitted to be */ -/* nil, in which case POOL is not modified. */ - -/* LIST is a node in the list to be inserted. The entire */ -/* list containing the node LIST is to be inserted */ -/* into the list containing PREV. The inserted list */ -/* will be located between PREV and its successor, */ -/* if any. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* POOL is the input pool, with the following */ -/* modifications: */ - -/* Let HEAD and TAIL be the head and tail nodes of */ -/* the list containing LIST. Then on output */ - -/* -- The successor of PREV is HEAD. */ -/* -- The predecessor of HEAD is PREV. */ - - -/* Let NEXT be the node that on input was the */ -/* successor of PREV; if NEXT exists, then on */ -/* output */ - -/* -- The successor of TAIL is NEXT. */ -/* -- The predecessor of NEXT is TAIL. */ - -/* If NEXT is nil, the forward pointer of the */ -/* inserted sublist is set to the negative of */ -/* the head of the list containing PREV. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If LIST is not a valid node number, the error */ -/* SPICE(INVALIDNODE) will be signalled. POOL will not be */ -/* modified. */ - -/* 2) If PREV is positive but is not a valid node number, the error */ -/* SPICE(INVALIDNODE) will be signalled. POOL will not be */ -/* modified. */ - -/* 3) It is not an error for PREV to be non-positive; if it is, */ -/* the call to this routine does not affect the pool. */ - -/* 4) If either of PREV or LIST are valid node numbers but are */ -/* not allocated, the error SPICE(UNALLOCATEDNODE) will be */ -/* signalled. POOL will not be modified. */ - -/* 5) If LIST belongs to the same list as does PREV, this routine */ -/* may fail in mysterious ways. For efficiency, this error */ -/* condition is not checked. */ - -/* For efficiency, discovery check-in is used in this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is used for augmenting lists by inserting other */ -/* lists into them. The case of insertion of a single allocated */ -/* node is not special: this is insertion of a singleton list. */ - -/* To insert a list into a list BEFORE a specified element, use the */ -/* routine LNKILB. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool that contains the lists */ - -/* 3 <--> 7 <--> 1 and 500 <--> 2 <--> 80 */ - -/* To insert the second list into the first after node 7, use the */ -/* call */ - -/* CALL LNKILA ( 7, 500, POOL ) */ - -/* The resulting list will be: */ - -/* 3 <--> 7 <--> 500 <--> 2 <--> 80 <--> 1 */ - - -/* 2) Let POOL be a doubly linked list pool that contains 5 nodes. */ -/* The sequence of calls */ - -/* TAIL = 0 */ - -/* DO I = 1, 5 */ -/* CALL LNKAN ( POOL, NODE ) */ -/* CALL LNKILA ( TAIL, NODE, POOL ) */ -/* TAIL = NODE */ -/* END DO */ - -/* builds the list */ - -/* 1 <--> 2 <--> 3 <--> 4 <--> 5 */ - -/* Note that the first call to LNKILA does not cause an error */ -/* to be signalled, even though TAIL is 0 at that point. */ - - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert sublist into linked list after a node */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* If PREV is non-positive, return now. */ - - if (*prev <= 0) { - return 0; - } - -/* At this point, PREV and LIST must be a valid node numbers, and */ -/* both PREV and LIST must be allocated as well. */ - - if (*prev > pool[10] || *list < 1 || *list > pool[10]) { - chkin_("LNKILA", (ftnlen)6); - setmsg_("PREV was #. LIST was #. Valid range is 1 to #.", (ftnlen)47) - ; - errint_("#", prev, (ftnlen)1); - errint_("#", list, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKILA", (ftnlen)6); - return 0; - } else if (pool[(*prev << 1) + 11] == 0 || pool[(*list << 1) + 11] == 0) { - chkin_("LNKILA", (ftnlen)6); - setmsg_("Node PREV: node number = #; backward pointer = #; forward " - "pointer = #. Node LIST: node number = #; backward pointer = " - "#; forward pointer = #. (\"FREE\" is #)", (ftnlen)157); - errint_("#", prev, (ftnlen)1); - errint_("#", &pool[(*prev << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*prev << 1) + 10], (ftnlen)1); - errint_("#", list, (ftnlen)1); - errint_("#", &pool[(*list << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*list << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKILA", (ftnlen)6); - return 0; - } - -/* Find the head and tail of the list containing LIST. */ - - head = *list; - while(pool[(head << 1) + 11] > 0) { - head = pool[(head << 1) + 11]; - } - tail = -pool[(head << 1) + 11]; - -/* Let NEXT be the forward pointer of PREV. */ - -/* Insert HEAD after PREV. */ - -/* If PREV has a successor, TAIL precedes it. */ - -/* If PREV has no successor, TAIL is the new tail of the list. */ -/* The backward pointer of the head of the merged list should */ -/* be set to -TAIL. */ - -/* In either case, the forward pointer of TAIL should be set */ -/* to the forward pointer of PREV. */ - - next = pool[(*prev << 1) + 10]; - pool[(*prev << 1) + 10] = head; - pool[(head << 1) + 11] = *prev; - if (next > 0) { - pool[(next << 1) + 11] = tail; - } else { - pool[(-next << 1) + 11] = -tail; - } - pool[(tail << 1) + 10] = next; - return 0; -} /* lnkila_ */ - diff --git a/ext/spice/src/cspice/lnkilb.c b/ext/spice/src/cspice/lnkilb.c deleted file mode 100644 index e73fb723ba..0000000000 --- a/ext/spice/src/cspice/lnkilb.c +++ /dev/null @@ -1,318 +0,0 @@ -/* lnkilb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKILB ( LNK, insert list before node ) */ -/* Subroutine */ int lnkilb_(integer *list, integer *next, integer *pool) -{ - integer head, tail, prev; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Insert the list containing a specified node into a another list, */ -/* preceding a specified node. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LIST I Node in the list to be inserted. */ -/* NEXT I Node before which a new list is to be inserted. */ -/* POOL I-O A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* $ Detailed_Input */ - -/* LIST is a node in the list to be inserted. The entire */ -/* list containing LIST is to be inserted into the */ -/* list containing NEXT. The inserted list will be */ -/* located between NEXT and its predecessor, if any. */ - -/* NEXT is a node in a list. NEXT is permitted to be */ -/* nil, in which case POOL is not modified. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* POOL is the input pool, with the following */ -/* modifications: */ - -/* Let HEAD and TAIL be the head and tail nodes of */ -/* the list containing LIST. Then on output */ - -/* -- The successor of TAIL is NEXT. */ - -/* -- The predecessor of NEXT is TAIL. */ - - -/* Let PREV be the node that on input was the */ -/* predecessor of NEXT; if PREV exists, then on */ -/* output */ - -/* -- The successor of PREV is HEAD. */ - -/* -- The predecessor of HEAD is PREV. */ - -/* If PREV is nil, the backward pointer of the */ -/* inserted sublist is set to the negative of */ -/* the tail of the list containing NEXT. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If LIST is not a valid node number, the error */ -/* SPICE(INVALIDNODE) will be signalled. POOL will not be */ -/* modified. */ - -/* 2) If NEXT is positive but is not a valid node number, the error */ -/* SPICE(INVALIDNODE) will be signalled. POOL will not be */ -/* modified. */ - -/* 3) It is not an error for NEXT to be non-positive; if it is, */ -/* the call to this routine does not affect the pool. */ - -/* 4) If either of LIST or NEXT are valid node numbers but are */ -/* not allocated, the error SPICE(UNALLOCATEDNODE) will be */ -/* signalled. POOL will not be modified. */ - -/* 5) If LIST belongs to the same list as does NEXT, this routine */ -/* may fail in mysterious ways. For efficiency, this error */ -/* condition is not checked. */ - -/* For efficiency, discovery check-in is used in this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is used for augmenting lists by inserting other */ -/* lists into them. The case of insertion of a single allocated */ -/* node is not special: this is insertion of a singleton list. */ - -/* To insert a list into a list AFTER a specified element, use the */ -/* routine LNKILA. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool that contains the lists */ - -/* 3 <--> 7 <--> 1 and 500 <--> 2 <--> 80 */ - -/* To insert the second list into the first before node 7, use */ -/* the call */ - -/* CALL LNKILB ( 500, 7, POOL ) */ - -/* The resulting list will be: */ - -/* 3 <--> 500 <--> 2 <--> 80 <--> 7 <--> 1 */ - - -/* 2) Let POOL be a doubly linked list pool that contains 5 nodes. */ -/* The sequence of calls */ - -/* HEAD = 0 */ - -/* DO I = 1, 5 */ -/* CALL LNKAN ( POOL, NODE ) */ -/* CALL LNKILB ( NODE, HEAD, POOL ) */ -/* HEAD = NODE */ -/* END DO */ - -/* builds the list */ - -/* 5 <--> 4 <--> 3 <--> 2 <--> 1 */ - -/* Note that the first call to LNKILB does not cause an error */ -/* to be signalled, even though HEAD is 0 at that point. */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert sublist into linked list before a node */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* If NEXT is non-positive, return now. */ - - if (*next <= 0) { - return 0; - } - -/* If we arrived here, NEXT and LIST must be valid node numbers. */ -/* These nodes must be allocated as well. */ - - if (*next > pool[10] || *list < 1 || *list > pool[10]) { - chkin_("LNKILB", (ftnlen)6); - setmsg_("NEXT was #. LIST was #. Valid range is 1 to #.", (ftnlen)47) - ; - errint_("#", next, (ftnlen)1); - errint_("#", list, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKILB", (ftnlen)6); - return 0; - } else if (pool[(*next << 1) + 11] == 0 || pool[(*list << 1) + 11] == 0) { - chkin_("LNKILB", (ftnlen)6); - setmsg_("Node NEXT: node number = #; backward pointer = #; forward " - "pointer = #. Node LIST: node number = #; backward pointer = " - "#; forward pointer = #. (\"FREE\" is #)", (ftnlen)157); - errint_("#", next, (ftnlen)1); - errint_("#", &pool[(*next << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*next << 1) + 10], (ftnlen)1); - errint_("#", list, (ftnlen)1); - errint_("#", &pool[(*list << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*list << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKILB", (ftnlen)6); - return 0; - } - -/* Find the head and tail of the list containing LIST. */ - - head = *list; - while(pool[(head << 1) + 11] > 0) { - head = pool[(head << 1) + 11]; - } - tail = -pool[(head << 1) + 11]; - -/* Let PREV be the backward pointer of NEXT. */ - -/* Insert TAIL before NEXT. */ - -/* If NEXT has a predecessor, HEAD follows it. */ - -/* If NEXT has no predecessor, HEAD is the new head of the list. */ -/* The forward pointer of the tail of the merged list should */ -/* be set to -HEAD. */ - -/* In either case, the backward pointer of HEAD should be set */ -/* to the backward pointer of NEXT. */ - - - prev = pool[(*next << 1) + 11]; - pool[(tail << 1) + 10] = *next; - pool[(*next << 1) + 11] = tail; - if (prev > 0) { - pool[(prev << 1) + 10] = head; - } else { - pool[(-prev << 1) + 10] = -head; - } - pool[(head << 1) + 11] = prev; - return 0; -} /* lnkilb_ */ - diff --git a/ext/spice/src/cspice/lnkini.c b/ext/spice/src/cspice/lnkini.c deleted file mode 100644 index 00179b05b3..0000000000 --- a/ext/spice/src/cspice/lnkini.c +++ /dev/null @@ -1,242 +0,0 @@ -/* lnkini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LNKINI ( LNK, initialize ) */ -/* Subroutine */ int lnkini_(integer *size, integer *pool) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Initialize a doubly linked list pool. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Number of nodes in the pool. */ -/* POOL I-O An array that is a linked pool on output. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* $ Detailed_Input */ - -/* SIZE is the number of nodes in the pool. */ - -/* POOL is an integer array that will contain the linked */ -/* pool on output. */ - -/* $ Detailed_Output */ - -/* POOL is an initialized doubly linked list pool. */ -/* The status of the pool is as follows: */ - -/* -- All nodes in the pool are on the free list. */ - -/* -- The free pointer indicates the first node. */ - -/* -- The total node count is set to the input */ -/* value, SIZE. */ - -/* -- The free node count is the input value, SIZE. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If the requested number of nodes is nonpositive, the error */ -/* SPICE(INVALIDCOUNT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* LNKINI must be called once to initialize a doubly linked list */ -/* pool before the pool is used. LNKINI can be called at any time */ -/* to re-initialize a doubly linked list pool. */ - -/* The functions */ - -/* LNKNFN ( LNK, number of free nodes ) and */ -/* LNKSIZ ( LNK, size of pool ) */ - -/* will both return the value PLSIZE if called immediately after a */ -/* call to LNKINI. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool with a maximum of */ -/* 100 nodes. POOL should be declared as follows: */ - -/* INTEGER LBPOOL */ -/* PARAMETER ( LBPOOL = -5 ) */ - -/* INTEGER PLSIZE */ -/* PARAMETER ( PLSIZE = 100 ) */ - -/* INTEGER POOL ( 2, LBPOOL : PLSIZE ) */ - - -/* To initialize POOL, use the call */ - -/* CALL LNKINI ( PLSIZE, POOL ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* initialize linked list pool */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* The requested number of nodes must be valid. */ - - if (*size < 1) { - chkin_("LNKINI", (ftnlen)6); - setmsg_("A linked list cannot have # nodes.", (ftnlen)34); - errint_("#", size, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("LNKINI", (ftnlen)6); - return 0; - } - -/* Initialize the pool. The free list occupies the whole pool at */ -/* this point. */ - - -/* POOL( SIZROW, SIZCOL ) is the pool size. */ - - pool[10] = *size; - -/* POOL( NFRROW, NFRCOL ) is the number of free nodes. */ - - pool[11] = *size; - -/* POOL( FREROW, FRECOL) is the "free" pointer. It points to the */ -/* first free node, which is node 1. */ - - pool[8] = 1; - -/* Initialize the backward and forward pointers. The last forward */ -/* pointer is zero. All of the backward pointers contain the value */ -/* FREE. */ - - i__1 = *size - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - pool[(i__ << 1) + 10] = i__ + 1; - pool[(i__ << 1) + 11] = 0; - } - pool[(*size << 1) + 10] = 0; - pool[(*size << 1) + 11] = 0; - return 0; -} /* lnkini_ */ - diff --git a/ext/spice/src/cspice/lnknfn.c b/ext/spice/src/cspice/lnknfn.c deleted file mode 100644 index 1245c17720..0000000000 --- a/ext/spice/src/cspice/lnknfn.c +++ /dev/null @@ -1,179 +0,0 @@ -/* lnknfn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LNKNFN ( LNK, number of free nodes ) */ -integer lnknfn_(integer *pool) -{ - /* System generated locals */ - integer ret_val; - -/* $ Abstract */ - -/* Return the number of free nodes in a doubly linked list pool. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POOL I A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* The function returns the number of free nodes in the pool. */ - -/* $ Detailed_Input */ - -/* SIZE is the number of nodes in the pool. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* The function returns the number of free nodes in the pool. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows the caller to find the number of free nodes */ -/* available in a doubly linked list pool, without having to make */ -/* use of knowledge of the internal structure of the pool. */ - -/* Routines that allocate nodes can use this routine to determine */ -/* how many nodes can be allocated safely---an attempt to allocate */ -/* a node when no free nodes are available causes a SPICELIB error */ -/* to be signalled. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool containing 5 nodes. */ -/* If POOL contains the list */ - -/* 4 <--> 5 <--> 1 <--> 2 */ - - -/* and the node 3 is unallocated, then the function reference */ - -/* NFREE = LNKNFN ( POOL ) */ - - -/* will assign the value 1 to NFREE. */ - - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return number of nodes in linked list pool */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Grab the number of free nodes from the control area. */ - - ret_val = pool[11]; - return ret_val; -} /* lnknfn_ */ - diff --git a/ext/spice/src/cspice/lnknxt.c b/ext/spice/src/cspice/lnknxt.c deleted file mode 100644 index 506dfbe0cb..0000000000 --- a/ext/spice/src/cspice/lnknxt.c +++ /dev/null @@ -1,255 +0,0 @@ -/* lnknxt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKNXT ( LNK, next node ) */ -integer lnknxt_(integer *node, integer *pool) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Find the node following a specified node in a doubly linked list */ -/* pool. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NODE I Number of an allocated node. */ -/* POOL I A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* The function returns the number of the successor of the node */ -/* indicated by NODE. */ - -/* $ Detailed_Input */ - -/* NODE is the number of an allocated node in POOL. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* The function returns the number of the successor of the node */ -/* indicated by NODE. If NODE is the tail node of a list, the */ -/* function returns the negative of the node number of the head */ -/* of the list. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If NODE is the tail node of a list, the function returns the */ -/* negative of the node number of the head of the list. */ - -/* 2) If NODE is not a valid node number, the error */ -/* SPICE(INVALIDNODE) is signalled. The value 0 is returned. */ - -/* 3) If NODE is not the number of an allocated node, the error */ -/* SPICE(UNALLOCATEDNODE) is signalled. The value 0 is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The raison d'etre of this routine is to allow forward traversal */ -/* of lists in a doubly linked list pool. */ - -/* Traversing a list is often performed in cases where the list is */ -/* used to index elements of a data structure, and the elements */ -/* indexed by the list must be searched. */ - -/* To traverse a list in backward order, use LNKPRV. */ - -/* $ Examples */ - -/* 1) Let POOL be doubly linked list pool, and let */ - -/* 3 <--> 7 <--> 1 */ - -/* be a list in the pool. The table below shows the effects */ -/* of function references to LNKNXT, where nodes in this list */ -/* are used as inputs: */ - -/* Function reference Value Returned */ -/* ------------------ -------------- */ - -/* LNKNXT ( 3, POOL ) 7 */ -/* LNKNXT ( 7, POOL ) 1 */ -/* LNKNXT ( 1, POOL ) -3 */ - - -/* 2) Forward traversal of a list: Let POOL be a doubly linked */ -/* list pool, and let NODE be an allocated node in the pool. */ -/* To traverse the list containing NODE in forward order */ -/* and print out the nodes of the list, we can use the */ -/* following code fragment: */ - -/* C */ -/* C Find the head of the list containing NODE. */ -/* C */ -/* NEXT = LNKHL ( NODE, POOL ) */ - -/* C */ -/* C Traverse the list, printing out node numbers */ -/* C as we go. */ -/* C */ -/* WRITE (*,*) 'The list, in forward order, is: ' */ - -/* DO WHILE ( NEXT .GT. 0 ) */ - -/* WRITE (*,*) NEXT */ -/* NEXT = LNKNXT ( NEXT, POOL ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return next node in linked list */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* If the node is out of range, something's very wrong. */ - - if (*node < 1 || *node > pool[10]) { - ret_val = 0; - chkin_("LNKNXT", (ftnlen)6); - setmsg_("NODE was #; valid range is 1 to #.", (ftnlen)34); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKNXT", (ftnlen)6); - return ret_val; - -/* We don't do free nodes. */ - - } else if (pool[(*node << 1) + 11] == 0) { - ret_val = 0; - chkin_("LNKNXT", (ftnlen)6); - setmsg_("NODE was #; backward pointer = #; forward pointer = #. \"FR" - "EE\" is #)", (ftnlen)67); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[(*node << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*node << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKNXT", (ftnlen)6); - return ret_val; - } - -/* Just return the forward pointer of NODE. */ - - ret_val = pool[(*node << 1) + 10]; - return ret_val; -} /* lnknxt_ */ - diff --git a/ext/spice/src/cspice/lnkprv.c b/ext/spice/src/cspice/lnkprv.c deleted file mode 100644 index 22a3f97f02..0000000000 --- a/ext/spice/src/cspice/lnkprv.c +++ /dev/null @@ -1,255 +0,0 @@ -/* lnkprv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKPRV ( LNK, previous node ) */ -integer lnkprv_(integer *node, integer *pool) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Find the node preceding a specified node in a doubly linked list */ -/* pool. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NODE I Number of an allocated node. */ -/* POOL I A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* The function returns the number of the predecessor of the node */ -/* indicated by NODE. */ - -/* $ Detailed_Input */ - -/* NODE is the number of an allocated node in POOL. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* The function returns the number of the predecessor of the node */ -/* indicated by NODE. If NODE is the head node of a list, the */ -/* function returns the negative of the node number of the tail */ -/* of the list. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If NODE is the head node of a list, the function returns the */ -/* negative of the node number of the tail of the list. */ - -/* 2) If NODE is not a valid node number, the error */ -/* SPICE(INVALIDNODE) is signalled. The value 0 is returned. */ - -/* 3) If NODE is not the number of an allocated node, the error */ -/* SPICE(UNALLOCATEDNODE) is signalled. The value 0 is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The raison d'etre of this routine is to allow backward traversal */ -/* of lists in a doubly linked list pool. */ - -/* Traversing a list is often performed in cases where the list is */ -/* used to index elements of a data structure, and the elements */ -/* indexed by the list must be searched. */ - -/* To traverse a list in forward order, use LNKNXT. */ - -/* $ Examples */ - -/* 1) Let POOL be doubly linked list pool, and let */ - -/* 3 <--> 7 <--> 1 */ - -/* be a list in the pool. The table below shows the effects */ -/* of function references to LNKPRV, where nodes in this list */ -/* are used as inputs: */ - -/* Function reference Value Returned */ -/* ------------------ -------------- */ - -/* LNKPRV ( 1, POOL ) 7 */ -/* LNKPRV ( 7, POOL ) 3 */ -/* LNKPRV ( 3, POOL ) -1 */ - - -/* 2) Backward traversal of a list: Let POOL be a doubly linked */ -/* list pool, and let NODE be an allocated node in the pool. */ -/* To traverse the list containing NODE in backward order */ -/* and print out the nodes of the list, we can use the */ -/* following code fragment: */ - -/* C */ -/* C Find the tail of the list containing NODE. */ -/* C */ -/* PREV = LNKTL ( NODE, POOL ) */ - -/* C */ -/* C Traverse the list, printing out node numbers */ -/* C as we go. */ -/* C */ -/* WRITE (*,*) 'The list, in backward order, is: ' */ - -/* DO WHILE ( PREV .GT. 0 ) */ - -/* WRITE (*,*) PREV */ -/* PREV = LNKPRV ( PREV, POOL ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return previous node in linked list */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* If the node is out of range, something's very wrong. */ - - if (*node < 1 || *node > pool[10]) { - ret_val = 0; - chkin_("LNKPRV", (ftnlen)6); - setmsg_("NODE was #; valid range is 1 to #.", (ftnlen)34); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKPRV", (ftnlen)6); - return ret_val; - -/* We don't do free nodes. */ - - } else if (pool[(*node << 1) + 11] == 0) { - ret_val = 0; - chkin_("LNKPRV", (ftnlen)6); - setmsg_("NODE was #; backward pointer = #; forward pointer = #. \"FR" - "EE\" is #)", (ftnlen)67); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[(*node << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*node << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKPRV", (ftnlen)6); - return ret_val; - } - -/* Just return the backward pointer of NODE. */ - - ret_val = pool[(*node << 1) + 11]; - return ret_val; -} /* lnkprv_ */ - diff --git a/ext/spice/src/cspice/lnksiz.c b/ext/spice/src/cspice/lnksiz.c deleted file mode 100644 index 8965f84c6f..0000000000 --- a/ext/spice/src/cspice/lnksiz.c +++ /dev/null @@ -1,170 +0,0 @@ -/* lnksiz.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LNKSIZ ( LNK, size ) */ -integer lnksiz_(integer *pool) -{ - /* System generated locals */ - integer ret_val; - -/* $ Abstract */ - -/* Return the size of a doubly linked list pool. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POOL I A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* The function returns the size of the pool. */ - -/* $ Detailed_Input */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* The function returns the size (total number of nodes) of the pool. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows an application program to determine the size */ -/* of a doubly linked list pool at run-time, without having to rely */ -/* on knowledge of the internals of the doubly linked list pool */ -/* structure. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool. The total number of */ -/* nodes in a doubly linked list pool is set when the pool is */ -/* initialized by LNKINI. This number is returned by LNKSIZ: */ - -/* C */ -/* C This sequence of calls will assign the value 100 */ -/* C to the variable SIZE: */ -/* C */ -/* CALL LNKINI ( 100, POOL ) */ -/* SIZE = LNKSIZ ( POOL ) */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return size of linked list */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Grab the pool size from the control area. */ - - ret_val = pool[10]; - return ret_val; -} /* lnksiz_ */ - diff --git a/ext/spice/src/cspice/lnktl.c b/ext/spice/src/cspice/lnktl.c deleted file mode 100644 index 227a235513..0000000000 --- a/ext/spice/src/cspice/lnktl.c +++ /dev/null @@ -1,267 +0,0 @@ -/* lnktl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKTL ( LNK, tail of list ) */ -integer lnktl_(integer *node, integer *pool) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer next; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Return the tail node of the list containing a specified node. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NODE I Number of a node. */ -/* POOL I A doubly linked list pool. */ -/* LBPOOL P Lower bound of pool column indices. */ - -/* The function returns the number of the tail node of the list */ -/* containing NODE. */ - -/* $ Detailed_Input */ - -/* NODE is the number of a node in POOL. Normally, */ -/* NODE will designate an allocated node, but NODE */ -/* is permitted to be less than or equal to zero. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* The function returns the number of the tail node of the list */ -/* containing NODE. If NODE is non-positive, the function returns */ -/* zero. */ - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If the NODE is less than or equal to zero, NODE is not */ -/* considered to be erroneous. The value 0 is returned. */ - -/* 2) If NODE is greater than the size of the pool, the error */ -/* SPICE(INVALIDNODE) is signalled. The value 0 is returned. */ - -/* 3) If NODE is not the number of an allocated node, the error */ -/* SPICE(UNALLOCATEDNODE) is signalled. The value 0 is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a convenient way to find the tail of a list */ -/* in a doubly linked list pool. The need to find the tail of a */ -/* list arises in applications such as buffer management. For */ -/* example, in a system using a "least recently used" buffer */ -/* replacement policy, the tail of a list may point to the least */ -/* recently accessed buffer element. */ - -/* $ Examples */ - -/* 1) If POOL is a doubly linked list pool that contains the list */ - -/* 3 <--> 7 <--> 1 <--> 44 */ - -/* any of function references */ - -/* TAIL = LNKTL ( 3, POOL ) */ -/* TAIL = LNKTL ( 7, POOL ) */ -/* TAIL = LNKTL ( 44, POOL ) */ - -/* will assign the value 44 to TAIL. */ - - -/* 2) If POOL is a doubly linked list pool that contains the */ -/* singleton list consisting of the allocated node */ - -/* 44 */ - -/* the function reference */ - -/* TAIL = LNKTL ( 44, POOL ) */ - -/* will assign the value 44 to TAIL. */ - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool, */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-JAN-1997 (NJB) */ - -/* Corrected module name in one pair of CHKIN/CHKOUT calls. */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* return tail of linked list */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-JAN-1997 (NJB) */ - -/* Corrected module name in one pair of CHKIN/CHKOUT calls. The */ -/* affected error case was the check for a node number being out */ -/* of range. */ -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* If the node is non-positive, we regard it as the nil node. */ - - if (*node < 1) { - ret_val = 0; - return ret_val; - -/* If the node is out of range, something's very wrong. */ - - } else if (*node > pool[10]) { - ret_val = 0; - chkin_("LNKTL", (ftnlen)5); - setmsg_("NODE was #; valid range is 1 to #.", (ftnlen)34); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKTL", (ftnlen)5); - return ret_val; - -/* We don't do free nodes. */ - - } else if (pool[(*node << 1) + 11] == 0) { - ret_val = 0; - chkin_("LNKTL", (ftnlen)5); - setmsg_("NODE was #; backward pointer = #; forward pointer = #. \"FR" - "EE\" is #)", (ftnlen)67); - errint_("#", node, (ftnlen)1); - errint_("#", &pool[(*node << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*node << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKTL", (ftnlen)5); - return ret_val; - } - -/* Find the tail of the list. */ - - ret_val = *node; - next = pool[(*node << 1) + 10]; - while(next > 0) { - ret_val = next; - next = pool[(ret_val << 1) + 10]; - } - -/* LNKTL is now the tail of the list. */ - - return ret_val; -} /* lnktl_ */ - diff --git a/ext/spice/src/cspice/lnkxsl.c b/ext/spice/src/cspice/lnkxsl.c deleted file mode 100644 index c683b21ffa..0000000000 --- a/ext/spice/src/cspice/lnkxsl.c +++ /dev/null @@ -1,366 +0,0 @@ -/* lnkxsl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LNKXSL ( LNK, extract sublist from list ) */ -/* Subroutine */ int lnkxsl_(integer *head, integer *tail, integer *pool) -{ - integer node, prev, next; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Extract a specified sublist from a list. */ - -/* $ 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 */ - -/* LNK */ - -/* $ Keywords */ - -/* LIST */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HEAD, */ -/* TAIL I Head and tail nodes of a sublist to be extracted. */ -/* POOL I-O A doubly linked list pool. */ - -/* $ Detailed_Input */ - -/* HEAD, */ -/* TAIL are, respectively, the head and tail nodes of a */ -/* sublist to be extracted. */ - -/* POOL is a doubly linked list pool. */ - -/* $ Detailed_Output */ - -/* POOL is the input pool, with the following */ -/* modifications: */ - -/* -- The sublist bounded by HEAD and */ -/* by TAIL is now a separate list from */ -/* the list that originally contained it. */ - -/* If on input, HEAD was preceded by the node */ -/* PREV, and tail was followed by the node */ -/* NEXT, then on output */ - -/* -- The successor of PREV is NEXT. */ -/* -- The predecessor of NEXT is PREV. */ - - -/* $ Parameters */ - -/* LBPOOL is the lower bound of the column indices of the POOL */ -/* array. The columns indexed LBPOOL to 0 are reserved */ -/* as a control area for the pool. */ - -/* $ Exceptions */ - -/* 1) If either of HEAD or TAIL are not valid node numbers, the */ -/* error SPICE(INVALIDNODE) will be signalled. POOL will not be */ -/* modified. */ - -/* 2) If either of HEAD or TAIL are valid node numbers but are */ -/* not allocated, the error SPICE(UNALLOCATEDNODE) will be */ -/* signalled. POOL will not be modified. */ - -/* 3) If TAIL cannot be reached by forward traversal of the list */ -/* containing HEAD, the error SPICE(INVALIDSUBLIST) is signalled. */ -/* POOL will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Extracting a sublist from a list is necessary when a list is */ -/* to be re-arranged in some way. For example, to move a node */ -/* in a list to the head of the list, the node (which is a */ -/* singleton sublist) is first extracted from the list containing */ -/* it, then inserted before the head of the list. */ - -/* $ Examples */ - -/* 1) Let POOL be a doubly linked list pool, and let */ - -/* 9 <--> 8 <--> 4 <--> 2000 <--> 1 */ - -/* be a list in POOL. To extract the sublist */ - -/* 4 <--> 2000 */ - -/* the call */ - -/* CALL LNKXSL ( 4, 2000, POOL ) */ - -/* can be used. After the call is made, POOL will contain the */ -/* separate lists */ - -/* 9 <--> 8 <--> 1 */ - -/* and */ - -/* 4 <--> 2000 */ - - -/* 2) Let POOL be a doubly linked list pool, and let */ - -/* 9 <--> 8 <--> 4 <--> 2000 <--> 1 */ - -/* be a list in POOL. To move the node 2000 to the */ -/* head of the list, the code fragment */ - -/* CALL LNKXSL ( 2000, 2000, POOL ) */ -/* CALL LNKILB ( 2000, 9, POOL ) */ - -/* can be used. The resulting list will be */ - -/* 2000 <--> 9 <--> 8 <--> 4 <--> 1 */ - - -/* $ Restrictions */ - -/* Linked list pools must be initialized via the routine */ -/* LNKINI. Failure to initialize a linked list pool */ -/* will almost certainly lead to confusing results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract sublist of linked list */ - -/* -& */ - -/* Local parameters */ - - -/* The control area contains 3 elements. They are: */ - -/* The "size" of the pool, that is, the number */ -/* of nodes in the pool. */ - -/* The number of free nodes in the pool. */ - -/* The "free pointer," which is the column index of the first free */ -/* node. */ - -/* Parameters defining the row and column indices of these control */ -/* elements are given below. */ - - -/* Each assigned node consists of a backward pointer and a forward */ -/* pointer. */ - -/* +-------------+ +-------------+ +-------------+ */ -/* | forward--> | | forward--> | | forward--> | */ -/* +-------------+ ... +-------------+ ... +-------------+ */ -/* | <--backward | | <--backward | | <--backward | */ -/* +-------------+ +-------------+ +-------------+ */ - -/* node 1 node I node SIZE */ - - - - -/* Free nodes say that that's what they are. The way they say it */ -/* is by containing the value FREE in their backward pointers. */ -/* Needless to say, FREE is a value that cannot be a valid pointer. */ - - -/* Local variables */ - - -/* HEAD and TAIL must be valid node numbers. These nodes */ -/* must be allocated as well. */ - - if (*head < 1 || *head > pool[10] || *tail < 1 || *tail > pool[10]) { - chkin_("LNKXSL", (ftnlen)6); - setmsg_("HEAD was #. TAIL was #. Valid range is 1 to #.", (ftnlen)47) - ; - errint_("#", head, (ftnlen)1); - errint_("#", tail, (ftnlen)1); - errint_("#", &pool[10], (ftnlen)1); - sigerr_("SPICE(INVALIDNODE)", (ftnlen)18); - chkout_("LNKXSL", (ftnlen)6); - return 0; - } else if (pool[(*head << 1) + 11] == 0 || pool[(*tail << 1) + 11] == 0) { - chkin_("LNKXSL", (ftnlen)6); - setmsg_("Node HEAD: node number = #; backward pointer = #; forward " - "pointer = #. Node TAIL: node number = #; backward pointer = " - "#; forward pointer = #. (\"FREE\" is #)", (ftnlen)157); - errint_("#", head, (ftnlen)1); - errint_("#", &pool[(*head << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*head << 1) + 10], (ftnlen)1); - errint_("#", tail, (ftnlen)1); - errint_("#", &pool[(*tail << 1) + 11], (ftnlen)1); - errint_("#", &pool[(*tail << 1) + 10], (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - sigerr_("SPICE(UNALLOCATEDNODE)", (ftnlen)22); - chkout_("LNKXSL", (ftnlen)6); - return 0; - } - -/* Starting at HEAD, search forward, looking for TAIL (apologies to */ -/* ZZ Top). */ - - node = *head; - while(node != *tail && node > 0) { - node = pool[(node << 1) + 10]; - } - -/* If we didn't find TAIL, that's an error. */ - - if (node != *tail) { - chkin_("LNKXSL", (ftnlen)6); - setmsg_("Node # cannot be found by forward traversal, starting at no" - "de #.", (ftnlen)64); - errint_("#", tail, (ftnlen)1); - errint_("#", head, (ftnlen)1); - sigerr_("SPICE(INVALIDSUBLIST)", (ftnlen)21); - chkout_("LNKXSL", (ftnlen)6); - return 0; - } - -/* We reached TAIL. Extract the sublist between HEAD and TAIL */ -/* inclusive. */ - -/* Find the predecessor of HEAD and the successor of TAIL. */ - - prev = pool[(*head << 1) + 11]; - next = pool[(*tail << 1) + 10]; - -/* If the input list did not start with HEAD, then we must update */ -/* the forward pointer of the tail node, as well as the backward */ -/* pointer of the head node, of the sublist that preceded HEAD. */ - - if (prev > 0) { - -/* Update the forward pointer of PREV with the forward pointer of */ -/* TAIL. */ - -/* If TAIL had a successor, the predecessor of HEAD will now */ -/* point forward to it. If TAIL was the tail of the input list, */ -/* the forward pointer of TAIL was the negative of the head of */ -/* the input list---this is the correct forward pointer for the */ -/* predecessor of HEAD in this case, since the predecessor of */ -/* HEAD will become the tail of the main list after the sublist */ -/* ranging from HEAD to TAIL is removed. */ - - pool[(prev << 1) + 10] = next; - -/* If TAIL is the tail of the input list, we must update the */ -/* backward pointer of the head of the input list to point to */ -/* the negative of the new tail of the list, which now is PREV. */ - - if (next <= 0) { - -/* In this case, we can read off the number of the head */ -/* node from NEXT: it is just -NEXT. */ - - pool[(-next << 1) + 11] = -prev; - } - } - -/* The portion of the input list that preceded HEAD (if such */ -/* portion existed) has now been taken care of. */ - -/* We now must perform the analogous updates to the portion of */ -/* the input list that followed TAIL. */ - -/* If the input list did not end with TAIL, then we must update */ -/* the backward pointer of the head node, as well as the forward */ -/* pointer of the tail node, of the sublist that followed TAIL. */ - - if (next > 0) { - -/* Update the backward pointer of NEXT with the backward pointer */ -/* of HEAD. */ - -/* If HEAD had a predecessor, the successor of TAIL will now */ -/* point backward to it. If HEAD was the head of the input list, */ -/* the backward pointer of HEAD was the negative of the tail of */ -/* the input list---this is the correct backward pointer for the */ -/* successor of TAIL in this case, since the successor of TAIL */ -/* will become the head of the main list after the sublist */ -/* ranging from HEAD to TAIL is removed. */ - - pool[(next << 1) + 11] = prev; - -/* If HEAD is the head of the input list, we must update the */ -/* forward pointer of the tail of the input list to point to */ -/* the negative of the new head of the list, which now is NEXT. */ - - if (prev <= 0) { - -/* In this case, we can read off the number of the tail */ -/* node from PREV: it is just -PREV. */ - - pool[(-prev << 1) + 10] = -next; - } - } - -/* The portion of the input list that followed TAIL (if such */ -/* portion existed) has now been taken care of. */ - - -/* Cauterize the sublist. */ - - pool[(*head << 1) + 11] = -(*tail); - pool[(*tail << 1) + 10] = -(*head); - return 0; -} /* lnkxsl_ */ - diff --git a/ext/spice/src/cspice/locati.c b/ext/spice/src/cspice/locati.c deleted file mode 100644 index 2a834cfbdf..0000000000 --- a/ext/spice/src/cspice/locati.c +++ /dev/null @@ -1,498 +0,0 @@ -/* locati.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LOCATI ( Locate an identifier in a list ) */ -/* Subroutine */ int locati_(integer *id, integer *idsz, integer *list, - integer *pool, integer *at, logical *presnt) -{ - /* System generated locals */ - integer list_dim1, list_offset, i__1; - - /* Local variables */ - integer head; - logical same, more; - integer last, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nfree; - extern /* Subroutine */ int lnkan_(integer *, integer *); - integer psize; - extern /* Subroutine */ int lnkilb_(integer *, integer *, integer *); - extern integer lnknfn_(integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern integer lnksiz_(integer *); - extern /* Subroutine */ int lnkxsl_(integer *, integer *, integer *); - integer new__; - -/* $ Abstract */ - -/* This routine locates the current location of an identifier */ -/* within a list or finds a location within the list to */ -/* store it and then does so. It returns the location of */ -/* the identifier and a flag indicating whether or not the */ -/* identifier was already present. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ID I An array of integers that comprise an identifier */ -/* IDSZ I The number of integer components per identifier */ -/* LIST I/O A list of known identifiers */ -/* POOL I/O A doubly linked list used for search the list */ -/* AT I/O Location of the ID in the list */ -/* PRESNT O If ID was already in the list TRUE otherwise FALSE */ - -/* $ Detailed_Input */ - -/* ID is an integer array that serves as an identifier */ -/* for some object. For example it might be a SPICE */ -/* id code for a planet or satellite; it might be the */ -/* instrument id and mode of operation of an instrument. */ -/* See the examples section for more details. */ - -/* IDSZ is the number of components in the array ID. */ - -/* LIST is an array containing several ID's. The array */ -/* should be declared so as to have the same upper */ -/* bound at least as large as the upper bound used */ -/* in the declaration of POOL. */ - -/* POOL is a linked list pool that gives the search order */ -/* for examining LIST to locate ID's. The declaration */ -/* of POOL and LIST need to be compatible. Normally, */ -/* the declaration should look like this: */ - -/* INTEGER LIST (IDSZ, LSTSIZ ) */ -/* INTEGER POOL ( 2, LBPOOL: LSTSIZ ) */ - -/* If POOL is declared with the statement */ - -/* INTEGER POOL ( 2, LBPOOL: PSIZE ) */ - -/* then you must make sure that PSIZE is less than */ -/* or equal to LSTSIZ. */ - -/* POOL should be initialized before the first */ -/* call to this routine with the SPICE routine */ -/* LNKINI. */ - -/* AT is a value that is set by this routine and that */ -/* you should never reset yourself. It points */ -/* to the head of the linked list used for */ -/* searching LIST. Changing AT will destroy the */ -/* link between POOL and LIST. */ - -/* There is one exception to these restrictions. */ -/* The first call to this routine that occurs after */ -/* initializing POOL, AT may have any value. It will */ -/* be set upon output and from that time on, you should */ -/* not alter its value except by calling this routine */ -/* to do so. */ - -/* $ Detailed_Output */ - -/* AT on output AT points to the location in LIST */ -/* of ID. */ - -/* PRESNT is a logical flag. It indicates whether or not */ -/* ID was already present in the LIST when this */ -/* routine was called. If ID was already in LIST */ -/* PRESNT is returned with the value TRUE. Otherwise */ -/* it is returned with the value FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of AT is less than zero or greater than */ -/* the declared size of POOL (except immediately after */ -/* initializing or re-initializing POOL) the */ -/* error 'SPICE(ADDRESSOUTOFBOUNDS)' will be signalled. */ - -/* 2) If the linked list pool POOL is corrupted by a higher */ -/* level routine, a diagnosis of the problem will be */ -/* made by a routine called by this one. */ - -/* $ Particulars */ - -/* This routine serves as a utility for managing the bookkeeping */ -/* needed when using a local buffering scheme which removes */ -/* the last used item when the local buffer becomes full. */ - -/* It is primarily a programming utility. Unless you are dealing */ -/* with a problem very similar to the one just described, you */ -/* probably shouldn't be using this routine. */ - -/* The example below illustrates the intended use of this */ -/* routine. */ - -/* $ Examples */ - -/* Consider the following programming situation. */ - -/* Suppose that a routine is being written that will */ -/* access large amounts of data stored in the SPICE */ -/* kernel pool. Kernel pool access requires overhead that */ -/* may be prohibitive under some circumstances. Buffering */ -/* data locally and only fetching data from the kernel pool */ -/* when it has not been buffered locally, may substantially */ -/* improve the performance of the routine being written. */ - -/* However, since FORTRAN does not allow dynamic memory allocation */ -/* the local data storage must be set at compile time. As */ -/* a result the local data buffer might become full during */ -/* an execution of your program. If data for an item needs */ -/* to be fetched from the kernel pool once the buffer has become */ -/* full, you must either repeatedly call the kernel pool to fetch */ -/* the new data or overwrite some of the data in your local buffer. */ - -/* This routine helps with the decisions of which items to */ -/* overwrite. In addition it always moves the last requested */ -/* item to the head of the index used for searching the buffered */ -/* ID's. In this way if the same item is needed many times */ -/* in succession, there will be very little overhead associated */ -/* with finding the item. Thus the routine spends its time */ -/* in computing the desired quantities, not in looking up the */ -/* parameters needed for the computation. */ - -/* Below is a fragment of code that illustrates how this routine */ -/* should be used. In the situation outlined above. We'll suppose */ -/* that we are fetching MDLSIZ double precision numbers from the */ -/* kernel pool that are associated with the item */ - -/* 'BODYid_MAGMODEL' */ - -/* And that we are computing something with this model data. */ - - -/* INTEGER MDLSIZ */ -/* PARAMETER ( MDLSIZ = xxxxxx ) */ - -/* We'll create room to buffer this data for 8 bodies. */ - - -/* INTEGER PSIZE */ -/* PARAMETER ( PSIZE = 8 ) */ - - -/* The ID's we shall be using are 1-dimensional. They are body */ -/* ID's for planets or and their satellites. */ - -/* INTEGER IDSZ */ -/* PARAMETER ( IDSZ = 1 ) */ - -/* INTEGER AT */ -/* INTEGER DIM */ -/* INTEGER LIST ( IDSZ, PSIZE ) */ -/* INTEGER POOL ( 2, LBPOOL:PSIZE ) */ - -/* DOUBLE PRECISION MAGMDL ( MDLSIZ, PSIZE ) */ -/* DOUBLE PRECISION MODEL ( MDLSIZ ) */ - -/* LOGICAL FIRST */ -/* LOGICAL PRESNT */ - -/* SAVE */ - -/* DATA FIRST / .TRUE. / */ - - -/* The block below handles initializing the linked list pool. */ - -/* IF ( FIRST ) THEN */ - -/* FIRST = .FALSE. */ - -/* CALL LNKINI ( PSIZE, POOL ) */ - -/* END IF */ - -/* See if the data associated with ID has already been */ -/* buffered. */ - -/* CALL LOCATI ( ID, IDSZ, LIST, POOL, AT, PRESNT ) */ - -/* IF ( .NOT. PRESNT ) THEN */ - -/* The data has not yet been buffered, look it up. Normally */ -/* you might want to check to see if the data exists and */ -/* handle things appropriately if it doesn't but this is just */ -/* to give you the idea... */ - -/* CALL BODVCD ( ID, 'MAGMODEL', 3, DIM, MAGMDL ( 1, AT ) ) */ - -/* END IF */ - -/* Put the model data into the array MODEL for ease of */ -/* reading the rest of the code. */ - -/* CALL MOVED ( MAGMDL(1,AT), MDLSIZ, MODEL ) */ - - -/* Now do whatever processing is needed .... */ - -/* There are a few things to note about the code fragment above. */ -/* First the handling of the buffering of data was very easy. */ -/* Second, if this routine is called again using the same ID, */ -/* the buffer will already contain the needed model. Moreover */ -/* the routine LOCATI will return very quickly because the */ -/* ID will already be at the head of the list indexed by POOL. */ - -/* You can also easily add an entry point to this routine that */ -/* will force it to look up data from the kernel pool on the */ -/* next call. All that needs to be done is re-initialize the */ -/* linked list pool. */ - -/* ENTRY DOLOOK */ - -/* CALL LNKINI ( PSIZE, POOL ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 24-OCT-2005 (NJB) */ - -/* Header update: changed reference to BODVAR to reference */ -/* to BODVCD. */ - -/* - SPICELIB Version 1.0.0, 9-APR-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Locate an item in a linked list indexed list of items */ -/* Remove least recently used item buffering */ - -/* -& */ - -/* Spicelib functions */ - - -/* Linked list parameters */ - - -/* Local Variables. */ - - /* Parameter adjustments */ - list_dim1 = *idsz; - list_offset = list_dim1 + 1; - - /* Function Body */ - chkin_("LOCATI", (ftnlen)6); - -/* We begin by looking through the list of items at our disposal. */ -/* One way or the other we will need the number of free nodes */ -/* in the linked list. */ - - nfree = lnknfn_(pool); - psize = lnksiz_(pool); - if (nfree == psize) { - -/* There's nothing in the list so far. Allocate a */ -/* node and begin a list. */ - - lnkan_(pool, at); - i__1 = *idsz; - for (i__ = 1; i__ <= i__1; ++i__) { - list[i__ + *at * list_dim1 - list_offset] = id[i__ - 1]; - } - *presnt = FALSE_; - chkout_("LOCATI", (ftnlen)6); - return 0; - } - if (*at <= 0 || *at > psize) { - setmsg_("The input value for the head of the ID address linked list " - "is out of bounds. It should be between 0 and #. The value su" - "pplied was #.", (ftnlen)132); - errint_("#", &psize, (ftnlen)1); - errint_("#", at, (ftnlen)1); - sigerr_("SPICE(ADDRESSOUTOFBOUNDS)", (ftnlen)25); - chkout_("LOCATI", (ftnlen)6); - return 0; - } - -/* If we are still here then there is actually something in */ -/* the list. We begin at start and traverse the list. */ -/* Since we are unlikely to ever have large ID's (their purpose */ -/* after all is to be a label for something more complex) we */ -/* will handle the cases where IDSZ is 1 or 2 as special */ -/* cases since the tests for equality are a lot easier. */ - - same = FALSE_; - head = *at; - if (*idsz == 1) { - same = id[0] == list[*at * list_dim1 + 1 - list_offset]; - more = *at > 0 && ! same; - while(more) { - *at = pool[(*at << 1) + 10]; - if (*at > 0) { - same = id[0] == list[*at * list_dim1 + 1 - list_offset]; - more = ! same; - } else { - more = FALSE_; - } - } - } else if (*idsz == 2) { - same = id[0] == list[*at * list_dim1 + 1 - list_offset] && id[1] == - list[*at * list_dim1 + 2 - list_offset]; - more = *at > 0 && ! same; - while(more) { - *at = pool[(*at << 1) + 10]; - if (*at > 0) { - if (id[0] == list[*at * list_dim1 + 1 - list_offset]) { - same = id[1] == list[*at * list_dim1 + 2 - list_offset]; - more = ! same; - } - } else { - more = FALSE_; - } - } - } else { - i__ = 1; - same = TRUE_; - while(same && i__ < *idsz) { - same = same && id[i__ - 1] == list[i__ + *at * list_dim1 - - list_offset]; - ++i__; - } - more = *at > 0 && ! same; - while(more) { - *at = pool[(*at << 1) + 10]; - if (*at > 0) { - i__ = 1; - same = TRUE_; - while(same && i__ < *idsz) { - same = same && id[i__ - 1] == list[i__ + *at * list_dim1 - - list_offset]; - ++i__; - } - more = ! same; - } else { - more = FALSE_; - } - } - } - -/* The hunting is over either we found it or we need to */ -/* allocate space to put this ID into storage. */ - - if (same) { - *presnt = TRUE_; - last = pool[(*at << 1) + 11]; - -/* If AT is not already at the head of the list, we */ -/* move this node to the front of the list. */ - - if (last > 0) { - lnkxsl_(at, at, pool); - lnkilb_(at, &head, pool); - } - chkout_("LOCATI", (ftnlen)6); - return 0; - } - -/* If we got to this point, we traversed the entire linked */ -/* list and did not find a matching ID. AT is negative */ -/* and -AT points to the head of the list. */ - - *presnt = FALSE_; - -/* We'll put it in the list. First see if there are any free nodes. */ - - if (nfree > 0) { - -/* Allocate a free node and put our ID at the NEW address. */ - - lnkan_(pool, &new__); - i__1 = *idsz; - for (i__ = 1; i__ <= i__1; ++i__) { - list[i__ + new__ * list_dim1 - list_offset] = id[i__ - 1]; - } - -/* Put the new node at the head of the linked list. */ - - lnkilb_(&new__, &head, pool); - *at = new__; - } else { - -/* The last item in the list is pointed to as being the */ -/* previous item to the head of the list. But we have to */ -/* change the sign to get a legitimate address. Overwrite */ -/* the ID information in this last slot of the list. */ - - last = -pool[(head << 1) + 11]; - i__1 = *idsz; - for (i__ = 1; i__ <= i__1; ++i__) { - list[i__ + last * list_dim1 - list_offset] = id[i__ - 1]; - } - -/* Extract the last item as a sublist and insert it before */ -/* the current head of the list. */ - - lnkxsl_(&last, &last, pool); - lnkilb_(&last, &head, pool); - *at = last; - } - chkout_("LOCATI", (ftnlen)6); - return 0; -} /* locati_ */ - diff --git a/ext/spice/src/cspice/locln.c b/ext/spice/src/cspice/locln.c deleted file mode 100644 index a233b3db1d..0000000000 --- a/ext/spice/src/cspice/locln.c +++ /dev/null @@ -1,606 +0,0 @@ -/* locln.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure LOCLN ( Locate lines in a text file ) */ -/* Subroutine */ int locln_(integer *unit, char *bmark, char *emark, char * - line, integer *bline, integer *eline, logical *found, ftnlen - bmark_len, ftnlen emark_len, ftnlen line_len) -{ - /* System generated locals */ - integer i__1; - cilist ci__1; - - /* Builtin functions */ - integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), - s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer ltrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - logical bfound, efound; - integer bltemp, eltemp; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - logical eof; - -/* $ Abstract */ - -/* Locate a group of lines in a text file delimited by markers. */ - -/* $ 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 */ - -/* FILES */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit connected to text file. */ -/* BMARK I Begin marker. */ -/* EMARK I End marker. */ -/* LINE I,O Workspace. */ -/* BLINE O Beginning line. */ -/* ELINE O Ending line. */ -/* FOUND O Markers found? */ - -/* $ Detailed_Input */ - -/* UNIT is a logical unit that has been connected to a */ -/* text file by the calling program. Use the routine */ -/* TXTOPR to open the file for read access and get its */ -/* logical unit. The file pointer may be pointing to */ -/* any line in the file due to previous read statements, */ -/* for example, or due to previous calls to LOCLN. */ - -/* BMARK, */ -/* EMARK are markers that delimit some group of lines in */ -/* the part of the file following the current position */ -/* of the file pointer. The group begins with the */ -/* first line equivalent to BMARK and ends with the */ -/* next line equivalent to EMARK, ignoring leading */ -/* and trailing blanks. */ - -/* If BMARK is blank, the group of lines begins with */ -/* the first line following the current position of the */ -/* file pointer; if EMARK is blank, the group of lines */ -/* ends with the last line in the file. */ - -/* LINE on input, is an arbitrary character string whose */ -/* contents are ignored. LINE is used to read lines */ -/* from the file connected to UNIT; its function */ -/* is to determine the maximum length of the lines */ -/* that can be read from the file. Lines longer */ -/* than the declared length of LINE are truncated */ -/* as they are read. */ - -/* $ Detailed_Output */ - -/* LINE on output, is undefined. */ - -/* BLINE, */ -/* ELINE are the line numbers of the first and last lines */ -/* in the group delimited by BMARK and EMARK. */ - -/* By convention, the first line read by the routine */ -/* is line 1; the second line is line 2; and so on. */ -/* If BMARK is blank, BLINE will be 1. */ - -/* FOUND is true if a group of lines delimited by BMARK and */ -/* EMARK is found, and is false otherwise. ELINE is */ -/* the last line read by LOCLN, so if FOUND is true, */ -/* the file pointer will be positioned on the line */ -/* after ELINE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If FOUND is false, the values of BLINE and ELINE are not */ -/* changed. */ - -/* 2) If an error occurs while reading from the input file, */ -/* the error SPICE(FILEREADFAILED) is signalled. */ - -/* 3) Lines in the file that are longer than the declared length of */ -/* LINE are truncated as they are read. If the truncation of */ -/* line containing a marker causes truncation of that marker, */ -/* it will not match the input value for that marker, so */ -/* FOUND will be .FALSE. */ - -/* $ Files */ - -/* See argument UNIT. */ - -/* $ Particulars */ - -/* This routine locates delimited groups of lines in a text file. */ -/* This allows files to be partitioned into sub-files; it also */ -/* allows related inputs to be grouped together in a relatively */ -/* free-format way. */ - -/* $ Examples */ - -/* 1) Let FILE.TXT be a text file that contains the following lines. */ -/* (The lines are numbered for reference, but these numbers do */ -/* not appear in the file). */ - -/* 1 BEGIN POEM */ -/* 2 Oh snail, */ -/* 3 Climb Mount Fuji, */ -/* 4 But slowly, slowly! */ -/* 5 END POEM */ -/* 6 */ -/* 7 BEGIN PROSE */ -/* 8 Lady, one of us has this book open */ -/* 9 to the wrong page. */ -/* 10 END PROSE */ -/* 11 */ -/* 12 BEGIN POEM */ -/* 13 John Keats, John Keats, */ -/* 14 John, */ -/* 15 Put your scarf on. */ -/* 16 END POEM */ -/* 17 */ -/* 18 BEGIN QUOTE */ -/* 19 That's not writing. That's typing. */ -/* 20 */ -/* 21 (Truman Capote on Jack Kerouac) */ -/* 22 END QUOTE */ -/* 23 */ -/* 24 BEGIN POEM */ -/* 25 Twice five syllables */ -/* 26 Plus seven isn't much, but */ -/* 27 That's haiku for you. */ -/* 28 BEGIN POEM */ -/* 29 */ -/* 30 BEGIN EQUATION */ -/* 31 2 */ -/* 32 e = mc */ -/* 33 END EQUATION */ - -/* Then the code fragment */ - -/* CALL TXTOPR ( 'FILE.TXT', UNIT ) */ - -/* BMARK = 'BEGIN POEM' */ -/* EMARK = 'END POEM' */ - -/* CALL LOCLN ( UNIT, BMARK, EMARK, LINE, B, E, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* WRITE (*,*) 'Found poem between lines ', B, ' and ', E */ - -/* CALL LOCLN ( UNIT, BMARK, EMARK, LINE, B, E, FOUND ) */ -/* END DO */ - -/* produces the following report: */ - -/* Found poem between lines 1 and 5 */ -/* Found poem between lines 7 and 11 */ -/* Found poem between lines 8 and 12 */ - -/* Note that line numbers are returned relative to the position */ -/* of the file pointer when LOCLN is called. The following code */ -/* fragment generates the numbers relative to the start of the */ -/* file. */ - -/* REWIND ( UNIT ) */ - -/* OFFSET = 0 */ -/* CALL LOCLN ( UNIT, BMARK, EMARK, LINE, B, E, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* WRITE (*,*) 'Found poem between lines ', */ -/* . OFFSET + B, */ -/* . ' and ', */ -/* . OFFSET + E */ - -/* OFFSET = OFFSET + E */ -/* CALL LOCLN ( UNIT, BMARK, EMARK, LINE, B, E, FOUND ) */ -/* END DO */ - -/* CLOSE ( UNIT ) */ - -/* The following report is produced: */ - -/* Found poem between lines 1 and 5 */ -/* Found poem between lines 12 and 16 */ -/* Found poem between lines 24 and 28 */ - - -/* 2) Given the same file, the code fragment */ - -/* CALL TXTOPR ( 'FILE.TXT', UNIT ) */ - -/* CALL LOCLN ( UNIT, */ -/* . 'begin poem', */ -/* . 'end poem', */ -/* . LINE, */ -/* . B, */ -/* . E, */ -/* . FOUND ) */ - -/* CLOSE ( UNIT ) */ - -/* finds nothing because case is significant: FOUND is false, */ -/* and B and E are unchanged. */ - -/* 3) This code fragment */ - -/* CALL TXTOPR ( 'FILE.TXT', UNIT ) */ - -/* CALL LOCLN ( UNIT, */ -/* . ' ', */ -/* . 'BEGIN PROSE', */ -/* . LINE, */ -/* . B, */ -/* . E, */ -/* . FOUND ) */ - -/* CLOSE ( UNIT ) */ - -/* when executed on the same file returns B = 1 and E = 7. */ -/* In effect, a blank begin marker "matches" the first line */ -/* that is read. */ - -/* Similarly, a blank end marker "matches" the last line of */ -/* the file, the code fragment */ - -/* CALL TXTOPR ( 'FILE.TXT', UNIT ) */ - -/* CALL LOCLN ( UNIT, */ -/* . 'BEGIN QUOTE', */ -/* . ' ', */ -/* . LINE, */ -/* . B, */ -/* . E, */ -/* . FOUND ) */ - -/* CLOSE ( UNIT ) */ - -/* when executed on the same file returns B = 18 and E = 33. */ -/* If both markers are blank, LOCLN basically counts the lines */ -/* in the file. */ - -/* 4) The code fragment */ - -/* CALL TXTOPR ( 'FILE.TXT', UNIT ) */ - -/* MARK = 'BEGIN POEM' */ - -/* CALL LOCLN ( UNIT, MARK, MARK, LINE, FIRST, SECOND, FOUND ) */ - -/* CLOSE ( UNIT ) */ - -/* returns FIRST = 1 and SECOND = 12 -- the first two lines that */ -/* are equivalent to MARK. */ - -/* 5) Nesting is not supported. That is, if UNIT is connected to */ -/* a file containing the following lines (ignoring line numbers), */ - -/* 1 Begin Object */ -/* 2 Begin Object */ -/* 3 Begin Object */ -/* 4 Just kidding! */ -/* 5 End Object */ -/* 6 End Object */ -/* 7 End Object */ - -/* REWIND ( UNIT ) */ - -/* CALL LOCLN ( UNIT, */ -/* . 'Begin Object' */ -/* . 'End Object', */ -/* . LINE, */ -/* . B, */ -/* . E, */ -/* . FOUND ) */ - -/* returns B = 1 and E = 5, not E = 7. */ - -/* 6) Let UNIT be connected to a text file containing the */ -/* following lines, again ignoring line numbers which are */ -/* listed for easy reference. */ - -/* 1 The first case tests the capability of ... */ -/* 2 */ -/* 3 NEW CASE */ -/* 4 TARGET = JUPITER */ -/* 5 EPOCH = 21 JUN 1992 13:04 */ -/* 6 END CASE */ -/* 7 */ -/* 8 The next case uses a different target and a slightly */ -/* 9 longer exposure time... */ -/* 10 */ -/* 11 NEW CASE */ -/* 12 TARGET = IO */ -/* 13 EPOCH = 21 JUN 1992 13:04 */ -/* 14 EXPOSURE = 2.44 SECONDS */ -/* 15 END CASE */ -/* 16 */ -/* 17 The next case changes targets in order to... */ -/* 18 */ -/* 19 NEW CASE */ -/* 20 TARGET = EUROPA */ -/* 21 EPOCH = 21 JUN 1992 13:04 */ -/* 22 EXPOSURE = 2.44 SECONDS */ -/* 23 END CASE */ - -/* Then the code fragment */ - -/* REWIND ( UNIT ) */ - -/* BMARK = 'NEW CASE' */ -/* EMARK = 'END CASE' */ - -/* CASES = 0 */ -/* OFFSET = 0 */ -/* CALL LOCLN ( UNIT, BMARK, EMARK, LINE, B, E, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CASES = CASES + 1 */ -/* BEG(CASES) = OFFSET + B */ -/* END(CASES) = OFFSET + E */ - -/* OFFSET = OFFSET + E */ -/* CALL LOCLN ( UNIT, BMARK, EMARK, LINE, B, E, FOUND ) */ -/* END DO */ - -/* saves the locations of the various input cases (skipping past */ -/* the intervening commentary) in the arrays BEG and END. After */ -/* running the code, CASES, BEG, and END have the following values: */ - -/* CASES = 3 */ -/* BEG = 3, 11, 19 */ -/* END = 6, 15, 23 */ - -/* The following code fragment retrieves the i'th case. */ - -/* REWIND ( UNIT ) */ - -/* DO J = 1, BEG(I) - 1 */ -/* READ (UNIT,FMT='(A)') LINE */ -/* END DO */ - -/* DO J = BEG(I), END(I) */ -/* READ (UNIT,FMT='(A)') LINE */ -/* . */ -/* . Process the line */ -/* . */ -/* END DO */ - -/* While this isn't an incredibly efficient way to process */ -/* large files, it can be effective for smaller files. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* locate lines in a text file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LOCLN", (ftnlen)5); - } - -/* We'll use temporary variables BLTEMP and ELTEMP for BLINE and */ -/* ELINE until we know that both markers have been found. We'll */ -/* use BFOUND to indicate whether or not BMARK was found, and */ -/* EFOUND to indicate whether or not EMARK was found. EOF */ -/* indicates end of file. */ - - bltemp = 0; - bfound = FALSE_; - efound = FALSE_; - eof = FALSE_; - -/* Read through the file, line by line, searching for the first */ -/* occurrence of BMARK and counting lines as we go. Once we */ -/* find BMARK, we'll start searching for EMARK. After each read */ -/* we'll check for I/O errors. */ - - while(! bfound && ! eof) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, line_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - -/* An end-of-file condition is indicated by a negative value */ -/* for IOSTAT. Any other non-zero value indicates some other */ -/* error. */ - - if (iostat > 0) { - setmsg_("While searching for BMARK = #, an attempt to read the f" - "ile named FILENAME failed. The value of IOSTAT is #.", ( - ftnlen)108); - errch_("#", bmark, (ftnlen)1, bmark_len); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FILENAME", unit, (ftnlen)8); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("LOCLN", (ftnlen)5); - return 0; - } else if (iostat < 0) { - eof = TRUE_; - } else { - -/* The read was successful, so count the line then */ -/* check for a match. */ - - ++bltemp; - ljust_(line, line, line_len, line_len); - -/* By convention, if BMARK is blank, it matches the */ -/* first line that we read. If it is not blank, we */ -/* compare it to the line just read, ignoring leading */ -/* and trailing blanks. */ - - if (s_cmp(bmark, " ", bmark_len, (ftnlen)1) == 0) { - bfound = TRUE_; - } else { - i__1 = ltrim_(bmark, bmark_len) - 1; - if (s_cmp(bmark + i__1, line, bmark_len - i__1, line_len) == - 0) { - bfound = TRUE_; - } - } - } - } - -/* Start the search for EMARK starting from where we left off. */ - - eltemp = bltemp; - while(! efound && ! eof) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, line, line_len); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - -/* An end-of-file condition is indicated by a negative value */ -/* for IOSTAT. Any other non-zero value indicates some other */ -/* error. */ - - if (iostat > 0) { - setmsg_("While searching for EMARK = #, an attempt to read the f" - "ile named FILENAME failed. The value of IOSTAT is #.", ( - ftnlen)108); - errch_("#", emark, (ftnlen)1, emark_len); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FILENAME", unit, (ftnlen)8); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("LOCLN", (ftnlen)5); - return 0; - } else if (iostat < 0) { - eof = TRUE_; - -/* By convention, if EMARK is blank, it matches the */ -/* last line in the file. */ - - if (s_cmp(emark, " ", emark_len, (ftnlen)1) == 0) { - efound = TRUE_; - } - } else { - -/* The read was successful, so count the line and check for */ -/* a match. */ - - ++eltemp; - ljust_(line, line, line_len, line_len); - if (s_cmp(emark, " ", emark_len, (ftnlen)1) != 0) { - i__1 = ltrim_(emark, emark_len) - 1; - if (s_cmp(emark + i__1, line, emark_len - i__1, line_len) == - 0) { - efound = TRUE_; - } - } - } - } - -/* Assign the line numbers to BLINE and ELINE only if both markers */ -/* were found. */ - - *found = bfound && efound; - if (*found) { - *bline = bltemp; - *eline = eltemp; - } - chkout_("LOCLN", (ftnlen)5); - return 0; -} /* locln_ */ - diff --git a/ext/spice/src/cspice/lparse.c b/ext/spice/src/cspice/lparse.c deleted file mode 100644 index 14490eb461..0000000000 --- a/ext/spice/src/cspice/lparse.c +++ /dev/null @@ -1,332 +0,0 @@ -/* lparse.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LPARSE ( Parse items from a list ) */ -/* Subroutine */ int lparse_(char *list, char *delim, integer *nmax, integer * - n, char *items, ftnlen list_len, ftnlen delim_len, ftnlen items_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - char bchr[1], echr[1]; - integer b, e, eol; - -/* $ Abstract */ - -/* Parse a list of items delimited by a single 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 */ - -/* None. */ - -/* $ Keywords */ - -/* CHARACTER */ -/* LIST */ -/* PARSING */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LIST I List of items delimited by DELIM. */ -/* DELIM I Single character used to delimit items. */ -/* NMAX I Maximum number of items to return. */ -/* N O Number of items in the list. */ -/* ITEMS O Items in the list, left justified. */ - -/* $ Detailed_Input */ - -/* LIST is a list of items delimited by the single character */ -/* DELIM. Consecutive delimiters, and delimiters at the */ -/* beginning and end of the list, are considered to */ -/* delimit blank items. A blank list is considered to */ -/* contain a single (blank) item. */ - -/* DELIM is the character delimiting the items in the list. */ -/* This may be any ASCII character, including a blank. */ -/* However, by definition, consecutive blanks are NOT */ -/* considered to be consecutive delimiters. In addition, */ -/* leading and trailing blanks are ignored. */ - -/* NMAX is the maximum number of items to be returned from */ -/* the list. This allows the user to guard against */ -/* overflow from a list containing more items than */ -/* expected. */ - -/* $ Detailed_Output */ - -/* N is the number of items in the list. N may be */ -/* any number between one and NMAX. N is always the */ -/* number of delimiters plus one. */ - -/* ITEMS are the items in the list, left justified. Any item */ -/* in the list to long to fit into an element of ITEMS */ -/* is truncated on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the string length of ITEMS is too short to accommodate */ -/* an item, the item will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following examples illustrate the operation of LPARSE. */ - -/* 1) Let */ -/* LIST = ' A number of words separated by spaces ' */ -/* DELIM = ' ' */ -/* NMAX = 20 */ - -/* Then */ -/* ITEMS(1) = 'A' */ -/* ITEMS(2) = 'number' */ -/* ITEMS(3) = 'of' */ -/* ITEMS(4) = 'words' */ -/* ITEMS(5) = 'separated' */ -/* ITEMS(6) = 'by' */ -/* ITEMS(7) = 'spaces' */ - -/* 2) Let */ -/* LIST = '//option1//option2/ //' */ -/* DELIM = '/' */ -/* NMAX = 20 */ - -/* Then */ -/* ITEMS(1) = ' ' */ -/* ITEMS(2) = ' ' */ -/* ITEMS(3) = 'option1' */ -/* ITEMS(4) = ' ' */ -/* ITEMS(5) = 'option2' */ -/* ITEMS(6) = ' ' */ -/* ITEMS(7) = ' ' */ -/* ITEMS(8) = ' ' */ - -/* 3) Let */ -/* LIST = ' ,bob, carol,, ted, alice' */ -/* DELIM = ',' */ -/* NMAX = 4 */ - -/* Then */ -/* ITEMS(1) = ' ' */ -/* ITEMS(2) = 'bob' */ -/* ITEMS(3) = 'carol' */ -/* ITEMS(4) = ' ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ - -/* Bug fix: code was modified to avoid out-of-range */ -/* substring bound conditions. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse items from a list */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ - -/* Bug fix: code was modified to avoid out-of-range */ -/* substring bound conditions. The previous version */ -/* of this routine used DO WHILE statements of the form */ - -/* DO WHILE ( ( B .LE. EOL ) */ -/* . .AND. ( LIST(B:B) .EQ. BLANK ) ) */ - -/* Such statements can cause index range violations when the */ -/* index B is greater than the length of the string LIST. */ -/* Whether or not such violations occur is platform-dependent. */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ - -/* Declaration of unused variable REM removed. */ -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Because speed is essential in many list parsing applications, */ -/* LPARSE parses the input list in a single pass. */ - - -/* Nothing yet. */ - - *n = 0; - -/* Blank list contains a blank item. */ - - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - *n = 1; - s_copy(items, " ", items_len, (ftnlen)1); - } else { - -/* Eliminate trailing blanks. EOL is the last non-blank */ -/* character in the list. */ - - eol = i_len(list, list_len); - while(*(unsigned char *)&list[eol - 1] == ' ') { - --eol; - } - -/* As the king said to Alice: 'Begin at the beginning. */ -/* Continue until you reach the end. Then stop.' */ - -/* When searching for items, B is the beginning of the current */ -/* item; E is the end. E points to the next non-blank delimiter, */ -/* if any; otherwise E points to either the last character */ -/* preceding the next item, or to the last character of the list. */ - - b = 1; - while(b <= eol) { - -/* Skip any blanks before the next item or delimiter. */ - -/* At this point in the loop, we know */ - -/* B <= EOL */ - - *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; - while(b <= eol && *(unsigned char *)bchr == 32) { - ++b; - if (b <= eol) { - *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; - } - } - -/* At this point B is the index of the next non-blank */ -/* character BCHR, or else */ - -/* B == EOL + 1 */ - -/* The item ends at the next delimiter. */ - - e = b; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; - } else { - *(unsigned char *)echr = ' '; - } - while(e <= eol && *(unsigned char *)echr != *(unsigned char *) - delim) { - ++e; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; - } - } - -/* The item now lies between B and E. Unless, of course, B and */ -/* E are the same character; this can happen if the list */ -/* starts or ends with a non-blank delimiter, or if we have */ -/* stumbled upon consecutive delimiters. */ - - ++(*n); - if (e > b) { - s_copy(items + (*n - 1) * items_len, list + (b - 1), - items_len, e - 1 - (b - 1)); - } else { - s_copy(items + (*n - 1) * items_len, " ", items_len, (ftnlen) - 1); - } - -/* If there are more items to be found, continue with */ -/* character following E (which is a delimiter). */ - - if (*n < *nmax) { - b = e + 1; - } else { - return 0; - } - } - -/* If the list ended with a (non-blank) delimiter, add a blank */ -/* item to the end. */ - - if (*(unsigned char *)&list[eol - 1] == *(unsigned char *)delim && *n - < *nmax) { - ++(*n); - s_copy(items + (*n - 1) * items_len, " ", items_len, (ftnlen)1); - } - } - return 0; -} /* lparse_ */ - diff --git a/ext/spice/src/cspice/lparse_c.c b/ext/spice/src/cspice/lparse_c.c deleted file mode 100644 index 62052d24e7..0000000000 --- a/ext/spice/src/cspice/lparse_c.c +++ /dev/null @@ -1,300 +0,0 @@ -/* - --Procedure lparse_c ( Parse items from a list ) - --Abstract - - Parse a list of items delimited by a single 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 - - None. - --Keywords - - CHARACTER, LIST, PARSING, STRING - -*/ - #include - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void lparse_c ( ConstSpiceChar * list, - ConstSpiceChar * delim, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - list I List of items delimited by delim. - delim I Single character used to delimit items. - nmax I Maximum number of items to return. - lenout I Length of strings in item array. - n O Number of items in the list. - items O Items in the list, left justified. - --Detailed_Input - - list is a string containing a list of items delimited by the - single character delim. Consecutive delimiters, and - delimiters at the beginning and end of the list, are - considered to delimit empty items. A blank or empty - list is considered to contain a single (empty) item. - - delim is the character delimiting the items in the list. - This may be any ASCII character, including a blank. - However, by definition, consecutive blanks are NOT - considered to be consecutive delimiters. In addition, - leading and trailing blanks are ignored. - - nmax is the maximum number of items to be returned from - the list. This allows the user to guard against - overflow from a list containing more items than - expected. - - lenout is the declared length of the strings in the string - array items. This length must include room for the - terminating null character in each string. - --Detailed_Output - - n is the number of items in the list. n may be - any number between one and nmax. n is always the - number of delimiters plus one. - - items is an array of strings containing the items in the list, - left justified. Any item in the list to long to fit into - an element of items is truncated on the right. Empty - (null) or blank items in the input string are mapped to - empty strings on output. - - items should be declared by the caller as: - - SpiceCharitem [nmax][lenout] - --Parameters - - None. - --Exceptions - - 1) If nmax is less than one, then n will be set to zero, and no - items will be returned. This case is not an error. The other - exceptional cases can occur only if nmax > 0. - - 2) The error SPICE(NULLPOINTER) is signaled if either the input or - output string pointer is null. - - 3) If the output string length lenout is less than one, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 4) An empty input string will result in a single, empty output - token. This case is not an error. - --Particulars - - None. - --Examples - - The following examples illustrate the operation of lparse_c. - - 1) Let - LIST = " A number of words separated by spaces " - DELIM = " " - nmax = 20 - - Then - ITEMS[0] = "A" - ITEMS[1] = "number" - ITEMS[2] = "of" - ITEMS[3] = "words" - ITEMS[4] = "separated" - ITEMS[5] = "by" - ITEMS[6] = "spaces" - - 2) Let - LIST = "//option1//option2/ //" - DELIM = "/" - nmax = 20 - - Then - ITEMS[0] = "" - ITEMS[1] = "" - ITEMS[2] = "option1" - ITEMS[3] = "" - ITEMS[4] = "option2" - ITEMS[5] = "" - ITEMS[6] = "" - ITEMS[7] = "" - - 3) Let - LIST = " ,bob, carol,, ted, alice" - DELIM = "," - nmax = 4 - - Then - ITEMS[0] = "" - ITEMS[1] = "bob" - ITEMS[2] = "carol" - ITEMS[3] = "" - --Restrictions - - None. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 2.2.0, 18-MAY-2001 (WLT) - - Added a cast to (char *) in the call to F2C_ConvertTrStrArr - - -CSPICE Version 2.1.0, 20-APR-2000 (NJB) - - Bug fix: set n to zero for nmax < 1. - - -CSPICE Version 2.0.0, 25-MAR-2000 (NJB) - - Updated header to accurately describe treatment of null tokens. - Updated code to handle the case of an empty input string or - nmax < 1. - - Changed typedef SpiceVoid to void. - - -CSPICE Version 1.0.0, 09-FEB-1998 (NJB) - --Index_Entries - - parse items from a list - --& -*/ - -{ /* Begin lparse_c */ - - - /* - Participate in error handling. - */ - chkin_c ( "lparse_c" ); - - - /* - If there's no room for output tokens, just return. - */ - if ( nmax < 1 ) - { - *n = 0; - chkout_c ( "lparse_c" ); - return; - } - - - /* - Make sure the output string array contains at least enough room - for a null character in each string. Unlike most CSPICE wrappers, - lparse_c must check the output array before checking the inputs - because there's a special case that results in returning before - the input checks are performed. - */ - CHKOSTR ( CHK_STANDARD, "lparse_c", items, lenout ); - - - /* - Special case: if the input string is empty, return a single blank - string. - - We must know that list is not a null pointer first. - */ - CHKPTR ( CHK_STANDARD, "lparse_c", list ); - - if ( list[0] == NULLCHAR ) - { - *n = 1; - *(SpiceChar *)items = NULLCHAR; - - chkout_c ( "lparse_c" ); - return; - } - - - /* - Check the input delimiter string to make sure the pointers are - non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "lparse_c", list ); - CHKFSTR ( CHK_STANDARD, "lparse_c", delim ); - - - /* - Call the f2c'd routine. - */ - lparse_ ( ( char * ) list, - ( char * ) delim, - ( integer * ) &nmax, - ( integer * ) n, - ( char * ) items, - ( ftnlen ) strlen(list), - ( ftnlen ) strlen(delim), - ( ftnlen ) lenout-1 ); - - /* - Reformat the output item array from Fortran to C style. Trim - trailing blanks from output tokens. - */ - - F2C_ConvertTrStrArr ( *n, lenout, (char *) items ); - - - chkout_c ( "lparse_c" ); - - -} /* End lparse_c */ diff --git a/ext/spice/src/cspice/lparsm.c b/ext/spice/src/cspice/lparsm.c deleted file mode 100644 index 21c838fb8d..0000000000 --- a/ext/spice/src/cspice/lparsm.c +++ /dev/null @@ -1,350 +0,0 @@ -/* lparsm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LPARSM ( Parse a list of items ) */ -/* Subroutine */ int lparsm_(char *list, char *delims, integer *nmax, integer - *n, char *items, ftnlen list_len, ftnlen delims_len, ftnlen items_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char bchr[1], echr[1]; - integer b, e, eol; - -/* $ Abstract */ - -/* Parse a list of items separated by multiple delimiters. */ - -/* $ 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 */ - -/* CHARACTER */ -/* LIST */ -/* PARSING */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LIST I List of items delimited by DELIMS. */ -/* DELIMS I Single characters which delimit items. */ -/* NMAX I Maximum number of items to return. */ -/* N O Number of items in the list. */ -/* ITEMS O Items in the list, left justified. */ - -/* $ Detailed_Input */ - -/* LIST is a list of items delimited by any one of the */ -/* characters in the string DELIMS. Consecutive */ -/* delimiters, and delimiters at the beginning and */ -/* end of the list, are considered to delimit blank */ -/* items. A blank list is considered to contain */ -/* a single (blank) item. */ - -/* DELIMS contains the individual characters which delimit */ -/* the items in the list. These may be any ASCII */ -/* characters, including blanks. */ - -/* However, by definition, consecutive blanks are NOT */ -/* considered to be consecutive delimiters. Nor are */ -/* a blank and any other delimiter considered to be */ -/* consecutive delimiters. In addition, leading and */ -/* trailing blanks are ignored. */ - -/* NMAX is the maximum number of items to be returned from */ -/* the list. This allows the user to guard against */ -/* overflow from a list containing more items than */ -/* expected. */ - -/* $ Detailed_Output */ - -/* N is the number of items in the list. N may be */ -/* any number between one and NMAX. N is always the */ -/* number of delimiters plus one. */ - -/* ITEMS are the items in the list, left justified. Any item */ -/* in the list to long to fit into an element of ITEMS */ -/* is truncated on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the string length of ITEMS is too short to accommodate */ -/* an item, the item will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following examples illustrate the operation of LPARSM. */ - -/* 1) Let */ -/* LIST = ' A number of words separated by spaces */ -/* DELIMS = ' ' */ -/* NMAX = 20 */ - -/* Then */ -/* ITEMS(1) = 'A' */ -/* ITEMS(2) = 'number' */ -/* ITEMS(3) = 'of' */ -/* ITEMS(4) = 'words' */ -/* ITEMS(5) = 'separated' */ -/* ITEMS(6) = 'by' */ -/* ITEMS(7) = 'spaces' */ - -/* 2) Let */ -/* LIST = ' 1986-187// 13:15:12.184 ' */ -/* DELIMS = ' ,/-:' */ -/* NMAX = 20 */ - -/* Then */ -/* ITEMS(1) = '1986' */ -/* ITEMS(2) = '187' */ -/* ITEMS(3) = ' ' */ -/* ITEMS(4) = '13' */ -/* ITEMS(5) = '15' */ -/* ITEMS(6) = '12.184' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ - -/* Bug fix: code was modified to avoid out-of-range */ -/* substring bound conditions. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse a list of items */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ - -/* Bug fix: code was modified to avoid out-of-range */ -/* substring bound conditions. The previous version */ -/* of this routine used DO WHILE statements of the form */ - -/* DO WHILE ( ( B .LE. EOL ) */ -/* . .AND. ( LIST(B:B) .EQ. BLANK ) ) */ - -/* Such statements can cause index range violations when the */ -/* index B is greater than the length of the string LIST. */ -/* Whether or not such violations occur is platform-dependent. */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Because speed is essential in many list parsing applications, */ -/* LPARSM parses the input list in a single pass. What follows */ -/* is nearly identical to LPARSE, except the Fortran INDEX function */ -/* is used to test for delimiters, instead of testing each character */ -/* for simple equality. */ - - -/* Nothing yet. */ - - *n = 0; - -/* Blank list contains a blank item. */ - - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - *n = 1; - s_copy(items, " ", items_len, (ftnlen)1); - } else { - -/* Eliminate trailing blanks. EOL is the last non-blank */ -/* character in the list. */ - - eol = i_len(list, list_len); - while(*(unsigned char *)&list[eol - 1] == 32) { - --eol; - } - -/* As the King said to Alice: 'Begin at the beginning. */ -/* Continue until you reach the end. Then stop.' */ - -/* When searching for items, B is the beginning of the current */ -/* item; E is the end. E points to the next non-blank delimiter, */ -/* if any; otherwise E points to either the last character */ -/* preceding the next item, or to the last character of the list. */ - - b = 1; - while(b <= eol) { - -/* Skip any blanks before the next item or delimiter. */ - -/* At this point in the loop, we know */ - -/* B <= EOL */ - - *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; - while(b <= eol && *(unsigned char *)bchr == 32) { - ++b; - if (b <= eol) { - *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; - } - } - -/* At this point B is the index of the next non-blank */ -/* character BCHR, or else */ - -/* B == EOL + 1 */ - -/* The item ends at the next delimiter. */ - - e = b; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; - } else { - *(unsigned char *)echr = ' '; - } - while(e <= eol && i_indx(delims, echr, delims_len, (ftnlen)1) == - 0) { - ++e; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; - } - } - -/* (This is different from LPARSE. If the delimiter was */ -/* a blank, find the next non-blank character. If it's not */ -/* a delimiter, back up. This prevents constructions */ -/* like 'a , b', where the delimiters are blank and comma, */ -/* from being interpreted as three items instead of two. */ -/* By definition, consecutive blanks, or a blank and any */ -/* other delimiter, do not count as consecutive delimiters.) */ - - if (e <= eol && *(unsigned char *)echr == 32) { - -/* Find the next non-blank character. */ - - while(e <= eol && *(unsigned char *)echr == 32) { - ++e; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - - 1]; - } - } - if (e <= eol) { - if (i_indx(delims, echr, delims_len, (ftnlen)1) == 0) { - -/* We're looking at a non-delimiter character. */ - -/* E is guaranteed to be > 1 if we're here, so the */ -/* following subtraction is valid. */ - - --e; - } - } - } - -/* The item now lies between B and E. Unless, of course, B and */ -/* E are the same character; this can happen if the list */ -/* starts or ends with a non-blank delimiter, or if we have */ -/* stumbled upon consecutive delimiters. */ - - ++(*n); - if (e > b) { - s_copy(items + (*n - 1) * items_len, list + (b - 1), - items_len, e - 1 - (b - 1)); - } else { - s_copy(items + (*n - 1) * items_len, " ", items_len, (ftnlen) - 1); - } - -/* If there are more items to be found, continue with */ -/* character following E (which is a delimiter). */ - - if (*n < *nmax) { - b = e + 1; - } else { - return 0; - } - } - -/* If the list ended with a (non-blank) delimiter, add a */ -/* blank item to the end. */ - - if (i_indx(delims, list + (eol - 1), delims_len, (ftnlen)1) != 0 && * - n < *nmax) { - ++(*n); - s_copy(items + (*n - 1) * items_len, " ", items_len, (ftnlen)1); - } - } - return 0; -} /* lparsm_ */ - diff --git a/ext/spice/src/cspice/lparsm_c.c b/ext/spice/src/cspice/lparsm_c.c deleted file mode 100644 index afe570575a..0000000000 --- a/ext/spice/src/cspice/lparsm_c.c +++ /dev/null @@ -1,295 +0,0 @@ -/* - --Procedure lparsm_c (Parse a list of items having multiple delimiters) - --Abstract - - Parse a list of items separated by multiple delimiters. - --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 - - CHARACTER, LIST, PARSING, STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void lparsm_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - list I List of items delimited by delims. - delims I Single characters which delimit items. - nmax I Maximum number of items to return. - lenout I Length of strings in item array. - n O Number of items in the list. - items O Items in the list, left justified. - --Detailed_Input - - list is a list of items delimited by any one of the - characters in the string delims. Consecutive delimiters, - and delimiters at the beginning and end of the list, are - considered to delimit empty items. A blank or empty list - is considered to contain a single, empty item. Leading - and trailing blanks in list are ignored. - - delims contains the individual characters which delimit - the items in the list. These may be any ASCII - characters, including blanks. - - However, by definition, consecutive blanks are NOT - considered to be consecutive delimiters. Nor are - a blank and any other delimiter considered to be - consecutive delimiters. - - nmax is the maximum number of items to be returned from the - list. This allows the user to guard against overflow - from a list containing more items than expected. - - lenout is the declared length of the strings in the string - array items. This length must include room for the - terminating null character in each string. - --Detailed_Output - - n is the number of items in the list. n may be any number - between one and nmax. - - items is an array of strings containing the items in the list, - left justified. Any item in the list too long to fit into - an element of items is truncated on the right. Empty - (null) or blank items in the input string are mapped to - empty strings on output. - - items should be declared by the caller as: - - SpiceChar items [nmax][lenout] - --Parameters - - None. - --Exceptions - - 1) If nmax is less than one, then n will be set to zero, and no - items will be returned. This case is not an error. The other - exceptional cases can occur only if nmax > 0. - - 2) The error SPICE(NULLPOINTER) is signaled if either of the input - string pointers or the output void pointer is null. - - 3) If the output string length lenout is less than one, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 4) An empty input string will result in a single, empty output - token. This case is not an error. - --Files - - None. - --Particulars - - None. - --Examples - - The following examples illustrate the operation of lparsm_c. - - 1) Let - - list == " A number of words separated by spaces " - delims == " " - nmax == 20 - - Then - - items[0] == "A" - items[1] == "number" - items[2] == "of" - items[3] == "words" - items[4] == "separated" - items[5] == "by" - items[6] == "spaces" - - - - 2) Let - - list == " ,bob, carol,, ted, alice" - delims == "," - nmax == 4 - - Then - - items[0] == "" - items[1] == "bob" - items[2] == "carol" - items[3] == "" - - - 3) Let - - list == " 1986-187// 13:15:12.184 " - delims == " ,/-:" - nmax == 20 - - Then - - items[0] == "1986" - items[1] == "187" - items[2] == "" - items[3] == "13" - items[4] == "15" - items[5] == "12.184" - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-AUG-2002 (NJB) (IMU) - --Index_Entries - - parse a list of items - --& -*/ - -{ /* Begin lparsm_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "lparsm_c" ); - - - /* - If there's no room for output tokens, just return. - */ - if ( nmax < 1 ) - { - *n = 0; - chkout_c ( "lparsm_c" ); - return; - } - - - /* - Make sure the output string array contains at least enough room - for a null character in each string. Unlike most CSPICE wrappers, - lparsm_c must check the output array before checking the inputs - because there's a special case that results in returning before - the input checks are performed. - */ - CHKOSTR ( CHK_STANDARD, "lparsm_c", items, lenout ); - - - /* - Special case: if the input string is empty, return a single empty - string. - - We must know that list is not a null pointer first. - */ - CHKPTR ( CHK_STANDARD, "lparsm_c", list ); - - if ( list[0] == NULLCHAR ) - { - *n = 1; - *(SpiceChar *)items = NULLCHAR; - - chkout_c ( "lparsm_c" ); - return; - } - - - /* - Check the input delimiter string to make sure the pointers are - non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "lparsm_c", list ); - CHKFSTR ( CHK_STANDARD, "lparsm_c", delims ); - - - /* - Call the f2c'd routine. - */ - lparsm_ ( ( char * ) list, - ( char * ) delims, - ( integer * ) &nmax, - ( integer * ) n, - ( char * ) items, - ( ftnlen ) strlen(list), - ( ftnlen ) strlen(delims), - ( ftnlen ) lenout-1 ); - - /* - Reformat the output item array from Fortran to C style. Trim - trailing blanks from output tokens. - */ - - F2C_ConvertTrStrArr ( *n, lenout, (char *) items ); - - - chkout_c ( "lparsm_c" ); - -} /* End lparsm_c */ diff --git a/ext/spice/src/cspice/lparss.c b/ext/spice/src/cspice/lparss.c deleted file mode 100644 index 63b0277052..0000000000 --- a/ext/spice/src/cspice/lparss.c +++ /dev/null @@ -1,487 +0,0 @@ -/* lparss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure LPARSS ( Parse a list of items; return a set. ) */ -/* Subroutine */ int lparss_(char *list, char *delims, char *set, ftnlen - list_len, ftnlen delims_len, ftnlen set_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char bchr[1], echr[1]; - integer nmax, b, e, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical valid; - extern integer sizec_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), validc_( - integer *, integer *, char *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen), insrtc_(char *, char - *, ftnlen, ftnlen); - extern logical return_(void); - integer eol; - -/* $ Abstract */ - -/* Parse a list of items delimited by multiple delimiters, */ -/* placing the resulting items into a set. */ - -/* $ 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 */ - -/* CELLS */ -/* SETS */ - -/* $ Keywords */ - -/* CHARACTER */ -/* PARSING */ -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LIST I List of items delimited by DELIMS on input. */ -/* DELIMS I Single characters which delimit items. */ -/* SET O Items in the list, validated, left justified. */ - -/* $ Detailed_Input */ - -/* LIST is a list of items delimited by any one of the */ -/* characters in the string DELIMS. Consecutive */ -/* delimiters, and delimiters at the beginning and */ -/* end of the list, are considered to delimit blank */ -/* items. A blank list is considered to contain */ -/* a single (blank) item. */ - -/* DELIMS contains the individual characters which delimit */ -/* the items in the list. These may be any ASCII */ -/* characters, including blanks. */ - -/* However, by definition, consecutive blanks are NOT */ -/* considered to be consecutive delimiters. Nor are */ -/* a blank and any other delimiter considered to be */ -/* consecutive delimiters. In addition, leading and */ -/* trailing blanks are ignored. */ - -/* $ Detailed_Output */ - -/* SET is a set containing the items in the list, left */ -/* justified. Any item in the list too long to fit */ -/* into an element of SET is truncated on the right. */ -/* The size of the set must be initialized prior */ -/* to calling LPARSS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the set is not large enough to accommodate all */ -/* of the items in the set, the error is diagnosed by routines in */ -/* the call tree of this routine. */ - -/* 2) If the string length of ITEMS is too short to accommodate */ -/* an item, the item will be truncated on the right. */ - -/* 3) If the string length of ITEMS is too short to permit encoding */ -/* of integers via ENCHAR, the error is diagnosed by routines in */ -/* the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following examples illustrate the operation of LPARSS. */ - -/* 1) Let */ -/* LIST = 'A number of words separated by */ -/* spaces.' */ -/* DELIMS = ' ,.' */ -/* SIZE (SET) = 20 */ - -/* Then */ - -/* CARDC (SET) = 8 */ - -/* SET (1) = ' ' */ -/* SET (2) = 'A' */ -/* SET (3) = 'by' */ -/* SET (4) = 'number' */ -/* SET (5) = 'of' */ -/* SET (6) = 'separated' */ -/* SET (7) = 'spaces' */ -/* SET (8) = 'words' */ - - -/* 2) Let */ - -/* LIST = ' 1986-187// 13:15:12.184 ' */ -/* DELIMS = ' ,/-:' */ -/* SIZE (SET) = 20 */ - -/* Then */ - -/* CARDC (SET) = 6 */ - -/* SET (1) = ' ' */ -/* SET (2) = '12.184' */ -/* SET (3) = '13' */ -/* SET (4) = '15' */ -/* SET (5) = '187' */ -/* SET (6) = '1986' */ - - -/* 3) Let LIST = ' ,This, is, ,an,, example, ' */ -/* DELIMS = ' ,' */ -/* SIZE (SET) = 20 */ - -/* Then */ -/* CARDC (SET) = 5 */ - -/* SET (1) = ' ' */ -/* SET (2) = 'This' */ -/* SET (3) = 'an' */ -/* SET (4) = 'example' */ -/* SET (5) = 'is' */ - - -/* 4) Let LIST = 'Mary had a little lamb, little lamb */ -/* whose fleece was white as snow.' */ -/* DELIMS = ' ,.' */ -/* SIZE (SET) = 6 */ - -/* An error would be signaled because the set is not */ -/* large enough to accommodate all of the items in the */ -/* list. */ - - -/* 5) Let LIST = '1 2 3 4 5 6 7 8 9 10.' */ -/* DELIMS = ' .' */ -/* SIZE (SET) = 10 */ - -/* An error would be signaled because the set is not */ -/* large enough to accommodate all of the items in the */ -/* list. Note that delimiters at the end (or beginning) */ -/* of list are considered to delimit blank items. */ - - -/* 6) Let LIST = '1 2 3 4 5 6 7 8 9 10.' */ -/* DELIMS = '.' */ -/* SIZE (SET) = 10 */ - -/* Then */ - -/* CARDC (SET) = 2 */ - -/* SET (1) = ' ' */ -/* SET (2) = '1 2 3 4 5 6 7 8 9 10' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ - -/* Bug fix: code was modified to avoid out-of-range */ -/* substring bound conditions. */ - -/* - 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 (HAN) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse a list of items and return a set */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ - -/* Bug fix: code was modified to avoid out-of-range */ -/* substring bound conditions. The previous version */ -/* of this routine used DO WHILE statements of the form */ - -/* DO WHILE ( ( B .LE. EOL ) */ -/* . .AND. ( LIST(B:B) .EQ. BLANK ) ) */ - -/* Such statements can cause index range violations when the */ -/* index B is greater than the length of the string LIST. */ -/* Whether or not such violations occur is platform-dependent. */ - - -/* - Beta Version 2.0.0, 10-JAN-1989 (HAN) */ - -/* Error handling was added, and old error flags and their */ -/* checks were removed. An error is signaled if the set */ -/* is not large enough to accommodate all of the items in */ -/* the list. */ - -/* The header documentation was updated to reflect the error */ -/* handling changes, and more examples were added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LPARSS", (ftnlen)6); - } - -/* Because speed is essential in many list parsing applications, */ -/* LPARSS, like LPARSE, parses the input list in a single pass. */ -/* What follows is nearly identical to LPARSE, except the FORTRAN */ -/* INDEX function is used to test for delimiters, instead of testing */ -/* each character for simple equality. Also, the items are inserted */ -/* into a set instead of simply placed at the end of an array. */ - -/* No items yet. */ - - n = 0; - -/* What is the size of the set? */ - - nmax = sizec_(set, set_len); - -/* The array has not been validated yet. */ - - valid = FALSE_; - -/* Blank list contains a blank item. No need to validate. */ - - if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { - scardc_(&c__0, set, set_len); - insrtc_(" ", set, (ftnlen)1, set_len); - valid = TRUE_; - } else { - -/* Eliminate trailing blanks. EOL is the last non-blank */ -/* character in the list. */ - - eol = lastnb_(list, list_len); - -/* As the King said to Alice: 'Begin at the beginning. */ -/* Continue until you reach the end. Then stop.' */ - -/* When searching for items, B is the beginning of the current */ -/* item; E is the end. E points to the next non-blank delimiter, */ -/* if any; otherwise E points to either the last character */ -/* preceding the next item, or to the last character of the list. */ - - b = 1; - while(b <= eol) { - -/* Skip any blanks before the next item or delimiter. */ - -/* At this point in the loop, we know */ - -/* B <= EOL */ - - *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; - while(b <= eol && *(unsigned char *)bchr == 32) { - ++b; - if (b <= eol) { - *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; - } - } - -/* At this point B is the index of the next non-blank */ -/* character BCHR, or else */ - -/* B == EOL + 1 */ - -/* The item ends at the next delimiter. */ - - e = b; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; - } else { - *(unsigned char *)echr = ' '; - } - while(e <= eol && i_indx(delims, echr, delims_len, (ftnlen)1) == - 0) { - ++e; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; - } - } - -/* (This is different from LPARSE. If the delimiter was */ -/* a blank, find the next non-blank character. If it's not */ -/* a delimiter, back up. This prevents constructions */ -/* like 'a , b', where the delimiters are blank and comma, */ -/* from being interpreted as three items instead of two. */ -/* By definition, consecutive blanks, or a blank and any */ -/* other delimiter, do not count as consecutive delimiters.) */ - - if (e <= eol && *(unsigned char *)echr == 32) { - -/* Find the next non-blank character. */ - - while(e <= eol && *(unsigned char *)echr == 32) { - ++e; - if (e <= eol) { - *(unsigned char *)echr = *(unsigned char *)&list[e - - 1]; - } - } - if (e <= eol) { - if (i_indx(delims, echr, delims_len, (ftnlen)1) == 0) { - -/* We're looking at a non-delimiter character. */ - -/* E is guaranteed to be > 1 if we're here, so the */ -/* following subtraction is valid. */ - - --e; - } - } - } - -/* The item now lies between B and E. Unless, of course, B and */ -/* E are the same character; this can happen if the list */ -/* starts or ends with a non-blank delimiter, or if we have */ -/* stumbled upon consecutive delimiters. */ - - if (! valid) { - -/* If the array has not been validated, it's just an */ -/* array, and we can insert items directly into it. */ -/* Unless it's full, in which case we validate now and */ -/* insert later. */ - - if (n < nmax) { - ++n; - if (e > b) { - s_copy(set + (n + 5) * set_len, list + (b - 1), - set_len, e - 1 - (b - 1)); - } else { - s_copy(set + (n + 5) * set_len, " ", set_len, (ftnlen) - 1); - } - } else { - validc_(&nmax, &nmax, set, set_len); - valid = TRUE_; - } - } - -/* Once the set has been validated, the strings are inserted */ -/* into the set if there's room. If there is not enough room */ -/* in the set, let INSRTC signal the error. */ - - if (valid) { - if (e > b) { - insrtc_(list + (b - 1), set, e - 1 - (b - 1), set_len); - } else { - insrtc_(" ", set, (ftnlen)1, set_len); - } - if (failed_()) { - chkout_("LPARSS", (ftnlen)6); - return 0; - } - } - -/* If there are more items to be found, continue with the */ -/* character following E (which is a delimiter). */ - - b = e + 1; - } - -/* If the array has not yet been validated, validate it before */ -/* returning. */ - - if (! valid) { - validc_(&nmax, &n, set, set_len); - } - -/* If the list ended with a (non-blank) delimiter, insert a */ -/* blank item into the set. If there isn't any room, signal */ -/* an error. */ - - if (i_indx(delims, list + (eol - 1), delims_len, (ftnlen)1) != 0) { - insrtc_(" ", set, (ftnlen)1, set_len); - -/* If INSRTC failed to insert the blank because the set */ -/* was already full, INSRTC will have signaled an error. */ -/* No action is necessary here. */ - - } - } - chkout_("LPARSS", (ftnlen)6); - return 0; -} /* lparss_ */ - diff --git a/ext/spice/src/cspice/lparss_c.c b/ext/spice/src/cspice/lparss_c.c deleted file mode 100644 index 91b2702f50..0000000000 --- a/ext/spice/src/cspice/lparss_c.c +++ /dev/null @@ -1,299 +0,0 @@ -/* - --Procedure lparss_c (Parse a list of items; return a set) - --Abstract - - Parse a list of items separated by multiple delimiters, placing the - resulting items into a set. - --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 - - CHARACTER, LIST, PARSING, STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void lparss_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - list I List of items delimited by delims. - delims I Single characters which delimit items. - set O Set containing items in the list, left justified. - --Detailed_Input - - list is a list of items delimited by any one of the - characters in the string delims. Consecutive delimiters, - and delimiters at the beginning and end of the list, are - considered to delimit empty items. A blank or empty list - is considered to contain a single, empty item. Leading - and trailing blanks in list are ignored. - - delims contains the individual characters which delimit - the items in the list. These may be any ASCII - characters, including blanks. - - However, by definition, consecutive blanks are NOT - considered to be consecutive delimiters. Nor are - a blank and any other delimiter considered to be - consecutive delimiters. - --Detailed_Output - - set is a CSPICE set containing the items in the list, - left justified. Any item in the list too long to fit into - an element of items is truncated on the right. Empty - (null) or blank items in the input string are mapped to - empty strings on output. - - set should be declared by the caller as a character - SpiceCell: - - SPICECHAR_CELL ( set, NMAX, LENGTH ); - - where NMAX is the maximum number of strings the set is - expected to hold and LENGTH is the maximum length of - the strings, counting the terminating null. - - The strings in set will be sorted in increasing order, - and duplicates will be removed. Trailing blanks are - ignored in string comparisons. - --Parameters - - None. - --Exceptions - - - 1) If the size of the set is not large enough to accomodate all of - the items in the set, the error SPICE(SETEXCESS) is signaled. - - 2) The error SPICE(NULLPOINTER) is signaled if either of the input - string pointers is null. - - 3) If the set does not have character type, the error - SPICE(TYPEMISMATCH) will be signaled.. - - 4) An empty input string will result in a single, empty output - token. This case is not an error. - - 5) If the string length associated with set is too short to - be usable when constructing a character Fortran-style cell, - the error will be diagnosed by routines in the call tree - of this routine. See the routine enchar_ for details. - --Files - - None. - --Particulars - - None. - --Examples - - The following examples illustrate the operation of lparss_c. - - 1) Let - - list == " A number of words separated by spaces. " - delims == " ,." - - Let set be declared with size 20. - - Then - - Element 0 of set == " " - Element 1 of set == "A" - Element 2 of set == "by" - Element 3 of set == "number" - Element 4 of set == "of" - Element 5 of set == "separated" - Element 6 of set == "spaces" - Element 7 of set == "words" - - 2) Let - - list == " 1986-187// 13:15:12.184 " - delims == " ,/-:" - nmax == 20 - - Then - - Element 0 of set == "" - Element 1 of set == "12.184" - Element 2 of set == "13" - Element 3 of set == "15" - Element 4 of set == "187" - Element 5 of set == "1986" - - --Restrictions - - 1) 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. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 27-AUG-2002 (NJB) (IMU) - --Index_Entries - - parse a list of items - --& -*/ - -{ /* Begin lparss_c */ - - /* - Local variables - */ - SpiceChar * fCell; - - SpiceInt fLen; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "lparss_c" ); - - - /* - Special case: if the input string is empty, return a set - containing a single empty string. - - We must know that list is not a null pointer first. - */ - CHKPTR ( CHK_STANDARD, "lparss_c", list ); - - if ( list[0] == NULLCHAR ) - { - insrtc_c ( "", set ); - - chkout_c ( "lparss_c" ); - return; - } - - - /* - Check the input delimiter string to make sure the pointers are - non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "lparss_c", list ); - CHKFSTR ( CHK_STANDARD, "lparss_c", delims ); - - - /* - Make sure we've been handed a character set. - */ - CELLTYPECHK ( CHK_STANDARD, "lparss_c", SPICE_CHR, set ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - - /* - Create a Fortran-style character set for the f2c'd routine to - write to. The first argument (caller) is empty because we - don't want to use delegated check-in. - */ - C2F_MAP_CELL ( "", set, &fCell, &fLen ); - - if ( failed_c() ) - { - chkout_c ( "lparss_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - lparss_ ( ( char * ) list, - ( char * ) delims, - ( char * ) fCell, - ( ftnlen ) strlen(list), - ( ftnlen ) strlen(delims), - ( ftnlen ) fLen ); - - /* - Map the Fortran set to a CSPICE set. - */ - F2C_MAP_CELL ( fCell, fLen, set ); - - - /* - We're done with the dynamically allocated Fortran-style array. - */ - free ( fCell ); - - - chkout_c ( "lparss_c" ); - -} /* End lparss_c */ diff --git a/ext/spice/src/cspice/lread.c b/ext/spice/src/cspice/lread.c deleted file mode 100644 index 6f537a7ebf..0000000000 --- a/ext/spice/src/cspice/lread.c +++ /dev/null @@ -1,700 +0,0 @@ -#include "f2c.h" -#include "fio.h" - -/* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */ -/* marks in namelist input a la the Fortran 8X Draft published in */ -/* the May 1989 issue of Fortran Forum. */ - - -extern char *f__fmtbuf; - -#ifdef Allow_TYQUAD -static longint f__llx; -#endif - -#ifdef KR_headers -extern double atof(); -extern char *malloc(), *realloc(); -int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), - (*l_ungetc)(int,FILE*); -#endif - -#include "fmt.h" -#include "lio.h" -#include "ctype.h" -#include "fp.h" - -int l_eof; - -#define isblnk(x) (f__ltab[x+1]&B) -#define issep(x) (f__ltab[x+1]&SX) -#define isapos(x) (f__ltab[x+1]&AX) -#define isexp(x) (f__ltab[x+1]&EX) -#define issign(x) (f__ltab[x+1]&SG) -#define iswhit(x) (f__ltab[x+1]&WH) -#define SX 1 -#define B 2 -#define AX 4 -#define EX 8 -#define SG 16 -#define WH 32 -char f__ltab[128+1] = { /* offset one for EOF */ - 0, - 0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -}; - -#ifdef ungetc - static int -#ifdef KR_headers -un_getc(x,f__cf) int x; FILE *f__cf; -#else -un_getc(int x, FILE *f__cf) -#endif -{ return ungetc(x,f__cf); } -#else -#define un_getc ungetc -#ifdef KR_headers - extern int ungetc(); -#else -extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */ -#endif -#endif - -t_getc(Void) -{ int ch; - if(f__curunit->uend) return(EOF); - if((ch=getc(f__cf))!=EOF) return(ch); - if(feof(f__cf)) - f__curunit->uend = l_eof = 1; - return(EOF); -} -integer e_rsle(Void) -{ - int ch; - if(f__curunit->uend) return(0); - while((ch=t_getc())!='\n') - if (ch == EOF) { - if(feof(f__cf)) - f__curunit->uend = l_eof = 1; - return EOF; - } - return(0); -} - -flag f__lquit; -int f__lcount,f__ltype,nml_read; -char *f__lchar; -double f__lx,f__ly; -#define ERR(x) if(n=(x)) return(n) -#define GETC(x) (x=(*l_getc)()) -#define Ungetc(x,y) (*l_ungetc)(x,y) - - static int -#ifdef KR_headers -l_R(poststar, reqint) int poststar, reqint; -#else -l_R(int poststar, int reqint) -#endif -{ - char s[FMAX+EXPMAXDIGS+4]; - register int ch; - register char *sp, *spe, *sp1; - long e, exp; - int havenum, havestar, se; - - if (!poststar) { - if (f__lcount > 0) - return(0); - f__lcount = 1; - } -#ifdef Allow_TYQUAD - f__llx = 0; -#endif - f__ltype = 0; - exp = 0; - havestar = 0; -retry: - sp1 = sp = s; - spe = sp + FMAX; - havenum = 0; - - switch(GETC(ch)) { - case '-': *sp++ = ch; sp1++; spe++; - case '+': - GETC(ch); - } - while(ch == '0') { - ++havenum; - GETC(ch); - } - while(isdigit(ch)) { - if (sp < spe) *sp++ = ch; - else ++exp; - GETC(ch); - } - if (ch == '*' && !poststar) { - if (sp == sp1 || exp || *s == '-') { - errfl(f__elist->cierr,112,"bad repetition count"); - } - poststar = havestar = 1; - *sp = 0; - f__lcount = atoi(s); - goto retry; - } - if (ch == '.') { -#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT - if (reqint) - errfl(f__elist->cierr,115,"invalid integer"); -#endif - GETC(ch); - if (sp == sp1) - while(ch == '0') { - ++havenum; - --exp; - GETC(ch); - } - while(isdigit(ch)) { - if (sp < spe) - { *sp++ = ch; --exp; } - GETC(ch); - } - } - havenum += sp - sp1; - se = 0; - if (issign(ch)) - goto signonly; - if (havenum && isexp(ch)) { -#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT - if (reqint) - errfl(f__elist->cierr,115,"invalid integer"); -#endif - GETC(ch); - if (issign(ch)) { -signonly: - if (ch == '-') se = 1; - GETC(ch); - } - if (!isdigit(ch)) { -bad: - errfl(f__elist->cierr,112,"exponent field"); - } - - e = ch - '0'; - while(isdigit(GETC(ch))) { - e = 10*e + ch - '0'; - if (e > EXPMAX) - goto bad; - } - if (se) - exp -= e; - else - exp += e; - } - (void) Ungetc(ch, f__cf); - if (sp > sp1) { - ++havenum; - while(*--sp == '0') - ++exp; - if (exp) - sprintf(sp+1, "e%ld", exp); - else - sp[1] = 0; - f__lx = atof(s); -#ifdef Allow_TYQUAD - if (reqint&2 && (se = sp - sp1 + exp) > 14 && se < 20) { - /* Assuming 64-bit longint and 32-bit long. */ - if (exp < 0) - sp += exp; - if (sp1 <= sp) { - f__llx = *sp1 - '0'; - while(++sp1 <= sp) - f__llx = 10*f__llx + (*sp1 - '0'); - } - while(--exp >= 0) - f__llx *= 10; - if (*s == '-') - f__llx = -f__llx; - } -#endif - } - else - f__lx = 0.; - if (havenum) - f__ltype = TYLONG; - else - switch(ch) { - case ',': - case '/': - break; - default: - if (havestar && ( ch == ' ' - ||ch == '\t' - ||ch == '\n')) - break; - if (nml_read > 1) { - f__lquit = 2; - return 0; - } - errfl(f__elist->cierr,112,"invalid number"); - } - return 0; - } - - static int -#ifdef KR_headers -rd_count(ch) register int ch; -#else -rd_count(register int ch) -#endif -{ - if (ch < '0' || ch > '9') - return 1; - f__lcount = ch - '0'; - while(GETC(ch) >= '0' && ch <= '9') - f__lcount = 10*f__lcount + ch - '0'; - Ungetc(ch,f__cf); - return f__lcount <= 0; - } - - static int -l_C(Void) -{ int ch, nml_save; - double lz; - if(f__lcount>0) return(0); - f__ltype=0; - GETC(ch); - if(ch!='(') - { - if (nml_read > 1 && (ch < '0' || ch > '9')) { - Ungetc(ch,f__cf); - f__lquit = 2; - return 0; - } - if (rd_count(ch)) - if(!f__cf || !feof(f__cf)) - errfl(f__elist->cierr,112,"complex format"); - else - err(f__elist->cierr,(EOF),"lread"); - if(GETC(ch)!='*') - { - if(!f__cf || !feof(f__cf)) - errfl(f__elist->cierr,112,"no star"); - else - err(f__elist->cierr,(EOF),"lread"); - } - if(GETC(ch)!='(') - { Ungetc(ch,f__cf); - return(0); - } - } - else - f__lcount = 1; - while(iswhit(GETC(ch))); - Ungetc(ch,f__cf); - nml_save = nml_read; - nml_read = 0; - if (ch = l_R(1,0)) - return ch; - if (!f__ltype) - errfl(f__elist->cierr,112,"no real part"); - lz = f__lx; - while(iswhit(GETC(ch))); - if(ch!=',') - { (void) Ungetc(ch,f__cf); - errfl(f__elist->cierr,112,"no comma"); - } - while(iswhit(GETC(ch))); - (void) Ungetc(ch,f__cf); - if (ch = l_R(1,0)) - return ch; - if (!f__ltype) - errfl(f__elist->cierr,112,"no imaginary part"); - while(iswhit(GETC(ch))); - if(ch!=')') errfl(f__elist->cierr,112,"no )"); - f__ly = f__lx; - f__lx = lz; -#ifdef Allow_TYQUAD - f__llx = 0; -#endif - nml_read = nml_save; - return(0); -} - - static int -l_L(Void) -{ - int ch; - if(f__lcount>0) return(0); - f__lcount = 1; - f__ltype=0; - GETC(ch); - if(isdigit(ch)) - { - rd_count(ch); - if(GETC(ch)!='*') - if(!f__cf || !feof(f__cf)) - errfl(f__elist->cierr,112,"no star"); - else - err(f__elist->cierr,(EOF),"lread"); - GETC(ch); - } - if(ch == '.') GETC(ch); - switch(ch) - { - case 't': - case 'T': - f__lx=1; - break; - case 'f': - case 'F': - f__lx=0; - break; - default: - if(isblnk(ch) || issep(ch) || ch==EOF) - { (void) Ungetc(ch,f__cf); - return(0); - } - if (nml_read > 1) { - Ungetc(ch,f__cf); - f__lquit = 2; - return 0; - } - errfl(f__elist->cierr,112,"logical"); - } - f__ltype=TYLONG; - while(!issep(GETC(ch)) && ch!=EOF); - (void) Ungetc(ch, f__cf); - return(0); -} - -#define BUFSIZE 128 - - static int -l_CHAR(Void) -{ int ch,size,i; - static char rafail[] = "realloc failure"; - char quote,*p; - if(f__lcount>0) return(0); - f__ltype=0; - if(f__lchar!=NULL) free(f__lchar); - size=BUFSIZE; - p=f__lchar = (char *)malloc((unsigned int)size); - if(f__lchar == NULL) - errfl(f__elist->cierr,113,"no space"); - - GETC(ch); - if(isdigit(ch)) { - /* allow Fortran 8x-style unquoted string... */ - /* either find a repetition count or the string */ - f__lcount = ch - '0'; - *p++ = ch; - for(i = 1;;) { - switch(GETC(ch)) { - case '*': - if (f__lcount == 0) { - f__lcount = 1; -#ifndef F8X_NML_ELIDE_QUOTES - if (nml_read) - goto no_quote; -#endif - goto noquote; - } - p = f__lchar; - goto have_lcount; - case ',': - case ' ': - case '\t': - case '\n': - case '/': - Ungetc(ch,f__cf); - /* no break */ - case EOF: - f__lcount = 1; - f__ltype = TYCHAR; - return *p = 0; - } - if (!isdigit(ch)) { - f__lcount = 1; -#ifndef F8X_NML_ELIDE_QUOTES - if (nml_read) { - no_quote: - errfl(f__elist->cierr,112, - "undelimited character string"); - } -#endif - goto noquote; - } - *p++ = ch; - f__lcount = 10*f__lcount + ch - '0'; - if (++i == size) { - f__lchar = (char *)realloc(f__lchar, - (unsigned int)(size += BUFSIZE)); - if(f__lchar == NULL) - errfl(f__elist->cierr,113,rafail); - p = f__lchar + i; - } - } - } - else (void) Ungetc(ch,f__cf); - have_lcount: - if(GETC(ch)=='\'' || ch=='"') quote=ch; - else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) { - Ungetc(ch,f__cf); - return 0; - } -#ifndef F8X_NML_ELIDE_QUOTES - else if (nml_read > 1) { - Ungetc(ch,f__cf); - f__lquit = 2; - return 0; - } -#endif - else { - /* Fortran 8x-style unquoted string */ - *p++ = ch; - for(i = 1;;) { - switch(GETC(ch)) { - case ',': - case ' ': - case '\t': - case '\n': - case '/': - Ungetc(ch,f__cf); - /* no break */ - case EOF: - f__ltype = TYCHAR; - return *p = 0; - } - noquote: - *p++ = ch; - if (++i == size) { - f__lchar = (char *)realloc(f__lchar, - (unsigned int)(size += BUFSIZE)); - if(f__lchar == NULL) - errfl(f__elist->cierr,113,rafail); - p = f__lchar + i; - } - } - } - f__ltype=TYCHAR; - for(i=0;;) - { while(GETC(ch)!=quote && ch!='\n' - && ch!=EOF && ++icierr,113,rafail); - p=f__lchar+i-1; - *p++ = ch; - } - else if(ch==EOF) return(EOF); - else if(ch=='\n') - { if(*(p-1) != '\\') continue; - i--; - p--; - if(++iciunit]; - if(a->ciunit>=MXUNIT || a->ciunit<0) - err(a->cierr,101,"stler"); - f__scale=f__recpos=0; - f__elist=a; - if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) - err(a->cierr,102,"lio"); - f__cf=f__curunit->ufd; - if(!f__curunit->ufmt) err(a->cierr,103,"lio") - return(0); -} -#ifdef KR_headers -l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; -#else -l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) -#endif -{ -#define Ptr ((flex *)ptr) - int i,n,ch; - doublereal *yy; - real *xx; - for(i=0;i<*number;i++) - { - if(f__lquit) return(0); - if(l_eof) - err(f__elist->ciend, EOF, "list in") - if(f__lcount == 0) { - f__ltype = 0; - for(;;) { - GETC(ch); - switch(ch) { - case EOF: - err(f__elist->ciend,(EOF),"list in") - case ' ': - case '\t': - case '\n': - continue; - case '/': - f__lquit = 1; - goto loopend; - case ',': - f__lcount = 1; - goto loopend; - default: - (void) Ungetc(ch, f__cf); - goto rddata; - } - } - } - rddata: - switch((int)type) - { - case TYINT1: - case TYSHORT: - case TYLONG: -#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT - ERR(l_R(0,1)); - break; -#endif - case TYREAL: - case TYDREAL: - ERR(l_R(0,0)); - break; -#ifdef TYQUAD - case TYQUAD: - n = l_R(0,2); - if (n) - return n; - break; -#endif - case TYCOMPLEX: - case TYDCOMPLEX: - ERR(l_C()); - break; - case TYLOGICAL1: - case TYLOGICAL2: - case TYLOGICAL: - ERR(l_L()); - break; - case TYCHAR: - ERR(l_CHAR()); - break; - } - while (GETC(ch) == ' ' || ch == '\t'); - if (ch != ',' || f__lcount > 1) - Ungetc(ch,f__cf); - loopend: - if(f__lquit) return(0); - if(f__cf && ferror(f__cf)) { - clearerr(f__cf); - errfl(f__elist->cierr,errno,"list in"); - } - if(f__ltype==0) goto bump; - switch((int)type) - { - case TYINT1: - case TYLOGICAL1: - Ptr->flchar = (char)f__lx; - break; - case TYLOGICAL2: - case TYSHORT: - Ptr->flshort = (short)f__lx; - break; - case TYLOGICAL: - case TYLONG: - Ptr->flint = (ftnint)f__lx; - break; -#ifdef Allow_TYQUAD - case TYQUAD: - if (!(Ptr->fllongint = f__llx)) - Ptr->fllongint = f__lx; - break; -#endif - case TYREAL: - Ptr->flreal=f__lx; - break; - case TYDREAL: - Ptr->fldouble=f__lx; - break; - case TYCOMPLEX: - xx=(real *)ptr; - *xx++ = f__lx; - *xx = f__ly; - break; - case TYDCOMPLEX: - yy=(doublereal *)ptr; - *yy++ = f__lx; - *yy = f__ly; - break; - case TYCHAR: - b_char(f__lchar,ptr,len); - break; - } - bump: - if(f__lcount>0) f__lcount--; - ptr += len; - if (nml_read) - nml_read++; - } - return(0); -#undef Ptr -} -#ifdef KR_headers -integer s_rsle(a) cilist *a; -#else -integer s_rsle(cilist *a) -#endif -{ - int n; - - f__reading=1; - f__external=1; - f__formatted=1; - if(n=c_le(a)) return(n); - f__lioproc = l_read; - f__lquit = 0; - f__lcount = 0; - l_eof = 0; - if(f__curunit->uwrt && f__nowreading(f__curunit)) - err(a->cierr,errno,"read start"); - if(f__curunit->uend) - err(f__elist->ciend,(EOF),"read start"); - l_getc = t_getc; - l_ungetc = un_getc; - f__doend = xrd_SL; - return(0); -} diff --git a/ext/spice/src/cspice/lspcn.c b/ext/spice/src/cspice/lspcn.c deleted file mode 100644 index 7bd1f0d08a..0000000000 --- a/ext/spice/src/cspice/lspcn.c +++ /dev/null @@ -1,404 +0,0 @@ -/* lspcn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure LSPCN ( Longitude of the sun, planetocentric ) */ -doublereal lspcn_(char *body, doublereal *et, char *abcorr, ftnlen body_len, - ftnlen abcorr_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal tipm[9] /* was [3][3] */; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - doublereal uavel[3], npole[3], trans[9] /* was [3][3] */; - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *), bods2c_(char *, integer *, logical *, ftnlen); - extern logical failed_(void); - integer idcode; - doublereal lt; - extern /* Subroutine */ int recrad_(doublereal *, doublereal *, - doublereal *, doublereal *), tipbod_(char *, integer *, - doublereal *, doublereal *, ftnlen); - doublereal bstate[6], radius; - extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - doublereal sstate[6]; - extern /* Subroutine */ int twovec_(doublereal *, integer *, doublereal *, - integer *, doublereal *), spkezr_(char *, doublereal *, char *, - char *, char *, doublereal *, doublereal *, ftnlen, ftnlen, - ftnlen, ftnlen); - extern logical return_(void); - doublereal lat, pos[3]; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Compute L_s, the planetocentric longitude of the sun, as seen */ -/* from a specified body. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* PCK */ -/* TIME */ -/* SPK */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Name of central body. */ -/* ET I Epoch in seconds past J2000 TDB. */ -/* ABCORR I Aberration correction. */ - -/* The function returns the value of L_s for the specified body */ -/* at the specified time. */ - -/* $ Detailed_Input */ - -/* BODY is the name of the central body, typically a planet. */ - -/* ET is the epoch at which the longitude of the sun (L_s) */ -/* is to be computed. ET is expressed as seconds past */ -/* J2000 TDB (Barycentric Dynamical Time). */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the longitude of the sun. ABCORR may */ -/* be any of the following. */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' Correct the position of the sun, */ -/* relative to the central body, for */ -/* planetary (light time) aberration. */ - -/* 'LT+S' Correct the position of the sun, */ -/* relative to the central body, for */ -/* planetary and stellar aberrations. */ - -/* $ Detailed_Output */ - -/* The function returns the planetocentric longitude of the sun, */ -/* often called "L_s," for the specified body at the specified time. */ -/* This is the longitude of the body-sun vector in a right-handed */ -/* frame whose basis vectors are defined as follows: */ - -/* - The positive Z direction is given by the instantaneous */ -/* angular velocity vector of the orbit of the body about */ -/* the sun. */ - -/* - The positive X direction is that of the cross product of the */ -/* instantaneous north spin axis of the body with the positive */ -/* Z direction. */ - -/* - The positive Y direction is Z x X. */ - -/* Units are radians; the range is 0 to 2*pi. Longitudes are */ -/* positive to the east. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input body name cannot be translated to an ID code, */ -/* and if the name is not a string representation of an integer */ -/* (for example, '399'), the error SPICE(NOTRANSLATION) is */ -/* signaled. */ - -/* 2) If no SPK (ephemeris) file has been loaded prior to calling */ -/* this routine, or if the SPK data has insufficient coverage, an */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 3) If a PCK file containing rotational elements for the central */ -/* body has not been loaded prior to calling this routine, an */ -/* error will be diagnosed and signaled by a routine called by a */ -/* routine in the call tree of this routine. */ - -/* 4) If the instantaneous angular velocity and spin axis of BODY */ -/* are parallel, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. */ - -/* $ Files */ - -/* 1) An SPK file (or file) containing ephemeris data sufficient to */ -/* compute the geometric state of the central body relative to */ -/* the sun at ET must be loaded before this routine is called. If */ -/* light time correction is used, data must be available that */ -/* enable computation of the state the sun relative to the solar */ -/* system barycenter at the light-time corrected epoch. If */ -/* stellar aberration correction is used, data must be available */ -/* that enable computation of the state the central body relative */ -/* to the solar system barycenter at ET. */ - -/* 2) A PCK file containing rotational elements for the central body */ -/* must be loaded before this routine is called. */ - -/* $ Particulars */ - -/* The direction of the vernal equinox for the central body is */ -/* determined from the instantaneous equatorial and orbital planes */ -/* of the central body. This equinox definition is specified in */ -/* reference [1]. The "instantaneous orbital plane" is interpreted */ -/* in this routine as the plane normal to the cross product of the */ -/* position and velocity of the central body relative to the sun. */ -/* The geometric state of the central body relative to the sun is */ -/* used for this normal vector computation. The "instantaneous */ -/* equatorial plane" is normal to the central body's north pole */ -/* at the requested epoch. The pole direction is determined from */ -/* rotational elements loaded via a PCK file. */ - -/* The result returned by this routine will depend on the */ -/* ephemeris data and rotational elements used. The result may */ -/* differ from that given in any particular version of the */ -/* Astronomical Almanac, due to differences in these input data, */ -/* and due to differences in precision of the computations. */ - -/* $ Examples */ - -/* 1) A simple program that computes L_s for a body and time */ -/* supplied interactively. The geometric state of the sun is */ -/* used. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION LSPCN */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER NAMLEN */ -/* PARAMETER ( NAMLEN = 36 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 40 ) */ - -/* CHARACTER*(NAMLEN) BODY */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) PCK */ -/* CHARACTER*(FILSIZ) SPK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LON */ - - -/* CALL PROMPT ( 'Enter name of leapseconds kernel > ', LSK ) */ -/* CALL PROMPT ( 'Enter name of PCK file > ', PCK ) */ -/* CALL PROMPT ( 'Enter name of SPK file > ', SPK ) */ - -/* CALL FURNSH ( LSK ) */ -/* CALL FURNSH ( PCK ) */ -/* CALL FURNSH ( SPK ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Kernels have been loaded.' */ -/* WRITE (*,*) ' ' */ - -/* DO WHILE ( .TRUE. ) */ - -/* CALL PROMPT ( 'Enter name of central body > ', */ -/* . BODY ) */ -/* CALL PROMPT ( 'Enter calendar, JD, or DOY time > ', */ -/* . TIMSTR ) */ - -/* CALL STR2ET ( TIMSTR, ET ) */ - -/* C */ -/* C Convert longitude to degrees. */ -/* C */ -/* LON = DPR() * LSPCN ( BODY, ET, ABCORR ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Central body = ', BODY */ -/* WRITE (*,*) 'Time = ', TIMSTR */ -/* WRITE (*,*) 'Planetocentric L_s (deg.) = ', LON */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] "The Astronomical Almanac for the Year 2005." U.S. Government */ -/* Printing Office, Washington, D.C., 1984, page L9. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* planetocentric longitude of sun */ -/* compute L_s */ -/* compute Ls */ -/* compute L_sub_s */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Give the function an initial value. */ - - ret_val = 0.; - -/* Standard SPICE error handling. */ - - if (return_()) { - return ret_val; - } - chkin_("LSPCN", (ftnlen)5); - -/* Map the body name to an ID code. */ - - bods2c_(body, &idcode, &found, body_len); - if (! found) { - setmsg_("The body name # could not be translated to a NAIF ID code. " - " The cause of this problem may be that you need an updated v" - "ersion of the SPICE Toolkit.", (ftnlen)147); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20); - chkout_("LSPCN", (ftnlen)5); - return ret_val; - } - -/* Look up the direction of the North pole of the central body. */ -/* Note that TIPBOD does make use of binary PCK data if available. */ - - tipbod_("J2000", &idcode, et, tipm, (ftnlen)5); - for (i__ = 1; i__ <= 3; ++i__) { - npole[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("npole", i__1, - "lspcn_", (ftnlen)339)] = tipm[(i__2 = i__ * 3 - 1) < 9 && 0 - <= i__2 ? i__2 : s_rnge("tipm", i__2, "lspcn_", (ftnlen)339)]; - } - -/* Get the geometric state of the body relative to the sun. */ - - spkgeo_(&idcode, et, "J2000", &c__10, bstate, <, (ftnlen)5); - -/* Get the unit direction vector parallel to the angular velocity */ -/* vector of the orbit. This is just the unitized cross product of */ -/* position and velocity. */ - - ucrss_(bstate, &bstate[3], uavel); - -/* We want to create a transformation matrix that maps vectors from */ -/* basis REF to the following frame: */ -/* Z = UAVEL */ - -/* X = NPOLE x UAVEL */ - -/* Y = Z x X */ - -/* This is a "two-vector" frame with the unit orbital */ -/* angular velocity vector UAVEL as the primary vector and the */ -/* spin axis NPOLE as the secondary vector. The primary */ -/* vector is associated with the +Z axis; the secondary vector */ -/* is associated with the +Y axis. */ - - twovec_(uavel, &c__3, npole, &c__2, trans); - if (failed_()) { - chkout_("LSPCN", (ftnlen)5); - return ret_val; - } - -/* We'll find the position of the Sun relative to this frame. */ - -/* Get the state of the sun in frame REF. Since we may be using */ -/* aberration corrections, this is not necessarily the negative of */ -/* the state we've just found. */ - - spkezr_("SUN", et, "J2000", abcorr, body, sstate, <, (ftnlen)3, (ftnlen) - 5, abcorr_len, body_len); - -/* Now transform the position of the Sun into the "orbit plane */ -/* and equinox" frame. */ - - mxv_(trans, sstate, pos); - -/* Let RECRAD find the longitude LS for us. RECRAD performs */ -/* the same coordinate transformation as the more commonly used */ -/* RECLAT, but the range of right ascension is 0:2*pi, which is */ -/* what we want for Ls. */ - - recrad_(pos, &radius, &ret_val, &lat); - chkout_("LSPCN", (ftnlen)5); - return ret_val; -} /* lspcn_ */ - diff --git a/ext/spice/src/cspice/lspcn_c.c b/ext/spice/src/cspice/lspcn_c.c deleted file mode 100644 index d61d78f1e5..0000000000 --- a/ext/spice/src/cspice/lspcn_c.c +++ /dev/null @@ -1,314 +0,0 @@ -/* - --Procedure lspcn_c ( Longitude of the sun, planetocentric ) - --Abstract - - Compute L_s, the planetocentric longitude of the sun, as seen - from a specified body. - --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 - - NAIF_IDS - PCK - TIME - SPK - --Keywords - - GEOMETRY - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceDouble lspcn_c ( ConstSpiceChar * body, - SpiceDouble et, - ConstSpiceChar * abcorr ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - body I Name of central body. - et I Epoch in seconds past J2000 TDB. - abcorr I Aberration correction. - - The function returns the value of L_s for the specified body - at the specified time. - --Detailed_Input - - body is the name of the central body, typically a planet. - - et is the epoch at which the longitude of the sun (L_s) is - to be computed. `et' is expressed as seconds past J2000 - TDB (Barycentric Dynamical Time). - - abcorr indicates the aberration corrections to be applied - when computing the longitude of the sun. `abcorr' - may be any of the following. - - "NONE" Apply no correction. - - "LT" Correct the position of the sun, - relative to the central body, for - planetary (light time) aberration. - - "LT+S" Correct the position of the sun, - relative to the central body, for - planetary and stellar aberrations. - --Detailed_Output - - The function returns the planetocentric longitude of the sun, - often called "L_s," for the specified body at the specified time. - This is the longitude of the body-sun vector in a right-handed - frame whose basis vectors are defined as follows: - - - The positive Z direction is given by the instantaneous - angular velocity vector of the orbit of the body about - the sun. - - - The positive X direction is that of the cross product of the - instantaneous north spin axis of the body with the - positive Z direction. - - - The positive Y direction is Z x X. - - Units are radians; the range is 0 to 2*pi. Longitudes are - positive to the east. - --Parameters - - None. - --Exceptions - - 1) If the input body name cannot be translated to an ID code, - and if the name is not a string representation of an integer - (for example, "399"), the error SPICE(NOTRANSLATION) is - signaled. - - 2) If no SPK (ephemeris) file has been loaded prior to calling - this routine, or if the SPK data has insufficient coverage, an - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 3) If a PCK file containing rotational elements for the central - body has not been loaded prior to calling this routine, an - error will be diagnosed and signaled by a routine called by a - routine in the call tree of this routine. - - 4) If the instantaneous angular velocity and spin axis of `body' - are parallel, the error will be diagnosed and signaled by a - routine in the call tree of this routine. - - 5) The error SPICE(EMPTYSTRING) is signaled if the input - string `body' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 6) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `body' is null. - --Files - - 1) An SPK file (or file) containing ephemeris data sufficient to - compute the geometric state of the central body relative to - the sun at `et' must be loaded before this routine is called. If - light time correction is used, data must be available that - enable computation of the state the sun relative to the solar - system barycenter at the light-time corrected epoch. If - stellar aberration correction is used, data must be available - that enable computation of the state the central body relative - to the solar system barycenter at `et'. - - 2) A PCK file containing rotational elements for the central body - must be loaded before this routine is called. - --Particulars - - The direction of the vernal equinox for the central body is - determined from the instantaneous equatorial and orbital planes - of the central body. This equinox definition is specified in - reference [1]. The "instantaneous orbital plane" is interpreted - in this routine as the plane normal to the cross product of the - position and velocity of the central body relative to the sun. - The geometric state of the central body relative to the sun is - used for this normal vector computation. The "instantaneous - equatorial plane" is normal to the central body's north pole - at the requested epoch. The pole direction is determined from - rotational elements loaded via a PCK file. - - The result returned by this routine will depend on the - ephemeris data and rotational elements used. The result may - differ from that given in any particular version of the - Astronomical Almanac, due to differences in these input data, - and due to differences in precision of the computations. - --Examples - - 1) A simple program that computes L_s for a body and time - supplied interactively. The geometric state of the sun is - used. - - #include - #include "SpiceUsr.h" - - int main() - { - #define ABCORR "NONE" - #define FILSIZ 256 - #define NAMLEN 37 - #define TIMLEN 41 - #define ABCORR "NONE" - - SpiceChar body [ NAMLEN ]; - SpiceChar lsk [ FILSIZ ]; - SpiceChar pck [ FILSIZ ]; - SpiceChar spk [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble et; - SpiceDouble lon; - - prompt_c ( "Enter name of leapseconds kernel > ", FILSIZ, lsk ); - prompt_c ( "Enter name of PCK file > ", FILSIZ, pck ); - prompt_c ( "Enter name of SPK file > ", FILSIZ, spk ); - - furnsh_c ( spk ); - furnsh_c ( lsk ); - furnsh_c ( pck ); - - printf ( "\n" - "Kernels have been loaded.\n" - "\n" ); - - while ( SPICETRUE ) - { - prompt_c ( "Enter name of central body > ", - NAMLEN, - body ); - prompt_c ( "Enter calendar, JD, or DOY time > ", - TIMLEN, - timstr ); - - str2et_c ( timstr, &et ); - - /. - Convert longitude to degrees. - ./ - lon = dpr_c() * lspcn_c ( body, et, ABCORR ); - - printf ( "\n" - "Central body = %s\n" - "Time = %s\n" - "Planetocentric L_s (deg.) = %f\n" - "\n", - body, - timstr, - lon ); - } - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - [1] "The Astronomical Almanac for the Year 2005." U.S. Government - Printing Office, Washington, D.C., 1984, page L9. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 06-JAN-2005 (NJB) - --Index_Entries - - planetocentric longitude of sun - compute L_s - compute Ls - compute L_sub_s - --& -*/ - -{ /* Begin lspcn_c */ - - /* - Local variables - */ - SpiceDouble retval; - - - /* - Give the function an initial value: - */ - retval = 0.0; - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( retval ); - } - chkin_c ( "lspcn_c" ); - - /* - Check the input string body to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "lspcn_c", body, retval ); - - /* - Call the f2c'd Fortran routine. - */ - retval = lspcn_ ( ( char * ) body, - ( doublereal * ) &et, - ( char * ) abcorr, - ( ftnlen ) strlen(body), - ( ftnlen ) strlen(abcorr) ); - - chkout_c ( "lspcn_c" ); - - return ( retval ); - -} /* End lspcn_c */ diff --git a/ext/spice/src/cspice/lstcld.c b/ext/spice/src/cspice/lstcld.c deleted file mode 100644 index 8799efcf0f..0000000000 --- a/ext/spice/src/cspice/lstcld.c +++ /dev/null @@ -1,247 +0,0 @@ -/* lstcld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTCLD ( Last closest double precision array element ) */ -integer lstcld_(doublereal *x, integer *n, doublereal *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer j, begin, items, middle, end; - -/* $ Abstract */ - -/* Given a number X and an array of non-decreasing numbers, find */ -/* the index of the array element whose value is closest to X. */ - -/* $ 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 */ - -/* ARRAY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I Search value. */ -/* N I Number of elements in ARRAY. */ -/* ARRAY I Array to be searched. */ - -/* The function returns the index of the element of ARRAY */ -/* whose value is closest to X. */ - -/* $ Detailed_Input */ - -/* X is the value to be compared with the elements of ARRAY. */ - -/* N is the number of elements in ARRAY. */ - -/* ARRAY is an array of double precision numbers such that */ - -/* ARRAY( I ) <= ARRAY( J ) */ - -/* for all I < J. */ - -/* $ Detailed_Output */ - -/* LSTCLD is the index of the element of the non-decreasing */ -/* sequence: {ARRAY(I) : 1 <= I <= N} that is closest */ -/* to X. In other words, ARRAY( LSTCLD( X, N, ARRAY ) ) */ -/* is the element of ARRAY whose value is closest to X. */ - -/* If X falls precisely on the midpoint of consecutive array */ -/* elements, the index of the larger of the two values is */ -/* returned. */ - -/* If X is closest to a value which appears more than */ -/* once in the array (since the array is ordered, these */ -/* elements would have to be consecutive), the highest index */ -/* for that value will be returned. */ - -/* LSTCLD = I for some I in the range 1 to N, unless N is */ -/* less than or equal to zero, in which case LSTCLD is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* LSTCLD uses a binary search algorithm to locate the value closest */ -/* to X in the non-decreasing sequence of double precision numbers */ -/* represented by the elements of ARRAY. */ - -/* $ Examples */ - -/* Suppose ARRAY contains the following double precision elements: */ - -/* ARRAY: -1 0 1 1.5 1.5 2 3 9 9.5 100 */ - -/* index: 1 2 3 4 5 6 7 8 9 10 */ - -/* The following table shows the values of LSTCLD that would be */ -/* returned for various values of X, and the corresponding closest */ -/* array element values. */ - -/* X LSTCLD( X,10,ARRAY ) ARRAY( LSTCLD( X,10,ARRAY )) */ -/* ----- -------------------- --------------------------- */ -/* 0.12 2 0 */ -/* -0.12 2 0 */ -/* -2.0 1 -1 */ -/* 2.5 7 3 */ -/* 1.3 5 1.5 */ -/* 100.0 10 100 */ -/* 100.1 10 100 */ - -/* $ Restrictions */ - -/* If the sequence is not non-decreasing, the routine will run */ -/* to completion but the index found will not mean anything. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the value of N is non-positive, LSTCLD returns the value */ -/* zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* M.J. Spencer (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ 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, 07-SEP-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* last closest d.p. array element */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 30-AUG-1990 (MJS) */ - -/* The following changes were made as a result of the */ -/* NAIF CK Code and Documentation Review: */ - -/* 1) The name of this routine was changed from CLOSTD to */ -/* LSTCLD because it was a more descriptive name. */ -/* 2) All references (comments and code) were changed to reflect */ -/* the name change. */ - -/* - Beta Version 1.0.0, 15-MAY-1990 (RET) */ - -/* -& */ - -/* Local variables */ - - -/* Save the size of the array and point to the beginning and ending */ -/* positions. The pointers delimit the current search interval. */ - - items = *n; - begin = 1; - end = *n; - if (*n <= 0) { - -/* There is nothing in the array to compare against. Zero is the */ -/* only sensible thing to return. */ - - ret_val = 0; - return ret_val; - } else if (*x <= array[begin - 1]) { - -/* All elements of the array are at least as big as X. So the */ -/* first element is the closest to X. */ - - ret_val = 1; - } else if (array[end - 1] <= *x) { - -/* X is at least as big as all elements of the array. So the last */ -/* element is the closest to X. */ - - ret_val = end; - } else { - -/* X lies between some pair of elements of the array. */ - - while(items > 2) { - j = items / 2; - middle = begin + j; - if (array[middle - 1] < *x) { - begin = middle; - } else { - end = middle; - } - items = end - begin + 1; - } - -/* Which of the two is closest? */ - - if (*x - array[begin - 1] < array[end - 1] - *x) { - ret_val = begin; - } else { - ret_val = end; - } - } - -/* March down the array to find the last element equal to the */ -/* closet value. */ - - while(ret_val < *n && array[ret_val - 1] == array[ret_val]) { - ++ret_val; - } - return ret_val; -} /* lstcld_ */ - diff --git a/ext/spice/src/cspice/lstcli.c b/ext/spice/src/cspice/lstcli.c deleted file mode 100644 index 514f7a8136..0000000000 --- a/ext/spice/src/cspice/lstcli.c +++ /dev/null @@ -1,232 +0,0 @@ -/* lstcli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTCLI ( Closest integer array element ) */ -integer lstcli_(integer *x, integer *n, integer *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer j, begin, items, middle, end; - -/* $ Abstract */ - -/* Given a number X and an array of non-decreasing integers, find */ -/* the index of the array element whose value is closest to X. */ - -/* $ 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 */ - -/* ARRAY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I Search value. */ -/* N I Number of elements in ARRAY. */ -/* ARRAY I Array to be searched. */ - -/* The function returns the index of the element of ARRAY */ -/* whose value is closest to X. */ - -/* $ Detailed_Input */ - -/* X is the value to be compared with the elements of ARRAY. */ - -/* N is the number of elements in ARRAY. */ - -/* ARRAY is an array of integers such that */ - -/* ARRAY( I ) <= ARRAY( J ) */ - -/* for all I < J. */ - -/* $ Detailed_Output */ - -/* LSTCLI is the index of the element of the non-decreasing */ -/* sequence: {ARRAY(I) : 1 <= I <= N} that is closest to */ -/* X. In other words, ARRAY( LSTCLI( X, N, ARRAY ) ) is the */ -/* closest element of ARRAY to X. */ - -/* If X falls precisely on the midpoint of consecutive array */ -/* elements, the index of the larger of the two values is */ -/* returned. */ - -/* If X is closest to a value which appears more than */ -/* once in the array (since the array is ordered, these */ -/* elements would have to be consecutive), the highest index */ -/* for that value will be returned. */ - -/* LSTCLI = I for some I in the range 1 to N, unless N is */ -/* less than or equal to zero, in which case LSTCLI is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* LSTCLI uses a binary search algorithm to locate the value closest */ -/* to X in the non-decreasing sequence of integers represented by */ -/* the elements of ARRAY. */ - -/* $ Examples */ - -/* Suppose ARRAY contains the following integer elements: */ - -/* ARRAY: -1 0 10 15 15 20 30 39 40 10 */ - -/* index: 1 2 3 4 5 6 7 8 9 10 */ - -/* The following table shows the values of LSTCLI that would be */ -/* returned for various values of X, and the corresponding closest */ -/* array element values. */ - -/* X LSTCLI( X,10,ARRAY ) ARRAY( LSTCLI( X,10,ARRAY )) */ -/* ----- -------------------- --------------------------- */ -/* -2 1 -1 */ -/* -1 1 -1 */ -/* 1 2 0 */ -/* 14 5 15 */ -/* 17 5 15 */ -/* 18 6 20 */ -/* 60 9 40 */ -/* 110 10 100 */ - -/* $ Restrictions */ - -/* If the sequence is not non-decreasing, the routine will run */ -/* to completion but the index found will not mean anything. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the value of N is non-positive, LSTCLI returns the value */ -/* zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (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, 07-SEP-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* closest integer array element */ - -/* -& */ - -/* Local variables */ - - -/* Save the size of the array and point to the beginning and ending */ -/* positions. The pointers delimit the current search interval. */ - - items = *n; - begin = 1; - end = *n; - if (*n <= 0) { - -/* There is nothing in the array to compare against. Zero is the */ -/* only sensible thing to return. */ - - ret_val = 0; - return ret_val; - } else if (*x <= array[begin - 1]) { - -/* All elements of the array are at least as big as X. So the */ -/* first element is the closest to X. */ - - ret_val = 1; - } else if (array[end - 1] <= *x) { - -/* X is at least as big as all elements of the array. So the last */ -/* element is the closest to X. */ - - ret_val = end; - } else { - -/* X lies between some pair of elements of the array. */ - - while(items > 2) { - j = items / 2; - middle = begin + j; - if (array[middle - 1] <= *x) { - begin = middle; - } else { - end = middle; - } - items = end - begin + 1; - } - -/* Which of the two is closest? */ - - if (*x - array[begin - 1] < array[end - 1] - *x) { - ret_val = begin; - } else { - ret_val = end; - } - } - -/* March down the array to find the last element equal to the */ -/* closet value. */ - - while(ret_val < *n && array[ret_val - 1] == array[ret_val]) { - ++ret_val; - } - return ret_val; -} /* lstcli_ */ - diff --git a/ext/spice/src/cspice/lstlec.c b/ext/spice/src/cspice/lstlec.c deleted file mode 100644 index 31841d8a5a..0000000000 --- a/ext/spice/src/cspice/lstlec.c +++ /dev/null @@ -1,267 +0,0 @@ -/* lstlec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $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_ */ - diff --git a/ext/spice/src/cspice/lstlec_c.c b/ext/spice/src/cspice/lstlec_c.c deleted file mode 100644 index 42b7d613a5..0000000000 --- a/ext/spice/src/cspice/lstlec_c.c +++ /dev/null @@ -1,322 +0,0 @@ -/* - --Procedure lstlec_c ( Last character element less than or equal to. ) - --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 - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "f2cMang.h" - #undef lstlec_c - - SpiceInt lstlec_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 or equal to string. - --Detailed_Input - - string is a string acting as an upper bound: the array element - that is lexically the greatest element less than or - equal to 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 less than or equal to string. The routine assumes - the array elements are sorted in non-decreasing order. - - If all elements of the input array are greater than 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 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 - - lstlec_c ( "NEWTON", 5, lenvals, array ) == 4 - lstlec_c ( "EINSTEIN", 5, lenvals, array ) == 1 - lstlec_c ( "GALILEO", 5, lenvals, array ) == 3 - lstlec_c ( "Galileo", 5, lenvals, array ) == 3 - lstlec_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.0.0, 22-JUL-2002 (NJB) (HAN) (WLT) - --Index_Entries - - last character element less_than_or_equal_to - --& -*/ - -{ /* Begin lstlec_c */ - - - /* - f2c library utility prototypes - */ - logical l_ge (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, "lstlec_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, "lstlec_c", array, lenvals, -1 ); - - - /* - Return if none of the array's elements are less than or equal to - the key value. - */ - keylen = strlen(string); - - begin = 0; - end = n - 1; - - if ( l_lt( ( char * )string, - ( char * )ARRAY(begin), - ( ftnlen )keylen, - ( ftnlen )strlen(ARRAY(begin)) ) ) - { - return ( -1 ); - } - - - /* - Return if the key string is greater than or equal to - all of the array's elements. - */ - if ( l_ge( ( 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 or equal to the first element - of array and strictly less than 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_le ( (char * ) ARRAY(middle), - (char * ) string, - (ftnlen ) lenvals-1, - (ftnlen ) keylen ) ) - { - /* - The middle element is less than or equal to string. - */ - begin = middle; - } - else - { - end = middle; - } - - items = end - begin + 1; - - /* - At this point, string is greater than or equal to the array element - at index begin and strictly less than the element at index end. - */ - } - - /* - The element at index begin is the winner. - */ - return ( begin ); - - -} /* End lstlec_c */ diff --git a/ext/spice/src/cspice/lstled.c b/ext/spice/src/cspice/lstled.c deleted file mode 100644 index c3d83a615a..0000000000 --- a/ext/spice/src/cspice/lstled.c +++ /dev/null @@ -1,227 +0,0 @@ -/* lstled.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTLED ( Last double precision element less than or equal) */ -integer lstled_(doublereal *x, integer *n, doublereal *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer j, begin, items, middle, end; - -/* $ Abstract */ - -/* Given a number X and an array of non-decreasing numbers, */ -/* find the index of the largest array element less than or equal */ -/* to X. */ - -/* $ 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 */ -/* -------- --- -------------------------------------------------- */ -/* X I Value to search against */ -/* ARRAY I Array of possible lower bounds */ -/* N I Number elements in ARRAY */ -/* LSTLED O the index of the last element of ARRAY <= X */ - -/* $ Detailed_Input */ - -/* X Double precision number for which one desires to find */ -/* the last ARRAY element less than or equal to X. */ - -/* ARRAY Array of double precision numbers that forms a */ -/* non-decreasing sequence. We will find the last element */ -/* of the sequence that is less than or equal to X. */ - -/* N Total number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* LSTLED Index of the last element of the non-decreasing sequence: */ -/* {ARRAY(I) : 0 < I < N + 1} that is less than or equal */ -/* to X. (Note that LSTLED = I for some I in the range 1 to */ -/* N unless X is less than all of these elements in which */ -/* case LSTLED = 0.) */ - -/* In the case that N is input with value less than or equal */ -/* to zero, LSTLED is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - - -/* An array of double precision numbers is given. The array */ -/* ARRAY(I) (0 < I < N ) forms a non-decreasing sequence of */ -/* numbers. Given a real number X, there will be a last one of */ -/* these numbers that is less than or equal to X. This routine */ -/* finds the index LSTLED such that ARRAY(LSTLED) is that number. */ - -/* If X is not greater than ARRAY(1), INDEX will be set to zero. */ - - -/* Note: If you need to find the first element of the array that */ -/* is greater than X, 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 */ - -/* If ARRAY(I) = -1 + 4*I/3 (real arithmetic implied here) */ - -/* N = 10 */ -/* X = 7.12 */ - -/* then */ - -/* LSTLED will be I where */ -/* (4*I/3) - 1 < or = 7.12 */ -/* but */ -/* (4*(I+1)/3) - 1 > 7.12 . */ - -/* In this case our subsequence is: */ -/* 1/3, 5/3, 9/3, 13/3, 17/3, 21/3, 25/3, .... 37/3 */ - -/* index: 1 2 3 4 5 6 7 .... 10 */ - -/* Thus LSTLED will be returned as 6 */ - -/* The following table shows the values of LSTLED that would be */ -/* returned for various values of X */ - -/* X LSTLED */ -/* ----- ------- */ -/* 0.12 0 */ -/* 1.34 1 */ -/* 5.13 4 */ -/* 8.00 6 */ -/* 15.10 10 */ - -/* $ Restrictions */ - -/* If the sequence does not non-decreasing, the program will run */ -/* to completion but the index found will not mean anything. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (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 d.p. element less_than_or_equal_to */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (NJB) */ - -/* Declaration of unused variable I removed. */ - -/* -& */ - -/* 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 (*x < array[begin - 1]) { - -/* None of the array elements are less than or equal to X */ - - ret_val = 0; - } else if (*x >= array[end - 1]) { - -/* X 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 X. */ - - ret_val = end; - } else { - -/* X lies between some pair of elements of the array */ - - while(items > 2) { - j = items / 2; - middle = begin + j; - if (array[middle - 1] <= *x) { - begin = middle; - } else { - end = middle; - } - items = end - begin + 1; - } - ret_val = begin; - } - return ret_val; -} /* lstled_ */ - diff --git a/ext/spice/src/cspice/lstled_c.c b/ext/spice/src/cspice/lstled_c.c deleted file mode 100644 index 3fe7cd5152..0000000000 --- a/ext/spice/src/cspice/lstled_c.c +++ /dev/null @@ -1,178 +0,0 @@ -/* - --Procedure lstled_c ( Last double precision element less than or equal) - --Abstract - - Given a number x and an array of non-decreasing numbers, - find the index of the largest array element less than or equal - to x. - --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 - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef lstled_c - - SpiceInt lstled_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - x I Value to search against - n I Number elements in array - array I Array of possible lower bounds - - The function returns the index of the last element of array that - is less than or equal to x. - --Detailed_Input - - x Double precision number. - - n Total number of elements in array. - - array Array of double precision numbers which forms a - non-decreasing sequence. 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 less than or equal to x. The routine assumes - the array elements are sorted in non-decreasing order. - - Indices range from 0 to n-1. - - If all elements of the input array are greater than x, the function - returns -1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) In the case that n is input with value less than or equal - to zero, the function returns -1. - - 2) If the input array is not sorted in increasing order, the - output of this routine are undefined. No error is signaled. - --Files - - None. - --Particulars - - Note: If you need to find the first element of the array that - is greater than x, 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 - - 1) Let array be assigned the following values: - - array[0] = -2.0; - array[1] = -2.0; - array[2] = 0.0; - array[3] = 1.0; - array[4] = 1.0; - array[5] = 11.0; - - - The table below demonstrates the behavior of lstled_c: - - Call Returned Value - =========================== ============== - lstled_c ( -3.0, 6, array ) -1 - - lstled_c ( -2.0, 6, array ) 1 - - lstled_c ( 0.0, 6, array ) 2 - - lstled_c ( 1.0, 6, array ) 4 - - lstled_c ( 11.1, 6, array ) 5 - - --Restrictions - - If the sequence of elements in array is not non-decreasing, - the program will run to completion but the index found will - not mean anything. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 09-JUL-2002 (NJB) (WLT) - --Index_Entries - - last d.p. element less_than_or_equal_to - --& -*/ - -{ /* Begin lstled_c */ - - - /* - Map the index returned by the f2c'd routine to the range 0 : n-1. - The return value -1 indicates "not found." - */ - - return ( (SpiceInt) lstled_ ( (doublereal *) &x, - (integer *) &n, - (doublereal *) array ) - 1 ); - -} /* End lstled_c */ diff --git a/ext/spice/src/cspice/lstlei.c b/ext/spice/src/cspice/lstlei.c deleted file mode 100644 index b788911e83..0000000000 --- a/ext/spice/src/cspice/lstlei.c +++ /dev/null @@ -1,307 +0,0 @@ -/* lstlei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTLEI ( Last integer element less than or equal to ) */ -integer lstlei_(integer *x, integer *n, integer *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer j, begin, items, middle, end; - -/* $ Abstract */ - -/* Given a number X and an array of non-decreasing numbers, */ -/* find the index of the largest array element less than or equal */ -/* to X. */ - -/* $ 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 */ -/* -------- --- -------------------------------------------------- */ -/* X I Value to search against. */ -/* ARRAY I Array of possible lower bounds. */ -/* N I Number elements in ARRAY. */ -/* LSTLEI O the index of the last element of ARRAY <= X. */ - -/* $ Detailed_Input */ - -/* X Integer for which one desires to find */ -/* the last ARRAY element less than or equal to X. */ - -/* ARRAY Array of integers that forms a */ -/* non-decreasing sequence. We will find the last element */ -/* of the sequence that is less than or equal to X. */ - -/* N Total number of elements in ARRAY */ - -/* $ Detailed_Output */ - -/* LSTLEI Index of the last element of the non-decreasing sequence: */ -/* {ARRAY(I) : 0 < I < N + 1} that is less than or equal */ -/* to X. (Note that LSTLEI = I for some I in the range 1 to */ -/* N unless X is less than all of these elements in which */ -/* case LSTLEI = 0.) */ - -/* In the case that N is input with value less than or equal */ -/* to zero, LSTLEI is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - - -/* An array of integers is given. The array */ -/* ARRAY(I) (0 < I < N ) forms a non-decreasing sequence of */ -/* numbers. Given a real number X, there will be a last one of */ -/* these numbers that is less than or equal to X. This routine */ -/* finds the index LSTLEI such that ARRAY(LSTLEI) is that number. */ - -/* If X is not greater than ARRAY(1), INDEX 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 LSTLEI. */ - -/* Note: If you need to find the first element of the array that */ -/* is greater than X, 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 an reasonably large ordered array of */ -/* integers, into which you want to insert a few more without */ -/* destroying the ordering. */ - -/* Depending upon your application, it may be desirable to */ -/* not insert duplicates, to insert duplicates before */ -/* existing entries or to insert them after existing entries. */ - -/* The code fragment below, illustrates an insertion scheme */ -/* that will insert duplicate items after existing items */ -/* and simultaneously update a second parallel array of */ -/* double precision numbers. */ - -/* get the pair to insert */ - -/* READ (*,*) KEY, VALUE */ - -/* locate the place to insert the new KEY into the sorted */ -/* array of keys. */ - -/* LOC = LSTLEI ( KEY, NKEYS, KEYS ) + 1 */ - -/* insert the key and its associated value into the */ -/* KEYS and VALUES arrays at location LOC */ - -/* CALL INSLAI ( KEY, 1, LOC, NKEYS, KEYS ) */ -/* CALL INSLAD ( VALUE, 1, LOC, NVALS, VALUES ) */ - -/* If at the READ statement the arrays KEYS and VALUES looked like: */ - -/* KEYS VALUES NKEYS = 6, NVALS = 6 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 3.14D0 */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - -/* and 9 and 33.33D3 were read into KEY and VALUE respectively */ -/* then LSTLEI (KEY, NKEYS, KEYS ) would be 3 and LOC would be 4. */ -/* After the calls to the routines INSLAI and INSLAD we would have */ - -/* KEYS VALUES NKEYS = 7, NVALS = 7 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 3.14D0 */ -/* 9 33.33D3 <===== inserted items. */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - -/* If 7 and 33.33D3 were read into KEY and VALUE respectively */ -/* then again LSTLEI (KEY, NKEYS, KEYS ) would be 3 and LOC would */ -/* be 4. After the calls to the routines INSLAI and INSLAD we */ -/* would have: */ - -/* KEYS VALUES NKEYS = 7, NVALS = 7 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 3.14D0 */ -/* 7 33.33D3 <===== inserted items. */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - -/* If we replaced the line of code */ - -/* LOC = LSTLEI ( KEY, NKEYS, KEYS ) + 1 */ -/* by */ - -/* LOC = LSTLTI ( KEY, NKEYS, KEYS ) + 1 */ - -/* we would obtain a routine that inserted duplicates before */ -/* existing entries. (LSTLTI is similar to LSTLEI except it finds */ -/* the last occurrance of an integer strictly less than a value.) */ -/* Using 7 and 33.33D3 for KEY and VALUE again, the modified code */ -/* fragment would yield the results shown below. */ - -/* KEYS VALUES NKEYS = 7, NVALS = 7 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 33.33D3 <===== inserted items. */ -/* 7 3.14D0 */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - - -/* (Note: you should NOT use the */ -/* code outlined above as the basis of a sorting algorithm. */ -/* The NAIF routines SHELLI, SHELLD, SHELLC, ORDERI, ORDERD, ORDERC, */ -/* REORDI, REORDD and REORDC are much more efficient routines for */ -/* sorting arrays or sorting a set of parallel arrays using */ -/* one of the set as a key. The fragment presented here is useful */ -/* for performing update insertions into previously ordered arrays.) */ - -/* For more ideas regarding the use of this routine, see LSTLEC */ -/* and LSTLTC. */ - -/* $ Restrictions */ - -/* If the sequence does not non-decreasing, 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 integer 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 (*x < array[begin - 1]) { - -/* None of the array elements are less than or equal to X */ - - ret_val = 0; - } else if (*x >= array[end - 1]) { - -/* X 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 X. */ - - ret_val = end; - } else { - -/* X lies between some pair of elements of the array */ - - while(items > 2) { - j = items / 2; - middle = begin + j; - if (array[middle - 1] <= *x) { - begin = middle; - } else { - end = middle; - } - items = end - begin + 1; - } - ret_val = begin; - } - return ret_val; -} /* lstlei_ */ - diff --git a/ext/spice/src/cspice/lstlei_c.c b/ext/spice/src/cspice/lstlei_c.c deleted file mode 100644 index 51ee6b3c3a..0000000000 --- a/ext/spice/src/cspice/lstlei_c.c +++ /dev/null @@ -1,178 +0,0 @@ -/* - --Procedure lstlei_c ( Last integer element less than or equal) - --Abstract - - Given a number x and an array of non-decreasing numbers, - find the index of the largest array element less than or equal - to x. - --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 - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef lstlei_c - - SpiceInt lstlei_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - x I Value to search against - n I Number elements in array - array I Array of possible lower bounds - - The function returns the index of the last element of array that - is less than or equal to x. - --Detailed_Input - - x Integer. - - n Total number of elements in array. - - array Array of integers which forms a non-decreasing sequence. - 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 less than or equal to x. The routine assumes - the array elements are sorted in non-decreasing order. - - Indices range from 0 to n-1. - - If all elements of array are greater than x, this routine returns - the value -1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) In the case that n is input with value less than or equal - to zero, the function returns -1. - - 2) If the input array is not sorted in increasing order, the - output of this routine are undefined. No error is signaled. - --Files - - None. - --Particulars - - Note: If you need to find the first element of the array that - is greater than x, 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 - - 1) Let array be assigned the following values: - - array[0] = -2; - array[1] = -2; - array[2] = 0; - array[3] = 1; - array[4] = 1; - array[5] = 11; - - - The table below demonstrates the behavior of lstlei_c: - - Call Returned Value - ========================= ============== - lstlei_c ( -3, 6, array ) -1 - - lstlei_c ( -2, 6, array ) 1 - - lstlei_c ( 0, 6, array ) 2 - - lstlei_c ( 1, 6, array ) 4 - - lstlei_c ( 12, 6, array ) 5 - - --Restrictions - - If the sequence of elements in array is not non-decreasing, - the program will run to completion but the index found will - not mean anything. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) - --Index_Entries - - last integer element less_than_or_equal_to - --& -*/ - -{ /* Begin lstlei_c */ - - - /* - Map the index returned by the f2c'd routine to the range 0 : n-1. - The return value -1 indicates "not found." - */ - - return ( (SpiceInt) lstlei_ ( (integer *) &x, - (integer *) &n, - (integer *) array ) - 1 ); - -} /* End lstlei_c */ diff --git a/ext/spice/src/cspice/lstltc.c b/ext/spice/src/cspice/lstltc.c deleted file mode 100644 index 24d70a1b8a..0000000000 --- a/ext/spice/src/cspice/lstltc.c +++ /dev/null @@ -1,264 +0,0 @@ -/* lstltc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTLTC ( Last character element less than ) */ -integer lstltc_(char *string, integer *n, char *array, ftnlen string_len, - ftnlen array_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - logical l_le(char *, char *, ftnlen, ftnlen), l_lt(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 */ -/* 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. */ -/* LSTLTC 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 STRING. */ - -/* N Total number of elements in ARRAY. */ - -/* ARRAY Ordered array of character strings. */ -/* We will find the last element */ -/* of the sequence that is less than STRING. */ - -/* $ Detailed_Output */ - -/* LSTLTC Index of the last element of the ordered array: */ -/* {ARRAY(I) : 0 < I < N + 1} that is less than STRING. */ -/* (Note that LSTLTC = I for some I in the range 1 to */ -/* N unless STRING is less than or equal to all of these */ -/* elements, in which case LSTLTC = 0.) */ - -/* In the case that N is input with value less than or equal */ -/* to zero, LSTLTC is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - - -/* An ordered array of character strings is given. */ -/* Given a real number STRING, there will be a last one of */ -/* these that is less than STRING. This routine */ -/* finds the index LSTLTC such that ARRAY(LSTLTC) is that string. */ - -/* If STRING is not greater than ARRAY(1), LSTLTC 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 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 */ - -/* 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 = LSTLTC( 'PLA', NWORDS, WORDS ) + 1 */ -/* END = LSTLTC( 'PLB', 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 */ - -/* -& */ -/* $ 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_le(string, array + (begin - 1) * array_len, string_len, - array_len)) { - -/* None of the array elements are less than STRING */ - - ret_val = 0; - } else if (l_lt(array + (end - 1) * array_len, string, array_len, - string_len)) { - -/* STRING is greater than all elements of the array. Thus the las */ -/* element of the array is the last item less than 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_lt(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; -} /* lstltc_ */ - diff --git a/ext/spice/src/cspice/lstltc_c.c b/ext/spice/src/cspice/lstltc_c.c deleted file mode 100644 index 207a581a03..0000000000 --- a/ext/spice/src/cspice/lstltc_c.c +++ /dev/null @@ -1,325 +0,0 @@ -/* - --Procedure lstltc_c ( Last character element less than ) - --Abstract - - Given a character string and an ordered array of character - strings, find the index of the largest array element less than - 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 - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "f2cMang.h" - #undef lstltc_c - - 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 */ diff --git a/ext/spice/src/cspice/lstltd.c b/ext/spice/src/cspice/lstltd.c deleted file mode 100644 index a12f7cb122..0000000000 --- a/ext/spice/src/cspice/lstltd.c +++ /dev/null @@ -1,224 +0,0 @@ -/* lstltd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTLTD ( Last double precision element less than ) */ -integer lstltd_(doublereal *x, integer *n, doublereal *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer j, begin, items, middle, end; - -/* $ Abstract */ - -/* Given a number X and an array of non-decreasing numbers, */ -/* find the index of the largest array element less than X. */ - -/* $ 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 */ -/* -------- --- -------------------------------------------------- */ -/* X I Value to search against. */ -/* ARRAY I Array of possible lower bounds. */ -/* N I Number elements in ARRAY. */ -/* LSTLTD O the index of the last element of ARRAY < X. */ - -/* $ Detailed_Input */ - -/* X Double precision number for which one desires to find */ -/* the last ARRAY element less than X. */ - -/* N Total number of elements in ARRAY. */ - -/* ARRAY Array of double precision numbers that forms a */ -/* non-decreasing sequence. We will find the last element */ -/* of the sequence that is less than X. */ - -/* $ Detailed_Output */ - -/* LSTLTD Index of the last element of the non-decreasing sequence: */ -/* {ARRAY(I) : 0 < I < N + 1} that is less than X. */ -/* (Note that LSTLTD = I for some I in the range 1 to */ -/* N unless X is less than or equal to all of these */ -/* elements, in which case LSTLTD = 0.) */ - -/* In the case that N is input with value less than or equal */ -/* to zero, LSTLTD is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - - -/* An array of double precision numbers is given. The array */ -/* ARRAY(I) (0 < I < N+1 ) forms a non-decreasing sequence of */ -/* numbers. Given a real number X, there will be a last one of */ -/* these numbers that is less than X. This routine */ -/* finds the index LSTLTD such that ARRAY(LSTLTD) is that number. */ - -/* If X is not greater than ARRAY(1), INDEX will be set to zero. */ - -/* Note: If you need to find the first element of the array that */ -/* is greater than or equal to X, 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 */ - -/* If ARRAY(I) = -1 + 4*I/3 (real arithmetic implied here) */ - -/* N = 10 */ -/* X = 7.12 */ - -/* then */ - -/* LSTLTD will be I where */ -/* (4*I/3) - 1 < 7.12 */ -/* but */ -/* (4*(I+1)/3) - 1 > or = 7.12 . */ - -/* In this case our subsequence is: */ -/* 1/3, 5/3, 9/3, 13/3, 17/3, 21/3, 25/3, .... 37/3 */ - -/* index: 1 2 3 4 5 6 7 .... 10 */ - -/* Thus LSTLTD will be returned as 6 */ - -/* The following table shows the values of LSTLTD that would be */ -/* returned for various values of X */ - -/* X LSTLTD */ -/* ----- ------- */ -/* 0.12 0 */ -/* 1.34 1 */ -/* 5.13 4 */ -/* 8.00 6 */ -/* 15.10 10 */ - -/* $ Restrictions */ - -/* If the sequence is not non-decreasing, the program will run */ -/* to completion but the index found will not mean anything. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (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 d.p. element less_than */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (NJB) */ - -/* Declaration of unused variable I removed. */ - -/* -& */ - -/* 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 (*x <= array[begin - 1]) { - -/* None of the array elements are less than X */ - - ret_val = 0; - } else if (array[end - 1] < *x) { - -/* X is greater than all elements of the array. Thus the last */ -/* element of the array is the last item less than X. */ - - ret_val = end; - } else { - -/* X lies between some pair of elements of the array */ - - while(items > 2) { - j = items / 2; - middle = begin + j; - if (array[middle - 1] < *x) { - begin = middle; - } else { - end = middle; - } - items = end - begin + 1; - } - ret_val = begin; - } - return ret_val; -} /* lstltd_ */ - diff --git a/ext/spice/src/cspice/lstltd_c.c b/ext/spice/src/cspice/lstltd_c.c deleted file mode 100644 index d84364e5ce..0000000000 --- a/ext/spice/src/cspice/lstltd_c.c +++ /dev/null @@ -1,178 +0,0 @@ -/* - --Procedure lstltd_c ( Last double precision element less than) - --Abstract - - Given a number x and an array of non-decreasing numbers, - find the index of the largest array element less than x. - --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 - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef lstltd_c - - SpiceInt lstltd_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - x I Value to search against - n I Number elements in array - array I Array of possible lower bounds - - The function returns the index of the last element of array that - is less than x. - --Detailed_Input - - x Double precision number. - - n Total number of elements in array. - - array Array of double precision numbers which forms a - non-decreasing sequence. 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 less than x. The routine assumes the array elements - are sorted in non-decreasing order. - - Indices range from 0 to n-1. - - If all elements of the input array are greater than or equal to x, - the function returns -1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) In the case that n is input with value less than or equal - to zero, the function returns -1. - - 2) If the input array is not sorted in increasing order, the - output of this routine are undefined. No error is signaled. - --Files - - None. - --Particulars - - Note: If you need to find the first element of the array that - is greater than or equal to x, 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 - - 1) Let array be assigned the following values: - - array[0] = -2.0; - array[1] = -2.0; - array[2] = 0.0; - array[3] = 1.0; - array[4] = 1.0; - array[5] = 11.0; - - - The table below demonstrates the behavior of lstltd_c: - - Call Returned Value - =========================== ============== - lstltd_c ( -3.0, 6, array ) -1 - - lstltd_c ( -2.0, 6, array ) -1 - - lstltd_c ( 0.0, 6, array ) 1 - - lstltd_c ( 1.0, 6, array ) 2 - - lstltd_c ( 11.1, 6, array ) 5 - - --Restrictions - - If the sequence of elements in array is not non-decreasing, - the program will run to completion but the index found will - not mean anything. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) - --Index_Entries - - last d.p. element less_than - --& -*/ - -{ /* Begin lstltd_c */ - - - /* - Map the index returned by the f2c'd routine to the range 0 : n-1. - The return value -1 indicates "not found." - */ - - return ( (SpiceInt) lstltd_ ( (doublereal *) &x, - (integer *) &n, - (doublereal *) array ) - 1 ); - -} /* End lstltd_c */ diff --git a/ext/spice/src/cspice/lstlti.c b/ext/spice/src/cspice/lstlti.c deleted file mode 100644 index 6bb5abe475..0000000000 --- a/ext/spice/src/cspice/lstlti.c +++ /dev/null @@ -1,305 +0,0 @@ -/* lstlti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LSTLTI ( Last integer element less than ) */ -integer lstlti_(integer *x, integer *n, integer *array) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer j, begin, items, middle, end; - -/* $ Abstract */ - -/* Given a number X and an array of non-decreasing numbers, */ -/* find the index of the largest array element less than X. */ - -/* $ 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 */ -/* -------- --- -------------------------------------------------- */ -/* X I Value to search against. */ -/* ARRAY I Array of possible lower bounds. */ -/* N I Number elements in ARRAY. */ -/* LSTLTI O the index of the last element of ARRAY < X. */ - -/* $ Detailed_Input */ - -/* X Integer for which one desires to find */ -/* the last ARRAY element less than X. */ - -/* N Total number of elements in ARRAY. */ - -/* ARRAY Array of integers that forms a */ -/* non-decreasing sequence. We will find the last element */ -/* of the sequence that is less than X. */ - -/* $ Detailed_Output */ - -/* LSTLTI Index of the last element of the non-decreasing sequence: */ -/* {ARRAY(I) : 0 < I < N + 1} that is less than X. */ -/* (Note that LSTLTI = I for some I in the range 1 to */ -/* N unless X is less than or equal to all of these */ -/* elements, in which case LSTLTI = 0.) */ - -/* In the case that N is input with value less than or equal */ -/* to zero, LSTLTI is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - - -/* An array of integers is given. The array */ -/* ARRAY(I) (0 < I < N+1 ) forms a non-decreasing sequence of */ -/* numbers. Given a real number X, there will be a last one of */ -/* these numbers that is less than X. This routine */ -/* finds the index LSTLTI such that ARRAY(LSTLTI) is that number. */ - -/* If X is not greater than ARRAY(1), INDEX 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 or equal to X, 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 an reasonably large ordered array of */ -/* integers, into which you want to insert a few more without */ -/* destroying the ordering. */ - -/* Depending upon your application, it may be desirable to */ -/* not insert duplicates, to insert duplicates before */ -/* existing entries or to insert them after existing entries. */ - -/* The code fragment below, illustrates an insertion scheme */ -/* that will insert duplicate items before existing items */ -/* and simultaneously update a second parallel array of */ -/* double precision numbers. */ - -/* get the pair to insert */ - -/* READ (*,*) KEY, VALUE */ - -/* locate the place to insert the new KEY into the sorted */ -/* array of keys. */ - -/* LOC = LSTLTI ( KEY, NKEYS, KEYS ) + 1 */ - -/* insert the key and its associated value into the */ -/* KEYS and VALUES arrays at location LOC */ - -/* CALL INSLAI ( KEY, 1, LOC, NKEYS, KEYS ) */ -/* CALL INSLAD ( VALUE, 1, LOC, NVALS, VALUES ) */ - -/* If at the READ statement the arrays KEYS and VALUES looked like: */ - -/* KEYS VALUES NKEYS = 6, NVALS = 6 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 3.14D0 */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - -/* and 9 and 33.33D3 were read into KEY and VALUE respectively */ -/* then LSTLEI (KEY, NKEYS, KEYS ) would be 3 and LOC would be 4. */ -/* After the calls to the routines INSLAI and INSLAD we would have */ - -/* KEYS VALUES NKEYS = 7, NVALS = 7 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 3.14D0 */ -/* 9 33.33D3 <===== inserted items. */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - -/* If 7 and 33.33D3 were read into KEY and VALUE respectively */ -/* then again LSTLEI (KEY, NKEYS, KEYS ) would be 2 and LOC would */ -/* be 3. After the calls to the routines INSLAI and INSLAD we */ -/* would have: */ - -/* KEYS VALUES NKEYS = 7, NVALS = 7 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 33.33D3 <===== inserted items. */ -/* 7 3.14D0 */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - -/* If we replaced the line of code */ - -/* LOC = LSTLTI ( KEY, NKEYS, KEYS ) + 1 */ -/* by */ - -/* LOC = LSTLEI ( KEY, NKEYS, KEYS ) + 1 */ - -/* we would obtain a routine that inserted duplicates before */ -/* existing entries. (LSTLEI is similar to LSTLTI except it finds */ -/* the last occurrance of an integer less than or equal to a value.) */ -/* Using 7 and 33.33D3 for KEY and VALUE again, the modified code */ -/* fragment would yield the results shown below. */ - -/* KEYS VALUES NKEYS = 7, NVALS = 7 */ -/* ---- ------- */ -/* 2 3.00D0 */ -/* 5 1.00D0 */ -/* 7 3.14D0 */ -/* 7 33.33D3 <===== inserted items. */ -/* 16 7.11D0 */ -/* 18 2.14D0 */ -/* 23 12.12D0 */ - - -/* Note: you should NOT use the code outlined above as the basis of */ -/* a sorting algorithm. The NAIF routines SHELLI, SHELLD, SHELLC, */ -/* ORDERI, ORDERD, ORDERC, REORDI, REORDD and REORDC are much more */ -/* efficient routines for sorting arrays or sorting a set of */ -/* parallel arrays using one of the set as a key. The fragment */ -/* presented here is useful for performing update insertions into */ -/* previously ordered arrays. */ - -/* For more ideas regarding the use of this routine, see LSTLEC */ -/* and LSTLTC */ - -/* $ Restrictions */ - -/* If the sequence is not non-decreasing, 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 integer element less_than */ - -/* -& */ -/* $ 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 (*x <= array[begin - 1]) { - -/* None of the array elements are less than X */ - - ret_val = 0; - } else if (array[end - 1] < *x) { - -/* X is greater than all elements of the array. Thus the last */ -/* element of the array is the last item less than X. */ - - ret_val = end; - } else { - -/* X lies between some pair of elements of the array */ - - while(items > 2) { - j = items / 2; - middle = begin + j; - if (array[middle - 1] < *x) { - begin = middle; - } else { - end = middle; - } - items = end - begin + 1; - } - ret_val = begin; - } - return ret_val; -} /* lstlti_ */ - diff --git a/ext/spice/src/cspice/lstlti_c.c b/ext/spice/src/cspice/lstlti_c.c deleted file mode 100644 index 61e9a374d4..0000000000 --- a/ext/spice/src/cspice/lstlti_c.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - --Procedure lstlti_c ( Last integer element less than ) - --Abstract - - Given a number x and an array of non-decreasing numbers, - find the index of the largest array element less than x. - --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 - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef lstlti_c - - - SpiceInt lstlti_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - x I Value to search against. - n I Number of elements in array. - array I Array of possible lower bounds. - - The function returns the index of the last element of array that is - less than x. - --Detailed_Input - - x is an integer serving as a key value. - - n is the total number of elements in array. - - array is an array of integers that forms a non-decreasing - sequence. - --Detailed_Output - - The function returns the index of the last element of the non-decreasing - sequence - - {array[i] : 0 <= i < n } - - that is less than x. Indices range from zero to n-1. - - If all elements of array are greater than or equal to x, this routine - returns the value -1. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - If n is less than or equal to zero, the function returns -1. This case - is not treated as an error. - --Particulars - - This routine uses a binary search algorithm and so requires - at most on the order of - - log (n) - 2 - - steps to compute the value of lstlti_c. - - Note: If you need to find the first element of the array that is greater - than or equal to x, 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 - - - 1) Let array be assigned the following values: - - array[0] = -2; - array[1] = -2; - array[2] = 0; - array[3] = 1; - array[4] = 1; - array[5] = 11; - - - The table below demonstrates the behavior of lstlti_c: - - Call Returned Value - ========================= ============== - lstlti_c ( -3, 6, array ) -1 - - lstlti_c ( -2, 6, array ) -1 - - lstlti_c ( 0, 6, array ) 1 - - lstlti_c ( 1, 6, array ) 2 - - lstlti_c ( 12, 6, array ) 5 - --Restrictions - - If the sequence in the input argument array is not non-decreasing, - the results of this routine are undefined. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 09-JUL-2002 (NJB) (HAN) (WLT) - --Index_Entries - - last integer element less_than_or_equal_to - --& -*/ - -{ /* Begin lstlti_c */ - - - return ( lstlti_ ( (integer *) &x, - (integer *) &n, - (integer *) array ) - 1 ); - -} /* End lstlti_c */ diff --git a/ext/spice/src/cspice/ltime.c b/ext/spice/src/cspice/ltime.c deleted file mode 100644 index d4e0c389f0..0000000000 --- a/ext/spice/src/cspice/ltime.c +++ /dev/null @@ -1,367 +0,0 @@ -/* ltime.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LTIME ( Light Time ) */ -/* Subroutine */ int ltime_(doublereal *etobs, integer *obs, char *dir, - integer *targ, doublereal *ettarg, doublereal *elapsd, ftnlen dir_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal sobs[6], myet, c__; - integer r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal starg[6]; - extern doublereal vdist_(doublereal *, doublereal *); - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - doublereal lt; - extern doublereal clight_(void); - integer bcentr; - extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* This routine computes the transmit (or receive) time */ -/* of a signal at a specified target, given the receive */ -/* (or transmit) time at a specified observer. The elapsed */ -/* time between transmit and receive is also returned. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ETOBS I Epoch of a signal at some observer */ -/* OBS I NAIF-id of some observer */ -/* DIR I Direction the signal travels ( '->' or '<-' ) */ -/* TARG I NAIF-id of the target object */ -/* ETTARG O Epoch of the signal at the target */ -/* ELAPSD O Time between transmit and receipt of the signal */ - -/* $ Detailed_Input */ - -/* ETOBS is an epoch expressed in ephemeris second (TDB) */ -/* past the epoch of the J2000 reference system. */ -/* This is the time at which an electromagnetic */ -/* signal is "at" the observer. */ - -/* OBS is the NAIF-id of some observer. */ - -/* DIR is the direction the signal travels. The */ -/* acceptable values are '->' and '<-'. When */ -/* you read the calling sequence from left to */ -/* right, the "arrow" given by DIR indicates */ -/* which way the electromagnetic signal is travelling. */ - -/* If the argument list reads as below, */ - -/* ..., OBS, '->', TARG, ... */ - -/* the signal is travelling from the observer to the */ -/* target. */ - -/* If the argument reads as */ - -/* ..., OBS, '<-', TARG */ - -/* the signal is travelling from the target to */ -/* the observer. */ - -/* TARG is the NAIF-id of the target. */ - -/* $ Detailed_Output */ - -/* ETTARG is the epoch expressed in ephemeris seconds (TDB) */ -/* past the epoch of the J2000 reference system */ -/* at which the electromagnetic signal is "at" the */ -/* target body. */ - -/* Note ETTARG is computed using only Newtonian */ -/* assumptions about the propagation of light. */ - -/* ELAPSD is the number of ephemeris seconds (TDB) between */ -/* transmission and receipt of the signal. */ - -/* ELAPSD = DABS( ETOBS - ETTARG ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If DIR is not one of '->' or '<-' the error */ -/* 'SPICE(BADDIRECTION)' will be signalled. In this case */ -/* ETTARG and ELAPSD will not be altered from their */ -/* input values. */ - -/* 2) If insufficient ephemeris information is available to */ -/* compute the outputs ETTARG and ELAPSD, or if observer */ -/* or target is not recognized, the problems is diagnosed */ -/* by a routine in the call tree of this routine. */ - -/* In this case, the value of ETTARG will be set to ETOBS */ -/* and ELAPSD will be set to zero. */ - -/* $ Particulars */ - - -/* Suppose a radio signal travels between two solar system */ -/* objects. Given an ephemeris for the two objects, which way */ -/* the signal is travelling, and the time when the signal is */ -/* "at" at one of the objects (the observer OBS), this routine */ -/* determines when the signal is "at" the other object (the */ -/* target TARG). It also returns the elapsed time between */ -/* transmission and receipt of the signal. */ - - -/* $ Examples */ - -/* Example 1. */ -/* ---------- */ -/* Suppose a signal is transmitted at time ET from the Goldstone */ -/* tracking site (id-code 399001) to a spacecraft whose id-code */ -/* is -77. */ - - -/* signal travelling to spacecraft */ -/* * -._.-._.-._.-._.-._.-._.-._.-._.-> * */ - -/* Goldstone (OBS=399001) Spacecraft (TARG = -77) */ -/* at epoch ETOBS(given) at epoch ETTARG(unknown) */ - -/* Assuming that all of the required SPICE kernels have been */ -/* loaded, the code fragment below shows how to compute the */ -/* time (ARRIVE) at which the signal arrives at the spacecraft */ -/* and how long (HOWLNG) it took the signal to reach the spacecraft. */ -/* (Note that we display the arrival time as the number of seconds */ -/* past J2000.) */ - -/* OBS = 399001 */ -/* TARG = -77 */ -/* ETOBS = ET */ - -/* CALL LTIME ( ETOBS, OBS, '->', TARG, ARRIVE, HOWLNG ) */ -/* CALL ETCAL */ - -/* WRITE (*,*) 'The signal arrived at time: ', ARRIVE */ -/* WRITE (*,*) 'It took ', HOWLNG, ' seconds to get there.' */ - - -/* Example 2. */ -/* ---------- */ -/* Suppose a signal is received at the Goldstone tracking sight */ -/* at epoch ET from the spacecraft of the previous example. */ - -/* signal sent from spacecraft */ -/* * <-._.-._.-._.-._.-._.-._.-._.-._.- * */ - -/* Goldstone (OBS=399001) Spacecraft (TARG = -77) */ -/* at epoch ETOBS(given) at epoch ETTARG(unknown) */ - -/* Again assuming that all the required kernels have been loaded */ -/* the code fragment below computes the epoch at which the */ -/* signal was transmitted from the spacecraft. */ - -/* OBS = 399001 */ -/* TARG = -77 */ -/* ETOBS = ET */ - -/* CALL LTIME ( ETOBS, OBS, '<-', TARG, SENT, HOWLNG ) */ -/* CALL ETCAL */ - -/* WRITE (*,*) 'The signal was transmitted at: ', SENT */ -/* WRITE (*,*) 'It took ', HOWLNG, ' seconds to get here.' */ - -/* EXAMPLE 3 */ -/* --------- */ -/* Suppose there is a transponder on board the spacecraft of */ -/* the previous examples that transmits a signal back to the */ -/* sender exactly 1 microsecond after a signal arrives at */ -/* the spacecraft. If we send a signal from Goldstone */ -/* to the spacecraft and wait to receive it at Canberra. */ -/* What will be the epoch at which the return signal arrives */ -/* in Canberra? ( The id-code for Canberra is 399002 ). */ - -/* Again, assuming we've loaded all the necessary kernels, */ -/* the fragment below will give us the answer. */ - -/* GSTONE = 399001 */ -/* SC = -77 */ -/* CANBER = 399002 */ -/* ETGOLD = ET */ - -/* CALL LTIME ( ETGOLD, GSTONE, '->', SC, SCGET, LT1 ) */ - -/* Account for the microsecond delay between receipt and transmit */ - -/* SCSEND = SCGET + 0.000001 */ - -/* CALL LTIME ( SCSEND, SC, '->', CANBER, ETCANB, LT2 ) */ - -/* RNDTRP = ETCANB - ETGOLD */ - -/* WRITE (*,*) 'The signal arrives in Canberra at: ', ETCANB */ -/* WRITE (*,*) 'Round trip time for the signal was: ', RNDTRP */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 22-SEP-2004 (EDW) */ - -/* Placed Copyright after Abstract. */ - -/* - SPICELIB Version 1.1.1, 18-NOV-1996 (WLT) */ - -/* Errors in the examples section were corrected. */ - -/* - SPICELIB Version 1.1.0, 10-JUL-1996 (WLT) */ - -/* Added Copyright Notice to the header. */ - -/* - SPICELIB Version 1.0.0, 10-NOV-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Compute uplink and downlink light time */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - if (return_()) { - return 0; - } - chkin_("LTIME", (ftnlen)5); - -/* First perform the obvious error check. */ - - if (s_cmp(dir, "->", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(dir, "<-", ( - ftnlen)2, (ftnlen)2) != 0) { - setmsg_("The direction specifier for the signal was '#' it must be " - "either '->' or '<-'. ", (ftnlen)80); - r__ = rtrim_(dir, (ftnlen)2); - errch_("#", dir, (ftnlen)1, r__); - sigerr_("SPICE(BADDIRECTION)", (ftnlen)19); - chkout_("LTIME", (ftnlen)5); - return 0; - } - -/* We need two constants, the speed of light and the id-code */ -/* for the solar system barycenter. */ - - c__ = clight_(); - bcentr = 0; - myet = *etobs; - -/* First get the barycenter relative states of the observer */ -/* and target. */ - - spkgeo_(obs, &myet, "J2000", &bcentr, sobs, <, (ftnlen)5); - spkgeo_(targ, &myet, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - -/* The rest is straight forward. We either add the elapsed */ -/* time to get the next state or subtract the elapsed time. */ -/* This depends on whether we are receiving or transmitting */ -/* at the observer. */ - -/* Note that 3 iterations as performed here gives us */ -/* Newtonian accuracy to the nanosecond level for all */ -/* known objects in the solar system. The ephemeris */ -/* is certain to be much worse than this. */ - - if (s_cmp(dir, "->", (ftnlen)2, (ftnlen)2) == 0) { - *ettarg = myet + *elapsd; - spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - *ettarg = myet + *elapsd; - spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - *ettarg = myet + *elapsd; - spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - *ettarg = myet + *elapsd; - } else { - *ettarg = myet - *elapsd; - spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - *ettarg = myet - *elapsd; - spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - *ettarg = myet - *elapsd; - spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); - *elapsd = vdist_(sobs, starg) / c__; - *ettarg = myet - *elapsd; - } - if (failed_()) { - *ettarg = myet; - *elapsd = 0.; - } - chkout_("LTIME", (ftnlen)5); - return 0; -} /* ltime_ */ - diff --git a/ext/spice/src/cspice/ltime_c.c b/ext/spice/src/cspice/ltime_c.c deleted file mode 100644 index 71e9bd1060..0000000000 --- a/ext/spice/src/cspice/ltime_c.c +++ /dev/null @@ -1,318 +0,0 @@ -/* - --Procedure ltime_c ( Light Time ) - --Abstract - - This routine computes the transmit (or receive) time - of a signal at a specified target, given the receive - (or transmit) time at a specified observer. The elapsed - time between transmit and receive is also returned. - --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 - - SPK - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void ltime_c ( SpiceDouble etobs, - SpiceInt obs, - ConstSpiceChar * dir, - SpiceInt targ, - SpiceDouble * ettarg, - SpiceDouble * elapsd ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - etobs I Epoch of a signal at some observer - obs I NAIF ID of some observer - dir I Direction the signal travels ( "->" or "<-" ) - targ I NAIF ID of the target object - ettarg O Epoch of the signal at the target - elapsd O Time between transmit and receipt of the signal - --Detailed_Input - - etobs is an epoch expressed in ephemeris seconds (TDB) - past the epoch of the J2000 reference system. - This is the time at which an electromagnetic - signal is "at" the observer. - - obs is the NAIF ID of some observer. - - dir is the direction the signal travels. The - acceptable values are "->" and "<-". When - you read the calling sequence from left to - right, the "arrow" given by DIR indicates - which way the electromagnetic signal is traveling. - - If the argument list reads as below, - - ..., obs, "->", targ, ... - - the signal is traveling from the observer to the - target. - - If the argument reads as - - ..., obs, "<-", targ - - the signal is traveling from the target to - the observer. - - targ is the NAIF ID of the target. - --Detailed_Output - - ettarg is the epoch, expressed in ephemeris seconds - past J2000 TDB, at which the electromagnetic signal is - "at" the target body. - - Note ettarg is computed using only Newtonian - assumptions about the propagation of light. - - elapsd is the number of ephemeris seconds (TDB) between - transmission and receipt of the signal. - - elapsd = fabs( etobs - ettarg ) - --Parameters - - None. - --Exceptions - - 1) If dir is not one of "->" or "<-" the error SPICE(BADDIRECTION) - will be signalled. In this case ettarg and elapsd will not be - modified. - - 2) - If insufficient ephemeris information is available to compute the - outputs ettarg and elapsd, or if observer or target are not - recognized, the problem is diagnosed by a routine in the call - tree of this routine. - - In this case, the value of ettarg will be set to etobs - and elapsd will be set to zero. - --Files - - None. - --Particulars - - Suppose a radio signal travels between two solar system objects. - Given an ephemeris for the two objects, which way the signal is - traveling, and the time when the signal is "at" at one of the - objects (the observer obs), this routine determines when the signal - is "at" the other object (the target targ). It also returns the - elapsed time between transmission and receipt of the signal. - - --Examples - - - - 1) Suppose a signal is transmitted at time et from the Goldstone - tracking site (ID code 399001) to a spacecraft whose ID code - is -77. - - - signal traveling to spacecraft - * -._.-._.-._.-._.-._.-._.-._.-._.-> * - - Goldstone (obs=399001) Spacecraft (targ = -77) - at epoch etobs(given) at epoch ettarg(unknown) - - Assuming that all of the required SPICE kernels have been - loaded, the code fragment below shows how to compute the - time (arrive) at which the signal arrives at the spacecraft - and how long (howlng) it took the signal to reach the spacecraft. - (Note that we display the arrival time as the number of seconds - past J2000.) - - #include - #include "SpiceUsr.h" - . - . - . - #define OBS 399001 - #define TARG -77 - #define LENOUT 81 - #define OBSUTC "1999 May 25" - #define LSK "leapseconds.ker" - - SpiceChar timestr [ LENOUT ]; - - SpiceDouble arrive; - SpiceDouble howlng; - SpiceDouble etobs; - SpiceDouble sent; - - - [ load kernels ] - - str2et_c ( OBSUTC, &etobs ); - - ltime_c ( etobs, OBS, "->", TARG, &arrive, &howlng ); - etcal_c ( arrive, LENOUT, timestr ); - - printf ( "The signal arrived at time: %s\n", timestr ); - printf ( "It took %15.6f seconds to get there.\n", howlng ); - - - 2) Suppose a signal is received at the Goldstone tracking sight - at epoch ET from the spacecraft of the previous example. - - signal sent from spacecraft - * <-._.-._.-._.-._.-._.-._.-._.-._.- * - - Goldstone (OBS=399001) Spacecraft (TARG = -77) - at epoch ETOBS(given) at epoch ETTARG(unknown) - - Again assuming that all the required kernels have been loaded - the code fragment below computes the epoch at which the - signal was transmitted from the spacecraft. - - ltime_c ( etobs, OBS, "<-", TARG, &sent, &howlng ); - etcal_c ( sent, LENOUT, timestr ); - - printf ( "The signal was transmitted at: %s\n", timestr ); - printf ( "It took %15.6f seconds to get there.\n", howlng ); - - - 3) Suppose there is a transponder on board the spacecraft of - the previous examples that transmits a signal back to the - sender exactly 1 microsecond after a signal arrives at - the spacecraft. If we send a signal from Goldstone - to the spacecraft and wait to receive it at Canberra. - What will be the epoch at which the return signal arrives - in Canberra? ( The ID code for Canberra is 399002 ). - - Again, assuming we've loaded all the necessary kernels, - the fragment below will give us the answer. - - #define GSTONE 399001 - #define SC -77 - #define CANBER 399002 - - str2et_c ( OBSUTC, &etgold ); - - ltime_c ( etgold, GSTONE, "->", SC, &scget, <1 ); - - /. - Account for the microsecond delay between receipt and - transmission. - ./ - scsend = scget + 0.000001; - - ltime_c ( scsend, SC, "->", CANBER, &etcanb, <2 ); - - rndtrp = etcanb - etgold; - - printf ( "The signal arrives in Canberra at ET: %15.6f\n" - "Round trip time for the signal was: %15.6f\n", - etcanb, - rndtrp ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 09-NOV-2006 (NJB) - - Corrected a reference to the function j2000_c; this had been - erroneously changed from the name J2000 to j2000_c - during translation from Fortran. - - Re-ordered header sections to conform to standard. - - -CSPICE Version 1.0.0, 29-MAY-1999 (WLT) (NJB) - --Index_Entries - - Compute uplink and downlink light time - --& -*/ - -{ /* Begin ltime_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "ltime_c" ); - - - /* - Check the input direction string. The pointer must be non-null - and the string length must be at least 1. - */ - CHKFSTR ( CHK_STANDARD, "ltime_c", dir ); - - - /* - Call the f2c'd routine. - */ - ltime_ ( ( doublereal * ) &etobs, - ( integer * ) &obs, - ( char * ) dir, - ( integer * ) &targ, - ( doublereal * ) ettarg, - ( doublereal * ) elapsd, - ( ftnlen ) strlen(dir) ); - - - chkout_c ( "ltime_c" ); - -} /* End ltime_c */ diff --git a/ext/spice/src/cspice/ltrim.c b/ext/spice/src/cspice/ltrim.c deleted file mode 100644 index 1b525d1e07..0000000000 --- a/ext/spice/src/cspice/ltrim.c +++ /dev/null @@ -1,164 +0,0 @@ -/* ltrim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LTRIM ( Left trim ) */ -integer ltrim_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - - /* Local variables */ - extern integer frstnb_(char *, ftnlen); - -/* $ Abstract */ - -/* Return the maximum of 1 and the location of the first non-blank */ -/* character in the 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 */ - -/* CHARACTER */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ - -/* STRING I String to be trimmed. */ - -/* The function returns the maximum of 1 and the location of the */ -/* first non-blank character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is a string to be trimmed: the location of the */ -/* first non-blank character is desired. */ - -/* $ Detailed_Output */ - -/* The function returns the maximum of 1 and the location of the */ -/* first non-blank character in STRING. */ - -/* In particular, when STRING is blank, the function returns the */ -/* value 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* When writing a character string to a file, we may wish to omit */ -/* leading blanks. We'd like to use FRSTNB as a lower substring */ -/* bound, but we have to handle the case where FRSTNB returns 0, */ -/* so we write: */ - - -/* WRITE ( UNIT, '(A)' ), STRING ( MAX (1, FRSTNB (STRING)) : ) */ - - -/* This can be simplified using LTRIM: */ - - -/* WRITE ( UNIT, '(A)' ), STRING ( LTRIM (STRING) : ) */ - - -/* This routine has a counterpart, RTRIM, which finds the maximum of */ -/* 1 and the position of the last non-blank character of a string. */ - -/* $ Examples */ - -/* 1) Write the non-blank portion of each element of a character */ -/* cell to file SPUD.DAT: */ - -/* DO I = 1, CARDC (CELL) */ - -/* CALL WRLINE ( 'SPUD.DAT', */ -/* . CELL(I) ( LTRIM (CELL) : RTRIM (CELL) ) ) */ - -/* END DO */ - -/* When CELL(I) is blank, the string ' ' will be written. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 02-MAY-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* left trim */ - -/* -& */ - -/* SPICELIB functions */ - - -/* `Just do it'. */ - -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(string, string_len); - ret_val = max(i__1,i__2); - return ret_val; -} /* ltrim_ */ - diff --git a/ext/spice/src/cspice/lun2fn.c b/ext/spice/src/cspice/lun2fn.c deleted file mode 100644 index 63d7d7ab4a..0000000000 --- a/ext/spice/src/cspice/lun2fn.c +++ /dev/null @@ -1,214 +0,0 @@ -/* lun2fn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LUN2FN ( Map logical unit of open file to its name. ) */ -/* Subroutine */ int lun2fn_(integer *lunit, char *filnam, ftnlen filnam_len) -{ - /* System generated locals */ - inlist ioin__1; - - /* Builtin functions */ - integer f_inqu(inlist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical opened; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Map the logical unit of an open file to its associated filename. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LUNIT I A logical unit to be mapped to a filename. */ -/* FILNAM O Name of the file associated with LUNIT. */ - -/* $ Detailed_Input */ - -/* LUNIT is the Fortran logical unit that is to be mapped to the */ -/* filename with which it is associated. The file must be */ -/* open for this routine to work properly. */ - -/* $ Detailed_Output */ - -/* FILNAM is the filename that is associated with the Fortran */ -/* logical unit LUNIT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the logical unit is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs during the execution of the Fortran INQUIRE */ -/* statement, the error SPICE(INQUIREFAILED) is signalled. */ - -/* 3) If the logical unit is not attached to an open file, the */ -/* error SPICE(FILENOTOPEN) will be signalled. */ - -/* 4) In the event of an error the contents of the variable FILNAM */ -/* are not defined and should not be used. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Uses the Fortran INQUIRE statement to determine the filename that */ -/* is associated with the Fortran logical unit LUNIT. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of LUN2FN. */ - -/* C */ -/* C Convert the logical unit to its filename and display it. */ -/* C */ -/* CALL LUN2FN ( UNIT1, FNAME1 ) */ -/* WRITE (*,*) 'The filename is: ', FNAME1 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* map logical unit to filename */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LUN2FN", (ftnlen)6); - } - -/* First we test to see if the filename is blank. */ - - if (*lunit <= 0) { - setmsg_("The Fortran logical unit was not positive: #.", (ftnlen)45); - errint_("#", lunit, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("LUN2FN", (ftnlen)6); - return 0; - } - -/* So simple, it defies explanation: just INQUIRE. */ - - ioin__1.inerr = 1; - ioin__1.inunit = *lunit; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.innamlen = filnam_len; - ioin__1.inname = filnam; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - setmsg_("An error occurred while INQUIRing on unit #. The IOSTAT val" - "ue is #.", (ftnlen)67); - errint_("#", lunit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("LUN2FN", (ftnlen)6); - return 0; - } - -/* If there is no open file associated with the logical unit LUNIT */ -/* we cannot get a filename. So signal an error. */ - - if (! opened) { - setmsg_("There was no open file associated with the logical unit #.", - (ftnlen)58); - errint_("#", lunit, (ftnlen)1); - sigerr_("SPICE(FILENOTOPEN)", (ftnlen)18); - chkout_("LUN2FN", (ftnlen)6); - return 0; - } - -/* If we made it to here, we are done. Just check out and return. */ - - chkout_("LUN2FN", (ftnlen)6); - return 0; -} /* lun2fn_ */ - diff --git a/ext/spice/src/cspice/lwrite.c b/ext/spice/src/cspice/lwrite.c deleted file mode 100644 index bf209f47ed..0000000000 --- a/ext/spice/src/cspice/lwrite.c +++ /dev/null @@ -1,302 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" -#include "lio.h" - -ftnint L_len; -int f__Aquote; - - static VOID -donewrec(Void) -{ - if (f__recpos) - (*f__donewrec)(); - } - - static VOID -#ifdef KR_headers -lwrt_I(n) longint n; -#else -lwrt_I(longint n) -#endif -{ - char *p; - int ndigit, sign; - - p = f__icvt(n, &ndigit, &sign, 10); - if(f__recpos + ndigit >= L_len) - donewrec(); - PUT(' '); - if (sign) - PUT('-'); - while(*p) - PUT(*p++); -} - static VOID -#ifdef KR_headers -lwrt_L(n, len) ftnint n; ftnlen len; -#else -lwrt_L(ftnint n, ftnlen len) -#endif -{ - if(f__recpos+LLOGW>=L_len) - donewrec(); - wrt_L((Uint *)&n,LLOGW, len); -} - static VOID -#ifdef KR_headers -lwrt_A(p,len) char *p; ftnlen len; -#else -lwrt_A(char *p, ftnlen len) -#endif -{ - int a; - char *p1, *pe; - - a = 0; - pe = p + len; - if (f__Aquote) { - a = 3; - if (len > 1 && p[len-1] == ' ') { - while(--len > 1 && p[len-1] == ' '); - pe = p + len; - } - p1 = p; - while(p1 < pe) - if (*p1++ == '\'') - a++; - } - if(f__recpos+len+a >= L_len) - donewrec(); - if (a -#ifndef OMIT_BLANK_CC - || !f__recpos -#endif - ) - PUT(' '); - if (a) { - PUT('\''); - while(p < pe) { - if (*p == '\'') - PUT('\''); - PUT(*p++); - } - PUT('\''); - } - else - while(p < pe) - PUT(*p++); -} - - static int -#ifdef KR_headers -l_g(buf, n) char *buf; double n; -#else -l_g(char *buf, double n) -#endif -{ -#ifdef Old_list_output - doublereal absn; - char *fmt; - - absn = n; - if (absn < 0) - absn = -absn; - fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; -#ifdef USE_STRLEN - sprintf(buf, fmt, n); - return strlen(buf); -#else - return sprintf(buf, fmt, n); -#endif - -#else - register char *b, c, c1; - - b = buf; - *b++ = ' '; - if (n < 0) { - *b++ = '-'; - n = -n; - } - else - *b++ = ' '; - if (n == 0) { - *b++ = '0'; - *b++ = '.'; - *b = 0; - goto f__ret; - } - sprintf(b, LGFMT, n); - switch(*b) { -#ifndef WANT_LEAD_0 - case '0': - while(b[0] = b[1]) - b++; - break; -#endif - case 'i': - case 'I': - /* Infinity */ - case 'n': - case 'N': - /* NaN */ - while(*++b); - break; - - default: - /* Fortran 77 insists on having a decimal point... */ - for(;; b++) - switch(*b) { - case 0: - *b++ = '.'; - *b = 0; - goto f__ret; - case '.': - while(*++b); - goto f__ret; - case 'E': - for(c1 = '.', c = 'E'; *b = c1; - c1 = c, c = *++b); - goto f__ret; - } - } - f__ret: - return b - buf; -#endif - } - - static VOID -#ifdef KR_headers -l_put(s) register char *s; -#else -l_put(register char *s) -#endif -{ -#ifdef KR_headers - register void (*pn)() = f__putn; -#else - register void (*pn)(int) = f__putn; -#endif - register int c; - - while(c = *s++) - (*pn)(c); - } - - static VOID -#ifdef KR_headers -lwrt_F(n) double n; -#else -lwrt_F(double n) -#endif -{ - char buf[LEFBL]; - - if(f__recpos + l_g(buf,n) >= L_len) - donewrec(); - l_put(buf); -} - static VOID -#ifdef KR_headers -lwrt_C(a,b) double a,b; -#else -lwrt_C(double a, double b) -#endif -{ - char *ba, *bb, bufa[LEFBL], bufb[LEFBL]; - int al, bl; - - al = l_g(bufa, a); - for(ba = bufa; *ba == ' '; ba++) - --al; - bl = l_g(bufb, b) + 1; /* intentionally high by 1 */ - for(bb = bufb; *bb == ' '; bb++) - --bl; - if(f__recpos + al + bl + 3 >= L_len) - donewrec(); -#ifdef OMIT_BLANK_CC - else -#endif - PUT(' '); - PUT('('); - l_put(ba); - PUT(','); - if (f__recpos + bl >= L_len) { - (*f__donewrec)(); -#ifndef OMIT_BLANK_CC - PUT(' '); -#endif - } - l_put(bb); - PUT(')'); -} -#ifdef KR_headers -l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; -#else -l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) -#endif -{ -#define Ptr ((flex *)ptr) - int i; - longint x; - double y,z; - real *xx; - doublereal *yy; - for(i=0;i< *number; i++) - { - switch((int)type) - { - default: f__fatal(204,"unknown type in lio"); - case TYINT1: - x = Ptr->flchar; - goto xint; - case TYSHORT: - x=Ptr->flshort; - goto xint; -#ifdef Allow_TYQUAD - case TYQUAD: - x = Ptr->fllongint; - goto xint; -#endif - case TYLONG: - x=Ptr->flint; - xint: lwrt_I(x); - break; - case TYREAL: - y=Ptr->flreal; - goto xfloat; - case TYDREAL: - y=Ptr->fldouble; - xfloat: lwrt_F(y); - break; - case TYCOMPLEX: - xx= &Ptr->flreal; - y = *xx++; - z = *xx; - goto xcomplex; - case TYDCOMPLEX: - yy = &Ptr->fldouble; - y= *yy++; - z = *yy; - xcomplex: - lwrt_C(y,z); - break; - case TYLOGICAL1: - x = Ptr->flchar; - goto xlog; - case TYLOGICAL2: - x = Ptr->flshort; - goto xlog; - case TYLOGICAL: - x = Ptr->flint; - xlog: lwrt_L(Ptr->flint, len); - break; - case TYCHAR: - lwrt_A(ptr,len); - break; - } - ptr += len; - } - return(0); -} diff --git a/ext/spice/src/cspice/lx4dec.c b/ext/spice/src/cspice/lx4dec.c deleted file mode 100644 index b1847f0864..0000000000 --- a/ext/spice/src/cspice/lx4dec.c +++ /dev/null @@ -1,281 +0,0 @@ -/* lx4dec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LX4DEC (Scan for signed integer) */ -/* Subroutine */ int lx4dec_(char *string, integer *first, integer *last, - integer *nchar, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer next, f, i__, j, l, n; - extern /* Subroutine */ int lx4sgn_(char *, integer *, integer *, integer - *, ftnlen), lx4uns_(char *, integer *, integer *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Scan a string from a specified starting position for the */ -/* end of a decimal number. */ - - -/* $ 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 */ - -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I any character string */ -/* FIRST I first character to scan from in STRING */ -/* LAST O last character that is part of a decimal number */ -/* NCHAR O number of characters in the decimal number. */ - -/* $ Detailed_Input */ - -/* STRING is any character string. */ - -/* FIRST is the location in the string to beginning scanning */ -/* for a decimal number. It is assumed that the */ -/* decimal number begins at FIRST. */ - -/* $ Detailed_Output */ - -/* LAST is the last character at or after FIRST such that */ -/* the substring STRING(FIRST:LAST) is a decimal */ -/* number. If there is no such substring, LAST */ -/* will be returned with the value FIRST-1. */ - -/* NCHAR is the number of characters in the decimal number */ -/* that begins at FIRST and ends at last. If there */ -/* is no such string NCHAR will be given the value 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If FIRST is beyond either end of the string, then */ -/* LAST will be returned with the value FIRST and NCHAR */ -/* will be returned with the value 0. */ - -/* 2) If STRING(FIRST:FIRST) is not part of a decimal number */ -/* then LAST will be returned with the value FIRST-1 and NCHAR */ -/* will be returned with the value 0. */ - -/* $ Particulars */ - -/* This routine allows you to scan forward in a string to locate */ -/* a decimal number that begins on the input character FIRST. Note */ -/* that all signed integers are included in the list of decimal */ -/* numbers. See LX4SGN for a description of signed integers. */ - -/* We let S stand for a signed integer and U stand for */ -/* an unsigned integer. With this notation, the strings */ -/* recognized as decimal numbers are: */ - -/* U */ -/* S */ -/* S. */ -/* S.U */ -/* .U */ -/* -.U */ -/* +.U */ - - -/* $ Examples */ - -/* Suppose you believe that a string has the form */ - -/* X%Y%Z */ - -/* where X, Y, and Z are decimal numbers of some unknown */ -/* length and % stands for some non-digit character. You could */ -/* use this routine to locate the decimal numbers in the */ -/* string as shown below. We'll keep track of the beginning and */ -/* ending of the decimal numbers in the integer arrays B and E. */ - -/* FIRST = 1 */ -/* I = 0 */ - -/* DO WHILE ( FIRST .LT. LEN(STRING) ) */ - -/* CALL LX4DEC ( STRING, FIRST, LAST, NCHAR ) */ - -/* IF ( NCHAR .GT. 0 ) THEN */ - -/* I = I + 1 */ -/* B(I) = FIRST */ -/* E(I) = LAST */ -/* FIRST = LAST + 2 */ - -/* ELSE */ - -/* FIRST = FIRST + 1 */ - -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 28-NOV-1995 (WLT) */ - -/* Upgraded the routine to handle strings of the form */ -/* '+.01' and '-.01' which were regarded as non-decimal */ -/* strings before. */ - -/* - SPICELIB Version 1.0.0, 12-JUL-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Scan a string for a signed integer. */ - -/* -& */ - *last = *first - 1; - next = *first + 1; - l = i_len(string, string_len); - -/* If start is beyond the ends of the string, we can quit now. */ - - if (*first < 1 || *first > l) { - *nchar = 0; - return 0; - } - -/* There are two cases to take care of (and in both cases */ -/* LX4SGN or LX4UNS do almost all of the work). */ - - i__ = *(unsigned char *)&string[*first - 1]; - if (next < l) { - j = *(unsigned char *)&string[next - 1]; - } else { - j = ' '; - } - if (i__ == '.') { - -/* Case 1. The string begins with a decimal point. */ -/* There must be an unsigned integer following. */ - - f = *first + 1; - lx4uns_(string, &f, last, nchar, string_len); - if (*nchar == 0) { - *last = *first - 1; - } else { - ++(*nchar); - } - } else if ((i__ == '-' || i__ == '+') && j == '.') { - -/* Case 2. The string begins with a sign followed by */ -/* a decimal point. There must be an unsigned integer following. */ - - f = next + 1; - lx4uns_(string, &f, last, nchar, string_len); - if (*nchar == 0) { - *last = *first - 1; - } else { - ++(*nchar); - } - } else if (i__ == '+' && j == '.') { - -/* Case 2. The string begins with a minus sign followed by */ -/* a decimal point. There must be an unsigned integer following. */ - - f = next + 1; - lx4uns_(string, &f, last, nchar, string_len); - if (*nchar == 0) { - *last = *first - 1; - } else { - ++(*nchar); - } - } else { - -/* Case 3. The leading character is not a decimal point. */ -/* First check to see how much signed integer we have. */ - - lx4sgn_(string, first, last, nchar, string_len); - -/* If we got some part of a signed integer, we next see */ -/* if there is a decimal point followed by an unsigned */ -/* integer. */ - - if (*nchar > 0 && *last < l) { - f = *last + 1; - i__ = *(unsigned char *)&string[f - 1]; - if (i__ == '.') { - *last = f; - f = *last + 1; - -/* After the decimal point we may have an unsigned integer. */ - - lx4uns_(string, &f, last, &n, string_len); - -/* LAST is either pointing to the decimal point or the */ -/* end of an unsigned integer. In either case we need */ -/* to update NCHAR. */ - - *nchar = *last + 1 - *first; - } - } - } - return 0; -} /* lx4dec_ */ - diff --git a/ext/spice/src/cspice/lx4dec_c.c b/ext/spice/src/cspice/lx4dec_c.c deleted file mode 100644 index 7e575c3d82..0000000000 --- a/ext/spice/src/cspice/lx4dec_c.c +++ /dev/null @@ -1,254 +0,0 @@ -/* - --Procedure lx4dec_c (Scan for decimal number) - --Abstract - - Scan a string from a specified starting position for the - end of a decimal number. - --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 - - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void lx4dec_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Any character string. - first I First character to scan from in string. - last O Last character that is part of a decimal number. - nchar O Number of characters in the decimal number. - --Detailed_Input - - string is any character string. - - first is the location in the string to beginning scanning - for a decimal number. It is assumed that the - decimal number begins at first. - - The normal range of first is 0 : strlen(string)-1. - --Detailed_Output - - last is the last character at or after first such that the - substring ranging from string[first] through - string[last] is a decimal number. If there is no such - substring, last will be returned with the value first-1. - - If a decimal number is found, last will be in the - range is 0 : strlen(string)-1. - - - nchar is the number of characters in the decimal number that - begins at index first and ends at last. If there is no - such string nchar will be given the value 0. - --Parameters - - None. - --Exceptions - - 1) If first is beyond either end of the string, then - last will be returned with the value first-1 and nchar - will be returned with the value 0. - - 2) If string[first] is not part of a decimal number then last - will be returned with the value first-1 and nchar will be - returned with the value 0. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 4) If the input string has length zero, last will be set to first-1 - and nchar will be set to zero. This case is not considered an - error. - --Files - - None. - --Particulars - - This routine allows you to scan forward in a string to locate - a decimal number that begins on the input character first. Note - that all signed integers are included in the list of decimal - numbers. See lx4sgn_c for a description of signed integers. - - We let S stand for a signed integer and U stand for - an unsigned integer. With this notation, the strings - recognized as decimal numbers are: - - U - S - S. - S.U - .U - -.U - +.U - - --Examples - - 1) Suppose you believe that a string has the form - - X%Y%Z - - where X, Y, and Z are decimal numbers of some unknown length and - % stands for any character that cannot occur in a decimal number. - You could use this routine to locate the decimal numbers in the - string as shown below. We'll keep track of the beginning and - ending of the decimal numbers in the integer arrays b and e. - - - #include - #include "SpiceUsr.h" - - . - . - . - - first = 0; - i = 0; - len = strlen(string); - - while ( first < len-1 ) - { - lx4dec_c ( string, first, &last, &nchar ); - - if ( nchar > 0 ) - { - i++; - - b[i] = first; - e[i] = last; - first = last + 2; - } - else - { - first++; - } - } - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-AUG-2002 (NJB) (WLT) - --Index_Entries - - Scan a string for a decimal number. - --& -*/ - -{ /* Begin lx4dec_c */ - - /* - Local variables - */ - SpiceInt locFirst; - SpiceInt len; - - - /* - Use discovery check-in. - - Check the input string argument for a null pointer. - */ - CHKPTR ( CHK_DISCOVER, "lx4dec_c", string ); - - - /* - We're done if the input string has zero length. - */ - len = strlen(string); - - if ( len == 0 ) - { - *last = -1; - *nchar = 0; - - return; - } - - - /* - Map first to a Fortran-style index. - */ - locFirst = first + 1; - - /* - Call the f2c'd routine. - */ - lx4dec_ ( ( char * ) string, - ( integer * ) &locFirst, - ( integer * ) last, - ( integer * ) nchar, - ( ftnlen ) len ); - - /* - Map last to a C-style index. - */ - - (*last)--; - -} /* End lx4dec_c */ diff --git a/ext/spice/src/cspice/lx4num.c b/ext/spice/src/cspice/lx4num.c deleted file mode 100644 index b843a38f5b..0000000000 --- a/ext/spice/src/cspice/lx4num.c +++ /dev/null @@ -1,219 +0,0 @@ -/* lx4num.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LX4NUM (Scan for a number) */ -/* Subroutine */ int lx4num_(char *string, integer *first, integer *last, - integer *nchar, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer temp, f, i__, l, n; - extern /* Subroutine */ int lx4dec_(char *, integer *, integer *, integer - *, ftnlen), lx4sgn_(char *, integer *, integer *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Scan a string from a specified starting position for the */ -/* end of a number. */ - - -/* $ 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 */ - -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I any character string */ -/* FIRST I first character to scan from in STRING */ -/* LAST O last character that is part of a number */ -/* NCHAR O number of characters in the number. */ - -/* $ Detailed_Input */ - -/* STRING is any character string. */ - -/* FIRST is the location in the string to beginning scanning */ -/* for a number. It is assumed that the number begins */ -/* at FIRST. */ - -/* $ Detailed_Output */ - -/* LAST is the last character at or after FIRST such that */ -/* the substring STRING(FIRST:LAST) is a number. */ -/* If there is no such substring, LAST will be returned */ -/* with the value FIRST-1. */ - -/* NCHAR is the number of characters in the number */ -/* that begins at FIRST and ends at last. If there */ -/* is no such string NCHAR will be given the value 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If FIRST is beyond either end of the string, then */ -/* LAST will be returned with the value FIRST and NCHAR */ -/* will be returned with the value 0. */ - -/* 2) If STRING(FIRST:FIRST) is not part of a number */ -/* then LAST will be returned with the value FIRST-1 and NCHAR */ -/* will be returned with the value 0. */ - -/* $ Particulars */ - -/* This routine allows you to scan forward in a string to locate */ -/* a number that begins on the input character FIRST. Note */ -/* that all decimal numbers are included in the list of numbers. */ -/* The main difference between decimal numbers and numbers is that */ -/* numbers may have an exponential expression attached (i.e. the */ -/* exponent character 'e','E','d' or 'D' followed by an signed */ -/* integer). */ - - -/* $ Examples */ - -/* Suppose you believe that a string has the form */ - -/* X%Y%Z */ - -/* where X, Y, and Z are decimal numbers of some unknown */ -/* length and % stands for some non-numeric character. You could */ -/* use this routine to locate the numbers in the */ -/* string as shown below. We'll keep track of the beginning and */ -/* ending of the numbers in the integer arrays B and E. */ - -/* FIRST = 1 */ -/* I = 0 */ - -/* DO WHILE ( FIRST .LT. LEN(STRING) ) */ - -/* CALL LX4NUM ( STRING, FIRST, LAST, NCHAR ) */ - -/* IF ( NCHAR .GT. 0 ) THEN */ - -/* I = I + 1 */ -/* B(I) = FIRST */ -/* E(I) = LAST */ -/* FIRST = LAST + 2 */ - -/* ELSE */ - -/* FIRST = FIRST + 1 */ - -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-JUL-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Scan a string for a number. */ - -/* -& */ - *last = *first - 1; - l = i_len(string, string_len); - -/* If start is beyond the ends of the string, we can quit now. */ - - if (*first < 1 || *first > l) { - *nchar = 0; - return 0; - } - -/* If this is a number, it must begin with a decimal number */ -/* substring. */ - - lx4dec_(string, first, last, nchar, string_len); - if (*nchar > 0 && *last < l) { - f = *last + 1; - i__ = *(unsigned char *)&string[f - 1]; - -/* See if we have an exponent. */ - - if (i__ == 'e' || i__ == 'E' || i__ == 'D' || i__ == 'd') { - -/* Starting after the exponent character see */ -/* if we have a signed integer. */ - - ++f; - lx4sgn_(string, &f, &temp, &n, string_len); - -/* If there was a signed integer, N will be bigger than */ -/* zero and TEMP will point to the last character of */ -/* the number. Otherwise we just fall through and leave */ -/* LAST and NCHAR alone. */ - - if (n > 0) { - *last = temp; - *nchar = *last + 1 - *first; - } - } - } - return 0; -} /* lx4num_ */ - diff --git a/ext/spice/src/cspice/lx4num_c.c b/ext/spice/src/cspice/lx4num_c.c deleted file mode 100644 index f6ad752bc0..0000000000 --- a/ext/spice/src/cspice/lx4num_c.c +++ /dev/null @@ -1,243 +0,0 @@ -/* - --Procedure lx4num_c (Scan for number) - --Abstract - - Scan a string from a specified starting position for the - end of a number. - --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 - - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void lx4num_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Any character string. - first I First character to scan from in string. - last O Last character that is part of a number. - nchar O Number of characters in the number. - --Detailed_Input - - string is any character string. - - first is the location in the string to beginning scanning - for a number. It is assumed that the - number begins at first. - - The normal range of first is 0 : strlen(string)-1. - --Detailed_Output - - last is the last character at or after first such that the - substring ranging from string[first] through - string[last] is a number. If there is no such - substring, last will be returned with the value first-1. - - If a number is found, last will be in the - range is 0 : strlen(string)-1. - - - nchar is the number of characters in the number that - begins at index first and ends at last. If there is no - such string nchar will be given the value 0. - --Parameters - - None. - --Exceptions - - 1) If first is beyond either end of the string, then - last will be returned with the value first-1 and nchar - will be returned with the value 0. - - 2) If string[first] is not part of a number then last - will be returned with the value first-1 and nchar will be - returned with the value 0. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 4) If the input string has length zero, last will be set to first-1 - and nchar will be set to zero. This case is not considered an - error. - --Files - - None. - --Particulars - - This routine allows you to scan forward in a string to locate a - number that begins on the input character first. Note that all - decimal numbers are included in the list of numbers. The main - difference between decimal numbers and numbers is that numbers may - have an exponential expression attached (i.e. the exponent character - 'e','E','d' or 'D' followed by an signed integer). - --Examples - - 1) Suppose you believe that a string has the form - - X%Y%Z - - where X, Y, and Z are numbers of some unknown length and - % stands for any character that cannot occur in a number. - You could use this routine to locate the numbers in the - string as shown below. We'll keep track of the beginning and - ending of the numbers in the integer arrays b and e. - - - #include - #include "SpiceUsr.h" - - . - . - . - - first = 0; - i = 0; - len = strlen(string); - - while ( first < len-1 ) - { - lx4num_c ( string, first, &last, &nchar ); - - if ( nchar > 0 ) - { - i++; - - b[i] = first; - e[i] = last; - first = last + 2; - } - else - { - first++; - } - } - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-AUG-2002 (NJB) (WLT) - --Index_Entries - - Scan a string for a number. - --& -*/ - -{ /* Begin lx4num_c */ - - /* - Local variables - */ - SpiceInt locFirst; - SpiceInt len; - - - /* - Use discovery check-in. - - Check the input string argument for a null pointer. - */ - CHKPTR ( CHK_DISCOVER, "lx4num_c", string ); - - - /* - We're done if the input string has zero length. - */ - len = strlen(string); - - if ( len == 0 ) - { - *last = -1; - *nchar = 0; - - return; - } - - - /* - Map first to a Fortran-style index. - */ - locFirst = first + 1; - - /* - Call the f2c'd routine. - */ - lx4num_ ( ( char * ) string, - ( integer * ) &locFirst, - ( integer * ) last, - ( integer * ) nchar, - ( ftnlen ) len ); - - /* - Map last to a C-style index. - */ - - (*last)--; - -} /* End lx4num_c */ diff --git a/ext/spice/src/cspice/lx4sgn.c b/ext/spice/src/cspice/lx4sgn.c deleted file mode 100644 index 3733ce204a..0000000000 --- a/ext/spice/src/cspice/lx4sgn.c +++ /dev/null @@ -1,210 +0,0 @@ -/* lx4sgn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LX4SGN (Scan for signed integer) */ -/* Subroutine */ int lx4sgn_(char *string, integer *first, integer *last, - integer *nchar, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer f, i__, l; - extern /* Subroutine */ int lx4uns_(char *, integer *, integer *, integer - *, ftnlen); - -/* $ Abstract */ - -/* Scan a string from a specified starting position for the */ -/* end of a signed integer. */ - - -/* $ 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 */ - -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I any character string */ -/* FIRST I first character to scan from in STRING */ -/* LAST O last character that is part of a signed integer */ -/* NCHAR O number of characters in the signed integer. */ - -/* $ Detailed_Input */ - -/* STRING is any character string. */ - -/* FIRST is the location in the string to beginning scanning */ -/* for a signed integer. It is assumed that the */ -/* signed integer begins at FIRST. */ - -/* $ Detailed_Output */ - -/* LAST is the last character at or after FIRST such that */ -/* the substring STRING(FIRST:LAST) is a signed */ -/* integer. If there is no such substring, LAST */ -/* will be returned with the value FIRST-1. */ - -/* NCHAR is the number of characters in the signed integer */ -/* that begins at FIRST and ends at last. If there */ -/* is no such string NCHAR will be given the value 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If FIRST is beyond either end of the string, then */ -/* LAST will be returned with the value FIRST and NCHAR */ -/* will be returned with the value 0. */ - -/* 2) If STRING(FIRST:FIRST) is not part of a signed integer */ -/* then LAST will be returned with the value FIRST-1 and NCHAR */ -/* will be returned with the value 0. */ - -/* $ Particulars */ - -/* This routine allows you to scan forward in a string to locate */ -/* a signed integer that begins on the input character FIRST. Note */ -/* that all unsigned integers are included in the list of signed */ -/* integers. The signed integers may in addition have a leading */ -/* plus ('+') or minus ('-') sign. */ - - -/* $ Examples */ - -/* Suppose you believe that a string has the form */ - -/* X%Y%Z */ - -/* where X, Y, and Z are signed integers of some unknown */ -/* length and % stands for some non-digit character. You could */ -/* use this routine to locate the signed integers in the */ -/* string as shown below. We'll keep track of the beginning and */ -/* ending of the signed integers in the integer arrays B and E. */ - -/* FIRST = 1 */ -/* I = 0 */ - -/* DO WHILE ( FIRST .LT. LEN(STRING) ) */ - -/* CALL LX4SGN ( STRING, FIRST, LAST, NCHAR ) */ - -/* IF ( NCHAR .GT. 0 ) THEN */ - -/* I = I + 1 */ -/* B(I) = FIRST */ -/* E(I) = LAST */ -/* FIRST = LAST + 2 */ - -/* ELSE */ - -/* FIRST = FIRST + 1 */ - -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-JUL-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Scan a string for a signed integer. */ - -/* -& */ - *last = *first - 1; - l = i_len(string, string_len); - -/* If start is beyond the ends of the string, we can quit now. */ - - if (*first < 1 || *first > l) { - *nchar = 0; - return 0; - } - -/* There are two cases to take care of (and in both cases */ -/* LX4UNS does almost all of the work). */ - - i__ = *(unsigned char *)&string[*first - 1]; - if (i__ == '+' || i__ == '-') { - -/* Case 1. The string begins with a + or -. There must */ -/* be an unsigned integer following. */ - - f = *first + 1; - lx4uns_(string, &f, last, nchar, string_len); - if (*nchar == 0) { - *last = *first - 1; - } else { - ++(*nchar); - } - } else { - -/* Case 2. The leading character is not a sign character. */ -/* We simply check to see how much unsigned integer we have. */ - - lx4uns_(string, first, last, nchar, string_len); - } - return 0; -} /* lx4sgn_ */ - diff --git a/ext/spice/src/cspice/lx4sgn_c.c b/ext/spice/src/cspice/lx4sgn_c.c deleted file mode 100644 index 3ade124232..0000000000 --- a/ext/spice/src/cspice/lx4sgn_c.c +++ /dev/null @@ -1,242 +0,0 @@ -/* - --Procedure lx4sgn_c (Scan for signed integer) - --Abstract - - Scan a string from a specified starting position for the - end of a signed integer. - --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 - - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void lx4sgn_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Any character string. - first I First character to scan from in string. - last O Last character that is part of a signed integer. - nchar O Number of characters in the signed integer. - --Detailed_Input - - string is any character string. - - first is the location in the string to beginning scanning - for a signed integer. It is assumed that the - signed integer begins at first. - - The normal range of first is 0 : strlen(string)-1. - --Detailed_Output - - last is the last character at or after first such that the - substring ranging from string[first] through - string[last] is a signed integer. If there is no such - substring, last will be returned with the value first-1. - - If a signed integer is found, last will be in the - range is 0 : strlen(string)-1. - - - nchar is the number of characters in the signed integer that - begins at index first and ends at last. If there is no - such string nchar will be given the value 0. - --Parameters - - None. - --Exceptions - - 1) If first is beyond either end of the string, then - last will be returned with the value first-1 and nchar - will be returned with the value 0. - - 2) If string[first] is not part of a signed integer then last - will be returned with the value first-1 and nchar will be - returned with the value 0. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 4) If the input string has length zero, last will be set to first-1 - and nchar will be set to zero. This case is not considered an - error. - --Files - - None. - --Particulars - - This routine allows you to scan forward in a string to locate a - signed integer that begins on the input character at index first. - Note that all unsigned integers are included in the list of signed - integers. The signed integers may in addition have a leading plus - ('+') or minus ('-') sign. - --Examples - - 1) Suppose you believe that a string has the form - - X%Y%Z - - where X, Y, and Z are signed integers of some unknown length and - % stands for any character that cannot occur in a signed integer. - You could use this routine to locate the signed integers in the - string as shown below. We'll keep track of the beginning and - ending of the signed integers in the integer arrays b and e. - - - #include - #include "SpiceUsr.h" - - . - . - . - - first = 0; - i = 0; - len = strlen(string); - - while ( first < len-1 ) - { - lx4sgn_c ( string, first, &last, &nchar ); - - if ( nchar > 0 ) - { - i++; - - b[i] = first; - e[i] = last; - first = last + 2; - } - else - { - first++; - } - } - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-AUG-2002 (NJB) (WLT) - --Index_Entries - - Scan a string for a signed integer. - --& -*/ - -{ /* Begin lx4sgn_c */ - - /* - Local variables - */ - SpiceInt locFirst; - SpiceInt len; - - - /* - Use discovery check-in. - - Check the input string argument for a null pointer. - */ - CHKPTR ( CHK_DISCOVER, "lx4sgn_c", string ); - - - /* - We're done if the input string has zero length. - */ - len = strlen(string); - - if ( len == 0 ) - { - *last = -1; - *nchar = 0; - - return; - } - - - /* - Map first to a Fortran-style index. - */ - locFirst = first + 1; - - /* - Call the f2c'd routine. - */ - lx4sgn_ ( ( char * ) string, - ( integer * ) &locFirst, - ( integer * ) last, - ( integer * ) nchar, - ( ftnlen ) len ); - - /* - Map last to a C-style index. - */ - - (*last)--; - -} /* End lx4sgn_c */ diff --git a/ext/spice/src/cspice/lx4uns.c b/ext/spice/src/cspice/lx4uns.c deleted file mode 100644 index 07f9b213ca..0000000000 --- a/ext/spice/src/cspice/lx4uns.c +++ /dev/null @@ -1,256 +0,0 @@ -/* lx4uns.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LX4UNS (Scan for unsigned integer) */ -/* Subroutine */ int lx4uns_(char *string, integer *first, integer *last, - integer *nchar, ftnlen string_len) -{ - /* Initialized data */ - - static logical doinit = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - - /* Local variables */ - static integer i__, l; - static logical digit[384]; - -/* $ Abstract */ - -/* Scan a string from a specified starting position for the */ -/* end of an unsigned integer. */ - -/* $ 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 */ - -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I any character string */ -/* FIRST I first character to scan from in STRING */ -/* LAST O last character that is part of an unsigned integer */ -/* NCHAR O number of characters in the unsigned integer. */ - -/* $ Detailed_Input */ - -/* STRING is any character string. */ - -/* FIRST is the location in the string to beginning scanning */ -/* for an unsigned integer. It is assumed that the */ -/* unsigned integer begins at FIRST. */ - -/* $ Detailed_Output */ - -/* LAST is the last character at or after FIRST such that */ -/* the substring STRING(FIRST:LAST) is an unsigned */ -/* integer. If there is no such substring, LAST */ -/* will be returned with the value FIRST-1. */ - -/* NCHAR is the number of characters in the unsigned integer */ -/* that begins at FIRST and ends at last. If there */ -/* is no such string NCHAR will be given the value 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If FIRST is beyond either end of the string, then */ -/* LAST will be returned with the value FIRST and NCHAR */ -/* will be returned with the value 0. */ - -/* 2) If STRING(FIRST:FIRST) is not part of an unsigned integer */ -/* then LAST will be returned with the value FIRST-1 and NCHAR */ -/* will be returned with the value 0. */ - -/* $ Particulars */ - -/* This routine allows you to scan forward in a string to locate */ -/* an unsigned integer that begins on the input character FIRST. */ - - -/* $ Examples */ - -/* Suppose you believe that a string has the form */ - -/* X%Y%Z */ - -/* where X, Y, and Z are unsigned integers of some unknown */ -/* length and % stands for some non-digit character. You could */ -/* use this routine to locate the unsigned integers in the */ -/* string as shown below. We'll keep track of the beginning and */ -/* ending of the unsigned integers in the integer arrays B and E. */ - -/* FIRST = 1 */ -/* I = 0 */ - -/* DO WHILE ( FIRST .LT. LEN(STRING) ) */ - -/* CALL LX4UNS ( STRING, FIRST, LAST, NCHAR ) */ - -/* IF ( NCHAR .GT. 0 ) THEN */ - -/* I = I + 1 */ -/* B(I) = FIRST */ -/* E(I) = LAST */ -/* FIRST = LAST + 2 */ - -/* ELSE */ - -/* FIRST = FIRST + 1 */ - -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* 1) Assumes ICHAR returns values in the range [-128, 255]. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 03-DEC-2001 (NJB) */ - -/* Updated to work if non-printing characters are present in */ -/* the input string. Updated Restrictions section. */ - -/* - SPICELIB Version 1.0.0, 12-JUL-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Scan a string for an unsigned integer. */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* First we perform some initializations that are needed on */ -/* each pass through this routine. */ - - if (doinit) { - doinit = FALSE_; - for (i__ = -128; i__ <= 255; ++i__) { - digit[(i__1 = i__ + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("dig" - "it", i__1, "lx4uns_", (ftnlen)206)] = FALSE_; - } - digit[(i__1 = '0' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)209)] = TRUE_; - digit[(i__1 = '1' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)210)] = TRUE_; - digit[(i__1 = '2' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)211)] = TRUE_; - digit[(i__1 = '3' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)212)] = TRUE_; - digit[(i__1 = '4' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)213)] = TRUE_; - digit[(i__1 = '5' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)214)] = TRUE_; - digit[(i__1 = '6' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)215)] = TRUE_; - digit[(i__1 = '7' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)216)] = TRUE_; - digit[(i__1 = '8' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)217)] = TRUE_; - digit[(i__1 = '9' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "lx4uns_", (ftnlen)218)] = TRUE_; - } - *last = *first - 1; - l = i_len(string, string_len); - -/* If start is beyond the ends of the string, we can quit now. */ - - if (*first < 1 || *first > l) { - *nchar = 0; - return 0; - } - -/* Now for the real work of the routine. Examine characters one */ -/* at a time... */ - - i__1 = l; - for (i__ = *first; i__ <= i__1; ++i__) { - -/* If this character is a digit, move the LAST pointe one */ -/* further down on the string. Otherwise set NCHAR and return. */ - - if (digit[(i__2 = *(unsigned char *)&string[i__ - 1] + 128) < 384 && - 0 <= i__2 ? i__2 : s_rnge("digit", i__2, "lx4uns_", (ftnlen) - 241)]) { - ++(*last); - } else { - *nchar = *last + 1 - *first; - return 0; - } - } - *nchar = *last + 1 - *first; - return 0; -} /* lx4uns_ */ - diff --git a/ext/spice/src/cspice/lx4uns_c.c b/ext/spice/src/cspice/lx4uns_c.c deleted file mode 100644 index e147c7dbc2..0000000000 --- a/ext/spice/src/cspice/lx4uns_c.c +++ /dev/null @@ -1,237 +0,0 @@ -/* - --Procedure lx4uns_c (Scan for unsigned integer) - --Abstract - - Scan a string from a specified starting position for the - end of an unsigned integer. - --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 - - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void lx4uns_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Any character string. - first I First character to scan from in string. - last O Last character that is part of an unsigned integer. - nchar O Number of characters in the unsigned integer. - --Detailed_Input - - string is any character string. - - first is the location in the string to beginning scanning - for an unsigned integer. It is assumed that the - unsigned integer begins at first. - - The normal range of first is 0 : strlen(string)-1. - --Detailed_Output - - last is the last character at or after first such that the - substring ranging from string[first] through - string[last] is an unsigned integer. If there is no such - substring, last will be returned with the value first-1. - - If an unsigned integer is found, last will be in the - range is 0 : strlen(string)-1. - - - nchar is the number of characters in the unsigned integer that - begins at index first and ends at last. If there is no - such string nchar will be given the value 0. - --Parameters - - None. - --Exceptions - - 1) If first is beyond either end of the string, then - last will be returned with the value first-1 and nchar - will be returned with the value 0. - - 2) If string[first] is not part of an unsigned integer then last - will be returned with the value first-1 and nchar will be - returned with the value 0. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 4) If the input string has length zero, last will be set to first-1 - and nchar will be set to zero. This case is not considered an - error. - --Files - - None. - --Particulars - - This routine allows you to scan forward in a string to locate an - unsigned integer that begins on the input character first. An - unsigned integer is simply a sequence of digits. - --Examples - - 1) Suppose you believe that a string has the form - - X%Y%Z - - where X, Y, and Z are unsigned integers of some unknown - length and % stands for some non-digit character. You could - use this routine to locate the unsigned integers in the - string as shown below. We'll keep track of the beginning and - ending of the unsigned integers in the integer arrays b and e. - - - #include - #include "SpiceUsr.h" - - . - . - . - - first = 0; - i = 0; - len = strlen(string); - - while ( first < len-1 ) - { - lx4uns_c ( string, first, &last, &nchar ); - - if ( nchar > 0 ) - { - i++; - - b[i] = first; - e[i] = last; - first = last + 2; - } - else - { - first++; - } - } - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 11-AUG-2002 (NJB) (WLT) - --Index_Entries - - Scan a string for an unsigned integer. - --& -*/ - -{ /* Begin lx4uns_c */ - - /* - Local variables - */ - SpiceInt locFirst; - SpiceInt len; - - - /* - Use discovery check-in. - - Check the input string argument for a null pointer. - */ - CHKPTR ( CHK_DISCOVER, "lx4uns_c", string ); - - - /* - We're done if the input string has zero length. - */ - len = strlen(string); - - if ( len == 0 ) - { - return; - } - - - /* - Map first to a Fortran-style index. - */ - locFirst = first + 1; - - /* - Call the f2c'd routine. - */ - lx4uns_ ( ( char * ) string, - ( integer * ) &locFirst, - ( integer * ) last, - ( integer * ) nchar, - ( ftnlen ) len ); - - /* - Map last to a C-style index. - */ - - (*last)--; - -} /* End lx4uns_c */ diff --git a/ext/spice/src/cspice/lxname.c b/ext/spice/src/cspice/lxname.c deleted file mode 100644 index 9f20111c9d..0000000000 --- a/ext/spice/src/cspice/lxname.c +++ /dev/null @@ -1,1002 +0,0 @@ -/* lxname.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__255 = 255; -static integer c__0 = 0; - -/* $Procedure LXNAME ( Lex names ) */ -/* Subroutine */ int lxname_0_(int n__, char *hdchrs, char *tlchrs, char * - string, integer *first, integer *last, integer *idspec, integer * - nchar, ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer c__, headc[261], i__, l, nhead; - extern integer cardi_(integer *); - integer tailc[261]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ntail, tcpos; - extern integer rtrim_(char *, ftnlen); - integer hl, tl; - extern /* Subroutine */ int scardi_(integer *, integer *), validi_( - integer *, integer *, integer *); - extern integer bsrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int appndi_(integer *, integer *), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen), ssizei_(integer *, integer *), - insrti_(integer *, integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Umbrella routine for name scanning entry points. */ - -/* $ 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 */ - -/* CHARACTER */ -/* PARSING */ -/* SCANNING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* HDCHRS I LXCSID */ -/* TLCHRS I LXCSID */ -/* STRING I LXIDNT */ -/* FIRST I LXIDNT */ -/* IDSPEC I-O LXDFID, LXCSID, LXIDNT */ -/* LAST O LXIDNT */ -/* NCHAR O LXIDNT */ -/* MXSPEC P LXDFID, LXCSID */ - -/* $ Detailed_Input */ - -/* See the entry points for descriptions of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for descriptions of their outputs. */ - -/* $ Parameters */ - -/* See the entry points for descriptions of their parameters. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error */ -/* SPICE(BOGUSENTRY) is signalled. */ - -/* See the entry points for descriptions of the exceptions */ -/* specific to those entry points. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Many computer languages include tokens that represent names. */ -/* Examples of names include procedure names and variable names. */ -/* The term `identifier' is generally used to indicate this type */ -/* of token. Rules for constructing identifiers vary from */ -/* language to language, but identifiers conforming to the */ -/* following rules are widely recognized: */ - -/* 1) The first character of the identifier is a letter. */ - -/* 2) The remaining characters are letters or numbers. */ - -/* 3) The length of the identifier is less than some specified */ -/* limit. */ - -/* This suite of routines has its own set of default rules for */ -/* forming identifiers. These rules are somewhat more liberal */ -/* than those listed above. Rule (1) above still holds, but */ -/* trailing characters may include letters, numbers, and the */ -/* special characters */ - -/* $ */ -/* _ (underscore) */ - -/* No mechanism for enforcing rule (3) is provided; this task is */ -/* left to the caller, since this routine would be unnecessarily */ -/* complicated by the need to construct diagnostic messages. */ - -/* The entry point LXIDNT (Lex identifier) recognizes valid */ -/* identifier tokens, using either the default character sets */ -/* for the head and tail of the identifier, or character sets */ -/* specified in the last call to LXCSID. */ - -/* In order to use this suite of routines to scan identifiers that */ -/* conform to the default rules, a program normally calls the entry */ -/* point LXDFID (Lex, default identifier specification) once to */ -/* obtain the default `identifier specification'. This specification */ -/* is an integer array in which the allowed head and tail character */ -/* sets are specified. This specification is then saved and supplied */ -/* to the entry point LXIDNT (Lex identifier) whenever LXIDNT is */ -/* called to scan an identifier. The entry point LXIDNT recognizes */ -/* valid identifier tokens, using an input identifier specification */ -/* to decide which head and tail characters are allowed in an */ -/* identifier. */ - -/* The scanning code using these routines might have the following */ -/* structure: */ - - -/* INTEGER IDSPEC ( LBCELL : MXSPEC ) */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C Initialize the identifier specification, using the */ -/* C default: */ -/* C */ -/* CALL SSIZEI ( MXSPEC, IDSPEC ) */ -/* CALL LXDFID ( IDSPEC ) */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C Scan string: */ -/* C */ -/* DO WHILE ( ) */ -/* . */ -/* . */ -/* . */ -/* IF ( ) THEN */ - -/* CALL LXIDNT ( IDSPEC, STRING, FIRST, LAST, NCHARS ) */ - -/* IF ( NCHARS .GT. 0 ) THEN */ - -/* [Identifier was found--process result] */ - -/* ELSE */ - -/* [Token at starting at location FIRST was not */ -/* an identifier--handle alternatives] */ - -/* END IF */ - -/* ELSE */ - -/* [ perform tests for other tokens ] */ - -/* END IF */ - -/* END DO */ - - -/* It is possible to override the default rules by calling the */ -/* entry point LXCSID (Lex, custom identifier characters). This */ -/* routine allows the caller to specify the precise set of */ -/* characters allowed as the first character (`head') of the */ -/* identifier, as well as those allowed in the remainder (`tail') */ -/* of the identifier. */ - -/* If a custom identifier specification is desired, the call to */ -/* LXDFID in the pseudo code above would be replaced by a call to */ -/* LXCSID. After setting the strings HDCHRS and TLCHRS to contain, */ -/* respectively, the allowed head and tail identifier characters, the */ -/* following call would produce an identifier specification structure */ -/* IDSPEC representing these set of allowed characters. */ - -/* CALL LXCSID ( HDCHRS, TLCHRS, IDSPEC ) */ - -/* The array IDSPEC obtained from LXCSID would be used as input to */ -/* LXIDNT, instead of using the array obtained by calling LXDFID. */ - -/* $ Examples */ - -/* 1) The following table illustrates the behavior of the scanning */ -/* entry point LXIDNT when the default identifier syntax is in */ -/* effect: */ - -/* STRING CONTENTS FIRST LAST NCHAR */ -/* ========================================================== */ -/* WHERE A LT B 1 5 5 */ -/* WHERE A LT B 7 7 1 */ -/* WHERE A.LT.B 7 7 1 */ -/* WHERE (A0)LT(B8) 8 9 2 */ -/* WHERE A0$LT_B7 7 14 8 */ -/* WHERE A LT B 12 12 1 */ -/* WHERE A .LT. B 9 8 0 */ - - -/* 2) The following table illustrates the behavior of the scanning */ -/* entry point LXIDNT when a custom identifier syntax is used. */ -/* The call */ - -/* CALL LXCSID ( HDCHRS, TLCHRS, IDSPEC ) */ - -/* where */ - -/* HDCHRS = 'abcdefghijklmnopqrstuvwxyz' */ - -/* and */ - -/* TLCHRS = 'abcdefghijklmnopqrstuvwxyz012345.' */ - -/* will produce an indentifier specification IDSPEC that, */ -/* when supplied as an input to LXIDNT, will cause LXIDNT */ -/* to perform in accordance with the table shown below: */ - - -/* STRING CONTENTS FIRST LAST NCHAR */ -/* ========================================================== */ -/* WHERE A LT B 1 0 0 */ -/* where a lt b 1 5 5 */ -/* WHERE a LT b 7 7 1 */ -/* WHERE a.LT.b 7 8 2 */ -/* WHERE (a0)LT(b8) 14 14 1 */ -/* WHERE (a0)LT(b5) 14 15 2 */ -/* WHERE a0.lt.b8 7 13 7 */ -/* WHERE a0$lt_b7 7 8 2 */ -/* where a .lt. b 9 12 4 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* scan name tokens --- umbrella */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* IDSPEC parameters: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_lxidnt; - case 2: goto L_lxdfid; - case 3: goto L_lxcsid; - } - - if (return_()) { - return 0; - } else { - chkin_("LXNAME", (ftnlen)6); - } - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("LXNAME", (ftnlen)6); - return 0; -/* $Procedure LXIDNT ( Lex identifer ) */ - -L_lxidnt: -/* $ Abstract */ - -/* Lex (scan) an identifer, starting from a specified character */ -/* position. */ - -/* $ 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 */ - -/* CHARACTER */ -/* PARSING */ -/* SCANNING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER IDSPEC ( LBCELL : * ) */ -/* CHARACTER*(*) STRING */ -/* INTEGER FIRST */ -/* INTEGER LAST */ -/* INTEGER NCHAR */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* IDSPEC I Identifier character specification. */ -/* STRING I String to be scanned. */ -/* FIRST I Character position at which to start scanning. */ -/* LAST O Character position of end of token. */ -/* NCHAR O Number of characters in token. */ - -/* $ Detailed_Input */ - -/* IDSPEC is an integer cell containing a specification of */ -/* the head and tail identifier character sets to be */ -/* used in scanning the input argument STRING. IDSPEC */ -/* should be obtained by calling LXDFID or LXCSID. */ -/* The structure of IDSPEC is not part of the */ -/* specification of this routine suite and should not */ -/* be relied upon by calling code. */ - -/* STRING is a character string that may contain an */ -/* `identifier' starting at the character position */ -/* indicated by the input argument FIRST (see */ -/* below). Identifier tokens are sequences of */ -/* characters that represent names. Syntactically, an */ -/* identifier is a sequence of characters that begins */ -/* with a character belonging to a set of valid `head' */ -/* characters and is followed by zero or more */ -/* characters belonging to a set of valid `tail' */ -/* characters. */ - -/* FIRST is the character position at which the routine */ -/* is to start scanning an identifier. Note */ -/* that the character STRING(FIRST:FIRST) must be a */ -/* valid head character if an identifier is to */ -/* be found; this routine does *not* attempt to locate */ -/* the first identifier following the position */ -/* FIRST. */ - -/* $ Detailed_Output */ - -/* LAST is the last character position such that the */ -/* substring STRING(FIRST:LAST) is an identifier, if */ -/* such a substring exists. Otherwise, the */ -/* returned value of LAST is FIRST-1. */ - -/* NCHAR is the length of the identifier found by this */ -/* routine, if such a token exists. If an identifier */ -/* is not found, the returned value of NCHAR is */ -/* zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input argument FIRST is less than 1 or greater than */ -/* LEN(STRING)-1, the returned value of LAST is FIRST-1, and the */ -/* returned value of NCHAR is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The default syntax rules for valid identifiers are specified in */ -/* the $Particulars section of the umbrella routine LXNAME. These */ -/* rules may be overridden by calling LXCSID. */ - -/* $ Examples */ - -/* See the $Examples section of the umbrella routine LXNAME. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* scan identifiers */ - -/* -& */ - -/* No check-in required; this entry point is error-free. */ - - -/* Save the length of the non-blank prefix of the input string. */ - - l = rtrim_(string, string_len); - -/* Handle the cases in which we can tell right away that */ -/* no token can be found. */ - - if (*first < 1 || *first > l) { - *last = *first - 1; - *nchar = 0; - return 0; - } - -/* In order for there to be a match, the character at position */ -/* FIRST must be in the head character set. */ - - nhead = idspec[6]; - c__ = *(unsigned char *)&string[*first - 1]; - i__ = bsrchi_(&c__, &nhead, &idspec[8]); - if (i__ == 0) { - *last = *first - 1; - *nchar = 0; - return 0; - } - -/* We have an identifier. The remaining question is how long it is. */ -/* Each subsequent character that is in the tail character set is */ -/* considered to be part of the identifier. */ - - *nchar = 1; - *last = *first; - ntail = idspec[7]; - tcpos = nhead + 3; - while(*last < l) { - i__1 = *last; - c__ = *(unsigned char *)&string[i__1]; - i__ = bsrchi_(&c__, &ntail, &idspec[tcpos + 5]); - if (i__ == 0) { - return 0; - } else { - ++(*nchar); - ++(*last); - } - } - return 0; -/* $Procedure LXDFID ( Lex, default identifier characters ) */ - -L_lxdfid: -/* $ Abstract */ - -/* Return the default specification for the characters that may */ -/* appear in an identifier. */ - -/* $ 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 */ - -/* CHARACTER */ -/* PARSING */ -/* SCANNING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER MXSPEC */ -/* PARAMETER ( MXSPEC = 512 ) */ - -/* INTEGER IDSPEC ( LBCELL : * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* IDSPEC I-O Identifier character specification. */ -/* MXSPEC P Recommended size for declaration of IDSPEC. */ - -/* $ Detailed_Input */ - -/* IDSPEC is an integer cell. The caller must initialize */ -/* IDSPEC as a cell, and should use MXSPEC as the size */ -/* of IDSPEC. */ - -/* $ Detailed_Output */ - -/* IDSPEC is an integer cell containing a specification of */ -/* the head and tail identifier character sets to be */ -/* used the entry point LXIDNT in scanning strings. */ - -/* $ Parameters */ - -/* MXSPEC is the recommended size for the declaration of */ -/* IDSPEC; the caller should declare IDSPEC as shown: */ - -/* INTEGER IDSPEC ( LBCELL : MXSPEC ) */ - -/* The caller should also initialize IDSPEC as shown: */ - -/* CALL SSIZEI ( MXSPEC, IDSPEC ) */ - -/* $ Exceptions */ - -/* 1) If IDSPEC is not properly initialized on input, or if its */ -/* size is too small, the error will be diagnosed by routines */ -/* called by this routine. IDSPEC is undefined on output in this */ -/* case. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows a calling program to obtain the default set of */ -/* allowed patterns for identifiers recognized by LXIDNT. */ - -/* Normally, this routine should be called once during the calling */ -/* program's initialization. */ - -/* $ Examples */ - -/* See the $Examples section of the umbrella routine LXNAME. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* return default allowed identifier characters */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LXDFID", (ftnlen)6); - } - -/* Intialize our head and tail character sets. */ - - ssizei_(&c__255, headc); - ssizei_(&c__255, tailc); - -/* Fill in the head and tail character arrays with their default */ -/* values. User integer codes for the characters. */ - - for (i__ = 1; i__ <= 26; ++i__) { - headc[(i__1 = i__ + 5) < 261 && 0 <= i__1 ? i__1 : s_rnge("headc", - i__1, "lxname_", (ftnlen)733)] = 'A' + i__ - 1; - headc[(i__1 = i__ + 31) < 261 && 0 <= i__1 ? i__1 : s_rnge("headc", - i__1, "lxname_", (ftnlen)734)] = 'a' + i__ - 1; - tailc[(i__1 = i__ + 5) < 261 && 0 <= i__1 ? i__1 : s_rnge("tailc", - i__1, "lxname_", (ftnlen)735)] = headc[(i__2 = i__ + 5) < 261 - && 0 <= i__2 ? i__2 : s_rnge("headc", i__2, "lxname_", ( - ftnlen)735)]; - tailc[(i__1 = i__ + 31) < 261 && 0 <= i__1 ? i__1 : s_rnge("tailc", - i__1, "lxname_", (ftnlen)736)] = headc[(i__2 = i__ + 31) < - 261 && 0 <= i__2 ? i__2 : s_rnge("headc", i__2, "lxname_", ( - ftnlen)736)]; - } - for (i__ = 1; i__ <= 10; ++i__) { - tailc[(i__1 = i__ + 57) < 261 && 0 <= i__1 ? i__1 : s_rnge("tailc", - i__1, "lxname_", (ftnlen)741)] = '0' + i__ - 1; - } - tailc[68] = '$'; - tailc[69] = '_'; - nhead = 52; - ntail = 64; - -/* Turn the arrays into integer sets. */ - - validi_(&c__255, &nhead, headc); - validi_(&c__255, &ntail, tailc); - -/* Create the output specification IDSPEC. This is a cell */ -/* containing, in order, */ - -/* - the number of head characters */ -/* - the number of tail characters */ -/* - integer codes for the head characters */ -/* - integer codes for the tail characters */ - -/* IDSPEC is assumed to be initialized. */ - - - scardi_(&c__0, idspec); - appndi_(&nhead, idspec); - appndi_(&ntail, idspec); - i__1 = nhead; - for (i__ = 1; i__ <= i__1; ++i__) { - appndi_(&headc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge( - "headc", i__2, "lxname_", (ftnlen)774)], idspec); - } - i__1 = ntail; - for (i__ = 1; i__ <= i__1; ++i__) { - appndi_(&tailc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge( - "tailc", i__2, "lxname_", (ftnlen)778)], idspec); - } - chkout_("LXDFID", (ftnlen)6); - return 0; -/* $Procedure LXCSID ( Lex, custom identifier characters ) */ - -L_lxcsid: -/* $ Abstract */ - -/* Set the acceptable characters that may appear in an identifier */ -/* token. */ - -/* $ 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 */ - -/* CHARACTER */ -/* PARSING */ -/* SCANNING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER MXSPEC */ -/* PARAMETER ( MXSPEC = 512 ) */ - -/* CHARACTER*(*) HDCHRS */ -/* CHARACTER*(*) TLCHRS */ -/* INTEGER IDSPEC ( LBCELL : * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HDCHRS I Allowed head characters for identifiers. */ -/* TLCHRS I Allowed tail characters for identifiers. */ -/* IDSPEC I-O Identifier character specification. */ -/* MXSPEC P Recommended size for declaration of IDSPEC. */ - -/* $ Detailed_Input */ - -/* HDCHRS is a string containing the set of characters */ -/* allowed as the first (`head') character of an */ -/* identifier token. Case is significant; if both */ -/* upper and lower case instances of a letter are */ -/* allowed, they must both be listed. White space is */ -/* ignored. Non-printing characters are not allowed. */ - -/* TLCHRS is a string containing the set of characters */ -/* allowed as tail characters (characters following */ -/* the head character) of an identifier token. Case */ -/* is significant; white space is ignored. */ -/* Non-printing characters are not allowed. */ - -/* IDSPEC is an integer cell. The caller must initialize */ -/* IDSPEC as a cell, and should use MXSPEC as the size */ -/* of IDSPEC. */ - -/* $ Detailed_Output */ - -/* IDSPEC is an integer cell containing a specification of */ -/* the head and tail identifier character sets to be */ -/* used the entry point LXIDNT in scanning strings. */ -/* The caller must initialize IDSPEC as a cell, and */ -/* should use MXSPEC as the size of IDSPEC. */ - -/* $ Parameters */ - -/* MXSPEC is the recommended size for the declaration of */ -/* IDSPEC; the caller should declare IDSPEC as shown: */ - -/* INTEGER IDSPEC ( LBCELL : MXSPEC ) */ - -/* The caller should also initialize IDSPEC as shown: */ - -/* CALL SSIZEI ( MXSPEC, IDSPEC ) */ - -/* $ Exceptions */ - -/* 1) If non-printing characters are found in either of the input */ -/* arguments HDCHRS or TLCHRS, the error SPICE(NONPRINTINGCHARS) */ -/* is signalled. The set of allowed identifier characters is not */ -/* modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows a calling program to customize the set of */ -/* allowed patterns for identifiers recognized by LXIDNT. */ - -/* Normally, this routine should be called once during the calling */ -/* program's initialization, if this routine is called at all. */ - -/* $ Examples */ - -/* See the $Examples section of the umbrella routine LXNAME. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* customize allowed identifier characters for lexing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LXCSID", (ftnlen)6); - } - -/* Intialize our head and tail character sets, every time. */ - - ssizei_(&c__255, headc); - ssizei_(&c__255, tailc); - -/* Check the inputs before proceeding. */ - - hl = rtrim_(hdchrs, hdchrs_len); - tl = rtrim_(tlchrs, tlchrs_len); - i__1 = hl; - for (i__ = 1; i__ <= i__1; ++i__) { - c__ = *(unsigned char *)&hdchrs[i__ - 1]; - if (c__ < 32 || c__ > 126) { - setmsg_("The character having integer code # in position # of th" - "e head character string HDCHRS is a non-printing charact" - "er.", (ftnlen)114); - errint_("#", &c__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NONPRINTINGCHARS)", (ftnlen)23); - chkout_("LXCSID", (ftnlen)6); - return 0; - } - } - i__1 = tl; - for (i__ = 1; i__ <= i__1; ++i__) { - c__ = *(unsigned char *)&tlchrs[i__ - 1]; - if (c__ < 32 || c__ > 126) { - setmsg_("The character having integer code # in position # of th" - "e tail character string TLCHRS is a non-printing charact" - "er.", (ftnlen)114); - errint_("#", &c__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NONPRINTINGCHARS)", (ftnlen)23); - chkout_("LXCSID", (ftnlen)6); - return 0; - } - } - -/* The characters of HDCHRS become the set of acceptable */ -/* characters for the head identifier character---all except */ -/* the blanks. Same deal goes for the tail characters. */ - - i__1 = hl; - for (i__ = 1; i__ <= i__1; ++i__) { - c__ = *(unsigned char *)&hdchrs[i__ - 1]; - if (c__ != 32) { - insrti_(&c__, headc); - } - } - nhead = cardi_(headc); - i__1 = tl; - for (i__ = 1; i__ <= i__1; ++i__) { - c__ = *(unsigned char *)&tlchrs[i__ - 1]; - if (c__ != 32) { - insrti_(&c__, tailc); - } - } - ntail = cardi_(tailc); - -/* Create the output specification IDSPEC. This is a cell */ -/* containing, in order, */ - -/* - the number of head characters */ -/* - the number of tail characters */ -/* - integer codes for the head characters */ -/* - integer codes for the tail characters */ - -/* IDSPEC is assumed to be initialized. */ - - - scardi_(&c__0, idspec); - appndi_(&nhead, idspec); - appndi_(&ntail, idspec); - i__1 = nhead; - for (i__ = 1; i__ <= i__1; ++i__) { - appndi_(&headc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge( - "headc", i__2, "lxname_", (ftnlen)1049)], idspec); - } - i__1 = ntail; - for (i__ = 1; i__ <= i__1; ++i__) { - appndi_(&tailc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge( - "tailc", i__2, "lxname_", (ftnlen)1053)], idspec); - } - chkout_("LXCSID", (ftnlen)6); - return 0; -} /* lxname_ */ - -/* Subroutine */ int lxname_(char *hdchrs, char *tlchrs, char *string, - integer *first, integer *last, integer *idspec, integer *nchar, - ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len) -{ - return lxname_0_(0, hdchrs, tlchrs, string, first, last, idspec, nchar, - hdchrs_len, tlchrs_len, string_len); - } - -/* Subroutine */ int lxidnt_(integer *idspec, char *string, integer *first, - integer *last, integer *nchar, ftnlen string_len) -{ - return lxname_0_(1, (char *)0, (char *)0, string, first, last, idspec, - nchar, (ftnint)0, (ftnint)0, string_len); - } - -/* Subroutine */ int lxdfid_(integer *idspec) -{ - return lxname_0_(2, (char *)0, (char *)0, (char *)0, (integer *)0, ( - integer *)0, idspec, (integer *)0, (ftnint)0, (ftnint)0, (ftnint) - 0); - } - -/* Subroutine */ int lxcsid_(char *hdchrs, char *tlchrs, integer *idspec, - ftnlen hdchrs_len, ftnlen tlchrs_len) -{ - return lxname_0_(3, hdchrs, tlchrs, (char *)0, (integer *)0, (integer *)0, - idspec, (integer *)0, hdchrs_len, tlchrs_len, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/lxqstr.c b/ext/spice/src/cspice/lxqstr.c deleted file mode 100644 index b9b56fe2e3..0000000000 --- a/ext/spice/src/cspice/lxqstr.c +++ /dev/null @@ -1,329 +0,0 @@ -/* lxqstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LXQSTR ( Lex quoted string ) */ -/* Subroutine */ int lxqstr_(char *string, char *qchar, integer *first, - integer *last, integer *nchar, ftnlen string_len, ftnlen qchar_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical even; - integer l, loc, pos; - -/* $ Abstract */ - -/* Lex (scan) a quoted 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 */ - -/* CHARACTER */ -/* PARSING */ -/* SCANNING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to be scanned. */ -/* QCHAR I Quote delimiter character. */ -/* FIRST I Character position at which to start scanning. */ -/* LAST O Character position of end of token. */ -/* NCHAR O Number of characters in token. */ - -/* $ Detailed_Input */ - -/* STRING is a character string that may contain a `string */ -/* token' starting at the character position */ -/* indicated by the input argument FIRST (see below). */ -/* String tokens are sequences of characters that */ -/* represent literal strings. Syntactically, a string */ -/* token is a sequence of characters that begins and */ -/* ends with a designated `quote character'. Within */ -/* the token, any occurrence of the quote character */ -/* is indicated by an adjacent pair of quote */ -/* characters: for example, if the quote character is */ - -/* " */ - -/* then the token representing one instance of this */ -/* character is */ - -/* """" */ - -/* Here the first quote indicates the beginning of the */ -/* token, the next two quotes together indicate a */ -/* single quote character that constitutes the */ -/* `contents' of the token, and the final quote */ -/* indicates the end of the token. */ - -/* QCHAR is the quote character. This is always a single */ -/* character. The characters */ - -/* " and ' */ - -/* are common choices, but any non-blank character is */ -/* accepted. Case *is* significant in QCHAR. */ - - -/* FIRST is the character position at which the routine */ -/* is to start scanning a quoted string token. Note */ -/* that the character STRING(FIRST:FIRST) must equal */ -/* QCHAR if a string token is to be found; this */ -/* routine does *not* attempt to locate the first */ -/* quoted string following the position FIRST. */ - -/* $ Detailed_Output */ - -/* LAST is the last character position such that the */ -/* subtring STRING(FIRST:LAST) is a quoted string */ -/* token, if such a substring exists. Otherwise, the */ -/* returned value of LAST is FIRST-1. */ - -/* NCHAR is the length of the string token found by this */ -/* routine, if such a token exists. This length */ -/* includes the starting and ending bracketing quotes. */ -/* If a string token is not found, the returned value */ -/* of NCHAR is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input argument FIRST is less than 1 or greater than */ -/* LEN(STRING)-1, the returned value of LAST is FIRST-1, and the */ -/* returned value of NCHAR is zero. */ - -/* 2) It is not an error for a quoted string token to consist of */ -/* two consecutive quote characters with no intervening */ -/* characters. Calling routines that require special treatment */ -/* of null tokens must handle this case. */ - -/* 3) If the input argument QCHAR is blank, the returned value of */ -/* LAST is FIRST-1, and the returned value of NCHAR is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Quote characters may be ANY non-blank character. For example, the */ -/* ampersand */ - -/* & */ - -/* is a perfectly valid quote character. If we were using the */ -/* ampersand as the quote character, then the term `doubled quote' */ -/* in the following discussion would refer to the sequence */ - -/* && */ - -/* not the character */ - -/* " */ - -/* The string tokens identified by this routine are Fortran-style */ -/* quoted strings: they start and end with quote characters. In the */ -/* interior of any such token, any quote characters are represented */ -/* by doubled quote characters. These rules imply that the number of */ -/* quote characters in a quoted string token is always even. The end */ -/* of a quoted string token is located at the first even-numbered */ -/* quote character, counting from the initial quote character, that */ -/* is not the first member of a pair of quotes indicating an */ -/* embedded quote character. */ - -/* To map the token to the string of characters it represents, use */ -/* the SPICELIB subroutine PARSQS (String parse, quoted). PARSQS */ -/* removes the bracketing quotes from a quoted string token and */ -/* converts each doubled quote between the bracketing quotes to a */ -/* single quote. For example, the token */ - -/* """" */ - -/* identified by this routine would be mapped by PARSQS to a string */ -/* variable containing the single character */ - -/* " */ - -/* $ Examples */ - -/* 1) The table below illustrates the action of this routine. */ - - -/* STRING CONTENTS QCHAR FIRST LAST NCHAR */ -/* ========================================================== */ -/* The "SPICE" system " 5 11 7 */ -/* The "SPICE" system " 1 0 0 */ -/* The "SPICE" system ' 5 4 0 */ -/* The """SPICE"" system" " 5 22 18 */ -/* The """SPICE"""" system " 5 15 11 */ -/* The &&&SPICE system & 5 6 2 */ -/* ' ' ' 1 3 3 */ -/* '' ' 1 2 2 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 25-FEB-2002 (NJB) */ - -/* Corrected references to other SPICELIB routines in header. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1994 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* scan quoted string token */ -/* lex quoted string token */ -/* recognize quoted string token */ - -/* -& */ - -/* Local variables */ - - -/* Error free, no check-in required. */ - - l = i_len(string, string_len); - -/* Handle the cases in which we can tell right away that */ -/* no token can be found. */ - - if (*first < 1 || *first > l - 1 || *(unsigned char *)qchar == ' ' || *( - unsigned char *)&string[*first - 1] != *(unsigned char *)qchar) { - *last = *first - 1; - *nchar = 0; - return 0; - } - -/* We started out with a quote character, if we got this far. Now */ -/* we have to see whether a quoted string token exists. Note that */ -/* we can safely assume FIRST+1 does not exceed L. */ - - i__1 = *first; - loc = i_indx(string + i__1, qchar, l - i__1, (ftnlen)1); - if (loc == 0) { - *last = *first - 1; - *nchar = 0; - return 0; - } - -/* At this point, we have a candidate ending point for the token. */ -/* We must search for the actual end of the token. The token ends */ -/* at the first even-numbered quote character that is not part of */ -/* an embedded pair of quotes. */ - -/* Our method of looking for the end of the token will be to search */ -/* from left to right, keeping track of the rightmost character */ -/* position that could be the end of the string token, until we find */ -/* a definitive answer as to the status of our candidate. */ -/* The variable LAST will be used for this candidate character */ -/* position. The variable EVEN will tell us whether we've seen an */ -/* even number of quotes. The variable POS will point to the current */ -/* character to examine. */ - - *last = *first + loc; - even = TRUE_; - pos = *last + 1; - while(pos <= l) { - if (*(unsigned char *)&string[pos - 1] == *(unsigned char *)qchar) { - -/* Each quote character we see toggles the quote parity. */ - - even = ! even; - -/* If the current parity is even, the current quote character */ -/* becomes the candidate for the final quote. This character */ -/* can lose out only to a quote that is further to the right. */ - - if (even) { - *last = pos; - } - } else { - if (even) { - -/* The last even-numbered quote was followed by a non-quote */ -/* character. We're done. */ - - *nchar = *last - *first + 1; - return 0; - } - } - ++pos; - -/* At this point in the loop, */ - -/* EVEN indicates whether we've seen an even number of quote */ -/* characters. */ - -/* LAST is the index, relative to the start of the string, */ -/* of the last even-numbered quote we've seen. This is the */ -/* current candidate for the closing quote. */ - -/* POS is the index of the next character to examine. */ - - } - -/* Since there are no further characters to examine, the value of */ -/* LAST that we already have is the largest value we can get. */ - - *nchar = *last - *first + 1; - return 0; -} /* lxqstr_ */ - diff --git a/ext/spice/src/cspice/lxqstr_c.c b/ext/spice/src/cspice/lxqstr_c.c deleted file mode 100644 index c3490d9f2d..0000000000 --- a/ext/spice/src/cspice/lxqstr_c.c +++ /dev/null @@ -1,293 +0,0 @@ -/* - --Procedure lxqstr_c ( Lex quoted string ) - --Abstract - - Lex (scan) a quoted 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 - - CHARACTER - PARSING - SCANNING - STRING - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void lxqstr_c ( ConstSpiceChar * string, - SpiceChar qchar, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - string I String to be scanned. - qchar I Quote delimiter character. - first I Character position at which to start scanning. - last O Character position of end of token. - nchar O Number of characters in token. - --Detailed_Input - - string is a character string that may contain a "string - token" starting at the character position - indicated by the input argument first (see below). - String tokens are sequences of characters that - represent literal strings. Syntactically, a string - token is a sequence of characters that begins and - ends with a designated "quote character". Within - the token, any occurrence of the quote character - is indicated by an adjacent pair of quote - characters: for example, if the quote character is - - " - - then the token representing one instance of this - character is - - """" - - Here the first quote indicates the beginning of the - token, the next two quotes together indicate a - single quote character that constitutes the - "contents" of the token, and the final quote - indicates the end of the token. - - qchar is the quote character. This is always a single - character. The characters - - " and ' - - are common choices, but any non-blank character is - accepted. Case *is* significant in qchar. - - - first is the character position at which the routine - is to start scanning a quoted string token. Note - that the character string[first] must equal - qchar if a string token is to be found; this - routine does *not* attempt to locate the first - quoted string following the position first. - --Detailed_Output - - last is the last character position such that the subtring - ranging from string[first] to string[last] is a - quoted string token, if such a substring exists. - Otherwise, the returned value of last is first-1. - - nchar is the length of the string token found by this - routine, if such a token exists. This length - includes the starting and ending bracketing quotes. - If a string token is not found, the returned value - of nchar is zero. - --Parameters - - None. - --Exceptions - - 1) If the input argument first is less than 1 or greater than - len(string)-1, the returned value of last is first-1, and the - returned value of nchar is zero. - - 2) It is not an error for a quoted string token to consist of - two consecutive quote characters with no intervening - characters. Calling routines that require special treatment - of null tokens must handle this case. - - 3) If the input argument qchar is blank, the returned value of - last is first-1, and the returned value of nchar is zero. - - 4) If the input string pointer is null, the error SPICE(NULLPOINTER) - will be signaled. - - 5) If the input string has length zero, last will be set to first-1 - and nchar will be set to zero. This case is not considered an - error. - --Files - - None. - --Particulars - - Quote characters may be ANY non-blank character. For example, the - ampersand - - & - - is a perfectly valid quote character. If we were using the - ampersand as the quote character, then the term "doubled quote" - in the following discussion would refer to the sequence - - && - - not the character - - " - - The string tokens identified by this routine are Fortran-style - quoted strings: they start and end with quote characters. In the - interior of any such token, any quote characters are represented - by doubled quote characters. These rules imply that the number of - quote characters in a quoted string token is always even. The end - of a quoted string token is located at the first even-numbered - quote character, counting from the initial quote character, that - is not the first member of a pair of quotes indicating an - embedded quote character. - - To map the token to the string of characters it represents, use - the CSPICE subroutine parsqs_c (String parse, quoted). parsqs_c - removes the bracketing quotes from a quoted string token and - converts each doubled quote between the bracketing quotes to a - single quote. For example, the token - - """" - - identified by this routine would be mapped by parsqs_c to a string - variable containing the single character - - " - --Examples - - 1) The table below illustrates the action of this routine. - - - STRING CONTENTS qchar first last nchar - ========================================================== - The "SPICE" system " 4 10 7 - The "SPICE" system " 0 -1 0 - The "SPICE" system ' 4 3 0 - The """SPICE"" system" " 4 12 9 - The """SPICE"""" system " 4 14 11 - The &&&SPICE system & 4 5 2 - ' ' ' 0 2 3 - '' ' 0 1 2 - ========================================================== - 01234567890123456789012 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 19-AUG-2002 (NJB) - --Index_Entries - - scan quoted string token - lex quoted string token - recognize quoted string token - --& -*/ - -{ /* Begin lxqstr_c */ - - /* - Local variables - */ - SpiceInt locFirst; - SpiceInt len; - - - /* - Use discovery check-in. - - Check the input string argument for a null pointer. - */ - CHKPTR ( CHK_DISCOVER, "lxqstr_c", string ); - - - /* - We're done if the input string has zero length. - */ - len = strlen(string); - - if ( len == 0 ) - { - *last = first - 1; - *nchar = 0; - - return; - } - - - /* - Map first to a Fortran-style index. - */ - locFirst = first + 1; - - - /* - Call the f2c'd routine. - */ - lxqstr_ ( ( char * ) string, - ( char * ) &qchar, - ( integer * ) &locFirst, - ( integer * ) last, - ( integer * ) nchar, - ( ftnlen ) len, - ( ftnlen ) 1 ); - - /* - Map last to a C-style index. - */ - - (*last)--; - - -} /* End lxqstr_c */ diff --git a/ext/spice/src/cspice/m2eul.c b/ext/spice/src/cspice/m2eul.c deleted file mode 100644 index 348e6fc131..0000000000 --- a/ext/spice/src/cspice/m2eul.c +++ /dev/null @@ -1,954 +0,0 @@ -/* m2eul.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b15 = .1; -static integer c__9 = 9; - -/* $Procedure M2EUL ( Matrix to Euler angles ) */ -/* Subroutine */ int m2eul_(doublereal *r__, integer *axis3, integer *axis2, - integer *axis1, doublereal *angle3, doublereal *angle2, doublereal * - angle1) -{ - /* Initialized data */ - - static integer next[3] = { 2,3,1 }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double acos(doublereal), atan2(doublereal, doublereal), asin(doublereal); - - /* Local variables */ - doublereal sign; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), mtxm_( - doublereal *, doublereal *, doublereal *); - integer c__, i__; - logical degen; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical isrot_(doublereal *, doublereal *, doublereal *); - doublereal change[9] /* was [3][3] */; - extern /* Subroutine */ int cleard_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - doublereal tmpmat[9] /* was [3][3] */; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal tmprot[9] /* was [3][3] */; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Factor a rotation matrix as a product of three rotations about */ -/* specified coordinate axes. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* ANGLE */ -/* MATRIX */ -/* ROTATION */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* R I A rotation matrix to be factored. */ -/* AXIS3, */ -/* AXIS2, */ -/* AXIS1 I Numbers of third, second, and first rotation axes. */ -/* ANGLE3, */ -/* ANGLE2, */ -/* ANGLE1 O Third, second, and first Euler angles, in radians. */ - -/* $ Detailed_Input */ - -/* R is a 3x3 rotation matrix that is to be factored as */ -/* a product of three rotations about a specified */ -/* coordinate axes. The angles of these rotations are */ -/* called `Euler angles'. */ - -/* AXIS3, */ -/* AXIS2, */ -/* AXIS1 are the indices of the rotation axes of the */ -/* `factor' rotations, whose product is R. R is */ -/* factored as */ - -/* R = [ ANGLE3 ] [ ANGLE2 ] [ ANGLE1 ] . */ -/* AXIS3 AXIS2 AXIS1 */ - -/* The axis numbers must belong to the set {1, 2, 3}. */ -/* The second axis number MUST differ from the first */ -/* and third axis numbers. */ - -/* See the $ Particulars section below for details */ -/* concerning this notation. */ - -/* $ Detailed_Output */ - -/* ANGLE3, */ -/* ANGLE2, */ -/* ANGLE1 are the Euler angles corresponding to the matrix */ -/* R and the axes specified by AXIS3, AXIS2, and */ -/* AXIS1. These angles satisfy the equality */ - -/* R = [ ANGLE3 ] [ ANGLE2 ] [ ANGLE1 ] */ -/* AXIS3 AXIS2 AXIS1 */ - - -/* See the $ Particulars section below for details */ -/* concerning this notation. */ - -/* The range of ANGLE3 and ANGLE1 is (-pi, pi]. */ - -/* The range of ANGLE2 depends on the exact set of */ -/* axes used for the factorization. For */ -/* factorizations in which the first and third axes */ -/* are the same, */ - -/* R = [r] [s] [t] , */ -/* a b a */ - -/* the range of ANGLE2 is [0, pi]. */ - - -/* For factorizations in which the first and third */ -/* axes are different, */ - -/* R = [r] [s] [t] , */ -/* a b c */ - -/* the range of ANGLE2 is [-pi/2, pi/2]. */ - -/* For rotations such that ANGLE3 and ANGLE1 are not */ -/* uniquely determined, ANGLE3 will always be set to */ -/* zero; ANGLE1 is then uniquely determined. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any of AXIS3, AXIS2, or AXIS1 do not have values in */ - -/* { 1, 2, 3 }, */ - -/* then the error SPICE(BADAXISNUMBERS) is signaled. */ - -/* 2) An arbitrary rotation matrix cannot be expressed using */ -/* a sequence of Euler angles unless the second rotation axis */ -/* differs from the other two. If AXIS2 is equal to AXIS3 or */ -/* AXIS1, then then error SPICE(BADAXISNUMBERS) is signaled. */ - -/* 3) If the input matrix R is not a rotation matrix, the error */ -/* SPICE(NOTAROTATION) is signaled. */ - -/* 4) If ANGLE3 and ANGLE1 are not uniquely determined, ANGLE3 */ -/* is set to zero, and ANGLE1 is determined. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A word about notation: the symbol */ - -/* [ x ] */ -/* i */ - -/* indicates a coordinate system rotation of x radians about the */ -/* ith coordinate axis. To be specific, the symbol */ - -/* [ x ] */ -/* 1 */ - -/* indicates a coordinate system rotation of x radians about the */ -/* first, or x-, axis; the corresponding matrix is */ - -/* +- -+ */ -/* | 1 0 0 | */ -/* | | */ -/* | 0 cos(x) sin(x) |. */ -/* | | */ -/* | 0 -sin(x) cos(x) | */ -/* +- -+ */ - -/* Remember, this is a COORDINATE SYSTEM rotation by x radians; this */ -/* matrix, when applied to a vector, rotates the vector by -x */ -/* radians, not x radians. Applying the matrix to a vector yields */ -/* the vector's representation relative to the rotated coordinate */ -/* system. */ - -/* The analogous rotation about the second, or y-, axis is */ -/* represented by */ - -/* [ x ] */ -/* 2 */ - -/* which symbolizes the matrix */ - -/* +- -+ */ -/* | cos(x) 0 -sin(x) | */ -/* | | */ -/* | 0 1 0 |, */ -/* | | */ -/* | sin(x) 0 cos(x) | */ -/* +- -+ */ - -/* and the analogous rotation about the third, or z-, axis is */ -/* represented by */ - -/* [ x ] */ -/* 3 */ - -/* which symbolizes the matrix */ - -/* +- -+ */ -/* | cos(x) sin(x) 0 | */ -/* | | */ -/* | -sin(x) cos(x) 0 |. */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - - -/* The input matrix is assumed to be the product of three */ -/* rotation matrices, each one of the form */ - -/* +- -+ */ -/* | 1 0 0 | */ -/* | | */ -/* | 0 cos(r) sin(r) | (rotation of r radians about the */ -/* | | x-axis), */ -/* | 0 -sin(r) cos(r) | */ -/* +- -+ */ - - -/* +- -+ */ -/* | cos(s) 0 -sin(s) | */ -/* | | */ -/* | 0 1 0 | (rotation of s radians about the */ -/* | | y-axis), */ -/* | sin(s) 0 cos(s) | */ -/* +- -+ */ - -/* or */ - -/* +- -+ */ -/* | cos(t) sin(t) 0 | */ -/* | | */ -/* | -sin(t) cos(t) 0 | (rotation of t radians about the */ -/* | | z-axis), */ -/* | 0 0 1 | */ -/* +- -+ */ - -/* where the second rotation axis is not equal to the first or */ -/* third. Any rotation matrix can be factored as a sequence of */ -/* three such rotations, provided that this last criterion is met. */ - -/* This routine is related to the SPICELIB routine EUL2M, which */ -/* produces a rotation matrix, given a sequence of Euler angles. */ -/* This routine is a `right inverse' of EUL2M: the sequence of */ -/* calls */ - -/* CALL M2EUL ( R, AXIS3, AXIS2, AXIS1, */ -/* . ANGLE3, ANGLE2, ANGLE1 ) */ - -/* CALL EUL2M ( ANGLE3, ANGLE2, ANGLE1, */ -/* . AXIS3, AXIS2, AXIS1, R ) */ - -/* preserves R, except for round-off error. */ - - -/* On the other hand, the sequence of calls */ - -/* CALL EUL2M ( ANGLE3, ANGLE2, ANGLE1, */ -/* . AXIS3, AXIS2, AXIS1, R ) */ - -/* CALL M2EUL ( R, AXIS3, AXIS2, AXIS1, */ -/* . ANGLE3, ANGLE2, ANGLE1 ) */ - - -/* preserve ANGLE3, ANGLE2, and ANGLE1 only if these angles start */ -/* out in the ranges that M2EUL's outputs are restricted to. */ - -/* $ Examples */ - -/* 1) Conversion of instrument pointing from a matrix representation */ -/* to Euler angles: */ - -/* Suppose we want to find camera pointing in alpha, delta, and */ -/* kappa, given the inertial-to-camera coordinate transformation */ - - -/* +- -+ */ -/* | 0.49127379678135830 0.50872620321864170 0.70699908539882417 | */ -/* | | */ -/* | -0.50872620321864193 -0.49127379678135802 0.70699908539882428 | */ -/* | | */ -/* | 0.70699908539882406 -0.70699908539882439 0.01745240643728360 | */ -/* +- -+ */ - - -/* We want to find angles alpha, delta, kappa such that */ - -/* TICAM = [ kappa ] [ pi/2 - delta ] [ pi/2 + alpha ] . */ -/* 3 1 3 */ - -/* We can use the following small program to do this computation: */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION HALFPI */ -/* DOUBLE PRECISION TWOPI */ - -/* DOUBLE PRECISION ALPHA */ -/* DOUBLE PRECISION ANG1 */ -/* DOUBLE PRECISION ANG2 */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION KAPPA */ -/* DOUBLE PRECISION TICAM ( 3, 3 ) */ - - -/* DATA TICAM / 0.49127379678135830D0, */ -/* . -0.50872620321864193D0, */ -/* . 0.70699908539882406D0, */ -/* . 0.50872620321864170D0, */ -/* . -0.49127379678135802D0, */ -/* . -0.70699908539882439D0, */ -/* . 0.70699908539882417D0, */ -/* . 0.70699908539882428D0, */ -/* . 0.01745240643728360D0 / */ - - -/* CALL M2EUL ( TICAM, 3, 1, 3, KAPPA, ANG2, ANG1 ) */ - -/* DELTA = HALFPI() - ANG2 */ -/* ALPHA = ANG1 - HALFPI() */ - -/* IF ( KAPPA .LT. 0.D0 ) THEN */ -/* KAPPA = KAPPA + TWOPI() */ -/* END IF */ - -/* IF ( ALPHA .LT. 0.D0 ) THEN */ -/* ALPHA = ALPHA + TWOPI() */ -/* END IF */ - -/* WRITE (*,'(1X,A,F24.14)') 'Alpha (deg): ', DPR() * ALPHA */ -/* WRITE (*,'(1X,A,F24.14)') 'Delta (deg): ', DPR() * DELTA */ -/* WRITE (*,'(1X,A,F24.14)') 'Kappa (deg): ', DPR() * KAPPA */ - -/* END */ - - -/* The program's output should be something like */ - -/* Alpha (deg): 315.00000000000000 */ -/* Delta (deg): 1.00000000000000 */ -/* Kappa (deg): 45.00000000000000 */ - -/* possibly formatted a little differently, or degraded slightly */ -/* by round-off. */ - - -/* 2) Conversion of instrument pointing angles from a non-J2000, */ -/* not necessarily inertial frame to J2000-relative RA, Dec, */ -/* and Twist. */ - -/* Suppose that we have pointing for some instrument expressed as */ - -/* [ gamma ] [ beta ] [ alpha ] */ -/* 3 2 3 */ - -/* with respect to some coordinate system S. For example, S */ -/* could be a spacecraft-fixed system. */ - -/* We will suppose that the transformation from J2000 */ -/* coordinates to system S coordinates is given by the rotation */ -/* matrix J2S. */ - -/* The rows of J2S are the unit basis vectors of system S, given */ -/* in J2000 coordinates. */ - -/* We want to express the pointing with respect to the J2000 */ -/* system as the sequence of rotations */ - -/* [ kappa ] [ pi/2 - delta ] [ pi/2 + alpha ] . */ -/* 3 1 3 */ - -/* First, we use subroutine EUL2M to form the transformation */ -/* from system S to instrument coordinates S2INST. */ - -/* CALL EUL2M ( GAMMA, BETA, ALPHA, 3, 2, 3, S2INST ) */ - -/* Next, we form the transformation from J2000 to instrument */ -/* coordinates J2INST. */ - -/* CALL MXM ( S2INST, J2S, J2INST ) */ - -/* Finally, we express J2INST using the desired Euler angles, as */ -/* in the first example: */ - -/* CALL M2EUL ( J2INST, 3, 1, 3, TWIST, ANG2, ANG3 ) */ - -/* RA = ANG3 - HALFPI() */ -/* DEC = HALFPI() - ANG2 */ - -/* If we wish to make sure that RA, DEC, and TWIST are in */ -/* the ranges [0, 2pi), [-pi/2, pi/2], and [0, 2pi) */ -/* respectively, we may add the code */ - -/* IF ( RA .LT. 0.D0 ) THEN */ -/* RA = RA + TWOPI() */ -/* END IF */ - -/* IF ( TWIST .LT. 0.D0 ) THEN */ -/* TWIST = TWIST + TWOPI() */ -/* END IF */ - -/* Note that DEC is already in the correct range, since ANG2 */ -/* is in the range [0, pi] when the first and third input axes */ -/* are equal. */ - -/* Now RA, DEC, and TWIST express the instrument pointing */ -/* as RA, Dec, and Twist, relative to the J2000 system. */ - -/* A warning note: more than one definition of RA, Dec, and */ -/* Twist is extant. Before using this example in an application, */ -/* check that the definition given here is consistent with that */ -/* used in your application. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 21-DEC-2006 (NJB) */ - -/* Error corrected in header example: input matrix */ -/* previously did not match shown outputs. Offending */ -/* example now includes complete program. */ - -/* - SPICELIB Version 1.2.0, 15-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM and MTXM calls. A short error message cited in */ -/* the Exceptions section of the header failed to match */ -/* the actual short message used; this has been corrected. */ - -/* - SPICELIB Version 1.1.2, 13-OCT-2004 (NJB) */ - -/* Fixed header typo. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (NJB) */ - -/* Header upgraded to describe notation in more detail. Argument */ -/* names were changed to describe the use of the arguments more */ -/* accurately. No change in functionality was made; the operation */ -/* of the routine is identical to that of the previous version. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix to euler angles */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 26-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM and MTXM calls. A short error message cited in */ -/* the Exceptions section of the header failed to match */ -/* the actual short message used; this has been corrected. */ - -/* - SPICELIB Version 1.1.0, 02-NOV-1990 (NJB) */ - -/* Argument names were changed to describe the use of the */ -/* arguments more accurately. The axis and angle numbers */ -/* now decrease, rather than increase, from left to right. */ -/* The current names reflect the order of operator application */ -/* when the Euler angle rotations are applied to a vector: the */ -/* rightmost matrix */ - -/* [ ANGLE1 ] */ -/* AXIS1 */ - -/* is applied to the vector first, followed by */ - -/* [ ANGLE2 ] */ -/* AXIS2 */ - -/* and then */ - -/* [ ANGLE3 ] */ -/* AXIS3 */ - -/* Previously, the names reflected the order in which the Euler */ -/* angle matrices appear on the page, from left to right. This */ -/* naming convention was found to be a bit obtuse by a various */ -/* users. */ - -/* No change in functionality was made; the operation of the */ -/* routine is identical to that of the previous version. */ - -/* Also, the header was upgraded to describe the notation in more */ -/* detail. The symbol */ - -/* [ x ] */ -/* i */ - -/* is explained at mind-numbing length. An example was added */ -/* that shows a specific set of inputs and the resulting output */ -/* matrix. */ - -/* The angle sequence notation was changed to be consistent with */ -/* Rotations required reading. */ - -/* 1-2-3 and a-b-c */ - -/* have been changed to */ - -/* 3-2-1 and c-b-a. */ - -/* Also, one `)' was changed to a `}'. */ - -/* The phrase `first and third' was changed to `first or third' */ -/* in the $ Particulars section, where the criterion for the */ -/* existence of an Euler angle factorization is stated. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* NTOL and DETOL are used to determine whether R is a rotation */ -/* matrix. */ - -/* NTOL is the tolerance for the norms of the columns of R. */ - -/* DTOL is the tolerance for the determinant of a matrix whose */ -/* columns are the unitized columns of R. */ - - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("M2EUL", (ftnlen)5); - } - -/* The first order of business is to screen out the goofy cases. */ - -/* Make sure the axis numbers are all right: They must belong to */ -/* the set {1, 2, 3}... */ - - if (*axis3 < 1 || *axis3 > 3 || (*axis2 < 1 || *axis2 > 3) || (*axis1 < 1 - || *axis1 > 3)) { - setmsg_("Axis numbers are #, #, #. ", (ftnlen)28); - errint_("#", axis3, (ftnlen)1); - errint_("#", axis2, (ftnlen)1); - errint_("#", axis1, (ftnlen)1); - sigerr_("SPICE(BADAXISNUMBERS)", (ftnlen)21); - chkout_("M2EUL", (ftnlen)5); - return 0; - -/* ...and the second axis number must differ from its neighbors. */ - - } else if (*axis3 == *axis2 || *axis1 == *axis2) { - setmsg_("Middle axis matches neighbor: # # #.", (ftnlen)36); - errint_("#", axis3, (ftnlen)1); - errint_("#", axis2, (ftnlen)1); - errint_("#", axis1, (ftnlen)1); - sigerr_("SPICE(BADAXISNUMBERS)", (ftnlen)21); - chkout_("M2EUL", (ftnlen)5); - return 0; - -/* R must be a rotation matrix, or we may as well forget it. */ - - } else if (! isrot_(r__, &c_b15, &c_b15)) { - setmsg_("Input matrix is not a rotation.", (ftnlen)31); - sigerr_("SPICE(NOTAROTATION)", (ftnlen)19); - chkout_("M2EUL", (ftnlen)5); - return 0; - } - -/* AXIS3, AXIS2, AXIS1 and R have passed their tests at this */ -/* point. We take the liberty of working with TMPROT, a version */ -/* of R that has unitized columns. */ - - for (i__ = 1; i__ <= 3; ++i__) { - vhat_(&r__[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "r", i__1, "m2eul_", (ftnlen)667)], &tmprot[(i__2 = i__ * 3 - - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2, "m2eul_", - (ftnlen)667)]); - } - -/* We now proceed to recover the promised Euler angles from */ -/* TMPROT. */ - -/* The ideas behind our method are explained in excruciating */ -/* detail in the ROTATION required reading, so we'll be terse. */ -/* Nonetheless, a word of explanation is in order. */ - -/* The sequence of rotation axes used for the factorization */ -/* belongs to one of two categories: a-b-a or c-b-a. We */ -/* wish to handle each of these cases in one shot, rather than */ -/* using different formulas for each sequence to recover the */ -/* Euler angles. */ - -/* What we're going to do is use the Euler angle formula for the */ -/* 3-1-3 factorization for all of the a-b-a sequences, and the */ -/* formula for the 3-2-1 factorization for all of the c-b-a */ -/* sequences. */ - -/* How can we get away with this? The Euler angle formulas for */ -/* each factorization are different! */ - -/* Our trick is to apply a change-of-basis transformation to the */ -/* input matrix R. For the a-b-a factorizations, we choose a new */ -/* basis such that a rotation of ANGLE3 radians about the basis */ -/* vector indexed by AXIS3 becomes a rotation of ANGLE3 radians */ -/* about the third coordinate axis, and such that a rotation of */ -/* ANGLE2 radians about the basis vector indexed by AXIS2 becomes */ -/* a rotation of ANGLE2 radians about the first coordinate axis. */ -/* So R can be factored as a 3-1-3 rotation relative to the new */ -/* basis, and the Euler angles we obtain are the exact ones we */ -/* require. */ - -/* The c-b-a factorizations can be handled in an analogous */ -/* fashion. We transform R to a basis where the original axis */ -/* sequence becomes a 3-2-1 sequence. In some cases, the angles */ -/* we obtain will be the negatives of the angles we require. This */ -/* will happen if and only if the ordered basis (here the e's are */ -/* the standard basis vectors) */ - -/* { e e e } */ -/* AXIS3 AXIS2 AXIS1 */ - -/* is not right-handed. An easy test for this condition is that */ -/* AXIS2 is not the successor of AXIS3, where the ordering is */ -/* cyclic. */ - - if (*axis3 == *axis1) { - -/* The axis order is a-b-a. We're going to find a matrix CHANGE */ -/* such that */ - -/* T */ -/* CHANGE R CHANGE */ - -/* gives us R in the a useful basis, that is, a basis in which */ -/* our original a-b-a rotation is a 3-1-3 rotation, but where the */ -/* rotation angles are unchanged. To achieve this pleasant */ -/* simplification, we set column 3 of CHANGE to to e(AXIS3), */ -/* column 1 of CHANGE to e(AXIS2), and column 2 of CHANGE to */ - -/* (+/-) e(C), */ - -/* (C is the remaining index) depending on whether */ -/* AXIS3-AXIS2-C is a right-handed sequence of axes: if it */ -/* is, the sign is positive. (Here e(1), e(2), e(3) are the */ -/* standard basis vectors.) */ - -/* Determine the sign of our third basis vector, so that we can */ -/* ensure that our new basis is right-handed. The variable NEXT */ -/* is just a little mapping that takes 1 to 2, 2 to 3, and 3 to */ -/* 1. */ - - if (*axis2 == next[(i__1 = *axis3 - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("next", i__1, "m2eul_", (ftnlen)746)]) { - sign = 1.; - } else { - sign = -1.; - } - -/* Since the axis indices sum to 6, */ - - c__ = 6 - *axis3 - *axis2; - -/* Set up the entries of CHANGE: */ - - cleard_(&c__9, change); - change[(i__1 = *axis3 + 5) < 9 && 0 <= i__1 ? i__1 : s_rnge("change", - i__1, "m2eul_", (ftnlen)762)] = 1.; - change[(i__1 = *axis2 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("change", - i__1, "m2eul_", (ftnlen)763)] = 1.; - change[(i__1 = c__ + 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("change", - i__1, "m2eul_", (ftnlen)764)] = sign * 1.; - -/* Transform TMPROT. */ - - mxm_(tmprot, change, tmpmat); - mtxm_(change, tmpmat, tmprot); - -/* Now we're ready to find the Euler angles, using a */ -/* 3-1-3 factorization. In general, the matrix product */ - -/* [ a1 ] [ a2 ] [ a3 ] */ -/* 3 1 3 */ - -/* has the form */ - -/* +- -+ */ -/* | cos(a1)cos(a3) cos(a1)sin(a3) sin(a1)sin(a2) | */ -/* | -sin(a1)cos(a2)sin(a3) +sin(a1)cos(a2)cos(a3) | */ -/* | | */ -/* | -sin(a1)cos(a3) -sin(a1)sin(a3) cos(a1)sin(a2) | */ -/* | -cos(a1)cos(a2)sin(a3) +cos(a1)cos(a2)cos(a3) | */ -/* | | */ -/* | sin(a2)sin(a3) -sin(a2)cos(a3) cos(a2) | */ -/* +- -+ */ - - -/* but if a2 is 0 or pi, the product matrix reduces to */ - - -/* +- -+ */ -/* | cos(a1)cos(a3) cos(a1)sin(a3) 0 | */ -/* | -sin(a1)cos(a2)sin(a3) +sin(a1)cos(a2)cos(a3) | */ -/* | | */ -/* | -sin(a1)cos(a3) -sin(a1)sin(a3) 0 | */ -/* | -cos(a1)cos(a2)sin(a3) +cos(a1)cos(a2)cos(a3) | */ -/* | | */ -/* | 0 0 cos(a2) | */ -/* +- -+ */ - - -/* In this case, a1 and a3 are not uniquely determined. If we */ -/* arbitrarily set a1 to zero, we arrive at the matrix */ - -/* +- -+ */ -/* | cos(a3) sin(a3) 0 | */ -/* | -cos(a2)sin(a3) cos(a2)cos(a3) 0 | */ -/* | 0 0 cos(a2) | */ -/* +- -+ */ - -/* We take care of this case first. We test three conditions */ -/* that are mathematically equivalent, but may not be satisfied */ -/* simultaneously because of round-off: */ - - - degen = tmprot[6] == 0. && tmprot[7] == 0. || tmprot[2] == 0. && - tmprot[5] == 0. || abs(tmprot[8]) == 1.; - -/* In the following block of code, we make use of the fact that */ - -/* SIN ( ANGLE2 ) > 0 */ -/* - */ -/* in choosing the signs of the ATAN2 arguments correctly. Note */ -/* that ATAN2(x,y) = -ATAN2(-x,-y). */ - - - if (degen) { - *angle3 = 0.; - *angle2 = acos(tmprot[8]); - *angle1 = atan2(tmprot[3], tmprot[0]); - } else { - -/* The normal case. */ - - *angle3 = atan2(tmprot[6], tmprot[7]); - *angle2 = acos(tmprot[8]); - *angle1 = atan2(tmprot[2], -tmprot[5]); - } - } else { - -/* The axis order is c-b-a. We're going to find a matrix CHANGE */ -/* such that */ - -/* T */ -/* CHANGE R CHANGE */ - -/* gives us R in the a useful basis, that is, a basis in which */ -/* our original c-b-a rotation is a 3-2-1 rotation, but where the */ -/* rotation angles are unchanged, or at worst negated. To */ -/* achieve this pleasant simplification, we set column 1 of */ -/* CHANGE to to e(AXIS3), column 2 of CHANGE to e(AXIS2), and */ -/* column 3 of CHANGE to */ - -/* (+/-) e(AXIS1), */ - -/* depending on whether AXIS3-AXIS2-AXIS1 is a right-handed */ -/* sequence of axes: if it is, the sign is positive. (Here */ -/* e(1), e(2), e(3) are the standard basis vectors.) */ - -/* We must be cautious here, because if AXIS3-AXIS2-AXIS1 is a */ -/* right-handed sequence of axes, all of the rotation angles will */ -/* be the same in our new basis, but if it's a left-handed */ -/* sequence, the third angle will be negated. Let's get this */ -/* straightened out right now. The variable NEXT is just a */ -/* little mapping that takes 1 to 2, 2 to 3, and 3 to 1. */ - - if (*axis2 == next[(i__1 = *axis3 - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("next", i__1, "m2eul_", (ftnlen)883)]) { - sign = 1.; - } else { - sign = -1.; - } - -/* Set up the entries of CHANGE: */ - - cleard_(&c__9, change); - change[(i__1 = *axis3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("change", - i__1, "m2eul_", (ftnlen)894)] = 1.; - change[(i__1 = *axis2 + 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("change", - i__1, "m2eul_", (ftnlen)895)] = 1.; - change[(i__1 = *axis1 + 5) < 9 && 0 <= i__1 ? i__1 : s_rnge("change", - i__1, "m2eul_", (ftnlen)896)] = sign * 1.; - -/* Transform TMPROT. */ - - mxm_(tmprot, change, tmpmat); - mtxm_(change, tmpmat, tmprot); - -/* Now we're ready to find the Euler angles, using a */ -/* 3-2-1 factorization. In general, the matrix product */ - -/* [ a1 ] [ a2 ] [ a3 ] */ -/* 1 2 3 */ - -/* has the form */ - - -/* +- -+ */ -/* | cos(a2)cos(a3) cos(a2)sin(a3) -sin(a2) | */ -/* | | */ -/* | -cos(a1)sin(a3) cos(a1)cos(a3) sin(a1)cos(a2) | */ -/* | +sin(a1)sin(a2)cos(a3) +sin(a1)sin(a2)sin(a3) | */ -/* | | */ -/* | sin(a1)sin(a3) -sin(a1)cos(a3) cos(a1)cos(a2) | */ -/* | +cos(a1)sin(a2)cos(a3) +cos(a1)sin(a2)sin(a3) | */ -/* +- -+ */ - - -/* but if a2 is -pi/2 or pi/2, the product matrix reduces to */ - - -/* +- -+ */ -/* | 0 0 -sin(a2) | */ -/* | | */ -/* | -cos(a1)sin(a3) cos(a1)cos(a3) 0 | */ -/* | +sin(a1)sin(a2)cos(a3) +sin(a1)sin(a2)sin(a3) | */ -/* | | */ -/* | sin(a1)sin(a3) -sin(a1)cos(a3) 0 | */ -/* | +cos(a1)sin(a2)cos(a3) +cos(a1)sin(a2)sin(a3) | */ -/* +- -+ */ - - -/* In this case, a1 and a3 are not uniquely determined. If we */ -/* arbitrarily set a1 to zero, we arrive at the matrix */ - -/* +- -+ */ -/* | 0 0 -sin(a2) | */ -/* | -sin(a3) cos(a3) 0 |, */ -/* | sin(a2)cos(a3) sin(a2)sin(a3) 0 | */ -/* +- -+ */ - - -/* We take care of this case first. We test three conditions */ -/* that are mathematically equivalent, but may not be satisfied */ -/* simultaneously because of round-off: */ - - - degen = tmprot[0] == 0. && tmprot[3] == 0. || tmprot[7] == 0. && - tmprot[8] == 0. || abs(tmprot[6]) == 1.; - -/* In the following block of code, we make use of the fact that */ - -/* COS ( ANGLE2 ) > 0 */ -/* - */ -/* in choosing the signs of the ATAN2 arguments correctly. Note */ -/* that ATAN2(x,y) = -ATAN2(-x,-y). */ - - - if (degen) { - *angle3 = 0.; - *angle2 = asin(-tmprot[6]); - *angle1 = sign * atan2(-tmprot[1], tmprot[4]); - } else { - -/* The normal case. */ - - *angle3 = atan2(tmprot[7], tmprot[8]); - *angle2 = asin(-tmprot[6]); - *angle1 = sign * atan2(tmprot[3], tmprot[0]); - } - } - chkout_("M2EUL", (ftnlen)5); - return 0; -} /* m2eul_ */ - diff --git a/ext/spice/src/cspice/m2eul_c.c b/ext/spice/src/cspice/m2eul_c.c deleted file mode 100644 index b81dfd7e40..0000000000 --- a/ext/spice/src/cspice/m2eul_c.c +++ /dev/null @@ -1,501 +0,0 @@ -/* - --Procedure m2eul_c ( Matrix to Euler angles ) - --Abstract - - Factor a rotation matrix as a product of three rotations about - specified coordinate axes. - --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 - - ROTATION - --Keywords - - ANGLE - MATRIX - ROTATION - TRANSFORMATION - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef m2eul_c - - - void m2eul_c ( ConstSpiceDouble r[3][3], - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble * angle3, - SpiceDouble * angle2, - SpiceDouble * angle1 ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - r I A rotation matrix to be factored. - axis3, - axis2, - axis1 I Numbers of third, second, and first rotation axes. - angle3, - angle2, - angle1 O Third, second, and first Euler angles, in radians. - --Detailed_Input - - r is a 3x3 rotation matrix that is to be factored as - a product of three rotations about a specified - coordinate axes. The angles of these rotations are - called `Euler angles'. - - axis3, - axis2, - axis1 are the indices of the rotation axes of the - `factor' rotations, whose product is r. r is - factored as - - r = [ angle3 ] [ angle2 ] [ angle1 ] . - axis3 axis2 axis1 - - The axis numbers must belong to the set {1, 2, 3}. - The second axis number MUST differ from the first - and third axis numbers. - - See the Particulars section below for details - concerning this notation. - --Detailed_Output - - angle3, - angle2, - angle1 are the Euler angles corresponding to the matrix - r and the axes specified by axis3, axis2, and - axis1. These angles satisfy the equality - - r = [ angle3 ] [ angle2 ] [ angle1 ] - axis3 axis2 axis1 - - - See the Particulars section below for details - concerning this notation. - - The range of angle3 and angle1 is (-pi, pi]. - - The range of angle2 depends on the exact set of - axes used for the factorization. For - factorizations in which the first and third axes - are the same, - - r = [R] [S] [T] , - a b a - - the range of angle2 is [0, pi]. - - - For factorizations in which the first and third - axes are different, - - r = [R] [S] [T] , - a b c - - the range of angle2 is [-pi/2, pi/2]. - - For rotations such that angle3 and angle1 are not - uniquely determined, angle3 will always be set to - zero; angle1 is then uniquely determined. - --Parameters - - None. - --Exceptions - - 1) If any of axis3, axis2, or axis1 do not have values in - - { 1, 2, 3 }, - - then the error SPICE(INPUTOUTOFRANGE) is signalled. - - 2) An arbitrary rotation matrix cannot be expressed using - a sequence of Euler angles unless the second rotation axis - differs from the other two. If axis2 is equal to axis3 or - axis1, then then error SPICE(BADAXISNUMBERS) is signalled. - - 3) If the input matrix r is not a rotation matrix, the error - SPICE(NOTAROTATION) is signalled. - - 4) If angle3 and angle1 are not uniquely determined, angle3 - is set to zero, and angle1 is determined. - --Files - - None. - --Particulars - - A word about notation: the symbol - - [ x ] - i - - indicates a coordinate system rotation of x radians about the - ith coordinate axis. To be specific, the symbol - - [ x ] - 1 - - indicates a coordinate system rotation of x radians about the - first, or x-, axis; the corresponding matrix is - - +- -+ - | 1 0 0 | - | | - | 0 cos(x) sin(x) |. - | | - | 0 -sin(x) cos(x) | - +- -+ - - Remember, this is a COORDINATE SYSTEM rotation by x radians; this - matrix, when applied to a vector, rotates the vector by -x - radians, not x radians. Applying the matrix to a vector yields - the vector's representation relative to the rotated coordinate - system. - - The analogous rotation about the second, or y-, axis is - represented by - - [ x ] - 2 - - which symbolizes the matrix - - +- -+ - | cos(x) 0 -sin(x) | - | | - | 0 1 0 |, - | | - | sin(x) 0 cos(x) | - +- -+ - - and the analogous rotation about the third, or z-, axis is - represented by - - [ x ] - 3 - - which symbolizes the matrix - - +- -+ - | cos(x) sin(x) 0 | - | | - | -sin(x) cos(x) 0 |. - | | - | 0 0 1 | - +- -+ - - - The input matrix is assumed to be the product of three - rotation matrices, each one of the form - - +- -+ - | 1 0 0 | - | | - | 0 cos(r) sin(r) | (rotation of r radians about the - | | x-axis), - | 0 -sin(r) cos(r) | - +- -+ - - - +- -+ - | cos(s) 0 -sin(s) | - | | - | 0 1 0 | (rotation of s radians about the - | | y-axis), - | sin(s) 0 cos(s) | - +- -+ - - or - - +- -+ - | cos(t) sin(t) 0 | - | | - | -sin(t) cos(t) 0 | (rotation of t radians about the - | | z-axis), - | 0 0 1 | - +- -+ - - where the second rotation axis is not equal to the first or - third. Any rotation matrix can be factored as a sequence of - three such rotations, provided that this last criterion is met. - - This routine is related to the CSPICE routine EUL2M, which - produces a rotation matrix, given a sequence of Euler angles. - This routine is a `right inverse' of EUL2M: the sequence of - calls - - m2eul_c ( r, axis3, axis2, axis1, - angle3, angle2, angle1 ); - - eul2m_c ( angle3, angle2, angle1, - axis3, axis2, axis1, r ); - - preserves r, except for round-off error. - - - On the other hand, the sequence of calls - - eul2m_c ( angle3, angle2, angle1, - axis3, axis2, axis1, r ); - - m2eul_c ( r, axis3, axis2, axis1, - angle3, angle2, angle1 ); - - - preserve angle3, angle2, and angle1 only if these angles start - out in the ranges that m2eul_c's outputs are restricted to. - --Examples - - 1) Conversion of instrument pointing from a matrix representation - to Euler angles: - - Suppose we want to find camera pointing in alpha, delta, and - kappa, given the inertial-to-camera coordinate transformation - - - ticam = - - +- -+ - | 0.49127379678135830 0.50872620321864170 0.70699908539882417 | - | | - | -0.50872620321864193 -0.49127379678135802 0.70699908539882428 | - | | - | 0.70699908539882406 -0.70699908539882439 0.01745240643728360 | - +- -+ - - - We want to find angles alpha, delta, kappa such that - - ticam = [ kappa ] [ pi/2 - delta ] [ pi/2 + alpha ] . - 3 1 3 - - The code fragment - - m2eul_c ( ticam, 3, 1, 3, &kappa, &ang2, &ang1 ); - - alpha = ang1 - halfpi_c(); - delta = halfpi_c() - ang2; - - calculates the desired angles. If we wish to make sure that - alpha, delta, and kappa are in the ranges [0, 2pi), - [-pi/2, pi/2], and [0, 2pi) respectively, we may add the code - - if ( alpha < 0. ) - { - alpha = alpha + twopi_c(); - } - - if ( kappa < 0. ) - { - kappa = kappa + twopi_c(); - } - - Note that delta is already in the correct range, since ang2 - is in the range [0, pi] when the first and third input axes - are equal. - - If we wish to print out the results in degrees, we might - use the code - - printf ( "Alpha = %25.17f\n" - "Delta = %25.17f\n" - "Kappa = %25.17f\n", - dpr_c() * alpha, - dpr_c() * delta, - dpr_c() * kappa ); - - - We should see something like - - Alpha = 315.00000000000000000 - Delta = 1.00000000000000000 - Kappa = 45.00000000000000000 - - possibly formatted a little differently, or degraded slightly - by round-off. - - - 2) Conversion of instrument pointing angles from a non-J2000, - not necessarily inertial frame to J2000-relative RA, Dec, - and Twist. - - Suppose that we have pointing for some instrument expressed as - - [ gamma ] [ beta ] [ alpha ] - 3 2 3 - - with respect to some coordinate system S. For example, S - could be a spacecraft-fixed system. - - We will suppose that the transformation from J2000 - coordinates to system S coordinates is given by the rotation - matrix j2s. - - The rows of j2s are the unit basis vectors of system S, given - in J2000 coordinates. - - We want to express the pointing with respect to the J2000 - system as the sequence of rotations - - [ kappa ] [ pi/2 - delta ] [ pi/2 + alpha ] . - 3 1 3 - - First, we use subroutine eul2m_c to form the transformation - from system S to instrument coordinates s2inst. - - eul2m_c ( gamma, beta, alpha, 3, 2, 3, s2inst ); - - Next, we form the transformation from J2000 to instrument - coordinates j2inst. - - mxm_c ( s2inst, j2s, j2inst ); - - Finally, we express j2inst using the desired Euler angles, as - in the first example: - - m2eul_c ( j2inst, 3, 1, 3, &twist, &ang2, &ang3 ); - - ra = ang3 - halfpi_c(); - dec = halfpi_c() - ang2; - - If we wish to make sure that ra, dec, and twist are in - the ranges [0, 2pi), [-pi/2, pi/2], and [0, 2pi) - respectively, we may add the code - - if ( ra < 0. ) - { - ra = ra + twopi_c(); - } - - if ( twist < 0. ) - { - twist = twist + twopi_c(); - } - - Note that dec is already in the correct range, since ang2 - is in the range [0, pi] when the first and third input axes - are equal. - - Now ra, dec, and twist express the instrument pointing - as RA, Dec, and Twist, relative to the J2000 system. - - A warning note: more than one definition of RA, Dec, and - Twist is extant. Before using this example in an application, - check that the definition given here is consistent with that - used in your application. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.3.1, 13-OCT-2004 (NJB) - - Fixed header typo. - - -CSPICE Version 1.3.0, 21-OCT-1998 (NJB) - - Made input matrix const. - - -CSPICE Version 1.2.0, 13-FEB-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Removed local variables used for temporary capture of outputs. - - -CSPICE Version 1.0.0 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) - --Index_Entries - - matrix to euler angles - --& -*/ - -{ /* Begin m2eul_c */ - - /* - Local variables - */ - SpiceDouble loc_r[3][3]; - - - /* - Participate in error tracing. - */ - chkin_c ( "m2eul_c" ); - - - /* - Transpose the input matrix to put it in column-major order. - */ - xpose_c ( r, loc_r ); - - - /* - Call the f2c'd version of m2eul: - */ - m2eul_ ( (doublereal *) loc_r, - (integer *) &axis3, - (integer *) &axis2, - (integer *) &axis1, - (doublereal *) angle3, - (doublereal *) angle2, - (doublereal *) angle1 ); - - - chkout_c ( "m2eul_c" ); - -} /* End m2eul_c */ diff --git a/ext/spice/src/cspice/m2q.c b/ext/spice/src/cspice/m2q.c deleted file mode 100644 index 5d69feb4ac..0000000000 --- a/ext/spice/src/cspice/m2q.c +++ /dev/null @@ -1,632 +0,0 @@ -/* m2q.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b2 = .1; - -/* $Procedure M2Q ( Matrix to quaternion ) */ -/* Subroutine */ int m2q_(doublereal *r__, doublereal *q) -{ - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - doublereal c__, s[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal trace, l2; - extern logical isrot_(doublereal *, doublereal *, doublereal *); - doublereal mtrace, factor, cc4; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal polish; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - doublereal s114, s224, s334; - -/* $ Abstract */ - -/* Find a unit quaternion corresponding to a specified rotation */ -/* matrix. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATH */ -/* MATRIX */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* R I A rotation matrix. */ -/* Q O A unit quaternion representing R. */ - -/* $ Detailed_Input */ - -/* R is a rotation matrix. */ - -/* $ Detailed_Output */ - -/* Q is a unit-length SPICE-style quaternion */ -/* representing R. See the discussion of quaternion */ -/* styles in Particulars below. */ - -/* Q is a 4-dimensional vector. If R rotates vectors */ -/* in the counterclockwise sense by an angle of theta */ -/* radians about a unit vector A, where */ - -/* 0 < theta < pi */ -/* - - */ - -/* then letting h = theta/2, */ - -/* Q = ( cos(h), sin(h)A , sin(h)A , sin(h)A ). */ -/* 1 2 3 */ - -/* The restriction that theta must be in the range */ -/* [0, pi] determines the output quaternion Q */ -/* uniquely except when theta = pi; in this special */ -/* case, both of the quaternions */ - -/* Q = ( 0, A , A , A ) */ -/* 1 2 3 */ -/* and */ - -/* Q = ( 0, -A , -A , -A ) */ -/* 1 2 3 */ - -/* are possible outputs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If R is not a rotation matrix, the error SPICE(NOTAROTATION) */ -/* is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A unit quaternion is a 4-dimensional vector for which the sum of */ -/* the squares of the components is 1. Unit quaternions can be used */ -/* to represent rotations in the following way: given a rotation */ -/* angle theta, where */ - -/* 0 < theta < pi */ -/* - - */ - -/* and a unit vector A, we can represent the transformation that */ -/* rotates vectors in the counterclockwise sense by theta radians */ -/* about A using the quaternion Q, where */ - -/* Q = */ - -/* ( cos(theta/2), sin(theta/2)a , sin(theta/2)a , sin(theta/2)a ) */ -/* 1 2 3 */ - -/* As mentioned in Detailed Output, our restriction on the range of */ -/* theta determines Q uniquely, except when theta = pi. */ - -/* The SPICELIB routine Q2M is an one-sided inverse of this routine: */ -/* given any rotation matrix R, the calls */ - -/* CALL M2Q ( R, Q ) */ -/* CALL Q2M ( Q, R ) */ - -/* leave R unchanged, except for round-off error. However, the */ -/* calls */ - -/* CALL Q2M ( Q, R ) */ -/* CALL M2Q ( R, Q ) */ - -/* might preserve Q or convert Q to -Q. */ - - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* 1) A case amenable to checking by hand calculation: */ - -/* To convert the rotation matrix */ - -/* +- -+ */ -/* | 0 1 0 | */ -/* | | */ -/* R = | -1 0 0 | */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - -/* also represented as */ - -/* [ pi/2 ] */ -/* 3 */ - -/* to a quaternion, we can use the code fragment */ - -/* CALL ROTATE ( HALFPI(), 3, R ) */ -/* CALL M2Q ( R, Q ) */ - -/* M2Q will return Q as */ - -/* ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) */ - -/* Why? Well, R is a reference frame transformation that */ -/* rotates vectors by -pi/2 radians about the axis vector */ - -/* A = ( 0, 0, 1 ) */ - -/* Equivalently, R rotates vectors by pi/2 radians in */ -/* the counterclockwise sense about the axis vector */ - -/* -A = ( 0, 0, -1 ) */ - -/* so our definition of Q, */ - -/* h = theta/2 */ - -/* Q = ( cos(h), sin(h)A , sin(h)A , sin(h)A ) */ -/* 1 2 3 */ - -/* implies that in this case, */ - -/* Q = ( cos(pi/4), 0, 0, -sin(pi/4) ) */ - -/* = ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) */ - - -/* 2) Finding a quaternion that represents a rotation specified by */ -/* a set of Euler angles: */ - -/* Suppose our original rotation R is the product */ - -/* [ TAU ] [ pi/2 - DELTA ] [ ALPHA ] */ -/* 3 2 3 */ - -/* The code fragment */ - -/* CALL EUL2M ( TAU, HALFPI() - DELTA, ALPHA, */ -/* . 3, 2, 3, R ) */ - -/* CALL M2Q ( R, Q ) */ - -/* yields a quaternion Q that represents R. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 27-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. Made various minor edits */ -/* throughout header. */ - -/* - SPICELIB Version 2.0.0, 17-SEP-1999 (WLT) */ - -/* The routine was re-implemented to sharpen the numerical */ -/* stability of the routine and eliminate calls to SIN */ -/* and COS functions. */ - -/* - 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, 30-AUG-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix to quaternion */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* NTOL and DETOL are used to determine whether R is a rotation */ -/* matrix. */ - -/* NTOL is the tolerance for the norms of the columns of R. */ - -/* DTOL is the tolerance for the determinant of a matrix whose */ -/* columns are the unitized columns of R. */ - - - -/* Local Variables */ - - -/* If R is not a rotation matrix, we can't proceed. */ - - if (! isrot_(r__, &c_b2, &c_b2)) { - chkin_("M2Q", (ftnlen)3); - setmsg_("Input matrix was not a rotation.", (ftnlen)32); - sigerr_("SPICE(NOTAROTATION)", (ftnlen)19); - chkout_("M2Q", (ftnlen)3); - return 0; - } - - -/* If our quaternion is C, S1, S2, S3 (the S's being the imaginary */ -/* part) and we let */ - -/* CSi = C * Si */ -/* Sij = Si * Sj */ - -/* then the rotation matrix corresponding to our quaternion is: */ - -/* R(1,1) = 1.0D0 - 2*S22 - 2*S33 */ -/* R(2,1) = 2*S12 + 2*CS3 */ -/* R(3,1) = 2*S13 - 2*CS2 */ - -/* R(1,2) = 2*S12 - 2*CS3 */ -/* R(2,2) = 1.0D0 - 2*S11 - 2*S33 */ -/* R(3,2) = 2*S23 + 2*CS1 */ - -/* R(1,3) = 2*S13 + 2*CS2 */ -/* R(2,3) = 2*S23 - 2*CS1 */ -/* R(3,3) = 1.0D0 - 2*S11 - 2*S22 */ - -/* From the above we can see that */ - -/* TRACE = 3 - 4*(S11 + S22 + S33) */ - -/* so that */ - - -/* 1.0D0 + TRACE = 4 - 4*(S11 + S22 + S33) */ -/* = 4*(CC + S11 + S22 + S33) */ -/* - 4*(S11 + S22 + S33) */ -/* = 4*CC */ - -/* Thus up to sign */ - -/* C = 0.5D0 * DSQRT( 1.0D0 + TRACE ) */ - -/* But we also have */ - -/* 1.0D0 + TRACE - 2.0D0*R(i,i) = 4.0D0 - 4.0D0(Sii + Sjj + Skk) */ -/* - 2.0D0 + 4.0D0(Sjj + Skk ) */ - -/* = 2.0D0 - 4.0D0*Sii */ - -/* So that */ - -/* 1.0D0 - TRACE + 2.0D0*R(i,i) = 4.0D0*Sii */ - -/* and so up to sign */ - -/* Si = 0.5D0*DSQRT( 1.0D0 - TRACE + 2.0D0*R(i,i) ) */ - -/* in addition to this observation, we note that all of the */ -/* product pairs can easily be computed */ - -/* CS1 = (R(3,2) - R(2,3))/4.0D0 */ -/* CS2 = (R(1,3) - R(3,1))/4.0D0 */ -/* CS3 = (R(2,1) - R(1,2))/4.0D0 */ -/* S12 = (R(2,1) + R(1,2))/4.0D0 */ -/* S13 = (R(3,1) + R(1,3))/4.0D0 */ -/* S23 = (R(2,3) + R(3,2))/4.0D0 */ - -/* But taking sums or differences of numbers that are nearly equal */ -/* or nearly opposite results in a loss of precision. As a result */ -/* we should take some care in which terms to select when computing */ -/* C, S1, S2, S3. However, by simply starting with one of the */ -/* large quantities cc, S11, S22, or S33 we can make sure that we */ -/* use the best of the 6 quantities above when computing the */ -/* remaining components of the quaternion. */ - - trace = r__[0] + r__[4] + r__[8]; - mtrace = 1. - trace; - cc4 = trace + 1.; - s114 = mtrace + r__[0] * 2.; - s224 = mtrace + r__[4] * 2.; - s334 = mtrace + r__[8] * 2.; - -/* Note that if you simply add CC4 + S114 + S224 + S334 */ -/* you get four. Thus at least one of the 4 terms is greater than 1. */ - - if (1. <= cc4) { - c__ = sqrt(cc4 * .25); - factor = 1. / (c__ * 4.); - s[0] = (r__[5] - r__[7]) * factor; - s[1] = (r__[6] - r__[2]) * factor; - s[2] = (r__[1] - r__[3]) * factor; - } else if (1. <= s114) { - s[0] = sqrt(s114 * .25); - factor = 1. / (s[0] * 4.); - c__ = (r__[5] - r__[7]) * factor; - s[1] = (r__[3] + r__[1]) * factor; - s[2] = (r__[6] + r__[2]) * factor; - } else if (1. <= s224) { - s[1] = sqrt(s224 * .25); - factor = 1. / (s[1] * 4.); - c__ = (r__[6] - r__[2]) * factor; - s[0] = (r__[3] + r__[1]) * factor; - s[2] = (r__[7] + r__[5]) * factor; - } else { - s[2] = sqrt(s334 * .25); - factor = 1. / (s[2] * 4.); - c__ = (r__[1] - r__[3]) * factor; - s[0] = (r__[6] + r__[2]) * factor; - s[1] = (r__[7] + r__[5]) * factor; - } - -/* If the magnitude of this quaternion is not one, we polish it */ -/* up a bit. */ - - l2 = c__ * c__ + s[0] * s[0] + s[1] * s[1] + s[2] * s[2]; - if (l2 != 1.) { - polish = 1. / sqrt(l2); - c__ *= polish; - s[0] *= polish; - s[1] *= polish; - s[2] *= polish; - } - if (c__ > 0.) { - q[0] = c__; - q[1] = s[0]; - q[2] = s[1]; - q[3] = s[2]; - } else { - q[0] = -c__; - q[1] = -s[0]; - q[2] = -s[1]; - q[3] = -s[2]; - } - return 0; -} /* m2q_ */ - diff --git a/ext/spice/src/cspice/m2q_c.c b/ext/spice/src/cspice/m2q_c.c deleted file mode 100644 index 7544417fc2..0000000000 --- a/ext/spice/src/cspice/m2q_c.c +++ /dev/null @@ -1,486 +0,0 @@ -/* - --Procedure m2q_c ( Matrix to quaternion ) - --Abstract - - Find a unit quaternion corresponding to a specified rotation - matrix. - --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 - - ROTATION - --Keywords - - MATH - MATRIX - ROTATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef m2q_c - - - void m2q_c ( ConstSpiceDouble r[3][3], - SpiceDouble q[4] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - r I A rotation matrix. - q O A unit quaternion representing `r'. - --Detailed_Input - - r is a rotation matrix. - --Detailed_Output - - q is a unit-length SPICE-style quaternion representing - `r'. See the discussion of quaternion styles in - Particulars below. - - `q' is a 4-dimensional vector. If `r' rotates vectors in - the counterclockwise sense by an angle of `theta' radians - about a unit vector `a', where - - 0 < theta < pi - - - - - then letting h = theta/2, - - q = ( cos(h), sin(h)a , sin(h)a , sin(h)a ). - 1 2 3 - - The restriction that `theta' must be in the range [0, pi] - determines the output quaternion `q' uniquely - except when theta = pi; in this special case, both of - the quaternions - - q = ( 0, a , a , a ) - 1 2 3 - and - - q = ( 0, -a , -a , -a ) - 1 2 3 - - are possible outputs. - --Parameters - - None. - --Exceptions - - 1) If `r' is not a rotation matrix, the error SPICE(NOTAROTATION) - is signaled. - --Files - - None. - --Particulars - - A unit quaternion is a 4-dimensional vector for which the sum of - the squares of the components is 1. Unit quaternions can be used - to represent rotations in the following way: given a rotation - angle `theta', where - - 0 < theta < pi - - - - - and a unit vector `a', we can represent the transformation that - rotates vectors in the counterclockwise sense by theta radians about - `a' using the quaternion `q', where - - q = ( cos(theta/2), sin(theta/2)a , sin(theta/2)a , sin(theta/2)a ) - 1 2 3 - - As mentioned in Detailed Output, our restriction on the range of - `theta' determines `q' uniquely, except when theta = pi. - - The CSPICE routine q2m_c is an one-sided inverse of this routine: - given any rotation matrix `r', the calls - - m2q_c ( r, q ); - q2m_c ( q, r ); - - leave `r' unchanged, except for round-off error. However, the - calls - - q2m_c ( q, r ); - m2q_c ( r, q ); - - might preserve `q' or convert `q' to -q. - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - 1) A case amenable to checking by hand calculation: - - To convert the rotation matrix - - +- -+ - | 0 1 0 | - | | - r = | -1 0 0 | - | | - | 0 0 1 | - +- -+ - - also represented as - - [ pi/2 ] - 3 - - to a quaternion, we can use the code fragment - - rotate_c ( halfpi_c(), 3, r ); - m2q_c ( r, q ); - - m2q_c will return `q' as - - ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) - - Why? Well, `r' is a reference frame transformation that - rotates vectors by -pi/2 radians about the axis vector - - a = ( 0, 0, 1 ) - - Equivalently, `r' rotates vectors by pi/2 radians in - the counterclockwise sense about the axis vector - - -a = ( 0, 0, -1 ) - - so our definition of `q', - - h = theta/2 - - q = ( cos(h), sin(h)a , sin(h)a , sin(h)a ) - 1 2 3 - - implies that in this case, - - q = ( cos(pi/4), 0, 0, -sin(pi/4) ) - - = ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) - - - 2) Finding a quaternion that represents a rotation specified by - a set of Euler angles: - - Suppose our original rotation `r' is the product - - [ tau ] [ pi/2 - delta ] [ alpha ] . - 3 2 3 - - The code fragment - - eul2m_c ( tau, halfpi_c() - delta, alpha, - 3, 2, 3, r ); - - m2q_c ( r, q ); - - yields a quaternion `q' that represents `r'. - --Restrictions - - None. - --Literature_References - - NAIF document 179.0, "Rotations and their Habits", by - W. L. Taber. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.1, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. Made minor edits throughout - header. - - -CSPICE Version 1.1.0, 21-OCT-1998 (NJB) - - Made input matrix const. - - -CSPICE Version 1.0.1, 13-FEB-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - matrix to quaternion - --& -*/ - -{ /* Begin m2q_c */ - - /* - Local variables - */ - SpiceDouble loc_r[3][3]; - - - /* - Participate in error tracing. - */ - chkin_c ( "m2q_c" ); - - - /* - Transpose the input matrix to put it in column-major order. - */ - xpose_c ( r, loc_r ); - - - /* - Call the f2c'd version of m2q: - */ - m2q_ ( (doublereal *) loc_r, - (doublereal *) q ); - - - chkout_c ( "m2q_c" ); - - -} /* End m2q_c */ diff --git a/ext/spice/src/cspice/matchi.c b/ext/spice/src/cspice/matchi.c deleted file mode 100644 index 0b7549389d..0000000000 --- a/ext/spice/src/cspice/matchi.c +++ /dev/null @@ -1,405 +0,0 @@ -/* matchi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure MATCHI ( Match string against wildcard template ) */ -logical matchi_(char *string, char *templ, char *wstr, char *wchr, ftnlen - string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer left, slen, tlen, scur, tcur, i__, j; - extern logical samch_(char *, integer *, char *, integer *, ftnlen, - ftnlen), nechr_(char *, char *, ftnlen, ftnlen); - integer right, slast, tlast; - extern logical samchi_(char *, integer *, char *, integer *, ftnlen, - ftnlen); - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - logical nosubm; - integer sfirst, tfirst; - -/* $ Abstract */ - -/* Determine whether a string is matched by a template containing */ -/* wild cards. This routine is case-insensitive. */ - -/* $ 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 */ - -/* CHARACTER */ -/* COMPARE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to be tested. */ -/* TEMPL I Template (with wild cards) to test against STRING. */ -/* WSTR I Wild string token. */ -/* WCHR I Wild character token. */ - -/* The function returns .TRUE. if STRING matches TEMPL and otherwise */ -/* returns .FALSE. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string to be tested for */ -/* a match against the input template. Leading and */ -/* trailing blanks are ignored. */ - -/* TEMPL is the input template to be tested for a match */ -/* against the input string. TEMPL may contain wild */ -/* cards. Leading and trailing blanks are ignored. */ - -/* WSTR is the wild string token used in the input template. */ -/* The wild string token may represent from zero to */ -/* any number of characters. */ - -/* WCHR is the wild character token used in the input */ -/* template. The wild character token represents */ -/* exactly one character. */ - -/* $ Detailed_Output */ - -/* The function is true when the input string matches the input */ -/* template, and false otherwise. The string and template match */ -/* whenever the template can expand (through replacement of its */ -/* wild cards) to become the input string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* MATCHI ignores leading and trailing blanks in both the string */ -/* and the template. All of the following are equivalent (they */ -/* all return TRUE). */ - -/* MATCHI ( 'ALCATRAZ', 'A*Z', '*', '%' ) */ -/* MATCHI ( ' ALCATRAZ ', 'A*Z', '*', '%' ) */ -/* MATCHI ( 'ALCATRAZ', ' A*Z ', '*', '%' ) */ -/* MATCHI ( ' ALCATRAZ ', ' A*Z ', '*', '%' ) */ - -/* MATCHI is case-insensitive: uppercase characters match */ -/* lowercase characters, and vice versa. Wild characters match */ -/* characters of both cases. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Examples */ - -/* Let */ - -/* STRING = ' ABCDEFGHIJKLMNOPQRSTUVWXYZ ' */ -/* WSTR = '*' */ -/* WCHR = '%' */ - -/* Then */ - -/* if TEMPL is '*A*' MATCHI is T */ -/* 'A%D*' F */ -/* 'A%C*' T */ -/* '%A*' F */ -/* '%%CD*Z' T */ -/* '%%CD' F */ -/* 'A*MN*Y*Z' T */ -/* 'A*MN*Y*%Z' F */ -/* '*BCD*Z*' T */ -/* '*bdc*z*' F */ -/* ' *bcD*Z* ' T */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.1, 11-NOV-2005 (NJB) */ - -/* Corrected example calls in header; made other minor */ -/* edits to header. */ - -/* - SPICELIB Version 1.1.0 08-JUN-1999 (WLT) */ - -/* Fixed comments in detailed output and example sections. */ - -/* - SPICELIB Version 1.0.0 01-DEC-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* match string against wildcard template */ -/* test whether a string matches a wildcard template */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Give the function an initial value of .FALSE. */ - - ret_val = FALSE_; - -/* First let's get everybody's measurments. */ - - sfirst = frstnb_(string, string_len); - slast = lastnb_(string, string_len); - tfirst = frstnb_(templ, templ_len); - tlast = lastnb_(templ, templ_len); - tlen = tlast - tfirst + 1; - slen = slast - sfirst + 1; - scur = max(1,sfirst); - tcur = tfirst; - -/* A blank template matches a blank string, and nothing else. */ - - if (tlast == 0 && slast == 0) { - ret_val = TRUE_; - return ret_val; - } else if (tlast == 0) { - ret_val = FALSE_; - return ret_val; - } - -/* The beginning of the string and template must be identical */ -/* up to the first occurrence of a wild string. */ - - while(tcur <= tlast && scur <= slast && ! samch_(templ, &tcur, wstr, & - c__1, templ_len, (ftnlen)1)) { - if (nechr_(templ + (tcur - 1), string + (scur - 1), (ftnlen)1, ( - ftnlen)1) && *(unsigned char *)&templ[tcur - 1] != *(unsigned - char *)wchr) { - ret_val = FALSE_; - return ret_val; - } else { - ++tcur; - ++scur; - } - } - -/* There are a three ways we could have finished the loop above */ -/* without hitting a wild string. */ - -/* Case 1. Both the string and template ran out of characters at */ -/* the same time without running into a wild string in the template. */ - - if (tcur > tlast && scur > slast) { - ret_val = TRUE_; - return ret_val; - } - -/* Case 2. The template ran out of characters while there were still */ -/* characters remaining in the in the string. No match. */ - - if (tcur > tlast && scur <= slast) { - ret_val = FALSE_; - return ret_val; - } - -/* Case 3. The string ran out of characters while non-wild characters */ -/* remain in the template. */ - -/* We have to check to see if any non-wild-string characters */ -/* remain. If so, we DO NOT have a match. On the other hand if */ -/* only wild string characters remain we DO have a match. */ - - if (tcur <= tlast && scur > slast) { - ret_val = TRUE_; - i__1 = tlast; - for (i__ = tcur; i__ <= i__1; ++i__) { - ret_val = ret_val && *(unsigned char *)&templ[i__ - 1] == *( - unsigned char *)wstr; - } - return ret_val; - } - -/* OK. There is only one way that you can get to this point. */ -/* It must be the case that characters remain in both the template */ -/* (TCUR .LE. TLAST) and the string (SCUR .LE. SLAST). Moreover, */ -/* to get out of the first loop you had to hit a wild string */ -/* character. Find the first non-wild-string character in the */ -/* template. (If there isn't one, we have a match.) */ - - while(tcur <= tlast && samch_(templ, &tcur, wstr, &c__1, templ_len, ( - ftnlen)1)) { - ++tcur; - } - if (tcur > tlast) { - ret_val = TRUE_; - return ret_val; - } - -/* Still here? Ok. We have a non-wild-string character at TCUR. Call */ -/* this position left and look for the right end of the maximum */ -/* length substring of TEMPL (starting at left) that does not have */ -/* a wild string character. */ - - left = tcur; - while(tcur <= tlast && ! samch_(templ, &tcur, wstr, &c__1, templ_len, ( - ftnlen)1)) { - ++tcur; - } - right = tcur - 1; - while(left <= tlast) { - -/* First see if there is enough room left in the string to */ -/* match TEMPL(LEFT:RIGHT) */ - - if (slast - scur < right - left) { - ret_val = FALSE_; - return ret_val; - } - -/* The substring TEMPL(LEFT:RIGHT) might be the end of the */ -/* string. In such a case the ends of STRING must match */ -/* exactly with the end of TEMPL. */ - - if (right == tlast) { - i__ = slast; - j = tlast; - while(j >= left) { - if (samch_(templ, &j, wchr, &c__1, templ_len, (ftnlen)1) || - samchi_(templ, &j, string, &i__, templ_len, - string_len)) { - --j; - --i__; - } else { - ret_val = FALSE_; - return ret_val; - } - } - -/* If we made it through the loop, we've got a match. */ - - ret_val = TRUE_; - return ret_val; - } else { - -/* In this case TEMPL(LEFT:RIGHT) is in between wild string */ -/* characters. Try to find a substring at or to the right */ -/* of SCUR in STRING that matches TEMPL(LEFT:RIGHT) */ - - nosubm = TRUE_; - while(nosubm) { - i__ = scur; - j = left; - while(j <= right && (samchi_(string, &i__, templ, &j, - string_len, templ_len) || samch_(wchr, &c__1, templ, & - j, (ftnlen)1, templ_len))) { - ++i__; - ++j; - } - -/* If J made it past RIGHT, we have a substring match */ - - if (j > right) { - scur = i__; - nosubm = FALSE_; - -/* Otherwise, try the substring starting 1 to the right */ -/* of where our last try began. */ - - } else { - ++scur; - -/* Make sure there's room to even attempt a match. */ - - if (slast - scur < right - left) { - ret_val = FALSE_; - return ret_val; - } - } - } - } - -/* If you have reached this point there must be something left */ -/* in the template and that something must begin with a wild */ -/* string character. Hunt for the next substring that doesn't */ -/* contain a wild string character. */ - - while(tcur <= tlast && samch_(templ, &tcur, wstr, &c__1, templ_len, ( - ftnlen)1)) { - ++tcur; - } - if (tcur > tlast) { - -/* All that was left was wild string characters. We've */ -/* got a match. */ - - ret_val = TRUE_; - return ret_val; - } - -/* Still here? Ok. We have a non-wild-string character at TCUR. */ -/* Call this position left and look for the right end of the */ -/* maximum length substring of TEMPL (starting at left) that */ -/* does not have a wild string character. */ - - left = tcur; - while(tcur <= tlast && ! samch_(templ, &tcur, wstr, &c__1, templ_len, - (ftnlen)1)) { - ++tcur; - } - right = tcur - 1; - } - return ret_val; -} /* matchi_ */ - diff --git a/ext/spice/src/cspice/matchi_c.c b/ext/spice/src/cspice/matchi_c.c deleted file mode 100644 index ce86f6862d..0000000000 --- a/ext/spice/src/cspice/matchi_c.c +++ /dev/null @@ -1,204 +0,0 @@ -/* - --Procedure matchi_c ( Match string against wildcard template ) - --Abstract - - Determine whether a string is matched by a template containing - wild cards. The pattern comparison is case-insensitive. - --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 - - CHARACTER, COMPARE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - SpiceBoolean matchi_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I String to be tested. - templ I Template (with wild cards) to test against string. - wstr I Wild string token. - wchr I Wild character token. - - The function returns the value SPICETRUE if string matches templ, - SPICEFALSE if not. - --Detailed_Input - - string is the input character string to be tested for - a match against the input template. Leading and - trailing blanks are ignored. - - templ is the input template to be tested for a match - against the input string. TEMPL may contain wild - cards. Leading and trailing blanks are ignored. - - wstr is the wild string token used in the input template. - The wild string token may represent from zero to - any number of characters. - - wchr is the wild character token used in the input - template. The wild character token represents - exactly one character. - --Detailed_Output - - The function returns SPICETRUE when the input string matches the - input template, and SPICEFALSE otherwise. The string and template - match whenever the template can expand (through replacement of its - wild cards) to become the input string. - --Parameters - - None. - --Particulars - - matchi_c ignores leading and trailing blanks in both the string - and the template. All of the following are equivalent: they - all return SPICETRUE. - - #include "SpiceUsr.h" - . - . - . - matchi_c ( "ALCATRAZ", "A*Z", '*', '%' ); - matchi_c ( " ALCATRAZ ", "a*z", '*', '%' ); - matchi_c ( "alcatraz", " A*Z ", '*', '%' ); - matchi_c ( " ALCATRAZ ", " A*Z ", '*', '%' ); - - matchi_c is case-insensitive: uppercase characters match - lowercase characters, and vice versa. Wild characters match - characters of both cases. - --Exceptions - - 1) If either the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. The function will - return SPICEFALSE. - - 2) If either input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. The function will - return SPICEFALSE. - --Examples - - Let - string = " ABCDEFGHIJKLMNOPQRSTUVWXYZ " - wstr = '*' - wchr = '%' - - Then - if TEMPL is "*A*" matchi_c is SPICETRUE - "A%D*" SPICEFALSE - "A%C*" SPICETRUE - "%A*" SPICEFALSE - "%%CD*Z" SPICETRUE - "%%CD" SPICEFALSE - "A*MN*Y*Z" SPICETRUE - "A*MN*Y*%Z" SPICEFALSE - "*BCD*Z*" SPICETRUE - "*bdc*z*" SPICEFALSE - " *bcD*Z* " SPICETRUE - --Restrictions - - None. - --Files - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 17-AUG-1999 (NJB) (WLT) (IMU) - --Index_Entries - - match string against wildcard template - test whether a string matches a wildcard template - --& -*/ - -{ /* Begin matchi_c */ - - /* - Use discovery check-in. - */ - - - /* - Check the input strings string and templ to make sure the pointers - are non-null and the strings are non-empty. - */ - CHKFSTR_VAL ( CHK_DISCOVER, "matchi_c", string, SPICEFALSE ); - CHKFSTR_VAL ( CHK_DISCOVER, "matchi_c", templ, SPICEFALSE ); - - /* - Call the f2c'd routine if we got this far. - */ - - return ( matchi_ ( ( char * ) string, - ( char * ) templ, - ( char * ) &wstr, - ( char * ) &wchr, - ( ftnlen ) strlen(string), - ( ftnlen ) strlen(templ), - ( ftnlen ) 1, - ( ftnlen ) 1 ) ); - - -} /* End matchi_c */ diff --git a/ext/spice/src/cspice/matchw.c b/ext/spice/src/cspice/matchw.c deleted file mode 100644 index a2c34aa4bf..0000000000 --- a/ext/spice/src/cspice/matchw.c +++ /dev/null @@ -1,431 +0,0 @@ -/* matchw.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure MATCHW ( Match string against wildcard template ) */ -logical matchw_(char *string, char *templ, char *wstr, char *wchr, ftnlen - string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer left, slen, tlen, scur, tcur, i__, j; - extern logical samch_(char *, integer *, char *, integer *, ftnlen, - ftnlen); - integer right, slast, tlast; - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - logical nosubm; - integer sfirst, tfirst; - -/* $ Abstract */ - -/* Determine whether a string is matched by a template containing */ -/* wild cards. */ - -/* $ 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 */ - -/* CHARACTER */ -/* COMPARE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to be tested. */ -/* TEMPL I Template (with wild cards) to test against STRING. */ -/* WSTR I Wild string token. */ -/* WCHR I Wild character token. */ - -/* The function returns .TRUE. if STRING matches TEMPL and otherwise */ -/* returns .FALSE. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string to be tested for */ -/* a match against the input template. Leading and */ -/* trailing blanks are ignored. */ - -/* TEMPL is the input template to be tested for a match */ -/* against the input string. TEMPL may contain wild */ -/* cards. Leading and trailing blanks are ignored. */ - -/* WSTR is the wild string token used in the input template. */ -/* The wild string token may represent from zero to */ -/* any number of characters. */ - -/* WCHR is the wild character token used in the input */ -/* template. The wild character token represents */ -/* exactly one character. */ - -/* $ Detailed_Output */ - -/* The function is true when the input string matches the input */ -/* template, and false otherwise. The string and template match */ -/* whenever the template can expand (through replacement of its */ -/* wild cards) to become the input string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* MATCHW ignores leading and trailing blanks in both the string */ -/* and the template. All of the following are equivalent (they */ -/* all return TRUE). */ - -/* MATCHW ( 'ALCATRAZ', 'A*Z', '*', '%' ) */ -/* MATCHW ( ' ALCATRAZ ', 'A*Z', '*', '%' ) */ -/* MATCHW ( 'ALCATRAZ', ' A*Z ', '*', '%' ) */ -/* MATCHW ( ' ALCATRAZ ', ' A*Z ', '*', '%' ) */ - -/* MATCHW is case-sensitive: uppercase characters do not match */ -/* lowercase characters, and vice versa. Wild characters match */ -/* characters of both cases. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Examples */ - -/* Let */ - -/* STRING = ' ABCDEFGHIJKLMNOPQRSTUVWXYZ ' */ -/* WSTR = '*' */ -/* WCHR = '%' */ - -/* Then */ - -/* if TEMPL is '*A*' MATCHW is T */ -/* 'A%D*' F */ -/* 'A%C*' T */ -/* '%A*' F */ -/* '%%CD*Z' T */ -/* '%%CD' F */ -/* 'A*MN*Y*Z' T */ -/* 'A*MN*Y*%Z' F */ -/* '*BCD*Z*' T */ -/* '*bcd*z*' F */ -/* ' *BCD*Z* ' T */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.1, 11-NOV-2005 (NJB) */ - -/* Corrected example calls in header; made other minor */ -/* edits to header. */ - -/* - SPICELIB Version 1.3.0, 08-JUN-1999 (WLT) */ - -/* Fixed comments in detailed output and example sections. */ - -/* - SPICELIB Version 1.2.0, 15-MAY-1995 (WLT) */ - -/* Direct substring comparisons were replaced with the logical */ -/* function SAMCH in several cases so as to avoid out of range */ -/* errors when examining substrings. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* match string against wildcard template */ -/* test whether a string matches a wildcard template */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-OCT-1988 (WLT) */ - -/* The old algorithm just did not work. Strings with wild */ -/* characters at the beginning or end of the string were not */ -/* matched correctly. For example, A% matched APPROX, if the */ -/* wild character token was % and the wild string token was */ -/* *. Needless to say, a new algorithm was developed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Set the default function value to be FALSE. */ - - ret_val = FALSE_; - -/* First let's get everybody's measurments. */ - - sfirst = frstnb_(string, string_len); - slast = lastnb_(string, string_len); - tfirst = frstnb_(templ, templ_len); - tlast = lastnb_(templ, templ_len); - tlen = tlast - tfirst + 1; - slen = slast - sfirst + 1; - scur = max(1,sfirst); - tcur = tfirst; - -/* A blank template matches a blank string, and nothing else. */ - - if (tlast == 0 && slast == 0) { - ret_val = TRUE_; - return ret_val; - } else if (tlast == 0) { - ret_val = FALSE_; - return ret_val; - } - -/* The beginning of the string and template must be identical */ -/* up to the first occurrence of a wild string. */ - - while(tcur <= tlast && scur <= slast && ! samch_(templ, &tcur, wstr, & - c__1, templ_len, (ftnlen)1)) { - if (*(unsigned char *)&templ[tcur - 1] != *(unsigned char *)&string[ - scur - 1] && *(unsigned char *)&templ[tcur - 1] != *(unsigned - char *)wchr) { - ret_val = FALSE_; - return ret_val; - } else { - ++tcur; - ++scur; - } - } - -/* There are a three ways we could have finished the loop above */ -/* without hitting a wild string. */ - -/* Case 1. Both the string and template ran out of characters at */ -/* the same time without running into a wild string in the template. */ - - if (tcur > tlast && scur > slast) { - ret_val = TRUE_; - return ret_val; - } - -/* Case 2. The template ran out of characters while there were still */ -/* characters remaining in the in the string. No match. */ - - if (tcur > tlast && scur <= slast) { - ret_val = FALSE_; - return ret_val; - } - -/* Case 3. The string ran out of characters while non-wild characters */ -/* remain in the template. */ - -/* We have to check to see if any non-wild-string characters */ -/* remain. If so, we DO NOT have a match. On the other hand if */ -/* only wild string characters remain we DO have a match. */ - - if (tcur <= tlast && scur > slast) { - ret_val = TRUE_; - i__1 = tlast; - for (i__ = tcur; i__ <= i__1; ++i__) { - ret_val = ret_val && *(unsigned char *)&templ[i__ - 1] == *( - unsigned char *)wstr; - } - return ret_val; - } - -/* OK. There is only one way that you can get to this point. */ -/* It must be the case that characters remain in both the template */ -/* (TCUR .LE. TLAST) and the string (SCUR .LE. SLAST). Moreover, */ -/* to get out of the first loop you had to hit a wild string */ -/* character. Find the first non-wild-string character in the */ -/* template. (If there isn't one, we have a match.) */ - - while(tcur <= tlast && samch_(templ, &tcur, wstr, &c__1, templ_len, ( - ftnlen)1)) { - ++tcur; - } - if (tcur > tlast) { - ret_val = TRUE_; - return ret_val; - } - -/* Still here? Ok. We have a non-wild-string character at TCUR. Call */ -/* this position left and look for the right end of the maximum */ -/* length substring of TEMPL (starting at left) that does not have */ -/* a wild string character. */ - - left = tcur; - while(tcur <= tlast && ! samch_(templ, &tcur, wstr, &c__1, templ_len, ( - ftnlen)1)) { - ++tcur; - } - right = tcur - 1; - while(left <= tlast) { - -/* First see if there is enough room left in the string to */ -/* match TEMPL(LEFT:RIGHT) */ - - if (slast - scur < right - left) { - ret_val = FALSE_; - return ret_val; - } - -/* The substring TEMPL(LEFT:RIGHT) might be the end of the */ -/* string. In such a case the ends of STRING must match */ -/* exactly with the end of TEMPL. */ - - if (right == tlast) { - i__ = slast; - j = tlast; - while(j >= left) { - if (samch_(templ, &j, wchr, &c__1, templ_len, (ftnlen)1) || - samch_(templ, &j, string, &i__, templ_len, string_len) - ) { - --j; - --i__; - } else { - ret_val = FALSE_; - return ret_val; - } - } - -/* If we made it through the loop, we've got a match. */ - - ret_val = TRUE_; - return ret_val; - } else { - -/* In this case TEMPL(LEFT:RIGHT) is in between wild string */ -/* characters. Try to find a substring at or to the right */ -/* of SCUR in STRING that matches TEMPL(LEFT:RIGHT) */ - - nosubm = TRUE_; - while(nosubm) { - i__ = scur; - j = left; - while(j <= right && (samch_(string, &i__, templ, &j, - string_len, templ_len) || samch_(wchr, &c__1, templ, & - j, (ftnlen)1, templ_len))) { - ++i__; - ++j; - } - -/* If J made it past RIGHT, we have a substring match */ - - if (j > right) { - scur = i__; - nosubm = FALSE_; - -/* Otherwise, try the substring starting 1 to the right */ -/* of where our last try began. */ - - } else { - ++scur; - -/* Make sure there's room to even attempt a match. */ - - if (slast - scur < right - left) { - ret_val = FALSE_; - return ret_val; - } - } - } - } - -/* If you have reached this point there must be something left */ -/* in the template and that something must begin with a wild */ -/* string character. Hunt for the next substring that doesn't */ -/* contain a wild string character. */ - - while(tcur <= tlast && samch_(templ, &tcur, wstr, &c__1, templ_len, ( - ftnlen)1)) { - ++tcur; - } - if (tcur > tlast) { - -/* All that was left was wild string characters. We've */ -/* got a match. */ - - ret_val = TRUE_; - return ret_val; - } - -/* Still here? Ok. We have a non-wild-string character at TCUR. */ -/* Call this position left and look for the right end of the */ -/* maximum length substring of TEMPL (starting at left) that */ -/* does not have a wild string character. */ - - left = tcur; - while(tcur <= tlast && ! samch_(templ, &tcur, wstr, &c__1, templ_len, - (ftnlen)1)) { - ++tcur; - } - right = tcur - 1; - } - return ret_val; -} /* matchw_ */ - diff --git a/ext/spice/src/cspice/matchw_c.c b/ext/spice/src/cspice/matchw_c.c deleted file mode 100644 index c9d83bc4ea..0000000000 --- a/ext/spice/src/cspice/matchw_c.c +++ /dev/null @@ -1,204 +0,0 @@ -/* - --Procedure matchw_c ( Match string against wildcard template ) - --Abstract - - Determine whether a string is matched by a template containing - wild cards. - --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 - - CHARACTER, COMPARE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - SpiceBoolean matchw_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I String to be tested. - templ I Template (with wild cards) to test against string. - wstr I Wild string token. - wchr I Wild character token. - - The function returns the value SPICETRUE if string matches templ, - SPICEFALSE if not. - --Detailed_Input - - string is the input character string to be tested for - a match against the input template. Leading and - trailing blanks are ignored. - - templ is the input template to be tested for a match - against the input string. TEMPL may contain wild - cards. Leading and trailing blanks are ignored. - - wstr is the wild string token used in the input template. - The wild string token may represent from zero to - any number of characters. - - wchr is the wild character token used in the input - template. The wild character token represents - exactly one character. - --Detailed_Output - - The function returns SPICETRUE when the input string matches the - input template, and SPICEFALSE otherwise. The string and template - match whenever the template can expand (through replacement of its - wild cards) to become the input string. - --Parameters - - None. - --Particulars - - matchw_c ignores leading and trailing blanks in both the string - and the template. All of the following are equivalent: they - all return SPICETRUE. - - #include "SpiceUsr.h" - . - . - . - matchw_c ( "ALCATRAZ", "A*Z", '*', '%' ); - matchw_c ( " ALCATRAZ ", "a*z", '*', '%' ); - matchw_c ( "alcatraz", " A*Z ", '*', '%' ); - matchw_c ( " ALCATRAZ ", " A*Z ", '*', '%' ); - - matchw_c is case-sensitive: uppercase characters do not match - lowercase characters, and vice versa. Wild characters match - characters of both cases. - --Exceptions - - 1) If either the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. The function will - return SPICEFALSE. - - 2) If either input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. The function will - return SPICEFALSE. - --Examples - - Let - string = " ABCDEFGHIJKLMNOPQRSTUVWXYZ " - wstr = '*' - wchr = '%' - - Then - if TEMPL is "*A*" matchw_c is SPICETRUE - "A%D*" SPICEFALSE - "A%C*" SPICETRUE - "%A*" SPICEFALSE - "%%CD*Z" SPICETRUE - "%%CD" SPICEFALSE - "A*MN*Y*Z" SPICETRUE - "A*MN*Y*%Z" SPICEFALSE - "*BCD*Z*" SPICETRUE - "*bcd*z*" SPICEFALSE - " *BCD*Z* " SPICETRUE - --Restrictions - - None. - --Files - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 17-AUG-1999 (NJB) (WLT) (IMU) - --Index_Entries - - match string against wildcard template - test whether a string matches a wildcard template - --& -*/ - -{ /* Begin matchw_c */ - - /* - Use discovery check-in. - */ - - - /* - Check the input strings string and templ to make sure the pointers - are non-null and the strings are non-empty. - */ - CHKFSTR_VAL ( CHK_DISCOVER, "matchw_c", string, SPICEFALSE ); - CHKFSTR_VAL ( CHK_DISCOVER, "matchw_c", templ, SPICEFALSE ); - - /* - Call the f2c'd routine if we got this far. - */ - - return ( matchw_ ( ( char * ) string, - ( char * ) templ, - ( char * ) &wstr, - ( char * ) &wchr, - ( ftnlen ) strlen(string), - ( ftnlen ) strlen(templ), - ( ftnlen ) 1, - ( ftnlen ) 1 ) ); - - -} /* End matchw_c */ diff --git a/ext/spice/src/cspice/maxac.c b/ext/spice/src/cspice/maxac.c deleted file mode 100644 index a45f1b561b..0000000000 --- a/ext/spice/src/cspice/maxac.c +++ /dev/null @@ -1,182 +0,0 @@ -/* maxac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MAXAC ( Maximum element of array, character ) */ -/* Subroutine */ int maxac_(char *array, integer *ndim, char *maxval, integer - *loc, ftnlen array_len, ftnlen maxval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - logical l_gt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Locate the maximum element of a character array. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ARRAY I Array. */ -/* NDIM I Number of elements in ARRAY. */ -/* MAXVAL O Maximum value in ARRAY. */ -/* LOC O Location of MAXVAL in ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is an arbitrary array. */ - -/* NDIM is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* MAXVAL is the value in array that is greater than or equal */ -/* to all other values in the array. If the array */ -/* contains more than one element with this value, */ -/* the first one is returned. */ - -/* Elements in character arrays are compared according */ -/* to the ASCII collating sequence. */ - -/* LOC is the location of the maximum element. That is, */ -/* MAXVAL contains element ARRAY(LOC). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the array is empty (NDIM is less than one), LOC is zero, and */ -/* MAXVAL is not changed. */ - -/* 2) If the declared length of MAXVAL is too short to contain the */ -/* entire element, the element is truncated. (The original value */ -/* can be accessed via LOC.) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let array A contain the following elements. */ - -/* A(1) = 'Einstein' */ -/* A(2) = 'Bohr' */ -/* A(3) = 'Feynman' */ -/* A(4) = 'Pauli' */ -/* A(5) = 'Bardeen' */ -/* A(6) = 'Dirac' */ - -/* Then following the call */ - -/* CALL MAXAC ( A, 6, MAXVAL, LOC ) */ - -/* the values of MAXVAL and LOC are 'Pauli' and 4 respectively. */ - -/* $ Restrictions */ - -/* None */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* maximum element of character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 2-FEB-1989 (IMU) */ - -/* Missing header sections completed. */ - -/* -& */ - -/* Local variables */ - - if (*ndim <= 0) { - *loc = 0; - return 0; - } - s_copy(maxval, array, maxval_len, array_len); - *loc = 1; - i__1 = *ndim; - for (i__ = 2; i__ <= i__1; ++i__) { - if (l_gt(array + (i__ - 1) * array_len, maxval, array_len, maxval_len) - ) { - s_copy(maxval, array + (i__ - 1) * array_len, maxval_len, - array_len); - *loc = i__; - } - } - return 0; -} /* maxac_ */ - diff --git a/ext/spice/src/cspice/maxad.c b/ext/spice/src/cspice/maxad.c deleted file mode 100644 index a81e103319..0000000000 --- a/ext/spice/src/cspice/maxad.c +++ /dev/null @@ -1,172 +0,0 @@ -/* maxad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MAXAD ( Maximum element of array, DP ) */ -/* Subroutine */ int maxad_(doublereal *array, integer *ndim, doublereal * - maxval, integer *loc) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Locate the maximum element of a DP array. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ARRAY I Array. */ -/* NDIM I Number of elements in ARRAY. */ -/* MAXVAL O Maximum value in ARRAY. */ -/* LOC O Location of MAXVAL in ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is an arbitrary array. */ - -/* NDIM is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* MAXVAL is the value in array that is greater than or equal */ -/* to all other values in the array. If the array */ -/* contains more than one element with this value, */ -/* the first one is returned. */ - -/* Elements in character arrays are compared according */ -/* to the ASCII collating sequence. */ - -/* LOC is the location of the maximum element. That is, */ -/* MAXVAL contains element ARRAY(LOC). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the array is empty (NDIM is less than one), LOC is zero, and */ -/* MAXVAL is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let array A contain the following elements. */ - -/* A(1) = 16.D0 */ -/* A(2) = 4.D0 */ -/* A(3) = 32.D0 */ -/* A(4) = 64.D0 */ -/* A(5) = 2.D0 */ -/* A(6) = 8.D0 */ - -/* Then following the call */ - -/* CALL MAXAD ( A, 6, MAXVAL, LOC ) */ - -/* the values of MAXVAL and LOC are 64.D0 and 4 respectively. */ - -/* $ Restrictions */ - -/* None */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* maximum element of d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 2-FEB-1989 (IMU) */ - -/* Missing header sections completed. */ - -/* -& */ - -/* Local variables */ - - if (*ndim <= 0) { - *loc = 0; - return 0; - } - *maxval = array[0]; - *loc = 1; - i__1 = *ndim; - for (i__ = 2; i__ <= i__1; ++i__) { - if (array[i__ - 1] > *maxval) { - *maxval = array[i__ - 1]; - *loc = i__; - } - } - return 0; -} /* maxad_ */ - diff --git a/ext/spice/src/cspice/maxai.c b/ext/spice/src/cspice/maxai.c deleted file mode 100644 index 6dab0c2407..0000000000 --- a/ext/spice/src/cspice/maxai.c +++ /dev/null @@ -1,172 +0,0 @@ -/* maxai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MAXAI ( Maximum element of array, integer ) */ -/* Subroutine */ int maxai_(integer *array, integer *ndim, integer *maxval, - integer *loc) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Locate the maximum element of an integer array. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ARRAY I Array. */ -/* NDIM I Number of elements in ARRAY. */ -/* MAXVAL O Maximum value in ARRAY. */ -/* LOC O Location of MAXVAL in ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is an arbitrary array. */ - -/* NDIM is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* MAXVAL is the value in array that is greater than or equal */ -/* to all other values in the array. If the array */ -/* contains more than one element with this value, */ -/* the first one is returned. */ - -/* Elements in character arrays are compared according */ -/* to the ASCII collating sequence. */ - -/* LOC is the location of the maximum element. That is, */ -/* MAXVAL contains element ARRAY(LOC). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the array is empty (NDIM is less than one), LOC is zero, and */ -/* MAXVAL is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let array A contain the following elements. */ - -/* A(1) = 16 */ -/* A(2) = 4 */ -/* A(3) = 32 */ -/* A(4) = 64 */ -/* A(5) = 2 */ -/* A(6) = 8 */ - -/* Then following the call */ - -/* CALL MAXAI ( A, 6, MAXVAL, LOC ) */ - -/* the values of MAXVAL and LOC are 64 and 4 respectively. */ - -/* $ Restrictions */ - -/* None */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* maximum element of integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 2-FEB-1989 (IMU) */ - -/* Missing header sections completed. */ - -/* -& */ - -/* Local variables */ - - if (*ndim <= 0) { - *loc = 0; - return 0; - } - *maxval = array[0]; - *loc = 1; - i__1 = *ndim; - for (i__ = 2; i__ <= i__1; ++i__) { - if (array[i__ - 1] > *maxval) { - *maxval = array[i__ - 1]; - *loc = i__; - } - } - return 0; -} /* maxai_ */ - diff --git a/ext/spice/src/cspice/maxd_c.c b/ext/spice/src/cspice/maxd_c.c deleted file mode 100644 index 4ebc2abde4..0000000000 --- a/ext/spice/src/cspice/maxd_c.c +++ /dev/null @@ -1,234 +0,0 @@ -/* - --Procedure maxd_c ( Maximum of a set of double precision values ) - --Abstract - - Find the maximum of a set of double precision values. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceDouble maxd_c ( SpiceInt n, ... ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - n I The number of double precision values to compare. - ... I The numbers to be compared, separated by commas. - --Detailed_Input - - n is the number of double precision values in the set - whose maximum is to be determined. - - ... represents a variable argument list. The number of - double precision values supplied must be that - indicated by n. The values are separated by commas. - - Section 5.2.4.1 of the ANSI C Standard, titled - "Translation Limits," specifies that argument lists - containing at least 31 items must be supported. In - the interest of portability, no more than 30 - double precision values should be supplied. - --Detailed_Output - - The function returns the maximum of the set of input double precision - values. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If n is less than 1, the value 0.0 is returned. - - 2) If the number of double precision values supplied does not match - the argument n, the action of this routine is not defined. - - 3) If the number of double precision values supplied exceeds 30, - the action of this routine is not defined. - --Files - - None. - --Particulars - - None. - --Examples - - 1) Find the maximum of four double precision values. - - #include "SpiceUsr.h" - . - . - . - - SpiceDouble max; - SpiceDouble a; - SpiceDouble b; - SpiceDouble c; - SpiceDouble d; - . - . - . - - max = maxd_c ( 4, a, b, c, d ); - - --Restrictions - - 1) The ANSI C Standard specifies that argument lists containing 31 - actual arguments must be supported. Larger sets of values may - not be handled properly by this routine. - --Literature_References - - 1) "American National Standard for Programming Languages---C." - Section 5.4.2.1, "Translation Limits," p. 13. - Published by American National Standards Institute, - 11 West 42nd St., New York, NY 10035. Copyright 1990. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added "None." text to Particulars section, required for - API doc script (cspicehtml.pl) integrity checks. - - -CSPICE Version 1.0.0, 16-SEP-1999 (NJB) - --Index_Entries - - maximum of double precision values - --& -*/ - -{ /* Begin maxd_c */ - - /* - Local variables - */ - - SpiceDouble next; - SpiceDouble retval; - - SpiceInt i; - - - /* - ap is the argument pointer. Its type va_list is declared in the - header stdarg.h. - */ - - va_list ap; - - - - /* - If there are no values to compare, return zero. - */ - - if ( n < 1 ) - { - return ( 0.0 ); - } - - /* - Initialize the argument pointer with the last named argument, namely - n. - */ - - va_start ( ap, n ); - - - /* - Initialize the maximum with the first value. - */ - - retval = va_arg ( ap, double ); - - - /* - Now compute a running maximum of the values, if there are more. - - By the way, we capture the argument in the variable next rather than - make the va_arg call as a MaxVal argument, because the MaxVal macro - would make the va_arg call twice. - */ - - for ( i = 1; i < n; i++ ) - { - next = va_arg ( ap, double ); - retval = MaxVal ( retval, next ); - } - - - /* - Terminate the argument fetching process. - */ - - va_end ( ap ); - - - /* - Return the value we've found. - */ - - return ( retval ); - - -} /* End maxd_c */ - diff --git a/ext/spice/src/cspice/maxi_c.c b/ext/spice/src/cspice/maxi_c.c deleted file mode 100644 index 7c7af65146..0000000000 --- a/ext/spice/src/cspice/maxi_c.c +++ /dev/null @@ -1,233 +0,0 @@ -/* - --Procedure maxi_c ( Maximum of a set of integers ) - --Abstract - - Find the maximum of a set of integers. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceInt maxi_c ( SpiceInt n, ... ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - n I The number of integer values to compare. - ... I The numbers to be compared, separated by commas. - --Detailed_Input - - n is the number of integer values in the set - whose maximum is to be determined. - - ... represents a variable argument list. The number of - integer values supplied must be that indicated by n. - The values are separated by commas. - - Section 5.2.4.1 of the ANSI C Standard, titled - "Translation Limits," specifies that argument lists - containing at least 31 items must be supported. In - the interest of portability, no more than 30 - integer values should be supplied. - --Detailed_Output - - The function returns the maximum of the set of input integers. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If n is less than 1, the value 0 is returned. - - 2) If the number of integer values supplied does not match - the argument n, the action of this routine is not defined. - - 3) If the number of integer values supplied exceeds 30, - the action of this routine is not defined. - --Files - - None. - --Particulars - - None. - --Examples - - 1) Find the maximum of four integer values. - - #include "SpiceUsr.h" - . - . - . - - SpiceInt max; - SpiceInt a; - SpiceInt b; - SpiceInt c; - SpiceInt d; - . - . - . - - max = maxi_c ( 4, a, b, c, d ); - - --Restrictions - - 1) The ANSI C Standard specifies that argument lists containing 31 - actual arguments must be supported. Larger sets of values may - not be handled properly by this routine. - --Literature_References - - 1) "American National Standard for Programming Languages---C." - Section 5.4.2.1, "Translation Limits," p. 13. - Published by American National Standards Institute, - 11 West 42nd St., New York, NY 10035. Copyright 1990. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added "None." text to Particulars section, required for - API doc script (cspicehtml.pl) integrity checks. - - -CSPICE Version 1.0.0, 29-MAR-1999 (NJB) - --Index_Entries - - maximum of integer values - --& -*/ - -{ /* Begin maxi_c */ - - /* - Local variables - */ - - SpiceInt next; - SpiceInt retval; - - SpiceInt i; - - - /* - ap is the argument pointer. Its type va_list is declared in the - header stdarg.h. - */ - - va_list ap; - - - - /* - If there are no values to compare, return zero. - */ - - if ( n < 1 ) - { - return ( 0 ); - } - - /* - Initialize the argument pointer with the last named argument, namely - n. - */ - - va_start ( ap, n ); - - - /* - Initialize the maximum with the first value. - */ - - retval = va_arg ( ap, int ); - - - /* - Now compute a running maximum of the values, if there are more. - - By the way, we capture the argument in the variable next rather than - make the va_arg call as a MaxVal argument, because the MaxVal macro - would make the va_arg call twice. - */ - - for ( i = 1; i < n; i++ ) - { - next = va_arg ( ap, int ); - retval = MaxVal ( retval, next ); - } - - - /* - Terminate the argument fetching process. - */ - - va_end ( ap ); - - - /* - Return the value we've found. - */ - - return ( retval ); - - -} /* End maxi_c */ - diff --git a/ext/spice/src/cspice/mequ.c b/ext/spice/src/cspice/mequ.c deleted file mode 100644 index f7da20a211..0000000000 --- a/ext/spice/src/cspice/mequ.c +++ /dev/null @@ -1,139 +0,0 @@ -/* mequ.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure MEQU ( Matrix equal to another, 3x3 ) */ -/* Subroutine */ int mequ_(doublereal *m1, doublereal *mout) -{ - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - -/* $ Abstract */ - -/* Set one double precision 3x3 matrix equal to another. */ - -/* $ 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 */ - -/* ASSIGNMENT, MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Input matrix. */ -/* MOUT O Output matrix equal to M1. */ - -/* $ Detailed_Input */ - -/* M1 This is an arbitrary input 3x3 matrix. There are no */ -/* restrictions on what it may contain. */ - -/* $ Detailed_Output */ - -/* MOUT This 3x3 matrix is set to be equal to M1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* If M1 = | 1.0D0 0.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - -/* the call */ - -/* CALL MEQU ( M1, MOUT ) */ - -/* produces the matrix */ - -/* MOUT = | 1.0D0 0.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* equal to another 3x3_matrix */ - -/* -& */ - moved_(m1, &c__9, mout); - - return 0; -} /* mequ_ */ - diff --git a/ext/spice/src/cspice/mequ_c.c b/ext/spice/src/cspice/mequ_c.c deleted file mode 100644 index 2d44d7287c..0000000000 --- a/ext/spice/src/cspice/mequ_c.c +++ /dev/null @@ -1,137 +0,0 @@ -/* - --Procedure mequ_c ( Matrix equal to another, 3x3 ) - --Abstract - - Set one double precision 3x3 matrix equal to another. - --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 - - ASSIGNMENT - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef mequ_c - - void mequ_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Input matrix. - mout O Output matrix equal to m1. - --Detailed_Input - - m1 This is an arbitrary input 3x3 matrix. There are no - restrictions on what it may contain. - --Detailed_Output - - mout This 3x3 matrix is set to be equal to m1. - --Parameters - - None. - --Particulars - - None. - --Examples - - If m1 = | 1.0 0.0 0.0 | - | | - | 0.0 1.0 0.0 | - | | - | 0.0 0.0 1.0 | - - the call - - mequ_c ( m1, mout ); - - produces the matrix - - mout = | 1.0 0.0 0.0 | - | | - | 0.0 1.0 0.0 | - | | - | 0.0 0.0 1.0 | - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 - --Index_Entries - - equal to another 3x3_matrix - --& -*/ - -{ /* Begin mequ_c */ - - - MOVED (m1, 9, mout); - - -} /* End mequ_c */ diff --git a/ext/spice/src/cspice/mequg.c b/ext/spice/src/cspice/mequg.c deleted file mode 100644 index 4f0cfbda7b..0000000000 --- a/ext/spice/src/cspice/mequg.c +++ /dev/null @@ -1,157 +0,0 @@ -/* mequg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MEQUG ( Matrix equal to another, general dimension ) */ -/* Subroutine */ int mequg_(doublereal *m1, integer *nr, integer *nc, - doublereal *mout) -{ - /* System generated locals */ - integer m1_dim1, m1_offset, mout_dim1, mout_offset, i__1; - - /* Local variables */ - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - -/* $ Abstract */ - -/* Set one double precision matrix of arbitrary size equal to */ -/* another. */ - -/* $ 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 */ - -/* ASSIGNMENT, MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Input matrix. */ -/* NR I Row dimension of M1 (and also MOUT). */ -/* NC I Column dimension of M1 (and also MOUT). */ -/* MOUT O Output matrix equal to M1. */ - -/* $ Detailed_Input */ - -/* M1 is an arbitrary-sized double precision matrix. */ -/* There are no restrictions on what it may contain. */ - -/* NR is the number of rows in the input matrix. */ - -/* NC is the number of columns in the input matrix. */ - -/* $ Detailed_Output */ - -/* MOUT This matrix is set to be equal to M1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* If M1 = | 1.0D0 2.0D0 | */ -/* | | */ -/* | 2.0D0 4.0D0 | */ -/* | | */ -/* | 4.0D0 6.0D0 | */ - -/* the call */ - -/* CALL MEQUG ( M1, 3, 2, MOUT ) */ - -/* produces the matrix */ - -/* MOUT = | 1.0D0 2.0D0 | */ -/* | | */ -/* | 2.0D0 4.0D0 | */ -/* | | */ -/* | 4.0D0 6.0D0 | */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NR < 1 or NC < 1, the elements of the matrix MOUT are not */ -/* assigned any values. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* equal to another n-dimensional matrix */ - -/* -& */ - /* Parameter adjustments */ - mout_dim1 = *nr; - mout_offset = mout_dim1 + 1; - m1_dim1 = *nr; - m1_offset = m1_dim1 + 1; - - /* Function Body */ - i__1 = *nr * *nc; - moved_(m1, &i__1, mout); - - return 0; -} /* mequg_ */ - diff --git a/ext/spice/src/cspice/mequg_c.c b/ext/spice/src/cspice/mequg_c.c deleted file mode 100644 index 82a17b884b..0000000000 --- a/ext/spice/src/cspice/mequg_c.c +++ /dev/null @@ -1,154 +0,0 @@ -/* - --Procedure mequg_c ( Matrix equal to another, general dimension ) - --Abstract - - Set one double precision matrix of arbitrary size equal to - another. - --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 - - ASSIGNMENT - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef mequg_c - - - void mequg_c ( const void * m1, - SpiceInt nr, - SpiceInt nc, - void * mout ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Input matrix. - nr I Row dimension of m1 (and also mout). - nc I Column dimension of m1 (and also mout). - mout O Output matrix equal to m1. - --Detailed_Input - - m1 is an arbitrary-sized double precision matrix. - There are no restrictions on what it may contain. - - nr is the number of rows in the input matrix. - - nc is the number of columns in the input matrix. - --Detailed_Output - - mout This matrix is set to be equal to m1. - --Parameters - - None. - --Particulars - - None. - --Examples - - If m1 = | 1.0 2.0 | - | | - | 2.0 4.0 | - | | - | 4.0 6.0 | - - the call - - mequg_c ( m1, 3, 2, mout ) - - produces the matrix - - mout = | 1.0 2.0 | - | | - | 2.0 4.0 | - | | - | 4.0 6.0 | - --Restrictions - - None. - --Exceptions - - 1) If nr < 1 or nc < 1, the elements of the matrix mout are not - assigned any values, i.e. all zeros. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input array. - - -CSPICE Version 1.0.0, 31-MAR-1998 (EDW) - --Index_Entries - - equal to another n-dimensional matrix - --& -*/ - -{ /* Begin mequg_c */ - - - /* Not really that complicated. */ - - MOVED ( m1, nr * nc, mout ); - - -} /* End mequg_c */ diff --git a/ext/spice/src/cspice/minac.c b/ext/spice/src/cspice/minac.c deleted file mode 100644 index 86f970dc1a..0000000000 --- a/ext/spice/src/cspice/minac.c +++ /dev/null @@ -1,182 +0,0 @@ -/* minac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MINAC ( Minimum element of array, character ) */ -/* Subroutine */ int minac_(char *array, integer *ndim, char *minval, integer - *loc, ftnlen array_len, ftnlen minval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Locate the minimum element of a character array. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ARRAY I Array. */ -/* NDIM I Number of elements in ARRAY. */ -/* MINVAL O Minimum value in ARRAY. */ -/* LOC O Location of MINVAL in ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is an arbitrary array. */ - -/* NDIM is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* MINVAL is the value in array that is less than or equal */ -/* to all other values in the array. If the array */ -/* contains more than one element with this value, */ -/* the first one is returned. */ - -/* Elements in character arrays are compared according */ -/* to the ASCII collating sequence. */ - -/* LOC is the location of the minimum element. That is, */ -/* MINVAL contains element ARRAY(LOC). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the array is empty (NDIM is less than one), LOC is zero, and */ -/* MINVAL is not changed. */ - -/* 2) If the declared length of MINVAL is too short to contain the */ -/* entire element, the element is truncated. (The original value */ -/* can be accessed via LOC.) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let array A contain the following elements. */ - -/* A(1) = 'Einstein' */ -/* A(2) = 'Bohr' */ -/* A(3) = 'Feynman' */ -/* A(4) = 'Pauli' */ -/* A(5) = 'Bardeen' */ -/* A(6) = 'Dirac' */ - -/* Then following the call */ - -/* CALL MINAC ( A, 6, MINVAL, LOC ) */ - -/* the values of MINVAL and LOC are 'Bardeen' and 5 respectively. */ - -/* $ Restrictions */ - -/* None */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* minimum element of character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 2-FEB-1989 (IMU) */ - -/* Missing header sections completed. */ - -/* -& */ - -/* Local variables */ - - if (*ndim <= 0) { - *loc = 0; - return 0; - } - s_copy(minval, array, minval_len, array_len); - *loc = 1; - i__1 = *ndim; - for (i__ = 2; i__ <= i__1; ++i__) { - if (l_lt(array + (i__ - 1) * array_len, minval, array_len, minval_len) - ) { - s_copy(minval, array + (i__ - 1) * array_len, minval_len, - array_len); - *loc = i__; - } - } - return 0; -} /* minac_ */ - diff --git a/ext/spice/src/cspice/minad.c b/ext/spice/src/cspice/minad.c deleted file mode 100644 index 7ae0b07984..0000000000 --- a/ext/spice/src/cspice/minad.c +++ /dev/null @@ -1,169 +0,0 @@ -/* minad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MINAD ( Minimum element of array, DP ) */ -/* Subroutine */ int minad_(doublereal *array, integer *ndim, doublereal * - minval, integer *loc) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Locate the minimum element of a DP array. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ARRAY I Array. */ -/* NDIM I Number of elements in ARRAY. */ -/* MINVAL O Minimum value in ARRAY. */ -/* LOC O Location of MINVAL in ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is an arbitrary array. */ - -/* NDIM is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* MINVAL is the value in array that is less than or equal */ -/* to all other values in the array. If the array */ -/* contains more than one element with this value, */ -/* the first one is returned. */ - -/* LOC is the location of the minimum element. That is, */ -/* MINVAL contains element ARRAY(LOC). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the array is empty (NDIM is less than one), LOC is zero, and */ -/* MINVAL is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let array A contain the following elements. */ - -/* A(1) = 16.D0 */ -/* A(2) = 4.D0 */ -/* A(3) = 32.D0 */ -/* A(4) = 64.D0 */ -/* A(5) = 2.D0 */ -/* A(6) = 8.D0 */ - -/* Then following the call */ - -/* CALL MINAD ( A, 6, MINVAL, LOC ) */ - -/* the values of MINVAL and LOC are 2.D0 and 5 respectively. */ - -/* $ Restrictions */ - -/* None */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* minimum element of d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 2-FEB-1989 (IMU) */ - -/* Missing header sections completed. */ - -/* -& */ - -/* Local variables */ - - if (*ndim <= 0) { - *loc = 0; - return 0; - } - *minval = array[0]; - *loc = 1; - i__1 = *ndim; - for (i__ = 2; i__ <= i__1; ++i__) { - if (array[i__ - 1] < *minval) { - *minval = array[i__ - 1]; - *loc = i__; - } - } - return 0; -} /* minad_ */ - diff --git a/ext/spice/src/cspice/minai.c b/ext/spice/src/cspice/minai.c deleted file mode 100644 index 6a3da42eda..0000000000 --- a/ext/spice/src/cspice/minai.c +++ /dev/null @@ -1,169 +0,0 @@ -/* minai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MINAI ( Minimum element of array, integer ) */ -/* Subroutine */ int minai_(integer *array, integer *ndim, integer *minval, - integer *loc) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Locate the minimum element of an integer array. */ - -/* $ 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 */ - -/* ARRAY, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ARRAY I Array. */ -/* NDIM I Number of elements in ARRAY. */ -/* MINVAL O Minimum value in ARRAY. */ -/* LOC O Location of MINVAL in ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is an arbitrary array. */ - -/* NDIM is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* MINVAL is the value in array that is less than or equal */ -/* to all other values in the array. If the array */ -/* contains more than one element with this value, */ -/* the first one is returned. */ - -/* LOC is the location of the minimum element. That is, */ -/* MINVAL contains element ARRAY(LOC). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the array is empty (NDIM is less than one), LOC is zero, and */ -/* MINVAL is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let array A contain the following elements. */ - -/* A(1) = 16 */ -/* A(2) = 4 */ -/* A(3) = 32 */ -/* A(4) = 64 */ -/* A(5) = 2 */ -/* A(6) = 8 */ - -/* Then following the call */ - -/* CALL MINAI ( A, 6, MINVAL, LOC ) */ - -/* the values of MINVAL and LOC are 2 and 5 respectively. */ - -/* $ Restrictions */ - -/* None */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* minimum element of integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 2-FEB-1989 (IMU) */ - -/* Missing header sections completed. */ - -/* -& */ - -/* Local variables */ - - if (*ndim <= 0) { - *loc = 0; - return 0; - } - *minval = array[0]; - *loc = 1; - i__1 = *ndim; - for (i__ = 2; i__ <= i__1; ++i__) { - if (array[i__ - 1] < *minval) { - *minval = array[i__ - 1]; - *loc = i__; - } - } - return 0; -} /* minai_ */ - diff --git a/ext/spice/src/cspice/mind_c.c b/ext/spice/src/cspice/mind_c.c deleted file mode 100644 index 299cbb0c42..0000000000 --- a/ext/spice/src/cspice/mind_c.c +++ /dev/null @@ -1,234 +0,0 @@ -/* - --Procedure mind_c ( Minimum of a set of double precision values ) - --Abstract - - Find the minimum of a set of double precision values. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceDouble mind_c ( SpiceInt n, ... ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - n I The number of double precision values to compare. - ... I The numbers to be compared, separated by commas. - --Detailed_Input - - n is the number of double precision values in the set - whose minimum is to be determined. - - ... represents a variable argument list. The number of - double precision values supplied must be that - indicated by n. The values are separated by commas. - - Section 5.2.4.1 of the ANSI C Standard, titled - "Translation Limits," specifies that argument lists - containing at least 31 items must be supported. In - the interest of portability, no more than 30 - double precision values should be supplied. - --Detailed_Output - - The function returns the minimum of the set of input double precision - values. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If n is less than 1, the value 0.0 is returned. - - 2) If the number of double precision values supplied does not match - the argument n, the action of this routine is not defined. - - 3) If the number of double precision values supplied exceeds 30, - the action of this routine is not defined. - --Files - - None. - --Particulars - - None. - --Examples - - 1) Find the minimum of four double precision values. - - #include "SpiceUsr.h" - . - . - . - - SpiceDouble min; - SpiceDouble a; - SpiceDouble b; - SpiceDouble c; - SpiceDouble d; - . - . - . - - min = mind_c ( 4, a, b, c, d ); - - --Restrictions - - 1) The ANSI C Standard specifies that argument lists containing 31 - actual arguments must be supported. Larger sets of values may - not be handled properly by this routine. - --Literature_References - - 1) "American National Standard for Programming Languages---C." - Section 5.4.2.1, "Translation Limits," p. 13. - Published by American National Standards Institute, - 11 West 42nd St., New York, NY 10035. Copyright 1990. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added "None." text to Particulars section, required for - API doc script (cspicehtml.pl) integrity checks. - - -CSPICE Version 1.0.0, 16-SEP-1999 (NJB) - --Index_Entries - - minimum of double precision values - --& -*/ - -{ /* Begin mind_c */ - - /* - Local variables - */ - - SpiceDouble next; - SpiceDouble retval; - - SpiceInt i; - - - /* - ap is the argument pointer. Its type va_list is declared in the - header stdarg.h. - */ - - va_list ap; - - - - /* - If there are no values to compare, return zero. - */ - - if ( n < 1 ) - { - return ( 0.0 ); - } - - /* - Initialize the argument pointer with the last named argument, namely - n. - */ - - va_start ( ap, n ); - - - /* - Initialize the minimum with the first value. - */ - - retval = va_arg ( ap, double ); - - - /* - Now compute a running minimum of the values, if there are more. - - By the way, we capture the argument in the variable next rather than - make the va_arg call as a MinVal argument, because the MinVal macro - would make the va_arg call twice. - */ - - for ( i = 1; i < n; i++ ) - { - next = va_arg ( ap, double ); - retval = MinVal ( retval, next ); - } - - - /* - Terminate the argument fetching process. - */ - - va_end ( ap ); - - - /* - Return the value we've found. - */ - - return ( retval ); - - -} /* End mind_c */ - diff --git a/ext/spice/src/cspice/mini_c.c b/ext/spice/src/cspice/mini_c.c deleted file mode 100644 index 7c1996f508..0000000000 --- a/ext/spice/src/cspice/mini_c.c +++ /dev/null @@ -1,233 +0,0 @@ -/* - --Procedure mini_c ( minimum of a set of integers ) - --Abstract - - Find the minimum of a set of integers. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceInt mini_c ( SpiceInt n, ... ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - n I The number of integer values to compare. - ... I The numbers to be compared, separated by commas. - --Detailed_Input - - n is the number of integer values in the set - whose minimum is to be determined. - - ... represents a variable argument list. The number of - integer values supplied must be that indicated by n. - The values are separated by commas. - - Section 5.2.4.1 of the ANSI C Standard, titled - "Translation Limits," specifies that argument lists - containing at least 31 items must be supported. In - the interest of portability, no more than 30 - integer values should be supplied. - --Detailed_Output - - The function returns the minimum of the set of input integers. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If n is less than 1, the value 0 is returned. - - 2) If the number of integer values supplied does not match - the argument n, the action of this routine is not defined. - - 3) If the number of integer values supplied exceeds 30, - the action of this routine is not defined. - --Files - - None. - --Particulars - - None. - --Examples - - 1) Find the minimum of four integer values. - - #include "SpiceUsr.h" - . - . - . - - SpiceInt min; - SpiceInt a; - SpiceInt b; - SpiceInt c; - SpiceInt d; - . - . - . - - min = mini_c ( 4, a, b, c, d ); - - --Restrictions - - 1) The ANSI C Standard specifies that argument lists containing 31 - actual arguments must be supported. Larger sets of values may - not be handled properly by this routine. - --Literature_References - - 1) "American National Standard for Programming Languages---C." - Section 5.4.2.1, "Translation Limits," p. 13. - Published by American National Standards Institute, - 11 West 42nd St., New York, NY 10035. Copyright 1990. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 11-NOV-2006 (EDW) - - Added "None." text to Particulars section, required for - API doc script (cspicehtml.pl) integrity checks. - - -CSPICE Version 1.0.0, 29-MAR-1999 (NJB) - --Index_Entries - - minimum of integer values - --& -*/ - -{ /* Begin mini_c */ - - /* - Local variables - */ - - SpiceInt next; - SpiceInt retval; - - SpiceInt i; - - - /* - ap is the argument pointer. Its type va_list is declared in the - header stdarg.h. - */ - - va_list ap; - - - - /* - If there are no values to compare, return zero. - */ - - if ( n < 1 ) - { - return ( 0 ); - } - - /* - Initialize the argument pointer with the last named argument, namely - n. - */ - - va_start ( ap, n ); - - - /* - Initialize the minimum with the first value. - */ - - retval = va_arg ( ap, int ); - - - /* - Now compute a running minimum of the values, if there are more. - - By the way, we capture the argument in the variable next rather than - make the va_arg call as a MinVal argument, because the MinVal macro - would make the va_arg call twice. - */ - - for ( i = 1; i < n; i++ ) - { - next = va_arg ( ap, int ); - retval = MinVal ( retval, next ); - } - - - /* - Terminate the argument fetching process. - */ - - va_end ( ap ); - - - /* - Return the value we've found. - */ - - return ( retval ); - - -} /* End mini_c */ - diff --git a/ext/spice/src/cspice/mkprodct.csh b/ext/spice/src/cspice/mkprodct.csh deleted file mode 100644 index e08a643dad..0000000000 --- a/ext/spice/src/cspice/mkprodct.csh +++ /dev/null @@ -1,318 +0,0 @@ -#! /bin/csh -# -# PC-LINUX 64bit version. -# -# This script is a more or less generic library/executable -# builder for CSPICE products. It assumes that it is executed -# from one of the "product" directories in a tree that looks like -# the one displayed below: -# -# package -# | -# | -# +------+------+------+------+------+ -# | | | | | | -# data doc etc exe lib src -# | -# | -# +----------+----------+------- ... ------+ -# | | | | -# product_1 product_2 product_3 ... product_n -# -# Here's the basic strategy: -# -# 1) Compile all of the .c files in the current directory -# -# 2) If there are no .pgm files in the current directory this -# is assumed to be a library source directory. The name -# of the library is the same as the name of the product. -# The library is placed in the "lib" directory in the tree -# above. The script is then done. -# -# If there are .pgm files and there were some .c -# files compiled the objects are gathered together in the -# current directory into a library called locallib.a. -# -# 3) If any *.pgm files exist in the current directory, compile -# them and add their objects to locallib.a. Create a C main -# program file from the uniform CSPICE main program main.x. -# Compile this main program and link its object with locallib.a, -# ../../cspice.a and ../../csupport.a. The output -# executables have an empty extension. The executables are -# placed in the "exe" directory in the tree above. -# -# The environment variable TKCOMPILEOPTIONS containing compile options -# is optionally set. If it is set prior to executing this script, -# those options are used. It it is not set, it is set within this -# script as a local variable. -# -# References: -# =========== -# -# "Unix Power Tools", page 11.02 -# Use the "\" character to unalias a command temporarily. -# -# "A Practical Guide to the Unix System" -# -# "The Unix C Shell Field Guide" -# -# Change History: -# =============== -# -# Version 6.2.0 Nov. 14, 2006 Boris Semenov -# -# Added -fPIC compile option. -# -# Version 6.1.0 November 13, 2006 Boris Semenov -# -# Updated for 64bit. Put -O2 back in. -# -# Version 6.1.0 October 6, 2005 Boris Semenov -# -# Put -O2 optimization back in because the problem that it caused -# was solved in the N0059 toolkit. -# -# Version 6.0.0 April 20, 2000 Bill Taber -# -# Removed O2 optimization as it caused some loops to -# not terminate. -# -# Version 5.0.0 Feb. 09, 1999 Nat Bachman -# -# Now uses O2 optimization. -# -# Version 4.0.0 Nov. 02, 1998 Nat Bachman -# -# Updated to use an environment variable to designate the C -# compiler to use. -# -# Version 3.0.0 Oct. 31, 1998 Nat Bachman -# -# Updated to make use of uniform C main routine main.x. -# -# Version 2.0.0 Feb. 04, 1998 Nat Bachman -# -# Modified to handle C code. Sun/Solaris/Native cc Version. -# -# Version 1.0.0 Dec 8, 1995 Bill Taber -# - - -# -# If there are any main programs in the directory, prepare them -# for use together with the "uniform" main.x routine. We copy -# each main program to a file whose name terminates in _main.c. -# We then make a copy of main.x having its name made of the tail of -# the original .pgm file and an extension of .px. When we compile -# the main programs, we'll look for this .px extension rather than -# the orginal .pgm. -# -\ls *.pgm >& /dev/null - -if ( $status == 0 ) then - - echo " " - - foreach MAIN ( *.pgm ) - -# -# Copy the orginal source file for the main program into a regular -# source file which will be included in the local library. -# -# Create a "main" source file having the name .px -# from the generic main program source file main.x. -# - set STEM = $MAIN:r - set TARGET = $STEM.px - - \cp $MAIN "$STEM"_main.c - \cp main.x $TARGET - -endif - - -# -# Choose your compiler. -# -if ( $?TKCOMPILER ) then - - echo " " - echo " Using compiler: " - echo " $TKCOMPILER" - -else - - set TKCOMPILER = "gcc" - echo " " - echo " Setting default compiler:" - echo $TKCOMPILER - -endif - - -# -# What compile options do we want to use? If they were -# set somewhere else, use those values. The same goes -# for link options. -# -if ( $?TKCOMPILEOPTIONS ) then - echo " " - echo " Using compile options: " - echo " $TKCOMPILEOPTIONS" -else -# -# Options: -# -# -ansi Compile source as ANSI C -# -# -DNON_UNIX_STDIO Don't assume standard Unix stdio.h -# implementation -# -# - set TKCOMPILEOPTIONS = "-c -ansi -m64 -O2 -fPIC -DNON_UNIX_STDIO" - echo " " - echo " Setting default compile options:" - echo " $TKCOMPILEOPTIONS" -endif - -if ( $?TKLINKOPTIONS ) then - echo " " - echo " Using link options: " - echo " $TKLINKOPTIONS" -else - set TKLINKOPTIONS = "-lm -m64" - echo " " - echo " Setting default link options:" - echo " $TKLINKOPTIONS" -endif - -echo " " - -# -# Determine a provisional LIBRARY name. -# - foreach item ( `pwd` ) - set LIBRARY = "../../lib/"$item:t - end - -# -# Are there any *.c files that need to be compiled? -# -\ls *.c >& /dev/null - -if ( $status == 0 ) then - - foreach SRCFILE ( *.c ) - echo " Compiling: " $SRCFILE - $TKCOMPILER $TKCOMPILEOPTIONS $SRCFILE - end - -endif - - -echo " " - -# -# If object files exist, we need to create an object library. -# - -\ls *.pgm >& /dev/null - -if ( $status == 0 ) then - set LIBRARY = "locallib" -endif - -\ls *.o >& /dev/null - -if ( $status == 0 ) then - - echo " Inserting objects in the library $LIBRARY ..." - ar crv $LIBRARY.a *.o - ranlib $LIBRARY.a - \rm *.o - echo " " - -endif - -# -# If there are any main programs in the directory, compile -# them. If they have their own locallib.a link with it in addition -# to the default libraries. -# - -\ls *.pgm >& /dev/null - -if ( $status == 0 ) then - - echo " " - - foreach MAIN ( *.px ) - - set STEM = $MAIN:r - set TARGET = $STEM.c - set MAINOBJ = $STEM.o - set EXECUT = ../../exe/$STEM - - cp $MAIN $TARGET - - echo " Compiling and linking: " $MAIN - - if ( -e locallib.a ) then - - $TKCOMPILER $TKCOMPILEOPTIONS $TARGET - $TKCOMPILER -o $EXECUT $MAINOBJ \ - locallib.a \ - ../../lib/csupport.a \ - ../../lib/cspice.a \ - $TKLINKOPTIONS - - \rm $TARGET - \rm $MAINOBJ - \rm locallib.a - - else - - echo "Compiling and linking: " $MAIN - $TKCOMPILER $TKCOMPILEOPTIONS $TARGET - $TKCOMPILER -o $EXECUT $MAINOBJ \ - ../../lib/csupport.a \ - ../../lib/cspice.a \ - $TKLINKOPTIONS - - \rm $TARGET - \rm $MAINOBJ - - endif - - end - -endif - -# -# Cleanup. -# - -echo " " - -\ls *.o >& /dev/null - -if ( $status == 0 ) then - \rm *.o -endif - -\ls *.px >& /dev/null - -if ( $status == 0 ) then - \rm *.px -endif - -\ls *_main.c >& /dev/null - -if ( $status == 0 ) then - \rm *_main.c -endif - - -exit 0 - - diff --git a/ext/spice/src/cspice/movec.c b/ext/spice/src/cspice/movec.c deleted file mode 100644 index 98b4335ce9..0000000000 --- a/ext/spice/src/cspice/movec.c +++ /dev/null @@ -1,169 +0,0 @@ -/* movec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MOVEC ( Move a character array to another ) */ -/* Subroutine */ int movec_(char *arrfrm, integer *ndim, char *arrto, ftnlen - arrfrm_len, ftnlen arrto_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Copy the elements of one character array into another */ -/* array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRFRM I Character array to be moved. */ -/* NDIM I Number of elements to copy, i.e. the dimension */ -/* of ARRFRM and ARRTO. */ -/* ARRTO O Destination array. */ - -/* $ Detailed_Input */ - -/* ARRFRM Array from which to copy items. */ - -/* NDIM Number of items to copy. */ - -/* $ Detailed_Output */ - -/* ARRTO Array to which items should be copied. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is simply shorthand for the following 3 lines of */ -/* code. */ - -/* DO I = 1, NDIM */ -/* ARRTO(I) = ARRFRM(I) */ -/* END DO */ - -/* $ Examples */ - -/* Often one needs to make a temporary copy of an array so that */ -/* it can be manipulated without altering the original array. */ -/* As pointed out in particulars, you could just do this within */ -/* the code that needs the copy. However, if you have several */ -/* arrays to copy, you can cut the number of lines of code that */ -/* are needed by a third. */ - -/* For example: */ - -/* DO I = 1, 19 */ -/* TEMPA(I) = A(I) */ -/* END DO */ - -/* DO I = 1, 38 */ -/* TEMPB(I) = B(I) */ -/* END DO */ - -/* Can be rewritten as */ - -/* CALL MOVEC ( A, 19, TEMPA ) */ -/* CALL MOVEC ( B, 38, TEMPB ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* move a character array to another character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 4-FEB-1989 (WLT) */ - -/* Header fully filled out. */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(arrto + (i__ - 1) * arrto_len, arrfrm + (i__ - 1) * arrfrm_len, - arrto_len, arrfrm_len); - } - return 0; -} /* movec_ */ - diff --git a/ext/spice/src/cspice/moved.c b/ext/spice/src/cspice/moved.c deleted file mode 100644 index c34fafd85d..0000000000 --- a/ext/spice/src/cspice/moved.c +++ /dev/null @@ -1,152 +0,0 @@ -/* - --Procedure moved_ ( Move a double precision array to another ) - --Abstract - - Copy the elements of one double precision array into another - array. - --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 - - ARRAY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - int moved_ ( doublereal * arrfrm, - integer * ndim, - doublereal * arrto ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - arrfrm I Double precision array to be moved. - ndim I Number of elements to copy, i.e. the dimension - of arrfrm and arrto. - arrto O Destination array. - --Detailed_Input - - arrfrm Array from which to copy items. - - ndim Number of items to copy. - --Detailed_Output - - arrto Array to which items should be copied. - --Parameters - - None. - --Particulars - - This routine should not be called by user applications. It exists - solely for the use of CSPICE functions produced by running f2c - on Fortran code. - --Examples - - This function encapsulates the following memmove call: - - memmove ( (void*) arrto, - (void*) arrfrm, - sizeof(SpiceDouble) * ndim ); - - where ndim is the number of double precision elements of the array - arrfrm. - - This call can be rewritten as - - moved_ ( arrfrm, &ndim, arrto ); - - --Restrictions - - 1) This function should not be called directly by user's application - software. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 14-SEP-1999 (NJB) - - Now avoids passing non-positive byte count to memmove. - - -CSPICE Version 1.0.0, 04-NOV-1998 (NJB) - --Index_Entries - - move a d.p. array to another d.p. array - --& -*/ - -{ /* Begin moved_ */ - - - if ( *ndim > 0 ) - { - MOVED ( arrfrm, (*ndim), arrto ); - } - - return ( 0 ); - - -} /* End moved_ */ - - diff --git a/ext/spice/src/cspice/movei.c b/ext/spice/src/cspice/movei.c deleted file mode 100644 index 89c0b106d3..0000000000 --- a/ext/spice/src/cspice/movei.c +++ /dev/null @@ -1,164 +0,0 @@ -/* movei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MOVEI ( Move a integer array to another ) */ -/* Subroutine */ int movei_(integer *arrfrm, integer *ndim, integer *arrto) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Copy the elements of one integer array into another */ -/* array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRFRM I Integer array to be moved. */ -/* NDIM I Number of elements to copy, i.e. the dimension */ -/* of ARRFRM and ARRTO. */ -/* ARRTO O Destination array. */ - -/* $ Detailed_Input */ - -/* ARRFRM Array from which to copy items. */ - -/* NDIM Number of items to copy. */ - -/* $ Detailed_Output */ - -/* ARRTO Array to which items should be copied. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is simply shorthand for the following 3 lines of */ -/* code. */ - -/* DO I = 1, NDIM */ -/* ARRTO(I) = ARRFRM(I) */ -/* END DO */ - -/* $ Examples */ - -/* Often one needs to make a temporary copy of an array so that */ -/* it can be manipulated without altering the original array. */ -/* As pointed out in particulars, you could just do this within */ -/* the code that needs the copy. However, if you have several */ -/* arrays to copy, you can cut the number of lines of code that */ -/* are needed by a third. */ - -/* For example: */ - -/* DO I = 1, 19 */ -/* TEMPA(I) = A(I) */ -/* END DO */ - -/* DO I = 1, 38 */ -/* TEMPB(I) = B(I) */ -/* END DO */ - -/* Can be rewritten as */ - -/* CALL MOVEI ( A, 19, TEMPA ) */ -/* CALL MOVEI ( B, 38, TEMPB ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* move a integer array to another integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 4-FEB-1989 (WLT) */ - -/* Header fully filled out. */ - -/* -& */ - -/* Local variables */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - arrto[i__ - 1] = arrfrm[i__ - 1]; - } - return 0; -} /* movei_ */ - diff --git a/ext/spice/src/cspice/mtxm.c b/ext/spice/src/cspice/mtxm.c deleted file mode 100644 index 1c32d5e6ed..0000000000 --- a/ext/spice/src/cspice/mtxm.c +++ /dev/null @@ -1,203 +0,0 @@ -/* mtxm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure MTXM ( Matrix transpose times matrix, 3x3 ) */ -/* Subroutine */ int mtxm_(doublereal *m1, doublereal *m2, doublereal *mout) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal prodm[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Multiply the transpose of a 3x3 matrix and a 3x3 matrix. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I 3x3 double precision matrix. */ -/* M2 I 3x3 double precision matrix. */ -/* MOUT O 3x3 double precision matrix which is the product */ -/* (M1**T) * M2. */ - -/* $ Detailed_Input */ - -/* M1 is any 3x3 double precision matrix. Typically, */ -/* M1 will be a rotation matrix since then its */ -/* transpose is its inverse (but this is NOT a */ -/* requirement). */ - -/* M2 is any 3x3 double precision matrix. */ - -/* $ Detailed_Output */ - -/* MOUT is s 3x3 double precision matrix. MOUT is the */ -/* product MOUT = (M1**T) x M2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscripts I and J from 1 to 3: */ - -/* MOUT(I,J) = Summation from K=1 to 3 of ( M1(K,I) * M2(K,J) ) */ - -/* Note that the reversal of the K and I subscripts in the left-hand */ -/* matrix M1 is what makes MOUT the product of the TRANSPOSE of M1 */ -/* and not simply of M1 itself. */ - -/* $ Examples */ - -/* Let M1 = | 1.0D0 2.0D0 3.0D0 | */ -/* | | */ -/* | 4.0D0 5.0D0 6.0D0 | */ -/* | | */ -/* | 7.0D0 8.0D0 9.0D0 | */ - - -/* M2 = | 1.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | -1.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - -/* then the call */ - -/* CALL MTXM ( M1, M2, MOUT ) */ - -/* produces the matrix */ - - -/* MOUT = | -3.0D0 5.0D0 7.0D0 | */ -/* | | */ -/* | -3.0D0 7.0D0 8.0D0 | */ -/* | | */ -/* | -3.0D0 9.0D0 9.0D0 | */ - - -/* $ Restrictions */ - -/* The user is responsible for checking the magnitudes of the */ -/* elements of M1 and M2 so that a floating point overflow does */ -/* not occur. (In the typical use where M1 and M2 are rotation */ -/* matrices, this not a risk at all.) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix_transpose times matrix 3x3_case */ - -/* -& */ - -/* Local variables */ - - -/* Perform the matrix multiplication */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - prodm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "prodm", i__1, "mtxm_", (ftnlen)175)] = m1[(i__2 = i__ * - 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, "mtx" - "m_", (ftnlen)175)] * m2[(i__3 = j * 3 - 3) < 9 && 0 <= - i__3 ? i__3 : s_rnge("m2", i__3, "mtxm_", (ftnlen)175)] + - m1[(i__4 = i__ * 3 - 2) < 9 && 0 <= i__4 ? i__4 : s_rnge( - "m1", i__4, "mtxm_", (ftnlen)175)] * m2[(i__5 = j * 3 - 2) - < 9 && 0 <= i__5 ? i__5 : s_rnge("m2", i__5, "mtxm_", ( - ftnlen)175)] + m1[(i__6 = i__ * 3 - 1) < 9 && 0 <= i__6 ? - i__6 : s_rnge("m1", i__6, "mtxm_", (ftnlen)175)] * m2[( - i__7 = j * 3 - 1) < 9 && 0 <= i__7 ? i__7 : s_rnge("m2", - i__7, "mtxm_", (ftnlen)175)]; - } - } - -/* Move the result into MOUT */ - - moved_(prodm, &c__9, mout); - return 0; -} /* mtxm_ */ - diff --git a/ext/spice/src/cspice/mtxm_c.c b/ext/spice/src/cspice/mtxm_c.c deleted file mode 100644 index 4c3cb723db..0000000000 --- a/ext/spice/src/cspice/mtxm_c.c +++ /dev/null @@ -1,200 +0,0 @@ -/* - --Procedure mtxm_c ( Matrix transpose times matrix, 3x3 ) - --Abstract - - Multiply the transpose of a 3x3 matrix and a 3x3 matrix. - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef mtxm_c - - - void mtxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I 3x3 double precision matrix. - m2 I 3x3 double precision matrix. - mout O The produce m1 transpose times m2. - --Detailed_Input - - m1 is any 3x3 double precision matrix. Typically, - m1 will be a rotation matrix since then its - transpose is its inverse (but this is not a - requirement). - - m2 is any 3x3 double precision matrix. - --Detailed_Output - - mout is a 3x3 double precision matrix. mout is the - product - - t - mout = m1 m2 - - mout may overwrite either m1 or m2. - --Parameters - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscripts i and j from 0 to 2: - - 2 - __ - \ - mout[i][j] = /_ m1[k][i] * m2[k][j] - k=0 - - Note that the reversal of the k and i subscripts in the left-hand - matrix m1 is what makes mout the product of the TRANSPOSE of M1 - and not simply of m1 itself. Also, the intermediate results of - the operation above are buffered in a temporary matrix which is - later moved to the output matrix. Thus mout can be actually be - m1 or m2 if desired without interfering with the computations. - --Examples - - Let m1 = | 1. 2. 3. | - | | - | 4. 5. 6. | - | | - | 7. 8. 9. | - - - m2 = | 1. 1. 0. | - | | - | -1. 1. 0. | - | | - | 0. 0. 1. | - - then the call - - mtxm_c ( m1, m2, mout ); - - produces the matrix - - mout = | -3. 5. 7. | - | | - | -3. 7. 8. | - | | - | -3. 9. 9. | - - --Restrictions - - The user is responsible for checking the magnitudes of the - elements of m1 and m2 so that a floating point overflow does - not occur. (In the typical use where m1 and m2 are rotation - matrices, this not a risk at all.) - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - W.M. Owen (JPL) - E.D Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - matrix_transpose times matrix 3x3_case - --& -*/ - - -{ /* Begin mtxm_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceInt j; - - SpiceDouble mtemp[3][3]; - - - for ( i = 0; i < 3; i++ ) - { - - for ( j = 0; j < 3; j++ ) - { - mtemp[i][j] = m1[0][i] * m2[0][j] - + m1[1][i] * m2[1][j] - + m1[2][i] * m2[2][j]; - } - } - - /* - Copy the results from the temporary matrix to the return matrix. - */ - - MOVED ( mtemp, 9, mout ); - - -} /* End mtxm_c */ - diff --git a/ext/spice/src/cspice/mtxmg.c b/ext/spice/src/cspice/mtxmg.c deleted file mode 100644 index 8696eac091..0000000000 --- a/ext/spice/src/cspice/mtxmg.c +++ /dev/null @@ -1,232 +0,0 @@ -/* mtxmg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MTXMG ( Matrix transpose times matrix, general dimension ) */ -/* Subroutine */ int mtxmg_(doublereal *m1, doublereal *m2, integer *nc1, - integer *nr1r2, integer *nc2, doublereal *mout) -{ - /* System generated locals */ - integer m1_dim1, m1_dim2, m1_offset, m2_dim1, m2_dim2, m2_offset, - mout_dim1, mout_dim2, mout_offset, i__1, i__2, i__3, i__4, i__5, - i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j, k; - -/* $ Abstract */ - -/* Multiply the transpose of a matrix with another matrix, */ -/* both of arbitrary size. (The dimensions of the matrices must be */ -/* compatible with this multiplication.) */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Left-hand matrix whose transpose is to be */ -/* multiplied. */ -/* M2 I Right-hand matrix to be multiplied. */ -/* NC1 I Column dimension of M1 and row dimension of */ -/* MOUT. */ -/* NR1R2 I Row dimension of M1 and row dimension of M2. */ -/* NC2 I Column dimension of M2 and column dimension of */ -/* MOUT. */ -/* MOUT O Product matrix M1**T * M2. */ -/* MOUT must NOT overwrite either M1 or M2. */ - -/* $ Detailed_Input */ - -/* M1 This is an double precision matrix of arbitrary dimension */ -/* whose transpose is the left hand multiplier of a matrix */ -/* multiplication. */ -/* M2 This is an double precision matrix of arbitrary dimension */ -/* whose transpose is the left hand multiplier of a matrix */ -/* multiplication. */ -/* NC1 This is the column dimension of M1 and row dimension of */ -/* MOUT. */ -/* NR1R2 This is the row dimension of both M1 and M2. */ -/* NC2 This is the column dimension of both M2 and MOUT. */ - -/* $ Detailed_Output */ - -/* MOUT is a double precision matrix containing the product */ - -/* T */ -/* MOUT = (M1) x (M2) */ - -/* where the superscript T denotes the transpose of M1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to NC1, and J from 1 */ -/* to NC2: */ - -/* MOUT(I,J) = Summation from K=1 to NR1R2 of ( M1(K,I) * M2(K,J) ) */ - -/* Note that the reversal of the K and I subscripts in the left-hand */ -/* matrix M1 is what makes MOUT the product of the TRANSPOSE of M1 */ -/* and not simply of M1 itself. */ - -/* Since this subroutine operates on matrices of arbitrary size, it */ -/* is not possible to buffer intermediate results. Thus, MOUT */ -/* should NOT overwrite either M1 or M2. */ - -/* $ Examples */ - -/* Suppose that M1 = | 1 2 3 0 | */ -/* | 1 1 1 1 | */ - -/* and that M2 = | 1 2 3 | */ -/* | 0 0 0 | */ - -/* Then calling MTXMG according to the following calling sequence */ - -/* CALL MTXMG (M1, M2, 4, 2, 3, MOUT) */ - -/* will yield the following value for MOUT */ - -/* | 1 2 3 | */ -/* MOUT = | 2 4 6 | */ -/* | 3 6 9 | */ -/* | 0 0 0 | */ - -/* $ Restrictions */ - -/* 1) The user is responsible for checking the magnitudes of the */ -/* elements of M1 and M2 so that a floating point overflow does */ -/* not occur. */ -/* 2) MOUT must not overwrite M1 or M2 or else the intermediate */ -/* will affect the final result. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix_transpose times matrix n-dimensional_case */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ - -/* Declaration of unused variable SUM removed. */ - -/* -& */ - -/* Perform the matrix multiplication */ - - /* Parameter adjustments */ - m1_dim1 = *nr1r2; - m1_dim2 = *nc1; - m1_offset = m1_dim1 + 1; - mout_dim1 = *nc1; - mout_dim2 = *nc2; - mout_offset = mout_dim1 + 1; - m2_dim1 = *nr1r2; - m2_dim2 = *nc2; - m2_offset = m2_dim1 + 1; - - /* Function Body */ - i__1 = *nc1; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = *nc2; - for (j = 1; j <= i__2; ++j) { - mout[(i__3 = i__ + j * mout_dim1 - mout_offset) < mout_dim1 * - mout_dim2 && 0 <= i__3 ? i__3 : s_rnge("mout", i__3, - "mtxmg_", (ftnlen)196)] = 0.; - i__3 = *nr1r2; - for (k = 1; k <= i__3; ++k) { - mout[(i__4 = i__ + j * mout_dim1 - mout_offset) < mout_dim1 * - mout_dim2 && 0 <= i__4 ? i__4 : s_rnge("mout", i__4, - "mtxmg_", (ftnlen)198)] = mout[(i__5 = i__ + j * - mout_dim1 - mout_offset) < mout_dim1 * mout_dim2 && 0 - <= i__5 ? i__5 : s_rnge("mout", i__5, "mtxmg_", ( - ftnlen)198)] + m1[(i__6 = k + i__ * m1_dim1 - - m1_offset) < m1_dim1 * m1_dim2 && 0 <= i__6 ? i__6 : - s_rnge("m1", i__6, "mtxmg_", (ftnlen)198)] * m2[(i__7 - = k + j * m2_dim1 - m2_offset) < m2_dim1 * m2_dim2 && - 0 <= i__7 ? i__7 : s_rnge("m2", i__7, "mtxmg_", ( - ftnlen)198)]; - } - } - } - - return 0; -} /* mtxmg_ */ - diff --git a/ext/spice/src/cspice/mtxmg_c.c b/ext/spice/src/cspice/mtxmg_c.c deleted file mode 100644 index ead1bd2ad6..0000000000 --- a/ext/spice/src/cspice/mtxmg_c.c +++ /dev/null @@ -1,299 +0,0 @@ -/* - --Procedure mtxmg_c ( Matrix transpose times matrix, general dimension ) - --Abstract - - Multiply the transpose of a matrix with another matrix, - both of arbitrary size. (The dimensions of the matrices must be - compatible with this multiplication.) - --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 - - MATRIX - -*/ - #include - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef mtxmg_c - - - void mtxmg_c ( const void * m1, - const void * m2, - SpiceInt ncol1, - SpiceInt nr1r2, - SpiceInt ncol2, - void * mout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I nr1r2 X ncol1 double precision matrix. - m2 I nr1r2 X ncol2 double precision matrix. - ncol1 I Column dimension of m1 and row dimension of mout. - nr1r2 I Row dimension of m1 and m2. - ncol2 I Column dimension of m2 (and also mout). - mout O Transpose of m1 times m2. - --Detailed_Input - - m1 is any double precision matrix of arbitrary size. - - m2 is any double precision matrix of arbitrary size. - The number of rows in m2 must match the number of - rows in m1. - - ncol1 is the number of columns in m1 and the number of rows of - mout. - - nr1r2 is the number of rows in both m1 and (by necessity) m2. - - ncol2 is the number of columns in both m2 and mout. - --Detailed_Output - - mout mout is the product matrix defined as the transpose of - m1 times m2, that is - - t - mout = (m1) x (m2) - - where the superscript t denotes the transpose of m1. - - mout is a double precision matrix of dimension ncol1 x - ncol2. - - mout may overwrite m1 or m2. Note that this capability - does not exist in the Fortran version of SPICELIB; in the - Fortran version, the output must not overwrite either - input. --Parameters - - None. - --Exceptions - - 1) If dynamic allocation of memory fails, the error - SPICE(MEMALLOCFAILED) is signalled. - --Files - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscript i from 1 to ncol1, and j from 1 - to ncol2: - - mout(i,j) = Summation from k=1 to nr1r2 of m1(k,i) * m2(k,j) - - --Examples - - 1) Suppose that m1 = | 1 2 3 0 | - | 1 1 1 1 | - - and that m2 = | 1 2 3 | - | 0 0 0 | - - Then calling mtxmg_c as shown - - mtxmg_c ( m1, m2, 4, 2, 3, mout ) - - will yield the following value for mout: - - | 1 2 3 | - mout = | 2 4 6 | - | 3 6 9 | - | 0 0 0 | - --Restrictions - - 1) No error checking is performed to prevent numeric overflow or - underflow. - - 2) No error checking performed to determine if the input and - output matrices have, in fact, been correctly dimensioned. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.2.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.2.1, 10-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input arrays. - - -CSPICE Version 1.0.0, 16-APR-1999 (NJB) - --Index_Entries - - matrix transpose times matrix n-dimensional_case - --& -*/ - -{ /* Begin mtxmg_c */ - - - /* - Local macros - - We'd like to be able to refer to the elements of the input and output - matrices using normal subscripts, for example, m1[2][3]. Since the - compiler doesn't know how to compute index offsets for the array - arguments, which have user-adjustable size, we must compute the - offsets ourselves. To make syntax a little easier to read (we hope), - we'll use macros to do the computations. - - The macro INDEX(width, i,j) computes the index offset from the array - base of the element at position [i][j] in a 2-dimensional matrix - having the number of columns indicated by width. For example, if - the input matrix m1 has 2 rows and 3 columns, the element at position - [0][1] would be indicated by - - m1[ INDEX(3,0,1) ] - - */ - - #define INDEX( width, row, col ) ( (row)*(width) + (col) ) - - - /* - Local variables - */ - SpiceDouble innerProduct; - SpiceDouble *tmpmat; - SpiceDouble *loc_m1; - SpiceDouble *loc_m2; - - SpiceInt col; - SpiceInt i; - SpiceInt nelt; - SpiceInt row; - - size_t size; - - - /* - Allocate space for a temporary copy of the output matrix, which - has ncol1 rows and ncol2 columns. - */ - nelt = ncol1 * ncol2; - size = (size_t) ( nelt * sizeof(SpiceDouble) ); - - tmpmat = (SpiceDouble *) malloc ( size ); - - if ( tmpmat == (SpiceDouble *)0 ) - { - chkin_c ( "mtxmg_c" ); - setmsg_c ( "An attempt to create a temporary matrix failed." ); - sigerr_c ( "SPICE(MEMALLOCFAILED)" ); - chkout_c ( "mtxmg_c" ); - return; - } - - /* - Cast the input pointers to pointers to SpiceDoubles. Note: the - original variables are pointers to void so that callers may - supply the array names as arguments without casting them to - SpiceDoubles. The naked array name is considered by the compiler - to be an incompatible pointer type with (SpiceDouble *), so we - can't simply declare the arguments to be (SpiceDouble *). On the - other hand, every pointer type can be cast to (void *). - */ - - loc_m1 = (SpiceDouble *) m1; - loc_m2 = (SpiceDouble *) m2; - - - /* - Compute the product. The matrix element at position (row,col) is - the inner product of the column of m1 having index row and the - column of m2 having index col. We compute index offsets using - the macro INDEX. - */ - - for ( row = 0; row < ncol1; row++ ) - { - - for ( col = 0; col < ncol2; col++ ) - { - innerProduct = 0.0; - - for ( i = 0; i < nr1r2; i++ ) - { - innerProduct += loc_m1[ INDEX(ncol1, i, row) ] - * loc_m2[ INDEX(ncol2, i, col) ]; - } - - tmpmat [ INDEX( ncol2, row, col ) ] = innerProduct; - } - } - - /* - Move the result from tmpmat into mout. - */ - MOVED ( tmpmat, nelt, mout ); - - /* - Free the temporary matrix. - */ - free ( tmpmat ); - - -} /* End mtxmg_c */ - diff --git a/ext/spice/src/cspice/mtxv.c b/ext/spice/src/cspice/mtxv.c deleted file mode 100644 index 1ec3c7eafe..0000000000 --- a/ext/spice/src/cspice/mtxv.c +++ /dev/null @@ -1,199 +0,0 @@ -/* mtxv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MTXV ( Matrix transpose times vector, 3x3 ) */ -/* Subroutine */ int mtxv_(doublereal *matrix, doublereal *vin, doublereal * - vout) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - doublereal prodv[3]; - -/* $ Abstract */ - -/* MTXV multiplies the transpose of a 3x3 matrix on the left with */ -/* a vector on the right. */ - -/* $ 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 */ - -/* MATRIX */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I 3X3 double precision matrix. */ -/* VIN I 3-dimensional double precision vector. */ -/* VOUT O 3-dimensional double precision vector. VOUT is */ -/* the product MATRIX**T * VIN. */ - -/* $ Detailed_Input */ - -/* MATRIX is an arbitrary 3x3 double precision matrix. */ -/* Typically, MATRIX will be a rotation matrix since */ -/* then its transpose is its inverse (but this is NOT */ -/* a requirement). */ - -/* VIN is an arbitrary 3-dimensional double precision */ -/* vector. */ - -/* $ Detailed_Output */ - -/* VOUT is a 3-dimensional double precision vector. VOUT is */ -/* the product VOUT = (MATRIX**T) x (VIN). */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to 3: */ - -/* VOUT(I) = Summation from K=1 to 3 of ( MATRIX(K,I) * VIN(K) ) */ - -/* Note that the reversal of the K and I subscripts in the left-hand */ -/* matrix MATRIX is what makes VOUT the product of the TRANSPOSE of */ -/* and not simply of MATRIX itself. */ - -/* $ Examples */ - -/* Typically the matrix MATRIX will be a rotation matrix. Because */ -/* the transpose of an orthogonal matrix is equivalent to its */ -/* inverse, applying the rotation to the vector is accomplished by */ -/* multiplying the vector by the transpose of the matrix. */ - -/* -1 */ -/* Let MATRIX * VIN = VOUT. If MATRIX is an orthogonal matrix, */ -/* then (MATRIX**T) * VIN = VOUT. */ - - -/* If MATRIX = | 1.0D0 1.0D0 0.0D0 | and VIN = | 5.0D0 | */ -/* | | | | */ -/* | -1.0D0 1.0D0 0.0D0 | | 10.0D0 | */ -/* | | | | */ -/* | 0.0D0 0.0D0 1.0D0 | | 15.0D0 | */ - - -/* then the call */ - -/* CALL MTXV ( MATRIX, VIN, VOUT ) */ - -/* produces the vector */ - - -/* VOUT = | -5.0D0 | */ -/* | | */ -/* | 15.0D0 | */ -/* | | */ -/* | 15.0D0 | */ - - -/* $ Restrictions */ - -/* The user is responsible for checking the magnitudes of the */ -/* elements of MATRIX and VIN so that a floating point overflow does */ -/* not occur. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix_transpose times 3-dimensional vector */ - -/* -& */ - -/* Local variables */ - - -/* Perform the matrix-vector multiplication */ - - for (i__ = 1; i__ <= 3; ++i__) { - prodv[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prodv", i__1, - "mtxv_", (ftnlen)179)] = matrix[(i__2 = i__ * 3 - 3) < 9 && - 0 <= i__2 ? i__2 : s_rnge("matrix", i__2, "mtxv_", (ftnlen) - 179)] * vin[0] + matrix[(i__3 = i__ * 3 - 2) < 9 && 0 <= i__3 - ? i__3 : s_rnge("matrix", i__3, "mtxv_", (ftnlen)179)] * vin[ - 1] + matrix[(i__4 = i__ * 3 - 1) < 9 && 0 <= i__4 ? i__4 : - s_rnge("matrix", i__4, "mtxv_", (ftnlen)179)] * vin[2]; - } - -/* Move the result into VOUT */ - - vout[0] = prodv[0]; - vout[1] = prodv[1]; - vout[2] = prodv[2]; - return 0; -} /* mtxv_ */ - diff --git a/ext/spice/src/cspice/mtxv_c.c b/ext/spice/src/cspice/mtxv_c.c deleted file mode 100644 index f744c094a0..0000000000 --- a/ext/spice/src/cspice/mtxv_c.c +++ /dev/null @@ -1,186 +0,0 @@ -/* - --Procedure mtxv_c ( Matrix transpose times vector, 3x3 ) - --Abstract - - mtxv_c multiplies the transpose of a 3x3 matrix on the left with - a vector on the right. - --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 - - VECTOR, MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef mtxv_c - - - void mtxv_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble vin [3], - SpiceDouble vout[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I 3x3 double precision matrix. - vin I 3-dimensional double precision vector. - vout O 3-dimensional double precision vector. vout is - the product m1**t * vin. - --Detailed_Input - - m1 is an arbitrary 3x3 double precision matrix. - typically, m1 will be a rotation matrix since - then its transpose is its inverse (but this is NOT - a requirement). - - vin is an arbitrary 3-dimensional double precision - vector. - --Detailed_Output - - vout is a 3-dimensional double precision vector. vout is - the product vout = (m1**t) x (vin). vout can - overwrite vin. - --Parameters - - None. - --Particulars - - The intermediate results of the operation performed by this routine - are buffered in a temporary vector which is later moved to the output - vector. Thus vout can be actually vin if desired without - interfering with the computation. - --Examples - - Typically the matrix m1 will be a rotation matrix. Because - the transpose of an orthogonal matrix is equivalent to its - inverse, applying the rotation to the vector is accomplished by - multiplying the vector by the transpose of the matrix. - - -1 - let m1 * vin = vout. If m1 is an orthogonal matrix, - then (m1**t) * vin = vout. - - - If m1 = | 1. 1. 0. | and vin = | 5. | - | | | | - | -1. 1. 0. | | 10. | - | | | | - | 0. 0. 1. | | 15. | - - - then the call - - mtxv_c ( m1, vin, vout ) - - produces the vector - - - vout = | -5. | - | | - | 15. | - | | - | 15. | - - --Restrictions - - The user is responsible for checking the magnitudes of the - elements of m1 and vin so that a floating point overflow does - not occur. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 10-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - matrix_transpose times 3-dimensional vector - --& -*/ - - -{ /* Begin mtxv_c */ - - - /* - Local variables - */ - - SpiceInt i; - SpiceDouble vtemp[3]; - - - for ( i = 0; i <= 2; i++ ) - { - vtemp[i] = m1[0][i]*vin[0] + m1[1][i]*vin[1] + m1[2][i]*vin[2]; - } - - - /* Move the computed result to the output array. */ - - MOVED ( vtemp, 3, vout ); - - -} /* End mtxv_c */ diff --git a/ext/spice/src/cspice/mtxvg.c b/ext/spice/src/cspice/mtxvg.c deleted file mode 100644 index ac304d74af..0000000000 --- a/ext/spice/src/cspice/mtxvg.c +++ /dev/null @@ -1,204 +0,0 @@ -/* mtxvg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MTXVG ( Matrix transpose times vector, general dimension ) */ -/* Subroutine */ int mtxvg_(doublereal *m1, doublereal *v2, integer *nc1, - integer *nr1r2, doublereal *vout) -{ - /* System generated locals */ - integer m1_dim1, m1_dim2, m1_offset, v2_dim1, vout_dim1, i__1, i__2, i__3, - i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, k; - doublereal sum; - -/* $ Abstract */ - -/* Multiply the transpose of a matrix and a vector of */ -/* arbitrary size. */ - -/* $ 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 */ - -/* MATRIX, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Left-hand matrix whose transpose is to be */ -/* multiplied. */ -/* V2 I Right-hand vector to be multiplied. */ -/* NC1 I Column dimension of M1 and length of VOUT. */ -/* NR1R2 I Row dimension of M1 and length of V2. */ -/* VOUT O Product vector M1**T * V2. */ -/* VOUT must NOT overwrite either M1 or V2. */ - -/* $ Detailed_Input */ - -/* M1 This is a double precision matrix of arbitrary size whose */ -/* transpose forms the left-hand matrix of the */ -/* multiplication. */ - -/* V2 This is a double precision vector on the right of the */ -/* multiplication. */ - -/* NC1 This is the column dimension of M1 and length of VOUT. */ - -/* NR1R2 This is the row dimension of M1 and length of V2. */ - -/* $ Detailed_Output */ - -/* VOUT This is the double precision vector which results from */ -/* the expression */ - -/* T */ -/* VOUT = (M1) x V2 */ - -/* where the T denotes the transpose of M1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to NC1, */ - -/* VOUT(I) = Summation from K=1 to NR1R2 of ( M1(K,I) * V2(K) ) */ - -/* Note that the reversal of the K and I subscripts in the left-hand */ -/* matrix M1 is what makes VOUT the product of the TRANSPOSE of M1 */ -/* and not simply of M1 itself. */ - -/* Since this subroutine operates on matrices of arbitrary size, it */ -/* is not feasible to buffer intermediate results. Thus, VOUT */ -/* should NOT overwrite either M1 or V2. */ - -/* $ Examples */ - -/* | 1 2 | */ -/* Suppose that M1 = | 1 3 | */ -/* | 1 4 | */ - -/* | 1 | */ -/* and that V2 = | 2 | */ -/* | 3 | */ - -/* Then calling MTXVG according to the following calling sequence */ - -/* CALL MTXVG (M1, V2, 2, 3, VOUT) */ - -/* will yield the following vector value for VOUT */ - -/* VOUT = | 6 | */ -/* | 20 | */ - -/* $ Restrictions */ - -/* 1) The user is responsible for checking the magnitudes of the */ -/* elements of M1 and V2 so that a floating point overflow does */ -/* not occur. */ -/* 2) VOUT not overwrite M1 or V2 or else the intermediate */ -/* will affect the final result. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix_transpose times n-dimensional vector */ - -/* -& */ - -/* Local variables */ - - -/* Perform the matrix-vector multiplication */ - - /* Parameter adjustments */ - vout_dim1 = *nc1; - v2_dim1 = *nr1r2; - m1_dim1 = *nr1r2; - m1_dim2 = *nc1; - m1_offset = m1_dim1 + 1; - - /* Function Body */ - i__1 = *nc1; - for (i__ = 1; i__ <= i__1; ++i__) { - sum = 0.; - i__2 = *nr1r2; - for (k = 1; k <= i__2; ++k) { - sum += m1[(i__3 = k + i__ * m1_dim1 - m1_offset) < m1_dim1 * - m1_dim2 && 0 <= i__3 ? i__3 : s_rnge("m1", i__3, "mtxvg_", - (ftnlen)183)] * v2[(i__4 = k - 1) < v2_dim1 && 0 <= i__4 - ? i__4 : s_rnge("v2", i__4, "mtxvg_", (ftnlen)183)]; - } - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "mtxvg_", (ftnlen)186)] = sum; - } - return 0; -} /* mtxvg_ */ - diff --git a/ext/spice/src/cspice/mtxvg_c.c b/ext/spice/src/cspice/mtxvg_c.c deleted file mode 100644 index 0ee741eb15..0000000000 --- a/ext/spice/src/cspice/mtxvg_c.c +++ /dev/null @@ -1,277 +0,0 @@ -/* - --Procedure mtxvg_c ( Matrix transpose times vector, general dimension ) - --Abstract - - Multiply the transpose of a matrix and a vector of arbitrary size. - --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 - - MATRIX, VECTOR - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef mtxvg_c - - - void mtxvg_c ( const void * m1, - const void * v2, - SpiceInt ncol1, - SpiceInt nr1r2, - void * vout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Left-hand matrix to be multiplied. - v2 I Right-hand vector to be multiplied. - ncol1 I Column dimension of m1 and length of vout. - nr1r2 I Row dimension of m1 and length of v2. - vout O Product vector m1 transpose * v2. - --Detailed_Input - - m1 is a double precision matrix of arbitrary size which - forms the left-hand matrix of the multiplication. - - v2 is a double precision vector on the right of the - multiplication. - - ncol1 is the column dimension of m1 and length of vout. - - nr1r2 is the row dimension of m1 and length of v2. - --Detailed_Output - - vout is the double precision vector which results from - the multiplication - - t - vout = (m1) x v2 - - where the superscript t denotes the transpose of a matrix. - vout has length ncol1. - - vout may overwrite m1 or v2. Note that this capability - does not exist in the Fortran version of SPICELIB; in the - Fortran version, the output must not overwrite either - input. - --Parameters - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscript i from 1 to ncol1, - - vout(i) = Summation from k=1 to nr1r2 of ( m1(k,i) * v2(k) ) - --Examples - - 1) Suppose that - - | 1 2 | - m1 = | 1 3 | - | 1 4 | - - - and that - - | 1 | - v2 = | 2 | - | 3 | - - - Then calling mxvg_c as shown - - mtxvg_c ( m1, v2, 2, 3, vout ); - - - will yield the following vector value for vout: - - vout = | 6 | - | 20 | - --Restrictions - - 1) The user is responsible for checking the magnitudes of the - elements of m1 and v2 so that a floating point overflow does - not occur. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input arrays. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - Corrected a comment describing the local macro INDEX. Made - miscellaneous code format corrections. - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - matrix transpose times n-dimensional vector - --& -*/ - -{ /* Begin mxvg_c */ - - /* - Local macros - - We'd like to be able to refer to the elements of the input and output - matrices using normal subscripts, for example, m1[2][3]. Since the - compiler doesn't know how to compute index offsets for the array - arguments, which have user-adjustable size, we must compute the - offsets ourselves. To make syntax a little easier to read (we hope), - we'll use macros to do the computations. - - The macro INDEX(width, i,j) computes the index offset from the array - base of the element at position [i][j] in a 2-dimensional matrix - having the number of columns indicated by width. For example, if - the input matrix m1 has 2 rows and 3 columns, the element at position - [0][1] would be indicated by - - m1[ INDEX(3,0,1) ] - - */ - - #define INDEX( width, row, col ) ( (row)*(width) + (col) ) - - - /* - Local variables - */ - SpiceDouble innerProduct; - SpiceDouble *tmpvec; - SpiceDouble *loc_m1; - SpiceDouble *loc_v2; - - SpiceInt row; - SpiceInt i; - - size_t size; - - - /* - Allocate space for a temporary copy of the output vector, which - has ncol1 rows. - */ - size = (size_t) ( ncol1 * sizeof(SpiceDouble) ); - - tmpvec = (SpiceDouble *) malloc ( size ); - - if ( tmpvec == (SpiceDouble *)0 ) - { - chkin_c ( "mtxvg_c" ); - setmsg_c ( "An attempt to create a temporary vector failed." ); - sigerr_c ( "SPICE(MEMALLOCFAILED)" ); - chkout_c ( "mtxvg_c" ); - return; - } - - /* - Cast the input pointers to pointers to SpiceDoubles. Note: the - original variables are pointers to void so that callers may - supply the array names as arguments without casting them to - SpiceDoubles. The naked array name is considered by the compiler - to be an incompatible pointer type with (SpiceDouble *), so we - can't simply declare the arguments to be (SpiceDouble *). On the - other hand, every pointer type can be cast to (void *). - */ - - loc_m1 = (SpiceDouble *) m1; - loc_v2 = (SpiceDouble *) v2; - - - /* - Compute the product. The vector element at position (row) is - the inner product of the column of m1 having index row and v2. - We compute index offsets using the macro INDEX. - */ - - for ( row = 0; row < ncol1; row++ ) - { - - innerProduct = 0.0; - - for ( i = 0; i < nr1r2; i++ ) - { - innerProduct += loc_m1[ INDEX(ncol1, i, row ) ] * loc_v2[i]; - } - - tmpvec [ row ] = innerProduct; - } - - /* - Move the result from tmpvec into vout. - */ - MOVED ( tmpvec, ncol1, vout ); - - /* - Free the temporary vector. - */ - free ( tmpvec ); - - -} /* End mtxvg_c */ diff --git a/ext/spice/src/cspice/mxm.c b/ext/spice/src/cspice/mxm.c deleted file mode 100644 index 0008cb90f9..0000000000 --- a/ext/spice/src/cspice/mxm.c +++ /dev/null @@ -1,191 +0,0 @@ -/* mxm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure MXM ( Matrix times matrix, 3x3 ) */ -/* Subroutine */ int mxm_(doublereal *m1, doublereal *m2, doublereal *mout) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal prodm[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Multiply two 3x3 matrices. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I 3x3 double precision matrix. */ -/* M2 I 3x3 double prercision matrix. */ -/* MOUT O 3x3 double precision matrix. MOUT is the product */ -/* M1*M2. */ - -/* $ Detailed_Input */ - -/* M1 is an arbitrary 3x3 double precision matrix. */ - -/* M2 is an arbitrary 3x3 double precision matrix. */ - -/* $ Detailed_Output */ - -/* MOUT is a 3x3 double precision matrix. MOUT is the product */ -/* M1*M2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscripts I and J from 1 to 3: */ - -/* MOUT(I,J) = Summation from K=1 to 3 of ( M1(I,K) * M2(K,J) ) */ - -/* $ Examples */ - -/* Let M1 = | 1.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | -1.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - - -/* and M2 = | 1.0D0 0.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 1.0D0 1.0D0 | */ -/* | | */ -/* | 0.0D0 -1.0D0 1.0D0 | */ - -/* then the call */ - -/* CALL MXM ( M1, M2, MOUT ) */ - -/* produces the matrix */ - -/* MOUT = | 1.0D0 1.0D0 1.0D0 | */ -/* | | */ -/* | -1.0D0 1.0D0 1.0D0 | */ -/* | | */ -/* | 0.0D0 -1.0D0 1.0D0 | */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix times matrix 3x3_case */ - -/* -& */ - -/* Local variables */ - - -/* Perform the matrix multiplication */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - prodm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "prodm", i__1, "mxm_", (ftnlen)162)] = m1[(i__2 = i__ - 1) - < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, "mxm_", ( - ftnlen)162)] * m2[(i__3 = j * 3 - 3) < 9 && 0 <= i__3 ? - i__3 : s_rnge("m2", i__3, "mxm_", (ftnlen)162)] + m1[( - i__4 = i__ + 2) < 9 && 0 <= i__4 ? i__4 : s_rnge("m1", - i__4, "mxm_", (ftnlen)162)] * m2[(i__5 = j * 3 - 2) < 9 && - 0 <= i__5 ? i__5 : s_rnge("m2", i__5, "mxm_", (ftnlen) - 162)] + m1[(i__6 = i__ + 5) < 9 && 0 <= i__6 ? i__6 : - s_rnge("m1", i__6, "mxm_", (ftnlen)162)] * m2[(i__7 = j * - 3 - 1) < 9 && 0 <= i__7 ? i__7 : s_rnge("m2", i__7, "mxm_" - , (ftnlen)162)]; - } - } - -/* Move the result into MOUT */ - - moved_(prodm, &c__9, mout); - return 0; -} /* mxm_ */ - diff --git a/ext/spice/src/cspice/mxm_c.c b/ext/spice/src/cspice/mxm_c.c deleted file mode 100644 index 428cd16bea..0000000000 --- a/ext/spice/src/cspice/mxm_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure mxm_c ( Matrix times matrix, 3x3 ) - --Abstract - - Multiply two 3x3 matrices. - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef mxm_c - - - void mxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 i 3x3 double precision matrix. - m2 i 3x3 double precision matrix. - mout o 3x3 double precision matrix. mout is the product - m1*m2. - --Detailed_Input - - m1 is an arbitrary 3x3 double precision matrix. - - m2 is an arbitrary 3x3 double precision matrix. - --Detailed_Output - - mout is a 3x3 double precision matrix. mout is the product - m1*m2. mout may overwrite either m1 or m2. - --Parameters - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscripts i and j from 1 to 3: - - mout(i,j) = summation from k=1 to 3 of ( m1(i,k) * m2(k,j) ) - - The intermediate results of the operation above are buffered in a - temporary matrix which is later moved to the output matrix. - Thus, to save space in the calling program, mout can be actually - be m1 or m2 if desired without interfering with the computations. - --Examples - - Let m1 = | 1. 1. 0. | - | | - | -1. 1. 0. | - | | - | 0. 0. 1. | - - - and m2 = | 1. 0. 0. | - | | - | 0. 1. 1. | - | | - | 0. -1. 1. | - - then the call - - mxm_c ( m1, m2, mout ); - - produces the matrix - - mout = | 1. 1. 1. | - | | - | -1. 1. 1. | - | | - | 0. -1. 1. | - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - matrix times matrix 3x3_case - --& -*/ - - -{ /* Begin mxm_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceInt j; - SpiceDouble mtemp[3][3]; - - - for ( i = 0; i <= 2; ++i) - { - - for ( j = 0; j <= 2; ++j) - { - mtemp[i][j] = m1[i][0] * m2[0][j] + - m1[i][1] * m2[1][j] + - m1[i][2] * m2[2][j]; - } - - } - - - /* - Copy the results from the temporary matrix to the return matrix. - */ - MOVED ( mtemp, 9, mout ); - - -} /* End mxm_c */ diff --git a/ext/spice/src/cspice/mxmg.c b/ext/spice/src/cspice/mxmg.c deleted file mode 100644 index 5dc64c4b3a..0000000000 --- a/ext/spice/src/cspice/mxmg.c +++ /dev/null @@ -1,216 +0,0 @@ -/* mxmg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MXMG ( Matrix times matrix, general dimension ) */ -/* Subroutine */ int mxmg_(doublereal *m1, doublereal *m2, integer *row1, - integer *col1, integer *col2, doublereal *mout) -{ - /* System generated locals */ - integer m1_dim1, m1_dim2, m1_offset, m2_dim1, m2_dim2, m2_offset, - mout_dim1, mout_dim2, mout_offset, i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j, k; - doublereal sum; - -/* $ Abstract */ - -/* Multiply two double precision matrices of arbitrary size. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I ROW1xCOL1 double precision matrix. */ -/* M2 I COL1xCOL2 double precision matrix. */ -/* ROW1 I Row dimension of M1 (and also MOUT). */ -/* COL1 I Column dimension of M1 and row dimension of M2. */ -/* COL2 I Column dimension of M2 (and also MOUT). */ -/* MOUT O ROW1xCOL2 double precision matrix. */ - -/* $ Detailed_Input */ - -/* M1 is any double precision matrix of arbitrary size. */ - -/* M2 is any double precision matrix of arbitrary size. */ -/* The number of rows in M2 must match the number of */ -/* columns in M1. */ - -/* ROW1 is the number of rows in both M1 and MOUT. */ - -/* COL1 is the number of columns in M1 and (by necessity) */ -/* the number of rows of M2. */ - -/* COL2 is the number of columns in both M2 and MOUT. */ - -/* $ Detailed_Output */ - -/* MOUT is a a double precision matrix of dimension */ -/* ROW1 x COL2. MOUT is the product matrix given */ -/* by MOUT = (M1) x (M2). MOUT must not overwrite */ -/* M1 or M2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Examples */ - -/* Let M1 = | 1.0D0 4.0D0 | and M2 = | 1.0D0 3.0D0 5.0D0 | */ -/* | | | | */ -/* | 2.0D0 5.0D0 | | 2.0D0 4.0D0 6.0D0 | */ -/* | | */ -/* | 3.0D0 6.0D0 | */ - - -/* and ROW1 = 3 */ -/* COL1 = 2 */ -/* COL2 = 3 */ - -/* Then the call */ - -/* CALL MXMG ( M1, M2, ROW1, COL1, COL2, MOUT ) */ - -/* produces the matrix */ - -/* MOUT = | 9.0D0 19.0D0 29.0D0 | */ -/* | | */ -/* | 12.0D0 26.0D0 40.0D0 | */ -/* | | */ -/* | 15.0D0 33.0D0 51.0D0 | */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to NC1, and J from 1 */ -/* to COL2: */ - -/* MOUT(I,J) = Summation from K=1 to ROW1R2 of ( M1(I,K) * M2(K,J) */ - -/* Since this subroutine operates on matrices of arbitrary size, it */ -/* is not feasible to buffer intermediate results. Thus, MOUT */ -/* should NOT overwrite either M1 or M2. */ - -/* $ Restrictions */ - -/* 1) No error checking is performed to prevent numeric overflow or */ -/* underflow. */ - -/* 2) No error checking performed to determine if the input and */ -/* output matrices have, in fact, been correctly dimensioned. */ - -/* 3) MOUT should not overwrite M1 or M2. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If COL1 < 1, the elements of the matrix MOUT are set equal to */ -/* zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix times matrix n-dimensional_case */ - -/* -& */ - -/* Perform the matrix multiplication */ - - /* Parameter adjustments */ - m1_dim1 = *row1; - m1_dim2 = *col1; - m1_offset = m1_dim1 + 1; - mout_dim1 = *row1; - mout_dim2 = *col2; - mout_offset = mout_dim1 + 1; - m2_dim1 = *col1; - m2_dim2 = *col2; - m2_offset = m2_dim1 + 1; - - /* Function Body */ - i__1 = *row1; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = *col2; - for (j = 1; j <= i__2; ++j) { - sum = 0.; - i__3 = *col1; - for (k = 1; k <= i__3; ++k) { - sum += m1[(i__4 = i__ + k * m1_dim1 - m1_offset) < m1_dim1 * - m1_dim2 && 0 <= i__4 ? i__4 : s_rnge("m1", i__4, - "mxmg_", (ftnlen)183)] * m2[(i__5 = k + j * m2_dim1 - - m2_offset) < m2_dim1 * m2_dim2 && 0 <= i__5 ? i__5 : - s_rnge("m2", i__5, "mxmg_", (ftnlen)183)]; - } - mout[(i__3 = i__ + j * mout_dim1 - mout_offset) < mout_dim1 * - mout_dim2 && 0 <= i__3 ? i__3 : s_rnge("mout", i__3, - "mxmg_", (ftnlen)185)] = sum; - } - } - - return 0; -} /* mxmg_ */ - diff --git a/ext/spice/src/cspice/mxmg_c.c b/ext/spice/src/cspice/mxmg_c.c deleted file mode 100644 index fc006d484b..0000000000 --- a/ext/spice/src/cspice/mxmg_c.c +++ /dev/null @@ -1,305 +0,0 @@ -/* - --Procedure mxmg_c ( Matrix times matrix, general dimension ) - --Abstract - - Multiply two double precision matrices of arbitrary size. - --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 - - MATRIX - -*/ - #include - #include "SpiceZmc.h" - #include "SpiceUsr.h" - #include "SpiceZim.h" - #undef mxmg_c - - void mxmg_c ( const void * m1, - const void * m2, - SpiceInt nrow1, - SpiceInt ncol1, - SpiceInt ncol2, - void * mout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I nrow1 X ncol1 double precision matrix. - m2 I ncol1 X ncol2 double precision matrix. - nrow1 I Row dimension of m1 (and also mout). - ncol1 I Column dimension of m1 and row dimension of m2. - ncol2 I Column dimension of m2 (and also mout). - mout O nrow1 X ncol2 double precision matrix. - --Detailed_Input - - m1 is any double precision matrix of arbitrary size. - - m2 is any double precision matrix of arbitrary size. - The number of rows in m2 must match the number of - columns in m1. - - nrow1 is the number of rows in both m1 and mout. - - ncol1 is the number of columns in m1 and (by necessity) - the number of rows of m2. - - ncol2 is the number of columns in both m2 and mout. - --Detailed_Output - - mout - mout is the product matrix defined by - - mout = (m1) x (m2) - - mout is a double precision matrix of dimension nrow1 x - ncol2. - - mout may overwrite m1 or m2. Note that this capability - does not exist in the Fortran version of SPICELIB; in the - Fortran version, the output must not overwrite either - input. --Parameters - - None. - --Exceptions - - 1) If dynamic allocation of memory fails, the error - SPICE(MEMALLOCFAILED) is signalled. - --Files - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscript i from 1 to nrow1, and j from 1 - to ncol2: - - mout(i,j) = Summation from k=1 to ncol1 of m1(i,k) * m2(k,j) - - --Examples - - - Let - - m1 = | 1.0 4.0 | and m2 = | 1.0 3.0 5.0 | - | | | - | 2.0 5.0 | | 2.0 4.0 6.0 | - | | - | 3.0 6.0 | - - and - - nrow1 = 3 - ncol1 = 2 - ncol2 = 3 - - Then the call - - - mxmg ( m1, m2, nrow1, ncol1, ncol2, mout ); - - - produces the matrix - - mout = | 9.0 19.0 29.0 | - | | - | 12.0 26.0 40.0 | - | | - | 15.0 33.0 51.0 | - - --Restrictions - - 1) No error checking is performed to prevent numeric overflow or - underflow. - - 2) No error checking performed to determine if the input and - output matrices have, in fact, been correctly dimensioned. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.1.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.1.1, 10-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.1.0, 28-AUG-2001 (NJB) - - Const-qualified input arrays. - - -CSPICE Version 1.0.0, 16-APR-1999 (NJB) - --Index_Entries - - matrix times matrix n-dimensional_case - --& -*/ - -{ /* Begin mxmg_c */ - - - /* - Local macros - - We'd like to be able to refer to the elements of the input and output - matrices using normal subscripts, for example, m1[2][3]. Since the - compiler doesn't know how to compute index offsets for the array - arguments, which have user-adjustable size, we must compute the - offsets ourselves. To make syntax a little easier to read (we hope), - we'll use macros to do the computations. - - The macro INDEX(width, i,j) computes the index offset from the array - base of the element at position [i][j] in a 2-dimensional matrix - having the number of columns indicated by width. For example, if - the input matrix m1 has 2 rows and 3 columns, the element at position - [0][1] would be indicated by - - m1[ INDEX(3,0,1) ] - - */ - - #define INDEX( width, row, col ) ( (row)*(width) + (col) ) - - - /* - Local variables - */ - SpiceDouble innerProduct; - SpiceDouble *tmpmat; - SpiceDouble *loc_m1; - SpiceDouble *loc_m2; - - SpiceInt col; - SpiceInt nelts; - SpiceInt row; - SpiceInt i; - - size_t size; - - - /* - Allocate space for a temporary copy of the output matrix, which - has nrow1 rows and ncol2 columns. - */ - nelts = nrow1 * ncol2; - size = (size_t) ( nelts * sizeof(SpiceDouble) ); - - tmpmat = (SpiceDouble *) malloc ( size ); - - if ( tmpmat == (SpiceDouble *)0 ) - { - chkin_c ( "mxmg_c" ); - setmsg_c ( "An attempt to create a temporary matrix failed." ); - sigerr_c ( "SPICE(MEMALLOCFAILED)" ); - chkout_c ( "mxmg_c" ); - return; - } - - /* - Cast the input pointers to pointers to SpiceDoubles. Note: the - original variables are pointers to void so that callers may - supply the array names as arguments without casting them to - SpiceDoubles. The naked array name is considered by the compiler - to be an incompatible pointer type with (SpiceDouble *), so we - can't simply declare the arguments to be (SpiceDouble *). On the - other hand, every pointer type can be cast to (void *). - */ - - loc_m1 = (SpiceDouble *) m1; - loc_m2 = (SpiceDouble *) m2; - - - /* - Compute the product. The matrix element at position (row,col) is - the inner product of the row of m1 having index row and the - column of m2 having index col. We compute index offsets using - the macro INDEX. - */ - - for ( row = 0; row < nrow1; row++ ) - { - - for ( col = 0; col < ncol2; col++ ) - { - innerProduct = 0.0; - - for ( i = 0; i < ncol1; i++ ) - { - innerProduct += loc_m1[ INDEX(ncol1, row, i ) ] - * loc_m2[ INDEX(ncol2, i, col) ]; - } - - tmpmat [ INDEX( ncol2, row, col ) ] = innerProduct; - } - } - - /* - Move the result from tmpmat into mout. - */ - MOVED ( tmpmat, nelts, mout ); - - /* - Free the temporary matrix. - */ - free ( tmpmat ); - - -} /* End mxmg_c */ - diff --git a/ext/spice/src/cspice/mxmt.c b/ext/spice/src/cspice/mxmt.c deleted file mode 100644 index c2f731e0b0..0000000000 --- a/ext/spice/src/cspice/mxmt.c +++ /dev/null @@ -1,203 +0,0 @@ -/* mxmt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure MXMT ( Matrix times matrix transpose, 3x3 ) */ -/* Subroutine */ int mxmt_(doublereal *m1, doublereal *m2, doublereal *mout) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal prodm[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Multiply a 3x3 matrix and the transpose of another 3x3 matrix. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I 3x3 double precision matrix. */ -/* M2 I 3x3 double precision matrix. */ -/* MOUT O 3x3 double precision matrix. MOUT is the */ -/* product M1 * M2**T. */ - -/* $ Detailed_Input */ - -/* M1 is an arbitrary 3x3 double precision matrix. */ - -/* M2 is an arbitrary 3x3 double precision matrix. */ -/* Typically, M2 will be a rotation matrix since */ -/* then its transpose is its inverse (but this is */ -/* NOT a requirement). */ - -/* $ Detailed_Output */ - -/* MOUT is a 3x3 double precision matrix. MOUT is the */ -/* product (M1) x (M2**T). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscripts I and J from 1 to 3: */ - -/* MOUT(I,J) = Summation from K=1 to 3 of ( M1(I,K) * M2(J,K) ) */ - -/* Note that the reversal of the K and J subscripts in the right- */ -/* hand matrix M2 is what makes MOUT the product of the TRANSPOSE of */ -/* M2 and not simply of M2 itself. */ - -/* $ Examples */ - -/* Let M1 = | 0.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | -1.0D0 0.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - - -/* M2 = | 0.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | -1.0D0 0.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - -/* then the call */ - -/* CALL MXMT ( M1, M2, MOUT ) */ - -/* produces the matrix */ - - -/* MOUT = | 1.0D0 0.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 1.0D0 0.0D0 | */ -/* | | */ -/* | 0.0D0 0.0D0 1.0D0 | */ - - -/* $ Restrictions */ - -/* The user is responsible for checking the magnitudes of the */ -/* elements of M1 and M2 so that a floating point overflow does */ -/* not occur. (In the typical use where M1 and M2 are rotation */ -/* matrices, this not a risk at all.) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix times matrix_transpose 3x3_case */ - -/* -& */ - -/* Local variables */ - - -/* Perform the matrix multiplication */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - prodm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "prodm", i__1, "mxmt_", (ftnlen)174)] = m1[(i__2 = i__ - - 1) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, "mxmt_", ( - ftnlen)174)] * m2[(i__3 = j - 1) < 9 && 0 <= i__3 ? i__3 : - s_rnge("m2", i__3, "mxmt_", (ftnlen)174)] + m1[(i__4 = - i__ + 2) < 9 && 0 <= i__4 ? i__4 : s_rnge("m1", i__4, - "mxmt_", (ftnlen)174)] * m2[(i__5 = j + 2) < 9 && 0 <= - i__5 ? i__5 : s_rnge("m2", i__5, "mxmt_", (ftnlen)174)] + - m1[(i__6 = i__ + 5) < 9 && 0 <= i__6 ? i__6 : s_rnge( - "m1", i__6, "mxmt_", (ftnlen)174)] * m2[(i__7 = j + 5) < - 9 && 0 <= i__7 ? i__7 : s_rnge("m2", i__7, "mxmt_", ( - ftnlen)174)]; - } - } - -/* Move the result into MOUT */ - - moved_(prodm, &c__9, mout); - return 0; -} /* mxmt_ */ - diff --git a/ext/spice/src/cspice/mxmt_c.c b/ext/spice/src/cspice/mxmt_c.c deleted file mode 100644 index bb3dfb8e5b..0000000000 --- a/ext/spice/src/cspice/mxmt_c.c +++ /dev/null @@ -1,201 +0,0 @@ -/* - --Procedure mxmt_c ( Matrix times matrix transpose, 3x3 ) - --Abstract - - Multiply a 3x3 matrix and the transpose of another 3x3 matrix. - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef mxmt_c - - - void mxmt_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I 3x3 double precision matrix. - m2 I 3x3 double precision matrix. - mout O The product m1 times m2 transpose . - --Detailed_Input - - m1 is an arbitrary 3x3 double precision matrix. - - m2 is an arbitrary 3x3 double precision matrix. - Typically, m2 will be a rotation matrix since - then its transpose is its inverse (but this is - NOT a requirement). - --Detailed_Output - - mout is a 3x3 double precision matrix. mout is the - product - - t - mout = m1 m2 - - mout may overwrite either m1 or m2. - --Parameters - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscripts i and j from 0 to 2: - - 2 - __ - \ - mout[i][j] = /_ m1[i][k] * m2[j][k] - k=0 - - Note that the reversal of the k and i subscripts in the left-hand - matrix m1 is what makes mout the product of the TRANSPOSE of M1 - and not simply of m1 itself. Also, the intermediate results of - the operation above are buffered in a temporary matrix which is - later moved to the output matrix. Thus mout can be actually be - m1 or m2 if desired without interfering with the computations. - --Examples - - Let m1 = | 0.0 1.0 0.0 | - | | - | -1.0 0.0 0.0 | - | | - | 0.0 0.0 1.0 | - - - m2 = | 0.0 1.0 0.0 | - | | - | -1.0 0.0 0.0 | - | | - | 0.0 0.0 1.0 | - - then the call - - mxmt_c ( m1, m2, mout ); - - produces the matrix - - mout = | 1.0 0.0 0.0 | - | | - | 0.0 1.0 0.0 | - | | - | 0.0 0.0 1.0 | - - --Restrictions - - The user is responsible for checking the magnitudes of the - elements of m1 and m2 so that a floating point overflow does - not occur. (In the typical use where m1 and m2 are rotation - matrices, this not a risk at all.) - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - matrix times matrix_transpose 3x3_case - --& -*/ - - -{ /* Begin mxmt_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceInt j; - - SpiceDouble mtemp[3][3]; - - - for ( i = 0; i < 3; i++ ) - { - - for ( j = 0; j < 3; j++ ) - { - mtemp[i][j] = m1[i][0] * m2[j][0] - + m1[i][1] * m2[j][1] - + m1[i][2] * m2[j][2]; - } - } - - - /* - Copy the results from the temporary matrix to the return matrix. - */ - - MOVED ( mtemp, 9, mout ); - - -} /* End mxmt_c */ - diff --git a/ext/spice/src/cspice/mxmtg.c b/ext/spice/src/cspice/mxmtg.c deleted file mode 100644 index dfca9f4596..0000000000 --- a/ext/spice/src/cspice/mxmtg.c +++ /dev/null @@ -1,233 +0,0 @@ -/* mxmtg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MXMTG ( Matrix times matrix transpose, general dimension ) */ -/* Subroutine */ int mxmtg_(doublereal *m1, doublereal *m2, integer *nr1, - integer *nc1c2, integer *nr2, doublereal *mout) -{ - /* System generated locals */ - integer m1_dim1, m1_dim2, m1_offset, m2_dim1, m2_dim2, m2_offset, - mout_dim1, mout_dim2, mout_offset, i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j, k; - doublereal sum; - -/* $ Abstract */ - -/* Multiply a matrix and the transpose of a matrix, both of */ -/* arbitrary size. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Left-hand matrix to be multiplied. */ -/* M2 I Right-hand matrix whose transpose is to be */ -/* multiplied. */ -/* NR1 I Row dimension of M1 and row dimension of MOUT. */ -/* NC1C2 I Column dimension of M1 and column dimension of */ -/* M2. */ -/* NR2 I Row dimension of M2 and column dimension of */ -/* MOUT. */ -/* MOUT O Product matrix M1 * M2**T. */ -/* MOUT must not overwrite either M1 or M2. */ - -/* $ Detailed_Input */ - -/* M1 M1 may be any double precision matrix of arbitrary size. */ - -/* M2 M2 may be any double precision matrix of arbitrary size. */ -/* The number of columns in M2 must match the number of */ -/* columns in M1. */ - -/* NR1 The number of rows in both M1 and MOUT. */ - -/* NC1C2 The number of columns in M1 and (by necessity) the number */ -/* of columns of M2. */ - -/* NR2 The number of rows in both M2 and the number of columns */ -/* in MOUT. */ - -/* $ Detailed_Output */ - -/* MOUT This is a double precision matrix of dimension NR1 x NR2. */ -/* T */ -/* MOUT is the product matrix given by MOUT = (M1) x (M2) */ -/* where the superscript "T" denotes the transpose matrix. */ - -/* MOUT must not overwrite M1 or M2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to NR1, and J from 1 */ -/* to NR2: */ - -/* MOUT(I,J) = Summation from K=1 to NC1C2 of ( M1(I,K) * M2(J,K) ) */ - -/* Notice that the order of the subscripts of M2 are reversed from */ -/* what they would be if this routine merely multiplied M1 and M2. */ -/* It is this transposition of subscripts that makes this routine */ -/* multiply M1 and the TRANPOSE of M2. */ - -/* Since this subroutine operates on matrices of arbitrary size, it */ -/* is not feasible to buffer intermediate results. Thus, MOUT */ -/* should NOT overwrite either M1 or M2. */ - -/* $ Examples */ - - -/* Let M1 = | 1.0D0 2.0D0 3.0D0 | NR1 = 2 */ -/* | | NC1C2 = 3 */ -/* | 3.0D0 2.0D0 1.0D0 | NR2 = 4 */ - - -/* Let M2 = | 1.0D0 2.0D0 0.0D0 | */ -/* | | */ -/* | 2.0D0 1.0D0 2.0D0 | */ -/* | | */ -/* | 1.0D0 2.0D0 0.0D0 | */ -/* | | */ -/* | 2.0D0 1.0D0 2.0D0 | */ - -/* then the call */ - -/* CALL MXMTG ( M1, M2, NR1, NC1C2, NR2, MOUT ) */ - -/* produces the matrix */ - - -/* MOUT = | 5.0D0 10.0D0 5.0D0 10.0D0 | */ -/* | | */ -/* | 7.0D0 10.0D0 7.0D0 10.0D0 | */ - - -/* $ Restrictions */ - -/* No error checking is performed to prevent numeric overflow or */ -/* underflow. */ - -/* No error checking is performed to determine if the input and */ -/* output matrices have, in fact, been correctly dimensioned. */ - -/* The user is responsible for checking the magnitudes of the */ -/* elements of M1 and M2 so that a floating point overflow does */ -/* not occur. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix times matrix_transpose n-dimensional_case */ - -/* -& */ - -/* Local variables */ - - -/* Perform the matrix multiplication */ - - /* Parameter adjustments */ - m1_dim1 = *nr1; - m1_dim2 = *nc1c2; - m1_offset = m1_dim1 + 1; - mout_dim1 = *nr1; - mout_dim2 = *nr2; - mout_offset = mout_dim1 + 1; - m2_dim1 = *nr2; - m2_dim2 = *nc1c2; - m2_offset = m2_dim1 + 1; - - /* Function Body */ - i__1 = *nr1; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = *nr2; - for (j = 1; j <= i__2; ++j) { - sum = 0.; - i__3 = *nc1c2; - for (k = 1; k <= i__3; ++k) { - sum += m1[(i__4 = i__ + k * m1_dim1 - m1_offset) < m1_dim1 * - m1_dim2 && 0 <= i__4 ? i__4 : s_rnge("m1", i__4, - "mxmtg_", (ftnlen)206)] * m2[(i__5 = j + k * m2_dim1 - - m2_offset) < m2_dim1 * m2_dim2 && 0 <= i__5 ? i__5 : - s_rnge("m2", i__5, "mxmtg_", (ftnlen)206)]; - } - mout[(i__3 = i__ + j * mout_dim1 - mout_offset) < mout_dim1 * - mout_dim2 && 0 <= i__3 ? i__3 : s_rnge("mout", i__3, - "mxmtg_", (ftnlen)209)] = sum; - } - } - return 0; -} /* mxmtg_ */ - diff --git a/ext/spice/src/cspice/mxmtg_c.c b/ext/spice/src/cspice/mxmtg_c.c deleted file mode 100644 index 4693b24508..0000000000 --- a/ext/spice/src/cspice/mxmtg_c.c +++ /dev/null @@ -1,323 +0,0 @@ -/* - --Procedure mxmtg_c ( Matrix times matrix transpose, general dimension ) - --Abstract - - Multiply a matrix and the transpose of a matrix, both of - arbitrary size. - --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 - - MATRIX - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef mxmtg_c - - - void mxmtg_c ( const void * m1, - const void * m2, - SpiceInt nrow1, - SpiceInt nc1c2, - SpiceInt nrow2, - void * mout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Left-hand matrix to be multiplied. - m2 I Right-hand matrix whose transpose is to be multiplied - nrow1 I Row dimension of m1 and row dimension of mout. - nc1c2 I Column dimension of m1 and column dimension of m2. - nrow2 I Row dimension of m2 and column dimension of mout. - mout O Product matrix. - --Detailed_Input - - m1 may be any double precision matrix of arbitrary size. - - m2 may be any double precision matrix of arbitrary size. - The number of columns in m2 must match the number of - columns in m1. - - nrow1 is the number of rows in both m1 and mout. - - nc1c2 i the number of columns in m1 and (by necessity) the - number of columns of m2. - - nrow2 is the number of rows in both m2 and the number of columns - in mout. - --Detailed_Output - - mout is the product matrix given by - - t - mout = (m1) x (m2) - - - where the superscript "t" denotes the transpose matrix. - This is a double precision matrix of dimension nrow1 x - nrow2. - - mout may overwrite m1 or m2. Note that this capability - does not exist in the Fortran version of SPICELIB; in the - Fortran version, the output must not overwrite either - input. - --Parameters - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscript i from 1 to nrow1, and j from 1 - to nrow2: - - mout(i,j) = summation from k=1 to nc1c2 of ( m1(i,k) * m2(j,k) ) - - Notice that the order of the subscripts of m2 are reversed from - what they would be if this routine merely multiplied m1 and m2. - It is this transposition of subscripts that makes this routine - multiply m1 and the TRANPOSE of m2. - --Examples - - 1) Let m1 = - - | 1.0 2.0 3.0 | - | | - | 3.0 2.0 1.0 | - - Let m2 = - - | 1.0 2.0 0.0 | - | | - | 2.0 1.0 2.0 | - | | - | 1.0 2.0 0.0 | - | | - | 2.0 1.0 2.0 | - - Here - - nrow1 = 2 - nc1c2 = 3 - nrow2 = 4 - - - so the call - - mxmtg_c ( m1, m2, nrow1, nc1c2, nrow2, mout ); - - - produces the matrix - - - mout = | 5.0 10.0 5.0 10.0 | - | | - | 7.0 10.0 7.0 10.0 | - - --Restrictions - - No error checking is performed to prevent numeric overflow or - underflow. - - No error checking is performed to determine if the input and - output matrices have, in fact, been correctly dimensioned. - - The user is responsible for checking the magnitudes of the - elements of m1 and m2 so that a floating point overflow does - not occur. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input arrays. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - Corrected a comment describing the local macro INDEX. Made - miscellaneous code format corrections. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - matrix times matrix_transpose n-dimensional_case - --& -*/ - -{ /* Begin mxmtg_c */ - - - - /* - Local macros - - We'd like to be able to refer to the elements of the input and output - matrices using normal subscripts, for example, m1[2][3]. Since the - compiler doesn't know how to compute index offsets for the array - arguments, which have user-adjustable size, we must compute the - offsets ourselves. To make syntax a little easier to read (we hope), - we'll use macros to do the computations. - - The macro INDEX(width, i,j) computes the index offset from the array - base of the element at position [i][j] in a 2-dimensional matrix - having the number of columns indicated by width. For example, if - the input matrix m1 has 2 rows and 3 columns, the element at position - [0][1] would be indicated by - - m1[ INDEX(3,0,1) ] - - */ - - #define INDEX( width, row, col ) ( (row)*(width) + (col) ) - - - /* - Local variables - */ - SpiceDouble innerProduct; - SpiceDouble *tmpmat; - SpiceDouble *loc_m1; - SpiceDouble *loc_m2; - - SpiceInt col; - SpiceInt nelts; - - SpiceInt row; - SpiceInt i; - - size_t size; - - - /* - Allocate space for a temporary copy of the output matrix, which - has nrow1 rows and nc1c2 columns. - */ - nelts = nrow1 * nrow2; - - size = (size_t) ( nelts * sizeof(SpiceDouble) ); - - tmpmat = (SpiceDouble *) malloc ( size ); - - if ( tmpmat == (SpiceDouble *)0 ) - { - chkin_c ( "mxmtg_c" ); - setmsg_c ( "An attempt to create a temporary matrix failed." ); - sigerr_c ( "SPICE(MEMALLOCFAILED)" ); - chkout_c ( "mxmtg_c" ); - return; - } - - /* - Cast the input pointers to pointers to SpiceDoubles. Note: the - original variables are pointers to void so that callers may - supply the array names as arguments without casting them to - SpiceDoubles. The naked array name is considered by the compiler - to be an incompatible pointer type with (SpiceDouble *), so we - can't simply declare the arguments to be (SpiceDouble *). On the - other hand, every pointer type can be cast to (void *). - */ - - loc_m1 = (SpiceDouble *) m1; - loc_m2 = (SpiceDouble *) m2; - - - /* - Compute the product. The matrix element at position (row,col) is - the inner product of the row of m1 having index row and the - row of m2 having index col. We compute index offsets using - the macro INDEX. - */ - - for ( row = 0; row < nrow1; row++ ) - { - - for ( col = 0; col < nrow2; col++ ) - { - innerProduct = 0.0; - - for ( i = 0; i < nc1c2; i++ ) - { - innerProduct += loc_m1[ INDEX(nc1c2, row, i) ] - * loc_m2[ INDEX(nc1c2, col, i) ]; - } - - tmpmat [ INDEX( nrow2, row, col ) ] = innerProduct; - } - } - - /* - Move the result from tmpmat into mout. - */ - MOVED ( tmpmat, nelts, mout ); - - /* - Free the temporary matrix. - */ - free ( tmpmat ); - - -} /* End mxmtg_c */ diff --git a/ext/spice/src/cspice/mxv.c b/ext/spice/src/cspice/mxv.c deleted file mode 100644 index 9da5c7b191..0000000000 --- a/ext/spice/src/cspice/mxv.c +++ /dev/null @@ -1,179 +0,0 @@ -/* mxv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MXV ( Matrix times vector, 3x3 ) */ -/* Subroutine */ int mxv_(doublereal *matrix, doublereal *vin, doublereal * - vout) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - doublereal prodv[3]; - -/* $ Abstract */ - -/* Multiply a 3x3 double precision matrix with a 3-dimensional */ -/* double precision vector. */ - -/* $ 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 */ - -/* MATRIX */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I 3x3 double precision matrix. */ -/* VIN I 3-dimensional double precision vector. */ -/* VOUT O 3-dimensinoal double precision vector. VOUT is */ -/* the product MATRIX*VIN. */ - -/* $ Detailed_Input */ - -/* MATRIX is an arbitrary 3x3 double precision matrix. */ - -/* VIN is an arbitrary 3-dimensional double precision vector. */ - -/* $ Detailed_Output */ - -/* VOUT is a 3-dimensional double precision vector. VOUT is */ -/* the product MATRIX * V. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to 3: */ - -/* VOUT(I) = Summation from K=1 to 3 of ( MATRIX(I,K) * VIN(K) ) */ - -/* $ Examples */ - -/* Let */ - -/* MATRIX = | 0.0D0 1.0D0 0.0D0 | and VIN = | 1.0D0 | */ -/* | | | | */ -/* | -1.0D0 0.0D0 0.0D0 | | 2.0D0 | */ -/* | | | | */ -/* | 0.0D0 0.0D0 1.0D0 | | 3.0D0 | */ - -/* Then the call, */ - -/* CALL MXV ( MATRIX, VIN, VOUT ) */ - -/* produces the vector */ - -/* VOUT = | 2.0D0 | */ -/* | | */ -/* | -1.0D0 | */ -/* | | */ -/* | 3.0D0 | */ - - -/* $ Restrictions */ - -/* The user is responsible for checking the magnitudes of the */ -/* elements of MATRIX and VIN so that a floating point overflow does */ -/* not occur. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix times 3-dimensional vector */ - -/* -& */ - -/* Perform the matrix-vector multiplication */ - - for (i__ = 1; i__ <= 3; ++i__) { - prodv[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prodv", i__1, - "mxv_", (ftnlen)157)] = matrix[(i__2 = i__ - 1) < 9 && 0 <= - i__2 ? i__2 : s_rnge("matrix", i__2, "mxv_", (ftnlen)157)] * - vin[0] + matrix[(i__3 = i__ + 2) < 9 && 0 <= i__3 ? i__3 : - s_rnge("matrix", i__3, "mxv_", (ftnlen)157)] * vin[1] + - matrix[(i__4 = i__ + 5) < 9 && 0 <= i__4 ? i__4 : s_rnge( - "matrix", i__4, "mxv_", (ftnlen)157)] * vin[2]; - } - -/* Move the buffered vector into the output vector VOUT. */ - - vout[0] = prodv[0]; - vout[1] = prodv[1]; - vout[2] = prodv[2]; - return 0; -} /* mxv_ */ - diff --git a/ext/spice/src/cspice/mxv_c.c b/ext/spice/src/cspice/mxv_c.c deleted file mode 100644 index 891d358e83..0000000000 --- a/ext/spice/src/cspice/mxv_c.c +++ /dev/null @@ -1,167 +0,0 @@ -/* - --Procedure mxv_c ( Matrix times vector, 3x3 ) - --Abstract - - Multiply a 3x3 double precision matrix with a 3-dimensional - double precision vector. - --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 - - MATRIX, VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef mxv_c - - - void mxv_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble vin [3], - SpiceDouble vout[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I 3x3 double precision matrix. - vin I 3-dimensional double precision vector. - vout O 3-dimensinoal double precision vector. vout is - the product m1*vin. - --Detailed_Input - - m1 is an arbitrary 3x3 double precision matrix. - - vin is an arbitrary 3-dimensional double precision vector. - --Detailed_Output - - vout is a 3-dimensional double precision vector. vout is - the product m1 * v. vout may overwrite vin. - --Parameters - - None. - --Particulars - - The intermediate results of the operation performed by this routine - are buffered in a temporary vector which is later moved to the output - vector. Thus vout can be actually be vin if desired without - interfering with the computation. - --Examples - - Let - - m1 = | 0. 1. 0. | and vin = | 1. | - | | | | - | -1. 0. 0. | | 2. | - | | | | - | 0. 0. 1. | | 3. | - - Then the call - - mxv_c ( m1, vin, vout ); - - produces the vector - - vout = | 2. | - | | - | -1. | - | | - | 3. | - - --Restrictions - - The user is responsible for checking the magnitudes of the - elements of matrix and vin so that a floating point overflow does - not occur. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - Ed Wright (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - matrix times 3-dimensional vector - --& -*/ - - -{ /* Begin mxv_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceDouble vtemp[3]; - - - for ( i = 0; i <= 2; i++ ) - { - vtemp[i] = m1[i][0]*vin[0] + m1[i][1]*vin[1] + m1[i][2]*vin[2]; - } - - - /* Move the computed result to the output array. */ - - MOVED ( vtemp, 3, vout ); - - -} /* End of mxv_c */ - diff --git a/ext/spice/src/cspice/mxvg.c b/ext/spice/src/cspice/mxvg.c deleted file mode 100644 index 19a7fe7fe0..0000000000 --- a/ext/spice/src/cspice/mxvg.c +++ /dev/null @@ -1,187 +0,0 @@ -/* mxvg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MXVG ( Matrix time vector, general dimension ) */ -/* Subroutine */ int mxvg_(doublereal *m1, doublereal *v2, integer *nr1, - integer *nc1r2, doublereal *vout) -{ - /* System generated locals */ - integer m1_dim1, m1_dim2, m1_offset, v2_dim1, vout_dim1, i__1, i__2, i__3, - i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, k; - doublereal sum; - -/* $ Abstract */ - -/* Multiply a matrix and a vector of arbitrary size. */ - -/* $ 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 */ - -/* MATRIX */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Left-hand matrix to be multiplied. */ -/* V2 I Right-hand vector to be multiplied. */ -/* NR1 I Row dimension of M1 and length of VOUT. */ -/* NC1R2 I Column dimension of M1 and length of V2. */ -/* VOUT O Product vector M1*V2. */ - -/* $ Detailed_Input */ - -/* M1 This is a double precision matrix of arbitrary size which */ -/* forms the left-hand matrix of the multiplication. */ - -/* V2 This is a double precision vector on the right of the */ -/* multiplication. */ - -/* NR1 This is the row dimension of M1 and length of VOUT. */ - -/* NC1R2 This is the column dimension of M1 and length of V2. */ - -/* $ Detailed_Output */ - -/* VOUT This is the double precision vector which results from */ -/* the expression VOUT = (M1) x V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The code reflects precisely the following mathematical expression */ - -/* For each value of the subscript I from 1 to NR1, */ - -/* VOUT(I) = Summation from K=1 to NC1R2 of ( M1(I,K) * V2(K) ) */ - -/* $ Examples */ - -/* Suppose that M1 = | 1 1 1 | */ -/* | 2 3 4 | */ - -/* | 1 | */ -/* and that V2 = | 2 | */ -/* | 3 | */ - -/* Then calling MXVG according to the following calling sequence */ - -/* CALL MXVG (M1, V2, 2, 3, VOUT) */ - -/* will yield the following vector value for VOUT */ - -/* VOUT = | 6 | */ -/* | 20 | */ - -/* $ Restrictions */ - -/* 1) The user is responsible for checking the magnitudes of the */ -/* elements of M1 and V2 so that a floating point overflow does */ -/* not occur. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Re-ordered header sections and made minor formatting */ -/* changes. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* matrix times n-dimensional vector */ - -/* -& */ - -/* Perform the matrix-vector multiplication */ - - /* Parameter adjustments */ - vout_dim1 = *nr1; - v2_dim1 = *nc1r2; - m1_dim1 = *nr1; - m1_dim2 = *nc1r2; - m1_offset = m1_dim1 + 1; - - /* Function Body */ - i__1 = *nr1; - for (i__ = 1; i__ <= i__1; ++i__) { - sum = 0.; - i__2 = *nc1r2; - for (k = 1; k <= i__2; ++k) { - sum += m1[(i__3 = i__ + k * m1_dim1 - m1_offset) < m1_dim1 * - m1_dim2 && 0 <= i__3 ? i__3 : s_rnge("m1", i__3, "mxvg_", - (ftnlen)163)] * v2[(i__4 = k - 1) < v2_dim1 && 0 <= i__4 ? - i__4 : s_rnge("v2", i__4, "mxvg_", (ftnlen)163)]; - } - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "mxvg_", (ftnlen)165)] = sum; - } - return 0; -} /* mxvg_ */ - diff --git a/ext/spice/src/cspice/mxvg_c.c b/ext/spice/src/cspice/mxvg_c.c deleted file mode 100644 index c0b768b1ac..0000000000 --- a/ext/spice/src/cspice/mxvg_c.c +++ /dev/null @@ -1,276 +0,0 @@ -/* - --Procedure mxvg_c ( Matrix times vector, general dimension ) - --Abstract - - Multiply a matrix and a vector of arbitrary size. - --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 - - MATRIX, VECTOR - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef mxvg_c - - - void mxvg_c ( const void * m1, - const void * v2, - SpiceInt nrow1, - SpiceInt nc1r2, - void * vout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Left-hand matrix to be multiplied. - v2 I Right-hand vector to be multiplied. - nrow1 I Row dimension of m1 and length of vout. - nc1r2 I Column dimension of m1 and length of v2. - vout O Product vector m1*v2. - --Detailed_Input - - m1 is a double precision matrix of arbitrary size which - forms the left-hand matrix of the multiplication. - - v2 is a double precision vector on the right of the - multiplication. - - nrow1 is the row dimension of m1 and length of vout. - - nc1r2 is the column dimension of m1 and length of v2. - --Detailed_Output - - vout is the double precision vector which results from - the multiplication - - vout = (m1) x v2 - - vout has length nrow1. - - vout may overwrite m1 or v2. Note that this capability - does not exist in the Fortran version of SPICELIB; in the - Fortran version, the output must not overwrite either - input. - --Parameters - - None. - --Particulars - - The code reflects precisely the following mathematical expression - - For each value of the subscript i from 1 to nrow1, - - vout(i) = Summation from k=1 to nc1r2 of ( m1(i,k) * v2(k) ) - --Examples - - 1) Suppose that - - M1 = | 1 1 1 | - | 2 3 4 | - - and that - - | 1 | - V2 = | 2 | - | 3 | - - - Then calling mxvg_c as shown - - mxvg_c ( m1, v2, 2, 3, vout ); - - - will yield the following vector value for vout: - - vout = | 6 | - | 20 | - --Restrictions - - 1) The user is responsible for checking the magnitudes of the - elements of m1 and v2 so that a floating point overflow does - not occur. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 25-JUL-2001 (NJB) - - Changed protoype: inputs m1 and v2 are now type (const void *). - Implemented interface macro for casting inputs m1 and v2 to - const. - - -CSPICE Version 1.0.1, 08-FEB-1998 (NJB) - - Corrected a comment describing the local macro INDEX. Made - miscellaneous code format corrections. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - matrix times n-dimensional vector - --& -*/ - -{ /* Begin mxvg_c */ - - /* - Local macros - - We'd like to be able to refer to the elements of the input and output - matrices using normal subscripts, for example, m1[2][3]. Since the - compiler doesn't know how to compute index offsets for the array - arguments, which have user-adjustable size, we must compute the - offsets ourselves. To make syntax a little easier to read (we hope), - we'll use macros to do the computations. - - The macro INDEX(width, i,j) computes the index offset from the array - base of the element at position [i][j] in a 2-dimensional matrix - having the number of columns indicated by width. For example, if - the input matrix m1 has 2 rows and 3 columns, the element at position - [0][1] would be indicated by - - m1[ INDEX(3,0,1) ] - - */ - - #define INDEX( width, row, col ) ( (row)*(width) + (col) ) - - - /* - Local variables - */ - SpiceDouble innerProduct; - SpiceDouble *tmpvec; - SpiceDouble *loc_m1; - SpiceDouble *loc_v2; - - SpiceInt row; - SpiceInt i; - - size_t size; - - - /* - Allocate space for a temporary copy of the output vector, which - has nrow1 rows. - */ - size = (size_t) ( nrow1 * sizeof(SpiceDouble) ); - - tmpvec = (SpiceDouble *) malloc ( size ); - - if ( tmpvec == (SpiceDouble *)0 ) - { - chkin_c ( "mxvg_c" ); - setmsg_c ( "An attempt to create a temporary vector failed." ); - sigerr_c ( "SPICE(MEMALLOCFAILED)" ); - chkout_c ( "mxvg_c" ); - return; - } - - /* - Cast the input pointers to pointers to SpiceDoubles. Note: the - original variables are pointers to void so that callers may - supply the array names as arguments without casting them to - SpiceDoubles. The naked array name is considered by the compiler - to be an incompatible pointer type with (SpiceDouble *), so we - can't simply declare the arguments to be (SpiceDouble *). On the - other hand, every pointer type can be cast to (void *). - */ - - loc_m1 = (SpiceDouble *) m1; - loc_v2 = (SpiceDouble *) v2; - - - /* - Compute the product. The vector element at position (row) is - the inner product of the row of m1 having index row and v2. - We compute index offsets using the macro INDEX. - */ - - for ( row = 0; row < nrow1; row++ ) - { - - innerProduct = 0.0; - - for ( i = 0; i < nc1r2; i++ ) - { - innerProduct += loc_m1[ INDEX(nc1r2, row, i ) ] * loc_v2[i]; - } - - tmpvec [ row ] = innerProduct; - } - - /* - Move the result from tmpvec into vout. - */ - MOVED ( tmpvec, nrow1, vout ); - - /* - Free the temporary vector. - */ - free ( tmpvec ); - - -} /* End mxvg_c */ diff --git a/ext/spice/src/cspice/namfrm_c.c b/ext/spice/src/cspice/namfrm_c.c deleted file mode 100644 index edd94bd608..0000000000 --- a/ext/spice/src/cspice/namfrm_c.c +++ /dev/null @@ -1,190 +0,0 @@ -/* - --Procedure namfrm_c (Name to frame) - --Abstract - - Look up the frame ID code associated with a 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 - - FRAMES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - void namfrm_c ( ConstSpiceChar * frname, - SpiceInt * frcode ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - frname I The name of some reference frame. - frcode O The SPICE ID code of the frame. - --Detailed_Input - - frname is a character string that stands for some - reference frame (either inertial or non-inertial). - - Leading blanks in frname are ignored. The - case of the letters in frname are insignificant. - - Note that all legitimate frame names contain - 32 or fewer characters. - --Detailed_Output - - frcode is the SPICE integer code used for internal - representation of the named reference frame. - - If the name input through frname is not recognized, - frcode will be returned with a value of zero. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the input name is not recognized, frcode will be - returned with a value of 0. - - 2) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If the input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Particulars - - This is a low level interface routine intended primarily for - use within the SPK and CK systems to assist in the transformation - to user specified reference frames. - - The routine first consults a stored list of reference frame - names in an attempt to determine the appropriate reference - frame code. - - If this search is unsuccessful, the routine then examines the - kernel pool to determine whether or not a variable of the - form - - "FRAME_" - - (where leading blanks of frname are ignored) - - is present. If it is and the number of values associated with the - name is 1, this value is taken to be the frame ID code. - - Note: It is NOT possible to override the default names and - ID codes stored locally in this routine by placing an - appropriately named variable in the kernel pool with a different - ID code. The predefined values always take precedence. - - Consult the FRAMES required reading document for more details - about constructing your own frame definitions. - --Examples - - Suppose that you needed to find the SPICE ID code for the - bodyfixed reference frame for Mars as modeled by the - IAU cartographic working group. Use the following code - to perform this task. - - #include "SpiceUsr.h" - . - . - . - - namfrm_c ( "IAU_MARS", &frcode ); - - printf ( "The SPICE code for the Mars bodyfixed frame is: %d\n", - frcode ); - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 13-AUG-2001 (NJB) (WLT) - --Index_Entries - - Frame name to frame idcode translation - --& -*/ - -{ /* Begin namfrm_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "namfrm_c" ); - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "namfrm_c", frname ); - - namfrm_ ( ( char * ) frname, - ( integer * ) frcode, - ( ftnlen ) strlen(frname) ); - - - chkout_c ( "namfrm_c" ); - -} /* End namfrm_c */ diff --git a/ext/spice/src/cspice/nblen.c b/ext/spice/src/cspice/nblen.c deleted file mode 100644 index 6f8f7475fa..0000000000 --- a/ext/spice/src/cspice/nblen.c +++ /dev/null @@ -1,145 +0,0 @@ -/* nblen.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NBLEN ( Non blank length of a string ) */ -integer nblen_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - -/* $ Abstract */ - -/* Return the non-blank length of a character string. (That is, */ -/* the index of the last non-blank character when the string is */ -/* left-justified.) */ - -/* $ 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 */ - -/* ASCII, CHARACTER, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* NBLEN O Non-blank length of STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* NBLEN is the non-blank length of STRING. This is the same */ -/* as the index of the last non-blank character in the */ -/* left justified string. If STRING is blank, NBLEN is */ -/* zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Locate the first and last non-blank characters in the string. */ -/* Subtract to get the non-blank length. */ - -/* $ Examples */ - -/* The following examples illustrate the use of NBLEN. */ - -/* NBLEN ( 'ABCDE' ) = 5 */ -/* NBLEN ( 'AN EXAMPLE' ) = 10 */ -/* NBLEN ( ' AN EXAMPLE ' ) = 10 */ -/* NBLEN ( ' ' ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* non-blank length of a string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Blank string is easy. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - ret_val = 0; - } else { - ret_val = lastnb_(string, string_len) - frstnb_(string, string_len) + - 1; - } - return ret_val; -} /* nblen_ */ - diff --git a/ext/spice/src/cspice/nbwid.c b/ext/spice/src/cspice/nbwid.c deleted file mode 100644 index f44e3ea813..0000000000 --- a/ext/spice/src/cspice/nbwid.c +++ /dev/null @@ -1,191 +0,0 @@ -/* nbwid.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NBWID ( Non-blank width of a character array ) */ -integer nbwid_(char *array, integer *nelt, ftnlen array_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__, j, strlen; - -/* $ Abstract */ - -/* Determine the non-blank width of a character array---that is, */ -/* the largest value of LASTNB for any element in the array. */ - -/* $ 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 */ - -/* ARRAY, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NELT I Number of elements in the array. */ -/* NBWID O Maximum value of LASTNB for the array. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* NELT is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* NBWID is the index of the rightmost non-blank character */ -/* in the entire array. This is equivalent to the */ -/* maximum value of LASTNB for the array, but somewhat */ -/* more efficient to compute. If NELT is not greater */ -/* than zero, NBWID is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Find the last non-blank character in the first element of the */ -/* array. Search the rest of the elements, starting at the end of */ -/* each string and moving back just far enough to determine if the */ -/* current string is wider than any of the previous ones. (This */ -/* makes NBWID somewhat more efficient than LASTNB.) */ - -/* If any of the strings is found to contain no trailing blanks, */ -/* NBWID is just the length of the individual elements of the array, */ -/* and the search is terminated immediately. */ - -/* $ Examples */ - -/* Let ARRAY contain the following strings. */ - -/* ARRAY(1) = 'A string of medium length ' */ -/* ARRAY(2) = 'A very long string, much longer than the rest ' */ -/* ARRAY(3) = 'Shorter ' */ -/* ARRAY(4) = 'Short ' */ - -/* Then the value returned by */ - -/* WIDEST = NBWID ( ARRAY, 4 ) */ - -/* is 45. */ - -/* If the word 'rest' in the second element is changed to 'others', */ -/* the value returned is 47, and the search is terminated after the */ -/* second element. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* non-blank width of a character array */ - -/* -& */ - -/* Local variables */ - - -/* Nonsense case: no elements. */ - - if (*nelt < 1) { - ret_val = 0; - -/* Get the length of the individual elements of the string. */ -/* So far, we have no maximum width, because we haven't examined */ -/* any elements. */ - - } else { - strlen = i_len(array, array_len); - ret_val = 0; - i__ = 0; - -/* Continue until the end of the array is reached, or until */ -/* a string with no trailing blanks is found. */ - - while(i__ < *nelt && ret_val < strlen) { - -/* Search no further than the current value of NBWID. */ - - ++i__; - j = strlen; - while(j > ret_val && *(unsigned char *)&array[(i__ - 1) * - array_len + (j - 1)] == ' ') { - --j; - } - -/* NBWID only increases if this string was wider than all */ -/* previous strings. */ - - ret_val = max(ret_val,j); - } - } - return ret_val; -} /* nbwid_ */ - diff --git a/ext/spice/src/cspice/ncpos.c b/ext/spice/src/cspice/ncpos.c deleted file mode 100644 index 3589cb32e1..0000000000 --- a/ext/spice/src/cspice/ncpos.c +++ /dev/null @@ -1,217 +0,0 @@ -/* ncpos.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NCPOS ( NOT character position ) */ -integer ncpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen - chars_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b; - logical found; - integer lenstr; - -/* $ Abstract */ - -/* Find the first occurrence in a string of a character NOT belonging */ -/* to a collection of characters, starting at a specified location, */ -/* searching forwards. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* CHARACTER */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I Any character string. */ -/* CHARS I A collection of characters. */ -/* START I Position to begin looking for one not in CHARS */ - -/* The function returns the index of the first character of STR */ -/* at or following index START that is not in the collection CHARS. */ - -/* $ Detailed_Input */ - -/* STR is any character string. */ - -/* CHARS is a character string containing a collection of */ -/* characters. Spaces in CHARS are significant. */ - -/* START is the position in STR to begin looking for */ -/* characters not in CHARS. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the first character of STR (at */ -/* or following index START) that is not one of the characters in the */ -/* string CHARS. If no such character is found, the function returns */ -/* zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If START is less than 1, the search begins at the first */ -/* character of the string. */ - -/* 2) If START is greater than the length of the string, NCPOS */ -/* returns zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCPOS is case sensitive. */ - -/* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */ -/* POSR, CPOSR, NCPOSR) is described in the Required Reading. */ - -/* Those familiar with the True BASIC language should note that */ -/* these functions are equivalent to the True BASIC intrinsic */ -/* functions with the same names. */ - -/* $ Examples */ - -/* Let STRING = 'BOB, JOHN, TED, AND MARTIN ' */ -/* 123456789012345678901234567890 */ - -/* Let CHAR = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' */ - -/* Normal (Sequential) Searching: */ -/* ------------------------------ */ - -/* NCPOS( STRING, CHAR, 1 ) = 4 */ -/* NCPOS( STRING, CHAR, 5 ) = 5 */ -/* NCPOS( STRING, CHAR, 6 ) = 10 */ -/* NCPOS( STRING, CHAR, 11 ) = 11 */ -/* NCPOS( STRING, CHAR, 12 ) = 15 */ -/* NCPOS( STRING, CHAR, 16 ) = 16 */ -/* NCPOS( STRING, CHAR, 17 ) = 20 */ -/* NCPOS( STRING, CHAR, 21 ) = 27 */ -/* NCPOS( STRING, CHAR, 28 ) = 28 */ -/* NCPOS( STRING, CHAR, 29 ) = 29 */ -/* NCPOS( STRING, CHAR, 30 ) = 30 */ -/* NCPOS( STRING, CHAR, 31 ) = 0 */ - -/* START out of bounds: */ -/* -------------------- */ - -/* NCPOS( STRING, CHAR, -12 ) = 4 */ -/* NCPOS( STRING, CHAR, 0 ) = 4 */ -/* NCPOS( STRING, CHAR, 31 ) = 0 */ -/* NCPOS( STRING, CHAR, 123 ) = 0 */ - -/* Order within CHARS: */ -/* ------------------- */ - -/* NCPOS( STRING, 'JOHN', 7 ) = 10 */ -/* NCPOS( STRING, 'OHJN', 7 ) = 10 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */ - -/* The Required Reading file POSITION was renamed to SCANNING. */ -/* This header was updated to reflect the change. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* forward search for position of unlisted character */ - -/* -& */ - -/* Local variables */ - - lenstr = i_len(str, str_len); - b = max(1,*start); - found = FALSE_; - ret_val = 0; - while(! found) { - if (b > lenstr) { - return ret_val; - } else if (i_indx(chars, str + (b - 1), chars_len, (ftnlen)1) == 0) { - ret_val = b; - return ret_val; - } else { - ++b; - } - } - return ret_val; -} /* ncpos_ */ - diff --git a/ext/spice/src/cspice/ncpos_c.c b/ext/spice/src/cspice/ncpos_c.c deleted file mode 100644 index 9af50cd446..0000000000 --- a/ext/spice/src/cspice/ncpos_c.c +++ /dev/null @@ -1,229 +0,0 @@ -/* - --Procedure ncpos_c ( NOT Character position ) - --Abstract - - Find the first occurrence in a string of a character NOT belonging - to a collection of characters, starting at a specified location, - searching forward. - --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 - - SCANNING - --Keywords - - CHARACTER - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - SpiceInt ncpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I Any character string. - chars I A collection of characters. - start I Position to begin looking for one not in chars. - - The function returns the index of the first character of str - at or following index start that is not in the collection chars. - --Detailed_Input - - str is any character string. - - chars is a character string containing a collection of - characters. Spaces in chars are significant, including - trailing blanks. The order in which characters are - listed is not significant. - - start is the position in str to begin looking for characters - not in chars. start may range from 0 to n-1, where n is - the number of characters in str. - --Detailed_Output - - The function returns the index of the first character of str (at or - following index start) that is not one of the characters in the - string chars. The returned value normally ranges from 0 to n-1, - where n is the number of characters in str. If no such character is - found, the function returns -1. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either of - the input string pointers is null. - - 2) If start is less than 0, the search begins at the first - character of the string. - - 3) If start is greater than or equal to the length of the string, - ncpos_c returns -1. - - 4) The function returns -1 if either of the input strings is empty. - --Files - - None. - --Particulars - - ncpos_c is case sensitive. - - An entire family of related CSPICE routines - - cpos_c - cposr_c - ncpos_c - ncposr_c - pos_c - posr_c - - is described in the Required Reading. - --Examples - - Let string == "BOB, JOHN, TED, AND MARTIN " - 012345678901234567890123456789 - - Let chars == "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - - - Normal (Sequential) Searching: - ------------------------------ - - ncpos_c( string, chars, 0 ) == 3 - ncpos_c( string, chars, 4 ) == 4 - ncpos_c( string, chars, 5 ) == 9 - ncpos_c( string, chars, 10 ) == 10 - ncpos_c( string, chars, 11 ) == 14 - ncpos_c( string, chars, 15 ) == 15 - ncpos_c( string, chars, 16 ) == 19 - ncpos_c( string, chars, 20 ) == 26 - ncpos_c( string, chars, 27 ) == 27 - ncpos_c( string, chars, 28 ) == 28 - ncpos_c( string, chars, 29 ) == 29 - - start out of bounds: - -------------------- - - ncpos_c( string, chars, -12 ) == 3 - ncpos_c( string, chars, -1 ) == 3 - ncpos_c( string, chars, 30 ) == -1 - ncpos_c( string, chars, 122 ) == -1 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (WLT) - --Index_Entries - - forward search for position of unlisted character - --& -*/ - -{ /* Begin ncpos_c */ - - /* - Local variables - */ - SpiceInt fstart; - SpiceInt retval; - - - /* - Use discovery check-in. - - Check for null pointers. - */ - CHKPTR_VAL ( CHK_DISCOVER, "ncpos_c", str, -1 ); - CHKPTR_VAL ( CHK_DISCOVER, "ncpos_c", chars, -1 ); - - - /* - Check for empty strings. - */ - if ( ( strlen(str) == 0 ) || ( strlen(chars) == 0 ) ) - { - return ( -1 ); - } - - - /* - The rest can be handled by the f2c'd SPICELIB routine. Adjust - the start index to account for Fortran indexing. - */ - - fstart = start + 1; - - retval = ncpos_ ( (char *) str, - (char *) chars, - (integer *) &fstart, - (ftnlen ) strlen(str), - (ftnlen ) strlen(chars) ); - - /* - Adjust the return value to account for C indexing. - */ - return ( retval-1 ); - - -} /* End ncpos_c */ diff --git a/ext/spice/src/cspice/ncposr.c b/ext/spice/src/cspice/ncposr.c deleted file mode 100644 index f8687d41be..0000000000 --- a/ext/spice/src/cspice/ncposr.c +++ /dev/null @@ -1,216 +0,0 @@ -/* ncposr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NCPOSR (NOT character position, reverse) */ -integer ncposr_(char *str, char *chars, integer *start, ftnlen str_len, - ftnlen chars_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b; - logical found; - integer lenstr; - -/* $ Abstract */ - -/* Find the first occurrence in a string of a character NOT */ -/* belonging to a collection of characters, starting at a */ -/* specified location, searching in reverse. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* CHARACTER */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I Any character string. */ -/* CHARS I A collection of characters. */ -/* START I Position to begin looking for one not in CHARS */ - -/* The function returns the index of the last character of STR */ -/* at or before index START that is not in the collection CHARS. */ - -/* $ Detailed_Input */ - -/* STR is any character string. */ - -/* CHARS is a character string containing a collection of */ -/* characters. Spaces in CHARS are significant. */ - -/* START is the position in STR to begin looking for */ -/* characters not in CHARS. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the last character of STR (at */ -/* or before index START) that is not one of the characters in the */ -/* string CHARS. No such character is found, the fucntion returns */ -/* zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If START is less than 1, NCPOSR returns zero. */ - -/* 2) If START is greater than LEN(STRING), the search begins */ -/* at the last character of the string. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCPOSR is case sensitive. */ - -/* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */ -/* POSR, CPOSR, NCPOSR) is described in the Required Reading. */ - -/* Those familiar with the True BASIC language should note that */ -/* these functions are equivalent to the True BASIC intrinsic */ -/* functions with the same names. */ - -/* $ Examples */ - -/* Let STRING = 'BOB, JOHN, TED, AND MARTIN ' */ -/* 123456789012345678901234567890 */ - -/* Let CHAR = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' */ - -/* Normal (Sequential) Searching: */ -/* ------------------------------ */ - -/* NCPOSR( STRING, CHAR, 31 ) = 30 */ -/* NCPOSR( STRING, CHAR, 29 ) = 29 */ -/* NCPOSR( STRING, CHAR, 28 ) = 28 */ -/* NCPOSR( STRING, CHAR, 27 ) = 27 */ -/* NCPOSR( STRING, CHAR, 26 ) = 20 */ -/* NCPOSR( STRING, CHAR, 19 ) = 16 */ -/* NCPOSR( STRING, CHAR, 15 ) = 15 */ -/* NCPOSR( STRING, CHAR, 14 ) = 11 */ -/* NCPOSR( STRING, CHAR, 10 ) = 10 */ -/* NCPOSR( STRING, CHAR, 9 ) = 5 */ -/* NCPOSR( STRING, CHAR, 4 ) = 4 */ -/* NCPOSR( STRING, CHAR, 3 ) = 0 */ - -/* START out of bounds: */ -/* -------------------- */ - -/* NCPOSR( STRING, CHAR, 0 ) = 0 */ -/* NCPOSR( STRING, CHAR, -4 ) = 0 */ -/* NCPOSR( STRING, CHAR, 31 ) = 30 */ -/* NCPOSR( STRING, CHAR, 123 ) = 30 */ - -/* Order within CHARS: */ -/* ------------------- */ - -/* NCPOSR( STRING, 'JOHN', 7 ) = 5 */ -/* NCPOSR( STRING, 'OHJN', 7 ) = 5 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */ - -/* The Required Reading file POSITION was renamed to SCANNING. */ -/* This header was updated to reflect the change. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* backward search for position of unlisted character */ - -/* -& */ - -/* Local variables */ - - lenstr = i_len(str, str_len); - b = min(lenstr,*start); - found = FALSE_; - ret_val = 0; - while(! found) { - if (b <= 0) { - return ret_val; - } else if (i_indx(chars, str + (b - 1), chars_len, (ftnlen)1) == 0) { - ret_val = b; - return ret_val; - } else { - --b; - } - } - return ret_val; -} /* ncposr_ */ - diff --git a/ext/spice/src/cspice/ncposr_c.c b/ext/spice/src/cspice/ncposr_c.c deleted file mode 100644 index 5fb38b3c81..0000000000 --- a/ext/spice/src/cspice/ncposr_c.c +++ /dev/null @@ -1,231 +0,0 @@ -/* - --Procedure ncposr_c ( Character position, reverse ) - --Abstract - - Find the first occurrence in a string of a character NOT belonging - to a collection of characters, starting at a specified location, - searching in reverse. - --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 - - SCANNING - --Keywords - - CHARACTER - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - SpiceInt ncposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I Any character string. - chars I A collection of characters. - start I Position to begin looking for one of chars. - - The function returns the index of the last character of str - at or before index start that is not in the collection chars. - --Detailed_Input - - str is any character string. - - chars is a character string containing a collection - of characters. Spaces in chars are significant, - including trailing blanks. The order in which - characters are listed is not significant. - - start is the position in str to begin looking for one of - the characters in chars. start may range from 0 - to n-1, where n is the number of characters in str. - --Detailed_Output - - The function returns the index of the last character of str (at or - before index start) that is not one of the characters in the string - chars. The returned value normally ranges from 0 to n-1, where n is - the number of characters in str. If none of the characters is found, - the function returns -1. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either of - the input string pointers is null. - - 2) If start is less than 0, ncposr_c returns -1. - - 3) If start is greater than or equal to the length of the string, - the search begins at the last character of the string. - - 4) The function returns -1 if either of the input strings is empty. - --Files - - None. - --Particulars - - ncposr_c is case sensitive. - - An entire family of related CSPICE routines - - cpos_c - cposr_c - ncpos_c - ncposr_c - pos_c - posr_c - - is described in the Required Reading. - --Examples - - Let string == "BOB, JOHN, TED, AND MARTIN...." - 012345678901234567890123456789 - - Let chars == "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - - Normal (sequential) searching: - ------------------------------ - - ncposr_c( string, ' ,', 29 ) = 29 - ncposr_c( string, ' ,', 28 ) = 28 - ncposr_c( string, ' ,', 27 ) = 27 - ncposr_c( string, ' ,', 26 ) = 26 - ncposr_c( string, ' ,', 25 ) = 19 - ncposr_c( string, ' ,', 18 ) = 15 - ncposr_c( string, ' ,', 14 ) = 14 - ncposr_c( string, ' ,', 13 ) = 10 - ncposr_c( string, ' ,', 9 ) = 9 - ncposr_c( string, ' ,', 8 ) = 4 - ncposr_c( string, ' ,', 3 ) = 3 - ncposr_c( string, ' ,', 2 ) = -1 - - - start out of bounds: - -------------------- - - ncposr_c( string, ' ,', -1 ) = -1 - ncposr_c( string, ' ,', -5 ) = -1 - ncposr_c( string, ' ,', 30 ) = 29 - ncposr_c( string, ' ,', 122 ) = 29 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 27-AUG-2002 (NJB) (WLT) - --Index_Entries - - backward search for position of unlisted character - --& -*/ - -{ /* Begin ncposr_c */ - - /* - Local variables - */ - SpiceInt fstart; - SpiceInt retval; - - - - /* - Use discovery check-in. - - Check for null pointers. - */ - CHKPTR_VAL ( CHK_DISCOVER, "ncposr_c", str, -1 ); - CHKPTR_VAL ( CHK_DISCOVER, "ncposr_c", chars, -1 ); - - - /* - Check for empty strings. - */ - if ( ( strlen(str) == 0 ) || ( strlen(chars) == 0 ) ) - { - return ( -1 ); - } - - - /* - The rest can be handled by the f2c'd SPICELIB routine. Adjust - the start index to account for Fortran indexing. - */ - - fstart = start + 1; - - retval = ncposr_ ( (char *) str, - (char *) chars, - (integer *) &fstart, - (ftnlen ) strlen(str), - (ftnlen ) strlen(chars) ); - - /* - Adjust the return value to account for C indexing. - */ - return ( retval-1 ); - - -} /* End ncposr_c */ diff --git a/ext/spice/src/cspice/nearpt.c b/ext/spice/src/cspice/nearpt.c deleted file mode 100644 index a23290f4fc..0000000000 --- a/ext/spice/src/cspice/nearpt.c +++ /dev/null @@ -1,1794 +0,0 @@ -/* nearpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static doublereal c_b36 = 2.; -static integer c__2048 = 2048; -static doublereal c_b108 = 1e-16; - -/* $Procedure NEARPT ( Nearest point on an ellipsoid ) */ -/* Subroutine */ int nearpt_(doublereal *positn, doublereal *a, doublereal *b, - doublereal *c__, doublereal *npoint, doublereal *alt) -{ - /* Initialized data */ - - static char mssg[80*7] = "Axis A was nonpositive. ? " - " " "Axis B was nonpositive. ? " - " " "Axes A a" - "nd B were nonpositive. ? " - " " "Axis C was nonpositive. ? " - " " "Axes A and C were nonpositive. ? " - " " "Axes B and C we" - "re nonpositive. ? " - "All three axes were nonpositive. ? " - " "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6; - doublereal d__1, d__2, d__3, d__4, d__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double sqrt(doublereal), pow_dd(doublereal *, doublereal *); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal sign, axis[3], temp, term[3], errp[3], copy[3]; - logical trim; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - integer i__; - doublereal q, scale; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - extern doublereal dpmax_(void); - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - logical extra; - doublereal lower; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal point[3], pnorm, upper; - extern /* Subroutine */ int vperp_(doublereal *, doublereal *, doublereal - *); - extern doublereal vnorm_(doublereal *); - doublereal denom2, denom3, lambda, tlambd[3], height; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - logical inside; - doublereal factor; - extern /* Subroutine */ int orderd_(doublereal *, integer *, integer *), - reordd_(integer *, integer *, doublereal *); - doublereal toobig; - integer iorder[3]; - extern doublereal touchd_(doublereal *); - doublereal olderr, normal[3], bestht, orignl[3], prodct; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - doublereal epoint[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen), vsclip_(doublereal *, - doublereal *); - doublereal bestpt[3], newerr; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - doublereal axisqr[3]; - extern logical approx_(doublereal *, doublereal *, doublereal *); - doublereal qlower; - integer snglpt; - doublereal qupper, spoint[3]; - extern logical return_(void); - logical solvng; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), surfnm_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - integer solutn, bad; - doublereal err[3]; - integer itr; - -/* $ Abstract */ - -/* This routine locates the point on the surface of an ellipsoid */ -/* that is nearest to a specified position. It also returns the */ -/* altitude of the position above the ellipsoid. */ - -/* $ 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 */ - -/* ALTITUDE */ -/* ELLIPSOID */ -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* POSITN I Position of a point in body-fixed frame. */ -/* A I Length of semi-axis parallel to x-axis. */ -/* B I Length of semi-axis parallel to y-axis. */ -/* C I Length on semi-axis parallel to z-axis. */ -/* NPOINT O Point on the ellipsoid closest to POSITN. */ -/* ALT O Altitude of POSITN above the ellipsoid. */ - -/* $ Detailed_Input */ - -/* POSITN 3-vector giving the position of a point with respect */ -/* to the center of an ellipsoid. The vector is expressed */ -/* in a body-fixed reference frame. The semi-axes of the */ -/* ellipsoid are aligned with the x, y, and z-axes of the */ -/* body-fixed frame. */ - -/* A Length of the semi-axis of the ellipsoid that is */ -/* parallel to the x-axis of the body-fixed reference */ -/* frame. */ - -/* B Length of the semi-axis of the ellipsoid that is */ -/* parallel to the y-axis of the body-fixed reference */ -/* frame. */ - -/* C Length of the semi-axis of the ellipsoid that is */ -/* parallel to the z-axis of the body-fixed reference */ -/* frame. */ - -/* $ Detailed_Output */ - -/* NPOINT is the nearest point on the ellipsoid to POSITN. */ -/* NPOINT is a 3-vector expressed in the body-fixed */ -/* reference frame. */ - -/* ALT is the altitude of POSITN above the ellipsoid. If */ -/* POSITN is inside the ellipsoid, ALT will be negative */ -/* and have magnitude equal to the distance between */ -/* NPOINT and POSITN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any of the axis lengths A, B or C are non-positive, the */ -/* error SPICE(BADAXISLENGTH) will be signaled. */ - -/* 2) If the ratio of the longest to the shortest ellipsoid axis */ -/* is large enough so that arithmetic expressions involving its */ -/* squared value may overflow, the error SPICE(BADAXISLENGTH) */ -/* will be signaled. */ - -/* 3) If any of the expressions */ - -/* A * ABS( POSITN(1) ) / m**2 */ -/* B * ABS( POSITN(2) ) / m**2 */ -/* C * ABS( POSITN(3) ) / m**2 */ - -/* where m is the minimum of { A, B, C }, is large enough so */ -/* that arithmetic expressions involving these sub-expressions */ -/* may overflow, the error SPICE(INPUTSTOOLARGE) is signaled. */ - -/* 4) If the axes of the ellipsoid have radically different */ -/* magnitudes, for example if the ratios of the axis lengths vary */ -/* by 10 orders of magnitude, the results may have poor */ -/* precision. No error checks are done to identify this problem. */ - -/* 5) If the axes of the ellipsoid and the input point POSITN have */ -/* radically different magnitudes, for example if the ratio of */ -/* the magnitude of POSITN to the length of the shortest axis is */ -/* 1.E25, the results may have poor precision. No error checks */ -/* are done to identify this problem. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Many applications of this routine are more easily performed */ -/* using the higher-level SPICELIB routine SUBPNT. This routine */ -/* is the mathematical workhorse on which SUBPNT relies. */ - -/* $ Examples */ - -/* Example 1. */ - -/* The code fragment below illustrates how you can use SPICELIB to */ -/* compute the apparent sub-earth point on the moon. */ - -/* C */ -/* C Load the ephemeris, leapseconds and physical constants */ -/* C files first. We assume the names of these files are */ -/* C stored in the character variables SPK, LSK and */ -/* C PCK. */ -/* C */ -/* CALL FURNSH ( SPK ) */ -/* CALL FURNSH ( LSK ) */ -/* CALL FURNSH ( PCK ) */ - -/* C */ -/* C Get the apparent position of the moon as seen from the */ -/* C earth. Look up this position vector in the moon */ -/* C body-fixed frame IAU_MOON. The orientation of the */ -/* C IAU_MOON frame will be computed at epoch ET-LT. */ -/* C */ -/* CALL SPKPOS ( 'moon', ET, 'IAU_MOON', 'LT+S', */ -/* . 'earth', TRGPOS, LT ) */ - -/* C */ -/* C Negate the moon's apparent position to obtain the */ -/* C position of the earth in the moon's body-fixed frame. */ -/* C */ -/* CALL VMINUS ( TRGPOS, EVEC ) */ - -/* C */ -/* C Get the lengths of the principal axes of the moon. */ -/* C Transfer the elements of the array RADII to the */ -/* C variables A, B, C to enhance readability. */ -/* C */ -/* CALL BODVRD ( 'MOON', 'RADII', DIM, RADII ) */ -/* CALL VUPACK ( RADII, A, B, C ) */ - -/* C */ -/* C Finally get the point SUBPNT on the surface of the */ -/* C moon closest to the earth --- the sub-earth point. */ -/* C SUBPNT is expressed in the IAU_MOON reference frame. */ -/* C */ -/* CALL NEARPT ( EVEC, A, B, C, SUBPNT, ALT ) */ - - -/* Example 2. */ - -/* One can use this routine to define a generalization of GEODETIC */ -/* coordinates called GAUSSIAN coordinates of a triaxial body. (The */ -/* name is derived from the famous Gauss-map of classical */ -/* differential geometry). The coordinates are longitude, */ -/* latitude, and altitude. */ - -/* We let the x-axis of the body fixed coordinate system point */ -/* along the longest axis of the triaxial body. The y-axis points */ -/* along the middle axis and the z-axis points along the shortest */ -/* axis. */ - -/* Given a point P, there is a point on the ellipsoid that is */ -/* closest to P, call it Q. The latitude and longitude of P */ -/* are determined by constructing the outward pointing unit normal */ -/* to the ellipsoid at Q. Latitude of P is the latitude that the */ -/* normal points toward in the body-fixed frame. Longitude is */ -/* the longitude the normal points to in the body-fixed frame. */ -/* The altitude is the signed distance from P to Q, positive if P */ -/* is outside the ellipsoid, negative if P is inside. */ -/* (the mapping of the point Q to the unit normal at Q is the */ -/* Gauss-map of Q). */ - -/* To obtain the Gaussian coordinates of a point whose position */ -/* in body-fixed rectangular coordinates is given by a vector P, */ -/* the code fragment below will suffice. */ - -/* CALL NEARPT ( P, A, B, C, Q, ALT ) */ -/* CALL SURFNM ( A, B, C Q, NRML ) */ - -/* CALL RECLAT ( NRML, R, LONG, LAT ) */ - -/* The Gaussian coordinates are LONG, LAT, and ALT. */ - - -/* $ Restrictions */ - -/* See the Exceptions header section above. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.1, 07-FEB-2008 (NJB) */ - -/* Header update: header now refers to SUBPNT rather */ -/* than deprecated routine SUBPT. */ - -/* - SPICELIB Version 1.3.0, 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable SNGLPT to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. */ - -/* - SPICELIB Version 1.2.0, 15-NOV-2005 (EDW) (NJB) */ - -/* Various changes were made to ensure that all loops terminate. */ - -/* Bug fix: scale of transverse component of error vector */ -/* was corrected for the exterior point case. */ - -/* Bug fix: non-standard use of duplicate arguments in VSCL */ -/* calls was corrected. */ - -/* Error checking was added to screen out inputs that might */ -/* cause numeric overflow. */ - -/* Replaced BODVAR call in examples to BODVRD. */ - -/* - SPICELIB Version 1.1.1, 28-JUL-2003 (NJB) (CHA) */ - -/* Various header corrections were made. */ - -/* - SPICELIB Version 1.1.0, 27-NOV-1990 (WLT) */ - -/* The routine was substantially rewritten to achieve */ -/* more robust behavior and document the mathematics */ -/* of the routine. */ - -/* - 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 */ - -/* distance from point to ellipsoid */ -/* nearest point on an ellipsoid */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable SNGLPT to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. The */ -/* statement referencing the uninitialized variable */ -/* was: */ - -/* IF ( INSIDE .AND. ( SNGLPT .EQ. 2 */ -/* . .OR. SNGLPT .EQ. 3 ) ) THEN */ - -/* SNGLPT is uninitialized only if INSIDE is .FALSE., */ -/* so the value of the logical expression is not affected by */ -/* the uninitialized value of SNGLPT. */ - -/* However, the Intel Fortran compiler for the Mac flags a runtime */ -/* error when the above code is exercised. So SNGLPT is now */ -/* initialized prior to the above IF statement. */ - - -/* - SPICELIB Version 1.2.0, 15-NOV-2005 (EDW) (NJB) */ - -/* Bug fix: scale of transverse component of error vector */ -/* was corrected for the exterior point case. */ -/* Replaced BODVAR call in examples to BODVRD. */ - -/* Bug fix: non-standard use of duplicate arguments in VSCL */ -/* calls was corrected. */ - -/* Various changes were made to ensure that all loops terminate. */ - -/* Error checking was added to screen out inputs that might */ -/* cause numeric overflow. */ - -/* Removed secant solution branch from root-finding loop. */ -/* Although the secant solution sped up some root searches, */ -/* it caused large numbers of unnecessary iterations in others. */ - -/* Changed the expression: */ - -/* IF ( LAMBDA .EQ. LOWER */ -/* . .OR. LAMBDA .EQ. UPPER ) THEN */ - -/* to */ - -/* IF ( APPROX( LAMBDA, LOWER, CNVTOL ) */ -/* . .OR. APPROX( LAMBDA, UPPER, CNVTOL ) ) THEN */ - -/* Use of APPROX eliminates the possibility of an infinite loop */ -/* when LAMBDA approaches to within epsilon of, but does not */ -/* equate to UPPER or LOWER. Infinite loops occurred under some */ -/* compiler's optimizations. */ - -/* The loop also includes a check on number of iterations, */ -/* signaling an error if the bisection loop uses more than */ -/* MAXITR passes. */ - -/* TOUCHD is now used to defeat extended-register usage in */ -/* cases where such usage may cause logic problems. */ - -/* Some minor code changes were made to ensure that various */ -/* variables remain in their expected ranges. */ - -/* A few code changes were made to enhance clarity. */ - - -/* - SPICELIB Version 1.1.0, 27-NOV-1990 */ - -/* The routine was nearly rewritten so that points */ -/* near the coordinate planes in the interior of the ellipsoid */ -/* could be handled without fear of floating point overflow */ -/* or divide by zero. */ - -/* While the mathematical ideas involved in the original routine */ -/* are retained, the code is for the most part new. In addition, */ -/* the new code has been documented far more extensively than was */ -/* NEARPT 1.0.0. */ - - -/* - Beta Version 2.0.0, 9-JAN-1989 (WLT) */ - -/* Error handling added has been added for bad axes values. */ - -/* The algorithm did not work correctly for some points inside */ -/* the ellipsoid lying on the plane orthogonal to the shortest */ -/* axis of the ellipsoid. The problem was corrected. */ - -/* Finally the algorithm was made slightly more robust and clearer */ -/* by use of SPICELIB routines and by normalizing the inputs. */ - -/* Add an example to the header section. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - - -/* The convergence tolerance CNVTOL is used to terminate the */ -/* bisection loop when the solution interval is very small but */ -/* hasn't converged to length zero. This situation can occur when */ -/* the root is extremely close to zero. */ - - -/* Various potentially large numbers we'll compute must not */ -/* exceed DPMAX()/MARGIN: */ - - -/* The parameter MAXSOL determines the maximum number of */ -/* iterations that will be performed in locating the */ -/* near point. This must be at least 3. To get strong */ -/* robustness in the routine, MAXSOL should be at least 4. */ - - -/* MAXITR defines the maximum number of iterations allowed in */ -/* the bisection loop used to find LAMBDA. If this loop requires */ -/* more than MAXITR iterations to achieve convergence, NEARPT */ -/* will signal an error. */ - -/* On a PC/Linux/g77 platform, it has been observed that each */ -/* bisection loop normally completes in fewer than 70 iterations. */ -/* MAXITR is used as a "backstop" to prevent infinite looping in */ -/* case the normal loop termination conditions don't take effect. */ -/* The value selected is based on the range of exponents for IEEE */ -/* double precision floating point numbers. */ - - -/* Length of lines in message buffer. */ - - -/* Local Variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Here's what you can expect to find in the routine below. */ - -/* Chapter 1. Error and Exception Handling. */ - -/* Chapter 2. Mathematical background for the solution---the */ -/* lambda equation. */ - -/* Chapter 3. Initializations for the main processing loop. */ - -/* Chapter 4. Mathematical Solution of the lambda equation. */ - -/* Section 4.1 Avoiding numerical difficulties. */ -/* Section 4.2 Bracketing the root of the lambda */ -/* equation. */ -/* Section 4.3 Refining the estimate of lambda. */ -/* Section 4.4 Handling points on the central plane. */ - -/* Chapter 5. Decisions and initializations for sharpening */ -/* the solution. */ - -/* Chapter 6. Clean up. */ - - -/* Error and Exception Handling. */ -/* ================================================================ */ -/* ---------------------------------------------------------------- */ - - if (return_()) { - return 0; - } else { - chkin_("NEARPT", (ftnlen)6); - } - -/* Check the axes to make sure that none of them is less than or */ -/* equal to zero. If one is, signal an error and return. */ - - bad = 0; - if (*a <= 0.) { - ++bad; - } - if (*b <= 0.) { - bad += 2; - } - if (*c__ <= 0.) { - bad += 4; - } - if (bad > 0) { - setmsg_(mssg + ((i__1 = bad - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "mssg", i__1, "nearpt_", (ftnlen)581)) * 80, (ftnlen)80); - errch_("?", "The A,B, and C axes were #, #, and # respectively.", ( - ftnlen)1, (ftnlen)50); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(BADAXISLENGTH)", (ftnlen)20); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - -/* Mathematical background for the solution---the lambda equation. */ -/* ================================================================ */ -/* ---------------------------------------------------------------- */ - - -/* Here is the background and general outline of how this problem is */ -/* going to be solved. */ - -/* We want to find, a point on the ellipsoid */ - - -/* X**2 Y**2 Z**2 */ -/* ------ + ------ + ------ = 1 */ -/* A**2 B**2 C**2 */ - -/* that is closest to the input point POSITN. */ - -/* If one cares about the gory details, we know that */ -/* such a point must exist because the */ -/* ellipsoid is a compact subset of Euclidean 3-space */ -/* and the distance function between the input point */ -/* and the ellipsoid is a continuous functions. */ -/* Since continuous functions on compact sets */ -/* actually achieve their minimums at some point of */ -/* the compact set, we are guaranteed that a closest */ -/* point exists. */ - -/* If we let NPOINT be a closest point to POSITN, then the */ -/* line segment joining POSITN to NPOINT is parallel to */ -/* the normal to the ellipsoid at NPOINT. Moreover, */ -/* suppose we let SEGMENT(P) be the line segment that */ -/* connects an arbitrary point P with POSITN. It can */ -/* be shown that there is only one point P on the */ -/* ellipsoid in the same octant at POSITN such that the */ -/* normal at P is parallel to SEGMENT(P) */ - - -/* More gory details: A normal to a point (X,Y,Z) */ -/* on the ellipsoid is given by */ - -/* (X/A**2, Y/B**2, Z/C**2) */ - -/* Given a fixed LAMBDA, and allowing (X,Y,Z) to */ -/* range over all points on the ellipsoid, the set */ -/* of points */ - - -/* LAMBDA*X LAMBDA*Y LAMBDA*Z */ -/* ( X + --------, Y + --------, Z + -------- ) */ -/* A**2 B**2 C**2 */ - -/* describes another ellipsoid with axes having lengths */ - -/* LAMBDA LAMBDA LAMBDA */ -/* A + ------ , B + ------ , C + ------ . */ -/* A B C */ - - -/* Moreover, as long as LAMBDA > - MIN( A**2, B**2, C**2 ) */ -/* none of these ellipsoids intersect. Thus, as long as */ -/* the normal lines are not allowed to cross the coordinate plane */ -/* orthogonal to the smallest axis (called the central plane) */ -/* they do not intersect. */ - - -/* Finally every point that does not lie on the central plane */ -/* lies on one of the "lambda" ellipsoids described above. */ - -/* Consequently, for each point, P, not on the central plane */ -/* there is a unique point, NPOINT, on the ellipsoid, such that */ -/* the normal line at NPOINT also contains P and does not cross */ -/* the central plane. */ - - -/* From the above discussion we see that we can mathematically */ -/* solve the near point problem by finding a point NPOINT */ -/* on the ellipsoid given by the equation: */ - -/* X**2 Y**2 Z**2 */ -/* ------ + ------ + ------ = 1 */ -/* A**2 B**2 C**2 */ - - -/* such that for some value of LAMBDA */ - -/* POSITN = NPOINT + LAMBDA*NORMAL(NPOINT). */ - -/* Moreover, if POSITN = (X_o,Y_o,Z_o) then LAMBDA must satisfy */ -/* the equation: */ - -/* 2 2 2 */ -/* X_o Y_o Z_o */ -/* ----------------- + ------------------ + ------------------ = 1 */ -/* 2 2 2 */ -/* ( A + LAMBDA/A ) ( B + LAMBDA/B ) ( C + LAMBDA/C ) */ - - -/* and LAMBDA must be greater than -MIN(A**2,B**2,C**2) */ - - -/* Once LAMBDA is known, NPOINT can be computed from the equation: */ - -/* POSITN = NPOINT + LAMBDA*NORMAL(NPOINT). */ - - -/* The process of solving for LAMBDA can be viewed as selecting */ -/* that ellipsoid */ - -/* 2 2 2 */ -/* x y z */ -/* --------------- + ---------------- + --------------- = 1 */ -/* 2 2 2 */ -/* (a + lambda/a) ( b + lambda/b) (c + lambda/c) */ - -/* that contains the input point POSITN. For lambda = 0, this */ -/* ellipsoid is just the input ellipsoid. When we increase */ -/* lambda we get a larger "inflated" ellipsoid. When we */ -/* decrease lambda we get a smaller "deflated" ellipsoid. Thus, */ -/* the search for lambda can be viewed as inflating or deflating */ -/* the input ellipsoid (in a specially prescribed manner) until */ -/* the resulting ellipsoid contains the input point POSITN. */ - -/* The mathematical solution laid out above, has some numeric */ -/* flaws. However, it is robust enough so that if it is applied */ -/* repeatedly, we can converge to a good solution of the near point */ -/* problem. */ - -/* In the code that follows, we will first solve the lambda equation */ -/* using the original input point. However, for points near the */ -/* central plane the solution we obtain may not lie on the */ -/* ellipsoid. But, it should lie along the correct normal line. */ - -/* Using this first candidate solution, we find the closest point */ -/* to it on the ellipsoid. This second iteration always produces */ -/* a point that is as close as you can get to the ellipsoid. */ -/* However, the normal at this second solution may not come as close */ -/* as desired to pointing toward the input position. To overcome */ -/* this deficiency we sharpen the second solution. */ - -/* To sharpen a solution we use the computed near point, the computed */ -/* altitude of POSITN and the normal at the near point to approximate */ -/* POSITN. The difference between the approximated position of */ -/* POSITN and the input value of POSITN is called the error vector. */ -/* To get a sharpened solution we translate the computed near point */ -/* by the component of the error vector orthogonal to the normal */ -/* and then find the mathematical near point to our translated */ -/* solution. */ - -/* The sharpening process is repeated until it no longer produces */ -/* an "improved" near point. */ - -/* At each step of this procedure, we must compute a solution to */ -/* the "lambda" equation in order to produce our next estimate of */ -/* the near point. If it were possible to create a "private" */ -/* routine in FORTRAN that only this routine could access, we */ -/* would do it. However, things being what they are, we have to */ -/* compute the lambda solution in a loop. We keep track of which */ -/* refinement we are working on by counting the number of */ -/* lambda solutions that are computed. */ - - -/* Initializations for the main processing loop */ -/* ================================================================ */ -/* ---------------------------------------------------------------- */ - - -/* Let the game begin! */ - -/* First order the axes of the ellipsoid and corresponding */ -/* component of POSITN by the size of lengths of axes. Knowing */ -/* which axes are smallest will simplify our task of computing */ -/* lambda when the time comes. */ - - axis[0] = *a; - axis[1] = *b; - axis[2] = *c__; - vequ_(positn, point); - orderd_(axis, &c__3, iorder); - reordd_(iorder, &c__3, axis); - reordd_(iorder, &c__3, point); - -/* Rescale everything so as to avoid underflows when squaring */ -/* quantities and copy the original starting point. */ - -/* Be sure that this is UNDONE at the end of the routine. */ - - scale = 1. / axis[0]; - vsclip_(&scale, axis); - vsclip_(&scale, point); - vequ_(point, orignl); - -/* Save the norm of the scaled input point. */ - - pnorm = vnorm_(point); - -/* The scaled axis lengths must be small enough so they can */ -/* be squared. */ - - toobig = sqrt(dpmax_() / 100.); - -/* Note the first axis has length 1.D0, so we don't check it. */ - - for (i__ = 2; i__ <= 3; ++i__) { - if (axis[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("axis", - i__1, "nearpt_", (ftnlen)809)] > toobig) { - setmsg_("Ratio of length of axis #* to length of axis #* is *; t" - "his value may cause numeric overflow.", (ftnlen)92); - errint_("*", &iorder[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("iorder", i__1, "nearpt_", (ftnlen)814)], (ftnlen) - 1); - errint_("*", iorder, (ftnlen)1); - errdp_("*", &axis[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("axis", i__1, "nearpt_", (ftnlen)816)], (ftnlen)1); - sigerr_("SPICE(BADAXISLENGTH)", (ftnlen)20); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - } - -/* We also must limit the size of the products */ - -/* AXIS(I)*POINT(I), I = 1, 3 */ - -/* We can safely check these by comparing the products of */ -/* the square roots of the factors to TOOBIG. */ - - for (i__ = 1; i__ <= 3; ++i__) { - prodct = sqrt(axis[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "axis", i__1, "nearpt_", (ftnlen)835)]) * sqrt((d__1 = point[( - i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("point", - i__2, "nearpt_", (ftnlen)835)], abs(d__1))); - if (prodct > toobig) { - setmsg_("Product of length of scaled axis #* and size of corresp" - "onding scaled component of POSITN is > *; these values m" - "ay cause numeric overflow.", (ftnlen)137); - errint_("*", &iorder[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("iorder", i__1, "nearpt_", (ftnlen)843)], (ftnlen) - 1); - d__1 = pow_dd(&toobig, &c_b36); - errdp_("*", &d__1, (ftnlen)1); - sigerr_("SPICE(INPUTSTOOLARGE)", (ftnlen)21); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - } - -/* Compute the squared lengths of the scaled axes. */ - - axisqr[0] = axis[0] * axis[0]; - axisqr[1] = axis[1] * axis[1]; - axisqr[2] = axis[2] * axis[2]; - -/* We will need to "solve" for the NEARPT at least 3 times. */ -/* SOLUTN is the counter that keeps track of how many times */ -/* we have actually solved for a near point. SOLVNG indicates */ -/* whether we should continue solving for NEARPT. */ - - snglpt = 4; - solutn = 1; - solvng = TRUE_; - while(solvng) { - -/* Mathematical solution of the lambda equation. */ -/* ================================================================ */ -/* ---------------------------------------------------------------- */ - - -/* Make a stab at solving the mathematical problem of finding the */ -/* near point. In other words, solve the lambda equation. */ - - -/* Avoiding Numerical difficulties */ -/* ------------------------------- */ - -/* First make a copy of POINT, then to avoid numerical */ -/* difficulties later on, we will assume that any component of */ -/* POINT that is not sufficiently different from zero to */ -/* contribute to an addition to the corresponding component */ -/* of AXIS, is in fact zero. */ - - vequ_(point, copy); - for (i__ = 1; i__ <= 3; ++i__) { - if (point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("poi" - "nt", i__1, "nearpt_", (ftnlen)894)] * .5 + axis[(i__2 = - i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("axis", i__2, - "nearpt_", (ftnlen)894)] == axis[(i__3 = i__ - 1) < 3 && - 0 <= i__3 ? i__3 : s_rnge("axis", i__3, "nearpt_", ( - ftnlen)894)] || point[(i__4 = i__ - 1) < 3 && 0 <= i__4 ? - i__4 : s_rnge("point", i__4, "nearpt_", (ftnlen)894)] * - .5 - axis[(i__5 = i__ - 1) < 3 && 0 <= i__5 ? i__5 : - s_rnge("axis", i__5, "nearpt_", (ftnlen)894)] == -axis[( - i__6 = i__ - 1) < 3 && 0 <= i__6 ? i__6 : s_rnge("axis", - i__6, "nearpt_", (ftnlen)894)]) { - point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("poi" - "nt", i__1, "nearpt_", (ftnlen)897)] = 0.; - } - } - -/* OK. Next we set up the logical that indicates whether */ -/* the current point is inside the ellipsoid. */ - - inside = FALSE_; - -/* Bracketing the root of the lambda equation. */ -/* ------------------------------------------- */ - -/* Let (x,y,z) stand for (POINT(1), POINT(2), POINT(3)) and */ -/* let (a,b,c) stand for (AXIS(1), AXIS(2), AXIS(3)). */ - -/* The main step in finding the near point is to find the */ -/* root of the lambda equation: */ - -/* 2 2 2 */ -/* x y z */ -/* 0 = --------------- + ---------------- + --------------- - 1 */ -/* 2 2 2 */ -/* (a + lambda/a) ( b + lambda/b) (c + lambda/c) */ - - -/* We let Q(lambda) be the right hand side of this equation. */ -/* To find the roots of the equation we determine */ -/* values of lambda that make Q greater than 0 and less than 0. */ -/* An obvious value to check is lambda = 0. */ - -/* Computing 2nd power */ - d__1 = point[0] / axis[0]; -/* Computing 2nd power */ - d__2 = point[1] / axis[1]; -/* Computing 2nd power */ - d__3 = point[2] / axis[2]; - q = d__1 * d__1 + d__2 * d__2 + d__3 * d__3 - 1.; - -/* On the first solution pass, we will determine the sign of */ -/* the altitude of the input POSITN */ - - if (solutn == 1) { - if (q >= 0.) { - sign = 1.; - } else { - sign = -1.; - } - } - -/* OK. Now for the stuff we will have to do on every solution */ -/* pass. */ - -/* Below, LOWER and UPPER are the bounds on our independent */ -/* variable LAMBDA. QLOWER and QUPPER are the values of Q */ -/* evaluated at LOWER and UPPER, respectively. The root we */ -/* seek lies in the interval */ - -/* [ LOWER, UPPER ] */ - -/* At all points in the algorithm, we have, since Q is a */ -/* decreasing function to the right of the first non-removable */ -/* singularity, */ - -/* QLOWER > 0 */ -/* - */ - -/* QUPPER < 0 */ -/* - */ - -/* We'll use bracketing to ensure that round-off errors don't */ -/* violate these inequalities. */ - -/* The logical flag INSIDE indicates whether the point is */ -/* strictly inside the interior of the ellipsoid. Points on the */ -/* surface are not considered to be inside. */ - - if (q == 0.) { - -/* In this case the point is already on the ellipsoid */ -/* (pretty lucky eh?) We simply set our bracketing values, */ -/* QLOWER and QUPPER, to zero so that that bisection */ -/* loop won't ever get executed. */ - - qlower = 0.; - qupper = 0.; - lower = 0.; - upper = 0.; - lambda = 0.; - inside = FALSE_; - } else if (q > 0.) { - -/* The input point is outside the ellipsoid (we expect that */ -/* this is the usual case). We want to choose our lower */ -/* bracketing value so that the bracketing values for lambda */ -/* aren't too far apart. So we just make sure that the largest */ -/* term of the expression for Q isn't bigger than 4. */ - - for (i__ = 1; i__ <= 3; ++i__) { - tlambd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "tlambd", i__1, "nearpt_", (ftnlen)1002)] = ((d__1 = - point[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("point", i__2, "nearpt_", (ftnlen)1002)], abs( - d__1)) * .5 - axis[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? - i__3 : s_rnge("axis", i__3, "nearpt_", (ftnlen)1002)] - ) * axis[(i__4 = i__ - 1) < 3 && 0 <= i__4 ? i__4 : - s_rnge("axis", i__4, "nearpt_", (ftnlen)1002)]; - } -/* Computing MAX */ - d__1 = max(0.,tlambd[0]), d__1 = max(d__1,tlambd[1]); - lower = max(d__1,tlambd[2]); - -/* Choose the next value of lambda so that the largest term */ -/* of Q will be no more than 1/4. */ - -/* Computing MAX */ - d__4 = (d__1 = axis[0] * point[0], abs(d__1)), d__5 = (d__2 = - axis[1] * point[1], abs(d__2)), d__4 = max(d__4,d__5), - d__5 = (d__3 = axis[2] * point[2], abs(d__3)); - upper = max(d__4,d__5) * 2.; - lambda = upper; - inside = FALSE_; - } else { - -/* In this case the point POSITN is inside the ellipsoid. */ - - inside = TRUE_; - -/* This case is a bit of a nuisance. To solve the lambda */ -/* equation we have to find upper and lower bounds on */ -/* lambda such that one makes Q greater than 0, the other */ -/* makes Q less than 0. Once the root has been bracketed */ -/* in this way it is a straight forward problem to find */ -/* the value of LAMBDA that is closest to the root we */ -/* seek. We already know that for LAMBDA = 0, Q is negative. */ -/* So we only need to find a value of LAMBDA that makes */ -/* Q positive. But... the expression for Q has singularities */ -/* at LAMBDA = -a**2, -b**2, and -c**2. */ - -/* These singularities are not necessarily to be avoided. */ -/* If the numerator of one of the terms for Q is zero, we */ -/* can simply compute Q ignoring that particular term. We */ -/* say that a singularity corresponding to a term whose */ -/* numerator is zero is a viable singularity. By being */ -/* careful in our computation of Q, we can assign LAMBDA to */ -/* the value of the singularity. A singularity that is not */ -/* viable is called a true singularity. */ - -/* By choosing LAMBDA, just slightly greater than the largest */ -/* true singularity, we can bracket the root we seek. */ - -/* First we must decide which singularity is the first true */ -/* one. */ - - snglpt = 4; - for (i__ = 3; i__ >= 1; --i__) { - if (point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "point", i__1, "nearpt_", (ftnlen)1056)] != 0.) { - snglpt = i__; - } - } - -/* If there is a singular point, compute LAMBDA so that the */ -/* largest term of Q is equal to 4. */ - - if (snglpt <= 3) { - for (i__ = 1; i__ <= 3; ++i__) { - if (point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("point", i__1, "nearpt_", (ftnlen)1070)] == - 0.) { - tlambd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("tlambd", i__1, "nearpt_", (ftnlen) - 1071)] = -axisqr[2]; - } else { - tlambd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("tlambd", i__1, "nearpt_", (ftnlen) - 1073)] = axis[(i__2 = i__ - 1) < 3 && 0 <= - i__2 ? i__2 : s_rnge("axis", i__2, "nearpt_", - (ftnlen)1073)] * ((d__1 = point[(i__3 = i__ - - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("point", - i__3, "nearpt_", (ftnlen)1073)], abs(d__1)) * - .5 - axis[(i__4 = i__ - 1) < 3 && 0 <= i__4 ? - i__4 : s_rnge("axis", i__4, "nearpt_", ( - ftnlen)1073)]); - } - } -/* Computing MAX */ - d__1 = max(tlambd[0],tlambd[1]); - lambda = max(d__1,tlambd[2]); - lower = lambda; - upper = max(lower,0.); - } else { - -/* The point must be at the origin. In this case */ -/* we know where the closest point is. WE DON'T have */ -/* to compute anything. It's just at the end of the */ -/* shortest semi-major axis. However, since we */ -/* may have done some rounding off, we will make */ -/* sure that we pick the side of the shortest axis */ -/* that has the same sign as COPY(1). */ - -/* We are going to be a bit sneaky here. We know */ -/* where the closest point is so we are going to */ -/* simply make POINT and COPY equal to that point */ -/* and set the upper and lower bracketing bounds */ -/* to zero so that we won't have to deal with any */ -/* special cases later on. */ - - if (copy[0] < 0.) { - point[0] = -axis[0]; - copy[0] = -axis[0]; - } else { - point[0] = axis[0]; - copy[0] = axis[0]; - } - copy[1] = 0.; - copy[2] = 0.; - upper = 0.; - lower = 0.; - lambda = 0.; - q = 0.; - inside = FALSE_; - } - } - -/* OK. Now compute the value of Q at the two bracketing */ -/* values of LAMBDA. */ - - for (i__ = 1; i__ <= 3; ++i__) { - if (point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("poi" - "nt", i__1, "nearpt_", (ftnlen)1130)] == 0.) { - term[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("term", - i__1, "nearpt_", (ftnlen)1132)] = 0.; - } else { - -/* We have to be a bit careful for points inside the */ -/* ellipsoid. The denominator of the factor we are */ -/* going to compute is ( AXIS + LAMBDA/AXIS ). */ -/* Numerically this may be too close to zero for us */ -/* to actually divide POINT by it. However, since */ -/* our solution algorithm for lambda does not depend */ -/* upon the differentiability of Q, we can simply truncate */ -/* its individual terms when we are in danger of */ -/* division overflows. */ - - denom = axis[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("axis", i__1, "nearpt_", (ftnlen)1146)] + - lambda / axis[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("axis", i__2, "nearpt_", (ftnlen)1146)]; - trim = (d__1 = point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("point", i__1, "nearpt_", (ftnlen)1148)], - abs(d__1)) * .5 > denom; - if (inside && trim) { - factor = 2.; - } else { - -/* We don't expect DENOM to be zero here, but we'll */ -/* check anyway. */ - - if (denom == 0.) { - setmsg_("AXIS(#) + LAMBDA/AXIS(#) is zero.", (ftnlen) - 33); - errint_("#", &i__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - factor = point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("point", i__1, "nearpt_", (ftnlen)1170)] / - denom; - } - term[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("term", - i__1, "nearpt_", (ftnlen)1174)] = factor * factor; - } - } - if (! inside) { - qlower = q; - qupper = term[0] + term[1] + term[2] - 1.; - } else { - qupper = q; - qlower = term[0] + term[1] + term[2] - 1.; - } - -/* Bracket QLOWER and QUPPER. */ - - qlower = max(0.,qlower); - qupper = min(0.,qupper); - lambda = upper; - q = qupper; - -/* Refining the estimate of lambda. */ -/* -------------------------------- */ - -/* Now find the root of Q by bisection. */ - - itr = 0; - -/* Throughout this loop we'll use TOUCHD to avoid logic problems */ -/* that may be caused by extended precision register usage by */ -/* some compilers. */ - - for(;;) { /* while(complicated condition) */ - d__1 = upper - lower; - if (!(touchd_(&d__1) > 0.)) - break; - ++itr; - if (itr > 2048) { - setmsg_("Iteration limit # exceeded in NEARPT. A, B, C = # #" - " #; POSITN = ( #, #, # ). LOWER = #; UPPER = #; UPPE" - "R-LOWER = #. Solution pass number = #. This event s" - "hould never occur. Contact NAIF.", (ftnlen)187); - errint_("#", &c__2048, (ftnlen)1); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - errdp_("#", positn, (ftnlen)1); - errdp_("#", &positn[1], (ftnlen)1); - errdp_("#", &positn[2], (ftnlen)1); - errdp_("#", &lower, (ftnlen)1); - errdp_("#", &upper, (ftnlen)1); - d__1 = upper - lower; - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - -/* Bracket LOWER, QLOWER, and QUPPER. */ - - lower = min(lower,upper); - qlower = max(0.,qlower); - qupper = min(0.,qupper); - -/* Depending upon how Q compares with Q at the */ -/* bracketing endpoints we adjust the endpoints */ -/* of the bracketing interval */ - - if (q == 0.) { - -/* We've found the root. */ - - lower = lambda; - upper = lambda; - } else { - if (q < 0.) { - upper = lambda; - qupper = q; - } else { - -/* We have Q > 0 */ - - lower = lambda; - qlower = q; - } - -/* Update LAMBDA. */ - - lambda = lower * .5 + upper * .5; - -/* It's quite possible as we get close to the root for Q */ -/* that round off errors in the computation of the next */ -/* value of LAMBDA will push it outside of the current */ -/* bracketing interval. Force it back in to the current */ -/* interval. */ - - lambda = brcktd_(&lambda, &lower, &upper); - } - -/* At this point, it's guaranteed that */ - -/* LOWER < LAMBDA < UPPER */ -/* - - */ - -/* If we didn't find a root, we've set LAMBDA to the midpoint */ -/* of the previous values of LOWER and UPPER, and we've moved */ -/* either LOWER or UPPER to the old value of LAMBDA, thereby */ -/* halving the distance between LOWER and UPPER. */ - -/* If we are still at an endpoint, we might as well cash in */ -/* our chips. We aren't going to be able to get away from the */ -/* endpoints. Set LOWER and UPPER equal so that the loop will */ -/* finally terminate. */ - - if (approx_(&lambda, &lower, &c_b108) || approx_(&lambda, &upper, - &c_b108)) { - -/* Make the decision as to which way to push */ -/* the boundaries, by selecting that endpoint */ -/* at which Q is closest to zero. */ - if (abs(qlower) < abs(qupper)) { - upper = lower; - } else { - lower = upper; - } - -/* Since LOWER is equal to UPPER, the loop will terminate. */ - - } - -/* If LOWER and UPPER aren't the same, we compute the */ -/* value of Q at our new guess for LAMBDA. */ - - d__1 = upper - lower; - if (touchd_(&d__1) > 0.) { - for (i__ = 1; i__ <= 3; ++i__) { - if (point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("point", i__1, "nearpt_", (ftnlen)1328)] == - 0.) { - term[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("term", i__1, "nearpt_", (ftnlen)1330)] - = 0.; - } else { - denom = axis[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("axis", i__1, "nearpt_", (ftnlen) - 1334)] + lambda / axis[(i__2 = i__ - 1) < 3 && - 0 <= i__2 ? i__2 : s_rnge("axis", i__2, - "nearpt_", (ftnlen)1334)]; - trim = (d__1 = point[(i__1 = i__ - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("point", i__1, "nearpt_", - (ftnlen)1336)], abs(d__1)) * .5 > denom; - if (inside && trim) { - factor = 2.; - } else { - -/* We don't expect DENOM to be zero here, but we'll */ -/* check anyway. */ - - if (denom == 0.) { - setmsg_("AXIS(#) + LAMBDA/AXIS(#) is zero.", ( - ftnlen)33); - errint_("#", &i__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - factor = point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("point", i__1, "nearpt_", ( - ftnlen)1359)] / denom; - } - term[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("term", i__1, "nearpt_", (ftnlen)1363)] - = factor * factor; - } - } - d__1 = term[0] + term[1] + term[2] - 1.; - q = touchd_(&d__1); - } - -/* Q(LAMBDA) has been set unless we've already found */ -/* a solution. */ - -/* Loop back through the bracketing refinement code. */ - - } - -/* Now we have LAMBDA, compute the nearest point based upon */ -/* this value. */ - - lambda = lower; - for (i__ = 1; i__ <= 3; ++i__) { - if (point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("poi" - "nt", i__1, "nearpt_", (ftnlen)1389)] == 0.) { - spoint[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "spoint", i__1, "nearpt_", (ftnlen)1391)] = 0.; - } else { - denom = lambda / axisqr[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("axisqr", i__1, "nearpt_", (ftnlen)1395) - ] + 1.; - -/* We don't expect that DENOM will be non-positive, but we */ -/* check for this case anyway. */ - - if (denom <= 0.) { - setmsg_("Denominator in expression for SPOINT(#) is #.", ( - ftnlen)45); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &denom, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - spoint[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "spoint", i__1, "nearpt_", (ftnlen)1412)] = copy[( - i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "copy", i__2, "nearpt_", (ftnlen)1412)] / denom; - } - } - -/* Handling points on the central plane. */ -/* ------------------------------------- */ - -/* I suppose you thought you were done at this point. */ -/* Not necessarily. If POINT is INSIDE the ellipsoid and */ -/* happens to lie in the y-z plane, there is a possibility */ -/* (perhaps even likelihood) that the nearest point on the */ -/* ellipsoid is NOT in the y-z plane. we must consider */ -/* this possibility next. */ - - if (inside && (snglpt == 2 || snglpt == 3)) { - -/* There are two ways to get here. SNGLPT = 2 or SNGLPT = 3. */ -/* Fortunately these two cases can be handled simultaneously */ -/* by code. However, they are most easily understood if treated */ -/* separately. */ - -/* Case 1. SNGLPT = 2 */ - -/* The input to the lambda solution POINT lies in the YZ plane. */ -/* We have already detected one critical point of the */ -/* distance function to POINT restricted to the ellipsoid. */ -/* This point also lies in the YZ-plane. However, when */ -/* POINT lies on the YZ-plane close to the center of the */ -/* ellipsoid, there may be a point that is nearest that does */ -/* not lie in the YZ-plane. Assuming the existence of such a */ -/* point, (x,y,z) it must satisfy the equations */ - -/* lambda*x */ -/* x + -------- = POINT(1) = 0 */ -/* a*a */ - - -/* lambda*y */ -/* y + -------- = POINT(2) */ -/* b*b */ - - -/* lambda*z */ -/* z + -------- = POINT(3) */ -/* c*c */ - - -/* Since we are assuming that this undetected solution (x,y,z) */ -/* does not have x equal to 0, it must be the case that */ - -/* lambda = -a*a. */ - -/* Because of this, we must have */ - -/* y = POINT(2) / ( 1 - (a**2/b**2) ) */ -/* z = POINT(3) / ( 1 - (a**2/c**2) ) */ - -/* The value of x is obtained by forcing */ - -/* (x/a)**2 + (y/b)**2 + (z/c)**2 = 1. */ - -/* This assumes of course that a and b are not equal. If */ -/* a and b are the same, then the solution we found above */ -/* by deflating the original ellipsoid, will find the */ -/* near point. */ - -/* (If a and b are equal, the ellipsoid deflates to a */ -/* segment on the z-axis when lambda = -a**2. Since */ -/* y is not zero, the deflating ellipsoid must pass */ -/* through (x,y,z) before it collapses to a segment.) */ - - -/* Case 2. SNGLPT = 3 */ - -/* The input to the lambda solution POINT lies on the Z-axis. */ -/* The solution obtained in the generic case above will */ -/* locate the critical point of the distance function */ -/* that lies on the Z. However, there will also be */ -/* critical points in the XZ-plane and YZ plane. The point */ -/* in the XZ-plane is the one to examine. Why? We are looking */ -/* for the point on the ellipsoid closest to POINT. It must */ -/* lie in one of these two planes. But the ellipse of */ -/* intersection with the XZ-plane fits inside the ellipse */ -/* of intersection with the YZ-plane. Therefore the closest */ -/* point on the YZ-ellipse must be at a greater distance than */ -/* the closest point on the XZ-ellipse. Thus, in solving */ -/* the equations */ - - -/* lambda*x */ -/* x + -------- = POINT(1) = 0 */ -/* a*a */ - - -/* lambda*y */ -/* y + -------- = POINT(2) = 0 */ -/* b*b */ - - -/* lambda*z */ -/* z + -------- = POINT(3) */ -/* c*c */ - - -/* We have */ - -/* lambda = -a*a, */ - -/* y = 0, */ - -/* z = POINT(3) / ( 1 - (a**2/c**2) ) */ - -/* The value of x is obtained by forcing */ - -/* (x/a)**2 + (y/b)**2 + (z/c)**2 = 1. */ - -/* This assumes that a and c are not equal. If */ -/* a and c are the same, then the solution we found above */ -/* by deflating the original ellipsoid, will find the */ -/* near point. */ - -/* ( If a = c, then the input ellipsoid is a sphere. */ -/* The ellipsoid will deflate to the center of the */ -/* sphere. Since our point is NOT at the center, */ -/* the deflating sphere will cross through */ -/* (x,y,z) before it collapses to a point ) */ - -/* We begin by assuming this extra point doesn't exist. */ - - extra = FALSE_; - -/* Next let's note a few simple tests we can apply to */ -/* eliminate searching for an extra point. */ - -/* First of all the smallest axis must be different from */ -/* the axis associated with the first true singularity. */ - - -/* Next, whatever point we find, it must be true that */ - -/* |y| < b, |z| < c */ - -/* because of the condition on the absolute values, we must */ -/* have: */ - -/* | POINT(2) | <= b - a*(a/b) */ - -/* | POINT(3) | <= c - a*(a/c) */ - - if (axis[0] != axis[(i__1 = snglpt - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("axis", i__1, "nearpt_", (ftnlen)1569)] && abs( - point[1]) <= axis[1] - axisqr[0] / axis[1] && abs(point[2] - ) <= axis[2] - axisqr[0] / axis[2]) { - -/* Compute the y, and z components (2 and 3) of the extra */ -/* point. */ - - denom2 = 1. - axisqr[0] / axisqr[1]; - denom3 = 1. - axisqr[0] / axisqr[2]; - -/* We expect DENOM2 and DENOM3 will always be positive. */ -/* Nonetheless, we check to make sure this is the case. */ -/* If not, we don't compute the extra point. */ - - if (denom2 > 0. && denom3 > 0.) { - epoint[1] = point[1] / denom2; - epoint[2] = point[2] / denom3; - -/* See if these components can even be on the */ -/* ellipsoid... */ - -/* Computing 2nd power */ - d__1 = epoint[1] / axis[1]; -/* Computing 2nd power */ - d__2 = epoint[2] / axis[2]; - temp = 1. - d__1 * d__1 - d__2 * d__2; - if (temp > 0.) { - -/* ...and compute the x component of the point. */ - - epoint[0] = axis[0] * sqrt(temp); - extra = TRUE_; - } - } - } - -/* Ok. If an extra point is possible, check and see if it */ -/* is the one we are searching for. */ - - if (extra) { - if (vdist_(epoint, point) < vdist_(spoint, point)) { - vequ_(epoint, spoint); - } - } - } - -/* Decisions and initializations for sharpening the solution. */ -/* ================================================================ */ -/* ---------------------------------------------------------------- */ - - if (solutn == 1) { - -/* The first solution for the nearest point may not be */ -/* very close to being on the ellipsoid. To */ -/* take care of this case, we next find the point on the */ -/* ellipsoid, closest to our first solution point. */ -/* (Ideally the normal line at this second point should */ -/* contain both the current solution point and the */ -/* original point). */ - - vequ_(spoint, point); - vequ_(spoint, bestpt); - bestht = vdist_(bestpt, orignl); - } else if (solutn == 2) { - -/* The current solution point will be very close to lying */ -/* on the ellipsoid. However, the normal at this solution */ -/* may not actually point toward the input point. */ - -/* With the current solution we can predict */ -/* the location of the input point. The difference between */ -/* this predicted point and the actual point can be used */ -/* to sharpen our estimate of the solution. */ - -/* The sharpening is performed by */ - -/* 1) Compute the vector ERR that gives the difference */ -/* between the input point (POSITN) and the point */ -/* computed using the solution point, normal and */ -/* altitude. */ - -/* 2) Find the component of ERR that is orthogonal to the */ -/* normal at the current solution point. If the point */ -/* is outside the ellipsoid, scale this component to */ -/* the approximate scale of the near point. We use */ -/* the scale factor */ - -/* ||near point|| / ||input point|| */ - -/* Call this scaled component ERRP. */ - -/* 3) Translate the solution point by ERRP to get POINT. */ - -/* 4) Find the point on the ellipsoid closest to POINT. */ -/* (step 4 is handled by the solution loop above). */ - - -/* First we need to compute the altitude */ - - height = sign * vdist_(spoint, orignl); - -/* Next compute the difference between the input point and */ -/* the one we get by moving out along the normal at our */ -/* solution point by the computed altitude. */ - - surfnm_(axis, &axis[1], &axis[2], spoint, normal); - for (i__ = 1; i__ <= 3; ++i__) { - err[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("err", - i__1, "nearpt_", (ftnlen)1699)] = orignl[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("orignl", i__2, - "nearpt_", (ftnlen)1699)] - spoint[(i__3 = i__ - 1) < - 3 && 0 <= i__3 ? i__3 : s_rnge("spoint", i__3, "near" - "pt_", (ftnlen)1699)] - height * normal[(i__4 = i__ - - 1) < 3 && 0 <= i__4 ? i__4 : s_rnge("normal", i__4, - "nearpt_", (ftnlen)1699)]; - } - -/* Find the component of the error vector that is */ -/* perpendicular to the normal, and shift our solution */ -/* point by this component. */ - - vperp_(err, normal, errp); - -/* The sign of the original point's altitude tells */ -/* us whether the point is outside the ellipsoid. */ - - if (sign >= 0.) { - -/* Scale the transverse component down to the local radius */ -/* of the surface point. */ - - if (pnorm == 0.) { - -/* Since the point is outside of the scaled ellipsoid, */ -/* we don't expect to arrive here. This is a backstop */ -/* check. */ - - setmsg_("Norm of scaled point is 0. POSITN = ( #, #, # )", - (ftnlen)47); - errdp_("#", positn, (ftnlen)1); - errdp_("#", &positn[1], (ftnlen)1); - errdp_("#", &positn[2], (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - d__1 = vnorm_(spoint) / pnorm; - vsclip_(&d__1, errp); - } - vadd_(spoint, errp, point); - olderr = vnorm_(err); - bestht = height; - -/* Finally store the current solution point, so that if */ -/* this sharpening doesn't improve our estimate of the */ -/* near point, we can just return our current best guess. */ - - vequ_(spoint, bestpt); - } else if (solutn > 2) { - -/* This branch exists for the purpose of testing our */ -/* "sharpened" solution and setting up for another sharpening */ -/* pass. */ - -/* We have already stored our best guess so far in BESTPT and */ -/* the vector ERR is the difference */ - -/* ORIGNL - ( BESTPT + BESTHT*NORMAL ) */ - -/* We have just computed a new candidate "best" near point. */ -/* SPOINT. */ - -/* If the error vector */ - -/* ORIGNL - ( SPOINT + HEIGHT*NORMAL) */ - -/* is shorter than our previous error, we will make SPOINT */ -/* our best guess and try to sharpen our estimate again. */ - -/* If our sharpening method hasn't improved things, we just */ -/* call it quits and go with our current best guess. */ - - -/* First compute the altitude, */ - - height = sign * vdist_(spoint, orignl); - -/* ... compute the difference */ - -/* ORIGNL - SPOINT - HEIGHT*NORMAL, */ - - surfnm_(axis, &axis[1], &axis[2], spoint, normal); - for (i__ = 1; i__ <= 3; ++i__) { - err[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("err", - i__1, "nearpt_", (ftnlen)1792)] = orignl[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("orignl", i__2, - "nearpt_", (ftnlen)1792)] - spoint[(i__3 = i__ - 1) < - 3 && 0 <= i__3 ? i__3 : s_rnge("spoint", i__3, "near" - "pt_", (ftnlen)1792)] - height * normal[(i__4 = i__ - - 1) < 3 && 0 <= i__4 ? i__4 : s_rnge("normal", i__4, - "nearpt_", (ftnlen)1792)]; - } - -/* ...and determine the magnitude of the error due to our */ -/* sharpened estimate. */ - - newerr = vnorm_(err); - -/* If the sharpened estimate yields a smaller error ... */ - - if (newerr < olderr) { - -/* ...our current value of SPOINT becomes our new */ -/* best point and the current altitude becomes our */ -/* new altitude point. */ - - olderr = newerr; - bestht = height; - vequ_(spoint, bestpt); - -/* Next, if we haven't passed the limit on the number of */ -/* iterations allowed we prepare the initial point for our */ -/* "sharpening" estimate. */ - - if (solutn <= 6) { - vperp_(err, normal, errp); - -/* The sign of the original point's altitude tells */ -/* us whether the point is outside the ellipsoid. */ - - if (sign >= 0.) { - -/* Scale the transverse component down to the local */ -/* radius of the surface point. */ - - if (pnorm == 0.) { - -/* Since the point is outside of the scaled */ -/* ellipsoid, we don't expect to arrive here. */ -/* This is a backstop check. */ - - setmsg_("Norm of scaled point is 0. POSITN = ( #" - ", #, # )", (ftnlen)47); - errdp_("#", positn, (ftnlen)1); - errdp_("#", &positn[1], (ftnlen)1); - errdp_("#", &positn[2], (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("NEARPT", (ftnlen)6); - return 0; - } - d__1 = vnorm_(spoint) / pnorm; - vsclip_(&d__1, errp); - } - vadd_(spoint, errp, point); - } - } else { - -/* If things didn't get better, there is no point in */ -/* going on. Just set the SOLVNG flag to .FALSE. to */ -/* terminate the outer loop. */ - - solvng = FALSE_; - } - } - -/* Increment the solution counter so that eventually this */ -/* loop will terminate. */ - - ++solutn; - solvng = solvng && solutn <= 6; - } - -/* Clean up. */ -/* ================================================================== */ -/* ------------------------------------------------------------------ */ - -/* Re-scale and re-order the components of our solution point. Scale */ -/* and copy the value of BESTHT into the output argument. */ - - d__1 = 1. / scale; - vsclip_(&d__1, bestpt); - for (i__ = 1; i__ <= 3; ++i__) { - npoint[(i__2 = iorder[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("iorder", i__1, "nearpt_", (ftnlen)1891)] - 1) < 3 && - 0 <= i__2 ? i__2 : s_rnge("npoint", i__2, "nearpt_", (ftnlen) - 1891)] = bestpt[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : - s_rnge("bestpt", i__3, "nearpt_", (ftnlen)1891)]; - } - *alt = bestht / scale; - chkout_("NEARPT", (ftnlen)6); - return 0; -} /* nearpt_ */ - diff --git a/ext/spice/src/cspice/nearpt_c.c b/ext/spice/src/cspice/nearpt_c.c deleted file mode 100644 index 5d61c9cb72..0000000000 --- a/ext/spice/src/cspice/nearpt_c.c +++ /dev/null @@ -1,295 +0,0 @@ -/* - --Procedure nearpt_c ( Nearest point on an ellipsoid ) - --Abstract - - This routine locates the point on the surface of an ellipsoid - that is nearest to a specified position. It also returns the - altitude of the position above the ellipsoid. - --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 - - ELLIPSOID, GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef nearpt_c - - - void nearpt_c ( ConstSpiceDouble positn[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble npoint[3], - SpiceDouble * alt ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - positn I Position of a point in bodyfixed frame. - a I Length of semi-axis parallel to x-axis. - b I Length of semi-axis parallel to y-axis. - c I Length on semi-axis parallel to z-axis. - npoint O Point on the ellipsoid closest to positn. - alt O Altitude of positn above the ellipsoid. - --Detailed_Input - - positn 3-vector giving the position of a point with respect to - the center of an ellipsoid. The vector is expressed in a - body-fixed reference frame. The semi-axes of the - ellipsoid are aligned with the x, y, and z-axes of the - body-fixed frame. - - a is the length of the semi-axis of the ellipsoid that is - parallel to the x-axis of the bodyfixed coordinate - system. - - b is the length of the semi-axis of the ellipsoid that is - parallel to the y-axis of the bodyfixed coordinate - system. - - c is the length of the semi-axis of the ellipsoid that is - parallel to the z-axis of the bodyfixed coordinate - system. - --Detailed_Output - - npoint is the nearest point on the ellipsoid to `positn'. - `npoint' is a 3-vector expressed in the body-fixed - reference frame. - - alt is the altitude of `positn' above the ellipsoid. If - `positn' is inside the ellipsoid, `alt' will be negative - and have magnitude equal to the distance between `npoint' - and `positn'. - --Parameters - - None. - --Exceptions - - 1) If any of the inputs a, b or c are non-positive the error - "SPICE(BADAXISLENGTH)" will be signaled. - - 2) If the ratio of the longest to the shortest ellipsoid axis - is large enough so that arithmetic expressions involving its - squared value may overflow, the error SPICE(BADAXISLENGTH) - will be signaled. - - 3) If any of the expressions - - a * abs( positn[0] ) / (m*m) - b * abs( positn[1] ) / (m*m) - c * abs( positn[1] ) / (m*m) - - where m is the minimum of { a, b, c }, is large enough so - that arithmetic expressions involving these sub-expressions - may overflow, the error SPICE(INPUTSTOOLARGE) is signaled. - - 4) If the axes of the ellipsoid have radically different - magnitudes, for example if the ratios of the axis lengths vary - by 10 orders of magnitude, the results may have poor - precision. No error checks are done to identify this problem. - - 5) If the axes of the ellipsoid and the input point `positn' have - radically different magnitudes, for example if the ratio of - the magnitude of `positn' to the length of the shortest axis is - 1.e25, the results may have poor precision. No error checks - are done to identify this problem. - --Files - - None. - --Particulars - - Many applications of this routine are more easily performed - using the higher-level CSPICE routine subpt_c. - --Examples - - Example 1. - - The code fragment below illustrates how you can use CSPICE to - compute the sub-earth point on the moon. - - /. - Load the ephemeris, leapseconds and physical constants files - first. We assume the names of these files are stored in the - character variables SPK, LSK and PCK. - ./ - furnsh_c ( SPK ); - furnsh_c ( LSK ); - furnsh_c ( PCK ); - - /. - Get the apparent position of the Moon as seen from Earth. - Look up this position vector in the moon body-fixed frame - IAU_MOON. The orientation of the IAU_MOON frame will be - computed at epoch et-lt. - ./ - spkpos_c ( "moon", et, "IAU_MOON", "lt+s", "earth, trgpos, < ); - - /. - Negate the moon's apparent position to obtain the - position of the earth in the moon's body-fixed frame. - ./ - vminus_c ( trgpos, evec ); - - /. - Get the lengths of the principal axes of the moon. Transfer the - elements of the array radii to the variables a, b, c to enhance - readability. - ./ - bodvcd_c ( 399, "RADII", 3, &dim, radii ); - vupack_c ( radii, &a, &b, &c ); - - /. - Finally get the point `subpnt' on the surface of the - moon closest to the earth --- the sub-earth point. - ./ - nearpt_c ( evec, a, b, c, subpnt, &alt ); - - - Example 2. - - One can use this routine to define a generalization of GEODETIC - coordinates called GAUSSIAN coordinates of a triaxial body. (The - name is derived from the famous Gauss-map of classical - differential geometry). The coordinates are longitude, latitude, - and altitude. - - We let the x-axis of the body fixed coordinate system point along - the longest axis of the triaxial body. The y-axis points along - the middle axis and the z-axis points along the shortest axis. - - Given a point P, there is a point on the ellipsoid that is - closest to P, call it Q. The latitude and longitude of P is - determined by constructing the outward pointing unit normal to - the ellipsoid at Q. The latitude of P is the latitude that the - normal points towards in the bodyfixed frame. The longitude of P - is the longitude the normal points to in the bodyfixed frame. The - altitude is the signed distance from P to Q, positive if P is - outside the ellipsoid, negative if P is inside. (the mapping of - the point Q to the unit normal at Q is the Gauss-map of Q). - - To obtain the Gaussian coordinates of a point whose position in - bodyfixed rectangular coordinates is given by a vector P, the - code fragment below will suffice. - - nearpt_c ( p, a, b, c, q, &alt ); - surfnm_c ( a, b, c q, nrml ); - reclat_c ( nrml, &r, &long, &lat ); - - The Gaussian coordinates are long, lat, alt. - --Restrictions - - See the Exceptions header section above. - --Author_and_Institution - - C.H. Acton (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.3.2, 17-NOV-2005 (NJB) (EDW) - - The Exceptions and Restrictions header sections were updated. - A reference to bodvar_c in the header was changed to a - reference to bodvcd_c. - - -CSPICE Version 1.3.1, 28-JUL-2003 (NJB) (CHA) - - Various header corrections were made. - - -CSPICE Version 1.3.0, 21-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.2.0, 15-FEB-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Removed local variables used for temporary capture of outputs. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.1.0, 27-NOV-1990 (WLT) - --Index_Entries - - distance from point to ellipsoid - nearest point on an ellipsoid - --& -*/ - -{ /* Begin nearpt_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "nearpt_c" ); - - - /* - Call the f2c'd nearpt. - */ - nearpt_( (doublereal *) positn, - (doublereal *) &a, - (doublereal *) &b, - (doublereal *) &c, - (doublereal *) npoint, - (doublereal *) alt ); - - - chkout_c ( "nearpt_c" ); - - -} /* End nearpt_c */ diff --git a/ext/spice/src/cspice/nextwd.c b/ext/spice/src/cspice/nextwd.c deleted file mode 100644 index 25e436f6b9..0000000000 --- a/ext/spice/src/cspice/nextwd.c +++ /dev/null @@ -1,259 +0,0 @@ -/* nextwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NEXTWD ( Next word in a character string ) */ -/* Subroutine */ int nextwd_(char *string, char *next, char *rest, ftnlen - string_len, ftnlen next_len, ftnlen rest_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__, begin; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - logical inword; - integer end; - -/* $ Abstract */ - -/* Return the next word in a given character string, and */ -/* left justify the rest of the 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 */ - -/* CHARACTER, PARSING, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* NEXT O The next word in the string. */ -/* REST O The remaining part of STRING, left-justified. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. This may be a list */ -/* of items, a sentence, or anything else. */ - -/* $ Detailed_Output */ - -/* NEXT is the next word in STRING. A word is any sequence */ -/* of consecutive non-blank characters. NEXT is always */ -/* returned left-justified. */ - -/* If STRING is blank, NEXT is blank. */ - -/* NEXT may NOT overwrite STRING. */ - -/* REST is the remaining part of STRING, left-justified */ -/* after the removal of NEXT. */ - -/* REST may overwrite STRING. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NEXTWD is used primarily for parsing input commands consisting */ -/* of one or more words, where a word is defined to be any sequence */ -/* of consecutive non-blank characters. Successive calls to NEXTWD, */ -/* each using the previous value of REST as the input string, allow */ -/* the calling routine to neatly parse and process one word at a */ -/* time. */ - -/* NEXTWD cuts the input string into two pieces, and returns them */ -/* separately. The first piece is the first word in the string. */ -/* (Leading blanks are ignored. The next word runs from the first */ -/* non-blank character in the string up to the first blank that */ -/* follows it.) The second piece is whatever is left after the */ -/* first word is removed. The second piece is left justified, */ -/* to simplify later calls to NEXTWD. */ - -/* If NEXT and REST are not large enough to hold the output */ -/* strings, they are truncated on the right. */ - -/* $ Examples */ - -/* Let STRING be the following string: */ - -/* ' Now is the time, for all good men to come.' */ - -/* Then successive aplications of NEXTWD yield the following: */ - -/* NEXT REST */ -/* ----------- ---------------------------- */ -/* 'Now' 'is the time, for all good men to come.' */ -/* 'is' 'the time, for all good men to come.' */ -/* 'the' 'time, for all good men to come.' */ -/* 'time,' 'for all good men to come.' */ -/* 'for' 'all good men to come.' */ -/* 'all' 'good men to come.' */ -/* 'good' 'men to come.' */ -/* 'men' 'to come.' */ -/* 'to 'come.' */ -/* 'come.' ' ' */ -/* ' ' ' ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 04-APR-1996 (KRG) */ - -/* Fixed a problem that could occur when STRING and REST are */ -/* the same character string. Simplified the algorithm a bit */ -/* while I was at it. */ - -/* Single character comparisons now make use of ICHAR to */ -/* perform the comparisons as integers for speed. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* next word in a character_string */ - -/* -& */ - -/* Local Parameters */ - - -/* Local variables */ - - -/* The trivial case. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - s_copy(next, " ", next_len, (ftnlen)1); - s_copy(rest, " ", rest_len, (ftnlen)1); - -/* The non-trivial case. */ - - } else { - -/* Get the length of the string. */ - - end = i_len(string, string_len); - -/* Skip leading blanks and set flags indicating that we are */ -/* not in a word and that we do not have a word. */ - - begin = 1; - inword = FALSE_; - -/* We know the string is not blank, so we will eventually */ -/* get to a word, thus no need to check against END here. */ - - while(! inword) { - if (*(unsigned char *)&string[begin - 1] == 32) { - ++begin; - } else { - inword = TRUE_; - } - } - -/* We are now in a word. Step through the input string until the */ -/* next blank is encountered or until the end of the string is */ -/* found. We start at BEGIN even though we know from above that */ -/* STRING(BEGIN:BEGIN) is not blank; this allows us to deal */ -/* cleanly with the case where the string is a single character */ -/* long and not blank (because we're in that case). */ - - i__ = begin; - while(inword) { - if (*(unsigned char *)&string[i__ - 1] != 32) { - ++i__; - if (i__ > end) { - --i__; - inword = FALSE_; - } - } else { - --i__; - inword = FALSE_; - } - } - -/* Our word is the substring between BEGIN and I. Note that I */ -/* might be equal to END, so we have to be careful about setting */ -/* the REST. We also left justify REST as we set it. LJUST does */ -/* the right thing if STRING and REST overlap. If we do not have */ -/* a word, the NEXT and REST are both blank. */ - - s_copy(next, string + (begin - 1), next_len, i__ - (begin - 1)); - if (i__ < end) { - i__1 = i__; - ljust_(string + i__1, rest, string_len - i__1, rest_len); - } else { - s_copy(rest, " ", rest_len, (ftnlen)1); - } - } - return 0; -} /* nextwd_ */ - diff --git a/ext/spice/src/cspice/notru.c b/ext/spice/src/cspice/notru.c deleted file mode 100644 index a4fb67fdd1..0000000000 --- a/ext/spice/src/cspice/notru.c +++ /dev/null @@ -1,152 +0,0 @@ -/* notru.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NOTRU ( No true entries? ) */ -logical notru_(logical *logcls, integer *n) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Determine if none the entries in an array of logicals are .TRUE. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LOGCLS I An array of logicals. */ -/* N I Number of elements in the array LOGCLS. */ - -/* The function returns .TRUE. if no entry has a value of .TRUE. */ - -/* $ Detailed_Input */ - -/* LOGCLS is an array of logicals. */ - -/* N is the number of elements in the array LOGCLS */ - -/* $ Detailed_Output */ - -/* The function returns true if no entry of LOGCLS is .TRUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If N is less than 1, the function returns a value of .TRUE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function examines each element of LOGCLS until */ -/* a .TRUE. value is found or until all values have been */ -/* examined. */ - -/* $ Examples */ - -/* Suppose you needed to confirm that no entry of a character set */ -/* WORDS was one of the words in the phrase */ - -/* 'EVERY GOOD BOY DOES FINE' */ - -/* You might execute the following block of code. */ - -/* FOUND(1) = ELEMC ( 'EVERY', WORDS ) */ -/* FOUND(2) = ELEMC ( 'GOOD', WORDS ) */ -/* FOUND(3) = ELEMC ( 'BOY', WORDS ) */ -/* FOUND(4) = ELEMC ( 'DOES', WORDS ) */ -/* FOUND(5) = ELEMC ( 'FINE', WORDS ) */ - -/* OK = NOTRU ( FOUND, 5 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 12-JUL-1991 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether no logicals in an array are true */ - -/* -& */ - -/* Just do it. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (logcls[i__ - 1]) { - ret_val = FALSE_; - return ret_val; - } - } - ret_val = TRUE_; - return ret_val; -} /* notru_ */ - diff --git a/ext/spice/src/cspice/nparsd.c b/ext/spice/src/cspice/nparsd.c deleted file mode 100644 index e6b8d8d1e8..0000000000 --- a/ext/spice/src/cspice/nparsd.c +++ /dev/null @@ -1,1072 +0,0 @@ -/* nparsd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure NPARSD ( Double Precision parsing of a string ) */ -/* Subroutine */ int nparsd_(char *string, doublereal *x, char *error, - integer *ptr, ftnlen string_len, ftnlen error_len) -{ - /* Initialized data */ - - static doublereal lookup[11] = { 1.,10.,100.,1e3,1e4,1e5,1e6,1e7,1e8,1e9, - 1e10 }; - static logical first = TRUE_; - static doublereal values[128] = { 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., - 0.,0.,0.,0.,0. }; - static integer class__[129] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - double d_lg10(doublereal *), d_int(doublereal *); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen), - i_dnnt(doublereal *); - - /* Local variables */ - static doublereal next; - static integer b; - extern /* Subroutine */ int zzinssub_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer i__, l, m; - static logical dodec; - static integer blank; - static logical bpiok, epiok; - extern doublereal dpmax_(void); - static doublereal value; - static logical doint, doexp; - static integer thisi; - static logical expok; - static integer nexti; - static logical zeroi, pntok; - static integer id; - extern doublereal pi_(void); - static integer nl; - static doublereal decval, factor, intbnd, smlbnd; - static logical sigchr; - static char toobig[160]; - static doublereal dpsign[2]; - static logical mantsa, signok, roundd; - static integer signdx; - static char blnkst[160]; - static doublereal ecount, divisr, expval, intval, maxexp; - static char unxpch[160]; - static doublereal minexp; - static logical roundi; - static char unrcst[160]; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen); - static char unxpsn[160], unxppt[160]; - static integer exp__; - -/* $ Abstract */ - -/* Parse a character string that represents a number and return */ -/* a double precision value. */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* STRING I Character string representing a numeric value. */ -/* X O Double precision value parsed from STRING. */ -/* ERROR O Message indicating whether errors have occurred. */ -/* PTR O Position in string where an error occurred. */ - -/* $ Detailed_Input */ - -/* STRING A character string that represents a numeric value. */ -/* Commas and spaces may be used in this string for */ -/* ease of reading and writing the number. They */ -/* are treated as insignificant but non-error-producing */ -/* characters. */ - -/* For exponential representation the characters */ -/* 'E','D','e','d' may be used. */ - -/* The following are legitimate numeric expressions */ - -/* +12.2 e-1 */ -/* -3. 1415 9276 */ -/* 1e12 */ -/* E10 */ - -/* The program also recognizes the following mnemonics */ -/* 'PI', 'pi', 'Pi', 'pI' */ -/* '+PI', '+pi', '+Pi', '+pI' */ -/* '-PI', '-pi', '-Pi', '-pI' */ -/* and returns the value */ -/* ( + OR - ) 3.1415 9265 3589 7932 3846 2600 D0 as */ -/* appropriate. */ - -/* $ Detailed_Output */ - -/* X Double precision parsed value of input string. If an */ -/* error is encountered, X is not changed. */ - -/* ERROR is a message indicating that the string could */ -/* not be parsed due to use of an unexpected or misplaced */ -/* character or due to a string representing a number */ -/* too large for double precision. If the number was */ -/* successfully parsed, ERROR will be returned as a blank. */ - -/* In particular, blank strings, or strings that do not */ -/* contain either a digit or exponent character will */ -/* be regarded as errors. */ - -/* PTR This indicates which character was being used when */ -/* the error occurred. If no error occurs, PTR is */ -/* returned as 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the string is non-numeric, PTR indicates the location in */ -/* the string where the error occurred, and ERROR contains a */ -/* descriptive error message. */ - -/* $ Particulars */ - -/* This routine parses an input character string that represents a */ -/* number, checks for overflow, unexpected or misplaced */ -/* characters. It returns the double precision number or an error */ -/* message. */ - -/* $ Examples */ - -/* Let LINE = 'DELTA_T_A = 32.184' */ - -/* The following code fragment parses the line and obtains the */ -/* double precision value. */ - - -/* CALL NEXTWD ( LINE, FIRST, REST ) */ -/* CALL NEXTWD ( REST, SECOND, REST ) */ -/* CALL NEXTWD ( REST, THIRD, REST ) */ - -/* CALL NPARSD ( THIRD, VALUE, ERROR, PTR ) */ - -/* $ Restrictions */ - -/* Due to rounding errors this routine may not be able to parse */ -/* the decimal character string representation of the largest */ -/* and smallest double precision numbers. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.5.0, 15-AUG-2002 (WLT) */ - -/* Replaced the call to INSSUB with a call to ZZINSSUB so */ -/* that this routine can legitimately call itself Error Free */ - -/* - SPICELIB Version 3.4.0, 3-DEC-2001 */ - -/* Added an extra check to make sure that ICHAR of any character */ -/* of the input string is positive. */ - -/* - SPICELIB Version 3.3.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* Removed the error message and storage for the unexpected */ -/* comma error message. This variable was set but never used, */ -/* and according to the spec for this routine a comma is a valid */ -/* delimiter, treated like a space, within numbers. */ - -/* - SPICELIB Version 3.2.0, 10-JAN-1995 (WLT) */ - -/* Changed error strings from parameters to assignments to */ -/* compensate for shortcomings of the Absoft FORTRAN compiler */ -/* on the NeXT. */ - -/* - SPICELIB Version 3.1.0, 12-JUL-1994 (WLT) */ - -/* The previous version of the routine assumed that the range */ -/* of values of ICHAR was 0 to 128. That turns out not to be */ -/* true on some machines. If a character whose ICHAR value is */ -/* outside this range is detected, it is now handled properly */ -/* as an unexpected character. */ - -/* - SPICELIB Version 3.0.0, 24-FEB-1993 (WLT) */ - -/* The previous version of the algorithm interpreted P or p as 1. */ -/* This was not the intent of the routine and was corrected. */ - -/* - SPICELIB Version 2.0.0, 28-AUG-1992 (WLT) (KRG) */ - -/* The basic algorithm was completely re-written. As a result */ -/* the routine now runs an order of magnitude faster than */ -/* it did before. In addition, strings that do not contain */ -/* enough information to assign a value to the string are now */ -/* regarded as errors. These include blank strings or strings */ -/* that contain only a sign characters, blanks and commas. */ - -/* In addition the error diagnosis and checking for overflow */ -/* was greatly enhanced. */ - -/* Note: strings may now parse with slightly different values */ -/* from the previous version of NPARSD. The current */ -/* implementation is more accurate in converting strings to */ -/* double precision numbers. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 17-APR-1990 (WLT) */ - -/* Bug fix. The subscript used to reference individual characters */ -/* of the input string could sometimes step out of bounds. This */ -/* went unnoticed until NAIF began compiling with the CHECK=BOUNDS */ -/* option of the DEC Fortran compiler. */ - - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse a character_string to a d.p. number */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.3.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* Removed the error message and storage for the unexpected */ -/* comma error message. This variable was set but never used, */ -/* and according to the spec for this routine a comma is a valid */ -/* delimiter, treated like a space, within numbers. */ - -/* - SPICELIB Version 3.2.0, 10-JAN-1995 (WLT) */ - -/* Changed error strings from parameters to assignments to */ -/* compensate for shortcomings of the Absoft FORTRAN compiler */ -/* on the NeXT. */ - -/* - SPICELIB Version 3.1.0, 12-JUL-1994 (WLT) */ - -/* The previous version of the routine assumed that the range */ -/* of values of ICHAR was 0 to 128. That turns out not to be */ -/* true on some machines. If a character whose ICHAR value is */ -/* outside this range is detected, it is now handled properly */ -/* as an unexpected character. */ - -/* - SPICELIB Version 3.0.0, 24-FEB-1993 (WLT) */ - -/* The previous version of the algorithm interpreted P or p as 1. */ -/* This was not the intent of the routine and was corrected. */ - -/* - SPICELIB Version 2.0.0, 28-AUG-1992 (WLT) (KRG) */ - -/* The basic algorithm was completely re-written. As a result */ -/* the routine now runs an order of magnitude faster than */ -/* it did before. In addition, strings that do not contain */ -/* enough information to assign a value to the string are now */ -/* regarded as errors. These include blank strings or strings */ -/* that contain only a sign characters, blanks and commas. */ - -/* In addition the error diagnosis and checking for overflow */ -/* was greatly enhanced. */ - -/* In general the current algorithm is more robust and much */ -/* faster than the previous version. */ - -/* Note: strings may now parse with slightly different values */ -/* from the previous version of NPARSD. The current */ -/* implementation is more accurate in converting strings to */ -/* double precision numbers. */ - -/* - SPICELIB Version 1.1.0, 17-APR-1990 (WLT) */ - -/* Bug fix. The subscript used to reference individual characters */ -/* of the input string could sometimes step out of bounds. This */ -/* went unnoticed until NAIF began compiling with the CHECK=BOUNDS */ -/* option of the DEC Fortran compiler. */ - -/* - Beta Version 1.1.0, 16-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed to "error free" */ -/* to reflect the decision that the module will never participate */ -/* in error handling. */ - -/* An example was added to the header, and the Exceptions section */ -/* was completed. */ - -/* Declaration of unused variables J, K and unused function */ -/* LASTNB removed. */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local Parameters. */ - - -/* Save everything. It's easier than tracking down every */ -/* little variable that might need to be saved. */ - - if (first) { - first = FALSE_; - -/* Set up the error messages */ - - s_copy(toobig, "The number represented by the input string is too la" - "rge to be stored as a double precision number. ", (ftnlen)160, - (ftnlen)99); - s_copy(unxpch, "An unexpected character was found while attempting t" - "o parse the input string. ", (ftnlen)160, (ftnlen)78); - s_copy(unxppt, "An unexpected decimal point was found in the input s" - "tring. ", (ftnlen)160, (ftnlen)59); - s_copy(unxpsn, "An unexpected sign character was found in the input " - "string. ", (ftnlen)160, (ftnlen)60); - s_copy(blnkst, "The input string is blank. Blank strings are not con" - "sidered to be numbers. ", (ftnlen)160, (ftnlen)75); - s_copy(unrcst, "The input string could not be recognized as a number" - ". ", (ftnlen)160, (ftnlen)54); - blank = ' '; - values[(i__1 = '0' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)476)] = 0.; - values[(i__1 = '1' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)477)] = 1.; - values[(i__1 = '2' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)478)] = 2.; - values[(i__1 = '3' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)479)] = 3.; - values[(i__1 = '4' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)480)] = 4.; - values[(i__1 = '5' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)481)] = 5.; - values[(i__1 = '6' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)482)] = 6.; - values[(i__1 = '7' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)483)] = 7.; - values[(i__1 = '8' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)484)] = 8.; - values[(i__1 = '9' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)485)] = 9.; - values[(i__1 = '-' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)486)] = -1.; - values[(i__1 = '+' - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "nparsd_", (ftnlen)487)] = 1.; - class__[(i__1 = ' ') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)489)] = 4; - class__[(i__1 = ',') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)490)] = 4; - class__[(i__1 = '.') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)492)] = 2; - class__[(i__1 = 'E') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)494)] = 3; - class__[(i__1 = 'D') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)495)] = 3; - class__[(i__1 = 'e') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)496)] = 3; - class__[(i__1 = 'd') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)497)] = 3; - class__[(i__1 = '+') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)499)] = 7; - class__[(i__1 = '-') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)500)] = 7; - class__[(i__1 = '1') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)502)] = 1; - class__[(i__1 = '2') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)503)] = 1; - class__[(i__1 = '3') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)504)] = 1; - class__[(i__1 = '4') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)505)] = 1; - class__[(i__1 = '5') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)506)] = 1; - class__[(i__1 = '6') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)507)] = 1; - class__[(i__1 = '7') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)508)] = 1; - class__[(i__1 = '8') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)509)] = 1; - class__[(i__1 = '9') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)510)] = 1; - class__[(i__1 = '0') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)511)] = 1; - class__[(i__1 = 'p') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)513)] = 5; - class__[(i__1 = 'P') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)514)] = 5; - class__[(i__1 = 'i') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)515)] = 6; - class__[(i__1 = 'I') < 129 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "nparsd_", (ftnlen)516)] = 6; - -/* Finally create the numbers that will be used for checking */ -/* for floating point overflow. */ - -/* NOTE: The value for MINEXP may be too small by one, but it */ -/* really doesn't make any difference, as you're going to */ -/* underflow anyway, and dividing zero by a number (BASE) */ -/* still gives you zero. */ - - d__2 = dpmax_(); - d__1 = d_lg10(&d__2); - maxexp = d_int(&d__1); - minexp = -(maxexp + 1); - smlbnd = dpmax_() / lookup[10]; - intbnd = 10.; - next = intbnd + 1.; - while(intbnd != next) { - intbnd *= 10.; - next = intbnd + 1.; - } - intbnd /= 10.; - -/* That takes care of the first pass initializations. */ - - } - -/* Here's what's true right now. */ - -/* There are no errors. */ -/* The error pointer doesn't need to point anywhere. */ -/* It's ok for the next token to be a decimal point. */ -/* It's ok for the next token to be a sign character. */ -/* It's ok for the next token to be an exponent marker. */ -/* It's ok for the next character to be the start of pi. */ - -/* We expect to be constructing the integer part of the */ -/* numeric string. */ - - s_copy(error, " ", error_len, (ftnlen)1); - *ptr = 0; - pntok = TRUE_; - signok = TRUE_; - expok = TRUE_; - bpiok = TRUE_; - doint = TRUE_; - roundd = TRUE_; - roundi = TRUE_; - -/* Here's some other facts. */ - -/* We are not parsing the decimal part of the string. */ -/* We are not parsing the exponent part of the string. */ -/* We have not encountered any digits in the mantissa. */ -/* We have not encountered any significant characters. */ -/* It's not ok for the next character to be the end of pi (i). */ - - dodec = FALSE_; - doexp = FALSE_; - mantsa = FALSE_; - sigchr = FALSE_; - epiok = FALSE_; - -/* So far there is no integer, decimal or exponent part to this */ -/* string. */ - - intval = 0.; - decval = 0.; - expval = 0.; - divisr = 1.; - factor = 1.; - ecount = 0.; - -/* Right now if we encounter a sign, it's part of the mantissa. */ -/* And until we know better the sign of both the mantissa and */ -/* exponent are +1 (as opposed to -1). */ - - signdx = 1; - dpsign[0] = 1.; - dpsign[1] = 1.; - -/* Before doing anything else we determine whether or not */ -/* the input string is empty. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - s_copy(error, blnkst, error_len, (ftnlen)160); - *ptr = 1; - return 0; - } - -/* We need to find the last non-blank character of the input */ -/* string. We shall use the idea of binary searching to locate */ -/* this character. At first this may appear to be a bit convoluted */ -/* when compared to the obvious thing to do (start at the end of */ -/* the string and step backward until a non-blank character is */ -/* located). However, on every machine we've looked at this method */ -/* locates the last non-blank character much more quickly on average */ -/* than the obvious method. */ - -/* L and B denote the last and beginning characters */ -/* of the substring we are searching. NL is the next to last */ -/* character that we are concerned with and M is the middle of */ -/* the current search interval ( from B to NL ). */ - - l = i_len(string, string_len); - b = 1; - nl = l - 1; - -/* We want M to be ( B + NL ) / 2 but right now that's L/2 */ - - m = l / 2; - while(l - b > 16) { - -/* What is true right now? The string from L+1 on out */ -/* is blank. L > B; L-1 = NL >= B; M = (B + NL) / 2; */ -/* and M >= B, B is at least one and if greater than 1 */ -/* there must be a non-blank character between B and the */ -/* end of the string. */ - - if (*(unsigned char *)&string[l - 1] != blank) { - b = l; - } else if (s_cmp(string + (m - 1), " ", nl - (m - 1), (ftnlen)1) == 0) - { - -/* If you got here, the STRING(L:L) is a blank. */ -/* The string from L+1 on out is blank. */ -/* The string from M to NL (=L-1) is blank. Thus the */ -/* string from M out is blank. */ - -/* M is greater than or equal to B. */ -/* If M is less than B + 2, then L will become */ -/* B or less and there will not be a */ -/* next pass through the loop. That means that */ -/* we will never get to this point again and don't */ -/* have to worry about the reference STRING(M:NL) */ -/* giving us an access violation. */ - - l = m - 1; - -/* With the new value of L, we now know that STRING(L+1:) */ -/* is blank. */ - - } else { - -/* If you get to this point all of the string from */ -/* L out is blank and L is greater than M. */ -/* There is a non-blank character between M and NL. */ -/* If L should get within 16 of B, then the loop */ -/* will not be executed again. That means again that */ -/* we don't have to worry about STRING(M:NL) being */ -/* an ill formed string. */ - - l = nl; - b = m; - -/* With the new value of L, we now know that STRING(L+1:) */ -/* is blank. */ - - } - -/* Finally compute NL,the index of the character that precedes */ -/* L and the new midpoint of the stuff from B to NL. */ - - nl = l - 1; - m = (b + nl) / 2; - -/* What's true now? The string from L+1 on out is blank. */ - - } - -/* L is now within 16 characters of the last non-blank character */ -/* of the input string. We simply search backward from L to */ -/* locate this last non-blank. */ - - while(*(unsigned char *)&string[l - 1] == blank) { - --l; - } - -/* Begin to collect the number in its various parts: an integer */ -/* portion, a fractional portion, and an exponent. */ - - i__1 = l; - for (i__ = 1; i__ <= i__1; ++i__) { - id = *(unsigned char *)&string[i__ - 1]; - if (id > 128 || id < 0) { - -/* This is definitely not expected. Set the error message */ -/* and return. */ - - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpch, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - -/* The action taken depends upon the class of the token. */ - - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)739)] == 1) { - -/* Once a digit has been encountered, we can no longer */ -/* allow the string 'PI' or a sign until an exponent */ -/* character is hit and resets the SIGNOK flag. */ - - bpiok = FALSE_; - epiok = FALSE_; - signok = FALSE_; - sigchr = TRUE_; - -/* If we are constructing the integer part ... */ - - if (doint) { - mantsa = TRUE_; - -/* Check the current value of the integer part to */ -/* make sure we don't overflow. */ - - if (intval < intbnd) { - intval = intval * 10. + values[(i__2 = id - 1) < 128 && 0 - <= i__2 ? i__2 : s_rnge("values", i__2, "nparsd_", - (ftnlen)761)]; - } else { - -/* Once the integer exceeds a given bound, */ -/* we add the rest on as fractional part and */ -/* keep track of the factor we will need to */ -/* multiply the decimal part by to scale things */ -/* appropriately. We also keep track of the number */ -/* we will need to add to the exponent part. */ - - ecount += 1; - factor /= 10.; - if (roundi) { - roundi = FALSE_; - if (values[(i__2 = id - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("values", i__2, "nparsd_", (ftnlen) - 779)] > 5.) { - intval += 1.; - } - } - } - -/* ... or the decimal part ... */ - - } else if (dodec) { - mantsa = TRUE_; - -/* There are two cases to consider. The case in which */ -/* the integer portion of the string has value 0... */ - - if (zeroi) { - -/* We can just keep accumulating the decimal part */ -/* as an integer. But we keep track of how many */ -/* places past the decimal point the first non-zero */ -/* digit occurs. Note that once the decimal part */ -/* exceeds the integer bound, we don't need to do */ -/* anything. The remaining digits cannot contribute */ -/* to the value of the decimal part. */ - - if (decval < intbnd) { - decval = decval * 10. + values[(i__2 = id - 1) < 128 - && 0 <= i__2 ? i__2 : s_rnge("values", i__2, - "nparsd_", (ftnlen)808)]; - ecount += -1; - } else if (roundd) { - roundd = FALSE_; - if (values[(i__2 = id - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("values", i__2, "nparsd_", (ftnlen) - 815)] >= 5.) { - decval += 1.; - } - } - -/* ...and the case in which the integer portion is not */ -/* zero. */ - - } else { - -/* In this case, we know there is at least _something_ */ -/* to the integer part of this string. We can */ -/* stop accumulating the decimal part when the divisor */ -/* portion exceeds the integer barrier. After that */ -/* the extra digits can't make any contribution to */ -/* the double precision value given to the string. */ - - if (divisr < intbnd) { - decval = decval * 10. + values[(i__2 = id - 1) < 128 - && 0 <= i__2 ? i__2 : s_rnge("values", i__2, - "nparsd_", (ftnlen)835)]; - divisr *= 10.; - } - } - -/* ...or the exponent part of the string. */ - - } else if (doexp) { - if (expval + ecount > maxexp) { - -/* This number is too big to put into a double */ -/* precision number. The marginal case where */ -/* EXPVAL + ECOUNT .EQ. MAXEXP will be dealt */ -/* with when the integer and fractional parts */ -/* of the double precision number are built */ -/* at the end of this routine. */ - - s_copy(error, toobig, error_len, (ftnlen)160); - *ptr = i__; - return 0; - } else if (expval + ecount < minexp) { - -/* This number is going to underflow, we can */ -/* just stop accumulating exponent. But we don't */ -/* stop parsing the string yet. There might be */ -/* a bad character lurking somewhere later in the */ -/* string. */ - -/* NOTE: It is also possible to underflow when the */ -/* value of EXPVAL + ECOUNT is equal to MINEXP, */ -/* since an entire 'BASE' scale is not supported */ -/* for this particular exponent. */ - - } else { - -/* This is the case we expect. Just add on the */ -/* next part of the exponent. */ - - expval = expval * 10. + dpsign[1] * values[(i__2 = id - 1) - < 128 && 0 <= i__2 ? i__2 : s_rnge("values", - i__2, "nparsd_", (ftnlen)877)]; - } - -/* Even though this character is a digit, its not expected */ -/* for some reason. Set the error flag and return. */ - - } else { - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpch, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)898)] == 2) { - if (pntok) { - bpiok = FALSE_; - epiok = FALSE_; - pntok = FALSE_; - signok = FALSE_; - dodec = TRUE_; - doint = FALSE_; - doexp = FALSE_; - zeroi = intval == 0.; - } else { - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxppt, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)925)] == 3) { - sigchr = TRUE_; - if (expok) { - bpiok = FALSE_; - epiok = FALSE_; - expok = FALSE_; - pntok = FALSE_; - dodec = FALSE_; - doint = FALSE_; - doexp = TRUE_; - signok = TRUE_; - signdx = 2; - } else { - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpch, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)955)] == 7) { - if (signok) { - dpsign[(i__2 = signdx - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge( - "dpsign", i__2, "nparsd_", (ftnlen)959)] = values[( - i__3 = id - 1) < 128 && 0 <= i__3 ? i__3 : s_rnge( - "values", i__3, "nparsd_", (ftnlen)959)]; - signok = FALSE_; - } else { - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpsn, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)976)] == 5) { - sigchr = TRUE_; - if (bpiok) { - doint = FALSE_; - dodec = FALSE_; - doexp = FALSE_; - expok = FALSE_; - pntok = FALSE_; - bpiok = FALSE_; - signok = FALSE_; - epiok = TRUE_; - } else { - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpch, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)1005)] == 6) { - if (epiok) { - doint = FALSE_; - dodec = FALSE_; - doexp = FALSE_; - expok = FALSE_; - pntok = FALSE_; - bpiok = FALSE_; - signok = FALSE_; - epiok = FALSE_; - mantsa = TRUE_; - intval = pi_(); - } else { - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpch, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } else if (class__[(i__2 = id) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "nparsd_", (ftnlen)1035)] == 4) { - -/* We don't do anything. */ - - } else { - -/* This is definitely not expected. Set the error message */ -/* and return. */ - - nexti = i__ + 1; - thisi = i__; - zzinssub_(string, "]", &nexti, error, string_len, (ftnlen)1, - error_len); - zzinssub_(error, "[", &thisi, error, error_len, (ftnlen)1, - error_len); - prefix_(unxpch, &c__1, error, (ftnlen)160, error_len); - *ptr = i__; - return 0; - } - } - -/* If we got through the loop and it's OK to end PI, then we started */ -/* it but never finished. This is an error. */ - - if (epiok) { - s_copy(error, unrcst, error_len, (ftnlen)160); - *ptr = l; - return 0; - } - -/* Put together the portion that does not involve an exponent. */ - -/* If */ -/* (1) MANTSA = .TRUE., then we had some explicit part of a */ -/* number, an integer part, a fractional part, or both. */ - -/* (2) SIGCHR = .TRUE, then we had either: */ - -/* (a) MANTSA = .TRUE. */ - -/* or */ - -/* (b) there was an implicit value associated with the input */ -/* string. For example, an exponent character followed */ -/* by an optional exponent would produce a valid number: */ -/* E+10 --> 1.0d+10. This is due to the fact that this */ -/* routine emulates an RPN calculator of popular repute, */ -/* not because it is inherently a good idea. */ - - if (mantsa) { - -/* We had an integer part of the number, a fractional part, or */ -/* both, so we need to put them together in an appropriate */ -/* fashion. */ - - value = intval + decval / divisr * factor; - } else if (sigchr) { - -/* We do not have a mantissa, so we had an implicit mantissa, */ -/* see above, so we need to set the value to one. */ - - value = 1.; - } else { - -/* We have an error. There were no significant characters in the */ -/* input character string, and hence we could not parse it into */ -/* a number. An example of such a string would be: '+ ,,.,,'. */ -/* So, we will set an appropriate error message and return. */ - - s_copy(error, unrcst, error_len, (ftnlen)160); - *ptr = i_len(string, string_len) + 1; - return 0; - } - -/* Adjust the entered part of the exponent by the amount */ -/* we "shifted" the decimal point when we were computing */ -/* the integer and decimal values. */ - - expval += ecount; - -/* Now take care of the exponent contribution to the answer. */ - -/* If the exponent is negative ... */ - - if (expval < 0.) { - while(expval < -10.) { - value /= lookup[10]; - expval += 10.; - } - value /= lookup[(i__1 = -((integer) expval)) < 11 && 0 <= i__1 ? i__1 - : s_rnge("lookup", i__1, "nparsd_", (ftnlen)1139)]; - -/* If the exponent is positive ... */ - - } else if (expval > 0.) { - while(expval > 10.) { - -/* Make sure that a multiply isn't going to create */ -/* a number that overflows. */ - - if (value >= smlbnd) { - s_copy(error, toobig, error_len, (ftnlen)160); - *ptr = i_len(string, string_len) + 1; - return 0; - } else { - value *= lookup[10]; - expval += -10.; - } - } - exp__ = i_dnnt(&expval); - -/* Again, make sure that a floating point overflow isn't */ -/* going to happen. */ - - if (value < dpmax_() / lookup[(i__1 = exp__) < 11 && 0 <= i__1 ? i__1 - : s_rnge("lookup", i__1, "nparsd_", (ftnlen)1172)]) { - value *= lookup[(i__1 = exp__) < 11 && 0 <= i__1 ? i__1 : s_rnge( - "lookup", i__1, "nparsd_", (ftnlen)1174)]; - } else { - s_copy(error, toobig, error_len, (ftnlen)160); - *ptr = i_len(string, string_len) + 1; - return 0; - } - } - *x = dpsign[0] * value; - return 0; -} /* nparsd_ */ - diff --git a/ext/spice/src/cspice/nparsi.c b/ext/spice/src/cspice/nparsi.c deleted file mode 100644 index 840f6997c7..0000000000 --- a/ext/spice/src/cspice/nparsi.c +++ /dev/null @@ -1,341 +0,0 @@ -/* nparsi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NPARSI ( Integer parsing of a character string) */ -/* Subroutine */ int nparsi_(char *string, integer *n, char *error, integer * - pnter, ftnlen string_len, ftnlen error_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* Builtin functions */ - double d_int(doublereal *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal x; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - extern integer intmin_(void), intmax_(void); - static doublereal xmnint, xmxint; - -/* $ Abstract */ - -/* Parse a character string that represents a number and return */ -/* the FORTRAN-truncated integer value. */ - -/* $ 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 */ - -/* ALPHANUMERIC */ -/* CONVERSION */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* STRING I Character string representing a numeric value. */ -/* N O Translated integer value of STRING. */ -/* ERROR O Message indicating what errors have occurred. */ -/* PNTER O Position in character string where an error */ -/* occurred. */ - -/* $ Detailed_Input */ - -/* STRING A character string that represents a numeric value. */ -/* Commas and spaces may be used in this string for */ -/* ease of reading and writing the number. They */ -/* are treated as insignificant but non-error-producing */ -/* characters. */ - -/* For exponential representation and of the characters */ -/* 'E','D','e','d' may be used. */ - -/* The following are legitimate numeric expressions */ - -/* +12.2 e-1 */ -/* -3. 1415 9276 */ -/* 1e12 */ -/* E10 */ - -/* The program also recognizes the following mnemonics */ -/* 'PI', 'pi', 'Pi', 'pI' */ -/* '+PI', '+pi', '+Pi', '+pI' */ -/* '-PI', '-pi', '-Pi', '-pI' */ -/* and returns the value ( + OR - ) 3 as appropriate. */ - -/* $ Detailed_Output */ - -/* N Integer parsed value of input string ( with */ -/* the implied limits on precision). If an error is */ -/* encountered, N is not changed from whatever the */ -/* input value was. If the input string has a fractional */ -/* part, the fractional part will be truncated. Thus */ -/* 3.18 is interpreted as 3. -4.98 is interpreted as -4. */ - -/* ERROR This is a message indicating that the string could */ -/* not be parsed due to ambiguous use of symbols or */ -/* due to a string representing a number too large for */ -/* VAX double precision or integer variables. If no */ -/* error occurred, ERROR is blank. */ - -/* In particular, blank strings, or strings that do not */ -/* contain either a digit or exponent character will */ -/* be regarded as errors. */ - -/* PNTER This indicates which character was being used when */ -/* the error occurred. If no error occurred, PNTER is 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Basically, all this routine does is pass the input string to */ -/* NPARSD which does the parsing in double precision. If nothing */ -/* goes wrong in the double precision parsing of the number, the */ -/* returned value is checked to determine whether or not it will fit */ -/* into a VAX integer. If it doesn't, an error message is returned. */ - -/* $ Examples */ - -/* Let LINE = 'DELTA_T_A = 32' */ - -/* The following code fragment parses the line and obtains the */ -/* integer value. */ - - -/* CALL NEXTWD ( LINE, FIRST, REST ) */ -/* CALL NEXTWD ( REST, SECOND, REST ) */ -/* CALL NEXTWD ( REST, THIRD, REST ) */ - -/* CALL NPARSI ( THIRD, VALUE, ERROR, POINTR ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the string is non-numeric, PNTER indicates the location in */ -/* the string where the error occurred, and ERROR contains a */ -/* descriptive error message. */ - -/* 2) If the string is blank, ERROR is returned with a message */ -/* indicating the problem and PNTER will have a non-zero value. */ - -/* 3) If the string represents a number that is outside the range */ -/* of representable integers, as defined by INTMIN() and INTMAX(), */ -/* ERROR is returned with a message and PNTER is set to the value */ -/* 1, as the entire numeric string is at fault. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 29-APR-1996 (KRG) */ - -/* This subroutine was modified to return a non-zero value of */ -/* PNTER when the value returned by NPARSD is not a representable */ -/* integer, as defined by INTMIN() and INTMAX(). The value */ -/* returned is one (1), since the entire input string was not */ -/* correct. */ - -/* The test for an error from NPARSD was also changed. It now */ -/* uses the integer PNTER returned from NPARSD rather then the */ -/* character string ERROR. This should pose no problems because */ -/* PNTER is non-zero if and only if there was an error and an */ -/* error message was assigned to ERROR. */ - -/* Some extra, and unnecessary, assignments were deleted. The */ -/* assignments were: */ - -/* X = DBLE ( N ) */ - -/* ERROR = ' ' */ - -/* which converted the input argument into a double before */ -/* calling NPARSD with X and initialized the error message */ -/* to be blank. NPARSD sets the value for X, ERROR, and PNTER */ -/* unless an error occurs, in which case X is not changed. */ -/* So, it is not necessary to initialize ERROR, PNTER, or X. */ - -/* Finally, the values of INTMIN and INTMAX are only set on the */ -/* first call to the routine. They are now SAVEd. */ - -/* - SPICELIB Version 2.0.0, 15-OCT-1992 (WLT) */ - -/* The abstract of this routine was modified to reflect what */ -/* the routine actually does---truncate the value to an */ -/* integer. */ - -/* In addition, a blank string is no longer considered to be */ -/* valid input. */ - -/* Finally the instances of DFLOAT in the previous version were */ -/* replaced by the standard intrinsic function DBLE and the */ -/* function DINT was replaced by IDINT in one place to make types */ -/* match up on both sides of an assignment. */ - -/* - 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 */ - -/* parse a character_string to an integer */ - -/* -& */ - -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 29-APR-1996 (KRG) */ - -/* This subroutine was modified to return a non-zero value of */ -/* PNTER when the value returned by NPARSD is not a representable */ -/* integer, as defined by INTMIN() and INTMAX(). The value */ -/* returned is one (1), since the entire input string was not */ -/* correct. */ - -/* The test for an error from NPARSD was also changed. It now */ -/* uses the integer PNTER returned from NPARSD rather then the */ -/* character string ERROR. This should pose no problems because */ -/* PNTER is non-zero if and only if there was an error and an */ -/* error message was assigned to ERROR. */ - -/* Some extra, and unnecessary, assignments were deleted. The */ -/* assignments were: */ - -/* X = DBLE ( N ) */ - -/* ERROR = ' ' */ - -/* which converted the input argument into a double before */ -/* calling NPARSD with X and initialized the error message */ -/* to be blank. NPARSD sets the value for X, ERROR, and PNTER */ -/* unless an error occurs, in which case X is not changed. */ -/* So, it is not necessary to initialize ERROR, PNTER, or X. */ - -/* Finally, the values of INTMIN and INTMAX are only set on the */ -/* first call to the routine. They are now SAVEd. */ - -/* - SPICELIB Version 2.0.0, 15-OCT-1992 (WLT) */ - -/* The abstract of this routine was modified to reflect what */ -/* the routine actually does---truncate the value to an */ -/* integer. */ - -/* In addition, a blank string is no longer considered to be */ -/* valid input. */ - -/* Finally the instances of DFLOAT in the previous version were */ -/* replaced by the standard intrinsic function DBLE and the */ -/* function DINT was replaced by IDINT in one place to make types */ -/* match up on both sides of an assignment. */ - -/* - Beta Version 1.2.0, 23-FEB-1989 (WLT) */ - -/* Due to a programming error, the routine was not leaving N */ -/* unchanged if the input string was blank. This bug was */ -/* fixed and the exceptional case noted in exceptions. */ - -/* - Beta Version 1.1.0, 28-OCT-1988 (HAN) */ - -/* Peter Wolff (JPL) informed the NAIF staff that he found */ -/* an "IMPLICIT NONE" statement in the ANSI Standard Fortran */ -/* 77 version of this routine. Because the statement is a */ -/* VAX extension not used by NAIF, the statement was removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial values */ - - -/* If this is the first time NPARSI has been called, initialize */ -/* bounds for the range of integers. */ - - if (first) { - first = FALSE_; - xmxint = (doublereal) intmax_(); - xmnint = (doublereal) intmin_(); - } - -/* NPARSD will define ERROR and PNTER if there is an error, */ -/* so we do not need to initialize them here. */ - - nparsd_(string, &x, error, pnter, string_len, error_len); - if (*pnter == 0) { - if (d_int(&x) < xmnint || d_int(&x) > xmxint) { - *pnter = 1; - s_copy(error, "NPARSI: Value entered is beyond the bounds of rep" - "resentable integers.", error_len, (ftnlen)69); - } else { - *n = (integer) x; - } - } - return 0; -} /* nparsi_ */ - diff --git a/ext/spice/src/cspice/npedln.c b/ext/spice/src/cspice/npedln.c deleted file mode 100644 index 35608381a5..0000000000 --- a/ext/spice/src/cspice/npedln.c +++ /dev/null @@ -1,597 +0,0 @@ -/* npedln.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b12 = 2.; -static doublereal c_b26 = 0.; - -/* $Procedure NPEDLN ( Nearest point on ellipsoid to line ) */ -/* Subroutine */ int npedln_(doublereal *a, doublereal *b, doublereal *c__, - doublereal *linept, doublereal *linedr, doublereal *pnear, doublereal - *dist) -{ - /* System generated locals */ - integer i__1; - doublereal d__1, d__2; - - /* Builtin functions */ - double pow_dd(doublereal *, doublereal *); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal cand[9], scla, sclb, sclc, udir[3]; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - integer i__; - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found[2]; - doublereal prjel[9]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal sclpt[3], prjpl[4], prjpt[3]; - extern /* Subroutine */ int unorm_(doublereal *, doublereal *, doublereal - *), vprjp_(doublereal *, doublereal *, doublereal *), nvc2pl_( - doublereal *, doublereal *, doublereal *); - extern logical failed_(void); - doublereal candpl[4], pt[6] /* was [3][2] */; - extern /* Subroutine */ int inedpl_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *); - logical ifound; - extern /* Subroutine */ int pjelpl_(doublereal *, doublereal *, - doublereal *); - doublereal normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - doublereal oppdir[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen), vsclip_(doublereal *, - doublereal *), setmsg_(char *, ftnlen); - logical xfound; - extern /* Subroutine */ int npelpt_(doublereal *, doublereal *, - doublereal *, doublereal *), vprjpi_(doublereal *, doublereal *, - doublereal *, doublereal *, logical *); - doublereal prjnpt[3]; - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *), surfpt_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, logical *); - doublereal mag; - -/* $ Abstract */ - -/* Find nearest point on a triaxial ellipsoid to a specified line, */ -/* and the distance from the ellipsoid to the line. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* ELLIPSOID */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* A I Length of ellipsoid's semi-axis in the x direction */ -/* B I Length of ellipsoid's semi-axis in the y direction */ -/* C I Length of ellipsoid's semi-axis in the z direction */ -/* LINEPT I Point on line */ -/* LINEDR I Direction vector of line */ -/* PNEAR O Nearest point on ellipsoid to line */ -/* DIST O Distance of ellipsoid from line */ -/* UBEL P Upper bound of array containing SPICELIB ellipse. */ -/* UBPL P Upper bound of array containing SPICELIB plane. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B, */ -/* C are the lengths of the semi-axes of a triaxial */ -/* ellipsoid which is centered at the origin and */ -/* oriented so that its axes lie on the x-, y- and */ -/* z- coordinate axes. A, B, and C are the lengths of */ -/* the semi-axes that point in the x, y, and z */ -/* directions respectively. */ - -/* LINEPT */ -/* LINEDR are, respectively, a point and a direction vector */ -/* that define a line. The line is the set of vectors */ - -/* LINEPT + t * LINEDR */ - -/* where t is any real number. */ - -/* $ Detailed_Output */ - -/* PNEAR is the point on the ellipsoid that is closest to */ -/* the line, if the line doesn't intersect the */ -/* ellipsoid. */ - -/* If the line intersects the ellipsoid, PNEAR will */ -/* be a point of intersection. If LINEPT is outside */ -/* of the ellipsoid, PNEAR will be the closest point */ -/* of intersection. If LINEPT is inside the */ -/* ellipsoid, PNEAR will not necessarily be the */ -/* closest point of intersection. */ - - -/* DIST is the distance of the line from the ellipsoid. */ -/* This is the minimum distance between any point on */ -/* the line and any point on the ellipsoid. */ - -/* If the line intersects the ellipsoid, DIST is zero. */ - -/* $ Parameters */ - -/* UBEL is the upper bound of the array used to contain */ -/* a SPICELIB ellipse. See the ELLIPSES Required */ -/* Reading for details. */ - -/* UBPL is the upper bound of the array used to contain */ -/* a SPICELIB plane. See the PLANES Required Reading */ -/* for details. */ - -/* $ Exceptions */ - -/* If this routine detects an error, the output arguments NEARP and */ -/* DIST are not modified. */ - -/* 1) If the length of any semi-axis of the ellipsoid is */ -/* non-positive, the error SPICE(INVALIDAXISLENGTH) is signalled. */ - -/* 2) If the line's direction vector is the zero vector, the error */ -/* SPICE(ZEROVECTOR) is signalled. */ - -/* 3) If the length of any semi-axis of the ellipsoid is zero after */ -/* the semi-axis lengths are scaled by the reciprocal of the */ -/* magnitude of the longest semi-axis and then squared, the error */ -/* SPICE(DEGENERATECASE) is signalled. */ - -/* 4) If the input ellipsoid is extremely flat or needle-shaped */ -/* and has its shortest axis close to perpendicular to the input */ -/* line, numerical problems could cause this routine's algorithm */ -/* to fail, in which case the error SPICE(DEGENERATECASE) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For any ellipsoid and line, if the line does not intersect the */ -/* ellipsoid, there is a unique point on the ellipsoid that is */ -/* closest to the line. Therefore, the distance DIST between */ -/* ellipsoid and line is well-defined. The unique line segment of */ -/* length DIST that connects the line and ellipsoid is normal to */ -/* both of these objects at its endpoints. */ - -/* If the line intersects the ellipsoid, the distance between the */ -/* line and ellipsoid is zero. */ - -/* $ Examples */ - -/* 1) We can find the distance between an instrument optic axis ray */ -/* and the surface of a body modelled as a tri-axial ellipsoid */ -/* using this routine. If the instrument position and pointing */ -/* unit vector in body-fixed coordinates are */ - -/* LINEPT = ( 1.0D6, 2.0D6, 3.0D6 ) */ - -/* and */ - -/* LINEDR = ( -4.472091234D-1 */ -/* -8.944182469D-1, */ -/* -4.472091234D-3 ) */ - -/* and the body semi-axes lengths are */ - -/* A = 7.0D5 */ -/* B = 7.0D5 */ -/* C = 6.0D5, */ - -/* then the call to NPEDLN */ - -/* CALL NPEDLN ( A, B, C, */ -/* . LINEPT, LINEDR, */ -/* . PNEAR, DIST ) */ - -/* yields a value for PNEAR, the nearest point on the body to */ -/* the optic axis ray, of */ - - -/* ( -1.6333110792340931E+03, */ -/* -3.2666222157820771E+03, */ -/* 5.9999183350006724E+05 ) */ - -/* and a value for DIST, the distance to the ray, of */ - -/* 2.3899679338299707E+06 */ - -/* (These results were obtained on a PC-Linux system under g77.) */ - -/* In some cases, it may not be clear that the closest point */ -/* on the line containing an instrument boresight ray is on */ -/* the boresight ray itself; the point may lie on the ray */ -/* having the same vertex as the boresight ray and pointing in */ -/* the opposite direction. To rule out this possibility, we */ -/* can make the following test: */ - -/* C */ -/* C Find the difference vector between the closest point */ -/* C on the ellpsoid to the line containing the boresight */ -/* C ray and the boresight ray's vertex. Find the */ -/* C angular separation between this difference vector */ -/* C and the boresight ray. If the angular separation */ -/* C does not exceed pi/2, we have the nominal geometry. */ -/* C Otherwise, we have an error. */ -/* C */ -/* CALL VSUB ( PNEAR, LINEPT, DIFF ) */ -/* SEP = VSEP ( DIFF, LINEDR ) */ - -/* IF ( SEP .LE. HALFPI() ) THEN */ - -/* [ perform normal processing ] */ - -/* ELSE */ - -/* [ handle error case ] */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 15-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL calls. Changed exponents to DOUBLE PRECISION type */ -/* in the test for underflow of squared, scaled axis lengths. */ - -/* - SPICELIB Version 1.2.1, 06-DEC-2002 (NJB) */ - -/* Outputs shown in header example have been corrected to */ -/* be consistent with those produced by this routine. */ - -/* - SPICELIB Version 1.2.0, 25-NOV-1992 (NJB) */ - -/* Bug fix: in the intercept case, PNEAR is now properly */ -/* re-scaled prior to output. Also, an error in the $Examples */ -/* section was corrected. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 04-DEC-1990 (NJB) */ - -/* Error message and description changed for non-positive */ -/* axis length error. */ - -/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* distance between line and ellipsoid */ -/* distance between line of sight and body */ -/* nearest point on ellipsoid to line */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 15-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL calls. Changed exponents to DOUBLE PRECISION type */ -/* in the test for underflow of squared, scaled axis lengths. */ - -/* - SPICELIB Version 1.2.0, 25-NOV-1992 (NJB) */ - -/* Bug fix: in the intercept case, PNEAR is now properly */ -/* re-scaled prior to output. Formerly, it was returned without */ -/* having been re-scaled. */ - -/* Also, an error in the $Examples section was corrected: the */ -/* line */ - -/* CALL VSUB ( LINEPT, PNEAR, DIFF ) */ - -/* was replaced by */ - -/* CALL VSUB ( PNEAR, LINEPT, DIFF ) */ - -/* The in-line comments were re-arranged slightly, and the claim */ -/* that the inverse orthogonal projection of PRJNPT is guaranteed */ -/* to exist was removed. (The check for this exception was already */ -/* being done.) */ - - -/* - SPICELIB Version 1.1.0, 04-DEC-1990 (NJB) */ - -/* Error message and description changed for non-positive */ -/* axis length error. The former message and description did */ -/* not match, and the description was incorrect: it described */ -/* `zero-length', rather than `non-positive' axes as invalid. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NPEDLN", (ftnlen)6); - } - -/* The algorithm used in this routine has two parts. The first */ -/* part handles the case where the input line and ellipsoid */ -/* intersect. Our procedure is simple in that case; we just */ -/* call SURFPT twice, passing it first one ray determined by the */ -/* input line, then a ray pointing in the opposite direction. */ -/* The second part of the algorithm handles the case where SURFPT */ -/* doesn't find an intersection. */ - -/* Finding the nearest point on the ellipsoid to the line, when the */ -/* two do not intersect, is a matter of following four steps: */ - -/* 1) Find the points on the ellipsoid where the surface normal */ -/* is normal to the line's direction. This set of points is */ -/* an ellipse centered at the origin. The point we seek MUST */ -/* lie on this `candidate' ellipse. */ - -/* 2) Project the candidate ellipse onto a plane that is normal */ -/* to the line's direction. This projection preserves */ -/* distance from the line; the nearest point to the line on */ -/* this new ellipse is the projection of the nearest point to */ -/* the line on the candidate ellipse, and these two points are */ -/* exactly the same distance from the line. If computed using */ -/* infinite-precision arithmetic, this projection would be */ -/* guaranteed to be non-degenerate as long as the input */ -/* ellipsoid were non-degenerate. This can be verified by */ -/* taking the inner product of the scaled normal to the candidate */ -/* ellipse plane and the line's unitized direction vector */ -/* (these vectors are called NORMAL and UDIR in the code below); */ -/* the inner product is strictly greater than 1 if the ellipsoid */ -/* is non-degenerate. */ - -/* 3) The nearest point on the line to the projected ellipse will */ -/* be contained in the plane onto which the projection is done; */ -/* we find this point and then find the nearest point to it on */ -/* the projected ellipse. The distance between these two points */ -/* is the distance between the line and the ellipsoid. */ - -/* 4) Finally, we find the point on the candidate ellipse that was */ -/* projected to the nearest point to the line on the projected */ -/* ellipse that was found in step 3. This is the nearest point */ -/* on the ellipsoid to the line. */ - - - - -/* Glossary of Geometric Variables */ - - -/* A, */ -/* B, */ -/* C Input ellipsoid's semi-axis lengths. */ - -/* POINT Point of intersection of line and ellipsoid */ -/* if the intersection is non-empty. */ - -/* CANDPL Plane containing candidate ellipse. */ - -/* NORMAL Normal vector to the candidate plane CANDPL. */ - -/* CAND Candidate ellipse. */ - -/* LINEPT, */ -/* LINEDR, Point and direction vector on input line. */ - -/* UDIR Unitized line direction vector. */ - -/* PRJPL Projection plane; the candidate ellipse is */ -/* projected onto this plane to yield PRJEL. */ - -/* PRJEL Projection of the candidate ellipse CAND onto */ -/* the projection plane PRJEL. */ - -/* PRJPT Projection of line point. */ - -/* PRJNPT Nearest point on projected ellipse to */ -/* projection of line point. */ - -/* PNEAR Nearest point on ellipsoid to line. */ - - - -/* We need a valid normal vector. */ - - unorm_(linedr, udir, &mag); - if (mag == 0.) { - setmsg_("Line direction vector is the zero vector. ", (ftnlen)42); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("NPEDLN", (ftnlen)6); - return 0; - -/* The ellipsoid's semi-axes must have positive length. */ - - } else if (*a <= 0. || *b <= 0. || *c__ <= 0.) { - setmsg_("Semi-axes: A = #, B = #, C = #.", (ftnlen)33); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24); - chkout_("NPEDLN", (ftnlen)6); - return 0; - } - -/* Scale the semi-axes lengths for better numerical behavior. */ -/* If squaring any one of the scaled lengths causes it to */ -/* underflow to zero, we have an error. Otherwise, scale the */ -/* point on the input line too. */ - -/* Computing MAX */ - d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__); - scale = max(d__1,d__2); - scla = *a / scale; - sclb = *b / scale; - sclc = *c__ / scale; - if (pow_dd(&scla, &c_b12) == 0. || pow_dd(&sclb, &c_b12) == 0. || pow_dd(& - sclc, &c_b12) == 0.) { - setmsg_("Semi-axis too small: A = #, B = #, C = #. ", (ftnlen)43); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("NPEDLN", (ftnlen)6); - return 0; - } - -/* Scale LINEPT. Because SCALE might be a very small number, */ -/* we avoid computing 1/SCALE; that's why we don't call VSCL here. */ - - sclpt[0] = linept[0] / scale; - sclpt[1] = linept[1] / scale; - sclpt[2] = linept[2] / scale; - -/* Hand off the intersection case to SURFPT. SURFPT determines */ -/* whether rays intersect a body, so we treat the line as a pair */ -/* of rays. */ - - vminus_(udir, oppdir); - surfpt_(sclpt, udir, &scla, &sclb, &sclc, pt, found); - surfpt_(sclpt, oppdir, &scla, &sclb, &sclc, &pt[3], &found[1]); - for (i__ = 1; i__ <= 2; ++i__) { - if (found[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("found", - i__1, "npedln_", (ftnlen)527)]) { - *dist = 0.; - vscl_(&scale, &pt[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("pt", i__1, "npedln_", (ftnlen)531)], pnear); - chkout_("NPEDLN", (ftnlen)6); - return 0; - } - } - -/* Getting here means the line doesn't intersect the ellipsoid. */ - -/* Find the candidate ellipse CAND. NORMAL is a normal vector to */ -/* the plane containing the candidate ellipse. Mathematically the */ -/* ellipse must exist, since it's the intersection of an ellipsoid */ -/* centered at the origin and a plane containing the origin. Only */ -/* numerical problems can prevent the intersection from being found. */ - - -/* Computing 2nd power */ - d__1 = scla; - normal[0] = udir[0] / (d__1 * d__1); -/* Computing 2nd power */ - d__1 = sclb; - normal[1] = udir[1] / (d__1 * d__1); -/* Computing 2nd power */ - d__1 = sclc; - normal[2] = udir[2] / (d__1 * d__1); - nvc2pl_(normal, &c_b26, candpl); - inedpl_(&scla, &sclb, &sclc, candpl, cand, &xfound); - if (! xfound) { - setmsg_("Candidate ellipse could not be found.", (ftnlen)37); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("NPEDLN", (ftnlen)6); - return 0; - } - -/* Project the candidate ellipse onto a plane orthogonal to the */ -/* line. We'll call the plane PRJPL and the projected ellipse PRJEL. */ - - nvc2pl_(udir, &c_b26, prjpl); - pjelpl_(cand, prjpl, prjel); - -/* Find the point on the line lying in the projection plane, and */ -/* then find the near point PRJNPT on the projected ellipse. Here */ -/* PRJPT is the point on the line lying in the projection plane. */ -/* The distance between PRJPT and PRJNPT is DIST. */ - - - vprjp_(sclpt, prjpl, prjpt); - npelpt_(prjpt, prjel, prjnpt, dist); - if (failed_()) { - chkout_("NPEDLN", (ftnlen)6); - return 0; - } - -/* Find the near point PNEAR on the ellipsoid by taking the inverse */ -/* orthogonal projection of PRJNPT; this is the point on the */ -/* candidate ellipse that projects to PRJNPT. Note that the */ -/* output DIST was computed in step 3 and needs only to be re-scaled. */ - -/* The inverse projection of PNEAR ought to exist, but may not */ -/* be calculable due to numerical problems (this can only happen */ -/* when the input ellipsoid is extremely flat or needle-shaped). */ - - vprjpi_(prjnpt, prjpl, candpl, pnear, &ifound); - if (! ifound) { - setmsg_("Inverse projection could not be found.", (ftnlen)38); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("NPEDLN", (ftnlen)6); - return 0; - } - -/* Undo the scaling. */ - - vsclip_(&scale, pnear); - *dist = scale * *dist; - chkout_("NPEDLN", (ftnlen)6); - return 0; -} /* npedln_ */ - diff --git a/ext/spice/src/cspice/npedln_c.c b/ext/spice/src/cspice/npedln_c.c deleted file mode 100644 index f42bb35143..0000000000 --- a/ext/spice/src/cspice/npedln_c.c +++ /dev/null @@ -1,564 +0,0 @@ -/* - --Procedure npedln_c ( Nearest point on ellipsoid to line ) - --Abstract - - Find nearest point on a triaxial ellipsoid to a specified line, - and the distance from the ellipsoid to the line. - --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 - - ELLIPSES - --Keywords - - ELLIPSOID - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef npedln_c - - - void npedln_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble linept[3], - ConstSpiceDouble linedr[3], - SpiceDouble pnear[3], - SpiceDouble * dist ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - a I Length of ellipsoid's semi-axis in the x direction - b I Length of ellipsoid's semi-axis in the y direction - c I Length of ellipsoid's semi-axis in the z direction - linept I Point on line - linedr I Direction vector of line - pnear O Nearest point on ellipsoid to line - dist O Distance of ellipsoid from line - --Detailed_Input - - a, - b, - c are the lengths of the semi-axes of a triaxial - ellipsoid which is centered at the origin and - oriented so that its axes lie on the x-, y- and - z- coordinate axes. a, b, and c are the lengths of - the semi-axes that point in the x, y, and z - directions respectively. - - linept - linedr are, respectively, a point and a direction vector - that define a line. The line is the set of vectors - - linept + t * linedr - - where t is any real number. - --Detailed_Output - - pnear is the point on the ellipsoid that is closest to - the line, if the line doesn't intersect the - ellipsoid. - - If the line intersects the ellipsoid, pnear will - be a point of intersection. If linept is outside - of the ellipsoid, pnear will be the closest point - of intersection. If linept is inside the - ellipsoid, pnear will not necessarily be the - closest point of intersection. - - - dist is the distance of the line from the ellipsoid. - This is the minimum distance between any point on - the line and any point on the ellipsoid. - - If the line intersects the ellipsoid, dist is zero. - --Parameters - - None. - --Exceptions - - If this routine detects an error, the output arguments nearp and - dist are not modified. - - 1) If the length of any semi-axis of the ellipsoid is - non-positive, the error SPICE(INVALIDAXISLENGTH) is signaled. - - 2) If the line's direction vector is the zero vector, the error - SPICE(ZEROVECTOR) is signaled. - - 3) If the length of any semi-axis of the ellipsoid is zero after - the semi-axis lengths are scaled by the reciprocal of the - magnitude of the longest semi-axis and then squared, the error - SPICE(DEGENERATECASE) is signaled. - - 4) If the input ellipsoid is extremely flat or needle-shaped - and has its shortest axis close to perpendicular to the input - line, numerical problems could cause this routine's algorithm - to fail, in which case the error SPICE(DEGENERATECASE) is - signaled. - --Files - - None. - --Particulars - - For any ellipsoid and line, if the line does not intersect the - ellipsoid, there is a unique point on the ellipsoid that is - closest to the line. Therefore, the distance dist between - ellipsoid and line is well-defined. The unique line segment of - length dist that connects the line and ellipsoid is normal to - both of these objects at its endpoints. - - If the line intersects the ellipsoid, the distance between the - line and ellipsoid is zero. - --Examples - - 1) We can find the distance between an instrument optic axis ray - and the surface of a body modelled as a tri-axial ellipsoid - using this routine. If the instrument position and pointing - unit vector in body-fixed coordinates are - - linept = ( 1.0e6, 2.0e6, 3.0e6 ) - - and - - linedr = ( -4.472091234e-1 - -8.944182469e-1, - -4.472091234e-3 ) - - and the body semi-axes lengths are - - a = 7.0e5 - b = 7.0e5 - c = 6.0e5, - - then the call to npedln_c - - npedln_c ( a, b, c, linept, linedr, pnear, &dist ); - - yields a value for pnear, the nearest point on the body to - the optic axis ray, of - - ( -.16333110792340931E+04, - -.32666222157820771E+04, - .59999183350006724E+06 ) - - and a value for dist, the distance to the ray, of - - .23899679338299707E+06 - - (These results were obtained on a PC-Linux system under gcc.) - - In some cases, it may not be clear that the closest point - on the line containing an instrument boresight ray is on - the boresight ray itself; the point may lie on the ray - having the same vertex as the boresight ray and pointing in - the opposite direction. To rule out this possibility, we - can make the following test: - - /. - Find the difference vector between the closest point - on the ellipsoid to the line containing the boresight - ray and the boresight ray's vertex. Find the - angular separation between this difference vector - and the boresight ray. If the angular separation - does not exceed pi/2, we have the nominal geometry. - Otherwise, we have an error. - ./ - - vsub_c ( pnear, linept, diff ); - - sep = vsep_c ( diff, linedr ); - - if ( sep <= halfpi_c() ) - { - [ perform normal processing ] - } - else - { - [ handle error case ] - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 01-JUN-2010 (NJB) - - Added touchd_ calls to tests for squared, scaled axis length - underflow. This forces rounding to zero in certain cases where - it otherwise might not occur due to use of extended registers. - - -CSPICE Version 1.0.1, 06-DEC-2002 (NJB) - - Outputs shown in header example have been corrected to - be consistent with those produced by this routine. - - -CSPICE Version 1.0.0, 03-SEP-1999 (NJB) - --Index_Entries - - distance between line and ellipsoid - distance between line of sight and body - nearest point on ellipsoid to line - --& -*/ - -{ /* Begin npedln_c */ - - - - /* - Local variables - */ - - SpiceBoolean found [2]; - SpiceBoolean ifound; - SpiceBoolean xfound; - - SpiceDouble oppdir [3]; - SpiceDouble mag; - SpiceDouble normal [3]; - SpiceDouble prjpt [3]; - SpiceDouble prjnpt [3]; - SpiceDouble pt [2][3]; - SpiceDouble scale; - SpiceDouble scla; - SpiceDouble scla2; - SpiceDouble sclb; - SpiceDouble sclb2; - SpiceDouble sclc; - SpiceDouble sclc2; - SpiceDouble sclpt [3]; - SpiceDouble udir [3]; - - SpiceEllipse cand; - SpiceEllipse prjel; - - SpiceInt i; - - SpicePlane candpl; - SpicePlane prjpl; - - - /* - Static variables - */ - - - /* - Participate in error tracing. - */ - - chkin_c ( "npedln_c" ); - - - - /* - The algorithm used in this routine has two parts. The first - part handles the case where the input line and ellipsoid - intersect. Our procedure is simple in that case; we just - call surfpt_c twice, passing it first one ray determined by the - input line, then a ray pointing in the opposite direction. - The second part of the algorithm handles the case where surfpt_c - doesn't find an intersection. - - Finding the nearest point on the ellipsoid to the line, when the - two do not intersect, is a matter of following four steps: - - 1) Find the points on the ellipsoid where the surface normal - is normal to the line's direction. This set of points is - an ellipse centered at the origin. The point we seek MUST - lie on this `candidate' ellipse. - - 2) Project the candidate ellipse onto a plane that is normal - to the line's direction. This projection preserves - distance from the line; the nearest point to the line on - this new ellipse is the projection of the nearest point to - the line on the candidate ellipse, and these two points are - exactly the same distance from the line. If computed using - infinite-precision arithmetic, this projection would be - guaranteed to be non-degenerate as long as the input - ellipsoid were non-degenerate. This can be verified by - taking the inner product of the scaled normal to the candidate - ellipse plane and the line's unitized direction vector - (these vectors are called normal and udir in the code below); - the inner product is strictly greater than 1 if the ellipsoid - is non-degenerate. - - 3) The nearest point on the line to the projected ellipse will - be contained in the plane onto which the projection is done; - we find this point and then find the nearest point to it on - the projected ellipse. The distance between these two points - is the distance between the line and the ellipsoid. - - 4) Finally, we find the point on the candidate ellipse that was - projected to the nearest point to the line on the projected - ellipse that was found in step 3. This is the nearest point - on the ellipsoid to the line. - - - - Glossary of Geometric Variables - - - a, - b, - c Input ellipsoid's semi-axis lengths. - - point Point of intersection of line and ellipsoid - if the intersection is non-empty. - - candpl Plane containing candidate ellipse. - - normal Normal vector to the candidate plane candpl. - - cand Candidate ellipse. - - linept, - linedr, Point and direction vector on input line. - - udir Unitized line direction vector. - - prjpl Projection plane; the candidate ellipse is - projected onto this plane to yield prjel. - - prjel Projection of the candidate ellipse cand onto - the projection plane prjel. - - prjpt Projection of line point. - - prjnpt Nearest point on projected ellipse to - projection of line point. - - pnear Nearest point on ellipsoid to line. - - */ - - - - /* - We need a valid normal vector. - */ - - unorm_c ( linedr, udir, &mag ); - - if ( mag == 0. ) - { - setmsg_c( "Line direction vector is the zero vector. " ); - sigerr_c( "SPICE(ZEROVECTOR)" ); - chkout_c( "npedln_c" ); - return; - } - - - if ( ( a <= 0. ) - || ( b <= 0. ) - || ( c <= 0. ) ) - { - setmsg_c ( "Semi-axis lengths: a = #, b = #, c = #." ); - errdp_c ( "#", a ); - errdp_c ( "#", b ); - errdp_c ( "#", c ); - sigerr_c ( "SPICE(INVALIDAXISLENGTH)" ); - chkout_c ( "npedln_c" ); - return; - } - - - /* - Scale the semi-axes lengths for better numerical behavior. - If squaring any one of the scaled lengths causes it to - underflow to zero, we cannot continue the computation. Otherwise, - scale the viewing point too. - */ - - scale = maxd_c ( 3, a, b, c ); - - scla = a / scale; - sclb = b / scale; - sclc = c / scale; - - scla2 = scla*scla; - sclb2 = sclb*sclb; - sclc2 = sclc*sclc; - - if ( ( (SpiceDouble)touchd_(&scla2) == 0. ) - || ( (SpiceDouble)touchd_(&sclb2) == 0. ) - || ( (SpiceDouble)touchd_(&sclc2) == 0. ) ) - { - setmsg_c ( "Semi-axis too small: a = #, b = #, c = #. " ); - errdp_c ( "#", a ); - errdp_c ( "#", b ); - errdp_c ( "#", c ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "npedln_c" ); - return; - } - - - /* - Scale linept. - */ - sclpt[0] = linept[0] / scale; - sclpt[1] = linept[1] / scale; - sclpt[2] = linept[2] / scale; - - /* - Hand off the intersection case to surfpt_c. surfpt_c determines - whether rays intersect a body, so we treat the line as a pair - of rays. - */ - - vminus_c ( udir, oppdir ); - - surfpt_c ( sclpt, udir, scla, sclb, sclc, pt[0], &(found[0]) ); - surfpt_c ( sclpt, oppdir, scla, sclb, sclc, pt[1], &(found[1]) ); - - for ( i = 0; i < 2; i++ ) - { - if ( found[i] ) - { - *dist = 0.0; - - vequ_c ( pt[i], pnear ); - vscl_c ( scale, pnear, pnear ); - chkout_c ( "npedln_c" ); - return; - } - } - - - /* - Getting here means the line doesn't intersect the ellipsoid. - - Find the candidate ellipse CAND. NORMAL is a normal vector to - the plane containing the candidate ellipse. Mathematically the - ellipse must exist, since it's the intersection of an ellipsoid - centered at the origin and a plane containing the origin. Only - numerical problems can prevent the intersection from being found. - */ - - normal[0] = udir[0] / scla2; - normal[1] = udir[1] / sclb2; - normal[2] = udir[2] / sclc2; - - nvc2pl_c ( normal, 0., &candpl ); - - inedpl_c ( scla, sclb, sclc, &candpl, &cand, &xfound ); - - if ( !xfound ) - { - setmsg_c ( "Candidate ellipse could not be found." ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "npedln_c" ); - return; - } - - /* - Project the candidate ellipse onto a plane orthogonal to the - line. We'll call the plane prjpl and the projected ellipse prjel. - */ - nvc2pl_c ( udir, 0., &prjpl ); - pjelpl_c ( &cand, &prjpl, &prjel ); - - - /* - Find the point on the line lying in the projection plane, and - then find the near point PRJNPT on the projected ellipse. Here - PRJPT is the point on the line lying in the projection plane. - The distance between PRJPT and PRJNPT is DIST. - */ - - vprjp_c ( sclpt, &prjpl, prjpt ); - npelpt_c ( prjpt, &prjel, prjnpt, dist ); - - - /* - Find the near point pnear on the ellipsoid by taking the inverse - orthogonal projection of prjnpt; this is the point on the - candidate ellipse that projects to prjnpt. Note that the - output dist was computed in step 3 and needs only to be re-scaled. - - The inverse projection of pnear ought to exist, but may not - be calculable due to numerical problems (this can only happen - when the input ellipsoid is extremely flat or needle-shaped). - */ - - vprjpi_c ( prjnpt, &prjpl, &candpl, pnear, &ifound ); - - if ( !ifound ) - { - setmsg_c ( "Inverse projection could not be found." ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "npedln_c" ); - return; - } - - /* - Undo the scaling. - */ - - vscl_c ( scale, pnear, pnear ); - - *dist *= scale; - - - chkout_c ( "npedln_c" ); - -} /* End npedln_c */ - diff --git a/ext/spice/src/cspice/npelpt.c b/ext/spice/src/cspice/npelpt.c deleted file mode 100644 index b291309a49..0000000000 --- a/ext/spice/src/cspice/npelpt.c +++ /dev/null @@ -1,367 +0,0 @@ -/* npelpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static doublereal c_b10 = 0.; -static doublereal c_b11 = 1.; -static doublereal c_b12 = 2.; - -/* $Procedure NPELPT ( Nearest point on ellipse to point ) */ -/* Subroutine */ int npelpt_(doublereal *point, doublereal *ellips, - doublereal *pnear, doublereal *dist) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ), vsub_(doublereal *, doublereal *, doublereal *), vequ_( - doublereal *, doublereal *), mtxv_(doublereal *, doublereal *, - doublereal *); - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen), vpack_(doublereal *, - doublereal *, doublereal *, doublereal *), errdp_(char *, - doublereal *, ftnlen); - extern doublereal vdist_(doublereal *, doublereal *); - doublereal tempv[3]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int el2cgv_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal majlen, center[3], minlen; - extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - doublereal smajor[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal rotate[9] /* was [3][3] */; - extern /* Subroutine */ int vsclip_(doublereal *, doublereal *), setmsg_( - char *, ftnlen); - doublereal sminor[3]; - extern /* Subroutine */ int twovec_(doublereal *, integer *, doublereal *, - integer *, doublereal *); - doublereal prjpnt[3]; - extern logical return_(void); - doublereal tmppnt[3]; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Find the nearest point on an ellipse to a specified point, both */ -/* in three-dimensional space, and find the distance between the */ -/* ellipse and the point. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* CONIC */ -/* ELLIPSE */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POINT I Point whose distance to an ellipse is to be found. */ -/* ELLIPS I A SPICELIB ellipse. */ -/* PNEAR O Nearest point on ellipse to input point. */ -/* DIST O Distance of input point to ellipse. */ - -/* $ Detailed_Input */ - -/* ELLIPS is a SPICELIB ellipse that represents an ellipse */ -/* in three-dimensional space. */ - -/* POINT is a point in 3-dimensional space. */ - -/* $ Detailed_Output */ - -/* PNEAR is the nearest point on ELLIPS to POINT. */ - -/* DIST is the distance between POINT and PNEAR. This is */ -/* the distance between POINT and the ellipse. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Invalid ellipses will be diagnosed by routines called by */ -/* this routine. */ - -/* 2) Ellipses having one or both semi-axis lengths equal to zero */ -/* are turned away at the door; the error SPICE(DEGENERATECASE) */ -/* is signalled. */ - -/* 3) If the geometric ellipse represented by ELLIPS does not */ -/* have a unique point nearest to the input point, any point */ -/* at which the minimum distance is attained may be returned */ -/* in PNEAR. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given an ellipse and a point in 3-dimensional space, if the */ -/* orthogonal projection of the point onto the plane of the ellipse */ -/* is on or outside of the ellipse, then there is a unique point on */ -/* the ellipse closest to the original point. This routine finds */ -/* that nearest point on the ellipse. If the projection falls inside */ -/* the ellipse, there may be multiple points on the ellipse that are */ -/* at the minimum distance from the original point. In this case, */ -/* one such closest point will be returned. */ - -/* This routine returns a distance, rather than an altitude, in */ -/* contrast to the SPICELIB routine NEARPT. Because our ellipse is */ -/* situated in 3-space and not 2-space, the input point is not */ -/* `inside' or `outside' the ellipse, so the notion of altitude does */ -/* not apply to the problem solved by this routine. In the case of */ -/* NEARPT, the input point is on, inside, or outside the ellipsoid, */ -/* so it makes sense to speak of its altitude. */ - -/* $ Examples */ - -/* 1) For planetary rings that can be modelled as flat disks with */ -/* elliptical outer boundaries, the distance of a point in */ -/* space from a ring's outer boundary can be computed using this */ -/* routine. Suppose CENTER, SMAJOR, and SMINOR are the center, */ -/* semi-major axis, and semi-minor axis of the ring's boundary. */ -/* Suppose also that SCPOS is the position of a spacecraft. */ -/* SCPOS, CENTER, SMAJOR, and SMINOR must all be expressed in */ -/* the same coordinate system. We can find the distance from */ -/* the spacecraft to the ring using the code fragment */ - -/* C */ -/* C Make a SPICELIB ellipse representing the ring, */ -/* C then use NPELPT to find the distance between */ -/* C the spacecraft position and RING. */ -/* C */ -/* CALL CGV2EL ( CENTER, SMAJOR, SMINOR, RING ) */ -/* CALL NPELPT ( SCPOS, RING, PNEAR, DIST ) */ - - -/* 2) The problem of finding the distance of a line from a tri-axial */ -/* ellipsoid can be reduced to the problem of finding the */ -/* distance between the same line and an ellipse; this problem in */ -/* turn can be reduced to the problem of finding the distance */ -/* between an ellipse and a point. The routine NPEDLN carries */ -/* out this process and uses NPELPT to find the ellipse-to-point */ -/* distance. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD, VSCL, MTXV and MXV calls. */ - -/* - 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, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* nearest point on ellipse to point */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD, VSCL, MTXV and MXV calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NPELPT", (ftnlen)6); - } - -/* Here's an overview of our solution: */ - -/* Let ELPL be the plane containing the ELLIPS, and let PRJ be */ -/* the orthogonal projection of the POINT onto ELPL. Let X be */ -/* any point in the plane ELPL. According to the Pythagorean */ -/* Theorem, */ - -/* 2 2 2 */ -/* || POINT - X || = || POINT - PRJ || + || PRJ - X ||. */ - -/* Then if we can find a point X on ELLIPS that minimizes the */ -/* rightmost term, that point X is the closest point on the */ -/* ellipse to POINT. */ - -/* So, we find the projection PRJ, and then solve the problem of */ -/* finding the closest point on ELLIPS to PRJ. To solve this */ -/* problem, we find a triaxial ellipsoid whose intersection with */ -/* the plane ELPL is precisely ELLIPS, and two of whose axes lie */ -/* in the plane ELPL. The closest point on ELLIPS to PRJ is also */ -/* the closest point on the ellipsoid to ELLIPS. But we have the */ -/* SPICELIB routine NEARPT on hand to find the closest point on an */ -/* ellipsoid to a specified point, so we've reduced our problem to */ -/* a solved problem. */ - -/* There is a subtle point to worry about here: if PRJ is outside */ -/* of ELLIPS (PRJ is in the same plane as ELLIPS, so `outside' */ -/* does make sense here), then the closest point on ELLIPS to PRJ */ -/* coincides with the closest point on the ellipsoid to PRJ, */ -/* regardless of how we choose the z-semi-axis length of the */ -/* ellipsoid. But the correspondence may be lost if PRJ is inside */ -/* the ellipse, if we don't choose the z-semi-axis length */ -/* correctly. */ - -/* Though it takes some thought to verify this (and we won't prove */ -/* it here), making the z-semi-axis of the ellipsoid longer than */ -/* the other two semi-axes is sufficient to maintain the */ -/* coincidence of the closest point on the ellipsoid to PRJPNT and */ -/* the closest point on the ellipse to PRJPNT. */ - - -/* Find the ellipse's center and semi-axes. */ - - el2cgv_(ellips, center, smajor, sminor); - -/* Find the lengths of the semi-axes, and scale the vectors to try */ -/* to prevent arithmetic unpleasantness. Degenerate ellipses are */ -/* turned away at the door. */ - - minlen = vnorm_(sminor); - majlen = vnorm_(smajor); - if (min(majlen,minlen) == 0.) { - setmsg_("Semi-axis lengths: # #. ", (ftnlen)24); - errdp_("#", &majlen, (ftnlen)1); - errdp_("#", &minlen, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("NPELPT", (ftnlen)6); - return 0; - } - scale = 1. / majlen; - vsclip_(&scale, smajor); - vsclip_(&scale, sminor); - -/* Translate ellipse and point so that the ellipse is centered at */ -/* the origin. Scale the point's coordinates to maintain the */ -/* correct relative position to the scaled ellipse. */ - - vsub_(point, center, tmppnt); - vsclip_(&scale, tmppnt); - -/* We want to reduce the problem to a two-dimensional one. We'll */ -/* work in a coordinate system whose x- and y- axes are aligned with */ -/* the semi-major and semi-minor axes of the input ellipse. The */ -/* z-axis is picked to give us a right-handed system. We find the */ -/* matrix that transforms coordinates to our new system using TWOVEC. */ - - twovec_(smajor, &c__1, sminor, &c__2, rotate); - -/* Apply the coordinate transformation to our scaled input point. */ - - mxv_(rotate, tmppnt, tempv); - vequ_(tempv, tmppnt); - -/* We must find the distance between the orthogonal projection of */ -/* TMPPNT onto the x-y plane and the ellipse. The projection is */ -/* just */ - -/* ( TMPPNT(1), TMPPNT(2), 0 ); */ - -/* we'll call this projection PRJPNT. */ - - - vpack_(tmppnt, &tmppnt[1], &c_b10, prjpnt); - -/* Now we're ready to find the distance between and a triaxial */ -/* ellipsoid whose intersection with the x-y plane is the ellipse */ -/* and whose third semi-axis lies on the z-axis. */ - -/* Because we've scaled the ellipse's axes so as to give the longer */ -/* axis length 1, a length of 2.D0 suffices for the ellipsoid's */ -/* z-semi-axis. */ - - -/* Find the nearest point to PRJPNT on the ellipoid, PNEAR. */ - - d__1 = minlen / majlen; - nearpt_(prjpnt, &c_b11, &d__1, &c_b12, pnear, dist); - -/* Scale the near point coordinates back to the original scale. */ - - vsclip_(&majlen, pnear); - -/* Apply the required inverse rotation and translation to PNEAR. */ -/* Compute the point-to-ellipse distance. */ - - mtxv_(rotate, pnear, tempv); - vadd_(tempv, center, pnear); - *dist = vdist_(pnear, point); - chkout_("NPELPT", (ftnlen)6); - return 0; -} /* npelpt_ */ - diff --git a/ext/spice/src/cspice/npelpt_c.c b/ext/spice/src/cspice/npelpt_c.c deleted file mode 100644 index b8780c1313..0000000000 --- a/ext/spice/src/cspice/npelpt_c.c +++ /dev/null @@ -1,352 +0,0 @@ -/* - --Procedure npelpt_c ( Nearest point on ellipse to point ) - --Abstract - - Find the nearest point on an ellipse to a specified point, both - in three-dimensional space, and find the distance between the - ellipse and the point. - --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 - - ELLIPSES - --Keywords - - CONIC - ELLIPSE - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef npelpt_c - - - void npelpt_c ( ConstSpiceDouble point [3], - ConstSpiceEllipse * ellips, - SpiceDouble pnear [3], - SpiceDouble * dist ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - point I Point whose distance to an ellipse is to be found. - ellips I A CSPICE ellipse. - pnear O Nearest point on ellipse to input point. - dist O Distance of input point to ellipse. - --Detailed_Input - - ellips is a CSPICE ellipse that represents an ellipse - in three-dimensional space. - - point is a point in 3-dimensional space. - --Detailed_Output - - pnear is the nearest point on ellips to point. - - dist is the distance between point and pnear. This is - the distance between point and the ellipse. - --Parameters - - None. - --Exceptions - - 1) Invalid ellipses will be diagnosed by routines called by - this routine. - - 2) Ellipses having one or both semi-axis lengths equal to zero - are turned away at the door; the error SPICE(DEGENERATECASE) - is signalled. - - 3) If the geometric ellipse represented by ellips does not - have a unique point nearest to the input point, any point - at which the minimum distance is attained may be returned - in pnear. - --Files - - None. - --Particulars - - Given an ellipse and a point in 3-dimensional space, if the - orthogonal projection of the point onto the plane of the ellipse - is on or outside of the ellipse, then there is a unique point on - the ellipse closest to the original point. This routine finds - that nearest point on the ellipse. If the projection falls inside - the ellipse, there may be multiple points on the ellipse that are - at the minimum distance from the original point. In this case, - one such closest point will be returned. - - This routine returns a distance, rather than an altitude, in - contrast to the CSPICE routine nearpt_c. Because our ellipse is - situated in 3-space and not 2-space, the input point is not - `inside' or `outside' the ellipse, so the notion of altitude does - not apply to the problem solved by this routine. In the case of - nearpt_c, the input point is on, inside, or outside the ellipsoid, - so it makes sense to speak of its altitude. - --Examples - - 1) For planetary rings that can be modelled as flat disks with - elliptical outer boundaries, the distance of a point in - space from a ring's outer boundary can be computed using this - routine. Suppose center, smajor, and sminor are the center, - semi-major axis, and semi-minor axis of the ring's boundary. - Suppose also that scpos is the position of a spacecraft. - scpos, center, smajor, and sminor must all be expressed in - the same coordinate system. We can find the distance from - the spacecraft to the ring using the code fragment - - #include "SpiceUsr.h" - . - . - . - /. - Make a CSPICE ellipse representing the ring, - then use npelpt_c to find the distance between - the spacecraft position and RING. - ./ - cgv2el_c ( center, smajor, sminor, ring ); - npelpt_c ( scpos, ring, pnear, &dist ); - - - - 2) The problem of finding the distance of a line from a tri-axial - ellipsoid can be reduced to the problem of finding the - distance between the same line and an ellipse; this problem in - turn can be reduced to the problem of finding the distance - between an ellipse and a point. The routine npedln_c carries - out this process and uses npelpt_c to find the ellipse-to-point - distance. - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 02-SEP-1999 (NJB) - --Index_Entries - - nearest point on ellipse to point - --& -*/ - -{ /* Begin npelpt_c */ - - - /* - Local variables - */ - - SpiceDouble center [3]; - SpiceDouble majlen; - SpiceDouble minlen; - SpiceDouble rotate [3][3]; - SpiceDouble scale; - SpiceDouble smajor [3]; - SpiceDouble sminor [3]; - SpiceDouble tmppnt [3]; - SpiceDouble prjpnt [3]; - - - /* - Participate in error tracing. - */ - chkin_c ( "npelpt_c" ); - - - /* - Here's an overview of our solution: - - Let ELPL be the plane containing the ELLIPS, and let PRJ be - the orthogonal projection of the POINT onto ELPL. Let X be - any point in the plane ELPL. According to the Pythagorean - Theorem, - - 2 2 2 - || POINT - X || = || POINT - PRJ || + || PRJ - X ||. - - Then if we can find a point X on ELLIPS that minimizes the - rightmost term, that point X is the closest point on the - ellipse to POINT. - - So, we find the projection PRJ, and then solve the problem of - finding the closest point on ELLIPS to PRJ. To solve this - problem, we find a triaxial ellipsoid whose intersection with - the plane ELPL is precisely ELLIPS, and two of whose axes lie - in the plane ELPL. The closest point on ELLIPS to PRJ is also - the closest point on the ellipsoid to ELLIPS. But we have the - SPICELIB routine NEARPT on hand to find the closest point on an - ellipsoid to a specified point, so we've reduced our problem to - a solved problem. - - There is a subtle point to worry about here: if PRJ is outside - of ELLIPS (PRJ is in the same plane as ELLIPS, so `outside' - does make sense here), then the closest point on ELLIPS to PRJ - coincides with the closest point on the ellipsoid to PRJ, - regardless of how we choose the z-semi-axis length of the - ellipsoid. But the correspondence may be lost if PRJ is inside - the ellipse, if we don't choose the z-semi-axis length - correctly. - - Though it takes some thought to verify this (and we won't prove - it here), making the z-semi-axis of the ellipsoid longer than - the other two semi-axes is sufficient to maintain the - coincidence of the closest point on the ellipsoid to PRJPNT and - the closest point on the ellipse to PRJPNT. - */ - - - /* - Find the ellipse's center and semi-axes. - */ - el2cgv_c ( ellips, center, smajor, sminor ); - - - /* - Find the lengths of the semi-axes, and scale the vectors to try - to prevent arithmetic unpleasantness. Degenerate ellipses are - turned away at the door. - */ - - minlen = vnorm_c (sminor); - majlen = vnorm_c (smajor); - - if ( MinVal ( majlen, minlen ) == 0.0 ) - { - setmsg_c ( "Ellipse semi-axis lengths: # #." ); - errdp_c ( "#", majlen ); - errdp_c ( "#", minlen ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "npelpt_c" ); - return; - } - - - scale = 1.0 / majlen; - - vscl_c ( scale, smajor, smajor ); - vscl_c ( scale, sminor, sminor ); - - - /* - Translate ellipse and point so that the ellipse is centered at - the origin. Scale the point's coordinates to maintain the - correct relative position to the scaled ellipse. - */ - vsub_c ( point, center, tmppnt ); - vscl_c ( scale, tmppnt, tmppnt ); - - - /* - We want to reduce the problem to a two-dimensional one. We'll - work in a coordinate system whose x- and y- axes are aligned with - the semi-major and semi-minor axes of the input ellipse. The - z-axis is picked to give us a right-handed system. We find the - matrix that transforms coordinates to our new system using twovec_c. - */ - twovec_c ( smajor, 1, sminor, 2, rotate ); - - - /* - Apply the coordinate transformation to our scaled input point. - */ - mxv_c ( rotate, tmppnt, tmppnt ); - - - /* - We must find the distance between the orthogonal projection of - tmppnt onto the x-y plane and the ellipse. The projection is - just - - ( TMPPNT[0], TMPPNT[1], 0 ); - - we'll call this projection prjpnt. - */ - - vpack_c ( tmppnt[0], tmppnt[1], 0.0, prjpnt ); - - - /* - Now we're ready to find the distance between and a triaxial - ellipsoid whose intersection with the x-y plane is the ellipse - and whose third semi-axis lies on the z-axis. - - Because we've scaled the ellipse's axes so as to give the longer - axis length 1, a length of 2.0 suffices for the ellipsoid's - z-semi-axis. - - Find the nearest point to prjpnt on the ellipoid, pnear. - */ - nearpt_c ( prjpnt, 1.0, minlen/majlen, 2.0, pnear, dist ); - - - /* - Scale the near point coordinates back to the original scale. - */ - vscl_c ( majlen, pnear, pnear ); - - - /* - Apply the required inverse rotation and translation to pnear. - Compute the point-to-ellipse distance. - */ - mtxv_c ( rotate, pnear, pnear ); - vadd_c ( pnear, center, pnear ); - - *dist = vdist_c ( pnear, point ); - - - chkout_c ( "npelpt_c" ); - -} /* End npelpt_c */ diff --git a/ext/spice/src/cspice/nplnpt.c b/ext/spice/src/cspice/nplnpt.c deleted file mode 100644 index 6ffe69a84e..0000000000 --- a/ext/spice/src/cspice/nplnpt.c +++ /dev/null @@ -1,221 +0,0 @@ -/* nplnpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NPLNPT ( Nearest point on line to point ) */ -/* Subroutine */ int nplnpt_(doublereal *linpt, doublereal *lindir, - doublereal *point, doublereal *pnear, doublereal *dist) -{ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal proj[3]; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), chkin_(char *, ftnlen); - doublereal trans[3]; - extern doublereal vdist_(doublereal *, doublereal *); - extern /* Subroutine */ int vproj_(doublereal *, doublereal *, doublereal - *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Find the nearest point on a line to a specified point, and find */ -/* the distance between the two points. */ - -/* $ 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 */ - -/* GEOMETRY */ -/* MATH */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LINPT, */ -/* LINDIR I Point on a line and the line's direction vector. */ -/* POINT I A second point. */ -/* PNEAR O Nearest point on the line to POINT. */ -/* DIST O Distance between POINT and PNEAR. */ - -/* $ Detailed_Input */ - -/* LINPT */ -/* LINDIR are, respectively, a point and a direction vector */ -/* that define a line in 3-dimensional space. The */ -/* line is the set of points */ - -/* LINPT + t * LINDIR */ - -/* where t is any real number. */ - -/* POINT is a point in 3-dimensional space. */ - -/* $ Detailed_Output */ - -/* PNEAR is the nearest point on the input line to the input */ -/* point. */ - -/* DIST is the distance between the input line and input */ -/* point. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the line direction vector LINDIR is the zero vector, the */ -/* error SPICE(ZEROVECTOR) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For every line L and point P, there is a unique closest point */ -/* on L to P. Call this closest point C. It is always true that */ -/* P - C is perpendicular to L, and the length of P - C is called */ -/* the `distance' between P and L. */ - -/* $ Examples */ - -/* 1) Suppose a line passes through the point ( 1, 2, 3 ) and */ -/* has direction vector ( 0, 1, 1 ). We wish to find the */ -/* closest point on the line to the point ( -6, 9, 10 ). We */ -/* can use the code fragment */ - -/* LINPT(1) = 1.D0 */ -/* LINPT(2) = 2.D0 */ -/* LINPT(3) = 3.D0 */ - -/* LINDIR(1) = 0.D0 */ -/* LINDIR(2) = 1.D0 */ -/* LINDIR(3) = 1.D0 */ - -/* POINT(1) = -6.D0 */ -/* POINT(2) = 9.D0 */ -/* POINT(3) = 10.D0 */ - -/* CALL NPLNPT ( LINPT, LINDIR, POINT, PNEAR, DIST ) */ - -/* After the call, PNEAR will take the value */ - -/* ( 1.D0, 9.D0, 10.D0 ); */ - -/* DIST will be 7.0. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD call. */ - -/* - 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, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* distance between point and line */ -/* nearest point on line to point */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NPLNPT", (ftnlen)6); - } - -/* We need a real direction vector to work with. */ - - if (vzero_(lindir)) { - setmsg_("Direction vector must be non-zero.", (ftnlen)34); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("NPLNPT", (ftnlen)6); - return 0; - } - -/* We translate line and input point so as to put the line through */ -/* the origin. Then the nearest point on the translated line to the */ -/* translated point TRANS is the projection of TRANS onto the line. */ - - vsub_(point, linpt, trans); - vproj_(trans, lindir, proj); - vadd_(proj, linpt, pnear); - *dist = vdist_(pnear, point); - chkout_("NPLNPT", (ftnlen)6); - return 0; -} /* nplnpt_ */ - diff --git a/ext/spice/src/cspice/nplnpt_c.c b/ext/spice/src/cspice/nplnpt_c.c deleted file mode 100644 index aca1b41e6e..0000000000 --- a/ext/spice/src/cspice/nplnpt_c.c +++ /dev/null @@ -1,202 +0,0 @@ -/* - --Procedure nplnpt_c ( Nearest point on line to point ) - --Abstract - - Find the nearest point on a line to a specified point, and find - the distance between the two points. - --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 - - GEOMETRY - MATH - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef nplnpt_c - - - void nplnpt_c ( ConstSpiceDouble linpt [3], - ConstSpiceDouble lindir [3], - ConstSpiceDouble point [3], - SpiceDouble pnear [3], - SpiceDouble * dist ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - linpt, - lindir I Point on a line and the line's direction vector. - point I A second point. - pnear O Nearest point on the line to point. - dist O Distance between point and pnear. - --Detailed_Input - - linpt - lindir are, respectively, a point and a direction vector - that define a line in 3-dimensional space. The - line is the set of points - - linpt + t * lindir - - where t is any real number. - - point is a point in 3-dimensional space. - --Detailed_Output - - pnear is the nearest point on the input line to the input - point. - - dist is the distance between the input line and input - point. - --Parameters - - None. - --Exceptions - - 1) If the line direction vector lindir is the zero vector, the - error SPICE(ZEROVECTOR) is signaled. - --Files - - None. - --Particulars - - For every line L and point P, there is a unique closest point - on L to P. Call this closest point C. It is always true that - P - C is perpendicular to L, and the length of P - C is called - the "distance" between P and L. - --Examples - - 1) Suppose a line passes through the point ( 1, 2, 3 ) and - has direction vector ( 0, 1, 1 ). We wish to find the - closest point on the line to the point ( -6, 9, 10 ). We - can use the code fragment - - #include "SpiceUsr.h" - . - . - . - LINPT[0] = 1.0; - LINPT[1] = 2.0; - LINPT[2] = 3.0; - - LINDIR[0] = 0.0; - LINDIR[1] = 1.0; - LINDIR[2] = 1.0; - - POINT[0] = -6.0; - POINT[1] = 9.0; - POINT[2] = 10.0; - - nplnpt_c ( linpt, lindir, point, pnear, &dist ); - - - After the call, pnear will take the value - - ( 1., 9., 10. ); - - dist will be 7.0. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 16-AUG-1999 (NJB) - --Index_Entries - - distance between point and line - nearest point on line to point - --& -*/ - -{ /* Begin nplnpt_c */ - - - /* - Local variables - */ - SpiceDouble trans [3]; - - - - /* - We need a real direction vector to work with. - */ - if ( vzero_c (lindir) ) - { - chkin_c ( "nplnpt_c" ); - setmsg_c ( "Direction vector must be non-zero." ); - sigerr_c ( "SPICE(ZEROVECTOR)" ); - chkout_c ( "nplnpt_c" ); - return; - } - - - /* - We translate line and input point so as to put the line through - the origin. Then the nearest point on the translated line to the - translated point TRANS is the projection of TRANS onto the line. - */ - - vsub_c ( point, linpt, trans ); - vproj_c ( trans, lindir, pnear ); - vadd_c ( pnear, linpt, pnear ); - - *dist = vdist_c ( pnear, point ); - - -} /* End nplnpt_c */ diff --git a/ext/spice/src/cspice/nthwd.c b/ext/spice/src/cspice/nthwd.c deleted file mode 100644 index 4b50e54810..0000000000 --- a/ext/spice/src/cspice/nthwd.c +++ /dev/null @@ -1,258 +0,0 @@ -/* nthwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NTHWD ( Nth word in a character string ) */ -/* Subroutine */ int nthwd_(char *string, integer *nth, char *word, integer * - loc, ftnlen string_len, ftnlen word_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical loop; - integer i__, n, length; - -/* $ Abstract */ - -/* Return the Nth word in a character string, and its location */ -/* in the 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 */ - -/* CHARACTER, PARSING, SEARCH, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* NTH I Index of the word to be returned. */ -/* WORD O The N'TH word in STRING. */ -/* LOC O Location of WORD in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input string to be parsed. It contains */ -/* some number of words, where a word is any string */ -/* of consecutive non-blank characters. */ - -/* NTH is the index of the word to be returned. (One for */ -/* the first word, two for the second, and so on.) */ - -/* $ Detailed_Output */ - -/* WORD is the N'th word in STRING. If STRING is blank, */ -/* or NTH is nonpositive or too large, WORD is blank. */ - -/* WORD may overwrite STRING. */ - -/* LOC is the location of WORD in STRING. (That is, WORD */ -/* begins at STRING(LOC:LOC). If STRING is blank, or */ -/* NTH is nonpositive or too large, LOC is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NTHWD, like NEXTWD, is useful primarily for parsing input */ -/* commands consisting of one or more words, where a word is */ -/* defined to be any sequence of consecutive non-blank characters. */ -/* Successive calls to NEXTWD allow the calling routine to neatly */ -/* parse and process one word at a time. */ - -/* The chief difference between the two routines is that */ -/* NTHWD allows the calling routine to access the words making */ -/* up the input string in random order. (NEXTWD allows only */ -/* sequential access.) */ - -/* $ Examples */ - -/* Let STRING be ' Now is the time, for all good men to come.' */ - -/* If N = -1 WORD = ' ' LOC = 0 */ -/* 0 ' ' 0 */ -/* 1, 'Now' 2 */ -/* 2, 'is' 6 */ -/* 3, 'the' 9 */ -/* 4, 'time,' 13 */ -/* 5, 'for' 21 */ -/* 6, 'all' 25 */ -/* 7, 'good' 29 */ -/* 8, 'men' 34 */ -/* 9, 'to' 42 */ -/* 10, 'come.' 45 */ -/* 11, ' ' 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 10-MAY-2006 (EDW) */ - -/* Added logic to prevent the evaluation of STRING(I:I) */ -/* if I exceeds the length of STRING. Functionally, the */ -/* evaluation had no effect on NTHWD's output, but the ifort */ -/* F95 compiler flagged the evaluation as an array */ -/* overrun error. This occurred because given: */ - -/* A .AND. B */ - -/* ifort evaluates A then B then performs the logical */ -/* comparison. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* nth word in a character_string */ - -/* -& */ - -/* Local variables */ - - -/* Trivial cases first. Blank STRING? Nonpositive NTH? */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0 || *nth < 1) { - s_copy(word, " ", word_len, (ftnlen)1); - *loc = 0; - return 0; - } - -/* Skip leading blanks. */ - - *loc = 1; - while(*(unsigned char *)&string[*loc - 1] == ' ') { - ++(*loc); - } - -/* If we wanted the first word, we have the location. Otherwise, */ -/* keep stepping through STRING. Quit when the N'TH word is found, */ -/* or when the end of the string is reached. (The current word is */ -/* ended whenever a blank is encountered.) */ - -/* N is the number of words found so far. */ -/* I is the current location in STRING. */ - - n = 1; - i__ = *loc; - length = i_len(string, string_len); - while(i__ < length && n < *nth) { - ++i__; - -/* Blank signals end of the current word. */ - - if (*(unsigned char *)&string[i__ - 1] == ' ') { - -/* Skip ahead to the next one. The logic ensures no */ -/* evaluation of STRING(I:I) if I > LEN(STRING). */ - - loop = i__ <= length; - if (loop) { - loop = loop && *(unsigned char *)&string[i__ - 1] == ' '; - } - while(loop) { - ++i__; - if (i__ > length) { - loop = FALSE_; - } else if (*(unsigned char *)&string[i__ - 1] != ' ') { - loop = FALSE_; - } else { - loop = TRUE_; - } - } - -/* If not at the end of the string, we have another word. */ - - if (i__ <= length) { - ++n; - *loc = i__; - } - } - } - -/* Couldn't find enough words? Return blank and zero. */ - - if (n < *nth) { - s_copy(word, " ", word_len, (ftnlen)1); - *loc = 0; - -/* Otherwise, find the rest of WORD (it continues until the next */ -/* blank), and return the current LOC. */ - - } else { - i__ = i_indx(string + (*loc - 1), " ", string_len - (*loc - 1), ( - ftnlen)1); - if (i__ == 0) { - s_copy(word, string + (*loc - 1), word_len, string_len - (*loc - - 1)); - } else { - s_copy(word, string + (*loc - 1), word_len, *loc + i__ - 1 - (* - loc - 1)); - } - } - return 0; -} /* nthwd_ */ - diff --git a/ext/spice/src/cspice/nvc2pl.c b/ext/spice/src/cspice/nvc2pl.c deleted file mode 100644 index 3ad2dabb5a..0000000000 --- a/ext/spice/src/cspice/nvc2pl.c +++ /dev/null @@ -1,273 +0,0 @@ -/* nvc2pl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NVC2PL ( Normal vector and constant to plane ) */ -/* Subroutine */ int nvc2pl_(doublereal *normal, doublereal *const__, - doublereal *plane) -{ - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), chkin_( - char *, ftnlen), unorm_(doublereal *, doublereal *, doublereal *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - doublereal tmpvec[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - doublereal mag; - -/* $ Abstract */ - -/* Make a SPICELIB plane from a normal vector and a constant. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NORMAL, */ -/* CONST I A normal vector and constant defining a plane. */ -/* PLANE O An array representing the plane. */ - -/* $ Detailed_Input */ - -/* NORMAL, */ -/* CONST are, respectively, a normal vector and constant */ -/* defining a plane. NORMAL need not be a unit */ -/* vector. Let the symbol < a, b > indicate the inner */ -/* product of vectors a and b; then the geometric */ -/* plane is the set of vectors X in three-dimensional */ -/* space that satisfy */ - -/* < X, NORMAL > = CONST. */ - -/* $ Detailed_Output */ - -/* PLANE is a SPICELIB plane that represents the geometric */ -/* plane defined by NORMAL and CONST. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input vector NORMAL is the zero vector, the error */ -/* SPICE(ZEROVECTOR) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB geometry routines that deal with planes use the `plane' */ -/* data type to represent input and output planes. This data type */ -/* makes the subroutine interfaces simpler and more uniform. */ - -/* The SPICELIB routines that produce SPICELIB planes from data that */ -/* define a plane are: */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* The SPICELIB routines that convert SPICELIB planes to data that */ -/* define a plane are: */ - -/* PL2NVC ( Plane to normal vector and constant ) */ -/* PL2NVP ( Plane to normal vector and point ) */ -/* PL2PSV ( Plane to point and spanning vectors ) */ - -/* Any of these last three routines may be used to convert this */ -/* routine's output, PLANE, to another representation of a */ -/* geometric plane. */ - -/* $ Examples */ - -/* 1) Apply a linear transformation represented by the matrix M to */ -/* a plane represented by the normal vector N and the constant C. */ -/* Find a normal vector and constant for the transformed plane. */ - -/* C */ -/* C Make a SPICELIB plane from N and C, and then find a */ -/* C point in the plane and spanning vectors for the */ -/* C plane. N need not be a unit vector. */ -/* C */ -/* CALL NVC2PL ( N, C, PLANE ) */ -/* CALL PL2PSV ( PLANE, POINT, SPAN1, SPAN2 ) */ - -/* C */ -/* C Apply the linear transformation to the point and */ -/* C spanning vectors. All we need to do is multiply */ -/* C these vectors by M, since for any linear */ -/* C transformation T, */ -/* C */ -/* C T ( POINT + t1 * SPAN1 + t2 * SPAN2 ) */ -/* C */ -/* C = T (POINT) + t1 * T(SPAN1) + t2 * T(SPAN2), */ -/* C */ -/* C which means that T(POINT), T(SPAN1), and T(SPAN2) */ -/* C are a point and spanning vectors for the transformed */ -/* C plane. */ -/* C */ -/* CALL MXV ( M, POINT, TPOINT ) */ -/* CALL MXV ( M, SPAN1, TSPAN1 ) */ -/* CALL MXV ( M, SPAN2, TSPAN2 ) */ - -/* C */ -/* C Make a new SPICELIB plane TPLANE from the */ -/* C transformed point and spanning vectors, and find a */ -/* C unit normal and constant for this new plane. */ -/* C */ -/* CALL PSV2PL ( TPOINT, TSPAN1, TSPAN2, TPLANE ) */ -/* CALL PL2NVC ( TPLANE, TN, TC ) */ - -/* $ Restrictions */ - -/* No checking is done to prevent arithmetic overflow. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 02-NOV-2009 (NJB) */ - -/* Corrected header typo. */ - -/* - SPICELIB Version 1.1.0, 30-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VMINUS call. */ - -/* - 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* normal vector and constant to plane */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VMINUS call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* The contents of SPICELIB planes are as follows: */ - -/* Elements NMLPOS through NMLPOS + 2 contain a unit normal */ -/* vector for the plane. */ - -/* Element CONPOS contains a constant for the plane; every point */ -/* X in the plane satisifies */ - -/* < X, PLANE(NMLPOS) > = PLANE(CONPOS). */ - -/* The plane constant is the distance of the plane from the */ -/* origin; the normal vector, scaled by the constant, is the */ -/* closest point in the plane to the origin. */ - - - -/* Local variables */ - - -/* This routine checks in only if an error is discovered. */ - - if (return_()) { - return 0; - } - unorm_(normal, plane, &mag); - -/* The normal vector must be non-zero. */ - - if (mag == 0.) { - chkin_("NVC2PL", (ftnlen)6); - setmsg_("Plane's normal must be non-zero.", (ftnlen)32); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("NVC2PL", (ftnlen)6); - return 0; - } - -/* To find the plane constant corresponding to the unitized normal */ -/* vector, we observe that */ - -/* < X, NORMAL > = CONST, */ - -/* so */ - -/* < X, NORMAL / || NORMAL || > = CONST / || NORMAL || */ - - - plane[3] = *const__ / mag; - -/* The constant should be the distance of the plane from the */ -/* origin. If the constant is negative, negate both it and the */ -/* normal vector. */ - - if (plane[3] < 0.) { - plane[3] = -plane[3]; - vminus_(plane, tmpvec); - vequ_(tmpvec, plane); - } - return 0; -} /* nvc2pl_ */ - diff --git a/ext/spice/src/cspice/nvc2pl_c.c b/ext/spice/src/cspice/nvc2pl_c.c deleted file mode 100644 index 890d9e1f8f..0000000000 --- a/ext/spice/src/cspice/nvc2pl_c.c +++ /dev/null @@ -1,254 +0,0 @@ -/* - --Procedure nvc2pl_c ( Normal vector and constant to plane ) - --Abstract - - Make a CSPICE plane from a normal vector and a constant. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - - #include "SpiceUsr.h" - #undef nvc2pl_c - - - void nvc2pl_c ( ConstSpiceDouble normal[3], - SpiceDouble constant, - SpicePlane * plane ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - normal, - constant I A normal vector and constant defining a plane. - plane O A CSPICE plane structure representing the plane. - --Detailed_Input - - normal, - constant are, respectively, a normal vector and constant - defining a plane. normal need not be a unit vector. - Let the symbol < a, b > indicate the inner product of - vectors a and b; then the geometric plane is the set - of vectors x in three-dimensional space that satisfy - - < x, normal > = constant. - --Detailed_Output - - plane is a CSPICE plane structure that represents the - geometric plane defined by normal and constant. - --Parameters - - None. - --Exceptions - - 1) If the input vector normal is the zero vector, the error - SPICE(ZEROVECTOR) is signalled. - --Files - - None. - --Particulars - - CSPICE geometry routines that deal with planes use the `plane' - data type to represent input and output planes. This data type - makes the subroutine interfaces simpler and more uniform. - - The CSPICE routines that produce CSPICE planes from data that - define a plane are: - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - The CSPICE routines that convert CSPICE planes to data that - define a plane are: - - pl2nvc_c ( Plane to normal vector and constant ) - pl2nvp_c ( Plane to normal vector and point ) - pl2psv_c ( Plane to point and spanning vectors ) - - Any of these last three routines may be used to convert this - routine's output, plane, to another representation of a - geometric plane. - --Examples - - 1) Apply a linear transformation represented by the matrix M to - a plane represented by the normal vector N and the constant C. - Find a normal vector and constant for the transformed plane. - - /. - Make a CSPICE plane from n and c, and then find a - point in the plane and spanning vectors for the - plane. n need not be a unit vector. - ./ - nvc2pl_c ( n, c, &plane ); - pl2psv_c ( &plane, point, span1, span2 ); - - - /. - Apply the linear transformation to the point and - spanning vectors. All we need to do is multiply - these vectors by m, since for any linear - transformation T, - - T ( POINT + t1 * SPAN1 + t2 * SPAN2 ) - - = T (POINT) + t1 * T(SPAN1) + t2 * T(SPAN2), - - which means that T(POINT), T(SPAN1), and T(SPAN2) - are a point and spanning vectors for the transformed - plane. - ./ - - mxv_c ( m, point, tpoint ); - mxv_c ( m, span1, tspan1 ); - mxv_c ( m, span2, tspan2 ); - - /. - Make a new CSPICE plane tplane from the - transformed point and spanning vectors, and find a - unit normal and constant for this new plane. - ./ - - psv2pl_c ( tpoint, tspan1, tspan2, &tplane ); - pl2nvc_c ( &tplane, tn, &tc ); - - --Restrictions - - No checking is done to prevent arithmetic overflow. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 02-NOV-2009 (NJB) - - Corrected header typo. - - -CSPICE Version 1.0.0, 01-MAR-1999 (NJB) - --Index_Entries - - normal vector and constant to plane - --& -*/ - -{ /* Begin nvc2pl_c */ - - - /* - Local variables - */ - SpiceDouble mag; - - - - /* - This routine checks in only if an error is discovered. - */ - - if ( return_c () ) - { - return; - } - - unorm_c ( normal, plane->normal, &mag ); - - - /* - The normal vector must be non-zero. - */ - if ( mag == 0. ) - { - chkin_c ( "nvc2pl_c" ); - setmsg_c ( "plane's normal must be non-zero." ); - sigerr_c ( "SPICE(ZEROVECTOR)" ); - chkout_c ( "nvc2pl_c" ); - return; - } - - - /* - To find the plane constant corresponding to the unitized normal - vector, we observe that - - < x, normal > = constant, - - so - - < x, normal / || normal || > = constant / || normal || - - */ - - - plane->constant = constant / mag; - - - /* - The constant should be the distance of the plane from the - origin. If the constant is negative, negate both it and the - normal vector. - */ - - if ( plane->constant < 0. ) - { - plane->constant = - (plane->constant); - - vminus_c ( plane->normal, plane->normal ); - } - - -} /* End nvc2pl_c */ - diff --git a/ext/spice/src/cspice/nvp2pl.c b/ext/spice/src/cspice/nvp2pl.c deleted file mode 100644 index 1b0b008db2..0000000000 --- a/ext/spice/src/cspice/nvp2pl.c +++ /dev/null @@ -1,242 +0,0 @@ -/* nvp2pl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NVP2PL ( Normal vector and point to plane ) */ -/* Subroutine */ int nvp2pl_(doublereal *normal, doublereal *point, - doublereal *plane) -{ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), chkin_( - char *, ftnlen); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal tmpvec[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Make a SPICELIB plane from a normal vector and a point. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NORMAL, */ -/* POINT I A normal vector and a point defining a plane. */ -/* PLANE O An array representing the plane. */ - -/* $ Detailed_Input */ - -/* NORMAL, */ -/* POINT */ -/* are, respectively, a normal vector and point that */ -/* define a plane in three-dimensional space. NORMAL */ -/* need not be a unit vector. Let the symbol < a, b > */ -/* indicate the inner product of vectors a and b; */ -/* then the geometric plane is the set of vectors X */ -/* in three-dimensional space that satisfy */ - -/* < X - POINT, NORMAL > = 0. */ - -/* $ Detailed_Output */ - -/* PLANE is a SPICELIB plane that represents the geometric */ -/* plane defined by POINT and NORMAL. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input vector NORMAL is the zero vector, the error */ -/* SPICE(ZEROVECTOR) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB geometry routines that deal with planes use the `plane' */ -/* data type to represent input and output planes. This data type */ -/* makes the subroutine interfaces simpler and more uniform. */ - -/* The SPICELIB routines that produce SPICELIB planes from data that */ -/* define a plane are: */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* The SPICELIB routines that convert SPICELIB planes to data that */ -/* define a plane are: */ - -/* PL2NVC ( Plane to normal vector and constant ) */ -/* PL2NVP ( Plane to normal vector and point ) */ -/* PL2PSV ( Plane to point and spanning vectors ) */ - -/* Any of these last three routines may be used to convert this */ -/* routine's output, PLANE, to another representation of a */ -/* geometric plane. */ - -/* $ Examples */ - -/* 1) Project a vector V orthogonally onto a plane defined by POINT */ -/* and NORMAL. PROJ is the projection we want; it is the */ -/* closest vector in the plane to V. */ - -/* CALL NVP2PL ( NORMAL, POINT, PLANE ) */ -/* CALL VPRJP ( V, PLANE, PROJ ) */ - - -/* 2) Given a point in a plane and a normal vector, find the */ -/* distance of the plane from the origin. We make a */ -/* `plane' from the point and normal, then convert the */ -/* plane to a unit normal and constant. The constant CONST */ -/* is (according to the specification of PL2NVC) the distance of */ -/* the plane from the origin. */ - -/* CALL NVP2PL ( NORMAL, POINT, PLANE ) */ -/* CALL PL2NVC ( PLANE, NORMAL, CONST ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 30-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VMINUS call. */ - -/* - 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* normal vector and point to plane */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VMINUS call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* The contents of SPICELIB planes are as follows: */ - -/* Elements NMLPOS through NMLPOS + 2 contain a unit normal */ -/* vector for the plane. */ - -/* Element CONPOS contains a constant for the plane; every point */ -/* X in the plane satisifies */ - -/* < X, PLANE(NMLPOS) > = PLANE(CONPOS). */ - -/* The plane constant is the distance of the plane from the */ -/* origin; the normal vector, scaled by the constant, is the */ -/* closest point in the plane to the origin. */ - - - -/* Local variables */ - - -/* This routine checks in only if an error is discovered. */ - - if (return_()) { - return 0; - } - -/* The normal vector must be non-zero. */ - - if (vzero_(normal)) { - chkin_("NVP2PL", (ftnlen)6); - setmsg_("Plane's normal must be non-zero.", (ftnlen)32); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("NVP2PL", (ftnlen)6); - return 0; - } - vhat_(normal, plane); - plane[3] = vdot_(point, plane); - -/* The constant should be the distance of the plane from the */ -/* origin. If the constant is negative, negate both it and the */ -/* normal vector. */ - - if (plane[3] < 0.) { - plane[3] = -plane[3]; - vminus_(plane, tmpvec); - vequ_(tmpvec, plane); - } - return 0; -} /* nvp2pl_ */ - diff --git a/ext/spice/src/cspice/nvp2pl_c.c b/ext/spice/src/cspice/nvp2pl_c.c deleted file mode 100644 index 7c01d2ed70..0000000000 --- a/ext/spice/src/cspice/nvp2pl_c.c +++ /dev/null @@ -1,210 +0,0 @@ -/* - --Procedure nvp2pl_c ( Normal vector and point to plane ) - --Abstract - - Make a CSPICE plane from a normal vector and a point. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - - #include "SpiceUsr.h" - #undef nvp2pl_c - - - void nvp2pl_c ( ConstSpiceDouble normal[3], - ConstSpiceDouble point [3], - SpicePlane * plane ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - normal, - point I A normal vector and a point defining a plane. - plane O A CSPICE plane structure representing the plane. - --Detailed_Input - - normal, - point - are, respectively, a normal vector and point that - define a plane in three-dimensional space. normal - need not be a unit vector. Let the symbol < a, b > - indicate the inner product of vectors a and b; - then the geometric plane is the set of vectors x - in three-dimensional space that satisfy - - < x - point, normal > = 0. - --Detailed_Output - - plane is a CSPICE plane structure that represents the - geometric plane defined by point and normal. - --Parameters - - None. - --Exceptions - - 1) If the input vector normal is the zero vector, the error - SPICE(ZEROVECTOR) is signaled. - --Files - - None. - --Particulars - - CSPICE geometry routines that deal with planes use the `plane' - data type to represent input and output planes. This data type - makes the subroutine interfaces simpler and more uniform. - - The CSPICE routines that produce CSPICE planes from data that - define a plane are: - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - The CSPICE routines that convert CSPICE planes to data that - define a plane are: - - pl2nvc_c ( Plane to normal vector and constant ) - pl2nvp_c ( Plane to normal vector and point ) - pl2psv_c ( Plane to point and spanning vectors ) - - Any of these last three routines may be used to convert this - routine's output, plane, to another representation of a - geometric plane. - --Examples - - 1) Project a vector v orthogonally onto a plane defined by point - and normal. proj is the projection we want; it is the - closest vector in the plane to v. - - nvp2pl_c ( normal, point, &plane ); - vprjp_c ( v, &plane, proj ); - - - 2) Given a point in a plane and a normal vector, find the - distance of the plane from the origin. We make a - `plane' from the point and normal, then convert the - plane to a unit normal and constant. The output constant - is (according to the specification of pl2nvc_c) the distance of - the plane from the origin. - - nvp2pl_c ( normal, point, &plane ); - pl2nvc_c ( &plane, normal, constant ); - - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - normal vector and point to plane - --& -*/ - -{ /* Begin nvp2pl_c */ - - - /* - This routine checks in only if an error is discovered. - */ - - if ( return_c() ) - { - return; - } - - - /* - The normal vector must be non-zero. - */ - - if ( vzero_c (normal) ) - { - chkin_c ( "nvp2pl_c" ); - setmsg_c ( "Plane's normal must be non-zero." ); - sigerr_c ( "SPICE(ZEROVECTOR)" ); - chkout_c ( "nvp2pl_c" ); - return; - } - - - vhat_c ( normal, plane->normal ); - - plane->constant = vdot_c ( point, plane->normal ); - - - /* - The constant should be the distance of the plane from the - origin. If the constant is negative, negate both it and the - normal vector. - */ - - if ( plane->constant < 0. ) - { - plane->constant = - (plane->constant); - - vminus_c ( plane->normal, plane->normal ); - } - - -} /* End nvp2pl_c */ - diff --git a/ext/spice/src/cspice/odd.c b/ext/spice/src/cspice/odd.c deleted file mode 100644 index 6e60f6d992..0000000000 --- a/ext/spice/src/cspice/odd.c +++ /dev/null @@ -1,150 +0,0 @@ -/* odd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ODD ( Is a number odd? ) */ -logical odd_(integer *i__) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Determine whether an integer is odd. */ - -/* $ 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 */ - -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* I I The integer in question. */ -/* ODD O True if I is odd, otherwise false. */ - -/* $ Detailed_Input */ - -/* I is the integer to be tested for oddness. */ - -/* $ Detailed_Output */ - -/* ODD is returned as true if I is odd, false if I is even. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Divide I by two. If the remainder is one, I is odd. */ - -/* $ Examples */ - -/* Let ENDPTS contain a series of endpoints, */ - -/* a , b , ..., a , b */ -/* 1 1 n n */ - -/* representing an ordered collection of disjoint intervals, */ - -/* a < b < a */ -/* i - i i+1 */ - -/* The following code fragment uses ODD to determine whether */ -/* an arbitrary value X is contained in any of the intervals. */ - -/* CONTAINED = .FALSE. */ - -/* DO I = 1, N-1 */ -/* IF ( X .GE. ENDPTS(I) .AND. X .LE. ENDPTS(I+1) ) THEN */ -/* CONTAINED = ( ODD ( I ) ) */ -/* END IF */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 07-NOV-2005 (BVS) */ - -/* Fixed a few typos in the header. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether an integer is odd */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* Self-explanatory. */ - - ret_val = *i__ % 2 != 0; - return ret_val; -} /* odd_ */ - diff --git a/ext/spice/src/cspice/open.c b/ext/spice/src/cspice/open.c deleted file mode 100644 index fcff7da016..0000000000 --- a/ext/spice/src/cspice/open.c +++ /dev/null @@ -1,449 +0,0 @@ -/* - --Source_File open.c ( CSPICE version of the open.c routine ) - --Abstract - - This file replaces the standard f2c open.c library file. The Mac classic - Metrowerks compiler requires a minor modification over the standard - C scratch file generation operation. - --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. - --Particulars - - Classic Macintosh scratch file creation occurs via generation of - a temp file name via a call to tmpnam. The name then passes to - fopen in the standard manner. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Restrictions - - 1) Requires CSPICE f2c.h header file. - --Version - - -CSPICE Version 1.0.0, 02-JAN-2002 (EDW) - -*/ - - - -#include "f2c.h" -#include "fio.h" -#include "string.h" -#ifndef NON_POSIX_STDIO -#ifdef MSDOS -#include "io.h" -#else -#include "unistd.h" /* for access */ -#endif -#endif - -#ifdef KR_headers -extern char *malloc(); -#ifdef NON_ANSI_STDIO -extern char *mktemp(); -#endif -extern integer f_clos(); -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" - -#ifdef __cplusplus -extern "C" { -#endif - -extern int f__canseek(FILE*); -extern integer f_clos(cllist*); -#endif - -#ifdef NON_ANSI_RW_MODES -char *f__r_mode[2] = {"r", "r"}; -char *f__w_mode[4] = {"w", "w", "r+w", "r+w"}; -#else -char *f__r_mode[2] = {"rb", "r"}; -char *f__w_mode[4] = {"wb", "w", "r+b", "r+"}; -#endif - - static char f__buf0[400], *f__buf = f__buf0; - int f__buflen = (int)sizeof(f__buf0); - - static void -#ifdef KR_headers - - f__bufadj(n, c) int n, c; - -#else - - f__bufadj(int n, int c) - -#endif - { - unsigned int len; - char *nbuf, *s, *t, *te; - - if (f__buf == f__buf0) - f__buflen = 1024; - while(f__buflen <= n) - f__buflen <<= 1; - len = (unsigned int)f__buflen; - if (len != f__buflen || !(nbuf = (char*)malloc(len))) - f__fatal(113, "malloc failure"); - s = nbuf; - t = f__buf; - te = t + c; - while(t < te) - *s++ = *t++; - if (f__buf != f__buf0) - free(f__buf); - f__buf = nbuf; - } - -int -#ifdef KR_headers - - f__putbuf(c) int c; - -#else - - f__putbuf(int c) - -#endif - { - char *s, *se; - int n; - - if (f__hiwater > f__recpos) - f__recpos = f__hiwater; - n = f__recpos + 1; - if (n >= f__buflen) - f__bufadj(n, f__recpos); - s = f__buf; - se = s + f__recpos; - if (c) - *se++ = c; - *se = 0; - for(;;) { - fputs(s, f__cf); - s += strlen(s); - if (s >= se) - break; /* normally happens the first time */ - putc(*s++, f__cf); - } - return 0; - } - - -void -#ifdef KR_headers - - x_putc(c) - -#else - - x_putc(int c) - -#endif - { - if (f__recpos >= f__buflen) - f__bufadj(f__recpos, f__buflen); - f__buf[f__recpos++] = c; - } - -#define opnerr(f,m,s) {if(f) errno= m; else opn_err(m,s,a); return(m);} - -static void -#ifdef KR_headers - - opn_err(m, s, a) int m; char *s; olist *a; - -#else - - opn_err(int m, char *s, olist *a) - -#endif - { - if (a->ofnm) - { - /* supply file name to error message */ - if (a->ofnmlen >= f__buflen) - f__bufadj((int)a->ofnmlen, 0); - g_char(a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf); - } - f__fatal(m, s); - } - - - - -#ifdef KR_headers - - integer f_open(a) olist *a; - -#else - - integer f_open( olist *a) - -#endif - { - unit *b; - integer rv; - char buf[256], *s; - cllist x; - int ufmt; - FILE *tf; -#ifndef NON_UNIX_STDIO - int n; -#endif - if(a->ounit>=MXUNIT || a->ounit<0) - err(a->oerr,101,"open") - if (!f__init) - f_init(); - f__curunit = b = &f__units[a->ounit]; - if(b->ufd) - { - if(a->ofnm==0) - { - same: if (a->oblnk) - b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z'; - return(0); - } -#ifdef NON_UNIX_STDIO - if (b->ufnm - && strlen(b->ufnm) == a->ofnmlen - && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen)) - goto same; -#else - g_char(a->ofnm,a->ofnmlen,buf); - if (f__inode(buf,&n) == b->uinode && n == b->udev) - goto same; -#endif - x.cunit=a->ounit; - x.csta=0; - x.cerr=a->oerr; - if ((rv = f_clos(&x)) != 0) - return rv; - } - b->url = (int)a->orl; - b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z'); - if(a->ofm==0) - { - if(b->url>0) b->ufmt=0; - else b->ufmt=1; - } - else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1; - else b->ufmt=0; - ufmt = b->ufmt; -#ifdef url_Adjust - if (b->url && !ufmt) - url_Adjust(b->url); -#endif - if (a->ofnm) - { - g_char(a->ofnm,a->ofnmlen,buf); - if (!buf[0]) - opnerr(a->oerr,107,"open") - } - else - sprintf(buf, "fort.%ld", a->ounit); - b->uscrtch = 0; - b->uend=0; - b->uwrt = 0; - b->ufd = 0; - b->urw = 3; - - switch(a->osta ? *a->osta : 'u') - { - - case 'o': - case 'O': -#ifdef NON_POSIX_STDIO - - if (!(tf = fopen(buf,"r"))) - opnerr(a->oerr,errno,"open") - fclose(tf); -#else - if ( access(buf,0) ) - { - opnerr(a->oerr,errno,"open"); - } -#endif - break; - - - case 's': - case 'S': - - b->uscrtch=1; - -#ifdef CSPICE_MACPPC - - tmpnam( buf ); - goto replace; - -#endif - - -#ifdef NON_ANSI_STDIO - - (void) strcpy(buf,"tmp.FXXXXXX"); - (void) mktemp(buf); - goto replace; - -#else - - -#ifndef CSPICE_MACPPC - - if (!(b->ufd = tmpfile())) - { - opnerr(a->oerr,errno,"open") - } - - b->ufnm = 0; - -#ifndef NON_UNIX_STDIO - b->uinode = b->udev = -1; -#endif - - b->useek = 1; - return 0; - -#endif - -#endif - - case 'n': - case 'N': - -#ifdef NON_POSIX_STDIO - if ((tf = fopen(buf,"r")) || (tf = fopen(buf,"a"))) - { - fclose(tf); - opnerr(a->oerr,128,"open") - } -#else - if (!access(buf,0)) - opnerr(a->oerr,128,"open") -#endif - - /* no break */ - case 'r': /* Fortran 90 replace option */ - case 'R': - - -#ifdef NON_ANSI_STDIO - replace: -#endif - -#ifdef CSPICE_MACPPC - replace: -#endif - - - - if (tf = fopen(buf,f__w_mode[0])) - fclose(tf); - } - - b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1)); - if(b->ufnm==NULL) opnerr(a->oerr,113,"no space"); - (void) strcpy(b->ufnm,buf); - if ((s = a->oacc) && b->url) - ufmt = 0; - if(!(tf = fopen(buf, f__w_mode[ufmt|2]))) { - if (tf = fopen(buf, f__r_mode[ufmt])) - b->urw = 1; - else if (tf = fopen(buf, f__w_mode[ufmt])) { - b->uwrt = 1; - b->urw = 2; - } - else - err(a->oerr, errno, "open"); - } - b->useek = f__canseek(b->ufd = tf); - -#ifndef NON_UNIX_STDIO - - if((b->uinode = f__inode(buf,&b->udev)) == -1) - opnerr(a->oerr,108,"open") - -#endif - - if(b->useek) - if (a->orl) - rewind(b->ufd); - else if ((s = a->oacc) && (*s == 'a' || *s == 'A') - && fseek(b->ufd, 0L, SEEK_END)) - opnerr(a->oerr,129,"open"); - return(0); -} - - - - -#ifdef KR_headers - - fk_open( seq, fmt, n) ftnint n; - -#else - - fk_open(int seq, int fmt, ftnint n) - -#endif - { - char nbuf[10]; - olist a; - (void) sprintf(nbuf,"fort.%ld",n); - a.oerr=1; - a.ounit=n; - a.ofnm=nbuf; - a.ofnmlen=strlen(nbuf); - a.osta=NULL; - a.oacc= seq==SEQ?"s":"d"; - a.ofm = fmt==FMT?"f":"u"; - a.orl = seq==DIR?1:0; - a.oblnk=NULL; - return(f_open(&a)); - } - -#ifdef __cplusplus -} -#endif diff --git a/ext/spice/src/cspice/opsgnd.c b/ext/spice/src/cspice/opsgnd.c deleted file mode 100644 index 3c13a0be13..0000000000 --- a/ext/spice/src/cspice/opsgnd.c +++ /dev/null @@ -1,145 +0,0 @@ -/* opsgnd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure OPSGND ( Opposite Sign Double Precision Numbers ) */ -logical opsgnd_(doublereal *x, doublereal *y) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Function: true if the input arguments have opposite signs. */ - -/* $ 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 */ - -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I A double precision number */ -/* Y I A double precision number */ - -/* $ Detailed_Input */ - -/* X is any double precision number. */ - -/* Y is any double precision number. */ - -/* $ Detailed_Output */ - -/* OPSGND is returned as .TRUE. if one of the pair X,Y is positive */ -/* and the other is negative. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the value: */ - -/* ( (( X .GT. 0) .AND. (Y .LT. 0)) */ -/* .OR. (( X .LT. 0) .AND. (Y .GT. 0)) ) */ - -/* This is a more stable value than */ - -/* ( X*Y .LT. 0 ) */ - -/* Note that if either of the two values is zero, OPSGND will be */ -/* false. */ - -/* $ Examples */ - -/* This routine can be used whenever a decision depends upon two */ -/* Double Precision values having opposite signs. */ - -/* IF ( OPSGND ( F(X1), F(X2) ) ) THEN */ -/* . */ -/* . */ -/* find a root of F lying between X1 and X2 */ -/* . */ -/* . */ -/* ELSE */ -/* . */ -/* . */ -/* do something */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* opposite sign d.p. numbers */ - -/* -& */ - ret_val = *x > 0. && *y < 0. || *x < 0. && *y > 0.; - return ret_val; -} /* opsgnd_ */ - diff --git a/ext/spice/src/cspice/opsgni.c b/ext/spice/src/cspice/opsgni.c deleted file mode 100644 index ceac711dbf..0000000000 --- a/ext/spice/src/cspice/opsgni.c +++ /dev/null @@ -1,150 +0,0 @@ -/* opsgni.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure OPSGNI ( Opposite Sign Integers ) */ -logical opsgni_(integer *x, integer *y) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Function: true if the input arguments have opposite signs. */ - -/* $ 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 */ - -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I An integer. */ -/* Y I An integer. */ -/* OPSGNI O .TRUE. when X and Y have opposite signs. */ - -/* $ Detailed_Input */ - -/* X is any integer number. */ - -/* Y is any integer number. */ - -/* $ Detailed_Output */ - -/* OPSGNI is returned as .TRUE. if one of the pair X,Y is positive */ -/* and the other is negative. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the value: */ - -/* ( (( X .GT. 0) .AND. (Y .LT. 0)) */ -/* .OR. (( X .LT. 0) .AND. (Y .GT. 0)) ) */ - -/* This is a more stable value than */ - -/* ( X*Y .LT. 0 ) */ - -/* Note that if either of the two values is zero, OPSGNI will be */ -/* false. */ - -/* $ Examples */ - -/* This routine can be used whenever a decision depends upon two */ -/* integer values having opposite signs. */ - -/* IF ( OPSGNI ( F(X1), F(X2) ) ) THEN */ -/* . */ -/* . */ -/* find the value of F closest to zero. */ -/* . */ -/* . */ -/* ELSE */ -/* . */ -/* . */ -/* do something */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 07-NOV-2005 (BVS) */ - -/* Fixed cut-and-paste errors in the header. */ - -/* - 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 */ - -/* opposite sign integers */ - -/* -& */ - ret_val = *x > 0 && *y < 0 || *x < 0 && *y > 0; - return ret_val; -} /* opsgni_ */ - diff --git a/ext/spice/src/cspice/ordc.c b/ext/spice/src/cspice/ordc.c deleted file mode 100644 index a0849214ba..0000000000 --- a/ext/spice/src/cspice/ordc.c +++ /dev/null @@ -1,221 +0,0 @@ -/* ordc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ORDC ( The ordinal position of an element in a set ) */ -integer ordc_(char *item, char *set, ftnlen item_len, ftnlen set_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* The function returns the ordinal position of any given item in a */ -/* set. If the item does not appear in the set, the function returns */ -/* zero. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* SEARCH */ -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I An item to locate within a set. */ -/* SET I A set to search for a given item. */ - -/* The function returns the ordinal position of ITEM within the SET. */ - -/* $ Detailed_Input */ - -/* ITEM Is an string to be located within a character set. */ - -/* SET Is a properly validated SPICELIB set that is to be */ -/* searched for the occurrence of item. */ - -/* $ Detailed_Output */ - -/* The function returns the ordinal position of ITEM within SET. */ -/* If ITEM is not an element of SET, the function is returned as 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A natural ordering can be imposed upon the elements of any */ -/* SPICELIB set, be it INTEGER, CHARACTER or DOUBLE PRECISION. For */ -/* character strings the ASCII collating sequence serves as the */ -/* ordering relation, for DOUBLE PRECISION and INTEGER variables */ -/* the arithmetic ordering is used. */ - -/* Given any element of a set, its location within this ordered */ -/* sequence of elements is called its ordinal position within */ -/* the set. */ - -/* For illustrative purposes suppose that SET represents the set */ - -/* { 8, 1, 2, 9, 7, 4, 10 } */ - -/* The ordinal position of: 8 is 5 */ -/* 1 is 1 */ -/* 2 is 2 */ -/* 9 is 6 */ -/* 7 is 4 */ -/* 4 is 3 */ -/* 10 is 7 */ - -/* Given an item of the SET, this routine returns its ordinal */ -/* position. If the item is not in the set, this function returns */ -/* a value of 0. */ - -/* $ Examples */ - -/* Suppose that you wished to find the relative position of a value */ -/* in a large list of values stored within an array. Say we want */ -/* to know the relative position of item I of ARRAY withing the */ -/* set of values represented in ARRAY. */ - -/* The following sequence of subroutine calls would allow you */ -/* determine the relative position of the value ARRAY(I). */ - -/* INTEGER N */ -/* PARAMETER ( N = something useful ) */ - -/* CHARACTER*(*) ARRAY ( N ) */ -/* CHARACTER*(*) SET ( LBCELL: N ) */ -/* INTEGER I */ - -/* INTEGER NVALID */ -/* INTEGER POSITION */ - - -/* set the value of NVALID to be the number of valid elements in the */ -/* array ARRAY */ - -/* CALL MOVEC ( ARRAY, N, SET(1) ) */ -/* CALL VALIDC ( N, NVALID, SET ) */ - -/* POSITION = ORDC ( ARRAY(I), SET ) */ - -/* POSITION now contains the ordinal position of ARRAY(I) within the */ -/* values represented in the array. */ - -/* $ Restrictions */ - -/* SET must be a validated or empty set. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* the ordinal position of an element in a set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling: */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("ORDC", (ftnlen)4); - } - -/* Given the structure of sets, there's not much to do. */ - - i__1 = cardc_(set, set_len); - ret_val = bsrchc_(item, &i__1, set + set_len * 6, item_len, set_len); - chkout_("ORDC", (ftnlen)4); - return ret_val; -} /* ordc_ */ - diff --git a/ext/spice/src/cspice/ordc_c.c b/ext/spice/src/cspice/ordc_c.c deleted file mode 100644 index 8dee6496e2..0000000000 --- a/ext/spice/src/cspice/ordc_c.c +++ /dev/null @@ -1,269 +0,0 @@ -/* - --Procedure ordc_c ( The ordinal position of an element in a set ) - --Abstract - - The function returns the ordinal position of any given item in a - character set. If the item does not appear in the set, the function - returns -1. - --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 - - SETS - --Keywords - - SEARCH - SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - SpiceInt ordc_c ( ConstSpiceChar * item, - SpiceCell * set ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I An item to locate within a set. - set I A set to search for a given item. - - The function returns the ordinal position of item within the set. - --Detailed_Input - - item is a character string to be located within a set. - Trailing blanks are not significant in the comparison. - - - set is an integer CSPICE set that is to be searched for the - occurrence of item. Trailing blanks are not significant - in the comparison. - - set must be declared as a character SpiceCell. - --Detailed_Output - - The function returns the ordinal position of item within set. - Ordinal positions range from 0 to N-1, where N is the cardinality - of the set. - - If item is not an element of set, the function returns -1. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - character, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - --Files - - None. - --Particulars - - A natural ordering can be imposed upon the elements of any - CSPICE set, be it integer, character or double precision. For - character strings the ASCII collating sequence serves as the - ordering relation, for double precision and integer variables - the arithmetic ordering is used. - - Given any element of a set, its location within this ordered - sequence of elements is called its ordinal position within - the set. - - In common mathematical usage, ordinal positions of elements - in a set of cardinality N range from 1 to N. In C programs, - it is much more convenient to use the range 0 to N-1; this is - the convention used in CSPICE. - - For illustrative purposes suppose that set represents the set - - { "8", "1", "2", "9", "7", "4", "10" } - - The ordinal position of: - - "8" is 5 - "1" is 0 - "2" is 2 - "9" is 6 - "7" is 4 - "4" is 3 - "10" is 1 - --Examples - - 1) Obtain the ordinal positions shown in the table of the Particulars - section above. - - - #include "SpiceUsr.h" - - int main() - { - /. - Declare an integer set and populate it with the elements - shown above. - ./ - #define MAXSIZ 7 - #define ITMLEN 10 - - SPICECHAR_CELL ( set, MAXSIZ, ITMLEN ); - - SpiceChar * cElt; - - SpiceChar inputs [MAXSIZ][ITMLEN] = - { - "8", "1", "2", "9", "7", "4", "10" - }; - - SpiceInt expected [MAXSIZ] = - { - 5, 0, 2, 6, 4, 3, 1 - }; - - SpiceInt i; - - - /. - Create the set. - ./ - - for ( i = 0; i < MAXSIZ; i++ ) - { - insrtc_c ( inputs[i], &set ); - } - - /. - Examine the ordinal positions of the set's elements. - Extract each element and verify that ordc_c gives the - index at which the element is located. - ./ - - for ( i = 0; i < card_c(&set); i++ ) - { - cElt = inputs[i]; - - if ( ordc_c(cElt, &set) != expected[i] ) - { - setmsg_c ( "Position of # was expected to be # " - "but was actually #." ); - errch_c ( "#", cElt ); - errint_c ( "#", expected[i] ); - errint_c ( "#", ordc_c(cElt,&set) ); - sigerr_c ( "INVALID LOCATION" ); - } - } - - return ( 0 ); - } - - --Restrictions - - 1) 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) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 21-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - the ordinal position of an element in a set - --& -*/ -{ - /* - Use discovery check-in. - - Check the input string pointer to make sure it's not null. - */ - CHKPTR_VAL ( CHK_DISCOVER, "ordc_c", item, -1 ); - - - /* - Make sure we're working with a character cell. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, "ordc_c", SPICE_CHR, set, -1 ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK_VAL ( CHK_DISCOVER, "ordc_c", set, -1 ); - - /* - The routine bsrchc_c returns the index of the item in the set, - or -1 if the item is not present. - */ - return ( bsrchc_c ( item, set->card, set->length, set->data ) ); -} - diff --git a/ext/spice/src/cspice/ordd.c b/ext/spice/src/cspice/ordd.c deleted file mode 100644 index e2bfb4bb8f..0000000000 --- a/ext/spice/src/cspice/ordd.c +++ /dev/null @@ -1,222 +0,0 @@ -/* ordd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ORDD ( The ordinal position of an element in a set ) */ -integer ordd_(doublereal *item, doublereal *set) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchd_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* The function returns the ordinal position of any given item in a */ -/* set. If the item does not appear in the set, the function returns */ -/* zero. */ - -/* $ 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 */ -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I An item to locate within a set. */ -/* SET I A set to search for a given item. */ - -/* The function returns the ordinal position of ITEM within the SET. */ - -/* $ Detailed_Input */ - -/* ITEM Is an DOUBLE PRECISION value to be located within a */ -/* set. */ - -/* SET Is a properly validated SPICELIB set that is to be */ -/* searched for the occurrence of item. */ - -/* $ Detailed_Output */ - -/* The function returns the ordinal position of ITEM within SET. */ -/* If ITEM is not an element of SET, the function is returned as 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A natural ordering can be imposed upon the elements of any */ -/* SPICELIB set, be it INTEGER, CHARACTER or DOUBLE PRECISION. For */ -/* character strings the ASCII collating sequence serves as the */ -/* ordering relation, for DOUBLE PRECISION and INTEGER variables */ -/* the arithmetic ordering is used. */ - -/* Given any element of a set, its location within this ordered */ -/* sequence of elements is called its ordinal position within */ -/* the set. */ - -/* For illustrative purposes suppose that SET represents the set */ - -/* { 8, 1, 2, 9, 7, 4, 10 } */ - -/* The ordinal position of: 8 is 5 */ -/* 1 is 1 */ -/* 2 is 2 */ -/* 9 is 6 */ -/* 7 is 4 */ -/* 4 is 3 */ -/* 10 is 7 */ - -/* Given an item of the SET, this routine returns its ordinal */ -/* position. If the item is not in the set, this function returns */ -/* a value of 0. */ - -/* $ Examples */ - -/* Suppose that you wished to find the relative position of a value */ -/* in a large list of values stored within an array. Say we want */ -/* to know the relative position of item I of ARRAY withing the */ -/* set of values represented in ARRAY. */ - -/* The following sequence of subroutine calls would allow you */ -/* determine the relative position of the value ARRAY(I). */ - -/* INTEGER N */ -/* PARAMETER ( N = something useful ) */ - -/* DOUBLE PRECISION ARRAY ( N ) */ -/* DOUBLE PRECISION SET ( LBCELL: N ) */ -/* INTEGER I */ - -/* INTEGER NVALID */ -/* INTEGER POSITION */ - - -/* set the value of NVALID to be the number of valid elements in the */ -/* array ARRAY */ - -/* CALL MOVED ( ARRAY, N, SET(1) ) */ -/* CALL VALIDD ( N, NVALID, SET ) */ - -/* POSITION = ORDD ( ARRAY(I), SET ) */ - -/* POSITION now contains the ordinal position of ARRAY(I) within the */ -/* values represented in the array. */ - -/* $ Restrictions */ - -/* SET must be a validated or empty set. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* the ordinal position of an element in a set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling: */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("ORDD", (ftnlen)4); - } - -/* Given the structure of sets, there's not much to do. */ - - i__1 = cardd_(set); - ret_val = bsrchd_(item, &i__1, &set[6]); - chkout_("ORDD", (ftnlen)4); - return ret_val; -} /* ordd_ */ - diff --git a/ext/spice/src/cspice/ordd_c.c b/ext/spice/src/cspice/ordd_c.c deleted file mode 100644 index f0fb3c41ed..0000000000 --- a/ext/spice/src/cspice/ordd_c.c +++ /dev/null @@ -1,255 +0,0 @@ -/* - --Procedure ordd_c ( The ordinal position of an element in a set ) - --Abstract - - The function returns the ordinal position of any given item in a - double precision set. If the item does not appear in the set, the - function returns -1. - --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 - - SETS - --Keywords - - SEARCH - SETS - -*/ - - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - SpiceInt ordd_c ( SpiceDouble item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I An item to locate within a set. - set I A set to search for a given item. - - The function returns the ordinal position of item within the set. - --Detailed_Input - - item is a double precision number to be located within a set. - - set is a double precision CSPICE set that is to be searched - for the occurrence of item. - - set must be declared as a double precision SpiceCell. - --Detailed_Output - - The function returns the ordinal position of item within set. - Ordinal positions range from 0 to N-1, where N is the cardinality - of the set. - - If item is not an element of set, the function returns -1. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - double precision, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - --Files - - None. - --Particulars - - A natural ordering can be imposed upon the elements of any - CSPICE set, be it integer, character or double precision. For - character strings the ASCII collating sequence serves as the - ordering relation, for double precision and integer variables - the arithmetic ordering is used. - - Given any element of a set, its location within this ordered - sequence of elements is called its ordinal position within - the set. - - In common mathematical usage, ordinal positions of elements - in a set of cardinality N range from 1 to N. In C programs, - it is much more convenient to use the range 0 to N-1; this is - the convention used in CSPICE. - - For illustrative purposes suppose that set represents the set - - { 8, 1, 2, 9, 7, 4, 10 } - - The ordinal position of: - - 8 is 4 - 1 is 0 - 2 is 1 - 9 is 5 - 7 is 3 - 4 is 2 - 10 is 6 - --Examples - - 1) Obtain the ordinal positions shown in the table of the Particulars - section above. - - - #include "SpiceUsr.h" - - int main() - { - /. - Declare a double precision set and populate it with - the elements shown above. - ./ - #define MAXSIZ 7 - - SPICEDOUBLE_CELL ( set, MAXSIZ ); - - SpiceDouble inputs [MAXSIZ] = - { - 8.0, 1.0, 2.0, 9.0, 7.0, 4.0, 10.0 - }; - - SpiceDouble expected [MAXSIZ] = - { - 4.0, 0.0, 1.0, 5.0, 3.0, 2.0, 6.0 - }; - - SpiceInt i; - SpiceDouble dElt; - - - /. - Create the set. - ./ - - for ( i = 0; i < MAXSIZ; i++ ) - { - insrtd_c ( inputs[i], &set ); - } - - /. - Examine the ordinal positions of the set's elements. - Extract each element and verify that ordd_c gives the - index at which the element is located. - ./ - - for ( i = 0; i < card_c(&set); i++ ) - { - dElt = inputs[i]; - - if ( ordd_c(dElt, &set) != expected[i] ) - { - setmsg_c ( "Position of # was expected to be # " - "but was actually #." ); - errdp_c ( "#", dElt ); - errdp_c ( "#", expected[i] ); - errint_c ( "#", ordd_c(dElt,&set) ); - sigerr_c ( "INVALID LOCATION" ); - } - } - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - the ordinal position of an element in a set - --& -*/ - -{ /* Begin ordd_c */ - - - /* - Use discovery check-in. - - Make sure we're working with a double precision cell. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, "ordd_c", SPICE_DP, set, -1 ); - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK_VAL ( CHK_DISCOVER, "ordd_c", set, -1 ); - - /* - The routine bsrchd_c returns the index of the item in the set, - or -1 if the item is not present. - */ - return ( bsrchd_c ( item, set->card, set->data ) ); - - -} /* End ordd_c */ - - diff --git a/ext/spice/src/cspice/orderc.c b/ext/spice/src/cspice/orderc.c deleted file mode 100644 index b7dbad17b6..0000000000 --- a/ext/spice/src/cspice/orderc.c +++ /dev/null @@ -1,186 +0,0 @@ -/* orderc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ORDERC ( Order of a character array ) */ -/* Subroutine */ int orderc_(char *array, integer *ndim, integer *iorder, - ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - logical l_le(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg, gap; - -/* $ Abstract */ - -/* Determine the order of elements in an array of character strings. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NDIM I Dimension of ARRAY. */ -/* IORDER O Order vector for ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* IORDER is the order vector for the input array. */ -/* IORDER(1) is the index of the smallest element */ -/* of ARRAY; IORDER(2) is the index of the next */ -/* smallest; and so on. Strings are ordered according */ -/* to the ASCII collating sequence. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* ORDERC finds the index of the smallest element of the input */ -/* array. This becomes the first element of the order vector. */ -/* The process is repeated for the rest of the elements. */ - -/* The order vector returned by ORDERC may be used by any of */ -/* the REORD routines to sort sets of related arrays, as shown */ -/* in the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, integer ID codes, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by name. */ -/* C */ -/* CALL ORDERC ( NAMES, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDI ( IORDER, N, CODES ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* order of a character array */ - -/* -& */ - -/* Local variables */ - - -/* Begin with the initial ordering. */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - iorder[i__ - 1] = i__; - } - -/* Find the smallest element, then the next smallest, and so on. */ -/* This uses the Shell Sort algorithm, but swaps the elements of */ -/* the order vector instead of the array itself. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (l_le(array + (iorder[j - 1] - 1) * array_len, array + ( - iorder[jg - 1] - 1) * array_len, array_len, array_len) - ) { - j = 0; - } else { - swapi_(&iorder[j - 1], &iorder[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* orderc_ */ - diff --git a/ext/spice/src/cspice/orderc_c.c b/ext/spice/src/cspice/orderc_c.c deleted file mode 100644 index 791bc37212..0000000000 --- a/ext/spice/src/cspice/orderc_c.c +++ /dev/null @@ -1,245 +0,0 @@ -/* - --Procedure orderc_c ( Order of a character array ) - --Abstract - - Determine the order of elements in an array of character strings. - --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 - - ARRAY, SORT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef orderc_c - - - void orderc_c ( SpiceInt lenvals, - const void * array, - SpiceInt ndim, - SpiceInt * iorder ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - lenvals I String length. - array I Input array. - ndim I Dimension of array. - iorder O Order vector for array. - --Detailed_Input - - lenvals is the declared length of the strings in the input - string array, including null terminators. The input - array should be declared with dimension - - [ndim][lenvals] - - array is the input array. - - ndim is the number of elements in the input array. - --Detailed_Output - - iorder is the order vector for the input array. - iorder[0] is the index of the smallest element - of array; iorder[1] is the index of the next - smallest; and so on. Strings are ordered according - to the ASCII collating sequence. Trailing white space - is ignored when comparing strings. - - The elements of iorder range from zero to ndim-1. - --Parameters - - None. - --Exceptions - - 1) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the input array string's length is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 3) If ndim < 1, this routine returns immediately. This case is not - considered an error. - --Files - - None. - --Particulars - - orderc_c finds the index of the smallest element of the input - array. This becomes the first element of the order vector. - The process is repeated for the rest of the elements. - - The order vector returned by orderc_c may be used by any of - the reord* routines to sort sets of related arrays, as shown - in the example below. - --Examples - - In the following example, the order and reord routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by name. - ./ - - orderc_c ( namlen, names, n, iorder ); - - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - - --Restrictions - - 1) 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. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-JUL-2002 (NJB) (IMU) - --Index_Entries - - order of a character array - --& -*/ - -{ /* Begin orderc_c */ - - - /* - Local variables - */ - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - SpiceInt i; - - - /* - Participate in error tracing. - */ - chkin_c ( "orderc_c" ); - - /* - Return immediately if the array dimension is non-positive. - */ - if ( ndim < 1 ) - { - chkout_c ( "orderc_c" ); - return; - } - - /* - Make sure the input pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "orderc_c", array, lenvals ); - - - /* - Create a Fortran-style string array. - */ - C2F_MapStrArr ( "orderc_c", - ndim, lenvals, array, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - chkout_c ( "orderc_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - orderc_ ( ( char * ) fCvalsArr, - ( integer * ) &ndim, - ( integer * ) iorder, - ( ftnlen ) fCvalsLen ); - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - - /* - Map the order vector elements to the range 0 : ndim-1. - */ - for ( i = 0; i < ndim; i++ ) - { - --iorder[i]; - } - - - chkout_c ( "orderc_c" ); - -} /* End orderc_c */ diff --git a/ext/spice/src/cspice/orderd.c b/ext/spice/src/cspice/orderd.c deleted file mode 100644 index e29eb64594..0000000000 --- a/ext/spice/src/cspice/orderd.c +++ /dev/null @@ -1,189 +0,0 @@ -/* orderd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ORDERD ( Order of a double precision array ) */ -/* Subroutine */ int orderd_(doublereal *array, integer *ndim, integer * - iorder) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg, gap; - -/* $ Abstract */ - -/* Determine the order of elements in a double precision array. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NDIM I Dimension of ARRAY. */ -/* IORDER O Order vector for ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* IORDER is the order vector for the input array. */ -/* IORDER(1) is the index of the smallest element */ -/* of ARRAY; IORDER(2) is the index of the next */ -/* smallest; and so on. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) A negative input dimension causes this routine to */ -/* leave the output order vector unchanged. */ - -/* This routine is error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ORDERD finds the index of the smallest element of the input */ -/* array. This becomes the first element of the order vector. */ -/* The process is repeated for the rest of the elements. */ - -/* The order vector returned by ORDERD may be used by any of */ -/* the REORD routines to sort sets of related arrays, as shown */ -/* in the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, integer ID codes, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by visual magnitude. */ -/* C */ -/* CALL ORDERD ( VMAGS, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDI ( IORDER, N, CODES ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-MAR-2010 (NJB) */ - -/* Header example was updated to show use of this routine. */ -/* Exceptions section was updated. Header sections were */ -/* re-ordered. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* order of a d.p. array */ - -/* -& */ - -/* Local variables */ - - -/* Begin with the initial ordering. */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - iorder[i__ - 1] = i__; - } - -/* Find the smallest element, then the next smallest, and so on. */ -/* This uses the Shell Sort algorithm, but swaps the elements of */ -/* the order vector instead of the array itself. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (array[iorder[j - 1] - 1] <= array[iorder[jg - 1] - 1]) { - j = 0; - } else { - swapi_(&iorder[j - 1], &iorder[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* orderd_ */ - diff --git a/ext/spice/src/cspice/orderd_c.c b/ext/spice/src/cspice/orderd_c.c deleted file mode 100644 index 57fac9c91b..0000000000 --- a/ext/spice/src/cspice/orderd_c.c +++ /dev/null @@ -1,178 +0,0 @@ -/* - --Procedure orderd_c ( Order of a double precision array ) - --Abstract - - Determine the order of elements in a double precision array. - --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 - - ARRAY, SORT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef orderd_c - - - void orderd_c ( ConstSpiceDouble * array, - SpiceInt ndim, - SpiceInt * iorder ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - array I Input array. - ndim I Dimension of array. - iorder O Order vector for array. - --Detailed_Input - - array is the input array. - - ndim is the number of elements in the input array. - --Detailed_Output - - iorder is the order vector for the input array. - iorder[0] is the index of the smallest element - of array; iorder[1] is the index of the next - smallest; and so on. - - The elements of iorder range from zero to ndim-1. --Parameters - - None. - --Exceptions - - 1) A negative input dimension causes this routine to - leave the output order vector unchanged. - - This routine is error free. - --Files - - None. - --Particulars - - orderd_c finds the index of the smallest element of the input - array. This becomes the first element of the order vector. - The process is repeated for the rest of the elements. - - The order vector returned by orderd_c may be used by any of - the reord* routines to sort sets of related arrays, as shown - in the example below. - --Examples - - In the following example, the order* and reord* routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by visual magnitude. - ./ - - orderd_c ( vmags, n, iorder ); - - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 23-MAR-2010 (NJB) - - Header example was updated to show use of this routine. - Exceptions section was updated. Header sections were - re-ordered. - - -CSPICE Version 1.0.0, 08-JUL-2002 (NJB) (IMU) - --Index_Entries - - order of a d.p. array - --& -*/ - -{ /* Begin orderd_c */ - - /* - Local variables - */ - SpiceInt i; - - - - orderd_ ( ( doublereal * ) array, - ( integer * ) &ndim, - ( integer * ) iorder ); - - /* - Map the order vector elements to the range 0 : ndim-1. - */ - for ( i = 0; i < ndim; i++ ) - { - --iorder[i]; - } - -} /* End orderd_c */ diff --git a/ext/spice/src/cspice/orderi.c b/ext/spice/src/cspice/orderi.c deleted file mode 100644 index 83f84a157e..0000000000 --- a/ext/spice/src/cspice/orderi.c +++ /dev/null @@ -1,188 +0,0 @@ -/* orderi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ORDERI ( Order of an integer array ) */ -/* Subroutine */ int orderi_(integer *array, integer *ndim, integer *iorder) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg, gap; - -/* $ Abstract */ - -/* Determine the order of elements in an integer array. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NDIM I Dimension of ARRAY. */ -/* IORDER O Order vector for ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* NDIM is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* IORDER is the order vector for the input array. */ -/* IORDER(1) is the index of the smallest element */ -/* of ARRAY; IORDER(2) is the index of the next */ -/* smallest; and so on. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) A negative input dimension causes this routine to */ -/* leave the output order vector unchanged. */ - -/* This routine is error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ORDERI finds the index of the smallest element of the input */ -/* array. This becomes the first element of the order vector. */ -/* The process is repeated for the rest of the elements. */ - -/* The order vector returned by ORDERI may be used by any of */ -/* the REORD routines to sort sets of related arrays, as shown */ -/* in the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, integer ID codes, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by ID code. */ -/* C */ -/* CALL ORDERI ( CODES, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDI ( IORDER, N, CODES ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-MAR-2010 (NJB) */ - -/* Header example was updated to show use of this routine. */ -/* Exceptions section was updated. Header sections were */ -/* re-ordered. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* order of an integer array */ - -/* -& */ - -/* Local variables */ - - -/* Begin with the initial ordering. */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - iorder[i__ - 1] = i__; - } - -/* Find the smallest element, then the next smallest, and so on. */ -/* This uses the Shell Sort algorithm, but swaps the elements of */ -/* the order vector instead of the array itself. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (array[iorder[j - 1] - 1] <= array[iorder[jg - 1] - 1]) { - j = 0; - } else { - swapi_(&iorder[j - 1], &iorder[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* orderi_ */ - diff --git a/ext/spice/src/cspice/orderi_c.c b/ext/spice/src/cspice/orderi_c.c deleted file mode 100644 index df3b0e5a51..0000000000 --- a/ext/spice/src/cspice/orderi_c.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - --Procedure orderi_c ( Order of an integer array ) - --Abstract - - Determine the order of elements in an integer array. - --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 - - ARRAY, SORT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef orderi_c - - - void orderi_c ( ConstSpiceInt * array, - SpiceInt ndim, - SpiceInt * iorder ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - array I Input array. - ndim I Dimension of array. - iorder O Order vector for array. - --Detailed_Input - - array is the input array. - - ndim is the number of elements in the input array. - --Detailed_Output - - iorder is the order vector for the input array. - iorder[0] is the index of the smallest element - of array; iorder[1] is the index of the next - smallest; and so on. - - The elements of iorder range from zero to ndim-1. - --Parameters - - None. - --Exceptions - - 1) A negative input dimension causes this routine to - leave the output order vector unchanged. - - This routine is error free. - --Files - - None. - --Particulars - - orderi_c finds the index of the smallest element of the input - array. This becomes the first element of the order vector. - The process is repeated for the rest of the elements. - - The order vector returned by orderi_c may be used by any of - the reord*_c routines to sort sets of related arrays, as shown - in the example below. - --Examples - - In the following example, the order*_c and reord*_c routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by ID code. - ./ - - orderi_c ( codes, n, iorder ); - - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 23-MAR-2010 (NJB) - - Header example was updated to show use of this routine. - Exceptions section was updated. Header sections were - re-ordered. - - -CSPICE Version 1.0.0, 08-JUL-2002 (NJB) (IMU) - --Index_Entries - - order of an integer array - --& -*/ - -{ /* Begin orderi_c */ - - /* - Local variables - */ - SpiceInt i; - - - /* - Call the f2c'd routine. - */ - orderi_ ( ( integer * ) array, - ( integer * ) &ndim, - ( integer * ) iorder ); - - /* - Map the order vector elements to the range 0 : ndim-1. - */ - for ( i = 0; i < ndim; i++ ) - { - --iorder[i]; - } - - -} /* End orderi_c */ diff --git a/ext/spice/src/cspice/ordi.c b/ext/spice/src/cspice/ordi.c deleted file mode 100644 index 0e9fdcf05f..0000000000 --- a/ext/spice/src/cspice/ordi.c +++ /dev/null @@ -1,221 +0,0 @@ -/* ordi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ORDI ( The ordinal position of an element in a set ) */ -integer ordi_(integer *item, integer *set) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* The function returns the ordinal position of any given item in a */ -/* set. If the item does not appear in the set, the function returns */ -/* zero. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* SEARCH */ -/* SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I An item to locate within a set. */ -/* SET I A set to search for a given item. */ - -/* The function returns the ordinal position of ITEM within the SET. */ - -/* $ Detailed_Input */ - -/* ITEM Is an INTEGER to be located within a set. */ - -/* SET Is a properly validated SPICELIB set that is to be */ -/* searched for the occurrence of item. */ - -/* $ Detailed_Output */ - -/* The function returns the ordinal position of ITEM within SET. */ -/* If ITEM is not an element of SET, the function is returned as 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A natural ordering can be imposed upon the elements of any */ -/* SPICELIB set, be it INTEGER, CHARACTER or DOUBLE PRECISION. For */ -/* character strings the ASCII collating sequence serves as the */ -/* ordering relation, for DOUBLE PRECISION and INTEGER variables */ -/* the arithmetic ordering is used. */ - -/* Given any element of a set, its location within this ordered */ -/* sequence of elements is called its ordinal position within */ -/* the set. */ - -/* For illustrative purposes suppose that SET represents the set */ - -/* { 8, 1, 2, 9, 7, 4, 10 } */ - -/* The ordinal position of: 8 is 5 */ -/* 1 is 1 */ -/* 2 is 2 */ -/* 9 is 6 */ -/* 7 is 4 */ -/* 4 is 3 */ -/* 10 is 7 */ - -/* Given an item of the SET, this routine returns its ordinal */ -/* position. If the item is not in the set, this function returns */ -/* a value of 0. */ - -/* $ Examples */ - -/* Suppose that you wished to find the relative position of a value */ -/* in a large list of values stored within an array. Say we want */ -/* to know the relative position of item I of ARRAY withing the */ -/* set of values represented in ARRAY. */ - -/* The following sequence of subroutine calls would allow you */ -/* determine the relative position of the value ARRAY(I). */ - -/* INTEGER N */ -/* PARAMETER ( N = something useful ) */ - -/* INTEGER ARRAY ( N ) */ -/* INTEGER SET ( LBCELL: N ) */ -/* INTEGER I */ - -/* INTEGER NVALID */ -/* INTEGER POSITION */ - - -/* set the value of NVALID to be the number of valid elements in the */ -/* array ARRAY */ - -/* CALL MOVEI ( ARRAY, N, SET(1) ) */ -/* CALL VALIDI ( N, NVALID, SET ) */ - -/* POSITION = ORDI ( ARRAY(I), SET ) */ - -/* POSITION now contains the ordinal position of ARRAY(I) within the */ -/* values represented in the array. */ - -/* $ Restrictions */ - -/* SET must be a validated or empty set. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* the ordinal position of an element in a set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling: */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("ORDI", (ftnlen)4); - } - -/* Given the structure of sets, there's not much to do. */ - - i__1 = cardi_(set); - ret_val = bsrchi_(item, &i__1, &set[6]); - chkout_("ORDI", (ftnlen)4); - return ret_val; -} /* ordi_ */ - diff --git a/ext/spice/src/cspice/ordi_c.c b/ext/spice/src/cspice/ordi_c.c deleted file mode 100644 index 924dc377d8..0000000000 --- a/ext/spice/src/cspice/ordi_c.c +++ /dev/null @@ -1,253 +0,0 @@ -/* - --Procedure ordi_c ( The ordinal position of an element in a set ) - --Abstract - - The function returns the ordinal position of any given item in an - integer set. If the item does not appear in the set, the function - returns -1. - --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 - - SETS - --Keywords - - SEARCH - SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - SpiceInt ordi_c ( SpiceInt item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I An item to locate within a set. - set I A set to search for a given item. - - The function returns the ordinal position of item within the set. - --Detailed_Input - - item is an integer to be located within a set. - - set is an integer CSPICE set that is to be searched for the - occurrence of item. - - set must be declared as an integer SpiceCell. - --Detailed_Output - - The function returns the ordinal position of item within set. - Ordinal positions range from 0 to N-1, where N is the cardinality - of the set. - - If item is not an element of set, the function returns -1. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - integer, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - --Files - - None. - --Particulars - - A natural ordering can be imposed upon the elements of any - CSPICE set, be it integer, character or double precision. For - character strings the ASCII collating sequence serves as the - ordering relation, for double precision and integer variables - the arithmetic ordering is used. - - Given any element of a set, its location within this ordered - sequence of elements is called its ordinal position within - the set. - - In common mathematical usage, ordinal positions of elements - in a set of cardinality N range from 1 to N. In C programs, - it is much more convenient to use the range 0 to N-1; this is - the convention used in CSPICE. - - For illustrative purposes suppose that set represents the set - - { 8, 1, 2, 9, 7, 4, 10 } - - The ordinal position of: - - 8 is 4 - 1 is 0 - 2 is 1 - 9 is 5 - 7 is 3 - 4 is 2 - 10 is 6 - --Examples - - 1) Obtain the ordinal positions shown in the table of the Particulars - section above. - - - #include "SpiceUsr.h" - - int main() - { - /. - Declare an integer set and populate it with the elements - shown above. - ./ - #define MAXSIZ 7 - - SPICEINT_CELL ( set, MAXSIZ ); - - SpiceInt inputs [MAXSIZ] = - { - 8, 1, 2, 9, 7, 4, 10 - }; - - SpiceInt expected [MAXSIZ] = - { - 4, 0, 1, 5, 3, 2, 6 - }; - - SpiceInt i; - SpiceInt iElt; - - - /. - Create the set. - ./ - - for ( i = 0; i < MAXSIZ; i++ ) - { - insrti_c ( inputs[i], &set ); - } - - /. - Examine the ordinal positions of the set's elements. - Extract each element and verify that ordi_c gives the - index at which the element is located. - ./ - - for ( i = 0; i < card_c(&set); i++ ) - { - iElt = inputs[i]; - - if ( ordi_c(iElt, &set) != expected[i] ) - { - setmsg_c ( "Position of # was expected to be # " - "but was actually #." ); - errint_c ( "#", iElt ); - errint_c ( "#", expected[i] ); - errint_c ( "#", ordi_c(iElt,&set) ); - sigerr_c ( "INVALID LOCATION" ); - } - } - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - the ordinal position of an element in a set - --& -*/ - -{ /* Begin ordi_c */ - - - /* - Use discovery check-in. - - Make sure we're working with an integer cell. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, "ordi_c", SPICE_INT, set, -1 ); - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK_VAL ( CHK_DISCOVER, "ordi_c", set, -1 ); - - /* - The routine bsrchi_c returns the index of the item in the set, - or -1 if the item is not present. - */ - return ( bsrchi_c ( item, set->card, set->data ) ); - - -} /* End ordi_c */ - diff --git a/ext/spice/src/cspice/oscelt.c b/ext/spice/src/cspice/oscelt.c deleted file mode 100644 index 19dd186b05..0000000000 --- a/ext/spice/src/cspice/oscelt.c +++ /dev/null @@ -1,674 +0,0 @@ -/* oscelt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b16 = 0.; -static doublereal c_b17 = 1.; -static doublereal c_b18 = 1e-10; - -/* $Procedure OSCELT ( Determine conic elements from state ) */ -/* Subroutine */ int oscelt_(doublereal *state, doublereal *et, doublereal * - mu, doublereal *elts) -{ - /* Initialized data */ - - static doublereal zvec[3] = { 0.,0.,1. }; - - /* System generated locals */ - doublereal d__1, d__2, d__3; - - /* Builtin functions */ - double atan2(doublereal, doublereal), cos(doublereal), sqrt(doublereal), - sin(doublereal), d_sign(doublereal *, doublereal *), sinh( - doublereal), tan(doublereal); - - /* Local variables */ - doublereal rmag, argp, vmag; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal e[3], h__[3], n[3], p, r__[3], v[3], cosea; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal sinea, lnode, coshf; - extern doublereal exact_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int vpack_(doublereal *, doublereal *, doublereal - *, doublereal *), errdp_(char *, doublereal *, ftnlen), vlcom_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - doublereal perix[3], periy[3], xprod[3], m0; - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *), vcrss_(doublereal *, doublereal *, doublereal *); - extern doublereal vnorm_(doublereal *), twopi_(void); - extern logical vzero_(doublereal *); - doublereal ea; - extern doublereal pi_(void), dacosh_(doublereal *); - doublereal nu, rp; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *, - ftnlen); - extern logical return_(void); - doublereal ecc, inc; - -/* $ Abstract */ - -/* Determine the set of osculating conic orbital elements that */ -/* corresponds to the state (position, velocity) of a body at */ -/* some epoch. */ - -/* $ 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 */ - -/* CONIC */ -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STATE I State of body at epoch of elements. */ -/* ET I Epoch of elements. */ -/* MU I Gravitational parameter (GM) of primary body. */ -/* ELTS O Equivalent conic elements. */ - -/* $ Detailed_Input */ - -/* STATE is the state (position and velocity) of the body */ -/* at some epoch. Components are x, y, z, dx/dt, dy/dt, */ -/* dz/dt. STATE must be expressed relative to an */ -/* inertial reference frame. Units are km and km/sec. */ - - -/* ET is the epoch of the input state, in ephemeris seconds */ -/* past J2000. */ - -/* 3 2 */ -/* MU is the gravitational parameter (GM, km /sec ) of */ -/* the primary body. */ - -/* $ Detailed_Output */ - -/* ELTS are equivalent conic elements describing the orbit */ -/* of the body around its primary. The elements are, */ -/* in order: */ - -/* RP Perifocal distance. */ -/* ECC Eccentricity. */ -/* INC Inclination. */ -/* LNODE Longitude of the ascending node. */ -/* ARGP Argument of periapsis. */ -/* M0 Mean anomaly at epoch. */ -/* T0 Epoch. */ -/* MU Gravitational parameter. */ - -/* The epoch of the elements is the epoch of the input */ -/* state. Units are km, rad, rad/sec. The same elements */ -/* are used to describe all three types (elliptic, */ -/* hyperbolic, and parabolic) of conic orbit. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If MU is not positive, the error SPICE(NONPOSITIVEMASS) */ -/* is signaled. */ - -/* 2) If the specific angular momentum vector derived from STATE */ -/* is the zero vector, the error SPICE(DEGENERATECASE) */ -/* is signaled. */ - -/* 3) If the position or velocity vectors derived from STATE */ -/* is the zero vector, the error SPICE(DEGENERATECASE) */ -/* is signaled. */ - -/* 4) If the inclination is determined to be zero or 180 degrees, */ -/* the longitude of the ascending node is set to zero. */ - -/* 5) If the eccentricity is determined to be zero, the argument of */ -/* periapse is set to zero. */ - -/* 6) If the eccentricy of the orbit is very close to but not */ -/* equal to zero, the argument of periapse may not be accurately */ -/* determined. */ - -/* 7) For inclinations near but not equal to 0 or 180 degrees, */ -/* the longitude of the ascending node may not be determined */ -/* accurately. The argument of periapse and mean anomaly may */ -/* also be inaccurate. */ - -/* 8) For eccentricities very close to but not equal to 1, the */ -/* results of this routine are unreliable. */ - -/* 9) If the specific angular momentum vector is non-zero but */ -/* "close" to zero, the results of this routine are unreliable. */ - -/* 10) If STATE is expressed relative to a non-inertial reference */ -/* frame, the resulting elements are invalid. No error checking */ -/* is done to detect this problem. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The SPICELIB routine CONICS is the inverse of this routine: */ -/* CONICS maps a set of osculating elements and a time to a state */ -/* vector. */ - -/* $ Examples */ - -/* Let VINIT contain the initial state of a spacecraft relative to */ -/* the center of a planet at epoch ET, and let GM be the gravitation */ -/* parameter of the planet. The call */ - -/* CALL OSCELT ( VINIT, ET, GM, ELTS ) */ - -/* produces a set of osculating elements describing the nominal */ -/* orbit that the spacecraft would follow in the absence of all */ -/* other bodies in the solar system. */ - -/* Now let STATE contain the state of the same spacecraft at some */ -/* other epoch, LATER. The difference between this state and the */ -/* state predicted by the nominal orbit at the same epoch can be */ -/* computed as follows. */ - -/* CALL CONICS ( ELTS, LATER, NOMINAL ) */ -/* CALL VSUBG ( NOMINAL, STATE, 6, DIFF ) */ - -/* WRITE (*,*) 'Perturbation in x, dx/dt = ', DIFF(1), DIFF(4) */ -/* WRITE (*,*) ' y, dy/dt = ', DIFF(2), DIFF(5) */ -/* WRITE (*,*) ' z, dz/dt = ', DIFF(3), DIFF(6) */ - -/* $ Restrictions */ - -/* 1) The input state vector must be expressed relative to an */ -/* inertial reference frame. */ - -/* 2) Osculating elements are generally not useful for */ -/* high-accuracy work. */ - -/* 3) Accurate osculating elements may be difficult to derive for */ -/* near-circular or near-equatorial orbits. Osculating elements */ -/* for such orbits should be used with caution. */ - -/* 4) Extracting osculating elements from a state vector is a */ -/* mathematically simple but numerically challenging task. The */ -/* mapping from a state vector to equivalent elements is */ -/* undefined for certain state vectors, and the mapping is */ -/* difficult to implement with finite precision arithmetic for */ -/* states near the subsets of R6 where singularities occur. */ - -/* In general, the elements found by this routine can have */ -/* two kinds of problems: */ - -/* - The elements are not accurate but still represent */ -/* the input state accurately. The can happen in */ -/* cases where the inclination is near zero or 180 */ -/* degrees, or for near-circular orbits. */ - -/* - The elements are garbage. This can occur when */ -/* the eccentricity of the orbit is close to but */ -/* not equal to 1. In general, any inputs that cause */ -/* great loss of precision in the computation of the */ -/* specific angular momentum vector or the eccentricity */ -/* vector will result in invalid outputs. */ - -/* For further details, see the Exceptions section. */ - -/* Users of this routine should carefully consider whether */ -/* it is suitable for their applications. One recommended */ -/* "sanity check" on the outputs is to supply them to the */ -/* SPICELIB routine CONICS and compare the resulting state */ -/* vector with the one supplied to this routine. */ - -/* $ Literature_References */ - -/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.1, 28-FEB-2008 (NJB) */ - -/* Updated Index_Entries header section to use keywords */ -/* "osculating" and "convert." Updated Particulars header */ -/* section to refer to CONICS. Fixed typo in in-line */ -/* comments. */ - -/* - SPICELIB Version 1.3.0, 17-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* The Exceptions and Restrictions header sections were updated. */ - -/* - SPICELIB Version 1.2.0, 28-JAN-2003 (NJB) (EDW) */ - -/* Bug fixes: routine previously didn't correctly compute */ -/* the argument of periapse or mean anomaly for some cases. */ -/* Also, the arguments of the ACOS and DACOSH functions were */ -/* able to go out of range, causing floating-point exceptions. */ - -/* The computations of M0 and INC were re-coded for improved */ -/* accuracy. */ - -/* Also, added error checks for non-positive MU, zero */ -/* position, velocity, and specific angular momentum vectors. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - SPICELIB Version 1.0.2, 6-APR-1995 (WLT) */ - -/* A typo was fixed in the description of the node vector */ -/* in the comments of the routine. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* conic elements from state */ -/* osculating elements from state */ -/* convert state to osculating elements */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - SPICELIB Version 1.2.0, 28-JAN-2003 (NJB) (EDW) */ - -/* Bug fixes: routine previously didn't correctly compute */ -/* the argument of periapse or mean anomaly for some cases. */ -/* Also, the arguments of the ACOS and DACOSH functions were */ -/* able to go out of range, causing floating-point exceptions. */ - -/* The old computation of ARGP did not work for cases where */ -/* the inclination was 0 or pi: the sign of ARGP was sometimes */ -/* incorrect. */ - -/* The new method uses the criterion: for inclination zero or pi */ -/* the argument of periapse is between zero and pi radians when */ - -/* e * ( h x n ) > 0 */ -/* - - - - */ - -/* where */ - -/* e is the eccentricity vector, */ -/* - */ - -/* h is the specific angular momentum vector, */ -/* - */ - -/* n is the node vector. */ -/* - */ - -/* The computation of M0 was re-coded for improved accuracy. */ -/* The new computation uses ATAN2 rather than ACOS to find */ -/* the eccentric anomaly for the ellipse case. The quadrant */ -/* of M0 is now found by converting the position to the */ -/* perifocal frame and finding the corresponding longitude. */ - -/* The old method, using the sign of , did not work */ -/* for circular orbits and was unreliable for near-circular */ -/* orbits. */ - -/* Inclination is now computed using VSEP. */ - -/* Also, added error checks for non-positive MU, zero */ -/* position, velocity, and specific angular momentum vectors. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - SPICELIB Version 1.0.2, 6-APR-1995 (WLT) */ - -/* A typo was fixed in the description of the node vector */ -/* in the comments of the routine. */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* External functions */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("OSCELT", (ftnlen)6); - } - if (*mu <= 0.) { - setmsg_("MU = #; non-positive gravitational parameter", (ftnlen)44); - errdp_("#", mu, (ftnlen)1); - sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22); - chkout_("OSCELT", (ftnlen)6); - return 0; - } - -/* In order to convert a position and velocity to an equivalent */ -/* set of (osculating) orbital elements, we need to determine three */ -/* principal vectors associated with the orbit: */ - -/* h The angular momentum vector. This is perpendicular */ -/* - to the plane of the orbit. */ - -/* h = r X v */ -/* - - - */ - -/* n The node vector. This is perpendicular to the */ -/* - normals of both the reference and orbital planes; */ -/* it lies in the intersecton of these planes, */ -/* pointing toward the ascending node. */ - -/* ^ */ -/* n = k X h = ( -h , h , 0 ) */ -/* - - y x */ - -/* e The eccentricity vector. This lies in the plane */ -/* - of the orbit, and points toward periapse. The */ -/* magnitude of this vector is the eccentricity. */ - -/* 2 */ -/* e = (1/mu)( (v - mu/r) r - v ) */ -/* - - - - - */ - - vequ_(state, r__); - vequ_(&state[3], v); - -/* Check for non-physical cases. Probably due to user */ -/* input error */ - - if (vzero_(r__)) { - setmsg_("Zero vector for input position vector.", (ftnlen)38); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("OSCELT", (ftnlen)6); - return 0; - } - if (vzero_(v)) { - setmsg_("Zero vector for input velocity vector.", (ftnlen)38); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("OSCELT", (ftnlen)6); - return 0; - } - rmag = vnorm_(r__); - vmag = vnorm_(v); - vcrss_(r__, v, h__); - -/* If the specific angular momentum vector is the zero vector, */ -/* we have a degenerate orbit and cannot proceed. */ - - if (vzero_(h__)) { - setmsg_("Input position and velocity are too close to parallel; the " - "specific angular momentum vector is zero.", (ftnlen)100); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("OSCELT", (ftnlen)6); - return 0; - } - d__1 = -h__[1]; - vpack_(&d__1, h__, &c_b16, n); -/* Computing 2nd power */ - d__2 = vmag; - d__1 = d__2 * d__2 - *mu / rmag; - d__3 = -vdot_(r__, v); - vlcom_(&d__1, r__, &d__3, v, e); - d__1 = 1. / *mu; - vsclip_(&d__1, e); - -/* We begin by determining the size and shape of the orbit. */ - -/* The eccentricity of the orbit is the magnitude of the */ -/* eccentricity vector. If the eccentricity is "close" to one, */ -/* go ahead and make this a parabola. */ - -/* The perifocal distance depends on the eccentricity and the */ -/* semi-latus rectum, which in turn orbit depends only on the */ -/* specific angular momentum of the orbiting object. */ - - d__1 = vnorm_(e); - ecc = exact_(&d__1, &c_b17, &c_b18); - p = vdot_(h__, h__) / *mu; - rp = p / (ecc + 1.); - -/* Next, the orientation of the orbit. */ -/* ^ */ -/* The inclination of the orbit is the angle between k (which is */ -/* perpendicular to the equator) and h (which is perpendicular to */ -/* the orbit. - */ - -/* If close to zero or pi, make it exact. In either case, the node */ -/* vector becomes undefined. */ - - inc = vsep_(h__, zvec); - if ((d__1 = inc + 0., abs(d__1)) < 1e-10) { - inc = 0.; - vpack_(&c_b17, &c_b16, &c_b16, n); - } else if ((d__1 = inc - pi_(), abs(d__1)) < 1e-10) { - inc = pi_(); - vpack_(&c_b17, &c_b16, &c_b16, n); - } - -/* ^ */ -/* The longitude of the ascending node is the angle between i */ -/* (the x-axis) and the node vector, n. */ -/* - */ - - lnode = atan2(n[1], n[0]); - if (lnode < 0.) { - lnode += twopi_(); - } - -/* The argument of periapsis is the angle between the node vector */ -/* n, and the eccentricity vector e. This is not defined for */ -/* - - */ -/* circular orbits. */ - - - if (ecc == 0.) { - argp = 0.; - } else { - -/* Set the magnitude of ARGP; we'll determine the sign next. */ - - argp = vsep_(n, e); - if (argp != 0.) { - if (inc == 0. || inc == pi_()) { - -/* The quadrant of ARGP is determined by the component of E */ -/* in the direction H x N. */ - - ucrss_(h__, n, xprod); - if (vdot_(e, xprod) < 0.) { - argp = twopi_() - argp; - } - } else if (e[2] < 0.) { - -/* The periapsis is below the reference plane; the argument */ -/* of periapsis must be greater than 180 degrees. */ - - argp = twopi_() - argp; - } - } - } - -/* And finally, the position of the object within the orbit. */ -/* The true anomaly, nu, is the angle between the eccentricity */ -/* and radius vectors, e and r. (For circular orbits, substitute */ -/* n for e.) - - */ -/* - - */ - -/* This angle increases in the counterclockwise direction about h. */ -/* We express the position in the perifocal frame in order to */ -/* extract nu. */ - - if (ecc == 0.) { - -/* In this case, the argument of periapse is set to zero, */ -/* so the nu is measured from N. */ - - vhat_(n, perix); - } else { - vhat_(e, perix); - } - ucrss_(h__, perix, periy); - nu = atan2(vdot_(r__, periy), vdot_(r__, perix)); - -/* Unfortunately, the other element routines need the mean */ -/* anomaly, M. The true and mean anomalies are related through */ -/* the eccentric anomalies D (parabolas), E (ellipses), and */ -/* F (hyperbolas), as shown below. */ - -/* e + cos(nu) */ -/* cos(E) = --------------- (ellipse) */ -/* 1 + e cos(nu) */ - -/* M = E - e sin(E) */ - - -/* e + cos(nu) */ -/* cosh(F) = --------------- (hyperbola) */ -/* 1 + e cos(nu) */ - -/* M = e sinh(F) - F */ - - -/* D = tan(nu/2) (parabola) */ - -/* 3 */ -/* M = D + D / 3 */ - -/* For elliptic orbits, the mean anomaly should be in [0,2*pi]. */ - - if (ecc < 1.) { - -/* For improved numerical performance, we compute both the */ -/* sine and cosine of the eccentric anomaly, then let ATAN2 */ -/* find the eccentric anomaly. */ - - cosea = (ecc + cos(nu)) / (ecc * cos(nu) + 1.); - -/* Here we use the relationships (here b is the length */ -/* of the semi-minor axis): */ - -/* a sin(E) = (a/b) r sin(nu) */ - -/* sin(E) = (r/b) sin(nu) */ -/* ______________ */ -/* = (r/rp) \/ (1-e) / (1+e) sin(nu) */ - - - sinea = rmag / rp * sqrt((1. - ecc) / (ecc + 1.)) * sin(nu); - ea = atan2(sinea, cosea); - d__1 = ea - ecc * sin(ea); - m0 = d_sign(&d__1, &nu); - if (m0 < 0.) { - m0 += twopi_(); - } - } else if (ecc > 1.) { - coshf = (ecc + cos(nu)) / (ecc * cos(nu) + 1.); - d__1 = max(1.,coshf); - ea = dacosh_(&d__1); - d__1 = ecc * sinh(ea) - ea; - m0 = d_sign(&d__1, &nu); - } else { - ea = tan(nu / 2.); -/* Computing 3rd power */ - d__2 = ea; - d__1 = ea + d__2 * (d__2 * d__2) / 3.; - m0 = d_sign(&d__1, &nu); - } - -/* Return the elements as a vector, suitable for input to CONICS. */ - - elts[0] = rp; - elts[1] = ecc; - elts[2] = inc; - elts[3] = lnode; - elts[4] = argp; - elts[5] = m0; - elts[6] = *et; - elts[7] = *mu; - chkout_("OSCELT", (ftnlen)6); - return 0; -} /* oscelt_ */ - diff --git a/ext/spice/src/cspice/oscelt_c.c b/ext/spice/src/cspice/oscelt_c.c deleted file mode 100644 index a6a5d7c346..0000000000 --- a/ext/spice/src/cspice/oscelt_c.c +++ /dev/null @@ -1,281 +0,0 @@ -/* - --Procedure oscelt_c ( Determine conic elements from state ) - --Abstract - - Determine the set of osculating conic orbital elements that - corresponds to the state (position, velocity) of a body at - some epoch. - --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 - - CONIC - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef oscelt_c - - - void oscelt_c ( ConstSpiceDouble state[6], - SpiceDouble et, - SpiceDouble mu, - SpiceDouble elts[8] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - state I State of body at epoch of elements. - et I Epoch of elements. - mu I Gravitational parameter (GM) of primary body. - elts O Equivalent conic elements - - --Detailed_Input - - state is the state (position and velocity) of the body - at some epoch. Components are x, y, z, dx/dt, dy/dt, - dz/dt. `state' must be expressed relative to an - inertial reference frame. Units are km and km/sec. - - - et is the epoch of the input state, in ephemeris seconds - past J2000. - - 3 2 - mu is the gravitational parameter (GM, km /sec ) of - the primary body. - --Detailed_Output - - elts are equivalent conic elements describing the orbit - of the body around its primary. The elements are, - in order: - - rp Perifocal distance. - ecc Eccentricity. - inc Inclination. - lnode Longitude of the ascending node. - argp Argument of periapsis. - m0 Mean anomaly at epoch. - t0 Epoch. - mu Gravitational parameter. - - The epoch of the elements is the epoch of the input - state. Units are km, rad, rad/sec. The same elements - are used to describe all three types (elliptic, - hyperbolic, and parabolic) of conic orbit. - --Parameters - - None - --Exceptions - - 1) If `mu' is not positive, the error SPICE(NONPOSITIVEMASS) - is signaled. - - 2) If the specific angular momentum vector derived from STATE - is the zero vector, the error SPICE(DEGENERATECASE) - is signaled. - - 3) If the position or velocity vectors derived from STATE - is the zero vector, the error SPICE(DEGENERATECASE) - is signaled. - - 4) If the inclination is determined to be zero or 180 degrees, - the longitude of the ascending node is set to zero. - - 5) If the eccentricity is determined to be zero, the argument of - periapse is set to zero. - - 6) If the eccentricy of the orbit is very close to but not - equal to zero, the argument of periapse may not be accurately - determined. - - 7) For inclinations near but not equal to 0 or 180 degrees, - the longitude of the ascending node may not be determined - accurately. The argument of periapse and mean anomaly may - also be inaccurate. - - 8) For eccentricities very close to but not equal to 1, the - results of this routine are unreliable. - - 9) If the specific angular momentum vector is non-zero but - "close" to zero, the results of this routine are unreliable. - - 10) If `state' is expressed relative to a non-inertial reference - frame, the resulting elements are invalid. No error checking - is done to detect this problem. - --Files - - None. - --Particulars - - The CSPICE routine conics_c is the inverse of this routine: - conics_c maps a set of osculating elements and a time to a state - vector. - --Examples - - Let vinit contain the initial state of a spacecraft relative to - the center of a planet at epoch ET, and let GM be the gravitation - parameter of the planet. The call - - oscelt_c ( vinit, et, gm, elts ); - - produces a set of osculating elements describing the nominal - orbit that the spacecraft would follow in the absence of all - other bodies in the solar system. - - Now let state contain the state of the same spacecraft at some - other epoch, later. The difference between this state and the - state predicted by the nominal orbit at the same epoch can be - computed as follows. - - conics_c ( elts, later, nominal ); - vsubg_c ( nominal, state, 6, diff ); - - printf( "Perturbation in x, dx/dt = %e %e\n", diff[0], diff[3] ); - printf( " y, dy/dt = %e %e\n", diff[1], diff[4] ); - printf( " z, dz/dt = %e %e\n", diff[2], diff[5] ); - - --Restrictions - - 1) The input state vector must be expressed relative to an - inertial reference frame. - - 2) Osculating elements are generally not useful for - high-accuracy work. - - 3) Accurate osculating elements may be difficult to derive for - near-circular or near-equatorial orbits. Osculating elements - for such orbits should be used with caution. - - 4) Extracting osculating elements from a state vector is a - mathematically simple but numerically challenging task. The - mapping from a state vector to equivalent elements is - undefined for certain state vectors, and the mapping is - difficult to implement with finite precision arithmetic for - states near the subsets of R6 where singularities occur. - - In general, the elements found by this routine can have - two kinds of problems: - - - The elements are not accurate but still represent - the input state accurately. The can happen in - cases where the inclination is near zero or 180 - degrees, or for near-circular orbits. - - - The elements are garbage. This can occur when - the eccentricity of the orbit is close to but - not equal to 1. In general, any inputs that cause - great loss of precision in the computation of the - specific angular momentum vector or the eccentricity - vector will result in invalid outputs. - - For further details, see the Exceptions section. - - Users of this routine should carefully consider whether - it is suitable for their applications. One recommended - "sanity check" on the outputs is to supply them to the - CSPICE routine conics_c and compare the resulting state - vector with the one supplied to this routine. - --Literature_References - - [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.2, 27-DEC-2007 (NJB) - - Updated Index_Entries header section to use keywords - "osculating" and "convert." Updated Particulars header - section to refer to conics_c. - - -CSPICE Version 1.0.1, 17-NOV-2005 (NJB) - - The Exceptions and Restrictions header sections were filled in. - Some corrections were made to the code example. - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - conic elements from state - osculating elements from state - convert state to osculating elements - --& -*/ - - -{ /* Begin oscelt_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "oscelt_c" ); - - - /* - Call the f2c'd Fortran routine. - */ - oscelt_( ( doublereal * ) state, - ( doublereal * ) &et , - ( doublereal * ) &mu , - ( doublereal * ) elts ); - - - chkout_c ( "oscelt_c" ); - -} /* End oscelt_c */ - diff --git a/ext/spice/src/cspice/outmsg.c b/ext/spice/src/cspice/outmsg.c deleted file mode 100644 index 21b3c0e559..0000000000 --- a/ext/spice/src/cspice/outmsg.c +++ /dev/null @@ -1,944 +0,0 @@ -/* outmsg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__2 = 2; -static integer c__3 = 3; -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure OUTMSG ( Output Error Messages ) */ -/* Subroutine */ int outmsg_(char *list, ftnlen list_len) -{ - /* Initialized data */ - - static char defmsg[80*4] = "Oh, by the way: The SPICELIB error handling" - " actions are USER-TAILORABLE. You " "can choose whether the To" - "olkit aborts or continues when errors occur, which " "error " - "messages to output, and where to send the output. Please read t" - "he ERROR " "\"Required Reading\" file, or see the routines ERRA" - "CT, ERRDEV, and ERRPRT. "; - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2], a__2[3]; - integer i__1, i__2, i__3[2], i__4[3]; - char ch__1[38]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[32], line[80]; - logical long__; - char lmsg[1840]; - logical expl; - char smsg[25], xmsg[80]; - integer i__; - logical trace; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - integer depth, index; - extern integer wdcnt_(char *, ftnlen); - extern /* Subroutine */ int expln_(char *, char *, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - char versn[80], words[9*5]; - integer start; - logical short__; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char device[255]; - integer remain; - static char border[80]; - extern /* Subroutine */ int getdev_(char *, ftnlen); - logical dfault; - integer length; - extern /* Subroutine */ int trcdep_(integer *); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int trcnam_(integer *, char *, ftnlen), lparse_( - char *, char *, integer *, integer *, char *, ftnlen, ftnlen, - ftnlen); - extern logical msgsel_(char *, ftnlen); - integer wrdlen; - extern /* Subroutine */ int getlms_(char *, ftnlen), wrline_(char *, char - *, ftnlen, ftnlen), getsms_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen); - char tmpmsg[105]; - extern /* Subroutine */ int nextwd_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - integer numwrd; - char upword[9], outwrd[1840]; - extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen); - logical output; - -/* $ Abstract */ - -/* Output error messages. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LIST I A list of error message types. */ -/* FILEN P Maximum length of file name. */ -/* NAMLEN P Maximum length of module name. See TRCPKG. */ -/* LL P Output line length. */ - -/* $ Detailed_Input */ - -/* LIST is a list of error message types. A list is a */ -/* character string containing one or more words */ -/* from the following list, separated by commas. */ - -/* SHORT */ -/* EXPLAIN */ -/* LONG */ -/* TRACEBACK */ -/* DEFAULT */ - -/* Each type of error message specified in LIST will */ -/* be output when an error is detected, if it is */ -/* enabled for output. Note that DEFAULT does */ -/* NOT refer to the "default message selection," */ -/* but rather to a special message that is output */ -/* when the error action is 'DEFAULT'. This message */ -/* is a statement referring the user to the error */ -/* handling documentation. */ - -/* Messages are never duplicated in the output; for */ -/* instance, supplying a value of LIST such as */ - -/* 'SHORT, SHORT' */ - -/* does NOT result in the output of two short */ -/* messages. */ - -/* The words in LIST may appear in mixed case; */ -/* for example, the call */ - -/* CALL OUTMSG ( 'ShOrT' ) */ - -/* will work. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN is the maximum device name length that can be */ -/* accommodated by this routine. */ - -/* NAMELN is the maximum length of an individual module name. */ - -/* LL is the maximum line length for the output message. */ -/* If the output message string is very long, it is */ -/* displayed over several lines, each of which has a */ -/* maximum length of LL characters. */ - -/* $ Exceptions */ - -/* 1) This routine detects invalid message types in the argument, */ -/* LIST. The short error message in this case is */ -/* 'SPICE(INVALIDLISTITEM)' */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling */ -/* mechanism. */ - -/* This routine outputs the error messages specified in LIST that */ -/* have been enabled for output (use the SPICELIB routine ERRPRT */ -/* to enable or disable output of specified types of error */ -/* messages). A border is written out preceding and following the */ -/* messages. Output is directed to the current error output device. */ - -/* $ Examples */ - -/* 1) Output the short and long error messages: */ - -/* C */ -/* C Output short and long messages: */ -/* C */ -/* CALL OUTMSG ( 'SHORT, LONG' ) */ - -/* $ Restrictions */ - -/* 1) This routine is intended for use by the SPICELIB error */ -/* handling mechanism. SPICELIB users are not expected to */ -/* need to call this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.22.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 5.21.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 5.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 5.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 5.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 5.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 5.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 5.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 5.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 5.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 5.12.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 5.11.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 5.10.0, 01-MAR-2009 (NJB) */ - -/* Bug fix: truncation of long words in */ -/* output has been corrected. Local parameter */ -/* TMPLEN was added and is used in declaration */ -/* of TMPMSG. */ - -/* - SPICELIB Version 5.9.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 5.8.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 5.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 5.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 5.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 5.4.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 5.3.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 5.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 5.1.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 5.1.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 5.1.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 5.1.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 5.1.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 5.1.0, 13-JAN-1999 (BVS) */ - -/* ``errhnd.inc'' file was included. Long and short error */ -/* message lengths parameter declarations were deleted. Long */ -/* and short error message string sizes were changed to those */ -/* declared in ``errhnd.inc''. */ - -/* - SPICELIB Version 5.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 4.0.0, 09-MAY-1996 (KRG) */ - -/* Added the toolkit version to the output error message. */ - -/* Updated this routine to be consistent with the trace package */ -/* revisions. This primarily affects the creation of the */ -/* traceback string. */ - -/* Long error messages are now wrapped on word boundaries when */ -/* they are longer than the output line length. Note that this */ -/* only happens for long error messages obtained from GETLMS, */ -/* and not for the error messages displayed by this subroutine */ -/* and other error handling subroutines that write their own */ -/* error messages. */ - -/* - SPICELIB Version 3.0.0, 09-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 2.2.0, 12-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. Moved the parameter */ -/* LL to the Declarations section of the header since it's */ -/* environment dependent. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 2.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */ - -/* Module was updated to include the value of LL for the */ -/* Macintosh. */ - -/* - SPICELIB Version 2.0.0, 28-MAR-1991 (NJB) */ - -/* Work-around for MS Fortran compiler error under DOS 3.10 */ -/* was made. Some substring bounds were simplified using RTRIM. */ -/* Updates were made to the header to clarify the text and */ -/* improve the header's appearance. The default error message */ -/* was slightly de-uglified. */ - -/* The IBM PC version of this routine now uses an output line */ -/* length of 78 characters rather than 80. This prevents */ -/* wrapping of the message borders and default error message. */ - - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.1.0, 13-JAN-1999 (BVS) */ - -/* ``errhnd.inc'' file was included. Long and short error */ -/* message lengths parameter declarations were deleted. Long */ -/* and short error message string size were changed to those */ -/* declared in ``errhnd.inc''. */ - -/* - SPICELIB Version 5.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 4.0.0, 09-MAY-1996 (KRG) */ - -/* Added the toolkit version to the output error message. */ - -/* Updated this routine to be consistent with the trace package */ -/* revisions. This primarily affects the creation of the */ -/* traceback string. */ - -/* Long error messages are now wrapped on word boundaries when */ -/* they are longer than the output line length. Note that this */ -/* only happens for long error messages obtained from GETLMS, */ -/* and not for the error messages displayed by this subroutine */ -/* and other error handling subroutines that write their own */ -/* error messages. */ - -/* - SPICELIB Version 3.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 2.2.0, 12-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. Moved the */ -/* parameter LL to the Declarations section of the header since */ -/* it's environment dependent. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */ - -/* Module was updated to include the value of LL for the */ -/* Macintosh. */ - -/* - SPICELIB Version 2.0.0, 28-MAR-1991 (NJB) */ - -/* 1) Work-around for MS Fortran compiler error under DOS 3.10 */ -/* was made. The compiler did not correctly handle code that */ -/* concatenated strings whose bounds involved the intrinsic */ -/* MAX function. */ - -/* 2) Some substring bounds were simplified using RTRIM. */ - -/* 3) Updates were made to the header to clarify the text and */ -/* improve the header's appearance. */ - -/* 4) Declarations were re-organized. */ - -/* 5) The default error message was slightly de-uglified. */ - -/* 6) The IBM PC version of this routine now uses an output line */ -/* length of 78 characters rather than 80. This prevents */ -/* wrapping of the message borders and default error message. */ - -/* - Beta Version 1.3.0, 19-JUL-1989 (NJB) */ - -/* Calls to REMSUB removed; blanking and left-justifying used */ -/* instead. This was done because REMSUB handles substring */ -/* bounds differently than in previous versions, and no longer */ -/* handles all possible inputs as required by this routine. */ -/* LJUST, which is used now, is error free. */ - -/* Also, an instance of .LT. was changed to .LE. The old code */ -/* caused a line break one character too soon. A minor bug, but */ -/* a bug nonetheless. */ - -/* Also, two substring bounds were changed to ensure that they */ -/* remain greater than zero. */ - -/* - Beta Version 1.2.0, 16-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. Parameters section updated to */ -/* describe FILEN and NAMLEN. */ - -/* Declaration of unused function FAILED removed. */ - -/* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */ - -/* Test added to ensure substring upper bound is greater than 0. */ -/* REMAIN must be greater than 0 when used as the upper bound */ -/* for a substring of NAME. Also, substring upper bound in */ -/* WRLINE call is now forced to be greater than 0. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* These parameters are system-independent. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial Values: */ - - -/* Executable Code: */ - - -/* The first time through, set up the output borders. */ - - if (first) { - first = FALSE_; - for (i__ = 1; i__ <= 80; ++i__) { - *(unsigned char *)&border[i__ - 1] = '='; - } - } - -/* No messages are to be output which are not specified */ -/* in LIST: */ - - short__ = FALSE_; - expl = FALSE_; - long__ = FALSE_; - trace = FALSE_; - dfault = FALSE_; -/* We parse the list of message types, and set local flags */ -/* indicating which ones are to be output. If we find */ -/* a word we don't recognize in the list, we signal an error */ -/* and continue parsing the list. */ - - lparse_(list, ",", &c__5, &numwrd, words, list_len, (ftnlen)1, (ftnlen)9); - i__1 = numwrd; - for (i__ = 1; i__ <= i__1; ++i__) { - ucase_(words + ((i__2 = i__ - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge( - "words", i__2, "outmsg_", (ftnlen)593)) * 9, upword, (ftnlen) - 9, (ftnlen)9); - if (s_cmp(upword, "SHORT", (ftnlen)9, (ftnlen)5) == 0) { - short__ = TRUE_; - } else if (s_cmp(upword, "EXPLAIN", (ftnlen)9, (ftnlen)7) == 0) { - expl = TRUE_; - } else if (s_cmp(upword, "LONG", (ftnlen)9, (ftnlen)4) == 0) { - long__ = TRUE_; - } else if (s_cmp(upword, "TRACEBACK", (ftnlen)9, (ftnlen)9) == 0) { - trace = TRUE_; - } else if (s_cmp(upword, "DEFAULT", (ftnlen)9, (ftnlen)7) == 0) { - dfault = TRUE_; - } else { - -/* Unrecognized word! This is an error... */ - -/* We have a special case on our hands; this routine */ -/* is itself called by SIGERR, so a recursion error will */ -/* result if this routine calls SIGERR. So we output */ -/* the error message directly: */ - - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(INVALIDLISTITEM)", (ftnlen)255, (ftnlen)22) - ; - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - wrline_(device, "OUTMSG: An invalid message type was specified " - "in the type list. ", (ftnlen)255, (ftnlen)65); -/* Writing concatenation */ - i__3[0] = 29, a__1[0] = "The invalid message type was "; - i__3[1] = 9, a__1[1] = words + ((i__2 = i__ - 1) < 5 && 0 <= i__2 - ? i__2 : s_rnge("words", i__2, "outmsg_", (ftnlen)630)) * - 9; - s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)38); - wrline_(device, ch__1, (ftnlen)255, (ftnlen)38); - } - } - -/* LIST has been parsed. */ - -/* Now, we output those error messages that were specified by LIST */ -/* and which belong to the set of messages selected for output. */ - - -/* We get the default error output device: */ - - getdev_(device, (ftnlen)255); - output = short__ && msgsel_("SHORT", (ftnlen)5) || expl && msgsel_("EXPL" - "AIN", (ftnlen)7) || long__ && msgsel_("LONG", (ftnlen)4) || trace - && msgsel_("TRACEBACK", (ftnlen)9) || dfault && msgsel_("DEFAULT", - (ftnlen)7) && s_cmp(device, "NULL", (ftnlen)255, (ftnlen)4) != 0; - -/* We go ahead and output those messages that have been specified */ -/* in the list and also are enabled for output. The order of the */ -/* cases below IS significant; the order in which the messages */ -/* appear in the output depends on it. */ - - -/* If there's nothing to output, we can leave now. */ - - if (! output) { - return 0; - } - -/* Write the starting border: skip a line, write the border, */ -/* skip a line. */ - - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - wrline_(device, border, (ftnlen)255, (ftnlen)80); - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - -/* Output the toolkit version and skip a line. */ - - tkvrsn_("TOOLKIT", versn, (ftnlen)7, (ftnlen)80); -/* Writing concatenation */ - i__3[0] = 17, a__1[0] = "Toolkit version: "; - i__3[1] = 80, a__1[1] = versn; - s_cat(line, a__1, i__3, &c__2, (ftnlen)80); - wrline_(device, line, (ftnlen)255, (ftnlen)80); - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - -/* Next, we output the messages specified in the list */ -/* that have been enabled. */ - -/* We start with the short message and its accompanying */ -/* explanation. If both are to be output, they are */ -/* concatenated into a single message. */ - - if (short__ && msgsel_("SHORT", (ftnlen)5) && (expl && msgsel_("EXPLAIN", - (ftnlen)7))) { - -/* Extract the short message from global storage; then get */ -/* the corresponding explanation. */ - - getsms_(smsg, (ftnlen)25); - expln_(smsg, xmsg, (ftnlen)25, (ftnlen)80); -/* Writing concatenation */ - i__4[0] = rtrim_(smsg, (ftnlen)25), a__2[0] = smsg; - i__4[1] = 4, a__2[1] = " -- "; - i__4[2] = 80, a__2[2] = xmsg; - s_cat(tmpmsg, a__2, i__4, &c__3, (ftnlen)105); - wrline_(device, tmpmsg, (ftnlen)255, (ftnlen)105); - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - } else if (short__ && msgsel_("SHORT", (ftnlen)5)) { - -/* Output the short error message without the explanation. */ - - getsms_(smsg, (ftnlen)25); - wrline_(device, smsg, (ftnlen)255, (ftnlen)25); - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - } else if (expl && msgsel_("EXPLAIN", (ftnlen)7)) { - -/* Obtain the explanatory text for the short error */ -/* message and output it: */ - - getsms_(smsg, (ftnlen)25); - expln_(smsg, xmsg, (ftnlen)25, (ftnlen)80); - wrline_(device, xmsg, (ftnlen)255, (ftnlen)80); - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - } - if (long__ && msgsel_("LONG", (ftnlen)4)) { - -/* Extract the long message from global storage and */ -/* output it: */ - - getlms_(lmsg, (ftnlen)1840); - -/* Get the number of words in the error message. */ - - numwrd = wdcnt_(lmsg, (ftnlen)1840); - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - start = 1; - -/* Format the words into output lines and display them as */ -/* needed. */ - - i__1 = numwrd; - for (i__ = 1; i__ <= i__1; ++i__) { - nextwd_(lmsg, outwrd, lmsg, (ftnlen)1840, (ftnlen)1840, (ftnlen) - 1840); - wrdlen = rtrim_(outwrd, (ftnlen)1840); - if (start + wrdlen <= 80) { - s_copy(line + (start - 1), outwrd, 80 - (start - 1), (ftnlen) - 1840); - start = start + wrdlen + 1; - } else { - if (wrdlen <= 80) { - -/* We had a short word, so just write the line and */ -/* continue. */ - - wrline_(device, line, (ftnlen)255, (ftnlen)80); - start = wrdlen + 2; - s_copy(line, outwrd, (ftnlen)80, (ftnlen)1840); - } else { - -/* We got a very long word here, so we break it up and */ -/* write it out. We fit as much of it as we an into line */ -/* as possible before writing it. */ - -/* Get the remaining space. If START is > 1 we have at */ -/* least one word already in the line, including it's */ -/* trailing space, otherwise the line is blank. If line */ -/* is empty, we have all of the space available. */ - - if (start > 1) { - remain = 80 - start; - } else { - remain = 80; - } - -/* Now we stuff bits of the word into the output line */ -/* until we're done, i.e., until we have a word part */ -/* that is less than the output length. First, we */ -/* check to see if there is a "significant" amount of */ -/* room left in the current output line. If not, we */ -/* write it and then begin stuffing the long word into */ -/* output lines. */ - - if (remain < 10) { - wrline_(device, line, (ftnlen)255, (ftnlen)80); - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - remain = 80; - start = 1; - } - -/* Stuff the word a chunk at a time into output lines */ -/* and write them. After writing a line, we clear the */ -/* part of the long word that we just wrote, left */ -/* justifying the remaining part before proceeding. */ - - while(wrdlen > 80) { - s_copy(line + (start - 1), outwrd, 80 - (start - 1), - remain); - wrline_(device, line, (ftnlen)255, (ftnlen)80); - s_copy(outwrd, " ", remain, (ftnlen)1); - ljust_(outwrd, outwrd, (ftnlen)1840, (ftnlen)1840); - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - wrdlen -= remain; - remain = 80; - start = 1; - } - -/* If we had a part of the long word left, get set up to */ -/* append more words from the error message to the output */ -/* line. If we finished the word, WRDLEN .EQ. 0, then */ -/* START and LINE have already been initialized. */ - - if (wrdlen > 0) { - start = wrdlen + 2; - s_copy(line, outwrd, (ftnlen)80, (ftnlen)1840); - } - } - } - } - -/* We may need to write the remaining part of a line. */ - - if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) != 0) { - wrline_(device, line, (ftnlen)255, (ftnlen)80); - } - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - } - if (trace && msgsel_("TRACEBACK", (ftnlen)9)) { - -/* Extract the traceback from global storage and */ -/* output it: */ - - trcdep_(&depth); - if (depth > 0) { - -/* We know we'll be outputting some trace information. */ -/* So, write a line telling the reader what's coming. */ - - wrline_(device, "A traceback follows. The name of the highest l" - "evel module is first.", (ftnlen)255, (ftnlen)68); - -/* While there are more names in the traceback */ -/* representation, we stuff them into output lines and */ -/* write the lines out when they are full. */ - - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - remain = 80; - i__1 = depth; - for (index = 1; index <= i__1; ++index) { - -/* For each module name in the traceback representation, */ -/* retrieve module name and stuff it into one or more */ -/* lines for output. */ - -/* Get a name and add the call order sign. We */ -/* indicate calling order by a ' --> ' delimiter; e.g. */ -/* "A calls B" is indicated by 'A --> B'. */ - - trcnam_(&index, name__, (ftnlen)32); - length = lastnb_(name__, (ftnlen)32); - -/* If it's the first name, just put it into the output */ -/* line, otherwise, add the call order sign and put the */ -/* name into the output line. */ - - if (index == 1) { - suffix_(name__, &c__0, line, (ftnlen)32, (ftnlen)80); - remain -= length; - } else { - -/* Add the calling order indicator, if it will fit. */ -/* If not, write the line and put the indicator as */ -/* the first thing on the next line. */ - - if (remain >= 4) { - suffix_("-->", &c__1, line, (ftnlen)3, (ftnlen)80); - remain += -4; - } else { - wrline_(device, line, (ftnlen)255, (ftnlen)80); - s_copy(line, "-->", (ftnlen)80, (ftnlen)3); - remain = 77; - } - -/* The name fits or it doesn't. If it does, just add */ -/* it, if it doesn't, write it, then make the name */ -/* the first thing on the next line. */ - - if (remain >= length) { - suffix_(name__, &c__1, line, (ftnlen)32, (ftnlen)80); - remain = remain - length - 1; - } else { - wrline_(device, line, (ftnlen)255, (ftnlen)80); - s_copy(line, name__, (ftnlen)80, (ftnlen)32); - remain = 80 - length; - } - } - } - -/* At this point, no more names are left in the */ -/* trace representation. LINE may still contain */ -/* names, or part of a long name. If it does, */ -/* we now write it out. */ - - if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) != 0) { - wrline_(device, line, (ftnlen)255, (ftnlen)80); - } - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - } - -/* At this point, either we have output the trace */ -/* representation, or the trace representation was */ -/* empty. */ - - } - if (dfault && msgsel_("DEFAULT", (ftnlen)7)) { - -/* Output the default message: */ - - for (i__ = 1; i__ <= 4; ++i__) { - wrline_(device, defmsg + ((i__1 = i__ - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("defmsg", i__1, "outmsg_", (ftnlen)951)) * - 80, (ftnlen)255, (ftnlen)80); - } - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - } - -/* At this point, we've output all of the enabled messages */ -/* that were specified in LIST. At least one message that */ -/* was specified was enabled. */ - -/* Write the ending border out: */ - - wrline_(device, border, (ftnlen)255, (ftnlen)80); - return 0; -} /* outmsg_ */ - diff --git a/ext/spice/src/cspice/packac.c b/ext/spice/src/cspice/packac.c deleted file mode 100644 index c04b64eb1c..0000000000 --- a/ext/spice/src/cspice/packac.c +++ /dev/null @@ -1,254 +0,0 @@ -/* packac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PACKAC ( Pack a character array ) */ -/* Subroutine */ int packac_(char *in, integer *pack, integer *npack, integer - *maxout, integer *nout, char *out, ftnlen in_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Pack the contents of a CHARACTER array. That is, take */ -/* a set of arbitrarily spaced elements from an input array, */ -/* and make them adjacent elements in an output array. */ - -/* $ 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 */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input array. */ -/* PACK I Indices of elements to be packed. */ -/* NPACK I Number of indices. */ -/* MAXOUT I Maximum number of elements in the output array. */ -/* NOUT O Number of elements in the output array. */ -/* OUT O Output array. */ - -/* $ Detailed_Input */ - -/* IN is the input array. */ - -/* PACK is the set of elements to be packed into the output */ -/* array. PACK(i) is the index of the element in the */ -/* input array that is to become the i'th element of */ -/* the output array. */ - -/* NPACK is the number of elements to be packed into the */ -/* output array. */ - -/* MAXOUT is the maximum number of elements to be packed */ -/* into the output array. If NPACK is larger than */ -/* MAXOUT, the extra items are ignored. */ - -/* $ Detailed_Output */ - -/* NOUT is the number of elements in the output array. */ - -/* OUT is the output array. This array contains up to */ -/* MAXOUT elements from the input array, located */ -/* in the first NOUT elements of the array. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If an element in the PACK array is less than 1, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The indicated elements are moved from their current locations */ -/* in the input array to consecutive positions in the output array. */ - -/* OUT( 1) = IN(PACK( 1)) */ -/* OUT( 2) = IN(PACK( 2)) */ -/* . */ -/* . */ -/* OUT(NOUT) = IN(PACK(NOUT)) */ - -/* NOUT is either NPACK or MAXOUT, whichever is smaller. */ - -/* $ Examples */ - -/* The most common use for this routine is to remove unwanted items */ -/* from an array or set of arrays. For example, suppose that the */ -/* arrays NAME, CODE, RADIUS and MASS contain the names, NAIF */ -/* integer ID codes, radii, and masses of a set of NSAT satellites. */ -/* Suppose further that the user selects a subset of the original */ -/* set of satellites from a menu of some sort. Let the indices of */ -/* these satellites be the NSEL elements of the array SEL. The */ -/* following sequence would remove the names, codes, etc., of the */ -/* unselected satellites from the arrays. */ - -/* CALL PACKAC ( NAME, SEL, NSEL, NSAT, NOUT, NAME2 ) */ -/* CALL PACKAI ( CODE, SEL, NSEL, NSAT, NOUT, CODE2 ) */ -/* CALL PACKAD ( RADIUS, SEL, NSEL, NSAT, NOUT, RADIUS2 ) */ -/* CALL PACKAD ( MASS, SEL, NSEL, NSAT, NOUT, MASS2 ) */ - -/* In the example above, suppose that NAME and PACK contain */ -/* the following: */ - -/* NAME = 'MIMAS' PACK = 2, 4, 6, 7 */ -/* 'ENCELADUS' */ -/* 'TETHYS' */ -/* 'DIONE' */ -/* 'RHEA' */ -/* 'TITAN' */ -/* 'HYPERION' */ -/* 'IAPETUS' */ -/* 'PHOEBE' */ - -/* Then, following the call to PACKAC, NOUT and NAME2 contain */ -/* the following: */ - -/* NOUT = 4 NAME2 = 'ENCELADUS' */ -/* 'DIONE' */ -/* 'TITAN' */ -/* 'HYPERION' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* pack a character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 4-JAN-1989 (HAN) */ - -/* Error handling was added to detect array indices that are */ -/* out of bound. If any element contained in the PACK array is */ -/* less than one, an error is signalled, and the output array is */ -/* not packed. */ - -/* -& */ - -/* Spicelib functions */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PACKAC", (ftnlen)6); - } - -/* First, determine how many items to transfer. */ - - *nout = min(*npack,*maxout); - -/* Check to see if PACK contains valid array indices. */ - - i__1 = *nout; - for (i__ = 1; i__ <= i__1; ++i__) { - if (pack[i__ - 1] < 1) { - setmsg_("Element number * contains index *.", (ftnlen)34); - errint_("*", &i__, (ftnlen)1); - errint_("*", &pack[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("PACKAC", (ftnlen)6); - return 0; - } - } - -/* Transfer them. Just like it says in the header. */ - - i__1 = *nout; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(out + (i__ - 1) * out_len, in + (pack[i__ - 1] - 1) * in_len, - out_len, in_len); - } - chkout_("PACKAC", (ftnlen)6); - return 0; -} /* packac_ */ - diff --git a/ext/spice/src/cspice/packad.c b/ext/spice/src/cspice/packad.c deleted file mode 100644 index dd29d8bae2..0000000000 --- a/ext/spice/src/cspice/packad.c +++ /dev/null @@ -1,248 +0,0 @@ -/* packad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PACKAD ( Pack a double precision array ) */ -/* Subroutine */ int packad_(doublereal *in, integer *pack, integer *npack, - integer *maxout, integer *nout, doublereal *out) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Pack the contents of a double precision array. That is, */ -/* take a set of arbitrarily spaced elements from an input */ -/* array, and make them adjacent elements in an output array. */ - -/* $ 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 */ - -/* ARRAY */ -/* ASSIGNMENT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input array. */ -/* PACK I Indices of elements to be packed. */ -/* NPACK I Number of indices. */ -/* MAXOUT I Maximum number of elements in the output array. */ -/* NOUT O Number of elements in the output array. */ -/* OUT O Output array. */ - -/* $ Detailed_Input */ - -/* IN is the input array. */ - -/* PACK is the set of elements to be packed into the output */ -/* array. PACK(i) is the index of the element in the */ -/* input array that is to become the i'th element of the */ -/* output array. */ - -/* NPACK is the number of elements to be packed into the */ -/* output array. */ - -/* MAXOUT is the maximum number of elements to be packed into */ -/* the output array. If NPACK is larger than MAXOUT, the */ -/* extra items are ignored. */ - -/* $ Detailed_Output */ - -/* NOUT is the number of elements in the output array. */ - -/* OUT is the output array. This array contains up to */ -/* MAXOUT elements from the input array, located */ -/* in the first NOUT elements of the array. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If an element in the PACK array is less than 1, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The indicated elements are moved from their current locations */ -/* in the input array to consecutive positions in the output array. */ - -/* OUT( 1) = IN(PACK( 1)) */ -/* OUT( 2) = IN(PACK( 2)) */ -/* . */ -/* . */ -/* OUT(NOUT) = IN(PACK(NOUT)) */ - -/* NOUT is either NPACK or MAXOUT, whichever is smaller. */ - -/* $ Examples */ - -/* The most common use for this routine is to remove unwanted items */ -/* from an array or set of arrays. For example, suppose that the */ -/* arrays NAME, CODE, RADIUS and MASS contain the names, NAIF */ -/* integer ID codes, radii, and masses of a set of NSAT satellites. */ -/* Suppose further that the user selects a subset of the original */ -/* set of satellites from a menu of some sort. Let the indices of */ -/* these satellites be the NSEL elements of the array SEL. The */ -/* following sequence would remove the names, codes, etc., of the */ -/* unselected satellites from the arrays. */ - -/* CALL PACKAC ( NAME, SEL, NSEL, NSAT, NOUT, NAME2 ) */ -/* CALL PACKAI ( CODE, SEL, NSEL, NSAT, NOUT, CODE2 ) */ -/* CALL PACKAD ( RADIUS, SEL, NSEL, NSAT, NOUT, RADIUS2 ) */ -/* CALL PACKAD ( MASS, SEL, NSEL, NSAT, NOUT, MASS2 ) */ - -/* In the example above, suppose that NAME and PACK contain */ -/* the following: */ - -/* NAME = 'MIMAS' PACK = 2, 4, 6, 7 */ -/* 'ENCELADUS' */ -/* 'TETHYS' */ -/* 'DIONE' */ -/* 'RHEA' */ -/* 'TITAN' */ -/* 'HYPERION' */ -/* 'IAPETUS' */ -/* 'PHOEBE' */ - -/* Then, following the call to PACKAC, NOUT and NAME2 contain */ -/* the following: */ - -/* NOUT = 4 NAME2 = 'ENCELADUS' */ -/* 'DIONE' */ -/* 'TITAN' */ -/* 'HYPERION' */ -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* pack a d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 4-JAN-1989 (HAN) */ - -/* Error handling was added to detect array indices that are */ -/* out of bound. If any element contained in the PACK array is */ -/* less than one, an error is signalled, and the output array is */ -/* not packed. */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PACKAD", (ftnlen)6); - } - -/* First, determine how many items to transfer. */ - - *nout = min(*npack,*maxout); - -/* Check to see if PACK contains valid array indices. */ - - i__1 = *nout; - for (i__ = 1; i__ <= i__1; ++i__) { - if (pack[i__ - 1] < 1) { - setmsg_("Element number * contains index *.", (ftnlen)34); - errint_("*", &i__, (ftnlen)1); - errint_("*", &pack[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("PACKAD", (ftnlen)6); - return 0; - } - } - -/* Transfer them. Just like it says in the header. */ - - i__1 = *nout; - for (i__ = 1; i__ <= i__1; ++i__) { - out[i__ - 1] = in[pack[i__ - 1] - 1]; - } - chkout_("PACKAD", (ftnlen)6); - return 0; -} /* packad_ */ - diff --git a/ext/spice/src/cspice/packai.c b/ext/spice/src/cspice/packai.c deleted file mode 100644 index 815af4aa26..0000000000 --- a/ext/spice/src/cspice/packai.c +++ /dev/null @@ -1,250 +0,0 @@ -/* packai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PACKAI ( Pack an integer array ) */ -/* Subroutine */ int packai_(integer *in, integer *pack, integer *npack, - integer *maxout, integer *nout, integer *out) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Pack the contents of an integer array. That is, */ -/* take a set of arbitrarily spaced elements from an input */ -/* array, and make them adjacent elements in an output array. */ - -/* $ 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 */ - -/* ARRAY, */ -/* ASSIGNMENT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input array. */ -/* PACK I Indices of elements to be packed. */ -/* NPACK I Number of indices. */ -/* MAXOUT I Maximum number of elements in the output array. */ -/* NOUT O Number of elements in the output array. */ -/* OUT O Output array. */ - -/* $ Detailed_Input */ - -/* IN is the input array. */ - -/* PACK is the set of elements to be packed into the output */ -/* array. PACK(i) is the index of the element in the */ -/* input array that is to become the i'th element of */ -/* the output array. */ - -/* NPACK is the number of elements to be packed into the */ -/* output array. */ - -/* MAXOUT is the maximum number of elements to be packed */ -/* into the output array. If NPACK is larger than */ -/* MAXOUT, the extra items are ignored. */ - -/* $ Detailed_Output */ - -/* NOUT is the number of elements in the output array. */ - - -/* OUT is the output array. This array contains up to */ -/* MAXOUT elements from the input array, located */ -/* in the first NOUT elements of the array. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If an element in the PACK array is less than 1, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The indicated elements are moved from their current locations */ -/* in the input array to consecutive positions in the output array. */ - -/* OUT( 1) = IN(PACK( 1)) */ -/* OUT( 2) = IN(PACK( 2)) */ -/* . */ -/* . */ -/* OUT(NOUT) = IN(PACK(NOUT)) */ - -/* NOUT is either NPACK or MAXOUT, whichever is smaller. */ - -/* $ Examples */ - -/* The most common use for this routine is to remove unwanted items */ -/* from an array or set of arrays. For example, suppose that the */ -/* arrays NAME, CODE, RADIUS and MASS contain the names, NAIF */ -/* integer ID codes, radii, and masses of a set of NSAT satellites. */ -/* Suppose further that the user selects a subset of the original */ -/* set of satellites from a menu of some sort. Let the indices of */ -/* these satellites be the NSEL elements of the array SEL. The */ -/* following sequence would remove the names, codes, etc., of the */ -/* unselected satellites from the arrays. */ - -/* CALL PACKAC ( NAME, SEL, NSEL, NSAT, NOUT, NAME2 ) */ -/* CALL PACKAI ( CODE, SEL, NSEL, NSAT, NOUT, CODE2 ) */ -/* CALL PACKAD ( RADIUS, SEL, NSEL, NSAT, NOUT, RADIUS2 ) */ -/* CALL PACKAD ( MASS, SEL, NSEL, NSAT, NOUT, MASS2 ) */ - -/* In the example above, suppose that NAME and PACK contain */ -/* the following: */ - -/* NAME = 'MIMAS' PACK = 2, 4, 6, 7 */ -/* 'ENCELADUS' */ -/* 'TETHYS' */ -/* 'DIONE' */ -/* 'RHEA' */ -/* 'TITAN' */ -/* 'HYPERION' */ -/* 'IAPETUS' */ -/* 'PHOEBE' */ - -/* Then, following the call to PACKAC, NOUT and NAME2 contain */ -/* the following: */ - -/* NOUT = 4 NAME2 = 'ENCELADUS' */ -/* 'DIONE' */ -/* 'TITAN' */ -/* 'HYPERION' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* pack an integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 4-JAN-1989 (HAN) */ - -/* Error handling was added to detect array indices that are */ -/* out of bound. If any element contained in the PACK array is */ -/* less than one, an error is signalled, and the output array is */ -/* not packed. */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PACKAI", (ftnlen)6); - } - -/* First, determine how many items to transfer. */ - - *nout = min(*npack,*maxout); - -/* Check to see if PACK contains valid array indices. */ - - i__1 = *nout; - for (i__ = 1; i__ <= i__1; ++i__) { - if (pack[i__ - 1] < 1) { - setmsg_("Element number * contains index *.", (ftnlen)34); - errint_("*", &i__, (ftnlen)1); - errint_("*", &pack[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("PACKAI", (ftnlen)6); - return 0; - } - } - -/* Transfer them. Just like it says in the header. */ - - i__1 = *nout; - for (i__ = 1; i__ <= i__1; ++i__) { - out[i__ - 1] = in[pack[i__ - 1] - 1]; - } - chkout_("PACKAI", (ftnlen)6); - return 0; -} /* packai_ */ - diff --git a/ext/spice/src/cspice/parsqs.c b/ext/spice/src/cspice/parsqs.c deleted file mode 100644 index 2aa993e768..0000000000 --- a/ext/spice/src/cspice/parsqs.c +++ /dev/null @@ -1,413 +0,0 @@ -/* parsqs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PARSQS ( Parse quoted string token ) */ -/* Subroutine */ int parsqs_(char *string, char *qchar, char *value, integer * - length, logical *error, char *errmsg, integer *ptr, ftnlen string_len, - ftnlen qchar_len, ftnlen value_len, ftnlen errmsg_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, ipos, opos, inlen, first; - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - integer outlen; - char chr[1]; - -/* $ Abstract */ - -/* Parse a quoted string token. */ - -/* $ 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 */ - -/* CHARACTER */ -/* PARSING */ -/* SCANNING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Quoted string to be parsed. */ -/* QCHAR I Quote delimiter character. */ -/* VALUE O Parsed string. */ -/* LENGTH O Number of significant characters in VALUE. */ -/* ERROR O Logical error flag. */ -/* ERRMSG O Message indicating whether errors have occurred. */ -/* PTR O Position in string where an error occurred. */ - -/* $ Detailed_Input */ - -/* STRING is a character string containing a `quoted string */ -/* token'. Quoted string tokens are sequences of */ -/* characters that represent literal strings. */ -/* Syntactically, a string token is a sequence of */ -/* characters that begins and ends with a designated */ -/* `quote character'. Within the token, any */ -/* occurrence of the quote character is indicated by */ -/* an adjacent pair of quote characters: for example, */ -/* if the quote character is */ - -/* " */ - -/* then the token representing one instance of this */ -/* character is */ - -/* """" */ - -/* Here the first quote indicates the beginning of the */ -/* token, the next two quotes together indicate a */ -/* single quote character that constitutes the */ -/* `contents' of the token, and the final quote */ -/* indicates the end of the token. */ - -/* Leading and trailing blanks in STRING are ignored. */ -/* The input string may not contain any trailing, */ -/* non-blank characters after the final quote */ -/* character. */ - -/* All blanks occurring between the bracketing */ -/* quote characters in STRING are significant. */ - - -/* QCHAR is the quote character. This is always a single */ -/* character. The characters */ - -/* " and ' */ - -/* are common choices, but any non-blank character is */ -/* accepted. Case *is* significant in QCHAR. */ - -/* $ Detailed_Output */ - -/* VALUE is the string resulting from parsing STRING. */ -/* VALUE is obtained from STRING by removing the */ -/* bracketing quote characters and replacing each pair */ -/* of quote characters in the interior of STRING with */ -/* a singleton quote character. The value resulting */ -/* from parsing STRING will occupy the leftmost */ -/* characters of VALUE, but will not be */ -/* `left-justified', since leading blanks within */ -/* the quoted string token in STRING are significant. */ - -/* LENGTH is the number of significant characters in VALUE. */ -/* This is the number of characters in the string */ -/* resulting from parsing the input string. Because */ -/* parsed strings containing embedded quote */ -/* characters are shorter than the unparsed tokens */ -/* that represent them, LENGTH may be less than the */ -/* number of characters between the bracketing quote */ -/* characters of the input string. */ - -/* ERROR is a logical flag indicating whether a parse error */ -/* occurred; if so, ERROR is returned with the value */ -/* .TRUE. */ - -/* ERRMSG is a message indicating that STRING could not be */ -/* parsed due to an error in its structure. If the */ -/* input string token was successfully parsed, ERRMSG */ -/* will be returned as a blank string. */ - -/* PTR indicates the character position at which an */ -/* error in STRING was detected. If STRING is */ -/* correctly formed, PTR is returned as 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input argument QCHAR is blank, a parse error will be */ -/* indicated by ERROR; PTR will be set to 1. The contents of */ -/* VALUE and LENGTH are undefined in this case. */ - -/* 2) If STRING is not a well-formed quoted string, a parse error */ -/* will be indicated by ERROR and PTR. The contents of VALUE */ -/* and LENGTH are undefined in this case. */ - -/* 3) If the length of the output string VALUE is too short to */ -/* accommodate the parsed string token produced by this routine, */ -/* a parse error message to this effect is generated. VALUE */ -/* will contain the as much as possible of the result, truncated */ -/* on the right. */ - -/* 4) If STRING consists of a null string token, that is, two */ -/* adjacent quote characters with nothing but blanks on either */ -/* side, a parse error will be indicated. The contents of VALUE */ -/* and LENGTH are undefined in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Quote characters may be ANY non-blank character. For example, the */ -/* ampersand */ - -/* & */ - -/* is a perfectly valid quote character. If we were using the */ -/* ampersand as the quote character, then the term `doubled quote' */ -/* in the following discussion would refer to the sequence */ - -/* && */ - -/* not the character */ - -/* " */ - -/* The string tokens that are expected inputs to this routine are */ -/* Fortran-style quoted strings: they start and end with quote */ -/* characters. In the interior of any such token, any quote */ -/* characters are represented by doubled quote characters. These */ -/* rules imply that the number of quote characters in a valid quoted */ -/* string token is always even. The end of a quoted string token is */ -/* located at the first even-numbered quote character, counting from */ -/* the initial quote character, that is not the first member of a */ -/* pair of quotes indicating an embedded quote character. */ - -/* This routine is meant to be used together with the SPICELIB */ -/* routine LXQSTR (Lex quoted string): LXQSTR is used to identify */ -/* quoted string tokens, and this routine converts the tokens to */ -/* string values. */ - -/* $ Examples */ - -/* 1) The table below illustrates the action of this routine. */ - - -/* STRING QCHAR VALUE LENGTH ERROR */ -/* ================================================================= */ -/* "SPICE" " SPICE 5 .FALSE. */ -/* "SPICE" ' .TRUE. */ -/* """SPICE"" system" " "SPICE" system 14 .FALSE. */ -/* " " " 1 .FALSE. */ -/* '' ' .TRUE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 08-MAY-1996 (WLT) */ - -/* Corrected the problem with an unintitialized variable */ -/* INLEN that was detected on the HP and reported by Steve */ -/* Schlaifer of MASL. */ - -/* - SPICELIB Version 1.0.0, 21-NOV-1994 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse quoted string token */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Error free, no check-in required. No parse error to start with. */ -/* No characters in the parsed string to start with. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *ptr = 0; - *length = 0; - -/* Reject invalid quote characters. */ - - if (*(unsigned char *)qchar == ' ') { - *error = TRUE_; - s_copy(errmsg, "The quote character must be non-blank, but isn't", - errmsg_len, (ftnlen)48); - *ptr = 1; - } - -/* Grab the lengths of the string arguments. */ - - inlen = i_len(string, string_len); - outlen = i_len(value, value_len); - -/* The token to be parsed extends from the first non-blank */ -/* character to the last non-blank character of STRING. */ - - first = frstnb_(string, string_len); - last = lastnb_(string, string_len); - if (first == 0) { - *error = TRUE_; - s_copy(errmsg, "Blank input string", errmsg_len, (ftnlen)18); - *ptr = inlen; - return 0; - } - -/* The input token must be bracketed by quote characters. */ - - if (*(unsigned char *)&string[first - 1] != *(unsigned char *)qchar) { - *error = TRUE_; - s_copy(errmsg, "String token does not start with quote character", - errmsg_len, (ftnlen)48); - *ptr = first; - return 0; - } else if (*(unsigned char *)&string[last - 1] != *(unsigned char *)qchar) - { - *error = TRUE_; - s_copy(errmsg, "String token does not end with quote character", - errmsg_len, (ftnlen)46); - *ptr = last; - return 0; - } - -/* Null strings are not accepted. */ - - if (first == last - 1) { - *error = TRUE_; - s_copy(errmsg, "Null (zero length) string token", errmsg_len, (ftnlen) - 31); - *ptr = last; - return 0; - } - -/* Transfer the interior characters of the input string to the output */ -/* string, replacing each doubled quote character with a single quote */ -/* character. The interior of the string must not contain any */ -/* un-doubled quotes; we have a parse error if we find any such */ -/* stragglers. */ - - opos = 1; - ipos = first + 1; - while(ipos <= last - 1 && opos <= outlen) { - -/* At this point, IPOS points to the current input character to */ -/* examine; OPOS points to the currently available position to */ -/* write to in the output string. */ - - *(unsigned char *)chr = *(unsigned char *)&string[ipos - 1]; - if (*(unsigned char *)chr != *(unsigned char *)qchar) { - -/* This is the normal, non-quote case. Transfer the */ -/* character to the output string and advance both the input */ -/* and output character positions. */ - - *(unsigned char *)&value[opos - 1] = *(unsigned char *)chr; - ++ipos; - ++opos; - ++(*length); - } else { - -/* We've encountered a quote character. By construction, the */ -/* parity of this quote character must be odd. The quote must */ -/* be followed immediately by a second, interior quote. */ - - if (ipos == last - 1) { - -/* We're already looking at the last interior input */ -/* character. */ - - *error = TRUE_; - s_copy(errmsg, "Quote character is unmatched or else string " - "ends without final quote; take your pick", errmsg_len, - (ftnlen)84); - *ptr = ipos; - return 0; - } else /* if(complicated condition) */ { - i__1 = ipos; - if (s_cmp(string + i__1, qchar, ipos + 1 - i__1, (ftnlen)1) != - 0) { - *error = TRUE_; - s_copy(errmsg, "Interior quote character is not doubled", - errmsg_len, (ftnlen)39); - *ptr = ipos; - return 0; - } else { - -/* This is the normal case; the quote character is doubled. */ -/* Transfer a single quote character to the output string, */ -/* and skip over the second quote in the input string. */ - - *(unsigned char *)&value[opos - 1] = *(unsigned char *) - chr; - ++opos; - ++(*length); - ipos += 2; - } - } - } - } - if (ipos < last - 1) { - -/* We must have stopped transferring characters to VALUE */ -/* because we ran out of room. */ - - *error = TRUE_; - s_copy(errmsg, "Output string too short, truncated on right", - errmsg_len, (ftnlen)43); - *ptr = ipos; - return 0; - } - if (opos < outlen) { - -/* Blank-pad the trailing portion of the output string. */ - - s_copy(value + (opos - 1), " ", value_len - (opos - 1), (ftnlen)1); - } - return 0; -} /* parsqs_ */ - diff --git a/ext/spice/src/cspice/partof.c b/ext/spice/src/cspice/partof.c deleted file mode 100644 index efb4e6197d..0000000000 --- a/ext/spice/src/cspice/partof.c +++ /dev/null @@ -1,227 +0,0 @@ -/* partof.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PARTOF ( Parabolic time of flight ) */ -/* Subroutine */ int partof_(doublereal *ma, doublereal *d__) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - doublereal m; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal dcbrt_(doublereal *); - doublereal deriv, deriv2, fn, change; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Solve the time of flight equation MA = D + (D**3) / 3 */ -/* for the parabolic eccentric anomaly D, given mean anomaly. */ - -/* $ 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 */ - -/* CONIC */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MA I Mean anomaly at epoch. */ -/* D O Parabolic eccentric anomaly. */ - -/* $ Detailed_Input */ - -/* MA is the parabolic mean anomaly of an orbiting body at */ -/* some epoch t, */ - -/* 3 1/2 */ -/* MA = (t-T) (mu/(2q )) */ - -/* where T is the time of periapsis passage, mu is */ -/* the gravitational parameter of the primary body, */ -/* and q is the perifocal distance. */ - -/* $ Detailed_Output */ - -/* D is the corresponding parabolic anomaly. This is the */ -/* solution to the time of flight equation */ - -/* 3 */ -/* MA = D + D / 3 */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Iterate to solve */ - -/* 3 */ -/* f(D,MA,p) = D + D / 3 - MA = 0 */ - -/* $ Examples */ - -/* ELLTOF, HYPTOF, and PARTOF are used by CONICS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */ - -/* A write statement left over from debugging days was removed. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* parabolic time of flight */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */ - -/* A write statement left over from debugging days was removed. */ - -/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */ - -/* Examples section completed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PARTOF", (ftnlen)6); - } - -/* If the mean anomaly is zero, the eccentric anomaly is also zero */ -/* (by inspection). If the mean anomaly is negative, we can pretend */ -/* that it's positive (by symmetry). */ - - if (*ma == 0.) { - *d__ = 0.; - chkout_("PARTOF", (ftnlen)6); - return 0; - } else { - m = abs(*ma); - } - -/* We need an initial guess for the eccentric anomaly D. The function */ -/* is well behaved, so just about any guess will do. */ - - d__1 = m * 3.; - *d__ = dcbrt_(&d__1); - -/* Use the Newton second-order method, */ - -/* 2 */ -/* F = F - (f/f')*(1 + f*f''/2f' ) */ -/* i+1 i */ - -/* where */ - -/* 3 */ -/* f = D + D / 3 - M */ - -/* 2 */ -/* f' = 1 + D */ - - -/* f'' = 2 D */ - - change = 1.; - while(abs(change) > 1e-13) { -/* Computing 3rd power */ - d__1 = *d__; - fn = *d__ + d__1 * (d__1 * d__1) / 3. - m; -/* Computing 2nd power */ - d__1 = *d__; - deriv = d__1 * d__1 + 1.; - deriv2 = *d__ * 2.; -/* Computing 2nd power */ - d__1 = deriv; - change = fn / deriv * (fn * deriv2 / (d__1 * d__1 * 2.) + 1.); - *d__ -= change; - } - if (*ma < 0.) { - *d__ = -(*d__); - } - chkout_("PARTOF", (ftnlen)6); - return 0; -} /* partof_ */ - diff --git a/ext/spice/src/cspice/pck03a.c b/ext/spice/src/cspice/pck03a.c deleted file mode 100644 index 4354441129..0000000000 --- a/ext/spice/src/cspice/pck03a.c +++ /dev/null @@ -1,374 +0,0 @@ -/* pck03a.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PCK03A ( PCK type 03: Add data to a segment ) */ -/* Subroutine */ int pck03a_(integer *handle, integer *ncsets, doublereal * - coeffs, doublereal *epochs) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errhan_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), sgwfpk_(integer *, integer *, doublereal *, integer *, - doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Add data to a type 03 PCK segment in the binary PCK file */ -/* associated with HANDLE. See also PCK03B and PCK03E. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a DAF file open for writing. */ -/* NCSETS I The number of Cheby coefficient sets and epochs. */ -/* COEFFS I The collection of Cheby coefficient sets. */ -/* EPOCHS I The epochs associated with the element sets. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a PCK file that has been */ -/* opened for writing. */ - -/* NCSETS is the number of Cheby coefficient sets and epochs */ -/* to be stored in the segment. */ - -/* COEFFS contains a time-ordered array of Chebyshev coefficient */ -/* sets for computing the orientation of a body relative to */ -/* the an inertial frame. The orientation is defined by */ -/* the angles RA, DEC, W and body fixed angular rates for */ -/* each axis of the body fixed coordinate system defined by */ -/* RA, DEC, and W. All of the angles and the angular rates */ -/* of the axes are given in degrees. */ - -/* See the $ Particulars section for details on how to store */ -/* the coefficient sets in the array. */ - -/* EPOCHS contains the epochs (ephemeris seconds past J2000) */ -/* corresponding to the elements in COEFFS. The I'th */ -/* epoch must equal the epoch of the I'th set of */ -/* coefficients. The epochs must form a strictly increasing */ -/* sequence. */ - -/* $ Detailed_Output */ - -/* None. The data is stored in a segment in the binary PCK file */ -/* associated with HANDLE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine adds data to a type 03 PCK segment in the binary */ -/* PCK file that is associated with HANDLE. The segment must have */ -/* been begun by calling PCK03B. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 03 PCK segments. These routines are: */ - -/* PCK03B: Begin a type 03 PCK segment. This routine must be */ -/* called before any data may be added to a type 03 */ -/* segment. */ - -/* PCK03A: Add data to a type 03 PCK segment. This routine may be */ -/* called any number of times after a call to PCK03B to */ -/* add type 03 records to the PCK segment that was */ -/* started. */ - -/* PCK03E: End a type 03 PCK segment. This routine is called to */ -/* make the type 03 segment a permanent addition to the */ -/* PCK file. Once this routine is called, no further type */ -/* 03 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 03 PCK segment consists of coefficient sets for fixed order */ -/* Chebyshev polynomials over consecutive time intervals, where the */ -/* time intervals need not all be of the same length. The Chebyshev */ -/* polynomials represent the orientation of a body specified relative */ -/* to an inertial frame by the angles RA, DEC, W and body fixed */ -/* angular rates for each axis of the body fixed coordinate system */ -/* defined by RA, DEC, and W. All of the angles and the angular rates */ -/* of the axes are given in degrees. */ - -/* The orientation data supplied to the type 03 PCK writer is packed */ -/* into an array as a sequence of logical records, */ - -/* ----------------------------------------------------- */ -/* | Record 1 | Record 2 | ... | Record N-1 | Record N | */ -/* ----------------------------------------------------- */ - -/* with each record has the following format. */ - -/* ------------------------------------------------ */ -/* | The midpoint of the approximation interval | */ -/* ------------------------------------------------ */ -/* | The radius of the approximation interval | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for RA | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for DEC | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for W | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X-axis rate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y-axis rate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z-axis rate | */ -/* ------------------------------------------------ */ - -/* $ Examples */ - -/* Assume we have the following for each of the examples that */ -/* follow. */ - -/* HANDLE is the handle of a PCK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the PCK */ -/* segment. */ - -/* BODY is the SPICE ID code for the body whose orientation */ -/* data is to be placed into the file. */ - -/* REFFRM is the name of the SPICE inertial reference frame */ -/* the orientation data is relative to. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the orientation data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the orientation data to be placed into the segment. */ - -/* Example 1: */ - -/* For this example, we also assume that: */ - -/* N is the number of type 03 records that we want to */ -/* put into a segment in PCK file. */ - -/* RECRDS contains N type 03 records packaged for the PCK */ -/* file. */ - -/* ETSTRT contains the initial epochs for each of the */ -/* records contained in RECRDS, where */ - -/* ETSTRT(I) < ETSTRT(I+1), I = 1, N-1 */ - -/* ETSTRT(1) <= FIRST, ETSTRT(N) < LAST */ - -/* ETSTRT(I+1), I = 1, N-1, is the ending epoch for */ -/* record I as well as the initial epoch for record */ -/* I+1. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 03 PCK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL PCK03B ( HANDLE, SEGID, BODY, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL PCK03A ( HANDLE, N, RECRDS, ETSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the PCK file. */ -/* C */ -/* CALL PCK03E ( HANDLE ) */ - -/* Example 2: */ - -/* In this example we want to add type O3 PCK records, as */ -/* described above in the $ Particulars section, to the segment */ -/* being written as they are generated. The ability to write the */ -/* records in this way is useful if computer memory is limited. It */ -/* may also be convenient from a programming perspective to write */ -/* the records one at a time. */ - -/* For this example, assume that we want to generate N type 03 PCK */ -/* records, one for each of N time intervals, writing them all to */ -/* the same segment in a PCK file. Let */ - -/* N be the number of type 03 records that we want to */ -/* generate and put into a segment in an PCK file. */ - -/* RECORD be an array with enough room to hold a single type */ -/* 03 record, i.e. RECORD should have dimension at */ -/* least 6 * (CHBDEG + 1 ) + 2. */ - -/* START be an array of N times that are the beginning */ -/* epochs for each of the intervals of interest. The */ -/* times should be in increasing order and the start */ -/* time for the first interval should equal the */ -/* starting time for the segment. */ - -/* START(I) < START(I+1), I = 1, N-1 */ - -/* START(1) = FIRST */ - -/* STOP be an array of N times that are the ending epochs */ -/* for each of the intervals of interest. The times */ -/* should be in increasing order and the stop time for */ -/* interval I should equal the start time for interval */ -/* I+1, i.e., we want to have continuous coverage in */ -/* time across all of the records. Also, the stop time */ -/* for the last interval should equal the ending time */ -/* for the segment. */ - -/* STOP(I) < STOP(I+1), I = 1, N-1 */ - -/* STOP(I) = START(I+1), I = 1, N-1 */ - -/* STOP(N) = LAST */ - -/* GENREC( TIME1, TIME2, RECORD ) */ - -/* be a subroutine that generates a type 03 PCK record */ -/* for a time interval specified by TIME1 and TIME2. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 03 PCK segment if all of the data for the segment is not */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL PCK03B ( HANDLE, SEGID, DESCR, CHBDEG ) */ - -/* C */ -/* C Generate the records and write them to the segment in the */ -/* C PCK file one at at time. */ -/* C */ -/* DO I = 1, N */ - -/* CALL GENREC ( START(I), STOP(I), RECORD ) */ -/* CALL PCK03A ( HANDLE, 1, RECORD, START(I) ) */ - -/* END DO */ - -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the PCK file. */ -/* C */ -/* CALL PCK03E ( HANDLE ) */ - -/* $ Restrictions */ - -/* 1) The type 03 PCK segment to which we are adding data must have */ -/* been started by the routine PCK03B, the routine which begins a */ -/* type 03 PCK segment. */ - -/* $ Exceptions */ - -/* 1) If the number of coefficient sets and epochs is not positive, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Removed DAFHLU call; replaced ERRFN call with ERRHAN. */ - -/* - SPICELIB Version 1.0.0, 06-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* add data to a type_03 pck segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCK03A", (ftnlen)6); - } - -/* First, check to see if the number of coefficient sets and epochs */ -/* is positive. */ - - if (*ncsets <= 0) { - setmsg_("The number of coefficient sets and epochs to be added to th" - "e PCK segment in the file '#' was not positive. Its value wa" - "s: #.", (ftnlen)124); - errhan_("#", handle, (ftnlen)1); - errint_("#", ncsets, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("PCK03A", (ftnlen)6); - return 0; - } - -/* Add the data. */ - - sgwfpk_(handle, ncsets, coeffs, ncsets, epochs); - -/* No need to check FAILED() here, since all we do is check out. */ -/* Leave it up to the caller. */ - - chkout_("PCK03A", (ftnlen)6); - return 0; -} /* pck03a_ */ - diff --git a/ext/spice/src/cspice/pck03b.c b/ext/spice/src/cspice/pck03b.c deleted file mode 100644 index ceed7e7bf6..0000000000 --- a/ext/spice/src/cspice/pck03b.c +++ /dev/null @@ -1,827 +0,0 @@ -/* pck03b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure PCK03B ( PCK type 03: End a segment.) */ -/* Subroutine */ int pck03b_(integer *handle, char *segid, integer *body, - char *frame, doublereal *first, doublereal *last, integer *chbdeg, - ftnlen segid_len, ftnlen frame_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern logical failed_(void); - doublereal dcoeff; - integer ncoeff; - extern /* Subroutine */ int pckpds_(integer *, char *, integer *, - doublereal *, doublereal *, doublereal *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), sgbwfs_(integer *, doublereal * - , char *, integer *, doublereal *, integer *, integer *, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer pktsiz; - -/* $ Abstract */ - -/* Begin a type 03 PCK segment in the binary PCK file associated with */ -/* HANDLE. See also PCK03A and PCK03E. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ - -/* Include the mnemonics for the generic segments routines. */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a DAF file open for writing. */ -/* SEGID I The string to use for segment identifier. */ -/* BODY I The NAIF ID code for the body of the segment. */ -/* FRAME I The inertial frame for this segment. */ -/* FIRST I The first epoch for which the segment is valid. */ -/* LAST I The last epoch for which the segment is valid. */ -/* CHBDEG I The degree of the Chebyshev Polynomial used. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a PCK file that has been */ -/* opened for writing. */ - -/* SEGID is the segment identifier. A PCK segment identifier */ -/* may contain up to 40 printing characters. It may also be */ -/* blank. */ - -/* BODY is the SPICE ID code for the body whose orientation */ -/* information is to be stored in the PCK segment being */ -/* created. */ - -/* FRAME is the inertial reference frame to which the orientation */ -/* data for BODY is relative. */ - -/* FIRST are the bounds on the ephemeris times, expressed as */ -/* LAST seconds past J2000, for which the states can be used */ -/* to interpolate a state for BODY. */ - -/* CHBDEG is the degree of the Chebyshev Polynomial used for */ -/* each set of Chebyshev coefficients that are to be stored */ -/* in the segment. */ - -/* $ Detailed_Output */ - -/* None. The data are stored in the PCK segment in the DAF */ -/* attached to HANDLE. */ - -/* See the $ Particulars section for details about the */ -/* structure of a type 03 PCK segment. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Particulars */ - -/* This routine begins a type 03 segment in the binary PCK file that */ -/* is associated with HANDLE. The file must have been opened with */ -/* write access. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 03 PCK segments. These routines are: */ - -/* PCK03B: Begin a type 03 PCK segment. This routine must be */ -/* called before any data may be added to a type 03 */ -/* segment. */ - -/* PCK03A: Add data to a type 03 PCK segment. This routine may be */ -/* called any number of times after a call to PCK03B to */ -/* add type 03 records to the PCK segment that was */ -/* started. */ - -/* PCK03E: End a type 03 PCK segment. This routine is called to */ -/* make the type 03 segment a permanent addition to the */ -/* PCK file. Once this routine is called, no further type */ -/* 03 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 03 PCK segment consists of coefficient sets for fixed order */ -/* Chebyshev polynomials over consecutive time intervals, where the */ -/* time intervals need not all be of the same length. The Chebyshev */ -/* polynomials represent the orientation of a body specified relative */ -/* to an inertial frame by the angles RA, DEC, W and body fixed */ -/* angular rates for each axis of the body fixed coordinate system */ -/* defined by RA, DEC, and W. All of the angles and the angular rates */ -/* of the axes are given in degrees. */ - -/* The orientation data supplied to the type 03 PCK writer is packed */ -/* into an array as a sequence of logical records, */ - -/* ----------------------------------------------------- */ -/* | Record 1 | Record 2 | ... | Record N-1 | Record N | */ -/* ----------------------------------------------------- */ - -/* with each record has the following format. */ - -/* ------------------------------------------------ */ -/* | The midpoint of the approximation interval | */ -/* ------------------------------------------------ */ -/* | The radius of the approximation interval | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for RA | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for DEC | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for W | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X-axis rate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y-axis rate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z-axis rate | */ -/* ------------------------------------------------ */ - -/* $ Examples */ - -/* Assume we have the following for each of the examples that */ -/* follow. */ - -/* HANDLE is the handle of a PCK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the PCK */ -/* segment. */ - -/* BODY is the SPICE ID code for the body whose orientation */ -/* data is to be placed into the file. */ - -/* REFFRM is the name of the SPICE inertial reference frame */ -/* the orientation data is relative to. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the orientation data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the orientation data to be placed into the segment. */ - -/* Example 1: */ - -/* For this example, we also assume that: */ - -/* N is the number of type 03 records that we want to */ -/* put into a segment in PCK file. */ - -/* RECRDS contains N type 03 records packaged for the PCK */ -/* file. */ - -/* ETSTRT contains the initial epochs for each of the */ -/* records contained in RECRDS, where */ - -/* ETSTRT(I) < ETSTRT(I+1), I = 1, N-1 */ - -/* ETSTRT(1) <= FIRST, ETSTRT(N) < LAST */ - -/* ETSTRT(I+1), I = 1, N-1, is the ending epoch for */ -/* record I as well as the initial epoch for record */ -/* I+1. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 03 PCK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL PCK03B ( HANDLE, SEGID, BODY, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL PCK03A ( HANDLE, N, RECRDS, ETSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the PCK file. */ -/* C */ -/* CALL PCK03E ( HANDLE ) */ - -/* Example 2: */ - -/* In this example we want to add type O3 PCK records, as */ -/* described above in the $ Particulars section, to the segment */ -/* being written as they are generated. The ability to write the */ -/* records in this way is useful if computer memory is limited. It */ -/* may also be convenient from a programming perspective to write */ -/* the records one at a time. */ - -/* For this example, assume that we want to generate N type 03 PCK */ -/* records, one for each of N time intervals, writing them all to */ -/* the same segment in a PCK file. Let */ - -/* N be the number of type 03 records that we want to */ -/* generate and put into a segment in an PCK file. */ - -/* RECORD be an array with enough room to hold a single type */ -/* 03 record, i.e. RECORD should have dimension at */ -/* least 6 * (CHBDEG + 1 ) + 2. */ - -/* START be an array of N times that are the beginning */ -/* epochs for each of the intervals of interest. The */ -/* times should be in increasing order and the start */ -/* time for the first interval should equal the */ -/* starting time for the segment. */ - -/* START(I) < START(I+1), I = 1, N-1 */ - -/* START(1) = FIRST */ - -/* STOP be an array of N times that are the ending epochs */ -/* for each of the intervals of interest. The times */ -/* should be in increasing order and the stop time for */ -/* interval I should equal the start time for interval */ -/* I+1, i.e., we want to have continuous coverage in */ -/* time across all of the records. Also, the stop time */ -/* for the last interval should equal the ending time */ -/* for the segment. */ - -/* STOP(I) < STOP(I+1), I = 1, N-1 */ - -/* STOP(I) = START(I+1), I = 1, N-1 */ - -/* STOP(N) = LAST */ - -/* GENREC( TIME1, TIME2, RECORD ) */ - -/* be a subroutine that generates a type 03 PCK record */ -/* for a time interval specified by TIME1 and TIME2. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 03 PCK segment if all of the data for the segment is not */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL PCK03B ( HANDLE, SEGID, BODY, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ - -/* C */ -/* C Generate the records and write them to the segment in the */ -/* C PCK file one at at time. */ -/* C */ -/* DO I = 1, N */ - -/* CALL GENREC ( START(I), STOP(I), RECORD ) */ -/* CALL PCK03A ( HANDLE, 1, RECORD, START(I) ) */ - -/* END DO */ - -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the PCK file. */ -/* C */ -/* CALL PCK03E ( HANDLE ) */ - -/* $ Restrictions */ - -/* The binary PCK file must be open with write access. */ - -/* Only one segment may be written to a particular PCK file at a */ -/* time. All of the data for the segment must be written and the */ -/* segment must be ended before another segment may be started in */ -/* the file. */ - -/* $ Exceptions */ - -/* 1) If the degree of the Chebyshev Polynomial to be used for this */ -/* segment is negative, the error SPICE(INVALIDARGUMENT) will */ -/* be signalled. */ - -/* 2) Errors in the structure or content of the inputs other than the */ -/* degree of the Chebyshev Polynomial are diagnosed by routines */ -/* called by this one. */ - -/* 3) File access errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin writing a type_03 pck segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Parameters */ - -/* DAF ND and NI values for PCK files. */ - - -/* Length of an PCK descriptor. */ - - -/* Number of Euler angles. */ - - -/* The type of this segment. */ - - -/* The number of constants. */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCK03B", (ftnlen)6); - } - -/* First, check the degree of the polynomial to be sure that it is */ -/* not negative. */ - - if (*chbdeg < 0) { - setmsg_("The degree of the Chebyshev Polynomial was negative, #. The" - " degree of the polynomial must be greater than or equal to z" - "ero.", (ftnlen)123); - errint_("#", chbdeg, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("PCK03B", (ftnlen)6); - return 0; - } - -/* Create a descriptor for the segment we are about to write. */ - - pckpds_(body, frame, &c__3, first, last, descr, frame_len); - if (failed_()) { - chkout_("PCK03B", (ftnlen)6); - return 0; - } - -/* We've got a valid descriptor, so compute a few things and begin */ -/* the segment. */ - - ncoeff = *chbdeg + 1; - pktsiz = ncoeff * 6 + 2; - dcoeff = (doublereal) ncoeff; - -/* For this data type, we want to use an explicit reference value */ -/* index where the reference epochs are in increasing order. We also */ -/* want to have as the index for a particular request epoch the index */ -/* of the greatest reference epoch less than or equal to the request */ -/* epoch. These characteristics are prescribed by the mnemonic EXPLE. */ -/* See the include file 'sgparam.inc' for more details. */ - - sgbwfs_(handle, descr, segid, &c__1, &dcoeff, &pktsiz, &c__3, segid_len); - chkout_("PCK03B", (ftnlen)6); - return 0; -} /* pck03b_ */ - diff --git a/ext/spice/src/cspice/pck03e.c b/ext/spice/src/cspice/pck03e.c deleted file mode 100644 index 8d99147ba2..0000000000 --- a/ext/spice/src/cspice/pck03e.c +++ /dev/null @@ -1,334 +0,0 @@ -/* pck03e.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PCK03E ( PCK type 03: End a segment. ) */ -/* Subroutine */ int pck03e_(integer *handle) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sgwes_(integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the type 03 PCK segment currently being written to the binary */ -/* PCK file associated with HANDLE. See also PCK03B and PCK03A. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a binary PCK file open for writing. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of a binary PCK file that has been */ -/* opened for writing and to which a type 03 PCK segment is */ -/* being written. */ - -/* $ Detailed_Output */ - -/* None. The segment in the PCK file associated with HANDLE will */ -/* be ended, making the addition of the data permanent. */ - -/* See the $ Particulars section for details about the */ -/* structure of a type 03 PCK segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine ends a type 03 PCK segment that is being written to */ -/* the binary PCK file associated with HANDLE. Ending the PCK segment */ -/* is a necessary step in the process of making the data a permanent */ -/* part of the binary PCK file. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 03 PCK segments. These routines are: */ - -/* PCK03B: Begin a type 03 PCK segment. This routine must be */ -/* called before any data may be added to a type 03 */ -/* segment. */ - -/* PCK03A: Add data to a type 03 PCK segment. This routine may be */ -/* called any number of times after a call to PCK03B to */ -/* add type 03 records to the PCK segment that was */ -/* started. */ - -/* PCK03E: End a type 03 PCK segment. This routine is called to */ -/* make the type 03 segment a permanent addition to the */ -/* PCK file. Once this routine is called, no further type */ -/* 03 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 03 PCK segment consists of coefficient sets for fixed order */ -/* Chebyshev polynomials over consecutive time intervals, where the */ -/* time intervals need not all be of the same length. The Chebyshev */ -/* polynomials represent the orientation of a body specified relative */ -/* to an inertial frame by the angles RA, DEC, W and body fixed */ -/* angular rates for each axis of the body fixed coordinate system */ -/* defined by RA, DEC, and W. All of the angles and the angular rates */ -/* of the axes are given in degrees. */ - -/* The orientation data supplied to the type 03 PCK writer is packed */ -/* into an array as a sequence of logical records, */ - -/* ----------------------------------------------------- */ -/* | Record 1 | Record 2 | ... | Record N-1 | Record N | */ -/* ----------------------------------------------------- */ - -/* with each record has the following format. */ - -/* ------------------------------------------------ */ -/* | The midpoint of the approximation interval | */ -/* ------------------------------------------------ */ -/* | The radius of the approximation interval | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for RA | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for DEC | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for W | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X-axis rate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y-axis rate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z-axis rate | */ -/* ------------------------------------------------ */ - -/* $ Examples */ - -/* Assume we have the following for each of the examples that */ -/* follow. */ - -/* HANDLE is the handle of a PCK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the PCK */ -/* segment. */ - -/* BODY is the SPICE ID code for the body whose orientation */ -/* data is to be placed into the file. */ - -/* REFFRM is the name of the SPICE inertial reference frame */ -/* the orientation data is relative to. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the orientation data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the orientation data to be placed into the segment. */ - -/* Example 1: */ - -/* For this example, we also assume that: */ - -/* N is the number of type 03 records that we want to */ -/* put into a segment in PCK file. */ - -/* RECRDS contains N type 03 records packaged for the PCK */ -/* file. */ - -/* ETSTRT contains the initial epochs for each of the */ -/* records contained in RECRDS, where */ - -/* ETSTRT(I) < ETSTRT(I+1), I = 1, N-1 */ - -/* ETSTRT(1) <= FIRST, ETSTRT(N) < LAST */ - -/* ETSTRT(I+1), I = 1, N-1, is the ending epoch for */ -/* record I as well as the initial epoch for record */ -/* I+1. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 03 PCK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL PCK03B ( HANDLE, SEGID, BODY, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL PCK03A ( HANDLE, N, RECRDS, ETSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the PCK file. */ -/* C */ -/* CALL PCK03E ( HANDLE ) */ - -/* Example 2: */ - -/* In this example we want to add type O3 PCK records, as */ -/* described above in the $ Particulars section, to the segment */ -/* being written as they are generated. The ability to write the */ -/* records in this way is useful if computer memory is limited. It */ -/* may also be convenient from a programming perspective to write */ -/* the records one at a time. */ - -/* For this example, assume that we want to generate N type 03 PCK */ -/* records, one for each of N time intervals, writing them all to */ -/* the same segment in a PCK file. Let */ - -/* N be the number of type 03 records that we want to */ -/* generate and put into a segment in an PCK file. */ - -/* RECORD be an array with enough room to hold a single type */ -/* 03 record, i.e. RECORD should have dimension at */ -/* least 6 * (CHBDEG + 1 ) + 2. */ - -/* START be an array of N times that are the beginning */ -/* epochs for each of the intervals of interest. The */ -/* times should be in increasing order and the start */ -/* time for the first interval should equal the */ -/* starting time for the segment. */ - -/* START(I) < START(I+1), I = 1, N-1 */ - -/* START(1) = FIRST */ - -/* STOP be an array of N times that are the ending epochs */ -/* for each of the intervals of interest. The times */ -/* should be in increasing order and the stop time for */ -/* interval I should equal the start time for interval */ -/* I+1, i.e., we want to have continuous coverage in */ -/* time across all of the records. Also, the stop time */ -/* for the last interval should equal the ending time */ -/* for the segment. */ - -/* STOP(I) < STOP(I+1), I = 1, N-1 */ - -/* STOP(I) = START(I+1), I = 1, N-1 */ - -/* STOP(N) = LAST */ - -/* GENREC( TIME1, TIME2, RECORD ) */ - -/* be a subroutine that generates a type 03 PCK record */ -/* for a time interval specified by TIME1 and TIME2. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 03 PCK segment if all of the data for the segment is not */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL PCK03B ( HANDLE, SEGID, DESCR, CHBDEG ) */ - -/* C */ -/* C Generate the records and write them to the segment in the */ -/* C PCK file one at at time. */ -/* C */ -/* DO I = 1, N */ - -/* CALL GENREC ( START(I), STOP(I), RECORD ) */ -/* CALL PCK03A ( HANDLE, 1, RECORD, START(I) ) */ - -/* END DO */ - -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the PCK file. */ -/* C */ -/* CALL PCK03E ( HANDLE ) */ - -/* $ Restrictions */ - -/* 1) The type 03 binary PCK segment being closed must have been */ -/* started by the routine PCK03B, the routine which begins a type */ -/* 03 PCK segment. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See the argument HANDLE. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* end a type_03 pck segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCK03E", (ftnlen)6); - } - -/* This is simple, just call the routine which ends a generic */ -/* segment. */ - - sgwes_(handle); - -/* No need to check FAILED() since all we do is leave. The caller can */ -/* check it. */ - - chkout_("PCK03E", (ftnlen)6); - return 0; -} /* pck03e_ */ - diff --git a/ext/spice/src/cspice/pckbsr.c b/ext/spice/src/cspice/pckbsr.c deleted file mode 100644 index 6df5957f00..0000000000 --- a/ext/spice/src/cspice/pckbsr.c +++ /dev/null @@ -1,3012 +0,0 @@ -/* pckbsr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__100 = 100; -static integer c__1000 = 1000; -static integer c__5 = 5; -static integer c__2 = 2; - -/* $Procedure PCKBSR ( PCK, Buffer segments for readers ) */ -/* Subroutine */ int pckbsr_0_(int n__, char *fname, integer *handle, integer - *body, doublereal *et, doublereal *descr, char *ident, logical *found, - ftnlen fname_len, ftnlen ident_len) -{ - /* Initialized data */ - - static integer nft = 0; - static integer nbt = 0; - static integer next = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer head; - static doublereal btlb[20]; - integer tail; - static doublereal btub[20]; - integer cost, i__, j; - extern /* Subroutine */ int dafgn_(char *, ftnlen); - integer cheap, p; - static integer btbeg[20]; - extern /* Subroutine */ int dafgs_(doublereal *); - static integer btbod[20]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer fthan[1000]; - char doing[15]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - char stack[15*2]; - static integer bthfs[20]; - extern doublereal dpmin_(void); - extern /* Subroutine */ int lnkan_(integer *, integer *); - extern doublereal dpmax_(void); - static integer btlfs[20]; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - static integer sthan[100], btexp[20]; - static doublereal stdes[500] /* was [5][100] */; - extern integer lnktl_(integer *, integer *); - static integer ftnum[1000]; - extern /* Subroutine */ int daffna_(logical *), dafbbs_(integer *), - daffpa_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), cleard_(integer *, - doublereal *), dafcls_(integer *); - logical fndhan; - integer crflbg, bindex; - extern /* Subroutine */ int lnkila_(integer *, integer *, integer *); - static logical btchkp[20]; - integer findex; - extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int lnkilb_(integer *, integer *, integer *), - lnkini_(integer *, integer *); - extern integer lnknfn_(integer *); - extern /* Subroutine */ int lnkfsl_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - extern integer intmax_(void); - static doublereal btprvd[100] /* was [5][20] */; - static integer btprvh[20]; - static char btprvi[40*20], stidnt[40*100]; - char urgent[15]; - static integer btruex[20]; - integer minexp, nxtseg; - extern integer lnkprv_(integer *, integer *); - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - static integer stpool[212] /* was [2][106] */; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - char status[15]; - doublereal dcd[2]; - integer icd[5]; - logical fnd; - integer new__, top; - -/* $ Abstract */ - -/* Load and unload PCK binary files for use by the readers. */ -/* Buffer segments for readers. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I PCKLOF */ -/* HANDLE I/O PCKLOF, PCKUOF, PCKSFS */ -/* BODY I PCKSFS */ -/* ET I PCKSFS */ -/* DESCR O PCKSFS */ -/* IDENT O PCKSFS */ - -/* $ Detailed_Input */ - -/* FNAME is the name of an PCK file to be loaded. */ - -/* HANDLE on input is the handle of an PCK file to be */ -/* unloaded. */ - -/* BODY is the NAIF integer code of an ephemeris object, */ -/* typically a solar system body. */ - -/* ET is a time, in seconds past the epoch J2000 TDB. */ - -/* $ Detailed_Output */ - -/* HANDLE on output is the handle of the binary PCK file */ -/* containing a located segment. */ - -/* DESCR is the descriptor of a located segment. */ - -/* IDENT is the identifier of a located segment. */ - -/* FOUND is a logical flag indicating whether a segment meeting */ -/* the search criteria was found. FOUND will have the */ -/* value .TRUE. if an appropriate segment was found during */ -/* the search; it will have the value of .FALSE. */ -/* otherwise. If FOUND has the value .FALSE., then either */ -/* an appropriate segment could not be found in any of the */ -/* loaded files or there were no PCK kernel files loaded */ -/* when the request for a segment was made. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of files that may be loaded */ -/* by PCKLOF at any given time for use by the PCK readers. */ - -/* BTSIZE is the maximum number of bodies whose segments can be */ -/* buffered by PCKSFS. */ - -/* STSIZE Maximum number of segments that can be buffered at any */ -/* given time by PCKSFS. */ - -/* $ Files */ - -/* PCK kernel files are indicated by filename before loading */ -/* (see PCKLOF) and handle after loading (all other places). */ - -/* $ Exceptions */ - -/* 1) If PCKBSR is called directly, the error 'SPICE(BOGUSENTRY)' */ -/* is signaled. */ - -/* 2) See entry points PCKLOF, PCKUOF, and PCKSFS for exceptions */ -/* specific to them. */ - -/* $ Particulars */ - -/* PCKBSR serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* PCKLOF Load PCK binary file. */ -/* PCKUOF Unload PCK binary file. */ -/* PCKSFS Select file and segment. */ - -/* Before a file can be read by the PCK kernel readers, it must be */ -/* loaded by PCKLOF, which among other things, calls routines to */ -/* open the specified file. */ - -/* Multiple files may be loaded for use simultaneously, and a file */ -/* need only be loaded once to become a potential search target */ -/* for any number of subsequent reads. */ - -/* Once a PCK kernel file is loaded and opened, it is assigned a file */ -/* handle, which is used by the calling program to refer to the file */ -/* in all subsequent calls to PCK routines. */ - -/* A file may be removed from the list of files searched by using */ -/* PCKUOF to unload it. */ - -/* PCKSFS performs the search for segments within a file for the */ -/* PCK kernel readers. It searches through the most recently loaded */ -/* files first. Within a single file, PCKSFS searches through */ -/* the segments in reverse order, beginning with the last segment in */ -/* the file. The search stops when the first appropriate segment is */ -/* found or all files and segments have been searched without a */ -/* match. */ - -/* PCKSFS buffers information from loaded PCK files to improve access */ -/* time by preventing unnecessary file reads during segment searches. */ - -/* $ Examples */ - -/* Example 1: */ -/* --------- */ - -/* Suppose that the data of interest are contained in the file */ -/* THE_MISSION.PCK, and that we want to generate a table containing */ -/* the descriptors of the PCK segments, or a message indicating that */ -/* no segment was found, for various request times. We are interested */ -/* in the data coverage of the segments in the file. */ - -/* Let */ - -/* PCK_HANDL be the handle for the mission PCK file. */ -/* HANDLE be the handle obtained from a segment search. In */ -/* this example, because there is only a single */ -/* file, this will always have the same value. */ -/* BODY be the NAIF ID code for the body of interest. */ -/* BEG_ET be the beginning epoch for a data table that */ -/* is generated. */ -/* END_ET be the ending epoch for a data table that is */ -/* generated. */ -/* DELTA be the time step, in seconds, between */ -/* consecutive times for a data table that is */ -/* generated. */ -/* ET be the epoch of interest for a segment */ -/* search to get a data table entry. */ -/* DESCR ( 5 ) be the descriptor of the PCK segment that is */ -/* found. */ -/* IDENT be the identifier of the PCK segment that is */ -/* found. */ -/* TABLE be the logical unit for the data table that is */ -/* generated. */ -/* ENTRY be a string to hold a formatted PCK segment */ -/* descriptor which is to be written to the table. */ -/* FOUND be a logical flag indicating that an */ -/* appropriate PCK segment has been found. */ - -/* The two routine names FORMAT_ENTRY and WRITE_ENTRY are used here */ -/* for purposes of demonstration only. Routines with these names do */ -/* not exist in SPICELIB. FORMAT_ENTRY is used to format a PCK */ -/* segment descriptor into a character string for the table */ -/* generated, and WRITE_ENTRY is used to write an entry to the file. */ - -/* The code fragment below loads PCK files and performs searches for */ -/* various epochs, generating a table containing the segment */ -/* descriptors, if found, or a message indicating that a segment */ -/* descriptor was not found. */ - -/* C */ -/* C Load the mission PCK file. */ -/* C */ -/* CALL PCKLOF ( 'THE_MISSION.PCK', PCK_HANDL ) */ - -/* C */ -/* C Search for segments using evenly spaced epochs between */ -/* C BEG_ET and END_ET. */ -/* C */ -/* ET = BEG_ET */ - -/* DO WHILE ( ET .LE. END_ET ) */ - -/* C */ -/* C Locate the applicable segment (handle and descriptor). */ -/* C */ -/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* CALL FORMAT_ENTRY ( DESCR, ENTRY ) */ - -/* ELSE */ - -/* ENTRY = '***** SEGMENT NOT FOUND *****' */ - -/* END IF */ - -/* CALL WRITE_ENTRY ( ET, ENTRY, TABLE ) */ - -/* C */ -/* C Increment the epoch. */ -/* C */ -/* ET = ET + DELTA */ - -/* END DO */ - -/* Example 2: */ -/* --------- */ - -/* In this example multiple PCK files are loaded and searched for */ -/* segments. */ - -/* Let */ - -/* PCK_HANDL be the handle used when loading PCK files. */ -/* HANDLE be the handle obtained from a segment search. In */ -/* this example, because there is only a single */ -/* file, this will always have the same value. */ -/* BODY be the NAIF ID code for the body of interest. */ -/* ET be the epoch of interest for a segment */ -/* search to get a data table entry. */ -/* DESCR ( 5 ) be the descriptor of the PCK segment that is */ -/* found. */ -/* IDENT be the identifier of the PCK segment that is */ -/* found. */ -/* FOUND be a logical flag indicating that an */ -/* appropriate PCK segment has been found. */ - -/* The code fragment below loads several PCK files and then performs */ -/* a search for an appropriate segment. */ - -/* C */ -/* C Load the PCK files. We can reuse the variable PCK_HANDL */ -/* C because the handle for the appropriate file is returned by */ -/* C the search. */ -/* C */ -/* CALL PCKLOF ( 'FIRST.PCK', PCK_HNDL ) */ -/* CALL PCKLOF ( 'SECOND.PCK', PCK_HNDL ) */ -/* CALL PCKLOF ( 'THIRD.PCK', PCK_HNDL ) */ -/* CALL PCKLOF ( 'FOURTH.PCK', PCK_HNDL ) */ -/* CALL PCKLOF ( 'FIFTH.PCK', PCK_HNDL ) */ - -/* C */ -/* C Do some computation that yields a body and epoch */ -/* C of interest. */ -/* C */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C Search for an appropriate segment in the loaded files. */ -/* C */ - -/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* Display results. */ - -/* ELSE */ - -/* WRITE (*,*) 'Sorry, no segment was found.' */ - -/* END IF */ - - -/* $ Restrictions */ - -/* 1) If Fortran I/O errors occur while searching a loaded PCK */ -/* file, the internal state of this suite of routines may */ -/* be corrupted. It may be possible to correct the state */ -/* by unloading the pertinent PCK files and then re-loading */ -/* them. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.S. Zukor (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED calls in entry points PCKUOF and PCKSFS. */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single PCK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) When a already loaded kernel is re-opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 4) The load routine PCKLOF now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby */ -/* avoiding arithmetic overflow. */ - -/* 5) The unload routine PCKUOF now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* 6) In PCKSFS, DAF calls are followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 7) In PCKSFS, a subscript bound violation in a loop */ -/* termination test was corrected. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* - SPICELIB Version 1.0.0, 16-MAR-1994 (KSZ) */ - -/* This differs only slightly from the SPKXXX code. */ -/* The main difference is that the SFS subroutine returns */ -/* FOUND = .FALSE. if no files are found, rather than returning */ -/* an error. */ - -/* -& */ -/* $ Index_Entries */ - -/* buffer PCK segments for readers */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED calls in entry points PCKUOF and PCKSFS. */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single PCK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) When a already loaded kernel is re-opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 4) The load routine PCKLOF now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby */ -/* avoiding arithmetic overflow. */ - -/* 5) The unload routine PCKUOF now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* 6) In PCKSFS, DAF calls are followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 7) In PCKSFS, a subscript bound violation in a loop */ -/* termination test was corrected. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. For each body, the associated re-use */ -/* interval marks the time interval containing the previous */ -/* request time for which the previously returned segment provides */ -/* the highest-priority data available. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* In order to simplify the source code, the in-line singly */ -/* linked list implementation of the segment table has been */ -/* replaced by an implementation relying on the SPICELIB */ -/* doubly linked list routines. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Constants used in the doubly linked list structure: */ - - -/* Local variables */ - - - -/* The file table contains the handle and file number of each file */ -/* that has been loaded for use with the PCK readers. File */ -/* numbers begin at one, and are incremented until they reach a */ -/* value of INTMAX() - 1, at which point they are mapped to the */ -/* range 1:NFT, where NFT is the number of loaded PCK files. */ - -/* (A file number is similar to a file handle, but it is assigned */ -/* and used exclusively by this module. The purpose of file numbers */ -/* is to keep track of the order in which files are loaded and the */ -/* order in which they are searched.) */ - -/* All names begin with FT. */ - -/* HAN Handle */ -/* NUM File number */ - -/* NFT is the number of files that have been loaded. NEXT is */ -/* incremented whenever a new file is loaded to give the file */ -/* number of the file. FINDEX is the index of whatever file is */ -/* of current interest at any given time. */ - -/* New files are added at the end of the table. As files are */ -/* removed, succeeding files are moved forward to take up the */ -/* slack. This keeps the table ordered by file number. */ - - -/* The body table contains the beginning of the list of the stored */ -/* segments for each body, and the expense at which that list */ -/* was constructed. (The expense of a body list is the number of */ -/* segment descriptors examined during the construction of the list.) */ -/* It also contains the highest and lowest file numbers searched */ -/* during the construction of the list. */ - -/* For each body, the time bounds of the "re-use interval" of the */ -/* last segment found are stored. This interval is the maximal */ -/* interval containing the epoch of the last request for data for */ -/* this body, such that the interval is not masked by higher-priority */ -/* segments. The handle, segment descriptor, and segment identifier */ -/* returned on the last request are also stored. */ - -/* All names begin with BT. */ - -/* BOD Body */ -/* EXP Expense */ -/* HFS Highest file (number) searched */ -/* LFS Lowest file (number) searched */ -/* BEG Beginning of segment list */ -/* LB Lower bound of the re-use interval of */ -/* previous segment returned. */ -/* UB Upper bound of the re-use interval of */ -/* previous segment returned. */ -/* PRVD Previous descriptor returned. */ -/* PRVI Previous segment identifier returned. */ -/* PRVH Previous handle returned. */ -/* CHKP Logical indicating that previous segment should */ -/* be checked to see whether it satisfies a request. */ -/* RUEX Expense of the re-use interval. */ - -/* NBT is the number of bodies for which segments are currently */ -/* being stored in the table. BINDEX is the index of whatever */ -/* body is of current interest at any given time. */ - -/* New bodies are added at the end of the table. As bodies are */ -/* removed, the last body is moved forward to take up the slack. */ -/* This keeps the entries in the table contiguous. */ - - -/* The segment table contains the handle, descriptor, and identifier */ -/* for each segment that has been found so far. */ - -/* The segment table is implemented as a set of arrays indexed by */ -/* a SPICE doubly linked list structure. For each body in the */ -/* body table, there is a segment table list; each node of a list */ -/* points to data associated with a segment. In each list, the head */ -/* node corresponds to the highest-priority segment in that list, */ -/* and segment priority decreases in the forward direction. */ - -/* All names begin with ST. */ - -/* POOL Doubly linked list pool. */ -/* HAN Handle */ -/* DES Descriptor */ -/* IDNT Identifier */ - -/* New segments are added to the front or end of a body list */ -/* as appropriate, according to the rules spelled out under */ -/* entry point PCKSFS. */ - - -/* Other stuff */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (descr) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_pcklof; - case 2: goto L_pckuof; - case 3: goto L_pcksfs; - } - - -/* Nobody has any business calling PCKBSR directly. */ - - if (return_()) { - return 0; - } - chkin_("PCKBSR", (ftnlen)6); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("PCKBSR", (ftnlen)6); - return 0; -/* $Procedure PCKLOF ( PCK, Load binary file ) */ - -L_pcklof: -/* $ Abstract */ - - -/* Load a binary PCK file for use by the readers. Return the */ -/* handle of the loaded file which is used by other PCK routines to */ -/* refer to the file. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of the file to be loaded. */ -/* HANDLE O Loaded file's handle. */ -/* FTSIZE P Maximum number of loaded PCK files. */ - -/* $ Detailed_Input */ - -/* FNAME Character name of the file to be loaded. */ - -/* $ Detailed_Output */ - -/* HANDLE Integer handle assigned to the file upon loading. */ -/* Almost every other PCK routine will subsequently use */ -/* this number to refer to the file. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of PCK files that may */ -/* be loaded simultaneously under any circumstances. */ -/* FTSIZE is currently set to match the maximum number */ -/* of DAF files that may be loaded simultaneously. */ - -/* $ Exceptions */ - -/* 1) If an attempt is made to open more DAF files than is specified */ -/* by the parameter FTSIZE in DAFAH, an error is signaled by a */ -/* routine in the call tree of this routine. */ - -/* 2) If an attempt is made to load more files than is specified */ -/* by the local paramater FTSIZE, and if the DAF system has */ -/* room to load another file, the error SPICE(PCKFILETABLEFULL) */ -/* signaled. The current setting of FTSIZE does not allow this */ -/* situation to arise: the DAF system will trap the error */ -/* before this routine has the chance. */ - -/* $ Files */ - -/* A file specified by FNAME, to be loaded. The file is assigned a */ -/* handle by PCKLOF, which will be used by most other routines to */ -/* refer to it. */ - -/* $ Particulars */ - -/* If there is room for a new file in the file table, PCKLOF creates */ -/* an entry for it and loads the file for reading using DAFOPR. */ - -/* $ Examples */ - -/* See the Example above, in PCKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.S. Zukor (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When an already loaded kernel is opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 2) This routine now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby avoiding */ -/* arithmetic overflow. The numbers in the file table */ -/* are replaced with consecutive integers in the range */ -/* 1 : NFT, such that the ordering of the numbers is not */ -/* changed. The HFS and LFS arrays are updated accordingly. */ - -/* Also, the flags indicating validity of the re-use intervals */ -/* are set to .FALSE. here. */ - -/* - SPICELIB Version 1.0.0, 16-MAR-1994 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* load PCK file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a loaded kernel is opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 2) This routine now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby avoiding */ -/* arithmetic overflow. The numbers in the file table */ -/* are replaced with consecutive integers in the range */ -/* 1 : NFT, such that the ordering of the numbers is not */ -/* changed. The HFS and LFS arrays are updated accordingly. */ -/* HFS and LFS entries that have gone stale are set to zero. */ - -/* Also, the flags indicating validity of the re-use intervals */ -/* are set to .FALSE. here. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKLOF", (ftnlen)6); - } - -/* Any time we load a file, there is a possibility that the */ -/* re-use intervals are invalid because they're been superseded */ -/* by higher-priority data. Since we're not going to examine */ -/* the loaded file, simply indicate that all of the re-use */ -/* intervals are invalid. */ - - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - btchkp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("btchkp", - i__2, "pckbsr_", (ftnlen)914)] = FALSE_; - } - -/* Nothing works unless at least one file has been loaded, so */ -/* this is as good a place as any to initialize the segment table */ -/* linked list pool, whenever the body table is empty. */ - - if (nbt == 0) { - lnkini_(&c__100, stpool); - } - -/* To load a new file, first try to open it for reading. */ - - dafopr_(fname, handle, fname_len); - if (failed_()) { - chkout_("PCKLOF", (ftnlen)6); - return 0; - } - -/* Determine if the file is already in the table. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex > 0) { - -/* The last call we made to DAFOPR added another DAF link to */ -/* the PCK file. Remove this link. */ - - dafcls_(handle); - -/* Remove the file from the file table and remove its segments */ -/* from the segment table. If the segment list for a body */ -/* becomes empty, remove that body from the body table. */ - - --nft; - i__1 = nft; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan" - , i__2, "pckbsr_", (ftnlen)956)] = fthan[(i__3 = i__) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "pckbsr_" - , (ftnlen)956)]; - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum" - , i__2, "pckbsr_", (ftnlen)957)] = ftnum[(i__3 = i__) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftnum", i__3, "pckbsr_" - , (ftnlen)957)]; - } - i__ = 1; - while(i__ <= nbt) { - p = btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)964)]; - while(p > 0) { - -/* Find the successor of P, if any. */ - - nxtseg = lnknxt_(&p, stpool); - if (sthan[(i__1 = p - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "pckbsr_", (ftnlen)972)] == *handle) { - -/* The segment corresponding to node P came from */ -/* the file we're unloading. Delete the node for */ -/* P from the segment list for body I; if P happens */ -/* to be the head node for body I's segment list, */ -/* make the successor of P the head of the list. */ - - lnkfsl_(&p, &p, stpool); - if (p == btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)982)]) { - btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)983)] - = nxtseg; - } - } - -/* Update P. */ - - p = nxtseg; - } - -/* If the list for this body is now empty, shorten the current */ -/* table by one: put all the entries for the last body in the */ -/* table into the space occupied by the one we've deleted. */ - - if (btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)999)] <= 0) { - -/* Because all of the re-use intervals are invalid, we need */ -/* not copy the saved items associated with them. The */ -/* items not copied are */ - -/* BTCHKP */ -/* BTLB */ -/* BTPRVD */ -/* BTPRVH */ -/* BTPRVI */ -/* BTRUEX */ -/* BTUB */ - - btbod[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbod", i__1, "pckbsr_", (ftnlen)1013)] = btbod[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btbod", i__2, "pckbsr_", (ftnlen)1013)]; - btexp[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "pckbsr_", (ftnlen)1014)] = btexp[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "pckbsr_", (ftnlen)1014)]; - bthfs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "pckbsr_", (ftnlen)1015)] = bthfs[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "pckbsr_", (ftnlen)1015)]; - btlfs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "pckbsr_", (ftnlen)1016)] = btlfs[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "pckbsr_", (ftnlen)1016)]; - btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)1017)] = btbeg[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btbeg", i__2, "pckbsr_", (ftnlen)1017)]; - --nbt; - } else { - ++i__; - } - } - } else { - -/* This is a new file. Make sure that there are unused slots */ -/* in the file table. */ - - if (nft == 1000) { - -/* This error case can occur only if FTSIZE is larger than */ -/* the maximum number of open DAF files. Currently FTSIZE */ -/* is equal to this limit. */ - - dafcls_(handle); - setmsg_("The internal file table is already full, with # entries." - , (ftnlen)56); - errint_("#", &c__1000, (ftnlen)1); - sigerr_("SPICE(PCKFILETABLEFULL)", (ftnlen)23); - chkout_("PCKLOF", (ftnlen)6); - return 0; - } - } - -/* Determine the next file number. Note that later code assumes */ -/* that the file number can be incremented by 1, so we can't allow */ -/* the file number to reach INTMAX(). */ - - if (next < intmax_() - 1) { - ++next; - } else { - -/* The user is to be congratulated: we've run out of file */ -/* numbers. */ - -/* Re-set the valid file numbers so they lie in the range 1:NFT, */ -/* with the Ith file in the file table having file number I. */ -/* First update the LFS and HFS components of the body table */ -/* according to this mapping. */ - -/* Set any body table entries that are lower than FTNUM(1) to */ -/* zero. */ - - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Re-map the HFS table for the Ith body. */ - - j = isrchi_(&bthfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("bthfs", i__2, "pckbsr_", (ftnlen)1079)], &nft, - ftnum); - if (j > 0) { - -/* The highest file searched for body I is the Jth file */ -/* in the file table. */ - - bthfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "pckbsr_", (ftnlen)1086)] = j; - } else { - -/* The highest file searched for body I is not in the file */ -/* table. This occurs when the highest file searched has */ -/* been unloaded. Note that this assigment makes all files */ -/* appear to be "new" when a lookup for body I is performed. */ - - bthfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "pckbsr_", (ftnlen)1095)] = 0; - } - -/* Re-map the LFS table for the Ith body. */ - - j = isrchi_(&btlfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btlfs", i__2, "pckbsr_", (ftnlen)1102)], &nft, - ftnum); - if (j > 0) { - -/* The lowest file searched for body I is the Jth file */ -/* in the file table. */ - - btlfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "pckbsr_", (ftnlen)1109)] = j; - } else { - -/* The lowest file searched for body I is not in the file */ -/* table. This occurs when the lowest file searched has */ -/* been unloaded. Force reconstruction of the list by */ -/* making all files "new." */ - - btlfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "pckbsr_", (ftnlen)1118)] = 0; - bthfs[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "pckbsr_", (ftnlen)1119)] = 0; - } - } - -/* Re-map the file number table itself. */ - - i__1 = nft; - for (i__ = 1; i__ <= i__1; ++i__) { - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum" - , i__2, "pckbsr_", (ftnlen)1130)] = i__; - } - -/* Assign a new file number. */ - - next = nft + 1; - } - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "pckbsr_", (ftnlen)1143)] = *handle; - ftnum[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnum", i__1, - "pckbsr_", (ftnlen)1144)] = next; - chkout_("PCKLOF", (ftnlen)6); - return 0; -/* $Procedure PCKUOF ( PCK, Unload binary file ) */ - -L_pckuof: -/* $ Abstract */ - -/* Unload a binary PCK file so that it will no longer be searched by */ -/* the readers. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file to be unloaded */ - -/* $ Detailed_Input */ - -/* HANDLE Integer handle assigned to the file upon loading. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Unloading a file that has not been loaded is a no-op. */ -/* No error is signaled. */ - -/* $ Files */ - -/* The file referred to by HANDLE is unloaded. */ - -/* $ Particulars */ - -/* A file is removed from consideration by the readers by a call to */ -/* PCKUOF. */ - -/* If the file specified by HANDLE is not currently loaded in the */ -/* PCK system, no action is taken. */ - -/* $ Examples */ - -/* See the Example above, in PCKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.S. Zukor (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) This routine now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* Also, the flags indicating validity of those re-use intervals */ -/* whose data comes from the unloaded file are set to .FALSE. */ - -/* - SPICELIB Version 1.0.0, 16-MAR-1994 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* unload PCK file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) This routine now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* Also, the flags indicating validity of those re-use intervals */ -/* whose data comes from the unloaded file are set to .FALSE. */ - -/* -& */ - if (return_()) { - return 0; - } - -/* All of the stored segments from the file must be removed */ -/* from the segment table (by returning the corresponding nodes */ -/* to the segment table pool.) */ - -/* Don't do anything if the given handle is not in the file table. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex == 0) { - return 0; - } - -/* First get rid of the entry in the file table. Close the file */ -/* before wiping out the handle. */ - - dafcls_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "pckbsr_", (ftnlen)1321)]); - --nft; - i__1 = nft; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan", - i__2, "pckbsr_", (ftnlen)1326)] = fthan[(i__3 = i__) < 1000 && - 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "pckbsr_", (ftnlen) - 1326)]; - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "pckbsr_", (ftnlen)1327)] = ftnum[(i__3 = i__) < 1000 && - 0 <= i__3 ? i__3 : s_rnge("ftnum", i__3, "pckbsr_", (ftnlen) - 1327)]; - } - -/* Check each body list individually. Note that the first node */ -/* on each list, having no predecessor, must be handled specially. */ - - i__ = 1; - while(i__ <= nbt) { - p = btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btbeg", - i__1, "pckbsr_", (ftnlen)1338)]; - while(p > 0) { - nxtseg = lnknxt_(&p, stpool); - if (sthan[(i__1 = p - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("sth" - "an", i__1, "pckbsr_", (ftnlen)1344)] == *handle) { - if (p == btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)1346)]) { - btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)1347)] = nxtseg; - } - lnkfsl_(&p, &p, stpool); - } - p = nxtseg; - } - -/* If we happened to get rid of all of the segments for this */ -/* body, then the body should be deleted from the table: shift */ -/* all entries for the body at the end of the table into the */ -/* space occupied by the deleted body. */ - - if (btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btbeg", - i__1, "pckbsr_", (ftnlen)1364)] <= 0) { - if (i__ != nbt) { - btbod[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbod", i__1, "pckbsr_", (ftnlen)1368)] = btbod[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btbod", i__2, "pckbsr_", (ftnlen)1368)]; - btexp[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "pckbsr_", (ftnlen)1369)] = btexp[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "pckbsr_", (ftnlen)1369)]; - bthfs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "pckbsr_", (ftnlen)1370)] = bthfs[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "pckbsr_", (ftnlen)1370)]; - btlfs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "pckbsr_", (ftnlen)1371)] = btlfs[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "pckbsr_", (ftnlen)1371)]; - btbeg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)1372)] = btbeg[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btbeg", i__2, "pckbsr_", (ftnlen)1372)]; - btlb[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btlb" - , i__1, "pckbsr_", (ftnlen)1373)] = btlb[(i__2 = nbt - - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("btlb", i__2, - "pckbsr_", (ftnlen)1373)]; - btub[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btub" - , i__1, "pckbsr_", (ftnlen)1374)] = btub[(i__2 = nbt - - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("btub", i__2, - "pckbsr_", (ftnlen)1374)]; - btprvh[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btprvh", i__1, "pckbsr_", (ftnlen)1375)] = btprvh[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btprvh", i__2, "pckbsr_", (ftnlen)1375)]; - s_copy(btprvi + ((i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btprvi", i__1, "pckbsr_", (ftnlen)1376)) * 40, - btprvi + ((i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btprvi", i__2, "pckbsr_", (ftnlen)1376)) * - 40, (ftnlen)40, (ftnlen)40); - btchkp[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "pckbsr_", (ftnlen)1377)] = btchkp[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btchkp", i__2, "pckbsr_", (ftnlen)1377)]; - btruex[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "pckbsr_", (ftnlen)1378)] = btruex[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btruex", i__2, "pckbsr_", (ftnlen)1378)]; - moved_(&btprvd[(i__1 = nbt * 5 - 5) < 100 && 0 <= i__1 ? i__1 - : s_rnge("btprvd", i__1, "pckbsr_", (ftnlen)1380)], & - c__5, &btprvd[(i__2 = i__ * 5 - 5) < 100 && 0 <= i__2 - ? i__2 : s_rnge("btprvd", i__2, "pckbsr_", (ftnlen) - 1380)]); - } - --nbt; - } else { - ++i__; - } - } - -/* Any time we unload a file, we may be removing the file */ -/* providing data for the re-use interval for one or more bodies. */ -/* For each body, if the handle associated with the re-use interval */ -/* happens to be that of the file we're unloading, indicate */ -/* that the re-use interval is invalid. */ - - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - if (btchkp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("btchkp" - , i__2, "pckbsr_", (ftnlen)1403)]) { - if (btprvh[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btprvh", i__2, "pckbsr_", (ftnlen)1405)] == *handle) { - btchkp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btchkp", i__2, "pckbsr_", (ftnlen)1406)] = FALSE_; - } - } - } - return 0; -/* $Procedure PCKSFS ( PCK, Select file and segment ) */ - -L_pcksfs: -/* $ Abstract */ - -/* Search through loaded files to find the first segment applicable */ -/* to the body and time specified. Buffer searched segments in the */ -/* process, to attempt to avoid re-reading files. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER BODY */ -/* DOUBLE PRECISION ET */ -/* INTEGER HANDLE */ -/* DOUBLE PRECISION DESCR ( * ) */ -/* CHARACTER*(*) IDENT */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Body ID. */ -/* ET I Ephemeris time. */ -/* HANDLE O Handle of file containing the applicable segment. */ -/* DESCR O Descriptor of the applicable segment. */ -/* IDENT O Identifier of the applicable segment. */ -/* FOUND O Indicates whether or not a segment was found. */ - -/* $ Detailed_Input */ - -/* BODY is the NAIF integer code of an ephemeris object, */ -/* typically a solar system body. */ - -/* ET is a time, in seconds past the epoch J2000 TDB. */ - -/* $ Detailed_Output */ - -/* HANDLE on output is the handle of the binary PCK file */ -/* containing a located segment. */ - -/* DESCR is the descriptor of a located segment. */ - -/* IDENT is the identifier of a located segment. */ - -/* FOUND indicates whether a requested segment was found or not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an attempt is made to call PCKSFS when there aren't any */ -/* files loaded, the error SPICE(NOLOADEDFILES) is signaled. */ - -/* $ Files */ - -/* All files loaded by PCKLOF are potential search targets for */ -/* PCKSFS. */ - -/* $ Particulars */ - -/* This routine finds the highest-priority segment, in any loaded */ -/* PCK file, such that the segment provides data for the specified */ -/* body and epoch. */ - -/* $ Examples */ - -/* See the Example above, in PCKBSR. */ - -/* $ Restrictions */ - -/* 1) If Fortran I/O errors occur while searching a loaded PCK */ -/* file, the internal state of this suite of routines may */ -/* be corrupted. It may be possible to correct the state */ -/* by unloading the pertinent PCK files and then re-loading */ -/* them. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.S. Zukor (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single PCK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) DAF calls are now followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 4) A subscript bound violation in a loop termination test */ -/* was corrected. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The body table size has been increased to 200 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - - -/* - SPICELIB Version 1.0.0, 16-MAR-1994 (KSZ) */ - -/* This differs only slightly from the SPKXXX code. */ -/* The main difference is that the SFS subroutine returns */ -/* FOUND = FALSE if no files are found, rather than returning */ -/* an error. */ - -/* -& */ -/* $ Index_Entries */ - -/* select PCK file and segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 1.1.0, 08-NOV-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single PCK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) DAF calls are now followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 4) A subscript bound violation in a loop termination test */ -/* was corrected. The loop is located in the */ -/* 'SEARCH W/O BUFFERING' block; it finds the start of a */ -/* partial list that is to be freed. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The body table size has been increased to 200 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* In order to simplify the source code, the in-line singly */ -/* linked list implementation of the segment table has been */ -/* replaced by an implementation relying on the SPICELIB */ -/* doubly linked list routines. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKSFS", (ftnlen)6); - } - -/* Assume the segment is not found, until it actually is. */ - - *found = FALSE_; - -/* Buffering segments involves maintaining three tables: the */ -/* file table, the body table, and the segment table. The routine */ -/* is broken down into various tasks, described below, which */ -/* perform these manipulations. A description of the components */ -/* of each table is provided in the declarations section of PCKBSR. */ - -/* Return FOUND as .FALSE. if no files are loaded. Unlike the SPK */ -/* case, it's not a error to call this routine if no files are */ -/* loaded. */ - - if (nft == 0) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - -/* The stack of suspended tasks is empty. */ - - top = 0; - -/* In the following loop, we will try to simplify things by */ -/* doing exactly one thing on each pass through the loop. */ -/* After each pass, the status of the loop (STATUS) will be */ -/* adjusted to reflect the next thing that needs to be done. */ -/* Occasionally, the current task will have to be interrupted */ -/* until another task can be carried out. (For example, when */ -/* collecting new segments, an interrupt might place a segment */ -/* at the front or end of the current body list; when placing */ -/* the segment on the list, a second interrupt might free up */ -/* room in the segment table in order to allow the addition */ -/* to proceed.) In this case, the current task will be saved and */ -/* restored after the more urgent task has been completed. */ - -/* The loop can terminate in only one of two ways (unless an */ -/* error occurs). First, if an applicable segment is found in */ -/* the segment table, the handle, descriptor, and identifier for */ -/* the segment are returned immediately. Second, if the table */ -/* does not contain an applicable segment, and if no files remain */ -/* to be searched, the loop terminates normally, and no data are */ -/* returned. */ - -/* The individual tasks are described below. */ - -/* 'NEW BODY' */ - - -/* This indicates that the specified body has no segments stored */ -/* for it at all. It must be added to the body table. (This is */ -/* followed immediately by an OLD FILES search, in which every */ -/* file loaded is considered an old file.) */ - -/* 'NEW FILES' */ - -/* This indicates that at least one new file has been added */ -/* since the last time the segment list for the specified */ -/* body was searched. Find the oldest of these new files, */ -/* and begin a NEW SEGMENTS search in forward order for */ -/* segments to add to the front of the list. */ - -/* 'NEW SEGMENTS' */ - -/* Continue a NEW FILES search, adding segments for the specified */ -/* body to the front of the list. */ - -/* 'OLD FILES' */ - -/* This indicates that although the list has been searched */ -/* and found to contain no applicable segment, some of the */ -/* older files remain to be searched. Find the newest of these */ -/* old files, and begin an OLD SEGMENTS search in backward order. */ - -/* 'OLD SEGMENTS' */ - -/* Continue an OLD FILES search, adding segments for the specified */ -/* body to the end of the list. */ - -/* 'CHECK LIST' */ - -/* This indicates that the list is ready to be searched, */ -/* either because no new files have been added, or because */ -/* segments from a new file or an old file have recently */ -/* been added. */ - -/* The list is never checked until all new files have been */ -/* searched. */ - -/* If an applicable segment is found, it is returned. */ - -/* 'MAKE ROOM' (Interrupt) */ - -/* This indicates that one of the bodies must be removed, */ -/* along with its stored segments, to make room for another */ -/* body or segment. The body (other than the one being searched */ -/* for) with the smallest expense is selected for this honor. */ - -/* 'ADD TO FRONT' (Interrupt) */ - -/* This indicates that a segment has been found (during the */ -/* course of a NEW FILES search) and must be added to the front */ -/* of the list. */ - -/* 'ADD TO END' (Interrupt) */ - -/* This indicates that a segment has been found (during the */ -/* course of an OLD FILES search) and must be added to the end */ -/* of the list. */ - -/* 'SUSPEND' */ - -/* This indicates that the current task (DOING) should be */ -/* interrupted until a more urgent task (URGENT) can be */ -/* carried out. The current task is placed on a stack for */ -/* safekeeping. */ - -/* 'RESUME' */ - -/* This indicates that the most recently interrupted task */ -/* should be resumed immediately. */ - -/* '?' */ - -/* This indicates that the next task is not immediately */ -/* apparent: if new files exist, they should be searched; */ -/* otherwise the list should be checked. */ - - -/* Is the body already in the body table? This determines what the */ -/* first task should be. */ - - bindex = isrchi_(body, &nbt, btbod); - if (bindex == 0) { - s_copy(status, "NEW BODY", (ftnlen)15, (ftnlen)8); - } else { - -/* Much of the time, the segment used to satisfy the previous */ -/* request for a given body will also satisfy the current request */ -/* for data for that body. Check whether this is the case. */ - - if (btchkp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "pckbsr_", (ftnlen)1827)]) { - -/* The previous segment found for the current body is a */ -/* viable candidate for the current request. See whether */ -/* the input ET value falls into the re-use interval for this */ -/* body: the time interval for which the previously returned */ -/* segment for this body provides the highest-priority */ -/* coverage. */ - -/* We treat the re-use interval as topologically open because */ -/* one or both endpoints may belong to higher-priority */ -/* segments. */ - - if (*et > btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "pckbsr_", (ftnlen)1840)] && *et < - btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btub", i__2, "pckbsr_", (ftnlen)1840)]) { - -/* The request time is covered by the segment found on */ -/* the previous request for data for the current body, */ -/* and this interval is not masked by any higher-priority */ -/* segments. The previous segment for this body satisfies */ -/* the request. */ - - *handle = btprvh[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("btprvh", i__1, "pckbsr_", (ftnlen)1849)]; - s_copy(ident, btprvi + ((i__1 = bindex - 1) < 20 && 0 <= i__1 - ? i__1 : s_rnge("btprvi", i__1, "pckbsr_", (ftnlen) - 1850)) * 40, ident_len, (ftnlen)40); - moved_(&btprvd[(i__1 = bindex * 5 - 5) < 100 && 0 <= i__1 ? - i__1 : s_rnge("btprvd", i__1, "pckbsr_", (ftnlen)1852) - ], &c__5, descr); - *found = TRUE_; - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - -/* Adjust the expense here. If the expense of the list */ -/* contains a component due to the cost of finding the */ -/* unbuffered segment providing data for re-use, subtract */ -/* that component from the expense. */ - - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("bte" - "xp", i__1, "pckbsr_", (ftnlen)1867)] = btexp[(i__2 = - bindex - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("btexp", - i__2, "pckbsr_", (ftnlen)1867)] - btruex[(i__3 = bindex - - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("btruex", i__3, - "pckbsr_", (ftnlen)1867)]; - btruex[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "pckbsr_", (ftnlen)1868)] = 0; - -/* The re-use interval becomes invalid if it didn't satisfy */ -/* the request. The validity flag gets re-set below. */ - -/* At this point, the previous segment is not a candidate */ -/* to satisfy the request---at least not until we've verified */ -/* that */ - -/* - The previous segment is still available. */ - -/* - The previous segment hasn't been superseded by a more */ -/* recently loaded segment. */ - - btchkp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "pckbsr_", (ftnlen)1883)] = FALSE_; - } - -/* If the segment list for this body is empty, make sure the */ -/* expense is reset to 0. */ - - if (btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btb" - "eg", i__1, "pckbsr_", (ftnlen)1892)] == 0) { - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("bte" - "xp", i__1, "pckbsr_", (ftnlen)1894)] = 0; - } - s_copy(status, "?", (ftnlen)15, (ftnlen)1); - } - while(s_cmp(status, "HOPELESS", (ftnlen)15, (ftnlen)8) != 0) { - -/* If new files have been added, they have to be searched. */ -/* Otherwise, we can go right to the list of stored segments. */ - - if (s_cmp(status, "?", (ftnlen)15, (ftnlen)1) == 0) { - -/* There are two ways to get to this point. */ - -/* 1) Status may have been set to '?' prior to the */ -/* loop DO WHILE ( STATUS .NE. HOPELESS ). */ - -/* 2) Status was set to '?' by the NEW SEGMENTS block */ -/* of code as the result of finishing the read of */ -/* a new file. */ - - if (bthfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "pckbsr_", (ftnlen)1921)] < ftnum[(i__2 = - nft - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "pckbsr_", (ftnlen)1921)]) { - s_copy(status, "NEW FILES", (ftnlen)15, (ftnlen)9); - } else { - s_copy(status, "CHECK LIST", (ftnlen)15, (ftnlen)10); - } - } else if (s_cmp(status, "NEW BODY", (ftnlen)15, (ftnlen)8) == 0) { - -/* New bodies are added to the end of the body table. If the */ -/* table is full, one of the current occupants must be */ -/* removed to make room for the new one. */ - -/* Setting LFS to one more than the highest current */ -/* file number means the OLD FILES SEARCH that follows will */ -/* begin with the last-loaded file. */ - -/* There is one way to get here: */ - -/* 1) The variable STATUS was set to NEW BODY prior to the */ -/* loop DO WHILE ( STATUS .NE. HOPELESS ). */ - -/* Find the cheapest slot in the body table to store */ -/* the initial information about this body. */ - -/* NOTE: This used to be handled by the MAKE ROOM section. */ -/* However, trying to handle this special case there was */ -/* just more trouble than it was worth. */ - - if (nbt < 20) { - -/* If the body table isn't full, the cheapest place is */ -/* just the next unused row of the table. */ - - ++nbt; - cheap = nbt; - } else { - -/* The body table is full. Find the least */ -/* expensive body in the table and remove it. */ - - cheap = 1; - minexp = btexp[0]; - i__1 = nbt; - for (i__ = 2; i__ <= i__1; ++i__) { - if (btexp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btexp", i__2, "pckbsr_", (ftnlen)1970)] < - minexp) { - cheap = i__; - minexp = btexp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btexp", i__2, "pckbsr_", ( - ftnlen)1972)]; - } - } - -/* If there are any segments associated with the */ -/* least expensive body, we put them back on the free */ -/* list. */ - - head = btbeg[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)1982)]; - if (head > 0) { - tail = -lnkprv_(&head, stpool); - lnkfsl_(&head, &tail, stpool); - } - } - -/* Set up a body table entry for the new body. */ - - btbod[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btbod" - , i__1, "pckbsr_", (ftnlen)1996)] = *body; - btexp[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btexp" - , i__1, "pckbsr_", (ftnlen)1997)] = 0; - bthfs[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("bthfs" - , i__1, "pckbsr_", (ftnlen)1998)] = ftnum[(i__2 = nft - 1) - < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", i__2, "pck" - "bsr_", (ftnlen)1998)]; - btlfs[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btlfs" - , i__1, "pckbsr_", (ftnlen)1999)] = ftnum[(i__2 = nft - 1) - < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", i__2, "pck" - "bsr_", (ftnlen)1999)] + 1; - btbeg[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btbeg" - , i__1, "pckbsr_", (ftnlen)2000)] = 0; - btchkp[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btc" - "hkp", i__1, "pckbsr_", (ftnlen)2001)] = FALSE_; - -/* The following items associated with the re-use interval */ -/* need not be initialized at this point: */ - -/* BTRUEX */ -/* BTLB */ -/* BTUB */ -/* BTPRVH */ -/* BTPRVI */ -/* BTPRVD */ - -/* However, we'll give these items initial values to */ -/* help prevent compilation warnings from zealous */ -/* compilers. */ - - btruex[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btr" - "uex", i__1, "pckbsr_", (ftnlen)2018)] = 0; - btlb[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btlb", - i__1, "pckbsr_", (ftnlen)2019)] = dpmin_(); - btub[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btub", - i__1, "pckbsr_", (ftnlen)2020)] = dpmax_(); - btprvh[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btp" - "rvh", i__1, "pckbsr_", (ftnlen)2021)] = 0; - s_copy(btprvi + ((i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btprvi", i__1, "pckbsr_", (ftnlen)2022)) * 40, - " ", (ftnlen)40, (ftnlen)1); - cleard_(&c__5, &btprvd[(i__1 = cheap * 5 - 5) < 100 && 0 <= i__1 ? - i__1 : s_rnge("btprvd", i__1, "pckbsr_", (ftnlen)2023)]); - -/* BINDEX is the body table index of the new entry. */ - - bindex = cheap; - -/* Now search the loaded PCK files for segments relating to */ -/* this body. We start with the last-loaded files and */ -/* work backwards. */ - - s_copy(status, "OLD FILES", (ftnlen)15, (ftnlen)9); - } else if (s_cmp(status, "NEW FILES", (ftnlen)15, (ftnlen)9) == 0) { - -/* When new files exist, they should be searched in forward */ -/* order, beginning with the oldest new file not yet searched. */ -/* All new files must be searched before the list can be */ -/* checked, to ensure that the best (newest) segments are */ -/* being used. */ - -/* Begin a forward search, and prepare to look for individual */ -/* segments from the file. */ - -/* The only way to get here is to have STATUS set to */ -/* the value NEW FILES in the STATUS .EQ. '?' block */ -/* of the IF structure. */ - -/* Find the next file to search; set FINDEX to the */ -/* corresponding file table entry. */ - - findex = 1; - while(bthfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "pckbsr_", (ftnlen)2059)] >= ftnum[(i__2 = - findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "pckbsr_", (ftnlen)2059)]) { - ++findex; - } - bthfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("bth" - "fs", i__1, "pckbsr_", (ftnlen)2063)] = ftnum[(i__2 = - findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "pckbsr_", (ftnlen)2063)]; - dafbfs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "pckbsr_", (ftnlen)2065)]); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - s_copy(status, "NEW SEGMENTS", (ftnlen)15, (ftnlen)12); - -/* The cost of the list contributed by the new file is */ -/* zero so far. */ - - cost = 0; - } else if (s_cmp(status, "NEW SEGMENTS", (ftnlen)15, (ftnlen)12) == 0) - { - -/* New files are searched in forward order. Segments, when */ -/* found, are inserted at the front of the list. Invisible */ -/* segments (alpha > omega) are ignored. */ - -/* Each segment examined, whether applicable or not, adds to */ -/* the expense of the list. */ - -/* The only way to get here is from the NEW FILES block */ -/* of the IF structure. */ - daffna_(&fnd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - if (! fnd) { - -/* We're out of segments in the current file. Decide */ -/* whether we need to examine another new file, or */ -/* whether we're ready to check the list. */ - - s_copy(status, "?", (ftnlen)15, (ftnlen)1); - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "pckbsr_", (ftnlen)2107)] = btexp[( - i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "pckbsr_", (ftnlen)2107)] + cost; - } else { - dafgs_(descr); - dafus_(descr, &c__2, &c__5, dcd, icd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - if (icd[0] == *body && dcd[0] <= dcd[1]) { - s_copy(doing, "NEW SEGMENTS", (ftnlen)15, (ftnlen)12); - s_copy(urgent, "ADD TO FRONT", (ftnlen)15, (ftnlen)12); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } - ++cost; - } - -/* If we haven't reset the status, we'll return for another */ -/* 'NEW SEGMENTS' pass. */ - - } else if (s_cmp(status, "OLD FILES", (ftnlen)15, (ftnlen)9) == 0) { - -/* When old files must be searched (because the segments */ -/* in the list are inadequate), they should be searched */ -/* in backward order, beginning with the newest old file */ -/* not yet searched. The segment list will be re-checked */ -/* after each file is searched. If a match is found, */ -/* the search terminates, so some old files may not be */ -/* searched. */ - -/* Search from the end, and prepare to look for individual */ -/* segments from the file. */ - -/* You can get to this block in two ways. */ - -/* 1) We can have a NEW BODY */ - -/* 2) We have checked the current list (CHECK LIST) for */ -/* this body, didn't find an applicable segment and */ -/* have some files left that have not been seached. */ - findex = nft; - while(btlfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "pckbsr_", (ftnlen)2159)] <= ftnum[(i__2 = - findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "pckbsr_", (ftnlen)2159)]) { - --findex; - } - dafbbs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "pckbsr_", (ftnlen)2163)]); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - s_copy(status, "OLD SEGMENTS", (ftnlen)15, (ftnlen)12); - -/* The next thing we'll do is search through all the segments */ -/* of this file for those that applicable to this body. */ -/* The cost of the list contributed by the current file is */ -/* zero so far. */ - - cost = 0; - } else if (s_cmp(status, "OLD SEGMENTS", (ftnlen)15, (ftnlen)12) == 0) - { - -/* Old files are searched in backward order. Segments, when */ -/* found, are inserted at the end of the list. Invisible */ -/* segments (alpha > omega) are ignored. */ - -/* Each segment examined, whether applicable or not, adds to */ -/* the expense of the list. */ - -/* There is only one way to get here---from the */ -/* block 'OLD FILES'. Note we do not add to the */ -/* expense of the list for this body until we've */ -/* completely searched this file. */ - - daffpa_(&fnd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - if (! fnd) { - -/* We've been through all of the segments in this file. */ -/* Change the lowest file searched indicator for this body */ -/* to be the current file, and go check the current list. */ - - btlfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "pckbsr_", (ftnlen)2208)] = ftnum[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("ftnum", i__2, "pckbsr_", (ftnlen)2208)]; - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "pckbsr_", (ftnlen)2209)] = btexp[( - i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "pckbsr_", (ftnlen)2209)] + cost; - s_copy(status, "CHECK LIST", (ftnlen)15, (ftnlen)10); - } else { - dafgs_(descr); - dafus_(descr, &c__2, &c__5, dcd, icd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - if (icd[0] == *body && dcd[0] <= dcd[1]) { - s_copy(doing, "OLD SEGMENTS", (ftnlen)15, (ftnlen)12); - s_copy(urgent, "ADD TO END", (ftnlen)15, (ftnlen)10); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } - ++cost; - } - -/* If we haven't reset the status, we'll return for another */ -/* 'OLD SEGMENTS' pass. */ - - } else if (s_cmp(status, "CHECK LIST", (ftnlen)15, (ftnlen)10) == 0) { - -/* Okay, all the new files (and maybe an old file or two) have */ -/* been searched. Time to look at the list of segments stored */ -/* for the body to see if one applicable to the specified */ -/* epoch is hiding in there. If so, return it. If not, */ -/* try another old file. If there are no more old files, */ -/* give up the ghost. */ - -/* There are two ways to get to this point. */ - -/* 1) From the '?' block. */ -/* 2) From the 'OLD SEGMENTS' block. */ - -/* For every segment examined, initialize the re-use interval */ -/* associated with the current body. */ - - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btlb", - i__1, "pckbsr_", (ftnlen)2256)] = dpmin_(); - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btub", - i__1, "pckbsr_", (ftnlen)2257)] = dpmax_(); - p = btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)2258)]; - while(p > 0) { - if (*et > stdes[(i__1 = p * 5 - 4) < 500 && 0 <= i__1 ? i__1 : - s_rnge("stdes", i__1, "pckbsr_", (ftnlen)2262)]) { - -/* ET is to the right of the coverage interval of this */ -/* segment. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btlb", i__2, "pckbsr_", (ftnlen)2267)], - d__2 = stdes[(i__3 = p * 5 - 4) < 500 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "pckbsr_", ( - ftnlen)2267)]; - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "pckbsr_", (ftnlen)2267)] = - max(d__1,d__2); - } else if (*et < stdes[(i__1 = p * 5 - 5) < 500 && 0 <= i__1 ? - i__1 : s_rnge("stdes", i__1, "pckbsr_", (ftnlen)2270) - ]) { - -/* ET is to the left of the coverage interval of this */ -/* segment. */ - -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btub", i__2, "pckbsr_", (ftnlen)2275)], - d__2 = stdes[(i__3 = p * 5 - 5) < 500 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "pckbsr_", ( - ftnlen)2275)]; - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "pckbsr_", (ftnlen)2275)] = - min(d__1,d__2); - } else { - -/* The segment coverage interval includes ET. */ - - moved_(&stdes[(i__1 = p * 5 - 5) < 500 && 0 <= i__1 ? - i__1 : s_rnge("stdes", i__1, "pckbsr_", (ftnlen) - 2281)], &c__5, descr); - s_copy(ident, stidnt + ((i__1 = p - 1) < 100 && 0 <= i__1 - ? i__1 : s_rnge("stidnt", i__1, "pckbsr_", ( - ftnlen)2282)) * 40, ident_len, (ftnlen)40); - *handle = sthan[(i__1 = p - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("sthan", i__1, "pckbsr_", (ftnlen)2283)]; - *found = TRUE_; - -/* Set the re-use interval for the current body. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btlb", i__2, "pckbsr_", (ftnlen)2289)], - d__2 = stdes[(i__3 = p * 5 - 5) < 500 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "pckbsr_", ( - ftnlen)2289)]; - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "pckbsr_", (ftnlen)2289)] = - max(d__1,d__2); -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btub", i__2, "pckbsr_", (ftnlen)2290)], - d__2 = stdes[(i__3 = p * 5 - 4) < 500 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "pckbsr_", ( - ftnlen)2290)]; - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "pckbsr_", (ftnlen)2290)] = - min(d__1,d__2); - -/* Save the returned output items, in case this segment */ -/* may satisfy the next request. */ - - btprvh[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btprvh", i__1, "pckbsr_", (ftnlen)2296)] = - *handle; - s_copy(btprvi + ((i__1 = bindex - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("btprvi", i__1, "pckbsr_", (ftnlen) - 2297)) * 40, ident, (ftnlen)40, ident_len); - moved_(descr, &c__5, &btprvd[(i__1 = bindex * 5 - 5) < - 100 && 0 <= i__1 ? i__1 : s_rnge("btprvd", i__1, - "pckbsr_", (ftnlen)2298)]); - btchkp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btchkp", i__1, "pckbsr_", (ftnlen)2299)] = - TRUE_; - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - p = stpool[(i__1 = (p << 1) + 10) < 212 && 0 <= i__1 ? i__1 : - s_rnge("stpool", i__1, "pckbsr_", (ftnlen)2310)]; - } - -/* If we're still here we didn't have information for this */ -/* body in the segment list. */ - -/* If there are more files, search them. */ -/* Otherwise, things are hopeless, set the status that way. */ - - if (btlfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "pckbsr_", (ftnlen)2321)] > ftnum[0]) { - s_copy(status, "OLD FILES", (ftnlen)15, (ftnlen)9); - } else { - s_copy(status, "HOPELESS", (ftnlen)15, (ftnlen)8); - } - } else if (s_cmp(status, "MAKE ROOM", (ftnlen)15, (ftnlen)9) == 0) { - -/* When adding a segment to a full segment table, one of */ -/* the current bodies must be dropped. The ideal candidate */ -/* is the one whose list was constructed at the lowest expense. */ -/* The candidate should be removed from the body table, and */ -/* its list transferred to the segment table pool. */ - -/* There is ``room'' if the segment table pool contains at */ -/* least one free node. */ - -/* It is possible that a single body requires more than the */ -/* entire segment table for its own segments. Two things might */ -/* happen in such a case: */ - -/* 1) If the list under consideration was being added to at */ -/* the end, then a search is continued without buffering */ -/* any segments. */ - -/* 2) If the list was being added to at the beginning, then */ -/* that means there was a NEW FILES search going on, and */ -/* so a brand new list is constructed for the body, much */ -/* as in a 'NEW BODY' task. */ - -/* There are two different ways to get to this point. */ - -/* 1) From 'ADD TO FRONT' if the segment table pool is full. */ -/* 2) From 'ADD TO END' if the segment table pool is full. */ - -/* Try to make room by deleting a segment list. CHEAP will */ -/* be the index of the "cheapest" segment list in the body */ -/* table. */ - - minexp = intmax_(); - cheap = 0; - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ != bindex) { - -/* This list is for a body other than the current */ -/* one. */ - - if (btexp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btexp", i__2, "pckbsr_", (ftnlen)2372)] < - minexp || cheap == 0) { - -/* This list is the cheapest seen so far, */ -/* possibly because it's the first one */ -/* considered. At the moment, it's as good */ -/* a candidate for removal as any. */ - - cheap = i__; - minexp = btexp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btexp", i__2, "pckbsr_", ( - ftnlen)2381)]; - } - } - } - if (cheap == 0) { - -/* What we do if there are no delete-able segments */ -/* depends on the task that was suspended before entering */ -/* 'MAKE ROOM'. */ - - if (s_cmp(stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "pckbsr_", (ftnlen)2396)) * 15, - "ADD TO END", (ftnlen)15, (ftnlen)10) == 0) { - -/* There's nothing left to do but search the remaining */ -/* files and segments without buffering them. */ - - s_copy(status, "SEARCH W/O BUFF", (ftnlen)15, (ftnlen)15); - } else { - -/* STACK(TOP) is set to 'ADD TO FRONT'. */ - -/* If there is no room left in the table in the middle */ -/* of an attempt to add to the front of the list, just */ -/* start from scratch by treating all files as */ -/* unsearched and doing an OLD FILES search, as would */ -/* be done for a new body. */ - -/* Return the current list to the segment table pool. */ - -/* Note that, according to the specification of the */ -/* SPICELIB doubly linked list routines, the backward */ -/* pointer of a list head is the negative of the tail */ -/* node. */ - - p = btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2421)]; - tail = -lnkprv_(&p, stpool); - lnkfsl_(&p, &tail, stpool); - -/* Re-initialize the table for this body, and initiate */ -/* an 'OLD FILES' search, just as in 'NEW BODY'. */ -/* Also, reset the suspended task stack to be empty. */ - - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btexp", i__1, "pckbsr_", (ftnlen)2431)] = - 0; - bthfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("bthfs", i__1, "pckbsr_", (ftnlen)2432)] = - ftnum[(i__2 = nft - 1) < 1000 && 0 <= i__2 ? i__2 - : s_rnge("ftnum", i__2, "pckbsr_", (ftnlen)2432)]; - btlfs[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlfs", i__1, "pckbsr_", (ftnlen)2433)] = - ftnum[(i__2 = nft - 1) < 1000 && 0 <= i__2 ? i__2 - : s_rnge("ftnum", i__2, "pckbsr_", (ftnlen)2433)] - + 1; - s_copy(status, "OLD FILES", (ftnlen)15, (ftnlen)9); - top = 0; - } - } else { - -/* Return this cheapest list to the segment pool. */ - - p = btbeg[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2443)]; - if (p > 0) { - tail = -lnkprv_(&p, stpool); - lnkfsl_(&p, &tail, stpool); - } - -/* Fill the deleted body's space in the table with */ -/* the final entry in the table. */ - - if (cheap != nbt) { - btbod[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbod", i__1, "pckbsr_", (ftnlen)2458)] = - btbod[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btbod", i__2, "pckbsr_", (ftnlen)2458)]; - btexp[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btexp", i__1, "pckbsr_", (ftnlen)2459)] = - btexp[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btexp", i__2, "pckbsr_", (ftnlen)2459)]; - bthfs[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("bthfs", i__1, "pckbsr_", (ftnlen)2460)] = - bthfs[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("bthfs", i__2, "pckbsr_", (ftnlen)2460)]; - btlfs[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlfs", i__1, "pckbsr_", (ftnlen)2461)] = - btlfs[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btlfs", i__2, "pckbsr_", (ftnlen)2461)]; - btbeg[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2462)] = - btbeg[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("btbeg", i__2, "pckbsr_", (ftnlen)2462)]; - btlb[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btlb", i__1, "pckbsr_", (ftnlen)2463)] = btlb[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btlb", i__2, "pckbsr_", (ftnlen)2463)]; - btub[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btub", i__1, "pckbsr_", (ftnlen)2464)] = btub[( - i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "btub", i__2, "pckbsr_", (ftnlen)2464)]; - btprvh[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btprvh", i__1, "pckbsr_", (ftnlen)2465)] = - btprvh[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 - : s_rnge("btprvh", i__2, "pckbsr_", (ftnlen)2465)] - ; - s_copy(btprvi + ((i__1 = cheap - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("btprvi", i__1, "pckbsr_", (ftnlen) - 2466)) * 40, btprvi + ((i__2 = nbt - 1) < 20 && 0 - <= i__2 ? i__2 : s_rnge("btprvi", i__2, "pckbsr_", - (ftnlen)2466)) * 40, (ftnlen)40, (ftnlen)40); - btruex[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btruex", i__1, "pckbsr_", (ftnlen)2467)] = - btruex[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 - : s_rnge("btruex", i__2, "pckbsr_", (ftnlen)2467)] - ; - btchkp[(i__1 = cheap - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btchkp", i__1, "pckbsr_", (ftnlen)2468)] = - btchkp[(i__2 = nbt - 1) < 20 && 0 <= i__2 ? i__2 - : s_rnge("btchkp", i__2, "pckbsr_", (ftnlen)2468)] - ; - moved_(&btprvd[(i__1 = nbt * 5 - 5) < 100 && 0 <= i__1 ? - i__1 : s_rnge("btprvd", i__1, "pckbsr_", (ftnlen) - 2471)], &c__5, &btprvd[(i__2 = cheap * 5 - 5) < - 100 && 0 <= i__2 ? i__2 : s_rnge("btprvd", i__2, - "pckbsr_", (ftnlen)2471)]); - } - -/* If the final entry in the table happened to be the */ -/* current body of interest, then we also have to change */ -/* the current body index. */ - - if (bindex == nbt) { - bindex = cheap; - } - -/* One less body now. */ - - --nbt; - s_copy(status, "RESUME", (ftnlen)15, (ftnlen)6); - } - -/* Either we made room by freeing a non-empty segment list, */ -/* or we're going to work without additional space. In the */ -/* latter case, the state is now 'OLD FILES' or */ -/* 'SEARCH W/O BUFF'. */ - - } else if (s_cmp(status, "ADD TO FRONT", (ftnlen)15, (ftnlen)12) == 0) - { - -/* The current segment information should be linked in at */ -/* the head of the segment list for the current body, and */ -/* the pertinent body table entry should point to the new */ -/* head of the list. */ - -/* The only way to get here is from the block NEW SEGMENTS */ -/* after suspending that task. */ - - if (lnknfn_(stpool) == 0) { - -/* There's no room left in the segment pool. We must make */ -/* room before continuing. */ - - s_copy(doing, "ADD TO FRONT", (ftnlen)15, (ftnlen)12); - s_copy(urgent, "MAKE ROOM", (ftnlen)15, (ftnlen)9); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } else { - -/* Allocate a node and link it to the front of the list */ -/* for the current body. */ - - lnkan_(stpool, &new__); - sthan[(i__1 = new__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "pckbsr_", (ftnlen)2525)] = fthan[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "pckbsr_", (ftnlen)2525)]; - moved_(descr, &c__5, &stdes[(i__1 = new__ * 5 - 5) < 500 && 0 - <= i__1 ? i__1 : s_rnge("stdes", i__1, "pckbsr_", ( - ftnlen)2526)]); - dafgn_(stidnt + ((i__1 = new__ - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("stidnt", i__1, "pckbsr_", (ftnlen)2527)) * - 40, (ftnlen)40); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - -/* If the current list is empty, this append operation */ -/* is a no-op. */ - - lnkilb_(&new__, &btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2538) - ], stpool); - btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "pckbsr_", (ftnlen)2539)] = new__; - s_copy(status, "RESUME", (ftnlen)15, (ftnlen)6); - } - } else if (s_cmp(status, "ADD TO END", (ftnlen)15, (ftnlen)10) == 0) { - -/* The current segment information should be linked in at */ -/* the tail of the segment list for the current body. */ - -/* The only way to get to this task is from the OLD SEGMENTS */ -/* block after suspending that task. */ - - if (lnknfn_(stpool) == 0) { - -/* There's no room left in the segment pool. We must make */ -/* room before continuing. */ - - s_copy(doing, "ADD TO END", (ftnlen)15, (ftnlen)10); - s_copy(urgent, "MAKE ROOM", (ftnlen)15, (ftnlen)9); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } else { - -/* Allocate a new node in the segment table pool. */ - - lnkan_(stpool, &new__); - sthan[(i__1 = new__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "pckbsr_", (ftnlen)2570)] = fthan[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "pckbsr_", (ftnlen)2570)]; - moved_(descr, &c__5, &stdes[(i__1 = new__ * 5 - 5) < 500 && 0 - <= i__1 ? i__1 : s_rnge("stdes", i__1, "pckbsr_", ( - ftnlen)2571)]); - dafgn_(stidnt + ((i__1 = new__ - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("stidnt", i__1, "pckbsr_", (ftnlen)2572)) * - 40, (ftnlen)40); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - if (btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2579)] <= 0) - { - -/* This is the first node in the list for this body. */ - - btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2583)] = - new__; - } else { - -/* Link the new node to the tail of the list. */ - - tail = -lnkprv_(&btbeg[(i__1 = bindex - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("btbeg", i__1, "pckbsr_", ( - ftnlen)2589)], stpool); - lnkila_(&tail, &new__, stpool); - } - s_copy(status, "RESUME", (ftnlen)15, (ftnlen)6); - } - } else if (s_cmp(status, "SEARCH W/O BUFF", (ftnlen)15, (ftnlen)15) == - 0) { - -/* When the segment table is completely full, continue */ -/* the search by looking through the unchecked portion */ -/* of the segment list for the current body, and */ -/* then searching old, unchecked files without buffering */ -/* their segments. */ - -/* The only way to get here is from the MAKE ROOM state */ -/* via the block ADD TO END. If you get here there is no */ -/* free space in the segment table pool. */ - -/* At this point, we need to initialize the cost of */ -/* the re-use interval. */ - - btruex[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "pckbsr_", (ftnlen)2615)] = 0; - -/* Need to find the portion of the current body's segment */ -/* list which comes from the current file of interest. It */ -/* will be returned to the segment table pool, since the */ -/* remainder of the file's segments can't be added to the list. */ - - crflbg = btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2623)]; - fndhan = FALSE_; - while(! fndhan && crflbg > 0) { - fndhan = sthan[(i__1 = crflbg - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("sthan", i__1, "pckbsr_", (ftnlen)2628)] == - fthan[(i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "pckbsr_", (ftnlen)2628)]; - if (! fndhan) { - -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - crflbg = stpool[(i__1 = (crflbg << 1) + 10) < 212 && 0 <= - i__1 ? i__1 : s_rnge("stpool", i__1, "pckbsr_", ( - ftnlen)2635)]; - } - } - if (crflbg > 0) { - -/* The sub-list from the current node onwards is to be */ -/* returned to the segment table pool. Save this node, */ -/* since we'll finish searching the list before freeing */ -/* the sub-list. */ - - p = crflbg; - -/* It may be that the sub-list we're deleting is the */ -/* entire segment list for this body. If so, the */ -/* corresponding body table entry should be set to */ -/* a non-positive value to indicate an empty segment list. */ - - if (p == btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2656)]) { - btbeg[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "pckbsr_", (ftnlen)2658)] = - 0; - -/* Also in this case, we must initialize the re-use */ -/* interval for this body. */ - - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "pckbsr_", (ftnlen)2663)] = - dpmin_(); - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "pckbsr_", (ftnlen)2664)] = - dpmax_(); - } - -/* Finish searching through the incomplete list for the */ -/* desired segment. */ - - while(crflbg > 0) { - -/* Every segment seen from the current file contributes */ -/* to the expense of the re-use interval. */ - - btruex[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btruex", i__1, "pckbsr_", (ftnlen)2677)] = - btruex[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btruex", i__2, "pckbsr_", (ftnlen) - 2677)] + 1; - if (*et > stdes[(i__1 = crflbg * 5 - 4) < 500 && 0 <= - i__1 ? i__1 : s_rnge("stdes", i__1, "pckbsr_", ( - ftnlen)2680)]) { - -/* ET is to the right of the coverage interval of this */ -/* segment. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btlb", i__2, "pckbsr_", ( - ftnlen)2685)], d__2 = stdes[(i__3 = crflbg * - 5 - 4) < 500 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "pckbsr_", (ftnlen)2685)]; - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "pckbsr_", (ftnlen)2685)] - = max(d__1,d__2); - } else if (*et < stdes[(i__1 = crflbg * 5 - 5) < 500 && 0 - <= i__1 ? i__1 : s_rnge("stdes", i__1, "pckbsr_", - (ftnlen)2688)]) { - -/* ET is to the left of the coverage interval of this */ -/* segment. */ - -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btub", i__2, "pckbsr_", ( - ftnlen)2693)], d__2 = stdes[(i__3 = crflbg * - 5 - 5) < 500 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "pckbsr_", (ftnlen)2693)]; - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "pckbsr_", (ftnlen)2693)] - = min(d__1,d__2); - } else { - -/* The segment coverage interval includes ET. */ - - moved_(&stdes[(i__1 = crflbg * 5 - 5) < 500 && 0 <= - i__1 ? i__1 : s_rnge("stdes", i__1, "pckbsr_", - (ftnlen)2699)], &c__5, descr); - s_copy(ident, stidnt + ((i__1 = crflbg - 1) < 100 && - 0 <= i__1 ? i__1 : s_rnge("stidnt", i__1, - "pckbsr_", (ftnlen)2701)) * 40, ident_len, ( - ftnlen)40); - *handle = sthan[(i__1 = crflbg - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("sthan", i__1, "pckbsr_", - (ftnlen)2702)]; - *found = TRUE_; - -/* Set the re-use interval for the current body. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btlb", i__2, "pckbsr_", ( - ftnlen)2708)], d__2 = stdes[(i__3 = crflbg * - 5 - 5) < 500 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "pckbsr_", (ftnlen)2708)]; - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "pckbsr_", (ftnlen)2708)] - = max(d__1,d__2); -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btub", i__2, "pckbsr_", ( - ftnlen)2709)], d__2 = stdes[(i__3 = crflbg * - 5 - 4) < 500 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "pckbsr_", (ftnlen)2709)]; - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "pckbsr_", (ftnlen)2709)] - = min(d__1,d__2); - -/* Save the output items, in case this */ -/* segment may be satisfy the next request. */ - - btprvh[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btprvh", i__1, "pckbsr_", (ftnlen) - 2715)] = *handle; - s_copy(btprvi + ((i__1 = bindex - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("btprvi", i__1, "pckbsr_" - , (ftnlen)2716)) * 40, ident, (ftnlen)40, - ident_len); - moved_(descr, &c__5, &btprvd[(i__1 = bindex * 5 - 5) < - 100 && 0 <= i__1 ? i__1 : s_rnge("btprvd", - i__1, "pckbsr_", (ftnlen)2717)]); - btchkp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btchkp", i__1, "pckbsr_", (ftnlen) - 2718)] = TRUE_; - -/* Update the expense of the list to reflect */ -/* the cost of locating this segment. */ - - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btexp", i__1, "pckbsr_", (ftnlen)2724) - ] = btexp[(i__2 = bindex - 1) < 20 && 0 <= - i__2 ? i__2 : s_rnge("btexp", i__2, "pckbsr_", - (ftnlen)2724)] + btruex[(i__3 = bindex - 1) < - 20 && 0 <= i__3 ? i__3 : s_rnge("btruex", - i__3, "pckbsr_", (ftnlen)2724)]; - -/* Free the sub-list we were searching. */ - - tail = lnktl_(&crflbg, stpool); - lnkfsl_(&p, &tail, stpool); - chkout_("PCKSFS", (ftnlen)6); - return 0; - } -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - crflbg = stpool[(i__1 = (crflbg << 1) + 10) < 212 && 0 <= - i__1 ? i__1 : s_rnge("stpool", i__1, "pckbsr_", ( - ftnlen)2740)]; - } - -/* Return the sub-list to the segment table pool. */ -/* CRFLBG at this point is the negative of the list head. */ -/* The list tail is (by the spec of the SPICELIB doubly */ -/* linked list routines) the negative of the predecessor */ -/* of the head. */ - -/* Note the list is always non-empty. */ - - i__1 = -crflbg; - tail = -lnkprv_(&i__1, stpool); - lnkfsl_(&p, &tail, stpool); - } - -/* Search through the remaining files without buffering. */ -/* Recall that a search is already in progress and that a */ -/* segment is currently under consideration (FND = .TRUE.). */ - - while(findex > 0) { - while(fnd) { - -/* Each segment found contributes to the expense of the */ -/* re-use interval. */ - - btruex[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("btruex", i__1, "pckbsr_", (ftnlen)2771)] = - btruex[(i__2 = bindex - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("btruex", i__2, "pckbsr_", (ftnlen) - 2771)] + 1; - dafgs_(descr); - dafus_(descr, &c__2, &c__5, dcd, icd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - if (*body == icd[0]) { - -/* This is a segment for the body of interest. */ -/* Update the re-use interval for this body. */ - - if (*et > dcd[1]) { - -/* ET is to the right of the coverage interval */ -/* of this segment. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("btlb", i__2, "pckbsr_", ( - ftnlen)2791)]; - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("btlb", i__1, "pckbsr_", (ftnlen) - 2791)] = max(d__1,dcd[1]); - } else if (*et < dcd[0]) { - -/* ET is to the left of the coverage interval */ -/* of this segment. */ - -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("btub", i__2, "pckbsr_", ( - ftnlen)2799)]; - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("btub", i__1, "pckbsr_", (ftnlen) - 2799)] = min(d__1,dcd[0]); - } else { - -/* The segment coverage interval includes ET. */ - - dafgn_(ident, ident_len); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - *handle = fthan[(i__1 = findex - 1) < 1000 && 0 <= - i__1 ? i__1 : s_rnge("fthan", i__1, - "pckbsr_", (ftnlen)2812)]; - *found = TRUE_; - -/* Set the re-use interval for the current body. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("btlb", i__2, "pckbsr_", ( - ftnlen)2818)]; - btlb[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("btlb", i__1, "pckbsr_", (ftnlen) - 2818)] = max(d__1,dcd[0]); -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("btub", i__2, "pckbsr_", ( - ftnlen)2819)]; - btub[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("btub", i__1, "pckbsr_", (ftnlen) - 2819)] = min(d__1,dcd[1]); - -/* Save the output items, in case this */ -/* segment may satisfy the next request. */ - - btprvh[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("btprvh", i__1, "pckbsr_", ( - ftnlen)2825)] = *handle; - s_copy(btprvi + ((i__1 = bindex - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("btprvi", i__1, - "pckbsr_", (ftnlen)2826)) * 40, ident, ( - ftnlen)40, ident_len); - moved_(descr, &c__5, &btprvd[(i__1 = bindex * 5 - - 5) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "btprvd", i__1, "pckbsr_", (ftnlen)2827)]) - ; - btchkp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("btchkp", i__1, "pckbsr_", ( - ftnlen)2828)] = TRUE_; - -/* Update the expense of the list to reflect */ -/* the cost of locating this segment. */ - - btexp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("btexp", i__1, "pckbsr_", ( - ftnlen)2834)] = btexp[(i__2 = bindex - 1) - < 20 && 0 <= i__2 ? i__2 : s_rnge("btexp", - i__2, "pckbsr_", (ftnlen)2834)] + btruex[ - (i__3 = bindex - 1) < 20 && 0 <= i__3 ? - i__3 : s_rnge("btruex", i__3, "pckbsr_", ( - ftnlen)2834)]; - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - } - daffpa_(&fnd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - } - -/* Try the next oldest file. */ - - --findex; - if (findex > 0) { - dafbbs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("fthan", i__1, "pckbsr_", (ftnlen) - 2859)]); - daffpa_(&fnd); - if (failed_()) { - chkout_("PCKSFS", (ftnlen)6); - return 0; - } - } - } - -/* If you get to here, sorry. */ - - btruex[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "pckbsr_", (ftnlen)2874)] = 0; - s_copy(status, "HOPELESS", (ftnlen)15, (ftnlen)8); - -/* When a task is suspended, the current activity is placed on */ -/* a stack, to be restored later. Two levels are provided, since */ -/* some interrupts can be interrupted by others. */ - - } else if (s_cmp(status, "SUSPEND", (ftnlen)15, (ftnlen)7) == 0) { - ++top; - s_copy(stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "stack", i__1, "pckbsr_", (ftnlen)2885)) * 15, doing, ( - ftnlen)15, (ftnlen)15); - s_copy(status, urgent, (ftnlen)15, (ftnlen)15); - } else if (s_cmp(status, "RESUME", (ftnlen)15, (ftnlen)6) == 0) { - -/* Pop the status stack. */ - - s_copy(status, stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "pckbsr_", (ftnlen)2892)) * 15, ( - ftnlen)15, (ftnlen)15); - --top; - } - } - -/* If we didn't find a segment, don't attempt to use saved */ -/* outputs from a previous call. BINDEX will always be set */ -/* at this point. Also, zero out the expense of the re-use */ -/* interval. */ - - if (bindex > 0) { - btchkp[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btchkp", - i__1, "pckbsr_", (ftnlen)2907)] = FALSE_; - btruex[(i__1 = bindex - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("btruex", - i__1, "pckbsr_", (ftnlen)2908)] = 0; - } - chkout_("PCKSFS", (ftnlen)6); - return 0; -} /* pckbsr_ */ - -/* Subroutine */ int pckbsr_(char *fname, integer *handle, integer *body, - doublereal *et, doublereal *descr, char *ident, logical *found, - ftnlen fname_len, ftnlen ident_len) -{ - return pckbsr_0_(0, fname, handle, body, et, descr, ident, found, - fname_len, ident_len); - } - -/* Subroutine */ int pcklof_(char *fname, integer *handle, ftnlen fname_len) -{ - return pckbsr_0_(1, fname, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (char *)0, (logical *)0, fname_len, (ftnint)0); - } - -/* Subroutine */ int pckuof_(integer *handle) -{ - return pckbsr_0_(2, (char *)0, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (char *)0, (logical *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int pcksfs_(integer *body, doublereal *et, integer *handle, - doublereal *descr, char *ident, logical *found, ftnlen ident_len) -{ - return pckbsr_0_(3, (char *)0, handle, body, et, descr, ident, found, ( - ftnint)0, ident_len); - } - diff --git a/ext/spice/src/cspice/pckcls.c b/ext/spice/src/cspice/pckcls.c deleted file mode 100644 index 4e3afb044c..0000000000 --- a/ext/spice/src/cspice/pckcls.c +++ /dev/null @@ -1,203 +0,0 @@ -/* pckcls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PCKCLS ( PCK, Close file ) */ -/* Subroutine */ int pckcls_(integer *handle) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), dafcls_(integer *); - char access[5]; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Close an open PCK file. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the PCK file to be closed. */ - -/* $ Detailed_Input */ - -/* HANDLE The handle of the PCK file that is to be closed. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there are no segments in the file the error */ -/* SPICE(NOSEGMENTSFOUND) will be signalled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* Close the PCK file attached to HANDLE. */ - -/* $ Examples */ - -/* Suppose that you want to create a new PCK file called 'new.PCK' */ -/* that contains a single type 2 PCK segment and has room for at */ -/* least 5000 comment characters. The following code fragment should */ -/* take care of this for you, assuming that all of the variables */ -/* passed to the PCK type 2 segment writer have appropriate values. */ - -/* NAME = 'new.pck' */ -/* IFNAME = 'Test PCK file' */ - -/* CALL PCKOPN ( NAME, IFNAME, 5000, HANDLE ) */ -/* CALL PCKW02 ( HANDLE, BODY, FRAME, FIRST, LAST, */ -/* . SEGID, INTLEN, N, POLYDG, CDATA, */ -/* . BTIME ) */ -/* CALL PCKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 27-NOV-2001 (FST) */ - -/* Removed DAFHLU call; replaced ERRFN call with ERRHAN. */ - -/* - SPICELIB Version 1.0.0, 27-JAN-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* close a pck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local Variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("PCKCLS", (ftnlen)6); - -/* Get the access method for the file. Currently, if HANDLE < 0, the */ -/* access method is 'WRITE'. If HANDLE > 0, the access method is */ -/* 'READ'. In the future this should make use of the private entry */ -/* in the handle manager umbrella, ZZDDHNFO. */ - - if (*handle < 0) { - s_copy(access, "WRITE", (ftnlen)5, (ftnlen)5); - } else if (*handle > 0) { - s_copy(access, "READ", (ftnlen)5, (ftnlen)4); - } - -/* If the file is open for writing and there are segments in the file */ -/* fix the ID word and close the file, or just close the file. */ - - if (s_cmp(access, "WRITE", (ftnlen)5, (ftnlen)5) == 0) { - -/* Check to see if there are any segments in the file. If there */ -/* are no segments, we signal an error. This probably indicates a */ -/* programming error of some sort anyway. Why would you create a */ -/* file and put nothing in it? */ - - dafbfs_(handle); - daffna_(&found); - if (failed_()) { - chkout_("PCKCLS", (ftnlen)6); - return 0; - } - if (! found) { - setmsg_("No segments were found in the PCK file '#'. There must " - "be at least one segment in the file when this subroutine" - " is called.", (ftnlen)122); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(NOSEGMENTSFOUND)", (ftnlen)22); - chkout_("PCKCLS", (ftnlen)6); - return 0; - } - } - -/* Close the file. */ - - dafcls_(handle); - -/* No need to check FAILED() here, since we just return. The caller */ -/* should check it though. */ - - chkout_("PCKCLS", (ftnlen)6); - return 0; -} /* pckcls_ */ - diff --git a/ext/spice/src/cspice/pckcov.c b/ext/spice/src/cspice/pckcov.c deleted file mode 100644 index f2c4f829d2..0000000000 --- a/ext/spice/src/cspice/pckcov.c +++ /dev/null @@ -1,574 +0,0 @@ -/* pckcov.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure PCKCOV ( PCK coverage ) */ -/* Subroutine */ int pckcov_(char *pck, integer *idcode, doublereal *cover, - ftnlen pck_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[80]; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - logical found; - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), wninsd_(doublereal *, doublereal *, - doublereal *); - char kertyp[80]; - extern logical return_(void); - -/* $ Abstract */ - -/* Find the coverage window for a specified reference frame in a */ -/* specified binary PCK file. */ - -/* $ 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 */ - -/* CELLS */ -/* DAF */ -/* PCK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* ORIENTATION */ -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PCK I Name of PCK file. */ -/* IDCODE I Class ID code of PCK reference frame. */ -/* COVER I/O Window giving coverage in PCK for IDCODE. */ - -/* $ Detailed_Input */ - -/* PCK is the name of a binary PCK file. */ - -/* IDCODE is the integer frame class ID code of a PCK */ -/* reference frame for which data are expected to */ -/* exist in the specified PCK file. */ - -/* COVER is an initialized SPICELIB window data structure. */ -/* COVER optionally may contain coverage data on */ -/* input; on output, the data already present in */ -/* COVER will be combined with coverage found for the */ -/* reference frame designated by IDCODE in the file */ -/* PCK. */ - -/* If COVER contains no data on input, its size and */ -/* cardinality still must be initialized. */ - -/* $ Detailed_Output */ - -/* COVER is a SPICELIB window data structure which */ -/* represents the merged coverage for the reference */ -/* frame having frame class ID IDCODE. This is the */ -/* set of time intervals for which data for IDCODE */ -/* are present in the file PCK, merged with the set */ -/* of time intervals present in COVER on input. The */ -/* merged coverage is represented as the union of one */ -/* or more disjoint time intervals. The window COVER */ -/* contains the pairs of endpoints of these */ -/* intervals. */ - -/* The interval endpoints contained in COVER are */ -/* ephemeris times, expressed as seconds past J2000 */ -/* TDB. */ - -/* See the Examples section below for a complete */ -/* example program showing how to retrieve the */ -/* endpoints from COVER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file has transfer format, the error */ -/* SPICE(INVALIDFORMAT) is signaled. */ - -/* 2) If the input file is not a transfer file but has architecture */ -/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */ - -/* 3) If the input file is a binary DAF file of type other than */ -/* PCK, the error SPICE(BADFILETYPE) is signaled. */ - -/* 4) If the PCK file cannot be opened or read, the error will */ -/* be diagnosed by routines called by this routine. The output */ -/* window will not be modified. */ - -/* 5) If the size of the output window argument COVER is */ -/* insufficient to contain the actual number of intervals in the */ -/* coverage window for IDCODE, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* This routine reads a PCK file. */ - -/* $ Particulars */ - -/* This routine provides an API via which applications can determine */ -/* the coverage a specified PCK file provides for a specified */ -/* PCK class reference frame. */ - -/* $ Examples */ - -/* 1) This example demonstrates combined usage of PCKCOV and the */ -/* related PCK utility PCKOBJ. */ - -/* Display the coverage for each object in a specified PCK file. */ -/* Find the set of objects in the file; for each object, find */ -/* and display the coverage. */ - - -/* PROGRAM IDCOV */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ -/* INTEGER CARDI */ -/* C */ -/* C Local parameters */ -/* C */ -/* C */ -/* C Declare the coverage window. Make enough room */ -/* C for MAXIV intervals. */ -/* C */ -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXIV */ -/* PARAMETER ( MAXIV = 1000 ) */ - -/* INTEGER WINSIZ */ -/* PARAMETER ( WINSIZ = 2 * MAXIV ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER MAXFRM */ -/* PARAMETER ( MAXFRM = 1000 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) PCK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER I */ -/* INTEGER IDS ( LBCELL : MAXFRM ) */ -/* INTEGER J */ -/* INTEGER NIV */ - - -/* C */ -/* C Load a leapseconds kernel for output time conversion. */ -/* C PCKCOV itself does not require a leapseconds kernel. */ -/* C */ -/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */ -/* CALL FURNSH ( LSK ) */ - -/* C */ -/* C Get name of PCK file. */ -/* C */ -/* CALL PROMPT ( 'Name of PCK file > ', PCK ) */ - -/* C */ -/* C Initialize the set IDS. */ -/* C */ -/* CALL SSIZEI ( MAXFRM, IDS ) */ - -/* C */ -/* C Initialize the window COVER. */ -/* C */ -/* CALL SSIZED ( WINSIZ, COVER ) */ - -/* C */ -/* C Find the set of frames in the PCK file. */ -/* C */ -/* CALL PCKFRM ( PCK, IDS ) */ - -/* C */ -/* C We want to display the coverage for each frame. Loop */ -/* C over the contents of the ID code set, find the coverage */ -/* C for each item in the set, and display the coverage. */ -/* C */ -/* DO I = 1, CARDI( IDS ) */ -/* C */ -/* C Find the coverage window for the current frame. */ -/* C Empty the coverage window each time so */ -/* C we don't include data for the previous frame. */ -/* C */ -/* CALL SCARDD ( 0, COVER ) */ -/* CALL PCKCOV ( PCK, IDS(I), COVER ) */ - -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) '========================================' */ -/* WRITE (*,*) 'Coverage for reference frame ', IDS(I) */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO J = 1, NIV */ -/* C */ -/* C Get the endpoints of the Jth interval. */ -/* C */ -/* CALL WNFETD ( COVER, J, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', J */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* WRITE (*,*) '========================================' */ - -/* END DO */ - -/* END */ - - -/* 2) Find the coverage for the frame designated by IDCODE */ -/* provided by the set of PCK files loaded via a metakernel. */ -/* (The metakernel must also specify a leapseconds kernel.) */ - -/* PROGRAM METCOV */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* INTEGER MAXCOV */ -/* PARAMETER ( MAXCOV = 100000 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) FILE */ -/* CHARACTER*(LNSIZE) IDCH */ -/* CHARACTER*(FILSIZ) META */ -/* CHARACTER*(FILSIZ) SOURCE */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(LNSIZE) TYPE */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER COUNT */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER IDCODE */ -/* INTEGER NIV */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Prompt for the metakernel name; load the metakernel. */ -/* C The metakernel lists the PCK files whose coverage */ -/* C for IDCODE we'd like to determine. The metakernel */ -/* C must also specify a leapseconds kernel. */ -/* C */ -/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */ - -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Get the ID code of interest. */ -/* C */ -/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */ - -/* CALL PRSINT ( IDCH, IDCODE ) */ - -/* C */ -/* C Initialize the coverage window. */ -/* C */ -/* CALL SSIZED ( MAXCOV, COVER ) */ - -/* C */ -/* C Find out how many kernels are loaded. Loop over the */ -/* C kernels: for each loaded PCK file, add its coverage */ -/* C for IDCODE, if any, to the coverage window. */ -/* C */ -/* CALL KTOTAL ( 'PCK', COUNT ) */ - -/* DO I = 1, COUNT */ - -/* CALL KDATA ( I, 'PCK', FILE, TYPE, */ -/* . SOURCE, HANDLE, FOUND ) */ - -/* CALL PCKCOV ( FILE, IDCODE, COVER ) */ - -/* END DO */ - -/* C */ -/* C Display results. */ -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Coverage for frame ', IDCODE */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO I = 1, NIV */ -/* C */ -/* C Get the endpoints of the Ith interval. */ -/* C */ -/* CALL WNFETD ( COVER, I, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', I */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) If an error occurs while this routine is updating the window */ -/* COVER, the window may be corrupted. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-NOV-2007 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get coverage window for binary pck reference frame */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("PCKCOV", (ftnlen)6); - -/* See whether GETFAT thinks we've got a binary PCK file. */ -/* If not, indicate the specific problem. */ - - getfat_(pck, arch, kertyp, pck_len, (ftnlen)80, (ftnlen)80); - if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "PCK file to be readable by this routine. If the input file " - "is an PCK file in transfer format, run TOBIN on the file to " - "convert it to binary format.", (ftnlen)207); - errch_("#", pck, (ftnlen)1, pck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("PCKCOV", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "PCK file to be readable by this routine. Binary PCK files h" - "ave DAF architecture. If you expected the file to be a bina" - "ry PCK file, the problem may be due to the file being an old" - " non-native file lacking binary file format information. It'" - "s also possible the file has been corrupted.", (ftnlen)343); - errch_("#", pck, (ftnlen)1, pck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22); - chkout_("PCKCOV", (ftnlen)6); - return 0; - } else if (s_cmp(kertyp, "PCK", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has file type #. The file must be a binary PCK" - " file to be readable by this routine. If you expected the fi" - "le to be a binary PCK file, the problem may be due to the fi" - "le being an old non-native file lacking binary file format i" - "nformation. It's also possible the file has been corrupted.", - (ftnlen)298); - errch_("#", pck, (ftnlen)1, pck_len); - errch_("#", kertyp, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22); - chkout_("PCKCOV", (ftnlen)6); - return 0; - } - -/* Open the file for reading. */ - - dafopr_(pck, &handle, pck_len); - if (failed_()) { - chkout_("PCKCOV", (ftnlen)6); - return 0; - } - -/* We will examine each segment descriptor in the file, and */ -/* we'll update our coverage bounds according to the data found */ -/* in these descriptors. */ - -/* Start a forward search. */ - - dafbfs_(&handle); - -/* Find the next DAF array. */ - - daffna_(&found); - while(found && ! failed_()) { - -/* Fetch and unpack the segment descriptor. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dc, ic); - if (ic[0] == *idcode) { - -/* This segment is for the body of interest. Insert the */ -/* coverage bounds into the coverage window. */ - - wninsd_(dc, &dc[1], cover); - } - daffna_(&found); - } - -/* Release the file. */ - - dafcls_(&handle); - chkout_("PCKCOV", (ftnlen)6); - return 0; -} /* pckcov_ */ - diff --git a/ext/spice/src/cspice/pckcov_c.c b/ext/spice/src/cspice/pckcov_c.c deleted file mode 100644 index 74565c5298..0000000000 --- a/ext/spice/src/cspice/pckcov_c.c +++ /dev/null @@ -1,473 +0,0 @@ -/* - --Procedure pckcov_c ( PCK coverage ) - --Abstract - - Find the coverage window for a specified reference frame in a - specified binary PCK file. - --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 - - CELLS - DAF - PCK - TIME - WINDOWS - --Keywords - - ORIENTATION - TIME - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void pckcov_c ( ConstSpiceChar * pck, - SpiceInt idcode, - SpiceCell * cover ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - pck I Name of PCK file. - idcode I Class ID code of PCK reference frame. - cover I/O Window giving coverage in `pck' for `idcode'. - --Detailed_Input - - pck is the name of a binary PCK file. - - idcode is the integer frame class ID code of a PCK reference - frame for which data are expected to exist in the - specified PCK file. - - cover is an initialized CSPICE window data structure. - `cover' optionally may contain coverage data on - input; on output, the data already present in `cover' - will be combined with coverage found for the - reference frame designated by `idcode' in the file - `pck'. - - If `cover' contains no data on input, its size and - cardinality still must be initialized. - --Detailed_Output - - cover is a CSPICE window data structure which represents - the merged coverage for the reference frame having - frame class ID `idcode'. This is the set of time - intervals for which data for `idcode' are present in - the file `pck', merged with the set of time intervals - present in `cover' on input. The merged coverage is - represented as the union of one or more disjoint time - intervals. The window `cover' contains the pairs of - endpoints of these intervals. - - The interval endpoints contained in `cover' are - ephemeris times, expressed as seconds past J2000 - TDB. - - See the Examples section below for a complete - example program showing how to retrieve the - endpoints from `cover'. - --Parameters - - None. - --Exceptions - - 1) If the input file has transfer format, the error - SPICE(INVALIDFORMAT) is signaled. - - 2) If the input file is not a transfer file but has architecture - other than DAF, the error SPICE(BADARCHTYPE) is signaled. - - 3) If the input file is a binary DAF file of type other than - PCK, the error SPICE(BADFILETYPE) is signaled. - - 4) If the PCK file cannot be opened or read, the error will - be diagnosed by routines called by this routine. The output - window will not be modified. - - 5) If the size of the output window argument COVER is - insufficient to contain the actual number of intervals in the - coverage window for IDCODE, the error will be diagnosed by - routines called by this routine. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input - string `pck' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `pck' is null. - --Files - - This routine reads a PCK file. - --Particulars - - This routine provides an API via which applications can determine - the coverage a specified PCK file provides for a specified - PCK class reference frame. - --Examples - - 1) This example demonstrates combined usage of pckcov_c and the - related PCK utility pckfrm_c. - - Display the coverage for each object in a specified PCK file. - Find the set of objects in the file; for each object, find - and display the coverage. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local parameters - ./ - #define FILSIZ 256 - #define MAXIV 1000 - #define WINSIZ ( 2 * MAXIV ) - #define TIMLEN 51 - #define MAXOBJ 1000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - SPICEINT_CELL ( ids, MAXOBJ ); - - SpiceChar lsk [ FILSIZ ]; - SpiceChar pck [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt i; - SpiceInt j; - SpiceInt niv; - SpiceInt obj; - - - /. - Load a leapseconds kernel for output time conversion. - PCKCOV itself does not require a leapseconds kernel. - ./ - prompt_c ( "Name of leapseconds kernel > ", FILSIZ, lsk ); - furnsh_c ( lsk ); - - /. - Get name of PCK file. - ./ - prompt_c ( "Name of PCK file > ", FILSIZ, pck ); - - /. - Find the set of frames in the PCK file. - ./ - pckfrm_c ( pck, &ids ); - - /. - We want to display the coverage for each frame. Loop over - the contents of the ID code set, find the coverage for - each item in the set, and display the coverage. - ./ - for ( i = 0; i < card_c( &ids ); i++ ) - { - /. - Find the coverage window for the current frame. - Empty the coverage window each time so we don't - include data for the previous frame. - ./ - obj = SPICE_CELL_ELEM_I( &ids, i ); - - scard_c ( 0, &cover ); - pckcov_c ( pck, obj, &cover ); - - /. - Get the number of intervals in the coverage window. - ./ - niv = wncard_c ( &cover ); - - /. - Display a simple banner. - ./ - printf ( "%s\n", "========================================" ); - - printf ( "Coverage for frame %ld\n", obj ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( j = 0; j < niv; j++ ) - { - /. - Get the endpoints of the jth interval. - ./ - wnfetd_c ( &cover, j, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - j, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - - } - return ( 0 ); - } - - - 2) Find the coverage for the frame designated by `idcode' - provided by the set of PCK files loaded via a metakernel. - (The metakernel must also specify a leapseconds kernel.) - - #include - #include "SpiceUsr.h" - - int main() - { - - /. - Local parameters - ./ - #define FILSIZ 256 - #define LNSIZE 81 - #define MAXCOV 100000 - #define WINSIZ ( 2 * MAXCOV ) - #define TIMLEN 51 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - - SpiceBoolean found; - - SpiceChar file [ FILSIZ ]; - SpiceChar idch [ LNSIZE ]; - SpiceChar meta [ FILSIZ ]; - SpiceChar source [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - SpiceChar type [ LNSIZE ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt count; - SpiceInt handle; - SpiceInt i; - SpiceInt idcode; - SpiceInt niv; - - - /. - Prompt for the metakernel name; load the metakernel. - The metakernel lists the PCK files whose coverage - for `idcode' we'd like to determine. The metakernel - must also specify a leapseconds kernel. - ./ - prompt_c ( "Name of metakernel > ", FILSIZ, meta ); - furnsh_c ( meta ); - - /. - Get the ID code of interest. - ./ - prompt_c ( "Enter ID code > ", LNSIZE, idch ); - prsint_c ( idch, &idcode ); - - /. - Find out how many kernels are loaded. Loop over the - kernels: for each loaded PCK file, add its coverage - for `idcode', if any, to the coverage window. - ./ - ktotal_c ( "PCK", &count ); - - for ( i = 0; i < count; i++ ) - { - kdata_c ( i, "PCK", FILSIZ, LNSIZE, FILSIZ, - file, type, source, &handle, &found ); - - pckcov_c ( file, idcode, &cover ); - } - - /. - Display results. - - Get the number of intervals in the coverage window. - ./ - niv = wncard_c ( &cover ); - - /. - Display a simple banner. - ./ - printf ( "\nCoverage for frame %ld\n", idcode ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( i = 0; i < niv; i++ ) - { - /. - Get the endpoints of the ith interval. - ./ - wnfetd_c ( &cover, i, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - i, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - return ( 0 ); - } - - - --Restrictions - - 1) If an error occurs while this routine is updating the window - `cover', the window may be corrupted. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 30-NOV-2007 (NJB) - --Index_Entries - - get coverage window for binary pck reference frame - --& -*/ - -{ /* Begin pckcov_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "pckcov_c" ); - - - /* - Check the input string `pck' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pckcov_c", pck ); - - /* - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "pckcov_c", SPICE_DP, cover ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cover ); - - /* - Call the f2c'd Fortran routine. - */ - pckcov_ ( ( char * ) pck, - ( integer * ) &idcode, - ( doublereal * ) (cover->base), - ( ftnlen ) strlen(pck) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, cover ); - } - - - chkout_c ( "pckcov_c" ); - -} /* End pckcov_c */ - diff --git a/ext/spice/src/cspice/pcke02.c b/ext/spice/src/cspice/pcke02.c deleted file mode 100644 index cc60779d49..0000000000 --- a/ext/spice/src/cspice/pcke02.c +++ /dev/null @@ -1,219 +0,0 @@ -/* pcke02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PCKE02 ( Get Euler angles at time from PCK file ) */ -/* Subroutine */ int pcke02_(doublereal *et, doublereal *record, doublereal * - eulang) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double d_mod(doublereal *, doublereal *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), spke02_(doublereal *, - doublereal *, doublereal *); - extern doublereal twopi_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Evaluate a single PCK data record from a segment of type 2 */ -/* (Chebyshev Polynomials, position only). */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* TRANSFORMATION */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch. */ -/* RECORD I Data record. */ -/* EULANG O Euler angles and their derivatives. */ - -/* $ Detailed_Input */ - -/* ET is an epoch, at which the Euler angles are to */ -/* be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the Euler angles of some body. */ - -/* $ Detailed_Output */ - -/* EULANG the Euler angles and their derivatives at */ -/* time ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 2 (Chebyshev polynomials, */ -/* position only) segments are described in the PCK Required Reading */ -/* file. */ - -/* A type 2 segment contains three sets of Chebyshev coefficients, */ -/* one set each for the Euler angles phi, delta and psi. PCKE02 */ -/* calls the routine SPKE02 for each set to evalute the polynomial */ -/* AND its first derivative. */ - -/* $ Examples */ - -/* The PCKEnn routines are almost always used in conjunction with */ -/* the corresponding PCKRnn routines, which read the records from */ -/* binary PCK files. */ - -/* The data returned by the PCKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the PCKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the PCKEnn routines. */ - - -/* Here we load a binary PCK files and use PCKE02 to get the */ -/* Euler angles. */ - -/* C */ -/* C Load binary PCK file. */ -/* C */ -/* CALL PCKLOF ('example.pck', HANDLE) */ - - -/* C Get a segment applicable to a specified body and epoch. */ - -/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - - -/* Look at parts of the descriptor. */ - -/* CALL DAFUS ( DESCR, ND, NI, DCD, ICD ) */ -/* TYPE = ICD( NT ) */ -/* REF = ICD( NR ) */ - -/* IF ( TYPE .EQ. 2 ) THEN */ - -/* Read in Chebyshev coefficients from segment. */ - -/* CALL PCKR02 ( HANDLE, DESCR, ET, RECORD ) */ - - -/* Call evaluation routine to get Euler angles */ -/* phi, delta, w. */ - -/* CALL PCKE02 ( ET, RECORD, EULANG ) */ - - -/* The Euler angles and their derivatives are returned */ -/* in EULANG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K. S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 13-MAR-1995 (KSZ) */ - -/* Added error handling. */ - -/* - SPICELIB Version 1.0.0, 30-SEP-1994 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* get Euler angles and their derivatives */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 13-MAR-1995 (KSZ) */ - -/* Added error handling. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKE02", (ftnlen)6); - } - -/* Call evaluation routine to get Euler angles */ -/* phi, delta, w. */ - - spke02_(et, record, eulang); - -/* Mod the 3rd element of the state by TWOPI. */ -/* We do this because we've always done this. */ - - d__1 = twopi_(); - eulang[2] = d_mod(&eulang[2], &d__1); - chkout_("PCKE02", (ftnlen)6); - return 0; -} /* pcke02_ */ - diff --git a/ext/spice/src/cspice/pcke03.c b/ext/spice/src/cspice/pcke03.c deleted file mode 100644 index 91cc1640dd..0000000000 --- a/ext/spice/src/cspice/pcke03.c +++ /dev/null @@ -1,408 +0,0 @@ -/* pcke03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure PCKE03 ( PCK, evaluate type 03 ) */ -/* Subroutine */ int pcke03_(doublereal *et, doublereal *record, doublereal * - rotmat) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal - *, integer *, integer *, integer *, doublereal *); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), vcrss_(doublereal *, - doublereal *, doublereal *); - integer degree; - extern /* Subroutine */ int chbval_(doublereal *, integer *, doublereal *, - doublereal *, doublereal *); - integer ncoeff; - extern doublereal halfpi_(void); - integer cofloc; - doublereal eulang[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal drotdt[9] /* was [3][3] */; - extern logical return_(void); - doublereal mav[3]; - extern doublereal rpd_(void); - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* Evaluate a single PCK data record from a segment of type 03 */ -/* (Variable width Chebyshev Polynomials for RA, DEC, and W) to */ -/* obtain a state transformation matrix. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch state transformation. */ -/* RECORD I Data record valid for epoch ET. */ -/* ROTMAT O State transformation matrix at epoch ET. */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, at which a state transformation */ -/* matrix is to be calculated. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give RA, DEC, and W and angular velocity */ -/* for a body. The RA, DEC and W are relative to */ -/* some inertial frame. The angular velocity is */ -/* expressed relative to the body fixed coordinate frame. */ - -/* $ Detailed_Output */ - -/* ROTMAT is the state transformation matrix at epoch ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 03 PCK segments are */ -/* described in the PCK Required Reading file. */ - -/* A type 03 segment contains six sets of Chebyshev coefficients, */ -/* one set each for RA, DEC, and W and one set each for the */ -/* components of the angular velocity of the body. The coefficients */ -/* for RA, DEC, and W are relative to some inertial reference */ -/* frame. The coefficients for the components of angular velocity */ -/* are relative to the body fixed frame and must be transformed */ -/* via the position transformation corresponding to RA, DEC and W. */ - -/* PCKE03 calls the routine CHBVAL to evalute each polynomial, */ -/* to obtain a complete set of values. These values are then */ -/* used to determine a state transformation matrix that will */ -/* rotate an inertially referenced state into the bodyfixed */ -/* coordinate system. */ - -/* $ Examples */ - -/* The PCKEnn routines are almost always used in conjunction with */ -/* the corresponding PCKRnn routines, which read the records from */ -/* binary PCK files. */ - -/* The data returned by the PCKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the PCKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the PCKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* TYPE = ICD( 3 ) */ - -/* IF ( TYPE .EQ. 03 ) THEN */ - -/* CALL PCKR03 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL PCKE03 ( ET, RECORD, ROTMAT ) */ -/* . */ -/* . Apply the rotation and check out the state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 6-OCT-1995 (WLT) */ - -/* Brian Carcich at Cornell discovered that the Euler */ -/* angles were being re-arranged unnecessarily. As a */ -/* result the state transformation matrix computed was */ -/* not the one we expected. (The re-arrangement was */ -/* a left-over from implementation 1.0.0. This problem */ -/* has now been corrected. */ - -/* - SPICELIB Version 2.0.0, 28-JUL-1995 (WLT) */ - -/* Version 1.0.0 was written under the assumption that */ -/* RA, DEC, W and dRA/dt, dDEC/dt and dW/dt were supplied */ -/* in the input RECORD. This version repairs the */ -/* previous misinterpretation. */ - -/* - SPICELIB Version 1.0.0, 14-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_03 pck segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 6-OCT-1995 (WLT) */ - -/* Brian Carcich at Cornell discovered that the Euler */ -/* angles were being re-arranged unnecessarily. As a */ -/* result the state transformation matrix computed was */ -/* not the one we expected. (The re-arrangement was */ -/* a left-over from implementation 1.0.0. This problem */ -/* has now been corrected. */ - -/* - SPICELIB Version 2.0.0, 28-JUL-1995 (WLT) */ - -/* Version 1.0.0 was written under the assumption that */ -/* RA, DEC, W and dRA/dt, dDEC/dt and dW/dt were supplied */ -/* in the input RECORD. This version repairs the */ -/* previous misinterpretation. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKE03", (ftnlen)6); - } - -/* The first number in the record is the number of Chebyshev */ -/* Polynomial coefficients used to represent each component of the */ -/* state vector. Following it are two numbers that will be used */ -/* later, then the six sets of coefficients. */ - - ncoeff = (integer) record[0]; - -/* The degree of each polynomial is one less than the number of */ -/* coefficients. */ - - degree = ncoeff - 1; - -/* Call CHBVAL once for each quantity to obtain RA, DEC, and W values */ -/* as well as values for the angular velocity. */ - -/* Note that we stick the angular velocity in the components 4 thru 6 */ -/* of the array EULANG even though they are not derivatives of */ -/* components 1 thru 3. It's just simpler to do it this way. */ - -/* Editorial Comment: */ - -/* Unlike every other SPICE routine, the units for the type 03 */ -/* PCK segment are degrees. This inconsistency exists solely */ -/* to support the NEAR project and the intransigence of one of the */ -/* participants of that project. */ - -/* It's a bad design and we know it. */ - -/* ---W.L. Taber */ - - - for (i__ = 1; i__ <= 6; ++i__) { - -/* The coefficients for each variable are located contiguously, */ -/* following the first three words in the record. */ - - cofloc = ncoeff * (i__ - 1) + 4; - -/* CHBVAL needs as input the coefficients, the degree of the */ -/* polynomial, the epoch, and also two variable transformation */ -/* parameters, which are located, in our case, in the second and */ -/* third slots of the record. */ - - chbval_(&record[cofloc - 1], °ree, &record[1], et, &eulang[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, - "pcke03_", (ftnlen)278)]); - -/* Convert to radians. */ - - eulang[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("eulang", - i__1, "pcke03_", (ftnlen)283)] = rpd_() * eulang[(i__2 = i__ - - 1) < 6 && 0 <= i__2 ? i__2 : s_rnge("eulang", i__2, "pcke0" - "3_", (ftnlen)283)]; - } - -/* EULANG(1) is RA make it PHI */ -/* EULANG(2) is DEC make it DELTA */ -/* EULANG(3) is W */ - - eulang[0] = halfpi_() + eulang[0]; - eulang[1] = halfpi_() - eulang[1]; - -/* Before we obtain the state transformation matrix, we need to */ -/* compute the rotation components of the transformation.. */ -/* The rotation we want to perform is: */ - -/* [W] [DELTA] [PHI] */ -/* 3 1 3 */ - -/* The array of Euler angles is now: */ - -/* EULANG(1) = PHI */ -/* EULANG(2) = DELTA */ -/* EULANG(3) = W */ -/* EULANG(4) = AV_1 (bodyfixed) */ -/* EULANG(5) = AV_2 (bodyfixed) */ -/* EULANG(6) = AV_3 (bodyfixed) */ - - -/* Compute the rotation associated with the Euler angles. */ - - eul2m_(&eulang[2], &eulang[1], eulang, &c__3, &c__1, &c__3, rot); - -/* This rotation transforms positions relative to the inertial */ -/* frame to positions relative to the bodyfixed frame. */ - -/* We next need to get dROT/dt. */ - -/* For this discussion let P be the bodyfixed coordinates of */ -/* a point that is fixed with respect to the bodyfixed frame. */ - -/* The velocity of P with respect to the inertial frame is */ -/* given by */ -/* t t */ -/* V = ROT ( AV ) x ROT ( P ) */ - -/* t */ -/* dROT */ -/* = ---- ( P ) */ -/* dt */ - -/* But */ -/* t t t */ -/* ROT ( AV ) x ROT ( P ) = ROT ( AV x P ) */ - -/* Let OMEGA be the cross product matrix corresponding to AV. */ -/* Then */ -/* t t */ -/* ROT ( AV x P ) = ROT * OMEGA * P */ - -/* where * denotes matrix multiplication. */ - -/* From these observations it follows that */ - -/* t */ -/* t dROT */ -/* ROT * OMEGA * P = ---- * P */ -/* dt */ - -/* Consequently, it follows that */ - -/* dROT t */ -/* ---- = OMEGA * ROT */ -/* dt */ - -/* = -OMEGA * ROT */ - -/* We compute dROT/dt now. Note that we can get the columns */ -/* of -OMEGA*ROT by computing the cross products -AV x COL */ -/* for each column COL of ROT. */ - - mav[0] = -eulang[3]; - mav[1] = -eulang[4]; - mav[2] = -eulang[5]; - vcrss_(mav, rot, drotdt); - vcrss_(mav, &rot[3], &drotdt[3]); - vcrss_(mav, &rot[6], &drotdt[6]); - -/* Now we simply fill in the blanks. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotmat[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : s_rnge( - "rotmat", i__1, "pcke03_", (ftnlen)378)] = rot[(i__2 = - i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("rot", - i__2, "pcke03_", (ftnlen)378)]; - rotmat[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("rotmat", i__1, "pcke03_", (ftnlen)379)] = drotdt[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge( - "drotdt", i__2, "pcke03_", (ftnlen)379)]; - rotmat[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("rotmat", i__1, "pcke03_", (ftnlen)380)] = 0.; - rotmat[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("rotmat", i__1, "pcke03_", (ftnlen)381)] = - rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "pcke03_", (ftnlen)381)]; - } - } - chkout_("PCKE03", (ftnlen)6); - return 0; -} /* pcke03_ */ - diff --git a/ext/spice/src/cspice/pckeul.c b/ext/spice/src/cspice/pckeul.c deleted file mode 100644 index cca170761a..0000000000 --- a/ext/spice/src/cspice/pckeul.c +++ /dev/null @@ -1,254 +0,0 @@ -/* pckeul.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__5 = 5; - -/* $Procedure PCKEUL ( Get Euler angles at time from PCK file ) */ -/* Subroutine */ int pckeul_(integer *body, doublereal *et, logical *found, - char *ref, doublereal *eulang, ftnlen ref_len) -{ - integer iref, type__; - extern /* Subroutine */ int pcke02_(doublereal *, doublereal *, - doublereal *), chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int pckr02_(integer *, doublereal *, doublereal *, - doublereal *), dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - char ident[40]; - integer handle; - extern /* Subroutine */ int irfnam_(integer *, char *, ftnlen); - doublereal record[130]; - extern /* Subroutine */ int pcksfs_(integer *, doublereal *, integer *, - doublereal *, char *, logical *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[5]; - -/* $ Abstract */ - -/* This routine is obsolete. It supports only the type 02 binary */ -/* PCK format. It is maintained only for backward compatibility */ - -/* Return Euler angles and their derivatives and their reference */ -/* frame, given an input time and body and reference frame from */ -/* a PCK binary file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* ROTATION */ -/* TIME */ -/* PCK */ - -/* $ Keywords */ - -/* TRANSFORMATION */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of body */ -/* ET I Epoch of transformation */ -/* FOUND O True if ET, BODY found in a PCK file */ -/* REF O Name of inertial ref. frame of state */ -/* EULANG O Euler angles and their derivatives. */ - -/* $ Detailed_Input */ - -/* BODY is the integer ID code of the body for which the */ -/* state transformation matrix is requested. Bodies */ -/* are numbered according to the standard NAIF */ -/* numbering scheme. The numbering scheme is */ -/* explained in the NAIF_IDS required reading file. */ - -/* ET is the epoch at which the state transformation */ -/* matrix is requested. */ - -/* $ Detailed_Output */ - -/* FOUND if the Euler angles for the requested time */ -/* and body are found in a PCK binary file, */ -/* FOUND is true. Otherwise, it's false. */ - -/* REF is the name of an inertial ref. frame. */ -/* (See the routine CHGIRF for a full list of names.) */ - -/* EULANG the Euler angles and their derivatives at */ -/* time ET. The rotation matrix is */ -/* [ EULANG(3) ] [EULANG(2)] [EULANG(1)] */ -/* 3 1 3 */ - -/* and dEULANG(1)/dt = EULANG(4) */ -/* dEULANG(2)/dt = EULANG(5) */ -/* dEULANG(3)/dt = EULANG(6) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Here we load a binary PCK files and use PCKEUL to get the */ -/* Euler angles. */ - -/* C */ -/* C Load binary PCK file. */ -/* C */ -/* CALL PCKLOF ('example.pck', HANDLE) */ - -/* C Call routine to get Euler angles phi, delta, w. */ - -/* CALL PCKEUL ( BODY, ET, FOUND, REF, EULANG ) */ - -/* The Euler angles and their derivatives are returned */ -/* in EULANG. */ - -/* $ Restrictions */ - -/* A binary PCK kernel must be loaded with PCKLOF before */ -/* calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K. S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 21-MAR-1995 (KSZ) */ - -/* PCKEUL modified to check in. PCKMAT takes */ -/* over for PCKEUL in many cases. REF now a character. */ - -/* - SPICELIB Version 1.1.0, 18-OCT-1994 (KSZ) */ - -/* Fixed bug which incorrecly modded DW by two pi. */ - -/* - SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* get Euler angles and their derivatives */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 21-MAR-1995 (KSZ) */ - -/* PCKEUL modified to check in. PCKMAT takes */ -/* over for PCKEUL in many cases. REF now a character. */ - -/* - SPICELIB Version 1.1.0, 18-OCT-1994 (KSZ) */ - -/* Fixed bug which incorrecly modded DW by two pi. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - -/* ND number of double precision components of descriptor */ -/* NI number of integer components of descriptor */ -/* NR component number of reference frame in integer */ -/* portion of descriptor */ -/* NS size of a packed PCK segment descriptor */ -/* NT component number of data type in integer portion */ -/* of descriptor */ - - -/* Local Variables */ - - -/* Standard SPICE Error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKEUL", (ftnlen)6); - } - -/* Get a segment applicable to a specified body and epoch. */ - - pcksfs_(body, et, &handle, descr, ident, found, (ftnlen)40); - if (*found) { - -/* Look at parts of the descriptor. */ - - dafus_(descr, &c__2, &c__5, dcd, icd); - type__ = icd[2]; - iref = icd[1]; - irfnam_(&iref, ref, ref_len); - if (type__ == 2) { - -/* Read in Chebyshev coefficients from segment. */ - - pckr02_(&handle, descr, et, record); - -/* Call evaluation routine to get Euler angles */ -/* phi, delta, w. */ - - pcke02_(et, record, eulang); - } else { - -/* If appropriate data was not found, found is false. */ - - *found = FALSE_; - } - } - chkout_("PCKEUL", (ftnlen)6); - return 0; -} /* pckeul_ */ - diff --git a/ext/spice/src/cspice/pckfrm.c b/ext/spice/src/cspice/pckfrm.c deleted file mode 100644 index 66cf72bcff..0000000000 --- a/ext/spice/src/cspice/pckfrm.c +++ /dev/null @@ -1,415 +0,0 @@ -/* pckfrm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure PCKFRM ( PCK reference frame class ID set ) */ -/* Subroutine */ int pckfrm_(char *pck, integer *ids, ftnlen pck_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[80]; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - logical found; - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), insrti_(integer *, integer *); - char kertyp[80]; - extern logical return_(void); - -/* $ Abstract */ - -/* Find the set of reference frame class ID codes of all frames */ -/* in a specified binary PCK file. */ - -/* $ 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 */ - -/* CELLS */ -/* DAF */ -/* SETS */ -/* PCK */ - -/* $ Keywords */ - -/* ORIENTATION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PCK I Name of PCK file. */ -/* IDS I/O Set of frame class ID codes of frames in PCK file. */ - -/* $ Detailed_Input */ - -/* PCK is the name of a binary PCK file. */ - -/* IDS is an initialized SPICELIB set data structure. IDS */ -/* optionally may contain a set of ID codes on input; */ -/* on output, the data already present in IDS will be */ -/* combined with ID code set found for the file PCK. */ - -/* If IDS contains no data on input, its size and */ -/* cardinality still must be initialized. */ - -/* $ Detailed_Output */ - -/* IDS is a SPICELIB set data structure which contains */ -/* the union of its contents upon input with the set */ -/* of reference frame class ID codes of each frame */ -/* for which data are present in the indicated PCK */ -/* file. The elements of SPICELIB sets are unique; */ -/* hence each ID code in IDS appears only once, even */ -/* if the PCK file contains multiple segments for */ -/* that ID code. */ - -/* See the Examples section below for a complete */ -/* example program showing how to retrieve the ID */ -/* codes from IDS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file has transfer format, the error */ -/* SPICE(INVALIDFORMAT) is signaled. */ - -/* 2) If the input file is not a transfer file but has architecture */ -/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */ - -/* 3) If the input file is a binary DAF file of type other than */ -/* PCK, the error SPICE(BADFILETYPE) is signaled. */ - -/* 4) If the PCK file cannot be opened or read, the error will */ -/* be diagnosed by routines called by this routine. */ - -/* 5) If the size of the output set argument IDS is insufficient to */ -/* contain the actual number of ID codes of frames covered by */ -/* the indicated PCK file, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides an API via which applications can determine */ -/* the set of reference frames for which there are data in a */ -/* specified PCK file. */ - -/* $ Examples */ - -/* 1) Display the coverage for each frame in a specified PCK file. */ -/* Find the set of frames in the file. Loop over the contents */ -/* of the ID code set: find the coverage for each item in the */ -/* set and display the coverage. */ - - -/* PROGRAM IDCOV */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ -/* INTEGER CARDI */ -/* C */ -/* C Local parameters */ -/* C */ -/* C */ -/* C Declare the coverage window. Make enough room */ -/* C for MAXIV intervals. */ -/* C */ -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXIV */ -/* PARAMETER ( MAXIV = 1000 ) */ - -/* INTEGER WINSIZ */ -/* PARAMETER ( WINSIZ = 2 * MAXIV ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER MAXFRM */ -/* PARAMETER ( MAXFRM = 1000 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) PCK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER I */ -/* INTEGER IDS ( LBCELL : MAXFRM ) */ -/* INTEGER J */ -/* INTEGER NIV */ - - -/* C */ -/* C Load a leapseconds kernel for output time conversion. */ -/* C PCKCOV itself does not require a leapseconds kernel. */ -/* C */ -/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */ -/* CALL FURNSH ( LSK ) */ - -/* C */ -/* C Get name of PCK file. */ -/* C */ -/* CALL PROMPT ( 'Name of PCK file > ', PCK ) */ - -/* C */ -/* C Initialize the set IDS. */ -/* C */ -/* CALL SSIZEI ( MAXFRM, IDS ) */ - -/* C */ -/* C Initialize the window COVER. */ -/* C */ -/* CALL SSIZED ( WINSIZ, COVER ) */ - -/* C */ -/* C Find the set of frames in the PCK file. */ -/* C */ -/* CALL PCKFRM ( PCK, IDS ) */ - -/* C */ -/* C We want to display the coverage for each frame. Loop */ -/* C over the contents of the ID code set, find the coverage */ -/* C for each item in the set, and display the coverage. */ -/* C */ -/* DO I = 1, CARDI( IDS ) */ -/* C */ -/* C Find the coverage window for the current frame. */ -/* C Empty the coverage window each time so */ -/* C we don't include data for the previous frame. */ -/* C */ -/* CALL SCARDD ( 0, COVER ) */ -/* CALL PCKCOV ( PCK, IDS(I), COVER ) */ - -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) '========================================' */ -/* WRITE (*,*) 'Coverage for reference frame ', IDS(I) */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO J = 1, NIV */ -/* C */ -/* C Get the endpoints of the Jth interval. */ -/* C */ -/* CALL WNFETD ( COVER, J, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', J */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* WRITE (*,*) '========================================' */ - -/* END DO */ - -/* END */ - -/* $ Restrictions */ - -/* 1) If an error occurs while this routine is updating the set */ -/* IDS, the set may be corrupted. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-2007 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find frame class id codes of frames in binary pck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("PCKFRM", (ftnlen)6); - -/* See whether GETFAT thinks we've got a PCK file. */ - - getfat_(pck, arch, kertyp, pck_len, (ftnlen)80, (ftnlen)80); - if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "PCK file to be readable by this routine. If the input file " - "is an PCK file in transfer format, run TOBIN on the file to " - "convert it to binary format.", (ftnlen)207); - errch_("#", pck, (ftnlen)1, pck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("PCKFRM", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "PCK file to be readable by this routine. Binary PCK files h" - "ave DAF architecture. If you expected the file to be a bina" - "ry PCK file, the problem may be due to the file being an old" - " non-native file lacking binary file format information. It'" - "s also possible the file has been corrupted.", (ftnlen)343); - errch_("#", pck, (ftnlen)1, pck_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22); - chkout_("PCKFRM", (ftnlen)6); - return 0; - } else if (s_cmp(kertyp, "PCK", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has file type #. The file must be a binary PCK" - " file to be readable by this routine. If you expected the fi" - "le to be a binary PCK file, the problem may be due to the fi" - "le being an old non-native file lacking binary file format i" - "nformation. It's also possible the file has been corrupted.", - (ftnlen)298); - errch_("#", pck, (ftnlen)1, pck_len); - errch_("#", kertyp, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22); - chkout_("PCKFRM", (ftnlen)6); - return 0; - } - -/* Open the file for reading. */ - - dafopr_(pck, &handle, pck_len); - if (failed_()) { - chkout_("PCKFRM", (ftnlen)6); - return 0; - } - -/* We will examine each segment descriptor in the file, and */ -/* we'll update our ID code set according to the data found */ -/* in these descriptors. */ - -/* Start a forward search. */ - - dafbfs_(&handle); - -/* Find the next DAF array. */ - - daffna_(&found); - while(found && ! failed_()) { - -/* Fetch and unpack the segment descriptor. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dc, ic); - -/* Insert the current ID code into the output set. */ -/* The insertion algorithm will handle duplicates; no special */ -/* action is required here. */ - - insrti_(ic, ids); - daffna_(&found); - } - -/* Release the file. */ - - dafcls_(&handle); - chkout_("PCKFRM", (ftnlen)6); - return 0; -} /* pckfrm_ */ - diff --git a/ext/spice/src/cspice/pckfrm_c.c b/ext/spice/src/cspice/pckfrm_c.c deleted file mode 100644 index 22a98073ba..0000000000 --- a/ext/spice/src/cspice/pckfrm_c.c +++ /dev/null @@ -1,328 +0,0 @@ -/* - --Procedure pckfrm_c ( PCK reference frame class ID set ) - --Abstract - - Find the set of reference frame class ID codes of all frames - in a specified binary PCK file. - --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 - - CELLS - DAF - SETS - PCK - --Keywords - - ORIENTATION - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void pckfrm_c ( ConstSpiceChar * pck, - SpiceCell * ids ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - pck I Name of PCK file. - ids I/O Set of frame class ID codes of frames in PCK file. - --Detailed_Input - - pck is the name of a binary PCK file. - - ids is an initialized CSPICE set data structure. `ids' - optionally may contain a set of ID codes on input; on - output, the data already present in `ids' will be - combined with ID code set found for the file PCK. - - If `ids' contains no data on input, its size and - cardinality still must be initialized. - --Detailed_Output - - ids is a CSPICE set data structure which contains the - union of its contents upon input with the set of - reference frame class ID codes of each frame for - which data are present in the indicated PCK file. The - elements of CSPICE sets are unique; hence each ID - code in `ids' appears only once, even if the PCK file - contains multiple segments for that ID code. - - See the Examples section below for a complete example - program showing how to retrieve the ID codes from - `ids'. - --Parameters - - None. - --Exceptions - - 1) If the input file has transfer format, the error - SPICE(INVALIDFORMAT) is signaled. - - 2) If the input file is not a transfer file but has architecture - other than DAF, the error SPICE(BADARCHTYPE) is signaled. - - 3) If the input file is a binary DAF file of type other than - PCK, the error SPICE(BADFILETYPE) is signaled. - - 4) If the PCK file cannot be opened or read, the error will - be diagnosed by routines called by this routine. - - 5) If the size of the output set argument `ids' is insufficient to - contain the actual number of ID codes of frames covered by - the indicated PCK file, the error will be diagnosed by - routines called by this routine. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input string - `pck' does not contain at least one character, since the input - string cannot be converted to a Fortran-style string in this - case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `pck' is null. - --Files - - None. - --Particulars - - This routine provides an API via which applications can determine - the set of reference frames for which there are data in a - specified PCK file. - --Examples - - 1) Display the coverage for each frame in a specified PCK file. - Find the set of frames in the file. Loop over the contents - of the ID code set: find the coverage for each item in the - set and display the coverage. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local parameters - ./ - #define FILSIZ 256 - #define MAXIV 1000 - #define WINSIZ ( 2 * MAXIV ) - #define TIMLEN 51 - #define MAXOBJ 1000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - SPICEINT_CELL ( ids, MAXOBJ ); - - SpiceChar lsk [ FILSIZ ]; - SpiceChar pck [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt i; - SpiceInt j; - SpiceInt niv; - SpiceInt obj; - - - /. - Load a leapseconds kernel for output time conversion. - PCKCOV itself does not require a leapseconds kernel. - ./ - prompt_c ( "Name of leapseconds kernel > ", FILSIZ, lsk ); - furnsh_c ( lsk ); - - /. - Get name of PCK file. - ./ - prompt_c ( "Name of PCK file > ", FILSIZ, pck ); - - /. - Find the set of frames in the PCK file. - ./ - pckfrm_c ( pck, &ids ); - - /. - We want to display the coverage for each frame. Loop over - the contents of the ID code set, find the coverage for - each item in the set, and display the coverage. - ./ - for ( i = 0; i < card_c( &ids ); i++ ) - { - /. - Find the coverage window for the current frame. - Empty the coverage window each time so we don't - include data for the previous frame. - ./ - obj = SPICE_CELL_ELEM_I( &ids, i ); - - scard_c ( 0, &cover ); - pckcov_c ( pck, obj, &cover ); - - /. - Get the number of intervals in the coverage window. - ./ - niv = wncard_c ( &cover ); - - /. - Display a simple banner. - ./ - printf ( "%s\n", "========================================" ); - - printf ( "Coverage for frame %ld\n", obj ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( j = 0; j < niv; j++ ) - { - /. - Get the endpoints of the jth interval. - ./ - wnfetd_c ( &cover, j, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - j, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - - } - return ( 0 ); - } - - --Restrictions - - 1) If an error occurs while this routine is updating the set - `ids', the set may be corrupted. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 01-DEC-2007 (NJB) - --Index_Entries - - find frame class id codes of frames in binary pck file - --& -*/ - -{ /* Begin pckfrm_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "pckfrm_c" ); - - - /* - Check the input string `pck' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pckfrm_c", pck ); - - /* - Make sure cell data type is SpiceInt. - */ - CELLTYPECHK ( CHK_STANDARD, "pckfrm_c", SPICE_INT, ids ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( ids ); - - /* - Call the f2c'd Fortran routine. - */ - pckfrm_ ( ( char * ) pck, - ( integer * ) (ids->base), - ( ftnlen ) strlen(pck) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, ids ); - } - - chkout_c ( "pckfrm_c" ); - -} /* End pckfrm_c */ diff --git a/ext/spice/src/cspice/pcklof_c.c b/ext/spice/src/cspice/pcklof_c.c deleted file mode 100644 index bb13352847..0000000000 --- a/ext/spice/src/cspice/pcklof_c.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - --Procedure pcklof_c ( PCK Kernel, Load binary file ) - --Abstract - - Load a binary PCK file for use by the readers. Return the - handle of the loaded file which is used by other PCK routines to - refer to the file. - --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 - - PCK - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void pcklof_c ( ConstSpiceChar * filename, - SpiceInt * handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - filename I Name of the file to be loaded. - handle O Loaded file's handle. - --Detailed_Input - - filename Character name of the file to be loaded. - --Detailed_Output - - handle Integer handle assigned to the file upon loading. - Other PCK routine will subsequently use this number - to refer to the file. - --Parameters - - None. - --Exceptions - - 1) If an attempt is made to load more files than is specified - by the paramater ftsize defined in pckbsr_, the error - SPICE(PCKFILETABLEFULL) is signalled. - - 2) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 3) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - - This routine makes use of DAF file system routines and is subject - to all of the constraints imposed by the DAF fuile system. See - the DAF Required Reading or individual DAF routines for details. - --Files - - A file specified by filename, to be loaded. The file is assigned a - handle by pcklof_c, which will be used by other routines to - refer to it. - --Particulars - - If there is room for a new file in the file table, pcklof_c creates - an entry for it, and opens the file for reading. - - Also, if the body table is empty, pcklof_c initializes it, this - being as good a place as any. - --Examples - - Load a binary PCK kernel and return the integer handle. - - pck = "/kernels/gen/pck/earth6.bpc"; - pcklof_c ( pck, &handle ); - - Also see the Example in PCKLOF.FOR. - --Restrictions - - None. - --Literature_References - - DAF Required Reading - --Author_and_Institution - - K.S. Zukor (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.0.1, 20-MAR-1998 (EDW) - - Minor correction to header. - - -CSPICE Version 2.0.0, 08-FEB-1998 (NJB) - - Input argument filename was changed to type ConstSpiceChar *. - - Re-implemented routine without dynamically allocated, temporary - strings. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - load PCK orientation file - --& -*/ - -{ /* Begin pcklof_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "pcklof_c" ); - - - /* - Check the input string filename to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pcklof_c", filename ); - - - /* - Call the f2c'd Fortran routine. - */ - pcklof_ ( ( char * ) filename, - ( integer * ) handle, - ( ftnlen ) strlen(filename) ); - - - chkout_c ( "pcklof_c" ); - - -} /* End pcklof_c */ diff --git a/ext/spice/src/cspice/pckmat.c b/ext/spice/src/cspice/pckmat.c deleted file mode 100644 index a7f1ab3e48..0000000000 --- a/ext/spice/src/cspice/pckmat.c +++ /dev/null @@ -1,393 +0,0 @@ -/* pckmat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__5 = 5; -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__130 = 130; - -/* $Procedure PCKMAT ( Get transformation matrix at time from PCK file ) */ -/* Subroutine */ int pckmat_(integer *body, doublereal *et, integer *ref, - doublereal *tsipm, logical *found) -{ - integer type__; - extern /* Subroutine */ int pcke02_(doublereal *, doublereal *, - doublereal *), pcke03_(doublereal *, doublereal *, doublereal *), - chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int pckr02_(integer *, doublereal *, doublereal *, - doublereal *), dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - char ident[40]; - extern /* Subroutine */ int pckr03_(integer *, doublereal *, doublereal *, - doublereal *), eul2xf_(doublereal *, integer *, integer *, - integer *, doublereal *); - extern logical failed_(void); - integer handle; - doublereal eulang[6], record[130]; - extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, - integer *, doublereal *); - doublereal estate[6]; - extern /* Subroutine */ int pcksfs_(integer *, doublereal *, integer *, - doublereal *, char *, logical *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen); - integer recsiz; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[5]; - -/* $ Abstract */ - -/* Given a body and epoch, return the name of an inertial */ -/* reference frame and the 6 x 6 state transformation matrix */ -/* from that frame to the body fixed frame. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* ROTATION */ -/* TIME */ -/* PCK */ - -/* $ Keywords */ - -/* TRANSFORMATION */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of some body. */ -/* ET I Epoch of transformation. */ -/* REF O Integer code for inertial reference frame. */ -/* TSIPM O Transformation from Inertial to PM for BODY at ET. */ -/* FOUND O True if data for BODY and ET are found. */ - -/* $ Detailed_Input */ - -/* BODY is the integer ID code of the body for which the */ -/* state transformation matrix is requested. Bodies */ -/* are numbered according to the standard NAIF */ -/* numbering scheme. The numbering scheme is */ -/* explained in the NAIF_IDS required reading file. */ - -/* ET is the epoch at which the state transformation */ -/* matrix is requested. */ - -/* $ Detailed_Output */ - -/* REF is the integer code for the inertial reference frame of */ -/* the state transformation matrix TSIPM. (See the routine */ -/* CHGIRF for a full list of reference frame names.) */ - -/* TSIPM is a 6x6 transformation matrix. It is used to transform */ -/* states from inertial coordinates to body fixed (also */ -/* called equator and prime meridian --- PM) coordinates. */ - -/* Given a state S in the inertial reference frame */ -/* specified by REF, the corresponding state in the body */ -/* fixed reference frame is given by the matrix vector */ -/* product: */ - -/* TSIPM * S */ - -/* The X axis of the PM system is directed to the */ -/* intersection of the equator and prime meridian. The Z */ -/* axis points along the spin axis and points towards the */ -/* same side of the invariable plane of the solar system as */ -/* does earth's north pole. */ - -/* NOTE: The inverse of TSIPM is NOT its transpose. The */ -/* matrix, TSIPM, has a structure as shown below: */ - -/* - - */ -/* | : | */ -/* | R : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | dR_dt : R | */ -/* | : | */ -/* - - */ - -/* where R is a time varying rotation matrix and */ -/* dR_dt is its derivative. The inverse of this */ -/* matrix is: */ - -/* - - */ -/* | T : | */ -/* | R : 0 | */ -/* | .......:.......| */ -/* | : | */ -/* | T : T | */ -/* | dR_dt : R | */ -/* | : | */ -/* - - */ - -/* The SPICE routine INVSTM is available for */ -/* producing this inverse. */ - -/* FOUND if the data allowing the computation of a state */ -/* transformation matrix for the requested time and body */ -/* are found in a binary PCK file, FOUND will have the */ -/* value .TRUE., otherwise it will have the value .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If the size of the type 03 PCK record to be retrieved is too */ -/* large to fit into RECORD, the error SPICE(PCKRECTOOLARGE) will be */ -/* signalled. */ - -/* $ Files */ - -/* A binary PCK kernel must be loaded with PCKLOF before */ -/* calling this routine. */ - -/* $ Particulars */ - -/* The matrix for transforming an inertial state into a body fixed */ -/* states is the 6x6 matrix shown below as a block structured */ -/* matrix. */ - -/* - - */ -/* | : | */ -/* | TIPM : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | DTIPM : TIPM | */ -/* | : | */ -/* - - */ - -/* If a binary PCK file record can be found for the time and */ -/* body requested, it will be used. The most recently loaded */ -/* binary PCK file has first priority, followed by previously */ -/* loaded binary PCK files in backward time order. If no */ -/* binary PCK file has been loaded, the text P_constants */ -/* kernel file is used. */ - - -/* $ Examples */ - -/* Here we load a binary PCK files and use PCKEUL to get the */ -/* Euler angles. */ - -/* C */ -/* C Load binary PCK file. */ -/* C */ -/* CALL PCKLOF ('example.pck', HANDLE) */ - -/* C Call routine to get transformation matrix. */ - -/* CALL PCKMAT ( BODY, ET, REF, TIPM, FOUND ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K. S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 22-MAR-1995 (KRG) (KSZ) */ - -/* Added PCK type 03. Added a new exception. Made some minor */ -/* comment changes. */ - -/* - SPICELIB Version 1.0.0, 21-MAR-1995 (KSZ) */ - -/* Replaces PCKEUL and returns the transformation */ -/* matrix rather than the Euler angles. */ - -/* -& */ -/* $ Index_Entries */ - -/* get state transformation matrix from binary PCK file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-MAR-1995 (KRG) (KSZ) */ - -/* Added PCK type 03. Added a new exception. Made some minor */ -/* comment changes. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* ND and NI values for a PCK file. */ - - -/* Index for the reference frame code in the integer summary. */ - - -/* Length of the descriptor for a PCK file. */ - - -/* Index for the data type code in the integer summary. */ - - -/* Maximum size allowed for a record in a segment of a binary PCK */ -/* file. */ - - -/* Number of components in a state vector. */ - - -/* Local Variables */ - - -/* Standard SPICE Error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKMAT", (ftnlen)6); - } - -/* Get a segment applicable to a specified body and epoch. */ - - pcksfs_(body, et, &handle, descr, ident, found, (ftnlen)40); - if (failed_()) { - *found = FALSE_; - chkout_("PCKMAT", (ftnlen)6); - return 0; - } - if (*found) { - -/* Look at parts of the descriptor. */ - - dafus_(descr, &c__2, &c__5, dcd, icd); - type__ = icd[2]; - *ref = icd[1]; - if (type__ == 2) { - -/* Read in Chebyshev coefficients from segment. */ - - pckr02_(&handle, descr, et, record); - -/* Call evaluation routine to get Euler angles */ -/* phi, delta, w. */ - - pcke02_(et, record, eulang); - if (failed_()) { - *found = FALSE_; - chkout_("PCKMAT", (ftnlen)6); - return 0; - } - -/* From the PCK type two file the Euler angles are */ -/* retrieved in a particular order. The routine to */ -/* get the TSIPM matrix from expects them in another */ -/* order. Here we change from EULANG to ESTATE, which */ -/* has this proper order. */ - - estate[0] = eulang[2]; - estate[1] = eulang[1]; - estate[2] = eulang[0]; - estate[3] = eulang[5]; - estate[4] = eulang[4]; - estate[5] = eulang[3]; - -/* Call routine which takes Euler angles to transformation */ -/* matrix. */ - - eul2xf_(estate, &c__3, &c__1, &c__3, tsipm); - if (failed_()) { - *found = FALSE_; - chkout_("PCKMAT", (ftnlen)6); - return 0; - } - } else if (type__ == 3) { - -/* Fetch the number of Chebyshev coefficients, compute the */ -/* record size needed, and signal an error if there is not */ -/* enough storage in RECORD. The number of coefficients is the */ -/* first constant value in the generic segment. */ - - sgfcon_(&handle, descr, &c__1, &c__1, record); - if (failed_()) { - *found = FALSE_; - chkout_("PCKMAT", (ftnlen)6); - return 0; - } - recsiz = (integer) record[0] * 6 + 2; - if (recsiz > 130) { - setmsg_("Storage for # double precision numbers is needed fo" - "r an PCK data record and only # locations were avail" - "able. Update the parameter MAXREC in the subroutine " - "PCKMAT and notify the NAIF group of this problem.", ( - ftnlen)204); - errint_("#", &recsiz, (ftnlen)1); - errint_("#", &c__130, (ftnlen)1); - sigerr_("SPICE(PCKKRECTOOLARGE)", (ftnlen)22); - chkout_("PCKMAT", (ftnlen)6); - return 0; - } - pckr03_(&handle, descr, et, record); - pcke03_(et, record, tsipm); - if (failed_()) { - *found = FALSE_; - chkout_("PCKMAT", (ftnlen)6); - return 0; - } - } else { - -/* If data matching the requested body and time was not */ -/* found, FOUND is false. */ - - *found = FALSE_; - } - } - chkout_("PCKMAT", (ftnlen)6); - return 0; -} /* pckmat_ */ - diff --git a/ext/spice/src/cspice/pckopn.c b/ext/spice/src/cspice/pckopn.c deleted file mode 100644 index c717a605a6..0000000000 --- a/ext/spice/src/cspice/pckopn.c +++ /dev/null @@ -1,213 +0,0 @@ -/* pckopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__5 = 5; - -/* $Procedure PCKOPN ( PCK, open new file. ) */ -/* Subroutine */ int pckopn_(char *name__, char *ifname, integer *ncomch, - integer *handle, ftnlen name_len, ftnlen ifname_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomr; - extern logical failed_(void); - extern /* Subroutine */ int dafonw_(char *, char *, integer *, integer *, - char *, integer *, integer *, ftnlen, ftnlen, ftnlen), chkout_( - char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Create a new PCK file, returning the handle of the opened file. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of the PCK file to be opened. */ -/* IFNAME I The internal filename for the PCK. */ -/* NCOMCH I The number of characters to reserve for comments. */ -/* HANDLE O The handle of the opened PCK file. */ - -/* $ Detailed_Input */ - -/* NAME The name of the PCK file to be created. */ - -/* IFNAME The internal filename for the PCK file that is being */ -/* created. The internal filename may be up to 60 characters */ -/* long. If you do not have any conventions for tagging your */ -/* files, an internal filename of 'PCK_file' is perfectly */ -/* acceptable. You may also leave it blank if you like. */ - -/* NCOMCH This is the space, measured in characters, to be */ -/* initially set aside for the comment area when a new PCK */ -/* file is opened. The amount of space actually set aside */ -/* may be greater than the amount requested, due to the */ -/* manner in which comment records are allocated in an PCK */ -/* file. However, the amount of space set aside for comments */ -/* will always be at least the amount that was requested. */ - -/* The value of NCOMCH should be greater than or equal to */ -/* zero, i.e., 0 <= NCOMCH. A negative value, should one */ -/* occur, will be assumed to be zero. */ - -/* $ Detailed_Output */ - -/* HANDLE The handle of the opened PCK file. If an error occurs */ -/* when opening the file, the value of this variable should */ -/* not be used, as it will not represent a valid handle. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of NCOMCH is negative, a value of zero (0) will */ -/* be used for the number of comment characters to be set aside */ -/* for comments. */ - -/* 2) If an error occurs while attempting to open a CK file the */ -/* value of HANDLE will not represent a valid file handle. */ - -/* $ Files */ - -/* See NAME and HANDLE. */ - -/* $ Particulars */ - -/* Open a new PCK file, reserving room for comments if requested. */ - -/* $ Examples */ - -/* Suppose that you want to create a new PCK file called 'new.PCK' */ -/* that contains a single type 2 PCK segment and has room for at */ -/* least 5000 comment characters. The following code fragment should */ -/* take care of this for you, assuming that all of the variables */ -/* passed to the PCK type 2 segment writer have appropriate values. */ - -/* NAME = 'new.pck' */ -/* IFNAME = 'Test PCK file' */ - -/* CALL PCKOPN ( NAME, IFNAME, 5000, HANDLE ) */ -/* CALL PCKW02 ( HANDLE, BODY, FRAME, FIRST, LAST, */ -/* . SEGID, INTLEN, N, POLYDG, CDATA, */ -/* . BTIME ) */ -/* CALL PCKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 09-NOV-2006 (NJB) */ - -/* Routine has been upgraded to support comment */ -/* area allocation using NCOMCH. */ - -/* - SPICELIB Version 1.0.0, 26-JAN-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a new pck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* DAF ND and NI values for PCK files. */ - - -/* Length of a DAF comment record, in characters. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("PCKOPN", (ftnlen)6); - -/* Compute the number of comment records that we want to allocate, if */ -/* the number of comment characters requested is greater than zero, */ -/* we always allocate an extra record to account for the end of line */ -/* marks in the comment area. */ - - if (*ncomch > 0) { - ncomr = (*ncomch - 1) / 1000 + 1; - } else { - ncomr = 0; - } - -/* Just do it. All of the error handling is taken care of for us. */ - - dafonw_(name__, "PCK", &c__2, &c__5, ifname, &ncomr, handle, name_len, ( - ftnlen)3, ifname_len); - if (failed_()) { - -/* If we failed, make sure that HANDLE does not contain a value */ -/* that represents a valid DAF file handle. */ - - *handle = 0; - } - chkout_("PCKOPN", (ftnlen)6); - return 0; -} /* pckopn_ */ - diff --git a/ext/spice/src/cspice/pckpds.c b/ext/spice/src/cspice/pckpds.c deleted file mode 100644 index c06a12d558..0000000000 --- a/ext/spice/src/cspice/pckpds.c +++ /dev/null @@ -1,260 +0,0 @@ -/* pckpds.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__5 = 5; - -/* $Procedure PCKPDS ( PCK pack descriptor ) */ -/* Subroutine */ int pckpds_(integer *body, char *frame, integer *type__, - doublereal *first, doublereal *last, doublereal *descr, ftnlen - frame_len) -{ - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), dafps_(integer *, integer *, doublereal *, - integer *, doublereal *), errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen); - integer ipart[5], refcod; - char calfst[40], callst[40]; - doublereal dppart[2]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Perform routine error checks and if all checks pass, pack the */ -/* descriptor for a PCK segment */ - -/* $ 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 */ - -/* PCK. */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I The NAIF ID code for the body of the segment. */ -/* FRAME I The inertial frame for this segment. */ -/* TYPE I The type of PCK segment to create. */ -/* FIRST I The first epoch for which the segment is valid. */ -/* LAST I The last epoch for which the segment is valid. */ -/* DESCR O A PCK segment descriptor. */ - -/* $ Detailed_Input */ - -/* BODY is the NAIF ID code for the body of the segment. */ - -/* FRAME is a string that names the inertial frame to which */ -/* states for the body shall be referenced. */ - -/* TYPE is the type of PCK segment to create. */ - -/* FIRST is the first epoch for which the segment will have */ -/* ephemeris data. */ - -/* LAST is the last epoch for which the segment will have */ -/* ephemeris data. */ - -/* $ Detailed_Output */ - -/* DESCR is a valid PCK segment descriptor to use */ -/* when creating a DAF segment for this body. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine for validating and creating */ -/* the descriptor for a PCK segment. It is intended for */ -/* use only by routines that create PCK segments. */ - -/* $ Examples */ - -/* Suppose that you wish to create a PCK segment of type X */ -/* and that you are writing a routine to handle the details */ -/* of the segment creation. This routine can be used to */ -/* ensure that the descriptor needed for the segment is */ -/* properly formed and that the information in that descriptor */ -/* is reasonable. */ - -/* Having collected the needed information you can create the */ -/* descriptor and then begin a new segment as shown below. */ - -/* CALL PCKPDS ( BODY, FRAME, TYPE, FIRST, LAST, DESCR ) */ -/* CALL DAFBNA ( HANDLE, DESCR, SEGID ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(BARYCENTERIDCODE)' is signalled if the */ -/* value of BODY is the ID code of a barycenter, codes */ -/* 0, 1, ..., 9. */ - -/* 3) The error 'SPICE(INVALIDREFFRAME)' is signalled if FRAME */ -/* is not one of the known SPICE inertial reference frames. */ - -/* 4) The error 'SPICE(BADDESCRTIMES)' is signalled if FIRST */ -/* is greater than or equal to LAST */ - -/* 5) The error 'SPICE(UNKNOWNPCKTYPE)' is signalled if the */ -/* value of TYPE is outside the range 2 to 1000 (inclusive). */ -/* This does not ensure that the TYPE is a legitimate PCK */ -/* segment type, but it is a simple check that helps avoid */ -/* problems that arise from unitialized values or improperly */ -/* ordered calling arguments. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 04-JAN-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Validate and pack a PCK segment descriptor */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* ND and NI values for a PCK file. */ - - -/* Length of a calender string. */ - - -/* Local Variables */ - - -/* Standard SPICLEIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKPDS", (ftnlen)6); - } - -/* We do not support orientation models for barycenters. */ - - if (*body >= 0 && *body <= 9) { - setmsg_("You have attempted to create a segment for for a barycente" - "r, and the PCK system does not support this.", (ftnlen)103); - sigerr_("SPICE(BARYCENTERIDCODE)", (ftnlen)23); - chkout_("PCKPDS", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - irfnum_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("PCKPDS", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first >= *last) { - -/* We've got an error. Get the calendar string for the first */ -/* and last epochs. */ - - etcal_(first, calfst, (ftnlen)40); - etcal_(last, callst, (ftnlen)40); - setmsg_("The segment start time: # (#) is at orafter the segment sto" - "p time # (#). ", (ftnlen)73); - errdp_("#", first, (ftnlen)1); - errch_("#", calfst, (ftnlen)1, (ftnlen)40); - errdp_("#", last, (ftnlen)1); - errch_("#", callst, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("PCKPDS", (ftnlen)6); - return 0; - } - -/* The type must be something reasonable. The interval from */ -/* 2 to 1000 is what we are calling reasonable these days. */ - - if (*type__ <= 1 || *type__ > 1000) { - setmsg_("The type specified, #, is not supported within the PCK syst" - "em. ", (ftnlen)63); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(UNKNOWNPCKTYPE)", (ftnlen)21); - chkout_("PCKPDS", (ftnlen)6); - return 0; - } - -/* Well, that's it. As far as we can determine these seem to be */ -/* reasonble values to put into a descriptor. Do it. */ - - ipart[0] = *body; - ipart[1] = refcod; - ipart[2] = *type__; - ipart[3] = 0; - ipart[4] = 0; - dppart[0] = *first; - dppart[1] = *last; - dafps_(&c__2, &c__5, dppart, ipart, descr); - chkout_("PCKPDS", (ftnlen)6); - return 0; -} /* pckpds_ */ - diff --git a/ext/spice/src/cspice/pckr02.c b/ext/spice/src/cspice/pckr02.c deleted file mode 100644 index 186ceceaa1..0000000000 --- a/ext/spice/src/cspice/pckr02.c +++ /dev/null @@ -1,227 +0,0 @@ -/* pckr02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__5 = 5; - -/* $Procedure PCKR02 ( Read PCK record from segment, type 2 ) */ -/* Subroutine */ int pckr02_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nrec; - doublereal init; - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer recno; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[5], recadr; - doublereal intlen; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer recsiz; - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Read a single PCK data record from a segment of type 2 */ -/* (Chebyshev, 3-vector only). */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a PCK segment of type 2. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the Euler */ -/* angles (orientation) of some body. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the PCK Required Reading file for a description of the */ -/* structure of a data type 2 (Chebyshev polynomials, Euler */ -/* angles only) segment. */ - -/* $ Examples */ - -/* The data returned is in its rawest form, taken directly from */ -/* the segment. As such, it will be meaningless to a user unless */ -/* he/she understands the structure of the data type completely. */ -/* Given that understanding, however, the PCKRxx routines might be */ -/* used to "dump" and check segment data for a particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, ND, NI, DCD, ICD ) */ -/* REF = ICD( NR ) */ -/* TYPE = ICD( NT ) */ - -/* IF ( TYPE .EQ. 2 ) THEN */ -/* CALL PCKR02 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 11-MAR-1993 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_2 pck segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKR02", (ftnlen)6); - } - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__5, dc, ic); - begin = ic[3]; - end = ic[4]; - -/* The segment is made up of a number of logical records, each */ -/* having the same size, and covering the same length of time. */ - -/* We can determine which record to return by comparing the input */ -/* epoch with the initial time of the segment and the length of the */ -/* interval covered by each record. These final two constants are */ -/* located at the end of the segment, along with the size of each */ -/* logical record and the total number of records. */ - - i__1 = end - 3; - dafgda_(handle, &i__1, &end, record); - init = record[0]; - intlen = record[1]; - recsiz = (integer) record[2]; - nrec = (integer) record[3]; - recno = (integer) ((*et - init) / intlen) + 1; - recno = min(recno,nrec); - -/* Compute the address of the desired record. */ - - recadr = (recno - 1) * recsiz + begin; - -/* Along with the record, return the size of the record. */ - - record[0] = record[2]; - i__1 = recadr + recsiz - 1; - dafgda_(handle, &recadr, &i__1, &record[1]); - chkout_("PCKR02", (ftnlen)6); - return 0; -} /* pckr02_ */ - diff --git a/ext/spice/src/cspice/pckr03.c b/ext/spice/src/cspice/pckr03.c deleted file mode 100644 index 48fb2716d9..0000000000 --- a/ext/spice/src/cspice/pckr03.c +++ /dev/null @@ -1,236 +0,0 @@ -/* pckr03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure PCKR03 ( Read PCK record from segment, type 03 ) */ -/* Subroutine */ int pckr03_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - integer ends, indx; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - doublereal value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), sgfcon_( - integer *, doublereal *, integer *, integer *, doublereal *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), sgfpkt_(integer - *, doublereal *, integer *, integer *, doublereal *, integer *), - sgfrvi_(integer *, doublereal *, doublereal *, doublereal *, - integer *, logical *), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Read a single PCK data record from a segment of type 03. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle for a PCK file. */ -/* DESCR I Descriptor for a type 03 PCK segment. */ -/* ET I Target epoch for orientation information. */ -/* RECORD O Data record associated with epoch ET. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle for a type 03 PCK segment. */ - -/* DESCR is the segment descriptor for a type 03 PCK segment. */ - -/* ET is a target epoch, for which a data record from */ -/* the specified segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the RA, DEC, */ -/* W and body fixed angular rates for the body associated */ -/* with the segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) It is assumed that the descriptor and handle supplied are */ -/* for a properly constructed type 03 segment. No checks are */ -/* performed to ensure this. */ - -/* 2) If the input ET value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signalled. */ - -/* 3) All other errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* This subroutine reads a type 03 PCK record from the segment */ -/* specified by HANDLE and DESCR. The record read will contain */ -/* sufficient information to to compute RA, DEC, W and body fixed */ -/* angular rates for the body associated with the segment for epoch */ -/* ET. */ - -/* See the PCK Required Reading file for a description of the */ -/* structure of a type 03 PCK segment. */ - -/* $ Examples */ - -/* The data returned by the PCKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the PCKRnn */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 03 ) THEN */ -/* CALL PCKR03 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) It is assumed that the descriptor and handle supplied are */ -/* for a properly constructed type 03 segment. No checks are */ -/* performed to ensure this. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_03 pck segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* The number of constant values stored with a type 03 segment */ -/* segment. */ - - -/* The beginning location in the output record for the non-constant */ -/* segment data. */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKR03", (ftnlen)6); - } - -/* Check the request time against the time bounds in the segment */ -/* descriptor. In order to get the right data back from the generic */ -/* segment calls below, we need to be sure that the desired epoch */ -/* falls within the bounds of the segment, as specified by the */ -/* descriptor. The first two elements of the descriptor are the start */ -/* time for the segment and the stop time for the segment, */ -/* respectively. */ - - if (*et < descr[0] || *et > descr[1]) { - setmsg_("Request time # is outside of descriptor bounds # : #.", ( - ftnlen)53); - errdp_("#", et, (ftnlen)1); - errdp_("#", descr, (ftnlen)1); - errdp_("#", &descr[1], (ftnlen)1); - sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22); - chkout_("PCKR03", (ftnlen)6); - return 0; - } - -/* Fetch the constants and store them in the first part of */ -/* the output RECORD. */ - - sgfcon_(handle, descr, &c__1, &c__1, record); - -/* Locate the time in the file less than or equal to the input ET. */ - - sgfrvi_(handle, descr, et, &value, &indx, &found); - -/* Fetch the data record. */ - - sgfpkt_(handle, descr, &indx, &indx, &record[1], &ends); - chkout_("PCKR03", (ftnlen)6); - return 0; -} /* pckr03_ */ - diff --git a/ext/spice/src/cspice/pckuds.c b/ext/spice/src/cspice/pckuds.c deleted file mode 100644 index 741442b3c5..0000000000 --- a/ext/spice/src/cspice/pckuds.c +++ /dev/null @@ -1,203 +0,0 @@ -/* pckuds.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__5 = 5; - -/* $Procedure PCKUDS (PCK - unpack segment descriptor ) */ -/* Subroutine */ int pckuds_(doublereal *descr, integer *body, integer *frame, - integer *type__, doublereal *first, doublereal *last, integer *begin, - integer *end) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer ipart[5]; - extern logical failed_(void); - doublereal dppart[2]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Unpack the contents of a PCK segment descriptor */ - -/* $ 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 */ - -/* PCK. */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DESCR I A PCK segment descriptor. */ -/* BODY O The NAIF ID code for the body of the segment. */ -/* FRAME O The code for the inertial frame of this segment. */ -/* TYPE O The type of PCK segment. */ -/* FIRST O The first epoch for which the segment is valid. */ -/* LAST O The last epoch for which the segment is valid. */ -/* BEGIN O Beginning DAF address of the segment. */ -/* END O Ending DAF address of the segment. */ - -/* $ Detailed_Input */ - -/* DESCR is a PCK segment descriptor. */ - -/* $ Detailed_Output */ - -/* BODY is the NAIF ID code for the body of the segment. */ - -/* FRAME is the SPICE ID code for the inertial frame to which */ -/* the body fixed orientation is referenced. */ - -/* TYPE is the type of PCK segment. */ - -/* FIRST is the first epoch for which the segment has */ -/* orientation data. */ - -/* LAST is the last epoch for which the segment has */ -/* orientation data. */ - -/* BEGIN is the starting address of the data associated */ -/* with this descriptor. */ - -/* END is the last address of the data associated with */ -/* this descriptor. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine extracts the contents of a PCK segment */ -/* descriptor into the components needed for reading and */ -/* evaluating the data stored in the segment. It serves */ -/* as a macro for expanding the PCK segment descriptor. */ - -/* $ Examples */ - -/* Suppose you wished to summarize a particular PCK segment */ -/* and that you have the descriptor for that segment in hand. */ -/* The following code fragment shows how you might use this */ -/* routine to create a summary message concerning the segment. */ - -/* CALL PCKUDS ( DESCR, BODY, FRAME, TYPE, FIRST, LAST ) */ - -/* Convert the start and stop times to ephemeris calendar strings */ - -/* CALL ETCAL ( FIRST, FSTCAL ) */ -/* CALL ETCAL ( LAST, LSTCAL ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Body : ', BODY */ -/* WRITE (*,*) 'Frame ID : ', FRAME */ -/* WRITE (*,*) 'Data Type: ', TYPE */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment Start : ', FSTCAL */ -/* WRITE (*,*) 'Segment Stop : ', LSTCAL */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 1994-JAN-4 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Unpack and PCK segment descriptor */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKUDS", (ftnlen)6); - } - -/* No judgements are made about the descriptor when we */ -/* unpack it. If things were done right when the descriptor */ -/* was created, it should be fine now. */ - - dafus_(descr, &c__2, &c__5, dppart, ipart); - if (failed_()) { - chkout_("PCKUDS", (ftnlen)6); - return 0; - } - *body = ipart[0]; - *frame = ipart[1]; - *type__ = ipart[2]; - *begin = ipart[3]; - *end = ipart[4]; - *first = dppart[0]; - *last = dppart[1]; - chkout_("PCKUDS", (ftnlen)6); - return 0; -} /* pckuds_ */ - diff --git a/ext/spice/src/cspice/pckuof_c.c b/ext/spice/src/cspice/pckuof_c.c deleted file mode 100644 index cc9e1a226e..0000000000 --- a/ext/spice/src/cspice/pckuof_c.c +++ /dev/null @@ -1,150 +0,0 @@ -/* - --Procedure pckuof_c ( PCK Kernel, Unload binary file ) - --Abstract - - Unload a binary PCK file so that it will no longer be searched by - the readers. - --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 - - PCK - --Keywords - - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void pckuof_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of PCK file to be unloaded - --Detailed_Input - - handle Integer handle assigned to the PCK file when it was - loaded. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - The file referred to by handle is unloaded. - --Particulars - - A PCK file is removed from consideration by the readers during a - search by a call to pckuof_c. - - The file table entry corresponding to the file referenced by - handle, is removed and the file is closed. Any segment table - entry which came from the specified file is also deleted. - - If the file specified by handle does not appear in the file table, - nothing happens. - --Examples - - Unload a binary PCK kernel specified by an integer handle, making - room to load another PCK. - - pck = "/kernels/gen/pck/earth6.bpc"; - pcklof_c ( pck, &handle ); - . - . - . - pckuof_c ( handle ); - - - Also see the Example in pckbsr.c or pckbsr.for. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.M. Lynch (JPL) - R.E. Thurman (JPL) - K.S. Zukor (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.0, 16-MAR-1994 (KSZ) - --Index_Entries - - unload PCK orientation file - --& -*/ - -{ /* Begin pckuof_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "pckuof_c" ); - - /* - Call the f2c'd Fortran routine. - */ - pckuof_ ( ( integer * ) &handle ); - - - chkout_c ( "pckuof_c" ); - - -} /* End pckuof_c */ diff --git a/ext/spice/src/cspice/pckw02.c b/ext/spice/src/cspice/pckw02.c deleted file mode 100644 index ab00a97cd2..0000000000 --- a/ext/spice/src/cspice/pckw02.c +++ /dev/null @@ -1,487 +0,0 @@ -/* pckw02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__40 = 40; -static integer c__2 = 2; -static integer c__5 = 5; -static integer c__1 = 1; - -/* $Procedure PCKW02 ( Write PCK segment, type 2 ) */ -/* Subroutine */ int pckw02_(integer *handle, integer *body, char *frame, - doublereal *first, doublereal *last, char *segid, doublereal *intlen, - integer *n, integer *polydg, doublereal *cdata, doublereal *btime, - ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, k; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), dafps_(integer *, integer *, doublereal *, - integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal ltime; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal rsize; - char etstr[40]; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( - integer *, doublereal *, char *, ftnlen), dafena_(void); - extern logical failed_(void); - extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, - ftnlen); - integer refcod, ninrec; - doublereal radius, numrec; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - char netstr[40]; - doublereal dcd[2]; - integer icd[5]; - doublereal mid; - -/* $ Abstract */ - -/* Write a type 2 segment to a PCK binary file given */ -/* the file handle, body, frame, time range covered by the */ -/* segment, and the Chebyshev polynomial coefficeients. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* PCK */ - -/* $ Keywords */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of binary PCK file open for writing. */ -/* BODY I NAIF code for ephemeris object. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* INTLEN I Length of time covered by logical record. */ -/* N I Number of logical records in segment. */ -/* POLYDG I Chebyshev polynomial degree. */ -/* CDATA I Array of Chebyshev coefficients. */ -/* BTIME I Begin time of first logical record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the DAF handle of an PCK file to which a type 2 */ -/* segment is to be added. The PCK file must be open */ -/* for writing. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose orientation is described by the segment to */ -/* be created. */ - -/* FRAME is the NAIF name for a reference frame relative to */ -/* which the orientation information for BODY is */ -/* specified. */ - -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the orientation of body. */ - -/* SEGID is the segment identifier. A PCK segment */ -/* identifier may contain up to 40 characters. */ - -/* INTLEN Length of time, in seconds, covered by each set of */ -/* Chebyshev polynomial coefficients (each logical */ -/* record). Each set of Chebyshev coefficents must */ -/* cover this fixed time interval, INTLEN. */ - -/* N is the number of sets of Chebyshev polynomial */ -/* coefficents (number of logical records) */ -/* to be stored in the segment. There is one set */ -/* of Chebyshev coefficients for each time period. */ - -/* POLYDG Degree of each set of Chebyshev polynomials. */ - -/* CDATA Array containing all the sets of Chebyshev */ -/* polynomial coefficients to be contained in the */ -/* segment of the PCK file. The coefficients are */ -/* stored in CDATA in order as follows: */ - -/* the (degree + 1) coefficients for the first */ -/* Euler angle of the first logical record */ - -/* the coefficients for the second Euler angle */ - -/* the coefficients for the third Euler angle */ - -/* the coefficients for the first Euler angle for */ -/* the second logical record, ... */ - -/* and so on. */ - -/* BTIME Begin time (seconds past J2000 TDB) of first set */ -/* of Chebyshev polynomial coefficients (first */ -/* logical record). */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of sets of coefficients is not positive */ -/* 'SPICE(NUMCOEFFSNOTPOS)' is signalled. */ - -/* 2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */ -/* is signalled. */ - -/* 3) If the integer code for the reference frame is not recognized, */ -/* 'SPICE(INVALIDREFFRAME)' is signalled. */ - -/* 4) If segment stop time is not greater then the begin time, */ -/* 'SPICE(BADDESCRTIMES)' is signalled. */ - -/* 5) If the time of the first record is not greater than */ -/* or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */ -/* is signalled. */ - -/* 6) If the end time of the last record is not greater than */ -/* or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */ -/* signalled. */ - -/* $ Files */ - -/* A new type 2 PCK segment is written to the PCK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an PCK type 2 data segment to the designated */ -/* PCK file, according to the format described in the PCK Required */ -/* Reading. */ - -/* Each segment can contain data for only one body and reference */ -/* frame. The Chebyshev polynomial degree and length of time covered */ -/* by each logical record are also fixed. However, an arbitrary */ -/* number of logical records of Chebyshev polynomial coefficients can */ -/* be written in each segment. Minimizing the number of segments in */ -/* a PCK file will help optimize how the SPICE system accesses the */ -/* file. */ - - -/* $ Examples */ - - -/* Suppose that you have sets of Chebyshev polynomial coefficients */ -/* in an array CDATA pertaining to the position of the moon (NAIF ID */ -/* = 301) in the J2000 reference frame, and want to put these into a */ -/* type 2 segment in an existing PCK file. The following code could */ -/* be used to add one new type 2 segment. To add multiple segments, */ -/* put the call to PCKW02 in a loop. */ - -/* C */ -/* C First open the PCK file and get a handle for it. */ -/* C */ -/* CALL DAFOPW ( PCKNAM, HANDLE ) */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_PCK_TYPE_2_SEGMENT' */ - -/* C */ -/* C Write the segment. */ - -/* CALL PCKW02 ( HANDLE, 301, 'J2000', */ -/* . FIRST, LAST, SEGID, INTLEN, */ -/* . N, POLYDG, CDATA, BTIME) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DAFCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */ - -/* The calling sequence was corrected so that REF is */ -/* a character string and BTIME contains only the start */ -/* time of the first record. Comments updated, and new */ -/* routine CHCKID is called to check segment identifier. */ - -/* - SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* write pck type_2 data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */ - -/* The calling sequence was corrected so that REF is */ -/* a character string and BTIME contains only the start */ -/* time of the first record. Comments updated, and new */ -/* routine CHCKID is called to check segment identifier. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* DTYPE is the PCK data type. */ - - -/* NS is the size of a packed PCK segment descriptor. */ - - -/* ND is the number of double precision components in an PCK */ -/* segment descriptor. PCK uses ND = 2. */ - - -/* NI is the number of integer components in an PCK segment */ -/* descriptor. PCK uses NI = 5. */ - - -/* SIDLEN is the maximum number of characters allowed in an */ -/* PCK segment identifier. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PCKW02", (ftnlen)6); - } - -/* The number of sets of coefficients must be positive. */ - - if (*n <= 0) { - setmsg_("The number of sets of Euler anglecoefficients is not positi" - "ve. N = #", (ftnlen)68); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22); - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* The interval length must be positive. */ - - if (*intlen <= 0.) { - setmsg_("The interval length is not positive.N = #", (ftnlen)41); - errdp_("#", intlen, (ftnlen)1); - sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19); - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - irfnum_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* The segment stop time must be greater than the begin time. */ - - if (*first > *last) { - setmsg_("The segment start time: # is greater than the segment end t" - "ime: #", (ftnlen)65); - etcal_(first, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(last, netstr, (ftnlen)40); - errch_("#", netstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* The begin time of the first record must be less than or equal */ -/* to the begin time of the segment. */ - - if (*first < *btime) { - setmsg_("The segment descriptor start time: # is less than the begin" - "ning time of the segment data: #", (ftnlen)91); - etcal_(first, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(btime, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* The end time of the final record must be greater than or */ -/* equal to the end time of the segment. */ - - ltime = *btime + *n * *intlen; - if (*last > ltime) { - setmsg_("The segment descriptor end time: # is greater than the end " - "time of the segment data: #", (ftnlen)86); - etcal_(last, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(<ime, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* Now check the validity of the segment identifier. */ - - chckid_("PCK segment identifier", &c__40, segid, (ftnlen)22, segid_len); - if (failed_()) { - chkout_("PCKW02", (ftnlen)6); - return 0; - } - -/* Store the start and end times to be associated */ -/* with this segment. */ - - dcd[0] = *first; - dcd[1] = *last; - -/* Create the integer portion of the descriptor. */ - - icd[0] = *body; - icd[1] = refcod; - icd[2] = 2; - -/* Pack the segment descriptor. */ - - dafps_(&c__2, &c__5, dcd, icd, descr); - -/* Begin a new segment of PCK type 2 form: */ - -/* Record 1 */ -/* Record 2 */ -/* ... */ -/* Record N */ -/* INIT ( initial epoch of first record ) */ -/* INTLEN ( length of interval covered by each record ) */ -/* RSIZE ( number of data elements in each record ) */ -/* N ( number of records in segment ) */ - -/* Each record will have the form: */ - -/* MID ( midpoint of time interval ) */ -/* RADIUS ( radius of time interval ) */ -/* X coefficients, Y coefficients, Z coefficients */ - - dafbna_(handle, descr, segid, segid_len); - -/* Calculate the number of entries in a record. */ - - ninrec = (*polydg + 1) * 3; - -/* Fill segment with N records of data. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the midpoint and radius of the time of each */ -/* record, and put that at the beginning of each record. */ - - radius = *intlen / 2; - mid = *btime + radius + (i__ - 1) * *intlen; - dafada_(&mid, &c__1); - dafada_(&radius, &c__1); - -/* Put one set of coefficients into the segment. */ - - k = (i__ - 1) * ninrec + 1; - dafada_(&cdata[k - 1], &ninrec); - } - -/* Store the initial epoch of the first record. */ - - dafada_(btime, &c__1); - -/* Store the length of interval covered by each record. */ - - dafada_(intlen, &c__1); - -/* Store the size of each record (total number of array elements). */ - - rsize = (doublereal) (ninrec + 2); - dafada_(&rsize, &c__1); - -/* Store the number of records contained in the segment. */ - - numrec = (doublereal) (*n); - dafada_(&numrec, &c__1); - -/* End this segment. */ - - dafena_(); - chkout_("PCKW02", (ftnlen)6); - return 0; -} /* pckw02_ */ - diff --git a/ext/spice/src/cspice/pcpool_c.c b/ext/spice/src/cspice/pcpool_c.c deleted file mode 100644 index aaf33a0938..0000000000 --- a/ext/spice/src/cspice/pcpool_c.c +++ /dev/null @@ -1,326 +0,0 @@ -/* - --Procedure pcpool_c ( Put character strings into the kernel pool ) - --Abstract - - This entry point provides toolkit programmers a method for - programmatically inserting character data into the - kernel pool. - --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 - - POOL - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #include "SpiceZim.h" - #undef pcpool_c - - - void pcpool_c ( ConstSpiceChar * name, - SpiceInt n, - SpiceInt lenvals, - const void * cvals ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I The kernel pool name to associate with cvals. - n I The number of values to insert. - lenvals I The lengths of the strings in the array cvals. - cvals I An array of strings to insert into the kernel pool. - --Detailed_Input - - name is the name of the kernel pool variable to associate - with the values supplied in the array cvals. 'name' is - restricted to a length of 32 characters or less. - - n is the number of values to insert into the kernel pool. - - lenvals is the length of the strings in the array cvals, - including the null terminators. - - cvals is an array of strings to insert into the kernel - pool. cvals should be declared as follows: - - char cvals[n][lenvals]; - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If name is already present in the kernel pool and there - is sufficient room to hold all values supplied in values, - the old values associated with name will be overwritten. - - 2) If there is not sufficient room to insert a new variable - into the kernel pool and name is not already present in - the kernel pool, the error SPICE(KERNELPOOLFULL) is - signaled by a routine in the call tree to this routine. - - 3) If there is not sufficient room to insert the values associated - with name, the error SPICE(NOMOREROOM) will be signaled. - - 4) If either input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 5) If the input string name has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 6) If the input cvals string length is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 7) The error 'SPICE(BADVARNAME)' signals if the kernel pool - variable name length exceeds 32. - --Files - - None. - --Particulars - - This entry point provides a programmatic interface for inserting - character data into the SPICE kernel pool without reading an - external file. - --Examples - - The following example program shows how a topocentric frame for a - point on the surface of the earth may be defined at run time using - pcpool_c, pdpool_c, and pipool_c. In this example, the surface - point is associated with the body code 300000. To facilitate - testing, the location of the surface point coincides with that of - the DSN station DSS-12; the reference frame MYTOPO defined here - coincides with the reference frame DSS-12_TOPO. - - #include - #include "SpiceUsr.h" - - int main() - { - /. - The first angle is the negative of the longitude of the - surface point; the second angle is the negative of the - point's colatitude. - ./ - SpiceDouble angles [3] = { -243.1945102442646, - -54.7000629043147, - 180.0 }; - - SpiceDouble et = 0.0; - SpiceDouble rmat [3][3]; - - SpiceInt axes [3] = { 3, 2, 3 }; - SpiceInt center = 300000; - SpiceInt frclass = 4; - SpiceInt frclsid = 1500000; - SpiceInt frcode = 1500000; - - /. - Define the MYTOPO reference frame. - - Note that the third argument in the pcpool_c calls is - the length of the final string argument, including the - terminating null character. - ./ - pipool_c ( "FRAME_MYTOPO", 1, &frcode ); - pcpool_c ( "FRAME_1500000_NAME", 1, 7, "MYTOPO" ); - pipool_c ( "FRAME_1500000_CLASS", 1, &frclass ); - pipool_c ( "FRAME_1500000_CLASS_ID", 1, &frclsid ); - pipool_c ( "FRAME_1500000_CENTER", 1, ¢er ); - - pcpool_c ( "OBJECT_300000_FRAME", 1, 7, "MYTOPO" ); - - pcpool_c ( "TKFRAME_MYTOPO_RELATIVE", 1, 7, "ITRF93" ); - pcpool_c ( "TKFRAME_MYTOPO_SPEC", 1, 7, "ANGLES" ); - pcpool_c ( "TKFRAME_MYTOPO_UNITS", 1, 8, "DEGREES" ); - pipool_c ( "TKFRAME_MYTOPO_AXES", 3, axes ); - pdpool_c ( "TKFRAME_MYTOPO_ANGLES", 3, angles ); - - /. - Load a high precision binary earth PCK. Also load a - topocentric frame kernel for DSN stations. The file names - shown here are simply examples; users should replace these - with the names of appropriate kernels. - ./ - furnsh_c ( "earth_000101_060207_051116.bpc" ); - furnsh_c ( "earth_topo_050714.tf" ); - - /. - Look up transformation from DSS-12_TOPO frame to MYTOPO frame. - This transformation should differ by round-off error from - the identity matrix. - ./ - pxform_c ( "DSS-12_TOPO", "MYTOPO", et, rmat ); - - printf ( "\n" - "DSS-12_TOPO to MYTOPO transformation at " - "et %23.16e = \n" - "\n" - " %25.16f %25.16f %25.16f\n" - " %25.16f %25.16f %25.16f\n" - " %25.16f %25.16f %25.16f\n", - et, - rmat[0][0], rmat[0][1], rmat[0][2], - rmat[1][0], rmat[1][1], rmat[1][2], - rmat[2][0], rmat[2][1], rmat[2][2] ); - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.3.2, 10-FEB-2010 (EDW) - - Added mention of the restriction on kernel pool variable - names to 32 characters or less. - - Reordered header sections to conform to SPICE convention. - - -CSPICE Version 1.3.1, 17-NOV-2005 (NJB) - - Replaced code fragment in Examples section of header with - smaller, complete program. - - -CSPICE Version 1.3.0, 12-JUL-2002 (NJB) - - Call to C2F_CreateStrArr_Sig replaced with call to C2F_MapStrArr. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input array cvals. - - -CSPICE Version 1.1.0, 14-FEB-2000 (NJB) - - Calls to C2F_CreateStrArr replaced with calls to error-signaling - version of this routine: C2F_CreateStrArr_Sig. - - -CSPICE Version 1.0.0, 18-JUN-1999 (NJB) (WLT) - --Index_Entries - - Set the value of a character kernel pool variable - --& -*/ - -{ /* Begin pcpool_c */ - - - /* - Local variables - */ - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - chkin_c ( "pcpool_c" ); - - /* - Check the input kernel variable name to make sure the pointer is - non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pcpool_c", name ); - - - /* - Make sure the input string pointer for the cvals array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "pcpool_c", cvals, lenvals ); - - - /* - Create a Fortran-style string array. - */ - C2F_MapStrArr ( "pcpool_c", - n, lenvals, cvals, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - chkout_c ( "pcpool_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - pcpool_ ( ( char * ) name, - ( integer * ) &n, - ( char * ) fCvalsArr, - ( ftnlen ) strlen(name), - ( ftnlen ) fCvalsLen ); - - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - - chkout_c ( "pcpool_c" ); - -} /* End pcpool_c */ - diff --git a/ext/spice/src/cspice/pcwid.c b/ext/spice/src/cspice/pcwid.c deleted file mode 100644 index 33455883ca..0000000000 --- a/ext/spice/src/cspice/pcwid.c +++ /dev/null @@ -1,197 +0,0 @@ -/* pcwid.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PCWID ( Printable width of a character array ) */ -integer pcwid_(char *array, integer *nelt, ftnlen array_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__, j, strlen; - -/* $ Abstract */ - -/* Determine the printable width of a character array. */ - -/* $ 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 */ - -/* ARRAY, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* NELT I Number of elements in the array. */ -/* PCWID O Maximum value of LASTPC for the array. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* NELT is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* PCWID is the index of the rightmost printable character */ -/* in the entire array. This is equivalent to the */ -/* maximum value of LASTPC for the array, but somewhat */ -/* more efficient to compute. If NELT is not greater */ -/* than zero, PCWID is zero. */ - -/* ASCII characters in the range [33,126] are considered */ -/* printable. Blanks are not considered printable. Thus, */ -/* for character arrays padded with blanks, PCWID is */ -/* equivalent to NBWID. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Find the last printable character in the first element of the */ -/* array. Search the rest of the elements, starting at the end of */ -/* each string and moving back just far enough to determine if the */ -/* current string is wider than any of the previous ones. (This */ -/* makes PCWID somewhat more efficient than LASTPC.) */ - -/* If any of the strings is found to end in a printable character, */ -/* PCWID is just the length of the individual elements of the array, */ -/* and the search is discontinued immediately. */ - -/* $ Examples */ - -/* Let ARRAY contain the following strings, */ - -/* ARRAY(1) = 'A string of medium length' */ -/* ARRAY(2) = 'A very long string, much longer than the rest' */ -/* ARRAY(3) = 'Shorter' */ -/* ARRAY(4) = 'Short' */ - -/* padded to length 47 with null characters instead of blanks. */ -/* Then the value returned by */ - -/* WIDEST = PCWID ( ARRAY, 4 ) */ - -/* is 45. */ - -/* If the word 'rest' in the second element is changed to 'others', */ -/* the value returned is 47, and the search is terminated after the */ -/* second element. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* printable width of a character array */ - -/* -& */ - -/* Local variables */ - - -/* Nonsense case: no elements. */ - - if (*nelt < 1) { - ret_val = 0; - -/* Get the length of the individual elements of the string. */ -/* So far, we have no maximum width, because we haven't examined */ -/* any elements. */ - - } else { - strlen = i_len(array, array_len); - ret_val = 0; - i__ = 0; - -/* Continue until the end of the array is reached, or until */ -/* a string with no trailing non-printing characters is found. */ - - while(i__ < *nelt && ret_val < strlen) { - -/* Search no further than the current value of PCWID. */ - - ++i__; - j = strlen; - while(j > ret_val && *(unsigned char *)&array[(i__ - 1) * - array_len + (j - 1)] < 33 && *(unsigned char *)&array[( - i__ - 1) * array_len + (j - 1)] > 126) { - --j; - } - -/* PCWID only increases if this string was wider than all */ -/* previous strings. */ - - ret_val = max(ret_val,j); - } - } - return ret_val; -} /* pcwid_ */ - diff --git a/ext/spice/src/cspice/pdpool_c.c b/ext/spice/src/cspice/pdpool_c.c deleted file mode 100644 index 9fff32ce03..0000000000 --- a/ext/spice/src/cspice/pdpool_c.c +++ /dev/null @@ -1,270 +0,0 @@ -/* - --Procedure pdpool_c ( Put d.p.'s into the kernel pool ) - --Abstract - - This entry point provides toolkit programmers a method for - programmatically inserting double precision data into the - kernel pool. - --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 - - POOL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef pdpool_c - - - void pdpool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceDouble * dvals ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I The kernel pool name to associate with dvals. - n I The number of values to insert. - dvals I An array of values to insert into the kernel pool. - --Detailed_Input - - name is the name of the kernel pool variable to associate - with the values supplied in the array dvals. 'name' is - restricted to a length of 32 characters or less. - - n is the number of values to insert into the kernel pool. - - dvals is an array of d.p. values to insert into the kernel - pool. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If name is already present in the kernel pool and there - is sufficient room to hold all values supplied in dvals, - the old values associated with name will be overwritten. - - 2) If there is not sufficient room to insert a new variable - into the kernel pool and name is not already present in - the kernel pool, the error SPICE(KERNELPOOLFULL) is - signaled by a routine in the call tree to this routine. - - 3) If there is not sufficient room to insert the values associated - with name, the error SPICE(NOMOREROOM) will be signaled. - - 4) If the input string pointer name is null, the error - SPICE(NULLPOINTER) will be signaled. - - 5) If the input string name has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 6) The error 'SPICE(BADVARNAME)' signals if the kernel pool - variable name length exceeds 32. - --Files - - None. - --Particulars - - This entry point provides a programmatic interface for inserting - data into the SPICE kernel pool without reading an external file. - --Examples - - The following example program shows how a topocentric frame for a - point on the surface of the earth may be defined at run time using - pcpool_c, pdpool_c, and pipool_c. In this example, the surface - point is associated with the body code 300000. To facilitate - testing, the location of the surface point coincides with that of - the DSN station DSS-12; the reference frame MYTOPO defined here - coincides with the reference frame DSS-12_TOPO. - - #include - #include "SpiceUsr.h" - - int main() - { - /. - The first angle is the negative of the longitude of the - surface point; the second angle is the negative of the - point's colatitude. - ./ - SpiceDouble angles [3] = { -243.1945102442646, - -54.7000629043147, - 180.0 }; - - SpiceDouble et = 0.0; - SpiceDouble rmat [3][3]; - - SpiceInt axes [3] = { 3, 2, 3 }; - SpiceInt center = 300000; - SpiceInt frclass = 4; - SpiceInt frclsid = 1500000; - SpiceInt frcode = 1500000; - - /. - Define the MYTOPO reference frame. - - Note that the third argument in the pcpool_c calls is - the length of the final string argument, including the - terminating null character. - ./ - pipool_c ( "FRAME_MYTOPO", 1, &frcode ); - pcpool_c ( "FRAME_1500000_NAME", 1, 7, "MYTOPO" ); - pipool_c ( "FRAME_1500000_CLASS", 1, &frclass ); - pipool_c ( "FRAME_1500000_CLASS_ID", 1, &frclsid ); - pipool_c ( "FRAME_1500000_CENTER", 1, ¢er ); - - pcpool_c ( "OBJECT_300000_FRAME", 1, 7, "MYTOPO" ); - - pcpool_c ( "TKFRAME_MYTOPO_RELATIVE", 1, 7, "ITRF93" ); - pcpool_c ( "TKFRAME_MYTOPO_SPEC", 1, 7, "ANGLES" ); - pcpool_c ( "TKFRAME_MYTOPO_UNITS", 1, 8, "DEGREES" ); - pipool_c ( "TKFRAME_MYTOPO_AXES", 3, axes ); - pdpool_c ( "TKFRAME_MYTOPO_ANGLES", 3, angles ); - - /. - Load a high precision binary earth PCK. Also load a - topocentric frame kernel for DSN stations. The file names - shown here are simply examples; users should replace these - with the names of appropriate kernels. - ./ - furnsh_c ( "earth_000101_060207_051116.bpc" ); - furnsh_c ( "earth_topo_050714.tf" ); - - /. - Look up transformation from DSS-12_TOPO frame to MYTOPO frame. - This transformation should differ by round-off error from - the identity matrix. - ./ - pxform_c ( "DSS-12_TOPO", "MYTOPO", et, rmat ); - - printf ( "\n" - "DSS-12_TOPO to MYTOPO transformation at " - "et %23.16e = \n" - "\n" - " %25.16f %25.16f %25.16f\n" - " %25.16f %25.16f %25.16f\n" - " %25.16f %25.16f %25.16f\n", - et, - rmat[0][0], rmat[0][1], rmat[0][2], - rmat[1][0], rmat[1][1], rmat[1][2], - rmat[2][0], rmat[2][1], rmat[2][2] ); - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.2, 10-FEB-2010 (EDW) - - Added mention of the restriction on kernel pool variable - names to 32 characters or less. - - Reordered header sections to conform to SPICE convention. - - -CSPICE Version 1.1.1, 17-NOV-2005 (NJB) - - Replaced code fragment in Examples section of header with - smaller, complete program. - - -CSPICE Version 1.1.0, 24-JUL-2001 (NJB) - - Changed prototype: input dvals is now type (ConstSpiceDouble *). - Implemented interface macro for casting input dvals to const. - - -CSPICE Version 1.0.0, 03-JUN-1999 (NJB) (WLT) - --Index_Entries - - Set the value of a d.p. kernel pool variable - --& -*/ - -{ /* Begin pdpool_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "pdpool_c" ); - - - /* - Check the input kernel variable name to make sure the pointer is - non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pdpool_c", name ); - - /* - Call the f2c'd routine. - */ - pdpool_ ( ( char * ) name, - ( integer * ) &n, - ( doublereal * ) dvals, - ( ftnlen ) strlen(name) ); - - - chkout_c ( "pdpool_c" ); - -} /* End pdpool_c */ diff --git a/ext/spice/src/cspice/pgrrec.c b/ext/spice/src/cspice/pgrrec.c deleted file mode 100644 index 7ee4fd1184..0000000000 --- a/ext/spice/src/cspice/pgrrec.c +++ /dev/null @@ -1,614 +0,0 @@ -/* pgrrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure PGRREC ( Planetographic to rectangular ) */ -/* Subroutine */ int pgrrec_(char *body, doublereal *lon, doublereal *lat, - doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan, - ftnlen body_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer sense; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), bods2c_(char *, integer *, logical *, - ftnlen), georec_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - integer bodyid; - doublereal geolon; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen); - char kvalue[80]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char pmkvar[32], pgrlon[4]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen); - extern integer plnsns_(integer *); - extern logical return_(void); - char tmpstr[32]; - -/* $ Abstract */ - -/* Convert planetographic coordinates to rectangular coordinates. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ -/* PCK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Body with which coordinate system is associated. */ -/* LON I Planetographic longitude of a point (radians). */ -/* LAT I Planetographic latitude of a point (radians). */ -/* ALT I Altitude of a point above reference spheroid. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* RECTAN O Rectangular coordinates of the point. */ - -/* $ Detailed_Input */ - -/* BODY Name of the body with which the planetographic */ -/* coordinate system is associated. */ - -/* BODY is used by this routine to look up from the */ -/* kernel pool the prime meridian rate coefficient giving */ -/* the body's spin sense. See the Files and Particulars */ -/* header sections below for details. */ - -/* LON Planetographic longitude of the input point. This is */ -/* the angle between the prime meridian and the meridian */ -/* containing the input point. For bodies having */ -/* prograde (aka direct) rotation, the direction of */ -/* increasing longitude is positive west: from the +X */ -/* axis of the rectangular coordinate system toward the */ -/* -Y axis. For bodies having retrograde rotation, the */ -/* direction of increasing longitude is positive east: */ -/* from the +X axis toward the +Y axis. */ - -/* The earth, moon, and sun are exceptions: */ -/* planetographic longitude is measured positive east for */ -/* these bodies. */ - -/* The default interpretation of longitude by this */ -/* and the other planetographic coordinate conversion */ -/* routines can be overridden; see the discussion in */ -/* Particulars below for details. */ - -/* Longitude is measured in radians. On input, the range */ -/* of longitude is unrestricted. */ - -/* LAT Planetographic latitude of the input point. For a */ -/* point P on the reference spheroid, this is the angle */ -/* between the XY plane and the outward normal vector at */ -/* P. For a point P not on the reference spheroid, the */ -/* planetographic latitude is that of the closest point */ -/* to P on the spheroid. */ - -/* Latitude is measured in radians. On input, the */ -/* range of latitude is unrestricted. */ - -/* ALT Altitude of point above the reference spheroid. */ -/* Units of ALT must match those of RE. */ - -/* RE Equatorial radius of a reference spheroid. This */ -/* spheroid is a volume of revolution: its horizontal */ -/* cross sections are circular. The shape of the */ -/* spheroid is defined by an equatorial radius RE and */ -/* a polar radius RP. Units of RE must match those of */ -/* ALT. */ - -/* F Flattening coefficient = */ - -/* (RE-RP) / RE */ - -/* where RP is the polar radius of the spheroid, and the */ -/* units of RP match those of RE. */ - -/* $ Detailed_Output */ - -/* RECTAN The rectangular coordinates of the input point. See */ -/* the discussion below in the Particulars header section */ -/* for details. */ - -/* The units associated with RECTAN are those associated */ -/* with the inputs ALT and RE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */ -/* and if BODY is not a string representation of an integer, */ -/* the error SPICE(IDCODENOTFOUND) will be signaled. */ - -/* 2) If the kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* is present in the kernel pool but has a value other */ -/* than one of */ - -/* 'EAST' */ -/* 'WEST' */ - -/* the error SPICE(INVALIDOPTION) will be signaled. Case */ -/* and blanks are ignored when these values are interpreted. */ - -/* 3) If polynomial coefficients for the prime meridian of BODY */ -/* are not available in the kernel pool, and if the kernel */ -/* variable BODY_PGR_POSITIVE_LON is not present in */ -/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */ - -/* 4) If the equatorial radius is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 5) If the flattening coefficient is greater than or equal to one, */ -/* the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* $ Files */ - -/* This routine expects a kernel variable giving BODY's prime */ -/* meridian angle as a function of time to be available in the */ -/* kernel pool. Normally this item is provided by loading a PCK */ -/* file. The required kernel variable is named */ - -/* BODY_PM */ - -/* where represents a string containing the NAIF integer */ -/* ID code for BODY. For example, if BODY is 'JUPITER', then */ -/* the name of the kernel variable containing the prime meridian */ -/* angle coefficients is */ - -/* BODY599_PM */ - -/* See the PCK Required Reading for details concerning the prime */ -/* meridian kernel variable. */ - -/* The optional kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* also is normally defined via loading a text kernel. When this */ -/* variable is present in the kernel pool, the prime meridian */ -/* coefficients for BODY are not required by this routine. See the */ -/* Particulars section below for details. */ - -/* $ Particulars */ - -/* Given the planetographic coordinates of a point, this routine */ -/* returns the body-fixed rectangular coordinates of the point. The */ -/* body-fixed rectangular frame is that having the X-axis pass */ -/* through the 0 degree latitude 0 degree longitude direction, the */ -/* Z-axis pass through the 90 degree latitude direction, and the */ -/* Y-axis equal to the cross product of the unit Z-axis and X-axis */ -/* vectors. */ - -/* The planetographic definition of latitude is identical to the */ -/* planetodetic (also called "geodetic" in SPICE documentation) */ -/* definition. In the planetographic coordinate system, latitude is */ -/* defined using a reference spheroid. The spheroid is */ -/* characterized by an equatorial radius and a polar radius. For a */ -/* point P on the spheroid, latitude is defined as the angle between */ -/* the X-Y plane and the outward surface normal at P. For a point P */ -/* off the spheroid, latitude is defined as the latitude of the */ -/* nearest point to P on the spheroid. Note if P is an interior */ -/* point, for example, if P is at the center of the spheroid, there */ -/* may not be a unique nearest point to P. */ - -/* In the planetographic coordinate system, longitude is defined */ -/* using the spin sense of the body. Longitude is positive to the */ -/* west if the spin is prograde and positive to the east if the spin */ -/* is retrograde. The spin sense is given by the sign of the first */ -/* degree term of the time-dependent polynomial for the body's prime */ -/* meridian Euler angle "W": the spin is retrograde if this term is */ -/* negative and prograde otherwise. For the sun, planets, most */ -/* natural satellites, and selected asteroids, the polynomial */ -/* expression for W may be found in a SPICE PCK kernel. */ - -/* The earth, moon, and sun are exceptions: planetographic longitude */ -/* is measured positive east for these bodies. */ - -/* If you wish to override the default sense of positive longitude */ -/* for a particular body, you can do so by defining the kernel */ -/* variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* where represents the NAIF ID code of the body. This */ -/* variable may be assigned either of the values */ - -/* 'WEST' */ -/* 'EAST' */ - -/* For example, you can have this routine treat the longitude */ -/* of the earth as increasing to the west using the kernel */ -/* variable assignment */ - -/* BODY399_PGR_POSITIVE_LON = 'WEST' */ - -/* Normally such assignments are made by placing them in a text */ -/* kernel and loading that kernel via FURNSH. */ - -/* The definition of this kernel variable controls the behavior of */ -/* the SPICELIB planetographic routines */ - -/* PGRREC */ -/* RECPGR */ -/* DPGRDR */ -/* DRDPGR */ - -/* It does not affect the other SPICELIB coordinate conversion */ -/* routines. */ - -/* $ Examples */ - -/* Numerical results shown for this example may differ between */ -/* platforms as the results depend on the SPICE kernels used as */ -/* input and the machine specific arithmetic implementation. */ - - -/* 1) Find the rectangular coordinates of the point having Mars */ -/* planetographic coordinates: */ - -/* longitude = 90 degrees west */ -/* latitude = 45 degrees north */ -/* altitude = 300 km */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION RPD */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION F */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION RADII ( 3 ) */ -/* DOUBLE PRECISION RE */ -/* DOUBLE PRECISION RECTAN ( 3 ) */ -/* DOUBLE PRECISION RP */ - -/* INTEGER N */ -/* C */ -/* C Load a PCK file containing a triaxial */ -/* C ellipsoidal shape model and orientation */ -/* C data for Mars. */ -/* C */ -/* CALL FURNSH ( 'pck00008.tpc' ) */ - -/* C */ -/* C Look up the radii for Mars. Although we */ -/* C omit it here, we could first call BADKPV */ -/* C to make sure the variable BODY499_RADII */ -/* C has three elements and numeric data type. */ -/* C If the variable is not present in the kernel */ -/* C pool, BODVRD will signal an error. */ -/* C */ -/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */ - -/* C */ -/* C Compute flattening coefficient. */ -/* C */ -/* RE = RADII(1) */ -/* RP = RADII(3) */ -/* F = ( RE - RP ) / RE */ - -/* C */ -/* C Do the conversion. Note that we must provide */ -/* C longitude and latitude in radians. */ -/* C */ -/* LON = 90.D0 * RPD() */ -/* LAT = 45.D0 * RPD() */ -/* ALT = 3.D2 */ - -/* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Planetographic coordinates:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Longitude (deg) = ', LON / RPD() */ -/* WRITE (*,*) ' Latitude (deg) = ', LAT / RPD() */ -/* WRITE (*,*) ' Altitude (km) = ', ALT */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Ellipsoid shape parameters: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Equatorial radius (km) = ', RE */ -/* WRITE (*,*) ' Polar radius (km) = ', RP */ -/* WRITE (*,*) ' Flattening coefficient = ', F */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Rectangular coordinates:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' X (km) = ', RECTAN(1) */ -/* WRITE (*,*) ' Y (km) = ', RECTAN(2) */ -/* WRITE (*,*) ' Z (km) = ', RECTAN(3) */ -/* WRITE (*,*) ' ' */ - -/* END */ - - -/* Output from this program should be similar to the following */ -/* (rounding and formatting differ across platforms): */ - -/* Planetographic coordinates: */ - -/* Longitude (deg) = 90. */ -/* Latitude (deg) = 45. */ -/* Altitude (km) = 300. */ - -/* Ellipsoid shape parameters: */ - -/* Equatorial radius (km) = 3396.19 */ -/* Polar radius (km) = 3376.2 */ -/* Flattening coefficient = 0.00588600756 */ - -/* Rectangular coordinates: */ - -/* X (km) = 1.60465003E-13 */ -/* Y (km) = -2620.67891 */ -/* Z (km) = 2592.40891 */ - - -/* 2) Below is a table showing a variety of rectangular coordinates */ -/* and the corresponding Mars planetographic coordinates. The */ -/* values are computed using the reference spheroid having radii */ - -/* Equatorial radius: 3397 */ -/* Polar radius: 3375 */ - -/* Note: the values shown above may not be current or suitable */ -/* for your application. */ - - -/* Corresponding rectangular and planetographic coordinates are */ -/* listed to three decimal places. */ - - -/* RECTAN(1) RECTAN(2) RECTAN(3) LON LAT ALT */ -/* ------------------------------------------------------------------ */ -/* 3397.000 0.000 0.000 0.000 0.000 0.000 */ -/* -3397.000 0.000 0.000 180.000 0.000 0.000 */ -/* -3407.000 0.000 0.000 180.000 0.000 10.000 */ -/* -3387.000 0.000 0.000 180.000 0.000 -10.000 */ -/* 0.000 -3397.000 0.000 90.000 0.000 0.000 */ -/* 0.000 3397.000 0.000 270.000 0.000 0.000 */ -/* 0.000 0.000 3375.000 0.000 90.000 0.000 */ -/* 0.000 0.000 -3375.000 0.000 -90.000 0.000 */ -/* 0.000 0.000 0.000 0.000 90.000 -3375.000 */ - - - -/* 3) Below we show the analogous relationships for the earth, */ -/* using the reference ellipsoid radii */ - -/* Equatorial radius: 6378.140 */ -/* Polar radius: 6356.750 */ - -/* Note the change in longitudes for points on the +/- Y axis */ -/* for the earth vs the Mars values. */ - - -/* RECTAN(1) RECTAN(2) RECTAN(3) LON LAT ALT */ -/* ------------------------------------------------------------------ */ -/* 6378.140 0.000 0.000 0.000 0.000 0.000 */ -/* -6378.140 0.000 0.000 180.000 0.000 0.000 */ -/* -6388.140 0.000 0.000 180.000 0.000 10.000 */ -/* -6368.140 0.000 0.000 180.000 0.000 -10.000 */ -/* 0.000 -6378.140 0.000 270.000 0.000 0.000 */ -/* 0.000 6378.140 0.000 90.000 0.000 0.000 */ -/* 0.000 0.000 6356.750 0.000 90.000 0.000 */ -/* 0.000 0.000 -6356.750 0.000 -90.000 0.000 */ -/* 0.000 0.000 0.000 0.000 90.000 -6356.750 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-DEC-2004 (CHA) (NJB) (HAN) (BVS) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert planetographic to rectangular coordinates */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("PGRREC", (ftnlen)6); - -/* Convert the body name to an ID code. */ - - bods2c_(body, &bodyid, &found, body_len); - if (! found) { - setmsg_("The value of the input argument BODY is #, this is not a re" - "cognized name of an ephemeris object. The cause of this prob" - "lem may be that you need an updated version of the SPICE Too" - "lkit. ", (ftnlen)185); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("PGRREC", (ftnlen)6); - return 0; - } - -/* The equatorial radius must be positive. If not, signal an error */ -/* and check out. */ - - if (*re <= 0.) { - setmsg_("Equatorial radius was #.", (ftnlen)24); - errdp_("#", re, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("PGRREC", (ftnlen)6); - return 0; - } - -/* If the flattening coefficient is greater than 1, the polar radius */ -/* is negative. If F is equal to 1, the polar radius is zero. Either */ -/* case is a problem, so signal an error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was #.", (ftnlen)29); - errdp_("#", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("PGRREC", (ftnlen)6); - return 0; - } - -/* Look up the longitude sense override variable from the */ -/* kernel pool. */ - - repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, ( - ftnlen)1, (ftnlen)32); - gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80); - if (found) { - -/* Make sure we recognize the value of PGRLON. */ - - cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32) - ; - ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4); - if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) { - sense = 1; - } else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) { - sense = -1; - } else { - setmsg_("Kernel variable # may have the values EAST or WEST. Ac" - "tual value was #.", (ftnlen)72); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", kvalue, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("PGRREC", (ftnlen)6); - return 0; - } - } else { - -/* Look up the spin sense of the body's prime meridian. */ - - sense = plnsns_(&bodyid); - -/* If the required prime meridian rate was not available, */ -/* PLNSNS returns the code 0. Here we consider this situation */ -/* to be an error. */ - - if (sense == 0) { - repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, ( - ftnlen)32); - setmsg_("Prime meridian rate coefficient defined by kernel varia" - "ble # is required but not available for body #. ", ( - ftnlen)103); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(MISSINGDATA)", (ftnlen)18); - chkout_("PGRREC", (ftnlen)6); - return 0; - } - -/* Handle the special cases: earth, moon, and sun. */ - - if (bodyid == 399 || bodyid == 301 || bodyid == 10) { - sense = 1; - } - } - -/* At this point, SENSE is set to +/- 1. */ - -/* Adjust the longitude according to the sense of the body's */ -/* spin, or according to the override value if one is provided. */ -/* We want positive east longitude. */ - - geolon = sense * *lon; - -/* Now that we have geodetic longitude in hand, convert the geodetic */ -/* equivalent of the input coordinates to rectangular coordinates. */ - - georec_(&geolon, lat, alt, re, f, rectan); - chkout_("PGRREC", (ftnlen)6); - return 0; -} /* pgrrec_ */ - diff --git a/ext/spice/src/cspice/pgrrec_c.c b/ext/spice/src/cspice/pgrrec_c.c deleted file mode 100644 index 9e29135a9e..0000000000 --- a/ext/spice/src/cspice/pgrrec_c.c +++ /dev/null @@ -1,521 +0,0 @@ -/* - --Procedure pgrrec_c ( Planetographic to rectangular ) - --Abstract - - Convert planetographic coordinates to rectangular coordinates. - --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 - - KERNEL - NAIF_IDS - PCK - --Keywords - - CONVERSION - COORDINATES - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void pgrrec_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - body I Body with which coordinate system is associated. - lon I Planetographic longitude of a point (radians). - lat I Planetographic latitude of a point (radians). - alt I Altitude of a point above reference spheroid. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - rectan O Rectangular coordinates of the point. - --Detailed_Input - - body Name of the body with which the planetographic - coordinate system is associated. - - `body' is used by this routine to look up from the - kernel pool the prime meridian rate coefficient giving - the body's spin sense. See the Files and Particulars - header sections below for details. - - lon Planetographic longitude of the input point. This is - the angle between the prime meridian and the meridian - containing the input point. For bodies having - prograde (aka direct) rotation, the direction of - increasing longitude is positive west: from the +X - axis of the rectangular coordinate system toward the - -Y axis. For bodies having retrograde rotation, the - direction of increasing longitude is positive east: - from the +X axis toward the +Y axis. - - The earth, moon, and sun are exceptions: - planetographic longitude is measured positive east for - these bodies. - - The default interpretation of longitude by this - and the other planetographic coordinate conversion - routines can be overridden; see the discussion in - Particulars below for details. - - Longitude is measured in radians. On input, the range - of longitude is unrestricted. - - lat Planetographic latitude of the input point. For a - point P on the reference spheroid, this is the angle - between the XY plane and the outward normal vector at - P. For a point P not on the reference spheroid, the - planetographic latitude is that of the closest point - to P on the spheroid. - - Latitude is measured in radians. On input, the - range of latitude is unrestricted. - - alt Altitude of point above the reference spheroid. - Units of `alt' must match those of `re'. - - re Equatorial radius of a reference spheroid. This - spheroid is a volume of revolution: its horizontal - cross sections are circular. The shape of the - spheroid is defined by an equatorial radius `re' and - a polar radius `rp'. Units of `re' must match those of - `alt'. - - f Flattening coefficient = - - (re-rp) / re - - where `rp' is the polar radius of the spheroid, and the - units of `rp' match those of `re'. - --Detailed_Output - - rectan The rectangular coordinates of the input point. See - the discussion below in the Particulars header section - for details. - - The units associated with `rectan' are those associated - with the inputs `alt' and `re'. - --Parameters - - None. - --Exceptions - - 1) If the body name `body' cannot be mapped to a NAIF ID code, - and if `body' is not a string representation of an integer, - the error SPICE(IDCODENOTFOUND) will be signaled. - - 2) If the kernel variable - - BODY_PGR_POSITIVE_LON - - is present in the kernel pool but has a value other - than one of - - 'EAST' - 'WEST' - - the error SPICE(INVALIDOPTION) will be signaled. Case - and blanks are ignored when these values are interpreted. - - 3) If polynomial coefficients for the prime meridian of `body' - are not available in the kernel pool, and if the kernel - variable BODY_PGR_POSITIVE_LON is not present in - the kernel pool, the error SPICE(MISSINGDATA) will be signaled. - - 4) If the equatorial radius is non-positive, the error - SPICE(VALUEOUTOFRANGE) is signaled. - - 5) If the flattening coefficient is greater than or equal to one, - the error SPICE(VALUEOUTOFRANGE) is signaled. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input - string `body' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `body' is null. - --Files - - This routine expects a kernel variable giving body's prime - meridian angle as a function of time to be available in the - kernel pool. Normally this item is provided by loading a PCK - file. The required kernel variable is named - - BODY_PM - - where represents a string containing the NAIF integer - ID code for `body'. For example, if `body' is "JUPITER", then - the name of the kernel variable containing the prime meridian - angle coefficients is - - BODY599_PM - - See the PCK Required Reading for details concerning the prime - meridian kernel variable. - - The optional kernel variable - - BODY_PGR_POSITIVE_LON - - also is normally defined via loading a text kernel. When this - variable is present in the kernel pool, the prime meridian - coefficients for `body' are not required by this routine. See the - Particulars section below for details. - --Particulars - - Given the planetographic coordinates of a point, this routine - returns the body-fixed rectangular coordinates of the point. The - body-fixed rectangular frame is that having the X-axis pass - through the 0 degree latitude 0 degree longitude direction, the - Z-axis pass through the 90 degree latitude direction, and the - Y-axis equal to the cross product of the unit Z-axis and X-axis - vectors. - - The planetographic definition of latitude is identical to the - planetodetic (also called "geodetic" in SPICE documentation) - definition. In the planetographic coordinate system, latitude is - defined using a reference spheroid. The spheroid is - characterized by an equatorial radius and a polar radius. For a - point P on the spheroid, latitude is defined as the angle between - the X-Y plane and the outward surface normal at P. For a point P - off the spheroid, latitude is defined as the latitude of the - nearest point to P on the spheroid. Note if P is an interior - point, for example, if P is at the center of the spheroid, there - may not be a unique nearest point to P. - - In the planetographic coordinate system, longitude is defined - using the spin sense of the body. Longitude is positive to the - west if the spin is prograde and positive to the east if the spin - is retrograde. The spin sense is given by the sign of the first - degree term of the time-dependent polynomial for the body's prime - meridian Euler angle "W": the spin is retrograde if this term is - negative and prograde otherwise. For the sun, planets, most - natural satellites, and selected asteroids, the polynomial - expression for W may be found in a SPICE PCK kernel. - - The earth, moon, and sun are exceptions: planetographic longitude - is measured positive east for these bodies. - - If you wish to override the default sense of positive longitude - for a particular body, you can do so by defining the kernel - variable - - BODY_PGR_POSITIVE_LON - - where represents the NAIF ID code of the body. This - variable may be assigned either of the values - - 'WEST' - 'EAST' - - For example, you can have this routine treat the longitude - of the earth as increasing to the west using the kernel - variable assignment - - BODY399_PGR_POSITIVE_LON = 'WEST' - - Normally such assignments are made by placing them in a text - kernel and loading that kernel via furnsh_c. - - The definition of this kernel variable controls the behavior of - the CSPICE planetographic routines - - pgrrec_c - recpgr_c - dpgrdr_c - drdpgr_c - - It does not affect the other CSPICE coordinate conversion - routines. - --Examples - - Numerical results shown for this example may differ between - platforms as the results depend on the SPICE kernels used as - input and the machine specific arithmetic implementation. - - - 1) Find the rectangular coordinates of the point having Mars - planetographic coordinates: - - longitude = 90 degrees west - latitude = 45 degrees north - altitude = 300 km - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local variables - ./ - SpiceDouble alt; - SpiceDouble f; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble radii [3]; - SpiceDouble re; - SpiceDouble rectan [3]; - SpiceDouble rp; - - SpiceInt n; - - - /. - Load a PCK file containing a triaxial - ellipsoidal shape model and orientation - data for Mars. - ./ - furnsh_c ( "pck00008.tpc" ); - - /. - Look up the radii for Mars. Although we - omit it here, we could first call badkpv_c - to make sure the variable BODY499_RADII - has three elements and numeric data type. - If the variable is not present in the kernel - pool, bodvrd_c will signal an error. - ./ - bodvrd_c ( "MARS", "RADII", 3, &n, radii ); - - /. - Compute flattening coefficient. - ./ - re = radii[0]; - rp = radii[2]; - f = ( re - rp ) / re; - - /. - Do the conversion. Note that we must provide - longitude and latitude in radians. - ./ - lon = 90.0 * rpd_c(); - lat = 45.0 * rpd_c(); - alt = 3.e2; - - pgrrec_c ( "mars", lon, lat, alt, re, f, rectan ); - - - printf ( "\n" - "Planetographic coordinates:\n" - "\n" - " Longitude (deg) = %18.9e\n" - " Latitude (deg) = %18.9e\n" - " Altitude (km) = %18.9e\n" - "\n" - "Ellipsoid shape parameters:\n" - "\n" - " Equatorial radius (km) = %18.9e\n" - " Polar radius (km) = %18.9e\n" - " Flattening coefficient = %18.9e\n" - "\n" - "Rectangular coordinates:\n" - "\n" - " X (km) = %18.9e\n" - " Y (km) = %18.9e\n" - " Z (km) = %18.9e\n" - "\n", - lon / rpd_c(), - lat / rpd_c(), - alt, - re, - rp, - f, - rectan[0], - rectan[1], - rectan[2] ); - - return ( 0 ); - } - - - Output from this program should be similar to the following - (rounding and formatting differ across platforms): - - - Planetographic coordinates: - - Longitude (deg) = 9.000000000e+01 - Latitude (deg) = 4.500000000e+01 - Altitude (km) = 3.000000000e+02 - - Ellipsoid shape parameters: - - Equatorial radius (km) = 3.396190000e+03 - Polar radius (km) = 3.376200000e+03 - Flattening coefficient = 5.886007556e-03 - - Rectangular coordinates: - - X (km) = 1.604650025e-13 - Y (km) = -2.620678915e+03 - Z (km) = 2.592408909e+03 - - - - 2) Below is a table showing a variety of rectangular coordinates - and the corresponding Mars planetographic coordinates. The - values are computed using the reference spheroid having radii - - Equatorial radius: 3397 - Polar radius: 3375 - - Note: the values shown above may not be current or suitable - for your application. - - - Corresponding rectangular and planetographic coordinates are - listed to three decimal places. - - rectan[0] rectan[1] rectan[2] lon lat alt - ------------------------------------------------------------------ - 3397.000 0.000 0.000 0.000 0.000 0.000 - -3397.000 0.000 0.000 180.000 0.000 0.000 - -3407.000 0.000 0.000 180.000 0.000 10.000 - -3387.000 0.000 0.000 180.000 0.000 -10.000 - 0.000 -3397.000 0.000 90.000 0.000 0.000 - 0.000 3397.000 0.000 270.000 0.000 0.000 - 0.000 0.000 3375.000 0.000 90.000 0.000 - 0.000 0.000 -3375.000 0.000 -90.000 0.000 - 0.000 0.000 0.000 0.000 90.000 -3375.000 - - - - 3) Below we show the analogous relationships for the earth, - using the reference ellipsoid radii - - Equatorial radius: 6378.140 - Polar radius: 6356.750 - - Note the change in longitudes for points on the +/- Y axis - for the earth vs the Mars values. - - rectan[0] rectan[1] rectan[2] lon lat alt - ------------------------------------------------------------------ - 6378.140 0.000 0.000 0.000 0.000 0.000 - -6378.140 0.000 0.000 180.000 0.000 0.000 - -6388.140 0.000 0.000 180.000 0.000 10.000 - -6368.140 0.000 0.000 180.000 0.000 -10.000 - 0.000 -6378.140 0.000 270.000 0.000 0.000 - 0.000 6378.140 0.000 90.000 0.000 0.000 - 0.000 0.000 6356.750 0.000 90.000 0.000 - 0.000 0.000 -6356.750 0.000 -90.000 0.000 - 0.000 0.000 0.000 0.000 90.000 -6356.750 - - --Restrictions - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - H.A. Neilan (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 26-DEC-2004 (CHA) (NJB) (HAN) (BVS) (WLT) - --Index_Entries - - convert planetographic to rectangular coordinates - --& -*/ - -{ /* Begin pgrrec_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "pgrrec_c" ); - - - /* - Check the input string body to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pgrrec_c", body ); - - - /* - Call the f2c'd Fortran routine. - */ - pgrrec_ ( ( char * ) body, - ( doublereal * ) &lon, - ( doublereal * ) &lat, - ( doublereal * ) &alt, - ( doublereal * ) &re, - ( doublereal * ) &f, - ( doublereal * ) rectan, - ( ftnlen ) strlen(body) ); - - - - chkout_c ( "pgrrec_c" ); - -} /* End pgrrec_c */ diff --git a/ext/spice/src/cspice/pi.c b/ext/spice/src/cspice/pi.c deleted file mode 100644 index 8959ba4cf5..0000000000 --- a/ext/spice/src/cspice/pi.c +++ /dev/null @@ -1,159 +0,0 @@ -/* pi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PI ( Value of pi ) */ -doublereal pi_(void) -{ - /* Initialized data */ - - static doublereal value = 0.; - - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double acos(doublereal); - -/* $ Abstract */ - -/* Return the value of pi (the ratio of the circumference of */ -/* a circle to its diameter). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the value of pi. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the value of pi (the ratio of a circle's */ -/* circumference to its diameter), determined by the ACOS function. */ -/* That is, */ - -/* PI = ACOS ( -1.D0 ) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The first time the function is referenced, the value is computed */ -/* as shown above. The value is saved, and returned directly upon */ -/* subsequent reference. */ - -/* $ Examples */ - -/* The code fragment below illustrates the use of PI. */ - -/* C */ -/* C Compute the polar radius, */ -/* C */ -/* C p */ -/* C ---------------- */ -/* C 1 + e cos(theta) */ -/* C */ -/* C at evenly spaced values of the polar angle, theta. */ -/* C */ -/* DELTA = PI() / N */ - -/* DO I = 0, N */ -/* R(I) = P / (1.D0 + ECC * COS(I*DELTA)) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* value of pi */ - -/* -& */ - -/* Local variables */ - - -/* Initial values */ - - -/* What is there to say? */ - - if (value == 0.) { - value = acos(-1.); - } - ret_val = value; - return ret_val; -} /* pi_ */ - diff --git a/ext/spice/src/cspice/pi_c.c b/ext/spice/src/cspice/pi_c.c deleted file mode 100644 index bf10fc6d73..0000000000 --- a/ext/spice/src/cspice/pi_c.c +++ /dev/null @@ -1,148 +0,0 @@ -/* - --Procedure pi_c ( Value of pi ) - --Abstract - - Return the value of pi (the ratio of the circumference of - a circle to its diameter). - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble pi_c ( void ) - -/* - --Brief_I/O - - The function returns the value of pi. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value of pi (the ratio of a circle's - circumference to its diameter), determined by the ACOS function. - That is, - - pi_c = acos ( -1.0 ); - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The first time the function is referenced, the value is computed - as shown above. The value is saved, and returned directly upon - subsequent reference. - --Examples - - The code fragment below illustrates the use of pi_c. - - /. - Compute the polar radius, - - p - ---------------- - 1 + e cos(theta) - - at evenly spaced values of the polar angle, theta. - ./ - delta = pi_c() / n - - for ( i = 0; i < n, i++ ) - { - r[i] = p / (1.0 + ecc * cos( i * delta) ); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - value of pi - --& -*/ - -{ /* Begin pi_c */ - - /* - Local Variables - */ - - static SpiceDouble value = 0.; - - - if ( value == 0.) - { - value = acos( -1. ); - } - - - return value; - -} /* End pi_c */ diff --git a/ext/spice/src/cspice/pipool_c.c b/ext/spice/src/cspice/pipool_c.c deleted file mode 100644 index 0ffb95091b..0000000000 --- a/ext/spice/src/cspice/pipool_c.c +++ /dev/null @@ -1,269 +0,0 @@ -/* - --Procedure pipool_c ( Put integers into the kernel pool ) - --Abstract - - This entry point provides toolkit programmers a method for - programmatically inserting integer data into the kernel pool. - --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 - - POOL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef pipool_c - - - void pipool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceInt * ivals ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I The kernel pool name to associate with values. - n I The number of values to insert. - ivals I An array of integers to insert into the pool. - --Detailed_Input - - name is the name of the kernel pool variable to associate - with the values supplied in the array ivals. 'name' is - restricted to a length of 32 characters or less. - - n is the number of values to insert into the kernel pool. - - ivals is an array of integers to insert into the kernel pool. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If name is already present in the kernel pool and there - is sufficient room to hold all values supplied in values, - the old values associated with name will be overwritten. - - 2) If there is not sufficient room to insert a new variable - into the kernel pool and name is not already present in - the kernel pool, the error SPICE(KERNELPOOLFULL) is - signaled by a routine in the call tree to this routine. - - 3) If there is not sufficient room to insert the values associated - with name, the error SPICE(NOMOREROOM) will be signaled. - - 4) If the input string pointer name is null, the error - SPICE(NULLPOINTER) will be signaled. - - 5) If the input string name has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 6) The error 'SPICE(BADVARNAME)' signals if the kernel pool - variable name length exceeds 32. - --Files - - None. - --Particulars - - This entry point provides a programmatic interface for inserting - data into the SPICE kernel pool without reading an external file. - --Examples - - The following example program shows how a topocentric frame for a - point on the surface of the earth may be defined at run time using - pcpool_c, pdpool_c, and pipool_c. In this example, the surface - point is associated with the body code 300000. To facilitate - testing, the location of the surface point coincides with that of - the DSN station DSS-12; the reference frame MYTOPO defined here - coincides with the reference frame DSS-12_TOPO. - - #include - #include "SpiceUsr.h" - - int main() - { - /. - The first angle is the negative of the longitude of the - surface point; the second angle is the negative of the - point's colatitude. - ./ - SpiceDouble angles [3] = { -243.1945102442646, - -54.7000629043147, - 180.0 }; - - SpiceDouble et = 0.0; - SpiceDouble rmat [3][3]; - - SpiceInt axes [3] = { 3, 2, 3 }; - SpiceInt center = 300000; - SpiceInt frclass = 4; - SpiceInt frclsid = 1500000; - SpiceInt frcode = 1500000; - - /. - Define the MYTOPO reference frame. - - Note that the third argument in the pcpool_c calls is - the length of the final string argument, including the - terminating null character. - ./ - pipool_c ( "FRAME_MYTOPO", 1, &frcode ); - pcpool_c ( "FRAME_1500000_NAME", 1, 7, "MYTOPO" ); - pipool_c ( "FRAME_1500000_CLASS", 1, &frclass ); - pipool_c ( "FRAME_1500000_CLASS_ID", 1, &frclsid ); - pipool_c ( "FRAME_1500000_CENTER", 1, ¢er ); - - pcpool_c ( "OBJECT_300000_FRAME", 1, 7, "MYTOPO" ); - - pcpool_c ( "TKFRAME_MYTOPO_RELATIVE", 1, 7, "ITRF93" ); - pcpool_c ( "TKFRAME_MYTOPO_SPEC", 1, 7, "ANGLES" ); - pcpool_c ( "TKFRAME_MYTOPO_UNITS", 1, 8, "DEGREES" ); - pipool_c ( "TKFRAME_MYTOPO_AXES", 3, axes ); - pdpool_c ( "TKFRAME_MYTOPO_ANGLES", 3, angles ); - - /. - Load a high precision binary earth PCK. Also load a - topocentric frame kernel for DSN stations. The file names - shown here are simply examples; users should replace these - with the names of appropriate kernels. - ./ - furnsh_c ( "earth_000101_060207_051116.bpc" ); - furnsh_c ( "earth_topo_050714.tf" ); - - /. - Look up transformation from DSS-12_TOPO frame to MYTOPO frame. - This transformation should differ by round-off error from - the identity matrix. - ./ - pxform_c ( "DSS-12_TOPO", "MYTOPO", et, rmat ); - - printf ( "\n" - "DSS-12_TOPO to MYTOPO transformation at " - "et %23.16e = \n" - "\n" - " %25.16f %25.16f %25.16f\n" - " %25.16f %25.16f %25.16f\n" - " %25.16f %25.16f %25.16f\n", - et, - rmat[0][0], rmat[0][1], rmat[0][2], - rmat[1][0], rmat[1][1], rmat[1][2], - rmat[2][0], rmat[2][1], rmat[2][2] ); - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.2.2, 10-FEB-2010 (EDW) - - Added mention of the restriction on kernel pool variable - names to 32 characters or less. - - Reordered header sections to conform to SPICE convention. - - -CSPICE Version 1.2.1, 17-NOV-2005 (NJB) - - Replaced code fragment in Examples section of header with - smaller, complete program. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input array ivals. - - -CSPICE Version 1.0.0, 03-JUN-1999 (NJB) (WLT) - --Index_Entries - - Set the value of a numeric kernel pool variable - --& -*/ - -{ /* Begin pipool_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "pipool_c" ); - - - /* - Check the input kernel variable name to make sure the pointer is - non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pipool_c", name ); - - /* - Call the f2c'd routine. - */ - pipool_ ( ( char * ) name, - ( integer * ) &n, - ( integer * ) ivals, - ( ftnlen ) strlen(name) ); - - chkout_c ( "pipool_c" ); - -} /* End pipool_c */ - diff --git a/ext/spice/src/cspice/pjelpl.c b/ext/spice/src/cspice/pjelpl.c deleted file mode 100644 index c378ecf100..0000000000 --- a/ext/spice/src/cspice/pjelpl.c +++ /dev/null @@ -1,367 +0,0 @@ -/* pjelpl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PJELPL ( Project ellipse onto plane ) */ -/* Subroutine */ int pjelpl_(doublereal *elin, doublereal *plane, doublereal * - elout) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal const__; - extern /* Subroutine */ int vperp_(doublereal *, doublereal *, doublereal - *), vprjp_(doublereal *, doublereal *, doublereal *), el2cgv_( - doublereal *, doublereal *, doublereal *, doublereal *), cgv2el_( - doublereal *, doublereal *, doublereal *, doublereal *), pl2nvc_( - doublereal *, doublereal *, doublereal *); - doublereal prjvc1[3], prjvc2[3], center[3], normal[3], smajor[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal prjctr[3], sminor[3]; - extern logical return_(void); - -/* $ Abstract */ - -/* Project an ellipse onto a plane, orthogonally. */ - -/* $ 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 */ - -/* ELLIPSES */ -/* PLANES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELIN I A SPICELIB ellipse to be projected. */ -/* PLANE I A plane onto which ELIN is to be projected. */ -/* ELOUT O A SPICELIB ellipse resulting from the projection. */ - -/* $ Detailed_Input */ - -/* ELIN, */ -/* PLANE are, respectively, a SPICELIB ellipse and a */ -/* SPICELIB plane. The geometric ellipse represented */ -/* by ELIN is to be orthogonally projected onto the */ -/* geometric plane represented by PLANE. */ - -/* $ Detailed_Output */ - -/* ELOUT is a SPICELIB ellipse that represents the geometric */ -/* ellipse resulting from orthogonally projecting the */ -/* ellipse represented by INEL onto the plane */ -/* represented by PLANE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input plane is invalid, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 2) The input ellipse may be degenerate--its semi-axes may be */ -/* linearly dependent. Such ellipses are allowed as inputs. */ - -/* 3) The ellipse resulting from orthogonally projecting the input */ -/* ellipse onto a plane may be degenerate, even if the input */ -/* ellipse is not. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Projecting an ellipse orthogonally onto a plane can be thought of */ -/* finding the points on the plane that are `under' or `over' the */ -/* ellipse, with the `up' direction considered to be perpendicular */ -/* to the plane. More mathematically, the orthogonal projection is */ -/* the set of points Y in the plane such that for some point X in */ -/* the ellipse, the vector Y - X is perpendicular to the plane. */ -/* The orthogonal projection of an ellipse onto a plane yields */ -/* another ellipse. */ - -/* $ Examples */ - -/* 1) With CENTER = ( 1.D0, 1.D0, 1.D0 ), */ -/* VECT1 = ( 2.D0, 0.D0, 0.D0 ), */ -/* VECT2 = ( 0.D0, 1.D0, 1.D0 ), */ -/* NORMAL = ( 0.D0, 0.D0, 1.D0 ), */ - -/* the code fragment */ - -/* CALL NVC2PL ( NORMAL, 0.D0, PLANE ) */ -/* CALL CGV2EL ( CENTER, VECT1, VECT2, ELIN ) */ -/* CALL PJELPL ( ELIN, PLANE, ELOUT ) */ -/* CALL EL2CGV ( ELOUT, PRJCTR, PRJMAJ, PRJMIN ) */ - -/* returns */ - -/* PRJCTR = ( 1.D0, 1.D0, 0.D0 ) */ -/* PRJMAJ = ( 2.D0, 0.D0, 0.D0 ) */ -/* PRJMIN = ( 0.D0, 1.D0, 0.D0 ) */ - - -/* 2) With VECT1 = ( 2.D0, 0.D0, 0.D0 ), */ -/* VECT2 = ( 1.D0, 1.D0, 1.D0 ), */ -/* CENTER = ( 0.D0, 0.D0, 0.D0 ), */ -/* NORMAL = ( 0.D0, 0.D0, 1.D0 ), */ - -/* the code fragment */ - -/* CALL NVC2PL ( NORMAL, 0.D0, PLANE ) */ -/* CALL CGV2EL ( CENTER, VECT1, VECT2, ELIN ) */ -/* CALL PJELPL ( ELIN, PLANE, ELOUT ) */ -/* CALL EL2CGV ( ELOUT, PRJCTR, PRJMAJ, PRJMIN ) */ - -/* returns */ - -/* PRJCTR = ( 0.D0, 0.D0, 0.D0 ) */ - -/* PRJMAJ = ( -2.227032728823213D0, */ -/* -5.257311121191336D-1, */ -/* 0.D0 ) */ - -/* PRJMIN = ( 2.008114158862273D-1, */ -/* -8.506508083520399D-1, */ -/* 0.D0 ) */ - - - -/* 3) An example of actual use: Suppose we wish to compute the */ -/* distance from an ellipsoid to a line. Let the line be */ -/* defined by a point P and a direction vector DIRECT; the */ -/* line is the set of points */ - -/* P + t * DIRECT, */ - -/* where t is any real number. Let the ellipsoid have semi- */ -/* axis lengths A, B, and C. */ - -/* We can reduce the problem to that of finding the distance */ -/* between the line and an ellipse on the ellipsoid surface by */ -/* considering the fact that the surface normal at the nearest */ -/* point to the line will be orthogonal to DIRECT; the set of */ -/* surface points where this condition holds lies in a plane, */ -/* and hence is an ellipse on the surface. The problem can be */ -/* further simplified by projecting the ellipse orthogonally */ -/* onto the plane defined by */ - -/* < X, DIRECT > = 0. */ - -/* The problem is then a two dimensional one: find the */ -/* distance of the projected ellipse from the intersection of */ -/* the line and this plane (which is necessarily one point). */ -/* A `paraphrase' of the relevant code is: */ - - -/* C Step 1. Find the candidate ellipse CAND. */ -/* C NORMAL is a normal vector to the plane */ -/* C containing the candidate ellipse. The */ -/* C ellipse must exist, since it's the */ -/* C intersection of an ellipsoid centered at */ -/* C the origin and a plane containing the */ -/* C origin. For this reason, we don't check */ -/* C INEDPL's `found flag' FOUND below. */ -/* C */ -/* NORMAL(1) = DIRECT(1) / A**2 */ -/* NORMAL(2) = DIRECT(2) / B**2 */ -/* NORMAL(3) = DIRECT(3) / C**2 */ - -/* CALL NVC2PL ( NORMAL, 0.D0, CANDPL ) */ - -/* CALL INEDPL ( A, B, C, CANDPL, CAND, FOUND ) */ - -/* C */ -/* C Step 2. Project the candidate ellipse onto a */ -/* C plane orthogonal to the line. We'll */ -/* C call the plane PRJPL and the */ -/* C projected ellipse PRJEL. */ -/* C */ -/* CALL NVC2PL ( DIRECT, 0.D0, PRJPL ) */ -/* CALL PJELPL ( CAND, PRJPL, PRJEL ) */ - -/* C */ -/* C Step 3. Find the point on the line lying in the */ -/* C projection plane, and then find the */ -/* C near point PJNEAR on the projected */ -/* C ellipse. Here PRJPT is the point on the */ -/* C input line that lies in the projection */ -/* C plane. The distance between PRJPT and */ -/* C PJNEAR is DIST. */ - -/* CALL VPRJP ( LINEPT, PRJPL, PRJPT ) */ -/* CALL NPEDPT ( PRJEL, PRJPT, PJNEAR, DIST ) */ - -/* C */ -/* C Step 4. Find the near point PNEAR on the */ -/* C ellipsoid by taking the inverse */ -/* C orthogonal projection of PJNEAR; this is */ -/* C the point on the candidate ellipse that */ -/* C projects to PJNEAR. Note that the output */ -/* C DIST was computed in step 3. */ -/* C */ -/* C The inverse projection of PJNEAR is */ -/* C guaranteed to exist, so we don't have to */ -/* C check FOUND. */ -/* C */ -/* CALL VPRJPI ( PJNEAR, PRJPL, CANDPL, PNEAR, FOUND ) */ - - -/* The value of DIST returned is the distance we're looking */ -/* for. */ - -/* The procedure described here is carried out in the routine */ -/* NPEDLN. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 02-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* project ellipse onto plane */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PJELPL", (ftnlen)6); - } - -/* Find generating vectors of the input ellipse. */ - - el2cgv_(elin, center, smajor, sminor); - -/* Find a normal vector for the input plane. */ - - pl2nvc_(plane, normal, &const__); - -/* Find the components of the semi-axes that are orthogonal to the */ -/* input plane's normal vector. The components are generating */ -/* vectors for the projected plane. */ - - vperp_(smajor, normal, prjvc1); - vperp_(sminor, normal, prjvc2); - -/* Find the projection of the ellipse's center onto the input plane. */ -/* This is the center of the projected ellipse. */ - -/* In case the last assertion is non-obvious, note that the */ -/* projection we're carrying out is the composition of a linear */ -/* mapping (projection to a plane containing the origin and parallel */ -/* to PLANE) and a translation mapping (adding the closest point to */ -/* the origin in PLANE to every point), and both linear mappings and */ -/* translations carry the center of an ellipse to the center of the */ -/* ellipse's image. Let's state this using mathematical symbols. */ -/* Let L be a linear mapping and let T be a translation mapping, */ -/* say */ - -/* T(x) = x + A. */ - -/* Then */ - -/* T ( L ( center + cos(theta)smajor + sin(theta)sminor ) ) */ - -/* = A + L ( center + cos(theta)smajor + sin(theta)sminor ) */ - -/* = A + L (center) */ -/* + cos(theta) L(smajor) */ -/* + sin(theta) L(sminor) */ - -/* From the form of this last expression, we see that we have an */ -/* ellipse centered at */ - -/* A + L (center) */ - -/* = T ( L (center) ) */ - -/* This last term is the image of the center of the original ellipse, */ -/* as we wished to demonstrate. */ - -/* Now in the case of orthogonal projection onto a plane PL, L can be */ -/* taken as the orthogonal projection onto a parallel plane PL' */ -/* containing the origin. Then L is a linear mapping. Let M be */ -/* the multiple of the normal vector of PL such that M is contained */ -/* in PL (M is the closest point in PL to the origin). Then the */ -/* orthogonal projection mapping onto PL, which we will name PRJ, */ -/* can be defined by */ - -/* PRJ (x) = L (x) + M. */ - -/* So PRJ is the composition of a translation and a linear mapping, */ -/* as claimed. */ - - - vprjp_(center, plane, prjctr); - -/* Put together the projected ellipse. */ - - cgv2el_(prjctr, prjvc1, prjvc2, elout); - chkout_("PJELPL", (ftnlen)6); - return 0; -} /* pjelpl_ */ - diff --git a/ext/spice/src/cspice/pjelpl_c.c b/ext/spice/src/cspice/pjelpl_c.c deleted file mode 100644 index 923f0e17c5..0000000000 --- a/ext/spice/src/cspice/pjelpl_c.c +++ /dev/null @@ -1,386 +0,0 @@ -/* - --Procedure pjelpl_c ( Project ellipse onto plane ) - --Abstract - - Project an ellipse onto a plane, orthogonally. - --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 - - ELLIPSES - PLANES - --Keywords - - ELLIPSE - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef pjelpl_c - - - void pjelpl_c ( ConstSpiceEllipse * elin, - ConstSpicePlane * plane, - SpiceEllipse * elout ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - elin I A CSPICE ellipse to be projected. - plane I A plane onto which elin is to be projected. - elout O A CSPICE ellipse resulting from the projection. - --Detailed_Input - - elin, - plane are, respectively, a cspice ellipse and a - cspice plane. The geometric ellipse represented - by elin is to be orthogonally projected onto the - geometric plane represented by plane. - --Detailed_Output - - elout is a cspice ellipse that represents the geometric - ellipse resulting from orthogonally projecting the - ellipse represented by inel onto the plane - represented by plane. - --Parameters - - None. - --Exceptions - - 1) If the input plane is invalid, the error will be diagnosed - by routines called by this routine. - - 2) The input ellipse may be degenerate--its semi-axes may be - linearly dependent. Such ellipses are allowed as inputs. - - 3) The ellipse resulting from orthogonally projecting the input - ellipse onto a plane may be degenerate, even if the input - ellipse is not. - --Files - - None. - --Particulars - - Projecting an ellipse orthogonally onto a plane can be thought of - finding the points on the plane that are `under' or `over' the - ellipse, with the `up' direction considered to be perpendicular - to the plane. More mathematically, the orthogonal projection is - the set of points Y in the plane such that for some point X in - the ellipse, the vector Y - X is perpendicular to the plane. - The orthogonal projection of an ellipse onto a plane yields - another ellipse. - --Examples - - 1) With center = { 1., 1., 1. }, - vect1 = { 2., 0., 0. }, - vect2 = { 0., 1., 1. }, - normal = { 0., 0., 1. } - - the code fragment - - nvc2pl_c ( normal, 0., plane ); - cgv2el_c ( center, vect1, vect2, elin ); - pjelpl_c ( elin, plane, elout ); - el2cgv_c ( elout, prjctr, prjmaj, prjmin ); - - returns - - prjctr = { 1., 1., 0. }, - prjmaj = { 2., 0., 0. }, - prjmin = { 0., 1., 0. } - - - 2) With vect1 = { 2., 0., 0. }, - vect2 = { 1., 1., 1. }, - center = { 0., 0., 0. }, - normal = { 0., 0., 1. }, - - the code fragment - - nvc2pl_c ( normal, 0., plane ); - cgv2el_c ( center, vect1, vect2, elin ); - pjelpl_c ( elin, plane, elout ); - el2cgv_c ( elout, prjctr, prjmaj, prjmin ); - - returns - - prjctr = { 0., 0., 0. }; - - prjmaj = { -2.227032728823213, - -5.257311121191336e-1, - 0. }; - - prjmin = { 2.008114158862273e-1, - -8.506508083520399e-1, - 0. }; - - - - 3) An example of actual use: Suppose we wish to compute the - distance from an ellipsoid to a line. Let the line be - defined by a point P and a direction vector DIRECT; the - line is the set of points - - P + t * DIRECT, - - where t is any real number. Let the ellipsoid have semi- - axis lengths A, B, and C. - - We can reduce the problem to that of finding the distance - between the line and an ellipse on the ellipsoid surface by - considering the fact that the surface normal at the nearest - point to the line will be orthogonal to DIRECT; the set of - surface points where this condition holds lies in a plane, - and hence is an ellipse on the surface. The problem can be - further simplified by projecting the ellipse orthogonally - onto the plane defined by - - < X, DIRECT > = 0. - - The problem is then a two dimensional one: find the - distance of the projected ellipse from the intersection of - the line and this plane (which is necessarily one point). - A `paraphrase' of the relevant code is: - - #include "SpiceUsr.h" - . - . - . - /. - Step 1. Find the candidate ellipse cand. - normal is a normal vector to the plane - containing the candidate ellipse. The - ellipse must exist, since it's the - intersection of an ellipsoid centered at - the origin and a plane containing the - origin. For this reason, we don't check - inedpl_c's "found flag" found below. - ./ - - normal[0] = direct[0] / (a*a); - normal[1] = direct[1] / (b*b); - normal[2] = direct[2] / (c*c); - - nvc2pl_c ( normal, 0., &candpl ); - - inedpl_c ( a, b, c, &candpl, cand, &found ); - - - /. - Step 2. Project the candidate ellipse onto a - plane orthogonal to the line. We'll - call the plane prjpl and the - projected ellipse prjel. - ./ - nvc2pl_c ( direct, 0., &prjpl ); - pjelpl_c ( &cand, &prjpl, &prjel ); - - - /. - Step 3. Find the point on the line lying in the - projection plane, and then find the - near point pjnear on the projected - ellipse. Here prjpt is the point on the - input line that lies in the projection - plane. The distance between prjpt and - pjnear is dist. - ./ - - vprjp_c ( linept, &prjpl, prjpt ); - npelpt_c ( &prjel, prjpt, pjnear, &dist ); - - - /. - Step 4. Find the near point pnear on the - ellipsoid by taking the inverse - orthogonal projection of PJNEAR; this is - the point on the candidate ellipse that - projects to pjnear. Note that the output - dist was computed in step 3. - - The inverse projection of pjnear is - guaranteed to exist, so we don't have to - check found. - ./ - vprjpi_c ( pjnear, &prjpl, &candpl, pnear, &found ); - - - /. - The value of dist returned is the distance we're looking - for. - - The procedure described here is carried out in the routine - npedln_c. - ./ - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 02-SEP-1999 (NJB) - --Index_Entries - - project ellipse onto plane - --& -*/ - -{ /* Begin pjelpl_c */ - - - - /* - Local variables - */ - SpiceDouble center[3]; - SpiceDouble cnst; - SpiceDouble normal[3]; - SpiceDouble prjctr[3]; - SpiceDouble prjvc1[3]; - SpiceDouble prjvc2[3]; - SpiceDouble smajor[3]; - SpiceDouble sminor[3]; - - - - /* - Participate in error tracing. - */ - chkin_c ( "pjelpl_c" ); - - - /* - Find generating vectors of the input ellipse. - */ - el2cgv_c ( elin, center, smajor, sminor ); - - - /* - Find a normal vector for the input plane. - */ - pl2nvc_c ( plane, normal, &cnst ); - - - /* - Find the components of the semi-axes that are orthogonal to the - input plane's normal vector. The components are generating - vectors for the projected plane. - */ - vperp_c ( smajor, normal, prjvc1 ); - vperp_c ( sminor, normal, prjvc2 ); - - - /* - Find the projection of the ellipse's center onto the input plane. - This is the center of the projected ellipse. - - In case the last assertion is non-obvious, note that the - projection we're carrying out is the composition of a linear - mapping (projection to a plane containing the origin and parallel - to PLANE) and a translation mapping (adding the closest point to - the origin in PLANE to every point), and both linear mappings and - translations carry the center of an ellipse to the center of the - ellipse's image. Let's state this using mathematical symbols. - Let L be a linear mapping and let T be a translation mapping, - say - - T(x) = x + A. - - Then - - T ( L ( center + cos(theta)smajor + sin(theta)sminor ) ) - - = A + L ( center + cos(theta)smajor + sin(theta)sminor ) - - = A + L (center) - + cos(theta) L(smajor) - + sin(theta) L(sminor) - - From the form of this last expression, we see that we have an - ellipse centered at - - A + L (center) - - = T ( L (center) ) - - This last term is the image of the center of the original ellipse, - as we wished to demonstrate. - - Now in the case of orthogonal projection onto a plane PL, L can be - taken as the orthogonal projection onto a parallel plane PL' - containing the origin. Then L is a linear mapping. Let M be - the multiple of the normal vector of PL such that M is contained - in PL (M is the closest point in PL to the origin). Then the - orthogonal projection mapping onto PL, which we will name PRJ, - can be defined by - - PRJ (x) = L (x) + M. - - So PRJ is the composition of a translation and a linear mapping, - as claimed. - */ - - vprjp_c ( center, plane, prjctr ); - - - /* - Put together the projected ellipse. - */ - cgv2el_c ( prjctr, prjvc1, prjvc2, elout ); - - - chkout_c ( "pjelpl_c" ); - -} /* End pjelpl_c */ diff --git a/ext/spice/src/cspice/pl2nvc.c b/ext/spice/src/cspice/pl2nvc.c deleted file mode 100644 index 47afff3974..0000000000 --- a/ext/spice/src/cspice/pl2nvc.c +++ /dev/null @@ -1,228 +0,0 @@ -/* pl2nvc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PL2NVC ( Plane to normal vector and constant ) */ -/* Subroutine */ int pl2nvc_(doublereal *plane, doublereal *normal, - doublereal *const__) -{ - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Return a unit normal vector and constant that define a specified */ -/* plane. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PLANE I A SPICELIB plane. */ -/* NORMAL, */ -/* CONST O A normal vector and constant defining the */ -/* geometric plane represented by PLANE. */ - -/* $ Detailed_Input */ - -/* PLANE is a SPICELIB plane. */ - -/* $ Detailed_Output */ - -/* NORMAL, */ -/* CONST are, respectively, a unit normal vector and */ -/* constant that define the geometric plane */ -/* represented by PLANE. Let the symbol < a, b > */ -/* indicate the inner product of vectors a and b; */ -/* then the geometric plane is the set of vectors X */ -/* in three-dimensional space that satisfy */ - -/* < X, NORMAL > = CONST. */ - -/* NORMAL is a unit vector. CONST is the distance of */ -/* the plane from the origin; */ - -/* CONST * NORMAL */ - -/* is the closest point in the plane to the origin. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) The input plane MUST have been created by one of the SPICELIB */ -/* routines */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* Otherwise, the results of this routine are unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB geometry routines that deal with planes use the `plane' */ -/* data type to represent input and output planes. This data type */ -/* makes the subroutine interfaces simpler and more uniform. */ - -/* The SPICELIB routines that produce SPICELIB planes from data that */ -/* define a plane are: */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* The SPICELIB routines that convert SPICELIB planes to data that */ -/* define a plane are: */ - -/* PL2NVC ( Plane to normal vector and constant ) */ -/* PL2NVP ( Plane to normal vector and point ) */ -/* PL2PSV ( Plane to point and spanning vectors ) */ - -/* $ Examples */ - -/* 1) Given a point in a plane and a normal vector, find the */ -/* distance of the plane from the origin. We make a */ -/* `plane' from the point and normal, then convert the */ -/* plane to a unit normal and constant. CONST is the distance */ -/* of the plane from the origin. */ - -/* CALL NVP2PL ( NORMAL, POINT, PLANE ) */ -/* CALL PL2NVC ( PLANE, NORMAL, CONST ) */ - - -/* 2) Apply a linear transformation represented by the matrix M to */ -/* a plane represented by the normal vector N and the constant C. */ -/* Find a normal vector and constant for the transformed plane. */ - -/* C */ -/* C Make a SPICELIB plane from N and C, and then find a */ -/* C point in the plane and spanning vectors for the */ -/* C plane. N need not be a unit vector. */ -/* C */ -/* CALL NVC2PL ( N, C, PLANE ) */ -/* CALL PL2PSV ( PLANE, POINT, SPAN1, SPAN2 ) */ - -/* C */ -/* C Apply the linear transformation to the point and */ -/* C spanning vectors. All we need to do is multiply */ -/* C these vectors by M, since for any linear */ -/* C transformation T, */ -/* C */ -/* C T ( POINT + t1 * SPAN1 + t2 * SPAN2 ) */ -/* C */ -/* C = T (POINT) + t1 * T(SPAN1) + t2 * T(SPAN2), */ -/* C */ -/* C which means that T(POINT), T(SPAN1), and T(SPAN2) */ -/* C are a point and spanning vectors for the transformed */ -/* C plane. */ -/* C */ -/* CALL MXV ( M, POINT, TPOINT ) */ -/* CALL MXV ( M, SPAN1, TSPAN1 ) */ -/* CALL MXV ( M, SPAN2, TSPAN2 ) */ - -/* C */ -/* C Make a new SPICELIB plane TPLANE from the */ -/* C transformed point and spanning vectors, and find a */ -/* C unit normal and constant for this new plane. */ -/* C */ -/* CALL PSV2PL ( TPOINT, TSPAN1, TSPAN2, TPLANE ) */ -/* CALL PL2NVC ( TPLANE, TN, TC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* plane to normal vector and constant */ - -/* -& */ - -/* The contents of SPICELIB planes are as follows: */ - -/* Elements NMLPOS through NMLPOS + 2 contain a unit normal */ -/* vector for the plane. */ - -/* Element CONPOS contains a constant for the plane; every point */ -/* X in the plane satisifies */ - -/* < X, PLANE(NMLPOS) > = PLANE(CONPOS). */ - -/* The plane constant is the distance of the plane from the */ -/* origin; the normal vector, scaled by the constant, is the */ -/* closest point in the plane to the origin. */ - - - -/* Unpack the plane. */ - - vequ_(plane, normal); - *const__ = plane[3]; - return 0; -} /* pl2nvc_ */ - diff --git a/ext/spice/src/cspice/pl2nvc_c.c b/ext/spice/src/cspice/pl2nvc_c.c deleted file mode 100644 index cb16451f66..0000000000 --- a/ext/spice/src/cspice/pl2nvc_c.c +++ /dev/null @@ -1,224 +0,0 @@ -/* - --Procedure pl2nvc_c ( Plane to normal vector and constant ) - --Abstract - - Return a unit normal vector and constant that define a specified - plane. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef pl2nvc_c - - - void pl2nvc_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble * constant ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - plane I A CSPICE plane. - normal, - constant O A normal vector and constant defining the - geometric plane represented by plane. - --Detailed_Input - - plane is a CSPICE plane. - --Detailed_Output - - normal, - constant are, respectively, a unit normal vector and - constant that define the geometric plane - represented by plane. Let the symbol < a, b > - indicate the inner product of vectors a and b; - then the geometric plane is the set of vectors x - in three-dimensional space that satisfy - - < x, normal > = constant. - - normal is a unit vector. constant is the distance of - the plane from the origin; - - constant * normal - - is the closest point in the plane to the origin. - --Parameters - - None. - --Exceptions - - Error free. - - 1) The input plane MUST have been created by one of the CSPICE - routines - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - Otherwise, the results of this routine are unpredictable. - --Files - - None. - --Particulars - - CSPICE geometry routines that deal with planes use the `plane' - data type to represent input and output planes. This data type - makes the subroutine interfaces simpler and more uniform. - - The CSPICE routines that produce CSPICE planes from data that - define a plane are: - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - The CSPICE routines that convert CSPICE planes to data that - define a plane are: - - pl2nvc_c ( Plane to normal vector and constant ) - pl2nvp_c ( Plane to normal vector and point ) - pl2psv_c ( Plane to point and spanning vectors ) - --Examples - - 1) Given a point in a plane and a normal vector, find the distance - of the plane from the origin. We make a `plane' from the point - and normal, then convert the plane to a unit normal and constant. - The constant is the distance of the plane from the origin. - - nvp2pl_c ( normal, point, &plane ); - pl2nvc_c ( &plane, normal, &constant ); - - - 2) Apply a linear transformation represented by the matrix m to - a plane represented by the normal vector n and the constant c. - Find a normal vector and constant for the transformed plane. - - /. - Make a CSPICE plane from n and c, and then find a - point in the plane and spanning vectors for the - plane. n need not be a unit vector. - ./ - nvc2pl_c ( n, c, &plane ); - pl2psv_c ( &plane, point, span1, span2 ); - - - /. - Apply the linear transformation to the point and - spanning vectors. All we need to do is multiply - these vectors by m, since for any linear - transformation T, - - T ( point + t1 * span1 + t2 * span2 ) - - = T (point) + t1 * T(span1) + t2 * T(span2), - - which means that T(point), T(span1), and T(span2) - are a point and spanning vectors for the transformed - plane. - ./ - - mxv_c ( m, point, tpoint ); - mxv_c ( m, span1, tspan1 ); - mxv_c ( m, span2, tspan2 ); - - /. - Make a new CSPICE plane tplane from the - transformed point and spanning vectors, and find a - unit normal and constant for this new plane. - ./ - - psv2pl_c ( tpoint, tspan1, tspan2, &tplane ); - pl2nvc_c ( &tplane, tn, &tc ); - - - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 06-FEB-2003 (EDW) - - Trivial correction to header docs. - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - plane to normal vector and constant - --& -*/ - -{ /* Begin pl2nvc_c */ - - - /* - Unpack the plane. - */ - - MOVED ( plane->normal, 3, normal ); - - *constant = plane->constant; - - -} /* End pl2nvc_c */ - diff --git a/ext/spice/src/cspice/pl2nvp.c b/ext/spice/src/cspice/pl2nvp.c deleted file mode 100644 index cd4a25f865..0000000000 --- a/ext/spice/src/cspice/pl2nvp.c +++ /dev/null @@ -1,175 +0,0 @@ -/* pl2nvp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PL2NVP ( Plane to normal vector and point ) */ -/* Subroutine */ int pl2nvp_(doublereal *plane, doublereal *normal, - doublereal *point) -{ - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - doublereal const__; - extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, - doublereal *); - -/* $ Abstract */ - -/* Return a unit normal vector and point that define a specified */ -/* plane. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PLANE I A SPICELIB plane. */ -/* NORMAL, */ -/* POINT O A unit normal vector and point that define PLANE. */ - -/* $ Detailed_Input */ - -/* PLANE is a SPICELIB plane. */ - -/* $ Detailed_Output */ - -/* NORMAL, */ -/* POINT are, respectively, a unit normal vector and point */ -/* that define the geometric plane represented by */ -/* PLANE. Let the symbol < a, b > indicate the inner */ -/* product of vectors a and b; then the geometric */ -/* plane is the set of vectors X in three-dimensional */ -/* space that satisfy */ - -/* < X - POINT, NORMAL > = 0. */ - -/* POINT is always the closest point in the input */ -/* plane to the origin. POINT is always a */ -/* non-negative scalar multiple of NORMAL. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) The input plane MUST have been created by one of the SPICELIB */ -/* routines */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* Otherwise, the results of this routine are unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB geometry routines that deal with planes use the `plane' */ -/* data type to represent input and output planes. This data type */ -/* makes the subroutine interfaces simpler and more uniform. */ - -/* The SPICELIB routines that produce SPICELIB planes from data that */ -/* define a plane are: */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* The SPICELIB routines that convert SPICELIB planes to data that */ -/* define a plane are: */ - -/* PL2NVC ( Plane to normal vector and constant ) */ -/* PL2NVP ( Plane to normal vector and point ) */ -/* PL2PSV ( Plane to point and spanning vectors ) */ - -/* $ Examples */ - -/* 1) Given a plane normal and constant, find a point in */ -/* the plane. POINT is the point we seek. */ - -/* CALL NVC2PL ( NORMAL, CONST, PLANE ) */ -/* CALL PL2NVP ( PLANE, NORMAL, POINT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* plane to normal vector and point */ - -/* -& */ - -/* Local variables */ - - -/* Find a unit normal and constant for the plane. Scaling the */ -/* unit normal by the constant gives us the closest point in */ -/* the plane to the origin. */ - - pl2nvc_(plane, normal, &const__); - vscl_(&const__, normal, point); - return 0; -} /* pl2nvp_ */ - diff --git a/ext/spice/src/cspice/pl2nvp_c.c b/ext/spice/src/cspice/pl2nvp_c.c deleted file mode 100644 index b5c68d693e..0000000000 --- a/ext/spice/src/cspice/pl2nvp_c.c +++ /dev/null @@ -1,173 +0,0 @@ -/* - --Procedure pl2nvp_c ( Plane to normal vector and point ) - --Abstract - - Return a unit normal vector and point that define a specified - plane. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef pl2nvp_c - - - void pl2nvp_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble point [3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - plane I A CSPICE plane. - normal, - point O A unit normal vector and point that define plane. - --Detailed_Input - - plane is a CSPICE plane. - --Detailed_Output - - normal, - point are, respectively, a unit normal vector and point - that define the geometric plane represented by - plane. Let the symbol < a, b > indicate the inner - product of vectors a and b; then the geometric - plane is the set of vectors x in three-dimensional - space that satisfy - - < x - point, normal > = 0. - - point is always the closest point in the input - plane to the origin. point is always a - non-negative scalar multiple of normal. - --Parameters - - None. - --Exceptions - - Error free. - - 1) The input plane MUST have been created by one of the CSPICE - routines - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - Otherwise, the results of this routine are unpredictable. - --Files - - None. - --Particulars - - CSPICE geometry routines that deal with planes use the `plane' - data type to represent input and output planes. This data type - makes the subroutine interfaces simpler and more uniform. - - The CSPICE routines that produce CSPICE planes from data that - define a plane are: - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - The CSPICE routines that convert CSPICE planes to data that - define a plane are: - - pl2nvc_c ( Plane to normal vector and constant ) - pl2nvp_c ( Plane to normal vector and point ) - pl2psv_c ( Plane to point and spanning vectors ) - --Examples - - 1) Given a plane normal and constant, find a point in - the plane. point is the point we seek. - - nvc2pl_c ( normal, const, &plane ); - pl2nvp_c ( &plane, normal, point ); - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - plane to normal vector and point - --& -*/ - -{ /* Begin pl2nvp_c */ - - - /* - Return the stored normal vector. - */ - MOVED ( plane->normal, 3, normal ); - - - /* - Find the closest point in the plane to the origin. - */ - vscl_c ( plane->constant, plane->normal, point ); - - -} /* End pl2nvp_c */ diff --git a/ext/spice/src/cspice/pl2psv.c b/ext/spice/src/cspice/pl2psv.c deleted file mode 100644 index 5556febd62..0000000000 --- a/ext/spice/src/cspice/pl2psv.c +++ /dev/null @@ -1,294 +0,0 @@ -/* pl2psv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PL2PSV ( Plane to point and spanning vectors ) */ -/* Subroutine */ int pl2psv_(doublereal *plane, doublereal *point, doublereal - *span1, doublereal *span2) -{ - extern /* Subroutine */ int frame_(doublereal *, doublereal *, doublereal - *), pl2nvp_(doublereal *, doublereal *, doublereal *); - doublereal normal[3]; - -/* $ Abstract */ - -/* Return a point and two orthogonal spanning vectors that generate */ -/* a specified plane. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PLANE I A SPICELIB plane. */ -/* POINT, */ -/* SPAN1, */ -/* SPAN2 O A point in the input plane and two vectors */ -/* spanning the input plane. */ - -/* $ Detailed_Input */ - -/* PLANE is a SPICELIB plane that represents the geometric */ -/* plane defined by POINT, SPAN1, and SPAN2. */ - -/* $ Detailed_Output */ - -/* POINT, */ -/* SPAN1, */ -/* SPAN2 are, respectively, a point and two orthogonal */ -/* spanning vectors that generate the geometric plane */ -/* represented by PLANE. The geometric plane is the */ -/* set of vectors */ - -/* POINT + s * SPAN1 + t * SPAN2 */ - -/* where s and t are real numbers. POINT is the */ -/* closest point in the plane to the origin; this */ -/* point is always a multiple of the plane's normal */ -/* vector. SPAN1 and SPAN2 are an orthonormal pair */ -/* of vectors. POINT, SPAN1, and SPAN2 are mutually */ -/* orthogonal. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) The input plane MUST have been created by one of the SPICELIB */ -/* routines */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* Otherwise, the results of this routine are unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB geometry routines that deal with planes use the `plane' */ -/* data type to represent input and output planes. This data type */ -/* makes the subroutine interfaces simpler and more uniform. */ - -/* The SPICELIB routines that produce SPICELIB planes from data that */ -/* define a plane are: */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* The SPICELIB routines that convert SPICELIB planes to data that */ -/* define a plane are: */ - -/* PL2NVC ( Plane to normal vector and constant ) */ -/* PL2NVP ( Plane to normal vector and point ) */ -/* PL2PSV ( Plane to point and spanning vectors ) */ - -/* $ Examples */ - -/* 1) Project a vector V orthogonally onto a plane defined by */ -/* POINT, SPAN1, and SPAN2. PROJ is the projection we want; it */ -/* is the closest vector in the plane to V. */ - -/* CALL PSV2PL ( POINT, SPAN1, SPAN2, PLANE ) */ -/* CALL VPRJP ( V, PLANE, PROJ ) */ - - -/* 2) Find the intersection of a plane and the unit sphere. This */ -/* is a geometry problem that arises in computing the */ -/* intersection of a plane and a triaxial ellipsoid. The */ -/* SPICELIB routine INEDPL computes this intersection, but this */ -/* example does illustrate how to use this routine. */ - - -/* C */ -/* C The geometric plane of interest will be represented */ -/* C by the SPICELIB plane PLANE in this example. */ -/* C */ -/* C The intersection circle will be represented by the */ -/* C vectors CENTER, V1, and V2; the circle is the set */ -/* C of points */ -/* C */ -/* C CENTER + cos(theta) V1 + sin(theta) V2, */ -/* C */ -/* C where theta is in the interval (-pi, pi]. */ -/* C */ -/* C The logical variable FOUND indicates whether the */ -/* C intersection is non-empty. */ -/* C */ - -/* C */ -/* C The center of the intersection circle will be the */ -/* C closest point in the plane to the origin. This */ -/* C point is returned by PL2PSV. The distance of the */ -/* C center from the origin is the norm of CENTER. */ -/* C */ -/* CALL PL2PSV ( PLANE, CENTER, SPAN1, SPAN2 ) */ - -/* DIST = VNORM ( CENTER ) */ - -/* C */ -/* C The radius of the intersection circle will be */ -/* C */ -/* C ____________ */ -/* C _ / 2 */ -/* C \/ 1 - DIST */ -/* C */ -/* C since the radius of the circle, the distance of the */ -/* C plane from the origin, and the radius of the sphere */ -/* C (1) are the lengths of the sides of a right triangle. */ -/* C */ -/* RADIUS = SQRT ( 1.0D0 - DIST**2 ) */ - -/* CALL VSCL ( RADIUS, SPAN1, V1 ) */ -/* CALL VSCL ( RADIUS, SPAN2, V2 ) */ - -/* FOUND = .TRUE. */ - - -/* 3) Apply a linear transformation represented by the matrix M to */ -/* a plane represented by the normal vector N and the constant C. */ -/* Find a normal vector and constant for the transformed plane. */ - -/* C */ -/* C Make a SPICELIB plane from N and C, and then find a */ -/* C point in the plane and spanning vectors for the */ -/* C plane. N need not be a unit vector. */ -/* C */ -/* CALL NVC2PL ( N, C, PLANE ) */ -/* CALL PL2PSV ( PLANE, POINT, SPAN1, SPAN2 ) */ - -/* C */ -/* C Apply the linear transformation to the point and */ -/* C spanning vectors. All we need to do is multiply */ -/* C these vectors by M, since for any linear */ -/* C transformation T, */ -/* C */ -/* C T ( POINT + t1 * SPAN1 + t2 * SPAN2 ) */ -/* C */ -/* C = T (POINT) + t1 * T(SPAN1) + t2 * T(SPAN2), */ -/* C */ -/* C which means that T(POINT), T(SPAN1), and T(SPAN2) */ -/* C are a point and spanning vectors for the transformed */ -/* C plane. */ -/* C */ -/* CALL MXV ( M, POINT, TPOINT ) */ -/* CALL MXV ( M, SPAN1, TSPAN1 ) */ -/* CALL MXV ( M, SPAN2, TSPAN2 ) */ - -/* C */ -/* C Make a new SPICELIB plane TPLANE from the */ -/* C transformed point and spanning vectors, and find a */ -/* C unit normal and constant for this new plane. */ -/* C */ -/* CALL PSV2PL ( TPOINT, TSPAN1, TSPAN2, TPLANE ) */ -/* CALL PL2NVC ( TPLANE, TN, TC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* plane to point and spanning vectors */ - -/* -& */ - -/* Local parameters */ - - -/* The contents of SPICELIB planes are as follows: */ - -/* Elements NMLPOS through NMLPOS + 2 contain a unit normal */ -/* vector for the plane. */ - -/* Element CONPOS contains a constant for the plane; every point */ -/* X in the plane satisifies */ - -/* < X, PLANE(NMLPOS) > = PLANE(CONPOS). */ - -/* The plane constant is the distance of the plane from the */ -/* origin; the normal vector, scaled by the constant, is the */ -/* closest point in the plane to the origin. */ - - - -/* Local variables */ - - -/* Find a unit normal vector for the plane, and find the closest */ -/* point in the plane to the origin. */ - - pl2nvp_(plane, normal, point); - -/* Next, find an orthogonal pair of vectors that are also */ -/* orthogonal to the PLANE's normal vector. The SPICELIB routine */ -/* FRAME does this for us. NORMAL, SPAN1, and SPAN2 form a */ -/* right-handed orthonormal system upon output from FRAME. */ - - frame_(normal, span1, span2); - return 0; -} /* pl2psv_ */ - diff --git a/ext/spice/src/cspice/pl2psv_c.c b/ext/spice/src/cspice/pl2psv_c.c deleted file mode 100644 index 60db83bff5..0000000000 --- a/ext/spice/src/cspice/pl2psv_c.c +++ /dev/null @@ -1,288 +0,0 @@ -/* - --Procedure pl2psv_c ( Plane to point and spanning vectors ) - --Abstract - - Return a point and two orthogonal spanning vectors that generate - a specified plane. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef pl2psv_c - - - void pl2psv_c ( ConstSpicePlane * plane, - SpiceDouble point[3], - SpiceDouble span1[3], - SpiceDouble span2[3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - plane I A CSPICE plane. - point, - span1, - span2 O A point in the input plane and two vectors - spanning the input plane. - --Detailed_Input - - plane is a CSPICE plane that represents the geometric - plane defined by point, span1, and span2. - --Detailed_Output - - point, - span1, - span2 are, respectively, a point and two orthogonal - spanning vectors that generate the geometric plane - represented by plane. The geometric plane is the - set of vectors - - point + s * span1 + t * span2 - - where s and t are real numbers. point is the - closest point in the plane to the origin; this - point is always a multiple of the plane's normal - vector. span1 and span2 are an orthonormal pair - of vectors. point, span1, and span2 are mutually - orthogonal. - --Parameters - - None. - --Exceptions - - Error free. - - 1) The input plane MUST have been created by one of the CSPICE - routines - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - Otherwise, the results of this routine are unpredictable. - --Files - - None. - --Particulars - - CSPICE geometry routines that deal with planes use the `plane' - data type to represent input and output planes. This data type - makes the subroutine interfaces simpler and more uniform. - - The CSPICE routines that produce CSPICE planes from data that - define a plane are: - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - The CSPICE routines that convert CSPICE planes to data that - define a plane are: - - pl2nvc_c ( Plane to normal vector and constant ) - pl2nvp_c ( Plane to normal vector and point ) - pl2psv_c ( Plane to point and spanning vectors ) - --Examples - - 1) Find the intersection of a plane and the unit sphere. This - is a geometry problem that arises in computing the - intersection of a plane and a triaxial ellipsoid. The - CSPICE routine inedpl_c computes this intersection, but this - example does illustrate how to use this routine. - - /. - The geometric plane of interest will be represented - by the CSPICE plane plane in this example. - - The intersection circle will be represented by the - vectors center, v1, and v2; the circle is the set - of points - - center + cos(theta) v1 + sin(theta) v2, - - where theta is in the interval (-pi, pi]. - - The logical variable found indicates whether the - intersection is non-empty. - - The center of the intersection circle will be the - closest point in the plane to the origin. This - point is returned by pl2psv_c. The distance of the - center from the origin is the norm of center. - ./ - - pl2psv_c ( &plane, center, span1, span2 ); - - dist = vnorm_c ( center ) - - - /. - The radius of the intersection circle will be - - ____________ - _ / 2 - \/ 1 - dist - - since the radius of the circle, the distance of the - plane from the origin, and the radius of the sphere - (1) are the lengths of the sides of a right triangle. - - ./ - - found = ( dist <= 1.0 ); - - if ( found ) - { - radius = sqrt ( 1.0 - pow(dist,2) ); - - vscl_c ( radius, span1, v1 ); - vscl_c ( radius, span2, v2 ) ; - } - - - - 2) Apply a linear transformation represented by the matrix m to - a plane represented by the normal vector n and the constant c. - Find a normal vector and constant for the transformed plane. - - /. - Make a CSPICE plane from n and c, and then find a - point in the plane and spanning vectors for the - plane. n need not be a unit vector. - ./ - nvc2pl_c ( n, c, &plane ); - pl2psv_c ( &plane, point, span1, span2 ); - - - /. - Apply the linear transformation to the point and - spanning vectors. All we need to do is multiply - these vectors by m, since for any linear - transformation T, - - T ( point + t1 * span1 + t2 * span2 ) - - = T (point) + t1 * T(span1) + t2 * T(span2), - - which means that T(point), T(span1), and T(span2) - are a point and spanning vectors for the transformed - plane. - ./ - - mxv_c ( m, point, tpoint ); - mxv_c ( m, span1, tspan1 ); - mxv_c ( m, span2, tspan2 ); - - /. - Make a new CSPICE plane tplane from the - transformed point and spanning vectors, and find a - unit normal and constant for this new plane. - ./ - - psv2pl_c ( tpoint, tspan1, tspan2, &tplane ); - pl2nvc_c ( &tplane, tn, &tc ); - - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - plane to point and spanning vectors - --& -*/ - -{ /* Begin pl2psv_c */ - - - /* - Local variables - */ - SpiceDouble normal[3]; - - - /* - This is an error-free function; no check-in is required. - */ - - /* - Find the closest point in the plane to the origin. - */ - vscl_c ( plane->constant, plane->normal, point ); - - - /* - Next, find an orthogonal pair of vectors that are also orthogonal to - the plane's normal vector. The CSPICE routine frame_c does this for - us. normal, span1, and span2 form a right-handed orthonormal system - upon output from frame_c. - */ - - MOVED ( plane->normal, 3, normal ); - - frame_c ( normal, span1, span2 ); - - -} /* End pl2psv_c */ - diff --git a/ext/spice/src/cspice/plnsns.c b/ext/spice/src/cspice/plnsns.c deleted file mode 100644 index 035dfb78c2..0000000000 --- a/ext/spice/src/cspice/plnsns.c +++ /dev/null @@ -1,241 +0,0 @@ -/* plnsns.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; - -/* $Procedure PLNSNS ( Planetographic Longitude Sense ) */ -integer plnsns_(integer *bodid) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal rate; - char item[32], type__[1]; - integer n; - logical found; - integer value; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), gdpool_(char *, integer *, integer *, - integer *, doublereal *, logical *, ftnlen), dtpool_(char *, - logical *, integer *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This function returns the quotient of the planetographic */ -/* and planetocentric longitude for a user specified body. */ - -/* $ 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 */ - -/* PCK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODID I is the NAIF id-code of some solar system object. */ - -/* Function returns planetographic/planetocentric */ - -/* $ Detailed_Input */ - -/* BODID is the NAIF id-code of some planet, asteroid, comet */ -/* or natural satellite of a planet. */ - -/* $ Detailed_Output */ - -/* Based upon loaded PCK values in the kernel pool, the function */ -/* returns the quotient */ - -/* planetographic longitude */ -/* ------------------------ */ -/* planetocentric longitude */ - -/* for the body specified by BODID. I.e. 1 if planetographic */ -/* and planetocentric longitude are the same for the input body, */ -/* -1 if the planetographic and planetocentric longitude are */ -/* opposite for the specified body. If PCK information for */ -/* the specified body can not be located in the kernel pool */ -/* the function returns the value 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If sufficient orientation information for the object */ -/* specified by BODID is not available in the kernel pool, */ -/* the function returns the value 0. */ - -/* $ Files */ - -/* A text PCK kernel must be loaded via the routine FURNSH */ -/* that contains the orientation information for the body specified */ -/* by BODID. */ - -/* $ Particulars */ - -/* This routine returns the multiplicative factor needed */ -/* to convert planetographic longitude to planetocentric */ -/* longitude. */ - -/* This routine relies on the proper orientation for the */ -/* specified body having been loaded in the kernel pool. */ - -/* $ Examples */ - -/* Suppose that you have the planetographic coordinates */ -/* of some point on the surface of an object and that you */ -/* need to convert these coordinates to bodyfixed rectangular */ -/* coordinates. This conversion requires knowledge of the */ -/* sense of planetographic longitude. The code fragment below */ -/* shows how you go about using this routine to perform the */ -/* conversion. */ - -/* We assume that the variables LAT, LONG, HEIGHT contain the */ -/* planetographic latitude, longitude and height above the */ -/* reference surface of some point. Moreover, let F be the */ -/* flattening factor for the reference spheroid. */ - -/* ( F = (Equatorial Radius - Polar Radius ) / Equatorial Radius ) */ - -/* Finally, let EQRAD be the equatorial radius. */ - -/* We first need to convert planetographic longitude to */ -/* planetocentric longitude. */ - -/* FACTOR = PLNSNS(BODID) */ - -/* IF ( FACTOR .EQ. 0 ) THEN */ - -/* WRITE (*,*) 'Sorry, we don''t have data available.' */ -/* STOP */ - -/* END IF */ - -/* Compute the planetocentric longitude */ - -/* PCLONG = FACTOR * LONG */ - -/* Now convert the planetographic coordinates with */ -/* planetographic longitude replaced by planetocentric */ -/* longitude rectangular coordinates. (Note the conversion */ -/* to planetocentric longitude is required because GEOREC */ -/* assumes that the ordering latitude, longitude, altitude */ -/* is a right handed ordering. Replacing planetographic */ -/* longitude by planetocentric longitude ensures that we */ -/* have a right handed coordinate system.) */ - -/* CALL GEOREC ( LAT, PCLONG, HEIGHT, EQRAD, F, REC ) */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 11-MAY-2009 (BVS) */ - -/* Replaced LDPOOL with FURNSN in the header. Re-ordered header */ -/* sections. */ - -/* - SPICELIB Version 1.0.0, 7-JAN-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Determine the sense of planetographic longitude. */ - -/* -& */ - -/* The earth is a special case so we just handle it here. */ - - if (*bodid == 399) { - ret_val = 1; - return ret_val; - } - -/* Create the name of the item to look up in the kernel pool. */ - - s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8); - repmi_(item, "#", bodid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - -/* See if this item exists in the kernel pool. */ - - dtpool_(item, &found, &n, type__, (ftnlen)32, (ftnlen)1); - if (! found || *(unsigned char *)type__ != 'N' || n < 2) { - value = 0; - } else { - gdpool_(item, &c__2, &c__1, &n, &rate, &found, (ftnlen)32); - -/* If the rate of change of the prime meridian is negative */ -/* the planetocentric and planetographic longitude are the */ -/* same... */ - - if (rate < 0.) { - value = 1; - } else { - -/* ...otherwise they have opposite signs. */ - - value = -1; - } - } - ret_val = value; - return ret_val; -} /* plnsns_ */ - diff --git a/ext/spice/src/cspice/polyds.c b/ext/spice/src/cspice/polyds.c deleted file mode 100644 index f628f5772d..0000000000 --- a/ext/spice/src/cspice/polyds.c +++ /dev/null @@ -1,311 +0,0 @@ -/* polyds.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure POLYDS ( Compute a Polynomial and its Derivatives ) */ -/* Subroutine */ int polyds_(doublereal *coeffs, integer *deg, integer * - nderiv, doublereal *t, doublereal *p) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, k; - doublereal scale; - -/* $ Abstract */ - -/* Compute the value of a polynomial and it's first */ -/* n derivatives at the value T. */ - -/* $ 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 */ - - -/* INTERPOLATION, MATH, POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COEFFS I Coefficients of the polynomial to be evaluated. */ -/* DEG I Degree of the polynomial to be evaluated. */ -/* NDERIV I Number of derivatives to compute. */ -/* T I Point to evaluate the polynomial and derivatives */ -/* P O Value of polynomial and derivatives. */ - -/* $ Detailed_Input */ - -/* COEFFS containst the coefficients of the polynomial that is */ -/* to be evaluated. The first element of this array */ -/* should be the constant term, the second element the */ -/* linear coefficient, the third term the quadratic */ -/* coefficient, and so on. The number of coefficients */ -/* supplied should be one more than DEG. */ - -/* DEG is the degree of the polynomial to be evaluated. DEG */ -/* should be one less than the number of coefficients */ -/* supplied. */ - -/* NDERIV is the number of derivatives to compute. If NDERIV */ -/* is zero, only the polynomial will be evaluated. If */ -/* NDERIV = 1, then the polynomial and its first */ -/* derivative will be evaluated, and so on. If the value */ -/* of NDERIV is negative, the routine returns */ -/* immediately. */ - -/* T is the point at which the polynomial and its */ -/* derivatives should be evaluated. */ - -/* $ Detailed_Output */ - -/* P is an array containing the value of the polynomial and */ -/* its derivatives evaluated at T. The first element of */ -/* the array contains the value of P at T. The second */ -/* element of the array contains the value of the first */ -/* derivative of P at T and so on. The NDERIV + 1'st */ -/* element of the array contains the NDERIV'th derivative */ -/* of P evaluated at T. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine uses the user supplied coefficients (COEFFS) */ -/* to evaluate a polynomial (having these coefficients) and its */ -/* derivatives at the point T. The zero'th derivative of the */ -/* polynomial is regarded as the polynomial itself. */ - -/* $ Examples */ - -/* Suppose T = 1.0D0 */ - - -/* Degree COEFFS Deriviative Number P */ -/* ------ ------ ------------------ ---------- */ -/* 0 1 0 5 */ -/* 1 3 1 10 */ -/* 2 0.5 2 29 */ -/* 3 1 3 102 */ -/* 4 0.5 */ -/* 5 -1 */ -/* 6 1 */ - -/* $ Restrictions */ - -/* Depending on the coefficients the user should be careful when */ -/* taking high order derivatives. As the example shows, these */ -/* can get big in a hurry. In general the coefficients of the */ -/* derivatives of a polynomial grow at a rate greater */ -/* than N! (N factorial). */ - -/* $ Exceptions */ - -/* Error free */ - -/* 1) If NDERIV is less than zero, the routine simply returns */ - -/* 2) If the degree of the polynomial is less than 0, the routine */ -/* simply returns. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */ - -/* Replaced the function calls to DFLOAT with standard conforming */ -/* calls to DBLE. */ - -/* - 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 */ - -/* compute a polynomial and its derivatives */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */ - -/* Replaced the function calls to DFLOAT with standard conforming */ -/* calls to DBLE. */ - -/* - 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) */ - -/* - Beta Version 1.0.1, 30-DEC-1988 (WLT) */ - -/* The error free specification was added as well as notes */ -/* on exceptional degree or derivative requests. */ - -/* -& */ - -/* Local variables */ - - if (*nderiv < 0) { - return 0; - } - -/* The following loops may not look like much, but they compute */ -/* P(T), P'(T), P''(T), ... etc. */ - -/* To see why, recall that if A_0 through A_N are the coefficients */ -/* of a polynomial, then P(t) can be computed from the sequence */ -/* of polynomials given by: */ - -/* P_0(t) = 0 */ -/* P_1(t) = t*P_0(t) + A_N */ -/* P_2(t) = t*P_1(t) + A_[N-1] */ -/* . */ -/* . */ -/* . */ -/* P_n(t) = t*P_[n-1](t) + A_0 */ - -/* The final polynomial in this list is in fact P(t). From this */ -/* it follows that P'(t) is given by P_n'(t). But */ - -/* P_n'(t) = t*P_[n-1]'(t) + P_[n-1](t) */ - -/* and */ - -/* P_[n-1]'(t) = t*P_[n-2]'(t) + P_[n-2](t) */ -/* . */ -/* . */ -/* . */ -/* P_2'(t) = t*P_1'(t) + P_1(t) */ -/* P_1'(t) = t*P_0'(t) + P_0(t) */ -/* P_0'(t) = 0 */ - -/* Rearranging the sequence we have a recursive method */ -/* for computing P'(t). At the i'th stage we require only the i-1st */ -/* polynomials P_[i-1] and P_[i-1]' . */ - -/* P_0'(t) = 0 */ -/* P_1'(t) = t*P_0'(t) + P_0(t) */ -/* P_2'(t) = t*P_1'(t) + P_1(t) */ -/* . */ -/* . */ -/* . */ -/* P_[n-1]'(t) = t*P_[n-2]'(t) + P_[n-2](t) */ -/* P_n'(t) = t*P_[n-1]'(t) + P_[n-1](t) */ - - -/* Similarly, */ - -/* P_0''(t) = 0 */ -/* P_1''(t) = t*P_0''(t) + 2*P_0'(t) */ -/* P_2''(t) = t*P_1''(t) + 2*P_1'(t) */ -/* . */ -/* . */ -/* . */ -/* P_[n-1]''(t) = t*P_[n-2]''(t) + 2*P_[n-2]'(t) */ - - - -/* P_0'''(t) = 0 */ -/* P_1'''(t) = t*P_0'''(t) + 3*P_0''(t) */ -/* P_2'''(t) = t*P_1'''(t) + 3*P_1''(t) */ -/* . */ -/* . */ -/* . */ -/* P_[n-1]'''(t) = t*P_[n-2]'''(t) + 3*P_[n-2]''(t) */ - -/* Thus if P(I) contains the k'th iterations of the i'th derivative */ -/* computation of P and P(I-1) contains the k'th iteration of the */ -/* i-1st derivative of P then, t*P(I) + I*P(I-1) is the value of the */ -/* k+1st iteration of the computation of the i'th derivative of */ -/* P. This can then be stored in P(I). */ - -/* If in a loop we compute in-place k'th iteration of the */ -/* I'th derivative before we perform the in-place k'th iteration */ -/* of the I-1st and I-2cnd derivative, then the k-1'th values */ -/* of the I-1st and I-2cnd will not be altered and will be available */ -/* for the computation of the k'th interation of the I-1st */ -/* derivative. This observation gives us an economical way to */ -/* compute all of the derivatives (including the zero'th derivative) */ -/* in place. We simply compute the iterates of the high order */ -/* derivatives first. */ - -/* Initialize the polynomial value (and all of its derivatives) to be */ -/* zero. */ - - i__1 = *nderiv; - for (i__ = 0; i__ <= i__1; ++i__) { - p[i__] = 0.; - } - -/* Set up the loop "counters" (they count backwards) for the first */ -/* pass through the loop. */ - - k = *deg; - i__ = *nderiv; - scale = (doublereal) (*nderiv); - while(k >= 0) { - while(i__ > 0) { - p[i__] = *t * p[i__] + scale * p[i__ - 1]; - scale += -1; - --i__; - } - p[0] = *t * p[0] + coeffs[k]; - --k; - i__ = *nderiv; - scale = (doublereal) (*nderiv); - } - return 0; -} /* polyds_ */ - diff --git a/ext/spice/src/cspice/pool.c b/ext/spice/src/cspice/pool.c deleted file mode 100644 index ccebe1716c..0000000000 --- a/ext/spice/src/cspice/pool.c +++ /dev/null @@ -1,8085 +0,0 @@ -/* pool.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5003 = 5003; -static integer c_b8 = 200000; -static integer c__4000 = 4000; -static integer c__1000 = 1000; -static integer c__50030 = 50030; -static integer c__1 = 1; -static integer c__32 = 32; - -/* $Procedure POOL ( Maintain a pool of kernel variables ) */ -/* Subroutine */ int pool_0_(int n__, char *kernel, integer *unit, char * - name__, char *names, integer *nnames, char *agent, integer *n, - doublereal *values, logical *found, logical *update, integer *start, - integer *room, char *cvals, integer *ivals, char *type__, char * - uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen - kernel_len, ftnlen name_len, ftnlen names_len, ftnlen agent_len, - ftnlen cvals_len, ftnlen type_len, ftnlen uwvars_len, ftnlen - uwagnt_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - cilist ci__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio( - integer *, char *, ftnlen), e_wsfe(void), i_dnnt(doublereal *), - i_len(char *, ftnlen); - - /* Local variables */ - static integer head, code, need, free, node; - static char line[132]; - static integer tail, hits; - extern /* Subroutine */ int zzgapool_(char *, char *, integer *, integer * - , char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - static integer i__, j, k; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int zznwpool_(char *, char *, integer *, integer * - , char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen); - static integer r__, begin; - extern logical elemc_(char *, char *, ftnlen, ftnlen); - static integer dnode, space, avail; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer nnode; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - lnkan_(integer *, integer *); - static doublereal small; - extern /* Subroutine */ int movec_(char *, integer *, char *, ftnlen, - ftnlen), errdp_(char *, doublereal *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int copyc_(char *, char *, ftnlen, ftnlen), - ioerr_(char *, char *, integer *, ftnlen, ftnlen), movei_(integer - *, integer *, integer *); - extern integer lnktl_(integer *, integer *); - static logical gotit; - static integer nvars__; - extern integer rtrim_(char *, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int zzcln_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - static integer nptrs; - extern logical failed_(void); - static integer datahd; - static char begdat[10]; - static logical dp; - static integer agnode; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - static integer chnode; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical matchi_(char *, char *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen); - static integer nameat, nfetch, nw, dpnode; - extern /* Subroutine */ int lnkila_(integer *, integer *, integer *); - static char active[32*50036]; - extern /* Subroutine */ int inslac_(char *, integer *, integer *, char *, - integer *, ftnlen, ftnlen); - static integer margin; - extern /* Subroutine */ int remlai_(integer *, integer *, integer *, - integer *); - static char cvalue[132]; - extern integer lnknfn_(integer *), lastnb_(char *, ftnlen); - static char begtxt[10]; - extern integer intmax_(void), intmin_(void); - static char pnames[32*5003]; - static integer namlst[5003]; - extern integer lstltc_(char *, integer *, char *, ftnlen, ftnlen), - zzhash_(char *, ftnlen); - static integer nmpool[10018] /* was [2][5009] */, datlst[5003], - chpool[8012] /* was [2][4006] */, dppool[400012] /* - was [2][200006] */; - static char chvals[80*4000]; - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - static doublereal dpvals[200000]; - static char wtagnt[32*50030], agents[32*50036], notify[32*50036]; - static integer wtpool[100072] /* was [2][50036] */; - static char wtvars[32*5009], finish[2], varnam[32]; - static doublereal dvalue; - static integer iostat, iquote, linnum, lookat, nnodes, tofree, varlen, - wtptrs[5003]; - static logical noagnt, succes, vector; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), zzpini_(logical *, integer *, - integer *, integer *, char *, char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, char *, - integer *, integer *, char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), lnkini_(integer * - , integer *), rdknew_(char *, ftnlen), zzrvar_(integer *, integer - *, char *, integer *, integer *, doublereal *, integer *, char *, - char *, logical *, ftnlen, ftnlen, ftnlen), cltext_(char *, - ftnlen); - static doublereal big; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), inslai_( - integer *, integer *, integer *, integer *, integer *); - static logical eof; - extern /* Subroutine */ int insrtc_(char *, char *, ftnlen, ftnlen); - static logical chr; - extern /* Subroutine */ int removc_(char *, char *, ftnlen, ftnlen), - zzgpnm_(integer *, integer *, char *, integer *, integer *, - doublereal *, integer *, char *, char *, logical *, integer *, - integer *, ftnlen, ftnlen, ftnlen), lnkfsl_(integer *, integer *, - integer *), zzrvbf_(char *, integer *, integer *, integer *, - integer *, char *, integer *, integer *, doublereal *, integer *, - char *, char *, logical *, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Maintain a pool of variables read from SPICE ASCII kernel files. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* KERNEL I LDPOOL */ -/* UNIT I WRPOOL */ -/* NAME I RTPOOL, EXPOOL, GIPOOL, GDPOOL, GCPOOL, PCPOOL, */ -/* PDPOOL, PIPOOL, DTPOOL, SZPOOL, DVPOOL, GNPOOL */ -/* NAMES I SWPOOL */ -/* NNAMES I SWPOOL */ -/* AGENT I CVPOOL, DWPOOL, SWPOOL */ -/* N I/O RTPOOL, GIPOOL, GCPOOL, GDPOOL, DTPOOL, PCPOOL, */ -/* PDPOOL, PIPOOL, LMPOOL, SZPOOL, GNPOOL */ -/* VALUES I/O RTPOOL GDPOOL, PDPOOL */ -/* FOUND O RTPOOL, EXPOOL, GIPOOL, GCPOOL, GDPOOL, DTPOOL, */ -/* SZPOOL, GNPOOL */ -/* UPDATE O CVPOOL */ -/* START I GIPOOL, GDPOOL, GCPOOL, GNPOOL */ -/* ROOM I GIPOOL, GDPOOL, GCPOOL. GNPOOL */ -/* CVALS I/O GCPOOL, PCPOOL, LMPOOL, GNPOOL */ -/* IVALS I/O GIPOOL, PIPOOL */ -/* TYPE O DTPOOL */ -/* UWVARS O ZZVUPOOL */ -/* UWPTRS O ZZVUPOOL */ -/* UWPOOL O ZZVUPOOL */ -/* UWAGNT O ZZVUPOOL */ - -/* MAXVAR P (All) */ -/* MAXLEN P (All) */ -/* MAXVAL P (All) */ -/* MAXAGT P (All) */ -/* MXNOTE P (All) */ -/* BEGDAT P WRPOOL */ -/* BEGTXT P WRPOOL */ - -/* $ Detailed_Input */ - -/* See the ENTRY points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the ENTRY points for a discussion of their arguments. */ - -/* $ Parameters */ - -/* MAXVAR is the maximum number of variables that the */ -/* kernel pool may contain at any one time. */ -/* MAXVAR should be a prime number. */ - -/* Here's a list of primes that should make */ -/* it easy to upgrade MAXVAR when/if the need arises. */ - -/* 103 */ -/* 199 */ -/* 307 */ -/* 401 */ -/* 503 */ -/* 601 */ -/* 701 */ -/* 751 */ -/* 811 */ -/* 911 */ -/* 1013 */ -/* 1213 */ -/* 1303 */ -/* 1511 */ -/* 1811 */ -/* 1913 */ -/* 2003 */ -/* 2203 */ -/* 2503 */ -/* 2803 */ -/* 3203 */ -/* 3607 */ -/* 4001 */ -/* 4507 */ -/* 4801 */ -/* 5003 Current Value */ -/* 6007 */ -/* 6521 */ -/* 7001 */ -/* 7507 */ -/* 8009 */ -/* 8501 */ -/* 9001 */ -/* 9511 */ -/* 10007 */ -/* 10501 */ -/* 11003 */ -/* 11503 */ - - -/* MAXLEN is the maximum length of the variable names that */ -/* can be stored in the kernel pool (also set in */ -/* zzrvar.f). */ - -/* MAXVAL is the maximum number of distinct values that */ -/* may belong to the variables in the kernel pool. */ -/* Each variable must have at least one value, and */ -/* may have any number, so long as the total number */ -/* does not exceed MAXVAL. MAXVAL must be at least */ -/* as large as MAXVAR. */ - -/* MAXAGT is the maximum number of agents that can be */ -/* associated with a given kernel variable. */ - -/* MAXCHR is the maximum number of characters that can be */ -/* stored in a component of a string valued kernel */ -/* variable. */ - -/* MXNOTE is the maximum sum of the sizes of the sets of */ -/* agents in the range of the mapping that associates */ -/* with each watched kernel variable a set of agents */ -/* that "watch" that variable. */ - -/* MAXLIN is the maximum number of character strings that */ -/* can be stored as data for kernel pool variables. */ - -/* $ Exceptions */ - -/* 1) If POOL is called directly, the error SPICE(BOGUSENTRY) is */ -/* signaled. */ - -/* $ Files */ - -/* See the ENTRY points for a discussion of their arguments. */ - -/* $ Particulars */ - -/* POOL should never be called directly, but should instead be */ -/* accessed only through its entry points. */ - -/* The purpose of this routine is to maintain a pool of variables */ -/* read from ASCII kernel files. The following entry points may be */ -/* used to access the pool. */ - -/* CLPOOL Clears the pool. */ - -/* LDPOOL Loads the variables from a kernel file into */ -/* the pool. */ - -/* RTPOOL Returns the value of a variable from */ -/* the pool. (Obsolete use GDPOOL) */ - -/* EXPOOL Confirms the existence of a numeric */ -/* variable in the pool. */ - -/* WRPOOL Writes the contents of the pool to an */ -/* ASCII kernel file. */ - -/* SWPOOL Sets up a "watcher" on a variable so that */ -/* various "agents" can be notified when a */ -/* variable has been updated. */ - -/* CVPOOL Indicates whether or not an agent's */ -/* variable has been updated since the last */ -/* time an agent checked with the pool. */ - -/* GCPOOL Returns the value of a string valued */ -/* variable in the pool. */ - -/* GDPOOL Returns the d.p. value of a numeric valued */ -/* variable in the pool. */ - -/* GIPOOL Returns the integer value of a numeric valued */ -/* variable in the pool. */ - -/* DTPOOL Returns the attributes of a variable in the */ -/* pool. */ - -/* PCPOOL Allows the insertion of a character variable */ -/* directly into the kernel pool without */ -/* supplying a text kernel. */ - -/* PDPOOL Allows the insertion of a double precision */ -/* variable directly into the kernel pool */ -/* without supplying a text kernel. */ - -/* PIPOOL Allows the insertion of an integer variable */ -/* directly into the kernel pool without */ -/* supplying a text kernel. */ - -/* LMPOOL Similar to LDPOOL, but the text kernel is */ -/* stored in an array of strings instead of an */ -/* external file. */ - -/* SZPOOL allows run time retrieval of kernel pool */ -/* memory parameters. */ - -/* DVPOOL allows deletion of a specific variable from */ -/* the kernel pool. (CLPOOL deletes all */ -/* variables from the kernel pool.) */ - -/* GNPOOL assists in determining which variables are */ -/* defined in the kernel pool via variable name */ -/* template matching. */ - -/* DWPOOL deletes a watch from the watcher system. */ - -/* Nominally, the kernel pool contains up to MAXVAR separate */ -/* variables, up to MAXVAL numeric values, and up to MAXLIN string */ -/* values. The names of the individual variables may contain up to */ -/* MAXLEN characters. */ - -/* $ Examples */ - -/* The following code fragment demonstrates how the data from */ -/* several kernel files can be loaded into a kernel pool. After the */ -/* pool is loaded, the values in the pool are written to a kernel */ -/* file. */ - -/* C */ -/* C Store in an array the names of the kernel files whose */ -/* C values will be loaded into the kernel pool. */ -/* C */ -/* KERNEL (1) = 'AXES.KER' */ -/* KERNEL (2) = 'GM.KER' */ -/* KERNEL (3) = 'LEAP_SECONDS.KER' */ - -/* C */ -/* C Clear the kernel pool. (This is optional.) */ -/* C */ -/* CALL CLPOOL */ - -/* C */ -/* C Load the variables from the three kernel files into the */ -/* C the kernel pool. */ -/* C */ -/* DO I = 1, 3 */ -/* CALL LDPOOL ( KERNEL (I) ) */ -/* END DO */ - -/* C */ -/* C We can examine the values associated with any d.p. variable */ -/* C in the kernel pool using GDPOOL. */ -/* C */ -/* CALL GDPOOL ( VARIABLE, START, ROOM, NVALS, VALUES, FOUND ) */ - -/* C */ -/* C Open the text file 'NEWKERNEL.KER'. */ -/* C */ -/* CALL TXTOPN ( NEWKERNEL.KER', UNIT ) */ - -/* C */ -/* C Write the values in the kernel pool to the file. */ -/* C */ -/* CALL WRPOOL ( UNIT ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 10.0.0, 24-MAY-2010 (EDW) (NJB) */ - -/* Added an error check on the length of the kernel pool variable */ -/* name argument in: */ - -/* PCPOOL */ -/* PDPOOL */ -/* PIPOOL */ - -/* to enforce the variable name length does not exceed MAXLEN. */ - -/* Increased MAXVAL to 200000. */ - -/* - SPICELIB Version 9.0.0, 19-MAR-2009 (NJB) */ - -/* Added watch deletion entry point DWPOOL and private entry */ -/* point ZZVUPOOL. Re-implemented watcher system to improve */ -/* efficiency, particularly of watch deletion. Bug fix: corrected */ -/* watcher overflow detection logic in SWPOOL. Updated header */ -/* code examples to use TXTOPN instead of GETLUN and a Fortran */ -/* OPEN statement; also to use GDPOOL instead of RTPOOL, except in */ -/* the header of RTPOOL itself. */ - -/* Code examples in SWPOOL and CVPOOL were updated to handle */ -/* kernel pool fetch failures. */ - -/* Existing entry points modified as part of this update were: */ - -/* POOL */ -/* CLPOOL */ -/* CVPOOL */ -/* DTPOOL */ -/* DVPOOL */ -/* EXPOOL */ -/* GCPOOL */ -/* GDPOOL */ -/* GIPOOL */ -/* GNPOOL */ -/* LDPOOL */ -/* LMPOOL */ -/* PCPOOL */ -/* PDPOOL */ -/* PIPOOL */ -/* RTPOOL */ -/* SWPOOL */ -/* WRPOOL */ - -/* Code examples using RTPOOL were updated to use GDPOOL, except */ -/* in the header of RTPOOL itself. Code examples using GETLUN and */ -/* an in-line Fortran OPEN statement were updated to use TXTOPN. */ - -/* Various typos in comments throughout this file were fixed. */ - - -/* - SPICELIB Version 8.3.0, 22-DEC-2004 (NJB) */ - -/* Fixed bug in DVPOOL. Made corrections to comments in */ -/* other entry points. The updated routines are DTPOOL, */ -/* DVPOOL, EXPOOL, GCPOOL, GDPOOL, GIPOOL, RTPOOL. */ - -/* - SPICELIB Version 8.2.0, 24-JAN-2003 (BVS) */ - -/* Increased MAXVAL to 40000. */ - -/* - SPICELIB Version 8.1.0, 13-MAR-2001 (FST) (NJB) */ - -/* Increased kernel pool size and agent parameters. MAXVAR is now */ -/* 5003, MAXVAL is 10000, MAXLIN is 4000, MXNOTE is 2000, and */ -/* MAXAGT is 1000. */ - -/* Modified Fortran output formats used in entry point WRPOOL to */ -/* remove list-directed formatting. This change was made to */ -/* work around problems with the way f2c translates list- */ -/* directed I/O. */ - - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* The entry point RTPOOL should now be regarded as obsolete */ -/* and is maintained solely for backward compatibility with */ -/* existing routines that make use of it. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL and CVPOOL were added. */ - -/* - SPICELIB Version 5.0.0, 22-AUG-1990 (NJB) */ - -/* Increased value of parameter MAXVAL to 5000 to accommodate */ -/* storage of SCLK coefficients in the kernel pool. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 3.0.0, 23-OCT-1989 (HAN) */ - -/* Added declaration of FAILED. FAILED is checked in the */ -/* DO-loops in LDPOOL and WRPOOL to prevent infinite looping. */ - -/* - SPICELIB Version 2.0.0, 18-OCT-1989 (RET) */ - -/* A FAILED test was inserted into the control of the DO-loop which */ -/* reads in each kernel variable in LDPOOL. */ - -/* - SPICELIB Version 1.2.0, 9-MAR-1989 (HAN) */ - -/* Parameters BEGDAT and BEGTXT have been moved into the */ -/* Declarations section. */ - -/* - SPICELIB Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Parameters MAXVAR, MAXVAL, MAXLEN moved into Declarations. */ -/* (Actually, MAXLEN was implicitly 32 characters, and has only */ -/* now been made an explicit---and changeable---limit.) */ - -/* Declaration of unused function FAILED removed. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* MAINTAIN a pool of kernel variables */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.3.0, 22-DEC-2004 (NJB) */ - -/* Fixed bug in DVPOOL. Made corrections to comments in */ -/* other entry points. The updated routines are DTPOOL, */ -/* DVPOOL, EXPOOL, GCPOOL, GDPOOL, GIPOOL, RTPOOL. */ - -/* - SPICELIB Version 8.2.0, 24-JAN-2003 (BVS) */ - -/* Increased MAXVAL to 40000. */ - -/* - SPICELIB Version 8.1.0, 13-MAR-2001 (FST) (NJB) */ - -/* Increased kernel pool size and agent parameters. MAXVAR is now */ -/* 5003, MAXVAL is 10000, MAXLIN is 4000, MXNOTE is 2000, and */ -/* MAXAGT is 1000. */ - -/* Modified Fortran output formats used in entry point WRPOOL to */ -/* remove list-directed formatting. This change was made to */ -/* work around problems with the way f2c translates list- */ -/* directed I/O. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* The entry point RTPOOL should now be regarded as obsolete */ -/* and is maintained solely for backward compatibility with */ -/* existing routines that make use of it. */ - -/* The basic data structure used to maintain the list of */ -/* variable names and values was replaced with a hash table */ -/* implementation. Data and names are accessed by means */ -/* of a hash function and linked lists of pointers to existing */ -/* variable names and data values. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL (set watch on a pool variable) */ -/* and CVPOOL (check variable for update) so that routines */ -/* that buffer data stored in the kernel pool can fetch */ -/* that data only when it is updated. */ - -/* Also the control of initializations was modified to be */ -/* consistent with other SPICELIB practices. */ - -/* Finally, the revision history was upgraded so that the */ -/* version number increases over time. This wasn't true */ -/* before. In addition some early revision data that referred to */ -/* pre-SPICELIB modifications were removed. This editing of */ -/* the version numbers makes it unlikely that anyone can track */ -/* down which previous version of this routine they have by */ -/* looking at the version number. The best way to determine */ -/* the routine you had previously is to compare the dates */ -/* stored in the Version line of the routine. */ - -/* - SPICELIB Version 5.0.0, 22-AUG-1990 (NJB) */ - -/* Increased value of parameter MAXVAL to 5000 to accommodate */ -/* storage of SCLK coefficients in the kernel pool. */ - -/* Also, changed version number in previous `Revisions' entry */ -/* from SPICELIB Version 2.0.0 to SPICELIB Version 2.0.0. The */ -/* last version entry in the `Version' section had been */ -/* Version 1.0.0, dated later than the entry for `version 2' */ -/* in the revisions section! */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 3.0.0, 23-OCT-1989 (HAN) */ - -/* Added declaration of FAILED. FAILED is checked in the */ -/* DO-loops in LDPOOL and WRPOOL to prevent infinite looping. */ - -/* - SPICELIB Version 2.0.0, 18-OCT-1989 (RET) */ - -/* A FAILED test was inserted into the control of the DO-loop which */ -/* reads in each kernel variable. */ - -/* Previously, if the error action 'RETURN' had been set by a */ -/* calling program, and the call to RDKNEW by LDPOOL failed, */ -/* then execution would continue through LDPOOL, with SPICELIB */ -/* routines returning upon entry. This meant that the routine */ -/* RDKVAR never got a chance to set the EOF flag, which was the */ -/* only control of the DO-loop. An infinite loop resulted in such */ -/* cases. The FAILED test resolves that situation. */ - -/* - SPICELIB Version 1.2.0, 9-MAR-1989 (HAN) */ - -/* Parameters BEGDAT and BEGTXT have been moved into the */ -/* Declarations section. */ - -/* - SPICELIB Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Parameters MAXVAR, MAXVAL, MAXLEN moved into Declarations. */ -/* (Actually, MAXLEN was implicitly 32 characters, and has only */ -/* now been made an explicit---and changeable---limit.) */ - -/* Declaration of unused function FAILED removed. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Private SPICELIB functions */ - - -/* Local Parameters */ - - -/* The next two variables are for use in traversing linked lists. */ - - -/* Local variables */ - - -/* Because some environments (such as the SUN) are too stupid to */ -/* treat the backslash character correctly we have to go through */ -/* some gyrations to put it into a variable in a "portable" way. */ -/* This is the reason for the following block of declarations. */ -/* Admittedly this is bizarre, but it works. */ - - -/* The following is the hash table used for holding kernel pool */ -/* variables. Here's the basic structure: */ - -/* The function ZZHASH computes the address of the head of a linked */ -/* list that contains the collisions for the range of ZZHASH. */ - -/* The head node of the collision lists is stored in NAMLST. */ - -/* If NAMLST has a value zero then */ - -/* there is no name corresponding to that value of the */ -/* hash function. */ - -/* If NAMLST is non-zero then */ - -/* it is the head node of the list of names that have been */ -/* stored so far. */ - -/* The list of addresses of names is stored in NMPOOL. */ -/* The names that have been stored so far are in PNAMES. */ - -/* The data associated with PNAMES is pointed to by DATLST */ -/* and CHPOOL or DPPOOL. If a name of interest is stored in */ -/* PNAMES(I) then the DATLST(I) points to the first data node */ -/* associated with the name. */ - -/* If DATLST(I) is less than zero then */ - -/* its opposite is the address of the first node of */ -/* character data associated with PNAMES(I). */ - -/* If DATLST(I) is positive then */ - -/* it points to the address of the first node of numeric */ -/* data associated with PNAMES(I). */ - -/* If DATLST(I) is zero */ - -/* there is no data associated with PNAMES(I). */ - - -/* The arrays DPPOOL and CHPOOL are linked list pools that */ -/* give the address lists of values associated with a name. */ - -/* The actual data is stored in DPVALS and CHVALS. */ - -/* Here's a picture of how this all works. */ - - -/* Linked list Pool */ -/* of HASH collisions */ -/* NAMLST NMPOOL PNAME */ -/* +------------+ +---------+ +--------+ */ -/* | | | | | | */ -/* +------------+ if not 0 +---------+ +--------+ */ -/* ZZHASH( NAME ) --->| Head Node | ---. | | | | */ -/* +------------+ | +---------+ +--------+ */ -/* | | | | | */ -/* | +---------+ +--------+ */ -/* `--> |Head of | |Name | */ -/* |collision| |corresp.| */ -/* |list for | -. |to head | */ -/* | NAME | | |of list | */ -/* +---------+ | +--------+ */ -/* | | | | | */ -/* +---------+ | +--------+ */ -/* | | | | | */ -/* +---------+ | +--------+ */ -/* |Next Node|<-' |NextName| */ -/* +---------+etc.+--------+ */ -/* . . */ -/* . . */ -/* . . */ -/* +---------+ +--------+ */ -/* | | | | */ -/* +---------+ +--------+ */ - - - - -/* Linked Variable Heads of */ -/* List Pool Names Data lists */ -/* NMPOOL PNAME DATLST */ -/* +--------+ +--------+ +---------+ Head of linked list */ -/* | | | | | | .--> in DPPOOL linked */ -/* +--------+ +--------+ +---------+ | list pool */ -/* | | | | | | | */ -/* +--------+ +--------+ +---------+ | Positive Value */ -/* | |<->| |<->| |---< */ -/* +--------+ +--------+ +---------+ | */ -/* | | | | | | | Negative Value */ -/* +--------+ +--------+ +---------+ | */ -/* | | | | | | `--> Opposite of head */ -/* +--------+ +--------+ +---------+ of linked list */ -/* | | | | | | in CHPOOL linked */ -/* +--------+ +--------+ +---------+ list pool. */ - - - - - -/* Linked Values */ -/* List Pool of data */ -/* DPPOOL (CHPOOL) DPVALS (CHVALS) */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | HEAD |--. <--> | head value | */ -/* +------------+ | +------------+ */ -/* | | | | | */ -/* +------------+ | +------------+ */ -/* | | | | | */ -/* +------------+ | +------------+ */ -/* | Node 2 |<-' <--> | 2nd value | */ -/* +------------+ etc. +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ -/* | | | | */ -/* +------------+ +------------+ */ - - - -/* The WT... variables make up the data structure that */ -/* maps variables to their associated agents (WTAGNT). */ -/* A diagram of the watcher data structure is shown below. */ - -/* Watched Heads of Agent linked Agent names */ -/* variables agent lists list pool */ -/* WTVARS WTPTR WTPOOL WTAGNT */ -/* +--------+ +--------+ +---------+ +---------+ */ -/* | | | | | | | | */ -/* +--------+ +--------+ +---------+ +---------+ */ -/* | | | | | | | | */ -/* +--------+ +--------+ +---------+ +---------+ */ -/* | |<->| |<->| |<->| | */ -/* +--------+ +--------+ +---------+ +---------+ */ -/* | | | | | | | | */ -/* +--------+ +--------+ +---------+ +---------+ */ -/* | | | | | | | | */ -/* +--------+ +--------+ +---------+ +---------+ */ -/* | | | | | | | | */ -/* +--------+ +--------+ +---------+ +---------+ */ - - - -/* Agents contains the list of agents that need to be notified */ -/* about updates to their variables. NOTIFY and ACTIVE are both */ -/* temporary sets. */ - -/* These variables are declared with the size MXNOTE because */ -/* they must be able to hold the largest possible number */ -/* of agents that could be associated with a kernel variable. */ - - -/* First is our initialization flag. */ - - -/* The remaining local variables... */ - - -/* Save EVERYTHING. */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (names) { - } - if (values) { - } - if (cvals) { - } - if (ivals) { - } - if (uwvars) { - } - if (uwptrs) { - } - if (uwpool) { - } - if (uwagnt) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_clpool; - case 2: goto L_ldpool; - case 3: goto L_rtpool; - case 4: goto L_expool; - case 5: goto L_wrpool; - case 6: goto L_swpool; - case 7: goto L_cvpool; - case 8: goto L_gcpool; - case 9: goto L_gdpool; - case 10: goto L_gipool; - case 11: goto L_dtpool; - case 12: goto L_pcpool; - case 13: goto L_pdpool; - case 14: goto L_pipool; - case 15: goto L_lmpool; - case 16: goto L_szpool; - case 17: goto L_dvpool; - case 18: goto L_gnpool; - case 19: goto L_dwpool; - case 20: goto L_zzvupool; - } - - -/* Set up the definition of our in-line functions. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("POOL", (ftnlen)4); - } - -/* This routine should never be called. If this routine is called, */ -/* an error is signaled. */ - - setmsg_("POOL: You have called an entry which performs performs no run-t" - "ime function. This may indicate a bug. Please check the document" - "ation for the subroutine POOL.", (ftnlen)157); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("POOL", (ftnlen)4); - return 0; -/* $Procedure CLPOOL ( Clear the pool of kernel variables ) */ - -L_clpool: -/* $ Abstract */ - -/* Remove all variables from the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) All known agents (those established through SWPOOL) will */ -/* be "notified" that their watched variables have been updated */ -/* whenever CLPOOL is called. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* CLPOOL clears the pool of kernel variables maintained by */ -/* the subroutine POOL. All the variables in the pool are deleted. */ -/* However, all watcher information is retained. */ - -/* Each watched variable will be regarded as having been updated. */ -/* Any agent associated with that variable will have a notice */ -/* posted for it indicating that it's watched variable has been */ -/* updated. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the data from */ -/* several kernel files can be loaded into a kernel pool. After the */ -/* pool is loaded, the values in the pool are written to a kernel */ -/* file. */ - - -/* C */ -/* C Store in an array the names of the kernel files whose */ -/* C values will be loaded into the kernel pool. */ -/* C */ -/* KERNEL (1) = 'AXES.KER' */ -/* KERNEL (2) = 'GM.KER' */ -/* KERNEL (3) = 'LEAP_SECONDS.KER' */ - -/* C */ -/* C Clear the kernel pool. (This is optional.) */ -/* C */ -/* CALL CLPOOL */ - -/* C */ -/* C Load the variables from the three kernel files into the */ -/* C the kernel pool. */ -/* C */ -/* DO I = 1, 3 */ -/* CALL LDPOOL ( KERNEL (I) ) */ -/* END DO */ - -/* C */ -/* C We can examine the values associated with any d.p. variable */ -/* C in the kernel pool using GDPOOL. */ -/* C */ -/* CALL GDPOOL ( VARIABLE, START, ROOM, NVALS, VALUES, FOUND ) */ - -/* C */ -/* C Open the text file 'NEWKERNEL.KER'. */ -/* C */ -/* CALL TXTOPN ( NEWKERNEL.KER', UNIT ) */ - -/* C */ -/* C Write the values in the kernel pool to the file. */ -/* C */ -/* CALL WRPOOL ( UNIT ) */ - - -/* $ Restrictions */ - -/* 1) This routine should not be used to unload kernels that */ -/* have been loaded via FURNSH. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. Updated Restrictions */ -/* header section. Updated code example to use TXTOPN. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* This entry point clears the string valued variables as well as */ -/* the numeric valued variables. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL and CVPOOL were added. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* CLEAR the pool of kernel variables */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* ZZNWPOOL is called to update the list of agents */ -/* to notify of watched variable updates. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* This entry point clears the string valued variables as well as */ -/* the numeric valued variables. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL (set watch on a pool variable) */ -/* and CVPOOL (check variable for update) so that routines */ -/* that buffer data stored in the kernel pool can fetch */ -/* that data only when it is updated. */ - - -/* Also the control of initializations was modified to be */ -/* consistent with other SPICELIB practices. */ - -/* Finally, the revision history was upgraded so that the */ -/* version number increases over time. This wasn't true */ -/* before. In addition some early revision data that referred to */ -/* pre-SPICELIB modifications were removed. This editing of */ -/* the version numbers makes it unlikely that anyone can track */ -/* down which previous version of this routine they have by */ -/* looking at the version number. The best way to determine */ -/* the routine you had previously is to compare the dates */ -/* stored in the Version line of the routine. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CLPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Wipe out all of the PNAMES data. */ - - for (i__ = 1; i__ <= 5003; ++i__) { - namlst[(i__1 = i__ - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge("namlst", - i__1, "pool_", (ftnlen)1304)] = 0; - datlst[(i__1 = i__ - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge("datlst", - i__1, "pool_", (ftnlen)1305)] = 0; - s_copy(pnames + (((i__1 = i__ - 1) < 5003 && 0 <= i__1 ? i__1 : - s_rnge("pnames", i__1, "pool_", (ftnlen)1306)) << 5), " ", ( - ftnlen)32, (ftnlen)1); - } - -/* Free up all of the space in all of the linked list pools, except */ -/* for the watcher pool. */ - - lnkini_(&c__5003, nmpool); - lnkini_(&c_b8, dppool); - lnkini_(&c__4000, chpool); - i__1 = cardc_(wtvars, (ftnlen)32); - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Union the update set AGENTS with the set of agents */ -/* associated with the Ith watched variable. */ - - zznwpool_(wtvars + (((i__2 = i__ + 5) < 5009 && 0 <= i__2 ? i__2 : - s_rnge("wtvars", i__2, "pool_", (ftnlen)1321)) << 5), wtvars, - wtptrs, wtpool, wtagnt, active, notify, agents, (ftnlen)32, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - } - chkout_("CLPOOL", (ftnlen)6); - return 0; -/* $Procedure LDPOOL ( Load variables from a kernel file into the pool ) */ - -L_ldpool: -/* $ Abstract */ - -/* Load the variables contained in a NAIF ASCII kernel file into the */ -/* kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) KERNEL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KERNEL I Name of the kernel file. */ - -/* $ Detailed_Input */ - -/* KERNEL is the name of the kernel file whose variables will be */ -/* loaded into the pool. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any I/O errors that occur while opening or reading a text */ -/* kernel will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* 2) Any text kernel parsing errors will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* 3) Any kernel pool overflow errors will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* $ Files */ - -/* The NAIF ASCII kernel file KERNEL is opened by RDKNEW. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The following code fragment demonstrates how the data from */ -/* several kernel files can be loaded into a kernel pool. After the */ -/* pool is loaded, the values in the pool are written to a kernel */ -/* file. */ - -/* C */ -/* C Store in an array the names of the kernel files whose */ -/* C values will be loaded into the kernel pool. */ -/* C */ -/* KERNEL (1) = 'AXES.KER' */ -/* KERNEL (2) = 'GM.KER' */ -/* KERNEL (3) = 'LEAP_SECONDS.KER' */ - -/* C */ -/* C Clear the kernel pool. (This is optional.) */ -/* C */ -/* CALL CLPOOL */ - -/* C */ -/* C Load the variables from the three kernel files into the */ -/* C the kernel pool. */ -/* C */ -/* DO I = 1, 3 */ -/* CALL LDPOOL ( KERNEL (I) ) */ -/* END DO */ - -/* C */ -/* C We can examine the values associated with any d.p. variable */ -/* C in the kernel pool using GDPOOL. */ -/* C */ -/* CALL GDPOOL ( VARIABLE, START, ROOM, NVALS, VALUES, FOUND ) */ - -/* C */ -/* C Open the new text file 'NEWKERNEL.KER'. */ -/* C */ -/* CALL TXTOPN ( 'NEWKERNEL.KER', UNIT ) */ - -/* C */ -/* C Write the values in the kernel pool to the file. */ -/* C */ -/* CALL WRPOOL ( UNIT ) */ - - -/* $ Restrictions */ - -/* 1) Normally SPICE applications should load kernels via the */ -/* FURNSH entry point of the KEEPER routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* Filled out Exceptions section of header, which previously */ -/* contained only the word "None." */ - -/* Updated code example to use TXTOPN. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* In addition much greater error checking is performed on */ -/* the input file to guarantee valid inputs. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL and CVPOOL were added. */ - -/* - SPICELIB Version 5.0.0, 22-AUG-1990 (NJB) */ - -/* Increased value of parameter MAXVAL to 5000 to accommodate */ -/* storage of SCLK coefficients in the kernel pool. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 3.0.0, 23-OCT-1989 (HAN) */ - -/* Added declaration of FAILED. FAILED is checked in the */ -/* DO-loops in LDPOOL and WRPOOL to prevent infinite looping. */ - -/* - SPICELIB Version 2.0.0, 18-OCT-1989 (RET) */ - -/* A FAILED test was inserted into the control of the DO-loop which */ -/* reads in each kernel variable in LDPOOL. */ - -/* - SPICELIB Version 1.2.0, 9-MAR-1989 (HAN) */ - -/* Parameters BEGDAT and BEGTXT have been moved into the */ -/* Declarations section. */ - -/* - SPICELIB Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Parameters MAXVAR, MAXVAL, MAXLEN moved into Declarations. */ -/* (Actually, MAXLEN was implicitly 32 characters, and has only */ -/* now been made an explicit---and changeable---limit.) */ - -/* Declaration of unused function FAILED removed. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* LOAD variables from a text kernel file into the pool */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* The entry point RTPOOL should now be regarded as obsolete */ -/* and is maintained solely for backward compatibility with */ -/* existing routines that make use of it. */ - -/* The basic data structure used to maintain the list of */ -/* variable names and values was replaced with a hash table */ -/* implementation. Data and names are accessed by means */ -/* of a hash function and linked lists of pointers to existing */ -/* variable names and data values. */ - -/* In addition much greater error checking is performed on */ -/* the input file to guarantee valid inputs. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL (set watch on a pool variable) */ -/* and CVPOOL (check variable for update) so that routines */ -/* that buffer data stored in the kernel pool can fetch */ -/* that data only when it is updated. */ - -/* In addition, the revision history was upgraded so that the */ -/* version number increases over time. This wasn't true */ -/* before. In addition some early revision data that referred to */ -/* pre-SPICELIB modifications were removed. This editing of */ -/* the version numbers makes it unlikely that anyone can track */ -/* down which previous version of this routine they have by */ -/* looking at the version number. The best way to determine */ -/* the routine you had previously is to compare the dates */ -/* stored in the Version line of the routine. */ - -/* - SPICELIB Version 5.0.0, 22-AUG-1990 (NJB) */ - -/* Increased value of parameter MAXVAL to 5000 to accommodate */ -/* storage of SCLK coefficients in the kernel pool. */ - -/* Also, changed version number in previous `Revisions' entry */ -/* from SPICELIB Version 2.0.0 to SPICELIB Version 2.0.0. The */ -/* last version entry in the `Version' section had been */ -/* Version 1.0.0, dated later than the entry for `version 2' */ -/* in the revisions section! */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 3.0.0, 23-OCT-1989 (HAN) */ - -/* Added declaration of FAILED. FAILED is checked in the */ -/* DO-loops in LDPOOL and WRPOOL to prevent infinite looping. */ - -/* - SPICELIB Version 2.0.0, 18-OCT-1989 (RET) */ - -/* A FAILED test was inserted into the control of the DO-loop which */ -/* reads in each kernel variable. */ - -/* Previously, if the error action 'RETURN' had been set by a */ -/* calling program, and the call to RDKNEW by LDPOOL failed, */ -/* then execution would continue through LDPOOL, with SPICELIB */ -/* routines returning upon entry. This meant that the routine */ -/* RDKVAR never got a chance to set the EOF flag, which was the */ -/* only control of the DO-loop. An infinite loop resulted in such */ -/* cases. The FAILED test resolves that situation. */ - -/* - SPICELIB Version 1.2.0, 9-MAR-1989 (HAN) */ - -/* Parameters BEGDAT and BEGTXT have been moved into the */ -/* Declarations section. */ - -/* - SPICELIB Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Parameters MAXVAR, MAXVAL, MAXLEN moved into Declarations. */ -/* (Actually, MAXLEN was implicitly 32 characters, and has only */ -/* now been made an explicit---and changeable---limit.) */ - -/* Declaration of unused function FAILED removed. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LDPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Open the kernel file and read the first variable. */ - - rdknew_(kernel, kernel_len); - zzrvar_(namlst, nmpool, pnames, datlst, dppool, dpvals, chpool, chvals, - varnam, &eof, (ftnlen)32, (ftnlen)80, (ftnlen)32); - -/* Read the variables in the file, one at a time. */ - - while(! eof && ! failed_()) { - if (s_cmp(varnam, " ", (ftnlen)32, (ftnlen)1) != 0) { - -/* See if this variable is being watched; if it is, add its */ -/* associated agents to the list of AGENTS to be notified of a */ -/* watched variable update. */ - - if (elemc_(varnam, wtvars, (ftnlen)32, (ftnlen)32)) { - -/* Union the update set AGENTS with the set of agents */ -/* associated with the variable NAME. */ - - zznwpool_(varnam, wtvars, wtptrs, wtpool, wtagnt, active, - notify, agents, (ftnlen)32, (ftnlen)32, (ftnlen)32, ( - ftnlen)32, (ftnlen)32, (ftnlen)32); - } - } - zzrvar_(namlst, nmpool, pnames, datlst, dppool, dpvals, chpool, - chvals, varnam, &eof, (ftnlen)32, (ftnlen)80, (ftnlen)32); - } - -/* We need to make sure that the kernel file gets closed. Normally */ -/* the calling tree of ZZRVAR take care of this, but if a parsing */ -/* or syntax error occurs there, ZZRVAR just returns and the */ -/* closing of the kernel is never handled. This takes care */ -/* of the problem. If the file has been closed already, this */ -/* doesn't hurt anything. */ - - cltext_(kernel, kernel_len); - chkout_("LDPOOL", (ftnlen)6); - return 0; -/* $Procedure RTPOOL ( Return the value of a pooled kernel variable ) */ - -L_rtpool: -/* $ Abstract */ - -/* Return the value of a kernel variable from the kernel pool. */ - -/* This routine is maintained only for backward compatibility. */ -/* It should be regarded as obsolete. Use one of the entry points */ -/* GDPOOL, GIPOOL or GCPOOL in its place. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER N */ -/* DOUBLE PRECISION VALUES ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable whose value is to be returned. */ -/* N O Number of values associated with NAME. */ -/* VALUES O Values associated with NAME. */ -/* FOUND O True if variable is in pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the variable whose values are to be */ -/* returned. If the variable is not in the pool, FOUND */ -/* will be FALSE. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with NAME. */ -/* If NAME is not in the pool, no value is given to */ -/* N. */ - -/* VALUES is the array of values associated with NAME. */ -/* If NAME is not in the pool, no values are given to */ -/* the elements of VALUES. */ - -/* FOUND is TRUE if the variable is in the pool, FALSE if it */ -/* is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the data from */ -/* several kernel files can be loaded into a kernel pool. After the */ -/* pool is loaded, the values in the pool are written to a kernel */ -/* file. */ - - -/* C */ -/* C Store in an array the names of the kernel files whose */ -/* C values will be loaded into the kernel pool. */ -/* C */ -/* KERNEL (1) = 'AXES.KER' */ -/* KERNEL (2) = 'GM.KER' */ -/* KERNEL (3) = 'LEAP_SECONDS.KER' */ - -/* C */ -/* C Clear the kernel pool. (This is optional.) */ -/* C */ -/* CALL CLPOOL */ - -/* C */ -/* C Load the variables from the three kernel files into the */ -/* C the kernel pool. */ -/* C */ -/* DO I = 1, 3 */ -/* CALL LDPOOL ( KERNEL (I) ) */ -/* END DO */ - -/* C */ -/* C We can examine the values associated with any variable */ -/* C in the kernel pool using RTPOOL. */ -/* C */ -/* CALL RTPOOL ( VARIABLE, NUMVAL, VALUES, FOUND ) */ - -/* C */ -/* C Open the new text file 'NEWKERNEL.KER'. */ -/* C */ -/* CALL TXTOPN ( 'NEWKERNEL.KER', UNIT ) */ - -/* C */ -/* C Write the values in the kernel pool to the file. */ -/* C */ -/* CALL WRPOOL ( UNIT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* Updated code example to use TXTOPN. */ - -/* - SPICELIB Version 8.0.1, 22-DEC-2004 (NJB) */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* The entry point RTPOOL should now be regarded as obsolete */ -/* and is maintained solely for backward compatibility with */ -/* existing routines that make use of it. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* RETURN the value of a pooled kernel variable */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RTPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__1 = lookat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge("naml" - "st", i__1, "pool_", (ftnlen)2019)] == 0) { - *found = FALSE_; - chkout_("RTPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - node = namlst[(i__1 = lookat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "namlst", i__1, "pool_", (ftnlen)2031)]; - succes = s_cmp(name__, pnames + (((i__1 = node - 1) < 5003 && 0 <= i__1 ? - i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen)2032)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - node = nmpool[(i__1 = (node << 1) + 10) < 10018 && 0 <= i__1 ? i__1 : - s_rnge("nmpool", i__1, "pool_", (ftnlen)2036)]; - if (node < 0) { - *found = FALSE_; - chkout_("RTPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__1 = node - 1) < 5003 && 0 <= - i__1 ? i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen)2046)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* If you get to this point, the variable NAME is present in the */ -/* list of names at PNAMES(NODE), ABS( DATLST(NODE) ) points to the */ -/* head of a linked list of values for this NAME. */ - -/* However, recall that RTPOOL can only return d.p. values. */ -/* DATLST(NODE) is the head of a d.p. list of values if it */ -/* is positive. We use negative values to point to character */ -/* values. */ - - if (datlst[(i__1 = node - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge("datlst", - i__1, "pool_", (ftnlen)2059)] <= 0) { - *found = FALSE_; - } else { - *found = TRUE_; - *n = 0; - node = datlst[(i__1 = node - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)2067)]; - while(node > 0) { - ++(*n); - values[*n - 1] = dpvals[(i__1 = node - 1) < 200000 && 0 <= i__1 ? - i__1 : s_rnge("dpvals", i__1, "pool_", (ftnlen)2071)]; - node = dppool[(i__1 = (node << 1) + 10) < 400012 && 0 <= i__1 ? - i__1 : s_rnge("dppool", i__1, "pool_", (ftnlen)2072)]; - } - } - chkout_("RTPOOL", (ftnlen)6); - return 0; -/* $Procedure EXPOOL ( Confirm the existence of a pooled kernel variable ) */ - -L_expool: -/* $ Abstract */ - -/* Confirm the existence of a kernel variable in the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable whose value is to be returned. */ -/* FOUND O True when the variable is in the pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the variable whose values are to be */ -/* returned. */ - -/* $ Detailed_Output */ - -/* FOUND is true whenever the specified variable is included */ -/* in the pool. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether or not a numeric kernel pool */ -/* variable exists. It does not detect the existence of */ -/* string valued kernel pool variables. */ - -/* A better routine for determining the existence of kernel pool */ -/* variables is the entry point DTPOOL which determines the */ -/* existence, size and type of kernel pool variables. */ - -/* $ Examples */ - -/* See BODFND. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* Fixed typos. */ - -/* - SPICELIB Version 8.0.1, 22-DEC-2004 (NJB) */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* CONFIRM the existence of a pooled kernel variable */ - -/* -& */ -/* $ Revisions */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* The entry point RTPOOL should now be regarded as obsolete */ -/* and is maintained solely for backward compatibility with */ -/* existing routines that make use of it. */ - -/* The basic data structure used to maintain the list of */ -/* variable names and values was replaced with a hash table */ -/* implementation. Data and names are accessed by means */ -/* of a hash function and linked lists of pointers to existing */ -/* variable names and data values. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EXPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__1 = lookat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge("naml" - "st", i__1, "pool_", (ftnlen)2304)] == 0) { - *found = FALSE_; - chkout_("EXPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - node = namlst[(i__1 = lookat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "namlst", i__1, "pool_", (ftnlen)2316)]; - succes = s_cmp(name__, pnames + (((i__1 = node - 1) < 5003 && 0 <= i__1 ? - i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen)2317)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - node = nmpool[(i__1 = (node << 1) + 10) < 10018 && 0 <= i__1 ? i__1 : - s_rnge("nmpool", i__1, "pool_", (ftnlen)2321)]; - if (node < 0) { - *found = FALSE_; - chkout_("EXPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__1 = node - 1) < 5003 && 0 <= - i__1 ? i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen)2331)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* If you get to this point, the variable NAME is present in the */ -/* list of names at PNAMES(NODE), ABS( DATLST(NODE) ) points to the */ -/* head of a linked list of values for this NAME. */ - -/* However, recall that EXPOOL indicates the existence only of */ -/* d.p. values. */ - - *found = datlst[(i__1 = node - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)2342)] > 0; - chkout_("EXPOOL", (ftnlen)6); - return 0; -/* $Procedure WRPOOL ( Write the values in pool to a specified unit ) */ - -L_wrpool: -/* $ Abstract */ - -/* Write the values in the pool to the specified unit. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit to which the values in the pool will */ -/* be written. */ - -/* $ Detailed_Input */ - -/* UNIT is the logical unit to which the values in the pool */ -/* will be written. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* If the values are to be written to an output kernel file, the */ -/* file should be opened with a logical unit determined by the */ -/* calling program. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the data from */ -/* several kernel files can be loaded into a kernel pool. After the */ -/* pool is loaded, the values in the pool are written to a kernel */ -/* file. */ - - -/* C */ -/* C Store in an array the names of the kernel files whose */ -/* C values will be loaded into the kernel pool. */ -/* C */ -/* KERNEL (1) = 'AXES.KER' */ -/* KERNEL (2) = 'GM.KER' */ -/* KERNEL (3) = 'LEAP_SECONDS.KER' */ - -/* C */ -/* C Clear the kernel pool. (This is optional.) */ -/* C */ -/* CALL CLPOOL */ - -/* C */ -/* C Load the variables from the three kernel files into the */ -/* C the kernel pool. */ -/* C */ -/* DO I = 1, 3 */ -/* CALL LDPOOL ( KERNEL (I) ) */ -/* END DO */ - -/* C */ -/* C We can examine the values associated with any double */ -/* C precision variable in the kernel pool using GDPOOL. */ -/* C */ -/* CALL GDPOOL ( VARIABLE, 1, NMAX, NUMVAL, VALUES, FOUND ) */ - -/* C */ -/* C Open the new text file 'NEWKERNEL.KER'. */ -/* C */ -/* CALL TXTOPN ( 'NEWKERNEL.KER', UNIT ) */ - -/* C */ -/* C Write the values in the kernel pool to the file. */ -/* C */ -/* CALL WRPOOL ( UNIT ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Updated code example to use TXTOPN. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. Both types are supported */ -/* by WRPOOL. */ - -/* - SPICELIB Version 5.0.0, 22-AUG-1990 (NJB) */ - -/* Increased value of parameter MAXVAL to 5000 to accommodate */ -/* storage of SCLK coefficients in the kernel pool. */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 3.0.0, 23-OCT-1989 (HAN) */ - -/* Added declaration of FAILED. FAILED is checked in the */ -/* DO-loops in LDPOOL and WRPOOL to prevent infinite looping. */ - -/* - SPICELIB Version 1.2.0, 9-MAR-1989 (HAN) */ - -/* Parameters BEGDAT and BEGTXT have been moved into the */ -/* Declarations section. */ - -/* - SPICELIB Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Parameters MAXVAR, MAXVAL, MAXLEN moved into Declarations. */ -/* (Actually, MAXLEN was implicitly 32 characters, and has only */ -/* now been made an explicit---and changeable---limit.) */ - -/* Declaration of unused function FAILED removed. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* WRITE the values in pool to a specified unit */ - -/* -& */ -/* $ Revisions */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The basic data structure used to maintain the list of */ -/* variable names and values was replaced with a hash table */ -/* implementation. Data and names are accessed by means */ -/* of a hash function and linked lists of pointers to existing */ -/* variable names and data values. */ - -/* - SPICELIB Version 5.0.0, 22-AUG-1990 (NJB) */ - -/* Increased value of parameter MAXVAL to 5000 to accommodate */ -/* storage of SCLK coefficients in the kernel pool. */ - -/* Also, changed version number in previous `Revisions' entry */ -/* from SPICELIB Version 2.0.0 to SPICELIB Version 2.0.0. The */ -/* last version entry in the `Version' section had been */ -/* Version 1.0.0, dated later than the entry for `version 2' */ -/* in the revisions section! */ - -/* - SPICELIB Version 4.0.0, 12-JUN-1990 (IMU) */ - -/* All entry points except POOL and CLPOOL now initialize the */ -/* pool if it has not been done yet. */ - -/* - SPICELIB Version 3.0.0, 23-OCT-1989 (HAN) */ - -/* Added declaration of FAILED. FAILED is checked in the */ -/* DO-loops in LDPOOL and WRPOOL to prevent infinite looping. */ - -/* - SPICELIB Version 2.0.0, 18-OCT-1989 (RET) */ - -/* A FAILED test was inserted into the control of the DO-loop which */ -/* reads in each kernel variable. */ - -/* Previously, if the error action 'RETURN' had been set by a */ -/* calling program, and the call to RDKNEW by LDPOOL failed, */ -/* then execution would continue through LDPOOL, with SPICELIB */ -/* routines returning upon entry. This meant that the routine */ -/* RDKVAR never got a chance to set the EOF flag, which was the */ -/* only control of the DO-loop. An infinite loop resulted in such */ -/* cases. The FAILED test resolves that situation. */ - -/* - SPICELIB Version 1.2.0, 9-MAR-1989 (HAN) */ - -/* Parameters BEGDAT and BEGTXT have been moved into the */ -/* Declarations section. */ - -/* - SPICELIB Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */ - -/* Parameters MAXVAR, MAXVAL, MAXLEN moved into Declarations. */ -/* (Actually, MAXLEN was implicitly 32 characters, and has only */ -/* now been made an explicit---and changeable---limit.) */ - -/* Declaration of unused function FAILED removed. */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1989 (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WRPOOL", (ftnlen)6); - } - -/* Indicate the beginning of a data section. */ - - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(1X,A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, begdat, (ftnlen)10); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(1X,A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsfe(); -L100002: - if (iostat != 0) { - ioerr_("writing a variable to the output kernel file ", " ", &iostat, - (ftnlen)45, (ftnlen)1); - sigerr_("SPICE(WRITEERROR)", (ftnlen)17); - chkout_("WRPOOL", (ftnlen)6); - return 0; - } - -/* Next prepare for writing out the data. */ - - iquote = '\''; - margin = 38; - for (k = 1; k <= 5003; ++k) { - -/* Get the head of this list. */ - - nnode = namlst[(i__1 = k - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "namlst", i__1, "pool_", (ftnlen)2665)]; - while(nnode > 0) { - s_copy(line, pnames + (((i__1 = nnode - 1) < 5003 && 0 <= i__1 ? - i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen)2669)) << - 5), (ftnlen)132, (ftnlen)32); - datahd = datlst[(i__1 = nnode - 1) < 5003 && 0 <= i__1 ? i__1 : - s_rnge("datlst", i__1, "pool_", (ftnlen)2670)]; - dp = datahd > 0; - chr = datahd < 0; - dnode = abs(datahd); - -/* Determine whether or not this is a vector object. */ - - if (dp) { - vector = dppool[(i__1 = (dnode << 1) + 10) < 400012 && 0 <= - i__1 ? i__1 : s_rnge("dppool", i__1, "pool_", (ftnlen) - 2678)] > 0; - } else if (chr) { - vector = chpool[(i__1 = (dnode << 1) + 10) < 8012 && 0 <= - i__1 ? i__1 : s_rnge("chpool", i__1, "pool_", (ftnlen) - 2680)] > 0; - } else { - setmsg_("This error is never supposed to occur. No data was " - "available for the variable '#'. ", (ftnlen)83); - r__ = rtrim_(pnames + (((i__1 = nnode - 1) < 5003 && 0 <= - i__1 ? i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen) - 2686)) << 5), (ftnlen)32); - errch_("#", pnames + (((i__1 = nnode - 1) < 5003 && 0 <= i__1 - ? i__1 : s_rnge("pnames", i__1, "pool_", (ftnlen)2687) - ) << 5), (ftnlen)1, r__); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("WRPOOL", (ftnlen)6); - return 0; - } - -/* If still here, then we can set up the beginning of this */ -/* output line. */ - - s_copy(line + 33, "= ", (ftnlen)99, (ftnlen)2); - if (vector) { - s_copy(line + 35, "( ", (ftnlen)97, (ftnlen)2); - } - -/* Now fetch all of the data associated with this variable. */ -/* We'll write them out one per line. */ - - while(dnode > 0) { - -/* Get the next data value and the address of the next node. */ - - if (dp) { - dvalue = dpvals[(i__1 = dnode - 1) < 200000 && 0 <= i__1 ? - i__1 : s_rnge("dpvals", i__1, "pool_", (ftnlen) - 2710)]; - dnode = dppool[(i__1 = (dnode << 1) + 10) < 400012 && 0 <= - i__1 ? i__1 : s_rnge("dppool", i__1, "pool_", ( - ftnlen)2711)]; - } else { - s_copy(cvalue, "'", (ftnlen)132, (ftnlen)1); - j = 1; - -/* We have to double up each of the quotes on output. */ -/* For this reason we copy the letters one at a time */ -/* into the output holding area CVALUE. */ - - i__2 = rtrim_(chvals + ((i__1 = dnode - 1) < 4000 && 0 <= - i__1 ? i__1 : s_rnge("chvals", i__1, "pool_", ( - ftnlen)2720)) * 80, (ftnlen)80); - for (i__ = 1; i__ <= i__2; ++i__) { - ++j; - *(unsigned char *)&cvalue[j - 1] = *(unsigned char *)& - chvals[((i__1 = dnode - 1) < 4000 && 0 <= - i__1 ? i__1 : s_rnge("chvals", i__1, "pool_", - (ftnlen)2722)) * 80 + (i__ - 1)]; - code = *(unsigned char *)&chvals[((i__1 = dnode - 1) < - 4000 && 0 <= i__1 ? i__1 : s_rnge("chvals", - i__1, "pool_", (ftnlen)2724)) * 80 + (i__ - 1) - ]; - if (code == iquote) { - ++j; - *(unsigned char *)&cvalue[j - 1] = *(unsigned - char *)&chvals[((i__1 = dnode - 1) < 4000 - && 0 <= i__1 ? i__1 : s_rnge("chvals", - i__1, "pool_", (ftnlen)2728)) * 80 + (i__ - - 1)]; - } - } - ++j; - *(unsigned char *)&cvalue[j - 1] = '\''; - dnode = chpool[(i__2 = (dnode << 1) + 10) < 8012 && 0 <= - i__2 ? i__2 : s_rnge("chpool", i__2, "pool_", ( - ftnlen)2734)]; - } - -/* We will need to properly finish off this write with */ -/* either a comma, a blank or a right parenthesis. */ - - if (dnode > 0) { - s_copy(finish, ", ", (ftnlen)2, (ftnlen)2); - } else if (vector) { - s_copy(finish, " )", (ftnlen)2, (ftnlen)2); - } else { - s_copy(finish, " ", (ftnlen)2, (ftnlen)1); - } - -/* Now write out our data. */ - - if (dp) { - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(1X,A,D25.17,A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, margin); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, (char *)&dvalue, (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, finish, (ftnlen)2); - if (iostat != 0) { - goto L100003; - } - iostat = e_wsfe(); -L100003: - ; - } else { - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(1X,3A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, line, margin); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, cvalue, j); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, finish, (ftnlen)2); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsfe(); -L100004: - ; - } - -/* Check the IOSTAT code. After all, that's why it's there. */ - - if (iostat != 0) { - ioerr_("writing a variable to the output kernel file ", - " ", &iostat, (ftnlen)45, (ftnlen)1); - sigerr_("SPICE(WRITEERROR)", (ftnlen)17); - chkout_("WRPOOL", (ftnlen)6); - return 0; - } - -/* Blank out the output line so that we'll have */ -/* leading blanks for subsequent components of the */ -/* vector (if we are in fact writing one). */ - - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - } - -/* Get the next name for this node: */ - - nnode = nmpool[(i__2 = (nnode << 1) + 10) < 10018 && 0 <= i__2 ? - i__2 : s_rnge("nmpool", i__2, "pool_", (ftnlen)2783)]; - } - -/* Get the next node (if there is one). */ - - } - -/* Indicate the beginning of a text section. Data sections and */ -/* text sections must alternate, even if the text section is blank. */ - - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(1X,A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100005; - } - iostat = e_wsfe(); -L100005: - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(1X,A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100006; - } - iostat = do_fio(&c__1, begtxt, (ftnlen)10); - if (iostat != 0) { - goto L100006; - } - iostat = e_wsfe(); -L100006: - if (iostat != 0) { - ioerr_("writing a variable to the output kernel file ", " ", &iostat, - (ftnlen)45, (ftnlen)1); - sigerr_("SPICE(WRITEERROR)", (ftnlen)17); - chkout_("WRPOOL", (ftnlen)6); - return 0; - } - chkout_("WRPOOL", (ftnlen)6); - return 0; -/* $Procedure SWPOOL ( Set watch on a pool variable ) */ - -L_swpool: -/* $ Abstract */ - -/* Add a name to the list of agents to notify whenever a member of */ -/* a list of kernel variables is updated. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) AGENT */ -/* INTEGER NNAMES */ -/* CHARACTER*(*) NAMES ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* AGENT I The name of an agent to be notified after updates. */ -/* NNAMES I The number of variables to associate with AGENT. */ -/* NAMES I Variable names whose update causes the notice. */ - -/* $ Detailed_Input */ - -/* AGENT is the name of a routine or entry point (agency) that */ -/* will want to know when the kernel pool variables */ -/* designated by NAMES have been updated. */ - -/* NNAMES is the number of kernel pool variable names that will */ -/* be associated with AGENT. */ - -/* NAMES is an array of names of variables in the kernel pool. */ -/* Whenever any of these is updated, a notice will be */ -/* posted for AGENT so that one can quickly check */ -/* whether needed data has been modified. */ - -/* Any kernel variable may be associated with multiple */ -/* agents; this call adds AGENT to each set of agents */ -/* associated with a member of NAMES. */ - -/* The variables designated by NAMES need not exist in */ -/* the kernel pool at the time a watch is set. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If sufficient room is not available to hold a new kernel */ -/* variable name, the error SPICE(KERVARSETOVERFLOW) will be */ -/* signaled. */ - -/* 2) If sufficient room is not available to hold a new agent */ -/* name, the error SPICE(TOOMANYWATCHES) will be signaled. */ - -/* 3) If any kernel variable in the array NAMES is already watched */ -/* by MAXAGT agents, and AGENT is not already associated with */ -/* that kernel variable, the error (AGENTLISTOVERFLOW) will be */ -/* signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The kernel pool is a convenient place to store a wide */ -/* variety of data needed by routines in SPICELIB and routines */ -/* that interface with SPICELIB routines. However, when */ -/* a single name has a large quantity of data associated with */ -/* it, it becomes inefficient to constantly query the kernel */ -/* pool for values that are not updated on a frequent basis. */ - -/* This entry point allows a routine to instruct the kernel pool */ -/* to post a message whenever a particular value gets updated. */ -/* In this way, a routine can quickly determine whether or not */ -/* data it requires has been updated since the last time the */ -/* data was accessed. This makes it reasonable to buffer */ -/* the data in local storage and update it only when */ -/* a variable in the kernel pool that affects this data has */ -/* been updated. */ - -/* Note that SWPOOL has a side effect. Whenever a call to */ -/* SWPOOL is made, the agent specified in the calling sequence */ -/* is added to the list of agents that should be notified that */ -/* an update of its variables has occurred. In other words */ -/* the code */ - -/* CALL SWPOOL ( AGENT, NNAMES, NAMES ) */ -/* CALL CVPOOL ( AGENT, UPDATE ) */ - -/* will always return UPDATE as .TRUE. */ - -/* This feature allows for a slightly cleaner use of SWPOOL and */ -/* CVPOOL as shown in the example below. Because SWPOOL */ -/* automatically loads AGENT into the list of agents to notify of */ -/* a kernel pool update, you do not have to include the code for */ -/* fetching the initial values of the kernel variables in the */ -/* initialization portion of a subroutine. Instead, the code for */ -/* the first fetch from the pool is the same as the code for */ -/* fetching when the pool is updated. */ - -/* $ Examples */ - -/* Suppose that you have an application subroutine, MYTASK, that */ -/* needs to access a large data set in the kernel pool. If this */ -/* data could be kept in local storage and kernel pool queries */ -/* performed only when the data in the kernel pool has been */ -/* updated, the routine can perform much more efficiently. */ - -/* The code fragment below illustrates how you might make use of this */ -/* feature. */ - -/* C */ -/* C On the first call to this routine establish those variables */ -/* C that we will want to read from the kernel pool only when */ -/* C new values have been established. */ -/* C */ -/* IF ( FIRST ) THEN */ - -/* FIRST = .FALSE. */ -/* HAVE = .FALSE. */ - -/* CALL SWPOOL ( 'MYTASK', NNAMES, NAMES ) */ - -/* END IF */ - -/* C */ -/* C If any of the variables has been updated, fetch */ -/* C it from the kernel pool. (Note that this also */ -/* C handles getting variables for the first time.) */ -/* C We use HAVE to indicate the fetch succeeded. If it */ -/* C didn't, we need to attempt the fetch on the next */ -/* C pass into this routine. */ -/* C */ -/* CALL CVPOOL ( 'MYTASK', UPDATE ) */ - -/* IF ( UPDATE .OR (.NOT. HAVE ) ) THEN */ - -/* CALL GDPOOL ( 'MYTASK_VAR_1', 1, M, N1, VALS1, FOUND(1) ) */ -/* CALL GDPOOL ( 'MYTASK_VAR_2', 1, M, N2, VALS2, FOUND(2) ) */ -/* . */ -/* . */ -/* . */ -/* CALL GDPOOL ( 'MYTASK_VAR_N', 1, M, NN, VALSN, FOUND(N) ) */ - -/* END IF */ - -/* IF ( FAILED() ) THEN */ -/* . */ -/* . */ -/* do something about the failure */ -/* . */ -/* . */ - -/* ELSE */ - -/* HAVE = .TRUE. */ - -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* This routine was re-written to work with the new */ -/* watcher system implementation. Several bugs related */ -/* to watch system overflow were fixed. */ - -/* The code example was updated to handle kernel pool */ -/* fetch failure. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL and CVPOOL were added. */ - -/* -& */ -/* $ Index_Entries */ - -/* Watch for an update to a kernel pool variable */ -/* Notify a routine of an update to a kernel pool variable */ -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* This routine was re-written to work with the new */ -/* watcher system implementation. */ - -/* Several bugs related to watch system overflow were fixed. */ -/* Now overflow error checks are performed *before* the */ -/* watcher system is updated, so a partial update won't */ -/* occur if there's not enough room for a full update. */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The basic data structure used to maintain the list of */ -/* variable names and values was replaced with a hash table */ -/* implementation. Data and names are accessed by means */ -/* of a hash function and linked lists of pointers to existing */ -/* variable names and data values. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL (set watch on a pool variable) */ -/* and CVPOOL (check variable for update) so that routines */ -/* that buffer data stored in the kernel pool can fetch */ -/* that data only when it is updated. */ - -/* In addition, the revision history was upgraded so that the */ -/* version number increases over time. This wasn't true */ -/* before. In addition some early revision data that referred to */ -/* pre-SPICELIB modifications were removed. This editing of */ -/* the version numbers makes it unlikely that anyone can track */ -/* down which previous version of this routine they have by */ -/* looking at the version number. The best way to determine */ -/* the routine you had previously is to compare the dates */ -/* stored in the Version line of the routine. */ - - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SWPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Do all of the error checking we need to do BEFORE touching */ -/* the watcher data structure. We don't want to end up with */ -/* a partial update due to running out of room in mid-update. */ - -/* First make sure we can handle any new kernel variable names. */ - - need = 0; - i__2 = *nnames; - for (i__ = 1; i__ <= i__2; ++i__) { - if (! elemc_(names + (i__ - 1) * names_len, wtvars, names_len, ( - ftnlen)32)) { - ++need; - } - } - space = sizec_(wtvars, (ftnlen)32) - cardc_(wtvars, (ftnlen)32); - if (need > space) { - setmsg_("The watched kernel variable name list WTVARS has room for #" - " more elements, so the # new names (in a list of # names) as" - "sociated with agent # cannot be inserted.", (ftnlen)160); - errint_("#", &space, (ftnlen)1); - errint_("#", &need, (ftnlen)1); - errint_("#", nnames, (ftnlen)1); - errch_("#", agent, (ftnlen)1, agent_len); - sigerr_("SPICE(KERVARSETOVERFLOW)", (ftnlen)24); - chkout_("SWPOOL", (ftnlen)6); - return 0; - } - -/* If the input agent is a new one for any member of NAMES, */ -/* make sure we have enough room to store this agent. Also */ -/* check for kernel variables that would have more than */ -/* MAXAGT agents watching them if this watch were established. */ - - need = 0; - i__2 = *nnames; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* Get the agents associated with NAMES(I). The output argument */ -/* ACTIVE is a SPICE set. */ - - zzgapool_(names + (i__ - 1) * names_len, wtvars, wtptrs, wtpool, - wtagnt, active, names_len, (ftnlen)32, (ftnlen)32, (ftnlen)32) - ; - nfetch = cardc_(active, (ftnlen)32); - noagnt = nfetch == 0 || ! elemc_(agent, active, agent_len, (ftnlen)32) - ; - if (noagnt) { - ++need; - -/* Check the number of agents already associated with the */ -/* current kernel variable. */ - - if (nfetch == 1000) { - setmsg_("The list of agents to notify when # is updated is t" - "oo big. The maximum number of agents that any kernel" - "pool variable can activate is #.", (ftnlen)135); - errch_("#", names + (i__ - 1) * names_len, (ftnlen)1, - names_len); - errint_("#", &c__1000, (ftnlen)1); - sigerr_("SPICE(TOOMANYWATCHES)", (ftnlen)21); - chkout_("SWPOOL", (ftnlen)6); - return 0; - } - } - } - -/* See whether WTAGNT has enough room to set this watch. */ - - space = lnknfn_(wtpool); - if (need > space) { - setmsg_("The watched kernel variable agent list WTAGNT has room for " - "# more elements, so the # new occurrences of agent # require" - "d for the input watch cannot be inserted.", (ftnlen)160); - errint_("#", &space, (ftnlen)1); - errint_("#", &need, (ftnlen)1); - errch_("#", agent, (ftnlen)1, agent_len); - sigerr_("SPICE(AGENTLISTOVERFLOW)", (ftnlen)24); - chkout_("SWPOOL", (ftnlen)6); - return 0; - } - -/* All of the overflow checks have been done. We finally can */ -/* get on with setting the specified watch. */ - -/* For each variable specified by the array NAMES, put AGENT */ -/* into its list of guys to be notified when a variable change */ -/* occurs. */ - - i__2 = *nnames; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* Get the agents associated with NAMES(I). The output argument */ -/* ACTIVE is a SPICE set. */ - - zzgapool_(names + (i__ - 1) * names_len, wtvars, wtptrs, wtpool, - wtagnt, active, names_len, (ftnlen)32, (ftnlen)32, (ftnlen)32) - ; - nfetch = cardc_(active, (ftnlen)32); - -/* Three things can happen now: */ - -/* 1) The kernel variable NAMES(I) is already watched by at */ -/* least one agent, but not by AGENT. We need to add AGENT */ -/* to the list of agents watching NAMES(I). */ - -/* 2) The kernel variable NAMES(I) isn't yet watched by any */ -/* agent, so we need to insert NAMES(I) into WTVARS, as */ -/* well as add AGENT to the (empty) list of agents watching */ -/* NAMES(I). */ - -/* 3) The kernel variable NAMES(I) is already watched by AGENT. */ -/* No action is needed. */ - -/* We could get fancy and try to minimize the number of lines of */ -/* code required to handle the first two cases...but we won't. */ -/* We'll just take them one at a time. */ - - - if (nfetch > 0) { - if (! elemc_(agent, active, agent_len, (ftnlen)32)) { - -/* Case 1: at least one agent is already watching NAMES(I), */ -/* but AGENT is not watching NAMES(I). We need the head of */ -/* the agent list for this kernel variable. */ - - i__1 = cardc_(wtvars, (ftnlen)32); - j = bsrchc_(names + (i__ - 1) * names_len, &i__1, wtvars + - 192, names_len, (ftnlen)32); - head = wtptrs[(i__1 = j - 1) < 5003 && 0 <= i__1 ? i__1 : - s_rnge("wtptrs", i__1, "pool_", (ftnlen)3303)]; - -/* Allocate a free node in the watch pool; append this node */ -/* to the tail of the agent list for the kernel variable; */ -/* we know that list is non-empty. */ - - lnkan_(wtpool, &node); - tail = lnktl_(&head, wtpool); - lnkila_(&tail, &node, wtpool); - -/* Store the agent name at index NODE in the agent list. */ - - s_copy(wtagnt + (((i__1 = node - 1) < 50030 && 0 <= i__1 ? - i__1 : s_rnge("wtagnt", i__1, "pool_", (ftnlen)3319)) - << 5), agent, (ftnlen)32, agent_len); - -/* The insertion is complete. We update AGENTS, which is */ -/* the set of agents to notify, at the end of this routine. */ - - } - } else { - -/* Case 2: the kernel variable NAMES(I) isn't watched. Add it */ -/* the watcher system. We've already ensured that there's */ -/* room in WTVARS and WTAGNT and that the insertion won't give */ -/* NAMES(I) an excessive number of agents. */ - -/* Let J be the insertion index in WTVARS. Since NAMES(I) */ -/* isn't yet a member of WTWARS, the insertion index will */ -/* always follow that of the last element in WTVARS */ -/* less than NAMES(I). */ - - i__1 = cardc_(wtvars, (ftnlen)32); - j = lstltc_(names + (i__ - 1) * names_len, &i__1, wtvars + 192, - names_len, (ftnlen)32) + 1; - -/* Note that we don't use INSRTC to add NAMES(I) to WTVARS */ -/* because we need the insertion index, and we don't want */ -/* to execute a redundant search to find it. */ - -/* We're now going to expand both the set WTVARS and the */ -/* parallel array WTPTRS by inserting new values at index J. */ -/* WTVARS(J) will receive the new kernel variable name */ -/* NAMES(I) and WTPTRS(J) will receive a new node in the watch */ -/* pool: this node provides an index into the agent list for */ -/* NAMES(I). */ - -/* Let NVARS be the size of the array WTVARS(1:*) prior to */ -/* the insertion. NVARS will be updated by INSLAC. */ - -/* NPTRS is the size of the associated pointer table WTPTRS. */ - - nvars__ = cardc_(wtvars, (ftnlen)32); - nptrs = nvars__; - inslac_(names + (i__ - 1) * names_len, &c__1, &j, wtvars + 192, & - nvars__, names_len, (ftnlen)32); - -/* WTVARS is actually a set, so we must update its cardinality. */ - - scardc_(&nvars__, wtvars, (ftnlen)32); - -/* Allocate a free node in the watch pool. */ - - lnkan_(wtpool, &node); - -/* Now insert NODE in the pointer table WTPTRS at index J. */ - - inslai_(&node, &c__1, &j, wtptrs, &nptrs); - -/* Store the agent name at index NODE in the agent list. */ - - s_copy(wtagnt + (((i__1 = node - 1) < 50030 && 0 <= i__1 ? i__1 : - s_rnge("wtagnt", i__1, "pool_", (ftnlen)3381)) << 5), - agent, (ftnlen)32, agent_len); - -/* The insertion is complete. We update AGENTS, which is the */ -/* set of agents to notify, at the end of this routine. */ - } - } - -/* We ALWAYS put this agent into the list of agents to be notified. */ - - insrtc_(agent, agents, agent_len, (ftnlen)32); - -/* That is all. */ - - chkout_("SWPOOL", (ftnlen)6); - return 0; -/* $Procedure CVPOOL ( Check variable in the pool for update) */ - -L_cvpool: -/* $ Abstract */ - -/* Determine whether or not any of the variables that are to */ -/* be watched and have AGENT on their distribution list have been */ -/* updated. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* SYMBOLS */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) AGENT */ -/* LOGICAL UPDATE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* AGENT I Name of the agent to check for notices. */ -/* UPDATE O .TRUE. if variables for AGENT have been updated. */ - -/* $ Detailed_Input */ - -/* AGENT is the name of a subroutine, entry point, or significant */ -/* portion of code that needs to access variables in the */ -/* kernel pool. Generally this agent will buffer these */ -/* variables internally and fetch them from the kernel */ -/* pool only when they are updated. */ - -/* $ Detailed_Output */ - -/* UPDATE is a logical flag that will be set to true if the */ -/* variables in the kernel pool that are required by */ -/* AGENT have been updated since the last call to CVPOOL. */ - -/* $ Parameters */ - -/* See the umbrella subroutine POOL. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point allows the calling program to determine */ -/* whether or not variables associated with with AGENT have */ -/* been updated. Making use of this entry point in conjunction */ -/* with the entry point SWPOOL (set watch on pool variables) */ -/* modules can buffer kernel pool variables they need and */ -/* fetch values from the kernel pool only when variables have */ -/* been updated. */ - -/* Note that the call to CVPOOL has a side effect. */ -/* Two consecutive calls to CVPOOL with the same */ -/* AGENT will always result in the UPDATE being .FALSE. */ -/* on the second call. In other words, if you embed */ -/* the following two lines of code in a piece of code */ - -/* CALL CVPOOL ( AGENT, UPDATE ) */ -/* CALL CVPOOL ( AGENT, UPDATE ) */ - -/* and then test UPDATE, it will be FALSE. The idea is */ -/* that once a call to CVPOOL has been made, the */ -/* kernel pool has performed its duty and notified the */ -/* calling routine that one of the AGENT's variables */ -/* has been updated. Consequently, on the second call */ -/* to CVPOOL above, the kernel pool will not have any */ -/* updates to report about any of AGENT's variables. */ - -/* If, on the other hand, you have code such as */ - -/* CALL CVPOOL ( AGENT, UPDATE ) */ -/* CALL LDPOOL ( 'MYFILE.DAT' ) */ -/* CALL CVPOOL ( AGENT, UPDATE ) */ - -/* the value of UPDATE will be true if one of the variables */ -/* associated with AGENT was updated by the call to */ -/* LDPOOL (and that variable has been specified as one */ -/* to watch by call a call to SWPOOL). */ - -/* It should also be noted that any call to CVPOOL that */ -/* occurs immediately after a call to SWPOOL will result in */ -/* UPDATE being returned as .TRUE. In other words, code */ -/* such as shown below, will always result in the value */ -/* of UPDATE as being returned .TRUE. */ - -/* CALL SWPOOL ( AGENT, NNAMES, NAMES ) */ -/* CALL CVPOOL ( AGENT, UPDATE ) */ - -/* See the header for SWPOOL for a full discussion of this */ -/* feature. */ - -/* $ Examples */ - -/* Suppose that you have an application subroutine, MYTASK, that */ -/* needs to access a large data set in the kernel pool. If this */ -/* data could be kept in local storage and kernel pool queries */ -/* performed only when the data in the kernel pool has been */ -/* updated, the routine can perform much more efficiently. */ - -/* The code fragment below illustrates how you might make use of this */ -/* feature. */ - -/* C */ -/* C On the first call to this routine establish those variables */ -/* C that we will want to read from the kernel pool only when */ -/* C new values have been established. */ -/* C */ -/* IF ( FIRST ) THEN */ - -/* FIRST = .FALSE. */ -/* HAVE = .FALSE. */ - -/* CALL SWPOOL ( 'MYTASK', NNAMES, NAMES ) */ - -/* END IF */ - -/* C */ -/* C If any of the variables has been updated, fetch */ -/* C it from the kernel pool. (Note that this also */ -/* C handles getting variables for the first time.) */ -/* C We use HAVE to indicate the fetch succeeded. If it */ -/* C didn't, we need to attempt the fetch on the next */ -/* C pass into this routine. */ -/* C */ -/* CALL CVPOOL ( 'MYTASK', UPDATE ) */ - -/* IF ( UPDATE .OR (.NOT. HAVE ) ) THEN */ - -/* CALL GDPOOL ( 'MYTASK_VAR_1', 1, M, N1, VALS1, FOUND(1) ) */ -/* CALL GDPOOL ( 'MYTASK_VAR_2', 1, M, N2, VALS2, FOUND(2) ) */ -/* . */ -/* . */ -/* . */ -/* CALL GDPOOL ( 'MYTASK_VAR_N', 1, M, NN, VALSN, FOUND(N) ) */ - -/* END IF */ - -/* IF ( FAILED() ) THEN */ -/* . */ -/* . */ -/* do something about the failure */ -/* . */ -/* . */ - -/* ELSE */ - -/* HAVE = .TRUE. */ - -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* The code example was updated to handle kernel pool */ -/* fetch failure. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL and CVPOOL were added. */ - -/* -& */ -/* $ Index_Entries */ - -/* Check the kernel pool for updated variables */ - -/* -& */ -/* $ Revisions */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The basic data structure used to maintain the list of */ -/* variable names and values was replaced with a hash table */ -/* implementation. Data and names are accessed by means */ -/* of a hash function and linked lists of pointers to existing */ -/* variable names and data values. */ - -/* - SPICELIB Version 6.0.0, 31-MAR-1992 (WLT) */ - -/* The entry points SWPOOL (set watch on a pool variable) */ -/* and CVPOOL (check variable for update) so that routines */ -/* that buffer data stored in the kernel pool can fetch */ -/* that data only when it is updated. */ - -/* In addition, the revision history was upgraded so that the */ -/* version number increases over time. This wasn't true */ -/* before. In addition some early revision data that referred to */ -/* pre-SPICELIB modifications were removed. This editing of */ -/* the version numbers makes it unlikely that anyone can track */ -/* down which previous version of this routine they have by */ -/* looking at the version number. The best way to determine */ -/* the routine you had previously is to compare the dates */ -/* stored in the Version line of the routine. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CVPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Check to see if our agent is on the list of agents to be */ -/* notified. If it is, we take this agent off the list---he's */ -/* now considered to have been notified. */ - - *update = elemc_(agent, agents, agent_len, (ftnlen)32); - if (*update) { - removc_(agent, agents, agent_len, (ftnlen)32); - } - chkout_("CVPOOL", (ftnlen)6); - return 0; -/* $Procedure GCPOOL (Get character data from the kernel pool) */ - -L_gcpool: -/* $ Abstract */ - -/* Return the character value of a kernel variable from the */ -/* kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER START */ -/* INTEGER ROOM */ -/* INTEGER N */ -/* CHARACTER*(*) CVALS ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable whose value is to be returned. */ -/* START I Which component to start retrieving for NAME */ -/* ROOM I The largest number of values to return. */ -/* N O Number of values returned for NAME. */ -/* CVALS O Values associated with NAME. */ -/* FOUND O True if variable is in pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the variable whose values are to be */ -/* returned. If the variable is not in the pool with */ -/* character type, FOUND will be FALSE. */ - -/* START is the index of the first component of NAME to return. */ -/* If START is less than 1, it will be treated as 1. If */ -/* START is greater than the total number of components */ -/* available for NAME, no values will be returned (N will */ -/* be set to zero). However, FOUND will still be set to */ -/* .TRUE. */ - -/* ROOM is the maximum number of components that should be */ -/* returned for this variable. (Usually it is the amount */ -/* of ROOM available in the array CVALS). If ROOM is */ -/* less than 1 the error 'SPICE(BADARRAYSIZE)' will be */ -/* signaled. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with NAME that */ -/* are returned. It will always be less than or equal */ -/* to ROOM. */ - -/* If NAME is not in the pool with character type, no */ -/* value is given to N. */ - -/* CVALS is the array of values associated with NAME. */ -/* If NAME is not in the pool with character type, no */ -/* values are given to the elements of CVALS. */ - -/* If the length of CVALS is less than the length of */ -/* strings stored in the kernel pool (see MAXCHR) the */ -/* values returned will be truncated on the right. */ - -/* FOUND is TRUE if the variable is in the pool and has */ -/* character type, FALSE if it is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ROOM is less than one the error */ -/* 'SPICE(BADARRAYSIZE)' is signaled. */ - -/* 2) If CVALS has declared length less than the size of a */ -/* string to be returned, the value will be truncated on */ -/* the right. See MAXCHR for the maximum stored size of */ -/* string variables. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the user interface to retrieving */ -/* character data stored in the kernel pool. This interface */ -/* allows you to retrieve the data associated with a variable */ -/* in multiple accesses. Under some circumstances this alleviates */ -/* the problem of having to know in advance the maximum amount */ -/* of space needed to accommodate all kernel variables. */ - -/* However, this method of access does come with a price. It is */ -/* always more efficient to retrieve all of the data associated */ -/* with a kernel pool data in one call than it is to retrieve */ -/* it in sections. */ - -/* See also the entry points GDPOOL and GIPOOL. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the data stored */ -/* in a kernel pool variable can be retrieved in pieces. */ - -/* First we need some declarations. */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 3 ) */ - -/* CHARACTER*(8) VARNAM */ -/* CHARACTER*(3) INDENT */ -/* INTEGER START */ -/* INTEGER N */ -/* LOGICAL FOUND */ -/* CHARACTER*(80) CVALS(ROOM) */ - - -/* Next load the data in the file 'typical.ker' into the */ -/* kernel pool. */ - -/* CALL LDPOOL ( 'typical.ker' ) */ - -/* Next we shall print the values stored for the kernel pool */ -/* variable 'MYDATA' */ - -/* VARNAM = 'MYDATA' */ -/* INDENT = ' ' */ -/* START = 1 */ - -/* CALL GCPOOL ( VARNAM, START, ROOM, N, CVALS, FOUND ) */ - -/* IF ( .NOT. FOUND ) */ -/* WRITE (*,*) 'There is no string data available for MYDATA.' */ -/* ELSE */ - -/* WRITE (*,*) 'Values for MYDATA.' */ -/* WRITE (*,*) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, CVALS(I) */ -/* END DO */ - -/* DO WHILE ( N .EQ. ROOM ) */ - -/* START = START + N */ -/* CALL GCPOOL ( VARNAM, START, ROOM, N, CVALS, FOUND ) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, CVALS(I) */ -/* END DO */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.1, 22-DEC-2004 (NJB) */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* -& */ -/* $ Index_Entries */ - -/* RETURN the character value of a pooled kernel variable */ -/* RETURN the string value of a pooled kernel variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GCPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Perform the one obvious error check first. */ - - if (*room < 1) { - setmsg_("The amount of room specified as available for output in the" - " output array was: #. The amount of room must be positive. ", - (ftnlen)119); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BADARRAYSIZE)", (ftnlen)19); - chkout_("GCPOOL", (ftnlen)6); - return 0; - } - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("naml" - "st", i__2, "pool_", (ftnlen)4045)] == 0) { - *found = FALSE_; - chkout_("GCPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - node = namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "namlst", i__2, "pool_", (ftnlen)4057)]; - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= i__2 ? - i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)4058)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - node = nmpool[(i__2 = (node << 1) + 10) < 10018 && 0 <= i__2 ? i__2 : - s_rnge("nmpool", i__2, "pool_", (ftnlen)4062)]; - if (node < 0) { - *found = FALSE_; - chkout_("GCPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= - i__2 ? i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)4072)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* If you get to this point, the variable NAME is present in the */ -/* list of names at PNAMES(NODE), ABS( DATLST(NODE) ) points to the */ -/* head of a linked list of values for this NAME. */ - - datahd = datlst[(i__2 = node - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "datlst", i__2, "pool_", (ftnlen)4080)]; - if (datahd > 0) { - *n = 0; - *found = FALSE_; - chkout_("GCPOOL", (ftnlen)6); - return 0; - } else if (datahd == 0) { - setmsg_("This is never supposed to happen. The requested name, '#'," - " was found in the name list, but the pointer to the head of " - "the data for this variable is zero. Please note your activit" - "ies and report this error to NAIF. ", (ftnlen)214); - errch_("#", name__, (ftnlen)1, rtrim_(name__, name_len)); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("GCPOOL", (ftnlen)6); - return 0; - } - *found = TRUE_; - k = 0; - *n = 0; - begin = max(*start,1); - node = -datahd; - while(node > 0) { - ++k; - if (k >= begin) { - ++(*n); - s_copy(cvals + (*n - 1) * cvals_len, chvals + ((i__2 = node - 1) < - 4000 && 0 <= i__2 ? i__2 : s_rnge("chvals", i__2, "pool_" - , (ftnlen)4116)) * 80, cvals_len, (ftnlen)80); - if (*n == *room) { - chkout_("GCPOOL", (ftnlen)6); - return 0; - } - } - node = chpool[(i__2 = (node << 1) + 10) < 8012 && 0 <= i__2 ? i__2 : - s_rnge("chpool", i__2, "pool_", (ftnlen)4125)]; - } - chkout_("GCPOOL", (ftnlen)6); - return 0; -/* $Procedure GDPOOL (Get d.p. values from the kernel pool) */ - -L_gdpool: -/* $ Abstract */ - -/* Return the d.p. value of a kernel variable from the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER START */ -/* INTEGER ROOM */ -/* INTEGER N */ -/* DOUBLE PRECISION VALUES ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable whose value is to be returned. */ -/* START I Which component to start retrieving for NAME */ -/* ROOM I The largest number of values to return. */ -/* N O Number of values returned for NAME. */ -/* VALUES O Values associated with NAME. */ -/* FOUND O True if variable is in pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the variable whose values are to be */ -/* returned. If the variable is not in the pool with */ -/* numeric type, FOUND will be FALSE. */ - -/* START is the index of the first component of NAME to return. */ -/* If START is less than 1, it will be treated as 1. If */ -/* START is greater than the total number of components */ -/* available for NAME, no values will be returned (N will */ -/* be set to zero). However, FOUND will still be set to */ -/* .TRUE. */ - -/* ROOM is the maximum number of components that should be */ -/* returned for this variable. (Usually it is the amount */ -/* of ROOM available in the array VALUES). If ROOM is */ -/* less than 1 the error 'SPICE(BADARRAYSIZE)' will be */ -/* signaled. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with NAME that */ -/* are returned. It will always be less than or equal */ -/* to ROOM. */ - -/* If NAME is not in the pool with numeric type, no value */ -/* is given to N. */ - -/* VALUES is the array of values associated with NAME. */ -/* If NAME is not in the pool with numeric type, no */ -/* values are given to the elements of VALUES. */ - -/* FOUND is TRUE if the variable is in the pool and has numeric */ -/* type, FALSE if it is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ROOM is less than one the error */ -/* 'SPICE(BADARRAYSIZE)' is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the user interface to retrieving */ -/* numeric data stored in the kernel pool. This interface */ -/* allows you to retrieve the data associated with a variable */ -/* in multiple accesses. Under some circumstances this alleviates */ -/* the problem of having to know in advance the maximum amount */ -/* of space needed to accommodate all kernel variables. */ - -/* However, this method of access does come with a price. It is */ -/* always more efficient to retrieve all of the data associated */ -/* with a kernel pool data in one call than it is to retrieve */ -/* it in sections. */ - -/* This routine should be used in place of RTPOOL when possible */ -/* as it avoids errors associated with writing data past the */ -/* end of an array. */ - -/* See also the entry points GIPOOL and GCPOOL. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the data stored */ -/* in a kernel pool variable can be retrieved in pieces. */ - -/* First we need some declarations. */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 3 ) */ - -/* CHARACTER*(8) VARNAM */ -/* CHARACTER*(3) INDENT */ -/* INTEGER START */ -/* INTEGER N */ -/* LOGICAL FOUND */ -/* DOUBLE PRECISION VALUES(ROOM) */ - - -/* Next load the data in the file 'typical.ker' into the */ -/* kernel pool. */ - - - -/* CALL LDPOOL ( 'typical.ker' ) */ - -/* Next we shall print the values stored for the kernel pool */ -/* variable 'MYDATA' */ - -/* VARNAM = 'MYDATA' */ -/* INDENT = ' ' */ -/* START = 1 */ - -/* CALL GDPOOL ( VARNAM, START, ROOM, N, VALUES, FOUND ) */ - -/* IF ( .NOT. FOUND ) */ -/* WRITE (*,*) 'There is no numeric data available for MYDATA.' */ -/* ELSE */ - -/* WRITE (*,*) 'Values for MYDATA.' */ -/* WRITE (*,*) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, VALUES(I) */ -/* END DO */ - -/* DO WHILE ( N .EQ. ROOM ) */ - -/* START = START + N */ -/* CALL GDPOOL ( VARNAM, START, ROOM, N, VALUES, FOUND ) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, VALUES(I) */ -/* END DO */ - -/* END DO */ - -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.1, 22-DEC-2004 (NJB) */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* -& */ -/* $ Index_Entries */ - -/* RETURN the d.p. value of a pooled kernel variable */ -/* RETURN the numeric value of a pooled kernel variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GDPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Perform the one obvious error check first. */ - - if (*room < 1) { - setmsg_("The amount of room specified as available for output in the" - " output array was: #. The amount of room must be positive. ", - (ftnlen)119); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BADARRAYSIZE)", (ftnlen)19); - chkout_("GDPOOL", (ftnlen)6); - return 0; - } - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("naml" - "st", i__2, "pool_", (ftnlen)4444)] == 0) { - *found = FALSE_; - chkout_("GDPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - node = namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "namlst", i__2, "pool_", (ftnlen)4456)]; - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= i__2 ? - i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)4457)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - node = nmpool[(i__2 = (node << 1) + 10) < 10018 && 0 <= i__2 ? i__2 : - s_rnge("nmpool", i__2, "pool_", (ftnlen)4461)]; - if (node < 0) { - *found = FALSE_; - chkout_("GDPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= - i__2 ? i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)4471)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* If you get to this point, the variable NAME is present in the */ -/* list of names at PNAMES(NODE), ABS( DATLST(NODE) ) points to the */ -/* head of a linked list of values for this NAME. */ - - datahd = datlst[(i__2 = node - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "datlst", i__2, "pool_", (ftnlen)4479)]; - if (datahd < 0) { - *n = 0; - *found = FALSE_; - chkout_("GDPOOL", (ftnlen)6); - return 0; - } else if (datahd == 0) { - setmsg_("This is never supposed to happen. The requested name, '#'," - " was found in the name list, but the pointer to the head of " - "the data for this variable is zero. Please note your activit" - "ies and report this error to NAIF. ", (ftnlen)214); - errch_("#", name__, (ftnlen)1, rtrim_(name__, name_len)); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("GDPOOL", (ftnlen)6); - return 0; - } - *found = TRUE_; - k = 0; - *n = 0; - begin = max(*start,1); - node = datahd; - while(node > 0) { - ++k; - if (k >= begin) { - ++(*n); - values[*n - 1] = dpvals[(i__2 = node - 1) < 200000 && 0 <= i__2 ? - i__2 : s_rnge("dpvals", i__2, "pool_", (ftnlen)4515)]; - if (*n == *room) { - chkout_("GDPOOL", (ftnlen)6); - return 0; - } - } - node = dppool[(i__2 = (node << 1) + 10) < 400012 && 0 <= i__2 ? i__2 : - s_rnge("dppool", i__2, "pool_", (ftnlen)4524)]; - } - chkout_("GDPOOL", (ftnlen)6); - return 0; -/* $Procedure GIPOOL (Get integers from the kernel pool) */ - -L_gipool: -/* $ Abstract */ - -/* Return the integer value of a kernel variable from the */ -/* kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER START */ -/* INTEGER ROOM */ -/* INTEGER N */ -/* INTEGER IVALS ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable whose value is to be returned. */ -/* START I Which component to start retrieving for NAME */ -/* ROOM I The largest number of values to return. */ -/* N O Number of values returned for NAME. */ -/* IVALS O Values associated with NAME. */ -/* FOUND O True if variable is in pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the variable whose values are to be */ -/* returned. If the variable is not in the pool with */ -/* numeric type, FOUND will be FALSE. */ - -/* START is the index of the first component of NAME to return. */ -/* If START is less than 1, it will be treated as 1. If */ -/* START is greater than the total number of components */ -/* available for NAME, no values will be returned (N will */ -/* be set to zero). However, FOUND will still be set to */ -/* .TRUE. */ - -/* ROOM is the maximum number of components that should be */ -/* returned for this variable. (Usually it is the amount */ -/* of ROOM available in the array IVALS). If ROOM is */ -/* less than 1 the error 'SPICE(BADARRAYSIZE)' will be */ -/* signaled. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with NAME that */ -/* are returned. It will always be less than or equal */ -/* to ROOM. */ - -/* If NAME is not in the pool with numeric type, no value */ -/* is given to N. */ - -/* IVALS is the array of values associated with NAME. */ -/* If NAME is not in the pool with numeric type, no */ -/* values are given to the elements of IVALS. */ - -/* FOUND is TRUE if the variable is in the pool and has numeric */ -/* type, FALSE if it is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ROOM is less than one the error */ -/* 'SPICE(BADARRAYSIZE)' is signaled. */ - -/* 2) If a value requested is outside the valid range */ -/* of integers, the error 'SPICE(INTOUTOFRANGE)' is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the user interface for retrieving */ -/* integer data stored in the kernel pool. This interface */ -/* allows you to retrieve the data associated with a variable */ -/* in multiple accesses. Under some circumstances this alleviates */ -/* the problem of having to know in advance the maximum amount */ -/* of space needed to accommodate all kernel variables. */ - -/* However, this method of access does come with a price. It is */ -/* always more efficient to retrieve all of the data associated */ -/* with a kernel pool data in one call than it is to retrieve */ -/* it in sections. */ - -/* See also the entry points GDPOOL and GCPOOL. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the data stored */ -/* in a kernel pool variable can be retrieved in pieces. */ - -/* First we need some declarations. */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 3 ) */ - -/* CHARACTER*(8) VARNAM */ -/* CHARACTER*(3) INDENT */ -/* INTEGER START */ -/* INTEGER N */ -/* LOGICAL FOUND */ -/* INTEGER IVALS(ROOM) */ - - -/* Next load the data in the file 'typical.ker' into the */ -/* kernel pool. */ - -/* CALL LDPOOL ( 'typical.ker' ) */ - -/* Next we shall print the values stored for the kernel pool */ -/* variable 'MYDATA' */ - -/* VARNAM = 'MYDATA' */ -/* INDENT = ' ' */ -/* START = 1 */ - -/* CALL GIPOOL ( VARNAM, START, ROOM, N, IVALS, FOUND ) */ - -/* IF ( .NOT. FOUND ) */ -/* WRITE (*,*) 'There is no numeric data available for MYDATA.' */ -/* ELSE */ - -/* WRITE (*,*) 'Values for MYDATA.' */ -/* WRITE (*,*) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, IVALS(I) */ -/* END DO */ - -/* DO WHILE ( N .EQ. ROOM ) */ - -/* START = START + N */ -/* CALL GIPOOL ( VARNAM, START, ROOM, N, IVALS, FOUND ) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, IVALS(I) */ -/* END DO */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.1, 22-DEC-2004 (NJB) */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* -& */ -/* $ Index_Entries */ - -/* RETURN the integer value of a pooled kernel variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GIPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Perform the one obvious error check first. */ - - if (*room < 1) { - setmsg_("The amount of room specified as available for output in the" - " output array was: #. The amount of room must be positive. ", - (ftnlen)119); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BADARRAYSIZE)", (ftnlen)19); - chkout_("GIPOOL", (ftnlen)6); - return 0; - } - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("naml" - "st", i__2, "pool_", (ftnlen)4835)] == 0) { - *found = FALSE_; - chkout_("GIPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - node = namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "namlst", i__2, "pool_", (ftnlen)4847)]; - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= i__2 ? - i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)4848)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - node = nmpool[(i__2 = (node << 1) + 10) < 10018 && 0 <= i__2 ? i__2 : - s_rnge("nmpool", i__2, "pool_", (ftnlen)4852)]; - if (node < 0) { - *found = FALSE_; - chkout_("GIPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= - i__2 ? i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)4862)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* If you get to this point, the variable NAME is present in the */ -/* list of names at PNAMES(NODE), ABS( DATLST(NODE) ) points to the */ -/* head of a linked list of values for this NAME. */ - - datahd = datlst[(i__2 = node - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "datlst", i__2, "pool_", (ftnlen)4870)]; - if (datahd < 0) { - *n = 0; - *found = FALSE_; - chkout_("GIPOOL", (ftnlen)6); - return 0; - } else if (datahd == 0) { - setmsg_("This is never supposed to happen. The requested name, '#'," - " was found in the name list, but the pointer to the head of " - "the data for this variable is zero. Please note your activit" - "ies and report this error to NAIF. ", (ftnlen)214); - errch_("#", name__, (ftnlen)1, rtrim_(name__, name_len)); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("GIPOOL", (ftnlen)6); - return 0; - } - -/* Prepare for fetching values. */ - - big = (doublereal) intmax_(); - small = (doublereal) intmin_(); - *found = TRUE_; - k = 0; - *n = 0; - begin = max(*start,1); - node = datahd; - while(node > 0) { - ++k; - if (k >= begin) { - ++(*n); - if (dpvals[(i__2 = node - 1) < 200000 && 0 <= i__2 ? i__2 : - s_rnge("dpvals", i__2, "pool_", (ftnlen)4911)] >= small && - dpvals[(i__1 = node - 1) < 200000 && 0 <= i__1 ? i__1 : - s_rnge("dpvals", i__1, "pool_", (ftnlen)4911)] <= big) { - ivals[*n - 1] = i_dnnt(&dpvals[(i__2 = node - 1) < 200000 && - 0 <= i__2 ? i__2 : s_rnge("dpvals", i__2, "pool_", ( - ftnlen)4914)]); - } else { - setmsg_("The value associated with index # of the kernel var" - "iable # is outside the range of integers. The value " - "stored was: # .", (ftnlen)118); - errint_("#", &k, (ftnlen)1); - errch_("#", name__, (ftnlen)1, rtrim_(name__, name_len)); - errdp_("#", &dpvals[(i__2 = node - 1) < 200000 && 0 <= i__2 ? - i__2 : s_rnge("dpvals", i__2, "pool_", (ftnlen)4926)], - (ftnlen)1); - sigerr_("SPICE(INTOUTOFRANGE)", (ftnlen)20); - chkout_("GIPOOL", (ftnlen)6); - return 0; - } - if (*n == *room) { - chkout_("GIPOOL", (ftnlen)6); - return 0; - } - } - node = dppool[(i__2 = (node << 1) + 10) < 400012 && 0 <= i__2 ? i__2 : - s_rnge("dppool", i__2, "pool_", (ftnlen)4940)]; - } - chkout_("GIPOOL", (ftnlen)6); - return 0; -/* $Procedure DTPOOL (Data for a kernel pool variable) */ - -L_dtpool: -/* $ Abstract */ - -/* Return the data about a kernel pool variable. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* LOGICAL FOUND */ -/* INTEGER N */ -/* CHARACTER*(*) TYPE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable whose value is to be returned. */ -/* FOUND O True if variable is in pool. */ -/* N O Number of values returned for NAME. */ -/* TYPE O Type of the variable 'C', 'N', 'X' */ - -/* $ Detailed_Input */ - -/* NAME is the name of the variable whose values are to be */ -/* returned. */ - - -/* $ Detailed_Output */ - - -/* FOUND is TRUE if the variable is in the pool FALSE if it */ -/* is not. */ - -/* N is the number of values associated with NAME. */ -/* If NAME is not present in the pool N will be returned */ -/* with the value 0. */ - -/* TYPE is the type of the variable associated with NAME. */ - -/* 'C' if the data is character data */ -/* 'N' if the data is numeric. */ -/* 'X' if there is no variable NAME in the pool. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the name requested is not in the kernel pool FOUND */ -/* will be set to FALSE, N to zero and TYPE to 'X'. */ - - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to determine whether or not a kernel */ -/* pool variable is present and to determine its size and type */ -/* if it is. */ - - -/* $ Examples */ - - -/* The following code fragment demonstrates how to determine the */ -/* properties of a stored kernel variable. */ - -/* CALL DTPOOL ( VARNAM, FOUND, N, TYPE ) */ - -/* IF ( FOUND ) THEN */ - -/* WRITE (*,*) 'Properties of variable: ', VARNAME */ -/* WRITE (*,*) */ - -/* WRITE (*,*) ' Size: ', N */ - -/* IF ( TYPE .EQ. 'C' ) THEN */ -/* WRITE (*,*) ' Type: Character' */ -/* ELSE */ -/* WRITE (*,*) ' Type: Numeric' */ -/* END IF */ - -/* ELSE */ - -/* WRITE (*,*) VARNAM(1:RTRIM(VARNAM)), ' is not present.' */ - -/* END IF */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.1, 22-DEC-2004 (NJB) */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* - SPICELIB Version 7.0.0, 20-SEP-1995 (WLT) */ - -/* The implementation of the kernel pool was completely redone */ -/* to improve performance in loading and fetching data. In */ -/* addition the pool was upgraded so that variables may be */ -/* either string or numeric valued. */ - -/* The entry points GCPOOL, GDPOOL, GIPOOL and DTPOOL were added */ -/* to the routine. */ - -/* -& */ -/* $ Index_Entries */ - -/* RETURN summary information about a kernel pool variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DTPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Until we find otherwise, we shall assume there is no data */ -/* for this variable. */ - - *found = FALSE_; - *n = 0; - s_copy(type__, "X", type_len, (ftnlen)1); - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("naml" - "st", i__2, "pool_", (ftnlen)5180)] == 0) { - chkout_("DTPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - node = namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "namlst", i__2, "pool_", (ftnlen)5191)]; - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= i__2 ? - i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)5192)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - node = nmpool[(i__2 = (node << 1) + 10) < 10018 && 0 <= i__2 ? i__2 : - s_rnge("nmpool", i__2, "pool_", (ftnlen)5196)]; - if (node < 0) { - chkout_("DTPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__2 = node - 1) < 5003 && 0 <= - i__2 ? i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)5205)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* If you get to this point, the variable NAME is present in the */ -/* list of names at PNAMES(NODE), ABS( DATLST(NODE) ) points to the */ -/* head of a linked list of values for this NAME. */ - - datahd = datlst[(i__2 = node - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "datlst", i__2, "pool_", (ftnlen)5214)]; - if (datahd < 0) { - s_copy(type__, "C", type_len, (ftnlen)1); - *found = TRUE_; - node = -datahd; - while(node > 0) { - ++(*n); - node = chpool[(i__2 = (node << 1) + 10) < 8012 && 0 <= i__2 ? - i__2 : s_rnge("chpool", i__2, "pool_", (ftnlen)5224)]; - } - } else if (datahd > 0) { - s_copy(type__, "N", type_len, (ftnlen)1); - *found = TRUE_; - node = datahd; - while(node > 0) { - ++(*n); - node = dppool[(i__2 = (node << 1) + 10) < 400012 && 0 <= i__2 ? - i__2 : s_rnge("dppool", i__2, "pool_", (ftnlen)5235)]; - } - } else if (datahd == 0) { - setmsg_("This is never supposed to happen. The requested name, '#'," - " was found in the name list, but the pointer to the head of " - "the data for this variable is zero. Please note your activit" - "ies and report this error to NAIF. ", (ftnlen)214); - errch_("#", name__, (ftnlen)1, rtrim_(name__, name_len)); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("DTPOOL", (ftnlen)6); - return 0; - } - chkout_("DTPOOL", (ftnlen)6); - return 0; -/* $Procedure PCPOOL ( Put character strings into the kernel pool ) */ - -L_pcpool: -/* $ Abstract */ - -/* This entry point provides toolkit programmers a method for */ -/* programmatically inserting character data into the */ -/* kernel pool. */ - -/* $ 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 */ - -/* POOL */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER N */ -/* CHARACTER*(*) CVALS ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The kernel pool name to associate with CVALS. */ -/* N I The number of values to insert. */ -/* CVALS I An array of strings to insert into the kernel pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the kernel pool variable to associate */ -/* with the values supplied in the array CVALS */ - -/* N is the number of values to insert into the kernel pool. */ - -/* CVALS is an array of strings to insert into the kernel */ -/* pool. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is already present in the kernel pool and there */ -/* is sufficient room to hold all values supplied in CVALS, */ -/* the old values associated with NAME will be overwritten. */ - -/* 2) If there is not sufficient room to insert a new variable */ -/* into the kernel pool and NAME is not already present in */ -/* the kernel pool, the error SPICE(KERNELPOOLFULL) is */ -/* signaled by a routine in the call tree to this routine. */ - -/* 3) If there is not sufficient room to insert the values associated */ -/* with NAME, the error 'SPICE(NOMOREROOM)' will be signaled. */ - -/* 4) The error 'SPICE(BADVARNAME)' signals if the kernel pool */ -/* variable name length exceeds MAXLEN. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point provides a programmatic interface for inserting */ -/* character data into the SPICE kernel pool without reading an */ -/* external file. */ - -/* $ Examples */ - -/* Suppose that you wish to supply default values for a program */ -/* so that it may function even in the absence of the appropriate */ -/* text kernels. You can use the entry points PCPOOL, PDPOOL */ -/* and PIPOOL to initialize the kernel pool with suitable */ -/* values at program initialization. The example below shows */ -/* how you might set up various kernel pool variables that might */ -/* be required by a program. */ - - -/* Set up the relationship between the EARTH_BODYFIXED frame */ -/* and the IAU_EARTH frame. */ - -/* CALL IDENT ( MATRIX ) */ -/* CALL PCPOOL ( 'TKFRAME_EARTH_FIXED_SPEC', 1, 'MATRIX' ) */ -/* CALL PCPOOL ( 'TKFRAME_EARTH_FIXED_RELATIVE', 1, 'IAU_EARTH' ) */ -/* CALL PDPOOL ( 'TKFRAME_EARTH_FIXED_MATRIX', 9, MATRIX ) */ - - -/* Load the IAU model for the earth's rotation and shape. */ - - -/* RA ( 1 ) = 0.0D0 */ -/* RA ( 2 ) = -0.641D0 */ -/* RA ( 3 ) = 0.0D0 */ - -/* DEC( 1 ) = 90.0D0 */ -/* DEC( 2 ) = -0.557D0 */ -/* DEC( 3 ) = 0.0D0 */ - -/* PM ( 1 ) = 190.16D0 */ -/* PM ( 2 ) = 360.9856235D0 */ -/* PM ( 3 ) = 0.0D0 */ - -/* R ( 1 ) = 6378.140D0 */ -/* R ( 2 ) = 6378.140D0 */ -/* R ( 3 ) = 6356.75D0 */ - -/* CALL PDPOOL ( 'BODY399_POLE_RA', 3, RA ) */ -/* CALL PDPOOL ( 'BODY399_POLE_DEC', 3, DEC ) */ -/* CALL PDPOOL ( 'BODY399_PM', 3, PM ) */ -/* CALL PDPOOL ( 'BODY399_RADII', 3, R ) */ - - -/* Set up a preliminary set of leapsecond values. */ - -/* CALL PDPOOL ( 'DELTET/DELTA_T_A/',1, 32.184D0 ) */ -/* CALL PDPOOL ( 'DELTET/K', 1, 1.657D-3 ) */ -/* CALL PDPOOL ( 'DELTET/EB', 1, 1.671D-2 ) */ - -/* VALUES(1) = 6.23999600D0 */ -/* VALUES(2) = 1.99096871D-7 */ - -/* CALL PDPOOL ( 'DELTET/M', 2, VALUES ) */ - - -/* VALUES( 1 ) = 10 */ -/* VALUES( 3 ) = 11 */ -/* VALUES( 5 ) = 12 */ -/* VALUES( 7 ) = 13 */ -/* VALUES( 9 ) = 14 */ -/* VALUES( 11 ) = 15 */ -/* VALUES( 13 ) = 16 */ -/* VALUES( 15 ) = 17 */ -/* VALUES( 17 ) = 18 */ -/* VALUES( 19 ) = 19 */ -/* VALUES( 21 ) = 20 */ -/* VALUES( 23 ) = 21 */ -/* VALUES( 25 ) = 22 */ -/* VALUES( 27 ) = 23 */ -/* VALUES( 29 ) = 24 */ -/* VALUES( 31 ) = 25 */ -/* VALUES( 33 ) = 26 */ -/* VALUES( 35 ) = 27 */ -/* VALUES( 37 ) = 28 */ -/* VALUES( 39 ) = 29 */ -/* VALUES( 41 ) = 30 */ -/* VALUES( 43 ) = 31 */ - -/* CALL TPARSE ( '1972-JAN-1', VALUES(2), ERROR ) */ -/* CALL TPARSE ( '1972-JUL-1', VALUES(4), ERROR ) */ -/* CALL TPARSE ( '1973-JAN-1', VALUES(6), ERROR ) */ -/* CALL TPARSE ( '1974-JAN-1', VALUES(8), ERROR ) */ -/* CALL TPARSE ( '1975-JAN-1', VALUES(10), ERROR ) */ -/* CALL TPARSE ( '1976-JAN-1', VALUES(12), ERROR ) */ -/* CALL TPARSE ( '1977-JAN-1', VALUES(14), ERROR ) */ -/* CALL TPARSE ( '1978-JAN-1', VALUES(16), ERROR ) */ -/* CALL TPARSE ( '1979-JAN-1', VALUES(18), ERROR ) */ -/* CALL TPARSE ( '1980-JAN-1', VALUES(20), ERROR ) */ -/* CALL TPARSE ( '1981-JUL-1', VALUES(22), ERROR ) */ -/* CALL TPARSE ( '1982-JUL-1', VALUES(24), ERROR ) */ -/* CALL TPARSE ( '1983-JUL-1', VALUES(26), ERROR ) */ -/* CALL TPARSE ( '1985-JUL-1', VALUES(28), ERROR ) */ -/* CALL TPARSE ( '1988-JAN-1', VALUES(30), ERROR ) */ -/* CALL TPARSE ( '1990-JAN-1', VALUES(32), ERROR ) */ -/* CALL TPARSE ( '1991-JAN-1', VALUES(34), ERROR ) */ -/* CALL TPARSE ( '1992-JUL-1', VALUES(36), ERROR ) */ -/* CALL TPARSE ( '1993-JUL-1', VALUES(38), ERROR ) */ -/* CALL TPARSE ( '1994-JUL-1', VALUES(40), ERROR ) */ -/* CALL TPARSE ( '1996-JAN-1', VALUES(42), ERROR ) */ -/* CALL TPARSE ( '1997-JUL-1', VALUES(44), ERROR ) */ - -/* CALL PDPOOL ( 'DELTET/DELTA_AT', 44, VALUES ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 9.0.0, 24-MAY-2010 (EDW) */ - -/* Added an error check on the length of the kernel pool variable */ -/* name argument to enforce the variable name length does not */ -/* exceed MAXLEN. */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory instead */ -/* of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* Set the value of a character kernel pool variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (*n <= 0) { - return 0; - } - if (return_()) { - return 0; - } - chkin_("PCPOOL", (ftnlen)6); - -/* Check the variable name length; signal an error */ -/* if longer than MAXLEN. */ - - varlen = i_len(name__, lastnb_(name__, name_len)); - if (varlen > 32) { - setmsg_("The input kernel pool variable name exceeds the maximum all" - "owed length of #1. The length of the variable name is #2, th" - "e offending variable name: '#3'.", (ftnlen)151); - errint_("#1", &c__32, (ftnlen)2); - errint_("#2", &varlen, (ftnlen)2); - errch_("#3", name__, (ftnlen)2, name_len); - sigerr_("SPICE(BADVARNAME)", (ftnlen)17); - chkout_("PCPOOL", (ftnlen)6); - return 0; - } - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Find out where the name for this item is located */ -/* in the data tables. */ - - zzgpnm_(namlst, nmpool, pnames, datlst, dppool, dpvals, chpool, chvals, - name__, &gotit, &lookat, &nameat, (ftnlen)32, (ftnlen)80, - name_len); - if (failed_()) { - chkout_("PCPOOL", (ftnlen)6); - return 0; - } - -/* Determine how much room is available for inserting new d.p.s */ -/* values into the kernel pool. */ - - avail = lnknfn_(chpool); - if (gotit) { - -/* If we found the specified variable in the kernel pool, we */ -/* may be able to free up some space before inserting data. */ -/* We need to take this into account when determining */ -/* the amount of free room in the pool. */ - - datahd = datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "pool_", (ftnlen)5594)]; - if (datahd > 0) { - -/* No extra strings will be freed. We have whatever */ -/* free space is in the CHPOOL right now. */ - - } else { - -/* Find out how many items are in the current */ -/* list of strings associated with the variable. */ - - tofree = 0; - node = -datahd; - while(node > 0) { - ++tofree; - node = chpool[(i__2 = (node << 1) + 10) < 8012 && 0 <= i__2 ? - i__2 : s_rnge("chpool", i__2, "pool_", (ftnlen)5611)]; - } - -/* Add the number we will free to the amount currently */ -/* free in the dp pool. */ - - avail += tofree; - } - } - -/* If the AVAIL for new data is less than the number of items */ -/* to be added, we just bail out here. */ - - if (avail < *n) { - if (! gotit) { - -/* We need to perform some clean up. We've allocated */ -/* a new name but it has nothing in it. On the other hand */ -/* if we found it don't need to do anything because we've */ -/* only read from the pool. We haven't altered anything. */ -/* But in that case we'll never get into this block of code. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - } - setmsg_("There is not sufficient space available in the kernel pool " - "to store the # items associated with the name #. There is r" - "oom to store only # items. ", (ftnlen)146); - errint_("#", n, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &avail, (ftnlen)1); - sigerr_("SPICE(NOMOREROOM)", (ftnlen)17); - chkout_("PCPOOL", (ftnlen)6); - return 0; - } - -/* There is room to insert the data. Free up any required */ -/* nodes. */ - - if (gotit) { - -/* We need to free the data associated with this */ -/* variable. But first make sure there will be room */ -/* to add data. */ - - datahd = datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "pool_", (ftnlen)5667)]; - datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("datl" - "st", i__2, "pool_", (ftnlen)5668)] = 0; - if (datahd > 0) { - -/* This variable was character type we need to */ -/* free a linked list from the character data */ -/* pool. */ - - head = datahd; - tail = -dppool[(i__2 = (head << 1) + 11) < 400012 && 0 <= i__2 ? - i__2 : s_rnge("dppool", i__2, "pool_", (ftnlen)5678)]; - lnkfsl_(&head, &tail, dppool); - } else { - -/* This variable was character type. We need to */ -/* free a linked list from the numeric pool. */ - - head = -datahd; - tail = -chpool[(i__2 = (head << 1) + 11) < 8012 && 0 <= i__2 ? - i__2 : s_rnge("chpool", i__2, "pool_", (ftnlen)5689)]; - lnkfsl_(&head, &tail, chpool); - } - } - -/* We have done all of the freeing and checking that */ -/* needs to be done. Now add the data. */ - - i__2 = *n; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* We are ready to go. Allocate a node for this data */ -/* item. First make sure there is room to do so. */ - - free = lnknfn_(chpool); - if (free <= 0) { - setmsg_("There is no room available for adding another character" - " value to the kernel pool.", (ftnlen)81); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("PCPOOL", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this string value: */ - - lnkan_(chpool, &chnode); - if (datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)5724)] == 0) { - -/* There was no data for this name yet. We make */ -/* CHNODE be the head of the data list for this name. */ - - datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)5730)] = -chnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = -datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : - s_rnge("datlst", i__1, "pool_", (ftnlen)5737)]; - tail = -chpool[(i__1 = (head << 1) + 11) < 8012 && 0 <= i__1 ? - i__1 : s_rnge("chpool", i__1, "pool_", (ftnlen)5738)]; - lnkila_(&tail, &chnode, chpool); - } - -/* Finally insert this data item in the data buffer */ -/* at CHNODE. Note any quotes will be doubled so we */ -/* have to undo this affect when we store the data. */ - - s_copy(chvals + ((i__1 = chnode - 1) < 4000 && 0 <= i__1 ? i__1 : - s_rnge("chvals", i__1, "pool_", (ftnlen)5749)) * 80, cvals + ( - i__ - 1) * cvals_len, (ftnlen)80, cvals_len); - -/* That's all for this value. It's now time to loop */ -/* back through and get the next value. */ - - } - -/* One last thing, see if this variable is being watched, */ -/* If it is, add its associated agents to the list of */ -/* AGENTS to be notified of a watched variable update. */ - - if (elemc_(name__, wtvars, name_len, (ftnlen)32)) { - -/* Union the update set AGENTS with the set of agents */ -/* associated with the variable NAME. */ - - zznwpool_(name__, wtvars, wtptrs, wtpool, wtagnt, active, notify, - agents, name_len, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen) - 32, (ftnlen)32); - } - chkout_("PCPOOL", (ftnlen)6); - return 0; -/* $Procedure PDPOOL ( Put d.p.'s into the kernel pool ) */ - -L_pdpool: -/* $ Abstract */ - -/* This entry point provides toolkit programmers a method for */ -/* programmatically inserting double precision data into the */ -/* kernel pool. */ - -/* $ 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 */ - -/* POOL */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER N */ -/* DOUBLE PRECISION VALUES ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The kernel pool name to associate with VALUES. */ -/* N I The number of values to insert. */ -/* VALUES I An array of values to insert into the kernel pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the kernel pool variable to associate */ -/* with the values supplied in the array VALUES */ - -/* N is the number of values to insert into the kernel pool. */ - -/* VALUES is an array of d.p. values to insert into the kernel */ -/* pool. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is already present in the kernel pool and there */ -/* is sufficient room to hold all values supplied in VALUES, */ -/* the old values associated with NAME will be overwritten. */ - -/* 2) If there is not sufficient room to insert a new variable */ -/* into the kernel pool and NAME is not already present in */ -/* the kernel pool, the error SPICE(KERNELPOOLFULL) is */ -/* signaled by a routine in the call tree to this routine. */ - -/* 3) If there is not sufficient room to insert the values associated */ -/* with NAME, the error 'SPICE(NOMOREROOM)' will be signaled. */ - -/* 4) The error 'SPICE(BADVARNAME)' signals if the kernel pool */ -/* variable name length exceeds MAXLEN. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point provides a programmatic interface for inserting */ -/* data into the SPICE kernel pool without reading an external file. */ - -/* $ Examples */ - -/* Suppose that you wish to supply default values for a program */ -/* so that it may function even in the absence of the appropriate */ -/* text kernels. You can use the entry points PCPOOL, PDPOOL */ -/* and PIPOOL to initialize the kernel pool with suitable */ -/* values at program initialization. The example below shows */ -/* how you might set up various kernel pool variables that might */ -/* be required by a program. */ - - -/* Set up the relationship between the EARTH_BODYFIXED frame */ -/* and the IAU_EARTH frame. */ - -/* CALL IDENT ( MATRIX ) */ -/* CALL PCPOOL ( 'TKFRAME_EARTH_FIXED_SPEC', 1, 'MATRIX' ) */ -/* CALL PCPOOL ( 'TKFRAME_EARTH_FIXED_RELATIVE', 1, 'IAU_EARTH' ) */ -/* CALL PDPOOL ( 'TKFRAME_EARTH_FIXED_MATRIX', 9, MATRIX ) */ - - -/* Load the IAU model for the earth's rotation and shape. */ - - -/* RA ( 1 ) = 0.0D0 */ -/* RA ( 2 ) = -0.641D0 */ -/* RA ( 3 ) = 0.0D0 */ - -/* DEC( 1 ) = 90.0D0 */ -/* DEC( 2 ) = -0.557D0 */ -/* DEC( 3 ) = 0.0D0 */ - -/* PM ( 1 ) = 190.16D0 */ -/* PM ( 2 ) = 360.9856235D0 */ -/* PM ( 3 ) = 0.0D0 */ - -/* R ( 1 ) = 6378.140D0 */ -/* R ( 2 ) = 6378.140D0 */ -/* R ( 3 ) = 6356.75D0 */ - -/* CALL PDPOOL ( 'BODY399_POLE_RA', 3, RA ) */ -/* CALL PDPOOL ( 'BODY399_POLE_DEC', 3, DEC ) */ -/* CALL PDPOOL ( 'BODY399_PM', 3, PM ) */ -/* CALL PDPOOL ( 'BODY399_RADII', 3, R ) */ - - -/* Set up a preliminary set of leapsecond values. */ - -/* CALL PDPOOL ( 'DELTET/DELTA_T_A', 1, 32.184D0 ) */ -/* CALL PDPOOL ( 'DELTET/K', 1, 1.657D-3 ) */ -/* CALL PDPOOL ( 'DELTET/EB', 1, 1.671D-2 ) */ - -/* VALUES(1) = 6.23999600D0 */ -/* VALUES(2) = 1.99096871D-7 */ - -/* CALL PDPOOL ( 'DELTET/M', 2, VALUES ) */ - - -/* VALUES( 1 ) = 10 */ -/* VALUES( 3 ) = 11 */ -/* VALUES( 5 ) = 12 */ -/* VALUES( 7 ) = 13 */ -/* VALUES( 9 ) = 14 */ -/* VALUES( 11 ) = 15 */ -/* VALUES( 13 ) = 16 */ -/* VALUES( 15 ) = 17 */ -/* VALUES( 17 ) = 18 */ -/* VALUES( 19 ) = 19 */ -/* VALUES( 21 ) = 20 */ -/* VALUES( 23 ) = 21 */ -/* VALUES( 25 ) = 22 */ -/* VALUES( 27 ) = 23 */ -/* VALUES( 29 ) = 24 */ -/* VALUES( 31 ) = 25 */ -/* VALUES( 33 ) = 26 */ -/* VALUES( 35 ) = 27 */ -/* VALUES( 37 ) = 28 */ -/* VALUES( 39 ) = 29 */ -/* VALUES( 41 ) = 30 */ -/* VALUES( 43 ) = 31 */ - -/* CALL TPARSE ( '1972-JAN-1', VALUES(2), ERROR ) */ -/* CALL TPARSE ( '1972-JUL-1', VALUES(4), ERROR ) */ -/* CALL TPARSE ( '1973-JAN-1', VALUES(6), ERROR ) */ -/* CALL TPARSE ( '1974-JAN-1', VALUES(8), ERROR ) */ -/* CALL TPARSE ( '1975-JAN-1', VALUES(10), ERROR ) */ -/* CALL TPARSE ( '1976-JAN-1', VALUES(12), ERROR ) */ -/* CALL TPARSE ( '1977-JAN-1', VALUES(14), ERROR ) */ -/* CALL TPARSE ( '1978-JAN-1', VALUES(16), ERROR ) */ -/* CALL TPARSE ( '1979-JAN-1', VALUES(18), ERROR ) */ -/* CALL TPARSE ( '1980-JAN-1', VALUES(20), ERROR ) */ -/* CALL TPARSE ( '1981-JUL-1', VALUES(22), ERROR ) */ -/* CALL TPARSE ( '1982-JUL-1', VALUES(24), ERROR ) */ -/* CALL TPARSE ( '1983-JUL-1', VALUES(26), ERROR ) */ -/* CALL TPARSE ( '1985-JUL-1', VALUES(28), ERROR ) */ -/* CALL TPARSE ( '1988-JAN-1', VALUES(30), ERROR ) */ -/* CALL TPARSE ( '1990-JAN-1', VALUES(32), ERROR ) */ -/* CALL TPARSE ( '1991-JAN-1', VALUES(34), ERROR ) */ -/* CALL TPARSE ( '1992-JUL-1', VALUES(36), ERROR ) */ -/* CALL TPARSE ( '1993-JUL-1', VALUES(38), ERROR ) */ -/* CALL TPARSE ( '1994-JUL-1', VALUES(40), ERROR ) */ -/* CALL TPARSE ( '1996-JAN-1', VALUES(42), ERROR ) */ -/* CALL TPARSE ( '1997-JUL-1', VALUES(44), ERROR ) */ - -/* CALL PDPOOL ( 'DELTET/DELTA_AT', 44, VALUES ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 9.0.0, 24-MAY-2010 (EDW) */ - -/* Added an error check on the length of the kernel pool variable */ -/* name argument to enforce the variable name length does not */ -/* exceed MAXLEN. */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory instead */ -/* of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* Set the value of a d.p. kernel pool variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (*n <= 0) { - return 0; - } - if (return_()) { - return 0; - } - chkin_("PDPOOL", (ftnlen)6); - -/* Check the variable name length; signal an error */ -/* if longer than MAXLEN. */ - - varlen = i_len(name__, lastnb_(name__, name_len)); - if (varlen > 32) { - setmsg_("The input kernel pool variable name exceeds the maximum all" - "owed length of #1. The length of the variable name is #2, th" - "e offending variable name: '#3'.", (ftnlen)151); - errint_("#1", &c__32, (ftnlen)2); - errint_("#2", &varlen, (ftnlen)2); - errch_("#3", name__, (ftnlen)2, name_len); - sigerr_("SPICE(BADVARNAME)", (ftnlen)17); - chkout_("PDPOOL", (ftnlen)6); - return 0; - } - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Find out where the name for this item is located */ -/* in the data tables. */ - - zzgpnm_(namlst, nmpool, pnames, datlst, dppool, dpvals, chpool, chvals, - name__, &gotit, &lookat, &nameat, (ftnlen)32, (ftnlen)80, - name_len); - if (failed_()) { - chkout_("PDPOOL", (ftnlen)6); - return 0; - } - -/* Determine how much room is available for inserting new d.p.s */ -/* values into the kernel pool. */ - - avail = lnknfn_(dppool); - if (gotit) { - -/* If we found the specified variable in the kernel pool, we */ -/* may be able to free up some space before inserting data. */ -/* We need to take this into account when determining */ -/* the amount of free room in the pool. */ - - datahd = datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "pool_", (ftnlen)6113)]; - if (datahd < 0) { - -/* No extra d.p.s will be freed. We have whatever */ -/* free space is in the DPPOOL right now. */ - - } else { - -/* Find out how many items are in the current */ -/* list of d.p. associated with the variable. */ - - tofree = 0; - node = datahd; - while(node > 0) { - ++tofree; - node = dppool[(i__2 = (node << 1) + 10) < 400012 && 0 <= i__2 - ? i__2 : s_rnge("dppool", i__2, "pool_", (ftnlen)6130) - ]; - } - -/* Add the number we will free to the amount currently */ -/* free in the dp pool. */ - - avail += tofree; - } - } - -/* If the AVAIL for new data is less than the number of items */ -/* to be added, we just bail out here. */ - - if (avail < *n) { - if (! gotit) { - -/* We need to perform some clean up. We've allocated */ -/* a new name but it has nothing in it. On the other hand */ -/* if we found it don't need to do anything because we've */ -/* only read from the pool. We haven't altered anything. */ -/* But in that case we'll never get into this block of code. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - } - setmsg_("There is not sufficient space available in the kernel pool " - "to store the # items associated with the name #. There is r" - "oom to store only # items. ", (ftnlen)146); - errint_("#", n, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &avail, (ftnlen)1); - sigerr_("SPICE(NOMOREROOM)", (ftnlen)17); - chkout_("PDPOOL", (ftnlen)6); - return 0; - } - -/* There is room to insert the data. Free up any required */ -/* nodes. */ - - if (gotit) { - -/* We need to free the data associated with this */ -/* variable. But first make sure there will be room */ -/* to add data. */ - - datahd = datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "pool_", (ftnlen)6186)]; - datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("datl" - "st", i__2, "pool_", (ftnlen)6187)] = 0; - if (datahd < 0) { - -/* This variable was character type we need to */ -/* free a linked list from the character data */ -/* pool. */ - - head = -datahd; - tail = -chpool[(i__2 = (head << 1) + 11) < 8012 && 0 <= i__2 ? - i__2 : s_rnge("chpool", i__2, "pool_", (ftnlen)6197)]; - lnkfsl_(&head, &tail, chpool); - } else { - -/* This variable was numeric type. We need to */ -/* free a linked list from the numeric pool. */ - - head = datahd; - tail = -dppool[(i__2 = (head << 1) + 11) < 400012 && 0 <= i__2 ? - i__2 : s_rnge("dppool", i__2, "pool_", (ftnlen)6208)]; - lnkfsl_(&head, &tail, dppool); - } - } - -/* We have done all of the freeing and checking that */ -/* needs to be done. Now add the data. */ - - i__2 = *n; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* OK. See if there is room in */ -/* the numeric portion of the pool to store this value. */ - - free = lnknfn_(dppool); - if (free <= 0) { - -/* This branch of the code should never be exercised, */ -/* but it doesn't hurt to program in a redundant check. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - setmsg_("There is no room available for adding another numeric v" - "alue to the kernel pool.", (ftnlen)79); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("PDPOOL", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this numeric value: */ - - lnkan_(dppool, &dpnode); - if (datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)6249)] == 0) { - -/* There was no data for this name yet. We make */ -/* DPNODE be the head of the data list for this name. */ - - datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)6255)] = dpnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : - s_rnge("datlst", i__1, "pool_", (ftnlen)6262)]; - tail = -dppool[(i__1 = (head << 1) + 11) < 400012 && 0 <= i__1 ? - i__1 : s_rnge("dppool", i__1, "pool_", (ftnlen)6263)]; - lnkila_(&tail, &dpnode, dppool); - } - -/* Finally insert this data item into the numeric buffer. */ - - dpvals[(i__1 = dpnode - 1) < 200000 && 0 <= i__1 ? i__1 : s_rnge( - "dpvals", i__1, "pool_", (ftnlen)6272)] = values[i__ - 1]; - } - -/* One last thing, see if this variable is being watched, */ -/* If it is, add its associated agents to the list of */ -/* AGENTS to be notified of a watched variable update. */ - - if (elemc_(name__, wtvars, name_len, (ftnlen)32)) { - -/* Union the update set AGENTS with the set of agents */ -/* associated with the variable NAME. */ - - zznwpool_(name__, wtvars, wtptrs, wtpool, wtagnt, active, notify, - agents, name_len, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen) - 32, (ftnlen)32); - } - chkout_("PDPOOL", (ftnlen)6); - return 0; -/* $Procedure PIPOOL ( Put integers into the kernel pool ) */ - -L_pipool: -/* $ Abstract */ - -/* This entry point provides toolkit programmers a method for */ -/* programmatically inserting integer data into the kernel pool. */ - -/* $ 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 */ - -/* POOL */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER N */ -/* INTEGER IVALS ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The kernel pool name to associate with IVALS. */ -/* N I The number of values to insert. */ -/* IVALS I An array of integers to insert into the pool. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the kernel pool variable to associate */ -/* with the values supplied in the array IVALS */ - -/* N is the number of values to insert into the kernel pool. */ - -/* IVALS is an array of integers to insert into the kernel */ -/* pool. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is already present in the kernel pool and there */ -/* is sufficient room to hold all values supplied in IVALS, */ -/* the old values associated with NAME will be overwritten. */ - -/* 2) If there is not sufficient room to insert a new variable */ -/* into the kernel pool and NAME is not already present in */ -/* the kernel pool, the error SPICE(KERNELPOOLFULL) is */ -/* signaled by a routine in the call tree to this routine. */ - -/* 3) If there is not sufficient room to insert the values associated */ -/* with NAME, the error 'SPICE(NOMOREROOM)' will be signaled. */ - -/* 4) The error 'SPICE(BADVARNAME)' signals if the kernel pool */ -/* variable name length exceeds MAXLEN. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point provides a programmatic interface for inserting */ -/* data into the SPICE kernel pool without reading an external file. */ - -/* $ Examples */ - -/* Suppose that you wish to supply default values for a program */ -/* so that it may function even in the absence of the appropriate */ -/* text kernels. You can use the entry points PCPOOL, PDPOOL */ -/* and PIPOOL to initialize the kernel pool with suitable */ -/* values at program initialization. The example below shows */ -/* how you might set up various kernel pool variables that might */ -/* be required by a program. */ - - -/* Set up the relationship between the EARTH_BODYFIXED frame */ -/* and the IAU_EARTH frame. */ - -/* CALL IDENT ( MATRIX ) */ -/* CALL PCPOOL ( 'TKFRAME_EARTH_FIXED_SPEC', 1, 'MATRIX' ) */ -/* CALL PIPOOL ( 'TKFRAME_EARTH_FIXED_RELATIVE', 1, 10081 ) */ -/* CALL PDPOOL ( 'TKFRAME_EARTH_FIXED_MATRIX', 9, MATRIX ) */ - - -/* Load the IAU model for the earth's rotation and shape. */ - - -/* RA ( 1 ) = 0.0D0 */ -/* RA ( 2 ) = -0.641D0 */ -/* RA ( 3 ) = 0.0D0 */ - -/* DEC( 1 ) = 90.0D0 */ -/* DEC( 2 ) = -0.557D0 */ -/* DEC( 3 ) = 0.0D0 */ - -/* PM ( 1 ) = 190.16D0 */ -/* PM ( 2 ) = 360.9856235D0 */ -/* PM ( 3 ) = 0.0D0 */ - -/* R ( 1 ) = 6378.140D0 */ -/* R ( 2 ) = 6378.140D0 */ -/* R ( 3 ) = 6356.75D0 */ - -/* CALL PDPOOL ( 'BODY399_POLE_RA', 3, RA ) */ -/* CALL PDPOOL ( 'BODY399_POLE_DEC', 3, DEC ) */ -/* CALL PDPOOL ( 'BODY399_PM', 3, PM ) */ -/* CALL PDPOOL ( 'BODY399_RADII', 3, R ) */ - - -/* Set up a preliminary set of leapsecond values. */ - -/* CALL PDPOOL ( 'DELTET/DELTA_T_A/',1, 32.184D0 ) */ -/* CALL PDPOOL ( 'DELTET/K', 1, 1.657D-3 ) */ -/* CALL PDPOOL ( 'DELTET/EB', 1, 1.671D-2 ) */ - -/* VALUES(1) = 6.23999600D0 */ -/* VALUES(2) = 1.99096871D-7 */ - -/* CALL PDPOOL ( 'DELTET/M', 2, VALUES ) */ - - -/* VALUES( 1 ) = 10 */ -/* VALUES( 3 ) = 11 */ -/* VALUES( 5 ) = 12 */ -/* VALUES( 7 ) = 13 */ -/* VALUES( 9 ) = 14 */ -/* VALUES( 11 ) = 15 */ -/* VALUES( 13 ) = 16 */ -/* VALUES( 15 ) = 17 */ -/* VALUES( 17 ) = 18 */ -/* VALUES( 19 ) = 19 */ -/* VALUES( 21 ) = 20 */ -/* VALUES( 23 ) = 21 */ -/* VALUES( 25 ) = 22 */ -/* VALUES( 27 ) = 23 */ -/* VALUES( 29 ) = 24 */ -/* VALUES( 31 ) = 25 */ -/* VALUES( 33 ) = 26 */ -/* VALUES( 35 ) = 27 */ -/* VALUES( 37 ) = 28 */ -/* VALUES( 39 ) = 29 */ -/* VALUES( 41 ) = 30 */ -/* VALUES( 43 ) = 31 */ - -/* CALL TPARSE ( '1972-JAN-1', VALUES(2), ERROR ) */ -/* CALL TPARSE ( '1972-JUL-1', VALUES(4), ERROR ) */ -/* CALL TPARSE ( '1973-JAN-1', VALUES(6), ERROR ) */ -/* CALL TPARSE ( '1974-JAN-1', VALUES(8), ERROR ) */ -/* CALL TPARSE ( '1975-JAN-1', VALUES(10), ERROR ) */ -/* CALL TPARSE ( '1976-JAN-1', VALUES(12), ERROR ) */ -/* CALL TPARSE ( '1977-JAN-1', VALUES(14), ERROR ) */ -/* CALL TPARSE ( '1978-JAN-1', VALUES(16), ERROR ) */ -/* CALL TPARSE ( '1979-JAN-1', VALUES(18), ERROR ) */ -/* CALL TPARSE ( '1980-JAN-1', VALUES(20), ERROR ) */ -/* CALL TPARSE ( '1981-JUL-1', VALUES(22), ERROR ) */ -/* CALL TPARSE ( '1982-JUL-1', VALUES(24), ERROR ) */ -/* CALL TPARSE ( '1983-JUL-1', VALUES(26), ERROR ) */ -/* CALL TPARSE ( '1985-JUL-1', VALUES(28), ERROR ) */ -/* CALL TPARSE ( '1988-JAN-1', VALUES(30), ERROR ) */ -/* CALL TPARSE ( '1990-JAN-1', VALUES(32), ERROR ) */ -/* CALL TPARSE ( '1991-JAN-1', VALUES(34), ERROR ) */ -/* CALL TPARSE ( '1992-JUL-1', VALUES(36), ERROR ) */ -/* CALL TPARSE ( '1993-JUL-1', VALUES(38), ERROR ) */ -/* CALL TPARSE ( '1994-JUL-1', VALUES(40), ERROR ) */ -/* CALL TPARSE ( '1996-JAN-1', VALUES(42), ERROR ) */ -/* CALL TPARSE ( '1997-JUL-1', VALUES(44), ERROR ) */ - -/* CALL PDPOOL ( 'DELTET/DELTA_AT', 44, VALUES ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 9.0.0, 24-MAY-2010 (EDW) */ - -/* Added an error check on the length of the kernel pool variable */ -/* name argument to enforce the variable name length does not */ -/* exceed MAXLEN. */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory instead */ -/* of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* Set the value of a numeric kernel pool variable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (*n <= 0) { - return 0; - } - if (return_()) { - return 0; - } - chkin_("PIPOOL", (ftnlen)6); - -/* Check the variable name length; signal an error */ -/* if longer than MAXLEN. */ - - varlen = i_len(name__, lastnb_(name__, name_len)); - if (varlen > 32) { - setmsg_("The input kernel pool variable name exceeds the maximum all" - "owed length of #1. The length of the variable name is #2, th" - "e offending variable name: '#3'.", (ftnlen)151); - errint_("#1", &c__32, (ftnlen)2); - errint_("#2", &varlen, (ftnlen)2); - errch_("#3", name__, (ftnlen)2, name_len); - sigerr_("SPICE(BADVARNAME)", (ftnlen)17); - chkout_("PIPOOL", (ftnlen)6); - return 0; - } - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Find out where the name for this item is located */ -/* in the data tables. */ - - zzgpnm_(namlst, nmpool, pnames, datlst, dppool, dpvals, chpool, chvals, - name__, &gotit, &lookat, &nameat, (ftnlen)32, (ftnlen)80, - name_len); - if (failed_()) { - chkout_("PIPOOL", (ftnlen)6); - return 0; - } - -/* Determine how much room is available for inserting new d.p.s */ -/* values into the kernel pool. */ - - avail = lnknfn_(dppool); - if (gotit) { - -/* If we found the specified variable in the kernel pool, we */ -/* may be able to free up some space before inserting data. */ -/* We need to take this into account when determining */ -/* the amount of free room in the pool. */ - - datahd = datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "pool_", (ftnlen)6631)]; - if (datahd < 0) { - -/* No extra d.p.s will be freed. We have whatever */ -/* free space is in the DPPOOL right now. */ - - } else { - -/* Find out how many items are in the current */ -/* list of d.p. associated with the variable. */ - - tofree = 0; - node = datahd; - while(node > 0) { - ++tofree; - node = dppool[(i__2 = (node << 1) + 10) < 400012 && 0 <= i__2 - ? i__2 : s_rnge("dppool", i__2, "pool_", (ftnlen)6648) - ]; - } - -/* Add the number we will free to the amount currently */ -/* free in the dp pool. */ - - avail += tofree; - } - } - -/* If the AVAIL for new data is less than the number of items */ -/* to be added, we just bail out here. */ - - if (avail < *n) { - if (! gotit) { - -/* We need to perform some clean up. We've allocated */ -/* a new name but it has nothing in it. On the other hand */ -/* if we found it don't need to do anything because we've */ -/* only read from the pool. We haven't altered anything. */ -/* But in that case we'll never get into this block of code. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - } - setmsg_("There is not sufficient space available in the kernel pool " - "to store the # items associated with the name #. There is r" - "oom to store only # items. ", (ftnlen)146); - errint_("#", n, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &avail, (ftnlen)1); - sigerr_("SPICE(NOMOREROOM)", (ftnlen)17); - chkout_("PIPOOL", (ftnlen)6); - return 0; - } - -/* There is room to insert the data. Free up any required */ -/* nodes. */ - - if (gotit) { - -/* We need to free the data associated with this */ -/* variable. But first make sure there will be room */ -/* to add data. */ - - datahd = datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "pool_", (ftnlen)6703)]; - datlst[(i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("datl" - "st", i__2, "pool_", (ftnlen)6704)] = 0; - if (datahd < 0) { - -/* This variable was character type we need to */ -/* free a linked list from the character data */ -/* pool. */ - - head = -datahd; - tail = -chpool[(i__2 = (head << 1) + 11) < 8012 && 0 <= i__2 ? - i__2 : s_rnge("chpool", i__2, "pool_", (ftnlen)6714)]; - lnkfsl_(&head, &tail, chpool); - } else { - -/* This variable was numeric type. We need to */ -/* free a linked list from the numeric pool. */ - - head = datahd; - tail = -dppool[(i__2 = (head << 1) + 11) < 400012 && 0 <= i__2 ? - i__2 : s_rnge("dppool", i__2, "pool_", (ftnlen)6725)]; - lnkfsl_(&head, &tail, dppool); - } - } - -/* We have done all of the freeing and checking that */ -/* needs to be done. Now add the data. */ - - i__2 = *n; - for (i__ = 1; i__ <= i__2; ++i__) { - -/* OK. See if there is room in */ -/* the numeric portion of the pool to store this value. */ - - free = lnknfn_(dppool); - if (free <= 0) { - -/* This branch of the code should never be exercised, */ -/* but it doesn't hurt to program in a redundant check. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - setmsg_("There is no room available for adding another numeric v" - "alue to the kernel pool.", (ftnlen)79); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("PIPOOL", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this numeric value: */ - - lnkan_(dppool, &dpnode); - if (datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)6766)] == 0) { - -/* There was no data for this name yet. We make */ -/* DPNODE be the head of the data list for this name. */ - - datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : s_rnge( - "datlst", i__1, "pool_", (ftnlen)6772)] = dpnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = datlst[(i__1 = nameat - 1) < 5003 && 0 <= i__1 ? i__1 : - s_rnge("datlst", i__1, "pool_", (ftnlen)6779)]; - tail = -dppool[(i__1 = (head << 1) + 11) < 400012 && 0 <= i__1 ? - i__1 : s_rnge("dppool", i__1, "pool_", (ftnlen)6780)]; - lnkila_(&tail, &dpnode, dppool); - } - -/* Finally insert this data item into the numeric buffer. */ - - dpvals[(i__1 = dpnode - 1) < 200000 && 0 <= i__1 ? i__1 : s_rnge( - "dpvals", i__1, "pool_", (ftnlen)6789)] = (doublereal) ivals[ - i__ - 1]; - } - -/* One last thing, see if this variable is being watched, */ -/* If it is, add its associated agents to the list of */ -/* AGENTS to be notified of a watched variable update. */ - - if (elemc_(name__, wtvars, name_len, (ftnlen)32)) { - -/* Union the update set AGENTS with the set of agents */ -/* associated with the variable NAME. */ - - zznwpool_(name__, wtvars, wtptrs, wtpool, wtagnt, active, notify, - agents, name_len, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen) - 32, (ftnlen)32); - } - chkout_("PIPOOL", (ftnlen)6); - return 0; -/* $Procedure LMPOOL ( Load variables from memory into the pool ) */ - -L_lmpool: -/* $ Abstract */ - -/* Load the variables contained in an internal buffer into the */ -/* kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) CVALS ( * ) */ -/* INTEGER N */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CVALS I An array that contains a SPICE text kernel */ -/* N I The number of entries in CVALS. */ - -/* $ Detailed_Input */ - -/* CVALS is an array that contains lines of text that */ -/* could serve as a SPICE text kernel. */ - -/* N the number of entries in CVALS. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) All exceptions are diagnosed by routines called by the */ -/* private routine ZZRVBF. */ - -/* 2) The error 'SPICE(BADVARNAME)' signals from a routine in the */ -/* call tree of LMPOOL if a kernel pool variable name length */ -/* exceeds MAXLEN characters (defined in pool.f). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to store a text kernel in an internal */ -/* array of your program and load this array into the kernel pool */ -/* without first storing its contents as a text kernel. */ - -/* $ Examples */ - -/* Suppose that your application is not particularly sensitive */ -/* to the current number of leapseconds but that you would */ -/* still like to use a relatively recent leapseconds kernel */ -/* without requiring users to load a leapseconds kernel into */ -/* the program. The example below shows how you might set up */ -/* the initialization portion of your program. */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* CHARACTER*(LNSIZE) TEXT ( 27 ) */ - -/* TEXT( 1 ) = 'DELTET/DELTA_T_A = 32.184' */ -/* TEXT( 2 ) = 'DELTET/K = 1.657D-3' */ -/* TEXT( 3 ) = 'DELTET/EB = 1.671D-2' */ -/* TEXT( 4 ) = 'DELTET/M = ( 6.239996D0 1.99096871D-7 )' */ -/* TEXT( 5 ) = 'DELTET/DELTA_AT = ( 10, @1972-JAN-1' */ -/* TEXT( 6 ) = ' 11, @1972-JUL-1' */ -/* TEXT( 7 ) = ' 12, @1973-JAN-1' */ -/* TEXT( 8 ) = ' 13, @1974-JAN-1' */ -/* TEXT( 9 ) = ' 14, @1975-JAN-1' */ -/* TEXT( 10 ) = ' 15, @1976-JAN-1' */ -/* TEXT( 11 ) = ' 16, @1977-JAN-1' */ -/* TEXT( 12 ) = ' 17, @1978-JAN-1' */ -/* TEXT( 13 ) = ' 18, @1979-JAN-1' */ -/* TEXT( 14 ) = ' 19, @1980-JAN-1' */ -/* TEXT( 15 ) = ' 20, @1981-JUL-1' */ -/* TEXT( 16 ) = ' 21, @1982-JUL-1' */ -/* TEXT( 17 ) = ' 22, @1983-JUL-1' */ -/* TEXT( 18 ) = ' 23, @1985-JUL-1' */ -/* TEXT( 19 ) = ' 24, @1988-JAN-1' */ -/* TEXT( 20 ) = ' 25, @1990-JAN-1' */ -/* TEXT( 21 ) = ' 26, @1991-JAN-1' */ -/* TEXT( 22 ) = ' 27, @1992-JUL-1' */ -/* TEXT( 23 ) = ' 28, @1993-JUL-1' */ -/* TEXT( 24 ) = ' 29, @1994-JUL-1' */ -/* TEXT( 25 ) = ' 30, @1996-JAN-1' */ -/* TEXT( 26 ) = ' 31, @1997-JUL-1' */ -/* TEXT( 27 ) = ' 32, @1999-JAN-1 )' */ - -/* CALL LMPOOL ( TEXT, 27 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.2.0, 10-FEB-2010 (EDW) */ - -/* Added mention of the restriction on kernel pool variable */ -/* names to MAXLEN characters or less. */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* Load the kernel pool from an internal text buffer */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LMPOOL", (ftnlen)6); - } - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Read from the internal SPICE pool buffer */ - - linnum = 1; - zzrvbf_(cvals, n, &linnum, namlst, nmpool, pnames, datlst, dppool, dpvals, - chpool, chvals, varnam, &eof, cvals_len, (ftnlen)32, (ftnlen)80, - (ftnlen)32); - -/* Read the variables in the file, one at a time. */ - - while(! eof && ! failed_()) { - if (s_cmp(varnam, " ", (ftnlen)32, (ftnlen)1) != 0) { - if (elemc_(varnam, wtvars, (ftnlen)32, (ftnlen)32)) { - -/* The variable VARNAM is watched. */ - -/* Union the update set AGENTS with the set of agents */ -/* associated with the variable VARNAM. */ - - zznwpool_(varnam, wtvars, wtptrs, wtpool, wtagnt, active, - notify, agents, (ftnlen)32, (ftnlen)32, (ftnlen)32, ( - ftnlen)32, (ftnlen)32, (ftnlen)32); - } - } - -/* We've processed VARNAM if it was non-blank. */ - - zzrvbf_(cvals, n, &linnum, namlst, nmpool, pnames, datlst, dppool, - dpvals, chpool, chvals, varnam, &eof, cvals_len, (ftnlen)32, ( - ftnlen)80, (ftnlen)32); - } - -/* That's it, the buffer supplied has been completely parsed */ -/* and placed into the kernel pool. */ - - chkout_("LMPOOL", (ftnlen)6); - return 0; -/* $Procedure SZPOOL (Get size limitations of the kernel pool) */ - -L_szpool: -/* $ Abstract */ - -/* Return the kernel pool size limitations. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER N */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the parameter to be returned. */ -/* N O Value of parameter specified by NAME. */ -/* FOUND O .TRUE. if NAME is recognized. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a kernel pool size parameter. */ -/* The following parameters may be specified. */ - -/* 'MAXVAR' */ -/* 'MAXVAL' */ -/* 'MAXLIN' */ -/* 'MAXCHR' */ -/* 'MXNOTE' */ -/* 'MAXLEN' */ -/* 'MAXAGT' */ - -/* See the main entry point for a description of the */ -/* meaning of these parameters. Note that the case */ -/* of NAME is insignificant. */ - -/* $ Detailed_Output */ - -/* N is the value of the parameter specified by NAME. If */ -/* NAME is not one of the items specified above, N will */ -/* be returned with the value 0. */ - -/* FOUND is TRUE if the parameter is recognized FALSE if it */ -/* is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified parameter is not recognized the value of N */ -/* returned will be zero and FOUND will be set to FALSE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the a programmatic interface to the */ -/* parameters used to define the kernel pool. It is not */ -/* anticipated that most kernel pool users will need to use this */ -/* routine. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.W. Taylor (ACT) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT)(HWT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* return a kernel pool definition parameter */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SZPOOL", (ftnlen)6); - *found = TRUE_; - if (eqstr_(name__, "MAXVAR", name_len, (ftnlen)6)) { - *n = 5003; - } else if (eqstr_(name__, "MAXVAL", name_len, (ftnlen)6)) { - *n = 200000; - } else if (eqstr_(name__, "MAXLIN", name_len, (ftnlen)6)) { - *n = 4000; - } else if (eqstr_(name__, "MAXCHR", name_len, (ftnlen)6)) { - *n = 80; - } else if (eqstr_(name__, "MXNOTE", name_len, (ftnlen)6)) { - *n = 50030; - } else if (eqstr_(name__, "MAXLEN", name_len, (ftnlen)6)) { - *n = 32; - } else if (eqstr_(name__, "MAXAGT", name_len, (ftnlen)6)) { - *n = 1000; - } else { - *n = 0; - *found = FALSE_; - } - chkout_("SZPOOL", (ftnlen)6); - return 0; -/* $Procedure DVPOOL ( Delete a variable from the kernel pool ) */ - -L_dvpool: -/* $ Abstract */ - -/* Delete a variable from the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the variable to be deleted. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the kernel pool variable to delete. */ -/* The name and associated values are removed from the */ -/* kernel pool, freeing the occupied space. */ - -/* If a watches are set on the variable designated by */ -/* NAME, the corresponding agents are placed on the list */ -/* of agents to be notified of a kernel variable update. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified variable is not present in the kernel pool, */ -/* this routine simply returns. No error is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine enables users to selectively remove variables from */ -/* the kernel pool, as opposed to having to clear the pool and */ -/* reload it. */ - -/* Note that it is not necessary to remove kernel variables in order */ -/* to simply update them; this routine should be used only when */ -/* variables are to be removed. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) Remove triaxial radii of Jupiter from the kernel pool. */ - -/* CALL DVPOOL ( 'BODY599_RADII' ) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.2.0, 19-MAR-2009 (NJB) */ - -/* Watcher update code was re-written for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.1.0, 22-DEC-2004 (NJB) */ - -/* Bug fix: corrected logic for determining when a */ -/* conflict resolution list is non-empty. */ - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (NJB) (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* delete a kernel pool variable */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.1.0, 22-DEC-2004 (NJB) */ - -/* Bug fix: corrected logic for determining when a */ -/* conflict resolution list is non-empty. The test */ - -/* IF ( NAMEAT .LT. 0 ) THEN */ - -/* formerly tested the variable NODE instead of NAMEAT. */ - - -/* Corrected an in-line comment relating to finding the */ -/* head node of the conflict resolution list for NAME. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DVPOOL", (ftnlen)6); - } - -/* Initialize the kernel pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Locate the variable name in the hash table. If the variable */ -/* is not present, just return. */ - - -/* Compute the hash value of this name. */ - - lookat = zzhash_(name__, name_len); - -/* Now see if there is a non-empty conflict resolution list for the */ -/* input string NAME. If so, NAMLST(LOOKAT) contains the head node */ -/* of the conflict resolution list; this node is a positive value. */ - - if (namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge("naml" - "st", i__2, "pool_", (ftnlen)7465)] == 0) { - chkout_("DVPOOL", (ftnlen)6); - return 0; - } - -/* If were are still here NAMLST(LOOKAT) is the first node of */ -/* a conflict resolution list. See if the NAME corresponding */ -/* to this node is the one we are looking for. */ - - nameat = namlst[(i__2 = lookat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "namlst", i__2, "pool_", (ftnlen)7476)]; - succes = s_cmp(name__, pnames + (((i__2 = nameat - 1) < 5003 && 0 <= i__2 - ? i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)7477)) << 5), - name_len, (ftnlen)32) == 0; - while(! succes) { - nameat = nmpool[(i__2 = (nameat << 1) + 10) < 10018 && 0 <= i__2 ? - i__2 : s_rnge("nmpool", i__2, "pool_", (ftnlen)7481)]; - if (nameat < 0) { - chkout_("DVPOOL", (ftnlen)6); - return 0; - } - succes = s_cmp(name__, pnames + (((i__2 = nameat - 1) < 5003 && 0 <= - i__2 ? i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)7490)) - << 5), name_len, (ftnlen)32) == 0; - } - -/* Ok, the variable's here. The head node of its value list is */ -/* DATLST(NAMEAT). Delete the list pointing to the associated */ -/* values. This list is in the numeric pool DPPOOL if the head */ -/* node is positive; otherwise the list is in the character pool */ -/* CHPOOL. */ - - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - -/* For consistency with CLPOOL, blank out the PNAMES entry containing */ -/* the name of this variable. This is a bit of a flourish since */ -/* when errors occur during the population of the kernel pool, PNAMES */ -/* is not cleaned out */ - - s_copy(pnames + (((i__2 = nameat - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "pnames", i__2, "pool_", (ftnlen)7511)) << 5), " ", (ftnlen)32, ( - ftnlen)1); - -/* There may be agents watching the variable we just wiped out. If */ -/* so, add these agents to the list of agents to be notified of a */ -/* watched variable update. */ - - if (elemc_(name__, wtvars, name_len, (ftnlen)32)) { - -/* Union the update set AGENTS with the set of agents */ -/* associated with the variable NAME. */ - - zznwpool_(name__, wtvars, wtptrs, wtpool, wtagnt, active, notify, - agents, name_len, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen) - 32, (ftnlen)32); - } - chkout_("DVPOOL", (ftnlen)6); - return 0; -/* $Procedure GNPOOL (Get names of kernel pool variables) */ - -L_gnpool: -/* $ Abstract */ - -/* Return names of kernel variables matching a specified template. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER START */ -/* INTEGER ROOM */ -/* INTEGER N */ -/* CHARACTER*(*) CVALS ( * ) */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Template that names should match. */ -/* START I Index of first matching name to retrieve. */ -/* ROOM I The largest number of values to return. */ -/* N O Number of values returned for NAME. */ -/* CVALS O Kernel pool variables whose names match NAME. */ -/* FOUND O True if there is at least one match. */ - -/* $ Detailed_Input */ - -/* NAME is a MATCHI template which will be used when searching */ -/* for variable names in the kernel pool. The characters */ -/* '*' and '%' are used for the wild string and wild */ -/* characters respectively. For details of string */ -/* pattern matching see the header of the routine MATCHI. */ - - -/* START is the index of the first variable name to return that */ -/* matches the NAME template. The matching names are */ -/* assigned indices ranging from 1 to NVAR, where NVAR is */ -/* the number of matching names. The index of a name does */ -/* not indicate how it compares alphabetically to another */ -/* name. */ - -/* If START is less than 1, it will be treated as 1. If */ -/* START is greater than the total number of matching */ -/* variable names, no values will be returned and N will */ -/* be set to zero. However, FOUND will still be set to */ -/* .TRUE. */ - - -/* ROOM is the maximum number of variable names that should */ -/* be returned for this template. If ROOM is less than 1 */ -/* the error 'SPICE(BADARRAYSIZE)' will be signaled. */ - -/* $ Detailed_Output */ - -/* N is the number of variable names matching NAME that are */ -/* returned. It will always be less than or equal to */ -/* ROOM. */ - -/* If no variable names match NAME, N is set to zero. */ - - -/* CVALS is an array of kernel pool variables whose names match */ -/* the template NAME and which have indices ranging from */ -/* START to START+N-1. */ - -/* Note that in general the names returned in CVALS are */ -/* not sorted. */ - -/* If no variables match NAME, no values are assigned to */ -/* the elements of CVALS. */ - -/* If the length of CVALS is less than the length of the */ -/* variable names, the values returned will be truncated */ -/* on the right. To ensure that names are not truncated, */ -/* CVALS should be declared to be at least */ -/* CHARACTER*(32). */ - - -/* FOUND is TRUE if the some variable name in the kernel pool */ -/* matches NAME, FALSE if it is not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ROOM is less than one the error */ -/* 'SPICE(BADARRAYSIZE)' is signaled. */ - -/* 2) If CVALS has declared length less than the size of a */ -/* name to be returned, the name will be truncated on */ -/* the right. See MAXCHR for the maximum stored size of */ -/* string variables. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the user interface for retrieving the names */ -/* of kernel pool variables. This interface allows you to retrieve */ -/* the names matching a template via multiple accesses. Under some */ -/* circumstances this alleviates the problem of having to know in */ -/* advance the maximum amount of space needed to accommodate all */ -/* matching names. */ - -/* However, this method of access does come with a price. It is */ -/* always more efficient to retrieve all of the data associated with */ -/* a kernel pool variable in one call than it is to retrieve it in */ -/* sections. The parameter MAXVAR defines the upper bound on the */ -/* number of possible matching names. */ - -/* $ Examples */ - - -/* The following code fragment demonstrates how the names of kernel */ -/* pool variables matching a template can be retrieved in pieces. */ - -/* First we need some declarations. */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 3 ) */ - -/* CHARACTER*(3) INDENT */ -/* CHARACTER*(80) CVALS (ROOM) */ -/* CHARACTER*(8) VARNAM */ - -/* INTEGER START */ -/* INTEGER N */ - -/* LOGICAL FOUND */ - - -/* Next load the data in the file 'typical.ker' into the */ -/* kernel pool. */ - -/* CALL LDPOOL ( 'typical.ker' ) */ - -/* Next we shall print the names of kernel variables that match the */ -/* template 'BODY599*'. */ - -/* VARNAM = 'BODY599*' */ -/* INDENT = ' ' */ -/* START = 1 */ - -/* CALL GNPOOL ( VARNAM, START, ROOM, N, CVALS, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* WRITE (*,*) 'There are no matching variables ' // */ -/* . 'in the kernel pool.' */ -/* ELSE */ - -/* WRITE (*,*) 'Kernel pool variables:' */ -/* WRITE (*,*) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, CVALS(I) */ -/* END DO */ - -/* DO WHILE ( N .EQ. ROOM ) */ - -/* START = START + N */ -/* CALL GNPOOL ( VARNAM, START, ROOM, N, CVALS, FOUND ) */ - -/* DO I = 1, N */ -/* WRITE (*,*) INDENT, CVALS(I) */ -/* END DO */ - -/* END DO */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.1.0, 19-MAR-2009 (NJB) */ - -/* ZZPINI call was updated for compatibility */ -/* with new watcher system implementation. */ - -/* - SPICELIB Version 8.0.0, 04-JUN-1999 (WLT) */ - -/* Added the entry points PCPOOL, PDPOOL and PIPOOL to allow */ -/* direct insertion of data into the kernel pool without having */ -/* to read an external file. */ - -/* Added the interface LMPOOL that allows SPICE */ -/* programs to load text kernels directly from memory */ -/* instead of requiring a text file. */ - -/* Added the entry point SZPOOL to return kernel pool definition */ -/* parameters. */ - -/* Added the entry point DVPOOL to allow the removal of a variable */ -/* from the kernel pool. */ - -/* Added the entry point GNPOOL to allow users to determine */ -/* variables that are present in the kernel pool */ - -/* -& */ -/* $ Index_Entries */ - -/* return names of kernel pool variables matching a template */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("GNPOOL", (ftnlen)6); - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Perform the one obvious error check first. */ - - if (*room < 1) { - setmsg_("The amount of room specified as available for output in the" - " output array was: #. The amount of room must be positive. ", - (ftnlen)119); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BADARRAYSIZE)", (ftnlen)19); - chkout_("GNPOOL", (ftnlen)6); - return 0; - } - -/* So far we've encountered no matching names. */ - - hits = 0; - *n = 0; - begin = max(1,*start); - for (k = 1; k <= 5003; ++k) { - -/* See if there is any variable associated with this hash value. */ - - nnode = namlst[(i__2 = k - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "namlst", i__2, "pool_", (ftnlen)7844)]; - while(nnode > 0) { - -/* There is some name list associated with this node. See if */ -/* it the current one matches the supplied template. */ - - if (matchi_(pnames + (((i__2 = nnode - 1) < 5003 && 0 <= i__2 ? - i__2 : s_rnge("pnames", i__2, "pool_", (ftnlen)7851)) << - 5), name__, "*", "%", (ftnlen)32, name_len, (ftnlen)1, ( - ftnlen)1)) { - -/* We've got a match. Record this fact and if we have */ -/* reached (or passed) the starting point, put this name */ -/* on the output list. */ - - ++hits; - if (hits >= *start) { - if (*n < *room) { - ++(*n); - s_copy(cvals + (*n - 1) * cvals_len, pnames + (((i__2 - = nnode - 1) < 5003 && 0 <= i__2 ? i__2 : - s_rnge("pnames", i__2, "pool_", (ftnlen)7864)) - << 5), cvals_len, (ftnlen)32); - } - -/* If we've filled up the buffer, we may as well */ -/* quit now. */ - - if (*n == *room) { - *found = TRUE_; - chkout_("GNPOOL", (ftnlen)6); - return 0; - } - } - } - -/* Get the next name for this node. */ - - nnode = nmpool[(i__2 = (nnode << 1) + 10) < 10018 && 0 <= i__2 ? - i__2 : s_rnge("nmpool", i__2, "pool_", (ftnlen)7883)]; - } - -/* Advance to the next hash value. */ - - } - *found = hits > 0; - chkout_("GNPOOL", (ftnlen)6); - return 0; -/* $Procedure DWPOOL ( Delete watch from kernel pool ) */ - -L_dwpool: -/* $ Abstract */ - -/* Delete a name from the list of agents to notify whenever a member */ -/* of a list of kernel variables is updated. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* CONSTANTS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) AGENT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* AGENT I The name of an agent to be notified after updates. */ - -/* $ Detailed_Input */ - -/* AGENT is any agent name that has previously been associated */ -/* with a kernel pool watch via a call to SWPOOL. The */ -/* agent name will be deleted from the notification list */ -/* of every watched kernel variable. */ - -/* Watched variables whose notification lists become */ -/* empty will be deleted. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) It's not an error to delete an agent that's not in */ -/* any notification list. This policy allows routines */ -/* to delete watches without first having to check that */ -/* the deletion they're requesting is possible. */ - -/* 2) If an attempt is made to delete an agent that */ -/* has an unchecked update, the error SPICE(UPDATEPENDING) */ -/* is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Kernel pool watches are a limited resource; the ability */ -/* to delete watches when they're no longer needed is essential */ -/* to allow programs that make heavy use of kernel pool watches */ -/* to run for extended periods. */ - -/* $ Examples */ - -/* Suppose that you have an application subroutine, MYTASK, that */ -/* needs to access a large data set in the kernel pool. If this */ -/* data could be kept in local storage and kernel pool queries */ -/* performed only when the data in the kernel pool has been */ -/* updated, the routine can perform much more efficiently. */ - -/* If at some point the local stored data no longer need to be */ -/* watched---for example, if they're removed from the local */ -/* buffer to make room for other data---the watch set by the */ -/* agent 'MYTASK' on those data can be deleted via the call */ - -/* CALL DWPOOL ( 'MYTASK' ) */ - -/* $ Restrictions */ - -/* 1) It is recommended that watches be deleted only by */ -/* routines that established them. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete kernel pool watch */ -/* delete agent from kernel pool watch lists */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("DWPOOL", (ftnlen)6); - -/* Initialize the pool if necessary. */ - - zzpini_(&first, &c__5003, &c_b8, &c__4000, begdat, begtxt, nmpool, dppool, - chpool, namlst, datlst, &c__1000, &c__50030, wtvars, wtptrs, - wtpool, wtagnt, agents, active, notify, (ftnlen)10, (ftnlen)10, ( - ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32, (ftnlen)32); - -/* Make sure we're not silencing an agent who has something */ -/* to say. */ - - if (elemc_(agent, agents, agent_len, (ftnlen)32)) { - setmsg_("Could not delete AGENT # from the watch symbol table becaus" - "e AGENT is associated with at least one updated kernel varia" - "ble. ", (ftnlen)124); - errch_("#", agent, (ftnlen)1, agent_len); - sigerr_("SPICE(UPDATEPENDING)", (ftnlen)20); - chkout_("DWPOOL", (ftnlen)6); - return 0; - } - -/* AGENT is no longer on the list of agents associated with a */ -/* kernel variable update. */ - - removc_(agent, agents, agent_len, (ftnlen)32); - -/* For each kernel variable in the watcher's list, remove */ -/* AGENT from its list of guys to be notified when a variable change */ -/* occurs. If AGENT is the only value associated with the variable, */ -/* delete the kernel variable's entry from the table. */ - -/* This outer loop is relatively tricky, since */ - -/* 1) The upper loop bound can change during loop execution. */ - -/* 2) The loop index I doesn't necessary increase on every */ -/* loop pass. */ - -/* Infinite loops can lurk in code with the above attributes. We */ -/* need to know that the loop will always terminate. Presume that */ -/* no SPICE error occurs during the loop: then we observe */ -/* that on each loop pass, either I increases or the loop bound */ -/* CARDC(WTVARS) decreases, so the difference */ - -/* CARDC(WTVARS) - I */ - -/* does in fact decrease on every loop iteration. When this */ -/* difference becomes -1, the loop will end. */ - -/* If a SPICE error occurs during the loop, the FAILED test */ -/* will terminate the loop. */ - -/* Since WTVARS may shrink due to deletion of watches, we */ -/* fetch the cardinality of WTVARS on each loop iteration. */ - - i__ = 1; - while(i__ <= cardc_(wtvars, (ftnlen)32) && ! failed_()) { - -/* Search the list of agents associated with the Ith watched */ -/* variable for AGENT. We want the list count as well, so */ -/* we'll traverse the whole list (which likely is short). */ - -/* We don't use ZZGAPOOL here because we need to get the */ -/* watcher pool nodes associated with AGENT. */ - -/* If we find AGENT, we'll use AGNODE to designate */ -/* the node associated with AGENT. */ - - node = wtptrs[(i__2 = i__ - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "wtptrs", i__2, "pool_", (ftnlen)8126)]; - nnodes = 0; - agnode = 0; - while(node > 0) { - ++nnodes; - -/* Fetch the next agent for the Ith kernel variable. */ - - if (s_cmp(wtagnt + (((i__2 = node - 1) < 50030 && 0 <= i__2 ? - i__2 : s_rnge("wtagnt", i__2, "pool_", (ftnlen)8136)) << - 5), agent, (ftnlen)32, agent_len) == 0) { - -/* Save the current node. */ - - agnode = node; - } - -/* Find the next node in the list. */ - - node = lnknxt_(&node, wtpool); - } - if (agnode > 0) { - -/* The input agent is on the agent list for the Ith watched */ -/* kernel variable. Delete this agent from the list. Delete */ -/* the node corresponding to AGENT from the watch pool. First */ -/* set the corresponding agent name to blank. */ - - s_copy(wtagnt + (((i__2 = agnode - 1) < 50030 && 0 <= i__2 ? i__2 - : s_rnge("wtagnt", i__2, "pool_", (ftnlen)8157)) << 5), - " ", (ftnlen)32, (ftnlen)1); - -/* If we're about to delete the head node of the agent list, */ -/* we'll need to update WTPTRS(I) to point to the new head. */ -/* It's possible that this agent list is empty after deletion */ -/* of AGNODE; we'll handle that case after the LNKFSL call */ -/* below. */ - - if (wtptrs[(i__2 = i__ - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "wtptrs", i__2, "pool_", (ftnlen)8166)] == agnode) { - wtptrs[(i__2 = i__ - 1) < 5003 && 0 <= i__2 ? i__2 : s_rnge( - "wtptrs", i__2, "pool_", (ftnlen)8168)] = lnknxt_(& - agnode, wtpool); - } - -/* Now free AGNODE. */ - - lnkfsl_(&agnode, &agnode, wtpool); - if (nnodes == 1) { - -/* In fact AGENT is the *only* agent for the Ith variable. */ -/* Deleting AGENT means that nobody's watching this */ -/* variable any more, so delete the variable from the */ -/* watched variable set. */ - nw = cardc_(wtvars, (ftnlen)32); - s_copy(varnam, wtvars + (((i__2 = i__ + 5) < 5009 && 0 <= - i__2 ? i__2 : s_rnge("wtvars", i__2, "pool_", (ftnlen) - 8187)) << 5), (ftnlen)32, (ftnlen)32); - removc_(varnam, wtvars, (ftnlen)32, (ftnlen)32); - -/* Remove the associated pointer from the pointer array. */ - - remlai_(&c__1, &i__, wtptrs, &nw); - -/* Since we deleted the current variable table entry and */ -/* compressed the set WTVARS and the array WTPTRS, I now */ -/* points to the next variable in the table. Decrement I */ -/* here to compensate for the increment operation at the */ -/* bottom of the loop. */ - - --i__; - } - -/* We've now deleted AGENT from the AGENT list for WTVARS(I). */ -/* If the deletion left no agents watching WTVARS(I), we */ -/* deleted WTVARS(I) and its associated pointer WTPTRS(I). */ - - } - -/* We've processed the Ith kernel variable in the watcher table. */ - -/* If we deleted the Ith WTVARS entry, we decremented I */ -/* at that time, so the increment operation here always is */ -/* applicable. */ - - ++i__; - -/* At this point in the loop, either I has increased or */ -/* CARDC(WTVARS) has decreased; hence we've made progress */ -/* toward loop termination. */ - - } - chkout_("DWPOOL", (ftnlen)6); - return 0; -/* $Procedure ZZVUPOOL ( Private: view kernel pool watch system ) */ - -L_zzvupool: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Delete a name from the list of agents to notify whenever a member */ -/* of a list of kernel variables is updated. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) UWVARS ( LBCELL : * ) */ -/* INTEGER UWPTRS ( * ) */ -/* INTEGER UWPOOL ( 2, LBCELL : * ) */ -/* CHARACTER*(*) UWAGNT ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UWVARS O Watched kernel variable set. */ -/* UWPTRS O Pointers from variables into the watch pool. */ -/* UWPOOL O Watch pool used for managing agent names. */ -/* UWAGNT O Array of agent names. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* UWVARS is a set into which the local watcher system */ -/* set WTVARS has been copied. */ - -/* UWPTRS is an array into which the local watcher system */ -/* array WTPTRS has been copied. */ - -/* UWPOOL is a doubly linked list pool into which the local */ -/* watcher system doubly linked list pool WTPOOL has */ -/* been copied. */ - -/* UWAGNT is an array into which the local watcher system */ -/* array WTAGNT has been copied. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the output array UWVARS is too small to hold the */ -/* set WTVARS, the error will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* 2) If any output array other than UWVARS is to small */ -/* to hold the corresponding watch system component, */ -/* memory corruption will occur. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is not part of the SPICELIB API. This routine */ -/* may be removed in a later version of the SPICE Toolkit, or */ -/* its interface may change. */ - -/* SPICE-based application code should not call this routine. */ - -/* This is an "inspection hatch" routine used for SPICELIB */ -/* testing. */ - -/* $ Examples */ - -/* See the TSPICE test family F_DWPOOL. */ - -/* $ Restrictions */ - -/* 1) This is a private routine. See $Particulars above. */ - -/* 2) The caller must provide output arrays of adequate */ -/* size. See the declarations of the watch system */ -/* components in the umbrella routine POOL for size */ -/* requirements. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* view kernel pool watcher data structures */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZVUPOOL", (ftnlen)8); - copyc_(wtvars, uwvars, (ftnlen)32, uwvars_len); - i__2 = cardc_(wtvars, (ftnlen)32); - movei_(wtptrs, &i__2, uwptrs); - -/* UWPOOL is expected to have dimensions */ - -/* ( 2, LBPOOL : MXNOTE ) */ - - i__ = 100072; - movei_(wtpool, &i__, uwpool); - movec_(wtagnt, &c__50030, uwagnt, (ftnlen)32, uwagnt_len); - chkout_("ZZVUPOOL", (ftnlen)8); - return 0; -} /* pool_ */ - -/* Subroutine */ int pool_(char *kernel, integer *unit, char *name__, char * - names, integer *nnames, char *agent, integer *n, doublereal *values, - logical *found, logical *update, integer *start, integer *room, char * - cvals, integer *ivals, char *type__, char *uwvars, integer *uwptrs, - integer *uwpool, char *uwagnt, ftnlen kernel_len, ftnlen name_len, - ftnlen names_len, ftnlen agent_len, ftnlen cvals_len, ftnlen type_len, - ftnlen uwvars_len, ftnlen uwagnt_len) -{ - return pool_0_(0, kernel, unit, name__, names, nnames, agent, n, values, - found, update, start, room, cvals, ivals, type__, uwvars, uwptrs, - uwpool, uwagnt, kernel_len, name_len, names_len, agent_len, - cvals_len, type_len, uwvars_len, uwagnt_len); - } - -/* Subroutine */ int clpool_(void) -{ - return pool_0_(1, (char *)0, (integer *)0, (char *)0, (char *)0, (integer - *)0, (char *)0, (integer *)0, (doublereal *)0, (logical *)0, ( - logical *)0, (integer *)0, (integer *)0, (char *)0, (integer *)0, - (char *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int ldpool_(char *kernel, ftnlen kernel_len) -{ - return pool_0_(2, kernel, (integer *)0, (char *)0, (char *)0, (integer *) - 0, (char *)0, (integer *)0, (doublereal *)0, (logical *)0, ( - logical *)0, (integer *)0, (integer *)0, (char *)0, (integer *)0, - (char *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, - kernel_len, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, - (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int rtpool_(char *name__, integer *n, doublereal *values, - logical *found, ftnlen name_len) -{ - return pool_0_(3, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, values, found, (logical *)0, (integer *)0, ( - integer *)0, (char *)0, (integer *)0, (char *)0, (char *)0, ( - integer *)0, (integer *)0, (char *)0, (ftnint)0, name_len, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int expool_(char *name__, logical *found, ftnlen name_len) -{ - return pool_0_(4, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, (integer *)0, (doublereal *)0, found, (logical *)0, - (integer *)0, (integer *)0, (char *)0, (integer *)0, (char *)0, ( - char *)0, (integer *)0, (integer *)0, (char *)0, (ftnint)0, - name_len, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int wrpool_(integer *unit) -{ - return pool_0_(5, (char *)0, unit, (char *)0, (char *)0, (integer *)0, ( - char *)0, (integer *)0, (doublereal *)0, (logical *)0, (logical *) - 0, (integer *)0, (integer *)0, (char *)0, (integer *)0, (char *)0, - (char *)0, (integer *)0, (integer *)0, (char *)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int swpool_(char *agent, integer *nnames, char *names, - ftnlen agent_len, ftnlen names_len) -{ - return pool_0_(6, (char *)0, (integer *)0, (char *)0, names, nnames, - agent, (integer *)0, (doublereal *)0, (logical *)0, (logical *)0, - (integer *)0, (integer *)0, (char *)0, (integer *)0, (char *)0, ( - char *)0, (integer *)0, (integer *)0, (char *)0, (ftnint)0, ( - ftnint)0, names_len, agent_len, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int cvpool_(char *agent, logical *update, ftnlen agent_len) -{ - return pool_0_(7, (char *)0, (integer *)0, (char *)0, (char *)0, (integer - *)0, agent, (integer *)0, (doublereal *)0, (logical *)0, update, ( - integer *)0, (integer *)0, (char *)0, (integer *)0, (char *)0, ( - char *)0, (integer *)0, (integer *)0, (char *)0, (ftnint)0, ( - ftnint)0, (ftnint)0, agent_len, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int gcpool_(char *name__, integer *start, integer *room, - integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen - cvals_len) -{ - return pool_0_(8, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, found, (logical *)0, start, - room, cvals, (integer *)0, (char *)0, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (ftnint)0, name_len, (ftnint)0, (ftnint)0, - cvals_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int gdpool_(char *name__, integer *start, integer *room, - integer *n, doublereal *values, logical *found, ftnlen name_len) -{ - return pool_0_(9, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, values, found, (logical *)0, start, room, (char * - )0, (integer *)0, (char *)0, (char *)0, (integer *)0, (integer *) - 0, (char *)0, (ftnint)0, name_len, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int gipool_(char *name__, integer *start, integer *room, - integer *n, integer *ivals, logical *found, ftnlen name_len) -{ - return pool_0_(10, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, found, (logical *)0, start, - room, (char *)0, ivals, (char *)0, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (ftnint)0, name_len, (ftnint)0, (ftnint)0, - (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dtpool_(char *name__, logical *found, integer *n, char * - type__, ftnlen name_len, ftnlen type_len) -{ - return pool_0_(11, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, found, (logical *)0, (integer *) - 0, (integer *)0, (char *)0, (integer *)0, type__, (char *)0, ( - integer *)0, (integer *)0, (char *)0, (ftnint)0, name_len, ( - ftnint)0, (ftnint)0, (ftnint)0, type_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int pcpool_(char *name__, integer *n, char *cvals, ftnlen - name_len, ftnlen cvals_len) -{ - return pool_0_(12, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, (logical *)0, (logical *)0, ( - integer *)0, (integer *)0, cvals, (integer *)0, (char *)0, (char * - )0, (integer *)0, (integer *)0, (char *)0, (ftnint)0, name_len, ( - ftnint)0, (ftnint)0, cvals_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int pdpool_(char *name__, integer *n, doublereal *values, - ftnlen name_len) -{ - return pool_0_(13, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, values, (logical *)0, (logical *)0, (integer *)0, - (integer *)0, (char *)0, (integer *)0, (char *)0, (char *)0, ( - integer *)0, (integer *)0, (char *)0, (ftnint)0, name_len, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int pipool_(char *name__, integer *n, integer *ivals, ftnlen - name_len) -{ - return pool_0_(14, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, (logical *)0, (logical *)0, ( - integer *)0, (integer *)0, (char *)0, ivals, (char *)0, (char *)0, - (integer *)0, (integer *)0, (char *)0, (ftnint)0, name_len, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int lmpool_(char *cvals, integer *n, ftnlen cvals_len) -{ - return pool_0_(15, (char *)0, (integer *)0, (char *)0, (char *)0, ( - integer *)0, (char *)0, n, (doublereal *)0, (logical *)0, ( - logical *)0, (integer *)0, (integer *)0, cvals, (integer *)0, ( - char *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, cvals_len, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int szpool_(char *name__, integer *n, logical *found, ftnlen - name_len) -{ - return pool_0_(16, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, found, (logical *)0, (integer *) - 0, (integer *)0, (char *)0, (integer *)0, (char *)0, (char *)0, ( - integer *)0, (integer *)0, (char *)0, (ftnint)0, name_len, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dvpool_(char *name__, ftnlen name_len) -{ - return pool_0_(17, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, (integer *)0, (doublereal *)0, (logical *)0, ( - logical *)0, (integer *)0, (integer *)0, (char *)0, (integer *)0, - (char *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, ( - ftnint)0, name_len, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int gnpool_(char *name__, integer *start, integer *room, - integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen - cvals_len) -{ - return pool_0_(18, (char *)0, (integer *)0, name__, (char *)0, (integer *) - 0, (char *)0, n, (doublereal *)0, found, (logical *)0, start, - room, cvals, (integer *)0, (char *)0, (char *)0, (integer *)0, ( - integer *)0, (char *)0, (ftnint)0, name_len, (ftnint)0, (ftnint)0, - cvals_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dwpool_(char *agent, ftnlen agent_len) -{ - return pool_0_(19, (char *)0, (integer *)0, (char *)0, (char *)0, ( - integer *)0, agent, (integer *)0, (doublereal *)0, (logical *)0, ( - logical *)0, (integer *)0, (integer *)0, (char *)0, (integer *)0, - (char *)0, (char *)0, (integer *)0, (integer *)0, (char *)0, ( - ftnint)0, (ftnint)0, (ftnint)0, agent_len, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzvupool_(char *uwvars, integer *uwptrs, integer *uwpool, - char *uwagnt, ftnlen uwvars_len, ftnlen uwagnt_len) -{ - return pool_0_(20, (char *)0, (integer *)0, (char *)0, (char *)0, ( - integer *)0, (char *)0, (integer *)0, (doublereal *)0, (logical *) - 0, (logical *)0, (integer *)0, (integer *)0, (char *)0, (integer * - )0, (char *)0, uwvars, uwptrs, uwpool, uwagnt, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, uwvars_len, - uwagnt_len); - } - diff --git a/ext/spice/src/cspice/pos.c b/ext/spice/src/cspice/pos.c deleted file mode 100644 index 820e1532be..0000000000 --- a/ext/spice/src/cspice/pos.c +++ /dev/null @@ -1,220 +0,0 @@ -/* pos.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure POS ( Position of substring ) */ -integer pos_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen - substr_len) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b; - logical found; - integer lchnce, offset, lenstr; - -/* $ Abstract */ - -/* Find the first occurrence in a string of a substring, starting at */ -/* a specified location, searching forward. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* CHARACTER */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I A character string */ -/* SUBSTR I Substring to locate in the character string. */ -/* START I Where to start looking for SUBSTR in STR. */ - -/* The function returns the index of SUBSTR in STR following START */ - -/* $ Detailed_Input */ - -/* STR is any character string. */ - -/* SUBSTR is a substring to look for in STR. Spaces in */ -/* SUBSTR are significant. */ - -/* START is the position in STR to begin looking for SUBSTR. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the beginning of the first */ -/* substring of STR that begins on or after index START and is equal */ -/* to SUBSTR. If the substring cannot be found after START, the */ -/* function is returns 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If START is less than 1, the search begins at the first */ -/* character of the string. */ - -/* 2) If START is greater than the length of the string, POS */ -/* returns zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* POS is case sensitive. */ - -/* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */ -/* POSR, CPOSR, NCPOSR) is described in the Required Reading. */ - -/* Those familiar with the True BASIC language should note that */ -/* these functions are equivalent to the True BASIC intrinsic */ -/* functions with the same names. */ - -/* $ Examples */ - -/* Let STRING = 'AN ANT AND AN ELEPHANT ' */ -/* 123456789012345678901234567890 */ - -/* Normal (Sequential) Searching: */ -/* ------------------------------ */ - -/* POS ( STRING, 'AN', 1 ) = 1 */ -/* POS ( STRING, 'AN', 3 ) = 4 */ -/* POS ( STRING, 'AN', 6 ) = 8 */ -/* POS ( STRING, 'AN', 10 ) = 12 */ -/* POS ( STRING, 'AN', 14 ) = 20 */ -/* POS ( STRING, 'AN', 22 ) = 0 */ - -/* START out of bounds: */ -/* -------------------- */ - -/* POS ( STRING, 'AN', -5 ) = 1 */ -/* POS ( STRING, 'AN', 0 ) = 1 */ -/* POS ( STRING, 'AN', 31 ) = 0 */ -/* POS ( STRING, 'AN', 44 ) = 0 */ - -/* Significance of Spaces: */ -/* ----------------------- */ - -/* POS ( STRING, 'AN', 1 ) = 1 */ -/* POS ( STRING, ' AN', 1 ) = 3 */ -/* POS ( STRING, ' AN ', 1 ) = 11 */ -/* POS ( STRING, ' AN ', 1 ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */ - -/* The Required Reading file POSITION was renamed to SCANNING. */ -/* This header was updated to reflect the change. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* position of substring */ - -/* -& */ - -/* Local variables */ - - -/* Let's find out how big every body is. */ - - lenstr = i_len(str, str_len); -/* Computing MAX */ - i__1 = 0, i__2 = i_len(substr, substr_len) - 1; - offset = max(i__1,i__2); - lchnce = lenstr - offset; - b = max(1,*start); - -/* Look for the string until we run find it or run out of room to */ -/* look. */ - - found = FALSE_; - ret_val = 0; - while(! found) { - if (b > lchnce) { - return ret_val; - } else if (s_cmp(str + (b - 1), substr, b + offset - (b - 1), - substr_len) == 0) { - ret_val = b; - return ret_val; - } else { - ++b; - } - } - return ret_val; -} /* pos_ */ - diff --git a/ext/spice/src/cspice/pos_c.c b/ext/spice/src/cspice/pos_c.c deleted file mode 100644 index 4b43662723..0000000000 --- a/ext/spice/src/cspice/pos_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure pos_c ( Position of substring ) - --Abstract - - Find the first occurrence in a string of a substring, starting at - a specified location, searching forward. - --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 - - SCANNING - --Keywords - - CHARACTER - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - SpiceInt pos_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I Any character string. - substr I Substring to locate in the character string. - start I Position to begin looking for substr in str. - - The function returns the index of the first occurrence of substr in - str at or following index start. - --Detailed_Input - - str is any character string. - - substr is a substring to look for in str. Spaces in substr are - significant, including trailing blanks. - - start is the position in str to begin looking for substr. start - may range from 0 to n-1, where n is the number of - characters in str. - --Detailed_Output - - The function returns the index of the beginning of the first - substring of str that begins on or after index start and is equal - to substr. If the substring cannot be found after start, the - function is returns -1. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either of - the input string pointers is null. - - 2) If start is less than 0, the search begins at the first - character of the string. - - 3) If start is greater than or equal to the length of the string, - pos_c returns -1. - - 4) The function returns -1 if either of the input strings is empty. - --Files - - None. - --Particulars - - pos_c is case sensitive. - - An entire family of related CSPICE routines - - cpos_c - cposr_c - ncpos_c - ncposr_c - pos_c - posr_c - - is described in the Required Reading. - --Examples - - Let string == "AN ANT AND AN ELEPHANT " - 012345678901234567890123456789 - - Normal (Sequential) Searching: - ------------------------------ - - pos_c ( string, "AN", 0 ) == 0 - pos_c ( string, "AN", 2 ) == 3 - pos_c ( string, "AN", 5 ) == 7 - pos_c ( string, "AN", 9 ) == 11 - pos_c ( string, "AN", 13 ) == 19 - pos_c ( string, "AN", 21 ) == -1 - - start out of bounds: - -------------------- - - pos_c ( string, "AN", -6 ) == 0 - pos_c ( string, "AN", -1 ) == 0 - pos_c ( string, "AN", 30 ) == -1 - pos_c ( string, "AN", 43 ) == -1 - - Significance of Spaces: - ----------------------- - - pos_c ( string, "AN", 0 ) == 0 - pos_c ( string, " AN", 0 ) == 2 - pos_c ( string, " AN ", 0 ) == 10 - pos_c ( string, " AN ", 0 ) == -1 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 15-AUG-2002 (NJB) (WLT) - --Index_Entries - - position of substring - --& -*/ - -{ /* Begin pos_c */ - - - /* - Local variables - */ - SpiceInt fstart; - SpiceInt retval; - - - - /* - Use discovery check-in. - - Check for null pointers. - */ - CHKPTR_VAL ( CHK_DISCOVER, "pos_c", str, -1 ); - CHKPTR_VAL ( CHK_DISCOVER, "pos_c", substr, -1 ); - - - /* - Check for empty strings. - */ - if ( ( strlen(str) == 0 ) || ( strlen(substr) == 0 ) ) - { - return ( -1 ); - } - - - /* - The rest can be handled by the f2c'd SPICELIB routine. Adjust - the start index to account for Fortran indexing. - */ - - fstart = start + 1; - - retval = pos_ ( (char *) str, - (char *) substr, - (integer *) &fstart, - (ftnlen ) strlen(str), - (ftnlen ) strlen(substr) ); - - /* - Adjust the return value to account for C indexing. - */ - return ( retval-1 ); - - -} /* End pos_c */ diff --git a/ext/spice/src/cspice/posr.c b/ext/spice/src/cspice/posr.c deleted file mode 100644 index 89cf00589d..0000000000 --- a/ext/spice/src/cspice/posr.c +++ /dev/null @@ -1,227 +0,0 @@ -/* posr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure POSR ( Position of substring, reverse search) */ -integer posr_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen - substr_len) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b; - logical found; - integer fchnce, offset, lenstr; - -/* $ Abstract */ - -/* Find the first occurrence in a string of a substring, starting at */ -/* a specified location, searching in reverse. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* CHARACTER */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I A character string */ -/* SUBSTR I Substring to locate in the character string. */ -/* START I Where to start looking for SUBSTR in STR. */ - -/* The function returns the index of SUBSTR in STR preceding START */ - -/* $ Detailed_Input */ - -/* STR is any character string. */ - -/* SUBSTR is a substring to look for in STR. Spaces in */ -/* SUBSTR are significant. */ - -/* START is the position in STR to begin looking for SUBSTR. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the beginning of the last */ -/* substring of STR that begins on or before index START and is */ -/* equal to SUBSTR. If the substring cannot be found starting at or */ -/* before START, the function is returns 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If START is less than 1, POSR returns zero. */ - -/* 2) If START is greater than LEN(STRING), the search begins */ -/* at the last character of the string. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* POSR is case sensitive. */ - -/* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */ -/* POSR, CPOSR, NCPOSR) is desribed in the Required Reading. */ - -/* Those familiar with the True BASIC language should note that */ -/* these functions are equivalent to the True BASIC intrinsic */ -/* functions with the same name. */ - -/* $ Examples */ - - -/* Let STRING = 'AN ANT AND AN ELEPHANT ' */ -/* 123456789012345678901234567890 */ - -/* Normal (Sequential) Searching: */ -/* ------------------------------ */ - -/* POSR ( STRING, 'AN', 31 ) = 20 */ -/* POSR ( STRING, 'AN', 19 ) = 12 */ -/* POSR ( STRING, 'AN', 11 ) = 8 */ -/* POSR ( STRING, 'AN', 7 ) = 4 */ -/* POSR ( STRING, 'AN', 3 ) = 1 */ -/* POSR ( STRING, 'AN', 0 ) = 0 */ - -/* START out of bounds: */ -/* -------------------- */ - -/* POSR ( STRING, 'AN', -5 ) = 0 */ -/* POSR ( STRING, 'AN', 0 ) = 0 */ -/* POSR ( STRING, 'AN', 31 ) = 20 */ -/* POSR ( STRING, 'AN', 44 ) = 20 */ - -/* Significance of Spaces: */ -/* ----------------------- */ - -/* POSR ( STRING, 'AN', 31 ) = 20 */ -/* POSR ( STRING, ' AN', 31 ) = 11 */ -/* POSR ( STRING, ' AN ', 31 ) = 11 */ -/* POSR ( STRING, ' AN ', 10 ) = 0 */ -/* POSR ( STRING, ' AN ', 31 ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* K.S. Zukor (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 31-JAN-2008 (BVS) */ - -/* Removed non-standard end-of-declarations marker */ -/* 'C%&END_DECLARATIONS' from comments. */ - -/* - SPICELIB Version 1.0.3, 25-AUG-1994 (HAN) (KSZ) */ - -/* Examples section of the header used POS instead of POSR. */ -/* Also, some examples were incorrect. They have been corrected. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */ - -/* The Required Reading file POSITION was renamed to SCANNING. */ -/* This header was updated to reflect the change. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* position of substring reverse search */ - -/* -& */ - -/* Local variables */ - - -/* Let's find out how big every body is. */ - - lenstr = i_len(str, str_len); -/* Computing MAX */ - i__1 = 0, i__2 = i_len(substr, substr_len) - 1; - offset = max(i__1,i__2); - fchnce = lenstr - offset; - -/* Look for the string until we run find it or run out of room to */ -/* look. */ - - b = min(fchnce,*start); - found = FALSE_; - ret_val = 0; - while(! found) { - if (b <= 0) { - return ret_val; - } else if (s_cmp(str + (b - 1), substr, b + offset - (b - 1), - substr_len) == 0) { - ret_val = b; - return ret_val; - } else { - --b; - } - } - return ret_val; -} /* posr_ */ - diff --git a/ext/spice/src/cspice/posr_c.c b/ext/spice/src/cspice/posr_c.c deleted file mode 100644 index 912511d01f..0000000000 --- a/ext/spice/src/cspice/posr_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure posr_c ( Position of substring, reverse search ) - --Abstract - - Find the first occurrence in a string of a substring, starting at - a specified location, searching backward. - --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 - - SCANNING - --Keywords - - CHARACTER - SEARCH - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - SpiceInt posr_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I Any character string. - substr I Substring to locate in the character string. - start I Position to begin looking for substr in str. - - The function returns the index of the last occurrence of substr in - str at or preceding index start. - --Detailed_Input - - str is any character string. - - substr is a substring to look for in str. Spaces in substr are - significant, including trailing blanks. - - start is the position in str to begin looking for substr. start - may range from 0 to n-1, where n is the number of - characters in str. - --Detailed_Output - - The function returns the index of the beginning of the last - substring of str that begins at or before index start and is equal - to substr. If the substring cannot be found after start, the - function is returns -1. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if either of - the input string pointers is null. - - 2) If start is less than 0, the search begins at the first - character of the string. - - 3) If start is greater than or equal to the length of the string, - posr_c returns -1. - - 4) The function returns -1 if either of the input strings is empty. - --Files - - None. - --Particulars - - posr_c is case sensitive. - - An entire family of related CSPICE routines - - cpos_c - cposr_c - ncpos_c - ncposr_c - pos_c - posr_c - - is described in the Required Reading. - --Examples - - Let string == "AN ANT AND AN ELEPHANT " - 012345678901234567890123456789 - - Normal (Sequential) Searching: - ------------------------------ - - posr_c ( STRING, "AN", 29 ) == 19 - posr_c ( STRING, "AN", 18 ) == 11 - posr_c ( STRING, "AN", 10 ) == 7 - posr_c ( STRING, "AN", 6 ) == 3 - posr_c ( STRING, "AN", 2 ) == 0 - - start out of bounds: - -------------------- - - posr_c ( STRING, "AN", -6 ) == -1 - posr_c ( STRING, "AN", -1 ) == -1 - posr_c ( STRING, "AN", 30 ) == 19 - posr_c ( STRING, "AN", 43 ) == 19 - - Significance of Spaces: - ----------------------- - - posr_c ( STRING, "AN", 29 ) == 19 - posr_c ( STRING, " AN", 29 ) == 10 - posr_c ( STRING, " AN ", 29 ) == 10 - posr_c ( STRING, " AN ", 9 ) == -1 - posr_c ( STRING, " AN ", 29 ) == -1 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 15-AUG-2002 (NJB) (WLT) - --Index_Entries - - position of substring reverse search - --& -*/ - -{ /* Begin posr_c */ - - - /* - Local variables - */ - SpiceInt fstart; - SpiceInt retval; - - - - /* - Use discovery check-in. - - Check for null pointers. - */ - CHKPTR_VAL ( CHK_DISCOVER, "posr_c", str, -1 ); - CHKPTR_VAL ( CHK_DISCOVER, "posr_c", substr, -1 ); - - - /* - Check for empty strings. - */ - if ( ( strlen(str) == 0 ) || ( strlen(substr) == 0 ) ) - { - return ( -1 ); - } - - - /* - The rest can be handled by the f2c'd SPICELIB routine. Adjust - the start index to account for Fortran indexing. - */ - - fstart = start + 1; - - retval = posr_ ( (char *) str, - (char *) substr, - (integer *) &fstart, - (ftnlen ) strlen(str), - (ftnlen ) strlen(substr) ); - - /* - Adjust the return value to account for C indexing. - */ - return ( retval-1 ); - - -} /* End posr_c */ diff --git a/ext/spice/src/cspice/pow_ci.c b/ext/spice/src/cspice/pow_ci.c deleted file mode 100644 index 37e2ce0f2e..0000000000 --- a/ext/spice/src/cspice/pow_ci.c +++ /dev/null @@ -1,20 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -VOID pow_ci(p, a, b) /* p = a**b */ - complex *p, *a; integer *b; -#else -extern void pow_zi(doublecomplex*, doublecomplex*, integer*); -void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */ -#endif -{ -doublecomplex p1, a1; - -a1.r = a->r; -a1.i = a->i; - -pow_zi(&p1, &a1, b); - -p->r = p1.r; -p->i = p1.i; -} diff --git a/ext/spice/src/cspice/pow_dd.c b/ext/spice/src/cspice/pow_dd.c deleted file mode 100644 index d2bb0e39bf..0000000000 --- a/ext/spice/src/cspice/pow_dd.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double pow(); -double pow_dd(ap, bp) doublereal *ap, *bp; -#else -#undef abs -#include "math.h" -double pow_dd(doublereal *ap, doublereal *bp) -#endif -{ -return(pow(*ap, *bp) ); -} diff --git a/ext/spice/src/cspice/pow_di.c b/ext/spice/src/cspice/pow_di.c deleted file mode 100644 index affed625a9..0000000000 --- a/ext/spice/src/cspice/pow_di.c +++ /dev/null @@ -1,35 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double pow_di(ap, bp) doublereal *ap; integer *bp; -#else -double pow_di(doublereal *ap, integer *bp) -#endif -{ -double pow, x; -integer n; -unsigned long u; - -pow = 1; -x = *ap; -n = *bp; - -if(n != 0) - { - if(n < 0) - { - n = -n; - x = 1/x; - } - for(u = n; ; ) - { - if(u & 01) - pow *= x; - if(u >>= 1) - x *= x; - else - break; - } - } -return(pow); -} diff --git a/ext/spice/src/cspice/pow_hh.c b/ext/spice/src/cspice/pow_hh.c deleted file mode 100644 index 24a019734d..0000000000 --- a/ext/spice/src/cspice/pow_hh.c +++ /dev/null @@ -1,33 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -shortint pow_hh(ap, bp) shortint *ap, *bp; -#else -shortint pow_hh(shortint *ap, shortint *bp) -#endif -{ - shortint pow, x, n; - unsigned u; - - x = *ap; - n = *bp; - - if (n <= 0) { - if (n == 0 || x == 1) - return 1; - if (x != -1) - return x == 0 ? 1/x : 0; - n = -n; - } - u = n; - for(pow = 1; ; ) - { - if(u & 01) - pow *= x; - if(u >>= 1) - x *= x; - else - break; - } - return(pow); - } diff --git a/ext/spice/src/cspice/pow_ii.c b/ext/spice/src/cspice/pow_ii.c deleted file mode 100644 index 84d1c7e0b5..0000000000 --- a/ext/spice/src/cspice/pow_ii.c +++ /dev/null @@ -1,33 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -integer pow_ii(ap, bp) integer *ap, *bp; -#else -integer pow_ii(integer *ap, integer *bp) -#endif -{ - integer pow, x, n; - unsigned long u; - - x = *ap; - n = *bp; - - if (n <= 0) { - if (n == 0 || x == 1) - return 1; - if (x != -1) - return x == 0 ? 1/x : 0; - n = -n; - } - u = n; - for(pow = 1; ; ) - { - if(u & 01) - pow *= x; - if(u >>= 1) - x *= x; - else - break; - } - return(pow); - } diff --git a/ext/spice/src/cspice/pow_ri.c b/ext/spice/src/cspice/pow_ri.c deleted file mode 100644 index 6e5816bbf1..0000000000 --- a/ext/spice/src/cspice/pow_ri.c +++ /dev/null @@ -1,35 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double pow_ri(ap, bp) real *ap; integer *bp; -#else -double pow_ri(real *ap, integer *bp) -#endif -{ -double pow, x; -integer n; -unsigned long u; - -pow = 1; -x = *ap; -n = *bp; - -if(n != 0) - { - if(n < 0) - { - n = -n; - x = 1/x; - } - for(u = n; ; ) - { - if(u & 01) - pow *= x; - if(u >>= 1) - x *= x; - else - break; - } - } -return(pow); -} diff --git a/ext/spice/src/cspice/pow_zi.c b/ext/spice/src/cspice/pow_zi.c deleted file mode 100644 index abb3cb2b53..0000000000 --- a/ext/spice/src/cspice/pow_zi.c +++ /dev/null @@ -1,54 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -VOID pow_zi(p, a, b) /* p = a**b */ - doublecomplex *p, *a; integer *b; -#else -extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); -void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ -#endif -{ - integer n; - unsigned long u; - double t; - doublecomplex q, x; - static doublecomplex one = {1.0, 0.0}; - - n = *b; - q.r = 1; - q.i = 0; - - if(n == 0) - goto done; - if(n < 0) - { - n = -n; - z_div(&x, &one, a); - } - else - { - x.r = a->r; - x.i = a->i; - } - - for(u = n; ; ) - { - if(u & 01) - { - t = q.r * x.r - q.i * x.i; - q.i = q.r * x.i + q.i * x.r; - q.r = t; - } - if(u >>= 1) - { - t = x.r * x.r - x.i * x.i; - x.i = 2 * x.r * x.i; - x.r = t; - } - else - break; - } - done: - p->i = q.i; - p->r = q.r; - } diff --git a/ext/spice/src/cspice/pow_zz.c b/ext/spice/src/cspice/pow_zz.c deleted file mode 100644 index 55785dffbe..0000000000 --- a/ext/spice/src/cspice/pow_zz.c +++ /dev/null @@ -1,23 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double log(), exp(), cos(), sin(), atan2(), f__cabs(); -VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; -#else -#undef abs -#include "math.h" -extern double f__cabs(double,double); -void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) -#endif -{ -double logr, logi, x, y; - -logr = log( f__cabs(a->r, a->i) ); -logi = atan2(a->i, a->r); - -x = exp( logr * b->r - logi * b->i ); -y = logr * b->i + logi * b->r; - -r->r = x * cos(y); -r->i = x * sin(y); -} diff --git a/ext/spice/src/cspice/prefix.c b/ext/spice/src/cspice/prefix.c deleted file mode 100644 index 2af88f6b20..0000000000 --- a/ext/spice/src/cspice/prefix.c +++ /dev/null @@ -1,203 +0,0 @@ -/* prefix.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PREFIX (Prefix a character string) */ -/* Subroutine */ int prefix_(char *pref, integer *spaces, char *string, - ftnlen pref_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer plen, slen, shift; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int shiftr_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Add a prefix to a character 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 */ - -/* ASSIGNMENT, CHARACTER, STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PREF I Prefix. */ -/* SPACES I Number of spaces separating prefix and suffix. */ -/* STRING I/O Suffix on input, string on output. */ - -/* $ Detailed_Input */ - -/* PREF is the prefix to be added to the string. Trailing */ -/* blanks are ignored. (A blank prefix is interpreted */ -/* as a null prefix.) */ - -/* SPACES is the number of spaces (blanks) in the output */ -/* string separating the last non-blank character */ -/* of the prefix from the first (blank or non-blank) */ -/* character of the suffix. Typically, this will be */ -/* zero or one. If not positive, SPACES defaults to */ -/* zero. */ - -/* STRING on input is the suffix to which the prefix is to */ -/* be added. Leading blanks are significant. */ - -/* $ Detailed_Output */ - -/* STRING on output is the is the prefixed string. If STRING */ -/* is not large enough to contain the output string, */ -/* the output string is truncated on the right. */ - -/* STRING may NOT overwrite PREF. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The suffix is shifted to the right to make room for the prefix */ -/* and required spaces, which are then added to the front of the */ -/* string. (The shift operation handles any necessary truncation.) */ - -/* $ Examples */ - -/* The following examples illustrate the use of PREFIX. */ - -/* PREF STRING (input) SPACES STRING (output) */ -/* ---------- -------------- ------ --------------- */ -/* 'abc ' 'def ' 0 'abcdef ' */ -/* 'abc ' 'def ' 1 'abc def' */ -/* 'abc ' ' def ' 0 'abc def' */ -/* 'abc ' ' def ' 1 'abc de' */ -/* ' abc ' 'def ' 0 ' abcdef' */ -/* ' abc ' 'def ' 1 ' abc de' */ -/* ' abc ' ' def ' -1 ' abc de' */ -/* ' ' 'def ' 0 'def ' */ -/* ' ' 'def ' 1 ' def ' */ -/* ' abc ' ' ' 0 ' abc ' */ - -/* $ Restrictions */ - -/* PREF and STRING must be distinct. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If SPACES is negative it is treated as zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* prefix a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 28-FEB-1989 (WLT) */ - -/* Reference to SHIFT replaced by SHIFTL. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* L is the location of the last non-blank character in the prefix. */ -/* PLEN is the length of the prefix. Remember that a blank (null) */ -/* prefix has zero length. */ - - plen = lastnb_(pref, pref_len); - -/* SLEN is the allocated length of the string. */ - - slen = i_len(string, string_len); - -/* We can't just do a concatenation, because the input and output */ -/* strings are of indeterminate length. (This would be a violation */ -/* of the ANSI Fortran 77 standard.) Instead, we will shift the */ -/* suffix to the right in order to make room for the prefix and */ -/* the required number of spaces. If part of the string gets */ -/* truncated, well, that's life. */ - - shift = plen + max(*spaces,0); - shiftr_(string, &shift, " ", string, string_len, (ftnlen)1, string_len); - -/* Put the non-blank part of the prefix in the vacated part of */ -/* the string. The spaces will fill themselves in. */ - - if (plen > 0) { - if (shift < slen) { - s_copy(string, pref, shift, pref_len); - } else { - s_copy(string, pref, string_len, pref_len); - } - } - return 0; -} /* prefix_ */ - diff --git a/ext/spice/src/cspice/prodad.c b/ext/spice/src/cspice/prodad.c deleted file mode 100644 index 8640ffd200..0000000000 --- a/ext/spice/src/cspice/prodad.c +++ /dev/null @@ -1,165 +0,0 @@ -/* prodad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PRODAD ( Product of a double precision array ) */ -doublereal prodad_(doublereal *array, integer *n) -{ - /* System generated locals */ - integer i__1; - doublereal ret_val; - - /* Local variables */ - doublereal prod; - integer i__; - -/* $ Abstract */ - -/* Return the product of the elements of a double precision array. */ - -/* $ 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 */ - -/* ARRAY, MATH, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* N I Number of elements in ARRAY. */ -/* PRODAD O Product of the elements of ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* N is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* PRODAD is the product of the elements of the input array. */ -/* That is, */ - -/* PRODAD = ARRAY(1) * ARRAY(2) * ... * ARRAY(N) */ - -/* If N is zero or negative, PRODAD is one. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The value of the function is initially set to one. The elements */ -/* of the array are then multiplied. If the number of elements is */ -/* zero or negative, PRODAD is one. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* ARRAY(1) = 12.D0 */ -/* ARRAY(2) = 2.D0 */ -/* ARRAY(3) = 4.D0 */ -/* ARRAY(4) = 75.D0 */ -/* ARRAY(5) = 18.D0 */ - -/* Then */ - -/* PRODAD ( ARRAY, -3 ) = 1.D0 */ -/* PRODAD ( ARRAY, 0 ) = 1.D0 */ -/* PRODAD ( ARRAY, 1 ) = 12.D0 */ -/* PRODAD ( ARRAY, 2 ) = 24.D0 */ -/* PRODAD ( ARRAY, 5 ) = 129600.D0 */ -/* PRODAD ( ARRAY(3), 3 ) = 5400.D0 */ - - -/* $ Restrictions */ - -/* PRODAD does not check for overflow. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* product of a d.p. array */ - -/* -& */ - -/* Local variables */ - - -/* Begin at one. */ - - prod = 1.; - -/* Multiply the elements. If N is zero or negative, nothing happens. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - prod *= array[i__ - 1]; - } - -/* Return the product. */ - - ret_val = prod; - return ret_val; -} /* prodad_ */ - diff --git a/ext/spice/src/cspice/prodai.c b/ext/spice/src/cspice/prodai.c deleted file mode 100644 index 69676dabaa..0000000000 --- a/ext/spice/src/cspice/prodai.c +++ /dev/null @@ -1,164 +0,0 @@ -/* prodai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PRODAI ( Product of an integer array ) */ -integer prodai_(integer *array, integer *n) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer prod, i__; - -/* $ Abstract */ - -/* Return the product of the elements of an integer array. */ - -/* $ 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 */ - -/* ARRAY, MATH, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* N I Number of elements in ARRAY. */ -/* PRODAI O Product of the elements of ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* N is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* PRODAI is the product of the elements of the input array. */ -/* That is, */ - -/* PRODAI = ARRAY(1) * ARRAY(2) * ... * ARRAY(N) */ - -/* If N is zero or negative, PRODAI is one. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The value of the function is initially set to one. The elements */ -/* of the array are then multiplied. If the number of elements is */ -/* zero or negative, PRODAI is one. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* ARRAY(1) = 12 */ -/* ARRAY(2) = 2 */ -/* ARRAY(3) = 4 */ -/* ARRAY(4) = 75 */ -/* ARRAY(5) = 18 */ - -/* Then */ - -/* PRODAI ( ARRAY, -3 ) = 1 */ -/* PRODAI ( ARRAY, 0 ) = 1 */ -/* PRODAI ( ARRAY, 1 ) = 12 */ -/* PRODAI ( ARRAY, 2 ) = 24 */ -/* PRODAI ( ARRAY, 5 ) = 129600 */ -/* PRODAI ( ARRAY(3), 3 ) = 5400 */ - - -/* $ Restrictions */ - -/* PRODAI does not check for overflow. (For integers, this can */ -/* occur relatively quickly.) */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* product of an integer array */ - -/* -& */ - -/* Local variables */ - - -/* Begin at one. */ - - prod = 1; - -/* Multiply the elements. If N is zero or negative, nothing happens. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - prod *= array[i__ - 1]; - } - -/* Return the product. */ - - ret_val = prod; - return ret_val; -} /* prodai_ */ - diff --git a/ext/spice/src/cspice/prompt.c b/ext/spice/src/cspice/prompt.c deleted file mode 100644 index bd7c727cdc..0000000000 --- a/ext/spice/src/cspice/prompt.c +++ /dev/null @@ -1,397 +0,0 @@ -/* prompt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure PROMPT ( Prompt a user for a string ) */ -/* Subroutine */ int prompt_(char *prmpt, char *string, ftnlen prmpt_len, - ftnlen string_len) -{ - /* System generated locals */ - integer i__1, i__2; - cilist ci__1; - - /* Builtin functions */ - integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void), - s_rsfe(cilist *), e_rsfe(void), i_len(char *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - , setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* This routine prompts a user for keyboard input. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PRMPT I The prompt to use when asking for input. */ -/* STRING O The response typed by a user. */ - -/* $ Detailed_Input */ - -/* PRMPT is a character string that will be displayed from the */ -/* current cursor position and describes the input that */ -/* the user is expected to enter. The string PRMPT should */ -/* be relatively short, i.e., 50 or fewer characters, so */ -/* that a response may be typed on the line where the */ -/* prompt appears. */ - -/* All characters (including trailing blanks) in PRMPT */ -/* are considered significant and will be displayed. */ - -/* $ Detailed_Output */ - -/* STRING is a character string that contains the string */ -/* entered by the user. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This subroutine uses discovery check-in so that it may be called */ -/* after an error has occurred. */ - -/* 1) If the attempt to write the prompt to the standard output */ -/* device fails, returning an IOSTAT value not equal to zero, the */ -/* error SPICE(WRITEFAILED) will be signalled. */ - -/* 2) If the attempt to read the response from the standard input */ -/* device fails, returning an IOSTAT value not equal to zero, the */ -/* error SPICE(READFAILED) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility that allows you to "easily" request information */ -/* from a program user. At a high level, it frees you from the */ -/* peculiarities of a particular implementation of FORTRAN cursor */ -/* control. */ - -/* $ Examples */ - -/* Suppose you wanted to ask a user to input an answer to */ -/* a question such as "Do you want to try again? (Y/N) " */ -/* and leave the cursor at the end of the question as shown here: */ - -/* Do you want to try again? (Y/N) _ */ - -/* (The underscore indicates the cursor position). */ - -/* The following line of code will do what you want. */ - -/* CALL PROMPT ( 'Do you want to try again? (Y/N) ', ANSWER ) */ - -/* $ Restrictions */ - -/* This routine is environment specific. Standard FORTRAN does not */ -/* provide for user control of cursor position after write */ -/* statements. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 3.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 3.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 3.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 3.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 3.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 3.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 3.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 3.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 3.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 3.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 3.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 3.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 3.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 3.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 3.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 3.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 20-JUL-1995 (WLT) (KRG) */ - -/* This routine now participates in error handling. It */ -/* checks to make sure no I/O errors have occurred while */ -/* attempting to write to standard output or read from standard */ -/* input. It uses discovery checkin if an error is detected. */ - -/* Restructured the subroutine a little bit; the writing of the */ -/* prompt is the only bit that is environment specific, so the */ -/* code was rearranged to reflect this. There is now only a single */ -/* READ statement. */ - -/* - SPICELIB Version 1.0.0, 15-OCT-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Prompt for keyboard input */ -/* Prompt for input with a user supplied message */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 20-JUL-1995 (WLT) (KRG) */ - -/* This routine now participates in error handling. It */ -/* checks to make sure no I/O errors have occurred while */ -/* attempting to write to standard output or read from standard */ -/* input. It uses discovery checkin if an error is detected. */ - -/* Restructured the subroutine a little bit; the writing of the */ -/* prompt is the only bit that is environment specific, so the */ -/* code was rearranged to reflect this. There is now only a single */ -/* READ statement. */ - -/* -& */ - -/* Local variables */ - - - - -/* The code below should be used in the following environments: */ - -/* SUN/Fortran, */ -/* HP/HP-Fortran, */ -/* Silicon Graphics/Silicon Graphics Fortran, */ -/* DEC Alpha-OSF/1--DEC Fortran, */ -/* NeXT/Absoft Fortran */ -/* PC Linux/Fort77 */ - - ci__1.cierr = 1; - ci__1.ciunit = 6; - ci__1.cifmt = "(A,$)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, prmpt, prmpt_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - -/* If none of the write statements above works on a particular */ -/* unsupported platform, read on... */ - -/* Although, this isn't really what you want, if you need to port */ -/* this quickly to an environment that does not support the format */ -/* statement in any of the cases above, you can comment out the */ -/* write statement above and un-comment the write statement below. */ -/* In this way you can get a program working quickly in the new */ -/* environment while you figure out how to control cursor */ -/* positioning. */ - -/* WRITE (*,*, IOSTAT=IOSTAT ) PRMPT */ - -/* Check for a write error. It's not likely, but the standard output */ -/* can be redirected. Better safe than confused later. */ - - if (iostat != 0) { - chkin_("PROMPT", (ftnlen)6); - setmsg_("An error occurred while attempting to write a prompt to the" - " standard output device, possibly because standard output ha" - "s been redirected to a file. There is not much that can be d" - "one about this if it happens. We do not try to determine whe" - "ther standard output has been redirected, so be sure that th" - "ere are sufficient resources available for the operation bei" - "ng performed.", (ftnlen)372); - sigerr_("SPICE(WRITEFAILED)", (ftnlen)18); - chkout_("PROMPT", (ftnlen)6); - return 0; - } - -/* Now that we've written out the prompt and there was no error, we */ -/* can read in the response. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = 5; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, string, string_len); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - if (iostat != 0) { - chkin_("PROMPT", (ftnlen)6); - setmsg_("An error occurred while attempting to retrieve a reply to t" - "he prompt \"#\". A possible cause is that you have exhauste" - "d the input buffer while attempting to type your response. " - "It may help if you limit your response to # or fewer charact" - "ers. ", (ftnlen)242); - errch_("#", prmpt, (ftnlen)1, prmpt_len); -/* Computing MIN */ - i__2 = i_len(string, string_len); - i__1 = min(i__2,131); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(READFAILED)", (ftnlen)17); - chkout_("PROMPT", (ftnlen)6); - return 0; - } - return 0; -} /* prompt_ */ - diff --git a/ext/spice/src/cspice/prompt_c.c b/ext/spice/src/cspice/prompt_c.c deleted file mode 100644 index d1279615e7..0000000000 --- a/ext/spice/src/cspice/prompt_c.c +++ /dev/null @@ -1,285 +0,0 @@ -/* - --Procedure prompt_c ( Prompt a user for a string ) - --Abstract - - This function prompts a user for keyboard input. - --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 - - UTILITY - -*/ - - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - SpiceChar * prompt_c ( ConstSpiceChar * prmptStr, - SpiceInt lenout, - SpiceChar * buffer ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - prmptStr I The prompt string to display when asking for input. - lenout I Minimum number of characters for response plus one. - buffer O The string containing the response typed by a user. - - The routine also returns a pointer to the output buffer. - --Detailed_Input - - prmptStr A character string displayed from the current cursor - position which describes the requested input. The prompt - string should be relatively short, i.e., 50 or fewer - characters, so a response may be typed on the line where - the prompt appears. - - All characters (including trailing blanks) in prmptStr - are considered significant and will be displayed. - - lenout The integer number of characters plus one for the - response string. - --Detailed_Output - - buffer The user supplied string which holds the response. The - string's memory is allocated in the calling routine. - - The routine returns a pointer to buffer as well as passing the - pointer back via an argument. - --Parameters - - None. - --Exceptions - - 1) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled and a null pointer is returned. - --Files - - None. - --Particulars - - This is a utility that allows you to "easily" request information - from a program user. The calling program declares an array or - allocate memory to contain the user's response to the prompt. - --Examples - - Suppose you have an interactive program that computes state - vectors by calling spkezr_c. The program prompts the user for - the inputs to spkezr_c. After each prompt is written, the program - leaves the cursor at the end of the string as shown here: - - Enter UTC epoch > _ - - (The underscore indicates the cursor position). - - The following program illustrates the aquisition of input - values using prompt_c: - - #include - #include - - #include "SpiceUsr.h" - - #define STRLEN 32 - - void main() - { - SpiceChar utc [STRLEN]; - SpiceChar obs [STRLEN]; - SpiceChar targ [STRLEN]; - SpiceChar * utc1; - SpiceChar * obs1; - SpiceChar * targ1; - - - /. Call the routine as a subroutine. ./ - - prompt_c ( "Enter UTC epoch > ", STRLEN, utc ); - prompt_c ( "Enter observer name > ", STRLEN, obs ); - prompt_c ( "Enter target name > ", STRLEN, targ ); - - - /. Or call the routine as a function. ./ - - utc1 = ( SpiceChar * ) malloc (STRLEN); - obs1 = ( SpiceChar * ) malloc (STRLEN); - targ1 = ( SpiceChar * ) malloc (STRLEN); - - - utc1 = prompt_c ( "Enter UTC epoch > ", STRLEN, utc1 ); - obs1 = prompt_c ( "Enter observer name > ", STRLEN, obs1 ); - targ1= prompt_c ( "Enter target name > ", STRLEN, targ1); - - - /. - Now do stuff with your strings. - ./ - - ... - - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 25-JUN-1999 (EDW) (NJB) - --Index_Entries - - Prompt for keyboard input - Prompt for input with a user supplied message - --& -*/ - -{ /* Begin prompt_c */ - - /* - Local variables - */ - SpiceChar c; - SpiceInt i; - - - /* - Participate in error tracing. - */ - chkin_c ( "prompt_c" ); - - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR_VAL ( CHK_STANDARD, "prompt_c", buffer, lenout, NULLCPTR ); - - - /* - Initialize i to zero. - */ - i = 0; - - - /* - Display the prompt string. - */ - printf ( "%s", prmptStr ); - - - /* - Get input from stdin, check for an end of line terminator. - The loop continues until the terminator is found. - */ - - c = getchar(); - - while ( ( c != (char)'\n') ) - { - - /* - We have room for lenout characters, the last of which will - be a null terminator. Slurp only (lenout - 1) characters - from the input into buffer. Ignore anything afterwards. - */ - if ( i < (lenout - 1 ) ) - { - - /* - Read in no more than lenout - 1 chracters. - */ - buffer[i] = c; - i++; - - } - - /* - Get the next character from the input line. - */ - c = getchar(); - - } - - - /* - Null terminate the current buffer. The counter i points to the - first free location in the buffer. - */ - buffer[i] = NULLCHAR; - - - /* - Done. Checkout. - */ - chkout_c ( "prompt_c"); - - - /* - Return the buffer so the user may elect to use the function call - capability. - */ - - return buffer; - - -} /* End prompt_c */ - diff --git a/ext/spice/src/cspice/prop2b.c b/ext/spice/src/cspice/prop2b.c deleted file mode 100644 index bd79691311..0000000000 --- a/ext/spice/src/cspice/prop2b.c +++ /dev/null @@ -1,1076 +0,0 @@ -/* prop2b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__6 = 6; - -/* $Procedure PROP2B ( Propagate a two-body solution ) */ -/* Subroutine */ int prop2b_(doublereal *gm, doublereal *pvinit, doublereal * - dt, doublereal *pvprop) -{ - /* Initialized data */ - - static integer nsaved = 0; - static integer newest[3] = { 1,2,3 }; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - doublereal d__1, d__2, d__3, d__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double sqrt(doublereal), log(doublereal), exp(doublereal); - - /* Local variables */ - static doublereal hvec[3], logf, maxc, kfun, oldx; - extern doublereal vdot_(doublereal *, doublereal *); - static doublereal sb2rv[3], b, e, f, qovr0; - static integer i__, k; - static doublereal q, x; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static doublereal fixed, eqvec[3], bound; - extern doublereal dpmax_(void); - static doublereal pcdot; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - static doublereal kfunl, vcdot; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - static doublereal c0, c1, c2, c3; - static integer mostc; - static doublereal kfunu, lower, h2, upper, rootf; - extern /* Subroutine */ int stmp03_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *), vequg_(doublereal *, - integer *, doublereal *), vcrss_(doublereal *, doublereal *, - doublereal *); - extern doublereal vnorm_(doublereal *); - static doublereal r0; - extern logical vzero_(doublereal *); - static doublereal x2, x3, bq, br, pc, vc, sf[3], sqovr0[3], logbnd, rv; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - static integer bumped; - extern integer brckti_(integer *, integer *, integer *); - static doublereal savegm[3], logdpm, logmxc, sbound[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - static doublereal tmpvec[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static doublereal br0, savepv[18] /* was [6][3] */; - static integer lcount; - extern logical return_(void); - static doublereal fx2, sbq[3], vel[3]; - static logical new__; - static doublereal pos[3], sbr0[3], b2rv; - -/* $ Abstract */ - -/* Given a central mass and the state of massless body at time t_0, */ -/* this routine determines the state as predicted by a two-body */ -/* force model at time t_0 + DT. */ - -/* $ 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 */ - -/* CONIC */ -/* EPHEMERIS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* GM I Gravity of the central mass. */ -/* PVINIT I Initial state from which to propagate a state. */ -/* DT I Time offset from initial state to propagate to. */ -/* PVPROP O The propagated state. */ - -/* $ Detailed_Input */ - -/* GM is the gravitational constant G times the mass M of the */ -/* central body. */ - -/* PVINIT is the state at some specified time relative to the */ -/* central mass. The mass of the object is assumed to */ -/* be negligible when compared to the central mass. */ - -/* DT is a offset in time from the time of the initial */ -/* state to which the two-body state should be */ -/* propagated. (The units of time and distance must be */ -/* the same in GM, PVINIT, and DT). */ - -/* $ Detailed_Output */ - -/* PVPROP is the two-body propagation of the initial state */ -/* DT units of time past the epoch of the initial state. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If GM is not positive, the error SPICE(NONPOSITIVEMASS) will */ -/* be signalled. */ - -/* 2) If the position of the initial state is the zero vector, the */ -/* error SPICE(ZEROPOSITION) will be signalled. */ - -/* 3) If the velocity of the initial state is the zero vector, the */ -/* error SPICE(ZEROVELOCITY) will be signalled. */ - -/* 4) If the cross product of the position and velocity of PVINIT */ -/* has squared length of zero, the error SPICE(NONCONICMOTION) */ -/* will be signalled. */ - -/* 5) The value of DT must be "reasonable". In other words, DT */ -/* should be less than 10**20 seconds for realistic solar system */ -/* orbits specified in the MKS system. (The actual bounds */ -/* on DT are much greater but require substantial computation.) */ -/* The "reasonableness" of DT is checked at run-time. If DT is */ -/* so large that there is a danger of floating point overflow */ -/* during computation, the error SPICE(DTOUTOFRANGE) is */ -/* signalled and a message is generated describing the problem. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine uses a universal variables formulation for the */ -/* two-body motion of an object in orbit about a central mass. It */ -/* propagates an initial state to an epoch offset from the */ -/* epoch of the initial state by time DT. */ - -/* This routine does not suffer from the finite precision */ -/* problems of the machine that are inherent to classical */ -/* formulations based on the solutions to Kepler's equation: */ - -/* n( t - T ) = E - e Sin(E) elliptic case */ -/* n( t - T ) = e sinh(F) - F hyperbolic case */ - -/* The derivation used to determine the propagated state is a */ -/* slight variation of the derivation in Danby's book */ -/* `Fundamentals of Celestial Mechanics' [1] . */ - -/* $ Examples */ - -/* When the eccentricity of an orbit is near 1, and the epoch */ -/* of classical elements is near the epoch of periapse, classical */ -/* formulations that propagate a state from elements tend to */ -/* lack robustness due to the finite precision of floating point */ -/* machines. In those situations it is better to use a universal */ -/* variables formulation to propagate the state. */ - -/* By using this routine, you need not go from a state to elements */ -/* and back to a state. Instead, you can get the state from an */ -/* initial state. */ - -/* If PV is your initial state and you want the state 3600 */ -/* seconds later, the following call will suffice. */ - -/* Look up GM somewhere */ - -/* DT = 3600.0D0 */ - -/* CALL PROP2B ( GM, PV, DT, PVDT ) */ - -/* After the call, PVDT will contain the state of the */ -/* object 3600 seconds after the time it had state PV. */ - -/* $ Restrictions */ - -/* Users should be sure that GM, PVINIT and DT are all in the */ -/* same system of units ( for example MKS ). */ - -/* $ Literature_References */ - -/* [1] `Fundamentals of Celestial Mechanics', Second Edition */ -/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */ -/* Richmond Virginia; pp 168-180 */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - Spicelib Version 2.0.0 16-May-1995 (WLT) */ - -/* The initial guess at a solution to Kepler's equation was */ -/* modified slightly and a loop counter was added to the */ -/* bisection loop together with logic that will force termination */ -/* of the bisection loop. */ - -/* - Spicelib Version 1.0.0, 10-Mar-1992 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Propagate state vector using two-body force model */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* The following quantities are needed in the solution of Kepler's */ -/* equation and in the propagation of the input state. They are */ -/* described as they are introduced in the code below. */ - - -/* The variables below store intermediate results that can be */ -/* reused if PVINIT is supplied more than once to this routine. */ -/* In this way, the number of redundant computations can be reduced. */ - - -/* Variables used to bracket X in our solution of Kepler's equation. */ - - -/* Save everything. */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PROP2B", (ftnlen)6); - } - -/* Life will be easier if we use POS and VEL to hold the state. */ - - pos[0] = pvinit[0]; - pos[1] = pvinit[1]; - pos[2] = pvinit[2]; - vel[0] = pvinit[3]; - vel[1] = pvinit[4]; - vel[2] = pvinit[5]; - -/* If we propagate many states from the same initial state, */ -/* most of the variables used to propagate the state will */ -/* not change in value. */ - -/* To save time needed to compute these variables, we recompute */ -/* variables that depend upon the initial state only when the */ -/* initial state is not one of those already buffered by this */ -/* routine. */ - -/* Determine whether or not this GM and state are the same as the */ -/* one of those already buffered. Note that we look through the */ -/* saved states and GM from the most recently input values of PVINIT */ -/* and GM to the oldest saved state and GM. */ - -/* NEWEST(1) contains the most recently input initial conditions */ -/* NEWEST(2) contains the next most recently input intial conditions */ -/* etc. */ - -/* Also note that when this routine starts up there will be no */ -/* buffered states or GMs. Every time we encounter a new state, we */ -/* will increment the number of saved states NSAVED until we have */ -/* BUFSIZ states buffered. From that point on, when a new state is */ -/* encountered we will overwrite the oldest buffered state. */ - - i__ = 0; - new__ = TRUE_; - while(i__ < nsaved && new__) { - ++i__; - k = newest[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("newest", - i__1, "prop2b_", (ftnlen)375)]; - new__ = pvinit[0] != savepv[(i__1 = k * 6 - 6) < 18 && 0 <= i__1 ? - i__1 : s_rnge("savepv", i__1, "prop2b_", (ftnlen)377)] || - pvinit[1] != savepv[(i__2 = k * 6 - 5) < 18 && 0 <= i__2 ? - i__2 : s_rnge("savepv", i__2, "prop2b_", (ftnlen)377)] || - pvinit[2] != savepv[(i__3 = k * 6 - 4) < 18 && 0 <= i__3 ? - i__3 : s_rnge("savepv", i__3, "prop2b_", (ftnlen)377)] || - pvinit[3] != savepv[(i__4 = k * 6 - 3) < 18 && 0 <= i__4 ? - i__4 : s_rnge("savepv", i__4, "prop2b_", (ftnlen)377)] || - pvinit[4] != savepv[(i__5 = k * 6 - 2) < 18 && 0 <= i__5 ? - i__5 : s_rnge("savepv", i__5, "prop2b_", (ftnlen)377)] || - pvinit[5] != savepv[(i__6 = k * 6 - 1) < 18 && 0 <= i__6 ? - i__6 : s_rnge("savepv", i__6, "prop2b_", (ftnlen)377)] || *gm - != savegm[(i__7 = k - 1) < 3 && 0 <= i__7 ? i__7 : s_rnge( - "savegm", i__7, "prop2b_", (ftnlen)377)]; - } - if (! new__) { - -/* We update the order vector NEWEST so that the state being */ -/* used this time becomes the "youngest" state. */ - - k = i__; - bumped = newest[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("new" - "est", i__1, "prop2b_", (ftnlen)394)]; - for (i__ = k; i__ >= 2; --i__) { - newest[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("newest", - i__1, "prop2b_", (ftnlen)397)] = newest[(i__2 = i__ - 2) - < 3 && 0 <= i__2 ? i__2 : s_rnge("newest", i__2, "prop2b_" - , (ftnlen)397)]; - } - newest[0] = bumped; - k = bumped; - -/* Now look up all of the other saved quantities. */ - - b2rv = sb2rv[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sb2rv", - i__1, "prop2b_", (ftnlen)406)]; - bound = sbound[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sbou" - "nd", i__1, "prop2b_", (ftnlen)407)]; - bq = sbq[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sbq", i__1, - "prop2b_", (ftnlen)408)]; - br0 = sbr0[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sbr0", - i__1, "prop2b_", (ftnlen)409)]; - f = sf[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sf", i__1, - "prop2b_", (ftnlen)410)]; - qovr0 = sqovr0[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sqov" - "r0", i__1, "prop2b_", (ftnlen)411)]; - } else { - -/* We have a new state, new GM or both. First let's make sure */ -/* there is nothing obviously wrong with them. (We buffer */ -/* only states, GMs and intermediate values that are "good.") */ -/* First check for nonpositive mass. */ - - if (*gm <= 0.) { - sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - -/* Next for a zero position vector */ - - if (vzero_(pos)) { - sigerr_("SPICE(ZEROPOSITION)", (ftnlen)19); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - -/* Finally for a zero velocity vector */ - - if (vzero_(vel)) { - sigerr_("SPICE(ZEROVELOCITY)", (ftnlen)19); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - -/* Obvious problems have been checked. Here are the relevant */ -/* equations. Let ... */ - -/* GM be the gravitational attraction of the central */ -/* mass. */ - -/* POS and be the initial position and velocity respectively */ -/* VEL of the orbiting object. */ - -/* R0 be the magnitude of the position vector POS */ - -/* RV be the value of the dot product POS * VEL */ - - r0 = vnorm_(pos); - rv = vdot_(pos, vel); - -/* Let HVEC be the specific angular momentum vector and let Q be */ -/* the distance at periapse. */ - -/* 1) HVEC = POS x VEL */ - -/* 2 */ -/* 2) H2 = |HVEC| = GM*(1+E)*Q */ - - - vcrss_(pos, vel, hvec); - h2 = vdot_(hvec, hvec); - -/* Let's make sure we are not in the pathological case of */ -/* rectilinear motion. */ - - if (h2 == 0.) { - sigerr_("SPICE(NONCONICMOTION)", (ftnlen)21); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - -/* Let E be the eccentricity of the orbit. */ - -/* Let QVEC be the unit vector that points toward perihelion, and */ -/* let EQVEC be QVEC scaled by E. */ - -/* VEL X HVEC POS */ -/* 1) E*QVEC = ---------- - --- */ -/* GM R0 */ - - -/* VEL X HVEC POS */ -/* 2) E = NORM ( ---------- - --- ) */ -/* GM R0 */ - - - vcrss_(vel, hvec, tmpvec); - d__1 = 1. / *gm; - d__2 = -1. / r0; - vlcom_(&d__1, tmpvec, &d__2, pos, eqvec); - e = vnorm_(eqvec); - -/* Solve the equation H2 = GM*Q*(1+E) for Q. */ - - q = h2 / (*gm * (e + 1)); - -/* From the discussion of the universal variables formulation in */ -/* Danby's book on pages 174 and 175 (see the reference listed */ -/* above) you can show that by making the substitutions */ - -/* F = 1 - E */ - -/* and */ - -/* _____ */ -/* / Q */ -/* S = / ----- X = B * X */ -/* \/ GM */ - - -/* that DT satisfies the universal variables Kepler's equation: */ - -/* 2 2 2 2 */ -/* DT = B*R0*X*C_1( F*X ) + B *RV*X C_2( F*X ) */ - -/* 3 2 */ -/* + B*Q*X C_3( F*X ) */ - -/* = KFUN( X ) */ - -/* (where C_k is used to denote the Stumpff functions. This is */ -/* the universal variables formulation of Kepler's equation. */ -/* KFUN is our abbreviation for "Kepler function.") */ - -/* (One might wonder, "Why make such a change of variables?" */ -/* By making this substitution early in the derivation supplied */ -/* in Danby's book, you can always deal with physically */ -/* meaningful quantities --- the pure numeric value of F and the */ -/* distance of periapse. Thus one does not need to be concerned */ -/* about infinite or negative semi-major axes or with discussing */ -/* how to interpret these somewhat artificial artifacts of the */ -/* classical derivations for two body motion.) */ - -/* Given the unique X for which this Kepler's equation is */ -/* satisfied, we can compute the state of the orbiting object */ -/* at a time DT past the epoch of the state POS and VEL. */ -/* Evidently we will need the constants: */ - - f = 1. - e; - b = sqrt(q / *gm); - br0 = b * r0; - b2rv = b * b * rv; - bq = b * q; - -/* The state corresponding to the value of X that solves this */ -/* equation is given by */ - -/* PC * POS + VC * VEL ( position ) */ - -/* and */ - -/* PCDOT * POS + VCDOT * VEL ( velocity ) */ - -/* where */ -/* 2 2 */ -/* ( 1 ) PC = 1 - ( Q/R0 )X C_2( F*X ) */ - -/* 3 2 */ -/* ( 2 ) VC = DT - ( B*Q )X C_3( F*X ) */ - - -/* Q 2 */ -/* ( 3 ) PCDOT = - ( ------ ) X C_1( F*X ) */ -/* B*R*R0 */ - -/* B*Q 2 2 */ -/* ( 4 ) VCDOT = 1 - ( --- ) X C_2( F*X ) */ -/* B*R */ - -/* Here R denotes the distance from the center of CP*POS + CV*VEL */ -/* It turns out that R can be computed as: */ - -/* 2 2 2 */ -/* ( 5 ) B*R = B*R0 C_0(F*X ) + B *RV X C_1(F*X ) */ - -/* 2 2 */ -/* + B*Q X C_2(F*X ) */ - - -/* Therefore we will also need the constant */ - - qovr0 = q / r0; - -/* We will have to find the unique value of X such that */ - -/* DT = KFUN ( X ) */ - -/* where KFUN stands for the "Kepler function" defined by the */ -/* equation below: */ - -/* 2 */ -/* KFUN(X) = B*R0*X * C_1(FX ) */ - -/* 2 2 2 */ -/* + B *RV*X * C_2(FX ) */ - -/* 3 2 */ -/* + B*Q*X * C_3(FX ) */ - - -/* (There is a unique solution to this equation. KFUN(X) is */ -/* unbounded above and below and is an increasing function */ -/* over all real X for all non-rectilinear orbits. To see this */ -/* we note that the variable X is a function of DT and is given */ -/* by the integral from 0 to DT of the differential: */ - -/* dt */ -/* ------ */ -/* B*R(t) */ - -/* where R(t) is the range of the body as a function of time. */ -/* Therefore X is an increasing function of DT, and DT must */ -/* also be an increasing function of X. */ - -/* Thus, there is a unique value of X that solves this */ -/* equation). */ - -/* If F is less than zero, we can have the computation of C0,... */ -/* overflow. This is because for X < 0 */ - - -/* C_0(X) = COSH( DSQRT(-X) ) */ - -/* C_1(X) = SINH( DSQRT(-X) ) */ -/* ----------------- */ -/* DSQRT(-X) */ - - - -/* and from the recursion relationship we know that */ - - -/* C_2(X) = ( 1/0! - C_0(X) ) / X */ - -/* C_3(X) = ( 1/1! - C_1(X) ) / X */ - - -/* 1 - COSH( DSQRT(-X) ) */ -/* C_2(X) = ------------------------ */ -/* X */ - -/* 1 - SINH( DSQRT(-X) ) / DSQRT(-X) */ -/* C_3(X) = ----------------------------------- */ -/* X */ - -/* Clearly for negative values of F*X*X having large magnitude, */ -/* it is easy to get an overflow. */ - -/* In the case when F is less than 0 we choose X so that we can */ -/* compute all of the following: */ - -/* | COEF_0 * X**0 * C_0(FX**2) | */ - -/* | COEF_1 * X**1 * C_1(FX**2) | */ - -/* | COEF_2 * X**2 * C_2(FX**2) | */ - -/* | COEF_3 * X**3 * C_3(FX**2) | */ - - -/* where COEF_n are coefficients that will be used in forming */ -/* linear combinations of X**n C_n(FX**2) terms. */ - -/* The variable portion of the last 3 terms above can be */ -/* rewritten as: */ - - -/* SINH ( DSQRT(-F)*|X| ) */ -/* | X**1 * C_1(FX**2) | = ---------------------- */ -/* DSQRT(-F) */ - - - -/* 1 - COSH( DSQRT(-F)*|X| ) */ -/* | X**2 * C_2(FX**2) | = ---------------------------- */ -/* -F */ - - -/* DSQRT(-F)*|X| - SINH(DSQRT(-F)*|X|) */ -/* | X**3 * C_3(FX**2) | = ------------------------------------- */ -/* F*DSQRT(-F) */ - - -/* For large |X| the absolute values of these expressions are well */ -/* approximated by */ - -/* 0.0 */ -/* COSH( DSQRT(-F)|X| ) * |F| */ - -/* -0.5 */ -/* SINH( DSQRT(-F)|X| ) * |F| */ - -/* -1.0 */ -/* COSH( DSQRT(-F)|X| ) * |F| */ - -/* -1.5 */ -/* SINH( DSQRT(-F)|X| ) * |F| */ - - -/* For large |X| the logarithms of these expressions are well */ -/* approximated by: */ - - -/* DSQRT(-F)|X| - LOG(2) - 0.0*LOG(-F) */ - -/* DSQRT(-F)|X| - LOG(2) - 0.5*LOG(-F) */ - -/* DSQRT(-F)|X| - LOG(2) - 1.0*LOG(-F) */ - -/* DSQRT(-F)|X| - LOG(2) - 1.5*LOG(-F) */ - -/* respectively. */ - - -/* To ensure that we can form a linear combination of these terms */ -/* we will require that: */ - - -/* |COEF_N*X**N * C_N(FX**2)| < DPMAX / 4 */ - - - -/* for N=0,1,2,3. This is equivalent to */ - -/* LOG ( X**N * C_N(FX**2) ) < LOG ( DPMAX ) */ -/* + LOG (|COEF_N|) - 2 LOG ( 2 ) */ - - - -/* or */ - -/* LOG ( X**N * C_N(FX**2) ) < LOG ( DPMAX ) */ -/* - LOG ( |COEF_N| ) */ -/* - 2*LOG ( 2 ). */ - - -/* Replacing the left hand side with the magnitude expressions */ -/* computed above we have: */ - -/* DSQRT(-F)|X| - LOG(2) - N*0.5*LOG( -F ) < LOG ( DPMAX ) */ -/* - LOG (|COEF_N|) */ -/* -2*LOG ( 2 ) */ - -/* So that: */ - - -/* |X| < { LOG ( DPMAX ) */ -/* - LOG (|COEF_N|) */ -/* - LOG ( 2 ) */ -/* + LOG ( -F )*N*0.5 } / DSQRT(-F) */ - -/* Let MAXC be the maximum of 1.0D0 and the various coefficients */ -/* of the Stumpff functions. We can then set our absolute value */ -/* bound on X to be: */ - - -/* MIN LOG(DPMAX/2) - LOG(MAXC) + (n/2)LOG(-F) */ -/* n = 0,3 { ----------------------------------------- } */ -/* DSQRT(-F) */ - -/* (Actually we know that the minimum must occur for n = 0 or */ -/* for n = 3). */ - - -/* Computing MAX */ - d__2 = 1., d__3 = abs(br0), d__2 = max(d__2,d__3), d__3 = abs(b2rv), - d__2 = max(d__2,d__3), d__3 = abs(bq), d__2 = max(d__2,d__3), - d__3 = (d__1 = qovr0 / bq, abs(d__1)); - maxc = max(d__2,d__3); - if (f < 0.) { - logmxc = log(maxc); - logdpm = log(dpmax_() / 2.); - fixed = logdpm - logmxc; - rootf = sqrt(-f); - logf = log(-f); -/* Computing MIN */ - d__1 = fixed / rootf, d__2 = (fixed + logf * 1.5) / rootf; - bound = min(d__1,d__2); - -/* Note that in the above, we can always perform the division */ -/* by ROOTF. To see this we note that -F is at least the */ -/* machine precision (we got it by subtracting E from 1.) */ -/* Thus its square root is a reasonably large number (if F is */ -/* 10**-N then ROOTF is 10**(-N/2) ) The value of FIXED is */ -/* about 3*M where M is the largest exponent such that 2**M */ -/* is representable on the host machine. Thus BOUND is at */ -/* worst M*10**(N/2) This will always be computable. */ - - } else { - - -/* In the case when F is non-negative we must be sure we */ -/* can compute all of the following. */ - -/* | COEF_0 * X**0 * C_0(FX**2) | < | COEF_0 | */ - -/* | COEF_1 * X**1 * C_1(FX**2) | < | COEF_1*|X| | */ - -/* | COEF_2 * X**2 * C_2(FX**2) | < | COEF_2*X**2 / 2 | */ - -/* | COEF_3 * X**3 * C_3(FX**2) | < | COEF_3*X**3 / 6 | */ - -/* If we assume that COEF_0 is computable, all of these are */ -/* bounded above by: */ - -/* | MAX(COEF_1,...COEF_3) * X**3 / 6 | */ - -/* We want to make sure we can add these terms so we need to */ -/* make sure that */ - -/* | MAX(COEF_1,...,COEF_3) * X**3 / 6 | < DPMAX() / 4. */ - -/* Thus we need: */ - -/* |X**3| < 1.5*DPMAX / MAX(COEF_1,...,COEF_3) */ -/* |X| < DCBRT ( 1.5*DPMAX / MAX(COEF_1,...,COEF_3) ) */ - -/* (We'll use logarithms to compute the upper bound for |X|.) */ - - logbnd = (log(1.5) + log(dpmax_()) - log(maxc)) / 3.; - bound = exp(logbnd); - } - -/* All the obvious problems have been checked, move everybody */ -/* on the list down and put the new guy on top of the list. */ - - i__1 = nsaved + 1; - nsaved = brckti_(&i__1, &c__1, &c__3); - bumped = newest[(i__1 = nsaved - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "newest", i__1, "prop2b_", (ftnlen)855)]; - for (i__ = nsaved; i__ >= 2; --i__) { - newest[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("newest", - i__1, "prop2b_", (ftnlen)858)] = newest[(i__2 = i__ - 2) - < 3 && 0 <= i__2 ? i__2 : s_rnge("newest", i__2, "prop2b_" - , (ftnlen)858)]; - } - newest[0] = bumped; - k = bumped; - savepv[(i__1 = k * 6 - 6) < 18 && 0 <= i__1 ? i__1 : s_rnge("savepv", - i__1, "prop2b_", (ftnlen)864)] = pvinit[0]; - savepv[(i__1 = k * 6 - 5) < 18 && 0 <= i__1 ? i__1 : s_rnge("savepv", - i__1, "prop2b_", (ftnlen)865)] = pvinit[1]; - savepv[(i__1 = k * 6 - 4) < 18 && 0 <= i__1 ? i__1 : s_rnge("savepv", - i__1, "prop2b_", (ftnlen)866)] = pvinit[2]; - savepv[(i__1 = k * 6 - 3) < 18 && 0 <= i__1 ? i__1 : s_rnge("savepv", - i__1, "prop2b_", (ftnlen)867)] = pvinit[3]; - savepv[(i__1 = k * 6 - 2) < 18 && 0 <= i__1 ? i__1 : s_rnge("savepv", - i__1, "prop2b_", (ftnlen)868)] = pvinit[4]; - savepv[(i__1 = k * 6 - 1) < 18 && 0 <= i__1 ? i__1 : s_rnge("savepv", - i__1, "prop2b_", (ftnlen)869)] = pvinit[5]; - savegm[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("savegm", i__1, - "prop2b_", (ftnlen)870)] = *gm; - -/* Finally we save the results of all of the above */ -/* computations so that we won't have to do them again, */ -/* if this initial state and GM are entered again. */ - - sb2rv[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sb2rv", i__1, - "prop2b_", (ftnlen)877)] = b2rv; - sbound[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sbound", i__1, - "prop2b_", (ftnlen)878)] = bound; - sbq[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sbq", i__1, - "prop2b_", (ftnlen)879)] = bq; - sbr0[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sbr0", i__1, - "prop2b_", (ftnlen)880)] = br0; - sf[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sf", i__1, "prop" - "2b_", (ftnlen)881)] = f; - sqovr0[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sqovr0", i__1, - "prop2b_", (ftnlen)882)] = qovr0; - } - - -/* We are now ready to find the unique value of X such that */ - -/* DT = KFUN ( X ) */ - -/* First we must bracket the root. The basic idea is this: */ - -/* 1) KFUN(0) = 0 so we will let one endpoint of our initial */ -/* guess of a bracketing interval be 0. */ - -/* 2) We get our initial guess at the other endpoint of the */ -/* bracketing interval by recalling that */ - -/* dt */ -/* dX = ------ */ -/* B*R(t) */ - -/* From this observation it follows that */ - -/* DT */ -/* X < ------- */ -/* B*Q */ - -/* Thus the solution to */ - -/* DT = KFUN ( X ) */ - -/* Satisifies */ - -/* DT */ -/* 0 < X < ------- */ -/* B*Q */ - - -/* We now have a guess at a bracketing interval. In the case */ -/* DT is positive it looks like */ - -/* 0 X */ -/* -------[--------]----------------------------- */ - -/* This is ok mathematically, but due to rounding etc it is */ -/* conceivable that we might not have bracketed the root. */ -/* We check and if not we will double the */ -/* endpoint farthest from zero and call this X, and make */ -/* the other endpoint the old value of X. */ - - -/* 0 */ -/* -------+--------[--------]-------------------- */ - - -/* We continue this process ... */ - -/* 0 */ -/* -------+-----------------[-----------------]-- */ - -/* ...until the root is bracketed. (One shift is certain */ -/* to do the job). */ - -/* If we perform this interval shift, we will have to take */ -/* care that X does not run out of the domain for which */ -/* we can safely compute KFUN. Thus we will make sure that */ -/* the endpoints of these shifted intervals always stay safely */ -/* inside the domain for which KFUN can be computed. */ - - x = *dt / bq; - d__1 = -bound; - x = brcktd_(&x, &d__1, &bound); - fx2 = f * x * x; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - kfun = x * (br0 * c1 + x * (b2rv * c2 + x * (bq * c3))); - if (*dt < 0.) { - upper = 0.; - lower = x; - while(kfun > *dt) { - upper = lower; - lower *= 2.; - oldx = x; - d__1 = -bound; - x = brcktd_(&lower, &d__1, &bound); - -/* Make sure we are making progress. (In other words make sure */ -/* we don't run into the boundary of values that X can assume. */ -/* If we do run into the boundary, X will be unchanged and */ -/* there's nothing further we can do. We'll have to call it */ -/* quits and tell the user what happened.) */ - - if (x == oldx) { - fx2 = f * bound * bound; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - kfunl = -bound * (br0 * c1 - bound * (b2rv * c2 - bound * bq * - c3)); - kfunu = bound * (br0 * c1 + bound * (b2rv * c2 + bound * bq * - c3)); - setmsg_("The input delta time (DT) has a value of #. This i" - "s beyond the range of DT for which we can reliably p" - "ropagate states. The limits for this GM and initial " - "state are from # to #. ", (ftnlen)178); - errdp_("#", dt, (ftnlen)1); - errdp_("#", &kfunl, (ftnlen)1); - errdp_("#", &kfunu, (ftnlen)1); - sigerr_("SPICE(DTOUTOFRANGE)", (ftnlen)19); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - fx2 = f * x * x; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - kfun = x * (br0 * c1 + x * (b2rv * c2 + x * (bq * c3))); - } - } else if (*dt > 0.) { - lower = 0.; - upper = x; - while(kfun < *dt) { - lower = upper; - upper *= 2.; - oldx = x; - d__1 = -bound; - x = brcktd_(&upper, &d__1, &bound); - -/* Make sure we are making progress. */ - - if (x == oldx) { - fx2 = f * bound * bound; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - kfunl = -bound * (br0 * c1 - bound * (b2rv * c2 - bound * bq * - c3)); - kfunu = bound * (br0 * c1 + bound * (b2rv * c2 + bound * bq * - c3)); - setmsg_("The input delta time (DT) has a value of #. This i" - "s beyond the range of DT for which we can reliably p" - "ropagate states. The limits for this GM and initial " - "state are from # to #. ", (ftnlen)178); - errdp_("#", dt, (ftnlen)1); - errdp_("#", &kfunl, (ftnlen)1); - errdp_("#", &kfunu, (ftnlen)1); - sigerr_("SPICE(DTOUTOFRANGE)", (ftnlen)19); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - fx2 = f * x * x; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - kfun = x * (br0 * c1 + x * (b2rv * c2 + x * bq * c3)); - } - } else { - vequg_(pvinit, &c__6, pvprop); - chkout_("PROP2B", (ftnlen)6); - return 0; - } - -/* Ok. We've bracketed the root. Now for lack of anything more */ -/* clever, we just bisect to find the solution. */ - -/* We add a loop counter so that we can ensure termination of the */ -/* loop below. */ - -/* On some systems the computed midpoint is stored in an extended */ -/* precision register. Thus the midpoint is always different from */ -/* UPPER and LOWER. Yet when the new value of LOWER and UPPER */ -/* are assigned UPPER and LOWER do not change and hence the */ -/* loop fails to terminate. With the loop counter we force */ -/* termination of the loop. */ - -/* Computing MIN */ -/* Computing MAX */ - d__3 = lower, d__4 = (lower + upper) / 2.; - d__1 = upper, d__2 = max(d__3,d__4); - x = min(d__1,d__2); - fx2 = f * x * x; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - lcount = 0; - mostc = 1000; - while(x > lower && x < upper && lcount < mostc) { - kfun = x * (br0 * c1 + x * (b2rv * c2 + x * bq * c3)); - if (kfun > *dt) { - upper = x; - } else if (kfun < *dt) { - lower = x; - } else { - upper = x; - lower = x; - } - -/* As soon as the bracketting values move away from */ -/* zero we can modify the count limit. */ - - if (mostc > 64) { - if (upper != 0. && lower != 0.) { - mostc = 64; - lcount = 0; - } - } -/* Computing MIN */ -/* Computing MAX */ - d__3 = lower, d__4 = (lower + upper) / 2.; - d__1 = upper, d__2 = max(d__3,d__4); - x = min(d__1,d__2); - fx2 = f * x * x; - stmp03_(&fx2, &c0, &c1, &c2, &c3); - ++lcount; - } - -/* With X in hand we simply compute BR, PC, VC, PCDOT and VCDOT */ -/* described in equations (1) --- (5) above. (Note, by our choice */ -/* of BOUND above, one can show that none of the computations */ -/* below can cause an overflow). */ - - x2 = x * x; - x3 = x2 * x; - br = br0 * c0 + x * (b2rv * c1 + x * (bq * c2)); - pc = 1. - qovr0 * x2 * c2; - vc = *dt - bq * x3 * c3; - pcdot = -(qovr0 / br) * x * c1; - vcdot = 1. - bq / br * x2 * c2; - -/* ... and compute the linear combinations needed to get PVPROP */ - - vlcom_(&pc, pos, &vc, vel, pvprop); - vlcom_(&pcdot, pos, &vcdot, vel, &pvprop[3]); - chkout_("PROP2B", (ftnlen)6); - return 0; -} /* prop2b_ */ - diff --git a/ext/spice/src/cspice/prop2b_c.c b/ext/spice/src/cspice/prop2b_c.c deleted file mode 100644 index b307d6c34c..0000000000 --- a/ext/spice/src/cspice/prop2b_c.c +++ /dev/null @@ -1,220 +0,0 @@ -/* - --Procedure prop2b_c ( Propagate a two-body solution ) - --Abstract - - Given a central mass and the state of massless body at time t_0, - this routine determines the state as predicted by a two-body - force model at time t_0 + dt. - --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 - - CONIC - EPHEMERIS - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef prop2b_c - - void prop2b_c ( SpiceDouble gm, - ConstSpiceDouble pvinit[6], - SpiceDouble dt, - SpiceDouble pvprop[6] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - gm I Gravity of the central mass. - pvinit I Initial state from which to propagate a state. - dt I Time offset from initial state to propagate to. - pvprop O The propagated state. - --Detailed_Input - - gm is the gravitational constant G times the mass M of the - central body. - - pvinit is the state at some specified time relative to the - central mass. The mass of the object is assumed to - be negligible when compared to the central mass. - - dt is a offset in time from the time of the initial - state to which the two-body state should be - propagated. (The units of time and distance must be - the same in gm, pvinit, and dt). - --Detailed_Output - - pvprop is the two-body propagation of the initial state - dt units of time past the epoch of the initial state. - --Parameters - - None. - --Exceptions - - 1) If gm is not positive, the error SPICE(NONPOSITIVEMASS) will - be signalled. - - 2) If the position of the initial state is the zero vector, the - error SPICE(ZEROPOSITION) will be signalled. - - 3) If the velocity of the initial state is the zero vector, the - error SPICE(ZEROVELOCITY) will be signalled. - - 4) If the cross product of the position and velocity of pvinit - has squared length of zero, the error SPICE(NONCONICMOTION) - will be signalled. - - 5) The value of dt must be "reasonable". In other words, dt - should be less than 10**20 seconds for realistic solar system - orbits specified in the MKS system. (The actual bounds - on dt are much greater but require substantial computation.) - The "reasonableness" of dt is checked at run-time. If dt is - so large that there is a danger of floating point overflow - during computation, the error SPICE(DTOUTOFRANGE) is - signalled and a message is generated describing the problem. - --Files - - None. - --Particulars - - This routine uses a universal variables formulation for the - two-body motion of an object in orbit about a central mass. It - propagates an initial state to an epoch offset from the - epoch of the initial state by time dt. - - This routine does not suffer from the finite precision - problems of the machine that are inherent to classical - formulations based on the solutions to Kepler's equation: - - n( t - T ) = E - e Sin(E) elliptic case - n( t - T ) = e sinh(F) - F hyperbolic case - - The derivation used to determine the propagated state is a - slight variation of the derivation in Danby's book - `Fundamentals of Celestial Mechanics' [1] . - --Examples - - When the eccentricity of an orbit is near 1, and the epoch - of classical elements is near the epoch of periapse, classical - formulations that propagate a state from elements tend to - lack robustness due to the finite precision of floating point - machines. In those situations it is better to use a universal - variables formulation to propagate the state. - - By using this routine, you need not go from a state to elements - and back to a state. Instead, you can get the state from an - initial state. - - If pv is your initial state and you want the state 3600 - seconds later, the following call will suffice. - - Look up gm somewhere - - dt = 3600.0; - - prop2b_c ( gm, pv, dt, pvdt ); - - After the call, pvdt will contain the state of the - object 3600 seconds after the time it had state pv. - --Restrictions - - Users should be sure that gm, pvinit and dt are all in the - same system of units ( for example MKS ). - --Literature_References - - [1] `Fundamentals of Celestial Mechanics', Second Edition - by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 - Richmond Virginia; pp 168-180 - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.0, 24-JUL-2001 (NJB) - - Changed protoype: input pvinit is now type - (ConstSpiceDouble [6]). Implemented interface macro for - casting input pvinit to const. - - -CSPICE Version 1.0.1, 20-MAR-1998 (EDW) - - Minor correction to header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - Propagate state vector using two-body force model - --& -*/ - -{ /* Begin prop2b_c */ - - - /* - Participate in error handling. - */ - - chkin_c ( "prop2b_c"); - - - prop2b_ ( ( doublereal * ) &gm, - ( doublereal * ) pvinit, - ( doublereal * ) &dt, - ( doublereal * ) pvprop ); - - - chkout_c ( "prop2b_c"); - - -} /* End prop2b_c */ diff --git a/ext/spice/src/cspice/prsdp.c b/ext/spice/src/cspice/prsdp.c deleted file mode 100644 index 981a018145..0000000000 --- a/ext/spice/src/cspice/prsdp.c +++ /dev/null @@ -1,150 +0,0 @@ -/* prsdp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PRSDP ( Parse d.p. number with error checking ) */ -/* Subroutine */ int prsdp_(char *string, doublereal *dpval, ftnlen - string_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), nparsd_(char *, - doublereal *, char *, integer *, ftnlen, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - char errmsg[320]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer ptr; - -/* $ Abstract */ - -/* Parse a string as a double precision number, encapsulating error */ -/* handling. */ - -/* $ 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 */ - -/* NUMBER */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String representing a d.p. number. */ -/* DPVAL O D.p. value obtained by parsing STRING. */ - -/* $ Detailed_Input */ - -/* STRING is a string representing a double precision */ -/* number. Any string acceptable to the SPICELIB */ -/* routine NPARSD is allowed. */ - -/* $ Detailed_Output */ - -/* DPVAL is the double precision number obtained by parsing */ -/* STRING. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input string cannot be parsed, the error */ -/* SPICE(NOTADPNUMBER) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The purpose of this routine is to enable safe parsing of double */ -/* precision numbers without the necessity of in-line error checking. */ -/* This routine is based on the SPICELIB routine NPARSD. */ - -/* $ Examples */ - -/* See the routine NPARSD for an examples of allowed strings. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-SEP-1997 (NJB) */ - -/* Bug fix: output argument declaration changed from INTEGER */ -/* to DOUBLE PRECISION. */ - -/* - SPICELIB Version 1.0.0, 22-JUL-1997 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse d.p. number with encapsulated error handling */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nparsd_(string, dpval, errmsg, &ptr, string_len, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - chkin_("PRSDP", (ftnlen)5); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(NOTADPNUMBER)", (ftnlen)19); - chkout_("PRSDP", (ftnlen)5); - return 0; - } - return 0; -} /* prsdp_ */ - diff --git a/ext/spice/src/cspice/prsdp_c.c b/ext/spice/src/cspice/prsdp_c.c deleted file mode 100644 index 6be42ac61c..0000000000 --- a/ext/spice/src/cspice/prsdp_c.c +++ /dev/null @@ -1,165 +0,0 @@ -/* - --Procedure prsdp_c ( Parse d.p. number with error checking ) - --Abstract - - Parse a string as a double precision number, encapsulating error - handling. - --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 - - NUMBER - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void prsdp_c ( ConstSpiceChar * string, - SpiceDouble * dpval ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - string I String representing a d.p. number. - dpval O D.p. value obtained by parsing string. - --Detailed_Input - - string is a string representing a double precision - number. Any string acceptable to the CSPICE - routine nparsd.c is allowed. - --Detailed_Output - - dpval is the double precision number obtained by parsing - string. - --Parameters - - None. - --Exceptions - - - 1) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the input string does not contain at least one character, - the error SPICE(EMPTYSTRING) will be signaled. - - 3) If the input string cannot be parsed, the error - SPICE(NOTADPNUMBER) is signalled. - --Files - - None. - --Particulars - - The purpose of this routine is to enable safe parsing of double - precision numbers without the necessity of in-line error checking. - This routine is based on the CSPICE routine nparsd.c. - --Examples - - See the routine NPARSD for an examples of allowed strings. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.2, 26-AUG-1999 (NJB) - - Header was updated to list string exceptions. - - -CSPICE Version 1.1.1, 25-MAR-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 - - Based on SPICELIB Version 1.0.0, 22-JUL-1997 (NJB) - --Index_Entries - - parse d.p. number with encapsulated error handling - --& -*/ - -{ /* Begin prsdp_c */ - - /* - Participate in error handling. - */ - chkin_c ( "prsdp_c"); - - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "prsdp_c", string ); - - - prsdp_ ( ( char * ) string, - ( doublereal * ) dpval, - ( ftnlen ) strlen(string) ); - - - chkout_c ( "prsdp_c"); - -} /* End prsdp_c */ diff --git a/ext/spice/src/cspice/prsint.c b/ext/spice/src/cspice/prsint.c deleted file mode 100644 index 43d44cc422..0000000000 --- a/ext/spice/src/cspice/prsint.c +++ /dev/null @@ -1,142 +0,0 @@ -/* prsint.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PRSINT ( Parse integer with error checking ) */ -/* Subroutine */ int prsint_(char *string, integer *intval, ftnlen string_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), nparsi_(char *, integer *, char *, integer *, ftnlen, - ftnlen), chkout_(char *, ftnlen); - char errmsg[320]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer ptr; - -/* $ Abstract */ - -/* Parse a string as an integer, encapsulating error handling. */ - -/* $ 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 */ - -/* INTEGER */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String representing an integer. */ -/* INTVAL O Integer value obtained by parsing STRING. */ - -/* $ Detailed_Input */ - -/* STRING is a string representing an integer. Any string */ -/* acceptable to the SPICELIB routine NPARSI is */ -/* allowed. */ - -/* $ Detailed_Output */ - -/* INTVAL is the integer obtained by parsing STRING. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input string cannot be parsed, the error */ -/* SPICE(NOTANINTEGER) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The purpose of this routine is to enable safe parsing of integers */ -/* without the necessity of in-line error checking. This routine is */ -/* based on the SPICELIB routine NPARSI. */ - -/* $ Examples */ - -/* See the routine NPARSI for an examples of allowed strings. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 22-JUL-1997 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse integer with encapsulated error handling */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nparsi_(string, intval, errmsg, &ptr, string_len, (ftnlen)320); - if (s_cmp(errmsg, " ", (ftnlen)320, (ftnlen)1) != 0) { - chkin_("PRSINT", (ftnlen)6); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(NOTANINTEGER)", (ftnlen)19); - chkout_("PRSINT", (ftnlen)6); - return 0; - } - return 0; -} /* prsint_ */ - diff --git a/ext/spice/src/cspice/prsint_c.c b/ext/spice/src/cspice/prsint_c.c deleted file mode 100644 index 2b1f8425a3..0000000000 --- a/ext/spice/src/cspice/prsint_c.c +++ /dev/null @@ -1,157 +0,0 @@ -/* - --Procedure prsint_c ( Parse integer with error checking ) - --Abstract - - Parse a string as an integer, encapsulating error handling. - --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 - - INTEGER - PARSING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void prsint_c ( ConstSpiceChar * string, - SpiceInt * intval ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - string I String representing an integer. - intval O Integer value obtained by parsing string. - --Detailed_Input - - string is a string representing an integer. Any string - acceptable to the CSPICE routine nparsi_ is - allowed. - --Detailed_Output - - intval is the integer obtained by parsing string. - --Parameters - - None. - --Exceptions - - - 1) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the input string does not contain at least one character, - the error SPICE(EMPTYSTRING) will be signaled. - - 3) If the input string cannot be parsed, the error - SPICE(NOTANINTEGER) is signaled. - --Files - - None. - --Particulars - - The purpose of this routine is to enable safe parsing of integers - without the necessity of in-line error checking. This routine is - based on the CSPICE routine nparsi_. - --Examples - - See the routine NPARSI for an examples of allowed strings. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.1, 26-AUG-1999 (NJB) - - Header was updated to list string exceptions. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - --Index_Entries - - parse integer with encapsulated error handling - --& -*/ - -{ /* Begin prsint_c */ - - /* - Participate in error handling. - */ - chkin_c ( "prsint_c"); - - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "prsint_c", string ); - - - prsint_ ( ( char * ) string, - ( integer * ) intval, - ( ftnlen ) strlen(string) ); - - - chkout_c ( "prsint_c"); - -} /* End prsint_c */ diff --git a/ext/spice/src/cspice/prtenc.c b/ext/spice/src/cspice/prtenc.c deleted file mode 100644 index 1a3fb5b5ba..0000000000 --- a/ext/spice/src/cspice/prtenc.c +++ /dev/null @@ -1,361 +0,0 @@ -/* prtenc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PRTENC ( Encode a character string, portably ) */ -/* Subroutine */ int prtenc_0_(int n__, integer *number, char *string, ftnlen - string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer base, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer remain; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer num; - -/* $ Abstract */ - -/* Encode a nonnegative integer number into a character string, */ -/* portably. This routine uses 128 as the base for encoding. */ - -/* $ 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 */ - -/* CELLS, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUMBER I Number to be encoded. */ -/* STRING O Encoded string. */ -/* MINLEN P Minimum length of string. */ - -/* $ Detailed_Input */ - -/* NUMBER is an arbitrary nonnegative integer. */ - -/* $ Detailed_Output */ - -/* STRING is the character string implied by the ASCII */ -/* interpretation of NUMBER when converted to its */ -/* base 128 representation. */ - -/* Let L be the declared length of STRING, and let */ -/* NUMBER be given by */ - -/* 0 1 L-1 */ -/* NUMBER = a 128 + a 128 + ... + a 128 */ -/* 1 2 L */ - -/* Then */ - -/* STRING(i:i) = CHAR(a ) for i = 1, L */ -/* i */ - -/* Note that, just as for any other "numbers", */ -/* the "digits" in STRING are arranged from right */ -/* to left in order of increasing significance. */ -/* The string is, in effect, "padded with nulls" */ -/* on the left. */ - -/* $ Parameters */ - -/* MINLEN is the minimum length of a string into which a */ -/* number may be encoded. In order to avoid padding */ -/* long strings with hundreds, possibly thousands */ -/* of null characters, only the first MINLEN characters */ -/* of the string are actually used. Note that this */ -/* also allows the encoded number to be preserved */ -/* during assignments, */ - -/* STR1 = STR2 */ - -/* so long as both strings are of length MINLEN or */ -/* greater. */ - -/* $ Particulars */ - -/* This routine is identical to ENCHAR, except that this routine */ -/* does not use the machine-dependent encoding base returned by */ -/* the SPICELIB routine CHBASE. Instead, the base 128 is used. */ -/* This base is expected to work on all systems supporting ASCII */ -/* encoding of characters. */ - -/* $ Examples */ - -/* See: SCARDC, SSIZEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the length of the output string is less than MINLEN, */ -/* the error 'SPICE(INSUFFLEN)' is signalled. */ - -/* 2) If the number to be encoded is negative, the error */ -/* 'SPICE(OUTOFRANGE)' is signalled. */ - -/* MINLEN */ -/* 3) If the number to be encoded is larger than 128 - 1, */ -/* the error 'SPICE(OUTOFRANGE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 19-DEC-1995 (NJB)(WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* encode a character string, portably */ - -/* -& */ - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_prtdec; - } - - if (i_len(string, string_len) < 5) { - chkin_("PRTENC", (ftnlen)6); - sigerr_("SPICE(INSUFFLEN)", (ftnlen)16); - chkout_("PRTENC", (ftnlen)6); - return 0; - } else if (*number < 0) { - chkin_("PRTENC", (ftnlen)6); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - chkout_("PRTENC", (ftnlen)6); - return 0; - } - -/* Generate the digits from right to left. */ - - base = 128; - num = *number; - for (i__ = 5; i__ >= 1; --i__) { - remain = num % base; - *(unsigned char *)&string[i__ - 1] = (char) remain; - num /= base; - } - -/* More error handling. */ - - if (num > 0) { - chkin_("PRTENC", (ftnlen)6); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - chkout_("PRTENC", (ftnlen)6); - } - return 0; -/* $Procedure PRTDEC ( Decode a character string ) */ - -L_prtdec: -/* $ Abstract */ - -/* Decode a character string encoded by PRTENC. */ - -/* $ 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 */ - -/* CHARACTER */ - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ -/* INTEGER NUMBER */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Encoded character string. */ -/* NUMBER O Decoded number. */ - -/* $ Detailed_Input */ - -/* STRING is a character string previously encoded by PRTENC. */ -/* This contains an integer in base 128 notation, */ -/* where 128 is a function of the size of the */ -/* available character set. See PRTENC for details */ -/* about the format of STRING. */ - -/* $ Detailed_Output */ - -/* NUMBER is the integer encoded in the input string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* PRTDEC is the inverse of PRTENC. In the example below, */ - -/* CALL PRTENC ( I, STRING ) */ -/* CALL PRTDEC ( STRING, J ) */ - -/* IF ( I .EQ. J ) THEN */ -/* . */ -/* . */ -/* END IF */ - -/* the logical test (I .EQ. J) is always true. */ - -/* This routine is identical to DECHAR, except that this routine */ -/* does not use the machine-dependent encoding base returned by */ -/* the SPICELIB routine CHBASE. Instead, the base 128 is used. */ -/* This base is expected to work on all systems supporting ASCII */ -/* encoding of characters. */ - -/* $ Examples */ - -/* See: CARDC, SIZEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the length of the input string is less than MINLEN, */ -/* the error 'SPICE(INSUFFLEN)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-DEC-1995 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* decode a portably encoded character string */ - -/* -& */ - if (i_len(string, string_len) < 5) { - chkin_("PRTDEC", (ftnlen)6); - sigerr_("SPICE(INSUFFLEN)", (ftnlen)16); - chkout_("PRTDEC", (ftnlen)6); - return 0; - } - -/* Sum the products of the 'digits' and the corresponding powers */ -/* of NDCHAR, just like any other base conversion. */ - - base = 128; - *number = 0; - for (i__ = 1; i__ <= 5; ++i__) { - *number = base * *number + *(unsigned char *)&string[i__ - 1]; - } - return 0; -} /* prtenc_ */ - -/* Subroutine */ int prtenc_(integer *number, char *string, ftnlen string_len) -{ - return prtenc_0_(0, number, string, string_len); - } - -/* Subroutine */ int prtdec_(char *string, integer *number, ftnlen string_len) -{ - return prtenc_0_(1, number, string, string_len); - } - diff --git a/ext/spice/src/cspice/prtpkg.c b/ext/spice/src/cspice/prtpkg.c deleted file mode 100644 index 7dea92e6b2..0000000000 --- a/ext/spice/src/cspice/prtpkg.c +++ /dev/null @@ -1,808 +0,0 @@ -/* prtpkg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure PRTPKG ( Declare Arguments for Error Message Routines ) */ -logical prtpkg_0_(int n__, logical *short__, logical *long__, logical *expl, - logical *trace, logical *dfault, char *type__, ftnlen type_len) -{ - /* Initialized data */ - - static logical svshrt = TRUE_; - static logical svexpl = TRUE_; - static logical svlong = TRUE_; - static logical svtrac = TRUE_; - static logical svdflt = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1[2]; - logical ret_val; - char ch__1[96]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - char ltype[10]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char device[255]; - extern /* Subroutine */ int getdev_(char *, ftnlen), wrline_(char *, char - *, ftnlen, ftnlen); - char loctyp[10]; - -/* $ Abstract */ - -/* Declare the arguments for the error message selection entry */ -/* points. DO NOT CALL THIS ROUTINE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O ENTRY */ -/* -------- --- -------------------------------------------------- */ - -/* SHORT I SETPRT */ -/* EXPL I SETPRT */ -/* LONG I SETPRT */ -/* TRACE I SETPRT */ -/* DFAULT I SETPRT */ -/* TYPE I MSGSEL */ -/* FILEN P MSGSEL */ - -/* $ Detailed_Input */ - -/* See the ENTRY points for discussions of their arguments. */ - -/* $ Detailed_Output */ - -/* See the ENTRY points for discussions of their arguments. */ - -/* $ Parameters */ - -/* See the ENTRY points for discussions of their parameters. */ - -/* $ Exceptions */ - -/* This routine signals an error IF IT IS CALLED. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* The entry points declared in this routine are: */ - -/* SETPRT */ -/* MSGSEL */ - -/* There is no reason to call this subroutine. */ -/* The purpose of this subroutine is to make the */ -/* declarations required by the various entry points. */ -/* This routine has no run-time function. */ - -/* $ Examples */ - -/* None. DO NOT CALL THIS ROUTINE. */ - -/* $ Restrictions */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 3.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 3.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 3.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 3.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 3.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 3.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 3.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 3.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 3.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 3.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 3.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 3.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 3.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 3.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 3.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - Beta Version 1.1.0, 13-DEC-1989 (NJB) */ - -/* PRTPKG, though it performs no run-time function, must */ -/* still return a value, in order to comply with the Fortran */ -/* standard. So, now it does. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine. */ -/* Parameter declarations moved to "Declarations" section. */ -/* Two local declarations moved to the correct location. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables: */ - - -/* Saved variables: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_setprt; - case 2: goto L_msgsel; - } - - -/* Executable Code: */ - - getdev_(device, (ftnlen)255); - wrline_(device, "PRTPKG: You have called an entry point which has no ru" - "n-time function; this may indicate a program bug. Please check " - "the PRTPKG documentation. ", (ftnlen)255, (ftnlen)146); - wrline_(device, "SPICE(BOGUSENTRY)", (ftnlen)255, (ftnlen)17); - ret_val = FALSE_; - return ret_val; -/* $Procedure SETPRT ( Store Error Message Types to be Output ) */ - -L_setprt: -/* $ Abstract */ - -/* Store (a representation of) the selection of types of error */ -/* messages to be output. DO NOT CALL THIS ROUTINE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* LOGICAL SHORT */ -/* LOGICAL EXPL */ -/* LOGICAL LONG */ -/* LOGICAL TRACE */ -/* LOGICAL DFAULT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* SHORT I Select output of short error message? */ -/* EXPL I Select output of explanation of short message? */ -/* LONG I Select output of long error message? */ -/* TRACE I Select output of traceback? */ -/* DFAULT I Select output of default message? */ - -/* $ Detailed_Input */ - -/* SHORT indicates whether the short error message is selected */ -/* as one of the error messages to be output when an error */ -/* is detected. A value of .TRUE. indicates that the */ -/* short error message IS selected. */ - -/* EXPL indicates whether the explanatory text for the short */ -/* error message is selected as one of the error messages */ -/* to be output when an error is detected. A value of */ -/* .TRUE. indicates that the explanatory text for the */ -/* short error message IS selected. */ - -/* LONG indicates whether the long error message is selected */ -/* as one of the error messages to be output when an error */ -/* is detected. A value of .TRUE. indicates that the */ -/* long error message IS selected. */ - -/* TRACE indicates whether the traceback is selected */ -/* as one of the error messages to be output when an error */ -/* is detected. A value of .TRUE. indicates that the */ -/* traceback IS selected. */ - -/* DFAULT indicates whether the default message is selected */ -/* as one of the error messages to be output when an error */ -/* is detected. A value of .TRUE. indicates that the */ -/* default message IS selected. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* The effect of this routine is an ENVIRONMENTAL one. This */ -/* routine performs no output; it stores the error message */ -/* selection provided as input. */ - -/* Note that the actual output of error messages depends not */ -/* only on the selection made using this routine, but also */ -/* on the selection of the error output device (see ERRDEV) */ -/* and the choice of error response action (see ERRACT). If */ -/* the action is not 'IGNORE' (possible choices are */ -/* 'IGNORE', 'ABORT', 'DEFAULT', 'REPORT', and 'RETURN'), */ -/* the selected error messages will be written to the chosen */ -/* output device when an error is detected. */ - -/* $ Examples */ - -/* 1. In this example, the short and long messages are selected. */ - -/* C */ -/* C Select short and long error messages for output */ -/* C (We don't examine the status returned because no */ -/* C errors are detected by SETPRT): */ -/* C */ - -/* STATUS = SETPRT ( .TRUE., .FALSE., .TRUE., .FALSE., */ -/* . .FALSE. ) */ - - - -/* $ Restrictions */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. Parameters section added. */ - -/* -& */ - -/* Executable Code: */ - - if (*short__) { - svshrt = TRUE_; - } else { - svshrt = FALSE_; - } - if (*expl) { - svexpl = TRUE_; - } else { - svexpl = FALSE_; - } - if (*long__) { - svlong = TRUE_; - } else { - svlong = FALSE_; - } - if (*trace) { - svtrac = TRUE_; - } else { - svtrac = FALSE_; - } - if (*dfault) { - svdflt = TRUE_; - } else { - svdflt = FALSE_; - } - -/* We assign a value to SETPRT, but this value is */ -/* not meaningful... */ - - ret_val = TRUE_; - return ret_val; -/* $Procedure MSGSEL ( Is This Message Type Selected for Output? ) */ - -L_msgsel: -/* $ Abstract */ - -/* Indicate whether the specified message type has been selected */ -/* for output. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* TYPE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* TYPE I Type of message whose selection status is queried. */ -/* FILEN P Maximum length of a file name. */ - -/* The function takes the value .TRUE. if the message type indicated */ -/* by TYPE has been selected for output to the error output device. */ - - -/* $ Detailed_Input */ - -/* TYPE Refers to a type of error message. Possible values */ -/* are 'SHORT', 'EXPLAIN', 'LONG', 'DEFAULT', */ -/* and 'TRACEBACK'. */ - -/* $ Detailed_Output */ - -/* The function takes the value .TRUE. if the message type indicated */ -/* by TYPE has been selected for output to the error output device. */ - -/* $ Parameters */ - -/* FILEN is the maximum length of a file name. */ - -/* $ Exceptions */ - -/* Additionally, invalid values of TYPE are detected. */ - -/* The short error message set in this case is: */ -/* 'SPICE(INVALIDMSGTYPE)' */ - -/* The handling of this error is a special case; to avoid recursion */ -/* problems, SIGERR is not called when the error is detected. */ -/* Instead, the short and long error messages are output directly. */ - - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* Note that even though a given type of message may have been */ -/* selected for output, the output device and error response */ -/* action must also have been selected appropriately. */ -/* Use ERRDEV to choose the output device for error messages. */ -/* Use ERRACT to choose the error response action. Any action */ -/* other than 'IGNORE' will result in error messages being */ -/* written to the error output device when errors are detected. */ -/* See ERRACT for details. */ - -/* $ Examples */ - - -/* 1. We want to know if the short message has been selected */ -/* for output: */ - -/* C */ -/* C Test whether the short message has been selected: */ -/* C */ - -/* SELECT = MSGSEL ( 'SHORT' ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Parameters section added; parameter declaration added */ -/* to brief I/O section as well. */ - -/* -& */ - -/* Executable Code: */ - - ljust_(type__, ltype, type_len, (ftnlen)10); - ucase_(ltype, ltype, (ftnlen)10, (ftnlen)10); - if (s_cmp(ltype, "SHORT", (ftnlen)10, (ftnlen)5) == 0) { - ret_val = svshrt; - } else if (s_cmp(ltype, "EXPLAIN", (ftnlen)10, (ftnlen)7) == 0) { - ret_val = svexpl; - } else if (s_cmp(ltype, "LONG", (ftnlen)10, (ftnlen)4) == 0) { - ret_val = svlong; - } else if (s_cmp(ltype, "TRACEBACK", (ftnlen)10, (ftnlen)9) == 0) { - ret_val = svtrac; - } else if (s_cmp(ltype, "DEFAULT", (ftnlen)10, (ftnlen)7) == 0) { - ret_val = svdflt; - } else { - -/* Bad value of type! We have a special case here; to */ -/* avoid recursion, we output the messages directly, */ -/* rather than call SIGERR. */ - - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(INVALIDMSGTYPE)", (ftnlen)255, (ftnlen)21); - wrline_(device, " ", (ftnlen)255, (ftnlen)1); - s_copy(loctyp, type__, (ftnlen)10, type_len); - -/* Note: What looks like a typo below isn't; there's */ -/* a line break after the substring 'specified' of */ -/* the "word" 'specifiedwas'. */ - -/* Writing concatenation */ - i__1[0] = 86, a__1[0] = "MSGSEL: An invalid error message type was " - "supplied as input; the type specifiedwas: "; - i__1[1] = 10, a__1[1] = loctyp; - s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)96); - wrline_(device, ch__1, (ftnlen)255, (ftnlen)96); - } - return ret_val; -} /* prtpkg_ */ - -logical prtpkg_(logical *short__, logical *long__, logical *expl, logical * - trace, logical *dfault, char *type__, ftnlen type_len) -{ - return prtpkg_0_(0, short__, long__, expl, trace, dfault, type__, - type_len); - } - -logical setprt_(logical *short__, logical *expl, logical *long__, logical * - trace, logical *dfault) -{ - return prtpkg_0_(1, short__, long__, expl, trace, dfault, (char *)0, ( - ftnint)0); - } - -logical msgsel_(char *type__, ftnlen type_len) -{ - return prtpkg_0_(2, (logical *)0, (logical *)0, (logical *)0, (logical *) - 0, (logical *)0, type__, type_len); - } - diff --git a/ext/spice/src/cspice/psv2pl.c b/ext/spice/src/cspice/psv2pl.c deleted file mode 100644 index 1a6444d831..0000000000 --- a/ext/spice/src/cspice/psv2pl.c +++ /dev/null @@ -1,254 +0,0 @@ -/* psv2pl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PSV2PL ( Point and spanning vectors to plane ) */ -/* Subroutine */ int psv2pl_(doublereal *point, doublereal *span1, doublereal - *span2, doublereal *plane) -{ - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), chkin_( - char *, ftnlen), ucrss_(doublereal *, doublereal *, doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal tmpvec[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Make a SPICELIB plane from a point and two spanning vectors. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POINT, */ -/* SPAN1, */ -/* SPAN2 I A point and two spanning vectors defining a plane. */ -/* PLANE O An array representing the plane. */ - -/* $ Detailed_Input */ - -/* POINT, */ -/* SPAN1, */ -/* SPAN2 are, respectively, a point and two spanning vectors */ -/* that define a geometric plane in three-dimensional */ -/* space. The plane is the set of vectors */ - -/* POINT + s * SPAN1 + t * SPAN2 */ - -/* where s and t are real numbers. The spanning */ -/* vectors SPAN1 and SPAN2 must be linearly */ -/* independent, but they need not be orthogonal or */ -/* unitized. */ - -/* $ Detailed_Output */ - -/* PLANE is a SPICELIB plane that represents the geometric */ -/* plane defined by POINT, SPAN1, and SPAN2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If SPAN1 and SPAN2 are linearly dependent, then the vectors */ -/* POINT, SPAN1, and SPAN2 do not define a plane. The error */ -/* SPICE(DEGENERATECASE) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SPICELIB geometry routines that deal with planes use the `plane' */ -/* data type to represent input and output planes. This data type */ -/* makes the subroutine interfaces simpler and more uniform. */ - -/* The SPICELIB routines that produce SPICELIB planes from data that */ -/* define a plane are: */ - -/* NVC2PL ( Normal vector and constant to plane ) */ -/* NVP2PL ( Normal vector and point to plane ) */ -/* PSV2PL ( Point and spanning vectors to plane ) */ - -/* The SPICELIB routines that convert SPICELIB planes to data that */ -/* define a plane are: */ - -/* PL2NVC ( Plane to normal vector and constant ) */ -/* PL2NVP ( Plane to normal vector and point ) */ -/* PL2PSV ( Plane to point and spanning vectors ) */ - -/* Any of these last three routines may be used to convert this */ -/* routine's output, PLANE, to another representation of a */ -/* geometric plane. */ - -/* $ Examples */ - -/* 1) Project a vector V orthogonally onto a plane defined by */ -/* POINT, SPAN1, and SPAN2. PROJ is the projection we want; it */ -/* is the closest vector in the plane to V. */ - -/* CALL PSV2PL ( POINT, SPAN1, SPAN2, PLANE ) */ -/* CALL VPRJP ( V, PLANE, PROJ ) */ - - -/* 2) Find the plane determined by a spacecraft's position vector */ -/* relative to a central body and the spacecraft's velocity */ -/* vector. We assume that all vectors are given in the same */ -/* coordinate system. */ - -/* C */ -/* C POS is the spacecraft's position, relative to */ -/* C the central body. VEL is the spacecraft's velocity */ -/* C vector. POS is a point (vector, if you like) in */ -/* C the orbit plane, and it is also one of the spanning */ -/* C vectors of the plane. */ -/* C */ -/* CALL PSV2PL ( POS, POS, VEL, PLANE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VMINUS call. */ - -/* - 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* point and spanning vectors to plane */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VMINUS call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* The contents of SPICELIB planes are as follows: */ - -/* Elements NMLPOS through NMLPOS + 2 contain a unit normal */ -/* vector for the plane. */ - -/* Element CONPOS contains a constant for the plane; every point */ -/* X in the plane satisifies */ - -/* < X, PLANE(NMLPOS) > = PLANE(CONPOS). */ - -/* The plane constant is the distance of the plane from the */ -/* origin; the normal vector, scaled by the constant, is the */ -/* closest point in the plane to the origin. */ - - - -/* Local variables */ - - -/* This routine checks in only if an error is discovered. */ - - if (return_()) { - return 0; - } - -/* Find the unitized cross product of SPAN1 and SPAN2; this is our */ -/* unit normal vector, or possibly its inverse. */ - - ucrss_(span1, span2, plane); - if (vzero_(plane)) { - chkin_("PSV2PL", (ftnlen)6); - setmsg_("Spanning vectors are parallel.", (ftnlen)30); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("PSV2PL", (ftnlen)6); - return 0; - } - -/* Find the plane constant corresponding to the unit normal */ -/* vector we've found. */ - - plane[3] = vdot_(plane, point); - -/* The constant should be the distance of the plane from the */ -/* origin. If the constant is negative, negate both it and the */ -/* normal vector. */ - - if (plane[3] < 0.) { - plane[3] = -plane[3]; - vminus_(plane, tmpvec); - vequ_(tmpvec, plane); - } - return 0; -} /* psv2pl_ */ - diff --git a/ext/spice/src/cspice/psv2pl_c.c b/ext/spice/src/cspice/psv2pl_c.c deleted file mode 100644 index abd15f2864..0000000000 --- a/ext/spice/src/cspice/psv2pl_c.c +++ /dev/null @@ -1,222 +0,0 @@ -/* - --Procedure psv2pl_c ( Point and spanning vectors to plane ) - --Abstract - - Make a CSPICE plane from a point and two spanning vectors. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - -*/ - - #include "SpiceUsr.h" - #undef psv2pl_c - - - void psv2pl_c ( ConstSpiceDouble point[3], - ConstSpiceDouble span1[3], - ConstSpiceDouble span2[3], - SpicePlane * plane ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - point, - span1, - span2 I A point and two spanning vectors defining a plane. - plane O A CSPICE plane representing the plane. - --Detailed_Input - - point, - span1, - span2 are, respectively, a point and two spanning vectors - that define a geometric plane in three-dimensional - space. The plane is the set of vectors - - point + s * span1 + t * span2 - - where s and t are real numbers. The spanning - vectors span1 and span2 must be linearly - independent, but they need not be orthogonal or - unitized. - --Detailed_Output - - plane is a CSPICE plane that represents the geometric - plane defined by point, span1, and span2. - --Parameters - - None. - --Exceptions - - 1) If span1 and span2 are linearly dependent, then the vectors - point, span1, and span2 do not define a plane. The error - SPICE(DEGENERATECASE) is signaled. - --Files - - None. - --Particulars - - CSPICE geometry routines that deal with planes use the `plane' - data type to represent input and output planes. This data type - makes the subroutine interfaces simpler and more uniform. - - The CSPICE routines that produce CSPICE planes from data that - define a plane are: - - nvc2pl_c ( Normal vector and constant to plane ) - nvp2pl_c ( Normal vector and point to plane ) - psv2pl_c ( Point and spanning vectors to plane ) - - The CSPICE routines that convert CSPICE planes to data that - define a plane are: - - pl2nvc_c ( Plane to normal vector and constant ) - pl2nvp_c ( Plane to normal vector and point ) - pl2psv_c ( Plane to point and spanning vectors ) - - Any of these last three routines may be used to convert this - routine's output, plane, to another representation of a - geometric plane. - --Examples - - 1) Project a vector v orthogonally onto a plane defined by - point, span1, and span2. proj is the projection we want; it - is the closest vector in the plane to v. - - psv2pl_c ( point, span1, span2, &plane ); - vprjp_c ( v, &plane, proj ); - - - 2) Find the plane determined by a spacecraft's position vector - relative to a central body and the spacecraft's velocity - vector. We assume that all vectors are given in the same - coordinate system. - - /. - pos is the spacecraft's position, relative to - the central body. vel is the spacecraft's velocity - vector. pos is a point (vector, if you like) in - the orbit plane, and it is also one of the spanning - vectors of the plane. - ./ - psv2pl_c ( pos, pos, vel, &plane ); - - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - point and spanning vectors to plane - --& -*/ - -{ /* Begin psv2pl_c */ - - - - /* - This routine checks in only if an error is discovered. - */ - - if ( return_c () ) - { - return; - } - - /* - Find the unitized cross product of SPAN1 and SPAN2; this is our - unit normal vector, or possibly its inverse. - */ - ucrss_c ( span1, span2, plane->normal ); - - if ( vzero_c ( plane->normal ) ) - { - chkin_c ( "psv2pl_c" ); - setmsg_c ( "Spanning vectors are parallel." ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "psv2pl_c" ); - return; - } - - - /* - Find the plane constant corresponding to the unit normal - vector we've found. - */ - plane->constant = vdot_c ( plane->normal, point ); - - - /* - The constant should be the distance of the plane from the - origin. If the constant is negative, negate both it and the - normal vector. - */ - - if ( plane->constant < 0. ) - { - plane->constant = - (plane->constant); - - vminus_c ( plane->normal, plane->normal ); - } - - -} /* End psv2pl_c */ - diff --git a/ext/spice/src/cspice/putact.c b/ext/spice/src/cspice/putact.c deleted file mode 100644 index 778ff71058..0000000000 --- a/ext/spice/src/cspice/putact.c +++ /dev/null @@ -1,355 +0,0 @@ -/* putact.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PUTACT ( Store Error Response Action ) */ -/* Subroutine */ int putact_0_(int n__, integer *action) -{ - /* Initialized data */ - - static integer savact = 5; - -/* $ Abstract */ - -/* PUTACT is a low-level data structure access routine which */ -/* stores the error response action. DO NOT CALL THIS ROUTINE. */ -/* USE ERRACT, NOT PUTACT, TO SET THE CURRENT ERROR RESPONSE ACTION. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I The integer code for the error response action. */ - -/* $ Detailed_Input */ - -/* ACTION The new integer code for the error response action. */ -/* This code is saved for use by the error handling */ -/* system. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* This is a data structure access routine for the SPICELIB */ -/* error response action. This routine should be used for */ -/* no other purpose. In particular, it should not be used */ -/* by non-SPICELIB routines to set up an error response; */ -/* use ERRACT for that. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* Calls to this routine by routines other than the */ -/* SPICELIB error handling routines may interfere */ -/* with error processing. */ - -/* See the subroutine ERRACT for the definitions of the error */ -/* action codes. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the saved error action from a short character string */ -/* to an integer. This change is backwardly incompatible */ -/* because the type of the input argument has changed. This */ -/* should pose no difficulties because it is a private subroutine */ -/* used by the error handling system, and hence isolated from */ -/* direct use. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the saved error action from a short character string */ -/* to an integer. This change is backwardly incompatible */ -/* because the type of the input argument has changed. This */ -/* should pose no difficulties because it is a private subroutine */ -/* used by the error handling system, and hence isolated from */ -/* direct use. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* Local Prameters: */ - -/* Define the mnemonic for the default error action. */ - - -/* Local Variables: */ - -/* The current error response action: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_getact; - } - - -/* Executable Code: */ - - savact = *action; - return 0; -/* $Procedure GETACT ( Get Error Response Action ) */ - -L_getact: -/* $ Abstract */ - -/* Return the value of the current error response action. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* INTEGER ACTION */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* ACTION O The integer code for the error response action. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* ACTION is the integer code for the current error response */ -/* action. See the ERRACT subroutine and the "required */ -/* reading" file for a detailed discussion of error */ -/* response actions. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehrigner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the saved error action from a short character string */ -/* to an integer. This change is backwardly incompatible */ -/* because the type of the input argument has changed. This */ -/* should pose no difficulties because it is a private subroutine */ -/* used by the error handling system, and hence isolated from */ -/* direct use. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the saved error action from a short character string */ -/* to an integer. This change is backwardly incompatible */ -/* because the type of the input argument has changed. This */ -/* should pose no difficulties because it is a private subroutine */ -/* used by the error handling system, and hence isolated from */ -/* direct use. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* Executable Code: */ - - -/* Grab saved error response action: */ - - *action = savact; - return 0; -} /* putact_ */ - -/* Subroutine */ int putact_(integer *action) -{ - return putact_0_(0, action); - } - -/* Subroutine */ int getact_(integer *action) -{ - return putact_0_(1, action); - } - diff --git a/ext/spice/src/cspice/putcml_c.c b/ext/spice/src/cspice/putcml_c.c deleted file mode 100644 index 198d93c50b..0000000000 --- a/ext/spice/src/cspice/putcml_c.c +++ /dev/null @@ -1,177 +0,0 @@ -/* - --Procedure putcml_c ( Get the command line ) - --Abstract - - Store the contents of argv and argc for later access.. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - - void putcml_c ( SpiceInt argc, - SpiceChar ** argv ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - argc I The number of command line arguments. - argv I The vector of command line arguments. - --Detailed_Input - - argc is the number of command line arguments. - - argv is the vector of space delimited command line arguments. - Each entry entry contains one argument. argv[0] is the - command name. - - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - This routines participates in error tracing but detects no errors. - Error detection is done in zzgetcml_c.c - --Files - - None. - --Particulars - - This routine is a wrapper routine for the initialization call to - zzgetcml_c. The first call to zzgetcml_c stores the values of argv - and argc where subsequent calls, via getcml_c, retrieve the values. - --Examples - - #include - #include - - #include "SpiceUsr.h" - - void main( int argc, char *argv[] ) - { - - - /. Store argv and argc for latter access. ./ - - putcml_c ( argc, argv ); - - - ..... other stuff ..... - ..... ..... - - } - - - void goop () - { - ..... new module ..... - - SpiceInt argc; - SpiceChar ** argv; - - - ..... - ..... - - /. Now get the stored information. ./ - - getcml_c ( &argc, &argv ); - - } - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.2.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - Corrected previous version line. - - -CSPICE Version 1.1.0, 08-FEB-1998 (EDW) - - Routine rewritten to use private routine zzgetcml_c.c. - - -CSPICE Version 1.0.0, 14-JAN-1997 (EDW) - --Index_Entries - - store argc argv - --& -*/ - -{ - /* - 'zzgetcml_c' does all the real work. Make the call. The SPICETRUE - boolean indicates the call is comming from putcml_c.c and not - getcml_c.c - */ - - chkin_c( "putcml_c" ); - - zzgetcml_c ( &argc, &argv, SPICETRUE ); - - chkout_c( "putcml_c" ); - -} - diff --git a/ext/spice/src/cspice/putdev.c b/ext/spice/src/cspice/putdev.c deleted file mode 100644 index 7a666069c0..0000000000 --- a/ext/spice/src/cspice/putdev.c +++ /dev/null @@ -1,472 +0,0 @@ -/* putdev.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PUTDEV ( Store Error Output Device Specification ) */ -/* Subroutine */ int putdev_0_(int n__, char *device, ftnlen device_len) -{ - /* Initialized data */ - - static char savdev[255] = "SCREEN " - " " - " " - " " - " "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* PUTDEV is a low-level data structure access routine which stores */ -/* the error output device specification. DO NOT CALL THIS ROUTINE. */ -/* USE ERRDEV, NOT PUTDEV, TO CHOOSE THE ERROR OUTPUT DEVICE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DEVICE I The error output device specification. */ -/* FILEN P The maximum length of a file name. */ - -/* $ Detailed_Input */ - -/* DEVICE The new value of the error output device */ -/* specification. This value will be saved. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN The maximum length of a file name. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* This is a data structure access routine for the SPICELIB */ -/* error output device specification. This routine should */ -/* be used for no other purpose; in particular, it should */ -/* not be used by non-toolkit routines to specify the error */ -/* error output device to be used by the toolkit. Use ERRDEV */ -/* for that. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* Calls to this routine by routines other than the */ -/* SPICELIB error handling routines may interfere */ -/* with error processing. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 3.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 3.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 3.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 3.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 3.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 3.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 3.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 3.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 3.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 3.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 3.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 3.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 3.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 3.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 3.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.1.0, 5-JAN-1995 (HAN) */ - -/* Module was updated to include one declaration for */ -/* the variable FILEN for the Macintosh environment. */ - -/* - SPICELIB Version 2.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. Also, the previous value of 256 for */ -/* Unix platforms was changed to 255. */ - -/* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ - -/* Updated module for multiple environments. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. Parameters section added. */ -/* Parameter declarations moved to "Declarations" section. */ - -/* -& */ - -/* Local Variables: */ - - -/* The current error output device specification: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_getdev; - } - - -/* Executable Code: */ - - s_copy(savdev, device, (ftnlen)255, device_len); - return 0; -/* $Procedure GETDEV ( Get Error Output Device Specification ) */ - -L_getdev: -/* $ Abstract */ - -/* Return the value of the current error output device */ -/* specification. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) DEVICE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* DEVICE O The error output device specification. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* DEVICE is the current error output device specification. */ -/* See the "required reading" file for a detailed */ -/* discussion of the error output device. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ - -/* Executable Code: */ - - -/* Grab saved error output device specification: */ - - s_copy(device, savdev, device_len, (ftnlen)255); - return 0; -} /* putdev_ */ - -/* Subroutine */ int putdev_(char *device, ftnlen device_len) -{ - return putdev_0_(0, device, device_len); - } - -/* Subroutine */ int getdev_(char *device, ftnlen device_len) -{ - return putdev_0_(1, device, device_len); - } - diff --git a/ext/spice/src/cspice/putlms.c b/ext/spice/src/cspice/putlms.c deleted file mode 100644 index 36c4f41451..0000000000 --- a/ext/spice/src/cspice/putlms.c +++ /dev/null @@ -1,391 +0,0 @@ -/* putlms.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PUTLMS ( Store Long Error Message ) */ -/* Subroutine */ int putlms_0_(int n__, char *msg, ftnlen msg_len) -{ - /* Initialized data */ - - static char savmsg[1840] = " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* PUTLMS is a low-level data structure access routine which stores */ -/* the long error message. DO NOT CALL THIS ROUTINE. USE SETMSG, */ -/* NOT PUTLMS, TO SET THE CURRENT LONG ERROR MESSAGE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MSG I A long error message. */ - -/* $ Detailed_Input */ - -/* MSG The current long error message. This value will be saved. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* LMSGLN is the maximum length of the long error message. See */ -/* the include file errhnd.inc for the value of LMSGLN. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* This routine should be used only by routines within the SPICELIB */ -/* error handling system. Other routines should use SETMSG to set */ -/* the long error message. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* Calls to this routine by routines outside of the SPICELIB error */ -/* handling system may interfere with error processing. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* Local Variables: */ - - -/* The current long error message: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_getlms; - } - - -/* Executable Code: */ - - s_copy(savmsg, msg, (ftnlen)1840, msg_len); - return 0; -/* $Procedure GETLMS ( Get Long Error Message ) */ - -L_getlms: -/* $ Abstract */ - -/* Return the value of the current long error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) MSG */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* MSG O The current long error message. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* MSG is the current long error message. See the */ -/* "required reading" file for a detailed discussion */ -/* of error messages. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* See the required reading file for details of error */ -/* processing. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.2, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* -& */ - -/* Grab the saved long message: */ - - s_copy(msg, savmsg, msg_len, (ftnlen)1840); - return 0; -} /* putlms_ */ - -/* Subroutine */ int putlms_(char *msg, ftnlen msg_len) -{ - return putlms_0_(0, msg, msg_len); - } - -/* Subroutine */ int getlms_(char *msg, ftnlen msg_len) -{ - return putlms_0_(1, msg, msg_len); - } - diff --git a/ext/spice/src/cspice/putsms.c b/ext/spice/src/cspice/putsms.c deleted file mode 100644 index f4f90a9b6c..0000000000 --- a/ext/spice/src/cspice/putsms.c +++ /dev/null @@ -1,361 +0,0 @@ -/* putsms.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PUTSMS ( Store Short Error Message ) */ -/* Subroutine */ int putsms_0_(int n__, char *msg, ftnlen msg_len) -{ - /* Initialized data */ - - static char savmsg[25] = " "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* PUTSMS is a low-level data structure access routine which stores */ -/* the short error message. DO NOT CALL THIS ROUTINE. USE SIGERR, */ -/* NOT PUTSMS, TO SIGNAL ERRORS. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MSG I A short error message. */ - -/* $ Detailed_Input */ - -/* MSG The current short error message. This value will be saved. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* SMSGLN is the maximum length of the short error message. See */ -/* the include file errhnd.inc for the value of SMSGLN. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a data structure access routine for the */ -/* toolkit short error message. This routine should be */ -/* used for no other purpose; in particular, it should */ -/* not be used to signal errors. Use SIGERR for that. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* Calls to this routine by routines other than the */ -/* SPICELIB error handling routines may interfere */ -/* with error processing. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the short error message is now represented */ -/* by the parameter SMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the short error message is now represented */ -/* by the parameter SMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* Local Variables: */ - - -/* The current short error message: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_getsms; - } - - -/* Executable Code: */ - - s_copy(savmsg, msg, (ftnlen)25, msg_len); - return 0; -/* $Procedure GETSMS ( Get Short Error Message ) */ - -L_getsms: -/* $ Abstract */ - -/* Return the value of the current short error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) MSG */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* MSG O The current short error message. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* MSG is the current short error message. See the */ -/* "required reading" file for a detailed discussion */ -/* of error messages. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* See the required reading file for details of error processing. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the short error message is now represented */ -/* by the parameter SMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 29-JUL-1997 (NJB) */ - -/* Maximum length of the short error message is now represented */ -/* by the parameter SMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* -& */ - -/* Grab saved short message: */ - - s_copy(msg, savmsg, msg_len, (ftnlen)25); - return 0; -} /* putsms_ */ - -/* Subroutine */ int putsms_(char *msg, ftnlen msg_len) -{ - return putsms_0_(0, msg, msg_len); - } - -/* Subroutine */ int getsms_(char *msg, ftnlen msg_len) -{ - return putsms_0_(1, msg, msg_len); - } - diff --git a/ext/spice/src/cspice/pxform.c b/ext/spice/src/cspice/pxform.c deleted file mode 100644 index 0874d514b5..0000000000 --- a/ext/spice/src/cspice/pxform.c +++ /dev/null @@ -1,226 +0,0 @@ -/* pxform.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PXFORM ( Position Transformation Matrix ) */ -/* Subroutine */ int pxform_(char *from, char *to, doublereal *et, doublereal - *rotate, ftnlen from_len, ftnlen to_len) -{ - integer fcode; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tcode; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - refchg_(integer *, integer *, doublereal *, doublereal *), - namfrm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the matrix that transforms position vectors from one */ -/* specified frame to another at a specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FROM I Name of the frame to transform from. */ -/* TO I Name of the frame to transform to. */ -/* ET I Epoch of the rotation matrix. */ -/* ROTATE O A rotation matrix */ - -/* $ Detailed_Input */ - -/* FROM is the name of some reference frame in which */ -/* a position vector is known. */ - -/* TO is the name of a reference frame in which it */ -/* is desired to represent a position vector. */ - -/* ET is the epoch in ephemeris seconds past the epoch */ -/* of J2000 (TDB) at which the position transformation */ -/* matrix ROTATE should be evaluated. */ - -/* $ Detailed_Output */ - -/* ROTATE is the matrix that transforms position vectors from */ -/* the reference frame FROM to the frame TO at epoch ET. */ -/* If (x, y, z) is a position relative to the frame FROM */ -/* then the vector ( x', y', z') is the same position */ -/* relative to the frame TO at epoch ET. Here the */ -/* vector ( x', y', z' ) is defined by the equation: */ - -/* - - - - - - */ -/* | x' | | | | x | */ -/* | y' | | ROTATE | | y | */ -/* | z' | = | | | z | */ -/* - - - - - - */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If sufficient information has not been supplied via loaded */ -/* SPICE kernels to compute the transformation between the */ -/* two frames, the error will be diagnosed by a routine */ -/* in the call tree to this routine. */ - -/* 2) If either frame FROM or TO is not recognized the error */ -/* 'SPICE(UNKNOWNFRAME)' will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the user level interface to computing */ -/* position transformations from one reference frame to another. */ - -/* Note that the reference frames may be inertial or non-inertial. */ -/* However, the user must take care that sufficient SPICE kernel */ -/* information is loaded to provide a complete position */ -/* transformation path from the FROM frame to the TO frame. */ - -/* $ Examples */ - -/* Suppose that you have geodetic coordinates of a station on the */ -/* surface of the earth and that you need the inertial (J2000) */ -/* position of this station. The following code fragment */ -/* illustrates how to transform the position of the station to a */ -/* J2000 position. */ - -/* CALL BODVRD ( 'EARTH', RADII, 3, N, ABC ) */ - -/* EQUATR = ABC(1) */ -/* POLAR = ABC(3) */ -/* F = (EQUATR - POLAR) / EQUATR */ - -/* CALL GEOREC ( LONG, LAT, 0.0D0, EQUATR, F, EPOS ) */ - -/* CALL PXFORM ( 'IAU_EARTH', 'J2000', ET, ROTATE ) */ -/* CALL MXV ( ROTATE, EPOS, JPOS ) */ - -/* The state JPOS is the desired J2000 position of the station. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 27-FEB-2008 (BVS) */ - -/* Added FRAMES to the Required_Reading section. */ - -/* - SPICELIB Version 1.0.2, 23-OCT-2005 (NJB) */ - -/* Header example had invalid flattening factor computation; */ -/* this was corrected. Reference to BODVAR in header was */ -/* replaced with reference to BODVRD. */ - -/* - SPICELIB Version 1.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various header corrections were made. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Find a position transformation matrix */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("PXFORM", (ftnlen)6); - namfrm_(from, &fcode, from_len); - namfrm_(to, &tcode, to_len); - -/* Only non-zero id-codes are legitimate frame id-codes. Zero */ -/* indicates that the frame wasn't recognized. */ - - if (fcode != 0 && tcode != 0) { - refchg_(&fcode, &tcode, et, rotate); - } else if (fcode == 0 && tcode == 0) { - setmsg_("Neither of the frames # or # was recognized as a known refe" - "rence frame. ", (ftnlen)72); - errch_("#", from, (ftnlen)1, from_len); - errch_("#", to, (ftnlen)1, to_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - } else if (fcode == 0) { - setmsg_("The frame # was not recognized as a known reference frame. ", - (ftnlen)59); - errch_("#", from, (ftnlen)1, from_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - } else if (tcode == 0) { - setmsg_("The frame # was not recognized as a known reference frame. ", - (ftnlen)59); - errch_("#", to, (ftnlen)1, to_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - } - chkout_("PXFORM", (ftnlen)6); - return 0; -} /* pxform_ */ - diff --git a/ext/spice/src/cspice/pxform_c.c b/ext/spice/src/cspice/pxform_c.c deleted file mode 100644 index 960d4b238e..0000000000 --- a/ext/spice/src/cspice/pxform_c.c +++ /dev/null @@ -1,225 +0,0 @@ -/* - --Procedure pxform_c ( Position Transformation Matrix ) - --Abstract - - Return the matrix that transforms position vectors from one - specified frame to another at a specified epoch. - --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 - - FRAMES - --Keywords - - FRAMES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - void pxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble rotate[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - from I Name of the frame to transform from. - to I Name of the frame to transform to. - et I Epoch of the rotation matrix. - rotate O A rotation matrix. - --Detailed_Input - - from is the name of a reference frame in which a position - vector is known. - - to is the name of a reference frame in which it is desired - to represent a position vector. - - et is the epoch in ephemeris seconds past the epoch of - J2000 (TDB) at which the position transformation matrix - `rotate' should be evaluated. - --Detailed_Output - - rotate is the matrix that transforms position vectors from the - reference frame `from' to the frame `to' at epoch `et'. - If (x, y, z) is a position relative to the frame `from' - then the vector ( x', y', z') is the same position - relative to the frame `to' at epoch `et'. Here the - vector ( x', y', z' ) is defined by the equation: - - - - - - - - - | x' | | | | x | - | y' | = | rotate | | y | - | z' | | | | z | - - - - - - - --Parameters - - None. - --Exceptions - - 1) If sufficient information has not been supplied via loaded SPICE - kernels to compute the transformation between the two frames, the - error will be diagnosed by a routine in the call tree of this - routine. - - 2) If either frame `from' or `to' is not recognized the error - SPICE(UNKNOWNFRAME) will be signaled. - --Files - - None. - --Particulars - - This routine provides the user level interface to computing - position transformations from one reference frame to another. - - Note that the reference frames may be inertial or non-inertial. - However, the user must take care that sufficient SPICE kernel - information is loaded to provide a complete position - transformation path from the from frame to the to frame. - --Examples - - Suppose that you have geodetic coordinates of a station on the - surface of the earth and that you need the inertial (J2000) - position of this station. The following code fragment - illustrates how to transform the position of the station to a - J2000 position. - - #include "SpiceUsr.h" - . - . - . - bodvcd_c ( 399, radii, 3, &n, abc ); - - equatr = abc[0]; - polar = abc[2]; - f = ( equatr - polar ) / equatr; - - georec_c ( long, lat, 0.0, equatr, f, epos ); - pxform_c ( "IAU_EARTH", "J2000", et, rotate ); - mxv_c ( rotate, epos, jpos ); - - - The position jpos is the desired J2000 position of the station. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.4, 27-FEB-2008 (BVS) - - Added FRAMES to the Required_Reading section of the header. - - -CSPICE Version 1.0.3, 24-OCT-2005 (NJB) - - Header updates: example had invalid flattening factor - computation; this was corrected. Reference to bodvar_c was - replaced with reference to bodvcd_c. - - -CSPICE Version 1.0.2, 07-JAN-2004 (EDW) - - Trivial typo correction to example section. - - -CSPICE Version 1.0.1, 29-JUL-2003 (NJB) (CHA) - - Various header corrections were made. - - -CSPICE Version 1.0.0, 20-JUN-1999 (NJB) (WLT) - --Index_Entries - - Find a position transformation matrix - --& -*/ - -{ /* Begin pxform_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "pxform_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "pxform_c", from ); - CHKFSTR ( CHK_STANDARD, "pxform_c", to ); - - /* - Call the f2c'd routine. - */ - pxform_ ( ( char * ) from, - ( char * ) to, - ( doublereal * ) &et, - ( doublereal * ) rotate, - ( ftnlen ) strlen(from), - ( ftnlen ) strlen(to) ); - - - /* - Transpose the output to obtain row-major order. - */ - xpose_c ( rotate, rotate ); - - - chkout_c ( "pxform_c" ); - -} /* End pxform_c */ diff --git a/ext/spice/src/cspice/q2m.c b/ext/spice/src/cspice/q2m.c deleted file mode 100644 index d6ac5076e4..0000000000 --- a/ext/spice/src/cspice/q2m.c +++ /dev/null @@ -1,592 +0,0 @@ -/* q2m.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure Q2M ( Quaternion to matrix ) */ -/* Subroutine */ int q2m_(doublereal *q, doublereal *r__) -{ - doublereal l2, q01, q02, q03, q12, q13, q23, sharpn, q1s, q2s, q3s; - -/* $ Abstract */ - -/* Find the rotation matrix corresponding to a specified unit */ -/* quaternion. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATH */ -/* MATRIX */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* Q I A unit quaternion. */ -/* R O A rotation matrix corresponding to Q. */ - -/* $ Detailed_Input */ - -/* Q is a unit-length SPICE-style quaternion. Q has the */ -/* property that */ - -/* || Q || = 1 */ - -/* See the discussion of quaternion styles in */ -/* Particulars below. */ - -/* $ Detailed_Output */ - -/* R is a 3 by 3 rotation matrix representing the same */ -/* rotation as does Q. See the discussion titled */ -/* "Associating SPICE Quaternions with Rotation */ -/* Matrices" in Particulars below. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If Q is not a unit quaternion, the output matrix M is */ -/* the rotation matrix that is the result of converting */ -/* normalized Q to a rotation matrix. */ - -/* 2) If Q is the zero quaternion, the output matrix M is */ -/* the identity matrix. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If a 4-dimensional vector Q satisfies the equality */ - -/* || Q || = 1 */ - -/* or equivalently */ - -/* 2 2 2 2 */ -/* Q(0) + Q(1) + Q(2) + Q(3) = 1, */ - -/* then we can always find a unit vector A and a scalar r such that */ - -/* Q = ( cos(r/2), sin(r/2)A(1), sin(r/2)A(2), sin(r/2)A(3) ). */ - -/* We can interpret A and r as the axis and rotation angle of a */ -/* rotation in 3-space. If we restrict r to the range [0, pi], */ -/* then r and A are uniquely determined, except if r = pi. In this */ -/* special case, A and -A are both valid rotation axes. */ - -/* Every rotation is represented by a unique orthogonal matrix; this */ -/* routine returns that unique rotation matrix corresponding to Q. */ - -/* The SPICELIB routine M2Q is a one-sided inverse of this routine: */ -/* given any rotation matrix R, the calls */ - -/* CALL M2Q ( R, Q ) */ -/* CALL Q2M ( Q, R ) */ - -/* leave R unchanged, except for round-off error. However, the */ -/* calls */ - -/* CALL Q2M ( Q, R ) */ -/* CALL M2Q ( R, Q ) */ - -/* might preserve Q or convert Q to -Q. */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* 1) A case amenable to checking by hand calculation: */ - -/* To convert the quaternion */ - -/* Q = ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) */ - -/* to a rotation matrix, we can use the code fragment */ - -/* Q(0) = DSQRT(2)/2.D0 */ -/* Q(1) = 0.D0 */ -/* Q(2) = 0.D0 */ -/* Q(3) = -DSQRT(2)/2.D0 */ - -/* CALL Q2M ( Q, R ) */ - -/* The matrix R will be set equal to */ - -/* +- -+ */ -/* | 0 1 0 | */ -/* | | */ -/* | -1 0 0 |. */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - -/* Why? Well, Q represents a rotation by some angle r about */ -/* some axis vector A, where r and A satisfy */ - -/* Q = */ - -/* ( cos(r/2), sin(r/2)A(1), sin(r/2)A(2), sin(r/2)A(3) ). */ - -/* In this example, */ - -/* Q = ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ), */ - -/* so */ - -/* cos(r/2) = sqrt(2)/2. */ - -/* Assuming that r is in the interval [0, pi], we must have */ - -/* r = pi/2, */ - -/* so */ - -/* sin(r/2) = sqrt(2)/2. */ - -/* Since the second through fourth components of Q represent */ - -/* sin(r/2) * A, */ - -/* it follows that */ - -/* A = ( 0, 0, -1 ). */ - -/* So Q represents a transformation that rotates vectors by */ -/* pi/2 about the negative z-axis. This is equivalent to a */ -/* coordinate system rotation of pi/2 about the positive */ -/* z-axis; and we recognize R as the matrix */ - -/* [ pi/2 ] . */ -/* 3 */ - - -/* 2) Finding a set of Euler angles that represent a rotation */ -/* specified by a quaternion: */ - -/* Suppose our rotation R is represented by the quaternion */ -/* Q. To find angles TAU, ALPHA, DELTA such that */ - - -/* R = [ TAU ] [ pi/2 - DELTA ] [ ALPHA ] , */ -/* 3 2 3 */ - -/* we can use the code fragment */ - - -/* CALL Q2M ( Q, R ) */ - -/* CALL M2EUL ( R, 3, 2, 3, */ -/* . TAU, DELTA, ALPHA ) */ - -/* DELTA = HALFPI() - DELTA */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] NAIF document 179.0, "Rotations and their Habits", by */ -/* W. L. Taber. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.2, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* - SPICELIB Version 1.1.1, 13-JUN-2002 (FST) */ - -/* Updated the Exceptions section to clarify exceptions that */ -/* are the result of changes made in the previous version of */ -/* the routine. */ - -/* - SPICELIB Version 1.1.0, 04-MAR-1999 (WLT) */ - -/* Added code to handle the case in which the input quaternion */ -/* is not of length 1. */ - -/* - 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, 30-AUG-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* quaternion to matrix */ - -/* -& */ - -/* Local variables */ - - -/* If a matrix R represents a rotation of r radians about the unit */ -/* vector n, we know that R can be represented as */ - -/* 2 */ -/* I + sin(r) N + [ 1 - cos(r) ] N , */ - -/* where N is the matrix that satisfies */ - -/* Nv = n x v */ - -/* for all vectors v, namely */ - -/* +- -+ */ -/* | 0 -n n | */ -/* | 3 2 | */ -/* | | */ -/* N = | n 0 -n |. */ -/* | 3 1 | */ -/* | | */ -/* | -n n 0 | */ -/* | 2 1 | */ -/* +- -+ */ - - -/* Define S as */ - -/* sin(r/2) N, */ - -/* and let our input quaternion Q be */ - -/* ( q , q , q , q ). */ -/* 0 1 2 3 */ - -/* Using the facts that */ - -/* 2 */ -/* 1 - cos(r) = 2 sin (r/2) */ - -/* and */ - -/* sin(r) = 2 cos(r/2) sin(r/2), */ - - -/* we can express R as */ - -/* 2 */ -/* I + 2 cos(r/2) S + 2 S, */ - -/* or */ -/* 2 */ -/* I + 2 q S + 2 S. */ -/* 0 */ - -/* Since S is just */ - -/* +- -+ */ -/* | 0 -q q | */ -/* | 3 2 | */ -/* | | */ -/* | q 0 -q |, */ -/* | 3 1 | */ -/* | | */ -/* | -q q 0 | */ -/* | 2 1 | */ -/* +- -+ */ - -/* our expression for R comes out to */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2 ( q + q ) 2( q q - q q ) 2 ( q q + q q ) | */ -/* | 2 3 1 2 0 3 1 3 0 2 | */ -/* | | */ -/* | 2 2 | */ -/* | 2( q q + q q ) 1 - 2 ( q + q ) 2 ( q q - q q ) |. */ -/* | 1 2 0 3 1 3 2 3 0 1 | */ -/* | | */ -/* | 2 2 | */ -/* | 2( q q - q q ) 2 ( q q + q q ) 1 - 2 ( q + q ) | */ -/* | 1 3 0 2 2 3 0 1 1 2 | */ -/* +- -+ */ - - -/* For efficiency, we avoid duplicating calculations where possible. */ - - q01 = q[0] * q[1]; - q02 = q[0] * q[2]; - q03 = q[0] * q[3]; - q12 = q[1] * q[2]; - q13 = q[1] * q[3]; - q23 = q[2] * q[3]; - q1s = q[1] * q[1]; - q2s = q[2] * q[2]; - q3s = q[3] * q[3]; - -/* We sharpen the computation by effectively converting Q to */ -/* a unit quaternion if it isn't one already. */ - - l2 = q[0] * q[0] + q1s + q2s + q3s; - if (l2 != 1. && l2 != 0.) { - sharpn = 1. / l2; - q01 *= sharpn; - q02 *= sharpn; - q03 *= sharpn; - q12 *= sharpn; - q13 *= sharpn; - q23 *= sharpn; - q1s *= sharpn; - q2s *= sharpn; - q3s *= sharpn; - } - r__[0] = 1. - (q2s + q3s) * 2.; - r__[1] = (q12 + q03) * 2.; - r__[2] = (q13 - q02) * 2.; - r__[3] = (q12 - q03) * 2.; - r__[4] = 1. - (q1s + q3s) * 2.; - r__[5] = (q23 + q01) * 2.; - r__[6] = (q13 + q02) * 2.; - r__[7] = (q23 - q01) * 2.; - r__[8] = 1. - (q1s + q2s) * 2.; - return 0; -} /* q2m_ */ - diff --git a/ext/spice/src/cspice/q2m_c.c b/ext/spice/src/cspice/q2m_c.c deleted file mode 100644 index 1024a5711f..0000000000 --- a/ext/spice/src/cspice/q2m_c.c +++ /dev/null @@ -1,468 +0,0 @@ -/* - --Procedure q2m_c ( Quaternion to matrix ) - --Abstract - - Find the rotation matrix corresponding to a specified unit - quaternion. - --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 - - ROTATION - --Keywords - - MATH - MATRIX - ROTATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef q2m_c - - - void q2m_c ( ConstSpiceDouble q[4], - SpiceDouble r[3][3] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - q I A unit quaternion. - r O A rotation matrix corresponding to `q'. - --Detailed_Input - - q is a unit-length SPICE-style quaternion representing - a rotation. `q' has the property that - - || q || = 1 - - See the discussion of quaternion styles in - Particulars below. - --Detailed_Output - - r is a 3 by 3 rotation matrix representing the same - rotation as does `q'. See the discussion titled - "Associating SPICE Quaternions with Rotation - Matrices" in Particulars below. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If `q' is not a unit quaternion, the output matrix `r' is - unlikely to be a rotation matrix. - --Files - - None. - --Particulars - - If a 4-dimensional vector `q' satisfies the equality - - || q || = 1 - - or equivalently - - 2 2 2 2 - q(0) + q(1) + q(2) + q(3) = 1, - - then we can always find a unit vector `q' and a scalar `theta' such - that - - q = - - ( cos(theta/2), sin(theta/2)a(1), sin(theta/2)a(2), sin(theta/2)a(3) ) - - We can interpret `a' and `theta' as the axis and rotation angle of a - rotation in 3-space. If we restrict `theta' to the range [0, pi], - then `theta' and `a' are uniquely determined, except if theta = pi. - In this special case, `a' and -a are both valid rotation axes. - - Every rotation is represented by a unique orthogonal matrix; this - routine returns that unique rotation matrix corresponding to `q'. - - The CSPICE routine m2q_c is a one-sided inverse of this routine: - given any rotation matrix `r', the calls - - m2q_c ( r, q ) - q2m_c ( q, r ) - - leave `r' unchanged, except for round-off error. However, the - calls - - q2m_c ( q, r ) - m2q_c ( r, q ) - - might preserve `q' or convert `q' to -q. - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - - 1) A case amenable to checking by hand calculation: - - To convert the rotation matrix - - +- -+ - | 0 1 0 | - | | - r = | -1 0 0 | - | | - | 0 0 1 | - +- -+ - - also represented as - - [ pi/2 ] - 3 - - to a quaternion, we can use the code fragment - - rotate_c ( halfpi_c(), 3, r ); - m2q_c ( r, q ); - - m2q_c will return `q' as - - ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) - - Why? Well, `r' is a reference frame transformation that - rotates vectors by -pi/2 radians about the axis vector - - a = ( 0, 0, 1 ) - - Equivalently, `r' rotates vectors by pi/2 radians in - the counterclockwise sense about the axis vector - - -a = ( 0, 0, -1 ) - - so our definition of `q', - - h = theta/2 - - q = ( cos(h), sin(h)a , sin(h)a , sin(h)a ) - 1 2 3 - - implies that in this case, - - q = ( cos(pi/4), 0, 0, -sin(pi/4) ) - - = ( sqrt(2)/2, 0, 0, -sqrt(2)/2 ) - - - 2) Finding a set of Euler angles that represent a rotation - specified by a quaternion: - - Suppose our rotation `r' is represented by the quaternion - `q'. To find angles `tau', `alpha', `delta' such that - - - r = [ tau ] [ pi/2 - delta ] [ alpha ] - 3 2 3 - - we can use the code fragment - - - q2m_c ( q, r ); - m2eul_c ( r, 3, 2, 3, tau, delta, alpha ); - - delta = halfpi_c() - delta; - --Restrictions - - None. - --Literature_References - - [1] NAIF document 179.0, "Rotations and their Habits", by - W. L. Taber. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.3.2, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE quaternion - conventions. Made miscellaneous edits throughout header. - - -CSPICE Version 1.3.1, 06-FEB-2003 (EDW) - - Corrected typo error in Examples section. - - -CSPICE Version 1.3.0, 24-JUL-2001 (NJB) - - Changed prototype: input q is now type (ConstSpiceDouble [4]). - Implemented interface macro for casting input q to const. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Removed local variables used for temporary capture of outputs. - Removed tracing calls, since the underlying Fortran routine - is error-free. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - quaternion to matrix - --& -*/ - -{ /* Begin q2m_c */ - - - /* - Call the f2c'd version of q2m: - */ - q2m_ ( (doublereal *) q, - (doublereal *) r ); - - /* - Transpose the output matrix to put it in row-major order. - */ - xpose_c ( r, r ); - - -} /* End q2m_c */ diff --git a/ext/spice/src/cspice/qderiv.c b/ext/spice/src/cspice/qderiv.c deleted file mode 100644 index ed1ffbf1dd..0000000000 --- a/ext/spice/src/cspice/qderiv.c +++ /dev/null @@ -1,225 +0,0 @@ -/* qderiv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure QDERIV ( Quadratic derivative ) */ -/* Subroutine */ int qderiv_(integer *n, doublereal *f0, doublereal *f2, - doublereal *delta, doublereal *dfdt) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), vlcomg_(integer *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Estimate the derivative of a function by finding the derivative */ -/* of a quadratic approximating function. This derivative estimate */ -/* is equivalent to that found by computing the average of forward */ -/* and backward differences. */ - -/* $ 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 */ - -/* MATH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* N I Dimension of function to be differentiated. */ -/* F0 I Function values at left endpoint. */ -/* F2 I Function values at right endpoint. */ -/* DELTA I Separation of abscissa points. */ -/* DFDT O Derivative vector. */ - -/* $ Detailed_Input */ - -/* N is the dimension of the function to be */ -/* differentiated. The derivative of each */ -/* function component will be found. */ - -/* F0 is an array of N function values at a point on */ -/* the real line; we'll refer to this point as X0. */ - -/* F2 is an array of N function values at a second point */ -/* on the real line; we'll refer to this point as X2. */ -/* The points X0 and X2 must satisfy */ - -/* X2 = X0 + 2 * DELTA */ - - -/* DELTA is one half of the difference between X2 and X0: */ - -/* DELTA = ( X2 - X0 ) / 2 */ - -/* DELTA may be negative but must be non-zero. */ - -/* $ Detailed_Output */ - -/* DFDT is an N-dimensional vector representing an estimate */ -/* of the derivative of the input function at the */ -/* midpoint X1 of the interval between X0 and X2. */ - -/* The Ith component of DFDT is */ - -/* ( 1 / (2*DELTA) ) * ( F2(I) - F0(I) ) */ - -/* We may regard this estimate as the derivative */ -/* at X1 of a parabola fitted to the points */ - -/* ( X0, F0(I) ), ( X2, F2(I) ) */ - -/* We may also regard this derivative as the average */ -/* of the forward and backward first-order */ -/* differences of the input function defined by */ -/* F0(I), F2(I), and DELTA. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If DELTA is zero, the error SPICE(DIVIDEBYZERO) is signaled. */ - -/* 2) If N is less than 1, this routine will fail in a system- */ -/* dependent manner. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine estimates the derivative of a vector-valued function */ -/* using the average of forward and backward differences. */ - -/* The derivative estimate computed by this routine is equivalent to */ -/* that obtained by fitting each component of the function with a */ -/* parabola at the points */ - -/* (X0, F(X0)), (X1, F(X1)), (X2, F(X2)) */ - -/* where */ - -/* X0 = X1 - DELTA */ -/* X2 = X1 + DELTA */ - -/* and finding the derivative of the parabolas at X1. */ - -/* $ Examples */ - -/* 1) Estimate the derivative of x**2 at x = 2. */ - -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION DFDT (1) */ -/* DOUBLE PRECISION F0 (1) */ -/* DOUBLE PRECISION F2 (1) */ -/* INTEGER N */ - -/* N = 1 */ -/* DELTA = 1.D-3 */ -/* F0(1) = ( 2.D0 - DELTA ) ** 2.D0 */ -/* F2(1) = ( 2.D0 + DELTA ) ** 2.D0 */ - -/* CALL QDERIV ( N, F0, F2, DELTA, DFDT ) */ - -/* WRITE ( *, '(1X,A,E25.16)' ) '4 - DFDT(1) = ', 4 - DFDT(1) */ -/* END */ - -/* The difference displayed is platform-dependent, but */ -/* should be on the order of 1.E-12. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Estimate function derivative using quadratic fit */ - -/* -& */ - -/* Use discovery check-in. */ - - if (*delta == 0.) { - chkin_("QDERIV", (ftnlen)6); - setmsg_("Delta abscissa value is zero; a non-zero value is required.", - (ftnlen)59); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("QDERIV", (ftnlen)6); - return 0; - } - - -/* Our derivative estimate is */ - -/* 1/2 * ( Backward_difference / DELTA */ -/* + Forward_difference / DELTA ) */ - -/* = ( 1/(2*DELTA) ) * ( ( F(X2) - F(X1) ) + ( F(X1) - F(X0) ) */ - -/* = ( 1/(2*DELTA) ) * ( ( F(X2) - F(X0) ) */ - -/* = (0.5/DELTA) * F(X2) + (-0.5/DELTA) * F(X0) */ - - - d__1 = .5 / *delta; - d__2 = -.5 / *delta; - vlcomg_(n, &d__1, f2, &d__2, f0, dfdt); - return 0; -} /* qderiv_ */ - diff --git a/ext/spice/src/cspice/qdq2av.c b/ext/spice/src/cspice/qdq2av.c deleted file mode 100644 index 8c4625ba58..0000000000 --- a/ext/spice/src/cspice/qdq2av.c +++ /dev/null @@ -1,722 +0,0 @@ -/* qdq2av.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static doublereal c_b3 = -2.; - -/* $Procedure QDQ2AV (Quaternion and quaternion derivative to a.v.) */ -/* Subroutine */ int qdq2av_(doublereal *q, doublereal *dq, doublereal *av) -{ - doublereal qhat[4]; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ), vhatg_(doublereal *, integer *, doublereal *); - doublereal qtemp[4], qstar[4]; - extern /* Subroutine */ int vminus_(doublereal *, doublereal *), qxq_( - doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Derive angular velocity from a unit quaternion and its derivative */ -/* with respect to time. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATH */ -/* POINTING */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* Q I Unit SPICE quaternion. */ -/* DQ I Derivative of Q with respect to time. */ -/* AV O Angular velocity defined by Q and DQ. */ - -/* $ Detailed_Input */ - -/* Q is a unit length 4-vector representing a */ -/* SPICE-style quaternion. See the discussion of */ -/* quaternion styles in Particulars below. */ - -/* DQ is a 4-vector representing the derivative of */ -/* Q with respect to time. */ - -/* $ Detailed_Output */ - -/* AV is 3-vector representing the angular velocity */ -/* defined by Q and DQ, that is, the angular velocity */ -/* of the frame defined by the rotation matrix */ -/* associated with Q. This rotation matrix can be */ -/* obtained via the SPICELIB routine Q2M; see the */ -/* Particulars section for the explicit matrix */ -/* entries. */ - -/* AV is the vector (imaginary) part of the */ -/* quaternion product */ - -/* * */ -/* -2 * Q * DQ */ - -/* This angular velocity is the same vector that */ -/* could be obtained (much less efficiently ) by */ -/* mapping Q and DQ to the corresponding C-matrix R */ -/* and its derivative DR, then calling the SPICELIB */ -/* routine XF2RAV. */ - -/* AV has units of */ - -/* radians / T */ - -/* where */ - -/* 1 / T */ - -/* is the unit associated with DQ. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) A unitized version of input quaternion is used in the */ -/* computation. No attempt is made to diagnose an invalid */ -/* input quaternion. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* About this routine */ -/* ================== */ - -/* Given a time-dependent SPICE quaternion representing the */ -/* attitude of an object, we can obtain the object's angular */ -/* velocity AV in terms of the quaternion Q and its derivative */ -/* with respect to time DQ: */ - -/* * */ -/* AV = Im ( -2 * Q * DQ ) (1) */ - -/* That is, AV is the vector (imaginary) part of the product */ -/* on the right hand side (RHS) of equation (1). The scalar part */ -/* of the RHS is zero. */ - -/* We'll now provide an explanation of formula (1). For any */ -/* time-dependent rotation, the associated angular velocity at a */ -/* given time is a function of the rotation and its derivative at */ -/* that time. This fact enables us to extend a proof for a limited */ -/* subset of rotations to *all* rotations: if we find a formula */ -/* that, for any rotation in our subset, gives us the angular */ -/* velocity as a function of the rotation and its derivative, then */ -/* that formula must be true for all rotations. */ - -/* We start out by considering the set of rotation matrices */ - -/* R(t) = M(t)C (2) */ - -/* where C is a constant rotation matrix and M(t) represents a */ -/* matrix that "rotates" with constant, unit magnitude angular */ -/* velocity and that is equal to the identity matrix at t = 0. */ - -/* For future reference, we'll consider C to represent a coordinate */ -/* transformation from frame F1 to frame F2. We'll call F1 the */ -/* "base frame" of C. We'll let AVF2 be the angular velocity of */ -/* M(t) relative to F2 and AVF1 be the same angular velocity */ -/* relative to F1. */ - -/* Referring to the axis-and-angle decomposition of M(t) */ - -/* 2 */ -/* M(t) = I + sin(t)OMEGA + (1-cos(t))OMEGA (3) */ - -/* (see the Rotation Required Reading for a derivation) we */ -/* have */ - -/* d(M(t))| */ -/* -------| = OMEGA (4) */ -/* dt |t=0 */ - -/* Then the derivative of R(t) at t = 0 is given by */ - - -/* d(R(t))| */ -/* -------| = OMEGA * C (5) */ -/* dt |t=0 */ - - -/* The rotation axis A associated with OMEGA is defined by (6) */ - -/* A(1) = - OMEGA(2,3) */ -/* A(2) = OMEGA(1,3) */ -/* A(3) = - OMEGA(1,2) */ - -/* Since the coordinate system rotation M(t) rotates vectors about A */ -/* through angle t radians at time t, the angular velocity AVF2 of */ -/* M(t) is actually given by */ - -/* AVF2 = - A (7) */ - -/* This angular velocity is represented relative to the image */ -/* frame F2 associated with the coordinate transformation C. */ - -/* Now, let's proceed to the angular velocity formula for */ -/* quaternions. */ - -/* To avoid some verbiage, we'll freely use 3-vectors to represent */ -/* the corresponding pure imaginary quaternions. */ - -/* Letting QR(t), QM(t), and QC be quaternions representing the */ -/* time-dependent matrices R(t), M(t) and C respectively, where */ -/* QM(t) is selected to be a differentiable function of t in a */ -/* neighborhood of t = 0, the quaternion representing R(t) is */ - -/* QR(t) = QM(t) * QC (8) */ - -/* Differentiating with respect to t, then evaluating derivatives */ -/* at t = 0, we have */ - -/* d(QR(t))| d(QM(t))| */ -/* --------| = --------| * QC (9) */ -/* dt |t=0 dt |t=0 */ - - -/* Since QM(t) represents a rotation having axis A and rotation */ -/* angle t, then (according to the relationship between SPICE */ -/* quaternions and rotations set out in the Rotation Required */ -/* Reading), we see QM(t) must be the quaternion (represented as the */ -/* sum of scalar and vector parts): */ - -/* cos(t/2) + sin(t/2) * A (10) */ - -/* where A is the rotation axis corresponding to the matrix */ -/* OMEGA introduced in equation (3). By inspection */ - -/* d(QM(t))| */ -/* --------| = 1/2 * A (11) */ -/* dt |t=0 */ - -/* which is a quaternion with scalar part zero. This allows us to */ -/* rewrite the quaternion derivative */ - -/* d(QR(t))| */ -/* --------| = 1/2 * A * QC (12) */ -/* dt |t=0 */ - -/* or for short, */ - -/* DQ = 1/2 * A * QC (13) */ - -/* Since from (7) we know the angular velocity AVF2 of the frame */ -/* associated with QM(t) is the negative of the rotation axis */ -/* defined by (3), we have */ - -/* DQ = - 1/2 * AVF2 * QC (14) */ - -/* Since */ - -/* AVF2 = C * AVF1 (15) */ - -/* we can apply the quaternion transformation formula */ -/* (from the Rotation Required Reading) */ - -/* * */ -/* AVF2 = QC * AVF1 * QC (16) */ - -/* Now we re-write (15) as */ - -/* * */ -/* DQ = - 1/2 * ( QC * AVF1 * QC ) * QC */ - -/* = - 1/2 * QC * AVF1 (17) */ - -/* Then the angular velocity vector AVF1 is given by */ - -/* * */ -/* AVF1 = -2 * QC * DQ (18) */ - -/* The relation (18) has now been demonstrated for quaternions */ -/* having constant, unit magnitude angular velocity. But since */ -/* all time-dependent quaternions having value QC and derivative */ -/* DQ at a given time t have the same angular velocity at time t, */ -/* that angular velocity must be AVF1. */ - -/* $ Examples */ - -/* The following test program creates a quaternion and quaternion */ -/* derivative from a known rotation matrix and angular velocity */ -/* vector. The angular velocity is recovered from the quaternion */ -/* and quaternion derivative by calling QDQ2AV and by an */ -/* alternate method; the results are displayed for comparison. */ - -/* PROGRAM TQDQ2AV */ -/* IMPLICIT NONE */ -/* C */ -/* C Start with a known rotation and angular velocity. Find */ -/* C the quaternion and quaternion derivative. The latter is */ -/* C computed from */ -/* C */ -/* C * */ -/* C AV = -2 * Q * DQ */ -/* C */ -/* C DQ = -1/2 * Q * AV */ -/* C */ -/* C */ -/* C SPICELIB Functions */ -/* C */ -/* DOUBLE PRECISION RPD */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ANGLE ( 3 ) */ -/* DOUBLE PRECISION AV ( 3 ) */ -/* DOUBLE PRECISION AVX ( 3 ) */ -/* DOUBLE PRECISION DM ( 3, 3 ) */ -/* DOUBLE PRECISION DQ ( 0 : 3 ) */ -/* DOUBLE PRECISION EXPAV ( 3 ) */ -/* DOUBLE PRECISION M ( 3, 3 ) */ -/* DOUBLE PRECISION MOUT ( 3, 3 ) */ -/* DOUBLE PRECISION Q ( 0 : 3 ) */ -/* DOUBLE PRECISION QAV ( 0 : 3 ) */ -/* DOUBLE PRECISION XTRANS ( 6, 6 ) */ - -/* INTEGER I */ -/* INTEGER J */ - -/* C */ -/* C Pick some Euler angles and form a rotation matrix. */ -/* C */ -/* ANGLE(1) = -20.0 * RPD() */ -/* ANGLE(2) = 50.0 * RPD() */ -/* ANGLE(3) = -60.0 * RPD() */ - -/* CALL EUL2M ( ANGLE(3), ANGLE(2), ANGLE(1), 3, 1, 3, M ) */ - -/* CALL M2Q ( M, Q ) */ - -/* C */ -/* C Choose an angular velocity vector. */ -/* C */ -/* EXPAV(1) = 1.0D0 */ -/* EXPAV(2) = 2.0D0 */ -/* EXPAV(3) = 3.0D0 */ - -/* C */ -/* C Form the quaternion derivative. */ -/* C */ -/* QAV(0) = 0.D0 */ -/* CALL VEQU ( EXPAV, QAV(1) ) */ - -/* CALL QXQ ( Q, QAV, DQ ) */ - -/* CALL VSCLG ( -0.5D0, DQ, 4, DQ ) */ - -/* C */ -/* C Recover angular velocity from Q and DQ using QDQ2AV. */ -/* C */ -/* CALL QDQ2AV ( Q, DQ, AV ) */ - -/* C */ -/* C Now we'll obtain the angular velocity from Q and */ -/* C DQ by an alternate method. */ -/* C */ -/* C Convert Q back to a rotation matrix. */ -/* C */ -/* CALL Q2M ( Q, M ) */ - -/* C */ -/* C Convert Q and DQ to a rotation derivative matrix. This */ -/* C somewhat messy procedure is based on differentiating the */ -/* C formula for deriving a rotation from a quaternion, then */ -/* C substituting components of Q and DQ into the derivative */ -/* C formula. */ -/* C */ - -/* DM(1,1) = -4.D0 * ( Q(2)*DQ(2) + Q(3)*DQ(3) ) */ - -/* DM(1,2) = 2.D0 * ( Q(1)*DQ(2) + Q(2)*DQ(1) */ -/* . - Q(0)*DQ(3) - Q(3)*DQ(0) ) */ - -/* DM(1,3) = 2.D0 * ( Q(1)*DQ(3) + Q(3)*DQ(1) */ -/* . + Q(0)*DQ(2) + Q(2)*DQ(0) ) */ - -/* DM(2,1) = 2.D0 * ( Q(1)*DQ(2) + Q(2)*DQ(1) */ -/* . + Q(0)*DQ(3) + Q(3)*DQ(0) ) */ - -/* DM(2,2) = -4.D0 * ( Q(1)*DQ(1) + Q(3)*DQ(3) ) */ - -/* DM(2,3) = 2.D0 * ( Q(2)*DQ(3) + Q(3)*DQ(2) */ -/* . - Q(0)*DQ(1) - Q(1)*DQ(0) ) */ - -/* DM(3,1) = 2.D0 * ( Q(3)*DQ(1) + Q(1)*DQ(3) */ -/* . - Q(0)*DQ(2) - Q(2)*DQ(0) ) */ - -/* DM(3,2) = 2.D0 * ( Q(2)*DQ(3) + Q(3)*DQ(2) */ -/* . + Q(0)*DQ(1) + Q(1)*DQ(0) ) */ - -/* DM(3,3) = -4.D0 * ( Q(1)*DQ(1) + Q(2)*DQ(2) ) */ - -/* C */ -/* C Form the state transformation matrix corresponding to M */ -/* C and DM. */ - -/* CALL CLEARD ( 36, XTRANS ) */ - -/* C */ -/* C Upper left block: */ -/* C */ -/* DO I = 1, 3 */ - -/* DO J = 1, 3 */ -/* XTRANS(I,J) = M(I,J) */ -/* END DO */ - -/* END DO */ - - -/* C */ -/* C Lower right block: */ -/* C */ -/* DO I = 1, 3 */ - -/* DO J = 1, 3 */ -/* XTRANS(3+I,3+J) = M(I,J) */ -/* END DO */ - -/* END DO */ - -/* C */ -/* C Lower left block: */ -/* C */ -/* DO I = 1, 3 */ - -/* DO J = 1, 3 */ -/* XTRANS(3+I,J) = DM(I,J) */ -/* END DO */ - -/* END DO */ - -/* C */ -/* C Now use XF2RAV to produce the expected angular velocity. */ -/* C */ -/* CALL XF2RAV ( XTRANS, MOUT, AVX ) */ - -/* C */ -/* C The results should match to nearly full double */ -/* C precision. */ -/* C */ -/* WRITE(*,*) 'Original angular velocity: ', EXPAV */ -/* WRITE(*,*) 'QDQ2AV''s angular velocity: ', AV */ -/* WRITE(*,*) 'XF2RAV''s angular velocity: ', AVX */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - SPICELIB Version 1.0.1, 24-FEB-2004 (NJB) */ - -/* Made minor edits to the Particulars header section. */ - -/* - SPICELIB Version 1.0.0, 26-AUG-2002 (NJB) */ - - -/* -& */ -/* $ Index_Entries */ - -/* angular velocity from quaternion and derivative */ -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* -& */ - -/* Local variables */ - - -/* Get a unitized copy of the input quaternion. */ - - vhatg_(q, &c__4, qhat); - -/* Get the conjugate QSTAR of QHAT. */ - - qstar[0] = qhat[0]; - vminus_(&qhat[1], &qstar[1]); - -/* Compute the angular velocity via the relationship */ - -/* * */ -/* AV = -2 * Q * DQ */ - - qxq_(qstar, dq, qtemp); - vscl_(&c_b3, &qtemp[1], av); - return 0; -} /* qdq2av_ */ - diff --git a/ext/spice/src/cspice/qdq2av_c.c b/ext/spice/src/cspice/qdq2av_c.c deleted file mode 100644 index d926c0547f..0000000000 --- a/ext/spice/src/cspice/qdq2av_c.c +++ /dev/null @@ -1,717 +0,0 @@ -/* - --Procedure qdq2av_c (Quaternion and quaternion derivative to a.v.) - --Abstract - - Derive angular velocity from a unit quaternion and its derivative - with respect to time. - --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 - - ROTATION - --Keywords - - MATH - POINTING - ROTATION - -*/ - - #include "SpiceUsr.h" - #undef qdq2av_c - - - void qdq2av_c ( ConstSpiceDouble q [4], - ConstSpiceDouble dq [4], - SpiceDouble av [3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - q I Unit SPICE quaternion. - dq I Derivative of `q' with respect to time. - av O Angular velocity defined by `q' and `dq'. - --Detailed_Input - - q is a unit length 4-vector representing a SPICE-style - quaternion. See the discussion of "Quaternion Styles" - in the Particulars section below. - - Note that multiple styles of quaternions are in use. - This routine will not work properly if the input - quaternions do not conform to the SPICE convention. - See the Particulars section for details. - - - dq is a 4-vector representing the derivative of `q' with - respect to time. - --Detailed_Output - - av is 3-vector representing the angular velocity defined - by `q' and `dq', that is, the angular velocity of the - frame defined by the rotation matrix associated with - `q'. This rotation matrix can be obtained via the - CSPICE routine q2m_c; see the Particulars section for - the explicit matrix entries. - - `av' is the vector (imaginary) part of the quaternion - product - - * - -2 * q * dq - - This angular velocity is the same vector that could - be obtained (much less efficiently ) by mapping `q' - and `dq' to the corresponding C-matrix `r' and its - derivative `dr', then calling the CSPICE routine - xf2rav_c. - - `av' has units of - - radians / T - - where - - 1 / T - - is the unit associated with `dq'. - --Parameters - - None. - --Exceptions - - Error free. - - 1) A unitized version of input quaternion is used in the - computation. No attempt is made to diagnose an invalid - input quaternion. - --Files - - None. - --Particulars - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - - About this routine - ================== - - Given a time-dependent SPICE quaternion representing the - attitude of an object, we can obtain the object's angular - velocity AV in terms of the quaternion Q and its derivative - with respect to time DQ: - - * - AV = Im ( -2 * Q * DQ ) (1) - - That is, AV is the vector (imaginary) part of the product - on the right hand side (RHS) of equation (1). The scalar part - of the RHS is zero. - - We'll now provide an explanation of formula (1). For any - time-dependent rotation, the associated angular velocity at a - given time is a function of the rotation and its derivative at - that time. This fact enables us to extend a proof for a limited - subset of rotations to *all* rotations: if we find a formula - that, for any rotation in our subset, gives us the angular - velocity as a function of the rotation and its derivative, then - that formula must be true for all rotations. - - We start out by considering the set of rotation matrices - - R(t) = M(t)C (2) - - where C is a constant rotation matrix and M(t) represents a - matrix that "rotates" with constant, unit magnitude angular - velocity and that is equal to the identity matrix at t = 0. - - For future reference, we'll consider C to represent a coordinate - transformation from frame F1 to frame F2. We'll call F1 the - "base frame" of C. We'll let AVF2 be the angular velocity of - M(t) relative to F2 and AVF1 be the same angular velocity - relative to F1. - - Referring to the axis-and-angle decomposition of M(t) - - 2 - M(t) = I + sin(t)OMEGA + (1-cos(t))OMEGA (3) - - (see the Rotation Required Reading for a derivation) we - have - - d(M(t))| - -------| = OMEGA (4) - dt |t=0 - - Then the derivative of R(t) at t = 0 is given by - - - d(R(t))| - -------| = OMEGA * C (5) - dt |t=0 - - - The rotation axis A associated with OMEGA is defined by (6) - - A(1) = - OMEGA(2,3) - A(2) = OMEGA(1,3) - A(3) = - OMEGA(1,2) - - Since the coordinate system rotation M(t) rotates vectors about A - through angle t radians at time t, the angular velocity AVF2 of - M(t) is actually given by - - AVF2 = - A (7) - - This angular velocity is represented relative to the image - frame F2 associated with the coordinate transformation C. - - Now, let's proceed to the angular velocity formula for - quaternions. - - To avoid some verbiage, we'll freely use 3-vectors to represent - the corresponding pure imaginary quaternions. - - Letting QR(t), QM(t), and QC be quaternions representing the - time-dependent matrices R(t), M(t) and C respectively, where - QM(t) is selected to be a differentiable function of t in a - neighborhood of t = 0, the quaternion representing R(t) is - - QR(t) = QM(t) * QC (8) - - Differentiating with respect to t, then evaluating derivatives - at t = 0, we have - - d(QR(t))| d(QM(t))| - --------| = --------| * QC (9) - dt |t=0 dt |t=0 - - - Since QM(t) represents a rotation having axis A and rotation - angle t, then (according to the relationship between SPICE - quaternions and rotations set out in the Rotation Required - Reading), we see QM(t) must be the quaternion (represented as the - sum of scalar and vector parts): - - cos(t/2) + sin(t/2) * A (10) - - where A is the rotation axis corresponding to the matrix - OMEGA introduced in equation (3). By inspection - - d(QM(t))| - --------| = 1/2 * A (11) - dt |t=0 - - which is a quaternion with scalar part zero. This allows us to - rewrite the quaternion derivative - - d(QR(t))| - --------| = 1/2 * A * QC (12) - dt |t=0 - - or for short, - - DQ = 1/2 * A * QC (13) - - Since from (7) we know the angular velocity AVF2 of the frame - associated with QM(t) is the negative of the rotation axis - defined by (3), we have - - DQ = - 1/2 * AVF2 * QC (14) - - Since - - AVF2 = C * AVF1 (15) - - we can apply the quaternion transformation formula - (from the Rotation Required Reading) - - * - AVF2 = QC * AVF1 * QC (16) - - Now we re-write (15) as - - * - DQ = - 1/2 * ( QC * AVF1 * QC ) * QC - - = - 1/2 * QC * AVF1 (17) - - Then the angular velocity vector AVF1 is given by - - * - AVF1 = -2 * QC * DQ (18) - - The relation (18) has now been demonstrated for quaternions - having constant, unit magnitude angular velocity. But since - all time-dependent quaternions having value QC and derivative - DQ at a given time t have the same angular velocity at time t, - that angular velocity must be AVF1. - --Examples - - The following test program creates a quaternion and quaternion - derivative from a known rotation matrix and angular velocity - vector. The angular velocity is recovered from the quaternion - and quaternion derivative by calling qdq2av_c and by an - alternate method; the results are displayed for comparison. - - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - int main() - { - /. - Local constants - ./ - - /. - Local variables - ./ - SpiceDouble angle [3]; - SpiceDouble av [3]; - SpiceDouble avx [3]; - SpiceDouble dm [3][3]; - SpiceDouble dq [4]; - SpiceDouble expav [3]; - SpiceDouble m [3][3]; - SpiceDouble mout [3][3]; - SpiceDouble q [4]; - SpiceDouble qav [4]; - SpiceDouble xtrans [6][6]; - - SpiceInt i; - - /. - Pick some Euler angles and form a rotation matrix. - ./ - angle[0] = -20.0 * rpd_c(); - angle[1] = 50.0 * rpd_c(); - angle[2] = -60.0 * rpd_c(); - - eul2m_c ( angle[2], angle[1], angle[0], 3, 1, 3, m ); - - m2q_c ( m, q ); - - /. - Choose an angular velocity vector. - ./ - expav[0] = 1.0; - expav[1] = 2.0; - expav[2] = 3.0; - - /. - Form the quaternion derivative. - ./ - qav[0] = 0.0; - vequ_c ( expav, qav+1 ); - - qxq_c ( q, qav, dq ); - - vsclg_c ( -0.5, dq, 4, dq ); - - /. - Recover angular velocity from `q' and `dq' using qdq2av_c. - ./ - qdq2av_c ( q, dq, av ); - - /. - Now we'll obtain the angular velocity from `q' and - `dq' by an alternate method. - - Convert `q' back to a rotation matrix. - ./ - q2m_c ( q, m ); - - /. - Convert `q' and `dq' to a rotation derivative matrix. This - somewhat messy procedure is based on differentiating the - formula for deriving a rotation from a quaternion, then - substituting components of `q' and `dq' into the derivative - formula. - ./ - - dm[0][0] = -4.0 * ( q[2]*dq[2] + q[3]*dq[3] ); - - dm[0][1] = 2.0 * ( q[1]*dq[2] + q[2]*dq[1] - - q[0]*dq[3] - q[3]*dq[0] ); - - dm[0][2] = 2.0 * ( q[1]*dq[3] + q[3]*dq[1] - + q[0]*dq[2] + q[2]*dq[0] ); - - dm[1][0] = 2.0 * ( q[1]*dq[2] + q[2]*dq[1] - + q[0]*dq[3] + q[3]*dq[0] ); - - dm[1][1] = -4.0 * ( q[1]*dq[1] + q[3]*dq[3] ); - - dm[1][2] = 2.0 * ( q[2]*dq[3] + q[3]*dq[2] - - q[0]*dq[1] - q[1]*dq[0] ); - - dm[2][0] = 2.0 * ( q[3]*dq[1] + q[1]*dq[3] - - q[0]*dq[2] - q[2]*dq[0] ); - - dm[2][1] = 2.0 * ( q[2]*dq[3] + q[3]*dq[2] - + q[0]*dq[1] + q[1]*dq[0] ); - - dm[2][2] = -4.0 * ( q[1]*dq[1] + q[2]*dq[2] ); - - /. - Form the state transformation matrix corresponding to `m' - and `dm'. - ./ - - /. - Upper left block: - ./ - for ( i = 0; i < 3; i++ ) - { - vequ_c ( m[i], xtrans[i] ); - } - - /. - Upper right block: - ./ - for ( i = 0; i < 3; i++ ) - { - vpack_c ( 0.0, 0.0, 0.0, xtrans[i]+3 ); - } - - /. - Lower left block: - ./ - for ( i = 0; i < 3; i++ ) - { - vequ_c ( dm[i], xtrans[3+i] ); - } - - /. - Lower right block: - ./ - for ( i = 0; i < 3; i++ ) - { - vequ_c ( m[i], xtrans[3+i]+3 ); - } - - /. - Now use xf2rav_c to produce the expected angular velocity. - ./ - xf2rav_c ( xtrans, mout, avx ); - - /. - The results should match to nearly full double precision. - ./ - printf ( "Original angular velocity: \n" - " %24.16e, %24.16e, %24.16e \n" - "qdq2av_c's angular velocity: \n" - " %24.16e, %24.16e, %24.16e \n" - "xf2rav's angular velocity: \n" - " %24.16e, %24.16e, %24.16e \n", - expav[0], expav[1], expav[2], - av [0], av [1], av [2], - avx [0], avx [1], avx [2] ); - - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. - - -CSPICE Version 1.0.0, 31-OCT-2005 (NJB) - --Index_Entries - - angular velocity from quaternion and derivative --& -*/ - -{ /* Begin qdq2av_c */ - - /* - Local variables - */ - SpiceDouble qhat [4]; - SpiceDouble qstar [4]; - SpiceDouble qtemp [4]; - - /* - This routine is error free. - */ - - - /* - Get a unitized copy of the input quaternion. - */ - vhatg_c ( q, 4, qhat ); - - - /* - Get the conjugate `qstar' of `qhat'. - */ - qstar[0] = qhat[0]; - - vminus_c ( qhat+1, qstar+1 ); - - - /* - Compute the angular velocity via the relationship - - * - av = -2 * q * dq - - */ - qxq_c ( qstar, dq, qtemp ); - vequ_c ( qtemp+1, av ); - vscl_c ( -2.0, av, av ); - - -} /* End qdq2av_c */ diff --git a/ext/spice/src/cspice/quote.c b/ext/spice/src/cspice/quote.c deleted file mode 100644 index 381855f3e4..0000000000 --- a/ext/spice/src/cspice/quote.c +++ /dev/null @@ -1,183 +0,0 @@ -/* quote.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure QUOTE ( Enclose in quotes ) */ -/* Subroutine */ int quote_(char *in, char *left, char *right, char *out, - ftnlen in_len, ftnlen left_len, ftnlen right_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen); - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Enclose (quote) the non-blank part of a character string */ -/* between delimiting symbols. */ - -/* $ 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 */ - -/* CHARACTER, PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* LEFT I Left delimiter. */ -/* RIGHT I Right delimiter. */ -/* OUT O Output (quoted) string. */ - -/* $ Detailed_Input */ - -/* IN is the input string to be quoted. */ - -/* LEFT, */ -/* RIGHT are the left and right delimiters to be used in */ -/* quoting the input string. These may be the same */ -/* character (apostrophe, vertical bar), complementary */ -/* characters (left and right parentheses, brackets, */ -/* or braces), or two totally unrelated characters. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is the non-blank part */ -/* of the input string delimited by LEFT and RIGHT. */ -/* If the output string is not large enough to contain */ -/* the quoted string, it is truncated on the right. */ -/* (The right delimiter would be lost in this case.) */ - -/* If the input string is blank, the output string is */ -/* a single quoted blank. */ - -/* OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The first character of the output string is the left delimiter, */ -/* LEFT. This is followed immediately by the non-blank part of the */ -/* input string, which is in turn followed by the right delimiter, */ -/* RIGHT. */ - -/* If the input string is blank (has no non-blank characters), */ -/* a single quoted blank is returned. */ - -/* $ Examples */ - -/* Let */ -/* IN = ' This string has leading and trailing blanks ' */ -/* LEFT = '(' */ -/* RIGHT = ')' */ - -/* Then */ -/* OUT = '(This string has leading and trailing blanks) ' */ - -/* Or, let IN = ' '. Then OUT = '( )'. */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* enclose in quotes */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Check for blank string first. */ - - if (s_cmp(in, " ", in_len, (ftnlen)1) == 0) { - s_copy(out, left, out_len, (ftnlen)1); - suffix_(right, &c__1, out, (ftnlen)1, out_len); - } else { - i__1 = frstnb_(in, in_len) - 1; - s_copy(out, in + i__1, out_len, lastnb_(in, in_len) - i__1); - prefix_(left, &c__0, out, (ftnlen)1, out_len); - suffix_(right, &c__0, out, (ftnlen)1, out_len); - } - return 0; -} /* quote_ */ - diff --git a/ext/spice/src/cspice/qxq.c b/ext/spice/src/cspice/qxq.c deleted file mode 100644 index c379a9bce5..0000000000 --- a/ext/spice/src/cspice/qxq.c +++ /dev/null @@ -1,441 +0,0 @@ -/* qxq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b2 = 1.; - -/* $Procedure QXQ (Quaternion times quaternion) */ -/* Subroutine */ int qxq_(doublereal *q1, doublereal *q2, doublereal *qout) -{ - extern doublereal vdot_(doublereal *, doublereal *); - doublereal cross[3]; - extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal - *), vlcom3_(doublereal *, doublereal *, doublereal *, doublereal * - , doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Multiply two quaternions. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* MATH */ -/* POINTING */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* Q1 I First SPICE quaternion factor. */ -/* Q2 I Second SPICE quaternion factor. */ -/* QOUT O Product of Q1 and Q2. */ - -/* $ Detailed_Input */ - -/* Q1 is a 4-vector representing a SPICE-style */ -/* quaternion. See the discussion of quaternion */ -/* styles in Particulars below. */ - -/* Note that multiple styles of quaternions */ -/* are in use. This routine will not work properly */ -/* if the input quaternions do not conform to */ -/* the SPICE convention. See the Particulars */ -/* section for details. */ - -/* Q2 is a second SPICE-style quaternion. */ - -/* $ Detailed_Output */ - -/* QOUT is 4-vector representing the quaternion product */ - -/* Q1 * Q2 */ - -/* Representing Q(i) as the sums of scalar (real) */ -/* part s(i) and vector (imaginary) part v(i) */ -/* respectively, */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* QOUT has scalar part s3 defined by */ - -/* s3 = s1 * s2 - */ - -/* and vector part v3 defined by */ - -/* v3 = s1 * v2 + s2 * v1 + v1 x v2 */ - -/* where the notation < , > denotes the inner */ -/* product operator and x indicates the cross */ -/* product operator. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - - -/* Quaternion Styles */ -/* ----------------- */ - -/* There are different "styles" of quaternions used in */ -/* science and engineering applications. Quaternion styles */ -/* are characterized by */ - -/* - The order of quaternion elements */ - -/* - The quaternion multiplication formula */ - -/* - The convention for associating quaternions */ -/* with rotation matrices */ - -/* Two of the commonly used styles are */ - -/* - "SPICE" */ - -/* > Invented by Sir William Rowan Hamilton */ -/* > Frequently used in mathematics and physics textbooks */ - -/* - "Engineering" */ - -/* > Widely used in aerospace engineering applications */ - - -/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ -/* Quaternions of any other style must be converted to SPICE */ -/* quaternions before they are passed to SPICELIB routines. */ - - -/* Relationship between SPICE and Engineering Quaternions */ -/* ------------------------------------------------------ */ - -/* Let M be a rotation matrix such that for any vector V, */ - -/* M*V */ - -/* is the result of rotating V by theta radians in the */ -/* counterclockwise direction about unit rotation axis vector A. */ -/* Then the SPICE quaternions representing M are */ - -/* (+/-) ( cos(theta/2), */ -/* sin(theta/2) A(1), */ -/* sin(theta/2) A(2), */ -/* sin(theta/2) A(3) ) */ - -/* while the engineering quaternions representing M are */ - -/* (+/-) ( -sin(theta/2) A(1), */ -/* -sin(theta/2) A(2), */ -/* -sin(theta/2) A(3), */ -/* cos(theta/2) ) */ - -/* For both styles of quaternions, if a quaternion q represents */ -/* a rotation matrix M, then -q represents M as well. */ - -/* Given an engineering quaternion */ - -/* QENG = ( q0, q1, q2, q3 ) */ - -/* the equivalent SPICE quaternion is */ - -/* QSPICE = ( q3, -q0, -q1, -q2 ) */ - - -/* Associating SPICE Quaternions with Rotation Matrices */ -/* ---------------------------------------------------- */ - -/* Let FROM and TO be two right-handed reference frames, for */ -/* example, an inertial frame and a spacecraft-fixed frame. Let the */ -/* symbols */ - -/* V , V */ -/* FROM TO */ - -/* denote, respectively, an arbitrary vector expressed relative to */ -/* the FROM and TO frames. Let M denote the transformation matrix */ -/* that transforms vectors from frame FROM to frame TO; then */ - -/* V = M * V */ -/* TO FROM */ - -/* where the expression on the right hand side represents left */ -/* multiplication of the vector by the matrix. */ - -/* Then if the unit-length SPICE quaternion q represents M, where */ - -/* q = (q0, q1, q2, q3) */ - -/* the elements of M are derived from the elements of q as follows: */ - -/* +- -+ */ -/* | 2 2 | */ -/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ -/* | | */ -/* | | */ -/* | 2 2 | */ -/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ -/* | | */ -/* +- -+ */ - -/* Note that substituting the elements of -q for those of q in the */ -/* right hand side leaves each element of M unchanged; this shows */ -/* that if a quaternion q represents a matrix M, then so does the */ -/* quaternion -q. */ - -/* To map the rotation matrix M to a unit quaternion, we start by */ -/* decomposing the rotation matrix as a sum of symmetric */ -/* and skew-symmetric parts: */ - -/* 2 */ -/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ - -/* symmetric skew-symmetric */ - - -/* OMEGA is a skew-symmetric matrix of the form */ - -/* +- -+ */ -/* | 0 -n3 n2 | */ -/* | | */ -/* OMEGA = | n3 0 -n1 | */ -/* | | */ -/* | -n2 n1 0 | */ -/* +- -+ */ - -/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ -/* of M and theta is M's rotation angle. Note that N and theta */ -/* are not unique. */ - -/* Let */ - -/* C = cos(theta/2) */ -/* S = sin(theta/2) */ - -/* Then the unit quaternions Q corresponding to M are */ - -/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ - -/* The mappings between quaternions and the corresponding rotations */ -/* are carried out by the SPICELIB routines */ - -/* Q2M {quaternion to matrix} */ -/* M2Q {matrix to quaternion} */ - -/* M2Q always returns a quaternion with scalar part greater than */ -/* or equal to zero. */ - - -/* SPICE Quaternion Multiplication Formula */ -/* --------------------------------------- */ - -/* Given a SPICE quaternion */ - -/* Q = ( q0, q1, q2, q3 ) */ - -/* corresponding to rotation axis A and angle theta as above, we can */ -/* represent Q using "scalar + vector" notation as follows: */ - -/* s = q0 = cos(theta/2) */ - -/* v = ( q1, q2, q3 ) = sin(theta/2) * A */ - -/* Q = s + v */ - -/* Let Q1 and Q2 be SPICE quaternions with respective scalar */ -/* and vector parts s1, s2 and v1, v2: */ - -/* Q1 = s1 + v1 */ -/* Q2 = s2 + v2 */ - -/* We represent the dot product of v1 and v2 by */ - -/* */ - -/* and the cross product of v1 and v2 by */ - -/* v1 x v2 */ - -/* Then the SPICE quaternion product is */ - -/* Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) */ - -/* If Q1 and Q2 represent the rotation matrices M1 and M2 */ -/* respectively, then the quaternion product */ - -/* Q1*Q2 */ - -/* represents the matrix product */ - -/* M1*M2 */ - - -/* $ Examples */ - -/* 1) Let QID, QI, QJ, QK be the "basis" quaternions */ - -/* QID = ( 1, 0, 0, 0 ) */ -/* QI = ( 0, 1, 0, 0 ) */ -/* QJ = ( 0, 0, 1, 0 ) */ -/* QK = ( 0, 0, 0, 1 ) */ - -/* respectively. Then the calls */ - -/* CALL QXQ ( QI, QJ, IXJ ) */ -/* CALL QXQ ( QJ, QK, JXK ) */ -/* CALL QXQ ( QK, QI, KXI ) */ - -/* produce the results */ - -/* IXJ = QK */ -/* JXK = QI */ -/* KXI = QJ */ - -/* All of the calls */ - -/* CALL QXQ ( QI, QI, QOUT ) */ -/* CALL QXQ ( QJ, QJ, QOUT ) */ -/* CALL QXQ ( QK, QK, QOUT ) */ - -/* produce the result */ - -/* QOUT = -QID */ - -/* For any quaternion Q, the calls */ - -/* CALL QXQ ( QID, Q, QOUT ) */ -/* CALL QXQ ( Q, QID, QOUT ) */ - -/* produce the result */ - -/* QOUT = Q */ - - - -/* 2) Composition of rotations: let CMAT1 and CMAT2 be two */ -/* C-matrices (which are rotation matrices). Then the */ -/* following code fragment computes the product CMAT1 * CMAT2: */ - - -/* C */ -/* C Convert the C-matrices to quaternions. */ -/* C */ -/* CALL M2Q ( CMAT1, Q1 ) */ -/* CALL M2Q ( CMAT2, Q2 ) */ - -/* C */ -/* C Find the product. */ -/* C */ -/* CALL QXQ ( Q1, Q2, QOUT ) */ - -/* C */ -/* C Convert the result to a C-matrix. */ -/* C */ -/* CALL Q2M ( QOUT, CMAT3 ) */ - -/* C */ -/* C Multiply CMAT1 and CMAT2 directly. */ -/* C */ -/* CALL MXM ( CMAT1, CMAT2, CMAT4 ) */ - -/* C */ -/* C Compare the results. The difference DIFF of */ -/* C CMAT3 and CMAT4 should be close to the zero */ -/* C matrix. */ -/* C */ -/* CALL VSUBG ( 9, CMAT3, CMAT4, DIFF ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 26-FEB-2008 (NJB) */ - -/* Updated header; added information about SPICE */ -/* quaternion conventions. */ - -/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* quaternion times quaternion */ -/* multiply quaternion by quaternion */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Compute the scalar part of the product. */ - - qout[0] = q1[0] * q2[0] - vdot_(&q1[1], &q2[1]); - -/* And now the vector part. The SPICELIB routine VLCOM3 computes */ -/* a linear combination of three 3-vectors. */ - - vcrss_(&q1[1], &q2[1], cross); - vlcom3_(q1, &q2[1], q2, &q1[1], &c_b2, cross, &qout[1]); - return 0; -} /* qxq_ */ - diff --git a/ext/spice/src/cspice/qxq_c.c b/ext/spice/src/cspice/qxq_c.c deleted file mode 100644 index 7436670ada..0000000000 --- a/ext/spice/src/cspice/qxq_c.c +++ /dev/null @@ -1,449 +0,0 @@ -/* - --Procedure qxq_c ( Quaternion times quaternion ) - --Abstract - - Multiply two quaternions. - --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 - - ROTATION - --Keywords - - MATH - POINTING - ROTATION - -*/ - - #include "SpiceUsr.h" - #undef qxq_c - - - void qxq_c ( ConstSpiceDouble q1 [4], - ConstSpiceDouble q2 [4], - SpiceDouble qout [4] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - q1 I First SPICE quaternion factor. - q2 I Second SPICE quaternion factor. - qout O Product of `q1' and `q2'. - --Detailed_Input - - q1 is a 4-vector representing a SPICE-style quaternion. - See the discussion of "Quaternion Styles" in the - Particulars section below. - - Note that multiple styles of quaternions are in use. - This routine will not work properly if the input - quaternions do not conform to the SPICE convention. - - q2 is a second SPICE-style quaternion. - --Detailed_Output - - qout is 4-vector representing the quaternion product - - q1 * q2 - - Representing q(i) as the sums of scalar (real) - part s(i) and vector (imaginary) part v(i) - respectively, - - q1 = s1 + v1 - q2 = s2 + v2 - - qout has scalar part s3 defined by - - s3 = s1 * s2 - - - and vector part v3 defined by - - v3 = s1 * v2 + s2 * v1 + v1 x v2 - - where the notation < , > denotes the inner - product operator and x indicates the cross - product operator. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - - Quaternion Styles - ----------------- - - There are different "styles" of quaternions used in - science and engineering applications. Quaternion styles - are characterized by - - - The order of quaternion elements - - - The quaternion multiplication formula - - - The convention for associating quaternions - with rotation matrices - - Two of the commonly used styles are - - - "SPICE" - - > Invented by Sir William Rowan Hamilton - > Frequently used in mathematics and physics textbooks - - - "Engineering" - - > Widely used in aerospace engineering applications - - - CSPICE function interfaces ALWAYS use SPICE quaternions. - Quaternions of any other style must be converted to SPICE - quaternions before they are passed to CSPICE functions. - - - Relationship between SPICE and Engineering Quaternions - ------------------------------------------------------ - - Let M be a rotation matrix such that for any vector V, - - M*V - - is the result of rotating V by theta radians in the - counterclockwise direction about unit rotation axis vector A. - Then the SPICE quaternions representing M are - - (+/-) ( cos(theta/2), - sin(theta/2) A(1), - sin(theta/2) A(2), - sin(theta/2) A(3) ) - - while the engineering quaternions representing M are - - (+/-) ( -sin(theta/2) A(1), - -sin(theta/2) A(2), - -sin(theta/2) A(3), - cos(theta/2) ) - - For both styles of quaternions, if a quaternion q represents - a rotation matrix M, then -q represents M as well. - - Given an engineering quaternion - - QENG = ( q0, q1, q2, q3 ) - - the equivalent SPICE quaternion is - - QSPICE = ( q3, -q0, -q1, -q2 ) - - - Associating SPICE Quaternions with Rotation Matrices - ---------------------------------------------------- - - Let FROM and TO be two right-handed reference frames, for - example, an inertial frame and a spacecraft-fixed frame. Let the - symbols - - V , V - FROM TO - - denote, respectively, an arbitrary vector expressed relative to - the FROM and TO frames. Let M denote the transformation matrix - that transforms vectors from frame FROM to frame TO; then - - V = M * V - TO FROM - - where the expression on the right hand side represents left - multiplication of the vector by the matrix. - - Then if the unit-length SPICE quaternion q represents M, where - - q = (q0, q1, q2, q3) - - the elements of M are derived from the elements of q as follows: - - +- -+ - | 2 2 | - | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | - | | - | | - | 2 2 | - M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | - | | - | | - | 2 2 | - | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | - | | - +- -+ - - Note that substituting the elements of -q for those of q in the - right hand side leaves each element of M unchanged; this shows - that if a quaternion q represents a matrix M, then so does the - quaternion -q. - - To map the rotation matrix M to a unit quaternion, we start by - decomposing the rotation matrix as a sum of symmetric - and skew-symmetric parts: - - 2 - M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] - - symmetric skew-symmetric - - - OMEGA is a skew-symmetric matrix of the form - - +- -+ - | 0 -n3 n2 | - | | - OMEGA = | n3 0 -n1 | - | | - | -n2 n1 0 | - +- -+ - - The vector N of matrix entries (n1, n2, n3) is the rotation axis - of M and theta is M's rotation angle. Note that N and theta - are not unique. - - Let - - C = cos(theta/2) - S = sin(theta/2) - - Then the unit quaternions Q corresponding to M are - - Q = +/- ( C, S*n1, S*n2, S*n3 ) - - The mappings between quaternions and the corresponding rotations - are carried out by the CSPICE routines - - q2m_c {quaternion to matrix} - m2q_c {matrix to quaternion} - - m2q_c always returns a quaternion with scalar part greater than - or equal to zero. - - - SPICE Quaternion Multiplication Formula - --------------------------------------- - - Given a SPICE quaternion - - Q = ( q0, q1, q2, q3 ) - - corresponding to rotation axis A and angle theta as above, we can - represent Q using "scalar + vector" notation as follows: - - s = q0 = cos(theta/2) - - v = ( q1, q2, q3 ) = sin(theta/2) * A - - Q = s + v - - Let Q1 and Q2 be SPICE quaternions with respective scalar - and vector parts s1, s2 and v1, v2: - - Q1 = s1 + v1 - Q2 = s2 + v2 - - We represent the dot product of v1 and v2 by - - - - and the cross product of v1 and v2 by - - v1 x v2 - - Then the SPICE quaternion product is - - Q1*Q2 = s1*s2 - + s1*v2 + s2*v1 + (v1 x v2) - - If Q1 and Q2 represent the rotation matrices M1 and M2 - respectively, then the quaternion product - - Q1*Q2 - - represents the matrix product - - M1*M2 - - --Examples - - 1) Let qid, qi, qj, qk be the "basis" quaternions - - qid = ( 1, 0, 0, 0 ) - qi = ( 0, 1, 0, 0 ) - qj = ( 0, 0, 1, 0 ) - qk = ( 0, 0, 0, 1 ) - - respectively. Then the calls - - qxq_c ( qi, qj, ixj ); - qxq_c ( qj, qk, jxk ); - qxq_c ( qk, qi, kxi ); - - produce the results - - ixj == qk - jxk == qi - kxi == qj - - All of the calls - - qxq_c ( qi, qi, qout ); - qxq_c ( qj, qj, qout ); - qxq_c ( qk, qk, qout ); - - produce the result - - qout == -qid - - For any quaternion Q, the calls - - qxq_c ( qid, q, qout ); - qxq_c ( q, qid, qout ); - - produce the result - - qout == q - - - - 2) Composition of rotations: let `cmat1' and `cmat2' be two - C-matrices (which are rotation matrices). Then the - following code fragment computes the product cmat1 * cmat2: - - - /. - Convert the C-matrices to quaternions. - ./ - m2q_c ( cmat1, q1 ); - m2q_c ( cmat2, q2 ); - - /. - Find the product. - ./ - qxq_c ( q1, q2, qout ); - - /. - Convert the result to a C-matrix. - ./ - q2m_c ( qout, cmat3 ); - - /. - Multiply `cmat1' and `cmat2' directly. - ./ - mxm_c ( cmat1, cmat2, cmat4 ); - - /. - Compare the results. The difference `diff' of - `cmat3' and `cmat4' should be close to the zero - matrix. - ./ - vsubg_c ( 9, cmat3, cmat4, diff ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 27-FEB-2008 (NJB) - - Updated header; added information about SPICE - quaternion conventions. - - -CSPICE Version 1.0.0, 27-OCT-2005 (NJB) - --Index_Entries - - quaternion times quaternion - multiply quaternion by quaternion --& -*/ - -{ /* Begin qxq_c */ - - /* - Local variables - */ - SpiceDouble cross[3]; - - - /* - This routine is error free. - */ - - /* - Assign the scalar portion of the product `vout'. - */ - qout[0] = q1[0]*q2[0] - vdot_c( q1+1, q2+1 ); - - /* - Compute the cross product term of the vector component of - vout. - */ - vcrss_c ( q1+1, q2+1, cross ); - - /* - Assign the vector portion of the product `vout'. - */ - vlcom3_c ( q1[0], q2+1, - q2[0], q1+1, - 1.0, cross, qout+1 ); - - -} /* End qxq_c */ diff --git a/ext/spice/src/cspice/r_abs.c b/ext/spice/src/cspice/r_abs.c deleted file mode 100644 index 7b222961d1..0000000000 --- a/ext/spice/src/cspice/r_abs.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double r_abs(x) real *x; -#else -double r_abs(real *x) -#endif -{ -if(*x >= 0) - return(*x); -return(- *x); -} diff --git a/ext/spice/src/cspice/r_acos.c b/ext/spice/src/cspice/r_acos.c deleted file mode 100644 index 328812ab6a..0000000000 --- a/ext/spice/src/cspice/r_acos.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double acos(); -double r_acos(x) real *x; -#else -#undef abs -#include "math.h" -double r_acos(real *x) -#endif -{ -return( acos(*x) ); -} diff --git a/ext/spice/src/cspice/r_asin.c b/ext/spice/src/cspice/r_asin.c deleted file mode 100644 index a30c6706b0..0000000000 --- a/ext/spice/src/cspice/r_asin.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double asin(); -double r_asin(x) real *x; -#else -#undef abs -#include "math.h" -double r_asin(real *x) -#endif -{ -return( asin(*x) ); -} diff --git a/ext/spice/src/cspice/r_atan.c b/ext/spice/src/cspice/r_atan.c deleted file mode 100644 index 1e3817bdf6..0000000000 --- a/ext/spice/src/cspice/r_atan.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double atan(); -double r_atan(x) real *x; -#else -#undef abs -#include "math.h" -double r_atan(real *x) -#endif -{ -return( atan(*x) ); -} diff --git a/ext/spice/src/cspice/r_atn2.c b/ext/spice/src/cspice/r_atn2.c deleted file mode 100644 index 3832a27f3e..0000000000 --- a/ext/spice/src/cspice/r_atn2.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double atan2(); -double r_atn2(x,y) real *x, *y; -#else -#undef abs -#include "math.h" -double r_atn2(real *x, real *y) -#endif -{ -return( atan2(*x,*y) ); -} diff --git a/ext/spice/src/cspice/r_cnjg.c b/ext/spice/src/cspice/r_cnjg.c deleted file mode 100644 index e127ca969c..0000000000 --- a/ext/spice/src/cspice/r_cnjg.c +++ /dev/null @@ -1,11 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -VOID r_cnjg(r, z) complex *r, *z; -#else -VOID r_cnjg(complex *r, complex *z) -#endif -{ -r->r = z->r; -r->i = - z->i; -} diff --git a/ext/spice/src/cspice/r_cos.c b/ext/spice/src/cspice/r_cos.c deleted file mode 100644 index cf5c8eb4af..0000000000 --- a/ext/spice/src/cspice/r_cos.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double cos(); -double r_cos(x) real *x; -#else -#undef abs -#include "math.h" -double r_cos(real *x) -#endif -{ -return( cos(*x) ); -} diff --git a/ext/spice/src/cspice/r_cosh.c b/ext/spice/src/cspice/r_cosh.c deleted file mode 100644 index 5756c17242..0000000000 --- a/ext/spice/src/cspice/r_cosh.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double cosh(); -double r_cosh(x) real *x; -#else -#undef abs -#include "math.h" -double r_cosh(real *x) -#endif -{ -return( cosh(*x) ); -} diff --git a/ext/spice/src/cspice/r_dim.c b/ext/spice/src/cspice/r_dim.c deleted file mode 100644 index baca95cd9e..0000000000 --- a/ext/spice/src/cspice/r_dim.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double r_dim(a,b) real *a, *b; -#else -double r_dim(real *a, real *b) -#endif -{ -return( *a > *b ? *a - *b : 0); -} diff --git a/ext/spice/src/cspice/r_exp.c b/ext/spice/src/cspice/r_exp.c deleted file mode 100644 index a95f4bc7f2..0000000000 --- a/ext/spice/src/cspice/r_exp.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double exp(); -double r_exp(x) real *x; -#else -#undef abs -#include "math.h" -double r_exp(real *x) -#endif -{ -return( exp(*x) ); -} diff --git a/ext/spice/src/cspice/r_imag.c b/ext/spice/src/cspice/r_imag.c deleted file mode 100644 index d51252bbb7..0000000000 --- a/ext/spice/src/cspice/r_imag.c +++ /dev/null @@ -1,10 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double r_imag(z) complex *z; -#else -double r_imag(complex *z) -#endif -{ -return(z->i); -} diff --git a/ext/spice/src/cspice/r_int.c b/ext/spice/src/cspice/r_int.c deleted file mode 100644 index 11264bf192..0000000000 --- a/ext/spice/src/cspice/r_int.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -double r_int(x) real *x; -#else -#undef abs -#include "math.h" -double r_int(real *x) -#endif -{ -return( (*x>0) ? floor(*x) : -floor(- *x) ); -} diff --git a/ext/spice/src/cspice/r_lg10.c b/ext/spice/src/cspice/r_lg10.c deleted file mode 100644 index 4ea02f4510..0000000000 --- a/ext/spice/src/cspice/r_lg10.c +++ /dev/null @@ -1,15 +0,0 @@ -#include "f2c.h" - -#define log10e 0.43429448190325182765 - -#ifdef KR_headers -double log(); -double r_lg10(x) real *x; -#else -#undef abs -#include "math.h" -double r_lg10(real *x) -#endif -{ -return( log10e * log(*x) ); -} diff --git a/ext/spice/src/cspice/r_log.c b/ext/spice/src/cspice/r_log.c deleted file mode 100644 index aec6726ef5..0000000000 --- a/ext/spice/src/cspice/r_log.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double log(); -double r_log(x) real *x; -#else -#undef abs -#include "math.h" -double r_log(real *x) -#endif -{ -return( log(*x) ); -} diff --git a/ext/spice/src/cspice/r_mod.c b/ext/spice/src/cspice/r_mod.c deleted file mode 100644 index 7adb44cdbe..0000000000 --- a/ext/spice/src/cspice/r_mod.c +++ /dev/null @@ -1,40 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -#ifdef IEEE_drem -double drem(); -#else -double floor(); -#endif -double r_mod(x,y) real *x, *y; -#else -#ifdef IEEE_drem -double drem(double, double); -#else -#undef abs -#include "math.h" -#endif -double r_mod(real *x, real *y) -#endif -{ -#ifdef IEEE_drem - double xa, ya, z; - if ((ya = *y) < 0.) - ya = -ya; - z = drem(xa = *x, ya); - if (xa > 0) { - if (z < 0) - z += ya; - } - else if (z > 0) - z -= ya; - return z; -#else - double quotient; - if( (quotient = (double)*x / *y) >= 0) - quotient = floor(quotient); - else - quotient = -floor(-quotient); - return(*x - (*y) * quotient ); -#endif -} diff --git a/ext/spice/src/cspice/r_nint.c b/ext/spice/src/cspice/r_nint.c deleted file mode 100644 index c45bac6458..0000000000 --- a/ext/spice/src/cspice/r_nint.c +++ /dev/null @@ -1,14 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double floor(); -double r_nint(x) real *x; -#else -#undef abs -#include "math.h" -double r_nint(real *x) -#endif -{ -return( (*x)>=0 ? - floor(*x + .5) : -floor(.5 - *x) ); -} diff --git a/ext/spice/src/cspice/r_sign.c b/ext/spice/src/cspice/r_sign.c deleted file mode 100644 index df6d02af00..0000000000 --- a/ext/spice/src/cspice/r_sign.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double r_sign(a,b) real *a, *b; -#else -double r_sign(real *a, real *b) -#endif -{ -double x; -x = (*a >= 0 ? *a : - *a); -return( *b >= 0 ? x : -x); -} diff --git a/ext/spice/src/cspice/r_sin.c b/ext/spice/src/cspice/r_sin.c deleted file mode 100644 index d2a3dac858..0000000000 --- a/ext/spice/src/cspice/r_sin.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sin(); -double r_sin(x) real *x; -#else -#undef abs -#include "math.h" -double r_sin(real *x) -#endif -{ -return( sin(*x) ); -} diff --git a/ext/spice/src/cspice/r_sinh.c b/ext/spice/src/cspice/r_sinh.c deleted file mode 100644 index 00cba0cb07..0000000000 --- a/ext/spice/src/cspice/r_sinh.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sinh(); -double r_sinh(x) real *x; -#else -#undef abs -#include "math.h" -double r_sinh(real *x) -#endif -{ -return( sinh(*x) ); -} diff --git a/ext/spice/src/cspice/r_sqrt.c b/ext/spice/src/cspice/r_sqrt.c deleted file mode 100644 index 26b45458aa..0000000000 --- a/ext/spice/src/cspice/r_sqrt.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sqrt(); -double r_sqrt(x) real *x; -#else -#undef abs -#include "math.h" -double r_sqrt(real *x) -#endif -{ -return( sqrt(*x) ); -} diff --git a/ext/spice/src/cspice/r_tan.c b/ext/spice/src/cspice/r_tan.c deleted file mode 100644 index 736b37893c..0000000000 --- a/ext/spice/src/cspice/r_tan.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double tan(); -double r_tan(x) real *x; -#else -#undef abs -#include "math.h" -double r_tan(real *x) -#endif -{ -return( tan(*x) ); -} diff --git a/ext/spice/src/cspice/r_tanh.c b/ext/spice/src/cspice/r_tanh.c deleted file mode 100644 index 044255a08c..0000000000 --- a/ext/spice/src/cspice/r_tanh.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double tanh(); -double r_tanh(x) real *x; -#else -#undef abs -#include "math.h" -double r_tanh(real *x) -#endif -{ -return( tanh(*x) ); -} diff --git a/ext/spice/src/cspice/radrec.c b/ext/spice/src/cspice/radrec.c deleted file mode 100644 index 4fdb965e96..0000000000 --- a/ext/spice/src/cspice/radrec.c +++ /dev/null @@ -1,197 +0,0 @@ -/* radrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RADREC ( Range, RA and DEC to rectangular coordinates ) */ -/* Subroutine */ int radrec_(doublereal *range, doublereal *ra, doublereal * - dec, doublereal *rectan) -{ - extern /* Subroutine */ int latrec_(doublereal *, doublereal *, - doublereal *, doublereal *); - -/* $ Abstract */ - -/* Convert from range, right ascension, and declination to */ -/* rectangular coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* RANGE I Distance of a point from the origin. */ -/* RA I Right ascension in radians. */ -/* DEC I Declination in radians. */ -/* RECTAN O Rectangular coordinates of the point. */ - -/* $ Detailed_Input */ - -/* RANGE is the distance of the point from the origin. Input */ -/* should be in terms of the same units in which the */ -/* output is desired. */ - - -/* RA is the right ascension of RECTAN. This is the angular */ -/* distance measured toward the east from the prime */ -/* meridian to the meridian containing the input point. */ -/* The direction of increasing right ascension is from */ -/* the +X axis towards the +Y axis. */ - -/* The range (i.e., the set of allowed values) of */ -/* RA is unrestricted. Units are radians. */ - - -/* DEC is the declination of RECTAN. This is the angle from */ -/* the XY plane of the ray from the origin through the */ -/* point. */ - -/* The range (i.e., the set of allowed values) of */ -/* DEC is unrestricted. Units are radians. */ - - -/* $ Detailed_Output */ - -/* RECTAN is the array containing the rectangular coordinates of */ -/* the point. */ - -/* The units associated with RECTAN are those */ -/* associated with the input RANGE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts the right ascension, declination, and range */ -/* of a point into the associated rectangular coordinates. */ - -/* The input is defined by a distance from a central reference point, */ -/* an angle from a reference meridian, and an angle above the equator */ -/* of a sphere centered at the central reference point. */ - -/* $ Examples */ - -/* The following code fragment converts right ascension and */ -/* declination from the B1950 reference frame to the J2000 frame. */ - -/* C */ -/* C Convert RA and DEC to a 3-vector expressed in */ -/* C the B1950 frame. */ -/* C */ -/* CALL RADREC ( 1.D0, RA, DEC, V1950 ) */ -/* C */ -/* C We use the SPICELIB routine PXFORM to obtain the */ -/* C transformation matrix for converting vectors between */ -/* C the B1950 and J2000 reference frames. Since */ -/* C both frames are inertial, the input time value we */ -/* C supply to PXFORM is arbitrary. We choose zero */ -/* C seconds past the J2000 epoch. */ -/* C */ -/* CALL PXFORM ( 'B1950', 'J2000', 0.D0, MTRANS ) */ -/* C */ -/* C Transform the vector to the J2000 frame. */ -/* C */ -/* CALL MXV ( MTRANS, V1950, V2000 ) */ -/* C */ -/* C Find the RA and DEC of the J2000-relative vector. */ -/* C */ -/* CALL RECRAD ( V2000, R, RA, DEC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Literature_References */ - -/* "Celestial Mechanics, A Computational Guide for the Practitioner" */ -/* by Laurence G. Taff */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 30-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - 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 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* range ra and dec to rectangular coordinates */ -/* right_ascension and declination to rectangular */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 19-MAY-1989 (HAN) */ - -/* Removed calls to CHKIN and CHKOUT. This routine is */ -/* "error free" and should not have been participating */ -/* in error handling. */ - -/* -& */ - -/* Convert from range, right ascension, and declination to */ -/* rectangular coordinates by calling the routine LATREC. */ - - latrec_(range, ra, dec, rectan); - return 0; -} /* radrec_ */ - diff --git a/ext/spice/src/cspice/radrec_c.c b/ext/spice/src/cspice/radrec_c.c deleted file mode 100644 index aa6ebaba75..0000000000 --- a/ext/spice/src/cspice/radrec_c.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure radrec_c ( Range, RA and DEC to rectangular coordinates ) - --Abstract - - Convert from range, right ascension, and declination to rectangular - coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include "SpiceUsr.h" - - void radrec_c ( SpiceDouble range, - SpiceDouble ra, - SpiceDouble dec, - SpiceDouble rectan[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- --------------------------------------------------- - range I Distance of a point from the origin. - ra I Right ascension of point in radians. - dec I Declination of point in radians. - rectan O Rectangular coordinates of the point. - --Detailed_Input - - range is the distance of the point from the origin. Output - units are the same as the units associated with `range.' - - ra is the right ascension of the input point: the angular - distance measured toward the east from the prime meridian - to the meridian containing the input point. The direction - of increasing right ascension is from the +X axis towards - the +Y axis. - - The range (i.e., the set of allowed values) of - `ra' is unrestricted. Units are radians. - - dec is the declination of the point. This is the angular - distance from the XY plane to the point. - - The range of `dec' is unrestricted. Units are radians. - --Detailed_Output - - rectan is the array containing the rectangular coordinates of - the point. The output units associated with `rectan' - are those associated with the input `range.' - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - None. - --Examples - - The following code fragment converts right ascension and - declination from the B1950 reference frame to the J2000 frame. - - #include "SpiceUsr.h" - - SpiceDouble ra; - SpiceDouble dec; - SpiceDouble r; - SpiceDouble rotab [ 3 ][ 3 ]; - SpiceDouble oldvec [ 3 ]; - SpiceDouble newvec [ 3 ]; - - - radrec_c ( 1.0, ra, dec, oldvec ); - - pxform_c ( "B1950", "J2000", 0.0, rotab ); - - mxv_c ( rotab, oldvec, newvec ); - recrad_c ( newvec, &r, &ra, &dec ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - E.D. Wright (JPL) - --Literature_References - - "Celestial Mechanics, A Computational Guide for the Practitioner" - by Laurence G. Taff - --Version - - -CSPICE Version 1.0.2, 28-JUL-2003 (NJB) - - Various header corrections were made. - - -CSPICE Version 1.0.1, 13-APR-2000 (NJB) - - Made some minor updates and corrections in the code example. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - range ra and dec to rectangular coordinates - right_ascension and declination to rectangular - --& -*/ - -{ /* Begin radrec_c */ - - /* - There isn't much to say or do... - */ - - latrec_c ( range, ra, dec, rectan ); - - -} /* End radrec_c */ diff --git a/ext/spice/src/cspice/rav2xf.c b/ext/spice/src/cspice/rav2xf.c deleted file mode 100644 index ccfe8a7651..0000000000 --- a/ext/spice/src/cspice/rav2xf.c +++ /dev/null @@ -1,267 +0,0 @@ -/* rav2xf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RAV2XF ( Rotation and angular velocity to transform ) */ -/* Subroutine */ int rav2xf_(doublereal *rot, doublereal *av, doublereal * - xform) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j; - doublereal omegat[9] /* was [3][3] */, drotdt[9] /* was [3][3] - */; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* This routine determines from a state transformation matrix */ -/* the associated rotation matrix and angular velocity of the */ -/* rotation. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ROT I rotation matrix */ -/* AV I angular velocity vector */ -/* XFORM O state transformation associated with ROT and AV */ - -/* $ Detailed_Input */ - -/* ROT is a rotation that gives the transformation from */ -/* some frame FRAME1 to another frame FRAME2. */ - -/* AV is the angular velocity of the transformation. */ -/* In other words, if P is the position of a fixed */ -/* point in FRAME2, then from the point of view of */ -/* FRAME1, P rotates (in a right handed sense) about */ -/* an axis parallel to AV. Moreover the rate of rotation */ -/* in radians per unit time is given by the length of */ -/* AV. */ - -/* More formally, the velocity V of P in FRAME1 is */ -/* given by */ -/* t */ -/* V = AV x ( ROT * P ) */ - -/* $ Detailed_Output */ - -/* XFORM is a state transformation matrix associated */ -/* with ROT and AV. If S1 is the state of an object */ -/* with respect to FRAME1, then the state S2 of the */ -/* object with respect to FRAME2 is given by */ - -/* S2 = XFORM * S1 */ - -/* where "*" denotes Matrix-Vector multiplication. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) No checks are performed on ROT to ensure that it is indeed */ -/* a rotation matrix. */ - -/* $ Particulars */ - -/* This routine is essentially a macro routine for converting */ -/* a rotation and angular velocity of the rotation to the */ -/* equivalent state transformation matrix. */ - -/* This routine is an inverse of XF2RAV */ - -/* $ Examples */ - -/* Suppose that you wanted to determine state transformation */ -/* matrix from a platform frame to J2000. */ - -/* CALL CKGPAV ( CKID, TIME, TOL, 'J2000', ROT, AV, CLKOUT, FND ) */ - -/* Recall that ROT and AV are the rotation and angular velocity */ -/* of the transformation from J2000 to the platform frame. */ - -/* IF ( FND ) THEN */ - -/* First get the state transformation from J2000 to the platform */ -/* frame. */ - -/* CALL RAV2XF ( ROT, AV, J2PLT ) */ - -/* Invert the state transformation matrix (using INVSTM) to */ -/* the desired state transformation matrix. */ - -/* CALL INVSTM ( J2PLT, XFORM ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (WLT) */ - -/* The example in version 1.0.0 was incorrect. The example */ -/* in version 1.1.0 fixes the previous problem. */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* State transformation to rotation and angular velocity */ - -/* -& */ - -/* A state transformation matrix XFORM has the following form */ - - -/* [ | ] */ -/* | R | 0 | */ -/* | | | */ -/* | -----+-----| */ -/* | dR | | */ -/* | -- | R | */ -/* [ dt | ] */ - - -/* where R is a rotation and dR/dt is the time derivative of that */ -/* rotation. From this we can immediately fill in most of the */ -/* state transformation matrix. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : s_rnge( - "xform", i__1, "rav2xf_", (ftnlen)192)] = rot[(i__2 = i__ - + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("rot", i__2, - "rav2xf_", (ftnlen)192)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "rav2xf_", (ftnlen)193)] = rot[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "rav2xf_", (ftnlen)193)]; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "rav2xf_", (ftnlen)194)] = 0.; - } - } - -/* Now for the rest. */ - -/* Recall that ROT is a transformation that converts positions */ -/* in some frame FRAME1 to positions in a second frame FRAME2. */ - -/* The angular velocity matrix OMEGA (the cross product matrix */ -/* corresponding to AV) has the following property. */ - -/* If P is the position of an object that is stationary with */ -/* respect to FRAME2 then the velocity V of that object in FRAME1 */ -/* is given by: */ -/* t */ -/* V = OMEGA * ROT * P */ - -/* But V is also given by */ - -/* t */ -/* d ROT */ -/* V = ----- * P */ -/* dt */ - -/* So that */ -/* t */ -/* t d ROT */ -/* OMEGA * ROT = ------- */ -/* dt */ - -/* Hence */ - -/* d ROT t */ -/* ----- = ROT * OMEGA */ -/* dt */ - - -/* From this discussion we can see that we need OMEGA transpose. */ -/* Here it is. */ - - omegat[0] = 0.; - omegat[1] = -av[2]; - omegat[2] = av[1]; - omegat[3] = av[2]; - omegat[4] = 0.; - omegat[5] = -av[0]; - omegat[6] = -av[1]; - omegat[7] = av[0]; - omegat[8] = 0.; - mxm_(rot, omegat, drotdt); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "rav2xf_", (ftnlen)252)] = drotdt[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge( - "drotdt", i__2, "rav2xf_", (ftnlen)252)]; - } - } - return 0; -} /* rav2xf_ */ - diff --git a/ext/spice/src/cspice/rav2xf_c.c b/ext/spice/src/cspice/rav2xf_c.c deleted file mode 100644 index 19fceb52d5..0000000000 --- a/ext/spice/src/cspice/rav2xf_c.c +++ /dev/null @@ -1,295 +0,0 @@ -/* - --Procedure rav2xf_c ( Rotation and angular velocity to transform ) - --Abstract - - This routine determines a state transformation matrix - from a rotation matrix and the angular velocity of the - rotation. - --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 - - FRAMES - -*/ - - #include "SpiceUsr.h" - #undef rav2xf_c - - - void rav2xf_c ( ConstSpiceDouble rot [3][3], - ConstSpiceDouble av [3], - SpiceDouble xform [6][6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - rot I Rotation matrix. - av I Angular velocity vector. - xform O State transformation associated with rot and av. - --Detailed_Input - - rot is a rotation that gives the transformation from - some frame frame1 to another frame frame2. - - av is the angular velocity of the transformation. - In other words, if p is the position of a fixed - point in frame2, then from the point of view of - frame1, p rotates (in a right handed sense) about - an axis parallel to av. Moreover the rate of rotation - in radians per unit time is given by the length of - av. - - More formally, the velocity v of p in frame1 is - given by - t - v = av x ( rot * p ) - --Detailed_Output - - xform is a state transformation matrix associated - with rot and av. If s1 is the state of an object - with respect to frame1, then the state s2 of the - object with respect to frame2 is given by - - s2 = xform * s1 - - where "*" denotes matrix-vector multiplication. - - --Parameters - - None. - --Exceptions - - Error free. - - 1) No checks are performed on ROT to ensure that it is indeed - a rotation matrix. - --Files - - None. - --Particulars - - This routine is essentially a macro routine for converting - a rotation and angular velocity of the rotation to the - equivalent state transformation matrix. - - This routine is an inverse of xf2rav_c. - --Examples - - Suppose that you wanted to determine state transformation - matrix from a platform frame to the J2000 frame. - - /. - The following call obtains the J2000-to-platform transformation - matrix and platform angular velocity at the time of interest. - The time value is expressed as encoded SCLK. - ./ - - ckgpav_c ( ckid, time, tol, "J2000", rot, av, &clkout, &fnd ); - - /. - Recall that rot and av are the rotation and angular velocity - of the transformation from J2000 to the platform frame. - ./ - - if ( fnd ) - { - /. - First get the state transformation from J2000 to the platform - frame. - ./ - - rav2xf_c ( rot, av, j2plt ); - - /. - Invert the state transformation matrix (using invstm_c) to - the desired state transformation matrix. - ./ - - invstm_c ( j2plt, xform ); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 12-APR-2007 (EDW) - - Edit to abstract. - - -CSPICE Version 1.0.0, 18-JUN-1999 (WLT) (NJB) - --Index_Entries - - State transformation to rotation and angular velocity - --& -*/ - - { /* Begin rav2xf_c */ - - - /* - Local variables - */ - - SpiceDouble drdt [3][3]; - SpiceDouble omegat [3][3]; - - SpiceInt i; - SpiceInt j; - - - - /* - Error free: no tracing required. - - - A state transformation matrix xform has the following form - - - [ | ] - | r | 0 | - | | | - | -----+-----| - | dr | | - | -- | r | - [ dt | ] - - - where r is a rotation and dr/dt is the time derivative of that - rotation. From this we can immediately fill in most of the - state transformation matrix. - */ - - - - for ( i = 0; i < 3; i++ ) - { - for ( j = 0; j < 3; j++ ) - { - xform[i ][j ] = rot [i][j]; - xform[i+3][j+3] = rot [i][j]; - xform[i ][j+3] = 0.; - } - } - - - - /* - Now for the rest. - - Recall that rot is a transformation that converts positions - in some frame frame1 to positions in a second frame frame2. - - The angular velocity matrix omega (the cross product matrix - corresponding to av) has the following property. - - If p is the position of an object that is stationary with - respect to frame2 then the velocity v of that object in frame1 - is given by: - t - v = omega * rot * p - - But v is also given by - - t - d rot - v = ----- * p - dt - - So that - t - t d rot - omega * rot = ------- - dt - - Hence - - d rot t - ----- = rot * omega - dt - - - From this discussion we can see that we need omega transpose. - Here it is. - */ - - omegat[0][0] = 0.0; - omegat[1][0] = -av[2]; - omegat[2][0] = av[1]; - - omegat[0][1] = av[2]; - omegat[1][1] = 0.0; - omegat[2][1] = -av[0]; - - omegat[0][2] = -av[1]; - omegat[1][2] = av[0]; - omegat[2][2] = 0.0; - - - mxm_c ( rot, omegat, drdt ); - - - for ( i = 0; i < 3; i++ ) - { - for ( j = 0; j < 3; j++ ) - { - xform[i+3][j] = drdt [i][j]; - } - } - - - } /* End rav2xf_c */ - diff --git a/ext/spice/src/cspice/rawio.h b/ext/spice/src/cspice/rawio.h deleted file mode 100644 index fd36a48260..0000000000 --- a/ext/spice/src/cspice/rawio.h +++ /dev/null @@ -1,41 +0,0 @@ -#ifndef KR_headers -#ifdef MSDOS -#include "io.h" -#ifndef WATCOM -#define close _close -#define creat _creat -#define open _open -#define read _read -#define write _write -#endif /*WATCOM*/ -#endif /*MSDOS*/ -#ifdef __cplusplus -extern "C" { -#endif -#ifndef MSDOS -#ifdef OPEN_DECL -extern int creat(const char*,int), open(const char*,int); -#endif -extern int close(int); -extern int read(int,void*,size_t), write(int,void*,size_t); -extern int unlink(const char*); -#ifndef _POSIX_SOURCE -#ifndef NON_UNIX_STDIO -extern FILE *fdopen(int, const char*); -#endif -#endif -#endif /*KR_HEADERS*/ - -extern char *mktemp(char*); - -#ifdef __cplusplus - } -#endif -#endif - -#include "fcntl.h" - -#ifndef O_WRONLY -#define O_RDONLY 0 -#define O_WRONLY 1 -#endif diff --git a/ext/spice/src/cspice/raxisa.c b/ext/spice/src/cspice/raxisa.c deleted file mode 100644 index 21feecda6c..0000000000 --- a/ext/spice/src/cspice/raxisa.c +++ /dev/null @@ -1,349 +0,0 @@ -/* raxisa.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RAXISA ( Rotation axis of a matrix ) */ -/* Subroutine */ int raxisa_(doublereal *matrix, doublereal *axis, doublereal - *angle) -{ - /* Builtin functions */ - double atan2(doublereal, doublereal); - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal q[4]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *), failed_(void); - extern doublereal pi_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int m2q_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Compute the axis of the rotation given by an input matrix */ -/* and the angle of the rotation about that axis. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* ANGLE, MATRIX, ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I 3x3 rotation matrix in double precision. */ -/* AXIS O Axis of the rotation. */ -/* ANGLE O Angle through which the rotation is performed. */ - -/* $ Detailed_Input */ - -/* MATRIX is a 3x3 rotation matrix in double precision. */ - -/* $ Detailed_Output */ - -/* AXIS is a unit vector pointing along the axis of the */ -/* rotation. In other words, AXIS is a unit eigenvector */ -/* of the input matrix, corresponding to the eigenvalue */ -/* 1. If the input matrix is the identity matrix, AXIS */ -/* will be the vector (0, 0, 1). If the input rotation is */ -/* a rotation by PI radians, both AXIS and -AXIS may be */ -/* regarded as the axis of the rotation. */ - -/* ANGLE is the angle between V and MATRIX*V for any non-zero */ -/* vector V orthogonal to AXIS. Angle is given in */ -/* radians. The angle returned will be in the range from */ -/* 0 to PI. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input matrix is not a rotation matrix (where a fairly */ -/* loose tolerance is used to check this) a routine in the */ -/* call tree of this routine will signal an error indicating */ -/* the problem. */ - -/* 2) If the input matrix is the identity matrix, this routine */ -/* returns an angle of 0.0, and an axis of ( 0.0, 0.0, 1.0 ). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Every rotation matrix has an axis A such any vector, V, parallel */ -/* to that axis satisfies the equation */ - -/* V = MATRIX * V */ - -/* This routine returns a unit vector AXIS parallel to the axis of */ -/* the input rotation matrix. Moreover for any vector W orthogonal */ -/* to the axis of the rotation */ - -/* AXIS and W x MATRIX*W */ - -/* (where "x" denotes the cross product operation) */ - -/* will be positive scalar multiples of one another (at least to */ -/* within the ability to make such computations with double */ -/* precision arithmetic, and under the assumption that the MATRIX */ -/* does not represent a rotation by zero or Pi radians). */ - -/* The angle returned will be the angle between W and MATRIX*W for */ -/* any vector orthogonal to AXIS. */ - -/* If the input matrix is a rotation by 0 or PI radians some choice */ -/* must be made for the AXIS returned. In the case of a rotation by */ -/* 0 radians, AXIS is along the positive z-axis. In the case of a */ -/* rotation by 180 degrees, two choices are */ - -/* $ Examples */ - -/* This routine can be used to numerically approximate the */ -/* instantaneous angular velocity vector of a rotating object. */ - -/* Suppose that R(t) is the rotation matrix whose columns represent */ -/* the inertial pointing vectors of the bodyfixed axes of an object */ -/* at time t. */ - -/* Then the angular velocity vector points along the vector given */ -/* by: */ -/* T */ -/* limit AXIS( R(t+h)R ) */ -/* h-->0 */ - -/* And the magnitude of the angular velocity at time t is given by: */ - -/* T */ -/* d ANGLE ( R(t+h)R(t) ) */ -/* ---------------------- at h = 0 */ -/* dh */ - -/* Thus to approximate the angular velocity vector the following */ -/* code fragment will do */ - -/* Load t into the double precision variable T */ -/* Load h into the double precision variable H */ -/* Load R(t+h) into the 3 by 3 double precision array RTH */ -/* Load R(t) into the 3 by 3 double precision array RT */ -/* . */ -/* . */ -/* . */ -/* compute the infinitesimal rotation R(t+h)R(t)**T */ - -/* CALL MXMT ( RTH, RT, INFROT ) */ - -/* compute the AXIS and ANGLE of the infinitesimal rotation */ - -/* CALL RAXISA ( INFROT, AXIS, ANGLE ) */ - -/* scale axis to get the angular velocity vector */ - -/* CALL VSCL ( ANGLE/H, AXIS, ANGVEL ) */ - - -/* $ Restrictions */ - -/* 1) If the input matrix is not a rotation matrix but is close */ -/* enough to pass the tests this routine performs on it, no error */ -/* will be signaled, but the results may have poor accuracy. */ - -/* 2) The input matrix is taken to be an object that acts on */ -/* (rotates) vectors---it is not regarded as a coordinate */ -/* transformation. To find the axis and angle of a coordinate */ -/* transformation, input the transpose of that matrix to this */ -/* routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.2, 02-JAN-2008 (EDW) */ - -/* Minor edit to the ANGLE declaration strictly */ -/* identifying the constant as a double. */ - -/* From: */ - -/* ANGLE = 2.0 * DATAN2( VNORM(Q(1)), Q(0) ) */ - -/* To: */ - -/* ANGLE = 2.D0 * DATAN2( VNORM(Q(1)), Q(0) ) */ - -/* - SPICELIB Version 2.1.1, 05-JAN-2005 (NJB) */ - -/* Minor edits and formatting changes were made. */ - -/* - SPICELIB Version 2.1.0, 30-MAY-2002 (FST) */ - -/* This routine now participates in error handling properly. */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1999 (WLT) */ - -/* The routine was re-written so as to avoid the numerical */ -/* instabilities present in the previous implementation for */ -/* rotations very near zero or 180 degrees. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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 */ - -/* axis and angle of a rotation matrix */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 30-MAY-2002 (FST) */ - -/* Calls to CHKIN and CHKOUT in the standard SPICE error */ -/* handling style were added. Versions prior to 2.0.0 */ -/* were error free, however the call to M2Q introduced in */ -/* version 2.0.0 signals an error if the input matrix is */ -/* not sufficiently close to a rotation. */ - -/* Additionally, FAILED is now checked after the call to */ -/* M2Q. This prevents garbage from being placed into the */ -/* output arguments. */ - -/* - SPICELIB Version 2.0.0, 21-SEP-1999 (WLT) */ - -/* The routine was re-written so as to avoid the numerical */ -/* instabilities present in the previous implementation for */ -/* rotations very near zero or 180 degrees. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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) */ - -/* - Beta Version 1.1.0, 3-JAN-1989 (WLT) */ - -/* Even though the routine stipulates that the input matrix */ -/* should be a rotation matrix, it might not be. As a result */ -/* we could have negative numbers showing up where we need */ -/* to take square roots. This fix simply bounds these values */ -/* so that Fortran intrinsics always get reasonable input values. */ - -/* Add and example to the header. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RAXISA", (ftnlen)6); - } - -/* Construct the quaternion corresponding to the input rotation */ -/* matrix */ - - m2q_(matrix, q); - -/* Check FAILED and return if an error has occurred. */ - - if (failed_()) { - chkout_("RAXISA", (ftnlen)6); - return 0; - } - -/* The quaternion we've just constructed is of the form: */ - -/* cos(ANGLE/2) + sin(ANGLE/2) * AXIS */ - -/* We take a few precautions to handle the case of an identity */ -/* rotation. */ - - if (vzero_(&q[1])) { - *angle = 0.; - axis[0] = 0.; - axis[1] = 0.; - axis[2] = 1.; - } else if (q[0] == 0.) { - *angle = pi_(); - axis[0] = q[1]; - axis[1] = q[2]; - axis[2] = q[3]; - } else { - vhat_(&q[1], axis); - *angle = atan2(vnorm_(&q[1]), q[0]) * 2.; - } - chkout_("RAXISA", (ftnlen)6); - return 0; -} /* raxisa_ */ - diff --git a/ext/spice/src/cspice/raxisa_c.c b/ext/spice/src/cspice/raxisa_c.c deleted file mode 100644 index 5ed9a02b6a..0000000000 --- a/ext/spice/src/cspice/raxisa_c.c +++ /dev/null @@ -1,243 +0,0 @@ -/* - --Procedure raxisa_c ( Rotation axis of a matrix ) - --Abstract - - Compute the axis of the rotation given by an input matrix - and the angle of the rotation about that axis. - --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 - - ROTATION - --Keywords - - ANGLE, MATRIX, ROTATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef raxisa_c - - - void raxisa_c ( ConstSpiceDouble matrix[3][3], - SpiceDouble axis [3], - SpiceDouble * angle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - matrix I 3x3 rotation matrix in double precision. - axis O Axis of the rotation. - angle O Angle through which the rotation is performed. - --Detailed_Input - - matrix is a 3x3 rotation matrix in double precision. - --Detailed_Output - - axis is a unit vector pointing along the axis of the rotation. - In other words, `axis' is a unit eigenvector of the input - matrix, corresponding to the eigenvalue 1. If the input - matrix is the identity matrix, `axis' will be the vector - (0, 0, 1). If the input rotation is a rotation by pi - radians, both `axis' and -axis may be regarded as the - axis of the rotation. - - angle is the angle between `v' and matrix*v for any non-zero - vector `v' orthogonal to `axis'. `angle' is given in - radians. The angle returned will be in the range from 0 - to pi radians. - --Parameters - - None. - --Exceptions - - 1) If the input matrix is not a rotation matrix (a fairly - loose tolerance is used to check this) a routine in the - call tree of this routine will signal an error indicating - the problem. - - 2) If the input matrix is the identity matrix, this routine - returns an angle of 0.0, and an axis of ( 0.0, 0.0, 1.0 ). - --Files - - None. - --Particulars - - Every rotation matrix has an axis `a' such any vector `v' - parallel to that axis satisfies the equation - - v = matrix * v - - This routine returns a unit vector `axis' parallel to the axis of - the input rotation matrix. Moreover for any vector `w' orthogonal - to the axis of the rotation, the two vectors - - axis, - w x (matrix*w) - - (where "x" denotes the cross product operation) - - will be positive scalar multiples of one another (at least - to within the ability to make such computations with double - precision arithmetic, and under the assumption that `matrix' - does not represent a rotation by zero or pi radians). - - The angle returned will be the angle between `w' and matrix*w - for any vector orthogonal to `axis'. - - If the input matrix is a rotation by 0 or pi radians some - choice must be made for the axis returned. In the case of - a rotation by 0 radians, `axis' is along the positive z-axis. - In the case of a rotation by 180 degrees, two choices are - possible. The choice made this routine is unspecified. - --Examples - - This routine can be used to numerically approximate the - instantaneous angular velocity vector of a rotating object. - - Suppose that r(t) is the rotation matrix whose columns - represent the inertial pointing vectors of the bodyfixed - axes of an object at time t. - - Then the angular velocity vector points along the vector - given by: - T - limit axis( r(t+h)r ) - h-->0 - - And the magnitude of the angular velocity at time t is given by: - - T - d angle ( r(t+h)r(t) ) - ---------------------- at h = 0 - dh - - Thus to approximate the angular velocity vector the following - code fragment will do - - [ Load t into the double precision variable t - Load h into the double precision variable h - Load r(t+h) into the 3 by 3 double precision array rth - Load r(t) into the 3 by 3 double precision array rt - . - . - . - ] - - /. - T - Compute the infinitesimal rotation r(t+h)r(t) - ./ - mxmt_c ( rth, rt, infrot ); - - /. - Compute the axis and angle of the infinitesimal rotation. - /. - raxisa_c ( infrot, axis, &angle ); - - /. - Scale axis to get the angular velocity vector. - ./ - vscl_c ( angle/h, axis, angvel ); - - --Restrictions - - 1) If the input matrix is not a rotation matrix but is close enough - to pass the tests this routine performs on it, no error will be - signaled, but the results may have poor accuracy. - - 2) The input matrix is taken to be an object that acts on (rotates) - vectors---it is not regarded as a coordinate transformation. To - find the axis and angle of a coordinate transformation, input - the transpose of that matrix to this routine. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 05-JAN-2005 (NJB) (WLT) (FST) - - Various header updates were made to reflect changes - made to the underlying SPICELIB Fortran code. - Miscellaneous header corrections were made as well. - - -CSPICE Version 1.0.0, 31-MAY-1999 (WLT) (NJB) - --Index_Entries - - rotation axis of a matrix - --& -*/ - -{ /* Begin raxisa_c */ - - /* - Local variables - */ - SpiceDouble tmpmat[3][3]; - - - /* - Error free: no error tracing. - */ - - /* - Transpose the input matrix to put it in column-major order. - */ - - xpose_c ( matrix, tmpmat ); - - raxisa_ ( ( doublereal * ) tmpmat, - ( doublereal * ) axis, - ( doublereal * ) angle ); - -} /* End raxisa_c */ - diff --git a/ext/spice/src/cspice/rdencc.c b/ext/spice/src/cspice/rdencc.c deleted file mode 100644 index 00c457f689..0000000000 --- a/ext/spice/src/cspice/rdencc.c +++ /dev/null @@ -1,538 +0,0 @@ -/* rdencc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; - -/* $Procedure RDENCC ( Read encoded characters from a text file ) */ -/* Subroutine */ int rdencc_(integer *unit, integer *n, char *data, ftnlen - data_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_rsle(cilist *), do_lio(integer *, - integer *, char *, ftnlen), e_rsle(void); - - /* Local variables */ - integer nescd; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer intch; - logical error; - char ch[1]; - extern /* Subroutine */ int hx2int_(char *, integer *, logical *, char *, - ftnlen, ftnlen); - logical escape; - char encchr[64]; - integer dtalen, dtalin, nchars, encpos, dtapos; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char errmsg[80]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer iostat; - char hexnum[2]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___11 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Read and decode encoded characters from a text file. */ - -/* $ 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 */ - -/* CHARACTERS */ -/* CONVERSION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number of input text file. */ -/* N I Number of characters to be read and decoded. */ -/* DATA O List of decoded characters to be returned. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for a previously opened text */ -/* file. All reading will begin at the CURRENT POSITION */ -/* in the text file. */ - -/* N The number of characters to be read from the text file */ -/* attached to UNIT. */ - -/* $ Detailed_Output */ - -/* DATA List of characters which were read from the text file */ -/* attached to UNIT and decoded. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N, the number of data items, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while reading from the text file */ -/* attached to UNIT, the error SPICE(FILEREADFAILED) will */ -/* be signalled. */ - -/* 3) If an error occurs while decoding a character, the error */ -/* SPICE(DECODINGERROR) will be signalled. */ - -/* $ Files */ - -/* See the description of UNIT in Detailed_Input. */ - -/* $ Particulars */ - -/* This routine will read quoted character strings of length */ -/* MAXENC containing encoded characters produced by the routine */ -/* WRENCC, or some equivalent procedure. The reading begins at */ -/* the current position in a previously opened text file attached */ -/* to logical UNIT and continues until N contiguous characters */ -/* have been successfully decoded and placed in the data buffer */ -/* DATA or an error occurs. The current position in a file is */ -/* defined to be the text line immediately following the last text */ -/* line that was written or read. */ - -/* The character strings are quoted so that a Fortran list directed */ -/* read may be used to read them, rather than a formatted read with */ -/* the format specifier FMT = '(A)'. */ - -/* As the characters are decoded they are placed into the first N */ -/* contiguous positions in the data buffer DATA, where the first N */ -/* contiguous positions are determined by moving from the lowest */ -/* array indices to highest array indices, i.e., moving from ``left'' */ -/* to ``right'' and ``top'' to ``bottom'' in the character array */ -/* DATA, beginning at the first character position, DATA(1)(1:1). So, */ -/* logically all of the quoted strings containing encoded data can */ -/* be thought of as being concatenated together into one long */ -/* character string. */ - -/* This routine is one of a pair of routines which are used to */ -/* encode and decode ASCII characters: */ - -/* WRENCC -- Encode and write ASCII characters to a file. */ -/* RDENCC -- Read and decode ASCII characters from a file. */ - -/* The encoding/decoding of characters is performed to provide */ -/* a portable means for transferring character data values. */ - -/* This routine is for use with the ASCII character set and */ -/* extensions to it. The supported characters must have decimal */ -/* values in the range from 0 to 255. */ - -/* $ Examples */ - -/* The following examples demonstrate the use of this routine. In */ -/* each of the examples, the variable UNIT is the Fortran logical */ -/* unit of a previously opened text file, and the variable N is */ -/* an integer which will represent the number of characters to be */ -/* read and decoded. */ - -/* The first example demonstrates a typical correct usage of this */ -/* routine. The second example demonstrates what would probably be */ -/* the most common incorrect usage of this routine. These examples */ -/* are meant to be illustrative, so for the sake of brevity and */ -/* clarity, the length of the quoted strings expected in the input */ -/* text file has been shortened. */ - -/* The examples use as data correctly and incorrectly encoded */ -/* versions of the following character string which has a length */ -/* of exactly 64 characters: */ - -/* 'Here is some data. What follows is more '// */ -/* 'data. This is more data. ' */ - -/* Example 1 */ -/* --------- */ - -/* This example demonstrates a typical usage of this routine. */ - -/* Let the symbol '-->' denote the file pointer. */ - -/* Let the current file pointer position and succeeding data be */ -/* the following: */ - -/* --> 'Here is some data. W' */ -/* 'hat follows is more ' */ -/* 'data. This is more d' */ -/* 'ata. ' */ - -/* There are exactly N = 64 characters of encoded data. */ - -/* Let the character data buffer have the following */ -/* declaration in the calling program: */ - -/* CHARACTER*(40) DATA(2) */ - -/* Then, the subroutine call */ - -/* CALL RDENCC( UNIT, N, DATA ) */ - -/* with N = 64 would produce the following results: */ - -/* DATA(1) = 'Here is some data. What follows is more ' */ -/* DATA(2) = 'data. This is more data.' */ - -/* Example 2 */ -/* --------- */ - -/* This example is meant to demonstrate what would probably be */ -/* a common misuse of this routine. */ - -/* Let the symbol '-->' denote the file pointer. */ - -/* Let the current file pointer position and succeeding data be */ -/* the following: */ - -/* --> 'Here is some data. ' */ -/* 'What follows is more' */ -/* 'data. This is more ' */ -/* 'data. ' */ - -/* As in example 1, there are exactly N = 64 characters of */ -/* encoded data, but to make the data more ``readable'' two extra */ -/* spaces have been added: one at the end of the first line and */ -/* one at the end of the third line. */ - -/* Let the character data buffer have the following */ -/* declaration in the calling program: */ - -/* CHARACTER*(40) DATA(2) */ - -/* Then, the subroutine call */ - -/* CALL RDENCC( UNIT, N, DATA ) */ - -/* with N = 64 would produce the following results: */ - -/* DATA(1) = 'Here is some data. What follows is more' */ -/* DATA(2) = ' data. This is more dat' */ - -/* This is probably not what was desired. The problem is that */ -/* the ``significant'' characters in the encoded string do not */ -/* appear contiguously; an ``extra'' blank appears at the end */ -/* of the first and third encoded quoted strings. */ - -/* Example 3 */ -/* --------- */ - -/* This example demonstrates the use of WRENCC and RDENCC for */ -/* writing and subsequent reading of character data using data */ -/* buffers that are ``shaped'' differently, i.e., that have */ -/* different dimensions. */ - -/* Let the input and output character data buffers have the */ -/* following declarations: */ - -/* CHARACTER*(25) OUTBUF(3) */ -/* CHARACTER*(10) INPBUF(7) */ - -/* Further, let the output buffer contain the following data: */ - -/* OUTBUF(1) = 'Today is the first day of' */ -/* OUTBUF(2) = ' the rest of my life, so ' */ -/* OUTBUF(3) = 'I will enjoy it.' */ - -/* There are exactly N = 66 significant characters in the output */ -/* buffer. The code fragment */ - -/* N = 66 */ -/* CALL WRENCC ( UNIT, N, OUTBUF ) */ -/* REWIND ( UNIT ) */ -/* CALL RDENCC ( UNIT, N, INPBUF ) */ - -/* has the effect of placing the original data into the */ -/* differently ``shaped'' input buffer with the following */ -/* results: */ - -/* INPBUF(1) = 'Today is t' */ -/* INPBUF(2) = 'he first d' */ -/* INPBUF(3) = 'ay of the ' */ -/* INPBUF(4) = 'rest of my' */ -/* INPBUF(5) = ' life, so ' */ -/* INPBUF(6) = 'I will enj' */ -/* INPBUF(7) = 'oy it. ' */ - -/* No information has been lost, it is simply arranged differently. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read encoded characters from a text file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDENCC", (ftnlen)6); - } - -/* Check to see if the number of data items is less than or equal */ -/* to zero. If it is, signal an error. */ - - if (*n < 1) { - setmsg_("The number of data items to be read was not positive: #.", ( - ftnlen)56); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("RDENCC", (ftnlen)6); - return 0; - } - -/* Initialize some stuff here */ - -/* Make sure that the encoding character string is empty when we */ -/* start. */ - - s_copy(encchr, " ", (ftnlen)64, (ftnlen)1); - -/* We have not encountered any errors yet, so set the error indicator */ -/* to .FALSE.. */ - - error = FALSE_; - -/* Get the length of a data ``line'' in the data buffer DATA. */ - - dtalen = i_len(data, data_len); - -/* We are not currently parsing an escaped character, so set the */ -/* escape indicator to .FALSE. and set the number of escape digits */ -/* to zero. */ - - escape = FALSE_; - nescd = 0; - -/* Set the initial line and position for the output data buffer. */ - - dtapos = 1; - dtalin = 1; - -/* Set the initial position in the encoding buffer to be 1 too */ -/* big so that we read an encoded character string from the file */ -/* attached to UNIT on the first pass through the loop. */ - - encpos = 65; - -/* Set the number of characters decoded to zero and begin the */ -/* decoding loop. */ - - nchars = 0; - while(nchars < *n) { - -/* If the last character we processed was the last one in the */ -/* encoded character string, then we need to read in the next */ -/* encoded character string from the file. This also accomplishes */ -/* the task of reading in the first encoded character string. */ - - if (encpos > 64) { - io___11.ciunit = *unit; - iostat = s_rsle(&io___11); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, encchr, (ftnlen)64); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsle(); -L100001: - if (iostat != 0) { - setmsg_("Error reading from logical unit #, IOSTAT = #.", ( - ftnlen)46); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("RDENCC", (ftnlen)6); - return 0; - } - -/* Set the pointer for the encoded character buffer to the */ -/* beginning of the buffer. */ - - encpos = 1; - } - *(unsigned char *)ch = *(unsigned char *)&encchr[encpos - 1]; - -/* If we are processing a character which was escaped when it was */ -/* encoded, we need to do some special stuff. */ - - if (escape) { - ++nescd; - if (nescd == 2) { - -/* If we have all of the digits in the encoded character, */ -/* then decode it. */ - - *(unsigned char *)&hexnum[nescd - 1] = *(unsigned char *)ch; - hx2int_(hexnum, &intch, &error, errmsg, (ftnlen)2, (ftnlen)80) - ; - if (error) { - setmsg_("Decoding error occurred while attempting to dec" - "ode item #: @#. #", (ftnlen)64); - i__1 = nchars + 1; - errint_("#", &i__1, (ftnlen)1); - errch_("#", hexnum, (ftnlen)1, (ftnlen)2); - errch_("#", errmsg, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(DECODINGERROR)", (ftnlen)20); - chkout_("RDENCC", (ftnlen)6); - return 0; - } - *(unsigned char *)ch = (char) intch; - -/* We now have the decoded character. We are no longer */ -/* processing an escaped character, so set the escape */ -/* indicator to .FALSE. and continue. The character we */ -/* just decoded will be placed into the data buffer DATA */ -/* below. */ - - escape = FALSE_; - nescd = 0; - } else if (nescd < 2 && nescd > 0) { - -/* Otherwise we are still collecting the digits of the */ -/* encoded character, so store the current character and */ -/* move on to the next one. */ - - *(unsigned char *)&hexnum[nescd - 1] = *(unsigned char *)ch; - } - } else { - -/* Check to see if the current character is the escape */ -/* character. If it is, we need to set the escape indicator */ -/* to .TRUE. so that we correctly process the encoded */ -/* digits. */ - - if (*(unsigned char *)ch == '@') { - escape = TRUE_; - } - } - -/* At this point one of the following is true: */ - -/* (1) CH contains a character to be placed into the data */ -/* buffer DATA. */ - -/* (2) We are currently building an escaped character from */ -/* its escape sequence, ESCAPE = .TRUE., and CH contains */ -/* some part of the escape sequence. */ - -/* If we are not currently decoding an escaped character, then */ -/* we need to store the character value that we have in the data */ -/* buffer, and move on to the next character. */ - - if (! escape) { - ++nchars; - -/* If the position in the data buffer is greater than the */ -/* length of a data line (DTALEN) then we need to increment */ -/* the current data line (DTALIN) and reset the current data */ -/* line buffer position (DTAPOS). */ - - if (dtapos > dtalen) { - ++dtalin; - dtapos = 1; - } - -/* Store the current character in the data buffer and */ -/* increment the buffer position. */ - - *(unsigned char *)&data[(dtalin - 1) * data_len + (dtapos - 1)] = - *(unsigned char *)ch; - ++dtapos; - } - -/* Increment the encoded character buffer position */ - - ++encpos; - -/* At this point, we know the following: */ - -/* (1) 1 <= ENCPOS <= MAXENC */ -/* (2) 1 <= NCHARS <= N */ -/* (3) 1 <= DTAPOS <= DTALEN */ -/* (4) 1 <= DTALIN */ -/* (5) 0 <= NESCD <= MXESCD */ -/* (6) ESCAPE is .TRUE. if we are currently decoding an escaped */ -/* character, otherwise it is .FALSE.. */ - - } - chkout_("RDENCC", (ftnlen)6); - return 0; -} /* rdencc_ */ - diff --git a/ext/spice/src/cspice/rdencd.c b/ext/spice/src/cspice/rdencd.c deleted file mode 100644 index a3532edb40..0000000000 --- a/ext/spice/src/cspice/rdencd.c +++ /dev/null @@ -1,338 +0,0 @@ -/* rdencd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; - -/* $Procedure RDENCD ( Read encoded d.p. numbers from file ) */ -/* Subroutine */ int rdencd_(integer *unit, integer *n, doublereal *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rsle(cilist *), s_rnge(char *, integer, char *, integer), - do_lio(integer *, integer *, char *, ftnlen), e_rsle(void); - - /* Local variables */ - char work[64*64]; - extern /* Subroutine */ int hx2dp_(char *, doublereal *, logical *, char * - , ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical error; - integer nitms, itmbeg; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char errmsg[80]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___4 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Read N encoded d.p. numbers from a text file, decoding them */ -/* into their equivalent d.p. numbers. */ - -/* $ 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 */ - -/* CONVERSION */ -/* NUMBERS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number of input text file. */ -/* N I Number of d.p. numbers to read and decode. */ -/* DATA I List of decoded d.p. numbers. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for a previously opened text */ -/* file. All reading will begin at the CURRENT POSITION */ -/* in the text file. */ - -/* N The number of encoded double precision numbers, to be */ -/* read from the text file attached to UNIT. */ - -/* $ Detailed_Output */ - -/* DATA List of decoded double precision numbers read from the */ -/* text file attached to UNIT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N, the number of data items, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while reading from the text file */ -/* attached to UNIT, the error SPICE(FILEREADFAILED) will */ -/* be signalled. */ - -/* 3) If an error occurs while decoding a number, the error */ -/* SPICE(DECODINGERROR) will be signalled. */ - -/* $ Files */ - -/* See the description of UNIT in Detailed_Input. */ - -/* $ Particulars */ - -/* This routine will read N encoded double precision numbers from */ -/* the current position in a previously opened text file. The */ -/* current position in a file is defined to be the text line */ -/* immediately following the last text line that was written or */ -/* read. The numbers will be decoded and placed into a list of */ -/* double precision numbers which will be passed back to the caller. */ -/* The encoded double precision numbers are represented as quoted */ -/* character strings so that a Fortran list directed read may be */ -/* used to read the encoded values, rather than a formatted read */ -/* with the format specifier FMT = '(A)'. */ - -/* This routine is one of a pair of routines which are used to */ -/* encode and decode d.p. numbers: */ - -/* WRENCD -- Encode and write d.p. numbers to a file. */ -/* RDENCD -- Read and decode d.p. numbers from a file. */ - -/* The encoding/decoding of d.p. numbers is performed to provide a */ -/* portable means for transferring data values. */ - -/* Currently the encoded d.p. numbers are represented in a base */ -/* 16 ``scientific notation.'' See DP2HX.FOR and HX2DP.FOR for */ -/* details. */ - -/* $ Examples */ - -/* Suppose we have the following input file which contains the */ -/* values 1.0D0 - 100.0D0 in encoded format, and that the input */ -/* file has already been opened for reading. The arrow, '-->', */ -/* indicates the current position in the file. */ - -/* -->'1^1' '2^1' '3^1' '4^1' '5^1' '6^1' '7^1' '8^1' '9^1' */ -/* 'A^1' 'B^1' 'C^1' 'D^1' 'E^1' 'F^1' '1^2' '11^2' '12^2' */ -/* '13^2' '14^2' '15^2' '16^2' '17^2' '18^2' '19^2' '1A^2' */ -/* '1B^2' '1C^2' '1D^2' '1E^2' '1F^2' '2^2' '21^2' '22^2' */ -/* '23^2' '24^2' '25^2' '26^2' '27^2' '28^2' '29^2' '2A^2' */ -/* '2B^2' '2C^2' '2D^2' '2E^2' '2F^2' '3^2' '31^2' '32^2' */ -/* '33^2' '34^2' '35^2' '36^2' '37^2' '38^2' '39^2' '3A^2' */ -/* '3B^2' '3C^2' '3D^2' '3E^2' '3F^2' '4^2' */ -/* '41^2' '42^2' '43^2' '44^2' '45^2' '46^2' '47^2' '48^2' */ -/* '49^2' '4A^2' '4B^2' '4C^2' '4D^2' '4E^2' '4F^2' '5^2' */ -/* '51^2' '52^2' '53^2' '54^2' '55^2' '56^2' '57^2' '58^2' */ -/* '59^2' '5A^2' '5B^2' '5C^2' '5D^2' '5E^2' '5F^2' '6^2' */ -/* '61^2' '62^2' '63^2' '64^2' */ - -/* Then the following code fragment would read and decode these */ -/* 100 values. */ - -/* N = 100 */ -/* CALL RDENCD( UNIT, N, DATA ) */ - -/* Upon returning, the array data would contain the values */ -/* 1.0D0 - 100.0D0. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 19-MAR-1999 (FST) */ - -/* Modified the long error message for SPICE(FILEREADFAILED) */ -/* to indicate the possibility of an incomplete text transfer */ -/* file as the cause. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read and decode encoded d.p. numbers from a text file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDENCD", (ftnlen)6); - } - -/* Check to see if the number of data items is less than or equal */ -/* to zero. If it is, signal an error. */ - - if (*n < 1) { - setmsg_("The number of data items to be read was not positive: #.", ( - ftnlen)56); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("RDENCD", (ftnlen)6); - return 0; - } - -/* Initialize the beginning location to place the decoded data */ -/* items. */ - - itmbeg = 1; - -/* We read in the encoded numbers in blocks of size WRKSIZ, and if */ -/* there was not a read error we will attempt to decode the numbers. */ -/* We signal an error if either: */ - -/* (1) there is a read error */ -/* (2) there is an error decoding the number. */ - -/* NOTE: EOF is interpreted as a read error because we know a priori */ -/* exactly how many data items we need to read: N. */ - -/* Begin decoding the encoded data items read from the input file */ -/* in blocks of size NITMS. Each time the number of data items */ -/* NITMS is reached, decode the encoded numbers into the data array. */ - - while(itmbeg <= *n) { - -/* The number of items is either the size of the workspace, or */ -/* the number of data items which remain to be processed, which */ -/* should always be less than or equal to the size of the */ -/* workspace. */ - -/* Computing MIN */ - i__1 = 64, i__2 = *n - itmbeg + 1; - nitms = min(i__1,i__2); - -/* Read in a block of data items to be decoded. */ - - io___4.ciunit = *unit; - iostat = s_rsle(&io___4); - if (iostat != 0) { - goto L100001; - } - i__1 = nitms; - for (i__ = 1; i__ <= i__1; ++i__) { - iostat = do_lio(&c__9, &c__1, work + (((i__2 = i__ - 1) < 64 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "rdencd_", (ftnlen) - 265)) << 6), (ftnlen)64); - if (iostat != 0) { - goto L100001; - } - } - iostat = e_rsle(); -L100001: - -/* Check to see if we got a read error: IOSTAT .NE. 0. If we did, */ -/* then signal an error. EOF is considered to be a read error, */ -/* since we know exactly how many data items we expect to read. */ - - if (iostat != 0) { - setmsg_("Error reading from logical unit #, IOSTAT = #. One poss" - "ible cause is an incomplete text transfer file.", (ftnlen) - 102); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("RDENCD", (ftnlen)6); - return 0; - } - -/* Begin to decode the data items into the data array. Signal an */ -/* error if we cannot decode a data item. */ - - i__2 = nitms; - for (i__ = 1; i__ <= i__2; ++i__) { - hx2dp_(work + (((i__1 = i__ - 1) < 64 && 0 <= i__1 ? i__1 : - s_rnge("work", i__1, "rdencd_", (ftnlen)289)) << 6), & - data[itmbeg + i__ - 2], &error, errmsg, (ftnlen)64, ( - ftnlen)80); - if (error) { - setmsg_("Decoding error occurred while attempting to decode " - "item #: #. #", (ftnlen)63); - errint_("#", &i__, (ftnlen)1); - errch_("#", work + (((i__1 = i__ - 1) < 64 && 0 <= i__1 ? - i__1 : s_rnge("work", i__1, "rdencd_", (ftnlen)295)) - << 6), (ftnlen)1, (ftnlen)64); - errch_("#", errmsg, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(DECODINGERROR)", (ftnlen)20); - chkout_("RDENCD", (ftnlen)6); - return 0; - } - } - -/* Position the data item pointer at the next location to begin */ -/* placing the decoded items in the array DATA, and continue */ -/* processing the until done. */ - - itmbeg += nitms; - } - chkout_("RDENCD", (ftnlen)6); - return 0; -} /* rdencd_ */ - diff --git a/ext/spice/src/cspice/rdenci.c b/ext/spice/src/cspice/rdenci.c deleted file mode 100644 index 73281fe165..0000000000 --- a/ext/spice/src/cspice/rdenci.c +++ /dev/null @@ -1,326 +0,0 @@ -/* rdenci.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; - -/* $Procedure RDENCI ( Read encoded integers from text file ) */ -/* Subroutine */ int rdenci_(integer *unit, integer *n, integer *data) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rsle(cilist *), s_rnge(char *, integer, char *, integer), - do_lio(integer *, integer *, char *, ftnlen), e_rsle(void); - - /* Local variables */ - char work[64*64]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical error; - integer nitms; - extern /* Subroutine */ int hx2int_(char *, integer *, logical *, char *, - ftnlen, ftnlen); - integer itmbeg; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char errmsg[80]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___4 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Read N encoded integers from a text file, decoding them into */ -/* their equivalent integers. */ - -/* $ 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 */ - -/* CONVERSION */ -/* NUMBERS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number of input text file. */ -/* N I Number of integers to read and decode. */ -/* DATA I List of decoded integers. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for a previously opened text */ -/* file. All reading will begin at the CURRENT POSITION */ -/* in the text file. */ - -/* N The number of encoded integers to be read from the */ -/* text file attached to UNIT. */ - -/* $ Detailed_Output */ - -/* DATA List of decoded integers read from the text file */ -/* attached to UNIT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N, the number of data items, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while reading from the text file */ -/* attached to UNIT, the error SPICE(FILEREADFAILED) will */ -/* be signalled. */ - -/* 3) If an error occurs while decoding a number, the error */ -/* SPICE(DECODINGERROR) will be signalled. */ - -/* $ Files */ - -/* See the description of UNIT in Detailed_Input. */ - -/* $ Particulars */ - -/* This routine will read N encoded integers beginning at the */ -/* current position in a previously opened text file. The current */ -/* position in a file is defined to be the text line immediately */ -/* following the last text line that was written or read. The */ -/* integers will be decoded and placed into a list of integers */ -/* which will be passed back to the caller. The encoded integers */ -/* are represented as quoted character strings so that a Fortran */ -/* list directed read may be used to read the encoded values, */ -/* rather than a formatted read with the format specifier */ -/* FMT = '(A)'. */ - -/* This routine is one of a pair of routines which are used to */ -/* encode and decode integers: */ - -/* WRENCI -- Encode and write integers to a file. */ -/* RDENCI -- Read and decode integers from a file. */ - -/* The encoding/decoding of integers is performed to provide a */ -/* portable means for transferring data values. */ - -/* Currently the encoded integers are represented as signed */ -/* hexadecimal numbers See INT2HX.FOR and HX2INT.FOR for details. */ - -/* $ Examples */ - -/* Suppose we have the following input file which contains the values */ -/* 1 - 100 encoded, and that the input file has already been opened */ -/* for reading. The arrow, '-->', indicates the current position in */ -/* the file. */ - -/* -->'1' '2' '3' '4' '5' '6' '7' '8' '9' 'A' 'B' 'C' 'D' 'E' */ -/* 'F' '10' '11' '12' '13' '14' '15' '16' '17' '18' '19' */ -/* '1A' '1B' '1C' '1D' '1E' '1F' '20' '21' '22' '23' '24' */ -/* '25' '26' '27' '28' '29' '2A' '2B' '2C' '2D' '2E' '2F' */ -/* '30' '31' '32' '33' '34' '35' '36' '37' '38' '39' '3A' */ -/* '3B' '3C' '3D' '3E' '3F' '40' */ -/* '41' '42' '43' '44' '45' '46' '47' '48' '49' '4A' '4B' */ -/* '4C' '4D' '4E' '4F' '50' '51' '52' '53' '54' '55' '56' */ -/* '57' '58' '59' '5A' '5B' '5C' '5D' '5E' '5F' '60' '61' */ -/* '62' '63' '64' */ - -/* Then, the following code fragment would read and decode these */ -/* 100 values. */ - -/* N = 100 */ -/* CALL RDENCI( UNIT, N, DATA ) */ - -/* Upon returning, the array data would contain the values 1 - 100. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read and decode encoded integers from a text file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDENCI", (ftnlen)6); - } - -/* Check to see if the number of data items is less than or equal */ -/* to zero. If it is, signal an error. */ - - if (*n < 1) { - setmsg_("The number of data items to be read was not positive: #.", ( - ftnlen)56); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("RDENCI", (ftnlen)6); - return 0; - } - -/* Initialize the beginning location to place the decoded data */ -/* items. */ - - itmbeg = 1; - -/* We read in the encoded numbers in blocks of size WRKSIZ, and if */ -/* there was not a read error we will attempt to decode the numbers. */ -/* We signal an error if either: */ - -/* (1) there is a read error */ -/* (2) there is an error decoding a number. */ - -/* NOTE: EOF is interpreted as a read error because we know a priori */ -/* exactly how many data items we need to read: N. */ - -/* Begin decoding the encoded data items read from the input file */ -/* in blocks of size NITMS. Each time the number of data items */ -/* NITMS is reached, decode the encoded numbers into the data array. */ - - while(itmbeg <= *n) { - -/* The number of items is either the size of the workspace, or */ -/* the number of data items which remain to be processed, which */ -/* should always be less than or equal to the size of the */ -/* workspace. */ - -/* Computing MIN */ - i__1 = 64, i__2 = *n - itmbeg + 1; - nitms = min(i__1,i__2); - -/* Read in a block of data items to be decoded. */ - - io___4.ciunit = *unit; - iostat = s_rsle(&io___4); - if (iostat != 0) { - goto L100001; - } - i__1 = nitms; - for (i__ = 1; i__ <= i__1; ++i__) { - iostat = do_lio(&c__9, &c__1, work + (((i__2 = i__ - 1) < 64 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "rdenci_", (ftnlen) - 252)) << 6), (ftnlen)64); - if (iostat != 0) { - goto L100001; - } - } - iostat = e_rsle(); -L100001: - -/* Check to see if we got a read error: IOSTAT .NE. 0. If we did, */ -/* then signal an error. EOF is considered to be a read error, */ -/* since we know exactly how many data items we expect to read. */ - - if (iostat != 0) { - setmsg_("Error reading from logical unit #, IOSTAT = #.", (ftnlen) - 46); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("RDENCI", (ftnlen)6); - return 0; - } - -/* Begin to decode the data items into the data array. Signal an */ -/* error if we cannot decode a data item. */ - - i__2 = nitms; - for (i__ = 1; i__ <= i__2; ++i__) { - hx2int_(work + (((i__1 = i__ - 1) < 64 && 0 <= i__1 ? i__1 : - s_rnge("work", i__1, "rdenci_", (ftnlen)275)) << 6), & - data[itmbeg + i__ - 2], &error, errmsg, (ftnlen)64, ( - ftnlen)80); - if (error) { - setmsg_("Decoding error occurred while attempting to decode " - "item #: #. #", (ftnlen)63); - errint_("#", &i__, (ftnlen)1); - errch_("#", work + (((i__1 = i__ - 1) < 64 && 0 <= i__1 ? - i__1 : s_rnge("work", i__1, "rdenci_", (ftnlen)281)) - << 6), (ftnlen)1, (ftnlen)64); - errch_("#", errmsg, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(DECODINGERROR)", (ftnlen)20); - chkout_("RDENCI", (ftnlen)6); - return 0; - } - } - -/* Position the data item pointer at the next location to begin */ -/* placing the decoded items in the array DATA, and continue */ -/* processing the until done. */ - - itmbeg += nitms; - } - chkout_("RDENCI", (ftnlen)6); - return 0; -} /* rdenci_ */ - diff --git a/ext/spice/src/cspice/rdfmt.c b/ext/spice/src/cspice/rdfmt.c deleted file mode 100644 index 3de3e494ca..0000000000 --- a/ext/spice/src/cspice/rdfmt.c +++ /dev/null @@ -1,476 +0,0 @@ -#include "f2c.h" -#include "fio.h" - -extern int f__cursor; -#ifdef KR_headers -extern double atof(); -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -#endif - -#include "fmt.h" -#include "fp.h" -#include "ctype.h" - - static int -#ifdef KR_headers -rd_Z(n,w,len) Uint *n; ftnlen len; -#else -rd_Z(Uint *n, int w, ftnlen len) -#endif -{ - long x[9]; - char *s, *s0, *s1, *se, *t; - int ch, i, w1, w2; - static char hex[256]; - static int one = 1; - int bad = 0; - - if (!hex['0']) { - s = "0123456789"; - while(ch = *s++) - hex[ch] = ch - '0' + 1; - s = "ABCDEF"; - while(ch = *s++) - hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11; - } - s = s0 = (char *)x; - s1 = (char *)&x[4]; - se = (char *)&x[8]; - if (len > 4*sizeof(long)) - return errno = 117; - while (w) { - GET(ch); - if (ch==',' || ch=='\n') - break; - w--; - if (ch > ' ') { - if (!hex[ch & 0xff]) - bad++; - *s++ = ch; - if (s == se) { - /* discard excess characters */ - for(t = s0, s = s1; t < s1;) - *t++ = *s++; - s = s1; - } - } - } - if (bad) - return errno = 115; - w = (int)len; - w1 = s - s0; - w2 = w1+1 >> 1; - t = (char *)n; - if (*(char *)&one) { - /* little endian */ - t += w - 1; - i = -1; - } - else - i = 1; - for(; w > w2; t += i, --w) - *t = 0; - if (!w) - return 0; - if (w < w2) - s0 = s - (w << 1); - else if (w1 & 1) { - *t = hex[*s0++ & 0xff] - 1; - if (!--w) - return 0; - t += i; - } - do { - *t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1; - t += i; - s0 += 2; - } - while(--w); - return 0; - } - - static int -#ifdef KR_headers -rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base; -#else -rd_I(Uint *n, int w, ftnlen len, register int base) -#endif -{ longint x; - int sign,ch; - char s[84], *ps; - ps=s; x=0; - while (w) - { - GET(ch); - if (ch==',' || ch=='\n') break; - *ps=ch; ps++; w--; - } - *ps='\0'; - ps=s; - while (*ps==' ') ps++; - if (*ps=='-') { sign=1; ps++; } - else { sign=0; if (*ps=='+') ps++; } -loop: while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; } - if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;} - if(sign) x = -x; - if(len==sizeof(integer)) n->il=x; - else if(len == sizeof(char)) n->ic = (char)x; -#ifdef Allow_TYQUAD - else if (len == sizeof(longint)) n->ili = x; -#endif - else n->is = (short)x; - if (*ps) return(errno=115); else return(0); -} - static int -#ifdef KR_headers -rd_L(n,w,len) ftnint *n; ftnlen len; -#else -rd_L(ftnint *n, int w, ftnlen len) -#endif -{ int ch, lv; - char s[84], *ps; - ps=s; - while (w) { - GET(ch); - if (ch==','||ch=='\n') break; - *ps=ch; - ps++; w--; - } - *ps='\0'; - ps=s; while (*ps==' ') ps++; - if (*ps=='.') ps++; - if (*ps=='t' || *ps == 'T') - lv = 1; - else if (*ps == 'f' || *ps == 'F') - lv = 0; - else return(errno=116); - switch(len) { - case sizeof(char): *(char *)n = (char)lv; break; - case sizeof(short): *(short *)n = (short)lv; break; - default: *n = lv; - } - return 0; -} - - static int -#ifdef KR_headers -rd_F(p, w, d, len) ufloat *p; ftnlen len; -#else -rd_F(ufloat *p, int w, int d, ftnlen len) -#endif -{ - char s[FMAX+EXPMAXDIGS+4]; - register int ch; - register char *sp, *spe, *sp1; - double x; - int scale1, se; - long e, exp; - - sp1 = sp = s; - spe = sp + FMAX; - exp = -d; - x = 0.; - - do { - GET(ch); - w--; - } while (ch == ' ' && w); - switch(ch) { - case '-': *sp++ = ch; sp1++; spe++; - case '+': - if (!w) goto zero; - --w; - GET(ch); - } - while(ch == ' ') { -blankdrop: - if (!w--) goto zero; GET(ch); } - while(ch == '0') - { if (!w--) goto zero; GET(ch); } - if (ch == ' ' && f__cblank) - goto blankdrop; - scale1 = f__scale; - while(isdigit(ch)) { -digloop1: - if (sp < spe) *sp++ = ch; - else ++exp; -digloop1e: - if (!w--) goto done; - GET(ch); - } - if (ch == ' ') { - if (f__cblank) - { ch = '0'; goto digloop1; } - goto digloop1e; - } - if (ch == '.') { - exp += d; - if (!w--) goto done; - GET(ch); - if (sp == sp1) { /* no digits yet */ - while(ch == '0') { -skip01: - --exp; -skip0: - if (!w--) goto done; - GET(ch); - } - if (ch == ' ') { - if (f__cblank) goto skip01; - goto skip0; - } - } - while(isdigit(ch)) { -digloop2: - if (sp < spe) - { *sp++ = ch; --exp; } -digloop2e: - if (!w--) goto done; - GET(ch); - } - if (ch == ' ') { - if (f__cblank) - { ch = '0'; goto digloop2; } - goto digloop2e; - } - } - switch(ch) { - default: - break; - case '-': se = 1; goto signonly; - case '+': se = 0; goto signonly; - case 'e': - case 'E': - case 'd': - case 'D': - if (!w--) - goto bad; - GET(ch); - while(ch == ' ') { - if (!w--) - goto bad; - GET(ch); - } - se = 0; - switch(ch) { - case '-': se = 1; - case '+': -signonly: - if (!w--) - goto bad; - GET(ch); - } - while(ch == ' ') { - if (!w--) - goto bad; - GET(ch); - } - if (!isdigit(ch)) - goto bad; - - e = ch - '0'; - for(;;) { - if (!w--) - { ch = '\n'; break; } - GET(ch); - if (!isdigit(ch)) { - if (ch == ' ') { - if (f__cblank) - ch = '0'; - else continue; - } - else - break; - } - e = 10*e + ch - '0'; - if (e > EXPMAX && sp > sp1) - goto bad; - } - if (se) - exp -= e; - else - exp += e; - scale1 = 0; - } - switch(ch) { - case '\n': - case ',': - break; - default: -bad: - return (errno = 115); - } -done: - if (sp > sp1) { - while(*--sp == '0') - ++exp; - if (exp -= scale1) - sprintf(sp+1, "e%ld", exp); - else - sp[1] = 0; - x = atof(s); - } -zero: - if (len == sizeof(real)) - p->pf = x; - else - p->pd = x; - return(0); - } - - - static int -#ifdef KR_headers -rd_A(p,len) char *p; ftnlen len; -#else -rd_A(char *p, ftnlen len) -#endif -{ int i,ch; - for(i=0;i=len) - { for(i=0;i0;f__cursor--) if((ch=(*f__getn)())<0) return(ch); - if(f__cursor<0) - { if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/ - f__cursor = -f__recpos; /* is this in the standard? */ - if(f__external == 0) { - extern char *f__icptr; - f__icptr += f__cursor; - } - else if(f__curunit && f__curunit->useek) - (void) fseek(f__cf,(long) f__cursor,SEEK_CUR); - else - err(f__elist->cierr,106,"fmt"); - f__recpos += f__cursor; - f__cursor=0; - } - switch(p->op) - { - default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op); - sig_die(f__fmtbuf, 1); - case IM: - case I: ch = rd_I((Uint *)ptr,p->p1,len, 10); - break; - - /* O and OM don't work right for character, double, complex, */ - /* or doublecomplex, and they differ from Fortran 90 in */ - /* showing a minus sign for negative values. */ - - case OM: - case O: ch = rd_I((Uint *)ptr, p->p1, len, 8); - break; - case L: ch = rd_L((ftnint *)ptr,p->p1,len); - break; - case A: ch = rd_A(ptr,len); - break; - case AW: - ch = rd_AW(ptr,p->p1,len); - break; - case E: case EE: - case D: - case G: - case GE: - case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len); - break; - - /* Z and ZM assume 8-bit bytes. */ - - case ZM: - case Z: - ch = rd_Z((Uint *)ptr, p->p1, len); - break; - } - if(ch == 0) return(ch); - else if(ch == EOF) return(EOF); - if (f__cf) - clearerr(f__cf); - return(errno); -} -#ifdef KR_headers -rd_ned(p) struct syl *p; -#else -rd_ned(struct syl *p) -#endif -{ - switch(p->op) - { - default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op); - sig_die(f__fmtbuf, 1); - case APOS: - return(rd_POS(p->p2.s)); - case H: return(rd_H(p->p1,p->p2.s)); - case SLASH: return((*f__donewrec)()); - case TR: - case X: f__cursor += p->p1; - return(1); - case T: f__cursor=p->p1-f__recpos - 1; - return(1); - case TL: f__cursor -= p->p1; - if(f__cursor < -f__recpos) /* TL1000, 1X */ - f__cursor = -f__recpos; - return(1); - } -} diff --git a/ext/spice/src/cspice/rdker.c b/ext/spice/src/cspice/rdker.c deleted file mode 100644 index 1c398875da..0000000000 --- a/ext/spice/src/cspice/rdker.c +++ /dev/null @@ -1,1084 +0,0 @@ -/* rdker.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_true = TRUE_; -static logical c_false = FALSE_; - -/* $Procedure RDKER ( Read a kernel file ) */ -/* Subroutine */ int rdker_0_(int n__, char *kernel, char *line, integer * - number, logical *eof, ftnlen kernel_len, ftnlen line_len) -{ - /* Initialized data */ - - static logical frstim = TRUE_; - static char file[255] = " " - " " - " " - " " - " "; - static integer linnum = 0; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzsetnnread_(logical *); - static integer i__, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char first[80]; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - static char begdat[10]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static char begtxt[10]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), cltext_(char *, ftnlen), rdtext_(char *, char *, logical - *, ftnlen, ftnlen); - extern logical return_(void); - static integer status; - static logical end; - -/* $ Abstract */ - -/* Open and read the contents of a SPICE ASCII kernel file. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O ENTRY */ -/* -------- --- -------------------------------------------------- */ -/* KERNEL I RDKNEW */ -/* LINE O RDKDAT */ -/* NUMBER O RDKLIN */ -/* EOF O RDKDAT */ - -/* $ Detailed_Input */ - -/* All input is through entry RDKNEW. */ - -/* $ Detailed_Output */ - -/* All output is through entry RDKDAT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If RDKER is called directly, the error SPICE(BOGUSENTRY) is */ -/* signalled. */ - -/* $ Files */ - -/* The SPICE ASCII kernel file KERNEL is opened by RDKNEW and read */ -/* by RDKDAT. The entry point RDKLIN is available for reporting */ -/* the name of the open file and the number of the last line that */ -/* was read from that file. */ - -/* $ Particulars */ - -/* RDKER should never be called directly, but should instead be */ -/* accessed only through its entry points, RDKNEW, RDKDAT and */ -/* RDKLIN. */ - -/* $ Examples */ - -/* In the following example, RDKNEW and RDKDAT are used to read */ -/* the contents of a kernel file. */ - -/* Let the file KERNEL contain the following lines. */ - -/* ============================================================= */ - -/* DELTA_T_A is defined to be 32.184 seconds, and should not */ -/* be changed except under the most unusual circumstances. */ - -/* \begindata */ - -/* DELTA_T_A = 32.184 */ - -/* \begintext */ - -/* The next three items determine the relativistic correction */ -/* in the difference ET - TAI. To turn the correction off, */ -/* just set K to zero. */ - -/* \begindata */ - -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ - -/* ============================================================= */ - -/* Then the code fragment */ - -/* CALL RDKNEW ( KERNEL ) */ -/* CALL RDKDAT ( LINE, EOF ) */ - -/* DO WHILE ( (.NOT. EOF) .AND. ( .NOT. FAILED () ) ) */ -/* WRITE (6,*) LINE */ -/* CALL RDKDAT ( LINE, EOF ) */ -/* END DO */ - -/* prints the following lines. */ - -/* ============================================================= */ -/* DELTA_T_A = 32.184 */ -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ -/* ============================================================= */ - -/* $ Restrictions */ - -/* The input file must be opened and initialized by RDKNEW prior */ -/* to the first call to RDKDAT. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.5.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 3.4.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 3.3.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 3.2.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 3.1.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 3.0.0, 11-FEB-2008 (NJB) */ - -/* Entry points RDKNEW and RDKDAT have been updated so as to be */ -/* able to parse text kernel lines containing tab characters. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.3.0, 14-NOV-2005 (BVS) */ - -/* Reinstated HP_C environment. */ - -/* - SPICELIB Version 2.2.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.1.0, 03-OCT-2005 (EDW) */ - -/* File rdker.f made a master file so as to */ -/* add the ZZSETNNREAD call. This call will exist */ -/* only in FORTRAN source intended for conversion */ -/* to C by the f2c utility. */ - -/* The ZZSETNNREAD call activates and deactivates */ -/* the non-native text line read capability for the */ -/* CSPICE toolkit. */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - SPICELIB Version 2.0.0, 20-SEP-1995 (WLT) */ - -/* The entry point RDKLIN was added. */ - -/* - SPICELIB Version 1.3.0, 22-SEP-1993 (NJB) */ - -/* Updated for port to NeXT. The "previous kernel" is now closed */ -/* only if there actually was a previous kernel. */ - -/* - SPICELIB Version 1.2.0, 01-JUN-1992 (MJS) */ - -/* RDKER now initializes the variables BEGDAT and BEGTXT */ -/* in a portable way. On the first valid entry to this routine, */ -/* the backslash character in the form CHAR(92) is concatenated */ -/* individually to 'begindata' and 'begintext'. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 7-DEC-1990 (HAN) */ - -/* The declarations for BEGDAT and BEGTXT were changed from */ -/* CHARACTER*10 to CHARACTER*(*). */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read a kernel file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 20-SEP-1995 (WLT) */ - -/* The entry point RDKLIN was added. */ - -/* - SPICELIB Version 1.3.0, 22-SEP-1993 (NJB) */ - -/* Updated for port to NeXT. The "previous kernel" is now closed */ -/* only if there actually was a previous kernel. */ - -/* In the last version of this routine, on the first entry into */ -/* the routine, the variable FILE, which records the name of */ -/* the last kernel accessed, was passed to CLTEXT. CLTEXT */ -/* executed an INQUIRE statement using this name, which was */ -/* not initialized. On the NeXT, this caused the INQUIRE */ -/* statement to fail. */ - - -/* - SPICELIB Version 1.2.0, 01-JUN-1992 (MJS) */ - -/* RDKER now initializes the variables BEGDAT and BEGTXT */ -/* in a portable way. On the first valid entry to this routine, */ -/* the backslash character in the form CHAR(92) is concatenated */ -/* individually to 'begindata' and 'begintext'. As a result of */ -/* this change, this module is no longer considered environment */ -/* specific. All references in the header to the previous method */ -/* of initialization were removed. */ - -/* FILE is now initialized to ' '. Before this modification, if */ -/* a call to RDKDAT was performed prior to RDKNEW, RDTEXT */ -/* would have printed out garbage (on some machines) in its */ -/* error message when notifiying the user that it couldn't read */ -/* from FILE. */ - -/* - SPICELIB Version 1.1.0, 7-DEC-1990 (HAN) */ - -/* The declarations for BEGDAT and BEGTXT were changed from */ -/* CHARACTER*10 to CHARACTER*(*). The fixed length of 10 was */ -/* not long enough. */ - -/* - Beta Version 1.1.0, 9-MAR-1989 (HAN) */ - -/* Moved the declaration of the parameters BEGDAT and */ -/* BEGTXT from the code to the Declarations section. */ -/* Filled out the Brief I/O and Parameters sections. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Because some environments (such as the SUN) treat the backslash */ -/* character as a special character, some gyrations are needed to */ -/* put it into a variable in a "portable" way. This is the reason */ -/* for the following block of declarations. Admittedly this is */ -/* bizarre, but it works. */ - - -/* The ASCII decimal code for the tab character is 9. */ - - -/* Local variables */ - - -/* Save EVERYTHING. */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_rdknew; - case 2: goto L_rdkdat; - case 3: goto L_rdklin; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDKER", (ftnlen)5); - } - -/* Calling RDKER directly is a serious breach of protocol. */ -/* If RDKER is called, an error is signalled. */ - - setmsg_("RDKER: You have called an entry which performs no run-time func" - "tion. This may indicate a bug. Please check the documentation fo" - "r the subroutine RDKER.", (ftnlen)150); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("RDKER", (ftnlen)5); - return 0; -/* $Procedure RDKNEW ( Open and initialize a new kernel file ) */ - -L_rdknew: -/* $ Abstract */ - -/* Open and initialize a SPICE ASCII kernel file. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) KERNEL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KERNEL I Kernel file. */ - -/* $ Detailed_Input */ - -/* KERNEL is the name of the SPICE ASCII kernel file to be */ -/* opened and initialized. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* The SPICE ASCII kernel file KERNEL is opened by RDKNEW and read */ -/* by RDKDAT. */ - -/* $ Particulars */ - -/* RDKNEW should be called prior to the first call to RDKDAT. */ -/* RDKNEW opens the kernel file and RDKDAT reads the lines of */ -/* data in the file. */ - -/* $ Examples */ - -/* In the following example, RDKNEW and RDKDAT are used to read */ -/* the contents of a kernel file. */ - -/* Let the file KERNEL contain the following lines. */ - -/* ============================================================= */ - -/* DELTA_T_A is defined to be 32.184 seconds, and should not */ -/* be changed except under the most unusual circumstances. */ - -/* \begindata */ - -/* DELTA_T_A = 32.184 */ - -/* \begintext */ - -/* The next three items determine the relativistic correction */ -/* in the difference ET - TAI. To turn the correction off, */ -/* just set K to zero. */ - -/* \begindata */ - -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ - -/* ============================================================= */ - -/* Then the code fragment */ - -/* CALL RDKNEW ( KERNEL ) */ -/* CALL RDKDAT ( LINE, EOF ) */ - -/* DO WHILE ( (.NOT. EOF) .AND. ( .NOT. FAILED () ) ) */ -/* WRITE (6,*) LINE */ -/* CALL RDKDAT ( LINE, EOF ) */ -/* END DO */ - -/* prints the following lines. */ - -/* ============================================================= */ -/* DELTA_T_A = 32.184 */ -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ -/* ============================================================= */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 11-FEB-2008 (NJB) */ - -/* This entry point has been updated so as to be */ -/* able to parse text kernel lines containing tab */ -/* characters. */ - -/* - SPICELIB Version 2.1.0, 03-OCT-2005 (EDW) */ - -/* File rdker.f made a master file so as to */ -/* add the ZZSETNNREAD call. This call will exist */ -/* only in FORTRAN source intended for conversion */ -/* to C by the f2c utility. */ - -/* The ZZSETNNREAD call activates and deactivates */ -/* the non-native text line read capability for the */ -/* CSPICE toolkit. */ - -/* - SPICELIB Version 2.0.0, 20-SEP-1995 (WLT) */ - -/* The entry point RDKLIN was added. */ - -/* - SPICELIB Version 1.2.0, 01-JUN-1992 (MJS) */ - -/* RDKER now initializes the variables BEGDAT and BEGTXT */ -/* in a portable way. On the first valid entry to this routine, */ -/* the backslash character in the form CHAR(92) is concatenated */ -/* individually to 'begindata' and 'begintext'. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* open and initialize a new kernel file */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDKNEW", (ftnlen)6); - } - -/* Initialize the data delimiters if it hasn't been done already. */ - - if (frstim) { - s_copy(begdat, "\\begindata", (ftnlen)10, (ftnlen)10); - s_copy(begtxt, "\\begintext", (ftnlen)10, (ftnlen)10); - frstim = FALSE_; - } else { - -/* Close the previous file, if it hasn't been closed already. */ - - cltext_(file, (ftnlen)255); - } - -/* Close the new file, too, in case they are the same. No sense */ -/* burning up logical units. */ - - cltext_(kernel, kernel_len); - -/* Read the first line of the file. It can't possibly be a data */ -/* line, since data must be preceded by a \begindata marker, so */ -/* we needn't take any pains to save it. */ - -/* We also initialize LINNUM to 1 so we know */ -/* the line number of the last line read and can return this */ -/* information from RDKLIN. */ - - -/* The ZZSETNNREAD calls will not exist in source files intended */ -/* for the FORTRAN toolkit files, they exists only to provide f2c */ -/* a stub for translation to C. */ - - zzsetnnread_(&c_true); - rdtext_(kernel, first, &end, kernel_len, (ftnlen)80); - zzsetnnread_(&c_false); - -/* Replace any tab characters with blanks. */ - - r__ = rtrim_(first, (ftnlen)80); - i__1 = r__; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&first[i__ - 1] == 9) { - *(unsigned char *)&first[i__ - 1] = ' '; - } - } - ljust_(first, first, (ftnlen)80, (ftnlen)80); - linnum = 1; - -/* The first line is enough to set the status for subsequent */ -/* calls to RDKDAT. */ - - if (end) { - status = 3; - cltext_(kernel, kernel_len); - } else if (s_cmp(first, begdat, (ftnlen)80, (ftnlen)10) == 0) { - status = 2; - } else { - status = 1; - } - -/* Save the name of the file for future reference. */ - - s_copy(file, kernel, (ftnlen)255, kernel_len); - chkout_("RDKNEW", (ftnlen)6); - return 0; -/* $Procedure RDKDAT ( Read the next data line from a kernel file ) */ - -L_rdkdat: -/* $ Abstract */ - -/* Read the next line of data from a SPICE ASCII kernel file. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) LINE */ -/* LOGICAL EOF */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LINE O Next line of kernel data. */ -/* EOF O End of file indicator. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* LINE is the next line of data from the kernel file */ -/* most recently opened by NEWKER. Data lines are */ -/* non-blank lines which lie between \begindata */ -/* and \begintext markers. Lines are returned left */ -/* justified. */ - -/* EOF is true when the end of the kernel file has been */ -/* reached, and is false otherwise. The kernel file */ -/* is closed automatically when the end of the file */ -/* is reached. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* The SPICE ASCII kernel file KERNEL is opened by RDKNEW and read */ -/* by RDKDAT. */ - -/* $ Particulars */ - -/* RDKDAT is used internally by RDKVAR to retrieve successive lines */ -/* of data from the current kernel file. It exists primarily to */ -/* relieve RDKVAR of the responsibility of dealing with comment */ -/* blocks and blank lines. */ - -/* $ Examples */ - -/* In the following example, RDKNEW and RDKDAT are used to read */ -/* the contents of a kernel file. */ - -/* Let the file KERNEL contain the following lines. */ - -/* ============================================================= */ - -/* DELTA_T_A is defined to be 32.184 seconds, and should not */ -/* be changed except under the most unusual circumstances. */ - -/* \begindata */ - -/* DELTA_T_A = 32.184 */ - -/* \begintext */ - -/* The next three items determine the relativistic correction */ -/* in the difference ET - TAI. To turn the correction off, */ -/* just set K to zero. */ - -/* \begindata */ - -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ - -/* ============================================================= */ - -/* Then the code fragment */ - -/* CALL RDKNEW ( KERNEL ) */ -/* CALL RDKDAT ( LINE, EOF ) */ - -/* DO WHILE ( (.NOT. EOF) .AND. ( .NOT. FAILED () ) ) */ -/* WRITE (6,*) LINE */ -/* CALL RDKDAT ( LINE, EOF ) */ -/* END DO */ - -/* prints the following lines. */ - -/* ============================================================= */ -/* DELTA_T_A = 32.184 */ -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ -/* ============================================================= */ - -/* $ Restrictions */ - -/* The input file must be opened and initialized by NEWKER prior */ -/* to the first call to RDKDAT. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 11-FEB-2008 (NJB) */ - -/* This entry point has been updated so as to be */ -/* able to parse text kernel lines containing tab */ -/* characters. */ - -/* - SPICELIB Version 2.1.0, 03-OCT-2005 (EDW) */ - -/* File rdker.f made a master file so as to */ -/* add the ZZSETNNREAD call. This call will exist */ -/* only in FORTRAN source intended for conversion */ -/* to C by the f2c utility. */ - -/* The ZZSETNNREAD call activates and deactivates */ -/* the non-native text line read capability for the */ -/* CSPICE toolkit. */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - SPICELIB Version 2.0.0, 20-SEP-1995 (WLT) */ - -/* The entry point RDKLIN was added. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read the next data line from a kernel file */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 23-OCT-1989 (HAN) */ - -/* A FAILED test was added to the DO-loop which reads */ -/* lines in the kernel file. */ - -/* If the error action was set to 'RETURN' an infinite loop */ -/* could have resulted if RDTEXT failed and the loop conditions */ -/* were satisfied. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDKDAT", (ftnlen)6); - } - -/* If the previous call detected the end of the file, */ -/* this one should do the same. */ - - if (status == 3) { - *eof = TRUE_; - chkout_("RDKDAT", (ftnlen)6); - return 0; - } - -/* Well, at least we can try to read a line. Adjust the status as */ -/* needed, return if appropriate, read another line if necessary. */ -/* Basically, we're looking for a non-blank line in a data segment. */ - -/* Note that after every read, we increment LINNUM so we know */ -/* the line number of the last line read and can return this */ -/* information from RDKLIN. */ - - s_copy(line, " ", line_len, (ftnlen)1); - while(! failed_() && (status == 1 || s_cmp(line, " ", line_len, (ftnlen)1) - == 0)) { - -/* The ZZSETNNREAD calls will not exist in source files intended */ -/* for the FORTRAN toolkit files, they exists only to provide f2c */ -/* a stub for translation to C. */ - - zzsetnnread_(&c_true); - rdtext_(file, line, eof, (ftnlen)255, line_len); - zzsetnnread_(&c_false); - -/* Replace any tab characters with blanks. */ - - r__ = rtrim_(line, line_len); - i__1 = r__; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&line[i__ - 1] == 9) { - *(unsigned char *)&line[i__ - 1] = ' '; - } - } - ljust_(line, line, line_len, line_len); - ++linnum; - if (*eof) { - status = 3; - cltext_(file, (ftnlen)255); - chkout_("RDKDAT", (ftnlen)6); - return 0; - } else if (s_cmp(line, begtxt, line_len, (ftnlen)10) == 0) { - status = 1; - } else if (s_cmp(line, begdat, line_len, (ftnlen)10) == 0) { - status = 2; - s_copy(line, " ", line_len, (ftnlen)1); - } - } - chkout_("RDKDAT", (ftnlen)6); - return 0; -/* $Procedure RDKLIN ( Reading kernel at line number ) */ - -L_rdklin: -/* $ Abstract */ - -/* Return the name of file and line number of the last line read by */ -/* the entry point RDKDAT. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) FILE */ -/* INTEGER NUMBER */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KERNEL O The name of the current file that is being read */ -/* NUMBER O The line number of the last line read in the file */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* KERNEL is the name of the last file supplied via a call */ -/* to RDKNEW. If no call to RDKNEW have been made */ -/* KERNEL is returned as a blank. If KERNEL is not */ -/* sufficiently long to hold th name of the file, the */ -/* file name will be truncated on the right. */ - -/* NUMBER is the number of the last line in KERNEL returned by */ -/* a call to RDKDAT. If no call to RDKNEW or RDKDAT */ -/* have been made NUMBER is returned with the value 0. */ - - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If no calls to RDKNEW have been made, KERNEL is returned as */ -/* a blank and NUMBER is returned with the value 0. */ - -/* 2) If no calls to RDKDAT have been made but RDKNEW has been */ -/* called NUMBER is returned with the value 1. */ - -/* 3) If KERNEL is not sufficiently long to hold the name of the */ -/* file being read, the name will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a utility to aid in determining the last */ -/* line read in a text file that is being read via RDKDAT. */ - -/* It is particular useful in pointing out the location of */ -/* an error in an input file. */ - -/* $ Examples */ - -/* Suppose that you are processing a file and have detected an */ -/* error in the syntax in the file. The following code fragment */ -/* illustrates how you can use this routine to inform a user of */ -/* the location of the error in the file. */ - -/* CALL RDKLIN ( FILE, NUMBER ) */ -/* R = RTRIM ( FILE ) */ - -/* WRITE (*,*) 'An error occurred while reading line ', NUMBER */ -/* WRITE (*,*) 'of the file ''', FILE(1:R), '''' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 03-OCT-2005 (EDW) */ - -/* File rdker.f made a master file so as to */ -/* add the ZZSETNNREAD call. This call will exist */ -/* only in FORTRAN source intended for conversion */ -/* to C by the f2c utility. */ - -/* The ZZSETNNREAD call activates and deactivates */ -/* the non-native text line read capability for the */ -/* CSPICE toolkit. */ - -/* - SPICELIB Version 2.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Determine the last line read from a kernel file. */ - -/* -& */ - -/* Not much to do here. Just copy the information and return. */ - - s_copy(kernel, file, kernel_len, (ftnlen)255); - *number = linnum; - return 0; -} /* rdker_ */ - -/* Subroutine */ int rdker_(char *kernel, char *line, integer *number, - logical *eof, ftnlen kernel_len, ftnlen line_len) -{ - return rdker_0_(0, kernel, line, number, eof, kernel_len, line_len); - } - -/* Subroutine */ int rdknew_(char *kernel, ftnlen kernel_len) -{ - return rdker_0_(1, kernel, (char *)0, (integer *)0, (logical *)0, - kernel_len, (ftnint)0); - } - -/* Subroutine */ int rdkdat_(char *line, logical *eof, ftnlen line_len) -{ - return rdker_0_(2, (char *)0, line, (integer *)0, eof, (ftnint)0, - line_len); - } - -/* Subroutine */ int rdklin_(char *kernel, integer *number, ftnlen kernel_len) -{ - return rdker_0_(3, kernel, (char *)0, number, (logical *)0, kernel_len, ( - ftnint)0); - } - diff --git a/ext/spice/src/cspice/rdkvar.c b/ext/spice/src/cspice/rdkvar.c deleted file mode 100644 index 4e5e2e265d..0000000000 --- a/ext/spice/src/cspice/rdkvar.c +++ /dev/null @@ -1,391 +0,0 @@ -/* rdkvar.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure RDKVAR ( Read the next variable from a kernel file ) */ -/* Subroutine */ int rdkvar_(char *tabsym, integer *tabptr, doublereal * - tabval, char *name__, logical *eof, ftnlen tabsym_len, ftnlen - name_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1[2]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - char line[80]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char error[80]; - extern logical failed_(void); - extern /* Subroutine */ int rdkdat_(char *, logical *, ftnlen), replch_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - char cvalue[30]; - doublereal dvalue; - char varnam[80]; - extern /* Subroutine */ int sydeld_(char *, char *, integer *, doublereal - *, ftnlen, ftnlen), nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - char dirctv[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen), tparse_(char *, - doublereal *, char *, ftnlen, ftnlen), sigerr_(char *, ftnlen), - setmsg_(char *, ftnlen), syenqd_(char *, doublereal *, char *, - integer *, doublereal *, ftnlen, ftnlen), nextwd_(char *, char *, - char *, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - char status[6]; - -/* $ Abstract */ - -/* Read the next variable from a SPICE ASCII kernel file into a */ -/* double precision symbol table. */ - -/* $ 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 */ - -/* KERNEL, SYMBOLS */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Symbol table. */ -/* NAME O Name of the variable. */ -/* EOF O End of file indicator. */ -/* LINLEN P Maximum line length. */ - -/* $ Detailed_Input */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol */ -/* table. On input, the table may or may not contain */ -/* any variables. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL on output, contains the name and values of the next */ -/* variable in kernel file. Depending on the assignment */ -/* directive, the values in the file may replace or */ -/* augment any existing values. */ - -/* NAME is the name of the variable. NAME is blank if */ -/* no variable is read. */ - -/* EOF is true when the end of the kernel file has been */ -/* reached, and is false otherwise. The kernel file */ -/* is closed automatically when the end of the file */ -/* is reached. */ - -/* $ Parameters */ - -/* LINLEN is the maximum length of a line in the kernel file. */ - - -/* $ Files */ - -/* RDKVAR reads from the file most recently opened by RDKNEW. */ - -/* $ Exceptions */ - -/* 1) If an error occurs parsing a date from the kernel file, the */ -/* error SPICE(DATEEXPECTED) is signalled. */ - -/* 2) If an error occurs parsing a numeric value from the kernel */ -/* file, the error SPICE(NUMBEREXPECTED) is signalled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, RDKNEW and RDKVAR are used to read */ -/* the contents of two kernel files into a single symbol table. */ -/* First, the table is cleared. */ - -/* CALL SCARDC ( 0, TABSYM ) */ -/* CALL SCARDI ( 0, TABPTR ) */ -/* CALL SCARDD ( 0, TABVAL ) */ - -/* Next, the files are opened and read individually. */ - -/* DO I = 1, 2 */ -/* CALL RDKNEW ( KERNEL(I), EOF ) */ - -/* DO WHILE ( .NOT. EOF ) */ -/* CALL RDKVAR ( TABSYM, TABPTR, TABVAL, NAME, EOF ) */ -/* END DO */ -/* END DO */ - -/* Let the files KERNEL(1) and KERNEL(2) contain */ - -/* =========================================================== */ - -/* \begindata */ -/* DELTA_T_A = 32.184 */ -/* K = 1.657D-3 */ -/* ORBIT_ECC = 1.671D-2 */ -/* MEAN_ANOM = ( 6.239996D0, 1.99096871D-7 ) */ - -/* =========================================================== */ - -/* and */ - -/* =========================================================== */ -/* \begindata */ -/* K = 0.0D0 */ -/* =========================================================== */ - -/* respectively. Then the contents of the symbol table are */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 0.0D0 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* In particular, the value of K read from the second file replaces */ -/* the value read from the first file. */ - -/* $ Restrictions */ - -/* The input file must be opened and initialized by RDKNEW prior */ -/* to the first call to RDKVAR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 10-MAR-1992 (WLT) */ - -/* Changed the length of the local character variable ERROR so */ -/* that it would always have a length greater than the lengths of */ -/* the character strng values placed into it. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read the next variable from a kernel file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 10-MAR-1992 (WLT) */ - -/* Changed the length of the local character variable ERROR so */ -/* that it would always have a length greater than the lengths of */ -/* the character strng values placed into it. */ - -/* The length of the character variable ERROR was changed from 30 */ -/* to 80. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ -/* - Beta Version 2.0.0, 23-OCT-1989 (HAN) */ - -/* Added a test to FAILED in the main DO-loop to prevent */ -/* infinite looping. If the error mode was set to 'RETURN' */ -/* and an error occurred, the same line could be processed */ -/* forever. */ - -/* - Beta Version 1.1.0, 13-JAN-1989 (IMU) */ - -/* Variable name may now take up an entire line. The previous */ -/* maximum length (32 characters) was tied to the known length */ -/* used by POOL. That length is now parameterized. Rather than */ -/* have two parameters, which could get out of synch, RDKVAR */ -/* now assumes that a variable name can be as long as an input */ -/* line. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDKVAR", (ftnlen)6); - } - -/* No variable yet. */ - - s_copy(name__, " ", name_len, (ftnlen)1); - -/* No parsing error has occurred yet. */ - - s_copy(error, " ", (ftnlen)80, (ftnlen)1); - -/* Get the next data line. Unless something is terribly wrong, */ -/* this will begin a new variable definition. We have to read */ -/* the whole variable, unless we luck out and get an error, in */ -/* which case we can quit. */ - - s_copy(status, "BEGIN", (ftnlen)6, (ftnlen)5); - while(s_cmp(status, "DONE", (ftnlen)6, (ftnlen)4) != 0 && ! failed_()) { - rdkdat_(line, eof, (ftnlen)80); - if (*eof) { - chkout_("RDKVAR", (ftnlen)6); - return 0; - } - -/* Replace commas with blanks. We make no distinctions between */ -/* the two. */ - - replch_(line, ",", " ", line, (ftnlen)80, (ftnlen)1, (ftnlen)1, ( - ftnlen)80); - -/* The first word on the first line should be the name of a */ -/* variable. The second word should be a directive: = or +=. */ - - if (s_cmp(status, "BEGIN", (ftnlen)6, (ftnlen)5) == 0) { - nextwd_(line, varnam, line, (ftnlen)80, (ftnlen)80, (ftnlen)80); - nextwd_(line, dirctv, line, (ftnlen)80, (ftnlen)3, (ftnlen)80); - -/* If this is replacement (=) and not an addition (+=), */ -/* delete the values currently associated with the variable. */ -/* They will be replaced later. */ - - if (s_cmp(dirctv, "=", (ftnlen)3, (ftnlen)1) == 0) { - sydeld_(varnam, tabsym, tabptr, tabval, (ftnlen)80, - tabsym_len); - } - -/* If this is a vector, the next thing on the line will be a */ -/* left parenthesis. Otherwise, assume that this is a scalar. */ -/* If it's a vector, get the first value. If it's a scalar, */ -/* plant a bogus right parenthesis, to make the following loop */ -/* terminate after one iteration. */ - - nextwd_(line, cvalue, line, (ftnlen)80, (ftnlen)30, (ftnlen)80); - if (s_cmp(cvalue, "(", (ftnlen)30, (ftnlen)1) == 0) { - nextwd_(line, cvalue, line, (ftnlen)80, (ftnlen)30, (ftnlen) - 80); - } else { - s_copy(line, ")", (ftnlen)80, (ftnlen)1); - } - -/* For subsequent lines, treat everything as a new value. */ - - } else { - nextwd_(line, cvalue, line, (ftnlen)80, (ftnlen)30, (ftnlen)80); - } - -/* We have a value anyway. Store it in the table. */ - -/* Keep going until the other shoe (the right parenthesis) */ -/* drops, or until the end of the line is reached. */ - -/* Dates begin with @; anything else is presumed to be a number. */ - - while(s_cmp(cvalue, ")", (ftnlen)30, (ftnlen)1) != 0 && s_cmp(cvalue, - " ", (ftnlen)30, (ftnlen)1) != 0) { - if (*(unsigned char *)cvalue == '@') { - tparse_(cvalue + 1, &dvalue, error, (ftnlen)29, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { -/* Writing concatenation */ - i__1[0] = 14, a__1[0] = "Encountered : "; - i__1[1] = 29, a__1[1] = cvalue + 1; - s_cat(error, a__1, i__1, &c__2, (ftnlen)80); - setmsg_(error, (ftnlen)80); - sigerr_("SPICE(DATEEXPECTED)", (ftnlen)19); - chkout_("RDKVAR", (ftnlen)6); - return 0; - } - } else { - nparsd_(cvalue, &dvalue, error, &i__, (ftnlen)30, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { -/* Writing concatenation */ - i__1[0] = 14, a__1[0] = "Encountered : "; - i__1[1] = 30, a__1[1] = cvalue; - s_cat(error, a__1, i__1, &c__2, (ftnlen)80); - setmsg_(error, (ftnlen)80); - sigerr_("SPICE(NUMBEREXPECTED)", (ftnlen)21); - chkout_("RDKVAR", (ftnlen)6); - return 0; - } - } - syenqd_(varnam, &dvalue, tabsym, tabptr, tabval, (ftnlen)80, - tabsym_len); - nextwd_(line, cvalue, line, (ftnlen)80, (ftnlen)30, (ftnlen)80); - } - if (s_cmp(cvalue, ")", (ftnlen)30, (ftnlen)1) == 0) { - s_copy(status, "DONE", (ftnlen)6, (ftnlen)4); - } else { - s_copy(status, "INVAR", (ftnlen)6, (ftnlen)5); - } - } - -/* Return the name of the variable, but only if everything went okay. */ - - s_copy(name__, varnam, name_len, (ftnlen)80); - chkout_("RDKVAR", (ftnlen)6); - return 0; -} /* rdkvar_ */ - diff --git a/ext/spice/src/cspice/rdnbl.c b/ext/spice/src/cspice/rdnbl.c deleted file mode 100644 index adb9175aa8..0000000000 --- a/ext/spice/src/cspice/rdnbl.c +++ /dev/null @@ -1,214 +0,0 @@ -/* rdnbl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RDNBL ( Read non-blank line ) */ -/* Subroutine */ int rdnbl_(char *file, char *line, logical *eof, ftnlen - file_len, ftnlen line_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), rdtext_(char *, char - *, logical *, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Read the next non-blank line of text from a text file. */ - -/* $ 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 */ - -/* FILES, TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FILE I Input text file. */ -/* LINE O Next non-blank line from the input text file. */ -/* EOF O End-of-file indicator. */ - -/* $ Detailed_Input */ - -/* FILE is the name of the text file from which the next */ -/* line is to be read. If the file is not currently */ -/* open, it is opened with a logical unit determined */ -/* at run time, and the first line of the file is */ -/* returned. Otherwise, the next line not yet read */ -/* from the file is read and returned. */ - -/* $ Detailed_Output */ - -/* LINE is next non-blank line of text in the specified file. */ - -/* EOF is true when the end of the file is reached, and is */ -/* otherwise false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either the end of the file is reached or an error occurs */ -/* before a non-blank line is found, LINE is blank. */ - -/* $ Files */ - -/* See input FILES. */ - -/* $ Particulars */ - -/* RDNBL simply calls RDTEXT until one of two things happens: */ - -/* 1. A non-blank line is found (in which case the line */ -/* is returned). */ - -/* 2. The end of the file is reached (in which case the */ -/* file is closed, a blank line is returned, and the */ -/* end-of-file indicator becomes TRUE.) */ - -/* $ Examples */ - -/* Let FILE.1 contain the following lines. */ - -/* Mary had a little lamb */ - -/* Everywhere that Mary went */ - - - -/* Its fleece was white as snow. */ -/* The lamb was sure to go. */ - -/* Then the code fragment */ - -/* DO I = 1, 4 */ -/* CALL RDNBL ( 'FILE.1', LINE, EOF ) */ -/* WRITE (*,*) LINE */ -/* END DO */ - -/* produces the following output: */ - -/* Mary had a little lamb */ -/* Everywhere that Mary went */ -/* Its fleece was white as snow. */ -/* The lamb was sure to go. */ - -/* In fact, the following code fragment removes all of the blank */ -/* lines from an arbitrary text file (FILE). */ - -/* CALL RDNBL ( FILE, LINE, EOF ) */ - -/* DO WHILE ( .NOT. EOF ) */ -/* WRITE (*,*) LINE( : RTRIM(LINE) ) */ - -/* CALL RDNBL ( FILE, LINE, EOF ) */ -/* END DO */ - -/* Note that because RDNBL calls RDTEXT, calls to either routine */ -/* can be interspersed. For example, RDNBL can be used to skip */ -/* blank lines at the beginning of the file, leaving the rest to */ -/* be processed: */ - -/* CALL RDNBL ( FILE, LINE, EOF ) */ - -/* DO WHILE ( .NOT. EOF ) */ -/* < do something with LINE > */ - -/* CALL RDTEXT ( FILE, LINE, EOF ) */ -/* END DO */ - -/* $ Restrictions */ - -/* Any restrictions that apply to RDTEXT apply to RDNBL as well. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 07-AUG-1994 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read a non-blank line from a text file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RDNBL", (ftnlen)5); - } - -/* Return as soon as a non-blank line is found. Otherwise, keep */ -/* looking until either the end of the file is reached or RDTEXT */ -/* manages to fail. */ - - rdtext_(file, line, eof, file_len, line_len); - while(! (*eof) && ! failed_()) { - if (s_cmp(line, " ", line_len, (ftnlen)1) != 0) { - chkout_("RDNBL", (ftnlen)5); - return 0; - } else { - rdtext_(file, line, eof, file_len, line_len); - } - } - -/* Didn't find anything? */ - - s_copy(line, " ", line_len, (ftnlen)1); - chkout_("RDNBL", (ftnlen)5); - return 0; -} /* rdnbl_ */ - diff --git a/ext/spice/src/cspice/rdtext.c b/ext/spice/src/cspice/rdtext.c deleted file mode 100644 index ffe64f118b..0000000000 --- a/ext/spice/src/cspice/rdtext.c +++ /dev/null @@ -1,989 +0,0 @@ -/* rdtext.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure RDTEXT ( Read a line from a text file ) */ -/* Subroutine */ int rdtext_0_(int n__, char *file, char *line, logical *eof, - ftnlen file_len, ftnlen line_len) -{ - /* Initialized data */ - - static integer n = 0; - static char lstfil[255] = " " - " " - " " - " " - " "; - - /* System generated locals */ - integer i__1, i__2, i__3; - cilist ci__1; - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open( - olist *), s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), - f_clos(cllist *); - - /* Local variables */ - logical same; - integer unit, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - static integer index, units[96]; - extern integer isrchi_(integer *, integer *, integer *); - integer number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), getlun_(integer *); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - static integer lstunt; - -/* $ Abstract */ - -/* Read the next line of text from a text file. */ - -/* $ 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 */ - -/* FILES */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* FILE I Name of text file. */ -/* LINE O Next line from the text file. */ -/* EOF O End-of-file indicator. */ -/* MAXOPN P Maximum number of open files. */ -/* MAXLEN P Maximum file name length. */ - -/* $ Detailed_Input */ - -/* FILE is the name of the text file from which the next */ -/* line is to be read. If the file is not currently */ -/* open, it is opened with a logical unit determined */ -/* at run time, and the first line of the file is */ -/* returned. Otherwise, the next line not yet read */ -/* from the file is read and returned. */ - -/* $ Detailed_Output */ - -/* LINE is next line of text in the specified file. */ -/* If the end of the file is reached, LINE is blank. */ - -/* EOF is true when the end of the file is reached, and is */ -/* otherwise false. */ - -/* $ Parameters */ - -/* MAXOPN is the maximum number of files that can be kept */ -/* open simultaneously by RDTEXT. */ - -/* VAX: */ - -/* The default number of files that can be open at one */ -/* time during a user's process is determined by the */ -/* value of FILLM. This number is usually 20, but it */ -/* may be changed by a user with sufficient privileges. */ - -/* IBM PC / Microsoft FORTRAN 5.0: */ - -/* The default value for the maximum number of files */ -/* open at one time is 20. This value may be changed */ -/* by modifying the appropriate startup files as */ -/* specified in the reference documentation. */ - -/* IBM PC / Linux / Fort77: */ - -/* An experiment showed that a program can */ -/* simultaneiously open one file for each available */ -/* logical unit; this amounts to 96 files. */ - -/* Sun / Sun FORTRAN: */ - -/* "The maximum number of logical units that a program */ -/* can have open at one time is the same as the SunOS */ -/* system limit, currently 64." */ - -/* HP-UX 9000/750, FORTRAN/9000 Series 700 computers and */ -/* Silicon Graphics: */ - -/* NAIF used a program to determine this value. Also, */ -/* the values can be found by executing the command */ -/* "man limits" and reading the value for OPEN_MAX. */ -/* This value is listed as 60, but two units are used */ -/* for standard output and standard error. */ - -/* DEC Alpha-OSF/1: */ - -/* The comment in the output from the command */ -/* "man limits" stated that the value of OPEN_MAX was */ -/* 64, but that it was "OBSOLETE, sysconf() interface */ -/* should be used". Looking into sysconf did not produce */ -/* any numbers, so the value is set at 20 because it */ -/* works! */ - -/* NeXT/Absoft Fortran: */ - -/* We couldn't find any documentation that addressed */ -/* this value, so we set it to 20. */ - - -/* MAXLEN is the maximum length of the file names that may */ -/* used to identify the files opened by RDTEXT. */ - -/* $ Exceptions */ - -/* 1) If too many files are open already, the error */ -/* SPICE(TOOMANYFILESOPEN) is signalled. */ - -/* 2) If the attempt to open the file fails, the error */ -/* SPICE(FILEOPENFAILED) is signalled. */ - -/* 3) If the attempt to read from the file fails, the error */ -/* SPICE(FILEREADFAILED) is signalled. */ - -/* 4) If the attempt to "inquire" the status of the file fails, */ -/* the error SPICE(INQUIREFAILED) is signalled. */ - -/* $ Files */ - -/* See input FILE. */ - -/* $ Particulars */ - -/* RDTEXT reads the next line from a text file. If the file is */ -/* not currently open, it is opened with a logical unit determined */ -/* at run time, and the first line of the file is returned. */ -/* Otherwise, the next line not yet read from the file is returned. */ - -/* If the end of the file is reached, a blank line is returned, */ -/* the end-of-file indicator is true, and the file is closed. */ - -/* Several files may be opened and read simultaneously. Thus, */ -/* you may begin reading from one file before the end of another */ -/* file has been reached. RDTEXT maintains a separate file pointer */ -/* for each file. */ - -/* $ Examples */ - -/* Let FILE.1 contain the following lines. */ - -/* Mary had a little lamb */ -/* Everywhere that Mary went */ - -/* Let FILE.2 contain the following lines. */ - -/* Its fleece was white as snow. */ -/* The lamb was sure to go. */ - -/* Then the code fragment */ - -/* DO I = 1, 2 */ -/* CALL RDTEXT ( 'FILE.1', LINE, EOF ) */ -/* WRITE (6,*) LINE */ - -/* CALL RDTEXT ( 'FILE.2', LINE, EOF ) */ -/* WRITE (6,*) LINE */ -/* END DO */ - -/* produces the following output */ - -/* Mary had a little lamb */ -/* Its fleece was white as snow. */ -/* Everywhere that Mary went */ -/* The lamb was sure to go. */ - -/* $ Restrictions */ - -/* 1) The values of MAXOPN and MAXLEN should not exceed any */ -/* corresponding limits imposed by the operating system. */ - -/* 2) If the input file is a print file, the carriage control */ -/* character at the beginning of a given line will be considered */ -/* part of the line. (Text files have no carriage control */ -/* characters.) */ - -/* 3) In order to avoid access violations, the VAX/VMS version of */ -/* RDTEXT uses the VAX READONLY qualifier to open files. This */ -/* must be removed or replaced when the routine is ported to */ -/* non-VAX/VMS systems. */ - -/* 4) On VAX systems, caution should be exercised when using */ -/* multiple logical names to point to the same file. Logical */ -/* name translation supporting execution of the Fortran */ -/* INQUIRE statement does not appear to work reliably in all */ -/* cases, which may lead this routine to believe that different */ -/* logical names indicate different files. The specific problem */ -/* that has been observed is that logical names that include */ -/* disk specifications are not always recognized as pointing */ -/* to the file they actually name. */ - -/* $ Literature_References */ - -/* 1. "VAX/VMS Guide to VAX/VMS System Management and Daily */ -/* Operations", Digital Equipment Corporation, September 1984, */ -/* Section 6.1.7, page 6-6. */ - -/* 2. "Microsoft FORTRAN Reference", Microsoft Corporation */ -/* 1989, Section C.3, page 404. */ - -/* 3. "Sun FORTRAN Programmer's Guide", Sun Microsystems, */ -/* Revision A of 6 May 1988, Section 7.2, page 73. */ - -/* 4. The Unix Man Pages for limits on the HP and Silicon Graphics. */ -/* The value of OPEN_MAX refers to the number of files a process */ -/* can have open. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 6.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 6.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 6.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 6.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 6.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 6.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 6.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 6.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 6.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 6.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 6.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 6.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 6.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 6.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 6.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 6.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 6.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 6.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 6.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 6.0.6, 24-APR-2003 (EDW) */ - -/* Added MAC-OSX-F77 to the list of platforms */ -/* that require READONLY to read write protected */ -/* kernels. */ - -/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 6.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 6.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 5.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the values for MAXLEN and */ -/* MAXOPN and the appropriate OPEN statement for the Silicon */ -/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */ -/* value of 256 for Unix platforms was changed to 255. */ - -/* - SPICELIB Version 4.1.0, 12-OCT-1992 (HAN) */ - -/* Module was updated to include the parameters for the */ -/* Hewlett Packard UX 9000/750 environment. */ - -/* - SPICELIB Version 4.0.0, 20-MAY-1992 (MJS) */ - -/* INDEX saved. */ - -/* - SPICELIB Version 3.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 3.0.0, 19-JUL-1991 (NJB) */ - -/* Version 2.0.0 of RDTEXT produced a Fortran run-time error */ -/* if the input argument FILE was blank. This has been */ -/* repaired. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */ - -/* Value of N was initialized to zero. LINE is now filled */ -/* with blanks when an error occurs or when an end of file */ -/* is reached. Some small fix-ups in the header, including */ -/* re-ordering the sections correctly. */ - -/* - SPICELIB Version 1.0.1, 20-MAR-1990 (HAN) */ - -/* Parameters section was updated to include the values */ -/* of MAXOPN for several machines. Sources of these values */ -/* are listed in the Literature References section. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read a line from a text file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 5.0.0, 9-NOV-1993 (HAN) */ - -/* Module was updated to include the values for MAXLEN and */ -/* MAXOPN and the appropriate OPEN statement for the Silicon */ -/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */ -/* value of 256 for Unix platforms was changed to 255. */ - -/* - SPICELIB Version 4.1.0, 12-OCT-1992 (HAN) */ - -/* Module was updated to include the parameters for the */ -/* Hewlett Packard UX 9000/750 environment. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 4.0.0, 26-MAY-1992 (MJS) */ - -/* The variable INDEX was saved. Prior to this fix, when RDTEXT */ -/* closed a file, INDEX was used without being assigned a value. */ -/* Since INDEX always points to the current file (unit), saving */ -/* INDEX fixed this problem. */ - -/* - SPICELIB Version 3.0.0, 19-JUL-1991 (NJB) */ - -/* Version 2.0.0 of RDTEXT produced a Fortran run-time error */ -/* if the input argument FILE was blank. This has been */ -/* repaired. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */ - -/* In past versions when an end of file was reached or when error */ -/* occured while reading the text file, LINE was returned with */ -/* its previous value. Now LINE is returned with blanks, in */ -/* accordance with the specifications given in the header. */ -/* The variable N, representing the number of files currently */ -/* open, was initialized to zero. */ - -/* The method of checking whether the file to be read is one */ -/* already opened for reading by this routine has been improved. */ -/* Formerly, the input file name was compared against a list of */ -/* names of routines already opened by RDTEXT. If the input name */ -/* pointed to a file that had been opened using a different name, */ -/* RDTEXT would not recognize that the new name pointed to a file */ -/* that was already open. The technique used now greatly reduces */ -/* the chance of such an error. The input file name is compared */ -/* to the previous input file name, and if the names do not agree, */ -/* an INQUIRE is performed to test whether the file named by the */ -/* input file name is already open. Only if this INQUIRE */ -/* indicates that the file is not already open will RDTEXT attempt */ -/* to open the file. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (IMU) (NJB) */ - -/* The primary change was the addition of error handling. */ -/* At the same time, the parameters MAXOPN and MAXLEN were */ -/* moved into the calling sequence. The call to IOERR was */ -/* replaced by a call to SETMSG. The declaration of the unused */ -/* function FAILED was deleted. Finally, all internal references */ -/* to the entry point WRTEXT (which was dropped when the routine */ -/* left OPTLIB) were removed. */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Save the names of the files, their associated logical units, and */ -/* the number of files opened. */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_cltext; - } - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } else { - chkin_("RDTEXT", (ftnlen)6); - } - -/* We will keep track of which files are open by storing the unit */ -/* numbers of those files. When a user requests a file to be read, */ -/* we first check if it is the same file as just previously read, if */ -/* not we use an INQUIRE statement to determine the open status and */ -/* unit number of the file. If the file is open we'll read it, if */ -/* not, well, we'll open it first. We could just skip the first */ -/* part, that is just use the INQUIRE statement, but that would */ -/* involve executing quite a few INQUIRE statements when just */ -/* reading one file and making this routine a much slower routine. */ - - -/* Are we reading the same file? */ - - same = s_cmp(lstfil, file, (ftnlen)255, file_len) == 0 && s_cmp(lstfil, - " ", (ftnlen)255, (ftnlen)1) != 0; - if (! same) { - -/* We still might have the same file. For example these three */ -/* names (on the VAX) are different but they represent the */ -/* same file: */ - -/* 1) MY$DISK:[MYDIR]MYFILE.DAT; */ - -/* 2) MYFILE.DAT;1 */ - -/* 3) MYFILE.DAT */ - -/* In other words, the user may have entered a different file */ -/* specification for the same file. */ - - number = 0; - ioin__1.inerr = 1; - ioin__1.infilen = file_len; - ioin__1.infile = file; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = &number; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - -/* This is weird. How can an INQUIRE statement fail, */ -/* if the syntax is correct? But just in case... */ - - setmsg_("INQUIRE error. File = #, IOSTAT = #.", (ftnlen)37); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("RDTEXT", (ftnlen)6); - return 0; - } - index = isrchi_(&number, &n, units); - if (index == 0) { - -/* Well, we will treat it as a new file then. We will */ -/* need a free logical unit. But only if we don't */ -/* have too many files open already. */ - - if (n == 96) { - setmsg_("Too many files open already.", (ftnlen)28); - sigerr_("SPICE(TOOMANYFILESOPEN)", (ftnlen)23); - chkout_("RDTEXT", (ftnlen)6); - return 0; - } else { - getlun_(&unit); - } - -/* Okay, we have a unit. Open the file, and hope nothing */ -/* goes awry. The READONLY qualifier is nonstandard, but */ -/* helpful where allowed. (Standard disclaimer.) */ - - o__1.oerr = 1; - o__1.ounit = unit; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = 0; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Could not open #.", (ftnlen)17); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("RDTEXT", (ftnlen)6); - return 0; - } - -/* Whew! We're ready to read from this file. Save */ -/* the pertinent information: */ - -/* - The number of files currently open. */ -/* - The logical unit connected to this file. */ -/* - The index of the file within the UNITS array. */ - - ++n; - units[(i__1 = n - 1) < 96 && 0 <= i__1 ? i__1 : s_rnge("units", - i__1, "rdtext_", (ftnlen)639)] = unit; - index = n; - } - s_copy(lstfil, file, (ftnlen)255, file_len); - lstunt = units[(i__1 = index - 1) < 96 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "rdtext_", (ftnlen)645)]; - } - -/* This is the easy part. Read the next line from the file. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = lstunt; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, line_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - -/* Well, what happened? An end-of-file condition is indicated by */ -/* a negative value for IOSTAT. Any other non-zero value indicates */ -/* some other error. In any event, close the file immediately. */ -/* Repack the UNITS array, so that subsequent calls will not try to */ -/* read from the file without reopening it. */ - - *eof = iostat < 0; - if (iostat != 0) { - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = index - 1) < 96 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "rdtext_", (ftnlen)669)]; - cl__1.csta = 0; - f_clos(&cl__1); - i__1 = n; - for (i__ = index + 1; i__ <= i__1; ++i__) { - units[(i__2 = i__ - 2) < 96 && 0 <= i__2 ? i__2 : s_rnge("units", - i__2, "rdtext_", (ftnlen)672)] = units[(i__3 = i__ - 1) < - 96 && 0 <= i__3 ? i__3 : s_rnge("units", i__3, "rdtext_", - (ftnlen)672)]; - } - --n; - -/* Fill LINE with blanks. */ - - s_copy(line, " ", line_len, (ftnlen)1); - -/* LSTFIL is no longer valid */ - - s_copy(lstfil, " ", (ftnlen)255, (ftnlen)1); - -/* If this is just the end of the file, don't report an error. */ -/* (All files have to end sometime.) */ - - if (! (*eof)) { - setmsg_("Could not read from #.", (ftnlen)22); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("RDTEXT", (ftnlen)6); - return 0; - } - } - chkout_("RDTEXT", (ftnlen)6); - return 0; -/* $Procedure CLTEXT ( Close a text file opened by RDTEXT) */ - -L_cltext: -/* $ Abstract */ - -/* Close a text file currently opened by RDTEXT. */ - -/* $ 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 */ - -/* FILES, TEXT */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I Text file to be closed. */ - -/* $ Detailed_Input */ - -/* FILE is the name of a text file which is currently */ -/* opened for reading or writing by RDTEXT. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the attempt to "inquire" the status of the file fails, */ -/* the error SPICE(INQUIREFAILED) is signalled. */ - -/* $ Files */ - -/* The text file, FILE, was previously opened by RDTEXT. */ - -/* $ Particulars */ - -/* CLTEXT closes one of the files currently opened for reading or */ -/* writing by RDTEXT. If the specified file is not open, nothing */ -/* happens. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) On VAX systems, caution should be exercised when using */ -/* multiple logical names to point to the same file. Logical */ -/* name translation supporting execution of the Fortran */ -/* INQUIRE statement does not appear to work reliably in all */ -/* cases, which may lead this routine to believe that different */ -/* logical names indicate different files. The specific problem */ -/* that has been observed is that logical names that include */ -/* disk specifications are not always recognized as pointing */ -/* to the file they actually name. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 6.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 3.0.0, 27-SEP-1994 (WLT) */ - -/* The check of RETURN was removed so that routines that need */ -/* to close a text file can do so even if an error has been */ -/* detected somewhere else in a user's program. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */ - -/* Method of recognizing whether input file name points to */ -/* a file opened by RDTEXT has been improved. Header indentation */ -/* fixed. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* close a text file opened by rdtext */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 27-SEP-1994 (WLT) */ - -/* The check of RETURN was removed so that routines that need */ -/* to close a text file can do so even if an error has been */ -/* detected somewhere else in a user's program. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */ - -/* Method of recognizing whether input file name points to */ -/* a file opened by RDTEXT has been improved. Formerly, CLTEXT */ -/* compared the input file name to a list of names of files */ -/* opened by RDTEXT. If the input name pointed to a file that */ -/* had been opened using a different name, CLTEXT would not */ -/* recognize that the new name pointed to a file that was already */ -/* open. The technique used now greatly reduces the chance of */ -/* such an error. Now, and INQUIRE is performed to obtain the */ -/* unit number attached to the file named by the input file name. */ -/* If this unit is attached to a file opened by RDTEXT, CLTEXT */ -/* will close that file. */ - -/* Header indentation was fixed. */ - - -/* - Beta Version 1.1.0, 8-JAN-1989 (IMU) */ - -/* References to WRTEXT removed. */ - -/* -& */ - -/* Set up the error processing. */ - - chkin_("CLTEXT", (ftnlen)6); - -/* Which file? */ - - number = 0; - ioin__1.inerr = 1; - ioin__1.infilen = file_len; - ioin__1.infile = file; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = &number; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - -/* This is weird. How can an INQUIRE statement fail, */ -/* if the syntax is correct? But just in case... */ - - setmsg_("INQUIRE error. File = #, IOSTAT = #.", (ftnlen)37); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("CLTEXT", (ftnlen)6); - return 0; - } - index = isrchi_(&number, &n, units); - if (index > 0) { - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = index - 1) < 96 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "rdtext_", (ftnlen)932)]; - cl__1.csta = 0; - f_clos(&cl__1); - if (units[(i__1 = index - 1) < 96 && 0 <= i__1 ? i__1 : s_rnge("units" - , i__1, "rdtext_", (ftnlen)934)] == lstunt) { - s_copy(lstfil, " ", (ftnlen)255, (ftnlen)1); - } - -/* Remember all that salient information about the file? */ -/* Lose it. */ - - i__1 = n; - for (i__ = index + 1; i__ <= i__1; ++i__) { - units[(i__2 = i__ - 2) < 96 && 0 <= i__2 ? i__2 : s_rnge("units", - i__2, "rdtext_", (ftnlen)943)] = units[(i__3 = i__ - 1) < - 96 && 0 <= i__3 ? i__3 : s_rnge("units", i__3, "rdtext_", - (ftnlen)943)]; - } - --n; - } - chkout_("CLTEXT", (ftnlen)6); - return 0; -} /* rdtext_ */ - -/* Subroutine */ int rdtext_(char *file, char *line, logical *eof, ftnlen - file_len, ftnlen line_len) -{ - return rdtext_0_(0, file, line, eof, file_len, line_len); - } - -/* Subroutine */ int cltext_(char *file, ftnlen file_len) -{ - return rdtext_0_(1, file, (char *)0, (logical *)0, file_len, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/rdtext_c.c b/ext/spice/src/cspice/rdtext_c.c deleted file mode 100644 index 4d06871d83..0000000000 --- a/ext/spice/src/cspice/rdtext_c.c +++ /dev/null @@ -1,251 +0,0 @@ -/* - --Procedure rdtext_c ( Read a line from a text file ) - --Abstract - - Read the next line of text from a text file. - --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 - - FILES - TEXT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void rdtext_c ( ConstSpiceChar * file, - SpiceInt lenout, - SpiceChar * line, - SpiceBoolean * eof ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- --------------------------------------------------- - file I Name of text file. - lenout I Available room in output line. - line O Next line from the text file. - eof O End-of-file indicator. - --Detailed_Input - - file is the name of the text file from which the next - line is to be read. If the file is not currently - open, it is opened with a logical unit determined - at run time, and the first line of the file is - returned. Otherwise, the next line not yet read - from the file is read and returned. - - lenout is the available room in the output line, including - the terminating null. If the maximum expected length - of an output line is N, lenout should be at least N+1. - --Detailed_Output - - line is next line of text in the specified file. - If the end of the file is reached, LINE is blank. - - eof is true when the end of the file is reached, and is - otherwise false. - --Parameters - - None. - --Exceptions - - 1) If too many files are open already, the error - SPICE(TOOMANYFILESOPEN) is signaled. - - 2) If the attempt to open the file fails, the error - SPICE(FILEOPENFAILED) is signaled. - - 3) If the attempt to read from the file fails, the error - SPICE(FILEREADFAILED) is signaled. - - 4) If the attempt to "inquire" the status of the file fails, - the error SPICE(INQUIREFAILED) is signaled. - --Files - - See input FILE. - --Particulars - - rdtext_c reads the next line from a text file. If the file is - not currently open, it is opened with a logical unit determined - at run time, and the first line of the file is returned. - Otherwise, the next line not yet read from the file is returned. - - If the end of the file is reached, an empty line is returned, - the end-of-file indicator is true, and the file is closed. - - Several files may be opened and read simultaneously. Thus, - you may begin reading from one file before the end of another - file has been reached. rdtext_c maintains a separate file pointer - for each file. - --Examples - - Let FILE.1 contain the following lines. - - Mary had a little lamb - Everywhere that Mary went - - Let FILE.2 contain the following lines. - - Its fleece was white as snow. - The lamb was sure to go. - - Note: You do not what and end-of-file on the same line as - text. That text will be ignored. - - - Then the code fragment - - #include "SpiceUsr.h" - #define LENOUT 32 - - main(void) - { - - SpiceBoolean eof; - SpiceChar line[LENOUT]; - - eof = SPICEFALSE; - - do { - rdtext_c ( "file.1", LENOUT, line, &eof ); - printf ( "%s \n", line ); - - rdtext_c ( "file.2", LENOUT, line, &eof ); - printf ( "%s \n", line ); - } - while ( !eof ); - - } - - produces the following output - - Mary had a little lamb - Its fleece was white as snow. - Everywhere that Mary went - The lamb was sure to go. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 2.0.0, 07-OCT-1999 (NJB) - - Changed argument list to conform to SPICE convention: LENOUT - now precedes the output string. - - Added description of lenout to the header. - - Added local logical variable for EOF flag. - - -CSPICE Version 1.0.0, 25-MAY-1999 (EDW) - --Index_Entries - - read a line from a text file - --& -*/ - -{ /* Begin rdtext_c */ - - /* - Local variables - */ - logical endfil; - - - /* - Participate in error tracing. - */ - chkin_c ( "rdtext_c" ); - - - /* - Check the strings: file, line to insure the pointer is - non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "rdtext_c", file ); - CHKOSTR ( CHK_STANDARD, "rdtext_c", line, lenout ); - - - /* Call the f2c'd routine. */ - rdtext_ ( ( char * ) file, - ( char * ) line, - ( logical * ) &endfil, - ( ftnlen ) strlen(file), - ( ftnlen ) lenout - 1 ); - - /* - Assign the SpiceBoolean EOF flag the logical value obtained - from the f2c'd routine. - */ - - *eof = endfil; - - - /* The string, line, is a Fortranish type string. Convert to C. */ - F2C_ConvertStr ( lenout, line ); - - - /* Checkout. */ - chkout_c ( "rdtext_c" ); - - -} /* End rdtext_c */ diff --git a/ext/spice/src/cspice/readla.c b/ext/spice/src/cspice/readla.c deleted file mode 100644 index 0bc82287cd..0000000000 --- a/ext/spice/src/cspice/readla.c +++ /dev/null @@ -1,334 +0,0 @@ -/* readla.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure READLA ( Read array of lines from a logical unit ) */ -/* Subroutine */ int readla_(integer *unit, integer *maxlin, integer *numlin, - char *array, logical *eof, ftnlen array_len) -{ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical myeof; - extern logical failed_(void); - extern /* Subroutine */ int readln_(integer *, char *, logical *, ftnlen), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* This routine reads lines from a Fortran logical unit placing */ -/* them into a character array buffer. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number to use for input. */ -/* MAXLIN I Maximum number of lines ARRAY can hold. */ -/* NUMLIN O Number of lines read from the file. */ -/* ARRAY O Array containing the lines read from the file. */ -/* EOF O Logical flag indicating the end of file. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for the input. This may */ -/* be either the unit number for the terminal, or the */ -/* unit number of a previously opened text file. */ - -/* MAXLIN The maximum number of text lines that can be placed */ -/* into the ARRAY. */ - -/* $ Detailed_Output */ - -/* NUMLIN The number of text lines read from the file attached to */ -/* UNIT and placed into ARRAY. 0 <= NUMLIN <= MAXLIN. */ - -/* In the event of an error while attempting to read a line */ -/* from the text file attached to UNIT, NUMLIN will contain */ -/* the number of lines successfully read before the error */ -/* occurred. */ - -/* ARRAY The array which is to contain the lines of text read from */ -/* the text file attached to UNIT. */ - -/* If an error or the end of file occurs while reading */ -/* from the text file attached to UNIT, this array will */ -/* contain the NUMLIN successfully read lines ARRAY(1) */ -/* through ARRAY(NUMLIN). */ - -/* EOF On output, this variable will be set to .TRUE. if the */ -/* end of file ( IOSTAT < 0 ) is encountered during an */ -/* attempt to read from UNIT. Otherwise, this variable */ -/* will be set to .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the maximum number of lines, MAXLIN, is not positive, the */ -/* error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while attempting to read from the text */ -/* file attached to unit, a routine called by this routine will */ -/* detect and signal the error. */ - -/* $ Files */ - -/* See the description of UNIT above. */ - -/* $ Particulars */ - -/* This routine reads lines of text from a file, placing each line */ -/* into an element of a character string array. */ - -/* An end of file flag will have the value .TRUE. if the end of file */ -/* is reached while reading. If the file contains more lines than the */ -/* character string array ARRAY can hold, as specified by the */ -/* argument MAXLIN, the routine will return and the end of file flag */ -/* will have the value .FALSE., indicating that there are more lines */ -/* of text that may be read from the file. */ - -/* Upon successful completion, the variable NUMLIN will contain the */ -/* number of lines of text placed into the character string array. */ -/* This value may be zero. */ - -/* $ Examples */ - -/* For the examples which follow, assume that we have a file named */ -/* 'mary.txt' which contains the following lines of text: */ - -/* */ -/* Mary had a little lamb */ -/* Whose fleece was white as snow */ -/* And every where that Mary went */ -/* The lamb was sure to go */ -/* */ - -/* where */ - -/* marks the beginning of the file */ -/* marks the end of the file */ - -/* For each example, assume that we have opened the file 'mary.txt', */ -/* obtaining the Fortran logical unit TXTLUN, and that we are */ -/* positioned to begin reading at the beginning of the file, ''. */ - -/* For brevity, none of the examples perform any error handling */ -/* functions: they simply assume that everything will work. */ - -/* Example 1: ARRAY is large enough to contain the entire contents of */ -/* the file. */ - -/* CHARACTER*(80) ARRAY(10) */ - -/* INTEGER NUMLIN */ - -/* LOGICAL EOF */ - -/* CALL READLA ( TXTLUN, 10, NUMLIN, ARRAY, EOF ) */ - -/* At this point the output variables NUMLIN, ARRAY, and EOF have */ -/* the following values: */ - -/* NUMLIN = 4 */ - -/* ARRAY(1) = 'Mary had a little lamb' */ -/* ARRAY(2) = 'Whose fleece was white as snow' */ -/* ARRAY(3) = 'And every where that Mary went' */ -/* ARRAY(4) = 'The lamb was sure to go' */ - -/* EOF = .TRUE. */ - -/* Example 2: ARRAY is not large enough to contain the entire */ -/* contents of the file -- perform multiple reads. */ - -/* CHARACTER*(80) ARRAY(3) */ - -/* INTEGER NUMLIN */ - -/* LOGICAL EOF */ - -/* EOF = .FALSE. */ -/* DO WHILE ( .NOT. EOF ) */ - -/* CALL READLA ( TXTLUN, 3, NUMLIN, ARRAY, EOF ) */ - -/* END DO */ - -/* Because the line buffer ARRAY may contain at most 3 lines and the */ -/* file contains 4 lines, the loop calling READLA will be executed */ -/* twice, terminating after the second call because EOF will be */ -/* true. */ - -/* After the first call to READLA the output variables NUMLIN, ARRAY, */ -/* and EOF have the following values: */ - -/* NUMLIN = 3 */ - -/* ARRAY(1) = 'Mary had a little lamb' */ -/* ARRAY(2) = 'Whose fleece was white as snow' */ -/* ARRAY(3) = 'And every where that Mary went' */ - -/* EOF = .FALSE. */ - -/* After the second call to READLA the output variables NUMLIN, */ -/* ARRAY, and EOF have the following values: */ - -/* NUMLIN = 1 */ - -/* ARRAY(1) = 'The lamb was sure to go' */ - -/* EOF = .TRUE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.0.0, 20-DEC-1995 (KRG) */ - -/* The routine graduated */ - -/* - Beta Version 3.0.0, 9-JAN-1995 (KRG) */ - -/* Added examples to the header. */ - -/* Fixed some problems with the variable descriptions in the */ -/* $ Detailed_Input and $ Detailed_Output sections of the header. */ - -/* Rearranged some of the code to be more aesthetically pleasing. */ - -/* - Beta Version 2.0.0, 05-JAN-1995 (KRG) */ - -/* This routine now participates fully with the SPICELIB error */ -/* handler, checking in on entry and checking out on exit. The */ -/* overhead associated with the error handler should not be */ -/* significant relative to the operation of this routine. */ - -/* Moved the test for the end of file outside of the loop. There */ -/* is no need to test for it every time in the loop, because we */ -/* only do it to decrement the number of lines read by one to */ -/* account for the pre-increment befor the READ that set the end */ -/* of file. */ - -/* Added a local variable MYEOF so that a value of the variable */ -/* EOF does not affect the termination of the read loop. */ - -/* - Beta Version 1.0.0, 18-DEC-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read an array of text lines from a logical unit */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("READLA", (ftnlen)6); - } - -/* Check to see if the maximum number of lines is positive. */ - - if (*maxlin <= 0) { - setmsg_("The maximum number of lines for the output line array was n" - "ot positive. It was: #.", (ftnlen)82); - errint_("#", maxlin, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("READLA", (ftnlen)6); - return 0; - } - -/* Begin reading in the lines from the text file attached to UNIT. */ -/* Stop when the array of lines is full, I = MAXLIN, or we hit the */ -/* end of file. */ - - myeof = FALSE_; - *numlin = 0; - i__ = 1; - while(i__ <= *maxlin && ! myeof) { - readln_(unit, array + (i__ - 1) * array_len, &myeof, array_len); - if (failed_()) { - -/* If the read failed, an appropriate error message has already */ -/* been set, so we need to set the number of lines that have */ -/* been correctly read from the file and return. */ - - chkout_("READLA", (ftnlen)6); - return 0; - } - *numlin = i__; - ++i__; - } - -/* If we got to here, then we have either filled up the line buffer */ -/* or we reached the end of the file. If we reached the end of the */ -/* file we need to adjust the value of NUMLIN to remove the last read */ -/* attempt. */ - - if (myeof) { - --(*numlin); - } - *eof = myeof; - chkout_("READLA", (ftnlen)6); - return 0; -} /* readla_ */ - diff --git a/ext/spice/src/cspice/readln.c b/ext/spice/src/cspice/readln.c deleted file mode 100644 index dbf8ae3a0b..0000000000 --- a/ext/spice/src/cspice/readln.c +++ /dev/null @@ -1,217 +0,0 @@ -/* readln.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure READLN ( Read a text line from a logical unit ) */ -/* Subroutine */ int readln_(integer *unit, char *line, logical *eof, ftnlen - line_len) -{ - /* System generated locals */ - cilist ci__1; - - /* Builtin functions */ - integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* This routine will read a single line of text from the Fortran */ -/* logical unit UNIT, reporting the end of file if it occurs. */ - -/* $ 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 */ - -/* ASCII */ -/* TEXT */ -/* FILES */ - -/* $ Declarations */ - - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I The Fortran unit number to use for input. */ -/* LINE O The line read from the file. */ -/* EOF O A logical flag indicating the end of file. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for the input. This may */ -/* be either the unit number for the terminal, or the */ -/* unit number of a previously opened text file. */ - -/* $ Detailed_Output */ - -/* LINE On output, this will contain the next text line */ -/* encountered when reading from UNIT. */ - -/* If the length of the character string LINE is shorter */ -/* than the length of the current line in the text file, the */ -/* line is truncated on the right by the Fortran READ */ -/* statement, filling LINE with the first LEN(LINE) */ -/* characters from the current line in the file. */ - -/* If an error or the end of file occurs during the */ -/* attempt to read from UNIT, the value of this variable */ -/* is not guaranteed. */ - -/* EOF On output, this variable will be set to .TRUE. if the */ -/* end of file ( IOSTAT < 0 ) is encountered during the */ -/* attempt to read from unit UNIT. Otherwise, this */ -/* variable will be set to .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while attempting to read from the text */ -/* file attached to UNIT, the error SPICE(FILEREADFAILED) will */ -/* be signalled. */ - -/* This routine only checks in with the error handler in the event */ -/* that an error occurred. (Discovery check in) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will read a single line, a text record, from the */ -/* logical unit UNIT. UNIT may be the terminal, or it may be a */ -/* logical unit number obtained from a Fortran OPEN or INQUIRE */ -/* statement. This routine will set a logical flag, EOF, on output */ -/* if the end of the file is encountered during the read attempt. */ - -/* $ Examples */ - -/* CALL READLN ( UNIT, LINE, EOF ) */ - -/* IF ( EOF ) THEN */ -/* < The end of file, deal with it appropriately > */ -/* END IF */ - -/* You now have a line of text from unit UNIT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.0.0, 20-DEC-1995 (KRG) */ - -/* The routine graduated */ - -/* - Beta Version 1.0.1, 22-NOV-1994 (KRG) */ - -/* Cleaned up the comments a little bit. No code changes. */ - -/* - Beta Version 1.0.0, 17-DEC-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read a text line from a logical unit */ - -/* -& */ - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - -/* Read in the next line from the text file attached to UNIT. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, line_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - -/* Check to see if we got a read error, and signal it if we did. */ - - if (iostat > 0) { - chkin_("READLN", (ftnlen)6); - setmsg_("Error reading from file: #. IOSTAT = #.", (ftnlen)39); - errfnm_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("READLN", (ftnlen)6); - return 0; - } - -/* Check to see if we got the end of file, and set the logical */ -/* flag EOF if we did. */ - - if (iostat < 0) { - *eof = TRUE_; - } else { - *eof = FALSE_; - } - return 0; -} /* readln_ */ - diff --git a/ext/spice/src/cspice/reccyl.c b/ext/spice/src/cspice/reccyl.c deleted file mode 100644 index 33c80b55ff..0000000000 --- a/ext/spice/src/cspice/reccyl.c +++ /dev/null @@ -1,199 +0,0 @@ -/* reccyl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RECCYL ( Rectangular to cylindrical coordinates ) */ -/* Subroutine */ int reccyl_(doublereal *rectan, doublereal *r__, doublereal * - long__, doublereal *z__) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal), atan2(doublereal, doublereal); - - /* Local variables */ - doublereal x, y; - extern doublereal twopi_(void); - doublereal big; - -/* $ Abstract */ - -/* Convert from rectangular to cylindrical coordinates. */ - - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* RECTAN I Rectangular coordinates of a point. */ -/* R O Distance of the point from Z axis. */ -/* LONG O Angle (radians) of the point from XZ plane */ -/* Z O Height of the point above XY plane. */ - -/* $ Detailed_Input */ - -/* RECTAN Rectangular coordinates of the point of interest. */ - -/* $ Detailed_Output */ - -/* R Distance of the point of interest from Z axis. */ - -/* LONG Cylindrical angle (in radians) of the point of */ -/* interest from XZ plane. */ - -/* Z Height of the point above XY plane. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine transforms the coordinates of a point from */ -/* rectangular to cylindrical coordinates. */ - -/* $ Examples */ - -/* Below are two tables. */ - -/* Listed in the first table (under X(1), X(2) and X(3) ) are a */ -/* number of points whose rectangular coordinates coorindates are */ -/* taken from the set {-1, 0, 1}. */ - -/* The result of the code fragment */ - -/* CALL RECCYL ( X, R, LONG, Z ) */ - -/* Use the SPICELIB routine CONVRT to convert the angular */ -/* quantities to degrees */ - -/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */ - -/* are listed to 4 decimal places in the second parallel table under */ -/* R (radius), LONG (longitude), and Z (same as rectangular Z */ -/* coordinate). */ - - -/* X(1) X(2) X(3) R LONG Z */ -/* -------------------------- ------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 */ -/* 0.0000 1.0000 0.0000 1.0000 90.0000 0.0000 */ -/* 0.0000 0.0000 1.0000 0.0000 0.0000 1.0000 */ -/* -1.0000 0.0000 0.0000 1.0000 180.0000 0.0000 */ -/* 0.0000 -1.0000 0.0000 1.0000 270.0000 0.0000 */ -/* 0.0000 0.0000 -1.0000 0.0000 0.0000 -1.0000 */ -/* 1.0000 1.0000 0.0000 1.4142 45.0000 0.0000 */ -/* 1.0000 0.0000 1.0000 1.0000 0.0000 1.0000 */ -/* 0.0000 1.0000 1.0000 1.0000 90.0000 1.0000 */ -/* 1.0000 1.0000 1.0000 1.4142 45.0000 1.0000 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. Obsolete Revisions section */ -/* deleted. */ - -/* - 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 */ - -/* rectangular to cylindrical coordinates */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Use temporary variables for computing R. */ - -/* Computing MAX */ - d__1 = abs(rectan[0]), d__2 = abs(rectan[1]); - big = max(d__1,d__2); - -/* Convert to cylindrical coordinates */ - - *z__ = rectan[2]; - if (big == 0.) { - *r__ = 0.; - *long__ = 0.; - } else { - x = rectan[0] / big; - y = rectan[1] / big; - *r__ = big * sqrt(x * x + y * y); - *long__ = atan2(y, x); - } - if (*long__ < 0.) { - *long__ += twopi_(); - } - return 0; -} /* reccyl_ */ - diff --git a/ext/spice/src/cspice/reccyl_c.c b/ext/spice/src/cspice/reccyl_c.c deleted file mode 100644 index 8a2a0fa94e..0000000000 --- a/ext/spice/src/cspice/reccyl_c.c +++ /dev/null @@ -1,204 +0,0 @@ -/* - --Procedure reccyl_c ( Rectangular to cylindrical coordinates ) - --Abstract - - Convert from rectangular to cylindrical coordinates. - - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef reccyl_c - - - void reccyl_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------- - rectan I Rectangular coordinates of a point. - r O Distance of the point from z axis. - lon O Angle (radians) of the point from xZ plane - z O Height of the point above xY plane. - --Detailed_Input - - rectan Rectangular coordinates of the point of interest. - --Detailed_Output - - r Distance of the point of interest from z axis. - - lon Cylindrical angle (in radians) of the point of - interest from xZ plane. - - z Height of the point above xY plane. - --Parameters - - None. - --Particulars - - This routine transforms the coordinates of a point from - rectangular to cylindrical coordinates. - --Examples - - Below are two tables. - - Listed in the first table (under x(1), x(2) and x(3) ) are a - number of points whose rectangular coordinates coorindates are - taken from the set {-1, 0, 1}. - - The result of the code fragment - - reccyl_c ( x, r, lon, z ); - - Use the CSPICE routine convrt_c to convert the angular - quantities to degrees - - convrt_c ( lon, "RADIANS", "DEGREES", lon ); - - are listed to 4 decimal places in the second parallel table under - r (radius), lon (longitude), and z (same as rectangular z - coordinate). - - - x(1) x(2) x(3) r lon z - -------------------------- ------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 - 0.0000 1.0000 0.0000 1.0000 90.0000 0.0000 - 0.0000 0.0000 1.0000 0.0000 0.0000 1.0000 - -1.0000 0.0000 0.0000 1.0000 180.0000 0.0000 - 0.0000 -1.0000 0.0000 1.0000 270.0000 0.0000 - 0.0000 0.0000 -1.0000 0.0000 0.0000 -1.0000 - 1.0000 1.0000 0.0000 1.4142 45.0000 0.0000 - 1.0000 0.0000 1.0000 1.0000 0.0000 1.0000 - 0.0000 1.0000 1.0000 1.0000 90.0000 1.0000 - 1.0000 1.0000 1.0000 1.4142 45.0000 1.0000 - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Removed tab characters from source file. Include interface - macro definition header SpiceZim.h. - - -CSPICE Version 1.1.0, 21-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - rectangular to cylindrical coordinates - --& -*/ - -{ /* Begin reccyl_c */ - - /* - Local variables - */ - - SpiceDouble x; - SpiceDouble y; - SpiceDouble big; - - - /* Computing max absolute value of x and y components */ - big = MaxAbs( rectan[0], rectan[1] ); - - - /* Convert to cylindrical coordinates */ - - *z = rectan[2]; - - if ( big == 0.) - { - *r = 0.; - *lon = 0.; - } - else - { - x = rectan[0] / big; - y = rectan[1] / big; - *r = big * sqrt(x * x + y * y); - *lon = atan2(y, x); - } - - if ( *lon < 0.) - { - *lon += twopi_c(); - } - - -} /* End reccyl_c */ diff --git a/ext/spice/src/cspice/recgeo.c b/ext/spice/src/cspice/recgeo.c deleted file mode 100644 index 3c2e5224f6..0000000000 --- a/ext/spice/src/cspice/recgeo.c +++ /dev/null @@ -1,320 +0,0 @@ -/* recgeo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RECGEO ( Rectangular to geodetic ) */ -/* Subroutine */ int recgeo_(doublereal *rectan, doublereal *re, doublereal * - f, doublereal *long__, doublereal *lat, doublereal *alt) -{ - doublereal base[3], a, b, c__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen), reclat_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal radius, normal[3]; - extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - surfnm_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert from rectangular coordinates to geodetic coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RECTAN I Rectangular coordinates of a point. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* LONG O Geodetic longitude of the point (radians). */ -/* LAT O Geodetic latitude of the point (radians). */ -/* ALT O Altitude of the point above reference spheroid. */ - -/* $ Detailed_Input */ - -/* RECTAN The rectangular coordinates of a point. */ - -/* RE Equatorial radius of a reference spheroid. This */ -/* spheroid is a volume of revolution: its horizontal */ -/* cross sections are circular. The shape of the */ -/* spheroid is defined by an equatorial radius RE and */ -/* a polar radius RP. */ - -/* F Flattening coefficient = (RE-RP) / RE, where RP is */ -/* the polar radius of the spheroid. */ - -/* $ Detailed_Output */ - -/* LONG Geodetic longitude of the input point. This is the */ -/* angle between the prime meridian and the meridian */ -/* containing RECTAN. The direction of increasing */ -/* longitude is from the +X axis towards the +Y axis. */ - -/* LONG is output in radians. The range of LONG is */ -/* [-pi, pi]. */ - -/* LAT Geodetic latitude of the input point. For a point P */ -/* on the reference spheroid, this is the angle between */ -/* the XY plane and the outward normal vector at P. */ -/* For a point P not on the reference spheroid, the */ -/* geodetic latitude is that of the closest point to P on */ -/* the spheroid. */ - -/* LAT is output in radians. The range of LAT is */ -/* [-pi/2, pi/2]. */ - - -/* ALT Altitude of point above the reference spheroid. */ - -/* The units associated with ALT are those associated */ -/* with the input RECTAN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the equatorial radius is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 2) If the flattening coefficient is greater than or equal to */ -/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 3) For points inside the reference ellipsoid, the nearest */ -/* point on the ellipsoid to RECTAN may not be unique, so */ -/* latitude may not be well-defined. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given the body-fixed rectangular coordinates of a point, and the */ -/* constants describing the reference spheroid, this routine */ -/* returns the geodetic coordinates of the point. The body-fixed */ -/* rectangular frame is that having the x-axis pass through the */ -/* 0 degree latitude 0 degree longitude point. The y-axis passes */ -/* through the 0 degree latitude 90 degree longitude. The z-axis */ -/* passes through the 90 degree latitude point. For some bodies */ -/* this coordinate system may not be a right-handed coordinate */ -/* system. */ - -/* $ Examples */ - -/* This routine can be used to convert body fixed rectangular */ -/* coordinates (such as the Satellite Tracking and Data Network */ -/* of 1973) to geodetic coordinates such as those used by the */ -/* United States Geological Survey topographic maps. */ - -/* The code would look something like this */ - -/* C */ -/* C Shift the STDN-73 coordinates to line up with the center */ -/* C of the Clark66 reference system. */ -/* C */ -/* CALL VSUB ( STDNX, OFFSET, X ) */ - -/* C */ -/* C Using the equatorial radius of the Clark66 spheroid */ -/* C (CLARKR = 6378.2064 km) and the Clark 66 flattening */ -/* C factor (CLARKF = 1.0D0 / 294.9787D0 ) convert to */ -/* C geodetic coordinates of the North American Datum of 1927. */ -/* C */ -/* CALL RECGEO ( X, CLARKR, CLARKF, LONG, LAT, ALT ) */ - - - -/* Below are two tables. */ - -/* Listed in the first table (under X(1), X(2) and X(3)) are a */ -/* number of points whose rectangular coordinates are */ -/* taken from the set {-1, 0, 1}. */ - -/* The results of the code fragment */ - -/* CALL RECGEO ( X, CLARKR, CLARKF, LONG, LAT, ALT ) */ - -/* Use the SPICELIB routine CONVRT to convert the angular */ -/* quantities to degrees */ - -/* CALL CONVRT ( LAT, 'RADIANS', 'DEGREES', LAT ) */ -/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */ - -/* are listed to 4 decimal places in the second parallel table under */ -/* LONG (longitude), LAT (latitude), and ALT (altitude). */ - - -/* X(1) X(2) X(3) LONG LAT ALT */ -/* -------------------------- ---------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 90.0000 -6356.5838 */ -/* 1.0000 0.0000 0.0000 0.0000 0.0000 -6377.2063 */ -/* 0.0000 1.0000 0.0000 90.0000 0.0000 -6377.2063 */ -/* 0.0000 0.0000 1.0000 0.0000 90.0000 -6355.5838 */ -/* -1.0000 0.0000 0.0000 180.0000 0.0000 -6377.2063 */ -/* 0.0000 -1.0000 0.0000 -90.0000 0.0000 -6377.2063 */ -/* 0.0000 0.0000 -1.0000 0.0000 -90.0000 -6355.5838 */ -/* 1.0000 1.0000 0.0000 45.0000 0.0000 -6376.7921 */ -/* 1.0000 0.0000 1.0000 0.0000 88.7070 -6355.5725 */ -/* 0.0000 1.0000 1.0000 90.0000 88.7070 -6355.5725 */ -/* 1.0000 1.0000 1.0000 45.0000 88.1713 -6355.5612 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See FUNDAMENTALS OF ASTRODYNAMICS, Bate, Mueller, White */ -/* published by Dover for a description of geodetic coordinates. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 02-JUL-2007 (NJB) */ - -/* In Examples section of header, description of right-hand */ -/* table was updated to use correct names of columns. Term */ -/* "bodyfixed" is now hyphenated. */ - -/* - SPICELIB Version 1.0.2, 30-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - 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 */ - -/* rectangular to geodetic */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 3.0.1, 9-JUN-1989 (HAN) */ - -/* Error handling was added to detect and equatorial radius */ -/* whose value is less than or equal to zero. */ - -/* - Beta Version 2.0.0, 21-DEC-1988 (HAN) */ - -/* Error handling to detect invalid flattening coefficients */ -/* was added. Because the flattening coefficient is used to */ -/* compute the length of an axis, it must be checked so that */ -/* the length is greater than zero. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RECGEO", (ftnlen)6); - } - -/* The equatorial radius must be positive. If not, signal an error */ -/* and check out. */ - - if (*re <= 0.) { - setmsg_("Equatorial radius was *.", (ftnlen)24); - errdp_("*", re, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("RECGEO", (ftnlen)6); - return 0; - } - -/* If the flattening coefficient is greater than one, the length */ -/* of the 'C' axis computed below is negative. If it's equal to one, */ -/* the length of the axis is zero. Either case is a problem, so */ -/* signal an error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was *.", (ftnlen)29); - errdp_("*", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("RECGEO", (ftnlen)6); - return 0; - } - -/* Determine the lengths of the axes of the reference ellipsoid. */ - - a = *re; - b = *re; - c__ = *re - *f * *re; - -/* Find the point on the reference spheroid closes to the input point */ - - nearpt_(rectan, &a, &b, &c__, base, alt); - -/* From this closest point determine the surface normal */ - - surfnm_(&a, &b, &c__, base, normal); - -/* Using the surface normal, determine the latitude and longitude */ -/* of the input point. */ - - reclat_(normal, &radius, long__, lat); - chkout_("RECGEO", (ftnlen)6); - return 0; -} /* recgeo_ */ - diff --git a/ext/spice/src/cspice/recgeo_c.c b/ext/spice/src/cspice/recgeo_c.c deleted file mode 100644 index 8054e53580..0000000000 --- a/ext/spice/src/cspice/recgeo_c.c +++ /dev/null @@ -1,272 +0,0 @@ -/* - --Procedure recgeo_c ( Rectangular to geodetic ) - --Abstract - - Convert from rectangular coordinates to geodetic coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef recgeo_c - - - void recgeo_c ( ConstSpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - rectan I Rectangular coordinates of a point. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - lon O Geodetic longitude of the point (radians). - lat O Geodetic latitude of the point (radians). - alt O Altitude of the point above reference spheroid. - --Detailed_Input - - rectan Rectangular coordinates of the input point. - - re Equatorial radius of a reference spheroid. This spheroid - is a volume of revolution: its horizontal cross sections - are circular. The shape of the spheroid is defined by - an equatorial radius `re' and a polar radius `rp'. - - f Flattening coefficient = (re-rp) / re, where rp is - the polar radius of the spheroid. - --Detailed_Output - - lon Geodetic longitude of the input point. This is the - angle between the prime meridian and the meridian - containing `rectan'. The direction of increasing - longitude is from the +X axis towards the +Y axis. - - `lon' is output in radians. The range of `lon' is - [-pi, pi]. - - - lat Geodetic latitude of the input point. For a point P - on the reference spheroid, this is the angle between the - XY plane and the outward normal vector at P. For a point P - not on the reference spheroid, the geodetic latitude is - that of the closest point to P on the spheroid. - - `lat' is output in radians. The range of `lat' is - [-pi/2, pi/2]. - - - alt Altitude of point above the reference spheroid. - - The units associated with `alt' are those associated with - the input `rectan'. - --Parameters - - None. - --Exceptions - - 1) If the equatorial radius is non-positive, the error - SPICE(VALUEOUTOFRANGE) is signaled. - - 2) If the flattening coefficient is greater than or equal to - one, the error SPICE(VALUEOUTOFRANGE) is signaled. - - 3) For points inside the reference ellipsoid, the nearest point on - the ellipsoid to `rectan' may not be unique, so latitude may not - be well-defined. - --Files - - None. - --Particulars - - Given the body-fixed rectangular coordinates of a point, and the - constants describing the reference spheroid, this routine - returns the geodetic coordinates of the point. The body-fixed - rectangular frame is that having the x-axis pass through the - 0 degree latitude 0 degree longitude point. The y-axis passes - through the 0 degree latitude 90 degree longitude. The z-axis - passes through the 90 degree latitude point. For some bodies - this coordinate system may not be a right-handed coordinate - system. - --Examples - - This routine can be used to convert body fixed rectangular - coordinates (such as the Satellite Tracking and Data Network - of 1973) to geodetic coordinates such as those used by the - United States Geological Survey topographic maps. - - The code would look something like this - - /. - Shift the STDN-73 coordinates to line up with the center - of the Clark66 reference system. - ./ - - vsub_c ( stdnx, offset, x ); - - /. - Using the equatorial radius of the Clark66 spheroid - (CLARKR = 6378.2064 km) and the Clark 66 flattening - factor (CLARKF = 1.0 / 294.9787 ) convert to - geodetic coordinates of the North American Datum of 1927. - ./ - - recgeo_c ( x, CLARKR, CLARKF, &lon, &lat, &alt ) - - - Below are two tables. - - Listed in the first table (under X[0], X[1] and X[2]) are a - number of points whose rectangular coordinates are - taken from the set {-1, 0, 1}. - - - The results of the code fragment - - recgeo_c ( x, CLARKR, CLARKF, &lon, &lat, &alt ); - - /. - Use the CSPICE routine convrt_c to convert the angular - quantities to degrees - ./ - convrt_c ( lat, "RADIANS", "DEGREES", &lat ); - convrt_c ( lon, "RADIANS", "DEGREES", &lon ); - - - are listed to four decimal places in the second parallel table under - lon (longitude), lat (latitude), and alt (altitude). - - X[0] X[1] X[2] lon lat alt - -------------------------- ---------------------------- - 0.0000 0.0000 0.0000 0.0000 90.0000 -6356.5838 - 1.0000 0.0000 0.0000 0.0000 0.0000 -6377.2063 - 0.0000 1.0000 0.0000 90.0000 0.0000 -6377.2063 - 0.0000 0.0000 1.0000 0.0000 90.0000 -6355.5838 - -1.0000 0.0000 0.0000 180.0000 0.0000 -6377.2063 - 0.0000 -1.0000 0.0000 -90.0000 0.0000 -6377.2063 - 0.0000 0.0000 -1.0000 0.0000 -90.0000 -6355.5838 - 1.0000 1.0000 0.0000 45.0000 0.0000 -6376.7921 - 1.0000 0.0000 1.0000 0.0000 88.7070 -6355.5725 - 0.0000 1.0000 1.0000 90.0000 88.7070 -6355.5725 - 1.0000 1.0000 1.0000 45.0000 88.1713 -6355.5612 - --Restrictions - - None. - --Literature_References - - See FUNDAMENTALS OF ASTRODYNAMICS, Bate, Mueller, White - published by Dover for a description of geodetic coordinates. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.2.2, 02-JUL-2007 (NJB) - - In Examples section of header, heading and description of - right-hand table was updated to use correct names of columns. - Term "bodyfixed" is now hyphenated. - - -CSPICE Version 1.2.1, 30-JUL-2003 (NJB) (CHA) - - Various header changes were made to improve clarity. Some - minor header corrections were made. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Removed tab characters from source file. Include interface - macro definition file SpiceZim.h. - - -CSPICE Version 1.1.0, 21-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - rectangular to geodetic - --& -*/ - -{ /* Begin recgeo_c */ - - /* - Participate in error handling - */ - - chkin_c ( "recgeo_c"); - - - /* - Call the f2c'd routine. - */ - - recgeo_( ( doublereal * ) rectan, - ( doublereal * ) &re, - ( doublereal * ) &f, - ( doublereal * ) lon, - ( doublereal * ) lat, - ( doublereal * ) alt); - - - chkout_c ( "recgeo_c"); - - -} /* End recgeo_c */ diff --git a/ext/spice/src/cspice/reclat.c b/ext/spice/src/cspice/reclat.c deleted file mode 100644 index d4aef0d718..0000000000 --- a/ext/spice/src/cspice/reclat.c +++ /dev/null @@ -1,228 +0,0 @@ -/* reclat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RECLAT ( Rectangular to latitudinal coordinates ) */ -/* Subroutine */ int reclat_(doublereal *rectan, doublereal *radius, - doublereal *long__, doublereal *lat) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal), atan2(doublereal, doublereal); - - /* Local variables */ - doublereal x, y, z__, big; - -/* $ Abstract */ - -/* Convert from rectangular coordinates to latitudinal coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RECTAN I Rectangular coordinates of the point. */ -/* RADIUS O Distance of a point from the origin. */ -/* LONG O Longitude of point in radians. */ -/* LAT O Latitude of point in radians. */ - -/* $ Detailed_Input */ - -/* RECTAN The rectangular coordinates of a point. */ - -/* $ Detailed_Output */ - -/* RADIUS Distance of a point from the origin. */ - -/* The units associated with RADIUS are those */ -/* associated with the input RECTAN. */ - -/* LONG Longitude of the input point. This is the angle */ -/* between the prime meridian and the meridian */ -/* containing the point. The direction of increasing */ -/* longitude is from the +X axis towards the +Y axis. */ - -/* LONG is output in radians. The range of LONG is */ -/* [ -pi, pi]. */ - - -/* LAT Latitude of the input point. This is the angle from */ -/* the XY plane of the ray from the origin through the */ -/* point. */ - -/* LAT is output in radians. The range of LAT is */ -/* [-pi/2, pi/2]. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the latitudinal coordinates of a point */ -/* whose position is input in rectangular coordinates. */ - -/* Latitudinal coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* above the equator of a sphere centered at the central reference */ -/* point. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the X and Y components of RECTAN are both zero, the */ -/* longitude is set to zero. */ - -/* 2) If RECTAN is the zero vector, longitude and latitude are */ -/* both set to zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Examples */ - -/* Below are two tables. */ - -/* Listed in the first table (under X(1), X(2) and X(3) ) are a */ -/* number of points whose rectangular coordinates are */ -/* taken from the set {-1, 0, 1}. */ - -/* The results of the code fragment */ - -/* CALL RECLAT ( X, R, LONG, LAT ) */ -/* C */ -/* C Use the SPICELIB routine CONVRT to convert the angular */ -/* C quantities to degrees */ -/* C */ -/* CALL CONVRT ( LAT, 'RADIANS', 'DEGREES', LAT ) */ -/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */ - -/* are listed to 4 decimal places in the second parallel table under */ -/* R (radius), LONG (longitude), and LAT (latitude). */ - - -/* X(1) X(2) X(3) R LONG LAT */ -/* -------------------------- -------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 */ -/* 0.0000 1.0000 0.0000 1.0000 90.0000 0.0000 */ -/* 0.0000 0.0000 1.0000 1.0000 0.0000 90.0000 */ -/* -1.0000 0.0000 0.0000 1.0000 180.0000 0.0000 */ -/* 0.0000 -1.0000 0.0000 1.0000 -90.0000 0.0000 */ -/* 0.0000 0.0000 -1.0000 1.0000 0.0000 -90.0000 */ -/* 1.0000 1.0000 0.0000 1.4142 45.0000 0.0000 */ -/* 1.0000 0.0000 1.0000 1.4142 0.0000 45.0000 */ -/* 0.0000 1.0000 1.0000 1.4142 90.0000 45.0000 */ -/* 1.0000 1.0000 1.0000 1.7320 45.0000 35.2643 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 30-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - 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 */ - -/* rectangular to latitudinal coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Store rectangular coordinates in temporary variables */ - -/* Computing MAX */ - d__1 = abs(rectan[0]), d__2 = abs(rectan[1]), d__1 = max(d__1,d__2), d__2 - = abs(rectan[2]); - big = max(d__1,d__2); - if (big > 0.) { - x = rectan[0] / big; - y = rectan[1] / big; - z__ = rectan[2] / big; - *radius = big * sqrt(x * x + y * y + z__ * z__); - *lat = atan2(z__, sqrt(x * x + y * y)); - x = rectan[0]; - y = rectan[1]; - if (x == 0. && y == 0.) { - *long__ = 0.; - } else { - *long__ = atan2(y, x); - } - } else { - *radius = 0.; - *lat = 0.; - *long__ = 0.; - } - return 0; -} /* reclat_ */ - diff --git a/ext/spice/src/cspice/reclat_c.c b/ext/spice/src/cspice/reclat_c.c deleted file mode 100644 index c98c0ca130..0000000000 --- a/ext/spice/src/cspice/reclat_c.c +++ /dev/null @@ -1,239 +0,0 @@ -/* - --Procedure reclat_c ( Rectangular to latitudinal coordinates ) - --Abstract - - Convert from rectangular coordinates to latitudinal coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef reclat_c - - - void reclat_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * longitude, - SpiceDouble * latitude ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - rectan I Rectangular coordinates of a point. - radius O Distance of the point from the origin. - longitude O Longitude of the point in radians. - latitude O Latitude of the point in radians. - --Detailed_Input - - rectan The rectangular coordinates of the input point. `rectan' - is a 3-vector. - --Detailed_Output - - radius Distance of the point from the origin. - - The units associated with `radius' are those - associated with the input `rectan'. - - longitude Longitude of the input point. This is angle between the - prime meridian and the meridian containing `rectan'. The - direction of increasing longitude is from the +X axis - towards the +Y axis. - - Longitude is output in radians. The range of `longitude' - is [-pi, pi]. - - - latitude Latitude of the input point. This is the angle from - the XY plane of the ray from the origin through the - point. - - Latitude is output in radians. The range of `latitude' - is [-pi/2, pi/2]. - --Files - - None. - --Exceptions - - Error free. - - 1) If the X and Y components of `rectan' are both zero, the - longitude is set to zero. - - 2) If `rectan' is the zero vector, longitude and latitude are - both set to zero. - --Particulars - - None. - --Parameters - - None. - --Examples - - Below are two tables. - - Listed in the first table (under rectan[0], rectan[1], and - rectan[2]) are a number of points whose rectangular coordinates are - taken from the set {-1, 0, 1}. - - The results of the code fragment - - reclat_c ( rectan, &r, &longitude, &latitude ); - - latitude *= dpr_c(); - longitude *= dpr_c(); - - are listed to four decimal places in the second parallel table under - r (radius), longitude, and latitude. - - rectan[0] rectan[1] rectan[2] r longitude latitude - ------------------------------- ---------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 - 0.0000 1.0000 0.0000 1.0000 90.0000 0.0000 - 0.0000 0.0000 1.0000 1.0000 0.0000 90.0000 - -1.0000 0.0000 0.0000 1.0000 180.0000 0.0000 - 0.0000 -1.0000 0.0000 1.0000 -90.0000 0.0000 - 0.0000 0.0000 -1.0000 1.0000 0.0000 -90.0000 - 1.0000 1.0000 0.0000 1.4142 45.0000 0.0000 - 1.0000 0.0000 1.0000 1.4142 0.0000 45.0000 - 0.0000 1.0000 1.0000 1.4142 90.0000 45.0000 - 1.0000 1.0000 1.0000 1.7320 45.0000 35.2643 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.2.1, 30-JUL-2003 (NJB) - - Various header changes were made to improve clarity. Some - minor header corrections were made. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Removed tab characters from source file. Now includes - interface macro header SpiceZim.h. - - -CSPICE Version 1.1.0, 21-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - rectangular to latitudinal coordinates - --& -*/ - -{ /* Begin reclat_c */ - - /* - Local variables and definitions. - */ - - SpiceDouble vmax; - SpiceDouble x1; - SpiceDouble y1; - SpiceDouble z1; - - - /* Function Body */ - - vmax = MaxAbs( rectan[0], MaxAbs( rectan[1], rectan[2] ) ); - - if ( vmax > 0.) - { - x1 = rectan[0] / vmax; - y1 = rectan[1] / vmax; - z1 = rectan[2] / vmax; - *radius = vmax * sqrt( x1*x1 + y1*y1 + z1*z1 ); - *latitude = atan2(z1, sqrt( x1*x1 + y1*y1 ) ); - - - if ( x1 == 0. && y1 == 0.) - { - *longitude = 0.; - } - - else - { - *longitude = atan2(y1, x1); - } - - } - - else - { - - /* - The vector is the zero vector. - */ - - *radius = 0.; - *longitude = 0.; - *latitude = 0.; - } - - -} /* End reclat_c */ diff --git a/ext/spice/src/cspice/recpgr.c b/ext/spice/src/cspice/recpgr.c deleted file mode 100644 index c10f9c8d90..0000000000 --- a/ext/spice/src/cspice/recpgr.c +++ /dev/null @@ -1,657 +0,0 @@ -/* recpgr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static doublereal c_b35 = 0.; - -/* $Procedure RECPGR ( Rectangular to planetographic ) */ -/* Subroutine */ int recpgr_(char *body, doublereal *rectan, doublereal *re, - doublereal *f, doublereal *lon, doublereal *lat, doublereal *alt, - ftnlen body_len) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer sense; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - extern doublereal twopi_(void); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen), - recgeo_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - integer bodyid; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen); - char kvalue[80]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char pmkvar[32], pgrlon[4]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen); - extern integer plnsns_(integer *); - extern logical return_(void); - char tmpstr[32]; - -/* $ Abstract */ - -/* Convert rectangular coordinates to planetographic coordinates. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ -/* PCK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Body with which coordinate system is associated. */ -/* RECTAN I Rectangular coordinates of a point. */ -/* RE I Equatorial radius of the reference spheroid. */ -/* F I Flattening coefficient. */ -/* LON O Planetographic longitude of the point (radians). */ -/* LAT O Planetographic latitude of the point (radians). */ -/* ALT O Altitude of the point above reference spheroid. */ - -/* $ Detailed_Input */ - -/* BODY Name of the body with which the planetographic */ -/* coordinate system is associated. */ - -/* BODY is used by this routine to look up from the */ -/* kernel pool the prime meridian rate coefficient giving */ -/* the body's spin sense. See the Files and Particulars */ -/* header sections below for details. */ - - -/* RECTAN The rectangular coordinates of a point. Units */ -/* are arbitrary, except that the input RE must be */ -/* expressed in the same units. */ - - -/* RE Equatorial radius of a reference spheroid. This */ -/* spheroid is a volume of revolution: its horizontal */ -/* cross sections are circular. The shape of the */ -/* spheroid is defined by an equatorial radius RE and a */ -/* polar radius RP. Units of RE must match those of */ -/* RECTAN. */ - - -/* F Flattening coefficient = */ - -/* (RE-RP) / RE */ - -/* where RP is the polar radius of the spheroid, and the */ -/* units of RP match those of RE. */ - -/* $ Detailed_Output */ - -/* LON Planetographic longitude of the input point. This is */ -/* the angle between the prime meridian and the meridian */ -/* containing RECTAN. For bodies having prograde (aka */ -/* direct) rotation, the direction of increasing */ -/* longitude is positive west: from the +X axis of the */ -/* rectangular coordinate system toward the -Y axis. */ -/* For bodies having retrograde rotation, the direction */ -/* of increasing longitude is positive east: from the +X */ -/* axis toward the +Y axis. */ - -/* The earth, moon, and sun are exceptions: */ -/* planetographic longitude is measured positive east for */ -/* these bodies. */ - -/* The default interpretation of longitude by this */ -/* and the other planetographic coordinate conversion */ -/* routines can be overridden; see the discussion in */ -/* Particulars below for details. */ - -/* LON is output in radians. The nominal range of LON is */ -/* given by: */ - -/* 0 < LON < 2*pi */ -/* - */ - -/* However, round-off error could cause LON to equal 2*pi. */ - - -/* LAT Planetographic latitude of the input point. For a */ -/* point P on the reference spheroid, this is the angle */ -/* between the XY plane and the outward normal vector at */ -/* P. For a point P not on the reference spheroid, the */ -/* planetographic latitude is that of the closest point */ -/* to P on the spheroid. */ - -/* LAT is output in radians. The range of LAT is given */ -/* by: */ - -/* -pi/2 < LAT < pi/2 */ -/* - - */ - - -/* ALT Altitude of point above the reference spheroid. */ - -/* The units associated with ALT are those associated */ -/* with the input RECTAN and RE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */ -/* and if BODY is not a string representation of an integer, */ -/* the error SPICE(IDCODENOTFOUND) will be signaled. */ - -/* 2) If the kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* is present in the kernel pool but has a value other than one */ -/* of */ - -/* 'EAST' */ -/* 'WEST' */ - -/* the error SPICE(INVALIDOPTION) will be signaled. Case */ -/* and blanks are ignored when these values are interpreted. */ - -/* 3) If polynomial coefficients for the prime meridian of BODY */ -/* are not available in the kernel pool, and if the kernel */ -/* variable BODY_PGR_POSITIVE_LON is not present in */ -/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */ - -/* 4) If the equatorial radius is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 5) If the flattening coefficient is greater than or equal to one, */ -/* the error SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 6) For points inside the reference ellipsoid, the nearest point */ -/* on the ellipsoid to RECTAN may not be unique, so latitude may */ -/* not be well-defined. */ - -/* $ Files */ - -/* This routine expects a kernel variable giving BODY's prime */ -/* meridian angle as a function of time to be available in the */ -/* kernel pool. Normally this item is provided by loading a PCK */ -/* file. The required kernel variable is named */ - -/* BODY_PM */ - -/* where represents a string containing the NAIF integer */ -/* ID code for BODY. For example, if BODY is 'JUPITER', then */ -/* the name of the kernel variable containing the prime meridian */ -/* angle coefficients is */ - -/* BODY599_PM */ - -/* The optional kernel variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* also is normally defined via loading a text kernel. When this */ -/* variable is present in the kernel pool, the prime meridian */ -/* coefficients for BODY are not required by this routine. See the */ -/* Particulars section below for details. */ - -/* $ Particulars */ - -/* Given the body-fixed rectangular coordinates of a point, this */ -/* routine returns the planetographic coordinates of the point. The */ -/* body-fixed rectangular frame is that having the X-axis pass */ -/* through the 0 degree latitude 0 degree longitude direction, the */ -/* Z-axis pass through the 90 degree latitude direction, and the */ -/* Y-axis equal to the cross product of the unit Z-axis and X-axis */ -/* vectors. */ - -/* The planetographic definition of latitude is identical to the */ -/* planetodetic (also called "geodetic" in SPICE documentation) */ -/* definition. In the planetographic coordinate system, latitude is */ -/* defined using a reference spheroid. The spheroid is */ -/* characterized by an equatorial radius and a polar radius. For a */ -/* point P on the spheroid, latitude is defined as the angle between */ -/* the X-Y plane and the outward surface normal at P. For a point P */ -/* off the spheroid, latitude is defined as the latitude of the */ -/* nearest point to P on the spheroid. Note if P is an interior */ -/* point, for example, if P is at the center of the spheroid, there */ -/* may not be a unique nearest point to P. */ - -/* In the planetographic coordinate system, longitude is defined */ -/* using the spin sense of the body. Longitude is positive to the */ -/* west if the spin is prograde and positive to the east if the spin */ -/* is retrograde. The spin sense is given by the sign of the first */ -/* degree term of the time-dependent polynomial for the body's prime */ -/* meridian Euler angle "W": the spin is retrograde if this term is */ -/* negative and prograde otherwise. For the sun, planets, most */ -/* natural satellites, and selected asteroids, the polynomial */ -/* expression for W may be found in a SPICE PCK kernel. */ - -/* The earth, moon, and sun are exceptions: planetographic longitude */ -/* is measured positive east for these bodies. */ - -/* If you wish to override the default sense of positive longitude */ -/* for a particular body, you can do so by defining the kernel */ -/* variable */ - -/* BODY_PGR_POSITIVE_LON */ - -/* where represents the NAIF ID code of the body. This */ -/* variable may be assigned either of the values */ - -/* 'WEST' */ -/* 'EAST' */ - -/* For example, you can have this routine treat the longitude */ -/* of the earth as increasing to the west using the kernel */ -/* variable assignment */ - -/* BODY399_PGR_POSITIVE_LON = 'WEST' */ - -/* Normally such assignments are made by placing them in a text */ -/* kernel and loading that kernel via FURNSH. */ - -/* The definition of this kernel variable controls the behavior of */ -/* the SPICELIB planetographic routines */ - -/* PGRREC */ -/* RECPGR */ -/* DPGRDR */ -/* DRDPGR */ - -/* It does not affect the other SPICELIB coordinate conversion */ -/* routines. */ - -/* $ Examples */ - - -/* Numerical results shown for this example may differ between */ -/* platforms as the results depend on the SPICE kernels used as */ -/* input and the machine specific arithmetic implementation. */ - - -/* 1) Find the planetographic coordinates of the point having Mars */ -/* rectangular coordinates: */ - -/* X (km) = 0.0 */ -/* Y (km) = -2620.678914818178 */ -/* Z (km) = 2592.408908856967 */ - -/* (These input values have been chosen to create "simple" output */ -/* values.) */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION RPD */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION F */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION RADII ( 3 ) */ -/* DOUBLE PRECISION RE */ -/* DOUBLE PRECISION RECTAN ( 3 ) */ -/* DOUBLE PRECISION RP */ - -/* INTEGER N */ -/* C */ -/* C Load a PCK file containing a triaxial */ -/* C ellipsoidal shape model and orientation */ -/* C data for Mars. */ -/* C */ -/* CALL FURNSH ( 'pck00008.tpc' ) */ - -/* C */ -/* C Look up the radii for Mars. Although we */ -/* C omit it here, we could first call BADKPV */ -/* C to make sure the variable BODY499_RADII */ -/* C has three elements and numeric data type. */ -/* C If the variable is not present in the kernel */ -/* C pool, BODVRD will signal an error. */ -/* C */ -/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */ - -/* C */ -/* C Compute flattening coefficient. */ -/* C */ -/* RE = RADII(1) */ -/* RP = RADII(3) */ -/* F = ( RE - RP ) / RE */ - -/* C */ -/* C Do the conversion. */ -/* C */ -/* RECTAN(1) = 0.D0 */ -/* RECTAN(2) = -2620.678914818178D0 */ -/* RECTAN(3) = 2592.408908856967D0 */ - -/* CALL RECPGR ( 'MARS', RECTAN, RE, F, LON, LAT, ALT ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Rectangular coordinates:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' X (km) = ', RECTAN(1) */ -/* WRITE (*,*) ' Y (km) = ', RECTAN(2) */ -/* WRITE (*,*) ' Z (km) = ', RECTAN(3) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Ellipsoid shape parameters: ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Equatorial radius (km) = ', RE */ -/* WRITE (*,*) ' Polar radius (km) = ', RP */ -/* WRITE (*,*) ' Flattening coefficient = ', F */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Planetographic coordinates:' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Longitude (deg) = ', LON / RPD() */ -/* WRITE (*,*) ' Latitude (deg) = ', LAT / RPD() */ -/* WRITE (*,*) ' Altitude (km) = ', ALT */ -/* WRITE (*,*) ' ' */ - -/* END */ - - -/* Output from this program should be similar to the following */ -/* (rounding and formatting will differ across platforms): */ - -/* Rectangular coordinates: */ - -/* X (km) = 0. */ -/* Y (km) = -2620.67891 */ -/* Z (km) = 2592.40891 */ - -/* Ellipsoid shape parameters: */ - -/* Equatorial radius (km) = 3396.19 */ -/* Polar radius (km) = 3376.2 */ -/* Flattening coefficient = 0.00588600756 */ - -/* Planetographic coordinates: */ - -/* Longitude (deg) = 90. */ -/* Latitude (deg) = 45. */ -/* Altitude (km) = 300. */ - - - -/* 2) Below is a table showing a variety of rectangular coordinates */ -/* and the corresponding Mars planetographic coordinates. The */ -/* values are computed using the reference spheroid having radii */ - -/* Equatorial radius: 3397 */ -/* Polar radius: 3375 */ - -/* Note: the values shown above may not be current or suitable */ -/* for your application. */ - - -/* Corresponding rectangular and planetographic coordinates are */ -/* listed to three decimal places. */ - -/* RECTAN(1) RECTAN(2) RECTAN(3) LON LAT ALT */ -/* ------------------------------------------------------------------ */ -/* 3397.000 0.000 0.000 0.000 0.000 0.000 */ -/* -3397.000 0.000 0.000 180.000 0.000 0.000 */ -/* -3407.000 0.000 0.000 180.000 0.000 10.000 */ -/* -3387.000 0.000 0.000 180.000 0.000 -10.000 */ -/* 0.000 -3397.000 0.000 90.000 0.000 0.000 */ -/* 0.000 3397.000 0.000 270.000 0.000 0.000 */ -/* 0.000 0.000 3375.000 0.000 90.000 0.000 */ -/* 0.000 0.000 -3375.000 0.000 -90.000 0.000 */ -/* 0.000 0.000 0.000 0.000 90.000 -3375.000 */ - - - -/* 3) Below we show the analogous relationships for the earth, */ -/* using the reference ellipsoid radii */ - -/* Equatorial radius: 6378.140 */ -/* Polar radius: 6356.750 */ - -/* Note the change in longitudes for points on the +/- Y axis */ -/* for the earth vs the Mars values. */ - - -/* RECTAN(1) RECTAN(2) RECTAN(3) LON LAT ALT */ -/* ---------------------------------- ------------------------------- */ -/* 6378.140 0.000 0.000 0.000 0.000 0.000 */ -/* -6378.140 0.000 0.000 180.000 0.000 0.000 */ -/* -6388.140 0.000 0.000 180.000 0.000 10.000 */ -/* -6368.140 0.000 0.000 180.000 0.000 -10.000 */ -/* 0.000 -6378.140 0.000 270.000 0.000 0.000 */ -/* 0.000 6378.140 0.000 90.000 0.000 0.000 */ -/* 0.000 0.000 6356.750 0.000 90.000 0.000 */ -/* 0.000 0.000 -6356.750 0.000 -90.000 0.000 */ -/* 0.000 0.000 0.000 0.000 90.000 -6356.750 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 23-JAN-2008 (EDW) */ - -/* Corrected typo in LAT range description, from: */ - -/* -pi/2 < LAT < pi */ -/* - - */ - -/* to: */ - -/* -pi/2 < LAT < pi/2 */ -/* - - */ - -/* - SPICELIB Version 1.0.0, 26-DEC-2004 (CHA) (NJB) (HAN) (BVS) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert rectangular to planetographic coordinates */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("RECPGR", (ftnlen)6); - -/* Convert the body name to an ID code. */ - - bods2c_(body, &bodyid, &found, body_len); - if (! found) { - setmsg_("The value of the input argument BODY is #, this is not a re" - "cognized name of an ephemeris object. The cause of this prob" - "lem may be that you need an updated version of the SPICE Too" - "lkit. ", (ftnlen)185); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("RECPGR", (ftnlen)6); - return 0; - } - -/* The equatorial radius must be positive. If not, signal an error */ -/* and check out. */ - - if (*re <= 0.) { - setmsg_("Equatorial radius was #.", (ftnlen)24); - errdp_("#", re, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("RECPGR", (ftnlen)6); - return 0; - } - -/* If the flattening coefficient is greater than 1, the polar radius */ -/* is negative. If F is equal to 1, the polar radius is zero. Either */ -/* case is a problem, so signal an error and check out. */ - - if (*f >= 1.) { - setmsg_("Flattening coefficient was #.", (ftnlen)29); - errdp_("#", f, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("RECPGR", (ftnlen)6); - return 0; - } - -/* Look up the longitude sense override variable from the */ -/* kernel pool. */ - - repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, ( - ftnlen)1, (ftnlen)32); - gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80); - if (found) { - -/* Make sure we recognize the value of PGRLON. */ - - cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32) - ; - ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4); - if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) { - sense = 1; - } else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) { - sense = -1; - } else { - setmsg_("Kernel variable # may have the values EAST or WEST. Ac" - "tual value was #.", (ftnlen)72); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", kvalue, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("RECPGR", (ftnlen)6); - return 0; - } - } else { - -/* Look up the spin sense of the body's prime meridian. */ - - sense = plnsns_(&bodyid); - -/* If the required prime meridian rate was not available, */ -/* PLNSNS returns the code 0. Here we consider this situation */ -/* to be an error. */ - - if (sense == 0) { - repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, ( - ftnlen)32); - setmsg_("Prime meridian rate coefficient defined by kernel varia" - "ble # is required but not available for body #. ", ( - ftnlen)103); - errch_("#", pmkvar, (ftnlen)1, (ftnlen)32); - errch_("#", body, (ftnlen)1, body_len); - sigerr_("SPICE(MISSINGDATA)", (ftnlen)18); - chkout_("RECPGR", (ftnlen)6); - return 0; - } - -/* Handle the special cases: earth, moon, and sun. */ - - if (bodyid == 399 || bodyid == 301 || bodyid == 10) { - sense = 1; - } - } - -/* At this point, SENSE is set to +/- 1. */ - -/* Convert the input coordinates first to geodetic coordinates. */ - - recgeo_(rectan, re, f, lon, lat, alt); -/* Adjust the longitude according to the sense of the body's */ -/* spin, or according to the override value if one is provided. */ - - *lon = sense * *lon; - -/* Convert the longitude from the range (-pi, pi] to [0, 2*pi), */ -/* the latter being the range of planetographic longitude. */ - - if (*lon < 0.) { - *lon += twopi_(); - } - -/* Make sure round-off error doesn't take LON out of range. */ - - d__1 = twopi_(); - *lon = brcktd_(lon, &c_b35, &d__1); - chkout_("RECPGR", (ftnlen)6); - return 0; -} /* recpgr_ */ - diff --git a/ext/spice/src/cspice/recpgr_c.c b/ext/spice/src/cspice/recpgr_c.c deleted file mode 100644 index 5f56b5fadc..0000000000 --- a/ext/spice/src/cspice/recpgr_c.c +++ /dev/null @@ -1,548 +0,0 @@ -/* - --Procedure recpgr_c ( Rectangular to planetographic ) - --Abstract - - Convert rectangular coordinates to planetographic coordinates. - --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 - - KERNEL - NAIF_IDS - PCK - --Keywords - - CONVERSION - COORDINATES - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void recpgr_c ( ConstSpiceChar * body, - SpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - body I Body with which coordinate system is associated. - rectan I Rectangular coordinates of a point. - re I Equatorial radius of the reference spheroid. - f I Flattening coefficient. - lon O Planetographic longitude of the point (radians). - lat O Planetographic latitude of the point (radians). - alt O Altitude of the point above reference spheroid. - --Detailed_Input - - body Name of the body with which the planetographic - coordinate system is associated. - - `body' is used by this routine to look up from the - kernel pool the prime meridian rate coefficient giving - the body's spin sense. See the Files and Particulars - header sections below for details. - - - rectan The rectangular coordinates of a point. Units - are arbitrary, except that the input `re' must be - expressed in the same units. - - - re Equatorial radius of a reference spheroid. This - spheroid is a volume of revolution: its horizontal - cross sections are circular. The shape of the - spheroid is defined by an equatorial radius `re' and a - polar radius `rp'. Units of `re' must match those of - `rectan'. - - - f Flattening coefficient = - - (re-rp) / re - - where `rp' is the polar radius of the spheroid, and the - units of `rp' match those of `re'. - --Detailed_Output - - lon Planetographic longitude of the input point. This is - the angle between the prime meridian and the meridian - containing `rectan'. For bodies having prograde (aka - direct) rotation, the direction of increasing - longitude is positive west: from the +X axis of the - rectangular coordinate system toward the -Y axis. - For bodies having retrograde rotation, the direction - of increasing longitude is positive east: from the +X - axis toward the +Y axis. - - The earth, moon, and sun are exceptions: - planetographic longitude is measured positive east for - these bodies. - - The default interpretation of longitude by this - and the other planetographic coordinate conversion - routines can be overridden; see the discussion in - Particulars below for details. - - `lon' is output in radians. The nominal range of `lon' is - given by: - - 0 < lon < 2*pi - - - - However, round-off error could cause `lon' to equal 2*pi. - - - lat Planetographic latitude of the input point. For a - point P on the reference spheroid, this is the angle - between the XY plane and the outward normal vector at - P. For a point P not on the reference spheroid, the - planetographic latitude is that of the closest point - to P on the spheroid. - - `lat' is output in radians. The range of `lat' is given - by: - - -pi/2 < lat < pi/2 - - - - - - alt Altitude of point above the reference spheroid. - - The units associated with `alt' are those associated - with the input `rectan' and `re'. - --Parameters - - None. - --Exceptions - - 1) If the body name `body' cannot be mapped to a NAIF ID code, - and if `body' is not a string representation of an integer, - the error SPICE(IDCODENOTFOUND) will be signaled. - - 2) If the kernel variable - - BODY_PGR_POSITIVE_LON - - is present in the kernel pool but has a value other than one - of - - 'EAST' - 'WEST' - - the error SPICE(INVALIDOPTION) will be signaled. Case - and blanks are ignored when these values are interpreted. - - 3) If polynomial coefficients for the prime meridian of `body' - are not available in the kernel pool, and if the kernel - variable BODY_PGR_POSITIVE_LON is not present in - the kernel pool, the error SPICE(MISSINGDATA) will be signaled. - - 4) If the equatorial radius is non-positive, the error - SPICE(VALUEOUTOFRANGE) is signaled. - - 5) If the flattening coefficient is greater than or equal to one, - the error SPICE(VALUEOUTOFRANGE) is signaled. - - 6) For points inside the reference ellipsoid, the nearest point - on the ellipsoid to `rectan' may not be unique, so latitude may - not be well-defined. - - 7) The error SPICE(EMPTYSTRING) is signaled if the input - string `body' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 8) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `body' is null. - --Files - - This routine expects a kernel variable giving body's prime - meridian angle as a function of time to be available in the - kernel pool. Normally this item is provided by loading a PCK - file. The required kernel variable is named - - BODY_PM - - where represents a string containing the NAIF integer - ID code for `body'. For example, if `body' is "JUPITER", then - the name of the kernel variable containing the prime meridian - angle coefficients is - - BODY599_PM - - The optional kernel variable - - BODY_PGR_POSITIVE_LON - - also is normally defined via loading a text kernel. When this - variable is present in the kernel pool, the prime meridian - coefficients for `body' are not required by this routine. See the - Particulars section below for details. - --Particulars - - Given the body-fixed rectangular coordinates of a point, this - routine returns the planetographic coordinates of the point. The - body-fixed rectangular frame is that having the X-axis pass - through the 0 degree latitude 0 degree longitude direction, the - Z-axis pass through the 90 degree latitude direction, and the - Y-axis equal to the cross product of the unit Z-axis and X-axis - vectors. - - The planetographic definition of latitude is identical to the - planetodetic (also called "geodetic" in SPICE documentation) - definition. In the planetographic coordinate system, latitude is - defined using a reference spheroid. The spheroid is - characterized by an equatorial radius and a polar radius. For a - point P on the spheroid, latitude is defined as the angle between - the X-Y plane and the outward surface normal at P. For a point P - off the spheroid, latitude is defined as the latitude of the - nearest point to P on the spheroid. Note if P is an interior - point, for example, if P is at the center of the spheroid, there - may not be a unique nearest point to P. - - In the planetographic coordinate system, longitude is defined - using the spin sense of the body. Longitude is positive to the - west if the spin is prograde and positive to the east if the spin - is retrograde. The spin sense is given by the sign of the first - degree term of the time-dependent polynomial for the body's prime - meridian Euler angle "W": the spin is retrograde if this term is - negative and prograde otherwise. For the sun, planets, most - natural satellites, and selected asteroids, the polynomial - expression for W may be found in a SPICE PCK kernel. - - The earth, moon, and sun are exceptions: planetographic longitude - is measured positive east for these bodies. - - If you wish to override the default sense of positive longitude - for a particular body, you can do so by defining the kernel - variable - - BODY_PGR_POSITIVE_LON - - where represents the NAIF ID code of the body. This - variable may be assigned either of the values - - 'WEST' - 'EAST' - - For example, you can have this routine treat the longitude - of the earth as increasing to the west using the kernel - variable assignment - - BODY399_PGR_POSITIVE_LON = 'WEST' - - Normally such assignments are made by placing them in a text - kernel and loading that kernel via furnsh_c. - - The definition of this kernel variable controls the behavior of - the CSPICE planetographic routines - - pgrrec_c - recpgr_c - dpgrdr_c - drdpgr_c - - It does not affect the other CSPICE coordinate conversion - routines. - --Examples - - - Numerical results shown for this example may differ between - platforms as the results depend on the SPICE kernels used as - input and the machine specific arithmetic implementation. - - - 1) Find the planetographic coordinates of the point having Mars - rectangular coordinates: - - X (km) = 0.0 - Y (km) = -2620.678914818178 - Z (km) = 2592.408908856967 - - (These input values have been chosen to create "simple" output - values.) - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local variables - ./ - SpiceDouble alt; - SpiceDouble f; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble radii [3]; - SpiceDouble re; - SpiceDouble rectan [3]; - SpiceDouble rp; - - SpiceInt n; - - - /. - Load a PCK file containing a triaxial - ellipsoidal shape model and orientation - data for Mars. - ./ - furnsh_c ( "pck00008.tpc" ); - - /. - Look up the radii for Mars. Although we - omit it here, we could first call badkpv_c - to make sure the variable BODY499_RADII - has three elements and numeric data type. - If the variable is not present in the kernel - pool, bodvrd_c will signal an error. - ./ - bodvrd_c ( "MARS", "RADII", 3, &n, radii ); - - /. - Compute flattening coefficient. - ./ - re = radii[0]; - rp = radii[2]; - f = ( re - rp ) / re; - - /. - Do the conversion. - ./ - rectan[0] = 0.0; - rectan[1] = -2620.678914818178; - rectan[2] = 2592.408908856967; - - recpgr_c ( "mars", rectan, re, f, &lon, &lat, &alt ); - - - printf ( "\n" - "Rectangular coordinates:\n" - "\n" - " X (km) = %18.9e\n" - " Y (km) = %18.9e\n" - " Z (km) = %18.9e\n" - "\n" - "Ellipsoid shape parameters:\n" - "\n" - " Equatorial radius (km) = %18.9e\n" - " Polar radius (km) = %18.9e\n" - " Flattening coefficient = %18.9e\n" - "\n" - "Planetographic coordinates:\n" - "\n" - " Longitude (deg) = %18.9e\n" - " Latitude (deg) = %18.9e\n" - " Altitude (km) = %18.9e\n" - "\n", - rectan[0], - rectan[1], - rectan[2], - re, - rp, - f, - lon / rpd_c(), - lat / rpd_c(), - alt ); - - return ( 0 ); - } - - - Output from this program should be similar to the following - (rounding and formatting will differ across platforms): - - - Rectangular coordinates: - - X (km) = 0.000000000e+00 - Y (km) = -2.620678915e+03 - Z (km) = 2.592408909e+03 - - Ellipsoid shape parameters: - - Equatorial radius (km) = 3.396190000e+03 - Polar radius (km) = 3.376200000e+03 - Flattening coefficient = 5.886007556e-03 - - Planetographic coordinates: - - Longitude (deg) = 9.000000000e+01 - Latitude (deg) = 4.500000000e+01 - Altitude (km) = 3.000000000e+02 - - - - 2) Below is a table showing a variety of rectangular coordinates - and the corresponding Mars planetographic coordinates. The - values are computed using the reference spheroid having radii - - Equatorial radius: 3397 - Polar radius: 3375 - - Note: the values shown above may not be current or suitable - for your application. - - - Corresponding rectangular and planetographic coordinates are - listed to three decimal places. - - rectan[0] rectan[1] rectan[2] lon lat alt - ------------------------------------------------------------------ - 3397.000 0.000 0.000 0.000 0.000 0.000 - -3397.000 0.000 0.000 180.000 0.000 0.000 - -3407.000 0.000 0.000 180.000 0.000 10.000 - -3387.000 0.000 0.000 180.000 0.000 -10.000 - 0.000 -3397.000 0.000 90.000 0.000 0.000 - 0.000 3397.000 0.000 270.000 0.000 0.000 - 0.000 0.000 3375.000 0.000 90.000 0.000 - 0.000 0.000 -3375.000 0.000 -90.000 0.000 - 0.000 0.000 0.000 0.000 90.000 -3375.000 - - - - 3) Below we show the analogous relationships for the earth, - using the reference ellipsoid radii - - Equatorial radius: 6378.140 - Polar radius: 6356.750 - - Note the change in longitudes for points on the +/- Y axis - for the earth vs the Mars values. - - rectan[0] rectan[1] rectan[2] lon lat alt - ---------------------------------- ------------------------------- - 6378.140 0.000 0.000 0.000 0.000 0.000 - -6378.140 0.000 0.000 180.000 0.000 0.000 - -6388.140 0.000 0.000 180.000 0.000 10.000 - -6368.140 0.000 0.000 180.000 0.000 -10.000 - 0.000 -6378.140 0.000 270.000 0.000 0.000 - 0.000 6378.140 0.000 90.000 0.000 0.000 - 0.000 0.000 6356.750 0.000 90.000 0.000 - 0.000 0.000 -6356.750 0.000 -90.000 0.000 - 0.000 0.000 0.000 0.000 90.000 -6356.750 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - H.A. Neilan (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 23-JAN-2008 (EDW) - - Corrected typo in LAT range description, from: - - -pi/2 < LAT < pi - - - - - to: - - -pi/2 < LAT < pi/2 - - - - - -CSPICE Version 1.0.0, 26-DEC-2004 (CHA) (NJB) (HAN) (BVS) (WLT) - --Index_Entries - - convert rectangular to planetographic coordinates - --& -*/ - -{ /* Begin recpgr_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "recpgr_c" ); - - - /* - Check the input string body to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "recpgr_c", body ); - - - /* - Call the f2c'd Fortran routine. - */ - recpgr_ ( ( char * ) body, - ( doublereal * ) rectan, - ( doublereal * ) &re, - ( doublereal * ) &f, - ( doublereal * ) lon, - ( doublereal * ) lat, - ( doublereal * ) alt, - ( ftnlen ) strlen(body) ); - - - chkout_c ( "recpgr_c" ); - -} /* End recpgr_c */ diff --git a/ext/spice/src/cspice/recrad.c b/ext/spice/src/cspice/recrad.c deleted file mode 100644 index d7b83c4f9b..0000000000 --- a/ext/spice/src/cspice/recrad.c +++ /dev/null @@ -1,201 +0,0 @@ -/* recrad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RECRAD ( Rectangular coordinates to RA and DEC ) */ -/* Subroutine */ int recrad_(doublereal *rectan, doublereal *range, - doublereal *ra, doublereal *dec) -{ - extern doublereal twopi_(void); - extern /* Subroutine */ int reclat_(doublereal *, doublereal *, - doublereal *, doublereal *); - -/* $ Abstract */ - -/* Convert rectangular coordinates to range, right ascension, */ -/* and declination. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RECTAN I Rectangular coordinates of a point. */ -/* RANGE O Distance of the point from the origin. */ -/* RA O Right ascension in radians. */ -/* DEC O Declination in radians. */ - -/* $ Detailed_Input */ - -/* RECTAN The rectangular coordinates of a point. */ - -/* $ Detailed_Output */ - -/* RANGE is the distance of the point from the origin. */ - -/* The units associated with RANGE are those */ -/* associated with the input RECTAN. */ - - -/* RA is the right ascension of RECTAN. This is the angular */ -/* distance measured toward the east from the prime */ -/* meridian to the meridian containing the input point. */ -/* The direction of increasing right ascension is from */ -/* the +X axis towards the +Y axis. */ - -/* RA is output in radians. The range of RA is [0, 2*pi]. */ - - -/* DEC is the declination of RECTAN. This is the angle from */ -/* the XY plane of the ray from the origin through the */ -/* point. */ - -/* DEC is output in radians. The range of DEC is */ -/* [-pi/2, pi/2]. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the X and Y components of RECTAN are both zero, the */ -/* right ascension is set to zero. */ - -/* 2) If RECTAN is the zero vector, right ascension and declination */ -/* are both set to zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the range, right ascension, and declination */ -/* of a point specified in rectangular coordinates. */ - -/* The output is defined by a distance from a central reference */ -/* point, an angle from a reference meridian, and an angle above */ -/* the equator of a sphere centered at the central reference */ -/* point. */ - -/* $ Examples */ - -/* The following code fragment converts right ascension and */ -/* declination from the B1950 reference frame to the J2000 frame. */ - -/* C */ -/* C Convert RA and DEC to a 3-vector expressed in */ -/* C the B1950 frame. */ -/* C */ -/* CALL RADREC ( 1.D0, RA, DEC, V1950 ) */ -/* C */ -/* C We use the SPICELIB routine PXFORM to obtain the */ -/* C transformation matrix for converting vectors between */ -/* C the B1950 and J2000 reference frames. Since */ -/* C both frames are inertial, the input time value we */ -/* C supply to PXFORM is arbitrary. We choose zero */ -/* C seconds past the J2000 epoch. */ -/* C */ -/* CALL PXFORM ( 'B1950', 'J2000', 0.D0, MTRANS ) */ -/* C */ -/* C Transform the vector to the J2000 frame. */ -/* C */ -/* CALL MXV ( MTRANS, V1950, V2000 ) */ -/* C */ -/* C Find the RA and DEC of the J2000-relative vector. */ -/* C */ -/* CALL RECRAD ( V2000, R, RA, DEC ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 30-JUL-2003 (NJB) (CHA) */ - -/* Various header changes were made to improve clarity. Some */ -/* minor header corrections were made. */ - -/* - 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 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* rectangular coordinates to ra and dec */ -/* rectangular to right_ascension and declination */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Call the subroutine RECLAT to convert the rectangular coordinates */ -/* into latitudinal coordinates. In RECLAT, the longitude ( which */ -/* is returned to this subroutine as RA ) ranges from - pi to pi */ -/* radians. Because the right ascension ranges from zero to */ -/* two pi radians, whenever RA is negative two pi must be added to */ -/* it. */ - - reclat_(rectan, range, ra, dec); - if (*ra < 0.) { - *ra += twopi_(); - } - return 0; -} /* recrad_ */ - diff --git a/ext/spice/src/cspice/recrad_c.c b/ext/spice/src/cspice/recrad_c.c deleted file mode 100644 index 9cd3bf7db6..0000000000 --- a/ext/spice/src/cspice/recrad_c.c +++ /dev/null @@ -1,209 +0,0 @@ -/* - --Procedure recrad_c ( Rectangular coordinates to RA and DEC ) - --Abstract - - Convert rectangular coordinates to range, right ascension, and - declination. - --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 - - CONVERSION, COORDINATES - -*/ - - #include "SpiceUsr.h" - #undef recrad_c - - - void recrad_c ( ConstSpiceDouble rectan[3], - SpiceDouble * range, - SpiceDouble * ra, - SpiceDouble * dec ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - rectan I Rectangular coordinates of a point. - range O Distance of the point from the origin. - ra O Right ascension in radians. - dec O Declination in radians. - --Detailed_Input - - rectan The rectangular coordinates of a point. - --Detailed_Output - - range is the distance of the point `rectan' from the origin. - - The units associated with `range' are those associated - with the input `rectan'. - - ra is the right ascension of `rectan'. This is the angular - distance measured toward the east from the prime meridian - to the meridian containing the input point. The direction - of increasing right ascension is from the +X axis towards - the +Y axis. - - `ra' is output in radians. The range of `ra' is [0, 2*pi]. - - - dec is the declination of `rectan'. This is the angle from - the XY plane of the ray from the origin through the - point. - - `dec' is output in radians. The range of `dec' is - [-pi/2, pi/2]. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If the X and Y components of `rectan' are both zero, the - right ascension is set to zero. - - 2) If `rectan' is the zero vector, right ascension and declination - are both set to zero. - --Files - - None. - --Particulars - - None. - --Examples - - The following code fragment converts right ascension and - declination from the B1950 reference frame to the J2000 frame. - - #include "SpiceUsr.h" - - SpiceDouble ra; - SpiceDouble dec; - SpiceDouble r; - SpiceDouble mtrans [ 3 ][ 3 ]; - SpiceDouble v1950 [ 3 ]; - SpiceDouble v2000 [ 3 ]; - - /. - Convert RA and DEC to a 3-vector expressed in the B1950 frame. - ./ - radrec_c ( 1.0, ra, dec, v1950 ); - - /. - We use the CSPICE routine pxform_c to obtain the transformation - matrix for converting vectors between the B1950 and J2000 - reference frames. Since both frames are inertial, the input time - value we supply to pxform_c is arbitrary. We choose zero seconds - past the J2000 epoch as the input value. - ./ - pxform_c ( "B1950", "J2000", 0.0, mtrans ); - - /. - Transform the vector to the J2000 frame. - ./ - mxv_c ( mtrans, v1950, v2000 ); - - /. - Find the RA and DEC of the J2000-relative vector. - ./ - recrad_c ( v2000, &r, &ra, &dec ); - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.2, 30-JUL-2003 (NJB) - - Various header corrections were made. - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - rectangular coordinates to ra and dec - rectangular to right_ascension and declination - --& -*/ - -{ /* Begin recrad_c */ - - /* - Call reclat_c to perform the conversion to angular terms. - */ - - reclat_c ( rectan, range, ra, dec ); - - - /* - Right ascension is always in the domain [0, 2Pi]. Rectan_c returns - ra in the domain [ -Pi, Pi ]. If ra is negative, add 2 Pi to map the - value to the correct domain - */ - - if ( *ra < 0. ) - { - *ra = *ra + twopi_c(); - } - - - -} /* End recrad_c */ diff --git a/ext/spice/src/cspice/recsph.c b/ext/spice/src/cspice/recsph.c deleted file mode 100644 index 82ce4112a5..0000000000 --- a/ext/spice/src/cspice/recsph.c +++ /dev/null @@ -1,208 +0,0 @@ -/* recsph.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RECSPH ( Rectangular to spherical coordinates ) */ -/* Subroutine */ int recsph_(doublereal *rectan, doublereal *r__, doublereal * - colat, doublereal *long__) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal), atan2(doublereal, doublereal); - - /* Local variables */ - doublereal x, y, z__, big; - -/* $ Abstract */ - -/* Convert from rectangular coordinates to spherical coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RECTAN I Rectangular coordinates of a point. */ -/* R O Distance of the point from the origin. */ -/* COLAT O Angle of the point from the positive Z-axis. */ -/* LONG O Longitude of the point radians. */ - -/* $ Detailed_Input */ - -/* RECTAN The rectangular coordinates of a point. */ - -/* $ Detailed_Output */ - -/* R Distance of the point from the origin. */ - -/* COLAT Angle between the point and the positive z-axis. */ - -/* LONG Longitude of the point in radians. This is the angle */ -/* between the positive X-axis and the orthogonal */ -/* projection of the point onto the XY plane. LONG */ -/* increases in the counterclockwise sense about the */ -/* positive Z-axis. The range of LONG is: */ - -/* -pi < LONG <= pi */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the spherical coordinates of a point */ -/* whose position is input in rectangular coordinates. */ - -/* Spherical coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* from the z-axis. */ - -/* $ Examples */ - -/* Below are two tables. */ - -/* Listed in the first table (under X(1), X(2) and X(3) ) are a */ -/* number of points whose rectangular coordinates are */ -/* taken from the set {-1, 0, 1}. */ - -/* The result of the code fragment */ - -/* CALL RECSPH ( X, R, COLAT, LONG ) */ - -/* Use the SPICELIB routine CONVRT to convert the angular */ -/* quantities to degrees */ - -/* CALL CONVRT ( COLAT, 'RADIANS', 'DEGREES', COLAT ) */ -/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */ - -/* are listed to 4 decimal places in the second parallel table under */ -/* R (radius), COLAT (co-latitude), and LONG (longitude). */ - -/* X(1) X(2) X(3) R COLAT LONG */ -/* -------------------------- ---------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 1.0000 90.0000 0.0000 */ -/* 0.0000 1.0000 0.0000 1.0000 90.0000 90.0000 */ -/* 0.0000 0.0000 1.0000 1.0000 0.0000 0.0000 */ -/* -1.0000 0.0000 0.0000 1.0000 90.0000 180.0000 */ -/* 0.0000 -1.0000 0.0000 1.0000 90.0000 -90.0000 */ -/* 0.0000 0.0000 -1.0000 1.0000 180.0000 0.0000 */ -/* 1.0000 1.0000 0.0000 1.4142 90.0000 45.0000 */ -/* 1.0000 0.0000 1.0000 1.4142 45.0000 0.0000 */ -/* 0.0000 1.0000 1.0000 1.4142 45.0000 90.0000 */ -/* 1.0000 1.0000 1.0000 1.7320 54.7356 45.0000 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 07-JAN-2002 (NJB) */ - -/* Fixed description of LONG in Brief_I/O and Detailed_I/O */ -/* header sections. */ - -/* - 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 */ - -/* rectangular to spherical coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Store rectangular coordinates in temporary variables */ - -/* Computing MAX */ - d__1 = abs(rectan[0]), d__2 = abs(rectan[1]), d__1 = max(d__1,d__2), d__2 - = abs(rectan[2]); - big = max(d__1,d__2); - if (big > 0.) { - x = rectan[0] / big; - y = rectan[1] / big; - z__ = rectan[2] / big; - *r__ = big * sqrt(x * x + y * y + z__ * z__); - *colat = atan2(sqrt(x * x + y * y), z__); - x = rectan[0]; - y = rectan[1]; - if (x == 0. && y == 0.) { - *long__ = 0.; - } else { - *long__ = atan2(y, x); - } - } else { - *r__ = 0.; - *colat = 0.; - *long__ = 0.; - } - return 0; -} /* recsph_ */ - diff --git a/ext/spice/src/cspice/recsph_c.c b/ext/spice/src/cspice/recsph_c.c deleted file mode 100644 index dfbf164278..0000000000 --- a/ext/spice/src/cspice/recsph_c.c +++ /dev/null @@ -1,220 +0,0 @@ -/* - --Procedure recsph_c ( Rectangular to spherical coordinates ) - --Abstract - - Convert from rectangular coordinates to spherical coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef recsph_c - - - void recsph_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * colat, - SpiceDouble * lon ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - rectan I Rectangular coordinates of a point. - r O Distance of the point from the origin. - colat O Angle of the point from the positive Z-axis. - lon O Longitude of the point in radians. - --Detailed_Input - - rectan The rectangular coordinates of a point. - --Detailed_Output - - r Distance of the point from the origin. - - colat Angle between the point and the positive z-axis. - - lon Longitude of the point in radians. This is the angle - between the positive X-axis and the orthogonal - projection of the point onto the XY plane. LONG - increases in the counterclockwise sense about the - positive Z-axis. The range of LONG is: - - -pi < LONG <= pi - --Parameters - - None. - --Particulars - - This routine returns the spherical coordinates of a point - whose position is input in rectangular coordinates. - - spherical coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - from the z-axis. - --Examples - - Below are two tables. - - Listed in the first table (under X(1), X(2) and X(3) ) are a - number of points whose rectangular coordinates are - taken from the set {-1, 0, 1}. - - The result of the code fragment - - recsph_c ( X, r, colat, lon ) - - Use the CSPICE routine convrt_c to convert the angular - quantities to degrees - - convrt_c ( colat, "RADIANS", "DEGREES", colat ) - convrt_c ( lon, "RADIANS", "DEGREES", lon ) - - are listed to 4 decimal places in the second parallel table under - r (radius), colat (co-latitude), and lon (longitude). - - X(1) X(2) X(3) r colat lon - -------------------------- ---------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 0.0000 0.0000 1.0000 90.0000 0.0000 - 0.0000 1.0000 0.0000 1.0000 90.0000 90.0000 - 0.0000 0.0000 1.0000 1.0000 0.0000 0.0000 - -1.0000 0.0000 0.0000 1.0000 90.0000 180.0000 - 0.0000 -1.0000 0.0000 1.0000 90.0000 -90.0000 - 0.0000 0.0000 -1.0000 1.0000 180.0000 0.0000 - 1.0000 1.0000 0.0000 1.4142 90.0000 45.0000 - 1.0000 0.0000 1.0000 1.4142 45.0000 0.0000 - 0.0000 1.0000 1.0000 1.4142 45.0000 90.0000 - 1.0000 1.0000 1.0000 1.7320 54.7356 45.0000 - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.1, 07-JAN-2002 (NJB) (EDW) - - Fixed description of lon in Brief_I/O and Detailed_I/O - header sections. - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input coordinate array const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - rectangular to spherical coordinates - --& -*/ - -{ /* Begin recsph_c */ - - /* - Local constants - */ - - SpiceDouble x; - SpiceDouble y; - SpiceDouble z; - SpiceDouble big; - - - /* Computing maximum magnitude of the elements of rectan */ - - big = MaxAbs( rectan[0], MaxAbs( rectan[1], rectan[2] ) ); - - if (big > 0.) - { - - x = rectan[0] / big; - y = rectan[1] / big; - z = rectan[2] / big; - - *r = big * sqrt(x * x + y * y + z * z ); - *colat = atan2( sqrt(x * x + y * y), z ); - - x = rectan[0]; - y = rectan[1]; - - if (x == 0. && y == 0.) - { - *lon = 0.; - } - else - { - *lon = atan2(y, x); - } - } - - else - { - *r = 0.; - *colat = 0.; - *lon = 0.; - } - - -} /* End recsph_c */ diff --git a/ext/spice/src/cspice/refchg.c b/ext/spice/src/cspice/refchg.c deleted file mode 100644 index 1bc5d47a88..0000000000 --- a/ext/spice/src/cspice/refchg.c +++ /dev/null @@ -1,679 +0,0 @@ -/* refchg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure REFCHG (Reference frame Change) */ -/* Subroutine */ int refchg_(integer *frame1, integer *frame2, doublereal *et, - doublereal *rotate) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer node; - logical done; - integer cent, this__; - extern /* Subroutine */ int zznofcon_(doublereal *, integer *, integer *, - integer *, integer *, char *, ftnlen); - integer i__, j, frame[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ident_(doublereal *); - integer class__; - logical found; - integer relto; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *), zzrxr_( - doublereal *, integer *, doublereal *); - extern logical failed_(void); - integer cmnode; - extern integer isrchi_(integer *, integer *, integer *); - integer clssid; - extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, - integer *, logical *); - logical gotone; - char errmsg[1840]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), rotget_(integer *, doublereal *, doublereal *, integer *, - logical *); - extern logical return_(void); - doublereal tmprot[9] /* was [3][3] */; - integer inc, get; - doublereal rot[126] /* was [3][3][14] */; - integer put; - doublereal rot2[18] /* was [3][3][2] */; - -/* $ Abstract */ - -/* Return the transformation matrix from one */ -/* frame to another. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRAME1 I the frame id-code for some reference frame */ -/* FRAME2 I the frame id-code for some reference frame */ -/* ET I an epoch in TDB seconds past J2000. */ -/* ROTATE O a rotation matrix */ - -/* $ Detailed_Input */ - -/* FRAME1 is the frame id-code in which some positions */ -/* are known. */ - -/* FRAME2 is the frame id-code for some frame in which you */ -/* would like to represent positions. */ - -/* ET is the epoch at which to compute the transformation */ -/* matrix. This epoch should be in TDB seconds past */ -/* the ephemeris epoch of J2000. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3 x 3 rotaion matrix that can be used to */ -/* transform positions relative to the frame */ -/* correspsonding to frame FRAME2 to positions relative */ -/* to the frame FRAME2. More explicitely, if POS is */ -/* the position of some object relative to the */ -/* reference frame of FRAME1 then POS2 is the position */ -/* of the same object relative to FRAME2 where POS2 is */ -/* computed via the subroutine call below */ - -/* CALL MXV ( ROTATE, POS, POS2 ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the reference frames is unrecognized, the error */ -/* SPICE(UNKNOWNFRAME) will be signalled. */ - -/* 2) If the auxillary information needed to compute a non-inertial */ -/* frame is not available an error will be diagnosed and signalled */ -/* by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to compute the rotation matrix */ -/* between two reference frames. */ - - -/* $ Examples */ - -/* Suppose that you have a position POS1 at epoch ET */ -/* relative to FRAME1 and wish to determine its representation */ -/* POS2 relative to FRAME2. The following subroutine calls */ -/* would suffice to make this rotation. */ - -/* CALL REFCHG ( FRAME1, FRAME2, ET, ROTATE ) */ -/* CALL MXV ( ROTATE, POS1, POS2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ - -/* Upgraded long error message associated with frame */ -/* connection failure. */ - -/* - SPICELIB Version 1.2.0, 26-APR-2004 (NJB) */ - -/* Another typo was corrected in the long error message, and */ -/* in a comment. */ - -/* - SPICELIB Version 1.1.0, 23-MAY-2000 (WLT) */ - -/* A typo was corrected in the long error message. */ - -/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Rotate positions from one frame to another */ - -/* -& */ - -/* SPICE functions */ - - -/* Local Paramters */ - - -/* The root of all reference frames is J2000 (Frame ID = 1). */ - - -/* Local Variables */ - - -/* ROT contains the rotations from FRAME1 to FRAME2 */ -/* ROT(1...3,1...3,I) has the rotation from FRAME(I) */ -/* to FRAME(I+1). We make extra room in ROT because we */ -/* plan to add rotations beyond the obvious chain from */ -/* FRAME1 to a root node. */ - - -/* ROT2 is used to store intermediate rotation from */ -/* FRAME2 to some node in the chain from FRAME1 to PCK or */ -/* INERTL frames. */ - - -/* FRAME contains the frames we transform from in going from */ -/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ - - -/* NODE counts the number of rotations needed to go */ -/* from FRAME1 to FRAME2. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("REFCHG", (ftnlen)6); - -/* Do the obvious thing first. If FRAME1 and FRAME2 are the */ -/* same then we simply return the identity matrix. */ - - if (*frame1 == *frame2) { - ident_(rotate); - chkout_("REFCHG", (ftnlen)6); - return 0; - } - -/* Now perform the obvious check to make sure that both */ -/* frames are recognized. */ - - frinfo_(frame1, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame1, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("REFCHG", (ftnlen)6); - return 0; - } - frinfo_(frame2, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame2, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("REFCHG", (ftnlen)6); - return 0; - } - node = 1; - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, - "refchg_", (ftnlen)287)] = *frame1; - found = TRUE_; - -/* Follow the chain of rotations until we run into */ -/* one that rotates to J2000 (frame id = 1) or we hit FRAME2. */ - - while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "refchg_", (ftnlen)293)] != 1 && node < 10 && frame[(i__2 = - node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "refc" - "hg_", (ftnlen)293)] != *frame2 && found) { - -/* Find out what rotation is available for this */ -/* frame. */ - - rotget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "refchg_", (ftnlen)301)], et, &rot[(i__2 = ( - node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "refchg_", (ftnlen)301)], &frame[(i__3 = node) < - 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "refchg_", ( - ftnlen)301)], &found); - if (found) { - -/* We found a rotation matrix. ROT(1,1,NODE) */ -/* now contains the rotation from FRAME(NODE) */ -/* to FRAME(NODE+1). We need to look up the information */ -/* for the next NODE. */ - - ++node; - } - } - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "refchg_", (ftnlen)317)] == 1 || frame[(i__2 = node - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "refchg_", (ftnlen) - 317)] == *frame2 || ! found; - while(! done) { - -/* The only way to get to this point is to have run out of */ -/* room in the array of reference frame rotation */ -/* buffers. We will now build the rotation from */ -/* the previous NODE to whatever the next node in the */ -/* chain is. We'll do this until we get to one of the */ -/* root classes or we run into FRAME2. */ - - rotget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "refchg_", (ftnlen)331)], et, &rot[(i__2 = ( - node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "refchg_", (ftnlen)331)], &relto, &found); - if (found) { - -/* Recall that ROT(1,1,NODE-1) contains the rotation */ -/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ -/* FRAME(NODE) with the frame indicated by RELTO. This means */ -/* that ROT(1,1,NODE-1) should be replaced with the */ -/* rotation from FRAME(NODE) to RELTO. */ - - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "refchg_", (ftnlen)342)] = relto; - zzrxr_(&rot[(i__1 = ((node - 1) * 3 + 1) * 3 - 12) < 126 && 0 <= - i__1 ? i__1 : s_rnge("rot", i__1, "refchg_", (ftnlen)343)] - , &c__2, tmprot); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot[(i__1 = i__ + (j + (node - 1) * 3) * 3 - 13) < 126 && - 0 <= i__1 ? i__1 : s_rnge("rot", i__1, "refchg_", - (ftnlen)347)] = tmprot[(i__2 = i__ + j * 3 - 4) < - 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2, - "refchg_", (ftnlen)347)]; - } - } - } - -/* We are done if the class of the last frame is J2000 */ -/* or if the last frame is FRAME2 or if we simply couldn't get */ -/* another rotation. */ - - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "refchg_", (ftnlen)357)] == 1 || frame[(i__2 = - node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "refchg_", (ftnlen)357)] == *frame2 || ! found; - } - -/* Right now we have the following situation. We have in hand */ -/* a collection of rotations between frames. (Assuming */ -/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ -/* no rotations computed yet. */ - - -/* ROT(1...3, 1...3, 1 ) rotates FRAME1 to FRAME(2) */ -/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ -/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ -/* . */ -/* . */ -/* . */ -/* ROT(1...3, 1...3, NODE-1 ) rotates FRAME(NODE-1) */ -/* to FRAME(NODE) */ - - -/* One of the following situations is true. */ - -/* 1) FRAME(NODE) is the root of all frames, J2000. */ - -/* 2) FRAME(NODE) is the same as FRAME2 */ - -/* 3) There is no rotation from FRAME(NODE) to another */ -/* more fundamental frame. The chain of rotations */ -/* from FRAME1 stops at FRAME(NODE). This means that the */ -/* "frame atlas" is incomplete because we can't get to the */ -/* root frame. */ - -/* We now have to do essentially the same thing for FRAME2. */ - - if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "refchg_", (ftnlen)395)] == *frame2) { - -/* We can handle this one immediately with the private routine */ -/* ZZRXR which multiplies a series of matrices. */ - - i__1 = node - 1; - zzrxr_(rot, &i__1, rotate); - chkout_("REFCHG", (ftnlen)6); - return 0; - } - -/* We didn't luck out above. So we follow the chain of */ -/* rotation for FRAME2. Note that at the moment the */ -/* chain of rotations from FRAME2 to other frames */ -/* does not share a node in the chain for FRAME1. */ -/* ( GOTONE = .FALSE. ) . */ - - this__ = *frame2; - gotone = FALSE_; - -/* First see if there is any chain to follow. */ - - done = this__ == 1; - -/* Set up the matrices ROT2(,,1) and ROT(,,2) and set up */ -/* PUT and GET pointers so that we know where to GET the partial */ -/* rotation from and where to PUT partial results. */ - - if (! done) { - put = 1; - get = 1; - inc = 1; - } - -/* Follow the chain of rotations until we run into */ -/* one that rotates to the root frame or we land in the */ -/* chain of nodes for FRAME1. */ - -/* Note that this time we will simply keep track of the full */ -/* rotation from FRAME2 to the last node. */ - - while(! done) { - -/* Find out what rotation is available for this */ -/* frame. */ - - if (this__ == *frame2) { - -/* This is the first pass, just put the rotation */ -/* directly into ROT2(,,PUT). */ - - rotget_(&this__, et, &rot2[(i__1 = (put * 3 + 1) * 3 - 12) < 18 && - 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "refchg_", ( - ftnlen)452)], &relto, &found); - if (found) { - this__ = relto; - get = put; - put += inc; - inc = -inc; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } else { - -/* Fetch the rotation into a temporary spot TMPROT */ - - rotget_(&this__, et, tmprot, &relto, &found); - if (found) { - -/* Next multiply TMPROT on the right by the last partial */ -/* product (in ROT2(,,GET) ). We do this in line. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot2[(i__1 = i__ + (j + put * 3) * 3 - 13) < 18 && 0 - <= i__1 ? i__1 : s_rnge("rot2", i__1, "refch" - "g_", (ftnlen)478)] = tmprot[(i__2 = i__ - 1) < - 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", - i__2, "refchg_", (ftnlen)478)] * rot2[(i__3 = - (j + get * 3) * 3 - 12) < 18 && 0 <= i__3 ? - i__3 : s_rnge("rot2", i__3, "refchg_", ( - ftnlen)478)] + tmprot[(i__4 = i__ + 2) < 9 && - 0 <= i__4 ? i__4 : s_rnge("tmprot", i__4, - "refchg_", (ftnlen)478)] * rot2[(i__5 = (j + - get * 3) * 3 - 11) < 18 && 0 <= i__5 ? i__5 : - s_rnge("rot2", i__5, "refchg_", (ftnlen)478)] - + tmprot[(i__6 = i__ + 5) < 9 && 0 <= i__6 ? - i__6 : s_rnge("tmprot", i__6, "refchg_", ( - ftnlen)478)] * rot2[(i__7 = (j + get * 3) * 3 - - 10) < 18 && 0 <= i__7 ? i__7 : s_rnge("rot2" - , i__7, "refchg_", (ftnlen)478)]; - } - } - -/* Adjust GET and PUT so that GET points to the slots */ -/* where we just stored the result of our multiply and */ -/* so that PUT points to the next available storage */ -/* locations. */ - - get = put; - put += inc; - inc = -inc; - this__ = relto; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } - -/* See if we have a common node and determine whether or not */ -/* we are done with this loop. */ - - done = this__ == 1 || gotone || ! found; - } - -/* There are two possible scenarios. Either the chain of */ -/* rotations from FRAME2 ran into a node in the chain for */ -/* FRAME1 or it didn't. (The common node might very well be */ -/* the root node.) If we didn't run into a common one, then */ -/* the two chains don't intersect and there is no way to */ -/* get from FRAME1 to FRAME2. */ - - if (! gotone) { - zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)525)], frame2, - &this__, errmsg, (ftnlen)1840); - if (failed_()) { - -/* We were unable to create the error message. This */ -/* unfortunate situation could arise if a frame kernel */ -/* is corrupted. */ - - chkout_("REFCHG", (ftnlen)6); - return 0; - } - -/* The normal case: signal an error with a descriptive long */ -/* error message. */ - - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); - chkout_("REFCHG", (ftnlen)6); - return 0; - } - -/* Recall that we have the following. */ - -/* ROT(1...3, 1...3, 1 ) rotates FRAME(1) to FRAME(2) */ -/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ -/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ - -/* ROT(1...3, 1...3, CMNODE-1) rotates FRAME(CMNODE-1) */ -/* to FRAME(CMNODE) */ - -/* and that ROT2(1,1,GET) rotates from FRAME2 to CMNODE. */ -/* Hence the inverse of ROT2(1,1,GET) rotates from CMNODE */ -/* to FRAME2. */ - -/* If we compute the inverse of ROT2 and store it in */ -/* the next available slot of ROT (.i.e. ROT(1,1,CMNODE) */ -/* we can simply apply our custom routine that multiplies a */ -/* sequence of rotation matrices together to get the */ -/* result from FRAME1 to FRAME2. */ - - xpose_(&rot2[(i__1 = (get * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : - s_rnge("rot2", i__1, "refchg_", (ftnlen)568)], &rot[(i__2 = ( - cmnode * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "refchg_", (ftnlen)568)]); - zzrxr_(rot, &cmnode, rotate); - chkout_("REFCHG", (ftnlen)6); - return 0; -} /* refchg_ */ - diff --git a/ext/spice/src/cspice/remlac.c b/ext/spice/src/cspice/remlac.c deleted file mode 100644 index f641c71f5d..0000000000 --- a/ext/spice/src/cspice/remlac.c +++ /dev/null @@ -1,255 +0,0 @@ -/* remlac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMLAC ( Remove elements from a character array ) */ -/* Subroutine */ int remlac_(integer *ne, integer *loc, char *array, integer * - na, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Remove one or more elements from a character array at the */ -/* indicated location. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NE I Number of elements to be removed. */ -/* LOC I Location of the first removed element. */ -/* ARRAY I/O Input/output array. */ -/* NA I/O Number of elements in the input/output array. */ - -/* $ Detailed_Input */ - -/* NE is the number of elements to be removed. */ - -/* LOC is the location in the array at which the first */ -/* element is to be removed. */ - -/* ARRAY on input, is the original array. */ - -/* NA on input, is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the original array with elements */ -/* LOC through LOC+NE-1 removed. Succeeding elements */ -/* are moved forward to fill the vacated spaces. */ - -/* NA on output, is the number of elements in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The elements in positions LOC through LOC+NE-1 are overwritten */ -/* as the elements beginning at LOC+NE are moved back. */ - -/* $ Examples */ - -/* Let */ - -/* NA = 7 ARRAY(1) = 'The' */ -/* ARRAY(2) = 'boy' */ -/* ARRAY(3) = 'in' */ -/* ARRAY(4) = 'the' */ -/* ARRAY(5) = 'park' */ -/* ARRAY(6) = 'fell' */ -/* ARRAY(7) = 'down' */ - -/* Then the call */ - -/* CALL REMLAC ( 3, 3, ARRAY, NA ) */ - -/* yields the following result: */ - -/* NA = 4 ARRAY(1) = 'The' */ -/* ARRAY(2) = 'boy' */ -/* ARRAY(3) = 'fell' */ -/* ARRAY(4) = 'down' */ - - -/* The following calls would signal errors: */ - -/* CALL REMLAC ( 3, 1, ARRAY, -1 ) */ -/* CALL REMLAC ( 3, -1, ARRAY, 7 ) */ -/* CALL REMLAC ( 3, 6, ARRAY, 7 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If LOC is not in the interval [1, NA], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 2) If the number of elements to be removed is greater than the */ -/* number of elements that can be removed, the error */ -/* SPICE(NONEXISTELEMENTS) is signalled. */ - -/* 3) If NE is less than one, the array is not modified. */ - -/* 4) If NA is less than one, any location is invalid, and the */ -/* error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove elements from a character array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 1-JAN-1989 (HAN) */ - -/* Code was added to handle the following exceptinoal */ -/* inputs. */ - -/* If the dimension of the array is less than one, any */ -/* value of LOC is invalid. The old verison did not check */ -/* the dimension of the array, and as a result, its output */ -/* was unpredictable. */ - -/* If the location at which the elements are to be removed is */ -/* not in the interval [1, NA], an error is signalled. */ -/* Locations not within that interval refer to non-existent */ -/* array elements. The old routine did not signal an error. */ -/* It just returned the original array. */ - -/* If the number of elements to be removed is greater than the */ -/* number of elements can be removed, an error is signalled. */ -/* In the old version, only those elements that could be */ -/* removed were removed, and no error was signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REMLAC", (ftnlen)6); - } - -/* If LOC does not point to an actual element, signal an error and */ -/* check out. If the dimension of the array is less than one, any */ -/* value of LOC is invalid, and an error is signalled. */ - - if (*loc < 1 || *loc > *na) { - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("REMLAC", (ftnlen)6); - return 0; - -/* Don't try to remove non-existent elements. */ - - } else if (*ne > *na - *loc + 1) { - setmsg_("Trying to remove non-existent elements.", (ftnlen)39); - sigerr_("SPICE(NONEXISTELEMENTS)", (ftnlen)23); - chkout_("REMLAC", (ftnlen)6); - return 0; - -/* If there are elements to be removed, remove them. Otherwise, */ -/* do not modify the array. */ - - } else if (*ne > 0) { - -/* Move the elements forward. */ - - i__1 = *na - *ne; - for (i__ = *loc; i__ <= i__1; ++i__) { - s_copy(array + (i__ - 1) * array_len, array + (i__ + *ne - 1) * - array_len, array_len, array_len); - } - -/* Update the number of elements in the array. */ - - *na -= *ne; - } - chkout_("REMLAC", (ftnlen)6); - return 0; -} /* remlac_ */ - diff --git a/ext/spice/src/cspice/remlad.c b/ext/spice/src/cspice/remlad.c deleted file mode 100644 index 8b253cd8a5..0000000000 --- a/ext/spice/src/cspice/remlad.c +++ /dev/null @@ -1,251 +0,0 @@ -/* remlad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMLAD (Remove elements from a double precision array) */ -/* Subroutine */ int remlad_(integer *ne, integer *loc, doublereal *array, - integer *na) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Remove one or more elements from a double precision array at the */ -/* indicated location. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NE I Number of elements to be removed. */ -/* LOC I Location of the first removed element. */ -/* ARRAY I/O Input/output array. */ -/* NA I/O Number of elements in the input/output array. */ - -/* $ Detailed_Input */ - -/* NE is the number of elements to be removed. */ - -/* LOC is the location in the array at which the first */ -/* element is to be removed. */ - -/* ARRAY on input, is the original array. */ - -/* NA on input, is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the original array with elements */ -/* LOC through LOC+NE-1 removed. Succeeding elements */ -/* are moved forward to fill the vacated spaces. */ - -/* NA on output, is the number of elements in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The elements in positions LOC through LOC+NE-1 are overwritten */ -/* as the elements beginning at LOC+NE are moved back. */ - -/* $ Examples */ - -/* Let */ - -/* NA = 7 ARRAY(1) = 1.0D0 */ -/* ARRAY(2) = 2.0D0 */ -/* ARRAY(3) = 3.0D0 */ -/* ARRAY(4) = 4.0D0 */ -/* ARRAY(5) = 5.0D0 */ -/* ARRAY(6) = 6.0D0 */ -/* ARRAY(7) = 7.0D0 */ - -/* Then the call */ - -/* CALL REMLAD ( 3, 3, ARRAY, NA ) */ - -/* yields the following result: */ - -/* NA = 4 ARRAY(1) = 1.0D0 */ -/* ARRAY(2) = 2.0D0 */ -/* ARRAY(3) = 6.0D0 */ -/* ARRAY(4) = 7.0D0 */ - - -/* The following calls would signal errors: */ - -/* CALL REMLAD ( 3, 1, ARRAY, -1 ) */ -/* CALL REMLAD ( 3, -1, ARRAY, 7 ) */ -/* CALL REMLAD ( 3, 6, ARRAY, 7 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If LOC is not in the interval [1, NA], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 2) If the number of elements to be removed is greater than the */ -/* number of elements that can be removed, the error */ -/* SPICE(NONEXISTELEMENTS) is signalled. */ - -/* 3) If NE is less than one, the array is not modified. */ - -/* 4) If NA is less than one, any location is invalid, and the */ -/* error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove elements from a d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 1-JAN-1989 (HAN) */ - -/* Code was added to handle the following exceptinoal */ -/* inputs. */ - -/* If the dimension of the array is less than one, any */ -/* value of LOC is invalid. The old verison did not check */ -/* the dimension of the array, and as a result, its output */ -/* was unpredictable. */ - -/* If the location at which the elements are to be removed is */ -/* not in the interval [1, NA], an error is signalled. */ -/* Locations not within that interval refer to non-existent */ -/* array elements. The old routine did not signal an error. */ -/* It just returned the original array. */ - -/* If the number of elements to be removed is greater than the */ -/* number of elements can be removed, an error is signalled. */ -/* In the old version, only those elements that could be */ -/* removed were removed, and no error was signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REMLAD", (ftnlen)6); - } - -/* If LOC does not point to an actual element, signal an error and */ -/* check out. If the dimension of the array is less than one, any */ -/* value of LOC is invalid, and an error is signalled. */ - - if (*loc < 1 || *loc > *na) { - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("REMLAD", (ftnlen)6); - return 0; - -/* Don't try to remove non-existent elements. */ - - } else if (*ne > *na - *loc + 1) { - setmsg_("Trying to remove non-existent elements.", (ftnlen)39); - sigerr_("SPICE(NONEXISTELEMENTS)", (ftnlen)23); - chkout_("REMLAD", (ftnlen)6); - return 0; - -/* If there are elements to be removed, remove them. Otherwise, */ -/* do not modify the array. */ - - } else if (*ne > 0) { - -/* Move the elements forward. */ - - i__1 = *na - *ne; - for (i__ = *loc; i__ <= i__1; ++i__) { - array[i__ - 1] = array[i__ + *ne - 1]; - } - -/* Update the number of elements in the array. */ - - *na -= *ne; - } - chkout_("REMLAD", (ftnlen)6); - return 0; -} /* remlad_ */ - diff --git a/ext/spice/src/cspice/remlai.c b/ext/spice/src/cspice/remlai.c deleted file mode 100644 index 047cec8c1d..0000000000 --- a/ext/spice/src/cspice/remlai.c +++ /dev/null @@ -1,251 +0,0 @@ -/* remlai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMLAI ( Remove elements from an integer array ) */ -/* Subroutine */ int remlai_(integer *ne, integer *loc, integer *array, - integer *na) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Remove one or more elements from an integer array at the */ -/* indicated location. */ - -/* $ 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 */ - -/* ARRAY, ASSIGNMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NE I Number of elements to be removed. */ -/* LOC I Location of the first removed element. */ -/* ARRAY I/O Input/output array. */ -/* NA I/O Number of elements in the input/output array. */ - -/* $ Detailed_Input */ - -/* NE is the number of elements to be removed. */ - -/* LOC is the location in the array at which the first */ -/* element is to be removed. */ - -/* ARRAY on input, is the original array. */ - -/* NA on input, is the number of elements in ARRAY. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the original array with elements */ -/* LOC through LOC+NE-1 removed. Succeeding elements */ -/* are moved forward to fill the vacated spaces. */ - -/* NA on output, is the number of elements in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The elements in positions LOC through LOC+NE-1 are overwritten */ -/* as the elements beginning at LOC+NE are moved back. */ - -/* $ Examples */ - -/* Let */ - -/* NA = 7 ARRAY(1) = 1 */ -/* ARRAY(2) = 2 */ -/* ARRAY(3) = 3 */ -/* ARRAY(4) = 4 */ -/* ARRAY(5) = 5 */ -/* ARRAY(6) = 6 */ -/* ARRAY(7) = 7 */ - -/* Then the call */ - -/* CALL REMLAI ( 3, 3, ARRAY, NA ) */ - -/* yields the following result: */ - -/* NA = 4 ARRAY(1) = 1 */ -/* ARRAY(2) = 2 */ -/* ARRAY(3) = 6 */ -/* ARRAY(4) = 7 */ - - -/* The following calls would signal errors: */ - -/* CALL REMLAI ( 3, 1, ARRAY, -1 ) */ -/* CALL REMLAI ( 3, -1, ARRAY, 7 ) */ -/* CALL REMLAI ( 3, 6, ARRAY, 7 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If LOC is not in the interval [1, NA], the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 2) If the number of elements to be removed is greater than the */ -/* number of elements that can be removed, the error */ -/* SPICE(NONEXISTELEMENTS) is signalled. */ - -/* 3) If NE is less than one, the array is not modified. */ - -/* 4) If NA is less than one, any location is invalid, and the */ -/* error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove elements from an integer array */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 1-JAN-1989 (HAN) */ - -/* Code was added to handle the following exceptinoal */ -/* inputs. */ - -/* If the dimension of the array is less than one, any */ -/* value of LOC is invalid. The old verison did not check */ -/* the dimension of the array, and as a result, its output */ -/* was unpredictable. */ - -/* If the location at which the elements are to be removed is */ -/* not in the interval [1, NA], an error is signalled. */ -/* Locations not within that interval refer to non-existent */ -/* array elements. The old routine did not signal an error. */ -/* It just returned the original array. */ - -/* If the number of elements to be removed is greater than the */ -/* number of elements can be removed, an error is signalled. */ -/* In the old version, only those elements that could be */ -/* removed were removed, and no error was signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REMLAI", (ftnlen)6); - } - -/* If LOC does not point to an actual element, signal an error and */ -/* check out. If the dimension of the array is less than one, any */ -/* value of LOC is invalid, and an error is signalled. */ - - if (*loc < 1 || *loc > *na) { - setmsg_("Location was *.", (ftnlen)15); - errint_("*", loc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("REMLAI", (ftnlen)6); - return 0; - -/* Don't try to remove non-existent elements. */ - - } else if (*ne > *na - *loc + 1) { - setmsg_("Trying to remove non-existent elements.", (ftnlen)39); - sigerr_("SPICE(NONEXISTELEMENTS)", (ftnlen)23); - chkout_("REMLAI", (ftnlen)6); - return 0; - -/* If there are elements to be removed, remove them. Otherwise, */ -/* do not modify the array. */ - - } else if (*ne > 0) { - -/* Move the elements forward. */ - - i__1 = *na - *ne; - for (i__ = *loc; i__ <= i__1; ++i__) { - array[i__ - 1] = array[i__ + *ne - 1]; - } - -/* Update the number of elements in the array. */ - - *na -= *ne; - } - chkout_("REMLAI", (ftnlen)6); - return 0; -} /* remlai_ */ - diff --git a/ext/spice/src/cspice/removc.c b/ext/spice/src/cspice/removc.c deleted file mode 100644 index f73f59dbce..0000000000 --- a/ext/spice/src/cspice/removc.c +++ /dev/null @@ -1,210 +0,0 @@ -/* removc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMOVC ( Remove an item from a character set ) */ -/* Subroutine */ int removc_(char *item, char *a, ftnlen item_len, ftnlen - a_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer card, i__; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical in; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* Remove an item from a character set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be removed. */ -/* A I/O Removal set. */ -/* ERROR O Error flag. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which is to be removed from the */ -/* specified set. ITEM may or may not already */ -/* be an element of the set. */ - - -/* A is a set. */ - - -/* On input, A may or may not contain the input item */ -/* as an element. */ - -/* $ Detailed_Output */ - -/* A on output contains the difference of the input set */ -/* and the input item. If the item is not an element of */ -/* the set, the set is not changed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 'PLUTO' is removed from */ -/* the character set PLANETS and inserted into the character set */ -/* ASTEROIDS. */ - -/* CALL REMOVC ( 'PLUTO', PLANETS ) */ -/* CALL INSRTC ( 'PLUTO', ASTEROIDS, ERROR ) */ - -/* If 'PLUTO' is not an element of PLANETS, then the contents of */ -/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */ -/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */ - -/* Because inserting an element into a set can increase the */ -/* cardinality of the set, the insertion routines return an */ -/* error flag. The flag is blank if the set is large enough to */ -/* hold the new element. Otherwise, a message (constructed by */ -/* the cell routine EXCESS) is returned. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove an item from a character set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling: */ - - if (return_()) { - return 0; - } else { - chkin_("REMOVC", (ftnlen)6); - } - -/* What is the cardinality of the set? */ - - card = cardc_(a, a_len); - -/* Determine the location (if any) of the item within the set. */ - - loc = bsrchc_(item, &card, a + a_len * 6, item_len, a_len); - -/* Is the item in the set? If so, it needs to be removed. */ - - in = loc > 0; - if (in) { - -/* Move succeeding elements forward to take up the slack left */ -/* by the departing element. And update the cardinality for */ -/* future reference. */ - - i__1 = card - 1; - for (i__ = loc; i__ <= i__1; ++i__) { - s_copy(a + (i__ + 5) * a_len, a + (i__ + 6) * a_len, a_len, a_len) - ; - } - i__1 = card - 1; - scardc_(&i__1, a, a_len); - } - chkout_("REMOVC", (ftnlen)6); - return 0; -} /* removc_ */ - diff --git a/ext/spice/src/cspice/removc_c.c b/ext/spice/src/cspice/removc_c.c deleted file mode 100644 index 3089443989..0000000000 --- a/ext/spice/src/cspice/removc_c.c +++ /dev/null @@ -1,257 +0,0 @@ -/* - --Procedure removc_c ( Remove an item from a character set ) - --Abstract - - Remove an item from a character set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "f2cMang.h" - - - void removc_c ( ConstSpiceChar * item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be removed. - set I/O Removal set. - --Detailed_Input - - item is an item which is to be removed from the specified - set. item may or may not already be an element of the - set. Trailing blanks in item are not significant. - - - set is a CSPICE set. set must be declared as a character - SpiceCell. - - On input, set may or may not contain the input item - as an element. - --Detailed_Output - - set on output contains the difference of the input set and - the input item. If the item is not an element of the - set, the set is not changed. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - character, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - - 3) If the input string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following example, the element "PLUTO" is removed from - the character set planets and inserted into the character set - asteroids. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( asteroids, MAXSIZ, NAMLEN ); - . - . - . - removc_c ( "PLUTO", &planets ); - insrtc_c ( "PLUTO", &asteroids ); - - - If "PLUTO" is not an element of planets, then the contents of - planets are not changed. Similarly, if "PLUTO" is already an - element of asteroids, the contents of asteroids remain unchanged. - --Restrictions - - 1) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input set 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) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (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, 07-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - remove an item from a character set - --& -*/ -{ - /* - f2c library utility prototypes - */ - extern integer s_cmp (char *a, char *b, ftnlen la, ftnlen lb ); - - /* - Local macros - */ - #define ARRAY( i ) ( (SpiceChar *)(set->data) + (i)*(set->length) ) - - - /* - local variables - */ - SpiceBoolean inSet; - - SpiceChar * cdata; - - SpiceInt i; - SpiceInt loc; - - - /* - Use discovery check-in. - */ - - - /* - Check the input string pointer to make sure it's not null. - */ - CHKPTR ( CHK_DISCOVER, "removc_c", item ); - - - /* - Make sure we're working with a character cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "removc_c", SPICE_CHR, set ); - - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK ( CHK_DISCOVER, "removc_c", set ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - - /* - Is the item in the set? If not, we're done now. - */ - cdata = (SpiceChar *) (set->data); - - loc = lstlec_c ( item, set->card, set->length, cdata ); - - inSet = ( loc > -1 ) - - && ( s_cmp( (SpiceChar *)item, - ARRAY(loc), - strlen(item), - strlen(ARRAY(loc)) ) == 0 ); - - if ( !inSet ) - { - return; - } - - - /* - Shift the set's contents to overwrite the slot at index loc. - */ - for ( i = loc; i < (set->card) - 1; i++ ) - { - SPICE_CELL_SET_C( ARRAY(i+1), i, set ); - } - - - /* - Decrement the set's cardinality. - */ - (set->card) --; - -} - diff --git a/ext/spice/src/cspice/removd.c b/ext/spice/src/cspice/removd.c deleted file mode 100644 index a4a93cb2f0..0000000000 --- a/ext/spice/src/cspice/removd.c +++ /dev/null @@ -1,205 +0,0 @@ -/* removd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMOVD ( Remove an item from a double precision set ) */ -/* Subroutine */ int removd_(doublereal *item, doublereal *a) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical in; - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern integer bsrchd_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* Remove an item from a double precision set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be removed. */ -/* A I/O Removal set. */ -/* ERROR O Error flag. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which is to be removed from the */ -/* specified set. ITEM may or may not already */ -/* be an element of the set. */ - - -/* A is a set. */ - - -/* On input, A may or may not contain the input item */ -/* as an element. */ - -/* $ Detailed_Output */ - -/* A on output contains the difference of the input set */ -/* and the input item. If the item is not an element of */ -/* the set, the set is not changed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 'PLUTO' is removed from */ -/* the character set PLANETS and inserted into the character set */ -/* ASTEROIDS. */ - -/* CALL REMOVC ( 'PLUTO', PLANETS ) */ -/* CALL INSRTC ( 'PLUTO', ASTEROIDS, ERROR ) */ - -/* If 'PLUTO' is not an element of PLANETS, then the contents of */ -/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */ -/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */ - -/* Because inserting an element into a set can increase the */ -/* cardinality of the set, the insertion routines return an */ -/* error flag. The flag is blank if the set is large enough to */ -/* hold the new element. Otherwise, a message (constructed by */ -/* the cell routine EXCESS) is returned. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove an item from a d.p. set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling: */ - - if (return_()) { - return 0; - } else { - chkin_("REMOVD", (ftnlen)6); - } - -/* What is the cardinality of the set? */ - - card = cardd_(a); - -/* Determine the location (if any) of the item within the set. */ - - loc = bsrchd_(item, &card, &a[6]); - -/* Is the item in the set? If so, it needs to be removed. */ - - in = loc > 0; - if (in) { - -/* Move succeeding elements forward to take up the slack left */ -/* by the departing element. And update the cardinality for */ -/* future reference. */ - - i__1 = card - 1; - for (i__ = loc; i__ <= i__1; ++i__) { - a[i__ + 5] = a[i__ + 6]; - } - i__1 = card - 1; - scardd_(&i__1, a); - } - chkout_("REMOVD", (ftnlen)6); - return 0; -} /* removd_ */ - diff --git a/ext/spice/src/cspice/removd_c.c b/ext/spice/src/cspice/removd_c.c deleted file mode 100644 index 3a98ffb43f..0000000000 --- a/ext/spice/src/cspice/removd_c.c +++ /dev/null @@ -1,244 +0,0 @@ -/* - --Procedure removd_c ( Remove an item from a double precision set ) - --Abstract - - Remove an item from a double precision set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void removd_c ( SpiceDouble item, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be removed. - set I/O Removal set. - --Detailed_Input - - item is an item which is to be removed from the specified - set. item may or may not already be an element of the - set. - - - set is a CSPICE set. set must be declared as a double - precision SpiceCell. - - On input, set may or may not contain the input item - as an element. - --Detailed_Output - - set on output contains the difference of the input set and - the input item. If the item is not an element of the - set, the set is not changed. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - double precision, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following code fragment, a list of camera exposure - durations are taken from the array expList and inserted into the - set expDur. - - We then update the set by removing the element 30.0 and - inserting 20.0 in its place. - - - #include "SpiceUsr.h" - . - . - . - /. - The number of list items is NLIST. - ./ - SpiceDouble expList[NLIST] = - { - 0.5, 2.0, 0.5, 30.0, 0.01, 30.0 - }; - - /. - Declare the set with maximum number of elements MAXSIZ. - ./ - SPICEDOUBLE_CELL ( expDur, MAXSIZ ); - . - . - . - for ( i = 0; i < NLIST; i++ ) - { - insrtd_c ( expList[i], &expDur ); - } - - /. - At this point expDur contains the set - - { 0.01, 0.5, 2.0, 30.0 } - - ./ - . - . - . - /. - Update the exposure set by replacing 30.0 with 20.0. - ./ - removd_c ( 30.0, &expDur ); - insrtd_c ( 20.0, &expDur ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - remove an item from a d.p. set - --& -*/ -{ - /* - local variables - */ - SpiceBoolean inSet; - - SpiceDouble * ddata; - - SpiceInt i; - SpiceInt loc; - - - /* - Use discovery check-in. - - Make sure we're working with a double precision cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "removd_c", SPICE_DP, set ); - - ddata = (SpiceDouble *) (set->data); - - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK ( CHK_DISCOVER, "removd_c", set ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - - /* - Is the item in the set? If not, we're done now. - */ - loc = lstled_c ( item, set->card, ddata ); - - inSet = ( loc > -1 ) && ( item == ddata[loc] ); - - if ( !inSet ) - { - return; - } - - - /* - Shift the set's contents to overwrite the slot at index loc. - */ - for ( i = loc; i < (set->card) - 1; i++ ) - { - ddata[i] = ddata[i+1]; - } - - - /* - Decrement the set's cardinality. - */ - (set->card) --; - - /* - Sync the set. - */ - zzsynccl_c ( C2F, set ); -} - diff --git a/ext/spice/src/cspice/removi.c b/ext/spice/src/cspice/removi.c deleted file mode 100644 index 48f9072890..0000000000 --- a/ext/spice/src/cspice/removi.c +++ /dev/null @@ -1,205 +0,0 @@ -/* removi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMOVI ( Remove an item from an integer set ) */ -/* Subroutine */ int removi_(integer *item, integer *a) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, i__; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical in; - extern /* Subroutine */ int scardi_(integer *, integer *); - extern integer bsrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* Remove an item from an integer set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item to be removed. */ -/* A I/O Removal set. */ -/* ERROR O Error flag. */ - -/* $ Detailed_Input */ - -/* ITEM is an item which is to be removed from the */ -/* specified set. ITEM may or may not already */ -/* be an element of the set. */ - - -/* A is a set. */ - - -/* On input, A may or may not contain the input item */ -/* as an element. */ - -/* $ Detailed_Output */ - -/* A on output contains the difference of the input set */ -/* and the input item. If the item is not an element of */ -/* the set, the set is not changed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example, the element 'PLUTO' is removed from */ -/* the character set PLANETS and inserted into the character set */ -/* ASTEROIDS. */ - -/* CALL REMOVC ( 'PLUTO', PLANETS ) */ -/* CALL INSRTC ( 'PLUTO', ASTEROIDS, ERROR ) */ - -/* If 'PLUTO' is not an element of PLANETS, then the contents of */ -/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */ -/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */ - -/* Because inserting an element into a set can increase the */ -/* cardinality of the set, the insertion routines return an */ -/* error flag. The flag is blank if the set is large enough to */ -/* hold the new element. Otherwise, a message (constructed by */ -/* the cell routine EXCESS) is returned. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove an item from an integer set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling: */ - - if (return_()) { - return 0; - } else { - chkin_("REMOVI", (ftnlen)6); - } - -/* What is the cardinality of the set? */ - - card = cardi_(a); - -/* Determine the location (if any) of the item within the set. */ - - loc = bsrchi_(item, &card, &a[6]); - -/* Is the item in the set? If so, it needs to be removed. */ - - in = loc > 0; - if (in) { - -/* Move succeeding elements forward to take up the slack left */ -/* by the departing element. And update the cardinality for */ -/* future reference. */ - - i__1 = card - 1; - for (i__ = loc; i__ <= i__1; ++i__) { - a[i__ + 5] = a[i__ + 6]; - } - i__1 = card - 1; - scardi_(&i__1, a); - } - chkout_("REMOVI", (ftnlen)6); - return 0; -} /* removi_ */ - diff --git a/ext/spice/src/cspice/removi_c.c b/ext/spice/src/cspice/removi_c.c deleted file mode 100644 index 29f2638409..0000000000 --- a/ext/spice/src/cspice/removi_c.c +++ /dev/null @@ -1,222 +0,0 @@ -/* - --Procedure removi_c ( Remove an item from an integer set ) - --Abstract - - Remove an item from an integer set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void removi_c ( SpiceInt item, - SpiceCell * set ) - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Item to be removed. - set I/O Removal set. - --Detailed_Input - - item is an item which is to be removed from the specified - set. item may or may not already be an element of the - set. - - - set is a CSPICE set. set must be declared as an integer - SpiceCell. - - On input, set may or may not contain the input item - as an element. - --Detailed_Output - - set on output contains the difference of the input set and - the input item. If the item is not an element of the - set, the set is not changed. - --Parameters - - None. - --Exceptions - - 1) If the input set argument is a SpiceCell of type other than - integer, the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the input set argument does not qualify as a CSPICE set, - the error SPICE(NOTASET) will be signaled. CSPICE sets have - their data elements sorted in increasing order and contain - no duplicate data elements. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following example, the NAIF ID code of Pluto is removed from - the integer set planets and inserted into the integer set - asteroids. - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( planets, MAXSIZ ); - SPICEINT_CELL ( asteroids, MAXSIZ ); - . - . - . - removi_c ( 999, &planets ); - insrti_c ( 999, &asteroids ); - - - If 999 is not an element of planets, then the contents of planets - are not changed. Similarly, if 999 is already an element of - asteroids, the contents of asteroids remain unchanged. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 07-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - remove an item from an integer set - --& -*/ -{ - /* - local variables - */ - SpiceBoolean inSet; - - SpiceInt i; - SpiceInt * idata; - SpiceInt loc; - - - /* - Use discovery check-in. - */ - - /* - Make sure we're working with an integer cell. - */ - CELLTYPECHK ( CHK_DISCOVER, "removi_c", SPICE_INT, set ); - - idata = (SpiceInt *) (set->data); - - - /* - Make sure the cell is really a set. - */ - CELLISSETCHK ( CHK_DISCOVER, "removi_c", set ); - - - /* - Initialize the set if necessary. - */ - CELLINIT ( set ); - - - /* - Is the item in the set? If not, we're done now. - */ - loc = lstlei_c ( item, set->card, idata ); - - inSet = ( loc > -1 ) && ( item == idata[loc] ); - - if ( !inSet ) - { - return; - } - - - /* - Shift the set's contents to overwrite the slot at index loc. - */ - for ( i = loc; i < (set->card) - 1; i++ ) - { - idata[i] = idata[i+1]; - } - - - /* - Decrement the set's cardinality. - */ - (set->card) --; - - - /* - Sync the set. - */ - zzsynccl_c ( C2F, set ); -} - diff --git a/ext/spice/src/cspice/remsub.c b/ext/spice/src/cspice/remsub.c deleted file mode 100644 index 3dc202a15f..0000000000 --- a/ext/spice/src/cspice/remsub.c +++ /dev/null @@ -1,241 +0,0 @@ -/* remsub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REMSUB ( Remove a substring ) */ -/* Subroutine */ int remsub_(char *in, integer *left, integer *right, char * - out, ftnlen in_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j, l, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer inlen; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer outlen; - extern logical return_(void); - -/* $ Abstract */ - -/* Remove the substring (LEFT:RIGHT) from a character 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 */ - -/* ASSIGNMENT, CHARACTER, STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* LEFT I Position of first character to be removed. */ -/* RIGHT I Position of last character to be removed. */ -/* OUT O Output string. */ - -/* $ Detailed_Input */ - -/* IN is an input character string, from which a substring */ -/* is to be removed. */ - -/* LEFT, */ -/* RIGHT are the ends of the substring to be removed. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is equivalent to the */ -/* string that would be created by the concatenation */ - -/* OUT = IN(1 : LEFT-1) // IN(RIGHT+1 : ) */ - -/* If the string is too long to fit into OUT, it is */ -/* truncated on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Move the characters, beginning with RIGHT, one at a time to the */ -/* positions immediately following LEFT. This has the same effect */ -/* as the concatenation */ - -/* OUT = IN(1 : LEFT-1) // IN(RIGHT+1 : ) */ - -/* Because this operation is not standard for strings of length (*), */ -/* this routine does not use concatenation. */ - -/* $ Examples */ - -/* The following examples illustrate the use of REMSUB. */ - -/* IN LEFT RIGHT OUT */ -/* ----------------- ---- ----- ------------------------ */ -/* 'ABCDEFGHIJ' 3 5 'ABFGHIJ' */ -/* 'The best rabbit' 5 8 'The rabbit' */ -/* 'The other woman' 1 4 'other woman' */ -/* 'An Apple a day' 2 2 'A apple a day' */ -/* 'An Apple a day' 5 2 An error is signalled. */ -/* 'An Apple a day' 0 0 An error is signalled. */ -/* 'An Apple a day' -3 3 An error is signalled. */ - -/* Whenever an error has been signalled, the contents of OUT are */ -/* unpredictable. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* If LEFT > RIGHT, RIGHT < 1, LEFT < 1, RIGHT > LEN(IN), or */ -/* LEFT > LEN(IN), the error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove a substring */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 5-JAN-1989 (HAN) */ - -/* Error handling was added to detect invalid character */ -/* positions. If LEFT > RIGHT, RIGHT < 1, LEFT < 1, */ -/* RIGHT > LEN(IN), or LEFT > LEN(IN), an error is signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REMSUB", (ftnlen)6); - } - -/* If a character position is out of range, signal an error. */ - - if (*left > *right || *right < 1 || *left < 1 || *right > i_len(in, - in_len) || *left > i_len(in, in_len)) { - setmsg_("Left location was *. Right location was *.", (ftnlen)42); - errint_("*", left, (ftnlen)1); - errint_("*", right, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("REMSUB", (ftnlen)6); - return 0; - } else { - l = *left; - r__ = *right; - } - -/* How much of the input string will we use? And how big is the */ -/* output string? */ - - inlen = lastnb_(in, in_len); - outlen = i_len(out, out_len); - -/* Copy the first part of the input string. (One character at a */ -/* time, in case this is being done in place.) */ - -/* Computing MIN */ - i__2 = l - 1; - i__1 = min(i__2,outlen); - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[i__ - 1] = *(unsigned char *)&in[i__ - 1]; - } - -/* Now move the rest of the string over. */ - - i__ = l; - j = r__ + 1; - while(i__ <= outlen && j <= inlen) { - *(unsigned char *)&out[i__ - 1] = *(unsigned char *)&in[j - 1]; - ++i__; - ++j; - } - -/* Pad with blanks, if necessary. */ - - if (i__ <= outlen) { - s_copy(out + (i__ - 1), " ", out_len - (i__ - 1), (ftnlen)1); - } - chkout_("REMSUB", (ftnlen)6); - return 0; -} /* remsub_ */ - diff --git a/ext/spice/src/cspice/reordc.c b/ext/spice/src/cspice/reordc.c deleted file mode 100644 index 5d5f3719ac..0000000000 --- a/ext/spice/src/cspice/reordc.c +++ /dev/null @@ -1,248 +0,0 @@ -/* reordc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REORDC ( Reorder a character array ) */ -/* Subroutine */ int reordc_(integer *iorder, integer *ndim, char *array, - ftnlen array_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer hold; - char temp[1]; - integer c__, index, start; - -/* $ Abstract */ - -/* Re-order the elements of an array of character strings */ -/* according to a given order vector. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IORDER I Order vector to be used to re-order ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I/O Array to be re-ordered. */ - -/* $ Detailed_Input */ - -/* IORDER is the order vector to be used to re-order the input */ -/* array. The first element of IORDER is the index of */ -/* the first item of the re-ordered array, and so on. */ - -/* Note that the order imposed by REORDC is not the */ -/* same order that would be imposed by a sorting */ -/* routine. In general, the order vector will have */ -/* been created (by one of the ORDER routines) for */ -/* a related array, as illustrated in the example below. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY on input, is an array containing some number of */ -/* elements in unspecified order. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the same array, with the elements */ -/* in re-ordered as specified by IORDER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* REORDC uses a cyclical algorithm to re-order the elements of */ -/* the array in place. After re-ordering, element IORDER(1) of */ -/* the input array is the first element of the output array, */ -/* element IORDER(2) is the input array is the second element of */ -/* the output array, and so on. */ - -/* The order vector used by REORDC is typically created for */ -/* a related array by one of the ORDER routines, as shown in */ -/* the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, integer ID codes, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by name. */ -/* C */ -/* CALL ORDERC ( NAMES, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDI ( IORDER, N, CODES ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* reorder a character array */ - -/* -& */ - -/* Local variables */ - - -/* If the array doesn't have at least two elements, don't bother. */ - - if (*ndim < 2) { - return 0; - } - -/* What follows is pretty much the same as for the other REORD */ -/* routines. The character routine is somewhat special in that */ -/* the use of a temporary variable would cause strings longer */ -/* than the variable to be truncated. Rather than just declare */ -/* a giant character string, the entire algorithm will be repeated */ -/* for each character in each string. That is, the first characters */ -/* will be ordered, then the second characters, and so on. This */ -/* looks messy as hell, but the same number of operations are */ -/* involved (more or less). */ - - i__1 = i_len(array, array_len); - for (c__ = 1; c__ <= i__1; ++c__) { - -/* START is the position in the order vector that begins the */ -/* current cycle. When all the switches have been made, START */ -/* will point to the end of the order vector. */ - - start = 1; - while(start < *ndim) { - -/* Begin with the element of input vector specified by */ -/* IORDER(START). Move it to the correct position in the */ -/* array, after saving the element it replaces to TEMP. */ -/* HOLD indicates the position of the array element to */ -/* be moved to its new position. After the element has */ -/* been moved, HOLD indicates the position of an available */ -/* space within the array. */ - - index = start; - *(unsigned char *)temp = *(unsigned char *)&array[(index - 1) * - array_len + (c__ - 1)]; - hold = iorder[index - 1]; - -/* As each slot in the output array is filled in, the sign */ -/* of the corresponding element in the order vector is changed */ -/* from positive to negative. This way, we know which elements */ -/* have already been ordered when looking for the beginning of */ -/* the next cycle. */ - -/* Keep going until HOLD points to the first array element */ -/* moved during the current cycle. This ends the cycle. */ - - while(hold != start) { - *(unsigned char *)&array[(index - 1) * array_len + (c__ - 1)] - = *(unsigned char *)&array[(hold - 1) * array_len + ( - c__ - 1)]; - index = hold; - hold = iorder[hold - 1]; - iorder[index - 1] = -iorder[index - 1]; - } - -/* The last element in the cycle is restored from TEMP. */ - - *(unsigned char *)&array[(index - 1) * array_len + (c__ - 1)] = *( - unsigned char *)temp; - iorder[hold - 1] = -iorder[hold - 1]; - -/* Begin the next cycle at the next element in the order */ -/* vector with a positive sign. (That is, the next one */ -/* that hasn't been moved.) */ - - while(iorder[start - 1] < 0 && start < *ndim) { - ++start; - } - } - -/* Restore the original signs of the elements of the order */ -/* vector, for the next go around. */ - - i__2 = *ndim; - for (index = 1; index <= i__2; ++index) { - iorder[index - 1] = (i__3 = iorder[index - 1], abs(i__3)); - } - } - return 0; -} /* reordc_ */ - diff --git a/ext/spice/src/cspice/reordc_c.c b/ext/spice/src/cspice/reordc_c.c deleted file mode 100644 index 5644b08ab9..0000000000 --- a/ext/spice/src/cspice/reordc_c.c +++ /dev/null @@ -1,270 +0,0 @@ -/* - --Procedure reordc_c ( Reorder a character array ) - --Abstract - - Re-order the elements of an array of character strings - according to a given order vector. - --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 - - ARRAY, SORT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef reordc_c - - - void reordc_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt lenvals, - void * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - iorder I Order vector to be used to re-order array. - ndim I Dimension of array. - lenvals I String length. - array I/O Array to be re-ordered. - --Detailed_Input - - iorder is the order vector to be used to re-order the input - array. The first element of iorder is the index of - the first item of the re-ordered array, and so on. - - Note that the order imposed by reordc_c is not the - same order that would be imposed by a sorting - routine. In general, the order vector will have - been created (by one of the order routines) for - a related array, as illustrated in the example below. - - The elements of iorder range from zero to ndim-1. - - ndim is the number of elements in the input 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 - - [ndim][lenvals] - - array on input, is an array containing some number of - elements in unspecified order. - --Detailed_Output - - array on output, is the same array, with the elements - in re-ordered as specified by iorder. - --Parameters - - None. - --Exceptions - - 1) If the input string array pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the input array string's length is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 3) If memory cannot be allocated to create a Fortran-style version of - the input order vector, the error SPICE(MALLOCFAILED) is signaled. - - 4) If ndim < 2, this routine executes a no-op. This case is - not an error. - --Files - - None. - --Particulars - - reordc_c uses a cyclical algorithm to re-order the elements of - the array in place. After re-ordering, element iorder[0] of - the input array is the first element of the output array, - element iorder[1] of the input array is the second element of - the output array, and so on. - - The order vector used by reordc_c is typically created for - a related array by one of the order*_c routines, as shown in - the example below. - --Examples - - In the following example, the order*_c and reord*_c routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by name. - ./ - - orderc_c ( namlen, names, n, iorder ); - - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) (IMU) - --Index_Entries - - reorder a character array - --& -*/ - -{ /* Begin reordc_c */ - - /* - Local variables - */ - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - SpiceInt i; - SpiceInt * ordvec ; - SpiceInt vSize; - - - - /* - If the input array doesn't have at least two elements, return - immediately. - */ - if ( ndim < 2 ) - { - return; - } - - /* - Use discovery check-in. - - - Make sure the input pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_DISCOVER, "reordc_c", array, lenvals ); - - - /* - Create a Fortran-style string array. - */ - C2F_MapStrArr ( "reordc_c", - ndim, lenvals, array, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - return; - } - - - /* - Get a local copy of the input order vector; map the vector's contents - to the range 1:ndim. - */ - vSize = ndim * sizeof(SpiceInt); - - ordvec = (SpiceInt *) malloc( vSize ); - - if ( ordvec == 0 ) - { - free ( fCvalsArr ); - - chkin_c ( "reordc_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", vSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "reordc_c" ); - return; - } - - for ( i = 0; i < ndim; i++ ) - { - ordvec[i] = iorder[i] + 1; - } - - - /* - Call the f2c'd routine. - */ - reordc_ ( ( integer * ) ordvec, - ( integer * ) &ndim, - ( char * ) fCvalsArr, - ( ftnlen ) fCvalsLen ); - - /* - Free the dynamically allocated arrays. - */ - free ( fCvalsArr ); - free ( ordvec ); - - -} /* End reordc_c */ diff --git a/ext/spice/src/cspice/reordd.c b/ext/spice/src/cspice/reordd.c deleted file mode 100644 index d427e4dc04..0000000000 --- a/ext/spice/src/cspice/reordd.c +++ /dev/null @@ -1,227 +0,0 @@ -/* reordd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REORDD ( Reorder a double precision array ) */ -/* Subroutine */ int reordd_(integer *iorder, integer *ndim, doublereal * - array) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer hold; - doublereal temp; - integer index, start; - -/* $ Abstract */ - -/* Re-order the elements of a double precision array according to */ -/* a given order vector. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IORDER I Order vector to be used to re-order ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I/O Array to be re-ordered. */ - -/* $ Detailed_Input */ - -/* IORDER is the order vector to be used to re-order the input */ -/* array. The first element of IORDER is the index of */ -/* the first item of the re-ordered array, and so on. */ - -/* Note that the order imposed by REORDD is not the */ -/* same order that would be imposed by a sorting */ -/* routine. In general, the order vector will have */ -/* been created (by one of the ORDER routines) for */ -/* a related array, as illustrated in the example below. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY on input, is an array containing some number of */ -/* elements in unspecified order. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the same array, with the elements */ -/* in re-ordered as specified by IORDER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* REORDD uses a cyclical algorithm to re-order the elements of */ -/* the array in place. After re-ordering, element IORDER(1) of */ -/* the input array is the first element of the output array, */ -/* element IORDER(2) is the input array is the second element of */ -/* the output array, and so on. */ - -/* The order vector used by REORDD is typically created for */ -/* a related array by one of the ORDER routines, as shown in */ -/* the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, integer ID codes, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by name. */ -/* C */ -/* CALL ORDERC ( NAMES, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDI ( IORDER, N, CODES ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* reorder a d.p. array */ - -/* -& */ - -/* Local variables */ - - -/* If the array doesn't have at least two elements, don't bother. */ - - if (*ndim < 2) { - return 0; - } - -/* START is the position in the order vector that begins the */ -/* current cycle. When all the switches have been made, START */ -/* will point to the end of the order vector. */ - - start = 1; - while(start < *ndim) { - -/* Begin with the element of input vector specified by */ -/* IORDER(START). Move it to the correct position in the */ -/* array, after saving the element it replaces to TEMP. */ -/* HOLD indicates the position of the array element to */ -/* be moved to its new position. After the element has */ -/* been moved, HOLD indicates the position of an available */ -/* space within the array. */ - - index = start; - temp = array[index - 1]; - hold = iorder[index - 1]; - -/* As each slot in the output array is filled in, the sign */ -/* of the corresponding element in the order vector is changed */ -/* from positive to negative. This way, we know which elements */ -/* have already been ordered when looking for the beginning of */ -/* the next cycle. */ - -/* Keep going until HOLD points to the first array element */ -/* moved during the current cycle. This ends the cycle. */ - - while(hold != start) { - array[index - 1] = array[hold - 1]; - index = hold; - hold = iorder[hold - 1]; - iorder[index - 1] = -iorder[index - 1]; - } - -/* The last element in the cycle is restored from TEMP. */ - - array[index - 1] = temp; - iorder[hold - 1] = -iorder[hold - 1]; - -/* Begin the next cycle at the next element in the order */ -/* vector with a positive sign. (That is, the next one */ -/* that hasn't been moved.) */ - - while(iorder[start - 1] < 0 && start < *ndim) { - ++start; - } - } - -/* Restore the original signs of the elements of the order vector, */ -/* in case the vector is to be used again with another array. */ - - i__1 = *ndim; - for (index = 1; index <= i__1; ++index) { - iorder[index - 1] = (i__2 = iorder[index - 1], abs(i__2)); - } - return 0; -} /* reordd_ */ - diff --git a/ext/spice/src/cspice/reordd_c.c b/ext/spice/src/cspice/reordd_c.c deleted file mode 100644 index 37005637ce..0000000000 --- a/ext/spice/src/cspice/reordd_c.c +++ /dev/null @@ -1,223 +0,0 @@ -/* - --Procedure reordd_c ( Reorder a double precision array ) - --Abstract - - Re-order the elements of a double precision array according to - a given order vector. - --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 - - ARRAY, SORT - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef reordd_c - - void reordd_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceDouble * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - iorder I Order vector to be used to re-order array. - ndim I Dimension of array. - array I/O Array to be re-ordered. - --Detailed_Input - - iorder is the order vector to be used to re-order the input - array. The first element of iorder is the index of - the first item of the re-ordered array, and so on. - - Note that the order imposed by reordd_c is not the - same order that would be imposed by a sorting - routine. In general, the order vector will have - been created (by one of the order routines) for - a related array, as illustrated in the example below. - - ndim is the number of elements in the input array. - - array on input, is an array containing some number of - elements in unspecified order. - --Detailed_Output - - array on output, is the same array, with the elements - in re-ordered as specified by iorder. - --Parameters - - None. - --Exceptions - - 1) If memory cannot be allocated to create a Fortran-style version of - the input order vector, the error SPICE(MALLOCFAILED) is signaled. - - 2) If ndim < 2, this routine executes a no-op. This case is - not an error. - --Files - - None. - --Particulars - - reordd_c uses a cyclical algorithm to re-order the elements of - the array in place. After re-ordering, element iorder[0] of - the input array is the first element of the output array, - element iorder[1] is the input array is the second element of - the output array, and so on. - - The order vector used by reordd_c is typically created for - a related array by one of the order routines, as shown in - the example below. - --Examples - - In the following example, the ORDER and REORD routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by name. - ./ - - orderc_c ( namlen, names, n, iorder ); - - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 11-JAN-2003 (EDW) - - Trivial. Corrected 'Detailed_output' section - header to 'Detailed_Output'. - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) - --Index_Entries - - reorder a d.p. array - --& -*/ - -{ /* Begin reordd_c */ - - - /* - Local variables - */ - SpiceInt i ; - SpiceInt * ordvec; - SpiceInt vSize; - - - - - /* - If the input array doesn't have at least two elements, return - immediately. - */ - if ( ndim < 2 ) - { - return; - } - - - /* - Get a local copy of the input order vector; map the vector's contents - to the range 1:ndim. - */ - vSize = ndim * sizeof(SpiceInt); - - ordvec = (SpiceInt *) malloc( vSize ); - - if ( ordvec == 0 ) - { - chkin_c ( "reordd_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", vSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "reordd_c" ); - return; - } - - for ( i = 0; i < ndim; i++ ) - { - ordvec[i] = iorder[i] + 1; - } - - - reordd_ ( ( integer * ) ordvec, - ( integer * ) &ndim, - ( doublereal * ) array ); - - - free ( ordvec ); - -} /* End reordd_c */ diff --git a/ext/spice/src/cspice/reordi.c b/ext/spice/src/cspice/reordi.c deleted file mode 100644 index 7dbb97fa1f..0000000000 --- a/ext/spice/src/cspice/reordi.c +++ /dev/null @@ -1,224 +0,0 @@ -/* reordi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REORDI ( Reorder an integer array ) */ -/* Subroutine */ int reordi_(integer *iorder, integer *ndim, integer *array) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer hold, temp, index, start; - -/* $ Abstract */ - -/* Re-order the elements of an integer array according to */ -/* a given order vector. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IORDER I Order vector to be used to re-order ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I/O Array to be re-ordered. */ - -/* $ Detailed_Input */ - -/* IORDER is the order vector to be used to re-order the input */ -/* array. The first element of IORDER is the index of */ -/* the first item of the re-ordered array, and so on. */ - -/* Note that the order imposed by REORDI is not the */ -/* same order that would be imposed by a sorting */ -/* routine. In general, the order vector will have */ -/* been created (by one of the ORDER routines) for */ -/* a related array, as illustrated in the example below. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY on input, is an array containing some number of */ -/* elements in unspecified order. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the same array, with the elements */ -/* in re-ordered as specified by IORDER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* REORDI uses a cyclical algorithm to re-order the elements of */ -/* the array in place. After re-ordering, element IORDER(1) of */ -/* the input array is the first element of the output array, */ -/* element IORDER(2) is the input array is the second element of */ -/* the output array, and so on. */ - -/* The order vector used by REORDI is typically created for */ -/* a related array by one of the ORDER routines, as shown in */ -/* the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, integer ID codes, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by name. */ -/* C */ -/* CALL ORDERC ( NAMES, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDI ( IORDER, N, CODES ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* reorder an integer array */ - -/* -& */ - -/* Local variables */ - - -/* If the array doesn't have at least two elements, don't bother. */ - - if (*ndim < 2) { - return 0; - } - -/* START is the position in the order vector that begins the */ -/* current cycle. When all the switches have been made, START */ -/* will point to the end of the order vector. */ - - start = 1; - while(start < *ndim) { - -/* Begin with the element of input vector specified by */ -/* IORDER(START). Move it to the correct position in the */ -/* array, after saving the element it replaces to TEMP. */ -/* HOLD indicates the position of the array element to */ -/* be moved to its new position. After the element has */ -/* been moved, HOLD indicates the position of an available */ -/* space within the array. */ - - index = start; - temp = array[index - 1]; - hold = iorder[index - 1]; - -/* As each slot in the output array is filled in, the sign */ -/* of the corresponding element in the order vector is changed */ -/* from positive to negative. This way, we know which elements */ -/* have already been ordered when looking for the beginning of */ -/* the next cycle. */ - -/* Keep going until HOLD points to the first array element */ -/* moved during the current cycle. This ends the cycle. */ - - while(hold != start) { - array[index - 1] = array[hold - 1]; - index = hold; - hold = iorder[hold - 1]; - iorder[index - 1] = -iorder[index - 1]; - } - -/* The last element in the cycle is restored from TEMP. */ - - array[index - 1] = temp; - iorder[hold - 1] = -iorder[hold - 1]; - -/* Begin the next cycle at the next element in the order */ -/* vector with a positive sign. (That is, the next one */ -/* that hasn't been moved.) */ - - while(iorder[start - 1] < 0 && start < *ndim) { - ++start; - } - } - -/* Restore the original signs of the elements of the order vector, */ -/* in case the vector is to be used again with another array. */ - - i__1 = *ndim; - for (index = 1; index <= i__1; ++index) { - iorder[index - 1] = (i__2 = iorder[index - 1], abs(i__2)); - } - return 0; -} /* reordi_ */ - diff --git a/ext/spice/src/cspice/reordi_c.c b/ext/spice/src/cspice/reordi_c.c deleted file mode 100644 index ef7d249eae..0000000000 --- a/ext/spice/src/cspice/reordi_c.c +++ /dev/null @@ -1,221 +0,0 @@ -/* - --Procedure reordi_c ( Reorder an integer array ) - --Abstract - - Re-order the elements of an integer array according to - a given order vector. - --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 - - ARRAY, SORT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef reordi_c - - - void reordi_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - iorder I Order vector to be used to re-order array. - ndim I Dimension of array. - array I/O Array to be re-ordered. - --Detailed_Input - - iorder is the order vector to be used to re-order the input - array. The first element of iorder is the index of - the first item of the re-ordered array, and so on. - - Note that the order imposed by reordi_c is not the - same order that would be imposed by a sorting - routine. In general, the order vector will have - been created (by one of the order routines) for - a related array, as illustrated in the example below. - - The elements of iorder range from zero to ndim-1. - - ndim is the number of elements in the input array. - - array on input, is an array containing some number of - elements in unspecified order. - --Detailed_Output - - array on output, is the same array, with the elements - in re-ordered as specified by iorder. - --Parameters - - None. - --Exceptions - - 1) If memory cannot be allocated to create a Fortran-style version of - the input order vector, the error SPICE(MALLOCFAILED) is signaled. - - 2) If ndim < 2, this routine executes a no-op. This case is - not an error. - --Files - - None. - --Particulars - - reordi_c uses a cyclical algorithm to re-order the elements of - the array in place. After re-ordering, element iorder[0] of - the input array is the first element of the output array, - element iorder[1] is the input array is the second element of - the output array, and so on. - - The order vector used by reordi_c is typically created for - a related array by one of the order*_c routines, as shown in - the example below. - --Examples - - In the following example, the order*_c and reord*_c routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by name. - ./ - - orderc_c ( namlen, names, n, iorder ); - - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) (IMU) - --Index_Entries - - reorder an integer array - --& -*/ - -{ /* Begin reordi_c */ - - /* - Local variables - */ - SpiceInt i ; - SpiceInt * ordvec; - SpiceInt vSize; - - - - /* - If the input array doesn't have at least two elements, return - immediately. - */ - if ( ndim < 2 ) - { - return; - } - - - /* - Get a local copy of the input order vector; map the vector's contents - to the range 1:ndim. - */ - vSize = ndim * sizeof(SpiceInt); - - ordvec = (SpiceInt *) malloc( vSize ); - - if ( ordvec == 0 ) - { - chkin_c ( "reordi_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", vSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "reordi_c" ); - return; - } - - for ( i = 0; i < ndim; i++ ) - { - ordvec[i] = iorder[i] + 1; - } - - - reordi_ ( ( integer * ) ordvec, - ( integer * ) &ndim, - ( integer * ) array ); - - - free ( ordvec ); - -} /* End reordi_c */ - diff --git a/ext/spice/src/cspice/reordl.c b/ext/spice/src/cspice/reordl.c deleted file mode 100644 index e7865e2220..0000000000 --- a/ext/spice/src/cspice/reordl.c +++ /dev/null @@ -1,221 +0,0 @@ -/* reordl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REORDL ( Reorder a logical array ) */ -/* Subroutine */ int reordl_(integer *iorder, integer *ndim, logical *array) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer hold; - logical temp; - integer index, start; - -/* $ Abstract */ - -/* Re-order the elements of a logical array according to */ -/* a given order vector. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IORDER I Order vector to be used to re-order ARRAY. */ -/* NDIM I Dimension of ARRAY. */ -/* ARRAY I/O Array to be re-ordered. */ - -/* $ Detailed_Input */ - -/* IORDER is the order vector to be used to re-order the input */ -/* array. The first element of IORDER is the index of */ -/* the first item of the re-ordered array, and so on. */ - -/* Note that the order imposed by REORDL is not the */ -/* same order that would be imposed by a sorting */ -/* routine. In general, the order vector will have */ -/* been created (by one of the ORDER routines) for */ -/* a related array, as illustrated in the example below. */ - -/* NDIM is the number of elements in the input array. */ - -/* ARRAY on input, is an array containing some number of */ -/* logicals in unspecified order. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, is the same array, with the logicals */ -/* re-ordered as specified by IORDER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* REORDL uses a cyclical algorithm to re-order the elements of */ -/* the array in place. After re-ordering, element IORDER(1) of */ -/* the input array is the first element of the output array, */ -/* element IORDER(2) is the input array is the second element of */ -/* the output array, and so on. */ - -/* The order vector used by REORDL is typically created for */ -/* a related array by one of the ORDER routines, as shown in */ -/* the example below. */ - -/* $ Examples */ - -/* In the following example, the ORDER and REORD routines are */ -/* used to sort four related arrays (containing the names, */ -/* masses, asteroid flag, and visual magnitudes for a group */ -/* of satellites). This is representative of the typical use of */ -/* these routines. */ - -/* C */ -/* C Sort the object arrays by name. */ -/* C */ -/* CALL ORDERC ( NAMES, N, IORDER ) */ - -/* CALL REORDC ( IORDER, N, NAMES ) */ -/* CALL REORDD ( IORDER, N, MASSES ) */ -/* CALL REORDL ( IORDER, N, AFLAGS ) */ -/* CALL REORDR ( IORDER, N, VMAGS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 6-MAR-1996 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* reorder a logical array */ - -/* -& */ - -/* Local variables */ - - -/* If the array doesn't have at least two elements, don't bother. */ - - if (*ndim < 2) { - return 0; - } - -/* START is the position in the order vector that begins the */ -/* current cycle. When all the switches have been made, START */ -/* will point to the end of the order vector. */ - - start = 1; - while(start < *ndim) { - -/* Begin with the element of input vector specified by */ -/* IORDER(START). Move it to the correct position in the */ -/* array, after saving the element it replaces to TEMP. */ -/* HOLD indicates the position of the array element to */ -/* be moved to its new position. After the element has */ -/* been moved, HOLD indicates the position of an available */ -/* space within the array. */ - - index = start; - temp = array[index - 1]; - hold = iorder[index - 1]; - -/* As each slot in the output array is filled in, the sign */ -/* of the corresponding element in the order vector is changed */ -/* from positive to negative. This way, we know which elements */ -/* have already been ordered when looking for the beginning of */ -/* the next cycle. */ - -/* Keep going until HOLD points to the first array element */ -/* moved during the current cycle. This ends the cycle. */ - - while(hold != start) { - array[index - 1] = array[hold - 1]; - index = hold; - hold = iorder[hold - 1]; - iorder[index - 1] = -iorder[index - 1]; - } - -/* The last element in the cycle is restored from TEMP. */ - - array[index - 1] = temp; - iorder[hold - 1] = -iorder[hold - 1]; - -/* Begin the next cycle at the next element in the order */ -/* vector with a positive sign. (That is, the next one */ -/* that hasn't been moved.) */ - - while(iorder[start - 1] < 0 && start < *ndim) { - ++start; - } - } - -/* Restore the original signs of the elements of the order vector, */ -/* in case the vector is to be used again with another array. */ - - i__1 = *ndim; - for (index = 1; index <= i__1; ++index) { - iorder[index - 1] = (i__2 = iorder[index - 1], abs(i__2)); - } - return 0; -} /* reordl_ */ - diff --git a/ext/spice/src/cspice/reordl_c.c b/ext/spice/src/cspice/reordl_c.c deleted file mode 100644 index 4ac56bcf6e..0000000000 --- a/ext/spice/src/cspice/reordl_c.c +++ /dev/null @@ -1,265 +0,0 @@ -/* - --Procedure reordl_c ( Reorder a logical array ) - --Abstract - - Re-order the elements of a logical (Boolean) array according to - a given order vector. - --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 - - ARRAY, SORT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef reordl_c - - - void reordl_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceBoolean * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - iorder I Order vector to be used to re-order array. - ndim I Dimension of array. - array I/O Array to be re-ordered. - --Detailed_Input - - iorder is the order vector to be used to re-order the input - array. The first element of iorder is the index of - the first item of the re-ordered array, and so on. - - Note that the order imposed by reordl_c is not the - same order that would be imposed by a sorting - routine. In general, the order vector will have - been created (by one of the order routines) for - a related array, as illustrated in the example below. - - The elements of iorder range from zero to ndim-1. - - ndim is the number of elements in the input array. - - array on input, is an array containing some number of - elements in unspecified order. - --Detailed_Output - - array on output, is the same array, with the elements - in re-ordered as specified by iorder. - --Parameters - - None. - --Exceptions - - 1) If memory cannot be allocated to create a Fortran-style version of - the input order vector, the error SPICE(MALLOCFAILED) is signaled. - - 2) If memory cannot be allocated to create a type "logical" copy of the - the input SpiceBoolean array, the error SPICE(MALLOCFAILED) is - signaled. - - 3) If ndim < 2, this routine executes a no-op. This case is - not an error. - --Files - - None. - --Particulars - - reordl_c uses a cyclical algorithm to re-order the elements of - the array in place. After re-ordering, element iorder[0] of - the input array is the first element of the output array, - element iorder[1] is the input array is the second element of - the output array, and so on. - - The order vector used by reordl_c is typically created for - a related array by one of the order*_c routines, as shown in - the example below. - --Examples - - In the following example, the order*_c and reord*_c routines are - used to sort four related arrays (containing the names, - masses, integer ID codes, and visual magnitudes for a group - of satellites). This is representative of the typical use of - these routines. - - #include "SpiceUsr.h" - . - . - . - /. - Sort the object arrays by name. - ./ - - orderc_c ( namlen, names, n, iorder ); -ordvec - reordc_c ( iorder, n, namlen, names ); - reordd_c ( iorder, n, masses ); - reordi_c ( iorder, n, codes ); - reordd_c ( iorder, n, vmags ); - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 10-JUL-2002 (NJB) (WLT) (IMU) - --Index_Entries - - reorder a logical array - --& -*/ - -{ /* Begin reordl_c */ - - /* - Local variables - */ - logical * lArray; - - SpiceInt aSize; - SpiceInt i ; - SpiceInt * ordvec; - SpiceInt vSize; - - - - /* - If the input array doesn't have at least two elements, return - immediately. - */ - if ( ndim < 2 ) - { - return; - } - - - /* - Get a local copy of the input order vector; map the vector's contents - to the range 1:ndim. - */ - vSize = ndim * sizeof(SpiceInt); - - ordvec = (SpiceInt *) malloc( vSize ); - - if ( ordvec == 0 ) - { - chkin_c ( "reordl_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", vSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "reordl_c" ); - return; - } - - for ( i = 0; i < ndim; i++ ) - { - ordvec[i] = iorder[i] + 1; - } - - /* - Get a local copy of the input logical array; use type logical - to ensure compatibility with code translated by f2c. - */ - aSize = ndim * sizeof(logical); - - lArray = (logical *) malloc( aSize ); - - if ( lArray == 0 ) - { - free ( ordvec ); - - chkin_c ( "reordl_c" ); - setmsg_c ( "Failure on malloc call to create array " - "for Fortran-style order vector. Tried " - "to allocate # bytes." ); - errint_c ( "#", aSize ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "reordl_c" ); - return; - } - - for ( i = 0; i < ndim; i++ ) - { - lArray[i] = array[i]; - } - - - reordl_ ( ( integer * ) ordvec, - ( integer * ) &ndim, - ( logical * ) lArray ); - - /* - Write the re-ordered result to the output array. - */ - for ( i = 0; i < ndim; i++ ) - { - array[i] = (SpiceBoolean) lArray[i]; - } - - - free ( ordvec ); - free ( lArray ); - - -} /* End reordl_c */ - diff --git a/ext/spice/src/cspice/replch.c b/ext/spice/src/cspice/replch.c deleted file mode 100644 index 7257ef1a68..0000000000 --- a/ext/spice/src/cspice/replch.c +++ /dev/null @@ -1,172 +0,0 @@ -/* replch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPLCH ( Replace characters in a string ) */ -/* Subroutine */ int replch_(char *instr, char *old, char *new__, char * - outstr, ftnlen instr_len, ftnlen old_len, ftnlen new_len, ftnlen - outstr_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Replace all occurrences of a single character with a second */ -/* 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 */ - -/* None. */ - -/* $ Keywords */ - -/* ASCII, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INSTR I Input string. */ -/* OLD I Character to be replaced. */ -/* NEW I Replacement character. */ -/* OUTSTR O Output string. */ - -/* $ Detailed_Input */ - -/* INSTR is the input character string, possibly containing */ -/* one or more occurrences of the character OLD. */ - -/* OLD is the character to be replaced wherever it occurs in */ -/* the input string. */ - -/* NEW is the character which is to replace each occurrence */ -/* of the character OLD in the output string. */ - -/* $ Detailed_Output */ - -/* OUTSTR is the output string. This is the input string */ -/* with every occurrence of the character OLD replaced */ -/* by the character NEW. */ - -/* OUTSTR may overwrite INSTR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Copy the contents of the input string to the output string */ -/* a character at a time, replacing each occurrence of OLD with NEW. */ -/* If the output string is not long enough to contain the input */ -/* string, it is truncated on the right. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Examples */ - -/* Let */ -/* INSTR = 'Woodsy is the Anti-Pollution Owl.' */ -/* OLD = 'O' */ -/* NEW = 'E' */ -/* then */ -/* OUTSTR = 'Woodsy is the Anti-Pollution Ewl.' */ - -/* Note the case-sensitivity of REPLCH. The lowercase o's are */ -/* not affected. */ - -/* REPLCH may similarly be used to replace control characters */ -/* (such as tab stops, line feeds, and nulls) with regular ASCII */ -/* characters (such as blanks). */ - -/* $ Restrictions */ - -/* REPLCH is sensitive to case, as shown in the examples above. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace characters in a string */ - -/* -& */ - -/* Local Variables */ - - -/* Move the input string to the output string. If it's too long, */ -/* this will truncate it. */ - - s_copy(outstr, instr, outstr_len, instr_len); - -/* Check each character of OUTSTR and replace as necessary. */ - - i__1 = i_len(outstr, outstr_len); - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&outstr[i__ - 1] == *(unsigned char *)old) { - *(unsigned char *)&outstr[i__ - 1] = *(unsigned char *)new__; - } - } - return 0; -} /* replch_ */ - diff --git a/ext/spice/src/cspice/replwd.c b/ext/spice/src/cspice/replwd.c deleted file mode 100644 index 65b5869522..0000000000 --- a/ext/spice/src/cspice/replwd.c +++ /dev/null @@ -1,301 +0,0 @@ -/* replwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPLWD ( Replace a word ) */ -/* Subroutine */ int replwd_(char *instr, integer *nth, char *new__, char * - outstr, ftnlen instr_len, ftnlen new_len, ftnlen outstr_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - integer f, i__, j, k, l, n, begin, shift; - extern /* Subroutine */ int nthwd_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - char short__[2]; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - -/* $ Abstract */ - -/* Replace the Nth word in a string with a new word. */ - -/* $ 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 */ - -/* ASSIGNMENT, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INSTR I Input string. */ -/* NTH I Number of the word to be replaced. */ -/* NEW I Replacement word. */ -/* OUTSTR O Output string. */ - -/* $ Detailed_Input */ - -/* INSTR is the input character string, possibly containing */ -/* one or more words, where a word is any string of */ -/* consecutive non-blank characters delimited by a */ -/* blank or by either end of the string. */ - -/* NTH is the number of the word to be replaced. Words */ -/* are numbered from one. If NTH is less than one, */ -/* or greater than the number of words in the string, */ -/* no replacement is made. */ - -/* NEW is the word which is to replace the specified word */ -/* in the input string. Leading and trailing blanks */ -/* are ignored. If the replacement word is blank, */ -/* the original word is simply removed. */ - -/* $ Detailed_Output */ - -/* OUTSTR is the output string. This is the input string */ -/* with the N'th word replaced by the word NEW. */ -/* Any blanks originally surrounding the replaced */ -/* word are retained. */ - -/* OUTSTR may overwrite INSTR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The effect of this routine is to remove the old word with */ -/* REMSUB, and insert the replacement word with INSSUB. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If NEW is blank, then the Nth word is replaced by a single */ -/* space. */ - -/* $ Files */ - -/* None. */ - -/* $ Examples */ - -/* Let */ -/* INSTR = ' Woodsy is the Anti-Pollution Owl.' */ - -/* and */ -/* NEW = ' an ' */ - -/* then the following values of NTH yield the following strings. */ - -/* NTH OUTSTR */ -/* --- ------------------------------------------ */ -/* -1 ' Woodsy is the Anti-Pollution Owl.' */ -/* 0 ' Woodsy is the Anti-Pollution Owl.' */ -/* 1 ' an is the Anti-Pollution Owl.' */ -/* 3 ' Woodsy is an Anti-Pollution Owl.' */ -/* 4 ' Woodsy is the an Owl.' */ -/* 5 ' Woodsy is the Anti-Pollution an' */ -/* 6 ' Woodsy is the Anti-Pollution Owl.' */ - -/* Note that in the first, second, and last cases, the string */ -/* was not changed. Note also that in the next to last case, */ -/* the final period was treated as part of the fifth word in the */ -/* string. */ - -/* If NEW is ' ', and NTH is 3, then */ - -/* OUTSTR = ' Woodsy is Anti-Pollution Owl.' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace a word */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.3.0, 7-MAR-1989 (WLT) */ - -/* To satisfy complaints about me not having enough to do, */ -/* the case of a blank NEW word has been handled. */ - -/* - Beta Version 1.2.0, 28-FEB-1989 (WLT) */ - -/* Routine completely rewritten to satify whims of the */ -/* NAIF group. */ - -/* - Beta Version 1.1.1, 17-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ - -/* Declaration of the unused variable OUTLEN deleted. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* First just shift the input string into the output string, */ -/* then do everything in place (for the case when the new */ -/* word is longer than the old one. When its shorter we'll */ -/* need to change this scheme slightly.) */ - - s_copy(outstr, instr, outstr_len, instr_len); - -/* Where does the word to be replaced begin? If there is none, */ -/* just return the original string. */ - - nthwd_(outstr, nth, short__, &begin, outstr_len, (ftnlen)2); - if (begin == 0) { - return 0; - } - -/* Otherwise, find out where it ends as well. */ - - fndnwd_(instr, &begin, &i__, &j, instr_len); - -/* Now insert only the non-blank part of the replacement string. */ -/* If the replacement string is blank, don't insert anything. */ - - if (s_cmp(new__, " ", new_len, (ftnlen)1) != 0) { - f = frstnb_(new__, new_len); - l = lastnb_(new__, new_len); - -/* Except in the lucky case that the word to insert is the */ -/* same length as the word it's replacing, we will have */ -/* to shift right or left by some amount. Compute the */ -/* appropriate amount to shift right. */ - - shift = l - f - (j - i__); - } else { - f = 1; - l = 1; - shift = i__ - j; - } - if (shift > 0) { - -/* To shift right in place start at the right most character */ -/* of the string and copy the character SHIFT spaces to the */ -/* left. */ - - k = i_len(outstr, outstr_len); - n = k - shift; - while(n > j) { - *(unsigned char *)&outstr[k - 1] = *(unsigned char *)&outstr[n - - 1]; - --k; - --n; - } - -/* Once the appropriate characters have been shifted out */ -/* of the way, replace the opened space with the new */ -/* word. */ - - while(f <= l && i__ <= i_len(outstr, outstr_len)) { - *(unsigned char *)&outstr[i__ - 1] = *(unsigned char *)&new__[f - - 1]; - ++f; - ++i__; - } - } else { - -/* We have a left shift. Fill in the first part of the word */ -/* we are replacing with the new one. */ - - while(f <= l && i__ <= i_len(outstr, outstr_len)) { - *(unsigned char *)&outstr[i__ - 1] = *(unsigned char *)&new__[f - - 1]; - ++f; - ++i__; - } - -/* Now starting just past the end of the word we are replacing */ -/* shift the remainder of string left one character at a time. */ - - if (shift < 0) { - ++j; - while(i__ <= i_len(outstr, outstr_len) && j <= i_len(instr, - instr_len)) { - *(unsigned char *)&outstr[i__ - 1] = *(unsigned char *)&instr[ - j - 1]; - ++i__; - ++j; - } - -/* Finally pad the string with blanks. */ - - if (i__ <= i_len(outstr, outstr_len)) { - s_copy(outstr + (i__ - 1), " ", outstr_len - (i__ - 1), ( - ftnlen)1); - } - } - } - return 0; -} /* replwd_ */ - diff --git a/ext/spice/src/cspice/repmc.c b/ext/spice/src/cspice/repmc.c deleted file mode 100644 index 8716205d48..0000000000 --- a/ext/spice/src/cspice/repmc.c +++ /dev/null @@ -1,292 +0,0 @@ -/* repmc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPMC ( Replace marker with character string ) */ -/* Subroutine */ int repmc_(char *in, char *marker, char *value, char *out, - ftnlen in_len, ftnlen marker_len, ftnlen value_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - integer mrkpos; - -/* $ Abstract */ - -/* Replace a marker with a character 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* MARKER I Marker to be replaced. */ -/* VALUE I Replacement string. */ -/* OUT O Output string. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* MARKER is an arbitrary character string. The first */ -/* occurrence of MARKER in the input string is */ -/* to be replaced by VALUE. */ - -/* Leading and trailing blanks in MARKER are NOT */ -/* significant. In particular, no substitution is */ -/* performed if MARKER is blank. */ - -/* VALUE is an arbitrary character string. */ - -/* Leading and trailing blanks in VALUE are NOT */ -/* significant: the portion of VALUE that is */ -/* substituted for MARKER extends from its first */ -/* non-blank character to its last non-blank */ -/* character. */ - -/* However, if VALUE is blank, a single blank is */ -/* substituted for the first occurrence of MARKER. */ - -/* $ Detailed_Output */ - -/* OUT is the string obtained by substituting VALUE */ -/* (leading and trailing blanks excepted) for */ -/* the first occurrence of MARKER in the input */ -/* string. */ - -/* OUT and IN must be identical or disjoint. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If OUT does not have sufficient length to accommodate the */ -/* result of the substitution, the result will be truncated on */ -/* the right. */ - -/* 2) If MARKER is blank, or if MARKER is not a substring of IN, */ -/* no substitution is performed. (OUT and IN are identical.) */ - -/* 3) If VALUE is blank, a single blank is substituted for the */ -/* first occurrence of MARKER. */ - -/* $ Particulars */ - -/* This is one of a family of related routines for inserting values */ -/* into strings. They are typically to construct messages that */ -/* are partly fixed, and partly determined at run time. For example, */ -/* a message like */ - -/* 'Fifty-one pictures were found in directory [USER.DATA].' */ - -/* might be constructed from the fixed string */ - -/* '#1 pictures were found in directory #2.' */ - -/* by the calls */ - -/* CALL REPMCT ( STRING, '#1', N_PICS, 'C', STRING ) */ -/* CALL REPMC ( STRING, '#2', DIR_NAME, STRING ) */ - -/* which substitute the cardinal text 'Fifty-one' and the character */ -/* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */ - -/* The complete list of routines is shown below. */ - -/* REPMC ( Replace marker with character string value ) */ -/* REPMD ( Replace marker with double precision value ) */ -/* REPMF ( Replace marker with formatted d.p. value ) */ -/* REPMI ( Replace marker with integer value ) */ -/* REPMCT ( Replace marker with cardinal text) */ -/* REPMOT ( Replace marker with ordinal text ) */ - -/* $ Examples */ - -/* 1. Let */ - -/* MARKER = '#' */ -/* IN = 'Invalid operation value. The value was: #' */ - -/* Then following the call, */ - -/* CALL REPMC ( IN, '#', 'append', IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was: append' */ - - -/* 2. Let */ - -/* MARKER = ' XX ' */ -/* IN = 'A syntax error occurred. The token XX was not */ -/* recognized. Did you mean to say XX?' */ - -/* Then following the call, */ - -/* CALL REPMC ( IN, ' XX ', ' FND ', OUT ) */ - -/* OUT is */ - -/* 'A syntax error occurred. The token FND was not */ -/* recognized. Did you mean to say XX?' */ - - -/* 3. Let */ - -/* MARKER = '&' */ -/* NUM = 23 */ -/* CHANCE = 'fair' */ -/* SCORE = 4.665D0 */ - -/* Then following the sequence of calls, */ - -/* CALL REPMI ( 'There are & routines that have a ' // */ -/* . '& chance of meeting your needs.' // */ -/* . 'The maximum score was &.', */ -/* . '&', */ -/* . NUM, */ -/* . MSG ) */ - -/* CALL REPMC ( MSG, '&', CHANCE, MSG ) */ - -/* CALL REPMF ( MSG, '&', SCORE, 4, 'F', MSG ) */ - -/* MSG is */ - -/* 'There are 23 routines that have a fair chance of */ -/* meeting your needs. The maximum score was 4.665.' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-AUG-2002 (WLT) */ - -/* The routine is now error free. */ - -/* - 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, 30-AUG-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace marker with character_string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* If MARKER is blank, no substitution is possible. */ - - if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks). If MARKER is not */ -/* a substring of IN, no substitution can be performed. */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(in, marker + i__1, in_len, lastnb_(marker, marker_len) - - i__1); - if (mrkpos == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Okay, MARKER is non-blank and has been found. If VALUE is */ -/* blank, substitute a single blank. (This removes the marker.) */ -/* Otherwise substitute the non-blank portion. */ - - if (s_cmp(value, " ", value_len, (ftnlen)1) == 0) { - i__1 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); - zzrepsub_(in, &mrkpos, &i__1, " ", out, in_len, (ftnlen)1, out_len); - } else { - i__1 = frstnb_(value, value_len) - 1; - i__2 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); - zzrepsub_(in, &mrkpos, &i__2, value + i__1, out, in_len, lastnb_( - value, value_len) - i__1, out_len); - } - return 0; -} /* repmc_ */ - diff --git a/ext/spice/src/cspice/repmc_c.c b/ext/spice/src/cspice/repmc_c.c deleted file mode 100644 index b6dd8ad74f..0000000000 --- a/ext/spice/src/cspice/repmc_c.c +++ /dev/null @@ -1,395 +0,0 @@ -/* - --Procedure repmc_c ( Replace marker with character string ) - --Abstract - - Replace a marker with a character 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 - - CHARACTER - CONVERSION - STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void repmc_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - ConstSpiceChar * value, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - marker I Marker to be replaced. - value I Replacement value. - lenout I Available space in output string. - out O Output string. - --Detailed_Input - - in is a character string. - - marker is character string indicating where a substring - replacement is to be made. The first occurrence of - marker in the input string is to be replaced by - value. - - Leading and trailing blanks in marker are NOT - significant. In particular, no substitution is - performed if marker is blank. - - value is a replacement character string. - - Leading and trailing blanks in value are NOT - significant: the portion of value that is substituted - for marker extends from its first non-blank character - to its last non-blank character. - - However, if value is blank or empty, a single blank - is substituted for the first occurrence of marker. - - lenout is the allowed length of the output string. This - length must large enough to hold the output string - plus the terminator. If the output string is - expected to have x characters, lenout should be at - least x + 1. - --Detailed_Output - - out is the string obtained by substituting value - (leading and trailing blanks excepted) for - the first occurrence of marker in the input - string. - - out and in must be identical or disjoint. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If either the input or output string pointers are null, the - error SPICE(NULLPOINTER) is signaled. - - 2) If the marker string is blank or empty, this routine leaves - the input string unchanged, except that trailing blanks - will be trimmed. This case is not considered an error. - - 3) If the output string is too short to accommodate a terminating - null character, the error SPICE(STRINGTOOSHORT) is signaled. - - 4) If out does not have sufficient length to accommodate the - result of the substitution, the result will be truncated on - the right. - - 5) If value is blank or empty, a single blank is substituted - for the first occurrence of marker. - --Particulars - - This is one of a family of related routines for inserting values - into strings. They are typically to construct messages that - are partly fixed, and partly determined at run time. For example, - a message like - - "Fifty-one pictures were found in directory [USER.DATA]." - - might be constructed from the fixed string - - "#1 pictures were found in directory #2." - - by the calls - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 81 - . - . - . - repmct_c ( string, "#1", 51, 'c', LENOUT, string ); - repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string ); - - - which substitute the cardinal text "Fifty-one" and the character - string "[USER.DATA]" for the markers "#1" and "#2" respectively. - - The complete list of routines is shown below. - - repmc_c ( Replace marker with character string value ) - repmd_c ( Replace marker with double precision value ) - repmf_c ( Replace marker with formatted d.p. value ) - repmi_c ( Replace marker with integer value ) - repmct_c ( Replace marker with cardinal text) - repmot_c ( Replace marker with ordinal text ) - --Examples - - 1. Let - - marker == "#" - in == "Invalid operation value. The value was: <#>." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - - repmc_c ( in, "#", "append", LENOUT, in ) - - in is - - "Invalid operation value. The value was: ." - - - 2. Let - - marker == " XX " - in == "A syntax error occurred. The token XX was not " - "recognized. Did you mean to say XX?" - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - - repmc_c ( in, " XX ", " FND ", LENOUT, out ); - - out is - - "A syntax error occurred. The token FND was not " - "recognized. Did you mean to say XX?" - - Making the additional call - - repmc_c ( out, " XX ", " found ", LENOUT, out ); - - yields the string - - "A syntax error occurred. The token FND was not - recognized. Did you mean to say found?" - - 3. Let - - marker == "&" - num == 23 - chance == "fair" - score == 4.665 - - Then following the sequence of calls, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmi_c ( "There are & routines that have a " - "& chance of meeting your needs. " - "The maximum score was &.", - marker, - num, - LENOUT, - msg ); - - repmc_c ( msg, marker, chance, LENOUT, msg ); - - repmf_c ( msg, marker, score, 4, 'f', LENOUT, msg ); - - msg is - - "There are 23 routines that have a fair chance of " - "meeting your needs. The maximum score was 4.665." - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU) - --Index_Entries - - replace marker with character_string - --& -*/ - -{ /* Begin repmc_c */ - - - /* - Local variables - */ - ConstSpiceChar * markPtr; - ConstSpiceChar * valPtr; - - - /* - Use discovery check-in. - - Make sure no string argument pointers are null. - */ - CHKPTR( CHK_DISCOVER, "repmc_c", in ); - CHKPTR( CHK_DISCOVER, "repmc_c", marker ); - CHKPTR( CHK_DISCOVER, "repmc_c", value ); - CHKPTR( CHK_DISCOVER, "repmc_c", out ); - - - /* - If the output string can't hold a terminating null character, - we can't proceed. - */ - if ( lenout < 1 ) - { - chkin_c ( "repmc_c" ); - setmsg_c ( "String length lenout must be >= 1; actual " - "value = #." ); - errint_c ( "#", lenout ); - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); - chkout_c ( "repmc_c" ); - return; - } - - - /* - If the output string has no room for data characters, we simply - terminate the string. - */ - if ( lenout == 1 ) - { - out[0] = NULLCHAR; - return; - } - - - /* - If the input string has zero length, the output is empty as well. - */ - if ( in[0] == NULLCHAR ) - { - out[0] = NULLCHAR; - - return; - } - - - /* - If the marker is empty, pass a blank marker to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( marker[0] == NULLCHAR ) - { - markPtr = " "; - } - else - { - markPtr = marker; - } - - - /* - If the value is empty, pass a blank value to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( value[0] == NULLCHAR ) - { - valPtr = " "; - } - else - { - valPtr = value; - } - - - /* - Simply call the f2c'd routine. - */ - repmc_ ( ( char * ) in, - ( char * ) markPtr, - ( char * ) valPtr, - ( char * ) out, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(markPtr), - ( ftnlen ) strlen(valPtr), - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, out ); - - -} /* End repmc_c */ diff --git a/ext/spice/src/cspice/repmct.c b/ext/spice/src/cspice/repmct.c deleted file mode 100644 index a63cf80320..0000000000 --- a/ext/spice/src/cspice/repmct.c +++ /dev/null @@ -1,343 +0,0 @@ -/* repmct.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPMCT ( Replace marker with cardinal text ) */ -/* Subroutine */ int repmct_(char *in, char *marker, integer *value, char * - case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, - ftnlen out_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char card[145]; - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen), - chkin_(char *, ftnlen), ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen), ljust_(char *, char *, - ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen); - char tmpcas[1]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int repsub_(char *, integer *, integer *, char *, - char *, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen); - integer mrkpos; - extern logical return_(void); - extern /* Subroutine */ int inttxt_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Replace a marker with the text representation of a */ -/* cardinal number. */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* MARKER I Marker to be replaced. */ -/* VALUE I Cardinal value. */ -/* CASE I Case of replacement text. */ -/* OUT O Output string. */ -/* MAXLCN P Maximum length of a cardinal number. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* MARKER is an arbitrary character string. The first */ -/* occurrence of MARKER in the input string is */ -/* to be replaced by the text representation of */ -/* the cardinal number VALUE. */ - -/* Leading and trailing blanks in MARKER are NOT */ -/* significant. In particular, no substitution is */ -/* performed if MARKER is blank. */ - -/* VALUE is an arbitrary integer. */ - -/* CASE indicates the case of the replacement text. */ -/* CASE may be any of the following: */ - -/* CASE Meaning Example */ -/* ---- ----------- ----------------------- */ -/* U, u Uppercase ONE HUNDRED FIFTY-THREE */ - -/* L, l Lowercase one hundred fifty-three */ - -/* C, c Capitalized One hundred fifty-three */ - -/* $ Detailed_Output */ - -/* OUT is the string obtained by substituting the text */ -/* representation of the cardinal number VALUE for */ -/* the first occurrence of MARKER in the input string. */ - -/* OUT and IN must be identical or disjoint. */ - -/* $ Parameters */ - -/* MAXLCN is the maximum expected length of any cardinal */ -/* text. 145 characters are sufficient to hold the */ -/* text representing any value in the range */ - -/* ( -10**12, 10**12 ) */ - -/* An example of a number whose text representation */ -/* is of maximum length is */ - -/* - 777 777 777 777 */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If OUT does not have sufficient length to accommodate the */ -/* result of the substitution, the result will be truncated on */ -/* the right. */ - -/* 2) If MARKER is blank, or if MARKER is not a substring of IN, */ -/* no substitution is performed. (OUT and IN are identical.) */ - -/* 3) If the value of CASE is not recognized, the error */ -/* SPICE(INVALIDCASE) is signalled. OUT is not changed. */ - -/* $ Particulars */ - -/* This is one of a family of related routines for inserting values */ -/* into strings. They are typically used to construct messages that */ -/* are partly fixed, and partly determined at run time. For example, */ -/* a message like */ - -/* 'Fifty-one pictures were found in directory [USER.DATA].' */ - -/* might be constructed from the fixed string */ - -/* '#1 pictures were found in directory #2.' */ - -/* by the calls */ - -/* CALL REPMCT ( STRING, '#1', NPICS, 'C', STRING ) */ -/* CALL REPMC ( STRING, '#2', DIRNAM, STRING ) */ - -/* which substitute the cardinal text 'Fifty-one' and the character */ -/* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */ - -/* The complete list of routines is shown below. */ - -/* REPMC ( Replace marker with character string value ) */ -/* REPMD ( Replace marker with double precision value ) */ -/* REPMF ( Replace marker with formatted d.p. value ) */ -/* REPMI ( Replace marker with integer value ) */ -/* REPMCT ( Replace marker with cardinal text) */ -/* REPMOT ( Replace marker with ordinal text ) */ - -/* $ Examples */ - -/* The following examples illustrate the use of REPMCT to */ -/* replace a marker within a string with the cardinal text */ -/* corresponding to an integer. */ - -/* Uppercase */ -/* --------- */ - -/* Let */ - -/* MARKER = '#' */ -/* IN = 'INVALID COMMAND. WORD # WAS NOT RECOGNIZED.' */ - -/* Then following the call, */ - -/* CALL REPMCT ( IN, '#', 5, 'U', IN ) */ - -/* IN is */ - -/* 'INVALID COMMAND. WORD FIVE WAS NOT RECOGNIZED.' */ - -/* Lowercase */ -/* --------- */ - -/* Let */ - -/* MARKER = ' XX ' */ -/* IN = 'Word XX of the XX sentence was misspelled.' */ - -/* Then following the call, */ - -/* CALL REPMCT ( IN, ' XX ', 5, 'L', OUT ) */ - -/* OUT is */ - -/* 'Word five of the XX sentence was misspelled.' */ - - -/* Capitalized */ -/* ----------- */ - -/* Let */ - -/* MARKER = ' XX ' */ -/* IN = 'Name: YY. Rank: XX.' */ - -/* Then following the calls, */ - -/* CALL REPMC ( IN, 'YY', 'Moriarty', OUT ) */ -/* CALL REPMCT ( OUT, 'XX', 1, 'C', OUT ) */ - -/* OUT is */ - -/* 'Name: Moriarty. Rank: One.' */ - -/* $ Restrictions */ - -/* 1) VALUE must be in the range accepted by subroutine INTTXT. */ -/* This range is currently */ - -/* ( -10**12, 10**12 ) */ - -/* Note that the endpoints of the interval are excluded. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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, 30-AUG-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace marker with cardinal text */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REPMCT", (ftnlen)6); - } - -/* Bail out if CASE is not recognized. */ - - ljust_(case__, tmpcas, (ftnlen)1, (ftnlen)1); - ucase_(tmpcas, tmpcas, (ftnlen)1, (ftnlen)1); - if (*(unsigned char *)tmpcas != 'U' && *(unsigned char *)tmpcas != 'L' && - *(unsigned char *)tmpcas != 'C') { - setmsg_("Case (#) must be U, L, or C.", (ftnlen)28); - errch_("#", case__, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDCASE)", (ftnlen)18); - chkout_("REPMCT", (ftnlen)6); - return 0; - } - -/* If MARKER is blank, no substitution is possible. */ - - if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) { - s_copy(out, in, out_len, in_len); - chkout_("REPMCT", (ftnlen)6); - return 0; - } - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks). If MARKER is not */ -/* a substring of IN, no substitution can be performed. */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(in, marker + i__1, in_len, lastnb_(marker, marker_len) - - i__1); - if (mrkpos == 0) { - s_copy(out, in, out_len, in_len); - chkout_("REPMCT", (ftnlen)6); - return 0; - } - -/* Okay, CASE is recognized and MARKER has been found. */ -/* Generate the cardinal text corresponding to VALUE. */ - - inttxt_(value, card, (ftnlen)145); - -/* CARD is always returned in upper case; change to the specified */ -/* case, if required. */ - - if (*(unsigned char *)tmpcas == 'L') { - lcase_(card, card, (ftnlen)145, (ftnlen)145); - } else if (*(unsigned char *)tmpcas == 'C') { - lcase_(card + 1, card + 1, (ftnlen)144, (ftnlen)144); - } - -/* Replace MARKER with CARD. */ - - i__1 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, marker_len); - repsub_(in, &mrkpos, &i__1, card, out, in_len, lastnb_(card, (ftnlen)145), - out_len); - chkout_("REPMCT", (ftnlen)6); - return 0; -} /* repmct_ */ - diff --git a/ext/spice/src/cspice/repmct_c.c b/ext/spice/src/cspice/repmct_c.c deleted file mode 100644 index dda0f0db9c..0000000000 --- a/ext/spice/src/cspice/repmct_c.c +++ /dev/null @@ -1,378 +0,0 @@ -/* - --Procedure repmct_c ( Replace marker with cardinal text ) - --Abstract - - Replace a marker with the text representation of a - cardinal number. - --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 - - CHARACTER - CONVERSION - STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void repmct_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar repcase, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - marker I Marker to be replaced. - value I Replacement value. - repcase I Case of replacement text. - lenout I Available space in output string. - out O Output string. - MAXLCN P is the maximum expected length of any cardinal text. - --Detailed_Input - - in is an arbitrary character string. - - marker is an arbitrary character string. The first - occurrence of marker in the input string is - to be replaced by the text representation of - the cardinal number value. - - Leading and trailing blanks in marker are not - significant. In particular, no substitution is - performed if marker is blank or empty. - - value is an arbitrary integer. - - repcase indicates the case of the replacement text. - repcase may be any of the following: - - repcase Meaning Example - ------- ----------- ----------------------- - U, u Uppercase ONE HUNDRED FIFTY-THREE - - L, l Lowercase one hundred fifty-three - - C, c Capitalized One hundred fifty-three - - lenout is the allowed length of the output string. This - length must large enough to hold the output string - plus the terminator. If the output string is - expected to have x characters, lenout should be at - least x + 1. - --Detailed_Output - - out is the string obtained by substituting the text - representation of the cardinal number value for - the first occurrence of marker in the input string. - - out and in must be identical or disjoint. - --Parameters - - MAXLCN is the maximum expected length of any cardinal - text. 145 characters are sufficient to hold the - text representing any value in the range - - ( -10**12, 10**12 ) - - An example of a number whose text representation - is of maximum length is - - - 777 777 777 777 - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if any of - the input or output string pointers is null. - - 2) If the marker string is blank or empty, this routine leaves - the input string unchanged, except that trailing blanks - will be trimmed. This case is not considered an error. - - 3) If the output string is too short to accommodate a terminating - null character, the error SPICE(STRINGTOOSHORT) is signaled. - - 4) If out does not have sufficient length to accommodate the - result of the substitution, the result will be truncated on - the right. - - 5) If the value of repcase is not recognized, the error - will be diagnosed by routines in the call tree of this - routine. out is not changed. - --Files - - None. - --Particulars - - This is one of a family of related routines for inserting values - into strings. They are typically used to construct messages that - are partly fixed, and partly determined at run time. For example, - a message like - - "Fifty-one pictures were found in directory [USER.DATA]." - - might be constructed from the fixed string - - "#1 pictures were found in directory #2." - - by the calls - - repmct_c ( string, "#1", 51, 'c', LENOUT, string ); - repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string ); - - which substitute the cardinal text "Fifty-one" and the character - string "[USER.DATA]" for the markers "#1" and "#2" respectively. - - The complete list of routines is shown below. - - repmc_c ( Replace marker with character string value ) - repmd_c ( Replace marker with double precision value ) - repmf_c ( Replace marker with formatted d.p. value ) - repmi_c ( Replace marker with integer value ) - repmct_c ( Replace marker with cardinal text ) - repmot_c ( Replace marker with ordinal text ) - --Examples - - The following examples illustrate the use of repmct_c to - replace a marker within a string with the cardinal text - corresponding to an integer. - - Uppercase - --------- - - Let - - marker == "#" - in == "Invalid command. Word # was not recognized." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmct_c ( in, "#", 5, 'U', LENOUT, in ); - - in is - - "Invalid command. Word FIVE was not recognized." - - Lowercase - --------- - - Let - - marker == " XX " - in == "Word XX of the XX sentence was misspelled." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmct_c ( in, " XX ", 5, 'L', LENOUT, out ); - - out is - - "Word five of the XX sentence was misspelled." - - - Capitalized - ----------- - - Let - - marker == " XX " - in == "Name: YY. Rank: XX." - - Then following the calls, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmc_c ( in, "YY", "Moriarty", LENOUT, out ); - repmct_c ( out, "XX", 1, 'C', LENOUT, out ); - - out is - - "Name: Moriarty. Rank: One." - --Restrictions - - 1) value must be in the range accepted by subroutine inttxt_. - This range is currently - - ( -10**12, 10**12 ) - - Note that the endpoints of the interval are excluded. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU) - --Index_Entries - - replace marker with cardinal text - --& -*/ - -{ /* Begin repmct_c */ - - /* - Local variables - */ - ConstSpiceChar * markPtr; - - - /* - Use discovery check-in. - - Make sure no string argument pointers are null. - */ - CHKPTR( CHK_DISCOVER, "repmct_c", in ); - CHKPTR( CHK_DISCOVER, "repmct_c", marker ); - CHKPTR( CHK_DISCOVER, "repmct_c", out ); - - - /* - If the output string can't hold a terminating null character, - we can't proceed. - */ - if ( lenout < 1 ) - { - chkin_c ( "repmct_c" ); - setmsg_c ( "String length lenout must be >= 1; actual " - "value = #." ); - errint_c ( "#", lenout ); - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); - chkout_c ( "repmct_c" ); - return; - } - - - /* - If the output string has no room for data characters, we simply - terminate the string. - */ - if ( lenout == 1 ) - { - out[0] = NULLCHAR; - return; - } - - - /* - If the input string has zero length, the output is empty as well. - */ - if ( in[0] == NULLCHAR ) - { - out[0] = NULLCHAR; - - return; - } - - - /* - If the marker is empty, pass a blank marker to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( marker[0] == NULLCHAR ) - { - markPtr = " "; - } - else - { - markPtr = marker; - } - - /* - Simply call the f2c'd routine. - */ - repmct_ ( ( char * ) in, - ( char * ) markPtr, - ( integer * ) &value, - ( char * ) &repcase, - ( char * ) out, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(markPtr), - ( ftnlen ) 1, - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, out ); - - -} /* End repmct_c */ diff --git a/ext/spice/src/cspice/repmd.c b/ext/spice/src/cspice/repmd.c deleted file mode 100644 index 8283c57ef7..0000000000 --- a/ext/spice/src/cspice/repmd.c +++ /dev/null @@ -1,313 +0,0 @@ -/* repmd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPMD ( Replace marker with double precision number ) */ -/* Subroutine */ int repmd_(char *in, char *marker, doublereal *value, - integer *sigdig, char *out, ftnlen in_len, ftnlen marker_len, ftnlen - out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen), dpstr_(doublereal *, integer *, - char *, ftnlen); - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - integer mrkpos; - char substr[23]; - -/* $ Abstract */ - -/* Replace a marker with a double precision number. */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* MARKER I Marker to be replaced. */ -/* VALUE I Replacement value. */ -/* SIGDIG I Significant digits in replacement text. */ -/* OUT O Output string. */ -/* MAXLDP P Maximum length of a DP number. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* MARKER is an arbitrary character string. The first */ -/* occurrence of MARKER in the input string is */ -/* to be replaced by VALUE. */ - -/* Leading and trailing blanks in MARKER are NOT */ -/* significant. In particular, no substitution is */ -/* performed if MARKER is blank. */ - -/* VALUE is an arbitrary double precision number. */ - -/* SIGDIG is the number of significant digits with */ -/* which VALUE is to be represented. SIGDIG */ -/* must be greater than zero and less than 15. */ - -/* $ Detailed_Output */ - - -/* OUT is the string obtained by substituting the text */ -/* representation of VALUE for the first occurrence */ -/* of MARKER in the input string. */ - -/* The text representation of VALUE is in scientific */ -/* notation, having the number of significant digits */ -/* specified by SIGDIG. The representation of VALUE */ -/* is produced by the routine DPSTR; see that routine */ -/* for details concerning the representation of */ -/* double precision numbers. */ - -/* OUT and IN must be identical or disjoint. */ - -/* $ Parameters */ - -/* MAXLDP is the maximum expected length of the text */ -/* representation of a double precision number. */ -/* 23 characters are sufficient to hold any result */ -/* returned by DPSTR. (See $Restrictions.) */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If OUT does not have sufficient length to accommodate the */ -/* result of the substitution, the result will be truncated on */ -/* the right. */ - -/* 2) If MARKER is blank, or if MARKER is not a substring of IN, */ -/* no substitution is performed. (OUT and IN are identical.) */ - -/* $ Particulars */ - -/* This is one of a family of related routines for inserting values */ -/* into strings. They are typically to construct messages that */ -/* are partly fixed, and partly determined at run time. For example, */ -/* a message like */ - -/* 'Fifty-one pictures were found in directory [USER.DATA].' */ - -/* might be constructed from the fixed string */ - -/* '#1 pictures were found in directory #2.' */ - -/* by the calls */ - -/* CALL REPMCT ( STRING, '#1', N_PICS, 'C', STRING ) */ -/* CALL REPMC ( STRING, '#2', DIR_NAME, STRING ) */ - -/* which substitute the cardinal text 'Fifty-one' and the character */ -/* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */ - -/* The complete list of routines is shown below. */ - -/* REPMC ( Replace marker with character string value ) */ -/* REPMD ( Replace marker with double precision value ) */ -/* REPMF ( Replace marker with formatted d.p. value ) */ -/* REPMI ( Replace marker with integer value ) */ -/* REPMCT ( Replace marker with cardinal text) */ -/* REPMOT ( Replace marker with ordinal text ) */ - -/* $ Examples */ - -/* 1. Let */ - -/* IN = 'Invalid operation value. The value was #.' */ - -/* Then following the call, */ - -/* CALL REPMD ( IN, '#', 5.0D1, 2, IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was 5.0E+01.' */ - - -/* 2. Let */ - -/* IN = 'Left endpoint exceeded right endpoint. The left */ -/* endpoint was: XX. The right endpoint was: XX.' */ - -/* Then following the call, */ - -/* CALL REPMD ( IN, ' XX ', -5.2D-9, 3, OUT ) */ - -/* OUT is */ - -/* 'Left endpoint exceeded right endpoint. The left */ -/* endpoint was: -5.20E-09. The right endpoint was: XX.' */ - - -/* 3. Let */ - -/* IN = 'Invalid operation value. The value was #.' */ - -/* Then following the call */ - -/* CALL REPMD ( IN, '#', 5.0D1, 100, IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was */ -/* 5.0000000000000E+01.' */ - -/* Note that even though 100 digits of precision were requested, */ -/* only 14 were returned. */ - - -/* 4. Let */ - -/* NUM = 23 */ -/* CHANCE = 'fair' */ -/* SCORE = 4.665D0 */ - -/* Then following the sequence of calls, */ - -/* CALL REPMI ( 'There are & routines that have a ' // */ -/* . '& chance of meeting your needs.' // */ -/* . 'The maximum score was &.', */ -/* . '&', */ -/* . NUM, */ -/* . MSG ) */ - -/* CALL REPMC ( MSG, '&', CHANCE, MSG ) */ - -/* CALL REPMD ( MSG, '&', SCORE, 4, MSG ) */ - -/* MSG is */ - -/* 'There are 23 routines that have a fair chance of */ -/* meeting your needs. The maximum score was 4.665E+00.' */ - -/* $ Restrictions */ - -/* 1) The maximum number of significant digits returned is 14. */ - -/* 2) This routine makes explicit use of the format of the string */ -/* returned by DPSTR; should that routine change, substantial */ -/* work may be required to bring this routine back up to snuff. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-AUG-2002 (WLT) */ - -/* The routine is now error free. */ - -/* - 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, 30-AUG-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace marker with d.p. number */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - - -/* If MARKER is blank, no substitution is possible. */ - - if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks). If MARKER is not */ -/* a substring of IN, no substitution can be performed. */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(in, marker + i__1, in_len, lastnb_(marker, marker_len) - - i__1); - if (mrkpos == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Okay, MARKER is non-blank and has been found. Convert the */ -/* number to text, and substitute the text for the marker. */ - - dpstr_(value, sigdig, substr, (ftnlen)23); - if (lastnb_(substr, (ftnlen)23) != 0) { - i__1 = frstnb_(substr, (ftnlen)23) - 1; - i__2 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); - zzrepsub_(in, &mrkpos, &i__2, substr + i__1, out, in_len, lastnb_( - substr, (ftnlen)23) - i__1, out_len); - } - return 0; -} /* repmd_ */ - diff --git a/ext/spice/src/cspice/repmd_c.c b/ext/spice/src/cspice/repmd_c.c deleted file mode 100644 index af69de1a6e..0000000000 --- a/ext/spice/src/cspice/repmd_c.c +++ /dev/null @@ -1,381 +0,0 @@ -/* - --Procedure repmd_c ( Replace marker with double precision number ) - --Abstract - - Replace a marker with a double precision number. - --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 - - CHARACTER - CONVERSION - STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void repmd_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - marker I Marker to be replaced. - value I Replacement value. - sigdig I Significant digits in replacement text. - lenout I Available space in output string. - out O Output string. - MAXLDP P Maximum length of a d.p. number. - --Detailed_Input - - in is an arbitrary character string. - - marker is an arbitrary character string. The first occurrence - of marker in the input string is to be replaced by value. - - Leading and trailing blanks in marker are NOT significant. - In particular, no substitution is performed if marker - is blank. - - value is an arbitrary double precision number. - - sigdig is the number of significant digits with which value - is to be represented. sigdig must be greater than - zero and less than 15. - - lenout is the allowed length of the output string. This length - must large enough to hold the output string plus the - terminator. If the output string is expected to have x - characters, lenout should be at least x + 1. - --Detailed_Output - - out is the string obtained by substituting the text - representation of value for the first occurrence - of marker in the input string. - - The text representation of value is in scientific - notation, having the number of significant digits - specified by sigdig. The representation of value is - produced by the routine dpstr_; see that routine for - details concerning the representation of double - precision numbers. - - out and in must be identical or disjoint. - --Parameters - - MAXLDP is the maximum expected length of the text - representation of a double precision number. - 23 characters are sufficient to hold any result - returned by dpstr_. (See Restrictions.) - - This routine assumes that the input d.p. value - is such that its string representation contains - no more than MAXLDP characters. - --Files - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if any of - the input or output string pointers is null. - - 2) If the marker string is blank or empty, this routine leaves - the input string unchanged, except that trailing blanks - will be trimmed. This case is not considered an error. - - 3) If the output string is too short to accommodate a terminating - null character, the error SPICE(STRINGTOOSHORT) is signaled. - - 4) If out does not have sufficient length to accommodate the - result of the substitution, the result will be truncated on - the right. - --Particulars - - This is one of a family of related routines for inserting values - into strings. They are typically to construct messages that - are partly fixed, and partly determined at run time. For example, - a message like - - "Fifty-one pictures were found in directory [USER.DATA]." - - might be constructed from the fixed string - - "#1 pictures were found in directory #2." - - by the calls - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 81 - . - . - . - repmct_c ( string, "#1", 51, 'c', LENOUT, string ); - repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string ); - - - which substitute the cardinal text "Fifty-one" and the character - string "[USER.DATA]" for the markers "#1" and "#2" respectively. - - The complete list of routines is shown below. - - repmc_c ( Replace marker with character string value ) - repmd_c ( Replace marker with double precision value ) - repmf_c ( Replace marker with formatted d.p. value ) - repmi_c ( Replace marker with integer value ) - repmct_c ( Replace marker with cardinal text ) - repmot_c ( Replace marker with ordinal text ) - - --Examples - - 1. Let - - in == "Invalid duration value. The value was ." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmd_c ( in, "", 5e11, 1, LENOUT, outstr ); - - - outstr contains the string: - - "Invalid duration value. The value was 5.0e11." - - - - 2. Let - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - in == "Left endpoint exceeded right endpoint. " - "The left endpoint was: XX. The right " - "endpoint was: XX." - - Then following the call, - - repmd_c ( in, " XX ", -5.2e-9, 3, LENOUT, out ); - - out is - - "Left endpoint exceeded right endpoint. The left " - "endpoint was: -5.20E-09. The right endpoint was: XX." - - - 3. Let - - num == 23 - chance == "fair" - score == 4.665 - - Then following the sequence of calls, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmi_c ( "There are & routines that have a " - "& chance of meeting your needs." - "The maximum score was &.", - "&", - num, - LENOUT, - msg ); - - repmc_c ( msg, marker, chance, LENOUT, msg ); - - repmd_c ( msg, marker, score, 4, LENOUT, msg ); - - - msg is - - "There are 23 routines that have a fair chance of " - "meeting your needs. The maximum score was 4.665E+00." - - --Restrictions - - 1) The maximum number of significant digits returned is 14. - - 2) This routine makes explicit use of the format of the string - returned by dpstr_; should that routine change, substantial - work may be required to bring this routine back up to snuff. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU) - --Index_Entries - - replace marker with d.p. number - --& -*/ - -{ /* Begin repmd_c */ - - /* - Local variables - */ - ConstSpiceChar * markPtr; - - - /* - Use discovery check-in. - - Make sure no string argument pointers are null. - */ - CHKPTR( CHK_DISCOVER, "repmd_c", in ); - CHKPTR( CHK_DISCOVER, "repmd_c", marker ); - CHKPTR( CHK_DISCOVER, "repmd_c", out ); - - - /* - If the output string can't hold a terminating null character, - we can't proceed. - */ - if ( lenout < 1 ) - { - chkin_c ( "repmd_c" ); - setmsg_c ( "String length lenout must be >= 1; actual " - "value = #." ); - errint_c ( "#", lenout ); - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); - chkout_c ( "repmd_c" ); - return; - } - - - /* - If the output string has no room for data characters, we simply - terminate the string. - */ - if ( lenout == 1 ) - { - out[0] = NULLCHAR; - return; - } - - - /* - If the input string has zero length, the output is empty as well. - */ - if ( in[0] == NULLCHAR ) - { - out[0] = NULLCHAR; - - return; - } - - - /* - If the marker is empty, pass a blank marker to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( marker[0] == NULLCHAR ) - { - markPtr = " "; - } - else - { - markPtr = marker; - } - - - /* - Simply call the f2c'd routine. - */ - repmd_ ( ( char * ) in, - ( char * ) marker, - ( doublereal * ) &value, - ( integer * ) &sigdig, - ( char * ) out, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(marker), - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, out ); - - -} /* End repmd_c */ diff --git a/ext/spice/src/cspice/repmf.c b/ext/spice/src/cspice/repmf.c deleted file mode 100644 index 63ddfb9ef5..0000000000 --- a/ext/spice/src/cspice/repmf.c +++ /dev/null @@ -1,352 +0,0 @@ -/* repmf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPMF ( Replace marker with formatted d.p. value ) */ -/* Subroutine */ int repmf_(char *in, char *marker, doublereal *value, - integer *sigdig, char *format, char *out, ftnlen in_len, ftnlen - marker_len, ftnlen format_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen), ucase_(char *, char *, ftnlen, - ftnlen); - char gdfmt[1]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - extern /* Subroutine */ int dpstrf_(doublereal *, integer *, char *, char - *, ftnlen, ftnlen); - integer mrkpos; - char substr[56]; - -/* $ Abstract */ - -/* Replace a marker in a string with a formatted double precision */ -/* value. */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* MARKER I Marker to be replaced. */ -/* VALUE I Replacement value. */ -/* SIGDIG I Significant digits in replacement text. */ -/* FORMAT I Format: 'E' or 'F'. */ -/* OUT O Output string. */ -/* MAXLFD P Maximum length of a formatted DP number. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* MARKER is an arbitrary character string. The first */ -/* occurrence of MARKER in the input string is */ -/* to be replaced by VALUE. */ - -/* Leading and trailing blanks in MARKER are NOT */ -/* significant. In particular, no substitution is */ -/* performed if MARKER is blank. */ - -/* VALUE is an arbitrary double precision number. */ - -/* SIGDIG is the number of significant digits with */ -/* which VALUE is to be represented. SIGDIG */ -/* must be greater than zero and less than 15. */ - -/* FORMAT is the format in which VALUE is to be represented. */ -/* FORMAT may be any of the following: */ - -/* FORMAT Meaning Example */ -/* ------ ----------- ---------------- */ -/* E, e Scientific 3.14159E+03 */ -/* (exponent) */ -/* notation */ - -/* F, f Fixed-point 3141.59 */ -/* notation */ - -/* $ Detailed_Output */ - -/* OUT is the string obtained by substituting the text */ -/* representation of VALUE for the first occurrence */ -/* of MARKER in the input string. */ - -/* The text representation of VALUE is in scientific */ -/* (exponent) or fixed-point notation, depending on */ -/* having the value of FORMAT, and having the number */ -/* of significant digits specified by SIGDIG. */ -/* The representation of VALUE is produced by the */ -/* routine DPSTRF; see that routine for details */ -/* concerning the representation of double precision */ -/* numbers. */ - -/* OUT and IN must be identical or disjoint. */ - -/* $ Parameters */ - -/* MAXLFD is the maximum expected length of the text */ -/* representation of a formatted double precision */ -/* number. 56 characters are sufficient to hold any */ -/* result returned by DPSTRF. (See $Restrictions.) */ -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If OUT does not have sufficient length to accommodate the */ -/* result of the substitution, the result will be truncated on */ -/* the right. */ - -/* 2) If MARKER is blank, or if MARKER is not a substring of IN, */ -/* no substitution is performed. (OUT and IN are identical.) */ - -/* $ Particulars */ - -/* This is one of a family of related routines for inserting values */ -/* into strings. They are typically to construct messages that */ -/* are partly fixed, and partly determined at run time. For example, */ -/* a message like */ - -/* 'Fifty-one pictures were found in directory [USER.DATA].' */ - -/* might be constructed from the fixed string */ - -/* '#1 pictures were found in directory #2.' */ - -/* by the calls */ - -/* CALL REPMCT ( STRING, '#1', N_PICS, 'C', STRING ) */ -/* CALL REPMC ( STRING, '#2', DIR_NAME, STRING ) */ - -/* which substitute the cardinal text 'Fifty-one' and the character */ -/* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */ - -/* The complete list of routines is shown below. */ - -/* REPMC ( Replace marker with character string value ) */ -/* REPMD ( Replace marker with double precision value ) */ -/* REPMF ( Replace marker with formatted d.p. value ) */ -/* REPMI ( Replace marker with integer value ) */ -/* REPMCT ( Replace marker with cardinal text) */ -/* REPMOT ( Replace marker with ordinal text ) */ - -/* $ Examples */ - - -/* 1. Let */ - -/* IN = 'Invalid operation value. The value was #.' */ - -/* Then following the call, */ - -/* CALL REPMF ( IN, '#', 5.0D1, 2, 'E', IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was 5.0E+01.' */ - - -/* 2. Let */ - -/* IN = 'Left endpoint exceeded right endpoint. The left */ -/* endpoint was: XX. The right endpoint was: XX.' */ - -/* Then following the call, */ - -/* CALL REPMF ( IN, ' XX ', -5.2D-9, 3, 'E', OUT ) */ - -/* OUT is */ - -/* 'Left endpoint exceeded right endpoint. The left */ -/* endpoint was: -5.20E-09. The right endpoint was: XX.' */ - - -/* 3. Let */ - -/* IN = 'Invalid operation value. The value was # units.' */ - -/* Then following the call, */ - -/* CALL REPMF ( IN, '#', 5.0D1, 3, 'F', IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was 50.0 units..' */ - - -/* 4. In the above example, if SIGDIG is 1 instead of 3, IN becomes */ - -/* 'Invalid operation value. The value was 50 units.' */ - - -/* 5. Let */ - -/* IN = 'Invalid operation value. The value was #.' */ - -/* Then following the call, */ - -/* CALL REPMF ( IN, '#', 5.0D1, 100, 'E', IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was */ -/* 5.0000000000000E+01.' */ - -/* Note that even though 100 digits of precision were requested, */ -/* only 14 were returned. */ - - -/* 6. Let */ - -/* MARKER = '&' */ -/* NUM = 23 */ -/* CHANCE = 'fair' */ -/* SCORE = 4.665D0 */ - -/* Then following the sequence of calls, */ - -/* CALL REPMI ( 'There are & routines that have a ' // */ -/* . '& chance of meeting your needs.' // */ -/* . 'The maximum score was &.', */ -/* . '&', */ -/* . NUM, */ -/* . MSG ) */ - -/* CALL REPMC ( MSG, '&', CHANCE, MSG ) */ - -/* CALL REPMF ( MSG, '&', SCORE, 4, 'F', MSG ) */ - -/* MSG is */ - -/* 'There are 23 routines that have a fair chance of */ -/* meeting your needs. The maximum score was 4.665.' */ - -/* $ Restrictions */ - -/* 1) The maximum number of significant digits returned is 14. */ - -/* 2) This routine makes explicit use of the format of the string */ -/* returned by DPSTRF; should that routine change, substantial */ -/* work may be required to bring this routine back up to snuff. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-AUG-2002 (WLT) */ - -/* The routine is now error free. */ - -/* - 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, 30-AUG-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace marker with formatted d.p. value */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* If MARKER is blank, no substitution is possible. */ - - if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks). If MARKER is not */ -/* a substring of IN, no substitution can be performed. */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(in, marker + i__1, in_len, lastnb_(marker, marker_len) - - i__1); - if (mrkpos == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Okay, MARKER is non-blank and has been found. Convert the */ -/* number to text, and substitute the text for the marker. */ - - ljust_(format, gdfmt, format_len, (ftnlen)1); - ucase_(gdfmt, gdfmt, (ftnlen)1, (ftnlen)1); - dpstrf_(value, sigdig, gdfmt, substr, (ftnlen)1, (ftnlen)56); - if (lastnb_(substr, (ftnlen)56) != 0) { - i__1 = frstnb_(substr, (ftnlen)56) - 1; - i__2 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, - marker_len); - zzrepsub_(in, &mrkpos, &i__2, substr + i__1, out, in_len, lastnb_( - substr, (ftnlen)56) - i__1, out_len); - } - return 0; -} /* repmf_ */ - diff --git a/ext/spice/src/cspice/repmf_c.c b/ext/spice/src/cspice/repmf_c.c deleted file mode 100644 index 58df8473b8..0000000000 --- a/ext/spice/src/cspice/repmf_c.c +++ /dev/null @@ -1,440 +0,0 @@ -/* - --Procedure repmf_c ( Replace marker with formatted d.p. value ) - --Abstract - - Replace a marker in a string with a formatted double precision - value. - --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 - - CHARACTER - CONVERSION - STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void repmf_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceChar format, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - marker I Marker to be replaced. - value I Replacement value. - sigdig I Significant digits in replacement text. - format I Format: 'E' or 'F'. - lenout I Available space in output string. - out O Output string. - MAXLFD P Maximum length of a formatted DP number. - --Detailed_Input - - in is an arbitrary character string. - - marker is an arbitrary character string. The first occurrence - of marker in the input string is to be replaced by value. - - Leading and trailing blanks in marker are NOT significant. - In particular, no substitution is performed if marker - is blank. - - value is an arbitrary double precision number. - - sigdig is the number of significant digits with which value - is to be represented. sigdig must be greater than - zero and less than 15. - - format is the format in which value is to be represented. - format may be any of the following: - - format Meaning Example - ------ ----------- ---------------- - E, e Scientific 3.14159E+03 - (exponent) - notation - - F, f Fixed-point 3141.59 - notation - - lenout is the allowed length of the output string. This length - must large enough to hold the output string plus the - terminator. If the output string is expected to have x - characters, lenout should be at least x + 1. - --Detailed_Output - - out is the string obtained by substituting the text - representation of value for the first occurrence - of marker in the input string. - - The text representation of value is in scientific - (exponent) or fixed-point notation, depending on - having the value of format, and having the number - of significant digits specified by sigdig. - The representation of value is produced by the - routine dpstrf_; see that routine for details - concerning the representation of double precision - numbers. - - out and in must be identical or disjoint. - --Parameters - - MAXLFD is the maximum expected length of the text - representation of a formatted double precision - number. 56 characters are sufficient to hold any - result returned by dpstrf_. (See $Restrictions.) - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if any of - the input or output string pointers is null. - - 2) If the marker string is blank or empty, this routine leaves - the input string unchanged, except that trailing blanks - will be trimmed. This case is not considered an error. - - 3) If the output string is too short to accommodate a terminating - null character, the error SPICE(STRINGTOOSHORT) is signaled. - - 4) If out does not have sufficient length to accommodate the - result of the substitution, the result will be truncated on - the right. - - 5) If the requested format is not supported, the error MAY be - diagnosed by routines in the call tree of this routine. - The current Fortran implementation defaults to F format - if the format is anything other than 'E'. - --Files - - None. - --Particulars - - This is one of a family of related routines for inserting values - into strings. They are typically to construct messages that - are partly fixed, and partly determined at run time. For example, - a message like - - "Fifty-one pictures were found in directory [USER.DATA]." - - might be constructed from the fixed string - - "#1 pictures were found in directory #2." - - by the calls - - repmct_c ( string, "#1", 51, 'c', LENOUT, string ); - repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string ); - - which substitute the cardinal text "Fifty-one" and the character - string "[USER.DATA]" for the markers "#1" and "#2" respectively. - - The complete list of routines is shown below. - - repmc_c ( Replace marker with character string value ) - repmd_c ( Replace marker with double precision value ) - repmf_c ( Replace marker with formatted d.p. value ) - repmi_c ( Replace marker with integer value ) - repmct_c ( Replace marker with cardinal text ) - repmot_c ( Replace marker with ordinal text ) - --Examples - - - 1. Let - - in == "Invalid duration value. The value was #." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmf_c ( in, "#", 5.0e3, 5, 'f', LENOUT, in ); - - in is - - "Invalid duration value. The value was 5000.0." - - - 2. Let - - in == "Left endpoint exceeded right endpoint. The left " - "endpoint was: XX. The right endpoint was: XX." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmf_c ( in, " XX ", -5.2d-9, 3, 'e', lenout, out ); - - out is - - "Left endpoint exceeded right endpoint. The left " - "endpoint was: -5.20E-09. The right endpoint was: XX." - - - 3. Let - - in == "Invalid quantity. The value was # units." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmf_c ( in, "#", 5.0e1, 3, 'f', LENOUT, in ); - - in is - - "Invalid quantity. The value was 50.0 units." - - - 4. In the above example, if sigdig is 1 instead of 3, in becomes - - "Invalid quantity. The value was 50. units." - - - 5. Let - - in == "Invalid duration value. The value was #." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmf_c ( in, "#", 5.0e1, 100, 'e', LENOUT, in ); - - in is - - "Invalid duration value. The value was " - "5.0000000000000E+01." - - Note that even though 100 digits of precision were requested, - only 14 were returned. - - - 6. Let - - marker == "&" - num == 23 - chance == "fair" - score == 4.665 - - Then following the sequence of calls, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmi_c ( "There are & routines that have a " - "& chance of meeting your needs. " - "The maximum score was &.", - marker, - num, - LENOUT, - msg ); - - repmc_c ( msg, marker, chance, LENOUT, msg ); - - repmf_c ( msg, marker, score, 4, 'f', LENOUT, msg ); - - msg is - - "There are 23 routines that have a fair chance of " - "meeting your needs. The maximum score was 4.665." - --Restrictions - - 1) The maximum number of significant digits returned is 14. - - 2) This routine makes explicit use of the format of the string - returned by dpstrf_; should that routine change, substantial - work may be required to bring this routine back up to snuff. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU) - --Index_Entries - - replace marker with formatted d.p. value - --& -*/ - -{ /* Begin repmf_c */ - - - /* - Local variables - */ - ConstSpiceChar * markPtr; - - - /* - Use discovery check-in. - - Make sure no string argument pointers are null. - */ - CHKPTR( CHK_DISCOVER, "repmf_c", in ); - CHKPTR( CHK_DISCOVER, "repmf_c", marker ); - CHKPTR( CHK_DISCOVER, "repmf_c", out ); - - - - /* - If the output string can't hold a terminating null character, - we can't proceed. - */ - if ( lenout < 1 ) - { - chkin_c ( "repmf_c" ); - setmsg_c ( "String length lenout must be >= 1; actual " - "value = #." ); - errint_c ( "#", lenout ); - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); - chkout_c ( "repmf_c" ); - return; - } - - - /* - If the output string has no room for data characters, we simply - terminate the string. - */ - if ( lenout == 1 ) - { - out[0] = NULLCHAR; - return; - } - - - /* - If the input string has zero length, the output is empty as well. - */ - if ( in[0] == NULLCHAR ) - { - out[0] = NULLCHAR; - - return; - } - - - /* - If the marker is empty, pass a blank marker to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( marker[0] == NULLCHAR ) - { - markPtr = " "; - } - else - { - markPtr = marker; - } - - - /* - Simply call the f2c'd routine. - */ - repmf_ ( ( char * ) in, - ( char * ) marker, - ( doublereal * ) &value, - ( integer * ) &sigdig, - ( char * ) &format, - ( char * ) out, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(markPtr), - ( ftnlen ) 1, - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, out ); - - -} /* End repmf_c */ diff --git a/ext/spice/src/cspice/repmi.c b/ext/spice/src/cspice/repmi.c deleted file mode 100644 index 6d29adae46..0000000000 --- a/ext/spice/src/cspice/repmi.c +++ /dev/null @@ -1,274 +0,0 @@ -/* repmi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPMI ( Replace marker with integer ) */ -/* Subroutine */ int repmi_(char *in, char *marker, integer *value, char *out, - ftnlen in_len, ftnlen marker_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - integer mrkpos; - char substr[11]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Replace a marker with an integer. */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* MARKER I Marker to be replaced. */ -/* VALUE I Replacement value. */ -/* OUT O Output string. */ -/* MAXLI P Maximum length of an integer. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* MARKER is an arbitrary character string. The first */ -/* occurrence of MARKER in the input string is */ -/* to be replaced by VALUE. */ - -/* Leading and trailing blanks in MARKER are NOT */ -/* significant. In particular, no substitution is */ -/* performed if MARKER is blank. */ - -/* VALUE is an arbitrary integer. */ - -/* $ Detailed_Output */ - -/* OUT is the string obtained by substituting the text */ -/* representation of VALUE for the first occurrence */ -/* of MARKER in the input string. */ - -/* OUT and IN must be identical or disjoint. */ - -/* $ Parameters */ - -/* MAXLI is the maximum expected length of the text */ -/* representation of an integer. 11 characters are */ -/* sufficient to hold any integer whose absolute */ -/* value is less than 10 billion. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If OUT does not have sufficient length to accommodate the */ -/* result of the substitution, the result will be truncated on */ -/* the right. */ - -/* 2) If MARKER is blank, or if MARKER is not a substring of IN, */ -/* no substitution is performed. (OUT and IN are identical.) */ - -/* $ Particulars */ - -/* This is one of a family of related routines for inserting values */ -/* into strings. They are typically to construct messages that */ -/* are partly fixed, and partly determined at run time. For example, */ -/* a message like */ - -/* 'Fifty-one pictures were found in directory [USER.DATA].' */ - -/* might be constructed from the fixed string */ - -/* '#1 pictures were found in directory #2.' */ - -/* by the calls */ - -/* CALL REPMCT ( STRING, '#1', N_PICS, 'C', STRING ) */ -/* CALL REPMC ( STRING, '#2', DIR_NAME, STRING ) */ - -/* which substitute the cardinal text 'Fifty-one' and the character */ -/* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */ - -/* The complete list of routines is shown below. */ - -/* REPMC ( Replace marker with character string value ) */ -/* REPMD ( Replace marker with double precision value ) */ -/* REPMF ( Replace marker with formatted d.p. value ) */ -/* REPMI ( Replace marker with integer value ) */ -/* REPMCT ( Replace marker with cardinal text) */ -/* REPMOT ( Replace marker with ordinal text ) */ - -/* $ Examples */ - -/* 1. Let */ - -/* IN = 'Invalid operation value. The value was #.' */ - -/* Then following the call, */ - -/* CALL REPMI ( IN, '#', 5, IN ) */ - -/* IN is */ - -/* 'Invalid operation value. The value was 5.' */ - - -/* 2. Let */ - -/* IN = 'Left endpoint exceeded right endpoint. */ -/* The left endpoint was: XX. The right */ -/* endpoint was: XX.' */ - -/* Then following the call, */ - -/* CALL REPMI ( IN, ' XX ', 5, OUT ) */ - -/* OUT is */ - -/* 'Left endpoint exceeded right endpoint. The left */ -/* endpoint was: 5. The right endpoint was: XX. */ - - -/* 3. Let */ - -/* NUM = 23 */ -/* CHANCE = 'fair' */ -/* SCORE = 4.665D0 */ - -/* Then following the sequence of calls, */ - -/* CALL REPMI ( 'There are & routines that have a ' // */ -/* . '& chance of meeting your needs.' // */ -/* . 'The maximum score was &.', */ -/* . '&', */ -/* . NUM, */ -/* . MSG ) */ - -/* CALL REPMC ( MSG, '&', CHANCE, MSG ) */ - -/* CALL REPMF ( MSG, '&', SCORE, 4, 'F', MSG ) */ - -/* MSG is */ - -/* 'There are 23 routines that have a fair chance of */ -/* meeting your needs. The maximum score was 4.665.' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-AUG-2002 (WLT) */ - -/* The routine is now error free. */ - -/* - 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, 30-AUG-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace marker with integer */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* If MARKER is blank, no substitution is possible. */ - - if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks). If MARKER is not */ -/* a substring of IN, no substitution can be performed. */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(in, marker + i__1, in_len, lastnb_(marker, marker_len) - - i__1); - if (mrkpos == 0) { - s_copy(out, in, out_len, in_len); - return 0; - } - -/* Okay, MARKER is non-blank and has been found. Convert the */ -/* integer to text, and substitute the text for the marker. */ - - intstr_(value, substr, (ftnlen)11); - i__1 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, marker_len); - zzrepsub_(in, &mrkpos, &i__1, substr, out, in_len, lastnb_(substr, ( - ftnlen)11), out_len); - return 0; -} /* repmi_ */ - diff --git a/ext/spice/src/cspice/repmi_c.c b/ext/spice/src/cspice/repmi_c.c deleted file mode 100644 index be22c91cb6..0000000000 --- a/ext/spice/src/cspice/repmi_c.c +++ /dev/null @@ -1,364 +0,0 @@ -/* - --Procedure repmi_c ( Replace marker with integer ) - --Abstract - - Replace a marker with an integer. - --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 - - CHARACTER - CONVERSION - STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void repmi_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - marker I Marker to be replaced. - value I Replacement value. - lenout I Available space in output string. - out O Output string. - MAXLI P Maximum length of an integer. - --Detailed_Input - - in is an arbitrary character string. - - marker is an arbitrary character string. The first occurrence - of marker in the input string is to be replaced by value. - - Leading and trailing blanks in marker are NOT significant. - In particular, no substitution is performed if marker - is blank. - - value is an arbitrary integer. - - - lenout is the allowed length of the output string. This length - must large enough to hold the output string plus the - terminator. If the output string is expected to have x - characters, lenout should be at least x + 1. - --Detailed_Output - - out is the string obtained by substituting the text - representation of value for the first occurrence - of marker in the input string. - - out and in must be identical or disjoint. - --Parameters - - MAXLI is the maximum expected length of the text - representation of an integer. 11 characters are - sufficient to hold any integer whose absolute - value is less than 10 billion. - - This routine assumes that the input integer - is such that its string representation contains - no more than MAXLI characters. - --Files - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if any of - the input or output string pointers is null. - - 2) If the marker string is blank or empty, this routine leaves - the input string unchanged, except that trailing blanks - will be trimmed. This case is not considered an error. - - 3) If the output string is too short to accommodate a terminating - null character, the error SPICE(STRINGTOOSHORT) is signaled. - - 4) If out does not have sufficient length to accommodate the - result of the substitution, the result will be truncated on - the right. - --Particulars - - This is one of a family of related routines for inserting values - into strings. They are typically to construct messages that - are partly fixed, and partly determined at run time. For example, - a message like - - "Fifty-one pictures were found in directory [USER.DATA]." - - might be constructed from the fixed string - - "#1 pictures were found in directory #2." - - by the calls - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 81 - . - . - . - repmct_c ( string, "#1", 51, 'c', LENOUT, string ); - repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string ); - - - which substitute the cardinal text "Fifty-one" and the character - string "[USER.DATA]" for the markers "#1" and "#2" respectively. - - The complete list of routines is shown below. - - repmc_c ( Replace marker with character string value ) - repmd_c ( Replace marker with double precision value ) - repmf_c ( Replace marker with formatted d.p. value ) - repmi_c ( Replace marker with integer value ) - repmct_c ( Replace marker with cardinal text ) - repmot_c ( Replace marker with ordinal text ) - - --Examples - - 1. Let - - in == "Invalid operation value. The value was ." - - Then following the call, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmi_c ( in, "", 5, LENOUT, outstr ); - - - outstr contains the string: - - "Invalid operation value. The value was 5." - - - - 2. Let - - in == "Left endpoint exceeded right endpoint. " - "The left endpoint was: XX. The right " - "endpoint was: XX." - - Then following the call, - - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmi_c ( in, " XX ", 5, LENOUT, out ); - - out is - - "Left endpoint exceeded right endpoint. The left " - "endpoint was: 5. The right endpoint was: XX." - - - 3. Let - - num == 23 - chance == "fair" - score == 4.665 - - Then following the sequence of calls, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmi_c ( "There are & routines that have a " - "& chance of meeting your needs." - "The maximum score was &.", - "&", - num, - LENOUT, - msg ); - - repmc_c ( msg, marker, chance, LENOUT, msg ); - - repmf_c ( msg, marker, score, 4, 'f', LENOUT, msg ); - - - msg is - - "There are 23 routines that have a fair chance of " - "meeting your needs. The maximum score was 4.665." - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU) - --Index_Entries - - replace marker with integer - --& -*/ - -{ /* Begin repmi_c */ - - - /* - Local variables - */ - ConstSpiceChar * markPtr; - - - /* - Use discovery check-in. - - Make sure no string argument pointers are null. - */ - CHKPTR( CHK_DISCOVER, "repmi_c", in ); - CHKPTR( CHK_DISCOVER, "repmi_c", marker ); - CHKPTR( CHK_DISCOVER, "repmi_c", out ); - - - /* - If the output string can't hold a terminating null character, - we can't proceed. - */ - if ( lenout < 1 ) - { - chkin_c ( "repmi_c" ); - setmsg_c ( "String length lenout must be >= 1; actual " - "value = #." ); - errint_c ( "#", lenout ); - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); - chkout_c ( "repmi_c" ); - return; - } - - - /* - If the output string has no room for data characters, we simply - terminate the string. - */ - if ( lenout == 1 ) - { - out[0] = NULLCHAR; - return; - } - - - /* - If the input string has zero length, the output is empty as well. - */ - if ( in[0] == NULLCHAR ) - { - out[0] = NULLCHAR; - - return; - } - - - /* - If the marker is empty, pass a blank marker to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( marker[0] == NULLCHAR ) - { - markPtr = " "; - } - else - { - markPtr = marker; - } - - /* - Simply call the f2c'd routine. - */ - repmi_ ( ( char * ) in, - ( char * ) markPtr, - ( integer * ) &value, - ( char * ) out, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(markPtr), - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, out ); - - -} /* End repmi_c */ diff --git a/ext/spice/src/cspice/repmot.c b/ext/spice/src/cspice/repmot.c deleted file mode 100644 index 5ff2bff5ec..0000000000 --- a/ext/spice/src/cspice/repmot.c +++ /dev/null @@ -1,344 +0,0 @@ -/* repmot.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure REPMOT ( Replace marker with ordinal text ) */ -/* Subroutine */ int repmot_(char *in, char *marker, integer *value, char * - case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, - ftnlen out_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen), - chkin_(char *, ftnlen), ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen), ljust_(char *, char *, - ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen); - char tmpcas[1]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int intord_(integer *, char *, ftnlen), repsub_( - char *, integer *, integer *, char *, char *, ftnlen, ftnlen, - ftnlen), setmsg_(char *, ftnlen); - integer mrkpos; - extern logical return_(void); - char ord[147]; - -/* $ Abstract */ - -/* Replace a marker with the text representation of an */ -/* ordinal number. */ - -/* $ 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 */ - -/* CHARACTER */ -/* CONVERSION */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* MARKER I Marker to be replaced. */ -/* VALUE I Ordinal value. */ -/* CASE I Case of replacement text. */ -/* OUT O Output string. */ -/* MAXLON P Maximum length of an ordinal number. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* MARKER is an arbitrary character string. The first */ -/* occurrence of MARKER in the input string is */ -/* to be replaced by the text representation of */ -/* the cardinal number VALUE. */ - -/* Leading and trailing blanks in MARKER are NOT */ -/* significant. In particular, no substitution is */ -/* performed if MARKER is blank. */ - -/* VALUE is an arbitrary integer. */ - -/* CASE indicates the case of the replacement text. */ -/* CASE may be any of the following: */ - -/* CASE Meaning Example */ -/* ---- ----------- ----------------------- */ -/* U, u Uppercase ONE HUNDRED FIFTY-THIRD */ - -/* L, l Lowercase one hundred fifty-third */ - -/* C, c Capitalized One hundred fifty-third */ - -/* $ Detailed_Output */ - -/* OUT is the string obtained by substituting the text */ -/* representation of the ordinal number VALUE for */ -/* the first occurrence of MARKER in the input string. */ - -/* OUT and IN must be identical or disjoint. */ - -/* $ Parameters */ - -/* MAXLON is the maximum expected length of any ordinal */ -/* text. 147 characters are sufficient to hold the */ -/* text representing any ordinal value whose */ -/* corresponding cardinal value is in the range */ - -/* ( -10**12, 10**12 ) */ - -/* An example of a number whose ordinal text */ -/* representation is of maximum length is */ - -/* - 777 777 777 777 */ -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If OUT does not have sufficient length to accommodate the */ -/* result of the substitution, the result will be truncated on */ -/* the right. */ - -/* 2) If MARKER is blank, or if MARKER is not a substring of IN, */ -/* no substitution is performed. (OUT and IN are identical.) */ - -/* 3) If the value of CASE is not recognized, the error */ -/* SPICE(INVALIDCASE) is signalled. OUT is not changed. */ - -/* $ Particulars */ - -/* This is one of a family of related routines for inserting values */ -/* into strings. They are typically to construct messages that */ -/* are partly fixed, and partly determined at run time. For example, */ -/* a message like */ - -/* 'The fifty-first picture was found in directory [USER.DATA].' */ - -/* might be constructed from the fixed string */ - -/* 'The #1 picture was found in directory #2.' */ - -/* by the calls */ - -/* CALL REPMOT ( STRING, '#1', N_PIC, 'L', STRING ) */ -/* CALL REPMC ( STRING, '#2', DIR_NAME, STRING ) */ - -/* which substitute the ordinal text 'Fifty-first' and the character */ -/* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */ - -/* The complete list of routines is shown below. */ - -/* REPMC ( Replace marker with character string value ) */ -/* REPMD ( Replace marker with double precision value ) */ -/* REPMF ( Replace marker with formatted d.p. value ) */ -/* REPMI ( Replace marker with integer value ) */ - -/* REPMCT ( Replace marker with cardinal text) */ -/* REPMOT ( Replace marker with ordinal text ) */ - -/* $ Examples */ - -/* The following examples illustrate the use of REPMOT to */ -/* replace a marker within a string with the ordinal text */ -/* corresponding to an integer. */ - -/* Uppercase */ -/* --------- */ - -/* Let */ - -/* MARKER = '#' */ -/* IN = 'INVALID COMMAND. # WORD WAS NOT RECOGNIZED.' */ - -/* Then following the call, */ - -/* CALL REPMOT ( IN, '#', 5, 'U', IN ) */ - -/* IN is */ - -/* 'INVALID COMMAND. FIFTH WORD WAS NOT RECOGNIZED.' */ - -/* Lowercase */ -/* --------- */ - -/* Let */ - -/* MARKER = ' XX ' */ -/* IN = 'The XX word of the XX sentence was misspelled.' */ - -/* Then following the call, */ - -/* CALL REPMOT ( IN, ' XX ', 5, 'L', OUT ) */ - -/* OUT is */ - -/* 'The fifth word of the XX sentence was misspelled.' */ - - -/* Capitalized */ -/* ----------- */ - -/* Let */ - -/* MARKER = ' XX ' */ -/* IN = 'Name: YY. Rank: XX.' */ - -/* Then following the calls, */ - -/* CALL REPMC ( IN, 'YY', 'Moriarty', OUT ) */ -/* CALL REPMOT ( OUT, 'XX', 1, 'C', OUT ) */ - -/* OUT is */ - -/* 'Name: Moriarty. Rank: First.' */ - -/* $ Restrictions */ - -/* 1) VALUE must be in the range accepted by subroutine INTORD. */ -/* This range is currently */ - -/* ( -10**12, 10**12 ) */ - -/* Note that the endpoints of the interval are excluded. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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, 30-AUG-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace marker with ordinal text */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REPMOT", (ftnlen)6); - } - -/* Bail out if CASE is not recognized. */ - - ljust_(case__, tmpcas, (ftnlen)1, (ftnlen)1); - ucase_(tmpcas, tmpcas, (ftnlen)1, (ftnlen)1); - if (*(unsigned char *)tmpcas != 'U' && *(unsigned char *)tmpcas != 'L' && - *(unsigned char *)tmpcas != 'C') { - setmsg_("Case (#) must be U, L, or C.", (ftnlen)28); - errch_("#", case__, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDCASE)", (ftnlen)18); - chkout_("REPMOT", (ftnlen)6); - return 0; - } - -/* If MARKER is blank, no substitution is possible. */ - - if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) { - s_copy(out, in, out_len, in_len); - chkout_("REPMOT", (ftnlen)6); - return 0; - } - -/* Locate the leftmost occurrence of MARKER, if there is one */ -/* (ignoring leading and trailing blanks). If MARKER is not */ -/* a substring of IN, no substitution can be performed. */ - - i__1 = frstnb_(marker, marker_len) - 1; - mrkpos = i_indx(in, marker + i__1, in_len, lastnb_(marker, marker_len) - - i__1); - if (mrkpos == 0) { - s_copy(out, in, out_len, in_len); - chkout_("REPMOT", (ftnlen)6); - return 0; - } - -/* Okay, CASE is recognized and MARKER has been found. */ -/* Generate the ordinal text corresponding to VALUE. */ - - intord_(value, ord, (ftnlen)147); - -/* CARD is always returned in upper case; change to the specified */ -/* case, if required. */ - - if (*(unsigned char *)tmpcas == 'L') { - lcase_(ord, ord, (ftnlen)147, (ftnlen)147); - } else if (*(unsigned char *)tmpcas == 'C') { - lcase_(ord + 1, ord + 1, (ftnlen)146, (ftnlen)146); - } - -/* Replace MARKER with CARD. */ - - i__1 = mrkpos + lastnb_(marker, marker_len) - frstnb_(marker, marker_len); - repsub_(in, &mrkpos, &i__1, ord, out, in_len, lastnb_(ord, (ftnlen)147), - out_len); - chkout_("REPMOT", (ftnlen)6); - return 0; -} /* repmot_ */ - diff --git a/ext/spice/src/cspice/repmot_c.c b/ext/spice/src/cspice/repmot_c.c deleted file mode 100644 index bba7746f11..0000000000 --- a/ext/spice/src/cspice/repmot_c.c +++ /dev/null @@ -1,366 +0,0 @@ -/* - --Procedure repmot_c ( Replace marker with ordinal text ) - --Abstract - - Replace a marker with the text representation of an ordinal number. - --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 - - CHARACTER - CONVERSION - STRING - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void repmot_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar repcase, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - marker I Marker to be replaced. - value I Replacement value. - repcase I Case of replacement text. - lenout I Available space in output string. - out O Output string. - MAXLON P Maximum length of an ordinal number. - --Detailed_Input - - in is an arbitrary character string. - - marker is an arbitrary character string. The first - occurrence of marker in the input string is - to be replaced by the text representation of - the ordinal number value. - - Leading and trailing blanks in marker are not - significant. In particular, no substitution is - performed if marker is blank or empty. - - value is an arbitrary integer. - - repcase indicates the case of the replacement text. - repcase may be any of the following: - - repcase Meaning Example - ------- ----------- ----------------------- - U, u Uppercase ONE HUNDRED FIFTY-THREE - - L, l Lowercase one hundred fifty-three - - C, c Capitalized One hundred fifty-three - - lenout is the allowed length of the output string. This - length must large enough to hold the output string - plus the terminator. If the output string is - expected to have x characters, lenout should be at - least x + 1. --Detailed_Output - - out is the string obtained by substituting the text - representation of the ordinal number value for - the first occurrence of marker in the input string. - - out and in must be identical or disjoint. - --Parameters - - MAXLON is the maximum expected length of any ordinal - text. 147 characters are sufficient to hold the - text representing any ordinal value whose - corresponding ordinal value is in the range - - ( -10**12, 10**12 ) - - An example of a number whose ordinal text - representation is of maximum length is - - - 777 777 777 777 --Files - - None. - --Exceptions - - 1) The error SPICE(NULLPOINTER) is signaled if any of - the input or output string pointers is null. - - 2) If the marker string is blank or empty, this routine leaves - the input string unchanged, except that trailing blanks - will be trimmed. This case is not considered an error. - - 3) If the output string is too short to accommodate a terminating - null character, the error SPICE(STRINGTOOSHORT) is signaled. - - 4) If out does not have sufficient length to accommodate the - result of the substitution, the result will be truncated on - the right. - - 5) If the value of repcase is not recognized, the error - will be diagnosed by routines in the call tree of this - routine. out is not changed. - --Particulars - - This is one of a family of related routines for inserting values - into strings. They are typically to construct messages that - are partly fixed, and partly determined at run time. For example, - a message like - - "The fifty-first picture was found in directory [USER.DATA]." - - might be constructed from the variable string - - "The #1 picture was found in directory #2." - - by the calls - - repmot_c ( string, "#1", 51, 'L', LENOUT, string ); - repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string ); - - which substitute the ordinal text "fifty-first" and the character - string "[USER.DATA]" for the markers "#1" and "#2" respectively. - - The complete list of routines is shown below. - - repmc_c ( Replace marker with character string value ) - repmd_c ( Replace marker with double precision value ) - repmf_c ( Replace marker with formatted d.p. value ) - repmi_c ( Replace marker with integer value ) - repmct_c ( Replace marker with cardinal text ) - repmot_c ( Replace marker with ordinal text ) - --Examples - - The following examples illustrate the use of repmot_c to - replace a marker within a string with the ordinal text - corresponding to an integer. - - Uppercase - --------- - - Let - - marker = "#" - in = "Invalid command. The # word was not recognized." - - Then following the call, - . - . - . - #define LENOUT 201 - . - . - . - repmot_c ( in, "#", 5, 'U', LENOUT, in ); - - in is - - "Invalid command. The FIFTH word was not recognized." - - Lowercase - --------- - - Let - - marker = " XX " - in = "The XX word of the XX sentence was misspelled." - - Then following the call, - - repmot_c ( in, " XX ", 5, 'L', LENOUT, out ); - - OUT is - - "The fifth word of the XX sentence was misspelled." - - - Capitalized - ----------- - - Let - - marker == " XX " - in == "Name: YY. Rank: XX." - - Then following the calls, - - #include "SpiceUsr.h" - . - . - . - #define LENOUT 201 - . - . - . - repmc_c ( in, "YY", "Moriarty", LENOUT, out ); - repmct_c ( out, "XX", 1, 'C', LENOUT, out ); - - out is - - "Name: Moriarty. Rank: First." - --Restrictions - - 1) value must be in the range accepted by subroutine intord_. - This range is currently - - ( -10**12, 10**12 ) - - Note that the endpoints of the interval are excluded. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU) - --Index_Entries - - replace marker with ordinal text - --& -*/ - -{ /* Begin repmot_c */ - - /* - Local variables - */ - ConstSpiceChar * markPtr; - - - /* - Use discovery check-in. - - Make sure no string argument pointers are null. - */ - CHKPTR( CHK_DISCOVER, "repmot_c", in ); - CHKPTR( CHK_DISCOVER, "repmot_c", marker ); - CHKPTR( CHK_DISCOVER, "repmot_c", out ); - - - /* - If the output string can't hold a terminating null character, - we can't proceed. - */ - if ( lenout < 1 ) - { - chkin_c ( "repmot_c" ); - setmsg_c ( "String length lenout must be >= 1; actual " - "value = #." ); - errint_c ( "#", lenout ); - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); - chkout_c ( "repmot_c" ); - return; - } - - - /* - If the output string has no room for data characters, we simply - terminate the string. - */ - if ( lenout == 1 ) - { - out[0] = NULLCHAR; - return; - } - - - /* - If the input string has zero length, the output is empty as well. - */ - if ( in[0] == NULLCHAR ) - { - out[0] = NULLCHAR; - - return; - } - - - /* - If the marker is empty, pass a blank marker to the f2c'd routine. - Otherwise, pass in the marker. - */ - if ( marker[0] == NULLCHAR ) - { - markPtr = " "; - } - else - { - markPtr = marker; - } - - /* - Simply call the f2c'd routine. - */ - repmot_ ( ( char * ) in, - ( char * ) markPtr, - ( integer * ) &value, - ( char * ) &repcase, - ( char * ) out, - ( ftnlen ) strlen(in), - ( ftnlen ) strlen(markPtr), - ( ftnlen ) 1, - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from Fortran to C style. - */ - F2C_ConvertStr ( lenout, out ); - - -} /* End repmot_c */ diff --git a/ext/spice/src/cspice/repsub.c b/ext/spice/src/cspice/repsub.c deleted file mode 100644 index fc715c506b..0000000000 --- a/ext/spice/src/cspice/repsub.c +++ /dev/null @@ -1,333 +0,0 @@ -/* repsub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure REPSUB ( Replace one substring with another ) */ -/* Subroutine */ int repsub_(char *in, integer *left, integer *right, char * - string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer next, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer inlen; - extern integer sumai_(integer *, integer *); - integer remain; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer strlen, outlen; - extern logical return_(void); - integer end, use[3]; - -/* $ Abstract */ - -/* Replace the substring (LEFT:RIGHT) with a string of any length. */ - -/* $ 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 */ - -/* ASSIGNMENT */ -/* CHARACTER */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* LEFT, */ -/* RIGHT I Ends of substring to be replaced. */ -/* STRING I Replacement string. */ -/* OUT O Resulting string. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* LEFT, */ -/* RIGHT are the ends of the substring to be replaced. */ -/* Legitimate substrings satisfy the following */ -/* conditions */ - -/* RIGHT > LEFT - 2 */ -/* LEFT > 1 */ -/* RIGHT < LEN(STRING) + 1 */ - -/* This allows users to refer to zero-length substrings */ -/* (null substrings) of IN. */ - -/* STRING is the replacement string. Essentially, the */ -/* substring (LEFT:RIGHT) is removed from the */ -/* input string, and STRING is inserted at the */ -/* point of removal. */ - -/* $ Detailed_Output */ - -/* OUT is the resulting string. OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If RIGHT is one less than LEFT, the substring to */ -/* replace will be the null substring. In this case, */ -/* STRING will be inserted between IN(:RIGHT) and IN(LEFT:). */ - -/* 2) If LEFT is smaller than one, the error SPICE(BEFOREBEGSTR) */ -/* is signalled. */ - -/* 3) If RIGHT is greater than the length of the input string, */ -/* the error SPICE(PASTENDSTR) is signalled. */ - -/* 4) If RIGHT is less than LEFT-1, the error SPICE(BADSUBSTR) */ -/* is signalled. */ - -/* 5) Whenever the output string is too small to hold the result, */ -/* the result is truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Ideally, replacement could be done with simple concatenation, */ - -/* OUT = IN(1:LEFT-1) // STRING // IN(RIGHT+1: ) */ - -/* but the Fortran 77 standard makes this illegal for strings of */ -/* unknown length. */ - -/* $ Examples */ - -/* A typical use for this routine might be to replace all */ -/* occurrences of one word in a string with another word. */ -/* For example, the following code fragment replaces every */ -/* occurrence of the word 'AND' with the word 'OR' in the */ -/* character string LINE. */ - -/* LEFT = WDINDX ( LINE, 'AND' ) */ - -/* DO WHILE ( LEFT .NE. 0 ) */ -/* CALL REPSUB ( LINE, LEFT, LEFT+2, 'OR', LINE ) */ -/* LEFT = WDINDX ( LINE, 'AND' ) */ -/* END DO */ - -/* This routine can also be used to insert substring between */ -/* two characters. Consider the string: */ - -/* IN = 'The defendent,, was found innocent.' */ - -/* to insert ' Emelda Marcos' between the first and second commas */ -/* determine the location of the pair ',,' */ - -/* RIGHT = POS ( IN, ',,', 1 ) */ -/* LEFT = RIGHT + 1 */ - -/* then */ - -/* CALL REPSUB ( IN, LEFT, RIGHT, ' Emelda Marcos', OUT ) */ - -/* The output (OUT) will have the value: */ - -/* 'The defendent, Emelda Marcos, was found innocent.' */ - -/* $ Restrictions */ - -/* The memory used by STRING and OUT must be disjoint. The memory */ -/* used by IN and OUT must be identical or disjoint. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 17-JUN-1999 (WLT) */ - -/* Fixed example code fragment. */ - -/* - 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, 24-AUG-1990 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* replace one substring with another substring */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("REPSUB", (ftnlen)6); - } - -/* Get the lengths of all the strings involved in this transaction. */ - - inlen = i_len(in, in_len); - strlen = i_len(string, string_len); - outlen = i_len(out, out_len); - -/* Reject bad inputs. */ - - if (*left < 1) { - setmsg_("REPSUB error: LEFT (#) must not be less than 1.", (ftnlen)47) - ; - errint_("#", left, (ftnlen)1); - sigerr_("SPICE(BEFOREBEGSTR)", (ftnlen)19); - chkout_("REPSUB", (ftnlen)6); - return 0; - } else if (*right > inlen) { - setmsg_("REPSUB error: RIGHT (#) must not exceed length of IN (#).", ( - ftnlen)57); - errint_("#", right, (ftnlen)1); - errint_("#", &inlen, (ftnlen)1); - sigerr_("SPICE(PASTENDSTR)", (ftnlen)17); - chkout_("REPSUB", (ftnlen)6); - return 0; - } else if (*right < *left - 1) { - setmsg_("REPSUB error: LEFT (#) must not exceed RIGHT+1 (# + 1). ", ( - ftnlen)56); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - sigerr_("SPICE(BADSUBSTR)", (ftnlen)16); - chkout_("REPSUB", (ftnlen)6); - return 0; - } - -/* Consider three separate sections: */ - -/* 1) The front of the original string. */ - -/* 2) The replacement string. */ - -/* 3) The end of the original string. */ - -/* Determine how much of each section to use in the output string. */ -/* REMAIN is the number of characters that will fit in the output */ -/* string. */ - - remain = outlen; -/* Computing MIN */ - i__1 = remain, i__2 = *left - 1; - use[0] = min(i__1,i__2); - remain -= use[0]; - use[1] = min(remain,strlen); - remain -= use[1]; -/* Computing MIN */ - i__1 = remain, i__2 = inlen - *right; - use[2] = min(i__1,i__2); - -/* Move the third section first. It gets moved back to front */ -/* or front to back, depending on whether the replacement string */ -/* is longer than the original substring. The main thing is to */ -/* avoid overwriting characters that have yet to be moved. */ - - end = sumai_(use, &c__3); - if (*left + strlen > *right) { - next = end; - for (i__ = use[2]; i__ >= 1; --i__) { - i__1 = *right + i__ - 1; - s_copy(out + (next - 1), in + i__1, (ftnlen)1, *right + i__ - - i__1); - --next; - } - } else { - next = *left + strlen; - i__1 = use[2]; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = *right + i__ - 1; - s_copy(out + (next - 1), in + i__2, (ftnlen)1, *right + i__ - - i__2); - ++next; - } - } - -/* The first two sections can be moved directly to the front of */ -/* the output string. */ - - next = 1; - i__1 = use[0]; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[next - 1] = *(unsigned char *)&in[i__ - 1]; - ++next; - } - i__1 = use[1]; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[next - 1] = *(unsigned char *)&string[i__ - 1]; - ++next; - } - -/* Pad with blanks, if the output string was not filled. */ - - if (end < outlen) { - i__1 = end; - s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1); - } - chkout_("REPSUB", (ftnlen)6); - return 0; -} /* repsub_ */ - diff --git a/ext/spice/src/cspice/reset.c b/ext/spice/src/cspice/reset.c deleted file mode 100644 index d29d3e13d0..0000000000 --- a/ext/spice/src/cspice/reset.c +++ /dev/null @@ -1,239 +0,0 @@ -/* reset.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static logical c_true = TRUE_; - -/* $Procedure RESET ( Reset Error Status ) */ -/* Subroutine */ int reset_(void) -{ - logical stat; - extern logical accept_(logical *), seterr_(logical *); - extern /* Subroutine */ int putlms_(char *, ftnlen), putsms_(char *, - ftnlen); - -/* $ Abstract */ - -/* Reset the SPICELIB error status to a value of "no error." */ -/* As a result, the status routine, FAILED, will return a value */ -/* of .FALSE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Please read the "required reading" first! */ - -/* The effects of this routine are: */ - -/* 1. The SPICELIB status is set to a value of "no error." */ - -/* 2. The long and short error messages are set to blank. */ - -/* 3. Setting of the long error message is re-enabled. */ - - -/* Subsequent to a call to RESET, references to the status */ -/* indicator function, FAILED, will return a value of .FALSE., */ -/* until an error is detected. */ - -/* This routine should be called in cases where one wishes */ -/* to attempt to continue processing after detection of an */ -/* error, and the 'RETURN' error action is being used. When */ -/* the error response action is set to 'RETURN', routines */ -/* that have external references, or that can */ -/* detect errors, return immediately upon entry when an */ -/* error condition exists. This prevents a program from */ -/* crashing, but does not allow for a recovery attempt. */ - -/* If one does wish to attempt to recover, */ -/* in general the procedure is to test for an error */ -/* condition, and if one exists, respond to the error */ -/* (by outputting diagnostic messages, for example). Next, */ -/* a call to RESET can be made. After resetting the */ -/* error status, the normal execution thread can be resumed. */ - -/* It is also appropriate to call this routine when the error */ -/* response action is 'REPORT', if one wishes to recover */ -/* from errors. */ - -/* $ Examples */ - -/* 1. In this example, we try to read a line from the file, */ -/* SPUD.DAT, using the toolkit routine, RDTEXT. */ -/* When FAILED indicates an error, we grab the short */ -/* error message and its explanation, using GETMSG (see), */ -/* log the messages using our user-defined routine, */ -/* USER_LOG (NOT a SPICELIB routine), reset the */ -/* status, and keep going. */ - -/* C */ -/* C We read a line from SPUD.DAT: */ -/* C */ - -/* CALL RDTEXT ( 'SPUD.DAT', LINE, EOF ) */ - -/* IF ( FAILED() ) THEN */ -/* C */ -/* C Oops! an error occurred during the read. */ -/* C Recover the short error message and its */ -/* C explanation, reset the error status, */ -/* C log the messages, and continue... */ -/* C */ - -/* CALL GETMSG ( 'SHORT' , SMSG ) */ -/* CALL GETMSG ( 'EXPLAIN' , EXPL ) */ - -/* CALL USER_LOG ( SMSG ) */ -/* CALL USER_LOG ( EXPL ) */ - -/* CALL RESET */ - -/* END IF */ - -/* $ Restrictions */ - -/* It can be dangerous to call this routine without */ -/* RESPONDING to the error condition first; by calling */ -/* RESET, you are wiping out the SPICELIB's knowledge of */ -/* the error. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 14-MAR-1996 (KRG) */ - -/* Removed the call to FREEZE at the end of this subroutine. */ -/* The call had no effect other than to copy the current */ -/* stack in the trace package from the active stack into the */ -/* frozen stack. The frozen stack could NEVER be accessed */ -/* after this copying action; the only time the frozen stack */ -/* could be accessed is when a program is executing in 'RETURN' */ -/* mode and FAILED is .TRUE., i.e. after an error has been */ -/* signalled, causing the active stack at the time of the */ -/* error to be copied to the frozen stack. So this copying */ -/* of the active stack on a RESET of the error handling */ -/* accomplishes nothing. */ - -/* References to the setting of the frozen traceback were */ -/* removed from the header as well. */ - -/* A missing Fortran RETURN statement was also added before the */ -/* END statement */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* reset error status */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables: */ - - -/* Executable Code: */ - -/* This odd-looking function reference resets the error */ -/* status to indicate "no error": */ - - stat = seterr_(&c_false); - -/* Wipe out the short and long error messages: */ - - putsms_(" ", (ftnlen)1); - putlms_(" ", (ftnlen)1); - -/* Allow long error message to be updated: */ - - stat = accept_(&c_true); - return 0; -} /* reset_ */ - diff --git a/ext/spice/src/cspice/reset_c.c b/ext/spice/src/cspice/reset_c.c deleted file mode 100644 index 32310ddd87..0000000000 --- a/ext/spice/src/cspice/reset_c.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - --Procedure reset_c ( Reset Error Status ) - --Abstract - - Reset the CSPICE error status to a value of "no error." - As a result, the status routine, failed_c, will return a value - of SPICEFALSE - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void reset_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - This routine does not detect any errors. - - However, this routine is part of the CSPICE error - handling mechanism. - --Files - - None. - --Particulars - - Please read the "required reading" first! - - The effects of this routine are: - - 1. The CSPICE status is set to a value of "no error." - - 2. The long and short error messages are set to blank. - - 3. Setting of the long error message is re-enabled. - - - Subsequent to a call to reset_c, references to the status - indicator function, failed_c, will return a value of SPICEFALSE, - until an error is detected. - - This routine should be called in cases where one wishes - to attempt to continue processing after detection of an - error, and the "RETURN" error action is being used. When - the error response action is set to "RETURN", routines - that have external references, or that can - detect errors, return immediately upon entry when an - error condition exists. This prevents a program from - crashing, but does not allow for a recovery attempt. - - If one does wish to attempt to recover, - in general the procedure is to test for an error - condition, and if one exists, respond to the error - (by outputting diagnostic messages, for example). Next, - a call to reset_c can be made. After resetting the - error status, the normal execution thread can be resumed. - - It is also appropriate to call this routine when the error - response action is "REPORT", if one wishes to recover - from errors. - --Examples - - 1. In this example, we try to read a line from the file, - SPUD.DAT, using the toolkit routine, rdtext_c. - When failed_c indicates an error, we grab the short - error message and its explanation, using getmsg_c (see), - log the messages using our user-defined routine, - USER_LOG (NOT a CSPICE routine), reset the - status, and keep going. - - /. - We read a line from SPUD.DAT: - ./ - - rdtext_c ( "SPUD.DAT", line, LENOUT, &eof ); - - if ( failed_c() ) - { - - /. - Oops! an error occurred during the read. - Recover the short error message and its - explanation, reset the error status, - log the messages, and continue... - ./ - - getmsg_c ( "SHORT" , LENOUT, short_mess ); - getmsg_c ( "EXPLAIN", LENOUT, explain_mess ); - - USER_LOG ( SMSG ); - USER_LOG ( EXPL ); - - reset_c(); - } - --Restrictions - - It can be dangerous to call this routine without - RESPONDING to the error condition first; by calling - reset_c, you are wiping out the CSPICE's knowledge of - the error. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.1, 25-MAR-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - reset error status - --& -*/ - - -{ /* Begin rest_c */ - - /* - Call the f2c'd Fortran routine. - */ - - reset_(); - - -} /* End reset_c */ diff --git a/ext/spice/src/cspice/return.c b/ext/spice/src/cspice/return.c deleted file mode 100644 index d9d01f9a31..0000000000 --- a/ext/spice/src/cspice/return.c +++ /dev/null @@ -1,274 +0,0 @@ -/* return.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RETURN ( Immediate Return Indicator ) */ -logical return_(void) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - extern logical failed_(void); - extern /* Subroutine */ int getact_(integer *); - integer action; - -/* $ Abstract */ - -/* True if SPICELIB routines should return immediately upon entry. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* The function returns the value, .TRUE., if and only if SPICELIB */ -/* routines should return immediately upon entry. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the value, .TRUE., if and only if SPICELIB */ -/* routines should return immediately upon entry. The criterion */ -/* for this is that the error response action is set to */ -/* 'RETURN', and an error condition exists. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Please read the "required reading" first! */ - -/* This routine can be referenced in non-toolkit code; in */ -/* fact, its use is encouraged. Its purpose is to signal */ -/* to the routine calling it that the caller should */ -/* return immediately. The reference to RETURN should */ -/* be the first executable line of the calling program. */ - -/* In 'RETURN' mode, SPICELIB routines */ -/* that have external references, or that can */ -/* detect errors, return immediately upon entry when an */ -/* error condition exists. They use RETURN to determine */ -/* when these conditions are met. Non--toolkit routines */ -/* can do the same. */ - -/* Additionally, when an error is signalled in 'RETURN' mode, */ -/* no further errors can be signalled until the error condition */ -/* is reset by a call to RESET. Calls to SIGERR simply have */ -/* no effect. Therefore, the error messages set in response */ -/* to the FIRST error that was detected will be saved until */ -/* RESET is called. These messages can be retrieved by */ -/* calls to GETMSG. */ - -/* There are a number of advantages to using this mechanism. */ -/* First, the likelihood of an error resulting in crash */ -/* in a different routine is greatly reduced. Second, */ -/* a program does not have to test the error status */ -/* (using a reference to FAILED) after each call to a toolkit */ -/* routine, but rather can make one test of status at the end */ -/* of a series of calls. See "Examples" below. */ - -/* See the subroutine ERRACT for definitions of the error action */ -/* codes. */ - -/* $ Examples */ - -/* 1. In this example, we show how to place a reference */ -/* to RETURN in your code: */ - -/* C */ -/* C No executable lines precede this one. */ -/* C */ -/* C Test whether to return before doing */ -/* C anything else. */ -/* C */ - -/* IF ( RETURN() ) RETURN */ - - -/* [ rest of code goes here] */ - -/* . */ -/* . */ -/* . */ - - -/* 2. Here's how one might code a sequence of calls */ -/* to routines with code that follows the pattern */ -/* given in example #1 above: */ - -/* . */ -/* . */ -/* . */ - -/* [ code may go here ] */ - -/* C */ -/* C We call routines A, B, and C; then we */ -/* C test for errors, using the SPICELIB error */ -/* C status indicator, FAILED: */ -/* C */ - -/* CALL A */ -/* CALL B */ -/* CALL C */ - -/* IF ( FAILED() ) THEN */ - -/* C */ -/* C If we're here, an error occurred. The */ -/* C error might have been detected by A, B, C, */ -/* C or by a routine called by one of them. */ -/* C Get the explanation of the short error message */ -/* C and output it using the routine, USER_OUT */ -/* C [USER_OUT is a fictitious routine]: */ -/* C */ - -/* CALL GETMSG ( 'EXPLAIN', MSG ) */ - -/* CALL USER_OUT ( MSG ) */ - -/* END IF */ - -/* [ rest of code goes here ] */ - -/* . */ -/* . */ -/* . */ - - - -/* $ Restrictions */ - -/* This routine has no effect unless the error action is 'RETURN'! */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of error action from a short character string to an */ -/* integer. This change is backwardly incompatible because the */ -/* type has changed. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* immediate return indicator */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of error action from a short character string to an */ -/* integer. This change is backwardly incompatible because the */ -/* type has changed. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Added parentheses to the declaration of RETURN. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* Define the mnemonic for the return action. */ - - -/* Local Variables */ - - -/* Immediate return is indicated only in 'RETURN' mode, */ -/* when an error condition is in effect: */ - - getact_(&action); - ret_val = action == 3 && failed_(); - return ret_val; -} /* return_ */ - diff --git a/ext/spice/src/cspice/return_c.c b/ext/spice/src/cspice/return_c.c deleted file mode 100644 index d28e12da7b..0000000000 --- a/ext/spice/src/cspice/return_c.c +++ /dev/null @@ -1,237 +0,0 @@ -/* - --Procedure return_c ( Immediate Return Indicator ) - --Abstract - - True if CSPICE routines should return immediately upon entry. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - SpiceBoolean return_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - The function returns the value, SPICETRUE, if and only if CSPICE - routines should return immediately upon entry. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the value, SPICETRUE, if and only if CSPICE - routines should return immediately upon entry. The criterion - for this is that the error response action is set to - "RETURN", and an error condition exists. - --Parameters - - None. - --Exceptions - - This routine does not detect any errors. - - However, this routine is part of the CSPICE error - handling mechanism. - --Files - - None. - --Particulars - - Please read the "required reading" first! - - This routine can be referenced in non-toolkit code; in - fact, its use is encouraged. Its purpose is to signal - to the routine calling it that the caller should - return immediately. The reference to return_c should - be the first executable line of the calling program. - - In "RETURN" mode, CSPICE routines - that have external references, or that can - detect errors, return immediately upon entry when an - error condition exists. They use return_c to determine - when these conditions are met. Non--toolkit routines - can do the same. - - Additionally, when an error is signalled in "RETURN" mode, - no further errors can be signalled until the error condition - is reset by a call to reset_c. Calls to SIGERR simply have - no effect. Therefore, the error messages set in response - to the FIRST error that was detected will be saved until - reset_c is called. These messages can be retrieved by - calls to getmsg_c. - - There are a number of advantages to using this mechanism. - First, the likelihood of an error resulting in crash - in a different routine is greatly reduced. Second, - a program does not have to test the error status - (using a reference to failed_c) after each call to a toolkit - routine, but rather can make one test of status at the end - of a series of calls. See "Examples" below. - - See the subroutine erract_c for definitions of the error action - codes. - --Examples - - 1. In this example, we show how to place a reference - to return_c in your code: - - /. - No executable lines precede this one. - - Test whether to return before doing - anything else. - ./ - - if ( return_c() ) - { - return; - } - - - [ rest of code goes here] - - . - . - . - - - 2. Here's how one might code a sequence of calls - to routines with code that follows the pattern - given in example #1 above: - - . - . - . - - [ code may go here ] - - /. - We call routines A, B, and C; then we - test for errors, using the CSPICE error - status indicator, failed_c: - ./ - - A(); - B(); - C(); - - if ( failed_c() ) - { - - /. - If we're here, an error occurred. The - error might have been detected by A, B, C, - or by a routine called by one of them. - Get the explanation of the short error message - and output it using the routine, user_out_c - [user_out_c is a fictitious routine]: - ./ - - getmsg_c ( "EXPLAIN", MSG ); - - user_out_c ( MSG ); - - } - - [ rest of code goes here ] - - . - . - . - --Restrictions - - This routine has no effect unless the error action is "RETURN"! - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - immediate return indicator - --& -*/ - -{ /* Begin return_c */ - - /* - Call the f2c'd Fortran routine and set the status. - */ - - if ( return_() ) - { - return SPICETRUE; - } - - else - { - return SPICEFALSE; - } - - -} /* End return_c */ - - diff --git a/ext/spice/src/cspice/rewind.c b/ext/spice/src/cspice/rewind.c deleted file mode 100644 index e58daad7b8..0000000000 --- a/ext/spice/src/cspice/rewind.c +++ /dev/null @@ -1,24 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#ifdef KR_headers -integer f_rew(a) alist *a; -#else -integer f_rew(alist *a) -#endif -{ - unit *b; - if(a->aunit>=MXUNIT || a->aunit<0) - err(a->aerr,101,"rewind"); - b = &f__units[a->aunit]; - if(b->ufd == NULL || b->uwrt == 3) - return(0); - if(!b->useek) - err(a->aerr,106,"rewind") - if(b->uwrt) { - (void) t_runc(a); - b->uwrt = 3; - } - rewind(b->ufd); - b->uend=0; - return(0); -} diff --git a/ext/spice/src/cspice/rjust.c b/ext/spice/src/cspice/rjust.c deleted file mode 100644 index 283dbada23..0000000000 --- a/ext/spice/src/cspice/rjust.c +++ /dev/null @@ -1,195 +0,0 @@ -/* rjust.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RJUST ( Right justify a character string ) */ -/* Subroutine */ int rjust_(char *input, char *output, ftnlen input_len, - ftnlen output_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer last, i__, first, start; - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - integer loc; - -/* $ Abstract */ - -/* Right justify a character 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 */ - -/* ASCII, CHARACTER, STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INPUT I Input character string. */ -/* OUTPUT O Output character string, right justified. */ - -/* $ Detailed_Input */ - -/* INPUT is the input character string. */ - -/* $ Detailed_Output */ - -/* OUTPUT is the output character string, right justified. */ -/* If INPUT is too large to fit into OUTPUT, it is */ -/* truncated on the left. */ - -/* OUTPUT may overwrite INPUT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Any trailing blanks in the input string are removed, and */ -/* the remaining string is copied to the output string. */ - -/* $ Examples */ - -/* The following examples should illustrate the use of RJUST. */ - -/* 'ABCDE ' becomes ' ABCDE' */ -/* 'AN EXAMPLE ' ' AN EXAMPLE' */ -/* ' AN EXAMPLE ' ' AN EXAMPLE' */ -/* ' ' ' ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* right justify a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 11-DEC-1989 (IMU) */ - -/* Did not work on Sun when INPUT and OUTPUT were */ -/* the same string, and where the initial and final */ -/* locations of the non-blank part of the string */ -/* overlapped. */ - -/* The solution is to move the characters one by one, */ -/* starting from the right side of the input string. */ -/* That way, nothing gets clobbered. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Blank string? It's all the same. */ - - if (s_cmp(input, " ", input_len, (ftnlen)1) == 0) { - s_copy(output, input, output_len, input_len); - -/* Get the first non-blank character. Start OUTPUT at that point. */ - - } else { - first = frstnb_(input, input_len); - last = lastnb_(input, input_len); - start = i_len(output, output_len) - (last - first); - -/* If the input string is too long (START < 1), move FIRST */ -/* up a little to truncate on the left. */ - - if (start < 1) { - first += 1 - start; - start = 1; - } - -/* Move the characters in reverse order, to keep from stomping */ -/* anything if the operation is being done in place. */ - - loc = i_len(output, output_len); - i__1 = first; - for (i__ = last; i__ >= i__1; --i__) { - *(unsigned char *)&output[loc - 1] = *(unsigned char *)&input[i__ - - 1]; - --loc; - } - -/* Clear the first part of OUTPUT, if necessary. */ - - if (start > 1) { - s_copy(output, " ", start - 1, (ftnlen)1); - } - } - return 0; -} /* rjust_ */ - diff --git a/ext/spice/src/cspice/rmaind.c b/ext/spice/src/cspice/rmaind.c deleted file mode 100644 index 2fc3606a56..0000000000 --- a/ext/spice/src/cspice/rmaind.c +++ /dev/null @@ -1,171 +0,0 @@ -/* rmaind.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RMAIND ( Remainder --- double precision ) */ -/* Subroutine */ int rmaind_(doublereal *num, doublereal *denom, doublereal * - q, doublereal *rem) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double d_int(doublereal *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal mynum; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal mydnom; - -/* $ Abstract */ - -/* Compute the integer quotient and non-negative remainder */ -/* of NUM and DENOM. */ - -/* $ 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 */ - -/* MATH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NUM I Numerator used to compute quotient and remainder. */ -/* DENOM I Denominator used to compute quotient and remainder. */ -/* Q O Integer portion of the quotient NUM/DENOM. */ -/* REM O Remainder of the quotient NUM/DENOM. */ - -/* $ Detailed_Input */ - -/* NUM is the numerator of a quotient */ - -/* DENOM is the denominator of a quotient */ - -/* $ Detailed_Output */ - -/* Q is the largest integer less than or equal to the */ -/* quotient NUM/DENOM */ - -/* REM is the remainder of the integer division NUM/DENOM */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If DENOM is zero, the error 'SPICE(DIVIDEBYZERO)' will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given the double precision inputs NUM and DENOM, this routine */ -/* finds double precision numbers Q and REM that satisfy the */ -/* following conditions: */ - -/* 1) NUM = DENOM * Q + REM */ - -/* 2) DENOM has integer value. */ - -/* 3) REM belongs to the half open interval [0, ABS(DENOM) ) */ - -/* This routine serves as a macro. In this way the code to perform */ -/* this task can be written and maintained in a single location. */ - -/* $ Examples */ - -/* One frequently needs to compute the ``Two pi modulus'' of a */ -/* number. For positive numbers the FORTRAN intrinsic mod */ -/* function works well. However, for negative numbers the */ -/* intrinsic will return a negative modulus. This routine */ -/* can be used to compute the positive two pi modulus (MOD2PI) for */ -/* any number X by the call: */ - -/* CALL RMAIND ( X, TWOPI(), I, MOD2PI ) */ - -/* $ Restrictions */ - -/* Arithmetic overflows are not trapped or detected by this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Compute the remainder of a double precision division */ - -/* -& */ - -/* Take care of the zero-denominator case first */ - - if (*denom == 0.) { - chkin_("RMAIND", (ftnlen)6); - setmsg_("Attempting to compute a quotient with a divide by zero.", ( - ftnlen)55); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("RMAIND", (ftnlen)6); - return 0; - } - mydnom = *denom; - mynum = *num; - d__1 = mynum / mydnom; - *q = d_int(&d__1); - *rem = mynum - *q * mydnom; - if (*rem < 0.) { - *q += -1.; - *rem += mydnom; - } - return 0; -} /* rmaind_ */ - diff --git a/ext/spice/src/cspice/rmaini.c b/ext/spice/src/cspice/rmaini.c deleted file mode 100644 index c2c87b2b29..0000000000 --- a/ext/spice/src/cspice/rmaini.c +++ /dev/null @@ -1,155 +0,0 @@ -/* rmaini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RMAINI ( Remainder --- integer ) */ -/* Subroutine */ int rmaini_(integer *num, integer *denom, integer *q, - integer *rem) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Compute the integer quotient and non-negative remainder */ -/* of NUM and DENOM. */ - -/* $ 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 */ - -/* MATH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NUM I Numerator used to compute quotient and remainder. */ -/* DENOM I Denominator used to compute quotient and remainder. */ -/* Q O Integer portion of the quotient NUM/DENOM. */ -/* REM O Remainder of the quotient NUM/DENOM. */ - -/* $ Detailed_Input */ - -/* NUM is the numerator of a quotient */ - -/* DENOM is the denominator of a quotient */ - -/* $ Detailed_Output */ - -/* Q is the largest integer less than or equal to the */ -/* quotient NUM/DENOM */ - -/* REM is the remainder of the integer division NUM/DENOM */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If DENOM is zero, the error 'SPICE(DIVIDEBYZERO)' will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given the integer inputs NUM and DENOM, this routine */ -/* finds integers Q and REM that satisfy the following conditions: */ - -/* 1) NUM = DENOM * Q + REM */ - -/* 2) REM is a non negative integer less than the absolute */ -/* value of DENOM. */ - -/* This routine serves as a macro. In this way the code to perform */ -/* this task can be written and maintained in a single location. */ - -/* $ Examples */ - -/* One frequently needs to compute the ``360 modulus'' of a */ -/* number. For positive numbers the FORTRAN intrinsic mod */ -/* function works well. However, for negative numbers the */ -/* intrinsic will return a negative modulus. This routine */ -/* can be used to compute the positive 360 pi modulus (MOD360) for */ -/* any integer I by the call: */ - -/* CALL RMAINI ( I, 360, Q, MOD360 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-DEC-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Compute the remainder of an integer division */ - -/* -& */ - -/* Take care of the zero-denominator case first */ - - if ((doublereal) (*denom) == 0.) { - chkin_("RMAINI", (ftnlen)6); - setmsg_("Attempting to compute a quotient with a divide by zero.", ( - ftnlen)55); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("RMAINI", (ftnlen)6); - return 0; - } - *q = *num / *denom; - *rem = *num - *denom * *q; - if (*rem < 0) { - --(*q); - *rem += *denom; - } - return 0; -} /* rmaini_ */ - diff --git a/ext/spice/src/cspice/rmdupc.c b/ext/spice/src/cspice/rmdupc.c deleted file mode 100644 index d8a4444a98..0000000000 --- a/ext/spice/src/cspice/rmdupc.c +++ /dev/null @@ -1,185 +0,0 @@ -/* rmdupc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RMDUPC ( Remove duplicates from a character array ) */ -/* Subroutine */ int rmdupc_(integer *nelt, char *array, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int shellc_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Remove duplicate elements from a character array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NELT I/O Number of elements in the array. */ -/* ARRAY I/O Input/output array. */ - -/* $ Detailed_Input */ - -/* NELT on input is the number of elements in the input */ -/* array. */ - -/* ARRAY on input contains zero or more elements, from which */ -/* all duplicate elements are to be removed. */ - -/* $ Detailed_Output */ - -/* NELT on output is the number of elements in the output */ -/* array. */ - -/* ARRAY on output contains the distinct elements of the */ -/* input array, sorted in increasing order. (Character */ -/* arrays are sorted according to the ASCII collating */ -/* sequence). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let the arrays C and I contain the following elements. */ - -/* NC = 7 NI = 5 */ -/* C(1) = 'Miranda' I(1) = 13 */ -/* C(2) = 'Ariel' I(2) = -13 */ -/* C(3) = 'Umbriel' I(3) = 0 */ -/* C(4) = 'Titania' I(4) = 1 */ -/* C(5) = 'Miranda' I(5) = 0 */ -/* C(6) = 'Oberon' */ -/* C(7) = 'Umbriel' */ - -/* Then following the calls */ - -/* CALL RMDUPC ( NC, C ) */ -/* CALL RMDUPI ( NI, I ) */ - -/* C and I contain the following. */ - -/* NC = 5 NI = 4 */ -/* C(1) = 'Ariel' I(1) = -13 */ -/* C(2) = 'Miranda' I(2) = 0 */ -/* C(3) = 'Oberon' I(3) = 1 */ -/* C(4) = 'Titania' I(4) = 13 */ -/* C(5) = 'Umbriel' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove duplicates from a character array */ - -/* -& */ - -/* Local variables */ - - -/* Proceed only if the array actualy contains more than one element. */ - - if (*nelt > 1) { - -/* Sort the array in place. */ - - shellc_(nelt, array, array_len); - -/* Drop duplicate entries. Compare adjacent entries, and move */ -/* duplicates forward. (Duplicates are now adjacent, because of */ -/* sorting.) */ - - j = 1; - i__1 = *nelt; - for (i__ = 2; i__ <= i__1; ++i__) { - if (s_cmp(array + (i__ - 1) * array_len, array + (i__ - 2) * - array_len, array_len, array_len) != 0) { - ++j; - s_copy(array + (j - 1) * array_len, array + (i__ - 1) * - array_len, array_len, array_len); - } - } - *nelt = j; - } - return 0; -} /* rmdupc_ */ - diff --git a/ext/spice/src/cspice/rmdupd.c b/ext/spice/src/cspice/rmdupd.c deleted file mode 100644 index 46fbc30506..0000000000 --- a/ext/spice/src/cspice/rmdupd.c +++ /dev/null @@ -1,179 +0,0 @@ -/* rmdupd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RMDUPD ( Remove duplicates from a double precision array ) */ -/* Subroutine */ int rmdupd_(integer *nelt, doublereal *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int shelld_(integer *, doublereal *); - -/* $ Abstract */ - -/* Remove duplicate elements from a double precision array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NELT I/O Number of elements in the array. */ -/* ARRAY I/O Input/output array. */ - -/* $ Detailed_Input */ - -/* NELT on input is the number of elements in the input */ -/* array. */ - -/* ARRAY on input contains zero or more elements, from which */ -/* all duplicate elements are to be removed. */ - -/* $ Detailed_Output */ - -/* NELT on output is the number of elements in the output */ -/* array. */ - -/* ARRAY on output contains the distinct elements of the */ -/* input array, sorted in increasing order. (Character */ -/* arrays are sorted according to the ASCII collating */ -/* sequence). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let the arrays C and I contain the following elements. */ - -/* NC = 7 NI = 5 */ -/* C(1) = 'Miranda' I(1) = 13 */ -/* C(2) = 'Ariel' I(2) = -13 */ -/* C(3) = 'Umbriel' I(3) = 0 */ -/* C(4) = 'Titania' I(4) = 1 */ -/* C(5) = 'Miranda' I(5) = 0 */ -/* C(6) = 'Oberon' */ -/* C(7) = 'Umbriel' */ - -/* Then following the calls */ - -/* CALL RMDUPC ( NC, C ) */ -/* CALL RMDUPI ( NI, I ) */ - -/* C and I contain the following. */ - -/* NC = 5 NI = 4 */ -/* C(1) = 'Ariel' I(1) = -13 */ -/* C(2) = 'Miranda' I(2) = 0 */ -/* C(3) = 'Oberon' I(3) = 1 */ -/* C(4) = 'Titania' I(4) = 13 */ -/* C(5) = 'Umbriel' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove duplicates from a d.p. array */ - -/* -& */ - -/* Local variables */ - - -/* Proceed only if the array actualy contains more than one element. */ - - if (*nelt > 1) { - -/* Sort the array in place. */ - - shelld_(nelt, array); - -/* Drop duplicate entries. Compare adjacent entries, and move */ -/* duplicates forward. (Duplicates are now adjacent, because of */ -/* sorting.) */ - - j = 1; - i__1 = *nelt; - for (i__ = 2; i__ <= i__1; ++i__) { - if (array[i__ - 1] != array[i__ - 2]) { - ++j; - array[j - 1] = array[i__ - 1]; - } - } - *nelt = j; - } - return 0; -} /* rmdupd_ */ - diff --git a/ext/spice/src/cspice/rmdupi.c b/ext/spice/src/cspice/rmdupi.c deleted file mode 100644 index 4ad3e1761c..0000000000 --- a/ext/spice/src/cspice/rmdupi.c +++ /dev/null @@ -1,179 +0,0 @@ -/* rmdupi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RMDUPI ( Remove duplicates from an integer array ) */ -/* Subroutine */ int rmdupi_(integer *nelt, integer *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int shelli_(integer *, integer *); - -/* $ Abstract */ - -/* Remove duplicate elements from an integer array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NELT I/O Number of elements in the array. */ -/* ARRAY I/O Input/output array. */ - -/* $ Detailed_Input */ - -/* NELT on input is the number of elements in the input */ -/* array. */ - -/* ARRAY on input contains zero or more elements, from which */ -/* all duplicate elements are to be removed. */ - -/* $ Detailed_Output */ - -/* NELT on output is the number of elements in the output */ -/* array. */ - -/* ARRAY on output contains the distinct elements of the */ -/* input array, sorted in increasing order. (Character */ -/* arrays are sorted according to the ASCII collating */ -/* sequence). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let the arrays C and I contain the following elements. */ - -/* NC = 7 NI = 5 */ -/* C(1) = 'Miranda' I(1) = 13 */ -/* C(2) = 'Ariel' I(2) = -13 */ -/* C(3) = 'Umbriel' I(3) = 0 */ -/* C(4) = 'Titania' I(4) = 1 */ -/* C(5) = 'Miranda' I(5) = 0 */ -/* C(6) = 'Oberon' */ -/* C(7) = 'Umbriel' */ - -/* Then following the calls */ - -/* CALL RMDUPC ( NC, C ) */ -/* CALL RMDUPI ( NI, I ) */ - -/* C and I contain the following. */ - -/* NC = 5 NI = 4 */ -/* C(1) = 'Ariel' I(1) = -13 */ -/* C(2) = 'Miranda' I(2) = 0 */ -/* C(3) = 'Oberon' I(3) = 1 */ -/* C(4) = 'Titania' I(4) = 13 */ -/* C(5) = 'Umbriel' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* remove duplicates from an integer array */ - -/* -& */ - -/* Local variables */ - - -/* Proceed only if the array actualy contains more than one element. */ - - if (*nelt > 1) { - -/* Sort the array in place. */ - - shelli_(nelt, array); - -/* Drop duplicate entries. Compare adjacent entries, and move */ -/* duplicates forward. (Duplicates are now adjacent, because of */ -/* sorting.) */ - - j = 1; - i__1 = *nelt; - for (i__ = 2; i__ <= i__1; ++i__) { - if (array[i__ - 1] != array[i__ - 2]) { - ++j; - array[j - 1] = array[i__ - 1]; - } - } - *nelt = j; - } - return 0; -} /* rmdupi_ */ - diff --git a/ext/spice/src/cspice/rotate.c b/ext/spice/src/cspice/rotate.c deleted file mode 100644 index d01b2f4a08..0000000000 --- a/ext/spice/src/cspice/rotate.c +++ /dev/null @@ -1,222 +0,0 @@ -/* rotate.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ROTATE ( Generate a rotation matrix ) */ -/* Subroutine */ int rotate_(doublereal *angle, integer *iaxis, doublereal * - mout) -{ - /* Initialized data */ - - static integer indexs[5] = { 3,1,2,3,1 }; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - double sin(doublereal), cos(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer temp; - doublereal c__, s; - integer i1, i2, i3; - -/* $ Abstract */ - -/* Calculate the 3x3 rotation matrix generated by a rotation */ -/* of a specified angle about a specified axis. This rotation */ -/* is thought of as rotating the coordinate system. */ - -/* $ 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 */ - -/* MATRIX, ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ANGLE I Angle of rotation (radians). */ -/* IAXIS I Axis of rotation (X=1, Y=2, Z=3). */ -/* MOUT O Resulting rotation matrix [ANGLE] */ -/* IAXIS */ -/* $ Detailed_Input */ - -/* ANGLE The angle given in radians, through which the rotation */ -/* is performed. */ - -/* IAXIS The index of the axis of rotation. The X, Y, and Z */ -/* axes have indices 1, 2 and 3 respectively. */ - -/* $ Detailed_Output */ - -/* MOUT Rotation matrix which describes the rotation of the */ -/* COORDINATE system through ANGLE radians about the */ -/* axis whose index is IAXIS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A rotation about the first, i.e. x-axis, is described by */ - -/* | 1 0 0 | */ -/* | 0 cos(theta) sin(theta) | */ -/* | 0 -sin(theta) cos(theta) | */ - -/* A rotation about the second, i.e. y-axis, is described by */ - -/* | cos(theta) 0 -sin(theta) | */ -/* | 0 1 0 | */ -/* | sin(theta) 0 cos(theta) | */ - -/* A rotation about the third, i.e. z-axis, is described by */ - -/* | cos(theta) sin(theta) 0 | */ -/* | -sin(theta) cos(theta) 0 | */ -/* | 0 0 1 | */ - -/* ROTATE decides which form is appropriate according to the value */ -/* of IAXIS. */ - -/* $ Examples */ - -/* If ROTATE is called from a FORTRAN program as follows: */ - -/* CALL ROTATE (PI/4, 3, MOUT) */ - -/* then MOUT will be given by */ - -/* | SQRT(2)/2 SQRT(2)/2 0 | */ -/* MOUT = |-SQRT(2)/2 SQRT(2)/2 0 | */ -/* | 0 0 1 | */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the axis index is not in the range 1 to 3 it will be */ -/* treated the same as that integer 1, 2, or 3 that is congruent */ -/* to it mod 3. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* generate a rotation matrix */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 3-JAN-1989 (WLT) */ - -/* Upgrade the routine to work with negative axis indexes. Also take */ -/* care of the funky way the indices (other than the input) were */ -/* obtained via the MOD function. It works but isn't as clear */ -/* (or fast) as just reading the axes from data. */ - -/* -& */ - - - -/* Get the sine and cosine of ANGLE */ - - s = sin(*angle); - c__ = cos(*angle); - -/* Get indices for axes. The first index is for the axis of rotation. */ -/* The next two axes follow in right hand order (XYZ). First get the */ -/* non-negative value of IAXIS mod 3 . */ - - temp = (*iaxis % 3 + 3) % 3; - i1 = indexs[(i__1 = temp) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", i__1, - "rotate_", (ftnlen)189)]; - i2 = indexs[(i__1 = temp + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "rotate_", (ftnlen)190)]; - i3 = indexs[(i__1 = temp + 2) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "rotate_", (ftnlen)191)]; - -/* Construct the rotation matrix */ - - mout[(i__1 = i1 + i1 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)196)] = 1.; - mout[(i__1 = i2 + i1 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)197)] = 0.; - mout[(i__1 = i3 + i1 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)198)] = 0.; - mout[(i__1 = i1 + i2 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)199)] = 0.; - mout[(i__1 = i2 + i2 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)200)] = c__; - mout[(i__1 = i3 + i2 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)201)] = -s; - mout[(i__1 = i1 + i3 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)202)] = 0.; - mout[(i__1 = i2 + i3 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)203)] = s; - mout[(i__1 = i3 + i3 * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "rotate_", (ftnlen)204)] = c__; - - return 0; -} /* rotate_ */ - diff --git a/ext/spice/src/cspice/rotate_c.c b/ext/spice/src/cspice/rotate_c.c deleted file mode 100644 index e6ad751128..0000000000 --- a/ext/spice/src/cspice/rotate_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure rotate_c ( Generate a rotation matrix ) - --Abstract - - Calculate the 3x3 rotation matrix generated by a rotation - of a specified angle about a specified axis. This rotation - is thought of as rotating the coordinate system. - --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 - - MATRIX, ROTATION - -*/ - - #include "SpiceZfc.h" - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - void rotate_c ( SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - angle I Angle of rotation (radians). - iaxis I Axis of rotation (X=1, Y=2, Z=3). - mout O Resulting rotation matrix [angle] - iaxis --Detailed_Input - - angle The angle given in radians, through which the rotation - is performed. - - iaxis The index of the axis of rotation. The X, Y, and Z - axes have indices 1, 2 and 3 respectively. - --Detailed_Output - - mout Rotation matrix which describes the rotation of the - COORDINATE system through angle radians about the - axis whose index is iaxis. - --Parameters - - None. - --Particulars - - A rotation about the first, i.e. x-axis, is described by - - | 1 0 0 | - | 0 cos(theta) sin(theta) | - | 0 -sin(theta) cos(theta) | - - A rotation about the second, i.e. y-axis, is described by - - | cos(theta) 0 -sin(theta) | - | 0 1 0 | - | sin(theta) 0 cos(theta) | - - A rotation about the third, i.e. z-axis, is described by - - | cos(theta) sin(theta) 0 | - | -sin(theta) cos(theta) 0 | - | 0 0 1 | - - rotate_c decides which form is appropriate according to the value - of IAXIS. - --Examples - - If rotate_c is called from a C program as follows: - - rotate_c ( pi_c()/4, 3, mout ); - - then mout will be given by - - | sqrt(2)/2 sqrt(2)/2 0 | - mout = |-sqrt(2)/2 sqrt(2)/2 0 | - | 0 0 1 | - --Restrictions - - None. - --Exceptions - - Error free. - - 1) If the axis index is not in the range 1 to 3 it will be - treated the same as that integer 1, 2, or 3 that is congruent - to it mod 3. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - generate a rotation matrix - --& -*/ - -{ /* Begin rotate_c */ - - /* - Local variables - */ - SpiceDouble loc_mat[3][3]; - - - /* - Call the f2c'd version of the routine. - */ - rotate_ ( (doublereal *) &angle, - (integer *) &iaxis, - (doublereal *) loc_mat ); - - /* - Transpose the output matrix to put it in row-major order. - */ - xpose_c ( loc_mat, loc_mat ); - - - /* - Set the output argument. - */ - MOVED ( loc_mat, 9, mout ); - - -} /* End rotate_c */ diff --git a/ext/spice/src/cspice/rotget.c b/ext/spice/src/cspice/rotget.c deleted file mode 100644 index e785630a4d..0000000000 --- a/ext/spice/src/cspice/rotget.c +++ /dev/null @@ -1,343 +0,0 @@ -/* rotget.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ROTGET (Frame get transformation) */ -/* Subroutine */ int rotget_(integer *infrm, doublereal *et, doublereal * - rotate, integer *outfrm, logical *found) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal tipm[9] /* was [3][3] */; - integer type__, i__, j; - extern /* Subroutine */ int zzdynrot_(integer *, integer *, doublereal *, - doublereal *, integer *), chkin_(char *, ftnlen), errch_(char *, - char *, ftnlen, ftnlen); - char versn[6]; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *); - extern logical failed_(void); - integer center; - extern /* Subroutine */ int tipbod_(char *, integer *, doublereal *, - doublereal *, ftnlen), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - tkfram_(integer *, doublereal *, integer *, logical *), ckfrot_( - integer *, doublereal *, doublereal *, integer *, logical *), - sigerr_(char *, ftnlen); - integer typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Find the rotation from a user specified frame to */ -/* another frame at a user specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRM I The integer code for a SPICE reference frame. */ -/* ET I An epoch in seconds past J2000. */ -/* ROTATE O A rotation matrix. */ -/* OUTFRM O The frame that ROTATE transforms INFRM to. */ -/* FOUND O TRUE if a rotation can be found. */ - -/* $ Detailed_Input */ - -/* INFRM is the SPICE id-code for some reference frame. */ - -/* ET is an epoch in ephemeris seconds past J2000 at */ -/* which the user wishes to retrieve a transformation */ -/* matrix. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3x3 matrix that transforms positions relative to */ -/* INFRM to positions relative to OUTFRM. (Assuming such */ -/* a rotation can be found.) */ - -/* OUTFRM is a reference frame. The 3x3 matrix ROTATE rotates */ -/* positions relative to INFRM to positions relative */ -/* to OUTFRM. */ -/* The positions transformation is achieved by */ -/* multiplying */ -/* ROTATE on the right by a position relative to INFRM. */ -/* This */ -/* is easily accomplished via the subroutine call */ -/* shown below. */ - -/* CALL MXV ( ROTATE, INPOS, OUTPOS ) */ - -/* FOUND is a logical flag indicating whether or not a */ -/* rotation matrix could be found from INFRM */ -/* to some other frame. If a rotation matrix */ -/* cannot be found OUTFRM will be set to zero, FOUND */ -/* will be set to FALSE and ROTATE will be returned */ -/* as the zero matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a rotation matrix cannot be located, then */ -/* FOUND will be set to FALSE, OUTFRM will be set to zero */ -/* and ROTATE will be set to the zero 3x3 matrix. */ - -/* 2) If the class of the requested frame is not recognized the */ -/* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a low level routine used for determining a chain of */ -/* position transformation matrices from one frame to another. */ - -/* $ Examples */ - -/* See FRMCHG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 02-MAR-2010 (NJB) */ - -/* Bug fix: frame ID rather than frame class ID */ -/* is now passed to dynamic frame evaluation */ -/* routine ZZDYNROT. Order of header sections was */ -/* corrected. */ - -/* - SPICELIB Version 2.0.0, 18-DEC-2004 (NJB) */ - -/* Added the new frame type 'DYN' to the list of frame */ -/* types recognized by ROTGET. */ - -/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a rotation matrix from a specified frame */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - s_copy(versn, "2.0.0", (ftnlen)6, (ftnlen)5); - *found = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ROTGET", (ftnlen)6); - -/* Get all the needed information about this frame. */ - - frinfo_(infrm, ¢er, &type__, &typeid, found); - if (! (*found)) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotate[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("rotate", i__1, "rotget_", (ftnlen)203)] = 0.; - } - } - chkout_("ROTGET", (ftnlen)6); - return 0; - } - if (type__ == 1) { - irfrot_(infrm, &c__1, rotate); - *found = TRUE_; - *outfrm = 1; - } else if (type__ == 2) { - tipbod_("J2000", &typeid, et, tipm, (ftnlen)5); - xpose_(tipm, rotate); - namfrm_("J2000", outfrm, (ftnlen)5); - *found = ! failed_(); - } else if (type__ == 3) { - ckfrot_(&typeid, et, rotate, outfrm, found); - } else if (type__ == 4) { - tkfram_(&typeid, rotate, outfrm, found); - } else if (type__ == 5) { - -/* Unlike the other frame classes, the dynamic frame evaluation */ -/* routine ZZDYNROT requires the input frame ID rather than the */ -/* dynamic frame class ID. ZZDYNROT also requires the center ID */ -/* we found via the FRINFO call. */ - zzdynrot_(infrm, ¢er, et, rotate, outfrm); - -/* The FOUND flag was set by FRINFO earlier; we don't touch */ -/* it here. If ZZDYNROT signaled an error, FOUND will be set */ -/* to .FALSE. at end of this routine. */ - - } else { - setmsg_("The reference frame # has class id-code #. This form of ref" - "erence frame is not supported in version # of ROTGET. You ne" - "ed to update your version of SPICELIB to the latest version " - "in order to support this frame. ", (ftnlen)211); - errint_("#", infrm, (ftnlen)1); - errint_("#", &type__, (ftnlen)1); - errch_("#", versn, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23); - chkout_("ROTGET", (ftnlen)6); - return 0; - } - if (failed_() || ! (*found)) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotate[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("rotate", i__1, "rotget_", (ftnlen)272)] = 0.; - } - } - *found = FALSE_; - } - chkout_("ROTGET", (ftnlen)6); - return 0; -} /* rotget_ */ - diff --git a/ext/spice/src/cspice/rotmat.c b/ext/spice/src/cspice/rotmat.c deleted file mode 100644 index d5874780ff..0000000000 --- a/ext/spice/src/cspice/rotmat.c +++ /dev/null @@ -1,238 +0,0 @@ -/* rotmat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure ROTMAT ( Rotate a matrix ) */ -/* Subroutine */ int rotmat_(doublereal *m1, doublereal *angle, integer * - iaxis, doublereal *mout) -{ - /* Initialized data */ - - static integer indexs[5] = { 3,1,2,3,1 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - double sin(doublereal), cos(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer temp; - doublereal c__; - integer i__; - doublereal s; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal prodm[9] /* was [3][3] */; - integer i1, i2, i3; - -/* $ Abstract */ - -/* ROTMAT applies a rotation of ANGLE radians about axis IAXIS to a */ -/* matrix. This rotation is thought of as rotating the coordinate */ -/* system. */ - -/* $ 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 */ - -/* MATRIX */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Matrix to be rotated. */ -/* ANGLE I Angle of rotation (radians). */ -/* IAXIS I Axis of rotation (X=1, Y=2, Z=3). */ -/* MOUT O Resulting rotated matrix [ANGLE] * M1 */ -/* IAXIS */ - -/* $ Detailed_Input */ - -/* M1 This is a matrix to which a rotation is to be applied. */ -/* In matrix algebra, the components of the matrix are */ -/* relevant in one particular coordinate system. Applying */ -/* ROTMAT changes the components of M1 so that they are */ -/* relevant to a rotated coordinate system. */ - -/* ANGLE The angle in radians through which the original */ -/* coordinate system is to be rotated. */ - -/* IAXIS An index for the axis of the original coordinate system */ -/* about which the rotation by ANGLE is to be performed. */ -/* IAXIS = 1,2 or 3 designates the x-, y- or z-axis, */ -/* respectively. */ - -/* $ Detailed_Output */ - -/* MOUT The matrix resulting from the application of the */ -/* specified rotation to the input matrix M1. If */ -/* [ANGLE] denotes the rotation matrix by ANGLE */ -/* IAXIS */ -/* radians about IAXIS, (refer to the routine ROTATE) then */ -/* MOUT is given by the following matrix equation: */ - -/* MOUT = [ANGLE] * M1 */ -/* IAXIS */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the axis index is not in the range 1 to 3 it will be */ -/* treated the same as that integer 1, 2, or 3 that is congruent */ -/* to it mod 3. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Suppose that to rotate a set of inertial axes to body fixed */ -/* axes, one must first roll the coordinate axes about the x-axis by */ -/* angle R to get x', y', z'. From this one must pitch about the y' */ -/* axis by angle P to get x'', y'', z''. And finally yaw the x'', */ -/* y'', z'' about the z'' axis by angle Y to obtain the */ -/* transformation to bodyfixed coordinates. If ID is the identity */ -/* matrix, then the following code fragment generates the */ -/* transformation from inertial to body fixed. */ - -/* CALL ROTMAT ( ID, R, 1, M1 ) */ -/* CALL ROTMAT ( M1, P, 2, M2 ) */ -/* CALL ROTMAT ( M2, Y, 3, TIBF ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* rotate a matrix */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 3-JAN-1989 (WLT) */ - -/* Upgrade the routine to work with negative axis indexes. Also take */ -/* care of the funky way the indices (other than the input) were */ -/* obtained via the MOD function. It works but isn't as clear */ -/* (or fast) as just reading the axes from data. */ - -/* -& */ - -/* Get the sine and cosine of ANGLE */ - - s = sin(*angle); - c__ = cos(*angle); - -/* Get indices for axes. The first index is for the axis of rotation. */ -/* The next two axes follow in right hand order (XYZ). First get the */ -/* non-negative value of IAXIS mod 3 . */ - - temp = (*iaxis % 3 + 3) % 3; - i1 = indexs[(i__1 = temp) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", i__1, - "rotmat_", (ftnlen)201)]; - i2 = indexs[(i__1 = temp + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "rotmat_", (ftnlen)202)]; - i3 = indexs[(i__1 = temp + 2) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "rotmat_", (ftnlen)203)]; - -/* Calculate the output matrix column by column */ - - for (i__ = 1; i__ <= 3; ++i__) { - prodm[(i__1 = i1 + i__ * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "prodm", i__1, "rotmat_", (ftnlen)208)] = m1[(i__2 = i1 + i__ - * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, "rotma" - "t_", (ftnlen)208)]; - prodm[(i__1 = i2 + i__ * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "prodm", i__1, "rotmat_", (ftnlen)209)] = c__ * m1[(i__2 = i2 - + i__ * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, - "rotmat_", (ftnlen)209)] + s * m1[(i__3 = i3 + i__ * 3 - 4) < - 9 && 0 <= i__3 ? i__3 : s_rnge("m1", i__3, "rotmat_", (ftnlen) - 209)]; - prodm[(i__1 = i3 + i__ * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "prodm", i__1, "rotmat_", (ftnlen)210)] = -s * m1[(i__2 = i2 - + i__ * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, - "rotmat_", (ftnlen)210)] + c__ * m1[(i__3 = i3 + i__ * 3 - 4) - < 9 && 0 <= i__3 ? i__3 : s_rnge("m1", i__3, "rotmat_", ( - ftnlen)210)]; - } - -/* Move the buffered matrix into MOUT. */ - - moved_(prodm, &c__9, mout); - - return 0; -} /* rotmat_ */ - diff --git a/ext/spice/src/cspice/rotmat_c.c b/ext/spice/src/cspice/rotmat_c.c deleted file mode 100644 index a369fb5209..0000000000 --- a/ext/spice/src/cspice/rotmat_c.c +++ /dev/null @@ -1,194 +0,0 @@ -/* - --Procedure rotmat_c ( Rotate a matrix ) - --Abstract - - rotmat_c applies a rotation of angle radians about axis iaxis to a - matrix. This rotation is thought of as rotating the coordinate - system. - --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 - - MATRIX, ROTATION - -*/ - - #include "SpiceZfc.h" - #include "SpiceUsr.h" - #undef rotmat_c - - - void rotmat_c ( ConstSpiceDouble m1[3][3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I Matrix to be rotated. - angle I Angle of rotation (radians). - iaxis I Axis of rotation (X=1, Y=2, Z=3). - mout O Resulting rotated matrix. - --Detailed_Input - - m1 This is a matrix to which a rotation is to be applied. - In matrix algebra, the components of the matrix are - relative to one particular coordinate system. Applying - rotmat_c changes the components of m1 so that they are - relative to a rotated coordinate system. - - angle The angle in radians through which the original - coordinate system is to be rotated. - - iaxis An index for the axis of the original coordinate system - about which the rotation by angle is to be performed. - iaxis = 1,2 or 3 designates the x-, y- or z-axis, - respectively. - --Detailed_Output - - mout The matrix resulting from the application of the - specified rotation to the input matrix m1. If - - [angle] - iaxis - - denotes the rotation matrix by angle radians about iaxis, - (see the Rotations Required Reading document) then mout is - given by the following matrix equation: - - mout = [angle] * m1 - iaxis - - mout can overwrite m1. - --Parameters - - None. - --Particulars - - None. - --Examples - - Suppose that to rotate the a set of inertial axes to body fixed - axes, one must first roll the coordinate axes about the x-axis by - angle r to get x', y', z'. From this one must pitch about the - y' axis by angle o to get x'', y'', z''. And finally yaw the - x'', y'', z'' about the z'' axis by angle y to obtain the - transformation to bodyfixed coordinates. If id is the identity - matrix, then the following code fragment generates the - transformation from interitial to body fixed. - - rotmat_c ( id, r, 1, m1 ); - rotmat_c ( m1, p, 2, m2 ); - rotmat_c ( m2, y, 3, tibf ); - --Restrictions - - None. - --Exceptions - - Error free. - - 1) If the axis index is not in the range 1 to 3 it will be - treated the same as that integer 1, 2, or 3 that is congruent - to it mod 3. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input matrix const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - rotate a matrix - --& -*/ - -{ /* Begin rotmat_c */ - - /* - Local variables - */ - SpiceDouble loc_mat[3][3]; - - - /* - Transpose the input matrix to put it in column-major order. - */ - xpose_c ( m1, loc_mat ); - - /* - Call the f2c'd version of the routine. Note that the Fortran version - ROTMAT works in place. - */ - rotmat_ ( (doublereal *) loc_mat, - (doublereal *) &angle, - (integer *) &iaxis, - (doublereal *) loc_mat ); - - /* - Transpose the output matrix to put it in row-major order. - */ - xpose_c ( loc_mat, mout ); - - -} /* End rotmat_c */ diff --git a/ext/spice/src/cspice/rotvec.c b/ext/spice/src/cspice/rotvec.c deleted file mode 100644 index 6244f524ce..0000000000 --- a/ext/spice/src/cspice/rotvec.c +++ /dev/null @@ -1,242 +0,0 @@ -/* rotvec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ROTVEC ( Transform a vector via a rotation ) */ -/* Subroutine */ int rotvec_(doublereal *v1, doublereal *angle, integer * - iaxis, doublereal *vout) -{ - /* Initialized data */ - - static integer indexs[5] = { 3,1,2,3,1 }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - double sin(doublereal), cos(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal temp[3], c__, s; - integer i1, i2, i3, tmp; - -/* $ Abstract */ - -/* Transform a vector to a new coordinate system rotated by ANGLE */ -/* radians about axis IAXIS. This transformation rotates V1 by */ -/* -ANGLE radians about the specified axis. */ - -/* $ 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 */ - -/* ROTATION */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector whose coordinate system is to be rotated. */ -/* ANGLE I Angle of rotation in radians. */ -/* IAXIS I Axis of rotation (X=1, Y=2, Z=3). */ -/* VOUT O Resulting vector [ANGLE] * V1 expressed in */ -/* IAXIS */ -/* the new coordinate system. */ - -/* $ Detailed_Input */ - -/* V1 This is a vector (typically representing a vector fixed */ -/* in inertial space) which is to be expressed in another */ -/* coordinate system. The vector remains fixed but the */ -/* coordinate system changes. */ - -/* ANGLE The angle given in radians, through which the rotation */ -/* is performed. */ - -/* IAXIS The index of the axis of rotation. The X, Y, and Z */ -/* axes have indices 1, 2 and 3 respectively. */ - -/* $ Detailed_Output */ - -/* VOUT This is the vector expressed in the new coordinate system */ -/* specified by the angle of rotation and axis. If */ -/* [ANGLE] represents the rotation matrix described by */ -/* IAXIS */ -/* the angle and axis, (refer to the routine ROTATE) */ -/* then VOUT = [ANGLE] * V1 */ -/* IAXIS */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the axis index is not in the range 1 to 3 it will be treated */ -/* the same as that integer 1, 2, or 3 that is congruent to it mod */ -/* 3. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A rotation about the first, i.e. x-axis, is described by */ - -/* | 1 0 0 | */ -/* | 0 cos(theta) sin(theta) | */ -/* | 0 -sin(theta) cos(theta) | */ - -/* A rotation about the second, i.e. y-axis, is described by */ - -/* | cos(theta) 0 -sin(theta) | */ -/* | 0 1 0 | */ -/* | sin(theta) 1 cos(theta) | */ - -/* A rotation about the third, i.e. z-axis, is described by */ - -/* | cos(theta) sin(theta) 0 | */ -/* | -sin(theta) cos(theta) 0 | */ -/* | 0 0 1 | */ - -/* ROTVEC decides which form is appropriate according to the value */ -/* of IAXIS and applies the rotation to the input vector. */ - -/* $ Examples */ - -/* Suppose that */ - -/* V1 = (1.414, 0, 0), ANGLE = PI/4, IAXIS = 3 */ - -/* then after calling ROTVEC according to */ - -/* CALL ROTVEC (V1, ANGLE, IAXIS, VOUT) */ - -/* VOUT will be equal to (1, -1, 0). */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.0.2, 04-OCT-1999 (NJB) */ - -/* Procedure line and abstract and were changed to dispel the */ -/* impression that the input vector is rotated by +ANGLE */ -/* radians about the specified axis. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* rotate a vector */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 4-JAN-1989 (WLT) */ - -/* Upgrade the routine to work with negative axis indexes. Also take */ -/* care of the funky way the indices (other than the input) were */ -/* obtained via the MOD function. It works but isn't as clear */ -/* (or fast) as just reading the axes from data. */ - -/* -& */ - -/* Get the sine and cosine of ANGLE */ - - s = sin(*angle); - c__ = cos(*angle); - -/* Get indices for axes. The first index is for the axis of rotation. */ -/* The next two axes follow in right hand order (XYZ). First get the */ -/* non-negative value of IAXIS mod 3 . */ - - tmp = (*iaxis % 3 + 3) % 3; - i1 = indexs[(i__1 = tmp) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", i__1, - "rotvec_", (ftnlen)215)]; - i2 = indexs[(i__1 = tmp + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "rotvec_", (ftnlen)216)]; - i3 = indexs[(i__1 = tmp + 2) < 5 && 0 <= i__1 ? i__1 : s_rnge("indexs", - i__1, "rotvec_", (ftnlen)217)]; - -/* The coordinate along the axis of rotation does not change. */ - - temp[0] = v1[(i__1 = i1 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("v1", i__1, - "rotvec_", (ftnlen)221)]; - temp[1] = c__ * v1[(i__1 = i2 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("v1", - i__1, "rotvec_", (ftnlen)222)] + s * v1[(i__2 = i3 - 1) < 3 && 0 - <= i__2 ? i__2 : s_rnge("v1", i__2, "rotvec_", (ftnlen)222)]; - temp[2] = -s * v1[(i__1 = i2 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("v1", - i__1, "rotvec_", (ftnlen)223)] + c__ * v1[(i__2 = i3 - 1) < 3 && - 0 <= i__2 ? i__2 : s_rnge("v1", i__2, "rotvec_", (ftnlen)223)]; - -/* Move the buffered vector to the output */ - - vout[(i__1 = i1 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vout", i__1, "rot" - "vec_", (ftnlen)227)] = temp[0]; - vout[(i__1 = i2 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vout", i__1, "rot" - "vec_", (ftnlen)228)] = temp[1]; - vout[(i__1 = i3 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vout", i__1, "rot" - "vec_", (ftnlen)229)] = temp[2]; - - return 0; -} /* rotvec_ */ - diff --git a/ext/spice/src/cspice/rotvec_c.c b/ext/spice/src/cspice/rotvec_c.c deleted file mode 100644 index c4bec2de97..0000000000 --- a/ext/spice/src/cspice/rotvec_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure rotvec_c ( Transform a vector via a rotation ) - --Abstract - - Transform a vector to a new coordinate system rotated by angle - radians about axis iaxis. This transformation rotates v1 by - -angle radians about the specified axis. - --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 - - ROTATION, VECTOR - -*/ - - #include "SpiceUsr.h" - #include - #undef rotvec_c - - - void rotvec_c ( ConstSpiceDouble v1 [3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble vout [3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector whose coordinate system is to be rotated. - angle I Angle of rotation in radians. - iaxis I Axis of rotation (X=1, Y=2, Z=3). - vout O Resulting vector [angle] * v1 expressed in - iaxis - the new coordinate system. vout can overwrite v1. - --Detailed_Input - - v1 This is a vector (typically representing a vector fixed - in inertial space) which is to be expressed in another - coordinate system. The vector remains fixed but the - coordinate system changes. - - angle The angle given in radians, through which the rotation - is performed. - - iaxis The index of the axis of rotation. The X, Y, and Z - axes have indices 1, 2 and 3 respectively. - --Detailed_Output - - vout This is the vector expressed in the new coordinate system - specified by the angle of rotation and axis. If - [angle] represents the rotation matrix described by - iaxis - the angle and axis, (refer to the routine ROTATE) - then vout = [angle] * v1 - iaxis - --Parameters - - None. - --Particulars - - A rotation about the first, i.e. x-axis, is described by - - | 1 0 0 | - | 0 cos(theta) sin(theta) | - | 0 -sin(theta) cos(theta) | - - A rotation about the second, i.e. y-axis, is described by - - | cos(theta) 0 -sin(theta) | - | 0 1 0 | - | sin(theta) 1 cos(theta) | - - A rotation about the third, i.e. z-axis, is described by - - | cos(theta) sin(theta) 0 | - | -sin(theta) cos(theta) 0 | - | 0 0 1 | - - rotvec_c decides which form is appropriate according to the value - of iaxis and applies the rotation to the input vector. - --Examples - - Suppose that - v1 = (1.414, 0, 0), angle = PI/4, iaxis = 3 - then after calling rotvec_c according to - - rotvec_c (v1, angle, iaxis, vout) - - vout will be equal to (1, -1, 0). - --Restrictions - - None - --Exceptions - - 1) If the axis index is not in the range 1 to 3 it will be treated - the same as that integer 1, 2, or 3 that is congruent to it mod - 3. - --Files - - None - --Author_and_Institution - - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.1.1, 04-OCT-1999 (NJB) - - Procedure line and abstract and were changed to dispel the - impression that the input vector is rotated by +angle - radians about the specified axis. - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - rotate a vector - --& -*/ - -{ /* Begin rotvec_c */ - - /* - Local constants - */ - - static SpiceInt indexs[5] = { 3,1,2,3,1 }; - - - /* - Local variables - */ - - SpiceDouble sn; - SpiceDouble cn; - SpiceDouble temp [3]; - - SpiceInt tmp; - SpiceInt i1; - SpiceInt i2; - SpiceInt i3; - - - /* Get the sine and cosine of angle */ - - sn = sin(angle); - cn = cos(angle); - - - /* - Get indices for axes. The first index is for the axis of rotation. - The next two axes follow in right hand order (XYZ). First get the - non-negative value of iaxis mod 3. - */ - - tmp = ( ( iaxis % 3 + 3) % 3 ); - i1 = indexs[tmp] - 1; - i2 = indexs[tmp + 1] - 1; - i3 = indexs[tmp + 2] - 1; - - - /* The coordinate along the axis of rotation does not change. */ - - temp[0] = v1[i1]; - temp[1] = cn * v1[i2] + sn * v1[i3]; - temp[2] =-sn * v1[i2] + cn * v1[i3]; - - - /* Move the buffered vector to the output */ - - vout[i1] = temp[0]; - vout[i2] = temp[1]; - vout[i3] = temp[2]; - - -} /* End rotvec_c */ diff --git a/ext/spice/src/cspice/rpd.c b/ext/spice/src/cspice/rpd.c deleted file mode 100644 index 9dfe3abc27..0000000000 --- a/ext/spice/src/cspice/rpd.c +++ /dev/null @@ -1,158 +0,0 @@ -/* rpd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RPD ( Radians per degree ) */ -doublereal rpd_(void) -{ - /* Initialized data */ - - static doublereal value = 0.; - - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double acos(doublereal); - -/* $ Abstract */ - -/* Return the number of radians per degree. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the number of radians per degree. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the number of radians per degree: pi/180. */ -/* The value of pi is determined by the ACOS function. That is, */ - -/* RPD = ACOS ( -1.D0 ) / 180.D0 */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The first time the function is referenced, the value is computed */ -/* as shown above. The value is saved, and returned directly upon */ -/* subsequent reference. */ - -/* $ Examples */ - -/* The code fragment below illustrates the use of RPD. */ - -/* C */ -/* C Convert all input angles to radians. */ -/* C */ -/* CLOCK = CLOCK * RPD() */ -/* CONE = CONE * RPD() */ -/* TWIST = TWIST * RPD() */ - -/* or equivalently, */ - -/* C */ -/* C Convert all input angles to radians. */ -/* C */ -/* CALL VPACK ( CLOCK, CONE, CCTWIST, ALBTGAM ) */ -/* CALL VSCL ( RPD(), ALBTGAM, ALBTGAM ) */ -/* CALL VUPACK ( ALBTGAM, CLOCK, CONE, CCTWIST ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* radians per degree */ - -/* -& */ - -/* Local variables */ - - -/* Initial values */ - - -/* What is there to say? */ - - if (value == 0.) { - value = acos(-1.) / 180.; - } - ret_val = value; - return ret_val; -} /* rpd_ */ - diff --git a/ext/spice/src/cspice/rpd_c.c b/ext/spice/src/cspice/rpd_c.c deleted file mode 100644 index 1a3f1fce79..0000000000 --- a/ext/spice/src/cspice/rpd_c.c +++ /dev/null @@ -1,137 +0,0 @@ -/* - --Procedure rpd_c ( Radians per degree ) - --Abstract - - Return the number of radians per degree. - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble rpd_c ( void ) - -/* - --Brief_I/O - - The function returns the number of radians per degree. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the number of radians per degree: pi/180. - The value of pi is determined by the ACOS function. That is, - - rpd = acos ( -1. ) / 180. - --Files - - None. - --Exceptions - - Error free. - --Particulars - - When the function is referenced, the value computed as shown - above is returned. - --Parameters - - None. - --Examples - - The code fragment below illustrates the use of rpd_c. - - /. Convert all angles to radians for output ./ - - clock *= rpd_c() - cone *= rpd_c() - twist *= rpd_c() - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - radians per degree - --& -*/ - - -{ /* Begin rpd_c */ - - /* - Local Variables - */ - - static SpiceDouble value = 0.; - - - if ( value == 0. ) - { - value = acos(-1.) / 180.; - } - - - return value; - -} /* End rpd_c */ - diff --git a/ext/spice/src/cspice/rquad.c b/ext/spice/src/cspice/rquad.c deleted file mode 100644 index 06aeaf8f3a..0000000000 --- a/ext/spice/src/cspice/rquad.c +++ /dev/null @@ -1,350 +0,0 @@ -/* rquad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure RQUAD ( Roots of a quadratic equation ) */ -/* Subroutine */ int rquad_(doublereal *a, doublereal *b, doublereal *c__, - doublereal *root1, doublereal *root2) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - doublereal discrm; - logical zeroed; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - doublereal con, lin, sqr; - -/* $ Abstract */ - -/* Find the roots of a quadratic equation. */ - -/* $ 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 */ - -/* MATH */ -/* POLYNOMIAL */ -/* ROOT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ - -/* A I Coefficient of quadratic term. */ -/* B I Coefficient of linear term. */ -/* C I Constant. */ -/* ROOT1 O Root built from positive discriminant term. */ -/* ROOT2 O Root built from negative discriminant term. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B, */ -/* C are the coefficients of a quadratic polynomial */ - -/* 2 */ -/* Ax + Bx + C. */ - -/* $ Detailed_Output */ - -/* ROOT1, */ -/* ROOT2 are the roots of the equation, */ - -/* 2 */ -/* Ax + Bx + C = 0. */ - - -/* ROOT1 and ROOT2 are both arrays of length 2. The */ -/* first element of each array is the real part of a */ -/* root; the second element contains the complex part */ -/* of the same root. */ - -/* When A is non-zero, ROOT1 represents the root */ - -/* _____________ */ -/* / 2 */ -/* - B + \/ B - 4AC */ -/* --------------------------- */ -/* 2A */ - - -/* and ROOT2 represents the root */ - -/* _____________ */ -/* / 2 */ -/* - B - \/ B - 4AC */ -/* --------------------------- . */ -/* 2A */ - - -/* When A is zero and B is non-zero, ROOT1 and ROOT2 */ -/* both represent the root */ - -/* - C / B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input coefficients A and B are both zero, the error */ -/* SPICE(DEGENERATECASE) is signalled. The output arguments */ -/* are not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* 1) Humor us and suppose we want to compute the "golden ratio." */ - -/* The quantity r is defined by the equation */ - -/* 1/r = r/(1-r), */ - -/* which is equivalent to */ - -/* 2 */ -/* r + r - 1 = 0. */ - -/* The following code frament does the job. */ - - -/* C */ -/* C Compute "golden ratio." The root we want, */ -/* C */ -/* C ___ */ -/* C / */ -/* C -1 + \/ 5 */ -/* C -----------, */ -/* C 2 */ -/* C */ -/* C */ -/* C is contained in ROOT1. */ -/* C */ - -/* CALL RQUAD ( 1.D0, 1.D0, -1.D0, ROOT1, ROOT2 ) */ - -/* PRINT *, 'The "golden ratio" is ', ROOT1(1) */ - - -/* 2) The equation, */ - -/* 2 */ -/* x + 1 = 0 */ - -/* can be solved by the code fragment */ - - -/* C */ -/* C Let's do one with imaginary roots just for fun. */ -/* C */ - -/* CALL RQUAD ( 1.D0, 0.D0, 1.D0, ROOT1, ROOT2 ) */ - -/* PRINT *, 'ROOT1 is ', ROOT1 */ -/* PRINT *, 'ROOT2 is ', ROOT2 */ - -/* The printed results will be something like: */ - - -/* ROOT1 is 0.000000000000000 1.000000000000000 */ -/* ROOT2 is 0.000000000000000 -1.000000000000000 */ - -/* $ Restrictions */ - -/* No checks for overflow of the roots are performed. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 10-JUL-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* roots of a quadratic equation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("RQUAD", (ftnlen)5); - } - -/* The degree of the equation is zero unless at least one of the */ -/* second or first degree coefficients is non-zero. */ - - if (*a == 0. && *b == 0.) { - setmsg_("Both 1st and 2nd degree coefficients are zero.", (ftnlen)46); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("RQUAD", (ftnlen)5); - return 0; - } - -/* If we can scale the coefficients without zeroing any of them out, */ -/* we will do so, to help prevent overflow. */ - -/* Computing MAX */ - d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__); - scale = max(d__1,d__2); - zeroed = *a != 0. && *a / scale == 0. || *b != 0. && *b / scale == 0. || * - c__ != 0. && *c__ / scale == 0.; - if (! zeroed) { - sqr = *a / scale; - lin = *b / scale; - con = *c__ / scale; - } else { - sqr = *a; - lin = *b; - con = *c__; - } - -/* If the second-degree coefficient is non-zero, we have a bona fide */ -/* quadratic equation, as opposed to a linear equation. */ - - if (sqr != 0.) { - -/* Compute the discriminant. */ - -/* Computing 2nd power */ - d__1 = lin; - discrm = d__1 * d__1 - sqr * 4. * con; - -/* A non-negative discriminant indicates that the roots are */ -/* real. */ - - if (discrm >= 0.) { - -/* The imaginary parts of both roots are zero. */ - - root1[1] = 0.; - root2[1] = 0.; - -/* We can take advantage of the fact that CON/SQR is the */ -/* product of the roots to improve the accuracy of the root */ -/* having the smaller magnitude. We compute the larger root */ -/* first and then divide CON/SQR by it to obtain the smaller */ -/* root. */ - - if (lin < 0.) { - -/* ROOT1 will contain the root of larger magnitude. */ - - root1[0] = (-lin + sqrt(discrm)) / (sqr * 2.); - root2[0] = con / sqr / root1[0]; - } else if (lin > 0.) { - -/* ROOT2 will contain the root of larger magnitude. */ - - root2[0] = (-lin - sqrt(discrm)) / (sqr * 2.); - root1[0] = con / sqr / root2[0]; - } else { - -/* The roots have the same magnitude. */ - - root1[0] = sqrt(discrm) / (sqr * 2.); - root2[0] = -root1[0]; - } - -/* The only other possibility is that the roots are complex. */ - - } else { - -/* The roots are complex conjugates, so they have equal */ -/* magnitudes. */ - - root1[0] = -lin / (sqr * 2.); - root1[1] = sqrt(-discrm) / (sqr * 2.); - root2[0] = root1[0]; - root2[1] = -root1[1]; - } - -/* If the second-degree coefficient is zero, we actually have a */ -/* linear equation. */ - - } else if (lin != 0.) { - root1[0] = -con / lin; - root1[1] = 0.; - -/* We set the second root equal to the first, rather than */ -/* leaving it undefined. */ - - moved_(root1, &c__2, root2); - } - chkout_("RQUAD", (ftnlen)5); - return 0; -} /* rquad_ */ - diff --git a/ext/spice/src/cspice/rquad_c.c b/ext/spice/src/cspice/rquad_c.c deleted file mode 100644 index 847de233bd..0000000000 --- a/ext/spice/src/cspice/rquad_c.c +++ /dev/null @@ -1,380 +0,0 @@ -/* - --Procedure rquad_c ( Roots of a quadratic equation ) - --Abstract - - Find the roots of a quadratic equation. - --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 - - MATH - POLYNOMIAL - ROOT - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void rquad_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble root1[2], - SpiceDouble root2[2] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - - a I Coefficient of quadratic term. - b I Coefficient of linear term. - c I Constant. - root1 O Root built from positive discriminant term. - root2 O Root built from negative discriminant term. - --Detailed_Input - - a, - b, - c are the coefficients of a quadratic polynomial - - 2 - ax + bx + c. - --Detailed_Output - - root1, - root2 are the roots of the equation, - - 2 - ax + bx + c = 0. - - - root1 and root2 are both arrays of length 2. The - first element of each array is the real part of a - root; the second element contains the complex part - of the same root. - - When a is non-zero, root1 represents the root - - _____________ - / 2 - - b + \/ b - 4ac - --------------------------- - 2a - - - and root2 represents the root - - _____________ - / 2 - - b - \/ b - 4ac - --------------------------- . - 2a - - - When a is zero and b is non-zero, root1 and root2 - both represent the root - - - c / b. - --Parameters - - None. - --Exceptions - - 1) If the input coefficients a and b are both zero, the error - SPICE(DEGENERATECASE) is signalled. The output arguments - are not modified. - --Files - - None. - --Particulars - - None. - --Examples - - 1) Humor us and suppose we want to compute the "golden ratio." - - The quantity r is defined by the equation - - 1/r = r/(1-r), - - which is equivalent to - - 2 - r + r - 1 = 0. - - The following code fragment does the job. - - - /. - Compute "golden ratio." The root we want, - - ___ - / - -1 + \/ 5 - -----------, - 2 - - - is contained in root1. - ./ - - - rquad_c ( 1., 1., -1., root1, root2 ); - - printf ( "The \"golden ratio\" is %f\n", root1[0] ); - - - 2) The equation, - - 2 - x + 1 = 0 - - can be solved by the code fragment - - - /. - Let's do one with imaginary roots just for fun. - ./ - - rquad_c ( 1., 0., 1., root1, root2 ); - - printf ( "root1 is %f %f\n", root1[0], root1[1] ); - printf ( "root2 is %f %f\n", root2[0], root2[1] ); - - - The printed results will be something like: - - root1 is 0.000000000000000 1.000000000000000 - root2 is 0.000000000000000 -1.000000000000000 - --Restrictions - - No checks for overflow of the roots are performed. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 13-JUN-1999 (NJB) - --Index_Entries - - roots of a quadratic equation - --& -*/ - -{ /* Begin rquad_c */ - - - /* - Local variables - */ - - SpiceBoolean zeroed; - - SpiceDouble con; - SpiceDouble discrm; - SpiceDouble lin; - SpiceDouble scale; - SpiceDouble sqr; - - - /* - Use discovery check-in. - */ - - - /* - The degree of the equation is zero unless at least one of the - second or first degree coefficients is non-zero. - */ - - if ( ( a == 0.0 ) && ( b == 0.0 ) ) - { - chkin_c ( "rquad_c" ); - setmsg_c ( "Both 1st and 2nd degree coefficients are zero." ); - sigerr_c ( "SPICE(DEGENERATECASE)" ); - chkout_c ( "rquad" ); - return; - } - - - /* - If we can scale the coefficients without zeroing any of them out, - we will do so, to help prevent overflow. - */ - - scale = MaxAbs ( a, b ); - scale = MaxAbs ( c, scale ); - - zeroed = ( ( a != 0. ) && ( a / scale == 0. ) ) - || ( ( b != 0. ) && ( b / scale == 0. ) ) - || ( ( c != 0. ) && ( c / scale == 0. ) ); - - - if ( !zeroed ) - { - sqr = a / scale; - lin = b / scale; - con = c / scale; - } - else - { - sqr = a; - lin = b; - con = c; - } - - - /* - If the second-degree coefficient is non-zero, we have a bona fide - quadratic equation, as opposed to a linear equation. - */ - - if ( sqr != 0. ) - { - /* - Compute the discriminant. - */ - discrm = lin*lin - 4.0 * sqr * con; - - - /* - A non-negative discriminant indicates that the roots are - real. - */ - - if ( discrm >= 0.0 ) - { - /* - The imaginary parts of both roots are zero. - */ - root1[1] = 0.; - root2[1] = 0.; - - /* - We can take advantage of the fact that con/sqr is the - product of the roots to improve the accuracy of the root - having the smaller magnitude. We compute the larger root - first and then divide con/sqr by it to obtain the smaller - root. - */ - - if ( lin < 0. ) - { - /* - root1 will contain the root of larger magnitude. - */ - - root1[0] = ( - lin + sqrt(discrm) ) / ( 2. * sqr ); - - root2[0] = ( con / sqr ) / root1[0]; - } - - else if ( lin > 0. ) - { - /* - ROOT2 will contain the root of larger magnitude. - */ - root2[0] = ( - lin - sqrt(discrm) ) / ( 2. * sqr ); - - root1[0] = ( con / sqr ) / root2[0]; - } - - else - { - /* - The roots have the same magnitude. - */ - root1[0] = sqrt( discrm ) / ( 2. * sqr ); - root2[0] = - root1[0]; - } - - } - - else - { - /* - The only other possibility is that the roots are complex. - - The roots are complex conjugates, so they have equal - magnitudes. - */ - root1[0] = -lin / ( 2. * sqr ); - root1[1] = sqrt( -discrm ) / ( 2. * sqr ); - - root2[0] = root1[0]; - root2[1] = -root1[1]; - } - - } - - else - { - /* - If the second-degree coefficient is zero, we actually have a - linear equation. - */ - - root1[0] = - con / lin; - root1[1] = 0.; - - /* - We set the second root equal to the first, rather than - leaving it undefined. - */ - MOVED ( root1, 2, root2 ); - } - - -} /* End rquad_c */ - diff --git a/ext/spice/src/cspice/rsfe.c b/ext/spice/src/cspice/rsfe.c deleted file mode 100644 index f95d4e45d7..0000000000 --- a/ext/spice/src/cspice/rsfe.c +++ /dev/null @@ -1,428 +0,0 @@ -/* --Procedure rsfe ( SPICE version of f2c library file rsfe.c ) - --Abstract - - This file replaces the standard f2c rsfe.c library file. The functions - below contain modifications to enable proper reading of non-native - text files. - --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 - - kernel reader non-native - -*/ - -#include "f2c.h" -#include "fio.h" -#include "fmt.h" - -/* - The variable read_non_native is set via the function zzsetnnread_. - This variable has file scope; functions in this file use it - to decide whether to handle non-native line termination. - The functions rdknew_ and rdkdat_ should turn on non-native - line termination handling before calling rdtext_ and turn this - feature off immediately after rdtext_ returns. -*/ -static logical read_non_native = 0; - -logical zzcheckeol ( int ch ); -void zzsetnnread_( logical * on ); - -/* - --Brief_I/O - - None - --Detailed_Input - - None - --Detailed_Output - - None - --Parameters - - None - --Exceptions - - None. - --Files - - None - --Particulars - - The CSPICE implementation of the SPICE toolkit now includes the - capability to read text file containing non-native line terminators. NAIF - applied this capability only to the text kernel readers. - --Examples - - None - --Restrictions - - 1) Requires CSPICE f2c.h header file. Use this routine only as part - of the CSPICE library. - --Literature_References - --Author_and_Institution - - N. J. Bachman (JPL) - E. D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 28-SEP-2005 (EDW) - --Index_Entries - --& -*/ - -xrd_SL(Void) - { - - int ch; - - if(!f__curunit->uend) - { - - while ( !zzcheckeol( ch = getc(f__cf) ) ) - { - - if (ch == EOF) - { - f__curunit->uend = 1; - break; - } - - } - - } - - f__cursor=f__recpos=0; - - return(1); - } - - -x_getc(Void) - { - - int ch; - - if( f__curunit->uend) - { - return(EOF); - } - - ch = getc(f__cf); - - /* - Does 'ch' represent an end-of-file, a \n or \r? - If neither, return 'ch' to the caller. - */ - if(ch!=EOF && !zzcheckeol(ch) ) - { - f__recpos++; - return(ch); - } - - /* - 'ch' represents either a end-of-line or a newline, - return the platform native newline. - */ - if( zzcheckeol(ch) ) - { - (void) ungetc( '\n',f__cf); - return('\n'); - } - - if(f__curunit->uend || feof(f__cf)) - { - errno = 0; - f__curunit->uend = 1; - return(-1); - } - - return(-1); - - } - - -x_endp(Void) - { - xrd_SL(); - return f__curunit->uend == 1 ? EOF : 0; - } - -x_rev(Void) - { - (void) xrd_SL(); - return(0); - } - - -#ifdef KR_headers -integer s_rsfe(a) cilist *a; -#else -integer s_rsfe(cilist *a) -#endif - { - int n; - - if(!f__init) - { - f_init(); - } - - f__reading = 1; - f__sequential = 1; - f__formatted = 1; - f__external = 1; - - if(n=c_sfe(a)) - { - return(n); - } - - f__elist = a; - f__cursor=f__recpos = 0; - f__scale = 0; - f__fmtbuf = a->cifmt; - f__cf = f__curunit->ufd; - - if(pars_f(f__fmtbuf)<0) - { - err(a->cierr,100,"startio"); - } - - f__getn = x_getc; - f__doed = rd_ed; - f__doned = rd_ned; - - fmt_bg(); - - f__doend = x_endp; - f__donewrec = xrd_SL; - f__dorevert = x_rev; - f__cblank = f__curunit->ublnk; - f__cplus = 0; - - if( f__curunit->uwrt && f__nowreading(f__curunit) ) - { - err(a->cierr,errno,"read start"); - } - - if(f__curunit->uend) - { - err(f__elist->ciend,(EOF),"read start"); - } - - return(0); - } - - -logical zzcheckeol ( int ch ) - { - - if ( read_non_native ) - { - - /* - Handle non-native as well as native line terminators. - */ - if ( ( ch == '\n' ) || ( ch == '\r' ) ) - { - - /* - Treat the character 'ch' as a newline character. This - may result in extra blank lines being returned, but - this does not interfere with correct parsing of the - kernel. - */ - return 1; - - } - else - { - - /* - The character 'ch' does not represent a newline of any type. - */ - return 0; - - } - - } - else - { - - /* - Don't attempt to handle non-native line terminators. - Just indicate whether 'ch' is a line terminator. - */ - return ( (logical)( ch == '\n' ) ); - - } - - } - - - - - -/* - --Procedure zzsetnnread_( Set non-native text read state ) - - --Abstract - - The function zzsetnnread_ is the control mechanism for enabling - or disabling handling non-native line termination. All this - function does is set the value of 'read_non_native' to the - input value 'on'. - --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 - --Keywords - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - on I Logical indicating state to set function - --Detailed_Input - - on a file scoped scalar boolean used to control program flow - above in x_getc - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - None. - --Examples - - /. - Signal rdtext_ to read non-platform native text files. - ./ - zzsetnnread_(&c_true); - - rdtext_(kernel, first, &end, kernel_len, (ftnlen)80); - - /. - Reset rdtext_ to read only platform native text files. - ./ - zzsetnnread_(&c_false); - --Restrictions - - 1) Use this routine only as part of the CSPICE library. - --Literature_References - - None. - --Author_and_Institution - - N. J. Bachman (JPL) - E. D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 30-SEP-2005 (EDW) - --Index_Entries - --& -*/ - -void zzsetnnread_( logical * on ) - { - read_non_native = *on; - } - - - - - diff --git a/ext/spice/src/cspice/rsli.c b/ext/spice/src/cspice/rsli.c deleted file mode 100644 index a081cd589a..0000000000 --- a/ext/spice/src/cspice/rsli.c +++ /dev/null @@ -1,103 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "lio.h" -#include "fmt.h" /* for f__doend */ - -extern flag f__lquit; -extern int f__lcount; -extern char *f__icptr; -extern char *f__icend; -extern icilist *f__svic; -extern int f__icnum, f__recpos; - -static int i_getc(Void) -{ - if(f__recpos >= f__svic->icirlen) { - if (f__recpos++ == f__svic->icirlen) - return '\n'; - z_rnew(); - } - f__recpos++; - if(f__icptr >= f__icend) - return EOF; - return(*f__icptr++); - } - - static -#ifdef KR_headers -int i_ungetc(ch, f) int ch; FILE *f; -#else -int i_ungetc(int ch, FILE *f) -#endif -{ - if (--f__recpos == f__svic->icirlen) - return '\n'; - if (f__recpos < -1) - err(f__svic->icierr,110,"recend"); - /* *--icptr == ch, and icptr may point to read-only memory */ - return *--f__icptr /* = ch */; - } - - static void -#ifdef KR_headers -c_lir(a) icilist *a; -#else -c_lir(icilist *a) -#endif -{ - extern int l_eof; - f__reading = 1; - f__external = 0; - f__formatted = 1; - f__svic = a; - L_len = a->icirlen; - f__recpos = -1; - f__icnum = f__recpos = 0; - f__cursor = 0; - l_getc = i_getc; - l_ungetc = i_ungetc; - l_eof = 0; - f__icptr = a->iciunit; - f__icend = f__icptr + a->icirlen*a->icirnum; - f__cf = 0; - f__curunit = 0; - f__elist = (cilist *)a; - } - - -#ifdef KR_headers -integer s_rsli(a) icilist *a; -#else -integer s_rsli(icilist *a) -#endif -{ - f__lioproc = l_read; - f__lquit = 0; - f__lcount = 0; - c_lir(a); - f__doend = 0; - return(0); - } - -integer e_rsli(Void) -{ return 0; } - -#ifdef KR_headers -integer s_rsni(a) icilist *a; -#else -extern int x_rsne(cilist*); - -integer s_rsni(icilist *a) -#endif -{ - extern int nml_read; - integer rv; - cilist ca; - ca.ciend = a->iciend; - ca.cierr = a->icierr; - ca.cifmt = a->icifmt; - c_lir(a); - rv = x_rsne(&ca); - nml_read = 0; - return rv; - } diff --git a/ext/spice/src/cspice/rsne.c b/ext/spice/src/cspice/rsne.c deleted file mode 100644 index cc679c7608..0000000000 --- a/ext/spice/src/cspice/rsne.c +++ /dev/null @@ -1,609 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "lio.h" - -#define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */ -#define MAXDIM 20 /* maximum number of subscripts */ - - struct dimen { - ftnlen extent; - ftnlen curval; - ftnlen delta; - ftnlen stride; - }; - typedef struct dimen dimen; - - struct hashentry { - struct hashentry *next; - char *name; - Vardesc *vd; - }; - typedef struct hashentry hashentry; - - struct hashtab { - struct hashtab *next; - Namelist *nl; - int htsize; - hashentry *tab[1]; - }; - typedef struct hashtab hashtab; - - static hashtab *nl_cache; - static int n_nlcache; - static hashentry **zot; - static int colonseen; - extern ftnlen f__typesize[]; - - extern flag f__lquit; - extern int f__lcount, nml_read; - extern t_getc(Void); - -#ifdef KR_headers - extern char *malloc(), *memset(); - -#ifdef ungetc - static int -un_getc(x,f__cf) int x; FILE *f__cf; -{ return ungetc(x,f__cf); } -#else -#define un_getc ungetc - extern int ungetc(); -#endif - -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -#include "string.h" - -#ifdef ungetc - static int -un_getc(int x, FILE *f__cf) -{ return ungetc(x,f__cf); } -#else -#define un_getc ungetc -extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */ -#endif -#endif - - static Vardesc * -#ifdef KR_headers -hash(ht, s) hashtab *ht; register char *s; -#else -hash(hashtab *ht, register char *s) -#endif -{ - register int c, x; - register hashentry *h; - char *s0 = s; - - for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1) - x += c; - for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next) - if (!strcmp(s0, h->name)) - return h->vd; - return 0; - } - - hashtab * -#ifdef KR_headers -mk_hashtab(nl) Namelist *nl; -#else -mk_hashtab(Namelist *nl) -#endif -{ - int nht, nv; - hashtab *ht; - Vardesc *v, **vd, **vde; - hashentry *he; - - hashtab **x, **x0, *y; - for(x = &nl_cache; y = *x; x0 = x, x = &y->next) - if (nl == y->nl) - return y; - if (n_nlcache >= MAX_NL_CACHE) { - /* discard least recently used namelist hash table */ - y = *x0; - free((char *)y->next); - y->next = 0; - } - else - n_nlcache++; - nv = nl->nvars; - if (nv >= 0x4000) - nht = 0x7fff; - else { - for(nht = 1; nht < nv; nht <<= 1); - nht += nht - 1; - } - ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *) - + nv*sizeof(hashentry)); - if (!ht) - return 0; - he = (hashentry *)&ht->tab[nht]; - ht->nl = nl; - ht->htsize = nht; - ht->next = nl_cache; - nl_cache = ht; - memset((char *)ht->tab, 0, nht*sizeof(hashentry *)); - vd = nl->vars; - vde = vd + nv; - while(vd < vde) { - v = *vd++; - if (!hash(ht, v->name)) { - he->next = *zot; - *zot = he; - he->name = v->name; - he->vd = v; - he++; - } - } - return ht; - } - -static char Alpha[256], Alphanum[256]; - - static VOID -nl_init(Void) { - register char *s; - register int c; - - if(!f__init) - f_init(); - for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) - Alpha[c] - = Alphanum[c] - = Alpha[c + 'a' - 'A'] - = Alphanum[c + 'a' - 'A'] - = c; - for(s = "0123456789_"; c = *s++; ) - Alphanum[c] = c; - } - -#define GETC(x) (x=(*l_getc)()) -#define Ungetc(x,y) (*l_ungetc)(x,y) - - static int -#ifdef KR_headers -getname(s, slen) register char *s; int slen; -#else -getname(register char *s, int slen) -#endif -{ - register char *se = s + slen - 1; - register int ch; - - GETC(ch); - if (!(*s++ = Alpha[ch & 0xff])) { - if (ch != EOF) - ch = 115; - errfl(f__elist->cierr, ch, "namelist read"); - } - while(*s = Alphanum[GETC(ch) & 0xff]) - if (s < se) - s++; - if (ch == EOF) - err(f__elist->cierr, EOF, "namelist read"); - if (ch > ' ') - Ungetc(ch,f__cf); - return *s = 0; - } - - static int -#ifdef KR_headers -getnum(chp, val) int *chp; ftnlen *val; -#else -getnum(int *chp, ftnlen *val) -#endif -{ - register int ch, sign; - register ftnlen x; - - while(GETC(ch) <= ' ' && ch >= 0); - if (ch == '-') { - sign = 1; - GETC(ch); - } - else { - sign = 0; - if (ch == '+') - GETC(ch); - } - x = ch - '0'; - if (x < 0 || x > 9) - return 115; - while(GETC(ch) >= '0' && ch <= '9') - x = 10*x + ch - '0'; - while(ch <= ' ' && ch >= 0) - GETC(ch); - if (ch == EOF) - return EOF; - *val = sign ? -x : x; - *chp = ch; - return 0; - } - - static int -#ifdef KR_headers -getdimen(chp, d, delta, extent, x1) - int *chp; dimen *d; ftnlen delta, extent, *x1; -#else -getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) -#endif -{ - register int k; - ftnlen x2, x3; - - if (k = getnum(chp, x1)) - return k; - x3 = 1; - if (*chp == ':') { - if (k = getnum(chp, &x2)) - return k; - x2 -= *x1; - if (*chp == ':') { - if (k = getnum(chp, &x3)) - return k; - if (!x3) - return 123; - x2 /= x3; - colonseen = 1; - } - if (x2 < 0 || x2 >= extent) - return 123; - d->extent = x2 + 1; - } - else - d->extent = 1; - d->curval = 0; - d->delta = delta; - d->stride = x3; - return 0; - } - -#ifndef No_Namelist_Questions - static Void -#ifdef KR_headers -print_ne(a) cilist *a; -#else -print_ne(cilist *a) -#endif -{ - flag intext = f__external; - int rpsave = f__recpos; - FILE *cfsave = f__cf; - unit *usave = f__curunit; - cilist t; - t = *a; - t.ciunit = 6; - s_wsne(&t); - fflush(f__cf); - f__external = intext; - f__reading = 1; - f__recpos = rpsave; - f__cf = cfsave; - f__curunit = usave; - f__elist = a; - } -#endif - - static char where0[] = "namelist read start "; - -#ifdef KR_headers -x_rsne(a) cilist *a; -#else -x_rsne(cilist *a) -#endif -{ - int ch, got1, k, n, nd, quote, readall; - Namelist *nl; - static char where[] = "namelist read"; - char buf[64]; - hashtab *ht; - Vardesc *v; - dimen *dn, *dn0, *dn1; - ftnlen *dims, *dims1; - ftnlen b, b0, b1, ex, no, no1, nomax, size, span; - ftnint type; - char *vaddr; - long iva, ivae; - dimen dimens[MAXDIM], substr; - - if (!Alpha['a']) - nl_init(); - f__reading=1; - f__formatted=1; - got1 = 0; - top: - for(;;) switch(GETC(ch)) { - case EOF: - eof: - err(a->ciend,(EOF),where0); - case '&': - case '$': - goto have_amp; -#ifndef No_Namelist_Questions - case '?': - print_ne(a); - continue; -#endif - default: - if (ch <= ' ' && ch >= 0) - continue; -#ifndef No_Namelist_Comments - while(GETC(ch) != '\n') - if (ch == EOF) - goto eof; -#else - errfl(a->cierr, 115, where0); -#endif - } - have_amp: - if (ch = getname(buf,sizeof(buf))) - return ch; - nl = (Namelist *)a->cifmt; - if (strcmp(buf, nl->name)) -#ifdef No_Bad_Namelist_Skip - errfl(a->cierr, 118, where0); -#else - { - fprintf(stderr, - "Skipping namelist \"%s\": seeking namelist \"%s\".\n", - buf, nl->name); - fflush(stderr); - for(;;) switch(GETC(ch)) { - case EOF: - err(a->ciend, EOF, where0); - case '/': - case '&': - case '$': - if (f__external) - e_rsle(); - else - z_rnew(); - goto top; - case '"': - case '\'': - quote = ch; - more_quoted: - while(GETC(ch) != quote) - if (ch == EOF) - err(a->ciend, EOF, where0); - if (GETC(ch) == quote) - goto more_quoted; - Ungetc(ch,f__cf); - default: - continue; - } - } -#endif - ht = mk_hashtab(nl); - if (!ht) - errfl(f__elist->cierr, 113, where0); - for(;;) { - for(;;) switch(GETC(ch)) { - case EOF: - if (got1) - return 0; - err(a->ciend, EOF, where0); - case '/': - case '$': - case '&': - return 0; - default: - if (ch <= ' ' && ch >= 0 || ch == ',') - continue; - Ungetc(ch,f__cf); - if (ch = getname(buf,sizeof(buf))) - return ch; - goto havename; - } - havename: - v = hash(ht,buf); - if (!v) - errfl(a->cierr, 119, where); - while(GETC(ch) <= ' ' && ch >= 0); - vaddr = v->addr; - type = v->type; - if (type < 0) { - size = -type; - type = TYCHAR; - } - else - size = f__typesize[type]; - ivae = size; - iva = readall = 0; - if (ch == '(' /*)*/ ) { - dn = dimens; - if (!(dims = v->dims)) { - if (type != TYCHAR) - errfl(a->cierr, 122, where); - if (k = getdimen(&ch, dn, (ftnlen)size, - (ftnlen)size, &b)) - errfl(a->cierr, k, where); - if (ch != ')') - errfl(a->cierr, 115, where); - b1 = dn->extent; - if (--b < 0 || b + b1 > size) - return 124; - iva += b; - size = b1; - while(GETC(ch) <= ' ' && ch >= 0); - goto scalar; - } - nd = (int)dims[0]; - nomax = span = dims[1]; - ivae = iva + size*nomax; - colonseen = 0; - if (k = getdimen(&ch, dn, size, nomax, &b)) - errfl(a->cierr, k, where); - no = dn->extent; - b0 = dims[2]; - dims1 = dims += 3; - ex = 1; - for(n = 1; n++ < nd; dims++) { - if (ch != ',') - errfl(a->cierr, 115, where); - dn1 = dn + 1; - span /= *dims; - if (k = getdimen(&ch, dn1, dn->delta**dims, - span, &b1)) - errfl(a->cierr, k, where); - ex *= *dims; - b += b1*ex; - no *= dn1->extent; - dn = dn1; - } - if (ch != ')') - errfl(a->cierr, 115, where); - readall = 1 - colonseen; - b -= b0; - if (b < 0 || b >= nomax) - errfl(a->cierr, 125, where); - iva += size * b; - dims = dims1; - while(GETC(ch) <= ' ' && ch >= 0); - no1 = 1; - dn0 = dimens; - if (type == TYCHAR && ch == '(' /*)*/) { - if (k = getdimen(&ch, &substr, size, size, &b)) - errfl(a->cierr, k, where); - if (ch != ')') - errfl(a->cierr, 115, where); - b1 = substr.extent; - if (--b < 0 || b + b1 > size) - return 124; - iva += b; - b0 = size; - size = b1; - while(GETC(ch) <= ' ' && ch >= 0); - if (b1 < b0) - goto delta_adj; - } - if (readall) - goto delta_adj; - for(; dn0 < dn; dn0++) { - if (dn0->extent != *dims++ || dn0->stride != 1) - break; - no1 *= dn0->extent; - } - if (dn0 == dimens && dimens[0].stride == 1) { - no1 = dimens[0].extent; - dn0++; - } - delta_adj: - ex = 0; - for(dn1 = dn0; dn1 <= dn; dn1++) - ex += (dn1->extent-1) - * (dn1->delta *= dn1->stride); - for(dn1 = dn; dn1 > dn0; dn1--) { - ex -= (dn1->extent - 1) * dn1->delta; - dn1->delta -= ex; - } - } - else if (dims = v->dims) { - no = no1 = dims[1]; - ivae = iva + no*size; - } - else - scalar: - no = no1 = 1; - if (ch != '=') - errfl(a->cierr, 115, where); - got1 = nml_read = 1; - f__lcount = 0; - readloop: - for(;;) { - if (iva >= ivae || iva < 0) { - f__lquit = 1; - goto mustend; - } - else if (iva + no1*size > ivae) - no1 = (ivae - iva)/size; - f__lquit = 0; - if (k = l_read(&no1, vaddr + iva, size, type)) - return k; - if (f__lquit == 1) - return 0; - if (readall) { - iva += dn0->delta; - if (f__lcount > 0) { - no1 = (ivae - iva)/size; - if (no1 > f__lcount) - no1 = f__lcount; - iva += no1 * dn0->delta; - if (k = l_read(&no1, vaddr + iva, - size, type)) - return k; - } - } - mustend: - GETC(ch); - if (readall) - if (iva >= ivae) - readall = 0; - else for(;;) { - switch(ch) { - case ' ': - case '\t': - case '\n': - GETC(ch); - continue; - } - break; - } - if (ch == '/' || ch == '$' || ch == '&') { - f__lquit = 1; - return 0; - } - else if (f__lquit) { - while(ch <= ' ' && ch >= 0) - GETC(ch); - Ungetc(ch,f__cf); - if (!Alpha[ch & 0xff] && ch >= 0) - errfl(a->cierr, 125, where); - break; - } - Ungetc(ch,f__cf); - if (readall && !Alpha[ch & 0xff]) - goto readloop; - if ((no -= no1) <= 0) - break; - for(dn1 = dn0; dn1 <= dn; dn1++) { - if (++dn1->curval < dn1->extent) { - iva += dn1->delta; - goto readloop; - } - dn1->curval = 0; - } - break; - } - } - } - - integer -#ifdef KR_headers -s_rsne(a) cilist *a; -#else -s_rsne(cilist *a) -#endif -{ - extern int l_eof; - int n; - - f__external=1; - l_eof = 0; - if(n = c_le(a)) - return n; - if(f__curunit->uwrt && f__nowreading(f__curunit)) - err(a->cierr,errno,where0); - l_getc = t_getc; - l_ungetc = un_getc; - f__doend = xrd_SL; - n = x_rsne(a); - nml_read = 0; - if (n) - return n; - return e_rsle(); - } diff --git a/ext/spice/src/cspice/rtrim.c b/ext/spice/src/cspice/rtrim.c deleted file mode 100644 index 1518f03402..0000000000 --- a/ext/spice/src/cspice/rtrim.c +++ /dev/null @@ -1,164 +0,0 @@ -/* rtrim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure RTRIM ( Right trim ) */ -integer rtrim_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - - /* Local variables */ - extern integer lastnb_(char *, ftnlen); - -/* $ Abstract */ - -/* Return the maximum of 1 and the location of the last non-blank */ -/* character in the 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 */ - -/* CHARACTER */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ - -/* STRING I String to be trimmed. */ - -/* The function returns the maximum of 1 and the location of the */ -/* last non-blank character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is a string to be trimmed: the location of the */ -/* last non-blank character is desired. */ - -/* $ Detailed_Output */ - -/* The function returns the maximum of 1 and the location of the */ -/* last non-blank character in STRING. */ - -/* In particular, when STRING is blank, the function returns the */ -/* value 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* When writing a character string to a file, we usually are content */ -/* to omit the trailing blanks. We'd like to use LASTNB as an upper */ -/* substring bound, but we have to handle the case where LASTNB */ -/* returns 0, so we write: */ - - -/* WRITE ( UNIT, '(A)' ), STRING ( : MAX (1, LASTNB (STRING)) ) */ - - -/* This can be simplified using RTRIM: */ - - -/* WRITE ( UNIT, '(A)' ), STRING ( : RTRIM (STRING) ) ) */ - - -/* This routine has a counterpart, LTRIM, which finds the maximum of */ -/* 1 and the position of the first non-blank character of a string. */ - -/* $ Examples */ - -/* 1) Write the non-blank portion of each element of a character */ -/* cell to file SPUD.DAT: */ - -/* DO I = 1, CARDC (CELL) */ - -/* CALL WRLINE ( 'SPUD.DAT', */ -/* . CELL(I) ( LTRIM (CELL) : RTRIM (CELL) ) ) */ - -/* END DO */ - -/* When CELL(I) is blank, the string ' ' will be written. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 02-MAY-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* right trim */ - -/* -& */ - -/* SPICELIB functions */ - - -/* `Just do it'. */ - -/* Computing MAX */ - i__1 = 1, i__2 = lastnb_(string, string_len); - ret_val = max(i__1,i__2); - return ret_val; -} /* rtrim_ */ - diff --git a/ext/spice/src/cspice/s_cat.c b/ext/spice/src/cspice/s_cat.c deleted file mode 100644 index 038f0ecfbe..0000000000 --- a/ext/spice/src/cspice/s_cat.c +++ /dev/null @@ -1,75 +0,0 @@ -/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the - * target of a concatenation to appear on its right-hand side (contrary - * to the Fortran 77 Standard, but in accordance with Fortran 90). - */ - -#include "f2c.h" -#ifndef NO_OVERWRITE -#include "stdio.h" -#undef abs -#ifdef KR_headers - extern char *F77_aloc(); - extern void free(); - extern void exit_(); -#else -#undef min -#undef max -#include "stdlib.h" - extern char *F77_aloc(ftnlen, char*); -#endif -#include "string.h" -#endif /* NO_OVERWRITE */ - - VOID -#ifdef KR_headers -s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll; -#else -s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll) -#endif -{ - ftnlen i, nc; - char *rp; - ftnlen n = *np; -#ifndef NO_OVERWRITE - ftnlen L, m; - char *lp0, *lp1; - - lp0 = 0; - lp1 = lp; - L = ll; - i = 0; - while(i < n) { - rp = rpp[i]; - m = rnp[i++]; - if (rp >= lp1 || rp + m <= lp) { - if ((L -= m) <= 0) { - n = i; - break; - } - lp1 += m; - continue; - } - lp0 = lp; - lp = lp1 = F77_aloc(L = ll, "s_cat"); - break; - } - lp1 = lp; -#endif /* NO_OVERWRITE */ - for(i = 0 ; i < n ; ++i) { - nc = ll; - if(rnp[i] < nc) - nc = rnp[i]; - ll -= nc; - rp = rpp[i]; - while(--nc >= 0) - *lp++ = *rp++; - } - while(--ll >= 0) - *lp++ = ' '; -#ifndef NO_OVERWRITE - if (lp0) { - memcpy(lp0, lp1, L); - free(lp1); - } -#endif - } diff --git a/ext/spice/src/cspice/s_cmp.c b/ext/spice/src/cspice/s_cmp.c deleted file mode 100644 index 1e052f2864..0000000000 --- a/ext/spice/src/cspice/s_cmp.c +++ /dev/null @@ -1,44 +0,0 @@ -#include "f2c.h" - -/* compare two strings */ - -#ifdef KR_headers -integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb; -#else -integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb) -#endif -{ -register unsigned char *a, *aend, *b, *bend; -a = (unsigned char *)a0; -b = (unsigned char *)b0; -aend = a + la; -bend = b + lb; - -if(la <= lb) - { - while(a < aend) - if(*a != *b) - return( *a - *b ); - else - { ++a; ++b; } - - while(b < bend) - if(*b != ' ') - return( ' ' - *b ); - else ++b; - } - -else - { - while(b < bend) - if(*a == *b) - { ++a; ++b; } - else - return( *a - *b ); - while(a < aend) - if(*a != ' ') - return(*a - ' '); - else ++a; - } -return(0); -} diff --git a/ext/spice/src/cspice/s_copy.c b/ext/spice/src/cspice/s_copy.c deleted file mode 100644 index d1673510c6..0000000000 --- a/ext/spice/src/cspice/s_copy.c +++ /dev/null @@ -1,51 +0,0 @@ -/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the - * target of an assignment to appear on its right-hand side (contrary - * to the Fortran 77 Standard, but in accordance with Fortran 90), - * as in a(2:5) = a(4:7) . - */ - -#include "f2c.h" - -/* assign strings: a = b */ - -#ifdef KR_headers -VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; -#else -void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) -#endif -{ - register char *aend, *bend; - - aend = a + la; - - if(la <= lb) -#ifndef NO_OVERWRITE - if (a <= b || a >= b + la) -#endif - while(a < aend) - *a++ = *b++; -#ifndef NO_OVERWRITE - else - for(b += la; a < aend; ) - *--aend = *--b; -#endif - - else { - bend = b + lb; -#ifndef NO_OVERWRITE - if (a <= b || a >= bend) -#endif - while(b < bend) - *a++ = *b++; -#ifndef NO_OVERWRITE - else { - a += lb; - while(b < bend) - *--a = *--bend; - a += lb; - } -#endif - while(a < aend) - *a++ = ' '; - } - } diff --git a/ext/spice/src/cspice/s_paus.c b/ext/spice/src/cspice/s_paus.c deleted file mode 100644 index 796300bf7c..0000000000 --- a/ext/spice/src/cspice/s_paus.c +++ /dev/null @@ -1,88 +0,0 @@ -#include "stdio.h" -#include "f2c.h" -#define PAUSESIG 15 - -#include "signal1.h" -#ifdef KR_headers -#define Void /* void */ -#define Int /* int */ -#else -#define Void void -#define Int int -#undef abs -#undef min -#undef max -#include "stdlib.h" -#ifdef __cplusplus -extern "C" { -#endif -extern int getpid(void), isatty(int), pause(void); -#endif - -extern VOID f_exit(Void); - - static VOID -waitpause(Sigarg) -{ Use_Sigarg; - return; - } - - static VOID -#ifdef KR_headers -s_1paus(fin) FILE *fin; -#else -s_1paus(FILE *fin) -#endif -{ - fprintf(stderr, - "To resume execution, type go. Other input will terminate the job.\n"); - fflush(stderr); - if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) { - fprintf(stderr, "STOP\n"); -#ifdef NO_ONEXIT - f_exit(); -#endif - exit(0); - } - } - - int -#ifdef KR_headers -s_paus(s, n) char *s; ftnlen n; -#else -s_paus(char *s, ftnlen n) -#endif -{ - fprintf(stderr, "PAUSE "); - if(n > 0) - fprintf(stderr, " %.*s", (int)n, s); - fprintf(stderr, " statement executed\n"); - if( isatty(fileno(stdin)) ) - s_1paus(stdin); - else { -#ifdef MSDOS - FILE *fin; - fin = fopen("con", "r"); - if (!fin) { - fprintf(stderr, "s_paus: can't open con!\n"); - fflush(stderr); - exit(1); - } - s_1paus(fin); - fclose(fin); -#else - fprintf(stderr, - "To resume execution, execute a kill -%d %d command\n", - PAUSESIG, getpid() ); - signal1(PAUSESIG, waitpause); - fflush(stderr); - pause(); -#endif - } - fprintf(stderr, "Execution resumes after PAUSE.\n"); - fflush(stderr); - return 0; /* NOT REACHED */ -#ifdef __cplusplus - } -#endif -} diff --git a/ext/spice/src/cspice/s_rnge.c b/ext/spice/src/cspice/s_rnge.c deleted file mode 100644 index cdbb143e74..0000000000 --- a/ext/spice/src/cspice/s_rnge.c +++ /dev/null @@ -1,288 +0,0 @@ -/* --Procedure s_rnge (Array bounds overrun error response) - --Abstract - - Called when a subscript is out of range. - --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 - - None. - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - The f2c application library provides an option to add code to the f2c - converted routines to detect array overruns. When such an condition occurs, - the array check code executes this function. The f2c library s_rnge.c - streams an error message to stderr then executes an abort. This action - has proven inconvenient with CSPICE since the error output lacks a call - traceback. This version of s_rnge.c includes the error subsystem - traceback in output. - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.0, 03-APR-2009 (EDW) - - Rewrote routine to a NAIF format and to also output the SPICE error - subsystem call traceback. - - -CSPICE Version 1.0.0, 06-FEB-1999 (NJB) - - The statement - - return 0; - - for the normal C case was added to suppress compilation warnings. - --Index_Entries - - subscript index out-of-range - --& -*/ - -#include -#include -#include "SpiceUsr.h" -#include "SpiceZst.h" - - -/* -Undefine min and max macros to prevent a macro redefine warning -from the min and max defintions in f2c.h. -*/ -#undef min -#undef max - -#include "f2c.h" - -#define ERRLEN 32 -#define TRC_LEN 32 -#define MAXMOD 100 - - -/* -CSPICE routines cannot include both SpiceZfc.h and f2c.h. -Explicitly provide prototypes for the f2c library and -CSPICE routines. -*/ -VOID sig_die(char*,int); -int trcdep_(integer *depth); -int trcnam_(integer *index, char *name__, ftnlen name_len); - - -integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) - { - - SpiceChar errproc[ERRLEN]; - SpiceChar errvar [ERRLEN]; - SpiceChar trname [TRC_LEN]; - - /* - Define an error message string for the case if the trcdep_ - call returns a value larger than MAXMOD. - */ - SpiceChar * depth_err = "SPICE(BUG): The trcdep_ routine " - "returned a depth, %i, larger than the " - "maximum allowed depth, %i. This error should " - "never signal. Please contact NAIF.\n\n"; - - /* - Define the error message for the subscript/index out of range. - This string remains similar but not identical to the original - f2c error message. - */ - SpiceChar * index_err = "SPICE(BADSUBSCRIPT): Subscript out " - "of range on file line %ld, procedure " - "\"%s\". Attempt to access element %ld " - "of variable \"%s\".\n\n"; - - SpiceInt depth; - SpiceChar trlist[MAXMOD*TRC_LEN]; - - SpiceInt i; - SpiceInt j; - - (void) memset( trlist, 0, MAXMOD*TRC_LEN ); - - /* Set a loop counter for use as an index. */ - j = 0; - - /* - Extract from 'procn' the name of the routine executing when the error - occurred. - - Ensure the loop does not exceed ERRLEN. - */ - while((i = *procn) && i != '_' && i != ' ' && j < ERRLEN ) - { - errproc[j] = *procn++; - j++; - } - - /* - Properly terminate the 'errproc' string. - */ - errproc[j] = '\0'; - - /* Reset the loop counter for 'errvar' (error variable name). */ - j = 0; - - /* - Extract from 'varn' the name of the variable with the bad subscript. - - Ensure the loop does not exceed ERRLEN. - */ - while((i = *varn) && i != ' ' && j < ERRLEN ) - { - errvar[j] = *varn++; - j++; - } - - /* - Properly terminate the 'errvar' string. - */ - errvar[j] = '\0'; - - (void) fprintf(stderr, index_err, - (long)line, - errproc, - (long)(offset+1), - errvar ); - - /* - Create the traceback string so the user will have some information - describing the program flow leading to this error. - */ - - /* - Retrieve the depth of the call traceback stack. - */ - (void) trcdep_( &depth ); - - /* - Check 'depth' as less-than or equal-to MAXMOD. Output an error - if 'depth' greater-than MAXMOD. - */ - if ( depth > MAXMOD ) - { - (void) fprintf( stderr, depth_err, depth, MAXMOD ); - } - else - { - - /* - Loop over the number of items in the trace list. - Index starts at 1 as trcnam_ is an f2c'd routine. - */ - for ( i=1; i<= depth; i++) - { - - /* - Retrieve the name (as a FORTRAN string) of the ith routine's name - from the trace stack. No SPICE call name has a string length longer - than TRC_LEN characters. - */ - (void) trcnam_( (integer *) &i, trname, (ftnlen) TRC_LEN ); - - /* - The f2c code returns a FORTRAN type string, so null terminate - the string for C. - */ - F2C_ConvertStr( TRC_LEN, trname); - - /* - Create the trace list string by concatenation. Add '->' as a - marker between the routine names except on the first pass through - the loop. - */ - if ( i != 1 ) - { - (void) strcat( trlist, "->" ); - } - (void) strcat( trlist, trname ); - } - - (void) fprintf( stderr, "A traceback follows. The name of the " - "highest level module is first.\n%s", - trlist ); - - } - - sig_die("", 1); - - return 0; - - } - - diff --git a/ext/spice/src/cspice/s_stop.c b/ext/spice/src/cspice/s_stop.c deleted file mode 100644 index 6e858d497a..0000000000 --- a/ext/spice/src/cspice/s_stop.c +++ /dev/null @@ -1,52 +0,0 @@ -/* - 06-FEB-1999 (NJB) - - The statement - - return 0; - - for the normal C case was added to suppress compilation warnings. - -*/ - -#include "stdio.h" -#include "f2c.h" - -#ifdef KR_headers -extern void f_exit(); -VOID s_stop(s, n) char *s; ftnlen n; -#else -#undef abs -#undef min -#undef max -#include "stdlib.h" -#ifdef __cplusplus -extern "C" { -#endif -void f_exit(void); - -int s_stop(char *s, ftnlen n) -#endif -{ -int i; - -if(n > 0) - { - fprintf(stderr, "STOP "); - for(i = 0; i */ - -/* indicate the inner product of the vectors a and b. */ - -/* The semi-major and semi-minor axes of the input ellipse are */ -/* vectors of maximum and minimum norm in the set */ - -/* cos(x) VEC1 + sin(x) VEC2 */ - -/* where x is in the interval (-pi, pi]. */ - -/* The square of the norm of a vector in this set is */ - -/* 2 */ -/* || cos(x) VEC1 + sin(x) VEC2 || */ - - -/* = < cos(x)VEC1 + sin(x)VEC2, cos(x)VEC1 + sin(x)VEC2 > ; */ - -/* this last expression can be written as the matrix product */ - -/* T */ -/* X S X, (1) */ - -/* where X is the unit vector */ - -/* +- -+ */ -/* | cos(x) | */ -/* | | */ -/* | sin(x) | */ -/* +- -+ */ - -/* and S is the symmetric matrix */ - -/* +- -+ */ -/* | < VEC1, VEC1 > < VEC1, VEC2 > | */ -/* | |. */ -/* | < VEC1, VEC2 > < VEC2, VEC2 > | */ -/* +- -+ */ - -/* Because the 2x2 matrix above is symmetric, there exists a */ -/* rotation matrix that allows us to diagonalize it: */ - -/* T */ -/* C S C = D, */ - -/* where D is a diagonal matrix. Since rotation matrices are */ -/* orthogonal, we have */ - -/* T */ -/* C C = I. */ - -/* If the unit vector U is defined by */ - -/* T */ -/* U = C X, */ - -/* then */ - -/* T T T T T */ -/* X S X = ( U C ) C D C ( C U ) = U D U. */ - -/* So, letting */ - -/* +- -+ */ -/* | u | */ -/* | | = U, */ -/* | v | */ -/* +- -+ */ - -/* we may re-write the original quadratic expression (1) as */ - -/* +- -+ +- -+ +- -+ */ -/* | u v | | D1 0 | | u |, */ -/* +- -+ | | | | */ -/* | | | v | */ -/* | 0 D2 | +- -+ */ -/* +- -+ */ -/* or */ - -/* 2 2 */ -/* D1 u + D2 v, */ - -/* where the diagonal matrix above is D. The eigenvalues D1 and */ -/* D2 are non-negative because they are eigenvalues of a positive */ -/* semi-definite matrix of the form */ - -/* T */ -/* M M. */ - -/* We may require that */ - -/* D1 > D2; */ -/* - */ - -/* then the maximum and minimum values of */ - -/* 2 2 */ -/* D1 u + D2 v (2) */ - -/* are D1 and D2 respectively. These values are the squares */ -/* of the lengths of the semi-major and semi-minor axes of the */ -/* ellipse, since the expression (2) is the square of the norm */ -/* of the point */ - -/* cos(x) VEC1 + sin(x) VEC2. */ - -/* Now we must find some eigenvectors. Since the extrema of (2) */ -/* occur when */ - -/* +- -+ +- -+ */ -/* | 1 | | 0 | */ -/* U = | | or U = | |, */ -/* | 0 | | 1 | */ -/* +- -+ +- -+ */ - -/* and since */ - -/* X = C U, */ - -/* we conclude that the extrema occur when X = C1 or X = C2, where */ -/* C1 and C2 are the first and second columns of C. Looking at */ -/* the definition of X, we see that the extrema occur when */ - -/* cos(x) = C1(1) */ -/* sin(x) = C1(2) */ - -/* and when */ - -/* cos(x) = C2(1), */ -/* sin(x) = C2(2) */ - -/* So the semi-major and semi-minor axes of the ellipse are */ - -/* C(1,1) VEC1 + C(2,1) VEC2 */ - -/* and */ - -/* C(1,2) VEC1 + C(2,2) VEC2 */ - -/* (the negatives of these vectors are also semi-axes). */ - - -/* Copy the input vectors. */ - - moved_(vec1, &c__3, tmpvc1); - moved_(vec2, &c__3, tmpvc2); - -/* Scale the vectors to try to prevent arithmetic unpleasantness. */ -/* We avoid using the quotient 1/SCALE, as this value may overflow. */ -/* No need to go further if SCALE turns out to be zero. */ - -/* Computing MAX */ - d__1 = vnorm_(tmpvc1), d__2 = vnorm_(tmpvc2); - scale = max(d__1,d__2); - if (scale == 0.) { - cleard_(&c__3, smajor); - cleard_(&c__3, sminor); - chkout_("SAELGV", (ftnlen)6); - return 0; - } - for (i__ = 1; i__ <= 3; ++i__) { - tmpvc1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("tmpvc1", - i__1, "saelgv_", (ftnlen)435)] = tmpvc1[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("tmpvc1", i__2, "saelgv_", ( - ftnlen)435)] / scale; - tmpvc2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("tmpvc2", - i__1, "saelgv_", (ftnlen)436)] = tmpvc2[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("tmpvc2", i__2, "saelgv_", ( - ftnlen)436)] / scale; - } - -/* Compute S and diagonalize it: */ - - s[0] = vdot_(tmpvc1, tmpvc1); - s[1] = vdot_(tmpvc1, tmpvc2); - s[2] = s[1]; - s[3] = vdot_(tmpvc2, tmpvc2); - diags2_(s, eigval, c__); - -/* Find the semi-axes. */ - - if (abs(eigval[0]) >= abs(eigval[3])) { - -/* The first eigenvector ( first column of C ) corresponds */ -/* to the semi-major axis of the ellipse. */ - - major = 1; - minor = 2; - } else { - -/* The second eigenvector corresponds to the semi-major axis. */ - - major = 2; - minor = 1; - } - vlcom_(&c__[(i__1 = (major << 1) - 2) < 4 && 0 <= i__1 ? i__1 : s_rnge( - "c", i__1, "saelgv_", (ftnlen)469)], tmpvc1, &c__[(i__2 = (major - << 1) - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("c", i__2, "saelgv_", - (ftnlen)469)], tmpvc2, smajor); - vlcom_(&c__[(i__1 = (minor << 1) - 2) < 4 && 0 <= i__1 ? i__1 : s_rnge( - "c", i__1, "saelgv_", (ftnlen)470)], tmpvc1, &c__[(i__2 = (minor - << 1) - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("c", i__2, "saelgv_", - (ftnlen)470)], tmpvc2, sminor); - -/* Undo the initial scaling. */ - - vsclip_(&scale, smajor); - vsclip_(&scale, sminor); - chkout_("SAELGV", (ftnlen)6); - return 0; -} /* saelgv_ */ - diff --git a/ext/spice/src/cspice/saelgv_c.c b/ext/spice/src/cspice/saelgv_c.c deleted file mode 100644 index 7d581bbb1b..0000000000 --- a/ext/spice/src/cspice/saelgv_c.c +++ /dev/null @@ -1,489 +0,0 @@ -/* - --Procedure saelgv_c ( Semi-axes of ellipse from generating vectors ) - --Abstract - - Find semi-axis vectors of an ellipse generated by two arbitrary - three-dimensional vectors. - --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 - - ELLIPSES - --Keywords - - ELLIPSE - GEOMETRY - MATH - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef saelgv_c - - - void saelgv_c ( ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - vec1, - vec2 I Two vectors used to generate an ellipse. - smajor O Semi-major axis of ellipse. - sminor O Semi-minor axis of ellipse. - --Detailed_Input - - vec1, - vec2 are two vectors that define an ellipse. - The ellipse is the set of points in 3-space - - center + cos(theta) vec1 + sin(theta) vec2 - - where theta is in the interval ( -pi, pi ] and - center is an arbitrary point at which the ellipse - is centered. An ellipse's semi-axes are - independent of its center, so the vector center - shown above is not an input to this routine. - - vec2 and vec1 need not be linearly independent; - degenerate input ellipses are allowed. - --Detailed_Output - - smajor - sminor are semi-major and semi-minor axes of the ellipse, - respectively. smajor and sminor may overwrite - either of vec1 or vec2. - --Parameters - - None. - --Exceptions - - 1) If one or more semi-axes of the ellipse is found to be the - zero vector, the input ellipse is degenerate. This case is - not treated as an error; the calling program must determine - whether the semi-axes are suitable for the program's intended - use. - --Files - - None. - --Particulars - - We note here that two linearly independent but not necessarily - orthogonal vectors vec1 and vec2 can define an ellipse - centered at the origin: the ellipse is the set of points in - 3-space - - center + cos(theta) vec1 + sin(theta) vec2 - - where theta is in the interval (-pi, pi] and center is an - arbitrary point at which the ellipse is centered. - - This routine finds vectors that constitute semi-axes of an - ellipse that is defined, except for the location of its center, - by vec1 and vec2. The semi-major axis is a vector of largest - possible magnitude in the set - - cos(theta) vec1 + sin(theta) vec2 - - There are two such vectors; they are additive inverses of each - other. The semi-minor axis is an analogous vector of smallest - possible magnitude. The semi-major and semi-minor axes are - orthogonal to each other. If smajor and sminor are choices of - semi-major and semi-minor axes, then the input ellipse can also - be represented as the set of points - - center + cos(theta) smajor + sin(theta) sminor - - where theta is in the interval (-pi, pi]. - - The capability of finding the axes of an ellipse is useful in - finding the image of an ellipse under a linear transformation. - Finding this image is useful for determining the orthogonal and - gnomonic projections of an ellipse, and also for finding the limb - and terminator of an ellipsoidal body. - --Examples - - 1) An example using inputs that can be readily checked by - hand calculation. - - Let - - vec1 = ( 1., 1., 1. ) - vec2 = ( 1., -1., 1. ) - - The function call - - saelgv_c ( vec1, vec2, smajor, sminor ); - - returns - - smajor = ( -1.414213562373095, - 0.0, - -1.414213562373095 ) - and - - sminor = ( -2.4037033579794549D-17 - 1.414213562373095, - -2.4037033579794549D-17 ) - - - 2) This example is taken from the code of the CSPICE routine - pjelpl_c, which finds the orthogonal projection of an ellipse - onto a plane. The code listed below is the portion used to - find the semi-axes of the projected ellipse. - - - #include "SpiceUsr.h" - . - . - . - - /. - Project vectors defining axes of ellipse onto plane. - ./ - vperp_c ( vec1, normal, proj1 ); - vperp_c ( vec2, normal, proj2 ); - - . - . - . - - saelgv_c ( proj1, proj2, smajor, sminor ); - - - The call to saelgv_c determines the required semi-axes. - --Restrictions - - None. - --Literature_References - - [1] Calculus, Vol. II. Tom Apostol. John Wiley & Sons, 1969. - See Chapter 5, `Eigenvalues of Operators Acting on Euclidean - Spaces'. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 12-JUN-1999 (NJB) - --Index_Entries - - semi-axes of ellipse from generating vectors - --& -*/ - -{ /* Begin saelgv_c */ - - - /* - Local macros - */ - #define CLEAR_VEC( v ) (v)[0] = 0.; (v)[1] = 0.; (v)[2] = 0.; - - - /* - Local variables - */ - SpiceDouble c [2][2]; - SpiceDouble eigval [2][2]; - SpiceDouble s [2][2]; - SpiceDouble scale; - SpiceDouble tmpvc1 [3]; - SpiceDouble tmpvc2 [3]; - - SpiceInt i; - SpiceInt major; - SpiceInt minor; - - - - - /* - Static variables - */ - - - /* - Participate in error tracing. - */ - - chkin_c ( "saelgv_c" ); - - - - /* - Let the notation - - < a, b > - - indicate the inner product of the vectors a and b. - - The semi-major and semi-minor axes of the input ellipse are - vectors of maximum and minimum norm in the set - - cos(x) vec1 + sin(x) vec2 - - where x is in the interval (-pi, pi]. - - The square of the norm of a vector in this set is - - 2 - || cos(x) vec1 + sin(x) vec2 || - - - = < cos(x)vec1 + sin(x)vec2, cos(x)vec1 + sin(x)vec2 > ; - - this last expression can be written as the matrix product - - T - X S X, (1) - - where X is the unit vector - - +- -+ - | cos(x) | - | | - | sin(x) | - +- -+ - - and S is the symmetric matrix - - +- -+ - | < vec1, vec1 > < vec1, vec2 > | - | |. - | < vec1, vec2 > < vec2, vec2 > | - +- -+ - - Because the 2x2 matrix above is symmetric, there exists a - rotation matrix that allows us to diagonalize it: - - T - C S C = D, - - where D is a diagonal matrix. Since rotation matrices are - orthogonal, we have - - T - C C = I. - - If the unit vector U is defined by - - T - U = C X, - - then - - T T T T T - X S X = ( U C ) C D C ( C U ) = U D U. - - So, letting - - +- -+ - | u | - | | = U, - | v | - +- -+ - - we may re-write the original quadratic expression (1) as - - +- -+ +- -+ +- -+ - | u v | | D1 0 | | u |, - +- -+ | | | | - | | | v | - | 0 D2 | +- -+ - +- -+ - or - - 2 2 - D1 u + D2 v, - - where the diagonal matrix above is D. The eigenvalues D1 and - D2 are non-negative because they are eigenvalues of a positive - semi-definite matrix of the form - - T - M M. - - We may require that - - D1 > D2; - - - - then the maximum and minimum values of - - 2 2 - D1 u + D2 v (2) - - are D1 and D2 respectively. These values are the squares - of the lengths of the semi-major and semi-minor axes of the - ellipse, since the expression (2) is the square of the norm - of the point - - cos(x) vec1 + sin(x) vec2. - - Now we must find some eigenvectors. Since the extrema of (2) - occur when - - +- -+ +- -+ - | 1 | | 0 | - U = | | or U = | |, - | 0 | | 1 | - +- -+ +- -+ - - and since - - X = C U, - - we conclude that the extrema occur when X = C1 or X = C2, where - C1 and C2 are the first and second columns of C. Looking at - the definition of X, we see that the extrema occur when - - cos(x) = C1[0] - sin(x) = C1[1] - - and when - - cos(x) = C2[0], - sin(x) = C2[1] - - So the semi-major and semi-minor axes of the ellipse are - - C[0][0] vec1 + C[1][0] vec2 - - and - - C[0][1] vec1 + C[1][1] vec2 - - (the negatives of these vectors are also semi-axes). - - */ - - - - /* - Copy the input vectors. - */ - MOVED ( vec1, 3, tmpvc1 ); - MOVED ( vec2, 3, tmpvc2 ); - - - /* - Scale the vectors to try to prevent arithmetic unpleasantness. - We avoid using the quotient 1/SCALE, as this value may overflow. - No need to go further if SCALE turns out to be zero. - */ - scale = MaxAbs ( vnorm_c ( tmpvc1 ), vnorm_c ( tmpvc2 ) ); - - if ( scale == 0.0 ) - { - CLEAR_VEC ( smajor ); - CLEAR_VEC ( sminor ); - - chkout_c ( "saelgv_c" ); - return; - } - - for ( i = 0; i < 3; i++ ) - { - tmpvc1[i] = tmpvc1[i]/scale; - tmpvc2[i] = tmpvc2[i]/scale; - } - - - /* - Compute S and diagonalize it: - */ - s[0][0] = vdot_c ( tmpvc1, tmpvc1 ); - s[1][0] = vdot_c ( tmpvc1, tmpvc2 ); - s[0][1] = s[1][0]; - s[1][1] = vdot_c ( tmpvc2, tmpvc2 ); - - - diags2_c ( s, eigval, c ); - - - /* - Find the semi-axes. - */ - - if ( fabs( eigval[0][0] ) >= fabs( eigval[1][1] ) ) - { - /* - The first eigenvector ( first column of C ) corresponds - to the semi-major axis of the ellipse. - */ - major = 0; - minor = 1; - } - else - { - /* - The second eigenvector corresponds to the semi-major axis. - */ - major = 1; - minor = 0; - } - - - vlcom_c ( c[0][major], tmpvc1, c[1][major], tmpvc2, smajor ); - vlcom_c ( c[0][minor], tmpvc1, c[1][minor], tmpvc2, sminor ); - - - /* - Undo the initial scaling. - */ - vscl_c ( scale, smajor, smajor ); - vscl_c ( scale, sminor, sminor ); - - - chkout_c ( "saelgv_c" ); - -} /* End saelgv_c */ diff --git a/ext/spice/src/cspice/samch.c b/ext/spice/src/cspice/samch.c deleted file mode 100644 index 6fd24468e3..0000000000 --- a/ext/spice/src/cspice/samch.c +++ /dev/null @@ -1,197 +0,0 @@ -/* samch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SAMCH ( Same character ) */ -logical samch_(char *str1, integer *l1, char *str2, integer *l2, ftnlen - str1_len, ftnlen str2_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - -/* $ Abstract */ - -/* Determine if two characters from different strings are the */ -/* same. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR1 I A character string */ -/* L1 I The location (index) of a character in STR1 */ -/* STR2 I A character string */ -/* L2 I The location (index) of a character in STR2 */ - -/* The function returns TRUE if the two characters are the */ -/* same. */ - -/* $ Detailed_Input */ - -/* STR1 is a character string */ - -/* L1 is the location (index) of a character in STR1 */ - -/* STR2 is a character string */ - -/* L2 is the location (index) of a character in STR2 */ - -/* $ Detailed_Output */ - - -/* The function returns TRUE if the characters STR1(L1:L1) and */ -/* STR2(L2:L2) are the same. */ - -/* If the characters are different or L1 or L2 is out of range the */ -/* function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If either L1 or L2 is out of range the function returns FALSE. */ - -/* $ Particulars */ - -/* This is a utility function for determining whether or not */ -/* two characters in different strings are the same. This */ -/* function is intended for situation in which you need to */ -/* search two strings for a match (or mismatch). */ - -/* $ Examples */ - -/* Often you need to scan through two string comparing character */ -/* by character until a mismatch occurs. The usual way to code */ -/* this is */ - -/* DO WHILE ( L1 .LE. LEN(STR1) */ -/* .AND. L2 .LE. LEN(STR2) */ -/* .AND. STR1(L1:L1) .EQ. STR2(L2:L2) ) */ - -/* L1 = L1 + 1 */ -/* L2 = L2 + 1 */ - -/* END DO */ - -/* Check L1, L2 to make sure we are still in range, etc. */ - -/* The problem with this loop is that even though the check to make */ -/* sure that L1 and L2 are in range is performed, FORTRAN may */ -/* go ahead and compute the equality condition even though one of the */ -/* first two steps failed. This can lead to out of range errors */ -/* and possible halting of your program depending upon how */ -/* the routine is compiled. An alternative way to code this is */ - -/* IF ( L1 .LE. LEN(STR1) .AND. L2 .LE. LEN(STR2) ) THEN */ -/* ALIKE = STR1(L1:L1) .EQ. STR2(L2:L2) */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ - -/* DO WHILE ( ALIKE ) */ - -/* L1 = L1 + 1 */ -/* L2 = L2 + 1 */ - -/* IF ( L1 .LE. LEN(STR1) .AND. L2 .LE. LEN(STR2) ) THEN */ -/* ALIKE = STR1(L1:L1) .EQ. STR2(L2:L2) */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ -/* END DO */ - -/* However this is a much more complicated section of code. This */ -/* routine allows you to code the above loops as: */ - - -/* DO WHILE ( SAMCH ( STR1,L1, STR2,L2 ) ) */ -/* L1 = L1 + 1 */ -/* L2 = L2 + 1 */ -/* END DO */ - -/* The boundary checks are automatically performed and out */ -/* of range errors are avoided. */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 31-MAR-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Check two characters substrings for case sensitive equal */ - -/* -& */ - if (*l1 < 1 || *l2 < 1 || *l1 > i_len(str1, str1_len) || *l2 > i_len(str2, - str2_len)) { - ret_val = FALSE_; - return ret_val; - } - ret_val = *(unsigned char *)&str1[*l1 - 1] == *(unsigned char *)&str2[*l2 - - 1]; - return ret_val; -} /* samch_ */ - diff --git a/ext/spice/src/cspice/samchi.c b/ext/spice/src/cspice/samchi.c deleted file mode 100644 index b61809b624..0000000000 --- a/ext/spice/src/cspice/samchi.c +++ /dev/null @@ -1,204 +0,0 @@ -/* samchi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SAMCHI ( Same character --- case insensitive ) */ -logical samchi_(char *str1, integer *l1, char *str2, integer *l2, ftnlen - str1_len, ftnlen str2_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - extern logical eqchr_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine if two characters from different strings are the */ -/* same when the case of the characters is ignored. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR1 I A character string */ -/* L1 I The location (index) of a character in STR1 */ -/* STR2 I A character string */ -/* L2 I The location (index) of a character in STR2 */ - -/* The function returns TRUE if the two characters are the */ -/* same up to case. */ - -/* $ Detailed_Input */ - -/* STR1 is a character string */ - -/* L1 is the location (index) of a character in STR1 */ - -/* STR2 is a character string */ - -/* L2 is the location (index) of a character in STR2 */ - -/* $ Detailed_Output */ - - -/* The function returns TRUE if the characters STR1(L1:L1) and */ -/* STR2(L2:L2) are the same when the case of the characters is */ -/* ignored. */ - -/* If the characters are different or L1 or L2 is out of range the */ -/* function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If either L1 or L2 is out of range the function returns FALSE. */ - -/* $ Particulars */ - -/* This is a utility function for determining whether or not */ -/* two characters in different strings are the same up to case. */ -/* This function is intended for situation in which you need */ -/* to search two strings for a match (or mismatch). */ - -/* $ Examples */ - -/* Often you need to scan through two string comparing */ -/* character by character until a case insensitive mismatch */ -/* occurs. The usual way to code this is */ - -/* DO WHILE ( L1 .LE. LEN(STR1) */ -/* .AND. L2 .LE. LEN(STR2) */ -/* .AND. EQCHR( STR1(L1:L1),STR2(L2:L2) ) ) */ - -/* L1 = L1 + 1 */ -/* L2 = L2 + 1 */ - -/* END DO */ - -/* Check L1, L2 to make sure we are still in range, etc. */ - -/* The problem with this loop is that even though the check to make */ -/* sure that L1 and L2 are in range is performed, FORTRAN may */ -/* go ahead and compute the equality condition even though one of the */ -/* first two steps failed. This can lead to out of range errors */ -/* and possible halting of your program depending upon how */ -/* the routine is compiled. An alternative way to code this is */ - -/* IF ( L1 .LE. LEN(STR1) .AND. L2 .LE. LEN(STR2) ) THEN */ -/* ALIKE = EQCHR( STR1(L1:L1),STR2(L2:L2) ) */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ - -/* DO WHILE ( ALIKE ) */ - -/* L1 = L1 + 1 */ -/* L2 = L2 + 1 */ - -/* IF ( L1 .LE. LEN(STR1) .AND. L2 .LE. LEN(STR2) ) THEN */ -/* ALIKE = EQCHR( STR1(L1:L1), STR2(L2:L2) ) */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ -/* END DO */ - -/* However this is a much more complicated section of code. This */ -/* routine allows you to code the above loops as: */ - - -/* DO WHILE ( SAMCHI ( STR1,L1, STR2,L2 ) ) */ -/* L1 = L1 + 1 */ -/* L2 = L2 + 1 */ -/* END DO */ - -/* The boundary checks are automatically performed and out */ -/* of range errors are avoided. */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 31-MAR-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Check two character substrings for case insensitive equal */ - -/* -& */ - -/* Spicelib Functions */ - - if (*l1 < 1 || *l2 < 1 || *l1 > i_len(str1, str1_len) || *l2 > i_len(str2, - str2_len)) { - ret_val = FALSE_; - return ret_val; - } - ret_val = eqchr_(str1 + (*l1 - 1), str2 + (*l2 - 1), (ftnlen)1, (ftnlen)1) - ; - return ret_val; -} /* samchi_ */ - diff --git a/ext/spice/src/cspice/sameai.c b/ext/spice/src/cspice/sameai.c deleted file mode 100644 index ea8287e0f2..0000000000 --- a/ext/spice/src/cspice/sameai.c +++ /dev/null @@ -1,155 +0,0 @@ -/* sameai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SAMEAI ( Are two integer arrays the same? ) */ -logical sameai_(integer *a1, integer *a2, integer *ndim) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Indicate whether two integer arrays are equal. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* A1 I First array to be compared. */ -/* A2 I Second array to be compared. */ -/* NDIM I Dimension of A1 and A2. */ - -/* The function returns the value .TRUE. if and only if A1 = A2. */ - -/* $ Detailed_Input */ - -/* A1, */ -/* A2 are two integer arrays to be compared. A1 and */ -/* A2 must have the same dimension. */ - -/* NDIM is the common dimension of A1 and A2. */ - -/* $ Detailed_Output */ - -/* The function takes the value .TRUE. if and only if A1 equals A2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function can be thought of as a macro. It replaces the */ -/* loop */ - -/* SAME = .TRUE. */ -/* I = 1 */ - -/* DO WHILE ( ( I .LE. NDIM ) .AND. SAME ) */ - -/* IF ( A1(I) .NE. A2(I) ) */ -/* SAME = .FALSE. */ -/* ELSE */ -/* I = I + 1 */ -/* END IF */ - -/* END DO */ - - -/* $ Examples */ - - -/* 1) Test two integer arrays A1 and A2 for equality, where both */ -/* arrays have declared length 10: */ - -/* SAME = SAMEAI ( A1, A2, 10 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* test two integer arrays for equality */ - -/* -& */ - -/* Local variables */ - - -/* Executable code */ - - ret_val = TRUE_; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if (a1[i__ - 1] != a2[i__ - 1]) { - ret_val = FALSE_; - return ret_val; - } - } - return ret_val; -} /* sameai_ */ - diff --git a/ext/spice/src/cspice/samsbi.c b/ext/spice/src/cspice/samsbi.c deleted file mode 100644 index c0efd689cc..0000000000 --- a/ext/spice/src/cspice/samsbi.c +++ /dev/null @@ -1,238 +0,0 @@ -/* samsbi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SAMSBI (Same substrings, case insensitive) */ -logical samsbi_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, - integer *e2, ftnlen str1_len, ftnlen str2_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer i__, j; - extern logical nechr_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine whether or not two substrings are the same up to */ -/* case. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* STR1 I A string */ -/* B1 I Beginning of a substring in STR1 */ -/* E1 I End of s substring in STR1 */ -/* STR2 I A second string */ -/* B2 I The beginning of a substring in STR2 */ -/* E2 I The end of s substring in STR2 */ - -/* The function returns .TRUE. if the substrings are identical */ -/* up to case. */ - -/* $ Detailed_Input */ - -/* STR1 is a character string */ - -/* B1 are integers giving the beginning and ending of a */ -/* E1 subsstring in STR1 */ - -/* STR2 is a character string */ - -/* B2 are integers giving the beginning and ending of a */ -/* E2 subsstring in STR2 */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if the two substrings STR(B1:E1) and */ -/* STR(B2:E2) have the same length and the same characters up to */ -/* case. */ - -/* If any of the indices B1, E1, B2, E2 are out of range or out */ -/* of order the function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If any of the B1, E1, B2, E2 are out of range or if an */ -/* ending substring index is before a beginning substring */ -/* index, the function returns false. */ - -/* $ Particulars */ - -/* This routine is a macro for comparing two substrings of */ -/* strings and handles all of the bounds checking to avoid */ -/* out of range errors with string indices. */ - -/* $ Examples */ - -/* Suppose a string contains a number of occurrences of some */ -/* particular substring in sequence and that you need to locate */ -/* the first character that is out of this sequence or the */ -/* end of the string. */ - -/* If one ignores boundary constraints this can easily be */ -/* coded as shown here: We assume the particular substring is */ - -/* '/beg' */ - -/* B = 1 */ -/* E = B + LEN('/beg' ) */ - -/* DO WHILE ( E .LE. LEN(STR) */ -/* .AND. STRING(B:E) .EQ. '/beg' ) */ - -/* B = B + LEN('/beg') */ -/* E = E + LEN('/beg') */ - -/* END DO */ - -/* IF ( B .LT. LEN(STR) ) THEN */ - -/* we've found the start of a substring of interest */ - -/* ELSE */ - -/* there is no substring to find. */ - -/* END IF */ - -/* Unfortunately, you can't rely upon FORTRAN to check the boundary */ -/* condition: E .LE. LEN(STR) and skip the second test if the first */ -/* condition if false. As a result you can get an out of range */ -/* error. */ - -/* Instead you could code: */ - -/* B = 1 */ -/* E = B + LEN('/beg') */ - -/* IF ( E .LE. LEN(STR) ) THEN */ -/* ALIKE = STRINB(B:E) .EQ. '/beg' */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ - -/* DO WHILE ( ALIKE ) */ - -/* B = B + LEN('/beg') */ -/* E = E + LEN('/beg') */ - -/* IF ( E .LE. LEN(STR) ) THEN */ -/* ALIKE = STRINB(B:E) .EQ. '/beg' */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ - -/* END DO */ - - -/* However, this is code is far more effort. Using this routine */ -/* you can make a much simpler block of code. */ - -/* B = 1 */ -/* E = B + LEN('/beg' ) */ - -/* DO WHILE ( SAMSBI(STR,B,E, '/beg',1,4 ) ) */ - -/* B = B + LEN('/beg') */ -/* E = E + LEN('/beg') */ - -/* END DO */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 31-MAR-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Check case insensitive equality of two substrings. */ - -/* -& */ - if (*e1 < *b1 || *e2 < *b2 || *b1 < 1 || *b2 < 1 || *e1 > i_len(str1, - str1_len) || *e2 > i_len(str2, str2_len) || *e1 - *b1 != *e2 - * - b2) { - ret_val = FALSE_; - return ret_val; - } - j = *b2; - ret_val = FALSE_; - i__1 = *e1; - for (i__ = *b1; i__ <= i__1; ++i__) { - if (nechr_(str1 + (i__ - 1), str2 + (j - 1), (ftnlen)1, (ftnlen)1)) { - return ret_val; - } - ++j; - } - ret_val = TRUE_; - return ret_val; -} /* samsbi_ */ - diff --git a/ext/spice/src/cspice/samsub.c b/ext/spice/src/cspice/samsub.c deleted file mode 100644 index 315a39724b..0000000000 --- a/ext/spice/src/cspice/samsub.c +++ /dev/null @@ -1,222 +0,0 @@ -/* samsub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SAMSUB (Same substrings) */ -logical samsub_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, - integer *e2, ftnlen str1_len, ftnlen str2_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine whether or not two substrings are the same */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* STR1 I A string */ -/* B1 I Beginning of a substring in STR1 */ -/* E1 I End of s substring in STR1 */ -/* STR2 I A second string */ -/* B2 I The beginning of a substring in STR2 */ -/* E2 I The end of s substring in STR2 */ - -/* The function returns .TRUE. if the substrings are identical */ - -/* $ Detailed_Input */ - -/* STR1 is a character string */ - -/* B1 are integers giving the beginning and ending of a */ -/* E1 substring in STR1 */ - -/* STR2 is a character string */ - -/* B2 are integers giving the beginning and ending of a */ -/* E2 substring in STR2 */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if the two substrings STR(B1:E1) and */ -/* STR(B2:E2) have the same length and the same characters. */ - -/* If any of the indices B1, E1, B2, E2 are out of range or out */ -/* of order the function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If any of the B1, E1, B2, E2 are out of range or if an */ -/* ending substring index is before a beginning substring */ -/* index, the function returns false. */ - -/* $ Particulars */ - -/* This routine is a macro for comparing two substrings of */ -/* strings and handles all of the bounds checking to avoid */ -/* out of range errors with string indices. */ - -/* $ Examples */ - -/* Suppose a string contains a number of occurrences of some */ -/* particular substring in sequence and that you need to locate */ -/* the first character that is out of this sequence or the */ -/* end of the string. */ - -/* If one ignores boundary constraints this can easily be */ -/* coded as shown here: We assume the particular substring is */ - -/* '/beg' */ - -/* B = 1 */ -/* E = B + LEN('/beg' ) */ - -/* DO WHILE ( E .LE. LEN(STR) */ -/* .AND. STRING(B:E) .EQ. '/beg' ) */ - -/* B = B + LEN('/beg') */ -/* E = E + LEN('/beg') */ - -/* END DO */ - -/* IF ( B .LT. LEN(STR) ) THEN */ - -/* we've found the start of a substring of interest */ - -/* ELSE */ - -/* there is no substring to find. */ - -/* END IF */ - -/* Unfortunately, you can't rely upon FORTRAN to check the boundary */ -/* condition: E .LE. LEN(STR) and skip the second test if the first */ -/* condition if false. As a result you can get an out of range */ -/* error. */ - -/* Instead you could code: */ - -/* B = 1 */ -/* E = B + LEN('/beg') */ - -/* IF ( E .LE. LEN(STR) ) THEN */ -/* ALIKE = STRINB(B:E) .EQ. '/beg' */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ - -/* DO WHILE ( ALIKE ) */ - -/* B = B + LEN('/beg') */ -/* E = E + LEN('/beg') */ - -/* IF ( E .LE. LEN(STR) ) THEN */ -/* ALIKE = STRINB(B:E) .EQ. '/beg' */ -/* ELSE */ -/* ALIKE = .FALSE. */ -/* END IF */ - -/* END DO */ - - -/* However, this is code is far more effort. Using this routine */ -/* you can make a much simpler block of code. */ - -/* B = 1 */ -/* E = B + LEN('/beg' ) */ - -/* DO WHILE ( SAMSUB(STR,B,E, '/beg',1,4 ) ) */ - -/* B = B + LEN('/beg') */ -/* E = E + LEN('/beg') */ - -/* END DO */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 31-MAR-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Check equality of two substrings. */ - -/* -& */ - if (*e1 < *b1 || *e2 < *b2 || *b1 < 1 || *b2 < 1 || *e1 > i_len(str1, - str1_len) || *e2 > i_len(str2, str2_len) || *e1 - *b1 != *e2 - * - b2) { - ret_val = FALSE_; - return ret_val; - } - ret_val = s_cmp(str1 + (*b1 - 1), str2 + (*b2 - 1), *e1 - (*b1 - 1), *e2 - - (*b2 - 1)) == 0; - return ret_val; -} /* samsub_ */ - diff --git a/ext/spice/src/cspice/sc01.c b/ext/spice/src/cspice/sc01.c deleted file mode 100644 index ce2f849b27..0000000000 --- a/ext/spice/src/cspice/sc01.c +++ /dev/null @@ -1,3244 +0,0 @@ -/* sc01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__0 = 0; -static integer c__1 = 1; -static integer c_b22 = 150000; -static integer c__9999 = 9999; -static integer c__10 = 10; -static integer c__30 = 30; - -/* $Procedure SC01 ( Spacecraft clock, type 1 ) */ -/* Subroutine */ int sc01_0_(int n__, integer *sc, char *clkstr, doublereal * - ticks, doublereal *sclkdp, doublereal *et, ftnlen clkstr_len) -{ - /* Initialized data */ - - static char bvlmsg[320] = "Invalid value of #. Value was #. " - " " - " " - " " - " " - " "; - static char del[1*5] = "." ":" "-" "," " "; - static logical first = TRUE_; - static char namlst[60*9] = "SCLK_KERNEL_ID " - " " "SCLK01_COEFFICIENTS " - " " "SCLK_PARTITION_START " - " " "SCLK_PARTITION_END " - " " "SCLK01_N_FIELDS " - " " "SCLK01_OFFSETS " - " " "SCLK01_MODULI " - " " "SCLK01_OUTPUT_DELIM " - " " "SCLK01_TIME_SYSTEM " - " "; - static logical nodata = TRUE_; - static integer oldsc = 0; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - double d_nint(doublereal *), d_lg10(doublereal *); - integer i_len(char *, ftnlen); - double d_int(doublereal *), d_mod(doublereal *, doublereal *); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static doublereal rate; - static integer pntr, i__, j, n; - extern /* Subroutine */ int scld01_(char *, integer *, integer *, integer - *, doublereal *, ftnlen), scli01_(char *, integer *, integer *, - integer *, integer *, ftnlen), chkin_(char *, ftnlen), errch_( - char *, char *, ftnlen, ftnlen); - static doublereal prend[9999]; - extern /* Subroutine */ int movec_(char *, integer *, char *, ftnlen, - ftnlen), repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, - ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - static integer npart; - static doublereal const__; - static integer lower; - static char error[240]; - static integer upper, ntsys, delcde; - extern logical failed_(void); - static integer needed, middle, ncoeff; - static char dpchar[30]; - static integer nfield; - static doublereal coeffs[150000] /* was [3][50000] */, tikdif; - static char kvname[60*9]; - static doublereal cmpval[10], moduli[10], maxwid, cmptks[10], mxtick, - offset[10]; - extern doublereal unitim_(doublereal *, char *, char *, ftnlen, ftnlen); - static doublereal partim, tikmsc, timdif; - static integer cmpwid[10], length[10]; - static logical update; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen), cvpool_(char *, logical *, - ftnlen), swpool_(char *, integer *, char *, ftnlen, ftnlen), - setmsg_(char *, ftnlen), lparsm_(char *, char *, integer *, - integer *, char *, ftnlen, ftnlen, ftnlen), errint_(char *, - integer *, ftnlen); - static integer timsys; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen), dpstrf_(doublereal *, integer *, char *, char - *, ftnlen, ftnlen), prefix_(char *, integer *, char *, ftnlen, - ftnlen); - static doublereal prstrt[9999]; - static integer pad, end; - static char cmp[30*10]; - static doublereal rem; - -/* $ Abstract */ - -/* Perform time conversions between different representations of */ -/* type 1 spacecraft clock. */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry point */ -/* -------- --- -------------------------------------------------- */ -/* SC I (All) */ -/* CLKSTR I,O SCTK01, SCFM01 */ -/* TIKS I,O SCTK01, SCFM01 */ -/* SCLKDP I,O SCTE01, SCET01, SCEC01 */ -/* ET I,O SCTE01, SCET01, SCEC01 */ -/* MXCOEF P SCTE01, SCET01 */ -/* MXPART P (All) */ -/* DELIMS P SCTK01, SCFM01 */ -/* MXNFLD P SCTK01, SCFM01 */ -/* DPLEN P SCTK01, SCFM01 */ - -/* $ Detailed_Input */ - -/* See the entry points SCTK01, SCFM01, SCET01, SCTE01, SCEC01. */ - -/* $ Detailed_Output */ - -/* See the entry points SCTK01, SCFM01, SCET01, SCTE01, SCEC01. */ - -/* $ Parameters */ - -/* MXCOEF is the maximum number of coefficient sets in the */ -/* array COEFFS that defines the mapping between */ -/* encoded type 1 SCLK and a parallel time system, */ -/* such as TDB or TDT. This array has dimension */ -/* 3 x MXCOEF. The value of MXCOEF may be increased */ -/* as required. */ - -/* MXPART is the maximum number of partitions for any type 1 */ -/* spacecraft clock. Type 1 SCLK kernels contain */ -/* start and stop times for each partition. The value */ -/* of MXPART may be increased as required. */ - -/* MXNFLD is an upper bound on the number of components in */ -/* the clock string. */ - -/* DPLEN is an upper bound on the width of the individual */ -/* components of the clock string. */ - -/* DELIMS are the characters that are accepted delimiters of */ -/* the clock components in the input SCLK string. */ - -/* $ Exceptions */ - -/* 1) If SC01 is called directly, the error SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* 2) See the entry points SCTK01, SCFM01, SCET01, SCTE01 for a */ -/* description of the exceptions specific to those routines. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SC01 serves as an umbrella routine under which the shared */ -/* variables of its entry points are declared. SC01 should */ -/* never be called directly. */ - -/* The entry points of SC01 are */ - -/* SCTK01 ( SCLK to ticks, type 1 ) */ -/* SCFM01 ( Format, type 1 ) */ -/* SCET01 ( ET to ticks, type 1 ) */ -/* SCEC01 ( ET to continuous ticks, type 1 ) */ -/* SCTE01 ( Ticks to ET, type 1 ) */ - -/* $ Examples */ - -/* See the entry points SCTK01, SCFM01, SCET01, SCEC01, SCTE01. */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time any entry point of this */ -/* routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time any entry point of this routine is */ -/* called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.3.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: the entry points of this routine now keep track of */ -/* whether their kernel pool look-ups succeeded. If not, a kernel */ -/* pool lookup is attempted on the next call to any entry point */ -/* of this routine. */ - -/* - SPICELIB Version 3.2.0, 17-FEB-2008 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* Bug fix: spaces between fields are now inserted */ -/* correctly when the output field delimiter is blank. */ - -/* - SPICELIB Version 3.1.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 3.1.0, 24-JAN-2003 (BVS) */ - -/* Increased MXCOEF to 10000. */ - -/* - SPICELIB Version 3.0.0, 09-MAR-1999 (NJB) */ - -/* Added new entry point SCEC01. Removed some extraneous */ -/* C's from column 1; these had been added by a wayward */ -/* preprocessor. */ - -/* Removed local variable RNDCLK; entry point SCTE01 no longer */ -/* creates a rounded version of its input argument. */ - -/* Updated/fixed various comments here and in entry SCET01. */ - -/* - SPICELIB Version 2.1.0, 07-JUL-1996 (NJB) */ - -/* Removed declaration, DATA and SAVE statements for unused */ -/* variables NFDMSG and OLDID. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* All entry points were updated to handle SCLK kernels that */ -/* map between SCLK and a variety of time systems; formerly */ -/* only TDB was supported. All entry points have had corrections */ -/* and additions made to their headers. Comment section for */ -/* permuted index source lines was added following the header. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* type_1 spacecraft_clock */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.3.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: the entry points of this routine now keep track of */ -/* whether their kernel pool look-ups succeeded. If not, a kernel */ -/* pool lookup is attempted on the next call to any entry point */ -/* of this routine. */ - -/* All entry points of this routine look up the same kernel */ -/* variables, and use the saved variable UPDATE to indicate that */ -/* a kernel pool look-up is needed. A look-up failure occurring */ -/* in any entry point will now prevent all entry points from */ -/* relying on stored kernel data. */ - - -/* - SPICELIB Version 3.2.0, 17-FEB-2008 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* Bug fix: spaces between fields are now inserted */ -/* correctly when the output field delimiter is blank. */ - -/* Unused parameter INITID was removed. */ - -/* - SPICELIB Version 3.1.0, 24-JAN-2003 (BVS) */ - -/* Increased MXCOEF to 10000. */ - -/* - SPICELIB Version 3.0.0, 06-JAN-1999 (NJB) */ - -/* Added new entry point SCEC01. Removed some extraneous */ -/* C's from column 1; these had been added by a wayward */ -/* preprocessor. */ - -/* Removed local variable RNDCLK; entry point SCTE01 no longer */ -/* creates a rounded version of its input argument. */ - -/* Updated/fixed various comments here and in entry SCET01. */ - -/* - SPICELIB Version 2.1.0, 07-JUL-1996 (NJB) */ - -/* Removed declaration, DATA and SAVE statements for unused */ -/* variables NFDMSG and OLDID. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* Entry points SCET01 and SCTE01 were updated to handle a time */ -/* system specification for the `parallel' time system */ -/* in the SCLK kernel. Formerly, the only time system that */ -/* an SCLK kernel could map SCLK to was TDB. Now TDT is */ -/* supported, and the mechanism for allowing other parallel */ -/* time systems is in place. */ - -/* To support a new parallel time system, it is necessary */ -/* to */ - -/* -- Update SCTE01 so that after the routine converts an input */ -/* tick value to a value in the parallel system, the */ -/* resulting value is converted to TDB. See the current */ -/* treatment of TDT in that routine for an example of how */ -/* this is done. */ - -/* -- Update SCET01 so that the input TDB value can be */ -/* converted to a value in the new parallel system when */ -/* required. This converted value is then used as an input */ -/* to the interpolation algorithm performed in SCET01. See */ -/* the current treatment of TDT in that routine for an */ -/* example of how this is done. */ - -/* -- Update the parameter MXTSYS in SCLU01 to indicate the */ -/* new number of supported parallel time systems. */ - -/* -- Update the SCLK Required Reading to document the */ -/* description of the currently supported parallel time */ -/* systems. */ - -/* See the named entry points for further details. */ - -/* The kernel pool routines SWPOOL and CVPOOL are now used */ -/* to determine when it is necessary to look up kernel pool */ -/* constants. The variable UPDATE is now used to indicate */ -/* when it is necessary to look up the kernel variables used by */ -/* this suite of routines. All of the entry points SCFM01, */ -/* SCTK01, SCET01, and SCTE01 were affected by this update. */ - -/* All of the entry points have had their headers updated to */ -/* discuss the fact that a leapseconds kernel will now need to be */ -/* loaded in order to use SCLK kernels that map between SCLK and */ -/* a parallel time system other than TDB. */ - -/* In this routine, a comment section for permuted index */ -/* source lines was added following the header. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Following are parameters for the indices within the */ -/* array NAMLST of the kernel variable names used by the */ -/* SC01 entry points. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* There are at least a half dozen distinct items to save. We're */ -/* safer just saving everything. */ - -/* Maintenance programming note: the coefficient buffer */ -/* should be saved in any event to prevent memory problems */ -/* on some platforms. */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_sctk01; - case 2: goto L_scfm01; - case 3: goto L_scte01; - case 4: goto L_scet01; - case 5: goto L_scec01; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SC01", (ftnlen)4); - } - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("SC01", (ftnlen)4); - return 0; -/* $Procedure SCTK01 ( Convert type 1 SCLK string to ticks ) */ - -L_sctk01: -/* $ Abstract */ - -/* Convert a character representation of a type 1 spacecraft clock */ -/* count to ticks. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* CHARACTER*(*) CLKSTR */ -/* DOUBLE PRECISION TICKS */ -/* INTEGER SC */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* CLKSTR I Character representation of a clock count. */ -/* TICKS O Number of ticks represented by the clock count. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF spacecraft identification code. See the */ -/* `Examples' section below, and also the NAIF_IDS */ -/* required reading file for a complete list of body ID */ -/* codes. */ - - -/* CLKSTR on input is the character representation of a */ -/* spacecraft clock count (SCLK), without a partition */ -/* number. */ - -/* Using Galileo as an example, a SCLK string without */ -/* a partition number has the form */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time */ -/* Image Count (RIM), which increments once every time */ -/* xx turns over, i.e., once every 60 2/3 seconds. The */ -/* roll-over expression for the RIM is 16777215, which */ -/* corresponds to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft count. */ -/* SCLK components may be separated by any of the */ -/* single character delimiters in the string DELIMS, with */ -/* any number of spaces separating the components and */ -/* the delimiters. The presence of the RIM component */ -/* is required. Successive components may be omitted, and */ -/* in such cases are assumed to represent zero values. */ - -/* Values for the individual components may exceed the */ -/* maximum expected values. For instance, '0:0:0:9' is */ -/* an acceptable Galileo clock string, and indicates the */ -/* same time interval as '0:0:1:1'. */ - -/* Consecutive delimiters containing no intervening digits */ -/* are treated as if they delimit zero components, except */ -/* in the case of blanks. Consecutive blanks are treated */ -/* as a single blank. */ - -/* Trailing zeros should always be included to match the */ -/* length of the counter. For example, a Galileo clock */ -/* count of '25684.90' should not be represented as */ -/* '25684.9'. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Galileo, Mars Observer, and Voyager */ -/* clock formats. */ - -/* See the `Examples' section in SCTK01, below. */ - -/* $ Detailed_Output */ - -/* TICKS is the number of "ticks" corresponding to the input */ -/* spacecraft clock string CLKSTR. "Ticks" are the units */ -/* in which encoded SCLK strings are represented. */ - -/* A typical Galileo SCLK string looks like */ - -/* 'wwwwwwww xx y z', */ - -/* as described above. Since z is the mod-8 (one tick) */ -/* counter, the number of ticks represented by y is 8*y. */ -/* And since y is the mod-10 counter, the number of ticks */ -/* represented by xx is 10*8*xx. The total number of */ -/* ticks represented by the above string is */ - -/* wwwwwwww( 7280 ) + */ -/* xx( 80 ) + */ -/* y( 8 ) + */ -/* z */ - -/* Clock strings for other spacecraft are converted in */ -/* a similar manner. */ - -/* See Examples below. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument TICKS will not */ -/* be modified. */ - -/* The variables that must be set by the SCLK kernel are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - -/* When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument TICKS will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - - -/* 2) If any of the following kernel variables have invalid values, */ -/* the error will be diagnosed by routines called by this */ -/* routine: */ - -/* - The time system code */ -/* - The number of SCLK coefficients */ -/* - The number of partition start times */ -/* - The number of partition end times */ -/* - The number of fields of a SCLK string */ -/* - The number of moduli for a SCLK string */ - -/* If the number of values for any item read from the kernel */ -/* pool exceeds the maximum allowed value, it is may not be */ -/* possible to diagnose the error correctly, since overwriting */ -/* of memory may occur. This particular type of error is not */ -/* diagnosed by this routine. */ - - -/* 3) The input argument CLKSTR may be invalid for a variety of */ -/* reasons: */ - -/* -- One of the extracted clock components cannot be parsed */ -/* as an integer */ - -/* -- CLKSTR contains too many components */ - -/* -- the value of one of the components is less than the */ -/* offset value */ - -/* If any of these conditions is detected, the error */ -/* SPICE(INVALIDSCLKSTRING) is signalled. The output argument */ -/* TICKS will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts a character string representation of a */ -/* spacecraft clock count into the number of ticks represented */ -/* by the clock count. An important distinction between this type */ -/* of conversion and that carried out by SCENCD is that this routine */ -/* treats spacecraft clock times as representations of time */ -/* intervals, not absolute times. */ - -/* This routine does not make use of any partition information. */ -/* See SCENCD for details on how to make use of partition numbers. */ - -/* $ Examples */ - -/* 1) Below are some examples illustrating various inputs and the */ -/* resulting outputs for the Galileo spacecraft. */ - -/* CLKSTR TICKS */ -/* ---------------- -------------------- */ -/* '0:0:0:1' 1 */ -/* '0:0:1' 8 */ -/* '0:1' 80 */ -/* '1' 7280 */ -/* '1 0 0 0' 7280 */ -/* '1,0,0,0' 7280 */ -/* '1:90' 14480 */ -/* '1:9' 8000 */ -/* '1:09' 8000 */ -/* '0-0-10' 80 |-- Third component is supposed */ -/* '0-1-0' 80 | to be a mod-10 count. */ -/* '0/1/0' Error: '/' is not an accepted delimiter. */ -/* '1: 00 : 0 : 1' 7281 */ -/* '1:::1' 7281 */ -/* '1.1.1.1.1' Error: Too many components */ -/* '1.1.1.1.' Error: The last delimiter signals that */ -/* a fifth component will follow. */ - - -/* The following examples are for the Voyager 2 spacecraft. Note */ -/* that the last component of the Voyager clock has an offset */ -/* value of 1. */ - -/* CLKSTR TICKS */ -/* ---------------- -------------------- */ -/* '0.0.001' 0 */ -/* '0:0:002' 1 */ -/* '0:01' 800 */ -/* '1' 48000 */ -/* '1.0' 48000 */ -/* '1.0.0' Error: The 3rd component is never 0. */ -/* '0.0:100' 99 */ -/* '0-60-1' 48000 */ -/* '1-1-1' 48800 */ -/* '1-1-2' 48801 */ - - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 2.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* Header was updated, particularly $Exceptions and $Restrictions */ -/* sections. Kernel pool watch is now set on required kernel */ -/* variables. Comment section for permuted index source lines */ -/* was added following the header. */ - -/* - SPICELIB Version 1.0.0, 04-SEP-1990 (NJB) (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert type_1 spacecraft_clock string to ticks */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* This routine now uses the new kernel pool watch capability */ -/* to determine when it is necessary to look up SCLK variables. */ -/* This method of checking for kernel pool updates replaces the */ -/* previously used once-per-call lookup of the SCLK_KERNEL_ID */ -/* kernel variable. */ - -/* The header was updated to discuss the fact that a leapseconds */ -/* kernel will now need to be loaded in order to use SCLK kernels */ -/* that map between SCLK and a parallel time system other than */ -/* TDB. The $Exceptions and $Restrictions sections were affected. */ - -/* A comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCTK01", (ftnlen)6); - } - -/* On the first pass through the subroutine, or if the spacecraft */ -/* clock ID changes, we will set watches on the SCLK kernel */ -/* variables for the current clock. */ - - if (first || *sc != oldsc) { - first = FALSE_; - -/* Make up a list of names of kernel variables that we'll use. */ -/* The first name in the list is SCLK_KERNEL_ID, which does not */ -/* require the addition of a spacecraft code suffix. For the */ -/* rest of the names, we'll have to add the suffix. */ - - s_copy(kvname, namlst, (ftnlen)60, (ftnlen)60); - movec_(namlst, &c__9, kvname, (ftnlen)60, (ftnlen)60); - for (i__ = 2; i__ <= 9; ++i__) { - suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? - i__1 : s_rnge("kvname", i__1, "sc01_", (ftnlen)884)) * - 60, (ftnlen)2, (ftnlen)60); - i__3 = -(*sc); - repmi_(kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : - s_rnge("kvname", i__1, "sc01_", (ftnlen)885)) * 60, "#", & - i__3, kvname + ((i__2 = i__ - 1) < 9 && 0 <= i__2 ? i__2 : - s_rnge("kvname", i__2, "sc01_", (ftnlen)885)) * 60, ( - ftnlen)60, (ftnlen)1, (ftnlen)60); - } - -/* Set a watch on all of the kernel variables we use. */ - - swpool_("SC01", &c__9, kvname, (ftnlen)4, (ftnlen)60); - -/* Keep track of the last spacecraft clock ID encountered. */ - - oldsc = *sc; - } - -/* Find out whether we need to look up new format descriptors from */ -/* the kernel pool. If any relevant kernel variables were updated, */ -/* we have to do a look-up. Note that changing the s/c clock ID */ -/* causes a new watch to be set, so a look-up is required. When we */ -/* do a look-up, we grab everything that any of the SC01 entry */ -/* points might need. */ - - cvpool_("SC01", &update, (ftnlen)4); - if (update || nodata) { - -/* Our first piece of business is to look up all of the data */ -/* we require from the kernel pool. We must form the names */ -/* of the items we want using the input S/C ID code. The items */ -/* we need are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - - scli01_(namlst + 240, sc, &c__1, &n, &nfield, (ftnlen)60); - scli01_(namlst + 420, sc, &c__1, &n, &delcde, (ftnlen)60); - scli01_(namlst + 480, sc, &c__1, &ntsys, &timsys, (ftnlen)60); - scld01_(namlst + 60, sc, &c_b22, &ncoeff, coeffs, (ftnlen)60); - scld01_(namlst + 120, sc, &c__9999, &n, prstrt, (ftnlen)60); - scld01_(namlst + 180, sc, &c__9999, &npart, prend, (ftnlen)60); - scld01_(namlst + 360, sc, &c__10, &n, moduli, (ftnlen)60); - scld01_(namlst + 300, sc, &c__10, &n, offset, (ftnlen)60); - -/* Don't try to continue if we had a lookup error. */ - - if (failed_()) { - nodata = TRUE_; - chkout_("SCTK01", (ftnlen)6); - return 0; - } - -/* The kernel pool look-up succeeded. */ - - nodata = FALSE_; - -/* Use the default time system (TDB) if none was specified in the */ -/* SCLK kernel. */ - - if (ntsys == 0) { - timsys = 1; - } - } - -/* If our clock string is blank, we can stop now. */ - - if (s_cmp(clkstr, " ", clkstr_len, (ftnlen)1) == 0) { - setmsg_("CLKSTR is blank.", (ftnlen)16); - sigerr_("SPICE(INVALIDSCLKSTRING)", (ftnlen)24); - chkout_("SCTK01", (ftnlen)6); - return 0; - } - -/* Determine how many ticks is each field is worth. */ - - cmptks[(i__1 = nfield - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmptks", - i__1, "sc01_", (ftnlen)981)] = 1.; - for (i__ = nfield - 1; i__ >= 1; --i__) { - cmptks[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmptks", - i__1, "sc01_", (ftnlen)984)] = cmptks[(i__2 = i__) < 10 && 0 - <= i__2 ? i__2 : s_rnge("cmptks", i__2, "sc01_", (ftnlen)984)] - * moduli[(i__3 = i__) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "moduli", i__3, "sc01_", (ftnlen)984)]; - } - -/* Parse the clock components from the input string. There should */ -/* be at most NFIELD of them, but, in order to check for too long */ -/* a clock string, we'll let LPARSM take up to MXNFLD components and */ -/* then test for an error. */ - - lparsm_(clkstr, ".:-, ", &c__10, &n, cmp, clkstr_len, (ftnlen)5, (ftnlen) - 30); - -/* If the string has too many fields for the specified spacecraft */ -/* then signal an error. */ - - if (n > nfield) { - setmsg_("CLKSTR has # fields, which is too many.", (ftnlen)39); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(INVALIDSCLKSTRING)", (ftnlen)24); - chkout_("SCTK01", (ftnlen)6); - return 0; - } - -/* Convert each of the components into numbers. Error if any */ -/* of the conversions screw up. NPARSD doesn't assign a value */ -/* to ' ', so assign the numeric value of the blank components */ -/* to be equal to the offset value. */ - - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "sc01_", (ftnlen)1017)) * 30, " ", (ftnlen)30, ( - ftnlen)1) == 0) { - cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmpval" - , i__2, "sc01_", (ftnlen)1018)] = offset[(i__3 = i__ - 1) - < 10 && 0 <= i__3 ? i__3 : s_rnge("offset", i__3, "sc01_", - (ftnlen)1018)]; - } else { - nparsd_(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "sc01_", (ftnlen)1020)) * 30, &cmpval[(i__3 = - i__ - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("cmpval", - i__3, "sc01_", (ftnlen)1020)], error, &pntr, (ftnlen)30, ( - ftnlen)240); - } - if (s_cmp(error, " ", (ftnlen)240, (ftnlen)1) != 0) { - setmsg_("Could not parse SCLK component # from # as a number.", ( - ftnlen)52); - errch_("#", cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("cmp", i__2, "sc01_", (ftnlen)1028)) * 30, (ftnlen) - 1, (ftnlen)30); - errch_("#", clkstr, (ftnlen)1, clkstr_len); - sigerr_("SPICE(INVALIDSCLKSTRING)", (ftnlen)24); - chkout_("SCTK01", (ftnlen)6); - return 0; - } - -/* Subtract off the offset value so that we can do base ten */ -/* arithmetic. Also, if any of the components become negative */ -/* as a result of the subtraction, then that component must */ -/* have been invalid. */ - - cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmpval", - i__2, "sc01_", (ftnlen)1042)] = cmpval[(i__3 = i__ - 1) < 10 - && 0 <= i__3 ? i__3 : s_rnge("cmpval", i__3, "sc01_", (ftnlen) - 1042)] - offset[(i__4 = i__ - 1) < 10 && 0 <= i__4 ? i__4 : - s_rnge("offset", i__4, "sc01_", (ftnlen)1042)]; - if (d_nint(&cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmpval", i__2, "sc01_", (ftnlen)1045)]) < 0.) { - setmsg_(" Component number # in the SCLK string is invalid " - " ", (ftnlen)78); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(INVALIDSCLKSTRING)", (ftnlen)24); - chkout_("SCTK01", (ftnlen)6); - return 0; - } - } - -/* Convert to ticks by multiplying the value of each component by */ -/* the number of ticks each component count represents, and then */ -/* add up the results. */ - - *ticks = 0.; - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - *ticks += cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmpval", i__2, "sc01_", (ftnlen)1066)] * cmptks[(i__3 = i__ - - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("cmptks", i__3, "sc01_" - , (ftnlen)1066)]; - } - chkout_("SCTK01", (ftnlen)6); - return 0; -/* $Procedure SCFM01 ( Convert ticks to a type 1 SCLK string. ) */ - -L_scfm01: -/* $ Abstract */ - -/* Convert a number of ticks to an equivalent type 1 spacecraft clock */ -/* 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* INTEGER SC */ -/* DOUBLE PRECISION TICKS */ -/* CHARACTER*(*) CLKSTR */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* TICKS I Number of ticks represented by a clock count. */ -/* CLKSTR O Character string representation of the clock count. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF spacecraft identification code. See the */ -/* `Examples' section below, and also the KERNEL required */ -/* reading file for a complete list of body ID codes. */ - - -/* TICKS is the number of ticks to be converted to a spacecraft */ -/* clock string, where a tick is defined to be */ -/* the smallest time increment expressible by the */ -/* spacecraft clock. */ - -/* If TICKS contains a fractional part, the string that */ -/* results is the same as if TICKS had been rounded to */ -/* the nearest whole number. */ - -/* See Examples below. */ - -/* $ Detailed_Output */ - - -/* CLKSTR on output is the character string representation of */ -/* the spacecraft clock count. The returned string has */ -/* the form */ - -/* 'wwwwwwww:xx:y:z', */ - -/* where the number of components and the width of each */ -/* one are different for each spacecraft. The delimiter */ -/* used is determined by a kernel pool variable and is */ -/* one of the five specified by the parameter DELIMS. */ -/* See Examples below. */ - -/* If CLKSTR is not long enough to accommodate the */ -/* formatted tick value, the result will be truncated on */ -/* the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument CLKSTR will not */ -/* be modified. */ - -/* The variables that must be set by the SCLK kernel are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - -/* When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument CLKSTR will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - -/* 2) If any of the following kernel variables have invalid values, */ -/* the error will be diagnosed by routines called by this */ -/* routine: */ - -/* - The time system code */ -/* - The number of SCLK coefficients */ -/* - The number of partition start times */ -/* - The number of partition end times */ -/* - The number of fields of a SCLK string */ -/* - The number of moduli for a SCLK string */ - -/* If the number of values for any item read from the kernel */ -/* pool exceeds the maximum allowed value, it is may not be */ -/* possible to diagnose the error correctly, since overwriting */ -/* of memory may occur. This particular type of error is not */ -/* diagnosed by this routine. */ - -/* 3) If the input value for TICKS is negative, the error */ -/* SPICE(VALUEOUTOFRANGE) is signalled. The output argument */ -/* CLKSTR will not be modified. */ - -/* 4) If the output argument CLKSTR is too short to accommodate */ -/* the output string produced by this routine, the error */ -/* SPICE(SCLKTRUNCATED) is signalled. The output string */ -/* CLKSTR will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The routine determines the values of the components of the */ -/* spacecraft clock count that is equivalent to the number TICKS. */ -/* The information needed to perform this operation, such as the */ -/* number of clock components and their moduli, is provided by */ -/* an SCLK kernel file. Normally, your program should load this */ -/* file during initialization. */ - -/* This routine does not make use of any partition information. */ -/* See SCDECD for details on how to make use of partition numbers. */ - -/* $ Examples */ - -/* Below are some examples illustrating various inputs and the */ -/* resulting outputs for the Galileo spacecraft. */ - -/* TICKS CLKSTR */ -/* ---------------- -------------------- */ -/* -1 Error: Ticks must be a positive number */ -/* 0 '0:00:0:0' */ -/* 1 '0:00:0:1' */ -/* 1.3 '0:00:0:1' */ -/* 1.5 '0:00:0:2' */ -/* 2 '0:00:0:2' */ -/* 7 '0:00:0:7' */ -/* 8 '0:00:1:0' */ -/* 80 '0:01:0:0' */ -/* 88 '0:01:1:0' */ -/* 7279 '0:90:9:7' */ -/* 7280 '1:00:0:0' */ -/* 1234567890 '169583:45:6:2' */ - - -/* The following examples are for the Voyager 2 spacecraft. */ -/* Note that the third component of the Voyager clock has an */ -/* offset value of one. */ - -/* TICKS CLKSTR */ -/* ---------------- -------------------- */ -/* -1 Error: Ticks must be a positive number */ -/* 0 '00000 00 001' */ -/* 1 '00000 00 002' */ -/* 1.3 '00000:00:002' */ -/* 1.5 '00000.00.003' */ -/* 2 '00000-00-003' */ -/* 799 '00000,00,800' */ -/* 800 '00000 01 001' */ -/* 47999 '00000 59 800' */ -/* 48000 '00001 00 001' */ -/* 3145727999 '65535 59 800' */ - - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 2.1.0, 17-FEB-2008 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* Bug fix: spaces between fields are now inserted */ -/* correctly when the output field delimiter is blank. */ - -/* - SPICELIB Version 2.0.1, 18-JUL-1996 (NJB) */ - -/* Misspelling in header fixed. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* Error is now signalled if truncation of output string occurs. */ -/* Header was updated, particularly $Exceptions and $Restrictions */ -/* sections. Kernel pool watch is now set on required kernel */ -/* variables. Comment section for permuted index source lines */ -/* was added following the header. */ - -/* - SPICELIB Version 1.0.0, 06-SEP-1990 (NJB) (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert ticks to a type_1 spacecraft_clock string */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 17-FEB-2008 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* Bug fix: spaces between fields are now inserted */ -/* correctly when the output field delimiter is blank. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* An error is now signalled if truncation of output string */ -/* occurs. */ - -/* The header was updated to discuss exception handling when */ -/* the output string is truncated. The header was also expanded */ -/* to discuss the fact that a leapseconds kernel will now need to */ -/* be loaded in order to use SCLK kernels that map between SCLK */ -/* and a parallel time system other than TDB. The $Exceptions */ -/* and $Restrictions sections were affected. */ - -/* This routine now uses the new kernel pool watch capability */ -/* to determine when it is necessary to look up SCLK variables. */ -/* This method of checking for kernel pool updates replaces the */ -/* previously used once-per-call lookup of the SCLK_KERNEL_ID */ -/* kernel variable. */ - -/* A comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCFM01", (ftnlen)6); - } - -/* On the first pass through the subroutine, or if the spacecraft */ -/* clock ID changes, we will set watches on the SCLK kernel */ -/* variables for the current clock. */ - - if (first || *sc != oldsc) { - first = FALSE_; - -/* Make up a list of names of kernel variables that we'll use. */ -/* The first name in the list is SCLK_KERNEL_ID, which does not */ -/* require the addition of a spacecraft code suffix. For the */ -/* rest of the names, we'll have to add the suffix. */ - - s_copy(kvname, namlst, (ftnlen)60, (ftnlen)60); - movec_(namlst, &c__9, kvname, (ftnlen)60, (ftnlen)60); - for (i__ = 2; i__ <= 9; ++i__) { - suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? - i__1 : s_rnge("kvname", i__1, "sc01_", (ftnlen)1411)) * - 60, (ftnlen)2, (ftnlen)60); - i__3 = -(*sc); - repmi_(kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : - s_rnge("kvname", i__1, "sc01_", (ftnlen)1412)) * 60, - "#", &i__3, kvname + ((i__2 = i__ - 1) < 9 && 0 <= i__2 ? - i__2 : s_rnge("kvname", i__2, "sc01_", (ftnlen)1412)) * - 60, (ftnlen)60, (ftnlen)1, (ftnlen)60); - } - -/* Set a watch on all of the kernel variables we use. */ - - swpool_("SC01", &c__9, kvname, (ftnlen)4, (ftnlen)60); - -/* Keep track of the last spacecraft clock ID encountered. */ - - oldsc = *sc; - } - -/* Find out whether we need to look up new format descriptors from */ -/* the kernel pool. If any relevant kernel variables were updated, */ -/* we have to do a look-up. Note that changing the s/c clock ID */ -/* causes a new watch to be set, so a look-up is required. When we */ -/* do a look-up, we grab everything that any of the SC01 entry */ -/* points might need. */ - - cvpool_("SC01", &update, (ftnlen)4); - if (update || nodata) { - -/* Our first piece of business is to look up all of the data */ -/* we require from the kernel pool. We must form the names */ -/* of the items we want using the input S/C ID code. The items */ -/* we need are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - - scli01_(namlst + 240, sc, &c__1, &n, &nfield, (ftnlen)60); - scli01_(namlst + 420, sc, &c__1, &n, &delcde, (ftnlen)60); - scli01_(namlst + 480, sc, &c__1, &ntsys, &timsys, (ftnlen)60); - scld01_(namlst + 60, sc, &c_b22, &ncoeff, coeffs, (ftnlen)60); - scld01_(namlst + 120, sc, &c__9999, &n, prstrt, (ftnlen)60); - scld01_(namlst + 180, sc, &c__9999, &npart, prend, (ftnlen)60); - scld01_(namlst + 360, sc, &c__10, &n, moduli, (ftnlen)60); - scld01_(namlst + 300, sc, &c__10, &n, offset, (ftnlen)60); - -/* Don't try to continue if we had a lookup error. */ - - if (failed_()) { - nodata = TRUE_; - chkout_("SCFM01", (ftnlen)6); - return 0; - } - -/* The kernel pool look-up succeeded. */ - - nodata = FALSE_; - -/* Use the default time system (TDB) if none was specified in the */ -/* SCLK kernel. */ - - if (ntsys == 0) { - timsys = 1; - } - } - -/* Determine how many ticks each field is worth. */ - - cmptks[(i__1 = nfield - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmptks", - i__1, "sc01_", (ftnlen)1494)] = 1.; - for (i__ = nfield - 1; i__ >= 1; --i__) { - cmptks[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmptks", - i__1, "sc01_", (ftnlen)1497)] = cmptks[(i__2 = i__) < 10 && 0 - <= i__2 ? i__2 : s_rnge("cmptks", i__2, "sc01_", (ftnlen)1497) - ] * moduli[(i__3 = i__) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "moduli", i__3, "sc01_", (ftnlen)1497)]; - } - -/* Determine the width of each field. */ - - i__1 = nfield; - for (i__ = 1; i__ <= i__1; ++i__) { - maxwid = moduli[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "moduli", i__2, "sc01_", (ftnlen)1505)] + offset[(i__3 = i__ - - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("offset", i__3, "sc01_" - , (ftnlen)1505)] - 1.; - d__1 = maxwid + .5; - cmpwid[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmpwid", - i__2, "sc01_", (ftnlen)1507)] = (integer) d_lg10(&d__1) + 1; - } - -/* Check whether the output string is long enough to contain the */ -/* string we're about to assemble. We need room for (NFIELD - 1) */ -/* delimiters as well as for the numeric fields. */ - - needed = nfield - 1 + sumai_(cmpwid, &nfield); - if (i_len(clkstr, clkstr_len) < needed) { - setmsg_("Output argument has declared length #; required length is #" - ". Input tick value was #.", (ftnlen)84); - i__1 = i_len(clkstr, clkstr_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &needed, (ftnlen)1); - errdp_("#", ticks, (ftnlen)1); - sigerr_("SPICE(SCLKTRUNCATED)", (ftnlen)20); - chkout_("SCFM01", (ftnlen)6); - return 0; - } - -/* Need to check that TICKS is a positive number. */ - - if (d_nint(ticks) < 0.) { - setmsg_("Negative value for SCLK ticks: #", (ftnlen)32); - errdp_("#", ticks, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCFM01", (ftnlen)6); - return 0; - } - -/* Determine the value of each of the components. This is done by */ -/* successively dividing by the number of ticks each component value */ -/* is worth. */ - - rem = d_nint(ticks); - i__1 = nfield - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = rem / cmptks[(i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("cmptks", i__3, "sc01_", (ftnlen)1554)]; - cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmpval", - i__2, "sc01_", (ftnlen)1554)] = d_int(&d__1) + offset[(i__4 = - i__ - 1) < 10 && 0 <= i__4 ? i__4 : s_rnge("offset", i__4, - "sc01_", (ftnlen)1554)]; - rem = d_mod(&rem, &cmptks[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("cmptks", i__2, "sc01_", (ftnlen)1555)]); - } - cmpval[(i__1 = nfield - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmpval", - i__1, "sc01_", (ftnlen)1559)] = rem + offset[(i__2 = nfield - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("offset", i__2, "sc01_", (ftnlen) - 1559)]; - -/* Convert the values of each component from double precision */ -/* numbers to character strings. */ - - i__1 = nfield; - for (i__ = 1; i__ <= i__1; ++i__) { - dpstrf_(&cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmpval", i__2, "sc01_", (ftnlen)1567)], &c__30, "F", dpchar, - (ftnlen)1, (ftnlen)30); - end = i_indx(dpchar, ".", (ftnlen)30, (ftnlen)1) - 1; - length[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("length", - i__2, "sc01_", (ftnlen)1570)] = end - 1; - s_copy(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "sc01_", (ftnlen)1571)) * 30, dpchar + 1, ( - ftnlen)30, end - 1); - } - -/* Pad on the left with zeros if necessary. */ - - i__1 = nfield; - for (i__ = 1; i__ <= i__1; ++i__) { - pad = cmpwid[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmp" - "wid", i__2, "sc01_", (ftnlen)1580)] - length[(i__3 = i__ - 1) - < 10 && 0 <= i__3 ? i__3 : s_rnge("length", i__3, "sc01_", ( - ftnlen)1580)]; - if (pad > 0) { - i__2 = pad; - for (j = 1; j <= i__2; ++j) { - prefix_("0", &c__0, cmp + ((i__3 = i__ - 1) < 10 && 0 <= i__3 - ? i__3 : s_rnge("cmp", i__3, "sc01_", (ftnlen)1585)) * - 30, (ftnlen)1, (ftnlen)30); - } - } - } - -/* Construct the clock string with a delimiter separating */ -/* each field. */ - - s_copy(clkstr, cmp, clkstr_len, (ftnlen)30); - i__1 = nfield; - for (i__ = 2; i__ <= i__1; ++i__) { - if (*(unsigned char *)&del[(i__2 = delcde - 1) < 5 && 0 <= i__2 ? - i__2 : s_rnge("del", i__2, "sc01_", (ftnlen)1600)] != ' ') { - prefix_(del + ((i__2 = delcde - 1) < 5 && 0 <= i__2 ? i__2 : - s_rnge("del", i__2, "sc01_", (ftnlen)1602)), &c__0, cmp + - ((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("cmp", - i__3, "sc01_", (ftnlen)1602)) * 30, (ftnlen)1, (ftnlen) - 30); - suffix_(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "sc01_", (ftnlen)1603)) * 30, &c__0, clkstr, - (ftnlen)30, clkstr_len); - } else { - suffix_(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "sc01_", (ftnlen)1605)) * 30, &c__1, clkstr, - (ftnlen)30, clkstr_len); - } - } - chkout_("SCFM01", (ftnlen)6); - return 0; -/* $Procedure SCTE01 ( Ticks to ET, type 01 ) */ - -L_scte01: -/* $ Abstract */ - -/* Convert encoded type 1 spacecraft clock (`ticks') to ephemeris */ -/* seconds past J2000 (ET). */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* INTEGER SC */ -/* DOUBLE PRECISION SCLKDP */ -/* DOUBLE PRECISION ET */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* SCLKDP I Type 1 SCLK, encoded as ticks since clock start. */ -/* ET I Ephemeris time, seconds past J2000. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF ID code for a spacecraft, one of whose */ -/* clock values is represented by SCLKDP. */ - -/* SCLKDP is an encoded type 1 spacecraft clock value */ -/* produced by the routine SCENCD. SCLKDP is a */ -/* count of ticks since spacecraft clock start: */ -/* partition information IS included in the encoded */ -/* value. */ - -/* $ Detailed_Output */ - -/* ET is the ephemeris time, seconds past J2000, that */ -/* corresponds to SCLKDP. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument ET will not */ -/* be modified. */ - -/* The variables that must be set by the SCLK kernel are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - -/* When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument ET will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - - -/* 2) If any of the following kernel variables have invalid values, */ -/* the error will be diagnosed by routines called by this */ -/* routine: */ - -/* - The time system code */ -/* - The number of SCLK coefficients */ -/* - The number of partition start times */ -/* - The number of partition end times */ -/* - The number of fields of a SCLK string */ -/* - The number of moduli for a SCLK string */ - -/* If the number of values for any item read from the kernel */ -/* pool exceeds the maximum allowed value, it is may not be */ -/* possible to diagnose the error correctly, since overwriting */ -/* of memory may occur. This particular type of error is not */ -/* diagnosed by this routine. */ - - -/* 3) If the input SCLK value SCLKDP is out of range, this routine */ -/* will signal the error SPICE(VALUEOUTOFRANGE). The output */ -/* argument ET will not be modified. */ - - -/* 4) If the partition times or SCLK coefficients themselves */ -/* are invalid, this routine will almost certainly give */ -/* incorrect results. This routine cannot diagnose errors */ -/* in the partition times or SCLK coefficients, except possibly */ -/* by crashing. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SCTE01 is not usually called by routines external to SPICELIB. */ -/* The conversion routine SCT2E converts any type of encoded */ -/* spacecraft clock value produced by SCENCD to ephemeris seconds */ -/* past J2000. SCT2E is the preferred user interface routine */ -/* because its interface specification does not refer to spacecraft */ -/* clock types. However, direct use of SCTE01 by user routines is */ -/* not prohibited. */ - -/* $ Examples */ - -/* 1) Convert an encoded type 1 SCLK value to ET: */ - -/* During program initialization, load the leapseconds and SCLK */ -/* kernels. We will assume that these files are named */ -/* "LEAPSECONDS.KER" and "SCLK.KER". You must substitute the */ -/* actual names of these files in your code. */ - -/* CALL CLPOOL */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* If SCLKDP is an encoded spacecraft clock value, if SC */ -/* is the NAIF integer code for the spacecraft whose */ -/* SCLK <--> ET mapping is defined by the data in SCLK.KER, */ -/* then the call */ - -/* CALL SCTE01 ( SC, SCLKDP, ET ) */ - -/* will return the ET value corresponding to SCLKDP. */ - -/* For example, if SC is -77, indicating the Galileo spacecraft, */ -/* and if a Galileo SCLK kernel is loaded, then if SCLKDP */ -/* is set to */ - -/* 7.2800000000000E+05 */ - -/* the call */ - -/* CALL SCTE01 ( SC, SCLKDP, ET ) */ - -/* returns ET as */ - -/* -3.2286984854565E+08 */ - -/* on a VAX 11/780 running VMS 5.3, Fortran 5.5. */ - - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.2.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 3.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 3.0.0, 06-JAN-1998 (NJB) */ - -/* Removed local variable RNDCLK; this entry point no longer */ -/* creates a rounded version of its input argument. Use of */ -/* ANINT to round coefficients has been discontinued. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* This routine was updated to handle SCLK kernels that use */ -/* TDT as their `parallel' time system. Header was updated, */ -/* particularly $Exceptions and $Restrictions. Watch is now */ -/* set on required kernel variables. Comment section for */ -/* permuted index source lines was added following the header. */ - -/* - SPICELIB Version 1.0.0, 21-AUG-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* type_1 ticks to ephemeris time */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 3.0.0, 06-JAN-1998 (NJB) */ - -/* Removed local variable RNDCLK; this entry point no longer */ -/* creates a rounded version of its input argument. Use of */ -/* ANINT to round coefficients has been discontinued. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* This routine was updated to handle a time system specification */ -/* for the `parallel' time system used in the SCLK kernel. */ - -/* Specific changes include: */ - -/* -- The time system code is looked up along with the */ -/* other SCLK specification parameters. */ - -/* -- The time value arrived at by interpolation of the */ -/* SCLK-to-parallel time mapping is converted to TDB */ -/* if the parallel time system is TDT. */ - -/* The header was expanded to discuss the fact that a leapseconds */ -/* kernel will now need to be loaded in order to use SCLK kernels */ -/* that map between SCLK and a parallel time system other than */ -/* TDB. The $Exceptions and $Restrictions sections were affected. */ - -/* This routine now uses the new kernel pool watch capability */ -/* to determine when it is necessary to look up SCLK variables. */ -/* This method of checking for kernel pool updates replaces the */ -/* previously used once-per-call lookup of the SCLK_KERNEL_ID */ -/* kernel variable. */ - -/* A comment section for permuted index source lines was added */ -/* following the header. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCTE01", (ftnlen)6); - } - -/* On the first pass through the subroutine, or if the spacecraft */ -/* clock ID changes, we will set watches on the SCLK kernel */ -/* variables for the current clock. */ - - if (first || *sc != oldsc) { - first = FALSE_; - -/* Make up a list of names of kernel variables that we'll use. */ -/* The first name in the list is SCLK_KERNEL_ID, which does not */ -/* require the addition of a spacecraft code suffix. For the */ -/* rest of the names, we'll have to add the suffix. */ - - movec_(namlst, &c__9, kvname, (ftnlen)60, (ftnlen)60); - for (i__ = 2; i__ <= 9; ++i__) { - suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? - i__1 : s_rnge("kvname", i__1, "sc01_", (ftnlen)1937)) * - 60, (ftnlen)2, (ftnlen)60); - i__3 = -(*sc); - repmi_(kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : - s_rnge("kvname", i__1, "sc01_", (ftnlen)1938)) * 60, - "#", &i__3, kvname + ((i__2 = i__ - 1) < 9 && 0 <= i__2 ? - i__2 : s_rnge("kvname", i__2, "sc01_", (ftnlen)1938)) * - 60, (ftnlen)60, (ftnlen)1, (ftnlen)60); - } - -/* Set a watch on all of the kernel variables we use. */ - - swpool_("SC01", &c__9, kvname, (ftnlen)4, (ftnlen)60); - -/* Keep track of the last spacecraft clock ID encountered. */ - - oldsc = *sc; - } - -/* Find out whether we need to look up new format descriptors from */ -/* the kernel pool. If any relevant kernel variables were updated, */ -/* we have to do a look-up. Note that changing the s/c clock ID */ -/* causes a new watch to be set, so a look-up is required. When we */ -/* do a look-up, we grab everything that any of the SC01 entry */ -/* points might need. */ - - cvpool_("SC01", &update, (ftnlen)4); - if (update || nodata) { - -/* Our first piece of business is to look up all of the data */ -/* we require from the kernel pool. We must form the names */ -/* of the items we want using the input S/C ID code. The items */ -/* we need are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - - scli01_(namlst + 240, sc, &c__1, &n, &nfield, (ftnlen)60); - scli01_(namlst + 420, sc, &c__1, &n, &delcde, (ftnlen)60); - scli01_(namlst + 480, sc, &c__1, &ntsys, &timsys, (ftnlen)60); - scld01_(namlst + 60, sc, &c_b22, &ncoeff, coeffs, (ftnlen)60); - scld01_(namlst + 120, sc, &c__9999, &n, prstrt, (ftnlen)60); - scld01_(namlst + 180, sc, &c__9999, &npart, prend, (ftnlen)60); - scld01_(namlst + 360, sc, &c__10, &n, moduli, (ftnlen)60); - scld01_(namlst + 300, sc, &c__10, &n, offset, (ftnlen)60); - -/* Don't try to continue if we had a lookup error. */ - - if (failed_()) { - nodata = TRUE_; - chkout_("SCTE01", (ftnlen)6); - return 0; - } - -/* The kernel pool look-up succeeded. */ - - nodata = FALSE_; - -/* Use the default time system (TDB) if none was specified in the */ -/* SCLK kernel. */ - - if (ntsys == 0) { - timsys = 1; - } - } - -/* To check whether SCLKDP is in range, we must find the end time */ -/* of the last partition, in total ticks since spacecraft clock */ -/* start. */ - - mxtick = 0.; - i__1 = npart; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = prend[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge( - "prend", i__2, "sc01_", (ftnlen)2025)] - prstrt[(i__3 = i__ - - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prstrt", i__3, "sc01_" - , (ftnlen)2025)] + mxtick; - mxtick = d_nint(&d__1); - } - -/* We now check that SCLKDP is in range. COEFFS(1,1) and */ -/* MXTICK are, respectively, the first and last absolute */ -/* tick values of the clock. */ - - if (*sclkdp < coeffs[0] || *sclkdp > mxtick) { - setmsg_(bvlmsg, (ftnlen)320); - errch_("#", "SCLKDP", (ftnlen)1, (ftnlen)6); - errdp_("#", sclkdp, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCTE01", (ftnlen)6); - return 0; - } - -/* Ok, if we made it this far, we can actually interpret the tick */ -/* value. But by this time, we're not in very good mood. */ - - -/* Find the tick value in COEFFS closest to the rounded input tick */ -/* value. The tick values in COEFFS are monotone increasing, so we */ -/* can do a binary search to find index of the greatest tick value */ -/* in the coefficient array that is less than or equal to SCLKDP. */ - -/* There are two cases: */ - -/* 1) SCLKDP is bounded by the least and greatest SCLK */ -/* coefficients in the array. In this case, we must search */ -/* the array for a consecutive pair of records whose SCLK */ -/* values bound SCLKDP. */ - -/* 2) SCLKDP is greater than or equal to all of the SCLK */ -/* coefficients. In that case, we don't need to search: the */ -/* last SCLK value in the array is the one we want. */ - - if (*sclkdp < coeffs[(i__1 = ncoeff / 3 * 3 - 3) < 150000 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)2069)]) { - lower = 1; - upper = ncoeff / 3; - -/* In the following loop, we maintain an invariant: */ - -/* COEFFS( 1, LOWER ) < SCLKDP < COEFFS( 1, UPPER ) */ -/* - */ - -/* At each step, we decrease the distance between LOWER and */ -/* UPPER, while keeping the above statement true. The loop */ -/* terminates when LOWER = UPPER - 1. */ - -/* Note that we start out with if LOWER < UPPER, since we've */ -/* already made sure that the invariant expression above is true. */ - - while(lower < upper - 1) { - middle = (lower + upper) / 2; - if (*sclkdp < coeffs[(i__1 = middle * 3 - 3) < 150000 && 0 <= - i__1 ? i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen) - 2091)]) { - upper = middle; - } else { - lower = middle; - } - } - -/* We've got SCLKDP trapped between two tick values that are */ -/* `adjacent' in the list: */ - -/* COEFFS ( 1, LOWER ) and */ -/* COEFFS ( 1, UPPER ) */ - -/* since the second value must be greater than the first. So */ - -/* COEFFS( 1, LOWER ) */ - -/* is the last tick value in the coefficients array less than or */ -/* equal to SCLKDP. */ - - } else { - -/* SCLKDP is greater than or equal to all of the SCLK */ -/* coefficients in the coefficients array. */ - - lower = ncoeff / 3; - } - -/* Now we evaluate a linear polynomial to find the time value that */ -/* corresponds to SCLKDP. The coefficients of the polynomial are */ -/* the time and rate (in units of seconds per tick) that correspond */ -/* to the tick value */ - -/* COEFFS( 1, LOWER ) */ - -/* We call these coefficients CONST and RATE. The rates in the */ -/* coefficients array are in units of seconds per most significant */ -/* SCLK count, so we use the conversion factor TIKMSC to change the */ -/* rate to seconds per tick. */ - - tikmsc = 1.; - for (i__ = nfield; i__ >= 2; --i__) { - tikmsc *= moduli[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "moduli", i__1, "sc01_", (ftnlen)2139)]; - } - tikdif = *sclkdp - coeffs[(i__1 = lower * 3 - 3) < 150000 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)2142)]; - const__ = coeffs[(i__1 = lower * 3 - 2) < 150000 && 0 <= i__1 ? i__1 : - s_rnge("coeffs", i__1, "sc01_", (ftnlen)2143)]; - rate = coeffs[(i__1 = lower * 3 - 1) < 150000 && 0 <= i__1 ? i__1 : - s_rnge("coeffs", i__1, "sc01_", (ftnlen)2144)] / tikmsc; - partim = const__ + rate * tikdif; - -/* Convert the parallel time to TDB, if the system is not TDB. */ -/* We don't need to check the validity of TIMSYS, because SCLI01 */ -/* already made this check. */ - - if (timsys == 1) { - *et = partim; - } else if (timsys == 2) { - *et = unitim_(&partim, "TDT", "TDB", (ftnlen)3, (ftnlen)3); - } - chkout_("SCTE01", (ftnlen)6); - return 0; -/* $Procedure SCET01 ( ET to discrete ticks, type 1 ) */ - -L_scet01: -/* $ Abstract */ - -/* Convert ephemeris seconds past J2000 (ET) to discrete encoded */ -/* type 1 spacecraft clock (`ticks'). */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* INTEGER SC */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION SCLKDP */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* ET I Ephemeris time, seconds past J2000. */ -/* SCLKDP O Type 1 SCLK, encoded as ticks since clock start. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF ID code for a spacecraft, one of whose */ -/* clock values is represented by SCLKDP. */ - -/* ET is an ephemeris time, specified in seconds past */ -/* J2000, whose equivalent encoded SCLK value is */ -/* desired. */ - -/* $ Detailed_Output */ - -/* SCLKDP is the encoded type 1 spacecraft clock value */ -/* that corresponds to ET. The value is obtained */ -/* by mapping ET, using the piecewise linear mapping */ -/* defined by the SCLK kernel, to a value that may */ -/* have a non-zero fractional part, and then */ -/* rounding this value to the nearest double precision */ -/* whole number. */ - -/* SCLKDP represents total time since spacecraft */ -/* clock start and hence does reflect partition */ -/* information. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument SCLKDP will not */ -/* be modified. */ - -/* The variables that must be set by the SCLK kernel are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - -/* When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument SCLKDP will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - -/* 2) If any of the following kernel variables have invalid values, */ -/* the error will be diagnosed by routines called by this */ -/* routine: */ - -/* - The time system code */ -/* - The number of SCLK coefficients */ -/* - The number of partition start times */ -/* - The number of partition end times */ -/* - The number of fields of a SCLK string */ -/* - The number of moduli for a SCLK string */ - -/* If the number of values for any item read from the kernel */ -/* pool exceeds the maximum allowed value, it is may not be */ -/* possible to diagnose the error correctly, since overwriting */ -/* of memory may occur. This particular type of error is not */ -/* diagnosed by this routine. */ - -/* 3) If the input ephemeris time value ET is out of range, this */ -/* routine will signal the error SPICE(VALUEOUTOFRANGE). */ -/* The output argument SCLKDP will not be modified. */ - -/* 4) If the SCLK rate used to interpolate SCLK values is zero, the */ -/* error SPICE(VALUEOUTOFRANGE) is signalled. The output */ -/* argument SCLKDP will not be modified. */ - -/* 5) If the partition times or SCLK coefficients themselves */ -/* are invalid, this routine will almost certainly give */ -/* incorrect results. This routine cannot diagnose errors */ -/* in the partition times or SCLK coefficients, except possibly */ -/* by crashing. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Normally, the newer entry point SCEC01 (ET to continuous ticks, */ -/* type 1) should be used in place of this routine. */ - -/* SCET01 is not usually called by routines external to SPICELIB. */ -/* The conversion routine SCE2T converts ephemeris seconds past J2000 */ -/* to any type of discrete, encoded type 1 spacecraft clock value. */ -/* For conversion to continuous, encoded SCLK, SCE2C is the preferred */ -/* user interface routine because its interface specification does */ -/* not refer to spacecraft clock types. For conversion to discrete, */ -/* encoded SCLK, SCE2T is the preferred interface routine. */ - -/* However, direct use of SCET01 by user routines is not prohibited. */ - -/* $ Examples */ - -/* 1) Converting ET to encoded type 1 SCLK: */ - -/* During program initialization, load the leapseconds and SCLK */ -/* kernels. We will assume that these files are named */ -/* "LEAPSECONDS.KER" and "SCLK.KER". You must substitute the */ -/* actual names of these files in your code. */ - -/* CALL CLPOOL */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* If SC is -77, indicating the Galileo spacecraft, and */ -/* ET is set to */ - -/* -3.2286984854565E+08 */ - -/* then the call */ - -/* CALL SCET01 ( SC, ET, SCLKDP ) */ - -/* returns SCLKDP as */ - -/* 7.2800000000000E+05 */ - -/* on a VAX 11/780 running VMS 5.3, Fortran 5.5. Note that */ -/* the result should be the same (except for the output format) */ -/* on most computers, since the result is a double precision */ -/* whole number. */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 2.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 2.0.3, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 2.0.2, 09-MAR-1999 (NJB) */ - -/* Comments were updated; references to SCE2C and SCEC01 were */ -/* added. */ - -/* - SPICELIB Version 2.0.1, 18-JUL-1996 (NJB) */ - -/* Typo in comment fixed. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* This routine was updated to handle SCLK kernels that use */ -/* TDT as their `parallel' time system. Header was updated, */ -/* particularly $Exceptions and $Restrictions. Watch is now */ -/* set on required kernel variables. Comment section for */ -/* permuted index source lines was added following the header. */ - -/* - SPICELIB Version 1.0.0, 04-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ephemeris time to type_1 ticks */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) */ - -/* This routine was updated to handle a time system specification */ -/* for the `parallel' time system used in the SCLK kernel. */ - -/* Specific changes include: */ - -/* -- The time system code is looked up along with the */ -/* other SCLK specification parameters. */ - -/* -- The input TDB value is converted, if necessary, to the */ -/* time system used in the parallel-time-to-SCLK mapping */ -/* defined by the current SCLK coefficients for the */ -/* specified spacecraft clock. This conversion is performed */ -/* prior to determination by interpolation of the */ -/* corresponding encoded SCLK value. */ - -/* The header was expanded to discuss the fact that a leapseconds */ -/* kernel will now need to be loaded in order to use SCLK kernels */ -/* that map between SCLK and a parallel time system other than */ -/* TDB. The $Exceptions and $Restrictions sections were affected. */ - -/* This routine now uses the new kernel pool watch capability */ -/* to determine when it is necessary to look up SCLK variables. */ -/* This method of checking for kernel pool updates replaces the */ -/* previously used once-per-call lookup of the SCLK_KERNEL_ID */ -/* kernel variable. */ - -/* A comment section for permuted index source lines was added */ -/* following the header. */ -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCET01", (ftnlen)6); - } - -/* On the first pass through the subroutine, or if the spacecraft */ -/* clock ID changes, we will set watches on the SCLK kernel */ -/* variables for the current clock. */ - - if (first || *sc != oldsc) { - first = FALSE_; - -/* Make up a list of names of kernel variables that we'll use. */ -/* The first name in the list is SCLK_KERNEL_ID, which does not */ -/* require the addition of a spacecraft code suffix. For the */ -/* rest of the names, we'll have to add the suffix. */ - - movec_(namlst, &c__9, kvname, (ftnlen)60, (ftnlen)60); - for (i__ = 2; i__ <= 9; ++i__) { - suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? - i__1 : s_rnge("kvname", i__1, "sc01_", (ftnlen)2500)) * - 60, (ftnlen)2, (ftnlen)60); - i__3 = -(*sc); - repmi_(kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : - s_rnge("kvname", i__1, "sc01_", (ftnlen)2501)) * 60, - "#", &i__3, kvname + ((i__2 = i__ - 1) < 9 && 0 <= i__2 ? - i__2 : s_rnge("kvname", i__2, "sc01_", (ftnlen)2501)) * - 60, (ftnlen)60, (ftnlen)1, (ftnlen)60); - } - -/* Set a watch on all of the kernel variables we use. */ - - swpool_("SC01", &c__9, kvname, (ftnlen)4, (ftnlen)60); - -/* Keep track of the last spacecraft clock ID encountered. */ - - oldsc = *sc; - } - -/* Find out whether we need to look up new format descriptors from */ -/* the kernel pool. If any relevant kernel variables were updated, */ -/* we have to do a look-up. Note that changing the s/c clock ID */ -/* causes a new watch to be set, so a look-up is required. When we */ -/* do a look-up, we grab everything that any of the SC01 entry */ -/* points might need. */ - - cvpool_("SC01", &update, (ftnlen)4); - if (update || nodata) { - -/* Our first piece of business is to look up all of the data */ -/* we require from the kernel pool. We must form the names */ -/* of the items we want using the input S/C ID code. The items */ -/* we need are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - - scli01_(namlst + 240, sc, &c__1, &n, &nfield, (ftnlen)60); - scli01_(namlst + 420, sc, &c__1, &n, &delcde, (ftnlen)60); - scli01_(namlst + 480, sc, &c__1, &ntsys, &timsys, (ftnlen)60); - scld01_(namlst + 60, sc, &c_b22, &ncoeff, coeffs, (ftnlen)60); - scld01_(namlst + 120, sc, &c__9999, &n, prstrt, (ftnlen)60); - scld01_(namlst + 180, sc, &c__9999, &npart, prend, (ftnlen)60); - scld01_(namlst + 360, sc, &c__10, &n, moduli, (ftnlen)60); - scld01_(namlst + 300, sc, &c__10, &n, offset, (ftnlen)60); - -/* Don't try to continue if we had a lookup error. */ - - if (failed_()) { - nodata = TRUE_; - chkout_("SCET01", (ftnlen)6); - return 0; - } - -/* The kernel pool look-up succeeded. */ - - nodata = FALSE_; - -/* Use the default time system (TDB) if none was specified in the */ -/* SCLK kernel. */ - - if (ntsys == 0) { - timsys = 1; - } - } - -/* Convert the input TDB time to the parallel time system, if the */ -/* parallel system is not TDB. */ - -/* We don't need to check the validity of TIMSYS, because SCLI01 */ -/* already made this check. */ - - if (timsys == 1) { - partim = *et; - } else if (timsys == 2) { - partim = unitim_(et, "TDB", "TDT", (ftnlen)3, (ftnlen)3); - } - -/* We'd like to ascertain whether PARTIM is between the minimum */ -/* time value in the coefficients array and the end time */ -/* corresponding to the number of ticks since spacecraft clock */ -/* start at the end of the last partition. */ - -/* Checking the time value is a special case; we'll convert the time */ -/* value to ticks, and then check whether the resulting value is */ -/* less than the total number of ticks since spacecraft clock start */ -/* at the end of the last partition. So, this check is performed */ -/* at the end of the routine. */ - -/* Find the time value in COEFFS closest to the input time value. */ -/* The time values are ordered, so we can do a binary search for the */ -/* closest one. When the search is done, we will have found the */ -/* index of the greatest time value in the coefficient array that */ -/* is less than or equal to PARTIM. */ - - -/* There are three cases: */ - -/* 1) PARTIM is less than the least time coefficient in the array. */ -/* In this case, we'll use the first coefficient set in the */ -/* kernel to extrapolate from. We don't automatically treat */ -/* this case as an error because PARTIM could round up to the */ -/* minimum tick value when converted to ticks. */ - -/* 2) PARTIM is bounded by the least and greatest time */ -/* coefficients in the array. In this case, we must search */ -/* the array for a consecutive pair of records whose time */ -/* values bound PARTIM. */ - -/* 3) PARTIM is greater than or equal to all of the time */ -/* coefficients. In that case, we don't need to search: the */ -/* last time value in the array is the one we want. */ - - - if (partim < coeffs[1]) { - -/* The coefficient set to use for extrapolation is the first. */ - - lower = 1; - } else if (partim < coeffs[(i__1 = ncoeff / 3 * 3 - 2) < 150000 && 0 <= - i__1 ? i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)2642)]) { - -/* In the following loop, we maintain an invariant: */ - -/* COEFFS( 2, LOWER ) < PARTIM < COEFFS( 2, UPPER ) */ -/* - */ - -/* At each step, we decrease the distance between LOWER and */ -/* UPPER, while keeping the above statement true. The loop */ -/* terminates when LOWER = UPPER - 1. */ - -/* Note that we start out with if LOWER < UPPER, since we've */ -/* already made sure that the invariant expression above is true. */ - - lower = 1; - upper = ncoeff / 3; - while(lower < upper - 1) { - middle = (lower + upper) / 2; - if (partim < coeffs[(i__1 = middle * 3 - 2) < 150000 && 0 <= i__1 - ? i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)2664)]) { - upper = middle; - } else { - lower = middle; - } - } - -/* We've got PARTIM trapped between two time values that are */ -/* `adjacent' in the list: */ - -/* COEFFS ( 2, LOWER ) and */ -/* COEFFS ( 2, UPPER ) */ - -/* since the second value must be greater than the first. So */ - -/* COEFFS( 2, LOWER ) */ - -/* is the last time value in the coefficients array less than or */ -/* equal to PARTIM. */ - - } else { - -/* PARTIM is greater than or equal to all of the time values in */ -/* the coefficients array. */ - - lower = ncoeff / 3; - } - -/* Now we evaluate a linear polynomial to find the tick value that */ -/* corresponds to PARTIM. The coefficients of the polynomial are */ -/* the tick value and rate (in units of ticks per second) that */ -/* correspond to the time value */ - -/* COEFFS( 2, LOWER ) */ - -/* We call these coefficients CONST and RATE. The rates in the */ -/* coefficients array are in units of seconds per most significant */ -/* clock count, so we use the conversion factor TIKMSC (`ticks per */ -/* most significant count') to change the rate to seconds per tick. */ - -/* One other thing: SCLKDP should be an integral number of ticks. */ -/* We use the generic `nearest whole number' function ANINT to */ -/* ensure this. */ - - timdif = partim - coeffs[(i__1 = lower * 3 - 2) < 150000 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)2713)]; - const__ = coeffs[(i__1 = lower * 3 - 3) < 150000 && 0 <= i__1 ? i__1 : - s_rnge("coeffs", i__1, "sc01_", (ftnlen)2714)]; - if (coeffs[(i__1 = lower * 3 - 1) < 150000 && 0 <= i__1 ? i__1 : s_rnge( - "coeffs", i__1, "sc01_", (ftnlen)2716)] <= 0.) { - setmsg_("Invalid SCLK rate.", (ftnlen)18); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCET01", (ftnlen)6); - return 0; - } - tikmsc = 1.; - for (i__ = nfield; i__ >= 2; --i__) { - tikmsc *= moduli[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "moduli", i__1, "sc01_", (ftnlen)2729)]; - } - rate = 1. / (coeffs[(i__1 = lower * 3 - 1) < 150000 && 0 <= i__1 ? i__1 : - s_rnge("coeffs", i__1, "sc01_", (ftnlen)2732)] / tikmsc); - d__1 = const__ + rate * timdif; - *sclkdp = d_nint(&d__1); - -/* Now, we'll see whether the SCLK value we've found is meaningful. */ -/* If it's too large, that's because the input PARTIM was beyond the */ -/* maximum value we can handle. To check whether PARTIM is in */ -/* range, we must find the end time of the last partition, in total */ -/* ticks since spacecraft clock start. */ - - d__1 = prend[0] - prstrt[0]; - mxtick = d_nint(&d__1); - i__1 = npart; - for (i__ = 2; i__ <= i__1; ++i__) { - d__1 = prend[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge( - "prend", i__2, "sc01_", (ftnlen)2746)] - prstrt[(i__3 = i__ - - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prstrt", i__3, "sc01_" - , (ftnlen)2746)] + mxtick; - mxtick = d_nint(&d__1); - } - -/* Make sure that ET does not precede the ET corresponding to */ -/* the clock's minimum tick value or exceed the ET corresponding to */ -/* the clock's maximum tick value. We'll do the comparison */ -/* using the tick value that ET mapped to and the minimum and */ -/* maximum tick values of the spacecraft clock. */ - -/* Convert SCLKDP and COEFFS(1,1) to whole numbers, so that */ -/* direct comparisons without tolerances are possible. */ - - *sclkdp = d_nint(sclkdp); - coeffs[0] = d_nint(coeffs); - if (*sclkdp < coeffs[0] || *sclkdp > mxtick) { - setmsg_(bvlmsg, (ftnlen)320); - errch_("#", "ET", (ftnlen)1, (ftnlen)2); - errdp_("#", et, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCET01", (ftnlen)6); - return 0; - } - chkout_("SCET01", (ftnlen)6); - return 0; -/* $Procedure SCEC01 ( ET to continuous ticks, type 1 ) */ - -L_scec01: -/* $ Abstract */ - -/* Convert ephemeris seconds past J2000 (ET) to continuous encoded */ -/* type 1 spacecraft clock (`ticks'). The output value need not be */ -/* integral. */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* INTEGER SC */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION SCLKDP */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* ET I Ephemeris time, seconds past J2000. */ -/* SCLKDP O Type 1 SCLK, encoded as continuous ticks since */ -/* clock start. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF ID code for a spacecraft, one of whose */ -/* clock values is represented by SCLKDP. */ - -/* ET is an ephemeris time, specified in seconds past */ -/* J2000, whose equivalent encoded SCLK value is */ -/* desired. */ - -/* $ Detailed_Output */ - -/* SCLKDP is the continuous encoded type 1 spacecraft clock */ -/* value corresponding to ET. The value is obtained */ -/* by mapping ET, using the piecewise linear mapping */ -/* defined by the SCLK kernel, to a value that may */ -/* have a non-zero fractional part. Unlike the output */ -/* of SCET01, SCLKDP is not rounded by this routine. */ - -/* SCLKDP represents total time since spacecraft */ -/* clock start and hence does reflect partition */ -/* information. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument SCLKDP will not */ -/* be modified. */ - -/* The variables that must be set by the SCLK kernel are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - -/* When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument SCLKDP will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - -/* 2) If any of the following kernel variables have invalid values, */ -/* the error will be diagnosed by routines called by this */ -/* routine: */ - -/* - The time system code */ -/* - The number of SCLK coefficients */ -/* - The number of partition start times */ -/* - The number of partition end times */ -/* - The number of fields of a SCLK string */ -/* - The number of moduli for a SCLK string */ - -/* If the number of values for any item read from the kernel */ -/* pool exceeds the maximum allowed value, it is may not be */ -/* possible to diagnose the error correctly, since overwriting */ -/* of memory may occur. This particular type of error is not */ -/* diagnosed by this routine. */ - -/* 3) If the input ephemeris time value ET is out of range, this */ -/* routine will signal the error SPICE(VALUEOUTOFRANGE). */ -/* The output argument SCLKDP will not be modified. */ - -/* 4) If the SCLK rate used to interpolate SCLK values is zero, the */ -/* error SPICE(VALUEOUTOFRANGE) is signalled. The output */ -/* argument SCLKDP will not be modified. */ - -/* 5) If the partition times or SCLK coefficients themselves */ -/* are invalid, this routine will almost certainly give */ -/* incorrect results. This routine cannot diagnose errors */ -/* in the partition times or SCLK coefficients, except possibly */ -/* by crashing. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SCEC01 is not usually called by routines external to SPICELIB. */ -/* The conversion routine SCE2C converts ephemeris seconds */ -/* past J2000 to any type of encoded spacecraft clock value. */ -/* SCE2C is the preferred user interface routine because its */ -/* interface specification does not refer to spacecraft clock types. */ -/* However, direct use of SCEC01 by user routines is not prohibited. */ - -/* $ Examples */ - -/* 1) Converting ET to encoded type 1 SCLK: */ - -/* During program initialization, load the leapseconds and SCLK */ -/* kernels. We will assume that these files are named */ -/* "LEAPSECONDS.KER" and "SCLK.KER". You must substitute the */ -/* actual names of these files in your code. */ - -/* CALL CLPOOL */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* If SC is -77, indicating the Galileo spacecraft, and */ -/* ET is set to */ - -/* -27848635.8149248 */ - -/* then the call */ - -/* CALL SCEC01 ( SC, ET, SCLKDP ) */ - -/* returns SCLKDP as */ - -/* 35425287435.8554 */ - -/* on a NeXT workstation running NEXTSTEP 3.3. */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 1.2.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 1.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* - SPICELIB Version 1.0.0, 13-FEB-1999 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ephemeris time to continuous type_1 ticks */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-NOV-2007 (NJB) */ - -/* Bug fix: changed maximum value arguments to 1 in */ -/* calls to SCLI01 to fetch NFIELD and DELCDE values. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCEC01", (ftnlen)6); - } - -/* On the first pass through the subroutine, or if the spacecraft */ -/* clock ID changes, we will set watches on the SCLK kernel */ -/* variables for the current clock. */ - - if (first || *sc != oldsc) { - first = FALSE_; - -/* Make up a list of names of kernel variables that we'll use. */ -/* The first name in the list is SCLK_KERNEL_ID, which does not */ -/* require the addition of a spacecraft code suffix. For the */ -/* rest of the names, we'll have to add the suffix. */ - - movec_(namlst, &c__9, kvname, (ftnlen)60, (ftnlen)60); - for (i__ = 2; i__ <= 9; ++i__) { - suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? - i__1 : s_rnge("kvname", i__1, "sc01_", (ftnlen)3054)) * - 60, (ftnlen)2, (ftnlen)60); - i__3 = -(*sc); - repmi_(kvname + ((i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : - s_rnge("kvname", i__1, "sc01_", (ftnlen)3055)) * 60, - "#", &i__3, kvname + ((i__2 = i__ - 1) < 9 && 0 <= i__2 ? - i__2 : s_rnge("kvname", i__2, "sc01_", (ftnlen)3055)) * - 60, (ftnlen)60, (ftnlen)1, (ftnlen)60); - } - -/* Set a watch on all of the kernel variables we use. */ - - swpool_("SC01", &c__9, kvname, (ftnlen)4, (ftnlen)60); - -/* Keep track of the last spacecraft clock ID encountered. */ - - oldsc = *sc; - } - -/* Find out whether we need to look up new format descriptors from */ -/* the kernel pool. If any relevant kernel variables were updated, */ -/* we have to do a look-up. Note that changing the s/c clock ID */ -/* causes a new watch to be set, so a look-up is required. When we */ -/* do a look-up, we grab everything that any of the SC01 entry */ -/* points might need. */ - - cvpool_("SC01", &update, (ftnlen)4); - if (update || nodata) { - -/* Our first piece of business is to look up all of the data */ -/* we require from the kernel pool. We must form the names */ -/* of the items we want using the input S/C ID code. The items */ -/* we need are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - - scli01_(namlst + 240, sc, &c__1, &n, &nfield, (ftnlen)60); - scli01_(namlst + 420, sc, &c__1, &n, &delcde, (ftnlen)60); - scli01_(namlst + 480, sc, &c__1, &ntsys, &timsys, (ftnlen)60); - scld01_(namlst + 60, sc, &c_b22, &ncoeff, coeffs, (ftnlen)60); - scld01_(namlst + 120, sc, &c__9999, &n, prstrt, (ftnlen)60); - scld01_(namlst + 180, sc, &c__9999, &npart, prend, (ftnlen)60); - scld01_(namlst + 360, sc, &c__10, &n, moduli, (ftnlen)60); - scld01_(namlst + 300, sc, &c__10, &n, offset, (ftnlen)60); - -/* Don't try to continue if we had a lookup error. */ - - if (failed_()) { - nodata = TRUE_; - chkout_("SCEC01", (ftnlen)6); - return 0; - } - -/* The kernel pool look-up succeeded. */ - - nodata = FALSE_; - -/* Use the default time system (TDB) if none was specified in the */ -/* SCLK kernel. */ - - if (ntsys == 0) { - timsys = 1; - } - } - -/* Convert the input TDB time to the parallel time system, if the */ -/* parallel system is not TDB. */ - -/* We don't need to check the validity of TIMSYS, because SCLI01 */ -/* already made this check. */ - - if (timsys == 1) { - partim = *et; - } else if (timsys == 2) { - partim = unitim_(et, "TDB", "TDT", (ftnlen)3, (ftnlen)3); - } - -/* We'd like to ascertain whether PARTIM is between the minimum */ -/* time value in the coefficients array and the end time */ -/* corresponding to the number of ticks since spacecraft clock */ -/* start at the end of the last partition. */ - -/* Checking the time value is a special case; we'll convert the time */ -/* value to ticks, and then check whether the resulting value is */ -/* less than the total number of ticks since spacecraft clock start */ -/* at the end of the last partition. So, this check is performed */ -/* at the end of the routine. */ - -/* Find the time value in COEFFS closest to the input time value. */ -/* The time values are ordered, so we can do a binary search for the */ -/* closest one. When the search is done, we will have found the */ -/* index of the greatest time value in the coefficient array that */ -/* is less than or equal to PARTIM. */ - - -/* There are two cases: */ - -/* 1) PARTIM is bounded by the least and greatest time */ -/* coefficients in the array. In this case, we must search */ -/* the array for a consecutive pair of records whose time */ -/* values bound PARTIM. */ - -/* 2) PARTIM is greater than or equal to all of the time */ -/* coefficients. In that case, we don't need to search: the */ -/* last time value in the array is the one we want. */ - - - if (partim < coeffs[1]) { - -/* PARTIM precedes the coverage of the kernel. */ - - setmsg_(bvlmsg, (ftnlen)320); - errch_("#", "ET", (ftnlen)1, (ftnlen)2); - errdp_("#", et, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCEC01", (ftnlen)6); - return 0; - } else if (partim < coeffs[(i__1 = ncoeff / 3 * 3 - 2) < 150000 && 0 <= - i__1 ? i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)3195)]) { - -/* In the following loop, we maintain an invariant: */ - -/* COEFFS( 2, LOWER ) < PARTIM < COEFFS( 2, UPPER ) */ -/* - */ - -/* At each step, we decrease the distance between LOWER and */ -/* UPPER, while keeping the above statement true. The loop */ -/* terminates when LOWER = UPPER - 1. */ - -/* Note that we start out with if LOWER < UPPER, since we've */ -/* already made sure that the invariant expression above is true. */ - - lower = 1; - upper = ncoeff / 3; - while(lower < upper - 1) { - middle = (lower + upper) / 2; - if (partim < coeffs[(i__1 = middle * 3 - 2) < 150000 && 0 <= i__1 - ? i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)3217)]) { - upper = middle; - } else { - lower = middle; - } - } - -/* We've got PARTIM trapped between two time values that are */ -/* `adjacent' in the list: */ - -/* COEFFS ( 2, LOWER ) and */ -/* COEFFS ( 2, UPPER ) */ - -/* since the second value must be greater than the first. So */ - -/* COEFFS( 2, LOWER ) */ - -/* is the last time value in the coefficients array less than or */ -/* equal to PARTIM. */ - - } else { - -/* PARTIM is greater than or equal to all of the time values in */ -/* the coefficients array. */ - - lower = ncoeff / 3; - } - -/* Now we evaluate a linear polynomial to find the tick value that */ -/* corresponds to PARTIM. The coefficients of the polynomial are */ -/* the tick value and rate (in units of ticks per second) that */ -/* correspond to the time value */ - -/* COEFFS( 2, LOWER ) */ - -/* We call these coefficients CONST and RATE. The rates in the */ -/* coefficients array are in units of seconds per most significant */ -/* clock count, so we use the conversion factor TIKMSC (`ticks per */ -/* most significant count') to change the rate to seconds per tick. */ - - timdif = partim - coeffs[(i__1 = lower * 3 - 2) < 150000 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "sc01_", (ftnlen)3262)]; - const__ = coeffs[(i__1 = lower * 3 - 3) < 150000 && 0 <= i__1 ? i__1 : - s_rnge("coeffs", i__1, "sc01_", (ftnlen)3263)]; - if (coeffs[(i__1 = lower * 3 - 1) < 150000 && 0 <= i__1 ? i__1 : s_rnge( - "coeffs", i__1, "sc01_", (ftnlen)3265)] <= 0.) { - setmsg_("Invalid SCLK rate.", (ftnlen)18); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCEC01", (ftnlen)6); - return 0; - } - tikmsc = 1.; - for (i__ = nfield; i__ >= 2; --i__) { - tikmsc *= moduli[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "moduli", i__1, "sc01_", (ftnlen)3278)]; - } - rate = 1. / (coeffs[(i__1 = lower * 3 - 1) < 150000 && 0 <= i__1 ? i__1 : - s_rnge("coeffs", i__1, "sc01_", (ftnlen)3281)] / tikmsc); - *sclkdp = const__ + rate * timdif; - -/* Now, we'll see whether the SCLK value we've found is meaningful. */ -/* If it's too large, that's because the input PARTIM was beyond the */ -/* maximum value we can handle. To check whether PARTIM is in */ -/* range, we must find the end time of the last partition, in total */ -/* ticks since spacecraft clock start. */ - - d__1 = prend[0] - prstrt[0]; - mxtick = d_nint(&d__1); - i__1 = npart; - for (i__ = 2; i__ <= i__1; ++i__) { - d__1 = prend[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge( - "prend", i__2, "sc01_", (ftnlen)3295)] - prstrt[(i__3 = i__ - - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prstrt", i__3, "sc01_" - , (ftnlen)3295)] + mxtick; - mxtick = d_nint(&d__1); - } - -/* Make sure that ET does not exceed the ET corresponding to */ -/* the clock's maximum tick value. We'll do the comparison */ -/* using the tick value that ET mapped to and the maximum tick */ -/* value of the spacecraft clock. */ - - if (*sclkdp > mxtick) { - setmsg_(bvlmsg, (ftnlen)320); - errch_("#", "ET", (ftnlen)1, (ftnlen)2); - errdp_("#", et, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCEC01", (ftnlen)6); - return 0; - } - chkout_("SCEC01", (ftnlen)6); - return 0; -} /* sc01_ */ - -/* Subroutine */ int sc01_(integer *sc, char *clkstr, doublereal *ticks, - doublereal *sclkdp, doublereal *et, ftnlen clkstr_len) -{ - return sc01_0_(0, sc, clkstr, ticks, sclkdp, et, clkstr_len); - } - -/* Subroutine */ int sctk01_(integer *sc, char *clkstr, doublereal *ticks, - ftnlen clkstr_len) -{ - return sc01_0_(1, sc, clkstr, ticks, (doublereal *)0, (doublereal *)0, - clkstr_len); - } - -/* Subroutine */ int scfm01_(integer *sc, doublereal *ticks, char *clkstr, - ftnlen clkstr_len) -{ - return sc01_0_(2, sc, clkstr, ticks, (doublereal *)0, (doublereal *)0, - clkstr_len); - } - -/* Subroutine */ int scte01_(integer *sc, doublereal *sclkdp, doublereal *et) -{ - return sc01_0_(3, sc, (char *)0, (doublereal *)0, sclkdp, et, (ftnint)0); - } - -/* Subroutine */ int scet01_(integer *sc, doublereal *et, doublereal *sclkdp) -{ - return sc01_0_(4, sc, (char *)0, (doublereal *)0, sclkdp, et, (ftnint)0); - } - -/* Subroutine */ int scec01_(integer *sc, doublereal *et, doublereal *sclkdp) -{ - return sc01_0_(5, sc, (char *)0, (doublereal *)0, sclkdp, et, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/scanit.c b/ext/spice/src/cspice/scanit.c deleted file mode 100644 index 0ea3f3d0cd..0000000000 --- a/ext/spice/src/cspice/scanit.c +++ /dev/null @@ -1,1580 +0,0 @@ -/* scanit.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCANIT ( Scan a character string ) */ -/* Subroutine */ int scanit_0_(int n__, char *string, integer *start, integer - *room, integer *nmarks, char *marks, integer *mrklen, integer *pnters, - integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen - string_len, ftnlen marks_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, jump, test, slot, stop, last1, this1, i__, j, l, n, fchar, - lchar; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical equal; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - logical known; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer eblock, backup, finish, lbound, offset; - extern /* Subroutine */ int rmdupc_(integer *, char *, ftnlen); - integer ubound, intval; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - char letter[1]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* This routine serves as an umbrella routine for routines */ -/* that are used to scan a string for recognized and unrecognized */ -/* substrings. */ - -/* $ 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 */ -/* PARSE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I a string to be scanned. */ -/* ROOM I space available for located substrings. */ -/* NMARKS I/O number of recognizable substrings. */ -/* MARKS I/O recognizable substrings. */ -/* MRKLEN I/O an auxiliary array describing MARKS. */ -/* PNTERS I/O an auxiliary array describing MARKS. */ -/* START I/O position from which to commence/resume scanning. */ -/* NTOKNS O number of scanned substrings. */ -/* BEG O beginnings of scanned substrings. */ -/* END O endings of scanned substrings. */ -/* IDENT O position of scanned substring within array MARKS. */ - -/* $ Detailed_Input */ - -/* STRING is any character string that is to be scanned */ -/* to locate recognized and unrecognized substrings. */ - -/* ROOM is the amount of space available for storing the */ -/* results of scanning the string. */ - -/* NMARKS is the number of marks that will be */ -/* recognized substrings of STRING. */ - -/* MARKS is an array of marks that will be recognized */ -/* by the scanning routine. The array must be */ -/* processed by a call to SCANPR before it can */ -/* be used by SCAN. Further details are given */ -/* in documentation for the individual entry points. */ - -/* MRKLEN is an auxiliary array populated by SCANPR */ -/* for use by SCAN. It should be declared with */ -/* length equal to the length of MARKS. */ - -/* PNTERS is an auxiliary array populated by SCANPR for */ -/* use by SCAN. It should be declared in the */ -/* calling program as */ - -/* INTEGER PNTERS ( RCHARS ) */ - -/* RCHARS is given by the expression */ - -/* MAX - MIN + 5 */ - -/* where */ - -/* MAX is the maximum value of ICHAR(MARKS(I)(1:1)) */ -/* over the range I = 1, NMARKS */ - -/* MIN is the minimum value of ICHAR(MARKS(I)(1:1)) */ -/* over the range I = 1, NMARKS */ - -/* Further details are provided in the entry point */ -/* SCANPR. */ - -/* START is the position in the STRING from which scanning */ -/* should commence. */ - -/* $ Detailed_Output */ - -/* NMARKS is the number of marks in the array MARKS after it */ -/* has been prepared for SCANPR. */ - -/* MARKS is an array of recognizable substrings that has */ -/* been prepared for SCAN by SCANPR. Note that MARKS */ -/* will be sorted in increasing order. */ - -/* MRKLEN is an auxiliary array, populated by SCANPR for */ -/* use by SCAN. */ - -/* PNTERS is an auxiliary array, populated by a call to */ -/* SCANPR and is intended for use by SCAN. */ - -/* START is the position from which scanning should continue */ -/* in order to fully scan STRING (if sufficient memory was */ -/* not provided in BEG, END, and IDENT on the current */ -/* call to SCAN). */ - -/* NTOKNS is the number of substrings identified in the current */ -/* scan of STRING. */ - -/* BEG Beginnings of scanned substrings. */ -/* This should be declared so that it is at least */ -/* as large as ROOM. */ - -/* END Endings of scanned substrings. */ -/* This should be declared so that it is at least */ -/* as large as ROOM. */ - -/* IDENT Positions of scanned substring within array MARKS. */ -/* If the substring STRING(BEG(I):END(I)) is not in the */ -/* list of MARKS then IDENT(I) will have the value 0. */ -/* This should be declared so that it is at least */ -/* as large as ROOM. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly the error */ -/* 'SPICE(BOGUSENTRY)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as an umbrella routine for the two entry */ -/* points SCANPR and SCAN. It can be used to locate keywords */ -/* or delimited substrings within a string. */ - -/* The process of breaking a string into those substrings that */ -/* have recognizable meaning, is called "scanning." The substrings */ -/* identified by the scanning process are called "tokens." */ - -/* Scanning has many applications including: */ - -/* -- the parsing of algebraic expressions */ - -/* -- parsing calendar dates */ - -/* -- processing text with embedded directions for displaying */ -/* the text. */ - -/* -- interpretation of command languages */ - -/* -- compilation of programming languages */ - -/* This routine simplifies the process of scanning a string for */ -/* its tokens. */ - -/* $ Examples */ - -/* Example 1. */ -/* ---------- */ - -/* Suppose you need to identify all of the words within a string */ -/* and wish to ignore punctuation marks such as ',', ':', ';', ' ', */ -/* '---'. */ - -/* The first step is to load the array of marks as shown here: */ - -/* The minimum ASCII code for the first character of a marker is */ -/* 32 ( for ' '). */ - -/* INTEGER FCHAR */ -/* PARAMETER ( FCHAR = 32 ) */ - -/* The maximum ASCII code for the first character of a marker is */ -/* 59 (for ';' ) */ - -/* INTEGER LCHAR */ -/* PARAMETER ( LCHAR = 59 ) */ - -/* INTEGER RCHAR */ -/* PARAMETER ( RCHAR = LCHAR - FCHAR + 5 ) */ - -/* LOGICAL FIRST */ -/* CHARACTER*(3) MARKS */ -/* INTEGER NMARKS ( 5 ) */ -/* INTEGER MRKLEN ( 5 ) */ -/* INTEGER PNTERS ( RCHAR ) */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 50 ) */ - -/* INTEGER BEG ( ROOM ) */ -/* INTEGER END ( ROOM ) */ -/* INTEGER IDENT ( ROOM ) */ - -/* SAVE FIRST */ -/* SAVE MARKS */ -/* SAVE MRKLEN */ -/* SAVE PNTERS */ - -/* IF ( FIRST ) THEN */ - -/* FIRST = .FALSE. */ - -/* MARKS(1) = ' ' */ -/* MARKS(2) = '---' */ -/* MARKS(3) = ':' */ -/* MARKS(4) = ',' */ -/* MARKS(5) = ';' */ - -/* NMARKS = 5 */ - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */ - -/* END IF */ - -/* Notice that the call to SCANPR is nested inside an */ -/* IF ( FIRST ) THEN ... END IF block. In this and many applications */ -/* the marks that will be used in the scan are fixed. Since the */ -/* marks are not changing, you need to process MARKS and set up */ -/* the auxiliary arrays MRKLEN and PNTERS only once (assuming that */ -/* you SAVE the appropriate variables as has been done above). */ -/* In this way if the code is executed many times, there is only */ -/* a small overhead required for preparing the data so that it */ -/* can be used efficiently in scanning. */ - -/* To identify the substrings that represent words we scan the */ -/* string using the prepared MARKS, MRKLEN and PNTERS. */ - -/* CALL SCAN ( STRING, MARKS, MRKLEN, PNTERS, ROOM, */ -/* . START, NTOKNS, IDENT, BEG, END ) */ - -/* To isolate only the words of the string, we examine the */ -/* array IDENT and keep only those Begin and Ends for which */ -/* the corresponding identity is non-positive. */ - -/* KEPT = 0 */ - -/* DO I = 1, NTOKNS */ - -/* IF ( IDENT(I) .LE. 0 ) THEN */ - -/* KEPT = KEPT + 1 */ -/* BEG(KEPT) = BEG(I) */ -/* END(KEPT) = END(I) */ - -/* END IF */ - -/* END DO */ - - -/* Example 2. */ -/* ---------- */ - -/* To parse an algebraic expression such as */ - -/* ( X + Y ) * ( 2*Z + SIN(W) ) ** 2 */ - -/* You would select '**', '*', '+', '-', '(', ')' and ' ' */ -/* to be the markers. Note that all of these begin with one */ -/* of the characters in the string ' !"#$%&''()*+,-./' */ -/* so that we can declare PNTERS to have length 20. */ - -/* Prepare the MARKS, MRKLEN, and PNTERS. */ - -/* LOGICAL FIRST */ -/* CHARACTER*(4) MARKS */ -/* INTEGER NMARKS ( 8 ) */ -/* INTEGER MRKLEN ( 8 ) */ -/* INTEGER PNTERS ( 20 ) */ - -/* SAVE FIRST */ -/* SAVE MARKS */ -/* SAVE MRKLEN */ -/* SAVE PNTERS */ - -/* IF ( FIRST ) THEN */ - -/* MARKS(1) = '(' */ -/* MARKS(2) = ')' */ -/* MARKS(3) = '+' */ -/* MARKS(4) = '-' */ -/* MARKS(5) = '*' */ -/* MARKS(6) = '/' */ -/* MARKS(7) = '**' */ -/* MARKS(8) = ' ' */ - -/* NMARKS = 8 */ - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */ - -/* Locate the blank character in MARKS once it has */ -/* been prepared. */ - -/* BLANK = BSRCHC ( ' ', NMARKS, MARKS ) */ - -/* END IF */ - - -/* Once all of the initializations are out of the way, */ -/* we can scan an input string. */ - -/* CALL SCAN ( STRING, MARKS, MRKLEN, PNTERS, ROOM, */ -/* . START, NTOKNS, IDENT, BEG, END ) */ - - -/* Next eliminate any white space that was returned in the */ -/* list of tokens. */ - -/* KEPT = 0 */ - -/* DO I = 1, NTOKNS */ - -/* IF ( IDENT(I) .NE. BLANK ) THEN */ -/* KEPT = KEPT + 1 */ -/* BEG (KEPT) = BEG (I) */ -/* END (KEPT) = END (I) */ -/* IDENT(KEPT) = IDENT (I) */ -/* END IF */ - -/* END DO */ - -/* Now all of the substrings remaining point to grouping symbols, */ -/* operators, functions, or variables. Given that the individual */ -/* "words" of the expression are now in hand, the meaning of the */ -/* expression is much easier to determine. */ - -/* The rest of the routine is left as a non-trivial exercise */ -/* for the reader. */ - -/* $ Restrictions */ - -/* The array of MARKS, MRKLEN, and PNTERS must be properly formatted */ -/* prior to calling SCAN. This is accomplished by calling SCANPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Spicelib Version 1.0.0, 26-JUL-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Scan a string for recognized and unrecognized tokens */ -/* Parse a string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - /* Parameter adjustments */ - if (ident) { - } - if (beg) { - } - if (end) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_scanpr; - case 2: goto L_scan; - } - - if (! return_()) { - chkin_("SCANIT", (ftnlen)6); - setmsg_("Your program has referenced the umbrella subroutine SCANIT." - " This may indicate a programming error.", (ftnlen)99); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("SCANIT", (ftnlen)6); - } - return 0; -/* $Procedure SCANPR ( Scanning preparation ) */ - -L_scanpr: -/* $ Abstract */ - -/* Prepare recognized markers and auxiliary arrays for the */ -/* routine SCAN. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER NMARKS */ -/* CHARACTER*(*) MARKS ( * ) */ -/* INTEGER MRKLEN ( * ) */ -/* INTEGER PNTERS ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NMARKS I/O Number of recognizable substrings. */ -/* MARKS I/O Recognizable substrings. */ -/* MRKLEN O auxiliary array describing MARKS. */ -/* PNTERS O auxiliary array describing MARKS. */ - -/* $ Detailed_Input */ - -/* NMARKS is the number of recognized marks that will be */ -/* recognized substrings of STRING. */ - -/* MARKS is an array of marks that will be recognized */ -/* by the scanning routine. Leading and trailing */ -/* blanks are not significant. (Except for the */ -/* blank character ' ', itself. After all, some */ -/* part of it must be significant.) Case of the */ -/* entries in MARKS is significant. The MARKS */ -/* 'XX' and 'xx' are regarded as different MARKS. */ - -/* $ Detailed_Output */ - -/* NMARKS is the number of marks in the array MARKS after it */ -/* has been prepared for SCAN. */ - -/* MARKS is an array of recognizable substrings. */ -/* It has been prepared for use by SCAN */ -/* so as to be compatible with the other arrays. */ -/* It will be sorted in ascending order, left */ -/* justified and contain no duplicate entries. */ - -/* MRKLEN is an auxiliary array populated by SCANPR */ -/* for use by SCAN that describes MARKS. */ - -/* PNTERS is an auxiliary array populated by SCANPR for */ -/* use by SCAN. It should be declared in the */ -/* calling program as */ - -/* INTEGER PNTERS ( RCHARS ) */ - -/* RCHARS is given by the expression */ - -/* MAX - MIN + 5 */ - -/* where */ - -/* MAX is the maximum value of ICHAR(MARKS(I)(1:1)) */ -/* over the range I = 1, NMARKS */ - -/* MIN is the minimum value of ICHAR(MARKS(I)(1:1)) */ -/* over the range I = 1, NMARKS */ - -/* Here are some typical values that may help you avoid */ -/* going through the computations above. (This assumes */ -/* that ICHAR returns the ASCII code for a character.) */ - -/* Scanning Situation RCHAR */ -/* ------------------ ------------------- */ -/* If NMARKS = 1 */ -/* or all MARKS 5 */ -/* begin with the same */ -/* character. */ - -/* All MARKS begin with */ -/* one of the characters 20 */ -/* in the string */ -/* ' !"#$%&''()*+,-./' */ - -/* All MARKS begin with */ -/* one of the characters 11 */ -/* in the string */ -/* ':;<=>?@' */ - -/* All MARKS begin with */ -/* one of the characters 37 */ -/* in the string */ -/* ' !"#$%&''()*+,-./:;<=>?@' */ - -/* All MARKS begin with */ -/* an upper case english letter 30 */ - -/* All MARKS begin with a */ -/* decimal digit 14 */ - -/* All Marks begin with a */ -/* lower case english letter 30 */ - -/* All Marks begin with */ -/* a digit or upper case 47 */ -/* character. */ - -/* All Marks begin with a */ -/* printing character or 100 */ -/* a blank. */ - -/* Anything might be a mark 132 */ - -/* Finally, so you won't have to look it up elsewhere */ -/* here are the ASCII codes for the printing */ -/* characters and blanks. */ - -/* (Common Punctuations) Character ASCII Code */ -/* ----------- ---------- */ -/* ' ' (space) 32 */ -/* '!' 33 */ -/* '"' 34 */ -/* '#' 35 */ -/* '$' 36 */ -/* '%' 37 */ -/* '&' 38 */ -/* '''' 39 */ -/* '(' 40 */ -/* ')' 41 */ -/* '*' 42 */ -/* '+' 43 */ -/* ',' 44 */ -/* '-' 45 */ -/* '.' 46 */ -/* '/' 47 */ - - -/* (Decimal Digits) Character ASCII Code */ -/* ----------- ---------- */ -/* '0' 48 */ -/* '1' 49 */ -/* '2' 50 */ -/* '3' 51 */ -/* '4' 52 */ -/* '5' 53 */ -/* '6' 54 */ -/* '7' 55 */ -/* '8' 56 */ -/* '9' 57 */ - -/* (More punctuation) Character ASCII Code */ -/* ----------- ---------- */ -/* ':' 58 */ -/* ';' 59 */ -/* '<' 60 */ -/* '=' 61 */ -/* '>' 62 */ -/* '?' 63 */ -/* '@' 64 */ - -/* (Uppercase characters) Character ASCII Code */ -/* ----------- ---------- */ -/* 'A' 65 */ -/* 'B' 66 */ -/* 'C' 67 */ -/* 'D' 68 */ -/* 'E' 69 */ -/* 'F' 70 */ -/* 'G' 71 */ -/* 'H' 72 */ -/* 'I' 73 */ -/* 'J' 74 */ -/* 'K' 75 */ -/* 'L' 76 */ -/* 'M' 77 */ -/* 'N' 78 */ -/* 'O' 79 */ -/* 'P' 80 */ -/* 'Q' 81 */ -/* 'R' 82 */ -/* 'S' 83 */ -/* 'T' 84 */ -/* 'U' 85 */ -/* 'V' 86 */ -/* 'W' 87 */ -/* 'X' 88 */ -/* 'Y' 89 */ -/* 'Z' 90 */ - -/* (More punctuation) Character ASCII Code */ -/* ----------- ---------- */ -/* '[' 91 */ -/* '\' 92 */ -/* ']' 93 */ -/* '^' 94 */ -/* '_' 95 */ -/* '`' 96 */ - -/* (Lowercase characters) Character ASCII Code */ -/* ----------- ---------- */ -/* 'a' 97 */ -/* 'b' 98 */ -/* 'c' 99 */ -/* 'd' 100 */ -/* 'e' 101 */ -/* 'f' 102 */ -/* 'g' 103 */ -/* 'h' 104 */ -/* 'i' 105 */ -/* 'j' 106 */ -/* 'k' 107 */ -/* 'l' 108 */ -/* 'm' 109 */ -/* 'n' 110 */ -/* 'o' 111 */ -/* 'p' 112 */ -/* 'q' 113 */ -/* 'r' 114 */ -/* 's' 115 */ -/* 't' 116 */ -/* 'u' 117 */ -/* 'v' 118 */ -/* 'w' 119 */ -/* 'x' 120 */ -/* 'y' 121 */ -/* 'z' 122 */ - -/* (More punctuation) Character ASCII Code */ -/* ----------- ---------- */ -/* '{' 123 */ -/* '|' 124 */ -/* '}' 125 */ -/* '~' 126 */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) A space is regarded as a special mark. If MARKS(I) = ' ', */ -/* then MARKS(I) will match any consecutive sequence of blanks. */ - -/* 2) If NMARKS is less than or equal to zero, SCAN will always */ -/* find a single token, namely the entire string to be scanned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine prepares the arrays MARKS, MRKLEN and PNTERS */ -/* so that they are suitable for input to the routine SCAN. */ - -/* It is expected that users will need to scan many strings */ -/* and that from the programming point of view it is */ -/* easiest to simply supply a list of MARKS to a "formatting" */ -/* routine such as this so that the strings can then */ -/* be efficiently scanned by the routine SCAN. This formatting */ -/* is the function of this routine. */ - -/* $ Examples */ - -/* Suppose you need to identify all of the words within a string */ -/* and wish to ignore punctuation marks such as ' ', ',', ':', ';' */ -/* '---'. Then the first step is to load the array of marks as */ -/* shown here: */ - -/* The minimum ASCII code for the first character of a marker is */ -/* 32 (for ' '). */ - -/* INTEGER FCHAR */ -/* PARAMETER ( FCHAR = 32 ) */ - -/* The maximum ASCII code for the first character of a marker is */ -/* 59 (for ';'). */ - -/* INTEGER LCHAR */ -/* PARAMETER ( LCHAR = 59 ) */ - - -/* The proper size to declare PNTERS is given by the parameter */ -/* RCHAR defined in terms of LCHAR and FCHAR. */ - -/* INTEGER RCHAR */ -/* PARAMETER ( RCHAR = LCHAR - FCHAR + 5 ) */ - -/* LOGICAL FIRST */ -/* CHARACTER*(4) MARKS */ -/* INTEGER NMARKS ( 5 ) */ -/* INTEGER MRKLEN ( 5 ) */ -/* INTEGER PNTERS ( RCHAR ) */ - -/* SAVE FIRST */ -/* SAVE MARKS */ -/* SAVE MRKLEN */ -/* SAVE PNTERS */ - -/* IF ( FIRST ) THEN */ - -/* FIRST = .FALSE. */ - -/* MARKS(1) = ' ' */ -/* MARKS(2) = '---' */ -/* MARKS(3) = ':' */ -/* MARKS(4) = ',' */ -/* MARKS(5) = ';' */ - -/* NMARKS = 5 */ - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */ - -/* END IF */ - -/* Notice that the call to SCANPR is nested inside an */ -/* IF ( FIRST ) THEN ... END IF block. In this and many applications */ -/* the marks that will used in the scan are fixed. Since the marks */ -/* are not changing, you need to process MARKS and set up */ -/* the auxiliary arrays MRKLEN and PNTERS only once (assuming that */ -/* you SAVE the appropriate variables as has been done above). */ -/* In this way if the code is executed many times, there is only */ -/* a small overhead required for preparing the data so that it */ -/* can be used efficiently in scanning. */ - - -/* $ Restrictions */ - -/* MRKLEN and PNTERS must be declared to be at least as large */ -/* as indicated above. If not, this routine will write */ -/* past the ends of these arrays. Much unpleasantness may */ -/* ensue in the attempt to debug such problems. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Spicelib Version 1.0.0, 26-JUL-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Prepare for scanning strings */ -/* Prepare for parsing strings */ - -/* -& */ - -/* We handle the case where NMARKS is non-positive separately. */ - - if (*nmarks <= 0) { - pnters[0] = 0; - pnters[1] = 0; - pnters[2] = 0; - pnters[3] = 0; - pnters[4] = 0; - return 0; - } - -/* First left justify MARKS and remove duplicates. */ - - i__1 = *nmarks; - for (i__ = 1; i__ <= i__1; ++i__) { - ljust_(marks + (i__ - 1) * marks_len, marks + (i__ - 1) * marks_len, - marks_len, marks_len); - } - n = *nmarks; - -/* Sort and remove duplicates from the array MARKS. */ - - rmdupc_(&n, marks, marks_len); - -/* All of the MARKS have the same declared length. */ -/* However, since all of your marks may not have */ -/* the same intended length (for example '*' and */ -/* '**') it is desirable to be able to specify */ -/* how much of MARKS(I) should actually be used */ -/* when examining STRING for a substring match. */ -/* This is done with the array MRKLEN. */ -/* MARKS(I)(1:MRKLEN(I)) will be used when */ -/* scanning STRING. */ - -/* Here is the expected structure of PNTERS. */ - -/* PNTERS(1) = MIN ( ICHAR(MARKS(I)(1:1) ), I=1,NMARKS ) */ -/* PNTERS(2) = MAX ( ICHAR(MARKS(I)(1:1) ), I=1,NMARKS ) */ - -/* For ease of further discussion let */ -/* MYCHAR(I) represent the characters from PNTERS(1) */ -/* to PNTERS(2), and assume that legitimate values of */ -/* I are from 1 to M. */ - -/* PNTERS(3) = 0 */ -/* PNTERS(4) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(1). */ - -/* PNTERS(5) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(2), if there is no such element */ -/* of MARKS let PNTERS(5) = PNTERS(4) */ -/* . */ -/* . */ -/* . */ - -/* PNTERS(3+K) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(K), if there is no such element */ -/* of MARKS, let PNTERS(3+K) = */ -/* PNTERS(3+K-1) */ -/* . */ -/* . */ -/* . */ - -/* PNTERS(3+M) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(M). */ - -/* PNTERS(4+M) = PNTERS(3+M) */ - - - -/* Next determine the minimum and maximum ASCII values */ -/* of the first characters of the MARKS. */ - - fchar = *(unsigned char *)&marks[0]; - lchar = *(unsigned char *)&marks[(n - 1) * marks_len]; - pnters[0] = fchar; - pnters[1] = lchar; - -/* For the purposes of getting started, we will say the last */ -/* character that started a MARK was one before FCHAR. We */ -/* will record the end of its block in slot 3 of PNTERS. */ - - last1 = fchar - 1; - slot = 3; - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - mrklen[i__ - 1] = rtrim_(marks + (i__ - 1) * marks_len, marks_len); - this1 = *(unsigned char *)&marks[(i__ - 1) * marks_len]; - if (this1 != last1) { - -/* We need to record the address of the end of the last */ -/* block of MARKS that began with the same character. */ -/* This is of course one before the current value of I. */ - -/* While we are at it, we might as well determine how */ -/* many possible first letters were "jumped" over in */ -/* going from the last first character to the current */ -/* first character. */ - - eblock = i__ - 1; - jump = this1 - last1; - -/* The end of the block for all of the MARKS having */ -/* first character between the last one and this one */ -/* is the same. */ - - i__2 = slot + jump - 1; - for (j = slot; j <= i__2; ++j) { - pnters[j - 1] = eblock; - } - slot += jump; - last1 = this1; - } - } - pnters[slot - 1] = n; - pnters[slot] = n; - *nmarks = n; - return 0; -/* $Procedure SCAN ( Scan a string for tokens ) */ - -L_scan: -/* $ Abstract */ - -/* This routine scans a string returning the beginning and */ -/* ends of recognized and unrecognized substrings. The full */ -/* collection of these substrings partitions the 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 */ - -/* PARSING */ - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ -/* CHARACTER*(*) MARKS ( * ) */ -/* INTEGER MRKLEN ( * ) */ -/* INTEGER PNTERS ( * ) */ -/* INTEGER ROOM */ -/* INTEGER START */ -/* INTEGER NTOKNS */ -/* INTEGER BEG ( * ) */ -/* INTEGER END ( * ) */ -/* INTEGER IDENT ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I string to be scanned. */ -/* MARKS I recognizable substrings. */ -/* MRKLEN I an auxiliary array describing MARKS. */ -/* PNTERS I an auxiliary array describing MARKS. */ -/* ROOM I space available for storing substring descriptions. */ -/* START I/O position from which to begin/resume scanning. */ -/* NTOKNS O number of scanned substrings. */ -/* BEG O beginnings of scanned substrings. */ -/* END O endings of scanned substrings. */ -/* IDENT O position of scanned substring within array MARKS. */ - -/* $ Detailed_Input */ - -/* STRING is any character string that is to be scanned */ -/* to locate recognized and unrecognized substrings. */ - -/* MARKS is an array of marks that will be recognized */ -/* by the scanning routine. This array must be prepared */ -/* by calling the routine SCANPR. */ - -/* Note that the blank string is interpreted */ -/* in a special way by SCAN. If the blank character, */ -/* ' ', is one of the MARKS, it will match any unbroken */ -/* sequence of blanks in string. Thus if ' ' is the only */ -/* marks supplied and STRING is */ - -/* 'A lot of space ' */ -/* ...................... */ - -/* Then scan will locate the following substrings */ - -/* 'A' STRING(1:1) (unrecognized) */ -/* ' ' STRING(2:4) (recognized --- all blanks) */ -/* 'lot' STRING(5:7) (unrecognized) */ -/* ' ' STRING(8:8) (recognized --- a blank) */ -/* 'of' STRING(9:10) (unrecognized) */ -/* ' ' STRING(11:16) (recognized --- all blanks) */ -/* 'space' STRING(17:21) (unrecognized) */ -/* ' ' STRING(22:22) (recognized --- a blank) */ - -/* MRKLEN is an auxiliary array populated by SCANPR */ -/* for use by SCAN. It should be declared with */ -/* length equal to the length of MARKS. It must */ -/* be prepared for use by the routine SCANPR. */ - -/* PNTERS is a specially structured array of integers that */ -/* describes the array MARKS. It is must be filled */ -/* in by the routine SCANPR. It should be declared */ -/* by the calling program as shown here: */ - -/* INTEGER PNTERS ( RCHARS ) */ - -/* RCHARS is given by the expression */ - -/* MAX - MIN + 5 */ - -/* where */ - -/* MAX is the maximum value of ICHAR(MARKS(I)(1:1)) */ -/* over the range I = 1, NMARKS */ - -/* MIN is the minimum value of ICHAR(MARKS(I)(1:1)) */ -/* over the range I = 1, NMARKS */ - -/* See SCANPR for a more detailed description of the */ -/* declaration of PNTERS. */ - -/* ROOM is the amount of space available for storing the */ -/* results of scanning the string. */ - -/* START is the position from which scanning should commence. */ -/* Values of START less than 1 are treated as 1. */ - -/* $ Detailed_Output */ - -/* START is the position from which scanning should continue */ -/* in order to fully scan STRING (if sufficient memory was */ -/* not provided in BEG, END, and IDENT on the current */ -/* call to SCAN). */ - -/* NTOKNS is the number of substrings identified in the current */ -/* scan of STRING. */ - -/* BEG Beginnings of scanned substrings. This should be */ -/* declared so that it is at least as large as ROOM. */ - -/* END Endings of scanned substrings. This should be declared */ -/* so that it is at least as large as ROOM. */ - -/* IDENT Positions of scanned substring within array MARKS. */ -/* If the substring STRING(BEG(I):END(I)) is in the array */ -/* MARKS, then MARKS(IDENT(I)) will equal */ -/* STRING(BEG(I):END(I)). */ - -/* If the substring STRING(BEG(I):END(I)) is not in the */ -/* list of MARKS then IDENT(I) will have the value 0. */ - -/* IDENT should be declared so that it can contain at least */ -/* ROOM integers. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) A space is regarded as a special mark. If MARKS(I) = ' ', */ -/* then MARKS(I) will match any consecutive sequence of blanks. */ - -/* 2) If START is less than 1 on input, it will be treated as */ -/* if it were 1. */ - -/* 3) If START is greater than the length of the string, no */ -/* tokens will be found and the value of START will return */ -/* unchanged. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to scan a string and partition it into */ -/* recognized and unrecognized substrings. */ - -/* For some applications the recognized substrings serve only as */ -/* delimiters between the portions of the string */ -/* that are of interest to your application. For other */ -/* applications the recognized substrings are equally important as */ -/* they may indicate operations that are to be performed on the */ -/* unrecognized portions of the string. However, the techniques */ -/* required to scan the string are the same in both instances. The */ -/* examples below illustrate some common situations. */ - -/* $ Examples */ - -/* Example 1. */ -/* ---------- */ - -/* Suppose you wished to write a routine that would return the words */ -/* of a string. The following routine shows how SCANPR and SCAN can */ -/* be used to accomplish this task. */ - -/* SUBROUTINE GETWDS ( STRING, WDROOM, NWORDS, WORDS ) */ - -/* CHARACTER*(*) STRING */ -/* INTEGER WDROOM */ -/* INTEGER NWORDS */ -/* CHARACTER*(*) WORDS ( * ) */ - - -/* CHARACTER*(1) MARKS ( 1 ) */ -/* INTEGER MRKLEN ( 1 ) */ -/* INTEGER PNTERS ( 5 ) */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 50 ) */ - -/* INTEGER BEG ( ROOM ) */ -/* INTEGER END ( ROOM ) */ -/* INTEGER I */ -/* INTEGER IDENT ( ROOM ) */ -/* INTEGER NMARKS */ -/* INTEGER NTOKNS */ -/* INTEGER START */ - -/* LOGICAL FIRST */ -/* SAVE FIRST */ -/* DATA FIRST / .TRUE. / */ - - -/* On the first time through the routine, set up the MARKS */ -/* MRKLEN, and PNTERS arrays. */ - -/* IF( FIRST ) THEN */ - -/* FIRST = .FALSE. */ -/* MARKS(1) = ' ' */ -/* NMARKS = 1 */ - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */ - -/* END IF */ - -/* Now simply scan the input string for words until we have */ -/* them all or until we run out of room. */ - -/* START = 1 */ -/* NWORDS = 0 */ - -/* CALL SCAN ( STRING, */ -/* MARKS, MRKLEN, PNTERS, ROOM, START, */ -/* NTOKNS, IDENT, BEG, END ) */ - -/* If we found something in our scan, copy the substrings into the */ -/* words array. */ - -/* DO WHILE ( ( NWORDS .LT. WDROOM ) */ -/* . .AND. ( NTOKNS .GT. 0 ) ) */ - - -/* Step through the scanned substrings, looking for those */ -/* that are not blank ... */ - -/* I = 1 */ - -/* DO WHILE ( ( NWORDS .LT. WDROOM ) */ -/* . .AND. ( I .LE. NTOKNS ) ) */ - -/* Copy the non-blank substrings (those unidentified by */ -/* SCAN) into WORDS. */ - -/* IF ( IDENT(I) .EQ. 0 ) THEN */ -/* NWORDS = NWORDS + 1 */ -/* WORDS(NWORDS) = STRING(BEG(I):END(I)) */ -/* END IF */ - -/* I = I + 1 */ - -/* END DO */ - - -/* Scan the STRING again for any substrings that might */ -/* remain. Note that START is already pointing at the */ -/* point in the string from which to resume scanning. */ - -/* CALL SCAN ( STRING, */ -/* MARKS, MRKLEN, PNTERS, ROOM, START, */ -/* NTOKNS, IDENT, BEG, END ) */ -/* END DO */ - -/* That's all, we've got all the substrings there were (or */ -/* that we had room for). */ - -/* RETURN */ - - -/* Example 2. */ -/* ---------- */ - -/* To parse an algebraic expression such as */ - -/* ( X + Y ) * ( 2*Z + SIN(W) ) ** 2 */ - -/* You would select '**', '*', '+', '-', '(', ')' and ' ' */ -/* to be the markers. Note that all of these begin with one */ -/* of the characters in the string ' !"#$%&''()*+,-./' */ -/* so that we can declare PNTERS to have length 20. */ - -/* Prepare the MARKS, MRKLEN, and PNTERS. */ - -/* CHARACTER*(4) MARKS */ -/* INTEGER NMARKS ( 8 ) */ -/* INTEGER MRKLEN ( 8 ) */ -/* INTEGER PNTERS ( 20 ) */ - -/* INTEGER ROOM */ -/* PARAMETER ( ROOM = 20 ) */ - -/* INTEGER NTOKNS */ -/* INTEGER BEG ( ROOM ) */ -/* INTEGER END ( ROOM ) */ -/* INTEGER IDENT ( ROOM ) */ - -/* LOGICAL FIRST */ -/* SAVE FIRST */ -/* SAVE MARKS */ -/* SAVE MRKLEN */ -/* SAVE PNTERS */ - -/* DATA FIRST / .TRUE. / */ - -/* IF ( FIRST ) THEN */ - -/* MARKS(1) = '(' */ -/* MARKS(2) = ')' */ -/* MARKS(3) = '+' */ -/* MARKS(4) = '-' */ -/* MARKS(5) = '*' */ -/* MARKS(6) = '/' */ -/* MARKS(7) = '**' */ -/* MARKS(8) = ' ' */ - -/* NMARKS = 8 */ - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */ - -/* BLANK = BSRCHC ( ' ', NMARKS, MARKS ) */ - -/* END IF */ - - -/* Once all of the initializations are out of the way, */ -/* we can scan an input string. */ - -/* CALL SCAN ( STRING, MARKS, MRKLEN, PNTERS, ROOM, */ -/* . START, NTOKNS, IDENT, BEG, END ) */ - - -/* Next eliminate any white space that was returned in the */ -/* list of tokens. */ - -/* KEPT = 0 */ - -/* DO I = 1, NTOKNS */ - -/* IF ( IDENT(I) .NE. BLANK ) THEN */ - -/* KEPT = KEPT + 1 */ -/* BEG (KEPT) = BEG(I) */ -/* END (KEPT) = END(I) */ -/* IDENT(KEPT) = IDENT(I) */ - -/* END IF */ - -/* END DO */ - -/* Now all of the substrings remaining point to grouping symbols, */ -/* operators, functions, or variables. Given that the individual */ -/* "words" of the expression are now in hand, the meaning of the */ -/* expression is much easier to determine. */ - -/* The rest of the routine is left as a non-trivial exercise */ -/* for the reader. */ - -/* $ Restrictions */ - -/* The arrays MARKS, MRKLEN, and PNTERS must be prepared by the */ -/* routine SCANPR prior to supplying them for use by SCAN. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-JUL-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Scan a string for recognized and unrecognized tokens */ -/* Parse a string */ - -/* -& */ - -/* All of the MARKS have the same declared length. */ -/* However, since all of your marks may not have */ -/* the same intended length (for example '*' and */ -/* '**') it is desirable to be able to specify */ -/* how much of MARKS(I) should actually be used */ -/* when examining STRING for a substring match. */ -/* This is done with the array MRKLEN. */ -/* MARKS(I)(1:MRKLEN(I)) will be used when */ -/* scanning STRING. */ - -/* Here is the expected structure of PNTERS. */ - -/* PNTERS(1) = MIN ( ICHAR(MARKS(I)(1:1) ) */ -/* PNTERS(2) = MAX ( ICHAR(MARKS(I)(1:1) ) */ - -/* where I ranges from 1 to the number of MARKS stored */ -/* in MARKS. For ease of further discussion let */ -/* MYCHAR(I) represent the characters from PNTERS(1) */ -/* to PNTERS(2), and assume that legitimate values of */ -/* I are from 1 to N. */ - -/* PNTERS(3) = 0 */ -/* PNTERS(4) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(1). */ - -/* PNTERS(5) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(2), if there is no such element */ -/* of MARKS let PNTERS(5) = PNTERS(4) */ -/* . */ -/* . */ -/* . */ - -/* PNTERS(3+K) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(K), if there is no such element */ -/* of MARKS, let PNTERS(3+K) = */ -/* PNTERS(3+K-1) */ -/* . */ -/* . */ -/* . */ - -/* PNTERS(3+N) = index of the last entry of MARKS */ -/* that begins with the character */ -/* MYCHAR(N). */ - -/* PNTERS(4+N) = PNTERS(3+N) */ - - -/* Get the information concerning the range of the */ -/* marks from the PNTERS array. */ - - offset = pnters[0] - 4; - lbound = pnters[0] - 1; - ubound = pnters[1] + 1; - last = i_len(string, string_len); - *ntokns = 0; - backup = *start - 1; - known = TRUE_; - *start = max(1,*start); - while(*start <= last) { - -/* Get the numeric code for this letter, and look up */ -/* the range of markers that begin with this letter. */ - - *(unsigned char *)letter = *(unsigned char *)&string[*start - 1]; -/* Computing MAX */ -/* Computing MIN */ - i__3 = *(unsigned char *)letter; - i__1 = lbound, i__2 = min(i__3,ubound); - intval = max(i__1,i__2); - test = pnters[intval - offset - 1]; - finish = pnters[intval - offset - 2]; - equal = FALSE_; - -/* If TEST is greater than FINISH, then there is a range of */ -/* markers that start with this letter. */ - - while(test > finish) { - -/* Look up the length of the next marker to test for */ -/* and compute where it would end in STRING if there */ -/* is a match. */ - - l = mrklen[test - 1]; - stop = backup + l; - -/* Make sure that we are not going to violate any substring */ -/* references when we compare the current candidate mark with */ -/* the substring having the same length and starting at START. */ - - if (stop > last) { - --test; - } else { - -/* OK. The substring reference STRING(START:STOP) is */ -/* legal. See if it is equal to the current test mark. */ - - equal = s_cmp(marks + (test - 1) * marks_len, string + (* - start - 1), l, stop - (*start - 1)) == 0; - -/* If it isn't equal, just set up to test the next mark. */ - - if (! equal) { - --test; - } else { - -/* If we were in the middle of an unrecognized string */ -/* then, we need to check whether or not we have room */ -/* to identify another token. If we don't we must return */ -/* now. */ - - if (! known && *ntokns == *room) { - return 0; - } - -/* A space is a special kind of mark. All white space */ -/* is regarded as being the same. If the current mark */ -/* is a space, we need to collect all of the consecutive */ -/* blanks beginning with the one at the START position. */ - - if (s_cmp(marks + (test - 1) * marks_len, " ", marks_len, - (ftnlen)1) == 0) { - stop = ncpos_(string, " ", start, string_len, (ftnlen) - 1) - 1; - if (stop < 0) { - stop = last; - } - } - -/* Ok. We have a new known token. */ - -/* 1) Record its begin, end, and identity. */ - -/* 2) Set TEST to FINISH so that the loop will end. */ - -/* 3) Set START to the current STOP so that later when */ -/* we add 1, START will point to the beginning */ -/* of the remainder of the string that needs to be */ -/* scanned. */ - - known = TRUE_; - ++(*ntokns); - beg[*ntokns - 1] = *start; - end[*ntokns - 1] = stop; - ident[*ntokns - 1] = test; - test = finish; - *start = stop; - -/* If we have just used up all available room, */ -/* position START so that we will be ready */ -/* to continue scanning on a subsequent call */ -/* and return. */ - - if (*ntokns == *room) { - ++(*start); - return 0; - } - } - } - } - -/* If none of the markers matched a substring starting at */ -/* the current position, we are beginning or continuing */ -/* an unrecognized substring. */ - - if (! equal) { - -/* If we are already in the middle of an unrecognized */ -/* substring, just extend our current unrecognized string. */ - - if (! known) { - end[*ntokns - 1] = *start; - -/* Otherwise, start up a new unrecognized substring. */ - - } else { - ++(*ntokns); - beg[*ntokns - 1] = *start; - end[*ntokns - 1] = *start; - ident[*ntokns - 1] = 0; - known = FALSE_; - } - } - backup = *start; - ++(*start); - } - return 0; -} /* scanit_ */ - -/* Subroutine */ int scanit_(char *string, integer *start, integer *room, - integer *nmarks, char *marks, integer *mrklen, integer *pnters, - integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen - string_len, ftnlen marks_len) -{ - return scanit_0_(0, string, start, room, nmarks, marks, mrklen, pnters, - ntokns, ident, beg, end, string_len, marks_len); - } - -/* Subroutine */ int scanpr_(integer *nmarks, char *marks, integer *mrklen, - integer *pnters, ftnlen marks_len) -{ - return scanit_0_(1, (char *)0, (integer *)0, (integer *)0, nmarks, marks, - mrklen, pnters, (integer *)0, (integer *)0, (integer *)0, ( - integer *)0, (ftnint)0, marks_len); - } - -/* Subroutine */ int scan_(char *string, char *marks, integer *mrklen, - integer *pnters, integer *room, integer *start, integer *ntokns, - integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen - marks_len) -{ - return scanit_0_(2, string, start, room, (integer *)0, marks, mrklen, - pnters, ntokns, ident, beg, end, string_len, marks_len); - } - diff --git a/ext/spice/src/cspice/scanrj.c b/ext/spice/src/cspice/scanrj.c deleted file mode 100644 index 0695936bbd..0000000000 --- a/ext/spice/src/cspice/scanrj.c +++ /dev/null @@ -1,202 +0,0 @@ -/* scanrj.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCANRJ ( Scan --- reject tokens ) */ -/* Subroutine */ int scanrj_(integer *ids, integer *n, integer *ntokns, - integer *ident, integer *beg, integer *end) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern integer isrchi_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Reject those tokens descriptors whose identities are among those */ -/* of a specific collection. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* IDS I value of id's of tokens that should be dumped. */ -/* N I number of id's. */ -/* NTOKNS I/O number of tokens input. The number kept. */ -/* IDENT I/O identity of each of the tokens. */ -/* BEG I/O indices of beginning of tokens. */ -/* END I/O indices of endings of tokens. */ - -/* $ Detailed_Input */ - -/* IDS is a list of the identity codes that we will want to */ -/* reject. */ - -/* N is the number of different cases. */ - -/* NTOKNS is the number of tokens to consider. */ - -/* IDENT holds the identities of each token that is up for */ -/* consideration. */ - -/* BEG holds the beginning indices of each token being */ -/* considered. */ - -/* END holds the ending indices of each token being */ -/* considered. */ - -/* $ Detailed_Output */ - -/* NTOKNS is the number of tokens remaining after the rejection */ -/* process has been completed. */ - -/* IDENT holds the identities of each token remaining. */ - -/* BEG holds the beginning indices of each token remaining. */ - -/* END holds the ending indices of each token remaining. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as a macro for the rejection process that */ -/* is typically performed to remove tokens whose ID's fall into */ -/* some set. */ - -/* $ Examples */ - -/* Suppose you wished to scan a string to locate the beginning and */ -/* endings of words together with punctuation, but that you did not */ -/* want to keep white space. The following code fragment illustrates */ -/* how you could use this routine to accomplish this task. */ - -/* Words will be delimited by spaces, periods, commas, colons, */ -/* question marks, exclamation marks, semicolons, parentheses, */ -/* m-dashes, and quotes. */ - -/* MARKS(1) = ' ' */ -/* MARKS(2) = '.' */ -/* MARKS(3) = ',' */ -/* MARKS(4) = '?' */ -/* MARKS(5) = '!' */ -/* MARKS(6) = '---' */ -/* MARKS(7) = ':' */ -/* MARKS(8) = ';' */ -/* MARKS(9) = '(' */ -/* MARKS(10) = ')' */ -/* MARKS(11) = '"' */ - -/* NMARKS = 11 */ - -/* IDS(1) = 0 */ -/* N = 1 */ - - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, MRKPTR ) */ - -/* IDS(1) = BSRCHC ( ' ', NMARKS, MARKS ) */ -/* N = 1 */ - -/* CALL SCAN ( STRING, MARKS, MRKLEN, MRKPTR, */ -/* . ROOM, NTOKNS, IDENT, BEG, END ) */ - -/* CALL SCANRJ ( IDS, N, NTOKNS, IDENT, BEG, END ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-JUL-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Remove tokens from a scanned list of tokens */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* There's not much to do, shift forward the token attributes for */ -/* tokens whose identities don't belong to the rejection list. */ - - j = 0; - i__1 = *ntokns; - for (i__ = 1; i__ <= i__1; ++i__) { - if (isrchi_(&ident[i__ - 1], n, ids) == 0) { - ++j; - ident[j - 1] = ident[i__ - 1]; - beg[j - 1] = beg[i__ - 1]; - end[j - 1] = end[i__ - 1]; - } - } - *ntokns = j; - return 0; -} /* scanrj_ */ - diff --git a/ext/spice/src/cspice/scard_c.c b/ext/spice/src/cspice/scard_c.c deleted file mode 100644 index a0bd041c8e..0000000000 --- a/ext/spice/src/cspice/scard_c.c +++ /dev/null @@ -1,219 +0,0 @@ -/* - --Procedure scard_c ( Set the cardinality of a cell ) - --Abstract - - Set the cardinality of a SPICE cell of any data type. - --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 - - CELLS - --Keywords - - CELLS - -*/ - -#include "SpiceUsr.h" -#include "SpiceCel.h" -#include "SpiceZmc.h" - - void scard_c ( SpiceInt card, - SpiceCell * cell ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - card I Cardinality of (number of elements in) the cell. - cell O The cell. - --Detailed_Input - - card is the cardinality of (number of elements in) the - cell. - --Detailed_Output - - cell is a SpiceCell of any data type. On output, the - cardinality of the cell is card. The data portion of - the cell is left unchanged. - - If the cardinality is set to zero, the cell becomes a - CSPICE set: the cell's "is a set?" attribute becomes - true. The cell then can be used as an input to the - CSPICE set routines such as insrt*_c. - --Parameters - - None. - --Exceptions - - 1) If the cardinality value supplied is less than 0 or greater - than the cell size, the error SPICE(INVALIDCARDINALITY) is - signaled. - --Files - - None. - --Particulars - - The set cardinality (scard_c) and set size (ssize_c) routines are - typically used to initialize cells for subsequent use. - - The set cardinality routines are also used by library routines - which manipulate cells (including set and window routines) to - reset the cardinalities of cells as they gain or lose elements. - --Examples - - 1) Declare an integer cell. Populate the cell, then reset - the cardinality to zero to effectively make room in the - cell. - - #include "SpiceUsr.h" - . - . - . - - #define SIZE 10 - - Spiceint i; - - /. - Declare a cell with room for SIZE integers. - ./ - SPICEINT_CELL ( icell, SIZE ); - - - /. - Fill in the cell with integers 0 through 9. - ./ - - for ( i = 0; i < SIZE; i++ ) - { - appndi_c ( i, &icell ); - } - . - . - . - /. - Make room in the cell. - ./ - scard_c ( 0, &icell ); - . - . - . - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 21-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - set the cardinality of an integer cell - --& -*/ -{ /* Begin scard_c */ - - - /* - Use discovery check-in. - */ - if ( return_c() ) - { - return; - } - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - /* - Make sure we have a valid cardinality value. - */ - if ( ( card < 0 ) || ( card > cell->size ) ) - { - chkin_c ( "scard_c" ); - setmsg_c ( "Attempt to set cardinality of cell to invalid " - "value #. Valid range is 0:#." ); - errint_c ( "#", card ); - errint_c ( "#", cell->size ); - sigerr_c ( "SPICE(INVALIDCARDINALITY)" ); - chkout_c ( "scard_c" ); - return; - } - - /* - Set the cell's cardinality member. For numeric cells, sync - the Fortran cell's cardinality value. - */ - cell->card = card; - - - if ( cell->dtype != SPICE_CHR ) - { - zzsynccl_c ( C2F, cell ); - } - - /* - The cell becomes a set if it's empty. - */ - if ( card == 0 ) - { - cell->isSet = SPICETRUE; - } - - -} /* End scard_c */ - diff --git a/ext/spice/src/cspice/scardc.c b/ext/spice/src/cspice/scardc.c deleted file mode 100644 index 1e122e6b1b..0000000000 --- a/ext/spice/src/cspice/scardc.c +++ /dev/null @@ -1,217 +0,0 @@ -/* scardc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCARDC ( Set the cardinality of a character cell ) */ -/* Subroutine */ int scardc_(integer *card, char *cell, ftnlen cell_len) -{ - integer size; - extern /* Subroutine */ int chkin_(char *, ftnlen), dechar_(char *, - integer *, ftnlen), enchar_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Set the cardinality of a character cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CARD I Cardinality of (number of elements in) the cell. */ -/* CELL O The cell. */ - -/* $ Detailed_Input */ - -/* CARD is the cardinality of (number of elements in) the */ -/* cell. */ - -/* $ Detailed_Output */ - - -/* CELL is a cell. */ - - -/* On output, the cardinality of the cell is CARD. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */ -/* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */ -/* initialize cells for subsequent use. Since all cell routines */ -/* expect to find the size and cardinality of a cell in place, */ -/* no cell can be used until both have been set. */ - -/* The set cardinality routines are also used by library routines */ -/* which manipulate cells (including set and window routines) to */ -/* reset the cardinalities of cells as they gain or lose elements. */ - -/* $ Examples */ - -/* In the example below, the size and cardinality of the character */ -/* cell FRED are set in the main module of the program FLNSTN. */ -/* Both are subsequently retrieved, and the cardinality changed, */ -/* in one of its subroutines, WILMA. */ - -/* PROGRAM FLNSTN */ - -/* CHARACTER*30 FRED ( LBCELL:100 ) */ -/* . */ -/* . */ -/* CALL SSIZEC ( 100, FRED ) */ -/* . */ -/* . */ -/* CALL WILMA ( FRED ) */ -/* . */ -/* . */ -/* STOP */ -/* END */ - - -/* SUBROUTINE WILMA ( FRED ) */ - -/* CHARACTER*(*) FRED ( LBCELL:* ) */ -/* INTEGER SIZE */ -/* INTEGER CARD */ - -/* INTEGER CARDC */ -/* INTEGER SIZEC */ -/* . */ -/* . */ -/* SIZE = SIZEC ( FRED ) */ -/* CARD = CARDC ( FRED ) */ -/* . */ -/* . */ -/* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */ -/* CALL EXCESS ( CARD-SIZE, 'cell' ) */ -/* . */ -/* . */ -/* RETURN */ -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the cardinality value supplied is less than 0 or greater */ -/* than the cell size, the error SPICE(INVALIDCARDINALITY) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the cardinality of a character cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for invalid cardinality value added. An error */ -/* is signalled if the value is out of range. Examples */ -/* updated so as not to refer to the EMPTYx routines, and */ -/* to show the correct calling protocol for EXCESS. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("SCARDC", (ftnlen)6); - } - -/* The cardinality may range from 0 to the size of the cell, */ -/* inclusive. Other values will be snubbed. */ - - dechar_(cell + (cell_len << 2), &size, cell_len); - if (*card < 0 || *card > size) { - setmsg_("Attempt to set cardinality of cell to invalid value. The v" - "alue was #.", (ftnlen)70); - errint_("#", card, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SCARDC", (ftnlen)6); - return 0; - } - -/* Not much to this. */ - - enchar_(card, cell + cell_len * 5, cell_len); - chkout_("SCARDC", (ftnlen)6); - return 0; -} /* scardc_ */ - diff --git a/ext/spice/src/cspice/scardd.c b/ext/spice/src/cspice/scardd.c deleted file mode 100644 index 4e19413294..0000000000 --- a/ext/spice/src/cspice/scardd.c +++ /dev/null @@ -1,211 +0,0 @@ -/* scardd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCARDD ( Set the cardinality of a double precision cell ) */ -/* Subroutine */ int scardd_(integer *card, doublereal *cell) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Set the cardinality of a double precision cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CARD I Cardinality of (number of elements in) the cell. */ -/* CELL O The cell. */ - -/* $ Detailed_Input */ - -/* CARD is the cardinality of (number of elements in) the */ -/* cell. */ - -/* $ Detailed_Output */ - - -/* CELL is a cell. */ - - -/* On output, the cardinality of the cell is CARD. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */ -/* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */ -/* initialize cells for subsequent use. Since all cell routines */ -/* expect to find the size and cardinality of a cell in place, */ -/* no cell can be used until both have been set. */ - -/* The set cardinality routines are also used by library routines */ -/* which manipulate cells (including set and window routines) to */ -/* reset the cardinalities of cells as they gain or lose elements. */ - -/* $ Examples */ - -/* In the example below, the size and cardinality of the character */ -/* cell FRED are set in the main module of the program FLNSTN. */ -/* Both are subsequently retrieved, and the cardinality changed, */ -/* in one of its subroutines, WILMA. */ - -/* PROGRAM FLNSTN */ - -/* CHARACTER*30 FRED ( LBCELL:100 ) */ -/* . */ -/* . */ -/* CALL SSIZEC ( 100, FRED ) */ -/* . */ -/* . */ -/* CALL WILMA ( FRED ) */ -/* . */ -/* . */ -/* STOP */ -/* END */ - - -/* SUBROUTINE WILMA ( FRED ) */ - -/* CHARACTER*(*) FRED ( LBCELL:* ) */ -/* INTEGER SIZE */ -/* INTEGER CARD */ - -/* INTEGER CARDC */ -/* INTEGER SIZEC */ -/* . */ -/* . */ -/* SIZE = SIZEC ( FRED ) */ -/* CARD = CARDC ( FRED ) */ -/* . */ -/* . */ -/* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */ -/* CALL EXCESS ( CARD-SIZE, 'cell' ) */ -/* . */ -/* . */ -/* RETURN */ -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the cardinality value supplied is less than 0 or greater */ -/* than the cell size, the error SPICE(INVALIDCARDINALITY) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the cardinality of a d.p. cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for invalid cardinality value added. An error */ -/* is signalled if the value is out of range. Examples */ -/* updated so as not to refer to the EMPTYx routines, and */ -/* to show the correct calling protocol for EXCESS. */ - -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - return 0; - } else { - chkin_("SCARDD", (ftnlen)6); - } - -/* The cardinality may range from 0 to the size of the cell, */ -/* inclusive. Other values will be snubbed. */ - - if (*card < 0 || *card > (integer) cell[4]) { - setmsg_("Attempt to set cardinality of cell to invalid value. The v" - "alue was #.", (ftnlen)70); - errint_("#", card, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SCARDD", (ftnlen)6); - return 0; - } - -/* Not much to this. */ - - cell[5] = (doublereal) (*card); - chkout_("SCARDD", (ftnlen)6); - return 0; -} /* scardd_ */ - diff --git a/ext/spice/src/cspice/scardi.c b/ext/spice/src/cspice/scardi.c deleted file mode 100644 index 7dc2993a6f..0000000000 --- a/ext/spice/src/cspice/scardi.c +++ /dev/null @@ -1,210 +0,0 @@ -/* scardi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCARDI ( Set the cardinality of an integer cell ) */ -/* Subroutine */ int scardi_(integer *card, integer *cell) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Set the cardinality of an integer cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CARD I Cardinality of (number of elements in) the cell. */ -/* CELL O The cell. */ - -/* $ Detailed_Input */ - -/* CARD is the cardinality of (number of elements in) the */ -/* cell. */ - -/* $ Detailed_Output */ - -/* CELL is a cell. */ - - -/* On output, the cardinality of the cell is CARD. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */ -/* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */ -/* initialize cells for subsequent use. Since all cell routines */ -/* expect to find the size and cardinality of a cell in place, */ -/* no cell can be used until both have been set. */ - -/* The set cardinality routines are also used by library routines */ -/* which manipulate cells (including set and window routines) to */ -/* reset the cardinalities of cells as they gain or lose elements. */ - -/* $ Examples */ - -/* In the example below, the size and cardinality of the character */ -/* cell FRED are set in the main module of the program FLNSTN. */ -/* Both are subsequently retrieved, and the cardinality changed, */ -/* in one of its subroutines, WILMA. */ - -/* PROGRAM FLNSTN */ - -/* CHARACTER*30 FRED ( LBCELL:100 ) */ -/* . */ -/* . */ -/* CALL SSIZEC ( 100, FRED ) */ -/* . */ -/* . */ -/* CALL WILMA ( FRED ) */ -/* . */ -/* . */ -/* STOP */ -/* END */ - - -/* SUBROUTINE WILMA ( FRED ) */ - -/* CHARACTER*(*) FRED ( LBCELL:* ) */ -/* INTEGER SIZE */ -/* INTEGER CARD */ - -/* INTEGER CARDC */ -/* INTEGER SIZEC */ -/* . */ -/* . */ -/* SIZE = SIZEC ( FRED ) */ -/* CARD = CARDC ( FRED ) */ -/* . */ -/* . */ -/* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */ -/* CALL EXCESS ( CARD-SIZE, 'cell' ) */ -/* . */ -/* . */ -/* RETURN */ -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the cardinality value supplied is less than 0 or greater */ -/* than the cell size, the error SPICE(INVALIDCARDINALITY) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the cardinality of an integer cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for invalid cardinality value added. An error */ -/* is signalled if the value is out of range. Examples */ -/* updated so as not to refer to the EMPTYx routines, and */ -/* to show the correct calling protocol for EXCESS. */ - -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - return 0; - } else { - chkin_("SCARDI", (ftnlen)6); - } - -/* The cardinality may range from 0 to the size of the cell, */ -/* inclusive. Other values will be snubbed. */ - - if (*card < 0 || *card > cell[4]) { - setmsg_("Attempt to set cardinality of cell to invalid value. The v" - "alue was #.", (ftnlen)70); - errint_("#", card, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SCARDI", (ftnlen)6); - return 0; - } - -/* Not much to this. */ - - cell[5] = *card; - chkout_("SCARDI", (ftnlen)6); - return 0; -} /* scardi_ */ - diff --git a/ext/spice/src/cspice/scdecd.c b/ext/spice/src/cspice/scdecd.c deleted file mode 100644 index 8eb09380dc..0000000000 --- a/ext/spice/src/cspice/scdecd.c +++ /dev/null @@ -1,671 +0,0 @@ -/* scdecd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9999 = 9999; -static integer c__0 = 0; - -/* $Procedure SCDECD ( Decode spacecraft clock ) */ -/* Subroutine */ int scdecd_(integer *sc, doublereal *sclkdp, char *sclkch, - ftnlen sclkch_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - doublereal d__1; - - /* Builtin functions */ - double d_nint(doublereal *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - - /* Local variables */ - integer part, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal ticks; - extern /* Subroutine */ int scfmt_(integer *, doublereal *, char *, - ftnlen); - doublereal pstop[9999]; - extern logical failed_(void); - extern integer lastnb_(char *, ftnlen); - integer prelen; - extern integer lstled_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer suflen; - extern /* Subroutine */ int scpart_(integer *, integer *, doublereal *, - doublereal *), chkout_(char *, ftnlen), prefix_(char *, integer *, - char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen, - ftnlen); - integer nparts; - doublereal pstart[9999]; - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - doublereal ptotls[9999]; - char prtstr[5]; - -/* $ Abstract */ - -/* Convert double precision encoding of spacecraft clock time into */ -/* a character representation. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* SCLKDP I Encoded representation of a spacecraft clock count. */ -/* SCLKCH O Character representation of a clock count. */ -/* MXPART P Maximum number of spacecraft clock partitions. */ - -/* $ Detailed_Input */ - -/* SC is the NAIF integer code of the spacecraft whose */ -/* clock's time is being decoded. */ - -/* SCLKDP is the double precision encoding of a clock time in */ -/* units of ticks since the spacecraft clock start time. */ -/* This value does reflect partition information. */ - -/* An analogy may be drawn between a spacecraft clock */ -/* and a standard wall clock. The number of ticks */ -/* corresponding to the wall clock string */ - -/* hh:mm:ss */ - -/* would be the number of seconds represented by that */ -/* time. */ - -/* For example: */ - -/* Clock string Number of ticks */ -/* ------------ --------------- */ -/* 00:00:10 10 */ -/* 00:01:00 60 */ -/* 00:10:00 600 */ -/* 01:00:00 3600 */ - -/* If SCLKDP contains a fractional part the result */ -/* is the same as if SCLKDP had been rounded to the */ -/* nearest whole number. */ - -/* $ Detailed_Output */ - -/* SCLKCH is the character representation of the clock count. */ -/* The exact form that SCLKCH takes depends on the */ -/* spacecraft. */ - -/* Nevertheless, SCLKCH will have the following general */ -/* format: */ - -/* 'pp/sclk_string' */ - -/* 'pp' is an integer greater than or equal to one and */ -/* represents a "partition number". */ - -/* Each mission is divided into some number of partitions. */ -/* A new partition starts when the spacecraft clock */ -/* resets, either to zero, or to some other */ -/* value. Thus, the first partition for any mission */ -/* starts with launch, and ends with the first clock */ -/* reset. The second partition starts immediately when */ -/* the first stopped, and so on. */ - -/* In order to be completely unambiguous about a */ -/* particular time, you need to specify a partition number */ -/* along with the standard clock string. */ - -/* Information about when partitions occur for different */ -/* missions is contained in a spacecraft clock kernel */ -/* file which needs to be loaded into the kernel pool */ -/* before calling SCDECD. */ - -/* The routine SCPART may be used to read the partition */ -/* start and stop times, in encoded units of ticks, from */ -/* the kernel file. */ - -/* Since the end time of one partition is coincident with */ -/* the begin time of the next, two different time strings */ -/* with different partition numbers can encode into the */ -/* same value. */ - -/* For example, if partition 1 ends at time t1, and */ -/* partition 2 starts at time t2, then */ - -/* '1/t1' and '2/t2' */ - -/* will be encoded into the same value, say X. SCDECD */ -/* always decodes such values into the latter of the */ -/* two partitions. In this example, */ - -/* CALL SCDECD ( X, SC, CLKSTR ) */ - -/* will result in */ - -/* CLKSTR = '2/t2'. */ - - - -/* 'sclk_string' is a spacecraft specific clock string, */ -/* typically consisting of a number of components */ -/* separated by delimiters. */ - -/* Using Galileo as an example, the full format is */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */ -/* Count (RIM), which increments once every time xx turns */ -/* over, i.e., once every 60 2/3 seconds. The roll-over */ -/* expression for the RIM is 16777215, which corresponds */ -/* to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft clock. */ -/* SCLK components may be separated by any of these five */ -/* characters: ' ' ':' ',' '-' '.' */ -/* The delimiter used is determined by a kernel pool */ -/* variable and can be adjusted by the user. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Voyager and Mars Observer clock */ -/* formats. */ - - -/* $ Parameters */ - -/* MXPART is the maximum number of spacecraft clock partitions */ -/* expected in the kernel file for any one spacecraft. */ -/* See the INCLUDE file sclk.inc for this parameter's */ -/* value. */ - -/* $ Exceptions */ - -/* 1) If kernel variables required by this routine are unavailable, */ -/* the error will be diagnosed by routines called by this routine. */ -/* SCLKCH will be returned as a blank string in this case. */ - -/* 2) If the number of partitions in the kernel file for spacecraft */ -/* SC exceeds the parameter MXPART, the error */ -/* 'SPICE(TOOMANYPARTS)' is signaled. SCLKCH will be returned */ -/* as a blank string in this case. */ - -/* 3) If the encoded value does not fall in the boundaries of the */ -/* mission, the error 'SPICE(VALUEOUTOFRANGE)' is signaled. */ -/* SCLKCH will be returned as a blank string in this case. */ - -/* 4) If the declared length of SCLKCH is not large enough to */ -/* contain the output clock string the error */ -/* 'SPICE(SCLKTRUNCATED)' is signaled either by this routine */ -/* or by a routine called by this routine. On output SCLKCH */ -/* will contain a portion of the truncated clock string. */ - -/* $ Files */ - -/* A kernel file containing spacecraft clock partition information */ -/* for the desired spacecraft must be loaded, using the routine */ -/* FURNSH, before calling this routine. */ - -/* $ Particulars */ - -/* In general, it is difficult to compare spacecraft clock counts */ -/* numerically since there are too many clock components for a */ -/* single comparison. The routine SCENCD provides a method of */ -/* assigning a single double precision number to a spacecraft's */ -/* clock count, given one of its character representations. */ - -/* This routine performs the inverse operation to SCENCD, converting */ -/* an encoded double precision number to character format. */ - -/* To convert the number of ticks since the start of the mission to */ -/* a clock format character string, SCDECD: */ - -/* 1) Determines the spacecraft clock partition that TICKS falls */ -/* in. */ - -/* 2) Subtracts off the number of ticks occurring in previous */ -/* partitions, to get the number of ticks since the beginning */ -/* of the current partition. */ - -/* 3) Converts the resulting ticks to clock format and forms the */ -/* string */ - -/* 'partition_number/clock_string' */ - - -/* $ Examples */ - -/* Double precision encodings of spacecraft clock counts are used to */ -/* tag pointing data in the C-kernel. */ - -/* In the following example, pointing for a sequence of images from */ -/* the Voyager 2 narrow angle camera is requested from the C-kernel */ -/* using an array of character spacecraft clock counts as input. */ -/* The clock counts attached to the output are then decoded to */ -/* character and compared with the input strings. */ - -/* CHARACTER*(25) CLKIN ( 4 ) */ -/* CHARACTER*(25) CLKOUT */ -/* CHARACTER*(25) CLKTOL */ - -/* DOUBLE PRECISION TIMEIN */ -/* DOUBLE PRECISION TIMOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ - -/* INTEGER NPICS */ -/* INTEGER SC */ - -/* DATA NPICS / 4 / */ - -/* DATA CLKIN / '2/20538:39:768', */ -/* . '2/20543:21:768', */ -/* . '2/20550:37', */ -/* . '2/20561:59' / */ - -/* DATA CLKTOL / ' 0:01:000' / */ - -/* C */ -/* C The instrument we want pointing for is the Voyager 2 */ -/* C narrow angle camera. The reference frame we want is */ -/* C J2000. The spacecraft is Voyager 2. */ -/* C */ -/* INST = -32001 */ -/* REF = 'J2000' */ -/* SC = -32 */ - -/* C */ -/* C Load the appropriate files. We need */ -/* C */ -/* C 1) CK file containing pointing data. */ -/* C 2) Spacecraft clock kernel file, for SCENCD and SCDECD. */ -/* C */ -/* CALL CKLPF ( 'VGR2NA.CK' ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* C */ -/* C Convert the tolerance string to ticks. */ -/* C */ -/* CALL SCTIKS ( SC, CLKTOL, TOL ) */ - -/* DO I = 1, NPICS */ - -/* CALL SCENCD ( SC, CLKIN( I ), TIMEIN ) */ - -/* CALL CKGP ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT, */ -/* . FOUND ) */ - -/* CALL SCDECD ( SC, TIMOUT, CLKOUT ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Input s/c clock count: ', CLKIN( I ) */ -/* WRITE (*,*) 'Output s/c clock count: ', CLKOUT */ -/* WRITE (*,*) 'Output C-Matrix: ', CMAT */ - -/* END DO */ - - -/* The output from such a program might look like: */ - - -/* Input s/c clock count: 2/20538:39:768 */ -/* Output s/c clock count: 2/20538:39:768 */ -/* Output C-Matrix: 'first C-matrix' */ - -/* Input s/c clock count: 2/20543:21:768 */ -/* Output s/c clock count: 2/20543:22:768 */ -/* Output C-Matrix: 'second C-matrix' */ - -/* Input s/c clock count: 2/20550:37 */ -/* Output s/c clock count: 2/20550:36:768 */ -/* Output C-Matrix: 'third C-matrix' */ - -/* Input s/c clock count: 2/20561:59 */ -/* Output s/c clock count: 2/20561:58:768 */ -/* Output C-Matrix: 'fourth C-matrix' */ - - -/* $ Restrictions */ - -/* 1) Assumes that an SCLK kernel file appropriate for the clock */ -/* designated by SC is loaded in the kernel pool at the time */ -/* this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */ - -/* Values of parameter MXPART and PARTLN are now */ -/* provided by the INCLUDE file sclk.inc. */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (JML) (WLT) */ - -/* The routine was changed to signal an error when SCLKCH is */ -/* not long enough to contain the output spacecraft clock */ -/* string. */ - -/* FAILED is now checked after calling SCPART. */ - -/* References to CLPOOL were deleted. */ - -/* Miscellaneous minor updates to the header were performed. */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.0, 06-SEP-1990 (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* decode spacecraft_clock */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 10-APR-1992 (JML) (WLT) */ - -/* The routine was changed to signal an error when SCLKCH is */ -/* not long enough to contain the output spacecraft clock */ -/* string. Previously, the SCLK routines simply truncated */ -/* the clock string on the right. It was determined that */ -/* since this truncation could easily go undetected by the */ -/* user ( only the leftmost field of a clock string is */ -/* required when clock string is used as an input to a */ -/* SCLK routine ), it would be better to signal an error */ -/* when this happens. */ - -/* FAILED is checked after calling SCPART in case an */ -/* error has occurred reading the kernel file and the */ -/* error action is not set to 'abort'. */ - -/* References to CLPOOL were deleted. */ - -/* Miscellaneous minor updates to the header were performed. */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCDECD", (ftnlen)6); - } - -/* Use a working copy of the input. */ - - ticks = d_nint(sclkdp); - s_copy(sclkch, " ", sclkch_len, (ftnlen)1); - -/* Read the partition start and stop times (in ticks) for this */ -/* mission. Error if there are too many of them. Also need to */ -/* check FAILED in case error handling is not in ABORT or */ -/* DEFAULT mode. */ - - scpart_(sc, &nparts, pstart, pstop); - if (failed_()) { - chkout_("SCDECD", (ftnlen)6); - return 0; - } - if (nparts > 9999) { - setmsg_("The number of partitions, #, for spacecraft # exceeds the v" - "alue for parameter MXPART, #.", (ftnlen)88); - errint_("#", &nparts, (ftnlen)1); - errint_("#", sc, (ftnlen)1); - errint_("#", &c__9999, (ftnlen)1); - sigerr_("SPICE(TOOMANYPARTS)", (ftnlen)19); - chkout_("SCDECD", (ftnlen)6); - return 0; - } - -/* For each partition, compute the total number of ticks in that */ -/* partition plus all preceding partitions. */ - - d__1 = pstop[0] - pstart[0]; - ptotls[0] = d_nint(&d__1); - i__1 = nparts; - for (i__ = 2; i__ <= i__1; ++i__) { - d__1 = ptotls[(i__3 = i__ - 2) < 9999 && 0 <= i__3 ? i__3 : s_rnge( - "ptotls", i__3, "scdecd_", (ftnlen)495)] + pstop[(i__4 = i__ - - 1) < 9999 && 0 <= i__4 ? i__4 : s_rnge("pstop", i__4, "scd" - "ecd_", (ftnlen)495)] - pstart[(i__5 = i__ - 1) < 9999 && 0 <= - i__5 ? i__5 : s_rnge("pstart", i__5, "scdecd_", (ftnlen)495)]; - ptotls[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", - i__2, "scdecd_", (ftnlen)495)] = d_nint(&d__1); - } - -/* The partition corresponding to the input ticks is the first one */ -/* whose tick total is greater than the input value. The one */ -/* exception is when the input ticks is equal to the total number */ -/* of ticks represented by all the partitions. In this case the */ -/* partition number is the last one, i.e. NPARTS. */ - -/* Error if TICKS comes before the first partition (that is, if it's */ -/* negative), or after the last one. */ - - if (ticks == ptotls[(i__1 = nparts - 1) < 9999 && 0 <= i__1 ? i__1 : - s_rnge("ptotls", i__1, "scdecd_", (ftnlen)510)]) { - part = nparts; - } else { - part = lstled_(&ticks, &nparts, ptotls) + 1; - } - if (ticks < 0. || part > nparts) { - setmsg_("Value for ticks, #, does not fall in any partition for spac" - "ecraft #.", (ftnlen)68); - errdp_("#", &ticks, (ftnlen)1); - errint_("#", sc, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCDECD", (ftnlen)6); - return 0; - } - -/* To get the count in this partition, subtract off the total of */ -/* the preceding partition counts and add the beginning count for */ -/* this partition. */ - - if (part == 1) { - ticks += pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge( - "pstart", i__1, "scdecd_", (ftnlen)535)]; - } else { - ticks = ticks + pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : - s_rnge("pstart", i__1, "scdecd_", (ftnlen)537)] - ptotls[( - i__2 = part - 2) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", - i__2, "scdecd_", (ftnlen)537)]; - } - -/* Now create the output SCLK clock string. */ - -/* First convert from ticks to clock string format. */ - - scfmt_(sc, &ticks, sclkch, sclkch_len); - -/* Now convert the partition number to a character string and prefix */ -/* it to the output string. */ - - intstr_(&part, prtstr, (ftnlen)5); - suffix_("/", &c__0, prtstr, (ftnlen)1, (ftnlen)5); - prelen = lastnb_(prtstr, (ftnlen)5); - suflen = lastnb_(sclkch, sclkch_len); - if (i_len(sclkch, sclkch_len) - suflen < prelen) { - setmsg_("Output string too short to contain clock string. Input tick" - " value: #, requires string of length #, but declared length " - "is #.", (ftnlen)124); - errdp_("#", sclkdp, (ftnlen)1); - i__1 = prelen + suflen; - errint_("#", &i__1, (ftnlen)1); - i__1 = i_len(sclkch, sclkch_len); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(SCLKTRUNCATED)", (ftnlen)20); - chkout_("SCDECD", (ftnlen)6); - return 0; - } - prefix_(prtstr, &c__0, sclkch, (ftnlen)5, sclkch_len); - chkout_("SCDECD", (ftnlen)6); - return 0; -} /* scdecd_ */ - diff --git a/ext/spice/src/cspice/scdecd_c.c b/ext/spice/src/cspice/scdecd_c.c deleted file mode 100644 index c05939a1f5..0000000000 --- a/ext/spice/src/cspice/scdecd_c.c +++ /dev/null @@ -1,473 +0,0 @@ -/* - --Procedure scdecd_c ( Decode spacecraft clock ) - --Abstract - - Convert double precision encoding of spacecraft clock time into - a character representation. - --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 - - SCLK - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void scdecd_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceInt lenout, - SpiceChar * sclkch ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft identification code. - sclkdp I Encoded representation of a spacecraft clock count. - lenout I Maximum allowed length of output SCLK string. - sclkch O Character representation of a clock count. - MXPART P Maximum number of spacecraft clock partitions. - --Detailed_Input - - sc is the NAIF integer code of the spacecraft whose - clock's time is being decoded. - - sclkdp is the double precision encoding of a clock time in - units of ticks since the spacecraft clock start time. - This value does reflect partition information. - - An analogy may be drawn between a spacecraft clock - and a standard wall clock. The number of ticks - corresponding to the wall clock string - - hh:mm:ss - - would be the number of seconds represented by that - time. - - For example: - - Clock string Number of ticks - ------------ --------------- - 00:00:10 10 - 00:01:00 60 - 00:10:00 600 - 01:00:00 3600 - - If sclkdp contains a fractional part the result - is the same as if sclkdp had been rounded to the - nearest whole number. - - - lenout is the maximum number of characters that can be - accommodated in the output string. This count - includes room for the terminating null character. - For example, if the maximum allowed length of the - output string, including the terminating null, is 25 - characters, then lenout should be set to 25. - --Detailed_Output - - sclkch is the character representation of the clock count. - The exact form that sclkch takes depends on the - spacecraft. - - Nevertheless, sclkch will have the following general - format: - - "pp/sclk_string" - - "pp" is an integer greater than or equal to one and - represents a "partition number". - - Each mission is divided into some number of partitions. - A new partition starts when the spacecraft clock - resets, either to zero, or to some other - value. Thus, the first partition for any mission - starts with launch, and ends with the first clock - reset. The second partition starts immediately when - the first stopped, and so on. - - In order to be completely unambiguous about a - particular time, you need to specify a partition number - along with the standard clock string. - - Information about when partitions occur for different - missions is contained in a spacecraft clock kernel - file which needs to be loaded into the kernel pool - before calling scdecd_c. - - The routine scpart_c may be used to read the partition - start and stop times, in encoded units of ticks, from - the kernel file. - - Since the end time of one partition is coincident with - the begin time of the next, two different time strings - with different partition numbers can encode into the - same value. - - For example, if partition 1 ends at time t1, and - partition 2 starts at time t2, then - - "1/t1" and "2/t2" - - will be encoded into the same value, say X. scdecd_c - always decodes such values into the latter of the - two partitions. In this example, - - scdecd_c ( x, sc, MAXLEN, clkstr ) - - will result in - - clkstr = "2/t2". - - - "sclk_string" is a spacecraft specific clock string, - typically consisting of a number of components - separated by delimiters. - - Using Galileo as an example, the full format is - - wwwwwwww:xx:y:z - - where z is a mod-8 counter (values 0-7) which - increments approximately once every 8 1/3 ms., y is a - mod-10 counter (values 0-9) which increments once - every time z turns over, i.e., approximately once every - 66 2/3 ms., xx is a mod-91 (values 0-90) counter - which increments once every time y turns over, i.e., - once every 2/3 seconds. wwwwwwww is the Real-Time Image - Count (RIM), which increments once every time xx turns - over, i.e., once every 60 2/3 seconds. The roll-over - expression for the RIM is 16777215, which corresponds - to approximately 32 years. - - wwwwwwww, xx, y, and z are referred to interchangeably - as the fields or components of the spacecraft clock. - SCLK components may be separated by any of these five - characters: " " ":" "," "-" "." - The delimiter used is determined by a kernel pool - variable and can be adjusted by the user. - - Some spacecraft clock components have offset, or - starting, values different from zero. For example, - with an offset value of 1, a mod 20 counter would - cycle from 1 to 20 instead of from 0 to 19. - - See the SCLK required reading for a detailed - description of the Voyager and Mars Observer clock - formats. - - --Parameters - - MXPART is the maximum number of spacecraft clock partitions - expected in the kernel file for any one spacecraft. - MXPART is currently set to 9999. - --Exceptions - - 1) If kernel variables required by this routine are unavailable, - the error will be diagnosed by routines called by this routine. - sclkch will be returned as a blank string in this case. - - 2) If the number of partitions in the kernel file for spacecraft - SC exceeds the parameter MXPART, the error - SPICE(TOOMANYPARTS) is signaled. sclkch will be returned - as a blank string in this case. - - 3) If the encoded value does not fall in the boundaries of the - mission, the error SPICE(VALUEOUTOFRANGE) is signaled. - sclkch will be returned as a blank string in this case. - - 4) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 5) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - - 6) If the length of sclkch (indicated by lenout) is at least two - characters but not large enough to contain the output clock - string, the error SPICE(SCLKTRUNCATED) is signaled either by the - underlying Fortran routine or by a routine called by that routine. - On output sclkch will contain a portion of the truncated clock - string. - - --Files - - A kernel file containing spacecraft clock partition information - for the desired spacecraft must be loaded, using the routine - furnsh_c, before calling this routine. - --Particulars - - In general, it is difficult to compare spacecraft clock counts - numerically since there are too many clock components for a - single comparison. The routine scencd_c provides a method of - assigning a single double precision number to a spacecraft's - clock count, given one of its character representations. - - This routine performs the inverse operation to scencd_c, converting - an encoded double precision number to character format. - - To convert the number of ticks since the start of the mission to - a clock format character string, scdecd_c: - - 1) Determines the spacecraft clock partition that TICKS falls - in. - - 2) Subtracts off the number of ticks occurring in previous - partitions, to get the number of ticks since the beginning - of the current partition. - - 3) Converts the resulting ticks to clock format and forms the - string - - "partition_number/clock_string" - - --Examples - - Double precision encodings of spacecraft clock counts are used to - tag pointing data in the C-kernel. - - In the following example, pointing for a sequence of images from - the Voyager 2 narrow angle camera is requested from the C-kernel - using an array of character spacecraft clock counts as input. - The clock counts attached to the output are then decoded to - character and compared with the input strings. - - #include - #include "SpiceUsr.h" - - void main() - { - /. - The instrument we want pointing for is the Voyager 2 - narrow angle camera. The reference frame we want is - J2000. The spacecraft is Voyager 2. - ./ - - #define SC -32 - #define INST -32001 - #define REF "J2000" - #define CK "/kernels/voyager2/ck/vg2_jup_qmw_na.bc" - #define SCLK "/kernels/voyager2/sclk/vg200004.tsc" - #define NPICS 4 - #define CLKTOL "0:01:001" - #define MAXLEN 30 - - SpiceBoolean found; - - SpiceChar sclkin [4][25] = { {"2 / 20538:39:768"}, - {"2 / 20543:21:768"}, - {"2 / 20550:37" }, - {"2 / 20561:59" } }; - SpiceChar sclkout[25]; - - SpiceDouble tol; - SpiceDouble timein; - SpiceDouble timeout; - SpiceDouble cmat [3][3]; - - SpiceInt handle; - SpiceInt i; - - - /. - Load the appropriate files. We need - - 1) CK file containing pointing data. - 2) Spacecraft clock kernel file, for scencd_c and SCDECD. - ./ - - cklpf_c ( CK, &handle ); - furnsh_c ( SCLK ); - - - /. - Convert the tolerance string to ticks. - ./ - sctiks_c ( SC, CLKTOL, &tol ); - - - for ( i = 0; i < NPICS; i++ ) - { - scencd_c ( SC, sclkin[i], &timein ); - - ckgp_c ( INST, timein, tol, REF, - cmat, &timeout, &found ); - - scdecd_c ( SC, timeout, MAXLEN, sclkout ); - - if ( found ) - { - printf ( "\n" - "Input s/c clock count: %s\n" - "Output s/c clock count: %s\n" - "Output C-Matrix: \n" - "%25.16f %25.16f %25.16f\n" - "%25.16f %25.16f %25.16f\n" - "%25.16f %25.16f %25.16f\n" - "\n", - sclkin[i], - sclkout, - cmat[0][0], cmat[0][1], cmat[0][2], - cmat[1][0], cmat[1][1], cmat[1][2], - cmat[2][0], cmat[2][1], cmat[2][2] ); - } - else - { - printf ( "\n" - "Input s/c clock count: %s\n" - "No pointing found.\n", - sclkin[i] ); - } - } - - } - - - The output from such a program might look like: - - - Input s/c clock count: 2 / 20538:39:768 - Output s/c clock count: 2/20538:39:768 - Output C-Matrix: "first C-matrix" - - Input s/c clock count: 2 / 20543:21:768 - Output s/c clock count: 2/20543:22:768 - Output C-Matrix: "second C-matrix" - - Input s/c clock count: 2 / 20550:37 - Output s/c clock count: 2/20550:36:768 - Output C-Matrix: "third C-matrix" - - Input s/c clock count: 2 / 20561:59 - Output s/c clock count: 2/20561:58:768 - Output C-Matrix: "fourth C-matrix" - - --Restrictions - - 1) Assumes that an SCLK kernel file appropriate for the clock - designated by SC is loaded in the kernel pool at the time - this routine is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.M. Lynch (JPL) - R.E. Thurman (JPL) - --Version - - -CSPICE Version 1.2.0, 11-FEB-2008 (NJB) - - Definition of constant macro MXPART was deleted. - Documentation was updated to reflect current - MXPART value of 9999. - - -CSPICE Version 1.1.2, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.1, 26-MAR-2003 (NJB) - - Fixed description of exception (6): replaced "lenout-1" - with "lenout." Corrected spelling of "signaled." - - -CSPICE Version 1.1.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Added output string length and pointer checks. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - --Index_Entries - - decode spacecraft_clock - --& -*/ - -{ /* Begin scdecd_c */ - - - /* - Participate in error handling - */ - chkin_c ( "scdecd_c"); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "scdecd_c", sclkch, lenout ); - - - /* - Decode the encoded SCLK value. - */ - scdecd_ ( ( integer * ) &sc, - ( doublereal * ) &sclkdp, - ( char * ) sclkch, - ( ftnlen ) lenout-1 ); - - /* - Convert the Fortran string to a C string by placing a null - after the last non-blank character. This operation is valid - whether or not the SPICELIB routine signaled an error. - */ - F2C_ConvertStr ( lenout, sclkch ); - - - chkout_c ( "scdecd_c"); - - -} /* End scdecd_c */ diff --git a/ext/spice/src/cspice/sce2c.c b/ext/spice/src/cspice/sce2c.c deleted file mode 100644 index 935b126997..0000000000 --- a/ext/spice/src/cspice/sce2c.c +++ /dev/null @@ -1,294 +0,0 @@ -/* sce2c.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCE2C ( ET to continuous SCLK ticks ) */ -/* Subroutine */ int sce2c_(integer *sc, doublereal *et, doublereal *sclkdp) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int scec01_(integer *, doublereal *, doublereal *) - , chkin_(char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern integer sctype_(integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert ephemeris seconds past J2000 (ET) to continuous encoded */ -/* spacecraft clock (`ticks'). Non-integral tick values may be */ -/* returned. */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* ET I Ephemeris time, seconds past J2000. */ -/* SCLKDP O SCLK, encoded as ticks since spacecraft clock */ -/* start. SCLKDP need not be integral. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF integer code for a spacecraft whose */ -/* encoded SCLK value at the epoch specified by ET is */ -/* desired. */ - -/* ET is an epoch, specified as ephemeris seconds past */ -/* J2000. */ - -/* $ Detailed_Output */ - -/* SCLKDP is an encoded spacecraft clock value. SCLKDP is */ -/* an encoded representation of the total number */ -/* of spacecraft clock ticks measured from the time */ -/* the spacecraft clock started to the epoch ET: */ -/* partition information IS reflected in the encoded */ -/* value. */ - -/* SCLKDP may be non-integral: SCLKDP is NOT */ -/* rounded to the nearest whole tick. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument SCLKDP will not */ -/* be modified. */ - -/* 2) When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument SCLKDP will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - -/* 3) If the clock type for the spacecraft clock identified by */ -/* SC is not supported by this routine, the error */ -/* SPICE(NOTSUPPORTED) is signalled. The output argument SCLKDP */ -/* will not be modified. */ - -/* 4) If the input ET value is not representable as an encoded */ -/* spacecraft clock value for the spacecraft clock identified by */ -/* SC, the error will be diagnosed by routines called by this */ -/* routine. The output argument SCLKDP will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine outputs continuous encoded SCLK values; unlike the */ -/* routine SCE2T, the values output by this routine need not be */ -/* integral. */ - -/* This routine supports use of non-integral encoded clock values in */ -/* C-kernels: non-integral clock values may be stored as pointing */ -/* time tags when a C-kernel is created, and they may be supplied */ -/* as request times to the C-kernel readers. */ - -/* The advantage of encoded SCLK, as opposed to character string */ -/* representations of SCLK, is that encoded SCLK values are easy to */ -/* perform arithmetic operations on. Also, working with encoded SCLK */ -/* reduces the overhead of repeated conversion of character strings */ -/* to integers or double precision numbers. */ - -/* To convert ET to a string representation of an SCLK value, use */ -/* the SPICELIB routine SCE2S. */ - -/* See the SCLK Required Reading for a list of the entire set of */ -/* SCLK conversion routines. */ - -/* $ Examples */ - -/* 1) Convert ET directly to an encoded SCLK value; use both of */ -/* these time values to look up both C-kernel (pointing) and */ -/* SPK (position and velocity) data for an epoch specified by an */ -/* ephemeris time. */ - -/* During program initialization, load the leapseconds and */ -/* SCLK kernels. We will pretend that these files are named */ -/* "LEAPSECONDS.KER" and "GLLSCLK.KER". To use this code */ -/* fragment, you must substitute the actual names of these */ -/* kernel files for the names used here. */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'GLLSCLK.KER' ) */ - -/* The mission is Galileo, which has spacecraft ID -77. */ -/* Let ET be the epoch, specified in ephemeris seconds */ -/* past J2000, at which both position and pointing data */ -/* are desired. */ - -/* Find the continuous encoded SCLK value corresponding to ET. */ - -/* CALL SCE2C ( -77, ET, SCLKDP ) */ - -/* Now you're ready to call both CKGP, which expects the input */ -/* epoch to be specified by an encoded SCLK string, and */ -/* SPKEZ, which expects the epoch to be specified as an */ -/* ephemeris time. */ - -/* C */ -/* C Find scan platform pointing CMAT and s/c--target */ -/* C vector (first 3 components of STATE) at epoch. */ -/* C We assume that CK and SPK kernels have been loaded */ -/* C already, via CKLPF and SPKLEF respectively. */ -/* C */ -/* CALL CKGP ( SCANPL, */ -/* . SCLKDP, */ -/* . TOL, */ -/* . REFSYS, */ -/* . CMAT, */ -/* . CLKOUT, */ -/* . FOUND ) */ - -/* CALL SPKEZ ( TARGET, */ -/* . ET, */ -/* . REFSYS, */ -/* . CORR, */ -/* . -77, */ -/* . STATE, */ -/* . LT ) */ - - -/* 2) Convert UTC to a continuous encoded Voyager 2 SCLK value. */ - -/* Again, your initialization code must load the leapseconds */ -/* and SCLK kernels. */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'VGR2SCLK.KER' ) */ - - -/* To find the encoded Voyager 2 SCLK value SCLKDP */ -/* corresponding to a UTC time, you can use the code fragment */ - -/* CALL UTC2ET ( UTC, ET ) */ -/* CALL SCE2C ( -32, ET, SCLKDP ) */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* [1] CK Required Reading */ - -/* [2] SPK Required Reading */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.0.0, 09-MAR-1999 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ephemeris time to continuous spacecraft_clock ticks */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCE2C", (ftnlen)5); - } - -/* Just hand off the conversion to the appropriate routine. */ - - if (sctype_(sc) == 1) { - scec01_(sc, et, sclkdp); - } else { - setmsg_("Clock type # is not supported.", (ftnlen)30); - i__1 = sctype_(sc); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SCE2C", (ftnlen)5); - return 0; - } - chkout_("SCE2C", (ftnlen)5); - return 0; -} /* sce2c_ */ - diff --git a/ext/spice/src/cspice/sce2c_c.c b/ext/spice/src/cspice/sce2c_c.c deleted file mode 100644 index 9676321883..0000000000 --- a/ext/spice/src/cspice/sce2c_c.c +++ /dev/null @@ -1,275 +0,0 @@ -/* - --Procedure sce2c_c ( ET to continuous SCLK ticks ) - --Abstract - - Convert ephemeris seconds past J2000 (ET) to continuous encoded - spacecraft clock (`ticks'). Non-integral tick values may be - returned. - --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 - - SCLK - TIME - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void sce2c_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft ID code. - et I Ephemeris time, seconds past J2000. - sclkdp O SCLK, encoded as ticks since spacecraft clock - start. sclkdp need not be integral. - --Detailed_Input - - sc is a NAIF integer code for a spacecraft whose - encoded SCLK value at the epoch specified by et is - desired. - - et is an epoch, specified as ephemeris seconds past - J2000. - --Detailed_Output - - sclkdp is an encoded spacecraft clock value. sclkdp is - an encoded representation of the total number - of spacecraft clock ticks measured from the time - the spacecraft clock started to the epoch et: - partition information IS reflected in the encoded - value. - - sclkdp may be non-integral: sclkdp is NOT - rounded to the nearest whole tick. - --Parameters - - None. - --Exceptions - - 1) This routine assumes that that an SCLK kernel appropriate - to the spacecraft clock identified by the input argument sc - has been loaded. If an SCLK kernel has not been loaded, - does not contain all of the required data, or contains - invalid data, error diagnoses will be performed by routines - called by this routine. The output argument sclkdp will not - be modified. - - 2) When using SCLK kernels that map SCLK to a time system other - than ET (also called barycentric dynamical time---`TDB'), it - is necessary to have a leapseconds kernel loaded at the time - this routine is called. If a leapseconds kernel is required - for conversion between SCLK and ET but is not loaded, the - error will be diagnosed by routines called by this routine. - The output argument sclkdp will not be modified. - - The time system that an SCLK kernel maps SCLK to is indicated - by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn - is the negative of the NAIF integer code for the spacecraft. - The time system used in a kernel is TDB if and only if the - variable is assigned the value 1. - - 3) If the clock type for the spacecraft clock identified by - SC is not supported by this routine, the error - SPICE(NOTSUPPORTED) is signalled. The output argument sclkdp - will not be modified. - - 4) If the input ET value is not representable as an encoded - spacecraft clock value for the spacecraft clock identified by - sc, the error will be diagnosed by routines called by this - routine. The output argument sclkdp will not be modified. - --Files - - None. - --Particulars - - This routine outputs continuous encoded SCLK values; unlike the - routine sce2t_c, the values output by this routine need not be - integral. - - This routine supports use of non-integral encoded clock values in - C-kernels: non-integral clock values may be stored as pointing - time tags when a C-kernel is created, and they may be supplied - as request times to the C-kernel readers. - - The advantage of encoded SCLK, as opposed to character string - representations of SCLK, is that encoded SCLK values are easy to - perform arithmetic operations on. Also, working with encoded SCLK - reduces the overhead of repeated conversion of character strings - to integers or double precision numbers. - - To convert ET to a string representation of an SCLK value, use - the CSPICE routine sce2s_c. - - See the SCLK Required Reading for a list of the entire set of SCLK - conversion routines. - --Examples - - 1) Convert ET directly to a continuous, encoded SCLK value. Use - both of these time values to look up both C-kernel (pointing) and - SPK (position and velocity) data for an epoch specified by an - ephemeris time. - - During program initialization, load the leapseconds and - SCLK kernels. We will pretend that these files are named - "leapseconds.ker" and "gllsclk.ker". To use this code - fragment, you must substitute the actual names of these - kernel files for the names used here. - - /. - Load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ) - furnsh_c ( "gllsclk.ker" ) - - The mission is Galileo, which has spacecraft ID -77. - Let ET be the epoch, specified in ephemeris seconds - past J2000, at which both position and pointing data - is desired. - - Find the encoded SCLK value corresponding to ET. - - sce2c_c ( -77, et, &sclkdp ); - - Now you're ready to call both ckgp_c, which expects the input - epoch to be specified by an encoded SCLK string, and - spkez_c, which expects the epoch to be specified as an - ephemeris time. - - /. - Find scan platform pointing cmat and s/c--target - vector (first 3 components of state) at epoch. - We assume that CK and SPK kernels have been loaded - already, via cklpf_c and spklef_c respectively. - ./ - ckgp_c ( scanpl, sclkdp, tol, refsys, - cmat, &clkout, &found ); - - spkez_c ( target, et, refsys, corr, - -77, state, < ); - - - 2) Convert UTC to an encoded Voyager 2 SCLK value. - - Again, your initialization code must load the leapseconds - and SCLK kernels. - - /. - Load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ); - furnsh_c ( "vgr2sclk.ker" ); - - /. - Find the encoded Voyager 2 SCLK value sclkdp - corresponding to the given UTC time. - ./ - utc2et ( utc, &et ); - sce2c_c ( -32, et, &sclkdp ); - --Restrictions - - 1) An SCLK kernel appropriate to the spacecraft clock identified - by SC must be loaded at the time this routine is called. - - 2) If the SCLK kernel used with this routine does not map SCLK - directly to barycentric dynamical time, a leapseconds kernel - must be loaded at the time this routine is called. - --Literature_References - - [1] CK Required Reading - - [2] SPK Required Reading - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.2, 09-NOV-2009 (EDW) - - Corrected typo in header; j2000_c replaced with J2000. Mention of - the J2000 epoch in the previous header used the word "j2000_c" (wrong) - instead of "J2000" (correct). - - -CSPICE Version 1.0.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.0.0, 18-JUN-1999 (NJB) - --Index_Entries - - ephemeris time to continuous spacecraft_clock ticks - --& -*/ - -{ /* Begin sce2c_c */ - - - /* - Participate in error handling. - */ - chkin_c ( "sce2c_c"); - - /* - Do the conversion. - */ - sce2c_ ( ( integer * ) &sc, - ( doublereal * ) &et, - ( doublereal * ) sclkdp ); - - - chkout_c ( "sce2c_c" ); - -} /* End sce2c_c */ diff --git a/ext/spice/src/cspice/sce2s.c b/ext/spice/src/cspice/sce2s.c deleted file mode 100644 index ca7b9edb5a..0000000000 --- a/ext/spice/src/cspice/sce2s.c +++ /dev/null @@ -1,354 +0,0 @@ -/* sce2s.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCE2S ( ET to SCLK string ) */ -/* Subroutine */ int sce2s_(integer *sc, doublereal *et, char *sclkch, ftnlen - sclkch_len) -{ - extern /* Subroutine */ int sce2t_(integer *, doublereal *, doublereal *), - chkin_(char *, ftnlen), scdecd_(integer *, doublereal *, char *, - ftnlen); - doublereal sclkdp; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert an epoch specified as ephemeris seconds past J2000 (ET) to */ -/* a character string representation of a spacecraft clock value */ -/* (SCLK). */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft clock ID code. */ -/* ET I Ephemeris time, specified as seconds past J2000. */ -/* SCLKCH O An SCLK string. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF ID code for a spacecraft clock whose */ -/* reading at the epoch specified by ET is desired. */ - -/* ET is an epoch, specified as ephemeris seconds past */ -/* J2000. */ - -/* $ Detailed_Output */ - -/* SCLKCH is a character string representation of the */ -/* spacecraft clock value that corresponds to ET, for */ -/* the spacecraft clock specified by the input */ -/* argument SC. SCLKCH is an absolute spacecraft */ -/* clock value, so a partition number is included in */ -/* the string. The format of SCLKCH is specified in */ -/* the SCLK kernel for the clock SC. A general */ -/* discussion of spacecraft clock string formats is */ -/* available in the SCLK Required Reading. */ - -/* In order to choose an appropriate length for */ -/* SCLKCH, you can examine an SCLK kernel for the */ -/* clock specified by SC. The format of string */ -/* representations of the clock's values is specified */ -/* by kernel variables associated with the clock. See */ -/* Examples below for further information. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that an SCLK kernel appropriate to the */ -/* spacecraft clock identified by the input argument SC has been */ -/* loaded. If an SCLK kernel has not been loaded, does not */ -/* contain all of the required data, or contains invalid data, */ -/* error diagnoses will be performed by routines called by this */ -/* routine. The output argument SCLKCH will not be modified. */ - -/* 2) When using an SCLK kernel that maps SCLK to a time system */ -/* other than ET (also called barycentric dynamical */ -/* time---`TDB'), it is necessary to have a leapseconds kernel */ -/* loaded at the time this routine is called. If a leapseconds */ -/* kernel is required for conversion between SCLK and ET but is */ -/* not loaded, the error will be diagnosed by routines called by */ -/* this routine. The output argument SCLKCH will not be */ -/* modified. */ - -/* The time system to which an SCLK kernel maps SCLK epochs is */ -/* indicated by the variable SCLK_TIME_SYSTEM_nn in the kernel, */ -/* where nn is the negative of the NAIF integer code for the */ -/* spacecraft. The time system used in a kernel is TDB if and */ -/* only if the variable is assigned the value 1. */ - -/* 3) If the input ET value is not representable in the spacecraft */ -/* clock string format for the spacecraft clock identified by */ -/* SC, the error will be diagnosed by routines called by this */ -/* routine. The output argument SCLKCH will not be modified. */ - -/* 4) If the output argument SCLKCH is too short to contain the */ -/* output spacecraft clock string produced by this routine, */ -/* the error will be diagnosed by routines called by this */ -/* routine. The output argument SCLKCH may contain a portion */ -/* of the truncated string. */ - -/* $ Files */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is provided as a convenience; it is simply shorthand */ -/* for the code fragment */ - -/* CALL SCE2T ( SC, ET, SCLKDP ) */ -/* CALL SCDECD ( SC, SCLKDP, SCLKCH ) */ - -/* See the SCLK Required Reading for a list of the entire set of */ -/* SCLK conversion routines. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) Determine the length of Galileo spacecraft clock strings. */ - -/* Examine a Galileo SCLK kernel. There you'll find the */ -/* kernel variable assignments */ - -/* SCLK01_MODULI_77 = ( 16777215 91 10 8 ) */ -/* SCLK01_OFFSETS_77 = ( 0 0 0 0 ) */ - -/* Each field of the clock string contains values ranging */ -/* from the offset value to M-1, where M is the corresponding */ -/* modulus. So the Galileo clock fields have maximum values */ - -/* 16777214 90 9 7 */ - -/* representing the partition number by the symbol "pp" and */ -/* the field delimiter character by the symbol "D", we see */ -/* that the GLL SCLK format is */ - -/* pp/xxxxxxxxDxxDxDx */ - -/* This string has length 18 characters. Accounting for the */ -/* terminating null character, the value of `lenout' should */ -/* be set to at least 19. */ - -/* Note: the delimiter character is determined by the integer */ -/* code assignment */ - -/* SCLK01_OUTPUT_DELIM_77 = ( 2 ) */ - -/* The SCLK Required Reading indicates that 2 is the SCLK kernel */ -/* code for the colon character. */ - - -/* 2) Find the Galileo SCLK value corresponding to the ET */ - -/* -322452420.5593641. */ - - -/* C */ -/* C Start out by loading the SCLK kernel. In your own */ -/* C program, you must use the name of a real SCLK kernel. */ -/* C The name shown here is fictitious. */ -/* C */ -/* CALL FURNSH ( 'GLLSCLK.KER' ) */ - -/* C */ -/* C Load a leapseconds kernel in case it is needed for */ -/* C SCLK-to-ET conversion. Depending on the SCLK kernel */ -/* C used, it may not be necessary to load this file; it's */ -/* C just a simple, reliable way of making sure that the */ -/* C leapseconds kernel constants are available if we need */ -/* C them. Again, a fictitious name is used. */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ - -/* C */ -/* C The spacecraft ID code for Galileo is -77. */ -/* C */ -/* SC = -77 */ -/* ET = -322452420.5593641 */ - -/* CALL SCE2S ( SC, ET, SCLKCH ) */ - - -/* The returned value of SCLKCH will be */ - -/* 1/00010001:44:2:0. */ - - -/* 2) Convert the UTC time */ - -/* August 25 1989 4:00:00 */ - -/* to a Voyager 2 SCLK value. */ - -/* To enable you to perform UTC to ET conversion, your */ -/* initialization code must load the leapseconds and SCLK */ -/* kernels: */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'VGR2SCLK.KER' ) */ - - -/* To find Voyager 2 SCLK string corresponding to the */ -/* specified UTC time, you can use the code fragment */ - -/* CALL UTC2ET ( 'Aug 25 1989 4:00:00', ET ) */ -/* CALL SCE2S ( -32, ET, SCLKCH ) */ - -/* The result of the conversion is */ - -/* SCLKCH = '4/11390:22:012' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.2, 29-JUL-2003 (NJB) */ - -/* Various header changes were made to improve clarity and */ -/* more fully explain the routine's functionality. */ - -/* - SPICELIB Version 1.2.1, 09-MAR-1999 (NJB) */ - -/* Explicit list of SCLK conversion routines in Particulars */ -/* section has been replaced by a pointer to the SCLK Required */ -/* Reading. */ - -/* - SPICELIB Version 1.2.0, 10-APR-1992 (NJB) (WLT) */ - -/* Truncation of the output string is now treated as an error. */ -/* Header was updated to reflect possibility of needing to load */ -/* a leapseconds kernel before calling this routine. Comment */ -/* section for permuted index source lines was added following the */ -/* header. */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Missing example added to the $ Examples section. Restrictions */ -/* section no longer states that you must load the leapseconds */ -/* kernel prior to calling this routine. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ephemeris time to spacecraft_clock string */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 10-APR-1992 (NJB) (WLT) */ - -/* Truncation of the output string is now treated as an error. */ -/* The code changes made to implement the error checking were */ -/* in SCDECD and other lower-level routines. */ - -/* The header was updated to reflect possibility of needing to */ -/* load a leapseconds kernel before calling this routine. */ - -/* The comment section for permuted index source lines was added */ -/* following the header. */ - - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Missing example added to the $ Examples section. Restrictions */ -/* section no longer states that you must load the leapseconds */ -/* kernel prior to calling this routine. */ - -/* The second example no longer uses a call to CLPOOL. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCE2S", (ftnlen)5); - } - -/* Convert ET to encoded SCLK, and then to an SCLK string. */ - - sce2t_(sc, et, &sclkdp); - scdecd_(sc, &sclkdp, sclkch, sclkch_len); - chkout_("SCE2S", (ftnlen)5); - return 0; -} /* sce2s_ */ - diff --git a/ext/spice/src/cspice/sce2s_c.c b/ext/spice/src/cspice/sce2s_c.c deleted file mode 100644 index 464b7291b5..0000000000 --- a/ext/spice/src/cspice/sce2s_c.c +++ /dev/null @@ -1,379 +0,0 @@ -/* - --Procedure sce2s_c ( ET to SCLK string ) - --Abstract - - Convert an epoch specified as ephemeris seconds past J2000 (ET) to a - character string representation of a spacecraft clock value (SCLK). - --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 - - SCLK - TIME - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void sce2s_c ( SpiceInt sc, - SpiceDouble et, - SpiceInt lenout, - SpiceChar * sclkch ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft clock ID code. - et I Ephemeris time, specified as seconds past J2000. - lenout I Maximum length of output string. - sclkch O An SCLK string. - --Detailed_Input - - sc is a NAIF ID code for a spacecraft clock whose - reading at the epoch specified by `et' is desired. - - et is an epoch, specified as ephemeris seconds past - J2000 TDB. - - lenout is the maximum number of characters that can be - accommodated in the output string. This count - includes room for the terminating null character. For - example, if the maximum allowed length of the output - string, including the terminating null, is 25 - characters, then `lenout' should be set to 25. - - In order to choose an appropriate value of `lenout', - you can examine an SCLK kernel for the clock specified - by `sc'. The format of string representations of - the clock's values is specified by kernel variables - associated with the clock. See Examples below for - further information. - --Detailed_Output - - sclkch is a character string representation of the - spacecraft clock value that corresponds to `et', for - the spacecraft clock specified by the input argument - `sc'. `sclkch' is an absolute spacecraft clock value, - so a partition number is included in the string. The - format of `sclkch' is specified in the SCLK kernel - for the clock `sc'. A general discussion of - spacecraft clock string formats is available in the - SCLK Required Reading. - --Parameters - - None. - --Exceptions - - 1) This routine assumes that an SCLK kernel appropriate to the - spacecraft clock identified by the input argument SC has been - loaded. If an SCLK kernel has not been loaded, does not contain - all of the required data, or contains invalid data, error - diagnoses will be performed by routines in the call tree of this - routine. The output argument `sclkch' will not be modified. - - 2) When using an SCLK kernel that maps SCLK to a time system other - than ET (also called barycentric dynamical time---"TDB"), it is - necessary to have a leapseconds kernel loaded at the time this - routine is called. If a leapseconds kernel is required for - conversion between SCLK and ET but is not loaded, the error will - be diagnosed by routines called by this routine. The output - argument `sclkch' will not be modified. - - The time system to which an SCLK kernel maps SCLK epochs is - indicated by the variable SCLK_TIME_SYSTEM_nn in the kernel, - where nn is the negative of the NAIF integer code for the - spacecraft. The time system used in a kernel is TDB if and only - if the variable is assigned the value 1. - - 3) If the input ET value is not representable in the spacecraft - clock string format for the spacecraft clock identified by `sc', - the error will be diagnosed by routines in the call tree of this - routine. The output argument `sclkch' will not be modified. - - 4) If the declared length of the output argument `sclkch' is too - short to contain the output spacecraft clock string produced by - this routine, the error will be diagnosed by routines in the - call tree of this routine. The output argument `sclkch' may - contain a portion of the truncated string. - --Files - - 1) An SCLK kernel appropriate to the spacecraft clock identified - by SC must be loaded at the time this routine is called. - - 2) If the SCLK kernel used with this routine does not map SCLK - directly to barycentric dynamical time, a leapseconds kernel - --Particulars - - This routine is provided as a convenience; it is simply shorthand - for the code fragment - - sce2t_c ( sc, et, &sclkdp ); - scdecd_c ( sc, sclkdp, sclkch ); - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Determine the length of Galileo spacecraft clock strings. - - Examine a Galileo SCLK kernel. There you'll find the - kernel variable assignments - - SCLK01_MODULI_77 = ( 16777215 91 10 8 ) - SCLK01_OFFSETS_77 = ( 0 0 0 0 ) - - Each field of the clock string contains values ranging - from the offset value to M-1, where M is the corresponding - modulus. So the Galileo clock fields have maximum values - - 16777214 90 9 7 - - representing the partition number by the symbol "pp" and - the field delimiter character by the symbol "D", we see - that the GLL SCLK format is - - pp/xxxxxxxxDxxDxDx - - This string has length 18 characters. Accounting for the - terminating null character, the value of `lenout' should - be set to at least 19. - - Note: the delimiter character is determined by the integer - code assignment - - SCLK01_OUTPUT_DELIM_77 = ( 2 ) - - The SCLK Required Reading indicates that 2 is the SCLK kernel - code for the colon character. - - - 2) Find the Galileo SCLK value corresponding to the ET value - - -322452420.5593641. - - We can use the program below: - - #include - #include "SpiceUsr.h" - - int main() - { - #define SCLKLEN 30 - - /. - The spacecraft ID code for the Galileo orbiter - is -77. This is the code for the Galileo spacecraft - clock as well. - ./ - #define GLL -77 - - SpiceChar sclkch[SCLKLEN]; - SpiceDouble et; - - - /. - Start out by loading the SCLK kernel. In your own - program, you must use the name of a real SCLK kernel. - The name shown here is fictitious. - ./ - furnsh_c ( "gllsclk.ker" ); - - /. - Load a leapseconds kernel in case it is needed for - SCLK-to-ET conversion. Depending on the SCLK kernel - used, it may not be necessary to load this file; it's - just a simple, reliable way of making sure that the - leapseconds kernel constants are available if we need - them. Again, a fictitious name is used. - ./ - furnsh_c ( "leapseconds.ker" ); - - et = -322452420.5593641; - - sce2s_c ( GLL, et, SCLKLEN, sclkch ); - - printf ( "ET = %25.17e\n" - "GLL SCLK = %s\n", - et, - sclkch ); - - return ( 0 ); - - } - - - The output will be - - ET = -3.22452420559364080e+08 - GLL SCLK = 1/00010001:44:2:0 - - - - 3) Convert the UTC time - - August 25 1989 4:00:00 - - to a Voyager 2 SCLK value. - - To perform this conversion, we could use the program below. - - #include - #include "SpiceUsr.h" - - int main() - { - /. - The spacecraft ID code for the Voyager 2 spacecraft - is -32. This is the code for the Voyager 2 spacecraft - clock as well. - ./ - #define VGR2 -32 - #define SCLKLEN 30 - - SpiceChar sclkch[SCLKLEN]; - SpiceDouble et; - - /. - Load SCLK and leapseconds kernels. - ./ - furnsh_c ( "vgr2sclk.ker" ); - furnsh_c ( "leapseconds.ker" ); - - /. - Find the Voyager 2 SCLK string corresponding to the - specified UTC time. - ./ - str2et_c ( "Aug 25 1989 4:00:00", &et ); - sce2s_c ( VGR2, et, SCLKLEN, sclkch ); - - printf ( "ET = %25.17e\n" - "VGR2 SCLK = %s\n", - et, - sclkch ); - - return ( 0 ); - } - - - The output will be - - ET = -3.26707143817267537e+08 - VGR2 SCLK = 4/11390:22:012 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.1, 29-JUL-2003 (NJB) (CHA) - - Various header changes were made to improve clarity and - more fully explain the routine's functionality. - - -CSPICE Version 1.1.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Updated the Exceptions header section. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.2.0, 10-APR-1992 (NJB) (WLT) - --Index_Entries - - ephemeris time to spacecraft_clock string - --& -*/ - -{ /* Begin sce2s_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "sce2s_c"); - - - /* - Make sure the output sclkch has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "sce2s_c", sclkch, lenout ); - - - /* - Do the conversion. - */ - sce2s_ ( ( integer * ) &sc, - ( doublereal * ) &et, - ( char * ) sclkch, - ( ftnlen ) lenout-1 ); - - /* - Convert sclkch to a null-terminated C string. - */ - F2C_ConvertStr ( lenout, sclkch ); - - - chkout_c ( "sce2s_c"); - -} /* End sce2s_c */ diff --git a/ext/spice/src/cspice/sce2t.c b/ext/spice/src/cspice/sce2t.c deleted file mode 100644 index df7a0c5e22..0000000000 --- a/ext/spice/src/cspice/sce2t.c +++ /dev/null @@ -1,324 +0,0 @@ -/* sce2t.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCE2T ( ET to discrete SCLK ticks ) */ -/* Subroutine */ int sce2t_(integer *sc, doublereal *et, doublereal *sclkdp) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scet01_(integer *, - doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer - *, ftnlen); - extern integer sctype_(integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert ephemeris seconds past J2000 (ET) to integral */ -/* encoded spacecraft clock (`ticks'). For conversion to */ -/* fractional ticks, (required for C-kernel production), see */ -/* the routine SCE2C. */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* ET I Ephemeris time, seconds past J2000. */ -/* SCLKDP O SCLK, encoded as ticks since spacecraft clock */ -/* start. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF integer code for a spacecraft whose */ -/* encoded SCLK value at the epoch specified by ET is */ -/* desired. */ - -/* ET is an epoch, specified as ephemeris seconds past */ -/* J2000. */ - -/* $ Detailed_Output */ - -/* SCLKDP is an encoded integral spacecraft clock value. */ -/* SCLKDP is an encoded representation of the total */ -/* count of spacecraft clock ticks measured from the */ -/* time the spacecraft clock started to the epoch ET: */ -/* partition information IS reflected in the encoded */ -/* value. SCLKDP is rounded to the nearest integral */ -/* double precision number. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument SCLKDP will not */ -/* be modified. */ - -/* 2) When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument SCLKDP will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - - -/* 3) If the clock type for the spacecraft clock identified by */ -/* SC is not supported by this routine, the error */ -/* SPICE(NOTSUPPORTED) is signaled. The output argument SCLKDP */ -/* will not be modified. */ - -/* 4) If the input ET value is not representable as an encoded */ -/* spacecraft clock value for the spacecraft clock identified by */ -/* SC, the error will be diagnosed by routines called by this */ -/* routine. The output argument SCLKDP will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine outputs discrete, encoded SCLK values. Since */ -/* continuous SCLK values are generally more useful, the newer */ -/* routine SCE2C (ET to continuous ticks) should normally be used */ -/* in place of this one. However, the functionality of this */ -/* routine is needed for converting ET to SCLK strings, and the */ -/* routine SCE2S calls this routine for that purpose. */ - -/* The advantage of encoded SCLK, as opposed to character string */ -/* representations of SCLK, is that encoded SCLK values are easy to */ -/* perform arithmetic operations on. Also, working with encoded SCLK */ -/* reduces the overhead of repeated conversion of character strings */ -/* to integers or double precision numbers. */ - -/* To convert ET to a string representation of an SCLK value, use */ -/* the SPICELIB routine SCE2S. */ - -/* See the SCLK Required Reading for a list of the entire set of */ -/* SCLK conversion routines. */ - -/* $ Examples */ - -/* 1) Convert ET directly to an encoded SCLK value; use both of */ -/* these time values to look up both C-kernel (pointing) and */ -/* SPK (position and velocity) data for an epoch specified by an */ -/* ephemeris time. */ - -/* During program initialization, load the leapseconds and */ -/* SCLK kernels. We will pretend that these files are named */ -/* "LEAPSECONDS.KER" and "GLLSCLK.KER". To use this code */ -/* fragment, you must substitute the actual names of these */ -/* kernel files for the names used here. */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'GLLSCLK.KER' ) */ - -/* The mission is Galileo, which has spacecraft ID -77. */ -/* Let ET be the epoch, specified in ephemeris seconds */ -/* past J2000, at which both position and pointing data */ -/* is desired. */ - -/* Find the encoded SCLK value corresponding to ET. */ - -/* CALL SCE2T ( -77, ET, SCLKDP ) */ - -/* Now you're ready to call both CKGP, which expects the input */ -/* epoch to be specified by an encoded SCLK string, and */ -/* SPKEZ, which expects the epoch to be specified as an */ -/* ephemeris time. */ - -/* C */ -/* C Find scan platform pointing CMAT and s/c--target */ -/* C vector (first 3 components of STATE) at epoch. */ -/* C We assume that CK and SPK kernels have been loaded */ -/* C already, via CKLPF and SPKLEF respectively. */ -/* C */ -/* CALL CKGP ( SCANPL, */ -/* . SCLKDP, */ -/* . TOL, */ -/* . REFSYS, */ -/* . CMAT, */ -/* . CLKOUT, */ -/* . FOUND ) */ - -/* CALL SPKEZ ( TARGET, */ -/* . ET, */ -/* . REFSYS, */ -/* . CORR, */ -/* . -77, */ -/* . STATE, */ -/* . LT ) */ - - -/* 2) Convert UTC to an encoded Voyager 2 SCLK value. */ - -/* Again, your initialization code must load the leapseconds */ -/* and SCLK kernels. */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'VGR2SCLK.KER' ) */ - - -/* To find the encoded Voyager 2 SCLK value SCLKDP */ -/* corresponding to a UTC time, you can use the code fragment */ - -/* CALL UTC2ET ( UTC, ET ) */ -/* CALL SCE2T ( -32, ET, SCLKDP ) */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* [1] CK Required Reading */ - -/* [2] SPK Required Reading */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 27-JAN-2004 (NJB) */ - -/* Header was updated to remove comments indicating this routine */ -/* was deprecated. Minor changes were made to clarify both the */ -/* functionality of this routine and the difference between */ -/* this routine and SCE2C. Examples were updated to use FURNSH. */ - -/* - SPICELIB Version 1.0.3, 09-MAR-1999 (NJB) */ - -/* Updated to reflect the introduction of continuous ticks and */ -/* the routine SCE2C. */ - -/* - SPICELIB Version 1.0.2, 10-APR-1992 (NJB) (WLT) */ - -/* Header was updated to reflect possibility of needing to load */ -/* a leapseconds kernel before calling this routine. Comment */ -/* section for permuted index source lines was added following the */ -/* header. */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Restrictions section no longer states that you must load the */ -/* leapseconds kernel prior to calling this routine. */ - -/* The examples have been slightly re-written. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* ephemeris time to spacecraft_clock ticks */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Restrictions section no longer states that you must load the */ -/* leapseconds kernel prior to calling this routine. */ - -/* The examples have been slightly re-written. In particular, */ -/* they no longer use calls to CLPOOL. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCE2T", (ftnlen)5); - } - -/* Just hand off the conversion to the appropriate routine. */ - - if (sctype_(sc) == 1) { - scet01_(sc, et, sclkdp); - } else { - setmsg_("Clock type # is not supported.", (ftnlen)30); - i__1 = sctype_(sc); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SCE2T", (ftnlen)5); - return 0; - } - chkout_("SCE2T", (ftnlen)5); - return 0; -} /* sce2t_ */ - diff --git a/ext/spice/src/cspice/sce2t_c.c b/ext/spice/src/cspice/sce2t_c.c deleted file mode 100644 index 52790da819..0000000000 --- a/ext/spice/src/cspice/sce2t_c.c +++ /dev/null @@ -1,285 +0,0 @@ -/* - --Procedure sce2t_c ( ET to SCLK ticks ) - --Abstract - - Convert ephemeris seconds past J2000 (ET) to integral - encoded spacecraft clock (`ticks'). For conversion to - fractional ticks, (required for C-kernel production), see - the routine sce2c_c.. - --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 - - SCLK - TIME - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void sce2t_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft ID code. - et I Ephemeris time, seconds past J2000. - sclkdp O SCLK, encoded as ticks since spacecraft clock - start. - --Detailed_Input - - sc is a NAIF integer code for a spacecraft whose encoded - SCLK value at the epoch specified by `et' is desired. - - et is an epoch, specified as ephemeris seconds past - J2000. - --Detailed_Output - - sclkdp is an encoded integral spacecraft clock value. - `sclkdp' is an encoded representation of the total - count of spacecraft clock ticks measured from the - time the spacecraft clock started to the epoch `et': - partition information IS reflected in the encoded - value. `sclkdp' is rounded to the nearest integral - double precision number. - --Parameters - - None. - --Exceptions - - 1) This function assumes that that an SCLK kernel appropriate - to the spacecraft clock identified by the input argument sc - has been loaded. If an SCLK kernel has not been loaded, - does not contain all of the required data, or contains - invalid data, error diagnoses will be performed by functions - called by this function. The output argument sclkdp will not - be modified. - - 2) When using SCLK kernels that map SCLK to a time system other - than ET (also called barycentric dynamical time---`TDB'), it - is necessary to have a leapseconds kernel loaded at the time - this function is called. If a leapseconds kernel is required - for conversion between SCLK and ET but is not loaded, the - error will be diagnosed by functions called by this function. - The output argument sclkdp will not be modified. - - The time system that an SCLK kernel maps SCLK to is indicated - by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn - is the negative of the NAIF integer code for the spacecraft. - The time system used in a kernel is TDB if and only if the - variable is assigned the value 1. - - - 3) If the clock type for the spacecraft clock identified by - `sc' is not supported by this function, the error - SPICE(NOTSUPPORTED) is signaled. The output argument `sclkdp' - will not be modified. - - 4) If the input ET value is not representable as an encoded - spacecraft clock value for the spacecraft clock identified by - `sc', the error will be diagnosed by functions called by this - function. The output argument sclkdp will not be modified. - --Files - - None. - --Particulars - - This function outputs discrete, encoded SCLK values. Since - continuous SCLK values are generally more useful, the newer - function sce2c_c (ET to continuous ticks) should normally be used - in place of this one. However, the functionality of this - routine is needed for converting ET to SCLK strings. - - This function outputs encoded SCLK values. The advantage of - encoded SCLK, as opposed to character string representations of - SCLK, is that encoded SCLK values are easy to perform arithmetic - operations on. Also, working with encoded SCLK reduces the - overhead of repeated conversion of character strings to integers - or double precision numbers. - - To convert ET to a string representation of an SCLK value, use - the CSPICE function sce2s_c. - --Examples - - 1) Convert ET directly to an encoded SCLK value. Use both of - these time values to look up both C-kernel (pointing) and - SPK (position and velocity) data for an epoch specified by an - ephemeris time. - - During program initialization, load the leapseconds and - SCLK kernels. We will pretend that these files are named - "leapseconds.ker" and "gllsclk.ker". To use this code - fragment, you must substitute the actual names of these - kernel files for the names used here. - - /. - Load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ) - furnsh_c ( "gllsclk.ker" ) - - The mission is Galileo, which has spacecraft ID -77. - Let ET be the epoch, specified in ephemeris seconds - past J2000, at which both position and pointing data - is desired. - - Find the encoded SCLK value corresponding to ET. - - sce2t_c ( -77, et, &sclkdp ); - - Now you're ready to call both ckgp_c, which expects the input - epoch to be specified by an encoded SCLK string, and - spkez_c, which expects the epoch to be specified as an - ephemeris time. - - /. - Find scan platform pointing cmat and s/c--target - vector (first 3 components of state) at epoch. - We assume that CK and SPK kernels have been loaded - already, via cklpf_c and spklef_c respectively. - ./ - ckgp_c ( scanpl, sclkdp, tol, refsys, - cmat, &clkout, &found ); - - spkez_c ( target, et, refsys, corr, - -77, state, < ); - - - 2) Convert UTC to an encoded Voyager 2 SCLK value. - - Again, your initialization code must load the leapseconds - and SCLK kernels. - - /. - Load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ); - furnsh_c ( "vgr2sclk.ker" ); - - /. - Find the encoded Voyager 2 SCLK value sclkdp - corresponding to the given UTC time. - ./ - utc2et ( utc, &et ); - sce2t_c ( -32, et, &sclkdp ); - --Restrictions - - 1) An SCLK kernel appropriate to the spacecraft clock identified - by SC must be loaded at the time this function is called. - - 2) If the SCLK kernel used with this function does not map SCLK - directly to barycentric dynamical time, a leapseconds kernel - must be loaded at the time this function is called. - --Literature_References - - [1] CK Required Reading - - [2] SPK Required Reading - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.2, 27-JAN-2004 (NJB) - - Header was updated to remove comments indicating this routine - was deprecated. Minor changes were made to clarify both the - functionality of this routine and the difference between - this routine and sce2c_c. Examples were updated to use furnsh_c. - - -CSPICE Version 1.0.1, 09-MAR-1999 (NJB) - - Updated to reflect the introduction of continuous ticks and - the function sce2c_c. - - Occurrences of "routine" were changed to "function" in the header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.2, 10-APR-1992 (NJB) (WLT) - --Index_Entries - - ephemeris time to spacecraft_clock ticks - --& -*/ - -{ /* Begin sce2t_c */ - - /* - Local variables - */ - SpiceDouble loc_sclkdp; - - - /* - Participate in error handling. - */ - chkin_c ( "sce2t_c"); - - /* - Do the conversion. - */ - sce2t_ ( ( integer * ) &sc, - ( doublereal * ) &et, - ( doublereal * ) &loc_sclkdp ); - - /* - Assign the output argument. - */ - *sclkdp = loc_sclkdp; - - - chkout_c ( "sce2t_c"); - - -} /* End sce2t_c */ diff --git a/ext/spice/src/cspice/scencd.c b/ext/spice/src/cspice/scencd.c deleted file mode 100644 index 642992472c..0000000000 --- a/ext/spice/src/cspice/scencd.c +++ /dev/null @@ -1,699 +0,0 @@ -/* scencd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__9999 = 9999; - -/* $Procedure SCENCD ( Encode spacecraft clock ) */ -/* Subroutine */ int scencd_(integer *sc, char *sclkch, doublereal *sclkdp, - ftnlen sclkch_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - doublereal d__1; - - /* Builtin functions */ - double d_nint(doublereal *); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - integer part, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal ticks; - integer pnter; - char error[25]; - doublereal pstop[9999]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), scpart_(integer *, - integer *, doublereal *, doublereal *), chkout_(char *, ftnlen), - nparsi_(char *, integer *, char *, integer *, ftnlen, ftnlen), - sctiks_(integer *, char *, doublereal *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - integer nparts; - doublereal pstart[9999]; - extern logical return_(void); - doublereal ptotls[9999]; - integer pos; - -/* $ Abstract */ - -/* Encode character representation of spacecraft clock time into a */ -/* double precision number. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* SCLKCH I Character representation of a spacecraft clock. */ -/* SCLKDP O Encoded representation of the clock count. */ -/* MXPART P Maximum number of spacecraft clock partitions. */ - -/* $ Detailed_Input */ - -/* SC is the standard NAIF ID of the spacecraft whose clock's */ -/* time is being encoded. */ - -/* SCLKCH is the character representation of some spacecraft's */ -/* clock count. */ - -/* SCLKCH will have the following general format: */ - -/* 'pp/sclk_string', or just */ -/* 'sclk_string' */ - -/* 'pp' is an integer greater than or equal to one */ -/* and is called the partition number. */ - -/* Each mission is divided into some number of partitions. */ -/* A new partition starts when the spacecraft clock */ -/* resets, either to zero, or to some other */ -/* value. Thus, the first partition for any mission */ -/* starts with launch, and ends with the first clock */ -/* reset. The second partition starts immediately when */ -/* the first stopped, and so on. */ - -/* In order to be completely unambiguous about a */ -/* particular time, you need to specify a partition number */ -/* along with the standard clock string. */ - -/* Information about when partitions occur for different */ -/* missions is contained in a spacecraft clock kernel */ -/* file, which needs to be loaded into the kernel pool, */ -/* using the routines CLPOOL and FURNSH. */ - -/* The routine SCPART is used to read the partition */ -/* start and stop times, in encoded units of SCLK (called */ -/* "ticks" -- see SCLKDP below) from the kernel file. */ - -/* If the partition number is included, it must be */ -/* separated from the rest of the string by a '/'. */ -/* Any number of spaces may separate the partition number, */ -/* the '/', and the rest of the clock string. */ - - -/* If the partition number is omitted, a default partition */ -/* will be assumed. The default partition is the lowest- */ -/* numbered partition that contains the given clock time. */ -/* If the clock time does not fall in any of the */ -/* partition boundaries then an error is signaled. */ - - -/* 'sclk_string' is a spacecraft specific clock string. */ -/* Using Galileo as an example, the full format is */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */ -/* Count (RIM), which increments once every time xx turns */ -/* over, i.e., once every 60 2/3 seconds. The roll-over */ -/* expression for the RIM is 16777215, which corresponds */ -/* to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft clock. */ -/* SCLK components may be separated by any of these */ -/* five characters: ' ' ':' ',' '-' '.' */ -/* Any number of spaces can separate the components and */ -/* the delimiters. The presence of the RIM component */ -/* is required. Successive components may be omitted, and */ -/* in such cases are assumed to represent zero values. */ - -/* Values for the individual components may exceed the */ -/* maximum expected values. For instance, '0:0:0:9' is */ -/* an acceptable Galileo clock string, and will convert */ -/* to the same number of ticks as '0:0:1:1'. */ - -/* Consecutive delimiters containing no intervening digits */ -/* are treated as if they delimit zero components. */ - -/* Trailing zeros should always be included to match the */ -/* length of the counter. For example, a Galileo clock */ -/* count of '25684.90' should not be represented as */ -/* '25684.9'. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Voyager and Mars Observer clock */ -/* formats. */ - - -/* $ Detailed_Output */ - -/* SCLKDP is the double precision encoding of SCLKCH. */ - -/* The encoding is such that order and proximity will be */ -/* preserved. That is, if t1, t2, and t3 are spacecraft */ -/* clock times, and t1*, t2*, and t3* are their encodings, */ -/* then if */ - -/* t1 < t2 < t3, and */ - -/* t2 is closer to t1 than to t3, you will have the result */ -/* that */ - -/* t1* < t2* < t3*, and */ - -/* t2* is closer to t1* than to t3*. */ - -/* The units of encoded SCLK are "ticks since the start of */ -/* the mission", where a "tick" is defined to be the */ -/* shortest time increment expressible by a particular */ -/* spacecraft's clock. */ - -/* Each clock string without partition number represents */ -/* a certain number of ticks, but you need to include */ -/* partition information to determine the relative */ -/* position of that time in relation to the start of the */ -/* mission. */ - -/* Since the end time of one partition is coincident */ -/* with the begin time of the next, there are two */ -/* different representations for this instant, and they */ -/* will both yield the same encoding. */ - -/* For example, if partition 1 has an end time of t1, and */ -/* partition 2 has a begin time of t2, then if we did */ - -/* CALL SCENCD ( '1/t1', SC, X ) and */ -/* CALL SCENCD ( '2/t2', SC, Y ), then */ - -/* X = Y. */ - -/* The individual routines TIKSnn, where nn is the */ -/* clock type code, contain more detailed information */ -/* on the conversion process. */ - -/* $ Parameters */ - -/* MXPART is the maximum number of spacecraft clock partitions */ -/* expected in the kernel file for any one spacecraft. */ -/* See the INCLUDE file sclk.inc for this parameter's */ -/* value. */ - -/* $ Exceptions */ - -/* 1) If the number of partitions in the kernel file for spacecraft */ -/* SC excceds the parameter MXPART, the error */ -/* 'SPICE(TOOMANYPARTS)' is signaled. */ - - -/* If a partition number is included in the SCLK string, the */ -/* following exceptions may occur: */ - -/* 2) If the partition number cannot be parsed as an integer, the */ -/* error 'SPICE(BADPARTNUMBER)' is signaled. */ - -/* 3) If the partition number is not in the range of the number of */ -/* partitions found in the kernel pool, the error */ -/* 'SPICE(BADPARTNUMBER)' is signaled. */ - -/* 4) If the clock count does not fall in the boundaries of the */ -/* specified partition, the error 'SPICE(NOTINPART)' is */ -/* signaled. */ - - -/* If a partition number is not included in the SCLK string, the */ -/* following exception may occur. */ - -/* 5) If the clock count does not fall in the boundaries of any */ -/* partition found in the kernel pool, the error */ -/* 'SPICE(NOPARTITION)' is signaled. */ - -/* The following error is signaled by a routine called by SCENCD */ - -/* 6) If any of the extracted clock components cannot be parsed as */ -/* integers, or the string has too many components, or the value */ -/* of one of the components is less than the offset value, then */ -/* the error SPICE(INVALIDSCLKSTRING) is signaled. */ - -/* $ Files */ - -/* A kernel file containing spacecraft clock partition information */ -/* for the desired spaceraft must be loaded, using the routines */ -/* CLPOOL and FURNSH, before calling this routine. */ - -/* $ Particulars */ - -/* In general, it is difficult to compare spacecraft clock counts */ -/* numerically since there are too many clock components for a */ -/* single comparison. This routine provides a method of assigning a */ -/* single double precision number to a spacecraft's clock count, */ -/* given one of its character representations. */ - -/* The routine SCDECD performs the inverse operation to SCENCD, */ -/* converting an encoded double precision number to character format. */ - -/* To convert the string to ticks since the start of the mission, */ -/* SCENCD */ - -/* 1) Converts the non-partition portion of the string to */ -/* ticks, using the routine SCTIKS. */ - -/* 2) Determines the partition number for the clock time, */ -/* either by getting it directly from the input string, or */ -/* determining the default partition if none was specified. */ - -/* 3) Includes partition start and stop times, which are also */ -/* measured in ticks, to compute the number of ticks */ -/* since the beginning of the mission of the clock time. */ - -/* $ Examples */ - -/* Double precision encodings of spacecraft clock counts are used to */ -/* tag pointing data in the C-kernel. */ - -/* In the following example, pointing for a sequence of images from */ -/* the Voyager 2 narrow angle camera is requested from the C-kernel */ -/* using an array of character spacecraft clock counts as input. */ -/* The clock counts attached to the output are then decoded to */ -/* character and compared with the input strings. */ - -/* CHARACTER*(25) SCLKIN ( 4 ) */ -/* CHARACTER*(25) SCLKOUT */ -/* CHARACTER*(25) CLKTOL */ - -/* DOUBLE PRECISION TIMEIN */ -/* DOUBLE PRECISION TIMOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ - -/* INTEGER NPICS */ -/* INTEGER SC */ - -/* DATA NPICS / 4 / */ - -/* DATA SCLKIN / '2 / 20538:39:768', */ -/* . '2 / 20543:21:768', */ -/* . '2 / 20550:37', */ -/* . '2 / 20561:59' / */ - -/* DATA CLKTOL / ' 0:01:000' / */ - -/* C */ -/* C The instrument we want pointing for is the Voyager 2 */ -/* C narrow angle camera. The reference frame we want is */ -/* C J2000. The spacecraft is Voyager 2. */ -/* C */ -/* INST = -32001 */ -/* REF = 'J2000' */ -/* SC = -32 */ - -/* C */ -/* C Load the appropriate files. We need */ -/* C */ -/* C 1) CK file containing pointing data. */ -/* C 2) Spacecraft clock kernel file, for SCENCD and SCDECD. */ -/* C */ -/* CALL CKLPF ( 'VGR2NA.CK' ) */ -/* CALL CLPOOL */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* C */ -/* C Convert the tolerance string to ticks. */ -/* C */ -/* CALL SCTIKS ( SC, CLKTOL, TOL ) */ - -/* DO I = 1, NPICS */ - -/* CALL SCENCD ( SC, SCLKIN( I ), TIMEIN ) */ - -/* CALL CKGP ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT, */ -/* . FOUND ) */ - -/* CALL SCDECD ( SC, TIMOUT, SCLKOUT ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Input s/c clock count: ', SCLKIN( I ) */ -/* WRITE (*,*) 'Output s/c clock count: ', SCLKOUT */ -/* WRITE (*,*) 'Output C-Matrix: ', CMAT */ -/* WRITE (*,*) */ - -/* END DO */ - -/* The output from such a program might look like: */ - - -/* Input s/c clock count: 2 / 20538:39:768 */ -/* Output s/c clock count: 2/20538:39:768 */ -/* Output C-Matrix: 'first C-matrix' */ - -/* Input s/c clock count: 2 / 20543:21:768 */ -/* Output s/c clock count: 2/20543:22:768 */ -/* Output C-Matrix: 'second C-matrix' */ - -/* Input s/c clock count: 2 / 20550:37 */ -/* Output s/c clock count: 2/20550:36:768 */ -/* Output C-Matrix: 'third C-matrix' */ - -/* Input s/c clock count: 2 / 20561:59 */ -/* Output s/c clock count: 2/20561:58:768 */ -/* Output C-Matrix: 'fourth C-matrix' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 05-FEB-2008 (NJB) */ - -/* The values of the parameter MXPART is now */ -/* provided by the INCLUDE file sclk.inc. */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - 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, 03-SEP-1990 (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* encode spacecraft_clock */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCENCD", (ftnlen)6); - } - -/* Convert the non-partition portion of the clock string to ticks. */ - - pos = cpos_(sclkch, "/", &c__1, sclkch_len, (ftnlen)1); - i__1 = pos; - sctiks_(sc, sclkch + i__1, &ticks, sclkch_len - i__1); - ticks = d_nint(&ticks); - -/* Read the partition start and stop times (in ticks) for this */ -/* mission. Error if there are too many of them. */ - - scpart_(sc, &nparts, pstart, pstop); - if (nparts > 9999) { - setmsg_("The number of partitions, #, for spacecraft # exceeds the v" - "alue for parameter MXPART, #.", (ftnlen)88); - errint_("#", &nparts, (ftnlen)1); - errint_("#", sc, (ftnlen)1); - errint_("#", &c__9999, (ftnlen)1); - sigerr_("SPICE(TOOMANYPARTS)", (ftnlen)19); - chkout_("SCENCD", (ftnlen)6); - return 0; - } - -/* PSTART and PSTOP represent integers but are read from the */ -/* kernel pool as double precision numbers. Make them whole */ -/* numbers so that logical tests may be performed with them. */ - - i__1 = nparts; - for (i__ = 1; i__ <= i__1; ++i__) { - pstop[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("pstop", - i__2, "scencd_", (ftnlen)483)] = d_nint(&pstop[(i__3 = i__ - - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("pstop", i__3, "scenc" - "d_", (ftnlen)483)]); - pstart[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("pstart", - i__2, "scencd_", (ftnlen)484)] = d_nint(&pstart[(i__3 = i__ - - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("pstart", i__3, "scen" - "cd_", (ftnlen)484)]); - } -/* For each partition, compute the total number of ticks in that */ -/* partition plus all preceding partitions. */ - - d__1 = pstop[0] - pstart[0]; - ptotls[0] = d_nint(&d__1); - i__1 = nparts; - for (i__ = 2; i__ <= i__1; ++i__) { - d__1 = ptotls[(i__3 = i__ - 2) < 9999 && 0 <= i__3 ? i__3 : s_rnge( - "ptotls", i__3, "scencd_", (ftnlen)495)] + pstop[(i__4 = i__ - - 1) < 9999 && 0 <= i__4 ? i__4 : s_rnge("pstop", i__4, "sce" - "ncd_", (ftnlen)495)] - pstart[(i__5 = i__ - 1) < 9999 && 0 <= - i__5 ? i__5 : s_rnge("pstart", i__5, "scencd_", (ftnlen)495)]; - ptotls[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", - i__2, "scencd_", (ftnlen)495)] = d_nint(&d__1); - } - -/* Determine the partition number for the input clock string: */ - -/* If it was included in the string make sure it's valid for */ -/* this mission. */ - -/* Error if */ - -/* 1) The partition number can't be parsed. */ -/* 2) The partition number is not in the range 1 to the number */ -/* of partitions. */ -/* 3) The clock count does not fall in the boundaries of the */ -/* specified partition. */ - -/* If it wasn't included, determine the default partition for */ -/* this clock count. */ - -/* Error if */ - -/* 1) The clock count does not fall in the boundaries of any */ -/* of the partitions. */ - - - if (pos == 1) { - setmsg_("Unable to parse the partition number from SCLK string #.", ( - ftnlen)56); - errch_("#", sclkch, (ftnlen)1, sclkch_len); - sigerr_("SPICE(BADPARTNUMBER)", (ftnlen)20); - chkout_("SCENCD", (ftnlen)6); - return 0; - } - if (pos > 1) { - part = 0; - nparsi_(sclkch, &part, error, &pnter, pos - 1, (ftnlen)25); - if (s_cmp(error, " ", (ftnlen)25, (ftnlen)1) != 0) { - setmsg_("Unable to parse the partition number from SCLK string #." - , (ftnlen)56); - errch_("#", sclkch, (ftnlen)1, sclkch_len); - sigerr_("SPICE(BADPARTNUMBER)", (ftnlen)20); - chkout_("SCENCD", (ftnlen)6); - return 0; - } else if (part <= 0 || part > nparts) { - setmsg_("Partition number # taken from SCLK string # is not in a" - "cceptable range 1 to #.", (ftnlen)78); - errint_("#", &part, (ftnlen)1); - errch_("#", sclkch, (ftnlen)1, sclkch_len); - errint_("#", &nparts, (ftnlen)1); - sigerr_("SPICE(BADPARTNUMBER)", (ftnlen)20); - chkout_("SCENCD", (ftnlen)6); - return 0; - } else if (ticks < pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? - i__1 : s_rnge("pstart", i__1, "scencd_", (ftnlen)558)] || - ticks > pstop[(i__2 = part - 1) < 9999 && 0 <= i__2 ? i__2 : - s_rnge("pstop", i__2, "scencd_", (ftnlen)558)]) { - setmsg_("SCLK count # does not fall in the boundaries of partiti" - "on number #.", (ftnlen)67); - errch_("#", sclkch, (ftnlen)1, sclkch_len); - errint_("#", &part, (ftnlen)1); - sigerr_("SPICE(NOTINPART)", (ftnlen)16); - chkout_("SCENCD", (ftnlen)6); - return 0; - } - } else { - part = 1; - while(part <= nparts && (ticks < pstart[(i__1 = part - 1) < 9999 && 0 - <= i__1 ? i__1 : s_rnge("pstart", i__1, "scencd_", (ftnlen) - 575)] || ticks > pstop[(i__2 = part - 1) < 9999 && 0 <= i__2 ? - i__2 : s_rnge("pstop", i__2, "scencd_", (ftnlen)575)])) { - ++part; - } - if (part > nparts) { - setmsg_("SCLK count # does not fall in the boundaries of any of " - "the partitions for spacecraft #.", (ftnlen)87); - errch_("#", sclkch, (ftnlen)1, sclkch_len); - errint_("#", sc, (ftnlen)1); - sigerr_("SPICE(NOPARTITION)", (ftnlen)18); - chkout_("SCENCD", (ftnlen)6); - return 0; - } - } - -/* Now we have a valid partition number, and the number of ticks for */ -/* the clock string. To convert to ticks since the start of the */ -/* mission, add in the total number of ticks in preceding partitions */ -/* and subtract off the starting ticks value for this partition. */ - - if (part > 1) { - *sclkdp = ticks - pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 - : s_rnge("pstart", i__1, "scencd_", (ftnlen)605)] + ptotls[( - i__2 = part - 2) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", - i__2, "scencd_", (ftnlen)605)]; - } else { - *sclkdp = ticks - pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 - : s_rnge("pstart", i__1, "scencd_", (ftnlen)607)]; - } - chkout_("SCENCD", (ftnlen)6); - return 0; -} /* scencd_ */ - diff --git a/ext/spice/src/cspice/scencd_c.c b/ext/spice/src/cspice/scencd_c.c deleted file mode 100644 index e2d5345af7..0000000000 --- a/ext/spice/src/cspice/scencd_c.c +++ /dev/null @@ -1,473 +0,0 @@ -/* - --Procedure scencd_c ( Encode spacecraft clock ) - --Abstract - - Encode character representation of spacecraft clock time into a - double precision number. - --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 - - SCLK - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void scencd_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * sclkdp ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft identification code. - sclkch I Character representation of a spacecraft clock. - sclkdp O Encoded representation of the clock count. - MXPART P Maximum number of spacecraft clock partitions. - --Detailed_Input - - sc is the standard NAIF ID of the spacecraft whose clock's - time is being encoded. - - sclkch is the character representation of some spacecraft's - clock count. - - sclkch will have the following general format: - - "pp/sclk_string", or just - "sclk_string" - - "pp" is an integer greater than or equal to one - and is called the partition number. - - Each mission is divided into some number of partitions. - A new partition starts when the spacecraft clock - resets, either to zero, or to some other - value. Thus, the first partition for any mission - starts with launch, and ends with the first clock - reset. The second partition starts immediately when - the first stopped, and so on. - - In order to be completely unambiguous about a - particular time, you need to specify a partition number - along with the standard clock string. - - Information about when partitions occur for different - missions is contained in a spacecraft clock kernel - file, which needs to be loaded into the kernel pool, - using the routine furnsh_c. - - The routine scpart_c is used to read the partition - start and stop times, in encoded units of SCLK (called - "ticks" -- see sclkdp below) from the kernel file. - - If the partition number is included, it must be - separated from the rest of the string by a "/". - Any number of spaces may separate the partition number, - the "/", and the rest of the clock string. - - - If the partition number is omitted, a default partition - will be assumed. The default partition is the lowest- - numbered partition that contains the given clock time. - If the clock time does not fall in any of the - partition boundaries then an error is signalled. - - - "sclk_string" is a spacecraft specific clock string. - Using Galileo as an example, the full format is - - wwwwwwww:xx:y:z - - where z is a mod-8 counter (values 0-7) which - increments approximately once every 8 1/3 ms., y is a - mod-10 counter (values 0-9) which increments once - every time z turns over, i.e., approximately once every - 66 2/3 ms., xx is a mod-91 (values 0-90) counter - which increments once every time y turns over, i.e., - once every 2/3 seconds. wwwwwwww is the Real-Time Image - Count (RIM), which increments once every time xx turns - over, i.e., once every 60 2/3 seconds. The roll-over - expression for the RIM is 16777215, which corresponds - to approximately 32 years. - - wwwwwwww, xx, y, and z are referred to interchangeably - as the fields or components of the spacecraft clock. - SCLK components may be separated by any of these - five characters: " " ":" "," "-" "." - Any number of spaces can separate the components and - the delimiters. The presence of the RIM component - is required. Successive components may be omitted, and - in such cases are assumed to represent zero values. - - Values for the individual components may exceed the - maximum expected values. For instance, "0:0:0:9" is - an acceptable Galileo clock string, and will convert - to the same number of ticks as "0:0:1:1". - - Consecutive delimiters containing no intervening digits - are treated as if they delimit zero components. - - Trailing zeros should always be included to match the - length of the counter. For example, a Galileo clock - count of "25684.90" should not be represented as - "25684.9". - - Some spacecraft clock components have offset, or - starting, values different from zero. For example, - with an offset value of 1, a mod 20 counter would - cycle from 1 to 20 instead of from 0 to 19. - - See the SCLK required reading for a detailed - description of the Voyager and Mars Observer clock - formats. - - --Detailed_Output - - sclkdp is the double precision encoding of sclkch. - - The encoding is such that order and proximity will be - preserved. That is, if t1, t2, and t3 are spacecraft - clock times, and t1*, t2*, and t3* are their encodings, - then if - - t1 < t2 < t3, and - - t2 is closer to t1 than to t3, you will have the result - that - - t1* < t2* < t3*, and - - t2* is closer to t1* than to t3*. - - The units of encoded SCLK are "ticks since the start of - the mission", where a "tick" is defined to be the - shortest time increment expressible by a particular - spacecraft's clock. - - Each clock string without partition number represents - a certain number of ticks, but you need to include - partition information to determine the relative - position of that time in relation to the start of the - mission. - - Since the end time of one partition is coincident - with the begin time of the next, there are two - different representations for this instant, and they - will both yield the same encoding. - - For example, if partition 1 has an end time of t1, and - partition 2 has a begin time of t2, then if we executed - the code fragment - - scencd_c ( "1/t1", sc, &x ); - scencd_c ( "2/t2", sc, &y ); - - The we would obtain x = y. - - The individual routines tiksNN_c, where NN is the - clock type code, contain more detailed information - on the conversion process. - --Parameters - - MXPART is the maximum number of spacecraft clock partitions - expected in the kernel file for any one spacecraft. - MXPART is currently set to 9999. - --Exceptions - - 1) If the number of partitions in the kernel file for spacecraft - sc exceeds the parameter MXPART, the error - SPICE(TOOMANYPARTS) is signalled. - - - If a partition number is included in the SCLK string, the - following exceptions may occur: - - 2) If the partition number cannot be parsed as an integer, the - error SPICE(BADPARTNUMBER) is signalled. - - 3) If the partition number is not in the range of the number of - partitions found in the kernel pool, the error - SPICE(BADPARTNUMBER) is signalled. - - 4) If the clock count does not fall within the boundaries of the - specified partition, the error SPICE(NOTINPART) is signalled. - - If a partition number is not included in the SCLK string, the - following exception may occur. - - 5) If the clock count does not fall within the boundaries of any - partition found in the kernel pool, the error SPICE(NOPARTITION) - is signalled. - - - The following error is signalled by a routine called by scencd_c. - - 6) If any of the extracted clock components cannot be parsed as - integers, or the string has too many components, or the value - of one of the components is less than the offset value, then - the error SPICE(INVALIDSCLKSTRING) is signalled. - --Files - - A kernel file containing spacecraft clock partition information - for the desired spaceraft must be loaded, using the routine - furnsh_c, before calling this routine. - --Particulars - - In general, it is difficult to compare spacecraft clock counts - numerically since there are too many clock components for a - single comparison. This routine provides a method of assigning a - single double precision number to a spacecraft's clock count, - given one of its character representations. - - The routine scdecd_c performs the inverse operation of scencd_c, - converting an encoded double precision number to character format. - - To convert the string to ticks since the start of the mission, - scencd_c - - 1) Converts the non-partition portion of the string to - ticks, using the routine sctiks_c. - - 2) Determines the partition number for the clock time, - either by getting it directly from the input string, or - determining the default partition if none was specified. - - 3) Includes partition start and stop times, which are also - measured in ticks, to compute the number of ticks - from the beginning of the mission to the clock time. - --Examples - - Double precision encodings of spacecraft clock counts are used to - tag pointing data in the C-kernel. - - In the following example, pointing for a sequence of images from - the Voyager 2 narrow angle camera is requested from the C-kernel - using an array of character spacecraft clock counts as input. - The clock counts attached to the output are then decoded to - character and compared with the input strings. - - #include - #include "SpiceUsr.h" - - void main() - { - /. - The instrument we want pointing for is the Voyager 2 - narrow angle camera. The reference frame we want is - J2000. The spacecraft is Voyager 2. - ./ - - #define SC -32 - #define INST -32001 - #define REF "J2000" - #define CK "/kernels/voyager2/ck/vg2_jup_qmw_na.bc" - #define SCLK "/kernels/voyager2/sclk/vg200004.tsc" - #define NPICS 4 - #define CLKTOL "0:01:001" - #define MAXLEN 30 - - SpiceBoolean found; - - SpiceChar sclkin [4][25] = { {"2 / 20538:39:768"}, - {"2 / 20543:21:768"}, - {"2 / 20550:37" }, - {"2 / 20561:59" } }; - SpiceChar sclkout[25]; - - SpiceDouble tol; - SpiceDouble timein; - SpiceDouble timeout; - SpiceDouble cmat [3][3]; - - SpiceInt handle; - SpiceInt i; - - - /. - Load the appropriate files. We need - - 1) CK file containing pointing data. - 2) Spacecraft clock kernel file, for scencd_c and SCDECD. - ./ - - cklpf_c ( CK, &handle ); - furnsh_c ( SCLK ); - - - /. - Convert the tolerance string to ticks. - ./ - sctiks_c ( SC, CLKTOL, &tol ); - - - for ( i = 0; i < NPICS; i++ ) - { - scencd_c ( SC, sclkin[i], &timein ); - - ckgp_c ( INST, timein, tol, REF, - cmat, &timeout, &found ); - - scdecd_c ( SC, timeout, MAXLEN, sclkout ); - - if ( found ) - { - printf ( "\n" - "Input s/c clock count: %s\n" - "Output s/c clock count: %s\n" - "Output C-Matrix: \n" - "%25.16f %25.16f %25.16f\n" - "%25.16f %25.16f %25.16f\n" - "%25.16f %25.16f %25.16f\n" - "\n", - sclkin[i], - sclkout, - cmat[0][0], cmat[0][1], cmat[0][2], - cmat[1][0], cmat[1][1], cmat[1][2], - cmat[2][0], cmat[2][1], cmat[2][2] ); - } - else - { - printf ( "\n" - "Input s/c clock count: %s\n" - "No pointing found.\n", - sclkin[i] ); - } - } - - } - - - The output from such a program might look like: - - - Input s/c clock count: 2 / 20538:39:768 - Output s/c clock count: 2/20538:39:768 - Output C-Matrix: "first C-matrix" - - Input s/c clock count: 2 / 20543:21:768 - Output s/c clock count: 2/20543:22:768 - Output C-Matrix: "second C-matrix" - - Input s/c clock count: 2 / 20550:37 - Output s/c clock count: 2/20550:36:768 - Output C-Matrix: "third C-matrix" - - Input s/c clock count: 2 / 20561:59 - Output s/c clock count: 2/20561:58:768 - Output C-Matrix: "fourth C-matrix" - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - J.M. Lynch (JPL) - R.E. Thurman (JPL) - --Version - - -CSPICE Version 1.2.0, 11-FEB-2008 (NJB) - - Definition of constant macro MXPART was deleted. - Documentation was updated to reflect current - MXPART value of 9999. - - -CSPICE Version 1.1.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - encode spacecraft_clock - --& -*/ - -{ /* Begin scencd_c */ - - - /* - Participate in error handling - */ - chkin_c ( "scencd_c"); - - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "scencd_c", sclkch ); - - - /* - Carry out the encoding. - */ - scencd_ ( ( integer * ) &sc, - ( char * ) sclkch, - ( doublereal * ) sclkdp, - ( ftnlen ) strlen(sclkch) ); - - - chkout_c ( "scencd_c"); - -} /* End scencd_c */ diff --git a/ext/spice/src/cspice/scfmt.c b/ext/spice/src/cspice/scfmt.c deleted file mode 100644 index 4d53b7a543..0000000000 --- a/ext/spice/src/cspice/scfmt.c +++ /dev/null @@ -1,324 +0,0 @@ -/* scfmt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCFMT ( Convert SCLK "ticks" to character clock format) */ -/* Subroutine */ int scfmt_(integer *sc, doublereal *ticks, char *clkstr, - ftnlen clkstr_len) -{ - integer type__; - extern /* Subroutine */ int scfm01_(integer *, doublereal *, char *, - ftnlen), chkin_(char *, ftnlen), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer - *, ftnlen); - extern integer sctype_(integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert encoded spacecraft clock ticks to character clock format. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* TICKS I Encoded representation of a spacecraft clock count. */ -/* CLKSTR O Character representation of a clock count. */ - -/* $ Detailed_Input */ - -/* SC is the NAIF ID number for the spacecraft whose clock's */ -/* time is being decoded. */ - -/* TICKS is the double precision encoding of a clock time in */ -/* units of ticks. Partition information is not reflected */ -/* in this value. */ - -/* An analogy may be drawn between a spacecraft clock and */ -/* a standard wall clock. The number of ticks */ -/* corresponding to the wall clock string */ - -/* hh:mm:ss */ - -/* would be the number of seconds represented by that */ -/* time. */ - -/* For example, */ - -/* Clock string Number of ticks */ -/* ------------ --------------- */ -/* 00:00:10 10 */ -/* 00:01:00 60 */ -/* 00:10:00 600 */ -/* 01:00:00 3600 */ -/* 01:01:00 3660 */ - -/* If TICKS contains a fractional part the result is the */ -/* same as if TICKS had been rounded to the nearest whole */ -/* number. */ - -/* See the Examples section below for examples of */ -/* actual spacecraft clock conversions. */ - -/* $ Detailed_Output */ - -/* CLKSTR is the spacecraft clock character string */ -/* corresponding to TICKS. Partition information is */ -/* not included in CLKSTR. */ - -/* Using Galileo as an example, the full format clock */ -/* string is */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */ -/* Count (RIM), which increments once every time xx turns */ -/* over, i.e., once every 60 2/3 seconds. The roll-over */ -/* expression for the RIM is 16777215, which corresponds */ -/* to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft clock. */ -/* SCLK components may be separated by any of these five */ -/* characters: ' ' ':' ',' '-' '.' */ -/* The delimiter used is determined by a kernel pool */ -/* variable and can be adjusted by the user. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Voyager and Mars Observer clock */ -/* formats. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the data type for the spacecraft is not supported */ -/* then the error SPICE(NOTSUPPORTED) is signalled. */ - -/* 2) If the value for TICKS is negative, the error is diagnosed */ -/* by routines called by this routine. */ - -/* 3) If the SCLK kernel file does not contain data for the */ -/* spacecraft specified by SC, then the error is diagnosed */ -/* by routines called by this routine. */ - -/* 4) If the declared length of SCLKCH is not large enough to */ -/* contain the output clock string the error */ -/* is diagnosed by a routine called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines which data type the spacecraft clock */ -/* belongs to and then calls FMTnn, where nn corresponds to the */ -/* data type code. FMTnn then handles the actual conversion from */ -/* ticks to clock string format. */ - -/* The routine SCTIKS performs the inverse operation to SCFMT, */ -/* converting from clock format to number of ticks. */ - -/* Note the important difference between SCFMT and SCDECD. SCDECD */ -/* converts some number of ticks since the spacecraft clock start */ -/* time to a character string which includes a partition number. */ -/* SCFMT, which is called by SCDECD, does not make use of partition */ -/* information. */ - -/* $ Examples */ - - -/* The following program fragment finds partition start and stop */ -/* times for the Galileo spacecraft from a spacecraft clock partition */ -/* kernel file, called SCLK.KER. Since those times are always */ -/* returned in units of ticks, the program uses SCFMT to print the */ -/* times in Galileo clock format. */ - - -/* CHARACTER*(30) START */ -/* CHARACTER*(30) STOP */ - -/* SC = -77 */ - -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* CALL SCPART ( SC, NPARTS, PSTART, PSTOP ) */ - -/* DO I = 1, NPARTS */ - -/* CALL SCFMT ( SC, PSTART( I ), START ) */ -/* CALL SCFMT ( SC, PSTOP ( I ), STOP ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Partition ', I, ':' */ -/* WRITE (*,*) 'Start = ', START */ -/* WRITE (*,*) 'Stop = ', STOP */ - -/* END DO */ - - - -/* Below are some examples illustrating various input numbers of */ -/* ticks and the resulting clock string outputs for the Galileo */ -/* spacecraft. */ - -/* TICKS CLKSTR */ -/* ---------------- -------------------- */ -/* -1 Error: Ticks must be a positive number */ -/* 0 '0:00:0:0' */ -/* 1 '0:00:0:1' */ -/* 1.3 '0:00:0:1' */ -/* 1.5 '0:00:0:2' */ -/* 2 '0:00:0:2' */ -/* 7 '0:00:0:7' */ -/* 8 '0:00:1:0' */ -/* 80 '0:01:0:0' */ -/* 88 '0:01:1:0' */ -/* 7279 '0:90:9:7' */ -/* 7280 '1:00:0:0' */ -/* 1234567890 '169583:45:6:2' */ - -/* The following examples are for the Voyager 2 spacecraft. */ -/* Note that the third component of the Voyager clock has an */ -/* offset value of one. */ - -/* TICKS CLKSTR */ -/* ---------------- -------------------- */ -/* -1 Error: Ticks must be a positive number */ -/* 0 '00000 00 001' */ -/* 1 '00000 00 002' */ -/* 1.3 '00000:00:002' */ -/* 1.5 '00000.00.003' */ -/* 2 '00000-00-003' */ -/* 799 '00000,00,800' */ -/* 800 '00000 01 001' */ -/* 47999 '00000 59 800' */ -/* 48000 '00001 00 001' */ -/* 3145727999 '65535 59 800' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.0.1, 17-APR-1992 (JML) (WLT) */ - -/* The exceptions section was updated to state that an error */ -/* is signalled if SCLKCH is not declared big enough to */ -/* contain the output spacecraft clock string. */ - -/* The wording to exception number three was changed. */ - -/* Miscellaneous minor updates to the header were performed. */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.0, 06-SEP-1990 (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert spacecraft_clock ticks to character clock format */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCFMT", (ftnlen)5); - } - -/* If the clock type is supported by NAIF then call FMTnn. */ - - type__ = sctype_(sc); - if (type__ == 1) { - scfm01_(sc, ticks, clkstr, clkstr_len); - } else { - setmsg_("Clock type # is not supported. ", (ftnlen)31); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SCFMT", (ftnlen)5); - return 0; - } - chkout_("SCFMT", (ftnlen)5); - return 0; -} /* scfmt_ */ - diff --git a/ext/spice/src/cspice/scfmt_c.c b/ext/spice/src/cspice/scfmt_c.c deleted file mode 100644 index 9b255c24c5..0000000000 --- a/ext/spice/src/cspice/scfmt_c.c +++ /dev/null @@ -1,359 +0,0 @@ -/* - --Procedure scfmt_c ( Convert SCLK "ticks" to character clock format) - --Abstract - - Convert encoded spacecraft clock ticks to character clock format. - --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 - - SCLK - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void scfmt_c ( SpiceInt sc, - SpiceDouble ticks, - SpiceInt lenout, - SpiceChar * clkstr ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft identification code. - ticks I Encoded representation of a spacecraft clock count. - lenout I Maximum allowed length of output string. - clkstr O Character representation of a clock count. - --Detailed_Input - - sc is the NAIF ID number for the spacecraft whose clock's - time is being decoded. - - ticks is the double precision encoding of a clock time in - units of ticks. Partition information is not reflected - in this value. - - An analogy may be drawn between a spacecraft clock and - a standard wall clock. The number of ticks - corresponding to the wall clock string - - hh:mm:ss - - would be the number of seconds represented by that - time. - - For example, - - Clock string Number of ticks - ------------ --------------- - 00:00:10 10 - 00:01:00 60 - 00:10:00 600 - 01:00:00 3600 - 01:01:00 3660 - - If ticks contains a fractional part the result is the - same as if ticks had been rounded to the nearest whole - number. - - See the Examples section below for examples of - actual spacecraft clock conversions. - - lenout The allowed length of the output string. This length - must large enough to hold the 'clkstr' string plus the - null terminator. If the output string is expected to - have x characters, 'lenout' must be x + 1. - --Detailed_Output - - clkstr is the spacecraft clock character string - corresponding to ticks. Partition information is - not included in clkstr. - - Using Galileo as an example, the full format clock - string is - - wwwwwwww:xx:y:z - - where z is a mod-8 counter (values 0-7) which - increments approximately once every 8 1/3 ms., y is a - mod-10 counter (values 0-9) which increments once - every time z turns over, i.e., approximately once every - 66 2/3 ms., xx is a mod-91 (values 0-90) counter - which increments once every time y turns over, i.e., - once every 2/3 seconds. wwwwwwww is the Real-Time Image - Count (RIM), which increments once every time xx turns - over, i.e., once every 60 2/3 seconds. The roll-over - expression for the RIM is 16777215, which corresponds - to approximately 32 years. - - wwwwwwww, xx, y, and z are referred to interchangeably - as the fields or components of the spacecraft clock. - SCLK components may be separated by any of these five - characters: " " ":" "," "-" "." - The delimiter used is determined by a kernel pool - variable and can be adjusted by the user. - - Some spacecraft clock components have offset, or - starting, values different from zero. For example, - with an offset value of 1, a mod 20 counter would - cycle from 1 to 20 instead of from 0 to 19. - - See the SCLK required reading for a detailed - description of the Voyager and Mars Observer clock - formats. - --Parameters - - None. - --Exceptions - - 1) If the data type for the spacecraft is not supported - then the error SPICE(NOTSUPPORTED) is signaled. - - 2) If the value for ticks is negative, the error is diagnosed - by routines called by this routine. - - 3) If the SCLK kernel file does not contain data for the - spacecraft specified by sc, then the error is diagnosed - by routines called by this routine. - - 4) If the output string pointer is null, the error SPICE(NULLPOINTER) - is signaled. - - 5) If the output string has length less than two characters, it - is too short to contain one character of output data plus a null - terminator, so it cannot be passed to the underlying Fortran - routine. In this event, the error SPICE(STRINGTOOSHORT) is - signaled. - - 6) If the length of clkstr (indicated by lenout) is at least two - characters but not large enough to contain the output clock - string, the error is diagnosed by a routine called by this - routine. - --Files - - None. - --Particulars - - The routine sctiks_c performs the inverse operation to scfmt_c, - converting from clock format to number of ticks. - - Note the important difference between scfmt_c and scdecd_c. scdecd_c - converts some number of ticks since the spacecraft clock start - time to a character string which includes a partition number. - scfmt_c, which is called by scdecd_c, does not make use of partition - information. - --Examples - - - The following program fragment finds partition start and stop - times for the Galileo spacecraft from a spacecraft clock partition - kernel file, called sclk.ker. Since those times are always - returned in units of ticks, the program uses scfmt_c to print the - times in Galileo clock format. - - #include - #include "SpiceUsr.h" - - #define MXPART 9999 - #define MAXLEN 30 - - SpiceChar start [ 30 ]; - SpiceChar stop [ 30 ]; - - SpiceDouble pstart [ MXPART ]; - SpiceDouble pstop [ MXPART ]; - - SpiceInt sc = -77; - SpiceInt i; - SpiceInt nparts; - - - furnsh_c ( "sclk.ker" ); - - scpart_c ( sc, &nparts, pstart, pstop ); - - for ( i = 0; i < nparts; i++ ) - { - - scfmt_c ( sc, pstart[ i ], MAXLEN, start ); - scfmt_c ( sc, pstop [ i ], MAXLEN, stop ); - - printf ( "\n" - "partition %d: \n" - "start = %s\n" - "stop = %s\n", - i, - start, - stop ); - } - - - - Below are some examples illustrating various input numbers of - ticks and the resulting clock string outputs for the Galileo - spacecraft. - - TICKS CLKSTR - ---------------- -------------------- - -1 Error: Ticks must be a positive number - 0 "0:00:0:0" - 1 "0:00:0:1" - 1.3 "0:00:0:1" - 1.5 "0:00:0:2" - 2 "0:00:0:2" - 7 "0:00:0:7" - 8 "0:00:1:0" - 80 "0:01:0:0" - 88 "0:01:1:0" - 7279 "0:90:9:7" - 7280 "1:00:0:0" - 1234567890 "169583:45:6:2" - - The following examples are for the Voyager 2 spacecraft. - Note that the third component of the Voyager clock has an - offset value of one. - - TICKS CLKSTR - ---------------- -------------------- - -1 Error: Ticks must be a positive number - 0 "00000 00 001" - 1 "00000 00 002" - 1.3 "00000:00:002" - 1.5 "00000.00.003" - 2 "00000-00-003" - 799 "00000,00,800" - 800 "00000 01 001" - 47999 "00000 59 800" - 48000 "00001 00 001" - 3145727999 "65535 59 800" - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.M. Lynch (JPL) - R.E. Thurman (JPL) - --Version - - -CSPICE Version 1.1.4, 11-FEB-2008 (NJB) - - Header example was updated to reflect current - MXPART value of 9999. - - -CSPICE Version 1.1.3, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.2, 01-OCT-2003 (EDW) - - Added description of the 'lenout' input in the - Detailed_Input section. - - -CSPICE Version 1.1.1, 26-MAR-2003 (NJB) - - Fixed description of exception (6): replaced "lenout-1" - with "lenout." - - -CSPICE Version 1.1.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Updated the Exceptions header section. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.1, 17-APR-1992 (JML) (WLT) - --Index_Entries - - convert spacecraft_clock ticks to character clock format - --& -*/ - -{ /* Begin scfmt_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "scfmt_c"); - - - /* - Make sure the output clkstr has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "scfmt_c", clkstr, lenout ); - - - /* - Do the conversion. - */ - scfmt_ ( ( integer * ) &sc, - ( doublereal * ) &ticks, - ( char * ) clkstr, - ( ftnlen ) lenout-1 ); - - /* - Convert the Fortran string to a C string by placing a null - after the last non-blank character. This operation is valid - whether or not the CSPICE routine signaled an error. - */ - F2C_ConvertStr ( lenout, clkstr ); - - - chkout_c ( "scfmt_c"); - - -} /* End scfmt_c */ diff --git a/ext/spice/src/cspice/sclu01.c b/ext/spice/src/cspice/sclu01.c deleted file mode 100644 index 82f890df61..0000000000 --- a/ext/spice/src/cspice/sclu01.c +++ /dev/null @@ -1,1205 +0,0 @@ -/* sclu01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; -static integer c__9 = 9; -static integer c__14 = 14; - -/* $Procedure SCLU01 ( SCLK look up, type 1 ) */ -/* Subroutine */ int sclu01_0_(int n__, char *name__, integer *sc, integer * - maxnv, integer *n, integer *ival, doublereal *dval, ftnlen name_len) -{ - /* Initialized data */ - - static char namlst[80*9] = "SCLK01_COEFFICIENTS " - " " "SCLK_PARTITION_START " - " " "SCLK_P" - "ARTITION_END " - " " "SCLK01_N_FIELDS " - " " "SCLK01_OFFSETS " - " " "SCLK01_MODULI" - " " - " " "SCLK01_OUTPUT_DELIM " - " " "SCLK01_KERNEL_ID " - " " "SCLK01_TIME_SYSTEM " - " "; - static integer lb[9] = { 3,1,1,1,1,1,1,1,0 }; - static char nfdmsg[320] = "# not found. Did you load the SCLK kernel? " - " " - " " - " " - " " - " "; - static char nummsg[320] = "Invalid number of values found for #: #. " - " " - " " - " " - " " - " "; - static char bvlmsg[320] = "Invalid value found for #: #. " - " " - " " - " " - " " - " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - char type__[1]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), repmd_(char *, char *, doublereal *, - integer *, char *, ftnlen, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int gipool_(char *, integer *, integer *, integer - *, integer *, logical *, ftnlen), sigerr_(char *, ftnlen); - char tmpnam[80]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - char errmsg[320]; - extern /* Subroutine */ int dtpool_(char *, logical *, integer *, char *, - ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer - *, ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen), - gdpool_(char *, integer *, integer *, integer *, doublereal *, - logical *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Look up type 1 SCLK kernel data. */ - -/* $ 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 */ - -/* KERNEL */ -/* SCLK */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* NAME I SCLD01, SCLI01 */ -/* SC I SCLD01, SCLI01 */ -/* MAXNV I SCLD01, SCLI01 */ -/* N O SCLD01, SCLI01 */ -/* IVAL O SCLI01 */ -/* DVAL O SCLD01 */ -/* MXCOEF P SCLD01, SCLI01 */ -/* MXPART P SCLD01, SCLI01 */ -/* MXNFLD P SCLD01, SCLI01 */ -/* NDELIM P SCLI01 */ -/* MXTSYS P SCLI01 */ - -/* $ Detailed_Input */ - -/* See entry points SCLI01, SCLD01. */ - -/* $ Detailed_Output */ - -/* See entry points SCLI01, SCLD01. */ - -/* $ Parameters */ - -/* See the INCLUDE file sclk.inc for descriptions and values */ -/* of the global parameters used by this routine and */ -/* its entry points. */ - -/* $ Exceptions */ - -/* 1) IF SCLU01 is called directly, the error SPICE(BOGUSENTRY) is */ -/* signaled. */ - -/* See entry points SCLI01, SCLD01 for descriptions of exceptions */ -/* specific to those routines. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a utility whose purpose is to localize error */ -/* checking for type 1 SCLK kernel pool lookups in a single place. */ - -/* SLCU01 exists solely as an umbrella routine in which the */ -/* variables for its entry points are declared. SCLU01 should never */ -/* be called directly. */ - -/* $ Examples */ - -/* See entry points SCLI01, SCLD01. */ - -/* $ Restrictions */ - -/* 1) SCLU01 handles lookups of type 1 SCLK data only. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.3.0, 05-FEB-2008 (NJB) */ - -/* Values of parameters */ - -/* MXCOEF, MXPART, MXNFLD, NDELIM, MXTSYS */ - -/* are now provided by the INCLUDE file sclk.inc. */ - -/* - SPICELIB Version 2.2.0, 20-NOV-2006 (NJB) (EDW) */ - -/* Entry points SCLI01 and SCLD01 were update to use kernel pool */ -/* fetch routines GIPOOL and GDPOOL respectively. Formerly these */ -/* entry points called the deprecated routine RTPOOL. */ - -/* All headers have been updated to remove warnings about memory */ -/* corruption that could occur due to use of RTPOOL. */ - -/* Header references to LDPOOL were replaced with references to */ -/* FURNSH. */ - -/* - SPICELIB Version 2.1.0, 19-OCT-1992 (NJB) */ - -/* Entry points SCLI01 and SCLD01 were updated to fix a bug: */ -/* if a kernel pool lookup fails, the number of elements returned */ -/* N is now set to zero. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* Entry point SCLI01 was updated to handle a time */ -/* system specification for the `parallel' time system */ -/* in the SCLK kernel. Comment section for permuted index */ -/* source lines was added following the header. */ - -/* - SPICELIB Version 1.0.0, 06-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* lookup type_1 spacecraft_clock */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 19-OCT-1992 (NJB) */ - -/* Entry points SCLI01 and SCLD01 were updated to fix a bug: */ -/* if a kernel pool lookup fails, the number of elements returned */ -/* N is now set to zero. Formerly, these routines returned */ -/* whatever value was returned by RTPOOL. RTPOOL, however, */ -/* does not set N to zero when the data item requested from it */ -/* is not found. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* Entry point SCLI01 was updated to handle a time */ -/* system specification for the `parallel' time system */ -/* in the SCLK kernel. The update consists of these */ -/* changes: */ - -/* -- The parameter MXTSYS is now defined. */ - -/* -- The local saved variable NAMLST has been expanded */ -/* to include the name SCLK01_TIME_SYSTEM */ - -/* -- The local saved variable LB has been expanded to */ -/* include the lower bound for the number of returned */ -/* values when SCLK01_TIME_SYSTEM_nn is looked up in */ -/* the kernel pool. */ - -/* -- SCLI01 checks the value returned by RTPOOL when */ -/* SCLK01_TIME_SYSTEM_nn is looked up to verify that */ -/* it is within the range [1, MXTSYS]. */ - -/* Also, a comment section for permuted index source lines was */ -/* added following the header. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* DELIDX is the index of the delimiter code name in NAMLST. If */ -/* the declaration of NAMLST or assignment of values to NAMLST */ -/* changes, this parameter value may have to change. */ - - -/* NFLIDX is the index of the SCLK field count in NAMLST. */ - - -/* MODIDX is the index of the SCLK moduli in NAMLST. */ - - -/* SYSIDX is the index of the time system in NAMLST. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Names of type 1 SCLK items and lower bounds on the number of */ -/* associated values. */ - - /* Parameter adjustments */ - if (ival) { - } - if (dval) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_scli01; - case 2: goto L_scld01; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCLU01", (ftnlen)6); - } - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("SCLU01", (ftnlen)6); - return 0; -/* $Procedure SCLI01 ( SCLK lookup of integer data, type 1 ) */ - -L_scli01: -/* $ Abstract */ - -/* Look up integer type 1 SCLK data from the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ -/* SCLK */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER SC */ -/* INTEGER MAXNV */ -/* INTEGER N */ -/* INTEGER IVAL ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME, */ -/* SC I Name of kernel data item, NAIF spacecraft ID code. */ -/* MAXNV I Maximum number of integer values to return. */ -/* N O Number of values actually returned. */ -/* IVAL O Returned integer values. */ -/* MXNFLD P Maximum number of fields in an SCLK string. */ -/* NDELIM P Maximum number of delimiter codes. */ -/* MXTSYS P Maximum number of supported parallel time systems. */ - -/* $ Detailed_Input */ - -/* NAME, */ -/* SC are, respectively, a name and a NAIF integer code */ -/* of a spacecraft that together define the name of a */ -/* requested kernel data item. NAME is the full name */ -/* as it appears in the SCLK kernel, except that it */ -/* lacks the final underscore and spacecraft integer */ -/* code (actually, the negative of the spacecraft */ -/* code). This routine combines NAME and SC to */ -/* make up the appropriate kernel variable name. */ - -/* For example, to look up data associated with the */ -/* name */ - -/* SCLK01_N_FIELDS_77 */ - -/* you would supply NAME as */ - -/* SCLK01_N_FIELDS */ - -/* and SC as -77. */ - - -/* MAXNV is the maximum number of values to return. MAXNV */ -/* is used to prevent SCLI01 from writing past the end */ -/* of the supplied array IVAL. */ - -/* $ Detailed_Output */ - -/* N is the number of values actually returned. */ - -/* IVAL is an array containing the requested integer */ -/* kernel data item. */ - -/* $ Parameters */ - -/* MXNFLD is an upper bound on the number of fields in a */ -/* SCLK string. */ - -/* NDELIM is the number of delimiter codes. */ - -/* MXTSYS is the maximum number of supported parallel time */ -/* systems that SCLK values may be mapped to or from. */ - -/* $ Exceptions */ - - -/* 1) If item specified by NAME and SC is not found in the kernel */ -/* pool, and if the presence of the item is required, the error */ -/* SPICE(KERNELVARNOTFOUND) is signaled. The output arguments */ -/* are not modified. */ - -/* If the specified item is not required, the output argument N */ -/* will take the value 0, and the output argument IVAL is not */ -/* modified. */ - -/* 2) This routine can check certain data for validity. If any of */ -/* these items have invalid values, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. The output arguments are */ -/* not modified. The values in question are: */ - -/* - The number of fields of a SCLK string */ -/* - The number of delimiter codes */ -/* - The output delimiter code */ -/* - The time system code */ - -/* 3) If the dimension of the requested item exceeds MAXNV, the */ -/* error SPICE(ARRAYTOOSMALL) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The purpose of this routine is to localize error checking for */ -/* lookups of type 1 SCLK kernel pool data. This routine handles */ -/* lookups of integer data. */ - -/* $ Examples */ - -/* 1) To get the number of SCLK fields for the Galileo spacecraft */ -/* clock, you can use the code fragment below: */ - -/* C */ -/* C Load the SCLK kernel in question. We use a */ -/* C made-up name for the kernel file; you would use */ -/* C the actual name of your kernel file instead if you */ -/* C were to carry out this procedure. */ -/* C */ -/* CALL FURNSH ( 'SAMPLE_GLL_SCLK.KER' ) */ - -/* SC = -77 */ -/* NAME = 'SCLK01_N_FIELDS' */ - -/* CALL SCLI01 ( NAME, SC, MXNFLD, N, NFIELD ) */ - - -/* After this subroutine call, NFIELD has the value 4. */ - - -/* $ Restrictions */ - -/* 1) SCLI01 assumes that a SCLK kernel appropriate to the */ -/* spacecraft identified by SC has been loaded. */ - -/* 2) SCLI01 handles lookups of type 1 SCLK data only. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 20-NOV-2006 (NJB) (EDW) */ - -/* Routine was updated to use GIPOOL instead of RTPOOL. Header */ -/* has been updated to remove warnings about memory corruption and */ -/* to document exception handling for output buffer overflow */ -/* errors. */ - -/* Header references to LDPOOL were replaced with references to */ -/* FURNSH. */ - -/* - SPICELIB Version 2.1.0, 19-OCT-1992 (NJB) */ - -/* This entry point was updated to fix a bug: if a kernel pool */ -/* lookup fails, the number of elements returned N is now set to */ -/* zero. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* SCLI01 was updated to handle a time system specification for */ -/* the `parallel' time system in the SCLK kernel. Some */ -/* corrections and other minor enhancements were made to the */ -/* header. Comment section for permuted index source lines was */ -/* added following the header. */ - -/* - SPICELIB Version 1.0.0, 06-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* lookup of type_1 spacecraft_clock integer data */ -/* lookup type_1 spacecraft_clock integer data */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 19-OCT-1992 (NJB) */ - -/* This entry point was updated to fix a bug: if a kernel pool */ -/* lookup fails, the number of elements returned N is now set to */ -/* zero. Formerly, this routine returned whatever value was */ -/* returned by RTPOOL. RTPOOL, however, does not set N to zero */ -/* when the data item requested from it is not found. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* Entry point SCLI01 was updated to handle a time */ -/* system specification for the `parallel' time system */ -/* in the SCLK kernel. The update consists of these */ -/* changes: */ - -/* -- The parameter MXTSYS is now defined. */ - -/* -- The local saved variable NAMLST has been expanded */ -/* to include the name SCLK01_TIME_SYSTEM */ - -/* -- The local saved variable LB has been expanded to */ -/* include the lower bound for the number of returned */ -/* values when SCLK01_TIME_SYSTEM_nn is looked up in */ -/* the kernel pool. */ - -/* -- SCLI01 checks the value returned by RTPOOL when */ -/* SCLK01_TIME_SYSTEM_nn is looked up to verify that */ -/* it is within the range [1, MXTSYS]. */ - -/* Also, a comment section for permuted index source lines was */ -/* added following the header. */ - -/* The $Exceptions header section was updated accordingly. */ - -/* Some corrections and other minor enhancements were made to the */ -/* header. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCLI01", (ftnlen)6); - } - -/* Form the name of the kernel pool data item, and do the lookup. */ -/* Note that eventually we should use a kernel pool lookup entry */ -/* that allows us to specify the maximum number of entries that */ -/* can be returned. */ - - s_copy(tmpnam, name__, (ftnlen)80, name_len); - suffix_("_#", &c__0, tmpnam, (ftnlen)2, (ftnlen)80); - i__1 = -(*sc); - repmi_(tmpnam, "#", &i__1, tmpnam, (ftnlen)80, (ftnlen)1, (ftnlen)80); - -/* Make sure we have enough room for the item in our output */ -/* array. Look up the dimension of the item. */ - - dtpool_(tmpnam, &found, n, type__, (ftnlen)80, (ftnlen)1); - if (*n > *maxnv) { - setmsg_("Item # has size # but output array has size #.", (ftnlen)46); - errch_("#", tmpnam, (ftnlen)1, (ftnlen)80); - errint_("#", n, (ftnlen)1); - errint_("#", maxnv, (ftnlen)1); - sigerr_("SPICE(ARRAYTOOSMALL)", (ftnlen)20); - chkout_("SCLI01", (ftnlen)6); - return 0; - } - gipool_(tmpnam, &c__1, maxnv, n, ival, &found, (ftnlen)80); - -/* Make sure we found what we were looking for, if the item */ -/* is required. */ - - if (! found) { - -/* Currently, the only item that is NOT required is the time */ -/* system specification. In any case, no values will be returned. */ - - *n = 0; - if (s_cmp(name__, namlst + 640, name_len, (ftnlen)80) == 0) { - chkout_("SCLI01", (ftnlen)6); - return 0; - } else { - setmsg_(nfdmsg, (ftnlen)320); - errch_("#", tmpnam, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("SCLI01", (ftnlen)6); - return 0; - } - } - -/* Now we must check that the number of returned values is in the */ -/* appropriate range. We test for the following conditions: */ - -/* - The number of SCLK fields is at least 1 and is not */ -/* more than MAXNV. */ - -/* - The number of delimiter codes is at least 1 and is not */ -/* more than MAXNV. */ - -/* - The output delimiter code is at least 1 and is not */ -/* greater than the number of delimiters. */ - -/* - The time system code is at least 1 and is not greater */ -/* than MXTSYS. */ - - -/* See if the input name is in the list of items we know about. */ -/* If it is, perform the bound checks that apply. */ - - i__ = isrchc_(name__, &c__9, namlst, name_len, (ftnlen)80); - if (i__ != 0) { - if (*n < lb[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("lb", - i__1, "sclu01_", (ftnlen)681)]) { - repmc_(nummsg, "#", tmpnam, errmsg, (ftnlen)320, (ftnlen)1, ( - ftnlen)80, (ftnlen)320); - repmi_(errmsg, "#", n, errmsg, (ftnlen)320, (ftnlen)1, (ftnlen) - 320); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCLI01", (ftnlen)6); - return 0; - } - } - -/* Check the value of the delimiter code itself. */ - - if (s_cmp(name__, namlst + 480, name_len, (ftnlen)80) == 0) { - if (ival[0] < 1 || ival[0] > 5) { - repmc_(bvlmsg, "#", tmpnam, errmsg, (ftnlen)320, (ftnlen)1, ( - ftnlen)80, (ftnlen)320); - repmi_(errmsg, "#", ival, errmsg, (ftnlen)320, (ftnlen)1, (ftnlen) - 320); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCLI01", (ftnlen)6); - return 0; - } - } - -/* Check the value of the field count, too. */ - - if (s_cmp(name__, namlst + 240, name_len, (ftnlen)80) == 0) { - if (ival[0] < 1 || ival[0] > 10) { - repmc_(bvlmsg, "#", tmpnam, errmsg, (ftnlen)320, (ftnlen)1, ( - ftnlen)80, (ftnlen)320); - repmi_(errmsg, "#", ival, errmsg, (ftnlen)320, (ftnlen)1, (ftnlen) - 320); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCLI01", (ftnlen)6); - return 0; - } - } - -/* Check the value of the time system code. */ - - if (s_cmp(name__, namlst + 640, name_len, (ftnlen)80) == 0) { - if (ival[0] < 1 || ival[0] > 2) { - repmc_(bvlmsg, "#", tmpnam, errmsg, (ftnlen)320, (ftnlen)1, ( - ftnlen)80, (ftnlen)320); - repmi_(errmsg, "#", ival, errmsg, (ftnlen)320, (ftnlen)1, (ftnlen) - 320); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCLI01", (ftnlen)6); - return 0; - } - } - chkout_("SCLI01", (ftnlen)6); - return 0; -/* $Procedure SCLD01 ( SCLK lookup of double precision data, type 1 ) */ - -L_scld01: -/* $ Abstract */ - -/* Look up double precision type 1 SCLK data from the kernel pool. */ - -/* $ 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 */ - -/* KERNEL */ -/* SCLK */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER SC */ -/* INTEGER MAXNV */ -/* INTEGER N */ -/* DOUBLE PRECISION DVAL ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME, */ -/* SC I Name of kernel data item, NAIF spacecraft ID code. */ -/* MAXNV I Maximum number of d.p. values to return. */ -/* N O Number of values actually returned. */ -/* DVAL O Requested kernel data item. */ -/* MXCOEF P Maximum number of coefficient sets in SCLK kernel. */ - -/* $ Detailed_Input */ - -/* NAME, */ -/* SC are, respectively, a name and a NAIF integer code */ -/* of a spacecraft that together define the name of a */ -/* requested kernel data item. NAME is the full name */ -/* as it appears in the SCLK kernel, except that it */ -/* lacks the final underscore and spacecraft integer */ -/* code (actually, the negative of the spacecraft */ -/* code). This routine combines NAME and SC to */ -/* make up the appropriate kernel variable name. */ - -/* For example, to look up data associated with the */ -/* name */ - -/* SCLK01_COEFFICIENTS_77 */ - -/* you would supply NAME as */ - -/* SCLK01_COEFFICIENTS */ - -/* and SC as -77. */ - - -/* MAXNV is the maximum number of values to return. MAXNV */ -/* is used to prevent SCLD01 from writing past the end */ -/* of the supplied array DVAL. */ - -/* $ Detailed_Output */ - -/* N is the number of values actually returned. */ - -/* DVAL is an array containing the requested double */ -/* precision kernel data item. */ - -/* $ Parameters */ - -/* MXCOEF is the maximum number of coefficient sets in the */ -/* array COEFFS that defines the mapping between */ -/* encoded type 1 SCLK and a parallel time system. */ -/* This array has dimension 3 x MXCOEF. The value of */ -/* MXCOEF may be increased as required. */ - -/* $ Exceptions */ - -/* 1) If item specified by NAME and SC is not found in the kernel */ -/* pool, the error SPICE(KERNELVARNOTFOUND) is signaled. The */ -/* output arguments are not modified. */ - -/* 2) This routine can check certain data for validity. If any of */ -/* these items have invalid values, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. The output arguments are */ -/* not modified. The values in question are: */ - -/* - The number of coefficients. */ -/* - The number of partition start values. */ -/* - The number of partition end values. */ -/* - The number of moduli. */ -/* - The values of the moduli (lower bounds) */ -/* - The number of offsets. */ -/* - The number of kernel identifiers. */ - -/* 3) If the partition times or SCLK coefficients themselves */ -/* are invalid, this routine does nothing about it. It is */ -/* simply not possible to detect all of the possible errors */ -/* that these data may be subject to. */ - -/* 4) If the dimension of the requested item exceeds MAXNV, the */ -/* error SPICE(ARRAYTOOSMALL) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The purpose of this routine is to localize error checking for */ -/* lookups of type 1 SCLK kernel pool data. This routine handles */ -/* lookups of double precision data. */ - -/* $ Examples */ - -/* 1) Check a NAIF SCLK kernel for accuracy by converting the */ -/* encoded SCLK coefficients to strings with partition numbers */ -/* and converting the parallel times to UTC strings. Print out */ -/* the results in tabular form. In this example, the spacecraft */ -/* is Mars Observer, which has NAIF ID code -94. We could */ -/* make the program work for Galileo by using the NAIF ID code */ -/* -77 instead of -94. */ - -/* C */ -/* C Load the SCLK kernel in question, and also load */ -/* C a leapseconds kernel. We use made-up names for the */ -/* C kernel file; you would use the actual names of your */ -/* C kernel files instead if you were to carry out this */ -/* C procedure. */ -/* C */ -/* CALL FURNSH ( 'SAMPLE_MO_SCLK.KER' ) */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ - -/* CONAME = SCLK01_COEFFICIENTS */ -/* SC = -94 */ - -/* C */ -/* C Grab the coefficients. */ -/* C */ -/* CALL SCLD01 ( CONAME, SC, 3*MXCOEF, NCOEFF, COEFFS ) */ - -/* C */ -/* C The SCLK coefficients are in the first row of the */ -/* C coefficients array; the parallel times are in the */ -/* C second. Since the parallel time system used for MO */ -/* C is terrestrial dynamical time (TDT), we will convert */ -/* C the parallel time values to ET (TDB) first and then */ -/* C convert the resulting times to UTC. */ -/* C */ -/* C In a more robust algorithm, we'd look up the parallel */ -/* C time system code used in the SCLK kernel rather than */ -/* C assume that it is a particular system. We omit this */ -/* C check for simplicity. */ -/* C */ -/* C We decode the SCLK coefficients using SCDECD. Write */ -/* C out the results to a file we'll call COMPARE.DAT. */ -/* C */ -/* OUTFIL = 'COMPARE.DAT' */ - -/* CALL WRLINE ( OUTFIL, ' SCLK UTC' ) */ -/* CALL WRLINE ( OUTFIL, ' ' ) */ - -/* DO I = 1, NCOEFF / 3 */ - -/* CALL SCDECD ( -94, COEFF(1,I), CLKSTR ) */ -/* C */ -/* C Convert the parallel time coefficients, which are */ -/* C given in TDT, to ET. UNITIM returns this value. */ -/* C */ -/* CALL ET2UTC ( UNITIM ( COEFF(2,I), 'TDT', 'TDB' ), */ -/* . 'D', */ -/* . 3, */ -/* . UTC ) */ - -/* LINE = ' SCLK UTC ' */ - -/* CALL REPMC ( LINE, 'SCLK', CLKSTR, LINE ) */ -/* CALL REPMC ( LINE, 'UTC', UTC, LINE ) */ - -/* CALL WRLINE ( OUTFIL, LINE ) */ - -/* END DO */ - - -/* $ Restrictions */ - -/* 1) SCLD01 assumes that a SCLK kernel appropriate to the */ -/* spacecraft identified by SC has been loaded. */ - -/* 2) SCLD01 handles lookups of type 1 SCLK data only. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 20-NOV-2006 (NJB) (EDW) */ - -/* Routine was updated to use GDPOOL instead of RTPOOL. Header */ -/* has been updated to remove warnings about memory corruption and */ -/* to document exception handling for output buffer overflow */ -/* errors. */ - -/* Header references to LDPOOL were replaced with references to */ -/* FURNSH. */ - -/* - SPICELIB Version 2.1.0, 19-OCT-1992 (NJB) */ - -/* This entry point was updated to fix a bug: if a kernel pool */ -/* lookup fails, the number of elements returned N is now set to */ -/* zero. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* One constant was changed in the code for clarity; no functional */ -/* change results from this. Some corrections and other minor */ -/* enhancements were made to the header. Comment section for */ -/* permuted index source lines was added following the header. */ - -/* - SPICELIB Version 1.0.0, 06-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* lookup of type_1 spacecraft_clock d.p. data */ -/* lookup type_1 spacecraft_clock d.p. data */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 19-OCT-1992 (NJB) */ - -/* This entry point was updated to fix a bug: if a kernel pool */ -/* lookup fails, the number of elements returned N is now set to */ -/* zero. Formerly, this routine returned whatever value was */ -/* returned by RTPOOL. RTPOOL, however, does not set N to zero */ -/* when the data item requested from it is not found. */ - -/* - SPICELIB Version 2.0.0, 17-APR-1992 (NJB) (WLT) */ - -/* The constant 1 was changed to 1.D0 in the test for the */ -/* validity of the moduli for a spacecraft clock. The change */ -/* was made simply for clarity. */ - -/* Some corrections and other minor enhancements were made to the */ -/* header. Comment section for permuted index source lines was */ -/* added following the header. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCLD01", (ftnlen)6); - } - -/* Form the name of the kernel pool datum, and do the lookup. */ - - s_copy(tmpnam, name__, (ftnlen)80, name_len); - suffix_("_#", &c__0, tmpnam, (ftnlen)2, (ftnlen)80); - i__1 = -(*sc); - repmi_(tmpnam, "#", &i__1, tmpnam, (ftnlen)80, (ftnlen)1, (ftnlen)80); - -/* Make sure we have enough room for the item in our output */ -/* array. Look up the dimension of the item. */ - - dtpool_(tmpnam, &found, n, type__, (ftnlen)80, (ftnlen)1); - if (*n > *maxnv) { - setmsg_("Item # has size # but output array has size #.", (ftnlen)46); - errch_("#", tmpnam, (ftnlen)1, (ftnlen)80); - errint_("#", n, (ftnlen)1); - errint_("#", maxnv, (ftnlen)1); - sigerr_("SPICE(ARRAYTOOSMALL)", (ftnlen)20); - chkout_("SCLD01", (ftnlen)6); - return 0; - } - gdpool_(tmpnam, &c__1, maxnv, n, dval, &found, (ftnlen)80); - -/* Make sure we found what we were looking for. */ - - if (! found) { - -/* No values are returned in this case. */ - - *n = 0; - setmsg_(nfdmsg, (ftnlen)320); - errch_("#", tmpnam, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("SCLD01", (ftnlen)6); - return 0; - } - -/* Now we must check that the number of returned values is in the */ -/* appropriate range. We test for the following conditions: */ - -/* - The number of coefficients is at least 3. */ - -/* - The number of partition start values is at least 1. */ - -/* - The number of partition end values is at least 1. */ - -/* - The number of moduli is at least 1. */ - -/* - The number of offsets is at least 1. */ - - - -/* See if the input name is in the list of items we know about. */ -/* If it is, perform the bounds checks that apply. */ - - i__ = isrchc_(name__, &c__9, namlst, name_len, (ftnlen)80); - if (i__ != 0) { - if (*n < lb[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("lb", - i__1, "sclu01_", (ftnlen)1121)]) { - repmc_(nummsg, "#", tmpnam, errmsg, (ftnlen)320, (ftnlen)1, ( - ftnlen)80, (ftnlen)320); - repmi_(errmsg, "#", n, errmsg, (ftnlen)320, (ftnlen)1, (ftnlen) - 320); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCLD01", (ftnlen)6); - return 0; - } - } - -/* Check the values of the moduli themselves. */ - - if (s_cmp(name__, namlst + 400, name_len, (ftnlen)80) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (dval[0] < 1.) { - repmc_(bvlmsg, "#", tmpnam, errmsg, (ftnlen)320, (ftnlen)1, ( - ftnlen)80, (ftnlen)320); - repmd_(errmsg, "#", dval, &c__14, errmsg, (ftnlen)320, ( - ftnlen)1, (ftnlen)320); - setmsg_(errmsg, (ftnlen)320); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SCLD01", (ftnlen)6); - return 0; - } - } - } - chkout_("SCLD01", (ftnlen)6); - return 0; -} /* sclu01_ */ - -/* Subroutine */ int sclu01_(char *name__, integer *sc, integer *maxnv, - integer *n, integer *ival, doublereal *dval, ftnlen name_len) -{ - return sclu01_0_(0, name__, sc, maxnv, n, ival, dval, name_len); - } - -/* Subroutine */ int scli01_(char *name__, integer *sc, integer *maxnv, - integer *n, integer *ival, ftnlen name_len) -{ - return sclu01_0_(1, name__, sc, maxnv, n, ival, (doublereal *)0, name_len) - ; - } - -/* Subroutine */ int scld01_(char *name__, integer *sc, integer *maxnv, - integer *n, doublereal *dval, ftnlen name_len) -{ - return sclu01_0_(2, name__, sc, maxnv, n, (integer *)0, dval, name_len); - } - diff --git a/ext/spice/src/cspice/scpars.c b/ext/spice/src/cspice/scpars.c deleted file mode 100644 index 6d5791f01f..0000000000 --- a/ext/spice/src/cspice/scpars.c +++ /dev/null @@ -1,800 +0,0 @@ -/* scpars.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__9999 = 9999; - -/* $Procedure SCPARS ( Parse a spacecraft clock string ) */ -/* Subroutine */ int scpars_(integer *sc, char *sclkch, logical *error, char * - msg, doublereal *sclkdp, ftnlen sclkch_len, ftnlen msg_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - double d_nint(doublereal *); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - integer part, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *, - char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), scps01_(integer - *, char *, logical *, char *, doublereal *, ftnlen, ftnlen), - repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen); - doublereal ticks; - integer dtype, pnter; - char psmsg[255]; - logical pserr; - doublereal pstop[9999]; - extern logical failed_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), scpart_(integer *, integer *, doublereal *, doublereal *) - , nparsi_(char *, integer *, char *, integer *, ftnlen, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern integer sctype_(integer *); - integer nparts; - doublereal pstart[9999]; - extern logical return_(void); - char strerr[255]; - doublereal ptotls[9999]; - integer pos; - -/* $ Abstract */ - -/* Parse a character representation of spacecraft clock time and */ -/* encode it as a double precision number. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* SCLKCH I Character representation of a spacecraft clock. */ -/* ERROR O Flag to indicate if string parsed correctly. */ -/* MSG O Error message if string did not parse. */ -/* SCLKDP O Encoded representation of the clock count. */ -/* MXPART P Maximum number of spacecraft clock partitions. */ - -/* $ Detailed_Input */ - -/* SC is the standard NAIF ID of the spacecraft whose clock's */ -/* time is being encoded. */ - -/* SCLKCH is the character representation of some spacecraft's */ -/* clock count. */ - -/* SCLKCH will have the following general format: */ - -/* 'pp/sclk_string', or just */ -/* 'sclk_string' */ - -/* 'pp' is an integer greater than or equal to one */ -/* and is called the partition number. */ - -/* Each mission is divided into some number of partitions. */ -/* A new partition starts when the spacecraft clock */ -/* resets, either to zero, or to some other */ -/* value. Thus, the first partition for any mission */ -/* starts with launch, and ends with the first clock */ -/* reset. The second partition starts immediately when */ -/* the first stopped, and so on. */ - -/* In order to be completely unambiguous about a */ -/* particular time, you need to specify a partition number */ -/* along with the standard clock string. */ - -/* Information about when partitions occur for different */ -/* missions is contained in a spacecraft clock kernel */ -/* file, which needs to be loaded into the kernel pool, */ -/* using the routines CLPOOL and FURNSH. */ - -/* The routine SCPART is used to read the partition */ -/* start and stop times, in encoded units of SCLK (called */ -/* "ticks" -- see SCLKDP below) from the kernel file. */ - -/* If the partition number is included, it must be */ -/* separated from the rest of the string by a '/'. */ -/* Any number of spaces may separate the partition number, */ -/* the '/', and the rest of the clock string. */ - - -/* If the partition number is omitted, a default partition */ -/* will be assumed. The default partition is the lowest- */ -/* numbered partition that contains the given clock time. */ -/* If the clock time does not fall in any of the */ -/* partition boundaries then an error is signaled. */ - - -/* 'sclk_string' is a spacecraft specific clock string. */ -/* Using Galileo as an example, the full format is */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */ -/* Count (RIM), which increments once every time xx turns */ -/* over, i.e., once every 60 2/3 seconds. The roll-over */ -/* expression for the RIM is 16777215, which corresponds */ -/* to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft clock. */ -/* SCLK components may be separated by any of these */ -/* five characters: ' ' ':' ',' '-' '.' */ -/* Any number of spaces can separate the components and */ -/* the delimiters. The presence of the RIM component */ -/* is required. Successive components may be omitted, and */ -/* in such cases are assumed to represent zero values. */ - -/* Values for the individual components may exceed the */ -/* maximum expected values. For instance, '0:0:0:9' is */ -/* an acceptable Galileo clock string, and will convert */ -/* to the same number of ticks as '0:0:1:1'. */ - -/* Consecutive delimiters containing no intervening digits */ -/* are treated as if they delimit zero components. */ - -/* Trailing zeros should always be included to match the */ -/* length of the counter. For example, a Galileo clock */ -/* count of '25684.90' should not be represented as */ -/* '25684.9'. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Voyager and Mars Observer clock */ -/* formats. */ - - -/* $ Detailed_Output */ - -/* ERROR is true if an error occurred parsing the input clock */ -/* string and converting it to ticks. */ - -/* MSG is the message generated if an error occurred parsing */ -/* the input clock string. */ - -/* SCLKDP is the double precision encoding of SCLKCH. */ - -/* The encoding is such that order and proximity will be */ -/* preserved. That is, if t1, t2, and t3 are spacecraft */ -/* clock times, and t1*, t2*, and t3* are their encodings, */ -/* then if */ - -/* t1 < t2 < t3, and */ - -/* t2 is closer to t1 than to t3, you will have the result */ -/* that */ - -/* t1* < t2* < t3*, and */ - -/* t2* is closer to t1* than to t3*. */ - -/* The units of encoded SCLK are "ticks since the start of */ -/* the mission", where a "tick" is defined to be the */ -/* shortest time increment expressible by a particular */ -/* spacecraft's clock. */ - -/* Each clock string without partition number represents */ -/* a certain number of ticks, but you need to include */ -/* partition information to determine the relative */ -/* position of that time in relation to the start of the */ -/* mission. */ - -/* Since the end time of one partition is coincident */ -/* with the begin time of the next, there are two */ -/* different representations for this instant, and they */ -/* will both yield the same encoding. */ - -/* For example, if partition 1 has an end time of t1, and */ -/* partition 2 has a begin time of t2, then if we did */ - -/* CALL SCENCD ( '1/t1', SC, X ) and */ -/* CALL SCENCD ( '2/t2', SC, Y ), then */ - -/* X = Y. */ - -/* The individual routines TIKSnn, where nn is the */ -/* clock type code, contain more detailed information */ -/* on the conversion process. */ - -/* $ Parameters */ - -/* MXPART is the maximum number of spacecraft clock partitions */ -/* expected in the kernel file for any one spacecraft. */ -/* See the INCLUDE file sclk.inc for this parameter's */ -/* value. */ - -/* $ Exceptions */ - -/* This routine uses both the normal SPICELIB error handling and */ -/* an ERROR flag and message. Errors that deal with kernel pool */ -/* data that is missing or invalid are treated in the usual way. */ -/* Errors that arise solely from parsing the input clock string */ -/* do not signal SPICELIB errors, but instead use the ERROR flag */ -/* and MSG string. */ - -/* In the case of any SPICELIB error occuring, ERROR is initialized */ -/* to .TRUE. and MSG to "SPICELIB error detected.". */ - - -/* 1) If the number of partitions in the kernel file for spacecraft */ -/* SC excceds the parameter MXPART, the error */ -/* 'SPICE(TOOMANYPARTS)' is signaled. */ - -/* 2) If the data type of the clock for the specified spacecraft is */ -/* of a data type not recognized by this routine, the error */ -/* 'SPICE(NOTSUPPORTED)' is signaled. */ - - -/* If a partition number is included in the SCLK string, the */ -/* following errors may occur: */ - -/* 3) The partition number cannot be parsed as an integer. */ - -/* 4) The partition number is not in the range of the number of */ -/* partitions found in the kernel pool. */ - -/* 5) The clock count does not fall in the boundaries of the */ -/* specified partition. */ - - -/* If a partition number is not included in the SCLK string, the */ -/* following exception may occur. */ - -/* 6) The clock count does not fall in the boundaries of any */ -/* partition found in the kernel pool. */ - -/* The actual parsing of the remainder of the clock string is */ -/* performed by data type specific routines. The error handling */ -/* in those routines works in a similar manner to this one. */ - -/* $ Files */ - -/* A kernel file containing spacecraft clock partition information */ -/* for the desired spaceraft must be loaded, using the routines */ -/* CLPOOL and FURNSH, before calling this routine. */ - -/* $ Particulars */ - -/* In general, it is difficult to compare spacecraft clock counts */ -/* numerically since there are too many clock components for a */ -/* single comparison. This routine provides a method of assigning a */ -/* single double precision number to a spacecraft's clock count, */ -/* given one of its character representations. */ - -/* The routine SCDECD performs the inverse operation to SCENCD, */ -/* converting an encoded double precision number to character format. */ - -/* To convert the string to ticks since the start of the mission, */ -/* SCENCD */ - -/* 1) Converts the non-partition portion of the string to */ -/* ticks, using the routine SCTIKS. */ - -/* 2) Determines the partition number for the clock time, */ -/* either by getting it directly from the input string, or */ -/* determining the default partition if none was specified. */ - -/* 3) Includes partition start and stop times, which are also */ -/* measured in ticks, to compute the number of ticks */ -/* since the beginning of the mission of the clock time. */ - -/* $ Examples */ - -/* Double precision encodings of spacecraft clock counts are used to */ -/* tag pointing data in the C-kernel. */ - -/* In the following example, pointing for a sequence of images from */ -/* the Voyager 2 narrow angle camera is requested from the C-kernel */ -/* using an array of character spacecraft clock counts as input. */ -/* The clock counts attached to the output are then decoded to */ -/* character and compared with the input strings. */ - -/* CHARACTER*(25) SCLKIN ( 4 ) */ -/* CHARACTER*(25) SCLKOUT */ -/* CHARACTER*(25) CLKTOL */ - -/* DOUBLE PRECISION TIMEIN */ -/* DOUBLE PRECISION TIMOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ - -/* INTEGER NPICS */ -/* INTEGER SC */ - -/* DATA NPICS / 4 / */ - -/* DATA SCLKIN / '2 / 20538:39:768', */ -/* . '2 / 20543:21:768', */ -/* . '2 / 20550:37', */ -/* . '2 / 20561:59' / */ - -/* DATA CLKTOL / ' 0:01:000' / */ - -/* C */ -/* C The instrument we want pointing for is the Voyager 2 */ -/* C narrow angle camera. The reference frame we want is */ -/* C J2000. The spacecraft is Voyager 2. */ -/* C */ -/* INST = -32001 */ -/* REF = 'J2000' */ -/* SC = -32 */ - -/* C */ -/* C Load the appropriate files. We need */ -/* C */ -/* C 1) CK file containing pointing data. */ -/* C 2) Spacecraft clock kernel file, for SCENCD and SCDECD. */ -/* C */ -/* CALL CKLPF ( 'VGR2NA.CK' ) */ -/* CALL CLPOOL */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* C */ -/* C Convert the tolerance string to ticks. */ -/* C */ -/* CALL SCTIKS ( SC, CLKTOL, TOL ) */ - -/* DO I = 1, NPICS */ - -/* CALL SCENCD ( SC, SCLKIN( I ), TIMEIN ) */ - -/* CALL CKGP ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT, */ -/* . FOUND ) */ - -/* CALL SCDECD ( SC, TIMOUT, SCLKOUT ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Input s/c clock count: ', SCLKIN( I ) */ -/* WRITE (*,*) 'Output s/c clock count: ', SCLKOUT */ -/* WRITE (*,*) 'Output C-Matrix: ', CMAT */ -/* WRITE (*,*) */ - -/* END DO */ - -/* The output from such a program might look like: */ - - -/* Input s/c clock count: 2 / 20538:39:768 */ -/* Output s/c clock count: 2/20538:39:768 */ -/* Output C-Matrix: 'first C-matrix' */ - -/* Input s/c clock count: 2 / 20543:21:768 */ -/* Output s/c clock count: 2/20543:22:768 */ -/* Output C-Matrix: 'second C-matrix' */ - -/* Input s/c clock count: 2 / 20550:37 */ -/* Output s/c clock count: 2/20550:36:768 */ -/* Output C-Matrix: 'third C-matrix' */ - -/* Input s/c clock count: 2 / 20561:59 */ -/* Output s/c clock count: 2/20561:58:768 */ -/* Output C-Matrix: 'fourth C-matrix' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 05-FEB-2008 (NJB) */ - -/* The values of parameter MXPART and is now */ -/* provided by the INCLUDE file sclk.inc. */ - -/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Make CHKIN and CHKOUT arguments consistent. */ - -/* - 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, 03-SEP-1990 (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* encode spacecraft_clock */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCPARS", (ftnlen)6); - } - -/* This routine handles errors in two different ways. */ - -/* 1) Errors relating to parsing the input clock string */ -/* will not use the normal SPICELIB error handling. */ -/* Instead they will use the ERROR and MSG arguments */ -/* to this routine. */ - -/* 2) Errors relating to missing or invalid data in the */ -/* kernel pool will use the normal SPICELIB error */ -/* handling. */ - -/* In the event that a SPICE error occurs somewhere, ERROR */ -/* and MSG will be initialized to the following values: */ - - *error = TRUE_; - s_copy(msg, "SPICELIB error detected.", msg_len, (ftnlen)24); - -/* First check if the string is blank. */ - - if (s_cmp(sclkch, " ", sclkch_len, (ftnlen)1) == 0) { - *error = TRUE_; - s_copy(msg, "Input spacecraft clock string is blank.", msg_len, ( - ftnlen)39); - chkout_("SCPARS", (ftnlen)6); - return 0; - } - -/* Convert the non-partition clock string to a tick value. */ -/* This conversion depends on the data type of the clock. */ - - pos = cpos_(sclkch, "/", &c__1, sclkch_len, (ftnlen)1); - dtype = sctype_(sc); - if (failed_()) { - chkout_("SCPARS", (ftnlen)6); - return 0; - } - if (dtype == 1) { - i__1 = pos; - scps01_(sc, sclkch + i__1, &pserr, psmsg, &ticks, sclkch_len - i__1, ( - ftnlen)255); - } else { - setmsg_("Clock type # is not supported.", (ftnlen)30); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SCPARS", (ftnlen)6); - return 0; - } - -/* Check if the SCPSxx routine encoutered a problem. */ - - if (pserr) { - *error = TRUE_; - s_copy(msg, psmsg, msg_len, (ftnlen)255); - chkout_("SCPARS", (ftnlen)6); - return 0; - } - -/* Find the partition that this clock time falls in. */ - - -/* Read the partition start and stop times (in ticks) for this */ -/* mission. Error if there are too many of them. */ - - scpart_(sc, &nparts, pstart, pstop); - if (failed_()) { - chkout_("SCPARS", (ftnlen)6); - return 0; - } - if (nparts > 9999) { - setmsg_("The number of partitions, #, for spacecraft # exceeds the v" - "alue for parameter MXPART, #.", (ftnlen)88); - errint_("#", &nparts, (ftnlen)1); - errint_("#", sc, (ftnlen)1); - errint_("#", &c__9999, (ftnlen)1); - sigerr_("SPICE(TOOMANYPARTS)", (ftnlen)19); - chkout_("SCPARS", (ftnlen)6); - return 0; - } - -/* For each partition, compute the total number of ticks in that */ -/* partition plus all preceding partitions. */ - - d__1 = pstop[0] - pstart[0]; - ptotls[0] = d_nint(&d__1); - i__1 = nparts; - for (i__ = 2; i__ <= i__1; ++i__) { - d__1 = ptotls[(i__3 = i__ - 2) < 9999 && 0 <= i__3 ? i__3 : s_rnge( - "ptotls", i__3, "scpars_", (ftnlen)588)] + pstop[(i__4 = i__ - - 1) < 9999 && 0 <= i__4 ? i__4 : s_rnge("pstop", i__4, "scp" - "ars_", (ftnlen)588)] - pstart[(i__5 = i__ - 1) < 9999 && 0 <= - i__5 ? i__5 : s_rnge("pstart", i__5, "scpars_", (ftnlen)588)]; - ptotls[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", - i__2, "scpars_", (ftnlen)588)] = d_nint(&d__1); - } - -/* Determine the partition number for the input clock string: */ - -/* If it was included in the string make sure it's valid for */ -/* this mission. */ - -/* Error if */ - -/* 1) The partition number can't be parsed. */ - -/* 2) The partition number is not in the range 1 to the number */ -/* of partitions. */ - -/* 3) The clock count does not fall in the boundaries of the */ -/* specified partition. */ - -/* If it wasn't included, determine the default partition for */ -/* this clock count. */ - -/* Error if */ - -/* 1) The clock count does not fall in the boundaries of any */ -/* of the partitions. */ - - - if (pos == 1) { - -/* The slash character is first character in the string which */ -/* means that the partition number is not there. */ - - s_copy(msg, "Unable to parse the partition number from SCLK string #." - , msg_len, (ftnlen)56); - repmc_(msg, "#", sclkch, msg, msg_len, (ftnlen)1, sclkch_len, msg_len) - ; - chkout_("SCPARS", (ftnlen)6); - return 0; - } else if (pos > 1) { - -/* Try to parse the partition number. */ - - part = 0; - nparsi_(sclkch, &part, strerr, &pnter, pos - 1, (ftnlen)255); - -/* Make sure that the number parsed is correct. */ - - if (s_cmp(strerr, " ", (ftnlen)255, (ftnlen)1) != 0) { - -/* Was not able to parse a number. */ - - s_copy(msg, "Unable to parse the partition number from SCLK stri" - "ng #.", msg_len, (ftnlen)56); - repmc_(msg, "#", sclkch, msg, msg_len, (ftnlen)1, sclkch_len, - msg_len); - chkout_("SCPARS", (ftnlen)6); - return 0; - } else if (part <= 0 || part > nparts) { - -/* The parsed number does not fall in the range of valid */ -/* numbers. */ - - s_copy(msg, "Partition number # taken from SCLK string # is not " - "in acceptable range 1 to #.", msg_len, (ftnlen)78); - repmi_(msg, "#", &part, msg, msg_len, (ftnlen)1, msg_len); - repmc_(msg, "#", sclkch, msg, msg_len, (ftnlen)1, sclkch_len, - msg_len); - repmi_(msg, "#", &nparts, msg, msg_len, (ftnlen)1, msg_len); - chkout_("SCPARS", (ftnlen)6); - return 0; - } else if (ticks < pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? - i__1 : s_rnge("pstart", i__1, "scpars_", (ftnlen)673)] || - ticks > pstop[(i__2 = part - 1) < 9999 && 0 <= i__2 ? i__2 : - s_rnge("pstop", i__2, "scpars_", (ftnlen)673)]) { - -/* The TICKS value does not fall in the range of valid */ -/* values for the partition number parsed from the input */ -/* clock string. */ - - s_copy(msg, "SCLK count from # does not fall in the boundaries o" - "f partition number #.", msg_len, (ftnlen)72); - i__1 = pos; - repmc_(msg, "#", sclkch + i__1, msg, msg_len, (ftnlen)1, - sclkch_len - i__1, msg_len); - repmi_(msg, "#", &part, msg, msg_len, (ftnlen)1, msg_len); - chkout_("SCPARS", (ftnlen)6); - return 0; - } - } else { - -/* The partition number was not included in the string. */ -/* Determine the partition from the TICKS value that the */ -/* clock string converted to. */ - - part = 1; - while(part <= nparts && (ticks < pstart[(i__1 = part - 1) < 9999 && 0 - <= i__1 ? i__1 : s_rnge("pstart", i__1, "scpars_", (ftnlen) - 702)] || ticks > pstop[(i__2 = part - 1) < 9999 && 0 <= i__2 ? - i__2 : s_rnge("pstop", i__2, "scpars_", (ftnlen)702)])) { - ++part; - } - if (part > nparts) { - s_copy(msg, "SCLK count # does not fall in the boundaries of any" - " of the partitions for spacecraft #.", msg_len, (ftnlen) - 87); - i__1 = pos; - repmc_(msg, "#", sclkch + i__1, msg, msg_len, (ftnlen)1, - sclkch_len - i__1, msg_len); - repmi_(msg, "#", sc, msg, msg_len, (ftnlen)1, msg_len); - chkout_("SCPARS", (ftnlen)6); - return 0; - } - } - -/* Now we have a valid partition number, and the number of ticks for */ -/* the clock string. To convert to ticks since the start of the */ -/* mission, add in the total number of ticks in preceding partitions */ -/* and subtract off the starting ticks value for this partition. */ - - if (part > 1) { - *sclkdp = ticks - pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 - : s_rnge("pstart", i__1, "scpars_", (ftnlen)733)] + ptotls[( - i__2 = part - 2) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", - i__2, "scpars_", (ftnlen)733)]; - } else { - *sclkdp = ticks - pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 - : s_rnge("pstart", i__1, "scpars_", (ftnlen)735)]; - } - *error = FALSE_; - s_copy(msg, " ", msg_len, (ftnlen)1); - chkout_("SCPARS", (ftnlen)6); - return 0; -} /* scpars_ */ - diff --git a/ext/spice/src/cspice/scpart.c b/ext/spice/src/cspice/scpart.c deleted file mode 100644 index 244ad87c6a..0000000000 --- a/ext/spice/src/cspice/scpart.c +++ /dev/null @@ -1,447 +0,0 @@ -/* scpart.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__2 = 2; -static integer c__9999 = 9999; - -/* $Procedure SCPART ( Spacecraft Clock Partition Information ) */ -/* Subroutine */ int scpart_(integer *sc, integer *nparts, doublereal *pstart, - doublereal *pstop) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical nodata = TRUE_; - static integer oldsc = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - double d_nint(doublereal *); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int scld01_(char *, integer *, integer *, integer - *, doublereal *, ftnlen), chkin_(char *, ftnlen), repmi_(char *, - char *, integer *, char *, ftnlen, ftnlen, ftnlen); - static doublereal prtsa[9999], prtso[9999]; - extern logical failed_(void); - char kvname[60*2]; - logical update; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), cvpool_(char *, logical *, ftnlen), setmsg_(char *, - ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen), - errint_(char *, integer *, ftnlen); - integer nprtsa; - extern logical return_(void); - extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen, - ftnlen); - integer nprtso; - static integer lstprt; - -/* $ Abstract */ - -/* Get spacecraft clock partition information from a spacecraft */ -/* clock kernel file. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* NPARTS O The number of spacecraft clock partitions. */ -/* PSTART O Array of partition start times. */ -/* PSTOP O Array of partition stop times. */ -/* MXPART P Maximum number of partitions. */ - -/* $ Detailed_Input */ - -/* SC is the NAIF ID for the spacecraft whose clock partition */ -/* information is being requested. */ - -/* $ Detailed_Output */ - -/* NPARTS is the number of spacecraft clock time partitions */ -/* described in the kernel file for spacecraft SC. */ - -/* PSTART is an array containing NPARTS partition start times */ -/* represented as encoded ticks. The values contained */ -/* in PSTART are whole numbers. */ - -/* PSTOP is an array containing NPARTS partition end times */ -/* represented as encoded ticks. The values contained */ -/* in PSTOP are whole numbers. */ - -/* $ Parameters */ - -/* MXPART is the maximum number of partitions for any spacecraft */ -/* clock. SCLK kernels contain start and stop times for */ -/* each partition. See the INCLUDE file sclk.inc for this */ -/* parameter's value. */ - -/* $ Exceptions */ - -/* 1) If the kernel variables containing the spacecraft clock */ -/* partition start and stop times have not been loaded in the */ -/* kernel pool, the error will be diagnosed by routines called */ -/* by this routine. */ - -/* 2) If the number of start and stop times are different then */ -/* the error SPICE(NUMPARTSUNEQUAL) is signaled. */ - -/* $ Files */ - -/* An SCLK kernel containing spacecraft clock partition start */ -/* and stop times for the spacecraft clock indicated by SC must */ -/* be loaded into the kernel pool. */ - -/* $ Particulars */ - -/* SCPART looks for two variables in the kernel pool for each */ -/* spacecraft's partition information. If SC = -nn, then the names of */ -/* the variables are */ - -/* 'SCLK_PARTITION_START_nn' and */ -/* 'SCLK_PARTITION_END_nn'. */ - -/* The start and stop times returned are in encoded units of "ticks". */ - -/* $ Examples */ - -/* 1) The following program fragment finds and prints out partition */ -/* start and stop times in clock format for the Galileo mission. */ -/* In this example, Galileo partition times are assumed to be */ -/* in the kernel file SCLK.KER. */ - -/* CHARACTER*(30) START */ -/* CHARACTER*(30) STOP */ - -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* SC = -77 */ - -/* CALL SCPART ( SC, NPARTS, PSTART, PSTOP ) */ - -/* DO I = 1, NPARTS */ - -/* CALL SCFMT ( SC, PSTART( I ), START ) */ -/* CALL SCFMT ( SC, PSTOP ( I ), STOP ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Partition ', I, ':' */ -/* WRITE (*,*) 'Start = ', START */ -/* WRITE (*,*) 'Stop = ', STOP */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) This routine assumes that an SCLK kernel appropriate to the */ -/* spacecraft identified by SC has been loaded into the kernel */ -/* pool. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */ - -/* The values of the parameter MXPART is now */ -/* provided by the INCLUDE file sclk.inc. */ - -/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.1.0, 22-MAR-1993 (JML) */ - -/* The routine now uses the kernel pool watch capability. */ - -/* - 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, 03-SEP-1990 (NJB) (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* spacecraft_clock partition information */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SCPART", (ftnlen)6); - -/* On the first pass through the subroutine, or if the */ -/* spacecraft code changes, set watches on the SCLK kernel */ -/* variables for the current clock. */ - - if (first || *sc != oldsc) { - -/* Make up a list of names of kernel variables that we'll use. */ - - s_copy(kvname, "SCLK_PARTITION_START", (ftnlen)60, (ftnlen)20); - s_copy(kvname + 60, "SCLK_PARTITION_END", (ftnlen)60, (ftnlen)18); - for (i__ = 1; i__ <= 2; ++i__) { - suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("kvname", i__1, "scpart_", (ftnlen)270)) * - 60, (ftnlen)2, (ftnlen)60); - i__3 = -(*sc); - repmi_(kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("kvname", i__1, "scpart_", (ftnlen)271)) * 60, - "#", &i__3, kvname + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("kvname", i__2, "scpart_", (ftnlen)271)) * - 60, (ftnlen)60, (ftnlen)1, (ftnlen)60); - } - -/* Set a watch on all of the kernel variables used. */ - - swpool_("SCPART", &c__2, kvname, (ftnlen)6, (ftnlen)60); - -/* Keep track of the last spacecraft ID encountered. */ - - oldsc = *sc; - first = FALSE_; - } - -/* If any of the kernel pool variables that this routine uses */ -/* have been updated, or if the spacecraft ID changes, look up */ -/* the new values from the kernel pool. */ - - cvpool_("SCPART", &update, (ftnlen)6); - if (update || nodata) { - -/* Read the values from the kernel pool. */ - - scld01_("SCLK_PARTITION_START", sc, &c__9999, &nprtsa, prtsa, (ftnlen) - 20); - scld01_("SCLK_PARTITION_END", sc, &c__9999, &nprtso, prtso, (ftnlen) - 18); - if (failed_()) { - nodata = TRUE_; - chkout_("SCPART", (ftnlen)6); - return 0; - } - -/* Error checking. */ - - if (nprtsa != nprtso) { - nodata = TRUE_; - setmsg_("The number of partition start and stop times are unequa" - "l for spacecraft #. ", (ftnlen)78); - errint_("#", sc, (ftnlen)1); - sigerr_("SPICE(NUMPARTSUNEQUAL)", (ftnlen)22); - chkout_("SCPART", (ftnlen)6); - return 0; - } - -/* At this point we have the data we sought. We need not */ -/* perform another kernel pool look-up unless there's */ -/* a kernel pool update or change in the SCLK ID. */ - - nodata = FALSE_; - -/* Buffer the number of partitions and the partition start */ -/* and stop times. */ - - lstprt = nprtsa; - -/* The partition start and stop times must be whole numbers. */ - - i__1 = lstprt; - for (i__ = 1; i__ <= i__1; ++i__) { - prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtsa" - , i__2, "scpart_", (ftnlen)341)] = d_nint(&prtsa[(i__3 = - i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtsa", - i__3, "scpart_", (ftnlen)341)]); - prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtso" - , i__2, "scpart_", (ftnlen)342)] = d_nint(&prtso[(i__3 = - i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtso", - i__3, "scpart_", (ftnlen)342)]); - } - } - -/* Copy the values in local buffers to the output arguments. */ - - *nparts = lstprt; - i__1 = *nparts; - for (i__ = 1; i__ <= i__1; ++i__) { - pstart[i__ - 1] = prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : - s_rnge("prtsa", i__2, "scpart_", (ftnlen)353)]; - pstop[i__ - 1] = prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : - s_rnge("prtso", i__2, "scpart_", (ftnlen)354)]; - } - chkout_("SCPART", (ftnlen)6); - return 0; -} /* scpart_ */ - diff --git a/ext/spice/src/cspice/scpart_c.c b/ext/spice/src/cspice/scpart_c.c deleted file mode 100644 index 839196f3c5..0000000000 --- a/ext/spice/src/cspice/scpart_c.c +++ /dev/null @@ -1,228 +0,0 @@ -/* - --Procedure scpart_c ( Spacecraft Clock Partition Information ) - --Abstract - - Get spacecraft clock partition information from a spacecraft - clock kernel file. - --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 - - SCLK - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void scpart_c ( SpiceInt sc, - SpiceInt * nparts, - SpiceDouble * pstart, - SpiceDouble * pstop ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft identification code. - nparts O The number of spacecraft clock partitions. - pstart O Array of partition start times. - pstop O Array of partition stop times. - MXPART P Maximum number of partitions. - --Detailed_Input - - sc is the NAIF ID for the spacecraft whose clock partition - information is being requested. - --Detailed_Output - - nparts is the number of spacecraft clock time partitions - described in the kernel file for spacecraft SC. - - pstart is an array containing nparts partition start times - represented as encoded ticks. The values contained - in pstart are whole numbers. - - pstop is an array containing nparts partition end times - represented as encoded ticks. The values contained - in pstop are whole numbers. - --Parameters - - MXPART is the maximum number of partitions for any - spacecraft clock. MXPART is currently set to - 9999. - --Exceptions - - 1) If the kernel variables containing the spacecraft clock - partition start and stop times have not been loaded in the - kernel pool, the error will be diagnosed by routines called - by this routine. - - 2) If the number of start and stop times are different then - the error SPICE(NUMPARTSUNEQUAL) is signalled. - --Files - - An SCLK kernel containing spacecraft clock partition start - and stop times for the spacecraft clock indicated by SC must - be loaded into the kernel pool before this routine may be called. - --Particulars - - scpart_c looks for two variables in the kernel pool for each - spacecraft's partition information. If sc = -nn, then the names of - the variables are - - "SCLK_PARTITION_START_nn" - "SCLK_PARTITION_END_nn" - - The start and stop times returned are in encoded units of "ticks." - --Examples - - 1) The following program fragment finds and prints out partition - start and stop times in clock format for the Galileo mission. - In this example, Galileo partition times are assumed to be - in the kernel file sclk.ker. - - #include - #include "SpiceUsr.h" - - void main() - { - #define CLKLEN 30 - #define SC -32 - #define MXPART 9999 - - SpiceChar start [ CLKLEN ]; - SpiceChar stop [ CLKLEN ]; - SpiceDouble pstart [ MXPART ]; - SpiceDouble pstop [ MXPART ]; - - SpiceInt nparts; - SpiceInt i; - - - furnsh_c ( "sclk.ker" ); - - scpart_c ( SC, &nparts, pstart, pstop ); - - for ( i = 0; i < nparts; i++ ) - { - scfmt_c ( SC, pstart[ i ], CLKLEN, start ); - scfmt_c ( SC, pstop [ i ], CLKLEN, stop ); - - printf ( "\n" - "Partition %d:\n" - "Start = %s\n" - "Stop = %s\n" - "\n", - i, - start, - stop ); - } - } - - - --Restrictions - - 1) This routine assumes that an SCLK kernel appropriate to the - spacecraft identified by SC has been loaded into the kernel - pool. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.M. Lynch (JPL) - R.E. Thurman (JPL) - --Version - - -CSPICE Version 1.1.0, 11-FEB-2008 (NJB) - - Definition of constant macro MXPART was deleted. - Documentation was updated to reflect current - MXPART value of 9999. - - -CSPICE Version 1.0.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.1.0, 22-MAR-1993 (JML) - --Index_Entries - - spacecraft_clock partition information - --& -*/ - -{ /* Begin scpart_c */ - - /* - Participate in error handling - */ - chkin_c ( "scpart_c"); - - /* - Unlike most of the wrappers, this one reads the - partition data directly into the callers' buffers. - - We rely on the scpart_ to check for an excessive - partition count. - */ - - scpart_ ( ( integer * ) &sc, - ( integer * ) nparts, - ( doublereal * ) pstart, - ( doublereal * ) pstop ); - - - - - chkout_c ( "scpart_c"); - - -} /* End scpart_c */ diff --git a/ext/spice/src/cspice/scps01.c b/ext/spice/src/cspice/scps01.c deleted file mode 100644 index c264142ad1..0000000000 --- a/ext/spice/src/cspice/scps01.c +++ /dev/null @@ -1,627 +0,0 @@ -/* scps01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; - -/* $Procedure SCPS01 ( Convert type 1 SCLK string to ticks ) */ -/* Subroutine */ int scps01_(integer *sc, char *clkstr, logical *error, char * - msg, doublereal *ticks, ftnlen clkstr_len, ftnlen msg_len) -{ - /* Initialized data */ - - static char namlst[60*3] = "SCLK01_N_FIELDS " - " " "SCLK01_OFFSETS " - " " "SCLK01_MODULI " - " "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - double d_nint(doublereal *); - - /* Local variables */ - static integer pntr, i__, n; - extern /* Subroutine */ int scld01_(char *, integer *, integer *, integer - *, doublereal *, ftnlen), scli01_(char *, integer *, integer *, - integer *, integer *, ftnlen), chkin_(char *, ftnlen), repmc_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), - repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen); - extern logical failed_(void); - static integer nfield; - static doublereal cmpval[10], moduli[10], offset[10]; - extern /* Subroutine */ int chkout_(char *, ftnlen), lparsm_(char *, char - *, integer *, integer *, char *, ftnlen, ftnlen, ftnlen); - static doublereal cmptks[10]; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - extern logical return_(void); - static char strerr[240], cmp[30*10]; - -/* $ Abstract */ - -/* Convert a character representation of a type 1 spacecraft clock */ -/* count to ticks. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file sclk.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define sizes and limits used by */ -/* the SCLK system. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* See the declaration section below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ - -/* Increased value of maximum coefficient record count */ -/* parameter MXCOEF from 10K to 50K. */ - -/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ - -/* -& */ - -/* Number of supported SCLK field delimiters: */ - - -/* Supported SCLK string field delimiters: */ - - -/* Maximum number of partitions: */ - - -/* Partition string length. */ - -/* Since the maximum number of partitions is given by MXPART is */ -/* 9999, PRTSTR needs at most 4 characters for the partition number */ -/* and one character for the slash. */ - - -/* Maximum number of coefficient records: */ - - -/* Maximum number of fields in an SCLK string: */ - - -/* Length of strings used to represent D.P. */ -/* numbers: */ - - -/* Maximum number of supported parallel time systems: */ - - -/* End of include file sclk.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* CLKSTR I Character representation of a clock count. */ -/* ERROR O Parsing error flag. */ -/* MSG O Output message for parsing error. */ -/* TICKS O Number of ticks represented by the clock count. */ -/* MXNFLD P Maximum number of allowed fields in an SCLK string. */ -/* DELIMS P The accepted delimiters of an SCLK string. */ -/* DPLEN P Maximum width of a clock field. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF spacecraft identification code. See the */ -/* `Examples' section below, and also the NAIF_IDS */ -/* required reading file for a complete list of body ID */ -/* codes. */ - - -/* CLKSTR on input is the character representation of a */ -/* spacecraft clock count (SCLK), without a partition */ -/* number. */ - -/* Using Galileo as an example, a SCLK string without */ -/* a partition number has the form */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time */ -/* Image Count (RIM), which increments once every time */ -/* xx turns over, i.e., once every 60 2/3 seconds. The */ -/* roll-over expression for the RIM is 16777215, which */ -/* corresponds to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft count. */ -/* SCLK components may be separated by any of the */ -/* single character delimiters in the string DELIMS, with */ -/* any number of spaces separating the components and */ -/* the delimiters. The presence of the RIM component */ -/* is required. Successive components may be omitted, and */ -/* in such cases are assumed to represent zero values. */ - -/* Values for the individual components may exceed the */ -/* maximum expected values. For instance, '0:0:0:9' is */ -/* an acceptable Galileo clock string, and indicates the */ -/* same time interval as '0:0:1:1'. */ - -/* Consecutive delimiters containing no intervening digits */ -/* are treated as if they delimit zero components, except */ -/* in the case of blanks. Consecutive blanks are treated */ -/* as a single blank. */ - -/* Trailing zeros should always be included to match the */ -/* length of the counter. For example, a Galileo clock */ -/* count of '25684.90' should not be represented as */ -/* '25684.9'. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Galileo, Mars Observer, and Voyager */ -/* clock formats. */ - -/* See the `Examples' section in SCPS01, below. */ - -/* $ Detailed_Output */ - -/* ERROR is true if an error occurred parsing the input clock */ -/* string and converting it to ticks. */ - -/* MSG is the message generated if an error occurred parsing */ -/* the input clock string. */ - -/* TICKS is the number of "ticks" corresponding to the input */ -/* spacecraft clock string CLKSTR. "Ticks" are the units */ -/* in which encoded SCLK strings are represented. */ - -/* A typical Galileo SCLK string looks like */ - -/* 'wwwwwwww xx y z', */ - -/* as described above. Since z is the mod-8 (one tick) */ -/* counter, the number of ticks represented by y is 8*y. */ -/* And since y is the mod-10 counter, the number of ticks */ -/* represented by xx is 10*8*xx. The total number of */ -/* ticks represented by the above string is */ - -/* wwwwwwww( 7280 ) + */ -/* xx( 80 ) + */ -/* y( 8 ) + */ -/* z */ - -/* Clock strings for other spacecraft are converted in */ -/* a similar manner. */ - -/* See Examples below. */ - -/* $ Parameters */ - -/* See the INCLUDE file sclk.inc. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument TICKS will not */ -/* be modified. */ - -/* The variables that must be set by the SCLK kernel are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The output delimiter code */ -/* - The parallel time system code */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ -/* - The SCLK coefficients array */ -/* - The partition start times */ -/* - The partition end times */ - -/* When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument TICKS will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - - -/* 2) If any of the following kernel variables have invalid values, */ -/* the error will be diagnosed by routines called by this */ -/* routine: */ - -/* - The time system code */ -/* - The number of SCLK coefficients */ -/* - The number of partition start times */ -/* - The number of partition end times */ -/* - The number of fields of a SCLK string */ -/* - The number of moduli for a SCLK string */ - -/* If the number of values for any item read from the kernel */ -/* pool exceeds the maximum allowed value, it is may not be */ -/* possible to diagnose the error correctly, since overwriting */ -/* of memory may occur. This particular type of error is not */ -/* diagnosed by this routine. */ - - -/* 3) The input argument CLKSTR may be invalid for a variety of */ -/* reasons: */ - -/* -- One of the extracted clock components cannot be parsed */ -/* as an integer */ - -/* -- CLKSTR contains too many components */ - -/* -- the value of one of the components is less than the */ -/* offset value */ - -/* If any of these conditions is detected, the error */ -/* SPICE(INVALIDSCLKSTRING) is signaled. The output argument */ -/* TICKS will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts a character string representation of a */ -/* spacecraft clock count into the number of ticks represented */ -/* by the clock count. An important distinction between this type */ -/* of conversion and that carried out by SCENCD is that this routine */ -/* treats spacecraft clock times as representations of time */ -/* intervals, not absolute times. */ - -/* This routine does not make use of any partition information. */ -/* See SCENCD for details on how to make use of partition numbers. */ - -/* $ Examples */ - -/* 1) Below are some examples illustrating various inputs and the */ -/* resulting outputs for the Galileo spacecraft. */ - -/* CLKSTR TICKS */ -/* ---------------- -------------------- */ -/* '0:0:0:1' 1 */ -/* '0:0:1' 8 */ -/* '0:1' 80 */ -/* '1' 7280 */ -/* '1 0 0 0' 7280 */ -/* '1,0,0,0' 7280 */ -/* '1:90' 14480 */ -/* '1:9' 8000 */ -/* '1:09' 8000 */ -/* '0-0-10' 80 |-- Third component is supposed */ -/* '0-1-0' 80 | to be a mod-10 count. */ -/* '0/1/0' Error: '/' is not an accepted delimiter. */ -/* '1: 00 : 0 : 1' 7281 */ -/* '1:::1' 7281 */ -/* '1.1.1.1.1' Error: Too many components */ -/* '1.1.1.1.' Error: The last delimiter signals that */ -/* a fifth component will follow. */ - - -/* The following examples are for the Voyager 2 spacecraft. Note */ -/* that the last component of the Voyager clock has an offset */ -/* value of 1. */ - -/* CLKSTR TICKS */ -/* ---------------- -------------------- */ -/* '0.0.001' 0 */ -/* '0:0:002' 1 */ -/* '0:01' 800 */ -/* '1' 48000 */ -/* '1.0' 48000 */ -/* '1.0.0' Error: The 3rd component is never 0. */ -/* '0.0:100' 99 */ -/* '0-60-1' 48000 */ -/* '1-1-1' 48800 */ -/* '1-1-2' 48801 */ - - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 11-FEB-2008 (NJB) */ - -/* Global parameters are now declared in the Fortran */ -/* INCLUDE file sclk.inc. */ - -/* - SPICELIB Version 1.0.0, 25-FEB-1993 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert type_1 spacecraft_clock string to ticks */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Following are parameters for the indices within the */ -/* array NAMLST of the kernel variable names. */ - - -/* Local variables */ - - -/* Save everything */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCPS01", (ftnlen)6); - } - -/* Start off with the error flag and message set for a regular */ -/* SPICE error. */ - - *error = TRUE_; - s_copy(msg, "SPICELIB error detected.", msg_len, (ftnlen)24); - -/* Our first piece of business is to look up all of the data */ -/* we require from the kernel pool. We must form the names */ -/* of the items we want using the input S/C ID code. The items */ -/* we need are: */ - -/* - The number of fields in an (unabridged) SCLK string */ -/* - The moduli of the fields of an SCLK string */ -/* - The offsets for each clock field. */ - - scli01_(namlst, sc, &c__10, &n, &nfield, (ftnlen)60); - scld01_(namlst + 120, sc, &c__10, &n, moduli, (ftnlen)60); - scld01_(namlst + 60, sc, &c__10, &n, offset, (ftnlen)60); - -/* Don't try to continue if we had a lookup error. */ - - if (failed_()) { - chkout_("SCPS01", (ftnlen)6); - return 0; - } - -/* If our clock string is blank, we can stop now. */ - - if (s_cmp(clkstr, " ", clkstr_len, (ftnlen)1) == 0) { - s_copy(msg, "Non partition part of the input clock string is blank.", - msg_len, (ftnlen)54); - *error = TRUE_; - chkout_("SCPS01", (ftnlen)6); - return 0; - } - -/* Determine how many ticks is each field is worth. */ - - cmptks[(i__1 = nfield - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmptks", - i__1, "scps01_", (ftnlen)464)] = 1.; - for (i__ = nfield - 1; i__ >= 1; --i__) { - cmptks[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("cmptks", - i__1, "scps01_", (ftnlen)467)] = cmptks[(i__2 = i__) < 10 && - 0 <= i__2 ? i__2 : s_rnge("cmptks", i__2, "scps01_", (ftnlen) - 467)] * moduli[(i__3 = i__) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "moduli", i__3, "scps01_", (ftnlen)467)]; - } - -/* Parse the clock components from the input string. There should */ -/* be at most NFIELD of them, but, in order to check for too long */ -/* a clock string, we'll let LPARSM take up to MXNFLD components and */ -/* then test for an error. */ - - lparsm_(clkstr, ".:-, ", &c__10, &n, cmp, clkstr_len, (ftnlen)5, (ftnlen) - 30); - -/* If the string has too many fields for the specified spacecraft */ -/* then signal an error. */ - - if (n > nfield) { - *error = TRUE_; - s_copy(msg, "Input clock string # has # fields; maximum for this spa" - "cecraft clock is #.", msg_len, (ftnlen)74); - repmc_(msg, "#", clkstr, msg, msg_len, (ftnlen)1, clkstr_len, msg_len) - ; - repmi_(msg, "#", &n, msg, msg_len, (ftnlen)1, msg_len); - repmi_(msg, "#", &nfield, msg, msg_len, (ftnlen)1, msg_len); - chkout_("SCPS01", (ftnlen)6); - return 0; - } - -/* Convert each of the components into numbers. Error if any */ -/* of the conversions screw up. */ - - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "scps01_", (ftnlen)504)) * 30, " ", (ftnlen)30, ( - ftnlen)1) == 0) { - cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmpval" - , i__2, "scps01_", (ftnlen)505)] = offset[(i__3 = i__ - 1) - < 10 && 0 <= i__3 ? i__3 : s_rnge("offset", i__3, "scps" - "01_", (ftnlen)505)]; - } else { - nparsd_(cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmp", i__2, "scps01_", (ftnlen)507)) * 30, &cmpval[(i__3 - = i__ - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("cmpval", - i__3, "scps01_", (ftnlen)507)], strerr, &pntr, (ftnlen)30, - (ftnlen)240); - } - if (s_cmp(strerr, " ", (ftnlen)240, (ftnlen)1) != 0) { - *error = TRUE_; - s_copy(msg, "Could not parse SCLK component # from # as a number." - , msg_len, (ftnlen)52); - repmc_(msg, "#", cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 - : s_rnge("cmp", i__2, "scps01_", (ftnlen)517)) * 30, msg, - msg_len, (ftnlen)1, (ftnlen)30, msg_len); - repmc_(msg, "#", clkstr, msg, msg_len, (ftnlen)1, clkstr_len, - msg_len); - chkout_("SCPS01", (ftnlen)6); - return 0; - } - -/* Subtract off the offset value so that we can do base ten */ -/* arithmetic. Also, if any of the components become negative */ -/* as a result of the subtraction, then that component must */ -/* have been invalid. */ - - cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("cmpval", - i__2, "scps01_", (ftnlen)531)] = cmpval[(i__3 = i__ - 1) < 10 - && 0 <= i__3 ? i__3 : s_rnge("cmpval", i__3, "scps01_", ( - ftnlen)531)] - offset[(i__4 = i__ - 1) < 10 && 0 <= i__4 ? - i__4 : s_rnge("offset", i__4, "scps01_", (ftnlen)531)]; - if (d_nint(&cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmpval", i__2, "scps01_", (ftnlen)533)]) < 0.) { - *error = TRUE_; - s_copy(msg, "Component number #, # in the SCLK string # is inva" - "lid.", msg_len, (ftnlen)55); - repmi_(msg, "#", &i__, msg, msg_len, (ftnlen)1, msg_len); - repmc_(msg, "#", cmp + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 - : s_rnge("cmp", i__2, "scps01_", (ftnlen)541)) * 30, msg, - msg_len, (ftnlen)1, (ftnlen)30, msg_len); - repmc_(msg, "#", clkstr, msg, msg_len, (ftnlen)1, clkstr_len, - msg_len); - chkout_("SCPS01", (ftnlen)6); - return 0; - } - } - -/* Convert to ticks by multiplying the value of each component by */ -/* the number of ticks each component count represents, and then */ -/* add up the results. */ - - *ticks = 0.; - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - *ticks += cmpval[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "cmpval", i__2, "scps01_", (ftnlen)559)] * cmptks[(i__3 = i__ - - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("cmptks", i__3, "scps" - "01_", (ftnlen)559)]; - } - *error = FALSE_; - s_copy(msg, " ", msg_len, (ftnlen)1); - chkout_("SCPS01", (ftnlen)6); - return 0; -} /* scps01_ */ - diff --git a/ext/spice/src/cspice/scs2e.c b/ext/spice/src/cspice/scs2e.c deleted file mode 100644 index 8a9385c0ee..0000000000 --- a/ext/spice/src/cspice/scs2e.c +++ /dev/null @@ -1,296 +0,0 @@ -/* scs2e.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCS2E ( SCLK string to ET ) */ -/* Subroutine */ int scs2e_(integer *sc, char *sclkch, doublereal *et, ftnlen - sclkch_len) -{ - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *), - chkin_(char *, ftnlen), scencd_(integer *, char *, doublereal *, - ftnlen); - doublereal sclkdp; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert a spacecraft clock string to ephemeris seconds past */ -/* J2000 (ET). */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF integer code for a spacecraft. */ -/* SCLKCH I An SCLK string. */ -/* ET O Ephemeris time, seconds past J2000. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF ID code for a spacecraft, one of whose */ -/* clock values is represented by SCLKCH. The set of */ -/* supported spacecraft clocks is listed in the SCLK */ -/* Required Reading. */ - -/* SCLKCH is a character string representation of the */ -/* spacecraft clock value that corresponds to ET, for */ -/* the spacecraft specified by the input argument SC. */ -/* SCLKCH is an absolute spacecraft clock time, so */ -/* partition information should be included in this */ -/* string. The precise format of SCLKCH is specified */ -/* in the SCLK Required Reading. */ - -/* $ Detailed_Output */ - -/* ET is the epoch, specified as ephemeris seconds past */ -/* J2000, that corresponds to SCLKCH. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument ET will not */ -/* be modified. */ - -/* 2) When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument ET will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - - -/* 3) Invalid values of SCLKCH will be diagnosed by routines called */ -/* by this routine. The output argument ET will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is provided as a convenience; it is simply shorthand */ -/* for the code fragment */ - -/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */ -/* CALL SCT2E ( SC, SCLKDP, ET ) */ - -/* See the SCLK Required Reading for a list of the entire set of */ -/* SCLK conversion routines. */ - -/* $ Examples */ - -/* 1) Find the state (position and velocity) of Jupiter, as seen */ -/* from the Galileo spacecraft, at the epoch corresponding to */ -/* the SCLK value */ - -/* 2 / 3110578:89:09 */ - -/* The digit `2', followed by the forward slash, indicates that */ -/* the time value is in the second mission partition. */ - - -/* During program initialization, load the leapseconds and */ -/* SCLK kernels. We will pretend that these files are named */ -/* "LEAPSECONDS.KER" and "GLLSCLK.KER". To use this code */ -/* fragment, you must substitute the actual names of these */ -/* kernel files for the names used here. */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'GLLSCLK.KER' ) */ - -/* C */ -/* C Load an SPK file (again, a fictitious file) */ -/* C containing an ephemeris for Jupiter and the */ -/* C GLL orbiter's trajectory. */ -/* C */ -/* CALL SPKLEF ( 'GLLSPK.KER', HANDLE ) */ - -/* The Galileo spacecraft ID is -77. Convert our SCLK */ -/* string to ephemeris seconds past J2000, which is the */ -/* time representation expected by SPKEZ. */ - -/* CALL SCS2E ( -77, '2 / 3110578:89:09', ET ) */ - - -/* Find the state of Jupiter (body 599) as seen from Galileo */ -/* at time ET. To use SPKEZ, you must first load an SPK */ -/* kernel, using the routine SPKLEF. */ - -/* CALL SPKEZ ( 599, */ -/* . ET, */ -/* . REFSYS, */ -/* . CORR, */ -/* . -77, */ -/* . STATE, */ -/* . LT ) */ - - - -/* 2) Convert a Voyager 2 SCLK value to UTC, using calendar format, */ -/* with 3 digits of precision in the seconds component. */ - -/* Again, your initialization code must load the leapseconds */ -/* and SCLK kernels: */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'VGR2SCLK.KER' ) */ - - -/* To find the UTC value corresponding to Voyager 2 SCLK */ -/* string */ - -/* 11389.20.768 */ - -/* you can use the code fragment */ - -/* CALL SCS2E ( -32, '11389.29.768', ET ) */ -/* CALL ET2UTC ( ET, 'C', 3, UTC ) */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* [1] SPK Required Reading */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.0.3, 09-MAR-1999 (NJB) */ - -/* Explicit list of SCLK conversion routines in Particulars */ -/* section has been replaced by a pointer to the SCLK Required */ -/* Reading. */ - -/* - SPICELIB Version 1.0.2, 10-APR-1992 (NJB) (WLT) */ - -/* The $Brief_I/O section now lists ET correctly as an output */ -/* from this routine. Header was updated to reflect possibility */ -/* of needing to load a leapseconds kernel before calling this */ -/* routine. Comment section for permuted index source lines was */ -/* added following the header. */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Restrictions section no longer states that you must load the */ -/* leapseconds kernel prior to calling this routine. */ - -/* The examples have been slightly re-written. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* spacecraft_clock string to ephemeris time */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Restrictions section no longer states that you must load the */ -/* leapseconds kernel prior to calling this routine. */ - -/* The examples have been slightly re-written. In particular, */ -/* they no longer use calls to CLPOOL. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCS2E", (ftnlen)5); - } - -/* Encode SCLKCH, and convert the result to ET. */ - - scencd_(sc, sclkch, &sclkdp, sclkch_len); - sct2e_(sc, &sclkdp, et); - chkout_("SCS2E", (ftnlen)5); - return 0; -} /* scs2e_ */ - diff --git a/ext/spice/src/cspice/scs2e_c.c b/ext/spice/src/cspice/scs2e_c.c deleted file mode 100644 index 2a9b4f2a64..0000000000 --- a/ext/spice/src/cspice/scs2e_c.c +++ /dev/null @@ -1,268 +0,0 @@ -/* - --Procedure scs2e_c ( SCLK string to ET ) - --Abstract - - Convert a spacecraft clock string to ephemeris seconds past - J2000 (ET). - --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 - - SCLK - TIME - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void scs2e_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * et ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF integer code for a spacecraft. - sclkch I An SCLK string. - et O Ephemeris time, seconds past J2000. - --Detailed_Input - - sc is a NAIF ID code for a spacecraft, one of whose - clock values is represented by sclkch. The set of - supported spacecraft clocks is listed in the SCLK - Required Reading. - - sclkch is a character string representation of the - spacecraft clock value that corresponds to ET, for - the spacecraft specified by the input argument sc. - sclkch is an absolute spacecraft clock time, so - partition information should be included in this - string. The precise format of sclkch is specified - in the SCLK Required Reading. - --Detailed_Output - - et is the epoch, specified as ephemeris seconds past - J2000, that corresponds to sclkch. - --Parameters - - None. - --Exceptions - - 1) This routine assumes that that an SCLK kernel appropriate - to the spacecraft clock identified by the input argument SC - has been loaded. If an SCLK kernel has not been loaded, - does not contain all of the required data, or contains - invalid data, error diagnoses will be performed by routines - called by this routine. The output argument et will not - be modified. - - 2) When using SCLK kernels that map SCLK to a time system other - than ET (also called barycentric dynamical time---`TDB'), it - is necessary to have a leapseconds kernel loaded at the time - this routine is called. If a leapseconds kernel is required - for conversion between SCLK and ET but is not loaded, the - error will be diagnosed by routines called by this routine. - The output argument et will not be modified. - - The time system that an SCLK kernel maps SCLK to is indicated - by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn - is the negative of the NAIF integer code for the spacecraft. - The time system used in a kernel is TDB if and only if the - variable is assigned the value 1. - - - 3) Invalid values of sclkch will be diagnosed by routines called - by this routine. The output argument et will not be modified. - --Files - - None. - --Particulars - - This routine is provided as a convenience; it is simply shorthand - for the code fragment - - scencd_c ( sc, sclkch, &sclkdp ); - sct2e_c ( sc, sclkdp, &et ); - --Examples - - 1) Find the state (position and velocity) of Jupiter, as seen - from the Galileo spacecraft, at the epoch corresponding to - the SCLK value - - 2 / 3110578:89:09 - - The digit "2", followed by the forward slash, indicates that - the time value is in the second mission partition. - - - During program initialization, load the leapseconds and - SCLK kernels. We will pretend that these files are named - "leapseconds.ker" and "gllsclk.ker". To use this code - fragment, you must substitute the actual names of these - kernel files for the names used here. - - /. - Load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ); - furnsh_c ( "gllsclk.ker" ); - - /. - Load an SPK file (again, a fictitious file) - containing an ephemeris for Jupiter and the - GLL orbiter's trajectory. - ./ - spklef_c ( "gllspk.ker", &handle ); - - /. - The Galileo spacecraft ID is -77. Convert our SCLK - string to ephemeris seconds past J2000, which is the - time representation expected by spkez_c. - ./ - scs2e_c ( -77, "2 / 3110578:89:09", &et ); - - /. - Find the state of Jupiter (body 599) as seen from Galileo - at time et. To use spkez_c, you must first load an SPK - kernel, using the routine spklef_c. - ./ - spkez_c ( 599, et, refsys, corr, -77, state, < ); - - - - 2) Convert a Voyager 2 SCLK value to UTC, using calendar format, - with 3 digits of precision in the seconds component. - - Again, your initialization code must load the leapseconds - and SCLK kernels: - - /. - Load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ); - furnsh_c ( "vgr2sclk.ker" ); - - - To find the UTC value corresponding to Voyager 2 SCLK - string - - 11389.20.768 - - you can use the code fragment - - scs2e_c ( -32, "11389.29.768", &et ); - et2utc_c ( et, "c", 3, UTCLEN, utc ); - - where UTCLEN is a constant indicating the available - room in the string utc. A value of 25 characters suffices. - --Restrictions - - 1) An SCLK kernel appropriate to the spacecraft clock identified - by SC must be loaded at the time this routine is called. - - 2) If the SCLK kernel used with this routine does not map SCLK - directly to barycentric dynamical time, a leapseconds kernel - must be loaded at the time this routine is called. - --Literature_References - - [1] SPK Required Reading - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.2, 10-APR-1992 (NJB) (WLT) - --Index_Entries - - spacecraft_clock string to ephemeris time - --& -*/ - -{ /* Begin scs2e_c */ - - - /* - Participate in error handling - */ - chkin_c ( "scs2e_c"); - - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "scs2e_c", sclkch ); - - - /* - Carry out the conversion. - */ - scs2e_ ( ( integer * ) &sc, - ( char * ) sclkch, - ( doublereal * ) et, - ( ftnlen ) strlen(sclkch) ); - - - chkout_c ( "scs2e_c"); - -} /* End scs2e_c */ diff --git a/ext/spice/src/cspice/sct2e.c b/ext/spice/src/cspice/sct2e.c deleted file mode 100644 index 62464056cd..0000000000 --- a/ext/spice/src/cspice/sct2e.c +++ /dev/null @@ -1,334 +0,0 @@ -/* sct2e.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCT2E ( SCLK ticks to ET ) */ -/* Subroutine */ int sct2e_(integer *sc, doublereal *sclkdp, doublereal *et) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scte01_(integer *, - doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer - *, ftnlen); - extern integer sctype_(integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert encoded spacecraft clock (`ticks') to ephemeris */ -/* seconds past J2000 (ET). */ - -/* $ 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 */ - -/* SCLK */ -/* TIME */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ -/* SCLKDP I SCLK, encoded as ticks since spacecraft clock */ -/* start. */ -/* ET O Ephemeris time, seconds past J2000. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF integer code for a spacecraft, one of */ -/* whose encoded clock values is represented by */ -/* SCLKDP. */ - -/* SCLKDP is an encoded spacecraft clock value. SCLKDP */ -/* represents time measured from spacecraft clock */ -/* start: partition information IS reflected in the */ -/* encoded value. */ - -/* $ Detailed_Output */ - -/* ET is the epoch, specified as ephemeris seconds past */ -/* J2000, that corresponds to SCLKDP. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine assumes that that an SCLK kernel appropriate */ -/* to the spacecraft clock identified by the input argument SC */ -/* has been loaded. If an SCLK kernel has not been loaded, */ -/* does not contain all of the required data, or contains */ -/* invalid data, error diagnoses will be performed by routines */ -/* called by this routine. The output argument ET will not be */ -/* modified. */ - -/* 2) When using SCLK kernels that map SCLK to a time system other */ -/* than ET (also called barycentric dynamical time---`TDB'), it */ -/* is necessary to have a leapseconds kernel loaded at the time */ -/* this routine is called. If a leapseconds kernel is required */ -/* for conversion between SCLK and ET but is not loaded, the */ -/* error will be diagnosed by routines called by this routine. */ -/* The output argument ET will not be modified. */ - -/* The time system that an SCLK kernel maps SCLK to is indicated */ -/* by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn */ -/* is the negative of the NAIF integer code for the spacecraft. */ -/* The time system used in a kernel is TDB if and only if the */ -/* variable is assigned the value 1. */ - - -/* 3) If the clock type for the spacecraft clock identified by */ -/* SC is not supported by this routine, the error */ -/* SPICE(NOTSUPPORTED) is signalled. The output argument ET */ -/* will not be modified. */ - -/* 4) If the input argument SCLKDP is invalid, the error will be */ -/* diagnosed by routines called by this routine. The output */ -/* argument ET will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine operates on encoded SCLK values. These values */ -/* are obtained by calling the SPICELIB routine SCENCD or other */ -/* SCLK conversion routines. The advantage of encoded SCLK, as */ -/* opposed to character string representations of SCLK is that */ -/* encoded SCLK values are easy to perform arithmetic operations on. */ -/* Additionally, working with encoded SCLK reduces the overhead of */ -/* repeated conversion of character strings to integers or double */ -/* precision numbers. */ - -/* To convert a string representation of an SCLK value to ET, use */ -/* the SPICELIB routine SCS2E. */ - -/* See the SCLK Required Reading for a list of the entire set of */ -/* SCLK conversion routines. */ - -/* $ Examples */ - -/* 1) Encode a Galileo SCLK string, and convert the encoded value */ -/* to ET; use these time values to look up both GLL orbiter */ -/* scan platform's pointing and the GLL--Earth state vector */ -/* for an epoch specified by an SCLK string. */ - -/* During program initialization, load the leapseconds and */ -/* SCLK kernels. We will pretend that these files are named */ -/* "LEAPSECONDS.KER" and "GLLSCLK.KER". To use this code */ -/* fragment, you must substitute the actual names of these */ -/* kernel files for the names used here. */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* The mission is Galileo, which has spacecraft ID -77. */ -/* Let's assume that the SCLK string is */ - -/* 1 / 1900000:00:00 */ - -/* The number 1, followed by a slash, indicates that the */ -/* epoch is in the first partition. */ - -/* The next step is to encode this SCLK string, and also */ -/* find the corresponding ET value: */ - -/* CALL SCENCD ( -77, '1/ 1900000:00:00', SCLKDP ) */ -/* CALL SCT2E ( -77, SCLKDP, ET ) */ - -/* We'll assume that you've already loaded SPK and CK files */ -/* containing ephemeris data for the GLL orbiter and the */ -/* Earth, as well as scan platform pointing. Now you're */ -/* ready to call both CKGP, which expects the input epoch to */ -/* be specified by an encoded SCLK string, and SPKEZ, which */ -/* expects the epoch to be specified as an ephemeris time. */ - -/* C */ -/* C Find scan platform pointing CMAT and s/c--target */ -/* C vector (first 3 components of STATE) at epoch. */ -/* C We assume that CK and SPK kernels have been loaded */ -/* C already, via CKLPF and SPKLEF respectively. */ -/* C */ -/* SCANPL = -77001 */ -/* EARTH = 399 */ - -/* CALL CKGP ( SCANPL, */ -/* . SCLKDP, */ -/* . TOL, */ -/* . REFSYS, */ -/* . CMAT, */ -/* . CLKOUT, */ -/* . FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* [ Indicate to user that pointing was not */ -/* available ] */ - -/* END IF */ - - -/* CALL SPKEZ ( EARTH, */ -/* . ET, */ -/* . REFSYS, */ -/* . CORR, */ -/* . -77, */ -/* . STATE, */ -/* . LT ) */ - - - -/* 2) Convert an encoded Voyager 2 SCLK value to UTC, using calendar */ -/* format, with 3 digits of precision. */ - -/* Again, your initialization code must load the leapseconds */ -/* and SCLK kernels: */ - -/* C */ -/* C Load leapseconds and SCLK kernels: */ -/* C */ -/* CALL FURNSH ( 'LEAPSECONDS.KER' ) */ -/* CALL FURNSH ( 'VGR2SCLK.KER' ) */ - - -/* To find the UTC value corresponding to the encoded */ -/* Voyager 2 SCLK value SCLKDP, you can use the code fragment */ - -/* CALL SCT2E ( -32, SCLKDP, ET ) */ -/* CALL ET2UTC ( ET, 'C', 3, UTC ) */ - -/* $ Restrictions */ - -/* 1) An SCLK kernel appropriate to the spacecraft clock identified */ -/* by SC must be loaded at the time this routine is called. */ - -/* 2) If the SCLK kernel used with this routine does not map SCLK */ -/* directly to barycentric dynamical time, a leapseconds kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* [1] CK Required Reading */ - -/* [2] SPK Required Reading */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.0.3, 09-MAR-1999 (NJB) */ - -/* Explicit list of SCLK conversion routines in Particulars */ -/* section has been replaced by a pointer to the SCLK Required */ -/* Reading. */ - -/* - SPICELIB Version 1.0.2, 10-APR-1992 (NJB) (WLT) */ - -/* The $Brief_I/O section now lists ET correctly as an output */ -/* from this routine. Header was updated to reflect possibility */ -/* of needing to load a leapseconds kernel before calling this */ -/* routine. Comment section for permuted index source lines was */ -/* added following the header. */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Restrictions section no longer states that you must load the */ -/* leapseconds kernel prior to calling this routine. */ - -/* The examples have been slightly re-written. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* spacecraft_clock ticks to ephemeris time */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.1, 12-OCT-1990 (NJB) */ - -/* Restrictions section no longer states that you must load the */ -/* leapseconds kernel prior to calling this routine. */ - -/* The examples have been slightly re-written. In particular, */ -/* they no longer use calls to CLPOOL. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCT2E", (ftnlen)5); - } - -/* Just hand off the conversion to the appropriate routine. */ - - if (sctype_(sc) == 1) { - scte01_(sc, sclkdp, et); - } else { - setmsg_("Clock type # is not supported.", (ftnlen)30); - i__1 = sctype_(sc); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SCT2E", (ftnlen)5); - return 0; - } - chkout_("SCT2E", (ftnlen)5); - return 0; -} /* sct2e_ */ - diff --git a/ext/spice/src/cspice/sct2e_c.c b/ext/spice/src/cspice/sct2e_c.c deleted file mode 100644 index abe0a1a064..0000000000 --- a/ext/spice/src/cspice/sct2e_c.c +++ /dev/null @@ -1,295 +0,0 @@ -/* - --Procedure sct2e_c ( SCLK ticks to ET ) - --Abstract - - Convert encoded spacecraft clock (`ticks') to ephemeris - seconds past J2000 (ET). - --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 - - SCLK - TIME - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void sct2e_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceDouble * et ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft ID code. - sclkdp I SCLK, encoded as ticks since spacecraft clock - start. - et O Ephemeris time, seconds past J2000. - --Detailed_Input - - sc is a NAIF integer code for a spacecraft, one of - whose encoded clock values is represented by - sclkdp. - - sclkdp is an encoded spacecraft clock value. sclkdp - represents time measured from spacecraft clock - start: partition information IS reflected in the - encoded value. - --Detailed_Output - - et is the epoch, specified as ephemeris seconds past - J2000, that corresponds to sclkdp. - --Parameters - - None. - --Exceptions - - 1) This routine assumes that that an SCLK kernel appropriate - to the spacecraft clock identified by the input argument sc - has been loaded. If an SCLK kernel has not been loaded, - does not contain all of the required data, or contains - invalid data, error diagnoses will be performed by routines - called by this routine. The output argument et will not be - modified. - - 2) When using SCLK kernels that map SCLK to a time system other - than ET (also called barycentric dynamical time---`TDB'), it - is necessary to have a leapseconds kernel loaded at the time - this routine is called. If a leapseconds kernel is required - for conversion between SCLK and ET but is not loaded, the - error will be diagnosed by routines called by this routine. - The output argument et will not be modified. - - The time system that an SCLK kernel maps SCLK to is indicated - by the variable SCLK_TIME_SYSTEM_nn in the kernel, where nn - is the negative of the NAIF integer code for the spacecraft. - The time system used in a kernel is TDB if and only if the - variable is assigned the value 1. - - - 3) If the clock type for the spacecraft clock identified by - sc is not supported by this routine, the error - SPICE(NOTSUPPORTED) is signalled. The output argument et - will not be modified. - - 4) If the input argument sclkdp is invalid, the error will be - diagnosed by routines called by this routine. The output - argument et will not be modified. - --Files - - None. - --Particulars - - This routine operates on encoded SCLK values. These values - are obtained by calling the CSPICE routine scencd_c or other - SCLK conversion routines. The advantage of encoded SCLK, as - opposed to character string representations of SCLK is that - encoded SCLK values are easy to perform arithmetic operations on. - Additionally, working with encoded SCLK reduces the overhead of - repeated conversion of character strings to integers or double - precision numbers. - - To convert a string representation of an SCLK value to ET, use - the CSPICE routine scs2e_c. - --Examples - - 1) Encode a Galileo SCLK string, and convert the encoded value - to ET; use these time values to look up both GLL orbiter - scan platform's pointing and the GLL--Earth state vector - for an epoch specified by an SCLK string. - - During program initialization, load the leapseconds and - SCLK kernels. We will pretend that these files are named - "leapseconds.ker" and "gllsclk.ker". To use this code - fragment, you must substitute the actual names of these - kernel files for the names used here. - - /. - load leapseconds and sclk kernels: - ./ - furnsh_c ( "leapseconds.ker" ); - furnsh_c ( "gllsclk.ker" ); - - /. - The mission is Galileo, which has spacecraft ID -77. - Let's assume that the SCLK string is - - 1 / 1900000:00:00 - - The number 1, followed by a slash, indicates that the - epoch is in the first partition. - - The next step is to encode this SCLK string, and also - find the corresponding ET value: - ./ - - scencd_c ( -77, "1/ 1900000:00:00", &sclkdp ); - sct2e_c ( -77, sclkdp, &et ); - - - We'll assume that you've already loaded SPK and CK files - containing ephemeris data for the GLL orbiter and the - Earth, as well as scan platform pointing. Now you're - ready to call both ckgp_c, which expects the input epoch to - be specified by an encoded SCLK string, and spkez_c, which - expects the epoch to be specified as an ephemeris time. - - /. - Find scan platform pointing cmat and s/c--target - vector (first 3 components of state) at epoch. - We assume that CK and SPK kernels have been loaded - already, via cklpf_c and spklef_c respectively. - - Use tolerance of 80 ticks for the CK look-up. - ./ - scanpl = -77001; - earth = 399; - tol = 80.0; - - ckgp_c ( scanpl, sclkdp, tol, refsys, - cmat, &clkout, &found ); - - if ( !found ) - { - [ Indicate to user that pointing was not - available ] - } - - spkez_c ( earth, et, refsys, corr, - -77, state, < ); - - - - 2) Convert an encoded Voyager 2 SCLK value to UTC, using calendar - format, with 3 digits of precision. - - Again, your initialization code must load the leapseconds - and SCLK kernels: - - /. - load leapseconds and SCLK kernels: - ./ - furnsh_c ( "leapseconds.ker" ); - furnsh_c ( "vgr2sclk.ker" ); - - - To find the UTC value corresponding to the encoded - Voyager 2 SCLK value sclkdp, you can use the code fragment - - sct2e_c ( -32, sclkdp, &et ); - et2utc_c ( et, "c", 3, UTCLEN, utc ); - - where UTCLEN is a constant indicating the available - room in the string utc. A value of 25 characters suffices. - - --Restrictions - - 1) An SCLK kernel appropriate to the spacecraft clock identified - by SC must be loaded at the time this routine is called. - - 2) If the SCLK kernel used with this routine does not map SCLK - directly to barycentric dynamical time, a leapseconds kernel - must be loaded at the time this routine is called. - --Literature_References - - [1] CK Required Reading - - [2] SPK Required Reading - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.2, 10-APR-1992 (NJB) (WLT) - --Index_Entries - - spacecraft_clock ticks to ephemeris time - --& -*/ - -{ /* Begin sct2e_c */ - - - /* - Local variables - */ - SpiceDouble loc_et; - - - /* - Participate in error handling - */ - chkin_c ( "sct2e_c"); - - - /* - Carry out the conversion. - */ - sct2e_ ( ( integer * ) &sc, - ( doublereal * ) &sclkdp, - ( doublereal * ) &loc_et ); - - /* - Assign the output argument. - */ - *et = loc_et; - - - chkout_c ( "sct2e_c"); - - -} /* End sct2e_c */ diff --git a/ext/spice/src/cspice/sctiks.c b/ext/spice/src/cspice/sctiks.c deleted file mode 100644 index c5de309bdd..0000000000 --- a/ext/spice/src/cspice/sctiks.c +++ /dev/null @@ -1,346 +0,0 @@ -/* sctiks.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCTIKS ( Convert spacecraft clock string to ticks. ) */ -/* Subroutine */ int sctiks_(integer *sc, char *clkstr, doublereal *ticks, - ftnlen clkstr_len) -{ - integer type__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sctk01_(integer *, - char *, doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer - *, ftnlen); - extern integer sctype_(integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Convert a spacecraft clock format string to number of "ticks". */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* TIME */ - -/* $ Declarations */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft identification code. */ -/* CLKSTR I Character representation of a spacecraft clock. */ -/* TICKS O Number of ticks represented by the clock string. */ - -/* $ Detailed_Input */ - -/* SC is the NAIF ID number for the spacecraft whose clock */ -/* string is being converted. */ - -/* CLKSTR is a character string representing a spacecraft clock */ -/* time, WITHOUT PARTITION NUMBER. */ - -/* Using Galileo as an example, the full format is */ - -/* wwwwwwww:xx:y:z */ - -/* where z is a mod-8 counter (values 0-7) which */ -/* increments approximately once every 8 1/3 ms., y is a */ -/* mod-10 counter (values 0-9) which increments once */ -/* every time z turns over, i.e., approximately once every */ -/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ -/* which increments once every time y turns over, i.e., */ -/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */ -/* Count (RIM), which increments once every time xx turns */ -/* over, i.e., once every 60 2/3 seconds. The roll-over */ -/* expression for the RIM is 16777215, which corresponds */ -/* to approximately 32 years. */ - -/* wwwwwwww, xx, y, and z are referred to interchangeably */ -/* as the fields or components of the spacecraft clock. */ -/* SCLK components may be separated by any of the */ -/* following characters: ' ' '.' ':' ',' '-' */ -/* Any number of spaces may separate the components and */ -/* the delimiters. The presence of the RIM component */ -/* is required. Successive components may be omitted, and */ -/* in such cases are assumed to represent zero values. */ - -/* Values for the individual components may exceed the */ -/* maximum expected values. For instance, '0:0:0:9' is */ -/* an acceptable Galileo clock string, and will convert */ -/* to the same number of ticks as '0:0:1:1'. */ - -/* Consecutive delimiters containing no intervening digits */ -/* are treated as if they delimit zero components. */ - -/* Trailing zeros should always be included to match the */ -/* length of the counter. For example, a Galileo clock */ -/* count of '25684.90' should not be represented as */ -/* '25684.9'. */ - -/* Some spacecraft clock components have offset, or */ -/* starting, values different from zero. For example, */ -/* with an offset value of 1, a mod 20 counter would */ -/* cycle from 1 to 20 instead of from 0 to 19. */ - -/* See the SCLK required reading for a detailed */ -/* description of the Voyager and Mars Observer clock */ -/* formats. */ - - -/* $ Detailed_Output */ - -/* TICKS is the number of ticks represented by the spacecraft */ -/* clock string. A tick is defined to be the smallest */ -/* time increment expressible by the spacecraft clock. */ - -/* An analogy may be drawn between a spacecraft clock */ -/* and a standard wall clock, measuring hours, minutes */ -/* and seconds. The number of ticks represented by the */ -/* wall clock string */ -/* hh:mm:ss */ - -/* would be the number of seconds represented by that */ -/* time. */ - -/* For example: */ - -/* 00:00:10 would convert to 10 */ -/* 00:01:00 would convert to 60 */ -/* 00:10:00 would convert to 600 */ -/* 01:00:00 would convert to 3600 */ -/* 01:01:00 would convert to 3660 */ - -/* See the Examples section below for examples for */ -/* actual spacecraft clocks. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the spacecraft clock type is not supported then the */ -/* error SPICE(NOTSUPPORTED) is signalled. */ - -/* 2) If any of the extracted clock components cannot be parsed as */ -/* integers, or the string has too many components, or the value */ -/* of one of the components is less than the offset value, then */ -/* the error is diagnosed by routines called by this routine. */ - -/* 3) Invalid spacecraft ID's are not diagnosed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Each spacecraft is assigned a clock type code in the kernel file. */ -/* SCTIKS calls the function SCTYPE to determine this value. If the */ -/* clock type is supported by SPICELIB, then the routine TIKSnn is */ -/* called to handle the actual conversion from clock format to number */ -/* of ticks. The nn in TIKSnn refers to the spacecraft clock type */ -/* code. Different spacecraft have distict clock formats but can */ -/* still be of the same clock type. */ - -/* The TIKSnn routines are entry points to the routines SCLKnn, which */ -/* also contain the ticks-to-clock format conversion routines FMTnn. */ -/* FMTnn is called by the subroutine SCFMT, which performs the */ -/* inverse operation to SCTIKS. */ - -/* Note the important difference between SCENCD and SCTIKS. SCENCD */ -/* converts a clock string to the number of ticks it represents */ -/* since the beginning of the mission, and so uses partition */ -/* information. SCTIKS just converts to absolute ticks. */ - -/* $ Examples */ - -/* SCTIKS is used as part of the process of encoding spacecraft clock */ -/* by SCENCD, though SCTIKS does not process any partition informa- */ -/* tion. */ - -/* Another use of SCTIKS, however, is to convert a clock measurement */ -/* to ticks for use as a tolerance for the CK reader CKGP. */ - - -/* C */ -/* C Get the pointing from a CK file of the VGR 1 narrow angle */ -/* C image corresponding to a particular SCLK count. */ -/* C */ -/* C Load the CK file and the kernel file containing SCLK */ -/* C partition information for SCENCD. */ -/* C */ -/* CALL CKLPF ( 'VGR1NA.CK', HANDLE ) */ -/* CALL FURNSH ( 'SCLK.KER' ) */ - -/* C */ -/* C Get the right ID numbers. */ -/* C */ -/* SC = -31 */ -/* INSTR = -31001 */ - -/* C */ -/* C The SCLK string includes a partition number. Pictures are */ -/* C never shuttered at intervals smaller than 1 MOD60 count */ -/* C from each other. So use 1 MOD60 count as the time */ -/* C tolerance. */ -/* C */ -/* CLKSTR = '1/20556:14:768' */ -/* TOLSTR = ' 0:01:000' */ - -/* C */ -/* C Encode the clock string and the tolerance. */ -/* C */ -/* CALL SCENCD ( SC, CLKSTR, SCLK ) */ -/* CALL SCTIKS ( SC, TOLSTR, TOL ) */ - -/* C */ -/* C Get the pointing from the C-kernel. */ -/* C */ -/* CALL CKGP ( INSTR, SCLK, TOL, REF, CMAT, CLKOUT, FOUND ) */ - - - -/* Below are some examples illustrating various clock string inputs */ -/* and the resulting outputs for the Galileo spacecraft. See the */ -/* SCLK required reading for a detailed description of the Galileo */ -/* clock format. */ - -/* CLKSTR TICKS */ -/* ---------------- -------------------- */ -/* '0:0:0:1' 1 */ -/* '0:0:1' 8 */ -/* '0:1' 80 */ -/* '1' 7280 */ -/* '1 0 0 0' 7280 */ -/* '1,0,0,0' 7280 */ -/* '1:90' 14480 */ -/* '1:9' 8000 */ -/* '1:09' 8000 */ -/* '0-0-10' 80 |-- Third component is supposed */ -/* '0-1-0' 80 | to be a mod-10 count. */ -/* '0/1/0' Error: '/' is not an accepted delimiter. */ -/* '1: 00 : 0 : 1' 7281 */ -/* '1:::1' 7281 */ -/* '1.1.1.1.1' Error: Too many components */ -/* '1.1.1.1.' Error: The last delimiter signals that */ -/* a fifth component will follow. */ - - -/* The following examples are for the Voyager 2 spacecraft. Note */ -/* that the last component of the Voyager clock has an offset */ -/* value of 1. */ - -/* CLKSTR TICKS */ -/* ---------------- -------------------- */ -/* '0.0.001' 0 */ -/* '0:0:002' 1 */ -/* '0:01' 800 */ -/* '1' 48000 */ -/* '1.0' 48000 */ -/* '1.0.0' Error: The 3rd component is never 0. */ -/* '0.0:100' 99 */ -/* '0-60-1' 48000 */ -/* '1-1-1' 48800 */ -/* '1-1-2' 48801 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - 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, 06-SEP-1990 (JML) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert spacecraft_clock string to ticks */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SCTIKS", (ftnlen)6); - } - -/* If the spacecraft clock type is supported by NAIF then */ -/* call TIKSnn to perform the conversion. */ - - type__ = sctype_(sc); - if (type__ == 1) { - sctk01_(sc, clkstr, ticks, clkstr_len); - } else { - setmsg_("Clock type # is not supported.", (ftnlen)30); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SCTIKS", (ftnlen)6); - return 0; - } - chkout_("SCTIKS", (ftnlen)6); - return 0; -} /* sctiks_ */ - diff --git a/ext/spice/src/cspice/sctiks_c.c b/ext/spice/src/cspice/sctiks_c.c deleted file mode 100644 index 5acf4b8599..0000000000 --- a/ext/spice/src/cspice/sctiks_c.c +++ /dev/null @@ -1,328 +0,0 @@ -/* - --Procedure sctiks_c ( Convert spacecraft clock string to ticks. ) - --Abstract - - Convert a spacecraft clock format string to number of "ticks". - --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 - - SCLK - --Keywords - - CONVERSION - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void sctiks_c ( SpiceInt sc, - ConstSpiceChar * clkstr, - SpiceDouble * ticks ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - sc I NAIF spacecraft identification code. - clkstr I Character representation of a spacecraft clock. - ticks O Number of ticks represented by the clock string. - --Detailed_Input - - sc is the NAIF ID number for the spacecraft whose clock - string is being converted. - - clkstr is a character string representing a spacecraft clock - time, WITHOUT PARTITION NUMBER. - - Using Galileo as an example, the full format is - - wwwwwwww:xx:y:z - - where z is a mod-8 counter (values 0-7) which - increments approximately once every 8 1/3 ms., y is a - mod-10 counter (values 0-9) which increments once - every time z turns over, i.e., approximately once every - 66 2/3 ms., xx is a mod-91 (values 0-90) counter - which increments once every time y turns over, i.e., - once every 2/3 seconds. wwwwwwww is the Real-Time Image - Count (RIM), which increments once every time xx turns - over, i.e., once every 60 2/3 seconds. The roll-over - expression for the RIM is 16777215, which corresponds - to approximately 32 years. - - wwwwwwww, xx, y, and z are referred to interchangeably - as the fields or components of the spacecraft clock. - SCLK components may be separated by any of the - following characters: " " "." ":" "," "-" - Any number of spaces may separate the components and - the delimiters. The presence of the RIM component - is required. Successive components may be omitted, and - in such cases are assumed to represent zero values. - - Values for the individual components may exceed the - maximum expected values. For instance, "0:0:0:9" is - an acceptable Galileo clock string, and will convert - to the same number of ticks as "0:0:1:1". - - Consecutive delimiters containing no intervening digits - are treated as if they delimit zero components. - - Trailing zeros should always be included to match the - length of the counter. For example, a Galileo clock - count of "25684.90" should not be represented as - "25684.9". - - Some spacecraft clock components have offset, or - starting, values different from zero. For example, - with an offset value of 1, a mod 20 counter would - cycle from 1 to 20 instead of from 0 to 19. - - See the SCLK required reading for a detailed - description of the Voyager and Mars Observer clock - formats. - - --Detailed_Output - - ticks is the number of ticks represented by the spacecraft - clock string. A tick is defined to be the smallest - time increment expressible by the spacecraft clock. - - An analogy may be drawn between a spacecraft clock - and a standard wall clock, measuring hours, minutes - and seconds. The number of ticks represented by the - wall clock string - - hh:mm:ss - - would be the number of seconds represented by that - time. - - For example: - - 00:00:10 would convert to 10 - 00:01:00 would convert to 60 - 00:10:00 would convert to 600 - 01:00:00 would convert to 3600 - 01:01:00 would convert to 3660 - - See the Examples section below for examples for - actual spacecraft clocks. - --Parameters - - None. - --Exceptions - - 1) If the spacecraft clock type is not supported then the - error SPICE(NOTSUPPORTED) is signalled. - - 2) If any of the extracted clock components cannot be parsed as - integers, or the string has too many components, or the value - of one of the components is less than the offset value, then - the error is diagnosed by routines called by this routine. - - 3) Invalid spacecraft ID's are not diagnosed. - --Files - - None. - --Particulars - - Note the important difference between scencd_c and sctiks_c. scencd_c - converts a clock string to the number of ticks it represents - since the beginning of the mission, and so uses partition - information. sctiks_c just converts to absolute ticks. - --Examples - - sctiks_c is used as part of the process of encoding spacecraft clock - by scencd_c, though sctiks_c does not process any partition informa- - tion. - - Another use of sctiks_c, however, is to convert a clock measurement - to ticks for use as a tolerance for the CK reader ckgp_c. - - - /. - Get the pointing from a CK file of the VGR 1 narrow angle - image corresponding to a particular SCLK count. - - Load the CK file and the kernel file containing SCLK - partition information for scencd_c. - ./ - cklpf_c ( "vgr1na.ck", &handle ); - furnsh_c ( "sclk.ker" ); - - /. - Get the right ID numbers. - ./ - sc = -31; - instr = -31001; - - /. - The SCLK string includes a partition number. Pictures are - never shuttered at intervals smaller than 1 MOD60 count - from each other. So use 1 MOD60 count as the time - tolerance. - ./ - clkstr = "1/20556:14:768"; - tolstr = " 0:01:000"; - - /. - Encode the clock string and the tolerance. - ./ - scencd_c ( sc, clkstr, &sclk ); - sctiks_c ( sc, tolstr, &tol ); - - /. - Get the pointing from the C-kernel. - ./ - ckgp_c ( instr, sclk, tol, ref, cmat, &clkout, &found ); - - - - Below are some examples illustrating various clock string inputs - and the resulting outputs for the Galileo spacecraft. See the - SCLK required reading for a detailed description of the Galileo - clock format. - - CLKSTR TICKS - ---------------- -------------------- - "0:0:0:1" 1 - "0:0:1" 8 - "0:1" 80 - "1" 7280 - "1 0 0 0" 7280 - "1,0,0,0" 7280 - "1:90" 14480 - "1:9" 8000 - "1:09" 8000 - "0-0-10" 80 |-- Third component is supposed - "0-1-0" 80 | to be a mod-10 count. - "0/1/0" Error: "/" is not an accepted delimiter. - "1: 00 : 0 : 1" 7281 - "1:::1" 7281 - "1.1.1.1.1" Error: Too many components - "1.1.1.1." Error: The last delimiter signals that - a fifth component will follow. - - - The following examples are for the Voyager 2 spacecraft. Note - that the last component of the Voyager clock has an offset - value of 1. - - CLKSTR TICKS - ---------------- -------------------- - "0.0.001" 0 - "0:0:002" 1 - "0:01" 800 - "1" 48000 - "1.0" 48000 - "1.0.0" Error: The 3rd component is never 0. - "0.0:100" 99 - "0-60-1" 48000 - "1-1-1" 48800 - "1-1-2" 48801 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - J.M. Lynch (JPL) - R.E. Thurman (JPL) - --Version - - -CSPICE Version 1.1.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) - --Index_Entries - - convert spacecraft_clock string to ticks - --& -*/ - -{ /* Begin sctiks_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "sctiks_c"); - - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "sctiks_c", clkstr ); - - - /* - Do the conversion. - */ - sctiks_ ( ( integer * ) &sc, - ( char * ) clkstr, - ( doublereal * ) ticks, - ( ftnlen ) strlen(clkstr) ); - - - chkout_c ( "sctiks_c"); - -} /* End sctiks_c */ diff --git a/ext/spice/src/cspice/sctran.c b/ext/spice/src/cspice/sctran.c deleted file mode 100644 index 7abfd5b6d8..0000000000 --- a/ext/spice/src/cspice/sctran.c +++ /dev/null @@ -1,539 +0,0 @@ -/* sctran.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SCTRAN ( SCLK name/ID code translation ) */ -/* Subroutine */ int sctran_0_(int n__, char *clknam, integer *clkid, logical - *found, ftnlen clknam_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer posr_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int bodn2c_(char *, integer *, logical *, ftnlen), - bodc2n_(integer *, char *, logical *, ftnlen), sigerr_(char *, - ftnlen); - char tmpnam[32]; - extern /* Subroutine */ int chkout_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* Convert between SCLK name strings and ID codes. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* PARSING */ -/* SCLK */ -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* CLKNAM I-O SCID2N, SCN2ID */ -/* CLKID I-O SCID2N, SCN2ID */ -/* FOUND O SCID2N, SCN2ID */ -/* MAXLEN P All */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Parameters */ - -/* MAXLEN is the maximum allowed length, in characters, of a */ -/* string containing the name of a spacecraft clock. */ - -/* $ Exceptions */ - -/* 1) This is an umbrella subroutine that contains declarations */ -/* for its entry points. This routine should never be called */ -/* directly. If it is, the error SPICE(BOGUSENTRY) will be */ -/* signaled. */ - - -/* See the entry points for a discussion of exceptions specific to */ -/* those routines. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This set of subroutines centralizes the mapping between */ -/* spacecraft clock names and their corresponding NAIF integer */ -/* codes. Translation between these names and codes is frequently */ -/* required by user interface functions. */ - -/* The set of supported clocks is identical to the set of spacecraft */ -/* supported by BODTRN. The mapping may be extended by calling */ -/* BODDEF. */ - -/* $ Examples */ - -/* See the entry points for examples of their usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 29-OCT-2001 (NJB) */ - -/* Bug fix: modified algorithm to handle case where string */ -/* "SCLK" appears in SCLK name. */ - -/* - SPICELIB Version 1.1.0, 25-FEB-2000 (NJB) */ - -/* Updated to use BODTRN for SCLK name/code mapping. */ - -/* - Beta Version 1.0.0, 17-NOV-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert between SCLK ID codes and names */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 12-AUG-2001 (NJB) */ - -/* Bug fix: modified algorithm to handle case where string */ -/* "SCLK" appears in SCLK name. SCN2ID now uses POSR to locate */ -/* the substring "SCLK" in the input string. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_scn2id; - case 2: goto L_scid2n; - } - - if (return_()) { - return 0; - } else { - chkin_("SCTRAN", (ftnlen)6); - } - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("SCTRAN", (ftnlen)6); - return 0; -/* $Procedure SCN2ID ( SCLK name to ID code ) */ - -L_scn2id: -/* $ Abstract */ - -/* Convert an SCLK name string to a NAIF integer code. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* PARSING */ -/* SCLK */ -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) CLKNAM */ -/* INTEGER CLKID */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CLKNAM I String giving spacecraft clock name. */ -/* CLKID O NAIF integer code of spacecraft clock. */ -/* FOUND O Flag indicating whether item was found. */ - -/* $ Detailed_Input */ - -/* CLKNAM is a short string identifying the spacecraft */ -/* clock of interest. The form of the string */ -/* is: */ - -/* SCLK */ - -/* for example */ - -/* VGR1 SCLK */ -/* VOYAGER 1 SCLK */ -/* GLL SCLK */ -/* GALILEO ORBITER SCLK */ - -/* Case and white space (including embedded white */ -/* space) are not significant. */ - -/* $ Detailed_Output */ - -/* CLKID is the NAIF integer code associated with the */ -/* input clock. CLKID is defined only if the */ -/* output flag FOUND is returned .TRUE. */ - -/* FOUND is a logical flag indicating whether the input */ -/* string specified a clock known to this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input name is not recognized, FOUND is set to .FALSE. */ -/* CLKID is not modified. */ - -/* 2) If the input name is recognized but does not refer to a */ -/* spacecraft, no error is signaled. For example, the string */ -/* 'JUPITER BARYCENTER SCLK' maps to the code 5. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* SCN2ID provides a means of mapping human-readable clock names */ -/* to integer codes used by the SPICELIB SCLK routines to */ -/* identify spacecraft clocks. */ - -/* $ Examples */ - -/* 1) Look up the spacecraft clock code for the Galileo orbiter. */ - -/* CALL SCN2ID ( 'GLL SCLK', CLKID, FOUND ) */ - -/* The outputs will be */ - -/* CLKID = -77 */ -/* FOUND = .TRUE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 12-AUG-2001 (NJB) */ - -/* Bug fix: modified algorithm to handle case where string */ -/* "SCLK" appears in SCLK name. */ - -/* - SPICELIB Version 1.1.0, 25-FEB-2000 (NJB) */ - -/* Updated to use BODTRN for SCLK name/code mapping. */ - -/* - Beta Version 1.0.0, 17-NOV-1995 (NJB) */ - - -/* -& */ -/* $ Index_Entries */ - -/* convert an SCLK name to an SCLK ID code */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 29-OCT-2001 (NJB) */ - -/* Bug fix: modified algorithm to handle case where string */ -/* "SCLK" appears in SCLK name. SCN2ID now uses POSR to locate */ -/* the substring "SCLK" in the input string. */ - -/* -& */ - -/* Convert name to upper case. */ - - ucase_(clknam, tmpnam, clknam_len, (ftnlen)32); - -/* Remove the final occurrence of the string 'SCLK' from */ -/* the input name. */ - - i__1 = rtrim_(tmpnam, (ftnlen)32); - loc = posr_(tmpnam, "SCLK", &i__1, (ftnlen)32, (ftnlen)4); - if (loc > 0) { - s_copy(tmpnam + (loc - 1), " ", (ftnlen)4, (ftnlen)1); - } - bodn2c_(tmpnam, clkid, found, (ftnlen)32); - return 0; -/* $Procedure SCID2N ( SCLK ID code to name ) */ - -L_scid2n: -/* $ Abstract */ - -/* Convert a NAIF integer code for a spacecraft clock to an SCLK name */ -/* 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* CONVERSION */ -/* PARSING */ -/* SCLK */ -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER CLKID */ -/* CHARACTER*(*) CLKNAM */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CLKID I NAIF integer code of spacecraft clock. */ -/* CLKNAM O String giving spacecraft clock name. */ -/* FOUND O Flag indicating whether item was found. */ - -/* $ Detailed_Input */ - -/* CLKID is the NAIF integer code of a spacecraft clock of */ -/* interest. */ - -/* $ Detailed_Output */ - -/* CLKNAM is a short, human-readable string identifying */ -/* the specified spacecraft clock. The returned */ -/* string has the form */ - -/* SCLK */ - -/* where the spacecraft name is the same string */ -/* returned by BODC2N when CLKID is supplied as the */ -/* input code. */ - -/* CLKNAM is defined only if the output flag FOUND is */ -/* returned .TRUE. */ - -/* FOUND is a logical flag indicating whether the input */ -/* code specified a clock known to this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input code is not recognized, FOUND is set to .FALSE. */ -/* CLKNAM is not modified. */ - -/* 2) If the input code is recognized but does not refer to a */ -/* spacecraft, no error is signaled. For example, the code */ -/* 5 maps to the string 'JUPITER BARYCENTER SCLK'. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine converts a NAIF spacecraft clock code to a human- */ -/* readable string. This function is useful for constructing */ -/* messages. */ - -/* $ Examples */ - -/* 1) Look up the spacecraft clock name for code -77. */ - -/* CALL SCID2N ( -77, CLKNAM, FOUND ) */ - -/* The outputs will be */ - -/* CLKNAM = 'GALILEO ORBITER SCLK' */ -/* FOUND = .TRUE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 25-FEB-2000 (NJB) */ - -/* Updated to use BODTRN for SCLK name/code mapping. */ - -/* - Beta Version 1.0.0, 17-NOV-1995 (NJB) */ - - -/* -& */ -/* $ Index_Entries */ - -/* convert an SCLK name to an SCLK ID code */ - -/* -& */ - bodc2n_(clkid, clknam, found, clknam_len); - if (! (*found)) { - return 0; - } - suffix_("SCLK", &c__1, clknam, (ftnlen)4, clknam_len); - return 0; -} /* sctran_ */ - -/* Subroutine */ int sctran_(char *clknam, integer *clkid, logical *found, - ftnlen clknam_len) -{ - return sctran_0_(0, clknam, clkid, found, clknam_len); - } - -/* Subroutine */ int scn2id_(char *clknam, integer *clkid, logical *found, - ftnlen clknam_len) -{ - return sctran_0_(1, clknam, clkid, found, clknam_len); - } - -/* Subroutine */ int scid2n_(integer *clkid, char *clknam, logical *found, - ftnlen clknam_len) -{ - return sctran_0_(2, clknam, clkid, found, clknam_len); - } - diff --git a/ext/spice/src/cspice/sctype.c b/ext/spice/src/cspice/sctype.c deleted file mode 100644 index f4d074140a..0000000000 --- a/ext/spice/src/cspice/sctype.c +++ /dev/null @@ -1,282 +0,0 @@ -/* sctype.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure SCTYPE ( SCLK type ) */ -integer sctype_(integer *sc) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical nodata = TRUE_; - static integer oldsc = 0; - - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer type__; - integer n; - extern /* Subroutine */ int scli01_(char *, integer *, integer *, integer - *, integer *, ftnlen), chkin_(char *, ftnlen), repmi_(char *, - char *, integer *, char *, ftnlen, ftnlen, ftnlen); - extern logical failed_(void); - char kvname[60]; - logical update; - extern /* Subroutine */ int chkout_(char *, ftnlen), cvpool_(char *, - logical *, ftnlen), suffix_(char *, integer *, char *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Return the spacecraft clock type for a specified spacecraft. */ - -/* $ 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 */ - -/* SCLK */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SC I NAIF spacecraft ID code. */ - -/* The function returns the spacecraft clock type associated with the */ -/* spacecraft specified by SC. */ - -/* $ Detailed_Input */ - -/* SC is a NAIF ID code for a spacecraft, whose */ -/* spacecraft clock `type' is desired. */ - -/* $ Detailed_Output */ - -/* The function returns the spacecraft clock type associated with the */ -/* spacecraft specified by SC. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the kernel variable that assigns a SCLK type to the */ -/* spacecraft specified by SC is not found in the kernel pool, */ -/* the error is diagnosed by routines called by this routine. */ -/* SCTYPE returns the value 0 in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The raison d'etre of this routine is that it consolidates the code */ -/* that maps spacecraft ID's to clock types. While any routine may */ -/* call SCTYPE, it is unlikely that there will be a need for */ -/* non-SPICELIB routines to call this routine directly. */ - -/* $ Examples */ - -/* 1) Find the SCLK type for Galileo. */ - -/* During program initialization, we load a SCLK kernel file */ -/* into the kernel pool. We will pretend that the name of */ -/* this file is GLLSCLK.KER. You must use the actual name of */ -/* an SCLK kernel that is accessible by your program to try */ -/* this example. */ - -/* C */ -/* C Load the SCLK kernel. */ -/* C */ -/* CALL FURNSH ( 'GLLSCLK.KER' ) */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C Print out the clock type for Galileo. */ -/* C */ -/* TYPE = SCTYPE ( -77 ) */ - -/* PRINT *, 'Galileo clock type is ', TYPE */ - - -/* 2) Find the SCLK type for Mars Observer. */ - - -/* C */ -/* C Load the SCLK kernel. */ -/* C */ -/* CALL FURNSH ( 'MOSCLK.KER' ) */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C Print out the clock type for Mars Observer. */ -/* C */ -/* TYPE = SCTYPE ( -94 ) */ - -/* PRINT *, 'Mars Observer clock type is ', TYPE */ - -/* $ Restrictions */ - -/* This routine assumes that an SCLK kernel appropriate to the */ -/* spacecraft specified by SC has been loaded into the kernel pool. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */ - -/* Replaced references to LDPOOL with references */ -/* to FURNSH. */ - -/* - SPICELIB Version 1.1.0, 22-MAR-1993 (JML) */ - -/* 1) The routine now uses the kernel pool watch capability. */ - -/* 2) The routine now returns a value of zero if RETURN is */ -/* true on entry. */ - -/* - 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, 04-SEP-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* spacecraft_clock type */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } - chkin_("SCTYPE", (ftnlen)6); - -/* On the first pass through the subroutine, or if the spacecraft */ -/* ID code changes, set a watch on the SCLK kernel variable for */ -/* the current clock type. */ - - if (first || *sc != oldsc) { - -/* Construct the name of the kernel variable that is needed. */ - - s_copy(kvname, "SCLK_DATA_TYPE", (ftnlen)60, (ftnlen)14); - suffix_("_#", &c__0, kvname, (ftnlen)2, (ftnlen)60); - i__1 = -(*sc); - repmi_(kvname, "#", &i__1, kvname, (ftnlen)60, (ftnlen)1, (ftnlen)60); - -/* Set a watch on the kernel variable needed. */ - - swpool_("SCTYPE", &c__1, kvname, (ftnlen)6, (ftnlen)60); - -/* Keep track of the last spacecraft ID encountered. */ - - oldsc = *sc; - first = FALSE_; - } - -/* If the kernel pool variable that this routine uses has */ -/* been updated, or if the spacecraft id code changes, look */ -/* up the new value from the kernel pool. */ - - cvpool_("SCTYPE", &update, (ftnlen)6); - if (update || nodata) { - -/* Find the clock type for the specified mission. */ - - type__ = 0; - scli01_("SCLK_DATA_TYPE", sc, &c__1, &n, &type__, (ftnlen)14); - if (failed_()) { - nodata = TRUE_; - ret_val = 0; - chkout_("SCTYPE", (ftnlen)6); - return ret_val; - } - nodata = FALSE_; - } - ret_val = type__; - chkout_("SCTYPE", (ftnlen)6); - return ret_val; -} /* sctype_ */ - diff --git a/ext/spice/src/cspice/sdiff_c.c b/ext/spice/src/cspice/sdiff_c.c deleted file mode 100644 index 5c1485122c..0000000000 --- a/ext/spice/src/cspice/sdiff_c.c +++ /dev/null @@ -1,359 +0,0 @@ -/* - --Procedure sdiff_c ( Symmetric difference of two sets ) - --Abstract - - Take the symmetric difference of two sets of any data type to form a - third set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void sdiff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I First input set. - b I Second input set. - c O Symmetric difference of a and b. - --Detailed_Input - - a is a CSPICE set. a must be declared as a SpiceCell - of data type character, double precision, or integer. - - b is a CSPICE set, distinct from a. b must have the - same data type as a. - --Detailed_Output - - c is a CSPICE set, distinct from sets a and b, which - contains the symmetric difference of a and b (that is, - all of the elements which are in a or in b but not in - both). c must have the same data type as a and b. - - When comparing elements of character sets, this routine - ignores trailing blanks. Trailing blanks will be - trimmed from the members of the output set c. - --Parameters - - None. - --Exceptions - - 1) If the input set arguments don't have identical data types, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the symmetric difference of the two sets contains more - elements than can be contained in the output set, the error - SPICE(SETEXCESS) is signaled. - - 3) If the set arguments have character type and the length of the - elements of the output set is less than the maximum of the - lengths of the elements of the input sets, the error - SPICE(ELEMENTSTOOSHORT) is signaled. - - 4) If either of the input arguments may be unordered or contain - duplicates, the error SPICE(NOTASET) is signaled. - --Files - - None. - --Particulars - - This is a generic CSPICE set routine; it operates on sets of any - supported data type. - - - The symmetric difference of two sets contains every element which is - in the first set OR in the second set, but NOT in both sets. - - {a,b} sym. difference {c,d} = {a,b,c,d} - {a,b,c} {b,c,d} {a,d} - {a,b,c,d} {} {a,b,c,d} - {} {a,b,c,d} {a,b,c,d} - {} {} {} - - --Examples - - 1) The following code fragment places the symmetric difference of - the character sets planets and asteroids into the character set - result. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( asteroids, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( result, MAXSIZ, NAMLEN ); - . - . - . - /. - Compute the symmetric difference. - ./ - sdiff_c ( &planets, &asteroids, &result ); - - - 2) Repeat example #1, this time using integer sets containing - ID codes of the bodies of interest. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( planets, MAXSIZ ); - SPICEINT_CELL ( asteroids, MAXSIZ ); - SPICEINT_CELL ( result, MAXSIZ ); - . - . - . - /. - Compute the symmetric difference. - ./ - sdiff_c ( &planets, &asteroids, &result ); - --Restrictions - - 1) The output set must be distinct from both of the input sets. - For example, the following calls are invalid. - - sdiff_c ( ¤t, &new, ¤t ); - sdiff_c ( &new, ¤t, ¤t ); - - In each of the examples above, whether or not the subroutine - signals an error, the results will almost certainly be wrong. - Nearly the same effect can be achieved, however, by placing the - result into a temporary set, which is immediately copied back - into one of the input sets, as shown below. - - sdiff_c ( ¤t, &new, &temp ); - copy_c ( &temp, &new ); - - - 2) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input sets 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) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 15-FEB-2005 (NJB) - - Bug fix: loop bound changed from 2 to 3 in loop used - to free dynamically allocated arrays. - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - symmetric difference of two sets - --& -*/ - - -{ /* Begin sdiff_c */ - - - /* - Local variables - */ - SpiceChar * fCell[3]; - - SpiceInt fLen [3]; - SpiceInt i; - - - /* - Standard SPICE error handling. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "sdiff_c" ); - - /* - Make sure data types match. - */ - CELLMATCH3 ( CHK_STANDARD, "sdiff_c", a, b, c ); - - /* - Make sure the input cells are sets. - */ - CELLISSETCHK2 ( CHK_STANDARD, "sdiff_c", a, b ); - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - /* - Call the symmetric difference routine appropriate for the data type - of the cells. - */ - if ( a->dtype == SPICE_CHR ) - { - - /* - Construct Fortran-style sets suitable for passing to sdiffc_. - */ - C2F_MAP_CELL3 ( "", - a, fCell, fLen, - b, fCell+1, fLen+1, - c, fCell+2, fLen+2 ); - - - if ( failed_c() ) - { - chkout_c ( "sdiff_c" ); - return; - } - - - sdiffc_ ( (char * ) fCell[0], - (char * ) fCell[1], - (char * ) fCell[2], - (ftnlen ) fLen[0], - (ftnlen ) fLen[1], - (ftnlen ) fLen[2] ); - - - /* - Map the diff back to a C style cell. - */ - F2C_MAP_CELL ( fCell[2], fLen[2], c ); - - - /* - We're done with the dynamically allocated Fortran-style arrays. - */ - for ( i = 0; i < 3; i++ ) - { - free ( fCell[i] ); - } - - } - - else if ( a->dtype == SPICE_DP ) - { - sdiffd_ ( (doublereal * ) (a->base), - (doublereal * ) (b->base), - (doublereal * ) (c->base) ); - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - } - - else if ( a->dtype == SPICE_INT ) - { - sdiffi_ ( (integer * ) (a->base), - (integer * ) (b->base), - (integer * ) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - } - - else - { - setmsg_c ( "Cell a contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (a->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "sdiff_c" ); - return; - } - - - /* - Indicate the result is a set. - */ - c->isSet = SPICETRUE; - - - chkout_c ( "sdiff_c" ); - -} /* End sdiff_c */ diff --git a/ext/spice/src/cspice/sdiffc.c b/ext/spice/src/cspice/sdiffc.c deleted file mode 100644 index df777584af..0000000000 --- a/ext/spice/src/cspice/sdiffc.c +++ /dev/null @@ -1,322 +0,0 @@ -/* sdiffc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SDIFFC ( Symmetric difference of two character sets ) */ -/* Subroutine */ int sdiffc_(char *a, char *b, char *c__, ftnlen a_len, - ftnlen b_len, ftnlen c_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer over, acard, bcard; - extern integer cardc_(char *, ftnlen); - integer ccard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - integer csize; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - integer apoint, bpoint; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), excess_(integer *, char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Take the symmetric difference of two character sets to form */ -/* a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Symmetric difference of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the symmetric difference of A and B */ -/* (that is, all of the elements which are in A */ -/* OR in B, but NOT in both). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the symmetric difference of */ -/* A and B, then only as many items as will fit in C */ -/* are included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The SYMMETRIC DIFFERENCE of two sets contains every */ -/* element which is in the first set OR in the second set, */ -/* but NOT in both sets. */ - -/* {a,b} sym. difference {c,d} = {a,b,c,d} */ -/* {a,b,c} {b,c,d} {a,d} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {a,b,c,d} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL SDIFFC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the symmetric difference of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL SDIFFI ( CURRENT, NEW, CURRENT ) */ -/* CALL SDIFFI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL SDIFFI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the symmetric difference of the two sets causes an excess */ -/* of elements, the error SPICE(SETEXCESS) is signalled. */ - -/* 2) If length of the elements of the output set is < the */ -/* maximum of the lengths of the elements of the input */ -/* sets, the error SPICE(ELEMENTSTOOSHORT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Modified call to CHKOUT to be consistent with CHKIN. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* symmetric difference of two character sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 05-JAN-1989 (NJB) */ - -/* Error signalled if output set elements are not long enough. */ -/* Length must be at least max of lengths of input elements. */ -/* Also, calling protocol for EXCESS has been changed. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("SDIFFC", (ftnlen)6); - -/* Make sure output set elements are long enough. */ - -/* Computing MAX */ - i__1 = i_len(a, a_len), i__2 = i_len(b, b_len); - if (i_len(c__, c_len) < max(i__1,i__2)) { - setmsg_("Length of output cell is #. Length required to contain res" - "ult is #.", (ftnlen)68); - i__1 = i_len(c__, c_len); - errint_("#", &i__1, (ftnlen)1); -/* Computing MAX */ - i__2 = i_len(a, a_len), i__3 = i_len(b, b_len); - i__1 = max(i__2,i__3); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(ELEMENTSTOOSHORT)", (ftnlen)23); - chkout_("SDIFFC", (ftnlen)6); - return 0; - } - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardc_(a, a_len); - bcard = cardc_(b, b_len); - csize = sizec_(c__, c_len); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of both input sets are reached, we're done. */ - - while(apoint <= acard || bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (apoint > acard) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, b + (bpoint + 5) * b_len, - c_len, b_len); - ++bpoint; - } else if (bpoint > bcard) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - } else if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len) == 0) { - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - } else if (l_lt(b + (bpoint + 5) * b_len, a + (apoint + 5) * - a_len, b_len, a_len)) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, b + (bpoint + 5) * b_len, - c_len, b_len); - ++bpoint; - } - -/* Otherwise, stop folling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (apoint > acard) { - ++over; - ++bpoint; - } else if (bpoint > bcard) { - ++over; - ++apoint; - } else if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len) == 0) { - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++over; - ++apoint; - } else if (l_lt(b + (bpoint + 5) * b_len, a + (apoint + 5) * - a_len, b_len, a_len)) { - ++over; - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardc_(&ccard, c__, c_len); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("SDIFFC", (ftnlen)6); - return 0; -} /* sdiffc_ */ - diff --git a/ext/spice/src/cspice/sdiffd.c b/ext/spice/src/cspice/sdiffd.c deleted file mode 100644 index 5397a4bf5c..0000000000 --- a/ext/spice/src/cspice/sdiffd.c +++ /dev/null @@ -1,272 +0,0 @@ -/* sdiffd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SDIFFD ( Symmetric difference of two double precision sets ) */ -/* Subroutine */ int sdiffd_(doublereal *a, doublereal *b, doublereal *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Take the symmetric difference of two double precision sets */ -/* to form a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Symmetric difference of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the symmetric difference of A and B */ -/* (that is, all of the elements which are in A */ -/* OR in B, but NOT in both). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the symmetric difference of */ -/* A and B, then only as many items as will fit in C */ -/* are included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The SYMMETRIC DIFFERENCE of two sets contains every */ -/* element which is in the first set OR in the second set, */ -/* but NOT in both sets. */ - -/* {a,b} sym. difference {c,d} = {a,b,c,d} */ -/* {a,b,c} {b,c,d} {a,d} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {a,b,c,d} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL SDIFFC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the symmetric difference of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL SDIFFI ( CURRENT, NEW, CURRENT ) */ -/* CALL SDIFFI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL SDIFFI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the symmetric difference of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* symmetric difference of two d.p. sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("SDIFFD", (ftnlen)6); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of both input sets are reached, we're done. */ - - while(apoint <= acard || bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (apoint > acard) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } else if (bpoint > bcard) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (apoint > acard) { - ++over; - ++bpoint; - } else if (bpoint > bcard) { - ++over; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++over; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++over; - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardd_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("SDIFFD", (ftnlen)6); - return 0; -} /* sdiffd_ */ - diff --git a/ext/spice/src/cspice/sdiffi.c b/ext/spice/src/cspice/sdiffi.c deleted file mode 100644 index 1304257a7f..0000000000 --- a/ext/spice/src/cspice/sdiffi.c +++ /dev/null @@ -1,272 +0,0 @@ -/* sdiffi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SDIFFI ( Symmetric difference of two integer sets ) */ -/* Subroutine */ int sdiffi_(integer *a, integer *b, integer *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Take the symmetric difference of two integer sets to form */ -/* a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Symmetric difference of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the symmetric difference of A and B */ -/* (that is, all of the elements which are in A */ -/* OR in B, but NOT in both). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the symmetric difference of */ -/* A and B, then only as many items as will fit in C */ -/* are included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The SYMMETRIC DIFFERENCE of two sets contains every */ -/* element which is in the first set OR in the second set, */ -/* but NOT in both sets. */ - -/* {a,b} sym. difference {c,d} = {a,b,c,d} */ -/* {a,b,c} {b,c,d} {a,d} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {a,b,c,d} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL SDIFFC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the symmetric difference of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL SDIFFI ( CURRENT, NEW, CURRENT ) */ -/* CALL SDIFFI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL SDIFFI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the symmetric difference of the two sets causes an excess of */ -/* elements, the error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* symmetric difference of two integer sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */ - -/* Calling protocol of EXCESS changed. Call to SETMSG removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("SDIFFI", (ftnlen)6); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardi_(a); - bcard = cardi_(b); - csize = sizei_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the end of both input sets are reached, we're done. */ - - while(apoint <= acard || bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (apoint > acard) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } else if (bpoint > bcard) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } - -/* Otherwise, stop folling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (apoint > acard) { - ++over; - ++bpoint; - } else if (bpoint > bcard) { - ++over; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++over; - ++apoint; - } else if (b[bpoint + 5] < a[apoint + 5]) { - ++over; - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardi_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("SDIFFI", (ftnlen)6); - return 0; -} /* sdiffi_ */ - diff --git a/ext/spice/src/cspice/set_c.c b/ext/spice/src/cspice/set_c.c deleted file mode 100644 index e4ef5447e4..0000000000 --- a/ext/spice/src/cspice/set_c.c +++ /dev/null @@ -1,354 +0,0 @@ -/* - --Procedure set_c ( Compare sets ) - --Abstract - - Given a relational operator, compare two sets of any data type. - --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 - - CELLS, SETS - --Keywords - - CELLS, SETS - -*/ - - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - SpiceBoolean set_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I First set. - op I Comparison operator. - b I Second set. - - The function returns the result of the comparison: a (op) b. - --Detailed_Input - - - a is a CSPICE set. a must be declared as a character, - double precision, or integer SpiceCell. - - - op is a comparison operator, indicating the way in - which the input sets are to be compared. op may - be any of the following: - - Operator Meaning - -------- ------------------------------------- - "=" a = b is true if a and b are equal - (contain the same elements). - - "<>" a <> b is true if a and b are not - equal. - - "<=" a <= b is true if a is a subset of b. - - "<" a < b is true if a is a proper subset - of b. - - ">=" a >= b is true if b is a subset of a. - - ">" a > b is true if b is a proper subset - of a. - - "&" a & b is true if a and b have one or more - elements in common (the intersection of - the two sets in non-empty.) - - "~" a ~ b is true if a and b are disjoint - sets. - - When comparing elements of character sets, this routine - ignores trailing blanks. - - b is a CSPICE set of the same data type as a. - --Detailed_Output - - The function returns the result of the comparison: a (op) b. - --Parameters - - None. - --Exceptions - - 1) If the set relational operator is not recognized, the error - SPICE(INVALIDOPERATION) is signaled. - - 2) The error SPICE(EMPTYSTRING) is signaled if the input operator - string does not contain at least one character, since this - input string cannot be converted to a Fortran-style string - in this case. - - 3) The error SPICE(NULLPOINTER) is signalled if the input operator - string pointer is null. - - 4) If the input set arguments don't have identical data types, - the error SPICE(TYPEMISMATCH) is signaled. - - 5) If either of the input set arguments may be unordered or contain - duplicates, the error SPICE(NOTASET) is signaled. - --Files - - None. - --Particulars - - None. - --Examples - - 1) In the following code fragment, set_c is used to repeat an operation - for as long as the integer set finished remains a proper - subset of the integer set planned. - - #include "SpiceUsr.h" - . - . - . - while ( set_c( &finished, "<", &planned ) ) - { - . - . - . - } - - - 2) In the following example, let the integer sets a, b, and c - contain the elements listed below. Let e be an empty integer - set. - - a b c - --- --- --- - 1 1 1 - 2 3 3 - 3 - 4 - - Then all of the following expressions are SPICETRUE. - - set_c ( b, "=", c ) "b is equal to c" - set_c ( a, "<>", c ) "a is not equal to c" - set_c ( a, ">", b ) "a is a proper superset of b" - set_c ( b, "<=", c ) "b is a subset of c" - set_c ( c, "<=", b ) "c is a subset of b" - set_c ( a, "<=", a ) "a is a subset of a" - set_c ( e, "<=", b ) "e is a subset of b" - set_c ( e, "<", b ) "e is a proper subset of b" - set_c ( e, "<=", e ) "e is a subset of e" - set_c ( a, "&", b ) "a has elements in common with b." - set_c ( b, "&", c ) "b has elements in common with c." - - And all of the following are SPICEFALSE. - - set_c ( b, "<>", c ) "b is not equal to c" - set_c ( a, "=", c ) "a is equal to c" - set_c ( a, "<", b ) "a is a proper subset of b" - set_c ( b, "<", c ) "b is a proper subset of c" - set_c ( b, ">=", a ) "b is a superset of a" - set_c ( a, ">", a ) "a is a proper superset of a" - set_c ( e, ">=", a ) "e is a superset of a" - set_c ( e, "<", e ) "e is a proper subset of e" - set_c ( a, "~", b ) "a and b are disjoint sets." - --Restrictions - - 1) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input sets 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) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 15-FEB-2005 (NJB) - - Bug fix: loop bound changed from 1 to 2 in loop used - to free dynamically allocated arrays. - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - compare sets - --& -*/ - -{ /* Begin set_c */ - - - /* - Local variables - */ - SpiceBoolean retval; - - SpiceChar * fCell[2]; - - SpiceInt fLen [2]; - SpiceInt i; - - - /* - Standard SPICE error handling. - */ - - if ( return_c() ) - { - return ( SPICEFALSE ); - } - chkin_c ( "set_c" ); - - - /* - Check the input string op to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "set_c", op, SPICEFALSE ); - - - /* - Make sure data types match. - */ - CELLMATCH2_VAL ( CHK_STANDARD, "set_c", a, b, SPICEFALSE ); - - - /* - Make sure the input cells are sets. - */ - CELLISSETCHK2_VAL ( CHK_STANDARD, "set_c", a, b, SPICEFALSE ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT2 ( a, b ); - - - /* - Call the set routine appropriate for the data type of the cells. - */ - if ( a->dtype == SPICE_CHR ) - { - - /* - Construct Fortran-style sets suitable for passing to setc_. - */ - C2F_MAP_CELL2 ( "set_c", - a, fCell, fLen, - b, fCell+1, fLen+1 ); - - - if ( failed_c() ) - { - chkout_c ( "set_c" ); - return ( SPICEFALSE ); - } - - - retval = (SpiceBoolean) setc_ ( (char * ) fCell[0], - (char * ) op, - (char * ) fCell[1], - (ftnlen ) fLen[0], - (ftnlen ) strlen(op), - (ftnlen ) fLen[1] ); - /* - We're done with the dynamically allocated Fortran-style arrays. - */ - for ( i = 0; i < 2; i++ ) - { - free ( fCell[i] ); - } - } - - else if ( a->dtype == SPICE_DP ) - { - - retval = (SpiceBoolean) setd_ ( (doublereal * ) (a->base), - (char * ) op, - (doublereal * ) (b->base), - (ftnlen ) strlen(op) ); - } - - else if ( a->dtype == SPICE_INT ) - { - retval = (SpiceBoolean) seti_ ( (integer * ) (a->base), - (char * ) op, - (integer * ) (b->base), - (ftnlen ) strlen(op) ); - } - - else - { - /* - We get to this point only if we have an invalid cell type. - */ - setmsg_c ( "Cell a contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (a->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "set_c" ); - return ( SPICEFALSE ); - } - - - chkout_c ( "set_c" ); - return ( retval ); - - -} /* End set_c */ diff --git a/ext/spice/src/cspice/setc.c b/ext/spice/src/cspice/setc.c deleted file mode 100644 index e03878e2b6..0000000000 --- a/ext/spice/src/cspice/setc.c +++ /dev/null @@ -1,602 +0,0 @@ -/* setc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SETC ( Compare character sets ) */ -logical setc_(char *a, char *op, char *b, ftnlen a_len, ftnlen op_len, ftnlen - b_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer cond, carda, cardb; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer condab, condoa, condob, indexa, condeq, indexb, condgt, condlt; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Given a relational operator, compare two character sets. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First set. */ -/* OP I Comparison operator. */ -/* B I Second set. */ - -/* The function returns the result of the comparison: A (OP) B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* OP is a comparison operator, indicating the way in */ -/* which the input sets are to be compared. OP may */ -/* be any of the following: */ - -/* Operator Meaning */ -/* -------- ------------------------------------- */ -/* '=' A = B is true if A and B are equal */ -/* (contain the same elements). */ - -/* '<>' A <> B is true if A and B are not */ -/* equal. */ - -/* '<=' A <= B is true if A is a subset of B. */ - -/* '<' A < B is true if A is a proper subset */ -/* of B. */ - -/* '>=' A >= B is true if B is a subset of A. */ - -/* '>' A > B is true if B is a proper subset */ -/* of A. */ - -/* '&' A & B is true if A and B have one or */ -/* more elements in common. (The */ -/* intersection of the two sets in */ -/* non-empty.) */ - -/* '~' A ~ B is true if A and B are disjoint */ -/* sets. */ - -/* B is a set. */ - -/* $ Detailed_Output */ - -/* The function returns the result of the comparison: A (OP) B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* 1) In the following example, SETx is used to repeat an operation */ -/* for as long as the integer set FINISHED remains a proper */ -/* subset of the integer set PLANNED. */ - -/* DO WHILE ( SETx ( FINISHED, '<', PLANNED ) ) */ -/* . */ -/* . */ -/* END DO */ - - -/* 2) In the following example, let the integer sets A, B, and C */ -/* contain the elements listed below. Let E be an empty integer */ -/* set. */ - -/* A B C */ -/* --- --- --- */ -/* 1 1 1 */ -/* 2 3 3 */ -/* 3 */ -/* 4 */ - -/* Then all of the following expressions are true. */ - -/* SETI ( B, '=', C ) "B is equal to C" */ -/* SETI ( A, '<>', C ) "A is not equal to C" */ -/* SETI ( A, '>', B ) "A is a proper superset of B" */ -/* SETI ( B, '<=', C ) "B is a subset of C" */ -/* SETI ( C, '<=', B ) "C is a subset of B" */ -/* SETI ( A, '<=', A ) "A is a subset of A" */ -/* SETI ( E, '<=', B ) "E is a subset of B" */ -/* SETI ( E, '<', B ) "E is a proper subset of B" */ -/* SETI ( E, '<=', E ) "E is a subset of E" */ -/* SETI ( A, '&', B ) "A has elements in common with B." */ -/* SETI ( B, '&', C ) "B has elements in common with C." */ - -/* And all of the following are false. */ - -/* SETI ( B, '<>', C ) "B is not equal to C" */ -/* SETI ( A, '=', C ) "A is equal to C" */ -/* SETI ( A, '<', B ) "A is a proper subset of B" */ -/* SETI ( B, '<', C ) "B is a proper subset of C" */ -/* SETI ( B, '>=', A ) "B is a superset of A" */ -/* SETI ( A, '>', A ) "A is a proper superset of A" */ -/* SETI ( E, '>=', A ) "E is a superset of A" */ -/* SETI ( E, '<', E ) "E is a proper subset of E" */ -/* SETI ( A, '~', B ) "A and B are disjoint sets." */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* If the set relational operator is not recognized, the error */ -/* SPICE(INVALIDOPERATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* compare character sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 11-JAN-1989 (WLT) (HAN) */ - -/* The old version was not compatible with the error handling */ -/* mechanism. Taking the difference of sets A and B caused an */ -/* overflow of the set DIFF, whose dimension was one. The method of */ -/* determining the function value has been redesigned, and the */ -/* difference of the sets is no longer computed. */ - -/* The new routine recognizes two new operators, '~' and '&'. */ -/* If the operator is not recognized, an error is now signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("SETC", (ftnlen)4); - ret_val = FALSE_; - } - -/* Obtain the cardinality of the sets. */ - - carda = cardc_(a, a_len); - cardb = cardc_(b, b_len); - -/* The easiest way to compare two sets is to list them side by side */ -/* as shown below: */ - -/* Set A Set B */ -/* ----- ----- */ -/* 1 1 */ -/* 2 */ -/* 3 3 */ -/* 4 4 */ -/* 5 */ -/* 6 */ -/* 7 7 */ - -/* When listed this way, one can easily determine intersections, */ -/* differences, and unions. Moreover, to determine if one set */ -/* is a subset of another, if they are equal, etc, one can just */ -/* inspect the two lists. */ - -/* We can mimick this in an algorithm. The main trick is to figure */ -/* out how to list the sets in this way. Once we know how to */ -/* list them, we can simply adapt the listing algorithm to get */ -/* a comparison algorithm. */ - -/* By the time we get this far, we know that our sets have distinct */ -/* elements and they are ordered. To write out the list above, */ -/* we start at the beginning of both sets (they're ordered, */ -/* remember?). Look at the next element of A and the next element */ -/* of B ( to start out ``next'' means ``first'' ). If the item */ -/* from A is smaller it should be written and space should be left */ -/* in the B column. If they are the same write them both. Otherwise, */ -/* the item from B is smaller, so leave space in the A column and */ -/* write the item from B. Continue until you run out of items in */ -/* one of the sets. Then just write down all those remaining in the */ -/* other set in the appropriate column. This is what the loop */ -/* below does. */ - - -/* NEXTA = 1 */ -/* NEXTB = 1 */ - -/* DO WHILE ( ( NEXTA .LT. CARD(A) ) */ -/* . .AND. ( NEXTB .LT. CARD(B) ) ) */ - -/* IF ( A(NEXTA) .LT. B(NEXTB) ) THEN */ - -/* WRITE (UNIT,*) A(NEXTA), SPACES */ -/* NEXTA = NEXTA + 1 */ - -/* ELSE IF ( A(NEXTA) .EQ. B(NEXTB) ) THEN */ - -/* WRITE (UNIT,*) A(NEXTA), B(NEXTB) */ -/* NEXTA = NEXTA + 1 */ -/* NEXTB = NEXTB + 1 */ - -/* ELSE */ - -/* WRITE (UNIT,*) SPACES, B(NEXTB) */ -/* NEXTB = NEXTB + 1 */ - -/* END IF */ -/* END DO */ - -/* DO NEXTA = 1, CARD(A) */ -/* WRITE (UNIT,*) A(NEXTA),SPACES */ -/* END DO */ - -/* DO NEXTB = 1, CARD(B) */ -/* WRITE (UNIT,*) B(NEXTB),SPACES */ -/* END DO */ - - -/* This also gives us a way to compare the elements of the two */ -/* sets one item at a time. Instead of writing the items, we */ -/* can make a decision as to whether or not the sets have the */ -/* relationship we are interested in. */ - -/* At the beginning of the loop we assume that the two sets are */ -/* related in the way we want. Once the comparison has been made */ -/* we can decide if they are still related in that way. If not, */ -/* we can RETURN .FALSE. Using psuedo-code the loop is modified */ -/* as shown below. */ - -/* NEXTA = 1 */ -/* NEXTB = 1 */ - -/* DO WHILE ( ( NEXTA .LT. CARD(A) ) */ -/* . .AND. ( NEXTB .LT. CARD(B) ) ) */ - -/* IF ( A(NEXTA) .LT. B(NEXTB) ) THEN */ - -/* RELATED = RELATIONSHIP_OF_INTEREST(AB) */ -/* NEXTB = NEXTB + 1 */ - -/* END IF */ - -/* IF ( SURE_NOW(RELATED) ) THEN */ -/* RETURN with the correct value. */ -/* ELSE */ -/* Keep going. */ -/* END IF */ - -/* END DO */ - - -/* Using the cardinality of the two sets, some function */ -/* values can be determined right away. If the cardinality */ -/* is not enough, we need to set up some conditions for the */ -/* loop which compares the individual elements of the sets. */ - - -/* A cannot be a proper subset of B if the cardinality of A is */ -/* greater than or equal to the cardinality of B. */ - - if (s_cmp(op, "<", op_len, (ftnlen)1) == 0) { - if (carda >= cardb) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 1; - condoa = 0; - condob = 1; - condab = 1; - } - -/* A cannot be a subset of B if A contains more elements than B. */ - - } else if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0) { - if (carda > cardb) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 1; - condoa = 0; - condob = 1; - condab = 1; - } - -/* If the cardinality of the two sets is not equal, there's no way */ -/* that the two sets could be equal. */ - - } else if (s_cmp(op, "=", op_len, (ftnlen)1) == 0) { - if (carda != cardb) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 0; - condoa = 0; - condob = 0; - condab = 1; - } - -/* If the cardinality of the two sets is not equal, the sets */ -/* are not equal. */ - - } else if (s_cmp(op, "<>", op_len, (ftnlen)2) == 0) { - if (carda != cardb) { - ret_val = TRUE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 2; - condeq = 1; - condgt = 2; - condoa = 0; - condob = 0; - condab = 0; - } - -/* B cannot be a proper subset of A if the cardinality of A is less */ -/* than or equal to the cardinality of B. */ - - } else if (s_cmp(op, ">", op_len, (ftnlen)1) == 0) { - if (carda <= cardb) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 1; - condgt = 0; - condoa = 1; - condob = 0; - condab = 1; - } - -/* B cannot be a subset of A if B contains more elements than A. */ - - } else if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0) { - if (carda < cardb) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 1; - condgt = 0; - condoa = 1; - condob = 0; - condab = 1; - } - -/* If the cardinality of one of the sets is zero, they can't */ -/* possibly have any elements in common. */ - - } else if (s_cmp(op, "&", op_len, (ftnlen)1) == 0) { - if (carda == 0 || cardb == 0) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 2; - condgt = 1; - condoa = 0; - condob = 0; - } - -/* If either A or B is the null set, the two sets are disjoint. */ - - } else if (s_cmp(op, "~", op_len, (ftnlen)1) == 0) { - if (carda == 0 || cardb == 0) { - ret_val = TRUE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 0; - condgt = 1; - condoa = 1; - condob = 1; - } - -/* If the relational operator is not recognized, signal an */ -/* error. */ - - } else { - setmsg_("Relational operator, *, is not recognized.", (ftnlen)42); - errch_("*", op, (ftnlen)1, op_len); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - chkout_("SETC", (ftnlen)4); - return ret_val; - } - -/* Initialize counters used for checking the elements of the sets. */ - - indexa = 1; - indexb = 1; - cond = 0; - -/* If we've come this far we need to check the elements of the */ -/* sets to determine the function value. */ - - while(indexa <= carda && indexb <= cardb) { - if (s_cmp(a + (indexa + 5) * a_len, b + (indexb + 5) * b_len, a_len, - b_len) < 0) { - cond = condlt; - ++indexa; - } else if (s_cmp(a + (indexa + 5) * a_len, b + (indexb + 5) * b_len, - a_len, b_len) == 0) { - cond = condeq; - ++indexa; - ++indexb; - } else { - cond = condgt; - ++indexb; - } - -/* At this point, there are several cases which allow us to */ -/* determine the function value without continuing to compare */ -/* the elements of the sets: */ - -/* 1. If the operator is '~' and a common element was found, */ -/* the sets are not disjoint ( COND = 0 ). */ - -/* 2. If the operator is '&' and a common element was found, */ -/* the sets have at least one common element ( COND = 2 ). */ - -/* 3. If the sets are being compared for containment, and the */ -/* first element of the "contained" set is less than the first */ -/* element of the "containing" set, the "contained" set */ -/* cannot be a subset of the "containing" set ( COND = 0 ). */ - -/* 4. If the operator is '=' and the elements being compared are */ -/* not equal, the sets are not equal ( COND = 0 ). */ - -/* 5. If the operator is '<>' and the elements being compared are */ -/* not equal, the sets are not equal ( COND = 2 ). */ - - - if (cond == 0) { - ret_val = FALSE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } else if (cond == 2) { - ret_val = TRUE_; - chkout_("SETC", (ftnlen)4); - return ret_val; - } - } - -/* We've exited the loop, so now we need to make a decision based on */ -/* what's left over. */ - - -/* We've gone through all of set B and there are elements left in */ -/* A. */ - - if (indexa <= carda) { - cond = condoa; - -/* We've gone through all of set A and there are elements left in */ -/* B. */ - - } else if (indexb <= cardb) { - cond = condob; - -/* We've gone through both the sets. */ - - } else { - cond = condab; - } - -/* Determine the value of SETC from the results. */ - - ret_val = cond == 1; - chkout_("SETC", (ftnlen)4); - return ret_val; -} /* setc_ */ - diff --git a/ext/spice/src/cspice/setd.c b/ext/spice/src/cspice/setd.c deleted file mode 100644 index 49af97c110..0000000000 --- a/ext/spice/src/cspice/setd.c +++ /dev/null @@ -1,599 +0,0 @@ -/* setd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SETD ( Compare double precision sets ) */ -logical setd_(doublereal *a, char *op, doublereal *b, ftnlen op_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer cond, carda, cardb; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer condab, condoa, condob, indexa, condeq, indexb, condgt, condlt; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Given a relational operator, compare two double precision sets. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First set. */ -/* OP I Comparison operator. */ -/* B I Second set. */ - -/* The function returns the result of the comparison: A (OP) B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* OP is a comparison operator, indicating the way in */ -/* which the input sets are to be compared. OP may */ -/* be any of the following: */ - -/* Operator Meaning */ -/* -------- ------------------------------------- */ -/* '=' A = B is true if A and B are equal */ -/* (contain the same elements). */ - -/* '<>' A <> B is true if A and B are not */ -/* equal. */ - -/* '<=' A <= B is true if A is a subset of B. */ - -/* '<' A < B is true if A is a proper subset */ -/* of B. */ - -/* '>=' A >= B is true if B is a subset of A. */ - -/* '>' A > B is true if B is a proper subset */ -/* of A. */ - -/* '&' A & B is true if A and B have one or */ -/* more elements in common. (The */ -/* intersection of the two sets in */ -/* non-empty.) */ - -/* '~' A ~ B is true if A and B are disjoint */ -/* sets. */ - -/* B is a set. */ - -/* $ Detailed_Output */ - -/* The function returns the result of the comparison: A (OP) B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* 1) In the following example, SETx is used to repeat an operation */ -/* for as long as the integer set FINISHED remains a proper */ -/* subset of the integer set PLANNED. */ - -/* DO WHILE ( SETx ( FINISHED, '<', PLANNED ) ) */ -/* . */ -/* . */ -/* END DO */ - - -/* 2) In the following example, let the integer sets A, B, and C */ -/* contain the elements listed below. Let E be an empty integer */ -/* set. */ - -/* A B C */ -/* --- --- --- */ -/* 1 1 1 */ -/* 2 3 3 */ -/* 3 */ -/* 4 */ - -/* Then all of the following expressions are true. */ - -/* SETI ( B, '=', C ) "B is equal to C" */ -/* SETI ( A, '<>', C ) "A is not equal to C" */ -/* SETI ( A, '>', B ) "A is a proper superset of B" */ -/* SETI ( B, '<=', C ) "B is a subset of C" */ -/* SETI ( C, '<=', B ) "C is a subset of B" */ -/* SETI ( A, '<=', A ) "A is a subset of A" */ -/* SETI ( E, '<=', B ) "E is a subset of B" */ -/* SETI ( E, '<', B ) "E is a proper subset of B" */ -/* SETI ( E, '<=', E ) "E is a subset of E" */ -/* SETI ( A, '&', B ) "A has elements in common with B." */ -/* SETI ( B, '&', C ) "B has elements in common with C." */ - -/* And all of the following are false. */ - -/* SETI ( B, '<>', C ) "B is not equal to C" */ -/* SETI ( A, '=', C ) "A is equal to C" */ -/* SETI ( A, '<', B ) "A is a proper subset of B" */ -/* SETI ( B, '<', C ) "B is a proper subset of C" */ -/* SETI ( B, '>=', A ) "B is a superset of A" */ -/* SETI ( A, '>', A ) "A is a proper superset of A" */ -/* SETI ( E, '>=', A ) "E is a superset of A" */ -/* SETI ( E, '<', E ) "E is a proper subset of E" */ -/* SETI ( A, '~', B ) "A and B are disjoint sets." */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* If the set relational operator is not recognized, the error */ -/* SPICE(INVALIDOPERATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* compare d.p. sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 11-JAN-1989 (WLT) (HAN) */ - -/* The old version was not compatible with the error handling */ -/* mechanism. Taking the difference of sets A and B caused an */ -/* overflow of the set DIFF, whose dimension was one. The method of */ -/* determining the function value has been redesigned, and the */ -/* difference of the sets is no longer computed. */ - -/* The new routine recognizes two new operators, '~' and '&'. */ -/* If the operator is not recognized, an error is now signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("SETD", (ftnlen)4); - ret_val = FALSE_; - } - -/* Obtain the cardinality of the sets. */ - - carda = cardd_(a); - cardb = cardd_(b); - -/* The easiest way to compare two sets is to list them side by side */ -/* as shown below: */ - -/* Set A Set B */ -/* ----- ----- */ -/* 1 1 */ -/* 2 */ -/* 3 3 */ -/* 4 4 */ -/* 5 */ -/* 6 */ -/* 7 7 */ - -/* When listed this way, one can easily determine intersections, */ -/* differences, and unions. Moreover, to determine if one set */ -/* is a subset of another, if they are equal, etc, one can just */ -/* inspect the two lists. */ - -/* We can mimick this in an algorithm. The main trick is to figure */ -/* out how to list the sets in this way. Once we know how to */ -/* list them, we can simply adapt the listing algorithm to get */ -/* a comparison algorithm. */ - -/* By the time we get this far, we know that our sets have distinct */ -/* elements and they are ordered. To write out the list above, */ -/* we start at the beginning of both sets (they're ordered, */ -/* remember?). Look at the next element of A and the next element */ -/* of B ( to start out ``next'' means ``first'' ). If the item */ -/* from A is smaller it should be written and space should be left */ -/* in the B column. If they are the same write them both. Otherwise, */ -/* the item from B is smaller, so leave space in the A column and */ -/* write the item from B. Continue until you run out of items in */ -/* one of the sets. Then just write down all those remaining in the */ -/* other set in the appropriate column. This is what the loop */ -/* below does. */ - - -/* NEXTA = 1 */ -/* NEXTB = 1 */ - -/* DO WHILE ( ( NEXTA .LT. CARD(A) ) */ -/* . .AND. ( NEXTB .LT. CARD(B) ) ) */ - -/* IF ( A(NEXTA) .LT. B(NEXTB) ) THEN */ - -/* WRITE (UNIT,*) A(NEXTA), SPACES */ -/* NEXTA = NEXTA + 1 */ - -/* ELSE IF ( A(NEXTA) .EQ. B(NEXTB) ) THEN */ - -/* WRITE (UNIT,*) A(NEXTA), B(NEXTB) */ -/* NEXTA = NEXTA + 1 */ -/* NEXTB = NEXTB + 1 */ - -/* ELSE */ - -/* WRITE (UNIT,*) SPACES, B(NEXTB) */ -/* NEXTB = NEXTB + 1 */ - -/* END IF */ -/* END DO */ - -/* DO NEXTA = 1, CARD(A) */ -/* WRITE (UNIT,*) A(NEXTA),SPACES */ -/* END DO */ - -/* DO NEXTB = 1, CARD(B) */ -/* WRITE (UNIT,*) B(NEXTB),SPACES */ -/* END DO */ - - -/* This also gives us a way to compare the elements of the two */ -/* sets one item at a time. Instead of writing the items, we */ -/* can make a decision as to whether or not the sets have the */ -/* relationship we are interested in. */ - -/* At the beginning of the loop we assume that the two sets are */ -/* related in the way we want. Once the comparison has been made */ -/* we can decide if they are still related in that way. If not, */ -/* we can RETURN .FALSE. Using psuedo-code the loop is modified */ -/* as shown below. */ - -/* NEXTA = 1 */ -/* NEXTB = 1 */ - -/* DO WHILE ( ( NEXTA .LT. CARD(A) ) */ -/* . .AND. ( NEXTB .LT. CARD(B) ) ) */ - -/* IF ( A(NEXTA) .LT. B(NEXTB) ) THEN */ - -/* RELATED = RELATIONSHIP_OF_INTEREST(AB) */ -/* NEXTB = NEXTB + 1 */ - -/* END IF */ - -/* IF ( SURE_NOW(RELATED) ) THEN */ -/* RETURN with the correct value. */ -/* ELSE */ -/* Keep going. */ -/* END IF */ - -/* END DO */ - - -/* Using the cardinality of the two sets, some function */ -/* values can be determined right away. If the cardinality */ -/* is not enough, we need to set up some conditions for the */ -/* loop which compares the individual elements of the sets. */ - - -/* A cannot be a proper subset of B if the cardinality of A is */ -/* greater than or equal to the cardinality of B. */ - - if (s_cmp(op, "<", op_len, (ftnlen)1) == 0) { - if (carda >= cardb) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 1; - condoa = 0; - condob = 1; - condab = 1; - } - -/* A cannot be a subset of B if A contains more elements than B. */ - - } else if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0) { - if (carda > cardb) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 1; - condoa = 0; - condob = 1; - condab = 1; - } - -/* If the cardinality of the two sets is not equal, there's no way */ -/* that the two sets could be equal. */ - - } else if (s_cmp(op, "=", op_len, (ftnlen)1) == 0) { - if (carda != cardb) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 0; - condoa = 0; - condob = 0; - condab = 1; - } - -/* If the cardinality of the two sets is not equal, the sets */ -/* are not equal. */ - - } else if (s_cmp(op, "<>", op_len, (ftnlen)2) == 0) { - if (carda != cardb) { - ret_val = TRUE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 2; - condeq = 1; - condgt = 2; - condoa = 0; - condob = 0; - condab = 0; - } - -/* B cannot be a proper subset of A if the cardinality of A is less */ -/* than or equal to the cardinality of B. */ - - } else if (s_cmp(op, ">", op_len, (ftnlen)1) == 0) { - if (carda <= cardb) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 1; - condgt = 0; - condoa = 1; - condob = 0; - condab = 1; - } - -/* B cannot be a subset of A if B contains more elements than A. */ - - } else if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0) { - if (carda < cardb) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 1; - condgt = 0; - condoa = 1; - condob = 0; - condab = 1; - } - -/* If the cardinality of one of the sets is zero, they can't */ -/* possibly have any elements in common. */ - - } else if (s_cmp(op, "&", op_len, (ftnlen)1) == 0) { - if (carda == 0 || cardb == 0) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 2; - condgt = 1; - condoa = 0; - condob = 0; - } - -/* If either A or B is the null set, the two sets are disjoint. */ - - } else if (s_cmp(op, "~", op_len, (ftnlen)1) == 0) { - if (carda == 0 || cardb == 0) { - ret_val = TRUE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 0; - condgt = 1; - condoa = 1; - condob = 1; - } - -/* If the relational operator is not recognized, signal an */ -/* error. */ - - } else { - setmsg_("Relational operator, *, is not recognized.", (ftnlen)42); - errch_("*", op, (ftnlen)1, op_len); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - chkout_("SETD", (ftnlen)4); - return ret_val; - } - -/* Initialize counters used for checking the elements of the sets. */ - - indexa = 1; - indexb = 1; - cond = 0; - -/* If we've come this far we need to check the elements of the */ -/* sets to determine the function value. */ - - while(indexa <= carda && indexb <= cardb) { - if (a[indexa + 5] < b[indexb + 5]) { - cond = condlt; - ++indexa; - } else if (a[indexa + 5] == b[indexb + 5]) { - cond = condeq; - ++indexa; - ++indexb; - } else { - cond = condgt; - ++indexb; - } - -/* At this point, there are several cases which allow us to */ -/* determine the function value without continuing to compare */ -/* the elements of the sets: */ - -/* 1. If the operator is '~' and a common element was found, */ -/* the sets are not disjoint ( COND = 0 ). */ - -/* 2. If the operator is '&' and a common element was found, */ -/* the sets have at least one common element ( COND = 2 ). */ - -/* 3. If the sets are being compared for containment, and the */ -/* first element of the "contained" set is less than the first */ -/* element of the "containing" set, the "contained" set */ -/* cannot be a subset of the "containing" set ( COND = 0 ). */ - -/* 4. If the operator is '=' and the elements being compared are */ -/* not equal, the sets are not equal ( COND = 0 ). */ - -/* 5. If the operator is '<>' and the elements being compared are */ -/* not equal, the sets are not equal ( COND = 2 ). */ - - - if (cond == 0) { - ret_val = FALSE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } else if (cond == 2) { - ret_val = TRUE_; - chkout_("SETD", (ftnlen)4); - return ret_val; - } - } - -/* We've exited the loop, so now we need to make a decision based on */ -/* what's left over. */ - - -/* We've gone through all of set B and there are elements left in */ -/* A. */ - - if (indexa <= carda) { - cond = condoa; - -/* We've gone through all of set A and there are elements left in */ -/* B. */ - - } else if (indexb <= cardb) { - cond = condob; - -/* We've gone through both the sets. */ - - } else { - cond = condab; - } - -/* Determine the value of SETD from the results. */ - - ret_val = cond == 1; - chkout_("SETD", (ftnlen)4); - return ret_val; -} /* setd_ */ - diff --git a/ext/spice/src/cspice/seterr.c b/ext/spice/src/cspice/seterr.c deleted file mode 100644 index 3c736fc5e8..0000000000 --- a/ext/spice/src/cspice/seterr.c +++ /dev/null @@ -1,428 +0,0 @@ -/* seterr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SETERR ( Set Error Status ) */ -logical seterr_0_(int n__, logical *status) -{ - /* Initialized data */ - - static logical svstat = FALSE_; - - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Set the SPICELIB error status. DO NOT CALL THIS ROUTINE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STATUS I Status indicator. */ - - -/* The function takes an UNSPECIFIED (and meaningless) value */ -/* on exit. */ - -/* $ Detailed_Input */ - -/* STATUS Indicates the new status. When .TRUE., it */ -/* means that an error condition exists. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* This purpose of this routine is to set status; the */ -/* function takes an UNSPECIFIED value on exit. The */ -/* assigned value does not have any meaning. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* This is a data structure access routine for the */ -/* SPICELIB status. This routine should be used for no */ -/* other purpose; in particular, it should not be used */ -/* to signal errors. Use SIGERR or FAILED for that. */ - -/* This routine assigns a value to SETERR on exit. */ -/* However, the value is not meaningful. */ - -/* $ Examples */ - -/* None. DON'T CALL THIS ROUTINE. */ - -/* No examples. If you don't know EXACTLY what a */ -/* ``data structure access routine'' is, don't call */ -/* this routine. If you do know, you don't need an */ -/* example. */ - -/* $ Restrictions */ - -/* DON'T CALL THIS ROUTINE. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* Local Variables: */ - - -/* The SPICELIB status: */ - - -/* Declaration of the entry point, FAILED: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_failed; - } - - -/* Executable Code: */ - - svstat = *status; - -/* Give SETERR a value; the value does not have any */ -/* meaning, but it appears standard FORTRAN requires this. */ - - ret_val = TRUE_; - return ret_val; -/* $Procedure FAILED ( Error Status Indicator ) */ - -L_failed: -/* $ Abstract */ - -/* True if an error condition has been signalled via SIGERR. */ -/* FAILED is the SPICELIB status indicator. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* The function takes the value .TRUE. if an error condition */ -/* was detected; it is .FALSE. otherwise. */ - - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* Please read the required reading file before reading this! */ - -/* The value taken by FAILED indicates status. */ - -/* The status value applies to the SPICELIB routines, */ -/* and to any other routines which call the status-setting */ -/* routine, SIGERR. */ - -/* When FAILED has the value, .TRUE., an error condition */ -/* exists. .FALSE. means "no error." */ - -/* More specifically, when FAILED has the value .TRUE., */ -/* some routine has indicated an error by calling the */ -/* SPICELIB routine, SIGERR. All SPICELIB routines */ -/* which can detect errors do this. Non-SPICELIB */ -/* routines may also reference SIGERR if desired. */ - -/* When FAILED has the value .FALSE., either no routine */ -/* has yet signalled an error via SIGERR, or the status */ -/* has been reset using, what else, RESET. */ - -/* FAILED is initialized to have the value, .FALSE. */ -/* This indicates a "no error" status. */ - -/* See "particulars" below for (slightly) more information. */ - - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* However, this routine is part of the SPICELIB error */ -/* handling mechanism. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* See the required reading file for details of error */ -/* processing. However, here are some notes: */ - -/* When any SPICELIB routine detects an error, the */ -/* status is set to indicate an error condition via */ -/* a call to SIGERR. After SIGERR */ -/* returns, further calls to FAILED will return the */ -/* value, .TRUE., indicating an error condition. */ - -/* Non-SPICELIB routines may also call SIGERR to indicate */ -/* an error condition; FAILED will reflect such calls */ -/* as well. */ - -/* It is possible to re-set the error status to indicate */ -/* "no error" using the SPICELIB routine, RESET (see). */ - -/* The effect on FAILED of resetting the status is */ -/* that FAILED will again return the value .FALSE., */ -/* indicating "no error." */ - -/* One of the main virtues of the SPICELIB error */ -/* handling mechanism is that you don't HAVE to test the */ -/* error status after every call to a SPICELIB routine. */ -/* If you set the error handling mode to 'RETURN', using */ -/* the routine, ERRACT, SPICELIB routines won't crash */ -/* when an error occurs; following the detection of the */ -/* error, each routine will return immediately upon entry. */ -/* Therefore, you call several SPICELIB routines in a */ -/* row, and just test status at the end of the sequence */ -/* of calls, if you wish. See "examples" below. */ - - -/* $ Examples */ - -/* 1. Here's an example of a simple call to RDTEXT, followed */ -/* by a test of the status. */ - - -/* C */ -/* C We read a line of text from file SPUD.DAT: */ -/* C */ - -/* CALL RDTEXT ( 'SPUD.DAT', LINE, EOF ) */ - -/* IF ( FAILED() ) THEN */ - -/* C An error occurred during the read. */ - -/* [respond to error here] */ - -/* END IF */ - - -/* 2. Here's an example in which we don't want to */ -/* put the error test inside our loop. We just */ -/* test the error status after the loop terminates. */ -/* We can do this because we (that is, you, the user) */ -/* have made the call, */ - -/* CALL ERRACT ( 'RETURN' ) */ - -/* prior to execution of the following code. If an */ -/* error does occur, the remaining calls to RDTEXT */ -/* will have no effect. Here's the example: */ - -/* C */ -/* C We read the first 5000 lines of a file, or until */ -/* C EOF is reached, whichever comes first: */ -/* C */ -/* C Note: the "DO WHILE" construct is available in */ -/* C VAX FORTRAN. */ -/* C */ - -/* LCOUNT = 0 */ -/* DO WHILE ( ( .NOT. EOF ) .AND. ( LCOUNT .LE. 5000 ) ) */ - -/* CALL RDTEXT ( 'SPUD.DAT', LINE(LCOUNT), EOF ) */ - -/* LCOUNT = LCOUNT + 1 */ - -/* END DO */ - -/* IF ( FAILED() ) THEN */ -/* C */ -/* C An error occurred during the read */ -/* C */ -/* [respond to error here] */ - -/* END IF */ - - - -/* $ Restrictions */ - -/* This routine automatically detects errors occurring in */ -/* the SPICELIB code. To make this routine work */ -/* for your own routines, your routines must call SIGERR */ -/* to report errors. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* error status indicator */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 18-DEC-1989 (HAN) */ - -/* Empty parentheses added to the ENTRY statement in order to */ -/* comply with the ANSI Fortran 77 Standard. */ - -/* -& */ - -/* Executable Code: */ - - -/* Grab saved status value: */ - - ret_val = svstat; - return ret_val; -} /* seterr_ */ - -logical seterr_(logical *status) -{ - return seterr_0_(0, status); - } - -logical failed_(void) -{ - return seterr_0_(1, (logical *)0); - } - diff --git a/ext/spice/src/cspice/seti.c b/ext/spice/src/cspice/seti.c deleted file mode 100644 index 6aebccf209..0000000000 --- a/ext/spice/src/cspice/seti.c +++ /dev/null @@ -1,599 +0,0 @@ -/* seti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SETI ( Compare integer sets ) */ -logical seti_(integer *a, char *op, integer *b, ftnlen op_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer cond, carda, cardb; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer condab, condoa, condob, indexa, condeq, indexb, condgt, condlt; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Given a relational operator, compare two integer sets. */ - -/* $ 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 */ - -/* CELLS, SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First set. */ -/* OP I Comparison operator. */ -/* B I Second set. */ - -/* The function returns the result of the comparison: A (OP) B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* OP is a comparison operator, indicating the way in */ -/* which the input sets are to be compared. OP may */ -/* be any of the following: */ - -/* Operator Meaning */ -/* -------- ------------------------------------- */ -/* '=' A = B is true if A and B are equal */ -/* (contain the same elements). */ - -/* '<>' A <> B is true if A and B are not */ -/* equal. */ - -/* '<=' A <= B is true if A is a subset of B. */ - -/* '<' A < B is true if A is a proper subset */ -/* of B. */ - -/* '>=' A >= B is true if B is a subset of A. */ - -/* '>' A > B is true if B is a proper subset */ -/* of A. */ - -/* '&' A & B is true if A and B have one or */ -/* more elements in common. (The */ -/* intersection of the two sets in */ -/* non-empty.) */ - -/* '~' A ~ B is true if A and B are disjoint */ -/* sets. */ - -/* B is a set. */ - -/* $ Detailed_Output */ - -/* The function returns the result of the comparison: A (OP) B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* 1) In the following example, SETx is used to repeat an operation */ -/* for as long as the integer set FINISHED remains a proper */ -/* subset of the integer set PLANNED. */ - -/* DO WHILE ( SETx ( FINISHED, '<', PLANNED ) ) */ -/* . */ -/* . */ -/* END DO */ - - -/* 2) In the following example, let the integer sets A, B, and C */ -/* contain the elements listed below. Let E be an empty integer */ -/* set. */ - -/* A B C */ -/* --- --- --- */ -/* 1 1 1 */ -/* 2 3 3 */ -/* 3 */ -/* 4 */ - -/* Then all of the following expressions are true. */ - -/* SETI ( B, '=', C ) "B is equal to C" */ -/* SETI ( A, '<>', C ) "A is not equal to C" */ -/* SETI ( A, '>', B ) "A is a proper superset of B" */ -/* SETI ( B, '<=', C ) "B is a subset of C" */ -/* SETI ( C, '<=', B ) "C is a subset of B" */ -/* SETI ( A, '<=', A ) "A is a subset of A" */ -/* SETI ( E, '<=', B ) "E is a subset of B" */ -/* SETI ( E, '<', B ) "E is a proper subset of B" */ -/* SETI ( E, '<=', E ) "E is a subset of E" */ -/* SETI ( A, '&', B ) "A has elements in common with B." */ -/* SETI ( B, '&', C ) "B has elements in common with C." */ - -/* And all of the following are false. */ - -/* SETI ( B, '<>', C ) "B is not equal to C" */ -/* SETI ( A, '=', C ) "A is equal to C" */ -/* SETI ( A, '<', B ) "A is a proper subset of B" */ -/* SETI ( B, '<', C ) "B is a proper subset of C" */ -/* SETI ( B, '>=', A ) "B is a superset of A" */ -/* SETI ( A, '>', A ) "A is a proper superset of A" */ -/* SETI ( E, '>=', A ) "E is a superset of A" */ -/* SETI ( E, '<', E ) "E is a proper subset of E" */ -/* SETI ( A, '~', B ) "A and B are disjoint sets." */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* If the set relational operator is not recognized, the error */ -/* SPICE(INVALIDOPERATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* compare integer sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 11-JAN-1989 (WLT) (HAN) */ - -/* The old version was not compatible with the error handling */ -/* mechanism. Taking the difference of sets A and B caused an */ -/* overflow of the set DIFF, whose dimension was one. The method of */ -/* determining the function value has been redesigned, and the */ -/* difference of the sets is no longer computed. */ - -/* The new routine recognizes two new operators, '~' and '&'. */ -/* If the operator is not recognized, an error is now signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("SETI", (ftnlen)4); - ret_val = FALSE_; - } - -/* Obtain the cardinality of the sets. */ - - carda = cardi_(a); - cardb = cardi_(b); - -/* The easiest way to compare two sets is to list them side by side */ -/* as shown below: */ - -/* Set A Set B */ -/* ----- ----- */ -/* 1 1 */ -/* 2 */ -/* 3 3 */ -/* 4 4 */ -/* 5 */ -/* 6 */ -/* 7 7 */ - -/* When listed this way, one can easily determine intersections, */ -/* differences, and unions. Moreover, to determine if one set */ -/* is a subset of another, if they are equal, etc, one can just */ -/* inspect the two lists. */ - -/* We can mimick this in an algorithm. The main trick is to figure */ -/* out how to list the sets in this way. Once we know how to */ -/* list them, we can simply adapt the listing algorithm to get */ -/* a comparison algorithm. */ - -/* By the time we get this far, we know that our sets have distinct */ -/* elements and they are ordered. To write out the list above, */ -/* we start at the beginning of both sets (they're ordered, */ -/* remember?). Look at the next element of A and the next element */ -/* of B ( to start out ``next'' means ``first'' ). If the item */ -/* from A is smaller it should be written and space should be left */ -/* in the B column. If they are the same write them both. Otherwise, */ -/* the item from B is smaller, so leave space in the A column and */ -/* write the item from B. Continue until you run out of items in */ -/* one of the sets. Then just write down all those remaining in the */ -/* other set in the appropriate column. This is what the loop */ -/* below does. */ - - -/* NEXTA = 1 */ -/* NEXTB = 1 */ - -/* DO WHILE ( ( NEXTA .LT. CARD(A) ) */ -/* . .AND. ( NEXTB .LT. CARD(B) ) ) */ - -/* IF ( A(NEXTA) .LT. B(NEXTB) ) THEN */ - -/* WRITE (UNIT,*) A(NEXTA), SPACES */ -/* NEXTA = NEXTA + 1 */ - -/* ELSE IF ( A(NEXTA) .EQ. B(NEXTB) ) THEN */ - -/* WRITE (UNIT,*) A(NEXTA), B(NEXTB) */ -/* NEXTA = NEXTA + 1 */ -/* NEXTB = NEXTB + 1 */ - -/* ELSE */ - -/* WRITE (UNIT,*) SPACES, B(NEXTB) */ -/* NEXTB = NEXTB + 1 */ - -/* END IF */ -/* END DO */ - -/* DO NEXTA = 1, CARD(A) */ -/* WRITE (UNIT,*) A(NEXTA),SPACES */ -/* END DO */ - -/* DO NEXTB = 1, CARD(B) */ -/* WRITE (UNIT,*) B(NEXTB),SPACES */ -/* END DO */ - - -/* This also gives us a way to compare the elements of the two */ -/* sets one item at a time. Instead of writing the items, we */ -/* can make a decision as to whether or not the sets have the */ -/* relationship we are interested in. */ - -/* At the beginning of the loop we assume that the two sets are */ -/* related in the way we want. Once the comparison has been made */ -/* we can decide if they are still related in that way. If not, */ -/* we can RETURN .FALSE. Using psuedo-code the loop is modified */ -/* as shown below. */ - -/* NEXTA = 1 */ -/* NEXTB = 1 */ - -/* DO WHILE ( ( NEXTA .LT. CARD(A) ) */ -/* . .AND. ( NEXTB .LT. CARD(B) ) ) */ - -/* IF ( A(NEXTA) .LT. B(NEXTB) ) THEN */ - -/* RELATED = RELATIONSHIP_OF_INTEREST(AB) */ -/* NEXTB = NEXTB + 1 */ - -/* END IF */ - -/* IF ( SURE_NOW(RELATED) ) THEN */ -/* RETURN with the correct value. */ -/* ELSE */ -/* Keep going. */ -/* END IF */ - -/* END DO */ - - -/* Using the cardinality of the two sets, some function */ -/* values can be determined right away. If the cardinality */ -/* is not enough, we need to set up some conditions for the */ -/* loop which compares the individual elements of the sets. */ - - -/* A cannot be a proper subset of B if the cardinality of A is */ -/* greater than or equal to the cardinality of B. */ - - if (s_cmp(op, "<", op_len, (ftnlen)1) == 0) { - if (carda >= cardb) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 1; - condoa = 0; - condob = 1; - condab = 1; - } - -/* A cannot be a subset of B if A contains more elements than B. */ - - } else if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0) { - if (carda > cardb) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 1; - condoa = 0; - condob = 1; - condab = 1; - } - -/* If the cardinality of the two sets is not equal, there's no way */ -/* that the two sets could be equal. */ - - } else if (s_cmp(op, "=", op_len, (ftnlen)1) == 0) { - if (carda != cardb) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 0; - condeq = 1; - condgt = 0; - condoa = 0; - condob = 0; - condab = 1; - } - -/* If the cardinality of the two sets is not equal, the sets */ -/* are not equal. */ - - } else if (s_cmp(op, "<>", op_len, (ftnlen)2) == 0) { - if (carda != cardb) { - ret_val = TRUE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 2; - condeq = 1; - condgt = 2; - condoa = 0; - condob = 0; - condab = 0; - } - -/* B cannot be a proper subset of A if the cardinality of A is less */ -/* than or equal to the cardinality of B. */ - - } else if (s_cmp(op, ">", op_len, (ftnlen)1) == 0) { - if (carda <= cardb) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 1; - condgt = 0; - condoa = 1; - condob = 0; - condab = 1; - } - -/* B cannot be a subset of A if B contains more elements than A. */ - - } else if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0) { - if (carda < cardb) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 1; - condgt = 0; - condoa = 1; - condob = 0; - condab = 1; - } - -/* If the cardinality of one of the sets is zero, they can't */ -/* possibly have any elements in common. */ - - } else if (s_cmp(op, "&", op_len, (ftnlen)1) == 0) { - if (carda == 0 || cardb == 0) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 2; - condgt = 1; - condoa = 0; - condob = 0; - } - -/* If either A or B is the null set, the two sets are disjoint. */ - - } else if (s_cmp(op, "~", op_len, (ftnlen)1) == 0) { - if (carda == 0 || cardb == 0) { - ret_val = TRUE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else { - condlt = 1; - condeq = 0; - condgt = 1; - condoa = 1; - condob = 1; - } - -/* If the relational operator is not recognized, signal an */ -/* error. */ - - } else { - setmsg_("Relational operator, *, is not recognized.", (ftnlen)42); - errch_("*", op, (ftnlen)1, op_len); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - chkout_("SETI", (ftnlen)4); - return ret_val; - } - -/* Initialize counters used for checking the elements of the sets. */ - - indexa = 1; - indexb = 1; - cond = 0; - -/* If we've come this far we need to check the elements of the */ -/* sets to determine the function value. */ - - while(indexa <= carda && indexb <= cardb) { - if (a[indexa + 5] < b[indexb + 5]) { - cond = condlt; - ++indexa; - } else if (a[indexa + 5] == b[indexb + 5]) { - cond = condeq; - ++indexa; - ++indexb; - } else { - cond = condgt; - ++indexb; - } - -/* At this point, there are several cases which allow us to */ -/* determine the function value without continuing to compare */ -/* the elements of the sets: */ - -/* 1. If the operator is '~' and a common element was found, */ -/* the sets are not disjoint ( COND = 0 ). */ - -/* 2. If the operator is '&' and a common element was found, */ -/* the sets have at least one common element ( COND = 2 ). */ - -/* 3. If the sets are being compared for containment, and the */ -/* first element of the "contained" set is less than the first */ -/* element of the "containing" set, the "contained" set */ -/* cannot be a subset of the "containing" set ( COND = 0 ). */ - -/* 4. If the operator is '=' and the elements being compared are */ -/* not equal, the sets are not equal ( COND = 0 ). */ - -/* 5. If the operator is '<>' and the elements being compared are */ -/* not equal, the sets are not equal ( COND = 2 ). */ - - - if (cond == 0) { - ret_val = FALSE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } else if (cond == 2) { - ret_val = TRUE_; - chkout_("SETI", (ftnlen)4); - return ret_val; - } - } - -/* We've exited the loop, so now we need to make a decision based on */ -/* what's left over. */ - - -/* We've gone through all of set B and there are elements left in */ -/* A. */ - - if (indexa <= carda) { - cond = condoa; - -/* We've gone through all of set A and there are elements left in */ -/* B. */ - - } else if (indexb <= cardb) { - cond = condob; - -/* We've gone through both the sets. */ - - } else { - cond = condab; - } - -/* Determine the value of SETI from the results. */ - - ret_val = cond == 1; - chkout_("SETI", (ftnlen)4); - return ret_val; -} /* seti_ */ - diff --git a/ext/spice/src/cspice/setmsg.c b/ext/spice/src/cspice/setmsg.c deleted file mode 100644 index c3e4a1a163..0000000000 --- a/ext/spice/src/cspice/setmsg.c +++ /dev/null @@ -1,207 +0,0 @@ -/* setmsg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SETMSG ( Set Long Error Message ) */ -/* Subroutine */ int setmsg_(char *msg, ftnlen msg_len) -{ - extern logical allowd_(void); - extern /* Subroutine */ int putlms_(char *, ftnlen); - -/* $ Abstract */ - -/* Set the value of the current long error message. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MSG I A long error message. */ - -/* $ Detailed_Input */ - -/* MSG A ``long'' error message. */ -/* MSG is a detailed description of the error. */ -/* MSG is supposed to start with the name of the */ -/* module which detected the error, followed by a */ -/* colon. Example: */ - -/* 'RDTEXT: There are no more free logical units' */ - -/* Only the first LMSGLN characters of MSG are stored; */ -/* any further characters are truncated. */ - -/* Generally, MSG will be stored internally by the SPICELIB */ -/* error handling mechanism. The only exception */ -/* is the case in which the user has commanded the */ -/* toolkit to ``ignore'' the error indicated by MSG. */ - -/* As a default, MSG will be output to the screen. */ -/* See the required reading file for a discussion of how */ -/* to customize toolkit error handling behavior, and */ -/* in particular, the disposition of MSG. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* LMSGLN is the maximum length of the long error message. See */ -/* the include file errhnd.inc for the value of LMSGLN. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the interface to the */ -/* SPICELIB error handling mechanism. For this reason, */ -/* this routine does not participate in the trace scheme, */ -/* even though it has external references. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The SPICELIB routine SIGERR should always be called */ -/* AFTER this routine is called, when an error is detected. */ - -/* The effects of this routine are: */ - -/* 1. If acceptance of a new long error message is */ -/* allowed: */ - -/* MSG will be stored internally. As a result, */ -/* The SPICELIB routine, GETMSG, will be able to */ -/* retrieve MSG, until MSG has been ``erased'' */ -/* by a call to RESET, or overwritten by another */ -/* call to SETMSG. */ - - -/* 2. If acceptance of a new long error message is not allowed, */ -/* a call to this routine has no effect. */ - -/* $ Examples */ - - -/* In the following example, N is supposed to be less than */ -/* MAXLUN. If it isn't, an error condition exists. */ - -/* C */ -/* C We will need a free logical unit. But only if we don't */ -/* C have too many files open already. */ -/* C */ - -/* IF ( N .EQ. MAXLUN ) THEN */ - -/* CALL SETMSG ( 'RDTEXT: Too many files open already' ) */ -/* CALL SIGERR ( 'SPICE(TOOMANYFILESOPEN)' ) */ - -/* RETURN */ - -/* END IF */ - - -/* $ Restrictions */ - -/* SIGERR must be called once after each call to this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* set long error message */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.2, 29-JUL-1997 (NJB) */ - -/* Maximum length of the long error message is now represented */ -/* by the parameter LMSGLN. Miscellaneous header fixes were */ -/* made. Some indentation and vertical white space abnormalities */ -/* in the code were fixed. Some dubious comments were deleted */ -/* from the code. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declarations of the unused variable STAT and unused function */ -/* ACCEPT removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* We store the long error message only when updates */ -/* of the long message are allowed: */ - - if (allowd_()) { - putlms_(msg, msg_len); - } - return 0; -} /* setmsg_ */ - diff --git a/ext/spice/src/cspice/setmsg_c.c b/ext/spice/src/cspice/setmsg_c.c deleted file mode 100644 index 46e1cdbcdd..0000000000 --- a/ext/spice/src/cspice/setmsg_c.c +++ /dev/null @@ -1,198 +0,0 @@ -/* - --Procedure setmsg_c ( Set Long Error Message ) - --Abstract - - Set the value of the current long error message. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void setmsg_c ( ConstSpiceChar * message ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - message I A long error message. - --Detailed_Input - - message A ``long'' error message. - message is a detailed description of the error. - message is supposed to start with the name of the - module which detected the error, followed by a - colon. Example: - - "rdtext_c: There are no more free logical units" - - Only the first LMSGLN (see setmsg.c) characters of - message are stored; any further characters are - truncated. - - Generally, message will be stored internally by the - CSPICE error handling mechanism. The only exception - is the case in which the user has commanded the - toolkit to ``ignore'' the error indicated by message. - - As a default, message will be output to the screen. - See the required reading file for a discussion of how - to customize toolkit error handling behavior, and - in particular, the disposition of message. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - This routine does not detect any errors. - - However, this routine is part of the interface to the - CSPICE error handling mechanism. For this reason, - this routine does not participate in the trace scheme, - even though it has external references. - --Files - - None. - --Particulars - - The CSPICE routine sigerr_c should always be called - AFTER this routine is called, when an error is detected. - - The effects of this routine are: - - 1. If acceptance of a new long error message is - allowed: - - message will be stored internally. As a result, - The CSPICE routine, getmsg_ , will be able to - retrieve message, until message has been ``erased'' - by a call to reset_c, or overwritten by another - call to setmsg_c. - - - 2. If acceptance of a new long error message is not allowed, - a call to this routine has no effect. - --Examples - - - In the following example, an error is signaled because the - double precision variable x contains an invalid value. The - value of x and the maximum allowed value MAXVAL are substituted - into the error message at the locations indicated by the # signs - below. - - /. - Indicate that x is out of range if x is too large. - ./ - - if ( x > MAXVAL ) - { - setmsg_c ( "Variable x = #; maximum allowed value is #" ); - errdp_c ( "#", x ); - errdp_c ( "#", MAXVAL ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ) ; - return; - } - - --Restrictions - - sigerr_c must be called once after each call to this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.1, 25-MAR-1998 (EDW) - - Corrected errors in header. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - set long error message - --& -*/ - -{ /* Begin setmsg_c */ - - /* Local Variables */ - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "setmsg_c", message ); - - - /* - Call the f2c'd Fortran routine. - */ - setmsg_ ( ( char * ) message, - ( ftnlen ) strlen(message) ); - - -} /* End setmsg_c */ diff --git a/ext/spice/src/cspice/sfe.c b/ext/spice/src/cspice/sfe.c deleted file mode 100644 index cade56a488..0000000000 --- a/ext/spice/src/cspice/sfe.c +++ /dev/null @@ -1,31 +0,0 @@ -/* sequential formatted external common routines*/ -#include "f2c.h" -#include "fio.h" - -extern char *f__fmtbuf; - -integer e_rsfe(Void) -{ int n; - n=en_fio(); - f__fmtbuf=NULL; - return(n); -} -#ifdef KR_headers -c_sfe(a) cilist *a; /* check */ -#else -c_sfe(cilist *a) /* check */ -#endif -{ unit *p; - f__curunit = p = &f__units[a->ciunit]; - if(a->ciunit >= MXUNIT || a->ciunit<0) - err(a->cierr,101,"startio"); - if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe") - if(!p->ufmt) err(a->cierr,102,"sfe") - return(0); -} -integer e_wsfe(Void) -{ - int n = en_fio(); - f__fmtbuf = NULL; - return n; -} diff --git a/ext/spice/src/cspice/sgfcon.c b/ext/spice/src/cspice/sgfcon.c deleted file mode 100644 index 66868a8156..0000000000 --- a/ext/spice/src/cspice/sgfcon.c +++ /dev/null @@ -1,625 +0,0 @@ -/* sgfcon.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; - -/* $Procedure SGFCON ( Generic Segments: Fetch constants ) */ -/* Subroutine */ int sgfcon_(integer *handle, doublereal *descr, integer * - first, integer *last, doublereal *values) -{ - integer base, b, e; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafgda_(integer *, - integer *, integer *, doublereal *); - extern logical failed_(void); - extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, - integer *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen); - integer myncon; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Given the descriptor for a generic segment in a DAF file */ -/* associated with HANDLE, fetch from the constants partition */ -/* of the segment the double precision numbers from FIRST to */ -/* LAST. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF open for reading. */ -/* DESCR I Descriptor for a generic segment in the DAF. */ -/* FIRST I The index of the first constant value to fetch. */ -/* LAST I The index of the last constant value to fetch. */ -/* VALUES O The constant values that were requested. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF opened for reading that */ -/* contains the segment described by DESCR. */ - -/* DESCR is the descriptor of the segment with the desired */ -/* constant values. This must be the descriptor for a */ -/* generic segment in the DAF associated with HANDLE. */ - -/* FIRST is the index of the first value to fetch from the */ -/* constants section of the generic segment associated */ -/* with HANDLE and DESCR. */ - -/* LAST is the index of the last value to fetch from the */ -/* constants section of the generic segment associated */ -/* with HANDLE and DESCR. */ - -/* $ Detailed_Output */ - -/* VALUES is the array of constant values obtained from the */ -/* constants section of the generic segment associated */ -/* with HANDLE and DESCR. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Files */ - -/* See the description of HANDLE above. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(REQUESTOUTOFBOUNDS) will be signalled */ -/* if FIRST is less than 1 or LAST is greater than the */ -/* number of constants. */ - -/* 2) The error SPICE(REQUESTOUTOFORDER) will be signalled */ -/* if LAST is less than FIRST. */ - -/* $ Particulars */ - -/* This routine allows easy access to values from the constants */ -/* partition of a generic segment in a DAF file. Please see the DAF */ -/* Required Reading or the include file 'sgparam.inc' for a more */ -/* detailed description of a generic segment. */ - -/* $ Examples */ - -/* Suppose that you have located a DAF generic segment. The */ -/* fragment of code below shows how to fetch all of the */ -/* constants from that segment. */ - -/* Declarations: */ - -/* DOUBLE PRECISION CONSTS() */ - -/* INTEGER MYNCON */ - -/* Get the number of items in the constants section. */ - -/* CALL SGMETA ( HANDLE, DESCR, NCON, MYNCON ) */ - -/* Fetch the constants from the segment. */ - -/* CALL SGFCON ( HANDLE, DESCR, 1, MYNCON, CONSTS ) */ - -/* $ Restrictions */ - -/* The segment described by DESCR must be a generic segment, */ -/* otherwise the results of this routine are not predictable. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ - -/* - SPICELIB Version 1.0.0, 11-APR-1995 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch constants from a generic segment */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* Include the mnemonic values for the generic segment declarations. */ - - -/* Local Variables */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGFCON", (ftnlen)6); - -/* Get the value for the base of the constants and the number of */ -/* constants in the generic segment. */ - - sgmeta_(handle, descr, &c__1, &base); - sgmeta_(handle, descr, &c__2, &myncon); - if (failed_()) { - chkout_("SGFCON", (ftnlen)6); - return 0; - } - -/* Perform checks on the inputs for reasonableness. */ - - if (*first < 1 || *last > myncon) { - setmsg_("The range of constants requested extends beyond the availab" - "le constant data. Constants are available for indices 1 to " - "#. You have requested data from # to #. ", (ftnlen)160); - errint_("#", &myncon, (ftnlen)1); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - sigerr_("SPICE(REQUESTOUTOFBOUNDS)", (ftnlen)25); - chkout_("SGFCON", (ftnlen)6); - return 0; - } - if (*last < *first) { - setmsg_("The last constant item requested, #, is before the first co" - "nstant item requested, #.", (ftnlen)84); - errint_("#", last, (ftnlen)1); - errint_("#", first, (ftnlen)1); - sigerr_("SPICE(REQUESTOUTOFORDER)", (ftnlen)24); - chkout_("SGFCON", (ftnlen)6); - return 0; - } - -/* Compute the addresses of the data within the file and then fetch */ -/* the data. */ - - b = base + *first; - e = base + *last; - dafgda_(handle, &b, &e, values); - chkout_("SGFCON", (ftnlen)6); - return 0; -} /* sgfcon_ */ - diff --git a/ext/spice/src/cspice/sgfpkt.c b/ext/spice/src/cspice/sgfpkt.c deleted file mode 100644 index 2f700d0bd6..0000000000 --- a/ext/spice/src/cspice/sgfpkt.c +++ /dev/null @@ -1,807 +0,0 @@ -/* sgfpkt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__12 = 12; -static integer c__10 = 10; -static integer c__16 = 16; -static integer c__15 = 15; -static integer c__11 = 11; -static integer c__8 = 8; -static integer c__9 = 9; - -/* $Procedure SGFPKT ( Generic Segment: Fetch data packets ) */ -/* Subroutine */ int sgfpkt_(integer *handle, doublereal *descr, integer * - first, integer *last, doublereal *values, integer *ends) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer size, b, e, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal dtemp[2]; - integer begin1, begin2; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - extern logical failed_(void); - extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, - integer *), sigerr_(char *, ftnlen); - integer mypdrb; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer soffst; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer mypktb, voffst; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer mynpdr; - extern logical return_(void); - integer mypdrt, mynpkt, mypkto, mypksz; - -/* $ Abstract */ - -/* Given the descriptor for a generic segment in a DAF file */ -/* associated with HANDLE, fetch the data packets indexed from FIRST */ -/* to LAST from the packet partition of the generic segment. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The file handle attached to an open DAF. */ -/* DESCR I The descriptor associated with a generic segment. */ -/* FIRST I The index of the first data packet to fetch. */ -/* LAST I The index of the last data packet to fetch. */ -/* VALUES O The data packets that have been fetched. */ -/* ENDS O An array of pointers to the ends of the packets. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF opened for reading that */ -/* contains the segment described by DESCR. */ - -/* DESCR is the descriptor of the segment with the desired */ -/* constant values. This must be the descriptor for a */ -/* generic segment in the DAF associated with HANDLE. */ - -/* FIRST is the index of the first value to fetch from the */ -/* constants section of the DAF segment described */ -/* by DESCR. */ - -/* LAST is the index of the last value to fetch from the */ -/* constants section of the DAF segment described */ -/* by DESCR */ - -/* $ Detailed_Output */ - -/* VALUES is the array of values constructed by concatenating */ -/* requested packets one after the other into */ -/* an array. Pictorially we can represent VALUES */ -/* as: */ - -/* +--------------------------+ */ -/* | first requested packet | */ -/* +--------------------------+ */ -/* | second requested packet | */ -/* +--------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------+ */ -/* | first requested packet | */ -/* +--------------------------+ */ - -/* ENDS is an array of pointers to the ends of the */ -/* fetched packets. ENDS(1) gives the index */ -/* of the last item of the first packet fetched. */ -/* ENDS(2) gives the index of the last item of */ -/* the second packet fetched, etc. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Files */ - -/* See the description of HANDLE above. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(REQUESTOUTOFBOUNDS) will be signalled */ -/* if FIRST is less than 1 or LAST is greater than the */ -/* number of packets. */ - -/* 2) The error SPICE(REQUESTOUTOFORDER) will be signalled */ -/* if LAST is less than FIRST. */ - -/* 3) The error SPICE(UNKNOWNPACKETDIR) will be signalled if */ -/* the packet directory structure is unrecognized. The most */ -/* likely cause of this error is that an upgrade to your */ -/* version of the SPICE toolkit is needed. */ - -/* $ Particulars */ - -/* This routine fetches requested packets from a generic */ -/* DAF segment. The two arrays returned have the following */ -/* relationship to one another. The first packet returned */ -/* resides in VALUES between indexes 1 and ENDS(1). If a */ -/* second packet is returned it resides in VALUES between */ -/* indices ENDS(1)+1 and ENDS(2). This relations ship is */ -/* repeated so that if I is greater than 1 and at least I */ -/* packets were returned then the I'th packet resides in */ -/* VALUES between index ENDS(I-1) + 1 and ENDS(I). */ - -/* $ Examples */ - -/* Suppose that you have located a generic DAF segment (as */ -/* identified by the contents of a segment descriptor). The */ -/* fragment of code below shows how you could fetch packets */ -/* 3 through 7 (assuming that many packets are present). */ -/* from the segment. */ - -/* Declarations: */ - -/* DOUBLE PRECISION MYPKSZ () */ - -/* INTEGER ENDS ( 5 ) */ -/* INTEGER MYNPKT */ - -/* get the number of packets */ - -/* CALL SGMETA ( HANDLE, DESCR, NPKT, MYNPKT ) */ - -/* finally, fetch the packets from the segment. */ - -/* IF ( 7 .LE. MYNPKT ) THEN */ -/* CALL SGFPKT ( HANDLE, DESCR, 3, 7, MYPKSZ, ENDS ) */ -/* END IF */ - -/* $ Restrictions */ - -/* The segment described by DESCR must be a generic segment, */ -/* otherwise the results of this routine are not predictable. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA calls with DAFGDA. */ - -/* - SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */ - -/* Found and fixed a bug in the calculation of the beginning */ -/* address for variable length packet fetching. The base address */ -/* for the packet directory was not added into the value. This */ -/* bug went unnoticed because of a bug in SGSEQW, entry SGWES, */ -/* that put absolute addresses into the packet directory rather */ -/* than addresses that were relative to the start of the DAF */ -/* array. The bug in SGSEQW has also been fixed. */ - -/* - SPICELIB Version 1.0.0, 06-JAN-1994 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch packets from a generic segment */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* Include the mnemonic values. */ - - -/* Local Variables */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGFPKT", (ftnlen)6); - -/* Perform the needed initialization */ - - sgmeta_(handle, descr, &c__12, &mynpkt); - sgmeta_(handle, descr, &c__10, &mypdrt); - sgmeta_(handle, descr, &c__16, &mypkto); - sgmeta_(handle, descr, &c__15, &mypksz); - sgmeta_(handle, descr, &c__11, &mypktb); - if (failed_()) { - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - -/* Perform checks on the inputs for reasonableness. */ - - if (*first < 1 || *last > mynpkt) { - setmsg_("The range of packets requested extends beyond the available" - " packet data. The packet data is available for indexes 1 to" - " #. You've requested data from # to #. ", (ftnlen)159); - errint_("#", &mynpkt, (ftnlen)1); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - sigerr_("SPICE(REQUESTOUTOFBOUNDS)", (ftnlen)25); - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - if (*last < *first) { - setmsg_("The last packet requested, #, is before the first packet re" - "quested, #. ", (ftnlen)71); - errint_("#", last, (ftnlen)1); - errint_("#", first, (ftnlen)1); - sigerr_("SPICE(REQUESTOUTOFORDER)", (ftnlen)24); - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - -/* We've passed the sanity tests, if the packet directory structure */ -/* is recognized fetch the values and ends. We assume that we are */ -/* reading data from a correctly constructed generic segment, so we */ -/* do not need to worry about the type of reference index, as this is */ -/* not needed to fetch a data packet. */ -/* Currently, only two packet directory types are supported, and this */ -/* subroutine is the only place that this is documented. The types */ -/* have values zero (0) and one (1) for, respectively, fixed size */ -/* packets and variable size packets. */ - - if (mypdrt == 0) { - -/* All packets have the same size MYPKSZ so the address of the */ -/* start of the first packet and end of the last packet are easily */ -/* computed. */ - - if (mypkto == 0) { - -/* Compute tha addresses for the packet data in the generic */ -/* segment. */ - - b = mypktb + (*first - 1) * mypksz + 1; - e = mypktb + *last * mypksz; - -/* Get the packet data all in one shot since we know it's */ -/* contiguous. */ - - dafgda_(handle, &b, &e, values); - } else { - -/* Compute the addresses for the packet data in the generic */ -/* segment. Remember that we need to account for an offset */ -/* here to get to the start of the actual data packet. */ - - size = mypksz + mypkto; - -/* Get the packet data. Because there is an offset from the */ -/* address to the start of the packet data, we need to get */ -/* the data one packet at a time rather than all at once. */ - - i__1 = *last; - for (i__ = *first; i__ <= i__1; ++i__) { - soffst = (i__ - 1) * size + 1; - voffst = (i__ - *first) * mypksz + 1; - b = mypktb + soffst + mypkto; - e = mypktb + soffst + mypksz; - dafgda_(handle, &b, &e, &values[voffst - 1]); - if (failed_()) { - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - } - } - -/* Compute the ends for each of the data packets. This is the */ -/* same for both of the cases above because we have fixed size */ -/* data packets. */ - - i__1 = *last - *first + 1; - for (i__ = 1; i__ <= i__1; ++i__) { - ends[i__ - 1] = i__ * mypksz; - } - } else { - -/* In addition to the other meta data items already retrieved, we */ -/* will also need a few others. */ - - sgmeta_(handle, descr, &c__8, &mypdrb); - sgmeta_(handle, descr, &c__9, &mynpdr); - if (failed_()) { - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - -/* Each packet has a different size, so we need to fetch each one */ -/* individually, keeping track of the ends and things. We assume */ -/* that there is enough room in the array of values to hold all of */ -/* the packets. For the variable packet case, however, we do not */ -/* need to treat the implicit indexing and explicit indexing cases */ -/* separately. */ - - voffst = 1; - i__1 = *last - *first + 1; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute the addresses in the generic segment for the */ -/* beginning of data packets I and I+1. We need these to */ -/* compute the size of the packet. */ - - b = mypdrb + *first + i__ - 1; - e = b + 1; - -/* Get the beginning addresses for the two data packets and */ -/* convert them into integers. */ - - dafgda_(handle, &b, &e, dtemp); - if (failed_()) { - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - begin1 = (integer) dtemp[0]; - begin2 = (integer) dtemp[1]; - -/* Compute the size of data packet I, remembering to deal with */ -/* the packet offset that might be present, and the beginning */ -/* and ending addresses for the packet data. */ - - size = begin2 - begin1 - mypkto; - b = mypktb + begin1; - e = b + size - 1; - -/* Get the data for packet I. */ - - dafgda_(handle, &b, &e, &values[voffst - 1]); - if (failed_()) { - chkout_("SGFPKT", (ftnlen)6); - return 0; - } - -/* Compute the end for packet I and store it. */ - - voffst += size; - ends[i__ - 1] = voffst - 1; - } - } - chkout_("SGFPKT", (ftnlen)6); - return 0; -} /* sgfpkt_ */ - diff --git a/ext/spice/src/cspice/sgfref.c b/ext/spice/src/cspice/sgfref.c deleted file mode 100644 index 6152d7c458..0000000000 --- a/ext/spice/src/cspice/sgfref.c +++ /dev/null @@ -1,698 +0,0 @@ -/* sgfref.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__5 = 5; -static integer c__7 = 7; - -/* $Procedure SGFREF ( Generic Segments: Fetch references ) */ -/* Subroutine */ int sgfref_(integer *handle, doublereal *descr, integer * - first, integer *last, doublereal *values) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - double d_int(doublereal *); - - /* Local variables */ - integer base, b, e, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafgda_(integer *, - integer *, integer *, doublereal *); - extern logical failed_(void); - doublereal buffer[2]; - extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, - integer *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - integer mynref; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer myreft; - extern logical return_(void); - -/* $ Abstract */ - -/* Given the descriptor for a generic segment in a DAF file */ -/* associated with HANDLE, fetch from the references partition */ -/* of the segment the double precision numbers from FIRST to */ -/* LAST. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF open for reading. */ -/* DESCR I Descriptor for a generic segment in the DAF. */ -/* FIRST I The index of the first reference value to fetch. */ -/* LAST I The index of the last reference value to fetch. */ -/* VALUES O The reference values that were requested. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF file opened for reading */ -/* that contains the segment described by DESCR. */ - -/* DESCR is the descriptor of the segment with the desired */ -/* constant values. This must be the descriptor for a */ -/* segment in the DAF associated with HANDLE. */ - -/* FIRST is the index of the first value to fetch from the */ -/* reference section of the DAF generic segment associated */ -/* with HANDLE and DESCR. */ - -/* LAST is the index of the last value to fetch from the */ -/* constants section of the DAF generic segment associated */ -/* with HANDLE and DESCR. */ - -/* $ Detailed_Output */ - -/* VALUES is the array of reference values obtained from the */ -/* reference section of the DAF generic segment */ -/* associated with HANDLE and DESCR. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Files */ - -/* See the description of HANDLE above. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(REQUESTOUTOFBOUNDS) will be signalled */ -/* if FIRST is less than 1 or LAST is greater than the */ -/* number of reference values. */ - -/* 2) The error SPICE(REQUESTOUTOFORDER) will be signalled */ -/* if LAST is less than FIRST. */ - -/* 3) The error SPICE(UNKNOWNREFDIR) will be signalled if the */ -/* reference directory structure is unrecognized. The most */ -/* likely cause of this error is that an upgrade to your */ -/* version of the SPICE toolkit is needed. */ - -/* $ Particulars */ - -/* This routine allows you to easily fetch values from the reference */ -/* section of a generic segment. */ - -/* $ Examples */ - -/* Suppose that you have located a DAF generic segment. The code */ -/* fragment below shows how to fetch the I'th reference value from */ -/* that segment. */ - -/* Declarations: */ - -/* DOUBLE PRECISION REFVAL */ - -/* Fetch the Ith reference value from the segment. */ - -/* CALL SGFREF ( HANDLE, DESCR, I, I, REFVAL ) */ - - -/* $ Restrictions */ - -/* The segment described by DESCR MUST be a generic segment, */ -/* otherwise the results of this routine are not predictable. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ - -/* - SPICELIB Version 1.0.0, 12-APR-1995 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch reference values from a generic segment */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* Include the mnemonic values for the generic segment declarations. */ - - -/* Local Variables */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - - if (return_()) { - return 0; - } - chkin_("SGFREF", (ftnlen)6); - -/* Perform the needed initialization */ - - sgmeta_(handle, descr, &c__6, &base); - sgmeta_(handle, descr, &c__5, &myreft); - sgmeta_(handle, descr, &c__7, &mynref); - if (failed_()) { - chkout_("SGFREF", (ftnlen)6); - return 0; - } - -/* Perform checks on the inputs for reasonableness. */ - - if (*first < 1 || *last > mynref) { - setmsg_("The range of reference items requested extends beyond the a" - "vailable range of reference items. The reference data is av" - "ailable for indexes 1 to #. You've requested data from # to" - " #.", (ftnlen)182); - errint_("#", &mynref, (ftnlen)1); - errint_("#", first, (ftnlen)1); - errint_("#", last, (ftnlen)1); - sigerr_("SPICE(REQUESTOUTOFBOUNDS)", (ftnlen)25); - chkout_("SGFREF", (ftnlen)6); - return 0; - } - if (*last < *first) { - setmsg_("The last reference item requested, #, is before the first r" - "eference item requested, #.", (ftnlen)86); - errint_("#", last, (ftnlen)1); - errint_("#", first, (ftnlen)1); - sigerr_("SPICE(REQUESTOUTOFORDER)", (ftnlen)24); - chkout_("SGFREF", (ftnlen)6); - return 0; - } - -/* Ok. We are ready to go. If the reference type is recognized */ -/* fetch the requested data. */ - - if (myreft == 0) { - -/* The reference values are implied in this case. Read the */ -/* reference base value and step. If we fail, check out and */ -/* return; we don't want to try and comput anything with bogus */ -/* data. */ - - b = base + 1; - e = base + 2; - dafgda_(handle, &b, &e, buffer); - if (failed_()) { - chkout_("SGFREF", (ftnlen)6); - return 0; - } - -/* Now simply compute the reference values using the implicit */ -/* model for them. */ - - i__1 = *last; - for (i__ = *first; i__ <= i__1; ++i__) { - d__1 = (doublereal) (i__ - 1) * buffer[1]; - values[i__ - 1] = buffer[0] + d_int(&d__1); - } - } else if (myreft == 1) { - -/* The reference values are implied in this case. Read the */ -/* reference base value and step. If we fail, check out and */ -/* return; we don't want to try and comput anything with bogus */ -/* data. */ - - b = base + 1; - e = base + 2; - dafgda_(handle, &b, &e, buffer); - if (failed_()) { - chkout_("SGFREF", (ftnlen)6); - return 0; - } - -/* Now simply compute the reference values using the implicit */ -/* model for them. */ - - i__1 = *last; - for (i__ = *first; i__ <= i__1; ++i__) { - d__1 = (doublereal) (i__ - 1) * buffer[1]; - values[i__ - 1] = buffer[0] + d_int(&d__1); - } - } else if (myreft == 3 || myreft == 2 || myreft == 4) { - -/* In this case the reference values are actually stored */ -/* in the file. This is even easier than the last case. */ -/* We simply fetch them with a call to DAF. We do not check for a */ -/* failure here, since all we do after the attempt to read is */ -/* checkout and return anyway. */ - - b = base + *first; - e = base + *last; - dafgda_(handle, &b, &e, values); - } else { - setmsg_("The generic DAF segment you attempted to read has an unsupp" - "orted reference directory structure. The integer code given " - "for this structure is #. The likely cause of this anomoly is" - " that your version of SPICELIB needs to be updated. Contact " - "your system administrator or NAIF for a toolkit update. ", ( - ftnlen)295); - errint_("#", &myreft, (ftnlen)1); - sigerr_("SPICE(UNKNOWNREFDIR)", (ftnlen)20); - chkout_("SGFREF", (ftnlen)6); - return 0; - } - chkout_("SGFREF", (ftnlen)6); - return 0; -} /* sgfref_ */ - diff --git a/ext/spice/src/cspice/sgfrvi.c b/ext/spice/src/cspice/sgfrvi.c deleted file mode 100644 index 6721de2fa9..0000000000 --- a/ext/spice/src/cspice/sgfrvi.c +++ /dev/null @@ -1,1272 +0,0 @@ -/* sgfrvi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__12 = 12; -static integer c__7 = 7; -static integer c__5 = 5; -static integer c__6 = 6; -static integer c__0 = 0; -static integer c__4 = 4; -static integer c__3 = 3; - -/* $Procedure SGFRVI ( Generic Segments: Fetch ref. value and index ) */ -/* Subroutine */ int sgfrvi_(integer *handle, doublereal *descr, doublereal * - x, doublereal *value, integer *indx, logical *found) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - logical done; - integer i__, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical myfnd; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafgda_( - integer *, integer *, integer *, doublereal *); - extern logical failed_(void); - doublereal endref; - integer nfetch; - doublereal buffer[101]; - integer bfindx, remain; - extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, - integer *); - doublereal dpimax; - integer myrefb; - extern integer lstled_(doublereal *, integer *, doublereal *); - doublereal dptemp; - integer fullrd, rdridx, myrdrb; - extern integer intmax_(void); - integer mynref; - logical isdirv; - integer myindx; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer mynrdr; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - doublereal myvalu; - extern logical return_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer myrdrt, mynpkt, end; - -/* $ Abstract */ - -/* Given the handle of a DAF and the descriptor associated with */ -/* a generic DAF segment in the file, find the reference value */ -/* associated with the value X and it's index. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a DAF open for reading. */ -/* DESCR I The descriptor for a DAF generic segment. */ -/* X I The key value used to find a reference and index. */ -/* VALUE O The reference value associated with X. */ -/* INDX O The index of VALUE within the reference values. */ -/* FOUND O A flag indicating whether values for X were found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF open for reading */ - -/* DESCR is the descriptor of the generic segment that we are */ -/* going to search for a reference value to associate with */ -/* X. */ - -/* X a value for which the associated reference value */ -/* and reference index is requested. */ - -/* $ Detailed_Output */ - -/* VALUE is the reference value associated with the input value */ -/* X. */ - -/* INDX is the index of VALUE within the set of reference */ -/* values for the generic segment. This value may be used */ -/* to obtain a particular packet of data from the generic */ -/* segment. */ - -/* FOUND is a logical flag indicating whether a reference value */ -/* associated with X was found. If a reference value was */ -/* found, FOUND will have a value of TRUE; otherwise it */ -/* will have a value of FALSE. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Files */ - -/* See the description of HANDLE above. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(UNKNOWNREFDIR) will be signalled if */ -/* the reference directory structure is unrecognized. The most */ -/* likely cause of this error is that an upgrade to your */ -/* version of the SPICE toolkit is needed. */ - -/* 2) If a value computed for the index of an implicitly indexed */ -/* generic segment is too large to be represented as an integer, */ -/* the error SPICE(INDEXTOOLARGE) will be signalled. */ - -/* $ Particulars */ - -/* This routine allows you to easily find the index and value */ -/* of the reference item that should be associated with a */ -/* value X. Given this information you can then easily retrieve */ -/* the packet that should be associated with X. */ - -/* $ Examples */ - -/* Suppose that you have a generic segment that contains the */ -/* following items. */ - -/* 1) Packets that model the motion of a body as a function */ -/* of time over some interval of time. */ - -/* 2) Reference values that are the epochs corresponding */ -/* to the beginning of the intervals for the packets. */ - -/* To retrieve the correct packet to use to compute the position */ -/* and velocity of the body at a particular epoch, ET, you could */ -/* use the following code. (Note this block of code assumes that */ -/* you aren't going to run into any exceptional cases such as ET */ -/* falling outside the range of times for which the packets can */ -/* provide ephemeris data.) */ - -/* Find out the index of the time that should be associated */ -/* with the ET we've been given */ - -/* CALL SGFRVI ( HANDLE, DESCR, ET, ETFND, INDX, FOUND ) */ - -/* Fetch the INDX'th ephemeris packet from the segment. */ - -/* CALL SGFPKT ( HANDLE, DESCR, INDX, EPHEM ) */ - - -/* $ Restrictions */ - -/* The segment described by DESCR MUST be a generic segment, */ -/* otherwise the results of this routine are not predictable. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ - -/* - SPICELIB Version 1.1.0, 08-MAY-1996 (WLT) */ - -/* A bug was found in the EXPCLS index case when the */ -/* trying to retrieve the last value in a generic segment. */ -/* This bug was discovered by the HP compiler complaining */ -/* that an index used was not initialized. */ - -/* The offending line was */ - -/* MYVALU = BUFFER(I) */ - -/* The corrected line is: */ - -/* MYVALU = BUFFER(BFINDX) */ - -/* - SPICELIB Version 1.0.0, 28-Mar-1994 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* find the index of a reference value in a generic segment */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* Include the mnemonic values for the generic segment declarations. */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial Values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGFRVI", (ftnlen)6); - -/* Set the value for the maximum index as a double precision number, */ -/* but only do it the first time into the subroutine. */ - - if (first) { - first = FALSE_; - dpimax = (doublereal) intmax_(); - } - -/* Collect the necessary meta data values common to all cases. */ - - sgmeta_(handle, descr, &c__12, &mynpkt); - sgmeta_(handle, descr, &c__7, &mynref); - sgmeta_(handle, descr, &c__5, &myrdrt); - sgmeta_(handle, descr, &c__6, &myrefb); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - -/* Check to be sure that we know how to deal with the type of index */ -/* in the segment. The index type should be between the minimum */ -/* allowed index type, MNIDXT, and the maximum allowed index type, */ -/* MXIDXT, as specified in the file 'sgparam.inc'. */ - - if (myrdrt < 0 || myrdrt > 4) { - setmsg_("The generic DAF segment you attempted to read has an unsupp" - "orted reference directory structure. The integer code given " - "for this structure is #, and allowed codes are within the ra" - "nge # to #. The likely cause of this anamoly is your version" - " of SPICELIB needs updating. Contact your system administrat" - "or or NAIF for a toolkit update.", (ftnlen)331); - errint_("#", &myrdrt, (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - errint_("#", &c__4, (ftnlen)1); - sigerr_("SPICE(UNKNOWNREFDIR)", (ftnlen)20); - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - -/* We don't have an index yet and we initialize things to zero. */ - - myfnd = FALSE_; - myindx = 0; - myvalu = 0.; - -/* We pass the idiot checks, so lets proceed. We have a IF block for */ -/* each allowed reference directory type code. */ - -/* For implicitly indexed data packets, the interval */ - -/* [ BUFFER(1), BUFFER(1) + (N - 1) * BUFFER(2) ) */ - -/* is divided into subintervals as follows: */ - -/* (-infinity, r1), [r_1,r_2) [r_2, r_3), ..., [r_i, r_(i+1)), */ -/* ..., [r_N, +infinity), */ - -/* where N = the number of packets in the segment, MYNPKT, and */ -/* r_i = BUFFER(1) + (i-1) * BUFFER(2). */ - -/* If X is in [r_i, r_(i+1)), i = 1, N-1, then we found a value */ -/* and the index returned will be i with the reference value */ -/* returned will be r_i. */ - -/* If X is in [r_N, +infinity), then we found a value and the */ -/* index returned will be N and the reference value returned will */ -/* be r_N. */ - -/* If X is in (-infinity, r1), we have two possibilities: */ - -/* 1) If the index type is implicit closest, we found a value, */ -/* the index returned will be 1 and the reference value */ -/* returned will be r_1. */ - -/* 2) If the index type is implicit less than or equal, we do */ -/* not find a value. */ - -/* For explicitly indexed packets we simply search the reference */ -/* directory for an appropriate reference value. */ - - if (myrdrt != 0 && myrdrt != 1) { - -/* In addition to the meta data items we already have, we also */ -/* need these. */ - - sgmeta_(handle, descr, &c__4, &mynrdr); - sgmeta_(handle, descr, &c__3, &myrdrb); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - -/* We need to scan the reference directory (if there is one) to */ -/* determine the appropriate block of reference values to read */ -/* from the generic segment. Then we compute the number of */ -/* reference values to fetch and examine. Finally, based on the */ -/* index type we figure out whether we have found a reference */ -/* value or not. It will take a little while to get there, so */ -/* let's get going. */ - -/* We have not started yet, so we're not done and we cannot have a */ -/* reference directory value yet. */ - - done = FALSE_; - isdirv = FALSE_; - -/* We have not read any full buffers of reference directory values */ -/* yet, all of the reference directory values remain to be read, */ -/* and we have no index for a reference directory value. */ - - fullrd = 0; - remain = mynrdr; - rdridx = 0; - -/* Search the reference directory values to select the appropriate */ -/* block of reference values to read. */ - - while(! done && remain > 0) { - -/* Read a buffer of reference directory items. */ - - nfetch = min(100,remain); - begin = myrdrb + fullrd * 100 + 1; - end = begin + nfetch - 1; - dafgda_(handle, &begin, &end, buffer); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - -/* See if X is in the current buffer. */ - - rdridx = lstled_(x, &nfetch, buffer); - if (rdridx == 0) { - -/* If not, then X < BUFFER(1) and we're done. This indicates */ -/* that the desired reference value is before, or in, the */ -/* previous block of reference values. */ - - done = TRUE_; - } else if (rdridx == nfetch) { - -/* If we get the last value of the buffer, then either we */ -/* are done, X = BUFFER(NFETCH), or X > BUFFER(NFETCH). */ - - if (*x == buffer[(i__1 = nfetch - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)417)] - ) { - -/* If X = BUFFER(NFETCH) we are done, we have a directory */ -/* value, and it might be a value we want to return. */ - - done = TRUE_; - isdirv = TRUE_; - } else { - -/* Otherwise, we might have more stuff to read, so update */ -/* the remainder and the current number of full buffer */ -/* reads and try the loop again. */ - - remain -= nfetch; - if (remain > 0) { - -/* We don't want to increment FULLRD for a partial */ -/* buffer read. The arithmetic for the index */ -/* calculations below will use RDRIDX to deal with */ -/* this. */ - - ++fullrd; - } - } - } else { - -/* BUFFER(1) <= X < BUFFER(NFETCH), i.e., we have something */ -/* in the buffer. Check to see if X = BUFFER(RDRIDX). If so, */ -/* we are done, we have a directory value, and it might be a */ -/* value we want to return. Otherwise, we are just done. */ - - done = TRUE_; - if (*x == buffer[(i__1 = rdridx - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)455)] - ) { - isdirv = TRUE_; - } - } - } - rdridx = fullrd * 100 + rdridx; - -/* There are three cases that we need to consider when X is not a */ -/* reference directory value: */ - -/* Case 1: 0 < RDRIDX < MYNRDR (most common first) */ -/* Case 2: RDRIDX = 0 */ -/* Case 3: RDRIDX = MYNRDR */ - - if (! isdirv) { - if (rdridx > 0 && rdridx < mynrdr) { - -/* If we were able to bracket X before reaching the end of */ -/* the reference directory, then we KNOW that we have a */ -/* candidate for a reference value in the reference data. */ -/* All we need to do is read the reference data and find it */ -/* in the buffer. We also read the reference directory */ -/* values that bracket the desired reference value into */ -/* BUFFER, so that they are there if we need them. */ - -/* Computing MIN */ - i__1 = 101, i__2 = mynref - rdridx * 100 + 1; - nfetch = min(i__1,i__2); - begin = myrefb + rdridx * 100; - end = begin + nfetch - 1; - dafgda_(handle, &begin, &end, buffer); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - bfindx = lstled_(x, &nfetch, buffer); - myindx = rdridx * 100 + bfindx - 1; - } else if (rdridx == 0) { - -/* The reference value may be one of the reference values */ -/* less than the first reference directory item. So we */ -/* compute the beginning and ending addresses for the data, */ -/* read it in, and try to find a reference value. */ - - nfetch = min(101,mynref); - begin = myrefb + 1; - end = begin + nfetch - 1; - dafgda_(handle, &begin, &end, buffer); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - bfindx = lstled_(x, &nfetch, buffer); - myindx = bfindx; - } else if (rdridx == mynrdr) { - -/* If we were not able to bracket X before reaching the end */ -/* of the reference directory, then we might have a */ -/* candidate for a reference value in the reference data */ -/* after the last reference directory value. All we need to */ -/* do is read the reference data and look. */ - -/* NOTE: NFETCH can never be zero or negative, so we can */ -/* glibly use it. The reason for this is the NFETCH can only */ -/* be zero if the desired reference value is a reference */ -/* directory value, and we already know that the reference */ -/* value we want is not a reference directory value, because */ -/* we are here. For similar reasons, NFETCH can never be */ -/* negative. */ - - begin = myrefb + rdridx * 100; - end = myrefb + mynref; - nfetch = end - begin + 1; - dafgda_(handle, &begin, &end, buffer); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - bfindx = lstled_(x, &nfetch, buffer); - myindx = rdridx * 100 + bfindx - 1; - } - } else { - -/* We have a reference directory value, whose index is easy to */ -/* compute. */ - - myindx = rdridx * 100; - } - -/* Now, if we have a candidate for a reference value, lets make */ -/* sure, based onthe type of index we have. */ - - if (myrdrt == 2) { - -/* We have a reference value only if X > some reference */ -/* value. */ - - if (! isdirv) { - -/* If the value is not a reference directory value, then */ -/* we have two cases: */ - -/* Case 1: 0 < MYINDX <= MYNREF */ -/* Case 2: MYINDX = 0 */ - - if (myindx > 0 && myindx <= mynref) { - -/* We found a reference value. The reference value we */ -/* want is either the value indicated by MYINDX or */ -/* the reference value immediately preceding MYINDX, */ -/* if there is such a value. To deal with this we */ -/* split the test up into two cases. */ - - if (myindx > 1) { - -/* If X > BUFFER(BFINDX) then we are done, so set the */ -/* value. If not, then we want the reference value */ -/* that is immediately before the current one. */ - - if (*x > buffer[(i__1 = bfindx - 1) < 101 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_" - , (ftnlen)595)]) { - myfnd = TRUE_; - myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, - "sgfrvi_", (ftnlen)598)]; - } else { - myfnd = TRUE_; - myvalu = buffer[(i__1 = bfindx - 2) < 101 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, - "sgfrvi_", (ftnlen)603)]; - --myindx; - } - } else { - -/* Remember, MYINDX is 1 here. If we are greater */ -/* than the first reference value in the segment, */ -/* we are done. Otherwise there is no reference */ -/* value to be associated with X. */ - - if (*x > buffer[(i__1 = myindx - 1) < 101 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_" - , (ftnlen)615)]) { - myfnd = TRUE_; - myvalu = buffer[(i__1 = myindx - 1) < 101 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, - "sgfrvi_", (ftnlen)618)]; - } else { - -/* We did not find a reference value. X was */ -/* equal to the first reference value of the */ -/* generic segment. */ - - myfnd = FALSE_; - } - } - } else if (myindx == 0) { - -/* We did not find a reference value. X was < the */ -/* first reference value for the generic segment. */ - - myfnd = FALSE_; - } - } else { - -/* We have a reference directory value, and we are done. */ -/* Either the reference directory value is the one we */ -/* want or the reference value immediately preceeding it */ -/* is the one we want. */ - - myfnd = TRUE_; - --myindx; - begin = myrefb + myindx; - end = begin; - dafgda_(handle, &begin, &end, &myvalu); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - } - } else if (myrdrt == 3) { - -/* We have a reference value only if X >= some reference */ -/* value. At this point, either we have the value and index */ -/* we want or X is before the first reference value of the */ -/* generic segment. We consider two cases, the first when X */ -/* is not a referecne directory value, and the second when */ -/* it is. */ - - if (! isdirv) { - -/* If X is not a directory value, then MYINDX is either */ -/* equal to zero, implying that X is before the first */ -/* reference value in the generic segment, or MYINDX > 0, */ -/* implying that we have found a reference value. */ - - if (myindx > 0 && myindx <= mynref) { - myfnd = TRUE_; - myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen) - 684)]; - } else if (myindx == 0) { - -/* We did not find a reference value. X was < the */ -/* first reference value for the generic segment. */ - - myfnd = FALSE_; - } - } else { - -/* We have a reference directory value, and it is the one */ -/* we want. */ - - myfnd = TRUE_; - myvalu = *x; - } - } else if (myrdrt == 4) { - -/* We have a reference value for every value of X. If X < */ -/* the first reference value of the generic segment, the */ -/* closest value is the first reference value. If X > the */ -/* last reference value of the generic segment, the closest */ -/* value is the last reference value. For X between the */ -/* first and last reference values we simple take the */ -/* closest reference value to X, resolving a tie by */ -/* accepting the larger reference value. */ - - if (! isdirv) { - -/* If X is not a directory value, then MYINDX is either */ -/* equal to zero, implying that X is before the first */ -/* reference value in the generic segment, */ -/* 0 < MYINDX < MYNPKT, implying X is between the first */ -/* and last reference values in the generic segment, or */ -/* MYINDX = MYNPKT implying that X is greater than or */ -/* equal to the last reference value. */ - - if (myindx > 0 && myindx < mynref) { - i__ = bfindx; - -/* Find the closest value to X, choosing the larger in */ -/* the event of a tie. */ - - if (buffer[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)734)] - - *x <= *x - buffer[(i__2 = i__ - 1) < 101 && 0 <= - i__2 ? i__2 : s_rnge("buffer", i__2, "sgfrvi_", ( - ftnlen)734)]) { - ++i__; - ++myindx; - } - myfnd = TRUE_; - myvalu = buffer[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen) - 742)]; - } else if (myindx == 0) { - -/* X is before the first reference value for the */ -/* generic segment, so the closest reference value is */ -/* the first one. */ - - myfnd = TRUE_; - myindx = 1; - myvalu = buffer[0]; - } else if (myindx == mynref) { - -/* X is at of after the last reference value for the */ -/* generic segment, so the closest reference value is */ -/* the last reference value, which will be in BUFFER. */ - - myfnd = TRUE_; - myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen) - 762)]; - } - } else { - -/* We have a reference directory value, and it is the one */ -/* we want. */ - - myfnd = TRUE_; - myvalu = *x; - } - } - } else if (myrdrt == 0) { - -/* Get the begin and end addresses from which to read the */ -/* reference values and get the reference values. */ - - begin = myrefb + 1; - end = myrefb + 2; - dafgda_(handle, &begin, &end, buffer); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1]; - -/* Compute the index if we can. */ - - if (*x < buffer[0]) { - -/* If X is less than BUFFER(1), we do not have a reference */ -/* value. */ - - myfnd = FALSE_; - } else if (*x > endref) { - -/* If X is greater than ENDREF, then we have a reference */ -/* value, ENDREF. */ - - myfnd = TRUE_; - myindx = mynpkt; - myvalu = endref; - } else { - -/* r_1 < X < r_N, i.e., we found a value. Compute the index */ -/* and the reference value. */ - - if (mynpkt > 1) { - myfnd = TRUE_; - -/* Compute the index. */ - - dptemp = (*x - buffer[0]) / buffer[1] + 1.; - -/* Test to see if we can safely convert the index to an */ -/* integer. */ - - if (dptemp > dpimax) { - setmsg_("The computed index is too large to be represent" - "ed as an integer. The most likely problem is tha" - "t an incorrect value was stored for the step siz" - "e. The value found for the step was: #", (ftnlen) - 181); - errdp_("#", &buffer[1], (ftnlen)1); - sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20); - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - myindx = (integer) dptemp; - myindx = min(myindx,mynpkt); - } else { - -/* There is only one packet. */ - - myindx = 1; - } - -/* Compute the reference value. */ - - myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1]; - } - } else if (myrdrt == 1) { - -/* Get the begin and end addresses from which to read the */ -/* reference values and get the reference values. */ - - begin = myrefb + 1; - end = myrefb + 2; - dafgda_(handle, &begin, &end, buffer); - if (failed_()) { - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1]; - -/* Compute the index if we can. */ - - if (*x < buffer[0]) { - -/* If X < BUFFER(1), then we found a value, the index */ -/* returned will be 1 and the reference value returned will */ -/* be BUFFER(1). */ - - myfnd = TRUE_; - myindx = 1; - myvalu = buffer[0]; - } else if (*x > endref) { - -/* If X > ENDREF, then we found a value, the index returned */ -/* will be MYNPKT and the reference value returned will be */ -/* ENDREF. */ - - myfnd = TRUE_; - myindx = mynpkt; - myvalu = endref; - } else { - -/* r_1 < X < r_N, i.e., we found a value. Compute the index */ -/* and the reference value. If X is closer to r_I, the index */ -/* returned will be I with a reference value of r_I. If X is */ -/* closer to r_(I+1), the index returned will be I+1 with a */ -/* reference value of r_(I+1). */ - - if (mynpkt > 1) { - myfnd = TRUE_; - -/* Compute the index. */ - - dptemp = (*x - buffer[0]) / buffer[1] + 1.5; - if (dptemp > dpimax + .5) { - setmsg_("The computed index is too large to be represent" - "ed as an integer. The most likely problem is tha" - "t an incorrect value was stored for the step siz" - "e. The value found for the step was: #", (ftnlen) - 181); - errdp_("#", &buffer[1], (ftnlen)1); - sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20); - chkout_("SGFRVI", (ftnlen)6); - return 0; - } - myindx = (integer) dptemp; - } else { - -/* There is only one packet. */ - - myindx = 1; - } - -/* Compute the reference value. */ - - myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1]; - } - } - -/* At this point, we have either found a value or not. If so, then we */ -/* need to set the index, value, and found flag for output. */ -/* Otherwise, we simply set the found flag. */ - - if (myfnd) { - *indx = myindx; - *value = myvalu; - } - *found = myfnd; - chkout_("SGFRVI", (ftnlen)6); - return 0; -} /* sgfrvi_ */ - diff --git a/ext/spice/src/cspice/sgmeta.c b/ext/spice/src/cspice/sgmeta.c deleted file mode 100644 index 993424a9e8..0000000000 --- a/ext/spice/src/cspice/sgmeta.c +++ /dev/null @@ -1,910 +0,0 @@ -/* sgmeta.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__15 = 15; - -/* $Procedure SGMETA ( Generic segments: Fetch meta data value ) */ -/* Subroutine */ int sgmeta_(integer *handle, doublereal *descr, integer * - mnemon, integer *value) -{ - /* Initialized data */ - - static integer lstbeg = -1; - static integer lsthan = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - static doublereal equiv_0[2]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *); - - /* Local variables */ - static integer meta[17]; - integer begm1, i__, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen); -#define dtemp (equiv_0) - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal xmeta[17]; -#define itemp ((integer *)equiv_0) - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - integer niovr2, nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafhsf_(integer *, integer *, integer *); - integer begmta, endmta, ametas; - static logical nieven; - static integer ioffst; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal dmtasz; - static integer metasz; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Obtain the value of a specified generic segment meta data item. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF open for reading. */ -/* DESCR I Descriptor for a generic segment in the DAF. */ -/* MNEMON I An integer mnemonic for the desired meta data. */ -/* VALUE O The value of the meta data item requested. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF opened for reading that */ -/* contains the generic segment described by DESCR. */ - -/* DESCR is the descriptor of a generic segment. This must */ -/* be the descriptor for a generic segment in the DAF */ -/* associated with HANDLE. */ - -/* MNEMON is the mnemonic used to represent the desired piece of */ -/* meta data. See the file 'sgparam.inc' for details, the */ -/* mnemonics, and their values. */ - -/* $ Detailed_Output */ - -/* VALUE is the value of the meta data item associated with */ -/* the mnemonic MNEMON that is in the generic segment */ -/* specified by HANDLE and DESCR. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Files */ - -/* See the description of HANDLE above. */ - -/* $ Exceptions */ - -/* 1) If the mnemonic for the meta data item is not valid, the error */ -/* SPICE(UNKNOWNMETAITEM) will be signalled. */ - -/* 2) If the last address in the DAF segment that reports the number */ -/* of meta data items that exist in the segment is less than */ -/* MNMETA, the error SPICE(INVALIDMETADATA) will be signaled. */ - -/* $ Particulars */ - -/* This routine is a utility for fetching the meta data associated */ -/* with a DAF generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a segment is */ -/* required. The other data partitions may occur in any order in the */ -/* segment because the meta data will contain pointers to the */ -/* appropriate locations of the other data partitions within the */ -/* segment. */ - -/* The meta data for the segment should be obtained only through */ -/* use of this routine, SGMETA. */ - -/* $ Examples */ - -/* Suppose that we would like to know how many constants, data */ -/* packets, and reference values are in the generic segment that we */ -/* have located in the DAF file associated with HANDLE. */ - -/* C */ -/* C Get the number of constants. */ -/* C */ -/* CALL SGMETA ( HANDLE, DESCR, NCON, NCONST ) */ -/* C */ -/* C Get the number of data packets. */ -/* C */ -/* CALL SGMETA ( HANDLE, DESCR, NPKT, NPKTS ) */ -/* C */ -/* C Get the number of constants. */ -/* C */ -/* CALL SGMETA ( HANDLE, DESCR, NREF, NREFS ) */ - -/* C */ -/* C Print the values. */ -/* C */ -/* WRITE (*, *) 'Number of Constants : ', NCONST */ -/* WRITE (*, *) 'Number of Data Packets : ', NPKTS */ -/* WRITE (*, *) 'Number of Reference Values: ', NREFS */ - -/* $ Restrictions */ - -/* The segment described by DESCR MUST be a generic segment, */ -/* otherwise the results of this routine are not predictable. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.4.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ - -/* - SPICELIB Version 1.3.0, 14-JUN-1999 (FST) */ - -/* Altered the check in/out structure to be more reasonable. */ -/* This introduced redundant code, but only to increase the */ -/* efficiency of the normal mode of operation. */ - -/* - SPICELIB Version 1.2.0, 24-SEP-1998 (FST) */ - -/* Modified the code that handles reading the meta data from the */ -/* DAF to handle the case when the number of meta data items in */ -/* the file exceeds the current maximum defined in sgparam.inc. */ -/* In the event that this situation occurs, the routine loads */ -/* what meta data it can interpret and ignores the rest. In */ -/* this event if NMETA is requested, it is returned as MXMETA in */ -/* sgparam.inc. */ - -/* An additional exception is now trapped by the routine. If */ -/* a generic segment in a DAF reports less than the known minimum */ -/* number of meta data items, then the routine signals the */ -/* error SPICE(INVALIDMETADATA). */ - -/* The conditions that cause the SPICE(UNKNOWNMETAITEM) to be */ -/* signaled have been altered. Now if the integer mnemonic */ -/* is not between 1 and METASZ inclusive, or NMETA the error */ -/* is signaled. In the versions preceding this change, for */ -/* segments that reported less than NMETA items of meta data */ -/* could not use this routine to request the number of meta */ -/* data items without signalling SPICE(UNKNOWNMETAITEM). */ - -/* - SPICELIB Version 1.1.0, 11-APR-1995 (KRG) */ - -/* Modified the code that deals with the EQUIVALENCEd part */ -/* descriptor. We now call MOVED rather than using a direct */ -/* assignment. */ - -/* - SPICELIB Version 1.0.0, 11-APR-1995 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* retrieve a meta data value for a generic segment */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* Include the mnemonic values for the generic segment declarations. */ - - -/* Local Variables */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Handle the case when we are looking at the same file and segment */ -/* descriptor first. This will result in duplicated code, but will */ -/* increase efficiency for the usual execution case. We need not */ -/* worry about the first time through, since LSTHAN and LSTBEG are */ -/* set to values that are bogus for actual DAF files. */ - - if (*handle == lsthan) { - -/* Get the begin and end values from the descriptor. They are */ -/* located in the last two "integer" positions of the descriptor. */ - - if (nieven) { - moved_(&descr[ioffst - 1], &c__1, dtemp); - begin = itemp[0]; - end = itemp[1]; - } else { - moved_(&descr[ioffst - 1], &c__2, dtemp); - begin = itemp[1]; - end = itemp[2]; - } - -/* Check the segment start address. This will tell us whether we */ -/* are looking at the same segment. */ - - if (lstbeg == begin) { - -/* The only acceptable integer mnemonics at this point are 1 */ -/* through METASZ inclusive, and NMETA. All other requests */ -/* should signal the SPICE(UNKNOWNMETAITEM) error, since the */ -/* current segment has no knowledge of these values. */ - - if (*mnemon <= 0 || *mnemon > metasz && *mnemon != 17) { - chkin_("SGMETA", (ftnlen)6); - *value = -1; - setmsg_("The item requested, #, is not one of the recognized" - " meta data items associated with this generic segmen" - "t.", (ftnlen)105); - errint_("#", mnemon, (ftnlen)1); - sigerr_("SPICE(UNKNOWNMETAITEM)", (ftnlen)22); - chkout_("SGMETA", (ftnlen)6); - return 0; - } - -/* Set the value for the desired meta data item and return. */ - - *value = meta[(i__1 = *mnemon - 1) < 17 && 0 <= i__1 ? i__1 : - s_rnge("meta", i__1, "sgmeta_", (ftnlen)364)]; - return 0; - } - } - -/* At this point we are going to have to load the meta data. If */ -/* the new handle and the old handle are the same, then the above */ -/* code has already retrieved the relevant segment addresses. If not */ -/* we need to fetch them. First check in. */ - - chkin_("SGMETA", (ftnlen)6); - if (*handle != lsthan) { - dafhsf_(handle, &nd, &ni); - if (failed_()) { - chkout_("SGMETA", (ftnlen)6); - return 0; - } - niovr2 = ni / 2; - nieven = niovr2 << 1 == ni; - ioffst = nd + niovr2; - lsthan = *handle; - -/* Get the begin and end values from the descriptor. They are */ -/* located in the last two "integer" positions of the descriptor. */ - - if (nieven) { - moved_(&descr[ioffst - 1], &c__1, dtemp); - begin = itemp[0]; - end = itemp[1]; - } else { - moved_(&descr[ioffst - 1], &c__2, dtemp); - begin = itemp[1]; - end = itemp[2]; - } - } - -/* Save the new begin address. Remember we have either just computed */ -/* this from the IF block above, or we computed it in the very */ -/* first IF block. */ - - lstbeg = begin; - -/* Compute the begin address of the meta data and compute the */ -/* end address of the number we will be collecting. */ - - dafgda_(handle, &end, &end, &dmtasz); - if (failed_()) { - chkout_("SGMETA", (ftnlen)6); - return 0; - } - metasz = i_dnnt(&dmtasz); - -/* Store the actual meta size in AMETAS, in case METASZ ends up */ -/* being modified to conform to our current understanding of */ -/* meta data items. */ - - ametas = metasz; - -/* Check to see if METASZ is an unacceptable value. */ - - if (metasz < 15) { - *value = -1; - setmsg_("This segment reports that it has # meta data items. Every g" - "eneric segment must have at least #.", (ftnlen)95); - errint_("#", &metasz, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDMETADATA)", (ftnlen)22); - chkout_("SGMETA", (ftnlen)6); - return 0; - -/* If it is not, we may need to fix a few things to work around some */ -/* older files that have been delivered. We perform these kludges */ -/* here. Originally, the number of meta data items was not */ -/* considered to be part of the meta data. It now is, so if we */ -/* encounter an older version of the file, we need to increment the */ -/* meta data size by 1. The number of meta data items is always */ -/* after all of the meta data items, so we can do this. */ - - } else if (metasz == 15) { - ++metasz; - ametas = metasz; - -/* If not check to see if METASZ is greater than the known MXMETA. */ -/* If it is then this segment most likely was constructed from */ -/* some newer version of the toolkit. Load what meta data we */ -/* currently know about as laid out in sgparam.inc. */ - - } else if (metasz > 17) { - -/* Leave AMETAS alone, since we need to know how far back */ -/* into the DAF file to begin reading. */ - - metasz = 17; - } - -/* The address computations that follow are precisely the same */ -/* as the previous version of the file, except when AMETAS is not */ -/* METASZ. This only happens when METASZ is greater than MXMETA. */ - - begmta = end - ametas + 1; - endmta = begmta + metasz - 1; - dafgda_(handle, &begmta, &endmta, xmeta); - if (failed_()) { - chkout_("SGMETA", (ftnlen)6); - return 0; - } - -/* Convert all of the meta data values into integers. */ - - i__1 = metasz; - for (i__ = 1; i__ <= i__1; ++i__) { - meta[(i__2 = i__ - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("meta", i__2, - "sgmeta_", (ftnlen)503)] = i_dnnt(&xmeta[(i__3 = i__ - 1) < - 17 && 0 <= i__3 ? i__3 : s_rnge("xmeta", i__3, "sgmeta_", ( - ftnlen)503)]); - } - -/* The kludge continues... NMETA and MXMETA are ALWAYS the same */ -/* value, and any missing values must appear between the last known */ -/* value, META(METASZ-1), and the end value, META(NMETA), so we zero */ -/* them out. */ - - meta[16] = metasz; - for (i__ = metasz; i__ <= 16; ++i__) { - meta[(i__1 = i__ - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge("meta", i__1, - "sgmeta_", (ftnlen)515)] = 0; - } - -/* Adjust the bases so that the N'th item of a partition is at */ -/* address META(PARTITION_BASE) + N */ - - begm1 = begin - 1; - meta[0] += begm1; - meta[5] += begm1; - meta[2] += begm1; - meta[7] += begm1; - meta[10] += begm1; - meta[12] += begm1; - -/* The only acceptable integer mnemonics at this point are 1 through */ -/* METASZ inclusive, and NMETA. All other requests should signal */ -/* the SPICE(UNKNOWNMETAITEM) error, since the current segment has */ -/* no knowledge of these values. */ - - if (*mnemon <= 0 || *mnemon > metasz && *mnemon != 17) { - *value = -1; - setmsg_("The item requested, #, is not one of the recognized meta da" - "ta items associated with this generic segment.", (ftnlen)105); - errint_("#", mnemon, (ftnlen)1); - sigerr_("SPICE(UNKNOWNMETAITEM)", (ftnlen)22); - chkout_("SGMETA", (ftnlen)6); - return 0; - } - -/* Set the value for the desired meta data item, check out if we */ -/* need to, and return. */ - - *value = meta[(i__1 = *mnemon - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge( - "meta", i__1, "sgmeta_", (ftnlen)555)]; - chkout_("SGMETA", (ftnlen)6); - return 0; -} /* sgmeta_ */ - -#undef itemp -#undef dtemp - - diff --git a/ext/spice/src/cspice/sgseqw.c b/ext/spice/src/cspice/sgseqw.c deleted file mode 100644 index d67f68cf71..0000000000 --- a/ext/spice/src/cspice/sgseqw.c +++ /dev/null @@ -1,4341 +0,0 @@ -/* sgseqw.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__4 = 4; -static integer c__1 = 1; -static integer c__17 = 17; - -/* $Procedure SGSEQW ( Generic segements: Sequential writer. ) */ -/* Subroutine */ int sgseqw_0_(int n__, integer *handle, doublereal *descr, - char *segid, integer *nconst, doublereal *const__, integer *npkts, - integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal * - refdat, integer *idxtyp, ftnlen segid_len) -{ - /* Initialized data */ - - static integer numfxd = 0; - static integer numvar = 0; - static integer nft = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double d_int(doublereal *); - - /* Local variables */ - integer meta[17], size, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer fthan[20], ftoff[20], index; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal xmeta[17], myref; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafcad_( - integer *), dafgda_(integer *, integer *, integer *, doublereal *) - , dafbna_(integer *, doublereal *, char *, ftnlen); - char dummy1[60]; - integer dummy2, dummy3; - extern /* Subroutine */ int dafena_(void); - integer nc, nd; - extern logical failed_(void); - integer begadr, ni; - extern /* Subroutine */ int dafhsf_(integer *, integer *, integer *), - dafsih_(integer *, char *, ftnlen); - integer refadr; - static integer ftbadr[20]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - integer sidlen; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen); - doublereal myaddr; - extern integer isrchi_(integer *, integer *, integer *), lastnb_(char *, - ftnlen); - integer pktadr; - static logical fxdseg; - static integer lsthan; - static doublereal ftrefs[40] /* was [2][20] */; - static integer ftncon[20]; - static logical explct; - doublereal dpksiz; - static integer ftnpkt[20], ftnref[20], ftnres[20]; - extern logical return_(void); - doublereal mysize; - integer pktpos; - static integer ftityp[20], ftpksz[20]; - static logical ftfixd[20], ftexpl[20]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static integer ftmxsz[20]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - integer ich; - -/* $ Abstract */ - -/* This is the umbrella routine for managing the sequential writing */ -/* of generic segments to DAF files. It should never be called */ -/* directly, it provides the mechanism whereby data are shared by */ -/* its entry points. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with write access. */ -/* DESCR I Descriptor for a generic segment. */ -/* SEGID I Identifier for a generic segment. */ -/* NCONST I Number of constant values in a generic segment. */ -/* CONST I Array of constant values for a generic segment. */ -/* NPKTS I Number of data packets to write to a segment. */ -/* PKTSIZ I Size of fixed size packets or sizes of variable */ -/* size packets. */ -/* PKTDAT I Array of packet data. */ -/* NREFS I Number of reference values. */ -/* REFDAT I Reference data. */ -/* IDXTYP I Index type for the reference values. */ - -/* $ Detailed_Input */ - -/* HANDLE Handle of a DAF file opened with write access. This is */ -/* the handle of the file in which a generic segment will */ -/* be started, or the handle of a file in which a generic */ -/* segment is currently being written. */ - -/* DESCR Descriptor for the generic segment that is being */ -/* written. This is the packed form of the DAF double */ -/* precision and integer summaries which contains ND double */ -/* precision numbers and NI integers, respectively. */ - -/* SEGID Identifier for the generic segment that is being */ -/* written. This is a character string containing at most */ -/* NC printing ASCII characters where */ - -/* / ND + ( NI + 1 ) \ */ -/* NC = 8 * | ----------------- | */ -/* \ 2 / */ - -/* SEGID may be blank. */ - -/* NCONST The number of constant values to be placed in the */ -/* generic segment. */ - -/* CONST An array of NCONST constant values for the generic */ -/* segment. */ - -/* NPKTS Number of data packets to write to a generic segment. */ - -/* PKTSIZ Size of fixed size packets or sizes of variable size */ -/* packets. */ - -/* The size of a packet is the number of double precision */ -/* numbers it contains. */ - -/* When writing a segment with fixed size packets, only */ -/* the first element of the array, PKTSIZ(1), is used, and */ -/* it should contain the size of the fixed size packets. In */ -/* this instance, the calling program need not declare this */ -/* variable as an array of one integer; it may be declared */ -/* as an integer variable. */ - -/* When writing a segment with variable size packets, */ -/* there must be an element in the array PKTSIZ for each of */ -/* the data packets. */ - -/* PKTDAT A singly dimensioned array containing the double */ -/* precision data for the fixed or variable size data */ -/* packets to be added to the generic segment associated */ -/* with HANDLE. */ - -/* For fixed size data packets, PKTDAT will have the */ -/* following structure: */ - -/* Packet # Range of locations for the packet data. */ -/* -------- --------------------------------------------- */ - -/* 1 PKTDAT(1) to PKTDAT(PS) */ -/* 2 PKTDAT(PS+1) to PKTDAT(2*PS) */ -/* 3 PKTDAT(2*PS+1) to PKTDAT(3*PS) */ -/* 4 PKTDAT(3*PS+1) to PKTDAT(4*PS) */ - -/* . */ -/* . */ -/* . */ - -/* NPKTS PKTDAT((NPKTS-1)*PS+1) to PKTDAT(NPKTS*PS) */ - -/* where PS = PKTSIZ(1). */ - -/* For variable size data packets, PKTDAT will have the */ -/* following structure: */ - -/* Packet # Range of locations for the packet data. */ -/* -------- --------------------------------------------- */ - -/* 1 PKTDAT(1) to PKTDAT(P(1)) */ -/* 2 PKTDAT(P(1)+1) to PKTDAT(P(2)) */ -/* 3 PKTDAT(P(2)+1) to PKTDAT(P(3)) */ -/* 4 PKTDAT(P(3)+1) to PKTDAT(P(4)) */ - -/* . */ -/* . */ -/* . */ - -/* NPKTS PKTDAT(P(NPKTS-1)+1) to PKTDAT(P(NPKTS)) */ - -/* I */ -/* --- */ -/* where P(I) = > PKTSIZ(K). */ -/* --- */ -/* K = 1 */ - -/* NREFS Number of reference values. */ - -/* For implicitly indexed packets, NREFS must have a value */ -/* of two (2). */ - -/* When writing packets to a generic segment which uses an */ -/* implicit index type, the value specified by NREFS is */ -/* used only on the first call to SGWFPK or SGWVPK. On all */ -/* subsequent calls to these subroutines for a particular */ -/* implicitly indexed generic segment, the value of NREFS */ -/* is ignored. */ - -/* For explicitly indexed packets, NREFS must be equal to */ -/* NPKTS; there should be a reference value for each data */ -/* packet being written to the generic segment. */ - -/* When writing packets to a segment which uses an explicit */ -/* index type, the value specified by NREFS is used on */ -/* every call to SGWFPK or SGWVPK and it must always be */ -/* equal to NPKTS. */ - -/* REFDAT Reference data values. */ - -/* For implicitly indexed packets, there must be two (2) */ -/* values. The values represent a starting value, which */ -/* will have an index of 1, and a step size between */ -/* reference values, which are used to compute an index and */ -/* a reference value associated with a specified key value. */ - -/* In order to avoid, or at least minimize, numerical */ -/* difficulties associated with computing index values for */ -/* generic segments with implicit index types, the value of */ -/* the stepsize must be an integer, i.e., DINT(REFDAT(2)) */ -/* must equal REFDAT(2). In this case, we also recommend */ -/* that REFDAT(1) be an integer, although this is not */ -/* enforced. */ - -/* When writing packets to a generic segment which uses an */ -/* implicit index type, the values specified by REFDAT are */ -/* used only on the first call to SGWFPK or SGWVPK. On all */ -/* subsequent calls to these subroutines for a particular */ -/* implicitly indexed generic segment REFDAT is ignored. */ - -/* For explicitly indexed packets, there must be NPKTS */ -/* reference values and the values must be in increasing */ -/* order: */ - -/* REFDAT(I) < REFDAT(I+1), I = 1, NPKTS-1 */ - -/* When writing packets to a segment which uses an explicit */ -/* index type, the values specified by REFDAT are used on */ -/* every call to SGWFPK or SGWVPK. On all calls to these */ -/* subroutines after the first, the value of REFDAT(1) must */ -/* be strictly greater than than the value of REFDAT(NPKTS) */ -/* from the previous call. This preserves the ordering of */ -/* the reference values for the entire segment. */ - -/* IDXTYP Index type to use for the reference values. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two */ -/* values, a starting value, which will have an index */ -/* of 1, and a step size between reference values, */ -/* which are used to compute an index and a reference */ -/* value associated with a specified key value. See */ -/* the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference */ -/* value for each data packet. */ - -/* See the chapter on Generic segments in the DAF required */ -/* or the include file 'sgparam.inc' for more details */ -/* about the index types that are available. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* The data passed to the various entry points of this subroutine are */ -/* used to construct a generic segment in one or more DAF files, with */ -/* the current file specified by the input argument HANDLE. */ - -/* $ Parameters */ - -/* The entry points in this subroutine make use of parameters defined */ -/* in the file 'sgparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If this subroutine is called directly rather than through one */ -/* of its entry points, the error SPICE(BOGUSENTRY) will be */ -/* signalled. */ - -/* See the individual entry points for descriptions of their */ -/* exceptions. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section above. */ - -/* $ Particulars */ - -/* This is the umbrella routine for managing the sequential writing */ -/* of generic segments to DAF files. It should never be called */ -/* directly, but provides the mechanism whereby data are shared by */ -/* its entry points. The entry points included in this subroutine */ -/* are: */ - -/* SGBWFS ( HANDLE, DESCR, SEGID, NCONST, CONST, PKTSIZ, IDXTYP ) */ -/* Begin writing a generic segment with fixed size packets. */ - -/* SGBWVS ( HANDLE, DESCR, SEGID, NCONST, CONST, IDXTYP ) */ -/* Begin writing a generic segment with variable size packets. */ - -/* SGWFPK ( HANDLE, NPKTS, PKTDAT, NREFS, REFDAT ) */ -/* Write fixed size packets to a generic segment started by */ -/* calling SGBWFS. */ - -/* SGWVPK ( HANDLE, NPKTS, PKTSIZ, PKTDAT, NREFS, REFDAT ) */ -/* Write variable size packets to a generic segment started by */ -/* calling SGBWVS. */ - -/* SGWES ( HANDLE ) */ -/* End a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* The entry points of this subroutine when used together provide the */ -/* following capabilities: */ - -/* 1) The ability to write a generic segment with fixed size data */ -/* packets to a DAF. */ - -/* 2) the ability to write a generic segment with variable size */ -/* data packets to a DAF. */ - -/* 3) The ability to write generic segments to multiple files. */ -/* Only a single generic segment may be written to a particular */ -/* file at any time, but several files may each have a generic */ -/* segment being written to them at the same time. */ - -/* Packets may be placed into a generic segment one at a time or N at */ -/* at time, depending upon the whim of the programmer, limitations */ -/* of the computing equipment (memory), or requirements placed upon */ -/* the software that will write a generic segment. */ - -/* Packets are retrieved from a generic segment by an index which may */ -/* be obtained by using the subroutine SGFRVI (generic segments fetch */ -/* reference value and index). */ - -/* $ Examples */ - -/* In examples 1 and 3, we make use of the fictitious subroutines */ - -/* GET_FIX_PKT ( PACKET, REF, DONE ) */ - -/* and */ - -/* GET_VAR_PKT ( PACKET, SIZE, REF, DONE ) */ - -/* where */ - -/* DONE is a logical flag indicating whether there is more data */ -/* available. DONE = .TRUE. implies there is no more data. */ -/* DONE = .FALSE. implies there is more data available. */ - -/* PACKET is a double precision array of an appropriate size to */ -/* hold all of the data returned. */ - -/* REF is a double precision reference value that will be used */ -/* to create an index for the data packets in the segment. */ -/* The values of this variable are always increasing, e.g., */ -/* the value of REF on the second call to GET_FIX_PKT or */ -/* GET_VAR_PKT will be greater than the value on the first */ -/* call to the subroutine. */ - -/* SIZE is an integer for the size of the variable size data */ -/* packet that is returned. */ - -/* These subroutines return a fixed size data packet and a variable */ -/* size data packet, respectively. We make use of these fictitious */ -/* subroutines in the examples to avoid adding unnecessary or */ -/* distracting complications. */ - -/* You may think of these subroutines as methods for acquiring data */ -/* from a "black-box" process. In the first case, the data is always */ -/* returned in fixed size blocks from a black-box that fills a local */ -/* buffer with data and always returned the entire buffer when data */ -/* is requested, e.g., an instrument that measures the concentrations */ -/* of carbon dioxide, sulfer dioxide, ozone, and other constituents */ -/* of the air. In the second case, the data is returned in variably */ -/* sized blocks from a black-box, e.g., an algorithm which integrates */ -/* a function using polynomials of varying degree; different numbers */ -/* of coefficients are required for polynomials of differing degrees. */ - -/* In examples 2 and 4, we make use of the fictitious subroutines */ - -/* GET_FIX_PKTS ( NPKTS, PKTS, REFS, DONE ) */ - -/* and */ - -/* GET_VAR_PKTS ( NPKTS, PKTS, SIZES, REFS, DONE ) */ - -/* where */ - -/* DONE is a logical flag indicating whether there is more data */ -/* available. DONE = .TRUE. implies there is no more data. */ -/* DONE = .FALSE. implies there is more data available; */ - -/* NPKTS is the number of data packets returned in the array */ -/* PKTS. */ - -/* PKTS is a double precision array containing NPKTS data */ -/* packets, either fixed size or variable size, and is of */ -/* an appropriate size to hold all of the data returned. */ -/* See the description of PKTDAT above for the exact manner */ -/* in which fixed size packets and variable size packets */ -/* are stored in an array. */ - -/* REFS is a double precision array which contains NPKTS */ -/* reference values that will be used to create an index */ -/* for the data packets in the segment. The values of this */ -/* variable are always increasing, e.g., the first value of */ -/* REFS on the second call to GET_FIX_PKTS or GET_VAR_PKTS */ -/* will be greater than the last value of REFS on the first */ -/* call to the subroutine. */ - -/* SIZES is an array of integers containing the sizes of each of */ -/* the variable size data packets that is returned in PKTS. */ - -/* These subroutines return arrays containing one or more fixed size */ -/* data packets and one or more variable size data packets, */ -/* respectively. We make use of these fictitious subroutines in the */ -/* examples to avoid adding unnecessary or distracting complications. */ - -/* For each example, we provide a simple code fragment that */ -/* demonstrates the use of the entry points to create generic */ -/* segments. We assume that all of the relevant variables are defined */ -/* at the time that the entry points are invoked. These code */ -/* fragments are for illustrative purposes; they do not necessarily */ -/* conform to what would be considered good programming practice. */ - -/* Example 1-A: Adding fixed size packets one at a time. */ - -/* For this example, we make no assumptions about the reference */ -/* values returned by GET_VAR_PKT other than they are increasing. */ -/* Having no other information about the reference values, we must */ -/* use an explicit indexing method to store the packets. */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a fixed size segment. To do this, we */ -/* C need: */ -/* C */ -/* C HANDLE -- The handle of a DAF opened with write */ -/* C access. */ -/* C DESCR -- The packed descriptor for the segment that */ -/* C we want to create. */ -/* C SEGID -- A short character string that provides an */ -/* C identifier for the segment. */ -/* C NCONST -- The number of constant values to be */ -/* C associated with all of the packets in the */ -/* C segment. */ -/* C CONST -- An array of constant values to be associated */ -/* C with all of the packets in a segment. */ -/* C PKTSIZ -- The size of the packets that will be stored */ -/* C in this segment, i.e., the number of double */ -/* C precision numbers necessary to store a */ -/* C complete data packet. */ -/* C EXPCLS -- The type of indexing scheme that we will use */ -/* C for searching the segment to obtain a data */ -/* C packet. In this case, we are going to use */ -/* C an exlicit index, which requires a reference */ -/* C value for each data packet, and when */ -/* C searching for a data packet we will choose */ -/* C the packet with a reference value closest to */ -/* C the requested value. See the include file */ -/* C 'sgparam.inc' for the value of EXPCLS. */ -/* C */ -/* CALL SGBWFS ( HANDLE, DESCR, SEGID, NCONST, */ -/* . CONST, PKTSIZ, EXPCLS ) */ -/* C */ -/* C We loop until done, obtaining a fixed size packet */ -/* C and writing it to the generic segment in the file. */ -/* C */ -/* DONE = .FALSE. */ -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get a fixed size packet and a reference value. */ -/* C */ -/* CALL GET_FIX_PKT ( PACKET, REF, DONE ) */ -/* C */ -/* C Write the packet to the segment, unless we're done. */ -/* C */ -/* IF ( .NOT. DONE ) THEN */ - -/* CALL SGWFPK ( HANDLE, 1, PACKET, 1, REF ) */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C End the segment and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDLE ) */ -/* . */ -/* . */ -/* . */ - -/* Example 1-B: Adding fixed size packets with uniformly spaced */ -/* reference values. */ - -/* In the previous example, we made no assumptions about the */ -/* reference values other than that they were increasing. We now */ -/* will assume that the reference values are also equally spaced */ -/* and that we have a priori values for a beginning reference */ -/* value, BEGIN_REF, and a stepsize, STEP_SIZE, that is the */ -/* difference between two consecutive reference values. We have */ - -/* BEGIN_REF <= REF <= BEGIN_REF + (N-1) * STEP_SIZE */ - -/* where BEGIN_REF equals the first reference value returned by */ -/* GET_FIX_PKT and BEGIN_REF + (N-1) * STEP_SIZE equals the last */ -/* reference value returned. Under these assumptions we can use an */ -/* implicit index for the data packets which will provide a more */ -/* space efficient method for putting the data packets into a */ -/* generic segment. We repeat the example under these assumptions */ -/* using an implicit indexing method. Nothing else has changed. */ - -/* The index for a data packet in the implicitly indexed generic */ -/* segment we create is computed from the formula: */ - -/* / VALUE - REFDAT(1) \ */ -/* INDEX = IDINT | 1.5 + ----------------------- | */ -/* \ REFDAT(2) / */ - -/* where the index for the data packet associated with VALUE is */ -/* desired. */ - -/* The reference value associated with this index is: */ - -/* REF = REFDAT(1) + REFDAT*(INDEX - 1) */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a fixed size segment. To do this, we */ -/* C need: */ -/* C */ -/* C HANDLE -- The handle of a DAF opened with write */ -/* C access. */ -/* C DESCR -- The packed descriptor for the segment that */ -/* C we want to create. */ -/* C SEGID -- A short character string that provides an */ -/* C identifier for the segment. */ -/* C NCONST -- The number of constant values to be */ -/* C associated with all of the packets in the */ -/* C segment. */ -/* C CONST -- An array of constant values to be associated */ -/* C with all of the packets in a segment. */ -/* C PKTSIZ -- The size of the packets that will be stored */ -/* C in this segment, i.e., the number of double */ -/* C precision numbers necessary to store a */ -/* C complete data packet. */ -/* C IMPCLS -- The type of indexing scheme that we will use */ -/* C for searching the segment to obtain a data */ -/* C packet. In this case, we are going to use */ -/* C an implicit index, which requires beginning */ -/* C and ending times which bound all reference */ -/* C values, and when searching for a data packet */ -/* C we will choose the packet whose index is */ -/* C computed by the formula above. See the */ -/* C include file 'sgparam.inc' for the value */ -/* C of IMPCLS */ -/* C */ -/* CALL SGBWFS ( HANDLE, DESCR, SEGID, NCONST, */ -/* . CONST, PKTSIZ, IMPCLS ) */ -/* C */ -/* C Set the beginning and ending reference values for the */ -/* C implicit indexing method. */ -/* C */ -/* REFS(1) = BEGIN_REF */ -/* REFS(2) = STEP_SIZE */ -/* C */ -/* C Get the first data packet and put it in the generic */ -/* C segment. At the same time, we write the bounds used for */ -/* C the implicit indexing. We ignore the value of REF since */ -/* C the reference values are equally spaced and we are using */ -/* C an implicit indexing method. We do not check DONE here */ -/* C because we assume that there is at least one data packet. */ -/* C */ -/* CALL GET_FIX_PKT ( PACKET, REF, DONE ) */ - -/* CALL SGWFPK ( HANDLE, 1, PACKET, 2, REFS ) */ -/* C */ -/* C We loop until done, obtaining a fixed size packet */ -/* C and writing it to the generic segment in the file. */ -/* C */ -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get a fixed size packet and a reference value. */ -/* C */ -/* CALL GET_FIX_PKT ( PACKET, REF, DONE ) */ -/* C */ -/* C Write the packet to the segment, unless we're done. */ -/* C Because this segment is implicitly indexed, the last */ -/* C two calling arguments are only used in the first call */ -/* C to SGWFPK above. they are ignored in all subsequent */ -/* C calls, so we may pass "dummy" arguments. */ -/* C */ -/* IF ( .NOT. DONE ) THEN */ - -/* CALL SGWFPK ( HANDLE, 1, PACKET, DUM1, DUM2 ) */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C End the segment and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDLE ) */ -/* . */ -/* . */ -/* . */ - -/* Example 2: Adding fixed size packets more efficiently. */ - -/* It is possible to add more than one fixed size data packet to a */ -/* generic segment at one time. Doing this will usually prove to */ -/* be a more efficient way of adding the data packets, provided */ -/* there is sufficient storage to hold more than one data packet */ -/* available. This example demonstrates this capability. */ - -/* For this example, we make no assumptions about the reference */ -/* values returned by GET_FIX_PKTS other than they are increasing. */ -/* Having no other information about the reference values, we must */ -/* use an explicit indexing method to store the packets. */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a fixed size segment. To do this, we */ -/* C need: */ -/* C */ -/* C HANDLE -- The handle of a DAF opened with write */ -/* C access. */ -/* C DESCR -- The packed descriptor for the segment that */ -/* C we want to create. */ -/* C SEGID -- A short character string that provides an */ -/* C identifier for the segment. */ -/* C NCONST -- The number of constant values to be */ -/* C associated with all of the packets in the */ -/* C segment. */ -/* C CONST -- An array of constant values to be associated */ -/* C with all of the packets in a segment. */ -/* C PKTSIZ -- The size of the packets that will be stored */ -/* C in this segment, i.e., the number of double */ -/* C precision numbers necessary to store a */ -/* C complete data packet. */ -/* C EXPCLS -- The type of indexing scheme that we will use */ -/* C for searching the segment to obtain a data */ -/* C packet. In this case, we are going to use */ -/* C an exlicit index, which requires a reference */ -/* C value for each data packet, and when */ -/* C searching for a data packet we will choose */ -/* C the packet with a reference value closest to */ -/* C the requested value. See the include file */ -/* C 'sgparam.inc' for the value of EXPCLS */ -/* C */ -/* CALL SGBWFS ( HANDLE, DESCR, SEGID, NCONST, */ -/* . CONST, PKTSIZ, EXPCLS ) */ -/* C */ -/* C We loop until done, obtaining a fixed size packet */ -/* C and writing it to the generic segment in the file. */ -/* C */ -/* DONE = .FALSE. */ -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get a collection of fixed size packet and associated */ -/* C array of increasing reference values. */ -/* C */ -/* CALL GET_FIX_PKTS ( NPKTS, PKTS, REFS, DONE ) */ -/* C */ -/* C Write the packets to the segment if we have any. Since */ -/* C we are using an explicit index, the number of */ -/* C reference values is the same as the number of data */ -/* C packets. */ -/* C */ -/* IF ( .NOT. DONE ) THEN */ - -/* CALL SGWFPK ( HANDLE, NPKTS, PKTS, NPKTS, REFS ) */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C End the segment and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDLE ) */ -/* . */ -/* . */ -/* . */ - -/* If we are using an implicit indexing method, multiple data */ -/* packets may be added with one call to SGWFPK as in the above */ -/* example for an explicit index, with the exception that there */ -/* are only two reference values, and they are specified on the */ -/* first call to SGWFPK, as in Example 1-B. */ - -/* Example 3-A: Adding variable size packets one at a time. */ - -/* For this example, we make no assumptions about the reference */ -/* values returned by GET_VAR_PKT other than they are increasing. */ -/* Having no other information about the reference values, we must */ -/* use an explicit indexing method to store the packets. */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a variable size segment. To do this, we */ -/* C need: */ -/* C */ -/* C HANDLE -- The handle of a DAF opened with write */ -/* C access. */ -/* C DESCR -- The packed descriptor for the segment that */ -/* C we want to create. */ -/* C SEGID -- A short character string that provides an */ -/* C identifier for the segment. */ -/* C NCONST -- The number of constant values to be */ -/* C associated with all of the packets in the */ -/* C segment. */ -/* C CONST -- An array of constant values to be associated */ -/* C with all of the packets in a segment. */ -/* C EXPCLS -- The type of indexing scheme that we will use */ -/* C for searching the segment to obtain a data */ -/* C packet. In this case, we are going to use */ -/* C an exlicit index, which requires a reference */ -/* C value for each data packet, and when */ -/* C searching for a data packet we will choose */ -/* C the packet with a reference value closest to */ -/* C the requested value. See the include file */ -/* C 'sgparam.inc' for the value of EXPCLS. */ -/* C */ -/* CALL SGBVFS ( HANDLE, DESCR, SEGID, */ -/* . NCONST, CONST, EXPCLS ) */ -/* C */ -/* C We loop until done, obtaining a variable size packet */ -/* C and writing it to the generic segment in the file. */ -/* C */ -/* DONE = .FALSE. */ -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get a variable size packet and a reference value. */ -/* C */ -/* CALL GET_VAR_PKT ( PACKET, SIZE, REF, DONE ) */ -/* C */ -/* C Write the packet to the segment, unless we're done. */ -/* C */ -/* IF ( .NOT. DONE ) THEN */ - -/* CALL SGWVPK ( HANDLE, 1, SIZE, PACKET, 1, REF ) */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C End the segment and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDLE ) */ -/* . */ -/* . */ -/* . */ - -/* Example 3-B: Adding variable size packets one at a time with */ -/* uniformly spaced reference values. */ - -/* In the previous example, we made no assumptions about the */ -/* reference values other than that they were increasing. We now */ -/* will assume that the reference values are also equally spaced */ -/* and that we have a priori values for a beginning reference */ -/* value, BEGIN_REF, and a stepsize, STEP_SIZE, that is the */ -/* difference between two consecutive reference values. We have */ - -/* BEGIN_REF <= REF <= BEGIN_REF + (N-1) * STEP_SIZE */ - -/* where BEGIN_REF equals the first reference value returned by */ -/* GET_VAR_PKT and BEGIN_REF + (N-1) * STEP_SIZE equals the last */ -/* reference value returned. Putting all of this together means */ -/* that we can use an implicit index for the data packets which */ -/* will provide a more space efficient method for putting the data */ -/* packets into a generic segment. We repeat the example under */ -/* these assumptions using an implicit indexing method. Nothing */ -/* else has changed. */ - -/* The index for a data packet in the implicitly indexed generic */ -/* segment we create is computed from the formula: */ - -/* / VALUE - REFDAT(1) \ */ -/* INDEX = IDINT | 1.5 + ----------------------- | */ -/* \ REFDAT(2) / */ - -/* where the index for the data packet associated with VALUE is */ -/* desired. */ - -/* The reference value associated with this index is: */ - -/* REF = REFDAT(1) + REFDAT*(INDEX - 1) */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a variable size segment. To do this, we */ -/* C need: */ -/* C */ -/* C HANDLE -- The handle of a DAF opened with write */ -/* C access. */ -/* C DESCR -- The packed descriptor for the segment that */ -/* C we want to create. */ -/* C SEGID -- A short character string that provides an */ -/* C identifier for the segment. */ -/* C NCONST -- The number of constant values to be */ -/* C associated with all of the packets in the */ -/* C segment. */ -/* C CONST -- An array of constant values to be associated */ -/* C with all of the packets in a segment. */ -/* C IMPCLS -- The type of indexing scheme that we will use */ -/* C for searching the segment to obtain a data */ -/* C packet. In this case, we are going to use */ -/* C an implicit index, which requires beginning */ -/* C and ending times which bound all reference */ -/* C values, and when searching for a data packet */ -/* C we will choose the packet whose index is */ -/* C computed by the formula above. See the */ -/* C include file 'sgparam.inc' for the value of */ -/* C IMPCLS. */ -/* C */ -/* CALL SGBWVS ( HANDLE, DESCR, SEGID, NCONST, */ -/* . CONST, IMPCLS ) */ -/* C */ -/* C Set the beginning and ending reference values for the */ -/* C implicit indexing method. */ -/* C */ -/* REFS(1) = BEGIN_REF */ -/* REFS(2) = STEP_SIZE */ -/* C */ -/* C Get the first data packet and put it in the generic */ -/* C segment. At the same time, we write the bounds used for */ -/* C the implicit indexing. We ignore the value of REF since */ -/* C the reference values are equally spaced and we are using */ -/* C an implicit indexing method. We do not check DONE here */ -/* C because we assume that there is at least one data packet. */ -/* C */ -/* CALL GET_VAR_PKT ( PACKET, SIZE, REF, DONE ) */ - -/* CALL SGWVPK ( HANDLE, 1, SIZE, PACKET, 2, REFS ) */ -/* C */ -/* C We loop until done, obtaining a fixed size packet */ -/* C and writing it to the generic segment in the file. */ -/* C */ -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get a variable size packet and a unique reference */ -/* C value. */ -/* C */ -/* CALL GET_VAR_PKT ( PACKET, SIZE, REF, DONE ) */ -/* C */ -/* C Write the packet to the segment, unless we're done. */ -/* C Because this segment is implicitly indexed, the last */ -/* C two calling arguments are only used in the first call */ -/* C to SGWFPK above. they are ignored in all subsequent */ -/* C calls, so we may pass "dummy" arguments. */ -/* C */ -/* IF ( .NOT. DONE ) THEN */ - -/* CALL SGVFPK ( HANDLE, 1, SIZE, PACKET, DUM1, DUM2 ) */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C End the segment and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDLE ) */ -/* . */ -/* . */ -/* . */ - -/* Example 4: Adding variable size packets more efficiently. */ - -/* It is possible to add more than one variable size data packet */ -/* to a generic segment at one time. Doing this will usually prove */ -/* to be a more efficient way of adding the data packets, provided */ -/* there is sufficient storage to hold more than one data packet */ -/* available. This example demonstrates this capability. */ - -/* For this example, we make no assumptions about the reference */ -/* values returned by GET_VAR_PKTS other than they are increasing. */ -/* Having no other information about the reference values, we must */ -/* use an explicit indexing method to store the packets. */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a variable size segment. To do this, we */ -/* C need: */ -/* C */ -/* C HANDLE -- The handle of a DAF opened with write */ -/* C access. */ -/* C DESCR -- The packed descriptor for the segment that */ -/* C we want to create. */ -/* C SEGID -- A short character string that provides an */ -/* C identifier for the segment. */ -/* C NCONST -- The number of constant values to be */ -/* C associated with all of the packets in the */ -/* C segment. */ -/* C CONST -- An array of constant values to be associated */ -/* C with all of the packets in a segment. */ -/* C EXPCLS -- The type of indexing scheme that we will use */ -/* C for searching the segment to obtain a data */ -/* C packet. In this case, we are going to use */ -/* C an exlicit index, which requires a reference */ -/* C value for each data packet, and when */ -/* C searching for a data packet we will choose */ -/* C the packet with a reference value closest to */ -/* C the requested value. See the include file */ -/* C sgparam.inc for the value of EXPCLS. */ -/* C */ -/* CALL SGBWVS ( HANDLE, DESCR, SEGID, */ -/* C . NCONST, CONST, EXPCLS ) */ -/* C */ -/* C We loop until done, obtaining a fixed size packet */ -/* C and writing it to the generic segment in the file. */ -/* C */ -/* DONE = .FALSE. */ -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get a collection of variable size packets and an */ -/* C array of increasing reference values. */ -/* C */ -/* GET_VAR_PKTS ( NPKTS, PKTS, SIZES, REFS, DONE ) */ -/* C */ -/* C Write the packets to the segment if we have any. Since */ -/* C we are using an explicit index, the number of */ -/* C reference values is the same as the number of data */ -/* C packets. */ -/* C */ -/* IF ( NPKTS .GT. 0 ) THEN */ - -/* CALL SGWVPK ( HANDLE, NPKTS, SIZES, */ -/* . PKTS, NPKTS, REFS ) */ - -/* END IF */ - -/* END DO */ -/* C */ -/* C End the segment and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDLE ) */ -/* . */ -/* . */ -/* . */ - -/* If we are using an implicit indexing method, multiple data */ -/* packets may be added with one call to SGWVPK as in the above */ -/* example for an explicit index, with the exception that there */ -/* are only two reference values, and they are specified on the */ -/* first call to SGWVPK, as in Example 3-B. */ - -/* Example 5: Adding packets to multiple files. */ - -/* It is possible to write multiple generic segments to different */ -/* DAFs at the same time. Only one generic segment may be written */ -/* to a particular DAF at any given time, however. */ - -/* For this example we assume that we have previously opened four */ -/* DAF files, having the handles HANDL1, HANDL2, HANDL3, HANDL4. */ -/* We will be writing fixed size data packets to the DAFs */ -/* associated with handles HANDL2 and HANDL3, with packet sizes of */ -/* 21 and 53, respectively. We will be writing variable size data */ -/* packets to the DAFs associated with handles HANDL1 and HANDL4. */ -/* We will be writing individual data packets to the files */ -/* associated with handles HANDL2 and HANDL4, and one or more data */ -/* packets to the files associated with handles HANDL1 and HANDL3. */ -/* On each trip through the loop in the example below, we will add */ -/* data to any of the segments whose status flags are not set. We */ -/* are done with the loop below when we have finished each of the */ -/* segments, as indicated by its status flag. */ - -/* For this example, we make no assumptions about the reference */ -/* values returned by the GET_*_* subroutines other than they are */ -/* increasing. Having no other information about the reference */ -/* values, we must use an explicit indexing method to store the */ -/* packets. */ - -/* . */ -/* . */ -/* . */ -/* C */ -/* C First we begin a generic segment of the appropriate type */ -/* C in each of the files. segment. To do this, we need: */ -/* C */ -/* C HANDL1, HANDL2, HANDL3, HANDL4 -- */ -/* C */ -/* C The handles of a DAFs opened with write access to */ -/* C which we wish to add a new generic segment. */ -/* C */ -/* C DESCR1, DESCR2, DESCR3, DESCR4 -- */ -/* C */ -/* C The packed descriptors for the segments that */ -/* C we want to create. */ -/* C */ -/* C SEGID1, SEGID2, SEGID3, SEGID4 -- */ -/* C */ -/* C A short character string that provides an */ -/* C identifier for each of the segments we will be */ -/* C creating. */ -/* C */ -/* C NCON1, NCON2, NCON3, NCON4 -- */ -/* C */ -/* C The number of constant values to be associated with */ -/* C all of the packets in each the segments we will be */ -/* C creating. */ -/* C */ -/* C */ -/* C CONST1, CONST2, CONST3, CONST4 -- */ -/* C */ -/* C An array of constant values to be associated with */ -/* C all of the packets in each of the segments that we */ -/* C are creating. */ -/* C */ -/* C IDXT1, IDXT2, IDXT3, IDXT4 -- */ -/* C */ -/* C The type of indexing scheme that we will use for */ -/* C searching each of the segments to obtain a data */ -/* C packet. In this example, each of the generic */ -/* C segments will use an explicit index, which requires */ -/* C a reference value for each data packet. When */ -/* C searching for a data packet we will choose the */ -/* C packet with a reference value closest to the */ -/* C requested value. */ -/* C */ -/* C IDXT1 = EXPCLS */ -/* C IDXT2 = EXPCLS */ -/* C IDXT3 = EXPCLS */ -/* C IDXT4 = EXPCLS */ -/* C */ -/* CALL SGBWVS ( HANDL1, DESCR1, SEGID1, */ -/* . NCON1, CONST1, IDXT1 ) */ -/* CALL SGBWFS ( HANDL2, DESCR2, SEGID2, 21, */ -/* . NCON2, CONST2, IDXT2 ) */ -/* CALL SGBWFS ( HANDL3, DESCR3, SEGID3, 53, */ -/* . NCON3, CONST3, IDXT3 ) */ -/* CALL SGBWVS ( HANDL4, DESCR4, SEGID4, */ -/* . NCON4, CONST4, IDXT4 ) */ -/* C */ -/* C We loop until done, obtaining data packets and writing */ -/* C them to the generic segments in the appropriate DAFs. */ -/* C */ -/* C We keep track of a status flag, DONE1, DONE2, DONE3, */ -/* C DONE4, for each of the segments we are writing. When we */ -/* C have finished writing all of the segments, we exit the */ -/* C loop. */ -/* C */ -/* DONE = .FALSE. */ -/* DONE1 = .FALSE. */ -/* DONE2 = .FALSE. */ -/* DONE3 = .FALSE. */ -/* DONE4 = .FALSE. */ - -/* DO WHILE ( .NOT. DONE ) */ -/* C */ -/* C Get data packets and reference values for HANDL1 and */ -/* C write them to the generic segment in that file. */ -/* C */ -/* IF ( .NOT. DONE1 ) THEN */ -/* GET_VAR_PKTS ( NPKTS, PKTS, SIZES, REFS, DONE1 ) */ - -/* IF ( NPKTS .GT. 0 ) THEN */ -/* CALL SGWVPK ( HANDL1, NPKTS, SIZES, */ -/* . PKTS, NPKTS, REFS ) */ -/* END IF */ -/* END IF */ -/* C */ -/* C Get a data packet and reference value for HANDL2 and */ -/* C write it to the generic segment in that file. */ -/* C */ -/* IF ( .NOT. DONE2 ) THEN */ -/* CALL GET_FIX_PKT ( PACKET, REF, DONE2 ) */ - -/* IF ( .NOT. DONE2 ) THEN */ -/* CALL SGWFPK ( HANDL2, 1, PACKET, 1, REF ) */ -/* END IF */ -/* END IF */ -/* C */ -/* C Get data packets and reference values for HANDL3 and */ -/* C write them to the generic segment in that file. */ -/* C */ -/* IF ( .NOT. DONE3 ) THEN */ -/* CALL GET_FIX_PKTS ( NPKTS, PKTS, REFS, DONE3 ) */ - -/* IF ( NPKTS .GT. 0 ) THEN */ -/* CALL SGWFPK ( HANDL3, NPKTS, PKTS, NPKTS, REFS ) */ -/* END IF */ -/* END IF */ -/* C */ -/* C Get a data packet and reference value for HANDL4 and */ -/* C write it to the generic segment in that file. */ -/* C */ -/* IF ( .NOT. DONE4 ) THEN */ -/* GET_VAR_PKT ( PACKET, SIZE, REF, DONE4 ) */ - -/* IF ( .NOT. DONE4 ) THEN */ -/* CALL SGWVPK ( HANDL4, 1, SIZES, PKTS, 1, REFS ) */ -/* END IF */ -/* END IF */ -/* C */ -/* C Set the DONE flag. */ -/* C */ -/* DONE = DONE1 .AND. DONE2 .AND. DONE3 .AND. DONE4 */ - -/* END DO */ -/* C */ -/* C End the segments and move on to other things. */ -/* C */ -/* CALL SGWES ( HANDL1 ) */ -/* CALL SGWES ( HANDL2 ) */ -/* CALL SGWES ( HANDL3 ) */ -/* CALL SGWES ( HANDL4 ) */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* See the individual entry points for any restrictions thay may */ -/* have. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA calls with DAFGDA. */ -/* Removed DAFHLU calls; replaced ERRFN calls with ERRHAN. */ - -/* - SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */ - -/* Fixed an annoying little bug in the variable segments code */ -/* when ending a segment. Rather than storing an appropriate */ -/* offset from the beginning of the segment as the packet */ -/* address in the packet directory, the absolute address, the */ -/* DAF address, was stored. This bug has been fixed. */ - -/* See SGWES for the details of the changes. */ - -/* - SPICELIB Version 1.0.0, 03-APR-1995 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* generic segments sequential writer */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local parameters */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII character. */ - - -/* The number of reference values it takes to get a reference */ -/* directory value. */ - - -/* The length of a DAF internal filename. */ - - -/* The file table size. This needs to be the same as the file table */ -/* size in DAFAH. */ - - -/* Include the mnemonic values for the generic segment declarations */ -/* and the meta data information. */ - - -/* Local variables */ - -/* Variables with the name DUMMY* are used as place holders when */ -/* calling various subroutines. Their values are not used in any of */ -/* the entry points of this subroutine. */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - - -/* File table declarations. The file table is used to keep track of */ -/* the vital statistics for each of the generic segments being */ -/* written. */ - - -/* Saved values. */ - - -/* Save the file table. */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (descr) { - } - if (const__) { - } - if (pktsiz) { - } - if (pktdat) { - } - if (refdat) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_sgbwfs; - case 2: goto L_sgbwvs; - case 3: goto L_sgwfpk; - case 4: goto L_sgwvpk; - case 5: goto L_sgwes; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Signal an error if this routine is called directly. */ - - chkin_("SGSEQW", (ftnlen)6); - setmsg_("This routine should never be called directly. It exists as an u" - "mbrella routine to maintain all of the variables for the generic" - " segment sequential writing entry points.", (ftnlen)168); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("SGSEQW", (ftnlen)6); - return 0; -/* $Procedure SGBWFS ( Generic segements: Begin a fixed size segment. ) */ - -L_sgbwfs: -/* $ Abstract */ - -/* Begin writing a generic segment that will contain fixed size data */ -/* packets. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* DOUBLE PRECISION DESCR ( * ) */ -/* CHARACTER*(*) SEGID */ -/* INTEGER NCONST */ -/* DOUBLE PRECISION CONST ( * ) */ -/* INTEGER PKTSIZ */ -/* INTEGER IDXTYP */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with write access. */ -/* DESCR I Descriptor for a generic segment. */ -/* SEGID I Identifier for a generic segment. */ -/* NCONST I Number of constant values in a generic segment. */ -/* CONST I Array of constant values for a generic segment. */ -/* PKTSIZ I Size of the data packets. */ -/* IDXTYP I Index type for the reference values. */ - -/* $ Detailed_Input */ - -/* HANDLE Handle of a DAF file opened with write access. This is */ -/* the handle of the file in which a generic segment will */ -/* be written. */ - -/* DESCR Descriptor for a segment that is being written. This is */ -/* the packed form of the DAF double precision and integer */ -/* summaries which contain ND double precision numbers and */ -/* NI integers. */ - -/* SEGID Identifier for a segment that is being written. This is */ -/* a character string containing at most NC printing ASCII */ -/* characters where */ - -/* / ND + ( NI + 1 ) \ */ -/* NC = 8 * | ----------------- | */ -/* \ 2 / */ - -/* SEGID may be blank. */ - -/* NCONST The number of constant values to be placed in a segment. */ - -/* CONST An array of NCONST constant values for a segment. */ - -/* PKTSIZ Size of fixed size packets. The size of a packet */ -/* is the number of double precision numbers contained in */ -/* the data packet. */ - -/* IDXTYP Index type to use for the reference values. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two */ -/* values, a starting value, which will have an index */ -/* of 1, and a step size between reference values, */ -/* which are used to compute an index and a reference */ -/* value associated with a specified key value. See */ -/* the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference */ -/* value for each data packet. */ - -/* See the chapter on generic segments in the DAF required */ -/* or the include file 'sgparam.inc' for more details */ -/* about the index types that are available. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If this routine is called more than once for a particular file */ -/* and segment, the error SPICE(CALLEDOUTOFORDER) will be */ -/* signalled. */ - -/* 2) If the length of the segment identifier, SEGID, is greater than */ -/* NC, as determined from the ND and NI values for a particular */ -/* DAF file, the error SPICE(SEGIDTOOLONG) will be signalled. */ - -/* 3) If the segment identifier contains nonprinting characters, the */ -/* error SPICE(NONPRINTINGCHARS) will be signalled. */ - -/* 4) If the number of constant values, NCONST, is negative, the */ -/* error SPICE(NUMCONSTANTSNEG) will be signalled. */ - -/* 5) If the packet size, PKTSIZ, is not positive, the error */ -/* SPICE(NONPOSPACKETSIZE) will be signalled. */ - -/* 6) If the index type for the reference values is not recognized, */ -/* the error SPICE(UNKNOWNINDEXTYPE) will be signalled. */ - -/* 7) If the file table is full, the error SPICE(FILETABLEFULL) will */ -/* be signalled. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Particulars */ - -/* Begin writing a generic segment for fixed size data packets to */ -/* the DAF file associated with HANDLE. */ - -/* $ Examples */ - -/* See the $ Examples section in the header for the main subroutine. */ -/* It contains examples wich demonstrate the use of the entry points */ -/* in the generic segments sequential writer. The entry points which */ -/* comprise the generic segments sequential writer must be used */ -/* together in the proper manner. Rather than repeating the examples */ -/* for each entry point they are provided in a single location. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-APR-1995 (KRG) (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* begin writing a fixed packet size generic segment */ - -/* -& */ - -/* SPICELIB functions */ - -/* INTEGER LASTNB */ -/* INTEGER ISRCHI */ - -/* LOGICAL FAILED */ -/* LOGICAL RETURN */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGBWFS", (ftnlen)6); - -/* We need to do some sanity checks on our input arguments before we */ -/* should attempt to write anything to the file. So, let's start with */ -/* that. */ - -/* Check to see if the file attached to the handle is open for */ -/* writing. If not, an error is signalled. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - -/* Check to see if the handle is currently in the file table. If it */ -/* is, we've got a problem. This routine may only be called once for */ -/* each segment that is to contain fixed size packets, and it places */ -/* a handle in the file table. If the handle is currently in the */ -/* file table a segment has already been started by this routine or */ -/* SGBWVS. In either case, we cannot continue, so we signal an error. */ - - if (nft > 0) { - index = isrchi_(handle, &nft, fthan); - if (index != 0) { - setmsg_("A segment is already being written to the file '#'. A n" - "ew segment cannot be started for this file until the cur" - "rent segment is finished. ", (ftnlen)137); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(CALLEDOUTOFORDER)", (ftnlen)23); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - } - -/* Get the ND and NI values from the DAF file. We need these to know */ -/* the size of the descriptor and the length of the segment ID. The */ -/* length of the segment ID is determined by the following formula */ -/* using integer division: */ - -/* / ND + ( NI + 1 ) \ */ -/* NC = 8 * | ----------------- | */ -/* \ 2 / */ - - dafhsf_(handle, &nd, &ni); - if (failed_()) { - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - nc = nd + (ni + 1) / 2 << 3; - -/* Get the length of the segment ID. Leading blanks are considered to */ -/* be important. A blank segment ID is OK too. */ - - sidlen = lastnb_(segid, segid_len); - -/* Check the segment ID to see if it is OK. Its length must be less */ -/* than NC and it must consist of only printing ASCII characters. */ - - if (sidlen > nc) { - setmsg_("Segment identifier contains more than # characters.", ( - ftnlen)51); - errint_("#", &nc, (ftnlen)1); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - i__1 = sidlen; - for (i__ = 1; i__ <= i__1; ++i__) { - ich = *(unsigned char *)&segid[i__ - 1]; - if (ich < 32 || ich > 126) { - setmsg_("The segment identifier contains a nonprinting characte" - "r at location #.", (ftnlen)71); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NONPRINTINGCHARS)", (ftnlen)23); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - } - -/* Check to see if the number of constants is negative. This is all */ -/* we can do here, we cannot check the constant values. */ - - if (*nconst < 0) { - setmsg_("The number of constants specified was #. This number must b" - "e non-negative. Perhaps the variable was not properlyinitial" - "ized. ", (ftnlen)125); - errint_("#", nconst, (ftnlen)1); - sigerr_("SPICE(NUMCONSTANTSNEG) ", (ftnlen)23); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - -/* Check to see that the packet size is OK. It should be positive. */ - - if (pktsiz[0] <= 0) { - setmsg_("The size of the data packets must be positive. It was speci" - "fied as #. Perhaps the input variable was not properly initi" - "alized. ", (ftnlen)127); - errint_("#", pktsiz, (ftnlen)1); - sigerr_("SPICE(NONPOSPACKETSIZE)", (ftnlen)23); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - -/* Check to see if the index type is one that we recognize. */ - - if (*idxtyp < 0 || *idxtyp > 4) { - setmsg_("The index type specified was #. This is not a valid index " - "type. Valid types are in the range from # to #.", (ftnlen)106) - ; - errint_("#", idxtyp, (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - errint_("#", &c__4, (ftnlen)1); - sigerr_("SPICE(UNKNOWNINDEXTYPE)", (ftnlen)23); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - -/* Check to see whether we still have room in the file table. */ - - if (nft == 20) { - setmsg_("There are already # files being written by generic segment " - "writing routines. No more files may be written by the generi" - "c segment writers until one of those currently being written" - " is closed via a call to SGWES.", (ftnlen)210); - errint_("#", &nft, (ftnlen)1); - sigerr_("SPICE(FILETABLEFULL)", (ftnlen)20); - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - -/* Set the flag which indicate whether this index type is an */ -/* explicit type or an implicit type. */ - - explct = *idxtyp == 2 || *idxtyp == 3 || *idxtyp == 4; - -/* At this point, we know that the input data is OK, in so far as we */ -/* can validate it, and we have room in the file table. So we proceed */ -/* with starting a segment for fixed size packets. */ - -/* Set the flag that indicate that this segment is a fixed size */ -/* segment. */ - - fxdseg = TRUE_; - -/* Get the address for the beginning of the array that we are going */ -/* to create. We have to get this by reading the file record. */ - - dafrfr_(handle, &nd, &ni, dummy1, &dummy2, &dummy3, &begadr, (ftnlen)60); - -/* Begin a new segment in the DAF file. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - -/* Write out the constants to the new segment, if there are any */ -/* constants. */ - - if (*nconst > 0) { - dafada_(const__, nconst); - if (failed_()) { - chkout_("SGBWFS", (ftnlen)6); - return 0; - } - } - -/* Store the information for this file and segment in the file table. */ - - ++nft; - ftityp[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftityp", i__1, - "sgseqw_", (ftnlen)1781)] = *idxtyp; - ftpksz[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftpksz", i__1, - "sgseqw_", (ftnlen)1782)] = pktsiz[0]; - ftmxsz[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftmxsz", i__1, - "sgseqw_", (ftnlen)1783)] = 0; - ftncon[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftncon", i__1, - "sgseqw_", (ftnlen)1785)] = *nconst; - ftnpkt[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnpkt", i__1, - "sgseqw_", (ftnlen)1786)] = 0; - ftnref[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnref", i__1, - "sgseqw_", (ftnlen)1787)] = 0; - ftnres[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnres", i__1, - "sgseqw_", (ftnlen)1788)] = 0; - ftexpl[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftexpl", i__1, - "sgseqw_", (ftnlen)1790)] = explct; - ftfixd[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftfixd", i__1, - "sgseqw_", (ftnlen)1792)] = fxdseg; - fthan[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "sgseqw_", (ftnlen)1794)] = *handle; - ftbadr[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftbadr", i__1, - "sgseqw_", (ftnlen)1795)] = begadr; - ftrefs[(i__1 = (nft << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge("ftrefs", - i__1, "sgseqw_", (ftnlen)1797)] = 0.; - ftrefs[(i__1 = (nft << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge("ftrefs", - i__1, "sgseqw_", (ftnlen)1798)] = 0.; - if (explct) { - ftoff[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftoff", - i__1, "sgseqw_", (ftnlen)1801)] = 1; - } else { - ftoff[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftoff", - i__1, "sgseqw_", (ftnlen)1803)] = 0; - } - lsthan = *handle; - index = nft; - ++numfxd; - chkout_("SGBWFS", (ftnlen)6); - return 0; -/* $Procedure SGBWVS ( Generic segements: Begin a variable size segment. ) */ - -L_sgbwvs: -/* $ Abstract */ - -/* Begin writing a generic segment that will contain variable size */ -/* data packets. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* DOUBLE PRECISION DESCR ( * ) */ -/* CHARACTER*(*) SEGID */ -/* INTEGER NCONST */ -/* DOUBLE PRECISION CONST ( * ) */ -/* INTEGER IDXTYP */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with write access. */ -/* DESCR I Descriptor for a segment. */ -/* SEGID I Identifier for a segment. */ -/* NCONST I Number of constant values in a segment. */ -/* CONST I Array of constant values for a segment. */ -/* IDXTYP I Index type for the reference values. */ - -/* $ Detailed_Input */ - -/* HANDLE Handle of a DAF file opened with write access. This is */ -/* the handle of the file in which a generic segment will */ -/* be written. */ - -/* DESCR Descriptor for a segment that is being written. This is */ -/* the packed form of the DAF double precision and integer */ -/* summaries which contain ND double precision numbers and */ -/* NI integers. */ - -/* SEGID Identifier for a segment that is being written. This is */ -/* a character string containing at most NC printing ASCII */ -/* characters where */ - -/* / ND + ( NI + 1 ) \ */ -/* NC = 8 * | ----------------- | */ -/* \ 2 / */ - -/* SEGID may be blank. */ - -/* NCONST The number of constant values to be placed in a segment. */ - -/* CONST An array of NCONST constant values for a segment. */ - -/* IDXTYP Index type to use for the reference values. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two */ -/* values, a starting value, which will have an index */ -/* of 1, and a step size between reference values, */ -/* which are used to compute an index and a reference */ -/* value associated with a specified key value. See */ -/* the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference */ -/* value for each data packet. */ - -/* See the chapter on generic segments in the DAF required */ -/* or the include file 'sgparam.inc' for more details */ -/* about the index types that are available. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If this routine is called more than once for a particular file */ -/* and segment, the error SPICE(CALLEDOUTOFORDER) will be */ -/* signalled. */ - -/* 2) If the length of the segment identifier, SEGID, is greater than */ -/* NC, as determined from the ND and NI values for a particular */ -/* DAF file, the error SPICE(SEGIDTOOLONG) will be signalled. */ - -/* 3) If the segment identifier contains nonprinting characters, the */ -/* error SPICE(NONPRINTINGCHARS) will be signalled. */ - -/* 4) If the number of constant values, NCONST, is negative, the */ -/* error SPICE(NUMCONSTANTSNEG) will be signalled. */ - -/* 5) If the index type for the reference values is not recognized, */ -/* the error SPICE(UNKNOWNINDEXTYPE) will be signalled. */ - -/* 6) If the file table is full, the error SPICE(FILETABLEFULL) will */ -/* be signalled. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Particulars */ - -/* Begin writing a generic segment for variable size data packets to */ -/* the DAF file associated with HANDLE. */ - -/* $ Examples */ - -/* See the $ Examples section in the header for the main subroutine. */ -/* It contains examples wich demonstrate the use of the entry points */ -/* in the generic segments sequential writer. The entry points which */ -/* comprise the generic segments sequential writer must be used */ -/* together in the proper manner. Rather than repeating the examples */ -/* for each entry point they are provided in a single location. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-APR-1995 (KRG) (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* begin writing a variable packet size generic segment */ - -/* -& */ - -/* SPICELIB functions */ - -/* INTEGER LASTNB */ -/* INTEGER ISRCHI */ - -/* LOGICAL FAILED */ -/* LOGICAL RETURN */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGBWVS", (ftnlen)6); - -/* We need to do some sanity checks on our input arguments before we */ -/* should attempt to write anything to the file. So, let's start with */ -/* that. */ - -/* Check to see if the file attached to the handle is open for */ -/* writing. If not, an error is signalled. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - -/* Check to see if the handle is currently in the file table. If it */ -/* is, we've got a problem. This routine may only be called once for */ -/* each segment that is to contain variable size packets, and it */ -/* places a handle into the file table. If the handle is currently in */ -/* the file table a segment has already been started by this routine */ -/* or SGBWFS. In either case, we cannot continue, so we signal an */ -/* error. */ - - if (nft > 0) { - index = isrchi_(handle, &nft, fthan); - if (index != 0) { - setmsg_("A segment is already being written to the file '#'. A n" - "ew segment cannot be started for this file until the cur" - "rent segment is finished. ", (ftnlen)137); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(CALLEDOUTOFORDER)", (ftnlen)23); - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - } - -/* Get the ND and NI values from the DAF file. We need these to know */ -/* the size of the descriptor and the length of the segment ID. The */ -/* length of the segment ID is determined by the following formula */ -/* using integer division: */ - -/* / ND + ( NI + 1 ) \ */ -/* NC = 8 * | ----------------- | */ -/* \ 2 / */ - - dafhsf_(handle, &nd, &ni); - if (failed_()) { - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - nc = nd + (ni + 1) / 2 << 3; - -/* Get the length of the segment ID. Leading blanks are considered to */ -/* be important. A blank segment ID is OK too. */ - - sidlen = lastnb_(segid, segid_len); - -/* Check the segment ID to see if it is OK. Its length must be less */ -/* than NC and it must consist of only printing ASCII characters. */ - - if (sidlen > nc) { - setmsg_("Segment identifier contains more than # characters.", ( - ftnlen)51); - errint_("#", &nc, (ftnlen)1); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - i__1 = sidlen; - for (i__ = 1; i__ <= i__1; ++i__) { - ich = *(unsigned char *)&segid[i__ - 1]; - if (ich < 32 || ich > 126) { - setmsg_("The segment identifier contains a nonprinting characte" - "r at location #.", (ftnlen)71); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NONPRINTINGCHARS)", (ftnlen)23); - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - } - -/* Check to see if the number of constants is negative. This is all */ -/* we can do here, we cannot check the constant values. */ - - if (*nconst < 0) { - setmsg_("The number of constants specified was #. This number must b" - "e non-negative. Perhaps the variable was not initialized. ", ( - ftnlen)117); - errint_("#", nconst, (ftnlen)1); - sigerr_("SPICE(NUMCONSTANTSNEG) ", (ftnlen)23); - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - -/* Check to see if the index type is one that we recognize. */ - - if (*idxtyp < 0 || *idxtyp > 4) { - setmsg_("The index type specified was #. This is not a valid index " - "type. Valid types are in the range from # to #.", (ftnlen)106) - ; - errint_("#", idxtyp, (ftnlen)1); - errint_("#", &c__0, (ftnlen)1); - errint_("#", &c__4, (ftnlen)1); - sigerr_("SPICE(UNKNOWNINDEXTYPE)", (ftnlen)23); - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - -/* Check to see if there is room in the file table. */ - - if (nft == 20) { - setmsg_("There are already # files being written by generic segment " - "writing routines. No more files may be written by the generi" - "c segment writers until one of those currently being written" - " is closed via a call to SGWES. ", (ftnlen)211); - errint_("#", &nft, (ftnlen)1); - sigerr_("SPICE(FILETABLEFULL)", (ftnlen)20); - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - -/* Set the flag which indicate whether this index type is an */ -/* explicit type or an implicit type. */ - - explct = *idxtyp == 2 || *idxtyp == 3 || *idxtyp == 4; - -/* At this point, we know that the input data is OK, in so far as we */ -/* can validate it and that there is room in the file table. So we */ -/* proceed with starting a segment for fixed size packets. */ - -/* Set the flag that indicate that this segment is a variable size */ -/* segment. */ - - fxdseg = FALSE_; - -/* Get the address for the beginning of the array that we are going */ -/* to create. We have to get this by reading the file record. */ - - dafrfr_(handle, &nd, &ni, dummy1, &dummy2, &dummy3, &begadr, (ftnlen)60); - -/* Begin a new segment in the DAF file. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - -/* Write out the constants to the new segment, if there are any */ -/* constants. */ - - if (*nconst > 0) { - dafada_(const__, nconst); - if (failed_()) { - chkout_("SGBWVS", (ftnlen)6); - return 0; - } - } - -/* Save the information for this file and segment in the file table. */ - - ++nft; - ftityp[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftityp", i__1, - "sgseqw_", (ftnlen)2209)] = *idxtyp; - ftpksz[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftpksz", i__1, - "sgseqw_", (ftnlen)2210)] = 0; - ftmxsz[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftmxsz", i__1, - "sgseqw_", (ftnlen)2211)] = 0; - ftncon[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftncon", i__1, - "sgseqw_", (ftnlen)2213)] = *nconst; - ftnpkt[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnpkt", i__1, - "sgseqw_", (ftnlen)2214)] = 0; - ftnref[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnref", i__1, - "sgseqw_", (ftnlen)2215)] = 0; - ftnres[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnres", i__1, - "sgseqw_", (ftnlen)2216)] = 0; - ftexpl[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftexpl", i__1, - "sgseqw_", (ftnlen)2218)] = explct; - ftfixd[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftfixd", i__1, - "sgseqw_", (ftnlen)2220)] = fxdseg; - fthan[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "sgseqw_", (ftnlen)2222)] = *handle; - ftbadr[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftbadr", i__1, - "sgseqw_", (ftnlen)2223)] = begadr; - ftrefs[(i__1 = (nft << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge("ftrefs", - i__1, "sgseqw_", (ftnlen)2225)] = 0.; - ftrefs[(i__1 = (nft << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge("ftrefs", - i__1, "sgseqw_", (ftnlen)2226)] = 0.; - if (explct) { - ftoff[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftoff", - i__1, "sgseqw_", (ftnlen)2229)] = 2; - } else { - ftoff[(i__1 = nft - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftoff", - i__1, "sgseqw_", (ftnlen)2231)] = 1; - } - lsthan = *handle; - index = nft; - ++numvar; - chkout_("SGBWVS", (ftnlen)6); - return 0; -/* $Procedure SGWFPK ( Generic segements: Write fixed size packets. ) */ - -L_sgwfpk: -/* $ Abstract */ - -/* Write one or more fixed size data packets to the generic segment */ -/* currently being written to the DAF file associated with HANDLE. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER NPKTS */ -/* DOUBLE PRECISION PKTDAT ( * ) */ -/* INTEGER NREFS */ -/* DOUBLE PRECISION REFDAT ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with write access. */ -/* NPKTS I Number of data packets to write to a segment. */ -/* PKTDAT I Array of packet data. */ -/* NREFS I Number of reference values. */ -/* REFDAT I Reference data. */ - -/* $ Detailed_Input */ - -/* HANDLE Handle of a DAF file opened with write access. This is */ -/* the handle of a file in which a generic segment has */ -/* been started and is currently being written. */ - -/* NPKTS Number of data packets to write to a segment. */ - -/* PKTDAT A singly dimensioned array containing the fixed size */ -/* data packets to be added to the segment associated with */ -/* HANDLE. */ - -/* For fixed size data packets, PKTDAT will have the */ -/* following structure: */ - -/* Packet # Range of Locations */ -/* -------- --------------------------------------------- */ - -/* 1 PKTDAT(1) to PKTDAT(PS) */ -/* 2 PKTDAT(PS+1) to PKTDAT(2*PS) */ -/* 3 PKTDAT(2*PS+1) to PKTDAT(3*PS) */ -/* 4 PKTDAT(3*PS+1) to PKTDAT(4*PS) */ - -/* . */ -/* . */ -/* . */ - -/* NPKTS PKTDAT((NPKTS-1)*PS+1) to PKTDAT(NPKTS*PS) */ - -/* where PS = PKTSIZ. */ - -/* NREFS Number of reference values. */ - -/* For implicitly indexed packets, NREFS must have a value */ -/* of two (2). */ - -/* When writing packets to a segment which uses an implicit */ -/* index type, the value specified by NREFS is used only on */ -/* the first call to SGWFPK. On all subsequent calls to */ -/* these subroutines for a particular implicitly indexed */ -/* segment, the value of NREFS is ignored. */ - -/* For explicitly indexed packets, NREFS must be equal to */ -/* NPKTS, i.e., there should ba a reference value for each */ -/* data packet being written to the segment. */ - -/* When writing packets to a segment which uses an explicit */ -/* index type, the value specified by NREFS is used on */ -/* every call to SGWFPK and it must be equal to NPKTS. */ - -/* REFDAT Reference data values. */ - -/* For implicitly indexed packets, there must be two (2) */ -/* values. The reference values represent a starting */ -/* reference value and a stepsize between consecutive */ -/* reference values, respectively. */ - -/* In order to avoid, or at least minimize, numerical */ -/* difficulties associated with computing index values for */ -/* generic segments with implicit index types, the value of */ -/* the stepsize must be an integer, i.e., DINT(REFDAT(2)) */ -/* must equal REFDAT(2). */ - -/* When writing packets to a segment which uses an implicit */ -/* index type, the values specified by REFDAT are used only */ -/* on the first call to SGWFPK. On all subsequent calls to */ -/* this subroutine for a particular implicitly indexed */ -/* segment, REFDAT is ignored. */ - -/* For explicitly indexed packets, there must be NPKTS */ -/* referencevalues and the values must be in increasing */ -/* order: */ - -/* REFDAT(I) < REFDAT(I+1), I = 1, NPKTS-1 */ - -/* When writing packets to a segment which uses an explicit */ -/* index type, the values specified by REFDAT are used on */ -/* every call to SGWFPK. On all calls to these subroutines */ -/* after the first, the value of REFDAT(1) must be greater */ -/* than than the value of REFDAT(NPKTS) from the previous */ -/* call. This preserves the ordering of the reference */ -/* values for the entire segment. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If there are no generic segments with fixed packet sizes */ -/* currently being written, the error SPICE(CALLEDOUTOFORDER) will */ -/* be signalled. */ - -/* 2) If there is not a generic segment with fixed packet size being */ -/* written to the file associated with HANDLE, the error */ -/* SPICE(SEGMENTNOTFOUND) will be signalled. */ - -/* 3) If the type of generic segment being written to this file is */ -/* not a fixed packet size generic segment, the error */ -/* SPICE(SEGTYPECONFLICT) will be signalled. */ - -/* 4) If the number of packets to be written to the generic segment */ -/* is not positive, the error SPICE(NUMPACKETSNOTPOS) will be */ -/* signalled. */ - -/* 5) If an explicitly indexed generic segment is being written and */ -/* the number of reference values, NREFS, is not equal to the */ -/* number of data packets being written, NPKTS, the error */ -/* SPICE(INCOMPATIBLENUMREF) will be signalled. */ - -/* 6) If an explicitly indexed generic segment is being written and */ -/* the reference values are not in increasing order, the error */ -/* SPICE(UNORDEREDREFS) will be signalled. */ - -/* 7) If an explicitly indexed generic segment is being written and */ -/* the first reference value on the second or later additions */ -/* of packets to the generic segment is not greater than the last */ -/* reference value from the previous addition of packets, the */ -/* error SPICE(UNORDEREDREFS) will be signalled. */ - -/* 8) If an implicitly indexed generic segment is being written and */ -/* the number of reference values, NREFS, is not equal to two (2) */ -/* on the first call to this subroutine for a particular segment, */ -/* then the error SPICE(INCOMPATIBLENUMREF) will be signalled. */ - -/* 9) If an implicitly indexed generic segment is being written and */ -/* the second reference value, the step size used for indexing, is */ -/* not integral, i.e., DINT(REFDAT(2)) .NE. REFDAT(2), the error */ -/* SPICE(REFVALNOTINTEGER) will be signalled. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine will write one or more fixed size data packets to a */ -/* generic segment in the DAF file associated with HANDLE. The */ -/* generic segment must have been started by a call to SGBWFS. */ - -/* $ Examples */ - -/* See the $ Examples section in the header for the main subroutine. */ -/* It contains examples wich demonstrate the use of the entry points */ -/* in the generic segments sequential writer. The entry points which */ -/* comprise the generic segments sequential writer must be used */ -/* together in the proper manner. Rather than repeating the examples */ -/* for each entry point they are provided in a single location. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-APR-1995 (KRG) (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* write fixed size packets to a generic segment */ - -/* -& */ - -/* SPICELIB functions */ - -/* INTEGER LASTNB */ -/* INTEGER ISRCHI */ - -/* LOGICAL FAILED */ -/* LOGICAL RETURN */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGWFPK", (ftnlen)6); - -/* Check to see if this is the first time here. If it is, we have */ -/* been called out of order, so signal an error. */ - - if (numfxd == 0) { - setmsg_("No segment with fixed size packets is currently being writt" - "en. This routine has been called out of order. The routine S" - "GBWFS must be called before his routine may be called.", ( - ftnlen)173); - sigerr_("SPICE(CALLEDOUTOFORDER)", (ftnlen)23); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - -/* Check to see if the last handle used is the same as the current */ -/* handle. This saves us a table lookup to get the appropriate index */ -/* into the file table to restore the information for that handle. */ - - if (*handle != lsthan) { - index = isrchi_(handle, &nft, fthan); - if (index == 0) { - setmsg_("No segment with fixed size packets is associated with t" - "he file '#'. In order to write fixed size packets to a f" - "ile the routine SGBWFS must be called to begin the segme" - "nt.", (ftnlen)170); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(SEGMENTNOTFOUND)", (ftnlen)22); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - explct = ftexpl[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftexpl", i__1, "sgseqw_", (ftnlen)2539)]; - fxdseg = ftfixd[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftfixd", i__1, "sgseqw_", (ftnlen)2540)]; - lsthan = *handle; - dafcad_(handle); - if (failed_()) { - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - } - -/* Check to see if the segment being written is a fixed size packet */ -/* segment or a variable size packet segment. If the latter, then */ -/* this is the wrong routine. */ - - if (! fxdseg) { - setmsg_("The segment being written to the file '#' is a variable pa" - "cket size segment, not a fixed packet size segment. The rou" - "tine SGWVPK may be used to write variable size packets.", ( - ftnlen)174); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(SEGTYPECONFLICT)", (ftnlen)22); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - -/* At this point, we have a good file handle, an index into the file */ -/* table, and we know that we are working with a fixed packet size */ -/* segment. So, what we need to do now is verify the input arguments. */ - -/* Check the number of packets to be sure that it is positive. */ - - if (*npkts <= 0) { - setmsg_("The number of packets to store is not positive. The value " - "supplied was #. Perhaps this packet count was unitialized.", ( - ftnlen)117); - errint_("#", npkts, (ftnlen)1); - sigerr_("SPICE(NUMPACKETSNOTPOS)", (ftnlen)23); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - -/* Now we get to some of the more interesting bits. We now need to */ -/* differentiate between the explicitly indexed types and the */ -/* implicitly indexed types, because they have different */ -/* characteristics and assumptions about how they are stored. */ - - if (explct) { - -/* For explicitly indexed packets the number of reference values */ -/* must be equal to the number of packets. The references must */ -/* also be in increasing order. */ - - if (*nrefs != *npkts) { - setmsg_("The number of reference values supplied, #, is not comp" - "atible with explicitly indexed packets. Explicitly index" - "ed packets require the number of reference values to equ" - "al the number of packets, in this case, #.", (ftnlen)209); - errint_("#", nrefs, (ftnlen)1); - errint_("#", npkts, (ftnlen)1); - sigerr_("SPICE(INCOMPATIBLENUMREF)", (ftnlen)25); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - -/* If this is not the first time we have asdded data to this */ -/* segment, we need to be sure that all of the current reference */ -/* values are greater then the last reference value from the */ -/* previous addition of packets to the segment. */ - - if (ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "pkt", i__1, "sgseqw_", (ftnlen)2622)] > 0) { - if (ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= i__1 ? i__1 : - s_rnge("ftrefs", i__1, "sgseqw_", (ftnlen)2624)] >= - refdat[0]) { - setmsg_("Reference values are out of order. The offending va" - "lue, #, was found to be out of order. The reference " - "values for explicitly indexed packets must be in inc" - "reasing order, and the first reference value is less" - " than or equal to the last reference value, #, from " - "the previous addition of packets.", (ftnlen)292); - errdp_("#", refdat, (ftnlen)1); - errdp_("#", &ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= - i__1 ? i__1 : s_rnge("ftrefs", i__1, "sgseqw_", ( - ftnlen)2635)], (ftnlen)1); - sigerr_("SPICE(UNORDEREDREFS)", (ftnlen)20); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - } - i__1 = *nrefs; - for (i__ = 2; i__ <= i__1; ++i__) { - if (refdat[i__ - 2] >= refdat[i__ - 1]) { - setmsg_("Reference values are out of order. The offending va" - "lue, #, was found to be out of order for index #. Th" - "e reference values for explicitly indexed packets mu" - "st be in increasing order.", (ftnlen)181); - errdp_("#", &refdat[i__ - 2], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - sigerr_("SPICE(UNORDEREDREFS)", (ftnlen)20); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - } - -/* Add the packets preceded by their reference values to the */ -/* segment. We put the reference values with the packets so that */ -/* we do not need to open a scratch file. We will use them to */ -/* construct a reference directory after all of the packets have */ -/* been added to the segment. */ - - i__1 = *npkts; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&refdat[i__ - 1], &c__1); - dafada_(&pktdat[(i__ - 1) * ftpksz[(i__2 = index - 1) < 20 && 0 <= - i__2 ? i__2 : s_rnge("ftpksz", i__2, "sgseqw_", (ftnlen) - 2673)]], &ftpksz[(i__3 = index - 1) < 20 && 0 <= i__3 ? - i__3 : s_rnge("ftpksz", i__3, "sgseqw_", (ftnlen)2673)]); - if (failed_()) { - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - } - -/* Save the last reference value in the file table so that we */ -/* can use it to verify that the next addition does not violate */ -/* the increasing order of the reference values. */ - - ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "ftrefs", i__1, "sgseqw_", (ftnlen)2687)] = refdat[*nrefs - 1] - ; - -/* Update the counts for the number of packets, the number of */ -/* references. */ - - ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnpkt", - i__1, "sgseqw_", (ftnlen)2692)] = ftnpkt[(i__2 = index - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("ftnpkt", i__2, "sgseqw_", ( - ftnlen)2692)] + *npkts; - ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnref", - i__1, "sgseqw_", (ftnlen)2693)] = ftnref[(i__2 = index - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("ftnref", i__2, "sgseqw_", ( - ftnlen)2693)] + *nrefs; - } else { - -/* For implicitly indexed packets the number of reference values */ -/* must be two (2), and the second reference value must be an */ -/* integer, i.e., DINT(REFDAT(2)) .eq. REFDAT(2). The number of */ -/* reference values and the integrality of the second reference */ -/* value are checked only on the first call to add variable length */ -/* data packets to a generic segment. In all subsequent calls, */ -/* these arguments are ignored. */ - - if (ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "pkt", i__1, "sgseqw_", (ftnlen)2706)] == 0) { - if (*nrefs != 2) { - setmsg_("The number of reference values supplied, #, is not " - "compatible with implicitly indexed packets. Implicit" - "ly indexed packets require the number of reference v" - "alues to be two (2).", (ftnlen)175); - errint_("#", nrefs, (ftnlen)1); - sigerr_("SPICE(INCOMPATIBLENUMREF)", (ftnlen)25); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - if (d_int(&refdat[1]) != refdat[1]) { - setmsg_("For implicitly indexed packets the step size must b" - "e an integer.", (ftnlen)64); - sigerr_("SPICE(REFVALNOTINTEGER)", (ftnlen)23); - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - } - -/* Add the packets to the segment. */ - - i__2 = ftpksz[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftpksz", i__1, "sgseqw_", (ftnlen)2736)] * *npkts; - dafada_(pktdat, &i__2); - if (failed_()) { - chkout_("SGWFPK", (ftnlen)6); - return 0; - } - -/* Save the last reference values and the number of reference */ -/* values in the file table. We only do this on the first time */ -/* through the routine. */ - - if (ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "pkt", i__1, "sgseqw_", (ftnlen)2747)] == 0) { - ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "ref", i__1, "sgseqw_", (ftnlen)2749)] = *nrefs; - ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= i__1 ? i__1 : - s_rnge("ftrefs", i__1, "sgseqw_", (ftnlen)2750)] = refdat[ - 0]; - ftrefs[(i__1 = (index << 1) - 1) < 40 && 0 <= i__1 ? i__1 : - s_rnge("ftrefs", i__1, "sgseqw_", (ftnlen)2751)] = refdat[ - 1]; - } - -/* Update the count for the number of packets. */ - - ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnpkt", - i__1, "sgseqw_", (ftnlen)2757)] = ftnpkt[(i__2 = index - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("ftnpkt", i__2, "sgseqw_", ( - ftnlen)2757)] + *npkts; - } - chkout_("SGWFPK", (ftnlen)6); - return 0; -/* $Procedure SGWVPK ( Generic segement: Write variable size packets. ) */ - -L_sgwvpk: -/* $ Abstract */ - -/* Write one or more variable size data packets to the generic */ -/* segment currently being written to the DAF file associated with */ -/* HANDLE. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER NPKTS */ -/* INTEGER PKTSIZ ( * ) */ -/* DOUBLE PRECISION PKTDAT ( * ) */ -/* INTEGER NREFS */ -/* DOUBLE PRECISION REFDAT ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with write access. */ -/* NPKTS I Number of data packets to write to a segment. */ -/* PKTSIZ I Array of sizes of variable size packets. */ -/* PKTDAT I Array of packet data. */ -/* NREFS I Number of reference values. */ -/* REFDAT I Reference data. */ - -/* $ Detailed_Input */ - -/* HANDLE Handle of a DAF file opened with write access. This is */ -/* the handle of a file in which a generic segment has */ -/* been started and is currently being written. */ - -/* NPKTS Number of data packets to write to a segment. */ - -/* PKTSIZ Sizes of variable size packets. */ - -/* By the size of a packet we mean the number of double */ -/* precision numbers contained in a data packet. */ - -/* When writing a segment with variable size packets, */ -/* there must be an element in the array PKTSIZ for each of */ -/* the variable size data packets. */ - -/* PKTDAT A singly dimensioned array containing the variable */ -/* size data packets to be added to the generic segment */ -/* associated with HANDLE. */ - -/* For variable size data packets, PKTDAT will have the */ -/* following structure: */ - -/* Packet # Range of Locations */ -/* -------- --------------------------------------------- */ - -/* 1 PKTDAT(1) to PKTDAT(P(1)) */ -/* 2 PKTDAT(P(1)+1) to PKTDAT(P(2)) */ -/* 3 PKTDAT(P(2)+1) to PKTDAT(P(3)) */ -/* 4 PKTDAT(P(3)+1) to PKTDAT(P(4)) */ - -/* . */ -/* . */ -/* . */ - -/* NPKTS PKTDAT(P(NPKTS-1)+1) to PKTDAT(P(NPKTS)) */ - -/* I */ -/* --- */ -/* where P(I) = > PKTSIZ(K). */ -/* --- */ -/* K = 1 */ - -/* NREFS Number of reference values. */ - -/* For implicitly indexed packets, NREFS must have a value */ -/* of two (2). */ - -/* When writing packets to a segment which uses an implicit */ -/* index type, the value specified by NREFS is used only on */ -/* the first call to SGWVPK. On all subsequent calls to */ -/* these subroutines for a particular implicitly indexed */ -/* segment, the value of NREFS is ignored. */ - -/* For explicitly indexed packets, NREFS must be equal to */ -/* NPKTS, i.e., there should be a reference value for each */ -/* data packet being written to the segment. */ - -/* When writing packets to a segment which uses an explicit */ -/* index type, the value specified by NREFS is used on */ -/* every call to SGWVPK and it must be equal to NPKTS. */ - -/* REFDAT Reference data values. */ - -/* For implicitly indexed packets, there must be two (2) */ -/* values. The reference values represent a starting */ -/* reference value and a stepsize between consecutive */ -/* reference values, respectively. */ - -/* In order to avoid, or at least minimize, numerical */ -/* difficulties associated with computing index values for */ -/* generic segments with implicit index types, the value of */ -/* the stepsize must be an integer, i.e., DINT(REFDAT(2)) */ -/* must equal REFDAT(2). */ - -/* When writing packets to a segment which uses an implicit */ -/* index type, the values specified by REFDAT are used only */ -/* on the first call to SGWVPK. On all subsequent calls to */ -/* this subroutine for a particular implicitly indexed */ -/* segment, REFDAT is ignored. */ - -/* For explicitly indexed packets, there must be NPKTS */ -/* reference values and the values must be in increasing */ -/* order: */ - -/* REFDAT(I) < REFDAT(I+1), I = 1, NPKTS-1 */ - -/* When writing packets to a segment which uses an explicit */ -/* index type, the values specified by REFDAT are used on */ -/* every call to SGWVPK. On all calls to this subroutine */ -/* after the first, the value of REFDAT(1) must be greater */ -/* than than the value of REFDAT(NPKTS) from the previous */ -/* call. This preserves the ordering of the reference */ -/* values for the entire segment. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If there are no generic segments with variable packet sizes */ -/* currently being written, the error SPICE(CALLEDOUTOFORDER) will */ -/* be signalled. */ - -/* 2) If there is not a generic segment with variable packet size */ -/* being written to the file associated with HANDLE, the error */ -/* SPICE(SEGMENTNOTFOUND) will be signalled. */ - -/* 3) If the type of generic segment being written to this file is */ -/* not a variable packet size generic segment, the error */ -/* SPICE(SEGTYPECONFLICT) will be signalled. */ - -/* 4) If the number of packets to be written to the generic segment */ -/* is not positive, the error SPICE(NUMPACKETSNOTPOS) will be */ -/* signalled. */ - -/* 5) If an explicitly indexed generic segment is being written and */ -/* the number of reference values, NREFS, is not equal to the */ -/* number of data packets being written, NPKTS, the error */ -/* SPICE(INCOMPATIBLENUMREF) will be signalled. */ - -/* 6) If an explicitly indexed generic segment is being written and */ -/* the reference values are not in increasing order, the error */ -/* SPICE(UNORDEREDREFS) will be signalled. */ - -/* 7) If an explicitly indexed generic segment is being written and */ -/* the first reference value on the second or later additions */ -/* of packets to the generic segment is not greater than the last */ -/* reference value from the previous addition of packets, the */ -/* error SPICE(UNORDEREDREFS) will be signalled. */ - -/* 8) If an explicitly indexed generic segment is being written and */ -/* one or more of the packet sizes is not positive, the error */ -/* SPICE(NONPOSPACKETSIZE) will be signalled. */ - -/* 9) If an implicitly indexed generic segment is being written and */ -/* the number of reference values, NREFS, is not equal to two (2) */ -/* on the first call to this subroutine for a particular segment, */ -/* then the error SPICE(INCOMPATIBLENUMREF) will be signalled. */ - -/* 10) If an implicitly indexed generic segment is being written and */ -/* the second reference value, the step size used for indexing, is */ -/* not integral, i.e., DINT(REFDAT(2)) .NE. REFDAT(2), the error */ -/* SPICE(REFVALNOTINTEGER) will be signalled. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine will write one or more variable size data packets to */ -/* a generic segment in the DAF file associated with HANDLE. The */ -/* generic segment must have been started by a call to SGBWVS. */ - -/* $ Examples */ - -/* See the $ Examples section in the header for the main subroutine. */ -/* It contains examples wich demonstrate the use of the entry points */ -/* in the generic segments sequential writer. The entry points which */ -/* comprise the generic segments sequential writer must be used */ -/* together in the proper manner. Rather than repeating the examples */ -/* for each entry point they are provided in a single location. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-APR-1995 (KRG) (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* write variable size packets to a generic segment */ - -/* -& */ - -/* SPICELIB functions */ - -/* INTEGER LASTNB */ -/* INTEGER ISRCHI */ - -/* LOGICAL FAILED */ -/* LOGICAL RETURN */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGWVPK", (ftnlen)6); - -/* Check to see if this is the first time here. If it is, we have */ -/* been called out of order, so signal an error. */ - - if (numvar == 0) { - setmsg_("No segment with variable size packets is currently being wr" - "itten. This routine has been called out of order. The routin" - "e SGBWVS must be called before his routine may be called.", ( - ftnlen)176); - sigerr_("SPICE(CALLEDOUTOFORDER)", (ftnlen)23); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - -/* Check to see if the last handle used is the same as the current */ -/* handle. This saves us a table lookup to get the appropriate index */ -/* into the file table to restore the information for that handle. */ - - if (*handle != lsthan) { - index = isrchi_(handle, &nft, fthan); - if (index == 0) { - setmsg_("No segment with variable size packets is associated wit" - "h the file '#'. In order to write variable size packets " - "to a file the routine SGBWVS must be called to begin the" - " segment.", (ftnlen)176); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(SEGMENTNOTFOUND)", (ftnlen)22); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - explct = ftexpl[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftexpl", i__1, "sgseqw_", (ftnlen)3082)]; - fxdseg = ftfixd[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftfixd", i__1, "sgseqw_", (ftnlen)3083)]; - lsthan = *handle; - dafcad_(handle); - if (failed_()) { - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - } - -/* Check to see if the segment being written is a fixed size packet */ -/* segment or a variable size packet segment. If the former, then */ -/* this is the wrong routine. */ - - if (fxdseg) { - setmsg_("The segment being written to the file '#' is a fixed packe" - "t size segment, not a variable packet size segment. The rou" - "tine SGWFPK may be used to write fixed size packets.", ( - ftnlen)171); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(SEGTYPECONFLICT)", (ftnlen)22); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - -/* At this point, we have a good file handle, an index into the file */ -/* table, and we know that we are working with a variable packet */ -/* size segment. So, what we need to do now is verify the input */ -/* arguments. */ - -/* Check the number of packets to be sure that it is positive. */ - - if (*npkts <= 0) { - setmsg_("The number of packets to store is not positive. The value " - "supplied was #. Perhaps this packet count was unitialized.", ( - ftnlen)117); - errint_("#", npkts, (ftnlen)1); - sigerr_("SPICE(NUMPACKETSNOTPOS)", (ftnlen)23); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - -/* Now we get to some of the more interesting bits. We now need to */ -/* differentiate between the explicitly indexed types and the */ -/* implicitly indexed types, because they have different */ -/* characteristics and assumptions about how they are stored. */ - - if (explct) { - -/* For explicitly indexed packets the number of reference values */ -/* must be equal to the number of packets. The references must */ -/* also be in increasing order. */ - - if (*nrefs != *npkts) { - setmsg_("The number of reference values supplied, #, is not comp" - "atible with explicitly indexed packets. Explicitly index" - "ed packets require the number of reference values to equ" - "al the number of packets, in this case, #.", (ftnlen)209); - errint_("#", nrefs, (ftnlen)1); - errint_("#", npkts, (ftnlen)1); - sigerr_("SPICE(INCOMPATIBLENUMREF)", (ftnlen)25); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - -/* If this is not the first time we have added data to this */ -/* segment, we need to be sure that all of the current reference */ -/* values are greater then the last reference value from the */ -/* provious addition of packets to the segment. */ - - if (ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "pkt", i__1, "sgseqw_", (ftnlen)3166)] > 0) { - if (ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= i__1 ? i__1 : - s_rnge("ftrefs", i__1, "sgseqw_", (ftnlen)3168)] >= - refdat[0]) { - setmsg_("Reference values are out of order. The offending va" - "lue, #, was found The reference values for explicitl" - "y to be out of order. indexed packets must be in inc" - "reasing order, and the first reference value is less" - " than or equal to the last reference value, #, from " - "the previous addition of packets.", (ftnlen)292); - errdp_("#", refdat, (ftnlen)1); - errdp_("#", &ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= - i__1 ? i__1 : s_rnge("ftrefs", i__1, "sgseqw_", ( - ftnlen)3179)], (ftnlen)1); - sigerr_("SPICE(UNORDEREDREFS)", (ftnlen)20); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - } - i__1 = *nrefs; - for (i__ = 2; i__ <= i__1; ++i__) { - if (refdat[i__ - 2] >= refdat[i__ - 1]) { - setmsg_("Reference values are out of order. The offending va" - "lue, #, was found to be out of order for index #. Th" - "e reference values for explicitly indexed packets mu" - "st be in increasing order.", (ftnlen)181); - errdp_("#", &refdat[i__ - 2], (ftnlen)1); - i__2 = i__ - 1; - errint_("#", &i__2, (ftnlen)1); - sigerr_("SPICE(UNORDEREDREFS)", (ftnlen)20); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - } - -/* Check the packet size to be sure that it is positive. */ - - i__1 = *npkts; - for (i__ = 1; i__ <= i__1; ++i__) { - if (pktsiz[i__ - 1] <= 0) { - setmsg_("The packet size for packet # was not positive. It h" - "ad a value of #. All packet sizes must be greater th" - "en zero.", (ftnlen)111); - errint_("#", &i__, (ftnlen)1); - errint_("#", &pktsiz[i__ - 1], (ftnlen)1); - sigerr_("SPICE(NONPOSPACKETSIZE)", (ftnlen)23); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - } - -/* Add the packets preceded by their reference values and sizes to */ -/* the segment. We put the reference values with the packets so */ -/* that we do not need to open a scratch file. We will use them to */ -/* construct a reference directory after all of the packets have */ -/* been added to the segment. */ - - pktpos = 1; - i__1 = *npkts; - for (i__ = 1; i__ <= i__1; ++i__) { - dpksiz = (doublereal) pktsiz[i__ - 1]; - dafada_(&refdat[i__ - 1], &c__1); - dafada_(&dpksiz, &c__1); - dafada_(&pktdat[pktpos - 1], &pktsiz[i__ - 1]); - if (failed_()) { - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - pktpos += pktsiz[i__ - 1]; - ftpksz[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftp" - "ksz", i__2, "sgseqw_", (ftnlen)3250)] = ftpksz[(i__3 = - index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftpksz", - i__3, "sgseqw_", (ftnlen)3250)] + pktsiz[i__ - 1]; - -/* Remember the maximum packet size encountered. */ - - if (pktsiz[i__ - 1] > ftmxsz[(i__2 = index - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("ftmxsz", i__2, "sgseqw_", (ftnlen)3254)]) - { - ftmxsz[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "ftmxsz", i__2, "sgseqw_", (ftnlen)3256)] = pktsiz[ - i__ - 1]; - } - } - -/* Save the last reference value in the file table so that we */ -/* can use it to verify that the next addition does not violate */ -/* the increasing order of the reference values. */ - - ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "ftrefs", i__1, "sgseqw_", (ftnlen)3266)] = refdat[*nrefs - 1] - ; - -/* Update the counts for the number of packets, the number of */ -/* references. */ - - ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnpkt", - i__1, "sgseqw_", (ftnlen)3271)] = ftnpkt[(i__2 = index - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("ftnpkt", i__2, "sgseqw_", ( - ftnlen)3271)] + *npkts; - ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnref", - i__1, "sgseqw_", (ftnlen)3272)] = ftnref[(i__2 = index - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("ftnref", i__2, "sgseqw_", ( - ftnlen)3272)] + *nrefs; - } else { - -/* For implicitly indexed packets the number of reference values */ -/* must be two (2), and the second reference value must be an */ -/* integer, i.e., DINT(REFDAT(2)) .eq. REFDAT(2). The number of */ -/* reference values and the integrality of the second reference */ -/* value are checked only on the first call to add variable length */ -/* data packets to a generic segment. In all subsequent calls, */ -/* these arguments are ignored. */ - - if (ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "pkt", i__1, "sgseqw_", (ftnlen)3284)] == 0) { - if (*nrefs != 2) { - setmsg_("The number of reference values supplied, #, is not " - "compatible with implicitly indexed packets. Implicit" - "ly indexed packets require the number of reference v" - "alues to be two (2).", (ftnlen)175); - errint_("#", nrefs, (ftnlen)1); - sigerr_("SPICE(INCOMPATIBLENUMREF)", (ftnlen)25); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - if (d_int(&refdat[1]) != refdat[1]) { - setmsg_("For implicitly indexed packets the step size must b" - "e an integer.", (ftnlen)64); - sigerr_("SPICE(REFVALNOTINTEGER)", (ftnlen)23); - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - } - -/* Add the packets to the segment preceded by the size of the */ -/* packet. */ - - pktpos = 1; - i__1 = *npkts; - for (i__ = 1; i__ <= i__1; ++i__) { - dpksiz = (doublereal) pktsiz[i__ - 1]; - dafada_(&dpksiz, &c__1); - dafada_(&pktdat[pktpos - 1], &pktsiz[i__ - 1]); - if (failed_()) { - chkout_("SGWVPK", (ftnlen)6); - return 0; - } - pktpos += pktsiz[i__ - 1]; - ftpksz[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftp" - "ksz", i__2, "sgseqw_", (ftnlen)3331)] = ftpksz[(i__3 = - index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftpksz", - i__3, "sgseqw_", (ftnlen)3331)] + pktsiz[i__ - 1]; - } - -/* Save the reference values and the number of reference values */ -/* in the file table. We only do this on the first time through */ -/* the routine. */ - - if (ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "pkt", i__1, "sgseqw_", (ftnlen)3339)] == 0) { - ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftn" - "ref", i__1, "sgseqw_", (ftnlen)3341)] = *nrefs; - ftrefs[(i__1 = (index << 1) - 2) < 40 && 0 <= i__1 ? i__1 : - s_rnge("ftrefs", i__1, "sgseqw_", (ftnlen)3342)] = refdat[ - 0]; - ftrefs[(i__1 = (index << 1) - 1) < 40 && 0 <= i__1 ? i__1 : - s_rnge("ftrefs", i__1, "sgseqw_", (ftnlen)3343)] = refdat[ - 1]; - } - -/* Update the counts for the number of packets. */ - - ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftnpkt", - i__1, "sgseqw_", (ftnlen)3349)] = ftnpkt[(i__2 = index - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("ftnpkt", i__2, "sgseqw_", ( - ftnlen)3349)] + *npkts; - } - chkout_("SGWVPK", (ftnlen)6); - return 0; -/* $Procedure SGWES ( Generic segements: End a segment. ) */ - -L_sgwes: -/* $ Abstract */ - -/* End the generic segment in the DAF file associated with HANDLE. */ - -/* $ 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 */ - -/* DAF Required Reading. */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with write access. */ - -/* $ Detailed_Input */ - -/* HANDLE Handle of a DAF file opened with write access. This is */ -/* the handle of the file which contains the generic */ -/* segment that we wish to end. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Exceptions */ - -/* 1) If there are no generic segments currently being written, the */ -/* error SPICE(CALLEDOUTOFORDER) will be signalled. */ - -/* 2) If there is no generic segment being written to the file */ -/* associated with HANDLE, the error SPICE(SEGMENTNOTFOUND) will */ -/* be signalled. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine will end the generic segment started by a call to */ -/* either SGBWFS or SGBWVS that is currently being written to the DAF */ -/* file associated with HANDLE. */ - -/* $ Examples */ - -/* See the $ Examples section in the header for the main subroutine. */ -/* It contains examples wich demonstrate the use of the entry points */ -/* in the generic segments sequential writer. The entry points which */ -/* comprise the generic segments sequential writer must be used */ -/* together in the proper manner. Rather than repeating the examples */ -/* for each entry point they are provided in a single location. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */ - -/* Fixed an annoying little bug in the variable segments code */ -/* when ending a segment. Rather than storing an appropriate */ -/* offset from the beginning of the segment as the packet */ -/* address in the packet directory, the absolute address, the */ -/* DAF address, was stored. This bug has been fixed. */ - -/* The address calculations, see the variable MYADDR, were fixed. */ -/* This involved initializing the variable outside of the loop */ -/* that scans throught the packet data and then incrementing this */ -/* variable in the same way as PKTADR. */ - -/* The changes were made in two places, for the explicitly indexed */ -/* case and for the implicitly indexed case. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1995 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* end a generic segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */ - -/* Fixed an annoying little bug in the variable segments code */ -/* when ending a segment. Rather than storing an appropriate */ -/* offset from the beginning of the segment as the packet */ -/* address in the packet directory, the absolute address, the */ -/* DAF address, was stored. This bug has been fixed. */ - -/* The address calculations, see the variable MYADDR, were fixed. */ -/* This involved initializing the variable outside of the loop */ -/* that scans throught the packet data and then incrementing this */ -/* variable in the same way as PKTADR. */ - -/* The changes were made in two places, for the explicitly indexed */ -/* case and for the implicitly indexed case. */ - -/* -& */ - -/* SPICELIB functions */ - -/* INTEGER LASTNB */ -/* INTEGER ISRCHI */ - -/* LOGICAL FAILED */ -/* LOGICAL RETURN */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SGWES", (ftnlen)5); - -/* Check to see if we have any fixed or variable segments being */ -/* written. */ - - if (nft == 0) { - setmsg_("No segment is currently being written. This routine has bee" - "n called out of order. One of the routines SGBWFS or SGBWVS " - "must be called before his routine may be called.", (ftnlen) - 167); - sigerr_("SPICE(CALLEDOUTOFORDER)", (ftnlen)23); - chkout_("SGWES", (ftnlen)5); - return 0; - } - -/* Check to see if the last handle used is the same as the current */ -/* handle. This saves us a table lookup to get the appropriate index */ -/* into the file table to restore the information for that handle. */ - - if (*handle != lsthan) { - index = isrchi_(handle, &nft, fthan); - if (index == 0) { - setmsg_("No segment is associated with the file '#'. In order to" - " write packets to a segment one of the routines SGBWFS o" - "r SGBWVS must be called to begin a segment.", (ftnlen)154) - ; - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(SEGMENTNOTFOUND)", (ftnlen)22); - chkout_("SGWES", (ftnlen)5); - return 0; - } - explct = ftexpl[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftexpl", i__1, "sgseqw_", (ftnlen)3569)]; - fxdseg = ftfixd[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftfixd", i__1, "sgseqw_", (ftnlen)3570)]; - lsthan = *handle; - dafcad_(handle); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - } - -/* We need to do different things depending on whether the reference */ -/* values are implicitly or explicitly defined. We will also need to */ -/* treat the cases of fixed size packets and variable size packets */ -/* differently. */ - - if (explct) { - -/* We have an explicit segment. */ - - if (fxdseg) { - -/* We need to do a little bit of work to finish this case off. */ -/* We know that we do not need a list of packet starting */ -/* addresses or a packet directory, but we do need to store in */ -/* a contiguous block the references and a reference directory */ -/* if the number of references is greater than DIRSIZ. */ - -/* We need to do the following things: */ - -/* 1) Initialize the offset of the packet data from the */ -/* beginning of the packet, set the size of the packet, and */ -/* set the beginning address of the packet data area in the */ -/* segment. */ - - size = ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftoff", i__1, "sgseqw_", (ftnlen)3606)] + ftpksz[(i__2 = - index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftpksz", - i__2, "sgseqw_", (ftnlen)3606)]; - refadr = ftbadr[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftbadr", i__1, "sgseqw_", (ftnlen)3607)] + ftncon[ - (i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "ftncon", i__2, "sgseqw_", (ftnlen)3607)]; - -/* 2) Collect all of the references stored with the packets */ -/* when they were written, and copy them into the */ -/* reference area. */ - - i__2 = ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnpkt", i__1, "sgseqw_", (ftnlen)3613)]; - for (i__ = 1; i__ <= i__2; ++i__) { - dafgda_(handle, &refadr, &refadr, &myref); - dafada_(&myref, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - refadr += size; - } - -/* 3) Create a reference directory if the number of */ -/* references is greater than DIRSIZ. */ - - if (ftnref[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "ftnref", i__2, "sgseqw_", (ftnlen)3630)] > 100) { - refadr = ftbadr[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftbadr", i__2, "sgseqw_", (ftnlen)3632)] + - ftncon[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftncon", i__1, "sgseqw_", (ftnlen)3632)]; - refadr = refadr + ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen) - 3633)] * size + 99; - i__1 = (ftnref[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnref", i__2, "sgseqw_", (ftnlen)3635)] - 1) - / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafgda_(handle, &refadr, &refadr, &myref); - dafada_(&myref, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - refadr += 100; - } - } - -/* 4) Construct the meta data for the segment. */ - - size = (ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftoff", i__1, "sgseqw_", (ftnlen)3653)] + ftpksz[( - i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftp" - "ksz", i__2, "sgseqw_", (ftnlen)3653)]) * ftnpkt[(i__3 = - index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftnpkt", - i__3, "sgseqw_", (ftnlen)3653)]; - meta[0] = 0; - meta[1] = ftncon[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftncon", i__1, "sgseqw_", (ftnlen)3656)]; - meta[10] = meta[0] + meta[1]; - meta[11] = ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnpkt", i__1, "sgseqw_", (ftnlen)3658)]; - meta[15] = ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftoff", i__1, "sgseqw_", (ftnlen)3659)]; - meta[7] = 0; - meta[8] = 0; - meta[9] = 0; - meta[5] = meta[10] + size; - meta[6] = ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnref", i__1, "sgseqw_", (ftnlen)3664)]; - meta[2] = meta[5] + meta[6]; - meta[3] = (ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnref", i__1, "sgseqw_", (ftnlen)3666)] - 1) / - 100; - meta[4] = ftityp[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftityp", i__1, "sgseqw_", (ftnlen)3667)]; - meta[12] = 0; - meta[13] = 0; - meta[14] = ftpksz[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftpksz", i__1, "sgseqw_", (ftnlen)3670)]; - meta[16] = 17; - } else { - -/* We need to do a little bit of work to finish this case off. */ -/* We know that we need a packet directory and we need to store */ -/* in a contiguous block the references and a reference */ -/* directory if the number of references is greater than */ -/* DIRSIZ. */ - -/* We need to do the following things: */ - -/* 1) Set the beginning address of the packet data area in the */ -/* segment and initialize the address of the first data */ -/* packet. */ - - pktadr = ftbadr[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftbadr", i__1, "sgseqw_", (ftnlen)3687)] + ftncon[ - (i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "ftncon", i__2, "sgseqw_", (ftnlen)3687)] + ftoff[(i__3 = - index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftoff", - i__3, "sgseqw_", (ftnlen)3687)]; - myaddr = (doublereal) (ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 - ? i__1 : s_rnge("ftoff", i__1, "sgseqw_", (ftnlen)3688)] - + 1); - -/* 2) Create a packet directory. The packet directory consists */ -/* of the beginning addresses for each of the packets and a */ -/* fake beginning for an extra packet so that we can easily */ -/* compute the size of the last packet. */ - - i__2 = ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnpkt", i__1, "sgseqw_", (ftnlen)3695)]; - for (i__ = 1; i__ <= i__2; ++i__) { - i__1 = pktadr - 1; - i__3 = pktadr - 1; - dafgda_(handle, &i__1, &i__3, &mysize); - dafada_(&myaddr, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - size = (integer) mysize; - pktadr = pktadr + size + ftoff[(i__1 = index - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("ftoff", i__1, "sgseqw_", ( - ftnlen)3707)]; - myaddr += (doublereal) (size + ftoff[(i__1 = index - 1) < 20 - && 0 <= i__1 ? i__1 : s_rnge("ftoff", i__1, "sgseqw_", - (ftnlen)3708)]); - } - -/* Put in the fake beginning for an extra packet. PKTADR should */ -/* contain the proper value. */ - - myaddr = myaddr; - dafada_(&myaddr, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - -/* 3) Collect all of the references, stored with the packets */ -/* when they were written, and copy them into the */ -/* reference area. */ - - refadr = ftbadr[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftbadr", i__2, "sgseqw_", (ftnlen)3729)] + ftncon[ - (i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftncon", i__1, "sgseqw_", (ftnlen)3729)]; - i__1 = ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen)3731)]; - for (i__ = 1; i__ <= i__1; ++i__) { - dafgda_(handle, &refadr, &refadr, &myref); - i__2 = refadr + 1; - i__3 = refadr + 1; - dafgda_(handle, &i__2, &i__3, &mysize); - dafada_(&myref, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - size = (integer) mysize; - refadr = refadr + size + ftoff[(i__2 = index - 1) < 20 && 0 <= - i__2 ? i__2 : s_rnge("ftoff", i__2, "sgseqw_", ( - ftnlen)3743)]; - } - -/* 3) Create a reference directory if the number of */ -/* references is greater than DIRSIZ. Note that we have one */ -/* more packet directory item than we have data packets. */ -/* This allows us to compute the size of the last data */ -/* packet. */ - - if (ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftnref", i__1, "sgseqw_", (ftnlen)3753)] > 100) { - refadr = ftbadr[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftbadr", i__1, "sgseqw_", (ftnlen)3755)] + - ftncon[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftncon", i__2, "sgseqw_", (ftnlen)3755)]; - refadr += ftpksz[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftpksz", i__1, "sgseqw_", (ftnlen)3756)]; - refadr += ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftoff", i__1, "sgseqw_", (ftnlen)3757)] * - ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen)3757)]; - refadr = refadr + ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 - ? i__1 : s_rnge("ftnpkt", i__1, "sgseqw_", (ftnlen) - 3758)] + 1; - refadr += 99; - i__2 = (ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnref", i__1, "sgseqw_", (ftnlen)3761)] - 1) - / 100; - for (i__ = 1; i__ <= i__2; ++i__) { - dafgda_(handle, &refadr, &refadr, &myref); - dafada_(&myref, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - refadr += 100; - } - } - -/* 4) Construct the meta data for the segment. */ - - meta[0] = 0; - meta[1] = ftncon[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftncon", i__2, "sgseqw_", (ftnlen)3780)]; - meta[10] = meta[0] + meta[1]; - meta[11] = ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen)3782)]; - meta[15] = ftoff[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftoff", i__2, "sgseqw_", (ftnlen)3783)]; - meta[7] = meta[10] + ftpksz[(i__2 = index - 1) < 20 && 0 <= i__2 ? - i__2 : s_rnge("ftpksz", i__2, "sgseqw_", (ftnlen)3784)] - + ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftoff", i__1, "sgseqw_", (ftnlen)3784)] * ftnpkt[( - i__3 = index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftn" - "pkt", i__3, "sgseqw_", (ftnlen)3784)]; - meta[8] = ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen)3786)] + 1; - meta[9] = 1; - meta[5] = meta[7] + meta[8]; - meta[6] = ftnref[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnref", i__2, "sgseqw_", (ftnlen)3789)]; - meta[2] = meta[5] + meta[6]; - meta[3] = (ftnref[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnref", i__2, "sgseqw_", (ftnlen)3791)] - 1) / - 100; - meta[4] = ftityp[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftityp", i__2, "sgseqw_", (ftnlen)3792)]; - meta[12] = 0; - meta[13] = 0; - meta[14] = ftmxsz[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftmxsz", i__2, "sgseqw_", (ftnlen)3795)]; - meta[16] = 17; - } - } else { - -/* We have an implicitly indexed segment. */ - - if (fxdseg) { - -/* There is no packet directory, so we just write the reference */ -/* values. There is no reference directory either, because */ -/* implicitly indexed packets only have two (2) reference */ -/* values. */ - - dafada_(&ftrefs[(i__2 = (index << 1) - 2) < 40 && 0 <= i__2 ? - i__2 : s_rnge("ftrefs", i__2, "sgseqw_", (ftnlen)3811)], & - ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnref", i__1, "sgseqw_", (ftnlen)3811)]); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - -/* Now we need to construct the meta data for this segment. We */ -/* will write it to the file a bit later. */ - - size = (ftoff[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftoff", i__2, "sgseqw_", (ftnlen)3821)] + ftpksz[( - i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ftp" - "ksz", i__1, "sgseqw_", (ftnlen)3821)]) * ftnpkt[(i__3 = - index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftnpkt", - i__3, "sgseqw_", (ftnlen)3821)]; - meta[0] = 0; - meta[1] = ftncon[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftncon", i__2, "sgseqw_", (ftnlen)3824)]; - meta[10] = meta[0] + meta[1]; - meta[11] = ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen)3826)]; - meta[15] = ftoff[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftoff", i__2, "sgseqw_", (ftnlen)3827)]; - meta[7] = 0; - meta[8] = 0; - meta[9] = 0; - meta[5] = meta[10] + size; - meta[6] = ftnref[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnref", i__2, "sgseqw_", (ftnlen)3832)]; - meta[2] = meta[5] + meta[6]; - meta[3] = 0; - meta[4] = ftityp[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftityp", i__2, "sgseqw_", (ftnlen)3835)]; - meta[12] = 0; - meta[13] = 0; - meta[14] = ftpksz[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftpksz", i__2, "sgseqw_", (ftnlen)3838)]; - meta[16] = 17; - } else { - -/* We need to do a little bit of work to finish this case off. */ -/* We know that we need a packet directory, but we do not need */ -/* a reference directory. */ - -/* We need to do the following things: */ - -/* 1) Set the beginning address of the packet data area in the */ -/* segment and initialize the address of the first data */ -/* packet. */ - - pktadr = ftbadr[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftbadr", i__2, "sgseqw_", (ftnlen)3853)] + ftncon[ - (i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ftncon", i__1, "sgseqw_", (ftnlen)3853)] + ftoff[(i__3 = - index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftoff", - i__3, "sgseqw_", (ftnlen)3853)]; - myaddr = (doublereal) (ftoff[(i__2 = index - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("ftoff", i__2, "sgseqw_", (ftnlen)3854)] - + 1); - -/* 2) Create a packet directory. The packet directory consists */ -/* of the beginning addresses for each of the packets and a */ -/* fake beginning for an extra packet so that we can easily */ -/* compute the size of the last packet. */ - - i__1 = ftnpkt[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftnpkt", i__2, "sgseqw_", (ftnlen)3861)]; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = pktadr - 1; - i__3 = pktadr - 1; - dafgda_(handle, &i__2, &i__3, &mysize); - dafada_(&myaddr, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - size = (integer) mysize; - pktadr = pktadr + size + ftoff[(i__2 = index - 1) < 20 && 0 <= - i__2 ? i__2 : s_rnge("ftoff", i__2, "sgseqw_", ( - ftnlen)3872)]; - myaddr += (doublereal) (size + ftoff[(i__2 = index - 1) < 20 - && 0 <= i__2 ? i__2 : s_rnge("ftoff", i__2, "sgseqw_", - (ftnlen)3873)]); - } - -/* Put in the fake beginning for an extra packet. PKTADR should */ -/* contain the proper value. */ - - myaddr = (doublereal) (pktadr - ftbadr[(i__1 = index - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("ftbadr", i__1, "sgseqw_", ( - ftnlen)3880)]); - dafada_(&myaddr, &c__1); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - -/* 3) Construct the meta data for the segment. */ - - meta[0] = 0; - meta[1] = ftncon[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftncon", i__1, "sgseqw_", (ftnlen)3892)]; - meta[10] = meta[0] + meta[1]; - meta[11] = ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnpkt", i__1, "sgseqw_", (ftnlen)3894)]; - meta[15] = ftoff[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftoff", i__1, "sgseqw_", (ftnlen)3895)]; - meta[7] = meta[10] + ftpksz[(i__1 = index - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ftpksz", i__1, "sgseqw_", (ftnlen)3896)] - + ftoff[(i__2 = index - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("ftoff", i__2, "sgseqw_", (ftnlen)3896)] * ftnpkt[( - i__3 = index - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("ftn" - "pkt", i__3, "sgseqw_", (ftnlen)3896)]; - meta[8] = ftnpkt[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnpkt", i__1, "sgseqw_", (ftnlen)3898)] + 1; - meta[9] = 1; - meta[5] = meta[7] + meta[8]; - meta[6] = ftnref[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftnref", i__1, "sgseqw_", (ftnlen)3901)]; - meta[2] = meta[5] + meta[6]; - meta[3] = 0; - meta[4] = ftityp[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftityp", i__1, "sgseqw_", (ftnlen)3904)]; - meta[12] = 0; - meta[13] = 0; - meta[14] = ftmxsz[(i__1 = index - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("ftmxsz", i__1, "sgseqw_", (ftnlen)3907)]; - meta[16] = 17; - } - } - -/* Write the meta data to the segment and end the segment. */ - - for (i__ = 1; i__ <= 17; ++i__) { - xmeta[(i__1 = i__ - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge("xmeta", - i__1, "sgseqw_", (ftnlen)3917)] = (doublereal) meta[(i__2 = - i__ - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("meta", i__2, - "sgseqw_", (ftnlen)3917)]; - } - dafada_(xmeta, &c__17); - -/* End the segment. */ - - dafena_(); - if (failed_()) { - chkout_("SGWES", (ftnlen)5); - return 0; - } - -/* Now we need to clean up after ourselves, removing the information */ -/* for the segment we just ended from the file table. */ - - --nft; - i__1 = nft; - for (i__ = index; i__ <= i__1; ++i__) { - ftbadr[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftbadr", - i__2, "sgseqw_", (ftnlen)3937)] = ftbadr[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftbadr", i__3, "sgseqw_", (ftnlen) - 3937)]; - fthan[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("fthan", - i__2, "sgseqw_", (ftnlen)3938)] = fthan[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "sgseqw_", (ftnlen) - 3938)]; - ftityp[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftityp", - i__2, "sgseqw_", (ftnlen)3939)] = ftityp[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftityp", i__3, "sgseqw_", (ftnlen) - 3939)]; - ftncon[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftncon", - i__2, "sgseqw_", (ftnlen)3940)] = ftncon[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftncon", i__3, "sgseqw_", (ftnlen) - 3940)]; - ftnpkt[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftnpkt", - i__2, "sgseqw_", (ftnlen)3941)] = ftnpkt[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftnpkt", i__3, "sgseqw_", (ftnlen) - 3941)]; - ftnref[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftnref", - i__2, "sgseqw_", (ftnlen)3942)] = ftnref[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftnref", i__3, "sgseqw_", (ftnlen) - 3942)]; - ftnres[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftnres", - i__2, "sgseqw_", (ftnlen)3943)] = ftnres[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftnres", i__3, "sgseqw_", (ftnlen) - 3943)]; - ftoff[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftoff", - i__2, "sgseqw_", (ftnlen)3944)] = ftoff[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftoff", i__3, "sgseqw_", (ftnlen) - 3944)]; - ftpksz[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftpksz", - i__2, "sgseqw_", (ftnlen)3945)] = ftpksz[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftpksz", i__3, "sgseqw_", (ftnlen) - 3945)]; - ftfixd[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftfixd", - i__2, "sgseqw_", (ftnlen)3946)] = ftfixd[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftfixd", i__3, "sgseqw_", (ftnlen) - 3946)]; - ftexpl[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ftexpl", - i__2, "sgseqw_", (ftnlen)3947)] = ftexpl[(i__3 = i__) < 20 && - 0 <= i__3 ? i__3 : s_rnge("ftexpl", i__3, "sgseqw_", (ftnlen) - 3947)]; - } - if (fxdseg) { - --numfxd; - } else { - --numvar; - } - chkout_("SGWES", (ftnlen)5); - return 0; -} /* sgseqw_ */ - -/* Subroutine */ int sgseqw_(integer *handle, doublereal *descr, char *segid, - integer *nconst, doublereal *const__, integer *npkts, integer *pktsiz, - doublereal *pktdat, integer *nrefs, doublereal *refdat, integer * - idxtyp, ftnlen segid_len) -{ - return sgseqw_0_(0, handle, descr, segid, nconst, const__, npkts, pktsiz, - pktdat, nrefs, refdat, idxtyp, segid_len); - } - -/* Subroutine */ int sgbwfs_(integer *handle, doublereal *descr, char *segid, - integer *nconst, doublereal *const__, integer *pktsiz, integer * - idxtyp, ftnlen segid_len) -{ - return sgseqw_0_(1, handle, descr, segid, nconst, const__, (integer *)0, - pktsiz, (doublereal *)0, (integer *)0, (doublereal *)0, idxtyp, - segid_len); - } - -/* Subroutine */ int sgbwvs_(integer *handle, doublereal *descr, char *segid, - integer *nconst, doublereal *const__, integer *idxtyp, ftnlen - segid_len) -{ - return sgseqw_0_(2, handle, descr, segid, nconst, const__, (integer *)0, ( - integer *)0, (doublereal *)0, (integer *)0, (doublereal *)0, - idxtyp, segid_len); - } - -/* Subroutine */ int sgwfpk_(integer *handle, integer *npkts, doublereal * - pktdat, integer *nrefs, doublereal *refdat) -{ - return sgseqw_0_(3, handle, (doublereal *)0, (char *)0, (integer *)0, ( - doublereal *)0, npkts, (integer *)0, pktdat, nrefs, refdat, ( - integer *)0, (ftnint)0); - } - -/* Subroutine */ int sgwvpk_(integer *handle, integer *npkts, integer *pktsiz, - doublereal *pktdat, integer *nrefs, doublereal *refdat) -{ - return sgseqw_0_(4, handle, (doublereal *)0, (char *)0, (integer *)0, ( - doublereal *)0, npkts, pktsiz, pktdat, nrefs, refdat, (integer *) - 0, (ftnint)0); - } - -/* Subroutine */ int sgwes_(integer *handle) -{ - return sgseqw_0_(5, handle, (doublereal *)0, (char *)0, (integer *)0, ( - doublereal *)0, (integer *)0, (integer *)0, (doublereal *)0, ( - integer *)0, (doublereal *)0, (integer *)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/sharpr.c b/ext/spice/src/cspice/sharpr.c deleted file mode 100644 index 0dc5809c31..0000000000 --- a/ext/spice/src/cspice/sharpr.c +++ /dev/null @@ -1,164 +0,0 @@ -/* sharpr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHARPR ( Sharpen a rotation ) */ -/* Subroutine */ int sharpr_(doublereal *rot) -{ - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *), vhatip_(doublereal *); - -/* $ Abstract */ - -/* Given a matrix that is "nearly" a rotation, adjust the columns */ -/* (from left to right in the usual printed presentation of a matrix) */ -/* so that the columns are numerically unit length and orthogonal. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ROT I/O The rotation matrix to be sharpened. */ - -/* $ Detailed_Input */ - -/* ROT a 3x3 matrix that is nearly a rotation matrix. */ - -/* $ Detailed_Output */ - -/* ROT the input after sharpening the columns. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) This routine is not meant to be used on singular or near- */ -/* singular matrices (in other words, matrices with determinant */ -/* close to zero). */ - -/* If the input matrix is singular, the output matrix may not */ -/* be a rotation matrix. In any case, the results should be */ -/* considered unreliable in this case. */ - -/* No error handling is done for invalid input matrices. */ - -/* $ Particulars */ - -/* This routine "sharpens" the orthogonality of a potential */ -/* rotation matrix. It is intended for use in those situations */ -/* in which you have a rotation matrix that may be derived */ -/* from single precision inputs or that may have experienced */ -/* round off errors in its construction. */ - -/* $ Examples */ - -/* Suppose that you have a rotation matrix that needs to be */ -/* converted to a quaternion. The SPICE matrix to quaternion */ -/* conversion routine M2Q performs error checks on the input */ -/* matrix and signals an error if it does not meet the checks */ -/* for a quaternion. By calling this routine you can ensure that */ -/* your rotation matrix (provided it's non-singular) will pass */ -/* the restrictions imposed by M2Q. */ - -/* CALL SHARPR ( ROT ) */ -/* CALL M2Q ( ROT, Q ) */ - -/* $ Restrictions */ - -/* See the Exceptions section above. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 13-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT call. Some header updates were made. */ - -/* - SPICELIB Version 1.0.0, 16-SEP-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Sharpen the orhogonality of the columns of a rotation */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 13-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT call. Some header updates were made. */ - -/* -& */ - -/* Unitize the first column of the rotation. */ - - vhatip_(rot); - -/* Unitize the third column of the rotation and make it */ -/* orthogonal to the first two columns. */ - - ucrss_(rot, &rot[3], &rot[6]); - -/* Unitize the second column of the rotation and make it */ -/* orthogonal to the first and third columns. */ - - ucrss_(&rot[6], rot, &rot[3]); - return 0; -} /* sharpr_ */ - diff --git a/ext/spice/src/cspice/shellc.c b/ext/spice/src/cspice/shellc.c deleted file mode 100644 index bee199aef0..0000000000 --- a/ext/spice/src/cspice/shellc.c +++ /dev/null @@ -1,172 +0,0 @@ -/* shellc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHELLC ( Shell sort a character array ) */ -/* Subroutine */ int shellc_(integer *ndim, char *array, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - logical l_le(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapc_(char *, char *, ftnlen, ftnlen); - integer jg, gap; - -/* $ Abstract */ - -/* Sort an array of character strings according to the ASCII */ -/* collating sequence using the Shell Sort algorithm. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NDIM I Dimension of the array. */ -/* ARRAY I/O The array. */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in the array to be sorted. */ - -/* ARRAY on input, is the array to be sorted. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, contains the same elements, sorted */ -/* according to the ASCII collating sequence. */ -/* The actual sorting is done in place in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The Shell Sort Algorithm is well known. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* 'FEYNMAN' */ -/* 'NEWTON' */ -/* 'EINSTEIN' */ -/* 'GALILEO' */ -/* 'EUCLID' */ -/* 'Galileo' */ - -/* Then after a call to SHELLC, the array would be ordered as */ -/* follows: */ - -/* 'EINSTEIN' */ -/* 'EUCLID' */ -/* 'FEYNMAN' */ -/* 'GALILEO' */ -/* 'Galileo' */ -/* 'NEWTON' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shell sort a character array */ - -/* -& */ - -/* Local variables */ - - -/* This is a straightforward implementation of the Shell Sort */ -/* algorithm. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (l_le(array + (j - 1) * array_len, array + (jg - 1) * - array_len, array_len, array_len)) { - j = 0; - } else { - swapc_(array + (j - 1) * array_len, array + (jg - 1) * - array_len, array_len, array_len); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* shellc_ */ - diff --git a/ext/spice/src/cspice/shellc_c.c b/ext/spice/src/cspice/shellc_c.c deleted file mode 100644 index ac9390b1af..0000000000 --- a/ext/spice/src/cspice/shellc_c.c +++ /dev/null @@ -1,227 +0,0 @@ -/* - --Procedure shellc_c ( Shell sort a character array ) - --Abstract - - Sort an array of character strings according to the ASCII - collating sequence using the Shell Sort algorithm. - --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 - - ARRAY, SORT - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void shellc_c ( SpiceInt ndim, - SpiceInt lenvals, - void * array ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - ndim I Dimension of the array. - lenvals I String length. - array I/O The array. - --Detailed_Input - - ndim is the number of elements in the array to be sorted. - - lenvals is the declared length of the strings in the input - string array, including null terminators. The input - array should be declared with dimension - - [ndim][lenvals] - - array on input, is the array to be sorted. - --Detailed_Output - - array on output, contains the same elements, sorted - according to the ASCII collating sequence. - The actual sorting is done in place in array. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If ndim < 2, this routine does not modify the array. - - 2) If the input string array pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If the input array string length is less than 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Particulars - - The Shell Sort Algorithm is well known. - --Examples - - Let array contain the following elements: - - "FEYNMAN" - "NEWTON" - "EINSTEIN" - "GALILEO" - "EUCLID" - "Galileo" - - Then after a call to shellc_c, the array would be ordered as - follows: - - "EINSTEIN" - "EUCLID" - "FEYNMAN" - "GALILEO" - "Galileo" - "NEWTON" - --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. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 18-JUL-2002 (NJB) (IMU) - --Index_Entries - - shell sort a character array - --& -*/ - -{ /* Begin shellc_c */ - - - /* - Local variables - */ - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - SpiceInt nBytes; - - - - /* - Use discovery check-in. - - Return immediately if no re-ordering is required. - */ - if ( ndim < 2 ) - { - return; - } - - /* - Make sure the input pointer for the string array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_DISCOVER, "shellc_c", array, lenvals ); - - /* - Create a Fortran-style string array. Don't eliminate trailing - white space during translation, since it will be convenient to keep the - same array dimensions when we return the sorted array. - */ - C2F_MapFixStrArr ( "shellc_c", - ndim, lenvals, array, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - return; - } - - /* - Call the f2c'd routine. - */ - shellc_ ( ( integer * ) &ndim, - ( char * ) fCvalsArr, - ( ftnlen ) fCvalsLen ); - - - /* - Copy the Fortran array into the output array. - */ - nBytes = ndim * fCvalsLen * sizeof(SpiceChar); - - memmove ( array, fCvalsArr, nBytes ); - - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - /* - Convert the output array from Fortran to C style. - */ - F2C_ConvertTrStrArr ( ndim, lenvals, (SpiceChar *)array ); - - -} /* End shellc_c */ diff --git a/ext/spice/src/cspice/shelld.c b/ext/spice/src/cspice/shelld.c deleted file mode 100644 index cd88101000..0000000000 --- a/ext/spice/src/cspice/shelld.c +++ /dev/null @@ -1,166 +0,0 @@ -/* shelld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHELLD ( Shell sort a double precision array ) */ -/* Subroutine */ int shelld_(integer *ndim, doublereal *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapd_(doublereal *, doublereal *); - integer jg, gap; - -/* $ Abstract */ - -/* Sort a double precision array using the Shell Sort algorithm. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NDIM I Dimension of the array. */ -/* ARRAY I/O The array. */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in the array to be sorted. */ - -/* ARRAY on input, is the array to be sorted. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, contains the same elements, sorted */ -/* in increasing order. The actual sorting is done */ -/* in place in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The Shell Sort Algorithm is well known. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* 99.D0 */ -/* 33.D0 */ -/* 55.D0 */ -/* 44.D0 */ -/* -77.D0 */ -/* 66.D0 */ - -/* Then after a call to SHELLD, the array would be ordered as */ -/* follows: */ - -/* -77.D0 */ -/* 33.D0 */ -/* 44.D0 */ -/* 55.D0 */ -/* 66.D0 */ -/* 99.D0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shell sort a d.p. array */ - -/* -& */ - -/* Local variables */ - - -/* This is a straightforward implementation of the Shell Sort */ -/* algorithm. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (array[j - 1] <= array[jg - 1]) { - j = 0; - } else { - swapd_(&array[j - 1], &array[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* shelld_ */ - diff --git a/ext/spice/src/cspice/shelld_c.c b/ext/spice/src/cspice/shelld_c.c deleted file mode 100644 index 785056a670..0000000000 --- a/ext/spice/src/cspice/shelld_c.c +++ /dev/null @@ -1,141 +0,0 @@ -/* - --Procedure shelld_c ( Shell sort a double precision array ) - --Abstract - - Sort a double precision array using the Shell Sort algorithm. - --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 - - ARRAY, SORT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void shelld_c ( SpiceInt ndim, - SpiceDouble * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - ndim I Dimension of the array. - array I/O The array to be sorted. - --Detailed_Input - - ndim is the number of elements in the array to be sorted. - - array on input, is the array to be sorted. - --Detailed_Output - - array on output, contains the same elements, sorted - in increasing order. The actual sorting is done - in place in array. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - 1) If ndim < 2, this routine does not modify the array. - --Particulars - - The Shell Sort Algorithm is well known. - --Examples - - Let array contain the following elements: - - 99. - 33. - 55. - 44. - -77. - 66. - - Then after a call to shelld_c, the array would be ordered as - follows: - - -77. - 33. - 44. - 55. - 66. - 99. - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-JUL-2002 (NJB) (IMU) - --Index_Entries - - shell sort a d.p. array - --& -*/ - -{ /* Begin shelld_c */ - - - shelld_ ( ( integer * ) &ndim, - ( doublereal * ) array ); - - -} /* End shelld_c */ diff --git a/ext/spice/src/cspice/shelli.c b/ext/spice/src/cspice/shelli.c deleted file mode 100644 index 25ca73e7c3..0000000000 --- a/ext/spice/src/cspice/shelli.c +++ /dev/null @@ -1,166 +0,0 @@ -/* shelli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHELLI ( Shell sort an integer array ) */ -/* Subroutine */ int shelli_(integer *ndim, integer *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg, gap; - -/* $ Abstract */ - -/* Sort an integer array using the Shell Sort algorithm. */ - -/* $ 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 */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NDIM I Dimension of the array. */ -/* ARRAY I/O The array. */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in the array to be sorted. */ - -/* ARRAY on input, is the array to be sorted. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, contains the same elements, sorted */ -/* in increasing order. The actual sorting is done */ -/* in place in ARRAY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The Shell Sort Algorithm is well known. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* 99 */ -/* 33 */ -/* 55 */ -/* 44 */ -/* -77 */ -/* 66 */ - -/* Then after a call to SHELLI, the array would be ordered as */ -/* follows: */ - -/* -77 */ -/* 33 */ -/* 44 */ -/* 55 */ -/* 66 */ -/* 99 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shell sort an integer array */ - -/* -& */ - -/* Local variables */ - - -/* This is a straightforward implementation of the Shell Sort */ -/* algorithm. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (array[j - 1] <= array[jg - 1]) { - j = 0; - } else { - swapi_(&array[j - 1], &array[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* shelli_ */ - diff --git a/ext/spice/src/cspice/shelli_c.c b/ext/spice/src/cspice/shelli_c.c deleted file mode 100644 index 607aac7cec..0000000000 --- a/ext/spice/src/cspice/shelli_c.c +++ /dev/null @@ -1,139 +0,0 @@ -/* - --Procedure shelli_c ( Shell sort an integer array ) - --Abstract - - Sort an integer array using the Shell Sort algorithm. - --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 - - ARRAY, SORT - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void shelli_c ( SpiceInt ndim, - SpiceInt * array ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - ndim I Dimension of the array. - array I/O The array. - --Detailed_Input - - ndim is the number of elements in the array to be sorted. - - array on input, is the array to be sorted. - --Detailed_Output - - array on output, contains the same elements, sorted - in increasing order. The actual sorting is done - in place in array. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - 1) If ndim < 2, this routine does not modify the array. - --Particulars - - The Shell Sort Algorithm is well known. - --Examples - - Let array contain the following elements: - - 99 - 33 - 55 - 44 - -77 - 66 - - Then after a call to shelli_c, the array would be ordered as - follows: - - -77 - 33 - 44 - 55 - 66 - 99 - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-JUL-2002 (NJB) (IMU) - --Index_Entries - - shell sort an integer array - --& -*/ - -{ /* Begin shelli_c */ - - shelli_ ( ( integer * ) &ndim, - ( integer * ) array ); - -} /* End shelli_c */ diff --git a/ext/spice/src/cspice/shiftc.c b/ext/spice/src/cspice/shiftc.c deleted file mode 100644 index f7a242a520..0000000000 --- a/ext/spice/src/cspice/shiftc.c +++ /dev/null @@ -1,209 +0,0 @@ -/* shiftc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHIFTC ( Shift a character string ) */ -/* Subroutine */ int shiftc_(char *in, char *dir, integer *nshift, char * - fillc, char *out, ftnlen in_len, ftnlen dir_len, ftnlen fillc_len, - ftnlen out_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), shiftl_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), shiftr_(char *, integer *, char *, char *, ftnlen, - ftnlen, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Shift the contents of a character string to the left or right. */ -/* Characters moved past the beginning or end of the string are */ -/* lost. Vacant spaces are filled with a specified 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 */ - -/* None. */ - -/* $ Keywords */ - -/* CHARACTER, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* DIR I Direction to shift. */ -/* NSHIFT I Number of times to shift. */ -/* FILLC I Character to fill spaces left vacant. */ -/* OUT O Shifted string. */ - -/* $ Detailed_Input */ - -/* IN is the input character string. */ - -/* DIR is the direction in which the characters in the */ -/* string are to be shifted. */ - -/* 'L' or 'l' to shift left. */ -/* 'R' or 'r' to shift right. */ - -/* NSHIFT is the number of times the string is to be */ -/* shifted. */ - -/* FILLC is the character with which spaces left vacant by */ -/* the shift are to be filled. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is the input string, */ -/* shifted N times, filled with FILLC. */ - -/* OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The first NSHIFT characters of the output string are filled */ -/* with the fill character, and the input string is appended. */ - -/* $ Examples */ - -/* If FILLC = ' ' */ - -/* 'abcde' shifted left twice becomes 'cde ' */ -/* 'abcde' shifted right once becomes ' abcd' */ - -/* If FILLC = '.' */ - -/* '12345 ' shifted right once becomes '.12345' */ -/* 'Apple ' shifted left ten times becomes '......' */ - -/* $ Restrictions */ - -/* SHIFTC is being maintained for historical reasons only. */ -/* To avoid the overhead imposed by the error handling in this */ -/* routine, use the equivalent routines SHIFTL and SHIFTR. */ - -/* $ Exceptions */ - -/* 1) A negative shift in one direction is equal to a positive */ -/* shift in the other. */ - -/* 2) If a legal direction ('L', 'l', 'R', 'r') is not supplied, */ -/* the error 'SPICE(ILLEGSHIFTDIR)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shift a character_string */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-OCT-1988 (IMU) */ - -/* Dick Simpson reported that the statement */ - -/* OUT(N+1: ) = IN */ - -/* which began the right-shift section failed on his Data */ -/* General, presumably because it requires temporary buffering */ -/* of characters. The new version seems to work for all cases. */ -/* It has been tested on the VAX and on the Sun (f77 compiler). */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SHIFTC", (ftnlen)6); - } - -/* Hand off to one of the other routines. */ - - if (*(unsigned char *)dir == 'L' || *(unsigned char *)dir == 'l') { - if (*nshift >= 0) { - shiftl_(in, nshift, fillc, out, in_len, (ftnlen)1, out_len); - } else { - i__1 = -(*nshift); - shiftr_(in, &i__1, fillc, out, in_len, (ftnlen)1, out_len); - } - } else if (*(unsigned char *)dir == 'R' || *(unsigned char *)dir == 'r') { - if (*nshift >= 0) { - shiftr_(in, nshift, fillc, out, in_len, (ftnlen)1, out_len); - } else { - i__1 = -(*nshift); - shiftl_(in, &i__1, fillc, out, in_len, (ftnlen)1, out_len); - } - } else { - setmsg_("Shift direction (#) must be L, l, R, or r.", (ftnlen)42); - errch_("#", dir, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(ILLEGSHIFTDIR)", (ftnlen)20); - } - chkout_("SHIFTC", (ftnlen)6); - return 0; -} /* shiftc_ */ - diff --git a/ext/spice/src/cspice/shiftl.c b/ext/spice/src/cspice/shiftl.c deleted file mode 100644 index 3321c4412a..0000000000 --- a/ext/spice/src/cspice/shiftl.c +++ /dev/null @@ -1,237 +0,0 @@ -/* shiftl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHIFTL ( Shift left ) */ -/* Subroutine */ int shiftl_(char *in, integer *nshift, char *fillc, char * - out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, n, s, nfill, inlen, nsave, outlen; - -/* $ Abstract */ - -/* Shift the contents of a character string to the left. */ -/* Characters moved past the beginning of the input string are */ -/* lost. Vacant spaces are filled with a specified 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 */ - -/* None. */ - -/* $ Keywords */ - -/* CHARACTER, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* NSHIFT I Number of times to shift. */ -/* FILLC I Character to fill spaces left vacant. */ -/* OUT O Shifted string. */ - -/* $ Detailed_Input */ - -/* IN is the input character string. */ - -/* NSHIFT is the number of times the string is to be */ -/* shifted. If NSHIFT is negative, OUT will be */ -/* identical to IN. */ - -/* FILLC is the character with which spaces left vacant by */ -/* the shift are to be filled. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is the input string, */ -/* shifted N times, filled with FILLC. */ - -/* OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* As a string is shifted left or right, the leftmost or */ -/* rightmost characters of the string disappear (as if pushed */ -/* off the end of the string). This is true regardless of */ -/* the length of the output string. */ - -/* The remaining characters are shifted simultaneously, and */ -/* the spaces vacated by those characters are filled with a */ -/* replacement character. */ - -/* $ Examples */ - -/* If FILLC = ' ' */ - -/* 'abcde' shifted left twice becomes 'cde ' */ -/* 'abcde' shifted right once becomes ' abcd' */ - -/* If FILLC = '.' */ - -/* '12345 ' shifted right once becomes '.12345' */ -/* 'Apple ' shifted left ten times becomes '......' */ - -/* Given the declarations */ - -/* CHARACTER*3 SHORT */ -/* CHARACTER*10 LONG */ - -/* The calls */ - -/* CALL SHIFTR ( 'abcde ', 2, '-', SHORT ) */ -/* CALL SHIFTR ( 'abcde ', 2, '-', LONG ) */ - -/* yield the strings */ - -/* SHORT = '--a' */ -/* LONG = '--abcd ' */ - -/* while the calls */ - -/* CALL SHIFTL ( 'abcde ', 2, '-', SHORT ) */ -/* CALL SHIFTL ( 'abcde ', 2, '-', LONG ) */ - -/* yield the strings */ - -/* SHORT = 'cde' */ -/* LONG = 'cde .. ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDDO to END DO. */ - -/* - SPICELIB Version 2.0.0, 01-SEP-1994 (MJS) */ - -/* This version correctly handles negative shifts. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shift left */ - -/* -& */ - -/* Local variables */ - - -/* Get the length of the input, output strings. */ - - inlen = i_len(in, in_len); - outlen = i_len(out, out_len); - -/* If the shift is zero or negative, the string is not changed. */ -/* If longer than the input string, the entire string is shifted. */ - - s = max(*nshift,0); - n = min(inlen,s); - -/* Figure out how many characters in the input string will */ -/* be saved (will not be shifted off the end of the string, */ -/* and will fit in the output string), and how many fill */ -/* characters will be needed (no more than NSHIFT, no fewer */ -/* than zero). */ - -/* Computing MIN */ - i__1 = inlen - n; - nsave = min(i__1,outlen); -/* Computing MAX */ - i__1 = 0, i__2 = inlen - outlen; - nfill = n - max(i__1,i__2); - -/* Move the saved characters to output. */ - - i__1 = nsave; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = i__ + s - 1; - s_copy(out + (i__ - 1), in + i__2, (ftnlen)1, i__ + s - i__2); - } - -/* Add as many fill characters as appropriate. */ - - i__1 = nsave + nfill; - for (i__ = nsave + 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[i__ - 1] = *(unsigned char *)fillc; - } - -/* Pad the output string with blanks (to cover any previous */ -/* ugliness there). */ - - if (outlen > inlen) { - i__1 = inlen; - s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1); - } - return 0; -} /* shiftl_ */ - diff --git a/ext/spice/src/cspice/shiftr.c b/ext/spice/src/cspice/shiftr.c deleted file mode 100644 index 8d1a6d0d63..0000000000 --- a/ext/spice/src/cspice/shiftr.c +++ /dev/null @@ -1,234 +0,0 @@ -/* shiftr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SHIFTR ( Shift right ) */ -/* Subroutine */ int shiftr_(char *in, integer *nshift, char *fillc, char * - out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, n, s, nfill, inlen, nsave, outlen; - -/* $ Abstract */ - -/* Shift the contents of a character string to the right. */ -/* Characters moved past the end of the input string are */ -/* lost. Vacant spaces are filled with a specified 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 */ - -/* None. */ - -/* $ Keywords */ - -/* CHARACTER, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* NSHIFT I Number of times to shift. */ -/* FILLC I Character to fill spaces left vacant. */ -/* OUT O Shifted string. */ - -/* $ Detailed_Input */ - -/* IN is the input character string. */ - -/* NSHIFT is the number of times the string is to be */ -/* shifted. If NSHIFT is negative, OUT will be */ -/* identical to IN. */ - -/* FILLC is the character with which spaces left vacant by */ -/* the shift are to be filled. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is the input string, */ -/* shifted N times, filled with FILLC. */ - -/* OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* As a string is shifted left or right, the leftmost or */ -/* rightmost characters of the string disappear (as if pushed */ -/* off the end of the string). This is true regardless of */ -/* the length of the output string. */ - -/* The remaining characters are shifted simultaneously, and */ -/* the spaces vacated by those characters are filled with a */ -/* replacement character. */ - -/* $ Examples */ - -/* If FILLC = ' ' */ - -/* 'abcde' shifted left twice becomes 'cde ' */ -/* 'abcde' shifted right once becomes ' abcd' */ - -/* If FILLC = '.' */ - -/* '12345 ' shifted right once becomes '.12345' */ -/* 'Apple ' shifted left ten times becomes '......' */ - -/* Given the declarations */ - -/* CHARACTER*3 SHORT */ -/* CHARACTER*10 LONG */ - -/* The calls */ - -/* CALL SHIFTR ( 'abcde ', 2, '-', SHORT ) */ -/* CALL SHIFTR ( 'abcde ', 2, '-', LONG ) */ - -/* yield the strings */ - -/* SHORT = '--a' */ -/* LONG = '--abcd ' */ - -/* while the calls */ - -/* CALL SHIFTL ( 'abcde ', 2, '-', SHORT ) */ -/* CALL SHIFTL ( 'abcde ', 2, '-', LONG ) */ - -/* yield the strings */ - -/* SHORT = 'cde' */ -/* LONG = 'cde .. ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 22-AUG-2001 (EDW) */ - -/* Corrected ENDDO to END DO. */ - -/* - SPICELIB Version 2.0.0, 01-SEP-1994 (MJS) */ - -/* This version correctly handles negative shifts. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shift right */ - -/* -& */ - -/* Local variables */ - - -/* Get the length of the input, output strings. */ - - inlen = i_len(in, in_len); - outlen = i_len(out, out_len); - -/* If the shift is zero or negative, the string is not changed. */ -/* If longer than the input string, the entire string is shifted. */ - - s = max(*nshift,0); - n = min(inlen,s); - -/* Figure out how many characters in the input string will */ -/* be saved (will not be shifted off the end of the string, */ -/* and will fit in the output string), and how many fill */ -/* characters will be needed (no more than NSHIFT, no fewer */ -/* than zero). */ - -/* Computing MAX */ - i__1 = 0, i__2 = inlen - outlen; - nsave = inlen - n - max(i__1,i__2); - nfill = min(n,outlen); - -/* Move the saved characters to output. */ - - for (i__ = nsave; i__ >= 1; --i__) { - i__1 = i__ + s - 1; - s_copy(out + i__1, in + (i__ - 1), i__ + s - i__1, (ftnlen)1); - } - -/* Add as many fill characters as appropriate. */ - - i__1 = nfill; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[i__ - 1] = *(unsigned char *)fillc; - } - -/* Pad the output string with blanks (to cover any previous */ -/* ugliness there). */ - - if (outlen > inlen) { - i__1 = inlen; - s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1); - } - return 0; -} /* shiftr_ */ - diff --git a/ext/spice/src/cspice/sig_die.c b/ext/spice/src/cspice/sig_die.c deleted file mode 100644 index 6c470ecb5f..0000000000 --- a/ext/spice/src/cspice/sig_die.c +++ /dev/null @@ -1,120 +0,0 @@ -/* - --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. - -*/ - -/* - --Description - - This is a slightly modified version of the f2c library - file sig_die.c, which was included in the 1998-09-13 f2c - distribution. - - This file has been modified as follows: - - 1) This "header" text has been added. - - 2) The file optionally invokes macros that mangle the - external symbols in f2c's F77 and I77 libraries. The - purpose of this is to allow programs to link to - CSPICE and also link to Fortran objects that do - Fortran I/O. - - The mangling is invoked by defining the preprocessor - flag - - MIX_C_AND_FORTRAN - - - The name mangling capability used by this routine should only be - used as a last resort. - --Version - - -CSPICE Version 1.0.0, 19-DEC-2001 (NJB) - --& -*/ - - /* - Mangle external symbols if we're mixing C and Fortran. This - code was not in the original version of sig_die.c obtained with - the f2c distribution. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - /* - End of modification. - */ - -#include "stdio.h" -#include "signal.h" - -#ifndef SIGIOT -#ifdef SIGABRT -#define SIGIOT SIGABRT -#endif -#endif - -#ifdef KR_headers -void sig_die(s, kill) register char *s; int kill; -#else -#include "stdlib.h" -#ifdef __cplusplus -extern "C" { -#endif - extern void f_exit(void); - -void sig_die(register char *s, int kill) -#endif -{ - /* print error message, then clear buffers */ - fprintf(stderr, "%s\n", s); - - if(kill) - { - fflush(stderr); - f_exit(); - fflush(stderr); - /* now get a core */ -#ifdef SIGIOT - signal(SIGIOT, SIG_DFL); -#endif - abort(); - } - else { -#ifdef NO_ONEXIT - f_exit(); -#endif - exit(1); - } - } -#ifdef __cplusplus -} -#endif diff --git a/ext/spice/src/cspice/sigdgt.c b/ext/spice/src/cspice/sigdgt.c deleted file mode 100644 index 7c857010c2..0000000000 --- a/ext/spice/src/cspice/sigdgt.c +++ /dev/null @@ -1,358 +0,0 @@ -/* sigdgt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SIGDGT ( Retain significant digits ) */ -/* Subroutine */ int sigdgt_(char *in, char *out, ftnlen in_len, ftnlen - out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - integer zero, i__, j, k, l, begin; - char lchar[1]; - extern integer lastnb_(char *, ftnlen), frstnb_(char *, ftnlen); - integer end; - -/* $ Abstract */ - -/* Retain only the significant digits in a numeric 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 */ - -/* CHARACTER, PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input numeric string. */ -/* OUT O Numeric string, with insignificant digits removed. */ - -/* $ Detailed_Input */ - -/* IN is a numeric string. */ - -/* $ Detailed_Output */ - -/* OUT is the same numeric string with insignificant */ -/* zeros and spaces removed. The special case '.000...' */ -/* becomes just '0'. OUT may overwrite IN. If the */ -/* output string is too long, it is truncated on the */ -/* right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* There are only two interesting cases: */ - -/* 1) There is a decimal point and an exponent immediately */ -/* preceded by zero ('...0E', '...0D', '...0e', '...0d') */ -/* or by a space ('... E', '... D', '... e', '... d'). */ - -/* 2) There is a decimal point and no exponent, and the last non- */ -/* blank character is a zero ('...0'). */ - -/* In each of these cases, go to the zero in question, and step */ -/* backwards until you find something other than a blank or a zero. */ - -/* Finally, remove all leading spaces, and all occurrences of more */ -/* than one consecutive space within the string. */ - -/* $ Examples */ - -/* The following examples illustrate the use of SIGDGT. */ - -/* '0.123456000000D-04' becomes '0.123456D-04' */ -/* ' -9.2100000000000' '-9.21' */ -/* ' 13' '13' */ -/* ' 00013' '00013' */ -/* ' .314 159 265 300 000 e1' '.314 159 265 3e1' */ -/* ' 123 45 6' '123 45 6' */ -/* ' .000000000' '0' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If IN is a non-numeric string, the contents of OUT are */ -/* unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* retain significant digits */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.3.0, 21-MAR-1989 (WLT) */ - -/* Previous fix was unbelievably bad, very buggy. This */ -/* has been fixed along with other bugs and non-standard */ -/* code has been removed. */ - -/* - Beta Version 1.2.0, 28-FEB-1989 (WLT) */ - -/* Reference to INSSUB replaced by SUFFIX */ - -/* - Beta Version 1.1.1, 17-FEB-1989 (HAN) (NJB) */ - -/* Declaration of the unused function ISRCHC removed. */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Find the first and last non-blank characters in the string. */ - -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(in, in_len); - begin = max(i__1,i__2); -/* Computing MAX */ - i__1 = 1, i__2 = lastnb_(in, in_len); - end = max(i__1,i__2); - *(unsigned char *)lchar = ' '; - -/* Trivial case. */ - - if (begin == end) { - *(unsigned char *)out = *(unsigned char *)&in[begin - 1]; - if (i_len(out, out_len) > 1) { - s_copy(out + 1, " ", out_len - 1, (ftnlen)1); - } - -/* If there is no decimal point, all zeros are significant. */ - - } else if (i_indx(in, ".", in_len, (ftnlen)1) == 0) { - l = 1; - k = begin; - while(l <= i_len(out, out_len) && k <= end) { - *(unsigned char *)&out[l - 1] = *(unsigned char *)&in[k - 1]; - -/* Don't increment L if the last item copied was a space */ -/* (we don't want to copy extra spaces). */ - - if (*(unsigned char *)&in[k - 1] != ' ' || *(unsigned char *) - lchar != ' ') { - ++l; - } - *(unsigned char *)lchar = *(unsigned char *)&in[k - 1]; - ++k; - } - if (l <= i_len(out, out_len)) { - s_copy(out + (l - 1), " ", out_len - (l - 1), (ftnlen)1); - } - } else { - -/* Is there is a decimal point and an exponent immediately */ -/* preceded by zero ('...0E', '...0D', '...0e', '...0d') or */ -/* by a space ('... E', '... D', '... e', '... d')? */ - - zero = i_indx(in, "0E", in_len, (ftnlen)2); - if (zero == 0) { - zero = i_indx(in, "0D", in_len, (ftnlen)2); - } - if (zero == 0) { - zero = i_indx(in, "0e", in_len, (ftnlen)2); - } - if (zero == 0) { - zero = i_indx(in, "0d", in_len, (ftnlen)2); - } - if (zero == 0) { - zero = i_indx(in, " E", in_len, (ftnlen)2); - } - if (zero == 0) { - zero = i_indx(in, " D", in_len, (ftnlen)2); - } - if (zero == 0) { - zero = i_indx(in, " e", in_len, (ftnlen)2); - } - if (zero == 0) { - zero = i_indx(in, " d", in_len, (ftnlen)2); - } - -/* Begin there, and move toward the front of the string until */ -/* something other than a blank or a zero is encountered. Then */ -/* remove the superfluous characters. */ - - if (zero > 0) { - j = zero + 1; - i__ = zero; - while(*(unsigned char *)&in[i__ - 1] == '0' || *(unsigned char *)& - in[i__ - 1] == ' ') { - --i__; - } - l = 1; - k = begin; - while(l <= i_len(out, out_len) && k <= i__) { - *(unsigned char *)&out[l - 1] = *(unsigned char *)&in[k - 1]; - -/* Don't increment L if the last item copied was a space. */ - - if (*(unsigned char *)&in[k - 1] != ' ' || *(unsigned char *) - lchar != ' ') { - ++l; - } - *(unsigned char *)lchar = *(unsigned char *)&in[k - 1]; - ++k; - } - k = j; - while(l <= i_len(out, out_len) && k <= end) { - *(unsigned char *)&out[l - 1] = *(unsigned char *)&in[k - 1]; - -/* Increment L only if we don't have two consecutive */ -/* spaces. */ - - if (*(unsigned char *)&in[k - 1] != ' ' || *(unsigned char *) - lchar != ' ') { - ++l; - } - *(unsigned char *)lchar = *(unsigned char *)&in[k - 1]; - ++k; - } - if (l <= i_len(out, out_len)) { - s_copy(out + (l - 1), " ", out_len - (l - 1), (ftnlen)1); - } - - -/* Is there is a decimal point and no exponent, and is the last */ -/* non-blank character a zero ('...0')? Then truncate the string */ -/* after the last character that is neither a blank nor a zero. */ - - } else if (*(unsigned char *)&in[end - 1] == '0' && cpos_(in, "EeDd", - &c__1, in_len, (ftnlen)4) == 0) { - i__ = end; - while(*(unsigned char *)&in[i__ - 1] == '0' || *(unsigned char *)& - in[i__ - 1] == ' ') { - --i__; - } - l = 1; - k = begin; - while(l <= i_len(out, out_len) && k <= i__) { - *(unsigned char *)&out[l - 1] = *(unsigned char *)&in[k - 1]; - -/* Increment L only if we don't have two consecutive */ -/* spaces. */ - - if (*(unsigned char *)&in[k - 1] != ' ' || *(unsigned char *) - lchar != ' ') { - ++l; - } - *(unsigned char *)lchar = *(unsigned char *)&in[k - 1]; - ++k; - } - if (l <= i_len(out, out_len)) { - s_copy(out + (l - 1), " ", out_len - (l - 1), (ftnlen)1); - } - } else { - l = 1; - k = begin; - while(l <= i_len(out, out_len) && k <= end) { - *(unsigned char *)&out[l - 1] = *(unsigned char *)&in[k - 1]; - -/* Increment L only if we don't have two consecutive spaces. */ - - if (*(unsigned char *)&in[k - 1] != ' ' || *(unsigned char *) - lchar != ' ') { - ++l; - } - *(unsigned char *)lchar = *(unsigned char *)&in[k - 1]; - ++k; - } - if (l <= i_len(out, out_len)) { - s_copy(out + (l - 1), " ", out_len - (l - 1), (ftnlen)1); - } - } - } - -/* Special case. The string '.0000....' reduces to '.' after the */ -/* zeros are removed. */ - - if (s_cmp(out, ".", out_len, (ftnlen)1) == 0) { - s_copy(out, "0", out_len, (ftnlen)1); - } - return 0; -} /* sigdgt_ */ - diff --git a/ext/spice/src/cspice/sigerr.c b/ext/spice/src/cspice/sigerr.c deleted file mode 100644 index 8996e6493a..0000000000 --- a/ext/spice/src/cspice/sigerr.c +++ /dev/null @@ -1,372 +0,0 @@ -/* sigerr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_true = TRUE_; -static logical c_false = FALSE_; - -/* $Procedure SIGERR ( Signal Error Condition ) */ -/* Subroutine */ int sigerr_(char *msg, ftnlen msg_len) -{ - /* Initialized data */ - - static char defmsg[40] = "SHORT, EXPLAIN, LONG, TRACEBACK, DEFAULT"; - static char errmsg[40] = "SHORT, EXPLAIN, LONG, TRACEBACK "; - - static logical stat; - extern logical failed_(void), accept_(logical *); - extern /* Subroutine */ int getact_(integer *); - static integer action; - extern /* Subroutine */ int byebye_(char *, ftnlen), freeze_(void); - extern logical seterr_(logical *); - extern /* Subroutine */ int outmsg_(char *, ftnlen), putsms_(char *, - ftnlen); - -/* $ Abstract */ - -/* Inform the SPICELIB error processing mechanism that an error has */ -/* occurred, and specify the type of error. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MSG I A short error message. */ - -/* $ Detailed_Input */ - -/* MSG A ``short'' error message. */ -/* MSG indicates the type of error that has occurred. */ - -/* The exact format that MSG must follow is */ -/* described in the required reading file, ERROR.REQ. */ -/* Only the first 25 characters of MSG will be stored; */ -/* additional characters will be truncated. */ - -/* Generally, MSG will be stored internally by the SPICELIB */ -/* error handling mechanism. The only exception */ -/* is the case in which the user has commanded the error */ -/* handling mechanism to ``ignore'' the error indicated by */ -/* MSG. */ - -/* As a default, MSG will be output to the screen. */ -/* See the required reading file for a discussion of how */ -/* to customize SPICELIB error handling behavior, and */ -/* in particular, the disposition of MSG. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine does not detect any errors. */ - -/* However, this routine is part of the interface to the */ -/* SPICELIB error handling mechanism. For this reason, */ -/* this routine does not participate in the trace scheme, */ -/* even though it has external references. */ - - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* First of all, please read the ``required reading'' file. */ -/* The information below will make a lot more sense if you do. */ - -/* This is the routine used by SPICELIB to signal the detection */ -/* of errors. */ - -/* Making a call to SIGERR is the way to inform the error */ -/* handling mechanism that an error has occurred. */ - -/* Specifically, the effects of this routine are: */ - -/* 1. If responding to the error indicated by MSG has */ -/* not been disabled: */ - -/* a. MSG will be stored internally. As a result, */ -/* The SPICELIB routine, GETMSG, will be able to */ -/* retrieve MSG, until MSG has been ``erased'' */ -/* by a call to RESET, or overwritten by another */ -/* call to SIGERR. */ - -/* b. An indication of an ``error condition'' will */ -/* be set internally. The SPICELIB logical */ -/* function, FAILED, will take the value, .TRUE., */ -/* as a result, until the error condition is */ -/* negated by a call to RESET. */ - -/* c. All of the error messages that have been selected */ -/* for automatic output via ERRPRT will be output. */ -/* The set of messages is some subset of { short message, */ -/* long message, explanation of short message, */ -/* traceback, and default message }. */ - -/* d. If the error response mode is not 'RETURN', */ -/* Setting of the long error message is enabled. */ -/* You can't re-set the long error message, once */ -/* it has been set, without first signalling an error. */ - -/* e. In 'RETURN' mode, further signalling of error */ -/* messages, and setting of the long message, are disabled. */ -/* (These capabilities can be re-enabled by calling RESET). */ - - -/* 2. If the error handling mechanism has been commanded to */ -/* ``ignore'' the error indicated by MSG, the call to SIGERR */ -/* has no effect. */ - -/* If you wish to set the long error message, call */ -/* SETMSG BEFORE calling SIGERR. */ - - -/* $ Examples */ - - -/* 1. In the following example, N is supposed to be less than */ -/* MAXLUN. If it isn't, an error condition exists. */ - -/* C */ -/* C We will need a free logical unit. But only if we don't */ -/* C have too many files open already. */ -/* C */ - -/* IF ( N .EQ. MAXLUN ) THEN */ - -/* CALL SIGERR ( 'SPICE(TOOMANYFILESOPEN)' ) */ -/* RETURN */ - -/* END IF */ - - -/* 2. This time, we want to set the long error message, too. */ - - - -/* IF ( N .EQ. MAXLUN ) THEN */ - -/* CALL SETMSG ( 'RDTEXT: Can't open another file; ' // */ -/* . 'max number of files open at once ' // */ -/* . 'for reading by RDTEXT is 20' ) */ - -/* CALL SIGERR ( 'SPICE(TOOMANYFILESOPEN)' ) */ -/* RETURN */ - -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 26-JUL-1996 (KRG) */ - -/* The STOP statement in this subroutine has been replaced */ -/* with a call to the subroutine BYEBYE which passes a failure */ -/* status to the operating system or command shell/environment */ -/* on all platforms which support this capability. */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the error action from a short character string to an */ -/* integer. This change is backwardly incompatible because the */ -/* type has changed. */ - -/* - 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 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* signal error condition */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 26-JUL-1996 (KRG) */ - -/* The STOP statement in this subroutine has been replaced */ -/* with a call to the subroutine BYEBYE which passes a failure */ -/* status to the operating system or command shell/environment */ -/* on all platforms which support this capability. */ - -/* - SPICELIB Version 2.0.0, 22-APR-1996 (KRG) */ - -/* This subroutine has been modified in an attempt to improve */ -/* the general performance of the SPICELIB error handling */ -/* mechanism. The specific modification has been to change the */ -/* type of the error action from a short character string to an */ -/* integer. This change is backwardly incompatible because the */ -/* type has changed. */ - -/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* -& */ - -/* SPICELIB functions: */ - - -/* Local Parameters */ - -/* Define mnemonics for the integer action codes used by the error */ -/* handling. See ERRACT for the character string equivalents used. */ - - -/* Length for output messages default settings. */ - - -/* Local Variables: */ - - -/* Initial Values */ - -/* Define the default error message strings for OUTMSG. */ - - -/* We must first check whether the error indicated by */ -/* MSG is one we're supposed to ignore... */ - -/* There are two cases in which we do not want to respond */ -/* to the signalled error. */ - -/* 1. When the error action is 'IGNORE'. The user has */ -/* commanded that all messages be ignored. */ - -/* 2. When the error action is 'RETURN', and an error */ -/* condition already exists. We wish to preserve the */ -/* error data from the FIRST error until the user/ */ -/* user's program has reset the error status via */ -/* a call to RESET. */ - - getact_(&action); - if (action != 4) { - if (action != 3 || ! failed_()) { - -/* This one's for real. Indicate an error condition, and */ -/* store the short error message. */ - -/* Note: the following strange -- looking function */ -/* reference sets the toolkit error status. STAT */ -/* doesn't have any meaning. */ - - stat = seterr_(&c_true); - putsms_(msg, msg_len); - -/* Create a frozen copy of the traceback: */ - - freeze_(); - -/* Now we output the error data that are available at this */ -/* time, and whose output has been enabled. The choice of */ -/* data is any combination of the following: */ - -/* 1. The short error message */ -/* 2. The explanation of the short error message */ -/* 3. The traceback */ -/* 4. The long error message */ -/* 5. The default message */ - -/* Note that OUTMSG outputs only those messages which have */ -/* been SELECTED for output, via a call to ERRPRT, except */ -/* if the error action is DEFAULT. In that case, the */ -/* default message selection applies. */ - - if (action != 5) { - outmsg_(errmsg, (ftnlen)40); - } else { - outmsg_(defmsg, (ftnlen)40); - } - if (action == 3) { - -/* Don't accept new long error messages or updates */ -/* to current long error message: */ -/* (STAT has no meaning). */ - - stat = accept_(&c_false); - } else { - stat = accept_(&c_true); - } - } else { - stat = accept_(&c_false); - } - } - -/* We could be in ABORT or DEFAULT mode. */ - - if (action == 5 || action == 1) { - byebye_("FAILURE", (ftnlen)7); - } - -/* That's all, folks! */ - - return 0; -} /* sigerr_ */ - diff --git a/ext/spice/src/cspice/sigerr_c.c b/ext/spice/src/cspice/sigerr_c.c deleted file mode 100644 index b479e85523..0000000000 --- a/ext/spice/src/cspice/sigerr_c.c +++ /dev/null @@ -1,229 +0,0 @@ -/* - --Procedure sigerr_c ( Signal Error Condition ) - --Abstract - - Inform the CSPICE error processing mechanism that an error has - occurred, and specify the type of error. - --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 - - ERROR - --Keywords - - ERROR -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void sigerr_c ( ConstSpiceChar * message ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - msg I A short error message. - --Detailed_Input - - msg A ``short'' error message. - msg indicates the type of error that has occurred. - - Only the first 25 characters of msg will be stored; - additional characters will be truncated. - - Generally, msg will be stored internally by the CSPICE - error handling mechanism. The only exception - is the case in which the user has commanded the error - handling mechanism to ``ignore'' the error indicated by - msg. - - As a default, msg will be output to the standard output. - See the required reading file for a discussion of how - to customize CSPICE error handling behavior, and - in particular, the disposition of msg. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - This routine does not detect any errors. - - However, this routine is part of the interface to the - CSPICE error handling mechanism. For this reason, - this routine does not participate in the trace scheme, - even though it has external references. - --Files - - None. - --Particulars - - First of all, please read the ``required reading'' file. - The information below will make a lot more sense if you do. - - This is the routine used by CSPICE to signal the detection - of errors. - - Making a call to sigerr_c is the way to inform the error - handling mechanism that an error has occurred. - - Specifically, the effects of this routine are: - - 1. If responding to the error indicated by msg has - not been disabled: - - a. msg will be stored internally. As a result, - The CSPICE routine, getmsg, will be able to - retrieve msg, until msg has been ``erased'' - by a call to reset_c, or overwritten by another - call to sigerr_c. - - b. An indication of an ``error condition'' will - be set internally. The CSPICE logical - function, failed_c, will take the value, SPICETRUE, - as a result, until the error condition is - negated by a call to reset_c. - - c. All of the error messages that have been selected - for automatic output via errprt_c will be output. - The set of messages is some subset of { short message, - long message, explanation of short message, - traceback, and default message }. - - d. If the error response mode is not "RETURN", - Setting of the long error message is enabled. - You can't re-set the long error message, once - it has been set, without first signalling an error. - - e. In "RETURN" mode, further signalling of error - messages, and setting of the long message, are disabled. - (These capabilities can be re-enabled by calling RESET). - - - 2. If the error handling mechanism has been commanded to - ``ignore'' the error indicated by msg, the call to sigerr_c - has no effect. - - If you wish to set the long error message, call - setmsg_c BEFORE calling sigerr_c. - - --Examples - - - In the following example, an error is signaled because the - double precision variable x contains an invalid value. The - value of x and the maximum allowed value MAXVAL are substituted - into the error message at the locations indicated by the # signs - below. - - /. - Indicate that x is out of range if x is too large. - ./ - - if ( x > MAXVAL ) - { - setmsg_c ( "Variable x = #; maximum allowed value is #" ); - errdp_c ( "#", x ); - errdp_c ( "#", MAXVAL ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ) ; - return; - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.1.0, 23-JUL-2001 (NJB) - - Removed tab characters from source file. - - -CSPICE Version 1.2.1, 25-MAR-1998 (EDW) - - Minor corrections to header. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Made various header fixes. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - signal error condition - --& -*/ - -{ /* Begin sigerr_c */ - - - - /* - Check the input string to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "sigerr_c", message ); - - /* - Call the f2c'd Fortran routine. - */ - sigerr_ ( ( char * ) message, - ( ftnlen ) strlen(message) ); - - -} /* End sigerr_c */ diff --git a/ext/spice/src/cspice/signal1.h b/ext/spice/src/cspice/signal1.h deleted file mode 100644 index 360d8d0118..0000000000 --- a/ext/spice/src/cspice/signal1.h +++ /dev/null @@ -1,118 +0,0 @@ -/* - --Header_File signal1.h (CSPICE version of the f2c signal1.h header file) - --Abstract - - Define macros associated with signal handling, customized for the - host environment. - --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. - --Particulars - - This header defines the macro signal1 referenced in main.c, - which is a generic main routine used in CSPICE executables that - link to code generated by f2c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - 1) This header file must be updated whenever the f2c processor - or the f2c libraries libI77 and libF77 are updated. - - 2) This header may need to be updated to support new platforms. - The supported platforms at the time of the 03-FEB-2000 release - are: - - ALPHA-DIGITAL-UNIX_C - HP_C - NEXT_C - PC-LINUX_C - PC-MS_C - SGI-IRIX-N32_C - SGI-IRIX-NO2_C - SUN-SOLARIS-GCC_C - SUN-SOLARIS-NATIVE_C - --Version - - -CSPICE Version 1.0.0, 03-FEB-2000 (NJB) - -*/ - - - - -/* You may need to adjust the definition of signal1 to supply a */ -/* cast to the correct argument type. This detail is system- and */ -/* compiler-dependent. The #define below assumes signal.h declares */ -/* type SIG_PF for the signal function's second argument. */ - -#include - -#ifndef Sigret_t -#define Sigret_t void -#endif -#ifndef Sigarg_t -#ifdef KR_headers -#define Sigarg_t -#else -#ifdef __cplusplus -#define Sigarg_t ... -#else -#define Sigarg_t int -#endif -#endif -#endif /*Sigarg_t*/ - -#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ -#define sig_pf SIG_PF -#else -typedef Sigret_t (*sig_pf)(Sigarg_t); -#endif - -#define signal1(a,b) signal(a,(sig_pf)b) - -#ifdef __cplusplus -#define Sigarg ... -#define Use_Sigarg -#else -#define Sigarg Int n -#define Use_Sigarg n = n /* shut up compiler warning */ -#endif - diff --git a/ext/spice/src/cspice/signal_.c b/ext/spice/src/cspice/signal_.c deleted file mode 100644 index 9f243d86e6..0000000000 --- a/ext/spice/src/cspice/signal_.c +++ /dev/null @@ -1,15 +0,0 @@ -#include "f2c.h" -#include "signal1.h" - - ftnint -#ifdef KR_headers -signal_(sigp, proc) integer *sigp; sig_pf proc; -#else -signal_(integer *sigp, sig_pf proc) -#endif -{ - int sig; - sig = (int)*sigp; - - return (ftnint)signal(sig, proc); - } diff --git a/ext/spice/src/cspice/sincpt.c b/ext/spice/src/cspice/sincpt.c deleted file mode 100644 index 5b7f34b966..0000000000 --- a/ext/spice/src/cspice/sincpt.c +++ /dev/null @@ -1,2256 +0,0 @@ -/* sincpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b65 = 1e-14; - -/* $Procedure SINCPT ( Surface intercept ) */ -/* Subroutine */ int sincpt_(char *method, char *target, doublereal *et, char - *fixref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, - doublereal *spoint, doublereal *trgepc, doublereal *srfvec, logical * - found, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, - ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char loccor[5] = " "; - static char prvcor[5] = " "; - static logical usecn = FALSE_; - static logical uselt = FALSE_; - static logical usestl = FALSE_; - static logical xmit = FALSE_; - - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal dist, udir[3]; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - integer nitr; - extern doublereal vsep_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal rpos[3], tpos[3], j2dir[3], j2est[3], j2pos[3]; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal s, radii[3], range; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal pnear[3]; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal xform[9] /* was [3][3] */; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - doublereal j2geom[3], r2jmat[9] /* was [3][3] */, j2tmat[9] /* - was [3][3] */; - extern logical failed_(void); - integer dfrcde; - doublereal lt, etdiff; - integer fxfcde; - extern doublereal dasine_(doublereal *, doublereal *); - doublereal refepc; - integer nradii, obscde; - doublereal ltdiff; - extern doublereal clight_(void); - integer dclass; - doublereal maxrad, reject; - extern doublereal touchd_(doublereal *); - doublereal ltcent, negpos[3], rayalt, relerr, srflen, obspos[3], prevet, - stldir[3], trgdir[3]; - integer dcentr; - extern logical return_(void); - doublereal prevlt, ssbost[6], ssbtst[6], stlerr[3], stltmp[3]; - integer dtypid, fxcent, fxclss, fxtyid, trgcde; - logical attblk[15]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), sigerr_(char *, ftnlen), suffix_(char *, integer *, char - *, ftnlen, ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *), errint_( - char *, integer *, ftnlen), spkezp_(integer *, doublereal *, char - *, char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vminus_(doublereal *, doublereal *), pxform_(char *, char *, - doublereal *, doublereal *, ftnlen, ftnlen), spkssb_(integer *, - doublereal *, char *, doublereal *, ftnlen), stelab_(doublereal *, - doublereal *, doublereal *), stlabx_(doublereal *, doublereal *, - doublereal *), bodvcd_(integer *, char *, integer *, integer *, - doublereal *, ftnlen), surfpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, logical *) - , npedln_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *), vhatip_(doublereal *); - logical fnd; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Given an observer and a direction vector defining a ray, compute */ -/* the surface intercept of the ray on a target body at a specified */ -/* epoch, optionally corrected for light time and stellar */ -/* aberration. */ - -/* This routine supersedes SRFXPT. */ - -/* $ 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 */ - -/* FRAMES */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* FIXREF I Body-fixed, body-centered target body frame. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* DREF I Reference frame of ray's direction vector. */ -/* DVEC I Ray's direction vector. */ -/* SPOINT O Surface intercept point on the target body. */ -/* TRGEPC O Intercept epoch. */ -/* SRFVEC O Vector from observer to intercept point. */ -/* FOUND O Flag indicating whether intercept was found. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. */ - -/* The only choice currently supported is */ - -/* 'Ellipsoid' The intercept computation uses */ -/* a triaxial ellipsoid to model */ -/* the surface of the target body. */ -/* The ellipsoid's radii must be */ -/* available in the kernel pool. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string ' eLLipsoid ' is */ -/* valid. */ - -/* TARGET is the name of the target body. TARGET is */ -/* case-insensitive, and leading and trailing blanks in */ -/* TARGET are not significant. Optionally, you may */ -/* supply a string containing the integer ID code */ -/* for the object. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the Moon is the */ -/* target body. */ - -/* When the target body's surface is represented by a */ -/* tri-axial ellipsoid, this routine assumes that a */ -/* kernel variable representing the ellipsoid's radii is */ -/* present in the kernel pool. Normally the kernel */ -/* variable would be defined by loading a PCK file. */ - - -/* ET is the epoch of participation of the observer, */ -/* expressed as ephemeris seconds past J2000 TDB: ET is */ -/* the epoch at which the observer's state is computed. */ - -/* When aberration corrections are not used, ET is also */ -/* the epoch at which the state and orientation of the */ -/* target body are computed. */ - -/* When aberration corrections are used, the position */ -/* and orientation of the target body are computed at */ -/* ET-LT or ET+LT, where LT is the one-way light time */ -/* between the intercept point and the observer, and the */ -/* sign applied to LT depends on the selected */ -/* correction. See the description of ABCORR below for */ -/* details. */ - - -/* FIXREF is the name of the body-fixed, body-centered */ -/* reference frame associated with the target body. The */ -/* output intercept point SPOINT and the observer to */ -/* intercept vector SRFVEC will be expressed relative to */ -/* this reference frame. The string FIXREF is */ -/* case-insensitive, and leading and trailing blanks in */ -/* FIXREF are not significant. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the target's position and orientation. */ - -/* For remote sensing applications, where the apparent */ -/* surface intercept point seen by the observer is */ -/* desired, normally the correction */ - -/* 'CN+S' */ - -/* should be used. This and the other supported options */ -/* are described below. ABCORR may be any of the */ -/* following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric surface intercept point on the */ -/* target body. */ - -/* Let LT represent the one-way light time between the */ -/* observer and the surface intercept point (note: NOT */ -/* between the observer and the target body's center). */ -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* intercept point's location at the light-time */ -/* corrected epoch ET-LT and *arrive* at the observer's */ -/* location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the location of the surface */ -/* intercept point at the moment it */ -/* emitted photons arriving at the */ -/* observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* Both the target position as seen by the */ -/* observer, and rotation of the target */ -/* body, are corrected for light time. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* surface intercept obtained with the */ -/* 'LT' option to account for the */ -/* observer's velocity relative to the */ -/* solar system barycenter. These */ -/* computations yield the apparent surface */ -/* intercept point. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges. Both the */ -/* position and rotation of the target */ -/* body are corrected for light time. */ - -/* 'CN+S' Converged Newtonian light time and */ -/* stellar aberration corrections. This */ -/* option produces a solution that is at */ -/* least as accurate at that obtainable */ -/* with the 'LT+S' option. Whether the */ -/* 'CN+S' solution is substantially more */ -/* accurate depends on the geometry of the */ -/* participating objects and on the */ -/* accuracy of the input data. In all */ -/* cases this routine will execute more */ -/* slowly when a converged solution is */ -/* computed. */ - -/* For reception-case applications */ -/* involving intercepts near the target */ -/* body limb, this option should be used. */ - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* intercept point at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* intercept location at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'XLT' option uses one iteration. */ - -/* Both the target position as seen by the */ -/* observer, and rotation of the target */ -/* body, are corrected for light time. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* intercept obtained with the 'XLT' */ -/* option to account for the observer's */ -/* velocity relative to the solar system */ -/* barycenter. */ - -/* 'XCN' Converged Newtonian light time */ -/* correction. This is the same as XLT */ -/* correction but with further iterations */ -/* to a converged Newtonian light time */ -/* solution. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. This option */ -/* produces a solution that is at least as */ -/* accurate at that obtainable with the */ -/* 'XLT+S' option. Whether the 'XCN+S' */ -/* solution is substantially more accurate */ -/* depends on the geometry of the */ -/* participating objects and on the */ -/* accuracy of the input data. In all */ -/* cases this routine will execute more */ -/* slowly when a converged solution is */ -/* computed. */ - -/* For transmission-case applications */ -/* involving intercepts near the target */ -/* body limb, this option should be used. */ - -/* Case and embedded blanks are not significant in */ -/* ABCORR. For example, the string */ - -/* 'Cn + s' */ - -/* is valid. */ - - -/* OBSRVR is the name of the observing body. This is typically */ -/* a spacecraft, the earth, or a surface point on the */ -/* earth. OBSRVR is case-insensitive, and leading and */ -/* trailing blanks in OBSRVR are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'MOON' and '301' are legitimate strings that indicate */ -/* the Moon is the observer. */ - - -/* DREF is the name of the reference frame relative to which */ -/* the ray's direction vector is expressed. This may be */ -/* any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and */ -/* leading and trailing blanks in DREF are not */ -/* significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the */ -/* frame's center is located elsewhere, then letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* $ Detailed_Output */ - - -/* SPOINT is the surface intercept point on the target body of */ -/* the ray defined by the observer and the direction */ -/* vector. If the ray intersects the target body in */ -/* multiple points, the selected intersection point is */ -/* the one closest to the observer. The output argument */ -/* FOUND (see below) indicates whether an intercept was */ -/* found. */ - -/* SPOINT is expressed in Cartesian coordinates, */ -/* relative to the target body-fixed frame designated by */ -/* FIXREF. The body-fixed target frame is evaluated at */ -/* the intercept epoch TRGEPC (see description below). */ - -/* When light time correction is used, the duration of */ -/* light travel between SPOINT to the observer is */ -/* considered to be the one way light time. When both */ -/* light time and stellar aberration corrections are */ -/* used, SPOINT is selected such that, when SPOINT is */ -/* corrected for light time and stellar aberration, the */ -/* resulting vector is parallel to SPOINT lies on the */ -/* ray defined by the observer's location and DVEC. */ - -/* The components of SPOINT are given in units of km. */ - - -/* TRGEPC is the "intercept epoch." TRGEPC is defined as */ -/* follows: letting LT be the one-way light time between */ -/* the observer and the intercept point, TRGEPC is the */ -/* epoch ET-LT, ET+LT, or ET depending on whether the */ -/* requested aberration correction is, respectively, for */ -/* received radiation, transmitted radiation, or */ -/* omitted. LT is computed using the method indicated by */ -/* ABCORR. */ - -/* TRGEPC is expressed as seconds past J2000 TDB. */ - - -/* SRFVEC is the vector from the observer's position at ET to */ -/* the aberration-corrected (or optionally, geometric) */ -/* position of SPOINT, where the aberration corrections */ -/* are specified by ABCORR. SRFVEC is expressed in the */ -/* target body-fixed reference frame designated by */ -/* FIXREF, evaluated at TRGEPC. */ - -/* The components of SRFVEC are given in units of km. */ - -/* One can use the SPICELIB function VNORM to obtain the */ -/* distance between the observer and SPOINT: */ - -/* DIST = VNORM ( SRFVEC ) */ - -/* The observer's position OBSPOS, relative to the */ -/* target body's center, where the center's position is */ -/* corrected for aberration effects as indicated by */ -/* ABCORR, can be computed via the call: */ - -/* CALL VSUB ( SPOINT, SRFVEC, OBSPOS ) */ - -/* To transform the vector SRFVEC to a time-dependent */ -/* reference frame REF at ET, a sequence of two frame */ -/* transformations is required. For example, let MFIX */ -/* and MREF be 3x3 matrices respectively describing the */ -/* target body-fixed to J2000 frame transformation at */ -/* TRGEPC and the J2000 to (time-dependent frame) REF */ -/* transformation at ET, and let XFORM be the 3x3 matrix */ -/* representing the composition of MREF with MFIX. Then */ -/* SRFVEC can be transformed to the result REFVEC as */ -/* follows: */ - -/* CALL PXFORM ( FIXREF, 'J2000', TRGEPC, MFIX ) */ -/* CALL PXFORM ( 'J2000', REF, ET, MREF ) */ -/* CALL MXM ( MREF, MFIX, XFORM ) */ -/* CALL MXV ( XFORM, SRFVEC, REFVEC ) */ - -/* The second example in the Examples header section */ -/* below presents a complete program that demonstrates */ -/* this procedure. */ - - -/* FOUND A logical flag indicating whether or not the ray */ -/* intersects the target. If an intersection exists */ -/* FOUND will be returned as .TRUE. If the ray misses */ -/* the target, FOUND will be returned as .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) If the specified aberration correction is relativistic or */ -/* calls for stellar aberration but not light time correction, */ -/* the error SPICE(NOTSUPPORTED) is signaled. If the specified */ -/* aberration correction is any other unrecognized value, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 2) If either the target or observer input strings cannot be */ -/* converted to an integer ID code, the error */ -/* SPICE(IDCODENOTFOUND) is signaled. */ - -/* 3) If OBSRVR and TARGET map to the same NAIF integer ID code, */ -/* the error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If the input target body-fixed frame FIXREF is not */ -/* recognized, the error SPICE(NOFRAME) is signaled. A frame */ -/* name may fail to be recognized because a required frame */ -/* specification kernel has not been loaded; another cause is a */ -/* misspelling of the frame name. */ - -/* 5) If the input frame FIXREF is not centered at the target body, */ -/* the error SPICE(INVALIDFRAME) is signaled. */ - -/* 6) If the input argument METHOD is not recognized, the error */ -/* SPICE(INVALIDMETHOD) is signaled. */ - -/* 7) If the target and observer have distinct identities but are */ -/* at the same location (for example, the target is Mars and the */ -/* observer is the Mars barycenter), the error */ -/* SPICE(NOSEPARATION) is signaled. */ - -/* 8) If insufficient ephemeris data have been loaded prior to */ -/* calling SINCPT, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. Note that when */ -/* light time correction is used, sufficient ephemeris data must */ -/* be available to propagate the states of both observer and */ -/* target to the solar system barycenter. */ - -/* 9) If the computation method specifies an ellipsoidal target */ -/* shape and triaxial radii of the target body have not been */ -/* loaded into the kernel pool prior to calling SINCPT, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 10) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be */ -/* diagnosed and signaled by routines in the call tree of this */ -/* routine. */ - -/* 11) If PCK data specifying the target body-fixed frame */ -/* orientation have not been loaded prior to calling SINCPT, */ -/* the error will be diagnosed and signaled by a routine in the */ -/* call tree of this routine. */ - -/* 12) If the reference frame designated by DREF is not recognized */ -/* by the SPICE frame subsystem, the error SPICE(NOFRAME) */ -/* will be signaled. */ - -/* 13) If the direction vector DVEC is the zero vector, the error */ -/* SPICE(ZEROVECTOR) will be signaled. */ - - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: if the computation method is specified as */ -/* "Ellipsoid," triaxial radii for the target body must be */ -/* loaded into the kernel pool. Typically this is done by */ -/* loading a text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must */ -/* be loaded. These may be provided in a text or binary PCK */ -/* file. */ - -/* The following data may be required: */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the body-fixed frame of */ -/* the target, that definition must be available in the kernel */ -/* pool. Similarly, the frame definition required to map */ -/* between the frame designated by DREF and the target */ -/* body-fixed frame must be available. Typically the */ -/* definitions of frames not already built-in to SPICE are */ -/* supplied by loading a frame kernel. */ - -/* - CK data: if the frame to which DREF refers is fixed to a */ -/* spacecraft instrument or structure, at least one CK file */ -/* will be needed to permit transformation of vectors between */ -/* that frame and both the J2000 and the target body-fixed */ -/* frames. */ - -/* - SCLK data: if a CK file is needed, an associated SCLK */ -/* kernel is required to enable conversion between encoded SCLK */ -/* (used to time-tag CK data) and barycentric dynamical time */ -/* (TDB). */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* Given a ray defined by a direction vector and the location of an */ -/* observer, SINCPT computes the surface intercept point of the ray */ -/* on a specified target body. SINCPT also determines the vector */ -/* from the observer to the surface intercept point. */ - -/* When aberration corrections are used, this routine finds the */ -/* value of SPOINT such that, if SPOINT is regarded as an ephemeris */ -/* object, after the selected aberration corrections are applied to */ -/* the vector from the observer to SPOINT, the resulting vector is */ -/* parallel to the direction vector DVEC. */ - -/* This routine computes light time corrections using light time */ -/* between the observer and the surface intercept point, as opposed */ -/* to the center of the target. Similarly, stellar aberration */ -/* corrections done by this routine are based on the direction of */ -/* the vector from the observer to the light-time corrected */ -/* intercept point, not to the target center. This technique avoids */ -/* errors due to the differential between aberration corrections */ -/* across the target body. Therefore it's valid to use aberration */ -/* corrections with this routine even when the observer is very */ -/* close to the intercept point, in particular when the */ -/* observer-intercept point distance is much less than the */ -/* observer-target center distance. It's also valid to use stellar */ -/* aberration corrections even when the intercept point is near or */ -/* on the limb (as may occur in occultation computations using a */ -/* point target). */ - -/* When comparing surface intercept point computations with results */ -/* from sources other than SPICE, it's essential to make sure the */ -/* same geometric definitions are used. */ - -/* $ Examples */ - -/* The numerical results shown for this example may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) The following program computes surface intercept points on Mars */ -/* for the boresight and FOV boundary vectors of the MGS MOC */ -/* narrow angle camera. The intercepts are computed for a single */ -/* observation epoch. Light time and stellar aberration */ -/* corrections are used. For simplicity, camera distortion is */ -/* ignored. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File: mgs_example2.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de418.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ -/* mgs_moc_v20.ti MGS MOC instrument */ -/* parameters */ -/* mgs_sclkscet_00061.tsc MGS SCLK coefficients */ -/* mgs_sc_ext12.bc MGS s/c bus attitude */ -/* mgs_ext12_ipng_mgs95j.bsp MGS ephemeris */ - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls', */ -/* 'mgs_moc_v20.ti', */ -/* 'mgs_sclkscet_00061.tsc', */ -/* 'mgs_sc_ext12.bc', */ -/* 'mgs_ext12_ipng_mgs95j.bsp' ) */ -/* \begintext */ - - -/* Example code begins here. */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION VNORM */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'mgs_example2.tm' ) */ - -/* INTEGER ABCLEN */ -/* PARAMETER ( ABCLEN = 20 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 78 ) */ - -/* INTEGER METLEN */ -/* PARAMETER ( METLEN = 40 ) */ - -/* INTEGER NAMLEN */ -/* PARAMETER ( NAMLEN = 32 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER SHPLEN */ -/* PARAMETER ( SHPLEN = 80 ) */ - -/* INTEGER NCORNR */ -/* PARAMETER ( NCORNR = 4 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(ABCLEN) ABCORR */ -/* CHARACTER*(NAMLEN) CAMERA */ -/* CHARACTER*(NAMLEN) DREF */ -/* CHARACTER*(METLEN) METHOD */ -/* CHARACTER*(NAMLEN) OBSRVR */ -/* CHARACTER*(SHPLEN) SHAPE */ -/* CHARACTER*(NAMLEN) TARGET */ -/* CHARACTER*(LNSIZE) TITLE */ -/* CHARACTER*(TIMLEN) UTC */ - -/* DOUBLE PRECISION BOUNDS ( 3, NCORNR ) */ -/* DOUBLE PRECISION BSIGHT ( 3 ) */ -/* DOUBLE PRECISION DIST */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION DVEC ( 3 ) */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ - -/* INTEGER CAMID */ -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER N */ - -/* LOGICAL FOUND */ - -/* DATA ABCORR / 'CN+S' / */ -/* DATA CAMERA / 'MGS_MOC_NA'/ */ -/* DATA METHOD / 'Ellipsoid' / */ -/* DATA OBSRVR / 'MGS' / */ -/* DATA TARGET / 'Mars' / */ -/* DATA UTC / '2003 OCT 13 06:00:00 UTC' / */ - -/* C */ -/* C Load kernel files: */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Convert the UTC request time to ET (seconds past */ -/* C J2000, TDB). */ -/* C */ -/* CALL STR2ET ( UTC, ET ) */ - -/* C */ -/* C Get the MGS MOC Narrow angle camera (MGS_MOC_NA) */ -/* C ID code. Then look up the field of view (FOV) */ -/* C parameters by calling GETFOV. */ -/* C */ -/* CALL BODN2C ( CAMERA, CAMID, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* CALL SETMSG ( 'Could not find ID code for ' // */ -/* . 'instrument #.' ) */ -/* CALL ERRCH ( '#', CAMERA ) */ -/* CALL SIGERR ( 'SPICE(NOTRANSLATION)' ) */ -/* END IF */ - -/* C */ -/* C GETFOV will return the name of the camera-fixed frame */ -/* C in the string DREF, the camera boresight vector in */ -/* C the array BSIGHT, and the FOV corner vectors in the */ -/* C array BOUNDS. */ -/* C */ -/* CALL GETFOV ( CAMID, NCORNR, SHAPE, DREF, */ -/* . BSIGHT, N, BOUNDS ) */ - - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Surface Intercept Locations for Camera' */ -/* WRITE (*,*) 'FOV Boundary and Boresight Vectors' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Instrument: ', CAMERA */ -/* WRITE (*,*) ' Epoch: ', UTC */ -/* WRITE (*,*) ' Aberration correction: ', ABCORR */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Now compute and display the surface intercepts for the */ -/* C boresight and all of the FOV boundary vectors. */ -/* C */ -/* DO I = 1, NCORNR+1 */ - -/* IF ( I .LE. NCORNR ) THEN */ - -/* TITLE = 'Corner vector #' */ -/* CALL REPMI ( TITLE, '#', I, TITLE ) */ - -/* CALL VEQU ( BOUNDS(1,I), DVEC ) */ - -/* ELSE */ - -/* TITLE = 'Boresight vector' */ -/* CALL VEQU ( BSIGHT, DVEC ) */ - -/* END IF */ - -/* C */ -/* C Compute the surface intercept point using */ -/* C the specified aberration corrections. */ -/* C */ -/* CALL SINCPT ( METHOD, TARGET, ET, 'IAU_MARS', */ -/* . ABCORR, OBSRVR, DREF, DVEC, */ -/* . SPOINT, TRGEPC, SRFVEC, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* C */ -/* C Compute range from observer to apparent intercept. */ -/* C */ -/* DIST = VNORM ( SRFVEC ) */ -/* C */ -/* C Convert rectangular coordinates to planetocentric */ -/* C latitude and longitude. Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */ - -/* LON = LON * DPR () */ -/* LAT = LAT * DPR () */ -/* C */ -/* C Display the results. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) TITLE */ - -/* TITLE = ' Vector in # frame = ' */ -/* CALL REPMC ( TITLE, '#', DREF, TITLE ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) TITLE */ - -/* IF ( I .LE. NCORNR ) THEN */ -/* WRITE (*,*) ' ', ( BOUNDS(J,I), J = 1, 3 ) */ -/* ELSE */ -/* WRITE (*,*) ' ', BSIGHT */ -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Intercept:' */ -/* WRITE (*,*) */ -/* . ' Radius (km) = ', RADIUS */ -/* WRITE (*,*) */ -/* . ' Planetocentric Latitude (deg) = ', LAT */ -/* WRITE (*,*) */ -/* . ' Planetocentric Longitude (deg) = ', LON */ -/* WRITE (*,*) */ -/* . ' Range (km) = ', DIST */ -/* WRITE (*,*) ' ' */ - -/* ELSE */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Intercept not found.' */ -/* WRITE (*,*) ' ' */ - -/* END IF */ - -/* END DO */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - -/* Surface Intercept Locations for Camera */ -/* FOV Boundary and Boresight Vectors */ - -/* Instrument: MGS_MOC_NA */ -/* Epoch: 2003 OCT 13 06:00:00 UTC */ -/* Aberration correction: CN+S */ - - -/* Corner vector 1 */ - -/* Vector in MGS_MOC_NA frame = */ -/* 1.85713838E-06 -0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.94114 */ -/* Planetocentric Latitude (deg) = -48.4774819 */ -/* Planetocentric Longitude (deg) = -123.474079 */ -/* Range (km) = 388.983104 */ - - -/* Corner vector 2 */ - -/* Vector in MGS_MOC_NA frame = */ -/* 1.85713838E-06 0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.9397 */ -/* Planetocentric Latitude (deg) = -48.4816363 */ -/* Planetocentric Longitude (deg) = -123.398823 */ -/* Range (km) = 388.975121 */ - - -/* Corner vector 3 */ - -/* Vector in MGS_MOC_NA frame = */ -/* -1.85713838E-06 0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.93969 */ -/* Planetocentric Latitude (deg) = -48.4816619 */ -/* Planetocentric Longitude (deg) = -123.398826 */ -/* Range (km) = 388.974662 */ - - -/* Corner vector 4 */ - -/* Vector in MGS_MOC_NA frame = */ -/* -1.85713838E-06 -0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.94113 */ -/* Planetocentric Latitude (deg) = -48.4775075 */ -/* Planetocentric Longitude (deg) = -123.474082 */ -/* Range (km) = 388.982645 */ - - -/* Boresight vector */ - -/* Vector in MGS_MOC_NA frame = */ -/* 0. 0. 1. */ - -/* Intercept: */ -/* Radius (km) = 3384.94041 */ -/* Planetocentric Latitude (deg) = -48.4795798 */ -/* Planetocentric Longitude (deg) = -123.436454 */ -/* Range (km) = 388.975736 */ - - - -/* 2) Use SUBPNT to find the sub-spacecraft point on Mars for the */ -/* Mars Reconnaissance Orbiter spacecraft (MRO) at a specified */ -/* time, using the "near point: ellipsoid" computation method. */ -/* Use both LT+S and CN+S aberration corrections to illustrate */ -/* the differences. */ - -/* Convert the spacecraft to sub-observer point vector obtained */ -/* from SUBPNT into the MRO_HIRISE_LOOK_DIRECTION reference frame */ -/* at the observation time. Perform a consistency check with this */ -/* vector: compare the Mars surface intercept of the ray */ -/* emanating from the spacecraft and pointed along this vector */ -/* with the sub-observer point. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File: mro_example.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de418.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ -/* mro_psp4_ssd_mro95a.bsp MRO ephemeris */ -/* mro_v11.tf MRO frame specifications */ -/* mro_sclkscet_00022_65536.tsc MRO SCLK coefficients and */ -/* parameters */ -/* mro_sc_psp_070925_071001.bc MRO attitude */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls', */ -/* 'mro_psp4_ssd_mro95a.bsp', */ -/* 'mro_v11.tf', */ -/* 'mro_sclkscet_00022_65536.tsc', */ -/* 'mro_sc_psp_070925_071001.bc' ) */ -/* \begintext */ - - -/* Example code begins here. */ - - -/* PROGRAM EX2 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION VDIST */ -/* DOUBLE PRECISION VNORM */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'mro_example.tm' ) */ - -/* CHARACTER*(*) F1 */ -/* PARAMETER ( F1 = '(A,F21.9)' ) */ - -/* CHARACTER*(*) F2 */ -/* PARAMETER ( F2 = '(A)' ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER MTHLEN */ -/* PARAMETER ( MTHLEN = 50 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 5 ) */ - -/* INTEGER NCORR */ -/* PARAMETER ( NCORR = 2 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR ( NCORR ) */ -/* CHARACTER*(FRNMLN) HIREF */ -/* CHARACTER*(MTHLEN) METHOD */ - -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION MROVEC ( 3 ) */ -/* DOUBLE PRECISION R1 ( 3, 3 ) */ -/* DOUBLE PRECISION R2 ( 3, 3 ) */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ -/* DOUBLE PRECISION XFORM ( 3, 3 ) */ -/* DOUBLE PRECISION XEPOCH */ -/* DOUBLE PRECISION XPOINT ( 3 ) */ -/* DOUBLE PRECISION XVEC ( 3 ) */ - -/* INTEGER I */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Initial values */ -/* C */ -/* DATA ABCORR / 'LT+S', 'CN+S' / */ -/* C */ -/* C Load kernel files via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Convert the TDB request time string to seconds past */ -/* C J2000, TDB. */ -/* C */ -/* CALL STR2ET ( '2007 SEP 30 00:00:00 TDB', ET ) */ - -/* C */ -/* C Compute the sub-spacecraft point using the */ -/* C "NEAR POINT: ELLIPSOID" definition. */ -/* C Compute the results using both LT+S and CN+S */ -/* C aberration corrections. */ -/* C */ -/* METHOD = 'Near point: ellipsoid' */ - -/* WRITE(*,F2) ' ' */ -/* WRITE(*,F2) 'Computation method = '//METHOD */ - -/* DO I = 1, NCORR */ - -/* CALL SUBPNT ( METHOD, */ -/* . 'Mars', ET, 'IAU_MARS', ABCORR(I), */ -/* . 'MRO', SPOINT, TRGEPC, SRFVEC ) */ -/* C */ -/* C Compute the observer's altitude above SPOINT. */ -/* C */ -/* ALT = VNORM ( SRFVEC ) */ -/* C */ -/* C Express SRFVEC in the MRO_HIRISE_LOOK_DIRECTION */ -/* C reference frame at epoch ET. Since SRFVEC is expressed */ -/* C relative to the IAU_MARS frame at TRGEPC, we must */ -/* C compose two transformations: that from IAU_MARS to */ -/* C J2000 at TRGEPC, followed by the transformation from */ -/* C J2000 to MRO_HIRISE_LOOK_DIRECTION at ET. */ -/* C (We could use any other inertial frame in place */ -/* C of J2000; the result would be the same.) */ -/* C */ -/* C To make code formatting a little easier, we'll store */ -/* C the long MRO reference frame name in a variable: */ -/* C */ -/* HIREF = 'MRO_HIRISE_LOOK_DIRECTION' */ - -/* CALL PXFORM ( 'IAU_MARS', 'J2000', TRGEPC, R1 ) */ -/* CALL PXFORM ( 'J2000', HIREF, ET, R2 ) */ - -/* CALL MXM ( R2, R1, XFORM ) */ -/* CALL MXV ( XFORM, SRFVEC, MROVEC ) */ - -/* C */ -/* C Convert rectangular coordinates to planetocentric */ -/* C latitude and longitude. Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */ - -/* LON = LON * DPR () */ -/* LAT = LAT * DPR () */ -/* C */ -/* C Write the results. */ -/* C */ -/* WRITE(*,F2) ' ' */ -/* WRITE(*,F2) 'Aberration correction = '//ABCORR(I) */ -/* WRITE(*,F1) ' ' */ -/* WRITE(*,F2) ' MRO-to-sub-observer vector in' */ -/* WRITE(*,F2) ' MRO HIRISE look direction frame' */ -/* WRITE(*,F1) ' X-component (km) = ', */ -/* . MROVEC(1) */ -/* WRITE(*,F1) ' Y-component (km) = ', */ -/* . MROVEC(2) */ -/* WRITE(*,F1) ' Z-component (km) = ', */ -/* . MROVEC(3) */ -/* WRITE(*,F1) ' Sub-observer point radius (km) = ', RADIUS */ -/* WRITE(*,F1) ' Planetocentric latitude (deg) = ', LAT */ -/* WRITE(*,F1) ' Planetocentric longitude (deg) = ', LON */ -/* WRITE(*,F1) ' Observer altitude (km) = ', ALT */ - -/* C */ -/* C Consistency check: find the surface intercept on */ -/* C Mars of the ray emanating from the spacecraft and having */ -/* C direction vector MROVEC in the MRO HIRISE look direction */ -/* C reference frame at ET. Call the intercept point */ -/* C XPOINT. XPOINT should coincide with SPOINT, up to a */ -/* C small round-off error. */ -/* C */ -/* CALL SINCPT ( 'Ellipsoid', 'Mars', ET, 'IAU_MARS', */ -/* . ABCORR(I), 'MRO', HIREF, MROVEC, */ -/* . XPOINT, XEPOCH, XVEC, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,F1) 'Bug: no intercept' */ -/* ELSE */ -/* C */ -/* C Report the distance between XPOINT and SPOINT. */ -/* C */ -/* WRITE (*,F1) ' Intercept comparison error (km) = ', */ -/* . VDIST( XPOINT, SPOINT ) */ -/* END IF */ - -/* WRITE(*,F1) ' ' */ - -/* END DO */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Computation method = Near point: ellipsoid */ - -/* Aberration correction = LT+S */ - -/* MRO-to-sub-observer vector in */ -/* MRO HIRISE look direction frame */ -/* X-component (km) = 0.286931987 */ -/* Y-component (km) = -0.260417167 */ -/* Z-component (km) = 253.816284981 */ -/* Sub-observer point radius (km) = 3388.299078207 */ -/* Planetocentric latitude (deg) = -38.799836879 */ -/* Planetocentric longitude (deg) = -114.995294746 */ -/* Observer altitude (km) = 253.816580760 */ -/* Intercept comparison error (km) = 0.000002144 */ - - -/* Aberration correction = CN+S */ - -/* MRO-to-sub-observer vector in */ -/* MRO HIRISE look direction frame */ -/* X-component (km) = 0.286931866 */ -/* Y-component (km) = -0.260417914 */ -/* Z-component (km) = 253.816274506 */ -/* Sub-observer point radius (km) = 3388.299078205 */ -/* Planetocentric latitude (deg) = -38.799836883 */ -/* Planetocentric longitude (deg) = -114.995294968 */ -/* Observer altitude (km) = 253.816570285 */ -/* Intercept comparison error (km) = 0.000000001 */ - - -/* $ Restrictions */ - -/* A cautionary note: if aberration corrections are used, and */ -/* if DREF is the target body-fixed frame, the epoch at which that */ -/* frame is evaluated is offset from ET by the light time between */ -/* the observer and the *center* of the target body. This light time */ -/* normally will differ from the light time between the observer and */ -/* intercept point. Consequently the orientation of the target */ -/* body-fixed frame at TRGEPC will not match that of the target */ -/* body-fixed frame at the epoch associated with DREF. As a result, */ -/* various derived quantities may not be as expected: for example, */ -/* SRFVEC would not be parallel to DVEC. */ - -/* In many applications the errors arising from this frame */ -/* discrepancy may be insignificant; however a safe approach is to */ -/* always use as DREF a frame other than the target body-fixed */ -/* frame. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-APR-2010 (NJB) */ - -/* Code style improvement: re-use of variables in */ -/* FRINFO calls has been eliminated. There is no impact */ -/* of the behavior of the routine. */ - -/* - SPICELIB Version 1.1.0, 17-MAR-2009 (NJB)(EDW) */ - -/* Bug fix: quick test for non-intersection is */ -/* no longer performed when observer-target distance */ -/* is less than target's maximum radius. */ - -/* Typos in the Detailed Input section's description of DREF */ -/* were corrected. */ - -/* In the header examples, meta-kernel names were updated to use */ -/* the suffix */ - -/* ".tm" */ - -/* Incorrect frame name FIXFRM was changed to FIXREF in */ -/* documentation. */ - -/* Typo correction in Required_Reading, changed FRAME */ -/* to FRAMES. */ - -/* - SPICELIB Version 1.0.0, 02-MAR-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find surface intercept point */ -/* find intersection of ray and target body surface */ -/* find intercept of ray on target body surface */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* This value will become system-dependent when systems */ -/* using 128-bit d.p. numbers are supported by SPICELIB. */ -/* CNVLIM, when added to 1.0D0, should yield 1.0D0. */ - - -/* Round-off error limit for arc sine input: */ - - -/* Fraction of target body angular radius used to define */ -/* region outside of which rays are immediately rejected */ -/* as non-intersecting. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SINCPT", (ftnlen)6); - -/* Nothing has been found yet. */ - - *found = FALSE_; - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Reject an aberration correction flag calling for stellar */ -/* aberration but not light time correction. */ - - if (attblk[2] && ! attblk[1]) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SINCPT", (ftnlen)6); - return 0; - } else if (attblk[5]) { - -/* Also reject flags calling for relativistic corrections. */ - - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is valid; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* USESTL indicates stellar aberration corrections. */ - - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - -/* The variable LOCCOR will contain a representation of */ -/* the aberration correction specification with stellar */ -/* aberration omitted. */ - - if (attblk[0]) { - s_copy(loccor, "NONE", (ftnlen)5, (ftnlen)4); - } else { - if (xmit) { - s_copy(loccor, "X", (ftnlen)5, (ftnlen)1); - } else { - s_copy(loccor, " ", (ftnlen)5, (ftnlen)1); - } - if (usecn) { - suffix_("CN", &c__0, loccor, (ftnlen)2, (ftnlen)5); - } else if (uselt) { - suffix_("LT", &c__0, loccor, (ftnlen)2, (ftnlen)5); - } - } - } - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &fnd, target_len); - if (! fnd) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - bods2c_(obsrvr, &obscde, &fnd, obsrvr_len); - if (! fnd) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the surface intercept point, the observing bod" - "y and target body are the same. Both are #.", (ftnlen)102); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Determine the attributes of the frame designated by FIXREF. */ - - namfrm_(fixref, &fxfcde, fixref_len); - frinfo_(&fxfcde, &fxcent, &fxclss, &fxtyid, &fnd); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - if (! fnd) { - setmsg_("Reference frame # is not recognized by the SPICE frame subs" - "ystem. Possibly a required frame definition kernel has not b" - "een loaded.", (ftnlen)130); - errch_("#", fixref, (ftnlen)1, fixref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Make sure that FIXREF is centered at the target body's center. */ - - if (fxcent != trgcde) { - setmsg_("Reference frame # is not centered at the target body #. The" - " ID code of the frame center is #.", (ftnlen)93); - errch_("#", fixref, (ftnlen)1, fixref_len); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", &fxcent, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Check for a zero ray direction vector. */ - - if (vzero_(dvec)) { - setmsg_("Input ray direction was the zero vector; this vector must b" - "e non-zero.", (ftnlen)70); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Get the sign S prefixing LT in the expression for TRGEPC. */ -/* When light time correction is not used, setting S = 0 */ -/* allows us to seamlessly set TRGEPC equal to ET. */ - - if (uselt) { - if (xmit) { - s = 1.; - } else { - s = -1.; - } - } else { - s = 0.; - } - -/* Determine the position of the observer in target */ -/* body-fixed coordinates. */ - -/* - Call SPKEZP to compute the position of the target body as */ -/* seen from the observing body and the light time (LT) */ -/* between them. We request that the coordinates of POS be */ -/* returned relative to the body fixed reference frame */ -/* associated with the target body, using aberration */ -/* corrections specified by LOCCOR; these are the corrections */ -/* the input argument ABCORR, minus the stellar aberration */ -/* correction if it was called for. */ - -/* - Call VMINUS to negate the direction of the vector (OBSPOS) */ -/* so it will be the position of the observer as seen from */ -/* the target body in target body fixed coordinates. */ - -/* Note that this result is not the same as the result of */ -/* calling SPKEZP with the target and observer switched. We */ -/* computed the vector FROM the observer TO the target in */ -/* order to get the proper light time and stellar aberration */ -/* corrections (if requested). Now we need the inverse of */ -/* that corrected vector in order to compute the intercept */ -/* point. */ - - spkezp_(&trgcde, et, fixref, loccor, &obscde, tpos, <, fixref_len, ( - ftnlen)5); - -/* Negate the target's position to obtain the position of the */ -/* observer relative to the target. */ - - vminus_(tpos, obspos); - -/* We now need to convert the direction vector into the */ -/* body fixed frame associated with the target. The target */ -/* epoch is dependent on the aberration correction. The */ -/* coefficient S has been set to give us the correct answer */ -/* for each case. */ - - *trgepc = *et + s * lt; - -/* Determine the attributes of the frame designated by DREF. */ - - namfrm_(dref, &dfrcde, dref_len); - frinfo_(&dfrcde, &dcentr, &dclass, &dtypid, &fnd); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - if (! fnd) { - setmsg_("Reference frame # is not recognized by the SPICE frame subs" - "ystem. Possibly a required frame definition kernel has not b" - "een loaded.", (ftnlen)130); - errch_("#", dref, (ftnlen)1, dref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Transform the direction vector from frame DREF to the body-fixed */ -/* frame associated with the target. The epoch TRGEPC associated */ -/* with the body-fixed frame has been set already. */ - -/* We'll compute the transformation in two parts: first */ -/* from frame DREF to J2000, then from J2000 to the target */ -/* frame. */ - - if (dclass == 1) { - -/* Inertial frames can be evaluated at any epoch. */ - - refepc = *et; - } else if (! uselt) { - -/* We're not using light time corrections (converged or */ -/* otherwise), so there's no time offset. */ - - refepc = *et; - } else if (dcentr == obscde) { - -/* If the center of frame DREF is the observer (which is */ -/* usually the case if the observer is a spacecraft), then */ -/* the epoch of frame DREF is simply ET. */ - -/* There's no offset between the center for frame DREF */ -/* and the observer. */ - - refepc = *et; - } else { - -/* Find the light time from the observer to the center of */ -/* frame DREF. */ - - spkezp_(&dcentr, et, "J2000", abcorr, &obscde, rpos, <cent, (ftnlen) - 5, abcorr_len); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - refepc = *et + s * ltcent; - } - -/* The epoch REFEPC associated with frame DREF has been set. */ - -/* Compute the transformation from frame DREF to J2000 and the */ -/* transformation from J2000 to the target body-fixed frame. */ - -/* Map DVEC to both the J2000 and target body-fixed frames. We'll */ -/* store DVEC, expressed relative to the J2000 frame, in the */ -/* variable J2DIR. DVEC in the target body-fixed frame will be */ -/* stored in TRGDIR. */ - -/* We may need both versions of DVEC: if we use light time */ -/* correction, we'll update "intercept epoch", and hence the */ -/* transformation between J2000 and the target body-fixed frame. */ -/* The transformation between DREF and J2000 doesn't change, on the */ -/* other hand, so we don't have to recompute J2DIR. We need TRGDIR */ -/* in all cases. */ - - pxform_(dref, "J2000", &refepc, r2jmat, dref_len, (ftnlen)5); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - mxv_(r2jmat, dvec, j2dir); - -/* Save this version of J2DIR as J2GEOM. Later we'll */ -/* modify J2DIR, if necessary, to account for stellar */ -/* aberration. */ - - vequ_(j2dir, j2geom); - -/* Map J2DIR (in the J2000 frame) to the target body-fixed */ -/* frame. */ - - pxform_("J2000", fixref, trgepc, j2tmat, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - mxv_(j2tmat, j2dir, trgdir); - -/* At this point, */ - -/* TRGEPC is set. */ -/* TRGDIR is set. */ -/* J2DIR is set. */ - - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. We'll use this in */ -/* several places later. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - -/* If we're using stellar aberration correction, at this point we'll */ -/* account for it. We're going to find a surface point such that */ -/* the radiation path from that point to the observer, after */ -/* correction for stellar aberration, is parallel to the ray. So */ -/* by applying the inverse of the correction to the ray, we obtain */ -/* the ray with which we must perform our intercept computation. */ - - if (usestl) { - -/* We approximate the inverse stellar aberration correction by */ -/* using the correction for the reverse transmission direction. */ -/* If we're in the reception case, we apply the transmission */ -/* stellar aberration correction to J2DIR and vice versa. */ - -/* We iterate our estimates until we have the desired level */ -/* of convergence or reach the iteration limit. */ - - nitr = 5; - if (xmit) { - -/* Use reception stellar aberration correction */ -/* routine STELAB to generate a first estimate of */ -/* the direction vector after stellar aberration */ -/* has been "removed"---that is, apply the inverse */ -/* of the transmission stellar aberration correction */ -/* mapping to J2DIR. */ - - stelab_(j2dir, &ssbost[3], stldir); - -/* Now improve our estimate. */ - - relerr = 1.; - i__ = 1; - while(i__ <= nitr && relerr > 1e-17) { - -/* Estimate the error in our previous approximation */ -/* by applying the reception stellar aberration */ -/* to STLDIR and finding the difference with J2DIR. */ - - stlabx_(stldir, &ssbost[3], j2est); - vsub_(j2dir, j2est, stlerr); - -/* Adding the error in the reception mapping to STLDIR */ -/* will give us an improved estimate of the inverse. */ - - vadd_(stlerr, stldir, stltmp); - vequ_(stltmp, stldir); - relerr = vnorm_(stlerr) / vnorm_(stldir); - ++i__; - } - -/* At this point we've found a good estimate of the */ -/* direction vector under the inverse of the transmission */ -/* stellar aberration correction mapping. */ - - } else { - -/* Use transmission stellar aberration correction */ -/* routine STLABX to generate a first estimate of */ -/* the direction vector after stellar aberration */ -/* has been "removed." */ - - stlabx_(j2dir, &ssbost[3], stldir); - -/* Now improve our estimate. */ - - relerr = 1.; - i__ = 1; - while(i__ <= nitr && relerr > 1e-17) { - -/* Estimate the error in our previous approximation */ -/* by applying the reception stellar aberration */ -/* to STLDIR and finding the difference with J2DIR. */ - - stelab_(stldir, &ssbost[3], j2est); - vsub_(j2dir, j2est, stlerr); - -/* Adding the error in the reception mapping to STLDIR */ -/* will give us an improved estimate of the inverse. */ - - vadd_(stlerr, stldir, stltmp); - vequ_(stltmp, stldir); - relerr = vnorm_(stlerr) / vnorm_(stldir); - ++i__; - } - -/* At this point we've found a good estimate of the */ -/* direction vector under the inverse of the reception */ -/* stellar aberration correction mapping. */ - - } - -/* Replace the J2000-relative ray direction with the corrected */ -/* direction. */ - - vequ_(stldir, j2dir); - mxv_(j2tmat, j2dir, trgdir); - } - -/* Find the surface intercept point and distance from observer to */ -/* intercept point using the specified geometric definition. */ - - if (eqstr_(method, "Ellipsoid", method_len, (ftnlen)9)) { - -/* Find the surface intercept given the target epoch, */ -/* observer-target position, and target body orientation */ -/* we've already computed. If we're not using light */ -/* time correction, this is all we must do. Otherwise, */ -/* our result will give us an initial estimate of the */ -/* target epoch, which we'll then improve. */ - -/* Get the radii of the target body from the kernel pool. */ - - bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5); - -/* Make an easy test to see whether we can quit now because */ -/* an intercept cannot exist. If the ray is separated from */ -/* the observer-target center vector by more than (MARGIN * */ -/* the maximum triaxial radius), we're done. Let REJECT be */ -/* the angular separation limit. */ - -/* Computing MAX */ - d__1 = max(radii[0],radii[1]); - maxrad = max(d__1,radii[2]); - range = vnorm_(obspos); - if (range == 0.) { - -/* We've already ensured that observer and target are */ -/* distinct, so this should be a very unusual occurrence. */ - - setmsg_("Observer-target distance is zero. Observer is #; target" - " is #.", (ftnlen)61); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOSEPARATION)", (ftnlen)19); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - if (range > maxrad * 1.01) { - -/* Compute the arc sine with SPICE error checking. */ - - d__1 = maxrad * 1.01 / range; - reject = dasine_(&d__1, &c_b65); - vminus_(obspos, negpos); - if (vsep_(negpos, trgdir) > reject) { - -/* The angular separation of ray and target is too great */ -/* for a solution to exist, even with a better light time */ -/* estimate. */ - - chkout_("SINCPT", (ftnlen)6); - return 0; - } - } - -/* Locate the intercept of the ray with the target; if there's no */ -/* intercept, find the closest point on the target to the ray. */ - - surfpt_(obspos, trgdir, radii, &radii[1], &radii[2], spoint, found); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* If we found an intercept, and if we're not using light time */ -/* corrections, we're almost done now. We still need SRFVEC. */ -/* SPOINT, TRGEPC, and FOUND have already been set. */ - - if (*found && ! uselt) { - vsub_(spoint, obspos, srfvec); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* From this point onward, we're dealing with a case calling for */ -/* light time and possibly stellar aberration corrections. */ - - if (! (*found)) { - -/* If there's no intercept, we're probably done. However, */ -/* we need to guard against the possibility that the ray does */ -/* intersect the ellipsoid but we haven't discovered it */ -/* because our first light time estimate was too poor. */ - -/* We'll make an improved light time estimate as follows: */ -/* Find the nearest point on the ellipsoid to the ray. Find */ -/* the light time between the observer and this point. */ - -/* If we're using converged Newtonian corrections, we */ -/* iterate this procedure up to three times. */ - - if (usecn) { - nitr = 3; - } else { - nitr = 1; - } - i__ = 1; - while(i__ <= nitr && ! (*found)) { - npedln_(radii, &radii[1], &radii[2], obspos, trgdir, pnear, & - rayalt); - lt = vdist_(obspos, pnear) / clight_(); - -/* Use the new light time estimate to repeat the intercept */ -/* computation. */ - - *trgepc = *et + s * lt; - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", fixref, trgepc, xform, (ftnlen)5, fixref_len) - ; - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Convert the observer's position relative to the target */ -/* from the J2000 frame to the target frame at the target */ -/* epoch. */ - - mxv_(xform, j2pos, obspos); - -/* Convert the ray's direction vector from the J2000 frame */ -/* to the target frame at the target epoch. */ - - mxv_(xform, j2dir, trgdir); - -/* Repeat the intercept computation. */ - - surfpt_(obspos, trgdir, radii, &radii[1], &radii[2], spoint, - found); - ++i__; - } - -/* If there's still no intercept, we're done. */ - - if (! (*found)) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - } - -/* Making it to this point means we've got an intersection. */ - -/* Since we're using light time corrections, we're going to make */ -/* an estimate of light time to the intercept point, then re-do */ -/* our computation of the target position and orientation using */ -/* the new light time value. */ - - if (usecn) { - nitr = 10; - } else { - nitr = 1; - } - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - -/* Compute new light time estimate and new target epoch. */ - - dist = vdist_(obspos, spoint); - lt = dist / clight_(); - *trgepc = *et + s * lt; - prevlt = 0.; - prevet = *trgepc; - i__ = 0; - ltdiff = 1.; - etdiff = 1.; - while(i__ < nitr && ltdiff > abs(lt) * 1e-17 && etdiff > 0.) { - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", fixref, trgepc, xform, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Convert the observer's position relative to the target from */ -/* the J2000 frame to the target frame at the target epoch. */ - - mxv_(xform, j2pos, obspos); - vminus_(obspos, negpos); - -/* Convert the ray's direction vector from the J2000 frame */ -/* to the target frame at the target epoch. */ - - mxv_(xform, j2dir, trgdir); - -/* Repeat the intercept computation. */ - - surfpt_(obspos, trgdir, radii, &radii[1], &radii[2], spoint, - found); - -/* If there's no intercept, we're done. */ - - if (! (*found)) { - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* Compute the distance between intercept and observer. */ - - dist = vdist_(obspos, spoint); - -/* Compute new light time estimate and new target epoch. */ - - lt = dist / clight_(); - *trgepc = *et + s * lt; - -/* We use the d.p. identity function TOUCHD to force the */ -/* compiler to create double precision arguments from the */ -/* differences LT-PREVLT and TRGEPC-PREVET. Some compilers */ -/* will perform extended-precision register arithmetic, which */ -/* can prevent a difference from rounding to zero. Simply */ -/* storing the result of the subtraction in a double precision */ -/* variable doesn't solve the problem, because that variable */ -/* can be optimized out of existence. */ - - d__2 = lt - prevlt; - ltdiff = (d__1 = touchd_(&d__2), abs(d__1)); - d__2 = *trgepc - prevet; - etdiff = (d__1 = touchd_(&d__2), abs(d__1)); - prevlt = lt; - prevet = *trgepc; - ++i__; - } - } else { - setmsg_("The computation method # was not recognized. ", (ftnlen)45); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SINCPT", (ftnlen)6); - return 0; - } - -/* FOUND, SPOINT, TRGEPC, and OBSPOS have been set at this point. */ -/* We need SRFVEC. Since OBSPOS doesn't take into account stellar */ -/* aberration, we can' derive SRFVEC from OBSPOS as is done in */ -/* the related routines SUBPNT and SUBSLR. Here, we derive */ -/* SRFVEC from J2GEOM, which is the input ray direction expressed in */ -/* the J2000 frame. We use XFORM, which is computed in the loop */ -/* above, to convert J2GEOM to FIXREF, evaluated at TRGEPC. */ - - mxv_(xform, j2geom, udir); - vhatip_(udir); - -/* Let SRFLEN be the length of SRFVEC; we CAN get this */ -/* length from OBSPOS and SPOINT, since stellar */ -/* aberration correction (as implemented in SPICE) */ -/* doesn't change the length of the vector SPOINT-OBSPOS. */ - - srflen = vdist_(spoint, obspos); - -/* Scale UDIR to obtain the desired value of SRFVEC. */ - - vscl_(&srflen, udir, srfvec); - chkout_("SINCPT", (ftnlen)6); - return 0; -} /* sincpt_ */ - diff --git a/ext/spice/src/cspice/sincpt_c.c b/ext/spice/src/cspice/sincpt_c.c deleted file mode 100644 index 1f264ff5ea..0000000000 --- a/ext/spice/src/cspice/sincpt_c.c +++ /dev/null @@ -1,1266 +0,0 @@ -/* - --Procedure sincpt_c ( Surface intercept ) - --Abstract - - Given an observer and a direction vector defining a ray, compute - the surface intercept of the ray on a target body at a specified - epoch, optionally corrected for light time and stellar - aberration. - - This routine supersedes srfxpt_c. - --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 - - FRAMES - NAIF_IDS - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef sincpt_c - - void sincpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - fixref I Body-fixed, body-centered target body frame. - abcorr I Aberration correction. - obsrvr I Name of observing body. - dref I Reference frame of ray's direction vector. - dvec I Ray's direction vector. - spoint O Surface intercept point on the target body. - trgepc O Intercept epoch. - srfvec O Vector from observer to intercept point. - found O Flag indicating whether intercept was found. - --Detailed_Input - - method is a short string providing parameters defining - the computation method to be used. - - The only choice currently supported is - - "Ellipsoid" The intercept computation uses - a triaxial ellipsoid to model - the surface of the target body. - The ellipsoid's radii must be - available in the kernel pool. - - Neither case nor white space are significant in - `method'. For example, the string ' eLLipsoid ' is - valid. - - - target is the name of the target body. `target' is - case-insensitive, and leading and trailing blanks in - `target' are not significant. Optionally, you may - supply a string containing the integer ID code - for the object. For example both "MOON" and "301" - are legitimate strings that indicate the Moon is the - target body. - - When the target body's surface is represented by a - tri-axial ellipsoid, this routine assumes that a - kernel variable representing the ellipsoid's radii is - present in the kernel pool. Normally the kernel - variable would be defined by loading a PCK file. - - - et is the epoch of participation of the observer, - expressed as ephemeris seconds past J2000 TDB: `et' is - the epoch at which the observer's state is computed. - - When aberration corrections are not used, `et' is also - the epoch at which the position and orientation of the - target body are computed. - - When aberration corrections are used, the position and - orientation of the target body are computed at et-lt or - et+lt, where `lt' is the one-way light time between the - intercept point and the observer, and the sign applied - to `lt' depends on the selected correction. See the - description of `abcorr' below for details. - - - fixref is the name of the body-fixed, body-centered - reference frame associated with the target body. The - output intercept point `spoint' and the observer to - intercept vector `srfvec' will be expressed relative to - this reference frame. - - - abcorr indicates the aberration corrections to be applied when - computing the target's position and orientation. - - For remote sensing applications, where the apparent - target surface intercept point seen by the observer is - desired, normally the correction - - "CN+S" - - should be used. This and the other supported options - are described below. `abcorr' may be any of the - following: - - "NONE" Apply no correction. Return the - geometric surface intercept point on the - target body. - - Let `lt' represent the one-way light time between the - observer and the surface intercept point (note: NOT - between the observer and the target body's center). - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - intercept point's location at the light-time - corrected epoch et-lt and *arrive* at the observer's - location at `et': - - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the location of the surface - intercept point at the moment it - emitted photons arriving at the - observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "LT" option uses one iteration. - - Both the target position as seen by the - observer, and rotation of the target - body, are corrected for light time. - - "LT+S" Correct for one-way light time and stellar - aberration using a Newtonian formulation. - This option modifies the surface intercept - obtained with the "LT" option to account - for the observer's velocity relative to - the solar system barycenter. These - computations yield the apparent surface - intercept point. - - "CN" Converged Newtonian light time correction. - In solving the light time equation, the - "CN" correction iterates until the - solution converges. Both the position and - rotation of the target body are corrected - for light time. - - "CN+S" Converged Newtonian light time and stellar - aberration corrections. This option - produces a solution that is at least as - accurate at that obtainable with the "LT+S" - option. Whether the "CN+S" solution is - substantially more accurate depends on the - geometry of the participating objects and - on the accuracy of the input data. In all - cases this routine will execute more - slowly when a converged solution is - computed. - - For reception-case applications involving - intercepts near the target body limb, this - option should be used - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - intercept point at the light-time corrected epoch - et+lt: - - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - intercept location at the moment it - receives photons emitted from the - observer's location at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "XLT" option uses one iteration. - - Both the target position as seen by the - observer, and rotation of the target - body, are corrected for light time. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - intercept obtained with the "XLT" - option to account for the observer's - velocity relative to the solar system - barycenter. - - "XCN" Converged Newtonian light time - correction. This is the same as XLT - correction but with further iterations - to a converged Newtonian light time - solution. - - "XCN+S" "Transmission" case: converged Newtonian - light time and stellar aberration - corrections. This option produces a - solution that is at least as accurate at - that obtainable with the "XLT+S" option. - Whether the "XCN+S" solution is - substantially more accurate depends on the - geometry of the participating objects and - on the accuracy of the input data. In all - cases this routine will execute more - slowly when a converged solution is - computed. - - For transmission-case applications - involving intercepts near the target body - limb, this option should be used. - - Case and embedded blanks are not significant in `abcorr'. - For example, the string - - "Cn + s" - - is valid. - - - obsrvr is the name of the observing body. This is typically - a spacecraft, the earth, or a surface point on the - earth. `obsrvr' is case-insensitive, and leading and - trailing blanks in `obsrvr' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both - "MOON" and "301" are legitimate strings that indicate - the Moon is the observer. - - - dref is the name of the reference frame relative to which the - ray's direction vector is expressed. This may be any - frame supported by the SPICE system, including built-in - frames (documented in the Frames Required Reading) and - frames defined by a loaded frame kernel (FK). The string - `dref' is case-insensitive, and leading and trailing - blanks in `dref' are not significant. - - When `dref' designates a non-inertial frame, the - orientation of the frame is evaluated at an epoch - dependent on the frame's center and, if the center is - not the observer, on the selected aberration - correction. See the description of the direction - vector `dvec' for details. - - - dvec Ray direction vector emanating from the observer. The - intercept with the target body's surface of the ray - defined by the observer and `dvec' is sought. - - `dvec' is specified relative to the reference frame - designated by `dref'. - - Non-inertial reference frames are treated as follows: - if the center of the frame is at the observer's - location, the frame is evaluated at `et'. If the - frame's center is located elsewhere, then letting - `ltcent' be the one-way light time between the observer - and the central body associated with the frame, the - orientation of the frame is evaluated at et-ltcent, - et+ltcent, or `et' depending on whether the requested - aberration correction is, respectively, for received - radiation, transmitted radiation, or is omitted. - `ltcent' is computed using the method indicated by - `abcorr'. - - --Detailed_Output - - - spoint is the surface intercept point on the target body of - the ray defined by the observer and the direction - vector. If the ray intersects the target body in - multiple points, the selected intersection point is - the one closest to the observer. The output argument - `found' (see below) indicates whether an intercept was - found. - - `spoint' is expressed in Cartesian coordinates, - relative to the target body-fixed frame designated by - `fixref'. The body-fixed target frame is evaluated at - the intercept epoch `trgepc' (see description below). - - When light time correction is used, the duration of - light travel between `spoint' to the observer is - considered to be the one way light time. When both light - time and stellar aberration corrections are used, - `spoint' is selected such that, when `spoint' is - corrected for light time an stellar aberration, `spoint' - lies on the ray defined by the observer's location and - `dvec'. - - The components of `spoint' are given in units of km. - - - trgepc is the "intercept epoch." `trgepc' is defined as - follows: letting `lt' be the one-way light time between - the observer and the intercept point, `trgepc' is the - epoch et-lt, et+lt, or `et' depending on whether the - requested aberration correction is, respectively, for - received radiation, transmitted radiation, or omitted. - `lt' is computed using the method indicated by `abcorr'. - - `trgepc' is expressed as seconds past J2000 TDB. - - - srfvec is the vector from the observer's position at `et' to - the aberration-corrected (or optionally, geometric) - position of `spoint', where the aberration corrections - are specified by `abcorr'. `srfvec' is expressed in the - target body-fixed reference frame designated by - `fixref', evaluated at `trgepc'. - - The components of `srfvec' are given in units of km. - - One can use the CSPICE function vnorm_c to obtain the - distance between the observer and `spoint': - - dist = vnorm_c ( srfvec ); - - The observer's position `obspos', relative to the - target body's center, where the center's position is - corrected for aberration effects as indicated by - `abcorr', can be computed via the call: - - vsub_c ( spoint, srfvec, obspos ); - - To transform the vector `srfvec' to a time-dependent - reference frame `ref' at `et', a sequence of two frame - transformations is required. For example, let `mfix' - and `mref' be 3x3 matrices respectively describing the - target body-fixed to J2000 frame transformation at - `trgepc' and the J2000 to (time-dependent frame) `ref' - transformation at `et', and let `xform' be the 3x3 matrix - representing the composition of `mref' with `mfix'. Then - `srfvec' can be transformed to the result `refvec' as - follows: - - pxform_c ( fixref, "j2000", trgepc, mfix ); - pxform_c ( "j2000", ref, et, mref ); - mxm_c ( mref, mfix, xform ); - mxv_c ( xform, srfvec, refvec ); - - The second example in the Examples header section - below presents a complete program that demonstrates - this procedure. - - - found A logical flag indicating whether or not the ray - intersects the target. If an intersection exists - `found' will be returned as SPICETRUE If the ray misses - the target, `found' will be returned as SPICEFALSE. - --Parameters - - None. - --Exceptions - - - 1) If the specified aberration correction is relativistic or - calls for stellar aberration but not light time correction, - the error SPICE(NOTSUPPORTED) is signaled. If the specified - aberration correction is any other unrecognized value, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 2) If either the target or observer input strings cannot be - converted to an integer ID code, the error SPICE(IDCODENOTFOUND) - is signaled. - - 3) If `obsrvr' and `target' map to the same NAIF integer ID code, - the error SPICE(BODIESNOTDISTINCT) is signaled. - - 4) If the input target body-fixed frame `fixref' is not recognized, - the error SPICE(NOFRAME) is signaled. A frame name may fail - to be recognized because a required frame specification kernel - has not been loaded; another cause is a misspelling of the - frame name. - - 5) If the input frame `fixref' is not centered at the target body, - the error SPICE(INVALIDFRAME) is signaled. - - 6) If the input argument `method' is not recognized, the error - SPICE(INVALIDMETHOD) is signaled. - - 7) If the target and observer have distinct identities but are - at the same location (for example, the target is Mars and - the observer is the Mars barycenter), the error - SPICE(NOSEPARATION) is signaled. - - 8) If insufficient ephemeris data have been loaded prior to - calling sincpt_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. Note that when - light time correction is used, sufficient ephemeris data - must be available to propagate the states of both observer - and target to the solar system barycenter. - - 9) If the computation method specifies an ellipsoidal target shape - and triaxial radii of the target body have not been loaded - into the kernel pool prior to calling sincpt_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 10) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 11) If PCK data specifying the target body-fixed frame orientation - have not been loaded prior to calling sincpt_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 12) If the reference frame designated by `dref' is not recognized - by the SPICE frame subsystem, the error SPICE(NOFRAME) - will be signaled. - - 13) If the direction vector `dvec' is the zero vector, the error - SPICE(ZEROVECTOR) will be signaled. - - 14) The error SPICE(EMPTYSTRING) is signaled if any input string - argument does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 15) The error SPICE(NULLPOINTER) is signaled if any input - string argument pointer is null. - - --Files - - Appropriate kernels must be loaded by the calling program before - this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target and observer must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - PCK data: if the computation method is specified as - "Ellipsoid," triaxial radii for the target body must be - loaded into the kernel pool. Typically this is done by - loading a text PCK file via furnsh_c. - - - Further PCK data: rotation data for the target body must - be loaded. These may be provided in a text or binary PCK - file. - - The following data may be required: - - - Frame data: if a frame definition is required to convert - the observer and target states to the body-fixed frame of - the target, that definition must be available in the kernel - pool. Similarly, the frame definition required to map - between the frame designated by `dref' and the target - body-fixed frame must be available. Typically the - definitions of frames not already built-in to SPICE are - supplied by loading a frame kernel. - - - CK data: if the frame to which `dref' refers is fixed to a - spacecraft instrument or structure, at least one CK file will - be needed to permit transformation of vectors between that - frame and both the J2000 and the target body-fixed frames. - - - SCLK data: if a CK file is needed, an associated SCLK - kernel is required to enable conversion between encoded SCLK - (used to time-tag CK data) and barycentric dynamical time - (TDB). - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - Given a ray defined by a direction vector and the location of an - observer, sincpt_c computes the surface intercept point of the ray - on a specified target body. sincpt_c also determines the vector - from the observer to the surface intercept point. - - When aberration corrections are used, this routine finds the - value of `spoint' such that, if `spoint' is regarded as an ephemeris - object, after the selected aberration corrections are applied to - the vector from the observer to `spoint', the resulting vector is - parallel to the direction vector `dvec'. - - This routine computes light time corrections using light time - between the observer and the surface intercept point, as opposed - to the center of the target. Similarly, stellar aberration - corrections done by this routine are based on the direction of - the vector from the observer to the light-time corrected - intercept point, not to the target center. This technique avoids - errors due to the differential between aberration corrections - across the target body. Therefore it's valid to use aberration - corrections with this routine even when the observer is very - close to the intercept point, in particular when the - observer-intercept point distance is much less than the - observer-target center distance. It's also valid to use stellar - aberration corrections even when the intercept point is near or - on the limb (as may occur in occultation computations using a - point target). - - When comparing surface intercept point computations with results - from sources other than SPICE, it's essential to make sure the - same geometric definitions are used. - --Examples - - The numerical results shown for this example may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) The following program computes surface intercept points on - Mars for the boresight and FOV boundary vectors of the MGS MOC - narrow angle camera. The intercepts are computed for a single - observation epoch. Light time and stellar aberration corrections - are used. For simplicity, camera distortion is ignored. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - File: mgs_example2.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de418.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - mgs_moc_v20.ti MGS MOC instrument - parameters - mgs_sclkscet_00061.tsc MGS SCLK coefficients - mgs_sc_ext12.bc MGS s/c bus attitude - mgs_ext12_ipng_mgs95j.bsp MGS ephemeris - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls', - 'mgs_moc_v20.ti', - 'mgs_sclkscet_00061.tsc', - 'mgs_sc_ext12.bc', - 'mgs_ext12_ipng_mgs95j.bsp' ) - \begintext - - - Example code begins here. - - #include - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - int main() - { - /. - Local parameters - ./ - #define META "mgs_example2.tm" - #define ABCLEN 20 - #define LNSIZE 81 - #define NAMLEN 33 - #define TIMLEN 51 - #define SHPLEN 81 - #define NCORNR 4 - - /. - Local variables - ./ - SpiceBoolean found; - - SpiceChar * abcorr = "CN+S"; - SpiceChar * camera = "MGS_MOC_NA"; - SpiceChar dref [NAMLEN]; - SpiceChar * fixref = "IAU_MARS"; - SpiceChar * method = "Ellipsoid"; - SpiceChar * obsrvr = "MGS"; - SpiceChar shape [ SHPLEN ]; - SpiceChar * target = "Mars"; - SpiceChar title [ LNSIZE ]; - SpiceChar * utc = "2003 OCT 13 06:00:00 UTC"; - - SpiceDouble bounds [NCORNR][3]; - SpiceDouble bsight [3]; - SpiceDouble dist; - SpiceDouble dvec [3]; - SpiceDouble et; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble radius; - SpiceDouble spoint [3]; - SpiceDouble srfvec [3]; - SpiceDouble trgepc; - - SpiceInt camid; - SpiceInt i; - SpiceInt n; - - - /. - Load kernel files: - ./ - furnsh_c ( META ); - - /. - Convert the UTC request time to ET (seconds past - J2000, TDB). - ./ - str2et_c ( utc, &et ); - - /. - Get the MGS MOC Narrow angle camera (MGS_MOC_NA) - ID code. Then look up the field of view (FOV) - parameters. - ./ - bodn2c_c ( camera, &camid, &found ); - - if ( !found ) - { - setmsg_c ( "Could not find ID code for " - "instrument #." ); - errch_c ( "#", camera ); - sigerr_c ( "SPICE(NOTRANSLATION)" ); - } - - /. - getfov_c will return the name of the camera-fixed frame - in the string `dref', the camera boresight vector in - the array `bsight', and the FOV corner vectors in the - array `bounds'. - ./ - getfov_c ( camid, NCORNR, SHPLEN, NAMLEN, - shape, dref, bsight, &n, bounds ); - - printf ( "\n" - "Surface Intercept Locations for Camera\n" - "FOV Boundary and Boresight Vectors\n" - "\n" - " Instrument: %s\n" - " Epoch: %s\n" - " Aberration correction: %s\n" - "\n", - camera, utc, abcorr ); - - /. - Now compute and display the surface intercepts for the - boresight and all of the FOV boundary vectors. - ./ - - for ( i = 0; i <= NCORNR; i++ ) - { - if ( i < NCORNR ) - { - sprintf ( title, "Corner vector %ld", i ); - - vequ_c ( bounds[i], dvec ); - } - else - { - strcpy ( title, "Boresight vector" ); - - vequ_c ( bsight, dvec ); - } - - /. - Compute the surface intercept point using - the specified aberration corrections. - ./ - sincpt_c ( method, - target, et, fixref, abcorr, - obsrvr, dref, dvec, spoint, - &trgepc, srfvec, &found ); - - if ( found ) - { - /. - Compute range from observer to apparent intercept. - ./ - dist = vnorm_c( srfvec ); - - /. - Convert rectangular coordinates to planetocentric - latitude and longitude. Convert radians to degrees. - ./ - reclat_c ( spoint, &radius, &lon, &lat ); - - lon *= dpr_c (); - lat *= dpr_c (); - - /. - Display the results. - ./ - - printf ( "\n" - "%s\n", title ); - - sprintf ( title, " Vector in %s frame = ", dref ); - - printf ( "\n" - "%s\n", title ); - - if ( i < NCORNR ) - { - printf ( " %18.10e %18.10e %18.10e\n", - bounds[i][0], bounds[i][1], bounds[i][2] ); - } - else - { - printf ( " %18.10e %18.10e %18.10e\n", - bsight[0], bsight[1], bsight[2] ); - } - - printf ( "\n" - " Intercept:\n" - "\n" - " Radius (km) = %18.10e\n" - " Planetocentric Latitude (deg) = %18.10e\n" - " Planetocentric Longitude (deg) = %18.10e\n" - " Range (km) = %18.10e\n" - "\n", - radius, lat, lon, dist ); - } - else - { - printf ( "\n" - "Intercept not found.\n" - "\n" ); - } - - } - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - Surface Intercept Locations for Camera - FOV Boundary and Boresight Vectors - - Instrument: MGS_MOC_NA - Epoch: 2003 OCT 13 06:00:00 UTC - Aberration correction: CN+S - - - Corner vector 0 - - Vector in MGS_MOC_NA frame = - 1.8571383810e-06 -3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849411359e+03 - Planetocentric Latitude (deg) = -4.8477481924e+01 - Planetocentric Longitude (deg) = -1.2347407905e+02 - Range (km) = 3.8898310366e+02 - - - Corner vector 1 - - Vector in MGS_MOC_NA frame = - 1.8571383810e-06 3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849396987e+03 - Planetocentric Latitude (deg) = -4.8481636340e+01 - Planetocentric Longitude (deg) = -1.2339882297e+02 - Range (km) = 3.8897512130e+02 - - - Corner vector 2 - - Vector in MGS_MOC_NA frame = - -1.8571383810e-06 3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849396899e+03 - Planetocentric Latitude (deg) = -4.8481661910e+01 - Planetocentric Longitude (deg) = -1.2339882618e+02 - Range (km) = 3.8897466238e+02 - - - Corner vector 3 - - Vector in MGS_MOC_NA frame = - -1.8571383810e-06 -3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849411271e+03 - Planetocentric Latitude (deg) = -4.8477507498e+01 - Planetocentric Longitude (deg) = -1.2347408220e+02 - Range (km) = 3.8898264472e+02 - - - Boresight vector - - Vector in MGS_MOC_NA frame = - 0.0000000000e+00 0.0000000000e+00 1.0000000000e+00 - - Intercept: - - Radius (km) = 3.3849404102e+03 - Planetocentric Latitude (deg) = -4.8479579822e+01 - Planetocentric Longitude (deg) = -1.2343645396e+02 - Range (km) = 3.8897573572e+02 - - - - 2) Use subpnt_c to find the sub-spacecraft point on Mars for the - Mars Reconnaissance Orbiter spacecraft (MRO) at a specified - time, using the "near point: ellipsoid" computation method. - Use both LT+S and CN+S aberration corrections to illustrate - the differences. - - Convert the spacecraft to sub-observer point vector obtained - from subpnt_c into the MRO_HIRISE_LOOK_DIRECTION reference frame - at the observation time. Perform a consistency check with this - vector: compare the Mars surface intercept of the ray - emanating from the spacecraft and pointed along this vector - with the sub-observer point. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - - KPL/MK - - File: mro_example.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de418.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - mro_psp4_ssd_mro95a.bsp MRO ephemeris - mro_v11.tf MRO frame specifications - mro_sclkscet_00022_65536.tsc MRO SCLK coefficients and - parameters - mro_sc_psp_070925_071001.bc MRO attitude - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls', - 'mro_psp4_ssd_mro95a.bsp', - 'mro_v11.tf', - 'mro_sclkscet_00022_65536.tsc', - 'mro_sc_psp_070925_071001.bc' ) - \begintext - - - Example code begins here. - - - /. - Program EX2 - ./ - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - ./ - #define META "mro_example.tm" - #define NCORR 2 - - /. - Local variables - ./ - SpiceBoolean found; - - static SpiceChar * abcorr[NCORR] = - { - "LT+S", "CN+S" - }; - - static SpiceChar * hiref; - static SpiceChar * method; - - SpiceDouble alt; - SpiceDouble et; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble mrovec [3]; - SpiceDouble r1 [3][3]; - SpiceDouble r2 [3][3]; - SpiceDouble radius; - SpiceDouble spoint [3]; - SpiceDouble srfvec [3]; - SpiceDouble trgepc; - SpiceDouble xepoch; - SpiceDouble xform [3][3]; - SpiceDouble xpoint [3]; - SpiceDouble xvec [3]; - - SpiceInt i; - - /. - Load kernel files via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the TDB request time string to seconds past - J2000, TDB. - ./ - str2et_c ( "2007 SEP 30 00:00:00 TDB", &et ); - - /. - Compute the sub-spacecraft point using the - "NEAR POINT: ELLIPSOID" definition. - Compute the results using both LT+S and CN+S - aberration corrections. - ./ - method = "Near point: ellipsoid"; - - printf ( "\nComputation method = %s\n", method ); - - for ( i = 0; i < 2; i++ ) - { - subpnt_c ( method, - "mars", et, "iau_mars", abcorr[i], - "mro", spoint, &trgepc, srfvec ); - - /. - Compute the observer's altitude above `spoint'. - ./ - alt = vnorm_c ( srfvec ); - - /. - Express `srfvec' in the MRO_HIRISE_LOOK_DIRECTION - reference frame at epoch `et'. Since `srfvec' is expressed - relative to the IAU_MARS frame at `trgepc', we must - compose two transformations: that from IAU_MARS to - J2000 at `trgepc', followed by the transformation from - J2000 to MRO_HIRISE_LOOK_DIRECTION at `et'. - (We could use any other inertial frame in place - of J2000; the result would be the same.) - - To make code formatting a little easier, we'll store - the long MRO reference frame name in a variable: - ./ - hiref = "MRO_HIRISE_LOOK_DIRECTION"; - - pxform_c ( "iau_mars", "j2000", trgepc, r1 ); - pxform_c ( "j2000", hiref, et, r2 ); - - mxm_c ( r2, r1, xform ); - mxv_c ( xform, srfvec, mrovec ); - - /. - Convert rectangular coordinates to planetocentric - latitude and longitude. Convert radians to degrees. - ./ - reclat_c ( spoint, &radius, &lon, &lat ); - - lon *= dpr_c(); - lat *= dpr_c(); - - /. - Write the results. - ./ - printf ( "\n" - "Aberration correction = %s\n\n" - " MRO-to-sub-observer vector in\n" - " MRO HIRISE look direction frame\n" - " X-component (km) = %21.9f\n" - " Y-component (km) = %21.9f\n" - " Z-component (km) = %21.9f\n" - " Sub-observer point radius (km) = %21.9f\n" - " Planetocentric latitude (deg) = %21.9f\n" - " Planetocentric longitude (deg) = %21.9f\n" - " Observer altitude (km) = %21.9f\n", - abcorr[i], - mrovec[0], - mrovec[1], - mrovec[2], - radius, - lat, - lon, - alt ); - - /. - Consistency check: find the surface intercept on - Mars of the ray emanating from the spacecraft and having - direction vector MROVEC in the MRO HIRISE look direction - reference frame at ET. Call the intercept point - XPOINT. XPOINT should coincide with SPOINT, up to a - small round-off error. - ./ - sincpt_c ( "ellipsoid", "mars", et, "iau_mars", - abcorr[i], "mro", hiref, mrovec, - xpoint, &xepoch, xvec, &found ); - - if ( !found ) - { - printf ( "Bug: no intercept\n" ); - } - else - { - /. - Report the distance between XPOINT and SPOINT. - ./ - printf ( " Intercept comparison error (km) = %21.9f\n\n", - vdist_c( xpoint, spoint ) ); - } - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Computation method = Near point: ellipsoid - - Aberration correction = LT+S - - MRO-to-sub-observer vector in - MRO HIRISE look direction frame - X-component (km) = 0.286931987 - Y-component (km) = -0.260417167 - Z-component (km) = 253.816284981 - Sub-observer point radius (km) = 3388.299078207 - Planetocentric latitude (deg) = -38.799836879 - Planetocentric longitude (deg) = -114.995294746 - Observer altitude (km) = 253.816580760 - Intercept comparison error (km) = 0.000002144 - - - Aberration correction = CN+S - - MRO-to-sub-observer vector in - MRO HIRISE look direction frame - X-component (km) = 0.286931866 - Y-component (km) = -0.260417914 - Z-component (km) = 253.816274506 - Sub-observer point radius (km) = 3388.299078205 - Planetocentric latitude (deg) = -38.799836883 - Planetocentric longitude (deg) = -114.995294968 - Observer altitude (km) = 253.816570285 - Intercept comparison error (km) = 0.000000001 - - --Restrictions - - A cautionary note: if aberration corrections are used, and - if `dref' is the target body-fixed frame, the epoch at which that - frame is evaluated is offset from `et' by the light time between - the observer and the *center* of the target body. This light time - normally will differ from the light time between the observer and - intercept point. Consequently the orientation of the target - body-fixed frame at `trgepc' will not match that of the target - body-fixed frame at the epoch associated with `dref'. As a result, - various derived quantities may not be as expected: for example, - `srfvec' would not be parallel to `dvec'. - - In many applications the errors arising from this frame - discrepancy may be insignificant; however a safe approach is to - always use as `dref' a frame other than the target body-fixed - frame. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 06-FEB-2009 (NJB) - - Typos in the Detailed Input section's description of `dref' - were corrected. Incorrect frame name fixfrm was changed to - fixref in documentation. - - In the header examples, meta-kernel names were updated to use - the suffix - - ".tm" - - -CSPICE Version 1.0.0, 02-MAR-2008 (NJB) - --Index_Entries - - find surface intercept point - find intersection of ray and target body surface - find intercept of ray on target body surface - --& -*/ - -{ /* Begin sincpt_c */ - - - /* - Local variables - */ - logical fnd; - - /* - Participate in error tracing. - */ - chkin_c ( "sincpt_c" ); - - /* - Check the input string arguments: - - method - target - fixref - abcorr - obsrvr - dref - - Make sure each pointer is non-null and each string contains - at least one data character: that is, one character - preceding the null terminator. - */ - CHKFSTR ( CHK_STANDARD, "sincpt_c", method ); - CHKFSTR ( CHK_STANDARD, "sincpt_c", target ); - CHKFSTR ( CHK_STANDARD, "sincpt_c", fixref ); - CHKFSTR ( CHK_STANDARD, "sincpt_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "sincpt_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "sincpt_c", dref ); - - /* - Call the f2c'd SPICELIB function. - */ - sincpt_ ( (char *) method, - (char *) target, - (doublereal *) &et, - (char *) fixref, - (char *) abcorr, - (char *) obsrvr, - (char *) dref, - (doublereal *) dvec, - (doublereal *) spoint, - (doublereal *) trgepc, - (doublereal *) srfvec, - (logical *) &fnd, - (ftnlen ) strlen(method), - (ftnlen ) strlen(target), - (ftnlen ) strlen(fixref), - (ftnlen ) strlen(abcorr), - (ftnlen ) strlen(obsrvr), - (ftnlen ) strlen(dref) ); - - /* - Move the found flag into a variable of type SpiceBoolean. - The SpiceBoolean type may have a different size than - the logical type. - */ - - *found = fnd; - - chkout_c ( "sincpt_c" ); - -} /* End sincpt_c */ diff --git a/ext/spice/src/cspice/size_c.c b/ext/spice/src/cspice/size_c.c deleted file mode 100644 index 82148cd893..0000000000 --- a/ext/spice/src/cspice/size_c.c +++ /dev/null @@ -1,224 +0,0 @@ -/* - --Procedure size_c ( Size of a cell ) - --Abstract - - Return the size (maximum cardinality) of a SPICE cell of any - data type. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - SpiceInt size_c ( SpiceCell * cell ) - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - cell I Input cell. - - The function returns the size of the input cell. - --Detailed_Input - - - cell is a CSPICE cell of any data type. Cell must be - declared as a character, double precision, or - integer SpiceCell. - --Detailed_Output - - The function returns the size of (maximum number of elements in) - the input cell. - --Parameters - - None. - --Exceptions - - 1) If the input array has invalid cardinality, the error - SPICE(INVALIDCARDINALITY) is signaled. size_c returns - an unspecified value in this case. - - 2) If the input array has invalid size, the error - SPICE(INVALIDSIZE) is signaled. size_c returns - an unspecified value in this case. - --Files - - None. - --Particulars - - None. - --Examples - - The size_c function is typically used in conjunction - with the card_c function to predict (and subsequently - avoid) overflows when manipulating cells. In the following - example, size_c is used to determine whether the integer cell - original can be safely copied into the integer cell save before - actually attempting the operation. (If original contains more - elements than save is capable of holding, then the operation - will fail.) - - #include "SpiceUsr.h" - . - . - . - /. - Declare the cells original and save with string length - LNSIZE and maximum number of strings SIZE1 and SIZE2 - respectively. - ./ - SPICECHAR_CELL ( original, SIZE1, LNSIZE ); - SPICECHAR_CELL ( save, SIZE2, LNSIZE ); - . - . - . - if ( card_c(&original) <= size_c(&save) ) - { - copy_c ( &original, &save ); - } - else - { - [ Handle overflow case ] - . - . - . - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 06-AUG-2002 (NJB) (CAC) (HAN) (WLT) (IMU) - --Index_Entries - - size of a cell - --& -*/ - -{ /* Begin size_c */ - - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( cell->size ); - } - chkin_c ( "size_c" ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - /* - Check the size and cardinality of the input cell. - */ - if ( cell->size < 0 ) - { - setmsg_c ( "Invalid cell size. The size was #." ); - errint_c ( "#", cell->size ); - sigerr_c ( "SPICE(INVALIDSIZE)" ); - chkout_c ( "size_c" ); - - return ( cell->size ); - } - - else if ( cell->card < 0 ) - { - setmsg_c ( "Invalid cell cardinality. The " - "cardinality was #." ); - errint_c ( "#", cell->card ); - sigerr_c ( "SPICE(INVALIDCARDINALITY)" ); - chkout_c ( "size_c" ); - - return ( cell->size ); - } - - else if ( cell->card > cell->size ) - { - setmsg_c ( "Invalid cell cardinality; cardinality exceeds " - " cell size. The cardinality was #. The size " - " was #." ); - errint_c ( "#", cell->card ); - errint_c ( "#", cell->size ); - sigerr_c ( "SPICE(INVALIDCARDINALITY)" ); - chkout_c ( "size_c" ); - - return ( cell->size ); - } - - - chkout_c ( "size_c" ); - - return ( cell->size ); - - -} /* End size_c */ diff --git a/ext/spice/src/cspice/sizec.c b/ext/spice/src/cspice/sizec.c deleted file mode 100644 index a34307122a..0000000000 --- a/ext/spice/src/cspice/sizec.c +++ /dev/null @@ -1,212 +0,0 @@ -/* sizec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SIZEC ( Size of a character cell ) */ -integer sizec_(char *cell, ftnlen cell_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer card, size; - extern /* Subroutine */ int chkin_(char *, ftnlen), dechar_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the size (maximum cardinality) of a character cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Input cell. */ - -/* The function returns the size of the input cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* The function returns the size of (maximum number of elements in) */ -/* the input cell. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The size (SIZE) functions are typically used in conjunction */ -/* with the cardinality functions to predict (and subsequently */ -/* avoid) overflows when manipulating cells. In the following */ -/* example, SIZEI is used to determine whether the integer cell */ -/* ORIGINAL can be safely copied into the integer cell SAVE before */ -/* actually attempting the operation. (If ORIGINAL contains more */ -/* elements than SAVE is capable of holding, then the operation */ -/* will fail.) */ - -/* IF ( CARDI ( ORIGINAL ) .LE. SIZEI ( SAVE ) ) THEN */ -/* CALL COPYI ( ORIGINAL, SAVE, ERROR ) */ - -/* ELSE */ -/* . */ -/* . */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) If the input array has invalid cardinality, the error */ -/* SPICE(INVALIDCARDINALITY) is signalled. SIZEC returns */ -/* an unspecified value in this case. */ - -/* 2) If the input array has invalid size, the error */ -/* SPICE(INVALIDSIZE) is signalled. SIZEC returns */ -/* an unspecified value in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* size of a character cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for valid input cell added. The input cell must */ -/* have valid size and cardinality values. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("SIZEC", (ftnlen)5); - } - -/* Set return value, regardless of validity. */ - - dechar_(cell + (cell_len << 2), &size, cell_len); - ret_val = size; - -/* Squeal if something is awry. */ - - dechar_(cell + cell_len * 5, &card, cell_len); - if (size < 0) { - setmsg_("Invalid cell size. The size was #.", (ftnlen)35); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("SIZEC", (ftnlen)5); - return ret_val; - } else if (card < 0) { - setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen) - 49); - errint_("#", &card, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SIZEC", (ftnlen)5); - return ret_val; - } else if (card > size) { - setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T" - "he cardinality was #. The size was #.", (ftnlen)97); - errint_("#", &card, (ftnlen)1); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SIZEC", (ftnlen)5); - return ret_val; - } - chkout_("SIZEC", (ftnlen)5); - return ret_val; -} /* sizec_ */ - diff --git a/ext/spice/src/cspice/sized.c b/ext/spice/src/cspice/sized.c deleted file mode 100644 index b58d1f1fd6..0000000000 --- a/ext/spice/src/cspice/sized.c +++ /dev/null @@ -1,209 +0,0 @@ -/* sized.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SIZED ( Size of a double precision cell ) */ -integer sized_(doublereal *cell) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the size (maximum cardinality) of a double precision */ -/* cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Input cell. */ - -/* The function returns the size of the input cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* The function returns the size of (maximum number of elements in) */ -/* the input cell. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The size (SIZE) functions are typically used in conjunction */ -/* with the cardinality functions to predict (and subsequently */ -/* avoid) overflows when manipulating cells. In the following */ -/* example, SIZEI is used to determine whether the integer cell */ -/* ORIGINAL can be safely copied into the integer cell SAVE before */ -/* actually attempting the operation. (If ORIGINAL contains more */ -/* elements than SAVE is capable of holding, then the operation */ -/* will fail.) */ - -/* IF ( CARDI ( ORIGINAL ) .LE. SIZEI ( SAVE ) ) THEN */ -/* CALL COPYI ( ORIGINAL, SAVE, ERROR ) */ - -/* ELSE */ -/* . */ -/* . */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input array has invalid cardinality, the error */ -/* SPICE(INVALIDCARDINALITY) is signalled. SIZEI returns */ -/* an unspecified value in this case. */ - -/* 2) If the input array has invalid size, the error */ -/* SPICE(INVALIDSIZE) is signalled. SIZEI returns */ -/* an unspecified value in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* size of a d.p. cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for valid input cell added. The input cell must */ -/* have valid size and cardinality values. */ -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("SIZED", (ftnlen)5); - } - -/* Set return value, regardless of validity. */ - - ret_val = (integer) cell[4]; - -/* Squeal if something is awry. */ - - if ((integer) cell[4] < 0) { - setmsg_("Invalid cell size. The size was #.", (ftnlen)35); - i__1 = (integer) cell[4]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("SIZED", (ftnlen)5); - return ret_val; - } else if ((integer) cell[5] < 0) { - setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen) - 49); - i__1 = (integer) cell[5]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SIZED", (ftnlen)5); - return ret_val; - } else if ((integer) cell[5] > (integer) cell[4]) { - setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T" - "he cardinality was #. The size was #.", (ftnlen)97); - i__1 = (integer) cell[5]; - errint_("#", &i__1, (ftnlen)1); - i__1 = (integer) cell[4]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SIZED", (ftnlen)5); - return ret_val; - } - chkout_("SIZED", (ftnlen)5); - return ret_val; -} /* sized_ */ - diff --git a/ext/spice/src/cspice/sizei.c b/ext/spice/src/cspice/sizei.c deleted file mode 100644 index b2c58cd50b..0000000000 --- a/ext/spice/src/cspice/sizei.c +++ /dev/null @@ -1,204 +0,0 @@ -/* sizei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SIZEI ( Size of an integer cell ) */ -integer sizei_(integer *cell) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the size (maximum cardinality) of an integer cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CELL I Input cell. */ - -/* The function returns the size of the input cell. */ - -/* $ Detailed_Input */ - - -/* CELL is a cell. */ - - -/* $ Detailed_Output */ - -/* The function returns the size of (maximum number of elements in) */ -/* the input cell. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The size (SIZE) functions are typically used in conjunction */ -/* with the cardinality functions to predict (and subsequently */ -/* avoid) overflows when manipulating cells. In the following */ -/* example, SIZEI is used to determine whether the integer cell */ -/* ORIGINAL can be safely copied into the integer cell SAVE before */ -/* actually attempting the operation. (If ORIGINAL contains more */ -/* elements than SAVE is capable of holding, then the operation */ -/* will fail.) */ - -/* IF ( CARDI ( ORIGINAL ) .LE. SIZEI ( SAVE ) ) THEN */ -/* CALL COPYI ( ORIGINAL, SAVE, ERROR ) */ - -/* ELSE */ -/* . */ -/* . */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input array has invalid cardinality, the error */ -/* SPICE(INVALIDCARDINALITY) is signalled. SIZEI returns */ -/* an unspecified value in this case. */ - -/* 2) If the input array has invalid size, the error */ -/* SPICE(INVALIDSIZE) is signalled. SIZEI returns */ -/* an unspecified value in this case. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */ -/* function. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* size of an integer cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for valid input cell added. The input cell must */ -/* have valid size and cardinality values. */ -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("SIZEI", (ftnlen)5); - } - -/* Set return value, regardless of validity. */ - - ret_val = cell[4]; - -/* Squeal if something is awry. */ - - if (cell[4] < 0) { - setmsg_("Invalid cell size. The size was #.", (ftnlen)35); - errint_("#", &cell[4], (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("SIZEI", (ftnlen)5); - return ret_val; - } else if (cell[5] < 0) { - setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen) - 49); - errint_("#", &cell[5], (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SIZEI", (ftnlen)5); - return ret_val; - } else if (cell[5] > cell[4]) { - setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T" - "he cardinality was #. The size was #.", (ftnlen)97); - errint_("#", &cell[5], (ftnlen)1); - errint_("#", &cell[4], (ftnlen)1); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("SIZEI", (ftnlen)5); - return ret_val; - } - chkout_("SIZEI", (ftnlen)5); - return ret_val; -} /* sizei_ */ - diff --git a/ext/spice/src/cspice/smsgnd.c b/ext/spice/src/cspice/smsgnd.c deleted file mode 100644 index 78a87792be..0000000000 --- a/ext/spice/src/cspice/smsgnd.c +++ /dev/null @@ -1,146 +0,0 @@ -/* smsgnd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SMSGND ( Same Sign Double Precision Numbers ) */ -logical smsgnd_(doublereal *x, doublereal *y) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* A logical function that is true if the input arguments have the */ -/* same sign. */ - -/* $ 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 */ - -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I A double precision number */ -/* Y I A double precision number */ - -/* $ Detailed_Input */ - -/* X is any double precision number. */ - -/* Y is any double precision number. */ - -/* $ Detailed_Output */ - -/* SMSGND is returned as .TRUE. if X and Y are both positive or both */ -/* negative. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the value: */ - -/* ( (( X .GT. 0) .AND. (Y .GT. 0)) */ -/* .OR. (( X .LT. 0) .AND. (Y .LT. 0)) ) */ - -/* This is a more stable value than */ - -/* ( X*Y .GT. 0 ) */ - -/* Note: If either of the to inputs is zero. The result returned */ -/* will be .FALSE. */ - -/* $ Examples */ - -/* This routine can be used whenever a decision depends upon two */ -/* Double Precision values having the same sign. */ - -/* IF ( SMSGND ( F(X1), F(X2) ) ) THEN */ -/* . */ -/* . */ -/* do something */ -/* . */ -/* . */ -/* ELSE */ -/* . */ -/* . */ -/* find a root of F lying between X1 and X2 */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* same sign d.p. numbers */ - -/* -& */ - ret_val = *x > 0. && *y > 0. || *x < 0. && *y < 0.; - return ret_val; -} /* smsgnd_ */ - diff --git a/ext/spice/src/cspice/smsgni.c b/ext/spice/src/cspice/smsgni.c deleted file mode 100644 index 309db0076e..0000000000 --- a/ext/spice/src/cspice/smsgni.c +++ /dev/null @@ -1,146 +0,0 @@ -/* smsgni.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SMSGNI ( Same Sign Integer Numbers ) */ -logical smsgni_(integer *x, integer *y) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* A logical function that is true if the input arguments have the */ -/* same sign. */ - -/* $ 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 */ - -/* NUMBERS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I An integer. */ -/* Y I An integer. */ - -/* $ Detailed_Input */ - -/* X is any integer. */ - -/* Y is any integer. */ - -/* $ Detailed_Output */ - -/* SMSGNI is returned as .TRUE. if X and Y are both positive or both */ -/* negative. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the value: */ - -/* ( (( X .GT. 0) .AND. (Y .GT. 0)) */ -/* .OR. (( X .LT. 0) .AND. (Y .LT. 0)) ) */ - -/* This is a more stable value than */ - -/* ( X*Y .GT. 0 ) */ - -/* Note: If either of the to inputs is zero. The result returned */ -/* will be .FALSE. */ - -/* $ Examples */ - -/* This routine can be used whenever a decision depends upon two */ -/* integer values having the same sign. */ - -/* IF ( SMSGNI ( F(X1), F(X2) ) ) THEN */ -/* . */ -/* . */ -/* do something */ -/* . */ -/* . */ -/* ELSE */ -/* . */ -/* . */ -/* find a root of F lying between X1 and X2 */ -/* . */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* same sign integer numbers */ - -/* -& */ - ret_val = *x > 0 && *y > 0 || *x < 0 && *y < 0; - return ret_val; -} /* smsgni_ */ - diff --git a/ext/spice/src/cspice/somfls.c b/ext/spice/src/cspice/somfls.c deleted file mode 100644 index 3e604e5abc..0000000000 --- a/ext/spice/src/cspice/somfls.c +++ /dev/null @@ -1,155 +0,0 @@ -/* somfls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SOMFLS ( Some entries false? ) */ -logical somfls_(logical *logcls, integer *n) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Determine if some of the entries in an array of logicals are */ -/* .FALSE. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LOGCLS I An array of logicals. */ -/* N I Number of elements in the array LOGCLS. */ - -/* The function returns .TRUE. if some of the values in the array */ -/* LOGCLS are false. */ - -/* $ Detailed_Input */ - -/* LOGCLS is an array of logicals. */ - -/* N is the number of elements in the array LOGCLS */ - -/* $ Detailed_Output */ - -/* The function returns true if the value of some entry of LOGCLS */ -/* is .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If N is less than 1, the function returns a value of .FALSE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function examines each element of LOGCLS until */ -/* a .FALSE. value is found or until all values have been */ -/* examined. */ - -/* $ Examples */ - -/* Suppose you need to confirm that a character set */ -/* WORDS does not contain at least one of the words in the phrase */ - -/* 'EVERY GOOD BOY DOES FINE' */ - -/* You might execute the following block of code. */ - -/* FOUND(1) = ELEMC ( 'EVERY', WORDS ) */ -/* FOUND(2) = ELEMC ( 'GOOD', WORDS ) */ -/* FOUND(3) = ELEMC ( 'BOY', WORDS ) */ -/* FOUND(4) = ELEMC ( 'DOES', WORDS ) */ -/* FOUND(5) = ELEMC ( 'FINE', WORDS ) */ - -/* OK = SOMFLS ( FOUND, 5 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 12-JUL-1991 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether some logicals in an array are false */ - -/* -& */ - -/* Just do it. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (! logcls[i__ - 1]) { - ret_val = TRUE_; - return ret_val; - } - } - ret_val = FALSE_; - return ret_val; -} /* somfls_ */ - diff --git a/ext/spice/src/cspice/somtru.c b/ext/spice/src/cspice/somtru.c deleted file mode 100644 index bcb8bd2e6d..0000000000 --- a/ext/spice/src/cspice/somtru.c +++ /dev/null @@ -1,155 +0,0 @@ -/* somtru.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SOMTRU ( Some entries true? ) */ -logical somtru_(logical *logcls, integer *n) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Determine if some of the entries in an array of logicals are */ -/* .TRUE. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LOGCLS I An array of logicals. */ -/* N I Number of elements in the array LOGCLS. */ - -/* The function returns .TRUE. if some of the values in the array */ -/* LOGCLS are true. */ - -/* $ Detailed_Input */ - -/* LOGCLS is an array of logicals. */ - -/* N is the number of elements in the array LOGCLS */ - -/* $ Detailed_Output */ - -/* The function returns true if the value of some entry of LOGCLS */ -/* is .TRUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If N is less than 1, the function returns a value of .FALSE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function examines each element of LOGCLS until */ -/* a .TRUE. value is found or until all values have been */ -/* examined. */ - -/* $ Examples */ - -/* Suppose you needed to confirm that a character set */ -/* WORDS contained at least one of the words in the phrase */ - -/* 'EVERY GOOD BOY DOES FINE' */ - -/* You might execute the following block of code. */ - -/* FOUND(1) = ELEMC ( 'EVERY', WORDS ) */ -/* FOUND(2) = ELEMC ( 'GOOD', WORDS ) */ -/* FOUND(3) = ELEMC ( 'BOY', WORDS ) */ -/* FOUND(4) = ELEMC ( 'DOES', WORDS ) */ -/* FOUND(5) = ELEMC ( 'FINE', WORDS ) */ - -/* OK = SOMTRU ( FOUND, 5 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 12-JUL-1991 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether some logicals in an array are true */ - -/* -& */ - -/* Just do it. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (logcls[i__ - 1]) { - ret_val = TRUE_; - return ret_val; - } - } - ret_val = FALSE_; - return ret_val; -} /* somtru_ */ - diff --git a/ext/spice/src/cspice/spca2b.c b/ext/spice/src/cspice/spca2b.c deleted file mode 100644 index ee181ee798..0000000000 --- a/ext/spice/src/cspice/spca2b.c +++ /dev/null @@ -1,225 +0,0 @@ -/* spca2b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPCA2B ( SPK and CK, ASCII to binary ) */ -/* Subroutine */ int spca2b_(char *text, char *binary, ftnlen text_len, - ftnlen binary_len) -{ - /* System generated locals */ - cllist cl__1; - - /* Builtin functions */ - integer f_clos(cllist *); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen), spct2b_(integer *, - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int txtopr_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Convert a text (ASCII) format SPK or CK file to an equivalent */ -/* binary file, including comments. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TEXT I Name of an existing text format SPK or CK file. */ -/* BINARY I Name of a binary SPK or CK file to be created. */ - -/* $ Detailed_Input */ - -/* TEXT is the name of an existing text format SPK or CK */ -/* file that may contain comments in the appropriate */ -/* SPC format, as written by SPCB2A or SPCB2T. This */ -/* file is unchanged by calling SPCA2B. */ - -/* BINARY is the name of a binary SPK or CK file to be created. */ -/* The binary file contains the same data and comments */ -/* as the text file, but in the binary format required */ -/* for use with the SPICELIB reader subroutines. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments TEXT and BINARY above. */ - -/* $ Exceptions */ - -/* 1) If there is an IOSTAT error while opening, reading, */ -/* or writing a file, a routine that SPCA2B calls will */ -/* diagnose and signal an error. */ - -/* 2) If the text file is not in the correct format, a */ -/* routine that SPCA2B calls will diagnose and signal */ -/* an error. */ - -/* $ Particulars */ - -/* The SPICELIB SPK and CK reader subroutines read binary files. */ -/* However, because different computing environments have different */ -/* binary representations of numbers, you must convert SPK and CK */ -/* files to text format when porting from one system to another. */ -/* After converting the file to text, you can transfer it using */ -/* a transfer protocol program like Kermit or FTP. Then, convert */ -/* the text file back to binary format. */ - -/* The following is a list of the SPICELIB routines that convert */ -/* SPK and CK files between binary and text format: */ - -/* SPCA2B converts text to binary. It opens the text file, */ -/* creates a new binary file, and closes both files. */ - -/* SPCB2A converts binary to text. It opens the binary file, */ -/* creates a new text file, and closes both files. */ - -/* SPCT2B converts text to binary. It creates a new binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit. */ - -/* SPCB2T converts binary to text. It opens the binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit */ - -/* See the SPC required reading for more information */ -/* about SPC routines and the SPK and CK file formats. */ - -/* $ Examples */ - -/* This is an example of how to use SPCB2A and SPCA2B for */ -/* transferring files. Suppose A.BSP is a binary SPK file in */ -/* environment 1; to transfer it to environment 2, follow */ -/* these three steps: */ - -/* 1) Call SPCB2A within a program in environment 1 to convert */ -/* the file to text: */ - -/* CALL SPCB2A ( 'A.BSP', 'A.TSP' ) */ - -/* 2) Transfer the text file from environment 1 to environment 2 */ -/* using FTP, Kermit, or some other file transfer utility, */ -/* for example, */ - -/* ftp> put A.TSP */ - -/* 3) Call SPCA2B within a program in environment 2 to convert */ -/* the file to binary on the new machine, */ - -/* CALL SPCA2B ( 'A.TSP', 'A.BSP' ) */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the data and comments in the */ -/* text format SPK or CK file come from a binary file */ -/* and were written by one of the routines SPCB2A or SPCB2T. */ -/* Data and/or comments written any other way may not be */ -/* in the correct format and, therefore, may not be handled */ -/* properly. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 05-SEP-1991 (HAN) */ - -/* Removed declarations of unused variables. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* ascii spk or ck to binary */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCA2B", (ftnlen)6); - } - -/* Open the text file with read access. SPCT2B will */ -/* create the binary file and write the data and comments */ -/* to it. Then we close the text file, and we're done. */ - - txtopr_(text, &unit, text_len); - spct2b_(&unit, binary, binary_len); - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("SPCA2B", (ftnlen)6); - return 0; -} /* spca2b_ */ - diff --git a/ext/spice/src/cspice/spcac.c b/ext/spice/src/cspice/spcac.c deleted file mode 100644 index e5fc31df19..0000000000 --- a/ext/spice/src/cspice/spcac.c +++ /dev/null @@ -1,776 +0,0 @@ -/* spcac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure SPCAC ( SPK and CK, add comments ) */ -/* Subroutine */ int spcac_(integer *handle, integer *unit, char *bmark, char - *emark, ftnlen bmark_len, ftnlen emark_len) -{ - /* System generated locals */ - integer i__1, i__2; - cilist ci__1; - alist al__1; - - /* Builtin functions */ - integer f_rew(alist *), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - i_indx(char *, char *, ftnlen, ftnlen), s_rsfe(cilist *), do_fio( - integer *, char *, ftnlen), e_rsfe(void), s_wdue(cilist *), - e_wdue(void); - - /* Local variables */ - char data[1002]; - integer dafu, free; - char line[1000], null[1]; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen); - integer c__, i__, l, bline, space, eline; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer bward, chars, fward; - extern /* Subroutine */ int locln_(integer *, char *, char *, char *, - integer *, integer *, logical *, ftnlen, ftnlen, ftnlen); - integer lines; - logical found; - integer total, start, nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - integer nr; - extern /* Subroutine */ int dafarr_(integer *, integer *), dafrfr_( - integer *, integer *, integer *, char *, integer *, integer *, - integer *, ftnlen); - char record[1000]; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen); - extern integer countc_(integer *, integer *, integer *, char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer lastrr, poseot; - extern logical return_(void); - integer rec, eol; - char eot[1]; - integer nrr, pos; - - /* Fortran I/O blocks */ - static cilist io___24 = { 1, 0, 1, 0, 0 }; - static cilist io___33 = { 1, 0, 0, 0, 0 }; - static cilist io___34 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Store text from a text file in the comment area of a binary SPK */ -/* or CK file, appending it to whatever text may already have */ -/* been stored there. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle assigned to binary SPK or CK file. */ -/* UNIT I Logical unit connected to comment file. */ -/* BMARK I Beginning marker. */ -/* EMARK I Ending marker. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle assigned to the binary SPK or CK file */ -/* which has been opened for write access. */ - -/* UNIT is the logical unit connected to the text file */ -/* which contains the text to be stored in the */ -/* comment area of the binary file. */ - -/* BMARK, */ -/* EMARK are markers that delimit a group of consecutive */ -/* lines in the text file (UNIT), that get stored in the */ -/* comment area of the binary file (HANDLE). */ - -/* The group of lines begins with the line that */ -/* immediately follows the first line of the file */ -/* equivalent to BMARK. It ends with line that */ -/* precedes the next line of the file equivalent to */ -/* EMARK, including blank lines. Leading and */ -/* trailing blanks are ignored when testing for */ -/* equivalence. */ - -/* By convention, if BMARK is blank, the first line of */ -/* the group is the first line of the file; if EMARK is */ -/* blank, the last line of the group is the last line */ -/* of the file. */ - -/* If a marker is non-blank and is not found, or if */ -/* non-blank markers are on successive lines in the text */ -/* file, nothing gets stored in the comment area of */ -/* the binary file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified DAF file is not open for write access, the */ -/* error will be diagnosed by a routine called by this routine. */ - -/* 2) If there is a problem reading from the comment area of the */ -/* binary file, the error SPICE(FILEREADFAILED) is signalled. */ - -/* 3) If there is a problem writing to the comment area of the */ -/* binary file, the error SPICE(FILEWRITEFAILED) is signalled. */ - -/* 4) If there is a problem reading from the text file, */ -/* a routine that SPCAC calls signals an error. */ - -/* 5) If a non-printing ASCII character is encountered in the */ -/* comments, a routine that SPCAC calls diagnoses and signals */ -/* an error. */ - -/* $ Files */ - -/* HANDLE is the handle assigned to the binary SPK or CK file. */ -/* Use DAFOPW to open it for write access and get the */ -/* handle. Upon exit, this binary file will contain */ -/* the specified text from the comment file in its */ -/* comment area, appended to whatever text may already */ -/* have been stored there. SPCAC will include an extra */ -/* blank line between the original text and the */ -/* appended text. */ - -/* UNIT is the logical unit connected to the comment file. */ -/* This file must contain only text (printable */ -/* ASCII characters, namely ASCII 32-126). Open this */ -/* file with read access and get its UNIT using TXTOPR. */ - -/* $ Particulars */ - -/* The structure of SPK and CK files accommodates comments in */ -/* addition to data. The following three routines are available */ -/* for accessing the comment area of a binary SPK or CK file: */ - -/* SPCAC add comments */ - -/* SPCEC extract comments */ - -/* SPCDC delete comments */ - -/* Note that comments must consist of only text, that is, printable */ -/* ASCII characters, specifically ASCII 32-126. This excludes */ -/* tabs (ASCII 9) and control characters. */ - -/* The SPC conversion routines---SPCB2A, SPCA2B, SPCB2T, and */ -/* SPCT2B---include these comments when converting SPK and CK */ -/* files between binary and text formats. */ - -/* $ Examples */ - -/* Suppose we have a binary SPK file called A.BSP and we have */ -/* a text file called COMMENTS.TXT that contains comments */ -/* about the data in the SPK file. */ - -/* The following code fragment stores the entire contents of */ -/* COMMENTS.TXT in the comment area of A.BSP. */ - -/* CALL DAFOPW ( 'A.BSP', HANDLE ) */ - -/* CALL TXTOPR ( 'COMMENTS.TXT', UNIT ) */ - -/* BMARK = ' ' */ -/* EMARK = ' ' */ - -/* CALL SPCAC ( HANDLE, UNIT, BMARK, EMARK ) */ - -/* CLOSE ( UNIT ) */ - -/* Now suppose MORE.TXT is a text file that contains additional */ -/* information about the data in A.BSP, as well as information */ -/* about several other SPK files. The contents of MORE.TXT are */ - -/* \begin A info */ - -/* DATAFILE = A */ -/* SOURCE = JPL, 1990 September 12 */ -/* MISSION = Galileo */ - -/* \end A info */ - -/* \begin B info */ - -/* DATAFILE = B */ -/* SOURCE = JPL, 1988 August 1 */ -/* MISSION = Voyager 2 */ - -/* \end B info */ - -/* \begin C info */ - -/* DATAFILE = C */ -/* SOURCE = JPL, 1994 January 31 */ -/* MISSION = Mars Observer */ - -/* \end C info */ - -/* This code fragment stores only the information that pertains */ -/* to A.BSP, and appends it to the text from COMMENTS.TXT that */ -/* has already been stored in the comment area of A.BSP */ - -/* CALL TXTOPR ( 'MORE.TXT', UNIT ) */ - -/* BMARK = '\begin A info' */ -/* EMARK = '\end A info' */ - -/* CALL SPCAC ( HANDLE, UNIT, BMARK, EMARK ) */ - -/* CLOSE ( UNIT ) */ - -/* CALL DAFCLS ( HANDLE ) */ - -/* Note that, ignoring leading and trailing blanks, BMARK and */ -/* EMARK are exactly equivalent to lines in the text file. */ -/* If the assignment had been instead BMARK = '\ begin A info', */ -/* with an extra space between the slash and the word begin, */ -/* SPCAC would not have found the marker and no comments from */ -/* the text file would be written to the binary file. */ - -/* $ Restrictions */ - -/* 1) The lines in the comment file should not exceed 1000 */ -/* characters in length. SPCAC truncates lines longer than */ -/* this on the right. */ - -/* 2) Use TXTOPR to open text files for read access and get */ -/* the logical unit. System dependencies regarding */ -/* opening text files have been isolated in the routines */ -/* TXTOPN and TXTOPR. */ - -/* 3) This routine assumes that the comment area of the binary SPK */ -/* or CK file contains only text stored by SPCAC. Comments */ -/* written any other way may not be handled properly. */ - -/* 4) The comment area of the binary SPK or CK file must contain */ -/* only one EOT character. This routine seeks back from the */ -/* last reserved record searching for the first EOT it */ -/* encounters. Thus the multiple EOT's will cause the appended */ -/* comments to be invisible to any reader that starts at the */ -/* first reserved record and reads until the first EOT present. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* J.E. McLean (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to utilize new handle manager */ -/* interfaces. */ - -/* - SPICELIB Version 1.3.0, 12-FEB-1999 (FST) */ - -/* Modified the EOT search code to seek back through any */ -/* reserved records, as opposed to just the last one. This */ -/* provides the flexibility to use DAFOPN to reserve records */ -/* that may ultimately be used for storing comments. As a direct */ -/* result of these changes the SPICE(MISSINGEOT) error is no */ -/* longer signalled, since if no EOT is found in the reserved */ -/* records, they are considered available for writes. */ - -/* - SPICELIB Version 1.2.0, 12-MAY-1994 (KRG) */ - -/* Added an IF statement so that DAFARR is called only if new */ -/* reserved records need to be added to the comment area. */ - -/* - SPICELIB Version 1.1.0, 09-APR-1993 (KRG) */ - -/* Added code to initialize the variable LASTRR to zero. This */ -/* variable is used in a function call, MAX ( LASTRR-1, 1 ), */ -/* regardless of whether or not any reserved records are in */ -/* the file. Thus the need to initialize it. */ - -/* - 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* add comments to spk or ck file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* This routine now utilizes DAFSIH to determine if */ -/* HANDLE is open for WRITE access. The call to DAFHLU */ -/* has been replaced with a call to ZZDDHHLU, the handle */ -/* manager interface for retrieving a logical unit. */ -/* DAFHLU is no longer used, since it locks the unit */ -/* returned to its HANDLE, tying up resources in the */ -/* handle manager. */ - -/* - SPICELIB Version 1.2.0, 12-MAY-1994 (KRG) */ - -/* Added an IF statement so that DAFARR is called only if new */ -/* reserved records need to be added to the comment area. */ - -/* - SPICELIB Version 1.1.0, 09-APR-1993 (KRG) */ - -/* Added code to initialize the variable LASTRR to zero. This */ -/* variable is used in a function call, MAX ( LASTRR-1, 1 ), */ -/* regardless of whether or not any reserved records are in */ -/* the file. Thus the need to initialize it. */ - -/* - 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, 05-APR-1991 (JEM) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - -/* MAXCPR is the maximum number of characters per DAF record and */ -/* hence the maximum comment line length. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCAC", (ftnlen)5); - } - -/* Before doing anything, determine if the file associated with */ -/* HANDLE is available for WRITE access. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Rewind the comment file - we'll start the search for BMARK */ -/* and EMARK at the beginnning. Once we have located the markers, */ -/* count the number of lines between them and the number of */ -/* characters in those lines, ignoring trailing blanks. */ - -/* We rewind the file so that we know where the file pointer is. */ -/* LOCLN will compute BLINE and ELINE taking the current position */ -/* of the file pointer as line 1. */ - - al__1.aerr = 0; - al__1.aunit = *unit; - f_rew(&al__1); - locln_(unit, bmark, emark, line, &bline, &eline, &found, bmark_len, - emark_len, (ftnlen)1000); - -/* If the markers are not found, or if BMARK and EMARK are on */ -/* successive lines, there is nothing to put in the comment area. */ - - if (! found) { - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Adjust BLINE and ELINE so we are pointing to the group of lines */ -/* BETWEEN the markers. Check and make sure there is at least one */ -/* line in the group. */ - - if (s_cmp(bmark, " ", bmark_len, (ftnlen)1) != 0) { - ++bline; - } - if (s_cmp(emark, " ", emark_len, (ftnlen)1) != 0) { - --eline; - } - if (bline > eline) { - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Calculate the number of lines and the total number of characters */ -/* in those lines. The characters must all be printable, or */ -/* else COUNTC will signal an error. */ - - lines = eline - bline + 1; - chars = countc_(unit, &bline, &eline, line, (ftnlen)1000); - if (failed_()) { - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Read the file record to find out if the DAF contains any */ -/* reserved records. The reserved records in an array file */ -/* are stored between the first record (the file record) and */ -/* the first summary record. FWARD is the record number of */ -/* that first summary record, and NRR is the number of reserved */ -/* records in the file. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - nrr = fward - 2; - -/* Get the logical unit for reading from and writing to the DAF. */ - - zzddhhlu_(handle, "DAF", &c_false, &dafu, (ftnlen)3); - if (failed_()) { - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Assign the value of NULL and EOT. NULL gets appended to the */ -/* end of each line of text. EOT gets appended to the end of */ -/* all the comments. Assign initial values for SPACE, RECORD, */ -/* and START. */ - - *(unsigned char *)null = '\0'; - *(unsigned char *)eot = '\4'; - space = 0; - s_copy(record, " ", (ftnlen)1000, (ftnlen)1); - start = 0; - lastrr = 0; - if (nrr != 0) { - -/* At this point, we know there exist reserved records in the */ -/* DAF. We need to search from the last record to the first, */ -/* seeking for the EOT (end of transmission) character, as it */ -/* marks the end of the comment region. */ - - lastrr = fward - 1; - i__ = lastrr + 1; - poseot = 0; - while(i__ > 1 && poseot == 0) { - -/* Decrement the counter now. This keeps it in */ -/* sync with the exit conditions. */ - - --i__; - io___24.ciunit = dafu; - io___24.cirec = i__; - iostat = s_rdue(&io___24); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Error reading comment area of binary file named FIL" - "E. IOSTAT = *.", (ftnlen)66); - errint_("*", &iostat, (ftnlen)1); - errfnm_("FILE", &dafu, (ftnlen)4); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Call INDEX. If POSEOT is 0, then RECORD doesn't contain */ -/* the EOT character. */ - - poseot = i_indx(record, eot, (ftnlen)1000, (ftnlen)1); - } - -/* The amount of free space in the reserved records of the */ -/* files is determined by the number of empty reserved */ -/* records ( LASTRR - I ), and the number of characters used */ -/* in last record with data (MAXCPR - POSEOT). */ - - space = (lastrr - i__ + 1) * 1000 - poseot; - -/* Adjust the value of LASTRR to indicate the record where */ -/* the EOT lies. From here on out, the purpose of this */ -/* variable is to indicate where to start dumping comments. */ - - lastrr = i__; - -/* If POSEOT is 0, then there are no comments in the file, but */ -/* there are reserved records. Branch on this: */ - - if (poseot == 0) { - -/* Leaving this string index at zero may be causing all sorts */ -/* of warning bells to go off in your head. However, before */ -/* this index value is used to address the contents of a */ -/* string it's incremented by 1. */ - - start = poseot; - -/* Handle the case when POSEOT is non-zero. */ - - } else { - -/* Replace the end-of-transmission character with a new line */ -/* character (we use null), so a blank line will come between */ -/* the old text and new text in the comment area. START is the */ -/* position after which the first character of the new text */ -/* goes. */ - - *(unsigned char *)&record[poseot - 1] = *(unsigned char *)null; - start = poseot; - } - } - -/* Compute the number of records (NR) needed to store all of these */ -/* characters. */ - -/* Each line should end with a null (ASCII 0) character. The final */ -/* line should also be followed by an end-of-transmission (ASCII 4) */ -/* character. So the total is the number of characters, plus the */ -/* number of lines, plus one for the EOT. */ - -/* If the TOTAL fits in the SPACE available in the last reserved */ -/* record, we don't need to reserve any more. Otherwise compute */ -/* the number we need. */ - - total = chars + lines + 1; - if (total - space > 0) { - nr = (total - space - 1) / 1000 + 1; - } else { - nr = 0; - } - -/* Reserve the records to create a comment area large enough */ -/* to hold it all, if we need to. If we can't do it, there's no */ -/* point in going on. */ - - if (nr > 0) { - dafarr_(handle, &nr); - if (failed_()) { - chkout_("SPCAC", (ftnlen)5); - return 0; - } - } - -/* Load the group of lines in the comment file into the reserved */ -/* records. Keep adding lines to the current record until it has */ -/* been filled, then write it to the DAF, and begin a new record. */ - -/* Computing MAX */ - i__1 = lastrr - 1; - rec = max(i__1,1); - pos = start; - -/* Rewind the text file then skip past the lines that we don't want */ -/* to position the file pointer at the correct record. */ - - al__1.aerr = 0; - al__1.aunit = *unit; - f_rew(&al__1); - i__1 = bline - 1; - for (l = 1; l <= i__1; ++l) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, line, (ftnlen)1000); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - if (iostat != 0) { - setmsg_("Error reading line # in text file named FILE. IOSTAT =" - " *.", (ftnlen)58); - errint_("#", &l, (ftnlen)1); - errint_("*", &iostat, (ftnlen)1); - errfnm_("FILE", unit, (ftnlen)4); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCAC", (ftnlen)5); - return 0; - } - } - -/* Start reading the lines that we do want. LINE is MAXCPR long */ -/* so that's the maximum number of characters that are read. */ - - i__1 = lines; - for (l = 1; l <= i__1; ++l) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, (ftnlen)1000); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - if (iostat != 0) { - setmsg_("Error reading line # in text file named FILE. IOSTAT =" - " *.", (ftnlen)58); - i__2 = l + bline - 1; - errint_("#", &i__2, (ftnlen)1); - errint_("*", &iostat, (ftnlen)1); - errfnm_("FILE", unit, (ftnlen)4); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCAC", (ftnlen)5); - return 0; - } - -/* Each line is followed by a null character. */ - - s_copy(data, line, (ftnlen)1002, (ftnlen)1000); - eol = lastnb_(data, (ftnlen)1002) + 1; - *(unsigned char *)&data[eol - 1] = *(unsigned char *)null; - -/* The final line is followed by an additional */ -/* end-of-transmission character. */ - - if (l == lines) { - ++eol; - *(unsigned char *)&data[eol - 1] = *(unsigned char *)eot; - } - -/* Moving characters one at a time is slower, but simpler, */ -/* than trying to move them in blocks. */ - - i__2 = eol; - for (c__ = 1; c__ <= i__2; ++c__) { - -/* If the current record is full, write it to the DAF. */ - - if (pos == 1000) { - ++rec; - io___33.ciunit = dafu; - io___33.cirec = rec; - iostat = s_wdue(&io___33); - if (iostat != 0) { - goto L100004; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100004; - } - iostat = e_wdue(); -L100004: - if (iostat == 0) { - s_copy(record, " ", (ftnlen)1000, (ftnlen)1); - pos = 0; - } else { - setmsg_("Error writing to record # of the binary file na" - "med FILE. IOSTAT = *.", (ftnlen)68); - errint_("#", &rec, (ftnlen)1); - errint_("*", &iostat, (ftnlen)1); - errfnm_("FILE", &dafu, (ftnlen)4); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCAC", (ftnlen)5); - return 0; - } - } - -/* Add the next character to the current record. */ - - ++pos; - *(unsigned char *)&record[pos - 1] = *(unsigned char *)&data[c__ - - 1]; - } - } - -/* Write the final record to the DAF. */ - - ++rec; - io___34.ciunit = dafu; - io___34.cirec = rec; - iostat = s_wdue(&io___34); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100005; - } - iostat = e_wdue(); -L100005: - if (iostat != 0) { - setmsg_("Error writing the final record, record #, of the binary fil" - "e named FILE. IOSTAT = *.", (ftnlen)85); - errint_("#", &rec, (ftnlen)1); - errint_("*", &iostat, (ftnlen)1); - errfnm_("FILE", &dafu, (ftnlen)4); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCAC", (ftnlen)5); - return 0; - } - chkout_("SPCAC", (ftnlen)5); - return 0; -} /* spcac_ */ - diff --git a/ext/spice/src/cspice/spcb2a.c b/ext/spice/src/cspice/spcb2a.c deleted file mode 100644 index 5c1a89203f..0000000000 --- a/ext/spice/src/cspice/spcb2a.c +++ /dev/null @@ -1,215 +0,0 @@ -/* spcb2a.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPCB2A ( SPK and CK, binary to ASCII ) */ -/* Subroutine */ int spcb2a_(char *binary, char *text, ftnlen binary_len, - ftnlen text_len) -{ - /* System generated locals */ - cllist cl__1; - - /* Builtin functions */ - integer f_clos(cllist *); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen), spcb2t_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Convert a binary SPK or CK file to an equivalent text (ASCII) */ -/* file, including the comment area. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINARY I Name of an existing binary SPK or CK file. */ -/* TEXT I Name of a text file to be created. */ - -/* $ Detailed_Input */ - -/* BINARY is the name of an existing binary SPK or CK file */ -/* that may contain comments in its comment area as */ -/* written by the routine SPCAC. */ - -/* TEXT is the name of a text SPK or CK file to be created. */ -/* The text file will contain the same data and comments */ -/* as the binary file, but in a form more suitable for */ -/* transfer between heterogeneous computing environments. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments BINARY and TEXT. */ - -/* $ Exceptions */ - -/* 1) If there is an IOSTAT error while opening, reading, */ -/* or writing a file, a routine that SPCB2A calls will */ -/* diagnose and signal an error. */ - -/* $ Particulars */ - -/* The SPICELIB SPK and CK reader subroutines read binary files. */ -/* However, because different computing environments have different */ -/* binary representations of numbers, you must convert SPK and CK */ -/* files to text format when porting from one system to another. */ -/* After converting the file to text, you can transfer it using */ -/* a transfer protocol program like Kermit or FTP. Then, convert */ -/* the text file back to binary format. */ - -/* The following is a list of the SPICELIB routines that convert */ -/* SPK and CK files between binary and text format: */ - -/* SPCA2B converts text to binary. It opens the text file, */ -/* creates a new binary file, and closes both files. */ - -/* SPCB2A converts binary to text. It opens the binary file, */ -/* creates a new text file, and closes both files. */ - -/* SPCT2B converts text to binary. It creates a new binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit. */ - -/* SPCB2T converts binary to text. It opens the binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit */ - -/* See the SPC required reading for more information */ -/* about SPC routines and the SPK and CK file formats. */ - -/* $ Examples */ - -/* This is an example of how to use SPCB2A and SPCA2B for */ -/* transferring files. Suppose A.BSP is a binary SPK file in */ -/* environment 1; to transfer it to environment 2, follow */ -/* these three steps: */ - -/* 1) Call SPCB2A within a program in environment 1 to convert */ -/* the file to text: */ - -/* CALL SPCB2A ( 'A.BSP', 'A.TSP' ) */ - -/* 2) Transfer the text file from environment 1 to environment 2 */ -/* using FTP, Kermit, or some other file transfer utility, */ -/* for example, */ - -/* ftp> put A.TSP */ - -/* 3) Call SPCA2B within a program in environment 2 to convert */ -/* the file to binary on the new machine, */ - -/* CALL SPCA2B ( 'A.TSP', 'A.BSP' ) */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the data and comments in the */ -/* text format SPK or CK file come from a binary file */ -/* and were written by one of the routines SPCB2A or SPCB2T. */ -/* Data and/or comments written any other way may not be */ -/* in the correct format and, therefore, may not be handled */ -/* properly. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary spk or ck to ascii */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCB2A", (ftnlen)6); - } - -/* Open the new text file. Call SPCB2T to write the data */ -/* and comments. Then close the text file and we're done. */ - - txtopn_(text, &unit, text_len); - spcb2t_(binary, &unit, binary_len); - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("SPCB2A", (ftnlen)6); - return 0; -} /* spcb2a_ */ - diff --git a/ext/spice/src/cspice/spcb2t.c b/ext/spice/src/cspice/spcb2t.c deleted file mode 100644 index 24277d3ec4..0000000000 --- a/ext/spice/src/cspice/spcb2t.c +++ /dev/null @@ -1,297 +0,0 @@ -/* spcb2t.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; - -/* $Procedure SPCB2T ( SPK and CK, binary to text ) */ -/* Subroutine */ int spcb2t_(char *binary, integer *unit, ftnlen binary_len) -{ - /* Builtin functions */ - integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), - e_wsle(void); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), spcec_(integer *, - integer *), dafb2t_(char *, integer *, ftnlen); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), dafopr_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___2 = { 1, 0, 0, 0, 0 }; - static cilist io___4 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Convert the contents of a binary SPK or CK file to text, */ -/* including comments if present, and write them to a text file */ -/* opened by the calling program. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINARY I Name of an existing binary SPK or CK file. */ -/* UNIT I Logical unit connected to a text file. */ - -/* $ Detailed_Input */ - -/* BINARY is the name of an existing binary SPK or CK file */ -/* that may contain comments in its comment area. */ - -/* UNIT is the logical unit connected to a text file that */ -/* has been opened for write access. Use the routine */ -/* TXTOPN to open this file. Upon exit, this file will */ -/* contain the same data and comments as the binary */ -/* file, but in text format which is more suitable for */ -/* transfer between heterogeneous computing environments. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See arguments BINARY and UNIT above. */ - -/* $ Exceptions */ - -/* 1) If there is a problem opening or reading from the binary file, */ -/* a routine that SPCB2T calls diagnoses and signals an error. */ - -/* 2) If there is a problem writing to the text file, */ -/* the error SPICE(FILEWRITEFAILED) is signalled. */ - -/* $ Particulars */ - -/* The SPICELIB SPK and CK reader subroutines read binary files. */ -/* However, because different computing environments have different */ -/* binary representations of numbers, you must convert SPK and CK */ -/* files to text format when porting from one system to another. */ -/* After converting the file to text, you can transfer it using */ -/* a transfer protocol program like Kermit or FTP. Then, convert */ -/* the text file back to binary format. */ - -/* The following is a list of the SPICELIB routines that convert */ -/* SPK and CK files between binary and text format: */ - -/* SPCA2B converts text to binary. It opens the text file, */ -/* creates a new binary file, and closes both files. */ - -/* SPCB2A converts binary to text. It opens the binary file, */ -/* creates a new text file, and closes both files. */ - -/* SPCT2B converts text to binary. It creates a new binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit. */ - -/* SPCB2T converts binary to text. It opens the binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit */ - -/* See the SPC required reading for more information */ -/* about SPC routines and the SPK and CK file formats. */ - -/* $ Examples */ - -/* The following code fragment creates a text file containing */ -/* text format SPK data and comments preceded and followed */ -/* by a standard label. */ - -/* The SPICELIB routine TXTOPN opens a new text file and TXTOPR */ -/* opens an existing text file for read access. TEXT and */ -/* BINARY are character strings that contain the names of the */ -/* text and binary files. */ - -/* CALL TXTOPN ( TEXT, UNIT ) */ - -/* (Write header label to UNIT) */ - -/* CALL SPCB2T ( BINARY, UNIT ) */ - -/* (Write trailing label to UNIT) */ - -/* CLOSE ( UNIT ) */ - - -/* The following code fragment reconverts the text format */ -/* SPK data and comments back into binary format. */ - -/* CALL TXTOPR ( TEXT, UNIT ) */ - -/* (Read, or just read past, header label from UNIT) */ - -/* CALL SPCT2B ( UNIT, BINARY ) */ - -/* (Read trailing label from UNIT, if desired ) */ - -/* CLOSE ( UNIT ) */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the comment area of the binary SPK */ -/* or CK file contains only text stored by SPCAC. Comments */ -/* written any other way may not be handled properly. */ - -/* 2) UNIT must be obtained via TXTOPN. Use TXTOPN to open new */ -/* text files for write access and get the logical unit. */ -/* System dependencies regarding opening text files have */ -/* been isolated in the routines TXTOPN and TXTOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* binary spk or ck to text */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCB2T", (ftnlen)6); - } - -/* First, convert the binary data to text and write it to */ -/* the text file. */ - - dafb2t_(binary, unit, binary_len); - -/* Next, write the begin comments marker. */ - - io___2.ciunit = *unit; - iostat = s_wsle(&io___2); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, "~NAIF/SPC BEGIN COMMENTS~", (ftnlen)25); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsle(); -L100001: - if (iostat != 0) { - setmsg_("Error writing the begin comments marker to the text file na" - "med FNM. IOSTAT = #.", (ftnlen)80); - errfnm_("FNM", unit, (ftnlen)3); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCB2T", (ftnlen)6); - return 0; - } - -/* Open the DAF for read access, extract the comments from */ -/* it and write them to the text file, then close the DAF. */ -/* If the comment area of the binary file is empty, SPCEC */ -/* writes nothing to the text file, but even so, we still */ -/* want the markers. */ - - dafopr_(binary, &handle, binary_len); - spcec_(&handle, unit); - dafcls_(&handle); - -/* Finally, write the end comments marker. */ - - io___4.ciunit = *unit; - iostat = s_wsle(&io___4); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__9, &c__1, "~NAIF/SPC END COMMENTS~", (ftnlen)23); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsle(); -L100002: - if (iostat != 0) { - setmsg_("Error writing the end comments marker to the text file name" - "d FNM. IOSTAT = #.", (ftnlen)78); - errfnm_("FNM", unit, (ftnlen)3); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCB2T", (ftnlen)6); - return 0; - } - chkout_("SPCB2T", (ftnlen)6); - return 0; -} /* spcb2t_ */ - diff --git a/ext/spice/src/cspice/spcdc.c b/ext/spice/src/cspice/spcdc.c deleted file mode 100644 index 7e84e75733..0000000000 --- a/ext/spice/src/cspice/spcdc.c +++ /dev/null @@ -1,219 +0,0 @@ -/* spcdc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPCDC ( SPK and CK, delete comments ) */ -/* Subroutine */ int spcdc_(integer *handle) -{ - integer free; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer bward, fward, nd, ni; - char ifname[60]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen), dafrrr_(integer *, - integer *), chkout_(char *, ftnlen); - extern logical return_(void); - integer nrr; - -/* $ Abstract */ - -/* Empty the comment area of a binary SPK or CK file. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle assigned to binary SPK or CK file. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle assigned to the binary SPK or CK file */ -/* which has been opened for write access. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file does not contain any comments in its comment area */ -/* on input, it will be unchanged by this routine. */ - -/* $ Files */ - -/* HANDLE is the handle assigned to the binary SPK or CK file. */ -/* Use DAFOPW to open it for write access and get its */ -/* handle. Upon exit, this binary file will have an */ -/* empty comment area: all previous comments are */ -/* deleted. Note, however, that the size of the */ -/* file does not change. */ - -/* $ Particulars */ - -/* The structure of SPK and CK files accommodates comments in */ -/* addition to data. The following three routines are available */ -/* for accessing the comment area of a binary SPK or CK file: */ - -/* SPCAC add comments */ - -/* SPCEC extract comments */ - -/* SPCDC delete comments */ - -/* Note that comments must consist of only text, that is, printable */ -/* ASCII characters, specifically ASCII 32-126. This excludes */ -/* tabs (ASCII 9) and control characters. */ - -/* The SPC conversion routines---SPCB2A, SPCA2B, SPCB2T, and */ -/* SPCT2B---include these comments when converting SPK and CK */ -/* files between binary and text formats. */ - -/* $ Examples */ - -/* 1) Suppose we have a binary SPK file called A.BSP. The following */ -/* code fragment deletes any comments that may have been stored */ -/* in the comment area of the file. */ - -/* CALL DAFOPW ( 'A.BSP', HANDLE ) */ - -/* CALL SPCDC ( HANDLE ) */ - -/* 2) Suppose B.BSP is a binary SPK file with comments in its */ -/* comment area. The routine TXTOPN opens a new text file. */ - -/* C */ -/* C Open the binary SPK file with write access and */ -/* C get its handle. */ -/* C */ -/* CALL DAFOPW ( 'B.BSP', HANDLE ) */ - -/* C */ -/* C Open a new text file and write the comments */ -/* C from the SPK file to it. */ -/* C */ -/* CALL TXTOPN ( 'COMMENTS.TXT', UNIT1 ) */ -/* CALL SPCEC ( HANDLE, UNIT1 ) */ - -/* C */ -/* C Delete the comments in the SPK file. */ -/* C */ -/* CALL SPCDC ( HANDLE ) */ - -/* C */ -/* C Open another new text file and try to write */ -/* C comments from the SPK file to it. */ -/* C */ -/* CALL TXTOPN ( 'NOCOMMENTS.TXT', UNIT2 ) */ -/* CALL SPCEC ( HANDLE, UNIT2 ) */ - -/* After executing this code fragment, COMMENTS.TXT would */ -/* contain the comments from the SPK file. NOCOMMENTS.TXT */ -/* would be empty because of the call to SPCDC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete comments from spk or ck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCDC", (ftnlen)5); - } - -/* The comment area IS the reserved records. To empty the comment */ -/* area we just remove the reserved records. */ - -/* Read the file record to find out how many reserved records are */ -/* in the DAF. The reserved records are stored between the first */ -/* record (the file record) and the first summary record. FWARD */ -/* is the record number of that first summary record, and NRR is */ -/* the number of reserved records in the file. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - nrr = fward - 2; - -/* Once we know how many there are, we can remove them. */ - - dafrrr_(handle, &nrr); - chkout_("SPCDC", (ftnlen)5); - return 0; -} /* spcdc_ */ - diff --git a/ext/spice/src/cspice/spcec.c b/ext/spice/src/cspice/spcec.c deleted file mode 100644 index 17b963f35d..0000000000 --- a/ext/spice/src/cspice/spcec.c +++ /dev/null @@ -1,394 +0,0 @@ -/* spcec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure SPCEC ( SPK and CK, extract comments ) */ -/* Subroutine */ int spcec_(integer *handle, integer *unit) -{ - /* System generated locals */ - integer i__1; - cilist ci__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), - s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), do_fio(integer - *, char *, ftnlen), e_wsfe(void); - - /* Local variables */ - integer dafu, free; - char line[1000], null[1]; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen); - integer c__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer bward, fward, nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - char ifname[60]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - char record[1000]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer rec; - char eot[1]; - integer nrr, pos; - - /* Fortran I/O blocks */ - static cilist io___16 = { 1, 0, 1, 0, 0 }; - static cilist io___18 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Extract the text from the comment area of a binary SPK or CK file */ -/* and write it to a text file. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle assigned to binary SPK or CK file. */ -/* UNIT I Logical unit connected to text file. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle assigned to the binary SPK or CK file */ -/* which has been opened for read access. */ - -/* UNIT is the logical unit connected to the text file to */ -/* which the contents of the comment area of the SPK */ -/* or CK file will be written, beginning at the current */ -/* position of the file pointer. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the comment area of the SPK or CK file is empty, nothing */ -/* will be written to the text file. */ - -/* 2) If there is a problem reading from the comment area, the error */ -/* SPICE(FILEREADFAILED) is signalled. */ - -/* 3) If there is a problem writing to the text file, the error */ -/* SPICE(FILEWRITEFAILED) is signalled. */ - -/* $ Files */ - -/* HANDLE is the handle assigned to the binary SPK or CK file. */ -/* Use DAFOPR to open it for read access and get its */ -/* handle unless SPKLEF or CKLPF has already been called */ -/* and returned the handle. This file is unchanged by */ -/* calling SPCEC. */ - -/* UNIT is the logical unit connected to the text file which */ -/* has been opened for write access. Use TXTOPN to */ -/* open the file and get its logical unit. Upon exit, */ -/* this file will contain the text from the comment */ -/* area of the binary SPK or CK file, beginning at */ -/* the line that was the position of the file pointer */ -/* when SPCEC was called. In other words, SPCEC does */ -/* not rewind or backspace this file before writing */ -/* the text to it. */ - -/* $ Particulars */ - -/* The structure of SPK and CK files accommodates comments in */ -/* addition to data. The following three routines are available */ -/* for accessing the comment area of a binary SPK or CK file: */ - -/* SPCAC add comments */ - -/* SPCEC extract comments */ - -/* SPCDC delete comments */ - -/* Note that comments must consist of only text, that is, printable */ -/* ASCII characters, specifically ASCII 32-126. This excludes */ -/* tabs (ASCII 9) and control characters. */ - -/* The SPC conversion routines---SPCB2A, SPCA2B, SPCB2T, and */ -/* SPCT2B---include these comments when converting SPK and CK */ -/* files between binary and text formats. */ - -/* $ Examples */ - -/* Suppose we have a binary SPK file called A.BSP. The following */ -/* code fragment stores the contents of the comment area of A.BSP */ -/* in a text file called COMMENTS.TXT and surrounds the comments */ -/* with markers. */ - -/* CALL DAFOPR ( 'A.BSP', HANDLE ) */ - -/* CALL TXTOPN ( 'COMMENTS.TXT', UNIT ) */ - -/* WRITE (UNIT,*) '\begincomments' */ - -/* CALL SPCEC ( HANDLE, UNIT ) */ - -/* WRITE (UNIT,*) '\endcomments' */ - -/* $ Restrictions */ - -/* 1) Use TXTOPN to open new text files and get their logical unit. */ -/* There are system dependencies regarding opening text files, */ -/* and these have been isolated in the routines TXTOPN and */ -/* TXTOPR. */ - -/* 2) This routine assumes that the comment area of the binary SPK */ -/* or CK file contains only text stored by SPCAC. Comments */ -/* written any other way may not be handled properly. */ - -/* 3) This routine is only used to read records on environments */ -/* whose characters are a single byte in size. Updates */ -/* to this routine and routines in its call tree may be */ -/* required to properly handle other cases. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to utilize new handle manager */ -/* interfaces. */ - -/* - 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract comments from spk or ck file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* The call to DAFHLU has been replaced with a call to */ -/* ZZDDHHLU, the handle manager interface for retrieving */ -/* a logical unit. DAFHLU is no longer used, since it */ -/* locks the unit returned to its HANDLE, tying up resources */ -/* in the handle manager. A call to DAFSIH was inserted to */ -/* make certain that HANDLE is present in DAFAH's file table. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - -/* MAXCPR is the maximum number of characters per DAF record and */ -/* hence the maximum comment line length. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCEC", (ftnlen)5); - } - -/* First, check to see if HANDLE is a legitimate DAF handle. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("SPCEC", (ftnlen)5); - return 0; - } - -/* Read the file record to find out if the DAF contains any */ -/* reserved records. The reserved records in an array file */ -/* are stored between the first record and the first summary */ -/* record. FWARD is the record number of that first summary */ -/* record, and NRR is the number of reserved records in the file. */ -/* If there are no reserved records, there's nothing to be done. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - nrr = fward - 2; - if (nrr == 0) { - chkout_("SPCEC", (ftnlen)5); - return 0; - } - -/* We need to read directly from the SPK or CK file, using a logical */ -/* unit instead of a handle. */ - - zzddhhlu_(handle, "DAF", &c_false, &dafu, (ftnlen)3); - if (failed_()) { - chkout_("SPCEC", (ftnlen)5); - return 0; - } - -/* Load the contents of the reserved records into individual lines, */ -/* for printing. Keep adding characters to the current line until */ -/* it has been filled, then write it to the text file, and */ -/* begin a new line. */ - -/* In the comment area, NULL means end-of-line, and EOT means */ -/* end-of-transmission, or in other words, end-of-comments. */ - - *(unsigned char *)null = '\0'; - *(unsigned char *)eot = '\4'; - s_copy(line, " ", (ftnlen)1000, (ftnlen)1); - s_copy(record, " ", (ftnlen)1000, (ftnlen)1); - pos = 0; - i__1 = nrr; - for (rec = 1; rec <= i__1; ++rec) { - io___16.ciunit = dafu; - io___16.cirec = rec + 1; - iostat = s_rdue(&io___16); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Error reading comment area of the binary file named FNM" - ". Value of IOSTAT is #.", (ftnlen)79); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &dafu, (ftnlen)3); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCEC", (ftnlen)5); - return 0; - } - for (c__ = 1; c__ <= 1000; ++c__) { - -/* End-of-transmission means we're done. */ - - if (*(unsigned char *)&record[c__ - 1] == *(unsigned char *)eot) { - chkout_("SPCEC", (ftnlen)5); - return 0; - -/* NULL means that the current line is ready to be written to */ -/* the text file. The end-of-line character itself does not */ -/* get written. After this, the current line should be empty */ -/* again. */ - - } else if (*(unsigned char *)&record[c__ - 1] == *(unsigned char * - )null) { - if (pos == 0) { - io___18.ciunit = *unit; - iostat = s_wsle(&io___18); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsle(); -L100002: - ; - } else { - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, pos); - if (iostat != 0) { - goto L100003; - } - iostat = e_wsfe(); -L100003: - ; - } - if (iostat != 0) { - setmsg_("Error writing to the text file named FNM. Valu" - "e of IOSTAT is #.", (ftnlen)64); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCEC", (ftnlen)5); - return 0; - } - s_copy(line, " ", (ftnlen)1000, (ftnlen)1); - pos = 0; - -/* If this a normal character, add it to the current line. */ - - } else { - ++pos; - *(unsigned char *)&line[pos - 1] = *(unsigned char *)&record[ - c__ - 1]; - } - } - } - chkout_("SPCEC", (ftnlen)5); - return 0; -} /* spcec_ */ - diff --git a/ext/spice/src/cspice/spcopn.c b/ext/spice/src/cspice/spcopn.c deleted file mode 100644 index b8cd7c959e..0000000000 --- a/ext/spice/src/cspice/spcopn.c +++ /dev/null @@ -1,210 +0,0 @@ -/* spcopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure SPCOPN ( SPK or CK, open new file ) */ -/* Subroutine */ int spcopn_(char *spc, char *ifname, integer *handle, ftnlen - spc_len, ftnlen ifname_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafopn_(char *, - integer *, integer *, char *, integer *, integer *, ftnlen, - ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open a new SPK or CK file for subsequent write requests. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SPC I Name of SPK or CK file to be created. */ -/* IFNAME I Internal file name. */ -/* HANDLE O Handle of new SPK or CK file. */ - -/* $ Detailed_Input */ - -/* SPC is the name of a new SPK or CK file to be created. */ - -/* IFNAME is the internal file name of the file to be created. */ -/* IFNAME may contain up to 60 characters. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle assigned to the new file. This */ -/* should be used to refer to the file in all subsequent */ -/* calls to DAF and SPC routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* SPK and CK files are Double Precision Array Files (DAFs). High */ -/* level SPK, CK, and SPC routines use lower level DAF routines to */ -/* open, close, read, write, and search a DAF. Any parameters or */ -/* limitations in the DAF specification also apply to SPK and CK */ -/* files. Refer to the on-line DAF Required Reading (also called */ -/* the DAF Specification and User's Guide) for details. */ - -/* Although SPCOPN does not signal any errors directly, it does call */ -/* a routine that signals errors for the following exceptional cases: */ - -/* 1) If the limit is exceeded for the number of DAFs open for */ -/* write access at any one time, */ - -/* 2) If the limit is exceeded for the maximum number of files open */ -/* at any one time, */ - -/* 3) If the file cannot be opened properly, or */ - -/* 4) If the initial records in the file cannot be written. */ - -/* $ Files */ - -/* See argument SPC above. */ - -/* $ Particulars */ - -/* SPCOPN opens a new SPK or CK file. It is identical to DAFOPN */ -/* except SPCOPN defines several of the inputs that DAFOPN */ -/* requires and which specify that the DAF to be opened is an */ -/* SPK or CK file. Use DAFCLS to close any DAF including SPK */ -/* and CK files. */ - -/* SPCOPN, is not to be confused with the routines that load */ -/* and unload files to and from a buffer for use by the readers */ -/* such as SPKLEF (SPK, load ephemeris file) and CKLPF (CK, */ -/* load pointing file). The loading and unloading routines */ -/* open and close the files internally, so there is no need to */ -/* call SPCOPN when loading or unloading SPK or CK files. */ - -/* $ Examples */ - -/* In the following code fragment, SPCOPN opens a new file, */ -/* to which an array is then added. GETDAT is a ficticious */ -/* non-SPICELIB routine whose function is to get the array data. */ -/* DAFBNA begins a new array, DAFADA adds data to an array, */ -/* and DAFENA ends a new array. */ - -/* CALL SPCOPN ( SPC, IFNAME, HANDLE ) */ - -/* CALL DAFBNA ( HANDLE, SUM, NAME ) */ - -/* CALL GETDAT ( N, DATA, FOUND ) */ - -/* DO WHILE ( FOUND ) */ - -/* CALL DAFADA ( N, DATA ) */ -/* CALL GETDAT ( N, DATA, FOUND ) */ - -/* END DO */ - -/* CALL DAFENA */ - -/* CALL DAFCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* open new spk or ck file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* ND, NI are the Number of Double precision and the Number of */ -/* Integer components in an SPK or CK segment descriptor. */ - -/* RESV is the number of records to reserve when opening the */ -/* file. */ - - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCOPN", (ftnlen)6); - } - -/* DAFOPN does all the work. We just handle the values of */ -/* ND and NI which are specific to SPK and CK. We'll not */ -/* reserve any records. */ - - dafopn_(spc, &c__2, &c__6, ifname, &c__0, handle, spc_len, ifname_len); - chkout_("SPCOPN", (ftnlen)6); - return 0; -} /* spcopn_ */ - diff --git a/ext/spice/src/cspice/spcrfl.c b/ext/spice/src/cspice/spcrfl.c deleted file mode 100644 index ecf950ac91..0000000000 --- a/ext/spice/src/cspice/spcrfl.c +++ /dev/null @@ -1,829 +0,0 @@ -/* spcrfl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure SPCRFL ( SPK and CK, read first line of comments ) */ -/* Subroutine */ int spcrfl_0_(int n__, integer *handle, char *line, logical * - eoc, ftnlen line_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); - - /* Local variables */ - static integer dafu, free; - static char temp[1000], null[1]; - extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *, - integer *, ftnlen), chkin_(char *, ftnlen); - static integer bward, fward, nd; - extern logical failed_(void); - static logical called; - static integer ni; - static char ifname[60]; - static integer hanbuf; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen); - static char record[1000]; - static logical eocsav; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - static integer tmplen; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - static integer posnul, rec, bol, eol; - static char eot[1]; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - static integer nrr; - - /* Fortran I/O blocks */ - static cilist io___16 = { 1, 0, 1, 0, 0 }; - static cilist io___21 = { 1, 0, 1, 0, 0 }; - static cilist io___24 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* Read the first line of text from the comment area */ -/* of a binary SPK or CK file. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle assigned to binary SPK or CK file. */ -/* LINE O First line of text from the comment area. */ -/* EOC O End of comments? */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle assigned to the binary SPK or CK file */ -/* which has been opened for read access. */ - -/* $ Detailed_Output */ - -/* LINE is the first line of text from the comment area of */ -/* the SPK or CK file specified by HANDLE. LINE may */ -/* be blank. */ - -/* EOC is true if the comment area is empty. If there */ -/* are comments in the comment area, then EOC is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the comment area of the SPK or CK file is empty, LINE */ -/* will be blank. */ - -/* 2) If the first line of comments in the comment area is longer */ -/* than the declared length of LINE, it will be truncated to */ -/* fit into the variable. */ - -/* 3) If there is a problem reading from the comment area, the error */ -/* SPICE(FILEREADFAILED) is signalled. */ - -/* 4) If the comments are not in the correct format, the error */ -/* SPICE(FORMATERROR) is signalled. */ - -/* $ Files */ - -/* HANDLE is the handle assigned to the binary SPK or CK file. */ -/* Use DAFOPR to open it for read access and get its */ -/* handle unless SPKLEF or CKLPF has already been called */ -/* and returned the handle. This file is unchanged by */ -/* calling SPCRFL. */ - -/* $ Particulars */ - -/* The structure of SPK and CK files accommodates comments in */ -/* addition to data. The following routines are available */ -/* for accessing the comment area of a binary SPK or CK file: */ - -/* SPCAC add comments */ - -/* SPCEC extract comments */ - -/* SPCDC delete comments */ - -/* SPCRFL read first line of comments */ - -/* SPCRNL read next line of comments */ - -/* Note that comments must consist of only text, that is, printable */ -/* ASCII characters, specifically ASCII 32-126. This excludes */ -/* tabs (ASCII 9) and control characters. */ - -/* The SPC conversion routines---SPCB2A, SPCA2B, SPCB2T, and */ -/* SPCT2B---include these comments when converting SPK and CK */ -/* files between binary and text formats. */ - -/* $ Examples */ - -/* Suppose we have a binary SPK file called A.BSP. The following */ -/* code fragment searches the comment area for a lines containing */ -/* the character string `SOURCE' and writes the lines to standard */ -/* output. */ - -/* C */ -/* C Open the binary SPK file and get its handle. */ -/* C */ -/* CALL DAFOPR ( 'A.BSP', HANDLE ) */ - -/* C */ -/* C Read the first line of comments. */ -/* C */ -/* CALL SPCRFL ( HANDLE, LINE, EOC ) */ - -/* C */ -/* C Search for the string 'SOURCE' in the line. If */ -/* C it is found, write the line. Then get the next */ -/* C line of comments and repeat as long as we're not */ -/* C at the end. */ -/* C */ -/* DO WHILE ( .NOT. EOC ) */ - -/* IF ( POS ( LINE, 'SOURCE', 1 ) .NE. 0 ) THEN */ -/* WRITE (*,*) LINE */ -/* END IF */ - -/* CALL SPCRNL ( LINE, EOC ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the comment area of the binary SPK */ -/* or CK file contains only text stored by SPCAC. Comments */ -/* written any other way may not be handled properly. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* J.E. McLean (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this routine to utilize the new handle manager */ -/* interfaces. */ - -/* - SPICELIB Version 1.1.0, 27-JUL-1992 (KRG) */ - -/* Removed a call to the SPICELIB subroutine SUFFIX() which */ -/* was used to join two parts of a comment line that may be */ -/* broken across two comment records. The problem was, SUFFIX */ -/* cannot know about leading/imbedded blanks when it appends, so */ -/* blanks were inadvertantly removed when they happened to be */ -/* stored at the end of comment record. */ - -/* Added the variable TMPLEN to record the length of the first */ -/* part of a comment line that may be broken across comment */ -/* records. */ - -/* - 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, 15-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* read the first comment line of an spk or ck file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Calls to DAFHLU now lock handles to their logical units. */ -/* While at first glance it may seem this is the appropriate */ -/* course of action due to the buffering of the logical unit */ -/* by this routine for its entry point, adding a call to */ -/* ZZDDHUNL in the entry point removes the need to lock DAFU */ -/* to its handle. The value of HANDLE is now buffered in */ -/* HANBUF, to allow the entry point to retrieve a logical */ -/* unit. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* IFNLEN is the length of a DAF internal file name. */ - -/* MAXCPR is the maximum number of characters per DAF record and */ -/* hence the maximum comment line length. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_spcrnl; - } - - if (return_()) { - return 0; - } else { - chkin_("SPCRFL", (ftnlen)6); - } - -/* SPCRFL has been called for this file. */ - - called = TRUE_; - -/* Read the file record to find out if the DAF contains any */ -/* reserved records. The reserved records in an array file */ -/* are stored between the first record and the first summary */ -/* record. FWARD is the record number of that first summary */ -/* record, and NRR is the number of reserved records in the file. */ - -/* If there are no reserved records, there are no comments. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - nrr = fward - 2; - if (nrr == 0) { - s_copy(line, " ", line_len, (ftnlen)1); - *eoc = TRUE_; - eocsav = *eoc; - chkout_("SPCRFL", (ftnlen)6); - return 0; - } - -/* We need to read directly from the SPK/CK file, using a logical */ -/* unit instead of a handle. */ - - zzddhhlu_(handle, "DAF", &c_false, &dafu, (ftnlen)3); - if (failed_()) { - chkout_("SPCRFL", (ftnlen)6); - return 0; - } - -/* Buffer the value of HANDLE. */ - - hanbuf = *handle; - -/* In the comment area, NULL means end-of-line, and EOT means */ -/* end-of-transmission, or in other words, end-of-comments. */ - - *(unsigned char *)null = '\0'; - *(unsigned char *)eot = '\4'; - -/* Read the first reserved record. */ - - rec = 2; - io___16.ciunit = dafu; - io___16.cirec = rec; - iostat = s_rdue(&io___16); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - if (iostat != 0) { - setmsg_("Error reading comment area of the binary file named FNM at " - "record #. Value of IOSTAT is #.", (ftnlen)91); - errint_("#", &rec, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &dafu, (ftnlen)3); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCRFL", (ftnlen)6); - return 0; - } - -/* The first line of comments begins with the first character */ -/* of the record. A NULL character specifies the end. */ - - posnul = pos_(record, null, &c__1, (ftnlen)1000, (ftnlen)1); - if (posnul == 0) { - -/* No NULL is in the record, so LINE is just the whole */ -/* record. (The maximum length of a line written to */ -/* the comment area by SPCAC is MAXCPR characters). */ - - eol = 1000; - } else { - -/* The end of the line precedes the NULL character. */ - - eol = posnul - 1; - } - -/* Now we have the position of the end of the first line. */ -/* Assign it to LINE. We're not yet at the end of comments, */ -/* since we have a line to return. If the first character */ -/* was a NULL, the line is blank. */ - - if (eol == 0) { - s_copy(line, " ", line_len, (ftnlen)1); - } else { - s_copy(line, record, line_len, eol); - } - *eoc = FALSE_; - eocsav = *eoc; - chkout_("SPCRFL", (ftnlen)6); - return 0; -/* $Procedure SPCRNL ( SPK and CK, read next line of comments ) */ - -L_spcrnl: -/* $ Abstract */ - -/* Continue reading lines from the comment area of a binary */ -/* SPK or CK file specified by the most recent call to */ -/* the routine SPCRFL. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) LINE */ -/* LOGICAL EOC */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LINE O Next line of text from the comment area. */ -/* EOC O End of comments? */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* LINE is the next line of text from the comment area of */ -/* the SPK or CK file. LINE may be blank. */ -/* SPCRFL reads the first line of comments from */ -/* a specified binary SPK or CK file. Once SPCRFL */ -/* has been called, SPCRNL may be called repetitively */ -/* to read the next lines of the comment area until */ -/* the end. */ - -/* EOC is true if there are no more comments to read. */ -/* Otherwise, EOC is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If SPCRFL is not called prior to calling SPCRNL, the error */ -/* SPICE(SPCRFLNOTCALLED). */ - -/* 2) If the most recent call to SPCRFL returned EOC with the value */ -/* true, then SPCRNL will return EOC with the same value. */ - -/* 3) If EOC is true, LINE will be blank. */ - -/* 4) If the first line of comments in the comment area is longer */ -/* than the declared length of LINE, it will be truncated to */ -/* fit into the variable. */ - -/* 5) If there is a problem reading from the comment area, the error */ -/* SPICE(FILEREADFAILED) is signalled. */ - -/* 6) If the comments are not in the correct format, the error */ -/* SPICE(FORMATERROR) is signalled. */ - -/* $ Files */ - -/* The handle of the binary SPK or CK is specified with the routine */ -/* SPCRFL. */ - -/* $ Particulars */ - -/* The structure of SPK and CK files accommodates comments in */ -/* addition to data. The following five routines are available */ -/* for accessing the comment area of a binary SPK or CK file: */ - -/* SPCAC add comments */ - -/* SPCEC extract comments */ - -/* SPCDC delete comments */ - -/* SPCRFL read first line of comments */ - -/* SPCRNL read next line of comments */ - -/* Note that comments must consist of only text, that is, printable */ -/* ASCII characters, specifically ASCII 32-126. This excludes */ -/* tabs (ASCII 9) and control characters. */ - -/* The SPC conversion routines---SPCB2A, SPCA2B, SPCB2T, and */ -/* SPCT2B---include these comments when converting SPK and CK */ -/* files between binary and text formats. */ - -/* $ Examples */ - -/* Suppose we have a binary SPK file called A.BSP. The following */ -/* code fragment searches the comment area for a lines containing */ -/* the character string `SOURCE' and writes the lines to standard */ -/* output. */ - -/* C */ -/* C Open the binary SPK file and get its handle. */ -/* C */ -/* CALL DAFOPR ( 'A.BSP', HANDLE ) */ - -/* C */ -/* C Read the first line of comments. */ -/* C */ -/* CALL SPCRFL ( HANDLE, LINE, EOC ) */ - -/* C */ -/* C Search for the string 'SOURCE' in the line. If */ -/* C it is found, write the line. Then get the next */ -/* C line of comments and repeat as long as we're not */ -/* C at the end. */ -/* C */ -/* DO WHILE ( .NOT. EOC ) */ - -/* IF ( POS ( LINE, 'SOURCE', 1 ) .NE. 0 ) THEN */ -/* WRITE (*,*) LINE */ -/* END IF */ - -/* CALL SPCRNL ( LINE, EOC ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the comment area of the binary SPK */ -/* or CK file contains only text stored by SPCAC. Comments */ -/* written any other way may not be handled properly. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* J.E. McLean (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */ - -/* Updated this entry point to utilize the handle manager */ -/* interfaces. See the Revisions section of the subroutine */ -/* header above for a detailed discussion of the changes. */ - -/* - SPICELIB Version 1.1.0, 27-JUL-1992 (KRG) */ - -/* Removed a call to the SPICELIB subroutine SUFFIX() which */ -/* was used to join two parts of a comment line that may be */ -/* broken across two comment records. The problem was, SUFFIX */ -/* cannot know about leading/imbedded blanks when it appends, so */ -/* blanks were inadvertantly removed when they happened to be */ -/* stored at the end of comment record. */ - -/* Added the variable TMPLEN to record the length of the first */ -/* part of a comment line that may be broken across comment */ -/* records. */ - -/* - 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, 15-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* continue reading comments from an spk or ck file */ -/* read the next comment line of an spk or ck file */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCRNL", (ftnlen)6); - } - -/* If SPCRFL hasn't been called, then we don't know which */ -/* file to read from. */ - - if (! called) { - setmsg_("You must call SPCRFL to read the first line of comments bef" - "ore calling SPCRNL to read the next line.", (ftnlen)100); - sigerr_("SPICE(SPCRFLNOTCALLED)", (ftnlen)22); - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* If we were at the end of comments before, then we're still */ -/* at the end. */ - - if (eocsav) { - s_copy(line, " ", line_len, (ftnlen)1); - *eoc = TRUE_; - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* Retrieve a logical unit for HANBUF. */ - - zzddhhlu_(&hanbuf, "DAF", &c_false, &dafu, (ftnlen)3); - if (failed_()) { - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* RECORD contains the last line and EOL is the position of */ -/* the end of that line. Now we need to determine the */ -/* position of the beginning of the next line (BOL). There */ -/* is a NULL between EOL and BOL, so BOL is two more than */ -/* EOL. If that puts BOL off the end of the current RECORD, */ -/* then we have to go to the next record. */ - - bol = eol + 2; - if (bol > 1000) { - bol += -1000; - ++rec; - -/* Check to make sure that we're not reading past the */ -/* reserved records. FWARD is the "forward list pointer". */ -/* It is the number of the first record after the reserved */ -/* records. */ - - if (rec >= fward) { - setmsg_("The comment area of the binary file named FNM is format" - "ted incorrectly. The end of the comments is not marked a" - "s it should be in record #. Calling SPCDC or DAFRRR will" - " remove the comment area and eliminate this format error" - ". Comments should be written ONLY by SPCAC.", (ftnlen)266) - ; - i__1 = rec - 1; - errint_("#", &i__1, (ftnlen)1); - errfnm_("FNM", &dafu, (ftnlen)3); - sigerr_("SPICE(FORMATERROR)", (ftnlen)18); - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* All clear to read the record. */ - - io___21.ciunit = dafu; - io___21.cirec = rec; - iostat = s_rdue(&io___21); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - if (iostat != 0) { - setmsg_("Error reading comment area of the binary file named FNM" - " at record #. Value of IOSTAT is #.", (ftnlen)91); - errint_("#", &rec, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &dafu, (ftnlen)3); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - } - -/* RECORD is now the record of the file that contains the */ -/* beginning of the next line (BOL). The line may not */ -/* exist or may be blank or may be a character string. */ - - if (*(unsigned char *)&record[bol - 1] == *(unsigned char *)eot) { - -/* There isn't a next line to get. We're at the end of */ -/* the comments. */ - - s_copy(line, " ", line_len, (ftnlen)1); - *eoc = TRUE_; - eocsav = *eoc; - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - if (*(unsigned char *)&record[bol - 1] == *(unsigned char *)null) { - -/* Just a NULL means a blank line. */ - - eol = bol - 1; - s_copy(line, " ", line_len, (ftnlen)1); - *eoc = FALSE_; - eocsav = *eoc; - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* The beginning of the next line is a character. Now we have */ -/* to find the end. It precedes the next NULL. */ - - posnul = pos_(record, null, &bol, (ftnlen)1000, (ftnlen)1); - if (posnul != 0) { - eol = posnul - 1; - s_copy(line, record + (bol - 1), line_len, eol - (bol - 1)); - *eoc = FALSE_; - eocsav = *eoc; - } else { - -/* There is no NULL in the rest of the record, so we have to */ -/* read the next record to find it. Save the first part */ -/* of the line in TEMP. */ - - s_copy(temp, record + (bol - 1), (ftnlen)1000, 1000 - (bol - 1)); - tmplen = 1000 - bol + 1; - ++rec; - -/* Check to make sure that we're not reading past the */ -/* reserved records. FWARD is the "forward list pointer". */ -/* It is the number of the first record after the reserved */ -/* records. */ - - if (rec >= fward) { - setmsg_("The comment area of the binary file named FNM is format" - "ted incorrectly. The end of the comments is not marked a" - "s it should be in record #. Calling SPCDC or DAFRRR will" - " remove the comment area and eliminate this format error" - ". Comments should be written ONLY by SPCAC.", (ftnlen)266) - ; - i__1 = rec - 1; - errint_("#", &i__1, (ftnlen)1); - errfnm_("FNM", &dafu, (ftnlen)3); - sigerr_("SPICE(FORMATERROR)", (ftnlen)18); - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* All clear to read the record. */ - - io___24.ciunit = dafu; - io___24.cirec = rec; - iostat = s_rdue(&io___24); - if (iostat != 0) { - goto L100003; - } - iostat = do_uio(&c__1, record, (ftnlen)1000); - if (iostat != 0) { - goto L100003; - } - iostat = e_rdue(); -L100003: - if (iostat != 0) { - setmsg_("Error reading comment area of the binary file named FNM" - " at record #. Value of IOSTAT is #.", (ftnlen)91); - errint_("#", &rec, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &dafu, (ftnlen)3); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - -/* There should be a null in this new record. If there isn't */ -/* then something is wrong. The maximum length of a line is */ -/* MAXCPR characters according to SPCAC. So BOL and the NULL */ -/* should be in the same record or in adjacent records. */ - - posnul = pos_(record, null, &c__1, (ftnlen)1000, (ftnlen)1); - if (posnul == 0) { - setmsg_("Cannot find the end of the line. There is something wr" - "ong with the format of thecomments.", (ftnlen)90); - sigerr_("SPICE(FORMATERROR)", (ftnlen)18); - chkout_("SPCRNL", (ftnlen)6); - return 0; - } - eol = posnul - 1; - -/* EOL is zero if the NULL was the first character of the */ -/* new record. Otherwise, concatenate the two parts of */ -/* the line from the two adjacent records. Then assign the */ -/* values of LINE and EOC. */ - - if (eol != 0) { - i__1 = tmplen; - s_copy(temp + i__1, record, 1000 - i__1, eol); - } - s_copy(line, temp, line_len, (ftnlen)1000); - *eoc = FALSE_; - eocsav = *eoc; - } - chkout_("SPCRNL", (ftnlen)6); - return 0; -} /* spcrfl_ */ - -/* Subroutine */ int spcrfl_(integer *handle, char *line, logical *eoc, - ftnlen line_len) -{ - return spcrfl_0_(0, handle, line, eoc, line_len); - } - -/* Subroutine */ int spcrnl_(char *line, logical *eoc, ftnlen line_len) -{ - return spcrfl_0_(1, (integer *)0, line, eoc, line_len); - } - diff --git a/ext/spice/src/cspice/spct2b.c b/ext/spice/src/cspice/spct2b.c deleted file mode 100644 index b6163ff9fb..0000000000 --- a/ext/spice/src/cspice/spct2b.c +++ /dev/null @@ -1,455 +0,0 @@ -/* spct2b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure SPCT2B ( SPK and CK, text to binary ) */ -/* Subroutine */ int spct2b_(integer *unit, char *binary, ftnlen binary_len) -{ - /* System generated locals */ - integer i__1; - cilist ci__1; - olist o__1; - cllist cl__1; - - /* Builtin functions */ - integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), - s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *), s_wsfe( - cilist *), e_wsfe(void), f_clos(cllist *); - - /* Local variables */ - char line[1000]; - extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *, - ftnlen, ftnlen), chkin_(char *, ftnlen); - extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen); - extern /* Subroutine */ int daft2b_(integer *, char *, integer *, ftnlen); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), dafopw_(char *, integer *, - ftnlen); - integer scrtch; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), getlun_(integer *), - setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Reconstruct a binary SPK or CK file including comments */ -/* from a text file opened by the calling program. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit connected to the text format file. */ -/* BINARY I Name of a binary SPK or CK file to be created. */ - -/* $ Detailed_Input */ - -/* UNIT is the logical unit connected to an existing text */ -/* format SPK or CK file that may contain comments in */ -/* the appropriate SPC format, as written by SPCB2A or */ -/* SPCB2T. This file must be opened for read access */ -/* using the routine TXTOPR. */ - -/* This file may contain text that precedes and */ -/* follows the SPK or CK data and comments, however, */ -/* when calling this routine, the file pointer must be */ -/* in a position in the file such that the next line */ -/* returned by a READ statement is */ - -/* ''NAIF/DAF'' */ - -/* which marks the beginning of the data. */ - -/* BINARY is the name of a binary SPK or CK file to be created. */ -/* The binary file contains the same data and comments */ -/* as the text file, but in the binary format required */ -/* for use with the SPICELIB reader subroutines. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* 1) See arguments UNIT and BINARY above. */ - -/* 2) This routine uses a Fortran scratch file to temporarily */ -/* store the lines of comments if there are any. */ - -/* $ Exceptions */ - -/* 1) If there is a problem opening or writing to the binary */ -/* file, a routine that SPCT2B calls diagnoses and signals */ -/* an error. */ - -/* 2) If there is a problem reading from the text file, the */ -/* error SPICE(FILEREADFAILED) is signalled. */ - -/* 3) If there is a problem opening a scratch file, the error */ -/* SPICE(FILEOPENERROR) is signalled. */ - -/* 4) If there is a problem writing to the scratch file, the */ -/* error SPICE(FILEWRITEFAILED) is signalled. */ - -/* $ Particulars */ - -/* The SPICELIB SPK and CK reader subroutines read binary files. */ -/* However, because different computing environments have different */ -/* binary representations of numbers, you must convert SPK and CK */ -/* files to text format when porting from one system to another. */ -/* After converting the file to text, you can transfer it using */ -/* a transfer protocol program like Kermit or FTP. Then, convert */ -/* the text file back to binary format. */ - -/* The following is a list of the SPICELIB routines that convert */ -/* SPK and CK files between binary and text format: */ - -/* SPCA2B converts text to binary. It opens the text file, */ -/* creates a new binary file, and closes both files. */ - -/* SPCB2A converts binary to text. It opens the binary file, */ -/* creates a new text file, and closes both files. */ - -/* SPCT2B converts text to binary. It creates a new binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit. */ - -/* SPCB2T converts binary to text. It opens the binary */ -/* file and closes it. The text file is open on */ -/* entrance and exit */ - -/* See the SPC required reading for more information */ -/* about SPC routines and the SPK and CK file formats. */ - -/* $ Examples */ - -/* 1) The following code fragment creates a text file containing */ -/* text format SPK data and comments preceded and followed */ -/* by a standard label. */ - -/* The SPICELIB routine TXTOPN opens a new text file and TXTOPR */ -/* opens an existing text file for read access. TEXT and */ -/* BINARY are character strings that contain the names of the */ -/* text and binary files. */ - -/* CALL TXTOPN ( TEXT, UNIT ) */ - -/* (Write header label to UNIT) */ - -/* CALL SPCB2T ( BINARY, UNIT ) */ - -/* (Write trailing label to UNIT) */ - -/* CLOSE ( UNIT ) */ - - -/* The following code fragment reconverts the text format */ -/* SPK data and comments back into binary format. */ - -/* CALL TXTOPR ( TEXT, UNIT ) */ - -/* (Read, or just read past, header label from UNIT) */ - -/* CALL SPCT2B ( UNIT, BINARY ) */ - -/* (Read trailing label from UNIT, if desired ) */ - -/* CLOSE ( UNIT ) */ - - -/* 2) Suppose three text format SPK files have been appended */ -/* together into one text file called THREE.TSP. The following */ -/* code fragment converts each set of data and comments into */ -/* its own binary file. */ - -/* CALL TXTOPR ( 'THREE.TSP', UNIT ) */ - -/* CALL SPCT2B ( UNIT, 'FIRST.BSP' ) */ -/* CALL SPCT2B ( UNIT, 'SECOND.BSP' ) */ -/* CALL SPCT2B ( UNIT, 'THIRD.BSP' ) */ - -/* CLOSE ( UNIT ) */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the data and comments in the */ -/* text format SPK or CK file come from a binary file */ -/* and were written by one of the routines SPCB2A or SPCB2T. */ -/* Data and/or comments written any other way may not be */ -/* in the correct format and, therefore, may not be handled */ -/* properly. */ - -/* 2) Older versions of SPK and CK files did not have a comment */ -/* area. These files, in text format, may still be converted */ -/* to binary using SPCT2B. However, upon exit, the file pointer */ -/* will not be in position ready to read the first line of text */ -/* after the data. Instead, the next READ statement after */ -/* calling SPCT2B will return the second line of text after */ -/* the data. Therefore, example 1 may not work as desired */ -/* if the trailing label begins on the first line after the */ -/* data. To solve this problem, use DAFT2B instead of SPCT2B. */ - -/* 3) UNIT must be obtained via TXTOPR. Use TXTOPR to open text */ -/* files for read access and get the logical unit. System */ -/* dependencies regarding opening text files have been isolated */ -/* in the routines TXTOPN and TXTOPR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ - -/* $ 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* text spk or ck to binary */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCT2B", (ftnlen)6); - } - -/* DAFT2B creates the new binary file and writes the data to */ -/* it. If the 'NAIF/DAF' keyword is not the first line that */ -/* it reads from the text file, it will signal an error. */ -/* Initially, no records are reserved. */ - - daft2b_(unit, binary, &c__0, binary_len); - -/* The comments follow the data and are surrounded by markers. */ -/* BMARK should be the next line that we read. If it isn't, */ -/* then this is an old file, created before the comment area */ -/* existed. In this case, we've read one line too far, but */ -/* we can't backspace because the file was written using list- */ -/* directed formatting (See the ANSI standard). All we can do */ -/* is check out, leaving the file pointer where it is, but */ -/* that's better than signalling an error. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - if (iostat > 0) { - setmsg_("Error reading the text file named FNM. Value of IOSTAT is " - "#.", (ftnlen)61); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", unit, (ftnlen)3); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCT2B", (ftnlen)6); - return 0; - } - i__1 = ltrim_(line, (ftnlen)1000) - 1; - if (s_cmp(line + i__1, "~NAIF/SPC BEGIN COMMENTS~", 1000 - i__1, (ftnlen) - 25) != 0 || iostat < 0) { - chkout_("SPCT2B", (ftnlen)6); - return 0; - } - -/* We're not at the end of the file, and the line we read */ -/* is BMARK, so we write the comments to a scratch file. */ -/* We do this because we have to use SPCAC to add the comments */ -/* to the comment area of the binary file, and SPCAC rewinds */ -/* the file. It's okay for SPCAC to rewind a scratch file, */ -/* but it's not okay to rewind the file connected to UNIT -- */ -/* we don't know the initial location of the file pointer. */ - - getlun_(&scrtch); - o__1.oerr = 1; - o__1.ounit = scrtch; - o__1.ofnm = 0; - o__1.orl = 0; - o__1.osta = "SCRATCH"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = "FORMATTED"; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Error opening a scratch file. File name was FNM. Value of" - " IOSTAT is #.", (ftnlen)72); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &scrtch, (ftnlen)3); - sigerr_("SPICE(FILEOPENERROR)", (ftnlen)20); - chkout_("SPCT2B", (ftnlen)6); - return 0; - } - ci__1.cierr = 1; - ci__1.ciunit = scrtch; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)1000)); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsfe(); -L100002: - if (iostat != 0) { - setmsg_("Error writing to scratch file. File name is FNM. Value of " - "IOSTAT is #.", (ftnlen)71); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &scrtch, (ftnlen)3); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCT2B", (ftnlen)6); - return 0; - } - -/* Continue reading lines from the text file and storing them */ -/* in the scratch file until we get to the end marker. */ - - for(;;) { /* while(complicated condition) */ - i__1 = ltrim_(line, (ftnlen)1000) - 1; - if (!(s_cmp(line + i__1, "~NAIF/SPC END COMMENTS~", 1000 - i__1, ( - ftnlen)23) != 0)) - break; - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, (ftnlen)1000); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - if (iostat != 0) { - setmsg_("Error reading the text file named FNM. Value of IOSTAT" - " is #.", (ftnlen)61); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", unit, (ftnlen)3); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("SPCT2B", (ftnlen)6); - return 0; - } - ci__1.cierr = 1; - ci__1.ciunit = scrtch; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)1000)); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsfe(); -L100004: - if (iostat != 0) { - setmsg_("Error writing to scratch file. File name is FNM. Valu" - "e of IOSTAT is #.", (ftnlen)72); - errint_("#", &iostat, (ftnlen)1); - errfnm_("FNM", &scrtch, (ftnlen)3); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("SPCT2B", (ftnlen)6); - return 0; - } - } - -/* Open the new binary file and add the comments that have been */ -/* stored temporarily in a scratch file. */ - - dafopw_(binary, &handle, binary_len); - spcac_(&handle, &scrtch, "~NAIF/SPC BEGIN COMMENTS~", "~NAIF/SPC END COM" - "MENTS~", (ftnlen)25, (ftnlen)23); - -/* Close the files. The scratch file is automatically deleted. */ - - dafcls_(&handle); - cl__1.cerr = 0; - cl__1.cunit = scrtch; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("SPCT2B", (ftnlen)6); - return 0; -} /* spct2b_ */ - diff --git a/ext/spice/src/cspice/spd.c b/ext/spice/src/cspice/spd.c deleted file mode 100644 index eae877c28e..0000000000 --- a/ext/spice/src/cspice/spd.c +++ /dev/null @@ -1,127 +0,0 @@ -/* spd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPD ( Seconds per day ) */ -doublereal spd_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the number of seconds in a day. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns the number of seconds in a day. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the number of seconds in a day: 86400. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The function always returns the constant value shown above. */ - -/* $ Examples */ - -/* The following code fragment illustrates the use of SPD. */ - -/* C */ -/* C Convert Julian Date to UTC seconds past the reference */ -/* C epoch (J2000). */ -/* C */ -/* SPREF = ( JD - J2000() ) * SPD() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* seconds per day */ - -/* -& */ - -/* Just like it says. */ - - ret_val = 86400.; - return ret_val; -} /* spd_ */ - diff --git a/ext/spice/src/cspice/spd_c.c b/ext/spice/src/cspice/spd_c.c deleted file mode 100644 index b6b545b14e..0000000000 --- a/ext/spice/src/cspice/spd_c.c +++ /dev/null @@ -1,133 +0,0 @@ -/* - --Procedure spd_c ( Seconds per day ) - --Abstract - - Return the number of seconds in a day. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble spd_c ( void ) - -/* - --Brief_I/O - - The function returns the number of seconds in a day. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the number of seconds in a day: 86400. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The function always returns the constant value shown above. - --Examples - - Convert Julian ephemeris date to TDB seconds past the reference - epoch, J2000. - - spref = ( jed - j2000_c() ) * spd_c(); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.1, 10-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - seconds per day - --& -*/ - - -{ /* Begin spd_c */ - - - /* There really isn't much to say. Return the known value. */ - - return 86400.; - - -} /* End spd_c */ - - - diff --git a/ext/spice/src/cspice/sphcyl.c b/ext/spice/src/cspice/sphcyl.c deleted file mode 100644 index 44fbca820e..0000000000 --- a/ext/spice/src/cspice/sphcyl.c +++ /dev/null @@ -1,171 +0,0 @@ -/* sphcyl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPHCYL ( Spherical to cylindrical coordinates ) */ -/* Subroutine */ int sphcyl_(doublereal *radius, doublereal *colat, - doublereal *slong, doublereal *r__, doublereal *long__, doublereal * - z__) -{ - /* Builtin functions */ - double sin(doublereal), cos(doublereal); - - /* Local variables */ - doublereal rr, zz; - -/* $ Abstract */ - -/* This routine converts from spherical coordinates to cylindrical */ -/* coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* RADIUS I Distance of point from origin. */ -/* COLAT I Polar angle (co-latitude in radians) of point. */ -/* SLONG I Azimuthal angle (longitude) of point (radians). */ -/* R O Distance of point from Z axis. */ -/* LONG O angle (radians) of point from XZ plane. */ -/* Z O Height of point above XY plane. */ - -/* $ Detailed_Input */ - -/* RADIUS Distance of the point from origin. */ - -/* COLAT Polar angle (co-latitude in radians) of the point. */ - -/* SLONG Azimuthal angle (longitude) of the point (radians). */ - -/* $ Detailed_Output */ - -/* R Distance of the point of interest from Z axis. */ - -/* LONG cylindrical angle (radians) of the point from the */ -/* XZ plane. */ - -/* Z Height of the point above XY plane. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This returns the cylindrical coordinates of a point whose */ -/* position is input through spherical coordinates. */ - -/* $ Examples */ - - -/* Other than the obvious conversion between coordinate systems */ -/* this routine could be used to obtain the axial projection */ -/* from a sphere to a cylinder about the z-axis that contains */ -/* the equator of the sphere. The following code fragment */ -/* illustrates this idea. */ - -/* CALL SPHCYL ( RADIUS, COLAT, LONG, R, LONG, Z ) */ -/* R = RADIUS */ - -/* R, LONG, and Z now contain the coordinates of the projected */ -/* point. Such a projection is valuable because it preserves the */ -/* areas between regions on the sphere and their projections to the */ -/* cylinder. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* spherical to cylindrical coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Local Variables */ - - -/* Convert to cylindrical coordinates, storing the results in */ -/* temporary variables. */ - - rr = *radius * sin(*colat); - zz = *radius * cos(*colat); - -/* Move the results to the output variables. */ - - *long__ = *slong; - *r__ = rr; - *z__ = zz; - return 0; -} /* sphcyl_ */ - diff --git a/ext/spice/src/cspice/sphcyl_c.c b/ext/spice/src/cspice/sphcyl_c.c deleted file mode 100644 index 6e66fc8aff..0000000000 --- a/ext/spice/src/cspice/sphcyl_c.c +++ /dev/null @@ -1,169 +0,0 @@ -/* - --Procedure sphcyl_c ( Spherical to cylindrical coordinates ) - --Abstract - - This routine converts from spherical coordinates to cylindrical - coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - - - void sphcyl_c ( SpiceDouble radius, - SpiceDouble colat, - SpiceDouble slon, - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------- - radius I Distance of point from origin. - colat I Polar angle (co-latitude in radians) of point. - slon I Azimuthal angle (longitude) of point (radians). - r O Distance of point from z axis. - lon O angle (radians) of point from XZ plane. - z O Height of point above XY plane. - --Detailed_Input - - radius Distance of the point from origin. - - colat Polar angle (co-latitude in radians) of the point. - - slon Azimuthal angle (longitude) of the point (radians). - --Detailed_Output - - r Distance of the point of interest from z axis. - - lon cylindrical angle (radians) of the point from the - XZ plane. - - z Height of the point above XY plane. - --Parameters - - None. - --Particulars - - This returns the cylindrical coordinates of a point whose - position is input through spherical coordinates. - --Examples - - - Other than the obvious conversion between coordinate systems - this routine could be used to obtain the axial projection - from a sphere to a cylinder about the z-axis that contains - the equator of the sphere. The following code fragment - illustrates this idea. - - sphcyl_c ( radius, colat, lon, r, lon, z ) - r = radius - - r, lon, and z now contain the coordinates of the projected - point. Such a projection is valuable because it preserves the - areas between regions on the sphere and their projections to the - cylinder. - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - spherical to cylindrical coordinates - --& -*/ - -{ /* Begin sphcyl_c */ - - /* - Local variables - */ - - SpiceDouble rr; - SpiceDouble zz; - - /* - Convert to cylindrical coordinates, storing the results in - temporary variables. - */ - - rr = radius * sin( colat ); - zz = radius * cos( colat ); - - - /* Move the results to the output variables. */ - - *lon = slon; - *r = rr; - *z = zz; - - -} /* End sphcyl_c */ diff --git a/ext/spice/src/cspice/sphlat.c b/ext/spice/src/cspice/sphlat.c deleted file mode 100644 index 7773914e17..0000000000 --- a/ext/spice/src/cspice/sphlat.c +++ /dev/null @@ -1,178 +0,0 @@ -/* sphlat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPHLAT ( Spherical to latitudinal coordinates ) */ -/* Subroutine */ int sphlat_(doublereal *r__, doublereal *colat, doublereal * - longs, doublereal *radius, doublereal *long__, doublereal *lat) -{ - extern doublereal halfpi_(void); - doublereal rr, lattud; - -/* $ Abstract */ - -/* Convert from spherical coordinates to latitudinal coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* R I Distance of the point from the origin. */ -/* COLAT I Angle of the point from positive Z axis (radians). */ -/* LONGS I Angle of the point from the XZ plane (radians). */ -/* RADIUS O Distance of a point from the origin */ -/* LONG O Angle of the point from the XZ plane in radians */ -/* LAT O Angle of the point from the XY plane in radians */ - -/* $ Detailed_Input */ - -/* R Distance of the point from the origin. */ - -/* COLAT Angle between the vector from the origin to the point */ -/* and the positive Z axis in radians. */ - -/* LONGS Angle of the point from the XZ plane (radians). */ - -/* $ Detailed_Output */ - -/* RADIUS Distance of a point from the origin */ - -/* LONG Angle of the point from the XZ plane in radians */ - -/* LAT Angle of the point from the XY plane in radians */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the latitudinal coordinates of a point */ -/* whose position is input in spherical coordinates. */ - -/* Latitudinal coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* above the equator of a sphere centered at the central reference */ -/* point. */ - -/* Spherical coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* from the z-axis. */ - -/* $ Examples */ - - -/* Latitude is obtained by subtracting co-latitude from HALFPI() */ -/* Radius and longitude mean the same thing in both latitudinal */ -/* and spherical coordinates. The table below lists LAT and */ -/* corresponding COLAT in terms of degrees. */ - -/* LAT COLAT */ -/* ------ ------ */ -/* 0 90 */ -/* 20 70 */ -/* 45 45 */ -/* -30 120 */ -/* 90 0 */ -/* -45 135 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* spherical to latitudinal coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Convert to latitudinal coordinates, storing the results in */ -/* temporary variables */ - - rr = *r__; - lattud = halfpi_() - *colat; - -/* Move the results to the output variables. */ - - *long__ = *longs; - *radius = rr; - *lat = lattud; - return 0; -} /* sphlat_ */ - diff --git a/ext/spice/src/cspice/sphlat_c.c b/ext/spice/src/cspice/sphlat_c.c deleted file mode 100644 index 19f16a12ea..0000000000 --- a/ext/spice/src/cspice/sphlat_c.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure sphlat_c ( Spherical to latitudinal coordinates ) - --Abstract - - Convert from spherical coordinates to latitudinal coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include "SpiceUsr.h" - - - void sphlat_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lons, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - r I Distance of the point from the origin. - colat I Angle of the point from positive z axis (radians). - lons I Angle of the point from the XZ plane (radians). - radius O Distance of a point from the origin - lon O Angle of the point from the XZ plane in radians - lat O Angle of the point from the XY plane in radians - --Detailed_Input - - r Distance of the point from the origin. - - colat Angle between the vector from the origin to the point - and the positive z axis in radians. - - lons Angle of the point from the XZ plane (radians). - --Detailed_Output - - radius Distance of a point from the origin - - lon Angle of the point from the XZ plane in radians - - lat Angle of the point from the XY plane in radians - --Parameters - - None. - --Particulars - - This routine returns the latitudinal coordinates of a point - whose position is input in spherical coordinates. - - Latitudinal coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - above the equator of a sphere centered at the central reference - point. - - Spherical coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - from the z-axis. - --Examples - - - Latitude is obtained by subtracting co-latitude from HALFPI() - Radius and longitude mean the same thing in both latitudinal - and spherical coordinates. The table below lists lat and - corresponding colat in terms of degrees. - - lat colat - ------ ------ - 0 90 - 20 70 - 45 45 - -30 120 - 90 0 - -45 135 - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - spherical to latitudinal coordinates - --& -*/ - -{ /* Begin sphlat_c */ - - /* - Local variables - */ - - SpiceDouble rr; - SpiceDouble lattud; - - rr = r; - lattud = halfpi_c() - colat; - - - /* Move the results to the output variables. */ - - *lon = lons; - *radius = rr; - *lat = lattud; - - -} /* End sphlat_c */ diff --git a/ext/spice/src/cspice/sphrec.c b/ext/spice/src/cspice/sphrec.c deleted file mode 100644 index 885a4340a0..0000000000 --- a/ext/spice/src/cspice/sphrec.c +++ /dev/null @@ -1,201 +0,0 @@ -/* sphrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPHREC ( Spherical to rectangular coordinates ) */ -/* Subroutine */ int sphrec_(doublereal *r__, doublereal *colat, doublereal * - long__, doublereal *rectan) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal x, y, z__; - -/* $ Abstract */ - -/* Convert from spherical coordinates to rectangular coordinates. */ - -/* $ 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 */ - -/* CONVERSION, COORDINATES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* R I Distance of a point from the origin. */ -/* COLAT I Angle of the point from the positive Z-axis. */ -/* LONG I Angle of the point from the XZ plane in radians. */ -/* RECTAN O Rectangular coordinates of the point. */ - -/* $ Detailed_Input */ - -/* R Distance of the point from the origin. */ - -/* COLAT Angle between the point and the positive z-axis. */ - -/* LONG Angle of the projection of the point to the XY */ -/* plane from the positive X-axis. The positive */ -/* Y-axis is at longitude PI/2 radians. */ - -/* $ Detailed_Output */ - -/* RECTAN The rectangular coordinates of a point. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the rectangular coordinates of a point */ -/* whose position is input in spherical coordinates. */ - -/* Spherical coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* from the z-axis. The co-latitude of the positive Z-axis is */ -/* zero. The longitude of the posive Y-axis is PI/2 radians. */ - -/* $ Examples */ - -/* Below are two tables. */ - -/* Listed in the first table (under R, COLAT and LONG ) are */ -/* spherical coordinate triples that approximately represent points */ -/* whose rectangular coordinates are taken from the set {-1, 0, 1}. */ -/* (Angular quantities are given in degrees.) */ - -/* The result of the code fragment */ - -/* Use the SPICELIB routine CONVRT to convert the angular */ -/* quantities to radians */ - -/* CALL CONVRT ( COLAT, 'DEGREES', 'RADIANS', LAT ) */ -/* CALL CONVRT ( LONG, 'DEGREES', 'RADIANS', LONG ) */ - -/* CALL SPHREC ( R, COLAT, LONG, X ) */ - - -/* are listed in the second parallel table under X(1), X(2) and X(3). */ - -/* R COLAT LONG X(1) X(2) X(3) */ -/* ---------------------------- -------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 90.0000 0.0000 1.0000 0.0000 0.0000 */ -/* 1.0000 90.0000 90.0000 0.0000 1.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 0.0000 0.0000 1.0000 */ -/* 1.0000 90.0000 180.0000 -1.0000 0.0000 0.0000 */ -/* 1.0000 90.0000 -90.0000 0.0000 -1.0000 0.0000 */ -/* 1.0000 180.0000 0.0000 0.0000 0.0000 -1.0000 */ -/* 1.4142 90.0000 45.0000 1.0000 1.0000 0.0000 */ -/* 1.4142 45.0000 0.0000 1.0000 0.0000 1.0000 */ -/* 1.4142 45.0000 90.0000 0.0000 1.0000 1.0000 */ -/* 1.7320 54.7356 45.0000 1.0000 1.0000 1.0000 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 24-SEP-1997 (WLT) */ - -/* The BRIEF I/O section was corrected so that it */ -/* correctly reflects the inputs and outputs. */ - -/* - SPICELIB Version 1.0.2, 12-JUL-1995 (WLT) */ - -/* The header documentation was corrected so that longitude */ -/* now is correctly described as the angle from the */ -/* XZ plane instead of XY. */ - -/* - 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 */ - -/* spherical to rectangular coordinates */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - -/* Local Variables */ - - -/* Convert to rectangular coordinates, storing in the results in */ -/* temporary variables */ - - x = *r__ * cos(*long__) * sin(*colat); - y = *r__ * sin(*long__) * sin(*colat); - z__ = *r__ * cos(*colat); - -/* Move the results to the output variables */ - - rectan[0] = x; - rectan[1] = y; - rectan[2] = z__; - return 0; -} /* sphrec_ */ - diff --git a/ext/spice/src/cspice/sphrec_c.c b/ext/spice/src/cspice/sphrec_c.c deleted file mode 100644 index 24289543cc..0000000000 --- a/ext/spice/src/cspice/sphrec_c.c +++ /dev/null @@ -1,186 +0,0 @@ -/* - --Procedure sphrec_c ( Spherical to rectangular coordinates ) - --Abstract - - Convert from spherical coordinates to rectangular coordinates. - --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 - - CONVERSION, COORDINATES - -*/ - - #include - #include "SpiceUsr.h" - - - void sphrec_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble rectan[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - r I Distance of a point from the origin. - colat I Angle of the point from the positive Z-axis. - lon I Angle of the point from the XZ plane in radians. - rectan O Rectangular coordinates of the point. - --Detailed_Input - - r Distance of the point from the origin. - - colat Angle between the point and the positive z-axis. - - lon Angle of the projection of the point to the XY - plane from the positive X-axis. The positive - Y-axis is at longitude PI/2 radians. - --Detailed_Output - - rectan The rectangular coordinates of a point. - --Parameters - - None. - --Particulars - - This routine returns the rectangular coordinates of a point - whose position is input in spherical coordinates. - - Spherical coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - from the z-axis. The co-latitude of the positive Z-axis is - zero. The longitude of the posive Y-axis is PI/2 radians. - --Examples - - Below are two tables. - - Listed in the first table (under r, colat and lon ) are - spherical coordinate triples that approximately represent points - whose rectangular coordinates are taken from the set {-1, 0, 1}. - (Angular quantities are given in degrees.) - - The result of the code fragment - - Use the CSPICE routine convrt_c to convert the angular - quantities to radians - - convrt_c ( colat, "DEGREES", "RADIANS", lat ) - convrt_c ( lon, "DEGREES", "RADIANS", lon ) - - sphrec_c ( r, colat, lon, X ) - - - are listed in the second parallel table under X(1), X(2) and X(3). - - r colat lon X(1) X(2) X(3) - ---------------------------- -------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 90.0000 0.0000 1.0000 0.0000 0.0000 - 1.0000 90.0000 90.0000 0.0000 1.0000 0.0000 - 1.0000 0.0000 0.0000 0.0000 0.0000 1.0000 - 1.0000 90.0000 180.0000 -1.0000 0.0000 0.0000 - 1.0000 90.0000 -90.0000 0.0000 -1.0000 0.0000 - 1.0000 180.0000 0.0000 0.0000 0.0000 -1.0000 - 1.4142 90.0000 45.0000 1.0000 1.0000 0.0000 - 1.4142 45.0000 0.0000 1.0000 0.0000 1.0000 - 1.4142 45.0000 90.0000 0.0000 1.0000 1.0000 - 1.7320 54.7356 45.0000 1.0000 1.0000 1.0000 - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - spherical to rectangular coordinates - --& -*/ - -{ /* Begin sphrec_c */ - - /* - Local variables - */ - - SpiceDouble x; - SpiceDouble y; - SpiceDouble z; - - - /* Function Body */ - - x = r * cos( lon ) * sin( colat ); - y = r * sin( lon ) * sin( colat ); - z = r * cos( colat ); - - - /* Move the results to the output variables */ - - rectan[0] = x; - rectan[1] = y; - rectan[2] = z; - - -} /* End sphrec_c */ diff --git a/ext/spice/src/cspice/sphsd.c b/ext/spice/src/cspice/sphsd.c deleted file mode 100644 index ce0dc3b16d..0000000000 --- a/ext/spice/src/cspice/sphsd.c +++ /dev/null @@ -1,254 +0,0 @@ -/* sphsd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b7 = -1.; -static doublereal c_b8 = 1.; - -/* $Procedure SPHSD ( Spherical surface distance ) */ -doublereal sphsd_(doublereal *radius, doublereal *long1, doublereal *lat1, - doublereal *long2, doublereal *lat2) -{ - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double sin(doublereal), cos(doublereal), acos(doublereal); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal sl1sl2; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - doublereal cosang; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the distance between two points on a sphere, measured */ -/* along the shortest great circle arc connecting them. */ - -/* $ 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 */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* RADIUS I Radius of sphere. */ -/* LONG1, */ -/* LAT1 I Longitude and latitude of first point in radians. */ -/* LONG2, */ -/* LAT2 I Longitude and latitude of second point in radians. */ - -/* The function returns the distance between the two input points, */ -/* measured along the shortest great circle arc connecting them. */ - -/* $ Detailed_Input */ - -/* RADIUS Radius of the sphere on which the points are */ -/* located. */ - -/* LONG1, */ -/* LAT1 Longitude and latitude of the first point. The */ -/* units are radians. */ - -/* LONG2, */ -/* LAT2 Longitude and latitude of the second point. The */ -/* units are radians. */ - -/* $ Detailed_Output */ - -/* The function returns the distance between the two input points, */ -/* measured along the shortest great circle arc connecting them. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If RADIUS is negative, the error SPICE(INPUTOUTOFRANGE) */ -/* is signalled. SPHSD is set to zero. RADIUS may be zero; */ -/* this case is not treated as an exception. */ - -/* 2) Latitudes out of the range [-pi/2, pi/2] are NOT treated */ -/* as errors, although they are not valid in the latitudinal */ -/* coordinate system and so may be considered to be exceptional */ -/* inputs. All latitude values are used in the same way in the */ -/* computation, regardless of whether or not they are in range. */ -/* See the code for the equation used. */ - -/* 3) Longitudes out of the range (-pi, pi] are NOT treated */ -/* as errors, although they are not valid in the latitudinal */ -/* coordinate system and so may be considered to be exceptional */ -/* inputs. All longitude values are used in the same way in the */ -/* computation, regardless of whether or not they are in range. */ -/* See the code for the equation used. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* You may need to consider whether a spherical model is adequate */ -/* for your application; some bodies may be more accurately modelled */ -/* by an oblate or prolate spheroid, or by a triaxial ellipsoid. */ - -/* $ Examples */ - -/* 1) To find the distance along a sphere of radius 1000 km between */ -/* the points at */ - -/* longitude = 1.570796326794897D0 (pi/2) radians, */ -/* latitude = 7.853981633974483D-1 (pi/4) radians */ - -/* and */ - -/* longitude = 0.0D0 radians, */ -/* latitude = 7.853981633974483D-1 (pi/4) radians, */ - -/* we could make the function call: */ - -/* DIST = SPHSD ( 1.0D3, */ -/* . 1.570796326794897D0, 7.853981633974483D-1, */ -/* . 0.D0, 7.853981633974483D-1 ) */ - -/* The value of DIST should be */ - -/* 1.047197551196598D3, */ - -/* which is (very, very close to) 1000 * pi/3. */ - -/* The exact numbers used in this example were obtained using */ -/* VAX Fortran 77 on a VAX 11/780; different compilers and */ -/* systems may yield different results. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* spherical surface distance */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check RETURN but do not check in unless an error is detected. */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } - -/* Make sure that RADIUS is ok; check in only if it isn't. */ - - if (*radius < 0.) { - ret_val = 0.; - chkin_("SPHSD", (ftnlen)5); - setmsg_("Radius was #.", (ftnlen)13); - errdp_("#", radius, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("SPHSD", (ftnlen)5); - return ret_val; - } - -/* The usual equation for the distance between points, measured */ -/* along a great circle, is: */ - -/* -1 */ -/* DIST = COS ( ( COS(LONG1-LONG2) * COS(LAT1) * COS(LAT2) ) */ -/* + ( SIN(LAT1) * SIN(LAT2) ) ) */ - -/* * RADIUS */ - -/* To arrive at this equation, we find the cartesian coordinates of */ -/* the input surface points and take the dot product of the two */ -/* points. */ - -/* To save a trig function reference, however, we implement this */ -/* calculation slightly differently. */ - - -/* COSANG is the cosine of the angle between the two position */ -/* vectors. We bracket COSANG 'tween -1 and 1 to make sure */ -/* round-off error doesn't take it out of the domain of arc */ -/* cosine... */ - - sl1sl2 = sin(*lat1) * sin(*lat2); - cosang = cos(*long1 - *long2) * (cos(*lat1 - *lat2) - sl1sl2) + sl1sl2; - ret_val = *radius * acos(brcktd_(&cosang, &c_b7, &c_b8)); - return ret_val; -} /* sphsd_ */ - diff --git a/ext/spice/src/cspice/spk14a.c b/ext/spice/src/cspice/spk14a.c deleted file mode 100644 index ec48882393..0000000000 --- a/ext/spice/src/cspice/spk14a.c +++ /dev/null @@ -1,377 +0,0 @@ -/* spk14a.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPK14A ( SPK type 14: Add data to a segment ) */ -/* Subroutine */ int spk14a_(integer *handle, integer *ncsets, doublereal * - coeffs, doublereal *epochs) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errhan_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), sgwfpk_(integer *, integer *, doublereal *, integer *, - doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Add data to a type 14 SPK segment associated with HANDLE. See */ -/* also SPK14B and SPK14E. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of an SPK file open for writing. */ -/* NCSETS I The number of coefficient sets and epochs. */ -/* COEFFS I The collection of coefficient sets. */ -/* EPOCHS I The epochs associated with the coefficient sets. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* NCSETS is the number of Chebyshev coefficient sets and epochs */ -/* to be stored in the segment. */ - -/* COEFFS contains a time-ordered array of Chebyshev coefficient */ -/* sets for computing the state vector of a body packed one */ -/* after the other into an array. A state vector contains */ -/* the position, X, Y, Z coordinates, and the velocities, */ -/* dX/dt, dY/dt, dZ/dt, for the position of a body relative */ -/* to a center of motion. */ - -/* See the $ Particulars section for details on how to store */ -/* the coefficient sets in the array. */ - -/* EPOCHS contains the initial epochs (ephemeris seconds past */ -/* J2000) corresponding to the Chebyshev coefficients in */ -/* COEFFS. The I'th epoch is associated with the I'th */ -/* Chebyshev coefficient set. The epochs must form a */ -/* strictly increasing sequence. */ - -/* $ Detailed_Output */ - -/* None. The ephemeris data is stored in a segment in the SPK file */ -/* associated with HANDLE. */ - -/* See the $ Particulars section for details about the */ -/* structure of a type 14 SPK segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine adds data to a type 14 SPK segment that is associated */ -/* with HANDLE. The segment must have been started by a call to the */ -/* routine SPK14B, the routine which begins a type 14 SPK segment. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 14 SPK segments. These routines are: */ - -/* SPK14B: Begin a type 14 SPK segment. This routine must be */ -/* called before any data may be added to a type 14 */ -/* segment. */ - -/* SPK14A: Add data to a type 14 SPK segment. This routine may be */ -/* called any number of times after a call to SPK14B to */ -/* add type 14 records to the SPK segment that was */ -/* started. */ - -/* SPK14E: End a type 14 SPK segment. This routine is called to */ -/* make the type 14 segment a permanent addition to the */ -/* SPK file. Once this routine is called, no further type */ -/* 14 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 14 SPK segment consists of coefficient sets for fixed order */ -/* Chebyshev polynomials over consecutive time intervals, where the */ -/* time intervals need not all be of the same length. The Chebyshev */ -/* polynomials represent the position, X, Y, and Z coordinates, and */ -/* the velocities, dX/dt, dY/dt, and dZ/dt, of BODY relative to */ -/* CENTER. */ - -/* The ephemeris data supplied to the type 14 SPK writer is packed */ -/* into an array as a sequence of logical records, */ - -/* ----------------------------------------------------- */ -/* | Record 1 | Record 2 | ... | Record N-1 | Record N | */ -/* ----------------------------------------------------- */ - -/* with each record has the following format. */ - -/* ------------------------------------------------ */ -/* | The midpoint of the approximation interval | */ -/* ------------------------------------------------ */ -/* | The radius of the approximation interval | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X velocity | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y velocity | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z velocity | */ -/* ------------------------------------------------ */ - -/* $ Examples */ - -/* Assume we have the following for each of the examples that */ -/* follow. */ - -/* HANDLE is the handle of an SPK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the SPK */ -/* segment we will create. */ - -/* BODY is the SPICE ID code for the body whose ephemeris */ -/* is to be placed into the file. */ - -/* CENTER is the center of motion for the ephemeris of BODY. */ - -/* REFFRM is the name of the SPICE inertial reference frame */ -/* for the ephemeris. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* Example 1: */ - -/* For this example, we also assume that: */ - -/* N is the number of type 14 records that we want to */ -/* put into a segment in an SPK file. */ - -/* RECRDS contains N type 14 records packaged for the SPK */ -/* file. */ - -/* ETSTRT contains the initial epochs for each of the */ -/* records contained in RECRDS, where */ - -/* ETSTRT(I) < ETSTRT(I+1), I = 1, N-1 */ - -/* ETSTRT(1) <= FIRST, ETSTRT(N) < LAST */ - -/* ETSTRT(I+1), I = 1, N-1, is the ending epoch for */ -/* record I as well as the initial epoch for record */ -/* I+1. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 14 SPK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL SPK14B ( HANDLE, SEGID, BODY, CENTER, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL SPK14A ( HANDLE, N, RECRDS, ETSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the SPK file. */ -/* C */ -/* CALL SPK14E ( HANDLE ) */ - -/* Example 2: */ - -/* In this example we want to add type 14 SPK records, as */ -/* described above in the $ Particulars section, to the segment */ -/* being written as they are generated. The ability to write the */ -/* records in this way is useful if computer memory is limited. It */ -/* may also be convenient from a programming perspective to write */ -/* the records one at a time. */ - -/* For this example, assume that we want to generate N type 14 SPK */ -/* records, one for each of N time intervals, writing them all to */ -/* the same segment in the SPK file. Let */ - -/* N be the number of type 14 records that we want to */ -/* generate and put into a segment in an SPK file. */ - -/* RECORD be an array with enough room to hold a single type */ -/* 14 record, i.e. RECORD should have dimension at */ -/* least 6 * (CHBDEG + 1 ) + 2. */ - -/* START be an array of N times that are the beginning */ -/* epochs for each of the intervals of interest. The */ -/* times should be in increasing order and the start */ -/* time for the first interval should equal the */ -/* starting time for the segment. */ - -/* START(I) < START(I+1), I = 1, N-1 */ - -/* START(1) = FIRST */ - -/* STOP be an array of N times that are the ending epochs */ -/* for each of the intervals of interest. The times */ -/* should be in increasing order and the stop time for */ -/* interval I should equal the start time for interval */ -/* I+1, i.e., we want to have continuous coverage in */ -/* time across all of the records. Also, the stop time */ -/* for the last interval should equal the ending time */ -/* for the segment. */ - -/* STOP(I) < STOP(I+1), I = 1, N-1 */ - -/* STOP(I) = START(I+1), I = 1, N-1 */ - -/* STOP(N) = LAST */ - -/* GENREC( TIME1, TIME2, RECORD ) */ - -/* be a subroutine that generates a type 14 SPK record */ -/* for a time interval specified by TIME1 and TIME2. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 14 SPK segment if all of the data for the segment is not */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL SPK14B ( HANDLE, SEGID, BODY, CENTER, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ - -/* C */ -/* C Generate the records and write them to the segment in the */ -/* C SPK file one at at time. */ -/* C */ -/* DO I = 1, N */ - -/* CALL GENREC ( START(I), STOP(I), RECORD ) */ -/* CALL SPK14A ( HANDLE, 1, RECORD, START(I) ) */ - -/* END DO */ - -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the SPK file. */ -/* C */ -/* CALL SPK14E ( HANDLE ) */ - -/* $ Restrictions */ - -/* 1) The type 14 SPK segment to which we are adding data must have */ -/* been started by the routine SPK14B, the routine which begins a */ -/* type 14 SPK segment. */ - -/* $ Exceptions */ - -/* 1) If the number of coefficient sets and epochs is not positive, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Removed DAFHLU call; replaced ERRFN call with ERRHAN. */ - -/* - SPICELIB Version 1.0.0, 06-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* add data to a type_14 spk segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPK14A", (ftnlen)6); - } - -/* First, check to see if the number of coefficient sets and epochs */ -/* is positive. */ - - if (*ncsets <= 0) { - setmsg_("The number of coefficient sets and epochs to be added to th" - "e SPK segment in the file '#' was not positive. Its value wa" - "s: #.", (ftnlen)124); - errhan_("#", handle, (ftnlen)1); - errint_("#", ncsets, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SPK14A", (ftnlen)6); - return 0; - } - -/* Add the data. */ - - sgwfpk_(handle, ncsets, coeffs, ncsets, epochs); - -/* No need to check FAILED() here, since all we do is check out. */ -/* Leave it up to the caller. */ - - chkout_("SPK14A", (ftnlen)6); - return 0; -} /* spk14a_ */ - diff --git a/ext/spice/src/cspice/spk14a_c.c b/ext/spice/src/cspice/spk14a_c.c deleted file mode 100644 index 70a65d1232..0000000000 --- a/ext/spice/src/cspice/spk14a_c.c +++ /dev/null @@ -1,410 +0,0 @@ -/* - --Procedure spk14a_c ( SPK, add data to a type 14 segment ) - --Abstract - - Add data to a type 14 SPK segment associated with handle. See - also spk14b_c and spk14e_c. - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spk14a_c - - - void spk14a_c ( SpiceInt handle, - SpiceInt ncsets, - ConstSpiceDouble coeffs [], - ConstSpiceDouble epochs [] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - handle I The handle of an SPK file open for writing. - ncsets I The number of coefficient sets and epochs. - coeffs I The collection of coefficient sets. - epochs I The epochs associated with the coefficient sets. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - ncsets is the number of Chebyshev coefficient sets and epochs - to be stored in the segment. - - coeffs contains a time-ordered array of Chebyshev coefficient - sets for computing the state vector of a body, packed one - after the other into an array. A state vector contains - the position, X, Y, Z coordinates, and the velocities, - dX/dt, dY/dt, dZ/dt, for the position of a body relative - to a center of motion. - - See the Particulars section for details on how to store - the coefficient sets in the array. - - epochs contains the initial epochs (ephemeris seconds past - J2000) corresponding to the Chebyshev coefficients in - COEFFS. The I'th epoch is associated with the I'th - Chebyshev coefficient set. The epochs must form a - strictly increasing sequence. - --Detailed_Output - - None. The ephemeris data is stored in a segment in the SPK file - associated with handle. - - See the Particulars section for details about the - structure of a type 14 SPK segment. - --Parameters - - None. - --Particulars - - This routine adds data to a type 14 SPK segment that is associated - with the input argument handle. The segment must have been started - by a call to the routine spk14b_c, the routine which begins a type - 14 SPK segment. - - This routine is one of a set of three routines for creating and - adding data to type 14 SPK segments. These routines are: - - spk14b_c: Begin a type 14 SPK segment. This routine must be - called before any data may be added to a type 14 - segment. - - spk14a_c: Add data to a type 14 SPK segment. This routine may be - called any number of times after a call to spk14b_c to - add type 14 records to the SPK segment that was - started. - - spk14e_c: End a type 14 SPK segment. This routine is called to - make the type 14 segment a permanent addition to the - SPK file. Once this routine is called, no further type - 14 records may be added to the segment. A new segment - must be started. - - A type 14 SPK segment consists of coefficient sets for fixed order - Chebyshev polynomials over consecutive time intervals, where the - time intervals need not all be of the same length. The Chebyshev - polynomials represent the position, X, Y, and Z coordinates, and - the velocities, dX/dt, dY/dt, and dZ/dt, of body relative to - center. - - The ephemeris data supplied to the type 14 SPK writer is packed - into an array as a sequence of logical records, - - ----------------------------------------------------- - | Record 1 | Record 2 | ... | Record N-1 | Record N | - ----------------------------------------------------- - - with each record has the following format. - - ------------------------------------------------ - | The midpoint of the approximation interval | - ------------------------------------------------ - | The radius of the approximation interval | - ------------------------------------------------ - | CHBDEG+1 coefficients for the X coordinate | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Y coordinate | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Z coordinate | - ------------------------------------------------ - | CHBDEG+1 coefficients for the X velocity | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Y velocity | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Z velocity | - ------------------------------------------------ - - --Examples - - Assume we have the following for each of the examples that - follow. - - handle is the handle of an SPK file opened with write - access. - - segid is a character string of no more than 40 characters - which provides a pedigree for the data in the SPK - segment we will create. - - body is the NAIF ID code for the body whose ephemeris - is to be placed into the file. - - center is the center of motion for the ephemeris of body. - - reffrm is the name of the SPICE reference frame for the - ephemeris. - - first is the starting epoch, in seconds past J2000, for - the ephemeris data to be placed into the segment. - - last is the ending epoch, in seconds past J2000, for - the ephemeris data to be placed into the segment. - - Example 1: - - For this example, we also assume that: - - n is the number of type 14 records that we want to - put into a segment in an SPK file. - - recrds contains n type 14 records packaged for the SPK - file. - - etstrt contains the initial epochs for each of the - records contained in RECRDS, where - - etstrt[i] < etstrt[i+1], i = 0, n-2 - - etstrt[1] <= first, etstrt[n-1] < last - - etstrt[i+1], i = 0, n-2, is the ending epoch for - record i as well as the initial epoch for record - i+1. - - Then the following code fragment demonstrates how to create a - type 14 SPK segment if all of the data for the segment is - available at one time. - - #include "SpiceUsr.h" - . - . - . - - #define SPK "example.bsp" - - /. - If the segment is to be appended to an existing file, open - that file for "append" access. Otherwise, create a new file. - ./ - - if ( exists_c(SPK) ) - { - spkopa_c ( SPK, &handle ); - } - else - { - /. - New files are supplied with an internal file name. - Comment area space may be reserved at this time; the - units are characters. - ./ - ifname = "Sample type 14 SPK file."; - ncomch = 1024; - - spkopn_c ( SPK, ifname, ncomch, &handle ); - } - - - /. - Begin the segment. - ./ - spk14b_c ( handle, segid, body, center, reffrm, - first, last, chbdeg ); - - /. - Add the data to the segment all at once. - ./ - spk14a_c ( handle, n, recrds, etstrt ); - - /. - End the segment, making the segment a permanent addition - to the SPK file. - ./ - spk14e_c ( handle ); - - . - . - . - /. - After all segments have been loaded, close the SPK file. - ./ - spkcls_c ( handle ); - - - Example 2: - - In this example we want to add type 14 SPK records, as described - above in the Particulars section, to the segments being written - as they are generated. The ability to write the records in this - way is useful if computer memory is limited. It may also be - convenient from a programming perspective to write the records - one at a time. - - For this example, assume that we want to generate n type 14 SPK - records, one for each of n time intervals, writing them all to - the same segment in the SPK file. Let - - n be the number of type 14 records that we want to - generate and put into a segment in an SPK file. - - record be an array with enough room to hold a single type - 14 record, i.e. record should have dimension at - least 6 * (chbdeg + 1 ) + 2. - - start be an array of n times that are the beginning - epochs for each of the intervals of interest. The - times should be in increasing order and the start - time for the first interval should equal the - starting time for the segment. - - start[i] < start[i+1], i = 0, n-2 - - start[0] = first - - stop be an array of n times that are the ending epochs - for each of the intervals of interest. The times - should be in increasing order and the stop time for - interval i should equal the start time for interval - i+1, i.e., we want to have continuous coverage in - time across all of the records. Also, the stop time - for the last interval should equal the ending time - for the segment. - - stop[i] < stop [i+1], i = 0, n-2 - - stop[i] = start[i+1], i = 0, n-2 - - stop[n-1] = last - - - genrec( time1, time2, record ) - - be a subroutine that generates a type 14 SPK record - for a time interval specified by time1 and time2. - - - Then the following code fragment demonstrates how to create a - type 14 SPK segment if all of the data for the segment is not - available at one time. - - #include "SpiceUsr.h" - . - . - . - - /. - Begin the segment. - ./ - spk14b_c ( handle, segid, body, center, reffrm, - first, last, chbdeg ); - - - /. - Generate the records and write them to the segment in the - SPK file one at at time. - ./ - - for ( i = 0; i < n; i++ ) - { - genrec ( start[i], stop[i], record ); - spk14a_c ( handle, 1, record, start+i ); - } - - /. - End the segment, making the segment a permanent addition - to the SPK file. - ./ - spk14e_c ( handle ); - - - --Restrictions - - 1) The type 14 SPK segment to which we are adding data must have - been started by the routine SPK14B, the routine which begins a - type 14 SPK segment. - --Exceptions - - 1) If the number of coefficient sets and epochs is not positive, - the error SPICE(INVALIDARGUMENT) will be signaled. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 29-JUL-1999 (NJB) (KRG) - --Index_Entries - - add data to a type_14 spk segment - --& -*/ - -{ /* Begin spk14a_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spk14a_c" ); - - - spk14a_ ( ( integer * ) &handle, - ( integer * ) &ncsets, - ( doublereal * ) coeffs, - ( doublereal * ) epochs ); - - - chkout_c ( "spk14a_c" ); - -} /* End spk14a_c */ diff --git a/ext/spice/src/cspice/spk14b.c b/ext/spice/src/cspice/spk14b.c deleted file mode 100644 index d2e6d148df..0000000000 --- a/ext/spice/src/cspice/spk14b.c +++ /dev/null @@ -1,843 +0,0 @@ -/* spk14b.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__14 = 14; -static integer c__1 = 1; -static integer c__3 = 3; - -/* $Procedure SPK14B ( SPK type 14: Begin a segment.) */ -/* Subroutine */ int spk14b_(integer *handle, char *segid, integer *body, - integer *center, char *frame, doublereal *first, doublereal *last, - integer *chbdeg, ftnlen segid_len, ftnlen frame_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern logical failed_(void); - doublereal dcoeff; - integer ncoeff; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), sgbwfs_(integer *, doublereal *, char *, integer *, - doublereal *, integer *, integer *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), spkpds_(integer *, - integer *, char *, integer *, doublereal *, doublereal *, - doublereal *, ftnlen); - extern logical return_(void); - integer pktsiz; - -/* $ Abstract */ - -/* Begin a type 14 SPK segment in the SPK file associated with */ -/* HANDLE. See also SPK14A and SPK14E. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ - -/* Include the mnemonics for the generic segments routines. */ - - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of an SPK file open for writing. */ -/* SEGID I The string to use for segment identifier. */ -/* BODY I The NAIF ID code for the body of the segment. */ -/* CENTER I The center of motion for BODY. */ -/* FRAME I The reference frame for this segment. */ -/* FIRST I The first epoch for which the segment is valid. */ -/* LAST I The last epoch for which the segment is valid. */ -/* CHBDEG I The degree of the Chebyshev Polynomial used. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* SEGID is the segment identifier. An SPK segment identifier */ -/* may contain up to 40 printing ASCII characters. */ - -/* BODY is the SPICE ID for the body whose states are */ -/* to be recorded in an SPK file. */ - -/* CENTER is the SPICE ID for the center of motion associated */ -/* with BODY. */ - -/* FRAME is the reference frame that states are referenced to, */ -/* for example 'J2000'. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* CHBDEG is the degree of the Chebyshev Polynomials used to */ -/* represent the ephemeris information stored in the */ -/* segment. */ - -/* $ Detailed_Output */ - -/* None. The input data is used to create the segment summary for */ -/* the segment being started in the SPK file associated with */ -/* HANDLE. */ - -/* See the $ Particulars section for details about the */ -/* structure of a type 14 SPK segment. */ - -/* $ Parameters */ - -/* This subroutine makes use of parameters defined in the file */ -/* 'sgparam.inc'. */ - -/* $ Particulars */ - -/* This routine begins writing a type 14 SPK segment to the open SPK */ -/* file that is associated with HANDLE. The file must have been */ -/* opened with write access. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 14 SPK segments. These routines are: */ - -/* SPK14B: Begin a type 14 SPK segment. This routine must be */ -/* called before any data may be added to a type 14 */ -/* segment. */ - -/* SPK14A: Add data to a type 14 SPK segment. This routine may be */ -/* called any number of times after a call to SPK14B to */ -/* add type 14 records to the SPK segment that was */ -/* started. */ - -/* SPK14E: End a type 14 SPK segment. This routine is called to */ -/* make the type 14 segment a permanent addition to the */ -/* SPK file. Once this routine is called, no further type */ -/* 14 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 14 SPK segment consists of coefficient sets for fixed order */ -/* Chebyshev polynomials over consecutive time intervals, where the */ -/* time intervals need not all be of the same length. The Chebyshev */ -/* polynomials represent the position, X, Y, and Z coordinates, and */ -/* the velocities, dX/dt, dY/dt, and dZ/dt, of BODY relative to */ -/* CENTER. */ - -/* The ephemeris data supplied to the type 14 SPK writer is packed */ -/* into an array as a sequence of records, */ - -/* ----------------------------------------------------- */ -/* | Record 1 | Record 2 | ... | Record N-1 | Record N | */ -/* ----------------------------------------------------- */ - -/* with each record has the following format. */ - -/* ------------------------------------------------ */ -/* | The midpoint of the approximation interval | */ -/* ------------------------------------------------ */ -/* | The radius of the approximation interval | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X velocity | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y velocity | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z velocity | */ -/* ------------------------------------------------ */ - -/* $ Examples */ - -/* Assume we have the following for each of the examples that */ -/* follow. */ - -/* HANDLE is the handle of an SPK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the SPK */ -/* segment we will create. */ - -/* BODY is the SPICE ID code for the body whose ephemeris */ -/* is to be placed into the file. */ - -/* CENTER is the center of motion for the ephemeris of BODY. */ - -/* REFFRM is the name of the SPICE reference frame for the */ -/* ephemeris. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* Example 1: */ - -/* For this example, we also assume that: */ - -/* N is the number of type 14 records that we want to */ -/* put into a segment in an SPK file. */ - -/* RECRDS contains N type 14 records packaged for the SPK */ -/* file. */ - -/* ETSTRT contains the initial epochs for each of the */ -/* records contained in RECRDS, where */ - -/* ETSTRT(I) < ETSTRT(I+1), I = 1, N-1 */ - -/* ETSTRT(1) <= FIRST, ETSTRT(N) < LAST */ - -/* ETSTRT(I+1), I = 1, N-1, is the ending epoch for */ -/* record I as well as the initial epoch for record */ -/* I+1. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 14 SPK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL SPK14B ( HANDLE, SEGID, BODY, CENTER, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL SPK14A ( HANDLE, N, RECRDS, ETSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the SPK file. */ -/* C */ -/* CALL SPK14E ( HANDLE ) */ - -/* Example 2: */ - -/* In this example we want to add type 14 SPK records, as */ -/* described above in the $ Particulars section, to the segment */ -/* being written as they are generated. The ability to write the */ -/* records in this way is useful if computer memory is limited. It */ -/* may also be convenient from a programming perspective to write */ -/* the records one at a time. */ - -/* For this example, assume that we want to generate N type 14 SPK */ -/* records, one for each of N time intervals, writing them all to */ -/* the same segment in the SPK file. Let */ - -/* N be the number of type 14 records that we want to */ -/* generate and put into a segment in an SPK file. */ - -/* RECORD be an array with enough room to hold a single type */ -/* 14 record, i.e. RECORD should have dimension at */ -/* least 6 * (CHBDEG + 1 ) + 2. */ - -/* START be an array of N times that are the beginning */ -/* epochs for each of the intervals of interest. The */ -/* times should be in increasing order and the start */ -/* time for the first interval should equal the */ -/* starting time for the segment. */ - -/* START(I) < START(I+1), I = 1, N-1 */ - -/* START(1) = FIRST */ - -/* STOP be an array of N times that are the ending epochs */ -/* for each of the intervals of interest. The times */ -/* should be in increasing order and the stop time for */ -/* interval I should equal the start time for interval */ -/* I+1, i.e., we want to have continuous coverage in */ -/* time across all of the records. Also, the stop time */ -/* for the last interval should equal the ending time */ -/* for the segment. */ - -/* STOP(I) < STOP(I+1), I = 1, N-1 */ - -/* STOP(I) = START(I+1), I = 1, N-1 */ - -/* STOP(N) = LAST */ - -/* GENREC( TIME1, TIME2, RECORD ) */ - -/* be a subroutine that generates a type 14 SPK record */ -/* for a time interval specified by TIME1 and TIME2. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 14 SPK segment if all of the data for the segment is not */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL SPK14B ( HANDLE, SEGID, BODY, CENTER, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ - -/* C */ -/* C Generate the records and write them to the segment in the */ -/* C SPK file one at at time. */ -/* C */ -/* DO I = 1, N */ - -/* CALL GENREC ( START(I), STOP(I), RECORD ) */ -/* CALL SPK14A ( HANDLE, 1, RECORD, START(I) ) */ - -/* END DO */ - -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the SPK file. */ -/* C */ -/* CALL SPK14E ( HANDLE ) */ - -/* $ Restrictions */ - -/* The SPK file must be open with write access. */ - -/* Only one segment may be written to a particular SPK file at a */ -/* time. All of the data for the segment must be written and the */ -/* segment must be ended before another segment may be started in */ -/* the file. */ - -/* $ Exceptions */ - -/* 1) If the degree of the Chebyshev Polynomial to be used for this */ -/* segment is negative, the error SPICE(INVALIDARGUMENT) will */ -/* be signalled. */ - -/* 2) Errors in the structure or content of the inputs other than the */ -/* degree of the Chebyshev Polynomial are diagnosed by routines */ -/* called by this one. */ - -/* 3) File access errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* See HANDLE in the $ Detailed_Input section. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 30-OCT-2006 (BVS) */ - -/* Deleted "inertial" from the FRAME description in the Brief_I/O */ -/* section of the header. */ - -/* - SPICELIB Version 1.0.0, 06-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* begin writing a type_14 spk segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Parameters */ - -/* DAF ND and NI values for SPK files. */ - - -/* Length of an SPK descriptor. */ - - -/* Length of a state. */ - - -/* The type of this segment */ - - -/* The number of constants: */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPK14B", (ftnlen)6); - } - -/* First, check the degree of the polynomial to be sure that it is */ -/* not negative. */ - - if (*chbdeg < 0) { - setmsg_("The degree of the Chebyshev Polynomial was negative, #. The" - " degree of the polynomial must be greater than or equal to z" - "ero.", (ftnlen)123); - errint_("#", chbdeg, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SPK14B", (ftnlen)6); - return 0; - } - -/* Create a descriptor for the segment we are about to write. */ - - spkpds_(body, center, frame, &c__14, first, last, descr, frame_len); - if (failed_()) { - chkout_("SPK14B", (ftnlen)6); - return 0; - } - -/* We've got a valid descriptor, so compute a few things and begin */ -/* the segment. */ - - ncoeff = *chbdeg + 1; - pktsiz = ncoeff * 6 + 2; - dcoeff = (doublereal) ncoeff; - -/* For this data type, we want to use an explicit reference value */ -/* index where the reference epochs are in increasing order. We also */ -/* want to have as the index for a particular request epoch the index */ -/* of the greatest reference epoch less than or equal to the request */ -/* epoch. These characteristics are prescribed by the mnemonic EXPLE. */ -/* See the include file 'sgparam.inc' for more details. */ - - sgbwfs_(handle, descr, segid, &c__1, &dcoeff, &pktsiz, &c__3, segid_len); - -/* No need to check FAILED() here, since all we do is check out. */ -/* Leave it up to the caller. */ - - chkout_("SPK14B", (ftnlen)6); - return 0; -} /* spk14b_ */ - diff --git a/ext/spice/src/cspice/spk14b_c.c b/ext/spice/src/cspice/spk14b_c.c deleted file mode 100644 index 802e87b265..0000000000 --- a/ext/spice/src/cspice/spk14b_c.c +++ /dev/null @@ -1,455 +0,0 @@ -/* - --Procedure spk14b_c ( SPK, begin a type 14 segment ) - --Abstract - - Begin a type 14 SPK segment in the SPK file associated with - handle. See also spk14a_c and spk14e_c. - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spk14b_c ( SpiceInt handle, - ConstSpiceChar * segid, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - SpiceInt chbdeg ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - handle I The handle of an SPK file open for writing. - segid I The string to use for segment identifier. - body I The NAIF ID code for the body of the segment. - center I The center of motion for body. - frame I The reference frame for this segment. - first I The first epoch for which the segment is valid. - last I The last epoch for which the segment is valid. - chbdeg I The degree of the Chebyshev Polynomial used. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - segid is the segment identifier. An SPK segment identifier - may contain up to 40 printing ASCII characters. - - body is the NAIF ID for the body whose states are - to be recorded in an SPK file. - - center is the NAIF ID for the center of motion associated - with body. - - frame is the reference frame that states are referenced to, - for example "J2000". - - first is the starting epoch, in TDB seconds past J2000, for - the ephemeris data to be placed into the segment. - - last is the ending epoch, in TDB seconds past J2000, for - the ephemeris data to be placed into the segment. - - chbdeg is the degree of the Chebyshev Polynomials used to - represent the ephemeris information stored in the - segment. - --Detailed_Output - - None. The input data is used to create the segment summary - for the segment being started in the SPK file - associated with handle. - - See the Particulars section for details about the - structure of a type 14 SPK segment. - --Parameters - - None. - --Particulars - - This routine begins writing a type 14 SPK segment to the open SPK - file that is associated with handle. The file must have been - opened with write access. - - This routine is one of a set of three routines for creating and - adding data to type 14 SPK segments. These routines are: - - spk14b_c: Begin a type 14 SPK segment. This routine must be - called before any data may be added to a type 14 - segment. - - spk14a_c: Add data to a type 14 SPK segment. This routine may be - called any number of times after a call to spk14b_c to - add type 14 records to the SPK segment that was - started. - - spk14e_c: End a type 14 SPK segment. This routine is called to - make the type 14 segment a permanent addition to the - SPK file. Once this routine is called, no further type - 14 records may be added to the segment. A new segment - must be started. - - A type 14 SPK segment consists of coefficient sets for fixed order - Chebyshev polynomials over consecutive time intervals, where the - time intervals need not all be of the same length. The Chebyshev - polynomials represent the position, X, Y, and Z coordinates, and - the velocities, dX/dt, dY/dt, and dZ/dt, of body relative to - center. - - The ephemeris data supplied to the type 14 SPK writer is packed - into an array as a sequence of records, - - ----------------------------------------------------- - | Record 1 | Record 2 | ... | Record N-1 | Record N | - ----------------------------------------------------- - - with each record has the following format. - - ------------------------------------------------ - | The midpoint of the approximation interval | - ------------------------------------------------ - | The radius of the approximation interval | - ------------------------------------------------ - | chbdeg+1 coefficients for the X coordinate | - ------------------------------------------------ - | chbdeg+1 coefficients for the Y coordinate | - ------------------------------------------------ - | chbdeg+1 coefficients for the Z coordinate | - ------------------------------------------------ - | chbdeg+1 coefficients for the X velocity | - ------------------------------------------------ - | chbdeg+1 coefficients for the Y velocity | - ------------------------------------------------ - | chbdeg+1 coefficients for the Z velocity | - ------------------------------------------------ - --Examples - - Assume we have the following for each of the examples that - follow. - - handle is the handle of an SPK file opened with write - access. - - segid is a character string of no more than 40 characters - which provides a pedigree for the data in the SPK - segment we will create. - - body is the NAIF ID code for the body whose ephemeris - is to be placed into the file. - - center is the center of motion for the ephemeris of body. - - reffrm is the name of the SPICE reference frame for the - ephemeris. - - first is the starting epoch, in seconds past J2000, for - the ephemeris data to be placed into the segment. - - last is the ending epoch, in seconds past J2000, for - the ephemeris data to be placed into the segment. - - Example 1: - - For this example, we also assume that: - - n is the number of type 14 records that we want to - put into a segment in an SPK file. - - recrds contains n type 14 records packaged for the SPK - file. - - etstrt contains the initial epochs for each of the - records contained in RECRDS, where - - etstrt[i] < etstrt[i+1], i = 0, n-2 - - etstrt[1] <= first, etstrt[n-1] < last - - etstrt[i+1], i = 0, n-2, is the ending epoch for - record i as well as the initial epoch for record - i+1. - - Then the following code fragment demonstrates how to create a - type 14 SPK segment if all of the data for the segment is - available at one time. - - #include "SpiceUsr.h" - . - . - . - - #define SPK "example.bsp" - - /. - If the segment is to be appended to an existing file, open - that file for "append" access. Otherwise, create a new file. - ./ - - if ( exists_c(SPK) ) - { - spkopa_c ( SPK, &handle ); - } - else - { - /. - New files are supplied with an internal file name. - Comment area space may be reserved at this time; the - units are characters. - ./ - ifname = "Sample type 14 SPK file."; - ncomch = 1024; - - spkopn_c ( SPK, ifname, ncomch, &handle ); - } - - - /. - Begin the segment. - ./ - spk14b_c ( handle, segid, body, center, reffrm, - first, last, chbdeg ); - - /. - Add the data to the segment all at once. - ./ - spk14a_c ( handle, n, recrds, etstrt ); - - /. - End the segment, making the segment a permanent addition - to the SPK file. - ./ - spk14e_c ( handle ); - - . - . - . - /. - After all segments have been loaded, close the SPK file. - ./ - spkcls_c ( handle ); - - - Example 2: - - In this example we want to add type 14 SPK records, as described - above in the Particulars section, to the segments being written - as they are generated. The ability to write the records in this - way is useful if computer memory is limited. It may also be - convenient from a programming perspective to write the records - one at a time. - - For this example, assume that we want to generate n type 14 SPK - records, one for each of n time intervals, writing them all to - the same segment in the SPK file. Let - - n be the number of type 14 records that we want to - generate and put into a segment in an SPK file. - - record be an array with enough room to hold a single type - 14 record, i.e. record should have dimension at - least 6 * (chbdeg + 1 ) + 2. - - start be an array of n times that are the beginning - epochs for each of the intervals of interest. The - times should be in increasing order and the start - time for the first interval should equal the - starting time for the segment. - - start[i] < start[i+1], i = 0, n-2 - - start[0] = first - - stop be an array of n times that are the ending epochs - for each of the intervals of interest. The times - should be in increasing order and the stop time for - interval i should equal the start time for interval - i+1, i.e., we want to have continuous coverage in - time across all of the records. Also, the stop time - for the last interval should equal the ending time - for the segment. - - stop[i] < stop [i+1], i = 0, n-2 - - stop[i] = start[i+1], i = 0, n-2 - - stop[n-1] = last - - - genrec( time1, time2, record ) - - be a subroutine that generates a type 14 SPK record - for a time interval specified by time1 and time2. - - - Then the following code fragment demonstrates how to create a - type 14 SPK segment if all of the data for the segment is not - available at one time. - - #include "SpiceUsr.h" - . - . - . - - /. - Begin the segment. - ./ - spk14b_c ( handle, segid, body, center, reffrm, - first, last, chbdeg ); - - - /. - Generate the records and write them to the segment in the - SPK file one at at time. - ./ - - for ( i = 0; i < n; i++ ) - { - genrec ( start[i], stop[i], record ); - spk14a_c ( handle, 1, record, start+i ); - } - - /. - End the segment, making the segment a permanent addition - to the SPK file. - ./ - spk14e_c ( handle ); - - --Restrictions - - The SPK file must be open with write access. - - Only one segment may be written to a particular SPK file at a - time. All of the data for the segment must be written and the - segment must be ended before another segment may be started in - the file. - --Exceptions - - 1) If the degree of the Chebyshev Polynomial to be used for this - segment is negative, the error SPICE(INVALIDARGUMENT) will - be signaled. - - 2) Errors in the structure or content of the inputs other than the - degree of the Chebyshev Polynomial are diagnosed by routines - called by this one. - - 3) File access errors are diagnosed by routines in the call tree - of this routine. - - 4) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 5) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - --Files - - See handle in the Detailed_Input section. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 30-OCT-2006 (BVS) - - Deleted "inertial" from the FRAME description in the Brief_I/O - section of the header. - - -CSPICE Version 1.0.0, 29-JUL-1999 (NJB) (KRG) - --Index_Entries - - begin writing a type_14 spk segment - --& -*/ - -{ /* Begin spk14b_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spk14b_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spk14b_c", frame ); - CHKFSTR ( CHK_STANDARD, "spk14b_c", segid ); - - - /* - Call the f2c'd routine. - */ - spk14b_ ( ( integer * ) &handle, - ( char * ) segid, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( integer * ) &chbdeg, - ( ftnlen ) strlen(segid), - ( ftnlen ) strlen(frame) ); - - - chkout_c ( "spk14b_c" ); - -} /* End spk14b_c */ diff --git a/ext/spice/src/cspice/spk14e.c b/ext/spice/src/cspice/spk14e.c deleted file mode 100644 index 71f19ab590..0000000000 --- a/ext/spice/src/cspice/spk14e.c +++ /dev/null @@ -1,335 +0,0 @@ -/* spk14e.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPK14E ( SPK type 14: End a segment. ) */ -/* Subroutine */ int spk14e_(integer *handle) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sgwes_(integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the type 14 SPK segment currently being written to the SPK */ -/* file associated with HANDLE. See also SPK14B and SPK14E. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of an SPK file open for writing. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing, and to which a type 14 segment is */ -/* being written. */ - -/* $ Detailed_Output */ - -/* None. The type 14 segment in the SPK file associated with */ -/* HANDLE will be ended, making the addition of the data */ -/* to the file permanent. */ - -/* See the $ Particulars section for details about the */ -/* structure of a type 14 SPK segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine ends a type 14 SPK segment which is being written to */ -/* the SPK file associated with HANDLE. Ending the SPK segment is a */ -/* necessary step in the process of making the data a permanent part */ -/* of the SPK file. */ - -/* This routine is one of a set of three routines for creating and */ -/* adding data to type 14 SPK segments. These routines are: */ - -/* SPK14B: Begin a type 14 SPK segment. This routine must be */ -/* called before any data may be added to a type 14 */ -/* segment. */ - -/* SPK14A: Add data to a type 14 SPK segment. This routine may be */ -/* called any number of times after a call to SPK14B to */ -/* add type 14 records to the SPK segment that was */ -/* started. */ - -/* SPK14E: End a type 14 SPK segment. This routine is called to */ -/* make the type 14 segment a permanent addition to the */ -/* SPK file. Once this routine is called, no further type */ -/* 14 records may be added to the segment. A new segment */ -/* must be started. */ - -/* A type 14 SPK segment consists of coefficient sets for fixed order */ -/* Chebyshev polynomials over consecutive time intervals, where the */ -/* time intervals need not all be of the same length. The Chebyshev */ -/* polynomials represent the position, X, Y, and Z coordinates, and */ -/* the velocities, dX/dt, dY/dt, and dZ/dt, of BODY relative to */ -/* CENTER. */ - -/* The ephemeris data supplied to the type 14 SPK writer is packed */ -/* into an array as a sequence of logical records, */ - -/* ----------------------------------------------------- */ -/* | Record 1 | Record 2 | ... | Record N-1 | Record N | */ -/* ----------------------------------------------------- */ - -/* with each record has the following format. */ - -/* ------------------------------------------------ */ -/* | the midpoint of the approximation interval | */ -/* ------------------------------------------------ */ -/* | the radius of the approximation interval | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z coordinate | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the X velocity | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Y velocity | */ -/* ------------------------------------------------ */ -/* | CHBDEG+1 coefficients for the Z velocity | */ -/* ------------------------------------------------ */ - -/* $ Examples */ - -/* Assume we have the following for each of the examples that */ -/* follow. */ - -/* HANDLE is the handle of an SPK file opened with write */ -/* access. */ - -/* SEGID is a character string of no more than 40 characters */ -/* which provides a pedigree for the data in the SPK */ -/* segment we will create. */ - -/* BODY is the SPICE ID code for the body whose ephemeris */ -/* is to be placed into the file. */ - -/* CENTER is the center of motion for the ephemeris of BODY. */ - -/* REFFRM is the name of the SPICE inertial reference frame */ -/* for the ephemeris. */ - -/* FIRST is the starting epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* LAST is the ending epoch, in seconds past J2000, for */ -/* the ephemeris data to be placed into the segment. */ - -/* Example 1: */ - -/* For this example, we also assume that: */ - -/* N is the number of type 14 records that we want to */ -/* put into a segment in an SPK file. */ - -/* RECRDS contains N type 14 records packaged for the SPK */ -/* file. */ - -/* ETSTRT contains the initial epochs for each of the */ -/* records contained in RECRDS, where */ - -/* ETSTRT(I) < ETSTRT(I+1), I = 1, N-1 */ - -/* ETSTRT(1) <= FIRST, ETSTRT(N) < LAST */ - -/* ETSTRT(I+1), I = 1, N-1, is the ending epoch for */ -/* record I as well as the initial epoch for record */ -/* I+1. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 14 SPK segment if all of the data for the segment is */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL SPK14B ( HANDLE, SEGID, BODY, CENTER, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ -/* C */ -/* C Add the data to the segment all at once. */ -/* C */ -/* CALL SPK14A ( HANDLE, N, RECRDS, ETSTRT ) */ -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the SPK file. */ -/* C */ -/* CALL SPK14E ( HANDLE ) */ - -/* Example 2: */ - -/* In this example we want to add type 14 SPK records, as */ -/* described above in the $ Particulars section, to the segment */ -/* being written as they are generated. The ability to write the */ -/* records in this way is useful if computer memory is limited. It */ -/* may also be convenient from a programming perspective to write */ -/* the records one at a time. */ - -/* For this example, assume that we want to generate N type 14 SPK */ -/* records, one for each of N time intervals, writing them all to */ -/* the same segment in the SPK file. Let */ - -/* N be the number of type 14 records that we want to */ -/* generate and put into a segment in an SPK file. */ - -/* RECORD be an array with enough room to hold a single type */ -/* 14 record, i.e. RECORD should have dimension at */ -/* least 6 * (CHBDEG + 1 ) + 2. */ - -/* START be an array of N times that are the beginning */ -/* epochs for each of the intervals of interest. The */ -/* times should be in increasing order and the start */ -/* time for the first interval should equal the */ -/* starting time for the segment. */ - -/* START(I) < START(I+1), I = 1, N-1 */ - -/* START(1) = FIRST */ - -/* STOP be an array of N times that are the ending epochs */ -/* for each of the intervals of interest. The times */ -/* should be in increasing order and the stop time for */ -/* interval I should equal the start time for interval */ -/* I+1, i.e., we want to have continuous coverage in */ -/* time across all of the records. Also, the stop time */ -/* for the last interval should equal the ending time */ -/* for the segment. */ - -/* STOP(I) < STOP(I+1), I = 1, N-1 */ - -/* STOP(I) = START(I+1), I = 1, N-1 */ - -/* STOP(N) = LAST */ - -/* GENREC( TIME1, TIME2, RECORD ) */ - -/* be a subroutine that generates a type 14 SPK record */ -/* for a time interval specified by TIME1 and TIME2. */ - -/* Then the following code fragment demonstrates how to create a */ -/* type 14 SPK segment if all of the data for the segment is not */ -/* available at one time. */ - -/* C */ -/* C Begin the segment. */ -/* C */ -/* CALL SPK14B ( HANDLE, SEGID, BODY, CENTER, REFFRM, */ -/* . FIRST, LAST, CHBDEG ) */ - -/* C */ -/* C Generate the records and write them to the segment in the */ -/* C SPK file one at at time. */ -/* C */ -/* DO I = 1, N */ - -/* CALL GENREC ( START(I), STOP(I), RECORD ) */ -/* CALL SPK14A ( HANDLE, 1, RECORD, START(I) ) */ - -/* END DO */ - -/* C */ -/* C End the segment, making the segment a permanent addition */ -/* C to the SPK file. */ -/* C */ -/* CALL SPK14E ( HANDLE ) */ - -/* $ Restrictions */ - -/* 1) The type 14 SPK segment being closed must have been started by */ -/* the routine SPK14B, the routine which begins a type 14 SPK */ -/* segment. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See the argument HANDLE. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* end a type_14 spk segment */ - -/* -& */ - -/* Spicelib functions */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPK14E", (ftnlen)6); - } - -/* This is simple, just call the routine which ends a generic */ -/* segment. */ - - sgwes_(handle); - -/* No need to check FAILED() here, since all we do is check out. */ -/* Leave it up to the caller. */ - chkout_("SPK14E", (ftnlen)6); - return 0; -} /* spk14e_ */ - diff --git a/ext/spice/src/cspice/spk14e_c.c b/ext/spice/src/cspice/spk14e_c.c deleted file mode 100644 index f7377cdcd4..0000000000 --- a/ext/spice/src/cspice/spk14e_c.c +++ /dev/null @@ -1,382 +0,0 @@ -/* - --Procedure spk14e_c ( SPK, end a type 14 segment ) - --Abstract - - End the type 14 SPK segment currently being written to the SPK - file associated with handle. See also spk14a_c and spk14b_c. - --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 - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void spk14e_c ( SpiceInt handle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - handle I The handle of an SPK file open for writing. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing, and to which a type 14 segment is - being written. - --Detailed_Output - - None. The type 14 segment in the SPK file associated with - handle will be ended, making the addition of the data - to the file permanent. - - See the Particulars section for details about the - structure of a type 14 SPK segment. - --Parameters - - None. - --Particulars - - This routine ends a type 14 SPK segment which is being written to - the SPK file associated with handle. Ending the SPK segment is a - necessary step in the process of making the data a permanent part - of the SPK file. - - This routine is one of a set of three routines for creating and - adding data to type 14 SPK segments. These routines are: - - spk14b_c: Begin a type 14 SPK segment. This routine must be - called before any data may be added to a type 14 - segment. - - spk14a_c: Add data to a type 14 SPK segment. This routine may be - called any number of times after a call to SPK14B to - add type 14 records to the SPK segment that was - started. - - spk14e_c: End a type 14 SPK segment. This routine is called to - make the type 14 segment a permanent addition to the - SPK file. Once this routine is called, no further type - 14 records may be added to the segment. A new segment - must be started. - - A type 14 SPK segment consists of coefficient sets for fixed order - Chebyshev polynomials over consecutive time intervals, where the - time intervals need not all be of the same length. The Chebyshev - polynomials represent the position, X, Y, and Z coordinates, and - the velocities, dX/dt, dY/dt, and dZ/dt, of a body relative to a - center of motion. - - The ephemeris data supplied to the type 14 SPK writer routines is - packed into an array as a sequence of logical records, - - ----------------------------------------------------- - | Record 1 | Record 2 | ... | Record N-1 | Record N | - ----------------------------------------------------- - - with each record has the following format. - - ------------------------------------------------ - | the midpoint of the approximation interval | - ------------------------------------------------ - | the radius of the approximation interval | - ------------------------------------------------ - | CHBDEG+1 coefficients for the X coordinate | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Y coordinate | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Z coordinate | - ------------------------------------------------ - | CHBDEG+1 coefficients for the X velocity | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Y velocity | - ------------------------------------------------ - | CHBDEG+1 coefficients for the Z velocity | - ------------------------------------------------ - --Examples - - Assume we have the following for each of the examples that - follow. - - handle is the handle of an SPK file opened with write - access. - - segid is a character string of no more than 40 characters - which provides a pedigree for the data in the SPK - segment we will create. - - body is the NAIF ID code for the body whose ephemeris - is to be placed into the file. - - center is the center of motion for the ephemeris of body. - - reffrm is the name of the SPICE reference frame for the - ephemeris. - - first is the starting epoch, in seconds past J2000, for - the ephemeris data to be placed into the segment. - - last is the ending epoch, in seconds past J2000, for - the ephemeris data to be placed into the segment. - - Example 1: - - For this example, we also assume that: - - n is the number of type 14 records that we want to - put into a segment in an SPK file. - - recrds contains n type 14 records packaged for the SPK - file. - - etstrt contains the initial epochs for each of the - records contained in RECRDS, where - - etstrt[i] < etstrt[i+1], i = 0, n-2 - - etstrt[1] <= first, etstrt[n-1] < last - - etstrt[i+1], i = 0, n-2, is the ending epoch for - record i as well as the initial epoch for record - i+1. - - Then the following code fragment demonstrates how to create a - type 14 SPK segment if all of the data for the segment is - available at one time. - - #include "SpiceUsr.h" - . - . - . - - #define SPK "example.bsp" - - /. - If the segment is to be appended to an existing file, open - that file for "append" access. Otherwise, create a new file. - ./ - - if ( exists_c(SPK) ) - { - spkopa_c ( SPK, &handle ); - } - else - { - /. - New files are supplied with an internal file name. - Comment area space may be reserved at this time; the - units are characters. - ./ - ifname = "Sample type 14 SPK file."; - ncomch = 1024; - - spkopn_c ( SPK, ifname, ncomch, &handle ); - } - - - /. - Begin the segment. - ./ - spk14b_c ( handle, segid, body, center, reffrm, - first, last, chbdeg ); - - /. - Add the data to the segment all at once. - ./ - spk14a_c ( handle, n, recrds, etstrt ); - - /. - End the segment, making the segment a permanent addition - to the SPK file. - ./ - spk14e_c ( handle ); - - . - . - . - /. - After all segments have been loaded, close the SPK file. - ./ - spkcls_c ( handle ); - - - Example 2: - - In this example we want to add type 14 SPK records, as described - above in the Particulars section, to the segments being written - as they are generated. The ability to write the records in this - way is useful if computer memory is limited. It may also be - convenient from a programming perspective to write the records - one at a time. - - For this example, assume that we want to generate n type 14 SPK - records, one for each of n time intervals, writing them all to - the same segment in the SPK file. Let - - n be the number of type 14 records that we want to - generate and put into a segment in an SPK file. - - record be an array with enough room to hold a single type - 14 record, i.e. record should have dimension at - least 6 * (chbdeg + 1 ) + 2. - - start be an array of n times that are the beginning - epochs for each of the intervals of interest. The - times should be in increasing order and the start - time for the first interval should equal the - starting time for the segment. - - start[i] < start[i+1], i = 0, n-2 - - start[0] = first - - stop be an array of n times that are the ending epochs - for each of the intervals of interest. The times - should be in increasing order and the stop time for - interval i should equal the start time for interval - i+1, i.e., we want to have continuous coverage in - time across all of the records. Also, the stop time - for the last interval should equal the ending time - for the segment. - - stop[i] < stop [i+1], i = 0, n-2 - - stop[i] = start[i+1], i = 0, n-2 - - stop[n-1] = last - - - genrec( time1, time2, record ) - - be a subroutine that generates a type 14 SPK record - for a time interval specified by time1 and time2. - - - Then the following code fragment demonstrates how to create a - type 14 SPK segment if all of the data for the segment is not - available at one time. - - #include "SpiceUsr.h" - . - . - . - - /. - Begin the segment. - ./ - spk14b_c ( handle, segid, body, center, reffrm, - first, last, chbdeg ); - - - /. - Generate the records and write them to the segment in the - SPK file one at at time. - ./ - - for ( i = 0; i < n; i++ ) - { - genrec ( start[i], stop[i], record ); - spk14a_c ( handle, 1, record, start+i ); - } - - /. - End the segment, making the segment a permanent addition - to the SPK file. - ./ - spk14e_c ( handle ); - --Restrictions - - 1) The type 14 SPK segment being closed must have been started by - the routine spk14b_c, the routine which begins a type 14 SPK - segment. - --Exceptions - - None. - --Files - - See the argument handle. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 16-JAN-2003 (EDW) - - Trivial correction to the header. - - -CSPICE Version 1.0.0, 29-JUL-1999 (NJB) (KRG) - --Index_Entries - - end a type_14 spk segment - --& -*/ - -{ /* Begin spk14e_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spk14e_c" ); - - - spk14e_ ( ( integer * ) &handle ); - - - chkout_c ( "spk14e_c" ); - -} /* End spk14e_c */ - diff --git a/ext/spice/src/cspice/spkacs.c b/ext/spice/src/cspice/spkacs.c deleted file mode 100644 index e416e891ed..0000000000 --- a/ext/spice/src/cspice/spkacs.c +++ /dev/null @@ -1,733 +0,0 @@ -/* spkacs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b13 = 1.; - -/* $Procedure SPKACS ( S/P Kernel, aberration corrected state ) */ -/* Subroutine */ int spkacs_(integer *targ, doublereal *et, char *ref, char * - abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal * - dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal t; - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal ltssb, ssblt, stobs[12] /* was [6][2] */; - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - logical attblk[15]; - extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), qderiv_(integer *, - doublereal *, doublereal *, doublereal *, doublereal *); - doublereal ssbobs[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen), sigerr_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), spkaps_(integer *, - doublereal *, char *, char *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, ftnlen, ftnlen), - setmsg_(char *, ftnlen); - extern logical return_(void); - static logical usestl; - doublereal acc[3]; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time */ -/* and stellar aberration, expressed relative to an inertial */ -/* reference frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observer. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the output state STARG is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* OBS is the NAIF ID code for the observer body. The */ -/* target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 3) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 4) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ -/* User applications normally will not need to call this routine */ -/* directly. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time and stellar aberration corrections. */ -/* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ -/* compute subsequent states at intervals of 1 hour. For each */ -/* epoch, display the states, the one way light time between */ -/* target and observer, and the rate of change of the one way */ -/* light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time and stellar */ -/* C aberration ('LT+S') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ - -/* CALL SPKACS ( 301, ET, 'J2000', 'LT+S', */ -/* . 399, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291584.614 */ -/* J2000 y-position (km): -266693.406 */ -/* J2000 z-position (km): -76095.6532 */ -/* J2000 x-velocity (km/s): 0.643439157 */ -/* J2000 y-velocity (km/s): -0.666065874 */ -/* J2000 z-velocity (km/s): -0.301310063 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289256.459 */ -/* J2000 y-position (km): -269080.605 */ -/* J2000 z-position (km): -77177.3528 */ -/* J2000 x-velocity (km/s): 0.64997032 */ -/* J2000 y-velocity (km/s): -0.660148253 */ -/* J2000 z-velocity (km/s): -0.299630418 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286904.897 */ -/* J2000 y-position (km): -271446.417 */ -/* J2000 z-position (km): -78252.9655 */ -/* J2000 x-velocity (km/s): 0.656443883 */ -/* J2000 y-velocity (km/s): -0.654183552 */ -/* J2000 z-velocity (km/s): -0.297928533 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284530.133 */ -/* J2000 y-position (km): -273790.671 */ -/* J2000 z-position (km): -79322.4117 */ -/* J2000 x-velocity (km/s): 0.662859505 */ -/* J2000 y-velocity (km/s): -0.648172247 */ -/* J2000 z-velocity (km/s): -0.296204558 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282132.378 */ -/* J2000 y-position (km): -276113.202 */ -/* J2000 z-position (km): -80385.612 */ -/* J2000 x-velocity (km/s): 0.669216846 */ -/* J2000 y-velocity (km/s): -0.642114815 */ -/* J2000 z-velocity (km/s): -0.294458645 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) The kernel files to be used by SPKACS must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 2) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration correction */ -/* aberration-corrected state from spk file */ -/* get light time and stellar aberration-corrected state */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKACS", (ftnlen)6); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SPKACS", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* USESTL is .TRUE. when stellar aberration correction is */ -/* specified. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - usestl = attblk[2]; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("SPKACS", (ftnlen)6); - return 0; - } - -/* Prepare to look up the apparent state of the target */ -/* as seen by the observer. We'll need the geometric */ -/* state of the observer relative to the solar system */ -/* barycenter. If we're using stellar aberration */ -/* corrections, we'll need the observer's acceleration */ -/* as well. */ - -/* Get the geometric state of the observer relative to the SSB, */ -/* which we'll call SSBOBS. */ - - spkgeo_(obs, et, ref, &c__0, ssbobs, &ssblt, ref_len); - if (usestl) { - -/* Numerically differentiate the observer velocity relative to */ -/* the SSB to obtain acceleration. We first evaluate the */ -/* geometric state of the observer relative to the solar system */ -/* barycenter at ET +/- DELTA. */ - for (i__ = 1; i__ <= 2; ++i__) { - t = *et + ((i__ << 1) - 3) * 1.; - spkgeo_(obs, &t, ref, &c__0, &stobs[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("stobs", i__1, "spkacs_", ( - ftnlen)626)], <ssb, ref_len); - } - qderiv_(&c__3, &stobs[3], &stobs[9], &c_b13, acc); - } else { - cleard_(&c__3, acc); - } - -/* Look up the apparent state. The light time and light */ -/* rate are returned as well. */ - - spkaps_(targ, et, ref, abcorr, ssbobs, acc, starg, lt, dlt, ref_len, - abcorr_len); - chkout_("SPKACS", (ftnlen)6); - return 0; -} /* spkacs_ */ - diff --git a/ext/spice/src/cspice/spkacs_c.c b/ext/spice/src/cspice/spkacs_c.c deleted file mode 100644 index 83df651ff2..0000000000 --- a/ext/spice/src/cspice/spkacs_c.c +++ /dev/null @@ -1,523 +0,0 @@ -/* - --Procedure spkacs_c ( S/P Kernel, aberration corrected state ) - --Abstract - - Return the state (position and velocity) of a target body - relative to an observer, optionally corrected for light time - and stellar aberration, expressed relative to an inertial - reference frame. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - void spkacs_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Observer epoch. - ref I Inertial reference frame of output state. - abcorr I Aberration correction flag. - obs I Observer. - starg O State of target. - lt O One way light time between observer and target. - dlt O Derivative of light time with respect to time. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a state vector whose position - component points from the observer to the target. - - et is the ephemeris time, expressed as seconds past - J2000 TDB, at which the state of the target body - relative to the observer is to be computed. `et' - refers to time at the observer's location. - - ref is the inertial reference frame with respect to which - the output state `starg' is expressed. `ref' must be - recognized by the CSPICE Toolkit. The acceptable - frames are listed in the Frames Required Reading, as - well as in the CSPICE routine chgirf_. - - Case and blanks are not significant in the string - `ref'. - - abcorr indicates the aberration corrections to be applied - to the state of the target body to account for one-way - light time and stellar aberration. See the discussion - in the Particulars section for recommendations on - how to choose aberration corrections. - - `abcorr' may be any of the following: - - "NONE" Apply no correction. Return the - geometric state of the target body - relative to the observer. - - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at `et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the state of the target at the - moment it emitted photons arriving at - the observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - state obtained with the "LT" option to - account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - state of the target---the position and - velocity of the target as seen by the - observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - state of the target at the moment it - receives photons emitted from the - observer's location at `et'. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - state obtained with the "XLT" option to - account for the observer's velocity - relative to the solar system - barycenter. The position component of - the computed target state indicates the - direction that photons emitted from the - observer's location must be "aimed" to - hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - - obs is the NAIF ID code for the observer body. The - target and observer define a state vector whose - position component points from the observer to the - target. - --Detailed_Output - - starg is a Cartesian state vector representing the position - and velocity of the target body relative to the - specified observer. `starg' is corrected for the - specified aberrations, and is expressed with respect - to the specified inertial reference frame. The first - three components of `starg' represent the x-, y- and - z-components of the target's position; last three - components form the corresponding velocity vector. - - The position component of `starg' points from the - observer's location at `et' to the aberration-corrected - location of the target. Note that the sense of the - position vector is independent of the direction of - radiation travel implied by the aberration - correction. - - Units are always km and km/sec. - - lt is the one-way light time between the observer and - target in seconds. If the target state is corrected - for aberrations, then `lt' is the one-way light time - between the observer and the light time corrected - target location. - - dlt is the derivative with respect to barycentric - dynamical time of the one way light time between - target and observer: - - dlt = d(lt)/d(et) - - `dlt' can also be described as the rate of change of - one way light time. `dlt' is unitless, since `lt' and - `et' both have units of TDB seconds. - - If the observer and target are at the same position, - then `dlt' is set to zero. - --Parameters - - None. - --Exceptions - - 1) If the value of `abcorr' is not recognized, the error is - diagnosed by a routine in the call tree of this routine. - - 2) If the reference frame requested is not a recognized - inertial reference frame, the error SPICE(BADFRAME) - is signaled. - - 3) If the state of the target relative to the solar system - barycenter cannot be computed, the error will be diagnosed - by routines in the call tree of this routine. - - 4) If the observer and target are at the same position, - then `dlt' is set to zero. This situation could arise, - for example, when the observer is Mars and the target - is the Mars barycenter. - - 6) The error SPICE(EMPTYSTRING) is signaled if either of the input - strings `ref' or `abcorr' do not contain at least one character, - since such an input string cannot be converted to a Fortran-style - string. - - 7) The error SPICE(NULLPOINTER) is signaled if either of the input - string pointers `ref' or `abcorr' are null. - --Files - - This routine computes states using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. Application programs typically load - kernels once before this routine is called, for example during - program initialization; kernels need not be loaded repeatedly. - See the routine furnsh_c and the SPK and KERNEL Required Reading - for further information on loading (and unloading) kernels. - - If any of the ephemeris data used to compute `starg' are expressed - relative to a non-inertial frame in the SPK files providing those - data, additional kernels may be needed to enable the reference - frame transformations required to compute the state. Normally - these additional kernels are PCK files or frame kernels. Any - such kernels must already be loaded at the time this routine is - called. - --Particulars - - This routine supports higher-level SPK API routines that can - perform both light time and stellar aberration corrections. - User applications normally will not need to call this routine - directly. - - See the header of the routine spkezr_c for a detailed discussion - of aberration corrections. - --Examples - - 1) Look up a sequence of states of the Moon as seen from the - Earth. Use light time and stellar aberration corrections. - Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; - compute subsequent states at intervals of 1 hour. For each - epoch, display the states, the one way light time between - target and observer, and the rate of change of the one way - light time. - - Use the following meta-kernel to specify the kernels to - load: - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls' ) - - \begintext - - - The code example follows: - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - - The meta-kernel name shown here refers to a file whose contents - are those shown above. This file and the kernels it references - must exist in your current working directory. - ./ - #define META "example.mk" - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 5 - - /. - Local variables - ./ - SpiceDouble dlt; - SpiceDouble et; - SpiceDouble et0; - SpiceDouble lt; - SpiceDouble state [6]; - SpiceInt i; - - /. - Load the SPK and LSK kernels via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the start time to seconds past J2000 TDB. - ./ - str2et_c ( "2000 JAN 1 12:00:00 TDB", &et0 ); - - /. - Step through a series of epochs, looking up a - state vector at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = et0 + i*STEP; - - /. - Look up a state vector at epoch ET using the - following inputs: - - Target: Moon (NAIF ID code 301) - Reference frame: J2000 - Aberration correction: Light time and stellar - aberration ('LT+S') - Observer: Earth (NAIF ID code 399) - ./ - spkacs_c ( 301, et, "j2000", "lt+s", - 399, state, <, &dlt ); - - printf( "et = %20.6f\n", et ); - printf( "J2000 x-position (km): %20.8f\n", state[0] ); - printf( "J2000 y-position (km): %20.8f\n", state[1] ); - printf( "J2000 z-position (km): %20.8f\n", state[2] ); - printf( "J2000 x-velocity (km/s): %20.12f\n", state[3] ); - printf( "J2000 y-velocity (km/s): %20.12f\n", state[4] ); - printf( "J2000 z-velocity (km/s): %20.12f\n", state[5] ); - printf( "One-way light time (s): %20.12f\n", lt ); - printf( "Light time rate: %20.08e\n\n", dlt ); - } - return ( 0 ); - } - - - The output produced by this program will vary somewhat as - a function of the platform on which the program is built and - executed. On a PC/Linux/gcc platform, the following output - was produced: - - et = 0.000000 - J2000 x-position (km): -291584.61369498 - J2000 y-position (km): -266693.40583163 - J2000 z-position (km): -76095.65320924 - J2000 x-velocity (km/s): 0.643439157435 - J2000 y-velocity (km/s): -0.666065873657 - J2000 z-velocity (km/s): -0.301310063429 - One-way light time (s): 1.342310610325 - Light time rate: 1.07316909e-07 - - et = 3600.000000 - J2000 x-position (km): -289256.45942322 - J2000 y-position (km): -269080.60545908 - J2000 z-position (km): -77177.35277130 - J2000 x-velocity (km/s): 0.649970320169 - J2000 y-velocity (km/s): -0.660148253293 - J2000 z-velocity (km/s): -0.299630417907 - One-way light time (s): 1.342693954864 - Light time rate: 1.05652599e-07 - - et = 7200.000000 - J2000 x-position (km): -286904.89654240 - J2000 y-position (km): -271446.41676468 - J2000 z-position (km): -78252.96553362 - J2000 x-velocity (km/s): 0.656443883155 - J2000 y-velocity (km/s): -0.654183552046 - J2000 z-velocity (km/s): -0.297928532945 - One-way light time (s): 1.343071311734 - Light time rate: 1.03990457e-07 - - et = 10800.000000 - J2000 x-position (km): -284530.13302756 - J2000 y-position (km): -273790.67111559 - J2000 z-position (km): -79322.41170392 - J2000 x-velocity (km/s): 0.662859504730 - J2000 y-velocity (km/s): -0.648172246851 - J2000 z-velocity (km/s): -0.296204558469 - One-way light time (s): 1.343442689069 - Light time rate: 1.02330665e-07 - - et = 14400.000000 - J2000 x-position (km): -282132.37807792 - J2000 y-position (km): -276113.20159697 - J2000 z-position (km): -80385.61203056 - J2000 x-velocity (km/s): 0.669216846492 - J2000 y-velocity (km/s): -0.642114815280 - J2000 z-velocity (km/s): -0.294458644904 - One-way light time (s): 1.343808095656 - Light time rate: 1.00673404e-07 - - --Restrictions - - 1) The kernel files to be used by spkacs_c must be loaded - (normally by the CSPICE kernel loader furnsh_c) before - this routine is called. - - 2) Unlike most other SPK state computation routines, this - routine requires that the output state be relative to an - inertial reference frame. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 11-JAN-2008 (NJB) - --Index_Entries - - low-level aberration correction - aberration-corrected state from spk file - get light time and stellar aberration-corrected state - --& -*/ - -{ /* Begin spkacs_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkacs_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkacs_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkacs_c", abcorr ); - - - spkacs_ ( (integer *) &targ, - (doublereal *) &et, - (char *) ref, - (char *) abcorr, - (integer *) &obs, - (doublereal *) starg, - (doublereal *) lt, - (doublereal *) dlt, - (ftnlen ) strlen(ref), - (ftnlen ) strlen(abcorr) ); - - - chkout_c ( "spkacs_c" ); - -} /* End spkacs_c */ diff --git a/ext/spice/src/cspice/spkapo.c b/ext/spice/src/cspice/spkapo.c deleted file mode 100644 index b13a77b9d8..0000000000 --- a/ext/spice/src/cspice/spkapo.c +++ /dev/null @@ -1,834 +0,0 @@ -/* spkapo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__9 = 9; - -/* $Procedure SPKAPO ( S/P Kernel, apparent position only ) */ -/* Subroutine */ int spkapo_(integer *targ, doublereal *et, char *ref, - doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, - ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT " - "XLT+S" "XCN " "XCN+S"; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char corr[5]; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ); - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal tpos[3]; - char corr2[5]; - integer i__, refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical usecn, uselt; - extern doublereal vnorm_(doublereal *); - extern logical failed_(void); - extern doublereal clight_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - stlabx_(doublereal *, doublereal *, doublereal *); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - integer maxitr; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), spkgps_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - static logical usestl; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* Return the position of a target body relative to an observer, */ -/* optionally corrected for light time and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of observer's state. */ -/* SOBS I State of observer wrt. solar system barycenter. */ -/* ABCORR I Aberration correction flag. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a position vector which points */ -/* from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the observer's state SOBS is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string REF. */ - -/* SOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* SOBS is a 6-vector: the first three components of */ -/* SOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. SOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* of the target as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The target position */ -/* indicates the direction that photons */ -/* emitted from the observer's location */ -/* must be "aimed" to hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the specified inertial */ -/* reference frame. The components of PTARG represent */ -/* the x-, y- and z-components of the target's position. */ - -/* The vector PTARG points from the observer's position */ -/* at ET to the aberration-corrected location of the */ -/* target. Note that the sense of the position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* 'SPICE(SPKINVALIDOPTION)' is signaled. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame the error 'SPICE(BADFRAME)' is */ -/* signaled. */ - -/* 3) If the position of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute PTARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute PTARG. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." */ - -/* The SPICE Toolkit can correct for two phenomena affecting the */ -/* apparent location of an object: one-way light time (also called */ -/* "planetary aberration") and stellar aberration. Correcting for */ -/* one-way light time is done by computing, given an observer and */ -/* observation epoch, where a target was when the observed photons */ -/* departed the target's location. The vector from the observer to */ -/* this computed target location is called a "light time corrected" */ -/* vector. The light time correction depends on the motion of the */ -/* target, but it is independent of the velocity of the observer */ -/* relative to the solar system barycenter. Relativistic effects */ -/* such as light bending and gravitational delay are not accounted */ -/* for in the light time correction performed by this routine. */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the motion of the target. The stellar aberration formula used */ -/* by this routine is non- relativistic. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This requires correction */ -/* of the geometric target position for the effects of light time and */ -/* stellar aberration, but in this case the corrections are computed */ -/* for radiation traveling from the observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* The traditional aberration corrections applicable to observation */ -/* and those applicable to transmission are related in a simple way: */ -/* one may picture the geometry of the "transmission" case by */ -/* imagining the "observation" case running in reverse time order, */ -/* and vice versa. */ - -/* One may reasonably object to using the term "observer" in the */ -/* transmission case, in which radiation is emitted from the */ -/* observer's location. The terminology was retained for */ -/* consistency with earlier documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation: */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target: */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file: */ - -/* Use 'NONE'. */ - - -/* 4) Compute the apparent position of a target body relative */ -/* to a star or other distant object: */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical: */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations: */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - - -/* Geometric case */ -/* ============== */ - -/* SPKAPO begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' are */ -/* selected, SPKAPO computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) */ -/* and O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT */ -/* is the solution of the */ -/* light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* RHS of the light-time equation (1) yields the "one-iteration" */ -/* estimate of the one-way light time. Repeating the process */ -/* until the estimates of LT converge yields the "converged */ -/* Newtonian" light time estimate. */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - - -/* The light-time corrected position is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter-relative */ -/* velocity vector of the observer. The magnitude of the rotation */ -/* depends on the magnitude of the observer's velocity relative */ -/* to the solar system barycenter and the angle between */ -/* this velocity and the observer-target vector. The rotation */ -/* is computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */ -/* selected, SPKAPO computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - - -/* The light-time corrected position is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The magnitude of the */ -/* rotation depends on the magnitude of the velocity and the */ -/* angle between the velocity and the observer-target vector. */ -/* The rotation is computed as in the reception case, but the */ -/* sign of the rotation angle is negated. */ - -/* Neither special nor general relativistic effects are accounted */ -/* for in the aberration corrections performed by this routine. */ - -/* $ Examples */ - -/* In the following code fragment, SPKSSB and SPKAPO are used */ -/* to display the position of Io (body 501) as seen from the */ -/* Voyager 2 spacecraft (Body -32) at a series of epochs. */ - -/* Normally, one would call the high-level reader SPKPOS to obtain */ -/* position vectors. The example below illustrates the interface */ -/* of this routine, but is not intended as a recommendation on */ -/* how to use the SPICE SPK subsystem. */ - -/* The use of integer ID codes is necessitated by the low-level */ -/* interface of this routine. */ - -/* IO = 501 */ -/* VGR2 = -32 */ - -/* DO WHILE ( EPOCH .LE. END ) */ - -/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */ -/* CALL SPKAPO ( IO, EPOCH, 'J2000', STVGR2, */ -/* . 'LT+S', STIO, LT ) */ - -/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */ -/* WRITE (*,*) RA * DPR(), DEC * DPR() */ - -/* EPOCH = EPOCH + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The ephemeris files to be used by SPKAPO must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 2) Unlike most other SPK position computation routines, this */ -/* routine requires that the input state be relative to an */ -/* inertial reference frame. Non-inertial frames are not */ -/* supported by this routine. */ - -/* 3) In a future version of this routine, the implementation */ -/* of the aberration corrections may be enhanced to improve */ -/* accuracy. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.2.0, 17-MAY-2010 (NJB) */ - -/* Bug fix: routine now returns immediately after */ -/* state lookup failure. */ - -/* - SPICELIB Version 2.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* - SPICELIB Version 2.0.1, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ -/* Corrected spelling errors. */ - -/* - SPICELIB Version 2.0.0, 18-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* apparent position from spk file */ -/* get apparent position */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of flags in the FLAGS array: */ - - -/* NAIF ID code for the solar system barycenter: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKAPO", (ftnlen)6); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - -/* Remove leading and embedded white space from the aberration */ -/* correction flag, then convert to upper case. */ - - cmprss_(" ", &c__0, abcorr, corr2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(corr2, corr, (ftnlen)5, (ftnlen)5); - -/* Locate the flag in our list of flags. */ - - i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5); - if (i__ == 0) { - setmsg_("Requested aberration correction was #.", (ftnlen)38); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23); - chkout_("SPKAPO", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction. */ - - xmit = i__ > 5; - uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7; - usestl = i__ > 1 && odd_(&i__); - usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("SPKAPO", (ftnlen)6); - return 0; - } - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Find the geometric position of the target body with respect to the */ -/* solar system barycenter. Subtract the position of the observer */ -/* to get the relative position. Use this to compute the one-way */ -/* light time. */ - - spkgps_(targ, et, ref, &c__0, ptarg, lt, ref_len); - if (failed_()) { - chkout_("SPKAPO", (ftnlen)6); - return 0; - } - vsub_(ptarg, sobs, tpos); - vequ_(tpos, ptarg); - *lt = vnorm_(ptarg) / clight_(); - -/* To correct for light time, find the position of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where he is. */ - - if (uselt) { - maxitr = 1; - } else if (usecn) { - maxitr = 3; - } else { - maxitr = 0; - } - i__1 = maxitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - spkgps_(targ, &d__1, ref, &c__0, ptarg, lt, ref_len); - if (failed_()) { - chkout_("SPKAPO", (ftnlen)6); - return 0; - } - vsub_(ptarg, sobs, tpos); - vequ_(tpos, ptarg); - *lt = vnorm_(ptarg) / clight_(); - } - -/* At this point, PTARG contains the geometric or light-time */ -/* corrected position of the target relative to the observer, */ -/* depending on the specified correction. */ - -/* If stellar aberration correction is requested, perform it now. */ - - if (usestl) { - if (xmit) { - -/* This is the transmission case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to PTARG. */ - - stlabx_(ptarg, &sobs[3], tpos); - vequ_(tpos, ptarg); - } else { - -/* This is the reception case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to PTARG. */ - - stelab_(ptarg, &sobs[3], tpos); - vequ_(tpos, ptarg); - } - } - chkout_("SPKAPO", (ftnlen)6); - return 0; -} /* spkapo_ */ - diff --git a/ext/spice/src/cspice/spkapo_c.c b/ext/spice/src/cspice/spkapo_c.c deleted file mode 100644 index fc3bab4dcc..0000000000 --- a/ext/spice/src/cspice/spkapo_c.c +++ /dev/null @@ -1,663 +0,0 @@ -/* - --Procedure spkapo_c ( S/P Kernel, apparent position only ) - --Abstract - - Return the position of a target body relative to an observer, - optionally corrected for light time and stellar aberration. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef spkapo_c - - - void spkapo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs[6], - ConstSpiceChar * abcorr, - SpiceDouble ptarg[3], - SpiceDouble * lt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Observer epoch. - ref I Inertial reference frame of observer's state. - sobs I State of observer wrt. solar system barycenter. - abcorr I Aberration correction flag. - ptarg O Position of target. - lt O One way light time between observer and target. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a position vector which points - from the observer to the target. - - et is the ephemeris time, expressed as seconds past - J2000 TDB, at which the position of the target body - relative to the observer is to be computed. 'et' - refers to time at the observer's location. - - ref is the inertial reference frame with respect to which - the observer's state 'sobs' is expressed. 'ref' must be - recognized by the SPICE Toolkit. The acceptable - frames are listed in the Frames Required Reading, as - well as in the CSPICE routine chgirf_. - - Case and blanks are not significant in the string - 'ref'. - - sobs is the geometric (uncorrected) state of the observer - relative to the solar system barycenter at epoch et. - 'sobs' is a 6-vector: the first three components of - 'sobs' represent a Cartesian position vector; the last - three components represent the corresponding velocity - vector. 'sobs' is expressed relative to the inertial - reference frame designated by 'ref'. - - Units are always km and km/sec. - - - abcorr indicates the aberration corrections to be applied to - the position of the target body to account for - one-way light time and stellar aberration. See the - discussion in the Particulars section for - recommendations on how to choose aberration - corrections. - - 'abcorr' may be any of the following: - - "NONE" Apply no correction. Return the - geometric position of the target body - relative to the observer. - - The following values of 'abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at et: - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the position of the target at the - moment it emitted photons arriving at - the observer at et. - - The light time correction involves - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - position obtained with the "LT" option - to account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - position of the target---the position - of the target as seen by the observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of 'abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at 'et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - position of the target at the moment it - receives photons emitted from the - observer's location at et. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - position obtained with the "XLT" option - to account for the observer's velocity - relative to the solar system - barycenter. The target position - indicates the direction that photons - emitted from the observer's location - must be "aimed" to hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - 'abcorr'. - --Detailed_Output - - ptarg is a Cartesian 3-vector representing the position of - the target body relative to the specified observer. - 'ptarg' is corrected for the specified aberrations, and - is expressed with respect to the specified inertial - reference frame. The components of 'ptarg' represent - the x-, y- and z-components of the target's position. - - Units are always km. - - The vector 'ptarg' points from the observer's position - at 'et' to the aberration-corrected location of the - target. Note that the sense of the position vector is - independent of the direction of radiation travel - implied by the aberration correction. - - lt is the one-way light time between the observer and - target in seconds. If the target position is - corrected for aberrations, then 'lt' is the one-way - light time between the observer and the light time - corrected target location. - --Parameters - - None. - --Exceptions - - 1) If the value of 'abcorr' is not recognized, the error - SPICE(SPKINVALIDOPTION) is signaled. - - 2) If the reference frame requested is not a recognized - inertial reference frame the error SPICE(BADFRAME) is - signaled. - - 3) If the position of the target relative to the solar system - barycenter cannot be computed, the error will be diagnosed - by routines in the call tree of this routine. - --Files - - - This routine computes positions using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. Application programs typically load - kernels once before this routine is called, for example during - program initialization; kernels need not be loaded repeatedly. - See the routine furnsh_c and the SPK and KERNEL Required Reading - for further information on loading (and unloading) kernels. - - If any of the ephemeris data used to compute 'ptarg' are expressed - relative to a non-inertial frame in the SPK files providing those - data, additional kernels may be needed to enable the reference - frame transformations required to compute 'ptarg'. Normally - these additional kernels are PCK files or frame kernels. Any - such kernels must already be loaded at the time this routine is - called. - --Particulars - - In space science or engineering applications one frequently - wishes to know where to point a remote sensing instrument, such - as an optical camera or radio antenna, in order to observe or - otherwise receive radiation from a target. This pointing problem - is complicated by the finite speed of light: one needs to point - to where the target appears to be as opposed to where it actually - is at the epoch of observation. We use the adjectives - "geometric," "uncorrected," or "true" to refer to an actual - position or state of a target at a specified epoch. When a - geometric position or state vector is modified to reflect how it - appears to an observer, we describe that vector by any of the - terms "apparent," "corrected," "aberration corrected," or "light - time and stellar aberration corrected." - - The SPICE Toolkit can correct for two phenomena affecting the - apparent location of an object: one-way light time (also called - "planetary aberration") and stellar aberration. Correcting for - one-way light time is done by computing, given an observer and - observation epoch, where a target was when the observed photons - departed the target's location. The vector from the observer to - this computed target location is called a "light time corrected" - vector. The light time correction depends on the motion of the - target, but it is independent of the velocity of the observer - relative to the solar system barycenter. Relativistic effects - such as light bending and gravitational delay are not accounted - for in the light time correction performed by this routine. - - The velocity of the observer also affects the apparent location - of a target: photons arriving at the observer are subject to a - "raindrop effect" whereby their velocity relative to the observer - is, using a Newtonian approximation, the photons' velocity - relative to the solar system barycenter minus the velocity of the - observer relative to the solar system barycenter. This effect is - called "stellar aberration." Stellar aberration is independent - of the motion of the target. The stellar aberration formula used - by this routine is non- relativistic. - - Stellar aberration corrections are applied after light time - corrections: the light time corrected target position vector is - used as an input to the stellar aberration correction. - - When light time and stellar aberration corrections are both - applied to a geometric position vector, the resulting position - vector indicates where the target "appears to be" from the - observer's location. - - As opposed to computing the apparent position of a target, one - may wish to compute the pointing direction required for - transmission of photons to the target. This requires correction - of the geometric target position for the effects of light time and - stellar aberration, but in this case the corrections are computed - for radiation traveling from the observer to the target. - - The "transmission" light time correction yields the target's - location as it will be when photons emitted from the observer's - location at 'et' arrive at the target. The transmission stellar - aberration correction is the inverse of the traditional stellar - aberration correction: it indicates the direction in which - radiation should be emitted so that, using a Newtonian - approximation, the sum of the velocity of the radiation relative - to the observer and of the observer's velocity, relative to the - solar system barycenter, yields a velocity vector that points in - the direction of the light time corrected position of the target. - - The traditional aberration corrections applicable to observation - and those applicable to transmission are related in a simple way: - one may picture the geometry of the "transmission" case by - imagining the "observation" case running in reverse time order, - and vice versa. - - One may reasonably object to using the term "observer" in the - transmission case, in which radiation is emitted from the - observer's location. The terminology was retained for - consistency with earlier documentation. - - Below, we indicate the aberration corrections to use for some - common applications: - - 1) Find the apparent direction of a target for a remote-sensing - observation: - - Use "LT+S": apply both light time and stellar - aberration corrections. - - Note that using light time corrections alone ("LT") is - generally not a good way to obtain an approximation to an - apparent target vector: since light time and stellar - aberration corrections often partially cancel each other, - it may be more accurate to use no correction at all than to - use light time alone. - - - 2) Find the corrected pointing direction to radiate a signal - to a target: - - Use "XLT+S": apply both light time and stellar - aberration corrections for transmission. - - - 3) Obtain an uncorrected position vector derived directly from - data in an SPK file: - - Use "NONE". - - - 4) Compute the apparent position of a target body relative - to a star or other distant object: - - Use "LT" or "LT+S" as needed to match the correction - applied to the position of the distant object. For - example, if a star position is obtained from a catalog, - the position vector may not be corrected for stellar - aberration. In this case, to find the angular - separation of the star and the limb of a planet, the - vector from the observer to the planet should be - corrected for light time but not stellar aberration. - - - 5) Use a geometric position vector as a low-accuracy estimate - of the apparent position for an application where execution - speed is critical: - - Use "NONE". - - - 6) While this routine cannot perform the relativistic - aberration corrections required to compute positions - with the highest possible accuracy, it can supply the - geometric positions required as inputs to these - computations: - - Use "NONE", then apply high-accuracy aberration - corrections (not available in the SPICE Toolkit). - - - Below, we discuss in more detail how the aberration corrections - applied by this routine are computed. - - - Geometric case - ============== - - spkapo_c begins by computing the geometric position T(et) of the - target body relative to the solar system barycenter (SSB). - Subtracting the geometric position of the observer O(et) gives - the geometric position of the target body relative to the - observer. The one-way light time, lt, is given by - - | T(et) - O(et) | - lt = ------------------- - c - - The geometric relationship between the observer, target, and - solar system barycenter is as shown: - - - SSB ---> O(et) - | / - | / - | / - | / T(et) - O(et) - V V - T(et) - - - The returned position vector is - - T(et) - O(et) - - - Reception case - ============== - - When any of the options "LT", "CN", "LT+S", "CN+S" are - selected, spkapo_c computes the position of the target body at - epoch et-lt, where lt is the one-way light time. Let T(t) - and O(t) represent the positions of the target and observer - relative to the solar system barycenter at time t; then lt - is the solution of the - light-time equation - - | T(et-lt) - O(et) | - lt = ------------------------ (1) - c - - The ratio - - | T(et) - O(et) | - --------------------- (2) - c - - is used as a first approximation to lt; inserting (2) into the - RHS of the light-time equation (1) yields the "one-iteration" - estimate of the one-way light time. Repeating the process - until the estimates of lt converge yields the "converged - Newtonian" light time estimate. - - Subtracting the geometric position of the observer O(et) gives - the position of the target body relative to the observer: - T(et-lt) - O(et). - - SSB ---> O(et) - | \ | - | \ | - | \ | T(et-lt) - O(et) - | \ | - V V V - T(et) T(et-lt) - - - The light-time corrected position is the vector - - T(et-lt) - O(et) - - If correction for stellar aberration is requested, the target - position is rotated toward the solar system barycenter-relative - velocity vector of the observer. The magnitude of the rotation - depends on the magnitude of the observer's velocity relative - to the solar system barycenter and the angle between - this velocity and the observer-target vector. The rotation - is computed as follows: - - Let r be the light time corrected vector from the observer - to the object, and v be the velocity of the observer with - respect to the solar system barycenter. Let w be the angle - between them. The aberration angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - h = r X v - - Rotate r by phi radians about h to obtain the apparent - position of the object. - - - - Transmission case - ================== - - When any of the options "XLT", "XCN", "XLT+S", "XCN+S" are - selected, spkapo_c computes the position of the target body T at - epoch et+lt, where lt is the one-way light time. lt is the - solution of the light-time equation - - | T(et+lt) - O(et) | - lt = ------------------------ (3) - c - - Subtracting the geometric position of the observer, O(et), - gives the position of the target body relative to the - observer: T(et-lt) - O(et). - - SSB --> O(et) - / | * - / | * T(et+lt) - O(et) - / |* - / *| - V V V - T(et+lt) T(et) - - - The light-time corrected position is - - T(et+lt) - O(et) - - If correction for stellar aberration is requested, the target - position is rotated away from the solar system barycenter- - relative velocity vector of the observer. The magnitude of the - rotation depends on the magnitude of the velocity and the - angle between the velocity and the observer-target vector. - The rotation is computed as in the reception case, but the - sign of the rotation angle is negated. - - Neither special nor general relativistic effects are accounted - for in the aberration corrections performed by this routine. - --Examples - - In the following code fragment, spkssb_c and spkapo_c are used - to display the position of Io (body 501) as seen from the - Voyager 2 spacecraft (Body -32) at a series of epochs. - - Normally, one would call the high-level reader spkpos_c to obtain - position vectors. The example below illustrates the interface - of this routine, but is not intended as a recommendation on - how to use the CSPICE SPK subsystem. - - The use of integer ID codes is necessitated by the low-level - interface of this routine. - - - #include - #include "SpiceUsr.h" - . - . - . - #define IO 501 - #define VGR2 -32 - - while ( epoch <= end ) - { - spkssb_c ( VGR2, epoch, "J2000", stvgr2 ); - spkapo_c ( IO, epoch, "J2000", stvgr2, "LT", posio, < ); - recrad_c ( posio, &range, &ra, &dec ); - - printf ( "RA = %f DEC = %f\n", ra*dpr_c(), dec*dpr_c() ); - - epoch += delta; - } - - --Restrictions - - 1) The ephemeris files to be used by spkapo_c must be loaded - (normally by the CSPICE kernel loader furnsh_c) before - this routine is called. - - 2) Unlike most other SPK position computation routines, this - routine requires that the input state be relative to an - inertial reference frame. Non-inertial frames are not - supported by this routine. - - 3) In a future version of this routine, the implementation - of the aberration corrections may be enhanced to improve - accuracy. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - I.M. Underwood (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 2.0.1, 13-OCT-2003 (EDW) - - Various minor header changes were made to improve clarity. - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - - Updated to handle aberration corrections for transmission - of radiation. Formerly, only the reception case was - supported. The header was revised and expanded to explain - the functionality of this routine in more detail. - - -CSPICE Version 1.0.0, 26-JUN-1999 (NJB) (HAN) (IMU) (WLT) - --Index_Entries - - apparent position from spk file - get apparent position - --& -*/ - -{ /* Begin spkapo_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkapo_c" ); - - - /* - Check the input strings 'ref' and 'abcorr' to make sure the - pointers are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkapo_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkapo_c", abcorr ); - - - /* - Call the f2c'd routine. - */ - spkapo_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( doublereal * ) sobs, - ( char * ) abcorr, - ( doublereal * ) ptarg, - ( doublereal * ) lt, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(abcorr) ); - - - chkout_c ( "spkapo_c" ); - -} /* End spkapo_c */ diff --git a/ext/spice/src/cspice/spkapp.c b/ext/spice/src/cspice/spkapp.c deleted file mode 100644 index 928c81761a..0000000000 --- a/ext/spice/src/cspice/spkapp.c +++ /dev/null @@ -1,914 +0,0 @@ -/* spkapp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__9 = 9; -static integer c__6 = 6; - -/* $Procedure SPKAPP ( S/P Kernel, apparent state ) */ -/* Subroutine */ int spkapp_(integer *targ, doublereal *et, char *ref, - doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, - ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT " - "XLT+S" "XCN " "XCN+S"; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char corr[5]; - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - char corr2[5]; - integer i__, refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), moved_( - doublereal *, integer *, doublereal *); - static logical usecn; - doublereal sapos[3]; - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - static logical uselt; - extern doublereal vnorm_(doublereal *), clight_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - stlabx_(doublereal *, doublereal *, doublereal *); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - doublereal tstate[6]; - integer maxitr; - extern /* Subroutine */ int spkssb_(integer *, doublereal *, char *, - doublereal *, ftnlen), cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - static logical usestl; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* Deprecated: This routine has been superseded by SPKAPS. This */ -/* routine is supported for purposes of backward compatibility only. */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time and */ -/* stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of observer's state. */ -/* SOBS I State of observer wrt. solar system barycenter. */ -/* ABCORR I Aberration correction flag. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the observer's state SOBS is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string REF. */ - -/* SOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* SOBS is a 6-vector: the first three components of */ -/* SOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. SOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* The velocity component of STARG is obtained by */ -/* evaluating the target's geometric state at the light */ -/* time corrected epoch, so for aberration-corrected */ -/* states, the velocity is not precisely equal to the */ -/* time derivative of the position. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* 'SPICE(SPKINVALIDOPTION)' is signaled. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error 'SPICE(BADFRAME)' */ -/* is signaled. */ - -/* 3) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." */ - -/* The SPICE Toolkit can correct for two phenomena affecting the */ -/* apparent location of an object: one-way light time (also called */ -/* "planetary aberration") and stellar aberration. Correcting for */ -/* one-way light time is done by computing, given an observer and */ -/* observation epoch, where a target was when the observed photons */ -/* departed the target's location. The vector from the observer to */ -/* this computed target location is called a "light time corrected" */ -/* vector. The light time correction depends on the motion of the */ -/* target, but it is independent of the velocity of the observer */ -/* relative to the solar system barycenter. Relativistic effects */ -/* such as light bending and gravitational delay are not accounted */ -/* for in the light time correction performed by this routine. */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine is non-relativistic. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This requires correction */ -/* of the geometric target position for the effects of light time and */ -/* stellar aberration, but in this case the corrections are computed */ -/* for radiation traveling from the observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* The traditional aberration corrections applicable to observation */ -/* and those applicable to transmission are related in a simple way: */ -/* one may picture the geometry of the "transmission" case by */ -/* imagining the "observation" case running in reverse time order, */ -/* and vice versa. */ - -/* One may reasonably object to using the term "observer" in the */ -/* transmission case, in which radiation is emitted from the */ -/* observer's location. The terminology was retained for */ -/* consistency with earlier documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation: */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target: */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file: */ - -/* Use 'NONE'. */ - - -/* 4) Compute the apparent position of a target body relative */ -/* to a star or other distant object: */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical: */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations: */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - - -/* Geometric case */ -/* ============== */ - -/* SPKAPP begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */ -/* selected, SPKAPP computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* RHS of the light-time equation (1) yields the "one-iteration" */ -/* estimate of the one-way light time. Repeating the process */ -/* until the estimates of LT converge yields the "converged */ -/* Newtonian" light time estimate. */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of */ -/* the target and observer relative to the solar system */ -/* barycenter at the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* The velocity component of the output state STARG is */ -/* not corrected for stellar aberration. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */ -/* selected, SPKAPP computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* is the difference */ - -/* T_vel(ET+LT) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of */ -/* the target and observer relative to the solar system */ -/* barycenter at the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - -/* The velocity component of the output state STARG is */ -/* not corrected for stellar aberration. */ - -/* Neither special nor general relativistic effects are accounted */ -/* for in the aberration corrections performed by this routine. */ - -/* $ Examples */ - -/* In the following code fragment, SPKSSB and SPKAPP are used */ -/* to display the position of Io (body 501) as seen from the */ -/* Voyager 2 spacecraft (Body -32) at a series of epochs. */ - -/* Normally, one would call the high-level reader SPKEZR to obtain */ -/* state vectors. The example below illustrates the interface */ -/* of this routine but is not intended as a recommendation on */ -/* how to use the SPICE SPK subsystem. */ - -/* The use of integer ID codes is necessitated by the low-level */ -/* interface of this routine. */ - -/* IO = 501 */ -/* VGR2 = -32 */ - -/* DO WHILE ( EPOCH .LE. END ) */ - -/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */ -/* CALL SPKAPP ( IO, EPOCH, 'J2000', STVGR2, */ -/* . 'LT+S', STIO, LT ) */ - -/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */ -/* WRITE (*,*) RA * DPR(), DEC * DPR() */ - -/* EPOCH = EPOCH + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The kernel files to be used by SPKAPP must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 2) Unlike most other SPK state computation routines, this */ -/* routine requires that the input state be relative to an */ -/* inertial reference frame. Non-inertial frames are not */ -/* supported by this routine. */ - -/* 3) In a future version of this routine, the implementation */ -/* of the aberration corrections may be enhanced to improve */ -/* accuracy. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.3, 18-MAY-2010 (BVS) */ - -/* Index lines now state that this routine is deprecated. */ - -/* - SPICELIB Version 3.0.2, 08-JAN-2008 (NJB) */ - -/* The Abstract section of the header was updated to */ -/* indicate that this routine has been deprecated. */ - -/* - SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ -/* Corrected spelling errors. */ - -/* - SPICELIB Version 3.0.0, 18-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 2.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */ - -/* The routine was modified to support the options 'CN' and */ -/* 'CN+S' aberration corrections. Moreover, diagnostics were */ -/* added to check for reference frames that are not recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 1.1.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */ - -/* In the example program, the calling sequence of SPKAPP */ -/* was corrected. */ - -/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */ - -/* The local variable CORR was added to eliminate a */ -/* run-time error that occurred when SPKAPP was determining */ -/* what corrections to apply to the state. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED low-level aberration correction */ -/* DEPRECATED apparent state from spk file */ -/* DEPRECATED get apparent state */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */ - -/* The routine was modified to support the options 'CN' and */ -/* 'CN+S' aberration corrections. Moreover, diagnostics were */ -/* added to check for reference frames that are not recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */ - -/* In the example program, the calling sequence of SPKAPP */ -/* was corrected. */ - -/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */ - -/* The local variable CORR was added to eliminate a run-time */ -/* error that occurred when SPKAPP was determining what */ -/* corrections to apply to the state. If the literal string */ -/* 'LT' was assigned to ABCORR, SPKAPP attempted to look at */ -/* ABCORR(3:4). Because ABCORR is a passed length argument, its */ -/* length is not guaranteed, and those positions may not exist. */ -/* Searching beyond the bounds of a string resulted in a */ -/* run-time error at NAIF because NAIF compiles SPICELIB using the */ -/* CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */ -/* Also, without the local variable CORR, SPKAPP would have to */ -/* modify the value of a passed argument, ABCORR. That's a no no. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of flags in the FLAGS array: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKAPP", (ftnlen)6); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - -/* Remove leading and embedded white space from the aberration */ -/* correction flag, then convert to upper case. */ - - cmprss_(" ", &c__0, abcorr, corr2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(corr2, corr, (ftnlen)5, (ftnlen)5); - -/* Locate the flag in our list of flags. */ - - i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5); - if (i__ == 0) { - setmsg_("Requested aberration correction # is not supported.", ( - ftnlen)51); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23); - chkout_("SPKAPP", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction. */ - - xmit = i__ > 5; - uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7; - usestl = i__ > 1 && odd_(&i__); - usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("SPKAPP", (ftnlen)6); - return 0; - } - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Find the geometric state of the target body with respect to the */ -/* solar system barycenter. Subtract the state of the observer */ -/* to get the relative state. Use this to compute the one-way */ -/* light time. */ - - spkssb_(targ, et, ref, starg, ref_len); - vsubg_(starg, sobs, &c__6, tstate); - moved_(tstate, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - -/* To correct for light time, find the state of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where he is. */ - - if (uselt) { - maxitr = 1; - } else if (usecn) { - maxitr = 3; - } else { - maxitr = 0; - } - i__1 = maxitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - spkssb_(targ, &d__1, ref, starg, ref_len); - vsubg_(starg, sobs, &c__6, tstate); - moved_(tstate, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - } - -/* At this point, STARG contains the light time corrected */ -/* state of the target relative to the observer. */ - -/* If stellar aberration correction is requested, perform it now. */ - -/* Stellar aberration corrections are not applied to the target's */ -/* velocity. */ - - if (usestl) { - if (xmit) { - -/* This is the transmission case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to STARG. */ - - stlabx_(starg, &sobs[3], sapos); - vequ_(sapos, starg); - } else { - -/* This is the reception case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to STARG. */ - - stelab_(starg, &sobs[3], sapos); - vequ_(sapos, starg); - } - } - chkout_("SPKAPP", (ftnlen)6); - return 0; -} /* spkapp_ */ - diff --git a/ext/spice/src/cspice/spkapp_c.c b/ext/spice/src/cspice/spkapp_c.c deleted file mode 100644 index 588d4b7258..0000000000 --- a/ext/spice/src/cspice/spkapp_c.c +++ /dev/null @@ -1,706 +0,0 @@ -/* - --Procedure spkapp_c ( S/P Kernel, apparent state ) - --Abstract - - Deprecated: This routine has been superseded by spkaps_c. This - routine is supported for purposes of backward compatibility only. - - Return the state (position and velocity) of a target body - relative to an observer, optionally corrected for light time and - stellar aberration. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkapp_c - - - void spkapp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs [6], - ConstSpiceChar * abcorr, - SpiceDouble starg [6], - SpiceDouble * lt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Observer epoch. - ref I Inertial reference frame of observer's state. - sobs I State of observer wrt. solar system barycenter. - abcorr I Aberration correction flag. - starg O State of target. - lt O One way light time between observer and target. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a state vector whose position - component points from the observer to the target. - - et is the ephemeris time, expressed as seconds past J2000 - TDB, at which the state of the target body relative to - the observer is to be computed. 'et' refers to time at - the observer's location. - - ref is the inertial reference frame with respect to which - the observer's state 'sobs' is expressed. 'ref' must be - recognized by the SPICE Toolkit. The acceptable - frames are listed in the Frames Required Reading, as - well as in the CSPICE routine chgirf_. - - Case and blanks are not significant in the string 'ref'. - - sobs is the geometric (uncorrected) state of the observer - relative to the solar system barycenter at epoch 'et'. - 'sobs' is a 6-vector: the first three components of - 'sobs' represent a Cartesian position vector; the last - three components represent the corresponding velocity - vector. 'sobs' is expressed relative to the inertial - reference frame designated by 'ref'. - - Units are always km and km/sec. - - abcorr indicates the aberration corrections to be applied - to the state of the target body to account for one-way - light time and stellar aberration. See the discussion - in the Particulars section for recommendations on - how to choose aberration corrections. - - abcorr may be any of the following: - - "NONE" Apply no correction. Return the - geometric state of the target body - relative to the observer. - - The following values of abcorr apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at 'et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the state of the target at the - moment it emitted photons arriving at - the observer at 'et'. - - The light time correction involves - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - state obtained with the "LT" option to - account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - state of the target---the position and - velocity of the target as seen by the - observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of abcorr apply to the - "transmission" case in which photons *depart* from - the observer's location at 'et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - state of the target at the moment it - receives photons emitted from the - observer's location at 'et'. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - state obtained with the "XLT" option to - account for the observer's velocity - relative to the solar system - barycenter. The position component of - the computed target state indicates the - direction that photons emitted from the - observer's location must be "aimed" to - hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - abcorr. - --Detailed_Output - - starg is a Cartesian state vector representing the position - and velocity of the target body relative to the - specified observer. 'starg' is corrected for the - specified aberrations, and is expressed with respect - to the specified inertial reference frame. The first - three components of 'starg' represent the x-, y- and - z-components of the target's position; last three - components form the corresponding velocity vector. - - Units are always km and km/sec. - - The position component of 'starg' points from the - observer's location at 'et' to the aberration-corrected - location of the target. Note that the sense of the - position vector is independent of the direction of - radiation travel implied by the aberration - correction. - - The velocity component of 'starg' is obtained by - evaluating the target's geometric state at the light - time corrected epoch, so for aberration-corrected - states, the velocity is not precisely equal to the - time derivative of the position. - - lt is the one-way light time between the observer and - target in seconds. If the target state is corrected - for aberrations, then 'lt' is the one-way light time - between the observer and the light time corrected - target location. - --Parameters - - None. - --Exceptions - - 1) If the value of abcorr is not recognized, the error - SPICE(SPKINVALIDOPTION) is signaled. - - 2) If the reference frame requested is not a recognized - inertial reference frame, the error SPICE(BADFRAME) - is signaled. - - 3) If the state of the target relative to the solar system - barycenter cannot be computed, the error will be diagnosed - by routines in the call tree of this routine. - --Files - - This routine computes states using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. Application programs typically load - kernels once before this routine is called, for example during - program initialization; kernels need not be loaded repeatedly. - See the routine furnsh_c and the SPK and KERNEL Required Reading - for further information on loading (and unloading) kernels. - - If any of the ephemeris data used to compute 'starg' are expressed - relative to a non-inertial frame in the SPK files providing those - data, additional kernels may be needed to enable the reference - frame transformations required to compute the state. Normally - these additional kernels are PCK files or frame kernels. Any - such kernels must already be loaded at the time this routine is - called. - --Particulars - - In space science or engineering applications one frequently - wishes to know where to point a remote sensing instrument, such - as an optical camera or radio antenna, in order to observe or - otherwise receive radiation from a target. This pointing problem - is complicated by the finite speed of light: one needs to point - to where the target appears to be as opposed to where it actually - is at the epoch of observation. We use the adjectives - "geometric," "uncorrected," or "true" to refer to an actual - position or state of a target at a specified epoch. When a - geometric position or state vector is modified to reflect how it - appears to an observer, we describe that vector by any of the - terms "apparent," "corrected," "aberration corrected," or "light - time and stellar aberration corrected." - - The SPICE Toolkit can correct for two phenomena affecting the - apparent location of an object: one-way light time (also called - "planetary aberration") and stellar aberration. Correcting for - one-way light time is done by computing, given an observer and - observation epoch, where a target was when the observed photons - departed the target's location. The vector from the observer to - this computed target location is called a "light time corrected" - vector. The light time correction depends on the motion of the - target, but it is independent of the velocity of the observer - relative to the solar system barycenter. Relativistic effects - such as light bending and gravitational delay are not accounted - for in the light time correction performed by this routine. - - The velocity of the observer also affects the apparent location - of a target: photons arriving at the observer are subject to a - "raindrop effect" whereby their velocity relative to the observer - is, using a Newtonian approximation, the photons' velocity - relative to the solar system barycenter minus the velocity of the - observer relative to the solar system barycenter. This effect is - called "stellar aberration." Stellar aberration is independent - of the velocity of the target. The stellar aberration formula - used by this routine is non-relativistic. - - Stellar aberration corrections are applied after light time - corrections: the light time corrected target position vector is - used as an input to the stellar aberration correction. - - When light time and stellar aberration corrections are both - applied to a geometric position vector, the resulting position - vector indicates where the target "appears to be" from the - observer's location. - - As opposed to computing the apparent position of a target, one - may wish to compute the pointing direction required for - transmission of photons to the target. This requires correction - of the geometric target position for the effects of light time and - stellar aberration, but in this case the corrections are computed - for radiation traveling from the observer to the target. - - The "transmission" light time correction yields the target's - location as it will be when photons emitted from the observer's - location at 'et' arrive at the target. The transmission stellar - aberration correction is the inverse of the traditional stellar - aberration correction: it indicates the direction in which - radiation should be emitted so that, using a Newtonian - approximation, the sum of the velocity of the radiation relative - to the observer and of the observer's velocity, relative to the - solar system barycenter, yields a velocity vector that points in - the direction of the light time corrected position of the target. - - The traditional aberration corrections applicable to observation - and those applicable to transmission are related in a simple way: - one may picture the geometry of the "transmission" case by - imagining the "observation" case running in reverse time order, - and vice versa. - - One may reasonably object to using the term "observer" in the - transmission case, in which radiation is emitted from the - observer's location. The terminology was retained for - consistency with earlier documentation. - - Below, we indicate the aberration corrections to use for some - common applications: - - 1) Find the apparent direction of a target for a remote-sensing - observation: - - Use "LT+S": apply both light time and stellar - aberration corrections. - - Note that using light time corrections alone ("LT") is - generally not a good way to obtain an aproximation to an - apparent target vector: since light time and stellar - aberration corrections often partially cancel each other, - it may be more accurate to use no correction at all than to - use light time alone. - - - 2) Find the corrected pointing direction to radiate a signal - to a target: - - Use "XLT+S": apply both light time and stellar - aberration corrections for transmission. - - - 3) Obtain an uncorrected state vector derived directly from - data in an SPK file: - - Use "NONE". - - - 4) Compute the apparent position of a target body relative - to a star or other distant object: - - Use "LT" or "LT+S" as needed to match the correction - applied to the position of the distant object. For - example, if a star position is obtained from a catalog, - the position vector may not be corrected for stellar - aberration. In this case, to find the angular - separation of the star and the limb of a planet, the - vector from the observer to the planet should be - corrected for light time but not stellar aberration. - - - 5) Use a geometric state vector as a low-accuracy estimate - of the apparent state for an application where execution - speed is critical: - - Use "NONE". - - - 6) While this routine cannot perform the relativistic - aberration corrections required to compute states - with the highest possible accuracy, it can supply the - geometric states required as inputs to these computations: - - Use "NONE", then apply high-accuracy aberration - corrections (not available in the SPICE Toolkit). - - - Below, we discuss in more detail how the aberration corrections - applied by this routine are computed. - - - Geometric case - ============== - - spkapp_c begins by computing the geometric position T(et) of the - target body relative to the solar system barycenter (SSB). - Subtracting the geometric position of the observer O(et) gives - the geometric position of the target body relative to the - observer. The one-way light time, 'lt', is given by - - | T(et) - O(et) | - lt = ------------------- - c - - The geometric relationship between the observer, target, and - solar system barycenter is as shown: - - - SSB ---> O(et) - | / - | / - | / - | / T(et) - O(et) - V V - T(et) - - - The returned state consists of the position vector - - T(et) - O(et) - - and a velocity obtained by taking the difference of the - corresponding velocities. In the geometric case, the - returned velocity is actually the time derivative of the - position. - - - Reception case - ============== - - When any of the options "LT", "CN", "LT+S", "CN+S" is - selected, spkapp_c computes the position of the target body at - epoch et-lt, where 'lt' is the one-way light time. Let T(t) and - O(t) represent the positions of the target and observer - relative to the solar system barycenter at time t; then 'lt' is - the solution of the light-time equation - - | T(et-lt) - O(et) | - lt = ------------------------ (1) - c - - The ratio - - | T(et) - O(et) | - --------------------- (2) - c - - is used as a first approximation to 'lt'; inserting (2) into the - RHS of the light-time equation (1) yields the "one-iteration" - estimate of the one-way light time. Repeating the process - until the estimates of 'lt' converge yields the "converged - Newtonian" light time estimate. - - Subtracting the geometric position of the observer O(et) gives - the position of the target body relative to the observer: - T(et-lt) - O(et). - - SSB ---> O(et) - | \ | - | \ | - | \ | T(et-lt) - O(et) - | \ | - V V V - T(et) T(et-lt) - - The position component of the light-time corrected state - is the vector - - T(et-lt) - O(et) - - The velocity component of the light-time corrected state - is the difference - - T_vel(et-lt) - O_vel(et) - - where T_vel and O_vel are, respectively, the velocities of - the target and observer relative to the solar system - barycenter at the epochs et-lt and 'et'. - - If correction for stellar aberration is requested, the target - position is rotated toward the solar system barycenter- - relative velocity vector of the observer. The rotation is - computed as follows: - - Let r be the light time corrected vector from the observer - to the object, and v be the velocity of the observer with - respect to the solar system barycenter. Let w be the angle - between them. The aberration angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - h = r X v - - Rotate r by phi radians about h to obtain the apparent - position of the object. - - The velocity component of the output state 'starg' is - not corrected for stellar aberration. - - - Transmission case - ================== - - When any of the options "XLT", "XCN", "XLT+S", "XCN+S" are - selected, spkapp_c computes the position of the target body T at - epoch et+lt, where 'lt' is the one-way light time. 'lt' is the - solution of the light-time equation - - | T(et+lt) - O(et) | - lt = ------------------------ (3) - c - - Subtracting the geometric position of the observer, O(et), - gives the position of the target body relative to the - observer: T(et-lt) - O(et). - - SSB --> O(et) - / | * - / | * T(et+lt) - O(et) - / |* - / *| - V V V - T(et+lt) T(et) - - The position component of the light-time corrected state - is the vector - - T(et+lt) - O(et) - - The velocity component of the light-time corrected state - is the difference - - T_vel(et+lt) - O_vel(et) - - where T_vel and O_vel are, respectively, the velocities of - the target and observer relative to the solar system - barycenter at the epochs et+lt and 'et'. - - If correction for stellar aberration is requested, the target - position is rotated away from the solar system barycenter- - relative velocity vector of the observer. The rotation is - computed as in the reception case, but the sign of the - rotation angle is negated. - - The velocity component of the output state 'starg' is - not corrected for stellar aberration. - - Neither special nor general relativistic effects are accounted - for in the aberration corrections performed by this routine. - --Examples - - In the following code fragment, spkssb_c and spkapp_c are used - to display the position of Io (body 501) as seen from the - Voyager 2 spacecraft (Body -32) at a series of epochs. - - Normally, one would call the high-level reader spkezr_c to obtain - state vectors. The example below illustrates the interface - of this routine but is not intended as a recommendation on - how to use the CSPICE SPK subsystem. - - The use of integer ID codes is necessitated by the low-level - interface of this routine. - - - #include - #include "SpiceUsr.h" - - #define IO 501 - #define VG2 -32 - . - . - . - [ load kernels ] - . - . - . - while ( epoch <= end ) - { - spkssb_c ( VG2, epoch, "J2000", stvg2 ); - spkapp_c ( IO, epoch, "J2000", stvg2, "LT", stio, < ); - - recrad_c ( stio, &range, &ra, &dec ); - - printf ( "RA = %f, DEC = %f\n", ra*dpr_c(), dec*dpr_c() ); - - epoch += delta; - } - - --Restrictions - - 1) The kernel files to be used by spkapp_c must be loaded - (normally by the CSPICE kernel loader furnsh_c) before - this routine is called. - - 2) Unlike most other SPK state computation routines, this - routine requires that the input state be relative to an - inertial reference frame. Non-inertial frames are not - supported by this routine. - - 3) In a future version of this routine, the implementation - of the aberration corrections may be enhanced to improve - accuracy. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - I.M. Underwood (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 2.0.3, 19-MAY-2010 (BVS) - - Index lines now state that this routine is deprecated. - - -CSPICE Version 2.0.2, 08-JAN-2008 (NJB) - - The Abstract section of the header was updated to - indicate that this routine has been deprecated. - - -CSPICE Version 2.0.1, 13-OCT-2003 (EDW) - - Various minor header changes were made to improve clarity. - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - - Updated to handle aberration corrections for transmission - of radiation. Formerly, only the reception case was - supported. The header was revised and expanded to explain - the functionality of this routine in more detail. - - -CSPICE Version 1.0.0, 21-JUN-1999 (NJB) (HAN) (IMU) (WLT) - --Index_Entries - - DEPRECATED low-level aberration correction - DEPRECATED apparent state from spk file - DEPRECATED get apparent state - --& -*/ - -{ /* Begin spkapp_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkapp_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkapp_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkapp_c", abcorr ); - - - spkapp_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( doublereal * ) sobs, - ( char * ) abcorr, - ( doublereal * ) starg, - ( doublereal * ) lt, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(abcorr) ); - - - chkout_c ( "spkapp_c" ); - -} /* End spkapp_c */ diff --git a/ext/spice/src/cspice/spkaps.c b/ext/spice/src/cspice/spkaps.c deleted file mode 100644 index cebfd41455..0000000000 --- a/ext/spice/src/cspice/spkaps.c +++ /dev/null @@ -1,828 +0,0 @@ -/* spkaps.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKAPS ( SPK, apparent state ) */ -/* Subroutine */ int spkaps_(integer *targ, doublereal *et, char *ref, char * - abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, - doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - static logical xmit; - extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal - *, doublereal *, doublereal *, doublereal *), zzprscor_(char *, - logical *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal pcorr[3]; - static logical uselt; - extern logical failed_(void); - logical attblk[15]; - doublereal dpcorr[3], corvel[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen), spkltc_(integer *, doublereal *, char *, char *, - doublereal *, doublereal *, doublereal *, doublereal *, ftnlen, - ftnlen); - doublereal corpos[3]; - extern logical return_(void); - static logical usestl; - -/* $ Abstract */ - -/* Given the state and acceleration of an observer relative to the */ -/* solar system barycenter, return the state (position and velocity) */ -/* of a target body relative to the observer, optionally corrected */ -/* for light time and stellar aberration. All input and output */ -/* vectors are expressed relative to an inertial reference frame. */ - -/* This routine supersedes SPKAPP. */ - -/* SPICE users normally should call the high-level API routines */ -/* SPKEZR or SPKEZ rather than this routine. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* STOBS I State of the observer relative to the SSB. */ -/* ACCOBS I Acceleration of the observer relative to the SSB. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the input state STOBS, the input acceleration ACCOBS, */ -/* and the output state STARG are expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the header of SPKEZR for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* STOBS is the geometric state of the observer relative to */ -/* the solar system barycenter at ET. STOBS is expressed */ -/* relative to the reference frame designated by REF. */ -/* The target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* ACCOBS is the geometric acceleration of the observer */ -/* relative to the solar system barycenter at ET. This */ -/* is the derivative with respect to time of the */ -/* velocity portion of STOBS. ACCOBS is expressed */ -/* relative to the reference frame designated by REF. */ - -/* ACCOBS is used for computing stellar aberration */ -/* corrected velocity. If stellar aberration corrections */ -/* are not specified by ABCORR, ACCOBS is ignored; the */ -/* caller need not provide a valid input value in this */ -/* case. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the inertial reference frame designated by REF. */ -/* The first three components of STARG represent the x-, */ -/* y- and z-components of the target's position; last */ -/* three components form the corresponding velocity */ -/* vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for light time, then LT is the one-way light time */ -/* between the observer and the light time-corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If ABCORR calls for stellar aberration but not light */ -/* time corrections, the error SPICE(NOTSUPPORTED) is */ -/* signaled. */ - -/* 3) If ABCORR calls for relativistic light time corrections, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 5) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 6) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any such */ -/* kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ - -/* User applications normally will not need to call this routine */ -/* directly. However, this routine can improve run-time efficiency */ -/* in situations where many targets are observed from the same */ -/* location at the same time. In such cases, the state and */ -/* acceleration of the observer relative to the solar system */ -/* barycenter need be computed only once per look-up epoch. */ - -/* When apparent positions, rather than apparent states, are */ -/* required, consider using the high-level position-only API */ -/* routines */ - -/* SPKPOS */ -/* SPKEZP */ - -/* or the low-level, position-only analog of this routine */ - -/* SPKAPO */ - -/* In general, the position-only routines are more efficient. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time and stellar aberration corrections. */ -/* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ -/* compute subsequent states at intervals of 1 hour. For each */ -/* epoch, display the states, the one way light time between */ -/* target and observer, and the rate of change of the one way */ -/* light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ACC ( 3 ) */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STATE0 ( 6 ) */ -/* DOUBLE PRECISION STATE2 ( 6 ) */ -/* DOUBLE PRECISION STOBS ( 6 ) */ -/* DOUBLE PRECISION TDELTA */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time and stellar */ -/* C aberration ('LT+S') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ -/* C Before we can execute this computation, we'll need the */ -/* C geometric state and accleration of the observer relative */ -/* C to the solar system barycenter at ET, expressed */ -/* C relative to the J2000 reference frame. First find */ -/* C the state: */ -/* C */ -/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ -/* C */ -/* C Next compute the acceleration. We numerically */ -/* C differentiate the velocity using a quadratic */ -/* C approximation: */ -/* C */ -/* TDELTA = 1.D0 */ - -/* CALL SPKSSB ( 399, ET-TDELTA, 'J2000', STATE0 ) */ -/* CALL SPKSSB ( 399, ET+TDELTA, 'J2000', STATE2 ) */ - -/* CALL QDERIV ( 3, STATE0(4), STATE2(4), TDELTA, ACC ) */ -/* C */ -/* C Now compute the desired state vector: */ -/* C */ -/* CALL SPKAPS ( 301, ET, 'J2000', 'LT+S', */ -/* . STOBS, ACC, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291584.614 */ -/* J2000 y-position (km): -266693.406 */ -/* J2000 z-position (km): -76095.6532 */ -/* J2000 x-velocity (km/s): 0.643439157 */ -/* J2000 y-velocity (km/s): -0.666065874 */ -/* J2000 z-velocity (km/s): -0.301310063 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289256.459 */ -/* J2000 y-position (km): -269080.605 */ -/* J2000 z-position (km): -77177.3528 */ -/* J2000 x-velocity (km/s): 0.64997032 */ -/* J2000 y-velocity (km/s): -0.660148253 */ -/* J2000 z-velocity (km/s): -0.299630418 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286904.897 */ -/* J2000 y-position (km): -271446.417 */ -/* J2000 z-position (km): -78252.9655 */ -/* J2000 x-velocity (km/s): 0.656443883 */ -/* J2000 y-velocity (km/s): -0.654183552 */ -/* J2000 z-velocity (km/s): -0.297928533 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284530.133 */ -/* J2000 y-position (km): -273790.671 */ -/* J2000 z-position (km): -79322.4117 */ -/* J2000 x-velocity (km/s): 0.662859505 */ -/* J2000 y-velocity (km/s): -0.648172247 */ -/* J2000 z-velocity (km/s): -0.296204558 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282132.378 */ -/* J2000 y-position (km): -276113.202 */ -/* J2000 z-position (km): -80385.612 */ -/* J2000 x-velocity (km/s): 0.669216846 */ -/* J2000 y-velocity (km/s): -0.642114815 */ -/* J2000 z-velocity (km/s): -0.294458645 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) This routine should not be used to compute geometric states. */ -/* Instead, use SPKEZR, SPKEZ, or SPKGEO. SPKGEO, which is called */ -/* by SPKEZR and SPKEZ, introduces less round-off error when the */ -/* observer and target have a common center that is closer to */ -/* both objects than is the solar system barycenter. */ - -/* 2) The kernel files to be used by SPKAPS must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration-corrected state computation */ -/* low-level light time and stellar aberration correction */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKAPS", (ftnlen)6); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SPKAPS", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usestl = attblk[2]; - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SPKAPS", (ftnlen)6); - return 0; - } else if (attblk[5]) { - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SPKAPS", (ftnlen)6); - return 0; - } - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("SPKAPS", (ftnlen)6); - return 0; - } - -/* Get the state of the target relative to the observer, */ -/* optionally corrected for light time. */ - - spkltc_(targ, et, ref, abcorr, stobs, starg, lt, dlt, ref_len, abcorr_len) - ; - -/* If stellar aberration corrections are not needed, we're */ -/* already done. */ - - if (! usestl) { - chkout_("SPKAPS", (ftnlen)6); - return 0; - } - -/* Get the stellar aberration correction and its time derivative. */ - - zzstelab_(&xmit, accobs, &stobs[3], starg, pcorr, dpcorr); - -/* Adding the stellar aberration correction to the light */ -/* time-corrected target position yields the position corrected for */ -/* both light time and stellar aberration. */ - - vadd_(pcorr, starg, corpos); - vequ_(corpos, starg); - -/* Velocity is treated in an analogous manner. */ - - vadd_(dpcorr, &starg[3], corvel); - vequ_(corvel, &starg[3]); - chkout_("SPKAPS", (ftnlen)6); - return 0; -} /* spkaps_ */ - diff --git a/ext/spice/src/cspice/spkaps_c.c b/ext/spice/src/cspice/spkaps_c.c deleted file mode 100644 index 2f92ab500c..0000000000 --- a/ext/spice/src/cspice/spkaps_c.c +++ /dev/null @@ -1,595 +0,0 @@ -/* - --Procedure spkaps_c ( SPK, apparent state ) - --Abstract - - Given the state and acceleration of an observer relative to the - solar system barycenter, return the state (position and velocity) - of a target body relative to the observer, optionally corrected - for light time and stellar aberration. All input and output - vectors are expressed relative to an inertial reference frame. - - This routine supersedes spkapp_c. - - SPICE users normally should call the high-level API routines - spkezr_c or spkez_c rather than this routine. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #undef spkaps_c - - - void spkaps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs [6], - ConstSpiceDouble accobs[6], - SpiceDouble starg [6], - SpiceDouble * lt, - SpiceDouble * dlt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Observer epoch. - ref I Inertial reference frame of output state. - abcorr I Aberration correction flag. - stobs I State of the observer relative to the SSB. - accobs I Acceleration of the observer relative to the SSB. - starg O State of target. - lt O One way light time between observer and target. - dlt O Derivative of light time with respect to time. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a state vector whose position - component points from the observer to the target. - - et is the ephemeris time, expressed as seconds past - J2000 TDB, at which the state of the target body - relative to the observer is to be computed. `et' - refers to time at the observer's location. - - ref is the inertial reference frame with respect to which - the input state `stobs', the input acceleration `accobs', - and the output state `starg' are expressed. `ref' must be - recognized by the CSPICE Toolkit. The acceptable - frames are listed in the Frames Required Reading, as - well as in the CSPICE routine chgirf_. - - Case and blanks are not significant in the string - `ref'. - - abcorr indicates the aberration corrections to be applied to - the state of the target body to account for one-way - light time. See the discussion in the Particulars - section for recommendations on how to choose - aberration corrections. - - If `abcorr' includes the stellar aberration correction - symbol "+S", this flag is simply ignored. Aside from - the possible presence of this symbol, `abcorr' may be - any of the following: - - "NONE" Apply no correction. Return the - geometric state of the target body - relative to the observer. - - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at `et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the state of the target at the - moment it emitted photons arriving at - the observer at `et'. - - The light time correction involves - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - state of the target at the moment it - receives photons emitted from the - observer's location at `et'. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - `abcorr'. - - - stobs is the geometric state of the observer relative - to the solar system barycenter at `et'. The - target and observer define a state vector whose - position component points from the observer to the - target. `stobs' is expressed relative to the reference - frame designated by `ref'. - - accobs is the geometric acceleration of the observer - relative to the solar system barycenter at `et'. This - is the derivative with respect to time of the - velocity portion of STOBS. `accobs' is expressed - relative to the reference frame designated by `ref'. - - `accobs' is used for computing stellar aberration - corrected velocity. If stellar aberration corrections - are not specified by `abcorr', `accobs' is ignored; the - caller need not provide a valid input value in this - case. - --Detailed_Output - - starg is a Cartesian state vector representing the position - and velocity of the target body relative to the - specified observer. `starg' is corrected for the - specified aberration, and is expressed with respect - to the specified inertial reference frame. The first - three components of `starg' represent the x-, y- and - z-components of the target's position; last three - components form the corresponding velocity vector. - - The position component of `starg' points from the - observer's location at `et' to the aberration-corrected - location of the target. Note that the sense of the - position vector is independent of the direction of - radiation travel implied by the aberration - correction. - - Units are always km and km/sec. - - lt is the one-way light time between the observer and - target in seconds. If the target state is corrected - for light time, then `lt' is the one-way light time - between the observer and the light time-corrected - target location. - - dlt is the derivative with respect to barycentric - dynamical time of the one way light time between - target and observer: - - dlt = d(lt)/d(et) - - `dlt' can also be described as the rate of change of - one way light time. `dlt' is unitless, since `lt' and - `et' both have units of TDB seconds. - - If the observer and target are at the same position, - then `dlt' is set to zero. - --Parameters - - None. - --Exceptions - - 1) If the value of `abcorr' is not recognized, the error - the error will be diagnosed by routines in the call tree of this - routine. - - 2) If `abcorr' calls for stellar aberration but not light - time corrections, the error SPICE(NOTSUPPORTED) is - signaled. - - 3) If `abcorr' calls for relativistic light time corrections, the - error SPICE(NOTSUPPORTED) is signaled. - - 4) If the reference frame requested is not a recognized - inertial reference frame, the error SPICE(BADFRAME) - is signaled. - - 5) If the state of the target relative to the solar system - barycenter cannot be computed, the error will be diagnosed - by routines in the call tree of this routine. - - 6) If the observer and target are at the same position, - then `dlt' is set to zero. This situation could arise, - for example, when the observer is Mars and the target - is the Mars barycenter. - - 7) The error SPICE(EMPTYSTRING) is signaled if either of the input - strings `ref' or `abcorr' do not contain at least one character, - since such an input string cannot be converted to a Fortran-style - string. - - 8) The error SPICE(NULLPOINTER) is signaled if either of the input - string pointers `ref' or `abcorr' are null. - --Files - - This routine computes states using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. Application programs typically load - kernels once before this routine is called, for example during - program initialization; kernels need not be loaded repeatedly. - See the routine furnsh_c and the SPK and KERNEL Required Reading - for further information on loading (and unloading) kernels. - - If any of the ephemeris data used to compute `starg' are expressed - relative to a non-inertial frame in the SPK files providing those - data, additional kernels may be needed to enable the reference - frame transformations required to compute the state. Normally - these additional kernels are PCK files or frame kernels. Any - such kernels must already be loaded at the time this routine is - called. - --Particulars - - This routine supports higher-level SPK API routines that can - perform both light time and stellar aberration corrections. - - User applications normally will not need to call this routine - directly. However, this routine can improve run-time efficiency - in situations where many targets are observed from the same - location at the same time. In such cases, the state and - acceleration of the observer relative to the solar system - barycenter need be computed only once per look-up epoch. - - When apparent positions, rather than apparent states, are - required, consider using the high-level position-only API - routines - - spkpos_c - spkezp_c - - or the low-level, position-only analog of this routine - - spkapo_c - - In general, the position-only routines are more efficient. - - See the header of the routine spkezr_c for a detailed discussion - of aberration corrections. - --Examples - - 1) Look up a sequence of states of the Moon as seen from the - Earth. Use light time and stellar aberration corrections. - Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; - compute subsequent states at intervals of 1 hour. For each - epoch, display the states, the one way light time between - target and observer, and the rate of change of the one way - light time. - - Use the following meta-kernel to specify the kernels to - load: - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls' ) - - \begintext - - - The code example follows: - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - int main() - { - /. - Local constants - - The meta-kernel name shown here refers to a file whose contents - are those shown above. This file and the kernels it references - must exist in your current working directory. - ./ - #define META "example.mk" - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 5 - - /. - Local variables - ./ - SpiceDouble acc [3]; - SpiceDouble dlt; - SpiceDouble et; - SpiceDouble et0; - SpiceDouble lt; - SpiceDouble state [6]; - SpiceDouble state0 [6]; - SpiceDouble state2 [6]; - SpiceDouble stobs [6]; - SpiceDouble tdelta; - - SpiceInt dim; - SpiceInt i; - - /. - Load the SPK and LSK kernels via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the start time to seconds past J2000 TDB. - ./ - str2et_c ( "2000 JAN 1 12:00:00 TDB", &et0 ); - - /. - Step through a series of epochs, looking up a - state vector at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = et0 + i*STEP; - - /. - Look up a state vector at epoch ET using the - following inputs: - - Target: Moon (NAIF ID code 301) - Reference frame: J2000 - Aberration correction: Light time and stellar - aberration ('LT+S') - Observer: Earth (NAIF ID code 399) - - Before we can execute this computation, we'll need the - geometric state and acceleration of the observer relative to - the solar system barycenter at ET, expressed relative to the - J2000 reference frame. First find the state: - ./ - spkssb_c ( 399, et, "j2000", stobs ); - - /. - Next compute the acceleration. We numerically differentiate - the velocity using a quadratic approximation. - ./ - tdelta = 1.0; - - spkssb_c ( 399, et-tdelta, "j2000", state0 ); - spkssb_c ( 399, et+tdelta, "j2000", state2 ); - - /. - Note that qderiv_ is an f2c'd Fortran routine, so - we must pass in the dimension and time delta by - reference. - ./ - dim = 3; - qderiv_ ( &dim, state0+3, state2+3, &tdelta, acc ); - - /. - Now compute the desired state vector: - ./ - spkaps_c ( 301, et, "j2000", "lt+s", - stobs, acc, state, <, &dlt ); - - printf( "et = %20.6f\n", et ); - printf( "J2000 x-position (km): %20.8f\n", state[0] ); - printf( "J2000 y-position (km): %20.8f\n", state[1] ); - printf( "J2000 z-position (km): %20.8f\n", state[2] ); - printf( "J2000 x-velocity (km/s): %20.12f\n", state[3] ); - printf( "J2000 y-velocity (km/s): %20.12f\n", state[4] ); - printf( "J2000 z-velocity (km/s): %20.12f\n", state[5] ); - printf( "One-way light time (s): %20.12f\n", lt ); - printf( "Light time rate: %20.08e\n\n", dlt ); - } - return ( 0 ); - } - - - The output produced by this program will vary somewhat as - a function of the platform on which the program is built and - executed. On a PC/Linux/gcc platform, the following output - was produced: - - et = 0.000000 - J2000 x-position (km): -291584.61369498 - J2000 y-position (km): -266693.40583163 - J2000 z-position (km): -76095.65320924 - J2000 x-velocity (km/s): 0.643439157435 - J2000 y-velocity (km/s): -0.666065873657 - J2000 z-velocity (km/s): -0.301310063429 - One-way light time (s): 1.342310610325 - Light time rate: 1.07316909e-07 - - et = 3600.000000 - J2000 x-position (km): -289256.45942322 - J2000 y-position (km): -269080.60545908 - J2000 z-position (km): -77177.35277130 - J2000 x-velocity (km/s): 0.649970320169 - J2000 y-velocity (km/s): -0.660148253293 - J2000 z-velocity (km/s): -0.299630417907 - One-way light time (s): 1.342693954864 - Light time rate: 1.05652599e-07 - - et = 7200.000000 - J2000 x-position (km): -286904.89654240 - J2000 y-position (km): -271446.41676468 - J2000 z-position (km): -78252.96553362 - J2000 x-velocity (km/s): 0.656443883155 - J2000 y-velocity (km/s): -0.654183552046 - J2000 z-velocity (km/s): -0.297928532945 - One-way light time (s): 1.343071311734 - Light time rate: 1.03990457e-07 - - et = 10800.000000 - J2000 x-position (km): -284530.13302756 - J2000 y-position (km): -273790.67111559 - J2000 z-position (km): -79322.41170392 - J2000 x-velocity (km/s): 0.662859504730 - J2000 y-velocity (km/s): -0.648172246851 - J2000 z-velocity (km/s): -0.296204558469 - One-way light time (s): 1.343442689069 - Light time rate: 1.02330665e-07 - - et = 14400.000000 - J2000 x-position (km): -282132.37807792 - J2000 y-position (km): -276113.20159697 - J2000 z-position (km): -80385.61203056 - J2000 x-velocity (km/s): 0.669216846492 - J2000 y-velocity (km/s): -0.642114815280 - J2000 z-velocity (km/s): -0.294458644904 - One-way light time (s): 1.343808095656 - Light time rate: 1.00673404e-07 - - --Restrictions - - 1) This routine should not be used to compute geometric states. - Instead, use spkezr_c, spkez_c, or spkgeo_c. spkgeo_c, which is called - by spkezr_c and spkez_c, introduces less round-off error when the - observer and target have a common center that is closer to - both objects than is the solar system barycenter. - - 2) The kernel files to be used by spkaps_c must be loaded - (normally by the CSPICE kernel loader furnsh_c) before - this routine is called. - - 3) Unlike most other SPK state computation routines, this - routine requires that the output state be relative to an - inertial reference frame. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 11-JAN-2008 (NJB) - --Index_Entries - - low-level aberration-corrected state computation - low-level light time and stellar aberration correction - --& -*/ - -{ /* Begin spkaps_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkaps_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkaps_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkaps_c", abcorr ); - - - spkaps_ ( (integer *) &targ, - (doublereal *) &et, - (char *) ref, - (char *) abcorr, - (doublereal *) stobs, - (doublereal *) accobs, - (doublereal *) starg, - (doublereal *) lt, - (doublereal *) dlt, - (ftnlen ) strlen(ref), - (ftnlen ) strlen(abcorr) ); - - - - chkout_c ( "spkaps_c" ); - -} /* End spkaps_c */ diff --git a/ext/spice/src/cspice/spkbsr.c b/ext/spice/src/cspice/spkbsr.c deleted file mode 100644 index 0a0b2e7416..0000000000 --- a/ext/spice/src/cspice/spkbsr.c +++ /dev/null @@ -1,3259 +0,0 @@ -/* spkbsr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__50000 = 50000; -static integer c__1000 = 1000; -static integer c__5 = 5; -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKBSR ( S/P Kernel, Buffer segments for readers ) */ -/* Subroutine */ int spkbsr_0_(int n__, char *fname, integer *handle, integer - *body, doublereal *et, doublereal *descr, char *ident, logical *found, - ftnlen fname_len, ftnlen ident_len) -{ - /* Initialized data */ - - static integer nft = 0; - static integer nbt = 0; - static integer next = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer head; - static doublereal btlb[200]; - integer tail; - static doublereal btub[200]; - integer cost, i__, j; - extern /* Subroutine */ int dafgn_(char *, ftnlen); - integer cheap, p; - static integer btbeg[200]; - extern /* Subroutine */ int dafgs_(doublereal *); - static integer btbod[200]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer fthan[1000]; - char doing[15]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - char stack[15*2]; - static integer bthfs[200]; - extern doublereal dpmin_(void); - extern /* Subroutine */ int lnkan_(integer *, integer *); - extern doublereal dpmax_(void); - static integer btlfs[200]; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - static integer sthan[50000], btexp[200]; - static doublereal stdes[250000] /* was [5][50000] */; - extern integer lnktl_(integer *, integer *); - static integer ftnum[1000]; - extern /* Subroutine */ int daffna_(logical *), dafbbs_(integer *), - daffpa_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), cleard_(integer *, - doublereal *), dafcls_(integer *); - logical fndhan; - integer crflbg, bindex; - extern /* Subroutine */ int lnkila_(integer *, integer *, integer *); - static logical btchkp[200]; - integer findex; - extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen), lnkilb_( - integer *, integer *, integer *); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int lnkini_(integer *, integer *); - extern integer lnknfn_(integer *); - extern /* Subroutine */ int lnkfsl_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - extern integer intmax_(void); - static doublereal btprvd[1000] /* was [5][200] */; - static char btprvi[40*200]; - static integer btprvh[200]; - static char stidnt[40*50000]; - static integer btruex[200]; - char urgent[15]; - integer minexp; - extern integer lnkprv_(integer *, integer *); - integer nxtseg; - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - static integer stpool[100012] /* was [2][50006] */; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - char status[15]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - doublereal dcd[2]; - integer icd[6]; - logical fnd; - integer new__, top; - -/* $ Abstract */ - -/* Load and unload files for use by the readers. Buffer segments */ -/* for readers. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I SPKLEF */ -/* HANDLE I/O SPKLEF, SPKUEF, SPKSFS */ -/* BODY I SPKSFS */ -/* ET I SPKSFS */ -/* DESCR O SPKSFS */ -/* IDENT O SPKSFS */ - -/* $ Detailed_Input */ - -/* FNAME is the name of an SPK file to be loaded. */ - -/* HANDLE on input is the handle of an SPK file to be */ -/* unloaded. */ - -/* BODY is the NAIF integer code of an ephemeris object, */ -/* typically a solar system body. */ - -/* ET is a time, in seconds past the epoch J2000 TDB. */ - -/* $ Detailed_Output */ - -/* HANDLE on output is the handle of the S/P-kernel file */ -/* containing a located segment. */ - -/* DESCR is the descriptor of a located segment. */ - -/* IDENT is the identifier of a located segment. */ - -/* FOUND indicates whether a requested segment was found or not. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of ephemeris files that can be */ -/* loaded by SPKLEF at any given time for use by the */ -/* readers. */ - -/* BTSIZE is the maximum number of bodies whose segments can be */ -/* buffered by SPKSFS. */ - -/* STSIZE Maximum number of segments that can be buffered at any */ -/* given time by SPKSFS. */ - - -/* $ Exceptions */ - -/* 1) If SPKBSR is called directly, the error 'SPICE(BOGUSENTRY)' */ -/* is signaled. */ - -/* 2) See entry points SPKLEF, SPKUEF, and SPKSFS for exceptions */ -/* specific to them. */ - -/* $ Files */ - -/* S/P-kernel ephemeris files are indicated by filename before */ -/* loading (see SPKLEF) and handle after loading (all other places). */ - -/* $ Particulars */ - -/* SPKBSR serves as an umbrella, allowing data to be shared by its */ -/* entry points: */ - -/* SPKLEF Load ephemeris file. */ -/* SPKUEF Unload ephemeris file. */ -/* SPKSFS Select file and segment. */ - -/* Before a file can be read by the S/P-kernel readers, it must be */ -/* loaded by SPKLEF, which among other things, loads the file into */ -/* the DAF system. */ - -/* Up to FTSIZE files may be loaded for use simultaneously, and a */ -/* file only has to be loaded once to become a potential search */ -/* target for any number of subsequent reads. */ - -/* Once an SPK file has been loaded, it is assigned a file */ -/* handle, which is used to keep track of the file internally, */ -/* and which is used by the calling program to refer to the file */ -/* in all subsequent calls to SPK routines. */ - -/* A file may be removed from the list of files for potential */ -/* searching by unloading it via a call to SPKUEF. */ - -/* SPKSFS performs the search for segments within a file for the */ -/* S/P-kernel readers. It searches through last-loaded files first. */ -/* Within a single file, it searches through last-inserted segments */ -/* first, thus assuming that "newest data is best". */ - -/* Information on loaded files is used by SPKSFS to manage a buffer */ -/* of saved segment descriptors and identifiers to speed up access */ -/* time without having to necessarily perform file reads. */ - -/* $ Examples */ - -/* Suppose that ephemeris data for the Mars Global Surveyor */ -/* spacecraft relative to Mars are contained in three separate files: */ -/* PREDICT.SPK contains complete predict ephemeris data for several */ -/* successive orbits, and UPDATE_1.SPK and UPDATE_2.SPK contain two */ -/* separate updates to selected intervals within those orbits, based */ -/* on altimeter fits. */ - -/* In the following example, states of the spacecraft are computed */ -/* in two different ways: */ - -/* First, the predict file and one of the update files are both */ -/* loaded and states are requested for regular intervals within */ -/* the orbits. The update file is searched through first, and if no */ -/* data for the requested time is available, the predict file is */ -/* used. */ - -/* Then, the first update file is unloaded, the second update file */ -/* is loaded, and the same requests are made as above. */ - -/* Throughout the two searches, a table is written which contains */ -/* the state (position and velocity) of the spacecraft, and the */ -/* file from which the data came, if such data was found, and an */ -/* error message otherwise. */ - -/* It is assumed that the beginning and ending ephemeris times */ -/* (BEG_ET, END_ET) for the entire span have already been */ -/* initialized, along with the step-size for each measurement */ -/* (DELTA). The two routines WRITE_TABLE and WRITE_ERROR do not */ -/* exist in SPICELIB. */ - - -/* INTEGER PRED_HNDL */ -/* INTEGER UPD1_HNDL */ -/* INTEGER UPD2_HNDL */ -/* INTEGER HANDLE */ -/* INTEGER BODY */ -/* INTEGER CENTER */ - -/* DOUBLE PRECISION BEG_ET */ -/* DOUBLE PRECISION END_ET */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION DESCR ( 5 ) */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* CHARACTER*40 IDENT */ -/* CHARACTER*25 FNAME */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Load the predict file and the first update file. Since */ -/* C last-loaded files get searched first, we want to load the */ -/* C update file second. */ -/* C */ -/* CALL SPKLEF ( 'PREDICT.SPK', PRED_HNDL ) */ -/* CALL SPKLEF ( 'UPDATE_1.SPK', UPD1_HNDL ) */ - -/* C */ -/* C NAIF code for the Mars Global Surveyor spacecraft is -94. */ -/* C */ -/* BODY = -94 */ - -/* C */ -/* C Compute states for regular intervals between BEG_ET and */ -/* C END_ET. */ -/* C */ -/* ET = BEG_ET */ - -/* DO WHILE ( ET .LE. END_ET ) */ - -/* C */ -/* C Locate the applicable segment (handle and descriptor). */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* C */ -/* C Evaluate the state, get the name of the file from */ -/* C whence the data came, and write the results to the */ -/* C table. */ -/* C */ -/* CALL SPKPV ( HANDLE, DESCR, ET, 'J2000', STATE, */ -/* . CENTER ) */ - -/* CALL DAFHFN ( HANDLE, FNAME ) */ - -/* CALL WRITE_TABLE ( ET, STATE, FNAME ) */ - -/* ELSE */ - -/* CALL WRITE_ERROR ( ET ) */ - -/* END IF */ - -/* C */ -/* C The next time. */ -/* C */ -/* ET = ET + DELTA */ - -/* END DO */ - -/* C */ -/* C Unload the first update file, load the second, and do */ -/* C everything over again. Since the original file stays */ -/* C loaded, the update file once again gets searched first. */ -/* C */ -/* CALL SPKUEF ( UPD1_HNDL ) */ -/* CALL SPKLEF ( 'UPDATE_2.SPK', UPD2_HNDL ) */ - -/* ET = BEG_ET */ - -/* DO WHILE ( ET .LE. END_ET ) */ - -/* C */ -/* C Locate the applicable segment. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* C */ -/* C Evaluate the state, get the name of the file from */ -/* C whence the data came, and write the results to the */ -/* C table. */ -/* C */ -/* CALL SPKPV ( HANDLE, DESCR, ET, 'J2000', STATE, */ -/* . CENTER ) */ - -/* CALL DAFHFN ( HANDLE, FNAME ) */ - -/* CALL WRITE_TABLE ( ET, STATE, FNAME ) */ - -/* ELSE */ - -/* CALL WRITE_ERROR ( ET ) */ - -/* END IF */ - -/* C */ -/* C The next time. */ -/* C */ -/* ET = ET + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) If Fortran I/O errors occur while searching a loaded SPK */ -/* file, the internal state of this suite of routines may */ -/* be corrupted. It may be possible to correct the state */ -/* by unloading the pertinent SPK files and then re-loading */ -/* them. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.2.0, 07-APR-2010 (NJB) */ - -/* Increased segment table buffer size to 50000 entries. */ - -/* - SPICELIB Version 5.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED calls in entry points SPKUEF and SPKSFS. */ - -/* Increased segment table buffer size to 30000 entries. */ - -/* - SPICELIB Version 5.0.0, 21-FEB-2003 (NJB) */ - -/* Increased segment table buffer size to 10000 entries. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single SPK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) When a already loaded kernel is re-opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 4) The load routine SPKLEF now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby */ -/* avoiding arithmetic overflow. */ - -/* 5) The unload routine SPKUEF now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* 6) In SPKSFS, DAF calls are followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 7) In SPKSFS, a subscript bound violation in a loop */ -/* termination test was corrected. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The body table size has been increased to 200 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* - SPICELIB Version 3.0.0, 14-AUG-1995 (WLT) */ - -/* An interim fix to a bug in SPKBSR was made. The parameters */ -/* STSIZE and BTSIZE were increase to be much larger than before */ -/* (from 100 and 20 to 2000 and 40 respectively). This should */ -/* keep the boundary errors experienced by Cassini users from */ -/* occurring again. Version 4.0.0 with a real fix to the */ -/* boundary problem should be installed in SPICELIB by */ -/* October 1995 */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) When loading a file, SPKLEF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that SPKLEF and SPKUEF clean up the body */ -/* tables after a file is unloaded was fixed. */ - -/* 3) Variable declarations were added to the example program */ -/* so that it can now be compiled. */ - -/* 4) A cut and paste error in the description of the segment */ -/* table was corrected. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 9-SEP-1991 (HAN) */ - -/* The declaraion of the variable STATE in the Examples section */ -/* was changed from a 3 dimensional vector to a 6 dimensional */ -/* vector, and the term state was specified to be the position */ -/* and velocity of a body relative to another body. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* buffer spk segments for readers */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED calls in entry points SPKUEF and SPKSFS. */ - -/* Increased segment table buffer size to 30000 entries. */ - -/* - SPICELIB Version 5.0.0, 21-FEB-2003 (NJB) */ - -/* Increased segment table buffer size to 10000 entries. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single SPK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) When a already loaded kernel is re-opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 4) The load routine SPKLEF now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby */ -/* avoiding arithmetic overflow. */ - -/* 5) The unload routine SPKUEF now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* 6) In SPKSFS, DAF calls are followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 7) In SPKSFS, a subscript bound violation in a loop */ -/* termination test was corrected. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. For each body, the associated re-use */ -/* interval marks the time interval containing the previous */ -/* request time for which the previously returned segment provides */ -/* the highest-priority data available. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The body table size has been increased to 200 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* In order to simplify the source code, the in-line singly */ -/* linked list implementation of the segment table has been */ -/* replaced by an implementation relying on the SPICELIB */ -/* doubly linked list routines. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Constants used in the doubly linked list structure: */ - - -/* Local variables */ - - -/* The file table contains the handle and file number of each file */ -/* that has been loaded for use with the SPK readers. File */ -/* numbers begin at one, and are incremented until they reach a */ -/* value of INTMAX() - 1, at which point they are mapped to the */ -/* range 1:NFT, where NFT is the number of loaded SPK files. */ - -/* (A file number is similar to a file handle, but it is assigned */ -/* and used exclusively by this module. The purpose of file numbers */ -/* is to keep track of the order in which files are loaded and the */ -/* order in which they are searched.) */ - -/* All names begin with FT. */ - -/* HAN Handle */ -/* NUM File number */ - -/* NFT is the number of files that have been loaded. NEXT is */ -/* incremented whenever a new file is loaded to give the file */ -/* number of the file. FINDEX is the index of whatever file is */ -/* of current interest at any given time. */ - -/* New files are added at the end of the table. As files are */ -/* removed, succeeding files are moved forward to take up the */ -/* slack. This keeps the table ordered by file number. */ - - -/* The body table contains the beginning of the list of the stored */ -/* segments for each body, and the expense at which that list */ -/* was constructed. (The expense of a body list is the number of */ -/* segment descriptors examined during the construction of the list.) */ -/* It also contains the highest and lowest file numbers searched */ -/* during the construction of the list. */ - -/* For each body, the time bounds of the "re-use interval" of the */ -/* last segment found are stored. This interval is the maximal */ -/* interval containing the epoch of the last request for data for */ -/* this body, such that the interval is not masked by higher-priority */ -/* segments. The handle, segment descriptor, and segment identifier */ -/* returned on the last request are also stored. */ - -/* All names begin with BT. */ - -/* BOD Body */ -/* EXP Expense */ -/* HFS Highest file (number) searched */ -/* LFS Lowest file (number) searched */ -/* BEG Beginning of segment list */ -/* LB Lower bound of the re-use interval of */ -/* previous segment returned. */ -/* UB Upper bound of the re-use interval of */ -/* previous segment returned. */ -/* PRVD Previous descriptor returned. */ -/* PRVI Previous segment identifier returned. */ -/* PRVH Previous handle returned. */ -/* CHKP Logical indicating that previous segment should */ -/* be checked to see whether it satisfies a request. */ -/* RUEX Expense of the re-use interval. */ - -/* NBT is the number of bodies for which segments are currently */ -/* being stored in the table. BINDEX is the index of whatever */ -/* body is of current interest at any given time. */ - -/* New bodies are added at the end of the table. As bodies are */ -/* removed, the last body is moved forward to take up the slack. */ -/* This keeps the entries in the table contiguous. */ - - -/* The segment table contains the handle, descriptor, and identifier */ -/* for each segment that has been found so far. */ - -/* The segment table is implemented as a set of arrays indexed by */ -/* a SPICE doubly linked list structure. For each body in the */ -/* body table, there is a segment table list; each node of a list */ -/* points to data associated with a segment. In each list, the head */ -/* node corresponds to the highest-priority segment in that list, */ -/* and segment priority decreases in the forward direction. */ - -/* All names begin with ST. */ - -/* POOL Doubly linked list pool. */ -/* HAN Handle */ -/* DES Descriptor */ -/* IDNT Identifier */ - -/* New segments are added to the front or end of a body list */ -/* as appropriate, according to the rules spelled out under */ -/* entry point SPKSFS. */ - - -/* Other stuff */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (descr) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_spklef; - case 2: goto L_spkuef; - case 3: goto L_spksfs; - } - - -/* Nobody has any business calling SPKBSR directly. */ - - if (return_()) { - return 0; - } - chkin_("SPKBSR", (ftnlen)6); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("SPKBSR", (ftnlen)6); - return 0; -/* $Procedure SPKLEF ( S/P Kernel, Load ephemeris file ) */ - -L_spklef: -/* $ Abstract */ - -/* Load an ephemeris file for use by the readers. Return that */ -/* file's handle, to be used by other SPK routines to refer to the */ -/* file. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of the file to be loaded. */ -/* HANDLE O Loaded file's handle. */ -/* FTSIZE P Maximum number of loaded SPK files. */ - -/* $ Detailed_Input */ - -/* FNAME Character name of the file to be loaded. */ - -/* $ Detailed_Output */ - -/* HANDLE Integer handle assigned to the file upon loading. */ -/* Almost every other SPK routine will subsequently use */ -/* this number to refer to the file. */ - -/* $ Parameters */ - -/* FTSIZE is the maximum number of SPK files that may */ -/* be loaded simultaneously under any circumstances. */ -/* FTSIZE is currently set to match the maximum number */ -/* of DAF files that may be loaded simultaneously. */ - -/* $ Exceptions */ - -/* 1) If an attempt is made to open more DAF files than is specified */ -/* by the parameter FTSIZE in DAFAH, an error is signaled by a */ -/* routine in the call tree of this routine. */ - -/* 2) If an attempt is made to load more files than is specified */ -/* by the local paramater FTSIZE, and if the DAF system has */ -/* room to load another file, the error SPICE(SPKFILETABLEFULL) */ -/* signaled. The current setting of FTSIZE does not allow this */ -/* situation to arise: the DAF system will trap the error */ -/* before this routine has the chance. */ - -/* $ Files */ - -/* A file specified by FNAME, to be loaded. The file is assigned a */ -/* handle by SPKLEF, which will be used by most other routines to */ -/* refer to it. */ - -/* $ Particulars */ - -/* If there is room for a new file in the file table, SPKLEF creates */ -/* an entry for it and loads the file for reading using DAFOPR. */ - -/* $ Examples */ - -/* See the Example above, in SPKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When an already loaded kernel is opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 2) This routine now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby avoiding */ -/* arithmetic overflow. The numbers in the file table */ -/* are replaced with consecutive integers in the range */ -/* 1 : NFT, such that the ordering of the numbers is not */ -/* changed. The HFS and LFS arrays are updated accordingly. */ - -/* Also, the flags indicating validity of the re-use intervals */ -/* are set to .FALSE. here. */ - - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) When loading a file, SPKLEF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that SPKLEF and SPKUEF clean up the body */ -/* tables after a file is unloaded was fixed. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* load spk ephemeris file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a loaded kernel is opened with DAFOPR, */ -/* it now has its link count reset to 1 via a call to */ -/* DAFCLS. */ - -/* 2) This routine now resets all file numbers when */ -/* the next file number reaches INTMAX()-1, thereby avoiding */ -/* arithmetic overflow. The numbers in the file table */ -/* are replaced with consecutive integers in the range */ -/* 1 : NFT, such that the ordering of the numbers is not */ -/* changed. The HFS and LFS arrays are updated accordingly. */ -/* HFS and LFS entries that have gone stale are set to zero. */ - -/* Also, the flags indicating validity of the re-use intervals */ -/* are set to .FALSE. here. */ - - -/* - SPICELIB Version 3.0.0, 14-AUG-1995 (WLT) */ - -/* An interim fix to a bug in SPKBSR was made. The parameters */ -/* STSIZE and BTSIZE were increase to be much larger than before */ -/* (from 100 and 20 to 2000 and 40 respectively). This should */ -/* keep the boundary errors experienced by Cassini users from */ -/* occurring again. Version 4.0.0 with a real fix to the */ -/* boundary problem should be installed in SPICELIB by */ -/* October 1995 */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) When loading a file, SPKLEF now checks if the file table is */ -/* full only after determining that the file is not currently */ -/* loaded. Previously, if the file table was full and an attempt */ -/* was made to reload a file, an error was signaled. A new */ -/* exception was added as a result of this change. */ - -/* 2) A bug in the way that SPKLEF and SPKUEF clean up the body */ -/* tables after a file is unloaded was fixed. */ - -/* If as the result of loading a file that was previously loaded, */ -/* there are no more segments buffered for a particular body, */ -/* the counter variable for the bodies is no longer incremented. */ - -/* The following code fragment changed: */ - -/* IF ( BTBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NBT = NBT - 1 */ - -/* END IF */ - -/* I = I + 1 */ - -/* This is the fix: */ - -/* IF ( BTBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NBT = NBT - 1 */ - -/* ELSE */ - -/* I = I + 1 */ - -/* END IF */ - -/* - Beta Version 1.1.0, 25-JAN-1990 (IMU) */ - -/* If a file that has already been loaded is loaded a second */ -/* (or third or fourth) time, it should be removed from the */ -/* file table, and any segments from the file must be removed */ -/* from the segment lists, just as if the user had unloaded */ -/* the file before loading it again. This means that a single */ -/* file cannot occur more than once in the file table. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKLEF", (ftnlen)6); - } - -/* Any time we load a file, there is a possibility that the */ -/* re-use intervals are invalid because they're been superseded */ -/* by higher-priority data. Since we're not going to examine */ -/* the loaded file, simply indicate that all of the re-use */ -/* intervals are invalid. */ - - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - btchkp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("btchkp", - i__2, "spkbsr_", (ftnlen)1050)] = FALSE_; - } - -/* Nothing works unless at least one file has been loaded, so */ -/* this is as good a place as any to initialize the segment table */ -/* linked list pool, whenever the body table is empty. */ - - if (nbt == 0) { - lnkini_(&c__50000, stpool); - } - -/* To load a new file, first try to open it for reading. */ - - dafopr_(fname, handle, fname_len); - if (failed_()) { - chkout_("SPKLEF", (ftnlen)6); - return 0; - } - -/* Determine if the file is already in the table. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex > 0) { - -/* The last call we made to DAFOPR added another DAF link to */ -/* the SPK file. Remove this link. */ - - dafcls_(handle); - -/* Remove the file from the file table and remove its segments */ -/* from the segment table. If the segment list for a body */ -/* becomes empty, remove that body from the body table. */ - - --nft; - i__1 = nft; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan" - , i__2, "spkbsr_", (ftnlen)1092)] = fthan[(i__3 = i__) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "spkbsr_" - , (ftnlen)1092)]; - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum" - , i__2, "spkbsr_", (ftnlen)1093)] = ftnum[(i__3 = i__) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftnum", i__3, "spkbsr_" - , (ftnlen)1093)]; - } - i__ = 1; - while(i__ <= nbt) { - p = btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)1100)]; - while(p > 0) { - -/* Find the successor of P, if any. */ - - nxtseg = lnknxt_(&p, stpool); - if (sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "spkbsr_", (ftnlen)1108)] == *handle) { - -/* The segment corresponding to node P came from */ -/* the file we're unloading. Delete the node for */ -/* P from the segment list for body I; if P happens */ -/* to be the head node for body I's segment list, */ -/* make the successor of P the head of the list. */ - - lnkfsl_(&p, &p, stpool); - if (p == btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 - : s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)1118)]) - { - btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)1119) - ] = nxtseg; - } - } - -/* Update P. */ - - p = nxtseg; - } - -/* If the list for this body is now empty, shorten the current */ -/* table by one: put all the entries for the last body in the */ -/* table into the space occupied by the one we've deleted. */ - - if (btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)1135)] <= 0) { - -/* Because all of the re-use intervals are invalid, we need */ -/* not copy the saved items associated with them. The */ -/* items not copied are */ - -/* BTCHKP */ -/* BTLB */ -/* BTPRVD */ -/* BTPRVH */ -/* BTPRVI */ -/* BTRUEX */ -/* BTUB */ - - btbod[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbod", i__1, "spkbsr_", (ftnlen)1149)] = btbod[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btbod", i__2, "spkbsr_", (ftnlen)1149)]; - btexp[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "spkbsr_", (ftnlen)1150)] = btexp[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "spkbsr_", (ftnlen)1150)]; - bthfs[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "spkbsr_", (ftnlen)1151)] = bthfs[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "spkbsr_", (ftnlen)1151)]; - btlfs[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "spkbsr_", (ftnlen)1152)] = btlfs[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "spkbsr_", (ftnlen)1152)]; - btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)1153)] = btbeg[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btbeg", i__2, "spkbsr_", (ftnlen)1153)]; - --nbt; - } else { - ++i__; - } - } - } else { - -/* This is a new file. Make sure that there are unused slots */ -/* in the file table. */ - - if (nft == 1000) { - -/* This error case can occur only if FTSIZE is larger than */ -/* the maximum number of open DAF files. Currently FTSIZE */ -/* is equal to this limit. */ - - dafcls_(handle); - setmsg_("The internal file table is already full, with # entries." - , (ftnlen)56); - errint_("#", &c__1000, (ftnlen)1); - sigerr_("SPICE(SPKFILETABLEFULL)", (ftnlen)23); - chkout_("SPKLEF", (ftnlen)6); - return 0; - } - } - -/* Determine the next file number. Note that later code assumes */ -/* that the file number can be incremented by 1, so we can't allow */ -/* the file number to reach INTMAX(). */ - - if (next < intmax_() - 1) { - ++next; - } else { - -/* The user is to be congratulated: we've run out of file */ -/* numbers. */ - -/* Re-set the valid file numbers so they lie in the range 1:NFT, */ -/* with the Ith file in the file table having file number I. */ -/* First update the LFS and HFS components of the body table */ -/* according to this mapping. */ - -/* Set any body table entries that are lower than FTNUM(1) to */ -/* zero. */ - - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Re-map the HFS table for the Ith body. */ - - j = isrchi_(&bthfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("bthfs", i__2, "spkbsr_", (ftnlen)1215)], &nft, - ftnum); - if (j > 0) { - -/* The highest file searched for body I is the Jth file */ -/* in the file table. */ - - bthfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "spkbsr_", (ftnlen)1222)] = j; - } else { - -/* The highest file searched for body I is not in the file */ -/* table. This occurs when the highest file searched has */ -/* been unloaded. Note that this assigment makes all files */ -/* appear to be "new" when a lookup for body I is performed. */ - - bthfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "spkbsr_", (ftnlen)1231)] = 0; - } - -/* Re-map the LFS table for the Ith body. */ - - j = isrchi_(&btlfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btlfs", i__2, "spkbsr_", (ftnlen)1238)], &nft, - ftnum); - if (j > 0) { - -/* The lowest file searched for body I is the Jth file */ -/* in the file table. */ - - btlfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "spkbsr_", (ftnlen)1245)] = j; - } else { - -/* The lowest file searched for body I is not in the file */ -/* table. This occurs when the lowest file searched has */ -/* been unloaded. Force reconstruction of the list by */ -/* making all files "new." */ - - btlfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "spkbsr_", (ftnlen)1254)] = 0; - bthfs[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "spkbsr_", (ftnlen)1255)] = 0; - } - } - -/* Re-map the file number table itself. */ - - i__1 = nft; - for (i__ = 1; i__ <= i__1; ++i__) { - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum" - , i__2, "spkbsr_", (ftnlen)1266)] = i__; - } - -/* Assign a new file number. */ - - next = nft + 1; - } - ++nft; - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "spkbsr_", (ftnlen)1279)] = *handle; - ftnum[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftnum", i__1, - "spkbsr_", (ftnlen)1280)] = next; - chkout_("SPKLEF", (ftnlen)6); - return 0; -/* $Procedure SPKUEF ( S/P Kernel, Unload ephemeris file ) */ - -L_spkuef: -/* $ Abstract */ - -/* Unload an ephemeris file so that it will no longer be searched by */ -/* the readers. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file to be unloaded */ - -/* $ Detailed_Input */ - -/* HANDLE Integer handle assigned to the file upon loading. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Unloading a file that has not been loaded is a no-op. */ -/* No error is signaled. */ - -/* $ Files */ - -/* The file referred to by HANDLE is unloaded. */ - -/* $ Particulars */ - -/* A file is removed from consideration by the readers by a call to */ -/* SPKUEF. */ - -/* If the file specified by HANDLE is not currently loaded in the */ -/* SPK system, no action is taken. */ - -/* $ Examples */ - -/* See the Example above, in SPKBSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) This routine now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* Also, the flags indicating validity of those re-use intervals */ -/* whose data comes from the unloaded file are set to .FALSE. */ - - -/* - SPICELIB Version 3.0.0, 14-AUG-1995 (WLT) */ - -/* An interim fix to a bug in SPKBSR was made. The parameters */ -/* STSIZE and BTSIZE were increase to be much larger than before */ -/* (from 100 and 20 to 2000 and 40 respectively). This should */ -/* keep the boundary errors experienced by Cassini users from */ -/* occurring again. Version 4.0.0 with a real fix to the */ -/* boundary problem should be installed in SPICELIB by */ -/* October 1995 */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) A bug in the way that SPKLEF and SPKUEF clean up the body */ -/* tables after a file is unloaded was fixed. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 2-MAY-1990 (RET) */ - -/* If unloading a file causes all segments in the list for a */ -/* body to go away, delete that body from the body list. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* unload spk ephemeris file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) This routine now calls RETURN() on entry and */ -/* returns if so directed. */ - -/* Also, the flags indicating validity of those re-use intervals */ -/* whose data comes from the unloaded file are set to .FALSE. */ - -/* - SPICELIB Version 2.0.0, 25-NOV-1992 (JML) */ - -/* 1) A bug in the way that SPKLEF and SPKUEF clean up the body */ -/* tables after a file is unloaded was fixed. */ - -/* If as the result of unloading a file there are no more */ -/* segments buffered for a particular body, the counter variable */ -/* for the bodies is no longer incremented. */ - -/* The following code fragment changed: */ - -/* IF ( BTBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NBT = NBT - 1 */ - -/* END IF */ - -/* I = I + 1 */ - -/* This is the fix: */ - -/* IF ( BTBEG( I ) .EQ. 0 ) THEN */ - -/* . */ -/* . */ -/* . */ -/* NBT = NBT - 1 */ - -/* ELSE */ - -/* I = I + 1 */ - -/* END IF */ - -/* - SPICELIB Version 1.1.0, 2-MAY-1990 (RET) */ - -/* If unloading a file causes all segments in the list for a */ -/* body to go away, delete that body from the body list. */ - -/* - Beta Version 1.1.0, 25-JAN-1990 (IMU) */ - -/* When unloading a file, close it. */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("SPKUEF", (ftnlen)6); - -/* All of the stored segments from the file must be removed */ -/* from the segment table (by returning the corresponding nodes */ -/* to the segment table pool.) */ - -/* Don't do anything if the given handle is not in the file table. */ - - findex = isrchi_(handle, &nft, fthan); - if (findex == 0) { - chkout_("SPKUEF", (ftnlen)6); - return 0; - } - -/* First get rid of the entry in the file table. Close the file */ -/* before wiping out the handle. */ - - dafcls_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "spkbsr_", (ftnlen)1535)]); - --nft; - i__1 = nft; - for (i__ = findex; i__ <= i__1; ++i__) { - fthan[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan", - i__2, "spkbsr_", (ftnlen)1540)] = fthan[(i__3 = i__) < 1000 && - 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "spkbsr_", (ftnlen) - 1540)]; - ftnum[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "spkbsr_", (ftnlen)1541)] = ftnum[(i__3 = i__) < 1000 && - 0 <= i__3 ? i__3 : s_rnge("ftnum", i__3, "spkbsr_", (ftnlen) - 1541)]; - } - -/* Check each body list individually. Note that the first node */ -/* on each list, having no predecessor, must be handled specially. */ - - i__ = 1; - while(i__ <= nbt) { - p = btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btbeg", - i__1, "spkbsr_", (ftnlen)1552)]; - while(p > 0) { - nxtseg = lnknxt_(&p, stpool); - if (sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "spkbsr_", (ftnlen)1558)] == *handle) { - if (p == btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)1560)]) { - btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)1561)] = nxtseg; - } - lnkfsl_(&p, &p, stpool); - } - p = nxtseg; - } - -/* If we happened to get rid of all of the segments for this */ -/* body, then the body should be deleted from the table: shift */ -/* all entries for the body at the end of the table into the */ -/* space occupied by the deleted body. */ - - if (btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btbeg", - i__1, "spkbsr_", (ftnlen)1578)] <= 0) { - if (i__ != nbt) { - btbod[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbod", i__1, "spkbsr_", (ftnlen)1582)] = btbod[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btbod", i__2, "spkbsr_", (ftnlen)1582)]; - btexp[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "spkbsr_", (ftnlen)1583)] = btexp[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "spkbsr_", (ftnlen)1583)]; - bthfs[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "spkbsr_", (ftnlen)1584)] = bthfs[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "bthfs", i__2, "spkbsr_", (ftnlen)1584)]; - btlfs[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "spkbsr_", (ftnlen)1585)] = btlfs[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btlfs", i__2, "spkbsr_", (ftnlen)1585)]; - btbeg[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)1586)] = btbeg[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btbeg", i__2, "spkbsr_", (ftnlen)1586)]; - btlb[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btlb", i__1, "spkbsr_", (ftnlen)1587)] = btlb[(i__2 = - nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("btlb", - i__2, "spkbsr_", (ftnlen)1587)]; - btub[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btub", i__1, "spkbsr_", (ftnlen)1588)] = btub[(i__2 = - nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("btub", - i__2, "spkbsr_", (ftnlen)1588)]; - btprvh[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btprvh", i__1, "spkbsr_", (ftnlen)1589)] = btprvh[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btprvh", i__2, "spkbsr_", (ftnlen)1589)]; - s_copy(btprvi + ((i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btprvi", i__1, "spkbsr_", (ftnlen)1590)) * 40, - btprvi + ((i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 - : s_rnge("btprvi", i__2, "spkbsr_", (ftnlen)1590)) * - 40, (ftnlen)40, (ftnlen)40); - btchkp[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "spkbsr_", (ftnlen)1591)] = btchkp[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btchkp", i__2, "spkbsr_", (ftnlen)1591)]; - btruex[(i__1 = i__ - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "spkbsr_", (ftnlen)1592)] = btruex[( - i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btruex", i__2, "spkbsr_", (ftnlen)1592)]; - moved_(&btprvd[(i__1 = nbt * 5 - 5) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("btprvd", i__1, "spkbsr_", (ftnlen)1594) - ], &c__5, &btprvd[(i__2 = i__ * 5 - 5) < 1000 && 0 <= - i__2 ? i__2 : s_rnge("btprvd", i__2, "spkbsr_", ( - ftnlen)1594)]); - } - --nbt; - } else { - ++i__; - } - } - -/* Any time we unload a file, we may be removing the file */ -/* providing data for the re-use interval for one or more bodies. */ -/* For each body, if the handle associated with the re-use interval */ -/* happens to be that of the file we're unloading, indicate */ -/* that the re-use interval is invalid. */ - - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - if (btchkp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("btch" - "kp", i__2, "spkbsr_", (ftnlen)1617)]) { - if (btprvh[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btprvh", i__2, "spkbsr_", (ftnlen)1619)] == *handle) { - btchkp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btchkp", i__2, "spkbsr_", (ftnlen)1620)] = FALSE_; - } - } - } - chkout_("SPKUEF", (ftnlen)6); - return 0; -/* $Procedure SPKSFS ( S/P Kernel, Select file and segment ) */ - -L_spksfs: -/* $ Abstract */ - -/* Search through loaded files to find the first segment applicable */ -/* to the body and time specified. Buffer searched segments in the */ -/* process, to attempt to avoid re-reading files. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ - -/* INTEGER BODY */ -/* DOUBLE PRECISION ET */ -/* INTEGER HANDLE */ -/* DOUBLE PRECISION DESCR ( * ) */ -/* CHARACTER*(*) IDENT */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BODY I Body ID. */ -/* ET I Ephemeris time. */ -/* HANDLE O Handle of file containing the applicable segment. */ -/* DESCR O Descriptor of the applicable segment. */ -/* IDENT O Identifier of the applicable segment. */ -/* FOUND O Indicates whether or not a segment was found. */ - -/* $ Detailed_Input */ - -/* BODY is the NAIF integer code of an ephemeris object, */ -/* typically a solar system body. */ - -/* ET is a time, in seconds past the epoch J2000 TDB. */ - -/* $ Detailed_Output */ - -/* HANDLE on output is the handle of the S/P-kernel file */ -/* containing a located segment. */ - -/* DESCR is the descriptor of a located segment. */ - -/* IDENT is the identifier of a located segment. */ - -/* FOUND indicates whether a requested segment was found or not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an attempt is made to call SPKSFS when there aren't any */ -/* files loaded, the error SPICE(NOLOADEDFILES) is signaled. */ - -/* $ Files */ - -/* All files loaded by SPKLEF are potential search targets for */ -/* SPKSFS. */ - -/* $ Particulars */ - -/* This routine finds the highest-priority segment, in any loaded */ -/* SPK file, such that the segment provides data for the specified */ -/* body and epoch. */ - -/* $ Examples */ - -/* See the Example above, in SPKBSR. */ - -/* $ Restrictions */ - -/* 1) If Fortran I/O errors occur while searching a loaded SPK */ -/* file, the internal state of this suite of routines may */ -/* be corrupted. It may be possible to correct the state */ -/* by unloading the pertinent SPK files and then re-loading */ -/* them. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single SPK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) DAF calls are now followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 4) A subscript bound violation in a loop termination test */ -/* was corrected. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The body table size has been increased to 200 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - - -/* - SPICELIB Version 3.0.0, 14-AUG-1995 (WLT) */ - -/* An interim fix to a bug in SPKBSR was made. The parameters */ -/* STSIZE and BTSIZE were increase to be much larger than before */ -/* (from 100 and 20 to 2000 and 40 respectively). This should */ -/* keep the boundary errors experienced by Cassini users from */ -/* occurring again. Version 4.0.0 with a real fix to the */ -/* boundary problem should be installed in SPICELIB by */ -/* October 1995 */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 2-MAY-1990 (RET) */ - -/* New error detected. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* select spk file and segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MOVED call. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Bug fixes: */ - -/* 1) When a segment list is freed because the entire list */ -/* is contributed by a single SPK file, and the list is */ -/* too large to be buffered, the corresponding body table */ -/* pointer is now set to null. */ - -/* 2) An algorithm change has eliminated a bug caused by not */ -/* updating the current body index when body table entries */ -/* having empty segment lists were compressed out of the */ -/* body table. Previously the body table pointer BINDEX */ -/* could go stale after the compression. */ - -/* 3) DAF calls are now followed by tests of FAILED() */ -/* in order to ensure that the main state loop terminates. */ - -/* 4) A subscript bound violation in a loop termination test */ -/* was corrected. The loop is located in the */ -/* 'SEARCH W/O BUFFERING' block; it finds the start of a */ -/* partial list that is to be freed. */ - -/* The "re-use interval" feature was introduced to improve speed */ -/* in the case where repeated, consecutive requests are satisified */ -/* by the same segment. */ - -/* The segment list cost algorithm was modified slightly: */ -/* the contribution of a file search to the cost of a list */ -/* is included only when the file search is completed. The */ -/* cost of finding the re-use interval is accounted for when */ -/* unbuffered searches are required. */ - -/* The file table size has been increased to 1000, in order */ -/* to take advantage of the DAF system's new ability to load */ -/* 1000 files. */ - -/* The body table size has been increased to 200 in order to */ -/* decrease the chance of thrashing due to swapping segment */ -/* lists for different bodies. */ - -/* Various small updates and corrections were made to the */ -/* comments throughout the file. */ - -/* In order to simplify the source code, the in-line singly */ -/* linked list implementation of the segment table has been */ -/* replaced by an implementation relying on the SPICELIB */ -/* doubly linked list routines. */ - -/* - SPICELIB Version 1.1.0, 2-MAY-1990 (RET) */ - -/* If an attempt is made to call SPKSFS when there are no files */ -/* loaded, an error is now signaled. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKSFS", (ftnlen)6); - } - -/* Assume the segment is not found, until it actually is. */ - - *found = FALSE_; - -/* Buffering segments involves maintaining three tables: the */ -/* file table, the body table, and the segment table. The routine */ -/* is broken down into various tasks, described below, which */ -/* perform these manipulations. A description of the components */ -/* of each table is provided in the declarations section of SPKBSR. */ - -/* There must be at least ONE file loaded. */ - - if (nft == 0) { - setmsg_("At least one SPK file needs to be loaded by SPKLEF before b" - "eginning a search.", (ftnlen)77); - sigerr_("SPICE(NOLOADEDFILES)", (ftnlen)20); - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - -/* The stack of suspended tasks is empty. */ - - top = 0; - -/* In the following loop, we will try to simplify things by */ -/* doing exactly one thing on each pass through the loop. */ -/* After each pass, the status of the loop (STATUS) will be */ -/* adjusted to reflect the next thing that needs to be done. */ -/* Occasionally, the current task will have to be interrupted */ -/* until another task can be carried out. (For example, when */ -/* collecting new segments, an interrupt might place a segment */ -/* at the front or end of the current body list; when placing */ -/* the segment on the list, a second interrupt might free up */ -/* room in the segment table in order to allow the addition */ -/* to proceed.) In this case, the current task will be saved and */ -/* restored after the more urgent task has been completed. */ - -/* The loop can terminate in only one of two ways (unless an */ -/* error occurs). First, if an applicable segment is found in */ -/* the segment table, the handle, descriptor, and identifier for */ -/* the segment are returned immediately. Second, if the table */ -/* does not contain an applicable segment, and if no files remain */ -/* to be searched, the loop terminates normally, and no data are */ -/* returned. */ - -/* The individual tasks are described below. */ - -/* 'NEW BODY' */ - - -/* This indicates that the specified body has no segments stored */ -/* for it at all. It must be added to the body table. (This is */ -/* followed immediately by an OLD FILES search, in which every */ -/* file loaded is considered an old file.) */ - -/* 'NEW FILES' */ - -/* This indicates that at least one new file has been added */ -/* since the last time the segment list for the specified */ -/* body was searched. Find the oldest of these new files, */ -/* and begin a NEW SEGMENTS search in forward order for */ -/* segments to add to the front of the list. */ - -/* 'NEW SEGMENTS' */ - -/* Continue a NEW FILES search, adding segments for the specified */ -/* body to the front of the list. */ - -/* 'OLD FILES' */ - -/* This indicates that although the list has been searched */ -/* and found to contain no applicable segment, some of the */ -/* older files remain to be searched. Find the newest of these */ -/* old files, and begin an OLD SEGMENTS search in backward order. */ - -/* 'OLD SEGMENTS' */ - -/* Continue an OLD FILES search, adding segments for the specified */ -/* body to the end of the list. */ - -/* 'CHECK LIST' */ - -/* This indicates that the list is ready to be searched, */ -/* either because no new files have been added, or because */ -/* segments from a new file or an old file have recently */ -/* been added. */ - -/* The list is never checked until all new files have been */ -/* searched. */ - -/* If an applicable segment is found, it is returned. */ - -/* 'MAKE ROOM' (Interrupt) */ - -/* This indicates that one of the bodies must be removed, */ -/* along with its stored segments, to make room for another */ -/* body or segment. The body (other than the one being searched */ -/* for) with the smallest expense is selected for this honor. */ - -/* 'ADD TO FRONT' (Interrupt) */ - -/* This indicates that a segment has been found (during the */ -/* course of a NEW FILES search) and must be added to the front */ -/* of the list. */ - -/* 'ADD TO END' (Interrupt) */ - -/* This indicates that a segment has been found (during the */ -/* course of an OLD FILES search) and must be added to the end */ -/* of the list. */ - -/* 'SUSPEND' */ - -/* This indicates that the current task (DOING) should be */ -/* interrupted until a more urgent task (URGENT) can be */ -/* carried out. The current task is placed on a stack for */ -/* safekeeping. */ - -/* 'RESUME' */ - -/* This indicates that the most recently interrupted task */ -/* should be resumed immediately. */ - -/* '?' */ - -/* This indicates that the next task is not immediately */ -/* apparent: if new files exist, they should be searched; */ -/* otherwise the list should be checked. */ - - -/* Is the body already in the body table? This determines what the */ -/* first task should be. */ - - bindex = isrchi_(body, &nbt, btbod); - if (bindex == 0) { - s_copy(status, "NEW BODY", (ftnlen)15, (ftnlen)8); - } else { - -/* Much of the time, the segment used to satisfy the previous */ -/* request for a given body will also satisfy the current request */ -/* for data for that body. Check whether this is the case. */ - - if (btchkp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "spkbsr_", (ftnlen)2065)]) { - -/* The previous segment found for the current body is a */ -/* viable candidate for the current request. See whether */ -/* the input ET value falls into the re-use interval for this */ -/* body: the time interval for which the previously returned */ -/* segment for this body provides the highest-priority */ -/* coverage. */ - -/* We treat the re-use interval as topologically open because */ -/* one or both endpoints may belong to higher-priority */ -/* segments. */ - - if (*et > btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2078)] && *et < - btub[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btub", i__2, "spkbsr_", (ftnlen)2078)]) { - -/* The request time is covered by the segment found on */ -/* the previous request for data for the current body, */ -/* and this interval is not masked by any higher-priority */ -/* segments. The previous segment for this body satisfies */ -/* the request. */ - - *handle = btprvh[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btprvh", i__1, "spkbsr_", (ftnlen)2087) - ]; - s_copy(ident, btprvi + ((i__1 = bindex - 1) < 200 && 0 <= - i__1 ? i__1 : s_rnge("btprvi", i__1, "spkbsr_", ( - ftnlen)2088)) * 40, ident_len, (ftnlen)40); - moved_(&btprvd[(i__1 = bindex * 5 - 5) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("btprvd", i__1, "spkbsr_", (ftnlen)2090) - ], &c__5, descr); - *found = TRUE_; - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - -/* Adjust the expense here. If the expense of the list */ -/* contains a component due to the cost of finding the */ -/* unbuffered segment providing data for re-use, subtract */ -/* that component from the expense. */ - - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "spkbsr_", (ftnlen)2105)] = btexp[(i__2 = - bindex - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("btexp", - i__2, "spkbsr_", (ftnlen)2105)] - btruex[(i__3 = bindex - - 1) < 200 && 0 <= i__3 ? i__3 : s_rnge("btruex", i__3, - "spkbsr_", (ftnlen)2105)]; - btruex[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "spkbsr_", (ftnlen)2106)] = 0; - -/* The re-use interval becomes invalid if it didn't satisfy */ -/* the request. The validity flag gets re-set below. */ - -/* At this point, the previous segment is not a candidate */ -/* to satisfy the request---at least not until we've verified */ -/* that */ - -/* - The previous segment is still available. */ - -/* - The previous segment hasn't been superseded by a more */ -/* recently loaded segment. */ - - btchkp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "spkbsr_", (ftnlen)2121)] = FALSE_; - } - -/* If the segment list for this body is empty, make sure the */ -/* expense is reset to 0. */ - - if (btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)2130)] == 0) { - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "spkbsr_", (ftnlen)2132)] = 0; - } - s_copy(status, "?", (ftnlen)15, (ftnlen)1); - } - while(s_cmp(status, "HOPELESS", (ftnlen)15, (ftnlen)8) != 0) { - -/* If new files have been added, they have to be searched. */ -/* Otherwise, we can go right to the list of stored segments. */ - - if (s_cmp(status, "?", (ftnlen)15, (ftnlen)1) == 0) { - -/* There are two ways to get to this point. */ - -/* 1) Status may have been set to '?' prior to the */ -/* loop DO WHILE ( STATUS .NE. HOPELESS ). */ - -/* 2) Status was set to '?' by the NEW SEGMENTS block */ -/* of code as the result of finishing the read of */ -/* a new file. */ - - if (bthfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "spkbsr_", (ftnlen)2159)] < ftnum[(i__2 = - nft - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "spkbsr_", (ftnlen)2159)]) { - s_copy(status, "NEW FILES", (ftnlen)15, (ftnlen)9); - } else { - s_copy(status, "CHECK LIST", (ftnlen)15, (ftnlen)10); - } - } else if (s_cmp(status, "NEW BODY", (ftnlen)15, (ftnlen)8) == 0) { - -/* New bodies are added to the end of the body table. If the */ -/* table is full, one of the current occupants must be */ -/* removed to make room for the new one. */ - -/* Setting LFS to one more than the highest current */ -/* file number means the OLD FILES SEARCH that follows will */ -/* begin with the last-loaded file. */ - -/* There is one way to get here: */ - -/* 1) The variable STATUS was set to NEW BODY prior to the */ -/* loop DO WHILE ( STATUS .NE. HOPELESS ). */ - -/* Find the cheapest slot in the body table to store */ -/* the initial information about this body. */ - -/* NOTE: This used to be handled by the MAKE ROOM section. */ -/* However, trying to handle this special case there was */ -/* just more trouble than it was worth. */ - - if (nbt < 200) { - -/* If the body table isn't full, the cheapest place is */ -/* just the next unused row of the table. */ - - ++nbt; - cheap = nbt; - } else { - -/* The body table is full. Find the least */ -/* expensive body in the table and remove it. */ - - cheap = 1; - minexp = btexp[0]; - i__1 = nbt; - for (i__ = 2; i__ <= i__1; ++i__) { - if (btexp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btexp", i__2, "spkbsr_", (ftnlen)2208)] < - minexp) { - cheap = i__; - minexp = btexp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btexp", i__2, "spkbsr_", ( - ftnlen)2210)]; - } - } - -/* If there are any segments associated with the */ -/* least expensive body, we put them back on the free */ -/* list. */ - - head = btbeg[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2220)]; - if (head > 0) { - tail = -lnkprv_(&head, stpool); - lnkfsl_(&head, &tail, stpool); - } - } - -/* Set up a body table entry for the new body. */ - - btbod[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btb" - "od", i__1, "spkbsr_", (ftnlen)2234)] = *body; - btexp[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("bte" - "xp", i__1, "spkbsr_", (ftnlen)2235)] = 0; - bthfs[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("bth" - "fs", i__1, "spkbsr_", (ftnlen)2236)] = ftnum[(i__2 = nft - - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", i__2, - "spkbsr_", (ftnlen)2236)]; - btlfs[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btl" - "fs", i__1, "spkbsr_", (ftnlen)2237)] = ftnum[(i__2 = nft - - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", i__2, - "spkbsr_", (ftnlen)2237)] + 1; - btbeg[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btb" - "eg", i__1, "spkbsr_", (ftnlen)2238)] = 0; - btchkp[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btchkp", i__1, "spkbsr_", (ftnlen)2239)] = FALSE_; - -/* The following items associated with the re-use interval */ -/* need not be initialized at this point: */ - -/* BTRUEX */ -/* BTLB */ -/* BTUB */ -/* BTPRVH */ -/* BTPRVI */ -/* BTPRVD */ - -/* However, we'll give these items initial values to */ -/* help prevent compilation warnings from zealous */ -/* compilers. */ - - btruex[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "spkbsr_", (ftnlen)2256)] = 0; - btlb[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btlb", - i__1, "spkbsr_", (ftnlen)2257)] = dpmin_(); - btub[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btub", - i__1, "spkbsr_", (ftnlen)2258)] = dpmax_(); - btprvh[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btprvh", i__1, "spkbsr_", (ftnlen)2259)] = 0; - s_copy(btprvi + ((i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btprvi", i__1, "spkbsr_", (ftnlen)2260)) * 40, - " ", (ftnlen)40, (ftnlen)1); - cleard_(&c__5, &btprvd[(i__1 = cheap * 5 - 5) < 1000 && 0 <= i__1 - ? i__1 : s_rnge("btprvd", i__1, "spkbsr_", (ftnlen)2261)]) - ; - -/* BINDEX is the body table index of the new entry. */ - - bindex = cheap; - -/* Now search the loaded SPK files for segments relating to */ -/* this body. We start with the last-loaded files and */ -/* work backwards. */ - - s_copy(status, "OLD FILES", (ftnlen)15, (ftnlen)9); - } else if (s_cmp(status, "NEW FILES", (ftnlen)15, (ftnlen)9) == 0) { - -/* When new files exist, they should be searched in forward */ -/* order, beginning with the oldest new file not yet searched. */ -/* All new files must be searched before the list can be */ -/* checked, to ensure that the best (newest) segments are */ -/* being used. */ - -/* Begin a forward search, and prepare to look for individual */ -/* segments from the file. */ - -/* The only way to get here is to have STATUS set to */ -/* the value NEW FILES in the STATUS .EQ. '?' block */ -/* of the IF structure. */ - -/* Find the next file to search; set FINDEX to the */ -/* corresponding file table entry. */ - - findex = 1; - while(bthfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("bthfs", i__1, "spkbsr_", (ftnlen)2297)] >= ftnum[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnum", i__2, "spkbsr_", (ftnlen)2297)]) { - ++findex; - } - bthfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "bthfs", i__1, "spkbsr_", (ftnlen)2301)] = ftnum[(i__2 = - findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftnum", - i__2, "spkbsr_", (ftnlen)2301)]; - dafbfs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "spkbsr_", (ftnlen)2303)]); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - s_copy(status, "NEW SEGMENTS", (ftnlen)15, (ftnlen)12); - -/* The cost of the list contributed by the new file is */ -/* zero so far. */ - - cost = 0; - } else if (s_cmp(status, "NEW SEGMENTS", (ftnlen)15, (ftnlen)12) == 0) - { - -/* New files are searched in forward order. Segments, when */ -/* found, are inserted at the front of the list. Invisible */ -/* segments (alpha > omega) are ignored. */ - -/* Each segment examined, whether applicable or not, adds to */ -/* the expense of the list. */ - -/* The only way to get here is from the NEW FILES block */ -/* of the IF structure. */ - daffna_(&fnd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - if (! fnd) { - -/* We're out of segments in the current file. Decide */ -/* whether we need to examine another new file, or */ -/* whether we're ready to check the list. */ - - s_copy(status, "?", (ftnlen)15, (ftnlen)1); - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "spkbsr_", (ftnlen)2345)] = btexp[( - i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "spkbsr_", (ftnlen)2345)] + cost; - } else { - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - if (icd[0] == *body && dcd[0] <= dcd[1]) { - s_copy(doing, "NEW SEGMENTS", (ftnlen)15, (ftnlen)12); - s_copy(urgent, "ADD TO FRONT", (ftnlen)15, (ftnlen)12); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } - ++cost; - } - -/* If we haven't reset the status, we'll return for another */ -/* 'NEW SEGMENTS' pass. */ - - } else if (s_cmp(status, "OLD FILES", (ftnlen)15, (ftnlen)9) == 0) { - -/* When old files must be searched (because the segments */ -/* in the list are inadequate), they should be searched */ -/* in backward order, beginning with the newest old file */ -/* not yet searched. The segment list will be re-checked */ -/* after each file is searched. If a match is found, */ -/* the search terminates, so some old files may not be */ -/* searched. */ - -/* Search from the end, and prepare to look for individual */ -/* segments from the file. */ - -/* You can get to this block in two ways. */ - -/* 1) We can have a NEW BODY */ - -/* 2) We have checked the current list (CHECK LIST) for */ -/* this body, didn't find an applicable segment and */ -/* have some files left that have not been seached. */ - findex = nft; - while(btlfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlfs", i__1, "spkbsr_", (ftnlen)2397)] <= ftnum[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnum", i__2, "spkbsr_", (ftnlen)2397)]) { - --findex; - } - dafbbs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "spkbsr_", (ftnlen)2401)]); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - s_copy(status, "OLD SEGMENTS", (ftnlen)15, (ftnlen)12); - -/* The next thing we'll do is search through all the segments */ -/* of this file for those that applicable to this body. */ -/* The cost of the list contributed by the current file is */ -/* zero so far. */ - - cost = 0; - } else if (s_cmp(status, "OLD SEGMENTS", (ftnlen)15, (ftnlen)12) == 0) - { - -/* Old files are searched in backward order. Segments, when */ -/* found, are inserted at the end of the list. Invisible */ -/* segments (alpha > omega) are ignored. */ - -/* Each segment examined, whether applicable or not, adds to */ -/* the expense of the list. */ - -/* There is only one way to get here---from the */ -/* block 'OLD FILES'. Note we do not add to the */ -/* expense of the list for this body until we've */ -/* completely searched this file. */ - - daffpa_(&fnd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - if (! fnd) { - -/* We've been through all of the segments in this file. */ -/* Change the lowest file searched indicator for this body */ -/* to be the current file, and go check the current list. */ - - btlfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "spkbsr_", (ftnlen)2446)] = ftnum[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("ftnum", i__2, "spkbsr_", (ftnlen)2446)]; - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btexp", i__1, "spkbsr_", (ftnlen)2447)] = btexp[( - i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "btexp", i__2, "spkbsr_", (ftnlen)2447)] + cost; - s_copy(status, "CHECK LIST", (ftnlen)15, (ftnlen)10); - } else { - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - if (icd[0] == *body && dcd[0] <= dcd[1]) { - s_copy(doing, "OLD SEGMENTS", (ftnlen)15, (ftnlen)12); - s_copy(urgent, "ADD TO END", (ftnlen)15, (ftnlen)10); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } - ++cost; - } - -/* If we haven't reset the status, we'll return for another */ -/* 'OLD SEGMENTS' pass. */ - - } else if (s_cmp(status, "CHECK LIST", (ftnlen)15, (ftnlen)10) == 0) { - -/* Okay, all the new files (and maybe an old file or two) have */ -/* been searched. Time to look at the list of segments stored */ -/* for the body to see if one applicable to the specified */ -/* epoch is hiding in there. If so, return it. If not, */ -/* try another old file. If there are no more old files, */ -/* give up the ghost. */ - -/* There are two ways to get to this point. */ - -/* 1) From the '?' block. */ -/* 2) From the 'OLD SEGMENTS' block. */ - -/* For every segment examined, initialize the re-use interval */ -/* associated with the current body. */ - - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btlb" - , i__1, "spkbsr_", (ftnlen)2494)] = dpmin_(); - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btub" - , i__1, "spkbsr_", (ftnlen)2495)] = dpmax_(); - p = btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)2496)]; - while(p > 0) { - if (*et > stdes[(i__1 = p * 5 - 4) < 250000 && 0 <= i__1 ? - i__1 : s_rnge("stdes", i__1, "spkbsr_", (ftnlen)2500)] - ) { - -/* ET is to the right of the coverage interval of this */ -/* segment. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 - : s_rnge("btlb", i__2, "spkbsr_", (ftnlen)2505)], - d__2 = stdes[(i__3 = p * 5 - 4) < 250000 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "spkbsr_", ( - ftnlen)2505)]; - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2505)] = - max(d__1,d__2); - } else if (*et < stdes[(i__1 = p * 5 - 5) < 250000 && 0 <= - i__1 ? i__1 : s_rnge("stdes", i__1, "spkbsr_", ( - ftnlen)2508)]) { - -/* ET is to the left of the coverage interval of this */ -/* segment. */ - -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 - : s_rnge("btub", i__2, "spkbsr_", (ftnlen)2513)], - d__2 = stdes[(i__3 = p * 5 - 5) < 250000 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "spkbsr_", ( - ftnlen)2513)]; - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "spkbsr_", (ftnlen)2513)] = - min(d__1,d__2); - } else { - -/* The segment coverage interval includes ET. */ - - moved_(&stdes[(i__1 = p * 5 - 5) < 250000 && 0 <= i__1 ? - i__1 : s_rnge("stdes", i__1, "spkbsr_", (ftnlen) - 2519)], &c__5, descr); - s_copy(ident, stidnt + ((i__1 = p - 1) < 50000 && 0 <= - i__1 ? i__1 : s_rnge("stidnt", i__1, "spkbsr_", ( - ftnlen)2520)) * 40, ident_len, (ftnlen)40); - *handle = sthan[(i__1 = p - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("sthan", i__1, "spkbsr_", (ftnlen) - 2521)]; - *found = TRUE_; - -/* Set the re-use interval for the current body. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 - : s_rnge("btlb", i__2, "spkbsr_", (ftnlen)2527)], - d__2 = stdes[(i__3 = p * 5 - 5) < 250000 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "spkbsr_", ( - ftnlen)2527)]; - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2527)] = - max(d__1,d__2); -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? i__2 - : s_rnge("btub", i__2, "spkbsr_", (ftnlen)2528)], - d__2 = stdes[(i__3 = p * 5 - 4) < 250000 && 0 <= - i__3 ? i__3 : s_rnge("stdes", i__3, "spkbsr_", ( - ftnlen)2528)]; - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "spkbsr_", (ftnlen)2528)] = - min(d__1,d__2); - -/* Save the returned output items, in case this segment */ -/* may satisfy the next request. */ - - btprvh[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btprvh", i__1, "spkbsr_", (ftnlen)2534)] = - *handle; - s_copy(btprvi + ((i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btprvi", i__1, "spkbsr_", (ftnlen) - 2535)) * 40, ident, (ftnlen)40, ident_len); - moved_(descr, &c__5, &btprvd[(i__1 = bindex * 5 - 5) < - 1000 && 0 <= i__1 ? i__1 : s_rnge("btprvd", i__1, - "spkbsr_", (ftnlen)2536)]); - btchkp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btchkp", i__1, "spkbsr_", (ftnlen)2537)] = - TRUE_; - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - p = stpool[(i__1 = (p << 1) + 10) < 100012 && 0 <= i__1 ? - i__1 : s_rnge("stpool", i__1, "spkbsr_", (ftnlen)2548) - ]; - } - -/* If we're still here we didn't have information for this */ -/* body in the segment list. */ - -/* If there are more files, search them. */ -/* Otherwise, things are hopeless, set the status that way. */ - - if (btlfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btlfs", i__1, "spkbsr_", (ftnlen)2559)] > ftnum[0]) { - s_copy(status, "OLD FILES", (ftnlen)15, (ftnlen)9); - } else { - s_copy(status, "HOPELESS", (ftnlen)15, (ftnlen)8); - } - } else if (s_cmp(status, "MAKE ROOM", (ftnlen)15, (ftnlen)9) == 0) { - -/* When adding a segment to a full segment table, one of */ -/* the current bodies must be dropped. The ideal candidate */ -/* is the one whose list was constructed at the lowest expense. */ -/* The candidate should be removed from the body table, and */ -/* its list transferred to the segment table pool. */ - -/* There is ``room'' if the segment table pool contains at */ -/* least one free node. */ - -/* It is possible that a single body requires more than the */ -/* entire segment table for its own segments. Two things might */ -/* happen in such a case: */ - -/* 1) If the list under consideration was being added to at */ -/* the end, then a search is continued without buffering */ -/* any segments. */ - -/* 2) If the list was being added to at the beginning, then */ -/* that means there was a NEW FILES search going on, and */ -/* so a brand new list is constructed for the body, much */ -/* as in a 'NEW BODY' task. */ - -/* There are two different ways to get to this point. */ - -/* 1) From 'ADD TO FRONT' if the segment table pool is full. */ -/* 2) From 'ADD TO END' if the segment table pool is full. */ - -/* Try to make room by deleting a segment list. CHEAP will */ -/* be the index of the "cheapest" segment list in the body */ -/* table. */ - - minexp = intmax_(); - cheap = 0; - i__1 = nbt; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ != bindex) { - -/* This list is for a body other than the current */ -/* one. */ - - if (btexp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btexp", i__2, "spkbsr_", (ftnlen)2610)] < - minexp || cheap == 0) { - -/* This list is the cheapest seen so far, */ -/* possibly because it's the first one */ -/* considered. At the moment, it's as good */ -/* a candidate for removal as any. */ - - cheap = i__; - minexp = btexp[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btexp", i__2, "spkbsr_", ( - ftnlen)2619)]; - } - } - } - if (cheap == 0) { - -/* What we do if there are no delete-able segments */ -/* depends on the task that was suspended before entering */ -/* 'MAKE ROOM'. */ - - if (s_cmp(stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "spkbsr_", (ftnlen)2634)) * 15, - "ADD TO END", (ftnlen)15, (ftnlen)10) == 0) { - -/* There's nothing left to do but search the remaining */ -/* files and segments without buffering them. */ - - s_copy(status, "SEARCH W/O BUFF", (ftnlen)15, (ftnlen)15); - } else { - -/* STACK(TOP) is set to 'ADD TO FRONT'. */ - -/* If there is no room left in the table in the middle */ -/* of an attempt to add to the front of the list, just */ -/* start from scratch by treating all files as */ -/* unsearched and doing an OLD FILES search, as would */ -/* be done for a new body. */ - -/* Return the current list to the segment table pool. */ - -/* Note that, according to the specification of the */ -/* SPICELIB doubly linked list routines, the backward */ -/* pointer of a list head is the negative of the tail */ -/* node. */ - - p = btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2659)]; - tail = -lnkprv_(&p, stpool); - lnkfsl_(&p, &tail, stpool); - -/* Re-initialize the table for this body, and initiate */ -/* an 'OLD FILES' search, just as in 'NEW BODY'. */ -/* Also, reset the suspended task stack to be empty. */ - - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btexp", i__1, "spkbsr_", (ftnlen)2669)] = - 0; - bthfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("bthfs", i__1, "spkbsr_", (ftnlen)2670)] = - ftnum[(i__2 = nft - 1) < 1000 && 0 <= i__2 ? i__2 - : s_rnge("ftnum", i__2, "spkbsr_", (ftnlen)2670)]; - btlfs[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlfs", i__1, "spkbsr_", (ftnlen)2671)] = - ftnum[(i__2 = nft - 1) < 1000 && 0 <= i__2 ? i__2 - : s_rnge("ftnum", i__2, "spkbsr_", (ftnlen)2671)] - + 1; - s_copy(status, "OLD FILES", (ftnlen)15, (ftnlen)9); - top = 0; - } - } else { - -/* Return this cheapest list to the segment pool. */ - - p = btbeg[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2681)]; - if (p > 0) { - tail = -lnkprv_(&p, stpool); - lnkfsl_(&p, &tail, stpool); - } - -/* Fill the deleted body's space in the table with */ -/* the final entry in the table. */ - - if (cheap != nbt) { - btbod[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbod", i__1, "spkbsr_", (ftnlen)2696)] = - btbod[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btbod", i__2, "spkbsr_", (ftnlen)2696)]; - btexp[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btexp", i__1, "spkbsr_", (ftnlen)2697)] = - btexp[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btexp", i__2, "spkbsr_", (ftnlen)2697)]; - bthfs[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("bthfs", i__1, "spkbsr_", (ftnlen)2698)] = - bthfs[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("bthfs", i__2, "spkbsr_", (ftnlen)2698)]; - btlfs[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlfs", i__1, "spkbsr_", (ftnlen)2699)] = - btlfs[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btlfs", i__2, "spkbsr_", (ftnlen)2699)]; - btbeg[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2700)] = - btbeg[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btbeg", i__2, "spkbsr_", (ftnlen)2700)]; - btlb[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2701)] = - btlb[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btlb", i__2, "spkbsr_", (ftnlen)2701)]; - btub[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "spkbsr_", (ftnlen)2702)] = - btub[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("btub", i__2, "spkbsr_", (ftnlen)2702)]; - btprvh[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btprvh", i__1, "spkbsr_", (ftnlen)2703)] = - btprvh[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btprvh", i__2, "spkbsr_", (ftnlen) - 2703)]; - s_copy(btprvi + ((i__1 = cheap - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btprvi", i__1, "spkbsr_", (ftnlen) - 2704)) * 40, btprvi + ((i__2 = nbt - 1) < 200 && - 0 <= i__2 ? i__2 : s_rnge("btprvi", i__2, "spkbs" - "r_", (ftnlen)2704)) * 40, (ftnlen)40, (ftnlen)40); - btruex[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btruex", i__1, "spkbsr_", (ftnlen)2705)] = - btruex[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btruex", i__2, "spkbsr_", (ftnlen) - 2705)]; - btchkp[(i__1 = cheap - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btchkp", i__1, "spkbsr_", (ftnlen)2706)] = - btchkp[(i__2 = nbt - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btchkp", i__2, "spkbsr_", (ftnlen) - 2706)]; - moved_(&btprvd[(i__1 = nbt * 5 - 5) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("btprvd", i__1, "spkbsr_", (ftnlen) - 2709)], &c__5, &btprvd[(i__2 = cheap * 5 - 5) < - 1000 && 0 <= i__2 ? i__2 : s_rnge("btprvd", i__2, - "spkbsr_", (ftnlen)2709)]); - } - -/* If the final entry in the table happened to be the */ -/* current body of interest, then we also have to change */ -/* the current body index. */ - - if (bindex == nbt) { - bindex = cheap; - } - -/* One less body now. */ - - --nbt; - s_copy(status, "RESUME", (ftnlen)15, (ftnlen)6); - } - -/* Either we made room by freeing a non-empty segment list, */ -/* or we're going to work without additional space. In the */ -/* latter case, the state is now 'OLD FILES' or */ -/* 'SEARCH W/O BUFF'. */ - - } else if (s_cmp(status, "ADD TO FRONT", (ftnlen)15, (ftnlen)12) == 0) - { - -/* The current segment information should be linked in at */ -/* the head of the segment list for the current body, and */ -/* the pertinent body table entry should point to the new */ -/* head of the list. */ - -/* The only way to get here is from the block NEW SEGMENTS */ -/* after suspending that task. */ - - if (lnknfn_(stpool) == 0) { - -/* There's no room left in the segment pool. We must make */ -/* room before continuing. */ - - s_copy(doing, "ADD TO FRONT", (ftnlen)15, (ftnlen)12); - s_copy(urgent, "MAKE ROOM", (ftnlen)15, (ftnlen)9); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } else { - -/* Allocate a node and link it to the front of the list */ -/* for the current body. */ - - lnkan_(stpool, &new__); - sthan[(i__1 = new__ - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "spkbsr_", (ftnlen)2763)] = fthan[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "spkbsr_", (ftnlen)2763)]; - moved_(descr, &c__5, &stdes[(i__1 = new__ * 5 - 5) < 250000 && - 0 <= i__1 ? i__1 : s_rnge("stdes", i__1, "spkbsr_", ( - ftnlen)2764)]); - dafgn_(stidnt + ((i__1 = new__ - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("stidnt", i__1, "spkbsr_", (ftnlen)2765) - ) * 40, (ftnlen)40); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - -/* If the current list is empty, this append operation */ -/* is a no-op. */ - - lnkilb_(&new__, &btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 - ? i__1 : s_rnge("btbeg", i__1, "spkbsr_", (ftnlen) - 2776)], stpool); - btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btbeg", i__1, "spkbsr_", (ftnlen)2777)] = new__; - s_copy(status, "RESUME", (ftnlen)15, (ftnlen)6); - } - } else if (s_cmp(status, "ADD TO END", (ftnlen)15, (ftnlen)10) == 0) { - -/* The current segment information should be linked in at */ -/* the tail of the segment list for the current body. */ - -/* The only way to get to this task is from the OLD SEGMENTS */ -/* block after suspending that task. */ - - if (lnknfn_(stpool) == 0) { - -/* There's no room left in the segment pool. We must make */ -/* room before continuing. */ - - s_copy(doing, "ADD TO END", (ftnlen)15, (ftnlen)10); - s_copy(urgent, "MAKE ROOM", (ftnlen)15, (ftnlen)9); - s_copy(status, "SUSPEND", (ftnlen)15, (ftnlen)7); - } else { - -/* Allocate a new node in the segment table pool. */ - - lnkan_(stpool, &new__); - sthan[(i__1 = new__ - 1) < 50000 && 0 <= i__1 ? i__1 : s_rnge( - "sthan", i__1, "spkbsr_", (ftnlen)2808)] = fthan[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("fthan", i__2, "spkbsr_", (ftnlen)2808)]; - moved_(descr, &c__5, &stdes[(i__1 = new__ * 5 - 5) < 250000 && - 0 <= i__1 ? i__1 : s_rnge("stdes", i__1, "spkbsr_", ( - ftnlen)2809)]); - dafgn_(stidnt + ((i__1 = new__ - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("stidnt", i__1, "spkbsr_", (ftnlen)2810) - ) * 40, (ftnlen)40); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - if (btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2817)] <= 0) - { - -/* This is the first node in the list for this body. */ - - btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2821)] = - new__; - } else { - -/* Link the new node to the tail of the list. */ - - tail = -lnkprv_(&btbeg[(i__1 = bindex - 1) < 200 && 0 <= - i__1 ? i__1 : s_rnge("btbeg", i__1, "spkbsr_", ( - ftnlen)2827)], stpool); - lnkila_(&tail, &new__, stpool); - } - s_copy(status, "RESUME", (ftnlen)15, (ftnlen)6); - } - } else if (s_cmp(status, "SEARCH W/O BUFF", (ftnlen)15, (ftnlen)15) == - 0) { - -/* When the segment table is completely full, continue */ -/* the search by looking through the unchecked portion */ -/* of the segment list for the current body, and */ -/* then searching old, unchecked files without buffering */ -/* their segments. */ - -/* The only way to get here is from the MAKE ROOM state */ -/* via the block ADD TO END. If you get here there is no */ -/* free space in the segment table pool. */ - -/* At this point, we need to initialize the cost of */ -/* the re-use interval. */ - - btruex[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "spkbsr_", (ftnlen)2853)] = 0; - -/* Need to find the portion of the current body's segment */ -/* list which comes from the current file of interest. It */ -/* will be returned to the segment table pool, since the */ -/* remainder of the file's segments can't be added to the list. */ - - crflbg = btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2861)]; - fndhan = FALSE_; - while(! fndhan && crflbg > 0) { - fndhan = sthan[(i__1 = crflbg - 1) < 50000 && 0 <= i__1 ? - i__1 : s_rnge("sthan", i__1, "spkbsr_", (ftnlen)2866)] - == fthan[(i__2 = findex - 1) < 1000 && 0 <= i__2 ? - i__2 : s_rnge("fthan", i__2, "spkbsr_", (ftnlen)2866)] - ; - if (! fndhan) { - -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - crflbg = stpool[(i__1 = (crflbg << 1) + 10) < 100012 && 0 - <= i__1 ? i__1 : s_rnge("stpool", i__1, "spkbsr_", - (ftnlen)2873)]; - } - } - if (crflbg > 0) { - -/* The sub-list from the current node onwards is to be */ -/* returned to the segment table pool. Save this node, */ -/* since we'll finish searching the list before freeing */ -/* the sub-list. */ - - p = crflbg; - -/* It may be that the sub-list we're deleting is the */ -/* entire segment list for this body. If so, the */ -/* corresponding body table entry should be set to */ -/* a non-positive value to indicate an empty segment list. */ - - if (p == btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2894)]) { - btbeg[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btbeg", i__1, "spkbsr_", (ftnlen)2896)] = - 0; - -/* Also in this case, we must initialize the re-use */ -/* interval for this body. */ - - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2901)] = - dpmin_(); - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "spkbsr_", (ftnlen)2902)] = - dpmax_(); - } - -/* Finish searching through the incomplete list for the */ -/* desired segment. */ - - while(crflbg > 0) { - -/* Every segment seen from the current file contributes */ -/* to the expense of the re-use interval. */ - - btruex[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btruex", i__1, "spkbsr_", (ftnlen)2915)] = - btruex[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btruex", i__2, "spkbsr_", (ftnlen) - 2915)] + 1; - if (*et > stdes[(i__1 = crflbg * 5 - 4) < 250000 && 0 <= - i__1 ? i__1 : s_rnge("stdes", i__1, "spkbsr_", ( - ftnlen)2918)]) { - -/* ET is to the right of the coverage interval of this */ -/* segment. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btlb", i__2, "spkbsr_", ( - ftnlen)2923)], d__2 = stdes[(i__3 = crflbg * - 5 - 4) < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "spkbsr_", (ftnlen)2923)]; - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2923)] - = max(d__1,d__2); - } else if (*et < stdes[(i__1 = crflbg * 5 - 5) < 250000 && - 0 <= i__1 ? i__1 : s_rnge("stdes", i__1, "spkbs" - "r_", (ftnlen)2926)]) { - -/* ET is to the left of the coverage interval of this */ -/* segment. */ - -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btub", i__2, "spkbsr_", ( - ftnlen)2931)], d__2 = stdes[(i__3 = crflbg * - 5 - 5) < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "spkbsr_", (ftnlen)2931)]; - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "spkbsr_", (ftnlen)2931)] - = min(d__1,d__2); - } else { - -/* The segment coverage interval includes ET. */ - - moved_(&stdes[(i__1 = crflbg * 5 - 5) < 250000 && 0 <= - i__1 ? i__1 : s_rnge("stdes", i__1, "spkbsr_" - , (ftnlen)2937)], &c__5, descr); - s_copy(ident, stidnt + ((i__1 = crflbg - 1) < 50000 && - 0 <= i__1 ? i__1 : s_rnge("stidnt", i__1, - "spkbsr_", (ftnlen)2939)) * 40, ident_len, ( - ftnlen)40); - *handle = sthan[(i__1 = crflbg - 1) < 50000 && 0 <= - i__1 ? i__1 : s_rnge("sthan", i__1, "spkbsr_", - (ftnlen)2940)]; - *found = TRUE_; - -/* Set the re-use interval for the current body. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btlb", i__2, "spkbsr_", ( - ftnlen)2946)], d__2 = stdes[(i__3 = crflbg * - 5 - 5) < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "spkbsr_", (ftnlen)2946)]; - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btlb", i__1, "spkbsr_", (ftnlen)2946)] - = max(d__1,d__2); -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btub", i__2, "spkbsr_", ( - ftnlen)2947)], d__2 = stdes[(i__3 = crflbg * - 5 - 4) < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "stdes", i__3, "spkbsr_", (ftnlen)2947)]; - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btub", i__1, "spkbsr_", (ftnlen)2947)] - = min(d__1,d__2); - -/* Save the output items, in case this */ -/* segment may be satisfy the next request. */ - - btprvh[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btprvh", i__1, "spkbsr_", (ftnlen) - 2953)] = *handle; - s_copy(btprvi + ((i__1 = bindex - 1) < 200 && 0 <= - i__1 ? i__1 : s_rnge("btprvi", i__1, "spkbsr_" - , (ftnlen)2954)) * 40, ident, (ftnlen)40, - ident_len); - moved_(descr, &c__5, &btprvd[(i__1 = bindex * 5 - 5) < - 1000 && 0 <= i__1 ? i__1 : s_rnge("btprvd", - i__1, "spkbsr_", (ftnlen)2955)]); - btchkp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btchkp", i__1, "spkbsr_", (ftnlen) - 2956)] = TRUE_; - -/* Update the expense of the list to reflect */ -/* the cost of locating this segment. */ - - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btexp", i__1, "spkbsr_", (ftnlen)2962) - ] = btexp[(i__2 = bindex - 1) < 200 && 0 <= - i__2 ? i__2 : s_rnge("btexp", i__2, "spkbsr_", - (ftnlen)2962)] + btruex[(i__3 = bindex - 1) < - 200 && 0 <= i__3 ? i__3 : s_rnge("btruex", - i__3, "spkbsr_", (ftnlen)2962)]; - -/* Free the sub-list we were searching. */ - - tail = lnktl_(&crflbg, stpool); - lnkfsl_(&p, &tail, stpool); - chkout_("SPKSFS", (ftnlen)6); - return 0; - } -/* Get the next node. We avoid LNKNXT here in order */ -/* to speed up the operation. */ - - crflbg = stpool[(i__1 = (crflbg << 1) + 10) < 100012 && 0 - <= i__1 ? i__1 : s_rnge("stpool", i__1, "spkbsr_", - (ftnlen)2978)]; - } - -/* Return the sub-list to the segment table pool. */ -/* CRFLBG at this point is the negative of the list head. */ -/* The list tail is (by the spec of the SPICELIB doubly */ -/* linked list routines) the negative of the predecessor */ -/* of the head. */ - -/* Note the list is always non-empty. */ - - i__1 = -crflbg; - tail = -lnkprv_(&i__1, stpool); - lnkfsl_(&p, &tail, stpool); - } - -/* Search through the remaining files without buffering. */ -/* Recall that a search is already in progress and that a */ -/* segment is currently under consideration (FND = .TRUE.). */ - - while(findex > 0) { - while(fnd) { - -/* Each segment found contributes to the expense of the */ -/* re-use interval. */ - - btruex[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("btruex", i__1, "spkbsr_", (ftnlen)3009)] = - btruex[(i__2 = bindex - 1) < 200 && 0 <= i__2 ? - i__2 : s_rnge("btruex", i__2, "spkbsr_", (ftnlen) - 3009)] + 1; - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dcd, icd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - if (*body == icd[0]) { - -/* This is a segment for the body of interest. */ -/* Update the re-use interval for this body. */ - - if (*et > dcd[1]) { - -/* ET is to the right of the coverage interval */ -/* of this segment. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 200 && 0 <= - i__2 ? i__2 : s_rnge("btlb", i__2, "spkb" - "sr_", (ftnlen)3029)]; - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btlb", i__1, "spkbsr_", ( - ftnlen)3029)] = max(d__1,dcd[1]); - } else if (*et < dcd[0]) { - -/* ET is to the left of the coverage interval */ -/* of this segment. */ - -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 200 && 0 <= - i__2 ? i__2 : s_rnge("btub", i__2, "spkb" - "sr_", (ftnlen)3037)]; - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btub", i__1, "spkbsr_", ( - ftnlen)3037)] = min(d__1,dcd[0]); - } else { - -/* The segment coverage interval includes ET. */ - - dafgn_(ident, ident_len); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - *handle = fthan[(i__1 = findex - 1) < 1000 && 0 <= - i__1 ? i__1 : s_rnge("fthan", i__1, - "spkbsr_", (ftnlen)3050)]; - *found = TRUE_; - -/* Set the re-use interval for the current body. */ - -/* Computing MAX */ - d__1 = btlb[(i__2 = bindex - 1) < 200 && 0 <= - i__2 ? i__2 : s_rnge("btlb", i__2, "spkb" - "sr_", (ftnlen)3056)]; - btlb[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btlb", i__1, "spkbsr_", ( - ftnlen)3056)] = max(d__1,dcd[0]); -/* Computing MIN */ - d__1 = btub[(i__2 = bindex - 1) < 200 && 0 <= - i__2 ? i__2 : s_rnge("btub", i__2, "spkb" - "sr_", (ftnlen)3057)]; - btub[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btub", i__1, "spkbsr_", ( - ftnlen)3057)] = min(d__1,dcd[1]); - -/* Save the output items, in case this */ -/* segment may satisfy the next request. */ - - btprvh[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btprvh", i__1, "spkbsr_", ( - ftnlen)3063)] = *handle; - s_copy(btprvi + ((i__1 = bindex - 1) < 200 && 0 <= - i__1 ? i__1 : s_rnge("btprvi", i__1, - "spkbsr_", (ftnlen)3064)) * 40, ident, ( - ftnlen)40, ident_len); - moved_(descr, &c__5, &btprvd[(i__1 = bindex * 5 - - 5) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "btprvd", i__1, "spkbsr_", (ftnlen)3065)]) - ; - btchkp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btchkp", i__1, "spkbsr_", ( - ftnlen)3066)] = TRUE_; - -/* Update the expense of the list to reflect */ -/* the cost of locating this segment. */ - - btexp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? - i__1 : s_rnge("btexp", i__1, "spkbsr_", ( - ftnlen)3072)] = btexp[(i__2 = bindex - 1) - < 200 && 0 <= i__2 ? i__2 : s_rnge("btexp" - , i__2, "spkbsr_", (ftnlen)3072)] + - btruex[(i__3 = bindex - 1) < 200 && 0 <= - i__3 ? i__3 : s_rnge("btruex", i__3, - "spkbsr_", (ftnlen)3072)]; - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - } - daffpa_(&fnd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - } - -/* Try the next oldest file. */ - - --findex; - if (findex > 0) { - dafbbs_(&fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("fthan", i__1, "spkbsr_", (ftnlen) - 3097)]); - daffpa_(&fnd); - if (failed_()) { - chkout_("SPKSFS", (ftnlen)6); - return 0; - } - } - } - -/* If you get to here, sorry. */ - - btruex[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "btruex", i__1, "spkbsr_", (ftnlen)3112)] = 0; - s_copy(status, "HOPELESS", (ftnlen)15, (ftnlen)8); - -/* When a task is suspended, the current activity is placed on */ -/* a stack, to be restored later. Two levels are provided, since */ -/* some interrupts can be interrupted by others. */ - - } else if (s_cmp(status, "SUSPEND", (ftnlen)15, (ftnlen)7) == 0) { - ++top; - s_copy(stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "stack", i__1, "spkbsr_", (ftnlen)3123)) * 15, doing, ( - ftnlen)15, (ftnlen)15); - s_copy(status, urgent, (ftnlen)15, (ftnlen)15); - } else if (s_cmp(status, "RESUME", (ftnlen)15, (ftnlen)6) == 0) { - -/* Pop the status stack. */ - - s_copy(status, stack + ((i__1 = top - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "spkbsr_", (ftnlen)3130)) * 15, ( - ftnlen)15, (ftnlen)15); - --top; - } - } - -/* If we didn't find a segment, don't attempt to use saved */ -/* outputs from a previous call. BINDEX will always be set */ -/* at this point. Also clear the re-use interval's expense. */ - - if (bindex > 0) { - btchkp[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btchkp" - , i__1, "spkbsr_", (ftnlen)3144)] = FALSE_; - btruex[(i__1 = bindex - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge("btruex" - , i__1, "spkbsr_", (ftnlen)3145)] = 0; - } - chkout_("SPKSFS", (ftnlen)6); - return 0; -} /* spkbsr_ */ - -/* Subroutine */ int spkbsr_(char *fname, integer *handle, integer *body, - doublereal *et, doublereal *descr, char *ident, logical *found, - ftnlen fname_len, ftnlen ident_len) -{ - return spkbsr_0_(0, fname, handle, body, et, descr, ident, found, - fname_len, ident_len); - } - -/* Subroutine */ int spklef_(char *fname, integer *handle, ftnlen fname_len) -{ - return spkbsr_0_(1, fname, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (char *)0, (logical *)0, fname_len, (ftnint)0); - } - -/* Subroutine */ int spkuef_(integer *handle) -{ - return spkbsr_0_(2, (char *)0, handle, (integer *)0, (doublereal *)0, ( - doublereal *)0, (char *)0, (logical *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int spksfs_(integer *body, doublereal *et, integer *handle, - doublereal *descr, char *ident, logical *found, ftnlen ident_len) -{ - return spkbsr_0_(3, (char *)0, handle, body, et, descr, ident, found, ( - ftnint)0, ident_len); - } - diff --git a/ext/spice/src/cspice/spkcls.c b/ext/spice/src/cspice/spkcls.c deleted file mode 100644 index 339fbbfa5b..0000000000 --- a/ext/spice/src/cspice/spkcls.c +++ /dev/null @@ -1,212 +0,0 @@ -/* spkcls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKCLS ( SPK, Close file ) */ -/* Subroutine */ int spkcls_(integer *handle) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), dafcls_(integer *); - char access[5]; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Close an open SPK file. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the SPK file to be closed. */ - -/* $ Detailed_Input */ - -/* HANDLE The handle of the SPK file that is to be closed. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there are no segments in the file the error */ -/* SPICE(NOSEGMENTSFOUND) will be signalled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* Close the SPK file attached to HANDLE. */ - -/* $ Examples */ - -/* Suppose that you want to create a new SPK file called 'new.spk' */ -/* that contains a single type 5 SPK segment and has room for at */ -/* least 5000 comment characters. The following code fragment should */ -/* take care of this for you, assuming that all of the variables */ -/* passed to the SPK type 5 segment writer have appropriate values */ -/* and no errors occur. */ - -/* NAME = 'new.spk' */ -/* IFNAME = 'Test SPK file' */ - -/* CALL SPKOPN ( NAME, IFNAME, 5000, HANDLE ) */ -/* CALL SPKW05 ( HANDLE, OBJID, CNTRID, CFRAME, ETBEG, */ -/* . ETEND, SEGMID, CNTRGM, NSTATE, STATE, */ -/* . EPOCH ) */ -/* CALL SPKCLS ( HANDLE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ - -/* Removed DAFHLU call; replaced ERRFN call with ERRHAN. */ - -/* - SPICELIB Version 1.1.0, 17-FEB-2000 (FST) */ - -/* Removed the call to ZZFIXID. This will make all SPK files */ -/* created with future versions of the toolkit possess the */ -/* unambiguous ID word 'DAF/SPK '. */ - -/* - SPICELIB Version 1.0.0, 27-JAN-1995 (KRG) */ - - -/* -& */ -/* $ Index_Entries */ - -/* close an spk file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKCLS", (ftnlen)6); - -/* Get the access method for the file. Currently, if HANDLE < 0, the */ -/* access method is 'WRITE'. If HANDLE > 0, the access method is */ -/* 'READ'. In the future this should make use of the private entry */ -/* in the handle manager umbrella, ZZDDHNFO. */ - - if (*handle < 0) { - s_copy(access, "WRITE", (ftnlen)5, (ftnlen)5); - } else if (*handle > 0) { - s_copy(access, "READ", (ftnlen)5, (ftnlen)4); - } - -/* If the file is open for writing and there are segments in the file */ -/* fix the ID word and close the file, or just close the file. */ - - if (s_cmp(access, "WRITE", (ftnlen)5, (ftnlen)5) == 0) { - -/* Check to see if there are any segments in the file. If there */ -/* are no segments, we signal an error. This probably indicates a */ -/* programming error of some sort anyway. Why would you create a */ -/* file and put nothing in it? */ - - dafbfs_(handle); - daffna_(&found); - if (failed_()) { - chkout_("SPKCLS", (ftnlen)6); - return 0; - } - if (! found) { - setmsg_("No segments were found in the SPK file '#'. There must " - "be at least one segment in the file when this subroutine" - " is called.", (ftnlen)122); - errhan_("#", handle, (ftnlen)1); - sigerr_("SPICE(NOSEGMENTSFOUND)", (ftnlen)22); - chkout_("SPKCLS", (ftnlen)6); - return 0; - } - } - -/* Close the file. */ - - dafcls_(handle); - -/* No need to check FAILED() here, since we only call spicelib */ -/* subroutines and return. The caller should check it though. */ - - chkout_("SPKCLS", (ftnlen)6); - return 0; -} /* spkcls_ */ - diff --git a/ext/spice/src/cspice/spkcls_c.c b/ext/spice/src/cspice/spkcls_c.c deleted file mode 100644 index 567b610997..0000000000 --- a/ext/spice/src/cspice/spkcls_c.c +++ /dev/null @@ -1,139 +0,0 @@ -/* - --Procedure spkcls_c ( SPK, Close file ) - --Abstract - - Close an open SPK file. - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - void spkcls_c ( SpiceInt handle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - handle I Handle of the SPK file to be closed. - --Detailed_Input - - handle The handle of the SPK file that is to be closed. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If there are no segments in the file, the error - SPICE(NOSEGMENTSFOUND) will be signaled. - --Files - - See argument handle. - --Particulars - - Close the SPK file attached to handle. - --Examples - - Suppose that you want to create a new SPK file called "new.spk" - that contains a single type 5 SPK segment and has room for at - least 5000 comment characters. The following code fragment should - take care of this for you, assuming that all of the variables - passed to the SPK type 5 segment writer have appropriate values - and no errors occur. - - #include "SpiceUsr.h" - . - . - . - name = "new.spk"; - ifname = "Test SPK file"; - - spkopn_c ( name, ifname, 5000, &handle ); - spkw05 ( handle, objid, cntrid, cframe, etbeg, - etend, segmid, cntrgm, nstate, state, - epoch ); - spkcls_c ( handle ); - --Restrictions - - None. - --Author_and_Institution - - F.S. Turner (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 16-MAR-1999 (FST) - --Index_Entries - - close an spk file - --& -*/ - -{ /* Begin spkcls_c */ - - /* - Participate in error tracing. - */ - - chkin_c ( "spkcls_c" ); - - spkcls_ ( ( integer * ) &handle ); - - chkout_c ( "spkcls_c" ); - -} /* End spkcls_c */ diff --git a/ext/spice/src/cspice/spkcov.c b/ext/spice/src/cspice/spkcov.c deleted file mode 100644 index 177cdf7800..0000000000 --- a/ext/spice/src/cspice/spkcov.c +++ /dev/null @@ -1,579 +0,0 @@ -/* spkcov.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKCOV ( SPK coverage ) */ -/* Subroutine */ int spkcov_(char *spk, integer *idcode, doublereal *cover, - ftnlen spk_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[80]; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - logical found; - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), wninsd_(doublereal *, doublereal *, - doublereal *); - char kertyp[80]; - extern logical return_(void); - -/* $ Abstract */ - -/* Find the coverage window for a specified ephemeris object in a */ -/* specified SPK file. */ - -/* $ 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 */ - -/* CELLS */ -/* DAF */ -/* SPK */ -/* TIME */ -/* WINDOWS */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SPK I Name of SPK file. */ -/* IDCODE I ID code of ephemeris object. */ -/* COVER I/O Window giving coverage in SPK for IDCODE. */ - -/* $ Detailed_Input */ - -/* SPK is the name of an SPK file. */ - -/* IDCODE is the integer ID code of an object for which */ -/* ephemeris data are expected to exist in the */ -/* specified SPK file. */ - -/* COVER is an initialized SPICELIB window data structure. */ -/* COVER optionally may contain coverage data on */ -/* input; on output, the data already present in */ -/* COVER will be combined with coverage found for the */ -/* object designated by IDCODE in the file SPK. */ - -/* If COVER contains no data on input, its size and */ -/* cardinality still must be initialized. */ - -/* $ Detailed_Output */ - -/* COVER is a SPICELIB window data structure which */ -/* represents the merged coverage for IDCODE. This is */ -/* the set of time intervals for which data for */ -/* IDCODE are present in the file SPK, merged with */ -/* the set of time intervals present in COVER on */ -/* input. The merged coverage is represented as the */ -/* union of one or more disjoint time intervals. The */ -/* window COVER contains the pairs of endpoints of */ -/* these intervals. */ - -/* The interval endpoints contained in COVER are */ -/* ephemeris times, expressed as seconds past J2000 */ -/* TDB. */ - -/* See the Examples section below for a complete */ -/* example program showing how to retrieve the */ -/* endpoints from COVER. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file has transfer format, the error */ -/* SPICE(INVALIDFORMAT) is signaled. */ - -/* 2) If the input file is not a transfer file but has architecture */ -/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */ - -/* 3) If the input file is a binary DAF file of type other than */ -/* SPK, the error SPICE(BADFILETYPE) is signaled. */ - -/* 4) If the SPK file cannot be opened or read, the error will */ -/* be diagnosed by routines called by this routine. The output */ -/* window will not be modified. */ - -/* 5) If the size of the output window argument COVER is */ -/* insufficient to contain the actual number of intervals in the */ -/* coverage window for IDCODE, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* This routine reads an SPK file. */ - -/* $ Particulars */ - -/* This routine provides an API via which applications can determine */ -/* the coverage a specified SPK file provides for a specified */ -/* ephemeris object. */ - -/* $ Examples */ - -/* 1) This example demonstrates combined usage of SPKCOV and the */ -/* related SPK utility SKOBJ. */ - -/* Display the coverage for each object in a specified SPK file. */ -/* Find the set of objects in the file; for each object, find */ -/* and display the coverage. */ - - -/* PROGRAM IDCOV */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER CARDI */ -/* INTEGER WNCARD */ -/* C */ -/* C Local parameters */ -/* C */ -/* C */ -/* C Declare the coverage window. Make enough room */ -/* C for MAXIV intervals. */ -/* C */ -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXIV */ -/* PARAMETER ( MAXIV = 1000 ) */ - -/* INTEGER WINSIZ */ -/* PARAMETER ( WINSIZ = 2 * MAXIV ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER MAXOBJ */ -/* PARAMETER ( MAXOBJ = 1000 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) SPK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER I */ -/* INTEGER IDS ( LBCELL : MAXOBJ ) */ -/* INTEGER J */ -/* INTEGER NIV */ - - -/* C */ -/* C Load a leapseconds kernel for output time conversion. */ -/* C SPKCOV itself does not require a leapseconds kernel. */ -/* C */ -/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */ -/* CALL FURNSH ( LSK ) */ - -/* C */ -/* C Get name of SPK file. */ -/* C */ -/* CALL PROMPT ( 'Name of SPK file > ', SPK ) */ - -/* C */ -/* C Initialize the set IDS. */ -/* C */ -/* CALL SSIZEI ( MAXOBJ, IDS ) */ - -/* C */ -/* C Initialize the window COVER. */ -/* C */ -/* CALL SSIZED ( WINSIZ, COVER ) */ - -/* C */ -/* C Find the set of objects in the SPK file. */ -/* C */ -/* CALL SPKOBJ ( SPK, IDS ) */ - -/* C */ -/* C We want to display the coverage for each object. Loop */ -/* C over the contents of the ID code set, find the coverage */ -/* C for each item in the set, and display the coverage. */ -/* C */ -/* DO I = 1, CARDI( IDS ) */ -/* C */ -/* C Find the coverage window for the current */ -/* C object. Empty the coverage window each time */ -/* C so we don't include data for the previous object. */ -/* C */ -/* CALL SCARDD ( 0, COVER ) */ -/* CALL SPKCOV ( SPK, IDS(I), COVER ) */ - -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD ( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) '========================================' */ -/* WRITE (*,*) 'Coverage for object ', IDS(I) */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO J = 1, NIV */ -/* C */ -/* C Get the endpoints of the Jth interval. */ -/* C */ -/* CALL WNFETD ( COVER, J, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', J */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* WRITE (*,*) '========================================' */ - -/* END DO */ - -/* END */ - - -/* 2) Find the coverage for the object designated by IDCODE */ -/* provided by the set of SPK files loaded via a metakernel. */ -/* (The metakernel must also specify a leapseconds kernel.) */ - -/* PROGRAM METCOV */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER WNCARD */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 80 ) */ - -/* INTEGER MAXCOV */ -/* PARAMETER ( MAXCOV = 100000 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) FILE */ -/* CHARACTER*(LNSIZE) IDCH */ -/* CHARACTER*(FILSIZ) META */ -/* CHARACTER*(FILSIZ) SOURCE */ -/* CHARACTER*(TIMLEN) TIMSTR */ -/* CHARACTER*(LNSIZE) TYPE */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER COUNT */ -/* INTEGER HANDLE */ -/* INTEGER I */ -/* INTEGER IDCODE */ -/* INTEGER NIV */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Prompt for the metakernel name; load the metakernel. */ -/* C The metakernel lists the SPK files whose coverage */ -/* C for IDCODE we'd like to determine. The metakernel */ -/* C must also specify a leapseconds kernel. */ -/* C */ -/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */ - -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Get the ID code of interest. */ -/* C */ -/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */ - -/* CALL PRSINT ( IDCH, IDCODE ) */ - -/* C */ -/* C Initialize the coverage window. */ -/* C */ -/* CALL SSIZED ( MAXCOV, COVER ) */ - -/* C */ -/* C Find out how many kernels are loaded. Loop over the */ -/* C kernels: for each loaded SPK file, add its coverage */ -/* C for IDCODE, if any, to the coverage window. */ -/* C */ -/* CALL KTOTAL ( 'SPK', COUNT ) */ - -/* DO I = 1, COUNT */ - -/* CALL KDATA ( I, 'SPK', FILE, TYPE, */ -/* . SOURCE, HANDLE, FOUND ) */ - -/* CALL SPKCOV ( FILE, IDCODE, COVER ) */ - -/* END DO */ - -/* C */ -/* C Display results. */ -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD ( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Coverage for object ', IDCODE */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO I = 1, NIV */ -/* C */ -/* C Get the endpoints of the Ith interval. */ -/* C */ -/* CALL WNFETD ( COVER, I, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', I */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) If an error occurs while this routine is updating the window */ -/* COVER, the window may be corrupted. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */ - -/* Corrected bug in first program in header Examples section: */ -/* program now empties the coverage window prior to collecting */ -/* data for the current object. Updated examples to use WNCARD */ -/* rather than CARDD. */ - -/* - SPICELIB Version 1.0.0, 30-DEC-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get coverage window for spk object */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKCOV", (ftnlen)6); - -/* See whether GETFAT thinks we've got a binary SPK file. */ -/* If not, indicate the specific problem. */ - - getfat_(spk, arch, kertyp, spk_len, (ftnlen)80, (ftnlen)80); - if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "SPK file to be readable by this routine. If the input file " - "is an SPK file in transfer format, run TOBIN on the file to " - "convert it to binary format.", (ftnlen)207); - errch_("#", spk, (ftnlen)1, spk_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("SPKCOV", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "SPK file to be readable by this routine. Binary SPK files h" - "ave DAF architecture. If you expected the file to be a bina" - "ry SPK file, the problem may be due to the file being an old" - " non-native file lacking binary file format information. It'" - "s also possible the file has been corrupted.", (ftnlen)343); - errch_("#", spk, (ftnlen)1, spk_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22); - chkout_("SPKCOV", (ftnlen)6); - return 0; - } else if (s_cmp(kertyp, "SPK", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has file type #. The file must be a binary SPK" - " file to be readable by this routine. If you expected the fi" - "le to be a binary SPK file, the problem may be due to the fi" - "le being an old non-native file lacking binary file format i" - "nformation. It's also possible the file has been corrupted.", - (ftnlen)298); - errch_("#", spk, (ftnlen)1, spk_len); - errch_("#", kertyp, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22); - chkout_("SPKCOV", (ftnlen)6); - return 0; - } - -/* Open the file for reading. */ - - dafopr_(spk, &handle, spk_len); - if (failed_()) { - chkout_("SPKCOV", (ftnlen)6); - return 0; - } - -/* We will examine each segment descriptor in the file, and */ -/* we'll update our coverage bounds according to the data found */ -/* in these descriptors. */ - -/* Start a forward search. */ - - dafbfs_(&handle); - -/* Find the next DAF array. */ - - daffna_(&found); - while(found && ! failed_()) { - -/* Fetch and unpack the segment descriptor. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dc, ic); - if (ic[0] == *idcode) { - -/* This segment is for the body of interest. Insert the */ -/* coverage bounds into the coverage window. */ - - wninsd_(dc, &dc[1], cover); - } - daffna_(&found); - } - -/* Release the file. */ - - dafcls_(&handle); - chkout_("SPKCOV", (ftnlen)6); - return 0; -} /* spkcov_ */ - diff --git a/ext/spice/src/cspice/spkcov_c.c b/ext/spice/src/cspice/spkcov_c.c deleted file mode 100644 index bca7aa8c91..0000000000 --- a/ext/spice/src/cspice/spkcov_c.c +++ /dev/null @@ -1,478 +0,0 @@ -/* - --Procedure spkcov_c ( SPK coverage ) - --Abstract - - Find the coverage window for a specified ephemeris object in a - specified SPK file. - --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 - - CELLS - DAF - SPK - TIME - WINDOWS - --Keywords - - EPHEMERIS - TIME - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spkcov_c ( ConstSpiceChar * spk, - SpiceInt idcode, - SpiceCell * cover ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - spk I Name of SPK file. - idcode I ID code of ephemeris object. - cover O Window giving coverage in `spk' for `idcode'. - --Detailed_Input - - spk is the name of an SPK file. - - idcode is the integer ID code of an object for which - ephemeris data are expected to exist in the - specified SPK file. - - cover is an initialized CSPICE window data structure. - `cover' optionally may contain coverage data on - input; on output, the data already present in - `cover' will be combined with coverage found for the - object designated by `idcode' in the file `spk'. - - If `cover' contains no data on input, its size and - cardinality still must be initialized. - --Detailed_Output - - cover is a CSPICE window data structure which - represents the merged coverage for `idcode'. This is - the set of time intervals for which data for - `idcode' are present in the file `spk', merged with - the set of time intervals present in `cover' on - input. The merged coverage is represented as the - union of one or more disjoint time intervals. The - window `cover' contains the pairs of endpoints of - these intervals. - - The interval endpoints contained in `cover' are - ephemeris times, expressed as seconds past J2000 - TDB. - - See the Examples section below for a complete - example program showing how to retrieve the - endpoints from `cover'. - --Parameters - - None. - --Exceptions - - 1) If the input file has transfer format, the error - SPICE(INVALIDFORMAT) is signaled. - - 2) If the input file is not a transfer file but has architecture - other than DAF, the error SPICE(BADARCHTYPE) is signaled. - - 3) If the input file is a binary DAF file of type other than - SPK, the error SPICE(BADFILETYPE) is signaled. - - 4) If the SPK file cannot be opened or read, the error will - be diagnosed by routines called by this routine. The output - window will not be modified. - routines called by this routine. - - 5) If the size of the output window argument `cover' is - insufficient to contain the actual number of intervals in the - coverage window for `idcode', the error will be diagnosed by - routines called by this routine. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input - string `spk' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `spk' is null. - --Files - - This routine reads an SPK file. - --Particulars - - This routine provides an API via which applications can determine - the coverage a specified SPK file provides for a specified - ephemeris object. - --Examples - - - 1) Display the coverage for each object in a specified SPK file. - Find the set of objects in the file. Loop over the contents - of the ID code set: find the coverage for each item in the - set and display the coverage. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local parameters - ./ - #define FILSIZ 256 - #define MAXIV 1000 - #define WINSIZ ( 2 * MAXIV ) - #define TIMLEN 51 - #define MAXOBJ 1000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - SPICEINT_CELL ( ids, MAXOBJ ); - - SpiceChar lsk [ FILSIZ ]; - SpiceChar spk [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt i; - SpiceInt j; - SpiceInt niv; - SpiceInt obj; - - - /. - Load a leapseconds kernel for output time conversion. - SPKCOV itself does not require a leapseconds kernel. - ./ - prompt_c ( "Name of leapseconds kernel > ", FILSIZ, lsk ); - furnsh_c ( lsk ); - - /. - Get name of SPK file. - ./ - prompt_c ( "Name of SPK file > ", FILSIZ, spk ); - - /. - Find the set of objects in the SPK file. - ./ - spkobj_c ( spk, &ids ); - - /. - We want to display the coverage for each object. Loop over - the contents of the ID code set, find the coverage for - each item in the set, and display the coverage. - ./ - for ( i = 0; i < card_c( &ids ); i++ ) - { - /. - Find the coverage window for the current object. - Empty the coverage window each time so we don't - include data for the previous object. - ./ - obj = SPICE_CELL_ELEM_I( &ids, i ); - - scard_c ( 0, &cover ); - spkcov_c ( spk, obj, &cover ); - - /. - Get the number of intervals in the coverage window. - ./ - niv = wncard_c ( &cover ); - - /. - Display a simple banner. - ./ - printf ( "%s\n", "========================================" ); - - printf ( "Coverage for object %ld\n", obj ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( j = 0; j < niv; j++ ) - { - /. - Get the endpoints of the jth interval. - ./ - wnfetd_c ( &cover, j, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - j, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - - } - return ( 0 ); - } - - - 2) Find the coverage for the object designated by `idcode' - provided by the set of SPK files loaded via a metakernel. - (The metakernel must also specify a leapseconds kernel.) - - #include - #include "SpiceUsr.h" - - int main() - { - - /. - Local parameters - ./ - #define FILSIZ 256 - #define LNSIZE 81 - #define MAXCOV 100000 - #define WINSIZ ( 2 * MAXCOV ) - #define TIMLEN 51 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - - SpiceBoolean found; - - SpiceChar file [ FILSIZ ]; - SpiceChar idch [ LNSIZE ]; - SpiceChar meta [ FILSIZ ]; - SpiceChar source [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - SpiceChar type [ LNSIZE ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt count; - SpiceInt handle; - SpiceInt i; - SpiceInt idcode; - SpiceInt niv; - - - /. - Prompt for the metakernel name; load the metakernel. - The metakernel lists the SPK files whose coverage - for `idcode' we'd like to determine. The metakernel - must also specify a leapseconds kernel. - ./ - prompt_c ( "Name of metakernel > ", FILSIZ, meta ); - furnsh_c ( meta ); - - /. - Get the ID code of interest. - ./ - prompt_c ( "Enter ID code > ", LNSIZE, idch ); - prsint_c ( idch, &idcode ); - - /. - Find out how many kernels are loaded. Loop over the - kernels: for each loaded SPK file, add its coverage - for `idcode', if any, to the coverage window. - ./ - ktotal_c ( "SPK", &count ); - - for ( i = 0; i < count; i++ ) - { - kdata_c ( i, "SPK", FILSIZ, LNSIZE, FILSIZ, - file, type, source, &handle, &found ); - - spkcov_c ( file, idcode, &cover ); - } - - /. - Display results. - - Get the number of intervals in the coverage window. - ./ - niv = wncard_c ( &cover ); - - /. - Display a simple banner. - ./ - printf ( "\nCoverage for object %ld\n", idcode ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( i = 0; i < niv; i++ ) - { - /. - Get the endpoints of the ith interval. - ./ - wnfetd_c ( &cover, i, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - i, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - return ( 0 ); - } - - --Restrictions - - 1) If an error occurs while this routine is updating the window - `cover', the window may be corrupted. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 30-NOV-2007 (NJB) - - Corrected bug in first example program in header: - program now empties result window prior to collecting - data for each object. Deleted declaration of unused - constant NAMLEN. Updated examples to use wncard_c - rather than card_c. - - -CSPICE Version 1.0.0, 30-DEC-2004 (NJB) - --Index_Entries - - get coverage window for spk object - --& -*/ - -{ /* Begin spkcov_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "spkcov_c" ); - - - /* - Check the input string `spk' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkcov_c", spk ); - - /* - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "spkcov_c", SPICE_DP, cover ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cover ); - - /* - Call the f2c'd Fortran routine. - */ - spkcov_ ( ( char * ) spk, - ( integer * ) &idcode, - ( doublereal * ) (cover->base), - ( ftnlen ) strlen(spk) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, cover ); - } - - chkout_c ( "spkcov_c" ); - -} /* End spkcov_c */ diff --git a/ext/spice/src/cspice/spke01.c b/ext/spice/src/cspice/spke01.c deleted file mode 100644 index e60a87998f..0000000000 --- a/ext/spice/src/cspice/spke01.c +++ /dev/null @@ -1,362 +0,0 @@ -/* spke01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__15 = 15; -static integer c__45 = 45; - -/* $Procedure SPKE01 ( S/P Kernel, evaluate, type 1 ) */ -/* Subroutine */ int spke01_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* Initialized data */ - - static doublereal fc[14] = { 1. }; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static doublereal g[15]; - static integer i__, j; - static doublereal w[17], delta; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - static integer kqmax1; - static doublereal dt[45] /* was [15][3] */, wc[13]; - static integer kq[3], ks; - static doublereal tl; - static integer jx; - static doublereal tp, refvel[3], refpos[3]; - extern logical return_(void); - static integer mq2, ks1, kqq; - static doublereal sum; - -/* $ Abstract */ - -/* Evaluate a single SPK data record from a segment of type 1 */ -/* (Difference Lines). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, at which a state vector is to */ -/* be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. */ - -/* $ Detailed_Output */ - -/* STATE is the state. Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 1 (difference lines) */ -/* segments are described in the SPK Required Reading file. */ - -/* Difference lines (DL's) are generated by JPL navigation */ -/* system programs P and PV. Each data record is equivalent */ -/* to the (slightly rearranged) 'P' portion of a NAVIO PV file */ -/* data record. */ - -/* SPKE01 is a specialized version of Fred Krogh's subroutine DAINT. */ -/* Only the calling sequence has been changed. */ - -/* Because the original version was undocumented, only Fred */ -/* knows how this really works. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* Unknown. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* F.T. Krogh (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 14-FEB-1997 (WLT) */ - -/* The goto's were removed and loop and if structures */ -/* revealed. We still don't know exactly what's going */ -/* on, but at least the bones of this routine have been */ -/* cleaned off and are ready for assembly. (WLT) */ - -/* - SPICELIB Version 1.0.4, 30-OCT-1996 (WLT) */ - -/* Removed redundant SAVE statements from the declaration */ -/* section. Thanks to Steve Schlaifer for finding this */ -/* error. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK01 was removed from the Required_Reading section of the */ -/* header. The information in the SPK01 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (FTK) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_1 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - -/* The names below are original to the routine. They correspond */ -/* roughly to the original memos written by Fred Krogh to explain */ -/* how all this stuff really works. */ - - -/* Save everything between calls. */ - - -/* If the RETURN function is set, don't even bother with this. */ - - if (return_()) { - return 0; - } - -/* Unpack the contents of the MDA array. */ - -/* Name Dimension Description */ -/* ------ --------- ------------------------------- */ -/* TL 1 Final epoch of record */ -/* G 15 Stepsize function vector */ -/* REFPOS 3 Reference position vector */ -/* REFVEL 3 Reference velocity vector */ -/* DT 15,NTE Modified divided difference arrays */ -/* KQMAX1 1 Maximum integration order plus 1 */ -/* KQ NTE Integration order array */ - -/* For our purposes, NTE is always 3. */ - - moved_(record, &c__1, &tl); - moved_(&record[1], &c__15, g); - -/* Collect the reference position and velocity. */ - - refpos[0] = record[16]; - refvel[0] = record[17]; - refpos[1] = record[18]; - refvel[1] = record[19]; - refpos[2] = record[20]; - refvel[2] = record[21]; - moved_(&record[22], &c__45, dt); - kqmax1 = (integer) record[67]; - kq[0] = (integer) record[68]; - kq[1] = (integer) record[69]; - kq[2] = (integer) record[70]; - -/* Next we set up for the computation of the various differences */ - - delta = *et - tl; - tp = delta; - mq2 = kqmax1 - 2; - ks = kqmax1 - 1; - -/* This is clearly collecting some kind of coefficients. */ -/* The problem is that we have no idea what they are... */ - -/* The G coefficients are supposed to be some kind of step size */ -/* vector. */ - -/* TP starts out as the delta t between the request time */ -/* and the time for which we last had a state in the MDL file. */ -/* We then change it from DELTA by the components of the stepsize */ -/* vector G. */ - - i__1 = mq2; - for (j = 1; j <= i__1; ++j) { - fc[(i__2 = j) < 14 && 0 <= i__2 ? i__2 : s_rnge("fc", i__2, "spke01_", - (ftnlen)267)] = tp / g[(i__3 = j - 1) < 15 && 0 <= i__3 ? - i__3 : s_rnge("g", i__3, "spke01_", (ftnlen)267)]; - wc[(i__2 = j - 1) < 13 && 0 <= i__2 ? i__2 : s_rnge("wc", i__2, "spk" - "e01_", (ftnlen)268)] = delta / g[(i__3 = j - 1) < 15 && 0 <= - i__3 ? i__3 : s_rnge("g", i__3, "spke01_", (ftnlen)268)]; - tp = delta + g[(i__2 = j - 1) < 15 && 0 <= i__2 ? i__2 : s_rnge("g", - i__2, "spke01_", (ftnlen)269)]; - } - -/* Collect KQMAX1 reciprocals. */ - - i__1 = kqmax1; - for (j = 1; j <= i__1; ++j) { - w[(i__2 = j - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("w", i__2, "spke0" - "1_", (ftnlen)276)] = 1. / (doublereal) j; - } - -/* Compute the W(K) terms needed for the position interpolation */ -/* (Note, it is assumed throughout this routine that KS, which */ -/* starts out as KQMAX1-1 (the ``maximum integration'') */ -/* is at least 2. */ - - jx = 0; - ks1 = ks - 1; - while(ks >= 2) { - ++jx; - i__1 = jx; - for (j = 1; j <= i__1; ++j) { - w[(i__2 = j + ks - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("w", i__2, - "spke01_", (ftnlen)293)] = fc[(i__3 = j) < 14 && 0 <= - i__3 ? i__3 : s_rnge("fc", i__3, "spke01_", (ftnlen)293)] - * w[(i__4 = j + ks1 - 1) < 17 && 0 <= i__4 ? i__4 : - s_rnge("w", i__4, "spke01_", (ftnlen)293)] - wc[(i__5 = j - - 1) < 13 && 0 <= i__5 ? i__5 : s_rnge("wc", i__5, "spke" - "01_", (ftnlen)293)] * w[(i__6 = j + ks - 1) < 17 && 0 <= - i__6 ? i__6 : s_rnge("w", i__6, "spke01_", (ftnlen)293)]; - } - ks = ks1; - --ks1; - } - -/* Perform position interpolation: (Note that KS = 1 right now. */ -/* We don't know much more than that.) */ - - for (i__ = 1; i__ <= 3; ++i__) { - kqq = kq[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("kq", i__1, - "spke01_", (ftnlen)307)]; - sum = 0.; - for (j = kqq; j >= 1; --j) { - sum += dt[(i__1 = j + i__ * 15 - 16) < 45 && 0 <= i__1 ? i__1 : - s_rnge("dt", i__1, "spke01_", (ftnlen)311)] * w[(i__2 = j - + ks - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("w", i__2, - "spke01_", (ftnlen)311)]; - } - state[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke01_", (ftnlen)314)] = refpos[(i__2 = i__ - 1) < 3 && 0 - <= i__2 ? i__2 : s_rnge("refpos", i__2, "spke01_", (ftnlen) - 314)] + delta * (refvel[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? - i__3 : s_rnge("refvel", i__3, "spke01_", (ftnlen)314)] + - delta * sum); - } - -/* Again we need to compute the W(K) coefficients that are */ -/* going to be used in the velocity interpolation. */ -/* (Note, at this point, KS = 1, KS1 = 0.) */ - - i__1 = jx; - for (j = 1; j <= i__1; ++j) { - w[(i__2 = j + ks - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("w", i__2, - "spke01_", (ftnlen)324)] = fc[(i__3 = j) < 14 && 0 <= i__3 ? - i__3 : s_rnge("fc", i__3, "spke01_", (ftnlen)324)] * w[(i__4 = - j + ks1 - 1) < 17 && 0 <= i__4 ? i__4 : s_rnge("w", i__4, - "spke01_", (ftnlen)324)] - wc[(i__5 = j - 1) < 13 && 0 <= - i__5 ? i__5 : s_rnge("wc", i__5, "spke01_", (ftnlen)324)] * w[ - (i__6 = j + ks - 1) < 17 && 0 <= i__6 ? i__6 : s_rnge("w", - i__6, "spke01_", (ftnlen)324)]; - } - --ks; - -/* Perform velocity interpolation: */ - - for (i__ = 1; i__ <= 3; ++i__) { - kqq = kq[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("kq", i__1, - "spke01_", (ftnlen)334)]; - sum = 0.; - for (j = kqq; j >= 1; --j) { - sum += dt[(i__1 = j + i__ * 15 - 16) < 45 && 0 <= i__1 ? i__1 : - s_rnge("dt", i__1, "spke01_", (ftnlen)338)] * w[(i__2 = j - + ks - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("w", i__2, - "spke01_", (ftnlen)338)]; - } - state[(i__1 = i__ + 2) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke01_", (ftnlen)341)] = refvel[(i__2 = i__ - 1) < 3 && 0 - <= i__2 ? i__2 : s_rnge("refvel", i__2, "spke01_", (ftnlen) - 341)] + delta * sum; - } - -/* That's all folks. We don't know why we did anything, but */ -/* at least we can tell structurally what we did. */ - - return 0; -} /* spke01_ */ - diff --git a/ext/spice/src/cspice/spke02.c b/ext/spice/src/cspice/spke02.c deleted file mode 100644 index c07077b46f..0000000000 --- a/ext/spice/src/cspice/spke02.c +++ /dev/null @@ -1,248 +0,0 @@ -/* spke02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE02 ( Evaluate Chebyshev polynomials, type 2 ) */ - -/* Subroutine */ int spke02_(doublereal *et, doublereal *record, doublereal * - xyzdot) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer degp, ncof, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer cofloc; - extern /* Subroutine */ int chbint_(doublereal *, integer *, doublereal *, - doublereal *, doublereal *, doublereal *), chkout_(char *, - ftnlen); - extern logical return_(void); - - -/* $ Abstract */ - -/* Evaluate a single data record from an PCK or SPK segment of type 2 */ -/* (Chebyshev Polynomials, 3 components). */ - -/* $ 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 */ - -/* SPK */ -/* PCK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ - - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I Data record. */ -/* XYZDOT O 3 components and their derivatives. */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, at which a state vector is to */ -/* be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the 3 component and their derivatives. */ - -/* $ Detailed_Output */ - -/* XYZDOT is a 6-vector. In order, X, Y, Z, X', Y', and Z'. */ -/* Units for state evaluations will be km and km/sec. */ -/* Units for angles will be radians and radians/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 2 (Chebyshev polynomials, */ -/* position only) segments are described in the SPK and PCK Required */ -/* Reading file. */ - -/* A type 2 segment contains three sets of Chebyshev coefficients, */ -/* one set each for components X, Y, and Z. SPKE02 */ -/* calls the routine CHBINT for each set to evalute the polynomial */ -/* AND its first derivative (which it computes internally) at the */ -/* input epoch, thereby arriving at the complete state. */ - -/* $ Examples */ - -/* The data returned by the routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 2 ) THEN */ - -/* CALL SPKR02 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE02 ( ET, RECORD, XYZDOT ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.4, 22-MAR-1994 (KSZ) */ - -/* Comments changed so this can be used as */ -/* a generic Chebyshev evaluator, rather than just for */ -/* SPK type 2 files. (KSZ) */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK02 was removed from the Required_Reading section of the */ -/* header. The information in the SPK02 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ - -/* $ Index_Entries */ - -/* evaluate type_2 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKE02", (ftnlen)6); - } - -/* The first number in the record is the record size. Following it */ -/* are two numbers that will be used later, then the three sets of */ -/* coefficients. The number of coefficients for each variable can */ -/* be determined from the record size, since there are the same */ -/* number of coefficients for each variable. */ - - ncof = ((integer) record[0] - 2) / 3; - -/* The degree of each polynomial is one less than the number of */ -/* coefficients. */ - - degp = ncof - 1; - -/* Call CHBINT once for each variable to evaluate the position */ -/* and velocity values. */ - - for (i__ = 1; i__ <= 3; ++i__) { - -/* The coefficients for each variable are located contiguously, */ -/* following the first three words in the record. */ - - cofloc = ncof * (i__ - 1) + 4; - -/* CHBINT needs as input the coefficients, the degree of the */ -/* polynomial, the epoch, and also two variable transformation */ -/* parameters, which are located, in our case, in the second and */ -/* third slots of the record. */ - - chbint_(&record[cofloc - 1], °p, &record[1], et, &xyzdot[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("xyzdot", i__1, - "spke02_", (ftnlen)234)], &xyzdot[(i__2 = i__ + 2) < 6 && 0 <= - i__2 ? i__2 : s_rnge("xyzdot", i__2, "spke02_", (ftnlen)234)] - ); - } - chkout_("SPKE02", (ftnlen)6); - return 0; -} /* spke02_ */ - diff --git a/ext/spice/src/cspice/spke03.c b/ext/spice/src/cspice/spke03.c deleted file mode 100644 index aca7a4bfc0..0000000000 --- a/ext/spice/src/cspice/spke03.c +++ /dev/null @@ -1,239 +0,0 @@ -/* spke03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE03 ( S/P Kernel, evaluate, type 3 ) */ -/* Subroutine */ int spke03_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer degp, ncof, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), chbval_(doublereal *, - integer *, doublereal *, doublereal *, doublereal *); - integer cofloc; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Evaluate a single SPK data record from a segment of type 3 */ -/* (Chebyshev Polynomials, position and velocity). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, at which a state vector is to */ -/* be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. */ - -/* $ Detailed_Output */ - -/* STATE is the state. In order, X, Y, Z, X', Y', and Z'. */ -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 3 (Chebyshev polynomials, */ -/* position and velocity) segments are described in the SPK */ -/* Required Reading file. */ - -/* A type 3 segment contains six sets of Chebyshev coefficients, */ -/* one set each for the position coordinates X, Y, and Z, and one */ -/* set each for the velocity coordinates X', Y', and Z'. SPKE03 */ -/* calls the routine CHBVAL to evalute each polynomial, and arrive */ -/* at the complete state. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 3 ) THEN */ - -/* CALL SPKR03 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE03 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK03 was removed from the Required_Reading section of the */ -/* header. The information in the SPK03 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_3 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKE03", (ftnlen)6); - } - -/* The first number in the record is the record size. Following it */ -/* are two numbers that will be used later, then the six sets of */ -/* coefficients. The number of coefficients for each quantity can */ -/* be determined from the record size, since there are the same */ -/* number of coefficients for each quantity. */ - - ncof = ((integer) record[0] - 2) / 6; - -/* The degree of each polynomial is one less than the number of */ -/* coefficients. */ - - degp = ncof - 1; - -/* Call CHBVAL once for each quantity to evaluate the position */ -/* and velocity values. */ - - for (i__ = 1; i__ <= 6; ++i__) { - -/* The coefficients for each variable are located contiguously, */ -/* following the first three words in the record. */ - - cofloc = ncof * (i__ - 1) + 4; - -/* CHBVAL needs as input the coefficients, the degree of the */ -/* polynomial, the epoch, and also two variable transformation */ -/* parameters, which are located, in our case, in the second and */ -/* third slots of the record. */ - - chbval_(&record[cofloc - 1], °p, &record[1], et, &state[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke03_", (ftnlen)236)]); - } - chkout_("SPKE03", (ftnlen)6); - return 0; -} /* spke03_ */ - diff --git a/ext/spice/src/cspice/spke05.c b/ext/spice/src/cspice/spke05.c deleted file mode 100644 index 7f438983db..0000000000 --- a/ext/spice/src/cspice/spke05.c +++ /dev/null @@ -1,328 +0,0 @@ -/* spke05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__12 = 12; -static integer c__6 = 6; - -/* $Procedure SPKE05 ( Evaluate SPK record, type 5 ) */ -/* Subroutine */ int spke05_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal dwdt; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal w; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - doublereal vcomp[3], numer, s1[6], s2[6], t1, t2; - extern /* Subroutine */ int prop2b_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal gm; - extern doublereal pi_(void); - doublereal dargdt, pv[12] /* was [6][2] */; - extern /* Subroutine */ int vlcomg_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *), chkout_(char *, - ftnlen); - extern logical return_(void); - doublereal arg, vel[3]; - -/* $ Abstract */ - -/* Evaluate a single SPK data record from a segment of type 5 */ -/* (two body propagation between discrete state vectors). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, specified as ephemeris seconds past */ -/* J2000, at which a state vector is to be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. */ - -/* The structure of RECORD is: */ - -/* RECORD(1) */ -/* . state of the body at epoch 1. */ -/* . */ -/* . */ -/* RECORD(6) */ - -/* RECORD(7) */ -/* . */ -/* . state of the body at epoch 2. */ -/* . */ -/* RECORD(12) */ -/* RECORD(13) epoch 1 in seconds past 2000. */ -/* RECORD(14) epoch 2 in seconds past 2000. */ -/* RECORD(15) GM for the center of motion. */ - -/* Epoch 1 and epoch 2 are the times in the segment that */ -/* bracket ET. If ET is less than the first time in the */ -/* segment then both epochs 1 and 2 are equal to the */ -/* first time. And if ET is greater than the last time */ -/* then, epochs 1 and 2 are set equal to this last time. */ - -/* $ Detailed_Output */ - -/* STATE is the state produced by evaluating RECORD at ET. */ -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there is a problem propagating, subject to the laws of two */ -/* body motion, either of the states from RECORD to the requested */ -/* time ET, an error will be signalled by the routine PROP2B. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine interpolates a state from the two reference states */ -/* contained in RECORD. */ - -/* It is assumed that this routine is used in conjunction with */ -/* the routine SPKR05 as shown here: */ - -/* CALL SPKR05 ( HANDLE, DESCR, ET, RECORD ) */ -/* CALL SPKE05 ( ET, RECORD, STATE ) */ - -/* Where it is known in advance that the HANDLE, DESCR pair points */ -/* to a type 05 data segment. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 5 ) THEN */ - -/* CALL SPKR05 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE05 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD call. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_5 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD call. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKE05", (ftnlen)6); - } - -/* Unpack the record, for easier reading. */ - - moved_(record, &c__12, pv); - t1 = record[12]; - t2 = record[13]; - gm = record[14]; - -/* Evaluate the two states. Call them s_1(t) and s_2(t). */ -/* Let the position and velocity components be: p_1, v_1, p_2, v_2. */ - -/* The final position is a weighted average. */ - -/* Let */ - -/* W(t) = 0.5 + 0.5*COS( PI*(t-t1)/(t2-t1) ) */ - -/* then */ - -/* p = W(t)*p_1(t) + (1 - W(t))*p_2(t) */ -/* v = W(t)*v_1(t) + (1 - W(t))*v_2(t) + W'(t)*(p_1(t) - p_2(t)) */ - -/* If t1 = t2, the state is just s(t1). */ - - -/* Note: there are a number of weighting schemes we could have */ -/* used. This one has the nice property that */ - -/* The graph of W is symmetric about the point */ - - -/* ( (t1+t2)/2, W( (t1+t2)/2 ) */ - -/* The range of W is from 1 to 0. And the derivative of W is */ -/* symmetric and zero at both t1 and t2. */ - - - if (t1 != t2) { - d__1 = *et - t1; - prop2b_(&gm, pv, &d__1, s1); - d__1 = *et - t2; - prop2b_(&gm, &pv[6], &d__1, s2); - numer = *et - t1; - denom = t2 - t1; - arg = numer * pi_() / denom; - dargdt = pi_() / denom; - w = cos(arg) * .5 + .5; - dwdt = sin(arg) * -.5 * dargdt; - d__1 = 1. - w; - vlcomg_(&c__6, &w, s1, &d__1, s2, state); - d__1 = -dwdt; - vlcom_(&dwdt, s1, &d__1, s2, vcomp); - vadd_(&state[3], vcomp, vel); - vequ_(vel, &state[3]); - } else { - d__1 = *et - t1; - prop2b_(&gm, pv, &d__1, state); - } - chkout_("SPKE05", (ftnlen)6); - return 0; -} /* spke05_ */ - diff --git a/ext/spice/src/cspice/spke08.c b/ext/spice/src/cspice/spke08.c deleted file mode 100644 index e7b3f5dfbe..0000000000 --- a/ext/spice/src/cspice/spke08.c +++ /dev/null @@ -1,327 +0,0 @@ -/* spke08.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure SPKE08 ( S/P Kernel, evaluate, type 8 ) */ -/* Subroutine */ int spke08_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, n; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal locrec[129]; - extern doublereal lgresp_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int xposeg_(doublereal *, integer *, integer *, - doublereal *); - extern logical return_(void); - integer ystart; - -/* $ Abstract */ - -/* Evaluate a single SPK data record from a segment of type 8 */ -/* (equally spaced discrete states, interpolated by Lagrange */ -/* polynomials). */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare SPK data record size. This record is declared in */ -/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */ -/* (SPKExx) routines. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* 1) If new SPK types are added, it may be necessary to */ -/* increase the size of this record. The header of SPKPVN */ -/* should be updated as well to show the record size */ -/* requirement for each data type. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */ - -/* -& */ - -/* End include file spkrec.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I-O Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, at which a state vector is to */ -/* be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. Normally, the caller of this routine */ -/* will obtain RECORD by calling SPKR08. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | start epoch | */ -/* +----------------------+ */ -/* | step size | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ - -/* $ Detailed_Output */ - -/* RECORD is the input record, modified by use as a work area. */ -/* On output, RECORD no longer contains useful */ -/* information. */ - -/* STATE is the state. In order, the elements are */ - -/* X, Y, Z, X', Y', and Z' */ - -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The caller of this routine must ensure that the input record */ -/* is appropriate for the supplied ET value. Otherwise, */ -/* arithmetic overflow may result. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 8 (equally spaced discrete */ -/* states, interpolated by Lagrange polynomials) segments are */ -/* described in the SPK Required Reading file. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 8 ) THEN */ - -/* CALL SPKR08 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE08 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in XPOSEG and LGRESP calls. */ - -/* - SPICELIB Version 1.0.0, 14-AUG-1993 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_8 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 25-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in XPOSEG and LGRESP calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Size of a state vector: */ - - -/* Indices of input record elements: */ - -/* -- size */ -/* -- start epoch */ -/* -- step size */ -/* -- start of state information */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - -/* We'll transpose the state information in the input record */ -/* so that contiguous pieces of it can be shoved directly into the */ -/* interpolation routine LGRESP. */ - - n = i_dnnt(record); - xposeg_(&record[3], &c__6, &n, locrec); - i__1 = n * 6; - moved_(locrec, &i__1, &record[3]); - -/* We interpolate each state component in turn. */ - - for (i__ = 1; i__ <= 6; ++i__) { - ystart = n * (i__ - 1) + 4; - state[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke08_", (ftnlen)274)] = lgresp_(&n, &record[1], &record[2] - , &record[ystart - 1], locrec, et); - } - return 0; -} /* spke08_ */ - diff --git a/ext/spice/src/cspice/spke09.c b/ext/spice/src/cspice/spke09.c deleted file mode 100644 index 2385e9bec8..0000000000 --- a/ext/spice/src/cspice/spke09.c +++ /dev/null @@ -1,323 +0,0 @@ -/* spke09.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure SPKE09 ( S/P Kernel, evaluate, type 9 ) */ -/* Subroutine */ int spke09_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, n; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal locrec[129]; - extern doublereal lgrint_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *); - extern /* Subroutine */ int xposeg_(doublereal *, integer *, integer *, - doublereal *); - extern logical return_(void); - integer xstart, ystart; - -/* $ Abstract */ - -/* Evaluate a single SPK data record from a segment of type 9 */ -/* (discrete states, evaluated by Lagrange interpolation). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare SPK data record size. This record is declared in */ -/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */ -/* (SPKExx) routines. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* 1) If new SPK types are added, it may be necessary to */ -/* increase the size of this record. The header of SPKPVN */ -/* should be updated as well to show the record size */ -/* requirement for each data type. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */ - -/* -& */ - -/* End include file spkrec.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I-O Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, at which a state vector is to */ -/* be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. Normally, the caller of this routine */ -/* will obtain RECORD by calling SPKR09. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* $ Detailed_Output */ - -/* RECORD is the input record, modified by use as a work area. */ -/* On output, RECORD no longer contains useful */ -/* information. */ - -/* STATE is the state. In order, the elements are */ - -/* X, Y, Z, X', Y', and Z' */ - -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The caller of this routine must ensure that the input record */ -/* is appropriate for the supplied ET value. Otherwise, */ -/* arithmetic overflow may result. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 9 (unequally spaced */ -/* discrete states, evaluated by Lagrange interpolation) segments are */ -/* described in the SPK Required Reading file. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 9 ) THEN */ - -/* CALL SPKR09 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE09 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in XPOSEG and LGRINT calls. */ - -/* - SPICELIB Version 1.0.0, 14-AUG-1993 (NJB) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_9 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in XPOSEG and LGRINT calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of input record elements: */ - -/* -- size */ -/* -- start of state information */ - - -/* Local variables */ - - -/* Discovery check-in. */ - - if (return_()) { - return 0; - } - -/* We'll transpose the state information in the input record */ -/* so that contiguous pieces of it can be shoved directly into the */ -/* interpolation routine LGRINT. We allow LGRINT to overwrite the */ -/* state values in the input record, since this saves local storage */ -/* and does no harm. (See the header of LGRINT for a description of */ -/* its work space usage.) */ - - n = i_dnnt(record); - xposeg_(&record[1], &c__6, &n, locrec); - i__1 = n * 6; - moved_(locrec, &i__1, &record[1]); - -/* We interpolate each state component in turn. */ - - xstart = n * 6 + 2; - for (i__ = 1; i__ <= 6; ++i__) { - ystart = n * (i__ - 1) + 2; - state[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke09_", (ftnlen)261)] = lgrint_(&n, &record[xstart - 1], & - record[ystart - 1], locrec, et); - } - return 0; -} /* spke09_ */ - diff --git a/ext/spice/src/cspice/spke10.c b/ext/spice/src/cspice/spke10.c deleted file mode 100644 index 171c1f3de7..0000000000 --- a/ext/spice/src/cspice/spke10.c +++ /dev/null @@ -1,485 +0,0 @@ -/* spke10.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__6 = 6; - -/* $Procedure SPKE10 ( Evaluate SPK record, type 10 ) */ -/* Subroutine */ int spke10_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - static doublereal dmob, dwdt, mypi; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mtxv_( - doublereal *, doublereal *, doublereal *), zzmobliq_(doublereal *, - doublereal *, doublereal *), eul2m_(doublereal *, doublereal *, - doublereal *, integer *, integer *, integer *, doublereal *); - static doublereal my2pi; - extern /* Subroutine */ int zzeprcss_(doublereal *, doublereal *); - static doublereal m[9] /* was [3][3] */, w; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static doublereal denom, precm[9] /* was [3][3] */; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - static doublereal nuobl; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - static doublereal vcomp[3], numer, nulon, n0; - extern doublereal twopi_(void); - static doublereal s1[6], s2[6], t1, t2; - extern /* Subroutine */ int ev2lin_(doublereal *, doublereal *, - doublereal *, doublereal *); - static doublereal nuobl1, nuobl2, nulon1, nulon2; - extern doublereal pi_(void); - static doublereal dargdt; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int dpspce_(doublereal *, doublereal *, - doublereal *, doublereal *); - static doublereal fivday, mnrate; - extern /* Subroutine */ int vlcomg_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *), chkout_(char *, - ftnlen); - static logical loworb; - static doublereal dt1, dt2, tmpsta[6]; - extern logical return_(void); - static doublereal arg, mob; - extern doublereal spd_(void); - -/* $ Abstract */ - -/* Evaluate a single SPK data record from a segment of type 10 */ -/* (NORAD two-line element sets.). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECORD I Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, specified as ephemeris seconds past */ -/* J2000, at which a state vector is to be computed. */ - -/* RECORD is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. */ - -/* The structure of RECORD is: */ - -/* RECORD(1) */ -/* . Geophysical Constants such as */ -/* . GM, J2, J3, J4, etc. */ -/* . */ -/* RECORD(NGEOCN) */ - -/* RECORD(NGEOCN + 1) */ -/* . */ -/* . elements and epoch for the body */ -/* . at epoch 1. */ -/* . */ -/* RECORD(NGEOCN + NELEMN ) */ - -/* RECORD(NGEOCN + NELEMN + 1) */ -/* . */ -/* . elements and epoch for the body */ -/* . at epoch 2. */ -/* . */ -/* RECORD(NGEOCN + 2*NELEMN ) */ - -/* Epoch 1 and epoch 2 are the times in the segment that */ -/* bracket ET. If ET is less than the first time in the */ -/* segment then both epochs 1 and 2 are equal to the */ -/* first time. And if ET is greater than the last time */ -/* then, epochs 1 and 2 are set equal to this last time. */ - -/* $ Detailed_Output */ - -/* STATE is the state produced by evaluating RECORD at ET. */ -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there is a problem evaluating the two-line elements, */ -/* the error will be diagnosed by EV2LIN. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine interpolates a state from the two reference sets */ -/* of two-line element sets contained in RECORD. */ - -/* It is assumed that this routine is used in conjunction with */ -/* the routine SPKR10 as shown here: */ - -/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */ -/* CALL SPKE10 ( ET, RECORD, STATE ) */ - -/* Where it is known in advance that the HANDLE, DESCR pair points */ -/* to a type 10 data segment. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 10 ) THEN */ - -/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE10 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 01-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MTXV and VADD calls. */ - -/* - SPICELIB Version 1.0.0 18-JUL-1997 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_10 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 01-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MTXV and VADD calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - - -/* The following parameters give the location of the various */ -/* geophysical parameters needed for the two line element */ -/* sets. We need these only so that we can count how many there */ -/* are (NGEOCN). */ - -/* KJ2 --- location of J2 */ -/* KJ3 --- location of J3 */ -/* KJ4 --- location if J4 */ -/* KKE --- location of KE = sqrt(GM) in eart-radii**1.5/MIN */ -/* KQO --- upper bound of atmospheric model in KM */ -/* KSO --- lower bound of atmospheric model in KM */ -/* KER --- earth equatorial radius in KM. */ -/* KAE --- distance units/earth radius */ - - - -/* An enumeration of the various components of the */ -/* a two-line element set. These are needed so that we */ -/* can locate the epochs in the two sets and so that */ -/* we can count the number of elements in a two-line */ -/* element set. */ - -/* KNDT20 */ -/* KNDD60 */ -/* KBSTAR */ -/* KINCL */ -/* KNODE0 */ -/* KECC */ -/* KOMEGA */ -/* KMO */ -/* KNO */ -/* KEPOCH */ - - -/* The nutation in obliquity and longitude as well as their rates */ -/* follow the elements. So we've got four angles/angle rates */ -/* following the elements */ - - -/* The locations of the epochs and the starts of the element */ -/* sets are given below. */ - - -/* The parameters below give the location of the nutation terms */ -/* and their rates for the first packet. */ - - -/* The parameters below give the location of the nutation terms */ -/* and their rates for the second packet. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKE10", (ftnlen)6); - } - if (first) { - first = FALSE_; - mypi = pi_(); - my2pi = twopi_(); - fivday = spd_() * 5.; - } - -/* Fetch the mean motion from the first set of two-line elements */ -/* stored in the record. */ - - n0 = record[16]; - mnrate = my2pi / 225.; - loworb = n0 >= mnrate; - -/* Fetch the two epochs stored in the record. */ - - t1 = record[17]; - t2 = record[31]; - -/* Evaluate the two states. Call them s_1(t) and s_2(t). */ -/* Let the position and velocity components be: p_1, v_1, p_2, v_2. */ - -/* The final position is a weighted average. */ - -/* Let */ - -/* W(t) = 0.5 + 0.5*COS( PI*(t-t1)/(t2-t1) ) */ - -/* then */ - -/* p = W(t)*p_1(t) + (1 - W(t))*p_2(t) */ -/* v = W(t)*v_1(t) + (1 - W(t))*v_2(t) + W'(t)*(p_1(t) - p_2(t)) */ - -/* If t1 = t2, the state is just s(t1). */ - - -/* Note: there are a number of weighting schemes we could have */ -/* used. This one has the nice property that */ - -/* The graph of W is symmetric about the point */ - - -/* ( (t1+t2)/2, W( (t1+t2)/2 ) */ - -/* The range of W is from 1 to 0. And the derivative of W is */ -/* symmetric and zero at both t1 and t2. */ - - if (t1 != t2) { - if (loworb) { - ev2lin_(et, record, &record[8], s1); - ev2lin_(et, record, &record[22], s2); - } else { - dpspce_(et, record, &record[8], s1); - dpspce_(et, record, &record[22], s2); - } - -/* Using the different element packets compute nutations in */ -/* obliquity and longitude. Note to avoid run-away nutation */ -/* interpolation we bracket DT1 and DT2 to be between -5 and 5 */ -/* days. */ - - d__1 = *et - t1; - d__2 = -fivday; - dt1 = brcktd_(&d__1, &d__2, &fivday); - nuobl1 = record[18] + dt1 * record[20]; - nulon1 = record[19] + dt1 * record[21]; - d__1 = *et - t2; - d__2 = -fivday; - dt2 = brcktd_(&d__1, &d__2, &fivday); - nuobl2 = record[32] + dt2 * record[34]; - nulon2 = record[33] + dt2 * record[35]; - -/* Compute the weighting function that we'll need later */ -/* when we combine states 1 and 2. */ - - numer = *et - t1; - denom = t2 - t1; - arg = numer * mypi / denom; - dargdt = mypi / denom; - w = cos(arg) * .5 + .5; - dwdt = sin(arg) * -.5 * dargdt; - -/* Use the weighting function to compute the nutation in obliquity */ -/* longitude. */ - - nuobl = w * nuobl1 + (1. - w) * nuobl2; - nulon = w * nulon1 + (1. - w) * nulon2; - -/* Compute the mean obliquity at the epoch ET. */ - - zzmobliq_(et, &mob, &dmob); - -/* Construct the transformation from mean of date to true of date. */ - - d__1 = -mob - nuobl; - d__2 = -nulon; - eul2m_(&d__1, &d__2, &mob, &c__1, &c__3, &c__1, m); - -/* Use the transpose of the matrix just computed to convert */ -/* S1 and S2 from true of date to mean of date. */ - - mtxv_(m, s1, tmpsta); - mtxv_(m, &s1[3], &tmpsta[3]); - moved_(tmpsta, &c__6, s1); - mtxv_(m, s2, tmpsta); - mtxv_(m, &s2[3], &tmpsta[3]); - moved_(tmpsta, &c__6, s2); - -/* Now compute the weighted average of the two true of date */ -/* states. */ - - d__1 = 1. - w; - vlcomg_(&c__6, &w, s1, &d__1, s2, state); - d__1 = -dwdt; - vlcom_(&dwdt, s1, &d__1, s2, vcomp); - vadd_(&state[3], vcomp, &tmpsta[3]); - vequ_(&tmpsta[3], &state[3]); - } else { - if (loworb) { - ev2lin_(et, record, &record[8], state); - } else { - dpspce_(et, record, &record[8], state); - } - -/* Interpolate the nutation in longitude and obliquity. Note */ -/* that to avoid run-away linear interpolation of the nutation */ -/* angles, we bracket DT1 to be between -5 and 5 days. */ - - d__1 = *et - t1; - d__2 = -fivday; - dt1 = brcktd_(&d__1, &d__2, &fivday); - nuobl = record[18] + dt1 * record[20]; - nulon = record[19] + dt1 * record[21]; - -/* Get the current obliquity. */ - - zzmobliq_(et, &mob, &dmob); - d__1 = -mob - nuobl; - d__2 = -nulon; - eul2m_(&d__1, &d__2, &mob, &c__1, &c__3, &c__1, m); - mtxv_(m, state, tmpsta); - mtxv_(m, &state[3], &tmpsta[3]); - moved_(tmpsta, &c__6, state); - } - -/* Finally, convert the mean of date state to J2000. First get */ -/* the rotation from J2000 to mean of date. */ - - zzeprcss_(et, precm); - -/* Now convert STATE to J2000. */ - - mtxv_(precm, state, tmpsta); - mtxv_(precm, &state[3], &tmpsta[3]); - moved_(tmpsta, &c__6, state); - chkout_("SPKE10", (ftnlen)6); - return 0; -} /* spke10_ */ - diff --git a/ext/spice/src/cspice/spke12.c b/ext/spice/src/cspice/spke12.c deleted file mode 100644 index f4bfd8cf88..0000000000 --- a/ext/spice/src/cspice/spke12.c +++ /dev/null @@ -1,245 +0,0 @@ -/* spke12.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE12 ( S/P Kernel, evaluate, type 12 ) */ -/* Subroutine */ int spke12_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer from; - doublereal work[516] /* was [258][2] */; - integer i__, j, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer to; - doublereal locrec[129]; - extern /* Subroutine */ int chkout_(char *, ftnlen), hrmesp_(integer *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *); - extern logical return_(void); - integer xstart; - -/* $ Abstract */ - -/* Evaluate a single data record from a type 12 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MAXREC P Maximum size of SPK record. See SPKPVN. */ -/* ET I Epoch for which a state is desired. */ -/* RECORD I Record from a type 12 SPK segment valid for ET. */ -/* STATE O State (position and velocity) at epoch ET. */ - -/* $ Detailed_Input */ - -/* ET is the epoch for which a state vector is desired. */ - -/* RECORD is a record from a type 12 SPK segment which, when */ -/* evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative to */ -/* some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | start epoch | */ -/* +----------------------+ */ -/* | step size | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ - - -/* $ Detailed_Output */ - -/* STATE is the state vector at epoch ET. Its contents are, in */ -/* order, X, Y, Z, X', Y', and Z'. Units are km and km/sec. */ - -/* $ Parameters */ - -/* MAXREC is the maximum size of SPK record. See the SPICELIB */ -/* routine SPKPVN for details. */ - -/* $ Exceptions */ - -/* None. This routine assumes that the input record is valid. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 12 (unequally spaced */ -/* discrete states, evaluated by Hermite interpolation) SPK segments */ -/* is described in the SPK Required Reading. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch before evaluating the record to obtain a */ -/* state vector, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 12 ) THEN */ - -/* CALL SPKR12 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE12 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the input record is valid. Any */ -/* checking of the input data is assumed to have been performed */ -/* when the source SPK file was created. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-1999 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_12 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKE12", (ftnlen)6); - n = i_dnnt(record); - -/* We interpolate each state component in turn. */ - - xstart = n * 6 + 2; - for (i__ = 1; i__ <= 3; ++i__) { - i__1 = n; - for (j = 1; j <= i__1; ++j) { - -/* For the Jth input state vector, copy the Ith position and */ -/* velocity components into the local record buffer LOCREC. */ - - from = (j - 1) * 6 + 3 + i__; - to = (j << 1) - 1; - locrec[(i__2 = to - 1) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec" - , i__2, "spke12_", (ftnlen)247)] = record[from - 1]; - locrec[(i__2 = to) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec", - i__2, "spke12_", (ftnlen)248)] = record[from + 2]; - } - -/* Interpolate the Ith position and velocity components of the */ -/* state. */ - - hrmesp_(&n, &record[1], &record[2], locrec, et, work, &state[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke12_", (ftnlen)256)], &state[(i__2 = i__ + 2) < 6 && 0 <= - i__2 ? i__2 : s_rnge("state", i__2, "spke12_", (ftnlen)256)]); - } - chkout_("SPKE12", (ftnlen)6); - return 0; -} /* spke12_ */ - diff --git a/ext/spice/src/cspice/spke13.c b/ext/spice/src/cspice/spke13.c deleted file mode 100644 index c189d7d6e2..0000000000 --- a/ext/spice/src/cspice/spke13.c +++ /dev/null @@ -1,242 +0,0 @@ -/* spke13.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE13 ( S/P Kernel, evaluate, type 13 ) */ -/* Subroutine */ int spke13_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer from; - doublereal work[516] /* was [258][2] */; - integer i__, j, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer to; - doublereal locrec[129]; - extern /* Subroutine */ int chkout_(char *, ftnlen), hrmint_(integer *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - extern logical return_(void); - integer xstart; - -/* $ Abstract */ - -/* Evaluate a single data record from a type 13 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MAXREC P Maximum size of SPK record. See SPKPVN. */ -/* ET I Epoch for which a state is desired. */ -/* RECORD I Record from a type 13 SPK segment valid for ET. */ -/* STATE O State (position and velocity) at epoch ET. */ - -/* $ Detailed_Input */ - -/* ET is the epoch for which a state vector is desired. */ - -/* RECORD is a record from a type 13 SPK segment which, when */ -/* evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative to */ -/* some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* $ Detailed_Output */ - -/* STATE is the state vector at epoch ET. Its contents are, in */ -/* order, X, Y, Z, X', Y', and Z'. Units are km and km/sec. */ - -/* $ Parameters */ - -/* MAXREC is the maximum size of SPK record. See the SPICELIB */ -/* routine SPKPVN for details. */ - -/* $ Exceptions */ - -/* None. This routine assumes that the input record is valid. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 13 (unequally spaced */ -/* discrete states, evaluated by Hermite interpolation) SPK segments */ -/* is described in the SPK Required Reading. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch before evaluating the record to obtain a */ -/* state vector, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 13 ) THEN */ - -/* CALL SPKR13 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE13 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the input record is valid. Any */ -/* checking of the input data is assumed to have been performed */ -/* when the source SPK file was created. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-FEB-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_13 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKE13", (ftnlen)6); - n = i_dnnt(record); - -/* We interpolate each state component in turn. */ - - xstart = n * 6 + 2; - for (i__ = 1; i__ <= 3; ++i__) { - i__1 = n; - for (j = 1; j <= i__1; ++j) { - -/* For the Jth input state vector, copy the Ith position and */ -/* velocity components into the local record buffer LOCREC. */ - - from = (j - 1) * 6 + 1 + i__; - to = (j << 1) - 1; - locrec[(i__2 = to - 1) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec" - , i__2, "spke13_", (ftnlen)234)] = record[from - 1]; - locrec[(i__2 = to) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec", - i__2, "spke13_", (ftnlen)235)] = record[from + 2]; - } - -/* Interpolate the Ith position and velocity components of the */ -/* state. */ - - hrmint_(&n, &record[xstart - 1], locrec, et, work, &state[(i__1 = i__ - - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, "spke13_" - , (ftnlen)243)], &state[(i__2 = i__ + 2) < 6 && 0 <= i__2 ? - i__2 : s_rnge("state", i__2, "spke13_", (ftnlen)243)]); - } - chkout_("SPKE13", (ftnlen)6); - return 0; -} /* spke13_ */ - diff --git a/ext/spice/src/cspice/spke14.c b/ext/spice/src/cspice/spke14.c deleted file mode 100644 index 3d89abf343..0000000000 --- a/ext/spice/src/cspice/spke14.c +++ /dev/null @@ -1,226 +0,0 @@ -/* spke14.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE14 ( S/P Kernel, evaluate, type 14 ) */ -/* Subroutine */ int spke14_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer degree; - extern /* Subroutine */ int chbval_(doublereal *, integer *, doublereal *, - doublereal *, doublereal *); - integer ncoeff, cofloc; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Evaluate a single data record from a type 14 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch for which a state is desired. */ -/* RECORD I Record from a type 14 SPK segment valid for ET. */ -/* STATE O State (position and velocity) at epoch ET. */ - -/* $ Detailed_Input */ - -/* ET is the epoch for which a state vector is desired. */ - -/* RECORD is a record from a type 14 SPK segment which, when */ -/* evaluated at epoch ET, will give the state (position */ -/* and velocity) of some body, relative to some center, in */ -/* some inertial reference frame. */ - -/* $ Detailed_Output */ - -/* STATE is the state vector at epoch ET. Its contents are, in */ -/* order, X, Y, Z, X', Y', and Z'. Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of a type 14 SPK segment is */ -/* described in the SPK Required Reading. */ - -/* A type 14 record contains six sets of Chebyshev coefficients, */ -/* one set each for the position coordinates X, Y, and Z, and one */ -/* set each for the velocity coordinates X', Y', and Z' of a state */ -/* vector. SPKE14 calls the routine CHBVAL to evalute each */ -/* Chebyshev polynomial, and arrive at the complete state. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch before evaluating the record to obtain a */ -/* state vector, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 14 ) THEN */ - -/* CALL SPKR14 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE14 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_14 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKE14", (ftnlen)6); - } - -/* The first number in the record is the number of Chebyshev */ -/* Polynomial coefficients used to represent each component of the */ -/* state vector. Following it are two numbers that will be used */ -/* when evaluating the sets of coefficients, and finally the six sets */ -/* of coefficients. */ - - ncoeff = (integer) record[0]; - -/* The degree of each polynomial is one less than the number of */ -/* coefficients. */ - - degree = ncoeff - 1; - -/* Call CHBVAL once for each quantity to evaluate the position */ -/* and velocity values. */ - - for (i__ = 1; i__ <= 6; ++i__) { - -/* The coefficients for each variable are located contiguously, */ -/* following the first three words in the record. */ - - cofloc = ncoeff * (i__ - 1) + 4; - -/* CHBVAL needs as input the coefficients, the degree of the */ -/* polynomial, also two variable transformation parameters, which */ -/* are located in the second and third slots of the record, and */ -/* the epoch. We get back the appropriate element of a state */ -/* vector. */ - - chbval_(&record[cofloc - 1], °ree, &record[1], et, &state[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke14_", (ftnlen)216)]); - } - chkout_("SPKE14", (ftnlen)6); - return 0; -} /* spke14_ */ - diff --git a/ext/spice/src/cspice/spke15.c b/ext/spice/src/cspice/spke15.c deleted file mode 100644 index 0b84329c3f..0000000000 --- a/ext/spice/src/cspice/spke15.c +++ /dev/null @@ -1,589 +0,0 @@ -/* spke15.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure SPKE15 ( Evaluate a type 15 SPK data record) */ -/* Subroutine */ int spke15_(doublereal *et, doublereal *recin, doublereal * - state) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double sqrt(doublereal), d_mod(doublereal *, doublereal *), d_sign( - doublereal *, doublereal *); - - /* Local variables */ - doublereal near__, dmdt; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - integer j2flg; - doublereal p, angle, dnode, z__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal epoch, speed, dperi, theta, manom; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - errdp_(char *, doublereal *, ftnlen), vcrss_(doublereal *, - doublereal *, doublereal *); - extern doublereal twopi_(void); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal - *, doublereal *); - doublereal oneme2, state0[6]; - extern /* Subroutine */ int prop2b_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal pa[3], gm, ta, dt; - extern doublereal pi_(void); - doublereal tp[3], pv[3], cosinc; - extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *) - , chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *), - setmsg_(char *, ftnlen); - doublereal tmpsta[6], oj2; - extern logical return_(void); - doublereal ecc; - extern doublereal dpr_(void); - doublereal dot, rpl, k2pi; - -/* $ Abstract */ - -/* Evaluates a single SPK data record from a segment of type 15 */ -/* (Precessing Conic Propagation). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECIN I Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, specified as ephemeris seconds past */ -/* J2000, at which a state vector is to be computed. */ - -/* RECIN is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. */ - -/* The structure of RECIN is: */ - -/* RECIN(1) epoch of periapsis */ -/* in ephemeris seconds past J2000. */ -/* RECIN(2)-RECIN(4) unit trajectory pole vector */ -/* RECIN(5)-RECIN(7) unit periapsis vector */ -/* RECIN(8) semi-latus rectum---p in the */ -/* equation: */ - -/* r = p/(1 + ECC*COS(Nu)) */ - -/* RECIN(9) eccentricity */ -/* RECIN(10) J2 processing flag describing */ -/* what J2 corrections are to be */ -/* applied when the orbit is */ -/* propagated. */ - -/* All J2 corrections are applied */ -/* if this flag has a value that */ -/* is not 1,2 or 3. */ - -/* If the value of the flag is 3 */ -/* no corrections are done. */ - -/* If the value of the flag is 1 */ -/* no corrections are computed for */ -/* the precession of the line */ -/* of apsides. However, regression */ -/* of the line of nodes is */ -/* performed. */ - -/* If the value of the flag is 2 */ -/* no corrections are done for */ -/* the regression of the line of */ -/* nodes. However, precession of the */ -/* line of apsides is performed. */ - -/* Note that J2 effects are computed */ -/* only if the orbit is elliptic and */ -/* does not intersect the central */ -/* body. */ - -/* RECIN(11)-RECIN(13) unit central body pole vector */ -/* RECIN(14) central body GM */ -/* RECIN(15) central body J2 */ -/* RECIN(16) central body radius */ - -/* Units are radians, km, seconds */ - -/* $ Detailed_Output */ - -/* STATE is the state produced by evaluating RECIN at ET. */ -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity is less than zero, the error */ -/* 'SPICE(BADECCENTRICITY)' will be signalled. */ - -/* 2) If the semi-latus rectum is non-positive, the error */ -/* 'SPICE(BADLATUSRECTUM)' is signalled. */ - -/* 3) If the pole vector, trajectory pole vector or periapsis vector */ -/* has zero length, the error 'SPICE(BADVECTOR)' is signalled. */ - -/* 4) If the trajectory pole vector and the periapsis vector are */ -/* not orthogonal, the error 'SPICE(BADINITSTATE)' is */ -/* signalled. The test for orthogonality is very crude. The */ -/* routine simply checks that the absolute value of the dot */ -/* product of the unit vectors parallel to the trajectory pole */ -/* and periapse vectors is less than 0.00001. This check is */ -/* intended to catch blunders, not to enforce orthogonality to */ -/* double precision tolerance. */ - -/* 5) If the mass of the central body is non-positive, the error */ -/* 'SPICE(NONPOSITIVEMASS)' is signalled. */ - -/* 6) If the radius of the central body is negative, the error */ -/* 'SPICE(BADRADIUS)' is signalled. */ - -/* $ Particulars */ - -/* This algorithm applies J2 corrections for precessing the */ -/* node and argument of periapse for an object orbiting an */ -/* oblate spheroid. */ - -/* Note the effects of J2 are incorporated only for elliptic */ -/* orbits that do not intersect the central body. */ - -/* While the derivation of the effect of the various harmonics */ -/* of gravitational field are beyond the scope of this header */ -/* the effect of the J2 term of the gravity model are as follows */ - - -/* The line of node precesses. Over one orbit average rate of */ -/* precession, DNode/dNu, is given by */ - -/* 3 J2 */ -/* dNode/dNu = - ----------------- DCOS( inc ) */ -/* 2 (P/RPL)**2 */ - -/* (Since this is always less than zero for oblate spheroids, this */ -/* should be called regression of nodes.) */ - -/* The line of apsides precesses. The average rate of precession */ -/* DPeri/dNu is given by */ -/* 3 J2 */ -/* dPeri/dNu = ----------------- ( 5*DCOS ( inc ) - 1 ) */ -/* 2 (P/RPL)**2 */ - -/* Details of these formulae are given in the Battin's book (see */ -/* literature references below). */ - - -/* It is assumed that this routine is used in conjunction with */ -/* the routine SPKR15 as shown here: */ - -/* CALL SPKR15 ( HANDLE, DESCR, ET, RECIN ) */ -/* CALL SPKE15 ( ET, RECIN, STATE ) */ - -/* where it is known in advance that the HANDLE, DESCR pair points */ -/* to a type 15 data segment. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 15 ) THEN */ - -/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE15 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* S. Schlaifer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* [1] `Fundamentals of Celestial Mechanics', Second Edition 1989 */ -/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */ -/* Richmond Virginia; pp 345-347. */ - -/* [2] `Astronautical Guidance', by Richard H. Battin. 1964 */ -/* McGraw-Hill Book Company, San Francisco. pp 199 */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT, VROTV, and VSCL calls. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_15 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT, VROTV, and VSCL calls. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKE15", (ftnlen)6); - -/* Fetch the various entities from the input record, first the epoch. */ - - epoch = recin[0]; - -/* The trajectory pole vector. */ - - vequ_(&recin[1], tp); - -/* The periapsis vector. */ - - vequ_(&recin[4], pa); - -/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */ -/* and eccentricity. */ - - p = recin[7]; - ecc = recin[8]; - -/* J2 processing flag. */ - - j2flg = (integer) recin[9]; - -/* Central body pole vector. */ - - vequ_(&recin[10], pv); - -/* The central mass, J2 and radius of the central body. */ - - gm = recin[13]; - oj2 = recin[14]; - rpl = recin[15]; - -/* Check all the inputs here for obvious failures. Yes, perhaps */ -/* this is overkill. However, there is a lot more computation */ -/* going on in this routine so that the small amount of overhead */ -/* here should not be significant. */ - - if (p <= 0.) { - setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator" - " was non-positive. This value must be positive. The value s" - "upplied was #.", (ftnlen)133); - errdp_("#", &p, (ftnlen)1); - sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21); - chkout_("SPKE15", (ftnlen)6); - return 0; - } else if (ecc < 0.) { - setmsg_("The eccentricity supplied for a type 15 segment is negative" - ". It must be non-negative. The value supplied to the type 1" - "5 evaluator was #. ", (ftnlen)138); - errdp_("#", &ecc, (ftnlen)1); - sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); - chkout_("SPKE15", (ftnlen)6); - return 0; - } else if (gm <= 0.) { - setmsg_("The mass supplied for the central body of a type 15 segment" - " was non-positive. Masses must be positive. The value suppl" - "ied was #. ", (ftnlen)130); - errdp_("#", &gm, (ftnlen)1); - sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22); - chkout_("SPKE15", (ftnlen)6); - return 0; - } else if (vzero_(tp)) { - setmsg_("The trajectory pole vector supplied to SPKE15 had length ze" - "ro. The most likely cause of this problem is a corrupted SPK" - " (ephemeris) file. ", (ftnlen)138); - sigerr_("SPICE(BADVECTOR)", (ftnlen)16); - chkout_("SPKE15", (ftnlen)6); - return 0; - } else if (vzero_(pa)) { - setmsg_("The periapse vector supplied to SPKE15 had length zero. The" - " most likely cause of this problem is a corrupted SPK (ephem" - "eris) file. ", (ftnlen)131); - sigerr_("SPICE(BADVECTOR)", (ftnlen)16); - chkout_("SPKE15", (ftnlen)6); - return 0; - } else if (vzero_(pv)) { - setmsg_("The central pole vector supplied to SPKE15 had length zero." - " The most likely cause of this problem is a corrupted SPK (e" - "phemeris) file. ", (ftnlen)135); - sigerr_("SPICE(BADVECTOR)", (ftnlen)16); - chkout_("SPKE15", (ftnlen)6); - return 0; - } else if (rpl < 0.) { - setmsg_("The central body radius was negative. It must be zero or po" - "sitive. The value supplied was #. ", (ftnlen)94); - errdp_("#", &rpl, (ftnlen)1); - sigerr_("SPICE(BADRADIUS)", (ftnlen)16); - chkout_("SPKE15", (ftnlen)6); - return 0; - } - -/* Convert TP, PV and PA to unit vectors. */ -/* (It won't hurt to polish them up a bit here if they are already */ -/* unit vectors.) */ - - vhatip_(pa); - vhatip_(tp); - vhatip_(pv); - -/* One final check. Make sure the pole and periapse vectors are */ -/* orthogonal. (We will use a very crude check but this should */ -/* rule out any obvious errors.) */ - - dot = vdot_(pa, tp); - if (abs(dot) > 1e-5) { - angle = vsep_(pa, tp) * dpr_(); - setmsg_("The periapsis and trajectory pole vectors are not orthogona" - "l. The anglebetween them is # degrees. ", (ftnlen)98); - errdp_("#", &angle, (ftnlen)1); - sigerr_("SPICE(BADINITSTATE)", (ftnlen)19); - chkout_("SPKE15", (ftnlen)6); - return 0; - } - -/* Compute the distance and speed at periapse. */ - - near__ = p / (ecc + 1.); - speed = sqrt(gm / p) * (ecc + 1.); - -/* Next get the position at periapse ... */ - - vscl_(&near__, pa, state0); - -/* ... and the velocity at periapsis. */ - - vcrss_(tp, pa, &state0[3]); - vsclip_(&speed, &state0[3]); - -/* Determine the elapsed time from periapse to the requested */ -/* epoch and propagate the state at periapsis to the epoch of */ -/* interest. */ - -/* Note that we are making use of the following fact. */ - -/* If R is a rotation, then the states obtained by */ -/* the following blocks of code are mathematically the */ -/* same. (In reality they may differ slightly due to */ -/* roundoff.) */ - -/* Code block 1. */ - -/* CALL MXV ( R, STATE0, STATE0 ) */ -/* CALL MXV ( R, STATE0(4), STATE0(4) ) */ -/* CALL PROP2B( GM, STATE0, DT, STATE ) */ - -/* Code block 2. */ - -/* CALL PROP2B( GM, STATE0, DT, STATE ) */ -/* CALL MXV ( R, STATE, STATE ) */ -/* CALL MXV ( R, STATE(4), STATE(4) ) */ - - -/* This allows us to first compute the propagation of our initial */ -/* state and then if needed perform the precession of the line */ -/* of nodes and apsides by simply precessing the resulting state. */ - - dt = *et - epoch; - prop2b_(&gm, state0, &dt, state); - -/* If called for, handle precession needed due to the J2 term. Note */ -/* that the motion of the lines of nodes and apsides is formulated */ -/* in terms of the true anomaly. This means we need the accumulated */ -/* true anomaly in order to properly transform the state. */ - - if (j2flg != 3 && oj2 != 0. && ecc < 1. && near__ > rpl) { - -/* First compute the change in mean anomaly since periapsis. */ - -/* Computing 2nd power */ - d__1 = ecc; - oneme2 = 1. - d__1 * d__1; - dmdt = oneme2 / p * sqrt(gm * oneme2 / p); - manom = dmdt * dt; - -/* Next compute the angle THETA such that THETA is between */ -/* -pi and pi and such than MANOM = THETA + K*2*pi for */ -/* some integer K. */ - - d__1 = twopi_(); - theta = d_mod(&manom, &d__1); - if (abs(theta) > pi_()) { - d__1 = twopi_(); - theta -= d_sign(&d__1, &theta); - } - k2pi = manom - theta; - -/* We can get the accumulated true anomaly from the propagated */ -/* state theta and the accumulated mean anomaly prior to this */ -/* orbit. */ - - ta = vsep_(pa, state); - ta = d_sign(&ta, &theta); - ta += k2pi; - -/* Determine how far the line of nodes and periapsis have moved. */ - - cosinc = vdot_(pv, tp); -/* Computing 2nd power */ - d__1 = rpl / p; - z__ = ta * 1.5 * oj2 * (d__1 * d__1); - dnode = -z__ * cosinc; -/* Computing 2nd power */ - d__1 = cosinc; - dperi = z__ * (d__1 * d__1 * 2.5 - .5); - -/* Precess the periapsis by rotating the state vector about the */ -/* trajectory pole */ - - if (j2flg != 1) { - vrotv_(state, tp, &dperi, tmpsta); - vrotv_(&state[3], tp, &dperi, &tmpsta[3]); - moved_(tmpsta, &c__6, state); - } - -/* Regress the line of nodes by rotating the state */ -/* about the pole of the central body. */ - - if (j2flg != 2) { - vrotv_(state, pv, &dnode, tmpsta); - vrotv_(&state[3], pv, &dnode, &tmpsta[3]); - moved_(tmpsta, &c__6, state); - } - -/* We could perform the rotations above in the other order, */ -/* but we would also have to rotate the pole before precessing */ -/* the line of apsides. */ - - } - -/* That's all folks. Check out and return. */ - - chkout_("SPKE15", (ftnlen)6); - return 0; -} /* spke15_ */ - diff --git a/ext/spice/src/cspice/spke17.c b/ext/spice/src/cspice/spke17.c deleted file mode 100644 index 66096e8312..0000000000 --- a/ext/spice/src/cspice/spke17.c +++ /dev/null @@ -1,278 +0,0 @@ -/* spke17.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE17 ( Evaluate a type 17 SPK data record) */ -/* Subroutine */ int spke17_(doublereal *et, doublereal *recin, doublereal * - state) -{ - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - doublereal a, h__, k; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal epoch; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal decpol, rapole; - extern /* Subroutine */ int sigerr_(char *, ftnlen), eqncpv_(doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - doublereal ecc; - -/* $ Abstract */ - -/* Evaluates a single SPK data record from a segment of type 17 */ -/* (Equinoctial Elements). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Target epoch. */ -/* RECIN I Data record. */ -/* STATE O State (position and velocity). */ - -/* $ Detailed_Input */ - -/* ET is a target epoch, specified as ephemeris seconds past */ -/* J2000, at which a state vector is to be computed. */ - -/* RECIN is a data record which, when evaluated at epoch ET, */ -/* will give the state (position and velocity) of some */ -/* body, relative to some center, in some inertial */ -/* reference frame. */ - -/* The structure of RECIN is: */ - -/* RECIN (1) epoch of the elements in ephemeris seconds */ -/* past J2000. */ - -/* RECIN (2)-RECIN (10) Equinoctial Elements: */ - - -/* RECIN (2) is the semi-major axis (A) of the orbit. */ - -/* RECIN (3) is the value of H at the specified epoch. */ -/* ( E*SIN(ARGP+NODE) ). */ - -/* RECIN (4) is the value of K at the specified epoch */ -/* ( E*COS(ARGP+NODE) ). */ - -/* RECIN (5) is the mean longitude (MEAN0+ARGP+NODE)at */ -/* the epoch of the elements. */ - -/* RECIN (6) is the value of P (TAN(INC/2)*SIN(NODE))at */ -/* the specified epoch. */ - -/* RECIN (7) is the value of Q (TAN(INC/2)*COS(NODE))at */ -/* the specified epoch. */ - -/* RECIN (8) is the rate of the longitude of periapse */ -/* (dARGP/dt + dNODE/dt ) at the epoch of */ -/* the elements. This rate is assumed to hold */ -/* for all time. */ - -/* RECIN (9) is the derivative of the mean longitude */ -/* ( dM/dt + dARGP/dt + dNODE/dt ). This */ -/* rate is assumed to be constant. */ - -/* RECIN (10) is the rate of the longitude of the */ -/* ascending node ( dNODE/dt). */ - -/* RECIN (11) Right Ascension of the pole of the */ -/* orbital reference system relative to the */ -/* reference frame of the associated SPK */ -/* segment. */ - -/* RECIN (12) Declination of the pole of the */ -/* orbital reference system relative to */ -/* the reference frame of the associated */ -/* SPK segment. */ - -/* $ Detailed_Output */ - -/* STATE is the state produced by evaluating RECIN at ET. */ -/* Units are km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity is greater than 0.9, the error */ -/* 'SPICE(BADECCENTRICITY)' will be signalled. */ - -/* 2) If the semi-major axis is non-positive, the error */ -/* 'SPICE(BADSEMIAXIS)' is signalled. */ - - -/* $ Particulars */ - -/* This routine performs a cursory examination of the elements */ -/* of a type 17 SPK data record and then passes the equinoctial */ -/* elements contained in that record on to the SPICE routine */ -/* EQNCPV for evaluation. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to examine raw segment data before */ -/* evaluating it with the SPKEnn routines. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 17 ) THEN */ - -/* CALL SPKR17 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE17 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 8-JAN-1997 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_17 spk segment */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKE17", (ftnlen)6); - -/* Fetch the various entities from the input record, first the epoch. */ - - epoch = recin[0]; - a = recin[1]; - h__ = recin[2]; - k = recin[3]; - ecc = sqrt(h__ * h__ + k * k); - rapole = recin[10]; - decpol = recin[11]; - -/* Check all the inputs here for obvious failures. Yes, perhaps */ -/* this is overkill. However, there is a lot more computation */ -/* going on in this routine so that the small amount of overhead */ -/* here should not be significant. */ - - if (a <= 0.) { - setmsg_("The semi-major axis supplied to the SPK type 17 evaluator w" - "as non-positive. This value must be positive. The value sup" - "plied was #.", (ftnlen)131); - errdp_("#", &a, (ftnlen)1); - sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18); - chkout_("SPKE17", (ftnlen)6); - return 0; - } else if (ecc > .9) { - setmsg_("The eccentricity supplied for a type 17 segment is greater " - "than 0.9. It must be less than 0.9.The value supplied to th" - "e type 17 evaluator was #. ", (ftnlen)146); - errdp_("#", &ecc, (ftnlen)1); - sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); - chkout_("SPKE17", (ftnlen)6); - return 0; - } - -/* That's all for here, just plug the elements into the routine */ -/* knows how to evaluate the equinoctial elements. */ - - eqncpv_(et, &epoch, &recin[1], &rapole, &decpol, state); - -/* That's all folks. Check out and return. */ - - chkout_("SPKE17", (ftnlen)6); - return 0; -} /* spke17_ */ - diff --git a/ext/spice/src/cspice/spke18.c b/ext/spice/src/cspice/spke18.c deleted file mode 100644 index ce978c9689..0000000000 --- a/ext/spice/src/cspice/spke18.c +++ /dev/null @@ -1,492 +0,0 @@ -/* spke18.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKE18 ( S/P Kernel, evaluate, type 18 ) */ -/* Subroutine */ int spke18_(doublereal *et, doublereal *record, doublereal * - state) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer from; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal work[516] /* was [258][2] */; - integer i__, j, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal vbuff[6]; - integer to; - doublereal locrec[129]; - integer packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern doublereal lgrint_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *); - extern /* Subroutine */ int hrmint_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), xpsgip_( - integer *, integer *, doublereal *); - extern logical return_(void); - integer xstart, subtyp, ystart; - -/* $ Abstract */ - -/* Evaluate a single data record from a type 18 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to SPK type 18. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */ - -/* -& */ - -/* SPK type 18 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 12-element packets, order */ -/* reduction at boundaries to preceding number */ -/* equivalent to 3 mod 4. */ - - -/* Subtype 1: Lagrange interpolation, 6-element packets, order */ -/* reduction at boundaries to preceding odd number. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of include file spk18.inc. */ - -/* $ Abstract */ - -/* Declare SPK data record size. This record is declared in */ -/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */ -/* (SPKExx) routines. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* 1) If new SPK types are added, it may be necessary to */ -/* increase the size of this record. The header of SPKPVN */ -/* should be updated as well to show the record size */ -/* requirement for each data type. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */ - -/* -& */ - -/* End include file spkrec.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MAXREC P Maximum size of SPK record. See SPKPVN. */ -/* ET I Epoch for which a state is desired. */ -/* RECORD I Record from a type 18 SPK segment valid for ET. */ -/* STATE O State (position and velocity) at epoch ET. */ - -/* $ Detailed_Input */ - -/* ET is the epoch for which a state vector is desired. */ - -/* RECORD is a record from a type 18 SPK segment which, when */ -/* evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative to */ -/* some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | subtype code | */ -/* +----------------------+ */ -/* | number of packets (n)| */ -/* +----------------------+ */ -/* | packet 1 | */ -/* +----------------------+ */ -/* | packet 2 | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | packet n | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* $ Detailed_Output */ - -/* STATE is the state vector at epoch ET. Its contents are, in */ -/* order, X, Y, Z, X', Y', and Z'. Units are km and km/sec. */ - -/* $ Parameters */ - -/* MAXREC is the maximum size of SPK record. See the SPICELIB */ -/* routine SPKPVN for details. */ - -/* $ Exceptions */ - -/* None. This routine assumes that the input record is valid. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The exact format and structure of type 18 (MEX/Rosetta Orbit */ -/* file interpolation) SPK segments is described in the SPK */ -/* Required Reading. */ - -/* $ Examples */ - -/* The SPKEnn routines are almost always used in conjunction with */ -/* the corresponding SPKRnn routines, which read the records from */ -/* SPK files. */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch before evaluating the record to obtain a */ -/* state vector, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ - -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 18 ) THEN */ - -/* CALL SPKR18 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* CALL SPKE18 ( ET, RECORD, STATE ) */ -/* . */ -/* . Check out the evaluated state. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) This routine assumes that the input record is valid. Any */ -/* checking of the input data is assumed to have been performed */ -/* when the source SPK file was created. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 05-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in XPOSEG and LGRINT calls. */ - -/* - SPICELIB Version 1.0.0, 17-AUG-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* evaluate type_18 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 05-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in XPOSEG and LGRINT calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Index of subtype code in record: */ - - -/* Index of packet count in record: */ - - -/* Index at which packets start: */ - - -/* Maximum polynomial degree: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKE18", (ftnlen)6); - -/* Capture the subtype from the record and set the packet size */ -/* accordingly. */ - - subtyp = i_dnnt(record); - if (subtyp == 0) { - packsz = 12; - } else if (subtyp == 1) { - packsz = 6; - } else { - setmsg_("Unexpected SPK type 18 subtype found in type 18 record.", ( - ftnlen)55); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKE18", (ftnlen)6); - return 0; - } - -/* Get the packet count. */ - - n = i_dnnt(&record[1]); - if (subtyp == 1) { - -/* This is the easy case: we perform Lagrange interpolation */ -/* on each state component. */ - -/* We'll transpose the state information in the input record so */ -/* that contiguous pieces of it can be shoved directly into the */ -/* interpolation routine LGRINT. */ - - n = i_dnnt(&record[1]); - xpsgip_(&packsz, &n, &record[2]); - -/* We interpolate each state component in turn. */ - - xstart = n * packsz + 3; - i__1 = packsz; - for (i__ = 1; i__ <= i__1; ++i__) { - ystart = n * (i__ - 1) + 3; - state[(i__2 = i__ - 1) < 6 && 0 <= i__2 ? i__2 : s_rnge("state", - i__2, "spke18_", (ftnlen)310)] = lgrint_(&n, &record[ - xstart - 1], &record[ystart - 1], locrec, et); - } - } else { - -/* We interpolate each state component in turn. Position and */ -/* velocity are interpolated separately. */ - - xstart = packsz * n + 3; - for (i__ = 1; i__ <= 3; ++i__) { - i__1 = n; - for (j = 1; j <= i__1; ++j) { - -/* For the Jth input packet, copy the Ith position and */ -/* velocity components into the local record buffer LOCREC. */ - - from = packsz * (j - 1) + 2 + i__; - to = (j << 1) - 1; - locrec[(i__2 = to - 1) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "locrec", i__2, "spke18_", (ftnlen)335)] = record[ - from - 1]; - locrec[(i__2 = to) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec" - , i__2, "spke18_", (ftnlen)336)] = record[from + 2]; - } - -/* Interpolate the Ith position and velocity components of the */ -/* state. We'll keep the position and overwrite the velocity. */ - - hrmint_(&n, &record[xstart - 1], locrec, et, work, &state[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1, - "spke18_", (ftnlen)344)], &state[(i__2 = i__ + 2) < 6 && - 0 <= i__2 ? i__2 : s_rnge("state", i__2, "spke18_", ( - ftnlen)344)]); - } - -/* Now interpolate velocity, using separate velocity data and */ -/* acceleration. */ - - for (i__ = 1; i__ <= 3; ++i__) { - i__1 = n; - for (j = 1; j <= i__1; ++j) { - -/* For the Jth input packet, copy the Ith position and */ -/* velocity components into the local record buffer LOCREC. */ - - from = packsz * (j - 1) + 2 + packsz / 2 + i__; - to = (j << 1) - 1; - locrec[(i__2 = to - 1) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "locrec", i__2, "spke18_", (ftnlen)368)] = record[ - from - 1]; - locrec[(i__2 = to) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec" - , i__2, "spke18_", (ftnlen)369)] = record[from + 2]; - } - -/* Interpolate the Ith velocity and acceleration components of */ -/* the state. We'll capture the result in a temporary buffer, */ -/* then transfer the velocity to the output state array. */ - - hrmint_(&n, &record[xstart - 1], locrec, et, work, &vbuff[(i__1 = - i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("vbuff", i__1, - "spke18_", (ftnlen)378)], &vbuff[(i__2 = i__ + 2) < 6 && - 0 <= i__2 ? i__2 : s_rnge("vbuff", i__2, "spke18_", ( - ftnlen)378)]); - } - -/* Fill in the velocity in the output state using the results of */ -/* interpolating velocity and acceleration. */ - - vequ_(vbuff, &state[3]); - } - chkout_("SPKE18", (ftnlen)6); - return 0; -} /* spke18_ */ - diff --git a/ext/spice/src/cspice/spkez.c b/ext/spice/src/cspice/spkez.c deleted file mode 100644 index fe6c176977..0000000000 --- a/ext/spice/src/cspice/spkez.c +++ /dev/null @@ -1,1417 +0,0 @@ -/* spkez.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure SPKEZ ( S/P Kernel, easy reader ) */ -/* Subroutine */ int spkez_(integer *targ, doublereal *et, char *ref, char * - abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen - ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer fj2000; - static doublereal temp[6]; - static integer type__; - static logical xmit; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - static integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical found; - static doublereal state[6], stobs[6], xform[36] /* was [6][6] */; - extern logical failed_(void); - extern /* Subroutine */ int frmchg_(integer *, integer *, doublereal *, - doublereal *); - static integer center; - static logical attblk[15]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *), spkacs_( - integer *, doublereal *, char *, char *, integer *, doublereal *, - doublereal *, doublereal *, ftnlen, ftnlen); - static logical usegeo; - static doublereal ltcent; - extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen); - static doublereal dltctr; - static integer reqfrm, typeid, ltsign; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), sigerr_(char *, ftnlen), spkltc_(integer *, doublereal *, - char *, char *, doublereal *, doublereal *, doublereal *, - doublereal *, ftnlen, ftnlen), spkssb_(integer *, doublereal *, - char *, doublereal *, ftnlen), vsclip_(doublereal *, doublereal *) - ; - extern logical return_(void); - static doublereal dlt; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observing body, optionally corrected for light */ -/* time (planetary aberration) and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output state vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output state vector should be expressed. This may */ -/* be any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. */ -/* See the description of the output state vector STARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the NAIF ID code for an observing body. */ - - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the reference frame specified by REF. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; the last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* The velocity component of STARG is the derivative */ -/* with respect to time of the position component of */ -/* STARG. */ - -/* Units are always km and km/sec. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 2) If the loaded kernels provide insufficient data to */ -/* compute the requested state vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 3) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output state STARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute STARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the state. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve state information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations. */ - -/* Use 'NONE', then apply relativistic aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* SPKEZ begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, SPKEZ computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT)*(1-dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* When stellar aberration corrections are used, the rate of */ -/* change of the stellar aberration correction is accounted for */ -/* in the computation of the output velocity. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, SPKEZ computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* consists of the difference */ - -/* T_vel(ET+LT)*(1+dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. Velocities are adjusted to account */ -/* for the rate of change of the stellar aberration correction. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK; then look up a series of */ -/* geometric states of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* C */ -/* C The NAIF IDs of the earth and moon are 399 and 301 */ -/* C respectively. */ -/* C */ -/* INTEGER OBSRVR */ -/* PARAMETER ( OBSRVR = 399 ) */ - -/* INTEGER TARGET */ -/* PARAMETER ( TARGET = 301 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL SPKEZ ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . STATE, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.0.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 5.0.0, 27-DEC-2007 (NJB) */ - -/* This routine was upgraded to more accurately compute */ -/* aberration-corrected velocity, and in particular, make it */ -/* more consistent with observer-target positions. */ - -/* When light time corrections are used, the derivative of light */ -/* time with respect to time is now accounted for in the */ -/* computation of observer-target velocities. When the reference */ -/* frame associated with the output state is time-dependent, the */ -/* derivative of light time with respect to time is now accounted */ -/* for in the computation of the rate of change of orientation of */ -/* the reference frame. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ -/* Minor header error was corrected. */ - -/* - SPICELIB Version 4.0.2, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 4.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 3.0.0, 26-MAY-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial frames. */ - -/* - SPICELIB Version 2.1.1, 5-AUG-1994 (HAN) (MJS) */ - -/* Added code so that routine accepts lower case, mixed case */ -/* and upper case versions of the string ABCORR. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 18-JUL-1991 (JEM) (NJB) */ - -/* The old SPKEZ did not compute the geometric state of one body */ -/* with respect to another unless data existed for each body with */ -/* respect to the solar system barycenter. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* easy reader for spk file */ -/* get state relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.0.0, 22-JUL-2007 (NJB) */ - -/* Routine was upgraded to more accurately compute aberration- */ -/* corrected velocity, and in particular, make it more consistent */ -/* with observer-target positions. When light time corrections */ -/* are used: */ - -/* 1) The derivative of light time with respect */ -/* to time is now accounted for in the computation */ -/* of observer-target velocities, for all types */ -/* of reference frames. */ - -/* 2) The derivative of light time with respect */ -/* to time is now accounted for in the computation of the */ -/* rate of change of orientation of time-dependent */ -/* reference frames for the output state. This rate of */ -/* change affects observer-target velocities. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - -/* This routine was modified as follows: */ - -/* - SPKAPP is no longer called; it has been superseded */ -/* by SPKACS. Aberration-corrected states relative to */ -/* inertial frames are computed by SPKACS. */ - -/* - The effect of the rate of change of light time on the */ -/* rate of change of orientation of non-inertial output */ -/* frames is accounted for in this routine. See the code */ -/* near the end of this source file. */ - -/* The header of this routine has been updated to reflect the */ -/* upgrades described here. */ - -/* As a separate upgrade, the method by which the aberration */ -/* correction flag is parsed has been made more robust: parsing */ -/* is now done by the routine ZZZPRSCOR. The new parsing */ -/* technique calls for parsing the input string only when it */ -/* differs from the previous value. */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. The new checks */ -/* are intended to prevent arithmetic operations from */ -/* being performed with uninitialized or invalid data. */ - -/* Minor header error was corrected. */ - -/* - SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 3.0.0, 26-MAY-1995 (WLT) */ - -/* The routine was upgraded so that it can now support */ -/* non-inertial reference frames. In additions some */ -/* of the error messages were slightly enhanced. */ - -/* - SPICELIB Version 2.1.1, 5-AUG-1994 (HAN) (MJS) */ - -/* Added code so that routine accepts lower case, mixed case */ -/* and upper case versions of the string ABCORR. */ - -/* - SPICELIB Version 2.0.0, 18-JUL-1991 (JEM) (NJB) */ - -/* The previous version of SPKEZ could not */ -/* compute the geometric state (no aberration */ -/* correction) of one body with respect to */ -/* another if the ephemeris data for each */ -/* body relative to the Solar System Barycenter */ -/* (body 0) had not been loaded. Now, if */ -/* sufficient data is loaded, SPKEZ can always */ -/* compute the state. */ - -/* For example, suppose the file GLL.BSP contains */ -/* segments of SPK data for the Galileo spacecraft */ -/* (body -77) relative to the Jupiter Barycenter */ -/* (body 5) over a period of time. If SPKEZ Version */ -/* 1.0.0 was called to compute the geometric state of */ -/* -77 relative to 5 (or vice versa), a routine that */ -/* SPKEZ calls, SPKSSB, would signal an error stating */ -/* that there is insufficient data for computing the */ -/* state of body 5 (relative to 0). Version 1.0.0 */ -/* of SPKEZ could not compute the requested state even */ -/* though sufficient data had been loaded. */ - -/* It is necessary to compute the states of each */ -/* of the target and observing bodies relative to */ -/* the solar system barycenter when aberration */ -/* corrections are being applied. However, when */ -/* computing geometric states, it is only necessary */ -/* to trace back to the first common node. Positive */ -/* side effects include the maintenance of precision */ -/* and reduction in number of look ups. */ - -/* The changes to the code in SPKEZ involved calling a new */ -/* routine, SPKGEO, which computes the geometric state if */ -/* no aberration corrections are requested. */ - -/* The other cosmetic changes include the removal of a reference */ -/* to the SPK User's Guide in Literature_References because */ -/* the User's Guide is the same as SPK Required Reading. */ - -/* Also, the item in Restrictions previously said */ - -/* 1) The ephemeris files to be used by SPKEZ must be loaded */ -/* by SPKLEF before SPKSSB is called. */ - -/* SPKSSB was replaced with SPKEZ. */ - -/* The location of the position and velocity information in the */ -/* output state vector argument STARG is now spelled out. */ - -/* Finally, the Particulars section was updated. In Version */ -/* 1.0.0 it said that calling SPKEZ was equivalent to calling */ -/* SPKSSB and SPKAPP. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKEZ", (ftnlen)5); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SPKEZ", (ftnlen)5); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - usegeo = attblk[0]; - -/* Get the frame ID for J2000 on the first call to this routine. */ - - if (first) { - namfrm_("J2000", &fj2000, (ftnlen)5); - first = FALSE_; - } - } - -/* If we only want a geometric state, then use SPKGEO to compute */ -/* just that. */ - -/* Otherwise, if REF is inertial, compute the state of the target */ -/* relative to the observer via SPKACS. If REF is non-inertial, */ -/* compute the requested state in the J2000 frame, then transform it */ -/* to the frame designated by REF. */ - - if (usegeo) { - spkgeo_(targ, et, ref, obs, starg, lt, ref_len); - } else { - -/* Get the auxiliary information about the requested output */ -/* frame. */ - - namfrm_(ref, &reqfrm, ref_len); - if (reqfrm == 0) { - setmsg_("The requested output frame '#' is not recognized by the" - " reference frame subsystem. Please check that the approp" - "riate kernels have been loaded and that you have correct" - "ly entered the name of the output frame. ", (ftnlen)208); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("SPKEZ", (ftnlen)5); - return 0; - } - frinfo_(&reqfrm, ¢er, &type__, &typeid, &found); - -/* If we are dealing with an inertial frame, we can simply */ -/* call SPKACS and return. */ - - if (type__ == 1) { - spkacs_(targ, et, ref, abcorr, obs, starg, lt, &dlt, ref_len, - abcorr_len); - chkout_("SPKEZ", (ftnlen)5); - return 0; - } - -/* Still here? */ - -/* We are dealing with a non-inertial frame. But we need to do */ -/* light time and stellar aberration corrections in an inertial */ -/* frame. Get the "apparent" state of TARG in the intermediary */ -/* inertial reference frame J2000. */ - -/* We also need the light time to the center of the frame. */ -/* We compute that first so that we can re-use the temporary */ -/* variable STATE when we compute the inertial apparent state */ -/* of the target relative to the observer. */ - - spkacs_(targ, et, "J2000", abcorr, obs, state, lt, &dlt, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("SPKEZ", (ftnlen)5); - return 0; - } - if (center == *obs) { - ltcent = 0.; - dltctr = 0.; - } else if (center == *targ) { - ltcent = *lt; - dltctr = dlt; - } else { - spkssb_(obs, et, "J2000", stobs, (ftnlen)5); - spkltc_(¢er, et, "J2000", abcorr, stobs, temp, <cent, & - dltctr, (ftnlen)5, abcorr_len); - } - -/* If something went wrong (like we couldn't get the state of */ -/* the center relative to the observer) now it is time to quit. */ - - if (failed_()) { - chkout_("SPKEZ", (ftnlen)5); - return 0; - } - -/* If the aberration corrections are for transmission, make the */ -/* sign of the light time positive, since we wish to compute the */ -/* orientation of the non-inertial frame at an epoch later than */ -/* ET by the one-way light time. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Get the state transformation from J2000 to the requested frame */ -/* and convert the state. */ - - d__1 = *et + ltsign * ltcent; - frmchg_(&fj2000, &reqfrm, &d__1, xform); - if (failed_()) { - chkout_("SPKEZ", (ftnlen)5); - return 0; - } - -/* There's a tricky bit here: since XFORM is evaluated */ -/* at time */ - -/* ET + LTSIGN*LTCENT */ - -/* XFORM is actually dependent on LTCENT. We need to account for */ -/* this dependency in our velocity transformation. */ - -/* Let P and V be the target position and velocity respectively, */ -/* and R, DR be the rotation and rotation derivative */ -/* corresponding to XFORM. */ - -/* The state transformation we need to perform is not */ - -/* R * V + DR * P */ - -/* but rather */ - -/* R * V + ( (1 + LTSIGN*DLTCTR) * DR ) * P */ - -/* So we'll scale the derivative block of XFORM accordingly. */ - - for (i__ = 1; i__ <= 3; ++i__) { - d__1 = ltsign * dltctr + 1.; - vsclip_(&d__1, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "spkez_", (ftnlen)1240)]); - } - -/* Now apply the frame transformation XFORM to produce the */ -/* state expressed relative to the request frame REQFRM. */ - - mxvg_(xform, state, &c__6, &c__6, starg); - } - chkout_("SPKEZ", (ftnlen)5); - return 0; -} /* spkez_ */ - diff --git a/ext/spice/src/cspice/spkez_c.c b/ext/spice/src/cspice/spkez_c.c deleted file mode 100644 index 3f8e183449..0000000000 --- a/ext/spice/src/cspice/spkez_c.c +++ /dev/null @@ -1,865 +0,0 @@ -/* - --Procedure spkez_c ( S/P Kernel, easy reader ) - --Abstract - - Return the state (position and velocity) of a target body - relative to an observing body, optionally corrected for light - time (planetary aberration) and stellar aberration. - --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 - - SPK - NAIF_IDS - FRAMES - TIME - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - void spkez_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar *ref, - ConstSpiceChar *abcorr, - SpiceInt obs, - SpiceDouble starg[6], - SpiceDouble *lt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Observer epoch. - ref I Reference frame of output state vector. - abcorr I Aberration correction flag. - obs I Observing body. - starg O State of target. - lt O One way light time between observer and target. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a state vector whose position - component points from the observer to the target. - - et is the ephemeris time, expressed as seconds past J2000 - TDB, at which the state of the target body relative to - the observer is to be computed. `et' refers to time at - the observer's location. - - ref is the name of the reference frame relative to which - the output state vector should be expressed. This may - be any frame supported by the SPICE system, including - built-in frames (documented in the Frames Required - Reading) and frames defined by a loaded frame kernel - (FK). - - When `ref' designates a non-inertial frame, the - orientation of the frame is evaluated at an epoch - dependent on the selected aberration correction. - See the description of the output state vector `starg' - for details. - - abcorr indicates the aberration corrections to be applied - to the state of the target body to account for one-way - light time and stellar aberration. See the discussion - in the Particulars section for recommendations on - how to choose aberration corrections. - - `abcorr' may be any of the following: - - "NONE" Apply no correction. Return the - geometric state of the target body - relative to the observer. - - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at - `et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the state of the target at the - moment it emitted photons arriving at - the observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - state obtained with the "LT" option to - account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - state of the target---the position and - velocity of the target as seen by the - observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - state of the target at the moment it - receives photons emitted from the - observer's location at `et'. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - state obtained with the "XLT" option to - account for the observer's velocity - relative to the solar system - barycenter. The position component of - the computed target state indicates the - direction that photons emitted from the - observer's location must be "aimed" to - hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - `abcorr'. - - obs is the NAIF ID code for an observing body. - - --Detailed_Output - - starg is a Cartesian state vector representing the position - and velocity of the target body relative to the - specified observer. `starg' is corrected for the - specified aberrations, and is expressed with respect - to the reference frame specified by `ref'. The first - three components of `starg' represent the x-, y- and - z-components of the target's position; the last three - components form the corresponding velocity vector. - - Units are always km and km/sec. - - The position component of `starg' points from the - observer's location at `et' to the aberration-corrected - location of the target. Note that the sense of the - position vector is independent of the direction of - radiation travel implied by the aberration - correction. - - The velocity component of `starg' is the derivative - with respect to time of the position component of - `starg.' - - Non-inertial frames are treated as follows: letting - `ltcent' be the one-way light time between the observer - and the central body associated with the frame, the - orientation of the frame is evaluated at et-ltcent, - et+ltcent, or `et' depending on whether the requested - aberration correction is, respectively, for received - radiation, transmitted radiation, or is omitted. `ltcent' - is computed using the method indicated by `abcorr'. - - lt is the one-way light time between the observer and - target in seconds. If the target state is corrected - for aberrations, then 'lt' is the one-way light time - between the observer and the light time corrected - target location. - --Parameters - - None. - --Exceptions - - 1) If the reference frame 'ref' is not a recognized reference - frame the error SPICE(UNKNOWNFRAME) is signaled. - - 2) If the loaded kernels provide insufficient data to - compute the requested state vector, the deficiency will - be diagnosed by a routine in the call tree of this routine. - - 3) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - --Files - - This routine computes states using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. See the routine furnsh_c and the SPK - and KERNEL Required Reading for further information on loading - (and unloading) kernels. - - If the output state `starg' is to be expressed relative to a - non-inertial frame, or if any of the ephemeris data used to - compute `starg' are expressed relative to a non-inertial frame in - the SPK files providing those data, additional kernels may be - needed to enable the reference frame transformations required to - compute the state. These additional kernels may be C-kernels, PCK - files or frame kernels. Any such kernels must already be loaded - at the time this routine is called. - --Particulars - - This routine is part of the user interface to the SPICE ephemeris - system. It allows you to retrieve state information for any - ephemeris object relative to any other in a reference frame that - is convenient for further computations. - - - Aberration corrections - ====================== - - In space science or engineering applications one frequently - wishes to know where to point a remote sensing instrument, such - as an optical camera or radio antenna, in order to observe or - otherwise receive radiation from a target. This pointing problem - is complicated by the finite speed of light: one needs to point - to where the target appears to be as opposed to where it actually - is at the epoch of observation. We use the adjectives - "geometric," "uncorrected," or "true" to refer to an actual - position or state of a target at a specified epoch. When a - geometric position or state vector is modified to reflect how it - appears to an observer, we describe that vector by any of the - terms "apparent," "corrected," "aberration corrected," or "light - time and stellar aberration corrected." The SPICE Toolkit can - correct for two phenomena affecting the apparent location of an - object: one-way light time (also called "planetary aberration") and - stellar aberration. - - One-way light time - ------------------ - - Correcting for one-way light time is done by computing, given an - observer and observation epoch, where a target was when the observed - photons departed the target's location. The vector from the - observer to this computed target location is called a "light time - corrected" vector. The light time correction depends on the motion - of the target relative to the solar system barycenter, but it is - independent of the velocity of the observer relative to the solar - system barycenter. Relativistic effects such as light bending and - gravitational delay are not accounted for in the light time - correction performed by this routine. - - Stellar aberration - ------------------ - - The velocity of the observer also affects the apparent location - of a target: photons arriving at the observer are subject to a - "raindrop effect" whereby their velocity relative to the observer - is, using a Newtonian approximation, the photons' velocity - relative to the solar system barycenter minus the velocity of the - observer relative to the solar system barycenter. This effect is - called "stellar aberration." Stellar aberration is independent - of the velocity of the target. The stellar aberration formula - used by this routine does not include (the much smaller) - relativistic effects. - - Stellar aberration corrections are applied after light time - corrections: the light time corrected target position vector is - used as an input to the stellar aberration correction. - - When light time and stellar aberration corrections are both - applied to a geometric position vector, the resulting position - vector indicates where the target "appears to be" from the - observer's location. - - As opposed to computing the apparent position of a target, one - may wish to compute the pointing direction required for - transmission of photons to the target. This also requires correction - of the geometric target position for the effects of light time - and stellar aberration, but in this case the corrections are - computed for radiation traveling *from* the observer to the target. - We will refer to this situation as the "transmission" case. - - The "transmission" light time correction yields the target's - location as it will be when photons emitted from the observer's - location at `et' arrive at the target. The transmission stellar - aberration correction is the inverse of the traditional stellar - aberration correction: it indicates the direction in which - radiation should be emitted so that, using a Newtonian - approximation, the sum of the velocity of the radiation relative - to the observer and of the observer's velocity, relative to the - solar system barycenter, yields a velocity vector that points in - the direction of the light time corrected position of the target. - - One may object to using the term "observer" in the transmission - case, in which radiation is emitted from the observer's location. - The terminology was retained for consistency with earlier - documentation. - - Below, we indicate the aberration corrections to use for some - common applications: - - 1) Find the apparent direction of a target. This is - the most common case for a remote-sensing observation. - - Use "LT+S": apply both light time and stellar - aberration corrections. - - Note that using light time corrections alone ("LT") is - generally not a good way to obtain an approximation to an - apparent target vector: since light time and stellar - aberration corrections often partially cancel each other, - it may be more accurate to use no correction at all than to - use light time alone. - - - 2) Find the corrected pointing direction to radiate a signal - to a target. This computation is often applicable for - implementing communications sessions. - - Use "XLT+S": apply both light time and stellar - aberration corrections for transmission. - - - 3) Compute the apparent position of a target body relative - to a star or other distant object. - - Use "LT" or "LT+S" as needed to match the correction - applied to the position of the distant object. For - example, if a star position is obtained from a catalog, - the position vector may not be corrected for stellar - aberration. In this case, to find the angular - separation of the star and the limb of a planet, the - vector from the observer to the planet should be - corrected for light time but not stellar aberration. - - - 4) Obtain an uncorrected state vector derived directly from - data in an SPK file. - - Use "NONE". - - - 5) Use a geometric state vector as a low-accuracy estimate - of the apparent state for an application where execution - speed is critical. - - Use "NONE". - - - 6) While this routine cannot perform the relativistic - aberration corrections required to compute states - with the highest possible accuracy, it can supply the - geometric states required as inputs to these computations. - - Use "NONE", then apply relativistic aberration - corrections (not available in the SPICE Toolkit). - - - Below, we discuss in more detail how the aberration corrections - applied by this routine are computed. - - Geometric case - ============== - - spkez_c begins by computing the geometric position T(et) of the - target body relative to the solar system barycenter (SSB). - Subtracting the geometric position of the observer O(et) gives - the geometric position of the target body relative to the - observer. The one-way light time, 'lt', is given by - - | T(et) - O(et) | - lt = ------------------- - c - - The geometric relationship between the observer, target, and - solar system barycenter is as shown: - - - SSB ---> O(et) - | / - | / - | / - | / T(et) - O(et) - V V - T(et) - - - The returned state consists of the position vector - - T(et) - O(et) - - and a velocity obtained by taking the difference of the - corresponding velocities. In the geometric case, the - returned velocity is actually the time derivative of the - position. - - - Reception case - ============== - - When any of the options "LT", "CN", "LT+S", "CN+S" is selected - for `abcorr', spkez_c computes the position of the target body at - epoch et-lt, where 'lt' is the one-way light time. Let T(t) and - O(t) represent the positions of the target and observer - relative to the solar system barycenter at time t; then 'lt' is - the solution of the light-time equation - - | T(et-lt) - O(et) | - lt = ------------------------ (1) - c - - The ratio - - | T(et) - O(et) | - --------------------- (2) - c - - is used as a first approximation to 'lt'; inserting (2) into the - right hand side of the light-time equation (1) yields the - "one-iteration" estimate of the one-way light time ("LT"). - Repeating the process until the estimates of 'lt' converge yields - the "converged Newtonian" light time estimate ("CN"). - - Subtracting the geometric position of the observer O(et) gives - the position of the target body relative to the observer: - T(et-lt) - O(et). - - SSB ---> O(et) - | \ | - | \ | - | \ | T(et-lt) - O(et) - | \ | - V V V - T(et) T(et-lt) - - The position component of the light time corrected state - is the vector - - T(et-lt) - O(et) - - The velocity component of the light time corrected state - is the difference - - T_vel(et-lt)*(1-d(lt)/d(et)) - O_vel(et) - - where T_vel and O_vel are, respectively, the velocities of the - target and observer relative to the solar system barycenter at - the epochs et-lt and 'et'. - - If correction for stellar aberration is requested, the target - position is rotated toward the solar system barycenter-relative - velocity vector of the observer. The rotation is computed as - follows: - - Let r be the light time corrected vector from the observer - to the object, and v be the velocity of the observer with - respect to the solar system barycenter. Let w be the angle - between them. The aberration angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - h = r X v - - Rotate r by phi radians about h to obtain the apparent - position of the object. - - When stellar aberration corrections are used, the rate of change - of the stellar aberration correction is accounted for in the - computation of the output velocity. - - - Transmission case - ================== - - When any of the options "XLT", "XCN", "XLT+S", "XCN+S" is - selected, spkez_c computes the position of the target body T at - epoch et+lt, where 'lt' is the one-way light time. 'lt' is the - solution of the light-time equation - - | T(et+lt) - O(et) | - lt = ------------------------ (3) - c - - Subtracting the geometric position of the observer, O(et), - gives the position of the target body relative to the - observer: T(et-lt) - O(et). - - SSB --> O(et) - / | * - / | * T(et+lt) - O(et) - / |* - / *| - V V V - T(et+lt) T(et) - - The position component of the light-time corrected state - is the vector - - T(et+lt) - O(et) - - The velocity component of the light-time corrected state - consists of the difference - - T_vel(et+lt)*(1+d(lt)/d(et)) - O_vel(et) - - where T_vel and O_vel are, respectively, the velocities of the - target and observer relative to the solar system barycenter at - the epochs et+lt and 'et'. - - If correction for stellar aberration is requested, the target - position is rotated away from the solar system barycenter- - relative velocity vector of the observer. The rotation is - computed as in the reception case, but the sign of the - rotation angle is negated. - - - Precision of light time corrections - =================================== - - Corrections using one iteration of the light time solution - ---------------------------------------------------------- - - When the requested aberration correction is "LT", "LT+S", - "XLT", or "XLT+S", only one iteration is performed in the - algorithm used to compute 'lt'. - - The relative error in this computation - - | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL - - is at most - - (V/C)**2 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**2, where V is the - velocity of the target relative to an inertial frame and C is - the speed of light. - - For nearly all objects in the solar system V is less than 60 - km/sec. The value of C is 300000 km/sec. Thus the one - iteration solution for 'lt' has a potential relative error of - not more than 4*10**-8. This is a potential light time error - of approximately 2*10**-5 seconds per astronomical unit of - distance separating the observer and target. Given the bound - on V cited above: - - As long as the observer and target are - separated by less than 50 astronomical units, - the error in the light time returned using - the one-iteration light time corrections - is less than 1 millisecond. - - - Converged corrections - --------------------- - - When the requested aberration correction is "CN", "CN+S", - "XCN", or "XCN+S", three iterations are performed in the - computation of 'lt'. The relative error present in this - solution is at most - - (V/C)**4 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**4. Mathematically the - precision of this computation is better than a nanosecond for - any pair of objects in the solar system. - - However, to model the actual light time between target and - observer one must take into account effects due to general - relativity. These may be as high as a few hundredths of a - millisecond for some objects. - - When one considers the extra time required to compute the - converged Newtonian light time (the state of the target relative - to the solar system barycenter is looked up three times instead - of once) together with the real gain in accuracy, it seems - unlikely that you will want to request either the "CN" or "CN+S" - light time corrections. However, these corrections can be useful - for testing situations where high precision (as opposed to - accuracy) is required. - - - Relativistic Corrections - ========================= - - This routine does not attempt to perform either general or - special relativistic corrections in computing the various - aberration corrections. For many applications relativistic - corrections are not worth the expense of added computation - cycles. If however, your application requires these additional - corrections we suggest you consult the astronomical almanac (page - B36) for a discussion of how to carry out these corrections. - - --Examples - - 1) Load a planetary ephemeris SPK, then look up a series of - geometric states of the moon relative to the earth, - referenced to the J2000 frame. - - - #include - #include "SpiceUsr.h" - - int main() - { - - #define ABCORR "NONE" - #define FRAME "J2000" - - /. - The name of the SPK file shown here is fictitious; - you must supply the name of an SPK file available - on your own computer system. - ./ - #define SPK "planetary_spk.bsp" - - /. - ET0 represents the date 2000 Jan 1 12:00:00 TDB. - ./ - #define ET0 0.0 - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 100 - - /. - The NAIF IDs of the earth and moon are 399 and 301 respectively. - ./ - #define OBSERVER 399 - #define TARGET 301 - - - /. - Local variables - ./ - SpiceInt i; - - SpiceDouble et; - SpiceDouble lt; - SpiceDouble state [6]; - - - /. - Load the spk file. - ./ - furnsh_c ( SPK ); - - /. - Step through a series of epochs, looking up a state vector - at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = ET0 + i*STEP; - - spkez_c ( TARGET, et, FRAME, ABCORR, - OBSERVER, state, < ); - - printf( "\net = %20.10f\n\n", et ); - printf( "J2000 x-position (km): %20.10f\n", state[0] ); - printf( "J2000 y-position (km): %20.10f\n", state[1] ); - printf( "J2000 z-position (km): %20.10f\n", state[2] ); - printf( "J2000 x-velocity (km/s): %20.10f\n", state[3] ); - printf( "J2000 y-velocity (km/s): %20.10f\n", state[4] ); - printf( "J2000 z-velocity (km/s): %20.10f\n", state[5] ); - } - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - C.H. Acton (JPL) - W.L. Taber (JPL) - N.J. Bachman (JPL) - J.E. McLean (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 3.0.0, 27-DEC-2007 (NJB) - - This routine was upgraded to more accurately compute - aberration-corrected velocity, and in particular, make it - more consistent with observer-target positions. - - When light time corrections are used, the derivative of light - time with respect to time is now accounted for in the - computation of observer-target velocities. When the reference - frame associated with the output state is time-dependent, the - derivative of light time with respect to time is now accounted - for in the computation of the rate of change of orientation of - the reference frame. - - When stellar aberration corrections are used, velocities - now reflect the rate of range of the stellar aberration - correction. - - -CSPICE Version 2.0.3, 12-DEC-2004 (NJB) - - Minor header error was corrected. - - -CSPICE Version 2.0.2, 13-OCT-2003 (EDW) - - Various minor header changes were made to improve clarity. - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 2.0.1, 29-JUL-2003 (NJB) (CHA) - - Various minor header changes were made to improve clarity. - - -CSPICE Version 2.0.0, 28-DEC-2001 (NJB) - - Updated to handle aberration corrections for transmission - of radiation. Formerly, only the reception case was - supported. The header was revised and expanded to explain - the functionality of this routine in more detail. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) - --Index_Entries - - using body codes get target state relative to an observer - get state relative to observer corrected for aberrations - read ephemeris data - read trajectory data - --& -*/ - -{ /* Begin spkez_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkez_c" ); - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkez_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkez_c", abcorr ); - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - - spkez_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( char * ) abcorr, - ( integer * ) &obs, - ( doublereal * ) starg, - ( doublereal * ) lt, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(abcorr) ); - - - chkout_c ( "spkez_c" ); - - -} /* End spkez_c */ diff --git a/ext/spice/src/cspice/spkezp.c b/ext/spice/src/cspice/spkezp.c deleted file mode 100644 index 21e0ff5d1e..0000000000 --- a/ext/spice/src/cspice/spkezp.c +++ /dev/null @@ -1,1030 +0,0 @@ -/* spkezp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKEZP ( S/P Kernel, easy position ) */ -/* Subroutine */ int spkezp_(integer *targ, doublereal *et, char *ref, char * - abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen - ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - static integer fj2000; - static doublereal temp[3], sobs[6]; - static integer type__; - static logical xmit; - static integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical eqchr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static logical found; - extern integer ltrim_(char *, ftnlen); - static doublereal xform[9] /* was [3][3] */; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static doublereal postn[3]; - extern logical failed_(void); - extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, - doublereal *); - static integer center; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - static doublereal ltcent; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer reqfrm, typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), spkapo_(integer *, - doublereal *, char *, doublereal *, char *, doublereal *, - doublereal *, ftnlen, ftnlen), setmsg_(char *, ftnlen), spkssb_( - integer *, doublereal *, char *, doublereal *, ftnlen), spkgps_( - integer *, doublereal *, char *, integer *, doublereal *, - doublereal *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Return the position of a target body relative to an observing */ -/* body, optionally corrected for light time (planetary aberration) */ -/* and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body NAIF ID code. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output position vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body NAIF ID code. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a position vector which points */ -/* from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output position vector should be expressed. This */ -/* may be any frame supported by the SPICE system, */ -/* including built-in frames (documented in the Frames */ -/* Required Reading) and frames defined by a loaded */ -/* frame kernel (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. See */ -/* the description of the output position vector PTARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at */ -/* the moment it emitted photons arriving */ -/* at the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The computed target */ -/* position indicates the direction that */ -/* photons emitted from the observer's */ -/* location must be "aimed" to hit the */ -/* target. */ -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the NAIF ID code for the observing body. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the reference frame */ -/* specified by REF. The three components of PTARG */ -/* represent the x-, y- and z-components of the target's */ -/* position. */ - -/* PTARG points from the observer's location at ET to */ -/* the aberration-corrected location of the target. */ -/* Note that the sense of this position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of target or observer cannot be translated to its */ -/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 3) If the loaded kernels provide insufficient data to */ -/* compute the requested position vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 4) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output position PTARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute PTARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the position. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve position information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations. */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* SPKEZP begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, SPKEZP computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The light time corrected position vector is */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, SPKEZP computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The light-time corrected position vector is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK, then look up a series of */ -/* geometric positions of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 positions. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* C */ -/* C The NAIF IDs of the earth and moon are 399 and 301 */ -/* C respectively. */ -/* C */ -/* INTEGER OBSRVR */ -/* PARAMETER ( OBSRVR = 399 ) */ - -/* INTEGER TARGET */ -/* PARAMETER ( TARGET = 301 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C position vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL SPKEZP ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . POS, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', POS(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', POS(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', POS(3) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* B.V. Semenov (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.1, 04-APR-2008 (NJB) */ - -/* Corrected minor error in description of XLT+S aberration */ -/* correction. */ - -/* - SPICELIB Version 3.1.0, 06-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ - -/* - SPICELIB Version 3.0.3, 12-DEC-2004 (NJB) */ - -/* Minor header error was corrected. */ - -/* - SPICELIB Version 3.0.2, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 3.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 3.0.0, 31-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* using body names get position relative to an observer */ -/* get position relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. The new checks */ -/* are intended to prevent arithmetic operations from */ -/* being performed with uninitialized or invalid data. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKEZP", (ftnlen)6); - } - -/* Get the frame id for J2000 on the first call to this routine. */ - - if (first) { - first = FALSE_; - namfrm_("J2000", &fj2000, (ftnlen)5); - } - -/* Decide whether the aberration correction is for received or */ -/* transmitted radiation. */ - - i__ = ltrim_(abcorr, abcorr_len); - xmit = eqchr_(abcorr + (i__ - 1), "X", (ftnlen)1, (ftnlen)1); - -/* If we only want geometric positions, then compute just that. */ - -/* Otherwise, compute the state of the observer relative to */ -/* the SSB. Then feed that position into SPKAPO to compute the */ -/* apparent position of the target body relative to the observer */ -/* with the requested aberration corrections. */ - - if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) { - spkgps_(targ, et, ref, obs, ptarg, lt, ref_len); - } else { - -/* Get the auxiliary information about the requested output */ -/* frame. */ - - namfrm_(ref, &reqfrm, ref_len); - if (reqfrm == 0) { - setmsg_("The requested output frame '#' is not recognized by the" - " reference frame subsystem. Please check that the appro" - "priate kernels have been loaded and that you have correc" - "tly entered the name of the output frame. ", (ftnlen)209); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("SPKEZP", (ftnlen)6); - return 0; - } - frinfo_(&reqfrm, ¢er, &type__, &typeid, &found); - -/* If we are dealing with an inertial frame, we can simply */ -/* call SPKSSB, SPKAPO and return. */ - - if (type__ == 1) { - spkssb_(obs, et, ref, sobs, ref_len); - spkapo_(targ, et, ref, sobs, abcorr, ptarg, lt, ref_len, - abcorr_len); - chkout_("SPKEZP", (ftnlen)6); - return 0; - } - -/* Still here? */ - -/* We are dealing with a non-inertial frame. But we need to */ -/* do light time and stellar aberration in an inertial frame. */ -/* Get the "apparent" position of TARG in the intermediary */ -/* inertial reference frame J2000. */ - -/* We also need the light time to the center of the frame. */ - - spkssb_(obs, et, "J2000", sobs, (ftnlen)5); - spkapo_(targ, et, "J2000", sobs, abcorr, postn, lt, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("SPKEZP", (ftnlen)6); - return 0; - } - if (center == *obs) { - ltcent = 0.; - } else if (center == *targ) { - ltcent = *lt; - } else { - spkapo_(¢er, et, "J2000", sobs, abcorr, temp, <cent, ( - ftnlen)5, abcorr_len); - } - -/* If something went wrong (like we couldn't get the position of */ -/* the center relative to the observer) now it is time to quit. */ - - if (failed_()) { - chkout_("SPKEZP", (ftnlen)6); - return 0; - } - -/* If the aberration corrections are for transmission, negate */ -/* the light time, since we wish to compute the orientation */ -/* of the non-inertial frame at an epoch later than ET by */ -/* the one-way light time. */ - - if (xmit) { - ltcent = -ltcent; - } - -/* Get the rotation from J2000 to the requested frame */ -/* and convert the position. */ - - d__1 = *et - ltcent; - refchg_(&fj2000, &reqfrm, &d__1, xform); - if (failed_()) { - chkout_("SPKEZP", (ftnlen)6); - return 0; - } - mxv_(xform, postn, ptarg); - } - chkout_("SPKEZP", (ftnlen)6); - return 0; -} /* spkezp_ */ - diff --git a/ext/spice/src/cspice/spkezp_c.c b/ext/spice/src/cspice/spkezp_c.c deleted file mode 100644 index 856e214b6f..0000000000 --- a/ext/spice/src/cspice/spkezp_c.c +++ /dev/null @@ -1,803 +0,0 @@ -/* - --Procedure spkezp_c ( S/P Kernel, easy position ) - --Abstract - - Return the position of a target body relative to an observing - body, optionally corrected for light time (planetary aberration) - and stellar aberration. - --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 - - SPK - NAIF_IDS - FRAMES - TIME - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void spkezp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body NAIF ID code. - et I Observer epoch. - ref I Reference frame of output position vector. - abcorr I Aberration correction flag. - obs I Observing body NAIF ID code. - ptarg O Position of target. - lt O One way light time between observer and target. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a position vector which points - from the observer to the target. - - et is the ephemeris time, expressed as seconds past - J2000 TDB, at which the position of the target body - relative to the observer is to be computed. 'et' - refers to time at the observer's location. - - ref is the name of the reference frame relative to which - the output position vector should be expressed. This - may be any frame supported by the SPICE system, - including built-in frames (documented in the Frames - Required Reading) and frames defined by a loaded - frame kernel (FK). - - When 'ref' designates a non-inertial frame, the - orientation of the frame is evaluated at an epoch - dependent on the selected aberration correction. See - the description of the output position vector 'ptarg' - for details. - - abcorr indicates the aberration corrections to be applied to - the position of the target body to account for - one-way light time and stellar aberration. See the - discussion in the Particulars section for - recommendations on how to choose aberration - corrections. - - abcorr may be any of the following: - - "NONE" Apply no correction. Return the - geometric position of the target body - relative to the observer. - - The following values of abcorr apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at 'et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the position of the target at - the moment it emitted photons arriving - at the observer at 'et'. - - The light time correction uses an - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - position obtained with the "LT" option - to account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - position of the target---the position - as seen by the observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of abcorr apply to the - "transmission" case in which photons *depart* from - the observer's location at 'et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - position of the target at the moment it - receives photons emitted from the - observer's location at 'et'. - - "XLT+S" "Transmission" case: correct for one-way - light time and stellar aberration using a - Newtonian formulation. This option - modifies the position obtained with the - "XLT" option to account for the observer's - velocity relative to the solar system - barycenter. The computed target position - indicates the direction that photons - emitted from the observer's location must - be "aimed" to hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - abcorr. - - obs is the NAIF ID code for an observing body. - --Detailed_Output - - ptarg is a Cartesian 3-vector representing the position of - the target body relative to the specified observer. - 'ptarg' is corrected for the specified aberrations, and - is expressed with respect to the reference frame - specified by 'ref'. The three components of 'ptarg' - represent the x-, y- and z-components of the target's - position. - - Units are always km. - - 'ptarg' points from the observer's location at 'et' to - the aberration-corrected location of the target. - Note that the sense of this position vector is - independent of the direction of radiation travel - implied by the aberration correction. - - Non-inertial frames are treated as follows: letting - ltcent be the one-way light time between the observer - and the central body associated with the frame, the - orientation of the frame is evaluated at et-ltcent, - et+ltcent, or 'et' depending on whether the requested - aberration correction is, respectively, for received - radiation, transmitted radiation, or is omitted. ltcent - is computed using the method indicated by abcorr. - - lt is the one-way light time between the observer and - target in seconds. If the target position is corrected - for aberrations, then 'lt' is the one-way light time - between the observer and the light time corrected - target location. - --Parameters - - None. - --Exceptions - - 1) If name of target or observer cannot be translated to its - NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. - - 2) If the reference frame 'ref' is not a recognized reference - frame the error SPICE(UNKNOWNFRAME) is signaled. - - 3) If the loaded kernels provide insufficient data to - compute the requested position vector, the deficiency will - be diagnosed by a routine in the call tree of this routine. - - 4) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - --Files - - This routine computes positions using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. See the routine furnsh_c and the SPK - and KERNEL Required Reading for further information on loading - (and unloading) kernels. - - If the output position 'ptarg' is to be expressed relative to a - non-inertial frame, or if any of the ephemeris data used to - compute 'ptarg' are expressed relative to a non-inertial frame in - the SPK files providing those data, additional kernels may be - needed to enable the reference frame transformations required to - compute the position. These additional kernels may be C-kernels, PCK - files or frame kernels. Any such kernels must already be loaded - at the time this routine is called. - - --Particulars - - This routine is part of the user interface to the SPICE ephemeris - system. It allows you to retrieve position information for any - ephemeris object relative to any other in a reference frame that - is convenient for further computations. - - - Aberration corrections - ====================== - - In space science or engineering applications one frequently - wishes to know where to point a remote sensing instrument, such - as an optical camera or radio antenna, in order to observe or - otherwise receive radiation from a target. This pointing problem - is complicated by the finite speed of light: one needs to point - to where the target appears to be as opposed to where it actually - is at the epoch of observation. We use the adjectives - "geometric," "uncorrected," or "true" to refer to an actual - position or state of a target at a specified epoch. When a - geometric position or state vector is modified to reflect how it - appears to an observer, we describe that vector by any of the - terms "apparent," "corrected," "aberration corrected," or "light - time and stellar aberration corrected." The SPICE Toolkit can - correct for two phenomena affecting the apparent location of an - object: one-way light time (also called "planetary aberration") and - stellar aberration. - - One-way light time - ------------------ - - Correcting for one-way light time is done by computing, given an - observer and observation epoch, where a target was when the observed - photons departed the target's location. The vector from the - observer to this computed target location is called a "light time - corrected" vector. The light time correction depends on the motion - of the target relative to the solar system barycenter, but it is - independent of the velocity of the observer relative to the solar - system barycenter. Relativistic effects such as light bending and - gravitational delay are not accounted for in the light time - correction performed by this routine. - - Stellar aberration - ------------------ - - The velocity of the observer also affects the apparent location - of a target: photons arriving at the observer are subject to a - "raindrop effect" whereby their velocity relative to the observer - is, using a Newtonian approximation, the photons' velocity - relative to the solar system barycenter minus the velocity of the - observer relative to the solar system barycenter. This effect is - called "stellar aberration." Stellar aberration is independent - of the velocity of the target. The stellar aberration formula - used by this routine does not include (the much smaller) - relativistic effects. - - Stellar aberration corrections are applied after light time - corrections: the light time corrected target position vector is - used as an input to the stellar aberration correction. - - When light time and stellar aberration corrections are both - applied to a geometric position vector, the resulting position - vector indicates where the target "appears to be" from the - observer's location. - - As opposed to computing the apparent position of a target, one - may wish to compute the pointing direction required for - transmission of photons to the target. This also requires correction - of the geometric target position for the effects of light time - and stellar aberration, but in this case the corrections are - computed for radiation traveling *from* the observer to the target. - We will refer to this situation as the "transmission" case. - - The "transmission" light time correction yields the target's - location as it will be when photons emitted from the observer's - location at `et' arrive at the target. The transmission stellar - aberration correction is the inverse of the traditional stellar - aberration correction: it indicates the direction in which - radiation should be emitted so that, using a Newtonian - approximation, the sum of the velocity of the radiation relative - to the observer and of the observer's velocity, relative to the - solar system barycenter, yields a velocity vector that points in - the direction of the light time corrected position of the target. - - One may object to using the term "observer" in the transmission - case, in which radiation is emitted from the observer's location. - The terminology was retained for consistency with earlier - documentation. - - Below, we indicate the aberration corrections to use for some - common applications: - - 1) Find the apparent direction of a target. This is - the most common case for a remote-sensing observation. - - Use "LT+S": apply both light time and stellar - aberration corrections. - - Note that using light time corrections alone ("LT") is - generally not a good way to obtain an approximation to an - apparent target vector: since light time and stellar - aberration corrections often partially cancel each other, - it may be more accurate to use no correction at all than to - use light time alone. - - - 2) Find the corrected pointing direction to radiate a signal - to a target. This computation is often applicable for - implementing communications sessions. - - Use "XLT+S": apply both light time and stellar - aberration corrections for transmission. - - - 3) Compute the apparent position of a target body relative - to a star or other distant object. - - Use "LT" or "LT+S" as needed to match the correction - applied to the position of the distant object. For - example, if a star position is obtained from a catalog, - the position vector may not be corrected for stellar - aberration. In this case, to find the angular - separation of the star and the limb of a planet, the - vector from the observer to the planet should be - corrected for light time but not stellar aberration. - - - 4) Obtain an uncorrected position vector derived directly from - data in an SPK file. - - Use "NONE". - - - 5) Use a geometric position vector as a low-accuracy estimate - of the apparent position for an application where execution - speed is critical. - - Use "NONE". - - - 6) While this routine cannot perform the relativistic - aberration corrections required to compute positions - with the highest possible accuracy, it can supply the - geometric positions required as inputs to these computations. - - Use "NONE", then apply relativistic aberration - corrections (not available in the SPICE Toolkit). - - - Below, we discuss in more detail how the aberration corrections - applied by this routine are computed. - - Geometric case - ============== - - spkezp_c begins by computing the geometric position T(et) of the - target body relative to the solar system barycenter (SSB). - Subtracting the geometric position of the observer O(et) gives - the geometric position of the target body relative to the - observer. The one-way light time, 'lt', is given by - - | T(et) - O(et) | - lt = ------------------- - c - - The geometric relationship between the observer, target, and - solar system barycenter is as shown: - - - SSB ---> O(et) - | / - | / - | / - | / T(et) - O(et) - V V - T(et) - - - The returned position is - - T(et) - O(et) - - - Reception case - ============== - - When any of the options "LT", "CN", "LT+S", "CN+S" is selected - for `abcorr', spkezp_c computes the position of the target body at - epoch et-lt, where 'lt' is the one-way light time. Let T(t) and - O(t) represent the positions of the target and observer - relative to the solar system barycenter at time t; then 'lt' is - the solution of the light-time equation - - | T(et-lt) - O(et) | - lt = ------------------------ (1) - c - - The ratio - - | T(et) - O(et) | - --------------------- (2) - c - - is used as a first approximation to 'lt'; inserting (2) into the - right hand side of the light-time equation (1) yields the - "one-iteration" estimate of the one-way light time ("LT"). - Repeating the process until the estimates of 'lt' converge yields - the "converged Newtonian" light time estimate ("CN"). - - Subtracting the geometric position of the observer O(et) gives - the position of the target body relative to the observer: - T(et-lt) - O(et). - - SSB ---> O(et) - | \ | - | \ | - | \ | T(et-lt) - O(et) - | \ | - V V V - T(et) T(et-lt) - - The light time corrected position vector is - - T(et-lt) - O(et) - - If correction for stellar aberration is requested, the target - position is rotated toward the solar system - barycenter-relative velocity vector of the observer. The - rotation is computed as follows: - - Let r be the light time corrected vector from the observer - to the object, and v be the velocity of the observer with - respect to the solar system barycenter. Let w be the angle - between them. The aberration angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - h = r X v - - Rotate r by phi radians about h to obtain the apparent - position of the object. - - - Transmission case - ================== - - When any of the options "XLT", "XCN", "XLT+S", "XCN+S" is - selected, spkezp_c computes the position of the target body T at - epoch et+lt, where 'lt' is the one-way light time. 'lt' is the - solution of the light-time equation - - | T(et+lt) - O(et) | - lt = ------------------------ (3) - c - - Subtracting the geometric position of the observer, O(et), - gives the position of the target body relative to the - observer: T(et-lt) - O(et). - - SSB --> O(et) - / | * - / | * T(et+lt) - O(et) - / |* - / *| - V V V - T(et+lt) T(et) - - The position component of the light-time corrected position - is the vector - - T(et+lt) - O(et) - - If correction for stellar aberration is requested, the target - position is rotated away from the solar system barycenter- - relative velocity vector of the observer. The rotation is - computed as in the reception case, but the sign of the - rotation angle is negated. - - Precision of light time corrections - =================================== - - Corrections using one iteration of the light time solution - ---------------------------------------------------------- - - When the requested aberration correction is "LT", "LT+S", - "XLT", or "XLT+S", only one iteration is performed in the - algorithm used to compute 'lt'. - - The relative error in this computation - - | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL - - is at most - - (V/C)**2 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**2, where V is the - velocity of the target relative to an inertial frame and C is - the speed of light. - - For nearly all objects in the solar system V is less than 60 - km/sec. The value of C is 300000 km/sec. Thus the one - iteration solution for 'lt' has a potential relative error of - not more than 4*10**-8. This is a potential light time error - of approximately 2*10**-5 seconds per astronomical unit of - distance separating the observer and target. Given the bound - on V cited above: - - As long as the observer and target are - separated by less than 50 astronomical units, - the error in the light time returned using - the one-iteration light time corrections - is less than 1 millisecond. - - - Converged corrections - --------------------- - - When the requested aberration correction is "CN", "CN+S", - "XCN", or "XCN+S", three iterations are performed in the - computation of 'lt'. The relative error present in this - solution is at most - - (V/C)**4 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**4. Mathematically the - precision of this computation is better than a nanosecond for - any pair of objects in the solar system. - - However, to model the actual light time between target and - observer one must take into account effects due to general - relativity. These may be as high as a few hundredths of a - millisecond for some objects. - - When one considers the extra time required to compute the - converged Newtonian light time (the state of the target relative - to the solar system barycenter is looked up three times instead - of once) together with the real gain in accuracy, it seems - unlikely that you will want to request either the "CN" or "CN+S" - light time corrections. However, these corrections can be useful - for testing situations where high precision (as opposed to - accuracy) is required. - - - Relativistic Corrections - ========================= - - This routine does not attempt to perform either general or - special relativistic corrections in computing the various - aberration corrections. For many applications relativistic - corrections are not worth the expense of added computation - cycles. If however, your application requires these additional - corrections we suggest you consult the astronomical almanac (page - B36) for a discussion of how to carry out these corrections. - - --Examples - - 1) Load a planetary ephemeris SPK, then look up a series of - geometric positions of the moon relative to the earth, - referenced to the J2000 frame. - - #include - #include "SpiceUsr.h" - - void main() - { - - #define ABCORR "NONE" - #define FRAME "J2000" - - /. - The name of the SPK file shown here is fictitious; - you must supply the name of an SPK file available - on your own computer system. - ./ - #define SPK "planetary_spk.bsp" - - /. - ET0 represents the date 2000 Jan 1 12:00:00 TDB. - ./ - #define ET0 0.0 - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 100 - - /. - The NAIF IDs of the earth and moon are 399 and 301 respectively. - ./ - #define OBSERVER 399 - #define TARGET 301 - - /. - Local variables - ./ - SpiceInt i; - - SpiceDouble et; - SpiceDouble lt; - SpiceDouble pos [3]; - - - /. - Load the spk file. - ./ - furnsh_c ( SPK ); - - /. - Step through a series of epochs, looking up a position vector - at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = ET0 + i*STEP; - - spkezp_c ( TARGET, et, FRAME, ABCORR, - OBSERVER, pos, < ); - - printf( "\net = %20.10f\n\n", et ); - printf( "J2000 x-position (km): %20.10f\n", pos[0] ); - printf( "J2000 y-position (km): %20.10f\n", pos[1] ); - printf( "J2000 z-position (km): %20.10f\n", pos[2] ); - } - } - - --Restrictions - - None. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - C.H. Acton (JPL) - B.V. Semenov (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 2.0.5, 04-APR-2008 (NJB) - - Corrected minor error in description of XLT+S aberration - correction. - - -CSPICE Version 2.0.4, 17-APR-2005 (NJB) - - Error was corrected in example program: variable name `state' - was changed to `pos' in printf calls. - - -CSPICE Version 2.0.3, 12-DEC-2004 (NJB) - - Minor header error was corrected. - - -CSPICE Version 2.0.2, 13-OCT-2003 (EDW) - - Various minor header changes were made to improve clarity. - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 2.0.1, 29-JUL-2003 (NJB) (CHA) - - Various minor header changes were made to improve clarity. - - -CSPICE Version 2.0.0, 31-DEC-2001 (NJB) - - Updated to handle aberration corrections for transmission - of radiation. Formerly, only the reception case was - supported. The header was revised and expanded to explain - the functionality of this routine in more detail. - - -CSPICE Version 1.0.0, 29-MAY-1999 (NJB) (WLT) - --Index_Entries - - get target position relative to an observer - get position relative observer corrected for aberrations - read ephemeris data - read trajectory data - --& -*/ - -{ /* Begin spkezp_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkezp_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkezp_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkezp_c", abcorr ); - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - spkezp_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( char * ) abcorr, - ( integer * ) &obs, - ( doublereal * ) ptarg, - ( doublereal * ) lt, - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(abcorr) ); - - - chkout_c ( "spkezp_c" ); - -} /* End spkezp_c */ - - diff --git a/ext/spice/src/cspice/spkezr.c b/ext/spice/src/cspice/spkezr.c deleted file mode 100644 index 155d98c25d..0000000000 --- a/ext/spice/src/cspice/spkezr.c +++ /dev/null @@ -1,1021 +0,0 @@ -/* spkezr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKEZR ( S/P Kernel, easier reader ) */ -/* Subroutine */ int spkezr_(char *targ, doublereal *et, char *ref, char * - abcorr, char *obs, doublereal *starg, doublereal *lt, ftnlen targ_len, - ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzbodn2c_(char *, integer *, logical *, - ftnlen), chkin_(char *, ftnlen); - integer obsid; - extern logical beint_(char *, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - logical found; - char error[80]; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen); - integer targid; - extern /* Subroutine */ int sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - integer ptr; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observing body, optionally corrected for light */ -/* time (planetary aberration) and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body name. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output state vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body name. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as */ -/* an integer string. For example both 'MOON' and */ -/* '301' are legitimate strings that indicate the */ -/* moon is the target body. */ - -/* The target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output state vector should be expressed. This may */ -/* be any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. */ -/* See the description of the output state vector STARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to supply to indicate the */ -/* observer is Earth. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the reference frame specified by REF. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; the last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* The velocity component of STARG is the derivative */ -/* with respect to time of the position component of */ -/* STARG. */ - -/* Units are always km and km/sec. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of target or observer cannot be translated to its */ -/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 3) If the loaded kernels provide insufficient data to */ -/* compute the requested state vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 4) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output state STARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute STARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the state. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve state information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - -/* This routine is identical in function to the routine SPKEZ except */ -/* that it allows you to refer to ephemeris objects by name (via a */ -/* character string). */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations. */ - -/* Use 'NONE', then apply relativistic aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* SPKEZR begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, SPKEZR computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT)*(1-dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* When stellar aberration corrections are used, the rate of */ -/* change of the stellar aberration correction is accounted for */ -/* in the computation of the output velocity. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, SPKEZR computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* consists of the difference */ - -/* T_vel(ET+LT)*(1+dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. Velocities are adjusted to account */ -/* for the rate of change of the stellar aberration correction. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK, then look up a series of */ -/* geometric states of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* CHARACTER*(*) OBSRVR */ -/* PARAMETER ( OBSRVR = 'Earth' ) */ - -/* CHARACTER*(*) TARGET */ -/* PARAMETER ( TARGET = 'Moon' ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL SPKEZR ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . STATE, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* B.V. Semenov (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 27-DEC-2007 (NJB) */ - -/* This routine was upgraded to more accurately compute */ -/* aberration-corrected velocity, and in particular, make it */ -/* more consistent with observer-target positions. */ - -/* When light time corrections are used, the derivative of light */ -/* time with respect to time is now accounted for in the */ -/* computation of observer-target velocities. When the reference */ -/* frame associated with the output state is time-dependent, the */ -/* derivative of light time with respect to time is now accounted */ -/* for in the computation of the rate of change of orientation of */ -/* the reference frame. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - -/* - SPICELIB Version 3.0.2, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 3.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 3.0.0, 31-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - Spicelib Version 2.0.0, 21-FEB-1997 (WLT) */ - -/* Extended the functionality of the routine. Users may */ -/* now entered the id code of an object as an ascii string */ -/* and the string will be converted to the corresponding */ -/* integer representation. */ - -/* - Spicelib Version 1.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* using body names get target state relative to an observer */ -/* get state relative to observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKEZR", (ftnlen)6); - } - -/* Starting from translation of target name to its code */ - - zzbodn2c_(targ, &targid, &found, targ_len); - if (! found) { - if (beint_(targ, targ_len)) { - s_copy(error, " ", (ftnlen)80, (ftnlen)1); - nparsi_(targ, &targid, error, &ptr, targ_len, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - found = FALSE_; - } else { - found = TRUE_; - } - } - } - if (! found) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. Alternatively you may ca" - "ll SPKEZ directly if you know the SPICE ID codes for both '#" - "' and '#' ", (ftnlen)249); - errch_("#", targ, (ftnlen)1, targ_len); - errch_("#", targ, (ftnlen)1, targ_len); - errch_("#", obs, (ftnlen)1, obs_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SPKEZR", (ftnlen)6); - return 0; - } - -/* Now do the same for observer */ - - zzbodn2c_(obs, &obsid, &found, obs_len); - if (! found) { - if (beint_(obs, obs_len)) { - s_copy(error, " ", (ftnlen)80, (ftnlen)1); - nparsi_(obs, &obsid, error, &ptr, obs_len, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - found = FALSE_; - } else { - found = TRUE_; - } - } - } - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE toolkit. Alternatively you may " - "call SPKEZ directly if you know the SPICE ID codes for both " - "'#' and '#' ", (ftnlen)251); - errch_("#", obs, (ftnlen)1, obs_len); - errch_("#", targ, (ftnlen)1, targ_len); - errch_("#", obs, (ftnlen)1, obs_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SPKEZR", (ftnlen)6); - return 0; - } - -/* After all translations are done we can call SPKEZ. */ - - spkez_(&targid, et, ref, abcorr, &obsid, starg, lt, ref_len, abcorr_len); - chkout_("SPKEZR", (ftnlen)6); - return 0; -} /* spkezr_ */ - diff --git a/ext/spice/src/cspice/spkezr_c.c b/ext/spice/src/cspice/spkezr_c.c deleted file mode 100644 index 7f992b9aaa..0000000000 --- a/ext/spice/src/cspice/spkezr_c.c +++ /dev/null @@ -1,866 +0,0 @@ -/* - --Procedure spkezr_c ( S/P Kernel, easier reader ) - --Abstract - - Return the state (position and velocity) of a target body - relative to an observing body, optionally corrected for light - time (planetary aberration) and stellar aberration. - --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 - - SPK - NAIF_IDS - FRAMES - TIME - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spkezr_c ( ConstSpiceChar *targ, - SpiceDouble et, - ConstSpiceChar *ref, - ConstSpiceChar *abcorr, - ConstSpiceChar *obs, - SpiceDouble starg[6], - SpiceDouble *lt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body name. - et I Observer epoch. - ref I Reference frame of output state vector. - abcorr I Aberration correction flag. - obs I Observing body name. - starg O State of target. - lt O One way light time between observer and target. - --Detailed_Input - - targ is the name of a target body. Optionally, you may - supply the integer ID code for the object as - an integer string. For example both "MOON" and - "301" are legitimate strings that indicate the - moon is the target body. - - The target and observer define a state vector whose - position component points from the observer to the - target. - - et is the ephemeris time, expressed as seconds past J2000 - TDB, at which the state of the target body relative to - the observer is to be computed. `et' refers to time at - the observer's location. - - ref is the name of the reference frame relative to which - the output state vector should be expressed. This may - be any frame supported by the SPICE system, including - built-in frames (documented in the Frames Required - Reading) and frames defined by a loaded frame kernel - (FK). - - When `ref' designates a non-inertial frame, the - orientation of the frame is evaluated at an epoch - dependent on the selected aberration correction. - See the description of the output state vector `starg' - for details. - - abcorr indicates the aberration corrections to be applied - to the state of the target body to account for one-way - light time and stellar aberration. See the discussion - in the Particulars section for recommendations on - how to choose aberration corrections. - - `abcorr' may be any of the following: - - "NONE" Apply no correction. Return the - geometric state of the target body - relative to the observer. - - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at - `et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the state of the target at the - moment it emitted photons arriving at - the observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - state obtained with the "LT" option to - account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - state of the target---the position and - velocity of the target as seen by the - observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - state of the target at the moment it - receives photons emitted from the - observer's location at `et'. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - state obtained with the "XLT" option to - account for the observer's velocity - relative to the solar system - barycenter. The position component of - the computed target state indicates the - direction that photons emitted from the - observer's location must be "aimed" to - hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - `abcorr'. - - obs is the name of an observing body. Optionally, you may - supply the ID code of the object as an integer string. - For example, both "EARTH" and "399" are legitimate - strings to supply to indicate the observer is - Earth. - --Detailed_Output - - starg is a Cartesian state vector representing the position - and velocity of the target body relative to the - specified observer. `starg' is corrected for the - specified aberrations, and is expressed with respect - to the reference frame specified by `ref'. The first - three components of `starg' represent the x-, y- and - z-components of the target's position; the last three - components form the corresponding velocity vector. - - The position component of `starg' points from the - observer's location at `et' to the aberration-corrected - location of the target. Note that the sense of the - position vector is independent of the direction of - radiation travel implied by the aberration - correction. - - The velocity component of `starg' is the derivative - with respect to time of the position component of - `starg.' - - Units are always km and km/sec. - - Non-inertial frames are treated as follows: letting - `ltcent' be the one-way light time between the observer - and the central body associated with the frame, the - orientation of the frame is evaluated at et-ltcent, - et+ltcent, or `et' depending on whether the requested - aberration correction is, respectively, for received - radiation, transmitted radiation, or is omitted. `ltcent' - is computed using the method indicated by `abcorr'. - - lt is the one-way light time between the observer and - target in seconds. If the target state is corrected - for aberrations, then `lt' is the one-way light time - between the observer and the light time corrected - target location. - --Parameters - - None. - --Exceptions - - 1) If name of target or observer cannot be translated to its - NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. - - 2) If the reference frame `ref' is not a recognized reference - frame the error SPICE(UNKNOWNFRAME) is signaled. - - 3) If the loaded kernels provide insufficient data to - compute the requested state vector, the deficiency will - be diagnosed by a routine in the call tree of this routine. - - 4) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - --Files - - This routine computes states using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. See the routine furnsh_c and the SPK - and KERNEL Required Reading for further information on loading - (and unloading) kernels. - - If the output state `starg' is to be expressed relative to a - non-inertial frame, or if any of the ephemeris data used to - compute `starg' are expressed relative to a non-inertial frame in - the SPK files providing those data, additional kernels may be - needed to enable the reference frame transformations required to - compute the state. These additional kernels may be C-kernels, PCK - files or frame kernels. Any such kernels must already be loaded - at the time this routine is called. - --Particulars - - This routine is part of the user interface to the SPICE ephemeris - system. It allows you to retrieve state information for any - ephemeris object relative to any other in a reference frame that - is convenient for further computations. - - This routine is identical in function to the routine spkez_c except - that it allows you to refer to ephemeris objects by name (via a - character string). - - - Aberration corrections - ====================== - - In space science or engineering applications one frequently - wishes to know where to point a remote sensing instrument, such - as an optical camera or radio antenna, in order to observe or - otherwise receive radiation from a target. This pointing problem - is complicated by the finite speed of light: one needs to point - to where the target appears to be as opposed to where it actually - is at the epoch of observation. We use the adjectives - "geometric," "uncorrected," or "true" to refer to an actual - position or state of a target at a specified epoch. When a - geometric position or state vector is modified to reflect how it - appears to an observer, we describe that vector by any of the - terms "apparent," "corrected," "aberration corrected," or "light - time and stellar aberration corrected." The SPICE Toolkit can - correct for two phenomena affecting the apparent location of an - object: one-way light time (also called "planetary aberration") and - stellar aberration. - - One-way light time - ------------------ - - Correcting for one-way light time is done by computing, given an - observer and observation epoch, where a target was when the observed - photons departed the target's location. The vector from the - observer to this computed target location is called a "light time - corrected" vector. The light time correction depends on the motion - of the target relative to the solar system barycenter, but it is - independent of the velocity of the observer relative to the solar - system barycenter. Relativistic effects such as light bending and - gravitational delay are not accounted for in the light time - correction performed by this routine. - - Stellar aberration - ------------------ - - The velocity of the observer also affects the apparent location - of a target: photons arriving at the observer are subject to a - "raindrop effect" whereby their velocity relative to the observer - is, using a Newtonian approximation, the photons' velocity - relative to the solar system barycenter minus the velocity of the - observer relative to the solar system barycenter. This effect is - called "stellar aberration." Stellar aberration is independent - of the velocity of the target. The stellar aberration formula - used by this routine does not include (the much smaller) - relativistic effects. - - Stellar aberration corrections are applied after light time - corrections: the light time corrected target position vector is - used as an input to the stellar aberration correction. - - When light time and stellar aberration corrections are both - applied to a geometric position vector, the resulting position - vector indicates where the target "appears to be" from the - observer's location. - - As opposed to computing the apparent position of a target, one - may wish to compute the pointing direction required for - transmission of photons to the target. This also requires correction - of the geometric target position for the effects of light time - and stellar aberration, but in this case the corrections are - computed for radiation traveling *from* the observer to the target. - We will refer to this situation as the "transmission" case. - - The "transmission" light time correction yields the target's - location as it will be when photons emitted from the observer's - location at `et' arrive at the target. The transmission stellar - aberration correction is the inverse of the traditional stellar - aberration correction: it indicates the direction in which - radiation should be emitted so that, using a Newtonian - approximation, the sum of the velocity of the radiation relative - to the observer and of the observer's velocity, relative to the - solar system barycenter, yields a velocity vector that points in - the direction of the light time corrected position of the target. - - One may object to using the term "observer" in the transmission - case, in which radiation is emitted from the observer's location. - The terminology was retained for consistency with earlier - documentation. - - Below, we indicate the aberration corrections to use for some - common applications: - - 1) Find the apparent direction of a target. This is - the most common case for a remote-sensing observation. - - Use "LT+S": apply both light time and stellar - aberration corrections. - - Note that using light time corrections alone ("LT") is - generally not a good way to obtain an approximation to an - apparent target vector: since light time and stellar - aberration corrections often partially cancel each other, - it may be more accurate to use no correction at all than to - use light time alone. - - - 2) Find the corrected pointing direction to radiate a signal - to a target. This computation is often applicable for - implementing communications sessions. - - Use "XLT+S": apply both light time and stellar - aberration corrections for transmission. - - - 3) Compute the apparent position of a target body relative - to a star or other distant object. - - Use "LT" or "LT+S" as needed to match the correction - applied to the position of the distant object. For - example, if a star position is obtained from a catalog, - the position vector may not be corrected for stellar - aberration. In this case, to find the angular - separation of the star and the limb of a planet, the - vector from the observer to the planet should be - corrected for light time but not stellar aberration. - - - 4) Obtain an uncorrected state vector derived directly from - data in an SPK file. - - Use "NONE". - - - 5) Use a geometric state vector as a low-accuracy estimate - of the apparent state for an application where execution - speed is critical. - - Use "NONE". - - - 6) While this routine cannot perform the relativistic - aberration corrections required to compute states - with the highest possible accuracy, it can supply the - geometric states required as inputs to these computations. - - Use "NONE", then apply relativistic aberration - corrections (not available in the SPICE Toolkit). - - - Below, we discuss in more detail how the aberration corrections - applied by this routine are computed. - - Geometric case - ============== - - spkezr_c begins by computing the geometric position T(et) of the - target body relative to the solar system barycenter (SSB). - Subtracting the geometric position of the observer O(et) gives - the geometric position of the target body relative to the - observer. The one-way light time, lt, is given by - - | T(et) - O(et) | - lt = ------------------- - c - - The geometric relationship between the observer, target, and - solar system barycenter is as shown: - - - SSB ---> O(et) - | / - | / - | / - | / T(et) - O(et) - V V - T(et) - - - The returned state consists of the position vector - - T(et) - O(et) - - and a velocity obtained by taking the difference of the - corresponding velocities. In the geometric case, the - returned velocity is actually the time derivative of the - position. - - - Reception case - ============== - - When any of the options "LT", "CN", "LT+S", "CN+S" is selected - for `abcorr', spkezr_c computes the position of the target body at - epoch et-lt, where `lt' is the one-way light time. Let T(t) and - O(t) represent the positions of the target and observer - relative to the solar system barycenter at time t; then `lt' is - the solution of the light-time equation - - | T(et-lt) - O(et) | - lt = ------------------------ (1) - c - - The ratio - - | T(et) - O(et) | - --------------------- (2) - c - - is used as a first approximation to `lt'; inserting (2) into the - right hand side of the light-time equation (1) yields the - "one-iteration" estimate of the one-way light time ("LT"). - Repeating the process until the estimates of `lt' converge yields - the "converged Newtonian" light time estimate ("CN"). - - Subtracting the geometric position of the observer O(et) gives - the position of the target body relative to the observer: - T(et-lt) - O(et). - - SSB ---> O(et) - | \ | - | \ | - | \ | T(et-lt) - O(et) - | \ | - V V V - T(et) T(et-lt) - - The position component of the light time corrected state - is the vector - - T(et-lt) - O(et) - - The velocity component of the light time corrected state - is the difference - - T_vel(et-lt)*(1-d(lt)/d(et)) - O_vel(et) - - where T_vel and O_vel are, respectively, the velocities of the - target and observer relative to the solar system barycenter at - the epochs et-lt and `et'. - - If correction for stellar aberration is requested, the target - position is rotated toward the solar system - barycenter-relative velocity vector of the observer. The - rotation is computed as follows: - - Let r be the light time corrected vector from the observer - to the object, and v be the velocity of the observer with - respect to the solar system barycenter. Let w be the angle - between them. The aberration angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - h = r X v - - Rotate r by phi radians about h to obtain the apparent - position of the object. - - When stellar aberration corrections are used, the rate of change - of the stellar aberration correction is accounted for in the - computation of the output velocity. - - - Transmission case - ================== - - When any of the options "XLT", "XCN", "XLT+S", "XCN+S" is - selected, spkezr_c computes the position of the target body T at - epoch et+lt, where `lt' is the one-way light time. `lt' is the - solution of the light-time equation - - | T(et+lt) - O(et) | - lt = ------------------------ (3) - c - - Subtracting the geometric position of the observer, O(et), - gives the position of the target body relative to the - observer: T(et-lt) - O(et). - - SSB --> O(et) - / | * - / | * T(et+lt) - O(et) - / |* - / *| - V V V - T(et+lt) T(et) - - The position component of the light-time corrected state - is the vector - - T(et+lt) - O(et) - - The velocity component of the light-time corrected state - consists of the difference - - T_vel(et+lt)*(1+d(lt)/d(et)) - O_vel(et) - - where T_vel and O_vel are, respectively, the velocities of the - target and observer relative to the solar system barycenter at - the epochs et+lt and `et'. - - If correction for stellar aberration is requested, the target - position is rotated away from the solar system barycenter- - relative velocity vector of the observer. The rotation is - computed as in the reception case, but the sign of the - rotation angle is negated. - - - Precision of light time corrections - =================================== - - Corrections using one iteration of the light time solution - ---------------------------------------------------------- - - When the requested aberration correction is "LT", "LT+S", - "XLT", or "XLT+S", only one iteration is performed in the - algorithm used to compute lt. - - The relative error in this computation - - | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL - - is at most - - (V/C)**2 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**2, where V is the - velocity of the target relative to an inertial frame and C is - the speed of light. - - For nearly all objects in the solar system V is less than 60 - km/sec. The value of C is 300000 km/sec. Thus the one - iteration solution for `lt' has a potential relative error of - not more than 4*10**-8. This is a potential light time error - of approximately 2*10**-5 seconds per astronomical unit of - distance separating the observer and target. Given the bound - on V cited above: - - As long as the observer and target are - separated by less than 50 astronomical units, - the error in the light time returned using - the one-iteration light time corrections - is less than 1 millisecond. - - - Converged corrections - --------------------- - - When the requested aberration correction is "CN", "CN+S", - "XCN", or "XCN+S", three iterations are performed in the - computation of `lt'. The relative error present in this - solution is at most - - (V/C)**4 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**4. Mathematically the - precision of this computation is better than a nanosecond for - any pair of objects in the solar system. - - However, to model the actual light time between target and - observer one must take into account effects due to general - relativity. These may be as high as a few hundredths of a - millisecond for some objects. - - When one considers the extra time required to compute the - converged Newtonian light time (the state of the target relative - to the solar system barycenter is looked up three times instead - of once) together with the real gain in accuracy, it seems - unlikely that you will want to request either the "CN" or "CN+S" - light time corrections. However, these corrections can be useful - for testing situations where high precision (as opposed to - accuracy) is required. - - - Relativistic Corrections - ========================= - - This routine does not attempt to perform either general or - special relativistic corrections in computing the various - aberration corrections. For many applications relativistic - corrections are not worth the expense of added computation - cycles. If however, your application requires these additional - corrections we suggest you consult the astronomical almanac (page - B36) for a discussion of how to carry out these corrections. - - --Examples - - Load a planetary ephemeris SPK, then look up a series of - geometric states of the moon relative to the earth, - referenced to the J2000 frame. - - #include - #include "SpiceUsr.h" - - int main() - { - - #define ABCORR "NONE" - #define FRAME "J2000" - - /. - The name of the SPK file shown here is fictitious; - you must supply the name of an SPK file available - on your own computer system. - ./ - #define SPK "planetary_spk.bsp" - - /. - ET0 represents the date 2000 Jan 1 12:00:00 TDB. - ./ - #define ET0 0.0 - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 100 - - #define OBSERVER "earth" - #define TARGET "moon" - - - /. - Local variables - ./ - SpiceInt i; - - SpiceDouble et; - SpiceDouble lt; - SpiceDouble state [6]; - - - /. - Load the spk file. - ./ - furnsh_c ( SPK ); - - /. - Step through a series of epochs, looking up a state vector - at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = ET0 + i*STEP; - - spkezr_c ( TARGET, et, FRAME, ABCORR, - OBSERVER, state, < ); - - printf( "\net = %20.10f\n\n", et ); - printf( "J2000 x-position (km): %20.10f\n", state[0] ); - printf( "J2000 y-position (km): %20.10f\n", state[1] ); - printf( "J2000 z-position (km): %20.10f\n", state[2] ); - printf( "J2000 x-velocity (km/s): %20.10f\n", state[3] ); - printf( "J2000 y-velocity (km/s): %20.10f\n", state[4] ); - printf( "J2000 z-velocity (km/s): %20.10f\n", state[5] ); - } - - return ( 0 ); - } - - - --Restrictions - - None. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - C.H. Acton (JPL) - B.V. Semenov (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 3.0.0, 27-DEC-2007 (NJB) - - This routine was upgraded to more accurately compute - aberration-corrected velocity, and in particular, make it - more consistent with observer-target positions. - - When light time corrections are used, the derivative of light - time with respect to time is now accounted for in the - computation of observer-target velocities. When the reference - frame associated with the output state is time-dependent, the - derivative of light time with respect to time is now accounted - for in the computation of the rate of change of orientation of - the reference frame. - - When stellar aberration corrections are used, velocities - now reflect the rate of range of the stellar aberration - correction. - - -CSPICE Version 2.0.2, 13-OCT-2003 (EDW) - - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 2.0.1, 29-JUL-2003 (NJB) (CHA) - - Various minor header changes were made to improve clarity. - - -CSPICE Version 2.0.0, 31-DEC-2001 (NJB) - - Updated to handle aberration corrections for transmission - of radiation. Formerly, only the reception case was - supported. The header was revised and expanded to explain - the functionality of this routine in more detail. - - -CSPICE Version 1.2.0, 29-MAY-1999 (NJB) (BVS) - - Comment correction: the name spkez_c was changed to spkezr_c. - --Index_Entries - - using body names get target state relative to an observer - get state relative to observer corrected for aberrations - read ephemeris data - read trajectory data - --& -*/ - -{ /* Begin spkezr_c */ - - - /* - Participate in tracing. - */ - chkin_c ( "spkezr_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkezr_c", targ ); - CHKFSTR ( CHK_STANDARD, "spkezr_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkezr_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "spkezr_c", obs ); - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - spkezr_ ( ( char * ) targ, - ( doublereal * ) &et, - ( char * ) ref, - ( char * ) abcorr, - ( char * ) obs, - ( doublereal * ) starg, - ( doublereal * ) lt, - ( ftnlen ) strlen(targ), - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obs) ); - - - chkout_c ( "spkezr_c" ); - - -} /* End spkezr_c */ diff --git a/ext/spice/src/cspice/spkgeo.c b/ext/spice/src/cspice/spkgeo.c deleted file mode 100644 index 0f6417fdc9..0000000000 --- a/ext/spice/src/cspice/spkgeo.c +++ /dev/null @@ -1,1063 +0,0 @@ -/* spkgeo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure SPKGEO ( S/P Kernel, geometric state ) */ -/* Subroutine */ int spkgeo_(integer *targ, doublereal *et, char *ref, - integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - integer cobs, legs; - doublereal sobs[6]; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - integer i__; - extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, - doublereal *), etcal_(doublereal *, char *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char oname[40]; - doublereal descr[5]; - integer ctarg[20]; - char ident[40], tname[40]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal starg[120] /* was [6][20] */; - logical nofrm; - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - doublereal stemp[6]; - integer ctpos; - doublereal vtemp[6]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer handle, cframe; - extern /* Subroutine */ int frmchg_(integer *, integer *, doublereal *, - doublereal *); - extern doublereal clight_(void); - integer tframe[20]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - integer tmpfrm; - extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), - spksfs_(integer *, doublereal *, integer *, doublereal *, char *, - logical *, ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *); - doublereal stxfrm[36] /* was [6][6] */; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - integer nct; - doublereal rot[9] /* was [3][3] */; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - char tstring[80]; - -/* $ Abstract */ - -/* Compute the geometric state (position and velocity) of a target */ -/* body relative to an observing body. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* OBS I Observing body. */ -/* STATE O State of target. */ -/* LT O Light time. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine FRMCHG. */ - -/* OBS is the standard NAIF ID code for an observing body. */ - -/* $ Detailed_Output */ - -/* STATE contains the position and velocity of the target */ -/* body, relative to the observing body, corrected */ -/* for the specified aberrations, at epoch ET. STATE */ -/* has six elements: the first three contain the */ -/* target's position; the last three contain the target's */ -/* velocity. These vectors are rotated into the */ -/* specified reference frame. Units are always */ -/* km and km/sec. */ - -/* LT is the one-way light time in seconds from the */ -/* observing body to the geometric position of the */ -/* target body at the specified epoch. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient ephemeris data has been loaded to compute */ -/* the necessary states, the error SPICE(SPKINSUFFDATA) is */ -/* signaled. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* SPKGEO computes the geometric state, T(t), of the target */ -/* body and the geometric state, O(t), of the observing body */ -/* relative to the first common center of motion. Subtracting */ -/* O(t) from T(t) gives the geometric state of the target */ -/* body relative to the observer. */ - - -/* CENTER ----- O(t) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(t) - O(t) */ -/* | / */ -/* T(t) */ - - -/* The one-way light time, tau, is given by */ - - -/* | T(t) - O(t) | */ -/* tau = ----------------- */ -/* c */ - - -/* For example, if the observing body is -94, the Mars Observer */ -/* spacecraft, and the target body is 401, Phobos, then the */ -/* first common center is probably 4, the Mars Barycenter. */ -/* O(t) is the state of -94 relative to 4 and T(t) is the */ -/* state of 401 relative to 4. */ - -/* The center could also be the Solar System Barycenter, body 0. */ -/* For example, if the observer is 399, Earth, and the target */ -/* is 299, Venus, then O(t) would be the state of 399 relative */ -/* to 0 and T(t) would be the state of 299 relative to 0. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the states of the target body and observer */ -/* relative to a common center. SPKGEO reads as many segments */ -/* as necessary, from as many files as necessary, using files */ -/* that have been loaded by previous calls to SPKLEF (load */ -/* ephemeris file). */ - -/* SPKGEO is similar to SPKEZ but returns geometric states */ -/* only, with no option to make planetary (light-time) nor */ -/* stellar aberration corrections. The geometric states */ -/* returned by SPKEZ and SPKGEO are the same. */ - -/* $ Examples */ - -/* The following code example computes the geometric */ -/* state of the moon with respect to the earth and */ -/* then prints the distance of the moon from the */ -/* the earth at a number of epochs. */ - -/* Assume the SPK file SAMPLE.BSP contains ephemeris data */ -/* for the moon relative to earth over the time interval */ -/* from BEGIN to END. */ - -/* INTEGER EARTH */ -/* PARAMETER ( EARTH = 399 ) */ - -/* INTEGER MOON */ -/* PARAMETER ( MOON = 301 ) */ - -/* INTEGER N */ -/* PARAMETER ( N = 100 ) */ - -/* INTEGER HANDLE */ -/* CHARACTER*(20) UTC */ -/* DOUBLE PRECISION BEGIN */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* C */ -/* C Load the binary SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Divide the interval of coverage [BEGIN,END] into */ -/* C N steps. At each step, compute the state, and */ -/* C print out the epoch in UTC time and position norm. */ -/* C */ -/* DELTA = ( END - BEGIN ) / N */ - -/* DO I = 0, N */ - -/* ET = BEGIN + I*DELTA */ - -/* CALL SPKGEO ( MOON, ET, 'J2000', EARTH, STATE, LT ) */ - -/* CALL ET2UTC ( ET, 'C', 0, UTC ) */ - -/* WRITE (*,*) UTC, VNORM ( STATE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The ephemeris files to be used by SPKGEO must be loaded */ -/* by SPKLEF before SPKGEO is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.4.0, 01-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADDG calls. */ - -/* - SPICELIB Version 2.3.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ - -/* - SPICELIB Version 2.2.1, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 2.2.0, 11-APR-1997 (WLT) */ - -/* The routine was modified to take advantage of the fact */ -/* that most state transformation are between inertial frames. */ -/* Looking up a transformation between inertial frames is */ -/* substantially faster than looking up non-inertial */ -/* transformations. Consequently slightly more */ -/* complex code produces about a 50% increase in speed for */ -/* many users. */ - -/* - SPICELIB Version 2.1.0, 26-JUL-1996 (WLT) */ - -/* The routine was upgraded so that potentially redundant */ -/* computations are not performed. */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded so that it can return states */ -/* relative to rotating frames. */ - -/* - 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, 18-JUL-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* geometric state of one body relative to another */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.4.0, 01-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADDG calls. */ - -/* -& */ - -/* This is the idea: */ - -/* Every body moves with respect to some center. The center */ -/* is itself a body, which in turn moves about some other */ -/* center. If we begin at the target body (T), follow */ -/* the chain, */ - -/* T */ -/* \ */ -/* SSB \ */ -/* \ C[1] */ -/* \ / */ -/* \ / */ -/* \ / */ -/* \ / */ -/* C[3]-----------C[2] */ - -/* and avoid circular definitions (A moves about B, and B moves */ -/* about A), eventually we get the state relative to the solar */ -/* system barycenter (which, for our purposes, doesn't move). */ -/* Thus, */ - -/* T = T + C[1] + C[2] + ... + C[n] */ -/* SSB C[1] C[2] [C3] SSB */ - -/* where */ - -/* X */ -/* Y */ - -/* is the state of body X relative to body Y. */ - -/* However, we don't want to follow each chain back to the SSB */ -/* if it isn't necessary. Instead we will just follow the chain */ -/* of the target body and follow the chain of the observing body */ -/* until we find a common node in the tree. */ - -/* In the example below, C is the first common node. We compute */ -/* the state of TARG relative to C and the state of OBS relative */ -/* to C, then subtract the two states. */ - -/* TARG */ -/* \ */ -/* SSB \ */ -/* \ A */ -/* \ / OBS */ -/* \ / | */ -/* \ / | */ -/* \ / | */ -/* B-------------C-----------------D */ - - - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* CHLEN is the maximum length of a chain. That is, */ -/* it is the maximum number of bodies in the chain from */ -/* the target or observer to the SSB. */ - - -/* Local variables */ - - -/* In-line Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKGEO", (ftnlen)6); - } - -/* We take care of the obvious case first. It TARG and OBS are the */ -/* same we can just fill in zero. */ - - if (*targ == *obs) { - *lt = 0.; - cleard_(&c__6, state); - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - -/* CTARG contains the integer codes of the bodies in the */ -/* target body chain, beginning with TARG itself and then */ -/* the successive centers of motion. */ - -/* STARG(1,I) is the state of the target body relative */ -/* to CTARG(I). The id-code of the frame of this state is */ -/* stored in TFRAME(I). */ - -/* COBS and SOBS will contain the centers and states of the */ -/* observing body. (They are single elements instead of arrays */ -/* because we only need the current center and state of the */ -/* observer relative to it.) */ - -/* First, we construct CTARG and STARG. CTARG(1) is */ -/* just the target itself, and STARG(1,1) is just a zero */ -/* vector, that is, the state of the target relative */ -/* to itself. */ - -/* Then we follow the chain, filling up CTARG and STARG */ -/* as we go. We use SPKSFS to search through loaded */ -/* files to find the first segment applicable to CTARG(1) */ -/* and time ET. Then we use SPKPVN to compute the state */ -/* of the body CTARG(1) at ET in the segment that was found */ -/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ - -/* We repeat the process for CTARG(2) and so on, until */ -/* there is no data found for some CTARG(I) or until we */ -/* reach the SSB. */ - -/* Next, we find centers and states in a similar manner */ -/* for the observer. It's a similar construction as */ -/* described above, but I is always 1. COBS and SOBS */ -/* are overwritten with each new center and state, */ -/* beginning at OBS. However, we stop when we encounter */ -/* a common center of motion, that is when COBS is equal */ -/* to CTARG(I) for some I. */ - -/* Finally, we compute the desired state of the target */ -/* relative to the observer by subtracting the state of */ -/* the observing body relative to the common node from */ -/* the state of the target body relative to the common */ -/* node. */ - -/* CTPOS is the position in CTARG of the common node. */ - - -/* Since Inertial frames are the most extensively used frames */ -/* we use the more restrictive routine IRFNUM to attempt to */ -/* look up the id-code for REF. If IRFNUM comes up empty handed */ -/* we then call the more general routine NAMFRM. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - namfrm_(ref, &refid, ref_len); - } - if (refid == 0) { - if (frstnp_(ref, ref_len) > 0) { - setmsg_("The string supplied to specify the reference frame, ('#" - "') contains non-printing characters. The two most commo" - "n causes for this kind of error are: 1. an error in the " - "call to SPKGEO; 2. an uninitialized variable. ", (ftnlen) - 213); - errch_("#", ref, (ftnlen)1, ref_len); - } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { - setmsg_("The string supplied to specify the reference frame is b" - "lank. The most common cause for this kind of error is a" - "n uninitialized variable. ", (ftnlen)137); - } else { - setmsg_("The string supplied to specify the reference frame was " - "'#'. This frame is not recognized. Possible causes for " - "this error are: 1. failure to load the frame definition " - "into the kernel pool; 2. An out-of-date edition of the t" - "oolkit. ", (ftnlen)231); - errch_("#", ref, (ftnlen)1, ref_len); - } - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - } - -/* Fill in CTARG and STARG until no more data is found */ -/* or until we reach the SSB. If the chain gets too */ -/* long to fit in CTARG, that is if I equals CHLEN, */ -/* then overwrite the last elements of CTARG and STARG. */ - -/* Note the check for FAILED in the loop. If SPKSFS */ -/* or SPKPVN happens to fail during execution, and the */ -/* current error handling action is to NOT abort, then */ -/* FOUND may be stuck at TRUE, CTARG(I) will never */ -/* become zero, and the loop will execute indefinitely. */ - - -/* Construct CTARG and STARG. Begin by assigning the */ -/* first elements: TARG and the state of TARG relative */ -/* to itself. */ - - i__ = 1; - ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, - "spkgeo_", (ftnlen)557)] = *targ; - found = TRUE_; - cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgeo_", (ftnlen)560)]); - while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ctarg", i__1, "spkgeo_", (ftnlen)562)] != *obs && - ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", - i__2, "spkgeo_", (ftnlen)562)] != 0) { - -/* Find a file and segment that has state */ -/* data for CTARG(I). */ - - spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ctarg", i__1, "spkgeo_", (ftnlen)571)], et, &handle, descr, - ident, &found, (ftnlen)40); - if (found) { - -/* Get the state of CTARG(I) relative to some */ -/* center of motion. This new center goes in */ -/* CTARG(I+1) and the state is called STEMP. */ - - ++i__; - spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("tframe", i__1, "spkgeo_", (ftnlen) - 581)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen)581)], & - ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "ctarg", i__3, "spkgeo_", (ftnlen)581)]); - -/* Here's what we have. STARG is the state of CTARG(I-1) */ -/* relative to CTARG(I) in reference frame TFRAME(I) */ - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - } - } - tframe[0] = tframe[1]; - -/* If the loop above ended because we ran out of */ -/* room in the arrays CTARG and STARG, then we */ -/* continue finding states but we overwrite the */ -/* last elements of CTARG and STARG. */ - -/* If, as a result, the first common node is */ -/* overwritten, we'll just have to settle for */ -/* the last common node. This will cause a small */ -/* loss of precision, but it's better than other */ -/* alternatives. */ - - if (i__ == 20) { - while(found && ctarg[19] != 0 && ctarg[19] != *obs) { - -/* Find a file and segment that has state */ -/* data for CTARG(CHLEN). */ - - spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) - ; - if (found) { - -/* Get the state of CTARG(CHLEN) relative to */ -/* some center of motion. The new center */ -/* overwrites the old. The state is called */ -/* STEMP. */ - - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); - -/* Add STEMP to the state of TARG relative to */ -/* the old center to get the state of TARG */ -/* relative to the new center. Overwrite */ -/* the last element of STARG. */ - - if (tframe[19] == tmpfrm) { - moved_(&starg[114], &c__6, vtemp); - } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && - tframe[19] <= 21) { - irfrot_(&tframe[19], &tmpfrm, rot); - mxv_(rot, &starg[114], vtemp); - mxv_(rot, &starg[117], &vtemp[3]); - } else { - frmchg_(&tframe[19], &tmpfrm, et, stxfrm); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - mxvg_(stxfrm, &starg[114], &c__6, &c__6, vtemp); - } - vaddg_(vtemp, stemp, &c__6, &starg[114]); - tframe[19] = tmpfrm; - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - } - } - } - nct = i__; - -/* NCT is the number of elements in CTARG, */ -/* the chain length. We have in hand the following information */ - -/* STARG(1...6,K) state of body */ -/* CTARG(K-1) relative to body CTARG(K) in the frame */ -/* TFRAME(K) */ - - -/* For K = 2,..., NCT. */ - -/* CTARG(1) = TARG */ -/* STARG(1...6,1) = ( 0, 0, 0, 0, 0, 0 ) */ -/* TFRAME(1) = TFRAME(2) */ - - -/* Now follow the observer's chain. Assign */ -/* the first values for COBS and SOBS. */ - - cobs = *obs; - cleard_(&c__6, sobs); - -/* Perhaps we have a common node already. */ -/* If so it will be the last node on the */ -/* list CTARG. */ - -/* We let CTPOS will be the position of the common */ -/* node in CTARG if one is found. It will */ -/* be zero if COBS is not found in CTARG. */ - - if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", - i__1, "spkgeo_", (ftnlen)717)] == cobs) { - ctpos = nct; - cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgeo_", (ftnlen)719)]; - } else { - ctpos = 0; - } - -/* Repeat the same loop as above, but each time */ -/* we encounter a new center of motion, check to */ -/* see if it is a common node. (When CTPOS is */ -/* not zero, CTARG(CTPOS) is the first common node.) */ - -/* Note that we don't need a centers array nor a */ -/* states array, just a single center and state */ -/* is sufficient --- we just keep overwriting them. */ -/* When the common node is found, we have everything */ -/* we need in that one center (COBS) and state */ -/* (SOBS-state of the target relative to COBS). */ - - found = TRUE_; - nofrm = TRUE_; - legs = 0; - while(found && cobs != 0 && ctpos == 0) { - -/* Find a file and segment that has state */ -/* data for COBS. */ - - spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); - if (found) { - -/* Get the state of COBS; call it STEMP. */ -/* The center of motion of COBS becomes the */ -/* new COBS. */ - - if (legs == 0) { - spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); - } else { - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); - } - if (nofrm) { - nofrm = FALSE_; - cframe = tmpfrm; - } - -/* Add STEMP to the state of OBS relative to */ -/* the old COBS to get the state of OBS */ -/* relative to the new COBS. */ - - if (cframe == tmpfrm) { - -/* On the first leg of the state of the observer, we */ -/* don't have to add anything, the state of the observer */ -/* is already in SOBS. We only have to add when the */ -/* number of legs in the observer state is one or greater. */ - - if (legs > 0) { - vaddg_(sobs, stemp, &c__6, vtemp); - moved_(vtemp, &c__6, sobs); - } - } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= - 21) { - irfrot_(&cframe, &tmpfrm, rot); - mxv_(rot, sobs, vtemp); - mxv_(rot, &sobs[3], &vtemp[3]); - vaddg_(vtemp, stemp, &c__6, sobs); - cframe = tmpfrm; - } else { - frmchg_(&cframe, &tmpfrm, et, stxfrm); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - mxvg_(stxfrm, sobs, &c__6, &c__6, vtemp); - vaddg_(vtemp, stemp, &c__6, sobs); - cframe = tmpfrm; - } - -/* Check failed. We don't want to loop */ -/* indefinitely. */ - - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - -/* We now have one more leg of the path for OBS. Set */ -/* LEGS to reflect this. Then see if the new center */ -/* is a common node. If not, repeat the loop. */ - - ++legs; - ctpos = isrchi_(&cobs, &nct, ctarg); - } - } - -/* If CTPOS is zero at this point, it means we */ -/* have not found a common node though we have */ -/* searched through all the available data. */ - - if (ctpos == 0) { - bodc2n_(targ, tname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); - repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) - ; - } else { - intstr_(targ, tname, (ftnlen)40); - } - bodc2n_(obs, oname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); - repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); - } else { - intstr_(obs, oname, (ftnlen)40); - } - setmsg_("Insufficient ephemeris data has been loaded to compute the " - "state of TARG relative to OBS at the ephemeris epoch #. ", ( - ftnlen)115); - etcal_(et, tstring, (ftnlen)80); - errch_("TARG", tname, (ftnlen)4, (ftnlen)40); - errch_("OBS", oname, (ftnlen)3, (ftnlen)40); - errch_("#", tstring, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - -/* If CTPOS is not zero, then we have reached a */ -/* common node, specifically, */ - -/* CTARG(CTPOS) = COBS = CENTER */ - -/* (in diagram below). The STATE of the target */ -/* (TARG) relative to the observer (OBS) is just */ - -/* STARG(1,CTPOS) - SOBS. */ - - - -/* SOBS */ -/* CENTER ---------------->OBS */ -/* | . */ -/* | . */ -/* S | . E */ -/* T | . T */ -/* A | . A */ -/* R | . T */ -/* G | . S */ -/* | . */ -/* | . */ -/* V L */ -/* TARG */ - - -/* And the light-time between them is just */ - -/* | STATE | */ -/* LT = --------- */ -/* c */ - - -/* Compute the state of the target relative to CTARG(CTPOS) */ - - if (ctpos == 1) { - tframe[0] = cframe; - } - i__1 = ctpos - 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" - , i__2, "spkgeo_", (ftnlen)915)] == tframe[(i__3 = i__) < 20 - && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgeo_", ( - ftnlen)915)]) { - vaddg_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "spkgeo_", (ftnlen)917)], &starg[( - i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : - s_rnge("starg", i__3, "spkgeo_", (ftnlen)917)], &c__6, - vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen) - 918)]); - } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "spkgeo_", (ftnlen)920)] > 0 && tframe[(i__3 = - i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk" - "geo_", (ftnlen)920)] <= 21 && tframe[(i__2 = i__ - 1) < 20 && - 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgeo_", (ftnlen) - 920)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 - : s_rnge("tframe", i__2, "spkgeo_", (ftnlen)920)] <= 21) { - irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "spkgeo_", (ftnlen)922)], &tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", - i__3, "spkgeo_", (ftnlen)922)], rot); - mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "spkgeo_", (ftnlen)923)], stemp); - mxv_(rot, &starg[(i__2 = i__ * 6 - 3) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "spkgeo_", (ftnlen)924)], &stemp[3]) - ; - vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= - i__2 ? i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen) - 925)], &c__6, vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen) - 926)]); - } else { - frmchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "spkgeo_", (ftnlen)930)], &tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", - i__3, "spkgeo_", (ftnlen)930)], et, stxfrm); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - mxvg_(stxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen)937)], & - c__6, &c__6, stemp); - vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= - i__2 ? i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen) - 938)], &c__6, vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgeo_", (ftnlen) - 939)]); - } - } - -/* To avoid unnecessary frame transformations we'll do */ -/* a bit of extra decision making here. It's a lot */ -/* faster to make logical checks than it is to compute */ -/* frame transformations. */ - - if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", - i__1, "spkgeo_", (ftnlen)952)] == cframe) { - vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgeo_", (ftnlen)954)], sobs, &c__6, - state); - } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgeo_", (ftnlen)956)] == refid) { - -/* If the last frame associated with the target is already */ -/* in the requested output frame, we convert the state of */ -/* the observer to that frame and then subtract the state */ -/* of the observer from the state of the target. */ - - if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - irfrot_(&cframe, &refid, rot); - mxv_(rot, sobs, stemp); - mxv_(rot, &sobs[3], &stemp[3]); - } else { - frmchg_(&cframe, &refid, et, stxfrm); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - mxvg_(stxfrm, sobs, &c__6, &c__6, stemp); - } - -/* We've now transformed SOBS into the requested reference frame. */ -/* Set CFRAME to reflect this. */ - - cframe = refid; - vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgeo_", (ftnlen)988)], stemp, &c__6, - state); - } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgeo_", (ftnlen)991) - ] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "spkgeo_", (ftnlen)991)] <= 21) { - -/* If both frames are inertial we use IRFROT instead of */ -/* FRMCHG to get things into a common frame. */ - - irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgeo_", (ftnlen)997)], &cframe, rot); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgeo_", (ftnlen)998)], stemp); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 3) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgeo_", (ftnlen)999)], &stemp[3]); - vsubg_(stemp, sobs, &c__6, state); - } else { - -/* Use the more general routine FRMCHG to make the transformation. */ - - frmchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgeo_", (ftnlen)1006)], &cframe, et, - stxfrm); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - mxvg_(stxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 - : s_rnge("starg", i__1, "spkgeo_", (ftnlen)1013)], &c__6, & - c__6, stemp); - vsubg_(stemp, sobs, &c__6, state); - } - -/* Finally, rotate as needed into the requested frame. */ - - if (cframe == refid) { - -/* We don't have to do anything in this case. */ - - } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - -/* Since both frames are inertial, we use the more direct */ -/* routine IRFROT to get the transformation to REFID. */ - - irfrot_(&cframe, &refid, rot); - mxv_(rot, state, stemp); - mxv_(rot, &state[3], &stemp[3]); - moved_(stemp, &c__6, state); - } else { - frmchg_(&cframe, &refid, et, stxfrm); - if (failed_()) { - chkout_("SPKGEO", (ftnlen)6); - return 0; - } - mxvg_(stxfrm, state, &c__6, &c__6, stemp); - moved_(stemp, &c__6, state); - } - *lt = vnorm_(state) / clight_(); - chkout_("SPKGEO", (ftnlen)6); - return 0; -} /* spkgeo_ */ - diff --git a/ext/spice/src/cspice/spkgeo_c.c b/ext/spice/src/cspice/spkgeo_c.c deleted file mode 100644 index b740077d22..0000000000 --- a/ext/spice/src/cspice/spkgeo_c.c +++ /dev/null @@ -1,292 +0,0 @@ -/* - --Procedure spkgeo_c ( S/P Kernel, geometric state ) - --Abstract - - Compute the geometric state (position and velocity) of a target - body relative to an observing body. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZfc.h" - - void spkgeo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble state[6], - SpiceDouble * lt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Target epoch. - ref I Target reference frame. - obs I Observing body. - state O State of target. - lt O Light time. - --Detailed_Input - - targ is the standard NAIF ID code for a target body. - - et is the epoch (ephemeris time) at which the state - of the target body is to be computed. - - ref is the name of the reference frame to which the state - vector returned by the routine should be rotated. This - may be any frame supported by the SPICELIB subroutine - FRMCHG. See also the Frames Required Reading for a list - of supported frames. - - obs is the standard NAIF ID code for an observing body. - --Detailed_Output - - state contains the position and velocity of the target - body, relative to the observing body, corrected - for the specified aberrations, at epoch 'et'. 'state' - has six elements: the first three contain the - target's position; the last three contain the target's - velocity. These vectors are rotated into the - specified reference frame. - - Units are always km and km/sec. - - lt is the one-way light time from the observing body - to the geometric position of the target body - in seconds at the specified epoch. - --Parameters - - None. - --Exceptions - - 1) If insufficient ephemeris data have been loaded to compute - the requested state, the error SPICE(SPKINSUFFDATA) is - signalled. - --Files - - See Restrictions. - --Particulars - - spkgeo_c computes the geometric state, T(t), of the target - body and the geometric state, O(t), of the observing body - relative to the first common center of motion. Subtracting - O(t) from T(t) gives the geometric state of the target - body relative to the observer. - - - CENTER ----- O(t) - | / - | / - | / - | / T(t) - O(t) - | / - T(t) - - - The one-way light time, tau, is given by - - - | T(t) - O(t) | - tau = ----------------- - c - - - For example, if the observing body is -94, the Mars Observer - spacecraft, and the target body is 401, Phobos, then the - first common center is probably 4, the Mars Barycenter. - O(t) is the state of -94 relative to 4 and T(t) is the - state of 401 relative to 4. - - The center could also be the Solar System Barycenter, body 0. - For example, if the observer is 399, Earth, and the target - is 299, Venus, then O(t) would be the state of 399 relative - to 0 and T(t) would be the state of 299 relative to 0. - - Ephemeris data from more than one segment may be required - to determine the states of the target body and observer - relative to a common center. spkgeo_c reads as many segments - as necessary, from as many files as necessary, using files - that have been loaded by previous calls to spklef_c (load - ephemeris file). - - spkgeo_c is similar to spkez_c but returns geometric states - only, with no option to make planetary (light-time) nor - stellar aberration corrections. The geometric states - returned by spkez_c and spkgeo_c are the same. - --Examples - - The following code example computes the geometric - state of the moon with respect to the earth and - then prints the distance of the moon from the - the earth at a number of epochs. - - Assume the SPK file sample.bsp contains ephemeris data - for the moon relative to earth over the time interval - from BEGIN to END. - - #include - #include "SpiceUsr.h" - - #define EARTH 399 - #define MOON 301 - #define N 100 - - SpiceChar utc [ 20 ]; - - SpiceInt handle; - - SpiceDouble begin; - SpiceDouble delta; - SpiceDouble end; - SpiceDouble et; - SpiceDouble state [6]; - - - /. - Load the binary SPK ephemeris file. - ./ - spklef_c ( "sample.bsp", &handle ); - - . - . - . - - /. - Divide the interval of coverage [BEGIN,END] into - N steps. At each step, compute the state, and - print out the epoch in UTC time and position norm. - ./ - - delta = ( end - begin ) / n; - - for ( i = 0; i < n; i++ ) - { - et = begin + i*delta; - - spkgeo_c ( moon, et, "j2000", earth, state, < ); - - et2utc_c ( et, "c", 0, UTCLEN, utc ); - - printf ( "UTC = %s; ||pos|| = %f\n", utc, vnorm_c(state) ); - } - - - --Restrictions - - 1) The ephemeris files to be used by spkgeo_c must be loaded - by SPKLEF before spkgeo_c is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.E. McLean (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.1, 13-OCT-2003 (EDW) - - Various minor header changes were made to improve clarity. - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 2.2.0, 11-APR-1997 (WLT) - --Index_Entries - - geometric state of one body relative to another - --& -*/ - -{ /* Begin spkgeo_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkgeo_c" ); - - - /* - Check the input string 'ref' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkgeo_c", ref ); - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - spkgeo_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( integer * ) &obs, - ( doublereal * ) state, - ( doublereal * ) lt, - ( ftnlen ) strlen(ref) ); - - - chkout_c ( "spkgeo_c" ); - -} /* End spkgeo_c */ diff --git a/ext/spice/src/cspice/spkgps.c b/ext/spice/src/cspice/spkgps.c deleted file mode 100644 index 380d22094d..0000000000 --- a/ext/spice/src/cspice/spkgps.c +++ /dev/null @@ -1,1016 +0,0 @@ -/* spkgps.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */ -/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref, - integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - integer cobs, legs; - doublereal sobs[6]; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char oname[40]; - doublereal descr[5]; - integer ctarg[20]; - char ident[40], tname[40]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal starg[120] /* was [6][20] */; - logical nofrm; - doublereal stemp[6]; - integer ctpos; - doublereal vtemp[6]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer handle, cframe; - extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, - doublereal *); - extern doublereal clight_(void); - integer tframe[20]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - integer tmpfrm; - extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), - spksfs_(integer *, doublereal *, integer *, doublereal *, char *, - logical *, ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - doublereal psxfrm[9] /* was [3][3] */; - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *), intstr_(integer *, char *, - ftnlen); - integer nct; - doublereal rot[9] /* was [3][3] */; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - char tstring[80]; - -/* $ Abstract */ - -/* Compute the geometric position of a target body relative to an */ -/* observing body. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* OBS I Observing body. */ -/* POS O Position of target. */ -/* LT O Light time. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the position */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine REFCHG. */ - -/* OBS is the standard NAIF ID code for an observing body. */ - -/* $ Detailed_Output */ - -/* POS contains the position of the target */ -/* body, relative to the observing body. This vector is */ -/* rotated into the specified reference frame. Units */ -/* are always km. */ - -/* LT is the one-way light time from the observing body */ -/* to the geometric position of the target body at the */ -/* specified epoch. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient ephemeris data has been loaded to compute */ -/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */ -/* signalled. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* SPKGPS computes the geometric position, T(t), of the target */ -/* body and the geometric position, O(t), of the observing body */ -/* relative to the first common center of motion. Subtracting */ -/* O(t) from T(t) gives the geometric position of the target */ -/* body relative to the observer. */ - - -/* CENTER ----- O(t) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(t) - O(t) */ -/* | / */ -/* T(t) */ - - -/* The one-way light time, tau, is given by */ - - -/* | T(t) - O(t) | */ -/* tau = ----------------- */ -/* c */ - - -/* For example, if the observing body is -94, the Mars Observer */ -/* spacecraft, and the target body is 401, Phobos, then the */ -/* first common center is probably 4, the Mars Barycenter. */ -/* O(t) is the position of -94 relative to 4 and T(t) is the */ -/* position of 401 relative to 4. */ - -/* The center could also be the Solar System Barycenter, body 0. */ -/* For example, if the observer is 399, Earth, and the target */ -/* is 299, Venus, then O(t) would be the position of 399 relative */ -/* to 0 and T(t) would be the position of 299 relative to 0. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the positions of the target body and observer */ -/* relative to a common center. SPKGPS reads as many segments */ -/* as necessary, from as many files as necessary, using files */ -/* that have been loaded by previous calls to SPKLEF (load */ -/* ephemeris file). */ - -/* SPKGPS is similar to SPKGEO but returns geometric positions */ -/* only. */ - -/* $ Examples */ - -/* The following code example computes the geometric */ -/* position of the moon with respect to the earth and */ -/* then prints the distance of the moon from the */ -/* the earth at a number of epochs. */ - -/* Assume the SPK file SAMPLE.BSP contains ephemeris data */ -/* for the moon relative to earth over the time interval */ -/* from BEGIN to END. */ - -/* INTEGER EARTH */ -/* PARAMETER ( EARTH = 399 ) */ - -/* INTEGER MOON */ -/* PARAMETER ( MOON = 301 ) */ - -/* INTEGER N */ -/* PARAMETER ( N = 100 ) */ - -/* INTEGER HANDLE */ -/* CHARACTER*(20) UTC */ -/* DOUBLE PRECISION BEGIN */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* C */ -/* C Load the binary SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Divide the interval of coverage [BEGIN,END] into */ -/* C N steps. At each step, compute the position, and */ -/* C print out the epoch in UTC time and position norm. */ -/* C */ -/* DELTA = ( END - BEGIN ) / N */ - -/* DO I = 0, N */ - -/* ET = BEGIN + I*DELTA */ - -/* CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */ - -/* CALL ET2UTC ( ET, 'C', 0, UTC ) */ - -/* WRITE (*,*) UTC, VNORM ( POS ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The ephemeris files to be used by SPKGPS must be loaded */ -/* by SPKLEF before SPKGPS is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD calls. */ - -/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ - -/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* geometric position of one body relative to another */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD calls. */ - -/* -& */ - -/* This is the idea: */ - -/* Every body moves with respect to some center. The center */ -/* is itself a body, which in turn moves about some other */ -/* center. If we begin at the target body (T), follow */ -/* the chain, */ - -/* T */ -/* \ */ -/* SSB \ */ -/* \ C[1] */ -/* \ / */ -/* \ / */ -/* \ / */ -/* \ / */ -/* C[3]-----------C[2] */ - -/* and avoid circular definitions (A moves about B, and B moves */ -/* about A), eventually we get the position relative to the solar */ -/* system barycenter (which, for our purposes, doesn't move). */ -/* Thus, */ - -/* T = T + C[1] + C[2] + ... + C[n] */ -/* SSB C[1] C[2] [C3] SSB */ - -/* where */ - -/* X */ -/* Y */ - -/* is the position of body X relative to body Y. */ - -/* However, we don't want to follow each chain back to the SSB */ -/* if it isn't necessary. Instead we will just follow the chain */ -/* of the target body and follow the chain of the observing body */ -/* until we find a common node in the tree. */ - -/* In the example below, C is the first common node. We compute */ -/* the position of TARG relative to C and the position of OBS */ -/* relative to C, then subtract the two positions. */ - -/* TARG */ -/* \ */ -/* SSB \ */ -/* \ A */ -/* \ / OBS */ -/* \ / | */ -/* \ / | */ -/* \ / | */ -/* B-------------C-----------------D */ - - - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* CHLEN is the maximum length of a chain. That is, */ -/* it is the maximum number of bodies in the chain from */ -/* the target or observer to the SSB. */ - - -/* Local variables */ - - -/* In-line Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKGPS", (ftnlen)6); - } - -/* We take care of the obvious case first. It TARG and OBS are the */ -/* same we can just fill in zero. */ - - if (*targ == *obs) { - *lt = 0.; - cleard_(&c__3, pos); - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - -/* CTARG contains the integer codes of the bodies in the */ -/* target body chain, beginning with TARG itself and then */ -/* the successive centers of motion. */ - -/* STARG(1,I) is the position of the target body relative */ -/* to CTARG(I). The id-code of the frame of this position is */ -/* stored in TFRAME(I). */ - -/* COBS and SOBS will contain the centers and positions of the */ -/* observing body. (They are single elements instead of arrays */ -/* because we only need the current center and position of the */ -/* observer relative to it.) */ - -/* First, we construct CTARG and STARG. CTARG(1) is */ -/* just the target itself, and STARG(1,1) is just a zero */ -/* vector, that is, the position of the target relative */ -/* to itself. */ - -/* Then we follow the chain, filling up CTARG and STARG */ -/* as we go. We use SPKSFS to search through loaded */ -/* files to find the first segment applicable to CTARG(1) */ -/* and time ET. Then we use SPKPVN to compute the position */ -/* of the body CTARG(1) at ET in the segment that was found */ -/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ - -/* We repeat the process for CTARG(2) and so on, until */ -/* there is no data found for some CTARG(I) or until we */ -/* reach the SSB. */ - -/* Next, we find centers and positions in a similar manner */ -/* for the observer. It's a similar construction as */ -/* described above, but I is always 1. COBS and SOBS */ -/* are overwritten with each new center and position, */ -/* beginning at OBS. However, we stop when we encounter */ -/* a common center of motion, that is when COBS is equal */ -/* to CTARG(I) for some I. */ - -/* Finally, we compute the desired position of the target */ -/* relative to the observer by subtracting the position of */ -/* the observing body relative to the common node from */ -/* the position of the target body relative to the common */ -/* node. */ - -/* CTPOS is the position in CTARG of the common node. */ - - -/* Since Inertial frames are the most extensively used frames */ -/* we use the more restrictive routine IRFNUM to attempt to */ -/* look up the id-code for REF. If IRFNUM comes up empty handed */ -/* we then call the more general routine NAMFRM. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - namfrm_(ref, &refid, ref_len); - } - if (refid == 0) { - if (frstnp_(ref, ref_len) > 0) { - setmsg_("The string supplied to specify the reference frame, ('#" - "') contains non-printing characters. The two most commo" - "n causes for this kind of error are: 1. an error in the " - "call to SPKGPS; 2. an uninitialized variable. ", (ftnlen) - 213); - errch_("#", ref, (ftnlen)1, ref_len); - } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { - setmsg_("The string supplied to specify the reference frame is b" - "lank. The most common cause for this kind of error is a" - "n uninitialized variable. ", (ftnlen)137); - } else { - setmsg_("The string supplied to specify the reference frame was " - "'#'. This frame is not recognized. Possible causes for " - "this error are: 1. failure to load the frame definition " - "into the kernel pool; 2. An out-of-date edition of the t" - "oolkit. ", (ftnlen)231); - errch_("#", ref, (ftnlen)1, ref_len); - } - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - } - -/* Fill in CTARG and STARG until no more data is found */ -/* or until we reach the SSB. If the chain gets too */ -/* long to fit in CTARG, that is if I equals CHLEN, */ -/* then overwrite the last elements of CTARG and STARG. */ - -/* Note the check for FAILED in the loop. If SPKSFS */ -/* or SPKPVN happens to fail during execution, and the */ -/* current error handling action is to NOT abort, then */ -/* FOUND may be stuck at TRUE, CTARG(I) will never */ -/* become zero, and the loop will execute indefinitely. */ - - -/* Construct CTARG and STARG. Begin by assigning the */ -/* first elements: TARG and the position of TARG relative */ -/* to itself. */ - - i__ = 1; - ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, - "spkgps_", (ftnlen)522)] = *targ; - found = TRUE_; - cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgps_", (ftnlen)525)]); - while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)527)] != *obs && - ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", - i__2, "spkgps_", (ftnlen)527)] != 0) { - -/* Find a file and segment that has position */ -/* data for CTARG(I). */ - - spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ctarg", i__1, "spkgps_", (ftnlen)536)], et, &handle, descr, - ident, &found, (ftnlen)40); - if (found) { - -/* Get the position of CTARG(I) relative to some */ -/* center of motion. This new center goes in */ -/* CTARG(I+1) and the position is called STEMP. */ - - ++i__; - spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen) - 546)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)546)], & - ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "ctarg", i__3, "spkgps_", (ftnlen)546)]); - -/* Here's what we have. STARG is the position of CTARG(I-1) */ -/* relative to CTARG(I) in reference frame TFRAME(I) */ - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - } - } - tframe[0] = tframe[1]; - -/* If the loop above ended because we ran out of */ -/* room in the arrays CTARG and STARG, then we */ -/* continue finding positions but we overwrite the */ -/* last elements of CTARG and STARG. */ - -/* If, as a result, the first common node is */ -/* overwritten, we'll just have to settle for */ -/* the last common node. This will cause a small */ -/* loss of precision, but it's better than other */ -/* alternatives. */ - - if (i__ == 20) { - while(found && ctarg[19] != 0 && ctarg[19] != *obs) { - -/* Find a file and segment that has position */ -/* data for CTARG(CHLEN). */ - - spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) - ; - if (found) { - -/* Get the position of CTARG(CHLEN) relative to */ -/* some center of motion. The new center */ -/* overwrites the old. The position is called */ -/* STEMP. */ - - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); - -/* Add STEMP to the position of TARG relative to */ -/* the old center to get the position of TARG */ -/* relative to the new center. Overwrite */ -/* the last element of STARG. */ - - if (tframe[19] == tmpfrm) { - moved_(&starg[114], &c__3, vtemp); - } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && - tframe[19] <= 21) { - irfrot_(&tframe[19], &tmpfrm, rot); - mxv_(rot, &starg[114], vtemp); - } else { - refchg_(&tframe[19], &tmpfrm, et, psxfrm); - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - mxv_(psxfrm, &starg[114], vtemp); - } - vadd_(vtemp, stemp, &starg[114]); - tframe[19] = tmpfrm; - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - } - } - } - nct = i__; - -/* NCT is the number of elements in CTARG, */ -/* the chain length. We have in hand the following information */ - -/* STARG(1...3,K) position of body */ -/* CTARG(K-1) relative to body CTARG(K) in the frame */ -/* TFRAME(K) */ - - -/* For K = 2,..., NCT. */ - -/* CTARG(1) = TARG */ -/* STARG(1...3,1) = ( 0, 0, 0 ) */ -/* TFRAME(1) = TFRAME(2) */ - - -/* Now follow the observer's chain. Assign */ -/* the first values for COBS and SOBS. */ - - cobs = *obs; - cleard_(&c__6, sobs); - -/* Perhaps we have a common node already. */ -/* If so it will be the last node on the */ -/* list CTARG. */ - -/* We let CTPOS will be the position of the common */ -/* node in CTARG if one is found. It will */ -/* be zero if COBS is not found in CTARG. */ - - if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", - i__1, "spkgps_", (ftnlen)681)] == cobs) { - ctpos = nct; - cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgps_", (ftnlen)683)]; - } else { - ctpos = 0; - } - -/* Repeat the same loop as above, but each time */ -/* we encounter a new center of motion, check to */ -/* see if it is a common node. (When CTPOS is */ -/* not zero, CTARG(CTPOS) is the first common node.) */ - -/* Note that we don't need a centers array nor a */ -/* positions array, just a single center and position */ -/* is sufficient --- we just keep overwriting them. */ -/* When the common node is found, we have everything */ -/* we need in that one center (COBS) and position */ -/* (SOBS-position of the target relative to COBS). */ - - found = TRUE_; - nofrm = TRUE_; - legs = 0; - while(found && cobs != 0 && ctpos == 0) { - -/* Find a file and segment that has position */ -/* data for COBS. */ - - spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); - if (found) { - -/* Get the position of COBS; call it STEMP. */ -/* The center of motion of COBS becomes the */ -/* new COBS. */ - - if (legs == 0) { - spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); - } else { - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); - } - if (nofrm) { - nofrm = FALSE_; - cframe = tmpfrm; - } - -/* Add STEMP to the position of OBS relative to */ -/* the old COBS to get the position of OBS */ -/* relative to the new COBS. */ - - if (cframe == tmpfrm) { - -/* On the first leg of the position of the observer, we */ -/* don't have to add anything, the position of the */ -/* observer is already in SOBS. We only have to add when */ -/* the number of legs in the observer position is one or */ -/* greater. */ - - if (legs > 0) { - vadd_(sobs, stemp, vtemp); - vequ_(vtemp, sobs); - } - } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= - 21) { - irfrot_(&cframe, &tmpfrm, rot); - mxv_(rot, sobs, vtemp); - vadd_(vtemp, stemp, sobs); - cframe = tmpfrm; - } else { - refchg_(&cframe, &tmpfrm, et, psxfrm); - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - mxv_(psxfrm, sobs, vtemp); - vadd_(vtemp, stemp, sobs); - cframe = tmpfrm; - } - -/* Check failed. We don't want to loop */ -/* indefinitely. */ - - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - -/* We now have one more leg of the path for OBS. Set */ -/* LEGS to reflect this. Then see if the new center */ -/* is a common node. If not, repeat the loop. */ - - ++legs; - ctpos = isrchi_(&cobs, &nct, ctarg); - } - } - -/* If CTPOS is zero at this point, it means we */ -/* have not found a common node though we have */ -/* searched through all the available data. */ - - if (ctpos == 0) { - bodc2n_(targ, tname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); - repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) - ; - } else { - intstr_(targ, tname, (ftnlen)40); - } - bodc2n_(obs, oname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); - repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); - } else { - intstr_(obs, oname, (ftnlen)40); - } - setmsg_("Insufficient ephemeris data has been loaded to compute the " - "position of TARG relative to OBS at the ephemeris epoch #. ", - (ftnlen)118); - etcal_(et, tstring, (ftnlen)80); - errch_("TARG", tname, (ftnlen)4, (ftnlen)40); - errch_("OBS", oname, (ftnlen)3, (ftnlen)40); - errch_("#", tstring, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - -/* If CTPOS is not zero, then we have reached a */ -/* common node, specifically, */ - -/* CTARG(CTPOS) = COBS = CENTER */ - -/* (in diagram below). The POSITION of the target */ -/* (TARG) relative to the observer (OBS) is just */ - -/* STARG(1,CTPOS) - SOBS. */ - - - -/* SOBS */ -/* CENTER ---------------->OBS */ -/* | . */ -/* | . N */ -/* S | . O */ -/* T | . I */ -/* A | . T */ -/* R | . I */ -/* G | . S */ -/* | . O */ -/* | . P */ -/* V L */ -/* TARG */ - - -/* And the light-time between them is just */ - -/* | POSITION | */ -/* LT = --------- */ -/* c */ - - -/* Compute the position of the target relative to CTARG(CTPOS) */ - - if (ctpos == 1) { - tframe[0] = cframe; - } - i__1 = ctpos - 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" - , i__2, "spkgps_", (ftnlen)879)] == tframe[(i__3 = i__) < 20 - && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", ( - ftnlen)879)]) { - vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "spkgps_", (ftnlen)881)], &starg[( - i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : - s_rnge("starg", i__3, "spkgps_", (ftnlen)881)], stemp); - moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen) - 882)]); - } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "spkgps_", (ftnlen)884)] > 0 && tframe[(i__3 = - i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk" - "gps_", (ftnlen)884)] <= 21 && tframe[(i__2 = i__ - 1) < 20 && - 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen) - 884)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 - : s_rnge("tframe", i__2, "spkgps_", (ftnlen)884)] <= 21) { - irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "spkgps_", (ftnlen)886)], &tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", - i__3, "spkgps_", (ftnlen)886)], rot); - mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "spkgps_", (ftnlen)887)], stemp); - vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 - ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)888)], - vtemp); - moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen) - 889)]); - } else { - refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "spkgps_", (ftnlen)893)], &tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", - i__3, "spkgps_", (ftnlen)893)], et, psxfrm); - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)900)], - stemp); - vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 - ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)901)], - vtemp); - moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen) - 902)]); - } - } - -/* To avoid unnecessary frame transformations we'll do */ -/* a bit of extra decision making here. It's a lot */ -/* faster to make logical checks than it is to compute */ -/* frame transformations. */ - - if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", - i__1, "spkgps_", (ftnlen)915)] == cframe) { - vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgps_", (ftnlen)917)], sobs, pos); - } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgps_", (ftnlen)919)] == refid) { - -/* If the last frame associated with the target is already */ -/* in the requested output frame, we convert the position of */ -/* the observer to that frame and then subtract the position */ -/* of the observer from the position of the target. */ - - if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - irfrot_(&cframe, &refid, rot); - mxv_(rot, sobs, stemp); - } else { - refchg_(&cframe, &refid, et, psxfrm); - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - mxv_(psxfrm, sobs, stemp); - } - -/* We've now transformed SOBS into the requested reference frame. */ -/* Set CFRAME to reflect this. */ - - cframe = refid; - vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgps_", (ftnlen)950)], stemp, pos); - } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)953) - ] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "spkgps_", (ftnlen)953)] <= 21) { - -/* If both frames are inertial we use IRFROT instead of */ -/* REFCHG to get things into a common frame. */ - - irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgps_", (ftnlen)959)], &cframe, rot); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgps_", (ftnlen)960)], stemp); - vsub_(stemp, sobs, pos); - } else { - -/* Use the more general routine REFCHG to make the transformation. */ - - refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "spkgps_", (ftnlen)967)], &cframe, et, psxfrm) - ; - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "spkgps_", (ftnlen)974)], stemp); - vsub_(stemp, sobs, pos); - } - -/* Finally, rotate as needed into the requested frame. */ - - if (cframe == refid) { - -/* We don't have to do anything in this case. */ - - } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - -/* Since both frames are inertial, we use the more direct */ -/* routine IRFROT to get the transformation to REFID. */ - - irfrot_(&cframe, &refid, rot); - mxv_(rot, pos, stemp); - moved_(stemp, &c__3, pos); - } else { - refchg_(&cframe, &refid, et, psxfrm); - if (failed_()) { - chkout_("SPKGPS", (ftnlen)6); - return 0; - } - mxv_(psxfrm, pos, stemp); - moved_(stemp, &c__3, pos); - } - *lt = vnorm_(pos) / clight_(); - chkout_("SPKGPS", (ftnlen)6); - return 0; -} /* spkgps_ */ - diff --git a/ext/spice/src/cspice/spkgps_c.c b/ext/spice/src/cspice/spkgps_c.c deleted file mode 100644 index c9efd0375b..0000000000 --- a/ext/spice/src/cspice/spkgps_c.c +++ /dev/null @@ -1,282 +0,0 @@ -/* - --Procedure spkgps_c ( S/P Kernel, geometric position ) - --Abstract - - Compute the geometric position of a target body relative to an - observing body. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void spkgps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble pos[3], - SpiceDouble * lt ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Target epoch. - ref I Target reference frame. - obs I Observing body. - pos O Position of target. - lt O Light time. - --Detailed_Input - - targ is the standard NAIF ID code for a target body. - - et is the epoch (ephemeris time) at which the position - of the target body is to be computed. - - ref is the name of the reference frame to - which the vectors returned by the routine should - be rotated. This may be any frame supported by - the CSPICE subroutine sxform_c. - - obs is the standard NAIF ID code for an observing body. - --Detailed_Output - - pos contains the position of the target - body, relative to the observing body. This vector is - rotated into the specified reference frame. Units - are always km. - - lt is the one-way light time from the observing body - to the geometric position of the target body at the - specified epoch. - --Parameters - - None. - --Exceptions - - 1) If insufficient ephemeris data has been loaded to compute - the necessary positions, the error SPICE(SPKINSUFFDATA) is - signalled. - --Files - - See: $Restrictions. - --Particulars - - spkgps_c computes the geometric position, T(t), of the target - body and the geometric position, O(t), of the observing body - relative to the first common center of motion. Subtracting - O(t) from T(t) gives the geometric position of the target - body relative to the observer. - - - CENTER ----- O(t) - | / - | / - | / - | / T(t) - O(t) - | / - T(t) - - - The one-way light time, tau, is given by - - - | T(t) - O(t) | - tau = ----------------- - c - - - For example, if the observing body is -94, the Mars Observer - spacecraft, and the target body is 401, Phobos, then the - first common center is probably 4, the Mars Barycenter. - O(t) is the position of -94 relative to 4 and T(t) is the - position of 401 relative to 4. - - The center could also be the Solar System Barycenter, body 0. - For example, if the observer is 399, Earth, and the target - is 299, Venus, then O(t) would be the position of 399 relative - to 0 and T(t) would be the position of 299 relative to 0. - - Ephemeris data from more than one segment may be required - to determine the positions of the target body and observer - relative to a common center. spkgps_c reads as many segments - as necessary, from as many files as necessary, using files - that have been loaded by previous calls to spklef_c (load - ephemeris file). - - spkgps_c is similar to spkgeo_c but returns geometric positions - only. - --Examples - - The following code example computes the geometric - position of the moon with respect to the earth and - then prints the distance of the moon from the - the earth at a number of epochs. - - Assume the SPK file SAMPLE.BSP contains ephemeris data - for the moon relative to earth over the time interval - whose endpoints are represented by the variables begin and - end. - - - #include - #include "SpiceUsr.h" - . - . - . - - int main() - { - - #define EARTH 399 - #define MOON 301 - #define N 100 - #define TIMLEN 30 - - SpiceChar utc [TIMLEN]; - - SpiceDouble begin; - SpiceDouble delta; - SpiceDouble end; - SpiceDouble et; - SpiceDouble pos [3]; - - SpiceInt handle; - - /. - Load the binary SPK ephemeris file. - ./ - - spklef_c ( "SAMPLE.BSP", &handle ); - - . - . - . - - /. - Divide the interval of coverage [begin,end] into - n steps. At each step, compute the position, and - print out the epoch in UTC time and position norm. - ./ - - delta = ( end - begin ) / n - - for ( i = 0; i < N; i++ ) - { - et = begin + i * delta; - - spkgps_c ( MOON, et, "J2000", EARTH, pos, < ); - - et2utc_c ( et, "C", 0, utc ); - - printf ( "%s %25.15e\n", utc, vnorm_c(pos) ); - } - - return ( 0 ); - } - - --Restrictions - - 1) The ephemeris files to be used by spkgps_c must be loaded - by spklef_c before spkgps_c is called. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.E. McLean (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 30-MAY-1999 (NJB) (JEM) (WLT) - --Index_Entries - - geometric position of one body relative to another - --& -*/ - -{ /* Begin spkgps_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkgps_c" ); - - - /* - Check the input string ref to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkgps_c", ref ); - - /* - Call the f2c'd routine. - */ - - spkgps_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( integer * ) &obs, - ( doublereal * ) pos, - ( doublereal * ) lt, - ( ftnlen ) strlen(ref) ); - - chkout_c ( "spkgps_c" ); - -} /* End spkgps_c */ diff --git a/ext/spice/src/cspice/spklef_c.c b/ext/spice/src/cspice/spklef_c.c deleted file mode 100644 index 819cd34cea..0000000000 --- a/ext/spice/src/cspice/spklef_c.c +++ /dev/null @@ -1,237 +0,0 @@ -/* - --Procedure spklef_c ( S/P Kernel, Load ephemeris file ) - --Abstract - - Load an ephemeris file for use by the readers. Return that file's - handle, to be used by other SPK routines to refer to the file. - --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 - - SPK - --Keywords - - None. - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spklef_c ( ConstSpiceChar * filename, - SpiceInt * handle ) - - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - fname I Name of the file to be loaded. - handle O Loaded file's handle. - --Detailed_Input - - fname is a string containing the name of the file to be - loaded. - --Detailed_Output - - handle is an integer handle assigned to the file upon - loading. Almost every other SPK routine will - subsequently use this number to refer to the file. - --Parameters - - None. - --Exceptions - - The parameter FTSIZE referenced below is defined in the header file - cspicelimits.h. - - 1) If an attempt is made to load more files than is specified - by the parameter FTSIZE, the error "SPICE(SPKFILETABLEFULL)" is - signalled. - - 2) If an attempt is made to open more DAF files than is specified - by the parameter FTSIZE, an error is signalled by a routine that - this routine calls. - --Files - - A file specified by fname, to be loaded. The file is assigned a - handle by spklef_c, which will be used by most other routines to - refer to it. - --Particulars - - Loading an SPK file make the file's data accessible to the CSPICE - SPK readers spkezr_c and spkez_c. - - The maximum number of SPK files that may be loaded at any time is - given by the parameter FTSIZE, which is defined in the header file - cspicelimits.h. After this limit it reached, it is necessary to - unload an SPK file before another can be loaded. The function - spkuef_c is provided to unload files from the SPK system. - --Examples - - 1) Load a planetary ephemeris SPK; then look up a series of - geometric states of the Earth relative to the solar system - barycenter, referenced to the J2000 frame. - - - #define MAXITR 100 - #define ET0 -315576000.0 - #define STEP 3600.0 - - #define ABCORR "NONE" - #define FRAME "J2000" - #define OBSERVER "SOLAR SYSTEM BARYCENTER" - #define SPK "de403.bsp" - #define TARGET "EARTH" - - SpiceInt handle; - SpiceInt i; - - SpiceDouble et; - SpiceDouble lt; - SpiceDouble state [6]; - - - /. - Load the spk file. - ./ - spklef_c ( SPK, &handle ); - - /. - Step through a series of epochs, looking up a state vector - at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = ET0 + i*STEP; - - spkezr_c ( TARGET, et, FRAME, ABCORR, - OBSERVER, state, < ); - - printf( "\net = %20.10f\n\n", et ); - printf( "J2000 x-position (km): %20.10f\n", state[0] ); - printf( "J2000 y-position (km): %20.10f\n", state[1] ); - printf( "J2000 z-position (km): %20.10f\n", state[2] ); - printf( "J2000 x-velocity (km/s): %20.10f\n", state[3] ); - printf( "J2000 y-velocity (km/s): %20.10f\n", state[4] ); - printf( "J2000 z-velocity (km/s): %20.10f\n", state[5] ); - } - --Restrictions - - None. - --Literature_References - - NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and - User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - J.M. Lynch (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 2.0.3, 04-FEB-2008 (BVS) - - Removed duplicate header section '-Exceptions'. - - -CSPICE Version 2.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 2.0.1, 10-NOV-2006 (EDW) - - Added Keywords and Parameters section headers. - Reordered section headers. - - -CSPICE Version 2.0.0, 08-FEB-1998 (NJB) - - Input argument filename changed to type ConstSpiceChar *. - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (EDW) - --Index_Entries - - load spk ephemeris file - --& -*/ - - -{ /* Begin spklef_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spklef_c" ); - - - /* - Check the input string filename to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spklef_c", filename ); - - - /* - Call the f2c'd Fortran routine. - */ - spklef_ ( ( char * ) filename, - ( integer * ) handle, - ( ftnlen ) strlen(filename) ); - - - chkout_c ( "spklef_c" ); - -} /* end spklef_c */ diff --git a/ext/spice/src/cspice/spkltc.c b/ext/spice/src/cspice/spkltc.c deleted file mode 100644 index 1c31dedba9..0000000000 --- a/ext/spice/src/cspice/spkltc.c +++ /dev/null @@ -1,919 +0,0 @@ -/* spkltc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__6 = 6; -static doublereal c_b25 = -1.; - -/* $Procedure SPKLTC ( S/P Kernel, light time corrected state ) */ -/* Subroutine */ int spkltc_(integer *targ, doublereal *et, char *ref, char * - abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, - doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal dist; - extern doublereal vdot_(doublereal *, doublereal *); - static logical xmit; - doublereal a, b, c__; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - static logical usecn; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *, - integer *, doublereal *); - doublereal ssblt; - static logical uselt; - extern doublereal vnorm_(doublereal *); - extern logical failed_(void); - extern doublereal clight_(void); - logical attblk[15]; - extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - doublereal ssbtrg[6]; - integer numitr; - extern logical return_(void); - logical usestl; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time, */ -/* expressed relative to an inertial reference frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* STOBS I State of the observer relative to the SSB. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the input state STOBS and the output state STARG are */ -/* expressed. REF must be recognized by the SPICE */ -/* Toolkit. The acceptable frames are listed in the */ -/* Frames Required Reading, as well as in the SPICELIB */ -/* routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time. See the discussion in the Particulars */ -/* section for recommendations on how to choose */ -/* aberration corrections. */ - -/* If ABCORR includes the stellar aberration correction */ -/* symbol '+S', this flag is simply ignored. Aside from */ -/* the possible presence of this symbol, ABCORR may be */ -/* any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* STOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* STOBS is a 6-vector: the first three components of */ -/* STOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. STOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberration, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for light time, then LT is the one-way light time */ -/* between the observer and the light time-corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) For the convenience of the caller, the input aberration */ -/* correction flag can call for stellar aberration correction via */ -/* inclusion of the '+S' suffix. This portion of the aberration */ -/* correction flag is ignored if present. */ - -/* 2) If ABCORR calls for stellar aberration but not light */ -/* time corrections, the error SPICE(NOTSUPPORTED) is */ -/* signaled. */ - -/* 3) If ABCORR calls for relativistic light time corrections, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 5) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 6) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 7) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* 8) If a division by zero error would occur in the computation */ -/* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ -/* User applications normally will not need to call this routine */ -/* directly. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time corrections. Compute the first state for */ -/* the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */ -/* intervals of 1 hour. For each epoch, display the states, the */ -/* one way light time between target and observer, and the rate of */ -/* change of the one way light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STOBS ( 6 ) */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time ('LT') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ -/* C Before we can execute this computation, we'll need the */ -/* C geometric state of the observer relative to the solar */ -/* C system barycenter at ET, expressed relative to the */ -/* C J2000 reference frame: */ -/* C */ -/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ -/* C */ -/* C Now compute the desired state vector: */ -/* C */ -/* CALL SPKLTC ( 301, ET, 'J2000', 'LT', */ -/* . STOBS, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291569.265 */ -/* J2000 y-position (km): -266709.186 */ -/* J2000 z-position (km): -76099.1551 */ -/* J2000 x-velocity (km/s): 0.643530613 */ -/* J2000 y-velocity (km/s): -0.666081817 */ -/* J2000 z-velocity (km/s): -0.301322832 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289240.781 */ -/* J2000 y-position (km): -269096.441 */ -/* J2000 z-position (km): -77180.8997 */ -/* J2000 x-velocity (km/s): 0.650062115 */ -/* J2000 y-velocity (km/s): -0.660162739 */ -/* J2000 z-velocity (km/s): -0.299642674 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286888.887 */ -/* J2000 y-position (km): -271462.302 */ -/* J2000 z-position (km): -78256.5557 */ -/* J2000 x-velocity (km/s): 0.656535992 */ -/* J2000 y-velocity (km/s): -0.654196577 */ -/* J2000 z-velocity (km/s): -0.297940273 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284513.792 */ -/* J2000 y-position (km): -273806.6 */ -/* J2000 z-position (km): -79326.0432 */ -/* J2000 x-velocity (km/s): 0.662951901 */ -/* J2000 y-velocity (km/s): -0.648183807 */ -/* J2000 z-velocity (km/s): -0.296215779 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282115.704 */ -/* J2000 y-position (km): -276129.17 */ -/* J2000 z-position (km): -80389.283 */ -/* J2000 x-velocity (km/s): 0.669309504 */ -/* J2000 y-velocity (km/s): -0.642124908 */ -/* J2000 z-velocity (km/s): -0.294469343 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) The routine SPKGEO should be used instead of this routine */ -/* to compute geometric states. SPKGEO introduces less */ -/* round-off error when the observer and target have common */ -/* center that is closer to both objects than is the solar */ -/* system barycenter. */ - -/* 2) The kernel files to be used by SPKLTC must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level light time correction */ -/* light-time corrected state from spk file */ -/* get light-time corrected state */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* TOL is the tolerance used for a division-by-zero test */ -/* performed prior to computation of DLT. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKLTC", (ftnlen)6); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SPKLTC", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SPKLTC", (ftnlen)6); - return 0; - } else if (attblk[5]) { - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SPKLTC", (ftnlen)6); - return 0; - } - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("SPKLTC", (ftnlen)6); - return 0; - } - -/* Find the geometric state of the target body with respect to */ -/* the solar system barycenter. Subtract the state of the */ -/* observer to get the relative state. Use this to compute the */ -/* one-way light time. */ - - spkgeo_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len); - vsubg_(ssbtrg, stobs, &c__6, starg); - dist = vnorm_(starg); - *lt = dist / clight_(); - if (*lt == 0.) { - -/* This can happen only if the observer and target are at the */ -/* same position. We don't consider this an error, but we're not */ -/* going to compute the light time derivative. */ - - *dlt = 0.; - chkout_("SPKLTC", (ftnlen)6); - return 0; - } - if (! uselt) { - -/* This is a special case: we're not using light time */ -/* corrections, so the derivative */ -/* of light time is just */ - -/* (1/c) * d(VNORM(STARG))/dt */ - - *dlt = vdot_(starg, &starg[3]) / (dist * clight_()); - -/* LT and DLT are both set, so we can return. */ - - chkout_("SPKLTC", (ftnlen)6); - return 0; - } - -/* To correct for light time, find the state of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where it is. */ - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Let NUMITR be the number of iterations we'll perform to */ -/* compute the light time. */ - - if (usecn) { - numitr = 3; - } else { - numitr = 1; - } - i__1 = numitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - spkgeo_(targ, &d__1, ref, &c__0, ssbtrg, &ssblt, ref_len); - vsubg_(ssbtrg, stobs, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - } - -/* At this point, STARG contains the light time corrected */ -/* state of the target relative to the observer. */ - -/* Compute the derivative of light time with respect */ -/* to time: dLT/dt. Below we derive the formula for */ -/* this quantity for the reception case. Let */ - -/* POBS be the position of the observer relative to the */ -/* solar system barycenter. */ - -/* VOBS be the velocity of the observer relative to the */ -/* solar system barycenter. */ - -/* PTARG be the position of the target relative to the */ -/* solar system barycenter. */ - -/* VTARG be the velocity of the target relative to the */ -/* solar system barycenter. */ - -/* S be the sign of the light time correction. S is */ -/* negative for the reception case. */ - -/* The light-time corrected position of the target relative to */ -/* the observer at observation time ET, given the one-way */ -/* light time LT is: */ - -/* PTARG(ET+S*LT) - POBS(ET) */ - -/* The light-time corrected velocity of the target relative to */ -/* the observer at observation time ET is */ - -/* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */ - -/* We need to compute dLT/dt. Below, we use the facts that, */ -/* for a time-dependent vector X(t), */ - -/* ||X|| = ** (1/2) */ - -/* d(||X||)/dt = (1/2)**(-1/2) * 2 * */ - -/* = **(-1/2) * */ - -/* = / ||X|| */ - -/* Newtonian light time equation: */ - -/* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */ - -/* Differentiate both sides: */ - -/* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* * < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */ - - -/* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* * ( < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT) - VOBS(ET) > */ - -/* + < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */ - -/* Let */ - -/* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */ - -/* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */ - -/* Then */ - -/* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */ - -/* which implies */ - -/* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */ - - - - a = 1. / (clight_() * vnorm_(starg)); - b = vdot_(starg, &starg[3]); - c__ = vdot_(starg, &ssbtrg[3]); - -/* For physically realistic target velocities, S*C*A cannot equal 1. */ -/* We'll check for this case anyway. */ - - if (ltsign * c__ * a > .99999999989999999) { - setmsg_("Target range rate magnitude is approximately the speed of l" - "ight. The light time derivative cannot be computed.", (ftnlen) - 110); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("SPKLTC", (ftnlen)6); - return 0; - } - -/* Compute DLT: the rate of change of light time. */ - - *dlt = a * b / (1. - ltsign * c__ * a); - -/* Overwrite the velocity portion of the output state */ -/* with the light-time corrected velocity. */ - - d__1 = ltsign * *dlt + 1.; - vlcom_(&d__1, &ssbtrg[3], &c_b25, &stobs[3], &starg[3]); - chkout_("SPKLTC", (ftnlen)6); - return 0; -} /* spkltc_ */ - diff --git a/ext/spice/src/cspice/spkltc_c.c b/ext/spice/src/cspice/spkltc_c.c deleted file mode 100644 index c6fe3cbdba..0000000000 --- a/ext/spice/src/cspice/spkltc_c.c +++ /dev/null @@ -1,526 +0,0 @@ -/* - --Procedure spkltc_c ( S/P Kernel, light time corrected state ) - --Abstract - - Return the state (position and velocity) of a target body - relative to an observer, optionally corrected for light time, - expressed relative to an inertial reference frame. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #undef spkltc_c - - - void spkltc_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Observer epoch. - ref I Inertial reference frame of output state. - abcorr I Aberration correction flag. - stobs I State of the observer relative to the SSB. - starg O State of target. - lt O One way light time between observer and target. - dlt O Derivative of light time with respect to time. - --Detailed_Input - - targ is the NAIF ID code for a target body. The target - and observer define a state vector whose position - component points from the observer to the target. - - et is the ephemeris time, expressed as seconds past - J2000 TDB, at which the state of the target body - relative to the observer is to be computed. `et' - refers to time at the observer's location. - - ref is the inertial reference frame with respect to which - the input state `stobs' and the output state `starg' are - expressed. `ref' must be recognized by the CSPICE - Toolkit. The acceptable frames are listed in the Frames - Required Reading, as well as in the CSPICE routine - chgirf_. - - Case and blanks are not significant in the string - `ref'. - - abcorr indicates the aberration corrections to be applied to - the state of the target body to account for one-way - light time. See the discussion in the Particulars - section for recommendations on how to choose - aberration corrections. - - If `abcorr' includes the stellar aberration correction - symbol "+S", this flag is simply ignored. Aside from - the possible presence of this symbol, `abcorr' may be - any of the following: - - "NONE" Apply no correction. Return the - geometric state of the target body - relative to the observer. - - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at `et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the state of the target at the - moment it emitted photons arriving at - the observer at `et'. - - The light time correction involves - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - state of the target at the moment it - receives photons emitted from the - observer's location at `et'. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - `abcorr'. - - stobs is the geometric state of the observer relative - to the solar system barycenter at `et'. The - target and observer define a state vector whose - position component points from the observer to the - target. `stobs' is expressed relative to the reference - frame designated by `ref'. - --Detailed_Output - - starg is a Cartesian state vector representing the position - and velocity of the target body relative to the - specified observer. `starg' is corrected for the - specified aberration, and is expressed with respect - to the specified inertial reference frame. The first - three components of `starg' represent the x-, y- and - z-components of the target's position; last three - components form the corresponding velocity vector. - - The position component of `starg' points from the - observer's location at `et' to the aberration-corrected - location of the target. Note that the sense of the - position vector is independent of the direction of - radiation travel implied by the aberration - correction. - - Units are always km and km/sec. - - lt is the one-way light time between the observer and - target in seconds. If the target state is corrected - for light time, then `lt' is the one-way light time - between the observer and the light time-corrected - target location. - - dlt is the derivative with respect to barycentric - dynamical time of the one way light time between - target and observer: - - dlt = d(lt)/d(et) - - `dlt' can also be described as the rate of change of - one way light time. `dlt' is unitless, since `lt' and - `et' both have units of TDB seconds. - - If the observer and target are at the same position, - then `dlt' is set to zero. - --Parameters - - None. - --Exceptions - - 1) For the convenience of the caller, the input aberration - correction flag can call for stellar aberration correction via - inclusion of the '+S' suffix. This portion of the aberration - correction flag is ignored if present. - - 2) If `abcorr' calls for stellar aberration but not light - time corrections, the error SPICE(NOTSUPPORTED) is - signaled. - - 3) If `abcorr' calls for relativistic light time corrections, the - error SPICE(NOTSUPPORTED) is signaled. - - 4) If the value of `abcorr' is not recognized, the error - is diagnosed by routines in the call tree of this routine. - - 5) If the reference frame requested is not a recognized - inertial reference frame, the error SPICE(BADFRAME) - is signaled. - - 6) If the state of the target relative to the solar system - barycenter cannot be computed, the error is diagnosed - by routines in the call tree of this routine. - - 7) If the observer and target are at the same position, - then `dlt' is set to zero. This situation could arise, - for example, when the observer is Mars and the target - is the Mars barycenter. - - 8) If a division by zero error would occur in the computation - of `dlt', the error SPICE(DIVIDEBYZERO) is signaled. - - 9) The error SPICE(EMPTYSTRING) is signaled if either of the input - strings `ref' or `abcorr' do not contain at least one character, - since such an input string cannot be converted to a - Fortran-style string. - - 10) The error SPICE(NULLPOINTER) is signaled if either of the input - string pointers `ref' or `abcorr' are null. - --Files - - This routine computes states using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. Application programs typically load - kernels once before this routine is called, for example during - program initialization; kernels need not be loaded repeatedly. - See the routine furnsh_c and the SPK and KERNEL Required Reading - for further information on loading (and unloading) kernels. - - If any of the ephemeris data used to compute `starg' are expressed - relative to a non-inertial frame in the SPK files providing those - data, additional kernels may be needed to enable the reference - frame transformations required to compute the state. Normally - these additional kernels are PCK files or frame kernels. Any - such kernels must already be loaded at the time this routine is - called. - --Particulars - - This routine supports higher-level SPK API routines that can - perform both light time and stellar aberration corrections. - User applications normally will not need to call this routine - directly. - - See the header of the routine spkezr_c for a detailed discussion - of aberration corrections. - --Examples - - - 1) Look up a sequence of states of the Moon as seen from the - Earth. Use light time corrections. Compute the first state for - the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at - intervals of 1 hour. For each epoch, display the states, the one - way light time between target and observer, and the rate of - change of the one way light time. - - Use the following meta-kernel to specify the kernels to - load: - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls' ) - - \begintext - - - The code example follows: - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - - The meta-kernel name shown here refers to a file whose contents - are those shown above. This file and the kernels it references - must exist in your current working directory. - ./ - #define META "example.mk" - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 5 - - /. - Local variables - ./ - SpiceDouble dlt; - SpiceDouble et; - SpiceDouble et0; - SpiceDouble lt; - SpiceDouble state [6]; - SpiceDouble stobs [6]; - SpiceInt i; - - /. - Load the SPK and LSK kernels via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the start time to seconds past J2000 TDB. - ./ - str2et_c ( "2000 JAN 1 12:00:00 TDB", &et0 ); - - /. - Step through a series of epochs, looking up a - state vector at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = et0 + i*STEP; - - /. - Look up a state vector at epoch ET using the - following inputs: - - Target: Moon (NAIF ID code 301) - Reference frame: J2000 - Aberration correction: Light time ('LT') - Observer: Earth (NAIF ID code 399) - - Before we can execute this computation, we'll need - the geometric state of the observer relative to the - solar system barycenter at ET, expressed relative - to the J2000 reference frame: - ./ - spkssb_c ( 399, et, "j2000", stobs ); - - spkltc_c ( 301, et, "j2000", "lt", - stobs, state, <, &dlt ); - - printf( "et = %20.6f\n", et ); - printf( "J2000 x-position (km): %20.8f\n", state[0] ); - printf( "J2000 y-position (km): %20.8f\n", state[1] ); - printf( "J2000 z-position (km): %20.8f\n", state[2] ); - printf( "J2000 x-velocity (km/s): %20.12f\n", state[3] ); - printf( "J2000 y-velocity (km/s): %20.12f\n", state[4] ); - printf( "J2000 z-velocity (km/s): %20.12f\n", state[5] ); - printf( "One-way light time (s): %20.12f\n", lt ); - printf( "Light time rate: %20.08e\n\n", dlt ); - } - return ( 0 ); - } - - - The output produced by this program will vary somewhat as - a function of the platform on which the program is built and - executed. On a PC/Linux/gcc platform, the following output - was produced: - - et = 0.000000 - J2000 x-position (km): -291569.26541283 - J2000 y-position (km): -266709.18647826 - J2000 z-position (km): -76099.15511876 - J2000 x-velocity (km/s): 0.643530613222 - J2000 y-velocity (km/s): -0.666081817008 - J2000 z-velocity (km/s): -0.301322831796 - One-way light time (s): 1.342310610325 - Light time rate: 1.07316909e-07 - - et = 3600.000000 - J2000 x-position (km): -289240.78128184 - J2000 y-position (km): -269096.44087958 - J2000 z-position (km): -77180.89972576 - J2000 x-velocity (km/s): 0.650062115201 - J2000 y-velocity (km/s): -0.660162739217 - J2000 z-velocity (km/s): -0.299642673906 - One-way light time (s): 1.342693954864 - Light time rate: 1.05652599e-07 - - et = 7200.000000 - J2000 x-position (km): -286888.88736709 - J2000 y-position (km): -271462.30170548 - J2000 z-position (km): -78256.55568214 - J2000 x-velocity (km/s): 0.656535991543 - J2000 y-velocity (km/s): -0.654196576804 - J2000 z-velocity (km/s): -0.297940273074 - One-way light time (s): 1.343071311734 - Light time rate: 1.03990457e-07 - - et = 10800.000000 - J2000 x-position (km): -284513.79173691 - J2000 y-position (km): -273806.60031034 - J2000 z-position (km): -79326.04318327 - J2000 x-velocity (km/s): 0.662951900546 - J2000 y-velocity (km/s): -0.648183807097 - J2000 z-velocity (km/s): -0.296215779371 - One-way light time (s): 1.343442689069 - Light time rate: 1.02330665e-07 - - et = 14400.000000 - J2000 x-position (km): -282115.70368389 - J2000 y-position (km): -276129.16976799 - J2000 z-position (km): -80389.28296571 - J2000 x-velocity (km/s): 0.669309503775 - J2000 y-velocity (km/s): -0.642124908057 - J2000 z-velocity (km/s): -0.294469343362 - One-way light time (s): 1.343808095656 - Light time rate: 1.00673404e-07 - - --Restrictions - - 1) The kernel files to be used by spkltc_c must be loaded - (normally by the CSPICE kernel loader furnsh_c) before - this routine is called. - - 2) Unlike most other SPK state computation routines, this - routine requires that the output state be relative to an - inertial reference frame. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 11-JAN-2008 (NJB) - --Index_Entries - - low-level light time correction - light-time corrected state from spk file - get light-time corrected state - --& -*/ - -{ /* Begin spkltc_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkltc_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkltc_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkltc_c", abcorr ); - - - spkltc_ ( (integer *) &targ, - (doublereal *) &et, - (char *) ref, - (char *) abcorr, - (doublereal *) stobs, - (doublereal *) starg, - (doublereal *) lt, - (doublereal *) dlt, - (ftnlen ) strlen(ref), - (ftnlen ) strlen(abcorr) ); - - chkout_c ( "spkltc_c" ); - -} /* End spkltc_c */ diff --git a/ext/spice/src/cspice/spkobj.c b/ext/spice/src/cspice/spkobj.c deleted file mode 100644 index 45e3844c0c..0000000000 --- a/ext/spice/src/cspice/spkobj.c +++ /dev/null @@ -1,422 +0,0 @@ -/* spkobj.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKOBJ ( SPK objects ) */ -/* Subroutine */ int spkobj_(char *spk, integer *ids, ftnlen spk_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[80]; - extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - logical found; - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), insrti_(integer *, integer *); - char kertyp[80]; - extern logical return_(void); - -/* $ Abstract */ - -/* Find the set of ID codes of all objects in a specified SPK file. */ - -/* $ 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 */ - -/* CELLS */ -/* DAF */ -/* SETS */ -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SPK I Name of SPK file. */ -/* IDS I/O Set of ID codes of objects in SPK file. */ - -/* $ Detailed_Input */ - -/* SPK is the name of an SPK file. */ - -/* IDS is an initialized SPICELIB set data structure. */ -/* IDS optionally may contain a set of ID codes on */ -/* input; on output, the data already present in */ -/* IDS will be combined with ID code set found for the */ -/* file SPK. */ - -/* If IDS contains no data on input, its size and */ -/* cardinality still must be initialized. */ - -/* $ Detailed_Output */ - -/* IDS is a SPICELIB set data structure which contains */ -/* the union of its contents upon input with the set */ -/* of ID codes of each object for which ephemeris */ -/* data are present in the indicated SPK file. The */ -/* elements of SPICELIB sets are unique; hence each */ -/* ID code in IDS appears only once, even if the SPK */ -/* file contains multiple segments for that ID code. */ - -/* See the Examples section below for a complete */ -/* example program showing how to retrieve the ID */ -/* codes from IDS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input file has transfer format, the error */ -/* SPICE(INVALIDFORMAT) is signaled. */ - -/* 2) If the input file is not a transfer file but has architecture */ -/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */ - -/* 3) If the input file is a binary DAF file of type other than */ -/* SPK, the error SPICE(BADFILETYPE) is signaled. */ - -/* 4) If the SPK file cannot be opened or read, the error will */ -/* be diagnosed by routines called by this routine. */ - -/* 5) If the size of the output set argument IDS is insufficient to */ -/* contain the actual number of ID codes of objects covered by */ -/* the indicated SPK file, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides an API via which applications can determine */ -/* the set of objects for which there are ephemeris data in a */ -/* specified SPK file. */ - -/* $ Examples */ - -/* 1) Display the coverage for each object in a specified SPK file. */ -/* Find the set of objects in the file. Loop over the contents */ -/* of the ID code set: find the coverage for each item in the */ -/* set and display the coverage. */ - -/* PROGRAM IDCOV */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER CARDI */ -/* INTEGER WNCARD */ -/* C */ -/* C Local parameters */ -/* C */ -/* C */ -/* C Declare the coverage window. Make enough room */ -/* C for MAXIV intervals. */ -/* C */ -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXIV */ -/* PARAMETER ( MAXIV = 1000 ) */ - -/* INTEGER WINSIZ */ -/* PARAMETER ( WINSIZ = 2 * MAXIV ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER MAXOBJ */ -/* PARAMETER ( MAXOBJ = 1000 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(FILSIZ) LSK */ -/* CHARACTER*(FILSIZ) SPK */ -/* CHARACTER*(TIMLEN) TIMSTR */ - -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */ -/* DOUBLE PRECISION E */ - -/* INTEGER I */ -/* INTEGER IDS ( LBCELL : MAXOBJ ) */ -/* INTEGER J */ -/* INTEGER NIV */ - - -/* C */ -/* C Load a leapseconds kernel for output time conversion. */ -/* C SPKCOV itself does not require a leapseconds kernel. */ -/* C */ -/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */ -/* CALL FURNSH ( LSK ) */ - -/* C */ -/* C Get name of SPK file. */ -/* C */ -/* CALL PROMPT ( 'Name of SPK file > ', SPK ) */ - -/* C */ -/* C Initialize the set IDS. */ -/* C */ -/* CALL SSIZEI ( MAXOBJ, IDS ) */ - -/* C */ -/* C Initialize the window COVER. */ -/* C */ -/* CALL SSIZED ( WINSIZ, COVER ) */ - -/* C */ -/* C Find the set of objects in the SPK file. */ -/* C */ -/* CALL SPKOBJ ( SPK, IDS ) */ - -/* C */ -/* C We want to display the coverage for each object. Loop */ -/* C over the contents of the ID code set, find the coverage */ -/* C for each item in the set, and display the coverage. */ -/* C */ -/* DO I = 1, CARDI( IDS ) */ -/* C */ -/* C Find the coverage window for the current */ -/* C object. Empty the coverage window each time */ -/* C so we don't include data for the previous object. */ -/* C */ -/* CALL SCARDD ( 0, COVER ) */ -/* CALL SPKCOV ( SPK, IDS(I), COVER ) */ - -/* C */ -/* C Get the number of intervals in the coverage */ -/* C window. */ -/* C */ -/* NIV = WNCARD ( COVER ) */ - -/* C */ -/* C Display a simple banner. */ -/* C */ -/* WRITE (*,*) '========================================' */ -/* WRITE (*,*) 'Coverage for object ', IDS(I) */ - -/* C */ -/* C Convert the coverage interval start and stop */ -/* C times to TDB calendar strings. */ -/* C */ -/* DO J = 1, NIV */ -/* C */ -/* C Get the endpoints of the Jth interval. */ -/* C */ -/* CALL WNFETD ( COVER, J, B, E ) */ -/* C */ -/* C Convert the endpoints to TDB calendar */ -/* C format time strings and display them. */ -/* C */ -/* CALL TIMOUT ( B, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Interval: ', J */ -/* WRITE (*,*) 'Start: ', TIMSTR */ - -/* CALL TIMOUT ( E, */ -/* . 'YYYY MON DD HR:MN:SC.### ' // */ -/* . '(TDB) ::TDB', */ -/* . TIMSTR ) */ -/* WRITE (*,*) 'Stop: ', TIMSTR */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* WRITE (*,*) '========================================' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) If an error occurs while this routine is updating the set */ -/* IDS, the set may be corrupted. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */ - -/* Corrected bug in program in header Examples section: */ -/* program now empties the coverage window prior to collecting */ -/* data for the current object. Deleted declaration of unused */ -/* parameter NAMLEN in example program. Updated example to */ -/* use WNCARD rather than CARDD. */ - -/* - SPICELIB Version 1.0.0, 30-DEC-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find id codes of objects in spk file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKOBJ", (ftnlen)6); - -/* See whether GETFAT thinks we've got an SPK file. */ - - getfat_(spk, arch, kertyp, spk_len, (ftnlen)80, (ftnlen)80); - if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "SPK file to be readable by this routine. If the input file " - "is an SPK file in transfer format, run TOBIN on the file to " - "convert it to binary format.", (ftnlen)207); - errch_("#", spk, (ftnlen)1, spk_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("SPKOBJ", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has architecture #. The file must be a binary " - "SPK file to be readable by this routine. Binary SPK files h" - "ave DAF architecture. If you expected the file to be a bina" - "ry SPK file, the problem may be due to the file being an old" - " non-native file lacking binary file format information. It'" - "s also possible the file has been corrupted.", (ftnlen)343); - errch_("#", spk, (ftnlen)1, spk_len); - errch_("#", arch, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22); - chkout_("SPKOBJ", (ftnlen)6); - return 0; - } else if (s_cmp(kertyp, "SPK", (ftnlen)80, (ftnlen)3) != 0) { - setmsg_("Input file # has file type #. The file must be a binary SPK" - " file to be readable by this routine. If you expected the fi" - "le to be a binary SPK file, the problem may be due to the fi" - "le being an old non-native file lacking binary file format i" - "nformation. It's also possible the file has been corrupted.", - (ftnlen)298); - errch_("#", spk, (ftnlen)1, spk_len); - errch_("#", kertyp, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22); - chkout_("SPKOBJ", (ftnlen)6); - return 0; - } - -/* Open the file for reading. */ - - dafopr_(spk, &handle, spk_len); - if (failed_()) { - chkout_("SPKOBJ", (ftnlen)6); - return 0; - } - -/* We will examine each segment descriptor in the file, and */ -/* we'll update our ID code set according to the data found */ -/* in these descriptors. */ - -/* Start a forward search. */ - - dafbfs_(&handle); - -/* Find the next DAF array. */ - - daffna_(&found); - while(found && ! failed_()) { - -/* Fetch and unpack the segment descriptor. */ - - dafgs_(descr); - dafus_(descr, &c__2, &c__6, dc, ic); - -/* Insert the current ID code into the output set. */ -/* The insertion algorithm will handle duplicates; no special */ -/* action is required here. */ - - insrti_(ic, ids); - daffna_(&found); - } - -/* Release the file. */ - - dafcls_(&handle); - chkout_("SPKOBJ", (ftnlen)6); - return 0; -} /* spkobj_ */ - diff --git a/ext/spice/src/cspice/spkobj_c.c b/ext/spice/src/cspice/spkobj_c.c deleted file mode 100644 index 97faa195f9..0000000000 --- a/ext/spice/src/cspice/spkobj_c.c +++ /dev/null @@ -1,337 +0,0 @@ -/* - --Procedure spkobj_c ( SPK objects ) - --Abstract - - Find the set of ID codes of all objects in a specified SPK file. - --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 - - CELLS - DAF - SETS - SPK - --Keywords - - EPHEMERIS - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spkobj_c ( ConstSpiceChar * spk, - SpiceCell * ids ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - spk I Name of SPK file. - ids I/O Set of ID codes of objects in SPK file. - --Detailed_Input - - spk is the name of an SPK file. - - ids is an initialized CSPICE set data structure. - `ids' optionally may contain a set of ID codes on - input; on output, the data already present in - `ids' will be combined with ID code set found for the - file `spk'. - - If `ids' contains no data on input, its size and - cardinality still must be initialized. - --Detailed_Output - - ids is a CSPICE set data structure which contains - the union of its contents upon input with the set - of ID codes of each object for which ephemeris - data are present in the indicated SPK file. The - elements of CSPICE sets are unique; hence each - ID code in `ids' appears only once, even if the SPK - file contains multiple segments for that ID code. - - See the Examples section below for a complete - example program showing how to retrieve the ID - codes from `ids'. - --Parameters - - None. - --Exceptions - - 1) If the input file has transfer format, the error - SPICE(INVALIDFORMAT) is signaled. - - 2) If the input file is not a transfer file but has architecture - other than DAF, the error SPICE(BADARCHTYPE) is signaled. - - 3) If the input file is a binary DAF file of type other than - SPK, the error SPICE(BADFILETYPE) is signaled. - - 4) If the SPK file cannot be opened or read, the error will - be diagnosed by routines called by this routine. - - 5) If the size of the output set argument `ids' is insufficient to - contain the actual number of ID codes of objects covered by - the indicated SPK file, the error will be diagnosed by - routines called by this routine. - - 6) The error SPICE(EMPTYSTRING) is signaled if the input - string `spk' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 7) The error SPICE(NULLPOINTER) is signaled if the input string - pointer `spk' is null. - --Files - - This routine reads an SPK file. - --Particulars - - This routine provides an API via which applications can determine - the set of objects for which there are ephemeris data in a - specified SPK file. - --Examples - - 1) Display the coverage for each object in a specified SPK file. - Find the set of objects in the file. Loop over the contents - of the ID code set: find the coverage for each item in the - set and display the coverage. - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local parameters - ./ - #define FILSIZ 256 - #define MAXIV 1000 - #define WINSIZ ( 2 * MAXIV ) - #define TIMLEN 51 - #define MAXOBJ 1000 - - /. - Local variables - ./ - SPICEDOUBLE_CELL ( cover, WINSIZ ); - SPICEINT_CELL ( ids, MAXOBJ ); - - SpiceChar lsk [ FILSIZ ]; - SpiceChar spk [ FILSIZ ]; - SpiceChar timstr [ TIMLEN ]; - - SpiceDouble b; - SpiceDouble e; - - SpiceInt i; - SpiceInt j; - SpiceInt niv; - SpiceInt obj; - - - /. - Load a leapseconds kernel for output time conversion. - SPKCOV itself does not require a leapseconds kernel. - ./ - prompt_c ( "Name of leapseconds kernel > ", FILSIZ, lsk ); - furnsh_c ( lsk ); - - /. - Get name of SPK file. - ./ - prompt_c ( "Name of SPK file > ", FILSIZ, spk ); - - /. - Find the set of objects in the SPK file. - ./ - spkobj_c ( spk, &ids ); - - /. - We want to display the coverage for each object. Loop over - the contents of the ID code set, find the coverage for - each item in the set, and display the coverage. - ./ - for ( i = 0; i < card_c( &ids ); i++ ) - { - /. - Find the coverage window for the current object. - Empty the coverage window each time so we don't - include data for the previous object. - ./ - obj = SPICE_CELL_ELEM_I( &ids, i ); - - scard_c ( 0, &cover ); - spkcov_c ( spk, obj, &cover ); - - /. - Get the number of intervals in the coverage window. - ./ - niv = wncard_c ( &cover ); - - /. - Display a simple banner. - ./ - printf ( "%s\n", "========================================" ); - - printf ( "Coverage for object %ld\n", obj ); - - /. - Convert the coverage interval start and stop times to TDB - calendar strings. - ./ - for ( j = 0; j < niv; j++ ) - { - /. - Get the endpoints of the jth interval. - ./ - wnfetd_c ( &cover, j, &b, &e ); - - /. - Convert the endpoints to TDB calendar - format time strings and display them. - ./ - timout_c ( b, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - - printf ( "\n" - "Interval: %ld\n" - "Start: %s\n", - j, - timstr ); - - timout_c ( e, - "YYYY MON DD HR:MN:SC.### (TDB) ::TDB", - TIMLEN, - timstr ); - printf ( "Stop: %s\n", timstr ); - - } - - } - return ( 0 ); - } - - --Restrictions - - 1) If an error occurs while this routine is updating the set - `ids', the set may be corrupted. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 30-NOV-2007 (NJB) - - Corrected bug in first example program in header: - program now empties result window prior to collecting - data for each object. Deleted declaration of unused - constant NAMLEN. Updated example to use wncard_c - rather than card_c. - - -CSPICE Version 1.0.0, 30-DEC-2004 (NJB) - --Index_Entries - - find id codes in spk file - --& -*/ - -{ /* Begin spkobj_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "spkobj_c" ); - - - /* - Check the input string `spk' to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkobj_c", spk ); - - /* - Make sure cell data type is SpiceInt. - */ - CELLTYPECHK ( CHK_STANDARD, "spkobj_c", SPICE_INT, ids ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( ids ); - - /* - Call the f2c'd Fortran routine. - */ - spkobj_ ( ( char * ) spk, - ( integer * ) (ids->base), - ( ftnlen ) strlen(spk) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, ids ); - } - - - chkout_c ( "spkobj_c" ); - -} /* End spkobj_c */ diff --git a/ext/spice/src/cspice/spkopa.c b/ext/spice/src/cspice/spkopa.c deleted file mode 100644 index 4e5b8c4331..0000000000 --- a/ext/spice/src/cspice/spkopa.c +++ /dev/null @@ -1,225 +0,0 @@ -/* spkopa.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKOPA ( SPK open for addition ) */ -/* Subroutine */ int spkopa_(char *file, integer *handle, ftnlen file_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[8], type__[8]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), dafopw_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical exists_(char *, ftnlen), return_(void); - -/* $ Abstract */ - -/* Open an existing SPK file for subsequent write. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I The name of an existing SPK file. */ -/* HANDLE O A handle attached to the SPK file opened for write. */ - -/* $ Detailed_Input */ - -/* FILE is the name of an existing SPK file to which */ -/* you wish to append additional SPK segments. */ - -/* $ Detailed_Output */ - -/* HANDLE is the DAF handle attached to the file required */ -/* by any of the SPK writing routines. If any exceptions */ -/* arise that prevent opening of the specified file for */ -/* writing, HANDLE will be returned with the value 0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file specified does not exist the error */ -/* 'SPICE(FILENOTFOUND)' will be signalled. */ - -/* 2) If the file specified is not an SPK file, the error */ -/* 'SPICE(FILEISNOTSPK)' will be signalled. */ - -/* All other exceptions are determined by routines in the */ -/* call tree of this routine. */ - -/* $ Particulars */ - -/* This file provides an interface for opening existing SPK */ -/* files for the addition of SPK segments. If you need */ -/* to open an new SPK file for writing, call the routine SPKOPN. */ - -/* $ Examples */ - -/* Suppose you have collected data for a type 05 spk segment and */ -/* wish to place the new segment in an existing SPK file. The */ -/* code fragment below shows one set of calls that you could perform */ -/* to make the addition. (Note that you could add segments of */ -/* other data types by replacing the call to SPKW05 with a suitably */ -/* modified call to another SPKWxx routine.) */ - -/* We assume that the following variables have already been */ -/* assigned the proper values: */ - -/* BODY (integer) Body code for ephemeris object. */ -/* CENTER (integer) Body code for the center of motion */ -/* of the body. */ -/* FRAME (string) The reference frame of the states. */ -/* FIRST (d.p.) First valid time for which states can be */ -/* computed in seconds past 2000. */ -/* LAST (d.p.) Last valid time for which states can */ -/* be computed in seconds past 2000. */ -/* GM (d.p.) Gravitational mass of central body. */ -/* N (integer) Number of states and epochs. */ -/* STATES (d.p.) Array of states (x,y,z,dx,dy,dz). */ -/* EPOCHS (d.p.) Array of epochs (seconds past 2000.) */ -/* SEGID (string) Segment identifier */ - - -/* Begin by opening the file. */ - -/* CALL SPKOPA ( FILE, HANDLE ) */ - -/* Now add the collected data as a new segment. */ - -/* CALL SPKW05 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, SEGID, */ -/* . GM, N, STATES, EPOCHS ) */ - -/* Finally, close the file. */ - -/* CALL SPKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-MAR-1999 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Open an existing SPK file for adding segments */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKOPA", (ftnlen)6); - -/* Until we get a legitimate handle we set HANDLE to zero. */ - - *handle = 0; - -/* First make sure the file exists. */ - - if (! exists_(file, file_len)) { - setmsg_("The file '#' is not recognized as an existing file. ", ( - ftnlen)52); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19); - chkout_("SPKOPA", (ftnlen)6); - return 0; - } - -/* Next make sure it is an SPK file. */ - - getfat_(file, arch, type__, file_len, (ftnlen)8, (ftnlen)8); - if (failed_()) { - chkout_("SPKOPA", (ftnlen)6); - return 0; - } - if (s_cmp(arch, "DAF", (ftnlen)8, (ftnlen)3) != 0 || s_cmp(type__, "SPK", - (ftnlen)8, (ftnlen)3) != 0) { - setmsg_("The file '#' was not an SPK file. The architecture and typ" - "e of the file were found to be '#' and '#' respectively. ", ( - ftnlen)116); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", arch, (ftnlen)1, (ftnlen)8); - errch_("#", type__, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(FILEISNOTSPK)", (ftnlen)19); - chkout_("SPKOPA", (ftnlen)6); - return 0; - } - -/* That's the limit of the checks performed here. We let DAFOPW */ -/* handle the remaining checks. */ - - dafopw_(file, handle, file_len); - if (failed_()) { - *handle = 0; - } - chkout_("SPKOPA", (ftnlen)6); - return 0; -} /* spkopa_ */ - diff --git a/ext/spice/src/cspice/spkopa_c.c b/ext/spice/src/cspice/spkopa_c.c deleted file mode 100644 index 08f6c5427b..0000000000 --- a/ext/spice/src/cspice/spkopa_c.c +++ /dev/null @@ -1,199 +0,0 @@ -/* - --Procedure spkopa_c ( SPK open for addition ) - --Abstract - - Open an existing SPK file for subsequent write. - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void spkopa_c ( ConstSpiceChar * file, - SpiceInt * handle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - file I The name of an existing SPK file. - handle O A handle attached to the SPK file opened to append. - --Detailed_Input - - file is the name of an existing SPK file to which - you wish to append additional SPK segments. - --Detailed_Output - - handle is the DAF integer handle that refers to the SPK file - opened for appending. - --Parameters - - None. - --Files - - See arguments file and handle. - --Exceptions - - 1) If the file specified does not exist the error - SPICE(FILENOTFOUND) will be signalled. - - 2) If the file specified is not an SPK file, the error - SPICE(FILEISNOTSPK) will be signalled. - - 3) If the string pointer file is null, the error - SPICE(NULLPOINTER) will be signaled. - - 4) If the string file has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - All other exceptions are determined by routines in the call - tree of this routine. If any exceptions arise that prevent - opening of the specified file for writing, HANDLE will be - returned with the value 0. - --Particulars - - This file provides an interface for opening existing SPK - files for the addition of SPK segments. If you need - to open an new SPK file for writing, call the routine SPKOPN. - --Examples - - Suppose you have collected data for a type 05 SPK segment and - wish to place the new segment in an existing SPK file. The - code fragment below shows one set of calls that you could perform - to make the addition. (Note that you could add segments of - other data types by replacing the call to spkw05_c with a suitably - modified call to another spkwXX_c routine.) - - We assume that the following variables have already been - assigned the proper values: - - body (integer) Body code for ephemeris object. - center (integer) body code for the center of motion - of the body. - frame (string) the reference frame of the states. - first (d.p.) first valid time for which states can be - computed in seconds past 2000. - last (d.p.) last valid time for which states can - be computed in seconds past 2000. - gm (d.p.) gravitational mass of central body. - n (integer) number of states and epochs. - states (d.p.) array of states (x,y,z,dx,dy,dz). - epochs (d.p.) array of epochs (seconds past 2000.) - segid (string) segment identifier - - - #include "SpiceUsr.h" - . - . - . - - /. - Begin by opening the file. - ./ - spkopa_c ( file, &handle ); - - /. - Now add the collected data as a new segment. - ./ - - spkw05_c ( handle, body, center, frame, first, last, segid, - gm, n, states, epochs ); - - /. - Finally, close the file. - ./ - - spkcls_c ( handle ); - --Restrictions - - None. - --Author_and_Institution - - F.S. Turner (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 16-MAR-1999 (FST) - --Index_Entries - - Open an existing SPK file for adding segments - --& -*/ - -{ /* Begin spkopa_c */ - - /* - Participate in error tracing. - */ - - chkin_c ( "spkopa_c" ); - - /* - Check the input string file to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkopa_c", file ); - - /* - Call the f2c'd Fortran routine. - */ - spkopa_ ( ( char * ) file, - ( integer * ) handle, - ( ftnlen ) strlen(file) ); - - chkout_c ( "spkopa_c" ); - -} /* End spkopa_c */ diff --git a/ext/spice/src/cspice/spkopn.c b/ext/spice/src/cspice/spkopn.c deleted file mode 100644 index c38d5ad19f..0000000000 --- a/ext/spice/src/cspice/spkopn.c +++ /dev/null @@ -1,216 +0,0 @@ -/* spkopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKOPN ( SPK, open new file. ) */ -/* Subroutine */ int spkopn_(char *name__, char *ifname, integer *ncomch, - integer *handle, ftnlen name_len, ftnlen ifname_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncomr; - extern logical failed_(void); - extern /* Subroutine */ int dafonw_(char *, char *, integer *, integer *, - char *, integer *, integer *, ftnlen, ftnlen, ftnlen), chkout_( - char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Create a new SPK file, returning the handle of the opened file. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of the new SPK file to be created. */ -/* IFNAME I The internal filename for the SPK file. */ -/* NCOMCH I The number of characters to reserve for comments. */ -/* HANDLE O The handle of the opened SPK file. */ - -/* $ Detailed_Input */ - -/* NAME The name of the new SPK file to be created. */ - -/* IFNAME The internal filename for the SPK file that is being */ -/* created. The internal filename may be up to 60 characters */ -/* long. If you do not have any conventions for tagging your */ -/* files, an internal filename of 'SPK_file' is perfectly */ -/* acceptable. You may also leave it blank if you like. */ - -/* NCOMCH This is the space, measured in characters, to be */ -/* initially set aside for the comment area when a new SPK */ -/* file is opened. The amount of space actually set aside */ -/* may be greater than the amount requested, due to the */ -/* manner in which comment records are allocated in an SPK */ -/* file. However, the amount of space set aside for comments */ -/* will always be at least the amount that was requested. */ - -/* The value of NCOMCH should be greater than or equal to */ -/* zero, i.e., 0 <= NCOMCH. A negative value, should one */ -/* occur, will be assumed to be zero. */ - -/* $ Detailed_Output */ - -/* HANDLE The handle of the opened SPK file. If an error occurs */ -/* when opening the file, the value of this variable should */ -/* not be used, as it will not represent a valid handle. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of NCOMCH is negative, a value of zero (0) will */ -/* be used for the number of comment characters to be set aside */ -/* for comments. */ - -/* 2) If an error occurs while attempting to open a CK file the */ -/* value of HANDLE will not represent a valid file handle. */ - -/* $ Files */ - -/* See NAME and HANDLE. */ - -/* $ Particulars */ - -/* Open a new SPK file, reserving room for comments if requested. */ - -/* $ Examples */ - -/* Suppose that you want to create a new SPK file called 'new.spk' */ -/* that contains a single type 5 SPK segment and has room for at */ -/* least 5000 comment characters. The following code fragment should */ -/* take care of this for you, assuming that all of the variables */ -/* passed to the SPK type 5 segment writer have appropriate values */ -/* and no errors occur. */ - -/* NAME = 'new.spk' */ -/* IFNAME = 'Test SPK file' */ - -/* CALL SPKOPN ( NAME, IFNAME, 5000, HANDLE ) */ -/* CALL SPKW05 ( HANDLE, OBJID, CNTRID, CFRAME, ETBEG, */ -/* . ETEND, SEGMID, CNTRGM, NSTATE, STATE, */ -/* . EPOCH ) */ -/* CALL SPKCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 09-NOV-2006 (NJB) */ - -/* Routine has been upgraded to support comment */ -/* area allocation using NCOMCH. */ - -/* - SPICELIB Version 1.0.0, 26-JAN-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* open a new spk file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* DAF ND and NI values for SPK files. */ - - -/* Length of a DAF comment record, in characters. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKOPN", (ftnlen)6); - -/* Compute the number of comment records that we want to allocate, if */ -/* the number of comment characters requested is greater than zero, */ -/* we always allocate an extra record to account for the end of line */ -/* marks in the comment area. */ - - - if (*ncomch > 0) { - ncomr = (*ncomch - 1) / 1000 + 1; - } else { - ncomr = 0; - } - -/* Just do it. All of the error handling is taken care of for us. */ - - dafonw_(name__, "SPK", &c__2, &c__6, ifname, &ncomr, handle, name_len, ( - ftnlen)3, ifname_len); - if (failed_()) { - -/* If we failed, make sure that HANDLE does not contain a value */ -/* that represents a valid DAF file handle. */ - - *handle = 0; - } - chkout_("SPKOPN", (ftnlen)6); - return 0; -} /* spkopn_ */ - diff --git a/ext/spice/src/cspice/spkopn_c.c b/ext/spice/src/cspice/spkopn_c.c deleted file mode 100644 index 162003bc01..0000000000 --- a/ext/spice/src/cspice/spkopn_c.c +++ /dev/null @@ -1,204 +0,0 @@ -/* - --Procedure spkopn_c ( SPK, open new file. ) - --Abstract - - Create a new SPK file, returning the handle of the opened file. - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void spkopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I The name of the new SPK file to be created. - ifname I The internal filename for the SPK file. - ncomch I The number of characters to reserve for comments. - handle O The handle of the opened SPK file. - --Detailed_Input - - name The name of the new SPK file to be created. - - ifname The internal filename for the SPK file that is being - created. The internal filename may be up to 60 characters - long. If you do not have any conventions for tagging your - files, an internal filename of "SPK_file" is perfectly - acceptable. You may also leave it blank if you like. - - ncomch This is the space, measured in characters, to be - initially set aside for the comment area when a new SPK - file is opened. The amount of space actually set aside - may be greater than the amount requested, due to the - manner in which comment records are allocated in an SPK - file. However, the amount of space set aside for comments - will always be at least the amount that was requested. - - The value of ncomch should be greater than or equal to - zero, i.e., 0 <= ncomch. A negative value, should one - occur, will be assumed to be zero. - --Detailed_Output - - handle The handle of the opened SPK file. If an error occurs - when opening the file, the value of this variable should - not be used, as it will not represent a valid handle. - --Parameters - - None. - --Exceptions - - 1) If the value of ncomch is negative, a value of zero (0) will - be used for the number of comment characters to be set aside - for comments. - - 2) If an error occurs while attempting to open a CK file, the - value of handle will not represent a valid file handle. - - 3) If any input string pointers are null, the error - SPICE(NULLPOINTER) will be signaled. - - 4) If any input strings have length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - See arguments name and handle. - --Particulars - - Open a new SPK file, reserving room for comments if requested. - --Examples - - Suppose that you want to create a new SPK file called 'new.spk' - that contains a single type 5 SPK segment and has room for at - least 5000 comment characters. The following code fragment should - take care of this for you, assuming that all of the variables - passed to the SPK type 5 segment writer have appropriate values - and no errors occur. - - #include "SpiceUsr.h" - . - . - . - name = "new.spk"; - ifname = "test spk file"; - - spkopn_c ( name, ifname, 5000, &handle ); - spkw05_c ( handle, objid, cntrid, cframe, etbeg, - etend, segmid, cntrgm, nstate, state, - epoch ); - spkcls_c ( handle ); - --Restrictions - - None. - --Author_and_Institution - - F.S. Turner (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 20-APR-2005 (NJB) - - Bug fix: address, rather than value, of `ncomch' is now - passed to spkopn_. - - Header comments indicating that `ncomch' is not used have - been deleted. - - -CSPICE Version 1.0.0, 16-MAR-1999 (FST) - --Index_Entries - - open a new spk file - --& -*/ - -{ /* Begin spkopn_c */ - - /* - Participate in error tracing. - */ - - chkin_c ( "spkopn_c" ); - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkopn_c", name ); - - /* - Check the input string ifname to make sure the pointer is - non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkopn_c", ifname ); - - /* - Call the f2c'd Fortran routine. - */ - spkopn_ ( ( char * ) name, - ( char * ) ifname, - ( integer * ) &ncomch, - ( integer * ) handle, - ( ftnlen ) strlen(name), - ( ftnlen ) strlen(ifname) ); - - chkout_c ( "spkopn_c" ); - -} /* End spkopn_c */ diff --git a/ext/spice/src/cspice/spkpds.c b/ext/spice/src/cspice/spkpds.c deleted file mode 100644 index e6a644109e..0000000000 --- a/ext/spice/src/cspice/spkpds.c +++ /dev/null @@ -1,287 +0,0 @@ -/* spkpds.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKPDS ( SPK pack descriptor ) */ -/* Subroutine */ int spkpds_(integer *body, integer *center, char *frame, - integer *type__, doublereal *first, doublereal *last, doublereal * - descr, ftnlen frame_len) -{ - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), dafps_(integer *, integer *, doublereal *, - integer *, doublereal *), errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen); - integer ipart[6], refcod; - char calfst[40]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - char callst[40]; - doublereal dppart[2]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Perform routine error checks and if all check pass, pack the */ -/* descriptor for an SPK segment */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I The NAIF ID code for the body of the segment. */ -/* CENTER I The center of motion for BODY. */ -/* FRAME I The frame for this segment. */ -/* TYPE I The type of SPK segment to create. */ -/* FIRST I The first epoch for which the segment is valid. */ -/* LAST I The last epoch for which the segment is valid. */ -/* DESCR O An SPK segment descriptor. */ - -/* $ Detailed_Input */ - -/* BODY is the NAIF ID code for the body of the segment. */ - -/* CENTER is the center of motion for BODY. */ - -/* FRAME is a string that names the frame to which states for */ -/* the body shall be referenced. */ - -/* TYPE is the type of SPK segment to create. */ - -/* FIRST is the first epoch for which the segment will have */ -/* ephemeris data. */ - -/* LAST is the last epoch for which the segment will have */ -/* ephemeris data. */ - -/* $ Detailed_Output */ - -/* DESCR is a valid SPK segment descriptor to use */ -/* when creating a DAF segment for this body. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine for validating and creating */ -/* the descriptor for an SPK segment. It is intended for */ -/* use only by routines that create SPK segments. */ - -/* $ Examples */ - -/* Suppose that you wish to create an SPK segment of type X */ -/* and that you are writing a routine to handle the details */ -/* of the segment creation. This routine can be used to */ -/* ensure that the descriptor needed for the segment is */ -/* properly formed and that the information in that descriptor */ -/* is reasonable. */ - -/* Having collected the needed information you can create the */ -/* descriptor and then begin a new segment as shown below. */ - -/* CALL SPKPDS ( BODY, CENTER, FRAME, TYPE, FIRST, LAST, DESCR ) */ -/* CALL DAFBNA ( HANDLE, DESCR, SEGID ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(BARYCENTEREPHEM)' is signalled if the */ -/* value of BODY is 0. */ - -/* 2) The error 'SPICE(BODYANDCENTERSAME)' is signalled if the */ -/* values of BODY and CENTER are the same. */ - -/* 3) The error 'SPICE(INVALIDREFFRAME)' is signalled if FRAME */ -/* is not one of the known SPICE reference frames. */ - -/* 4) The error 'SPICE(BADDESCRTIMES)' is signalled if FIRST */ -/* is greater than or equal to LAST */ - -/* 5) The error 'SPICE(UNKNOWNSPKTYPE)' is signalled if the */ -/* value of TYPE is outside the range 1 to 1000 (inclusive). */ -/* This does not ensure that the TYPE is a legitimate SPK */ -/* segment type, but it is a simple check that helps avoid */ -/* problems that arise from uninitialized values or improperly */ -/* ordered calling arguments. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 1995-SEP-19 (WLT) */ - -/* Upgraded the routine to support non-inertial frames. */ - -/* - SPICELIB Version 1.0.0, 1994-JAN-4 (WLT) (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* Validate and pack an SPK segment descriptor */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* ND and NI values for an SPK file. */ - - -/* Length of a calender string. */ - - -/* Local Variables */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKPDS", (ftnlen)6); - } - -/* We do not support ephemerides for the solar system barycenter */ -/* (at least not yet anyway). */ - - if (*body == 0) { - setmsg_("You've attempted to create a segment for the solar system b" - "arycenter. This is not supported by the ephemeris system.", ( - ftnlen)117); - sigerr_("SPICE(BARYCENTEREPHEM)", (ftnlen)22); - chkout_("SPKPDS", (ftnlen)6); - return 0; - } - -/* There is no point in having an ephemeris for a body relative */ -/* to itself. */ - - if (*body == *center) { - setmsg_("You've attempted to create a segment for a body relative to" - " itself. The body ID code was: #.", (ftnlen)92); - errint_("#", body, (ftnlen)1); - sigerr_("SPICE(BODYANDCENTERSAME)", (ftnlen)24); - chkout_("SPKPDS", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKPDS", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first >= *last) { - -/* We've got an error. Get the calendar string for the first */ -/* and last epochs. */ - - etcal_(first, calfst, (ftnlen)40); - etcal_(last, callst, (ftnlen)40); - setmsg_("The segment start time: # (#) is at or after the segment st" - "op time # (#).", (ftnlen)73); - errdp_("#", first, (ftnlen)1); - errch_("#", calfst, (ftnlen)1, (ftnlen)40); - errdp_("#", last, (ftnlen)1); - errch_("#", callst, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKPDS", (ftnlen)6); - return 0; - } - -/* The type must be something reasonable. The interval from */ -/* 1 to 1000 is what we are calling reasonable these days. */ - - if (*type__ <= 0 || *type__ > 1000) { - setmsg_("The type specified, #, is not supported within the SPK syst" - "em.", (ftnlen)62); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(UNKNOWNSPKTYPE)", (ftnlen)21); - chkout_("SPKPDS", (ftnlen)6); - return 0; - } - -/* Well, that's it. As far as we can determine these seem to be */ -/* reasonable values to put into a descriptor. Do it. */ - - ipart[0] = *body; - ipart[1] = *center; - ipart[2] = refcod; - ipart[3] = *type__; - ipart[4] = 0; - ipart[5] = 0; - dppart[0] = *first; - dppart[1] = *last; - dafps_(&c__2, &c__6, dppart, ipart, descr); - chkout_("SPKPDS", (ftnlen)6); - return 0; -} /* spkpds_ */ - diff --git a/ext/spice/src/cspice/spkpds_c.c b/ext/spice/src/cspice/spkpds_c.c deleted file mode 100644 index d6167a40a3..0000000000 --- a/ext/spice/src/cspice/spkpds_c.c +++ /dev/null @@ -1,201 +0,0 @@ -/* - --Procedure spkpds_c ( SPK pack descriptor ) - --Abstract - - Perform routine error checks and if all check pass, pack the - descriptor for an SPK segment - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spkpds_c ( SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceInt type, - SpiceDouble first, - SpiceDouble last, - SpiceDouble descr[5] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - body I The NAIF ID code for the body of the segment. - center I The center of motion for body. - frame I The frame for this segment. - type I The type of SPK segment to create. - first I The first epoch for which the segment is valid. - last I The last epoch for which the segment is valid. - descr O An SPK segment descriptor. - --Detailed_Input - - body is the NAIF ID code for the body of the segment. - - center is the center of motion for BODY. - - frame is a string that names the frame to which states for - the body shall be referenced. - - type is the type of SPK segment to create. - - first is the first epoch for which the segment will have - ephemeris data. - - last is the last epoch for which the segment will have - ephemeris data. - --Detailed_Output - - descr is a valid SPK segment descriptor to use - when creating a DAF segment for this body. - --Parameters - - None. - --Particulars - - This is a utility routine for validating and creating - the descriptor for an SPK segment. It is intended for - use only by routines that create SPK segments. - --Examples - - Suppose that you wish to create an SPK segment of type X - and that you are writing a routine to handle the details - of the segment creation. This routine can be used to - ensure that the descriptor needed for the segment is - properly formed and that the information in that descriptor - is reasonable. - - Having collected the needed information you can create the - descriptor and then begin a new segment as shown below. - - #include "SpiceUsr.h" - . - . - . - spkpds_c ( body, center, frame, type, first, last, descr ); - dafbna_c ( handle, descr, segid ); - --Restrictions - - None. - --Exceptions - - 1) The error SPICE(BARYCENTEREPHEM) is signaled if the - value of body is 0. - - 2) The error SPICE(BODYANDCENTERSAME) is signaled if the - values of body and center are the same. - - 3) The error SPICE(INVALIDREFFRAME) is signaled if frame - is not one of the known SPICE reference frames. - - 4) The error SPICE(BADDESCRTIMES) is signaled if first - is greater than or equal to LAST - - 5) The error SPICE(UNKNOWNSPKTYPE) is signaled if the - value of type is outside the range 1 to 1000 (inclusive). - This does not ensure that the type is a legitimate SPK - segment type, but it is a simple check that helps avoid - problems that arise from uninitialized values or improperly - ordered calling arguments. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 19-JUL-1999 (NJB) (KRG) (WLT) - --Index_Entries - - Validate and pack an SPK segment descriptor - --& -*/ - -{ /* Begin spkpds_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "spkpds_c" ); - - /* - Check the input frame string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkpds_c", frame ); - - /* - Call the f2c'd routine. - */ - spkpds_ ( ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( integer * ) &type, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( doublereal * ) descr, - ( ftnlen ) strlen(frame) ); - - - chkout_c ( "spkpds_c" ); - -} /* End spkpds_c */ diff --git a/ext/spice/src/cspice/spkpos.c b/ext/spice/src/cspice/spkpos.c deleted file mode 100644 index 64d19ff006..0000000000 --- a/ext/spice/src/cspice/spkpos.c +++ /dev/null @@ -1,958 +0,0 @@ -/* spkpos.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKPOS ( S/P Kernel, position ) */ -/* Subroutine */ int spkpos_(char *targ, doublereal *et, char *ref, char * - abcorr, char *obs, doublereal *ptarg, doublereal *lt, ftnlen targ_len, - ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzbodn2c_(char *, integer *, logical *, - ftnlen), chkin_(char *, ftnlen); - integer obsid; - extern logical beint_(char *, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - logical found; - char error[80]; - integer targid; - extern /* Subroutine */ int sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), spkezp_(integer *, doublereal *, - char *, char *, integer *, doublereal *, doublereal *, ftnlen, - ftnlen); - extern logical return_(void); - integer ptr; - -/* $ Abstract */ - -/* Return the position of a target body relative to an observing */ -/* body, optionally corrected for light time (planetary aberration) */ -/* and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body name. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output position vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body name. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector */ -/* which points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output position vector should be expressed. This */ -/* may be any frame supported by the SPICE system, */ -/* including built-in frames (documented in the Frames */ -/* Required Reading) and frames defined by a loaded */ -/* frame kernel (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. See */ -/* the description of the output position vector PTARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at */ -/* the moment it emitted photons arriving */ -/* at the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The computed target */ -/* position indicates the direction that */ -/* photons emitted from the observer's */ -/* location must be "aimed" to hit the */ -/* target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to supply to indicate the */ -/* observer is Earth. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the reference frame */ -/* specified by REF. The three components of PTARG */ -/* represent the x-, y- and z-components of the target's */ -/* position. */ - -/* PTARG points from the observer's location at ET to */ -/* the aberration-corrected location of the target. */ -/* Note that the sense of this position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of target or observer cannot be translated to its */ -/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 3) If the loaded kernels provide insufficient data to */ -/* compute the requested position vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 4) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output position PTARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute PTARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the position. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve position information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - -/* This routine is identical in function to the routine SPKEZP */ -/* except that it allows you to refer to ephemeris objects by name */ -/* (via a character string). */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations. */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* SPKPOS begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, SPKPOS computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The light time corrected position vector is */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, SPKPOS computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The light-time corrected position vector is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK, then look up a series of */ -/* geometric positions of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 positions. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* CHARACTER*(*) OBSRVR */ -/* PARAMETER ( OBSRVR = 'Earth' ) */ - -/* CHARACTER*(*) TARGET */ -/* PARAMETER ( TARGET = 'Moon' ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C position vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL SPKPOS ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . POS, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', POS(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', POS(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', POS(3) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* B.V. Semenov (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.3, 04-APR-2008 (NJB) */ - -/* Corrected minor error in description of XLT+S aberration */ -/* correction. */ - -/* - SPICELIB Version 3.0.2, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 3.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 3.0.0, 31-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* using body names get position relative to an observer */ -/* get position relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKPOS", (ftnlen)6); - } - -/* Starting from translation of target name to its code */ - - zzbodn2c_(targ, &targid, &found, targ_len); - if (! found) { - if (beint_(targ, targ_len)) { - s_copy(error, " ", (ftnlen)80, (ftnlen)1); - nparsi_(targ, &targid, error, &ptr, targ_len, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - found = FALSE_; - } else { - found = TRUE_; - } - } - } - if (! found) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE toolkit. Alternatively you may ca" - "ll SPKEZP directly if you know the SPICE id-codes for both '" - "#' and '#' ", (ftnlen)250); - errch_("#", targ, (ftnlen)1, targ_len); - errch_("#", targ, (ftnlen)1, targ_len); - errch_("#", obs, (ftnlen)1, obs_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SPKPOS", (ftnlen)6); - return 0; - } - -/* Now do the same for observer. */ - - zzbodn2c_(obs, &obsid, &found, obs_len); - if (! found) { - if (beint_(obs, obs_len)) { - s_copy(error, " ", (ftnlen)80, (ftnlen)1); - nparsi_(obs, &obsid, error, &ptr, obs_len, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - found = FALSE_; - } else { - found = TRUE_; - } - } - } - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE toolkit. Alternatively you may " - "call SPKEZP directly if you know the SPICE id-codes for both" - " '#' and '#' ", (ftnlen)252); - errch_("#", obs, (ftnlen)1, obs_len); - errch_("#", targ, (ftnlen)1, targ_len); - errch_("#", obs, (ftnlen)1, obs_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SPKPOS", (ftnlen)6); - return 0; - } - -/* After all translations are done we can call SPKEZP. */ - - spkezp_(&targid, et, ref, abcorr, &obsid, ptarg, lt, ref_len, abcorr_len); - chkout_("SPKPOS", (ftnlen)6); - return 0; -} /* spkpos_ */ - diff --git a/ext/spice/src/cspice/spkpos_c.c b/ext/spice/src/cspice/spkpos_c.c deleted file mode 100644 index 3c85be4875..0000000000 --- a/ext/spice/src/cspice/spkpos_c.c +++ /dev/null @@ -1,811 +0,0 @@ -/* - --Procedure spkpos_c ( S/P Kernel, position ) - --Abstract - - Return the position of a target body relative to an observing - body, optionally corrected for light time (planetary aberration) - and stellar aberration. - --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 - - SPK - NAIF_IDS - FRAMES - TIME - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spkpos_c ( ConstSpiceChar * targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body name. - et I Observer epoch. - ref I Reference frame of output position vector. - abcorr I Aberration correction flag. - obs I Observing body name. - ptarg O Position of target. - lt O One way light time between observer and target. - --Detailed_Input - - targ is the name of a target body. Optionally, you may - supply the integer ID code for the object as - an integer string. For example both "MOON" and - "301" are legitimate strings that indicate the - moon is the target body. - - The target and observer define a position vector - which points from the observer to the target. - - et is the ephemeris time, expressed as seconds past - J2000 TDB, at which the position of the target body - relative to the observer is to be computed. `et' - refers to time at the observer's location. - - ref is the name of the reference frame relative to which - the output position vector should be expressed. This - may be any frame supported by the SPICE system, - including built-in frames (documented in the Frames - Required Reading) and frames defined by a loaded - frame kernel (FK). - - When `ref' designates a non-inertial frame, the - orientation of the frame is evaluated at an epoch - dependent on the selected aberration correction. See - the description of the output position vector `ptarg' - for details. - - abcorr indicates the aberration corrections to be applied to - the position of the target body to account for - one-way light time and stellar aberration. See the - discussion in the Particulars section for - recommendations on how to choose aberration - corrections. - - 'abcorr' may be any of the following: - - "NONE" Apply no correction. Return the - geometric position of the target body - relative to the observer. - - The following values of 'abcorr' apply to the - "reception" case in which photons depart from the - target's location at the light-time corrected epoch - et-lt and *arrive* at the observer's location at `et': - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the position of the target at - the moment it emitted photons arriving - at the observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation (see Particulars for details). - The solution invoked by the "LT" option - uses one iteration. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - position obtained with the "LT" option - to account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - position of the target---the position - as seen by the observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges (three - iterations on all supported platforms). - - The "CN" correction typically does not - substantially improve accuracy because - the errors made by ignoring - relativistic effects may be larger than - the improvement afforded by obtaining - convergence of the light time solution. - The "CN" correction computation also - requires a significantly greater number - of CPU cycles than does the - one-iteration light time correction. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - - The following values of 'abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - target's location at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - position of the target at the moment it - receives photons emitted from the - observer's location at `et'. - - "XLT+S" "Transmission" case: correct for one-way - light time and stellar aberration using a - Newtonian formulation. This option - modifies the position obtained with the - "XLT" option to account for the observer's - velocity relative to the solar system - barycenter. The computed target position - indicates the direction that photons - emitted from the observer's location must - be "aimed" to hit the target. - - "XCN" "Transmission" case: converged - Newtonian light time correction. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - - Neither special nor general relativistic effects are - accounted for in the aberration corrections applied - by this routine. - - Case and blanks are not significant in the string - 'abcorr'. - - obs is the name of an observing body. Optionally, you may - supply the ID code of the object as an integer string. - For example, both "EARTH" and "399" are legitimate - strings to supply to indicate the observer is - Earth. - --Detailed_Output - - ptarg is a Cartesian 3-vector representing the position of - the target body relative to the specified observer. - `ptarg' is corrected for the specified aberrations, and - is expressed with respect to the reference frame - specified by `ref'. The three components of `ptarg' - represent the x-, y- and z-components of the target's - position. - - Units are always km. - - `ptarg' points from the observer's location at `et' to - the aberration-corrected location of the target. - Note that the sense of this position vector is - independent of the direction of radiation travel - implied by the aberration correction. - - Non-inertial frames are treated as follows: letting - ltcent be the one-way light time between the observer - and the central body associated with the frame, the - orientation of the frame is evaluated at et-ltcent, - et+ltcent, or `et' depending on whether the requested - aberration correction is, respectively, for received - radiation, transmitted radiation, or is omitted. ltcent - is computed using the method indicated by 'abcorr'. - - lt is the one-way light time between the observer and - target in seconds. If the target position is - corrected for aberrations, then `lt' is the one-way - light time between the observer and the light time - corrected target location. - --Parameters - - None. - --Exceptions - - 1) If name of target or observer cannot be translated to its - NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. - - 2) If the reference frame `ref' is not a recognized reference - frame the error SPICE(UNKNOWNFRAME) is signaled. - - 3) If the loaded kernels provide insufficient data to - compute the requested position vector, the deficiency will - be diagnosed by a routine in the call tree of this routine. - - 4) If an error occurs while reading an SPK or other kernel file, - the error will be diagnosed by a routine in the call tree - of this routine. - --Files - - This routine computes positions using SPK files that have been - loaded into the SPICE system, normally via the kernel loading - interface routine furnsh_c. See the routine furnsh_c and the SPK - and KERNEL Required Reading for further information on loading - (and unloading) kernels. - - If the output position `ptarg' is to be expressed relative to a - non-inertial frame, or if any of the ephemeris data used to - compute `ptarg' are expressed relative to a non-inertial frame in - the SPK files providing those data, additional kernels may be - needed to enable the reference frame transformations required to - compute the position. These additional kernels may be C-kernels, PCK - files or frame kernels. Any such kernels must already be loaded - at the time this routine is called. - --Particulars - - This routine is part of the user interface to the SPICE ephemeris - system. It allows you to retrieve position information for any - ephemeris object relative to any other in a reference frame that - is convenient for further computations. - - This routine is identical in function to the routine SPKEZP - except that it allows you to refer to ephemeris objects by name - (via a character string). - - - Aberration corrections - ====================== - - In space science or engineering applications one frequently - wishes to know where to point a remote sensing instrument, such - as an optical camera or radio antenna, in order to observe or - otherwise receive radiation from a target. This pointing problem - is complicated by the finite speed of light: one needs to point - to where the target appears to be as opposed to where it actually - is at the epoch of observation. We use the adjectives - "geometric," "uncorrected," or "true" to refer to an actual - position or state of a target at a specified epoch. When a - geometric position or state vector is modified to reflect how it - appears to an observer, we describe that vector by any of the - terms "apparent," "corrected," "aberration corrected," or "light - time and stellar aberration corrected." The SPICE Toolkit can - correct for two phenomena affecting the apparent location of an - object: one-way light time (also called "planetary aberration") and - stellar aberration. - - One-way light time - ------------------ - - Correcting for one-way light time is done by computing, given an - observer and observation epoch, where a target was when the observed - photons departed the target's location. The vector from the - observer to this computed target location is called a "light time - corrected" vector. The light time correction depends on the motion - of the target relative to the solar system barycenter, but it is - independent of the velocity of the observer relative to the solar - system barycenter. Relativistic effects such as light bending and - gravitational delay are not accounted for in the light time - correction performed by this routine. - - Stellar aberration - ------------------ - - The velocity of the observer also affects the apparent location - of a target: photons arriving at the observer are subject to a - "raindrop effect" whereby their velocity relative to the observer - is, using a Newtonian approximation, the photons' velocity - relative to the solar system barycenter minus the velocity of the - observer relative to the solar system barycenter. This effect is - called "stellar aberration." Stellar aberration is independent - of the velocity of the target. The stellar aberration formula - used by this routine does not include (the much smaller) - relativistic effects. - - Stellar aberration corrections are applied after light time - corrections: the light time corrected target position vector is - used as an input to the stellar aberration correction. - - When light time and stellar aberration corrections are both - applied to a geometric position vector, the resulting position - vector indicates where the target "appears to be" from the - observer's location. - - As opposed to computing the apparent position of a target, one - may wish to compute the pointing direction required for - transmission of photons to the target. This also requires correction - of the geometric target position for the effects of light time - and stellar aberration, but in this case the corrections are - computed for radiation traveling *from* the observer to the target. - We will refer to this situation as the "transmission" case. - - The "transmission" light time correction yields the target's - location as it will be when photons emitted from the observer's - location at `et' arrive at the target. The transmission stellar - aberration correction is the inverse of the traditional stellar - aberration correction: it indicates the direction in which - radiation should be emitted so that, using a Newtonian - approximation, the sum of the velocity of the radiation relative - to the observer and of the observer's velocity, relative to the - solar system barycenter, yields a velocity vector that points in - the direction of the light time corrected position of the target. - - One may object to using the term "observer" in the transmission - case, in which radiation is emitted from the observer's location. - The terminology was retained for consistency with earlier - documentation. - - Below, we indicate the aberration corrections to use for some - common applications: - - 1) Find the apparent direction of a target. This is - the most common case for a remote-sensing observation. - - Use "LT+S": apply both light time and stellar - aberration corrections. - - Note that using light time corrections alone ("LT") is - generally not a good way to obtain an approximation to an - apparent target vector: since light time and stellar - aberration corrections often partially cancel each other, - it may be more accurate to use no correction at all than to - use light time alone. - - - 2) Find the corrected pointing direction to radiate a signal - to a target. This computation is often applicable for - implementing communications sessions. - - Use "XLT+S": apply both light time and stellar - aberration corrections for transmission. - - - 3) Compute the apparent position of a target body relative - to a star or other distant object. - - Use "LT" or "LT+S" as needed to match the correction - applied to the position of the distant object. For - example, if a star position is obtained from a catalog, - the position vector may not be corrected for stellar - aberration. In this case, to find the angular - separation of the star and the limb of a planet, the - vector from the observer to the planet should be - corrected for light time but not stellar aberration. - - - 4) Obtain an uncorrected position vector derived directly from - data in an SPK file. - - Use "NONE". - - - 5) Use a geometric position vector as a low-accuracy estimate - of the apparent position for an application where execution - speed is critical: - - Use "NONE". - - - 6) While this routine cannot perform the relativistic - aberration corrections required to compute positions - with the highest possible accuracy, it can supply the - geometric positions required as inputs to these computations: - - Use "NONE", then apply relativistic aberration - corrections (not available in the SPICE Toolkit). - - - Below, we discuss in more detail how the aberration corrections - applied by this routine are computed. - - Geometric case - ============== - - spkpos_c begins by computing the geometric position T(et) of the - target body relative to the solar system barycenter (SSB). - Subtracting the geometric position of the observer O(et) gives - the geometric position of the target body relative to the - observer. The one-way light time, 'lt', is given by - - | T(et) - O(et) | - lt = ------------------- - c - - The geometric relationship between the observer, target, and - solar system barycenter is as shown: - - - SSB ---> O(et) - | / - | / - | / - | / T(et) - O(et) - V V - T(et) - - - The returned position is - - T(et) - O(et) - - - Reception case - ============== - - When any of the options "LT", "CN", "LT+S", "CN+S" is selected - for `abcorr', spkpos_c computes the position of the target body at - epoch et-lt, where 'lt' is the one-way light time. Let T(t) and - O(t) represent the positions of the target and observer - relative to the solar system barycenter at time t; then 'lt' is - the solution of the light-time equation - - | T(et-lt) - O(et) | - lt = ------------------------ (1) - c - - The ratio - - | T(et) - O(et) | - --------------------- (2) - c - - is used as a first approximation to 'lt'; inserting (2) into the - right hand side of the light-time equation (1) yields the - "one-iteration" estimate of the one-way light time ("LT"). - Repeating the process until the estimates of 'lt' converge yields - the "converged Newtonian" light time estimate ("CN"). - - Subtracting the geometric position of the observer O(et) gives - the position of the target body relative to the observer: - T(et-lt) - O(et). - - SSB ---> O(et) - | \ | - | \ | - | \ | T(et-lt) - O(et) - | \ | - V V V - T(et) T(et-lt) - - The light time corrected position vector is - - T(et-lt) - O(et) - - If correction for stellar aberration is requested, the target - position is rotated toward the solar system - barycenter-relative velocity vector of the observer. The - rotation is computed as follows: - - Let r be the light time corrected vector from the observer - to the object, and v be the velocity of the observer with - respect to the solar system barycenter. Let w be the angle - between them. The aberration angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - h = r X v - - Rotate r by phi radians about h to obtain the apparent - position of the object. - - - Transmission case - ================== - - When any of the options "XLT", "XCN", "XLT+S", "XCN+S" is - selected, spkpos_c computes the position of the target body T at - epoch et+lt, where 'lt' is the one-way light time. 'lt' is the - solution of the light-time equation - - | T(et+lt) - O(et) | - lt = ------------------------ (3) - c - - Subtracting the geometric position of the observer, O(et), - gives the position of the target body relative to the - observer: T(et-lt) - O(et). - - SSB --> O(et) - / | * - / | * T(et+lt) - O(et) - / |* - / *| - V V V - T(et+lt) T(et) - - The position component of the light-time corrected position - is the vector - - T(et+lt) - O(et) - - If correction for stellar aberration is requested, the target - position is rotated away from the solar system barycenter- - relative velocity vector of the observer. The rotation is - computed as in the reception case, but the sign of the - rotation angle is negated. - - Precision of light time corrections - =================================== - - Corrections using one iteration of the light time solution - ---------------------------------------------------------- - - When the requested aberration correction is "LT", "LT+S", - "XLT", or "XLT+S", only one iteration is performed in the - algorithm used to compute 'lt'. - - The relative error in this computation - - | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL - - is at most - - (V/C)**2 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**2, where V is the - velocity of the target relative to an inertial frame and C is - the speed of light. - - For nearly all objects in the solar system V is less than 60 - km/sec. The value of C is 300000 km/sec. Thus the one - iteration solution for 'lt' has a potential relative error of - not more than 4*10**-8. This is a potential light time error - of approximately 2*10**-5 seconds per astronomical unit of - distance separating the observer and target. Given the bound - on V cited above: - - As long as the observer and target are - separated by less than 50 astronomical units, - the error in the light time returned using - the one-iteration light time corrections - is less than 1 millisecond. - - - Converged corrections - --------------------- - - When the requested aberration correction is "CN", "CN+S", - "XCN", or "XCN+S", three iterations are performed in the - computation of 'lt'. The relative error present in this - solution is at most - - (V/C)**4 - ---------- - 1 - (V/C) - - which is well approximated by (V/C)**4. Mathematically the - precision of this computation is better than a nanosecond for - any pair of objects in the solar system. - - However, to model the actual light time between target and - observer one must take into account effects due to general - relativity. These may be as high as a few hundredths of a - millisecond for some objects. - - When one considers the extra time required to compute the - converged Newtonian light time (the state of the target relative - to the solar system barycenter is looked up three times instead - of once) together with the real gain in accuracy, it seems - unlikely that you will want to request either the "CN" or "CN+S" - light time corrections. However, these corrections can be useful - for testing situations where high precision (as opposed to - accuracy) is required. - - - Relativistic Corrections - ========================= - - This routine does not attempt to perform either general or - special relativistic corrections in computing the various - aberration corrections. For many applications relativistic - corrections are not worth the expense of added computation - cycles. If however, your application requires these additional - corrections we suggest you consult the astronomical almanac (page - B36) for a discussion of how to carry out these corrections. - - --Examples - - 1) Load a planetary ephemeris SPK, then look up a series of - geometric positions of the moon relative to the earth, - referenced to the J2000 frame. - - #include - #include "SpiceUsr.h" - - void main() - { - - #define ABCORR "NONE" - #define FRAME "J2000" - - /. - The name of the SPK file shown here is fictitious; - you must supply the name of an SPK file available - on your own computer system. - ./ - #define SPK "planetary_spk.bsp" - - /. - ET0 represents the date 2000 Jan 1 12:00:00 TDB. - ./ - #define ET0 0.0 - - /. - Use a time step of 1 hour; look up 100 states. - ./ - #define STEP 3600.0 - #define MAXITR 100 - - #define OBSERVER "earth" - #define TARGET "moon" - - - /. - Local variables - ./ - SpiceInt i; - - SpiceDouble et; - SpiceDouble lt; - SpiceDouble pos [3]; - - - /. - Load the spk file. - ./ - furnsh_c ( SPK ); - - /. - Step through a series of epochs, looking up a position vector - at each one. - ./ - for ( i = 0; i < MAXITR; i++ ) - { - et = ET0 + i*STEP; - - spkpos_c ( TARGET, et, FRAME, ABCORR, - OBSERVER, pos, < ); - - printf( "\net = %20.10f\n\n", et ); - printf( "J2000 x-position (km): %20.10f\n", pos[0] ); - printf( "J2000 y-position (km): %20.10f\n", pos[1] ); - printf( "J2000 z-position (km): %20.10f\n", pos[2] ); - } - } - - --Restrictions - - None. - --Literature_References - - SPK Required Reading. - --Author_and_Institution - - C.H. Acton (JPL) - B.V. Semenov (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 2.0.4, 04-APR-2008 (NJB) - - Corrected minor error in description of XLT+S aberration - correction. - - -CSPICE Version 2.0.3, 17-APR-2005 (NJB) - - Error was corrected in example program: variable name `state' - was changed to `pos' in printf calls. - - -CSPICE Version 2.0.2, 13-OCT-2003 (EDW) - - Various minor header changes were made to improve clarity. - Added mention that 'lt' returns a value in seconds. - - -CSPICE Version 2.0.1, 27-JUL-2003 (NJB) (CHA) - - Various header corrections were made. - - -CSPICE Version 2.0.0, 31-DEC-2001 (NJB) - - Updated to handle aberration corrections for transmission - of radiation. Formerly, only the reception case was - supported. The header was revised and expanded to explain - the functionality of this routine in more detail. - - -CSPICE Version 1.0.0, 29-MAY-1999 (NJB) (WLT) - --Index_Entries - - using names get target position relative to an observer - position relative to observer corrected for aberrations - read ephemeris data - read trajectory data - --& -*/ - -{ /* Begin spkpos_c */ - - /* - Participate in error tracing. - */ - - chkin_c ( "spkpos_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkpos_c", targ ); - CHKFSTR ( CHK_STANDARD, "spkpos_c", ref ); - CHKFSTR ( CHK_STANDARD, "spkpos_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "spkpos_c", obs ); - - - /* - Call the f2c'd Fortran routine. Use explicit type casts for every - type defined by f2c. - */ - spkpos_ ( ( char * ) targ, - ( doublereal * ) &et, - ( char * ) ref, - ( char * ) abcorr, - ( char * ) obs, - ( doublereal * ) ptarg, - ( doublereal * ) lt, - ( ftnlen ) strlen(targ), - ( ftnlen ) strlen(ref), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obs) ); - - - chkout_c ( "spkpos_c" ); - -} /* End spkpos_c */ diff --git a/ext/spice/src/cspice/spkpv.c b/ext/spice/src/cspice/spkpv.c deleted file mode 100644 index a4a289ef48..0000000000 --- a/ext/spice/src/cspice/spkpv.c +++ /dev/null @@ -1,288 +0,0 @@ -/* spkpv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKPV ( S/P Kernel, position and velocity ) */ -/* Subroutine */ int spkpv_(integer *handle, doublereal *descr, doublereal * - et, char *ref, doublereal *state, integer *center, ftnlen ref_len) -{ - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *), chkin_(char *, ftnlen), dafus_( - doublereal *, integer *, integer *, doublereal *, integer *), - errch_(char *, char *, ftnlen, ftnlen); - doublereal xform[36] /* was [6][6] */, dc[2]; - integer ic[6]; - extern /* Subroutine */ int frmchg_(integer *, integer *, doublereal *, - doublereal *), namfrm_(char *, integer *, ftnlen); - integer irfreq; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal tstate[6]; - extern logical return_(void); - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *); - integer irf; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to some center of motion in a specified frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* STATE O Position, velocity. */ -/* CENTER O Center of state. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle assigned to a SPK file, and the */ -/* descriptor for a segment within the file. Together */ -/* they determine the ephemeris data from which the */ -/* state of the body is to be computed. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine FRMCHG. */ - -/* $ Detailed_Output */ - -/* STATE contains the position and velocity, at epoch ET, */ -/* for whatever body is covered by the specified segment. */ -/* STATE has six elements: the first three contain the */ -/* body's position; the last three contain the body's */ -/* velocity. These vectors are rotated into the */ -/* specified reference frame, the origin of */ -/* which is located at the center of motion for the */ -/* body (see CENTER, below). Units are always km and */ -/* km/sec. */ - -/* CENTER is the integer ID code of the center of motion for */ -/* the state. */ - -/* $ Parameters */ - -/* NONE. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the requested reference frame is not supported by the */ -/* current version of CHGIRF, the error 'SPICE(SPKREFNOTSUPP)' */ -/* is signalled. */ - -/* $ Particulars */ - -/* Once SPKPV was the most basic of the SPK readers, the reader upon */ -/* which SPKSSB, SPKAPP, and SPKEZ were built. However, its function */ -/* has now largely been replaced by SPKPVN. SPKPV should not normally */ -/* be called except by old software written before the release of */ -/* SPKPVN. This routine should be considered obsolete. */ - - -/* $ Examples */ - -/* In the following code fragment, an entire SPK file is searched */ -/* for segments containing a particular epoch. For each one found, */ -/* the body, center, segment identifier, and range at the epoch */ -/* are printed out. */ - -/* CALL DAFOPR ( 'TEST.SPK', HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ - -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DC, IC ) */ - -/* IF ( DC(1) .LE. ET .AND. ET .LE. DC(2) ) THEN */ -/* CALL SPKPV ( HANDLE, DESCR, ET, 'J2000', STATE, CENTER ) */ -/* CALL DAFGN ( IDENT ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Body = ', IC(1) */ -/* WRITE (*,*) 'Center = ', CENTER, */ -/* WRITE (*,*) 'ID = ', IDENT */ -/* WRITE (*,*) 'Range = ', VNORM ( STATE ) */ -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 6.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was updated to handle non-inertial frames. */ - -/* - SPICELIB Version 5.0.0, 13-MAR-1995 (KRG) */ - -/* The routine was updated to handle type 14. */ - -/* A new exception, 3, was also added. */ - -/* - SPICELIB Version 4.0.0, 04-NOV-1994 (WLT) */ - -/* The routine was updated to handle type 15. */ - -/* - SPICELIB Version 3.0.0, 04-AUG-1993 (NJB) */ - -/* The routine was updated to handle types 08 and 09. */ - -/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */ - -/* The routine was updated to handle type 05. */ - -/* - SPICELIB Version 1.0.2, 18-JUL-1991 (NJB) */ - -/* The description of the output STATE was expanded slightly. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* position and velocity from ephemeris */ -/* spk file position and velocity */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 6.0.0, 6-OCT-1994 (WLT) */ - -/* The routine was updated to handle non-inertial frames. */ - -/* - SPICELIB Version 5.0.0, 13-MAR-1995 (KRG) */ - -/* The routine was updated to handle type 14. */ - -/* A new exception, 3, was also added. */ - -/* - SPICELIB Version 4.0.0, 04-NOV-1994 (WLT) */ - -/* The routine was updated to handle type 15. */ - -/* - SPICELIB Version 3.0.0, 04-AUG-1993 (NJB) */ - -/* The routine was updated to handle types 08 and 09. */ - -/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */ - -/* The routine was updated to handle type 05. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Some local space is needed in which to return records, and */ -/* into which to unpack the segment descriptor. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKPV", (ftnlen)5); - } - dafus_(descr, &c__2, &c__6, dc, ic); - *center = ic[1]; - irf = ic[2]; - -/* Rotate the raw state from its native frame to the only if the */ -/* native frame differs from the one requested by the user. */ - - namfrm_(ref, &irfreq, ref_len); - if (irfreq == 0) { - setmsg_("No support for frame #.", (ftnlen)23); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(SPKREFNOTSUPP)", (ftnlen)20); - } else if (irfreq != irf) { - spkpvn_(handle, descr, et, &irf, tstate, center); - frmchg_(&irf, &irfreq, et, xform); - mxvg_(xform, tstate, &c__6, &c__6, state); - } else { - spkpvn_(handle, descr, et, &irf, state, center); - } - chkout_("SPKPV", (ftnlen)5); - return 0; -} /* spkpv_ */ - diff --git a/ext/spice/src/cspice/spkpvn.c b/ext/spice/src/cspice/spkpvn.c deleted file mode 100644 index 2a207a9ba1..0000000000 --- a/ext/spice/src/cspice/spkpvn.c +++ /dev/null @@ -1,473 +0,0 @@ -/* spkpvn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; -static integer c__129 = 129; - -/* $Procedure SPKPVN ( S/P Kernel, position and velocity in native frame ) */ -/* Subroutine */ int spkpvn_(integer *handle, doublereal *descr, doublereal * - et, integer *ref, doublereal *state, integer *center) -{ - integer type__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), spke01_( - doublereal *, doublereal *, doublereal *), spke02_(doublereal *, - doublereal *, doublereal *), spke03_(doublereal *, doublereal *, - doublereal *), spke10_(doublereal *, doublereal *, doublereal *), - spke05_(doublereal *, doublereal *, doublereal *), spke12_( - doublereal *, doublereal *, doublereal *), spke13_(doublereal *, - doublereal *, doublereal *), spke08_(doublereal *, doublereal *, - doublereal *), spke09_(doublereal *, doublereal *, doublereal *), - spke14_(doublereal *, doublereal *, doublereal *), spke15_( - doublereal *, doublereal *, doublereal *), spke17_(doublereal *, - doublereal *, doublereal *), spke18_(doublereal *, doublereal *, - doublereal *), spkr01_(integer *, doublereal *, doublereal *, - doublereal *), spkr02_(integer *, doublereal *, doublereal *, - doublereal *), spkr03_(integer *, doublereal *, doublereal *, - doublereal *), spkr05_(integer *, doublereal *, doublereal *, - doublereal *), spkr10_(integer *, doublereal *, doublereal *, - doublereal *), spkr12_(integer *, doublereal *, doublereal *, - doublereal *), spkr08_(integer *, doublereal *, doublereal *, - doublereal *), spkr09_(integer *, doublereal *, doublereal *, - doublereal *), spkr13_(integer *, doublereal *, doublereal *, - doublereal *), spkr14_(integer *, doublereal *, doublereal *, - doublereal *), spkr15_(integer *, doublereal *, doublereal *, - doublereal *), spkr17_(integer *, doublereal *, doublereal *, - doublereal *), spkr18_(integer *, doublereal *, doublereal *, - doublereal *); - doublereal dc[2]; - integer ic[6]; - extern logical failed_(void); - doublereal record[129]; - extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, - integer *, doublereal *), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer recsiz; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to some center of motion. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare SPK data record size. This record is declared in */ -/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */ -/* (SPKExx) routines. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* 1) If new SPK types are added, it may be necessary to */ -/* increase the size of this record. The header of SPKPVN */ -/* should be updated as well to show the record size */ -/* requirement for each data type. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */ - -/* -& */ - -/* End include file spkrec.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* REF O Target reference frame. */ -/* STATE O Position, velocity. */ -/* CENTER O Center of state. */ -/* MAXREC P Maximum length of records returned by SPKRnn. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle assigned to a SPK file, and the */ -/* descriptor for a segment within the file. Together */ -/* they determine the ephemeris data from which the */ -/* state of the body is to be computed. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* is to be computed. */ - -/* $ Detailed_Output */ - -/* REF is the id-code of the reference frame to */ -/* which the vectors returned by the routine belong. */ - -/* STATE contains the position and velocity, at epoch ET, */ -/* for whatever body is covered by the specified segment. */ -/* STATE has six elements: the first three contain the */ -/* body's position; the last three contain the body's */ -/* velocity. These vectors are rotated into the */ -/* specified reference frame, the origin of */ -/* which is located at the center of motion for the */ -/* body (see CENTER, below). Units are always km and */ -/* km/sec. */ - -/* CENTER is the integer ID code of the center of motion for */ -/* the state. */ - -/* $ Parameters */ - -/* MAXREC is the maximum length of a record returned by any of */ -/* data type-specific routines SPKRnn, which are called */ -/* by SPKPVN (see Particulars). */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the segment type is not supported by the current */ -/* version of SPKPVN, the error 'SPICE(SPKTYPENOTSUPP)' */ -/* is signalled. */ - - -/* $ Particulars */ - -/* SPKPVN is the most basic of the SPK readers, the reader upon */ -/* which SPKPV and SPKGEO, etc. are built. It should not normally */ -/* be called directly except in cases where some optimization is */ -/* required. (That is, where the calling program has prior knowledge */ -/* of the center-barycenter shifts to be performed, or a non-standard */ -/* method of determining the files and segments to be used when */ -/* computing states.) */ - -/* This is the only reader which makes distinctions between the */ -/* various segment types in the SPK format. The complete list */ -/* of types currently supported is shown below. */ - -/* Type Description */ -/* ---- ----------------------- */ -/* 1 Difference Lines */ -/* 2 Chebyshev (P) */ -/* 3 Chebyshev (P,V) */ -/* 4 Weighted elements ( not yet implemented ) */ -/* 5 Two body propagation between discrete states */ -/* 8 Lagrange interpolation, equally spaced discrete states */ -/* 9 Lagrange interpolation, unequally spaced discrete states */ -/* 12 Hermite interpolation, equally spaced discrete states */ -/* 13 Hermite interpolation, unequally spaced discrete states */ -/* 14 Chebyshev Unequally spaced */ -/* 15 Precessing Ellipse */ -/* 17 Equinoctial Elements */ - -/* SPKPVN is the only reader that needs to be changed in order to */ -/* add a new segment type to the SPK format. If a new data type is */ -/* added, the following steps should be taken: */ - -/* 1) Write two new routines, SPKRnn and SPKEnn, to read and */ -/* evaluate, respectively, a record from a data type nn segment. */ - -/* 2) Insert a new case into the body of SPKPVN to accommodate the */ -/* new type. */ - -/* 3) If necessary, adjust the parameter MAXREC, above, so that it */ -/* is large enough to encompass the maximum size of a record */ -/* returned by SPKRnn and passed to SPKEnn. */ - -/* The maximum record lengths for each data type currently */ -/* supported are as follows: */ - -/* Data type Maximum record length */ -/* --------- --------------------- */ -/* 1 71 */ -/* 2 66 */ -/* 3 129 */ -/* 5 15 */ -/* 8 99 */ -/* 9 113 */ -/* 12 51 */ -/* 13 57 */ -/* 14 Variable */ -/* 15 16 */ -/* 17 12 */ -/* 18 114 */ - -/* $ Examples */ - -/* In the following code fragment, an entire SPK file is searched */ -/* for segments containing a particular epoch. For each one found, */ -/* the body, center, segment identifier, and range at the epoch */ -/* are printed out. */ - -/* CALL DAFOPR ( 'TEST.SPK', HANDLE ) */ -/* CALL DAFBFS ( HANDLE ) */ - -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DC, IC ) */ - -/* IF ( DC(1) .LE. ET .AND. ET .LE. DC(2) ) THEN */ -/* CALL SPKPVN ( HANDLE, DESCR, ET, REF, STATE, CENTER ) */ -/* CALL DAFGN ( IDENT ) */ -/* CALL FRMNAM ( REF, FRAME ) */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Body = ', IC(1) */ -/* WRITE (*,*) 'Center = ', CENTER, */ -/* WRITE (*,*) 'ID = ', IDENT */ -/* WRITE (*,*) 'Frame = ', FRAME */ -/* WRITE (*,*) 'Range = ', VNORM ( STATE ) */ -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-AUG-2002 (NJB) */ - -/* Added support for type 18. This routine now uses the */ -/* include file spkrec.inc to declare the record size. */ - -/* Corrected header comments giving record sizes for types */ -/* 8, 9, 12, 13. */ - -/* - SPICELIB Version 2.0.0, 06-NOV-1999 (NJB) */ - -/* Added support for types 12 and 13. */ - -/* - SPICELIB Version 1.1.0, 7-JAN-1997 (WLT) */ - -/* Added support for type 17. */ - -/* - SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* position and velocity from ephemeris */ -/* spk file position and velocity */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 7-JAN-1997 (WLT) */ - -/* Added support for type 17. */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Some local space is needed in which to return records, and */ -/* into which to unpack the segment descriptor. */ - - -/* Local Parameters */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKPVN", (ftnlen)6); - } - -/* Unpacking the segment descriptor will tell us the center, */ -/* reference frame, and data type for this segment. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - *center = ic[1]; - *ref = ic[2]; - type__ = ic[3]; - -/* Each data type has a pair of routines to read and evaluate */ -/* records for that data type. These routines are the only ones */ -/* that actually look inside the segments. */ - -/* By the time we have more than 100 data types, we should be */ -/* allowed to use longer variable names. */ - - if (type__ == 1) { - spkr01_(handle, descr, et, record); - spke01_(et, record, state); - } else if (type__ == 2) { - spkr02_(handle, descr, et, record); - spke02_(et, record, state); - } else if (type__ == 3) { - spkr03_(handle, descr, et, record); - spke03_(et, record, state); - -/* Type 04 is not officially part of the library. */ - -/* ELSE IF ( TYPE .EQ. 04 ) THEN */ -/* CALL SPKR04 ( HANDLE, DESCR, ET, RECORD ) */ -/* CALL SPKE04 ( ET, RECORD, STATE ) */ - } else if (type__ == 5) { - spkr05_(handle, descr, et, record); - spke05_(et, record, state); - } else if (type__ == 8) { - spkr08_(handle, descr, et, record); - spke08_(et, record, state); - } else if (type__ == 9) { - spkr09_(handle, descr, et, record); - spke09_(et, record, state); - } else if (type__ == 10) { - spkr10_(handle, descr, et, record); - spke10_(et, record, state); - } else if (type__ == 12) { - spkr12_(handle, descr, et, record); - spke12_(et, record, state); - } else if (type__ == 13) { - spkr13_(handle, descr, et, record); - spke13_(et, record, state); - } else if (type__ == 14) { - -/* Fetch the number of Chebyshev coefficients, compute the record */ -/* size needed, and signal an error if there is not enough storage */ -/* in RECORD. The number of coefficients is the first constant */ -/* value in the generic segment. */ - - sgfcon_(handle, descr, &c__1, &c__1, record); - if (failed_()) { - chkout_("SPKPVN", (ftnlen)6); - return 0; - } - recsiz = (integer) record[0] * 6 + 3; - if (recsiz > 129) { - setmsg_("Storage for # double precision numbers is needed for an" - " SPK data record and only # locations were available. Up" - "date the parameter MAXREC in the subroutine SPKPVN and n" - "otify the NAIF group of this problem.", (ftnlen)204); - errint_("#", &recsiz, (ftnlen)1); - errint_("#", &c__129, (ftnlen)1); - sigerr_("SPICE(SPKRECTOOLARGE)", (ftnlen)21); - chkout_("SPKPVN", (ftnlen)6); - return 0; - } - spkr14_(handle, descr, et, record); - spke14_(et, record, state); - } else if (type__ == 15) { - spkr15_(handle, descr, et, record); - spke15_(et, record, state); - } else if (type__ == 17) { - spkr17_(handle, descr, et, record); - spke17_(et, record, state); - } else if (type__ == 18) { - spkr18_(handle, descr, et, record); - spke18_(et, record, state); - } else { - setmsg_("SPK type # is not supported in your version of the SPICE li" - "brary. You will need to upgrade your version of the library" - " to make use of ephemerides that contain this SPK data type. " - , (ftnlen)180); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(SPKTYPENOTSUPP)", (ftnlen)21); - chkout_("SPKPVN", (ftnlen)6); - return 0; - } - chkout_("SPKPVN", (ftnlen)6); - return 0; -} /* spkpvn_ */ - diff --git a/ext/spice/src/cspice/spkr01.c b/ext/spice/src/cspice/spkr01.c deleted file mode 100644 index dc4cab2c72..0000000000 --- a/ext/spice/src/cspice/spkr01.c +++ /dev/null @@ -1,291 +0,0 @@ -/* spkr01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__100 = 100; - -/* $Procedure SPKR01 ( Read SPK record from segment, type 1 ) */ -/* Subroutine */ int spkr01_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Local variables */ - doublereal data[100]; - integer offd, offe, nrec, ndir, offr, i__, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer recno; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - extern logical return_(void); - integer end, off; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 1 */ -/* (Difference Lines). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 1. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 1 segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 1 ) THEN */ -/* CALL SPKR01 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK01 was removed from the Required_Reading section of the */ -/* header. The information in the SPK01 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_1 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKR01", (ftnlen)6); - } - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - begin = ic[4]; - end = ic[5]; - -/* Get the number of records in the segment. From that, we can */ -/* compute */ - -/* NDIR The number of directory epochs. */ - -/* OFFD The offset of the first directory epoch. */ - -/* OFFE The offset of the first epoch. */ - - -/* the number of directory epochs. */ - - dafgda_(handle, &end, &end, data); - nrec = (integer) data[0]; - ndir = nrec / 100; - offd = end - ndir - 1; - offe = end - ndir - nrec - 1; - -/* What we want is the record number: once we have that, we can */ -/* compute the offset of the record from the beginning of the */ -/* segment, grab it, and go. But how to find it? */ - -/* Ultimately, we want the first record whose epoch is greater */ -/* than or equal to ET. If there are 100 or fewer records, all */ -/* the record epochs can be examined in a single group. */ - - if (nrec <= 100) { - i__1 = offe + 1; - i__2 = offe + nrec; - dafgda_(handle, &i__1, &i__2, data); - recno = lstltd_(et, &nrec, data) + 1; - offr = begin - 1 + (recno - 1) * 71; - i__1 = offr + 1; - i__2 = offr + 71; - dafgda_(handle, &i__1, &i__2, record); - chkout_("SPKR01", (ftnlen)6); - return 0; - } - -/* Searching directories is a little more difficult. */ - -/* The directory contains epochs 100, 200, and so on. Once we */ -/* find the first directory epoch greater than or equal to ET, */ -/* we can grab the corresponding set of 100 record epochs, and */ -/* search them. */ - - i__1 = ndir; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = offd + i__; - i__3 = offd + i__; - dafgda_(handle, &i__2, &i__3, data); - if (data[0] >= *et) { - off = offe + (i__ - 1) * 100; - i__2 = off + 1; - i__3 = off + 100; - dafgda_(handle, &i__2, &i__3, data); - recno = (i__ - 1) * 100 + lstltd_(et, &c__100, data) + 1; - offr = begin - 1 + (recno - 1) * 71; - i__2 = offr + 1; - i__3 = offr + 71; - dafgda_(handle, &i__2, &i__3, record); - chkout_("SPKR01", (ftnlen)6); - return 0; - } - } - -/* If ET is greater than the final directory epoch, we want one */ -/* of the final records. */ - - i__ = nrec % 100; - i__1 = end - ndir - i__; - i__2 = end - ndir - 1; - dafgda_(handle, &i__1, &i__2, data); - recno = ndir * 100 + lstltd_(et, &i__, data) + 1; - offr = begin - 1 + (recno - 1) * 71; - i__1 = offr + 1; - i__2 = offr + 71; - dafgda_(handle, &i__1, &i__2, record); - chkout_("SPKR01", (ftnlen)6); - return 0; -} /* spkr01_ */ - diff --git a/ext/spice/src/cspice/spkr02.c b/ext/spice/src/cspice/spkr02.c deleted file mode 100644 index abd4b1ec5c..0000000000 --- a/ext/spice/src/cspice/spkr02.c +++ /dev/null @@ -1,243 +0,0 @@ -/* spkr02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKR02 ( Read SPK record from segment, type 2 ) */ -/* Subroutine */ int spkr02_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nrec; - doublereal init; - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer recno; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6], recadr; - doublereal intlen; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer recsiz; - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 2 */ -/* (Chebyshev, position only). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 2. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 2 (Chebyshev polynomials, position */ -/* only) segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 2 ) THEN */ -/* CALL SPKR02 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK02 was removed from the Required_Reading section of the */ -/* header. The information in the SPK02 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_2 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKR02", (ftnlen)6); - } - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - begin = ic[4]; - end = ic[5]; - -/* The segment is made up of a number of logical records, each */ -/* having the same size, and covering the same length of time. */ - -/* We can determine which record to return by comparing the input */ -/* epoch with the initial time of the segment and the length of the */ -/* interval covered by each record. These final two constants are */ -/* located at the end of the segment, along with the size of each */ -/* logical record and the total number of records. */ - - i__1 = end - 3; - dafgda_(handle, &i__1, &end, record); - init = record[0]; - intlen = record[1]; - recsiz = (integer) record[2]; - nrec = (integer) record[3]; - recno = (integer) ((*et - init) / intlen) + 1; - recno = min(recno,nrec); - -/* Compute the address of the desired record. */ - - recadr = (recno - 1) * recsiz + begin; - -/* Along with the record, return the size of the record. */ - - record[0] = record[2]; - i__1 = recadr + recsiz - 1; - dafgda_(handle, &recadr, &i__1, &record[1]); - chkout_("SPKR02", (ftnlen)6); - return 0; -} /* spkr02_ */ - diff --git a/ext/spice/src/cspice/spkr03.c b/ext/spice/src/cspice/spkr03.c deleted file mode 100644 index 9baf41d137..0000000000 --- a/ext/spice/src/cspice/spkr03.c +++ /dev/null @@ -1,247 +0,0 @@ -/* spkr03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKR03 ( Read SPK record from segment, type 3 ) */ -/* Subroutine */ int spkr03_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nrec; - doublereal init; - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer recno; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6], recadr; - doublereal intlen; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer recsiz; - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 3 */ -/* (Chebyshev coefficients, position and velocity). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 3. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 3 (Chebyshev polynomials, position */ -/* and velocity) segment. */ - -/* On not so close inspection, you will see that this routine is */ -/* identical to SPKR02, which reads a type 2 (Chebyshev polynomials, */ -/* position only) segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 3 ) THEN */ -/* CALL SPKR03 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK03 was removed from the Required_Reading section of the */ -/* header. The information in the SPK03 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_3 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKR03", (ftnlen)6); - } - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - begin = ic[4]; - end = ic[5]; - -/* The segment is made up of a number of logical records, each */ -/* having the same size, and covering the same length of time. */ - -/* We can determine which record to return by comparing the input */ -/* epoch with the initial time of the segment and the length of the */ -/* interval covered by each record. These final two constants are */ -/* located at the end of the segment, along with the size of each */ -/* logical record and the total number of records. */ - - i__1 = end - 3; - dafgda_(handle, &i__1, &end, record); - init = record[0]; - intlen = record[1]; - recsiz = (integer) record[2]; - nrec = (integer) record[3]; - recno = (integer) ((*et - init) / intlen) + 1; - recno = min(recno,nrec); - -/* Compute the address of the desired record. */ - - recadr = (recno - 1) * recsiz + begin; - -/* Along with the record, return the size of the record. */ - - record[0] = record[2]; - i__1 = recadr + recsiz - 1; - dafgda_(handle, &recadr, &i__1, &record[1]); - chkout_("SPKR03", (ftnlen)6); - return 0; -} /* spkr03_ */ - diff --git a/ext/spice/src/cspice/spkr05.c b/ext/spice/src/cspice/spkr05.c deleted file mode 100644 index 51d005ead5..0000000000 --- a/ext/spice/src/cspice/spkr05.c +++ /dev/null @@ -1,476 +0,0 @@ -/* spkr05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__12 = 12; - -/* $Procedure SPKR05 ( Read SPK record from segment, type 5 ) */ -/* Subroutine */ int spkr05_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal data[100]; - integer nrec, ndir, skip, type__, i__, n, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), moved_(doublereal - *, integer *, doublereal *); - integer group; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6], grpadd, remain, dirloc, addrss; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - extern logical return_(void); - integer end; - logical fnd; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 5 */ -/* ( two body propagation between discrete state vectors ). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* the type 05 SPK segment to be read. */ - -/* ET is a target epoch, specified as ephemeris seconds past */ -/* J2000, for which a data record from the segment is */ -/* required. */ - -/* $ Detailed_Output */ - -/* RECORD is a logical record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* The structure of RECORD is: */ - -/* RECORD(1) */ -/* . state of the body at epoch 1. */ -/* . */ -/* . */ -/* RECORD(6) */ - -/* RECORD(7) */ -/* . */ -/* . state of the body at epoch 2. */ -/* . */ -/* RECORD(12) */ -/* RECORD(13) epoch 1 in seconds past 2000. */ -/* RECORD(14) epoch 2 in seconds past 2000. */ -/* RECORD(15) GM for the center of motion. */ - - -/* Epoch 1 and epoch 2 are the times in the segment that */ -/* bracket ET. If ET is less than the first time in the */ -/* segment then both epochs 1 and 2 are equal to the */ -/* first time. And if ET is greater than the last time */ -/* then, epochs 1 and 2 are set equal to this last time. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the segment specified by DESCR is not of data type 05, */ -/* the error 'SPICE(WRONGSPKTYPE)' is signalled. */ - -/* 2) No error is signalled if ET is outside the time bounds of */ -/* the segment. The output RECORD will contain epochs and the */ -/* associated states which satisfy the rules stated above. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* This routine reads the segment specified by DESCR from the SPK */ -/* file attached to HANDLE to locate the two epochs in the segment */ -/* that bracket the input ET. It then returns a logical record which */ -/* contains these times and their associated states, and also the */ -/* mass of the center of motion. The routine makes explicit use of */ -/* the structure of the type 05 data segment to locate this data. */ - -/* See the section of the SPK Required Reading on data type 05 for */ -/* a description of the structure of a type 05 segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 05 ) THEN */ - -/* CALL SPKR05 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_5 spk segment */ - -/* -& */ - -/* Local parameters */ - - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKR05", (ftnlen)6); - } - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[3]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 5 data segment. */ - - if (type__ != 5) { - setmsg_("You are attempting to locate type 5 data in a type # data s" - "egment.", (ftnlen)66); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19); - chkout_("SPKR05", (ftnlen)6); - return 0; - } - -/* Get the number of records in the segment. While we're at it, */ -/* get the GM of the central body (it's adjacent to NREC) */ -/* since we'll need it anyway. Put it where it belongs, at the */ -/* end of the output record. */ - - i__1 = end - 1; - dafgda_(handle, &i__1, &end, data); - nrec = i_dnnt(&data[1]); - record[14] = data[0]; - -/* From the number of records, we can compute the number of */ -/* directory epochs. */ - - ndir = nrec / 100; - -/* The directory epochs narrow down the search to a group of DIRSIZ */ -/* or fewer records. Because the Ith directory epoch is the I*100th */ -/* epoch, the Ith group will contain epochs ((I-1)*100 + 1) through */ -/* (I*100). For example: */ -/* group first epoch # last epoch # */ -/* ----- ------------- ------------ */ -/* 1 1 100 */ -/* 2 101 200 */ -/* . . . */ -/* . . . */ -/* 10 901 1000 */ -/* . . . */ -/* . . . */ -/* N (N-1)*100+1 N*100 */ - if (ndir == 0) { - -/* There is only one group if there are no directory epochs. */ - - group = 1; - } else { - -/* Compute the location of the first directory epoch. From the */ -/* beginning of the segment, we need to go through all of the */ -/* NREC states and epochs. */ - - dirloc = begin + nrec * 7; - -/* Determine which group of DIRSIZ times to search, by finding */ -/* the last directory epoch that is less than ET. */ - - fnd = FALSE_; - remain = ndir; - group = 0; - while(! fnd) { - -/* Read in as many as BUFSIZ directory epochs at a time */ -/* for comparison. */ - - n = min(remain,100); - i__1 = dirloc + n - 1; - dafgda_(handle, &dirloc, &i__1, data); - remain -= n; - -/* Determine the last directory element in DATA that's less */ -/* than ET. */ - -/* If we reach the end of the directories, and still haven't */ -/* found one bigger than the epoch, the group is the last group */ -/* in the segment. */ - -/* Otherwise keep looking. */ - - - i__ = lstltd_(et, &n, data); - if (i__ < n) { - group = group + i__ + 1; - fnd = TRUE_; - } else if (remain == 0) { - group = ndir + 1; - fnd = TRUE_; - } else { - dirloc += n; - group += n; - } - } - } - -/* Now we know which group of DIRSIZ (or less) epochs to look at. */ -/* Out of the NREC epochs, the number that we should skip over */ -/* to get to the proper group is DIRSIZ * ( GROUP - 1 ). */ - - skip = (group - 1) * 100; - -/* From this we can compute the index into the segment of the group */ -/* of times we want. From the beginning, we need to pass through */ -/* STASIZ * NREC state numbers to get to the first epoch. Then we */ -/* skip over the number just computed above. */ - - grpadd = begin + nrec * 6 + skip; - -/* The number of epochs that we have to look at may be less than */ -/* DIRSIZ. However many there are, go ahead and read them into the */ -/* buffer. */ - -/* If there are no times in the last group then the time that we */ -/* are looking for is the same as the last directory epoch. */ -/* We should not try to read in this instance. */ - -/* Computing MIN */ - i__1 = 100, i__2 = nrec - skip; - n = min(i__1,i__2); - if (n != 0) { - i__1 = grpadd + n - 1; - dafgda_(handle, &grpadd, &i__1, data); - -/* Find the index of the largest time in the group that is less */ -/* than the input time. */ - - i__ = lstltd_(et, &n, data); - } else { - -/* If we are here it means that ET is greater then the last */ -/* time in the segment and there are no elements in the last */ -/* group. This can occur when the number of epochs is a multiple */ -/* DIRSIZ. */ - -/* By setting N equal to I we can handle this case in the */ -/* same branch as when there are elements in the last group. */ -/* This is because the DATA array still contains the directory */ -/* epochs and I is pointing at the last element which is also the */ -/* last time in the segment. */ - - n = i__; - } - -/* At this point N is the number of epochs in this GROUP which is */ -/* also the size of the array DATA which contains the epochs. I is */ -/* the index of the largest time in DATA which is less than ET. */ - -/* We need to take different actions depending on whether ET is less */ -/* than the first time or greater than the last one in the GROUP. */ - - if (i__ == 0) { - if (group == 1) { - -/* ET is less than or equal to the first time in the segment. */ -/* Return the state at the first time twice. */ - - record[12] = data[0]; - record[13] = data[0]; - i__1 = begin + 5; - dafgda_(handle, &begin, &i__1, data); - moved_(data, &c__6, record); - moved_(data, &c__6, &record[6]); - chkout_("SPKR05", (ftnlen)6); - return 0; - } else { - -/* ET is less than or equal to the first time in this group */ -/* but not the first time in the segment. Get the last time */ -/* from the preceding group. The states for this case will */ -/* be read outside of the IF block. */ - - i__1 = grpadd - 1; - dafgda_(handle, &i__1, &grpadd, data); - record[12] = data[0]; - record[13] = data[1]; - } - } else if (i__ == n) { - if (group == ndir + 1) { - -/* ET is greater than all of the times in the segment. Return */ -/* the state for the last time twice. */ - - record[12] = data[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("data", i__1, "spkr05_", (ftnlen)481)]; - record[13] = data[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("data", i__1, "spkr05_", (ftnlen)482)]; - addrss = begin + (nrec - 1) * 6; - i__1 = addrss + 5; - dafgda_(handle, &addrss, &i__1, data); - moved_(data, &c__6, record); - moved_(data, &c__6, &record[6]); - chkout_("SPKR05", (ftnlen)6); - return 0; - } else { - -/* ET is greater than the last time in this group but this is */ -/* not the last time in the segment. Need the first time from */ -/* the following group. The states for this case will be read */ -/* outside of the IF block. */ - - i__1 = grpadd + n - 1; - i__2 = grpadd + n; - dafgda_(handle, &i__1, &i__2, data); - record[12] = data[0]; - record[13] = data[1]; - } - } else { - -/* There are two times in the group that bracket ET. The states */ -/* for this case will be read outside of the IF block. */ - - record[12] = data[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "data", i__1, "spkr05_", (ftnlen)513)]; - record[13] = data[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "data", i__1, "spkr05_", (ftnlen)514)]; - } - -/* Read the consecutive states for the two epochs found above. */ -/* ET is greater than the (SKIP + I)th time but less than or */ -/* equal to the time (SKIP + I + 1). */ - - addrss = begin + (skip + i__ - 1) * 6; - i__1 = addrss + 11; - dafgda_(handle, &addrss, &i__1, data); - moved_(data, &c__12, record); - chkout_("SPKR05", (ftnlen)6); - return 0; -} /* spkr05_ */ - diff --git a/ext/spice/src/cspice/spkr08.c b/ext/spice/src/cspice/spkr08.c deleted file mode 100644 index f599409d09..0000000000 --- a/ext/spice/src/cspice/spkr08.c +++ /dev/null @@ -1,368 +0,0 @@ -/* spkr08.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKR08 ( Read SPK record from segment, type 8 ) */ -/* Subroutine */ int spkr08_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer near__, last; - doublereal step; - integer type__, n, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), errdp_(char *, - doublereal *, ftnlen); - integer first; - doublereal start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6], degree; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal contrl[4]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer grpsiz; - extern logical return_(void), odd_(integer *); - integer end, low; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 8 */ -/* (equally spaced discrete states, interpolated by Lagrange */ -/* polynomials). */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 8. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is a set of data from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | start epoch | */ -/* +----------------------+ */ -/* | step size | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine follows the pattern established in the lower-numbered */ -/* SPK data type readers of not explicitly performing error */ -/* diagnoses. Exceptions are listed below nonetheless. */ - -/* 1) If the input HANDLE does not designate a loaded SPK file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 2) If the segment specified by DESCR is not of data type 08, */ -/* the error 'SPICE(WRONGSPKTYPE)' is signalled. */ - -/* 3) If the input ET value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signalled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 8 segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 8 ) THEN */ -/* CALL SPKR08 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) Correctness of inputs must be ensured by the caller of */ -/* this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 2.0.0, 06-NOV-1999 (NJB) */ - -/* Data type check was relaxed to enable reading type 12 */ -/* segments. */ - -/* - SPICELIB Version 1.0.1, 24-OCT-1994 (NJB) */ - -/* In-line comment concerning transpose of state data was */ -/* removed. */ - -/* - SPICELIB Version 1.0.0, 14-AUG-1993 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_8 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - -/* Unpack the segment descriptor, and get the start and end addresses */ -/* of the segment. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[3]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 8 or type 12 data segment. */ - - if (type__ != 8 && type__ != 12) { - chkin_("SPKR08", (ftnlen)6); - setmsg_("You are attempting to locate type 8 or type 12 data in a ty" - "pe # data segment.", (ftnlen)77); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19); - chkout_("SPKR08", (ftnlen)6); - return 0; - } - -/* Check the request time against the bounds in the segment */ -/* descriptor. */ - - if (*et < dc[0] || *et > dc[1]) { - chkin_("SPKR08", (ftnlen)6); - setmsg_("Request time # is outside of descriptor bounds # : #.", ( - ftnlen)53); - errdp_("#", et, (ftnlen)1); - errdp_("#", dc, (ftnlen)1); - errdp_("#", &dc[1], (ftnlen)1); - sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22); - chkout_("SPKR08", (ftnlen)6); - return 0; - } - -/* The type 8 segment structure is described by this diagram from */ -/* the SPK Required Reading: */ - -/* +-----------------------+ */ -/* | State 1 | */ -/* +-----------------------+ */ -/* | State 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | State N | */ -/* +-----------------------+ */ -/* | Epoch of state 1 (ET) | */ -/* +-----------------------+ */ -/* | Step size | */ -/* +-----------------------+ */ -/* | Polynomial degree | */ -/* +-----------------------+ */ -/* | Number of states | */ -/* +-----------------------+ */ - - -/* We'll need the last four items before we can determine which */ -/* states make up our output record. */ - - - i__1 = end - 3; - dafgda_(handle, &i__1, &end, contrl); - start = contrl[0]; - step = contrl[1]; - degree = i_dnnt(&contrl[2]); - n = i_dnnt(&contrl[3]); - grpsiz = degree + 1; - -/* We'll now select the set of states that define the interpolating */ -/* polynomials. The cases of odd and even GRPSIZ are handled */ -/* separately. */ - - if (odd_(&grpsiz)) { - -/* Find the index of the state whose epoch is closest to the */ -/* input epoch. Find the first and last indices in the record */ -/* of the (GRPSIZ-1)/2 states on either side of this central */ -/* state. */ - - d__1 = (*et - start) / step; - near__ = i_dnnt(&d__1) + 1; -/* Computing MIN */ -/* Computing MAX */ - i__3 = 1, i__4 = near__ - degree / 2; - i__1 = max(i__3,i__4), i__2 = n - degree; - first = min(i__1,i__2); - last = first + degree; - } else { - -/* Find the index of the last state whose epoch is less than or */ -/* equal to that of the input epoch. Find the first and last */ -/* indices in the record of the set of GRPSIZ consecutive states */ -/* having this state as the (GRPSIZ/2)th one. */ - - low = (integer) ((*et - start) / step) + 1; -/* Computing MIN */ -/* Computing MAX */ - i__3 = 1, i__4 = low - degree / 2; - i__1 = max(i__3,i__4), i__2 = n - degree; - first = min(i__1,i__2); - last = first + degree; - } - -/* Put the size of the group of states, the epoch of the first */ -/* state in the record, and the step size into the output record. */ - - record[0] = (doublereal) grpsiz; - record[1] = start + (first - 1) * step; - record[2] = step; - -/* Read the states. */ - - i__1 = begin + (first - 1) * 6; - i__2 = begin + last * 6 - 1; - dafgda_(handle, &i__1, &i__2, &record[3]); - return 0; -} /* spkr08_ */ - diff --git a/ext/spice/src/cspice/spkr09.c b/ext/spice/src/cspice/spkr09.c deleted file mode 100644 index 110e332615..0000000000 --- a/ext/spice/src/cspice/spkr09.c +++ /dev/null @@ -1,485 +0,0 @@ -/* spkr09.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKR09 ( Read SPK record from segment, type 9 ) */ -/* Subroutine */ int spkr09_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer high, near__, ndir, last, type__, i__, n, begin, nread; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), errdp_(char *, - doublereal *, ftnlen); - integer first, group, start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6], degree, begidx, bufbas, dirbas; - doublereal buffer[101]; - integer endidx, remain, timbas; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal contrl[2]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - integer wndsiz; - extern logical return_(void), odd_(integer *); - integer end, low; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 9 */ -/* (Unequally spaced discrete states, interpolated by Lagrange */ -/* polynomials). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 9. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is a set of data from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine follows the pattern established in the lower-numbered */ -/* SPK data type readers of not explicitly performing error */ -/* diagnoses. Exceptions are listed below nonetheless. */ - -/* 1) If the input HANDLE does not designate a loaded SPK file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 2) If the segment specified by DESCR is not of data types 9 or 13, */ -/* the error 'SPICE(WRONGSPKTYPE)' is signalled. */ - -/* 3) If the input ET value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signalled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 9 segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 9 ) THEN */ -/* CALL SPKR09 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) Correctness of inputs must be ensured by the caller of */ -/* this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 2.0.0, 06-NOV-1999 (NJB) */ - -/* Data type check was relaxed to enable reading type 13 */ -/* segments. */ - -/* - SPICELIB Version 1.0.1, 24-OCT-1994 (NJB) */ - -/* In-line comment concerning transpose of state data was */ -/* removed. */ - -/* - SPICELIB Version 1.0.0, 14-AUG-1993 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_9 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - -/* Unpack the segment descriptor, and get the start and end addresses */ -/* of the segment. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[3]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 9 or type 13 data segment. */ - - if (type__ != 9 && type__ != 13) { - chkin_("SPKR09", (ftnlen)6); - setmsg_("You are attempting to locate type 9 or type 13 data in a ty" - "pe # data segment.", (ftnlen)77); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19); - chkout_("SPKR09", (ftnlen)6); - return 0; - } - -/* Check the request time against the bounds in the segment */ -/* descriptor. */ - - if (*et < dc[0] || *et > dc[1]) { - chkin_("SPKR09", (ftnlen)6); - setmsg_("Request time # is outside of descriptor bounds # : #.", ( - ftnlen)53); - errdp_("#", et, (ftnlen)1); - errdp_("#", dc, (ftnlen)1); - errdp_("#", &dc[1], (ftnlen)1); - sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22); - chkout_("SPKR09", (ftnlen)6); - return 0; - } - -/* From this point onward, we assume the segment was constructed */ -/* correctly. In particular, we assume: */ - -/* 1) The first and last epochs in the segment define a time */ -/* interval that contains the interval defined by the segment */ -/* descriptor's time bounds. */ - -/* 2) The segment descriptor's time bounds are in order and are */ -/* distinct. */ - -/* 3) The epochs in the segment are in strictly increasing */ -/* order. */ - -/* 4) The degree of the interpolating polynomial specified by */ -/* the segment is at least 1 and is no larger than */ - -/* ( L - 1 ) / 7 [integer division] */ - -/* where L is the declared length of the argument RECORD. */ - -/* 5) There are at least as many epochs in the segment as the */ -/* the number of points required to define an interpolating */ -/* polynomial of the specified degree. */ - - -/* We'll need the last two items before we can determine which */ -/* states make up our output record. */ - - - i__1 = end - 1; - dafgda_(handle, &i__1, &end, contrl); - degree = i_dnnt(contrl); - n = i_dnnt(&contrl[1]); - wndsiz = degree + 1; - -/* We'll now select the set of states that define the interpolating */ -/* polynomials. We'll start out by finding the first directory */ -/* entry that is greater than or equal to the request epoch. We'll */ -/* use the variable GROUP to indicate the set of epochs to search */ -/* within, once we've found the right directory entry. */ - - ndir = (n - 1) / 100; - dirbas = end - ndir - 2; - if (ndir == 0) { - -/* There's no mystery about which group of epochs to search. */ - - group = 1; - } else { - -/* There's at least one directory. Find the first directory */ -/* whose time is greater than or equal to the request time, if */ -/* there is such a directory. We'll search linearly through the */ -/* directory entries, reading up to BUFSIZ of them at a time. */ -/* Having found the correct set of directory entries, we'll */ -/* perform a binary search within that set for the desired entry. */ - - bufbas = dirbas; - nread = min(ndir,101); - remain = ndir - nread; - i__1 = bufbas + 1; - i__2 = bufbas + nread; - dafgda_(handle, &i__1, &i__2, buffer); - while(buffer[(i__1 = nread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge( - "buffer", i__1, "spkr09_", (ftnlen)373)] < *et && remain > 0) - { - bufbas += nread; - nread = min(remain,101); - remain -= nread; - -/* Note: NREAD is always > 0 here. */ - - i__1 = bufbas + 1; - i__2 = bufbas + nread; - dafgda_(handle, &i__1, &i__2, buffer); - } - -/* At this point, BUFBAS - DIRBAS is the number of directory */ -/* entries preceding the one contained in BUFFER(1). */ - - group = bufbas - dirbas + lstltd_(et, &nread, buffer) + 1; - } - -/* GROUP now indicates the set of epochs in which to search for the */ -/* request epoch. If GROUP is 1, the request time lies within the */ -/* inclusive time interval bounded by the first and last epochs of */ -/* the first group. Otherwise, the request time lies in the time */ -/* interval bounded by the last element of the preceding group and */ -/* the last element of the current group. */ - -/* We'll use the variable names BEGIDX and ENDIDX to refer to */ -/* the indices, relative to the set of time tags, of the first */ -/* and last time tags in the set we're going to look up. */ - - if (group == 1) { - begidx = 1; - endidx = min(n,100); - } else { - -/* If the group index is greater than 1, we'll include the last */ -/* time tag of the previous group in the set of time tags we look */ -/* up. That way, the request time is bracketed by the time tag */ -/* set we look up. */ - - begidx = (group - 1) * 100; -/* Computing MIN */ - i__1 = begidx + 100; - endidx = min(i__1,n); - } - timbas = dirbas - n; - i__1 = timbas + begidx; - i__2 = timbas + endidx; - dafgda_(handle, &i__1, &i__2, buffer); - -/* Find two adjacent epochs bounding the request epoch. The request */ -/* time cannot be greater than all of epochs in the group, and it */ -/* cannot precede the first element of the group. */ - - i__1 = endidx - begidx + 1; - i__ = lstltd_(et, &i__1, buffer); - -/* The variables LOW and high are the indices of a pair of time */ -/* tags that bracket the request time. */ - - if (i__ == 0) { - low = 1; - } else { - low = begidx + i__ - 1; - } - high = low + 1; - -/* Now select the set of states used for interpolation. */ - - if (odd_(&wndsiz)) { - -/* Find the index of the state whose epoch is closest to the */ -/* input epoch. The index I is in the range [0, DIRSIZ], */ -/* since ENDIDX - BEGIDX never exceeds DIRSIZ, and ET is */ -/* never larger than the (ENDIDX-BEGIDX+1)th element of the */ -/* buffer. */ - - if (i__ == 0) { - -/* This can happen only if the request time matches the */ -/* first time tag of the segment. */ - - near__ = low; - } else if ((d__1 = *et - buffer[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "spkr09_", (ftnlen)467)], abs( - d__1)) < (d__2 = *et - buffer[(i__2 = i__) < 101 && 0 <= i__2 - ? i__2 : s_rnge("buffer", i__2, "spkr09_", (ftnlen)467)], abs( - d__2))) { - near__ = low; - } else { - near__ = high; - } - -/* The epochs whose index is NEAR is the (WNDSIZ/2 + 1)th */ -/* of the interpolating set, unless the request time is too close */ -/* to the end of the coverage interval, in which case one endpoint */ -/* of the window will coincide with an endpoint of the coverage */ -/* interval. */ - -/* Computing MIN */ -/* Computing MAX */ - i__3 = near__ - degree / 2; - i__1 = max(i__3,1), i__2 = n - degree; - first = min(i__1,i__2); - last = first + degree; - } else { - -/* The group size is even. */ - -/* The bracketing epochs we've found are the (WNDSIZ/2)th */ -/* and (WNDSIZ/2 + 1)th of the interpolating set, unless the */ -/* request time is too close to the end of the coverage interval, */ -/* in which case one endpoint of the window will coincide with */ -/* an endpoint of the coverage interval. */ - -/* Computing MIN */ -/* Computing MAX */ - i__3 = low - degree / 2; - i__1 = max(i__3,1), i__2 = n - degree; - first = min(i__1,i__2); - last = first + degree; - } - -/* Put the size of the group of states into the output record. */ - - record[0] = (doublereal) wndsiz; - -/* Read the states. */ - - i__1 = begin + (first - 1) * 6; - i__2 = begin + last * 6 - 1; - dafgda_(handle, &i__1, &i__2, &record[1]); - -/* Finally, add the epochs to the output record. */ - - start = begin + n * 6 + first - 2; - i__1 = start + 1; - i__2 = start + wndsiz; - dafgda_(handle, &i__1, &i__2, &record[wndsiz * 6 + 1]); - return 0; -} /* spkr09_ */ - diff --git a/ext/spice/src/cspice/spkr10.c b/ext/spice/src/cspice/spkr10.c deleted file mode 100644 index 6a43d69356..0000000000 --- a/ext/spice/src/cspice/spkr10.c +++ /dev/null @@ -1,667 +0,0 @@ -/* spkr10.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__8 = 8; -static integer c__7 = 7; -static integer c__14 = 14; - -/* $Procedure SPKR10 ( SPK, read record from SPK type 10 segment ) */ -/* Subroutine */ int spkr10_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - static integer ends[2], indx, from, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - static logical found; - static doublereal value; - static integer to, nepoch, getelm; - extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, - integer *, doublereal *), sgmeta_(integer *, doublereal *, - integer *, integer *), chkout_(char *, ftnlen), sgfpkt_(integer *, - doublereal *, integer *, integer *, doublereal *, integer *), - sgfrvi_(integer *, doublereal *, doublereal *, doublereal *, - integer *, logical *); - static integer putelm; - extern logical return_(void); - static integer set1, set2; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 10 */ -/* (NORAD two line element sets). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 10. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) It is assumed that the descriptor and handle supplied are */ -/* for a properly constructed type 10 segment. No checks are */ -/* performed to ensure this. */ - -/* 2) All errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 10 segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 1 ) THEN */ -/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-MAR-2009 (EDW) */ - -/* Remove declaration of unused varaible DOINT. */ - -/* - SPICELIB Version 1.0.0, 05-JAN-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_10 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* We have 2 nutation/obliquity terms and their rates giving us */ -/* four angle components for each packet. */ - - -/* BEGEL1 is the location in the record where the first */ -/* two-line element set will begin. */ - - -/* BEGEL2 is the location in the record where the second */ -/* two-line element set will begin. */ - - -/* ENSET1 and ENSET2 are the locations in the record where the */ -/* last element of set 1 and set 2 will be located. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKR10", (ftnlen)6); - -/* Fetch the constants and store them in the first part of */ -/* the output RECORD. */ - - sgfcon_(handle, descr, &c__1, &c__8, record); - -/* Locate the time in the file closest to the input ET. */ - - sgfrvi_(handle, descr, et, &value, &indx, &found); - -/* Determine which pair of element sets to choose so that */ -/* they will bracket ET. */ - - if (*et <= value) { -/* Computing MAX */ - i__1 = indx - 1; - from = max(i__1,1); - to = indx; - } else { - sgmeta_(handle, descr, &c__7, &nepoch); - from = indx; -/* Computing MIN */ - i__1 = indx + 1; - to = min(i__1,nepoch); - } - -/* Fetch the element sets */ - - sgfpkt_(handle, descr, &from, &to, &record[8], ends); - -/* If the size of the packets is not 14, this is an old style */ -/* two-line element set without nutation information. We simply */ -/* set all of the angles to zero. */ - - if (ends[0] == 10) { - -/* First shift the elements to their proper locations in RECORD */ -/* so there will be room to fill in the zeros. */ - - putelm = 32; - getelm = 28; - while(getelm > 18) { - record[putelm - 1] = record[getelm - 1]; - --putelm; - --getelm; - } - set1 = 19; - set2 = 33; - for (i__ = 1; i__ <= 4; ++i__) { - record[set1 - 1] = 0.; - record[set2 - 1] = 0.; - ++set1; - ++set2; - } - } - -/* If we only got one element set, ET was either before the */ -/* first one in the segment or after the last one in the */ -/* segment. We simply copy the one fetched a second time so */ -/* that the record is properly constructed. */ - - if (from == to) { - moved_(&record[8], &c__14, &record[22]); - } - chkout_("SPKR10", (ftnlen)6); - return 0; -} /* spkr10_ */ - diff --git a/ext/spice/src/cspice/spkr12.c b/ext/spice/src/cspice/spkr12.c deleted file mode 100644 index 693f375d80..0000000000 --- a/ext/spice/src/cspice/spkr12.c +++ /dev/null @@ -1,200 +0,0 @@ -/* spkr12.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKR12 ( Read SPK record from segment, type 12 ) */ -/* Subroutine */ int spkr12_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), spkr08_(integer *, - doublereal *, doublereal *, doublereal *), chkout_(char *, ftnlen) - ; - extern logical return_(void); - -/* $ Abstract */ - -/* Read a single data record from a type 12 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the open SPK file. */ -/* DESCR I Descriptor of the segment with the desired record. */ -/* ET I Epoch used to identify the desired record. */ -/* RECORD O The desired type 12 SPK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the open SPK file which contains */ -/* the segment of interest. */ - -/* DESCR is the descriptor for a type 12 SPK segment that */ -/* contains the record of interest. */ - -/* ET is the target epoch used to determine the */ -/* particular record to be obtained from the SPK */ -/* segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | start epoch | */ -/* +----------------------+ */ -/* | step size | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) All errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* This subroutine will read a single record from a type 12 SPK */ -/* segment. The record read will provide the data necessary to */ -/* compute the state for the body designated by DESCR at epoch */ -/* ET. */ - -/* The exact format and structure of a type 12 SPK segment is */ -/* described in the SPK Required Reading. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 12 ) THEN */ -/* CALL SPKR12 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* This subroutine should not be called directly by a casual user. It */ -/* is intended for use by the subroutine SPKPVN, and certain tests */ -/* for error conditions are not performed here, as SPKPVN will have */ -/* already performed them. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-FEB-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_12 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKR12", (ftnlen)6); - -/* The type 8 reader knows how to obtain a type 12 record. */ - - spkr08_(handle, descr, et, record); - chkout_("SPKR12", (ftnlen)6); - return 0; -} /* spkr12_ */ - diff --git a/ext/spice/src/cspice/spkr13.c b/ext/spice/src/cspice/spkr13.c deleted file mode 100644 index 9e2a5b6850..0000000000 --- a/ext/spice/src/cspice/spkr13.c +++ /dev/null @@ -1,205 +0,0 @@ -/* spkr13.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKR13 ( Read SPK record from segment, type 13 ) */ -/* Subroutine */ int spkr13_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), spkr09_(integer *, - doublereal *, doublereal *, doublereal *), chkout_(char *, ftnlen) - ; - extern logical return_(void); - -/* $ Abstract */ - -/* Read a single data record from a type 13 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the open SPK file. */ -/* DESCR I Descriptor of the segment with the desired record. */ -/* ET I Epoch used to identify the desired record. */ -/* RECORD O The desired type 13 SPK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the open SPK file which contains */ -/* the segment of interest. */ - -/* DESCR is the descriptor for a type 13 SPK segment that */ -/* contains the record of interest. */ - -/* ET is the target epoch used to determine the */ -/* particular record to be obtained from the SPK */ -/* segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | number of states (n) | */ -/* +----------------------+ */ -/* | state 1 (6 elts.) | */ -/* +----------------------+ */ -/* | state 2 (6 elts.) | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | state n (6 elts.) | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) It is assumed that the descriptor and handle supplied are */ -/* for a properly constructed type 13 segment. No checks are */ -/* performed to ensure this. */ - -/* 2) If the input ET value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signalled. */ - -/* 3) All other errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* This subroutine will read a single record from a type 13 SPK */ -/* segment. The record read will provide the data necessary to */ -/* compute the state for the body designated by DESCR at epoch */ -/* ET. */ - -/* The exact format and structure of a type 13 SPK segment is */ -/* described in the SPK Required Reading. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 13 ) THEN */ -/* CALL SPKR13 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* This subroutine should not be called directly by a casual user. It */ -/* is intended for use by the subroutine SPKPVN, and certain tests */ -/* for error conditions are not performed here, as SPKPVN will have */ -/* already performed them. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-FEB-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_13 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKR13", (ftnlen)6); - -/* The type 9 reader knows how to obtain a type 13 record. */ - - spkr09_(handle, descr, et, record); - chkout_("SPKR13", (ftnlen)6); - return 0; -} /* spkr13_ */ - diff --git a/ext/spice/src/cspice/spkr14.c b/ext/spice/src/cspice/spkr14.c deleted file mode 100644 index f119e34b80..0000000000 --- a/ext/spice/src/cspice/spkr14.c +++ /dev/null @@ -1,238 +0,0 @@ -/* spkr14.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SPKR14 ( Read SPK record from segment, type 14 ) */ -/* Subroutine */ int spkr14_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - integer ends, indx; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - doublereal value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), sgfcon_( - integer *, doublereal *, integer *, integer *, doublereal *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), sgfpkt_(integer - *, doublereal *, integer *, integer *, doublereal *, integer *), - sgfrvi_(integer *, doublereal *, doublereal *, doublereal *, - integer *, logical *), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Read a single data record from a type 14 SPK segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the open SPK file. */ -/* DESCR I Descriptor of the segment with the desired record. */ -/* ET I Epoch used to identify the desired record. */ -/* RECORD O The desired type 14 SPK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the open SPK file which contains the */ -/* segment of interest. */ - -/* DESCR is the descriptor for a type 14 SPK segment that contains */ -/* the record of interest. */ - -/* ET is the target epoch used to determine the particular */ -/* record to be obtained from the SPK segment. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) It is assumed that the descriptor and handle supplied are */ -/* for a properly constructed type 14 segment. No checks are */ -/* performed to ensure this. */ - -/* 2) If the input ET value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signalled. */ - -/* 3) All other errors are diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* This subroutine will read a single record from a type 14 SPK */ -/* segment. The record read will provide the data necessary to */ -/* compute the state for a some body in some inertial frame at epoch */ -/* ET. */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a type 14 SPK segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in a raw form, taken */ -/* directly from the segment. As such, it will be not be directly */ -/* useful to a user unless they have a complete understanding of the */ -/* structure of the data type. Given that understanding, however, */ -/* the SPKRnn routines could be used to "dump" and check segment data */ -/* for a particular epoch, as in the example which follows. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 14 ) THEN */ -/* CALL SPKR14 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* This subroutine should not be called directly by a casual user. It */ -/* is intended for use by the subroutine SPKPV, and certain tests for */ -/* error conditions are not performed here, as SPKPV will have */ -/* already performed them. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_14 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - -/* The number of constant values stored with a type 14 segment */ -/* segment. */ - - -/* The beginning location in the output record for the non constant */ -/* segment data. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKR14", (ftnlen)6); - } - -/* Check the request time against the time bounds in the segment */ -/* descriptor. In order to get the right data back from the generic */ -/* segment calls below, we need to be sure that the desired epoch */ -/* falls within the bounds of the segment, as specified by the */ -/* descriptor. The first two elements of the descriptor are the start */ -/* time for the segment and the stop time for the segment, */ -/* respectively. */ - - if (*et < descr[0] || *et > descr[1]) { - setmsg_("Request time # is outside of descriptor bounds # : #.", ( - ftnlen)53); - errdp_("#", et, (ftnlen)1); - errdp_("#", descr, (ftnlen)1); - errdp_("#", &descr[1], (ftnlen)1); - sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22); - chkout_("SPKR14", (ftnlen)6); - return 0; - } - -/* Fetch the constants and store them in the first part of */ -/* the output RECORD. */ - - sgfcon_(handle, descr, &c__1, &c__1, record); - -/* Locate the time in the file less than or equal to the input ET, */ -/* obtaining its index. This will allow us to retrieve the proper */ -/* record. */ - - sgfrvi_(handle, descr, et, &value, &indx, &found); - -/* Fetch the appropriate record from the segment. */ - - sgfpkt_(handle, descr, &indx, &indx, &record[1], &ends); - chkout_("SPKR14", (ftnlen)6); - return 0; -} /* spkr14_ */ - diff --git a/ext/spice/src/cspice/spkr15.c b/ext/spice/src/cspice/spkr15.c deleted file mode 100644 index 409938f910..0000000000 --- a/ext/spice/src/cspice/spkr15.c +++ /dev/null @@ -1,266 +0,0 @@ -/* spkr15.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKR15 ( Read SPK record from segment, type 15 ) */ -/* Subroutine */ int spkr15_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer type__, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *); - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* This routine reads a single spk data record from a segment of */ -/* type 15 (Precessing Conic Propagation). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 15. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the segment specified by DESCR is not a type 15 segment */ -/* the error 'SPICE(WRONGSPKTYPE)' will be signalled. */ - -/* 2) A type 15 segment should have exactly 16 values. If this */ -/* is not the case the error 'SPICE(MALFORMEDSEGMENT)' is */ -/* signalled. */ - -/* $ Particulars */ - -/* This routine reads all of the data from a type 15 SPK segment. */ - -/* The structure of the data retrieved in RECORD is: */ - -/* RECORD(1) epoch of the orbit elements at periapse */ -/* in ephemeris seconds past J2000. */ -/* RECORD(2)-RECORD(4) unit trajectory pole vector */ -/* RECORD(5)-RECORD(7) unit periapsis vector */ -/* RECORD(8) semi-latus rectum---p in the */ -/* equation: */ - -/* r = p/(1 + ECC*COS(Nu)) */ - -/* RECORD(9) eccentricity */ -/* RECORD(10) J2 processing flag describing */ -/* what J2 corrections are to be */ -/* applied when the orbit is */ -/* propagated. */ - -/* Value Meaning */ -/* ----- ----------------------------- */ -/* 1 Regress line of nodes only. */ -/* 2 Precess line of apsides only. */ -/* 3 Don't use J2 corrections. */ -/* Other Regress line of nodes */ -/* and precess line of apsides. */ - -/* RECORD(11)-RECORD(13) unit central body pole vector */ -/* RECORD(14) central body GM */ -/* RECORD(15) central body J2 */ -/* RECORD(16) central body radius */ - -/* Except for J2, units are radians, km, seconds. */ - - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 15 ) THEN */ -/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* S. Schlaifer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_15 spk segment */ - -/* -& */ - -/* SPICELIB Funcions */ - - -/* Local Variables */ - - -/* The differnce between the first and last address of a type 15 */ -/* segment should be 15. */ - - -/* Standard Spice Error Handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKR15", (ftnlen)6); - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[3]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 15 data segment. */ - - if (type__ != 15) { - setmsg_("You are attempting to locate type 15 data in a type # data " - "segment.", (ftnlen)67); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19); - chkout_("SPKR15", (ftnlen)6); - return 0; - } - -/* Since it doesn't cost much we make sure that the segment has */ -/* the correct amount of data. */ - - if (end - begin != 15) { - setmsg_("A type 15 segment should contain exactly 16 double precisio" - "n values. The segment supplied had #. The segment is badly" - " formed. ", (ftnlen)128); - i__1 = end - begin + 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(MALFORMEDSEGMENT)", (ftnlen)23); - chkout_("SPKR15", (ftnlen)6); - return 0; - } - -/* Read the data for the record. */ - - dafgda_(handle, &begin, &end, record); - chkout_("SPKR15", (ftnlen)6); - return 0; -} /* spkr15_ */ - diff --git a/ext/spice/src/cspice/spkr17.c b/ext/spice/src/cspice/spkr17.c deleted file mode 100644 index aaf8a8b995..0000000000 --- a/ext/spice/src/cspice/spkr17.c +++ /dev/null @@ -1,279 +0,0 @@ -/* spkr17.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__12 = 12; - -/* $Procedure SPKR17 ( Read SPK record from segment, type 17 ) */ -/* Subroutine */ int spkr17_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer type__, begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), dafgda_(integer *, - integer *, integer *, doublereal *); - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* This routine reads a single spk data record from a segment of */ -/* type 17 (Precessing Conic Propagation). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 17. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is the record from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some inertial reference frame. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Exceptions */ - -/* 1) If the segment specified by DESCR is not a type 17 segment */ -/* the error 'SPICE(WRONGSPKTYPE)' will be signalled. */ - -/* 2) A type 17 segment should have exactly 16 values. If this */ -/* is not the case the error 'SPICE(MALFORMEDSEGMENT)' is */ -/* signalled. */ - -/* $ Particulars */ - -/* This routine reads all of the data from a type 17 SPK segment. */ - -/* The structure of the data retrieved in RECORD is: */ - -/* RECORD(1) is the epoch of the orbit elements at */ -/* in ephemeris seconds past J2000. */ - -/* RECORD(2) is the semi-major axis (A) of the orbit. */ - -/* RECORD(3) is the value of H at the specified epoch. */ -/* ( E*SIN(ARGP+NODE) ). */ - -/* RECORD(4) is the value of K at the specified epoch */ -/* ( E*COS(ARGP+NODE) ). */ - -/* RECORD(5) is the mean longitude (MEAN0+ARGP+NODE)at */ -/* the epoch of the elements. */ - -/* RECORD(6) is the value of P (TAN(INC/2)*SIN(NODE))at */ -/* the specified epoch. */ - -/* RECORD(7) is the value of Q (TAN(INC/2)*COS(NODE))at */ -/* the specified epoch. */ - -/* RECORD(8) is the rate of the longitude of periapse */ -/* (dARGP/dt + dNODE/dt ) at the epoch of */ -/* the elements. This rate is assumed to hold */ -/* for all time. */ - -/* RECORD(9) is the derivative of the mean longitude */ -/* ( dM/dt + dARGP/dt + dNODE/dt ). This */ -/* rate is assumed to be constant. */ - -/* RECORD(10) is the rate of the longitude of the ascending */ -/* node ( dNODE/dt). */ - -/* RECORD(11) Right Ascension of the pole of the */ -/* orbital reference system relative to the */ -/* reference frame of the associated SPK segment. */ - -/* RECORD(12) Declination of the pole of the */ -/* orbital reference system relative to the */ -/* reference frame of the associated SPK segment. */ - -/* Units are km, radians and radians/second. */ - - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRnn */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 17 ) THEN */ -/* CALL SPKR17 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 3-JAN-1997 (WLT) (SS) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_17 spk segment */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* The difference between the first and last address of a type 17 */ -/* segment should be 11. */ - - -/* Standard Spice Error Handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKR17", (ftnlen)6); - -/* Unpack the segment descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[3]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 17 data segment. */ - - if (type__ != 17) { - setmsg_("You are attempting to locate type 17 data in a type # data " - "segment.", (ftnlen)67); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19); - chkout_("SPKR17", (ftnlen)6); - return 0; - } - -/* Since it doesn't cost much we make sure that the segment has */ -/* the correct amount of data. */ - - if (end - begin != 11) { - setmsg_("A type 17 segment should contain exactly # double precision" - " values. The segment supplied had #. The segment is badly " - "formed. ", (ftnlen)127); - i__1 = end - begin + 1; - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__12, (ftnlen)1); - sigerr_("SPICE(MALFORMEDSEGMENT)", (ftnlen)23); - chkout_("SPKR17", (ftnlen)6); - return 0; - } - -/* Read the data for the record. */ - - dafgda_(handle, &begin, &end, record); - chkout_("SPKR17", (ftnlen)6); - return 0; -} /* spkr17_ */ - diff --git a/ext/spice/src/cspice/spkr18.c b/ext/spice/src/cspice/spkr18.c deleted file mode 100644 index 212178cb6c..0000000000 --- a/ext/spice/src/cspice/spkr18.c +++ /dev/null @@ -1,617 +0,0 @@ -/* spkr18.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKR18 ( Read SPK record from segment, type 18 ) */ -/* Subroutine */ int spkr18_(integer *handle, doublereal *descr, doublereal * - et, doublereal *record) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer high, ndir, last, type__, i__, n, begin, nread; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), errdp_(char *, - doublereal *, ftnlen); - integer lsize, first, group, rsize, start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6]; - extern logical failed_(void); - integer begidx, bufbas, dirbas; - doublereal buffer[101]; - integer endidx, remain, timbas, packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer maxwnd; - doublereal contrl[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern integer lstltd_(doublereal *, integer *, doublereal *); - integer wndsiz; - extern logical return_(void); - integer subtyp; - extern logical odd_(integer *); - integer end, low; - -/* $ Abstract */ - -/* Read a single SPK data record from a segment of type 18 */ -/* (MEX/Rosetta Orbit file interpolation). */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to SPK type 18. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */ - -/* -& */ - -/* SPK type 18 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 12-element packets, order */ -/* reduction at boundaries to preceding number */ -/* equivalent to 3 mod 4. */ - - -/* Subtype 1: Lagrange interpolation, 6-element packets, order */ -/* reduction at boundaries to preceding odd number. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of include file spk18.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* DESCR I Segment descriptor. */ -/* ET I Target epoch. */ -/* RECORD O Data record. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR are the file handle and segment descriptor for */ -/* a SPK segment of type 18. */ - -/* ET is a target epoch, for which a data record from */ -/* a specific segment is required. */ - -/* $ Detailed_Output */ - -/* RECORD is a set of data from the specified segment which, */ -/* when evaluated at epoch ET, will give the state */ -/* (position and velocity) of some body, relative */ -/* to some center, in some reference frame. */ - -/* The structure of the record is as follows: */ - -/* +----------------------+ */ -/* | subtype code | */ -/* +----------------------+ */ -/* | number of packets (n)| */ -/* +----------------------+ */ -/* | packet 1 | */ -/* +----------------------+ */ -/* | packet 2 | */ -/* +----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +----------------------+ */ -/* | packet n | */ -/* +----------------------+ */ -/* | epochs 1--n | */ -/* +----------------------+ */ - -/* The packet size is a function of the subtype code. */ -/* All packets in a record have the same size. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input HANDLE does not designate a loaded SPK file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 2) If the segment specified by DESCR is not of data type 18, */ -/* the error 'SPICE(WRONGSPKTYPE)' is signaled. */ - -/* 3) If the input ET value is not within the range specified */ -/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */ -/* is signaled. */ - -/* 4) If the window size is non-positive or greater than the */ -/* maximum allowed value, the error SPICE(INVALIDVALUE) is */ -/* signaled. */ - -/* 5) If the window size is not compatible with the segment */ -/* subtype, the error SPICE(INVALIDVALUE) is signaled. */ - -/* 6) If the segment subtype is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* See the SPK Required Reading file for a description of the */ -/* structure of a data type 18 segment. */ - -/* $ Examples */ - -/* The data returned by the SPKRnn routine is in its rawest form, */ -/* taken directly from the segment. As such, it will be meaningless */ -/* to a user unless he/she understands the structure of the data type */ -/* completely. Given that understanding, however, the SPKRxx */ -/* routines might be used to "dump" and check segment data for a */ -/* particular epoch. */ - - -/* C */ -/* C Get a segment applicable to a specified body and epoch. */ -/* C */ -/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */ - -/* C */ -/* C Look at parts of the descriptor. */ -/* C */ -/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */ -/* CENTER = ICD( 2 ) */ -/* REF = ICD( 3 ) */ -/* TYPE = ICD( 4 ) */ - -/* IF ( TYPE .EQ. 18 ) THEN */ -/* CALL SPKR18 ( HANDLE, DESCR, ET, RECORD ) */ -/* . */ -/* . Look at the RECORD data. */ -/* . */ -/* END IF */ - -/* $ Restrictions */ - -/* 1) Correctness of inputs must be ensured by the caller of */ -/* this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 04-SEP-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read record from type_18 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Maximum polynomial degree: */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("SPKR18", (ftnlen)6); - -/* Unpack the segment descriptor, and get the start and end addresses */ -/* of the segment. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - type__ = ic[3]; - begin = ic[4]; - end = ic[5]; - -/* Make sure that this really is a type 18 data segment. */ - - if (type__ != 18) { - setmsg_("You are attempting to locate type * data in a type 18 data " - "segment.", (ftnlen)67); - errint_("*", &type__, (ftnlen)1); - sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - -/* Check the request time against the bounds in the segment */ -/* descriptor. */ - - if (*et < dc[0] || *et > dc[1]) { - setmsg_("Request time # is outside of descriptor bounds # : #.", ( - ftnlen)53); - errdp_("#", et, (ftnlen)1); - errdp_("#", dc, (ftnlen)1); - errdp_("#", &dc[1], (ftnlen)1); - sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - -/* From this point onward, we assume the segment was constructed */ -/* correctly. In particular, we assume: */ - -/* 1) The first and last epochs in the segment define a time */ -/* interval that contains the interval defined by the segment */ -/* descriptor's time bounds. */ - -/* 2) The segment descriptor's time bounds are in order and are */ -/* distinct. */ - -/* 3) The epochs in the segment are in strictly increasing */ -/* order. */ - -/* 4) The degree of the interpolating polynomial specified by */ -/* the segment is at least 1 and is no larger than */ - -/* MAXDEG */ - -/* We'll need the last two items before we can determine which */ -/* packets make up our output record. */ - - - i__1 = end - 2; - dafgda_(handle, &i__1, &end, contrl); - -/* Check the FAILED flag just in case HANDLE is not attached to */ -/* any DAF file and the error action is not set to ABORT. You need */ -/* need to do this only after the first call to DAFGDA. */ - - if (failed_()) { - chkout_("SPKR18", (ftnlen)6); - return 0; - } - subtyp = i_dnnt(contrl); - wndsiz = i_dnnt(&contrl[1]); - n = i_dnnt(&contrl[2]); - -/* Set the packet size, which is a function of the subtype. */ - - if (subtyp == 0) { - packsz = 12; - } else if (subtyp == 1) { - packsz = 6; - } else { - setmsg_("Unexpected SPK type 18 subtype # found in type 18 segment.", - (ftnlen)58); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - -/* Check the window size. */ - - if (wndsiz <= 0) { - setmsg_("Window size in type 18 segment was #; must be positive.", ( - ftnlen)55); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - if (subtyp == 0) { - maxwnd = 8; - if (wndsiz > maxwnd) { - setmsg_("Window size in type 18 segment was #; max allowed value" - " is # for subtype 0 (Hermite, 12-element packets).", ( - ftnlen)105); - errint_("#", &wndsiz, (ftnlen)1); - errint_("#", &maxwnd, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - if (odd_(&wndsiz)) { - setmsg_("Window size in type 18 segment was #; must be even for " - "subtype 0 (Hermite, 12-element packets).", (ftnlen)95); - errint_("#", &wndsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - } else if (subtyp == 1) { - maxwnd = 16; - if (wndsiz > maxwnd) { - setmsg_("Window size in type 18 segment was #; max allowed value" - " is # for subtype 1 (Lagrange, 6-element packets).", ( - ftnlen)105); - errint_("#", &wndsiz, (ftnlen)1); - errint_("#", &maxwnd, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - if (odd_(&wndsiz)) { - setmsg_("Window size in type 18 segment was #; must be even for " - "subtype 1 (Lagrange, 6-element packets).", (ftnlen)95); - errint_("#", &wndsiz, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - } else { - setmsg_("This point should not be reached. Getting here may indicate" - " that the code needs to updated to handle new subtypes.", ( - ftnlen)114); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SPKR18", (ftnlen)6); - return 0; - } - -/* We'll now select the set of packets that define the interpolating */ -/* polynomials. We'll start out by finding the first directory */ -/* entry that is greater than or equal to the request epoch. We'll */ -/* use the variable GROUP to indicate the set of epochs to search */ -/* within, once we've found the right directory entry. */ - - ndir = (n - 1) / 100; - dirbas = end - ndir - 3; - if (ndir == 0) { - -/* There's no mystery about which group of epochs to search. */ - - group = 1; - } else { - -/* There's at least one directory. Find the first directory */ -/* whose time is greater than or equal to the request time, if */ -/* there is such a directory. We'll search linearly through the */ -/* directory entries, reading up to BUFSIZ of them at a time. */ -/* Having found the correct set of directory entries, we'll */ -/* perform a binary search within that set for the desired entry. */ - - bufbas = dirbas; - nread = min(ndir,100); - remain = ndir - nread; - i__1 = bufbas + 1; - i__2 = bufbas + nread; - dafgda_(handle, &i__1, &i__2, buffer); - while(buffer[(i__1 = nread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge( - "buffer", i__1, "spkr18_", (ftnlen)486)] < *et && remain > 0) - { - bufbas += nread; - nread = min(remain,100); - remain -= nread; - -/* Note: NREAD is always > 0 here. */ - - i__1 = bufbas + 1; - i__2 = bufbas + nread; - dafgda_(handle, &i__1, &i__2, buffer); - } - -/* At this point, BUFBAS - DIRBAS is the number of directory */ -/* entries preceding the one contained in BUFFER(1). */ - - group = bufbas - dirbas + lstltd_(et, &nread, buffer) + 1; - } - -/* GROUP now indicates the set of epochs in which to search for the */ -/* request epoch. If GROUP is 1, the request time lies within the */ -/* inclusive time interval bounded by the first and last epochs of */ -/* the first group. Otherwise, the request time lies in the time */ -/* interval bounded by the last element of the preceding group and */ -/* the last element of the current group. */ - -/* We'll use the variable names BEGIDX and ENDIDX to refer to */ -/* the indices, relative to the set of time tags, of the first */ -/* and last time tags in the set we're going to look up. */ - - if (group == 1) { - begidx = 1; - endidx = min(n,100); - } else { - -/* If the group index is greater than 1, we'll include the last */ -/* time tag of the previous group in the set of time tags we look */ -/* up. That way, the request time is bracketed by the time tag */ -/* set we look up. */ - - begidx = (group - 1) * 100; -/* Computing MIN */ - i__1 = begidx + 100; - endidx = min(i__1,n); - } - timbas = dirbas - n; - i__1 = timbas + begidx; - i__2 = timbas + endidx; - dafgda_(handle, &i__1, &i__2, buffer); - -/* Find two adjacent epochs bounding the request epoch. The request */ -/* time cannot be greater than all of epochs in the group, and it */ -/* cannot precede the first element of the group. */ - - i__1 = endidx - begidx + 1; - i__ = lstltd_(et, &i__1, buffer); - -/* The variables LOW and high are the indices of a pair of time */ -/* tags that bracket the request time. */ - - if (i__ == 0) { - low = 1; - } else { - low = begidx + i__ - 1; - } - high = low + 1; - -/* Now select the set of packets used for interpolation. Note */ -/* that the window size is known to be even. */ - -/* Unlike SPK types 8, 9, 12, and 13, for type 18 we adjust */ -/* the window size to keep the request time within the central */ -/* interval of the window. */ - -/* The nominal bracketing epochs we've found are the (WNDSIZ/2)nd */ -/* and (WNDSIZ/2 + 1)st of the interpolating set. If the */ -/* request time is too close to one end of the coverage interval, */ -/* we reduce the window size, after which one endpoint of the */ -/* window will coincide with an endpoint of the coverage interval. */ - -/* Let LSIZE be the size of the "left half" of the window: the */ -/* size set of window epochs to the left of the request time. */ -/* We want this size to be WNDSIZ/2, but if not enough states are */ -/* available, the set ranges from index 1 to index LOW. */ - -/* Computing MIN */ - i__1 = wndsiz / 2; - lsize = min(i__1,low); - -/* RSIZE is defined analogously for the right half of the window. */ - -/* Computing MIN */ - i__1 = wndsiz / 2, i__2 = n - high + 1; - rsize = min(i__1,i__2); - -/* The window size is simply the sum of LSIZE and RSIZE. */ - - wndsiz = lsize + rsize; - -/* FIRST and LAST are the endpoints of the range of indices of */ -/* time tags (and packets) we'll collect in the output record. */ - - first = low - lsize + 1; - last = first + wndsiz - 1; - -/* Put the subtype into the output record. The size of the group */ -/* of packets is derived from the subtype, so we need not include */ -/* the size. */ - - record[0] = (doublereal) subtyp; - record[1] = (doublereal) wndsiz; - -/* Read the packets. */ - - i__1 = begin + (first - 1) * packsz; - i__2 = begin + last * packsz - 1; - dafgda_(handle, &i__1, &i__2, &record[2]); - -/* Finally, add the epochs to the output record. */ - - start = begin + n * packsz + first - 2; - i__1 = start + 1; - i__2 = start + wndsiz; - dafgda_(handle, &i__1, &i__2, &record[wndsiz * packsz + 2]); - chkout_("SPKR18", (ftnlen)6); - return 0; -} /* spkr18_ */ - diff --git a/ext/spice/src/cspice/spks01.c b/ext/spice/src/cspice/spks01.c deleted file mode 100644 index ecc8ac1a9e..0000000000 --- a/ext/spice/src/cspice/spks01.c +++ /dev/null @@ -1,266 +0,0 @@ -/* spks01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__71 = 71; -static integer c__1 = 1; - -/* $Procedure SPKS01 ( S/P Kernel, subset, type 1 ) */ -/* Subroutine */ int spks01_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Local variables */ - doublereal data[71]; - integer offe, nrec, ndir, last, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer first; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_( - integer *, integer *, integer *, doublereal *); - integer offset; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in a SPK segment of type 1 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of source segment. */ -/* BADDR I Beginning address of source segment. */ -/* EADDR I Ending address of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to a SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* the file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* The exact structure of a segment of data type 1 is detailed in */ -/* the SPK Required Reading file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK01 was removed from the Required_Reading section of the */ -/* header. The information in the SPK01 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_1 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS01", (ftnlen)6); - } - -/* Get the number of records in the segment. From that, we can */ -/* compute */ - -/* NDIR The number of directory epochs. */ - -/* OFFE The offset of the first epoch. */ - - -/* the number of directory epochs. */ - - dafgda_(handle, eaddr, eaddr, data); - nrec = (integer) data[0]; - ndir = nrec / 100; - offe = *eaddr - ndir - nrec - 1; - -/* Well, the new segment has already been begun. We just have to */ -/* decide what to move, and move it (using DAFADA). */ - -/* Let's agree right now that speed is not of the greatest */ -/* importance here. We can probably do this with two passes */ -/* through the record epochs, and one pass through the records. */ - -/* 1) Determine the first and last records to be included */ -/* in the subset. */ - -/* 2) Move the records. */ - -/* 3) Write the epochs. */ - -/* We can leap through the epochs one last time to get the */ -/* directory epochs. */ - - -/* First pass: which records are to be moved? */ - - first = 0; - last = 0; - i__1 = nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - if (first == 0 && data[0] >= *begin) { - first = i__; - } - if (first != 0 && last == 0 && data[0] >= *end) { - last = i__; - } - } - -/* Second pass. Move the records. */ - - offset = *baddr - 1 + (first - 1) * 71; - i__1 = last; - for (i__ = first; i__ <= i__1; ++i__) { - i__2 = offset + 1; - i__3 = offset + 71; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__71); - offset += 71; - } - -/* Third pass. Move the epochs. */ - - i__1 = last; - for (i__ = first; i__ <= i__1; ++i__) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Get every 100'th epoch for the directory. */ - - i__1 = last; - for (i__ = first + 99; i__ <= i__1; i__ += 100) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Add the number of records, and we're done. */ - - data[0] = (doublereal) (last - first + 1); - dafada_(data, &c__1); - chkout_("SPKS01", (ftnlen)6); - return 0; -} /* spks01_ */ - diff --git a/ext/spice/src/cspice/spks02.c b/ext/spice/src/cspice/spks02.c deleted file mode 100644 index 5b6099fa7d..0000000000 --- a/ext/spice/src/cspice/spks02.c +++ /dev/null @@ -1,240 +0,0 @@ -/* spks02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure SPKS02 ( S/P Kernel, subset, type 2 ) */ -/* Subroutine */ int spks02_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - doublereal data[50]; - integer addr__, nrec; - doublereal init; - integer last, move; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer first; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_( - integer *, integer *, integer *, doublereal *); - integer remain; - doublereal intlen; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer recsiz; - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in a SPK segment of type 2 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of source segment. */ -/* BADDR I Beginning address of source segment. */ -/* EADDR I Ending address of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to a SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* the file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* The exact structure of a segment of data type 2 is detailed in */ -/* the SPK Required Reading file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK02 was removed from the Required_Reading section of the */ -/* header. The information in the SPK02 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_2 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS02", (ftnlen)6); - } - -/* The segment is made up of a number of logical records, each */ -/* having the same size, and covering the same length of time. */ - -/* We can determine which records to extract by comparing the input */ -/* epochs with the initial time of the segment and the length of the */ -/* interval covered by each record. These final two constants are */ -/* located at the end of the segment, along with the size of each */ -/* logical record and the total number of records. */ - - i__1 = *eaddr - 3; - dafgda_(handle, &i__1, eaddr, data); - init = data[0]; - intlen = data[1]; - recsiz = (integer) data[2]; - nrec = (integer) data[3]; - first = (integer) ((*begin - init) / intlen) + 1; - first = min(first,nrec); - last = (integer) ((*end - init) / intlen) + 1; - last = min(last,nrec); - -/* The number of records to be moved. */ - - nrec = last - first + 1; - -/* We're going to move the data in chunks of 50 d.p. words. Compute */ -/* the number of words left to move, the address of the beginning */ -/* of the records to move, and the number to move this time. */ - - remain = nrec * recsiz; - addr__ = *baddr + (first - 1) * recsiz; - move = min(50,remain); - while(remain > 0) { - i__1 = addr__ + move - 1; - dafgda_(handle, &addr__, &i__1, data); - dafada_(data, &move); - remain -= move; - addr__ += move; - move = min(50,remain); - } - -/* That's all the records we have to move. But there are still four */ -/* final numbers left to write: */ - -/* 1) The initial time for the polynomials (INIT). */ -/* 2) The time interval length for each polynomial (INTLEN). */ -/* 3) The record size (RECSIZ). */ -/* 4) The number of records (NREC). */ - -/* INIT and NREC will probably be different for the new segment (in */ -/* fact, NREC has already been changed), the other two will not. */ - - init += (first - 1) * intlen; - data[0] = init; - data[1] = intlen; - data[2] = (doublereal) recsiz; - data[3] = (doublereal) nrec; - dafada_(data, &c__4); - chkout_("SPKS02", (ftnlen)6); - return 0; -} /* spks02_ */ - diff --git a/ext/spice/src/cspice/spks03.c b/ext/spice/src/cspice/spks03.c deleted file mode 100644 index 72be2b5f4c..0000000000 --- a/ext/spice/src/cspice/spks03.c +++ /dev/null @@ -1,244 +0,0 @@ -/* spks03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure SPKS03 ( S/P Kernel, subset, type 3 ) */ -/* Subroutine */ int spks03_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - doublereal data[50]; - integer addr__, nrec; - doublereal init; - integer last, move; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer first; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_( - integer *, integer *, integer *, doublereal *); - integer remain; - doublereal intlen; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer recsiz; - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in a SPK segment of type 3 (Chebyshev */ -/* polynomials, position and velocity) into a new segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of source segment. */ -/* BADDR I Beginning address of source segment. */ -/* EADDR I Ending address of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to a SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* the file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See argument HANDLE. */ - -/* $ Particulars */ - -/* The exact structure of a segment of data type 3 (Chebyshev */ -/* polynomials, position and velocity) is detailed in the SPK */ -/* Required Reading file. */ - -/* On not so close inspection, it will be noted that SPKS03 is */ -/* identical to SPKS02. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* R.E. Thurman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */ - -/* SPK03 was removed from the Required_Reading section of the */ -/* header. The information in the SPK03 Required Reading file */ -/* is now part of the SPK Required Reading file. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_3 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS03", (ftnlen)6); - } - -/* The segment is made up of a number of logical records, each */ -/* having the same size, and covering the same length of time. */ - -/* We can determine which records to extract by comparing the input */ -/* epochs with the initial time of the segment and the length of the */ -/* interval covered by each record. These final two constants are */ -/* located at the end of the segment, along with the size of each */ -/* logical record and the total number of records. */ - - i__1 = *eaddr - 3; - dafgda_(handle, &i__1, eaddr, data); - init = data[0]; - intlen = data[1]; - recsiz = (integer) data[2]; - nrec = (integer) data[3]; - first = (integer) ((*begin - init) / intlen) + 1; - first = min(first,nrec); - last = (integer) ((*end - init) / intlen) + 1; - last = min(last,nrec); - -/* The number of records to be moved. */ - - nrec = last - first + 1; - -/* We're going to move the data in chunks of 50 d.p. words. Compute */ -/* the number of words left to move, the address of the beginning */ -/* of the records to move, and the number to move this time. */ - - remain = nrec * recsiz; - addr__ = *baddr + (first - 1) * recsiz; - move = min(50,remain); - while(remain > 0) { - i__1 = addr__ + move - 1; - dafgda_(handle, &addr__, &i__1, data); - dafada_(data, &move); - remain -= move; - addr__ += move; - move = min(50,remain); - } - -/* That's all the records we have to move. But there are still four */ -/* final numbers left to write: */ - -/* 1) The initial time for the polynomials (INIT). */ -/* 2) The time interval length for each polynomial (INTLEN). */ -/* 3) The record size (RECSIZ). */ -/* 4) The number of records (NREC). */ - -/* INIT and NREC will probably be different for the new segment (in */ -/* fact, NREC has already been changed), the other two will not. */ - - init += (first - 1) * intlen; - data[0] = init; - data[1] = intlen; - data[2] = (doublereal) recsiz; - data[3] = (doublereal) nrec; - dafada_(data, &c__4); - chkout_("SPKS03", (ftnlen)6); - return 0; -} /* spks03_ */ - diff --git a/ext/spice/src/cspice/spks05.c b/ext/spice/src/cspice/spks05.c deleted file mode 100644 index 882faa2c26..0000000000 --- a/ext/spice/src/cspice/spks05.c +++ /dev/null @@ -1,294 +0,0 @@ -/* spks05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKS05 ( S/P Kernel, subset, type 5 ) */ -/* Subroutine */ int spks05_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Local variables */ - doublereal data[6]; - integer offe, nrec, ndir, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *, - integer *), dafgda_(integer *, integer *, integer *, doublereal *) - ; - doublereal gm; - integer offset; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer rec[2]; - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 5 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* The first epoch for which there will be ephemeris */ -/* data in the new segment will be the greatest time */ -/* in the source segment that is less than or equal */ -/* to BEGIN. */ - -/* The last epoch for which there will be ephemeris */ -/* data in the new segment will be the smallest time */ -/* in the source segment that is greater than or equal */ -/* to END. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. */ - -/* It transfers a subset of a type 05 SPK data segment to */ -/* a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 05 is described */ -/* in the section on type 05 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_5 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS05", (ftnlen)6); - } - -/* Get the number of records in the segment. While we're at it, */ -/* get the GM of the central body as well (it's adjacent to NREC) */ -/* since we'll need it anyway. */ - - i__1 = *eaddr - 1; - dafgda_(handle, &i__1, eaddr, data); - nrec = (integer) data[1]; - gm = data[0]; - -/* From the number of records, we can compute */ - -/* NDIR The number of directory epochs. */ - -/* OFFE The offset of the first epoch. */ - - ndir = nrec / 100; - offe = *eaddr - ndir - nrec - 2; - -/* Examine the epochs in forward order, looking for the first */ -/* epoch greater than or equal to END (or the final epoch, */ -/* whichever comes first). This epoch corresponds to the last */ -/* state to be transferred. */ - - rec[1] = 1; - i__1 = offe + rec[1]; - i__2 = offe + rec[1]; - dafgda_(handle, &i__1, &i__2, data); - while(rec[1] < nrec && data[0] < *end) { - ++rec[1]; - i__1 = offe + rec[1]; - i__2 = offe + rec[1]; - dafgda_(handle, &i__1, &i__2, data); - } - -/* Now examine them in reverse order, looking for the first */ -/* epoch less than or equal to BEGIN (or the initial epoch, */ -/* whichever comes first). This epoch corresponds to the first */ -/* state to be transferred. */ - - rec[0] = nrec; - i__1 = offe + rec[0]; - i__2 = offe + rec[0]; - dafgda_(handle, &i__1, &i__2, data); - while(rec[0] > 1 && data[0] > *begin) { - --rec[0]; - i__1 = offe + rec[0]; - i__2 = offe + rec[0]; - dafgda_(handle, &i__1, &i__2, data); - } - -/* Copy states REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - offset = *baddr - 1 + (i__ - 1) * 6; - i__2 = offset + 1; - i__3 = offset + 6; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__6); - } - -/* Copy epochs REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Put every 100'th epoch into the directory. */ - - i__1 = rec[1]; - for (i__ = rec[0] + 99; i__ <= i__1; i__ += 100) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Store the GM of the central body and the number of records */ -/* to end the segment. */ - - dafada_(&gm, &c__1); - d__1 = (doublereal) (rec[1] - rec[0] + 1); - dafada_(&d__1, &c__1); - chkout_("SPKS05", (ftnlen)6); - return 0; -} /* spks05_ */ - diff --git a/ext/spice/src/cspice/spks08.c b/ext/spice/src/cspice/spks08.c deleted file mode 100644 index 46d2406177..0000000000 --- a/ext/spice/src/cspice/spks08.c +++ /dev/null @@ -1,327 +0,0 @@ -/* spks08.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKS08 ( S/P Kernel, subset, type 8 ) */ -/* Subroutine */ int spks08_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - double d_int(doublereal *); - - /* Local variables */ - doublereal data[6]; - integer nrec; - doublereal step; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal ratio, start; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_( - integer *, integer *, integer *, doublereal *); - integer degree, offset; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer rec[2]; - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 8 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* The first epoch for which there will be ephemeris */ -/* data in the new segment will be the greatest time */ -/* in the source segment that is less than or equal */ -/* to BEGIN. */ - -/* The last epoch for which there will be ephemeris */ -/* data in the new segment will be the smallest time */ -/* in the source segment that is greater than or equal */ -/* to END. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. */ - -/* It transfers a subset of a type 08 SPK data segment to */ -/* a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 08 is described */ -/* in the section on type 08 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 2.0.0, 20-AUG-1994 (NJB) */ - -/* Bug fix: START value for output segment has been corrected. */ -/* Bug fix: Sufficient bracketing states are now included in the */ -/* output segment to ensure duplication of states given by source */ -/* segment. */ - -/* - SPICELIB Version 1.0.0, 08-AUG-1993 (NJB) (JML) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_8 spk segment */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS08", (ftnlen)6); - } - -/* Look up the following items: */ - -/* -- The start epoch */ -/* -- The step size */ -/* -- The polynomial degree */ -/* -- The number of records in the segment */ - - i__1 = *eaddr - 3; - dafgda_(handle, &i__1, eaddr, data); - start = data[0]; - step = data[1]; - degree = i_dnnt(&data[2]); - nrec = i_dnnt(&data[3]); - -/* See whether there's any work to do; return immediately if not. */ - - if (*end < *begin || *end < start || *begin > start + (nrec - 1) * step) { - chkout_("SPKS08", (ftnlen)6); - return 0; - } - -/* Compute the index of the state having the last epoch */ -/* epoch less than or equal to BEGIN (or the initial epoch, */ -/* whichever comes last). This epoch corresponds to the first */ -/* state to be transferred. */ - -/* Computing MAX */ - d__1 = 0., d__2 = (*begin - start) / step; - ratio = max(d__1,d__2); -/* Computing MIN */ - i__1 = (integer) ratio, i__2 = nrec - 1; - rec[0] = min(i__1,i__2) + 1; - -/* Make sure that there are DEGREE/2 additional states to the left */ -/* of the one having index REC(1), if possible. If not, take as */ -/* many states as we can. */ - -/* Computing MAX */ - i__1 = 1, i__2 = rec[0] - degree / 2; - rec[0] = max(i__1,i__2); - -/* Make sure that REC(1) is small enough so that there are are at */ -/* least DEGREE+1 states in the segment. */ - -/* Computing MIN */ - i__1 = rec[0], i__2 = nrec - degree; - rec[0] = min(i__1,i__2); - -/* Now compute the index of the state having the first epoch greater */ -/* than or equal to END (or the final epoch, whichever comes first). */ -/* This epoch corresponds to the last state to be transferred. */ - - ratio = (*end - start) / step; - if (ratio == d_int(&ratio)) { -/* Computing MIN */ - i__1 = (integer) ratio, i__2 = nrec - 1; - rec[1] = min(i__1,i__2) + 1; - } else { -/* Computing MIN */ - i__1 = (integer) ratio + 1, i__2 = nrec - 1; - rec[1] = min(i__1,i__2) + 1; - } - -/* Make sure that there are DEGREE/2 additional states to the right */ -/* of the one having index REC(2), if possible. If not, take as */ -/* many states as we can. */ - -/* Computing MIN */ - i__1 = nrec, i__2 = rec[1] + degree / 2; - rec[1] = min(i__1,i__2); - -/* Make sure that REC(2) is large enough so that there are are at */ -/* least DEGREE+1 states in the segment. */ - -/* Computing MAX */ - i__1 = rec[1], i__2 = degree + 1; - rec[1] = max(i__1,i__2); - -/* Copy states REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - offset = *baddr - 1 + (i__ - 1) * 6; - i__2 = offset + 1; - i__3 = offset + 6; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__6); - } - -/* Store the start time, step size, polynomial degree and the */ -/* number of records to end the segment. */ - - d__1 = start + (rec[0] - 1) * step; - dafada_(&d__1, &c__1); - dafada_(&step, &c__1); - d__1 = (doublereal) degree; - dafada_(&d__1, &c__1); - d__1 = (doublereal) (rec[1] - rec[0] + 1); - dafada_(&d__1, &c__1); - chkout_("SPKS08", (ftnlen)6); - return 0; -} /* spks08_ */ - diff --git a/ext/spice/src/cspice/spks09.c b/ext/spice/src/cspice/spks09.c deleted file mode 100644 index 99527328ba..0000000000 --- a/ext/spice/src/cspice/spks09.c +++ /dev/null @@ -1,351 +0,0 @@ -/* spks09.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKS09 ( S/P Kernel, subset, type 9 ) */ -/* Subroutine */ int spks09_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - doublereal data[6]; - integer offe, nrec, ndir, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *, - integer *), dafgda_(integer *, integer *, integer *, doublereal *) - ; - integer degree, offset; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer rec[2]; - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 9 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* The first epoch for which there will be ephemeris */ -/* data in the new segment will be the greatest time */ -/* in the source segment that is less than or equal */ -/* to BEGIN. */ - -/* The last epoch for which there will be ephemeris */ -/* data in the new segment will be the smallest time */ -/* in the source segment that is greater than or equal */ -/* to END. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. */ - -/* It transfers a subset of a type 09 SPK data segment to */ -/* a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 09 is described */ -/* in the section on type 09 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 2.0.0, 27-AUG-1994 (NJB) */ - -/* Bug fix: Sufficient bracketing states are now included in the */ -/* output segment to ensure duplication of states given by source */ -/* segment. */ - -/* Test for null subset simplified. */ - -/* - SPICELIB Version 1.0.0, 08-AUG-1993 (NJB) (JML) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_9 spk segment */ - -/* -& */ -/* $ Revisions */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS09", (ftnlen)6); - } - -/* See whether there's any work to do; return immediately if not. */ - - if (*begin > *end) { - chkout_("SPKS09", (ftnlen)6); - return 0; - } - -/* Get the number of records in the segment. Get the polynomial */ -/* degree as well. */ - - i__1 = *eaddr - 1; - dafgda_(handle, &i__1, eaddr, data); - degree = i_dnnt(data); - nrec = i_dnnt(&data[1]); - -/* From the number of records, we can compute */ - -/* NDIR The number of directory epochs. */ - -/* OFFE The offset of the first epoch. */ - - ndir = (nrec - 1) / 100; - offe = *eaddr - ndir - nrec - 2; - -/* Examine the epochs in forward order, looking for the first */ -/* epoch greater than or equal to END (or the final epoch, */ -/* whichever comes first). This epoch corresponds to the last */ -/* state to be transferred. */ - - rec[1] = 1; - i__1 = offe + rec[1]; - i__2 = offe + rec[1]; - dafgda_(handle, &i__1, &i__2, data); - while(rec[1] < nrec && data[0] < *end) { - ++rec[1]; - i__1 = offe + rec[1]; - i__2 = offe + rec[1]; - dafgda_(handle, &i__1, &i__2, data); - } - -/* Make sure that there are DEGREE/2 additional states to the right */ -/* of the one having index REC(2), if possible. If not, take as */ -/* many states as we can. */ - -/* Computing MIN */ - i__1 = nrec, i__2 = rec[1] + degree / 2; - rec[1] = min(i__1,i__2); - -/* Make sure that REC(2) is large enough so that there are are at */ -/* least DEGREE+1 states in the segment. */ - -/* Computing MAX */ - i__1 = rec[1], i__2 = degree + 1; - rec[1] = max(i__1,i__2); - -/* Now examine the epochs in reverse order, looking for the first */ -/* epoch less than or equal to BEGIN (or the initial epoch, */ -/* whichever comes first). This epoch corresponds to the first */ -/* state to be transferred. */ - - rec[0] = nrec; - i__1 = offe + rec[0]; - i__2 = offe + rec[0]; - dafgda_(handle, &i__1, &i__2, data); - while(rec[0] > 1 && data[0] > *begin) { - --rec[0]; - i__1 = offe + rec[0]; - i__2 = offe + rec[0]; - dafgda_(handle, &i__1, &i__2, data); - } - -/* Make sure that there are DEGREE/2 additional states to the left */ -/* of the one having index REC(1), if possible. If not, take as */ -/* many states as we can. */ - -/* Computing MAX */ - i__1 = 1, i__2 = rec[0] - degree / 2; - rec[0] = max(i__1,i__2); - -/* Make sure that REC(1) is small enough so that there are are at */ -/* least DEGREE+1 states in the segment. */ - -/* Computing MIN */ - i__1 = rec[0], i__2 = nrec - degree; - rec[0] = min(i__1,i__2); - -/* Copy states REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - offset = *baddr - 1 + (i__ - 1) * 6; - i__2 = offset + 1; - i__3 = offset + 6; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__6); - } - -/* Copy epochs REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Put every 100'th epoch into the directory, except the last */ -/* epoch, if that epoch's index would be a multiple of 100. */ - - i__1 = rec[1] - 1; - for (i__ = rec[0] + 99; i__ <= i__1; i__ += 100) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Store the polynomial degree and the number of records */ -/* to end the segment. */ - - d__1 = (doublereal) degree; - dafada_(&d__1, &c__1); - d__1 = (doublereal) (rec[1] - rec[0] + 1); - dafada_(&d__1, &c__1); - chkout_("SPKS09", (ftnlen)6); - return 0; -} /* spks09_ */ - diff --git a/ext/spice/src/cspice/spks10.c b/ext/spice/src/cspice/spks10.c deleted file mode 100644 index a4ee07322f..0000000000 --- a/ext/spice/src/cspice/spks10.c +++ /dev/null @@ -1,664 +0,0 @@ -/* spks10.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; -static integer c__8 = 8; -static integer c__14 = 14; -static integer c__4 = 4; -static integer c__7 = 7; - -/* $Procedure SPKS10 ( S/P Kernel, subset, type 10 ) */ -/* Subroutine */ int spks10_(integer *srchan, doublereal *srcdsc, integer * - dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - char time[40]; - integer i__; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), dafus_(doublereal *, integer *, integer *, - doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen); - doublereal dtemp[2]; - logical found; - integer itemp[6]; - doublereal myref; - extern /* Subroutine */ int sgwes_(integer *); - integer dummy; - extern logical failed_(void); - integer begidx; - doublereal begtim, packet[14]; - integer endidx, nepoch; - doublereal endtim; - extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, - integer *, doublereal *), sgbwfs_(integer *, doublereal *, char *, - integer *, doublereal *, integer *, integer *, ftnlen), chkout_( - char *, ftnlen), sigerr_(char *, ftnlen), sgfrvi_(integer *, - doublereal *, doublereal *, doublereal *, integer *, logical *), - setmsg_(char *, ftnlen), sgmeta_(integer *, doublereal *, integer - *, integer *), sgfpkt_(integer *, doublereal *, integer *, - integer *, doublereal *, integer *), sgfref_(integer *, - doublereal *, integer *, integer *, doublereal *); - doublereal consts[8]; - extern /* Subroutine */ int sgwfpk_(integer *, integer *, doublereal *, - integer *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in a type 10 SPK segment into a new */ -/* type 10 segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SRCHAN I Handle of the SPK file with the source segment. */ -/* SRCDSC I Descriptor for the source segment. */ -/* DSTHAN I Handle of the SPK file for the destination segment. */ -/* DSTDSC I Descriptor for the destination segment. */ -/* DSTSID I Segment identifier for the new segment. */ - -/* $ Detailed_Input */ - -/* SRCHAN The handle of the SPK file containing the source segment. */ - -/* SRCDSC The SPK descriptor for the source segment. */ - -/* DSTHAN The handle of the SPK file containing the new segment. */ - -/* DSTDSC The SPK descriptor for the destination segment. It */ -/* contains the desired start and stop times for the */ -/* requested subset. */ - -/* DSTSID The segment identifier for the destination segment. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See arguments SRCHAN, DSTHAN. */ - -/* $ Particulars */ - -/* This subroutine copies a subset of the data form one SPK segment */ -/* to another. */ - -/* The exact structure of a segment of SPK type 10 is detailed in */ -/* the SPK Required Reading. Please see this document for details. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) We assume that the source descriptor actually describes a */ -/* segment in the source SPK file containing the time coverage */ -/* that is desired for the subsetting operation. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-JUN-1997 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_10 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* DAF ND and NI values for SPK files. */ - - -/* The number of geophysical constants: */ - - -/* The number of elements per two-line set: */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS10", (ftnlen)6); - } - -/* First, unpack the destination segment descriptor and set some */ -/* local variables. */ - - dafus_(dstdsc, &c__2, &c__6, dtemp, itemp); - begtim = dtemp[0]; - endtim = dtemp[1]; - -/* Get the constants for the input segment and send them to the */ -/* output segment by beginning a fixed packet size segment. */ - - sgfcon_(srchan, srcdsc, &c__1, &c__8, consts); - sgbwfs_(dsthan, dstdsc, dstsid, &c__8, consts, &c__14, &c__4, dstsid_len); - if (failed_()) { - chkout_("SPKS10", (ftnlen)6); - return 0; - } - -/* Get the beginning and ending indices for the packets we need for */ -/* the destination segment. Note we need to get the preceding */ -/* and succeeding packets (if there are any) corresponding to the */ -/* start and end times of the output segments */ - - sgfrvi_(srchan, srcdsc, &begtim, &myref, &begidx, &found); - if (! found) { - etcal_(&begtim, time, (ftnlen)40); - setmsg_("An error has occurred while attempting to subset the a type" - " 10 SPK segment. The error occurred while attempting to loca" - "te a packet for the epoch #. There does not appear to be su" - "ch a packet. ", (ftnlen)192); - errch_("#", time, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22); - chkout_("SPKS10", (ftnlen)6); - return 0; - } - if (myref > begtim) { -/* Computing MAX */ - i__1 = 1, i__2 = begidx - 1; - begidx = max(i__1,i__2); - } - sgfrvi_(srchan, srcdsc, &endtim, &myref, &endidx, &found); - if (! found) { - etcal_(&endtim, time, (ftnlen)40); - setmsg_("An error has occurred while attempting to subset the a type" - " 10 SPK segment. The error occurred while attempting to loca" - "te a packet for the epoch #. There does not appear to be su" - "ch a packet. ", (ftnlen)192); - errch_("#", time, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22); - chkout_("SPKS10", (ftnlen)6); - return 0; - } - -/* Get the total number of epochs. */ - - sgmeta_(srchan, srcdsc, &c__7, &nepoch); - if (myref < endtim) { -/* Computing MIN */ - i__1 = nepoch, i__2 = endidx + 1; - endidx = min(i__1,i__2); - } - -/* Now we get the data one record at a time from the source segment */ -/* and write it out to the destination segment. */ - - i__1 = endidx; - for (i__ = begidx; i__ <= i__1; ++i__) { - sgfpkt_(srchan, srcdsc, &i__, &i__, packet, &dummy); - sgfref_(srchan, srcdsc, &i__, &i__, &myref); - sgwfpk_(dsthan, &c__1, packet, &c__1, &myref); - } - -/* Now all we need to do is end the segment. */ - - sgwes_(dsthan); - chkout_("SPKS10", (ftnlen)6); - return 0; -} /* spks10_ */ - diff --git a/ext/spice/src/cspice/spks12.c b/ext/spice/src/cspice/spks12.c deleted file mode 100644 index 9a1fb716ab..0000000000 --- a/ext/spice/src/cspice/spks12.c +++ /dev/null @@ -1,183 +0,0 @@ -/* spks12.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKS12 ( S/P Kernel, subset, type 12 ) */ -/* Subroutine */ int spks12_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), spks08_(integer *, - integer *, integer *, doublereal *, doublereal *), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 12 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* The output segment will be padded to the left of */ -/* BEGIN and the right of END with sufficient states to */ -/* ensure that the segment yields an ephemeris identical */ -/* to that given by the source segment. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. */ - -/* It transfers a subset of a type 12 SPK data segment to */ -/* a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 12 is described */ -/* in the section on type 12 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-FEB-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_12 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS12", (ftnlen)6); - } - -/* The type 8 subsetter knows how to do this job. */ - - spks08_(handle, baddr, eaddr, begin, end); - chkout_("SPKS12", (ftnlen)6); - return 0; -} /* spks12_ */ - diff --git a/ext/spice/src/cspice/spks13.c b/ext/spice/src/cspice/spks13.c deleted file mode 100644 index 7d6577a7a0..0000000000 --- a/ext/spice/src/cspice/spks13.c +++ /dev/null @@ -1,183 +0,0 @@ -/* spks13.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKS13 ( S/P Kernel, subset, type 13 ) */ -/* Subroutine */ int spks13_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), spks09_(integer *, - integer *, integer *, doublereal *, doublereal *), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 13 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* The output segment will be padded to the left of */ -/* BEGIN and the right of END with sufficient states to */ -/* ensure that the segment yields an ephemeris identical */ -/* to that given by the source segment. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. */ - -/* It transfers a subset of a type 13 SPK data segment to */ -/* a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 13 is described */ -/* in the section on type 13 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-FEB-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_13 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS13", (ftnlen)6); - } - -/* The type 9 subsetter knows how to do this job. */ - - spks09_(handle, baddr, eaddr, begin, end); - chkout_("SPKS13", (ftnlen)6); - return 0; -} /* spks13_ */ - diff --git a/ext/spice/src/cspice/spks14.c b/ext/spice/src/cspice/spks14.c deleted file mode 100644 index 316ce629e4..0000000000 --- a/ext/spice/src/cspice/spks14.c +++ /dev/null @@ -1,285 +0,0 @@ -/* spks14.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure SPKS14 ( S/P Kernel, subset, type 14 ) */ -/* Subroutine */ int spks14_(integer *srchan, doublereal *srcdsc, integer * - dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer body, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *), spk14a_(integer *, - integer *, doublereal *, doublereal *), spk14b_(integer *, char * - , integer *, integer *, char *, doublereal *, doublereal *, - integer *, ftnlen, ftnlen), spk14e_(integer *); - doublereal dtemp[2]; - logical found; - integer itemp[6]; - doublereal myref; - integer dummy, chbdeg; - extern logical failed_(void); - integer begidx, iframe; - doublereal begtim; - integer endidx; - extern /* Subroutine */ int irfnam_(integer *, char *, ftnlen), sgfref_( - integer *, doublereal *, integer *, integer *, doublereal *); - doublereal endtim, record[128]; - integer center; - extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, - integer *, doublereal *); - char myfram[16]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer recsiz; - extern /* Subroutine */ int sgfrvi_(integer *, doublereal *, doublereal *, - doublereal *, integer *, logical *), sgfpkt_(integer *, - doublereal *, integer *, integer *, doublereal *, integer *), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in a type 14 SPK segment into a new */ -/* type 14 segment. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SRCHAN I Handle of the SPK file with the source segment. */ -/* SRCDSC I Descriptor for the source segment. */ -/* DSTHAN I Handle of the SPK file for the destination segment. */ -/* DSTDSC I Descriptor for the destination segment. */ -/* DSTSID I Segment identifier for the new segment. */ - -/* $ Detailed_Input */ - -/* SRCHAN The handle of the SPK file containing the source segment. */ - -/* SRCDSC The SPK descriptor for the source segment. */ - -/* DSTHAN The handle of the SPK file containing the new segment. */ - -/* DSTDSC The SPK descriptor for the destination segment. It */ -/* contains the desired start and stop times for the */ -/* requested subset. */ - -/* DSTSID The segment identifier for the destination segment. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the length of the SPK record that is to be moved is larger */ -/* than MAXREC, the error 'SPICE(SPKRECTOOLARGE)' will be */ -/* signalled. */ - -/* $ Files */ - -/* See arguments SRCHAN, DSTHAN. */ - -/* $ Particulars */ - -/* This subroutine copies a subset of the data form one SPK segment */ -/* to another. */ - -/* The exact structure of a segment of SPK type 14 is detailed in */ -/* the SPK Required Reading. Please see this document for details. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) We assume that the source descriptor actually describes a */ -/* segment in the source SPK file containing the time coverage */ -/* that is desired for the subsetting operation. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-MAR-1995 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_14 spk segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* This is the maximum size type 14 record that we can move. This */ -/* allows a 20th degree Chebyshev Polynomial, which should be more */ -/* than sufficient. This should be the same as the value in SPKPV. */ - - -/* Reference frame name size. See CHGIRF. */ - - -/* DAF ND and NI values for SPK files. */ - - -/* Length of a state. */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS14", (ftnlen)6); - } - -/* First, unpack the destination segment descriptor and set some */ -/* local variables. */ - - dafus_(dstdsc, &c__2, &c__6, dtemp, itemp); - begtim = dtemp[0]; - endtim = dtemp[1]; - body = itemp[0]; - center = itemp[1]; - iframe = itemp[2]; - irfnam_(&iframe, myfram, (ftnlen)16); - -/* If we can't find the code, it can't be an SPK file. */ - - if (failed_()) { - chkout_("SPKS14", (ftnlen)6); - return 0; - } - -/* Get the constants for this segment. There is only one. */ - - sgfcon_(srchan, srcdsc, &c__1, &c__1, dtemp); - if (failed_()) { - chkout_("SPKS14", (ftnlen)6); - return 0; - } - -/* The first element of DTEMP now contains the number of coefficients */ -/* used for the Chebyshev polynomials. We need the degree of the */ -/* polynomial which is one less than the number of coefficients. */ - - chbdeg = (integer) dtemp[0] - 1; - -/* Compute the size of the SPK record and signal an error if there is */ -/* not enough room in the variable RECORD to hold it. */ - - recsiz = (chbdeg + 1) * 6 + 2; - if (recsiz > 128) { - setmsg_("Storage for # double precision numbers is needed for an SPK" - " data record and only # locations were available. Update the" - " parameter MAXREC in the subroutine SPKS14 and notify the NA" - "IF group of this problem.", (ftnlen)204); - errint_("#", &recsiz, (ftnlen)1); - errint_("#", &c__128, (ftnlen)1); - sigerr_("SPICE(SPKRECTOOLARGE)", (ftnlen)21); - chkout_("SPKS14", (ftnlen)6); - return 0; - } - -/* Get the beginning and ending indices for the packets we need for */ -/* the destination segment. */ - - sgfrvi_(srchan, srcdsc, &begtim, &myref, &begidx, &found); - sgfrvi_(srchan, srcdsc, &endtim, &myref, &endidx, &found); - -/* Begin the destination segment. */ - - spk14b_(dsthan, dstsid, &body, ¢er, myfram, &begtim, &endtim, &chbdeg, - dstsid_len, (ftnlen)16); - if (failed_()) { - chkout_("SPKS14", (ftnlen)6); - return 0; - } - -/* Now we get the data one record at a time from the source segment */ -/* and write it out to the destination segment. */ - - i__1 = endidx; - for (i__ = begidx; i__ <= i__1; ++i__) { - sgfpkt_(srchan, srcdsc, &i__, &i__, record, &dummy); - sgfref_(srchan, srcdsc, &i__, &i__, &myref); - spk14a_(dsthan, &c__1, record, &myref); - if (failed_()) { - chkout_("SPKS14", (ftnlen)6); - return 0; - } - } - -/* Now all we need to do is end the segment. */ - - spk14e_(dsthan); - chkout_("SPKS14", (ftnlen)6); - return 0; -} /* spks14_ */ - diff --git a/ext/spice/src/cspice/spks15.c b/ext/spice/src/cspice/spks15.c deleted file mode 100644 index 0ad441d4de..0000000000 --- a/ext/spice/src/cspice/spks15.c +++ /dev/null @@ -1,205 +0,0 @@ -/* spks15.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__16 = 16; - -/* $Procedure SPKS15 ( S/P Kernel, subset, type 15 ) */ -/* Subroutine */ int spks15_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - doublereal data[16]; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *, - integer *), dafgda_(integer *, integer *, integer *, doublereal *) - , chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 15 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. It transfers a subset of a type 15 SPK data */ -/* segment to a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 15 is described */ -/* in the section on type 15 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 7-NOV-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_15 spk segment */ - -/* -& */ -/* $ Revisions */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS15", (ftnlen)6); - } - -/* See whether there's any work to do; return immediately if not. */ - - if (*begin > *end) { - chkout_("SPKS15", (ftnlen)6); - return 0; - } - -/* This couldn't be much easier. First copy the entire */ -/* type 15 segment out of the file. */ - - dafgda_(handle, baddr, eaddr, data); - -/* Now write the data into the output file. */ - - dafada_(data, &c__16); - chkout_("SPKS15", (ftnlen)6); - return 0; -} /* spks15_ */ - diff --git a/ext/spice/src/cspice/spks17.c b/ext/spice/src/cspice/spks17.c deleted file mode 100644 index 06d4ed93d3..0000000000 --- a/ext/spice/src/cspice/spks17.c +++ /dev/null @@ -1,205 +0,0 @@ -/* spks17.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__12 = 12; - -/* $Procedure SPKS17 ( S/P Kernel, subset, type 17 ) */ -/* Subroutine */ int spks17_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - doublereal data[12]; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *, - integer *), dafgda_(integer *, integer *, integer *, doublereal *) - , chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 17 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. It transfers a subset of a type 17 SPK data */ -/* segment to a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 17 is described */ -/* in the section on type 17 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 3-JAN-1997 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_17 spk segment */ - -/* -& */ -/* $ Revisions */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS17", (ftnlen)6); - } - -/* See whether there's any work to do; return immediately if not. */ - - if (*begin > *end) { - chkout_("SPKS17", (ftnlen)6); - return 0; - } - -/* This couldn't be much easier. First copy the entire */ -/* type 17 segment out of the file. */ - - dafgda_(handle, baddr, eaddr, data); - -/* Now write the data into the output file. */ - - dafada_(data, &c__12); - chkout_("SPKS17", (ftnlen)6); - return 0; -} /* spks17_ */ - diff --git a/ext/spice/src/cspice/spks18.c b/ext/spice/src/cspice/spks18.c deleted file mode 100644 index 03d06b4cc5..0000000000 --- a/ext/spice/src/cspice/spks18.c +++ /dev/null @@ -1,438 +0,0 @@ -/* spks18.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SPKS18 ( S/P Kernel, subset, type 18 ) */ -/* Subroutine */ int spks18_(integer *handle, integer *baddr, integer *eaddr, - doublereal *begin, doublereal *end) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - doublereal data[12]; - integer offe, nrec, ndir, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *, - integer *), dafgda_(integer *, integer *, integer *, doublereal *) - ; - integer wnszm1, offset, packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer subtyp, rec[2]; - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment of type 18 */ -/* into a new segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to SPK type 18. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */ - -/* -& */ - -/* SPK type 18 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 12-element packets, order */ -/* reduction at boundaries to preceding number */ -/* equivalent to 3 mod 4. */ - - -/* Subtype 1: Lagrange interpolation, 6-element packets, order */ -/* reduction at boundaries to preceding odd number. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of include file spk18.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of file containing source segment. */ -/* BADDR I Beginning address in file of source segment. */ -/* EADDR I Ending address in file of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* BADDR, */ -/* EADDR are the file handle assigned to an SPK file, and the */ -/* beginning and ending addresses of a segment within */ -/* that file. Together they determine a complete set of */ -/* ephemeris data, from which a subset is to be */ -/* extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* The first epoch for which there will be ephemeris */ -/* data in the new segment will be the greatest time */ -/* in the source segment that is less than or equal */ -/* to BEGIN. */ - -/* The last epoch for which there will be ephemeris */ -/* data in the new segment will be the smallest time */ -/* in the source segment that is greater than or equal */ -/* to END. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine relies on the caller to ensure that the */ -/* interval [BEGIN, END] is contained in the coverage */ -/* interval of the segment. */ - -/* 2) If BEGIN > END, no data is written to the target file. */ - -/* 3) If a unexpected SPK type 18 subtype is found in the input */ -/* segment, the error SPICE(INVALIDVALUE) is signaled. */ - -/* $ Files */ - -/* Data is extracted from the file connected to the input */ -/* handle, and written to the current DAF open for writing. */ - -/* The segment descriptor and summary must already have been written */ -/* prior to calling this routine. The segment must be ended */ -/* external to this routine. */ - -/* $ Particulars */ - -/* This routine is intended solely for use as a utility by the */ -/* routine SPKSUB. */ - -/* It transfers a subset of a type 18 SPK data segment to */ -/* a properly initialized segment of a second SPK file. */ - -/* The exact structure of a segment of data type 18 is described */ -/* in the section on type 18 in the SPK Required Reading. */ - -/* $ Examples */ - -/* This routine is intended only for use as a utility by SPKSUB. */ -/* To use this routine successfully, you must: */ - -/* Open the SPK file from which to extract data. */ -/* Locate the segment from which data should be extracted. */ - -/* Open the SPK file to which this data should be written. */ -/* Begin a new segment (array). */ -/* Write the summary information for the array. */ - -/* Call this routine to extract the appropriate data from the */ -/* SPK open for read. */ - -/* End the array to which this routine writes data. */ - -/* Much of this procedure is carried out by the routine SPKSUB. The */ -/* examples of that routine illustrate more fully the process */ -/* described above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset type_18 spk segment */ - -/* -& */ -/* $ Revisions */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKS18", (ftnlen)6); - } - -/* See whether there's any work to do; return immediately if not. */ - - if (*begin > *end) { - chkout_("SPKS18", (ftnlen)6); - return 0; - } - -/* Read the segment structure metadata. */ - -/* Get the type 18 segment subtype. Next get the quantity "window */ -/* size minus one." This quantity plays the same role as does the */ -/* polynomial degree for the type 9 subsetter. Also get the number */ -/* of records in the segment. */ - - i__1 = *eaddr - 2; - dafgda_(handle, &i__1, eaddr, data); - subtyp = i_dnnt(data); - wnszm1 = i_dnnt(&data[1]); - nrec = i_dnnt(&data[2]); - -/* Set the packet size based on the subtype. */ - - if (subtyp == 0) { - packsz = 12; - } else if (subtyp == 1) { - packsz = 6; - } else { - setmsg_("Unexpected SPK type 18 subtype found in type 18 record.", ( - ftnlen)55); - errint_("#", &subtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKS18", (ftnlen)6); - return 0; - } - -/* From the number of records, we can compute */ - -/* NDIR The number of directory epochs. */ - -/* OFFE The offset of the first epoch. */ - - ndir = (nrec - 1) / 100; - offe = *eaddr - ndir - nrec - 3; - -/* Examine the epochs in forward order, looking for the first */ -/* epoch greater than or equal to END (or the final epoch, */ -/* whichever comes first). This epoch corresponds to the last */ -/* state to be transferred. */ - - rec[1] = 1; - i__1 = offe + rec[1]; - i__2 = offe + rec[1]; - dafgda_(handle, &i__1, &i__2, data); - while(rec[1] < nrec && data[0] < *end) { - ++rec[1]; - i__1 = offe + rec[1]; - i__2 = offe + rec[1]; - dafgda_(handle, &i__1, &i__2, data); - } - -/* Make sure that there are WNSZM1/2 additional states to the right */ -/* of the one having index REC(2), if possible. If not, take as */ -/* many states as we can. */ - -/* Computing MIN */ - i__1 = nrec, i__2 = rec[1] + wnszm1 / 2; - rec[1] = min(i__1,i__2); - -/* Make sure that REC(2) is large enough so that there are are at */ -/* least WNSZM1+1 states in the segment. */ - -/* Computing MAX */ - i__1 = rec[1], i__2 = wnszm1 + 1; - rec[1] = max(i__1,i__2); - -/* Now examine the epochs in reverse order, looking for the first */ -/* epoch less than or equal to BEGIN (or the initial epoch, */ -/* whichever comes first). This epoch corresponds to the first */ -/* state to be transferred. */ - - rec[0] = nrec; - i__1 = offe + rec[0]; - i__2 = offe + rec[0]; - dafgda_(handle, &i__1, &i__2, data); - while(rec[0] > 1 && data[0] > *begin) { - --rec[0]; - i__1 = offe + rec[0]; - i__2 = offe + rec[0]; - dafgda_(handle, &i__1, &i__2, data); - } - -/* Make sure that there are WNSZM1/2 additional states to the left */ -/* of the one having index REC(1), if possible. If not, take as */ -/* many states as we can. */ - -/* Computing MAX */ - i__1 = 1, i__2 = rec[0] - wnszm1 / 2; - rec[0] = max(i__1,i__2); - -/* Make sure that REC(1) is small enough so that there are are at */ -/* least WNSZM1+1 states in the segment. */ - -/* Computing MIN */ - i__1 = rec[0], i__2 = nrec - wnszm1; - rec[0] = min(i__1,i__2); - -/* Copy states REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - offset = *baddr - 1 + (i__ - 1) * packsz; - i__2 = offset + 1; - i__3 = offset + packsz; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &packsz); - } - -/* Copy epochs REC(1) through REC(2) to the output file. */ - - i__1 = rec[1]; - for (i__ = rec[0]; i__ <= i__1; ++i__) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Put every 100'th epoch into the directory, except the last */ -/* epoch, if that epoch's index would be a multiple of 100. */ - - i__1 = rec[1] - 1; - for (i__ = rec[0] + 99; i__ <= i__1; i__ += 100) { - i__2 = offe + i__; - i__3 = offe + i__; - dafgda_(handle, &i__2, &i__3, data); - dafada_(data, &c__1); - } - -/* Store subtype, the window size minus one and the number of */ -/* records to end the segment. */ - - d__1 = (doublereal) subtyp; - dafada_(&d__1, &c__1); - d__1 = (doublereal) wnszm1; - dafada_(&d__1, &c__1); - d__1 = (doublereal) (rec[1] - rec[0] + 1); - dafada_(&d__1, &c__1); - chkout_("SPKS18", (ftnlen)6); - return 0; -} /* spks18_ */ - diff --git a/ext/spice/src/cspice/spkssb.c b/ext/spice/src/cspice/spkssb.c deleted file mode 100644 index 01e66219d4..0000000000 --- a/ext/spice/src/cspice/spkssb.c +++ /dev/null @@ -1,220 +0,0 @@ -/* spkssb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SPKSSB ( S/P Kernel, solar system barycenter ) */ -/* Subroutine */ int spkssb_(integer *targ, doublereal *et, char *ref, - doublereal *starg, ftnlen ref_len) -{ - integer bary; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal lt; - extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to the solar system barycenter. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* STARG O State of target. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to which the */ -/* vectors returned by the routine should be rotated. */ -/* This may be any frame supported by the SPICELIB frame */ -/* system, including dynamic and other non-inertial */ -/* frames. */ - -/* $ Detailed_Output */ - -/* STARG contains the position and velocity of the target */ -/* body, relative to the solar system barycenter, */ -/* at epoch ET. These vectors are rotated into the */ -/* specified reference frame. Units are always */ -/* km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient information has not bee "loaded" via the */ -/* routine SPKLEF or the PCK kernel loaders, the problem will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* In order to compute the state of one body relative to another, */ -/* the states of the two bodies must be known relative to a third */ -/* body. One simple solution is to use the solar system barycenter */ -/* as the third body. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the state of a body relative to the barycenter. */ -/* SPKSSB reads as many segments as necessary, from as many */ -/* files as necessary, using files that have been loaded by */ -/* previous calls to SPKLEF (load ephemeris file). */ - -/* $ Examples */ - -/* In the following code fragment, SPKSSB is used to display */ -/* the distance from Earth (Body 399) to Mars (body 499) at */ -/* a series of epochs. */ - -/* CALL SPKLEF ( 'DE125.SPK', HANDLE ) */ -/* . */ -/* . */ - -/* EARTH = 399 */ -/* MARS = 499 */ - -/* DO WHILE ( EPOCH .LE. END ) */ -/* CALL SPKSSB ( EARTH, EPOCH, 'J2000', SEARTH ) */ -/* CALL SPKSSB ( MARS, EPOCH, 'J2000', SMARS ) */ - -/* CALL VSUB ( SMARS, SEARTH, SMARS ) */ -/* WRITE (*,*) EPOCH, VNORM ( SMARS ) */ - -/* EPOCH = EPOCH + DELTA */ -/* END DO */ - -/* $ Restrictions */ - -/* 1) The ephemeris files to be used by SPKSSB must be loaded */ -/* by SPKLEF before SPKSSB is called. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.3, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 2.0.2, 20-NOV-2004 (NJB) */ - -/* Updated description of input argument REF to indicate all */ -/* frames supported by SPICELIB are allowed. */ - -/* - SPICELIB Version 2.0.1, 24-JUN-1999 (WLT) */ - -/* Corrected code in Examples section of the headers */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was simplified by replacing all of the */ -/* main body of code with a call to SPKGEO. By making */ -/* this change the routine now supports non-inertial frames. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* state relative to solar system barycenter */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was simplified by replacing all of the */ -/* main body of code with a call to SPKGEO. By making */ -/* this change the routine now supports non-inertial frames. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKSSB", (ftnlen)6); - } - bary = 0; - spkgeo_(targ, et, ref, &bary, starg, <, ref_len); - chkout_("SPKSSB", (ftnlen)6); - return 0; -} /* spkssb_ */ - diff --git a/ext/spice/src/cspice/spkssb_c.c b/ext/spice/src/cspice/spkssb_c.c deleted file mode 100644 index a482e77cff..0000000000 --- a/ext/spice/src/cspice/spkssb_c.c +++ /dev/null @@ -1,213 +0,0 @@ -/* - --Procedure spkssb_c ( S/P Kernel, solar system barycenter ) - --Abstract - - Return the state (position and velocity) of a target body - relative to the solar system barycenter. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void spkssb_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceDouble starg[6] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - targ I Target body. - et I Target epoch. - ref I Target reference frame. - starg O State of target. - --Detailed_Input - - targ is the standard NAIF ID code for a target body. - - et is the epoch (ephemeris time) at which the state of the - target body is to be computed. - - ref is the name of the reference frame to which the vectors - returned by the routine should be rotated. This may be - any frame supported by the CSPICE frame system, - including dynamic and other non-inertial frames. - --Detailed_Output - - starg contains the position and velocity of the target body, - relative to the solar system barycenter, at epoch 'et'. - These vectors are rotated into the specified reference - frame. Units are always km and km/sec. - --Parameters - - None. - --Exceptions - - 1) If sufficient information has not been "loaded" via the - routine spklef_c or the PCK kernel loaders, the problem will - be diagnosed by a routine in the call tree of this routine. - - 2) The error SPICE(EMPTYSTRING) is signaled if the input - string 'ref' does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 3) The error SPICE(NULLPOINTER) is signaled if the input string - pointer 'ref' is null. - --Files - - See: Restrictions. - --Particulars - - In order to compute the state of one body relative to another, - the states of the two bodies must be known relative to a third - body. One simple solution is to use the solar system barycenter - as the third body. - - Ephemeris data from more than one segment may be required - to determine the state of a body relative to the barycenter. - spkssb_c reads as many segments as necessary, from as many - files as necessary, using files that have been loaded by - previous calls to spklef_c (load ephemeris file). - --Examples - - In the following code fragment, spkssb_c is used to display - the distance from Earth (Body 399) to Mars (body 499) at - a series of epochs. - - #include - #include "SpiceUsr.h" - - - #define EARTH 399 - #define MARS 499 - . - . - . - spklef_c ( "DE125.SPK", &handle ); - . - . - . - - while ( epoch <= end ) - { - spkssb_c ( EARTH, epoch, "J2000", searth ); - spkssb_c ( MARS, epoch, "J2000", smars ); - - printf ( "%f %22.15e\n", epoch, vdist_c( searth, smars ) ); - - epoch += delta; - } - - --Restrictions - - 1) The ephemeris files to be used by spkssb_c must be loaded - by spklef_c before spkssb_c is called. - --Literature_References - - NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and - User's Guide" - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.2, 20-NOV-2004 (NJB) - - Updated description of input argument `ref' to indicate all - frames supported by CSPICE are allowed. - - -CSPICE Version 1.0.1, 14-OCT-2003 (EDW) - - Various minor corrections to the header. - - -CSPICE Version 1.0.0, 23-JUN-1999 (NJB) (WLT) (IMU) - --Index_Entries - - state relative to solar system barycenter - --& -*/ - -{ /* Begin spkssb_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkssb_c" ); - - - /* - Check the input string 'ref' to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkssb_c", ref ); - - - spkssb_ ( ( integer * ) &targ, - ( doublereal * ) &et, - ( char * ) ref, - ( doublereal * ) starg, - ( ftnlen ) strlen(ref) ); - - - chkout_c ( "spkssb_c" ); - -} /* End spkssb_c */ diff --git a/ext/spice/src/cspice/spksub.c b/ext/spice/src/cspice/spksub.c deleted file mode 100644 index f21eaca546..0000000000 --- a/ext/spice/src/cspice/spksub.c +++ /dev/null @@ -1,408 +0,0 @@ -/* spksub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKSUB ( S/P Kernel, subset ) */ -/* Subroutine */ int spksub_(integer *handle, doublereal *descr, char *ident, - doublereal *begin, doublereal *end, integer *newh, ftnlen ident_len) -{ - logical okay; - integer type__, baddr, eaddr; - doublereal alpha, omega; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *), dafus_( - doublereal *, integer *, integer *, doublereal *, integer *); - doublereal ndscr[5]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), spks01_( - integer *, integer *, integer *, doublereal *, doublereal *), - spks02_(integer *, integer *, integer *, doublereal *, doublereal - *), spks03_(integer *, integer *, integer *, doublereal *, - doublereal *), spks10_(integer *, doublereal *, integer *, - doublereal *, char *, ftnlen), spks05_(integer *, integer *, - integer *, doublereal *, doublereal *), spks12_(integer *, - integer *, integer *, doublereal *, doublereal *), spks13_( - integer *, integer *, integer *, doublereal *, doublereal *), - spks08_(integer *, integer *, integer *, doublereal *, doublereal - *), spks09_(integer *, integer *, integer *, doublereal *, - doublereal *), spks14_(integer *, doublereal *, integer *, - doublereal *, char *, ftnlen), spks15_(integer *, integer *, - integer *, doublereal *, doublereal *), spks17_(integer *, - integer *, integer *, doublereal *, doublereal *), spks18_( - integer *, integer *, integer *, doublereal *, doublereal *); - doublereal dc[2]; - extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, - ftnlen); - integer ic[6]; - extern /* Subroutine */ int dafena_(void), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract a subset of the data in an SPK segment into a */ -/* separate segment. */ - -/* $ 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 */ - -/* SPK */ -/* DAF */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of source segment. */ -/* DESCR I Descriptor of source segment. */ -/* IDENT I Identifier of source segment. */ -/* BEGIN I Beginning (initial epoch) of subset. */ -/* END I End (final epoch) of subset. */ -/* NEWH I Handle of new segment. */ - -/* $ Detailed_Input */ - -/* HANDLE, */ -/* DESCR, */ -/* IDENT are the file handle assigned to a SPK file, the */ -/* descriptor for a segment within the file, and the */ -/* identifier for that segment. Together they determine */ -/* a complete set of ephemeris data, from which a */ -/* subset is to be extracted. */ - -/* BEGIN, */ -/* END are the initial and final epochs (ephemeris time) */ -/* of the subset. */ - -/* NEWH is the file handle assigned to the file in which */ -/* the new segment is to be written. The file must */ -/* be open for write access. NEWH and HANDLE may refer */ -/* to the same file. */ - -/* $ Detailed_Output */ - -/* See $Files section. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the condition */ - -/* ALPHA < BEGIN < END < OMEGA */ -/* - - - */ - -/* is not satisfied (where ALPHA and OMEGA are the initial */ -/* and final epochs of the segment respectively), the error */ -/* 'SPICE(SPKNOTASUBSET)' is signalled. */ - -/* 2) If the segment type is not supported by the current */ -/* version of SPKSUB, the error 'SPICE(SPKTYPENOTSUPP)' */ -/* is signalled. */ - -/* $ Files */ - -/* A new segment, which contains a subset of the data in the */ -/* segment specified by DESCR and HANDLE, is written to the SPK */ -/* file attached to NEWH. */ - -/* $ Particulars */ - -/* Sometimes, the segments in official source files---planetary */ -/* Developmental Ephemeris (DE) files, archival spacecraft */ -/* ephemeris files, and so on---contain more data than is needed */ -/* by a particular user. SPKSUB allows a user to extract from a */ -/* segment the smallest amount of ephemeris data sufficient to */ -/* cover a specific interval. */ - -/* The new segment is written with the same identifier as the */ -/* original segment, and with the same descriptor, with the */ -/* following components changed: */ - -/* 1) ALPHA and OMEGA (DCD(1) and DCD(2)) are assigned the values */ -/* specified by BEGIN and END. */ - -/* 2) The beginning and ending segment addresses (ICD(5) and ICD(6)) */ -/* are, of course, changed to reflect the location of the new */ -/* segment. */ - -/* $ Examples */ - -/* In the following code fragment, the descriptor for each segment */ -/* in a source SPK file is examined. For each segment that covers */ -/* a target interval, the smallest possible subset is extracted into */ -/* a custom SPK file. */ - -/* Assume that the source and custom files have been opened, for */ -/* read and write access, with handles SRC and CUST respectively. */ - -/* CALL DAFBFS ( SRC ) */ -/* CALL DAFFNA ( FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* CALL DAFGS ( DESCR ) */ -/* CALL DAFUS ( DESCR, 2, 6, DC, IC ) */ - -/* IF ( DC(1) .LE. BEGIN .AND. END .LE. DC(2) ) THEN */ -/* CALL DAFGN ( IDENT ) */ -/* CALL SPKSUB ( SRC, DESCR, IDENT, BEGIN, END, CUST ) */ -/* END IF */ - -/* CALL DAFFNA ( FOUND ) */ -/* END DO */ - - -/* $ Restrictions */ - -/* 1) There is no way for SPKSUB to verify that the descriptor and */ -/* identifier are the original ones for the segment. Changing */ -/* the descriptor can cause the data in the new segment to be */ -/* evaluated incorrectly; changing the identifier can destroy */ -/* the path from the data back to its original source. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* R.E. Thurman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 8.0.0, 12-AUG-2002 (NJB) */ - -/* The routine was updated to handle type 18. */ - -/* - SPICELIB Version 7.0.0, 06-NOV-1999 (NJB) */ - -/* The routine was updated to handle types 12 and 13. */ - -/* - SPICELIB Version 6.0.0, 30-JUN-1997 (WLT) */ - -/* The routine was updated to handle types 10 and 17. */ - -/* - SPICELIB Version 5.0.0, 10-MAR-1995 (KRG) */ - -/* The routine was updated to handle type 14. */ - -/* - SPICELIB Version 4.0.0, 07-NOV-1994 (WLT) */ - -/* The routine was updated to handle type 15. */ - -/* - SPICELIB Version 3.0.0, 05-AUG-1993 (NJB) */ - -/* The routine was updated to handle types 08 and 09. */ - -/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */ - -/* 1) The routine was updated to handle type 05. */ - -/* 2) DESCR was being used as both an input and output */ -/* variable when it was only supposed to be used for */ -/* input. A new local variable, NDSCR, was added where DESCR */ -/* was being altered. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (RET) */ - -/* -& */ -/* $ Index_Entries */ - -/* subset of spk file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 8.0.0, 12-AUG-2002 (NJB) */ - -/* The routine was updated to handle type 18. */ - -/* - SPICELIB Version 6.0.0, 30-JUN-1997 (WLT) */ - -/* The routine was updated to handle types 10 and 17. */ - -/* - SPICELIB Version 5.0.0, 10-MAR-1995 (KRG) */ - -/* The routine was updated to handle type 14. */ - -/* - SPICELIB Version 4.0.0, 07-NOV-1994 (WLT) */ - -/* The routine was updated to handle type 15. */ - -/* - SPICELIB Version 3.0.0, 05-AUG-1993 (NJB) */ - -/* The routine was updated to handle types 08 and 09. */ - -/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */ - -/* 1) The routine was updated to handle type 05. */ - -/* 2) DESCR was being used as both an input and output */ -/* variable when it was only supposed to be used for */ -/* input. A new local variable, NDSCR, was added where DESCR */ -/* was being altered. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKSUB", (ftnlen)6); - } - -/* Unpack the descriptor. */ - - dafus_(descr, &c__2, &c__6, dc, ic); - alpha = dc[0]; - omega = dc[1]; - type__ = ic[3]; - baddr = ic[4]; - eaddr = ic[5]; - -/* Make sure the epochs check out. */ - - okay = alpha <= *begin && *begin <= *end && *end <= omega; - if (! okay) { - setmsg_("Specified interval [#, #] is not a subset of segment interv" - "al [#, #].", (ftnlen)69); - errdp_("#", begin, (ftnlen)1); - errdp_("#", end, (ftnlen)1); - errdp_("#", &alpha, (ftnlen)1); - errdp_("#", &omega, (ftnlen)1); - sigerr_("SPICE(SPKNOTASUBSET)", (ftnlen)20); - chkout_("SPKSUB", (ftnlen)6); - return 0; - } - -/* Begin the new segment, with a descriptor containing the subset */ -/* epochs. */ - - dc[0] = *begin; - dc[1] = *end; - dafps_(&c__2, &c__6, dc, ic, ndscr); - -/* Let the type-specific (SPKSnn) routines decide what to move. */ - - if (type__ == 1) { - dafbna_(newh, ndscr, ident, ident_len); - spks01_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 2) { - dafbna_(newh, ndscr, ident, ident_len); - spks02_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 3) { - dafbna_(newh, ndscr, ident, ident_len); - spks03_(handle, &baddr, &eaddr, begin, end); - dafena_(); - -/* Type 04 has not been yet been added to SPICELIB. */ - -/* ELSE IF ( TYPE .EQ. 04 ) THEN */ -/* CALL DAFBNA ( NEWH, NDSCR, IDENT ) */ -/* CALL SPKS04 ( HANDLE, BADDR, EADDR, BEGIN, END ) */ -/* CALL DAFENA */ - } else if (type__ == 5) { - dafbna_(newh, ndscr, ident, ident_len); - spks05_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 8) { - dafbna_(newh, ndscr, ident, ident_len); - spks08_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 9) { - dafbna_(newh, ndscr, ident, ident_len); - spks09_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 10) { - spks10_(handle, descr, newh, ndscr, ident, ident_len); - } else if (type__ == 12) { - dafbna_(newh, ndscr, ident, ident_len); - spks12_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 13) { - dafbna_(newh, ndscr, ident, ident_len); - spks13_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 14) { - spks14_(handle, descr, newh, ndscr, ident, ident_len); - } else if (type__ == 15) { - dafbna_(newh, ndscr, ident, ident_len); - spks15_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 17) { - dafbna_(newh, ndscr, ident, ident_len); - spks17_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else if (type__ == 18) { - dafbna_(newh, ndscr, ident, ident_len); - spks18_(handle, &baddr, &eaddr, begin, end); - dafena_(); - } else { - setmsg_("SPK data type # is not supported.", (ftnlen)33); - errint_("#", &type__, (ftnlen)1); - sigerr_("SPICE(SPKTYPENOTSUPP)", (ftnlen)21); - chkout_("SPKSUB", (ftnlen)6); - return 0; - } - chkout_("SPKSUB", (ftnlen)6); - return 0; -} /* spksub_ */ - diff --git a/ext/spice/src/cspice/spksub_c.c b/ext/spice/src/cspice/spksub_c.c deleted file mode 100644 index 1c1763b9f3..0000000000 --- a/ext/spice/src/cspice/spksub_c.c +++ /dev/null @@ -1,236 +0,0 @@ -/* - --Procedure spksub_c ( S/P Kernel, subset ) - --Abstract - - Extract a subset of the data in an SPK segment into a - separate segment. - --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 - - SPK - DAF - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void spksub_c ( SpiceInt handle, - SpiceDouble descr[5], - ConstSpiceChar * ident, - SpiceDouble begin, - SpiceDouble end, - SpiceInt newh ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of source segment. - descr I Descriptor of source segment. - ident I Identifier of source segment. - begin I Beginning (initial epoch) of subset. - end I End (final epoch) of subset. - newh I Handle of new segment. - --Detailed_Input - - handle, - descr, - ident are the file handle assigned to a SPK file, the - descriptor for a segment within the file, and the - identifier for that segment. Together they determine - a complete set of ephemeris data, from which a - subset is to be extracted. - - begin, - end are the initial and final epochs (ephemeris time) - of the subset. - - newh is the file handle assigned to the file in which - the new segment is to be written. The file must - be open for write access. newh and handle may refer - to the same file. - --Detailed_Output - - See $Files section. - --Parameters - - None. - --Exceptions - - 1) If the condition - - ALPHA < BEGIN < END < OMEGA - - - - - - is not satisfied (where ALPHA and OMEGA are the initial - and final epochs of the segment respectively), the error - SPICE(SPKNOTASUBSET) is signaled. - - 2) If the segment type is not supported by the current - version of spksub_c, the error SPICE(SPKTYPENOTSUPP) - is signaled. - - 3) If the segment ID string pointer is null, the error - SPICE(NULLPOINTER) is signaled. - - 4) If the segment ID string is empty, the error - SPICE(EMPTYSTRING) is signaled. - --Files - - A new segment, which contains a subset of the data in the - segment specified by DESCR and HANDLE, is written to the SPK - file attached to NEWH. - --Particulars - - Sometimes, the segments in official source files---planetary - Developmental Ephemeris (DE) files, archival spacecraft - ephemeris files, and so on---contain more data than is needed - by a particular user. spksub_c allows a user to extract from a - segment the smallest amount of ephemeris data sufficient to - cover a specific interval. - - The new segment is written with the same identifier as the - original segment, and with the same descriptor, with the - following components changed: - - 1) ALPHA and OMEGA (DCD(1) and DCD(2)) are assigned the values - specified by BEGIN and END. - - 2) The beginning and ending segment addresses (ICD(5) and ICD(6)) - are, of course, changed to reflect the location of the new - segment. - --Examples - - In the following code fragment, the descriptor for each segment - in a source SPK file is examined. For each segment that covers - a target interval, the smallest possible subset is extracted into - a custom SPK file. - - Assume that the source and custom files have been opened, for - read and write access, with handles srchan and custhan respectively. - - #include "SpiceUsr.h" - . - . - . - dafbfs_c ( srchan ); - daffna_c ( &found ); - - while ( found ) - { - dafgs_c ( descr ); - dafus_c ( descr, 2, 6, dc, ic ); - - if ( ( dc[0] <= begin ) && ( end <= dc[1] ) ) - { - dafgn_c ( ident ); - spksub_c ( srchan, descr, ident, begin, end, custhan ); - } - - daffna_c ( &found ); - } - - --Restrictions - - 1) There is no way for spksub_c to verify that the descriptor and - identifier are the original ones for the segment. Changing - the descriptor can cause the data in the new segment to be - evaluated incorrectly; changing the identifier can destroy - the path from the data back to its original source. - --Literature_References - - NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and - User's Guide" - --Author_and_Institution - - K.R. Gehringer (JPL) - W.L. Taber (JPL) - N.J. Bachman (JPL) - J.M. Lynch (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 (KRG)(WLT)(NJB)(JML)(RET)(IMU) - --Index_Entries - - subset of spk file - --& -*/ - -{ /* Begin spksub_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spksub_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spksub_c", ident ); - - - spksub_ ( ( integer * ) &handle, - ( doublereal * ) descr, - ( char * ) ident, - ( doublereal * ) &begin, - ( doublereal * ) &end, - ( integer * ) &newh, - ( ftnlen ) strlen(ident) ); - - - chkout_c ( "spksub_c" ); - -} /* End spksub_c */ diff --git a/ext/spice/src/cspice/spkuds.c b/ext/spice/src/cspice/spkuds.c deleted file mode 100644 index 7db418186f..0000000000 --- a/ext/spice/src/cspice/spkuds.c +++ /dev/null @@ -1,212 +0,0 @@ -/* spkuds.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure SPKUDS ( SPK - unpack segment descriptor ) */ -/* Subroutine */ int spkuds_(doublereal *descr, integer *body, integer * - center, integer *frame, integer *type__, doublereal *first, - doublereal *last, integer *begin, integer *end) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, - integer *, integer *, doublereal *, integer *); - integer ipart[6]; - extern logical failed_(void); - doublereal dppart[2]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Unpack the contents of an SPK segment descriptor */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DESCR I An SPK segment descriptor. */ -/* BODY O The NAIF ID code for the body of the segment. */ -/* CENTER O The center of motion for BODY. */ -/* FRAME O The code for the frame of this segment. */ -/* TYPE O The type of SPK segment. */ -/* FIRST O The first epoch for which the segment is valid. */ -/* LAST O The last epoch for which the segment is valid. */ -/* BEGIN O Beginning DAF address of the segment. */ -/* END O Ending DAF address of the segment. */ - -/* $ Detailed_Input */ - -/* DESCR is an SPK segment descriptor. */ - -/* $ Detailed_Output */ - -/* BODY is the NAIF ID code for the body of the segment. */ - -/* CENTER is the center of motion for BODY. */ - -/* FRAME is SPICE integer code for the frame to which states */ -/* for the body are be referenced. */ - -/* TYPE is the type of SPK segment. */ - -/* FIRST is the first epoch for which the segment has */ -/* ephemeris data. */ - -/* LAST is the last epoch for which the segment has */ -/* ephemeris data. */ - -/* BEGIN is the starting address of the data associated */ -/* with this descriptor */ - -/* END is the last address of the data associated with */ -/* this descriptor */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine extracts the contents of an SPK segment */ -/* descriptor into the components needed for reading and */ -/* evaluating the data stored in the segment. It serves */ -/* as a macro for expanding the SPK segment descriptor. */ - -/* $ Examples */ - -/* Suppose you wished to summarize a particular SPK segment */ -/* and that you have the descriptor for that segment in hand. */ -/* The following code fragment shows how you might use this */ -/* routine to create a summary message concerning the segment. */ - -/* CALL SPKUDS ( DESCR, BODY, CENTER, FRAME, */ -/* . TYPE, FIRST, LAST, BADDR, EADDR ) */ - -/* Convert the start and stop times to ephemeris calendar strings */ - -/* CALL ETCAL ( FIRST, FSTCAL ) */ -/* CALL ETCAL ( LAST, LSTCAL ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Body : ', BODY */ -/* WRITE (*,*) 'Center : ', CENTER */ -/* WRITE (*,*) 'Frame ID : ', FRAME */ -/* WRITE (*,*) 'Data Type: ', TYPE */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Segment Start : ', FSTCAL */ -/* WRITE (*,*) 'Segment Stop : ', LSTCAL */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 1994-JAN-4 (WLT) (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* Unpack and SPK segment descriptor */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - -/* Values of ND and NI for SPK files. */ - - -/* Local Variables */ - - -/* Standard introductory error handling preparations. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKUDS", (ftnlen)6); - } - -/* No judgements are made about the descriptor when we */ -/* unpack it. If things were done right when the descriptor */ -/* was created, it should be fine now. */ - - dafus_(descr, &c__2, &c__6, dppart, ipart); - if (failed_()) { - chkout_("SPKUDS", (ftnlen)6); - return 0; - } - *body = ipart[0]; - *center = ipart[1]; - *frame = ipart[2]; - *type__ = ipart[3]; - *begin = ipart[4]; - *end = ipart[5]; - *first = dppart[0]; - *last = dppart[1]; - chkout_("SPKUDS", (ftnlen)6); - return 0; -} /* spkuds_ */ - diff --git a/ext/spice/src/cspice/spkuds_c.c b/ext/spice/src/cspice/spkuds_c.c deleted file mode 100644 index 6114a75ea8..0000000000 --- a/ext/spice/src/cspice/spkuds_c.c +++ /dev/null @@ -1,215 +0,0 @@ -/* - --Procedure spkuds_c ( SPK - unpack segment descriptor ) - --Abstract - - Unpack the contents of an SPK segment descriptor - --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 - - SPK - --Keywords - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef spkuds_c - - - void spkuds_c ( ConstSpiceDouble descr [5], - SpiceInt * body, - SpiceInt * center, - SpiceInt * frame, - SpiceInt * type, - SpiceDouble * first, - SpiceDouble * last, - SpiceInt * begin, - SpiceInt * end ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - descr I An SPK segment descriptor. - body O The NAIF ID code for the body of the segment. - center O The center of motion for body. - frame O The ID code for the frame of this segment. - type O The type of SPK segment. - first O The first epoch for which the segment is valid. - last O The last epoch for which the segment is valid. - begin O Beginning DAF address of the segment. - end O Ending DAF address of the segment. - --Detailed_Input - - descr is an SPK segment descriptor. - --Detailed_Output - - body is the NAIF ID code for the body of the segment. - - center is the center of motion for body. - - frame is the SPICE integer code for the frame to which states - for the body are be referenced. - - type is the type of SPK segment. - - first is the first epoch for which the segment has - ephemeris data. - - last is the last epoch for which the segment has - ephemeris data. - - begin is the starting address of the data associated - with this descriptor. - - end is the last address of the data associated with - this descriptor. - --Parameters - - None. - --Particulars - - This routine extracts the contents of an SPK segment - descriptor into the components needed for reading and - evaluating the data stored in the segment. It serves - as a macro for expanding the SPK segment descriptor. - --Examples - - Suppose you wished to summarize a particular SPK segment - and that you have the descriptor for that segment in hand. - The following code fragment shows how you might use this - routine to create a summary message concerning the segment. - - #include - #include "SpiceUsr.h" - - #define TIMLEN 35 - . - . - . - - spkuds_c ( descr, &body, ¢er, &frame, - . &type, &first, &last, &baddr, &eaddr ); - - /. - Convert the start and stop times to TDB calendar strings. - ./ - etcal_c ( first, TIMLEN, fstcal ); - etcal_c ( last, TIMLEN, lstcal ); - - printf ( "\n" - "Body : %d\n" - "Center : %d\n" - "Frame ID : %d\n" - "Data Type: %d\n" - "\n" - "Segment Start : %s\n" - "Segment Stop : %s\n", - body, - center, - frame, - type, - fstcal, - lstcal ); - - --Restrictions - - None. - --Exceptions - - None. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - K.R. Gehringer (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 24-JUL-2001 (NJB) - - Changed protoype: input descr is now type (ConstSpiceDouble *). - Implemented interface macro for casting input descr to const. - - -CSPICE Version 1.0.0, 22-JUL-1999 (NJB) (WLT) (KRG) - --Index_Entries - - Unpack and SPK segment descriptor - --& -*/ - -{ /* Begin spkuds_c */ - - - /* - Participate in error tracing. - */ - - chkin_c ( "spkuds_c" ); - - - spkuds_ ( ( doublereal * ) descr, - ( integer * ) body, - ( integer * ) center, - ( integer * ) frame, - ( integer * ) type, - ( doublereal * ) first, - ( doublereal * ) last, - ( integer * ) begin, - ( integer * ) end ); - - - chkout_c ( "spkuds_c" ); - -} /* End spkuds_c */ - diff --git a/ext/spice/src/cspice/spkuef_c.c b/ext/spice/src/cspice/spkuef_c.c deleted file mode 100644 index d83ced1124..0000000000 --- a/ext/spice/src/cspice/spkuef_c.c +++ /dev/null @@ -1,149 +0,0 @@ -/* - --Procedure spkuef_c ( S/P Kernel, Unload ephemeris file ) - --Abstract - - Unload an ephemeris file so that it will no longer be searched by - the readers. - --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 - - SPK - --Keywords - - EPHEMERIS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - - void spkuef_c ( SpiceInt handle ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of file to be unloaded - --Detailed_Input - - handle Integer handle assigned to the file upon loading. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - The file referred to by handle is unloaded. - --Particulars - - A file is removed from consideration by the readers by a call to - spkuef_c. - - The file table entry corresponding to the file referenced by - handle, is removed. Also any segment table entry which came from - the specified file is also deleted. - - If the file specified by handle does not appear in the file table, - nothing happens. - --Examples - - - // Unload the kernel file assigned to hand.. - spkuef_c ( hand1 ); - - Also see the Example in spkbsr.for. - --Restrictions - - None. - --Literature_References - - NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and - User's Guide" - --Author_and_Institution - - J.M. Lynch (JPL) - R.E. Thurman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 02-JUL-2003 (EDW) - - Corrected trivial typo in the Version 1.0.0 line. - The typo caused an integrity check script to fail. - - -CSPICE Version 1.0.0, 19-OCT-1997 (EDW) - --Index_Entries - - unload spk ephemeris file - --& -*/ - -{ /* Begin spkuef_c */ - - /* - Participate in error handling - */ - chkin_c( "spkuef_c"); - - - /* - Call the f2c'd Fortran routine. - */ - spkuef_ ( &handle ); - - - chkout_c( "spkuef_c"); - -} /* end spkuef_c */ - diff --git a/ext/spice/src/cspice/spkw01.c b/ext/spice/src/cspice/spkw01.c deleted file mode 100644 index a0161fd37a..0000000000 --- a/ext/spice/src/cspice/spkw01.c +++ /dev/null @@ -1,451 +0,0 @@ -/* spkw01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SPKW01 ( Write SPK segment, type 1 ) */ -/* Subroutine */ int spkw01_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - integer *n, doublereal *dlines, doublereal *epochs, ftnlen frame_len, - ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *), dafbna_(integer *, doublereal *, char *, ftnlen), - dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal maxtim; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), spkpds_(integer *, integer *, char *, integer - *, doublereal *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Write a type 1 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I NAIF code for an ephemeris object. */ -/* CENTER I NAIF code for center of motion of BODY. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* N I Number of difference lines in segment. */ -/* DLINES I Array of difference lines. */ -/* EPOCHS I Coverage end times of difference lines. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose state relative to another body is described */ -/* by the segment to be created. */ - -/* CENTER is the NAIF integer code for the center of motion */ -/* of the object identified by BODY. */ - -/* FRAME is the NAIF name for a reference frame relative to */ -/* which the state information for BODY is specified. */ -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the state of BODY. */ - -/* SEGID is the segment identifier. An SPK segment */ -/* identifier may contain up to 40 characters. */ - -/* N is the number of difference lines in the input */ -/* difference line array. */ - -/* DLINES contains a time-ordered array of difference lines */ -/* The Ith difference line occupies elements (1,I) */ -/* through (71,I) of DLINES. Each difference line */ -/* represents the state (x, y, z, dx/dt, dy/dt, */ -/* dz/dt, in kilometers and kilometers per second) */ -/* of BODY relative to CENTER, specified relative to */ -/* FRAME, for an interval of time. The time interval */ -/* covered by the Ith difference line ends at the */ -/* Ith element of the array EPOCHS (described below). */ -/* The interval covered by the first difference line */ -/* starts at the segment start time. */ - -/* The contents of a difference line are as shown */ -/* below: */ - -/* Dimension Description */ -/* --------- ---------------------------------- */ -/* 1 Reference epoch of difference line */ -/* 15 Stepsize function vector */ -/* 1 Reference position vector, x */ -/* 1 Reference velocity vector, x */ -/* 1 Reference position vector, y */ -/* 1 Reference velocity vector, y */ -/* 1 Reference position vector, z */ -/* 1 Reference velocity vector, z */ -/* 15,3 Modified divided difference */ -/* arrays (MDAs) */ -/* 1 Maximum integration order plus 1 */ -/* 3 Integration order array */ - -/* The reference position and velocity are those of */ -/* BODY relative to CENTER at the reference epoch. */ -/* (A difference line is essentially a polynomial */ -/* expansion of acceleration about the reference */ -/* epoch.) */ - - -/* EPOCHS is an array of epochs corresponding to the members */ -/* of the state array. The epochs are specified as */ -/* seconds past J2000, TDB. */ - -/* The first difference line covers the time interval */ -/* from the segment start time to EPOCHS(1). For */ -/* I > 1, the Ith difference line covers the half-open */ -/* time interval from, but not including, EPOCHS(I-1) */ -/* through EPOCHS(I). */ - -/* The elements of EPOCHS must be strictly increasing. */ - - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If FRAME is not a recognized name, the error */ -/* SPICE(INVALIDREFFRAME) is signaled. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signaled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signaled. */ - -/* 4) If the number of difference lines N is not at least one, */ -/* the error SPICE(INVALIDCOUNT) will be signaled. */ - -/* 5) If FIRST is greater than or equal to LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 6) If the elements of the array EPOCHS are not in strictly */ -/* increasing order, the error SPICE(TIMESOUTOFORDER) will be */ -/* signaled. */ - -/* 7) If the last epoch EPOCHS(N) is less than LAST, the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* $ Files */ - -/* A new type 1 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 1 data segment to the open SPK */ -/* file according to the format described in the type 1 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have difference lines and are prepared to */ -/* produce a segment of type 1 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_1_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW01 ( HANDLE, BODY, CENTER, FRAME, */ -/* . FIRST, LAST, SEGID, N, */ -/* . DLINES, EPOCHS ) */ - -/* $ Restrictions */ - -/* 1) The validity of the difference lines is not checked by */ -/* this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 07-APR-2010 (NJB) */ - -/* Updated Detailed_Input to state that the elements */ -/* of EPOCHS must be strictly increasing. The Exceptions */ -/* section already described this error condition. */ - -/* - SPICELIB Version 1.0.0, 30-JAN-2003 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_1 ephemeris data segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW01", (ftnlen)6); - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW01", (ftnlen)6); - return 0; - } - -/* Check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW01", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW01", (ftnlen)6); - return 0; - } - } - -/* The difference line count must be at least one. */ - - if (*n < 1) { - setmsg_("The difference line count was #; the count must be at least" - " one.", (ftnlen)64); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("SPKW01", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first >= *last) { - setmsg_("The segment start time: # is greater then the segment end t" - "ime: #", (ftnlen)65); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW01", (ftnlen)6); - return 0; - } - -/* Make sure the epochs form a strictly increasing sequence. */ - - maxtim = epochs[0]; - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - if (epochs[i__ - 1] <= maxtim) { - setmsg_("EPOCH # having index # is not greater than its predeces" - "sor #.", (ftnlen)61); - errdp_("#", &epochs[i__ - 1], (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &epochs[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("SPKW01", (ftnlen)6); - return 0; - } else { - maxtim = epochs[i__ - 1]; - } - } - -/* Make sure there's no gap between the last difference line */ -/* epoch and the end of the time interval defined by the segment */ -/* descriptor. */ - - if (epochs[*n - 1] < *last) { - setmsg_("Segment end time # follows last epoch #.", (ftnlen)40); - errdp_("#", last, (ftnlen)1); - errdp_("#", &epochs[*n - 1], (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW01", (ftnlen)6); - return 0; - } - -/* If we made it this far, we're ready to start writing the segment. */ - - -/* Create the segment descriptor. */ - - spkpds_(body, center, frame, &c__1, first, last, descr, frame_len); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW01", (ftnlen)6); - return 0; - } - -/* The type 1 segment structure is shown below: */ - -/* +-----------------------+ */ -/* | Difference line 1 | */ -/* +-----------------------+ */ -/* | Difference line 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Difference line N | */ -/* +-----------------------+ */ -/* | Epoch 1 | */ -/* +-----------------------+ */ -/* | Epoch 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch N | */ -/* +-----------------------+ */ -/* | Epoch 100 | (First directory) */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch (N/100)*100 | (Last directory) */ -/* +-----------------------+ */ -/* | Number of diff lines | */ -/* +-----------------------+ */ - - - i__1 = *n * 71; - dafada_(dlines, &i__1); - dafada_(epochs, n); - i__1 = *n / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&epochs[i__ * 100 - 1], &c__1); - } - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW01", (ftnlen)6); - return 0; -} /* spkw01_ */ - diff --git a/ext/spice/src/cspice/spkw02.c b/ext/spice/src/cspice/spkw02.c deleted file mode 100644 index 076c02e189..0000000000 --- a/ext/spice/src/cspice/spkw02.c +++ /dev/null @@ -1,490 +0,0 @@ -/* spkw02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__40 = 40; -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKW02 ( Write SPK segment, type 2 ) */ -/* Subroutine */ int spkw02_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, - doublereal *btime, ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, k; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), dafps_(integer *, integer *, doublereal *, - integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal ltime; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal rsize; - char etstr[40]; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( - integer *, doublereal *, char *, ftnlen), dafena_(void); - extern logical failed_(void); - extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, - ftnlen); - integer refcod, ninrec; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - doublereal radius, numrec; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - char netstr[40]; - doublereal dcd[2]; - integer icd[6]; - doublereal mid; - -/* $ Abstract */ - -/* Write a type 2 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of SPK file open for writing. */ -/* BODY I NAIF code for ephemeris object. */ -/* CENTER I NAIF code for the center of motion of the body. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* INTLEN I Length of time covered by logical record. */ -/* N I Number of logical records in segment. */ -/* POLYDG I Chebyshev polynomial degree. */ -/* CDATA I Array of Chebyshev coefficients. */ -/* BTIME I Begin time of first logical record. */ - -/* $ Detailed_Input */ - -/* HANDLE DAF handle of an SPK file to which a type 2 segment */ -/* is to be added. The SPK file must be open for */ -/* writing. */ - -/* BODY NAIF integer code for an ephemeris object whose */ -/* state relative to another body is described by the */ -/* segment to be created. */ - -/* CENTER NAIF integer code for the center of motion of the */ -/* object identified by BODY. */ - -/* FRAME NAIF name for a reference frame relative to which */ -/* the state information for BODY is specified. */ - -/* FIRST, */ -/* LAST Start and stop times of the time interval over */ -/* which the segment defines the state of body. */ - -/* SEGID Segment identifier. An SPK segment identifier may */ -/* contain up to 40 characters. */ - -/* INTLEN Length of time, in seconds, covered by each set of */ -/* Chebyshev polynomial coefficients (each logical */ -/* record). Each set of Chebyshev coefficients must */ -/* cover this fixed time interval, INTLEN. */ - -/* N Number of sets of Chebyshev polynomial coefficients */ -/* for coordinates (number of logical records) to be */ -/* stored in the segment. There is one set of */ -/* Chebyshev coefficients for each time period. */ - -/* POLYDG Degree of each set of Chebyshev polynomials, i.e. */ -/* the number of Chebyshev coefficients per coordinate */ -/* minus one. */ - -/* CDATA Array containing all the sets of Chebyshev */ -/* polynomial coefficients to be placed in the */ -/* segment of the SPK file. The coefficients are */ -/* stored in CDATA in order as follows: */ - -/* the (degree + 1) coefficients for the first */ -/* coordinate of the first logical record */ - -/* the coefficients for the second coordinate */ - -/* the coefficients for the third coordinate */ - -/* the coefficients for the first coordinate for */ -/* the second logical record, ... */ - -/* and so on. */ - - -/* BTIME Begin time (seconds past J2000 TDB) of first set */ -/* of Chebyshev polynomial coefficients (first */ -/* logical record). FIRST is an appropriate value */ -/* for BTIME. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of sets of coefficients is not positive */ -/* 'SPICE(NUMCOEFFSNOTPOS)' is signalled. */ - -/* 2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */ -/* is signalled. */ - -/* 3) If the name of the reference frame is not recognized, */ -/* 'SPICE(INVALIDREFFRAME)' is signalled. */ - -/* 4) If segment stop time is not greater then the begin time, */ -/* 'SPICE(BADDESCRTIMES)' is signalled. */ - -/* 5) If the start time of the first record is not less than */ -/* or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */ -/* is signalled. */ - -/* 6) If the end time of the last record is not greater than */ -/* or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */ -/* signalled. */ - -/* $ Files */ - -/* A new type 2 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 2 data segment to the designated */ -/* SPK file, according to the format described in the SPK Required */ -/* Reading. */ - -/* Each segment can contain data for only one target, central body, */ -/* and reference frame. The Chebyshev polynomial degree and length */ -/* of time covered by each logical record are also fixed. However, */ -/* an arbitrary number of logical records of Chebyshev polynomial */ -/* coefficients can be written in each segment. Minimizing the */ -/* number of segments in an SPK file will help optimize how the SPICE */ -/* system accesses the file. */ - -/* $ Examples */ - -/* Suppose that you have sets of Chebyshev polynomial coefficients */ -/* in an array CDATA pertaining to the position of the moon (NAIF ID */ -/* = 301), relative to the Earth-moon barycenter (NAIF ID = 3), in */ -/* the J2000 reference frame, and want to put these into a type 2 */ -/* segment in an existing SPK file. The following code could be used */ -/* to add one new type 2 segment. To add multiple segments, put the */ -/* call to SPKW02 in a loop. */ - -/* C */ -/* C First open the SPK file and get a handle for it. */ -/* C */ -/* CALL DAFOPW ( SPKNAM, HANDLE ) */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_2_SEGMENT' */ - -/* C */ -/* C Write the segment. */ - -/* CALL SPKW02 ( HANDLE, 301, 3, 'J2000', */ -/* . FIRST, LAST, SEGID, INTLEN, */ -/* . N, POLYDG, CDATA, BTIME ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DAFCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 30-OCT-2006 (BVS) */ - -/* Removed restriction that the input reference frame should be */ -/* inertial by changing the routine that determins the frame ID */ -/* from the name from IRFNUM to NAMFRM. */ - -/* - SPICELIB Version 1.0.1, 24-AUG-1998 (EDW) */ - -/* Changed a 2 to 2.D0 for a double precision computation. Added */ -/* some comments to the header. Corrected spelling mistakes. */ - -/* - SPICELIB Version 1.0.0, 1-AUG-1995 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_2 data segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* DTYPE is the SPK data type. */ - - -/* ND is the number of double precision components in an SPK */ -/* segment descriptor. SPK uses ND = 2. */ - - -/* NI is the number of integer components in an SPK segment */ -/* descriptor. SPK uses NI = 6. */ - - -/* NS is the size of a packed SPK segment descriptor. */ - - -/* SIDLEN is the maximum number of characters allowed in an */ -/* SPK segment identifier. */ - - -/* Local variables */ - - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW02", (ftnlen)6); - } - -/* The number of sets of coefficients must be positive. */ - - if (*n <= 0) { - setmsg_("The number of sets of coordinatecoefficients is not positiv" - "e. N = #", (ftnlen)67); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22); - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* The interval length must be positive. */ - - if (*intlen <= 0.) { - setmsg_("The interval length is not positive.N = #", (ftnlen)41); - errdp_("#", intlen, (ftnlen)1); - sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19); - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* The segment stop time must be greater than the begin time. */ - - if (*first > *last) { - setmsg_("The segment start time: # is greater than the segment end t" - "ime: #", (ftnlen)65); - etcal_(first, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(last, netstr, (ftnlen)40); - errch_("#", netstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* The begin time of the first record must be less than or equal */ -/* to the begin time of the segment. */ - - if (*first < *btime) { - setmsg_("The segment descriptor start time: # is less than the begin" - "ning time of the segment data: #", (ftnlen)91); - etcal_(first, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(btime, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* The end time of the final record must be greater than or */ -/* equal to the end time of the segment. */ - - ltime = *btime + *n * *intlen; - if (*last > ltime) { - setmsg_("The segment descriptor end time: # is greater than the end " - "time of the segment data: #", (ftnlen)86); - etcal_(last, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(<ime, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* Now check the validity of the segment identifier. */ - - chckid_("SPK segment identifier", &c__40, segid, (ftnlen)22, segid_len); - if (failed_()) { - chkout_("SPKW02", (ftnlen)6); - return 0; - } - -/* Store the start and end times to be associated */ -/* with this segment. */ - - dcd[0] = *first; - dcd[1] = *last; - -/* Create the integer portion of the descriptor. */ - - icd[0] = *body; - icd[1] = *center; - icd[2] = refcod; - icd[3] = 2; - -/* Pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Begin a new segment of SPK type 2 form: */ - -/* Record 1 */ -/* Record 2 */ -/* ... */ -/* Record N */ -/* INIT ( initial epoch of first record ) */ -/* INTLEN ( length of interval covered by each record ) */ -/* RSIZE ( number of data elements in each record ) */ -/* N ( number of records in segment ) */ - -/* Each record will have the form: */ - -/* MID ( midpoint of time interval ) */ -/* RADIUS ( radius of time interval ) */ -/* X coefficients, Y coefficients, Z coefficients */ - - dafbna_(handle, descr, segid, segid_len); - -/* Calculate the number of entries in a record. */ - - ninrec = (*polydg + 1) * 3; - -/* Fill segment with N records of data. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the midpoint and radius of the time of each */ -/* record, and put that at the beginning of each record. */ - - radius = *intlen / 2.; - mid = *btime + radius + (i__ - 1) * *intlen; - dafada_(&mid, &c__1); - dafada_(&radius, &c__1); - -/* Put one set of coefficients into segment. */ - - k = (i__ - 1) * ninrec + 1; - dafada_(&cdata[k - 1], &ninrec); - } - -/* Store the initial epoch of the first record. */ - - dafada_(btime, &c__1); - -/* Store the length of interval covered by each record. */ - - dafada_(intlen, &c__1); - -/* Store the size of each record (total number of array elements). */ - - rsize = (doublereal) (ninrec + 2); - dafada_(&rsize, &c__1); - -/* Store the number of records contained in the segment. */ - - numrec = (doublereal) (*n); - dafada_(&numrec, &c__1); - -/* End this segment. */ - - dafena_(); - -/* We're done. Checkout of error trace. */ - - chkout_("SPKW02", (ftnlen)6); - return 0; -} /* spkw02_ */ - diff --git a/ext/spice/src/cspice/spkw02_c.c b/ext/spice/src/cspice/spkw02_c.c deleted file mode 100644 index a03499a4e2..0000000000 --- a/ext/spice/src/cspice/spkw02_c.c +++ /dev/null @@ -1,301 +0,0 @@ -/* - --Procedure spkw02_c ( Write SPK segment, type 2 ) - --Abstract - - Write a type 2 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw02_c - - - void spkw02_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I Body code for ephemeris object. - center I Body code for the center of motion of the body. - frame I The reference frame of the states. - first I First valid time for which states can be computed. - last I Last valid time for which states can be computed. - segid I Segment identifier. - intlen I Length of time covered by logical record. - n I Number of coefficient sets. - polydg I Chebyshev polynomial degree. - cdata I Array of Chebyshev coefficients. - btime I Begin time of first logical record. - --Detailed_Input - - handle DAF handle of an SPK file to which a type 2 segment - is to be added. The SPK file must be open for - writing. - - body NAIF integer code for an ephemeris object whose - state relative to another body is described by the - segment to be created. - - center NAIF integer code for the center of motion of the - object identified by body. - - frame NAIF name for a reference frame relative to which - the state information for body is specified. - - first, - last Start and stop times of the time interval over - which the segment defines the state of body. - - segid Segment identifier. An SPK segment identifier may - contain up to 40 characters. - - intlen Length of time, in seconds, covered by each set of - Chebyshev polynomial coefficients (each logical - record). Each set of Chebyshev coefficients must - cover this fixed time interval, intlen. - - n Number of sets of Chebyshev polynomial coefficients - for coordinates (number of logical records) to be - stored in the segment. There is one set of - Chebyshev coefficients for each time period. - - polydg Degree of each set of Chebyshev polynomials, i.e. - the number of Chebyshev coefficients per coordinate - minus one. - - cdata Array containing all the sets of Chebyshev - polynomial coefficients to be placed in the - segment of the SPK file. The coefficients are - stored in cdata in order as follows: - - the (degree + 1) coefficients for the first - coordinate of the first logical record - - the coefficients for the second coordinate - - the coefficients for the third coordinate - - the coefficients for the first coordinate for - the second logical record, ... - - and so on. - - - btime Begin time (seconds past J2000 TDB) of first set - of Chebyshev polynomial coefficients (first - logical record). first is an appropriate value - for btime. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the number of sets of coefficients is not positive - SPICE(NUMCOEFFSNOTPOS) is signalled. - - 2) If the interval length is not positive, SPICE(INTLENNOTPOS) - is signalled. - - 3) If the integer code for the reference frame is not recognized, - SPICE(INVALIDREFFRAME) is signalled. - - 4) If segment stop time is not greater then the begin time, - SPICE(BADDESCRTIMES) is signalled. - - 5) If the start time of the first record is not less than - or equal to the descriptor begin time, SPICE(BADDESCRTIMES) - is signalled. - - 6) If the end time of the last record is not greater than - or equal to the descriptor end time, SPICE(BADDESCRTIMES) is - signalled. - - 7) The error SPICE(EMPTYSTRING) is signaled if either input - string does not contain at least one character, since the - input strings cannot be converted to a Fortran-style string - in this case. - - 8) The error SPICE(NULLPOINTER) is signaled if either input string - pointer is null. - --Files - - A new type 2 SPK segment is written to the SPK file attached - to handle. - --Particulars - - This routine writes an SPK type 2 data segment to the designated - SPK file, according to the format described in the SPK Required - Reading. - - Each segment can contain data for only one target, central body, - and reference frame. The Chebyshev polynomial degree and length - of time covered by each logical record are also fixed. However, - an arbitrary number of logical records of Chebyshev polynomial - coefficients can be written in each segment. Minimizing the - number of segments in an SPK file will help optimize how the SPICE - system accesses the file. - --Examples - - Suppose that you have sets of Chebyshev polynomial coefficients - in an array CDATA pertaining to the position of the moon (NAIF ID - = 301), relative to the Earth-moon barycenter (NAIF ID = 3), in - the J2000 reference frame, and want to put these into a type 2 - segment in an existing SPK file. The following code could be used - to add one new type 2 segment. To add multiple segments, put the - call to spkw02_c in a loop. - - #include "SpiceUsr.h" - . - . - . - - /. - First open the SPK file and get a handle for it. - ./ - spkopa_c ( spknam, &handle ); - - /. - Create a segment identifier. - ./ - segid = "MY_SAMPLE_SPK_TYPE_2_SEGMENT"; - - /. - Write the segment. - ./ - spkw02_c ( handle, 301, 3, "J2000", - first, last, segid, intlen, - n, polydg, cdata, btime ); - - /. - Close the file. - ./ - spkcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.S. Zukor (JPL) - --Version - - -CSPICE Version 1.0.0, 21-JUL-1999 (NJB) (KSZ) - --Index_Entries - - write spk type_2 data segment - --& -*/ - -{ /* Begin spkw02_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "spkw02_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw02_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw02_c", segid ); - - - /* - Write the segment. - */ - - spkw02_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( doublereal * ) &intlen, - ( integer * ) &n, - ( integer * ) &polydg, - ( doublereal * ) cdata, - ( doublereal * ) &btime, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw02_c" ); - -} /* End spkw02_c */ diff --git a/ext/spice/src/cspice/spkw03.c b/ext/spice/src/cspice/spkw03.c deleted file mode 100644 index cc95689e44..0000000000 --- a/ext/spice/src/cspice/spkw03.c +++ /dev/null @@ -1,494 +0,0 @@ -/* spkw03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__40 = 40; -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKW03 ( Write SPK segment, type 3 ) */ -/* Subroutine */ int spkw03_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, - doublereal *btime, ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, k; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), dafps_(integer *, integer *, doublereal *, - integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal ltime; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal rsize; - char etstr[40]; - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( - integer *, doublereal *, char *, ftnlen), dafena_(void); - extern logical failed_(void); - extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, - ftnlen); - integer refcod, ninrec; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - doublereal radius, numrec; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - char netstr[40]; - doublereal dcd[2]; - integer icd[6]; - doublereal mid; - -/* $ Abstract */ - -/* Write a type 3 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of SPK file open for writing. */ -/* BODY I NAIF code for ephemeris object. */ -/* CENTER I NAIF code for the center of motion of the body. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* INTLEN I Length of time covered by record. */ -/* N I Number of records in segment. */ -/* POLYDG I Chebyshev polynomial degree. */ -/* CDATA I Array of Chebyshev coefficients. */ -/* BTIME I Begin time of first record. */ - -/* $ Detailed_Input */ - -/* HANDLE DAF handle of an SPK file to which a type 3 segment */ -/* is to be added. The SPK file must be open for */ -/* writing. */ - -/* BODY NAIF integer code for an ephemeris object whose */ -/* state relative to another body is described by the */ -/* segment to be created. */ - -/* CENTER NAIF integer code for the center of motion of the */ -/* object identified by BODY. */ - -/* FRAME NAIF name for a reference frame relative to which */ -/* the state information for BODY is specified. */ - -/* FIRST, */ -/* LAST Start and stop times of the time interval over */ -/* which the segment defines the state of body. */ - -/* SEGID Segment identifier. An SPK segment identifier may */ -/* contain up to 40 characters. */ - -/* INTLEN Length of time, in seconds, covered by each set of */ -/* Chebyshev polynomial coefficients (each logical */ -/* record). Each set of Chebyshev coefficents must */ -/* cover this fixed time interval, INTLEN. */ - -/* N Number of sets of Chebyshev polynomial coefficients */ -/* for coordinates and their derivatives (number of */ -/* logical records) to be stored in the segment. */ -/* There is one set of Chebyshev coefficients for each */ -/* time period. */ - -/* POLYDG Degree of each set of Chebyshev polynomials. */ - -/* CDATA Array containing all the sets of Chebyshev */ -/* polynomial coefficients to be placed in the */ -/* segment of the SPK file. The coefficients are */ -/* stored in CDATA in order as follows: */ - -/* the (degree + 1) coefficients for the first */ -/* coordinate of the first logical record */ - -/* the coefficients for the second coordinate */ - -/* the coefficients for the third coordinate */ - -/* the coefficients for the derivative of the first */ -/* coordinate */ - -/* the coefficients for the derivative of the */ -/* second coordinate */ - -/* the coefficients for the derivative of the third */ -/* coordinate */ - -/* the coefficients for the first coordinate for */ -/* the second logical record, ... */ - -/* and so on. */ - - -/* BTIME Begin time (seconds past J2000 TDB) of first set */ -/* of Chebyshev polynomial coefficients (first */ -/* logical record). */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of sets of coefficients is not positive */ -/* 'SPICE(NUMCOEFFSNOTPOS)' is signalled. */ - -/* 2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */ -/* is signalled. */ - -/* 3) If the name of the reference frame is not recognized, */ -/* 'SPICE(INVALIDREFFRAME)' is signalled. */ - -/* 4) If segment stop time is not greater then the begin time, */ -/* 'SPICE(BADDESCRTIMES)' is signalled. */ - -/* 5) If the start time of the first record is not less than */ -/* or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */ -/* is signalled. */ - -/* 6) If the end time of the last record is not greater than */ -/* or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */ -/* signalled. */ - -/* $ Files */ - -/* A new type 3 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 3 data segment to the designated */ -/* SPK file, according to the format described in the SPK Required */ -/* Reading. */ - -/* Each segment can contain data for only one target, central body, */ -/* and reference frame. The Chebyshev polynomial degree and length */ -/* of time covered by each logical record are also fixed. However, */ -/* an arbitrary number of logical records of Chebyshev polynomial */ -/* coefficients can be written in each segment. Minimizing the */ -/* number of segments in an SPK file will help optimize how the SPICE */ -/* system accesses the file. */ - -/* $ Examples */ - -/* Suppose that you have sets of Chebyshev polynomial coefficients */ -/* in an array CDATA pertaining to the position of the moon (NAIF ID */ -/* = 301), relative to the Earth-moon barycenter (NAIF ID = 3), in */ -/* the J2000 reference frame, and want to put these into a type 2 */ -/* segment in an existing SPK file. The following code could be used */ -/* to add one new type 2 segment. To add multiple segments, put the */ -/* call to SPKW02 in a loop. */ - -/* C */ -/* C First open the SPK file and get a handle for it. */ -/* C */ -/* CALL DAFOPW ( SPKNAM, HANDLE ) */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_3_SEGMENT' */ - -/* C */ -/* C Write the segment. */ - -/* SUBROUTINE SPKW03 ( HANDLE, 301, 3, 'J2000', */ -/* . FIRST, LAST, SEGID, INTLEN, */ -/* . N, POLYDG, CDATA, BTIME ) */ - -/* C */ -/* C Close the file. */ -/* C */ -/* CALL DAFCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 30-OCT-2006 (BVS) */ - -/* Removed restriction that the input reference frame should be */ -/* inertial by changing the routine that determins the frame ID */ -/* from the name from IRFNUM to NAMFRM. */ - -/* - SPICELIB Version 1.0.1, 19-SEP-2006 (EDW) */ - -/* Corrected typo in the section name ("Example" to "Examples"). */ - -/* - SPICELIB Version 1.0.0, 01-AUG-1995 (KSZ) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_3 data segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - -/* DTYPE is the SPK data type. */ - - -/* ND is the number of double precision components in an SPK */ -/* segment descriptor. SPK uses ND = 2. */ - - -/* NI is the number of integer components in an SPK segment */ -/* descriptor. SPK uses NI = 6. */ - - -/* NS is the size of a packed SPK segment descriptor. */ - - -/* SIDLEN is the maximum number of characters allowed in an */ -/* SPK segment identifier. */ - - -/* Local variables */ - - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW03", (ftnlen)6); - } - -/* The number of sets of coefficients must be positive. */ - - if (*n <= 0) { - setmsg_("The number of sets of coordinatecoeffcients is not positive" - ". N = #", (ftnlen)66); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22); - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* The interval length must be positive. */ - - if (*intlen <= 0.) { - setmsg_("The interval length is not positive.N = #", (ftnlen)41); - errdp_("#", intlen, (ftnlen)1); - sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19); - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* The segment stop time must be greater than the begin time. */ - - if (*first > *last) { - setmsg_("The segment descriptor start time: # is greater than the se" - "gment end time: #", (ftnlen)76); - etcal_(first, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(last, netstr, (ftnlen)40); - errch_("#", netstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* The begin time of the first record must be less than or equal */ -/* to the begin time of the segment. */ - - if (*first < *btime) { - setmsg_("The segment descriptor start time: # is less than the begin" - "ning time of the segment data: #", (ftnlen)91); - etcal_(first, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(btime, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* The end time of the final record must be greater than or */ -/* equal to the end time of the segment. */ - - ltime = *btime + *n * *intlen; - if (*last > ltime) { - setmsg_("The segment descriptor end time: # is greater than the end " - "time of the segmentdata: #", (ftnlen)85); - etcal_(last, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - etcal_(<ime, etstr, (ftnlen)40); - errch_("#", etstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* Now check the validity of the segment identifier. */ - - chckid_("SPK segment identifier", &c__40, segid, (ftnlen)22, segid_len); - if (failed_()) { - chkout_("SPKW03", (ftnlen)6); - return 0; - } - -/* Store the start and end times to be associated */ -/* with this segment. */ - - dcd[0] = *first; - dcd[1] = *last; - -/* Create the integer portion of the descriptor. */ - - icd[0] = *body; - icd[1] = *center; - icd[2] = refcod; - icd[3] = 3; - -/* Pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Begin a new segment of SPK type 3 form: */ - -/* Record 1 */ -/* Record 2 */ -/* ... */ -/* Record N */ -/* INIT ( initial epoch of first record ) */ -/* INTLEN ( length of interval covered by each record ) */ -/* RSIZE ( number of data elements in each record ) */ -/* N ( number of records in segment ) */ - -/* Each record will have the form: */ - -/* MID ( midpoint of time interval ) */ -/* RADIUS ( radius of time interval ) */ -/* X coefficients, Y coefficients, Z coefficients */ -/* X' coefficients, Y' coefficents, Z' coefficients */ - - dafbna_(handle, descr, segid, segid_len); - -/* Calculate the number of Chebyshev coefficients in a record. */ - - ninrec = (*polydg + 1) * 6; - -/* Fill segment with N records of data. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the midpoint and radius of the time of each */ -/* record, and put that at the beginning of each record. */ - - radius = *intlen / 2; - mid = *btime + radius + (i__ - 1) * *intlen; - dafada_(&mid, &c__1); - dafada_(&radius, &c__1); - -/* Put one set of coefficients into the segment. */ - - k = (i__ - 1) * ninrec + 1; - dafada_(&cdata[k - 1], &ninrec); - } - -/* Store the initial epoch of the first record. */ - - dafada_(btime, &c__1); - -/* Store the length of interval covered by each record. */ - - dafada_(intlen, &c__1); - -/* Store the size of each record (total number of array elements). */ - - rsize = (doublereal) (ninrec + 2); - dafada_(&rsize, &c__1); - -/* Store the number of records contained in the segment. */ - - numrec = (doublereal) (*n); - dafada_(&numrec, &c__1); - -/* End this segment. */ - - dafena_(); - chkout_("SPKW03", (ftnlen)6); - return 0; -} /* spkw03_ */ - diff --git a/ext/spice/src/cspice/spkw03_c.c b/ext/spice/src/cspice/spkw03_c.c deleted file mode 100644 index 25b929e52a..0000000000 --- a/ext/spice/src/cspice/spkw03_c.c +++ /dev/null @@ -1,312 +0,0 @@ -/* - --Procedure spkw03_c ( Write SPK segment, type 3 ) - --Abstract - - Write a type 3 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw03_c - - - void spkw03_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of SPK file open for writing. - body I NAIF code for ephemeris object. - center I NAIF code for the center of motion of the body. - frame I Reference frame name. - first I Start time of interval covered by segment. - last I End time of interval covered by segment. - segid I Segment identifier. - intlen I Length of time covered by record. - n I Number of records in segment. - polydg I Chebyshev polynomial degree. - cdata I Array of Chebyshev coefficients. - btime I Begin time of first record. - --Detailed_Input - - handle DAF handle of an SPK file to which a type 3 segment - is to be added. The SPK file must be open for - writing. - - body NAIF integer code for an ephemeris object whose - state relative to another body is described by the - segment to be created. - - center NAIF integer code for the center of motion of the - object identified by body. - - frame NAIF name for a reference frame relative to which - the state information for body is specified. - - first, - last Start and stop times of the time interval over - which the segment defines the state of body. - - segid Segment identifier. An SPK segment identifier may - contain up to 40 characters. - - intlen Length of time, in seconds, covered by each set of - Chebyshev polynomial coefficients (each logical - record). Each set of Chebyshev coefficents must - cover this fixed time interval, intlen. - - n Number of sets of Chebyshev polynomial coefficients - for coordinates and their derivatives (number of - logical records) to be stored in the segment. - There is one set of Chebyshev coefficients for each - time period. - - polydg Degree of each set of Chebyshev polynomials. - - cdata Array containing all the sets of Chebyshev - polynomial coefficients to be placed in the - segment of the SPK file. The coefficients are - stored in cdata in order as follows: - - the (degree + 1) coefficients for the first - coordinate of the first logical record - - the coefficients for the second coordinate - - the coefficients for the third coordinate - - the coefficients for the derivative of the first - coordinate - - the coefficients for the derivative of the - second coordinate - - the coefficients for the derivative of the third - coordinate - - the coefficients for the first coordinate for - the second logical record, ... - - and so on. - - - btime Begin time (seconds past J2000 TDB) of first set - of Chebyshev polynomial coefficients (first - logical record). - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) If the number of sets of coefficients is not positive - SPICE(NUMCOEFFSNOTPOS) is signaled. - - 2) If the interval length is not positive, SPICE(INTLENNOTPOS) - is signaled. - - 3) If the integer code for the reference frame is not recognized, - SPICE(INVALIDREFFRAME) is signaled. - - 4) If segment stop time is not greater then the begin time, - SPICE(BADDESCRTIMES) is signaled. - - 5) If the start time of the first record is not less than - or equal to the descriptor begin time, SPICE(BADDESCRTIMES) - is signaled. - - 6) If the end time of the last record is not greater than - or equal to the descriptor end time, SPICE(BADDESCRTIMES) is - signaled. - - 7) The error SPICE(EMPTYSTRING) is signaled if either input - string does not contain at least one character, since the - input strings cannot be converted to a Fortran-style string - in this case. - - 8) The error SPICE(NULLPOINTER) is signaled if either input string - pointer is null. - --Files - - A new type 3 SPK segment is written to the SPK file attached - to handle. - --Particulars - - This routine writes an SPK type 3 data segment to the designated - SPK file, according to the format described in the SPK Required - Reading. - - Each segment can contain data for only one target, central body, - and reference frame. The Chebyshev polynomial degree and length - of time covered by each logical record are also fixed. However, - an arbitrary number of logical records of Chebyshev polynomial - coefficients can be written in each segment. Minimizing the - number of segments in an SPK file will help optimize how the SPICE - system accesses the file. - --Examples - - Suppose that you have sets of Chebyshev polynomial coefficients - in an array cdata pertaining to the position of the moon (NAIF ID - = 301), relative to the Earth-moon barycenter (NAIF ID = 3), in - the J2000 reference frame, and want to put these into a type 2 - segment in an existing SPK file. The following code could be used - to add one new type 2 segment. To add multiple segments, put the - call to SPKW02 in a loop. - - #include "SpiceUsr.h" - . - . - . - - /. - First open the SPK file and get a handle for it. - ./ - spkopa_c ( spknam, &handle ); - - /. - Create a segment identifier. - ./ - segid = "MY_SAMPLE_SPK_TYPE_3_SEGMENT"; - - /. - Write the segment. - ./ - spkw03_c ( handle, 301, 3, "J2000", - first, last, segid, intlen, - n, polydg, cdata, btime ); - - /. - Close the file. - ./ - spkcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.S. Zukor (JPL) - --Version - - -CSPICE Version 1.0.0, 08-MAR-2002 (EDW) - - Corrected section header typo: Example to Examples. - - -CSPICE Version 1.0.0, 23-JUN-1999 (NJB) (KSZ) - --Index_Entries - - write spk type_3 data segment - --& -*/ - -{ /* Begin spkw03_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw03_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw03_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw03_c", segid ); - - - /* - Write the segment. - */ - spkw03_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( doublereal * ) &intlen, - ( integer * ) &n, - ( integer * ) &polydg, - ( doublereal * ) cdata, - ( doublereal * ) &btime, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw03_c" ); - -} /* End spkw03_c */ diff --git a/ext/spice/src/cspice/spkw05.c b/ext/spice/src/cspice/spkw05.c deleted file mode 100644 index e011efe016..0000000000 --- a/ext/spice/src/cspice/spkw05.c +++ /dev/null @@ -1,442 +0,0 @@ -/* spkw05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKW05 ( Write SPK segment, type 5 ) */ -/* Subroutine */ int spkw05_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - doublereal *gm, integer *n, doublereal *states, doublereal *epochs, - ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( - doublereal *, integer *), dafbna_(integer *, doublereal *, char *, - ftnlen), dafena_(void); - extern logical failed_(void); - integer refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Write an SPK segment of type 5 given a time-ordered set of */ -/* discrete states and epochs, and the gravitational parameter */ -/* of a central body. */ - -/* $ 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 */ - -/* SPK */ -/* SPC */ -/* NAIF_IDS */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I Body code for ephemeris object. */ -/* CENTER I Body code for the center of motion of the body. */ -/* FRAME I The reference frame of the states. */ -/* FIRST I First valid time for which states can be computed. */ -/* LAST I Last valid time for which states can be computed. */ -/* SEGID I Segment identifier. */ -/* GM I Gravitational parameter of central body. */ -/* N I Number of states and epochs. */ -/* STATES I States. */ -/* EPOCHS I Epochs. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file */ -/* opened for writing. */ - -/* BODY is the NAIF ID for the body whose states are */ -/* to be recorded in an SPK file. */ - -/* CENTER is the NAIF ID for the center of motion associated */ -/* with BODY. */ - -/* FRAME is the reference frame that states are referenced to, */ -/* for example 'J2000'. */ - -/* FIRST are the bounds on the ephemeris times, expressed as */ -/* LAST seconds past J2000, for which the states can be used */ -/* to interpolate a state for BODY. */ - -/* SEGID is the segment identifier. An SPK segment identifier */ -/* may contain up to 40 characters. */ - -/* GM is the gravitational parameter of the central body */ -/* ( in units of kilometers **3 / seconds **2 ). */ - -/* N is the number of states and epochs to be stored */ -/* in the segment. */ - -/* STATES contains a time-ordered array of geometric states */ -/* ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and */ -/* kilometers per second ) of the target body with */ -/* respect to the central body specified in the segment */ -/* descriptor. */ - -/* EPOCHS contains the epochs (ephemeris seconds past J2000) */ -/* corresponding to the states in STATES. Epochs must */ -/* form a strictly increasing sequence. */ - -/* $ Detailed_Output */ - -/* None. A type 5 segment is written to the file attached to HANDLE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If GM is not positive, the error SPICE(NONPOSITIVEMASS) */ -/* signals. */ - -/* 2) If the input epochs do not form an increasing sequence, the */ -/* error SPICE(UNORDEREDTIMES) will be signalled. */ - -/* 3) If the number of states and epochs is not positive then the */ -/* error SPICE(NUMSTATESNOTPOS) will be signalled. */ - -/* 4) If FIRST is greater than LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signalled. */ - -/* 5) If SEGID is more than 40 characters long, the error */ -/* SPICE(SEGIDTOOLONG) is signalled. */ - -/* 6) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 7) Any file I/O problems will be detected and diagnosed by one */ -/* of the DAF routines called by this routine. */ - -/* $ Files */ - -/* A new type 05 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 05 data segment to the open SPK */ -/* file according to the format described in the type 05 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have states and are prepared to produce */ -/* a segment of type 05 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_5_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW05 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ -/* . SEGID, GM, N, STATES, EPOCHS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 30-OCT-2006 (BVS) */ - -/* Removed restriction that the input reference frame should be */ -/* inertial by changing the routine that determins the frame ID */ -/* from the name from IRFNUM to NAMFRM. */ - -/* - SPICELIB Version 1.0.2, 27-JAN-2003 (EDW) */ - -/* Added error check to catch non-positive gravitational */ -/* parameter GM. */ - -/* - SPICELIB Version 1.0.1, 05-OCT-1993 (KRG) */ - -/* Removed all references to a specific method of opening the SPK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Particulars and */ -/* $ Examples sections of the header. It is assumed that a person */ -/* using this routine has some knowledge of the DAF system and the */ -/* methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_5 ephemeris data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 30-OCT-2006 (BVS) */ - -/* Removed restriction that the input reference frame should be */ -/* inertial by changing the routine that determins the frame ID */ -/* from the name from IRFNUM to NAMFRM. */ - -/* - SPICELIB Version 1.0.2, 27-JAN-2003 (EDW) */ - -/* Added error check to catch non-positive gravitational */ -/* parameter GM. */ - -/* - SPICELIB Version 1.0.1, 05-OCT-1993 (KRG) */ - -/* Removed all references to a specific method of opening the SPK */ -/* file in the $ Brief_I/O, $ Detailed_Input, and $ Examples */ -/* sections of the header. It is assumed that a person using this */ -/* routine has some knowledge of the DAF system and the methods */ -/* for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* SIDLEN is the maximum number of characters allowed in an */ -/* SPK segment identifier. */ - -/* NS is the size of a packed SPK segment descriptor. */ - -/* ND is the number of double precision components in an SPK */ -/* segment descriptor. */ - -/* NI is the number of integer components in an SPK segment */ -/* descriptor. */ - -/* DTYPE is the data type. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW05", (ftnlen)6); - } - if (*gm <= 0.) { - setmsg_("GM = #; Non-positive gravitational parameter", (ftnlen)44); - errdp_("#", gm, (ftnlen)1); - sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - -/* Make sure that the number of states and epochs is positive. */ - - if (*n <= 0) { - setmsg_("The number of states and epochs is not positive. N = #", ( - ftnlen)54); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(NUMSTATESNOTPOS)", (ftnlen)22); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - -/* Check the input epochs to make sure that they form a */ -/* strictly increasing sequence. */ - - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - if (epochs[i__ - 1] <= epochs[i__ - 2]) { - setmsg_("Epoch # is out of order. ", (ftnlen)25); - errdp_("#", &epochs[i__ - 1], (ftnlen)1); - sigerr_("SPICE(UNORDEREDTIMES)", (ftnlen)21); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first > *last) { - setmsg_("The segment start time: # is greater then the segment end t" - "ime: #", (ftnlen)65); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segid can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - } - -/* Also check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW05", (ftnlen)6); - return 0; - } - -/* Store the start and end times to be associated */ -/* with this segment. */ - - dcd[0] = *first; - dcd[1] = *last; - -/* Create the integer portion of the descriptor. */ - - icd[0] = *body; - icd[1] = *center; - icd[2] = refcod; - icd[3] = 5; - -/* Pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW05", (ftnlen)6); - return 0; - } - -/* This could hardly be simpler. Stuff the states into the segment, */ -/* followed by the epochs. */ - - i__1 = *n * 6; - dafada_(states, &i__1); - dafada_(epochs, n); - -/* If there are at least 100 state/epoch pairs, write a directory */ -/* containing every 100'th epoch. */ - - i__ = 100; - while(i__ <= *n) { - dafada_(&epochs[i__ - 1], &c__1); - i__ += 100; - } - -/* Store the GM of the central body, and the number of states. */ - - dafada_(gm, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* If anything went wrong, don't end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW05", (ftnlen)6); - return 0; -} /* spkw05_ */ - diff --git a/ext/spice/src/cspice/spkw05_c.c b/ext/spice/src/cspice/spkw05_c.c deleted file mode 100644 index 73e644ee91..0000000000 --- a/ext/spice/src/cspice/spkw05_c.c +++ /dev/null @@ -1,267 +0,0 @@ -/* - --Procedure spkw05_c ( Write SPK segment, type 5 ) - --Abstract - - Write an SPK segment of type 5 given a time-ordered set of - discrete states and epochs, and the gravitational parameter - of a central body. - --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 - - SPK - SPC - NAIF_IDS - --Keywords - - EPHEMERIS - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw05_c - - - void spkw05_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble gm, - SpiceInt n, - ConstSpiceDouble states [][6], - ConstSpiceDouble epochs [] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I Body code for ephemeris object. - center I Body code for the center of motion of the body. - frame I The reference frame of the states. - first I First valid time for which states can be computed. - last I Last valid time for which states can be computed. - segid I Segment identifier. - gm I Gravitational parameter of central body. - n I Number of states and epochs. - states I States. - epochs I Epochs. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF ID for the body whose states are - to be recorded in an SPK file. - - center is the NAIF ID for the center of motion associated - with BODY. - - frame is the reference frame that states are referenced to, - for example "J2000". - - first are the bounds on the ephemeris times, expressed as - last seconds past J2000, for which the states can be used - to interpolate a state for BODY. - - segid is the segment identifier. An SPK segment identifier - may contain up to 40 characters. - - gm is the gravitational parameter of the central body - ( in units of kilometers **3 / seconds **2 ). - - n is the number of states and epochs to be stored - in the segment. - - states contains a time-ordered array of geometric states - ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and - kilometers per second ) of the target body with - respect to the central body specified in the segment - descriptor. - - epochs contains the epochs (ephemeris seconds past J2000) - corresponding to the states in states. Epochs must - form a strictly increasing sequence. - --Detailed_Output - - None. A type 5 segment is written to the file attached to handle. - --Parameters - - None. - --Exceptions - - 1) If the input epochs do not form an increasing sequence, the - error SPICE(UNORDEREDTIMES) will be signaled. - - 2) If the number of states and epochs is not positive then the - error SPICE(NUMSTATESNOTPOS) will be signaled. - - 3) If FIRST is greater than LAST then the error - SPICE(BADDESCRTIMES) will be signaled. - - 4) If SEGID is more than 40 characters long, the error - SPICE(SEGIDTOOLONG) is signaled. - - 5) If SEGID contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 6) Any file I/O problems will be detected and diagnosed by one - of the DAF routines called by this routine. - - 7) The error SPICE(EMPTYSTRING) is signaled if either input - string does not contain at least one character, since the - input strings cannot be converted to a Fortran-style string - in this case. - - 8) The error SPICE(NULLPOINTER) is signaled if either input string - pointer is null. - --Files - - A new type 05 SPK segment is written to the SPK file attached - to handle. - --Particulars - - This routine writes an SPK type 05 data segment to the open SPK - file according to the format described in the type 05 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that you have states and are prepared to produce - a segment of type 05 in an SPK file. - - The following code fragment could be used to add the new segment - to a previously opened SPK file attached to handle. The file must - have been opened with write access. - - #include "SpiceUsr.h" - . - . - . - /. - Create a segment identifier. - ./ - ConstSpiceChar * segid = "MY_SAMPLE_SPK_TYPE_5_SEGMENT"; - - /. - Write the segment. - ./ - spkw05_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble gm, - SpiceInt n, - SpiceDouble states, - SpiceDouble epochs ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - J.M. Lynch (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 23-JUN-1999 (NJB)(KRG)(JML)(WLT)(IMU) - --Index_Entries - - write spk type_5 ephemeris data segment - --& -*/ - -{ /* Begin spkw05_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw05_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw05_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw05_c", segid ); - - - /* - Write the segment. Note that the state array DOES NOT require - transposition! - */ - - spkw05_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( doublereal * ) &gm, - ( integer * ) &n, - ( doublereal * ) states, - ( doublereal * ) epochs, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - chkout_c ( "spkw05_c" ); - -} /* End spkw05_c */ diff --git a/ext/spice/src/cspice/spkw08.c b/ext/spice/src/cspice/spkw08.c deleted file mode 100644 index 4d84b3f8a9..0000000000 --- a/ext/spice/src/cspice/spkw08.c +++ /dev/null @@ -1,507 +0,0 @@ -/* spkw08.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKW08 ( Write SPK segment, type 8 ) */ -/* Subroutine */ int spkw08_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - integer *degree, integer *n, doublereal *states, doublereal *epoch1, - doublereal *step, ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *), dafbna_(integer *, doublereal *, char *, ftnlen), - dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Write a type 8 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I NAIF code for an ephemeris object. */ -/* CENTER I NAIF code for center of motion of BODY. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* DEGREE I Degree of interpolating polynomials. */ -/* N I Number of states. */ -/* STATES I Array of states. */ -/* EPOCH1 I Epoch of first state in STATES array. */ -/* STEP I Time step separating epochs of states. */ -/* MAXDEG P Maximum allowed degree of interpolating polynomial. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose state relative to another body is described */ -/* by the segment to be created. */ - -/* CENTER is the NAIF integer code for the center of motion */ -/* of the object identified by BODY. */ - -/* FRAME is the NAIF name for a reference frame */ -/* relative to which the state information for BODY */ -/* is specified. */ - -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the state of BODY. */ - -/* SEGID is the segment identifier. An SPK segment */ -/* identifier may contain up to 40 characters. */ - -/* DEGREE is the degree of the Lagrange polynomials used to */ -/* interpolate the states. All components of the */ -/* state vectors are interpolated by polynomials of */ -/* fixed degree. */ - -/* N is the number of states in the input state vector */ -/* array. */ - -/* STATES contains a time-ordered array of geometric states */ -/* ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and */ -/* kilometers per second ) of BODY relative to CENTER, */ -/* specified relative to FRAME. */ - -/* EPOCH1 is the epoch corresponding to the first state in */ -/* the state array. Because extra states are needed */ -/* at the beginning and end of the segment in order */ -/* for the interpolation method to work, EPOCH1 will */ -/* normally precede FIRST. */ - -/* STEP is the time step separating the epochs of adjacent */ -/* states in the input state array. STEP is specified */ -/* in seconds. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* MAXDEG is the maximum allowed degree of the interpolating */ -/* polynomial. If the value of MAXDEG is increased, */ -/* the SPICELIB routine SPKPV must be changed */ -/* accordingly. In particular, the size of the */ -/* record passed to SPKRnn and SPKEnn must be */ -/* increased, and comments describing the record size */ -/* must be changed. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If FRAME is not a recognized name, the error */ -/* SPICE(INVALIDREFFRAME) is signalled. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signalled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 4) If DEGREE is not at least 1 or is greater than MAXDEG, the */ -/* error SPICE(INVALIDDEGREE) is signalled. */ - -/* 5) If the number of states N is not at least DEGREE+1, the error */ -/* SPICE(TOOFEWSTATES) will be signalled. */ - -/* 6) If FIRST is greater than LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signalled. */ - -/* 7) If STEP is non-positive, the error SPICE(INVALIDSTEPSIZE) will */ -/* be signalled. */ - -/* 8) If the first epoch EPOCH1 is greater than FIRST, the error */ -/* SPICE(BADDESCRTIMES) will be signalled. */ - -/* 9) If the last epoch */ - -/* FIRST + (N-1)*STEP */ - -/* is less than LAST, the error SPICE(BADDESCRTIMES) will be */ -/* signalled. */ - -/* $ Files */ - -/* A new type 8 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 08 data segment to the open SPK */ -/* file according to the format described in the type 08 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have states and are prepared to produce */ -/* a segment of type 08 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_8_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW08 ( HANDLE, BODY, CENTER, FRAME, */ -/* . FIRST, LAST, SEGID, DEGREE, */ -/* . N, STATES, EPOCH1, STEP ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.0.1, 05-OCT-1993 (KRG) */ - -/* Removed all references to a specific method of opening the SPK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Particulars and */ -/* $ Examples sections of the header. It is assumed that a person */ -/* using this routine has some knowledge of the DAF system and the */ -/* methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 08-AUG-1993 (NJB) (JML) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_8 ephemeris data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.0.1, 05-OCT-1993 (KRG) */ - -/* Removed all references to a specific method of opening the SPK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Particulars and */ -/* $ Examples sections of the header. It is assumed that a person */ -/* using this routine has some knowledge of the DAF system and the */ -/* methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 08-AUG-1993 (NJB) (JML) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* SIDLEN is the maximum number of characters allowed in an */ -/* SPK segment identifier. */ - -/* NS is the size of a packed SPK segment descriptor. */ - -/* ND is the number of double precision components in an SPK */ -/* segment descriptor. */ - -/* NI is the number of integer components in an SPK segment */ -/* descriptor. */ - -/* DTYPE is the data type. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW08", (ftnlen)6); - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* Check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters" - ": ICHAR(SEGID(#:#)) = #", (ftnlen)79); - errint_("#", &i__, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errint_("#", &chrcod, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - } - -/* Make sure that the degree of the interpolating polynomials is */ -/* in range. */ - - if (*degree < 1 || *degree > 15) { - setmsg_("The interpolating polynomials have degree #; the valid degr" - "ee range is [1, #].", (ftnlen)78); - errint_("#", degree, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* Make sure that the number of states is sufficient to define a */ -/* polynomial whose degree is DEGREE. */ - - if (*n <= *degree) { - setmsg_("At least # states are required to define a polynomial of de" - "gree #. Number of states supplied: #.", (ftnlen)98); - i__1 = *degree + 1; - errint_("#", &i__1, (ftnlen)1); - errint_("#", degree, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(TOOFEWSTATES)", (ftnlen)19); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater than the begin time. */ - - if (*first >= *last) { - setmsg_("The segment start time: # is greater than or equal to the s" - "egment end time: #", (ftnlen)77); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* The step size must be positive. */ - - if (*step <= 0.) { - setmsg_("The step size must be > 0 but was #. ", (ftnlen)37); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEPSIZE)", (ftnlen)22); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* Make sure that the span of the input epochs includes the interval */ -/* defined by the segment descriptor. */ - - if (*epoch1 > *first) { - setmsg_("Segment start time # precedes first epoch #.", (ftnlen)44); - errdp_("#", first, (ftnlen)1); - errdp_("#", epoch1, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW08", (ftnlen)6); - return 0; - } else if (*epoch1 + (*n - 1) * *step < *last) { - setmsg_("Segment end time # follows last epoch #.", (ftnlen)40); - errdp_("#", last, (ftnlen)1); - d__1 = *epoch1 + (*n - 1) * *step; - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* If we made it this far, we're ready to start writing the segment. */ - -/* Store the start and end times to be associated */ -/* with this segment. */ - - dcd[0] = *first; - dcd[1] = *last; - -/* Create the integer portion of the descriptor. */ - - icd[0] = *body; - icd[1] = *center; - icd[2] = refcod; - icd[3] = 8; - -/* Pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW08", (ftnlen)6); - return 0; - } - -/* The type 8 segment structure is eloquently described by this */ -/* diagram from the SPK Required Reading: */ - -/* +-----------------------+ */ -/* | State 1 | */ -/* +-----------------------+ */ -/* | State 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | State N | */ -/* +-----------------------+ */ -/* | Epoch of state 1 (ET) | */ -/* +-----------------------+ */ -/* | Step size | */ -/* +-----------------------+ */ -/* | Polynomial degree | */ -/* +-----------------------+ */ -/* | Number of states | */ -/* +-----------------------+ */ - - - i__1 = *n * 6; - dafada_(states, &i__1); - dafada_(epoch1, &c__1); - dafada_(step, &c__1); - d__1 = (doublereal) (*degree); - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW08", (ftnlen)6); - return 0; -} /* spkw08_ */ - diff --git a/ext/spice/src/cspice/spkw08_c.c b/ext/spice/src/cspice/spkw08_c.c deleted file mode 100644 index 8243dc8122..0000000000 --- a/ext/spice/src/cspice/spkw08_c.c +++ /dev/null @@ -1,309 +0,0 @@ -/* - --Procedure spkw08_c ( Write SPK segment, type 8 ) - --Abstract - - Write a type 8 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - TIME - --Keywords - - EPHEMERIS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw08_c - - - void spkw08_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch1, - SpiceDouble step ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I NAIF code for an ephemeris object. - center I NAIF code for center of motion of BODY. - frame I Reference frame name. - first I Start time of interval covered by segment. - last I End time of interval covered by segment. - segid I Segment identifier. - degree I Degree of interpolating polynomials. - n I Number of states. - states I Array of states. - epoch1 I Epoch of first state in states array. - step I Time step separating epochs of states. - MAXDEG P Maximum allowed degree of interpolating polynomial. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF integer code for an ephemeris object - whose state relative to another body is described - by the segment to be created. - - center is the NAIF integer code for the center of motion - of the object identified by body. - - frame is the NAIF name for a reference frame - relative to which the state information for body - is specified. - - first, - last are, respectively, the start and stop times of - the time interval over which the segment defines - the state of body. - - segid is the segment identifier. An SPK segment - identifier may contain up to 40 characters. - - degree is the degree of the Lagrange polynomials used to - interpolate the states. All components of the - state vectors are interpolated by polynomials of - fixed degree. - - n is the number of states in the input state vector - array. - - states contains a time-ordered array of geometric states - ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and - kilometers per second ) of body relative to center, - specified relative to frame. - - epoch1 is the epoch corresponding to the first state in - the state array. Because extra states are needed - at the beginning and end of the segment in order - for the interpolation method to work, epoch1 will - normally precede first. - - step is the time step separating the epochs of adjacent - states in the input state array. step is specified - in seconds. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - MAXDEG is the maximum allowed degree of the interpolating - polynomial. If the value of MAXDEG is increased, - the CSPICE routine SPKPV must be changed - accordingly. In particular, the size of the - record passed to SPKRnn and SPKEnn must be - increased, and comments describing the record size - must be changed. - - The current value of MAXDEG is 15. - --Exceptions - - If any of the following exceptions occur, this routine will return - without creating a new segment. - - 1) If FRAME is not a recognized name, the error - SPICE(INVALIDREFFRAME) is signaled. - - 2) If the last non-blank character of SEGID occurs past index 40, - the error SPICE(SEGIDTOOLONG) is signaled. - - 3) If SEGID contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If DEGREE is not at least 1 or is greater than MAXDEG, the - error SPICE(INVALIDDEGREE) is signaled. - - 5) If the number of states N is not at least DEGREE+1, the error - SPICE(TOOFEWSTATES) will be signaled. - - 6) If FIRST is greater than LAST then the error - SPICE(BADDESCRTIMES) will be signaled. - - 7) If STEP is non-positive, the error SPICE(INVALIDSTEPSIZE) will - be signaled. - - 8) If the first epoch EPOCH1 is greater than FIRST, the error - SPICE(BADDESCRTIMES) will be signaled. - - 9) If the last epoch - - FIRST + (N-1)*STEP - - is less than LAST, the error SPICE(BADDESCRTIMES) will be - signaled. - - 10) The error SPICE(EMPTYSTRING) is signaled if either input - string does not contain at least one character, since the - input strings cannot be converted to a Fortran-style string - in this case. - - 11) The error SPICE(NULLPOINTER) is signaled if either input string - pointer is null. - --Files - - A new type 8 SPK segment is written to the SPK file attached - to handle. - --Particulars - - This routine writes an SPK type 08 data segment to the open SPK - file according to the format described in the type 08 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that you have states and are prepared to produce - a segment of type 08 in an SPK file. - - The following code fragment could be used to add the new segment - to a previously opened SPK file attached to HANDLE. The file must - have been opened with write access. - - #include "SpiceUsr.h" - . - . - . - - /. - First open the SPK file and get a handle for it. - ./ - spkopa_c ( spknam, &handle ); - - /. - Create a segment identifier. - ./ - segid = "MY_SAMPLE_SPK_TYPE_8_SEGMENT"; - - /. - Write the segment. - ./ - spkw08_c ( handle, body, center, frame, - first, last, segid, degree, - n, states, epoch1, step ); - - /. - Close the file. - ./ - spkcls_c ( handle ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - N.J. Bachman (JPL) - J.M. Lynch (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 (NJB) - --Index_Entries - - write spk type_8 ephemeris data segment - --& -*/ - -{ /* Begin spkw08_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw08_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw08_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw08_c", segid ); - - - /* - Write the segment. - */ - - spkw08_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( integer * ) °ree, - ( integer * ) &n, - ( doublereal * ) states, - ( doublereal * ) &epoch1, - ( doublereal * ) &step, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw08_c" ); - -} /* End spkw08_c */ diff --git a/ext/spice/src/cspice/spkw09.c b/ext/spice/src/cspice/spkw09.c deleted file mode 100644 index 76076cc160..0000000000 --- a/ext/spice/src/cspice/spkw09.c +++ /dev/null @@ -1,522 +0,0 @@ -/* spkw09.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKW09 ( Write SPK segment, type 9 ) */ -/* Subroutine */ int spkw09_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - integer *degree, integer *n, doublereal *states, doublereal *epochs, - ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *), dafbna_(integer *, doublereal *, char *, ftnlen), - dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal maxtim; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - doublereal dcd[2]; - integer icd[6]; - -/* $ Abstract */ - -/* Write a type 9 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I NAIF code for an ephemeris object. */ -/* CENTER I NAIF code for center of motion of BODY. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* DEGREE I Degree of interpolating polynomials. */ -/* N I Number of states. */ -/* STATES I Array of states. */ -/* EPOCHS I Array of epochs corresponding to states. */ -/* MAXDEG P Maximum allowed degree of interpolating polynomial. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose state relative to another body is described */ -/* by the segment to be created. */ - -/* CENTER is the NAIF integer code for the center of motion */ -/* of the object identified by BODY. */ - -/* FRAME is the NAIF name for a reference frame */ -/* relative to which the state information for BODY */ -/* is specified. */ - -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the state of BODY. */ - -/* SEGID is the segment identifier. An SPK segment */ -/* identifier may contain up to 40 characters. */ - -/* DEGREE is the degree of the Lagrange polynomials used to */ -/* interpolate the states. All components of the */ -/* state vectors are interpolated by polynomials of */ -/* fixed degree. */ - -/* N is the number of states in the input state vector */ -/* array. */ - -/* STATES contains a time-ordered array of geometric states */ -/* ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and */ -/* kilometers per second ) of BODY relative to CENTER, */ -/* specified relative to FRAME. */ - -/* EPOCHS is an array of epochs corresponding to the members */ -/* of the state array. The epochs are specified as */ -/* seconds past J2000, TDB. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* MAXDEG is the maximum allowed degree of the interpolating */ -/* polynomial. If the value of MAXDEG is increased, */ -/* the SPICELIB routine SPKPV must be changed */ -/* accordingly. In particular, the size of the */ -/* record passed to SPKRnn and SPKEnn must be */ -/* increased, and comments describing the record size */ -/* must be changed. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If FRAME is not a recognized name, the error */ -/* SPICE(INVALIDREFFRAME) is signalled. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signalled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signalled. */ - -/* 4) If DEGREE is not at least 1 or is greater than MAXDEG, the */ -/* error SPICE(INVALIDDEGREE) is signalled. */ - -/* 5) If the number of states N is not at least DEGREE+1, the error */ -/* SPICE(TOOFEWSTATES) will be signalled. */ - -/* 6) If FIRST is greater than or equal to LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signalled. */ - -/* 7) If the elements of the array EPOCHS are not in strictly */ -/* increasing order, the error SPICE(TIMESOUTOFORDER) will be */ -/* signalled. */ - -/* 8) If the first epoch EPOCHS(1) is greater than FIRST, the error */ -/* SPICE(BADDESCRTIMES) will be signalled. */ - -/* 9) If the last epoch EPOCHS(N) is less than LAST, the error */ -/* SPICE(BADDESCRTIMES) will be signalled. */ - - -/* $ Files */ - -/* A new type 9 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 09 data segment to the open SPK */ -/* file according to the format described in the type 09 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have states and are prepared to produce */ -/* a segment of type 09 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_9_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW09 ( HANDLE, BODY, CENTER, FRAME, */ -/* . FIRST, LAST, SEGID, DEGREE, */ -/* . N, STATES, EPOCHS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.M. Lynch (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.0.1, 05-OCT-1993 (KRG) */ - -/* Removed all references to a specific method of opening the SPK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Particulars and */ -/* $ Examples sections of the header. It is assumed that a person */ -/* using this routine has some knowledge of the DAF system and the */ -/* methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 05-AUG-1993 (NJB) (JML) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_9 ephemeris data segment */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial reference */ -/* frames. */ - -/* - SPICELIB Version 1.0.1, 05-OCT-1993 (KRG) */ - -/* Removed all references to a specific method of opening the SPK */ -/* file in the $ Brief_I/O, $ Detailed_Input, $ Particulars and */ -/* $ Examples sections of the header. It is assumed that a person */ -/* using this routine has some knowledge of the DAF system and the */ -/* methods for obtaining file handles. */ - -/* - SPICELIB Version 1.0.0, 05-AUG-1993 (NJB) (JML) (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* SIDLEN is the maximum number of characters allowed in an */ -/* SPK segment identifier. */ - -/* NS is the size of a packed SPK segment descriptor. */ - -/* ND is the number of double precision components in an SPK */ -/* segment descriptor. */ - -/* NI is the number of integer components in an SPK segment */ -/* descriptor. */ - -/* DTYPE is the data type. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW09", (ftnlen)6); - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first >= *last) { - setmsg_("The segment start time: # is greater then the segment end t" - "ime: #", (ftnlen)65); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - } - -/* Also check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* Make sure that the degree of the interpolating polynomials is */ -/* in range. */ - - if (*degree < 1 || *degree > 15) { - setmsg_("The interpolating polynomials have degree #; the valid degr" - "ee range is [1, #]", (ftnlen)77); - errint_("#", degree, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* Make sure that the number of states is sufficient to define a */ -/* polynomial whose degree is DEGREE. */ - - if (*n <= *degree) { - setmsg_("At least # states are required to define a polynomial of de" - "gree #. Number of states supplied: #", (ftnlen)97); - i__1 = *degree + 1; - errint_("#", &i__1, (ftnlen)1); - errint_("#", degree, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(TOOFEWSTATES)", (ftnlen)19); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* Make sure the epochs form a strictly increasing sequence. */ - - maxtim = epochs[0]; - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - if (epochs[i__ - 1] <= maxtim) { - setmsg_("EPOCH # having index # is not greater than its predeces" - "sor #.", (ftnlen)61); - errdp_("#", &epochs[i__ - 1], (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &epochs[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("SPKW09", (ftnlen)6); - return 0; - } else { - maxtim = epochs[i__ - 1]; - } - } - -/* Make sure that the span of the input epochs includes the interval */ -/* defined by the segment descriptor. */ - - if (epochs[0] > *first) { - setmsg_("Segment start time # precedes first epoch #.", (ftnlen)44); - errdp_("#", first, (ftnlen)1); - errdp_("#", epochs, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW09", (ftnlen)6); - return 0; - } else if (epochs[*n - 1] < *last) { - setmsg_("Segment end time # follows last epoch #.", (ftnlen)40); - errdp_("#", last, (ftnlen)1); - errdp_("#", &epochs[*n - 1], (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* That concludes the error checks. Make the segment. */ - -/* Store the start and end times to be associated */ -/* with this segment. */ - - dcd[0] = *first; - dcd[1] = *last; - -/* Create the integer portion of the descriptor. */ - - icd[0] = *body; - icd[1] = *center; - icd[2] = refcod; - icd[3] = 9; - -/* Pack the segment descriptor. */ - - dafps_(&c__2, &c__6, dcd, icd, descr); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW09", (ftnlen)6); - return 0; - } - -/* The type 9 segment structure is eloquently described by this */ -/* diagram from the SPK Required Reading: */ - -/* +-----------------------+ */ -/* | State 1 | */ -/* +-----------------------+ */ -/* | State 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | State N | */ -/* +-----------------------+ */ -/* | Epoch 1 | */ -/* +-----------------------+ */ -/* | Epoch 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch N | */ -/* +-----------------------+ */ -/* | Epoch 100 | (First directory) */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch ((N-1)/100)*100 | (Last directory) */ -/* +-----------------------+ */ -/* | Polynomial degree | */ -/* +-----------------------+ */ -/* | Number of states | */ -/* +-----------------------+ */ - - - i__1 = *n * 6; - dafada_(states, &i__1); - dafada_(epochs, n); - i__1 = (*n - 1) / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&epochs[i__ * 100 - 1], &c__1); - } - d__1 = (doublereal) (*degree); - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW09", (ftnlen)6); - return 0; -} /* spkw09_ */ - diff --git a/ext/spice/src/cspice/spkw09_c.c b/ext/spice/src/cspice/spkw09_c.c deleted file mode 100644 index 95ff006aa6..0000000000 --- a/ext/spice/src/cspice/spkw09_c.c +++ /dev/null @@ -1,286 +0,0 @@ -/* - --Procedure spkw09_c ( Write SPK segment, type 9 ) - --Abstract - - Write a type 9 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - TIME - --Keywords - - EPHEMERIS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef spkw09_c - - - void spkw09_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I NAIF code for an ephemeris object. - center I NAIF code for center of motion of body. - frame I Reference frame name. - first I Start time of interval covered by segment. - last I End time of interval covered by segment. - segid I Segment identifier. - degree I Degree of interpolating polynomials. - n I Number of states. - states I Array of states. - epochs I Array of epochs corresponding to states. - maxdeg P Maximum allowed degree of interpolating polynomial. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF integer code for an ephemeris object - whose state relative to another body is described - by the segment to be created. - - center is the NAIF integer code for the center of motion - of the object identified by body. - - frame is the NAIF name for a reference frame - relative to which the state information for body - is specified. - - first, - last are, respectively, the start and stop times of - the time interval over which the segment defines - the state of body. - - segid is the segment identifier. An SPK segment - identifier may contain up to 40 characters. - - degree is the degree of the Lagrange polynomials used to - interpolate the states. All components of the - state vectors are interpolated by polynomials of - fixed degree. - - n is the number of states in the input state vector - array. - - states contains a time-ordered array of geometric states - ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and - kilometers per second ) of body relative to center, - specified relative to frame. - - epochs is an array of epochs corresponding to the members - of the state array. The epochs are specified as - seconds past J2000, TDB. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - MAXDEG is the maximum allowed degree of the interpolating - polynomial. If the value of MAXDEG is increased, - the CSPICE routine spkpvn_ must be changed - accordingly. In particular, the size of the - record passed to spkrNN_ and spkeNN_ must be - increased, and comments describing the record size - must be changed. - - The current value of MAXDEG is 15. - --Exceptions - - If any of the following exceptions occur, this routine will return - without creating a new segment. - - 1) If frame is not a recognized name, the error - SPICE(INVALIDREFFRAME) is signaled. - - 2) If the last non-blank character of segid occurs past index 40, - the error SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If degree is not at least 1 or is greater than MAXDEG, the - error SPICE(INVALIDDEGREE) is signaled. - - 5) If the number of states n is not at least degree+1, the error - SPICE(TOOFEWSTATES) will be signaled. - - 6) If first is greater than or equal to last then the error - SPICE(BADDESCRTIMES) will be signaled. - - 7) If the elements of the array epochs are not in strictly - increasing order, the error SPICE(TIMESOUTOFORDER) will be - signaled. - - 8) If the first epoch epochs[0] is greater than first, the error - SPICE(BADDESCRTIMES) will be signaled. - - 9) If the last epoch epochs[n] is less than last, the error - SPICE(BADDESCRTIMES) will be signaled. - - 10) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 11) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - --Files - - A new type 9 SPK segment is written to the SPK file attached - to handle. - --Particulars - - This routine writes an SPK type 09 data segment to the open SPK - file according to the format described in the type 09 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that you have states and are prepared to produce - a segment of type 09 in an SPK file. - - The following code fragment could be used to add the new segment - to a previously opened SPK file attached to HANDLE. The file must - have been opened with write access. - - #include "SpiceUsr.h" - . - . - . - - /. - Create a segment identifier. - ./ - #define SEGID "MY_SAMPLE_SPK_TYPE_9_SEGMENT" - - - /. - Write the segment. - ./ - - spkw09_c ( handle, body, center, frame, - first, last, segid, degree, - n, states, epochs ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - K.R. Gehringer (JPL) - N.J. Bachman (JPL) - J.M. Lynch (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 21-JUN-1999 (KRG) (NJB) (JML) (WLT) - --Index_Entries - - write spk type_9 ephemeris data segment - --& -*/ - -{ /* Begin spkw09_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw09_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw09_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw09_c", segid ); - - - /* - Write the segment. - */ - spkw09_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( integer * ) °ree, - ( integer * ) &n, - ( doublereal * ) states, - ( doublereal * ) epochs, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw09_c" ); - -} /* End spkw09_c */ diff --git a/ext/spice/src/cspice/spkw10.c b/ext/spice/src/cspice/spkw10.c deleted file mode 100644 index 703f8a42c8..0000000000 --- a/ext/spice/src/cspice/spkw10.c +++ /dev/null @@ -1,710 +0,0 @@ -/* spkw10.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__8 = 8; -static integer c__14 = 14; -static integer c__4 = 4; -static integer c__1 = 1; - -/* $Procedure SPKW10 (SPK - write a type 10 segment ) */ -/* Subroutine */ int spkw10_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - doublereal *consts, integer *n, doublereal *elems, doublereal *epochs, - ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer base; - doublereal dnut[4]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[6]; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - sgwes_(integer *); - integer npkts; - extern logical failed_(void); - doublereal packet[14]; - integer nepoch; - extern /* Subroutine */ int sgbwfs_(integer *, doublereal *, char *, - integer *, doublereal *, integer *, integer *, ftnlen), chkout_( - char *, ftnlen), sgwfpk_(integer *, integer *, doublereal *, - integer *, doublereal *), spkpds_(integer *, integer *, char *, - integer *, doublereal *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int zzwahr_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Write an SPK type 10 segment to the DAF open and attached to */ -/* the input HANDLE. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the generic segments subroutines. */ - -/* $ 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 */ - -/* DAF Required Reading */ - -/* $ Keywords */ - -/* GENERIC SEGMENTS */ - -/* $ Particulars */ - -/* This include file contains the parameters used by the generic */ -/* segments subroutines, SGxxxx. A generic segment is a */ -/* generalization of a DAF array which places a particular structure */ -/* on the data contained in the array, as described below. */ - -/* This file defines the mnemonics that are used for the index types */ -/* allowed in generic segments as well as mnemonics for the meta data */ -/* items which are used to describe a generic segment. */ - -/* A DAF generic segment contains several logical data partitions: */ - -/* 1) A partition for constant values to be associated with each */ -/* data packet in the segment. */ - -/* 2) A partition for the data packets. */ - -/* 3) A partition for reference values. */ - -/* 4) A partition for a packet directory, if the segment contains */ -/* variable sized packets. */ - -/* 5) A partition for a reference value directory. */ - -/* 6) A reserved partition that is not currently used. This */ -/* partition is only for the use of the NAIF group at the Jet */ -/* Propulsion Laboratory (JPL). */ - -/* 7) A partition for the meta data which describes the locations */ -/* and sizes of other partitions as well as providing some */ -/* additional descriptive information about the generic */ -/* segment. */ - -/* +============================+ */ -/* | Constants | */ -/* +============================+ */ -/* | Packet 1 | */ -/* |----------------------------| */ -/* | Packet 2 | */ -/* |----------------------------| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |----------------------------| */ -/* | Packet N | */ -/* +============================+ */ -/* | Reference Values | */ -/* +============================+ */ -/* | Packet Directory | */ -/* +============================+ */ -/* | Reference Directory | */ -/* +============================+ */ -/* | Reserved Area | */ -/* +============================+ */ -/* | Segment Meta Data | */ -/* +----------------------------+ */ - -/* Only the placement of the meta data at the end of a generic */ -/* segment is required. The other data partitions may occur in any */ -/* order in the generic segment because the meta data will contain */ -/* pointers to their appropriate locations within the generic */ -/* segment. */ - -/* The meta data for a generic segment should only be obtained */ -/* through use of the subroutine SGMETA. The meta data should not be */ -/* written through any mechanism other than the ending of a generic */ -/* segment begun by SGBWFS or SGBWVS using SGWES. */ - -/* $ Restrictions */ - -/* 1) If new reference index types are added, the new type(s) should */ -/* be defined to be the consecutive integer(s) after the last */ -/* defined reference index type used. In this way a value for */ -/* the maximum allowed index type may be maintained. This value */ -/* must also be updated if new reference index types are added. */ - -/* 2) If new meta data items are needed, mnemonics for them must be */ -/* added to the end of the current list of mnemonics and before */ -/* the NMETA mnemonic. In this way compatibility with files having */ -/* a different, but smaller, number of meta data items may be */ -/* maintained. See the description and example below. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* Generic Segments Required Reading. */ -/* DAF Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ - -/* Header update: equations for comptutations of packet indices */ -/* for the cases of index types 0 and 1 were corrected. */ - -/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ - -/* Added parameter MNMETA, the minimum number of meta data items */ -/* that must be present in a generic DAF segment. */ - -/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ - -/* -& */ - -/* Mnemonics for the type of reference value index. */ - -/* Two forms of indexing are provided: */ - -/* 1) An implicit form of indexing based on using two values, a */ -/* starting value, which will have an index of 1, and a step */ -/* size between reference values, which are used to compute an */ -/* index and a reference value associated with a specified key */ -/* value. See the descriptions of the implicit types below for */ -/* the particular formula used in each case. */ - -/* 2) An explicit form of indexing based on a reference value for */ -/* each data packet. */ - - -/* Reference Index Type 0 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | -------------------- | */ -/* \ REF(2) / */ - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - - -/* Reference Index Type 1 */ -/* ---------------------- */ - -/* Implied index. The index and reference value of a data packet */ -/* associated with a specified key value are computed from the two */ -/* generic segment reference values using the formula below. The two */ -/* generic segment reference values, REF(1) and REF(2), represent, */ -/* respectively, a starting value and a step size between reference */ -/* values. The index of the data packet associated with a key value */ -/* of VALUE is given by: */ - -/* / VALUE - REF(1) \ */ -/* INDEX = 1 + INT | 0.5 + -------------------- | */ -/* \ REF(2) / */ - - -/* and the reference value associated with VALUE is given by: */ - -/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ - -/* We get the larger index in the event that VALUE is halfway between */ -/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ - - -/* Reference Index Type 2 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is strictly less than VALUE. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 3 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the last reference item */ -/* that is less than or equal to VALUE. The reference values must be */ -/* in ascending order, REF(I) < REF(I+1). */ - - -/* Reference Index Type 4 */ -/* ---------------------- */ - -/* Explicit index. In this case the number of packets must equal the */ -/* number of reference values. The index of the packet associated */ -/* with a key value of VALUE is the index of the reference item */ -/* that is closest to the value of VALUE. In the event of a "tie" */ -/* the larger index is selected. The reference values must be in */ -/* ascending order, REF(I) < REF(I+1). */ - - -/* These parameters define the valid range for the index types. An */ -/* index type code, MYTYPE, for a generic segment must satisfy the */ -/* relation MNIDXT <= MYTYPE <= MXIDXT. */ - - -/* The following meta data items will appear in all generic segments. */ -/* Other meta data items may be added if a need arises. */ - -/* 1) CONBAS Base Address of the constants in a generic segment. */ - -/* 2) NCON Number of constants in a generic segment. */ - -/* 3) RDRBAS Base Address of the reference directory for a */ -/* generic segment. */ - -/* 4) NRDR Number of items in the reference directory of a */ -/* generic segment. */ - -/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ -/* generic segment. */ - -/* 6) REFBAS Base Address of the reference items for a generic */ -/* segment. */ - -/* 7) NREF Number of reference items in a generic segment. */ - -/* 8) PDRBAS Base Address of the Packet Directory for a generic */ -/* segment. */ - -/* 9) NPDR Number of items in the Packet Directory of a generic */ -/* segment. */ - -/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ -/* segment. */ - -/* 11) PKTBAS Base Address of the Packets for a generic segment. */ - -/* 12) NPKT Number of Packets in a generic segment. */ - -/* 13) RSVBAS Base Address of the Reserved Area in a generic */ -/* segment. */ - -/* 14) NRSV Number of items in the reserved area of a generic */ -/* segment. */ - -/* 15) PKTSZ Size of the packets for a segment with fixed width */ -/* data packets or the size of the largest packet for a */ -/* segment with variable width data packets. */ - -/* 16) PKTOFF Offset of the packet data from the start of a packet */ -/* record. Each data packet is placed into a packet */ -/* record which may have some bookkeeping information */ -/* prepended to the data for use by the generic */ -/* segments software. */ - -/* 17) NMETA Number of meta data items in a generic segment. */ - -/* Meta Data Item 1 */ -/* ----------------- */ - - -/* Meta Data Item 2 */ -/* ----------------- */ - - -/* Meta Data Item 3 */ -/* ----------------- */ - - -/* Meta Data Item 4 */ -/* ----------------- */ - - -/* Meta Data Item 5 */ -/* ----------------- */ - - -/* Meta Data Item 6 */ -/* ----------------- */ - - -/* Meta Data Item 7 */ -/* ----------------- */ - - -/* Meta Data Item 8 */ -/* ----------------- */ - - -/* Meta Data Item 9 */ -/* ----------------- */ - - -/* Meta Data Item 10 */ -/* ----------------- */ - - -/* Meta Data Item 11 */ -/* ----------------- */ - - -/* Meta Data Item 12 */ -/* ----------------- */ - - -/* Meta Data Item 13 */ -/* ----------------- */ - - -/* Meta Data Item 14 */ -/* ----------------- */ - - -/* Meta Data Item 15 */ -/* ----------------- */ - - -/* Meta Data Item 16 */ -/* ----------------- */ - - -/* If new meta data items are to be added to this list, they should */ -/* be added above this comment block as described below. */ - -/* INTEGER NEW1 */ -/* PARAMETER ( NEW1 = PKTOFF + 1 ) */ - -/* INTEGER NEW2 */ -/* PARAMETER ( NEW2 = NEW1 + 1 ) */ - -/* INTEGER NEWEST */ -/* PARAMETER ( NEWEST = NEW2 + 1 ) */ - -/* and then the value of NMETA must be changed as well to be: */ - -/* INTEGER NMETA */ -/* PARAMETER ( NMETA = NEWEST + 1 ) */ - -/* Meta Data Item 17 */ -/* ----------------- */ - - -/* Maximum number of meta data items. This is always set equal to */ -/* NMETA. */ - - -/* Minimum number of meta data items that must be present in a DAF */ -/* generic segment. This number is to remain fixed even if more */ -/* meta data items are added for compatibility with old DAF files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I The handle of a DAF file open for writing. */ -/* BODY I The NAIF ID code for the body of the segment. */ -/* CENTER I The center of motion for BODY. */ -/* FRAME I The reference frame for this segment. */ -/* FIRST I The first epoch for which the segment is valid. */ -/* LAST I The last epoch for which the segment is valid. */ -/* SEGID I The string to use for segment identifier. */ -/* CONSTS I The array of geophysical constants for the segment */ -/* N I The number of element/epoch pairs to be stored */ -/* ELEMS I The collection of "two-line" element sets. */ -/* EPOCHS I The epochs associated with the element sets. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing by SPCOPN, DAFOPN, or DAFOPW. */ - -/* BODY is the SPICE ID for the body whose states are */ -/* to be recorded in an SPK file. */ - -/* CENTER is the SPICE ID for the center of motion associated */ -/* with BODY. */ - -/* FRAME is the reference frame that states are referenced to, */ -/* for example 'J2000'. */ - -/* FIRST are the bounds on the ephemeris times, expressed as */ -/* LAST seconds past J2000, for which the states can be used */ -/* to interpolate a state for BODY. */ - -/* SEGID is the segment identifier. An SPK segment identifier */ -/* may contain up to 40 characters. */ - -/* CONSTS are the geophysical constants needed for evaluation */ -/* of the two line elements sets. The order of these */ -/* constants must be: */ - -/* CONSTS(1) = J2 gravitational harmonic for earth */ -/* CONSTS(2) = J3 gravitational harmonic for earth */ -/* CONSTS(3) = J4 gravitational harmonic for earth */ -/* CONSTS(4) = Square root of the GM for earth where GM */ -/* is expressed in earth radii cubed per */ -/* minutes squared */ -/* CONSTS(5) = Equatorial radius of the earth in km */ -/* CONSTS(6) = Low altitude bound for atmospheric */ -/* model in km */ -/* CONSTS(7) = High altitude bound for atmospheric */ -/* model in km */ -/* CONSTS(8) = Distance units/earth radius (normally 1) */ - -/* N is the number of "two-line" element sets and epochs */ -/* to be stored in the segment. */ - -/* ELEMS contains a time-ordered array of two-line elements */ -/* as supplied in NORAD two-line element files. The */ -/* I'th set of elements should be stored as shown here: */ - -/* BASE = (I-1)*10 */ - -/* ELEMS ( BASE + 1 ) = NDT20 */ -/* ELEMS ( BASE + 2 ) = NDD60 */ -/* ELEMS ( BASE + 3 ) = BSTAR */ -/* ELEMS ( BASE + 4 ) = INCL */ -/* ELEMS ( BASE + 5 ) = NODE0 */ -/* ELEMS ( BASE + 6 ) = ECC */ -/* ELEMS ( BASE + 7 ) = OMEGA */ -/* ELEMS ( BASE + 8 ) = MO */ -/* ELEMS ( BASE + 9 ) = NO */ -/* ELEMS ( BASE + 10 ) = EPOCH */ - -/* The meaning of these variables is defined by the */ -/* format of the two-line element files available from */ -/* NORAD */ - -/* EPOCHS contains the epochs (ephemeris seconds past J2000) */ -/* corresponding to the elements in ELEMS. The I'th */ -/* epoch must equal the epoch of the I'th element set */ -/* Epochs must form a strictly increasing sequence. */ - -/* $ Detailed_Output */ - -/* None. The data input is stored in an SPK segment in the */ -/* DAF connected to the input HANDLE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine writes a type 10 SPK segment to the DAF open */ -/* for writing that is attached to HANDLE. A routine, GETELM, that */ -/* reads two-line element data from files distributed by */ -/* NORAD is available from NAIF. */ - -/* $ Examples */ - -/* Suppose that you have collected the two-line element data */ -/* and geophysical constants as prescribed above. The following */ -/* code fragment demonstrates how you could go about creating */ -/* a type 10 SPK segment. */ - -/* Open a new SPK file using DAF and get a file handle. */ - -/* BODY = */ -/* CENTER = */ -/* FRAME = 'J2000' */ -/* SEGID = */ - -/* FNAME = 'SAMPLE.SPK' */ -/* ND = 2 */ -/* NI = 6 */ -/* IFNAME = 'SAMPLE SPK FILE FOR PRIVATE USE' */ -/* RESV = 0 */ - -/* CALL DAFONW ( FNAME, 'SPK', ND, NI, IFNAME, RESV, HANDLE ) */ - - -/* Add the type 10 data. */ - -/* CALL SPKW10 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ -/* . SEGID, CONSTS, N, ELEMS, EPOCHS ) */ - -/* Close the DAF properly. */ - -/* CALL DAFCLS ( HANDLE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Errors in the structure or content of the inputs are */ -/* diagnosed by routines called by this one. */ - -/* 2) File access errors are diagnosed by routines in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 2006-OCT-30 (BVS) */ - -/* Deleted "inertial" from the FRAME description in the Brief_I/O */ -/* section of the header. */ - -/* - SPICELIB Version 1.0.1, 1999-JUN-21 (WLT) */ - -/* Cleaned up the header. */ - -/* - SPICELIB Version 1.0.0, 1994-JAN-5 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* WRITE A TYPE 10 SPK SEGMENT */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Variables */ - - -/* The type of this segment */ - - -/* The number of geophysical constants: */ - - -/* The number of elements per two-line set: */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKW10", (ftnlen)6); - -/* First we need to create a descriptor for the segment */ -/* we are about to write. */ - - spkpds_(body, center, frame, &c__10, first, last, descr, frame_len); - if (failed_()) { - chkout_("SPKW10", (ftnlen)6); - return 0; - } - -/* We've got a valid descriptor, write the data to a DAF */ -/* segment using the generic segment writer. */ - - npkts = *n; - nepoch = *n; - sgbwfs_(handle, descr, segid, &c__8, consts, &c__14, &c__4, segid_len); - i__1 = nepoch; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Move the elements into the next packet. */ - - base = (i__ - 1) * 10; - moved_(&elems[base], &c__10, packet); - -/* For each epoch, we need to get the nutation in obliquity, */ -/* nutation in longitude and mean obliquity. */ - - zzwahr_(&epochs[i__ - 1], dnut); - packet[11] = dnut[0]; - packet[10] = dnut[1]; - packet[13] = dnut[2]; - packet[12] = dnut[3]; - -/* Now write the packet into the generic segment. */ - - sgwfpk_(handle, &c__1, packet, &c__1, &epochs[i__ - 1]); - } - sgwes_(handle); - chkout_("SPKW10", (ftnlen)6); - return 0; -} /* spkw10_ */ - diff --git a/ext/spice/src/cspice/spkw10_c.c b/ext/spice/src/cspice/spkw10_c.c deleted file mode 100644 index b105301e83..0000000000 --- a/ext/spice/src/cspice/spkw10_c.c +++ /dev/null @@ -1,287 +0,0 @@ -/* - --Procedure spkw10_c (SPK - write a type 10 segment ) - --Abstract - - Write an SPK type 10 segment to the DAF open and attached to - the input handle. - --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 - - SPK - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw10_c - - void spkw10_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - ConstSpiceDouble consts [8], - SpiceInt n, - ConstSpiceDouble elems [], - ConstSpiceDouble epochs [] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - handle I The handle of a DAF file open for writing. - body I The NAIF ID code for the body of the segment. - center I The center of motion for body. - frame I The reference frame for this segment. - first I The first epoch for which the segment is valid. - last I The last epoch for which the segment is valid. - segid I The string to use for segment identifier. - consts I The array of geophysical constants for the segment - n I The number of element/epoch pairs to be stored - elems I The collection of "two-line" element sets. - epochs I The epochs associated with the element sets. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing by spcopn, dafopn, or dafopw. - - body is the NAIF ID for the body whose states are - to be recorded in an SPK file. - - center is the NAIF ID for the center of motion associated - with body. - - frame is the reference frame that states are referenced to, - for example "J2000". - - first are the bounds on the ephemeris times, expressed as - last seconds past J2000, for which the states can be used - to interpolate a state for body. - - segid is the segment identifier. An SPK segment identifier - may contain up to 40 characters. - - consts are the geophysical constants needed for evaluation - of the two line elements sets. The order of these - constants must be: - - consts[0] = J2 gravitational harmonic for earth - consts[1] = J3 gravitational harmonic for earth - consts[2] = J4 gravitational harmonic for earth - consts[3] = Square root of the GM for earth where GM - is expressed in earth radii cubed per - minutes squared - consts[4] = Equatorial radius of the earth in km - consts[5] = Low altitude bound for atmospheric - model in km - consts[6] = High altitude bound for atmospheric - model in km - consts[7] = Distance units/earth radius (normally 1) - - n is the number of "two-line" element sets and epochs - to be stored in the segment. - - elems contains a time-ordered array of two-line elements - as supplied in NORAD two-line element files. The - i'th set of elements (where i ranges from 1 to n) - should be stored as shown here: - - base = (i-1)*10 - - elems ( base + 0 ) = NDT20 - elems ( base + 1 ) = NDD60 - elems ( base + 2 ) = BSTAR - elems ( base + 3 ) = INCL - elems ( base + 4 ) = NODE0 - elems ( base + 5 ) = ECC - elems ( base + 6 ) = OMEGA - elems ( base + 7 ) = MO - elems ( base + 8 ) = NO - elems ( base + 9 ) = EPOCH - - The meaning of these variables is defined by the - format of the two-line element files available from - NORAD. - - epochs contains the epochs (ephemeris seconds past J2000) - corresponding to the elements in elems. The I'th - epoch must equal the epoch of the I'th element set - Epochs must form a strictly increasing sequence. - --Detailed_Output - - None. The data input is stored in an SPK segment in the - DAF connected to the input handle. - --Parameters - - None. - --Particulars - - This routine writes a type 10 SPK segment to the DAF open - for writing that is attached to handle. A routine, GETELM, that - reads two-line element data from files distributed by - NORAD is available from NAIF. - --Examples - - Suppose that you have collected the two-line element data - and geophysical constants as prescribed above. The following - code fragment demonstrates how you could go about creating - a type 10 SPK segment. - - #include "SpiceUsr.h" - . - . - . - /. - Open a new SPK file using DAF and get a file handle. - ./ - body = ; - center = ; - frame = "J2000"; - segid = ; - - fname = "SAMPLE.SPK"; - ifname = "SAMPLE SPK FILE FOR PRIVATE USE"; - ncomch = 0; - - void spkopn_c ( fname, ifname, ncomch, &handle ); - - /. - Add the type 10 data. - ./ - spkw10_c ( handle, body, center, frame, first, last, - segid, consts, n, elems, epochs ); - - /. - Close the SPK properly. - ./ - spkcls_c ( handle ); - - - --Restrictions - - None. - --Exceptions - - 1) Errors in the structure or content of the inputs must be - diagnosed by routines called by this one. - - 2) File access errors are diagnosed by routines in the - call tree of this routine. - - 3) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 4) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 30-OCT-2006 (BVS) - - Deleted "inertial" from the FRAME description in the Brief_I/O - section of the header. - - -CSPICE Version 1.0.0, 29-JUN-1999 (NJB) (WLT) - --Index_Entries - - write a type_10 spk segment - --& -*/ - -{ /* Begin spkw10_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw10_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw10_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw10_c", segid ); - - - /* - Write the segment. - */ - spkw10_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( doublereal * ) consts, - ( integer * ) &n, - ( doublereal * ) elems, - ( doublereal * ) epochs, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw10_c" ); - -} /* End spkw10_c */ diff --git a/ext/spice/src/cspice/spkw12.c b/ext/spice/src/cspice/spkw12.c deleted file mode 100644 index 6e1296a6d8..0000000000 --- a/ext/spice/src/cspice/spkw12.c +++ /dev/null @@ -1,472 +0,0 @@ -/* spkw12.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__12 = 12; -static integer c__1 = 1; - -/* $Procedure SPKW12 ( Write SPK segment, type 12 ) */ -/* Subroutine */ int spkw12_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - integer *degree, integer *n, doublereal *states, doublereal *epoch1, - doublereal *step, ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - extern logical even_(integer *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *), dafbna_(integer *, doublereal *, char *, ftnlen), - dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), spkpds_(integer *, integer *, char *, integer *, - doublereal *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - integer winsiz; - -/* $ Abstract */ - -/* Write a type 12 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I NAIF code for an ephemeris object. */ -/* CENTER I NAIF code for center of motion of BODY. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* DEGREE I Degree of interpolating polynomials. */ -/* N I Number of states. */ -/* STATES I Array of states. */ -/* EPOCH1 I Epoch of first state in STATES array. */ -/* STEP I Time step separating epochs of states. */ -/* MAXDEG P Maximum allowed degree of interpolating polynomial. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose state relative to another body is described */ -/* by the segment to be created. */ - -/* CENTER is the NAIF integer code for the center of motion */ -/* of the object identified by BODY. */ - -/* FRAME is the NAIF name for a reference frame */ -/* relative to which the state information for BODY */ -/* is specified. */ - -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the state of BODY. */ - -/* SEGID is the segment identifier. An SPK segment */ -/* identifier may contain up to 40 characters. */ - -/* DEGREE is the degree of the Lagrange polynomials used to */ -/* interpolate the states. All components of the */ -/* state vectors are interpolated by polynomials of */ -/* fixed degree. */ - -/* N is the number of states in the input state vector */ -/* array. */ - -/* STATES contains a time-ordered array of geometric states */ -/* ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and */ -/* kilometers per second ) of BODY relative to CENTER, */ -/* specified relative to FRAME. */ - -/* EPOCH1 is the epoch corresponding to the first state in */ -/* the state array. Because extra states are needed */ -/* at the beginning and end of the segment in order */ -/* for the interpolation method to work, EPOCH1 will */ -/* normally precede FIRST. */ - -/* STEP is the time step separating the epochs of adjacent */ -/* states in the input state array. STEP is specified */ -/* in seconds. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* MAXDEG is the maximum allowed degree of the interpolating */ -/* polynomial. If the value of MAXDEG is increased, */ -/* the SPICELIB routine SPKPV must be changed */ -/* accordingly. In particular, the size of the */ -/* record passed to SPKRnn and SPKEnn must be */ -/* increased, and comments describing the record size */ -/* must be changed. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If FRAME is not a recognized name, the error */ -/* SPICE(INVALIDREFFRAME) is signaled. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signaled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signaled. */ - -/* 4) If DEGREE is not at least 1 or is greater than MAXDEG, the */ -/* error SPICE(INVALIDDEGREE) is signaled. */ - -/* 5) If DEGREE is not odd, the error SPICE(INVALIDDEGREE) is */ -/* signaled. */ - -/* 6) If the number of states N is not at least (DEGREE+1)/2, the */ -/* error SPICE(TOOFEWSTATES) will be signaled. */ - -/* 7) If FIRST is greater than LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 8) If STEP is non-positive, the error SPICE(INVALIDSTEPSIZE) will */ -/* be signaled. */ - -/* 9) If the first epoch EPOCH1 is greater than FIRST, the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 10) If the last epoch */ - -/* FIRST + (N-1)*STEP */ - -/* is less than LAST, the error SPICE(BADDESCRTIMES) will be */ -/* signaled. */ - -/* $ Files */ - -/* A new type 12 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 12 data segment to the open SPK */ -/* file according to the format described in the type 12 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have states and are prepared to produce */ -/* a segment of type 12 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_12_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW12 ( HANDLE, BODY, CENTER, FRAME, */ -/* . FIRST, LAST, SEGID, DEGREE, */ -/* . N, STATES, EPOCH1, STEP ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-FEB-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_12 ephemeris data segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* SIDLEN is the maximum number of characters allowed in an */ -/* SPK segment identifier. */ - -/* NS is the size of a packed SPK segment descriptor. */ - -/* ND is the number of double precision components in an SPK */ -/* segment descriptor. */ - -/* NI is the number of integer components in an SPK segment */ -/* descriptor. */ - -/* DTYPE is the data type. */ - -/* FPRINT is the integer value of the first printable ASCII */ -/* character. */ - -/* LPRINT is the integer value of the last printable ASCII character. */ - - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW12", (ftnlen)6); - } - -/* Set the window size corresponding to the input degree. This */ -/* size will be used in various places below. */ - - winsiz = (*degree + 1) / 2; - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* Check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - } - -/* Make sure that the degree of the interpolating polynomials is */ -/* in range. */ - - if (*degree < 1 || *degree > 15) { - setmsg_("The interpolating polynomials have degree #; the valid degr" - "ee range is [1, #]", (ftnlen)77); - errint_("#", degree, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* Make sure that the degree of the interpolating polynomials is odd. */ - - if (even_(degree)) { - setmsg_("The interpolating polynomials have degree #; for SPK type 1" - "3, the degree must be odd.", (ftnlen)85); - errint_("#", degree, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* Make sure that the number of states is sufficient to define a */ -/* polynomial whose degree is DEGREE. */ - - if (*n < winsiz) { - setmsg_("At least # states are required to define a Hermite polynomi" - "al of degree #. Number of states supplied: #", (ftnlen)105); - errint_("#", &winsiz, (ftnlen)1); - errint_("#", degree, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(TOOFEWSTATES)", (ftnlen)19); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first >= *last) { - setmsg_("The segment start time: # is greater then the segment end t" - "ime: #", (ftnlen)65); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* The step size must be positive. */ - - if (*step <= 0.) { - setmsg_("The step size must be > 0 but was #. ", (ftnlen)37); - errdp_("#", step, (ftnlen)1); - sigerr_("SPICE(INVALIDSTEPSIZE)", (ftnlen)22); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* Make sure that the span of the input epochs includes the interval */ -/* defined by the segment descriptor. */ - - if (*epoch1 > *first) { - setmsg_("Segment start time # precedes first epoch #.", (ftnlen)44); - errdp_("#", first, (ftnlen)1); - errdp_("#", epoch1, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW12", (ftnlen)6); - return 0; - } else if (*epoch1 + (*n - 1) * *step < *last) { - setmsg_("Segment end time # follows last epoch #.", (ftnlen)40); - errdp_("#", last, (ftnlen)1); - d__1 = *epoch1 + (*n - 1) * *step; - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* If we made it this far, we're ready to start writing the segment. */ - - -/* Create the segment descriptor. */ - - spkpds_(body, center, frame, &c__12, first, last, descr, frame_len); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW12", (ftnlen)6); - return 0; - } - -/* The type 12 segment structure is eloquently described by this */ -/* diagram from the SPK Required Reading: */ - -/* +-----------------------+ */ -/* | State 1 | */ -/* +-----------------------+ */ -/* | State 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | State N | */ -/* +-----------------------+ */ -/* | Epoch of state 1 (ET) | */ -/* +-----------------------+ */ -/* | Step size | */ -/* +-----------------------+ */ -/* | Window size - 1 | */ -/* +-----------------------+ */ -/* | Number of states | */ -/* +-----------------------+ */ - - - i__1 = *n * 6; - dafada_(states, &i__1); - dafada_(epoch1, &c__1); - dafada_(step, &c__1); - d__1 = (doublereal) (winsiz - 1); - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW12", (ftnlen)6); - return 0; -} /* spkw12_ */ - diff --git a/ext/spice/src/cspice/spkw12_c.c b/ext/spice/src/cspice/spkw12_c.c deleted file mode 100644 index 7b7ee36a0f..0000000000 --- a/ext/spice/src/cspice/spkw12_c.c +++ /dev/null @@ -1,296 +0,0 @@ -/* - --Procedure spkw12_c ( Write SPK segment, type 12 ) - --Abstract - - Write a type 12 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - TIME - --Keywords - - EPHEMERIS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef spkw12_c - - - void spkw12_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch0, - SpiceDouble step ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I NAIF code for an ephemeris object. - center I NAIF code for center of motion of body. - frame I Reference frame name. - first I Start time of interval covered by segment. - last I End time of interval covered by segment. - segid I Segment identifier. - degree I Degree of interpolating polynomials. - n I Number of states. - states I Array of states. - epoch0 I Epoch of first state in states array. - step I Time step separating epochs of states. - MAXDEG P Maximum allowed degree of interpolating polynomial. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF integer code for an ephemeris object - whose state relative to another body is described - by the segment to be created. - - center is the NAIF integer code for the center of motion - of the object identified by body. - - frame is the NAIF name for a reference frame - relative to which the state information for body - is specified. - - first, - last are, respectively, the start and stop times of - the time interval over which the segment defines - the state of body. - - segid is the segment identifier. An SPK segment - identifier may contain up to 40 characters. - - degree is the degree of the Hermite polynomials used to - interpolate the states. All components of the - state vectors are interpolated by polynomials of - fixed degree. - - n is the number of states in the input state vector - array. - - states contains a time-ordered array of geometric states - ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and - kilometers per second ) of body relative to center, - specified relative to frame. - - epoch0 is the epoch corresponding to the first state in - the state array. Because extra states are needed - at the beginning and end of the segment in order - for the interpolation method to work, epoch0 will - normally precede first. - - step is the time step separating the epochs of adjacent - states in the input state array. step is specified - in seconds. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - MAXDEG is the maximum allowed degree of the interpolating - polynomial. If the value of MAXDEG is increased, - the SPICELIB routine SPKPVN must be changed - accordingly. In particular, the size of the - record passed to SPKRnn and SPKEnn must be - increased, and comments describing the record size - must be changed. - --Exceptions - - If any of the following exceptions occur, this routine will return - without creating a new segment. - - 1) If frame is not a recognized name, the error - SPICE(INVALIDREFFRAME) is signaled. - - 2) If the last non-blank character of segid occurs past index 40, - the error SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If degree is not at least 1 or is greater than MAXDEG, the - error SPICE(INVALIDDEGREE) is signaled. - - 5) If degree is not odd, the error SPICE(INVALIDDEGREE) is - signaled. - - 6) If the number of states n is not at least (degree+1)/2, - the error SPICE(TOOFEWSTATES) will be signaled. - - 7) If first is greater than or equal to last then the error - SPICE(BADDESCRTIMES) will be signaled. - - 8) If step is non-positive, the error SPICE(INVALIDSTEPSIZE) will - be signaled. - - 9) If the first epoch epoch0 is greater than first, the error - SPICE(BADDESCRTIMES) will be signaled. - - 10) If the last epoch - - first + (n-1)*step - - is less than last, the error SPICE(BADDESCRTIMES) will be - signaled. - - 11) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 12) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - - --Files - - A new type 12 SPK segment is written to the SPK file attached - to HANDLE. - --Particulars - - This routine writes an SPK type 12 data segment to the open SPK - file according to the format described in the type 12 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that you have states and are prepared to produce - a segment of type 12 in an SPK file. - - The following code fragment could be used to add the new segment - to a previously opened SPK file attached to handle. The file must - have been opened with write access. - - #include "SpiceUsr.h" - . - . - . - - /. - Create a segment identifier. - ./ - #define SEGID "MY_SAMPLE_SPK_TYPE_12_SEGMENT" - - - /. - Write the segment. - ./ - - spkw12_c ( handle, body, center, frame, - first, last, segid, degree, - n, states, epoch0, step ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 23-FEB-2000 (NJB) - --Index_Entries - - write spk type_12 ephemeris data segment - --& -*/ - -{ /* Begin spkw12_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw12_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw12_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw12_c", segid ); - - - /* - Write the segment. - */ - spkw12_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( integer * ) °ree, - ( integer * ) &n, - ( doublereal * ) states, - ( doublereal * ) &epoch0, - ( doublereal * ) &step, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw12_c" ); - -} /* End spkw12_c */ diff --git a/ext/spice/src/cspice/spkw13.c b/ext/spice/src/cspice/spkw13.c deleted file mode 100644 index 3cf30febc1..0000000000 --- a/ext/spice/src/cspice/spkw13.c +++ /dev/null @@ -1,476 +0,0 @@ -/* spkw13.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__13 = 13; -static integer c__1 = 1; - -/* $Procedure SPKW13 ( Write SPK segment, type 13 ) */ -/* Subroutine */ int spkw13_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - integer *degree, integer *n, doublereal *states, doublereal *epochs, - ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - extern logical even_(integer *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *), dafbna_(integer *, doublereal *, char *, ftnlen), - dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal maxtim; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), spkpds_(integer *, integer *, char *, integer - *, doublereal *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - integer winsiz; - -/* $ Abstract */ - -/* Write a type 13 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I NAIF code for an ephemeris object. */ -/* CENTER I NAIF code for center of motion of BODY. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* DEGREE I Degree of interpolating polynomials. */ -/* N I Number of states. */ -/* STATES I Array of states. */ -/* EPOCHS I Array of epochs corresponding to states. */ -/* MAXDEG P Maximum allowed degree of interpolating polynomial. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose state relative to another body is described */ -/* by the segment to be created. */ - -/* CENTER is the NAIF integer code for the center of motion */ -/* of the object identified by BODY. */ - -/* FRAME is the NAIF name for a reference frame */ -/* relative to which the state information for BODY */ -/* is specified. */ - -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the state of BODY. */ - -/* SEGID is the segment identifier. An SPK segment */ -/* identifier may contain up to 40 characters. */ - -/* DEGREE is the degree of the Hermite polynomials used to */ -/* interpolate the states. All components of the */ -/* state vectors are interpolated by polynomials of */ -/* fixed degree. */ - -/* N is the number of states in the input state vector */ -/* array. */ - -/* STATES contains a time-ordered array of geometric states */ -/* ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and */ -/* kilometers per second ) of BODY relative to CENTER, */ -/* specified relative to FRAME. */ - -/* EPOCHS is an array of epochs corresponding to the members */ -/* of the state array. The epochs are specified as */ -/* seconds past J2000, TDB. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* MAXDEG is the maximum allowed degree of the interpolating */ -/* polynomial. If the value of MAXDEG is increased, */ -/* the SPICELIB routine SPKPV must be changed */ -/* accordingly. In particular, the size of the */ -/* record passed to SPKRnn and SPKEnn must be */ -/* increased, and comments describing the record size */ -/* must be changed. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If FRAME is not a recognized name, the error */ -/* SPICE(INVALIDREFFRAME) is signaled. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signaled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signaled. */ - -/* 4) If DEGREE is not at least 1 or is greater than MAXDEG, the */ -/* error SPICE(INVALIDDEGREE) is signaled. */ - -/* 5) If DEGREE is not odd, the error SPICE(INVALIDDEGREE) is */ -/* signaled. */ - -/* 6) If the number of states N is not at least (DEGREE+1)/2, */ -/* the error SPICE(TOOFEWSTATES) will be signaled. */ - -/* 7) If FIRST is greater than or equal to LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 8) If the elements of the array EPOCHS are not in strictly */ -/* increasing order, the error SPICE(TIMESOUTOFORDER) will be */ -/* signaled. */ - -/* 9) If the first epoch EPOCHS(1) is greater than FIRST, the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 10) If the last epoch EPOCHS(N) is less than LAST, the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - - -/* $ Files */ - -/* A new type 13 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 13 data segment to the open SPK */ -/* file according to the format described in the type 13 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have states and are prepared to produce */ -/* a segment of type 13 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_13_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW13 ( HANDLE, BODY, CENTER, FRAME, */ -/* . FIRST, LAST, SEGID, DEGREE, */ -/* . N, STATES, EPOCHS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-MAR-2000 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_13 ephemeris data segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW13", (ftnlen)6); - } - -/* Set the window size corresponding to the input degree. This */ -/* size will be used in various places below. */ - - winsiz = (*degree + 1) / 2; - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* Check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - } - -/* Make sure that the degree of the interpolating polynomials is */ -/* in range. */ - - if (*degree < 1 || *degree > 15) { - setmsg_("The interpolating polynomials have degree #; the valid degr" - "ee range is [1, #]", (ftnlen)77); - errint_("#", degree, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* Make sure that the degree of the interpolating polynomials is odd. */ - - if (even_(degree)) { - setmsg_("The interpolating polynomials have degree #; for SPK type 1" - "3, the degree must be odd.", (ftnlen)85); - errint_("#", degree, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* Make sure that the number of states is sufficient to define a */ -/* polynomial whose degree is DEGREE. */ - - if (*n < winsiz) { - setmsg_("At least # states are required to define a Hermite polynomi" - "al of degree #. Number of states supplied: #", (ftnlen)105); - errint_("#", &winsiz, (ftnlen)1); - errint_("#", degree, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(TOOFEWSTATES)", (ftnlen)19); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater then the begin time. */ - - if (*first >= *last) { - setmsg_("The segment start time: # is greater then the segment end t" - "ime: #", (ftnlen)65); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* Make sure the epochs form a strictly increasing sequence. */ - - maxtim = epochs[0]; - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - if (epochs[i__ - 1] <= maxtim) { - setmsg_("EPOCH # having index # is not greater than its predeces" - "sor #.", (ftnlen)61); - errdp_("#", &epochs[i__ - 1], (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &epochs[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("SPKW13", (ftnlen)6); - return 0; - } else { - maxtim = epochs[i__ - 1]; - } - } - -/* Make sure that the span of the input epochs includes the interval */ -/* defined by the segment descriptor. */ - - if (epochs[0] > *first) { - setmsg_("Segment start time # precedes first epoch #.", (ftnlen)44); - errdp_("#", first, (ftnlen)1); - errdp_("#", epochs, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW13", (ftnlen)6); - return 0; - } else if (epochs[*n - 1] < *last) { - setmsg_("Segment end time # follows last epoch #.", (ftnlen)40); - errdp_("#", last, (ftnlen)1); - errdp_("#", &epochs[*n - 1], (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* If we made it this far, we're ready to start writing the segment. */ - - -/* Create the segment descriptor. */ - - spkpds_(body, center, frame, &c__13, first, last, descr, frame_len); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW13", (ftnlen)6); - return 0; - } - -/* The type 13 segment structure is eloquently described by this */ -/* diagram from the SPK Required Reading: */ - -/* +-----------------------+ */ -/* | State 1 | */ -/* +-----------------------+ */ -/* | State 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | State N | */ -/* +-----------------------+ */ -/* | Epoch 1 | */ -/* +-----------------------+ */ -/* | Epoch 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch N | */ -/* +-----------------------+ */ -/* | Epoch 100 | (First directory) */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch ((N-1)/100)*100 | (Last directory) */ -/* +-----------------------+ */ -/* | Window size - 1 | */ -/* +-----------------------+ */ -/* | Number of states | */ -/* +-----------------------+ */ - - - i__1 = *n * 6; - dafada_(states, &i__1); - dafada_(epochs, n); - i__1 = (*n - 1) / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&epochs[i__ * 100 - 1], &c__1); - } - d__1 = (doublereal) (winsiz - 1); - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW13", (ftnlen)6); - return 0; -} /* spkw13_ */ - diff --git a/ext/spice/src/cspice/spkw13_c.c b/ext/spice/src/cspice/spkw13_c.c deleted file mode 100644 index 6cf88f2f7e..0000000000 --- a/ext/spice/src/cspice/spkw13_c.c +++ /dev/null @@ -1,284 +0,0 @@ -/* - --Procedure spkw13_c ( Write SPK segment, type 13 ) - --Abstract - - Write a type 13 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - TIME - --Keywords - - EPHEMERIS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef spkw13_c - - - void spkw13_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I NAIF code for an ephemeris object. - center I NAIF code for center of motion of body. - frame I Reference frame name. - first I Start time of interval covered by segment. - last I End time of interval covered by segment. - segid I Segment identifier. - degree I Degree of interpolating polynomials. - n I Number of states. - states I Array of states. - epochs I Array of epochs corresponding to states. - MAXDEG P Maximum allowed degree of interpolating polynomial. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF integer code for an ephemeris object - whose state relative to another body is described - by the segment to be created. - - center is the NAIF integer code for the center of motion - of the object identified by body. - - frame is the NAIF name for a reference frame - relative to which the state information for body - is specified. - - first, - last are, respectively, the start and stop times of - the time interval over which the segment defines - the state of body. - - segid is the segment identifier. An SPK segment - identifier may contain up to 40 characters. - - degree is the degree of the Hermite polynomials used to - interpolate the states. All components of the - state vectors are interpolated by polynomials of - fixed degree. - - n is the number of states in the input state vector - array. - - states contains a time-ordered array of geometric states - ( x, y, z, dx/dt, dy/dt, dz/dt, in kilometers and - kilometers per second ) of body relative to center, - specified relative to frame. - - epochs is an array of epochs corresponding to the members - of the state array. The epochs are specified as - seconds past J2000, TDB. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - MAXDEG is the maximum allowed degree of the interpolating - polynomial. If the value of MAXDEG is increased, - the SPICELIB routine SPKPVN must be changed - accordingly. In particular, the size of the - record passed to SPKRnn and SPKEnn must be - increased, and comments describing the record size - must be changed. - --Exceptions - - If any of the following exceptions occur, this routine will return - without creating a new segment. - - 1) If frame is not a recognized name, the error - SPICE(INVALIDREFFRAME) is signaled. - - 2) If the last non-blank character of segid occurs past index 40, - the error SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If degree is not at least 1 or is greater than MAXDEG, the - error SPICE(INVALIDDEGREE) is signaled. - - 5) If degree is not odd, the error SPICE(INVALIDDEGREE) is - signaled. - - 6) If the number of states n is not at least (degree+1)/2, - the error SPICE(TOOFEWSTATES) will be signaled. - - 7) If first is greater than or equal to last then the error - SPICE(BADDESCRTIMES) will be signaled. - - 8) If the elements of the array epochs are not in strictly - increasing order, the error SPICE(TIMESOUTOFORDER) will be - signaled. - - 9) If the first epoch epochs[0] is greater than first, the error - SPICE(BADDESCRTIMES) will be signaled. - - 10) If the last epoch epochs[n-1] is less than last, the error - SPICE(BADDESCRTIMES) will be signaled. - - 11) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 12) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - - --Files - - A new type 13 SPK segment is written to the SPK file attached - to HANDLE. - --Particulars - - This routine writes an SPK type 13 data segment to the open SPK - file according to the format described in the type 13 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that you have states and are prepared to produce - a segment of type 13 in an SPK file. - - The following code fragment could be used to add the new segment - to a previously opened SPK file attached to handle. The file must - have been opened with write access. - - #include "SpiceUsr.h" - . - . - . - - /. - Create a segment identifier. - ./ - #define SEGID "MY_SAMPLE_SPK_TYPE_13_SEGMENT" - - - /. - Write the segment. - ./ - - spkw13_c ( handle, body, center, frame, - first, last, segid, degree, - n, states, epochs ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 15-FEB-2000 (NJB) - --Index_Entries - - write spk type_13 ephemeris data segment - --& -*/ - -{ /* Begin spkw13_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw13_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw13_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw13_c", segid ); - - - /* - Write the segment. - */ - spkw13_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( integer * ) °ree, - ( integer * ) &n, - ( doublereal * ) states, - ( doublereal * ) epochs, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw13_c" ); - -} /* End spkw13_c */ diff --git a/ext/spice/src/cspice/spkw15.c b/ext/spice/src/cspice/spkw15.c deleted file mode 100644 index a2acdd8808..0000000000 --- a/ext/spice/src/cspice/spkw15.c +++ /dev/null @@ -1,501 +0,0 @@ -/* spkw15.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__16 = 16; - -/* $Procedure SPKW15 ( SPK, write a type 15 segment ) */ -/* Subroutine */ int spkw15_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, - doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, - doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen - segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal mypa[3]; - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal mytp[3]; - integer i__; - doublereal angle; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - integer value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( - integer *, doublereal *, char *, ftnlen), dafena_(void); - extern logical failed_(void); - doublereal record[16]; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), spkpds_(integer *, integer *, char *, integer *, - doublereal *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - extern doublereal dpr_(void); - doublereal dot; - -/* $ Abstract */ - -/* Write an SPK segment of type 15 given a type 15 data record. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I Body code for ephemeris object. */ -/* CENTER I Body code for the center of motion of the body. */ -/* FRAME I The reference frame of the states. */ -/* FIRST I First valid time for which states can be computed. */ -/* LAST I Last valid time for which states can be computed. */ -/* SEGID I Segment identifier. */ -/* EPOCH I Epoch of the periapse. */ -/* TP I Trajectory pole vector. */ -/* PA I Periapsis vector. */ -/* P I Semi-latus rectum. */ -/* ECC I Eccentricity. */ -/* J2FLG I J2 processing flag. */ -/* PV I Central body pole vector. */ -/* GM I Central body GM. */ -/* J2 I Central body J2. */ -/* RADIUS I Equatorial radius of central body. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF ID for the body whose states are */ -/* to be recorded in an SPK file. */ - -/* CENTER is the NAIF ID for the center of motion associated */ -/* with BODY. */ - -/* FRAME is the reference frame that states are referenced to, */ -/* for example 'J2000'. */ - -/* FIRST are the bounds on the ephemeris times, expressed as */ -/* LAST seconds past J2000. */ - -/* SEGID is the segment identifier. An SPK segment identifier */ -/* may contain up to 40 characters. */ - -/* EPOCH is the epoch of the orbit elements at periapse */ -/* in ephemeris seconds past J2000. */ - -/* TP is a unit vector parallel to the angular momentum */ -/* vector of the orbit at epoch expressed relative to */ -/* FRAME. */ - -/* PA is a unit vector parallel to the position vector */ -/* of the trajectory at periapsis of EPOCH expressed */ -/* relative to FRAME. */ - -/* P is the semi-latus rectum--- p in the equation: */ - -/* r = p/(1 + ECC*COS(Nu)) */ - -/* ECC is the eccentricity. */ - -/* J2FLG is the J2 processing flag describing what J2 */ -/* corrections are to be applied when the orbit is */ -/* propagated. */ - -/* All J2 corrections are applied if the value of J2FLG */ -/* is not 1, 2 or 3. */ - -/* If the value of the flag is 3 no corrections are */ -/* done. */ - -/* If the value of the flag is 1 no corrections are */ -/* computed for the precession of the line of apsides. */ -/* However, regression of the line of nodes is */ -/* performed. */ - -/* If the value of the flag is 2 no corrections are */ -/* done for the regression of the line of nodes. */ -/* However, precession of the line of apsides is */ -/* performed. */ - -/* Note that J2 effects are computed only if the orbit */ -/* is elliptic and does not intersect the central body. */ - -/* PV is a unit vector parallel to the north pole vector */ -/* of the central body expressed relative to FRAME. */ - -/* GM is the central body GM. */ - -/* J2 is the central body J2 (dimensionless). */ - -/* RADIUS is the equatorial radius of the central body. */ - -/* Units are radians, km, seconds. */ - -/* $ Detailed_Output */ - -/* None. A type 15 segment is written to the file attached */ -/* to HANDLE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the eccentricity is less than zero, the error */ -/* 'SPICE(BADECCENTRICITY)' will be signalled. */ - -/* 2) If the semi-latus rectum is 0, the error */ -/* 'SPICE(BADLATUSRECTUM)' is signalled. */ - -/* 3) If the pole vector, trajectory pole vector or periapsis vector */ -/* have zero length, the error 'SPICE(BADVECTOR)' is signalled. */ - -/* 4) If the trajectory pole vector and the periapsis vector are */ -/* not orthogonal, the error 'SPICE(BADINITSTATE)' is signalled. */ -/* The test for orthogonality is very crude. The routine simply */ -/* checks that the dot product of the unit vectors parallel */ -/* to the trajectory pole and periapse vectors is less than */ -/* 0.00001. This check is intended to catch blunders, not to */ -/* enforce orthogonality to double precision capacity. */ - -/* 5) If the mass of the central body is non-positive, the error */ -/* 'SPICE(NONPOSITIVEMASS)' is signalled. */ - -/* 6) If the radius of the central body is negative, the error */ -/* 'SPICE(BADRADIUS)' is signalled. */ - -/* 7) If the segment identifier has more than 40 non-blank characters */ -/* the error 'SPICE(SEGIDTOOLONG)' is signalled. */ - -/* 8) If the segment identifier contains non-printing characters */ -/* the error 'SPICE(NONPRINTABLECHARS)' is signalled. */ - -/* 9) If there are inconsistencies in the BODY, CENTER, FRAME or */ -/* FIRST and LAST times, the problem will be diagnosed by */ -/* a routine in the call tree of this routine. */ - -/* $ Files */ - -/* A new type 15 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 15 data segment to the open SPK */ -/* file according to the format described in the type 15 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* This routine is provided to provide direct support for the MASL */ -/* precessing orbit formulation. */ - -/* $ Examples */ - -/* Suppose that at time EPOCH you have the J2000 periapsis */ -/* state of some object relative to some central body and would */ -/* like to create a type 15 SPK segment to model the motion of */ -/* the object using simple regression and precession of the */ -/* line of nodes and apsides. The following code fragment */ -/* illustrates how you can prepare such a segment. We shall */ -/* assume that you have in hand the J2000 direction of the */ -/* central body's pole vector, its GM, J2 and equatorial */ -/* radius. In addition we assume that you have opened an SPK */ -/* file for write access and that it is attached to HANDLE. */ - -/* (If your state is at an epoch other than periapse the */ -/* fragment below will NOT produce a "correct" type 15 segment */ -/* for modelling the motion of your object.) */ - -/* C */ -/* C First we get the osculating elements. */ -/* C */ -/* CALL OSCELT ( STATE, EPOCH, GM, ELTS ) */ - -/* C */ -/* C From these collect the eccentricity and semi-latus rectum. */ -/* C */ -/* ECC = ELTS ( 2 ) */ -/* P = ELTS ( 1 ) * ( 1.0D0 + ECC ) */ -/* C */ -/* C Next get the trajectory pole vector and the */ -/* C periapsis vector. */ -/* C */ -/* CALL UCRSS ( STATE(1), STATE(4), TP ) */ -/* CALL VHAT ( STATE(1), PA ) */ - -/* C */ -/* C Enable both J2 corrections. */ -/* C */ - -/* J2FLG = 0.0D0 */ - -/* C */ -/* C Now add the segment. */ -/* C */ - -/* CALL SPKW15 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ -/* . SEGID, EPOCH, TP, PA, P, ECC, */ -/* . J2FLG, PV, GM, J2, RADIUS ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 28-NOV-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Write a type 15 spk segment */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Segment descriptor size */ - - -/* Segment identifier size */ - - -/* SPK data type */ - - -/* Range of printing characters */ - - -/* Number of items in a segment */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKW15", (ftnlen)6); - -/* Fetch the various entities from the inputs and put them into */ -/* the data record, first the epoch. */ - - record[0] = *epoch; - -/* The trajectory pole vector. */ - - vequ_(tp, &record[1]); - -/* The periapsis vector. */ - - vequ_(pa, &record[4]); - -/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */ -/* and eccentricity. */ - - record[7] = *p; - record[8] = *ecc; - -/* J2 processing flag. */ - - record[9] = *j2flg; - -/* Central body pole vector. */ - - vequ_(pv, &record[10]); - -/* The central mass, J2 and radius of the central body. */ - - record[13] = *gm; - record[14] = *j2; - record[15] = *radius; - -/* Check all the inputs here for obvious failures. It's much */ -/* better to check them now and quit than it is to get a bogus */ -/* segment into an SPK file and diagnose it later. */ - - if (*p <= 0.) { - setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator" - " was non-positive. This value must be positive. The value s" - "upplied was #.", (ftnlen)133); - errdp_("#", p, (ftnlen)1); - sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21); - chkout_("SPKW15", (ftnlen)6); - return 0; - } else if (*ecc < 0.) { - setmsg_("The eccentricity supplied for a type 15 segment is negative" - ". It must be non-negative. The value supplied to the type 1" - "5 evaluator was #. ", (ftnlen)138); - errdp_("#", ecc, (ftnlen)1); - sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); - chkout_("SPKW15", (ftnlen)6); - return 0; - } else if (*gm <= 0.) { - setmsg_("The mass supplied for the central body of a type 15 segment" - " was non-positive. Masses must be positive. The value suppl" - "ied was #. ", (ftnlen)130); - errdp_("#", gm, (ftnlen)1); - sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22); - chkout_("SPKW15", (ftnlen)6); - return 0; - } else if (vzero_(tp)) { - setmsg_("The trajectory pole vector supplied to SPKW15 had length ze" - "ro. The most likely cause of this problem is an unititialize" - "d vector.", (ftnlen)128); - sigerr_("SPICE(BADVECTOR)", (ftnlen)16); - chkout_("SPKW15", (ftnlen)6); - return 0; - } else if (vzero_(pa)) { - setmsg_("The periapse vector supplied to SPKW15 had length zero. The" - " most likely cause of this problem is an unitialized vector.", - (ftnlen)119); - sigerr_("SPICE(BADVECTOR)", (ftnlen)16); - chkout_("SPKW15", (ftnlen)6); - return 0; - } else if (vzero_(pv)) { - setmsg_("The central pole vector supplied to SPKW15 had length zero." - " The most likely cause of this problem is an unitialized vec" - "tor. ", (ftnlen)124); - sigerr_("SPICE(BADVECTOR)", (ftnlen)16); - chkout_("SPKW15", (ftnlen)6); - return 0; - } else if (*radius < 0.) { - setmsg_("The central body radius was negative. It must be zero or po" - "sitive. The value supplied was #. ", (ftnlen)94); - errdp_("#", radius, (ftnlen)1); - sigerr_("SPICE(BADRADIUS)", (ftnlen)16); - chkout_("SPKW15", (ftnlen)6); - return 0; - } - -/* Convert TP and PA to unit vectors. */ - - vhat_(pa, mypa); - vhat_(tp, mytp); - -/* One final check. Make sure the pole and periapse vectors are */ -/* orthogonal. (We will use a very crude check but this should */ -/* rule out any obvious errors.) */ - - dot = vdot_(mypa, mytp); - if (abs(dot) > 1e-5) { - angle = vsep_(pa, tp) * dpr_(); - setmsg_("The periapsis and trajectory pole vectors are not orthogona" - "l. The angle between them is # degrees. ", (ftnlen)99); - errdp_("#", &angle, (ftnlen)1); - sigerr_("SPICE(BADINITSTATE)", (ftnlen)19); - chkout_("SPKW15", (ftnlen)6); - return 0; - } - -/* Make sure the segment identifier is not too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW15", (ftnlen)6); - return 0; - } - -/* Make sure it has only printing characters. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains the nonprintable charac" - "ter having ascii code #.", (ftnlen)79); - errint_("#", &value, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW15", (ftnlen)6); - return 0; - } - } - -/* All of the obvious checks have been performed on the input */ -/* record. Create the segment descriptor. (FIRST and LAST are */ -/* checked by SPKPDS as well as consistency between BODY and CENTER). */ - - spkpds_(body, center, frame, &c__15, first, last, descr, frame_len); - if (failed_()) { - chkout_("SPKW15", (ftnlen)6); - return 0; - } - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW15", (ftnlen)6); - return 0; - } - dafada_(record, &c__16); - if (! failed_()) { - dafena_(); - } - chkout_("SPKW15", (ftnlen)6); - return 0; -} /* spkw15_ */ - diff --git a/ext/spice/src/cspice/spkw15_c.c b/ext/spice/src/cspice/spkw15_c.c deleted file mode 100644 index a1af8fe0a8..0000000000 --- a/ext/spice/src/cspice/spkw15_c.c +++ /dev/null @@ -1,373 +0,0 @@ -/* - --Procedure spkw15_c ( SPK, write a type 15 segment ) - --Abstract - - Write an SPK segment of type 15 given a type 15 data record. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw15_c - - - void spkw15_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble tp [3], - ConstSpiceDouble pa [3], - SpiceDouble p, - SpiceDouble ecc, - SpiceDouble j2flg, - ConstSpiceDouble pv [3], - SpiceDouble gm, - SpiceDouble j2, - SpiceDouble radius ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I Body code for ephemeris object. - center I Body code for the center of motion of the body. - frame I The reference frame of the states. - first I First valid time for which states can be computed. - last I Last valid time for which states can be computed. - segid I Segment identifier. - epoch I Epoch of the periapse. - tp I Trajectory pole vector. - pa I Periapsis vector. - p I Semi-latus rectum. - ecc I Eccentricity. - j2flg I J2 processing flag. - pv I Central body pole vector. - gm I Central body GM. - j2 I Central body J2. - radius I Equatorial radius of central body. - --Detailed_Input - - - All units are radians, km, seconds. - - - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF ID for the body whose states are - to be recorded in an SPK file. - - center is the NAIF ID for the center of motion associated - with body. - - frame is the reference frame that states are referenced to, - for example "J2000". - - first are the bounds on the ephemeris times, expressed as - last seconds past J2000. - - segid is the segment identifier. An SPK segment identifier - may contain up to 40 characters. - - epoch is the epoch of the orbit elements at periapse - in ephemeris seconds past J2000. - - tp is a unit vector parallel to the angular momentum - vector of the orbit at epoch expressed relative to - frame. - - pa is a unit vector parallel to the position vector - of the trajectory at periapsis of epoch expressed - relative to frame. - - p is the semi-latus rectum---p in the equation: - - r = p/(1 + ecc*cos(Nu)) - - ecc is the eccentricity. - - j2flg is the J2 processing flag describing what J2 - corrections are to be applied when the orbit is - propagated. - - All J2 corrections are applied if the value of j2flg - is not 1, 2 or 3. - - If the value of the flag is 3 no corrections are - done. - - If the value of the flag is 1 no corrections are - computed for the precession of the line of apsides. - However, regression of the line of nodes is - performed. - - If the value of the flag is 2 no corrections are - done for the regression of the line of nodes. - However, precession of the line of apsides is - performed. - - Note that J2 effects are computed only if the orbit - is elliptic and does not intersect the central body. - - pv is a unit vector parallel to the north pole vector - of the central body expressed relative to frame. - - gm is the central body gm. - - j2 is the central body J2 (dimensionless). - - radius is the equatorial radius of the central body. - - --Detailed_Output - - None. A type 15 segment is written to the file attached - to handle. - --Parameters - - None. - --Exceptions - - 1) If the eccentricity is less than zero, the error - SPICE(BADECCENTRICITY) will be signaled. - - 2) If the semi-latus rectum is 0, the error - SPICE(BADLATUSRECTUM) is signaled. - - 3) If the pole vector, trajectory pole vector or periapsis vector - have zero length, the error SPICE(BADVECTOR) is signaled. - - 4) If the trajectory pole vector and the periapsis vector are - not orthogonal, the error SPICE(BADINITSTATE) is signaled. - The test for orthogonality is very crude. The routine simply - checks that the dot product of the unit vectors parallel - to the trajectory pole and periapse vectors is less than - 0.00001. This check is intended to catch blunders, not to - enforce orthogonality to double precision capacity. - - 5) If the mass of the central body is non-positive, the error - SPICE(NONPOSITIVEMASS) is signaled. - - 6) If the radius of the central body is negative, the error - SPICE(BADRADIUS) is signaled. - - 7) If the segment identifier has more than 40 non-blank characters - the error SPICE(SEGIDTOOLONG) is signaled. - - 8) If the segment identifier contains non-printing characters - the error SPICE(NONPRINTABLECHARS) is signaled. - - 9) If there are inconsistencies in the body, center, frame or - first and last times, the problem will be diagnosed by - a routine in the call tree of this routine. - - 10) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 11) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - --Files - - A new type 15 SPK segment is written to the SPK file attached - to handle. - --Particulars - - This routine writes an SPK type 15 data segment to the open SPK - file according to the format described in the type 15 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - - This routine is provided to provide direct support for the MASL - precessing orbit formulation. - --Examples - - Suppose that at time epoch you have the J2000 periapsis - state of some object relative to some central body and would - like to create a type 15 SPK segment to model the motion of - the object using simple regression and precession of the - line of nodes and apsides. The following code fragment - illustrates how you can prepare such a segment. We shall - assume that you have in hand the J2000 direction of the - central body's pole vector, its GM, J2 and equatorial - radius. In addition we assume that you have opened an SPK - file for write access and that it is attached to handle. - - (If your state is at an epoch other than periapse the - fragment below will NOT produce a "correct" type 15 segment - for modelling the motion of your object.) - - #include "SpiceUsr.h" - . - . - . - - /. - First we get the osculating elements. - / - oscelt_c ( state, epoch, gm, elts ); - - - /. - From these collect the eccentricity and semi-latus rectum. - ./ - ecc = elts [ 1 ]; - p = elts [ 0 ] * ( 1.0 + ecc ); - - - /. - Next get the trajectory pole vector and the - periapsis vector. - ./ - ucrss_c ( state, state+4, tp ); - vhat_c ( state, pa ); - - - /. - Enable both J2 corrections. - ./ - j2flg = 0.0; - - - /. - Now add the segment. - ./ - spkw15_c ( handle, body, center, frame, first, last, - segid, epoch, tp, pa, p, ecc, - j2flg, pv, gm, j2, radius ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 21-JUN-1999 - --Index_Entries - - Write a type 15 spk segment - --& -*/ - -{ /* Begin spkw15_c */ - - /* - Local constants - */ - - - /* - Local macros - */ - - - /* - Local variables - */ - - - /* - Static variables - */ - - - /* - Participate in error tracing. - */ - - chkin_c ( "spkw15_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw15_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw15_c", segid ); - - - /* - Write the segment. - */ - spkw15_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( doublereal * ) &epoch, - ( doublereal * ) tp, - ( doublereal * ) pa, - ( doublereal * ) &p, - ( doublereal * ) &ecc, - ( doublereal * ) &j2flg, - ( doublereal * ) pv, - ( doublereal * ) &gm, - ( doublereal * ) &j2, - ( doublereal * ) &radius, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw15_c" ); - -} /* End spkw15_c */ diff --git a/ext/spice/src/cspice/spkw17.c b/ext/spice/src/cspice/spkw17.c deleted file mode 100644 index 872b14135f..0000000000 --- a/ext/spice/src/cspice/spkw17.c +++ /dev/null @@ -1,416 +0,0 @@ -/* spkw17.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__17 = 17; -static integer c__12 = 12; - -/* $Procedure SPKW17 ( SPK, write a type 17 segment ) */ -/* Subroutine */ int spkw17_(integer *handle, integer *body, integer *center, - char *frame, doublereal *first, doublereal *last, char *segid, - doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal * - decpol, ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - doublereal a, h__; - integer i__; - doublereal k; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal descr[5]; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - integer value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( - doublereal *, integer *), dafbna_(integer *, doublereal *, char *, - ftnlen), dafena_(void); - extern logical failed_(void); - doublereal record[12]; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), spkpds_(integer *, integer *, char *, integer *, - doublereal *, doublereal *, doublereal *, ftnlen); - extern logical return_(void); - doublereal ecc; - -/* $ Abstract */ - -/* Write an SPK segment of type 17 given a type 17 data record. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* BODY I Body code for ephemeris object. */ -/* CENTER I Body code for the center of motion of the body. */ -/* FRAME I The reference frame of the states. */ -/* FIRST I First valid time for which states can be computed. */ -/* LAST I Last valid time for which states can be computed. */ -/* SEGID I Segment identifier. */ -/* EPOCH I Epoch of elements in seconds past J2000 */ -/* EQEL I Array of equinoctial elements */ -/* RAPOL I Right Ascension of the pole of the reference plane */ -/* DECPOL I Declination of the pole of the reference plane */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* BODY is the NAIF ID for the body whose states are */ -/* to be recorded in an SPK file. */ - -/* CENTER is the NAIF ID for the center of motion associated */ -/* with BODY. */ - -/* FRAME is the reference frame that states are referenced to, */ -/* for example 'J2000'. */ - -/* FIRST are the bounds on the ephemeris times, expressed as */ -/* LAST seconds past J2000. */ - -/* SEGID is the segment identifier. An SPK segment identifier */ -/* may contain up to 40 characters. */ - -/* EPOCH is the epoch of equinoctial elements in seconds */ -/* past the J2000 epoch. */ - -/* EQEL is an array of 9 double precision numbers that */ -/* are the equinoctial elements for some orbit relative */ -/* to the equatorial frame of a central body. */ - -/* ( The z-axis of the equatorial frame is the direction */ -/* of the pole of the central body relative to FRAME. */ -/* The x-axis is given by the cross product of the */ -/* Z-axis of FRAME with the direction of the pole of */ -/* the central body. The Y-axis completes a right */ -/* handed frame. ) */ - -/* The specific arrangement of the elements is spelled */ -/* out below. The following terms are used in the */ -/* discussion of elements of EQEL */ - -/* INC --- inclination of the orbit */ -/* ARGP --- argument of periapse */ -/* NODE --- longitude of the ascending node */ -/* E --- eccentricity of the orbit */ - -/* EQEL(1) is the semi-major axis (A) of the orbit in km. */ - -/* EQEL(2) is the value of H at the specified epoch. */ -/* ( E*SIN(ARGP+NODE) ). */ - -/* EQEL(3) is the value of K at the specified epoch */ -/* ( E*COS(ARGP+NODE) ). */ - -/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */ -/* the epoch of the elements measured in radians. */ - -/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */ -/* the specified epoch. */ - -/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */ -/* the specified epoch. */ - -/* EQEL(7) is the rate of the longitude of periapse */ -/* (dARGP/dt + dNODE/dt ) at the epoch of */ -/* the elements. This rate is assumed to hold */ -/* for all time. The rate is measured in */ -/* radians per second. */ - -/* EQEL(8) is the derivative of the mean longitude */ -/* ( dM/dt + dARGP/dt + dNODE/dt ). This */ -/* rate is assumed to be constant and is */ -/* measured in radians/second. */ - -/* EQEL(9) is the rate of the longitude of the ascending */ -/* node ( dNODE/dt). This rate is measured */ -/* in radians per second. */ - -/* RAPOL Right Ascension of the pole of the reference plane */ -/* relative to FRAME measured in radians. */ - -/* DECPOL Declination of the pole of the reference plane */ -/* relative to FRAME measured in radians. */ - -/* $ Detailed_Output */ - -/* None. A type 17 segment is written to the file attached */ -/* to HANDLE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the semi-major axis is less than or equal to zero, the error */ -/* 'SPICE(BADSEMIAXIS)' is signalled. */ - -/* 2) If the eccentricity of the orbit corresponding to the values */ -/* of H and K ( EQEL(2) and EQEL(3) ) is greater than 0.9 the */ -/* error 'SPICE(ECCOUTOFRANGE)' is signalled. */ - -/* 3) If the segment identifier has more than 40 non-blank characters */ -/* the error 'SPICE(SEGIDTOOLONG)' is signalled. */ - -/* 4) If the segment identifier contains non-printing characters */ -/* the error 'SPICE(NONPRINTABLECHARS)' is signalled. */ - -/* 5) If there are inconsistencies in the BODY, CENTER, FRAME or */ -/* FIRST and LAST times, the problem will be diagnosed by */ -/* a routine in the call tree of this routine. */ - -/* $ Files */ - -/* A new type 17 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 17 data segment to the open SPK */ -/* file according to the format described in the type 17 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that at time EPOCH you have the classical elements */ -/* of some BODY relative to the equatorial frame of some central */ -/* body CENTER. These can be converted to equinoctial elements */ -/* and stored in an SPK file as a type 17 segment so that this */ -/* body can be used within the SPK subsystem of the SPICE system. */ - -/* Below is a list of the variables used to represent the */ -/* classical elements */ - -/* Variable Meaning */ -/* -------- ---------------------------------- */ -/* A Semi-major axis in km */ -/* ECC Eccentricity of orbit */ -/* INC Inclination of orbit */ -/* NODE Longitude of the ascending node at epoch */ -/* OMEGA Argument of periapse at epoch */ -/* M Mean anomaly at epoch */ -/* DMDT Mean anomaly rate in radians/second */ -/* DNODE Rate of change of longitude of ascending node */ -/* in radians/second */ -/* DOMEGA Rate of change of argument of periapse in */ -/* radians/second */ -/* EPOCH is the epoch of the elements in seconds past */ -/* the J2000 epoch. */ - - -/* These elements are converted to equinoctial elements (in */ -/* the order compatible with type 17) as shown below. */ - -/* EQEL(1) = A */ -/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */ -/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */ - -/* EQEL(4) = M + OMEGA + NODE */ - -/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */ -/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */ - -/* EQEL(7) = DOMEGA */ -/* EQEL(8) = DOMEGA + DMDT + DNODE */ -/* EQEL(9) = DNODE */ - - -/* C */ -/* C Now add the segment. */ -/* C */ - -/* CALL SPKW17 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ -/* . SEGID, EPOCH, EQEL, RAPOL, DECPOL ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 24-Jun-1999 (WLT) */ - -/* Corrected typographical errors in the header. */ - -/* - SPICELIB Version 1.0.0, 8-Jan-1997 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Write a type 17 spk segment */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Segment descriptor size */ - - -/* Segment identifier size */ - - -/* SPK data type */ - - -/* Range of printing characters */ - - -/* Number of items in a segment */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SPKW17", (ftnlen)6); - -/* Fetch the various entities from the inputs and put them into */ -/* the data record, first the epoch. */ - - record[0] = *epoch; - -/* The trajectory pole vector. */ - - moved_(eqel, &c__9, &record[1]); - record[10] = *rapol; - record[11] = *decpol; - a = record[1]; - h__ = record[2]; - k = record[3]; - ecc = sqrt(h__ * h__ + k * k); - -/* Check all the inputs here for obvious failures. It's much */ -/* better to check them now and quit than it is to get a bogus */ -/* segment into an SPK file and diagnose it later. */ - - if (a <= 0.) { - setmsg_("The semimajor axis supplied to the SPK type 17 evaluator wa" - "s non-positive. This value must be positive. The value supp" - "lied was #.", (ftnlen)130); - errdp_("#", &a, (ftnlen)1); - sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18); - chkout_("SPKW17", (ftnlen)6); - return 0; - } else if (ecc > .9) { - setmsg_("The eccentricity supplied for a type 17 segment is greater " - "than 0.9. It must be less than 0.9.The value supplied to th" - "e type 17 evaluator was #. ", (ftnlen)146); - errdp_("#", &ecc, (ftnlen)1); - sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); - chkout_("SPKW17", (ftnlen)6); - return 0; - } - -/* Make sure the segment identifier is not too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW17", (ftnlen)6); - return 0; - } - -/* Make sure the segment identifier has only printing characters. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - value = *(unsigned char *)&segid[i__ - 1]; - if (value < 32 || value > 126) { - setmsg_("The segment identifier contains the nonprintable charac" - "ter having ascii code #.", (ftnlen)79); - errint_("#", &value, (ftnlen)1); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW17", (ftnlen)6); - return 0; - } - } - -/* All of the obvious checks have been performed on the input */ -/* record. Create the segment descriptor. (FIRST and LAST are */ -/* checked by SPKPDS as well as consistency between BODY and CENTER). */ - - spkpds_(body, center, frame, &c__17, first, last, descr, frame_len); - if (failed_()) { - chkout_("SPKW17", (ftnlen)6); - return 0; - } - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW17", (ftnlen)6); - return 0; - } - dafada_(record, &c__12); - if (! failed_()) { - dafena_(); - } - chkout_("SPKW17", (ftnlen)6); - return 0; -} /* spkw17_ */ - diff --git a/ext/spice/src/cspice/spkw17_c.c b/ext/spice/src/cspice/spkw17_c.c deleted file mode 100644 index c806938fc9..0000000000 --- a/ext/spice/src/cspice/spkw17_c.c +++ /dev/null @@ -1,328 +0,0 @@ -/* - --Procedure spkw17_c ( SPK, write a type 17 segment ) - --Abstract - - Write an SPK segment of type 17 given a type 17 data record. - --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 - - SPK - --Keywords - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef spkw17_c - - - void spkw17_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble eqel [9], - SpiceDouble rapol, - SpiceDouble decpol ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - body I Body code for ephemeris object. - center I Body code for the center of motion of the body. - frame I The reference frame of the states. - first I First valid time for which states can be computed. - last I Last valid time for which states can be computed. - segid I Segment identifier. - epoch I Epoch of elements in seconds past J2000. - eqel I Array of equinoctial elements. - rapol I Right Ascension of the pole of the reference plane. - decpol I Declination of the pole of the reference plane. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - body is the NAIF ID for the body whose states are - to be recorded in an SPK file. - - center is the NAIF ID for the center of motion associated - with body. - - frame is the reference frame that states are referenced to, - for example "J2000". - - first are the bounds on the ephemeris times, expressed as - last seconds past J2000. - - segid is the segment identifier. An SPK segment identifier - may contain up to 40 characters. - - epoch is the epoch of equinoctial elements in seconds - past the J2000 epoch. - - eqel is an array of 9 double precision numbers that - are the equinoctial elements for some orbit relative - to the equatorial frame of a central body. - - The z-axis of the equatorial frame is the direction - of the pole of the central body relative to frame. - The x-axis is given by the cross product of the - Z-axis of frame with the direction of the pole of - the central body. The Y-axis completes a right - handed frame. - - The specific arrangement of the elements is spelled - out below. The following terms are used in the - discussion of elements of eqel: - - inc --- inclination of the orbit - argp --- argument of periapse - node --- longitude of the ascending node - e --- eccentricity of the orbit - - eqel[0] is the semi-major axis (A) of the orbit in km. - - eqel[1] is the value of H at the specified epoch. - ( e*sin(argp+node) ). - - eqel[2] is the value of K at the specified epoch - ( e*cos(argp+node) ). - - eqel[3] is the mean longitude (mean0+argp+node) at - the epoch of the elements measured in radians. - - eqel[4] is the value of p (tan(inc/2)*sin(node)) at - the specified epoch. - - eqel[5] is the value of q (tan(inc/2)*cos(node)) at - the specified epoch. - - eqel[6] is the rate of the longitude of periapse - (dargp/dt + dnode/dt ) at the epoch of - the elements. This rate is assumed to hold - for all time. The rate is measured in - radians per second. - - eqel[7] is the derivative of the mean longitude - ( dm/dt + dargp/dt + dnode/dt ). This - rate is assumed to be constant and is - measured in radians/second. - - eqel[8] is the rate of the longitude of the ascending - node ( dnode/dt). This rate is measured - in radians per second. - - rapol Right Ascension of the pole of the reference plane - relative to frame measured in radians. - - DECPOL Declination of the pole of the reference plane - relative to frame measured in radians. - --Detailed_Output - - None. A type 17 segment is written to the file attached - to handle. - --Parameters - - None. - --Exceptions - - 1) If the semi-major axis is less than or equal to zero, the error - SPICE(BADSEMIAXIS) is signaled. - - 2) If the eccentricity of the orbit corresponding to the values - of H and K ( eqel[1] and eqel[2] ) is greater than 0.9 the - error SPICE(ECCOUTOFRANGE) is signaled. - - 3) If the segment identifier has more than 40 non-blank characters - the error SPICE(SEGIDTOOLONG) is signaled. - - 4) If the segment identifier contains non-printing characters - the error SPICE(NONPRINTABLECHARS) is signaled. - - 5) If there are inconsistencies in the body, center, frame or - first and last times, the problem will be diagnosed by - a routine in the call tree of this routine. - - 6) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 7) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - - --Files - - A new type 17 SPK segment is written to the SPK file attached - to HANDLE. - --Particulars - - This routine writes an SPK type 17 data segment to the open SPK - file according to the format described in the type 17 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that at time epoch you have the classical elements - of some body relative to the equatorial frame of some central - body CENTER. These can be converted to equinoctial elements - and stored in an SPK file as a type 17 segment so that this - body can be used within the SPK subsystem of the SPICE system. - - Below is a list of the variables used to represent the - classical elements - - Variable Meaning - -------- ---------------------------------- - a Semi-major axis in km - ecc Eccentricity of orbit - inc Inclination of orbit - node Longitude of the ascending node at epoch - omega Argument of periapse at epoch - m Mean anomaly at epoch - dmdt Mean anomaly rate in radians/second - dnode Rate of change of longitude of ascending node - in radians/second - domega Rate of change of argument of periapse in - radians/second - epoch is the epoch of the elements in seconds past - the J2000 epoch. - - - These elements are converted to equinoctial elements (in - the order compatible with type 17) as shown below. - - #include "SpiceUsr.h" - . - . - . - - eqel[0] = a; - eqel[1] = ecc * sin ( omega + node ); - eqel[2] = ecc * cos ( omega + node ); - - eqel[3] = m + omega + node; - - eqel[4] = tan(inc/2.0) * sin(node); - eqel[5] = tan(inc/2.0) * cos(node); - - eqel[6] = domega; - eqel[7] = domega + dmdt + dnode; - eqel[8] = dnode; - - - /. - Now add the segment. - ./ - - spkw17_c ( handle, body, center, frame, first, last, - segid, epoch, eqel, rapol, decpol ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 21-JUN-1999 (NJB) (WLT) - --Index_Entries - - Write a type 17 spk segment - --& -*/ - -{ /* Begin spkw17_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "spkw17_c" ); - - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw17_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw17_c", segid ); - - - /* - Write the segment. - */ - spkw17_ ( ( integer * ) &handle, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( doublereal * ) &epoch, - ( doublereal * ) eqel, - ( doublereal * ) &rapol, - ( doublereal * ) &decpol, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw17_c" ); - -} /* End spkw17_c */ diff --git a/ext/spice/src/cspice/spkw18.c b/ext/spice/src/cspice/spkw18.c deleted file mode 100644 index 06e6f15b49..0000000000 --- a/ext/spice/src/cspice/spkw18.c +++ /dev/null @@ -1,640 +0,0 @@ -/* spkw18.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure SPKW18 ( Write SPK segment, type 18 ) */ -/* Subroutine */ int spkw18_(integer *handle, integer *subtyp, integer *body, - integer *center, char *frame, doublereal *first, doublereal *last, - char *segid, integer *degree, integer *n, doublereal *packts, - doublereal *epochs, ftnlen frame_len, ftnlen segid_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, - integer *); - doublereal dc[2]; - extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, - ftnlen); - integer ic[6]; - extern /* Subroutine */ int dafena_(void); - extern logical failed_(void); - integer chrcod, refcod; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - integer packsz; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - doublereal maxtim; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - integer winsiz; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* Write a type 18 segment to an SPK file. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* SPC */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* FILES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to SPK type 18. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* SPK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */ - -/* -& */ - -/* SPK type 18 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 12-element packets, order */ -/* reduction at boundaries to preceding number */ -/* equivalent to 3 mod 4. */ - - -/* Subtype 1: Lagrange interpolation, 6-element packets, order */ -/* reduction at boundaries to preceding odd number. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of include file spk18.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of an SPK file open for writing. */ -/* SUBTYP I SPK type 18 subtype code. */ -/* BODY I NAIF code for an ephemeris object. */ -/* CENTER I NAIF code for center of motion of BODY. */ -/* FRAME I Reference frame name. */ -/* FIRST I Start time of interval covered by segment. */ -/* LAST I End time of interval covered by segment. */ -/* SEGID I Segment identifier. */ -/* DEGREE I Degree of interpolating polynomials. */ -/* N I Number of packets. */ -/* PACKTS I Array of packets. */ -/* EPOCHS I Array of epochs corresponding to packets. */ -/* MAXDEG P Maximum allowed degree of interpolating polynomial. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of an SPK file that has been */ -/* opened for writing. */ - -/* SUBTYP is an integer code indicating the subtype of the */ -/* the segment to be created. */ - -/* BODY is the NAIF integer code for an ephemeris object */ -/* whose state relative to another body is described */ -/* by the segment to be created. */ - -/* CENTER is the NAIF integer code for the center of motion */ -/* of the object identified by BODY. */ - -/* FRAME is the NAIF name for a reference frame */ -/* relative to which the state information for BODY */ -/* is specified. */ - -/* FIRST, */ -/* LAST are, respectively, the start and stop times of */ -/* the time interval over which the segment defines */ -/* the state of BODY. */ - -/* SEGID is the segment identifier. An SPK segment */ -/* identifier may contain up to 40 characters. */ - -/* DEGREE is the nominal degree of the polynomials used to */ -/* interpolate the states contained in the input */ -/* packets. All components of the state vectors are */ -/* interpolated by polynomials of the specified */ -/* degree, except near the segment boundaries, */ -/* or if the total number of states in the segment */ -/* is too few to allow interpolation using the */ -/* specified degree. */ - -/* If the actual interpolation degree is reduced, */ -/* the highest degree feasible degree valid for */ -/* the interpolation type is used. */ - -/* N is the number of packets in the input packet */ -/* array. */ - -/* PACKTS contains a time-ordered array of data packets */ -/* representing geometric states of BODY relative */ -/* to CENTER, specified relative to FRAME. The */ -/* packet structure depends on the segment subtype */ -/* as follows: */ - -/* Type 0 (indicated by code S18TP0): */ - -/* x, y, z, dx/dt, dy/dt, dz/dt, */ -/* vx, vy, vz, dvx/dt, dvy/dt, dvz/dt */ - -/* where x, y, z represent Cartesian position */ -/* components and vx, vy, vz represent Cartesian */ -/* velocity components. Note well: vx, vy, and */ -/* vz *are not necessarily equal* to the time */ -/* derivatives of x, y, and z. This packet */ -/* structure mimics that of the Rosetta/MEX orbit */ -/* file from which the data are taken. */ - -/* Type 1 (indicated by code S18TP1): */ - -/* x, y, z, dx/dt, dy/dt, dz/dt */ - -/* where x, y, z represent Cartesian position */ -/* components and vx, vy, vz represent Cartesian */ -/* velocity components. */ - -/* Position units are kilometers, velocity units */ -/* are kilometers per second, and acceleration units */ -/* are kilometers per second per second. */ - - -/* EPOCHS is an array of epochs corresponding to the members */ -/* of the packets array. The epochs are specified as */ -/* seconds past J2000, TDB. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* MAXDEG is the maximum allowed degree of the interpolating */ -/* polynomial. If the value of MAXDEG is increased, */ -/* the SPICELIB routine SPKPV must be changed */ -/* accordingly. In particular, the size of the */ -/* record passed to SPKRnn and SPKEnn must be */ -/* increased, and comments describing the record size */ -/* must be changed. */ - -/* $ Exceptions */ - -/* If any of the following exceptions occur, this routine will return */ -/* without creating a new segment. */ - -/* 1) If FRAME is not a recognized name, the error */ -/* SPICE(INVALIDREFFRAME) is signaled. */ - -/* 2) If the last non-blank character of SEGID occurs past index 40, */ -/* the error SPICE(SEGIDTOOLONG) is signaled. */ - -/* 3) If SEGID contains any nonprintable characters, the error */ -/* SPICE(NONPRINTABLECHARS) is signaled. */ - -/* 4) If DEGREE is not at least 1 or is greater than MAXDEG, the */ -/* error SPICE(INVALIDDEGREE) is signaled. */ - -/* 5) If the window size implied by DEGREE is odd, the error */ -/* SPICE(INVALIDDEGREE) is signaled. */ - -/* 6) If the number of packets N is not at least 1, */ -/* the error SPICE(TOOFEWSTATES) will be signaled. */ - -/* 7) If FIRST is greater than or equal to LAST then the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 8) If the elements of the array EPOCHS are not in strictly */ -/* increasing order, the error SPICE(TIMESOUTOFORDER) will be */ -/* signaled. */ - -/* 9) If the first epoch EPOCHS(1) is greater than FIRST, the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 10) If the last epoch EPOCHS(N) is less than LAST, the error */ -/* SPICE(BADDESCRTIMES) will be signaled. */ - -/* 11) If the subtype code is not recognized, the error */ -/* SPICE(INVALIDVALUE) will be signaled. */ - - -/* $ Files */ - -/* A new type 18 SPK segment is written to the SPK file attached */ -/* to HANDLE. */ - -/* $ Particulars */ - -/* This routine writes an SPK type 18 data segment to the open SPK */ -/* file according to the format described in the type 18 section of */ -/* the SPK Required Reading. The SPK file must have been opened with */ -/* write access. */ - -/* $ Examples */ - -/* Suppose that you have states and are prepared to produce */ -/* a segment of type 18 in an SPK file. */ - -/* The following code fragment could be used to add the new segment */ -/* to a previously opened SPK file attached to HANDLE. The file must */ -/* have been opened with write access. */ - -/* C */ -/* C Create a segment identifier. */ -/* C */ -/* SEGID = 'MY_SAMPLE_SPK_TYPE_18_SEGMENT' */ - -/* C */ -/* C Write the segment. */ -/* C */ -/* CALL SPKW18 ( HANDLE, BODY, CENTER, FRAME, */ -/* . FIRST, LAST, SEGID, DEGREE, */ -/* . N, STATES, EPOCHS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 29-APR-2003 (NJB) */ - -/* Description of error condition arising from invalid window */ -/* size was corrected. */ - -/* - SPICELIB Version 1.0.0, 13-MAY-2002 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write spk type_18 ephemeris data segment */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPKW18", (ftnlen)6); - } - -/* Set the packet size, which is a function of the subtype. */ - - if (*subtyp == 0) { - packsz = 12; - } else if (*subtyp == 1) { - packsz = 6; - } else { - setmsg_("Unexpected SPK type 18 subtype requested: #", (ftnlen)43); - errint_("#", subtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Set the window size corresponding to the input degree. This */ -/* size will be used in various places below. */ - - if (*subtyp == 0) { - winsiz = (*degree + 1) / 2; - } else if (*subtyp == 1) { - winsiz = *degree + 1; - } else { - setmsg_("This point should not be reached. Getting here may indicate" - " that the code needs to updated to handle new subtypes.", ( - ftnlen)114); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Get the NAIF integer code for the reference frame. */ - - namfrm_(frame, &refcod, frame_len); - if (refcod == 0) { - setmsg_("The reference frame # is not supported.", (ftnlen)39); - errch_("#", frame, (ftnlen)1, frame_len); - sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Check to see if the segment identifier is too long. */ - - if (lastnb_(segid, segid_len) > 40) { - setmsg_("Segment identifier contains more than 40 characters.", ( - ftnlen)52); - sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Now check that all the characters in the segment identifier */ -/* can be printed. */ - - i__1 = lastnb_(segid, segid_len); - for (i__ = 1; i__ <= i__1; ++i__) { - chrcod = *(unsigned char *)&segid[i__ - 1]; - if (chrcod < 32 || chrcod > 126) { - setmsg_("The segment identifier contains nonprintable characters", - (ftnlen)55); - sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - } - -/* Make sure that the degree of the interpolating polynomials is */ -/* in range. */ - - if (*degree < 1 || *degree > 15) { - setmsg_("The interpolating polynomials have degree #; the valid degr" - "ee range is [1, #]", (ftnlen)77); - errint_("#", degree, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Make sure that the window size is even. If not, the input */ -/* DEGREE is incompatible with the subtype. */ - - if (odd_(&winsiz)) { - setmsg_("The interpolating polynomials have degree #; for SPK type 1" - "8, the degree must be equivalent to 3 mod 4 for Hermite inte" - "rpolation and odd for for Lagrange interpolation.", (ftnlen) - 168); - errint_("#", degree, (ftnlen)1); - sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Make sure that the number of packets is sufficient to define a */ -/* polynomial whose degree is DEGREE. */ - - if (*n < 1) { - setmsg_("At least 1 packet is required for SPK type 18. Number of p" - "ackets supplied: #", (ftnlen)78); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(TOOFEWSTATES)", (ftnlen)19); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* The segment stop time should be greater than or equal to */ -/* the begin time. */ - - if (*first > *last) { - setmsg_("The segment start time: # is greater then the segment end t" - "ime: #", (ftnlen)65); - errdp_("#", first, (ftnlen)1); - errdp_("#", last, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* Make sure the epochs form a strictly increasing sequence. */ - - maxtim = epochs[0]; - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - if (epochs[i__ - 1] <= maxtim) { - setmsg_("EPOCH # having index # is not greater than its predeces" - "sor #.", (ftnlen)61); - errdp_("#", &epochs[i__ - 1], (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &epochs[i__ - 2], (ftnlen)1); - sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); - chkout_("SPKW18", (ftnlen)6); - return 0; - } else { - maxtim = epochs[i__ - 1]; - } - } - -/* Make sure that the span of the input epochs includes the interval */ -/* defined by the segment descriptor. */ - - if (epochs[0] > *first) { - setmsg_("Segment start time # precedes first epoch #.", (ftnlen)44); - errdp_("#", first, (ftnlen)1); - errdp_("#", epochs, (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW18", (ftnlen)6); - return 0; - } else if (epochs[*n - 1] < *last) { - setmsg_("Segment end time # follows last epoch #.", (ftnlen)40); - errdp_("#", last, (ftnlen)1); - errdp_("#", &epochs[*n - 1], (ftnlen)1); - sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* If we made it this far, we're ready to start writing the segment. */ - - -/* Create the segment descriptor. We don't use SPKPDS because */ -/* that routine doesn't allow creation of a singleton segment. */ - - ic[0] = *body; - ic[1] = *center; - namfrm_(frame, &ic[2], frame_len); - if (failed_()) { - chkout_("SPKW18", (ftnlen)6); - return 0; - } - ic[3] = 18; - dc[0] = *first; - dc[1] = *last; - dafps_(&c__2, &c__6, dc, ic, descr); - -/* Begin a new segment. */ - - dafbna_(handle, descr, segid, segid_len); - if (failed_()) { - chkout_("SPKW18", (ftnlen)6); - return 0; - } - -/* The type 18 segment structure is eloquently described by this */ -/* diagram from the SPK Required Reading: */ - -/* +-----------------------+ */ -/* | Packet 1 | */ -/* +-----------------------+ */ -/* | Packet 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Packet N | */ -/* +-----------------------+ */ -/* | Epoch 1 | */ -/* +-----------------------+ */ -/* | Epoch 2 | */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch N | */ -/* +-----------------------+ */ -/* | Epoch 100 | (First directory) */ -/* +-----------------------+ */ -/* . */ -/* . */ -/* . */ -/* +-----------------------+ */ -/* | Epoch ((N-1)/100)*100 | (Last directory) */ -/* +-----------------------+ */ -/* | Subtype code | */ -/* +-----------------------+ */ -/* | Window size | */ -/* +-----------------------+ */ -/* | Number of packets | */ -/* +-----------------------+ */ - - - i__1 = *n * packsz; - dafada_(packts, &i__1); - dafada_(epochs, n); - i__1 = (*n - 1) / 100; - for (i__ = 1; i__ <= i__1; ++i__) { - dafada_(&epochs[i__ * 100 - 1], &c__1); - } - d__1 = (doublereal) (*subtyp); - dafada_(&d__1, &c__1); - d__1 = (doublereal) winsiz; - dafada_(&d__1, &c__1); - d__1 = (doublereal) (*n); - dafada_(&d__1, &c__1); - -/* As long as nothing went wrong, end the segment. */ - - if (! failed_()) { - dafena_(); - } - chkout_("SPKW18", (ftnlen)6); - return 0; -} /* spkw18_ */ - diff --git a/ext/spice/src/cspice/spkw18_c.c b/ext/spice/src/cspice/spkw18_c.c deleted file mode 100644 index bd02370fd0..0000000000 --- a/ext/spice/src/cspice/spkw18_c.c +++ /dev/null @@ -1,338 +0,0 @@ -/* - --Procedure spkw18_c ( Write SPK segment, type 18 ) - --Abstract - - Write a type 18 segment to an SPK file. - --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 - - NAIF_IDS - SPC - SPK - TIME - --Keywords - - EPHEMERIS - FILES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #undef spkw18_c - - - void spkw18_c ( SpiceInt handle, - SpiceSPK18Subtype subtyp, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - const void * packts, - ConstSpiceDouble epochs[] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - handle I Handle of an SPK file open for writing. - subtyp I SPK type 18 subtype code. - body I NAIF code for an ephemeris object. - center I NAIF code for center of motion of body. - frame I Reference frame name. - first I Start time of interval covered by segment. - last I End time of interval covered by segment. - segid I Segment identifier. - degree I Degree of interpolating polynomials. - n I Number of states. - states I Array of states. - epochs I Array of epochs corresponding to states. - MAXDEG P Maximum allowed degree of interpolating polynomial. - --Detailed_Input - - handle is the file handle of an SPK file that has been - opened for writing. - - subtyp is an integer code indicating the subtype of the - the segment to be created. - - body is the NAIF integer code for an ephemeris object - whose state relative to another body is described - by the segment to be created. - - center is the NAIF integer code for the center of motion - of the object identified by body. - - frame is the NAIF name for a reference frame - relative to which the state information for body - is specified. - - first, - last are, respectively, the start and stop times of - the time interval over which the segment defines - the state of body. - - segid is the segment identifier. An SPK segment - identifier may contain up to 40 characters. - - degree is the nominal degree of the polynomials used to - interpolate the states contained in the input - packets. All components of the state vectors are - interpolated by polynomials of the specified - degree, except near the segment boundaries, - or if the total number of states in the segment - is too few to allow interpolation using the - specified degree. - - n is the number of packets in the input packet - array. - - packts contains a time-ordered array of data packets - representing geometric states of body relative - to center, specified relative to frame. The - packet structure depends on the segment subtype - as follows: - - Type 0 (indicated by code S18TP0): - - x, y, z, dx/dt, dy/dt, dz/dt, - vx, vy, vz, dvx/dt, dvy/dt, dvz/dt - - where x, y, z represent Cartesian position - components and vx, vy, vz represent Cartesian - velocity components. Note well: vx, vy, and - vz *are not necessarily equal* to the time - derivatives of x, y, and z. This packet - structure mimics that of the Rosetta/MEX orbit - file from which the data are taken. - - Type 1 (indicated by code S18TP1): - - x, y, z, dx/dt, dy/dt, dz/dt - - where x, y, z represent Cartesian position - components and vx, vy, vz represent Cartesian - velocity components. - - Position units are kilometers, velocity units - are kilometers per second, and acceleration units - are kilometers per second per second. - - - epochs is an array of epochs corresponding to the members - of the packets array. The epochs are specified as - seconds past J2000, TDB. - --Detailed_Output - - None. See $Particulars for a description of the effect of this - routine. - --Parameters - - MAXDEG is the maximum allowed degree of the interpolating - polynomial. If the value of MAXDEG is increased, - the CSPICE routine spkpvn_ must be changed - accordingly. In particular, the size of the - record passed to SPKRnn and SPKEnn must be - increased, and comments describing the record size - must be changed. - --Exceptions - - If any of the following exceptions occur, this routine will return - without creating a new segment. - - 1) If frame is not a recognized name, the error - SPICE(INVALIDREFFRAME) is signaled. - - 2) If the last non-blank character of segid occurs past index 40, - the error SPICE(SEGIDTOOLONG) is signaled. - - 3) If segid contains any nonprintable characters, the error - SPICE(NONPRINTABLECHARS) is signaled. - - 4) If degree is not at least 1 or is greater than MAXDEG, the - error SPICE(INVALIDDEGREE) is signaled. - - 5) If the window size implied by DEGREE is odd, the error - SPICE(INVALIDDEGREE) is signaled. - - 6) If the number of packets n is not at least 1, - the error SPICE(TOOFEWSTATES) will be signaled. - - 7) If first is greater than or equal to last then the error - SPICE(BADDESCRTIMES) will be signaled. - - 8) If the elements of the array epochs are not in strictly - increasing order, the error SPICE(TIMESOUTOFORDER) will be - signaled. - - 9) If the first epoch epochs[0] is greater than first, the error - SPICE(BADDESCRTIMES) will be signaled. - - 10) If the last epoch epochs[n-1] is less than last, the error - SPICE(BADDESCRTIMES) will be signaled. - - 11) If either the input frame or segment ID string pointer is null, - the error SPICE(NULLPOINTER) is signaled. - - 12) If either the input frame or segment ID string is empty, - the error SPICE(EMPTYSTRING) is signaled. - --Files - - A new type 18 SPK segment is written to the SPK file attached - to HANDLE. - --Particulars - - This routine writes an SPK type 18 data segment to the open SPK - file according to the format described in the type 18 section of - the SPK Required Reading. The SPK file must have been opened with - write access. - --Examples - - Suppose that you have states and are prepared to produce - a segment of type 18 in an SPK file. - - The following code fragment could be used to add the new segment - to a previously opened SPK file attached to handle. The file must - have been opened with write access. - - #include "SpiceUsr.h" - . - . - . - - /. - Create a segment identifier. - ./ - #define SEGID "MY_SAMPLE_SPK_TYPE_18_SEGMENT" - - - /. - Write the segment. - ./ - spkw18_c ( handle, subtyp, body, center, - frame, first, last, segid, - degree, n, states, epochs ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 29-APR-2003 (NJB) - - Description of error condition arising from invalid window - size was corrected. - - -CSPICE Version 1.0.0, 16-AUG-2002 (NJB) - --Index_Entries - - write spk type_18 ephemeris data segment - --& -*/ - -{ /* Begin spkw18_c */ - - - /* - Local variables - */ - SpiceInt locSubtype; - - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "spkw18_c" ); - - /* - Check the input strings to make sure the pointers - are non-null and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "spkw18_c", frame ); - CHKFSTR ( CHK_STANDARD, "spkw18_c", segid ); - - - locSubtype = (SpiceInt) subtyp; - - /* - Write the segment. - */ - spkw18_ ( ( integer * ) &handle, - ( integer * ) &locSubtype, - ( integer * ) &body, - ( integer * ) ¢er, - ( char * ) frame, - ( doublereal * ) &first, - ( doublereal * ) &last, - ( char * ) segid, - ( integer * ) °ree, - ( integer * ) &n, - ( doublereal * ) packts, - ( doublereal * ) epochs, - ( ftnlen ) strlen(frame), - ( ftnlen ) strlen(segid) ); - - - chkout_c ( "spkw18_c" ); - - -} /* End spkw18_c */ diff --git a/ext/spice/src/cspice/srfrec.c b/ext/spice/src/cspice/srfrec.c deleted file mode 100644 index fd6ea25bfa..0000000000 --- a/ext/spice/src/cspice/srfrec.c +++ /dev/null @@ -1,335 +0,0 @@ -/* srfrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static doublereal c_b5 = 1.; - -/* $Procedure SRFREC ( Surface to rectangular coordinates ) */ -/* Subroutine */ int srfrec_(integer *body, doublereal *long__, doublereal * - lat, doublereal *rectan) -{ - /* Initialized data */ - - static doublereal origin[3] = { 0.,0.,0. }; - - doublereal uvec[3]; - integer n; - doublereal radii[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen), latrec_(doublereal *, doublereal *, - doublereal *, doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int surfpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, logical *) - ; - -/* $ Abstract */ - -/* Convert planetocentric latitude and longitude of a surface */ -/* point on a specified body to rectangular coordinates. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ - -/* $ Keywords */ - -/* CONVERSION */ -/* COORDINATES */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BODY I NAIF integer code of an extended body. */ -/* LONG I Longitude of point in radians. */ -/* LAT I Latitude of point in radians. */ -/* RECTAN O Rectangular coordinates of the point. */ - -/* $ Detailed_Input */ - -/* BODY is the NAIF integer code of an extended body on which */ -/* a surface point of interest is located. The body is */ -/* modeled as a triaxial ellipsoid. */ - -/* LONG Longitude of the input point. This is the angle */ -/* between the prime meridian and the meridian */ -/* containing the point. The direction of increasing */ -/* longitude is from the +X axis towards the +Y axis. */ - -/* Longitude is measured in radians. On input, the */ -/* range of longitude is unrestricted. */ - -/* LAT Latitude of the input point. This is the angle from */ -/* the XY plane of the ray from the origin through the */ -/* point. */ - -/* Latitude is measured in radians. On input, the range */ -/* of latitude is unrestricted. */ - -/* $ Detailed_Output */ - -/* RECTAN The rectangular coordinates of the input surface */ -/* point. Units are the same as those used to define the */ -/* radii of BODY. Normally, these units are km. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If radii for BODY are not found in the kernel pool, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 2) If radii for BODY are invalid, the error will be diagnosed by */ -/* routines called by this routine. The radii should be */ -/* positive. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the rectangular coordinates of a surface */ -/* point on an extended body with known radii, where the location */ -/* of the surface point is specified in planetocentric latitudinal */ -/* coordinates. */ - -/* Latitudinal coordinates are defined by a distance from a central */ -/* reference point, an angle from a reference meridian, and an angle */ -/* above the equator of a sphere centered at the central reference */ -/* point. In this case, the distance from the central reference */ -/* point is not required as an input because the fact that the */ -/* point is on the body's surface allows one to deduce this quantity. */ - -/* Below are two tables that demonstrate by example the relationship */ -/* between rectangular and latitudinal coordinates. */ - -/* Listed in the first table (under R, LONG and LAT ) are */ -/* latitudinal coordinate triples that approximately represent */ -/* points whose rectangular coordinates are taken from the set */ -/* {-1, 0, 1}. (Angular quantities are given in degrees.) */ - - -/* R LONG LAT X(1) X(2) X(3) */ -/* -------------------------- -------------------------- */ -/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */ -/* 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 */ -/* 1.0000 90.0000 0.0000 0.0000 1.0000 0.0000 */ -/* 1.0000 0.0000 90.0000 0.0000 0.0000 1.0000 */ -/* 1.0000 180.0000 0.0000 -1.0000 0.0000 0.0000 */ -/* 1.0000 -90.0000 0.0000 0.0000 -1.0000 0.0000 */ -/* 1.0000 0.0000 -90.0000 0.0000 0.0000 -1.0000 */ -/* 1.4142 45.0000 0.0000 1.0000 1.0000 0.0000 */ -/* 1.4142 0.0000 45.0000 1.0000 0.0000 1.0000 */ -/* 1.4142 90.0000 45.0000 0.0000 1.0000 1.0000 */ -/* 1.7320 45.0000 35.2643 1.0000 1.0000 1.0000 */ - - -/* This routine is related to the SPICELIB routine LATREC, which */ -/* accepts a radius, longitude, and latitude as inputs and produces */ -/* equivalent rectangular coordinates as outputs. */ - -/* $ Examples */ - -/* 1) Find the rectangular coordinates of the point */ - -/* 100 degrees planetocentric longitude */ -/* -35 degrees planetocentric latitude */ - -/* on the Earth; then convert these coordinates back to */ -/* latitudinal coordinates. We should be able to recover */ -/* our original longitude and latitude values. */ - - -/* PROGRAM TEST_SRFREC */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION RPD */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LONG */ -/* DOUBLE PRECISION X ( 3 ) */ -/* DOUBLE PRECISION RADIUS */ - -/* C */ -/* C Load the kernel pool with a PCK file that contains */ -/* C values for the radii of the Earth. */ -/* C */ -/* CALL FURNSH ( 'pck00008.tpc' ) */ - -/* C */ -/* C Find X, the rectangular coordinates of the */ -/* C surface point defined by LAT and LONG. The */ -/* C NAIF integer code for the Earth is 399. */ -/* C (See the NAIF_IDS required reading file for */ -/* C the complete set of codes.) */ -/* C */ -/* LONG = 100.D0 */ -/* LAT = -35.D0 */ - -/* WRITE (*,*) 'Original latitudinal coordinates' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Longitude ', LONG */ -/* WRITE (*,*) 'Latitude ', LAT */ - -/* C */ -/* C Convert angles to radians on input to SRFREC. */ -/* C */ -/* CALL SRFREC ( 399, LONG*RPD(), LAT*RPD(), X ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Rectangular coordinates ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) X */ - -/* C */ -/* C Now try to recover the original latitudinal */ -/* C coordinates from the rectangular coordinates */ -/* C found by SRFREC. */ -/* C */ -/* CALL RECLAT ( X, RADIUS, LONG, LAT ) */ - -/* C */ -/* C Convert angles to degrees for display. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Latitudinal coordinates recovered ' // */ -/* . 'from rectangular coordinates' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Longitude (deg) ', LONG * DPR() */ -/* WRITE (*,*) 'Latitude (deg) ', LAT * DPR() */ -/* WRITE (*,*) 'Radius (km) ', RADIUS */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) A NAIF text kernel containing the body radius definitions */ -/* required by this routine must be loaded into the kernel */ -/* pool prior to any calls to this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 03-NOV-2005 (NJB) */ - -/* Call to BODVAR was replaced with call to BODVCD. */ - -/* Various header updates were made to clarify description */ -/* of routine's functionality. Example program was updated */ -/* as well. */ - -/* - 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, 03-SEP-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert bodyfixed latitudinal coordinates to rectangular */ -/* convert surface latitudinal coordinates to rectangular */ -/* surface point latitudinal coordinates to rectangular */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SRFREC", (ftnlen)6); - } - -/* Look up the body's radii. */ - - bodvcd_(body, "RADII", &c__3, &n, radii, (ftnlen)5); - -/* Find the unit vector pointing from the body center to the */ -/* input surface point. */ - - latrec_(&c_b5, long__, lat, uvec); - -/* Find out where the ray defined by this vector intersects the */ -/* surface. This intercept is the point we're looking for. */ - - surfpt_(origin, uvec, radii, &radii[1], &radii[2], rectan, &found); - -/* You can't miss the surface if you're riding a ray out from the */ -/* origin, so we don't check the FOUND flag. */ - - chkout_("SRFREC", (ftnlen)6); - return 0; -} /* srfrec_ */ - diff --git a/ext/spice/src/cspice/srfrec_c.c b/ext/spice/src/cspice/srfrec_c.c deleted file mode 100644 index de9050d08e..0000000000 --- a/ext/spice/src/cspice/srfrec_c.c +++ /dev/null @@ -1,288 +0,0 @@ -/* - --Procedure srfrec_c ( Surface to rectangular coordinates ) - --Abstract - - Convert planetocentric latitude and longitude of a surface - point on a specified body to rectangular coordinates. - --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 - - KERNEL - NAIF_IDS - --Keywords - - CONVERSION - COORDINATES - TRANSFORMATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - - - void srfrec_c ( SpiceInt body, - SpiceDouble longitude, - SpiceDouble latitude, - SpiceDouble rectan[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - body I NAIF integer code of an extended body. - longitude I Longitude of point in radians. - latitude I Latitude of point in radians. - rectan O Rectangular coordinates of the point. - --Detailed_Input - - body is the NAIF integer code of an extended body - on which a surface point of interest is located. - The body is modeled as a triaxial ellipsoid. - - longitude Longitude of the input point. This is the angle between - the prime meridian and the meridian containing `rectan'. - The direction of increasing longitude is from the +X axis - towards the +Y axis. - - Longitude is measured in radians. On input, the range - of longitude is unrestricted. - - - latitude Latitude of the input point. This is the angle from - the XY plane of the ray from the origin through the - point. - - Latitude is measured in radians. On input, the range of - latitude is unrestricted. - --Detailed_Output - - rectan The rectangular coordinates of the input point. `rectan' - is a 3-vector. - - Units are the same as those used to define the radii of - `body'. Normally, these units are km. - --Parameters - - None. - --Exceptions - - 1) If radii for `body' are not found in the kernel pool, the error - will be diagnosed by routines called by this routine. - - 2) If radii for `body' are invalid, the error will be diagnosed by - routines called by this routine. The radii should be - positive. - --Files - - None. - --Particulars - - This routine returns the rectangular coordinates of a surface - point on an extended body with known radii, where the location - of the surface point is specified in planetocentric latitudinal - coordinates. - - Latitudinal coordinates are defined by a distance from a central - reference point, an angle from a reference meridian, and an angle - above the equator of a sphere centered at the central reference - point. In this case, the distance from the central reference - point is not required as an input because the fact that the - point is on the body's surface allows one to deduce this quantity. - - Below are two tables that demonstrate by example the relationship - between rectangular and latitudinal coordinates. - - Listed in the first table (under r, longitude and latitude ) are - latitudinal coordinate triples that approximately represent - points whose rectangular coordinates are taken from the set - {-1, 0, 1}. (Angular quantities are given in degrees.) - - - r longitude latitude rectan[0] rectan[1] rectan[2]. - ---------------------------- ------------------------------- - 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 - 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 - 1.0000 90.0000 0.0000 0.0000 1.0000 0.0000 - 1.0000 0.0000 90.0000 0.0000 0.0000 1.0000 - 1.0000 180.0000 0.0000 -1.0000 0.0000 0.0000 - 1.0000 -90.0000 0.0000 0.0000 -1.0000 0.0000 - 1.0000 0.0000 -90.0000 0.0000 0.0000 -1.0000 - 1.4142 45.0000 0.0000 1.0000 1.0000 0.0000 - 1.4142 0.0000 45.0000 1.0000 0.0000 1.0000 - 1.4142 90.0000 45.0000 0.0000 1.0000 1.0000 - 1.7320 45.0000 35.2643 1.0000 1.0000 1.0000 - - - This routine is related to the CSPICE routine latrec_c, which - accepts a radius, longitude, and latitude as inputs and produces - equivalent rectangular coordinates as outputs. - --Examples - - 1) Find the rectangular coordinates of the point - - 100 degrees planetocentric longitude - -35 degrees planetocentric latitude - - on the Earth; then convert these coordinates back to - latitudinal coordinates. We should be able to recover - our original longitude and latitude values. - - - #include - #include "SpiceUsr.h" - - - int main() - { - - #define EARTH 399 - - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble x [3]; - SpiceDouble radius; - - /. - Load the kernel pool with a PCK file that contains - values for the radii of the Earth. - ./ - furnsh_c ( "pck00008.tpc" ); - - /. - Find `x', the rectangular coordinates of the surface point - defined by `lat' and `long'. The NAIF integer code for - the Earth is 399. (See the NAIF_IDS required reading file - for the complete set of codes.) - ./ - lon = 100.0; - lat = -35.0; - - printf ( "Original latitudinal coordinates:\n" - "\n" - "Longitude (deg): %f\n" - "Latitude (deg): %f\n", - lon, - lat ); - - /. - Convert angles to radians forr input to srfrec_c. - ./ - srfrec_c ( EARTH, lon*rpd_c(), lat*rpd_c(), x ); - - printf ( "\n" - "Rectangular coordinates:\n" - "\n" - "X (km): %24.16f\n" - "Y (km): %24.16f\n" - "Z (km): %25.16f\n", - x[0], - x[1], - x[2] ); - - /. - Now try to recover the original latitudinal coordinates - from the rectangular coordinates found by srfrec_c. - ./ - reclat_c ( x, &radius, &lon, &lat ); - - /. - Convert angles back to degree for display. - ./ - printf ( "\n" - "Latitudinal coordinates recovered from " - "rectangular coordinates:\n" - "\n" - "Longitude (deg): %f\n" - "Latitude (deg): %f\n" - "Radius (km): %f\n", - lon * dpr_c(), - lat * dpr_c(), - radius ); - - return ( 0 ); - } - - --Restrictions - - 1) A SPICE text kernel containing the body radius definitions - required by this routine must be loaded into the kernel - pool prior to any calls to this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 03-NOV-2005 (NJB) (WLT) - --Index_Entries - - convert bodyfixed latitudinal coordinates to rectangular - convert surface latitudinal coordinates to rectangular - surface point latitudinal coordinates to rectangular - --& -*/ - -{ /* Begin srfrec_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "srfrec_c" ); - - srfrec_ ( (SpiceInt *) &body, - (SpiceDouble *) &longitude, - (SpiceDouble *) &latitude, - (SpiceDouble *) rectan ); - - - chkout_c ( "srfrec_c" ); - -} /* End srfrec_c */ diff --git a/ext/spice/src/cspice/srfxpt.c b/ext/spice/src/cspice/srfxpt.c deleted file mode 100644 index a671495fbe..0000000000 --- a/ext/spice/src/cspice/srfxpt.c +++ /dev/null @@ -1,1757 +0,0 @@ -/* srfxpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static doublereal c_b45 = 1e-14; - -/* $Procedure SRFXPT ( Surface intercept point ) */ -/* Subroutine */ int srfxpt_(char *method, char *target, doublereal *et, char - *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal * - spoint, doublereal *dist, doublereal *trgepc, doublereal *obspos, - logical *found, ftnlen method_len, ftnlen target_len, ftnlen - abcorr_len, ftnlen obsrvr_len, ftnlen dref_len) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - integer nitr; - extern doublereal vsep_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer type__; - logical xmit; - doublereal rpos[3], tpos[3], j2dir[3], j2est[3], j2pos[3]; - integer i__; - doublereal s, radii[3], range; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - extern logical eqchr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal pnear[3]; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - logical usecn; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal xform[9] /* was [3][3] */; - logical uselt; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - bods2c_(char *, integer *, logical *, ftnlen); - doublereal r2jmat[9] /* was [3][3] */, j2tmat[9] /* was [3][3] - */; - extern logical failed_(void); - integer refcde; - doublereal lt, etdiff; - integer frcode; - extern doublereal dasine_(doublereal *, doublereal *); - doublereal refepc; - integer obscde, nradii; - extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical - *, ftnlen); - char frname[80]; - extern doublereal clight_(void); - doublereal ltdiff, maxrad, reject; - integer trgcde; - char loccor[15]; - integer center; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - extern doublereal touchd_(doublereal *); - doublereal ltcent; - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *); - doublereal negpos[3], rayalt, trgdir[3]; - integer typeid; - doublereal stldir[3]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - doublereal prevet; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), spkssb_(integer *, doublereal *, char *, doublereal *, - ftnlen), stlabx_(doublereal *, doublereal *, doublereal *); - doublereal stlerr[3], prevlt; - extern logical return_(void); - doublereal ssbost[6]; - logical usestl; - doublereal ssbtst[6], stltmp[3]; - extern /* Subroutine */ int spkezp_(integer *, doublereal *, char *, char - *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vminus_(doublereal *, doublereal *), pxform_(char *, char *, - doublereal *, doublereal *, ftnlen, ftnlen), bodvcd_(integer *, - char *, integer *, integer *, doublereal *, ftnlen), surfpt_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, logical *), npedln_(doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - logical fnd; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Deprecated: This routine has been superseded by the SPICELIB */ -/* routine SINCPT. This routine is supported for purposes of */ -/* backward compatibility only. */ - -/* Given an observer and a direction vector defining a ray, compute */ -/* the surface intercept point of the ray on a target body at a */ -/* specified epoch, optionally corrected for light time and stellar */ -/* aberration. */ - -/* $ 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 */ - -/* FRAMES */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* DREF I Reference frame of input direction vector. */ -/* DVEC I Ray's direction vector. */ -/* SPOINT O Surface intercept point on the target body. */ -/* DIST O Distance from the observer to the intercept point. */ -/* TRGEPC O Intercept epoch. */ -/* OBSPOS O Observer position relative to target center. */ -/* FOUND O Flag indicating whether intercept was found. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. Parameters */ -/* include, but are not limited to, the shape model */ -/* used to represent the surface of the target body. */ - -/* The only choice currently supported is */ - -/* 'Ellipsoid' The intercept computation uses */ -/* a triaxial ellipsoid to model */ -/* the surface of the target body. */ -/* The ellipsoid's radii must be */ -/* available in the kernel pool. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string ' eLLipsoid ' is */ -/* valid. */ - -/* In a later Toolkit release, this argument will be */ -/* used to invoke a wider range of surface */ -/* representations. For example, it will be possible to */ -/* represent the target body's surface using a digital */ -/* model. */ - - -/* TARGET is the name of the target body. TARGET is */ -/* case-insensitive, and leading and trailing blanks in */ -/* TARGET are not significant. Optionally, you may */ -/* supply a string containing the integer ID code */ -/* for the object. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* When the target body's surface is represented by a */ -/* tri-axial ellipsoid, this routine assumes that a */ -/* kernel variable representing the ellipsoid's radii is */ -/* present in the kernel pool. Normally the kernel */ -/* variable would be defined by loading a PCK file. */ - - -/* ET is the epoch of participation of the observer, */ -/* expressed as ephemeris seconds past J2000 TDB: ET is */ -/* the epoch at which the observer's state is computed. */ - -/* When aberration corrections are not used, ET is also */ -/* the epoch at which the state and orientation of the */ -/* target body are computed. */ - -/* When aberration corrections are used, ET is the epoch */ -/* at which the observer's state relative to the solar */ -/* system barycenter is computed; in this case the */ -/* position and orientation of the target body are */ -/* computed at ET-LT or ET+LT, where LT is the one-way */ -/* light time between the intercept point and the */ -/* observer, and the sign applied to LT depends on the */ -/* selected correction. See the description of ABCORR */ -/* below for details. */ - - -/* ABCORR indicates the aberration correction to be applied */ -/* when computing the observer-target state and the */ -/* orientation of the target body. ABCORR may be any of */ -/* the following. */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric surface intercept point on the */ -/* target body. */ - -/* Let LT represent the one-way light time between the */ -/* observer and the surface intercept point (note: NOT */ -/* between the observer and the target body's center). */ -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* intercept point's location at the light-time */ -/* corrected epoch ET-LT and *arrive* at the observer's */ -/* location at ET: */ - - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the location of the surface */ -/* intercept point at the moment it */ -/* emitted photons arriving at the */ -/* observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* Both the target state as seen by the */ -/* observer, and rotation of the target */ -/* body, are corrected for light time. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* surface intercept point as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges. Both the */ -/* state and rotation of the target body */ -/* are corrected for light time. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* intercept point at the light-time corrected epoch */ -/* ET+LT: */ - - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* intercept location at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* Both the target state as seen by the */ -/* observer, and rotation of the target */ -/* body, are corrected for light time. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* intercept obtained with the 'XLT' */ -/* option to account for the observer's */ -/* velocity relative to the solar system */ -/* barycenter. */ - -/* 'XCN' Converged Newtonian light time */ -/* correction. This is the same as XLT */ -/* correction but with further iterations */ -/* to a converged Newtonian light time */ -/* solution. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* OBSRVR is the name of the observing body. This is typically */ -/* a spacecraft, the earth, or a surface point on the */ -/* earth. OBSRVR is case-insensitive, and leading and */ -/* trailing blanks in OBSRVR are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'MOON' and '301' are legitimate strings that indicate */ -/* the moon is the observer. */ - - -/* DREF is the name of the reference frame relative to which */ -/* the input direction vector is expressed. This may be */ -/* any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DVEC Pointing vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the */ -/* frame's center is located elsewhere, then letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* $ Detailed_Output */ - - -/* SPOINT is the surface intercept point on the target body of */ -/* the ray defined by the observer and the direction */ -/* vector. If the ray intersects the target body in */ -/* multiple points, the selected intersection point is */ -/* the one closest to the observer. The output */ -/* argument FOUND (see below) indicates whether an */ -/* intercept was found. */ - -/* SPOINT is expressed in Cartesian coordinates, */ -/* relative to the body-fixed frame associated with the */ -/* target body. The body-fixed target frame is */ -/* evaluated at the intercept epoch TRGEPC (see */ -/* description below). */ - -/* When light time correction is used, the duration of */ -/* light travel between SPOINT to the observer is */ -/* considered to be the one way light time. When both */ -/* light time and stellar aberration corrections are */ -/* used, SPOINT is selected such that, when SPOINT is */ -/* corrected for light time and the vector from the */ -/* observer to the light-time corrected location of */ -/* SPOINT is corrected for stellar aberration, the */ -/* resulting vector is parallel to the ray defined by */ -/* the observer's location and DVEC. */ - -/* The components of SPOINT are given in units of km. */ - - -/* DIST is the distance between the observer and the surface */ -/* intercept on the target body. DIST is given in */ -/* units of km. */ - - -/* TRGEPC is the "intercept epoch." This is the epoch at which */ -/* the ray defined by OBSRVR and DVEC intercepts the */ -/* target surface at SPOINT. TRGEPC is defined as */ -/* follows: letting LT be the one-way light time between */ -/* the observer and the intercept point, TRGEPC is the */ -/* epoch ET-LT, ET+LT, or ET depending on whether the */ -/* requested aberration correction is, respectively, for */ -/* received radiation, transmitted radiation, or */ -/* omitted. LT is computed using the method indicated by */ -/* ABCORR. */ - -/* TRGEPC is expressed as seconds past J2000 TDB. */ - - -/* OBSPOS is the vector from the center of the target body at */ -/* epoch TRGEPC to the observer at epoch ET. OBSPOS is */ -/* expressed in the target body-fixed reference frame */ -/* evaluated at TRGEPC. (This is the frame relative to */ -/* which SPOINT is given.) */ - -/* OBSPOS is returned to simplify various related */ -/* computations that would otherwise be cumbersome. For */ -/* example, the vector XVEC from the observer to SPOINT */ -/* can be calculated via the call */ - -/* CALL VSUB ( SPOINT, OBSPOS, XVEC ) */ - -/* The components of OBSPOS are given in units of km. */ - - -/* FOUND A logical flag indicating whether or not the ray */ -/* intersects the target. If an intersection exists */ -/* FOUND will be returned as .TRUE. If the ray misses */ -/* the target, FOUND will be returned as .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If any of the listed errors occur, the output arguments are */ -/* left unchanged. */ - - -/* 1) If the input argument METHOD is not recognized, the error */ -/* will be signaled by a routine in the call tree of this */ -/* routine. */ - -/* 2) If TARGET cannot be mapped to an ID code, the error */ -/* SPICE(IDCODENOTFOUND) will be signaled. If OBSRVR */ -/* cannot be mapped to an ID code, the error will be */ -/* signaled by a routine in the call tree of this */ -/* routine. */ - -/* 3) If the input argument ABCORR is invalid, the error */ -/* will be signaled by a routine in the call tree of this */ -/* routine. */ - -/* 4) If a body-fixed reference frame associated with the */ -/* target cannot be found, the error SPICE(NOFRAME) will */ -/* be signaled. */ - -/* 5) If OBSRVR and TARGET map to the same NAIF integer ID codes, */ -/* the error will be signaled by a routine in the call tree of */ -/* this routine. */ - -/* 6) If frame definition data enabling the evaluation of the state */ -/* of the target relative to the observer in target body-fixed */ -/* coordinates have not been loaded prior to calling SRFXPT, the */ -/* error will be signaled by a routine in the call tree of this */ -/* routine. */ - -/* 7) If the specified aberration correction is not recognized, the */ -/* error will be signaled by a routine in the call tree of this */ -/* routine. */ - -/* 8) If insufficient ephemeris data have been loaded prior to */ -/* calling SRFXPT, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. Note that when */ -/* light time correction is used, sufficient ephemeris data */ -/* must be available to propagate the states of both observer */ -/* and target to the solar system barycenter. */ - -/* 9) If the computation method has been specified as "Ellipsoid" */ -/* and triaxial radii of the target body have not been loaded */ -/* into the kernel pool prior to calling SRFXPT, the error will */ -/* be signaled by a routine in the call tree of this routine. */ - -/* 10) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be signaled */ -/* by routines in the call tree of this routine. */ - -/* 11) If PCK data needed to define the target body-fixed frame */ -/* have not been loaded prior to calling SRFXPT, the error will */ -/* be signaled by a routine in the call tree of this routine. */ - -/* 12) If the reference frame designated by DREF is not recognized */ -/* by the SPICE frame subsystem, the error will be signaled */ -/* by a routine in the call tree of this routine. */ - -/* 13) If the direction vector DVEC is the zero vector, the error */ -/* is signaled by a routine in the call tree of this routine. */ - - -/* $ Files */ - -/* Appropriate SPK, PCK, and frame kernels must be loaded by the */ -/* calling program before this routine is called. CK, SCLK, and */ -/* IK kernels may be required as well. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: if the computation method is specified as */ -/* "Ellipsoid," triaxial radii for the target body must be */ -/* loaded into the kernel pool. Typically this is done by */ -/* loading a text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must */ -/* be loaded. These may be provided in a text or binary PCK */ -/* file. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the body-fixed frame of */ -/* the target, that definition must be available in the kernel */ -/* pool. Similarly, the frame definition required to map */ -/* between the frame designated by DREF and the target */ -/* body-fixed frame must be available. Typically the */ -/* definitions of frames not already built-in to SPICE are */ -/* supplied by loading a frame kernel. */ - -/* The following data may be required: */ - -/* - CK data: if the frame to which DREF refers is fixed to a */ -/* spacecraft instrument or structure, at least one CK file */ -/* will be needed to permit transformation of vectors between */ -/* that frame and both J2000 and the target body-fixed frame. */ - -/* - SCLK data: if a CK file is needed, an associated SCLK */ -/* kernel is required to enable conversion between encoded SCLK */ -/* (used to time-tag CK data) and barycentric dynamical time */ -/* (TDB). */ - -/* - IK data: one or more I-kernels may be required to enable */ -/* transformation of vectors from an instrument-fixed frame to */ -/* a spacecraft-fixed frame whose attitude is given by a */ -/* C-kernel. */ - - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* Given a ray defined by a direction vector and the location of an */ -/* observer, SRFXPT computes the surface intercept point of the ray */ -/* on a specified target body. SRFXPT also determines the distance */ -/* between the observer and the surface intercept point. */ - -/* When aberration corrections are used, this routine finds the */ -/* value of SPOINT such that, if SPOINT is regarded as an ephemeris */ -/* object, after the selected aberration corrections are applied to */ -/* the vector from the observer to SPOINT, the resulting vector is */ -/* parallel to the direction vector DVEC. */ - -/* This routine computes light time corrections using light time */ -/* between the observer and the surface intercept point, as opposed */ -/* to the center of the target. Similarly, stellar aberration */ -/* corrections done by this routine are based on the direction of */ -/* the vector from the observer to the light-time corrected */ -/* intercept point, not to the target center. This technique avoids */ -/* errors due to the differential between aberration corrections */ -/* across the target body. Therefore it's valid to use aberration */ -/* corrections with this routine even when the observer is very */ -/* close to the intercept point, in particular when the */ -/* observer-intercept point distance is much less than the */ -/* observer-target center distance. It's also valid to use stellar */ -/* aberration corrections even when the intercept point is near or */ -/* on the limb (as may occur in occultation computations using a */ -/* point target). */ - -/* When comparing surface intercept point computations with results */ -/* from sources other than SPICE, it's essential to make sure the */ -/* same geometric definitions are used. */ - -/* $ Examples */ - -/* The numerical results shown for this example may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* Example 1 */ -/* --------- */ - -/* The following program computes surface intercept points on Mars */ -/* for the boresight and FOV boundary vectors of the MGS MOC narrow */ -/* angle camera. The intercepts are computed for a single */ -/* observation epoch. Light time and stellar aberration corrections */ -/* are used. For simplicity, camera distortion is ignored. */ - - -/* PROGRAM MOCXPT */ -/* IMPLICIT NONE */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER ABCLEN */ -/* PARAMETER ( ABCLEN = 20 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = 78 ) */ - -/* INTEGER METLEN */ -/* PARAMETER ( METLEN = 40 ) */ - -/* INTEGER NAMLEN */ -/* PARAMETER ( NAMLEN = 32 ) */ - -/* INTEGER TIMLEN */ -/* PARAMETER ( TIMLEN = 50 ) */ - -/* INTEGER SHPLEN */ -/* PARAMETER ( SHPLEN = 80 ) */ - -/* INTEGER NCORNR */ -/* PARAMETER ( NCORNR = 4 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(ABCLEN) ABCORR */ -/* CHARACTER*(NAMLEN) CAMERA */ -/* CHARACTER*(NAMLEN) DREF */ -/* CHARACTER*(METLEN) METHOD */ -/* CHARACTER*(NAMLEN) OBSRVR */ -/* CHARACTER*(NAMLEN) SHAPE */ -/* CHARACTER*(NAMLEN) TARGET */ -/* CHARACTER*(LNSIZE) TITLE */ -/* CHARACTER*(TIMLEN) UTC */ - -/* DOUBLE PRECISION BOUNDS ( 3, NCORNR ) */ -/* DOUBLE PRECISION BSIGHT ( 3 ) */ -/* DOUBLE PRECISION DIST */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION DVEC ( 3 ) */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION OBSPOS ( 3 ) */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ - -/* INTEGER CAMID */ -/* INTEGER I */ -/* INTEGER J */ -/* INTEGER N */ - -/* LOGICAL FOUND */ - -/* DATA ABCORR / 'LT+S' / */ -/* DATA CAMERA / 'MGS_MOC_NA'/ */ -/* DATA METHOD / 'Ellipsoid' / */ -/* DATA OBSRVR / 'MGS' / */ -/* DATA TARGET / 'Mars' / */ -/* DATA UTC / '2003 OCT 13 06:00:00 UTC' / */ - -/* C */ -/* C Load kernel files: */ -/* C */ -/* C - Leapseconds kernel */ -/* C - MGS SCLK kernel */ -/* C - Text PCK file */ -/* C - Planetary SPK file */ -/* C - MGS I-kernel */ -/* C - MGS spacecraft bus C-kernel */ -/* C - MGS SPK file */ -/* C */ -/* CALL FURNSH ( 'naif0007.tls' ) */ -/* CALL FURNSH ( 'mgs_sclkscet_00052.tsc' ) */ -/* CALL FURNSH ( 'mars_iau2000_v0.tpc' ) */ -/* CALL FURNSH ( 'de405s.bsp' ) */ -/* CALL FURNSH ( 'mgs_moc_v20.ti' ) */ -/* CALL FURNSH ( 'mgs_ext12.bsp' ) */ -/* CALL FURNSH ( 'mgs_sc_ext12.bc' ) */ - -/* C */ -/* C Convert the UTC request time to ET (seconds past */ -/* C J2000, TDB). */ -/* C */ -/* CALL STR2ET ( UTC, ET ) */ - -/* C */ -/* C Get the MGS MOC Narrow angle camera (MGS_MOC_NA) */ -/* C ID code. Then look up the field of view (FOV) */ -/* C parameters by calling GETFOV. */ -/* C */ -/* CALL BODN2C ( CAMERA, CAMID, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* CALL SETMSG ( 'Could not find ID code for ' // */ -/* . 'instrument #.' ) */ -/* CALL ERRCH ( '#', CAMERA ) */ -/* CALL SIGERR ( 'SPICE(NOTRANSLATION)' ) */ -/* END IF */ - -/* C */ -/* C GETFOV will return the name of the camera-fixed frame */ -/* C in the string DREF, the camera boresight vector in */ -/* C the array BSIGHT, and the FOV corner vectors in the */ -/* C array BOUNDS. */ -/* C */ -/* CALL GETFOV ( CAMID, NCORNR, SHAPE, DREF, */ -/* . BSIGHT, N, BOUNDS ) */ - - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Surface Intercept Locations for Camera' */ -/* WRITE (*,*) 'FOV Boundary and Boresight Vectors' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Instrument: ', CAMERA */ -/* WRITE (*,*) ' Epoch: ', UTC */ -/* WRITE (*,*) ' Aberration correction: ', ABCORR */ -/* WRITE (*,*) ' ' */ - -/* C */ -/* C Now compute and display the surface intercepts for the */ -/* C boresight and all of the FOV boundary vectors. */ -/* C */ -/* DO I = 1, NCORNR+1 */ - -/* IF ( I .LE. NCORNR ) THEN */ - -/* TITLE = 'Corner vector #' */ -/* CALL REPMI ( TITLE, '#', I, TITLE ) */ - -/* CALL VEQU ( BOUNDS(1,I), DVEC ) */ - -/* ELSE */ - -/* TITLE = 'Boresight vector' */ -/* CALL VEQU ( BSIGHT, DVEC ) */ - -/* END IF */ - -/* C */ -/* C Compute the surface intercept point using */ -/* C the specified aberration corrections. */ -/* C */ -/* C SRFXPT will signal an error if required kernel */ -/* C data are unavailable. See example (2) below for */ -/* C a suggestion on detecting absence of C-kernel */ -/* C data prior to calling SRFXPT. */ -/* C */ -/* CALL SRFXPT ( METHOD, TARGET, ET, ABCORR, */ -/* . OBSRVR, DREF, DVEC, SPOINT, */ -/* . DIST, TRGEPC, OBSPOS, FOUND ) */ - -/* IF ( FOUND ) THEN */ -/* C */ -/* C Convert rectangular coordinates to planetocentric */ -/* C latitude and longitude. Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */ - -/* LON = LON * DPR () */ -/* LAT = LAT * DPR () */ -/* C */ -/* C Display the results. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) TITLE */ - -/* TITLE = ' Vector in # frame = ' */ -/* CALL REPMC ( TITLE, '#', DREF, TITLE ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) TITLE */ - -/* IF ( I .LE. NCORNR ) THEN */ -/* WRITE (*,*) ' ', ( BOUNDS(J,I), J = 1, 3 ) */ -/* ELSE */ -/* WRITE (*,*) ' ', BSIGHT */ -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Intercept:' */ -/* WRITE (*,*) */ -/* . ' Radius (km) = ', RADIUS */ -/* WRITE (*,*) */ -/* . ' Planetocentric Latitude (deg) = ', LAT */ -/* WRITE (*,*) */ -/* . ' Planetocentric Longitude (deg) = ', LON */ -/* WRITE (*,*) */ -/* . ' Range (km) = ', DIST */ -/* WRITE (*,*) ' ' */ - -/* ELSE */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Intercept not found.' */ -/* WRITE (*,*) ' ' */ - -/* END IF */ - -/* END DO */ - -/* END */ - - -/* When this program is executed, the output will be: */ - - -/* Surface Intercept Locations for Camera */ -/* FOV Boundary and Boresight Vectors */ - -/* Instrument: MGS_MOC_NA */ -/* Epoch: 2003 OCT 13 06:00:00 UTC */ -/* Aberration correction: LT+S */ - - -/* Corner vector 1 */ - -/* Vector in MGS_MOC_NA frame = */ -/* 1.85713838E-06 -0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.94126 */ -/* Planetocentric Latitude (deg) = -48.4771189 */ -/* Planetocentric Longitude (deg) = -123.473655 */ -/* Range (km) = 388.983627 */ - - -/* Corner vector 2 */ - -/* Vector in MGS_MOC_NA frame = */ -/* 1.85713838E-06 0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.93982 */ -/* Planetocentric Latitude (deg) = -48.4812729 */ -/* Planetocentric Longitude (deg) = -123.398399 */ -/* Range (km) = 388.975659 */ - - -/* Corner vector 3 */ - -/* Vector in MGS_MOC_NA frame = */ -/* -1.85713838E-06 0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.93982 */ -/* Planetocentric Latitude (deg) = -48.4812985 */ -/* Planetocentric Longitude (deg) = -123.398403 */ -/* Range (km) = 388.9752 */ - - -/* Corner vector 4 */ - -/* Vector in MGS_MOC_NA frame = */ -/* -1.85713838E-06 -0.00380156227 0.999992774 */ - -/* Intercept: */ -/* Radius (km) = 3384.94125 */ -/* Planetocentric Latitude (deg) = -48.4771444 */ -/* Planetocentric Longitude (deg) = -123.473658 */ -/* Range (km) = 388.983168 */ - - -/* Boresight vector */ - -/* Vector in MGS_MOC_NA frame = */ -/* 0. 0. 1. */ - -/* Intercept: */ -/* Radius (km) = 3384.94054 */ -/* Planetocentric Latitude (deg) = -48.4792166 */ -/* Planetocentric Longitude (deg) = -123.43603 */ -/* Range (km) = 388.976266 */ - - - -/* Example 2 */ -/* --------- */ - -/* SRFXPT will signal an error if required kernel data are */ -/* unavailable: for example, in the program of Example 1, if the */ -/* C-kernel containing data for the MGS bus had a gap at epoch ET, */ -/* SRFXPT would be unable to transform the direction vector DVEC */ -/* from the reference frame fixed to the camera to the reference */ -/* frame fixed to the target body. */ - -/* We could modify the code of Example 1 as shown below to test for */ -/* the availability of C-kernel data. We would add the declarations */ -/* shown, and we'd call the C-kernel reader CKGP to find whether the */ -/* desired pointing was available. Depending on the value of the */ -/* FOUND flag returned by CKGP, we'd go on to compute the surface */ -/* intercept point or respond to the error condition. */ - - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Local parameters */ -/* C */ -/* INTEGER BUSID */ -/* PARAMETER ( BUSID = -94000 ) */ - -/* INTEGER MGS */ -/* PARAMETER ( MGS = -94 ) */ -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Local variables */ -/* C */ - -/* DOUBLE PRECISION CLKOUT */ -/* DOUBLE PRECISION CMAT ( 3, 3 ) */ -/* DOUBLE PRECISION SCLKDP */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Look up the transformation from the J2000 frame to the */ -/* C MGS spacecraft frame. To do this, we'll need to represent */ -/* C our observation epoch in terms of MGS encoded SCLK. */ -/* C */ -/* CALL SCE2C ( MGS, ET, SCLKDP ) */ - -/* C */ -/* C Look up the spacecraft attitude from the C-kernel. */ -/* C */ -/* CALL CKGP ( BUSID, SCLKDP, 0.D0, 'J2000', */ -/* . CMAT, CLKOUT, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* [Proceed to compute intercept point] */ - -/* ELSE */ - -/* [Handle case where pointing is unavailable */ -/* for the epoch of interest] */ - -/* END IF */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* A cautionary note: if aberration corrections are used, and */ -/* if DREF is the target body-fixed frame, the epoch at which that */ -/* frame is evaluated is offset from ET by the light time between */ -/* the observer and the *center* of the target body. This light time */ -/* normally will differ from the light time between the observer and */ -/* intercept point. Consequently the orientation of the target */ -/* body-fixed frame at TRGEPC will not match that of the target */ -/* body-fixed frame at the epoch associated with DREF. As a result, */ -/* various derived quantities may not be as expected: for example, */ -/* OBSPOS would not be the inverse of the aberration-corrected */ -/* position of the target as seen by the observer. */ - -/* In many applications the errors arising from this frame */ -/* discrepancy may be insignificant; however a safe approach is to */ -/* always use as DREF a frame other than the target body-fixed */ -/* frame. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.4.1, 18-MAY-2010 (BVS) */ - -/* Index line now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.4.0, 23-MAR-2009 (NJB) */ - -/* Bug fix: quick test for non-intersection is */ -/* no longer performed when observer-target distance */ -/* is less than target's maximum radius. */ - -/* Typo correction in Required_Reading: changed FRAME */ -/* to FRAMES. */ - -/* - SPICELIB Version 1.3.0, 15-FEB-2008 (NJB) */ - -/* Bug fix: near-miss case light time improvement */ -/* logic is no longer applied when a geometric */ -/* solution is requested via ABCORR. */ - -/* References to unneeded variables FJ2000 and FIRST */ -/* were deleted. */ - -/* Header typo was corrected; reference to VMINUS was replaced */ -/* with reference to VSUB. */ - -/* Abstract now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.1, 25-APR-2007 (NJB) */ - -/* Header typo was corrected; reference to VMINUS was replaced */ -/* with reference to VSUB. */ - -/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */ - -/* Call to BODVAR was replaced with call to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to use BODS2C. */ - -/* - SPICELIB Version 1.0.0, 27-FEB-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED surface intercept point */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 30-JAN-2008 (NJB) */ - -/* Bug fix: near-miss case light time improvement */ -/* logic is no longer applied when a geometric */ -/* solution is requested via ABCORR. */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to use BODS2C. This simplifies the name-to-ID */ -/* mapping code. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* This value will become system-dependent when systems */ -/* using 128-bit d.p. numbers are supported by SPICELIB. */ -/* CNVLIM, when added to 1.0D0, should yield 1.0D0. */ - - -/* Round-off error limit for arc sine input: */ - - -/* Fraction of planetary angular radius used to define */ -/* region outside of which rays are immediately rejected */ -/* as non-intersecting. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SRFXPT", (ftnlen)6); - -/* Nothing has been found yet. */ - - *found = FALSE_; - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &fnd, target_len); - if (! fnd) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - bods2c_(obsrvr, &obscde, &fnd, obsrvr_len); - if (! fnd) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the surface intercept point, the observing bod" - "y and target body are the same. Both are #.", (ftnlen)102); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Get a left-justified, upper case copy of the aberration */ -/* correction flag. */ - - ljust_(abcorr, loccor, abcorr_len, (ftnlen)15); - ucase_(loccor, loccor, (ftnlen)15, (ftnlen)15); - -/* Check for stellar aberration in the aberration correction flag. */ - - usestl = i_indx(loccor, "+S", (ftnlen)15, (ftnlen)2) > 0; - -/* Now remove the stellar aberration component from the aberration */ -/* correction flag; we'll do our state lookups without stellar */ -/* aberration correction. */ - - repmc_(loccor, "+S", " ", loccor, (ftnlen)15, (ftnlen)2, (ftnlen)1, ( - ftnlen)15); - -/* Decide whether the aberration correction is for received or */ -/* transmitted radiation. */ - - xmit = eqchr_(loccor, "X", (ftnlen)1, (ftnlen)1); - -/* Decide what sort of light time correction has been requested. */ - - usecn = s_cmp(loccor, "CN", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(loccor, - "XCN", (ftnlen)3, (ftnlen)3) == 0; - uselt = usecn || s_cmp(loccor, "LT", (ftnlen)2, (ftnlen)2) == 0 || s_cmp( - loccor, "XLT", (ftnlen)3, (ftnlen)3) == 0; - -/* Get the sign S prefixing LT in the expression for TRGEPC. */ -/* When light time correction is not used, setting S = 0 */ -/* allows us to seamlessly set TRGEPC equal to ET. */ - - if (uselt) { - if (xmit) { - s = 1.; - } else { - s = -1.; - } - } else { - s = 0.; - } - -/* Find the name of the body-fixed frame associated with the */ -/* target body. We'll want the state of the target relative to */ -/* the observer in this body-fixed frame. */ - - cidfrm_(&trgcde, &frcode, frname, &fnd, (ftnlen)80); - if (! fnd) { - setmsg_("No body-fixed frame is associated with target body #; a fra" - "me kernel must be loaded to make this association. Consult " - "the FRAMES Required Reading for details.", (ftnlen)159); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Determine the position of the observer in target */ -/* body-fixed coordinates. */ - -/* - Call SPKEZP to compute the position of the target body as */ -/* seen from the observing body and the light time (LT) */ -/* between them. We request that the coordinates of POS be */ -/* returned relative to the body fixed reference frame */ -/* associated with the target body, using aberration */ -/* corrections specified by the input argument ABCORR. */ - -/* - Call VMINUS to negate the direction of the vector (OBSPOS) */ -/* so it will be the position of the observer as seen from */ -/* the target body in target body fixed coordinates. */ - -/* Note that this result is not the same as the result of */ -/* calling SPKEZP with the target and observer switched. We */ -/* computed the vector FROM the observer TO the target in */ -/* order to get the proper light time and stellar aberration */ -/* corrections (if requested). Now we need the inverse of */ -/* that corrected vector in order to compute the intercept */ -/* point. */ - - spkezp_(&trgcde, et, frname, loccor, &obscde, tpos, <, (ftnlen)80, ( - ftnlen)15); - -/* Negate the target's position to obtain the position of the */ -/* observer relative to the target. */ - - vminus_(tpos, obspos); - -/* We now need to convert the direction vector into the */ -/* body fixed frame associated with the target. The target */ -/* epoch is dependent on the aberration correction. The */ -/* coefficient S has been set to give us the correct answer */ -/* for each case. */ - - *trgepc = *et + s * lt; - -/* Determine the attributes of the frame designated by DREF. */ - - namfrm_(dref, &refcde, dref_len); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - frinfo_(&refcde, ¢er, &type__, &typeid, &fnd); - if (! fnd) { - setmsg_("Reference frame # is not recognized by the SPICE frame subs" - "ystem. Possibly a required frame definition kernel has not " - "been loaded.", (ftnlen)131); - errch_("#", dref, (ftnlen)1, dref_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Transform the direction vector from frame DREF to the body-fixed */ -/* frame associated with the target. The epoch TRGEPC associated */ -/* with the body-fixed frame has been set already. */ - -/* We'll compute the transformation in two parts: first */ -/* from frame DREF to J2000, then from J2000 to the target */ -/* frame. */ - - if (type__ == 1) { - -/* Inertial frames can be evaluated at any epoch. */ - - refepc = *et; - } else if (! uselt) { - -/* We're not using light time corrections (converged or */ -/* otherwise), so there's no time offset. */ - - refepc = *et; - } else if (center == obscde) { - -/* If the center of frame DREF is the observer (which is */ -/* usually the case if the observer is a spacecraft), then */ -/* the epoch of frame DREF is simply ET. */ - -/* There's no offset between the center for frame DREF */ -/* and the observer. */ - - refepc = *et; - } else { - -/* Find the light time from the observer to the center of */ -/* frame DREF. */ - - spkezp_(¢er, et, "J2000", loccor, &obscde, rpos, <cent, (ftnlen) - 5, (ftnlen)15); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - refepc = *et + s * ltcent; - } - -/* The epoch REFEPC associated with frame DREF has been set. */ - -/* Compute the transformation from frame DREF to J2000 and the */ -/* transformation from J2000 to the target body-fixed frame. */ - -/* Map DVEC to both the J2000 and target body-fixed frames. We'll */ -/* store DVEC, expressed relative to the J2000 frame, in the */ -/* variable J2DIR. DVEC in the target body-fixed frame will be */ -/* stored in TRGDIR. */ - -/* We may need both versions of DVEC: if we use light time */ -/* correction, we'll update "intercept epoch", and hence the */ -/* transformation between J2000 and the target body-fixed frame. */ -/* The transformation between DREF and J2000 doesn't change, on the */ -/* other hand, so we don't have to recompute J2DIR. We need TRGDIR */ -/* in all cases. */ - - pxform_(dref, "J2000", &refepc, r2jmat, dref_len, (ftnlen)5); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - mxv_(r2jmat, dvec, j2dir); - -/* Map J2DIR (in the J2000 frame) to the target body-fixed */ -/* frame. */ - - pxform_("J2000", frname, trgepc, j2tmat, (ftnlen)5, (ftnlen)80); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - mxv_(j2tmat, j2dir, trgdir); - -/* At this point, */ - -/* TRGEPC is set. */ -/* TRGDIR is set. */ -/* J2DIR is set. */ - - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. We'll use this in */ -/* several places later. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - -/* If we're using stellar aberration correction, at this point we'll */ -/* account for it. We're going to find a surface point such that */ -/* the radiation path from that point to the observer, after */ -/* correction for stellar aberration, is parallel to the ray. So */ -/* by applying the inverse of the correction to the ray, we obtain */ -/* the ray with which we must perform our intercept computation. */ - - if (usestl) { - -/* We approximate the inverse stellar aberration correction by */ -/* using the correction for the reverse transmission direction. */ -/* If we're in the reception case, we apply the transmission */ -/* stellar aberration correction to J2DIR and vice versa. */ - - if (xmit) { - -/* Use reception stellar aberration correction */ -/* routine STELAB to generate a first estimate of */ -/* the direction vector after stellar aberration */ -/* has been "removed"---that is, apply the inverse */ -/* of the transmission stellar aberration correction */ -/* mapping to J2DIR. */ - - stelab_(j2dir, &ssbost[3], stldir); - -/* Estimate the error in our first approximation */ -/* by applying the transmission stellar aberration */ -/* to STLDIR and finding the difference with J2DIR. */ - - stlabx_(stldir, &ssbost[3], j2est); - vsub_(j2dir, j2est, stlerr); - -/* Adding the error in the transmission mapping to STLDIR */ -/* will give us a second-order estimate of the inverse. */ - - vadd_(stlerr, stldir, stltmp); - vequ_(stltmp, stldir); - -/* At this point we've found a good estimate of the */ -/* direction vector under the inverse of the transmission */ -/* stellar aberration correction mapping. */ - - } else { - -/* Use transmission stellar aberration correction */ -/* routine STLABX to generate a first estimate of */ -/* the direction vector after stellar aberration */ -/* has been "removed." */ - - stlabx_(j2dir, &ssbost[3], stldir); - -/* Estimate the error in our first approximation */ -/* by applying the reception stellar aberration */ -/* to STLDIR and finding the difference with J2DIR. */ - - stelab_(stldir, &ssbost[3], j2est); - vsub_(j2dir, j2est, stlerr); - -/* Adding the error in the reception mapping to STLDIR */ -/* will give us a second-order estimate of the inverse. */ - - vadd_(stlerr, stldir, stltmp); - vequ_(stltmp, stldir); - -/* At this point we've found a good estimate of the */ -/* direction vector under the inverse of the reception */ -/* stellar aberration correction mapping. */ - - } - -/* Replace the J2000-relative ray direction with the corrected */ -/* direction. */ - - vequ_(stldir, j2dir); - mxv_(j2tmat, j2dir, trgdir); - } - -/* Find the surface intercept point and distance from observer to */ -/* intercept point using the specified geometric definition. */ - - if (eqstr_(method, "Ellipsoid", method_len, (ftnlen)9)) { - -/* Find the surface intercept given the target epoch, */ -/* observer-target position, and target body orientation */ -/* we've already computed. If we're not using light */ -/* time correction, this is all we must do. Otherwise, */ -/* our result will give us an initial estimate of the */ -/* target epoch, which we'll then improve. */ - -/* Get the radii of the target body from the kernel pool. */ - - bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5); - -/* Make an easy test to see whether we can quit now because */ -/* an intercept cannot exist. If the ray is separated from */ -/* the observer-target center vector by more than (MARGIN * */ -/* the maximum triaxial radius), we're done. Let REJECT be */ -/* the angular separation limit. */ - -/* Computing MAX */ - d__1 = max(radii[0],radii[1]); - maxrad = max(d__1,radii[2]); - range = vnorm_(obspos); - if (range == 0.) { - -/* We've already ensured that observer and target are */ -/* distinct, so this should be a very unusual occurrence. */ - - setmsg_("Observer-target distance is zero.", (ftnlen)33); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - if (range > maxrad * 1.001) { - -/* Compute the arc sine with SPICE error checking. */ - - d__1 = maxrad * 1.001 / range; - reject = dasine_(&d__1, &c_b45); - vminus_(obspos, negpos); - if (vsep_(negpos, trgdir) > reject) { - -/* The angular separation of ray and target is too great */ -/* for a solution to exist, even with a better light time */ -/* estimate. */ - - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - } - -/* Locate the nearest point to the observer on the target. */ - - surfpt_(obspos, trgdir, radii, &radii[1], &radii[2], spoint, found); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* If we're not using light time corrections, we're almost */ -/* done now. TRGEPC, OBSPOS, and FOUND have been set. */ -/* If an intercept was found, SPOINT has been set as well. */ -/* We haven't yet computed DIST. */ - - if (! uselt) { - if (*found) { - *dist = vdist_(obspos, spoint); - } - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - if (! (*found)) { - -/* If there's no intercept, we're probably done. However, */ -/* we need to guard against the possibility that the ray does */ -/* intersect the ellipsoid but we haven't discovered it */ -/* because our first light time estimate was too poor. */ - -/* We'll make an improved light time estimate as follows: */ -/* Find the nearest point on the ellipsoid to the ray. Find */ -/* the light time between the observer and this point. */ - -/* If we're using converged Newtonian corrections, we */ -/* iterate this procedure up to two times. */ - - if (usecn) { - nitr = 2; - } else { - nitr = 1; - } - i__ = 1; - while(i__ <= nitr && ! (*found)) { - npedln_(radii, &radii[1], &radii[2], obspos, trgdir, pnear, & - rayalt); - lt = vdist_(obspos, pnear) / clight_(); - -/* Use the new light time estimate to repeat the intercept */ -/* computation. */ - - *trgepc = *et + s * lt; - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", frname, trgepc, xform, (ftnlen)5, (ftnlen)80) - ; - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Convert the observer's position relative to the target */ -/* from the J2000 frame to the target frame at the target */ -/* epoch. */ - - mxv_(xform, j2pos, obspos); - -/* Convert the ray's direction vector from the J2000 frame */ -/* to the target frame at the target epoch. */ - - mxv_(xform, j2dir, trgdir); - -/* Repeat the intercept computation. */ - - surfpt_(obspos, trgdir, radii, &radii[1], &radii[2], spoint, - found); - ++i__; - } - -/* If there's still no intercept, we're done. */ - - if (! (*found)) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - } - -/* We've got an intersection. SURFPT doesn't compute range, so do */ -/* it here. */ - - *dist = vdist_(obspos, spoint); - -/* Since we're using light time corrections, we're going to make */ -/* an estimate of light time to the intercept point, then re-do */ -/* our computation of the target position and orientation using */ -/* the new light time value. */ - - if (usecn) { - nitr = 10; - } else { - nitr = 1; - } - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - -/* Compute new light time estimate and new target epoch. */ - - lt = *dist / clight_(); - *trgepc = *et + s * lt; - prevlt = 0.; - prevet = *trgepc; - i__ = 0; - ltdiff = 1.; - etdiff = 1.; - while(i__ < nitr && ltdiff > abs(lt) * 1e-17 && etdiff > 0.) { - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", frname, trgepc, xform, (ftnlen)5, (ftnlen)80); - if (failed_()) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Convert the observer's position relative to the target from */ -/* the J2000 frame to the target frame at the target epoch. */ - - mxv_(xform, j2pos, obspos); - vminus_(obspos, negpos); - -/* Convert the ray's direction vector from the J2000 frame */ -/* to the target frame at the target epoch. */ - - mxv_(xform, j2dir, trgdir); - -/* Repeat the intercept computation. */ - - surfpt_(obspos, trgdir, radii, &radii[1], &radii[2], spoint, - found); - -/* If there's no intercept, we're done. */ - - if (! (*found)) { - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* Compute the distance between intercept and observer. */ - - *dist = vdist_(obspos, spoint); - -/* Compute new light time estimate and new target epoch. */ - - lt = *dist / clight_(); - *trgepc = *et + s * lt; - -/* We use the d.p. identity function TOUCHD to force the */ -/* compiler to create double precision arguments from the */ -/* differences LT-PREVLT and TRGEPC-PREVET. Some compilers */ -/* will perform extended-precision register arithmetic, which */ -/* can prevent a difference from rounding to zero. Simply */ -/* storing the result of the subtraction in a double precision */ -/* variable doesn't solve the problem, because that variable */ -/* can be optimized out of existence. */ - - d__2 = lt - prevlt; - ltdiff = (d__1 = touchd_(&d__2), abs(d__1)); - d__2 = *trgepc - prevet; - etdiff = (d__1 = touchd_(&d__2), abs(d__1)); - prevlt = lt; - prevet = *trgepc; - ++i__; - } - } else { - setmsg_("The computation method # was not recognized. ", (ftnlen)45); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SRFXPT", (ftnlen)6); - return 0; - } - -/* FOUND, SPOINT, TRGEPC, and DIST have been set at this point. */ - - chkout_("SRFXPT", (ftnlen)6); - return 0; -} /* srfxpt_ */ - diff --git a/ext/spice/src/cspice/srfxpt_c.c b/ext/spice/src/cspice/srfxpt_c.c deleted file mode 100644 index 0c57004e4b..0000000000 --- a/ext/spice/src/cspice/srfxpt_c.c +++ /dev/null @@ -1,996 +0,0 @@ -/* - --Procedure srfxpt_c ( Surface intercept point ) - --Abstract - - Deprecated: This routine has been superseded by the CSPICE - routine sincpt_c. This routine is supported for purposes of - backward compatibility only. - - Given an observer and a direction vector defining a ray, compute the - surface intercept point of the ray on a target body at a specified - epoch, optionally corrected for light time and stellar aberration. - --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 - - FRAMES - NAIF_IDS - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #undef srfxpt_c - - - void srfxpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * dist, - SpiceDouble * trgepc, - SpiceDouble obspos [3], - SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - abcorr I Aberration correction. - obsrvr I Name of observing body. - dref I Reference frame of input direction vector. - dvec I Ray's direction vector. - spoint O Surface intercept point on the target body. - dist O Distance from the observer to the intercept point. - trgepc O Intercept epoch. - obspos O Observer position relative to target center. - found O Flag indicating whether intercept was found. - --Detailed_Input - - method is a short string providing parameters defining - the computation method to be used. Parameters - include, but are not limited to, the shape model - used to represent the surface of the target body. - - The only choice currently supported is - - "Ellipsoid" The intercept computation uses - a triaxial ellipsoid to model - the surface of the target body. - The ellipsoid's radii must be - available in the kernel pool. - - Neither case nor white space are significant in - `method'. For example, the string " eLLipsoid " is - valid. - - In a later Toolkit release, this argument will be - used to invoke a wider range of surface - representations. For example, it will be possible to - represent the target body's surface using a digital - model. - - - target is the name of the target body. `target' is - case-insensitive, and leading and trailing blanks in - `target' are not significant. Optionally, you may supply - a string containing the integer ID code for the object. - For example both "MOON" and "301" are legitimate strings - that indicate the moon is the target body. - - When the target body's surface is represented by a - tri-axial ellipsoid, this routine assumes that a kernel - variable representing the ellipsoid's radii is present - in the kernel pool. Normally the kernel variable would - be defined by loading a PCK file. - - - et is the epoch of participation of the observer, expressed - as ephemeris seconds past J2000 TDB: `et' is the epoch - at which the observer's state is computed. - - When aberration corrections are not used, `et' is also - the epoch at which the state and orientation of the - target body are computed. - - When aberration corrections are used, `et' is the epoch - at which the observer's state relative to the solar - system barycenter is computed; in this case the position - and orientation of the target body are computed at et-lt - or et+lt, where `lt' is the one-way light time between - the intercept point and the observer, and the sign - applied to lt depends on the selected correction. See - the description of `abcorr' below for details. - - - abcorr indicates the aberration correction to be applied - when computing the observer-target state and the - orientation of the target body. `abcorr' may be any of - the following. - - "NONE" Apply no correction. Return the - geometric surface intercept point on the - target body. - - Let `lt' represent the one-way light time between the - observer and the surface intercept point (note: NOT - between the observer and the target body's center). - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - intercept point's location at the light-time - corrected epoch et-lt and *arrive* at the observer's - location at `et': - - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the location of the surface - intercept point at the moment it - emitted photons arriving at the - observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "LT" option uses one iteration. - - Both the target state as seen by the - observer, and rotation of the target - body, are corrected for light time. - - "LT+S" Correct for one-way light time and - stellar aberration using a Newtonian - formulation. This option modifies the - state obtained with the "LT" option to - account for the observer's velocity - relative to the solar system - barycenter. The result is the apparent - surface intercept point as seen by the - observer. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges. Both the - state and rotation of the target body - are corrected for light time. - - "CN+S" Converged Newtonian light time - and stellar aberration corrections. - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - intercept point at the light-time corrected epoch - et+lt: - - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - intercept location at the moment it - receives photons emitted from the - observer's location at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "LT" option uses one iteration. - - Both the target state as seen by the - observer, and rotation of the target - body, are corrected for light time. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - intercept obtained with the "XLT" - option to account for the observer's - velocity relative to the solar system - barycenter. - - "XCN" Converged Newtonian light time - correction. This is the same as "XLT" - correction but with further iterations - to a converged Newtonian light time - solution. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - - obsrvr is the name of the observing body. This is typically - a spacecraft, the earth, or a surface point on the - earth. `obsrvr' is case-insensitive, and leading and - trailing blanks in `obsrvr' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both - "EARTH" and "399" are legitimate strings that indicate - the earth is the observer. - - - dref is the name of the reference frame relative to which the - input direction vector is expressed. This may be any - frame supported by the SPICE system, including built-in - frames (documented in the Frames Required Reading) and - frames defined by a loaded frame kernel (FK). - - When `dref' designates a non-inertial frame, the - orientation of the frame is evaluated at an epoch - dependent on the frame's center and, if the center is - not the observer, on the selected aberration - correction. See the description of the direction - vector `dvec' for details. - - - dvec Pointing vector emanating from the observer. The - intercept with the target body's surface of the ray - defined by the observer and `dvec' is sought. - - `dvec' is specified relative to the reference frame - designated by `dref'. - - Non-inertial reference frames are treated as follows: - if the center of the frame is at the observer's - location, the frame is evaluated at `et'. If the - frame's center is located elsewhere, then letting - `ltcent' be the one-way light time between the observer - and the central body associated with the frame, the - orientation of the frame is evaluated at et-ltcent, - et+ltcent, or `et' depending on whether the requested - aberration correction is, respectively, for received - radiation, transmitted radiation, or is omitted. - `ltcent' is computed using the method indicated by - `abcorr'. - --Detailed_Output - - - spoint is the surface intercept point on the target body of - the ray defined by the observer and the direction - vector. If the ray intersects the target body in - multiple points, the selected intersection point is - the one closest to the observer. The output - argument `found' (see below) indicates whether an - intercept was found. - - `spoint' is expressed in Cartesian coordinates, - relative to the body-fixed frame associated with the - target body. The body-fixed target frame is - evaluated at the intercept epoch `trgepc' (see - description below). - - When light time correction is used, the duration of - light travel between `spoint' to the observer is - considered to be the one way light time. When both - light time and stellar aberration corrections are - used, `spoint' is selected such that, when `spoint' is - corrected for light time and the vector from the - observer to the light-time corrected location of - `spoint' is corrected for stellar aberration, the - resulting vector is parallel to the ray defined by - the observer's location and `dvec'. - - The components of `spoint' are given in units of km. - - - dist is the distance between the observer and the surface - intercept on the target body. `dist' is given in units - of km. - - - trgepc is the "intercept epoch." This is the epoch at which - the ray defined by `obsrvr' and `dvec' intercepts the - target surface at `spoint'. `trgepc' is defined as - follows: letting `lt' be the one-way light time between - the observer and the intercept point, `trgepc' is the - epoch et-lt, et+lt, or `et' depending on whether the - requested aberration correction is, respectively, for - received radiation, transmitted radiation, or - omitted. `lt' is computed using the method indicated by - `abcorr'. - - `trgepc' is expressed as seconds past J2000 TDB. - - - obspos is the vector from the center of the target body at - epoch `trgepc' to the observer at epoch `et'. `obspos' is - expressed in the target body-fixed reference frame - evaluated at `trgepc'. (This is the frame relative to - which `spoint' is given.) - - `obspos' is returned to simplify various related - computations that would otherwise be cumbersome. For - example, the vector `xvec' from the observer to `spoint' - can be calculated via the call - - vsub_c ( spoint, obspos, xvec ); - - The components of `obspos' are given in units of km. - - - found A logical flag indicating whether or not the ray - intersects the target. If an intersection exists - `found' will be returned as SPICETRUE. If the ray misses - the target, `found' will be returned as SPICEFALSE. - --Parameters - - None. - --Exceptions - - If any of the listed errors occur, the output arguments are - left unchanged. - - - 1) If the input argument `method' is not recognized, the error - SPICE(INVALIDMETHOD) is signaled. - - 2) If `obsrvr' and `target' map to the same NAIF integer ID codes, - the error SPICE(BODIESNOTDISTINCT) is signaled. - - 3) If frame definition data enabling the evaluation of the state - of the target relative to the observer in target body-fixed - coordinates have not been loaded prior to calling srfxpt_c, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 4) If the specified aberration correction is not recognized, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 5) If insufficient ephemeris data have been loaded prior to - calling srfxpt_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. Note that when - light time correction is used, sufficient ephemeris data - must be available to propagate the states of both observer - and target to the solar system barycenter. - - 6) If the computation method has been specified as "Ellipsoid" - and triaxial radii of the target body have not been loaded - into the kernel pool prior to calling srfxpt_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 7) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 8) If PCK data supplying a rotation model for the target body - have not been loaded prior to calling srfxpt_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 9) If the reference frame designated by `dref' is not recognized, - the error SPICE(NOTSUPPORTED) will be signaled. - - 10) If the direction vector `dvec' is the zero vector, the error - SPICE(ZEROVECTOR) will be signaled. - - 11) If any of the input string pointers `method', `target', - `abcorr', `obsrvr', or `dref' are null, the error - SPICE(NULLPOINTER) will be signaled. - - 12) If any of the input strings referred to by `method', `target', - `abcorr', `obsrvr', or `dref' contain no data characters, the - error SPICE(EMPTYSTRING) will be signaled. - --Files - - Appropriate SPK, PCK, and frame kernels must be loaded by the - calling program before this routine is called. CK, SCLK, and - IK kernels may be required as well. - - The following data are required: - - - SPK data: ephemeris data for target and observer must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - PCK data: if the computation method is specified as - "Ellipsoid," triaxial radii for the target body must be - loaded into the kernel pool. Typically this is done by - loading a text PCK file via furnsh_c. - - - Further PCK data: rotation data for the target body must - be loaded. These may be provided in a text or binary PCK - file. - - - Frame data: if a frame definition is required to convert - the observer and target states to the body-fixed frame of - the target, that definition must be available in the kernel - pool. Similarly, the frame definition required to map - between the frame designated by `dref' and the target - body-fixed frame must be available. Typically the - definitions of frames not already built-in to SPICE are - supplied by loading a frame kernel. - - The following data may be required: - - - CK data: if the frame to which `dref' refers is fixed to - a spacecraft instrument or structure, at least one CK file will - be needed to permit transformation of vectors between that - frame and both J2000 and the target body-fixed frame. - - - SCLK data: if a CK file is needed, an associated SCLK kernel - is required to enable conversion between encoded SCLK - (used to time-tag CK data) and barycentric dynamical time - (TDB). - - - IK data: one or more I-kernels may be required to - enable transformation of vectors from an instrument-fixed - frame to a spacecraft-fixed frame whose attitude is given - by a C-kernel. - - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - Given a ray defined by a direction vector and the location of an - observer, srfxpt_c computes the surface intercept point of the ray - on a specified target body. srfxpt_c also determines the distance - between the observer and the surface intercept point. - - When aberration corrections are used, this routine finds the - value of `spoint' such that, if `spoint' is regarded as an ephemeris - object, after the selected aberration corrections are applied to - the vector from the observer to `spoint', the resulting vector is - parallel to the direction vector `dvec'. - - This routine computes light time corrections using light time - between the observer and the surface intercept point, as opposed - to the center of the target. Similarly, stellar aberration - corrections done by this routine are based on the direction of - the vector from the observer to the light-time corrected - intercept point, not to the target center. This technique avoids - errors due to the differential between aberration corrections - across the target body. Therefore it's valid to use aberration - corrections with this routine even when the observer is very - close to the intercept point, in particular when the - observer-intercept point distance is much less than the - observer-target center distance. It's also valid to use stellar - aberration corrections even when the intercept point is near or - on the limb (as may occur in occultation computations using a - point target). - - When comparing surface intercept point computations with results - from sources other than SPICE, it's essential to make sure the - same geometric definitions are used. - --Examples - - The numerical results shown for this example may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - Example 1 - --------- - - The following program computes surface intercept points on - Mars for the boresight and FOV boundary vectors of the - MGS MOC narrow angle camera. The intercepts are computed - for a single observation epoch. Light time and stellar - aberration corrections are used. For simplicity, camera - distortion is ignored. - - - #include - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - int main() - { - - /. - Local parameters - ./ - - #define ABCLEN 20 - #define LNSIZE 81 - #define METLEN 41 - #define NAMLEN 33 - #define TIMLEN 51 - #define SHPLEN 81 - #define NCORNR 4 - - - /. - Local variables - ./ - SpiceBoolean found; - - SpiceChar * abcorr = "LT+S"; - SpiceChar * camera = "MGS_MOC_NA"; - SpiceChar dref [NAMLEN]; - SpiceChar * method = "Ellipsoid"; - SpiceChar * obsrvr = "MGS"; - SpiceChar shape [ SHPLEN ]; - SpiceChar * target = "Mars"; - SpiceChar title [ LNSIZE ]; - SpiceChar * utc = "2003 OCT 13 06:00:00 UTC"; - - SpiceDouble bounds [NCORNR][3]; - SpiceDouble bsight [3]; - SpiceDouble dist; - SpiceDouble dvec [3]; - SpiceDouble et; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble obspos [3]; - SpiceDouble radius; - SpiceDouble spoint [3]; - SpiceDouble trgepc; - - SpiceInt camid; - SpiceInt i; - SpiceInt n; - - - /. - Load kernel files: - - - Leapseconds kernel - - MGS SCLK kernel - - Text PCK file - - Planetary SPK file - - MGS I-kernel - - MGS spacecraft bus C-kernel - - MGS SPK file - ./ - furnsh_c ( "naif0007.tls" ); - furnsh_c ( "mgs_sclkscet_00052.tsc" ); - furnsh_c ( "mars_iau2000_v0.tpc" ); - furnsh_c ( "de405s.bsp" ); - furnsh_c ( "mgs_moc_v20.ti" ); - furnsh_c ( "mgs_sc_ext12.bc" ); - furnsh_c ( "mgs_ext12.bsp" ); - - /. - Convert the UTC request time to ET (seconds past - J2000, TDB). - ./ - str2et_c ( utc, &et ); - - /. - Get the MGS MOC Narrow angle camera (MGS_MOC_NA) - ID code. Then look up the field of view (FOV) - parameters. - ./ - bodn2c_c ( camera, &camid, &found ); - - if ( !found ) - { - setmsg_c ( "Could not find ID code for " - "instrument #." ); - errch_c ( "#", camera ); - sigerr_c ( "SPICE(NOTRANSLATION)" ); - } - - getfov_c ( camid, NCORNR, SHPLEN, NAMLEN, - shape, dref, bsight, &n, bounds ); - - - printf ( "\n" - "Surface Intercept Locations for Camera\n" - "FOV Boundary and Boresight Vectors\n" - "\n" - " Instrument: %s\n" - " Epoch: %s\n" - " Aberration correction: %s\n" - "\n", - camera, utc, abcorr ); - - /. - Now compute and display the surface intercepts for the - boresight and all of the FOV boundary vectors. - ./ - - for ( i = 0; i <= NCORNR; i++ ) - { - if ( i < NCORNR ) - { - sprintf ( title, "Corner vector %ld", i ); - - vequ_c ( bounds[i], dvec ); - } - else - { - strcpy ( title, "Boresight vector" ); - - vequ_c ( bsight, dvec ); - } - - /. - Compute the surface intercept point using - the specified aberration corrections. - - srfxpt_c will signal an error if required kernel - data are unavailable. See example (2) below for - a suggestion on detecting absence of C-kernel - data prior to calling srfxpt_c. - ./ - srfxpt_c ( method, - target, et, abcorr, - obsrvr, dref, dvec, - spoint, &dist, &trgepc, obspos, &found ); - - if ( found ) - { - /. - Convert rectangular coordinates to planetocentric - latitude and longitude. Convert radians to degrees. - ./ - reclat_c ( spoint, &radius, &lon, &lat ); - - lon *= dpr_c (); - lat *= dpr_c (); - - /. - Display the results. - ./ - - printf ( "\n" - "%s\n", title ); - - sprintf ( title, " Vector in %s frame = ", dref ); - - printf ( "\n" - "%s\n", title ); - - if ( i < NCORNR ) - { - printf ( " %18.10e %18.10e %18.10e\n", - bounds[i][0], bounds[i][1], bounds[i][2] ); - } - else - { - printf ( " %18.10e %18.10e %18.10e\n", - bsight[0], bsight[1], bsight[2] ); - } - - printf ( "\n" - " Intercept:\n" - "\n" - " Radius (km) = %18.10e\n" - " Planetocentric Latitude (deg) = %18.10e\n" - " Planetocentric Longitude (deg) = %18.10e\n" - " Range (km) = %18.10e\n" - "\n", - radius, lat, lon, dist ); - } - else - { - printf ( "\n" - "Intercept not found.\n" - "\n" ); - } - - } - return ( 0 ); - } - - - When this program is executed, the output will be: - - - Surface Intercept Locations for Camera - FOV Boundary and Boresight Vectors - - Instrument: MGS_MOC_NA - Epoch: 2003 OCT 13 06:00:00 UTC - Aberration correction: LT+S - - - Corner vector 0 - - Vector in MGS_MOC_NA frame = - 1.8571383810e-06 -3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849412615e+03 - Planetocentric Latitude (deg) = -4.8477118861e+01 - Planetocentric Longitude (deg) = -1.2347365507e+02 - Range (km) = 3.8898362745e+02 - - - Corner vector 1 - - Vector in MGS_MOC_NA frame = - 1.8571383810e-06 3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849398244e+03 - Planetocentric Latitude (deg) = -4.8481272936e+01 - Planetocentric Longitude (deg) = -1.2339839939e+02 - Range (km) = 3.8897565851e+02 - - - Corner vector 2 - - Vector in MGS_MOC_NA frame = - -1.8571383810e-06 3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849398156e+03 - Planetocentric Latitude (deg) = -4.8481298506e+01 - Planetocentric Longitude (deg) = -1.2339840260e+02 - Range (km) = 3.8897519958e+02 - - - Corner vector 3 - - Vector in MGS_MOC_NA frame = - -1.8571383810e-06 -3.8015622659e-03 9.9999277403e-01 - - Intercept: - - Radius (km) = 3.3849412527e+03 - Planetocentric Latitude (deg) = -4.8477144435e+01 - Planetocentric Longitude (deg) = -1.2347365823e+02 - Range (km) = 3.8898316850e+02 - - - Boresight vector - - Vector in MGS_MOC_NA frame = - 0.0000000000e+00 0.0000000000e+00 1.0000000000e+00 - - Intercept: - - Radius (km) = 3.3849405358e+03 - Planetocentric Latitude (deg) = -4.8479216591e+01 - Planetocentric Longitude (deg) = -1.2343603019e+02 - Range (km) = 3.8897626607e+02 - - - - Example 2 - --------- - - srfxpt_c will signal an error if required kernel data are - unavailable: for example, in the program of Example 1, if the - C-kernel containing data for the MGS bus had a gap at epoch `et', - srfxpt_c would be unable to transform the direction vector `dvec' - from the reference frame fixed to the camera to the reference - frame fixed to the target body. - - We could modify the code of Example 1 as shown below to test for - the availability of C-kernel data. We would add the declarations - shown, and we'd call the C-kernel reader ckgp_c to find whether the - desired pointing was available. Depending on the value of the - `found' flag returned by ckgp_c, we'd go on to compute the surface - intercept point or respond to the error condition. - - - . - . - . - /. - Local parameters - ./ - #define BUSID ( -94000 ) - #define MGS ( -94 ) - . - . - . - - /. - Local variables - ./ - SpiceDouble clkout; - SpiceDouble cmat [3][3]; - SpiceDouble sclkdp; - - . - . - . - /. - Look up the transformation from the J2000 frame to the - MGS spacecraft frame. To do this, we'll need to represent - our observation epoch in terms of MGS encoded SCLK. - ./ - sce2c_c ( MGS, et, &sclkdp ); - - /. - Look up the spacecraft attitude from the C-kernel. - ./ - ckgp_c ( BUSID, sclkdp, 0., "J2000", - cmat, &clkout, &found ); - - if ( found ) - { - - [Proceed to compute intercept point] - } - else - { - - [Handle case where pointing is unavailable - for the epoch of interest] - } - . - . - . - - --Restrictions - - A cautionary note: if aberration corrections are used, and - if `dref' is the target body-fixed frame, the epoch at which that - frame is evaluated is offset from `et' by the light time between the - observer and the *center* of the target body. This light time - normally will differ from the light time between the observer and - intercept point. Consequently the orientation of the target - body-fixed frame at `trgepc' will not match that of the target - body-fixed frame at the epoch associated with `dref'. As a result, - various derived quantities may not be as expected: for example, - `obspos' would not be the inverse of the aberration-corrected - position of the target as seen by the observer. - - In many applications the errors arising from this frame - discrepancy may be insignificant; however a safe approach is to - always use as `dref' a frame other than the target body-fixed - frame. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.3, 19-MAY-2010 (BVS) - - Index line now states that this routine is deprecated. - - -CSPICE Version 1.0.2, 07-FEB-2008 (NJB) - - Abstract now states that this routine is deprecated. - - Header typo was corrected; reference to vminus_c was replaced - with reference to vsub_c. - - -CSPICE Version 1.0.1, 22-JUL-2004 (NJB) - - Made trivial change to description of `obsrvr' in - Detailed Input header section. - - -CSPICE Version 1.0.0, 27-FEB-2004 (NJB) - --Index_Entries - - DEPRECATED surface intercept point - --& -*/ - -{ /* Begin srfxpt_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "srfxpt_c" ); - - /* - Check the input string arguments: - - method - target - abcorr - obsrvr - dref - - Make sure each pointer is non-null and each string contains - at least one data character: that is, one character - preceding the null terminator. - */ - CHKFSTR ( CHK_STANDARD, "srfxpt_c", method ); - CHKFSTR ( CHK_STANDARD, "srfxpt_c", target ); - CHKFSTR ( CHK_STANDARD, "srfxpt_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "srfxpt_c", obsrvr ); - CHKFSTR ( CHK_STANDARD, "srfxpt_c", dref ); - - /* - Call the f2c'd SPICELIB function. - */ - srfxpt_ ( (char *) method, - (char *) target, - (doublereal *) &et, - (char *) abcorr, - (char *) obsrvr, - (char *) dref, - (doublereal *) dvec, - (doublereal *) spoint, - (doublereal *) dist, - (doublereal *) trgepc, - (doublereal *) obspos, - (logical *) &fnd, - (ftnlen ) strlen(method), - (ftnlen ) strlen(target), - (ftnlen ) strlen(abcorr), - (ftnlen ) strlen(obsrvr), - (ftnlen ) strlen(dref) ); - - /* - Move the found flag into a variable of type SpiceBoolean. - The SpiceBoolean type may have a different size than - the logical type. - */ - - *found = fnd; - - chkout_c ( "srfxpt_c" ); - -} /* End srfxpt_c */ diff --git a/ext/spice/src/cspice/ssize_c.c b/ext/spice/src/cspice/ssize_c.c deleted file mode 100644 index 6d245898c4..0000000000 --- a/ext/spice/src/cspice/ssize_c.c +++ /dev/null @@ -1,218 +0,0 @@ -/* - --Procedure ssize_c ( Set the size of a cell ) - --Abstract - - Set the size (maximum cardinality) of a CSPICE cell of any data - type. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void ssize_c ( SpiceInt size, - SpiceCell * cell ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - size I Size (maximum cardinality) of the cell. - cell O The cell. - --Detailed_Input - - size is the new value of the size (maximum number of - elements) of the cell. - - size must be non-negative and must be no larger than - the initial declared size of the cell. - - - cell is a CSPICE cell of any data type. - --Detailed_Output - - - cell is, on output, the cell with its size updated to - the value given by the input argument size. - - The cardinality of the cell is set to 0. - - The cell becomes a CSPICE set: the cell's "is a set?" - attribute becomes true. The cell then can be used as - an input to the CSPICE set routines such as insrt*_c. - - Unlike the cell "set size" routines in the Fortran - SPICE Toolkit's SPICELIB library, this routine does - not clear the unused portion of the cell's control - area. - --Parameters - - None. - --Exceptions - - 1) If an attempt is made to set the size of the cell to a negative - number, the error SPICE(INVALIDSIZE) is signaled. - - 2) The size of a cell may not be set to a value larger than the - original declared size. However, the CSPICE cell routines - cannot detect this error. - --Files - - None. - --Particulars - - Unlike their counterparts in the Fortran SPICELIB library, - CSPICE cells are initialized automatically when accessed via - the CSPICE cell API routines, so there is normally no reason to - call this routine. - - This routine is provided for the sake of completeness. - --Examples - - 1) Declare an integer cell. Populate the cell, then reset - the size to 1/2 the originally declared size, in order - to inhibit write access to the last portion of the cell. - - #include "SpiceUsr.h" - . - . - . - - #define SIZE 10 - - /. - Declare a cell with room for SIZE integers. - ./ - SPICEINT_CELL ( icell, SIZE ); - . - . - . - /. - Reduce the size of the cell. - ./ - ssize_c ( SIZE/2, &icell ); - - --Restrictions - - See exception #2 in the Exceptions section. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 21-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - set the size of a cell --& -*/ - -{ /* Begin ssize_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "ssize_c" ); - - - if ( size < 0 ) - { - setmsg_c ( "Attempt to set the size of cell to invalid " - "value. The value was #." ); - errint_c ( "#", size ); - sigerr_c ( "SPICE(INVALIDSIZE)" ); - chkout_c ( "ssize_c" ); - return; - } - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( cell ); - - - /* - Do what the Fortran ssizec routine does: set the cell's size - and reset the cardinality to zero. - */ - cell->size = size; - cell->card = 0; - - - /* - Sync the cell. - */ - zzsynccl_c ( C2F, cell ); - - - /* - The cell becomes a set since it's empty. - */ - cell->isSet = SPICETRUE; - - - chkout_c ( "ssize_c" ); - -} /* End ssize_c */ diff --git a/ext/spice/src/cspice/ssizec.c b/ext/spice/src/cspice/ssizec.c deleted file mode 100644 index d103a9fc17..0000000000 --- a/ext/spice/src/cspice/ssizec.c +++ /dev/null @@ -1,222 +0,0 @@ -/* ssizec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure SSIZEC ( Set the size of a character cell ) */ -/* Subroutine */ int ssizec_(integer *size, char *cell, ftnlen cell_len) -{ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), enchar_(integer *, - char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Set the size (maximum cardinality) of a character cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size (maximum cardinality) of the cell. */ -/* CELL O The cell. */ - -/* $ Detailed_Input */ - -/* SIZE is the size (maximum number of elements) of the cell. */ - -/* $ Detailed_Output */ - - -/* CELL is a cell. */ - - -/* On output, the size of the cell is SIZE. The */ -/* cardinality of the cell is 0. The rest of the */ -/* control area is zeroed out. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */ -/* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */ -/* initialize cells for subsequent use. Since all cell routines */ -/* expect to find the size and cardinality of a cell in place, */ -/* no cell can be used until both have been set. */ - -/* $ Examples */ - -/* In the example below, the size and cardinality of the character */ -/* cell FRED are set in the main module of the program FLNSTN. */ -/* Both are subsequently retrieved, and the cardinality changed, */ -/* in one of its subroutines, WILMA. */ - -/* PROGRAM FLNSTN */ - -/* CHARACTER*30 FRED ( LBCELL:100 ) */ -/* . */ -/* . */ -/* CALL SSIZEC ( 100, FRED ) */ -/* . */ -/* . */ -/* CALL WILMA ( FRED ) */ -/* . */ -/* . */ -/* STOP */ -/* END */ - - -/* SUBROUTINE WILMA ( FRED ) */ - -/* CHARACTER*(*) FRED ( LBCELL:* ) */ -/* INTEGER SIZE */ -/* INTEGER CARD */ - -/* INTEGER CARDC */ -/* INTEGER SIZEC */ -/* . */ -/* . */ -/* SIZE = SIZEC ( FRED ) */ -/* CARD = CARDC ( FRED ) */ -/* . */ -/* . */ -/* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */ -/* CALL EXCESS ( CARD-SIZE, 'cell' ) */ -/* . */ -/* . */ -/* RETURN */ -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the size of a character cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for invalid size value added. An error */ -/* is signalled if the value is out of range. The cardinality */ -/* is now automatically reset to 0. The rest of the control */ -/* area is now zeroed out. */ - -/* The examples have been updated to illustrate set initialization */ -/* without the use of the EMPTYx routines, which have been */ -/* removed from the library. Errors in the examples have been */ -/* removed, also. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("SSIZEC", (ftnlen)6); - } - -/* The size must be non-negative. Other values will be snubbed. */ - - if (*size < 0) { - setmsg_("Attempt to set size of cell to invalid value. The value wa" - "s #.", (ftnlen)63); - errint_("#", size, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("SSIZEC", (ftnlen)6); - return 0; - } - -/* Not much to this. */ - - enchar_(size, cell + (cell_len << 2), cell_len); - enchar_(&c__0, cell + cell_len * 5, cell_len); - for (i__ = -5; i__ <= -2; ++i__) { - enchar_(&c__0, cell + (i__ + 5) * cell_len, cell_len); - } - chkout_("SSIZEC", (ftnlen)6); - return 0; -} /* ssizec_ */ - diff --git a/ext/spice/src/cspice/ssized.c b/ext/spice/src/cspice/ssized.c deleted file mode 100644 index b368d4dd76..0000000000 --- a/ext/spice/src/cspice/ssized.c +++ /dev/null @@ -1,218 +0,0 @@ -/* ssized.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SSIZED ( Set the size of a double precision cell ) */ -/* Subroutine */ int ssized_(integer *size, doublereal *cell) -{ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Set the size (maximum cardinality) of a double precision cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size (maximum cardinality) of the cell. */ -/* CELL O The cell. */ - -/* $ Detailed_Input */ - -/* SIZE is the size (maximum number of elements) of the cell. */ - -/* $ Detailed_Output */ - - -/* CELL is a cell. */ - - -/* On output, the size of the cell is SIZE. The */ -/* cardinality of the cell is 0. The rest of the */ -/* control area is zeroed out. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */ -/* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */ -/* initialize cells for subsequent use. Since all cell routines */ -/* expect to find the size and cardinality of a cell in place, */ -/* no cell can be used until both have been set. */ - -/* $ Examples */ - -/* In the example below, the size and cardinality of the character */ -/* cell FRED are set in the main module of the program FLNSTN. */ -/* Both are subsequently retrieved, and the cardinality changed, */ -/* in one of its subroutines, WILMA. */ - -/* PROGRAM FLNSTN */ - -/* CHARACTER*30 FRED ( LBCELL:100 ) */ -/* . */ -/* . */ -/* CALL SSIZEC ( 100, FRED ) */ -/* . */ -/* . */ -/* CALL WILMA ( FRED ) */ -/* . */ -/* . */ -/* STOP */ -/* END */ - - -/* SUBROUTINE WILMA ( FRED ) */ - -/* CHARACTER*(*) FRED ( LBCELL:* ) */ -/* INTEGER SIZE */ -/* INTEGER CARD */ - -/* INTEGER CARDC */ -/* INTEGER SIZEC */ -/* . */ -/* . */ -/* SIZE = SIZEC ( FRED ) */ -/* CARD = CARDC ( FRED ) */ -/* . */ -/* . */ -/* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */ -/* CALL EXCESS ( CARD-SIZE, 'cell' ) */ -/* . */ -/* . */ -/* RETURN */ -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the size of a d.p. cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for invalid size value added. An error */ -/* is signalled if the value is out of range. The cardinality */ -/* is now automatically reset to 0. The rest of the control */ -/* area is now zeroed out. */ - -/* The examples have been updated to illustrate set initialization */ -/* without the use of the EMPTYx routines, which have been */ -/* removed from the library. Errors in the examples have been */ -/* removed, also. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("SSIZED", (ftnlen)6); - } - -/* The size must be non-negative. Other values will be snubbed. */ - - if (*size < 0) { - setmsg_("Attempt to set size of cell to invalid value. The value wa" - "s #.", (ftnlen)63); - errint_("#", size, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("SSIZED", (ftnlen)6); - return 0; - } - -/* Not much to this. */ - - cell[4] = (doublereal) (*size); - cell[5] = 0.; - for (i__ = -5; i__ <= -2; ++i__) { - cell[i__ + 5] = 0.; - } - chkout_("SSIZED", (ftnlen)6); - return 0; -} /* ssized_ */ - diff --git a/ext/spice/src/cspice/ssizei.c b/ext/spice/src/cspice/ssizei.c deleted file mode 100644 index 975c3006b2..0000000000 --- a/ext/spice/src/cspice/ssizei.c +++ /dev/null @@ -1,218 +0,0 @@ -/* ssizei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SSIZEI ( Set the size of an integer cell ) */ -/* Subroutine */ int ssizei_(integer *size, integer *cell) -{ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Set the size (maximum cardinality) of an integer cell. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size (maximum cardinality) of the cell. */ -/* CELL O The cell. */ - -/* $ Detailed_Input */ - -/* SIZE is the size (maximum number of elements) of the cell. */ - -/* $ Detailed_Output */ - - -/* CELL is a cell. */ - - -/* On output, the size of the cell is SIZE. The */ -/* cardinality of the cell is 0. The rest of the */ -/* control area is zeroed out. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */ -/* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */ -/* initialize cells for subsequent use. Since all cell routines */ -/* expect to find the size and cardinality of a cell in place, */ -/* no cell can be used until both have been set. */ - -/* $ Examples */ - -/* In the example below, the size and cardinality of the character */ -/* cell FRED are set in the main module of the program FLNSTN. */ -/* Both are subsequently retrieved, and the cardinality changed, */ -/* in one of its subroutines, WILMA. */ - -/* PROGRAM FLNSTN */ - -/* CHARACTER*30 FRED ( LBCELL:100 ) */ -/* . */ -/* . */ -/* CALL SSIZEC ( 100, FRED ) */ -/* . */ -/* . */ -/* CALL WILMA ( FRED ) */ -/* . */ -/* . */ -/* STOP */ -/* END */ - - -/* SUBROUTINE WILMA ( FRED ) */ - -/* CHARACTER*(*) FRED ( LBCELL:* ) */ -/* INTEGER SIZE */ -/* INTEGER CARD */ - -/* INTEGER CARDC */ -/* INTEGER SIZEC */ -/* . */ -/* . */ -/* SIZE = SIZEC ( FRED ) */ -/* CARD = CARDC ( FRED ) */ -/* . */ -/* . */ -/* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */ -/* CALL EXCESS ( CARD-SIZE, 'cell' ) */ -/* . */ -/* . */ -/* RETURN */ -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the size of an integer cell */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Check for invalid size value added. An error */ -/* is signalled if the value is out of range. The cardinality */ -/* is now automatically reset to 0. The rest of the control */ -/* area is now zeroed out. */ - -/* The examples have been updated to illustrate set initialization */ -/* without the use of the EMPTYx routines, which have been */ -/* removed from the library. Errors in the examples have been */ -/* removed, also. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("SSIZEI", (ftnlen)6); - } - -/* The size must be non-negative. Other values will be snubbed. */ - - if (*size < 0) { - setmsg_("Attempt to set size of cell to invalid value. The value wa" - "s #.", (ftnlen)63); - errint_("#", size, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("SSIZEI", (ftnlen)6); - return 0; - } - -/* Not much to this. */ - - cell[4] = *size; - cell[5] = 0; - for (i__ = -5; i__ <= -2; ++i__) { - cell[i__ + 5] = 0; - } - chkout_("SSIZEI", (ftnlen)6); - return 0; -} /* ssizei_ */ - diff --git a/ext/spice/src/cspice/stcc01.c b/ext/spice/src/cspice/stcc01.c deleted file mode 100644 index c1e57bfce5..0000000000 --- a/ext/spice/src/cspice/stcc01.c +++ /dev/null @@ -1,452 +0,0 @@ -/* stcc01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure STCC01 ( STAR catalog type 1, check whether type 1 ) */ -/* Subroutine */ int stcc01_(char *catfnm, char *tabnam, logical *istyp1, - char *errmsg, ftnlen catfnm_len, ftnlen tabnam_len, ftnlen errmsg_len) -{ - /* Initialized data */ - - static char cat1nm[32*7] = "CATALOG_NUMBER " "RA " - " " "DEC " "RA_" - "SIGMA " "DEC_SIGMA " - "VISUAL_MAGNITUDE " "SPECTRAL_TYPE " - " "; - static char cat1dt[4*7] = "INT " "DP " "DP " "DP " "DP " "DP " "CHR " - ; - - /* System generated locals */ - address a__1[4]; - integer i__1, i__2, i__3, i__4[4]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - static integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer nblen_(char *, ftnlen); - extern /* Subroutine */ int ekcls_(integer *); - static logical found; - static integer ncols; - extern /* Subroutine */ int ekopr_(char *, integer *, ftnlen); - static integer sizes[100], nrows; - static char cnames[32*100]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - eknseg_(integer *); - static logical indexd[100]; - static integer tmphnd, numseg; - extern /* Subroutine */ int chkout_(char *, ftnlen); - static logical nullok[100]; - extern /* Subroutine */ int ekssum_(integer *, integer *, char *, integer - *, integer *, char *, char *, integer *, integer *, logical *, - logical *, ftnlen, ftnlen, ftnlen); - static char dtypes[4*100]; - extern logical return_(void); - static char tmptnm[64]; - static integer strlns[100]; - static char tnmprv[64]; - -/* $ Abstract */ - -/* Check whether a file is a type 1 star catalog and return the */ -/* catalog's table name if it is. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* None. */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CATFNM I Catalog file name. */ -/* TABNAM O Catalog table name. */ -/* ISTYP1 O True when file is type 1 star catalog. */ -/* ERRMSG O Error message. */ - -/* $ Detailed_Input */ - -/* CATFNM is the name of the catalog file. */ - -/* $ Detailed_Output */ - -/* TABNAM is the name of the data table contained in the */ -/* catalog. Set to blank if file is not a type 1 star */ -/* catalog. */ - -/* ISTYP1 is TRUE when the file is a type 1 star catalog. FALSE */ -/* otherwise. */ - -/* ERRMSG is a diagnostic message indicating why the file is */ -/* not a type 1 star catalog. Set to blank if the file */ -/* is a type 1 star catalog. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the indicated file cannot be opened, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the indicated file has the wrong architecture version, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* This routine checks whether file is really SPICE type 1 star */ -/* catalog file. */ - -/* SPICE type 1 star catalog files MUST contain a single data table. */ -/* It can occupy a single segment or it can spread across multiple */ -/* segments. This table MUST include the following columns: */ - -/* column name data type units */ -/* ------------------------------------------------------- */ -/* RA DOUBLE PRECISION DEGREES */ -/* DEC DOUBLE PRECISION DEGREES */ -/* RA_SIGMA DOUBLE PRECISION DEGREES */ -/* DEC_SIGMA DOUBLE PRECISION DEGREES */ -/* CATALOG_NUMBER INTEGER */ -/* SPECTRAL_TYPE CHARACTER*(4) */ -/* VISUAL_MAGNITUDE DOUBLE PRECISION */ - -/* Nulls are not allowed in any of the columns. */ -/* Other columns can also be present in the table but their data */ -/* will NOT be accessible through type 1 star catalog access */ -/* routines. Note that the names and attributes of these additional */ -/* columns must be identical for all segments containing this table. */ - -/* $ Particulars */ - -/* This routine does not need to be called by the user's program. */ -/* It is used by star catalog loader routines to check */ -/* whether a particular file is a type 1 star catalog before loading */ -/* the file. */ - -/* $ Examples */ - -/* In the following code fragment, STCC01 is used to determine */ -/* whether a file is a SPICE type 1 star catalog. */ - -/* C */ -/* C Call STCC01 to determine whether the file is type 1 star */ -/* C catalog file. */ -/* C */ -/* CALL STCC01 ( CATFNM, TABNAM, ISTYP1, ERRMSG ) */ - -/* C */ -/* C Check ISTYP1 flag and stop execution and report an */ -/* C error if file is not type 1 star catalog file. */ -/* C */ -/* IF ( .NOT. ISTYP1 ) THEN */ -/* . WRITE (*,*) 'The file:' */ -/* . WRITE (*,*) ' ',CATFNM(1:RTRIM(CATFNM)) */ -/* . WRITE (*,*) 'is not a type 1 star catalog.' */ -/* . WRITE (*,*) ERRMSG */ -/* STOP */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-MAY-1996 (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* check whether a file is a type 1 star catalog */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters. */ - - -/* Local variables */ - - -/* Initial values. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("STCC01", (ftnlen)6); - } - -/* More initial values. */ - - s_copy(tabnam, " ", tabnam_len, (ftnlen)1); - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *istyp1 = TRUE_; - -/* Open star catalog file with low level "open for read access" */ -/* EK routine. */ - - ekopr_(catfnm, &tmphnd, catfnm_len); - -/* Get the number of segments in the file and check whether it is */ -/* greater than 0 (i.e. some data are is present in the file). If */ -/* not then set an error message and return to the calling routine. */ - - numseg = eknseg_(&tmphnd); - if (numseg <= 0) { - s_copy(errmsg, "File contains no data.", errmsg_len, (ftnlen)22); - *istyp1 = FALSE_; - chkout_("STCC01", (ftnlen)6); - return 0; - } - -/* Loop through the segments to find out whether all of them */ -/* contain pieces of the same table. If not then set */ -/* an error message and return to the calling routine. */ - - i__1 = numseg; - for (i__ = 1; i__ <= i__1; ++i__) { - ekssum_(&tmphnd, &i__, tmptnm, &nrows, &ncols, cnames, dtypes, sizes, - strlns, indexd, nullok, (ftnlen)64, (ftnlen)32, (ftnlen)4); - if (i__ > 1) { - if (s_cmp(tmptnm, tnmprv, (ftnlen)64, (ftnlen)64) != 0) { - s_copy(errmsg, "File contains more than one data table.", - errmsg_len, (ftnlen)39); - *istyp1 = FALSE_; - chkout_("STCC01", (ftnlen)6); - return 0; - } - } - s_copy(tnmprv, tmptnm, (ftnlen)64, (ftnlen)64); - } - -/* Check whether the number of columns is less than it */ -/* is supposed to be in type 1 star catalogs. If so then set */ -/* an error message and return to a calling routine. */ - - if (ncols < 7) { - s_copy(errmsg, "File contains too few data columns.", errmsg_len, ( - ftnlen)35); - *istyp1 = FALSE_; - chkout_("STCC01", (ftnlen)6); - return 0; - } - -/* Check whether all columns that will be used in catalog search and */ -/* star data fetching are present in the data table. If not */ -/* then set an error message and return to a calling routine. */ - - for (i__ = 1; i__ <= 7; ++i__) { - found = FALSE_; - j = isrchc_(cat1nm + (((i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : - s_rnge("cat1nm", i__1, "stcc01_", (ftnlen)319)) << 5), &ncols, - cnames, (ftnlen)32, (ftnlen)32); - if (j > 0) { - found = s_cmp(cat1dt + (((i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 - : s_rnge("cat1dt", i__1, "stcc01_", (ftnlen)322)) << 2), - dtypes + (((i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("dtypes", i__2, "stcc01_", (ftnlen)322)) << 2), ( - ftnlen)4, (ftnlen)4) == 0 && ! nullok[(i__3 = j - 1) < - 100 && 0 <= i__3 ? i__3 : s_rnge("nullok", i__3, "stcc01_" - , (ftnlen)322)]; - } - if (! found) { -/* Writing concatenation */ - i__4[0] = 8, a__1[0] = " Column "; - i__4[1] = nblen_(cat1nm + (((i__2 = i__ - 1) < 7 && 0 <= i__2 ? - i__2 : s_rnge("cat1nm", i__2, "stcc01_", (ftnlen)326)) << - 5), (ftnlen)32), a__1[1] = cat1nm + (((i__1 = i__ - 1) < - 7 && 0 <= i__1 ? i__1 : s_rnge("cat1nm", i__1, "stcc01_", - (ftnlen)326)) << 5); - i__4[2] = 16, a__1[2] = " is not found or"; - i__4[3] = 33, a__1[3] = " improperly declared in the file."; - s_cat(errmsg, a__1, i__4, &c__4, errmsg_len); - *istyp1 = FALSE_; - chkout_("STCC01", (ftnlen)6); - return 0; - } - } - -/* If we got to this point then all checks were passed successfully */ -/* and the file can be processed as a type 1 star catalog. We */ -/* "return" the table name and close the file with the EK close */ -/* routine. */ - - s_copy(tabnam, tmptnm, tabnam_len, (ftnlen)64); - ekcls_(&tmphnd); - chkout_("STCC01", (ftnlen)6); - return 0; -} /* stcc01_ */ - diff --git a/ext/spice/src/cspice/stcf01.c b/ext/spice/src/cspice/stcf01.c deleted file mode 100644 index b2159bc868..0000000000 --- a/ext/spice/src/cspice/stcf01.c +++ /dev/null @@ -1,338 +0,0 @@ -/* stcf01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; - -/* $Procedure STCF01 (STAR catalog type 1, find stars in RA-DEC box) */ -/* Subroutine */ int stcf01_(char *catnam, doublereal *westra, doublereal * - eastra, doublereal *sthdec, doublereal *nthdec, integer *nstars, - ftnlen catnam_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal ramin; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - doublereal ramax; - extern /* Subroutine */ int repmd_(char *, char *, doublereal *, integer * - , char *, ftnlen, ftnlen, ftnlen); - logical error; - char query[512], qrytm1[512], qrytm2[512]; - doublereal decmin; - extern /* Subroutine */ int ekfind_(char *, integer *, logical *, char *, - ftnlen, ftnlen); - doublereal decmax; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char errmsg[512]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern doublereal dpr_(void); - -/* $ Abstract */ - -/* Search through a type 1 star catalog and return the number of */ -/* stars within a specified RA - DEC rectangle. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CATNAM I Catalog table name. */ -/* WESTRA I Western most right ascension in radians. */ -/* EASTRA I Eastern most right ascension in radians. */ -/* STHDEC I Southern most declination in radians. */ -/* NTHDEC I Northern most declination in radians. */ -/* NSTARS O Number of stars found. */ - -/* $ Detailed_Input */ - -/* CATNAM is name of the catalog data table. This name is */ -/* returned by the catalog loader routine STCL01. */ - -/* WESTRA are right ascension and declination constraints */ -/* EASTRA giving the western, eastern, southern and northern */ -/* STHDEC boundaries of a search rectangle as follows: */ -/* NTHDEC */ -/* RA BETWEEN WESTRA AND EASTRA and */ -/* DEC BETWEEN STHDEC AND NTHDEC */ - -/* where RA and DEC are the right ascension and */ -/* declination of a star. WESTRA always represents */ -/* "west" side of this rectangle and EASTRA -- the */ -/* "east" side. STHDEC represents the "south" side */ -/* of the rectangle, NTHDEC represents the "north" */ -/* side of the rectangle. */ - -/* For an observer standing on the surface */ -/* of the earth at the equator, the west side of the */ -/* rectangle ( the side associated with WESTRA) rises */ -/* first. The east side (the side associated with */ -/* EASTRA) rises last. All meridians that rise between */ -/* the rising of the west and east edges of the */ -/* rectangle cross through the RA-DEC rectangle. */ - -/* To specify the 6 degrees wide RA-DEC */ -/* square centered on the celestical equator that */ -/* has western most right ascension of 357 degrees, */ -/* use the following values for WESTRA, EASTRA, STHDEC, */ -/* and NTHDEC (we multiply the angles by the SPICELIB */ -/* function RPD to convert degrees to radians). */ - -/* WESTRA = 357.0D0 * RPD() */ -/* EASTRA = 3.0D0 * RPD() */ -/* STHDEC = -3.0D0 * RPD() */ -/* DEXMAX = 3.0D0 * RPD() */ - -/* To specify a 5 degree wide RA-DEC square that has */ -/* western most right ascension 10 degrees and */ -/* eastern most right ascension 15 degrees and southern */ -/* most declination of 45 degrees, assign the following */ -/* values to WESTRA, EASTRA, STHDEC and NTHDEC. */ - -/* WESTRA = 10.0D0 * RPD() */ -/* EASTRA = 15.0D0 * RPD() */ -/* STHDEC = 45.0D0 * RPD() */ -/* DEXMAX = 50.0D0 * RPD() */ - -/* All RA and DECS should be in radians and relative */ -/* to the J2000 inertial frame. */ - -/* All Right Ascension values should be in the */ -/* interval [0, 2*pi ). This routine does */ -/* not "fold" Right Ascension values into the this */ -/* interval. For example if you request stars in */ -/* whose right ascensions lie between 3*pi and 4*pi */ -/* no stars will be found. */ - -/* All Declination values should be in the interval */ -/* [-pi,pi]. */ - -/* $ Detailed_Output */ - -/* NSTARS is number of catalog stars found within the */ -/* specified RA - DEC rectangle. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If no star catalog has been loaded, an error will be */ -/* signalled by a routine in the call tree of this routine. */ - -/* 2) If the catalog query fails for any reason then */ -/* the error 'SPICE(QUERYFAILURE)'is signalled. */ - -/* $ Files */ - -/* This routine searches for stars within SPICE type 1 star catalog */ -/* files that have been loaded by calls to the STCL01 routine and */ -/* that contain that catalog data table named CATNAM. */ - -/* SPICE type 1 star catalog files MUST contain a single data table. */ -/* It can occupy a single segment or it can spread across multiple */ -/* segments. This table MUST include the following columns: */ - -/* column name data type units */ -/* ------------------------------------------------------- */ -/* RA DOUBLE PRECISION DEGREES */ -/* DEC DOUBLE PRECISION DEGREES */ -/* RA_SIGMA DOUBLE PRECISION DEGREES */ -/* DEC_SIGMA DOUBLE PRECISION DEGREES */ -/* CATALOG_NUMBER INTEGER */ -/* SPECTRAL_TYPE CHARACTER*(4) */ -/* VISUAL_MAGNITUDE DOUBLE PRECISION */ - -/* Nulls are not allowed in any of the columns. */ -/* Other columns can also be present in the table but their data */ -/* will NOT be accessible through STCF01 and STCG01 -- */ -/* the interface used to access data in the catalog. Note */ -/* that the names and attributes of these additional columns */ -/* must be identical for all segments containing this table. */ - -/* $ Particulars */ - -/* This routine is intended to be a part of the user interface to */ -/* the SPICE type 1 star catalog. It allows the caller to find all */ -/* stars within a specified RA - DEC rectangle in the SPICE */ -/* EK type 1 star catalog files loaded by STCL01. This */ -/* subroutine MUST NOT be called before a catalog file has */ -/* been loaded. */ - -/* Other routines in the SPICE type 1 star catalog access */ -/* family are: */ - -/* STCL01 load the catalog file and make its data */ -/* available for search and retrieval. */ - -/* STCG01 retrieve position and characteristics for */ -/* a specified star in the set found by this */ -/* routine. */ - -/* $ Examples */ - -/* In the following code fragment, STCF01 is used to find */ -/* all stars within a specified RA - DEC rectangle in a SPICE */ -/* EK type 1 star catalog. */ - -/* C */ -/* C Load catalog file. */ -/* C */ -/* CALL STCL01 ( CATFN, TABNAM, HANDLE ) */ -/* C */ -/* C Search through the loaded catalog. */ -/* C */ -/* CALL STCF01 ( TABNAM, WESTRA, EASTRA, */ -/* . STHDEC, NTHDEC, NSTARS ) */ -/* C */ -/* C Retrieve data for every star found. */ -/* C */ -/* DO I = 1, NSTARS */ - -/* CALL STCG01 ( I, RA, DEC, RASIG, DECSIG, */ -/* . CATNUM, SPTYPE, VMAG ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The catalog file STCF01 searches through MUST be loaded */ -/* by STCL01 before STCF01 is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-MAY-1996 (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* find stars in RA-DEC rectangle in type 1 star catalog */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("STCF01", (ftnlen)6); - } - -/* Query templates. */ - - s_copy(qrytm1, "SELECT RA, DEC, RA_SIGMA, DEC_SIGMA,CATALOG_NUMBER, SPEC" - "TRAL_TYPE, VISUAL_MAGNITUDE FROM # WHERE ( RA BETWEEN # AND # )" - " AND ( DEC BETWEEN # AND # ) ", (ftnlen)512, (ftnlen)149); - s_copy(qrytm2, "SELECT RA, DEC, RA_SIGMA, DEC_SIGMA,CATALOG_NUMBER, SPEC" - "TRAL_TYPE, VISUAL_MAGNITUDE FROM # WHERE ( ( RA BETWEEN # AND 36" - "0 ) OR ( RA BETWEEN 0 AND # ) ) AND ( DEC BETWEEN # A" - "ND # ) ", (ftnlen)512, (ftnlen)191); - -/* Choose query template to be used. */ - - if (*westra <= *eastra) { - s_copy(query, qrytm1, (ftnlen)512, (ftnlen)512); - } else { - s_copy(query, qrytm2, (ftnlen)512, (ftnlen)512); - } - -/* Convert angles in radians to angles in degrees. */ - - ramin = *westra * dpr_(); - ramax = *eastra * dpr_(); - decmin = *sthdec * dpr_(); - decmax = *nthdec * dpr_(); - -/* Construct query using inputs and chosen template. */ - - repmc_(query, "#", catnam, query, (ftnlen)512, (ftnlen)1, catnam_len, ( - ftnlen)512); - repmd_(query, "#", &ramin, &c__15, query, (ftnlen)512, (ftnlen)1, (ftnlen) - 512); - repmd_(query, "#", &ramax, &c__15, query, (ftnlen)512, (ftnlen)1, (ftnlen) - 512); - repmd_(query, "#", &decmin, &c__15, query, (ftnlen)512, (ftnlen)1, ( - ftnlen)512); - repmd_(query, "#", &decmax, &c__15, query, (ftnlen)512, (ftnlen)1, ( - ftnlen)512); - -/* Submit query and get number of stars. Check for */ -/* errors in QUERY. */ - - ekfind_(query, nstars, &error, errmsg, (ftnlen)512, (ftnlen)512); - if (error) { - setmsg_("Error querying type 1 star catalog. Error message: # ", ( - ftnlen)53); - errch_("#", errmsg, (ftnlen)1, (ftnlen)512); - sigerr_("SPICE(QUERYFAILURE)", (ftnlen)19); - chkout_("STCF01", (ftnlen)6); - return 0; - } - chkout_("STCF01", (ftnlen)6); - return 0; -} /* stcf01_ */ - diff --git a/ext/spice/src/cspice/stcg01.c b/ext/spice/src/cspice/stcg01.c deleted file mode 100644 index d9fef498c0..0000000000 --- a/ext/spice/src/cspice/stcg01.c +++ /dev/null @@ -1,321 +0,0 @@ -/* stcg01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__3 = 3; -static integer c__4 = 4; -static integer c__5 = 5; -static integer c__6 = 6; -static integer c__7 = 7; - -/* $Procedure STCG01 ( STAR catalog type 1, get star data ) */ -/* Subroutine */ int stcg01_(integer *index, doublereal *ra, doublereal *dec, - doublereal *rasig, doublereal *decsig, integer *catnum, char *sptype, - doublereal *vmag, ftnlen sptype_len) -{ - extern /* Subroutine */ int ekgc_(integer *, integer *, integer *, char *, - logical *, logical *, ftnlen), ekgd_(integer *, integer *, - integer *, doublereal *, logical *, logical *), ekgi_(integer *, - integer *, integer *, integer *, logical *, logical *); - logical null; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern doublereal rpd_(void); - -/* $ Abstract */ - -/* Get data for a single star from a SPICE type 1 star catalog. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INDEX I Star index. */ -/* RA O Right ascension in radians. */ -/* DEC O Declination in radians. */ -/* RAS O Right ascension uncertainty in radians. */ -/* DECS O Declination uncertainty in radians. */ -/* CATNUM O Catalog number. */ -/* SPTYPE O Spectral type. */ -/* VMAG O Visual magnitude. */ - -/* $ Detailed_Input */ - -/* INDEX is the index of the star in the list of stars */ -/* that satisfy the selection criteria specified in */ -/* the last call to STCF01. */ - -/* $ Detailed_Output */ - -/* RA is right ascension of the star at the catalog epoch */ -/* in radians relative to the J2000 inertial frame. */ - -/* DEC is declination of the star at the catalog epoch in */ -/* radians relative to the J2000 inertial frame. */ - -/* RASIG is the uncertainty in right ascension of the star at */ -/* the catalog epoch in radians. */ - -/* DECSIG is the uncertainty in declination of the star at */ -/* the catalog epoch in radians. */ - -/* CATNUM is the star number in the catalog. */ - -/* SPTYPE is the star's spectral type. See catalog description */ -/* for more information regarding encoding of spectral */ -/* type values. */ - -/* VMAG is the visual magnitude of the star. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If fetching of any of output values fails, then */ -/* the error 'SPICE(BADSTARINDEX)' is signalled. */ - -/* 2) If no star catalog has been loaded, the error is dianosed */ -/* by a routine called by this one. */ - -/* 3) If STCF01 was not called first, the EK query */ -/* error 'SPICE(INVALIDINDEX)' is signalled. */ - -/* $ Files */ - -/* This routine reads the data from SPICE type 1 star catalog file */ -/* loaded into the program by a call to STCL01. */ - -/* SPICE type 1 star catalog files MUST contain a single data table. */ -/* It can occupy a single segment or it can spread across multiple */ -/* segments. This table MUST include the following columns: */ - -/* column name data type units */ -/* ------------------------------------------------------- */ -/* RA DOUBLE PRECISION DEGREES */ -/* DEC DOUBLE PRECISION DEGREES */ -/* RA_SIGMA DOUBLE PRECISION DEGREES */ -/* DEC_SIGMA DOUBLE PRECISION DEGREES */ -/* CATALOG_NUMBER INTEGER */ -/* SPECTRAL_TYPE CHARACTER*(4) */ -/* VISUAL_MAGNITUDE DOUBLE PRECISION */ - -/* Nulls are not allowed in any of the columns. */ -/* Other columns can also be present in the table but their data */ -/* will NOT be accessible through STCF01 and STCG01 -- */ -/* the interface used to access data in the catalog. Note */ -/* that the names and attributes of these additional columns */ -/* must be identical for all segments containing this table. */ - -/* $ Particulars */ - -/* This routine is intended to be a part of the user interface to */ -/* the SPICE type 1 star catalog. It allows the caller to retrieve */ -/* data for a single star found by STCF01 using the star's */ -/* index within the search result array. This subroutine MUST */ -/* NOT be called before a search by STCF01 was done. */ - -/* Other routines in the SPICE type 1 star catalog access */ -/* family are: */ - -/* STCL01 load the catalog file and make its data */ -/* available for search and retrieval. */ - -/* STCF01 search through the catalog for all stars within */ -/* a specified RA-DEC rectangle. */ - -/* $ Examples */ - -/* In the following code fragment, STCG01 is used to retrieve */ -/* position and characteristics for every star within an RA - DEC */ -/* rectangle from a particular SPICE type 1 star catalog. */ - -/* C */ -/* C Load catalog file. */ -/* C */ -/* CALL STCL01 ( CATFN, TABNAM, HANDLE ) */ -/* C */ -/* C Search through the loaded catalog. */ -/* C */ -/* CALL STCF01 ( TABNAM, RAMIN, RAMAX, */ -/* . DECMIN, DECMAX, NSTARS ) */ -/* C */ -/* C Retrieve data for every star found. */ -/* C */ -/* DO I = 1, NSTARS */ - -/* CALL STCG01 ( I, RA, DEC, RASIG, DECSIG, */ -/* . CATNUM, SPTYPE, VMAG ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) The catalog file STCG01 reads data from MUST be loaded */ -/* by STCL01 and a search through the catalog MUST be done by */ -/* STCF01 before STCG01 is called. */ - -/* 2) No other EK queries can be made between the call to STCF01 */ -/* and the call to STCG01. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-MAY-1996 (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* get data for single star from a type 1 star catalog */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local variables. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("STCG01", (ftnlen)6); - } - -/* Fetch data from the catalog in the following order */ -/* as defined QUERY string template in STCF01 routine */ - -/* RA, DEC, RASIG, DECSIG, CATNUM, SPTYPE, VMAG */ - -/* Check FOUNDs and report error if any of the parameters */ -/* is not found. */ - -/* Since NULLs are not allowed in any of the star catalog */ -/* columns, no check for NULLs is performed. */ - - ekgd_(&c__1, index, &c__1, ra, &null, &found); - if (! found) { - setmsg_("RA value for star # not found. ", (ftnlen)31); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - ekgd_(&c__2, index, &c__1, dec, &null, &found); - if (! found) { - setmsg_("DEC value for star # not found. ", (ftnlen)32); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - ekgd_(&c__3, index, &c__1, rasig, &null, &found); - if (! found) { - setmsg_("RASIG value for star # not found. ", (ftnlen)34); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - ekgd_(&c__4, index, &c__1, decsig, &null, &found); - if (! found) { - setmsg_("DECSIG value for star # not found.", (ftnlen)34); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - ekgi_(&c__5, index, &c__1, catnum, &null, &found); - if (! found) { - setmsg_("CATNUM value for star # not found.", (ftnlen)34); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - ekgc_(&c__6, index, &c__1, sptype, &null, &found, sptype_len); - if (! found) { - setmsg_("SPTYPE value for star # not found.", (ftnlen)34); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - ekgd_(&c__7, index, &c__1, vmag, &null, &found); - if (! found) { - setmsg_("VMAG value for star # not found. ", (ftnlen)33); - errint_("#", index, (ftnlen)1); - sigerr_("SPICE(BADSTARINDEX)", (ftnlen)19); - chkout_("STCG01", (ftnlen)6); - return 0; - } - -/* Convert angles to radians before return. */ - - *ra *= rpd_(); - *dec *= rpd_(); - *rasig *= rpd_(); - *decsig *= rpd_(); - chkout_("STCG01", (ftnlen)6); - return 0; -} /* stcg01_ */ - diff --git a/ext/spice/src/cspice/stcl01.c b/ext/spice/src/cspice/stcl01.c deleted file mode 100644 index 9acfa27c7a..0000000000 --- a/ext/spice/src/cspice/stcl01.c +++ /dev/null @@ -1,245 +0,0 @@ -/* stcl01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure STCL01 ( STAR catalog type 1, load catalog file ) */ -/* Subroutine */ int stcl01_(char *catfnm, char *tabnam, integer *handle, - ftnlen catfnm_len, ftnlen tabnam_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1[2]; - char ch__1[295]; - - /* Builtin functions */ - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int eklef_(char *, integer *, ftnlen), chkin_( - char *, ftnlen), stcc01_(char *, char *, logical *, char *, - ftnlen, ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical istyp1; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - char errmsg[256]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Load SPICE type 1 star catalog and return the catalog's */ -/* table name. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CATFNM I Catalog file name. */ -/* TABNAM O Catalog table name. */ -/* HANDLE O Catalog file handle. */ - -/* $ Detailed_Input */ - -/* CATFNM is the name of the catalog file. */ - -/* $ Detailed_Output */ - -/* TABNAM is the name of the table loaded from the catalog */ -/* file. This name must be provided as an input argument */ -/* to STCF01 catalog search routine. Multiple catalogs */ -/* contaning the table TABNAM may be loaded. Sets of */ -/* columns, column names and attribites must be */ -/* identical through all these files. */ - -/* HANDLE is the integer handle of the catalog file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the indicated file cannot be opened, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the indicated file has the wrong architecture version, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 4) If the catalog file is not a type 1 star catalog file */ -/* then the error 'SPICE(BADCATALOGFILE)' is signalled. */ - -/* $ Files */ - -/* This routine loads a SPICE type 1 star catalog file. */ - -/* SPICE type 1 star catalog files MUST contain a single data table. */ -/* It can occupy a single segment or it can spread across multiple */ -/* segments. This table MUST include the following columns: */ - -/* column name data type units */ -/* ------------------------------------------------------- */ -/* RA DOUBLE PRECISION DEGREES */ -/* DEC DOUBLE PRECISION DEGREES */ -/* RA_SIGMA DOUBLE PRECISION DEGREES */ -/* DEC_SIGMA DOUBLE PRECISION DEGREES */ -/* CATALOG_NUMBER INTEGER */ -/* SPECTRAL_TYPE CHARACTER*(4) */ -/* VISUAL_MAGNITUDE DOUBLE PRECISION */ - -/* Nulls are not allowed in any of the columns. */ -/* Other columns can also be present in the table but their data */ -/* will NOT be accessible through STCF01 and STCG01 -- */ -/* the interface used to access data in the catalog. Note */ -/* that the names and attributes of these additional columns */ -/* must be identical for all segments containing this table. */ - -/* $ Particulars */ - -/* This STCL01 routine is intended to be part of the user */ -/* interface to the SPICE type 1 star catalog. It loads a */ -/* SPICE type 1 star catalog file and makes its data available */ -/* for searches and retrieval. */ - -/* Other routines in SPICE type 1 star catalog access family are: */ - -/* STCF01 search through the catalog for all stars within */ -/* a specified RA-DEC rectangle. */ - -/* STCG01 retrieve position and characteristics for */ -/* every single star found. */ - -/* $ Examples */ - -/* In the following code fragment, STCL01 is used to load */ -/* a SPICE type 1 star catalog. */ - -/* C */ -/* C Load catalog file. */ -/* C */ -/* CALL STCL01 ( CATFN, TABNAM, HANDLE ) */ -/* C */ -/* C Search through the loaded catalog. */ -/* C */ -/* CALL STCF01 ( TABNAM, RAMIN, RAMAX, */ -/* . DECMIN, DECMAX, NSTARS ) */ -/* C */ -/* C Retrieve data for every star that matched the */ -/* C search criteria. */ -/* C */ -/* DO I = 1, NSTARS */ - -/* CALL STCG01 ( I, RA, DEC, RASIG, DECSIG, */ -/* . CATNUM, SPTYPE, VMAG ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Balanced calls to CHKIN/CHKOUT. */ - -/* - SPICELIB Version 1.0.0, 15-MAY-1996 (BVS) */ - -/* -& */ -/* $ Index_Entries */ - -/* load a type 1 star catalog file */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("STCL01", (ftnlen)6); - } - -/* Check whether the file is really a type 1 star catalog file. */ -/* If not then signal an error. */ - - stcc01_(catfnm, tabnam, &istyp1, errmsg, catfnm_len, tabnam_len, (ftnlen) - 256); - if (! istyp1) { -/* Writing concatenation */ - i__1[0] = 39, a__1[0] = "File # is not type 1 star catalog file."; - i__1[1] = 256, a__1[1] = errmsg; - s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)295); - setmsg_(ch__1, (ftnlen)295); - errch_("#", catfnm, (ftnlen)1, catfnm_len); - sigerr_("SPICE(BADCATALOGFILE)", (ftnlen)21); - chkout_("STCL01", (ftnlen)6); - return 0; - } - -/* Load the catalog file with the high level EK loader. */ - - eklef_(catfnm, handle, catfnm_len); - chkout_("STCL01", (ftnlen)6); - return 0; -} /* stcl01_ */ - diff --git a/ext/spice/src/cspice/stdio.c b/ext/spice/src/cspice/stdio.c deleted file mode 100644 index 3475933ec4..0000000000 --- a/ext/spice/src/cspice/stdio.c +++ /dev/null @@ -1,163 +0,0 @@ -/* stdio.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure STDIO ( Standard IO ) */ -/* Subroutine */ int stdio_(char *name__, integer *unit, ftnlen name_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), ljust_( - char *, char *, ftnlen, ftnlen); - char myname[8]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the logical unit associated with some standard input or */ -/* standard output. */ - -/* $ 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 */ - -/* I/O */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I is the name of a logical unit to return. */ -/* UNIT O is the logical unit associated with NAME. */ - -/* $ Detailed_Input */ - -/* NAME is the "name" of a FORTRAN unit to return. */ -/* Recognized names are 'STDIN' and 'STDOUT'. */ -/* The routine is case insensitive to NAME. */ - -/* If NAME is not recognized the error */ -/* 'SPICE(BADSTDIONAME)' is signalled and UNIT is */ -/* set to -100. */ - -/* $ Detailed_Output */ - -/* UNIT is the logical unit associated with NAME. If */ -/* NAME is not recognized, UNIT is set to -100. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is not recognized, the error 'SPICE(BADSTDIONAME)' is */ -/* signalled. */ - -/* $ Particulars */ - -/* This is a low level utility for retrieving the logical units */ -/* associated with standard input and output. It exists to */ -/* isolate SPICE based code from compiler writer choices in the */ -/* implementation of standard input and output. */ - -/* $ Examples */ - -/* Suppose you would like to send a message to standard output */ -/* and that this message is contained in the array of N character */ -/* strings MESSGE. The code below would handle the task. */ - -/* CALL STDIO ( 'STDOUT', STDOUT ) */ - -/* DO I = 1, N */ -/* CALL WRITLN ( MESSGE(I), STDOUT ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* logical units associated standard input and output */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - ljust_(name__, myname, name_len, (ftnlen)8); - ucase_(myname, myname, (ftnlen)8, (ftnlen)8); - if (s_cmp(myname, "STDIN", (ftnlen)8, (ftnlen)5) == 0) { - *unit = 5; - } else if (s_cmp(myname, "STDOUT", (ftnlen)8, (ftnlen)6) == 0) { - *unit = 6; - } else if (return_()) { - return 0; - } else { - chkin_("STDIO", (ftnlen)5); - setmsg_("The only \"names\" recognized by STDIO are 'STDIN' and 'STD" - "OUT' you requested a unit for '#'. ", (ftnlen)92); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(BADSTDIONAME)", (ftnlen)19); - chkout_("STDIO", (ftnlen)5); - } - return 0; -} /* stdio_ */ - diff --git a/ext/spice/src/cspice/stelab.c b/ext/spice/src/cspice/stelab.c deleted file mode 100644 index 340080f820..0000000000 --- a/ext/spice/src/cspice/stelab.c +++ /dev/null @@ -1,316 +0,0 @@ -/* stelab.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure STELAB ( Stellar Aberration ) */ -/* Subroutine */ int stelab_(doublereal *pobj, doublereal *vobs, doublereal * - appobj) -{ - /* Builtin functions */ - double asin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal vbyc[3]; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vdot_(doublereal *, doublereal *); - doublereal h__[3], u[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *), errdp_(char *, doublereal *, ftnlen), - vcrss_(doublereal *, doublereal *, doublereal *); - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal - *, doublereal *); - extern doublereal clight_(void); - doublereal onebyc, sinphi; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal lensqr; - extern logical return_(void); - doublereal phi; - -/* $ Abstract */ - -/* Correct the apparent position of an object for stellar */ -/* aberration. */ - -/* $ 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 */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* POBJ I Position of an object with respect to the */ -/* observer. */ -/* VOBS I Velocity of the observer with respect to the */ -/* Solar System barycenter. */ -/* APPOBJ O Apparent position of the object with respect to */ -/* the observer, corrected for stellar aberration. */ - -/* $ Detailed_Input */ - -/* POBJ is the position (x, y, z, km) of an object with */ -/* respect to the observer, possibly corrected for */ -/* light time. */ - -/* VOBS is the velocity (dx/dt, dy/dt, dz/dt, km/sec) */ -/* of the observer with respect to the Solar System */ -/* barycenter. */ - -/* $ Detailed_Output */ - -/* APPOBJ is the apparent position of the object relative */ -/* to the observer, corrected for stellar aberration. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the velocity of the observer is greater than or equal */ -/* to the speed of light, the error SPICE(VALUEOUTOFRANGE) */ -/* is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let r be the vector from the observer to the object, and v be */ -/* - - */ -/* the velocity of the observer with respect to the Solar System */ -/* barycenter. Let w be the angle between them. The aberration */ -/* angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ -/* - */ - -/* h = r X v */ -/* - - - */ - -/* Rotate r by phi radians about h to obtain the apparent position */ -/* - - */ -/* of the object. */ - -/* $ Examples */ - -/* In the following example, STELAB is used to correct the position */ -/* of a target body for stellar aberration. */ - - -/* (Previous subroutine calls have loaded the SPK file and */ -/* the leapseconds kernel file.) */ - - -/* C */ -/* C Get the geometric state of the observer OBS relative to */ -/* C the solar system barycenter. */ -/* C */ -/* CALL SPKSSB ( OBS, ET, 'J2000', SOBS ) */ - -/* C */ -/* C Get the light-time corrected position TPOS of the target */ -/* C body TARG as seen by the observer. Normally we would */ -/* C call SPKPOS to obtain this vector, but we already have */ -/* C the state of the observer relative to the solar system */ -/* C barycenter, so we can avoid looking up that state twice */ -/* C by calling SPKAPO. */ -/* C */ -/* CALL SPKAPO ( TARG, ET, 'J2000', SOBS, 'LT', TPOS, LT ) */ - -/* C */ -/* C Apply the correction for stellar aberration to the */ -/* C light-time corrected position of the target body. */ -/* C The corrected position is returned in the argument */ -/* C PCORR. */ -/* C */ -/* CALL STELAB ( TPOS, SOBS(4), PCORR ) */ - - -/* Note that this example is somewhat contrived. The sequence */ -/* of calls above could be replaced by a single call to SPKEZP, */ -/* using the aberration correction flag 'LT+S'. */ - -/* For more information on aberration-corrected states or */ -/* positions, see the headers of any of the routines */ - -/* SPKEZR */ -/* SPKEZ */ -/* SPKPOS */ -/* SPKEZP */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) W.M. Owen, Jr., JPL IOM #314.8-524, "The Treatment of */ -/* Aberration in Optical Navigation", 8 February 1985. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 8-JAN-2008 (NJB) */ - -/* The header example was updated to remove references */ -/* to SPKAPP. */ - -/* - SPICELIB Version 1.1.0, 8-FEB-1999 (WLT) */ - -/* The example was corrected so that SOBS(4) is passed */ -/* into STELAB instead of STARG(4). */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 8-AUG-1990 (HAN) */ - -/* Examples section of the header was updated to replace */ -/* calls to the GEF ephemeris readers by calls to the */ -/* new SPK ephemeris reader. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* stellar aberration */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.1.0, 9-MAR-1989 (HAN) */ - -/* Declaration of the variable LIGHT was removed from the code. */ -/* The variable was declared but never used. */ - -/* - Beta Version 2.0.0, 28-DEC-1988 (HAN) */ - -/* Error handling was added to check the velocity of the */ -/* observer. If the velocity of the observer is greater */ -/* than or equal to the speed of light, the error */ -/* SPICE(VALUEOUTOFRANGE) is signalled. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("STELAB", (ftnlen)6); - } - -/* We are not going to compute the aberrated vector in exactly the */ -/* way described in the particulars section. We can combine some */ -/* steps and we take some precautions to prevent floating point */ -/* overflows. */ - - -/* Get a unit vector that points in the direction of the object */ -/* ( u_obj ). */ - - vhat_(pobj, u); - -/* Get the velocity vector scaled with respect to the speed of light */ -/* ( v/c ). */ - - onebyc = 1. / clight_(); - vscl_(&onebyc, vobs, vbyc); - -/* If the square of the length of the velocity vector is greater than */ -/* or equal to one, the speed of the observer is greater than or */ -/* equal to the speed of light. The observer speed is definitely out */ -/* of range. Signal an error and check out. */ - - lensqr = vdot_(vbyc, vbyc); - if (lensqr >= 1.) { - setmsg_("Velocity components of observer were: dx/dt = *, dy/dt = *" - ", dz/dt = *.", (ftnlen)71); - errdp_("*", vobs, (ftnlen)1); - errdp_("*", &vobs[1], (ftnlen)1); - errdp_("*", &vobs[2], (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("STELAB", (ftnlen)6); - return 0; - } - -/* Compute u_obj x (v/c) */ - - vcrss_(u, vbyc, h__); - -/* If the magnitude of the vector H is zero, the observer is moving */ -/* along the line of sight to the object, and no correction is */ -/* required. Otherwise, rotate the position of the object by phi */ -/* radians about H to obtain the apparent position. */ - - sinphi = vnorm_(h__); - if (sinphi != 0.) { - phi = asin(sinphi); - vrotv_(pobj, h__, &phi, appobj); - } else { - moved_(pobj, &c__3, appobj); - } - chkout_("STELAB", (ftnlen)6); - return 0; -} /* stelab_ */ - diff --git a/ext/spice/src/cspice/stelab_c.c b/ext/spice/src/cspice/stelab_c.c deleted file mode 100644 index b1354ef827..0000000000 --- a/ext/spice/src/cspice/stelab_c.c +++ /dev/null @@ -1,215 +0,0 @@ -/* - --Procedure stelab_c ( Stellar Aberration ) - --Abstract - - Correct the apparent position of an object for stellar - aberration. - --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 - - EPHEMERIS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef stelab_c - - - void stelab_c ( ConstSpiceDouble pobj[3], - ConstSpiceDouble vobs[3], - SpiceDouble appobj[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - pobj I Position of an object with respect to the - observer. - vobs I Velocity of the observer with respect to the - Solar System barycenter. - appobj O Apparent position of the object with respect to - the observer, corrected for stellar aberration. - --Detailed_Input - - pobj is the position (x, y, z, km) of an object with - respect to the observer, possibly corrected for - light time. - - vobs is the velocity (dx/dt, dy/dt, dz/dt, km/sec) - of the observer with respect to the Solar System - barycenter. - --Detailed_Output - - appobj is the apparent position of the object relative - to the observer, corrected for stellar aberration. - --Parameters - - None. - --Exceptions - - 1) If the velocity of the observer is greater than or equal - to the speed of light, the error SPICE(VALUEOUTOFRANGE) - is signaled. - --Files - - None. - --Particulars - - Let r be the vector from the observer to the object, and v be - - - - the velocity of the observer with respect to the Solar System - barycenter. Let w be the angle between them. The aberration - angle phi is given by - - sin(phi) = v sin(w) / c - - Let h be the vector given by the cross product - - - - h = r X v - - - - - - Rotate r by phi radians about h to obtain the apparent position - - - - of the object. - --Examples - - In the following example, stelab_c is used to correct the position - of a target body for stellar aberration. - - /. - (Previous subroutine calls have loaded the SPK file and - the leapseconds kernel file.) - ./ - - /. - Get the state of the observer with respect to the solar - system barycenter. - ./ - spkssb_c ( idobs, et, "J2000", sobs ); - - /. - Get the light-time corrected position `tpos' of the target - body `targ' as seen by the observer. Normally we would - call spkpos_c to obtain this vector, but we already have - the state of the observer relative to the solar system - barycenter, so we can avoid looking up that state twice - by calling spkapo_c. - ./ - spkapo_c ( targ, et, "j2000", sobs, "lt", tpos, < ); - - /. - Apply the correction for stellar aberration to the - light-time corrected position of the target body. - The corrected position is returned in the argument - `pcorr'. - ./ - stelab_c ( tpos, sobs+3, pcorr ); - - - Note that this example is somewhat contrived. The sequence - of calls above could be replaced by a single call to spkezp_c, - using the aberration correction flag "lt+s". - - For more information on aberration-corrected states or - positions, see the headers of any of the routines - - spkezr_c - spkez_c - spkpos_c - spkezp_c - - --Restrictions - - None. - --Literature_References - - 1) W.M. Owen, Jr., JPL IOM #314.8-524, "The Treatment of - Aberration in Optical Navigation", 8 February 1985. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 8-JAN-2008 (NJB) - - The header example was updated to remove references - to spkapp_c. - - -CSPICE Version 1.0.0, 22-OCT-1998 (NJB) - - Based on SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) - --Index_Entries - - stellar aberration - --& -*/ - -{ /* Begin stelab_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "stelab_c" ); - - - /* - Call the f2c'd routine. - */ - stelab_ ( ( doublereal * ) pobj, - ( doublereal * ) vobs, - ( doublereal * ) appobj ); - - - chkout_c ( "stelab_c" ); - -} /* End stelab_c */ diff --git a/ext/spice/src/cspice/stlabx.c b/ext/spice/src/cspice/stlabx.c deleted file mode 100644 index 654db9d31c..0000000000 --- a/ext/spice/src/cspice/stlabx.c +++ /dev/null @@ -1,240 +0,0 @@ -/* stlabx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure STLABX ( Stellar aberration, transmission case ) */ -/* Subroutine */ int stlabx_(doublereal *pobj, doublereal *vobs, doublereal * - corpos) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), stelab_(doublereal *, - doublereal *, doublereal *); - doublereal negvel[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Correct the position of a target for the stellar aberration */ -/* effect on radiation transmitted from a specified observer to */ -/* the target. */ - -/* $ 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 */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* POBJ I Position of an object with respect to the */ -/* observer. */ -/* VOBS I Velocity of the observer with respect to the */ -/* Solar System barycenter. */ -/* CORPOS O Corrected position of the object. */ - -/* $ Detailed_Input */ - -/* POBJ is the cartesian position vector of an object with */ -/* respect to the observer, possibly corrected for */ -/* light time. Units are km. */ - -/* VOBS is the cartesian velocity vector of the observer */ -/* with respect to the Solar System barycenter. Units */ -/* are km/s. */ - -/* $ Detailed_Output */ - -/* CORPOS is the position of the object relative to the */ -/* observer, corrected for the stellar aberration */ -/* effect on radiation directed toward the target. This */ -/* correction is the inverse of the usual stellar */ -/* aberration correction: the corrected vector */ -/* indicates the direction in which radiation must be */ -/* emitted from the observer, as seen in an inertial */ -/* reference frame having velocity equal to that of the */ -/* observer, in order to reach the position indicated by */ -/* the input vector POBJ. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the velocity of the observer is greater than or equal */ -/* to the speed of light, the error is diagnosed by a routine */ -/* called by this routine. The outputs are undefined. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* In order to transmit radiation from an observer to a specified */ -/* target, the emission direction must be corrected for one way */ -/* light time and for the motion of the observer relative to the */ -/* solar system barycenter. The correction for the observer's */ -/* motion when transmitting to a target is the inverse of the */ -/* usual stellar aberration correction applied to the light-time */ -/* corrected position of the target as seen by the observer. */ - -/* Below is the description of the stellar aberration correction */ -/* used in the SPICELIB routine STELAB (with the notation changed */ -/* slightly): */ - -/* Let r be the vector from the observer to the object, and v be */ -/* the velocity of the observer with respect to the Solar System */ -/* barycenter. Let w be the angle between them. The aberration */ -/* angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent position */ -/* of the object. */ - -/* This routine applies the inverse correction, so here the rotation */ -/* about h is by -phi radians. */ - -/* $ Examples */ - -/* In the following example, STLABX is used to correct the position */ -/* of a target body for the stellar aberration effect on radiation */ -/* transmitted to the target. */ - -/* [Previous subroutine calls have loaded an SPK file and */ -/* the leapseconds kernel file. The SPK file contains */ -/* sufficient data to enable computation of observer and */ -/* target states relative to the solar system barycenter.] */ - -/* C */ -/* C Get the geometric state of the observer OBS relative to */ -/* C the solar system barycenter. */ -/* C */ -/* CALL SPKSSB ( OBS, ET, 'J2000', SOBS ) */ - -/* C */ -/* C Get the light-time corrected position TPOS of the target */ -/* C body TARG as seen by the observer. Normally we would */ -/* C call SPKPOS to obtain this vector, but we already have */ -/* C the state of the observer relative to the solar system */ -/* C barycenter, so we can avoid looking up that state twice */ -/* C by calling SPKAPO. */ -/* C */ -/* CALL SPKAPO ( TARG, ET, 'J2000', SOBS, 'XLT', TPOS, LT ) */ - -/* C */ -/* C Apply the correction for stellar aberration to the */ -/* C light-time corrected position of the target body. */ -/* C The corrected position is returned in the argument */ -/* C PCORR. */ -/* C */ -/* CALL STLABX ( TPOS, SOBS(4), PCORR ) */ - - -/* Note that this example is somewhat contrived. The sequence */ -/* of calls above could be replaced by a single call to SPKEZP, */ -/* using the aberration correction flag 'XLT+S'. */ - -/* For more information on aberration-corrected states or */ -/* positions, see the headers of any of the routines */ - -/* SPKEZR */ -/* SPKEZ */ -/* SPKPOS */ -/* SPKEZP */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) W.M. Owen, Jr., JPL IOM #314.8-524, "The Treatment of */ -/* Aberration in Optical Navigation", 8 February 1985. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 8-JAN-2008 (NJB) */ - -/* The header example was updated to remove references */ -/* to SPKAPP. */ - -/* - SPICELIB Version 1.0.0, 02-JAN-2002 (IMU) (WLT) (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* stellar aberration for transmission case */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("STLABX", (ftnlen)6); - } - -/* Obtain the negative of the observer's velocity. This */ -/* velocity, combined with the target's position, will yield */ -/* the inverse of the usual stellar aberration correction, */ -/* which is exactly what we seek. */ - - vminus_(vobs, negvel); - stelab_(pobj, negvel, corpos); - chkout_("STLABX", (ftnlen)6); - return 0; -} /* stlabx_ */ - diff --git a/ext/spice/src/cspice/stmp03.c b/ext/spice/src/cspice/stmp03.c deleted file mode 100644 index e0917a43df..0000000000 --- a/ext/spice/src/cspice/stmp03.c +++ /dev/null @@ -1,698 +0,0 @@ -/* stmp03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure STMP03 ( Stumpff functions 0 through 3 ) */ -/* Subroutine */ int stmp03_(doublereal *x, doublereal *c0, doublereal *c1, - doublereal *c2, doublereal *c3) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double log(doublereal); - - /* Local variables */ - integer divs, i__; - doublereal w, y, z__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal dpmax_(void); - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - static doublereal pairs[20], lbound; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Compute the values of the Stumpff functions C_0 through C_3 at */ -/* a specified point. */ - -/* $ 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 */ - -/* CONIC */ -/* MATH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* X I Argument to each Stumpff function C_0 to C_3. */ -/* C0 O Value of C_0(X) */ -/* C1 O Value of C_1(X) */ -/* C2 O Value of C_2(X) */ -/* C3 O Value of C_3(X) */ -/* TRUNC P Number of terms needed in Maclaurin series for C_3. */ - -/* $ Detailed_Input */ - -/* X is the argument to use in each of the Stumpff functions */ -/* C_0, C_1, C_2, and C_3. */ - -/* $ Detailed_Output */ - -/* C0 are the values of the Stumpff functions */ -/* C1 C_0(X), C_1(X), C_2(X), and C_3(X). */ -/* C2 */ -/* C3 */ - -/* $ Parameters */ - -/* TRUNC The Maclaurin series for C_3 and C_2 respectively are: */ - -/* 2 3 k */ -/* 1 X X X (-X) */ -/* C_3(X) = --- - --- + --- - --- + . . . + ----------. . . */ -/* 3! 5! 7! 9! (3 + 2*K)! */ - -/* and */ - -/* 2 3 k */ -/* 1 X X X (-X) */ -/* C_2(X) = --- - --- + --- - --- + . . . + ----------. . . */ -/* 2! 4! 6! 8! (2 + 2*K)! */ - -/* These series are used in the evaluation of C_3 and C_2. */ -/* Thus, it is necessary to make a decision about where to */ -/* truncate the series in our evaluation of C_3 and C_2. */ - -/* TRUNC is used to tell this routine where to truncate */ -/* the Maclaurin series for C_3 and C_2. */ - -/* The value of TRUNC for your machine is the smallest */ -/* integer such that */ - -/* 1 */ -/* 1.0D0 + ---------- = 1.0D0 */ -/* (2*TRUNC)! */ - -/* The following program will (if compiled and linked) */ -/* will produce the values of TRUNC for your machine. */ - -/* INTEGER TRUNC */ - -/* DOUBLE PRECISION DENOM */ -/* DOUBLE PRECISION FACTR */ - -/* DOUBLE PRECISION X */ - -/* DENOM = 2.0D0 */ -/* FACTR = 2.0D0 */ -/* TRUNC = 1 */ - -/* X = 1.0D0 / DENOM */ - -/* DO WHILE ( 1.0D0 + X .GT. 1.0D0 ) */ -/* DENOM = DENOM * (2.0D0+FACTR) * (1.0D0+FACTR) */ -/* FACTR = FACTR + 2.0D0 */ -/* TRUNC = TRUNC + 1 */ -/* X = 1.0D0 / DENOM */ -/* END DO */ - -/* WRITE (*,*) 'The value of TRUNC is: ', TRUNC */ - -/* END */ - -/* $ Exceptions */ - -/* 1) If the input value of X is not in the domain of values */ -/* for which the Stumpff functions can be computed, the error */ -/* SPICE(VALUEOUTOFRANGE) is signalled. */ - -/* The range of valid inputs is from -[ln(2) + ln(DPMAX)]**2 */ -/* to DPMAX. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the values of the Stumpff functions C_0, */ -/* C_1, C_2, and C_3 at the input X. */ - -/* The Stumpff function C_k(X) for k = 0, 1, ... is given by the */ -/* series: */ - -/* 2 3 m */ -/* 1 X X X (-X) */ -/* C_k(X) = --- - ------ + ------ - ------ + . . . + ------- + . . . */ -/* k! (k+2)! (k+4)! (k+6)! (k+2m)! */ - - -/* These series converge for all real values of X. */ - - -/* $ Examples */ - -/* For positive X, */ - -/* C_0(X) = COS ( DSQRT(X) ) */ - - -/* SIN ( DSQRT(X) ) */ -/* C_1(X) = --------------- */ -/* DSQRT(X) */ - - -/* 1 - COS ( DSQRT(X) ) */ -/* C_2(X) = --------------------- */ -/* X */ - - - -/* 1 - SIN ( DSQRT(X) ) / DSQRT(X) */ -/* C_3(X) = ---------------------------------- */ -/* X */ - -/* Thus the following block of code can be used to check this */ -/* routine for reasonableness: */ - -/* INTEGER I */ - -/* DOUBLE PRECISION X */ -/* DOUBLE PRECISION ROOTX */ - -/* DOUBLE PRECISION TC0 */ -/* DOUBLE PRECISION TC1 */ -/* DOUBLE PRECISION TC2 */ -/* DOUBLE PRECISION TC3 */ - -/* DOUBLE PRECISION C0 */ -/* DOUBLE PRECISION C1 */ -/* DOUBLE PRECISION C2 */ -/* DOUBLE PRECISION C3 */ - -/* DO I = 1, 10 */ - -/* X = DBLE (I) */ -/* ROOTX = DSQRT(X) */ - -/* TC0 = COS ( ROOTX ) */ -/* TC1 = SIN ( ROOTX ) / ROOTX */ - -/* TC2 = ( 1.0D0 - COS( ROOTX ) ) / X */ -/* TC3 = ( 1.0D0 - SIN( ROOTX ) / ROOTX ) / X */ - -/* CALL STMP03 ( X, C0, C1, C2, C3 ) */ - -/* WRITE (*,*) */ -/* WRITE (*,*) 'Expected - Computed for X = ', X */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Delta C0 :', TC0 - C0 */ -/* WRITE (*,*) 'Delta C1 :', TC1 - C1 */ -/* WRITE (*,*) 'Delta C2 :', TC2 - C2 */ -/* WRITE (*,*) 'Delta C3 :', TC3 - C3 */ - -/* END DO */ - -/* END */ - -/* You should expect all of the differences to be on the order of */ -/* the precision of the machine on which this program is executed. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Fundamentals of Celestial Mechanics', Second Edition */ -/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */ -/* Richmond Virginia; pp 168-180 */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 3.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 3.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 3.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 3.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 3.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 3.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 3.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 3.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 3.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 3.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 3.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 3.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 3.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 3.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 3.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 3.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 3.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 3.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 11-NOV-1993 (HAN) */ - -/* The file was modified to include values for other platforms. */ -/* Also, the file was formatted for use by the program that */ -/* creates the environment specific source files. */ - -/* - SPICELIB Version 1.0.0, 17-FEB-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Evaluate the first four Stumpff functions */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 2.0.0, 11-NOV-1993 (HAN) */ - -/* The file was modified to include values for other platforms. */ -/* Also, the file was formatted for use by the program that */ -/* creates the environment specific source files. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* The integers NPAIRS, LPAIR2, and LPAIR3 are used to declare */ -/* space for Maclaurin series coefficients and for determining how */ -/* many terms of these series to use in the computation of */ -/* C_2 and C_3. */ - -/* Here's what is supposed to be true. */ - -/* 1/(TRUNC*2)! + 1.0D0 = 1.0D0 */ - -/* using this machine's double precision arithmetic. */ - -/* We will map the input X to a value y between -1 and 1 and then */ -/* construct the values of the functions at X from their values at y. */ -/* Since we will only evaluate the series expansion for C_2 and C_3 */ -/* for values of y between -1 and 1, its easy to show that we don't */ -/* need to consider terms in the series whose coefficients have */ -/* magnitudes less than or equal 1/(2*TRUNC)! . */ - -/* If the value of TRUNC is 10, then the series expansions for */ -/* C_2(y) and C_3(y) are can be truncated as shown here: */ - -/* 2 7 8 */ -/* . 1 y y y y */ -/* C_3(y) = --- - --- + --- + ... - --- + --- */ -/* 3! 5! 7! 17! 19! */ - - -/* 1 y y y y */ -/* = ---( 1 - --- ( 1 - --- (...( 1- ----- ( 1 - ----- )...) */ -/* 2*3 4*5 6*7 16*17 18*19 */ - - - - -/* . 1 y y y y */ -/* C_2(y) = --- - --- + --- + ... + --- - --- */ -/* 2! 4! 6! 16! 18! */ - - -/* 1 y y y y */ -/* = ---( 1 - --- ( 1 - --- (...( 1- ----- ( 1 - ----- )...) */ -/* 1*2 3*4 5*6 15*16 17*18 */ - -/* As is evident from the above, we are going to need the */ -/* "reciprocal pairs" */ - -/* 1/(1*2), 1/(2*3), 1/(3*4), 1/(4*5), ... */ - -/* The number of such fractions be computed directly from */ -/* TRUNC. LPAIR3 and LPAIR2 indicate which of these pairs */ -/* (counting 1/(1*2) as the first) will be the last one needed in */ -/* the evaluation of C_2 and C_3. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* We are going to need the numbers */ - -/* 1/(2*3), 1/(3*4), 1/(4*5), ... */ - -/* but we don't want to compute them every time this routine is */ -/* called. So the first time this routine is called we compute */ -/* them and put them in the array PAIRS for use on subsequent */ -/* calls. (This could be done via parameters, but computing them */ -/* at run time seems to have a better chance of being */ -/* easily maintained.) */ - -/* In addition we will need to compute the lower bound for which */ -/* C_0,...,C_3 can be computed. This lower bound is computed by */ -/* noting that C_0 has the largest magnitude of all the Stumpff */ -/* functions over the domain from -infinity to -1. Moreover, in this */ -/* range */ - -/* C_0(X) = Cosh( SQRT(-X) ) */ - -/* Thus the range of X for which the Stumpff functions can be */ -/* computed is bounded below by the value of X for which */ - -/* Cosh ( SQRT(-X) ) = DPMAX */ - -/* Which implies the lower bound for valid inputs is at */ - -/* X = - ( DLOG ( 2.0 ) + DLOG( DPMAX ) ) ** 2 */ - -/* = - ( DLOG ( 2*N ) + DLOG ( DPMAX/N ) ) ** 2 */ - -/* We point out the second formulation of the bound just in case */ -/* your compiler can't handle the computation of DLOG ( DPMAX ). */ -/* If this unfortunate situation should arise, complain to the */ -/* company that produces your compiler and in the code below */ -/* compute LBOUND using the second form above with N equal to */ -/* some large power of 2 (say 2**20). */ - - if (first) { - first = FALSE_; - for (i__ = 1; i__ <= 20; ++i__) { - pairs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("pairs", - i__1, "stmp03_", (ftnlen)564)] = 1. / ((doublereal) i__ * - (doublereal) (i__ + 1)); - } - y = log(2.) + log(dpmax_()); - lbound = -y * y; - } - -/* First we make sure that the input value of X is within the */ -/* range that we are confident we can use to compute the Stumpff */ -/* functions. */ - - if (*x <= lbound) { - chkin_("STMP03", (ftnlen)6); - setmsg_("The input value of X must be greater than #. The input val" - "ue was #", (ftnlen)67); - errdp_("#", &lbound, (ftnlen)1); - errdp_("#", x, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("STMP03", (ftnlen)6); - return 0; - } - -/* From the definition of the Stumpff functions it can be seen that */ -/* C_0(X), C_1(X) are given by */ - -/* COS ( DSQRT(X) ) and SIN ( DSQRT(X) ) / DSQRT(X) */ - -/* for positive X. Moreover, the series used to define them converges */ -/* for all real X. */ - -/* These functions have a number of simple relationships that make */ -/* their computations practical. Among these are: */ - -/* 1 */ -/* x*C_k+2(x) = --- - C_k(x) */ -/* k! */ - - - -/* 2 */ -/* C_0(4x) = 2*[ C_0(x) ] - 1 */ - - - - -/* C_1(4x) = C_1(x)*C_0(x) */ - - - -/* 2 */ -/* C_2(4x) = [C_1(x)] / 2 */ - - - - -/* C_3(4x) = [ C_2(x) + C_0(x)*C_3(x) ] / 4 */ - -/* These can be used to derive formulae for C_0(16x) ... C_3(16x) */ -/* that involve only C_0(x) ... C_3(x). If we let */ - -/* 2 */ -/* Z = C_0(x) - 0.5 */ - -/* and */ - -/* W = 2*C_0(x)*C_1(x) */ - -/* then */ - -/* 2 */ -/* C_0(16x) = 8*Z - 1 */ - - -/* C_1(16x) = W*Z */ - - -/* 2 */ -/* C_2(16x) = W / 8 */ - - -/* 2 */ -/* C_1(x) + Z*[C_2(x) + C_0(x)*C_3(x)] */ -/* C_3(16x) = ---------------------------------- */ -/* 8 */ - - - -/* First we divide X by 16 until we reach a value for which */ -/* convergence of the Taylor Series is relatively rapid. */ - - y = *x; - divs = 0; - if (*x < 0.) { - while(y < -1.) { - y /= 16.; - ++divs; - } - } else { - while(y > 1.) { - y /= 16.; - ++divs; - } - } - -/* Compute C_3 of y : */ - -/* . 1 y y y y */ -/* C_3(y) = --- - --- + --- + ... - --- + --- */ -/* 3! 5! 7! 17! 19! */ - - -/* 1 y y y y */ -/* = ---( 1 - --- ( 1 - --- (...( 1- ----- ( 1 - ----- )...) */ -/* 2*3 4*5 6*7 16*17 18*19 */ - -/* ^ ^ ^ ^ ^ */ -/* | | | | | */ -/* | | | | | */ -/* PAIR(2) PAIR(4) PAIR(6) ... PAIR(16) PAIR(18) */ - -/* Assuming that we don't need to go beyond the term with 1/19!, */ -/* LPAIR3 will be 18. */ - - *c3 = 1.; - for (i__ = 20; i__ >= 4; i__ += -2) { - *c3 = 1. - y * pairs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("pairs", i__1, "stmp03_", (ftnlen)701)] * *c3; - } - *c3 = pairs[1] * *c3; - -/* Compute C_2 of y : */ - -/* Here's how we do it. */ -/* 2 7 8 */ -/* . 1 y y y y */ -/* C_2(y) = --- - --- + --- + ... + --- - --- */ -/* 2! 4! 6! 16! 18! */ - - -/* 1 y y y y */ -/* = ---( 1 - --- ( 1 - --- (...( 1- ----- ( 1 - ----- )...) */ -/* 1*2 3*4 5*6 15*16 17*18 */ - -/* ^ ^ ^ ^ ^ */ -/* | | | | | */ -/* | | | | | */ -/* PAIR(1) PAIR(3) PAIR(5) ... PAIR(15) PAIR(17) */ - -/* Assuming that we don't need to go beyond the term with 1/18!, */ -/* LPAIR2 will be 17. */ - - *c2 = 1.; - for (i__ = 19; i__ >= 3; i__ += -2) { - *c2 = 1. - y * pairs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("pairs", i__1, "stmp03_", (ftnlen)732)] * *c2; - } - *c2 = pairs[0] * *c2; - -/* Get C1 and C0 via the recursion formula: */ - -/* 1 */ -/* y*C_k+2(y) = --- - C_k(y) */ -/* k! */ - - *c1 = 1. - y * *c3; - *c0 = 1. - y * *c2; - -/* Now using the 16th angle formulae, compute C0 through C3 at X. */ - - i__1 = divs; - for (i__ = 1; i__ <= i__1; ++i__) { - z__ = *c0 * *c0 - .5; - w = *c0 * *c1 * 2.; - *c3 = (*c1 * *c1 + z__ * (*c2 + *c0 * *c3)) * .125; - *c2 = w * .125 * w; - *c1 = z__ * w; - *c0 = z__ * 8. * z__ - 1.; - } - return 0; -} /* stmp03_ */ - diff --git a/ext/spice/src/cspice/stpool.c b/ext/spice/src/cspice/stpool.c deleted file mode 100644 index 42da977ad2..0000000000 --- a/ext/spice/src/cspice/stpool.c +++ /dev/null @@ -1,450 +0,0 @@ -/* stpool.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure STPOOL ( String from pool ) */ -/* Subroutine */ int stpool_(char *item, integer *nth, char *contin, char * - string, integer *size, logical *found, ftnlen item_len, ftnlen - contin_len, ftnlen string_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer comp; - logical more; - char part[80]; - integer room, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer clast, csize; - logical gotit; - extern integer rtrim_(char *, ftnlen); - integer putat, strno; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen); - integer cfirst; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Retrieve the NTH string from the kernel pool variable, */ -/* where the string may be continued across several components */ -/* of the kernel pool variable. */ - -/* $ 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 */ - -/* POOL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I name of the kernel pool variable */ -/* NTH I index of the full component to retrieve */ -/* CONTIN I character sequence used to indicate continuation */ -/* STRING O a full string concatenated across continuations */ -/* SIZE O the number of character in the full string value */ -/* FOUND O flag indicating success or failure of request */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a kernel pool variable for which */ -/* the caller wants to retrieve a full (potentially */ -/* continued) string component. */ - - -/* NTH is the number of the component to retrieve from */ -/* the kernel pool. */ - -/* CONTIN is a sequence of characters which (if they appear as */ -/* the last non-blank sequence of characters in a */ -/* component of a value of a kernel pool variable) */ -/* indicate that the string associated with the */ -/* component is continued into the next literal */ -/* component of the kernel pool variable. */ - -/* If CONTIN is blank, all of the components of ITEM */ -/* will be retrieved as a single string. */ - -/* $ Detailed_Output */ - -/* STRING is the NTH full string associated with the kernel */ -/* pool variable specified by ITEM. */ - -/* Note that if STRING is not sufficiently long to hold */ -/* the fully continued string, the value will be */ -/* truncated. You can determine if STRING has been */ -/* truncated by examining the variable SIZE. */ - -/* SIZE is the index of last non-blank character of */ -/* continued string as it is represented in the */ -/* kernel pool. This is the actual number of characters */ -/* needed to hold the requested string. If STRING */ -/* contains a truncated portion of the full string, */ -/* RTRIM(STRING) will be less than SIZE. */ - -/* If the value of STRING should be a blank, then */ -/* SIZE will be set to 1. */ - -/* FOUND is a logical variable indicating success of the */ -/* request to retrieve the NTH string associated */ -/* with ITEM. If an NTH string exists, */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the variable specified by ITEM is not present in the */ -/* kernel pool or is present but is not character valued, */ -/* STRING will be returned as a blank, SIZE will be */ -/* returned with the value 0 and FOUND will be set to .FALSE. In */ -/* particular if NTH is less than 1, STRING will be returned as a */ -/* blank, SIZE will be zero and FOUND will be FALSE. */ - -/* 2) If the variable specified has a blank string associated */ -/* with its NTH full string, STRING will be blank, SIZE */ -/* will be 1 and FOUND will be set to .TRUE. */ - -/* 3) If STRING is not long enough to hold all of the characters */ -/* associated with the NTH string, it will be truncated on the */ -/* right. */ - -/* 4) If the continuation character is a blank, every component */ -/* of the variable specified by ITEM will be inserted into */ -/* the output string. */ - -/* 5) If the continuation character is blank, then a blank component */ -/* of a variable is treated as a component with no letters. */ -/* For example: */ - -/* STRINGS = ( 'This is a variable' */ -/* 'with a blank' */ -/* ' ' */ -/* 'component.' ) */ - -/* Is equivalent to */ - - -/* STRINGS = ( 'This is a variable' */ -/* 'with a blank' */ -/* 'component.' ) */ - -/* from the point of view of STPOOL if CONTIN is set to the */ -/* blank character. */ - -/* $ Particulars */ - -/* The SPICE Kernel Pool provides a very convenient interface */ -/* for supplying both numeric and textual data to user application */ -/* programs. However, any particular component of a character */ -/* valued component of a kernel pool variable is limited to 80 */ -/* or fewer characters in length. */ - -/* This routine allows you to overcome this limitation by */ -/* "continuing" a character component of a kernel pool variable. */ -/* To do this you need to select a continuation sequence */ -/* of characters and then insert this sequence as the last non-blank */ -/* set of characters that make up the portion of the component */ -/* that should be continued. */ - -/* For example, you may decide to use the sequence '//' to indicate */ -/* that a string should be continued to the next component of */ -/* a kernel pool variable. Then set up the */ -/* kernel pool variable as shown below */ - -/* LONG_STRINGS = ( 'This is part of the first component //' */ -/* 'that needs more than one line when //' */ -/* 'inserting it into the kernel pool.' */ -/* 'This is the second string that is split //' */ -/* 'up as several components of a kernel pool //' */ -/* 'variable.' ) */ - -/* When loaded into the kernel pool, the variable LONG_STRINGS */ -/* will have six literal components: */ - -/* COMPONENT (1) = 'This is part of the first component //' */ -/* COMPONENT (2) = 'that needs more than one line when //' */ -/* COMPONENT (3) = 'inserting it into the kernel pool.' */ -/* COMPONENT (4) = 'This is the second string that is split //' */ -/* COMPONENT (5) = 'up as several components of a kernel pool //' */ -/* COMPONENT (6) = 'variable.' */ - -/* These are the components that would be retrieved by the call */ - -/* CALL GCPOOL ( 'LONG_STRINGS', 1, 6, N, COMPONENT, FOUND ) */ - -/* However, using the routine STPOOL you can view the variable */ -/* LONG_STRINGS as having two long components. */ - -/* STRING (1) = 'This is part of the first component that ' */ -/* . // 'needs more than one line when inserting ' */ -/* . // 'it into the kernel pool. ' */ - -/* STRING (2) = 'This is the second string that is split ' */ -/* . // 'up as several components of a kernel pool ' */ -/* . // 'variable. ' */ - - -/* These string components would be retrieved by the following two */ -/* calls. */ - -/* CALL STPOOL ( 'LONG_STRINGS, 1, '//', STRING(1), SIZE, FOUND ) */ -/* CALL STPOOL ( 'LONG_STRINGS, 2, '//', STRING(2), SIZE, FOUND ) */ - -/* $ Examples */ - -/* Example 1. Retrieving file names. */ - -/* Suppose a you have used the kernel pool as a mechanism for */ -/* specifying SPK files to load at startup but that the full */ -/* names of the files are too long to be contained in a single */ -/* text line of a kernel pool assignment. */ - -/* By selecting an appropriate continuation character ('*' for */ -/* example) you can insert the full names of the SPK files */ -/* into the kernel pool and then retrieve them using this */ -/* routine. */ - -/* First set up the kernel pool specification of the strings */ -/* as shown here: */ - -/* SPK_FILES = ( 'this_is_the_full_path_specification_*' */ -/* 'of_a_file_with_a_long_name' */ -/* 'this_is_the_full_path_specification_*' */ -/* 'of_a_second_file_with_a_very_long_*' */ -/* 'name' ) */ - -/* Now to retrieve and load the SPK_FILES one at a time, */ -/* exercise the following loop. */ - -/* INTEGER FILSIZ */ -/* PARAMETER ( FILSIZ = 255 ) */ - -/* CHARACTER*(FILSIZ) FILE */ -/* INTEGER I */ - -/* I = 1 */ - -/* CALL STPOOL ( 'SPK_FILES', I, '*', FILE, SIZE, FOUND ) */ - -/* DO WHILE ( FOUND .AND. RTRIM(FILE) .EQ. SIZE ) */ - -/* CALL SPKLEF ( FILE, HANDLE ) */ -/* I = I + 1 */ -/* CALL STPOOL ( 'SPK_FILES', I, '*', FILE, SIZE, FOUND ) */ -/* END DO */ - -/* IF ( FOUND .AND. RTRIM(FILE) .NE. SIZE ) THEN */ -/* WRITE (*,*) 'The ', I, '''th file name was too long.' */ -/* END IF */ - - -/* Example 2. Retrieving all components as a string. */ - - -/* Occasionally, it may be useful to retrieve the entire */ -/* contents of a kernel pool variable as a single string. To */ -/* do this you can use the blank character as the */ -/* continuation character. For example if you place the */ -/* following assignment in a text kernel */ - -/* COMMENT = ( 'This is a long note ' */ -/* ' about the intended ' */ -/* ' use of this text kernel that ' */ -/* ' can be retrieved at run time.' ) */ - -/* you can retrieve COMMENT as single string via the call below. */ - -/* CALL STPOOL ( 'COMMENT', 1, ' ', COMMNT, SIZE, FOUND ) */ - -/* The result will be that COMMNT will have the following value. */ - -/* COMMNT = 'This is a long note about the intended use of ' */ -/* . // 'this text kernel that can be retrieved at run ' */ -/* . // 'time. ' */ - -/* Note that the leading blanks of each component of COMMENT are */ -/* significant, trailing blanks are not significant. */ - -/* If COMMENT had been set as */ - -/* COMMENT = ( 'This is a long note ' */ -/* 'about the intended ' */ -/* 'use of this text kernel that ' */ -/* 'can be retrieved at run time.' ) */ - -/* Then the call to STPOOL above would have resulted in several */ -/* words being run together as shown below. */ - - -/* COMMNT = 'This is a long noteabout the intendeduse of ' */ -/* . // 'this text kernel thatcan be retrieved at run ' */ -/* . // 'time. ' */ - - -/* resulted in several words being run together as shown below. */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JUL-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Retrieve a continued string value from the kernel pool */ - -/* -& */ -/* SPICELIB Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - if (*nth < 1) { - *found = FALSE_; - s_copy(string, " ", string_len, (ftnlen)1); - *size = 0; - return 0; - } - chkin_("STPOOL", (ftnlen)6); - room = i_len(string, string_len); - csize = rtrim_(contin, contin_len); - putat = 1; - -/* Retrieve components until we've gone past the first NTH-1 */ -/* strings. */ - - strno = 1; - comp = 1; - *found = FALSE_; - while(strno < *nth) { - gcpool_(item, &comp, &c__1, &n, part, &gotit, item_len, (ftnlen)80); - gotit = n > 0; - if (! gotit) { - s_copy(string, " ", string_len, (ftnlen)1); - *size = 0; - *found = FALSE_; - chkout_("STPOOL", (ftnlen)6); - return 0; - } - clast = rtrim_(part, (ftnlen)80); - cfirst = clast - csize + 1; - if (cfirst < 0) { - ++strno; - } else if (s_cmp(part + (cfirst - 1), contin, clast - (cfirst - 1), - contin_len) != 0) { - ++strno; - } - ++comp; - } - -/* Once we've reached this point, COMP points to the component */ -/* of the kernel pool variable that is the beginning of the NTH */ -/* string. Now just retrieve components until we run out or */ -/* one is not continued. */ - - more = TRUE_; - s_copy(string, " ", string_len, (ftnlen)1); - n = 0; - while(more) { - gcpool_(item, &comp, &c__1, &n, part, &more, item_len, (ftnlen)80); - more = more && n > 0; - if (more) { - *found = TRUE_; - clast = rtrim_(part, (ftnlen)80); - cfirst = clast - csize + 1; - if (cfirst < 0) { - if (putat <= room) { - s_copy(string + (putat - 1), part, string_len - (putat - - 1), clast); - } - putat += clast; - more = FALSE_; - } else if (s_cmp(part + (cfirst - 1), contin, clast - (cfirst - 1) - , contin_len) != 0) { - if (putat <= room) { - s_copy(string + (putat - 1), part, string_len - (putat - - 1), clast); - } - putat += clast; - more = FALSE_; - } else if (cfirst > 1) { - if (putat <= room) { - s_copy(string + (putat - 1), part, string_len - (putat - - 1), cfirst - 1); - } - putat = putat + cfirst - 1; - } - } - ++comp; - } - -/* We are done. Get the size of the full string and checkout. */ - - *size = putat - 1; - chkout_("STPOOL", (ftnlen)6); - return 0; -} /* stpool_ */ - diff --git a/ext/spice/src/cspice/stpool_c.c b/ext/spice/src/cspice/stpool_c.c deleted file mode 100644 index 4283c9268e..0000000000 --- a/ext/spice/src/cspice/stpool_c.c +++ /dev/null @@ -1,474 +0,0 @@ -/* - --Procedure stpool_c ( String from pool ) - --Abstract - - Retrieve the nth string from the kernel pool variable, where the - string may be continued across several components of the kernel pool - variable. - --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 - - POOL - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void stpool_c ( ConstSpiceChar * item, - SpiceInt nth, - ConstSpiceChar * contin, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * size, - SpiceBoolean * found ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - item I Name of the kernel pool variable. - nth I Index of the full string to retrieve. - contin I Character sequence used to indicate continuation. - lenout I Available space in output string. - string O A full string concatenated across continuations. - size O The number of characters in the full string value. - found O Flag indicating success or failure of request. - --Detailed_Input - - item is the name of a kernel pool variable for which - the caller wants to retrieve a full (potentially - continued) string. - - nth is the number of the string to retrieve from the kernel - pool. The range of `nth' is 0 to one less than the - number of full strings that are present. - - contin is a sequence of characters which (if they appear as the - last non-blank sequence of characters in a component of a - value of a kernel pool variable) act as a continuation - marker: the marker indicates that the string associated - with the component containing it is continued into the - next literal component of the kernel pool variable. - - If contin is blank, all of the components of `item' - will be retrieved as a single string. - - lenout is the available space in the output string, counting - room for the terminating null. Up to lenout-1 "data" - characters will be assigned to the output string. - --Detailed_Output - - string is the nth full string associated with the kernel - pool variable specified by item. - - Note that if `string' is not sufficiently long to hold - the fully continued string, the value will be truncated. - You can determine if `string' has been truncated by - examining the variable `size'. `string' will always be - null-terminated, even if truncation of the data occurs. - - size is the index of last non-blank character of the continued - string as it is represented in the kernel pool. This is - the actual number of characters needed to hold the - requested string. If `string' contains a truncated - portion of the full string, strlen(string) will be less - than `size'. - - If the value of `string' should be a blank, then - SIZE will be set to 1. - - found is a logical variable indicating success of the - request to retrieve the nth string associated - with item. If an nth string exists, `found' will be - set to SPICETRUE; otherwise `found' will be set to - SPICEFALSE. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the variable specified by item is not present in the kernel - pool or is present but is not character valued, string will be - returned as a null string, size will be returned with the value 0 - and found will be set to SPICEFALSE. - - 2) If the variable specified has a blank string associated - with its nth full string, string will be blank, size - will be 1 and found will be set to SPICETRUE. - - 3) If string is not long enough to hold all of the characters - associated with the nth string, it will be truncated on the - right. string will still be null terminated. - - 4) If the continuation character is a blank, every component - of the variable specified by item will be inserted into - the output string. - - 5) If the continuation character is blank, then a blank component - of a variable is treated as a component with no letters. - For example: - - STRINGS = ( 'This is a variable' - 'with a blank' - ' ' - 'component.' ) - - Is equivalent to - - - STRINGS = ( 'This is a variable' - 'with a blank' - 'component.' ) - - from the point of view of stpool_c if contin is set to the - blank character. - - 6) If either the input or output string pointers are null, the error - SPICE(NULLPOINTER) will be signaled. - - 7) If any input strings have length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 8) The caller must pass a value indicating the length of the output - string. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Particulars - - The SPICE Kernel Pool provides a very convenient interface for - supplying both numeric and textual data to user application - programs. However, any particular component of a character valued - component of a kernel pool variable is limited to 80 or fewer - characters in length. - - This routine allows you to overcome this limitation by "continuing" - a character component of a kernel pool variable. To do this you need - to select a continuation sequence of characters and then insert this - sequence as the last non-blank set of characters that make up the - portion of the component that should be continued. - - For example, you may decide to use the sequence "//" to indicate - that a string should be continued to the next component of a kernel - pool variable. Then set up the kernel pool variable as shown below: - - LONG_STRINGS = ( 'This is part of the first component //' - 'that needs more than one line when //' - 'inserting it into the kernel pool.' - 'This is the second string that is split //' - 'up as several components of a kernel pool //' - 'variable.' ) - - When loaded into the kernel pool, the variable LONG_STRINGS - will have six literal components: - - component[0] == "This is part of the first component //" - component[1] == "that needs more than one line when //" - component[2] == "inserting it into the kernel pool." - component[3] == "This is the second string that is split //" - component[4] == "up as several components of a kernel pool //" - component[5] == "variable." - - These are the components that would be retrieved by the call - - gcpool_c ( "LONG_STRINGS", 1, 6, 81, &n, component, &found ); - - However, using the routine stpool_c you can view the variable - LONG_STRINGS as having two long components. - - string [0] == "This is part of the first component that " - "needs more than one line when inserting " - "it into the kernel pool. " - - string [1] == "This is the second string that is split " - "up as several components of a kernel pool " - "variable. " - - - These string components would be retrieved by the following two - calls. We will use 81 as the length of the elements of the string - array. - - stpool_c( "LONG_STRINGS", 0, "//", 81, string[0], &size, &found ); - stpool_c( "LONG_STRINGS", 1, "//", 81, string[1], &size, &found ); - --Examples - - Example 1. Retrieving file names. - - Suppose a you have used the kernel pool as a mechanism for - specifying SPK files to load at startup but that the full names - of the files are too long to be contained in a single text line - of a kernel pool assignment. - - By selecting an appropriate continuation character ("*" for - example) you can insert the full names of the SPK files into the - kernel pool and then retrieve them using this routine. - - First set up the kernel pool specification of the strings - as shown here: - - SPK_FILES = ( 'this_is_the_full_path_specification_*' - 'of_a_file_with_a_long_name' - 'this_is_the_full_path_specification_*' - 'of_a_second_file_with_a_very_long_*' - 'name' ) - - Now to retrieve and load the SPK_FILES one at a time, - exercise the following loop. - - #include - #include - #include "SpiceUsr.h" - . - . - . - #define FILSIZ 255 - - SpiceBoolean found; - - SpiceChar file [ FILSIZ ]; - - SpiceInt handle; - SpiceInt i; - SpiceInt size; - - - i = 0; - - stpool_c ( "SPK_FILES", i, "*", FILSIZ, file, &size, &found ); - - while ( found && ( strlen(file) == size ) ) - { - spklef_c ( file, &handle ); - - i++; - - stpool_c ( "SPK_FILES", i, "*", FILSIZ, - file, &size, &found ); - } - - if ( found && ( strlen(file) != size ) ) - { - printf ( "The %d th file name was too long\n", i ); - } - - - - Example 2. Retrieving all components as a string. - - - Occasionally, it may be useful to retrieve the entire - contents of a kernel pool variable as a single string. To - do this you can use the blank character as the - continuation character. For example if you place the - following assignment in a text kernel - - COMMENT = ( 'This is a long note ' - ' about the intended ' - ' use of this text kernel that ' - ' can be retrieved at run time.' ) - - you can retrieve COMMENT as single string via the call below. Here - LENOUT is the declared length of commnt. - - stpool_c ( "COMMENT", 1, " ", commnt, LENOUT, &size, &found ); - - The result will be that commnt will have the following value. - - commnt == "This is a long note about the intended use of " - "this text kernel that can be retrieved at run " - "time. " - - Note that the leading blanks of each component of COMMENT are - significant; trailing blanks are not significant. - - If COMMENT had been set as - - COMMENT = ( 'This is a long note ' - 'about the intended ' - 'use of this text kernel that ' - 'can be retrieved at run time.' ) - - Then the call to stpool_c above would have resulted in several - words being run together as shown below. - - - commnt == "This is a long noteabout the intendeduse of " - "this text kernel thatcan be retrieved at run " - "time. " - - - resulted in several words being run together as shown above. - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.2.0, 06-SEP-2004 (NJB) - - Bug fix: added CHKOSTR call to check output string pointer - and length. Made some minor header updates. - - -CSPICE Version 1.1.0, 06-MAY-2003 (NJB) - - Bug fix: removed extra #include statement referencing - SpiceZfc.h. - - -CSPICE Version 1.0.1, 10-JUN-2001 (NJB) - - Header was corrected: kernel variable assignments were shown - using double quotes; these have been changed to single quotes. - - Various instances of the '=' operator were replaced with the - '==' operator in comments where the intent was to indicate - equality of two items. - - -CSPICE Version 1.0.0, 10-JUN-1999 (NJB) (WLT) - --Index_Entries - - Retrieve a continued string value from the kernel pool - --& -*/ - - -{ /* Begin stpool_c */ - - - /* - Local variables - */ - logical fnd; - SpiceInt ncomp; - - - /* - Participate in error tracing. - */ - chkin_c ( "stpool_c" ); - - - /* - Initialize the found flag in case we get kicked out on an error - condition. - */ - - *found = SPICEFALSE; - - - /* - Check the input strings item and contin to make sure the pointers - are non-null and the strings are non-empty. - */ - CHKFSTR ( CHK_STANDARD, "stpool_c", item ); - CHKFSTR ( CHK_STANDARD, "stpool_c", contin ); - - - /* - Check the output string to make sure the pointer is non-null and that - there is room for at least one character plus a null terminator. - */ - CHKOSTR ( CHK_STANDARD, "stpool_c", string, lenout ); - - /* - Call the f2c'd routine. First map the number of components to - the Fortran style range of 1 : #of components. - */ - - ncomp = nth + 1; - - stpool_ ( ( char * ) item, - ( integer * ) &ncomp, - ( char * ) contin, - ( char * ) string, - ( integer * ) size, - ( logical * ) &fnd, - ( ftnlen ) strlen(item), - ( ftnlen ) strlen(contin), - ( ftnlen ) lenout-1 ); - - /* - Convert the output string from C style to Fortran style. - */ - F2C_ConvertStr ( lenout, string ); - - - /* - If the output string is supposed to consist of a single blank, make - sure that's what string contains. This condition holds when fnd - is SPICETRUE, string is empty, and size is 1. The Fortran to C - conversion wipes out trailing white space; that's why string would - be empty in this case. - */ - - if ( fnd && ( strlen(string) == 0 ) && ( *size == 1 ) ) - { - string[0] = BLANK; - string[1] = NULLCHAR; - } - - - /* - Set the SpiceBoolean found flag. - */ - *found = fnd; - - - chkout_c ( "stpool_c" ); - -} /* End stpool_c */ diff --git a/ext/spice/src/cspice/str2et.c b/ext/spice/src/cspice/str2et.c deleted file mode 100644 index 366d7e75d2..0000000000 --- a/ext/spice/src/cspice/str2et.c +++ /dev/null @@ -1,1335 +0,0 @@ -/* str2et.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; -static integer c__6 = 6; - -/* $Procedure STR2ET ( String to ET ) */ -/* Subroutine */ int str2et_(char *string, doublereal *et, ftnlen string_len) -{ - /* Initialized data */ - - static char defzon[16] = " "; - static char defsys[16] = "UTC "; - static char mixed[16] = "MIXED "; - static char juln[16] = "JULIAN "; - static char gregrn[16] = "GREGORIAN "; - static doublereal dhoff = 0.; - static doublereal dmoff = 0.; - static char mname[16*12] = "January " "February " "March " - " " "April " "May " "June " - " " "July " "August " "September " - "October " "November " "December "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *); - double d_int(doublereal *); - - /* Local variables */ - static doublereal frac, hoff, moff, secs; - static integer year; - static doublereal tvec[8]; - static logical mods; - static integer last; - static doublereal hour; - static char hstr[2], type__[16], mstr[2]; - static integer i__; - static char check[16]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer cyear; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static integer gyear; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), moved_(doublereal *, integer *, - doublereal *), dpfmt_(doublereal *, char *, char *, ftnlen, - ftnlen), repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, - ftnlen); - static logical dojul; - static doublereal tvecm[8]; - static char forml[16]; - static integer ntvec; - static logical zoned; - static doublereal extra; - static integer month; - static char error[400]; - extern /* Subroutine */ int jul2gr_(integer *, integer *, integer *, - integer *), gr2jul_(integer *, integer *, integer *, integer *); - static integer sc, hr, mm, mn, dy; - static logical ok; - extern /* Subroutine */ int tchckd_(char *, ftnlen), tcheck_(doublereal *, - char *, logical *, char *, logical *, char *, ftnlen, ftnlen, - ftnlen); - static char calndr[16]; - extern /* Subroutine */ int timdef_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - static integer yr; - extern /* Subroutine */ int tparch_(char *, ftnlen); - static logical succes; - static char modify[16*5]; - static logical yabbrv, adjust; - extern /* Subroutine */ int sigerr_(char *, ftnlen), prefix_(char *, - integer *, char *, ftnlen, ftnlen), chkout_(char *, ftnlen); - static doublereal minute; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static char pictur[80]; - static logical ok1, ok2; - extern /* Subroutine */ int ttrans_(char *, char *, doublereal *, ftnlen, - ftnlen); - extern logical return_(void); - static integer orgnyr; - extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char - *, char *, logical *, logical *, logical *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), texpyr_(integer *); - static integer day; - static doublereal mdy[2], mon[2]; - static integer doy; - extern /* Subroutine */ int zzutcpm_(char *, integer *, doublereal *, - doublereal *, integer *, logical *, ftnlen); - -/* $ Abstract */ - -/* Convert a string representing an epoch to a double precision */ -/* value representing the number of TDB seconds past the J2000 */ -/* epoch corresponding to the input epoch. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A string representing an epoch. */ -/* ET O The equivalent value in seconds past J2000, TDB. */ - -/* $ Detailed_Input */ - -/* STRING is a string representing an epoch. Virtually all */ -/* common calendar representations are allowed. You may */ -/* specify a time string belonging to any of the */ -/* systems TDB, TDT, UTC. Moreover, you may specify a */ -/* time string relative to a specific UTC based time */ -/* zone. */ - -/* The rules used in the parsing of STRING are spelled */ -/* out in great detail in the routine TPARTV. The basics */ -/* are given in the Particulars section below. */ - -/* $ Detailed_Output */ - -/* ET is the double precision number of TDB seconds past the */ -/* J2000 epoch that corresponds to the input STRING. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) The error SPICE(UNPARSEDTIME) is signaled if the */ -/* string cannot be recognized as a legitimate time string. */ - -/* 2) The error SPICE(TIMECONFLICT) is signaled if more than */ -/* one time system is specified as part of the time string. */ - -/* 3) The error SPICE(BADTIMESTRING) is signaled if any component */ -/* of the time string is outside the normal range of usage. For */ -/* example, the day January 35 is outside the normal range of days */ -/* in January. The checks applied are spelled out in the routine */ -/* TCHECK. */ - -/* 4) If a time zone is specified with hours or minutes components */ -/* that are outside of the normal range, the error */ -/* SPICE(TIMEZONEERROR) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the ephemeris epoch corresponding to an */ -/* input string. The ephemeris epoch is represented as seconds */ -/* past the J2000 epoch in the time system known as Barycentric */ -/* Dynamical Time (TDB). This time system is also referred to as */ -/* Ephemeris Time (ET) throughout the SPICE Toolkit. */ - -/* The variety of ways people have developed for representing */ -/* times is enormous. It is unlikely that any single subroutine */ -/* can accommodate the wide variety of custom time formats that */ -/* have arisen in various computing contexts. However, we */ -/* believe that this routine will correctly interpret most time */ -/* formats used throughout the planetary science community. */ -/* For example this routine supports ISO time formats and UNIX */ -/* `date` output formats. One obvious omission from the strings */ -/* recognized by this routine are strings of the form */ - -/* 93234.1829 or 1993234.1829 */ - -/* Some readers may recognize this as the epoch that is 0.1829 */ -/* days past the beginning of the 234'th day of 1993. However, */ -/* many other readers may regard this interpretation as a bit */ -/* obscure. */ - -/* Below we outline some of the rules used in the interpretation */ -/* of strings. A more complete discussion of the interpretation */ -/* of strings is given in the routine TPARTV. */ - - -/* Default Behavior */ -/* ---------------- */ - -/* Consider the string */ - -/* 1988 June 13, 3:29:48 */ - -/* There is nothing in this string to indicate what time system */ -/* the date and time belong to. Moreover, there is nothing to */ -/* indicate whether the time is based on a 24-hour clock or */ -/* twelve hour clock. */ - -/* In the absence of such indicators, the default interpretation */ -/* of this string is to regard the time of day to be a time on */ -/* a 24-hour clock in the UTC time system. The date is a date */ -/* on the Gregorian Calendar (this is the calendar used in nearly */ -/* all western societies). */ - -/* Labels */ -/* ------ */ - -/* If you add more information to the string, STR2ET can make a */ -/* more informed interpretation of the time string. For example: */ - -/* 1988 June 13, 3:29:48 P.M. */ - -/* is still regarded as a UTC epoch. However, with the addition */ -/* of the 'P.M.' label it is now interpreted as the same epoch */ -/* as the unlabeled epoch 1988 June 13, 15:29:48. Similarly */ - -/* 1988 June 13, 12:29:48 A.M. */ - -/* is interpreted as */ - -/* 1988 June 13, 00:29:48 */ - -/* For the record: 12:00 A.M. corresponds to Midnight (00:00 on the */ -/* 24 hour clock. 12:00 P.M. corresponds to Noon. (12:00) on the */ -/* 24 hour clock. */ - -/* You may add still further indicators to the string. For example */ - -/* 1988 June 13, 3:29:48 P.M. PST */ - -/* is interpreted as an epoch in the Pacific Standard Time system. */ -/* This is equivalent to */ - -/* 1988 June 13, 07:29:48 UTC */ - -/* The following U.S. time zones are recognized. */ - -/* EST --- Eastern Standard Time ( UTC-5:00 ) */ -/* CST --- Central Standard Time ( UTC-6:00 ) */ -/* MST --- Mountain Standard Time ( UTC-7:00 ) */ -/* PST --- Pacific Standard Time ( UTC-8:00 ) */ - -/* EDT --- Eastern Daylight Time ( UTC-4:00 ) */ -/* CDT --- Central Daylight Time ( UTC-5:00 ) */ -/* MDT --- Mountain Daylight Time ( UTC-6:00 ) */ -/* PDT --- Pacific Daylight Time ( UTC-7:00 ) */ - -/* In addition any other time zone may be specified by representing */ -/* its offset from UTC. This notation starts with the letters 'UTC' */ -/* followed by a '+' for time zones east of Greenwich and '-' for */ -/* time zones west of Greenwich. This is followed by the number of */ -/* hours to add or subtract from UTC. This is optionally followed */ -/* by a colon ':' and the number of minutes to add or subtract to */ -/* get the local time zone. Thus to specify the time zone of */ -/* Calcutta (which is 5 and 1/2 hours ahead of UTC) you would */ -/* specify the time zone to be UTC+5:30. To specify the time zone */ -/* of Newfoundland (which is 3 and 1/2 hours behind UTC) use the */ -/* offset notation UTC-3:30. */ - -/* For the Record: Leapseconds occur at the same time in all */ -/* time zones. In other words, the seconds component of a time */ -/* string is the same for any time zone as is the seconds */ -/* component of UTC. Thus the following are all legitimate */ -/* ways to represent an epoch of some event that occurred */ -/* in the leapsecond */ - -/* 1995 December 31 23:59:60.5 (UTC) */ - - -/* 1996 January 1, 05:29:60.5 (UTC+5:30 --- Calcutta Time) */ -/* 1995 December 31, 20:29:60.5 (UTC-3:30 --- Newfoundland) */ -/* 1995 December 31 18:59:60.5 (EST) */ -/* 1995 December 31 17:59:60.5 (CST) */ -/* 1995 December 31 16:59:60.5 (MST) */ -/* 1995 December 31 15:59:60.5 (PST) */ - - -/* In addition to specifying time zones, you may specify that the */ -/* string be interpreted as a formal calendar representation in */ -/* either the Barycentric Dynamical Time system (TDB) or the */ -/* Terrestrial Dynamical Time system (TDT). In These systems there */ -/* are no leapseconds. Times in TDB are written as */ - -/* 1988 June 13, 12:29:48 TDB */ - -/* TDT times are written as: */ - -/* 1988 June 13, 12:29:48 TDT */ - -/* Finally, you may explicitly state that the time system is UTC */ - -/* 1988 June 13, 12:29:48 UTC. */ - - -/* Abbreviating Years */ -/* ------------------ */ - -/* Although it can lead to confusion, many people are in the */ -/* habit of abbreviating years when they write them in dates. */ -/* For example */ - -/* 99 Jan 13, 12:28:24 */ - -/* Upon seeing such a string, most of us would regard this */ -/* as being 1999 January 13, 12:28:24 and not January 13 of */ -/* the year 99. This routine interprets years that are less */ -/* than 100 as belonging either to the 1900's or 2000's. Years */ -/* greater than 68 ( 69 - 99 ) are regarded as being an */ -/* abbreviation with the '19' suppressed (1969 - 1999). Years */ -/* smaller than 69 ( 00 - 68 ) are regarded as being an */ -/* abbreviation with the '20' suppressed (2000 - 2068). */ - -/* Note that in general it is usually a good idea to write */ -/* out the year. Or if you'd like to save some typing */ -/* abbreviate 1999 as '99. */ - -/* If you need to specify an epoch whose year */ -/* is less than 1000, we recommend that you specify the era */ -/* along with the year. For example if you want to specify */ -/* the year 13 A.D. write it as */ - -/* 13 A.D. Jan 12 */ - -/* When specifying the era it should immediately follow the year. */ -/* Both the A.D. and B.C. eras are supported. */ - - -/* Changing Default Behavior */ -/* ------------------------- */ - -/* As discussed above, if a string is unlabeled, it is regarded */ -/* as representing a string in the UTC time system on the */ -/* Gregorian calendar. In addition abbreviated years are */ -/* regarded as abbreviations of the years from 1969 to 2068. */ - -/* You may modify these defaults through the routines TIMDEF */ -/* and TSETYR (an entry point of TEXPYR). */ - -/* You may: */ - -/* Set the calendar to be Gregorian, Julian or a mixture of */ -/* two via the TIMDEF; */ - -/* Set the time system to be UTC, TDB, TDT or any time zone */ -/* via the routine TIMDEF; */ - -/* Set the range of year abbreviations to be any 100 year */ -/* interval via the routine TSETYR. */ - -/* See the routine TEXPYR and TIMDEF for details on changing */ -/* defaults. */ - -/* These alterations affect only the interpretation of unlabeled */ -/* strings. If an input string is labeled the specification */ -/* in the label is used. */ - - -/* If any component of a date or time is out of range, STR2ET */ -/* regards the string as erroneous. Below is a list of */ -/* erroneous strings and why they are regarded as such. */ - -/* 1997 Jan 32 12:29:29 --- there are only 31 days in January */ - -/* '98 Jan 12 13:29:29 A.M. --- Hours must be between 1 and 12 */ -/* inclusive when A.M. or P.M. is */ -/* specified. */ - -/* 1997 Feb 29, 12:29:20.0 --- February has only 29 days in */ -/* 1997. This would be ok if the */ -/* year was 1996. */ - - -/* 1992 Mar 12 12:62:20 --- Minutes must be between 0 and 59 */ -/* inclusive. */ - -/* 1993 Mar 18 15:29:60.5 --- Seconds is out of range for this */ -/* date. It would not be out of */ -/* range for Dec 31 23:59:60.5 or */ -/* Jun 30 23:59:60.5 because these */ -/* can be leapseconds (UTC). */ - -/* Specifics On Interpretation of the Input String */ -/* ----------------------------------------------- */ - -/* The process of examining the string to determine its meaning is */ -/* called "parsing" the string. The string is parsed by first */ -/* determining its recognizable substrings (integers, punctuation */ -/* marks, names of months, names of weekdays, time systems, time */ -/* zones, etc.) These recognizable substrings are called the tokens */ -/* of the input string. The meaning of some tokens are immediately */ -/* determined. For example named months, weekdays, time systems have */ -/* clear meanings. However, the meanings of numeric components must */ -/* be deciphered from their magnitudes and location in the string */ -/* relative to the immediately recognized components of the input */ -/* string. */ - -/* To determine the meaning of the numeric tokens in the input */ -/* string, a set of "production rules" and transformations are */ -/* applied to the full set of tokens in the string. These */ -/* transformations are repeated until the meaning of every token */ -/* has been determined, or until further transformations yield */ -/* no new clues into the meaning of the numeric tokens. */ - -/* 1) Unless the substring 'JD' or 'jd' is present, the string is */ -/* assumed to be a calendar format (day-month-year or year and */ -/* day of year). If the substring JD or jd is present, the */ -/* string is assumed to represent a Julian date. */ - -/* 2) If the Julian date specifier is not present, any integer */ -/* greater than 999 is regarded as being a year specification. */ - -/* 3) A dash '-' can represent a minus sign only if it precedes */ -/* the first digit in the string and the string contains */ -/* the Julian date specifier (JD). (No negative years, */ -/* months, days, etc are allowed). */ - -/* 4) Numeric components of a time string must be separated */ -/* by a character that is not a digit or decimal point. */ -/* Only one decimal component is allowed. For example */ -/* 1994219.12819 is sometimes interpreted as the */ -/* 219th day of 1994 + 0.12819 days. STR2ET does not */ -/* support such strings. */ - -/* No exponential components are allowed. For example you */ -/* can't specify the Julian date of J2000 as 2.451545E6. */ - -/* 5) The single colon (:) when used to separate numeric */ -/* components of a string is interpreted as separating */ -/* Hours, Minutes, and Seconds of time. */ - -/* 6) If a double slash (//) or double colon (::) follows */ -/* a pair of integers, those integers are assumed to */ -/* represent the year and day of year. */ - -/* 7) A quote followed by an integer less than 100 is regarded */ -/* as an abbreviated year. For example: '93 would be regarded */ -/* as the 93rd year of the reference century. See TEXPYR */ -/* for further discussion of abbreviated years. */ - -/* 8) An integer followed by 'B.C.' or 'A.D.' is regarded as */ -/* a year in the era associated with that abbreviation. */ - -/* 9) All dates are regarded as belonging to the extended */ -/* Gregorian Calendar (the Gregorian calendar is the calendar */ -/* currently used by western society). See the routine TIMDEF */ -/* to modify this behavior. */ - -/* 10) If the ISO date-time separator (T) is present in the string */ -/* ISO allowed token patterns are examined for a match */ -/* with the current token list. If no match is found the */ -/* search is abandoned and appropriate diagnostic messages */ -/* are generated. */ - -/* 11) If two delimiters are found in succession in the time */ -/* string, the time string is diagnosed as an erroneous string. */ -/* (Delimiters are comma, white space, dash, slash, period, or */ -/* of year mark. The day of year mark is a pair of forward */ -/* slashes or a pair of colons.) */ - -/* Note the delimiters do not have to be the same. The pair */ -/* of characters ",-" counts as two successive delimiters. */ - -/* 12) White space and commas serve only to delimit tokens in the */ -/* input string. They do not affect the meaning of any */ -/* of the tokens. */ - -/* 13) If an integer is greater than 1000 (and the 'JD' label */ -/* is not present, the integer is regarded as a year. */ - -/* 14) When the size of the integer components does not clearly */ -/* specify a year the following patterns are assumed */ - -/* Calendar Format */ - -/* Year Month Day */ -/* Month Day Year */ -/* Year Day Month */ - -/* where Month is the name of a month, not its numeric */ -/* value. */ - -/* When integer components are separated by slashes (/) */ -/* as in 3/4/5. Month, Day, Year is assumed (2005 March 4) */ - -/* Day of Year Format. */ - -/* If a day of year marker (// or ::) is present, the */ -/* pattern I-I// or I-I:: (where I stands for an integer) */ -/* is interpreted as Year Day-of-Year. However, I-I/ is */ -/* regarded as ambiguous. */ - - -/* $ Examples */ - -/* Below is a sampling of some of the time formats that are */ -/* acceptable as inputs to STR2ET. A complete discussion of */ -/* permissible formats is given in the SPICE routine TPARTV as well */ -/* as the reference document time.req located in the "doc" */ -/* directory of the Toolkit. */ - -/* ISO (T) Formats. */ - -/* String Year Mon DOY DOM HR Min Sec */ -/* ---------------------------- ---- --- --- --- -- --- ------ */ -/* 1996-12-18T12:28:28 1996 Dec na 18 12 28 28 */ -/* 1986-01-18T12 1986 Jan na 18 12 00 00 */ -/* 1986-01-18T12:19 1986 Jan na 18 12 19 00 */ -/* 1986-01-18T12:19:52.18 1986 Jan na 18 12 19 52.18 */ -/* 1995-08T18:28:12 1995 na 008 na 18 28 12 */ -/* 1995-18T 1995 na 018 na 00 00 00 */ - - -/* Calendar Formats. */ - -/* String Year Mon DOM HR Min Sec */ -/* ---------------------------- ---- --- --- -- --- ------ */ -/* Tue Aug 6 11:10:57 1996 1996 Aug 06 11 10 57 */ -/* 1 DEC 1997 12:28:29.192 1997 Dec 01 12 28 29.192 */ -/* 2/3/1996 17:18:12.002 1996 Feb 03 17 18 12.002 */ -/* Mar 2 12:18:17.287 1993 1993 Mar 02 12 18 17.287 */ -/* 1992 11:18:28 3 Jul 1992 Jul 03 11 18 28 */ -/* June 12, 1989 01:21 1989 Jun 12 01 21 00 */ -/* 1978/3/12 23:28:59.29 1978 Mar 12 23 28 59.29 */ -/* 17JUN1982 18:28:28 1982 Jun 17 18 28 28 */ -/* 13:28:28.128 1992 27 Jun 1992 Jun 27 13 28 28.128 */ -/* 1972 27 jun 12:29 1972 Jun 27 12 29 00 */ -/* '93 Jan 23 12:29:47.289 1993* Jan 23 12 29 47.289 */ -/* 27 Jan 3, 19:12:28.182 2027* Jan 03 19 12 28.182 */ -/* 23 A.D. APR 4, 18:28:29.29 0023** Apr 04 18 28 29.29 */ -/* 18 B.C. Jun 3, 12:29:28.291 -017** Jun 03 12 29 28.291 */ -/* 29 Jun 30 12:29:29.298 2029+ Jun 30 12 29 29.298 */ -/* 29 Jun '30 12:29:29.298 2030* Jun 29 12 29 29.298 */ - -/* Day of Year Formats */ - -/* String Year DOY HR Min Sec */ -/* ---------------------------- ---- --- -- --- ------ */ -/* 1997-162::12:18:28.827 1997 162 12 18 28.827 */ -/* 162-1996/12:28:28.287 1996 162 12 28 28.287 */ -/* 1993-321/12:28:28.287 1993 231 12 28 28.287 */ -/* 1992 183// 12 18 19 1992 183 12 18 19 */ -/* 17:28:01.287 1992-272// 1992 272 17 28 01.287 */ -/* 17:28:01.282 272-1994// 1994 272 17 28 01.282 */ -/* '92-271/ 12:28:30.291 1992* 271 12 28 30.291 */ -/* 92-182/ 18:28:28.281 1992* 182 18 28 28.281 */ -/* 182-92/ 12:29:29.192 0182+ 092 12 29 29.192 */ -/* 182-'92/ 12:28:29.182 1992 182 12 28 29.182 */ - - -/* Julian Date Strings */ - -/* jd 28272.291 Julian Date 28272.291 */ -/* 2451515.2981 (JD) Julian Date 2451515.2981 */ -/* 2451515.2981 JD Julian Date 2451515.2981 */ - -/* Abbreviations Used in Tables */ - -/* na --- Not Applicable */ -/* Mon --- Month */ -/* DOY --- Day of Year */ -/* DOM --- Day of Month */ -/* Wkday --- Weekday */ -/* Hr --- Hour */ -/* Min --- Minutes */ -/* Sec --- Seconds */ - -/* * The default interpretation of a year that has been abbreviated */ -/* with a leading quote as in 'xy (such as '92) is to treat the */ -/* year as 19xy if xy > 68 and to treat it is 20xy otherwise. Thus */ -/* '69 is interpreted as 1969 and '68 is treated as 2068. However, */ -/* you may change the "split point" and centuries through use of */ -/* the SPICE routine TSETYR which is an entry point in the SPICE */ -/* module TEXPYR. See that routine for a discussion of how you may */ -/* reset the split point. */ - -/* ** All epochs are regarded as belonging to the Gregorian */ -/* calendar. We formally extend the Gregorian calendar backward */ -/* and forward in time for all epochs. */ - -/* + When a day of year format or calendar format string is input */ -/* and neither of the integer components of the date is greater */ -/* than 1000, the first integer is regarded as being the year. */ - - -/* Suppose you would like to determine whether your favorite */ -/* time representation is supported by STR2ET. The small */ -/* program below gives you a simple way to experiment with */ -/* STR2ET. (Note that erroneous inputs will be flagged by */ -/* signaling an error.) */ - -/* To run this program you need to: */ - -/* 1. copy it to a file, */ -/* 2. un-comment the obvious lines of code, */ -/* 3. compile it, */ -/* 4. link the resulting object file with SPICELIB, */ -/* 5. and place the leapseconds kernel in your current directory. */ - -/* PROGRAM */ - -/* CHARACTER*(64) STRING */ -/* CHARACTER*(64) CALDR */ -/* CHARACTER*(64) DAYOFY */ -/* CHARACTER*(127) FILNAM */ - -/* DOUBLE PRECISION ET */ - - -/* First get the name of a leapseconds kernel, and load it. */ - -/* CALL PROMPT ( 'Leapseconds kernel: ', FILNAM ) */ -/* CALL FURNSH ( FILNAM ) */ - -/* Leave some space on the screen and get the first trial string. */ -/* If we get a blank input, we quit. */ - -/* WRITE (*,*) */ -/* CALL PROMPT ( 'String to try: ', STRING ) */ - -/* DO WHILE ( STRING .NE. ' ' ) */ - -/* Convert the string to ET and then back to UTC calendar */ -/* and day-of-year formats. */ - -/* CALL STR2ET ( STRING, ET ) */ -/* CALL ET2UTC ( ET, 'C', 0, CALDR ) */ -/* CALL ET2UTC ( ET, 'D', 0, DAYOFY ) */ - -/* Print the results. */ - -/* WRITE (*,*) 'Calendar Format: ', CALDR */ -/* WRITE (*,*) 'Day of year Format: ', DAYOFY */ - -/* Ask for another string and do it all again. */ - -/* WRITE (*,*) */ -/* CALL PROMPT ( 'String to try: ', STRING ) */ - -/* END DO */ -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.1, 02-NOV-2009 (CHA) */ - -/* A few minor grammar errors were fixed in the header. */ -/* The header sections were reordered. */ - -/* - SPICELIB Version 1.3.0, 31-AUG-2006 (NJB) (EDW) */ - -/* Bug fix: routine formerly returned incorrect results */ -/* in some cases on calls following calls for which a time */ -/* zone was specified. */ - -/* Replaced reference to LDPOOL in header Examples section */ -/* with reference to FURNSH. */ - -/* - SPICELIB Version 1.2.2, 29-JUL-2003 (NJB) */ - -/* Various minor header corrections were made */ - -/* - SPICELIB Version 1.2.1, 10-FEB-2003 (NJB) */ - -/* Corrected header typo. */ - -/* - SPICELIB Version 1.2.0, 11-NOV-1997 (WLT) */ - -/* The previous versions of this routine did not correctly */ -/* convert day-of-year strings in the TDB or TDT systems. */ -/* They treated the day of year as year, month, day giving */ -/* spectacularly wrong answers. */ - -/* In addition, comments concerning the default century for */ -/* abbreviated years were updated to reflect changes to TEXPYR */ - -/* - SPICELIB Version 1.1.0, 10-FEB-1997 (WLT) */ - -/* In the case that a time zone could not be parsed, */ -/* this routine signaled an error and checked out without */ -/* then returning. This error has been corrected. */ - -/* - SPICELIB Version 1.0.0, 15-NOV-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Convert a string to TDB seconds past the J2000 epoch */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 31-AUG-2006 (NJB) */ - -/* Bug fix: routine formerly returned incorrect results */ -/* in some cases on calls following calls for which a time */ -/* zone was specified. */ - -/* The problem was caused by the variable ZONED not being */ -/* properly set when a time system was specified */ -/* in the input string. In such cases, ZONED retained the */ -/* value from the previous call. */ - -/* -& */ - -/* SPICELIB Functions. */ - - -/* Local (in-line) Functions */ - - -/* The following integers are pointers to the */ -/* locations of various components in a time vector. */ - - -/* Saved variables */ - - -/* Initial values */ - - if (return_()) { - return 0; - } - chkin_("STR2ET", (ftnlen)6); - -/* Collect the current defaults. */ - - timdef_("GET", "SYSTEM", defsys, (ftnlen)3, (ftnlen)6, (ftnlen)16); - timdef_("GET", "ZONE", defzon, (ftnlen)3, (ftnlen)4, (ftnlen)16); - timdef_("GET", "CALENDAR", calndr, (ftnlen)3, (ftnlen)8, (ftnlen)16); - if (s_cmp(defzon, " ", (ftnlen)16, (ftnlen)1) != 0) { - prefix_("::", &c__0, defzon, (ftnlen)2, (ftnlen)16); - zzutcpm_(defzon, &c__1, &dhoff, &dmoff, &last, &succes, (ftnlen)16); - } else { - dhoff = 0.; - dmoff = 0.; - } - -/* See if TPARTV can recognize what the user has supplied. */ - - tpartv_(string, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes, - pictur, error, string_len, (ftnlen)16, (ftnlen)16, (ftnlen)80, ( - ftnlen)400); - if (! succes) { - setmsg_(error, (ftnlen)400); - sigerr_("SPICE(UNPARSEDTIME)", (ftnlen)19); - chkout_("STR2ET", (ftnlen)6); - return 0; - } - -/* A system and time zone are incompatible components in a */ -/* time string. */ - - if (s_cmp(modify + 32, " ", (ftnlen)16, (ftnlen)1) != 0 && s_cmp(modify + - 64, " ", (ftnlen)16, (ftnlen)1) != 0) { - setmsg_("Both a time system and time zone have been specified in the" - " input string (# and #). These are inconsistent. A time zone" - " is a fixed offset from UTC. ", (ftnlen)148); - errch_("#", modify + 64, (ftnlen)1, (ftnlen)16); - errch_("#", modify + 32, (ftnlen)1, (ftnlen)16); - sigerr_("SPICE(TIMECONFLICT)", (ftnlen)19); - chkout_("STR2ET", (ftnlen)6); - return 0; - } - -/* If both the zone and system are empty, we can replace them */ -/* with the default zone and system values (only one of which */ -/* can be non-blank). */ - - zoned = FALSE_; - if (s_cmp(modify + 32, " ", (ftnlen)16, (ftnlen)1) == 0 && s_cmp(modify + - 64, " ", (ftnlen)16, (ftnlen)1) == 0) { - s_copy(modify + 32, defzon, (ftnlen)16, (ftnlen)16); - s_copy(modify + 64, defsys, (ftnlen)16, (ftnlen)16); - hoff = dhoff; - moff = dmoff; - zoned = s_cmp(modify + 32, " ", (ftnlen)16, (ftnlen)1) != 0; - } else if (s_cmp(modify + 32, " ", (ftnlen)16, (ftnlen)1) != 0) { - -/* Parse the time zone specification. If we don't succeed */ -/* in the parsing, signal an error. */ - - zoned = TRUE_; - prefix_("::", &c__0, modify + 32, (ftnlen)2, (ftnlen)16); - zzutcpm_(modify + 32, &c__1, &hoff, &moff, &last, &succes, (ftnlen)16) - ; - if (! succes) { - setmsg_("# is not a legitimate time zone specification. ", ( - ftnlen)47); - errch_("#", modify + 34, (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(TIMEZONEERROR)", (ftnlen)20); - chkout_("STR2ET", (ftnlen)6); - return 0; - } - } - -/* We handle the julian date case now. It doesn't have the */ -/* complications associated with it that the calendar strings */ -/* have. */ - - if (s_cmp(type__, "JD", (ftnlen)16, (ftnlen)2) == 0) { - if (s_cmp(modify + 64, "UTC", (ftnlen)16, (ftnlen)3) == 0) { - s_copy(type__, "JDUTC", (ftnlen)16, (ftnlen)5); - } else if (s_cmp(modify + 64, "TDB", (ftnlen)16, (ftnlen)3) == 0) { - s_copy(type__, "JDTDB", (ftnlen)16, (ftnlen)5); - } else if (s_cmp(modify + 64, "TDT", (ftnlen)16, (ftnlen)3) == 0) { - s_copy(type__, "JDTDT", (ftnlen)16, (ftnlen)5); - } else { - s_copy(type__, "JDUTC", (ftnlen)16, (ftnlen)5); - } - ttrans_(type__, "TDB", tvec, (ftnlen)16, (ftnlen)3); - *et = tvec[0]; - chkout_("STR2ET", (ftnlen)6); - return 0; - } - -/* Set the indexes of the hours, minutes, seconds, etc. components */ -/* of the time vector. */ - - if (s_cmp(type__, "YD", (ftnlen)16, (ftnlen)2) == 0) { - yr = 1; - dy = 2; - hr = 3; - mn = 4; - sc = 5; - s_copy(forml, "YDF", (ftnlen)16, (ftnlen)3); - } else { - yr = 1; - mm = 2; - dy = 3; - hr = 4; - mn = 5; - sc = 6; - s_copy(forml, "YMDF", (ftnlen)16, (ftnlen)4); - } - -/* Check the components for reasonableness. */ - - tchckd_(check, (ftnlen)16); - tparch_("YES", (ftnlen)3); - -/* If the calendar is NOT gregorian, or if we have a time zone */ -/* present, we avoid the problem of checking for legitimate */ -/* leapseconds (at least we avoid this problem for the moment). */ - - adjust = FALSE_; - if (zoned || s_cmp(calndr, gregrn, (ftnlen)16, (ftnlen)16) != 0) { - if (tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)949)] >= 60. && tvec[(i__2 = sc - 1) - < 8 && 0 <= i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", ( - ftnlen)949)] < 61.) { - adjust = TRUE_; - tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)953)] = tvec[(i__2 = sc - 1) < 8 - && 0 <= i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", ( - ftnlen)953)] - 1.; - } - } - if (s_cmp(calndr, mixed, (ftnlen)16, (ftnlen)16) == 0) { - -/* This is a bit awkward, but here's what's going on. */ -/* If the input calendar is part of the Julian calendar */ -/* it might be Feb 29 on a century such as 1500. These */ -/* are not legitimate dates on the Gregorian calendar. */ -/* But they are ok on the Julian calendar. */ - -/* However, one of the year numbers YEAR or YEAR + 4 will */ -/* be a leap year on both the Julian and Gregorian calendar. */ -/* If we have just a century problem, it will be a problem */ -/* for only one of the years. So in the range where we could */ -/* have a problem we call TCHECK twice and .OR. the results */ -/* of the checks to see if we have a legitimate time vector. */ - - if (tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)976)] < 1580.) { - moved_(tvec, &c__6, tvecm); - tvecm[0] += 4.; - tcheck_(tvecm, type__, &mods, modify, &ok1, error, (ftnlen)16, ( - ftnlen)16, (ftnlen)400); - tcheck_(tvec, type__, &mods, modify, &ok2, error, (ftnlen)16, ( - ftnlen)16, (ftnlen)400); - ok = ok1 || ok2; - } else { - tcheck_(tvec, type__, &mods, modify, &ok, error, (ftnlen)16, ( - ftnlen)16, (ftnlen)400); - } - } else if (s_cmp(calndr, juln, (ftnlen)16, (ftnlen)16) == 0) { - -/* Basically, this is the same story as before, but there */ -/* are no bounds in the years where we might be on a century. */ -/* So we just check twice for each time vector. */ - - moved_(tvec, &c__6, tvecm); - tvecm[0] += 4.; - tcheck_(tvecm, type__, &mods, modify, &ok1, error, (ftnlen)16, ( - ftnlen)16, (ftnlen)400); - tcheck_(tvec, type__, &mods, modify, &ok2, error, (ftnlen)16, (ftnlen) - 16, (ftnlen)400); - ok = ok1 || ok2; - } else { - -/* TCHECK was designed for the Gregorian Calendar, So we */ -/* don't have much to do. */ - - tcheck_(tvec, type__, &mods, modify, &ok, error, (ftnlen)16, (ftnlen) - 16, (ftnlen)400); - } - -/* Reset the checking status. */ - - tparch_(check, (ftnlen)16); - -/* If we didn't get an OK from the inspection above, */ -/* say so and signal an error. */ - - if (! ok) { - setmsg_(error, (ftnlen)400); - sigerr_("SPICE(BADTIMESTRING)", (ftnlen)20); - chkout_("STR2ET", (ftnlen)6); - return 0; - } - -/* Reset TVEC(SC) if it was adjusted earlier. */ - - if (adjust) { - tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1037)] = tvec[(i__2 = sc - 1) < 8 && 0 <= - i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", (ftnlen)1037)] - + 1.; - } - -/* There are no leapseconds in the TDT and TDB time systems */ -/* This means that the seconds component must be less than 60. */ - - if (s_cmp(modify + 64, "TDT", (ftnlen)16, (ftnlen)3) == 0 || s_cmp(modify - + 64, "TDB", (ftnlen)16, (ftnlen)3) == 0) { - if (tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1047)] >= 60.) { - setmsg_("The seconds component of time must be less than 60 for " - "any calendar representation of #. ", (ftnlen)89); - errch_("#", modify + 64, (ftnlen)1, (ftnlen)16); - sigerr_("SPICE(BADTIMESTRING)", (ftnlen)20); - chkout_("STR2ET", (ftnlen)6); - return 0; - } - } - -/* If a B.C. era marker is present we can't have a year abbreviation */ - - if (s_cmp(modify, "B.C.", (ftnlen)16, (ftnlen)4) == 0 && yabbrv) { - setmsg_("The Year may be abbreviated only if the year belongs to the" - " Christian Era (A.D.) ", (ftnlen)81); - sigerr_("SPICE(BADTIMESTRING)", (ftnlen)20); - chkout_("STR2ET", (ftnlen)6); - return 0; - } - -/* If the era is B.C. we need to reset the year. */ - - if (s_cmp(modify, "B.C.", (ftnlen)16, (ftnlen)4) == 0) { - tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1078)] = 1. - tvec[(i__2 = yr - 1) < 8 && - 0 <= i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", (ftnlen) - 1078)]; - } - -/* If there is a A.M. or P.M. time string modifier, we need to adjust */ -/* the hours component of the time. */ - - if (s_cmp(modify + 48, "P.M.", (ftnlen)16, (ftnlen)4) == 0) { - if (tvec[(i__1 = hr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1087)] < 12.) { - tvec[(i__1 = hr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1088)] = tvec[(i__2 = hr - 1) < - 8 && 0 <= i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", ( - ftnlen)1088)] + 12.; - } - } else if (s_cmp(modify + 48, "A.M.", (ftnlen)16, (ftnlen)4) == 0) { - if (tvec[(i__1 = hr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1093)] >= 12.) { - tvec[(i__1 = hr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1094)] = tvec[(i__2 = hr - 1) < - 8 && 0 <= i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", ( - ftnlen)1094)] - 12.; - } - } - -/* If the year has been abbreviated, we need to convert it */ -/* to the proper range. In addition we assume a year less */ -/* than 100 that is not qualified with the B.C. or A.D. era */ -/* string is in fact an abbreviated year. */ - - year = i_dnnt(&tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "tvec", i__1, "str2et_", (ftnlen)1105)]); - if (yabbrv) { - texpyr_(&year); - tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1110)] = (doublereal) year; - } else if (year < 100 && s_cmp(modify, " ", (ftnlen)16, (ftnlen)1) == 0) { - texpyr_(&year); - tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1116)] = (doublereal) year; - } - -/* We may need to convert to the Gregorian Calendar, now is */ -/* the time to do so. */ - - if (s_cmp(calndr, mixed, (ftnlen)16, (ftnlen)16) == 0) { - -/* We need to check the components. */ - - if (s_cmp(type__, "YD", (ftnlen)16, (ftnlen)2) == 0) { - dojul = tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "tvec", i__1, "str2et_", (ftnlen)1131)] < 1582. || tvec[( - i__2 = yr - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("tvec", - i__2, "str2et_", (ftnlen)1131)] == 1582. && tvec[(i__3 = - dy - 1) < 8 && 0 <= i__3 ? i__3 : s_rnge("tvec", i__3, - "str2et_", (ftnlen)1131)] < 279.; - } else { - dojul = tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "tvec", i__1, "str2et_", (ftnlen)1137)] < 1582. || tvec[( - i__2 = yr - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("tvec", - i__2, "str2et_", (ftnlen)1137)] <= 1582. && tvec[(i__3 = - mm - 1) < 8 && 0 <= i__3 ? i__3 : s_rnge("tvec", i__3, - "str2et_", (ftnlen)1137)] < 10. || tvec[(i__4 = yr - 1) < - 8 && 0 <= i__4 ? i__4 : s_rnge("tvec", i__4, "str2et_", ( - ftnlen)1137)] <= 1582. && tvec[(i__5 = mm - 1) < 8 && 0 <= - i__5 ? i__5 : s_rnge("tvec", i__5, "str2et_", (ftnlen) - 1137)] <= 10. && tvec[(i__6 = dy - 1) < 8 && 0 <= i__6 ? - i__6 : s_rnge("tvec", i__6, "str2et_", (ftnlen)1137)] < - 6.; - } - } else if (s_cmp(calndr, juln, (ftnlen)16, (ftnlen)16) == 0) { - dojul = TRUE_; - } else { - dojul = FALSE_; - } - -/* If the input string is from the julian calendar, we need */ -/* to convert it to Gregorian. We also need to save the original */ -/* year value in the unlikely event it is needed for a later */ -/* diagnostic message. */ - - if (dojul) { - if (s_cmp(type__, "YD", (ftnlen)16, (ftnlen)2) == 0) { - year = (integer) d_int(&tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("tvec", i__1, "str2et_", (ftnlen)1165)]); - month = 1; - day = (integer) d_int(&tvec[(i__1 = dy - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("tvec", i__1, "str2et_", (ftnlen)1167)]); - frac = tvec[(i__1 = dy - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "tvec", i__1, "str2et_", (ftnlen)1168)] - (doublereal) - day; - orgnyr = year; - jul2gr_(&year, &month, &day, &doy); - tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1173)] = (doublereal) year; - tvec[(i__1 = dy - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1174)] = (doublereal) doy + frac; - } else { - year = (integer) d_int(&tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("tvec", i__1, "str2et_", (ftnlen)1178)]); - month = (integer) d_int(&tvec[(i__1 = mm - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("tvec", i__1, "str2et_", (ftnlen)1179)]); - day = (integer) d_int(&tvec[(i__1 = dy - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("tvec", i__1, "str2et_", (ftnlen)1180)]); - frac = tvec[(i__1 = dy - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "tvec", i__1, "str2et_", (ftnlen)1181)] - (doublereal) - day; - orgnyr = year; - jul2gr_(&year, &month, &day, &doy); - tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1186)] = (doublereal) year; - tvec[(i__1 = mm - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1187)] = (doublereal) month; - tvec[(i__1 = dy - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1188)] = (doublereal) day + frac; - } - } else { - orgnyr = (integer) d_int(&tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("tvec", i__1, "str2et_", (ftnlen)1194)]); - } - -/* The TDT and TDB calendars don't need to worry about time */ -/* zone adjustments. */ - - if (s_cmp(modify + 64, "TDT", (ftnlen)16, (ftnlen)3) == 0) { - ttrans_(forml, "FORMAL", tvec, (ftnlen)16, (ftnlen)6); - ttrans_("TDT", "TDB", tvec, (ftnlen)3, (ftnlen)3); - *et = tvec[0]; - chkout_("STR2ET", (ftnlen)6); - return 0; - } else if (s_cmp(modify + 64, "TDB", (ftnlen)16, (ftnlen)3) == 0) { - ttrans_(forml, "FORMAL", tvec, (ftnlen)16, (ftnlen)6); - *et = tvec[0]; - chkout_("STR2ET", (ftnlen)6); - return 0; - } - -/* If a time zone has been specified, we need to convert */ -/* from the time zone components to UTC components. */ - - if (zoned) { - -/* A time zone was specified explicitly in the input */ -/* string. We need to compute the hour and minute offsets */ -/* associated with the time zone. */ - - tvec[(i__1 = hr - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1230)] = tvec[(i__2 = hr - 1) < 8 && 0 <= - i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", (ftnlen)1230)] - - hoff; - tvec[(i__1 = mn - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1231)] = tvec[(i__2 = mn - 1) < 8 && 0 <= - i__2 ? i__2 : s_rnge("tvec", i__2, "str2et_", (ftnlen)1231)] - - moff; - secs = tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", - i__1, "str2et_", (ftnlen)1232)]; - tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1233)] = 0.; - ttrans_(forml, forml, tvec, (ftnlen)16, (ftnlen)16); - tvec[(i__1 = sc - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("tvec", i__1, - "str2et_", (ftnlen)1237)] = secs; - } - -/* If we decided to forgo the leapseconds check earlier */ -/* now is the time to do it. We've now got Gregorian UTC */ -/* time components. */ - - if (adjust) { - tchckd_(check, (ftnlen)16); - tparch_("YES", (ftnlen)3); - mods = FALSE_; - s_copy(modify + 48, " ", (ftnlen)16, (ftnlen)1); - tcheck_(tvec, type__, &mods, modify, &ok, error, (ftnlen)16, (ftnlen) - 16, (ftnlen)400); - } else { - ok = TRUE_; - } - if (ok) { - -/* That's it we are ready to rumble. */ - - ttrans_(type__, "TDB", tvec, (ftnlen)16, (ftnlen)3); - *et = tvec[0]; - chkout_("STR2ET", (ftnlen)6); - return 0; - } -/* =============================================================== */ -/* If you are still here, it is because OK was .FALSE. in the test */ -/* above. The only way this can happen is if the seconds were */ -/* not in the expected range. The rest of the code is a diagnosis */ -/* of this problem. (This is a nuisance case that is */ -/* unlikely to occur very often.) */ - - if (zoned && dojul) { - s_copy(error, "The seconds component of '#' is out of range. On the " - "Julian Calendar in the specified time zone (#) leapseconds " - "can occur during the year # only in the second that immediat" - "ely follows the time #:#:59 on # # and # #. ", (ftnlen)400, ( - ftnlen)218); - repmc_(error, "#", string, error, (ftnlen)400, (ftnlen)1, string_len, - (ftnlen)400); - repmc_(error, "#", modify + 34, error, (ftnlen)400, (ftnlen)1, ( - ftnlen)14, (ftnlen)400); - } else if (zoned) { - -/* If we had a time zone, we want to say what time zone */ -/* in the output string. */ - - s_copy(error, "The seconds component of '#' is out of range. In the " - "specified time zone (#) leapseconds can occur during the ye" - "ar # only in the second that immediately follows the time #:" - "#:59 on # # and # #.", (ftnlen)400, (ftnlen)194); - repmc_(error, "#", string, error, (ftnlen)400, (ftnlen)1, string_len, - (ftnlen)400); - repmc_(error, "#", modify + 34, error, (ftnlen)400, (ftnlen)1, ( - ftnlen)14, (ftnlen)400); - } else { - -/* No time zone, this case can only occur if we interpreted */ -/* the input string as a date on the Julian Calendar */ - - s_copy(error, "The seconds component of '#' is out of range. Leapsec" - "onds can occur during the year # of the Julian calendar only" - " in the second that immediately follows the time #:#:59 on " - "# # and # #.' ", (ftnlen)400, (ftnlen)187); - repmc_(error, "#", string, error, (ftnlen)400, (ftnlen)1, string_len, - (ftnlen)400); - } - -/* First fill in the year portion of the error message. */ - - repmi_(error, "#", &orgnyr, error, (ftnlen)400, (ftnlen)1, (ftnlen)400); - mon[0] = 6.; - mon[1] = 12.; - mdy[0] = 30.; - mdy[1] = 31.; - -/* Next Fill in the hours and minutes. Recall that leapseconds */ -/* occur during the last second of the 59'th minute of the 23'rd */ -/* hour UTC. So in the new time zone, it occurs in the 59'th + MOFF */ -/* minute of the 23'rd + HOFF hour of the time zone. We adjust */ -/* these to account for hour roll over and day roll over. */ - - minute = moff + 59.; - if (minute > 59.) { - minute += -60.; - extra = 1.; - } else if (minute < 0.) { - minute += 60.; - extra = -1.; - } else { - extra = 0.; - } - hour = hoff + 23. + extra; - if (hour > 23.) { - hour += -24; - } - -/* Convert the hours and minutes to strings and place the */ -/* strings in the message. */ - - dpfmt_(&hour, "0x", hstr, (ftnlen)2, (ftnlen)2); - dpfmt_(&minute, "0x", mstr, (ftnlen)2, (ftnlen)2); - repmc_(error, "#", hstr, error, (ftnlen)400, (ftnlen)1, (ftnlen)2, ( - ftnlen)400); - repmc_(error, "#", mstr, error, (ftnlen)400, (ftnlen)1, (ftnlen)2, ( - ftnlen)400); - -/* Last step we generate the month and day corresponding */ -/* to Dec 31, 23:59, and Jun 30, 23:59. We only want the */ -/* dates that belong to the original year. We could */ -/* probably figure out the right year to use, but with Julian */ -/* date possibly messing everything up, we just use the */ -/* current year and the one before. If you keep in mind that */ -/* the Julian Year is always less than the Gregorian year and */ -/* that the offsets can only push you into the next year, you */ -/* can determine that we want to start with what ever current */ -/* UTC year we have and work backwards until we have the */ -/* year corresponding to the original year. Since the current */ -/* UTC year was constructed from the input original year, we */ -/* only have to step back at most 1 year to get all the dates */ -/* that might have leapseconds in the user specified year */ -/* of whatever calendar happens to be in use. */ - - cyear = (integer) d_int(&tvec[(i__1 = yr - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("tvec", i__1, "str2et_", (ftnlen)1387)]); - i__1 = cyear - 1; - for (gyear = cyear; gyear >= i__1; --gyear) { - for (i__ = 1; i__ <= 2; ++i__) { - tvec[0] = (doublereal) gyear; - tvec[1] = mon[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge( - "mon", i__2, "str2et_", (ftnlen)1394)]; - tvec[2] = mdy[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge( - "mdy", i__2, "str2et_", (ftnlen)1395)]; - tvec[3] = hoff + 23.; - tvec[4] = moff + 59.; - tvec[5] = 0.; - -/* Normalize the time vector. */ - - ttrans_("YMDF", "YMDF", tvec, (ftnlen)4, (ftnlen)4); - year = i_dnnt(tvec); - month = i_dnnt(&tvec[1]); - day = i_dnnt(&tvec[2]); - if (dojul) { - gr2jul_(&year, &month, &day, &doy); - } - if (year == orgnyr) { - repmc_(error, "#", mname + (((i__2 = month - 1) < 12 && 0 <= - i__2 ? i__2 : s_rnge("mname", i__2, "str2et_", ( - ftnlen)1415)) << 4), error, (ftnlen)400, (ftnlen)1, ( - ftnlen)16, (ftnlen)400); - repmi_(error, "#", &day, error, (ftnlen)400, (ftnlen)1, ( - ftnlen)400); - } - } - } - setmsg_(error, (ftnlen)400); - sigerr_("SPICE(BADTIMESTRING)", (ftnlen)20); - chkout_("STR2ET", (ftnlen)6); - return 0; -} /* str2et_ */ - diff --git a/ext/spice/src/cspice/str2et_c.c b/ext/spice/src/cspice/str2et_c.c deleted file mode 100644 index a2bcde2f16..0000000000 --- a/ext/spice/src/cspice/str2et_c.c +++ /dev/null @@ -1,643 +0,0 @@ -/* - --Procedure str2et_c ( String to ET ) - --Abstract - - Convert a string representing an epoch to a double precision - value representing the number of TDB seconds past the J2000 - epoch corresponding to the input epoch. - --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 - - TIME - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void str2et_c ( ConstSpiceChar * str, - SpiceDouble * et ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - str I A string representing an epoch. - et O The equivalent value in seconds past J2000, TDB. - --Detailed_Input - - str is a string representing an epoch. Virtually all common - calendar representations are allowed. You may specify a - time string belonging to any of the systems TDB, TDT, - UTC. Moreover, you may specify a time string relative to - a specific UTC based time zone. - - The rules used in the parsing of `str' are spelled out in - great detail in the CSPICE routine tpartv_. The basics - are given in the Particulars section below. - --Detailed_Output - - et is the double precision number of TDB seconds past the - J2000 epoch that corresponds to the input `str'. - --Parameters - - None. - --Exceptions - - 1) The error SPICE(UNPARSEDTIME) is signaled if the - string cannot be recognized as a legitimate time string. - - 2) The error SPICE(TIMECONFLICT) is signaled if more than - one time system is specified as part of the time string. - - 3) The error SPICE(BADTIMESTRING) is signaled if any component - of the time string is outside the normal range of usage. - For example, the day January 35 is outside the normal range - of days in January. The checks applied are spelled out in - the routine tcheck_. - - 4) The error SPICE(EMPTYSTRING) is signaled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 5) The error SPICE(NULLPOINTER) is signaled if the input string - pointer is null. - --Files - - None. - --Particulars - - This routine computes the ephemeris epoch corresponding to an input - string. The ephemeris epoch is represented as seconds past the - J2000 epoch in the time system known as Barycentric Dynamical Time - (TDB). This time system is also referred to as Ephemeris Time (ET) - throughout the SPICE Toolkit. - - The variety of ways people have developed for representing times is - enormous. It is unlikely that any single subroutine can accommodate - the wide variety of custom time formats that have arisen in various - computing contexts. However, we believe that this routine will - correctly interpret most time formats used throughout the planetary - science community. For example this routine supports ISO time - formats and UNIX `date` output formats. One obvious omission from - the strings recognized by this routine are strings of the form - - 93234.1829 or 1993234.1829 - - Some readers may recognize this as the epoch that is 0.1829 - days past the beginning of the 234'th day of 1993. However, - many other readers may regard this interpretation as a bit - obscure. - - Below we outline some of the rules used in the interpretation - of strings. A more complete discussion of the interpretation - of strings is given in the routine tpartv_. - - - Default Behavior - ---------------- - - Consider the string - - 1988 June 13, 3:29:48 - - There is nothing in this string to indicate what time system - the date and time belong to. Moreover, there is nothing to - indicate whether the time is based on a 24-hour clock or - twelve hour clock. - - In the absence of such indicators, the default interpretation - of this string is to regard the time of day to be a time on - a 24-hour clock in the UTC time system. The date is a date - on the Gregorian Calendar (this is the calendar used in nearly - all western societies). - - Labels - ------ - - If you add more information to the string, str2et_c can - make a more informed interpretation of the time string. - For example: - - 1988 June 13, 3:29:48 P.M. - - is still regarded as a UTC epoch. However, with the addition - of the "P.M." label it is now interpreted as the same epoch - as the unlabeled epoch 1988 June 13, 15:29:48. Similarly - - 1988 June 13, 12:29:48 A.M. - - is interpreted as - - 1988 June 13, 00:29:48 - - For the record: 12:00 A.M. corresponds to Midnight (00:00 on the - 24 hour clock. 12:00 P.M. corresponds to Noon. (12:00) on the - 24 hour clock. - - You may add still further indicators to the string. For example - - 1988 June 13, 3:29:48 P.M. PST - - is interpreted as an epoch in the Pacific Standard Time system. - This is equivalent to - - 1988 June 13, 07:29:48 UTC - - The following U.S. time zones are recognized. - - EST --- Eastern Standard Time ( UTC-5:00 ) - CST --- Central Standard Time ( UTC-6:00 ) - MST --- Mountain Standard Time ( UTC-7:00 ) - PST --- Pacific Standard Time ( UTC-8:00 ) - - EDT --- Eastern Daylight Time ( UTC-4:00 ) - CDT --- Central Daylight Time ( UTC-5:00 ) - MDT --- Mountain Daylight Time ( UTC-6:00 ) - PDT --- Pacific Daylight Time ( UTC-7:00 ) - - In addition any other time zone may be specified by representing its - offset from UTC. This notation starts with the letters "UTC" - followed by a "+" for time zones east of Greenwich and "-" for time - zones west of Greenwich. This is followed by the number of hours to - add or subtract from UTC. This is optionally followed by a colon - ":" and the number of minutes to add or subtract to get the local - time zone. Thus to specify the time zone of Calcutta (which is 5 - and 1/2 hours ahead of UTC) you would specify the time zone to be - UTC+5:30. To specify the time zone of Newfoundland (which is 3 and - 1/2 hours behind UTC) use the offset notation UTC-3:30. - - For the Record: Leapseconds occur at the same time in all - time zones. In other words, the seconds component of a time - string is the same for any time zone as is the seconds - component of UTC. Thus the following are all legitimate - ways to represent an epoch of some event that occurred - in the leapsecond - - 1995 December 31 23:59:60.5 (UTC) - 1996 January 1, 05:29:60.5 (UTC+5:30 --- Calcutta Time) - 1995 December 31, 20:29:60.5 (UTC-3:30 --- Newfoundland) - 1995 December 31 18:59:60.5 (EST) - 1995 December 31 17:59:60.5 (CST) - 1995 December 31 16:59:60.5 (MST) - 1995 December 31 15:59:60.5 (PST) - - - In addition to specifying time zones, you may specify that the - string be interpreted as a formal calendar representation in either - the Barycentric Dynamical Time system (TDB) or the Terrestrial - Dynamical Time system (TDT). In These systems there are no - leapseconds. Times in TDB are written as - - 1988 June 13, 12:29:48 TDB - - TDT times are written as: - - 1988 June 13, 12:29:48 TDT - - Finally, you may explicitly state that the time system is UTC - - 1988 June 13, 12:29:48 UTC. - - - Abbreviating Years - ------------------ - - Although it can lead to confusion, many people are in the - habit of abbreviating years when they write them in dates. - For example - - 99 Jan 13, 12:28:24 - - Upon seeing such a string, most of us would regard this - as being 1999 January 13, 12:28:24 and not January 13 of - the year 99. This routine interprets years that are less - than 100 as belonging either to the 1900's or 2000's. Years - greater than 49 ( 50 - 99 ) are regarded as being an - abbreviation with the '19' suppressed (1950 - 1999). Years - smaller than 50 ( 00 - 49 ) are regarded as being an - abbreviation with the '20' suppressed (2000 - 2049). - - Note that in general it is usually a good idea to write - out the year. Or if you'd like to save some typing - abbreviate 1999 as '99. - - If you need to specify an epoch whose year - is less than 1000, we recommend that you specify the era - along with the year. For example if you want to specify - the year 13 A.D. write it as - - 13 A.D. Jan 12 - - When specifying the era it should immediately follow the year. - Both the A.D. and B.C. eras are supported. - - - Changing Default Behavior - ------------------------- - - As discussed above, if a string is unlabeled, it is regarded - as representing a string in the UTC time system on the - Gregorian calendar. In addition abbreviated years are - regarded as abbreviations of the years from 1950 to 2049. - - You may modify these defaults through the routines timdef_c_ - and tsetyr_c. - - You may: - - Set the calendar to be Gregorian, Julian or a mixture of - two via the timdef_c; - - Set the time system to be UTC, TDB, TDT or any time zone - via the routine timdef_c; - - Set the range of year abbreviations to be any 100 year - interval via the routine tsetyr_c. - - See the routines texpyr_ and timdef_c for details on changing - defaults. - - These alterations affect only the interpretation of unlabeled - strings. If an input string is labeled the specification - in the label is used. - - If any component of a date or time is out of range, str2et_c - regards the string as erroneous. Below is a list of - erroneous strings and why they are regarded as such. - - 1997 Jan 32 12:29:29 --- there are only 31 days in January - - - '98 Jan 12 13:29:29 A.M. --- Hours must be between 1 and 12 - inclusive when A.M. or P.M. is - specified. - - 1997 Feb 29, 12:29:20.0 --- February has only 29 days in - 1997. This would be ok if the - year was 1996. - - - 1992 Mar 12 12:62:20 --- Minutes must be between 0 and 59 - inclusive. - - 1993 Mar 18 15:29:60.5 --- Seconds is out of range for this - date. It would not be out of - range for Dec 31 23:59:60.5 or - Jun 30 23:59:60.5 because these - can be leapseconds (UTC). - - Specifics On Interpretation of the Input String - ----------------------------------------------- - - The process of examining the string to determine its meaning is - called "parsing" the string. The string is parsed by first - determining its recognizable substrings (integers, punctuation - marks, names of months, names of weekdays, time systems, time zones, - etc.) These recognizable substrings are called the tokens of the - input string. The meaning of some tokens are immediately - determined. For example named months, weekdays, time systems have - clear meanings. However, the meanings of numeric components must be - deciphered from their magnitudes and location in the string relative - to the immediately recognized components of the input string. - - To determine the meaning of the numeric tokens in the input string, - a set of "production rules" and transformations are applied to the - full set of tokens in the string. These transformations are - repeated until the meaning of every token has been determined, or - until further transformations yield no new clues into the meaning of - the numeric tokens. - - 1) Unless the substring "JD" or "jd" is present, the string is - assumed to be a calendar format (day-month-year or year and - day of year). If the substring JD or jd is present, the - string is assumed to represent a Julian date. - - 2) If the Julian date specifier is not present, any integer - greater than 999 is regarded as being a year specification. - - 3) A dash "-" can represent a minus sign only if it precedes - the first digit in the string and the string contains - the Julian date specifier (JD). (No negative years, - months, days, etc. are allowed). - - 4) Numeric components of a time string must be separated - by a character that is not a digit or decimal point. - Only one decimal component is allowed. For example - 1994219.12819 is sometimes interpreted as the - 219th day of 1994 + 0.12819 days. str2et_c does not - support such strings. - - No exponential components are allowed. For example you - can't specify the Julian date of J2000 as 2.451545E6. - - 5) The single colon (:) when used to separate numeric - components of a string is interpreted as separating - Hours, Minutes, and Seconds of time. - - 6) If a double slash (//) or double colon (::) follows - a pair of integers, those integers are assumed to - represent the year and day of year. - - 7) A quote followed by an integer less than 100 is regarded - as an abbreviated year. For example: '93 would be regarded - as the 93rd year of the reference century. See texpyr_ - for further discussion of abbreviated years. - - 8) An integer followed" by "B.C." or "A.D." is regarded as - a year in the era associated with that abbreviation. - - 9) All dates are regarded as belonging to the extended - Gregorian Calendar (the Gregorian calendar is the calendar - currently used by western society). See the routine timedef_ - to modify this behavior. - - 10) If the ISO date-time separator (T) is present in the string - ISO allowed token patterns are examined for a match - with the current token list. If no match is found the - search is abandoned and appropriate diagnostic messages - are generated. - - 11) If two delimiters are found in succession in the time - string, the time string is diagnosed as an erroneous - string. (Delimiters are comma, white space, dash, slash, - period, or day of year mark. The day of year mark is a pair - of forward slashes or a pair of colons.) - - Note the delimiters do not have to be the same. The pair - of characters ",-" counts as two successive delimiters. - - 12) White space and commas serve only to delimit tokens in the - input string. They do not affect the meaning of any - of the tokens. - - 13) If an integer is greater than 1000 (and the "JD" label - is not present, the integer is regarded as a year. - - 14) When the size of the integer components does not clearly - specify a year the following patterns are assumed - - Calendar Format - - Year Month Day - Month Day Year - Year Day Month - - where Month is the name of a month, not its numeric - value. - - When integer components are separated by slashes (/) - as in 3/4/5. Month, Day, Year is assumed (2005 March 4) - - - Day of Year Format - - If a day of year marker (// or ::) is present, the - pattern I-I// or I-I:: (where I stands for an integer) - is interpreted as Year Day-of-Year. However, I-I/ is - regarded as ambiguous. - --Examples - - - Below is a sampling of some of the time formats that are acceptable - as inputs to str2et_c. A complete discussion of permissible formats - is given in the CSPICE routine tpartv_ as well as the reference - document time.req located in the "doc" directory of the Toolkit. - - ISO (T) Formats. - - String Year Mon DOY DOM HR Min Sec - ---------------------------- ---- --- --- --- -- --- ------ - 1996-12-18T12:28:28 1996 Dec na 18 12 28 28 - 1986-01-18T12 1986 Jan na 18 12 00 00 - 1986-01-18T12:19 1986 Jan na 18 12 19 00 - 1986-01-18T12:19:52.18 1986 Jan na 18 12 19 52.18 - 1995-08T18:28:12 1995 na 008 na 18 28 12 - 1995-18T 1995 na 018 na 00 00 00 - - - Calendar Formats. - - String Year Mon DOM HR Min Sec - ---------------------------- ---- --- --- -- --- ------ - Tue Aug 6 11:10:57 1996 1996 Aug 06 11 10 57 - 1 DEC 1997 12:28:29.192 1997 Dec 01 12 28 29.192 - 2/3/1996 17:18:12.002 1996 Feb 03 17 18 12.002 - Mar 2 12:18:17.287 1993 1993 Mar 02 12 18 17.287 - 1992 11:18:28 3 Jul 1992 Jul 03 11 18 28 - June 12, 1989 01:21 1989 Jun 12 01 21 00 - 1978/3/12 23:28:59.29 1978 Mar 12 23 28 59.29 - 17JUN1982 18:28:28 1982 Jun 17 18 28 28 - 13:28:28.128 1992 27 Jun 1992 Jun 27 13 28 28.128 - 1972 27 jun 12:29 1972 Jun 27 12 29 00 - '93 Jan 23 12:29:47.289 1993* Jan 23 12 29 47.289 - 27 Jan 3, 19:12:28.182 2027* Jan 03 19 12 28.182 - 23 A.D. APR 4, 18:28:29.29 0023** Apr 04 18 28 29.29 - 18 B.C. Jun 3, 12:29:28.291 -017** Jun 03 12 29 28.291 - 29 Jun 30 12:29:29.298 2029+ Jun 30 12 29 29.298 - 29 Jun '30 12:29:29.298 2030* Jun 29 12 29 29.298 - - Day of Year Formats - - String Year DOY HR Min Sec - ---------------------------- ---- --- -- --- ------ - 1997-162::12:18:28.827 1997 162 12 18 28.827 - 162-1996/12:28:28.287 1996 162 12 28 28.287 - 1993-321/12:28:28.287 1993 231 12 28 28.287 - 1992 183// 12 18 19 1992 183 12 18 19 - 17:28:01.287 1992-272// 1992 272 17 28 01.287 - 17:28:01.282 272-1994// 1994 272 17 28 01.282 - '92-271/ 12:28:30.291 1992* 271 12 28 30.291 - 92-182/ 18:28:28.281 1992* 182 18 28 28.281 - 182-92/ 12:29:29.192 0182+ 092 12 29 29.192 - 182-'92/ 12:28:29.182 1992 182 12 28 29.182 - - - Julian Date Strings - - jd 28272.291 Julian Date 28272.291 - 2451515.2981 (JD) Julian Date 2451515.2981 - 2451515.2981 JD Julian Date 2451515.2981 - - Abbreviations Used in Tables - - na --- Not Applicable - Mon --- Month - DOY --- Day of Year - DOM --- Day of Month - Wkday --- Weekday - Hr --- Hour - Min --- Minutes - Sec --- Seconds - - * The default interpretation of a year that has been abbreviated - with a leading quote as in 'xy (such as '92) is to treat the year as - 19xy if xy > 68 and to treat it is 20xy otherwise. Thus '69 is - interpreted as 1969 and '68 is treated as 2068. However, you may - change the "split point" and centuries through use of the CSPICE - routine tsetyr_c. See that routine for a discussion of how you may - reset the split point. - - ** All epochs are regarded as belonging to the Gregorian calendar. - We formally extend the Gregorian calendar backward and forward in - time for all epochs. - - + When a day of year format or calendar format string is input and - neither of the integer components of the date is greater than 1000, - the first integer is regarded as being the year. - - - Suppose you would like to determine whether your favorite time - representation is supported by str2et_c. The small program below - gives you a simple way to experiment with str2et_c. (Note that - erroneous inputs will be flagged by signaling an error.) - - To build and run this program you need to: - - 1. copy it to a file, - 2. un-comment the obvious lines of code, - and replace the default string with your test string - 3. compile it, - 4. link the resulting object file with CSPICE, - 5. and place the leapseconds kernel in your current directory. - - #include - - #include "SpiceUsr.h" - - char *date = "Thu Mar 20 12:53:29 PST 1997"; - char *leap = "naif0007.tls"; - - main () - { - - furnsh_c ( leap ); - str2et_c ( date, &et ); - - printf ( "%f\n", et ); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.5, 02-NOV-2009 (CHA) - - A few minor grammar fixes in the header. - - -CSPICE Version 1.1.4, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.1.3, 12-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.1.2, 29-JUL-2003 (CHA) (NJB) - - Various minor header corrections were made. - - -CSPICE Version 1.1.1, 10-FEB-2002 (NJB) - - Corrected typo in header. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Exceptions section of header was updated. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - Convert a string to TDB seconds past the J2000 epoch - --& -*/ - -{ /* Begin str2et_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "str2et_c" ); - - - /* - Check the input string str to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "str2et_c", str ); - - - /* - Call the f2c'd Fortran routine. - */ - str2et_ ( ( char * ) str, - ( doublereal * ) et, - ( ftnlen ) strlen(str) ); - - - chkout_c ( "str2et_c" ); - - -}/* End str2et_c */ diff --git a/ext/spice/src/cspice/subpnt.c b/ext/spice/src/cspice/subpnt.c deleted file mode 100644 index 72614244a5..0000000000 --- a/ext/spice/src/cspice/subpnt.c +++ /dev/null @@ -1,1881 +0,0 @@ -/* subpnt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__2 = 2; -static integer c__3 = 3; - -/* $Procedure SUBPNT ( Sub-observer point ) */ -/* Subroutine */ int subpnt_(char *method, char *target, doublereal *et, char - *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal * - trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, - ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* Initialized data */ - - static logical elipsd = TRUE_; - static logical first = TRUE_; - static logical near__ = TRUE_; - static char prvcor[5] = " "; - static char prvmth[80] = "Ellipsoid, near point " - " "; - - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nitr; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer type__; - static logical xmit; - doublereal tpos[3]; - extern /* Subroutine */ int mtxv_(doublereal *, doublereal *, doublereal * - ); - doublereal j2pos[3]; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal s, radii[3], range; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical usecn; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal vtemp[3], xform[9] /* was [3][3] */; - static logical uselt; - char words[32*2]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - doublereal corvj2[3], subvj2[3]; - extern logical failed_(void); - integer refcde; - doublereal lt, etdiff; - integer obscde; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer nw, nradii; - doublereal ltdiff; - extern doublereal clight_(void); - integer trgcde; - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *); - integer center; - extern doublereal touchd_(doublereal *); - char locmth[80]; - doublereal subvec[3], stloff[3]; - integer typeid; - logical attblk[15]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal corpos[3], obspos[3], prevet; - extern logical return_(void); - doublereal prevlt, ssbost[6], ssbtst[6]; - static logical usestl; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *, - integer *, integer *, integer *, logical *), errint_(char *, - integer *, ftnlen), cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), lparse_(char *, char *, integer *, - integer *, char *, ftnlen, ftnlen, ftnlen), spkezp_(integer *, - doublereal *, char *, char *, integer *, doublereal *, doublereal - *, ftnlen, ftnlen), vminus_(doublereal *, doublereal *), nearpt_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *), surfpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, logical *) - , spkssb_(integer *, doublereal *, char *, doublereal *, ftnlen), - pxform_(char *, char *, doublereal *, doublereal *, ftnlen, - ftnlen), stlabx_(doublereal *, doublereal *, doublereal *); - logical fnd; - doublereal alt; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Compute the rectangular coordinates of the sub-observer point on */ -/* a target body at a specified epoch, optionally corrected for */ -/* light time and stellar aberration. */ - -/* This routine supersedes SUBPT. */ - -/* $ 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 */ - -/* FRAMES */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* FIXREF I Body-fixed, body-centered target body frame. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* SPOINT O Sub-observer point on the target body. */ -/* TRGEPC O Sub-observer point epoch. */ -/* SRFVEC O Vector from observer to sub-observer point. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. */ - -/* The supported values of METHOD are listed below. */ -/* Please note that the colon is a required delimiter; */ -/* using a blank will not work. */ - -/* 'Near point: ellipsoid' The sub-observer point */ -/* computation uses a */ -/* triaxial ellipsoid to */ -/* model the surface of the */ -/* target body. The */ -/* sub-observer point is */ -/* defined as the nearest */ -/* point on the target */ -/* relative to the */ -/* observer. */ - -/* 'Intercept: ellipsoid' The sub-observer point */ -/* computation uses a */ -/* triaxial ellipsoid to */ -/* model the surface of the */ -/* target body. The */ -/* sub-observer point is */ -/* defined as the target */ -/* surface intercept of the */ -/* line containing the */ -/* observer and the */ -/* target's center. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string */ - -/* ' nearpoint:ELLIPSOID ' */ - -/* is valid. */ - - -/* TARGET is the name of the target body. The target body is */ -/* an ephemeris object (its trajectory is given by */ -/* SPK data), and is an extended object. */ - -/* The string TARGET is case-insensitive, and leading */ -/* and trailing blanks in TARGET are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'MOON' and '301' are legitimate strings that indicate */ -/* the Moon is the target body. */ - -/* When the target body's surface is represented by a */ -/* tri-axial ellipsoid, this routine assumes that a */ -/* kernel variable representing the ellipsoid's radii is */ -/* present in the kernel pool. Normally the kernel */ -/* variable would be defined by loading a PCK file. */ - - -/* ET is the epoch of participation of the observer, */ -/* expressed as ephemeris seconds past J2000 TDB: ET is */ -/* the epoch at which the observer's state is computed. */ - -/* When aberration corrections are not used, ET is also */ -/* the epoch at which the position and orientation of */ -/* the target body are computed. */ - -/* When aberration corrections are used, the position */ -/* and orientation of the target body are computed at */ -/* ET-LT or ET+LT, where LT is the one-way light time */ -/* between the sub-observer point and the observer, and */ -/* the sign applied to LT depends on the selected */ -/* correction. See the description of ABCORR below for */ -/* details. */ - - -/* FIXREF is the name of the body-fixed, body-centered */ -/* reference frame associated with the target body. */ -/* The output sub-observer point SPOINT will be */ -/* expressed relative to this reference frame. */ -/* The string FIXREF is case-insensitive, and leading */ -/* and trailing blanks in FIXREF are not significant. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the target's position and orientation. */ - -/* For remote sensing applications, where the apparent */ -/* sub-observer point seen by the observer is desired, */ -/* normally either of the corrections */ - -/* 'LT+S' */ -/* 'CN+S' */ - -/* should be used. These and the other supported options */ -/* are described below. ABCORR may be any of the */ -/* following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric sub-observer point on the */ -/* target body. */ - -/* Let LT represent the one-way light time between the */ -/* observer and the sub-observer point (note: NOT */ -/* between the observer and the target body's center). */ -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* sub-observer point's location at the light-time */ -/* corrected epoch ET-LT and *arrive* at the observer's */ -/* location at ET: */ - - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the location of sub-observer */ -/* point at the moment it emitted photons */ -/* arriving at the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* Both the target position as seen by the */ -/* observer, and rotation of the target */ -/* body, are corrected for light time. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* sub-observer point obtained with the */ -/* 'LT' option to account for the */ -/* observer's velocity relative to the */ -/* solar system barycenter. These */ -/* corrections yield the apparent */ -/* sub-observer point. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges. Both the */ -/* position and rotation of the target */ -/* body are corrected for light time. */ - -/* 'CN+S' Converged Newtonian light time and */ -/* stellar aberration corrections. This */ -/* option produces a solution that is at */ -/* least as accurate at that obtainable */ -/* with the `LT+S' option. Whether the */ -/* 'CN+S' solution is substantially more */ -/* accurate depends on the geometry of the */ -/* participating objects and on the */ -/* accuracy of the input data. In all */ -/* cases this routine will execute more */ -/* slowly when a converged solution is */ -/* computed. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* sub-observer point at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* sub-observer location at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* Both the target position as seen by the */ -/* observer, and rotation of the target */ -/* body, are corrected for light time. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* sub-observer point obtained with the */ -/* 'XLT' option to account for the */ -/* observer's velocity relative to the */ -/* solar system barycenter. */ - -/* 'XCN' Converged Newtonian light time */ -/* correction. This is the same as 'XLT' */ -/* correction but with further iterations */ -/* to a converged Newtonian light time */ -/* solution. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither case nor white space are significant in */ -/* ABCORR. For example, the string */ - -/* 'Lt + s' */ - -/* is valid. */ - - -/* OBSRVR is the name of the observing body. The observing body */ -/* is an ephemeris object: it typically is a spacecraft, */ -/* the earth, or a surface point on the earth. OBSRVR is */ -/* case-insensitive, and leading and trailing blanks in */ -/* OBSRVR are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the Moon is the */ -/* observer. */ - -/* $ Detailed_Output */ - - -/* SPOINT is the sub-observer point on the target body. */ - -/* The sub-observer point is defined either as the point */ -/* on the target body that is closest to the observer, */ -/* or the target surface intercept of the line from the */ -/* observer to the target's center; the input argument */ -/* METHOD selects the definition to be used. */ - -/* SPOINT is expressed in Cartesian coordinates, */ -/* relative to the body-fixed target frame designated by */ -/* FIXREF. The body-fixed target frame is evaluated at */ -/* the sub-observer epoch TRGEPC (see description below). */ - -/* When light time correction is used, the duration of */ -/* light travel between SPOINT to the observer is */ -/* considered to be the one way light time. */ - -/* When aberration corrections are used, SPOINT is */ -/* computed using target body position and orientation */ -/* that have been adjusted for the corrections */ -/* applicable to SPOINT itself rather than to the target */ -/* body's center. In particular, if the stellar */ -/* aberration correction applicable to SPOINT is */ -/* represented by a shift vector S, then the light-time */ -/* corrected position of the target is shifted by S */ -/* before the sub-observer point is computed. */ - -/* The components of SPOINT have units of km. */ - - -/* TRGEPC is the "sub-observer point epoch." TRGEPC is defined */ -/* as follows: letting LT be the one-way light time */ -/* between the observer and the sub-observer point, */ -/* TRGEPC is the epoch ET-LT, ET+LT, or ET depending on */ -/* whether the requested aberration correction is, */ -/* respectively, for received radiation, transmitted */ -/* radiation, or omitted. LT is computed using the */ -/* method indicated by ABCORR. */ - -/* TRGEPC is expressed as seconds past J2000 TDB. */ - - -/* SRFVEC is the vector from the observer's position at ET to */ -/* the aberration-corrected (or optionally, geometric) */ -/* position of SPOINT, where the aberration corrections */ -/* are specified by ABCORR. SRFVEC is expressed in the */ -/* target body-fixed reference frame designated by */ -/* FIXREF, evaluated at TRGEPC. */ - -/* The components of SRFVEC are given in units of km. */ - -/* One can use the SPICELIB function VNORM to obtain the */ -/* distance between the observer and SPOINT: */ - -/* DIST = VNORM ( SRFVEC ) */ - -/* The observer's position OBSPOS, relative to the */ -/* target body's center, where the center's position is */ -/* corrected for aberration effects as indicated by */ -/* ABCORR, can be computed via the call: */ - -/* CALL VSUB ( SPOINT, SRFVEC, OBSPOS ) */ - -/* To transform the vector SRFVEC to a time-dependent */ -/* reference frame REF at ET, a sequence of two frame */ -/* transformations is required. For example, let MFIX */ -/* and MREF be 3x3 matrices respectively describing the */ -/* target body-fixed to J2000 frame transformation at */ -/* TRGEPC and the J2000 to (time-dependent frame) REF */ -/* transformation at ET, and let XFORM be the 3x3 matrix */ -/* representing the composition of MREF with MFIX. Then */ -/* SRFVEC can be transformed to the result REFVEC as */ -/* follows: */ - -/* CALL PXFORM ( FIXREF, 'J2000', TRGEPC, MFIX ) */ -/* CALL PXFORM ( 'J2000', REF, ET, MREF ) */ -/* CALL MXM ( MREF, MFIX, XFORM ) */ -/* CALL MXV ( XFORM, SRFVEC, REFVEC ) */ - -/* The second example in the Examples header section */ -/* below presents a complete program that demonstrates */ -/* this procedure. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified aberration correction is relativistic or */ -/* calls for stellar aberration but not light time correction, */ -/* the error SPICE(NOTSUPPORTED) is signaled. If the specified */ -/* aberration correction is any other unrecognized value, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 2) If either the target or observer input strings cannot be */ -/* converted to an integer ID code, the error */ -/* SPICE(IDCODENOTFOUND) is signaled. */ - -/* 3) If OBSRVR and TARGET map to the same NAIF integer ID code, */ -/* the error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If the input target body-fixed frame FIXREF is not */ -/* recognized, the error SPICE(NOFRAME) is signaled. A frame */ -/* name may fail to be recognized because a required frame */ -/* specification kernel has not been loaded; another cause is a */ -/* misspelling of the frame name. */ - -/* 5) If the input frame FIXREF is not centered at the target body, */ -/* the error SPICE(INVALIDFRAME) is signaled. */ - -/* 6) If the input argument METHOD is not recognized, the error */ -/* SPICE(INVALIDMETHOD) is signaled. */ - -/* 7) If the target and observer have distinct identities but are */ -/* at the same location (for example, the target is Mars and the */ -/* observer is the Mars barycenter), the error */ -/* SPICE(NOSEPARATION) is signaled. */ - -/* 8) If insufficient ephemeris data have been loaded prior to */ -/* calling SUBPNT, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. Note that when */ -/* light time correction is used, sufficient ephemeris data must */ -/* be available to propagate the states of both observer and */ -/* target to the solar system barycenter. */ - -/* 9) If the computation method specifies an ellipsoidal target */ -/* shape and triaxial radii of the target body have not been */ -/* loaded into the kernel pool prior to calling SUBPNT, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 10) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be */ -/* diagnosed and signaled by routines in the call tree of this */ -/* routine. */ - -/* 11) If PCK data specifying the target body-fixed frame */ -/* orientation have not been loaded prior to calling SUBPNT, */ -/* the error will be diagnosed and signaled by a routine in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: if the target body shape is modeled as an */ -/* ellipsoid, triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must be */ -/* loaded. These may be provided in a text or binary PCK file. */ - -/* - Frame data: if a frame definition is required to convert the */ -/* observer and target states to the body-fixed frame of the */ -/* target, that definition must be available in the kernel */ -/* pool. Typically the definition is supplied by loading a */ -/* frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* There are two different popular ways to define the sub-observer */ -/* point: "nearest point on the target to the observer" or "target */ -/* surface intercept of the line containing observer and target." */ -/* These coincide when the target is spherical and generally are */ -/* distinct otherwise. */ - -/* This routine computes light time corrections using light time */ -/* between the observer and the sub-observer point, as opposed to */ -/* the center of the target. Similarly, stellar aberration */ -/* corrections done by this routine are based on the direction of */ -/* the vector from the observer to the light-time corrected */ -/* sub-observer point, not to the target center. This technique */ -/* avoids errors due to the differential between aberration */ -/* corrections across the target body. Therefore it's valid to use */ -/* aberration corrections with this routine even when the observer */ -/* is very close to the sub-observer point, in particular when the */ -/* observer to sub-observer point distance is much less than the */ -/* observer to target center distance. */ - -/* The definition of the aberration-corrected sub-observer point is */ -/* implicit: SPOINT is defined by an equation of the form */ - -/* SPOINT = F ( SPOINT ) */ - -/* Because of the contraction properties of both light time and */ -/* stellar aberration corrections---that is, the difference in the */ -/* corrections for two vectors is much smaller than the difference */ -/* between the vectors themselves---it's easy to solve this equation */ -/* accurately and fairly quickly. */ - -/* When comparing sub-observer point computations with results from */ -/* sources other than SPICE, it's essential to make sure the same */ -/* geometric definitions are used. */ - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - - -/* 1) Find the sub-Earth point on Mars for a specified time. Perform */ -/* the computation twice, using both the "intercept" and "near */ -/* point" options. Display the location of both the Earth and the */ -/* sub-Earth point using both planetocentric and planetographic */ -/* coordinates. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION VNORM */ -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.tm' ) */ - -/* CHARACTER*(*) FM */ -/* PARAMETER ( FM = '(A,F21.9)' ) */ - -/* INTEGER MTHLEN */ -/* PARAMETER ( MTHLEN = 50 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(MTHLEN) METHOD ( 2 ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION F */ -/* DOUBLE PRECISION OBSPOS ( 3 ) */ -/* DOUBLE PRECISION ODIST */ -/* DOUBLE PRECISION OPCLAT */ -/* DOUBLE PRECISION OPCLON */ -/* DOUBLE PRECISION OPCRAD */ -/* DOUBLE PRECISION OPGALT */ -/* DOUBLE PRECISION OPGLAT */ -/* DOUBLE PRECISION OPGLON */ -/* DOUBLE PRECISION RADII ( 3 ) */ -/* DOUBLE PRECISION RE */ -/* DOUBLE PRECISION RP */ -/* DOUBLE PRECISION SPCLAT */ -/* DOUBLE PRECISION SPCLON */ -/* DOUBLE PRECISION SPCRAD */ -/* DOUBLE PRECISION SPGALT */ -/* DOUBLE PRECISION SPGLAT */ -/* DOUBLE PRECISION SPGLON */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ - -/* INTEGER I */ -/* INTEGER N */ -/* C */ -/* C Saved variables */ -/* C */ -/* SAVE METHOD */ -/* C */ -/* C Initial values */ -/* C */ -/* DATA METHOD / 'Intercept: ellipsoid', */ -/* . 'Near point: ellipsoid' / */ -/* C */ -/* C Load kernel files via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Convert the UTC request time string seconds past */ -/* C J2000, TDB. */ -/* C */ -/* CALL STR2ET ( '2008 AUG 11 00:00:00', ET ) */ - -/* C */ -/* C Look up the target body's radii. We'll use these to */ -/* C convert Cartesian to planetographic coordinates. Use */ -/* C the radii to compute the flattening coefficient of */ -/* C the reference ellipsoid. */ -/* C */ -/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */ - -/* C */ -/* C Let RE and RP be, respectively, the equatorial and */ -/* C polar radii of the target. */ -/* C */ -/* RE = RADII( 1 ) */ -/* RP = RADII( 3 ) */ - -/* F = ( RE - RP ) / RE */ - -/* C */ -/* C Compute sub-observer point using light time and stellar */ -/* C aberration corrections. Use the "target surface intercept" */ -/* C definition of sub-observer point on the first loop */ -/* C iteration, and use the "near point" definition on the */ -/* C second. */ -/* C */ -/* DO I = 1, 2 */ - -/* CALL SUBPNT ( METHOD(I), */ -/* . 'MARS', ET, 'IAU_MARS', 'LT+S', */ -/* . 'EARTH', SPOINT, TRGEPC, SRFVEC ) */ -/* C */ -/* C Compute the observer's distance from SPOINT. */ -/* C */ -/* ODIST = VNORM ( SRFVEC ) */ - -/* C */ -/* C Convert the sub-observer point's rectangular coordinates */ -/* C to planetographic longitude, latitude and altitude. */ -/* C Convert radians to degrees. */ -/* C */ -/* CALL RECPGR ( 'MARS', SPOINT, RE, F, */ -/* . SPGLON, SPGLAT, SPGALT ) */ - -/* SPGLON = SPGLON * DPR () */ -/* SPGLAT = SPGLAT * DPR () */ - -/* C */ -/* C Convert sub-observer point's rectangular coordinates to */ -/* C planetocentric radius, longitude, and latitude. Convert */ -/* C radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, SPCRAD, SPCLON, SPCLAT ) */ - -/* SPCLON = SPCLON * DPR () */ -/* SPCLAT = SPCLAT * DPR () */ - -/* C */ -/* C Compute the observer's position relative to the center */ -/* C of the target, where the center's location has been */ -/* C adjusted using the aberration corrections applicable */ -/* C to the sub-point. Express the observer's location in */ -/* C planetographic coordinates. */ -/* C */ -/* CALL VSUB ( SPOINT, SRFVEC, OBSPOS ) */ - -/* CALL RECPGR ( 'MARS', OBSPOS, RE, F, */ -/* . OPGLON, OPGLAT, OPGALT ) */ - -/* OPGLON = OPGLON * DPR () */ -/* OPGLAT = OPGLAT * DPR () */ - -/* C */ -/* C Convert the observer's rectangular coordinates to */ -/* C planetocentric radius, longitude, and latitude. */ -/* C Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( OBSPOS, OPCRAD, OPCLON, OPCLAT ) */ - -/* OPCLON = OPCLON * DPR () */ -/* OPCLAT = OPCLAT * DPR () */ - -/* C */ -/* C Write the results. */ -/* C */ -/* WRITE(*,FM) ' ' */ -/* WRITE(*,* ) 'Computation method = ', METHOD(I) */ -/* WRITE(*,FM) ' ' */ -/* WRITE(*,FM) */ -/* . ' Observer altitude (km) = ', OPGALT */ -/* WRITE(*,FM) */ -/* . ' Length of SRFVEC (km) = ', ODIST */ -/* WRITE(*,FM) */ -/* . ' Sub-observer point altitude (km) = ', SPGALT */ -/* WRITE(*,FM) */ -/* . ' Sub-observer planetographic longitude (deg) = ', SPGLON */ -/* WRITE(*,FM) */ -/* . ' Observer planetographic longitude (deg) = ', OPGLON */ -/* WRITE(*,FM) */ -/* . ' Sub-observer planetographic latitude (deg) = ', SPGLAT */ -/* WRITE(*,FM) */ -/* . ' Observer planetographic latitude (deg) = ', OPGLAT */ -/* WRITE(*,FM) */ -/* . ' Sub-observer planetocentric longitude (deg) = ', SPCLON */ -/* WRITE(*,FM) */ -/* . ' Observer planetocentric longitude (deg) = ', OPCLON */ -/* WRITE(*,FM) */ -/* . ' Sub-observer planetocentric latitude (deg) = ', SPCLAT */ -/* WRITE(*,FM) */ -/* . ' Observer planetocentric latitude (deg) = ', OPCLAT */ -/* WRITE(*,FM) ' ' */ - -/* END DO */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Computation method = Intercept: ellipsoid */ - -/* Observer altitude (km) = 349199089.542324781 */ -/* Length of SRFVEC (km) = 349199089.579020321 */ -/* Sub-observer point altitude (km) = 0.000000000 */ -/* Sub-observer planetographic longitude (deg) = 199.302305055 */ -/* Observer planetographic longitude (deg) = 199.302305055 */ -/* Sub-observer planetographic latitude (deg) = 26.262401212 */ -/* Observer planetographic latitude (deg) = 25.994936725 */ -/* Sub-observer planetocentric longitude (deg) = 160.697694945 */ -/* Observer planetocentric longitude (deg) = 160.697694945 */ -/* Sub-observer planetocentric latitude (deg) = 25.994934146 */ -/* Observer planetocentric latitude (deg) = 25.994934146 */ - - -/* Computation method = Near point: ellipsoid */ - -/* Observer altitude (km) = 349199089.542316496 */ -/* Length of SRFVEC (km) = 349199089.542316496 */ -/* Sub-observer point altitude (km) = 0.000000000 */ -/* Sub-observer planetographic longitude (deg) = 199.302305055 */ -/* Observer planetographic longitude (deg) = 199.302305055 */ -/* Sub-observer planetographic latitude (deg) = 25.994936725 */ -/* Observer planetographic latitude (deg) = 25.994936725 */ -/* Sub-observer planetocentric longitude (deg) = 160.697694945 */ -/* Observer planetocentric longitude (deg) = 160.697694945 */ -/* Sub-observer planetocentric latitude (deg) = 25.729407202 */ -/* Observer planetocentric latitude (deg) = 25.994934146 */ - - - - -/* 2) Use SUBPNT to find the sub-spacecraft point on Mars for the */ -/* Mars Reconnaissance Orbiter spacecraft (MRO) at a specified */ -/* time, using the "near point: ellipsoid" computation method. */ -/* Use both LT+S and CN+S aberration corrections to illustrate */ -/* the differences. */ - -/* Convert the spacecraft to sub-observer point vector obtained */ -/* from SUBPNT into the MRO_HIRISE_LOOK_DIRECTION reference frame */ -/* at the observation time. Perform a consistency check with this */ -/* vector: compare the Mars surface intercept of the ray */ -/* emanating from the spacecraft and pointed along this vector */ -/* with the sub-observer point. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File: mro_example.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de418.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ -/* mro_psp4_ssd_mro95a.bsp MRO ephemeris */ -/* mro_v11.tf MRO frame specifications */ -/* mro_sclkscet_00022_65536.tsc MRO SCLK coefficients and */ -/* parameters */ -/* mro_sc_psp_070925_071001.bc MRO attitude */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls', */ -/* 'mro_psp4_ssd_mro95a.bsp', */ -/* 'mro_v11.tf', */ -/* 'mro_sclkscet_00022_65536.tsc', */ -/* 'mro_sc_psp_070925_071001.bc' ) */ -/* \begintext */ - - -/* Example code begins here. */ - - -/* PROGRAM EX2 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION VDIST */ -/* DOUBLE PRECISION VNORM */ - -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'mro_example.tm' ) */ - -/* CHARACTER*(*) F1 */ -/* PARAMETER ( F1 = '(A,F21.9)' ) */ - -/* CHARACTER*(*) F2 */ -/* PARAMETER ( F2 = '(A)' ) */ - -/* INTEGER FRNMLN */ -/* PARAMETER ( FRNMLN = 32 ) */ - -/* INTEGER MTHLEN */ -/* PARAMETER ( MTHLEN = 50 ) */ - -/* INTEGER CORLEN */ -/* PARAMETER ( CORLEN = 5 ) */ - -/* INTEGER NCORR */ -/* PARAMETER ( NCORR = 2 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(CORLEN) ABCORR ( NCORR ) */ -/* CHARACTER*(FRNMLN) HIREF */ -/* CHARACTER*(MTHLEN) METHOD */ - -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION MROVEC ( 3 ) */ -/* DOUBLE PRECISION R1 ( 3, 3 ) */ -/* DOUBLE PRECISION R2 ( 3, 3 ) */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ -/* DOUBLE PRECISION TRGEPC */ -/* DOUBLE PRECISION XFORM ( 3, 3 ) */ -/* DOUBLE PRECISION XEPOCH */ -/* DOUBLE PRECISION XPOINT ( 3 ) */ -/* DOUBLE PRECISION XVEC ( 3 ) */ - -/* INTEGER I */ - -/* LOGICAL FOUND */ - -/* C */ -/* C Initial values */ -/* C */ -/* DATA ABCORR / 'LT+S', 'CN+S' / */ -/* C */ -/* C Load kernel files via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Convert the TDB request time string to seconds past */ -/* C J2000, TDB. */ -/* C */ -/* CALL STR2ET ( '2007 SEP 30 00:00:00 TDB', ET ) */ - -/* C */ -/* C Compute the sub-spacecraft point using the */ -/* C "NEAR POINT: ELLIPSOID" definition. */ -/* C Compute the results using both LT+S and CN+S */ -/* C aberration corrections. */ -/* C */ -/* METHOD = 'Near point: ellipsoid' */ - -/* WRITE(*,F2) ' ' */ -/* WRITE(*,F2) 'Computation method = '//METHOD */ - -/* DO I = 1, NCORR */ - -/* CALL SUBPNT ( METHOD, */ -/* . 'Mars', ET, 'IAU_MARS', ABCORR(I), */ -/* . 'MRO', SPOINT, TRGEPC, SRFVEC ) */ -/* C */ -/* C Compute the observer's altitude above SPOINT. */ -/* C */ -/* ALT = VNORM ( SRFVEC ) */ -/* C */ -/* C Express SRFVEC in the MRO_HIRISE_LOOK_DIRECTION */ -/* C reference frame at epoch ET. Since SRFVEC is expressed */ -/* C relative to the IAU_MARS frame at TRGEPC, we must */ -/* C compose two transformations: that from IAU_MARS to */ -/* C J2000 at TRGEPC, followed by the transformation from */ -/* C J2000 to MRO_HIRISE_LOOK_DIRECTION at ET. */ -/* C (We could use any other inertial frame in place */ -/* C of J2000; the result would be the same.) */ -/* C */ -/* C To make code formatting a little easier, we'll store */ -/* C the long MRO reference frame name in a variable: */ -/* C */ -/* HIREF = 'MRO_HIRISE_LOOK_DIRECTION' */ - -/* CALL PXFORM ( 'IAU_MARS', 'J2000', TRGEPC, R1 ) */ -/* CALL PXFORM ( 'J2000', HIREF, ET, R2 ) */ - -/* CALL MXM ( R2, R1, XFORM ) */ -/* CALL MXV ( XFORM, SRFVEC, MROVEC ) */ - -/* C */ -/* C Convert rectangular coordinates to planetocentric */ -/* C latitude and longitude. Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */ - -/* LON = LON * DPR () */ -/* LAT = LAT * DPR () */ -/* C */ -/* C Write the results. */ -/* C */ -/* WRITE(*,F2) ' ' */ -/* WRITE(*,F2) 'Aberration correction = '//ABCORR(I) */ -/* WRITE(*,F1) ' ' */ -/* WRITE(*,F2) ' MRO-to-sub-observer vector in' */ -/* WRITE(*,F2) ' MRO HIRISE look direction frame' */ -/* WRITE(*,F1) ' X-component (km) = ', */ -/* . MROVEC(1) */ -/* WRITE(*,F1) ' Y-component (km) = ', */ -/* . MROVEC(2) */ -/* WRITE(*,F1) ' Z-component (km) = ', */ -/* . MROVEC(3) */ -/* WRITE(*,F1) ' Sub-observer point radius (km) = ', RADIUS */ -/* WRITE(*,F1) ' Planetocentric latitude (deg) = ', LAT */ -/* WRITE(*,F1) ' Planetocentric longitude (deg) = ', LON */ -/* WRITE(*,F1) ' Observer altitude (km) = ', ALT */ - -/* C */ -/* C Consistency check: find the surface intercept on */ -/* C Mars of the ray emanating from the spacecraft and having */ -/* C direction vector MROVEC in the MRO HIRISE look direction */ -/* C reference frame at ET. Call the intercept point */ -/* C XPOINT. XPOINT should coincide with SPOINT, up to a */ -/* C small round-off error. */ -/* C */ -/* CALL SINCPT ( 'Ellipsoid', 'Mars', ET, 'IAU_MARS', */ -/* . ABCORR(I), 'MRO', HIREF, MROVEC, */ -/* . XPOINT, XEPOCH, XVEC, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,F1) 'Bug: no intercept' */ -/* ELSE */ -/* C */ -/* C Report the distance between XPOINT and SPOINT. */ -/* C */ -/* WRITE (*,F1) ' Intercept comparison error (km) = ', */ -/* . VDIST( XPOINT, SPOINT ) */ -/* END IF */ - -/* WRITE(*,F1) ' ' */ - -/* END DO */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Computation method = Near point: ellipsoid */ - -/* Aberration correction = LT+S */ - -/* MRO-to-sub-observer vector in */ -/* MRO HIRISE look direction frame */ -/* X-component (km) = 0.286931987 */ -/* Y-component (km) = -0.260417167 */ -/* Z-component (km) = 253.816284981 */ -/* Sub-observer point radius (km) = 3388.299078207 */ -/* Planetocentric latitude (deg) = -38.799836879 */ -/* Planetocentric longitude (deg) = -114.995294746 */ -/* Observer altitude (km) = 253.816580760 */ -/* Intercept comparison error (km) = 0.000002144 */ - - -/* Aberration correction = CN+S */ - -/* MRO-to-sub-observer vector in */ -/* MRO HIRISE look direction frame */ -/* X-component (km) = 0.286931866 */ -/* Y-component (km) = -0.260417914 */ -/* Z-component (km) = 253.816274506 */ -/* Sub-observer point radius (km) = 3388.299078205 */ -/* Planetocentric latitude (deg) = -38.799836883 */ -/* Planetocentric longitude (deg) = -114.995294968 */ -/* Observer altitude (km) = 253.816570285 */ -/* Intercept comparison error (km) = 0.000000001 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-MAY-2010 (NJB) */ - -/* Bug fix: calls to FAILED() have been added after */ -/* SPK calls, target radius lookup, near point */ -/* and surface intercept computations. */ - -/* - SPICELIB Version 1.0.1, 06-FEB-2009 (NJB) */ - -/* Typo correction: changed FIXFRM to FIXREF in header */ -/* documentation. Meta-kernel name suffix was changed to */ -/* ".tm" in header code example. */ - -/* - SPICELIB Version 1.0.0, 02-MAR-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find sub-observer point on target body */ -/* find sub-spacecraft point on target body */ -/* find nearest point to observer on target body */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* This value will become system-dependent when systems */ -/* using 128-bit d.p. numbers are supported by SPICELIB. */ -/* CNVLIM, when added to 1.0D0, should yield 1.0D0. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SUBPNT", (ftnlen)6); - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* USESTL indicates stellar aberration corrections. */ - - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - -/* Reject an aberration correction flag calling for stellar */ -/* aberration but not light time correction. */ - - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } else if (attblk[5]) { - -/* Also reject flags calling for relativistic corrections. */ - - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - } - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &fnd, target_len); - if (! fnd) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - bods2c_(obsrvr, &obscde, &fnd, obsrvr_len); - if (! fnd) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the sub-observer point, the observing body and" - " target body are the same. Both are #.", (ftnlen)97); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Determine the attributes of the frame designated by FIXREF. */ - - namfrm_(fixref, &refcde, fixref_len); - frinfo_(&refcde, ¢er, &type__, &typeid, &fnd); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - if (! fnd) { - setmsg_("Reference frame # is not recognized by the SPICE frame subs" - "ystem. Possibly a required frame definition kernel has not b" - "een loaded.", (ftnlen)130); - errch_("#", fixref, (ftnlen)1, fixref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Make sure that FIXREF is centered at the target body's center. */ - - if (center != trgcde) { - setmsg_("Reference frame # is not centered at the the target body #." - " The ID code of the frame center is #.", (ftnlen)97); - errch_("#", fixref, (ftnlen)1, fixref_len); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", ¢er, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* If necessary, parse the method specification. PRVMTH */ -/* and the derived flags NEAR and ELIPSD start out with */ -/* valid values. PRVMTH records the last valid value of */ -/* METHOD; NEAR and ELIPSD are the corresponding flags. */ - - if (s_cmp(method, prvmth, method_len, (ftnlen)80) != 0) { - -/* Parse the computation method specification. Work with a local */ -/* copy of the method specification that contains no leading or */ -/* embedded blanks. */ - - cmprss_(" ", &c__0, method, locmth, (ftnlen)1, method_len, (ftnlen)80) - ; - ucase_(locmth, locmth, (ftnlen)80, (ftnlen)80); - lparse_(locmth, ":", &c__2, &nw, words, (ftnlen)80, (ftnlen)1, ( - ftnlen)32); - if (nw != 2) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBPNT for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* The text preceding the first delimiter indicates the */ -/* sub-observer point definition: "nearpoint" or "intercept." The */ -/* second word designates the target shape model. Recall that */ -/* we've removed all blanks from the input string, so we won't */ -/* see the string "near point." */ - -/* Check the sub-observer point definition. */ - - if (s_cmp(words, "NEARPOINT", (ftnlen)32, (ftnlen)9) != 0 && s_cmp( - words, "INTERCEPT", (ftnlen)32, (ftnlen)9) != 0) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBPNT for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Check the shape specification. */ - - if (s_cmp(words + 32, "ELLIPSOID", (ftnlen)32, (ftnlen)9) != 0) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBPNT for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* At this point the method specification has passed our tests. */ -/* Use the flag NEAR to indicate whether the computation type is */ -/* "near point." Use the flag ELIPSD to indicate that the shape */ -/* is modeled as an ellipsoid (which is true, for now). */ - - near__ = s_cmp(words, "NEARPOINT", (ftnlen)32, (ftnlen)9) == 0; - elipsd = TRUE_; - -/* Save the current value of METHOD. */ - - s_copy(prvmth, method, (ftnlen)80, method_len); - } - -/* Get the sign S prefixing LT in the expression for TRGEPC. */ -/* When light time correction is not used, setting S = 0 */ -/* allows us to seamlessly set TRGEPC equal to ET. */ - - if (uselt) { - if (xmit) { - s = 1.; - } else { - s = -1.; - } - } else { - s = 0.; - } - -/* Determine the position of the observer in the target body-fixed */ -/* frame. This is a first estimate. */ - -/* - Call SPKEZP to compute the position of the target body as */ -/* seen from the observing body and the light time (LT) */ -/* between them. We request that the coordinates of POS be */ -/* returned relative to the body fixed reference frame */ -/* associated with the target body, using aberration */ -/* corrections specified by the input argument ABCORR. */ - -/* - Call VMINUS to negate the direction of the vector (OBSPOS) */ -/* so it will be the position of the observer as seen from */ -/* the target body in target body fixed coordinates. */ - -/* Note that this result is not the same as the result of */ -/* calling SPKEZP with the target and observer switched. We */ -/* computed the vector FROM the observer TO the target in */ -/* order to get the proper light time and stellar aberration */ -/* corrections (if requested). Now we need the inverse of */ -/* that corrected vector in order to compute the sub-observer */ -/* point. */ - - spkezp_(&trgcde, et, fixref, abcorr, &obscde, tpos, <, fixref_len, - abcorr_len); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Negate the target's position to obtain the position of the */ -/* observer relative to the target. */ - - vminus_(tpos, obspos); - -/* Find the sub-observer point and distance from observer to */ -/* sub-observer point using the specified geometric definition. */ - - if (elipsd) { - -/* Find the sub-observer point given the target epoch, */ -/* observer-target position, and target body orientation */ -/* we've already computed. If we're not using light */ -/* time correction, this is all we need do. Otherwise, */ -/* our result will give us an initial estimate of the */ -/* target epoch, which we'll then improve. */ - -/* Get the radii of the target body from the kernel pool. */ - - bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - range = vnorm_(obspos); - if (range == 0.) { - -/* We've already ensured that observer and target are */ -/* distinct, so this should be a very unusual occurrence. */ - - setmsg_("Observer-target distance is zero. Observer is #; target" - " is #.", (ftnlen)61); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOSEPARATION)", (ftnlen)19); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Make a first estimate of the sub-observer point. The algorithm */ -/* we use depends on the sub-observer point definition. */ - - if (near__) { - -/* Locate the nearest point to the observer on the target. */ - - nearpt_(obspos, radii, &radii[1], &radii[2], spoint, &alt); - } else { - -/* Locate the surface intercept of the ray from the */ -/* observer to the target center. */ - - surfpt_(obspos, tpos, radii, &radii[1], &radii[2], spoint, &fnd); - if (! fnd) { - -/* If there's no intercept, we have a numerical problem. */ - - setmsg_("No intercept of observer-target ray was found.", ( - ftnlen)46); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - alt = vdist_(obspos, spoint); - } - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Compute the one-way light time and target epoch based on our */ -/* first computation of SPOINT. The coefficient S has been */ -/* set to give us the correct answer for each aberration */ -/* correction case. */ - - lt = alt / clight_(); - *trgepc = *et + s * lt; - -/* If we're not using light time and stellar aberration */ -/* corrections, we're almost done now. Note that we need only */ -/* check for use of light time corrections, because use of */ -/* stellar aberration corrections alone has been prevented by an */ -/* earlier check. */ - if (! uselt) { - -/* The TRGEPC value we'll return comes from our value of ALT */ -/* computed above. The previous call to SPKEZP call yielded */ -/* the vector OBSPOS. SPOINT was set immediately above. The */ -/* only output left to compute is SRFVEC. */ - - vsub_(spoint, obspos, srfvec); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* We'll now make an improved sub-observer point estimate using */ -/* the previous estimate of the sub-observer point. The number of */ -/* iterations depends on the light time correction type. */ - if (usecn) { - nitr = 5; - } else { - nitr = 1; - } - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Initialize the variables required to evaluate the */ -/* loop termination condition. */ - - i__ = 0; - ltdiff = 1.; - etdiff = 1.; - prevlt = lt; - prevet = *trgepc; - while(i__ < nitr && ltdiff > abs(lt) * 1e-17 && etdiff > 0.) { - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", fixref, trgepc, xform, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - mxv_(xform, j2pos, obspos); - -/* If we're using stellar aberration corrections, adjust the */ -/* observer position to account for the stellar aberration */ -/* correction applicable to SPOINT. */ - - if (usestl) { - -/* We want to apply the stellar aberration correction that */ -/* applies to our current estimate of the sub-observer point */ -/* location, NOT the correction for the target body's */ -/* center. In most cases the two corrections will be */ -/* similar, but they might not be---consider the case of a */ -/* highly prolate target body where the observer is close */ -/* to one "end" of the body. */ - -/* Find the vector from the observer to the estimated */ -/* sub-observer point. Find the stellar aberration offset */ -/* STLOFF for this vector. Note that all vectors are */ -/* expressed relative to the target body-fixed frame at */ -/* TRGEPC. We must perform our corrections in an inertial */ -/* frame. */ - - vsub_(spoint, obspos, subvec); - mtxv_(xform, subvec, subvj2); - if (xmit) { - stlabx_(subvj2, &ssbost[3], corvj2); - } else { - stelab_(subvj2, &ssbost[3], corvj2); - } - mxv_(xform, corvj2, corpos); - vsub_(corpos, subvec, stloff); - -/* In principle, we want to shift the target body position */ -/* relative to the solar system barycenter by STLOFF, but */ -/* we can skip this step and just re-compute the observer's */ -/* location relative to the target body's center by */ -/* subtracting off STLOFF. */ - - vsub_(obspos, stloff, vtemp); - vequ_(vtemp, obspos); - } - -/* Find the sub-observer point using the current estimated */ -/* geometry. */ - - if (near__) { - -/* Locate the nearest point to the observer on the target. */ - - nearpt_(obspos, radii, &radii[1], &radii[2], spoint, &alt); - } else { - -/* Locate the surface intercept of the ray from the */ -/* observer to the target center. */ - - vminus_(obspos, tpos); - surfpt_(obspos, tpos, radii, &radii[1], &radii[2], spoint, & - fnd); - if (! fnd) { - -/* If there's no intercept, we have a numerical problem. */ - - setmsg_("No intercept of observer-target ray was found.", - (ftnlen)46); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - alt = vdist_(obspos, spoint); - } - if (failed_()) { - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* Compute a new light time estimate and new target epoch. */ - - lt = alt / clight_(); - *trgepc = *et + s * lt; - -/* At this point, we have new estimates of the sub-observer */ -/* point SPOINT, the observer altitude ALT, the target epoch */ -/* TRGEPC, and the position of the observer relative to the */ -/* target OBSPOS. */ - -/* We use the d.p. identity function TOUCHD to force the */ -/* compiler to create double precision arguments from the */ -/* differences LT-PREVLT and TRGEPC-PREVET. Some compilers */ -/* will perform extended-precision register arithmetic, which */ -/* can prevent a difference from rounding to zero. Simply */ -/* storing the result of the subtraction in a double precision */ -/* variable doesn't solve the problem, because that variable */ -/* can be optimized out of existence. */ - - d__2 = lt - prevlt; - ltdiff = (d__1 = touchd_(&d__2), abs(d__1)); - d__2 = *trgepc - prevet; - etdiff = (d__1 = touchd_(&d__2), abs(d__1)); - prevlt = lt; - prevet = *trgepc; - ++i__; - } - } else { - -/* We've already checked the computation method input argument, */ -/* so we don't expect to arrive here. This code is present for */ -/* safety. */ - - setmsg_("The computation method # was not recognized. ", (ftnlen)45); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBPNT", (ftnlen)6); - return 0; - } - -/* SPOINT, TRGEPC, and OBSPOS have been set at this point. Compute */ -/* SRFVEC. */ - - vsub_(spoint, obspos, srfvec); - chkout_("SUBPNT", (ftnlen)6); - return 0; -} /* subpnt_ */ - diff --git a/ext/spice/src/cspice/subpnt_c.c b/ext/spice/src/cspice/subpnt_c.c deleted file mode 100644 index fdaf3eb993..0000000000 --- a/ext/spice/src/cspice/subpnt_c.c +++ /dev/null @@ -1,1100 +0,0 @@ -/* - --Procedure subpnt_c ( Sub-observer point ) - --Abstract - - Compute the rectangular coordinates of the sub-observer point on - a target body at a specified epoch, optionally corrected for - light time and stellar aberration. - - This routine supersedes subpt_c. - --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 - - frame_c - NAIF_IDS - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void subpnt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - fixref I Body-fixed, body-centered target body frame. - abcorr I Aberration correction. - obsrvr I Name of observing body. - spoint O Sub-observer point on the target body. - trgepc O Sub-observer point epoch. - srfvec O Vector from observer to sub-observer point. - --Detailed_Input - - method is a short string providing parameters defining - the computation method to be used. - - The supported values of `method' are listed below. - Please note that the colon is a required delimiter; - using a blank will not work. - - "Near point: ellipsoid" The sub-observer point - computation uses a - triaxial ellipsoid to - model the surface of the - target body. The - sub-observer point is - defined as the nearest - point on the target - relative to the - observer. - - "Intercept: ellipsoid" The sub-observer point - computation uses a - triaxial ellipsoid to - model the surface of the - target body. The - sub-observer point is - defined as the target - surface intercept of the - line containing the - observer and the - target's center. - - Neither case nor white space are significant in - `method'. For example, the string - - " nearpoint:ELLIPSOID " - - is valid. - - - target is the name of the target body. The target body is - an ephemeris object (its trajectory is given by - SPK data), and is an extended object. - - The string `target' is case-insensitive, and leading - and trailing blanks in `target' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both - "MOON" and "301" are legitimate strings that indicate - the Moon is the target body. - - When the target body's surface is represented by a - tri-axial ellipsoid, this routine assumes that a - kernel variable representing the ellipsoid's radii is - present in the kernel pool. Normally the kernel - variable would be defined by loading a PCK file. - - - et is the epoch of participation of the observer, - expressed as ephemeris seconds past J2000 TDB: `et' is - the epoch at which the observer's state is computed. - - When aberration corrections are not used, `et' is also - the epoch at which the position and orientation of - the target body are computed. - - When aberration corrections are used, the position and - orientation of the target body are computed at et-lt or - et+lt, where `lt' is the one-way light time between the - sub-observer point and the observer, and the sign - applied to `lt' depends on the selected correction. See - the description of `abcorr' below for details. - - - fixref is the name of the body-fixed, body-centered reference - frame associated with the target body. The output - sub-observer point `spoint' will be expressed relative - to this reference frame. The string `fixref' is - case-insensitive, and leading and trailing blanks in - `fixref' are not significant. - - - abcorr indicates the aberration corrections to be applied when - computing the target's position and orientation. - - For remote sensing applications, where the apparent - sub-observer point seen by the observer is desired, - normally either of the corrections - - "LT+S" - "CN+S" - - should be used. These and the other supported options - are described below. `abcorr' may be any of the - following: - - "NONE" Apply no correction. Return the - geometric sub-observer point on the - target body. - - Let `lt' represent the one-way light time between the - observer and the sub-observer point (note: NOT - between the observer and the target body's center). - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - sub-observer point's location at the light-time - corrected epoch et-lt and *arrive* at the observer's - location at `et': - - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the location of sub-observer - point at the moment it emitted photons - arriving at the observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "LT" option uses one iteration. - - Both the target position as seen by the - observer, and rotation of the target - body, are corrected for light time. - - "LT+S" Correct for one-way light time and stellar - aberration using a Newtonian formulation. - This option modifies the sub-observer - point obtained with the "LT" option to - account for the observer's velocity - relative to the solar system barycenter. - These corrections yield the apparent - sub-observer point. - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges. Both the - position and rotation of the target - body are corrected for light time. - - "CN+S" Converged Newtonian light time and - stellar aberration corrections. This - option produces a solution that is at - least as accurate at that obtainable - with the "LT+S" option. Whether the "CN+S" - solution is substantially more accurate - depends on the geometry of the - participating objects and on the - accuracy of the input data. In all - cases this routine will execute more - slowly when a converged solution is - computed. - - - The following values of `abcorr' apply to the - "transmission" case in which photons *depart* from - the observer's location at `et' and arrive at the - sub-observer point at the light-time corrected epoch - et+lt: - - "XLT" "Transmission" case: correct for - one-way light time using a Newtonian - formulation. This correction yields the - sub-observer location at the moment it - receives photons emitted from the - observer's location at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "LT" option uses one iteration. - - Both the target position as seen by the - observer, and rotation of the target - body, are corrected for light time. - - "XLT+S" "Transmission" case: correct for - one-way light time and stellar - aberration using a Newtonian - formulation This option modifies the - sub-observer point obtained with the - "XLT" option to account for the - observer's velocity relative to the - solar system barycenter. - - "XCN" Converged Newtonian light time - correction. This is the same as "XLT" - correction but with further iterations - to a converged Newtonian light time - solution. - - "XCN+S" "Transmission" case: converged - Newtonian light time and stellar - aberration corrections. - - Neither case nor white space are significant in - `abcorr'. For example, the string - - 'Lt + s' - - is valid. - - - obsrvr is the name of the observing body. The observing body - is an ephemeris object: it typically is a spacecraft, - the earth, or a surface point on the earth. `obsrvr' is - case-insensitive, and leading and trailing blanks in - `obsrvr' are not significant. Optionally, you may - supply a string containing the integer ID code for - the object. For example both "MOON" and "301" are - legitimate strings that indicate the Moon is the - observer. - --Detailed_Output - - - spoint is the sub-observer point on the target body. - - The sub-observer point is defined either as the point - on the target body that is closest to the observer, - or the target surface intercept of the line from the - observer to the target's center; the input argument - `method' selects the definition to be used. - - `spoint' is expressed in Cartesian coordinates, - relative to the body-fixed target frame designated by - `fixref'. The body-fixed target frame is evaluated at - the sub-observer epoch `trgepc' (see description below). - - When light time correction is used, the duration of - light travel between `spoint' to the observer is - considered to be the one way light time. - - When aberration corrections are used, `spoint' is - computed using target body position and orientation - that have been adjusted for the corrections - applicable to `spoint' itself rather than to the target - body's center. In particular, if the stellar - aberration correction applicable to `spoint' is - represented by a shift vector `s', then the light-time - corrected position of the target is shifted by `s' - before the sub-observer point is computed. - - The components of `spoint' have units of km. - - - trgepc is the "sub-observer point epoch." `trgepc' is defined - as follows: letting `lt' be the one-way light time - between the observer and the sub-observer point, - `trgepc' is the epoch et-lt, et+lt, or `et' depending on - whether the requested aberration correction is, - respectively, for received radiation, transmitted - radiation, or omitted. `lt' is computed using the - method indicated by `abcorr'. - - `trgepc' is expressed as seconds past J2000 TDB. - - - srfvec is the vector from the observer's position at `et' to - the aberration-corrected (or optionally, geometric) - position of `spoint', where the aberration corrections - are specified by `abcorr'. `srfvec' is expressed in the - target body-fixed reference frame designated by - `fixref', evaluated at `trgepc'. - - The components of `srfvec' are given in units of km. - - One can use the CSPICE function vnorm_c to obtain the - distance between the observer and `spoint': - - dist = vnorm_c ( srfvec ); - - The observer's position `obspos', relative to the - target body's center, where the center's position is - corrected for aberration effects as indicated by - `abcorr', can be computed via the call: - - vsub_c ( spoint, srfvec, obspos ); - - To transform the vector `srfvec' to a time-dependent - reference frame `ref' at `et', a sequence of two frame - transformations is required. For example, let `mfix' - and `mref' be 3x3 matrices respectively describing the - target body-fixed to J2000 frame transformation at - `trgepc' and the J2000 to (time-dependent frame) `ref' - transformation at `et', and let `xform' be the 3x3 matrix - representing the composition of `mref' with `mfix'. Then - `srfvec' can be transformed to the result `refvec' as - follows: - - pxform_c ( fixref, "j2000", trgepc, mfix ); - pxform_c ( "j2000", ref, et, mref ); - mxm_c ( mref, mfix, xform ); - mxv_c ( xform, srfvec, refvec ); - - The second example in the Examples header section - below presents a complete program that demonstrates - this procedure. - --Parameters - - None. - --Exceptions - - - 1) If the specified aberration correction is relativistic or - calls for stellar aberration but not light time correction, - the error SPICE(NOTSUPPORTED) is signaled. If the specified - aberration correction is any other unrecognized value, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 2) If either the target or observer input strings cannot be - converted to an integer ID code, the error SPICE(IDCODENOTFOUND) - is signaled. - - 3) If `obsrvr' and `target' map to the same NAIF integer ID code, - the error SPICE(BODIESNOTDISTINCT) is signaled. - - 4) If the input target body-fixed frame `fixref' is not recognized, - the error SPICE(NOFRAME) is signaled. A frame name may fail - to be recognized because a required frame specification kernel - has not been loaded; another cause is a misspelling of the - frame name. - - 5) If the input frame `fixref' is not centered at the target body, - the error SPICE(INVALIDFRAME) is signaled. - - 6) If the input argument `method' is not recognized, the error - SPICE(INVALIDMETHOD) is signaled. - - 7) If the target and observer have distinct identities but are - at the same location (for example, the target is Mars and - the observer is the Mars barycenter), the error - SPICE(NOSEPARATION) is signaled. - - 8) If insufficient ephemeris data have been loaded prior to - calling subpnt_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. Note that when - light time correction is used, sufficient ephemeris data - must be available to propagate the states of both observer - and target to the solar system barycenter. - - 9) If the computation method specifies an ellipsoidal target shape - and triaxial radii of the target body have not been loaded - into the kernel pool prior to calling subpnt_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 10) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 11) If PCK data specifying the target body-fixed frame orientation - have not been loaded prior to calling subpnt_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 12) The error SPICE(EMPTYSTRING) is signaled if any input string - argument does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 13) The error SPICE(NULLPOINTER) is signaled if any input - string argument pointer is null. - - --Files - - Appropriate kernels must be loaded by the calling program before - this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target and observer must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - PCK data: if the target body shape is modeled as an - ellipsoid, triaxial radii for the target body must be loaded - into the kernel pool. Typically this is done by loading a - text PCK file via furnsh_c. - - - Further PCK data: rotation data for the target body must be - loaded. These may be provided in a text or binary PCK file. - - - Frame data: if a frame definition is required to convert the - observer and target states to the body-fixed frame of the - target, that definition must be available in the kernel - pool. Typically the definition is supplied by loading a - frame kernel via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - There are two different popular ways to define the sub-observer - point: "nearest point on the target to the observer" or "target - surface intercept of the line containing observer and target." - These coincide when the target is spherical and generally are - distinct otherwise. - - This routine computes light time corrections using light time - between the observer and the sub-observer point, as opposed to - the center of the target. Similarly, stellar aberration - corrections done by this routine are based on the direction of - the vector from the observer to the light-time corrected - sub-observer point, not to the target center. This technique - avoids errors due to the differential between aberration - corrections across the target body. Therefore it's valid to use - aberration corrections with this routine even when the observer - is very close to the sub-observer point, in particular when the - observer to sub-observer point distance is much less than the - observer to target center distance. - - The definition of the aberration-corrected sub-observer point is - implicit: `spoint' is defined by an equation of the form - - spoint = f ( spoint ) - - Because of the contraction properties of both light time and - stellar aberration corrections---that is, the difference in the - corrections for two vectors is much smaller than the difference - between the vectors themselves---it's easy to solve this equation - accurately and fairly quickly. - - When comparing sub-observer point computations with results from - sources other than SPICE, it's essential to make sure the same - geometric definitions are used. - --Examples - - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Find the sub-Earth point on Mars for a specified time. Perform - the computation twice, using both the "intercept" and "near - point" options. Display the location of both the Earth and the - sub-Earth point using both planetocentric and planetographic - coordinates. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls' ) - - \begintext - - - Example code begins here. - - /. - Program EX1 - ./ - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local parameters - ./ - #define META "example.tm" - - /. - Local variables - ./ - static SpiceChar * method[2] = - { - "Intercept: ellipsoid", - "Near point: ellipsoid" - }; - - SpiceDouble et; - SpiceDouble f; - SpiceDouble obspos [3]; - SpiceDouble odist; - SpiceDouble opclat; - SpiceDouble opclon; - SpiceDouble opcrad; - SpiceDouble opgalt; - SpiceDouble opglat; - SpiceDouble opglon; - SpiceDouble radii [3]; - SpiceDouble re; - SpiceDouble rp; - SpiceDouble spclat; - SpiceDouble spclon; - SpiceDouble spcrad; - SpiceDouble spgalt; - SpiceDouble spglat; - SpiceDouble spglon; - SpiceDouble spoint [3]; - SpiceDouble srfvec [3]; - SpiceDouble trgepc; - - SpiceInt i; - SpiceInt n; - - /. - Load kernel files via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the UTC request time string to seconds past - J2000, TDB. - ./ - str2et_c ( "2008 aug 11 00:00:00", &et ); - - /. - Look up the target body's radii. We'll use these to - convert Cartesian to planetographic coordinates. Use - the radii to compute the flattening coefficient of - the reference ellipsoid. - ./ - bodvrd_c ( "MARS", "RADII", 3, &n, radii ); - - /. - Let `re and `rp' be, respectively, the equatorial and - polar radii of the target. - ./ - re = radii[0]; - rp = radii[2]; - - f = ( re - rp ) / re; - - /. - Compute sub-observer point using light time and stellar - aberration corrections. Use the "target surface intercept" - definition of the sub-observer point on the first loop - iteration, and use the "near point" definition on the - second. - ./ - - for ( i = 0; i < 2; i++ ) - { - subpnt_c ( method[i], - "mars", et, "iau_mars", "lt+s", - "earth", spoint, &trgepc, srfvec ); - /. - Compute the observer's distance from SPOINT. - ./ - odist = vnorm_c ( srfvec ); - - /. - Convert the sub-observer point's rectangular coordinates - to planetographic longitude, latitude and altitude. - Convert radians to degrees. - ./ - recpgr_c ( "mars", spoint, re, f, - &spglon, &spglat, &spgalt ); - - spglon *= dpr_c(); - spglat *= dpr_c(); - - /. - Convert sub-observer point's rectangular coordinates to - planetocentric radius, longitude, and latitude. Convert - radians to degrees. - ./ - reclat_c ( spoint, &spcrad, &spclon, &spclat ); - - spclon *= dpr_c(); - spclat *= dpr_c(); - - /. - Compute the observer's position relative to the center - of the target, where the center's location has been - adjusted using the aberration corrections applicable - to the sub-point. Express the observer's location in - planetographic coordinates. - ./ - vsub_c ( spoint, srfvec, obspos ); - - recpgr_c ( "mars", obspos, re, f, - &opglon, &opglat, &opgalt ); - - opglon *= dpr_c (); - opglat *= dpr_c (); - - /. - Convert the observer's rectangular coordinates to - planetocentric radius, longitude, and latitude. - Convert radians to degrees. - ./ - reclat_c ( obspos, &opcrad, &opclon, &opclat ); - - opclon *= dpr_c(); - opclat *= dpr_c(); - - /. - Write the results. - ./ - printf ( "\n" - " Computation method = %s\n\n" - " Observer altitude (km) = %21.9f\n" - " Length of SRFVEC (km) = %21.9f\n" - " Sub-observer point altitude (km) = %21.9f\n" - " Sub-observer planetographic longitude (deg) = %21.9f\n" - " Observer planetographic longitude (deg) = %21.9f\n" - " Sub-observer planetographic latitude (deg) = %21.9f\n" - " Observer planetographic latitude (deg) = %21.9f\n" - " Sub-observer planetocentric longitude (deg) = %21.9f\n" - " Observer planetocentric longitude (deg) = %21.9f\n" - " Sub-observer planetocentric latitude (deg) = %21.9f\n" - " Observer planetocentric latitude (deg) = %21.9f\n" - "\n", - method[i], - opgalt, - odist, - spgalt, - spglon, - opglon, - spglat, - opglat, - spclon, - opclon, - spclat, - opclat ); - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - Computation method = Intercept: ellipsoid - - Observer altitude (km) = 349199089.542324722 - Length of SRFVEC (km) = 349199089.579020321 - Sub-observer point altitude (km) = 0.000000000 - Sub-observer planetographic longitude (deg) = 199.302305055 - Observer planetographic longitude (deg) = 199.302305055 - Sub-observer planetographic latitude (deg) = 26.262401212 - Observer planetographic latitude (deg) = 25.994936725 - Sub-observer planetocentric longitude (deg) = 160.697694945 - Observer planetocentric longitude (deg) = 160.697694945 - Sub-observer planetocentric latitude (deg) = 25.994934146 - Observer planetocentric latitude (deg) = 25.994934146 - - - Computation method = Near point: ellipsoid - - Observer altitude (km) = 349199089.542316437 - Length of SRFVEC (km) = 349199089.542316437 - Sub-observer point altitude (km) = -0.000000000 - Sub-observer planetographic longitude (deg) = 199.302305055 - Observer planetographic longitude (deg) = 199.302305055 - Sub-observer planetographic latitude (deg) = 25.994936725 - Observer planetographic latitude (deg) = 25.994936725 - Sub-observer planetocentric longitude (deg) = 160.697694945 - Observer planetocentric longitude (deg) = 160.697694945 - Sub-observer planetocentric latitude (deg) = 25.729407202 - Observer planetocentric latitude (deg) = 25.994934146 - - - - 2) Use subpnt_c to find the sub-spacecraft point on Mars for the - Mars Reconnaissance Orbiter spacecraft (MRO) at a specified - time, using the "near point: ellipsoid" computation method. - Use both LT+S and CN+S aberration corrections to illustrate - the differences. - - Convert the spacecraft to sub-observer point vector obtained - from subpnt_c into the MRO_HIRISE_LOOK_DIRECTION reference frame - at the observation time. Perform a consistency check with this - vector: compare the Mars surface intercept of the ray - emanating from the spacecraft and pointed along this vector - with the sub-observer point. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - - KPL/MK - - File: mro_example.tm - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - The names and contents of the kernels referenced - by this meta-kernel are as follows: - - File name Contents - --------- -------- - de418.bsp Planetary ephemeris - pck00008.tpc Planet orientation and - radii - naif0008.tls Leapseconds - mro_psp4_ssd_mro95a.bsp MRO ephemeris - mro_v11.tf MRO frame specifications - mro_sclkscet_00022_65536.tsc MRO SCLK coefficients and - parameters - mro_sc_psp_070925_071001.bc MRO attitude - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls', - 'mro_psp4_ssd_mro95a.bsp', - 'mro_v11.tf', - 'mro_sclkscet_00022_65536.tsc', - 'mro_sc_psp_070925_071001.bc' ) - \begintext - - - Example code begins here. - - - /. - Program EX2 - ./ - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local constants - ./ - #define META "mro_example.tm" - #define NCORR 2 - - /. - Local variables - ./ - SpiceBoolean found; - - static SpiceChar * abcorr[NCORR] = - { - "LT+S", "CN+S" - }; - - static SpiceChar * hiref; - static SpiceChar * method; - - SpiceDouble alt; - SpiceDouble et; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble mrovec [3]; - SpiceDouble r1 [3][3]; - SpiceDouble r2 [3][3]; - SpiceDouble radius; - SpiceDouble spoint [3]; - SpiceDouble srfvec [3]; - SpiceDouble trgepc; - SpiceDouble xepoch; - SpiceDouble xform [3][3]; - SpiceDouble xpoint [3]; - SpiceDouble xvec [3]; - - SpiceInt i; - - /. - Load kernel files via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the TDB request time string to seconds past - J2000, TDB. - ./ - str2et_c ( "2007 SEP 30 00:00:00 TDB", &et ); - - /. - Compute the sub-spacecraft point using the - "NEAR POINT: ELLIPSOID" definition. - Compute the results using both LT+S and CN+S - aberration corrections. - ./ - method = "Near point: ellipsoid"; - - printf ( "\nComputation method = %s\n", method ); - - for ( i = 0; i < 2; i++ ) - { - subpnt_c ( method, - "mars", et, "iau_mars", abcorr[i], - "mro", spoint, &trgepc, srfvec ); - - /. - Compute the observer's altitude above `spoint'. - ./ - alt = vnorm_c ( srfvec ); - - /. - Express `srfvec' in the MRO_HIRISE_LOOK_DIRECTION - reference frame at epoch `et'. Since `srfvec' is expressed - relative to the IAU_MARS frame at `trgepc', we must - compose two transformations: that from IAU_MARS to - J2000 at `trgepc', followed by the transformation from - J2000 to MRO_HIRISE_LOOK_DIRECTION at `et'. - (We could use any other inertial frame in place - of J2000; the result would be the same.) - - To make code formatting a little easier, we'll store - the long MRO reference frame name in a variable: - ./ - hiref = "MRO_HIRISE_LOOK_DIRECTION"; - - pxform_c ( "iau_mars", "j2000", trgepc, r1 ); - pxform_c ( "j2000", hiref, et, r2 ); - - mxm_c ( r2, r1, xform ); - mxv_c ( xform, srfvec, mrovec ); - - /. - Convert rectangular coordinates to planetocentric - latitude and longitude. Convert radians to degrees. - ./ - reclat_c ( spoint, &radius, &lon, &lat ); - - lon *= dpr_c(); - lat *= dpr_c(); - - /. - Write the results. - ./ - printf ( "\n" - "Aberration correction = %s\n\n" - " MRO-to-sub-observer vector in\n" - " MRO HIRISE look direction frame\n" - " X-component (km) = %21.9f\n" - " Y-component (km) = %21.9f\n" - " Z-component (km) = %21.9f\n" - " Sub-observer point radius (km) = %21.9f\n" - " Planetocentric latitude (deg) = %21.9f\n" - " Planetocentric longitude (deg) = %21.9f\n" - " Observer altitude (km) = %21.9f\n", - abcorr[i], - mrovec[0], - mrovec[1], - mrovec[2], - radius, - lat, - lon, - alt ); - - /. - Consistency check: find the surface intercept on - Mars of the ray emanating from the spacecraft and having - direction vector MROVEC in the MRO HIRISE look direction - reference frame at ET. Call the intercept point - XPOINT. XPOINT should coincide with SPOINT, up to a - small round-off error. - ./ - sincpt_c ( "ellipsoid", "mars", et, "iau_mars", - abcorr[i], "mro", hiref, mrovec, - xpoint, &xepoch, xvec, &found ); - - if ( !found ) - { - printf ( "Bug: no intercept\n" ); - } - else - { - /. - Report the distance between XPOINT and SPOINT. - ./ - printf ( " Intercept comparison error (km) = %21.9f\n\n", - vdist_c( xpoint, spoint ) ); - } - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Computation method = Near point: ellipsoid - - Aberration correction = LT+S - - MRO-to-sub-observer vector in - MRO HIRISE look direction frame - X-component (km) = 0.286931987 - Y-component (km) = -0.260417167 - Z-component (km) = 253.816284981 - Sub-observer point radius (km) = 3388.299078207 - Planetocentric latitude (deg) = -38.799836879 - Planetocentric longitude (deg) = -114.995294746 - Observer altitude (km) = 253.816580760 - Intercept comparison error (km) = 0.000002144 - - - Aberration correction = CN+S - - MRO-to-sub-observer vector in - MRO HIRISE look direction frame - X-component (km) = 0.286931866 - Y-component (km) = -0.260417914 - Z-component (km) = 253.816274506 - Sub-observer point radius (km) = 3388.299078205 - Planetocentric latitude (deg) = -38.799836883 - Planetocentric longitude (deg) = -114.995294968 - Observer altitude (km) = 253.816570285 - Intercept comparison error (km) = 0.000000001 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 06-FEB-2009 (NJB) - - Incorrect frame name fixfrm was changed to fixref in - documentation. - - In the header examples, meta-kernel names were updated to use - the suffix - - ".tm" - - -CSPICE Version 1.0.0, 02-MAR-2008 (NJB) - --Index_Entries - - find sub-observer point on target body - find sub-spacecraft point on target body - find nearest point to observer on target body - --& -*/ - -{ /* Begin subpnt_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "subpnt_c" ); - - /* - Check the input strings: method, target, fixref, abcorr, and obsrvr. - Make sure none of the pointers are null and that each string - contains at least one non-null character. - */ - CHKFSTR ( CHK_STANDARD, "subpnt_c", method ); - CHKFSTR ( CHK_STANDARD, "subpnt_c", target ); - CHKFSTR ( CHK_STANDARD, "subpnt_c", fixref ); - CHKFSTR ( CHK_STANDARD, "subpnt_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "subpnt_c", obsrvr ); - - /* - Call the f2c'd routine. - */ - subpnt_ ( ( char * ) method, - ( char * ) target, - ( doublereal * ) &et, - ( char * ) fixref, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) spoint, - ( doublereal * ) trgepc, - ( doublereal * ) srfvec, - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(fixref), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - chkout_c ( "subpnt_c" ); - -} /* End subpnt_c */ diff --git a/ext/spice/src/cspice/subpt.c b/ext/spice/src/cspice/subpt.c deleted file mode 100644 index ef1a1a46ed..0000000000 --- a/ext/spice/src/cspice/subpt.c +++ /dev/null @@ -1,649 +0,0 @@ -/* subpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure SUBPT ( Sub-observer point ) */ -/* Subroutine */ int subpt_(char *method, char *target, doublereal *et, char * - abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen - method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* Initialized data */ - - static doublereal origin[3] = { 0.,0.,0. }; - - doublereal radii[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - extern doublereal vdist_(doublereal *, doublereal *); - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - integer obscde; - doublereal lt; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer frcode; - extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical - *, ftnlen); - integer nradii; - char frname[80]; - integer trgcde; - extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - doublereal tstate[6]; - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *), surfpt_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, logical *); - doublereal pos[3]; - -/* $ Abstract */ - -/* Deprecated: This routine has been superseded by the SPICELIB */ -/* routine SUBPNT. This routine is supported for purposes of */ -/* backward compatibility only. */ - -/* Compute the rectangular coordinates of the sub-observer point on */ -/* a target body at a particular epoch, optionally corrected for */ -/* planetary (light time) and stellar aberration. Return these */ -/* coordinates expressed in the body-fixed frame associated with the */ -/* target body. Also, return the observer's altitude above the */ -/* target body. */ - -/* $ 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 */ - -/* FRAMES */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* SPOINT O Sub-observer point on the target body. */ -/* ALT O Altitude of the observer above the target body. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string specifying the computation method */ -/* to be used. The choices are: */ - -/* 'Near point' The sub-observer point is */ -/* defined as the nearest point on */ -/* the target relative to the */ -/* observer. */ - -/* 'Intercept' The sub-observer point is */ -/* defined as the target surface */ -/* intercept of the line */ -/* containing the observer and the */ -/* target's center. */ - -/* In both cases, the intercept computation treats the */ -/* surface of the target body as a triaxial ellipsoid. */ -/* The ellipsoid's radii must be available in the kernel */ -/* pool. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string ' NEARPOINT' is */ -/* valid. */ - - -/* TARGET is the name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as */ -/* an integer string. For example both 'MOON' and */ -/* '301' are legitimate strings that indicate the */ -/* moon is the target body. This routine assumes */ -/* that this body is modeled by a tri-axial ellipsoid, */ -/* and that a PCK file containing its radii has been */ -/* loaded into the kernel pool via FURNSH. */ - -/* ET is the epoch in ephemeris seconds past J2000 at which */ -/* the sub-observer point on the target body is to be */ -/* computed. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the observer-target state. ABCORR */ -/* may be any of the following. */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric sub-observer point on the */ -/* target body. */ - -/* 'LT' Correct for planetary (light time) */ -/* aberration. Both the state and rotation */ -/* of the target body are corrected for */ -/* light time. */ - -/* 'LT+S' Correct for planetary (light time) and */ -/* stellar aberrations. Both the state and */ -/* rotation of the target body are */ -/* corrected for light time. */ - -/* 'CN' Converged Newtonian light time */ -/* corrections. This is the same as LT */ -/* corrections but with further iterations */ -/* to a converged Newtonian light time */ -/* solution. Given that relativistic */ -/* effects may be as large as the higher */ -/* accuracy achieved by this computation, */ -/* this is correction is seldom worth the */ -/* additional computations required unless */ -/* the user incorporates additional */ -/* relativistic corrections. Both the */ -/* state and rotation of the target body */ -/* are corrected for light time. */ - -/* 'CN+S' Converged Newtonian light time */ -/* corrections and stellar aberration. */ -/* Both the state and rotation of the */ -/* target body are corrected for light */ -/* time. */ - -/* OBSRVR is the name of the observing body. This is typically */ -/* a spacecraft, the earth, or a surface point on the */ -/* earth. Optionally, you may supply the ID code of */ -/* the object as an integer string. For example, both */ -/* 'EARTH' and '399' are legitimate strings to supply */ -/* to indicate the observer is Earth. */ - -/* $ Detailed_Output */ - -/* SPOINT is the sub-observer point on the target body at ET */ -/* expressed relative to the body-fixed frame of the */ -/* target body. */ - -/* The sub-observer point is defined either as the point */ -/* on the target body that is closest to the observer, */ -/* or the target surface intercept of the line from the */ -/* observer to the target's center; the input argument */ -/* METHOD selects the definition to be used. */ - -/* The body-fixed frame, which is time-dependent, is */ -/* evaluated at ET if ABCORR is 'NONE'; otherwise the */ -/* frame is evaluated at ET-LT, where LT is the one-way */ -/* light time from target to observer. */ - -/* The state of the target body is corrected for */ -/* aberration as specified by ABCORR; the corrected */ -/* state is used in the geometric computation. As */ -/* indicated above, the rotation of the target is */ -/* retarded by one-way light time if ABCORR specifies */ -/* that light time correction is to be done. */ - - -/* ALT is the "altitude" of the observer above the target */ -/* body. When METHOD specifies a "near point" */ -/* computation, ALT is truly altitude in the standard */ -/* geometric sense: the length of a segment dropped from */ -/* the observer to the target's surface, such that the */ -/* segment is perpendicular to the surface at the */ -/* contact point SPOINT. */ - -/* When METHOD specifies an "intercept" computation, ALT */ -/* is still the length of the segment from the observer */ -/* to the surface point SPOINT, but this segment in */ -/* general is not perpendicular to the surface. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If any of the listed errors occur, the output arguments are */ -/* left unchanged. */ - - -/* 1) If the input argument METHOD is not recognized, the error */ -/* SPICE(DUBIOUSMETHOD) is signaled. */ - -/* 2) If either of the input body names TARGET or OBSRVR cannot be */ -/* mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */ -/* is signaled. */ - -/* 3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */ -/* error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If frame definition data enabling the evaluation of the state */ -/* of the target relative to the observer in target body-fixed */ -/* coordinates have not been loaded prior to calling SUBPT, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 5) If the specified aberration correction is not recognized, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 6) If insufficient ephemeris data have been loaded prior to */ -/* calling SUBPT, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. */ - -/* 7) If the triaxial radii of the target body have not been loaded */ -/* into the kernel pool prior to calling SUBPT, the error will be */ -/* diagnosed and signaled by a routine in the call tree of this */ -/* routine. */ - -/* 8) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be diagnosed */ -/* and signaled by routines in the call tree of this routine. */ - -/* 9) If PCK data supplying a rotation model for the target body */ -/* have not been loaded prior to calling SUBPT, the error will be */ -/* diagnosed and signaled by a routine in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* Appropriate SPK, PCK, and frame kernels must be loaded */ -/* prior by the calling program before this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must */ -/* be loaded. These may be provided in a text or binary PCK */ -/* file. Either type of file may be loaded via FURNSH. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the body-fixed frame of */ -/* the target, that definition must be available in the kernel */ -/* pool. Typically the definition is supplied by loading a */ -/* frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* SUBPT computes the sub-observer point on a target body. */ -/* (The sub-observer point is commonly called the sub-spacecraft */ -/* point when the observer is a spacecraft.) SUBPT also */ -/* determines the altitude of the observer above the target body. */ - -/* There are two different popular ways to define the sub-observer */ -/* point: "nearest point on target to observer" or "target surface */ -/* intercept of line containing observer and target." These */ -/* coincide when the target is spherical and generally are distinct */ -/* otherwise. */ - -/* When comparing sub-point computations with results from sources */ -/* other than SPICE, it's essential to make sure the same geometric */ -/* definitions are used. */ - -/* $ Examples */ - -/* The numerical results shown for this example may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* In the following example program, the file */ - -/* spk_m_031103-040201_030502.bsp */ - -/* is a binary SPK file containing data for Mars Global Surveyor, */ -/* Mars, and the Sun for a time interval bracketing the date */ - -/* 2004 JAN 1 12:00:00 UTC. */ - -/* pck00007.tpc is a planetary constants kernel file containing */ -/* radii and rotation model constants. naif0007.tls is a */ -/* leapseconds kernel. */ - -/* Find the sub-observer point of the Mars Global Surveyor (MGS) */ -/* spacecraft on Mars for a specified time. Perform the computation */ -/* twice, using both the "intercept" and "near point" options. */ - - -/* IMPLICIT NONE */ - -/* CHARACTER*25 METHOD ( 2 ) */ - -/* INTEGER I */ - -/* DOUBLE PRECISION ALT */ -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ - -/* DATA METHOD / 'Intercept', 'Near point' / */ - -/* C */ -/* C Load kernel files. */ -/* C */ -/* CALL FURNSH ( 'naif0007.tls' ) */ -/* CALL FURNSH ( 'pck00007.tpc' ) */ -/* CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */ - -/* C */ -/* C Convert the UTC request time to ET (seconds past */ -/* C J2000, TDB). */ -/* C */ -/* CALL STR2ET ( '2004 JAN 1 12:00:00', ET ) */ - -/* C */ -/* C Compute sub-spacecraft point using light time and stellar */ -/* C aberration corrections. Use the "target surface intercept" */ -/* C definition of sub-spacecraft point on the first loop */ -/* C iteration, and use the "near point" definition on the */ -/* C second. */ -/* C */ -/* DO I = 1, 2 */ - -/* CALL SUBPT ( METHOD(I), */ -/* . 'MARS', ET, 'LT+S', */ -/* . 'MGS', SPOINT, ALT ) */ - -/* C */ -/* C Convert rectangular coordinates to planetocentric */ -/* C latitude and longitude. Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */ - -/* LON = LON * DPR () */ -/* LAT = LAT * DPR () */ - -/* C */ -/* C Write the results. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Computation method: ', METHOD(I) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Radius (km) = ', RADIUS */ -/* WRITE (*,*) ' Planetocentric Latitude (deg) = ', LAT */ -/* WRITE (*,*) ' Planetocentric Longitude (deg) = ', LON */ -/* WRITE (*,*) ' Altitude (km) = ', ALT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* When this program is executed, the output will be: */ - - -/* Computation method: Intercept */ - -/* Radius (km) = 3387.97077 */ -/* Planetocentric Latitude (deg) = -39.7022724 */ -/* Planetocentric Longitude (deg) = -159.226663 */ -/* Altitude (km) = 373.173506 */ - - -/* Computation method: Near point */ - -/* Radius (km) = 3387.9845 */ -/* Planetocentric Latitude (deg) = -39.6659329 */ -/* Planetocentric Longitude (deg) = -159.226663 */ -/* Altitude (km) = 373.166636 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.3, 18-MAY-2010 (BVS) */ - -/* Index line now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */ - -/* Typo correction in Required_Reading, changed */ -/* FRAME to FRAMES. */ - -/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */ - -/* Abstract now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */ - -/* Replaced call to BODVAR with call to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 21-JUL-2004 (EDW) */ - -/* Changed BODN2C call to BODS2C giving the routine */ -/* the capability to accept string representations of */ -/* interger IDs for TARGET and OBSRVR. */ - -/* - SPICELIB Version 1.0.1, 27-JUL-2003 (NJB) (CHA) */ - -/* Various header corrections were made. The example program */ -/* was upgraded to use real kernels, and the program's output is */ -/* shown. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED sub-observer point */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SUBPT", (ftnlen)5); - } - -/* Obtain integer codes for the target and observer. */ - -/* Target... */ - - bods2c_(target, &trgcde, &found, target_len); - if (! found) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBPT", (ftnlen)5); - return 0; - } - -/* ...observer. */ - - bods2c_(obsrvr, &obscde, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBPT", (ftnlen)5); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the sub-observer point, the observing body and" - " target body are the same. Both are #.", (ftnlen)97); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("SUBPT", (ftnlen)5); - return 0; - } - -/* Get the radii of the target body from the kernel pool. */ - - bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5); - -/* Find the name of the body-fixed frame associated with the */ -/* target body. We'll want the state of the target relative to */ -/* the observer in this body-fixed frame. */ - - cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80); - if (! found) { - setmsg_("No body-fixed frame is associated with target body #; a fra" - "me kernel must be loaded to make this association. Consult " - "the FRAMES Required Reading for details.", (ftnlen)159); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SUBPT", (ftnlen)5); - return 0; - } - -/* Determine the position of the observer in target */ -/* body-fixed coordinates. */ - -/* - Call SPKEZR to compute the position of the target */ -/* body as seen from the observing body and the light time */ -/* (LT) between them. SPKEZR returns a state which is */ -/* the position and velocity, but we'll only use the position */ -/* which is the first three elements. We request that the */ -/* coordinates of POS be returned relative to the body fixed */ -/* reference frame associated with the target body, using */ -/* aberration corrections specified by the input argument */ -/* ABCORR. */ - -/* - Call VMINUS to negate the direction of the vector (POS) */ -/* so it will be the position of the observer as seen from */ -/* the target body in target body fixed coordinates. */ - -/* Note that this result is not the same as the result of */ -/* calling SPKEZR with the target and observer switched. We */ -/* computed the vector FROM the observer TO the target in */ -/* order to get the proper light time and stellar aberration */ -/* corrections (if requested). Now we need the inverse of */ -/* that corrected vector in order to compute the sub-point. */ - - spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, <, (ftnlen)80, - abcorr_len); - -/* Negate the target's state to obtain the position of the observer */ -/* relative to the target. */ - - vminus_(tstate, pos); - -/* Find the sub-point and "altitude" (distance from observer to */ -/* sub-point) using the specified geometric definition. */ - - if (eqstr_(method, "Near point", method_len, (ftnlen)10)) { - -/* Locate the nearest point to the observer on the target. */ - - nearpt_(pos, radii, &radii[1], &radii[2], spoint, alt); - } else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) { - surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found); - -/* Since the line in question passes through the center of the */ -/* target, there will always be a surface intercept. So we should */ -/* never have FOUND = .FALSE. */ - - if (! found) { - setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex " - "of ray is at target center. This indicates a bug. Please" - " contact NAIF.", (ftnlen)125); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("SUBPT", (ftnlen)5); - return 0; - } - -/* SURFPT doesn't compute altitude, so do it here. */ - - *alt = vdist_(pos, spoint); - } else { - setmsg_("The computation method # was not recognized. Allowed values" - " are \"Near point\" and \"Intercept.\"", (ftnlen)93); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20); - chkout_("SUBPT", (ftnlen)5); - return 0; - } - chkout_("SUBPT", (ftnlen)5); - return 0; -} /* subpt_ */ - diff --git a/ext/spice/src/cspice/subpt_c.c b/ext/spice/src/cspice/subpt_c.c deleted file mode 100644 index eac35c16fe..0000000000 --- a/ext/spice/src/cspice/subpt_c.c +++ /dev/null @@ -1,514 +0,0 @@ -/* - --Procedure subpt_c ( Sub-observer point ) - --Abstract - - Deprecated: This routine has been superseded by the CSPICE - routine subpnt_c. This routine is supported for purposes of - backward compatibility only. - - Compute the rectangular coordinates of the sub-observer point on - a target body at a particular epoch, optionally corrected for - planetary (light time) and stellar aberration. Return these - coordinates expressed in the body-fixed frame associated with the - target body. Also, return the observer's altitude above the - target body. - --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 - - FRAMES - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void subpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * alt ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - abcorr I Aberration correction. - obsrvr I Name of observing body. - spoint O Sub-observer point on the target body. - alt O Altitude of the observer above the target body. - --Detailed_Input - - method is a short string specifying the computation method - to be used. The choices are: - - "Near point" The sub-observer point is - defined as the nearest point on - the target relative to the - observer. - - "Intercept" The sub-observer point is - defined as the target surface - intercept of the line - containing the observer and the - target's center. - - In both cases, the intercept computation treats the - surface of the target body as a triaxial ellipsoid. - The ellipsoid's radii must be available in the kernel - pool. - - Neither case nor white space are significant in - `method'. For example, the string " NEARPOINT" is - valid. - - - target is the name of the target body. `target' is - case-insensitive, and leading and trailing blanks in - `target' are not significant. Optionally, you may supply - a string containing the integer ID code for the object. - For example both "MOON" and "301" are legitimate strings - that indicate the moon is the target body. - - This routine assumes that the target body is modeled by - a tri-axial ellipsoid, and that a PCK file containing - its radii has been loaded into the kernel pool via - furnsh_c. - - - et is the epoch in ephemeris seconds past J2000 at which - the sub-observer point on the target body is to be - computed. - - - abcorr indicates the aberration corrections to be applied - when computing the observer-target state. `abcorr' - may be any of the following. - - "NONE" Apply no correction. Return the - geometric sub-observer point on the - target body. - - "LT" Correct for planetary (light time) - aberration. Both the state and rotation - of the target body are corrected for - light time. - - "LT+S" Correct for planetary (light time) and - stellar aberrations. Both the state and - rotation of the target body are - corrected for light time. - - "CN" Converged Newtonian light time - corrections. This is the same as LT - corrections but with further iterations - to a converged Newtonian light time - solution. Given that relativistic - effects may be as large as the higher - accuracy achieved by this computation, - this is correction is seldom worth the - additional computations required unless - the user incorporates additional - relativistic corrections. Both the - state and rotation of the target body - are corrected for light time. - - "CN+S" Converged Newtonian light time - corrections and stellar aberration. - Both the state and rotation of the - target body are corrected for light - time. - - obsrvr is the name of the observing body. This is typically a - spacecraft, the earth, or a surface point on the earth. - `obsrvr' is case-insensitive, and leading and trailing - blanks in `obsrvr' are not significant. Optionally, you - may supply a string containing the integer ID code for - the object. For example both "EARTH" and "399" are - legitimate strings that indicate the earth is the - observer. - --Detailed_Output - - spoint is the sub-observer point on the target body at `et' - expressed relative to the body-fixed frame of the - target body. - - The sub-observer point is defined either as the point - on the target body that is closest to the observer, - or the target surface intercept of the line from the - observer to the target's center; the input argument - `method' selects the definition to be used. - - The body-fixed frame, which is time-dependent, is - evaluated at `et' if `abcorr' is "NONE"; otherwise the - frame is evaluated at et-lt, where `lt' is the one-way - light time from target to observer. - - The state of the target body is corrected for - aberration as specified by `abcorr'; the corrected - state is used in the geometric computation. As - indicated above, the rotation of the target is - retarded by one-way light time if `abcorr' specifies - that light time correction is to be done. - - alt is the "altitude" of the observer above the target - body. When `method' specifies a "near point" - computation, `alt' is truly altitude in the standard - geometric sense: the length of a segment dropped from - the observer to the target's surface, such that the - segment is perpendicular to the surface at the - contact point `spoint'. - - When `method' specifies an "intercept" computation, `alt' - is still the length of the segment from the observer - to the surface point `spoint', but this segment in - general is not perpendicular to the surface. - --Parameters - - None. - --Exceptions - - If any of the listed errors occur, the output arguments are - left unchanged. - - - 1) If the input argument `method' is not recognized, the error - SPICE(DUBIOUSMETHOD) is signaled. - - 2) If either of the input body names `target' or `obsrvr' cannot be - mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) - is signaled. - - 3) If `obsrvr' and `target' map to the same NAIF integer ID codes, the - error SPICE(BODIESNOTDISTINCT) is signaled. - - 4) If frame definition data enabling the evaluation of the state - of the target relative to the observer in target body-fixed - coordinates have not been loaded prior to calling subpt_c, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 5) If the specified aberration correction is not recognized, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 6) If insufficient ephemeris data have been loaded prior to - calling subpt_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. - - 7) If the triaxial radii of the target body have not been loaded - into the kernel pool prior to calling subpt_c, the error will be - diagnosed and signaled by a routine in the call tree of this - routine. - - 8) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 9) If PCK data supplying a rotation model for the target body - have not been loaded prior to calling subpt_c, the error will be - diagnosed and signaled by a routine in the call tree of this - routine. - --Files - - Appropriate SPK, PCK, and frame data must be available to - the calling program before this routine is called. Typically - the data are made available by loading kernels; however the - data may be supplied via subroutine interfaces if applicable. - - The following data are required: - - - SPK data: ephemeris data for target and observer must be - loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. - Typically ephemeris data are made available by loading one - or more SPK files via furnsh_c. - - - PCK data: triaxial radii for the target body must be loaded - into the kernel pool. Typically this is done by loading a - text PCK file via furnsh_c. - - - Further PCK data: rotation data for the target body must - be loaded. These may be provided in a text or binary PCK file. - Either type of file may be loaded via furnsh_c - - - Frame data: if a frame definition is required to convert - the observer and target states to the body-fixed frame of - the target, that definition must be available in the kernel - pool. Typically the definition is supplied by loading a - frame kernel via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - subpt_c computes the sub-observer point on a target body. - (The sub-observer point is commonly called the sub-spacecraft - point when the observer is a spacecraft.) subpt_c also - determines the altitude of the observer above the target body. - - There are two different popular ways to define the sub-observer - point: "nearest point on target to observer" or "target surface - intercept of line containing observer and target." These - coincide when the target is spherical and generally are distinct - otherwise. - - When comparing sub-point computations with results from sources - other than SPICE, it's essential to make sure the same geometric - definitions are used. - --Examples - - The numerical results shown for this example may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - In the following example program, the file - - spk_m_031103-040201_030502.bsp - - is a binary SPK file containing data for Mars Global Surveyor, - Mars, and the Sun for a time interval bracketing the date - - 2004 JAN 1 12:00:00 UTC. - - pck00007.tpc is a planetary constants kernel file containing - radii and rotation model constants. naif0007.tls is a - leapseconds kernel. - - Find the sub-observer point of the Mars Global Surveyor (MGS) - spacecraft on Mars for a specified time. Perform the computation - twice, using both the "intercept" and "near point" options. - - #include - #include "SpiceUsr.h" - - int main () - { - #define METHODLEN 25 - - SpiceChar method [2][METHODLEN] = - { - "Intercept", "Near point" - }; - - SpiceDouble alt; - SpiceDouble et; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble radius; - SpiceDouble spoint [3]; - - SpiceInt i; - - - /. - Load kernel files. - ./ - furnsh_c ( "naif0007.tls" ); - furnsh_c ( "pck00007.tpc" ); - furnsh_c ( "spk_m_031103-040201_030502.bsp" ); - - /. - Convert the UTC request time to ET (seconds past J2000 TDB). - ./ - str2et_c ( "2004 JAN 1 12:00:00", &et ); - - /. - Compute sub-spacecraft point using light time and stellar - aberration corrections. Use the "target surface intercept" - definition of sub-spacecraft point on the first loop - iteration, and use the "near point" definition on the - second. - ./ - - for ( i = 0; i < 2; i++ ) - { - subpt_c ( method[i], - "MARS", et, "LT+S", - "MGS", spoint, &alt ); - - /. - Convert rectangular coordinates to planetocentric - latitude and longitude. Convert radians to degrees. - ./ - reclat_c ( spoint, &radius, &lon, &lat ); - - lon *= dpr_c (); - lat *= dpr_c (); - - /. - Write the results. - ./ - - printf ( "\n" - "Computation method: %s\n" - "\n" - " Radius (km) = %25.15e\n" - " Planetocentric Latitude (deg) = %25.15e\n" - " Planetocentric Longitude (deg) = %25.15e\n" - " Altitude (km) = %25.15e\n" - "\n", - method[i], - radius, - lat, - lon, - alt ); - } - - return ( 0 ); - } - - - When this program is executed, the output will be: - - - Computation method: Intercept - - Radius (km) = 3.387970765126046e+03 - Planetocentric Latitude (deg) = -3.970227239033073e+01 - Planetocentric Longitude (deg) = -1.592266633611679e+02 - Altitude (km) = 3.731735060549094e+02 - - - Computation method: Near point - - Radius (km) = 3.387984503271711e+03 - Planetocentric Latitude (deg) = -3.966593293571449e+01 - Planetocentric Longitude (deg) = -1.592266633611679e+02 - Altitude (km) = 3.731666361282019e+02 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - J.E. McLean (JPL) - --Version - - -CSPICE Version 1.0.4, 19-MAY-2010 (BVS) - - Index line now states that this routine is deprecated. - - -CSPICE Version 1.0.3, 07-FEB-2008 (NJB) - - Abstract now states that this routine is deprecated. - - -CSPICE Version 1.0.2, 22-JUL-2004 (NJB) - - Updated header to indicate that the `target' and `observer' - input arguments can now contain string representations of - integers. - - -CSPICE Version 1.0.1, 27-JUL-2003 (NJB) (CHA) - - Various header corrections were made. The example program - was upgraded to use real kernels, and the program's output is - shown. - - -CSPICE Version 1.0.0, 31-MAY-1999 (NJB) (JEM) - --Index_Entries - - DEPRECATED sub-observer point - --& -*/ - -{ /* Begin subpt_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "subpt_c" ); - - - /* - Check the input strings: method, target, abcorr, and obsrvr. Make - sure none of the pointers are null and that each string contains at - least one non-null character. - */ - CHKFSTR ( CHK_STANDARD, "subpt_c", method ); - CHKFSTR ( CHK_STANDARD, "subpt_c", target ); - CHKFSTR ( CHK_STANDARD, "subpt_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "subpt_c", obsrvr ); - - - /* - Call the f2c'd routine. - */ - subpt_ ( ( char * ) method, - ( char * ) target, - ( doublereal * ) &et, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) spoint, - ( doublereal * ) alt, - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - - chkout_c ( "subpt_c" ); - -} /* End subpt_c */ diff --git a/ext/spice/src/cspice/subslr.c b/ext/spice/src/cspice/subslr.c deleted file mode 100644 index 4207d36396..0000000000 --- a/ext/spice/src/cspice/subslr.c +++ /dev/null @@ -1,1586 +0,0 @@ -/* subslr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__2 = 2; -static integer c__3 = 3; -static integer c__10 = 10; - -/* $Procedure SUBSLR ( Sub-solar point ) */ -/* Subroutine */ int subslr_(char *method, char *target, doublereal *et, char - *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal * - trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, - ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* Initialized data */ - - static logical elipsd = TRUE_; - static logical first = TRUE_; - static logical near__ = TRUE_; - static char prvcor[5] = " "; - static char prvmth[80] = "Near point: Ellipsoid " - " "; - - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal sdir[3]; - integer nitr; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer type__; - static logical xmit; - doublereal spos[3], tpos[3]; - extern /* Subroutine */ int mtxv_(doublereal *, doublereal *, doublereal * - ); - doublereal j2pos[3]; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal s, radii[3], range; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical usecn; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal vtemp[3], xform[9] /* was [3][3] */; - static logical uselt; - char words[32*2]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - doublereal corvj2[3], subvj2[3]; - extern logical failed_(void); - integer refcde; - doublereal lt, etdiff; - integer obscde; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer nw, nradii; - doublereal ltdiff; - extern doublereal clight_(void); - integer trgcde; - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *); - integer center; - extern doublereal touchd_(doublereal *); - char locmth[80]; - doublereal subvec[3], stloff[3]; - integer typeid; - logical attblk[15]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal altsun, corpos[3]; - extern logical return_(void); - doublereal obspos[3], prevet, prevlt, ssbost[6], ssbtst[6]; - static logical usestl; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *, - integer *, integer *, integer *, logical *), errint_(char *, - integer *, ftnlen), cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), lparse_(char *, char *, integer *, - integer *, char *, ftnlen, ftnlen, ftnlen), spkezp_(integer *, - doublereal *, char *, char *, integer *, doublereal *, doublereal - *, ftnlen, ftnlen), vminus_(doublereal *, doublereal *), nearpt_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *), surfpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, logical *) - , spkssb_(integer *, doublereal *, char *, doublereal *, ftnlen), - pxform_(char *, char *, doublereal *, doublereal *, ftnlen, - ftnlen); - logical fnd; - doublereal alt, slt; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Compute the rectangular coordinates of the sub-solar point on */ -/* a target body at a specified epoch, optionally corrected for */ -/* light time and stellar aberration. */ - -/* This routine supersedes SUBSOL. */ - -/* $ 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 */ - -/* FRAMES */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* FIXREF I Body-fixed, body-centered target body frame. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* SPOINT O Sub-solar point on the target body. */ -/* TRGEPC O Sub-solar point epoch. */ -/* SRFVEC O Vector from observer to sub-solar point. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. */ - -/* The supported values of METHOD are listed below. */ -/* Please note that the colon is a required delimiter; */ -/* using a blank will not work. */ - -/* 'Near point: ellipsoid' The sub-solar point */ -/* computation uses a */ -/* triaxial ellipsoid to */ -/* model the surface of the */ -/* target body. The */ -/* sub-solar point is */ -/* defined as the nearest */ -/* point on the target */ -/* relative to the Sun. */ - -/* 'Intercept: ellipsoid' The sub-solar point */ -/* computation uses a */ -/* triaxial ellipsoid to */ -/* model the surface of the */ -/* target body. The */ -/* sub-solar point is */ -/* defined as the target */ -/* surface intercept of the */ -/* line containing the Sun */ -/* and the target's center. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string */ - -/* ' nearpoint:ELLIPSOID ' */ - -/* is valid. */ - - -/* TARGET is the name of the target body. The target body is */ -/* an ephemeris object (its trajectory is given by */ -/* SPK data), and is an extended object. */ - -/* The string TARGET is case-insensitive, and leading */ -/* and trailing blanks in TARGET are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'MOON' and '301' are legitimate strings that indicate */ -/* the Moon is the target body. */ - -/* When the target body's surface is represented by a */ -/* tri-axial ellipsoid, this routine assumes that a */ -/* kernel variable representing the ellipsoid's radii is */ -/* present in the kernel pool. Normally the kernel */ -/* variable would be defined by loading a PCK file. */ - - -/* ET is the epoch of participation of the observer, */ -/* expressed as ephemeris seconds past J2000 TDB: ET is */ -/* the epoch at which the observer's state is computed. */ - -/* When aberration corrections are not used, ET is also */ -/* the epoch at which the position and orientation of */ -/* the target body and the position of the Sun are */ -/* computed. */ - -/* When aberration corrections are used, ET is the epoch */ -/* at which the observer's state relative to the solar */ -/* system barycenter is computed; in this case the */ -/* position and orientation of the target body are */ -/* computed at ET-LT, where LT is the one-way light time */ -/* between the sub-solar point and the observer. See the */ -/* description of ABCORR below for details. */ - - -/* FIXREF is the name of the body-fixed, body-centered */ -/* reference frame associated with the target body. The */ -/* output sub-solar point SPOINT will be expressed */ -/* relative to this reference frame. The string FIXREF */ -/* is case-insensitive, and leading and trailing blanks */ -/* in FIXREF are not significant. */ - - -/* ABCORR indicates the aberration correction to be applied */ -/* when computing the target position and orientation */ -/* and the position of the Sun. */ - -/* For remote sensing applications, where the apparent */ -/* sub-solar point seen by the observer is desired, */ -/* normally either of the corrections */ - -/* 'LT+S' */ -/* 'CN+S' */ - -/* should be used. These and the other supported options */ -/* are described below. ABCORR may be any of the */ -/* following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric sub-solar point on the target */ -/* body. */ - -/* Let LT represent the one-way light time between the */ -/* observer and the sub-solar point (note: NOT between */ -/* the observer and the target body's center). The */ -/* following values of ABCORR apply to the "reception" */ -/* case in which photons depart from the sub-solar */ -/* point's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the location of sub-solar */ -/* point at the moment it emitted photons */ -/* arriving at the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation. The solution invoked by the */ -/* 'LT' option uses one iteration. */ - -/* The target position and orientation as */ -/* seen by the observer are corrected for */ -/* light time. The position of the Sun */ -/* relative to the target is corrected for */ -/* one-way light time between the Sun and */ -/* target. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* sub-solar point obtained with the 'LT' */ -/* option to account for the observer's */ -/* velocity relative to the solar system */ -/* barycenter. These corrections yield */ -/* the apparent sub-solar point. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges. Both the */ -/* position and rotation of the target */ -/* body, and the position of the Sun, are */ -/* corrected for light time. */ - -/* 'CN+S' Converged Newtonian light time and */ -/* stellar aberration corrections. This */ -/* option produces a solution that is at */ -/* least as accurate at that obtainable */ -/* with the 'LT+S' option. Whether the */ -/* 'CN+S' solution is substantially more */ -/* accurate depends on the geometry of the */ -/* participating objects and on the */ -/* accuracy of the input data. In all */ -/* cases this routine will execute more */ -/* slowly when a converged solution is */ -/* computed. */ - -/* Neither case nor white space are significant in */ -/* ABCORR. For example, the string */ - -/* 'Lt + s' */ - -/* is valid. */ - - -/* OBSRVR is the name of the observing body. The observing body */ -/* is an ephemeris object: it typically is a spacecraft, */ -/* the earth, or a surface point on the earth. OBSRVR is */ -/* case-insensitive, and leading and trailing blanks in */ -/* OBSRVR are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the Moon is the */ -/* observer. */ - -/* $ Detailed_Output */ - - -/* SPOINT is the sub-solar point on the target body. */ - -/* The sub-solar point is defined either as the point */ -/* on the target body that is closest to the Sun, */ -/* or the target surface intercept of the line from the */ -/* Sun to the target's center; the input argument */ -/* METHOD selects the definition to be used. */ - -/* SPOINT is expressed in Cartesian coordinates, */ -/* relative to the body-fixed target frame designated by */ -/* FIXREF. The body-fixed target frame is evaluated at */ -/* the sub-solar point epoch TRGEPC (see description */ -/* below). */ - -/* When aberration corrections are used, SPOINT is */ -/* computed using target body position and orientation */ -/* that have been adjusted for the corrections */ -/* applicable to SPOINT itself rather than to the target */ -/* body's center. In particular, if the stellar */ -/* aberration correction applicable to SPOINT is */ -/* represented by a shift vector S, then the light-time */ -/* corrected position of the target is shifted by S */ -/* before the sub-solar point is computed. */ - -/* The components of SPOINT have units of km. */ - - -/* TRGEPC is the "sub-solar point epoch." TRGEPC is defined as */ -/* follows: letting LT be the one-way light time between */ -/* the observer and the sub-solar point, TRGEPC is */ -/* either the epoch ET-LT or ET depending on whether the */ -/* requested aberration correction is, respectively, for */ -/* received radiation or omitted. LT is computed using */ -/* the method indicated by ABCORR. */ - -/* TRGEPC is expressed as seconds past J2000 TDB. */ - - -/* SRFVEC is the vector from the observer's position at ET to */ -/* the aberration-corrected (or optionally, geometric) */ -/* position of SPOINT, where the aberration corrections */ -/* are specified by ABCORR. SRFVEC is expressed in the */ -/* target body-fixed reference frame designated by */ -/* FIXREF, evaluated at TRGEPC. */ - -/* The components of SRFVEC are given in units of km. */ - -/* One can use the SPICELIB function VNORM to obtain the */ -/* distance between the observer and SPOINT: */ - -/* DIST = VNORM ( SRFVEC ) */ - -/* The observer's position OBSPOS, relative to the */ -/* target body's center, where the center's position is */ -/* corrected for aberration effects as indicated by */ -/* ABCORR, can be computed via the call: */ - -/* CALL VSUB ( SPOINT, SRFVEC, OBSPOS ) */ - -/* To transform the vector SRFVEC to a time-dependent */ -/* reference frame REF at ET, a sequence of two frame */ -/* transformations is required. For example, let MFIX */ -/* and MREF be 3x3 matrices respectively describing the */ -/* target body-fixed to J2000 frame transformation at */ -/* TRGEPC and the J2000 to (time-dependent frame) REF */ -/* transformation at ET, and let XFORM be the 3x3 matrix */ -/* representing the composition of MREF with MFIX. Then */ -/* SRFVEC can be transformed to the result REFVEC as */ -/* follows: */ - -/* CALL PXFORM ( FIXREF, 'J2000', TRGEPC, MFIX ) */ -/* CALL PXFORM ( 'J2000', REF, ET, MREF ) */ -/* CALL MXM ( MREF, MFIX, XFORM ) */ -/* CALL MXV ( XFORM, SRFVEC, REFVEC ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) If the specified aberration correction is relativistic or */ -/* calls for stellar aberration but not light time correction, */ -/* the error SPICE(NOTSUPPORTED) is signaled. If the specified */ -/* aberration correction is any other unrecognized value, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 2) If either the target or observer input strings cannot be */ -/* converted to an integer ID code, the error */ -/* SPICE(IDCODENOTFOUND) is signaled. */ - -/* 3) If OBSRVR and TARGET map to the same NAIF integer ID code, */ -/* the error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If the input target body-fixed frame FIXREF is not */ -/* recognized, the error SPICE(NOFRAME) is signaled. A frame */ -/* name may fail to be recognized because a required frame */ -/* specification kernel has not been loaded; another cause is a */ -/* misspelling of the frame name. */ - -/* 5) If the input frame FIXREF is not centered at the target body, */ -/* the error SPICE(INVALIDFRAME) is signaled. */ - -/* 6) If the input argument METHOD is not recognized, the error */ -/* SPICE(INVALIDMETHOD) is signaled. */ - -/* 7) If the target and observer have distinct identities but are */ -/* at the same location (for example, the target is Mars and the */ -/* observer is the Mars barycenter), the error */ -/* SPICE(NOSEPARATION) is signaled. */ - -/* 8) If insufficient ephemeris data have been loaded prior to */ -/* calling SUBSLR, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. Note that when */ -/* light time correction is used, sufficient ephemeris data must */ -/* be available to propagate the states of observer, target, and */ -/* the Sun to the solar system barycenter. */ - -/* 9) If the computation method specifies an ellipsoidal target */ -/* shape and triaxial radii of the target body have not been */ -/* loaded into the kernel pool prior to calling SUBSLR, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 10) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be */ -/* diagnosed and signaled by routines in the call tree of this */ -/* routine. */ - -/* 11) If PCK data specifying the target body-fixed frame */ -/* orientation have not been loaded prior to calling SUBSLR, */ -/* the error will be diagnosed and signaled by a routine in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target, observer, and */ -/* Sun must be loaded. If aberration corrections are used, the */ -/* states of target, observer, and the Sun relative to the */ -/* solar system barycenter must be calculable from the */ -/* available ephemeris data. Typically ephemeris data are made */ -/* available by loading one or more SPK files via FURNSH. */ - -/* - PCK data: if the target body shape is modeled as an */ -/* ellipsoid, triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must be */ -/* loaded. These may be provided in a text or binary PCK file. */ - -/* - Frame data: if a frame definition is required to convert the */ -/* observer and target states to the body-fixed frame of the */ -/* target, that definition must be available in the kernel */ -/* pool. Typically the definition is supplied by loading a */ -/* frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* There are two different popular ways to define the sub-solar */ -/* point: "nearest point on target to the Sun" or "target surface */ -/* intercept of the line containing the Sun and target." These */ -/* coincide when the target is spherical and generally are distinct */ -/* otherwise. */ - -/* This routine computes light time corrections using light time */ -/* between the observer and the sub-solar point, as opposed to the */ -/* center of the target. Similarly, stellar aberration corrections */ -/* done by this routine are based on the direction of the vector */ -/* from the observer to the light-time corrected sub-solar point, */ -/* not to the target center. This technique avoids errors due to the */ -/* differential between aberration corrections across the target */ -/* body. Therefore it's valid to use aberration corrections with */ -/* this routine even when the observer is very close to the */ -/* sub-solar point, in particular when the observer to sub-solar */ -/* point distance is much less than the observer to target center */ -/* distance. */ - -/* The definition of the aberration-corrected sub-solar point is */ -/* implicit: SPOINT is defined by an equation of the general form */ - -/* SPOINT = F ( SPOINT ) */ - -/* Because of the contraction properties of both light time and */ -/* stellar aberration corrections---that is, the difference in the */ -/* corrections for two vectors is much smaller than the difference */ -/* between the vectors themselves---it's easy to solve this equation */ -/* accurately and fairly quickly. */ - -/* When comparing sub-solar point computations with results from */ -/* sources other than SPICE, it's essential to make sure the same */ -/* geometric definitions are used. */ - -/* $ Examples */ - - -/* The numerical results shown for this example may differ across */ -/* platforms. The results depend on the SPICE kernels used as input, */ -/* the compiler and supporting libraries, and the machine specific */ -/* arithmetic implementation. */ - - -/* 1) Find the sub-solar point on Mars as seen from the Earth for a */ -/* specified time. Perform the computation twice, using both the */ -/* "intercept" and "near point" options. Display the locations of */ -/* the Sun and the sub-solar point using both planetocentric */ -/* and planetographic coordinates. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* Example code begins here. */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C SPICELIB functions */ -/* C */ -/* DOUBLE PRECISION DPR */ -/* C */ -/* C Local parameters */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.tm' ) */ - -/* CHARACTER*(*) FM */ -/* PARAMETER ( FM = '(A,F21.9)' ) */ - -/* INTEGER MTHLEN */ -/* PARAMETER ( MTHLEN = 50 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* CHARACTER*(MTHLEN) METHOD ( 2 ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION F */ -/* DOUBLE PRECISION RADII ( 3 ) */ -/* DOUBLE PRECISION RE */ -/* DOUBLE PRECISION RP */ -/* DOUBLE PRECISION SPCLAT */ -/* DOUBLE PRECISION SPCLON */ -/* DOUBLE PRECISION SPCRAD */ -/* DOUBLE PRECISION SPGALT */ -/* DOUBLE PRECISION SPGLAT */ -/* DOUBLE PRECISION SPGLON */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ -/* DOUBLE PRECISION SRFVEC ( 3 ) */ -/* DOUBLE PRECISION SUNLT */ -/* DOUBLE PRECISION SUNPOS ( 3 ) */ -/* DOUBLE PRECISION SUPCLN */ -/* DOUBLE PRECISION SUPCLT */ -/* DOUBLE PRECISION SUPCRD */ -/* DOUBLE PRECISION SUPGAL */ -/* DOUBLE PRECISION SUPGLN */ -/* DOUBLE PRECISION SUPGLT */ -/* DOUBLE PRECISION TRGEPC */ - -/* INTEGER I */ -/* INTEGER N */ -/* C */ -/* C Saved variables */ -/* C */ -/* SAVE METHOD */ -/* C */ -/* C Initial values */ -/* C */ -/* DATA METHOD / 'Intercept: ellipsoid', */ -/* . 'Near point: ellipsoid' / */ -/* C */ -/* C Load kernel files via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ - -/* C */ -/* C Convert the UTC request time to ET (seconds past */ -/* C J2000, TDB). */ -/* C */ -/* CALL STR2ET ( '2008 AUG 11 00:00:00', ET ) */ - -/* C */ -/* C Look up the target body's radii. We'll use these to */ -/* C convert Cartesian to planetographic coordinates. Use */ -/* C the radii to compute the flattening coefficient of */ -/* C the reference ellipsoid. */ -/* C */ -/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */ - -/* C */ -/* C Let RE and RP be, respectively, the equatorial and */ -/* C polar radii of the target. */ -/* C */ -/* RE = RADII( 1 ) */ -/* RP = RADII( 3 ) */ - -/* F = ( RE - RP ) / RE */ - -/* C */ -/* C Compute sub-solar point using light time and stellar */ -/* C aberration corrections. Use the "target surface intercept" */ -/* C definition of sub-solar point on the first loop */ -/* C iteration, and use the "near point" definition on the */ -/* C second. */ -/* C */ -/* DO I = 1, 2 */ - -/* CALL SUBSLR ( METHOD(I), */ -/* . 'MARS', ET, 'IAU_MARS', 'LT+S', */ -/* . 'EARTH', SPOINT, TRGEPC, SRFVEC ) */ -/* C */ -/* C Convert the sub-solar point's rectangular coordinates */ -/* C to planetographic longitude, latitude and altitude. */ -/* C Convert radians to degrees. */ -/* C */ -/* CALL RECPGR ( 'MARS', SPOINT, RE, F, */ -/* . SPGLON, SPGLAT, SPGALT ) */ - -/* SPGLON = SPGLON * DPR () */ -/* SPGLAT = SPGLAT * DPR () */ - -/* C */ -/* C Convert sub-solar point's rectangular coordinates to */ -/* C planetocentric radius, longitude, and latitude. Convert */ -/* C radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, SPCRAD, SPCLON, SPCLAT ) */ - -/* SPCLON = SPCLON * DPR () */ -/* SPCLAT = SPCLAT * DPR () */ - -/* C */ -/* C Compute the Sun's apparent position relative to the */ -/* C center of the target at TRGEPC. Express the Sun's */ -/* C location in planetographic coordinates. */ -/* C */ -/* CALL SPKPOS ( 'SUN', TRGEPC, 'IAU_MARS', 'LT+S', */ -/* . 'MARS', SUNPOS, SUNLT ) */ - -/* CALL RECPGR ( 'MARS', SUNPOS, RE, F, */ -/* . SUPGLN, SUPGLT, SUPGAL ) */ - -/* SUPGLN = SUPGLN * DPR () */ -/* SUPGLT = SUPGLT * DPR () */ - -/* C */ -/* C Convert the Sun's rectangular coordinates to */ -/* C planetocentric radius, longitude, and latitude. */ -/* C Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SUNPOS, SUPCRD, SUPCLN, SUPCLT ) */ - -/* SUPCLN = SUPCLN * DPR () */ -/* SUPCLT = SUPCLT * DPR () */ - -/* C */ -/* C Write the results. */ -/* C */ -/* WRITE(*,FM) ' ' */ -/* WRITE(*,* ) 'Computation method = ', METHOD(I) */ -/* WRITE(*,FM) ' ' */ -/* WRITE(*,FM) */ -/* . ' Sub-solar point altitude (km) = ', SPGALT */ -/* WRITE(*,FM) */ -/* . ' Sub-solar planetographic longitude (deg) = ', SPGLON */ -/* WRITE(*,FM) */ -/* . ' Sun''s planetographic longitude (deg) = ', SUPGLN */ -/* WRITE(*,FM) */ -/* . ' Sub-solar planetographic latitude (deg) = ', SPGLAT */ -/* WRITE(*,FM) */ -/* . ' Sun''s planetographic latitude (deg) = ', SUPGLT */ -/* WRITE(*,FM) */ -/* . ' Sub-solar planetocentric longitude (deg) = ', SPCLON */ -/* WRITE(*,FM) */ -/* . ' Sun''s planetocentric longitude (deg) = ', SUPCLN */ -/* WRITE(*,FM) */ -/* . ' Sub-solar planetocentric latitude (deg) = ', SPCLAT */ -/* WRITE(*,FM) */ -/* . ' Sun''s planetocentric latitude (deg) = ', SUPCLT */ -/* WRITE(*,FM) ' ' */ - -/* END DO */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - -/* Computation method = Intercept: ellipsoid */ - -/* Sub-solar point altitude (km) = 0.000000000 */ -/* Sub-solar planetographic longitude (deg) = 175.810721566 */ -/* Sun's planetographic longitude (deg) = 175.810721564 */ -/* Sub-solar planetographic latitude (deg) = 23.668550265 */ -/* Sun's planetographic latitude (deg) = 23.420823346 */ -/* Sub-solar planetocentric longitude (deg) = -175.810721566 */ -/* Sun's planetocentric longitude (deg) = -175.810721564 */ -/* Sub-solar planetocentric latitude (deg) = 23.420819920 */ -/* Sun's planetocentric latitude (deg) = 23.420819920 */ - - -/* Computation method = Near point: ellipsoid */ - -/* Sub-solar point altitude (km) = 0.000000000 */ -/* Sub-solar planetographic longitude (deg) = 175.810721552 */ -/* Sun's planetographic longitude (deg) = 175.810721550 */ -/* Sub-solar planetographic latitude (deg) = 23.420823346 */ -/* Sun's planetographic latitude (deg) = 23.420823346 */ -/* Sub-solar planetocentric longitude (deg) = -175.810721552 */ -/* Sun's planetocentric longitude (deg) = -175.810721550 */ -/* Sub-solar planetocentric latitude (deg) = 23.175085562 */ -/* Sun's planetocentric latitude (deg) = 23.420819920 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-MAY-2010 (NJB) */ - -/* Bug fix: calls to FAILED() have been added after */ -/* SPK calls, target radius lookup, near point */ -/* and surface intercept computations. */ - -/* - SPICELIB Version 1.0.1, 17-MAR-2009 (NJB) */ - -/* Typo correction: changed FIXFRM to FIXREF in header */ -/* documentation. Meta-kernel name suffix was changed to */ -/* ".tm" in header code example. */ - -/* Typo correction in Required_Reading, changed */ -/* FRAME to FRAMES. */ - -/* - SPICELIB Version 1.0.0, 02-MAR-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find sub-solar point on target body */ -/* find nearest point to sun on target body */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* This value will become system-dependent when systems */ -/* using 128-bit d.p. numbers are supported by SPICELIB. */ -/* CNVLIM, when added to 1.0D0, should yield 1.0D0. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SUBSLR", (ftnlen)6); - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* USESTL indicates stellar aberration corrections. */ - - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - -/* Reject an aberration correction flag calling for transmission */ -/* corrections. */ - - if (xmit) { - setmsg_("Aberration correction flag # calls for transmission-sty" - "le corrections.", (ftnlen)70); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Reject an aberration correction flag calling for stellar */ -/* aberration but not light time correction. */ - - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } else if (attblk[5]) { - -/* Also reject flags calling for relativistic corrections. */ - - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - } - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &fnd, target_len); - if (! fnd) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - bods2c_(obsrvr, &obscde, &fnd, obsrvr_len); - if (! fnd) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the sub-solar point, the observing body and ta" - "rget body are the same. Both are #.", (ftnlen)94); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Determine the attributes of the frame designated by FIXREF. */ - - namfrm_(fixref, &refcde, fixref_len); - frinfo_(&refcde, ¢er, &type__, &typeid, &fnd); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - if (! fnd) { - setmsg_("Reference frame # is not recognized by the SPICE frame subs" - "ystem. Possibly a required frame definition kernel has not b" - "een loaded.", (ftnlen)130); - errch_("#", fixref, (ftnlen)1, fixref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Make sure that FIXREF is centered at the target body's center. */ - - if (center != trgcde) { - setmsg_("Reference frame # is not centered at the target body #. The" - " ID code of the frame center is #.", (ftnlen)93); - errch_("#", fixref, (ftnlen)1, fixref_len); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", ¢er, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* If necessary, parse the method specification. PRVMTH */ -/* and the derived flags NEAR and ELIPSD start out with */ -/* valid values. PRVMTH records the last valid value of */ -/* METHOD; NEAR and ELIPSD are the corresponding flags. */ - - if (s_cmp(method, prvmth, method_len, (ftnlen)80) != 0) { - -/* Parse the computation method specification. Work with a local */ -/* copy of the method specification that contains no leading or */ -/* embedded blanks. */ - - cmprss_(" ", &c__0, method, locmth, (ftnlen)1, method_len, (ftnlen)80) - ; - ucase_(locmth, locmth, (ftnlen)80, (ftnlen)80); - lparse_(locmth, ":", &c__2, &nw, words, (ftnlen)80, (ftnlen)1, ( - ftnlen)32); - if (nw != 2) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBSLR for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* The text preceding the first delimiter indicates the */ -/* sub-observer point definition: "nearpoint" or "intercept." The */ -/* second word designates the target shape model. Recall that */ -/* we've removed all blanks from the input string, so we won't */ -/* see the string "near point." */ - -/* Check the sub-observer point definition. */ - - if (s_cmp(words, "NEARPOINT", (ftnlen)32, (ftnlen)9) != 0 && s_cmp( - words, "INTERCEPT", (ftnlen)32, (ftnlen)9) != 0) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBSLR for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Check the shape specification. */ - - if (s_cmp(words + 32, "ELLIPSOID", (ftnlen)32, (ftnlen)9) != 0) { - setmsg_("Computation method argument was <#>; this string must s" - "pecify a supported shape model and computation type. See" - " the header of SUBSLR for details.", (ftnlen)145); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* At this point the method specification has passed our tests. */ -/* Use the flag NEAR to indicate whether the computation type is */ -/* "near point." Use the flag ELIPSD to indicate that the shape */ -/* is modeled as an ellipsoid (which is true, for now). */ - - near__ = s_cmp(words, "NEARPOINT", (ftnlen)32, (ftnlen)9) == 0; - elipsd = TRUE_; - -/* Save the current value of METHOD. */ - - s_copy(prvmth, method, (ftnlen)80, method_len); - } - -/* Get the sign S prefixing LT in the expression for TRGEPC. */ -/* When light time correction is not used, setting S = 0 */ -/* allows us to seamlessly set TRGEPC equal to ET. */ - - if (uselt) { - s = -1.; - } else { - s = 0.; - } - -/* Determine the position of the observer in target body-fixed */ -/* coordinates. This is a first estimate. */ - -/* - Call SPKEZP to compute the position of the target body as */ -/* seen from the observing body and the light time (LT) */ -/* between them. We request that the coordinates of POS be */ -/* returned relative to the body fixed reference frame */ -/* associated with the target body, using aberration */ -/* corrections specified by the input argument ABCORR. */ - -/* - Call VMINUS to negate the direction of the vector (OBSPOS) */ -/* so it will be the position of the observer as seen from */ -/* the target body in target body fixed coordinates. */ - -/* Note that this result is not the same as the result of */ -/* calling SPKEZP with the target and observer switched. We */ -/* computed the vector FROM the observer TO the target in */ -/* order to get the proper light time and stellar aberration */ -/* corrections (if requested). Now we need the inverse of */ -/* that corrected vector in order to compute the sub-solar */ -/* point. */ - - spkezp_(&trgcde, et, fixref, abcorr, &obscde, tpos, <, fixref_len, - abcorr_len); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Negate the target's position to obtain the position of the */ -/* observer relative to the target. */ - - vminus_(tpos, obspos); - -/* Make a first estimate of the target epoch. */ - - *trgepc = *et + s * lt; - -/* Find the sub-solar point and distance from observer to */ -/* sub-solar point using the specified geometric definition. */ - - if (elipsd) { - -/* Find the sub-solar point given the target epoch, */ -/* observer-target position, and target body orientation */ -/* we've already computed. If we're not using light */ -/* time correction, this is all we need do. Otherwise, */ -/* our result will give us an initial estimate of the */ -/* target epoch, which we'll then improve. */ - -/* Get the radii of the target body from the kernel pool. */ - - bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - range = vnorm_(obspos); - if (range == 0.) { - -/* We've already ensured that observer and target are */ -/* distinct, so this should be a very unusual occurrence. */ - - setmsg_("Observer-target distance is zero. Observer is #; target" - " is #.", (ftnlen)61); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOSEPARATION)", (ftnlen)19); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Get the position of the Sun SPOS as seen from the target */ -/* in the target body-fixed frame at TRGEPC. */ - - spkezp_(&c__10, trgepc, fixref, abcorr, &trgcde, spos, &slt, - fixref_len, abcorr_len); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Make a first estimate of the sub-solar point. The algorithm */ -/* we use depends on the sub-solar point definition. */ - - if (near__) { - -/* Locate the nearest point to the Sun on the target. */ - - nearpt_(spos, radii, &radii[1], &radii[2], spoint, &altsun); - } else { - -/* Locate the surface intercept of the ray from the */ -/* Sun to the target center. */ - - vminus_(spos, sdir); - surfpt_(spos, sdir, radii, &radii[1], &radii[2], spoint, &fnd); - if (! fnd) { - -/* If there's no intercept, we have a numerical problem. */ - - setmsg_("No intercept of observer-target ray was found.", ( - ftnlen)46); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - } - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - alt = vdist_(obspos, spoint); - -/* Compute the one-way light time and target epoch based on our */ -/* first computation of SPOINT. The coefficient S has been */ -/* set to give us the correct answer for each aberration */ -/* correction case. */ - - lt = alt / clight_(); - *trgepc = *et + s * lt; - -/* If we're not using light time and stellar aberration */ -/* corrections, we're almost done now. Note that we need only */ -/* check for use of light time corrections, because use of */ -/* stellar aberration corrections alone has been prevented by an */ -/* earlier check. */ - - if (! uselt) { - -/* The TRGEPC value we'll return comes from our value of ALT */ -/* computed above. The previous call to SPKEZP call yielded */ -/* the vector OBSPOS. SPOINT was set immediately above. The */ -/* only output left to compute is SRFVEC. */ - - vsub_(spoint, obspos, srfvec); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* We'll now make an improved sub-solar point estimate using the */ -/* previous estimate of the sub-solar point. The number of */ -/* iterations depends on the light time correction type. */ - - if (usecn) { - nitr = 5; - } else { - nitr = 1; - } - -/* Get the J2000-relative state of the observer relative to */ -/* the solar system barycenter at ET. */ - - spkssb_(&obscde, et, "J2000", ssbost, (ftnlen)5); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Initialize the variables required to evaluate the */ -/* loop termination condition. */ - - i__ = 0; - ltdiff = 1.; - etdiff = 1.; - prevlt = lt; - prevet = *trgepc; - while(i__ < nitr && ltdiff > abs(lt) * 1e-17 && etdiff > 0.) { - -/* Get the J2000-relative state of the target relative to */ -/* the solar system barycenter at the target epoch. */ - - spkssb_(&trgcde, trgepc, "J2000", ssbtst, (ftnlen)5); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Find the position of the observer relative to the target. */ -/* Convert this vector from the J2000 frame to the target */ -/* frame at TRGEPC. */ - - vsub_(ssbost, ssbtst, j2pos); - pxform_("J2000", fixref, trgepc, xform, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - mxv_(xform, j2pos, obspos); - -/* If we're using stellar aberration corrections, adjust the */ -/* observer position to account for the stellar aberration */ -/* correction applicable to SPOINT. */ - - if (usestl) { - -/* We want to apply the stellar aberration correction that */ -/* applies to our current estimate of the sub-solar point */ -/* location, NOT the correction for the target body's */ -/* center. In most cases the two corrections will be */ -/* similar, but they might not be---consider the case of a */ -/* highly prolate target body where the observer is close */ -/* to one "end" of the body. */ - -/* Find the vector from the observer to the estimated */ -/* sub-solar point. Find the stellar aberration offset */ -/* STLOFF for this vector. Note that all vectors are */ -/* expressed relative to the target body-fixed frame at */ -/* TRGEPC. We must perform our corrections in an inertial */ -/* frame. */ - - vsub_(spoint, obspos, subvec); - mtxv_(xform, subvec, subvj2); - -/* Note that we don't handle the transmission */ -/* case here. */ - - stelab_(subvj2, &ssbost[3], corvj2); - mxv_(xform, corvj2, corpos); - vsub_(corpos, subvec, stloff); - -/* In principle, we want to shift the target body position */ -/* relative to the solar system barycenter by STLOFF, but */ -/* we can skip this step and just re-compute the observer's */ -/* location relative to the target body's center by */ -/* subtracting off STLOFF. */ - - vsub_(obspos, stloff, vtemp); - vequ_(vtemp, obspos); - } - -/* Find the position of the Sun as seen from the */ -/* target at TRGEPC. */ - - spkezp_(&c__10, trgepc, fixref, abcorr, &trgcde, spos, &slt, - fixref_len, abcorr_len); - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* Find the sub-solar point using the current estimated */ -/* geometry. */ - - if (near__) { - -/* Locate the nearest point to the observer on the target. */ - - nearpt_(spos, radii, &radii[1], &radii[2], spoint, &altsun); - } else { - -/* Locate the surface intercept of the ray from the */ -/* Sun to the target center. */ - - vminus_(spos, sdir); - surfpt_(spos, sdir, radii, &radii[1], &radii[2], spoint, &fnd) - ; - if (! fnd) { - -/* If there's no intercept, we have a numerical problem. */ - - setmsg_("No intercept of observer-target ray was found.", - (ftnlen)46); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - } - if (failed_()) { - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - alt = vdist_(obspos, spoint); - -/* Compute a new light time estimate and new target epoch. */ - - lt = alt / clight_(); - *trgepc = *et + s * lt; - -/* At this point, we have new estimates of the sub-solar point */ -/* SPOINT, the observer altitude ALT, the target epoch TRGEPC, */ -/* and the position of the observer relative to the target */ -/* OBSPOS. */ - -/* We use the d.p. identity function TOUCHD to force the */ -/* compiler to create double precision arguments from the */ -/* differences LT-PREVLT and TRGEPC-PREVET. Some compilers */ -/* will perform extended-precision register arithmetic, which */ -/* can prevent a difference from rounding to zero. Simply */ -/* storing the result of the subtraction in a double precision */ -/* variable doesn't solve the problem, because that variable */ -/* can be optimized out of existence. */ - - d__2 = lt - prevlt; - ltdiff = (d__1 = touchd_(&d__2), abs(d__1)); - d__2 = *trgepc - prevet; - etdiff = (d__1 = touchd_(&d__2), abs(d__1)); - prevlt = lt; - prevet = *trgepc; - ++i__; - } - } else { - -/* We've already checked the computation method input argument, */ -/* so we don't expect to arrive here. This code is present for */ -/* safety. */ - - setmsg_("The computation method # was not recognized. ", (ftnlen)45); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(INVALIDMETHOD)", (ftnlen)20); - chkout_("SUBSLR", (ftnlen)6); - return 0; - } - -/* SPOINT, TRGEPC, and OBSPOS have been set at this point. Compute */ -/* SRFVEC. */ - - vsub_(spoint, obspos, srfvec); - chkout_("SUBSLR", (ftnlen)6); - return 0; -} /* subslr_ */ - diff --git a/ext/spice/src/cspice/subslr_c.c b/ext/spice/src/cspice/subslr_c.c deleted file mode 100644 index 895a98ed8e..0000000000 --- a/ext/spice/src/cspice/subslr_c.c +++ /dev/null @@ -1,792 +0,0 @@ -/* - --Procedure subslr_c ( Sub-solar point ) - --Abstract - - Compute the rectangular coordinates of the sub-solar point on - a target body at a specified epoch, optionally corrected for - light time and stellar aberration. - - This routine supersedes subsol_c. - --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 - - FRAMES - NAIF_IDS - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void subslr_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - fixref I Body-fixed, body-centered target body frame. - abcorr I Aberration correction. - obsrvr I Name of observing body. - spoint O Sub-solar point on the target body. - trgepc O Sub-solar point epoch. - srfvec O Vector from observer to sub-solar point. - --Detailed_Input - - method is a short string providing parameters defining - the computation method to be used. - - The supported values of `method' are listed below. - Please note that the colon is a required delimiter; - using a blank will not work. - - "Near point: ellipsoid" The sub-solar point - computation uses a - triaxial ellipsoid to - model the surface of the - target body. The - sub-solar point is - defined as the nearest - point on the target - relative to the Sun. - - "Intercept: ellipsoid" The sub-solar point - computation uses a - triaxial ellipsoid to - model the surface of the - target body. The - sub-solar point is - defined as the target - surface intercept of the - line containing the - Sun and the - target's center. - - Neither case nor white space are significant in - `method'. For example, the string - - " nearpoint:ELLIPSOID " - - is valid. - - - target is the name of the target body. The target body is - an ephemeris object (its trajectory is given by - SPK data), and is an extended object. - - The string `target' is case-insensitive, and leading - and trailing blanks in `target' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both - "MOON" and "301" are legitimate strings that indicate - the Moon is the target body. - - When the target body's surface is represented by a - tri-axial ellipsoid, this routine assumes that a - kernel variable representing the ellipsoid's radii is - present in the kernel pool. Normally the kernel - variable would be defined by loading a PCK file. - - - et is the epoch of participation of the observer, - expressed as ephemeris seconds past J2000 TDB: `et' is - the epoch at which the observer's state is computed. - - When aberration corrections are not used, `et' is also - the epoch at which the position and orientation of - the target body and the position of the Sun are computed. - - When aberration corrections are used, `et' is the epoch - at which the observer's state relative to the solar - system barycenter is computed; in this case the position - and orientation of the target body are computed at - et-lt, where `lt' is the one-way light time between the - sub-solar point and the observer. See the description of - `abcorr' below for details. - - - fixref is the name of the body-fixed, body-centered reference - frame associated with the target body. The output - sub-solar point `spoint' will be expressed relative to - this reference frame. The string `fixref' is - case-insensitive, and leading and trailing blanks in - `fixref' are not significant. - - - abcorr indicates the aberration correction to be applied when - computing the target position and orientation, and the - position of the Sun. - - For remote sensing applications, where the apparent - sub-solar point seen by the observer is desired, - normally either of the corrections - - "LT+S" - "CN+S" - - should be used. These and the other supported options - are described below. `abcorr' may be any of the - following: - - "NONE" Apply no correction. Return the - geometric sub-solar point on the - target body. - - Let `lt' represent the one-way light time between the - observer and the sub-solar point (note: NOT - between the observer and the target body's center). - The following values of `abcorr' apply to the - "reception" case in which photons depart from the - sub-solar point's location at the light-time - corrected epoch et-lt and *arrive* at the observer's - location at `et': - - - "LT" Correct for one-way light time (also - called "planetary aberration") using a - Newtonian formulation. This correction - yields the location of sub-solar - point at the moment it emitted photons - arriving at the observer at `et'. - - The light time correction uses an - iterative solution of the light time - equation. The solution invoked by the - "LT" option uses one iteration. - - The target position and orientation as - seen by the observer are corrected for - light time. The position of the Sun - relative to the target is corrected for - one-way light time between the Sun and - target. - - - "LT+S" Correct for one-way light time and stellar - aberration using a Newtonian formulation. - This option modifies the sub-solar point - obtained with the "LT" option to account - for the observer's velocity relative to - the solar system barycenter. These - corrections yield the apparent - sub-solar point. - - - "CN" Converged Newtonian light time - correction. In solving the light time - equation, the "CN" correction iterates - until the solution converges. Both the - position and rotation of the target - body, and the position of the Sun, - are corrected for light time. - - "CN+S" Converged Newtonian light time and - stellar aberration corrections. This - option produces a solution that is at - least as accurate at that obtainable - with the "LT+S" option. Whether the "CN+S" - solution is substantially more accurate - depends on the geometry of the - participating objects and on the - accuracy of the input data. In all - cases this routine will execute more - slowly when a converged solution is - computed. - - Neither case nor white space are significant in - `abcorr'. For example, the string - - 'Lt + s' - - is valid. - - - obsrvr is the name of the observing body. The observing body - is an ephemeris object: it typically is a spacecraft, - the earth, or a surface point on the earth. `obsrvr' is - case-insensitive, and leading and trailing blanks in - `obsrvr' are not significant. Optionally, you may - supply a string containing the integer ID code for - the object. For example both "MOON" and "301" are - legitimate strings that indicate the Moon is the - observer. - --Detailed_Output - - - spoint is the sub-solar point on the target body. - - The sub-solar point is defined either as the point - on the target body that is closest to the Sun, - or the target surface intercept of the line from the - Sun to the target's center; the input argument - `method' selects the definition to be used. - - `spoint' is expressed in Cartesian coordinates, - relative to the body-fixed target frame designated by - `fixref'. The body-fixed target frame is evaluated at - the sub-solar epoch `trgepc' (see description below). - - When light time correction is used, the duration of - light travel between `spoint' to the observer is - considered to be the one way light time. - - When aberration corrections are used, `spoint' is - computed using target body position and orientation - that have been adjusted for the corrections - applicable to `spoint' itself rather than to the target - body's center. In particular, if the stellar - aberration correction applicable to `spoint' is - represented by a shift vector `s', then the light-time - corrected position of the target is shifted by `s' - before the sub-solar point is computed. - - The components of `spoint' have units of km. - - - trgepc is the "sub-solar point epoch." `trgepc' is defined - as follows: letting `lt' be the one-way light time - between the observer and the sub-solar point, - `trgepc' is either the epoch et-lt or `et' depending on - whether the requested aberration correction is, - respectively, for received radiation or omitted. `lt' is - computed using the method indicated by `abcorr'. - - `trgepc' is expressed as seconds past J2000 TDB. - - - srfvec is the vector from the observer's position at `et' to - the aberration-corrected (or optionally, geometric) - position of `spoint', where the aberration corrections - are specified by `abcorr'. `srfvec' is expressed in the - target body-fixed reference frame designated by - `fixref', evaluated at `trgepc'. - - - The components of `srfvec' are given in units of km. - - One can use the CSPICE function vnorm_c to obtain the - distance between the observer and `spoint': - - dist = vnorm_c ( srfvec ); - - The observer's position `obspos', relative to the - target body's center, where the center's position is - corrected for aberration effects as indicated by - `abcorr', can be computed via the call: - - vsub_c ( spoint, srfvec, obspos ); - - To transform the vector `srfvec' to a time-dependent - reference frame `ref' at `et', a sequence of two frame - transformations is required. For example, let `mfix' - and `mref' be 3x3 matrices respectively describing the - target body-fixed to J2000 frame transformation at - `trgepc' and the J2000 to (time-dependent frame) `ref' - transformation at `et', and let `xform' be the 3x3 matrix - representing the composition of `mref' with `mfix'. Then - `srfvec' can be transformed to the result `refvec' as - follows: - - pxform_c ( fixref, "j2000", trgepc, mfix ); - pxform_c ( "j2000", ref, et, mref ); - mxm_c ( mref, mfix, xform ); - mxv_c ( xform, srfvec, refvec ); - - The second example in the Examples header section - below presents a complete program that demonstrates - this procedure. - --Parameters - - None. - --Exceptions - - - 1) If the specified aberration correction is relativistic or - calls for stellar aberration but not light time correction, - the error SPICE(NOTSUPPORTED) is signaled. If the specified - aberration correction is any other unrecognized value, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 2) If either the target or observer input strings cannot be - converted to an integer ID code, the error SPICE(IDCODENOTFOUND) - is signaled. - - 3) If `obsrvr' and `target' map to the same NAIF integer ID code, - the error SPICE(BODIESNOTDISTINCT) is signaled. - - 4) If the input target body-fixed frame `fixref' is not recognized, - the error SPICE(NOFRAME) is signaled. A frame name may fail - to be recognized because a required frame specification kernel - has not been loaded; another cause is a misspelling of the - frame name. - - 5) If the input frame `fixref' is not centered at the target body, - the error SPICE(INVALIDFRAME) is signaled. - - 6) If the input argument `method' is not recognized, the error - SPICE(INVALIDMETHOD) is signaled. - - 7) If the target and observer have distinct identities but are - at the same location (for example, the target is Mars and - the observer is the Mars barycenter), the error - SPICE(NOSEPARATION) is signaled. - - 8) If insufficient ephemeris data have been loaded prior to - calling subslr_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. Note that when - light time correction is used, sufficient ephemeris data - must be available to propagate the states of observer, - target, and the Sun to the solar system barycenter. - - 9) If the computation method specifies an ellipsoidal target shape - and triaxial radii of the target body have not been loaded - into the kernel pool prior to calling subslr_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 10) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 11) If PCK data specifying the target body-fixed frame orientation - have not been loaded prior to calling subslr_c, the error will - be diagnosed and signaled by a routine in the call tree of - this routine. - - 12) The error SPICE(EMPTYSTRING) is signaled if any input string - argument does not contain at least one character, since the - input string cannot be converted to a Fortran-style string in - this case. - - 13) The error SPICE(NULLPOINTER) is signaled if any input - string argument pointer is null. - --Files - - Appropriate kernels must be loaded by the calling program before - this routine is called. - - The following data are required: - - - SPK data: ephemeris data for target, observer, and the Sun must - be loaded. If aberration corrections are used, the states of - target and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. Typically - ephemeris data are made available by loading one or more SPK - files via furnsh_c. - - - PCK data: if the target body shape is modeled as an - ellipsoid, triaxial radii for the target body must be loaded - into the kernel pool. Typically this is done by loading a - text PCK file via furnsh_c. - - - Further PCK data: rotation data for the target body must be - loaded. These may be provided in a text or binary PCK file. - - - Frame data: if a frame definition is required to convert the - observer and target states to the body-fixed frame of the - target, that definition must be available in the kernel - pool. Typically the definition is supplied by loading a - frame kernel via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - There are two different popular ways to define the sub-solar point: - "nearest point on the target to the Sun" or "target surface - intercept of the line containing the Sun and the target." These - coincide when the target is spherical and generally are distinct - otherwise. - - This routine computes light time corrections using light time - between the observer and the sub-solar point, as opposed to the - center of the target. Similarly, stellar aberration corrections done - by this routine are based on the direction of the vector from the - observer to the light-time corrected sub-solar point, not to the - target center. This technique avoids errors due to the differential - between aberration corrections across the target body. Therefore - it's valid to use aberration corrections with this routine even when - the observer is very close to the sub-solar point, in particular - when the observer to sub-solar point distance is much less than the - observer to target center distance. - - The definition of the aberration-corrected sub-solar point is - implicit: `spoint' is defined by an equation of the general form - - spoint = f ( spoint ) - - Because of the contraction properties of both light time and - stellar aberration corrections---that is, the difference in the - corrections for two vectors is much smaller than the difference - between the vectors themselves---it's easy to solve this equation - accurately and fairly quickly. - - When comparing sub-solar point computations with results from - sources other than SPICE, it's essential to make sure the same - geometric definitions are used. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - 1) Find the sub-solar point on Mars as seen from the Earth for a - specified time. Perform the computation twice, using both the - "intercept" and "near point" options. Display the locations of - the Sun and the sub-solar point using both planetocentric - and planetographic coordinates. - - Use the meta-kernel shown below to load the required SPICE - kernels. - - KPL/MK - - This meta-kernel is intended to support operation of SPICE - example programs. The kernels shown here should not be - assumed to contain adequate or correct versions of data - required by SPICE-based user applications. - - In order for an application to use this meta-kernel, the - kernels referenced here must be present in the user's - current working directory. - - - \begindata - - KERNELS_TO_LOAD = ( 'de418.bsp', - 'pck00008.tpc', - 'naif0008.tls' ) - - \begintext - - - Example code begins here. - - /. - Program EX1 - ./ - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Local parameters - ./ - #define META "example.tm" - - /. - Local variables - ./ - static SpiceChar * method[2] = - { - "Intercept: ellipsoid", - "Near point: ellipsoid" - }; - - SpiceDouble et; - SpiceDouble f; - SpiceDouble radii [3]; - SpiceDouble re; - SpiceDouble rp; - SpiceDouble spclat; - SpiceDouble spclon; - SpiceDouble spcrad; - SpiceDouble spgalt; - SpiceDouble spglat; - SpiceDouble spglon; - SpiceDouble spoint [3]; - SpiceDouble srfvec [3]; - SpiceDouble sunlt; - SpiceDouble sunpos [3]; - SpiceDouble supcln; - SpiceDouble supclt; - SpiceDouble supcrd; - SpiceDouble supgal; - SpiceDouble supgln; - SpiceDouble supglt; - SpiceDouble trgepc; - - SpiceInt i; - SpiceInt n; - - /. - Load kernel files via the meta-kernel. - ./ - furnsh_c ( META ); - - /. - Convert the UTC request time string to seconds past - J2000, TDB. - ./ - str2et_c ( "2008 aug 11 00:00:00", &et ); - - /. - Look up the target body's radii. We'll use these to - convert Cartesian to planetographic coordinates. Use - the radii to compute the flattening coefficient of - the reference ellipsoid. - ./ - bodvrd_c ( "MARS", "RADII", 3, &n, radii ); - - /. - Let `re' and `rp' be, respectively, the equatorial and - polar radii of the target. - ./ - re = radii[0]; - rp = radii[2]; - - f = ( re - rp ) / re; - - /. - Compute the sub-solar point using light time and stellar - aberration corrections. Use the "target surface intercept" - definition of the sub-solar point on the first loop - iteration, and use the "near point" definition on the - second. - ./ - - for ( i = 0; i < 2; i++ ) - { - subslr_c ( method[i], - "mars", et, "iau_mars", "lt+s", - "earth", spoint, &trgepc, srfvec ); - - /. - Convert the sub-observer point's rectangular coordinates - to planetographic longitude, latitude and altitude. - Convert radians to degrees. - ./ - recpgr_c ( "mars", spoint, re, f, - &spglon, &spglat, &spgalt ); - - spglon *= dpr_c(); - spglat *= dpr_c(); - - /. - Convert the sub-solar point's rectangular coordinates to - planetocentric radius, longitude, and latitude. Convert - radians to degrees. - ./ - reclat_c ( spoint, &spcrad, &spclon, &spclat ); - - spclon *= dpr_c(); - spclat *= dpr_c(); - - /. - Compute the Sun's apparent position relative to the - center of the target at `trgepc'. Express the Sun's - location in planetographic coordinates. - ./ - spkpos_c ( "sun", trgepc, "iau_mars", "lt+s", - "mars", sunpos, &sunlt ); - - recpgr_c ( "mars", sunpos, re, f, - &supgln, &supglt, &supgal ); - - supgln *= dpr_c (); - supglt *= dpr_c (); - - /. - Convert the Sun's rectangular coordinates to - planetocentric radius, longitude, and latitude. - Convert radians to degrees. - ./ - reclat_c ( sunpos, &supcrd, &supcln, &supclt ); - - supcln *= dpr_c(); - supclt *= dpr_c(); - - /. - Write the results. - ./ - printf ( "\n" - " Computation method = %s\n\n" - " Sub-solar point altitude (km) = %21.9f\n" - " Sub-solar planetographic longitude (deg) = %21.9f\n" - " Sun's planetographic longitude (deg) = %21.9f\n" - " Sub-solar planetographic latitude (deg) = %21.9f\n" - " Sun's planetographic latitude (deg) = %21.9f\n" - " Sub-solar planetocentric longitude (deg) = %21.9f\n" - " Sun's planetocentric longitude (deg) = %21.9f\n" - " Sub-solar planetocentric latitude (deg) = %21.9f\n" - " Sun's planetocentric latitude (deg) = %21.9f\n" - "\n", - method[i], - spgalt, - spglon, - supgln, - spglat, - supglt, - spclon, - supcln, - spclat, - supclt ); - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - Computation method = Intercept: ellipsoid - - Sub-solar point altitude (km) = 0.000000000 - Sub-solar planetographic longitude (deg) = 175.810721566 - Sun's planetographic longitude (deg) = 175.810721564 - Sub-solar planetographic latitude (deg) = 23.668550265 - Sun's planetographic latitude (deg) = 23.420823346 - Sub-solar planetocentric longitude (deg) = -175.810721566 - Sun's planetocentric longitude (deg) = -175.810721564 - Sub-solar planetocentric latitude (deg) = 23.420819920 - Sun's planetocentric latitude (deg) = 23.420819920 - - - Computation method = Near point: ellipsoid - - Sub-solar point altitude (km) = -0.000000000 - Sub-solar planetographic longitude (deg) = 175.810721552 - Sun's planetographic longitude (deg) = 175.810721550 - Sub-solar planetographic latitude (deg) = 23.420823346 - Sun's planetographic latitude (deg) = 23.420823346 - Sub-solar planetocentric longitude (deg) = -175.810721552 - Sun's planetocentric longitude (deg) = -175.810721550 - Sub-solar planetocentric latitude (deg) = 23.175085562 - Sun's planetocentric latitude (deg) = 23.420819920 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 06-FEB-2009 (NJB) - - Incorrect frame name fixfrm was changed to fixref in - documentation. - - In the header examples, meta-kernel names were updated to use - the suffix - - ".tm" - - -CSPICE Version 1.0.0, 02-MAR-2008 (NJB) - --Index_Entries - - find sub-solar point on target body - find nearest point to Sun on target body - --& -*/ - -{ /* Begin subslr_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "subslr_c" ); - - /* - Check the input strings: method, target, fixref, abcorr, and obsrvr. - Make sure none of the pointers are null and that each string - contains at least one non-null character. - */ - CHKFSTR ( CHK_STANDARD, "subslr_c", method ); - CHKFSTR ( CHK_STANDARD, "subslr_c", target ); - CHKFSTR ( CHK_STANDARD, "subslr_c", fixref ); - CHKFSTR ( CHK_STANDARD, "subslr_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "subslr_c", obsrvr ); - - /* - Call the f2c'd routine. - */ - subslr_ ( ( char * ) method, - ( char * ) target, - ( doublereal * ) &et, - ( char * ) fixref, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) spoint, - ( doublereal * ) trgepc, - ( doublereal * ) srfvec, - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(fixref), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - chkout_c ( "subslr_c" ); - -} /* End subslr_c */ diff --git a/ext/spice/src/cspice/subsol.c b/ext/spice/src/cspice/subsol.c deleted file mode 100644 index 022547dd59..0000000000 --- a/ext/spice/src/cspice/subsol.c +++ /dev/null @@ -1,617 +0,0 @@ -/* subsol.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure SUBSOL ( Sub-solar point ) */ -/* Subroutine */ int subsol_(char *method, char *target, doublereal *et, char - *abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen - target_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - /* Initialized data */ - - static doublereal origin[3] = { 0.,0.,0. }; - - doublereal radii[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), ltime_(doublereal *, integer *, char *, integer - *, doublereal *, doublereal *, ftnlen); - logical found; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal sunlt; - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - integer obscde; - doublereal lt; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer frcode; - extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical - *, ftnlen); - integer nradii; - char frname[80]; - integer trgcde; - doublereal ettarg; - extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int spkpos_(char *, doublereal *, char *, char *, - char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen, - ftnlen), surfpt_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *); - doublereal alt, pos[3]; - -/* $ Abstract */ - -/* Deprecated: This routine has been superseded by the SPICELIB */ -/* routine SUBSLR. This routine is supported for purposes of */ -/* backward compatibility only. */ - -/* Determine the coordinates of the sub-solar point on a target */ -/* body as seen by a specified observer at a specified epoch, */ -/* optionally corrected for planetary (light time) and stellar */ -/* aberration. */ - -/* $ 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 */ - -/* FRAMES */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TARGET I Name of target body. */ -/* ET I Epoch in ephemeris seconds past J2000 TDB. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Name of observing body. */ -/* SPOINT O Sub-solar point on the target body. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string specifying the computation method */ -/* to be used. The choices are: */ - -/* 'Near point' The sub-solar point is defined */ -/* as the nearest point on the */ -/* target to the sun. */ - -/* 'Intercept' The sub-observer point is */ -/* defined as the target surface */ -/* intercept of the line */ -/* containing the target's center */ -/* and the sun's center. */ - -/* In both cases, the intercept computation treats the */ -/* surface of the target body as a triaxial ellipsoid. */ -/* The ellipsoid's radii must be available in the kernel */ -/* pool. */ - -/* Neither case nor white space are significant in */ -/* METHOD. For example, the string ' NEARPOINT' is */ -/* valid. */ - - -/* TARGET is the name of the target body. TARGET is */ -/* case-insensitive, and leading and trailing blanks in */ -/* TARGET are not significant. Optionally, you may */ -/* supply a string containing the integer ID code for */ -/* the object. For example both 'MOON' and '301' are */ -/* legitimate strings that indicate the moon is the */ -/* target body. */ - -/* This routine assumes that the target body is modeled */ -/* by a tri-axial ellipsoid, and that a PCK file */ -/* containing its radii has been loaded into the kernel */ -/* pool via FURNSH. */ - - -/* ET is the epoch in ephemeris seconds past J2000 at which */ -/* the sub-solar point on the target body is to be */ -/* computed. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the observer-target state. ABCORR */ -/* may be any of the following. */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric sub-solar point on the target */ -/* body. */ - -/* 'LT' Correct for planetary (light time) */ -/* aberration. Both the state and rotation */ -/* of the target body are corrected for one */ -/* way light time from target to observer. */ - -/* The state of the sun relative to the */ -/* target is corrected for one way light */ -/* from the sun to the target; this state */ -/* is evaluated at the epoch obtained by */ -/* retarding ET by the one way light time */ -/* from target to observer. */ - -/* 'LT+S' Correct for planetary (light time) and */ -/* stellar aberrations. Light time */ -/* corrections are the same as in the 'LT' */ -/* case above. The target state is */ -/* additionally corrected for stellar */ -/* aberration as seen by the observer, and */ -/* the sun state is corrected for stellar */ -/* aberration as seen from the target. */ - -/* 'CN' Converged Newtonian light time */ -/* corrections. This is the same as LT */ -/* corrections but with further iterations */ -/* to a converged Newtonian light time */ -/* solution. Given that relativistic */ -/* effects may be as large as the higher */ -/* accuracy achieved by this computation, */ -/* this is correction is seldom worth the */ -/* additional computations required unless */ -/* the user incorporates additional */ -/* relativistic corrections. Light */ -/* time corrections are applied as in the */ -/* 'LT' case. */ - -/* 'CN+S' Converged Newtonian light time */ -/* corrections and stellar aberration. */ -/* Light time and stellar aberration */ -/* corrections are applied as in the */ -/* 'LT+S' case. */ - - -/* OBSRVR is the name of the observing body, typically a */ -/* spacecraft, the earth, or a surface point on the */ -/* earth. OBSRVR is case-insensitive, and leading and */ -/* trailing blanks in OBSRVR are not significant. */ -/* Optionally, you may supply a string containing the */ -/* integer ID code for the object. For example both */ -/* 'EARTH' and '399' are legitimate strings that indicate */ -/* the earth is the observer. */ - -/* $ Detailed_Output */ - -/* SPOINT is the sub-solar point on the target body at ET */ -/* expressed relative to the body-fixed frame of the */ -/* target body. */ - -/* The sub-solar point is defined either as the point on */ -/* the target body that is closest to the sun, or the */ -/* target surface intercept of the line containing the */ -/* target's center and the sun's center; the input */ -/* argument METHOD selects the definition to be used. */ - -/* The body-fixed frame, which is time-dependent, is */ -/* evaluated at ET if ABCORR is 'NONE'; otherwise the */ -/* frame is evaluated at ET-LT, where LT is the one way */ -/* light time from target to observer. */ - -/* The state of the target body is corrected for */ -/* aberration as specified by ABCORR; the corrected */ -/* state is used in the geometric computation. As */ -/* indicated above, the rotation of the target is */ -/* retarded by one way light time if ABCORR specifies */ -/* that light time correction is to be done. */ - -/* The state of the sun as seen from the observing */ -/* body is also corrected for aberration as specified */ -/* by ABCORR. The corrections, when selected, are */ -/* applied at the epoch ET-LT, where LT is the one way */ -/* light time from target to observer. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If any of the listed errors occur, the output arguments are */ -/* left unchanged. */ - - -/* 1) If the input argument METHOD is not recognized, the error */ -/* SPICE(DUBIOUSMETHOD) is signaled. */ - -/* 2) If either of the input body names TARGET or OBSRVR cannot be */ -/* mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */ -/* is signaled. */ - -/* 3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */ -/* error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If frame definition data enabling the evaluation of the state */ -/* of the target relative to the observer in target body-fixed */ -/* coordinates have not been loaded prior to calling SUBSOL, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 5) If the specified aberration correction is not recognized, the */ -/* error will be diagnosed and signaled by a routine in the call */ -/* tree of this routine. */ - -/* 6) If insufficient ephemeris data have been loaded prior to */ -/* calling SUBSOL, the error will be diagnosed and signaled by a */ -/* routine in the call tree of this routine. */ - -/* 7) If the triaxial radii of the target body have not been loaded */ -/* into the kernel pool prior to calling SUBSOL, the error will be */ -/* diagnosed and signaled by a routine in the call tree of this */ -/* routine. */ - -/* 8) The target must be an extended body: if any of the radii of */ -/* the target body are non-positive, the error will be diagnosed */ -/* and signaled by routines in the call tree of this routine. */ - -/* 9) If PCK data supplying a rotation model for the target body */ -/* have not been loaded prior to calling SUBSOL, the error will be */ -/* diagnosed and signaled by a routine in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* Appropriate SPK, PCK, and frame data must be available to */ -/* the calling program before this routine is called. Typically */ -/* the data are made available by loading kernels; however the */ -/* data may be supplied via subroutine interfaces if applicable. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for sun, target, and observer must */ -/* be loaded. If aberration corrections are used, the states of */ -/* sun, target, and observer relative to the solar system */ -/* barycenter must be calculable from the available ephemeris */ -/* data. Ephemeris data are made available by loading */ -/* one or more SPK files via FURNSH. */ - -/* - PCK data: triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: a rotation model for the target body must */ -/* be loaded. This may be provided in a text or binary PCK */ -/* file which is loaded via FURNSH. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the sun, observer, and target states to the body-fixed frame */ -/* of the target, that definition must be available in the */ -/* kernel pool. Typically the definition is supplied by loading */ -/* a frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* SUBSOL computes the sub-solar point on a target body, as seen by */ -/* a specified observer. */ - -/* There are two different popular ways to define the sub-solar */ -/* point: "nearest point on target to the sun" or "target surface */ -/* intercept of line containing target and sun." These coincide */ -/* when the target is spherical and generally are distinct otherwise. */ - -/* When comparing sub-point computations with results from sources */ -/* other than SPICE, it's essential to make sure the same geometric */ -/* definitions are used. */ - -/* $ Examples */ - - -/* In the following example program, the file MGS.BSP is a */ -/* hypothetical binary SPK ephemeris file containing data for the */ -/* Mars Global Surveyor orbiter. The SPK file de405s.bsp contains */ -/* data for the planet barycenters as well as the Earth, Moon, and */ -/* Sun for the time period including the date 1997 Dec 31 12:000 */ -/* UTC. MGS0000A.TPC is a planetary constants kernel file */ -/* containing radii and rotation model constants. MGS00001.TLS is */ -/* a leapseconds file. (File names shown here that are specific */ -/* to MGS are not names of actual files.) */ - -/* IMPLICIT NONE */ - -/* CHARACTER*25 METHOD ( 2 ) */ - -/* INTEGER I */ - -/* DOUBLE PRECISION DPR */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LAT */ -/* DOUBLE PRECISION LON */ -/* DOUBLE PRECISION RADIUS */ -/* DOUBLE PRECISION SPOINT ( 3 ) */ - -/* DATA METHOD / 'Intercept', 'Near point' / */ - -/* C */ -/* C Load kernel files. */ -/* C */ -/* CALL FURNSH ( 'MGS00001.TLS' ) */ -/* CALL FURNSH ( 'MGS0000A.TPC' ) */ -/* CALL FURNSH ( 'de405s.bsp' ) */ -/* CALL FURNSH ( 'MGS.BSP' ) */ - -/* C */ -/* C Convert the UTC request time to ET (seconds past */ -/* C J2000, TDB). */ -/* C */ -/* CALL STR2ET ( '1997 Dec 31 12:00:00', ET ) */ - -/* C */ -/* C Compute sub-spacecraft point using light time and stellar */ -/* C aberration corrections. Use the "target surface intercept" */ -/* C definition of sub-spacecraft point on the first loop */ -/* C iteration, and use the "near point" definition on the */ -/* C second. */ -/* C */ -/* DO I = 1, 2 */ - -/* CALL SUBSOL ( METHOD(I), */ -/* . 'MARS', ET, 'LT+S', 'MGS', SPOINT ) */ - -/* C */ -/* C Convert rectangular coordinates to planetocentric */ -/* C latitude and longitude. Convert radians to degrees. */ -/* C */ -/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */ - -/* LON = LON * DPR () */ -/* LAT = LAT * DPR () */ - -/* C */ -/* C Write the results. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Computation method: ', METHOD(I) */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' Radius (km) = ', RADIUS */ -/* WRITE (*,*) ' Planetocentric Latitude (deg) = ', LAT */ -/* WRITE (*,*) ' Planetocentric Longitude (deg) = ', LON */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - -/* $ Restrictions */ - -/* The appropriate kernel data must have been loaded before this */ -/* routine is called. See the Files section above. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.3, 18-MAY-2010 (BVS) */ - -/* Index line now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */ - -/* Typo correction in Required_Reading, changed */ -/* FRAME to FRAMES. */ - -/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */ - -/* Abstract now states that this routine is deprecated. */ - -/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */ - -/* Call to BODVAR was replaced with call to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to support representations of integers in the input */ -/* arguments TARGET and OBSRVR. Deleted references in header to */ -/* kernel-specific loaders. Made miscellaneous minor corrections */ -/* to header comments. */ - -/* - SPICELIB Version 1.0.2, 12-DEC-2002 (NJB) */ - -/* Corrected and updated code example in header. */ - -/* - SPICELIB Version 1.0.1, 1-NOV-1999 (WLT) */ - -/* Declared routine LTIME to be external. */ - -/* - SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* DEPRECATED sub-solar point */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */ - -/* Updated to support representations of integers in the */ -/* input arguments TARGET and OBSRVR: calls to BODN2C */ -/* were replaced by calls to BODS2C. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SUBSOL", (ftnlen)6); - } - -/* Obtain integer codes for the target and observer. */ - - bods2c_(target, &trgcde, &found, target_len); - if (! found) { - setmsg_("The target, '#', is not a recognized name for an ephemeris " - "object. The cause of this problem may be that you need an up" - "dated version of the SPICE Toolkit. ", (ftnlen)155); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBSOL", (ftnlen)6); - return 0; - } - bods2c_(obsrvr, &obscde, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("SUBSOL", (ftnlen)6); - return 0; - } - -/* Check the input body codes. If they are equal, signal */ -/* an error. */ - - if (obscde == trgcde) { - setmsg_("In computing the sub-observer point, the observing body and" - " target body are the same. Both are #.", (ftnlen)97); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("SUBSOL", (ftnlen)6); - return 0; - } - -/* Get the radii of the target body from the kernel pool. */ - - bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5); - -/* Find the name of the body-fixed frame associated with the */ -/* target body. We'll want the state of the target relative to */ -/* the observer in this body-fixed frame. */ - - cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80); - if (! found) { - setmsg_("No body-fixed frame is associated with target body #; a fra" - "me kernel must be loaded to make this association. Consult " - "the FRAMES Required Reading for details.", (ftnlen)159); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("SUBSOL", (ftnlen)6); - return 0; - } - -/* If we're using aberration corrections, we'll need the */ -/* one way light time from the target to the observer. Otherwise, */ -/* we set the time time to zero. */ - - if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) { - lt = 0.; - ettarg = *et; - } else { - ltime_(et, &obscde, "<-", &trgcde, &ettarg, <, (ftnlen)2); - } - -/* Determine the position of the sun in target body-fixed */ -/* coordinates. */ - -/* Call SPKEZ to compute the position of the sun as seen from the */ -/* target body and the light time between them SUNLT. This state is */ -/* evaluated at the target epoch ETTARG. We request that the */ -/* coordinates of the target-sun position vector POS be returned */ -/* relative to the body fixed reference frame associated with the */ -/* target body, using aberration corrections specified by the input */ -/* argument ABCORR. */ - - spkpos_("SUN", &ettarg, frname, abcorr, target, pos, &sunlt, (ftnlen)3, ( - ftnlen)80, abcorr_len, target_len); - -/* Find the sub-solar point using the specified geometric definition. */ - - if (eqstr_(method, "Near point", method_len, (ftnlen)10)) { - -/* Locate the nearest point to the sun on the target. */ - - nearpt_(pos, radii, &radii[1], &radii[2], spoint, &alt); - } else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) { - surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found); - -/* Since the line in question passes through the center of the */ -/* target, there will always be a surface intercept. So we should */ -/* never have FOUND = .FALSE. */ - - if (! found) { - setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex " - "of ray is at target center. This indicates a bug. Please" - " contact NAIF.", (ftnlen)125); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("SUBSOL", (ftnlen)6); - return 0; - } - } else { - setmsg_("The computation method # was not recognized. Allowed values" - " are \"Near point\" and \"Intercept.\"", (ftnlen)93); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20); - chkout_("SUBSOL", (ftnlen)6); - return 0; - } - chkout_("SUBSOL", (ftnlen)6); - return 0; -} /* subsol_ */ - diff --git a/ext/spice/src/cspice/subsol_c.c b/ext/spice/src/cspice/subsol_c.c deleted file mode 100644 index b3f63b7bb0..0000000000 --- a/ext/spice/src/cspice/subsol_c.c +++ /dev/null @@ -1,489 +0,0 @@ -/* - --Procedure subsol_c ( Sub-solar point ) - --Abstract - - Deprecated: This routine has been superseded by the CSPICE - routine subslr_c. This routine is supported for purposes of - backward compatibility only. - - Determine the coordinates of the sub-solar point on a target - body as seen by a specified observer at a specified epoch, - optionally corrected for planetary (light time) and stellar - aberration. - --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 - - FRAMES - PCK - SPK - TIME - --Keywords - - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void subsol_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - method I Computation method. - target I Name of target body. - et I Epoch in ephemeris seconds past J2000 TDB. - abcorr I Aberration correction. - obsrvr I Name of observing body. - spoint O Sub-solar point on the target body. - --Detailed_Input - - method is a short string specifying the computation method - to be used. The choices are: - - "Near point" The sub-solar point is defined - as the nearest point on the - target to the sun. - - "Intercept" The sub-observer point is defined - as the target surface intercept of - the line containing the target's - center and the sun's center. - - In both cases, the intercept computation treats the - surface of the target body as a triaxial ellipsoid. - The ellipsoid's radii must be available in the kernel - pool. - - Neither case nor white space are significant in - method. For example, the string " NEARPOINT" is - valid. - - - target is the name of the target body. `target' is - case-insensitive, and leading and trailing blanks in - `target' are not significant. Optionally, you may supply - a string containing the integer ID code for the object. - For example both "MOON" and "301" are legitimate strings - that indicate the moon is the target body. - - This routine assumes that the target body is modeled by - a tri-axial ellipsoid, and that a PCK file containing - its radii has been loaded into the kernel pool via - furnsh_c. - - - et is the epoch in ephemeris seconds past J2000 at which - the sub-solar point on the target body is to be - computed. - - - abcorr indicates the aberration corrections to be applied - when computing the observer-target state. abcorr - may be any of the following. - - "NONE" Apply no correction. Return the - geometric sub-solar point on the target - body. - - "LT" Correct for planetary (light time) - aberration. Both the state and rotation - of the target body are corrected for one - way light time from target to observer. - - The state of the sun relative to the - target is corrected for one way light - from the sun to the target; this state - is evaluated at the epoch obtained by - retarding et by the one way light time - from target to observer. - - "LT+S" Correct for planetary (light time) and - stellar aberrations. Light time - corrections are the same as in the "LT" - case above. The target state is - additionally corrected for stellar - aberration as seen by the observer, and - the sun state is corrected for stellar - aberration as seen from the target. - - "CN" Converged Newtonian light time - corrections. This is the same as LT - corrections but with further iterations - to a converged Newtonian light time - solution. Given that relativistic - effects may be as large as the higher - accuracy achieved by this computation, - this is correction is seldom worth the - additional computations required unless - the user incorporates additional - relativistic corrections. Light - time corrections are applied as in the - "LT" case. - - "CN+S" Converged Newtonian light time - corrections and stellar aberration. - Light time and stellar aberration - corrections are applied as in the - "LT+S" case. - - - obsrvr is the name of the observing body. This is typically - a spacecraft, the earth, or a surface point on the - earth. `obsrvr' is case-insensitive, and leading and - trailing blanks in `obsrvr' are not significant. - Optionally, you may supply a string containing the - integer ID code for the object. For example both - "EARTH" and "399" are legitimate strings that indicate - the earth is the observer. - - --Detailed_Output - - spoint is the sub-solar point on the target body at et, - expressed relative to the body-fixed frame of the - target body. - - The sub-solar point is defined either as the point on - the target body that is closest to the sun, or the - target surface intercept of the line containing the sun's - center and the target's center; the input argument - method selects the definition to be used. - - The body-fixed frame, which is time-dependent, is - evaluated at et if abcorr is "NONE"; otherwise the - frame is evaluated at et-lt, where lt is the one way - light time from target to observer. - - The state of the target body is corrected for - aberration as specified by abcorr; the corrected - state is used in the geometric computation. As - indicated above, the rotation of the target is - retarded by one way light time if abcorr specifies - that light time correction is to be done. - - The state of the sun as seen from the target body - body is also corrected for aberration as specified - by abcorr. The corrections, when selected, are - applied at the epoch et-lt, where lt is the one way - light time from target to observer. - --Parameters - - None. - --Exceptions - - If any of the listed errors occur, the output arguments are - left unchanged. - - - 1) If the input argument method is not recognized, the error - SPICE(DUBIOUSMETHOD) is signaled. - - 2) If either of the input body names target or obsrvr cannot be - mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) - is signaled. - - 3) If obsrvr and target map to the same NAIF integer ID codes, the - error SPICE(BODIESNOTDISTINCT) is signaled. - - 4) If frame definition data enabling the evaluation of the state - of the target relative to the observer in target body-fixed - coordinates have not been loaded prior to calling subsol_c, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 5) If the specified aberration correction is not recognized, the - error will be diagnosed and signaled by a routine in the call - tree of this routine. - - 6) If insufficient ephemeris data have been loaded prior to - calling subsol_c, the error will be diagnosed and signaled by a - routine in the call tree of this routine. - - 7) If the triaxial radii of the target body have not been loaded - into the kernel pool prior to calling subsol_c, the error will be - diagnosed and signaled by a routine in the call tree of this - routine. - - 8) The target must be an extended body: if any of the radii of - the target body are non-positive, the error will be diagnosed - and signaled by routines in the call tree of this routine. - - 9) If PCK data supplying a rotation model for the target body - have not been loaded prior to calling subsol_c, the error will be - diagnosed and signaled by a routine in the call tree of this - routine. - - 10) If any input string argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 11) If any input string argument is empty, the error - SPICE(EMPTYSTRING) will be signaled. - - --Files - - Appropriate SPK, PCK, and frame data must be available to - the calling program before this routine is called. Typically - the data are made available by loading kernels; however the - data may be supplied via subroutine interfaces if applicable. - - The following data are required: - - - SPK data: ephemeris data for sun, target, and observer must be - loaded. If aberration corrections are used, the states of sun, - target, and observer relative to the solar system barycenter - must be calculable from the available ephemeris data. Ephemeris - data are made available by loading one or more SPK files via - furnsh_c. - - - PCK data: triaxial radii for the target body must be loaded - into the kernel pool. Typically this is done by loading a - text PCK file via furnsh_c. - - - Further PCK data: a rotation model for the target body must be - loaded. This may be provided in a text or binary PCK file - which is loaded via furnsh_c. - - - Frame data: if a frame definition is required to convert - the sun, observer, and target states to the body-fixed frame - of the target, that definition must be available in the - kernel pool. Typically the definition is supplied by loading - a frame kernel via furnsh_c. - - In all cases, kernel data are normally loaded once per program - run, NOT every time this routine is called. - --Particulars - - subsol_c computes the sub-solar point on a target body, as seen by - a specified observer. - - There are two different popular ways to define the sub-solar point: - "nearest point on target to the sun" or "target surface intercept of - line containing target and sun." These coincide when the target is - spherical and generally are distinct otherwise. - - When comparing sub-point computations with results from sources - other than SPICE, it's essential to make sure the same geometric - definitions are used. - --Examples - - - In the following example program, the file MGS.BSP is a - hypothetical binary SPK ephemeris file containing data for the - Mars Global Surveyor orbiter. The SPK file de405s.bsp contains - data for the planet barycenters as well as the Earth, Moon, and - Sun for the time period including the date 1997 Dec 31 12:000 - UTC. MGS0000A.TPC is a planetary constants kernel file - containing radii and rotation model constants. MGS00001.TLS is - a leapseconds file. (File names shown here that are specific - to MGS are not names of actual files.) - - - #include - #include "SpiceUsr.h" - - int main( void ) - { - #define METHLN 26 - - SpiceChar method [2][ METHLN ] = - { - "Intercept", - "Near point" - }; - - SpiceDouble et; - SpiceDouble lat; - SpiceDouble lon; - SpiceDouble radius; - SpiceDouble spoint[3]; - - SpiceInt i; - - - /. - Load kernel files. - ./ - furnsh_c ( "MGS00001.TLS" ); - furnsh_c ( "MGS0000A.TPC" ); - furnsh_c ( "de405s.bsp" ); - furnsh_c ( "MGS.BSP" ); - - - /. - Convert the UTC request time to ET (seconds past - J2000, TDB). - ./ - str2et_c ( "1997 Dec 31 12:00:00", &et ); - - /. - Compute sub-spacecraft point using light time and stellar - aberration corrections. Use the "target surface intercept" - definition of sub-spacecraft point on the first loop - iteration, and use the "near point" definition on the - second. - ./ - - for ( i = 0; i < 2; i++ ) - { - - subsol_c ( method[i], "mars", et, "lt+s", "mgs", spoint ); - - /. - Convert rectangular coordinates to planetocentric - latitude and longitude. Convert radians to degrees. - ./ - reclat_c ( spoint, &radius, &lon, &lat ); - - lon = lon * dpr_c (); - lat = lat * dpr_c (); - - /. - Write the results. - ./ - - printf ( "\n" - "Computation method: %s\n" - "\n" - " Radius (km) = %f\n" - " Planetocentric Latitude (deg) = %f\n" - " Planetocentric Longitude (deg) = %f\n" - "\n", - - method[i], radius, lat, lon ); - } - - return ( 0 ); - } - - - --Restrictions - - The appropriate kernel data must have been loaded before this - routine is called. See the Files section above. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.E. McLean (JPL) - --Version - - -CSPICE Version 1.0.4, 19-MAY-2010 (BVS) - - Index line now states that this routine is deprecated. - - -CSPICE Version 1.0.3, 07-FEB-2008 (NJB) - - Abstract now states that this routine is deprecated. - - -CSPICE Version 1.0.2, 22-JUL-2004 (NJB) - - Updated header to indicate that the `target' and `observer' - input arguments can now contain string representations of - integers. Deleted references to kernel-specific loaders. - Made miscellaneous minor corrections to header comments. - - -CSPICE Version 1.0.1, 12-DEC-2002 (NJB) - - Corrected and updated code example in header. - - -CSPICE Version 1.0.0, 03-SEP-1999 (NJB) - --Index_Entries - - DEPRECATED sub-solar point - --& -*/ - -{ /* Begin subsol_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "subsol_c" ); - - - /* - Check the input strings: method, target, abcorr, and obsrvr. Make - sure none of the pointers are null and that each string contains at - least one non-null character. - */ - CHKFSTR ( CHK_STANDARD, "subsol_c", method ); - CHKFSTR ( CHK_STANDARD, "subsol_c", target ); - CHKFSTR ( CHK_STANDARD, "subsol_c", abcorr ); - CHKFSTR ( CHK_STANDARD, "subsol_c", obsrvr ); - - - /* - Call the f2c'd routine. - */ - subsol_ ( ( char * ) method, - ( char * ) target, - ( doublereal * ) &et, - ( char * ) abcorr, - ( char * ) obsrvr, - ( doublereal * ) spoint, - ( ftnlen ) strlen(method), - ( ftnlen ) strlen(target), - ( ftnlen ) strlen(abcorr), - ( ftnlen ) strlen(obsrvr) ); - - - - chkout_c ( "subsol_c" ); - -} /* End subsol_c */ diff --git a/ext/spice/src/cspice/sue.c b/ext/spice/src/cspice/sue.c deleted file mode 100644 index d2a7c34f12..0000000000 --- a/ext/spice/src/cspice/sue.c +++ /dev/null @@ -1,83 +0,0 @@ -#include "f2c.h" -#include "fio.h" -extern uiolen f__reclen; -long f__recloc; - -#ifdef KR_headers -c_sue(a) cilist *a; -#else -c_sue(cilist *a) -#endif -{ - f__external=f__sequential=1; - f__formatted=0; - f__curunit = &f__units[a->ciunit]; - if(a->ciunit >= MXUNIT || a->ciunit < 0) - err(a->cierr,101,"startio"); - f__elist=a; - if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit)) - err(a->cierr,114,"sue"); - f__cf=f__curunit->ufd; - if(f__curunit->ufmt) err(a->cierr,103,"sue") - if(!f__curunit->useek) err(a->cierr,103,"sue") - return(0); -} -#ifdef KR_headers -integer s_rsue(a) cilist *a; -#else -integer s_rsue(cilist *a) -#endif -{ - int n; - if(!f__init) f_init(); - f__reading=1; - if(n=c_sue(a)) return(n); - f__recpos=0; - if(f__curunit->uwrt && f__nowreading(f__curunit)) - err(a->cierr, errno, "read start"); - if(fread((char *)&f__reclen,sizeof(uiolen),1,f__cf) - != 1) - { if(feof(f__cf)) - { f__curunit->uend = 1; - err(a->ciend, EOF, "start"); - } - clearerr(f__cf); - err(a->cierr, errno, "start"); - } - return(0); -} -#ifdef KR_headers -integer s_wsue(a) cilist *a; -#else -integer s_wsue(cilist *a) -#endif -{ - int n; - if(!f__init) f_init(); - if(n=c_sue(a)) return(n); - f__reading=0; - f__reclen=0; - if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) - err(a->cierr, errno, "write start"); - f__recloc=ftell(f__cf); - (void) fseek(f__cf,(long)sizeof(uiolen),SEEK_CUR); - return(0); -} -integer e_wsue(Void) -{ long loc; - fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); -#ifdef ALWAYS_FLUSH - if (fflush(f__cf)) - err(f__elist->cierr, errno, "write end"); -#endif - loc=ftell(f__cf); - fseek(f__cf,f__recloc,SEEK_SET); - fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); - fseek(f__cf,loc,SEEK_SET); - return(0); -} -integer e_rsue(Void) -{ - (void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR); - return(0); -} diff --git a/ext/spice/src/cspice/suffix.c b/ext/spice/src/cspice/suffix.c deleted file mode 100644 index d855ce118c..0000000000 --- a/ext/spice/src/cspice/suffix.c +++ /dev/null @@ -1,181 +0,0 @@ -/* suffix.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SUFFIX (Suffix a character string) */ -/* Subroutine */ int suffix_(char *suff, integer *spaces, char *string, - ftnlen suff_len, ftnlen string_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer slen, l; - extern integer lastnb_(char *, ftnlen); - integer end; - -/* $ Abstract */ - -/* Add a suffix to a character 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 */ - -/* ASSIGNMENT, CHARACTER, STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SUFF I Suffix. */ -/* SPACES I Number of spaces separating prefix and suffix. */ -/* STRING I/O Prefix on input, string on output. */ - -/* $ Detailed_Input */ - -/* SUFF is the suffix to be added to the string. */ -/* Leading blanks are significant. (A blank */ -/* suffix is interpreted as a null suffix.) */ - -/* SPACES is the number of spaces (blanks) in the output */ -/* string separating the last non-blank character */ -/* of the prefix from the first (blank or non-blank) */ -/* character of the suffix. Typically, this will be */ -/* zero or one. If not positive, SPACES defaults to */ -/* zero. */ - -/* STRING on input is the prefix to which the suffix is */ -/* to be added. Leading blanks are significant. */ -/* Trailing blanks are ignored. */ - -/* $ Detailed_Output */ - -/* STRING on output is the suffixed string. If STRING */ -/* is not large enough to contain the output string, */ -/* the output string is truncated on the right. */ - -/* STRING may NOT overwrite SUFF. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The suffix is added to the right of the last non-blank character */ -/* of the prefix. (Any necessary truncation is done automatically.) */ - -/* $ Examples */ - -/* The following examples illustrate the use of SUFFIX. */ - -/* SUFF STRING (input) SPACES STRING (output) */ -/* ---------- -------------- ------ --------------- */ -/* 'abc ' 'def ' 0 'defabc ' */ -/* 'abc ' 'def ' 1 'def abc' */ -/* 'abc ' ' def ' 0 ' defabc' */ -/* 'abc ' ' def ' 1 ' def ab' */ -/* ' abc ' 'def ' 0 'def abc' */ -/* ' abc ' 'def ' 1 'def ab' */ -/* ' abc ' ' def ' -1 ' def ab' */ -/* ' ' 'def ' 0 'def ' */ -/* ' ' 'def ' 1 'def ' */ -/* ' abc ' ' ' 0 ' abc ' */ -/* ' abc ' ' ' 1 ' abc ' */ - -/* $ Restrictions */ - -/* SUFF and STRING must be distinct. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* suffix a character_string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* SLEN is the allocated length of the string. L is the location of */ -/* the last non-blank character of the prefix. */ - - slen = i_len(string, string_len); - l = lastnb_(string, string_len); - -/* Put the suffix at the end of the string. The spaces will fill */ -/* themselves in. */ - - end = l + max(*spaces,0); - if (end < slen) { - i__1 = end; - s_copy(string + i__1, suff, string_len - i__1, suff_len); - } - return 0; -} /* suffix_ */ - diff --git a/ext/spice/src/cspice/sumad.c b/ext/spice/src/cspice/sumad.c deleted file mode 100644 index b6928efa2e..0000000000 --- a/ext/spice/src/cspice/sumad.c +++ /dev/null @@ -1,165 +0,0 @@ -/* sumad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SUMAD ( Sum of a double precision array ) */ -doublereal sumad_(doublereal *array, integer *n) -{ - /* System generated locals */ - integer i__1; - doublereal ret_val; - - /* Local variables */ - integer i__; - doublereal sum; - -/* $ Abstract */ - -/* Return the sum of the elements of a double precision array. */ - -/* $ 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 */ - -/* ARRAY, MATH, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* N I Number of elements in ARRAY. */ -/* SUMAI O Sum of the elements of ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* N is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* SUMAD is the sum of the elements of the input array. */ -/* That is, */ - -/* SUMAD = ARRAY(1) + ARRAY(2) + ... + ARRAY(N) */ - -/* If N is zero or negative, SUMAD is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The value of the function is initially set to zero. The elements */ -/* of the array are then added. If the number of elements is */ -/* zero or negative, SUMAD is zero. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* ARRAY(1) = 12.D0 */ -/* ARRAY(2) = 1.D0 */ -/* ARRAY(3) = 4.D0 */ -/* ARRAY(4) = 75.D0 */ -/* ARRAY(5) = 18.D0 */ - -/* Then */ - -/* SUMAD ( ARRAY, -3 ) = 0.D0 */ -/* SUMAD ( ARRAY, 0 ) = 0.D0 */ -/* SUMAD ( ARRAY, 1 ) = 12.D0 */ -/* SUMAD ( ARRAY, 2 ) = 13.D0 */ -/* SUMAD ( ARRAY, 5 ) = 110.D0 */ -/* SUMAD ( ARRAY(3), 3 ) = 97.D0 */ - - -/* $ Restrictions */ - -/* SUMAD does not check for overflow. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* sum of a d.p. array */ - -/* -& */ - -/* Local variables */ - - -/* Begin at zero. */ - - sum = 0.; - -/* Sum the elements. If N is zero or negative, nothing happens. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sum += array[i__ - 1]; - } - -/* Return the sum. */ - - ret_val = sum; - return ret_val; -} /* sumad_ */ - diff --git a/ext/spice/src/cspice/sumad_c.c b/ext/spice/src/cspice/sumad_c.c deleted file mode 100644 index 261c0d0ba4..0000000000 --- a/ext/spice/src/cspice/sumad_c.c +++ /dev/null @@ -1,160 +0,0 @@ -/* - --Procedure sumad_c ( Sum of a double precision array ) - --Abstract - - Return the sum of the elements of a double precision array. - --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 - - ARRAY, MATH, UTILITY - -*/ - - #include "SpiceUsr.h" - #undef sumad_c - - - SpiceDouble sumad_c ( ConstSpiceDouble * array, - SpiceInt n ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - array I Input array. - n I Number of elements in the array. - - The function returns the sum of the elements of the input array. - --Detailed_Input - - array is the input array. - - n is the number of elements in the array. - --Detailed_Output - - The function returns the sum of the elements of the input array. - That is, - - sumad_c ( array, n ) = array[0] + array[1] + ... + array[n-1] - - If n is zero or negative, sumad_c returns zero. - --Parameters - - None. - --Particulars - - The value of the function is initially set to zero. The elements - of the array are then added. If the number of elements is - zero or negative, sumad_c is zero. - --Examples - - Let array contain the following elements. - - array[0] = 12. - array[1] = 1. - array[2] = 4. - array[3] = 75. - array[4] = 18. - - Then - - sumad_c ( array, -3 ) = 0. - sumad_c ( array, 0 ) = 0. - sumad_c ( array, 1 ) = 12. - sumad_c ( array, 2 ) = 13. - sumad_c ( array, 5 ) = 110. - sumad_c ( array+2, 3 ) = 97. - - --Restrictions - - sumad_c does not check for overflow. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 24-MAR-1999 (IMU) (NJB) - --Index_Entries - - sum of a d.p. array - --& -*/ - -{ /* Begin sumad_c */ - - /* - Local variables - */ - SpiceDouble retval; - - SpiceInt i; - - - - retval = 0.; - - for ( i = 0; i < n; i++ ) - { - retval += array[i]; - } - - return ( retval ); - - -} /* End sumad_c */ diff --git a/ext/spice/src/cspice/sumai.c b/ext/spice/src/cspice/sumai.c deleted file mode 100644 index 9fe41482b4..0000000000 --- a/ext/spice/src/cspice/sumai.c +++ /dev/null @@ -1,163 +0,0 @@ -/* sumai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SUMAI ( Sum of an integer array ) */ -integer sumai_(integer *array, integer *n) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer i__, sum; - -/* $ Abstract */ - -/* Return the sum of the elements of an integer array. */ - -/* $ 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 */ - -/* ARRAY, MATH, UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ARRAY I Input array. */ -/* N I Number of elements in ARRAY. */ -/* SUMAI O Sum of the elements of ARRAY. */ - -/* $ Detailed_Input */ - -/* ARRAY is the input array. */ - -/* N is the number of elements in the array. */ - -/* $ Detailed_Output */ - -/* SUMAI is the sum of the elements of the input array. */ -/* That is, */ - -/* SUMAI = ARRAY(1) + ARRAY(2) + ... + ARRAY(N) */ - -/* If N is zero or negative, SUMAI is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The value of the function is initially set to zero. The elements */ -/* of the array are then added. If the number of elements is */ -/* zero or negative, SUMAI is zero. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* ARRAY(1) = 12 */ -/* ARRAY(2) = 1 */ -/* ARRAY(3) = 4 */ -/* ARRAY(4) = 75 */ -/* ARRAY(5) = 18 */ - -/* Then */ - -/* SUMAI ( ARRAY, -3 ) = 0 */ -/* SUMAI ( ARRAY, 0 ) = 0 */ -/* SUMAI ( ARRAY, 1 ) = 12 */ -/* SUMAI ( ARRAY, 2 ) = 13 */ -/* SUMAI ( ARRAY, 5 ) = 110 */ -/* SUMAI ( ARRAY(3), 3 ) = 97 */ - - -/* $ Restrictions */ - -/* SUMAI does not check for overflow. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* sum of an integer array */ - -/* -& */ - -/* Local variables */ - - -/* Begin at zero. */ - - sum = 0; - -/* Sum the elements. If N is zero or negative, nothing happens. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sum += array[i__ - 1]; - } - -/* Return the sum. */ - - ret_val = sum; - return ret_val; -} /* sumai_ */ - diff --git a/ext/spice/src/cspice/sumai_c.c b/ext/spice/src/cspice/sumai_c.c deleted file mode 100644 index 52c5689dda..0000000000 --- a/ext/spice/src/cspice/sumai_c.c +++ /dev/null @@ -1,160 +0,0 @@ -/* - --Procedure sumai_c ( Sum of an integer array ) - --Abstract - - Return the sum of the elements of an integer array. - --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 - - ARRAY, MATH, UTILITY - -*/ - - #include "SpiceUsr.h" - #undef sumai_c - - - SpiceInt sumai_c ( ConstSpiceInt * array, - SpiceInt n ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - array I Input array. - n I Number of elements in the array. - - The function returns the sum of the elements of the input array. - --Detailed_Input - - array is the input array. - - n is the number of elements in the array. - --Detailed_Output - - The function returns the sum of the elements of the input array. - That is, - - sumai_c ( array, n ) = array[0] + array[1] + ... + array[n-1] - - If n is zero or negative, sumai_c returns zero. - --Parameters - - None. - --Particulars - - The value of the function is initially set to zero. The elements - of the array are then added. If the number of elements is zero or - negative, sumai_c is zero. - --Examples - - Let array contain the following elements. - - array[0] = 12 - array[1] = 1 - array[2] = 4 - array[3] = 75 - array[4] = 18 - - Then - - sumai_c ( array, -3 ) = 0 - sumai_c ( array, 0 ) = 0 - sumai_c ( array, 1 ) = 12 - sumai_c ( array, 2 ) = 13 - sumai_c ( array, 5 ) = 110 - sumai_c ( array+2, 3 ) = 97 - - --Restrictions - - sumai_c does not check for overflow. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 24-MAR-1999 (IMU) (NJB) - --Index_Entries - - sum of an integer array - --& -*/ - -{ /* Begin sumai_c */ - - /* - Local variables - */ - - SpiceInt retval; - SpiceInt i; - - - - retval = 0; - - for ( i = 0; i < n; i++ ) - { - retval += array[i]; - } - - return ( retval ); - - -} /* End sumai_c */ diff --git a/ext/spice/src/cspice/surfnm.c b/ext/spice/src/cspice/surfnm.c deleted file mode 100644 index 40af905db8..0000000000 --- a/ext/spice/src/cspice/surfnm.c +++ /dev/null @@ -1,294 +0,0 @@ -/* surfnm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure SURFNM ( Surface normal vector on an ellipsoid ) */ -/* Subroutine */ int surfnm_(doublereal *a, doublereal *b, doublereal *c__, - doublereal *point, doublereal *normal) -{ - /* Initialized data */ - - static char mssg[32*7] = "Axis A was nonpositive. " "Axis B was " - "nonpositive. " "Axes A and B were nonpositive. " "Axis " - "C was nonpositive. " "Axes A and C were nonpositive. " - "Axes B and C were nonpositive. " "All three axes were nonposit" - "ive."; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2]; - doublereal d__1; - char ch__1[35]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - static doublereal m; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen); - static doublereal a1, b1, c1; - extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *) - , chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - static integer bad; - -/* $ Abstract */ - -/* This routine computes the outward-pointing, unit normal vector */ -/* from a point on the surface of an ellipsoid. */ - -/* $ 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 */ - -/* ELLIPSOID, GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I Length of the ellisoid semi-axis along the x-axis. */ -/* B I Length of the ellisoid semi-axis along the y-axis. */ -/* C I Length of the ellisoid semi-axis along the z-axis. */ -/* POINT I Body-fixed coordinates of a point on the ellipsoid */ -/* NORMAL O Outward pointing unit normal to ellipsoid at POINT */ - -/* $ Detailed_Input */ - -/* A This is the length of the semi-axis of the ellipsoid */ -/* that is parallel to the x-axis of the body-fixed */ -/* coordinate system. */ - -/* B This is the length of the semi-axis of the ellipsoid */ -/* that is parallel to the y-axis of the body-fixed */ -/* coordinate system. */ - -/* C This is the length of the semi-axis of the ellipsoid */ -/* that is parallel to the z-axis of the body-fixed */ -/* coordinate system. */ - -/* POINT This is a 3-vector giving the bodyfixed coordinates */ -/* of a point on the ellipsoid. In bodyfixed coordinates, */ -/* the semi-axes of the ellipsoid are aligned with the */ -/* x, y, and z-axes of the coordinate system. */ - -/* $ Detailed_Output */ - -/* NORMAL A unit vector pointing away from the ellipsoid and */ -/* normal to the ellipsoid at POINT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any of the axes are non-positive, the error */ -/* 'SPICE(BADAXISLENGTH)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the outward pointing unit normal vector to */ -/* the ellipsoid having semi-axes of length A, B, and C from the */ -/* point POINT. */ - -/* $ Examples */ - -/* A typical use of SURFNM would be to find the angle of incidence */ -/* of the light from the sun at a point on the surface of an */ -/* ellipsoid. */ - -/* Let Q be a 3-vector representing the rectangular body-fixed */ -/* coordinates of a point on the ellipsoid (we are assuming that */ -/* the axes of the ellipsoid are aligned with the axes of the */ -/* body fixed frame.) Let V be the vector from Q to the sun in */ -/* bodyfixed coordinates. Then the following code fragment could */ -/* be used to compute angle of incidence of sunlight at Q. */ - -/* CALL SURFNM ( A, B, C, Q, NRML ) */ - -/* INCIDN = VSEP ( V, NRML ) */ - - -/* $ Restrictions */ - -/* It is assumed that the input POINT is indeed on the ellipsoid. */ -/* No checking for this is done. */ - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.3.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT call. */ - -/* - SPICELIB Version 1.2.0, 07-AUG-1996 (WLT) */ - -/* Added a SAVE statement so that the error message will */ -/* not be lost between separate invocations of the routine. */ - -/* - SPICELIB Version 1.1.0, 21-JUL-1995 (WLT) */ - -/* A typo in the Examples section was corrected */ - -/* - 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 */ - -/* surface normal vector on an ellipsoid */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 02-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VHAT call. */ - -/* - Beta Version 2.0.0, 9-JAN-1989 (WLT) */ - -/* Error handling added. */ - -/* The algorithm was modified from the initial obvious routine */ -/* to one that is immune to numerical catastrophes (multiplication */ -/* or division overflows). */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SURFNM", (ftnlen)6); - } - -/* Check the axes to make sure that none of them is less than or */ -/* equal to zero. If one is, signal an error and return. */ - - bad = 0; - if (*a <= 0.) { - ++bad; - } - if (*b <= 0.) { - bad += 2; - } - if (*c__ <= 0.) { - bad += 4; - } - if (bad > 0) { -/* Writing concatenation */ - i__2[0] = 32, a__1[0] = mssg + (((i__1 = bad - 1) < 7 && 0 <= i__1 ? - i__1 : s_rnge("mssg", i__1, "surfnm_", (ftnlen)247)) << 5); - i__2[1] = 3, a__1[1] = " ? "; - s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)35); - setmsg_(ch__1, (ftnlen)35); - errch_(" ? ", "The A,B, and C axes were #, #, and # respectively.", ( - ftnlen)3, (ftnlen)50); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(BADAXISLENGTH)", (ftnlen)20); - chkout_("SURFNM", (ftnlen)6); - return 0; - } - -/* Mathematically we want to compute (Px/a**2, Py/b**2, Pz/c**2) */ -/* and then convert this to a unit vector. However, computationally */ -/* this can blow up in our faces. But note that only the ratios */ -/* a/b, b/c and a/c are important in computing the unit normal. */ -/* We can use the trick below to avoid the unpleasantness of */ -/* multiplication and division overflows. */ - -/* Computing MIN */ - d__1 = min(*a,*b); - m = min(d__1,*c__); - -/* M can be divided by A,B or C without fear of an overflow */ -/* occuring. */ - - a1 = m / *a; - b1 = m / *b; - c1 = m / *c__; - -/* All of the terms A1,B1,C1 are less than 1. Thus no overflows */ -/* can occur. */ - - normal[0] = point[0] * (a1 * a1); - normal[1] = point[1] * (b1 * b1); - normal[2] = point[2] * (c1 * c1); - vhatip_(normal); - chkout_("SURFNM", (ftnlen)6); - return 0; -} /* surfnm_ */ - diff --git a/ext/spice/src/cspice/surfnm_c.c b/ext/spice/src/cspice/surfnm_c.c deleted file mode 100644 index b598561897..0000000000 --- a/ext/spice/src/cspice/surfnm_c.c +++ /dev/null @@ -1,190 +0,0 @@ -/* - --Procedure surfnm_c ( Surface normal vector on an ellipsoid ) - --Abstract - - This routine computes the outward-pointing, unit normal vector - from a point on the surface of an ellipsoid. - --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 - - ELLIPSOID, GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef surfnm_c - - - void surfnm_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble point[3], - SpiceDouble normal[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I Length of the ellisoid semi-axis along the x-axis. - b I Length of the ellisoid semi-axis along the y-axis. - c I Length of the ellisoid semi-axis along the z-axis. - point I Body-fixed coordinates of a point on the ellipsoid - normal O Outward pointing unit normal to ellipsoid at point - --Detailed_Input - - a This is the length of the semi-axis of the ellipsoid - that is parallel to the x-axis of the body-fixed - coordinate system. - - b This is the length of the semi-axis of the ellipsoid - that is parallel to the y-axis of the body-fixed - coordinate system. - - c This is the length of the semi-axis of the ellipsoid - that is parallel to the z-axis of the body-fixed - coordinate system. - - point This is a 3-vector giving the bodyfixed coordinates - of a point on the ellipsoid. In bodyfixed coordinates, - the semi-axes of the ellipsoid are aligned with the - x, y, and z-axes of the coordinate system. - --Detailed_Output - - normal A unit vector pointing away from the ellipsoid and - normal to the ellipsoid at point. - --Parameters - - None. - --Exceptions - - 1) If any of the axes are non-positive, the error - SPICE(BADAXISLENGTH) will be signalled. - --Files - - None. - --Particulars - - This routine computes the outward pointing unit normal vector to - the ellipsoid having semi-axes of length a, b, and c from the - point point. - --Examples - - A typical use of surfnm_c would be to find the angle of incidence - of the light from the sun at a point on the surface of an - ellipsoid. - - Let q be a 3-vector representing the rectangular body-fixed - coordinates of a point on the ellipsoid (we are assuming that - the axes of the ellipsoid are aligned with the axes of the - body fixed frame.) Let v be the vector from q to the sun in - bodyfixed coordinates. Then the following code fragment could - be used to compute angle of incidence of sunlight at q. - - surfnm_c ( a, b, c, q, nrml ); - - incidn = vsep_c ( v, nrml ); - - --Restrictions - - It is assumed that the input point is indeed on the ellipsoid. - No checking for this is done. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 1.3.1, 31-JAN-2008 (BVS) - - Removed '-Revisions' from the header. - - -CSPICE Version 1.3.0, 22-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Removed local variables used for temporary capture of outputs. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.2.0, 07-AUG-1996 (WLT) - --Index_Entries - - surface normal vector on an ellipsoid - --& -*/ - -{ /* Begin surfnm_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "surfnm_c"); - - - /* - Call the f2c'd surfpt. - */ - surfnm_( (doublereal *) &a, - (doublereal *) &b, - (doublereal *) &c, - (doublereal *) point, - (doublereal *) normal ); - - - chkout_c ( "surfnm_c" ); - - -} /* End surfnm_c */ diff --git a/ext/spice/src/cspice/surfpt.c b/ext/spice/src/cspice/surfpt.c deleted file mode 100644 index eb4d5467b3..0000000000 --- a/ext/spice/src/cspice/surfpt.c +++ /dev/null @@ -1,487 +0,0 @@ -/* surfpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__3 = 3; -static doublereal c_b19 = 1.; - -/* $Procedure SURFPT ( Surface point on an ellipsoid ) */ -/* Subroutine */ int surfpt_(doublereal *positn, doublereal *u, doublereal *a, - doublereal *b, doublereal *c__, doublereal *point, logical *found) -{ - /* Initialized data */ - - static char mssg[32*7] = "Axis A was nonpositive. " "Axis B was " - "nonpositive. " "Axes A and B were nonpositive. " "Axis " - "C was nonpositive. " "Axes A and C were nonpositive. " - "Axes B and C were nonpositive. " "All three axes were nonposit" - "ive."; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2]; - doublereal d__1, d__2; - char ch__1[35]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - double sqrt(doublereal); - - /* Local variables */ - doublereal pmag, ymag, sign; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal p[3], scale, x[3], y[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen), vlcom_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), vperp_(doublereal *, doublereal *, doublereal *); - extern doublereal vnorm_(doublereal *); - doublereal yproj[3]; - extern logical vzero_(doublereal *); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - doublereal ux[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - integer bad; - -/* $ Abstract */ - -/* Determine the intersection of a line-of-sight vector with the */ -/* surface of an ellipsoid. */ - -/* $ 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 */ - -/* ELLIPSOID, GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* POSITN I Position of the observer in body-fixed frame. */ -/* U I Vector from the observer in some direction. */ -/* A I Length of ellipsoid semi-axis along the x-axis. */ -/* B I Length of ellipsoid semi-axis along the y-axis. */ -/* C I Length of ellipsoid semi-axis along the z-axis. */ -/* POINT O Point on the ellipsoid pointed to by U. */ -/* FOUND O Flag indicating if U points at the ellipsoid. */ - -/* $ Detailed_Input */ - -/* POSITN 3-vector giving the position of an observer with */ -/* respect to the center of an ellipsoid. The vector is */ -/* expressed in a body-fixed reference frame. The */ -/* semi-axes of the ellipsoid are aligned with the x, y, */ -/* and z-axes of the body-fixed frame. */ - -/* U Pointing vector emanating from the observer. */ - -/* A Length of the semi-axis of the ellipsoid that is */ -/* parallel to the x-axis of the body-fixed reference */ -/* frame. */ - -/* B Length of the semi-axis of the ellipsoid that is */ -/* parallel to the y-axis of the body-fixed reference */ -/* frame. */ - -/* C Length of the semi-axis of the ellipsoid that is */ -/* parallel to the z-axis of the body-fixed reference */ -/* frame. */ - -/* $ Detailed_Output */ - -/* POINT If the ray with direction vector U emanating from */ -/* POSITN intersects the ellipsoid, POINT will be */ -/* returned with the body-fixed coordinates of the point */ -/* where the ray first meets the ellipsoid. Otherwise, */ -/* POINT will be returned as (0, 0, 0). */ - -/* FOUND A logical flag indicating whether or not the ray from */ -/* POSITN with direction U actually intersects the */ -/* ellipsoid. If the ray does intersect the ellipsoid, */ -/* FOUND will be returned as .TRUE. If the ray misses the */ -/* ellipsoid, FOUND will be returned as .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine assumes that an ellipsoid having semi-axes of */ -/* length A, B and C is given. Moreover, it is assumed that these */ -/* axes are parallel to the x-, y-, and z-axes of a reference frame */ -/* whose origin is the geometric center of the ellipsoid---this is */ -/* called the body-fixed reference frame. */ - -/* $ Examples */ - -/* A typical use of SURFPT would be to obtain the planetocentric */ -/* coordinates of the point at which the optic axis of a */ -/* spacecraft-mounted instrument intersects the surface of a target */ -/* body, given the following items. */ - -/* 1) The epoch (ET) of observation, and the inertial */ -/* pointing (VPNT) of the instrument at this epoch. */ - -/* 2) The apparent position (VTARG) of the center of the */ -/* target body as seen from the spacecraft at the epoch */ -/* of observation, and the one-way light time (TAU) */ -/* from the target to the spacecraft. */ - -/* In order to find the point of intersection, the following */ -/* items are also needed. */ - -/* 3) The transformation (TIBF) from inertial */ -/* to body-fixed coordinates at epoch ET-TAU. */ - -/* 4) The radii (R) of the tri-axial ellipsoid */ -/* used to model the target body. */ - -/* These may be obtained from the kernel pool via calls to PXFORM */ -/* and BODVRD or BODVCD respectively. */ - -/* The position of the observer is just the negative of the */ -/* spacecraft-target vector, VTARG, computed using the VMINUS */ -/* module. (Note that this is NOT the same as the apparent position */ -/* of the spacecraft as seen from the target!) Both vectors must be */ -/* specified in the body-fixed reference frame. The point of */ -/* intersection is found as follows: */ - -/* CALL VMINUS ( VTARG, VPOS ) */ -/* CALL MXV ( TIBF, VPOS, VPOS ) */ -/* CALL MXV ( TIBF, VPNT, VPNT ) */ - -/* CALL SURFPT ( VPOS, VPNT, R(1), R(2), R(3), VSURF, FOUND ) */ - -/* Note that VSURF may or may not be a point of intersection, */ -/* depending on whether FOUND is .TRUE. or .FALSE. Note also that */ -/* VSURF is a vector from the center to the surface of the */ -/* target, in body-fixed coordinates, which may be converted */ -/* directly to planetocentric latitude, longitude, and radius: */ - -/* CALL RECLAT ( VSURF, RADIUS, LONG, LAT ) */ - -/* To get the inertial vector from the spacecraft to the */ -/* surface point, you must subtract VPOS from VSURF, and rotate */ -/* the resulting vector back to inertial coordinates: */ - -/* CALL VSUB ( VSURF, VPOS, VSURF ) */ -/* CALL MTXV ( TIBF, VSURF, VSURF ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input vector is the zero vector, the error */ -/* SPICE(ZEROVECTOR) is signaled. */ - -/* 2) If any of the body's axes is zero, the error */ -/* SPICE(BADAXISLENGTH) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 03-APR-2006 (NJB) */ - -/* Bug fix: intercept point is now always set to the */ -/* ray's vertex when the vertex is on the ellipsoid's */ -/* surface. This routine now uses discovery check-in. */ - -/* - SPICELIB Version 1.2.2, 24-OCT-2005 (NJB) */ - -/* Updated header to refer to BODVRD and BODVCD instead of */ -/* BODVAR. */ - -/* - SPICELIB Version 1.2.1, 27-JUL-2003 (NJB) (CHA) */ - -/* Various header corrections were made. The example program */ -/* was upgraded to use real kernels, and the program's output is */ -/* shown. */ - -/* - SPICELIB Version 1.2.0, 28-NOV-2002 (NJB) */ - -/* Re-implemented intercept computation to reduce loss of */ -/* precision. */ - -/* Changed SAVE statement to save only the error message. */ -/* Previously all local variables were saved. */ - -/* - SPICELIB Version 1.1.0, 07-AUG-1996 (WLT) */ - -/* Added a SAVE statement so that the error message will */ -/* not be lost between separate invocations of the routine. */ - -/* - 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 */ - -/* line of sight intercept with body */ -/* point of intersection between ray and ellipsoid */ -/* surface point of intersection of ray and ellipsoid */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 28-NOV-2002 (NJB) */ - -/* Re-implemented intercept computation to reduce loss of */ -/* precision. New algorithm maps input ellipsoid to unit */ -/* sphere, finds closest point on input ray to the origin, */ -/* then finds the offset from this point to the surface. */ - -/* - Beta Version 2.0.0, 9-JAN-1988 (WLT) */ - -/* Short error message 'SPICE(ZEROAXISLENGTH)' changed to */ -/* 'SPICE(BADAXISLENGTH)' */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. */ - - if (return_()) { - return 0; - } - -/* Check the input vector to see if its the zero vector. If it is */ -/* signal an error and return. */ - - if (vzero_(u)) { - chkin_("SURFPT", (ftnlen)6); - setmsg_("SURFPT: The input vector is the zero vector.", (ftnlen)44); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("SURFPT", (ftnlen)6); - return 0; - } - -/* Check the axis to make sure that none of them is less than or */ -/* equal to zero. If one is, signal an error and return. */ - - bad = 0; - if (*a <= 0.) { - ++bad; - } - if (*b <= 0.) { - bad += 2; - } - if (*c__ <= 0.) { - bad += 4; - } - if (bad > 0) { - chkin_("SURFPT", (ftnlen)6); -/* Writing concatenation */ - i__2[0] = 32, a__1[0] = mssg + (((i__1 = bad - 1) < 7 && 0 <= i__1 ? - i__1 : s_rnge("mssg", i__1, "surfpt_", (ftnlen)354)) << 5); - i__2[1] = 3, a__1[1] = " ? "; - s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)35); - setmsg_(ch__1, (ftnlen)35); - errch_(" ? ", "The A,B, and C axes were #, #, and # respectively.", ( - ftnlen)3, (ftnlen)50); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(BADAXISLENGTH)", (ftnlen)20); - chkout_("SURFPT", (ftnlen)6); - return 0; - } - -/* We're done with the error checks. Set the outputs to the */ -/* appropriate values for the "no intersection" case. */ - - *found = FALSE_; - cleard_(&c__3, point); - -/* Apply a linear transformation to the point, direction vector, */ -/* and ellipsoid to transform the problem to one having the unit */ -/* sphere as the target ellipsoid. (The transformation of the */ -/* ellipsoid is implicit.) */ - - x[0] = u[0] / *a; - x[1] = u[1] / *b; - x[2] = u[2] / *c__; - y[0] = positn[0] / *a; - y[1] = positn[1] / *b; - y[2] = positn[2] / *c__; - -/* Find the component P of Y (the ray's vertex) orthogonal to X */ -/* (the ray's direction). */ - - vperp_(y, x, p); - -/* Find the component of Y parallel to X. */ - - vsub_(y, p, yproj); - -/* Find the magnitudes of Y and P. */ - - ymag = vnorm_(y); - pmag = vnorm_(p); - -/* Get a unitized copy of X. */ - - vhat_(x, ux); - -/* Now determine whether there's an intersection. Consider */ -/* the case where Y is outside the sphere first. */ - - if (ymag > 1.) { - -/* If P is outside of the sphere, there can be no intersection. */ - - if (pmag > 1.) { - return 0; - } - -/* If X points in the same direction as YPROJ, then the ray */ -/* is pointing away from the sphere, and there is no */ -/* intersection. */ - - if (vdot_(yproj, x) > 0.) { - return 0; - } - -/* At this point we know there's an intersection. */ - - if (pmag == 1.) { - -/* The vector P we've found is the singleton point of */ -/* intersection. All we have to do is transform P by */ -/* applying the inverse of our original linear transformation. */ - - point[0] = p[0] * *a; - point[1] = p[1] * *b; - point[2] = p[2] * *c__; - *found = TRUE_; - return 0; - } - -/* At this point we know there's a non-trivial intersection. */ - -/* Set the sign of the coefficient of UX (a unitized copy */ -/* of X) that will be used to compute the intercept point. */ -/* In this case the coefficient of UX has negative sign because */ -/* the vector we're adding to P points toward Y. */ - - sign = -1.; - } else if (ymag == 1.) { - -/* The ray's vertex is on the surface of the ellipsoid. */ -/* The vertex is the first point of intersection. */ - - vequ_(positn, point); - *found = TRUE_; - return 0; - } else { - -/* Y is inside the sphere, so there's definitely an intersection. */ -/* In this case, the intercept is obtained by adding a positive */ -/* multiple of UX to P. */ - - sign = 1.; - } - - -/* We have a small amount of work to do: we'll find the multiple */ -/* of X that when added to P yields the desired intercept point. */ - -/* The magnitude of the half-chord connecting P and the surface */ -/* is just */ -/* ____________ */ -/* \/ 1 - PMAG**2 */ - - -/* Computing MAX */ - d__1 = 0., d__2 = 1 - pmag * pmag; - scale = sqrt((max(d__1,d__2))); - -/* Find the intercept point on the unit sphere. */ - - d__1 = sign * scale; - vlcom_(&c_b19, p, &d__1, ux, point); - -/* Undo our linear transformation. */ - - point[0] *= *a; - point[1] *= *b; - point[2] *= *c__; - *found = TRUE_; - return 0; -} /* surfpt_ */ - diff --git a/ext/spice/src/cspice/surfpt_c.c b/ext/spice/src/cspice/surfpt_c.c deleted file mode 100644 index 2ea10037b8..0000000000 --- a/ext/spice/src/cspice/surfpt_c.c +++ /dev/null @@ -1,270 +0,0 @@ -/* - --Procedure surfpt_c ( Surface point on an ellipsoid ) - --Abstract - - Determine the intersection of a line-of-sight vector with the - surface of an ellipsoid. - --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 - - ELLIPSOID - GEOMETRY - INTERSECTION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef surfpt_c - - - void surfpt_c ( ConstSpiceDouble positn[3], - ConstSpiceDouble u[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble point[3], - SpiceBoolean * found ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - positn I Position of the observer in body-fixed frame. - u I Vector from the observer in some direction. - a I Length of the ellipsoid semi-axis along the x-axis. - b I Length of the ellipsoid semi-axis along the y-axis. - c I Length of the ellipsoid semi-axis along the z-axis. - point O Point on the ellipsoid pointed to by u. - found O Flag indicating if u points at the ellipsoid. - --Detailed_Input - - positn 3-vector giving the position of an observer with respect - to the center of an ellipsoid. The vector is expressed - in a body-fixed reference frame. The semi-axes of the - ellipsoid are aligned with the x, y, and z-axes of the - body-fixed frame. - - u Direction vector emanating from the observer. - - a Length of the semi-axis of the ellipsoid that is parallel - to the x-axis of the body-fixed reference frame. - - b Length of the semi-axis of the ellipsoid that is parallel - to the y-axis of the body-fixed reference frame. - - c Length of the semi-axis of the ellipsoid that is parallel - to the z-axis of the body-fixed reference frame. - - --Detailed_Output - - point If the ray with direction vector u emanating from - positn intersects the ellipsoid, point will be - returned with the body-fixed coordinates of the point - where the ray first meets the ellipsoid. Otherwise, - point will be returned as (0, 0, 0). - - found A logical flag indicating whether or not the ray from - positn with direction u actually intersects the - ellipsoid. If the ray does intersect the ellipsoid, - found will be returned as SPICETRUE. If the ray misses - the ellipsoid, found will be returned as SPICEFALSE. - --Parameters - - None. - --Particulars - - This routine assumes that an ellipsoid having semi-axes of length a, - b and c is given. Moreover, it is assumed that these axes are - parallel to the x-, y-, and z-axes of a coordinate system whose - origin is the geometric center of the ellipsoid---this is called the - body-fixed coordinate frame. - --Examples - - A typical use of surfpt_c would be to obtain the planetocentric - coordinates of the point at which the optic axis of a - spacecraft-mounted instrument intersects the surface of a target - body, given the following items. - - 1) The epoch (et) of observation, and the inertial - pointing (vpnt) of the instrument at this epoch. - - 2) The apparent position (vtarg) of the center of the - target body as seen from the spacecraft at the epoch - of observation, and the one-way light time (tau) - from the target to the spacecraft. - - In order to find the point of intersection, the following items are - also needed. - - 3) The transformation (tibf) from inertial - to body-fixed coordinates at epoch et-tau. - - 4) The radii (r) of the tri-axial ellipsoid - used to model the target body. - - These may be obtained from the kernel pool via calls to pxform_c and - bodvrd_c or bodvcd_c respectively. - - The position of the observer is just the negative of the - spacecraft-target vector, vtarg, computed using the vminus_c module. - (Note that this is NOT the same as the apparent position of the - spacecraft as seen from the target!) Both vectors must be in - body-fixed coordinates. The point of intersection is found as - follows. - - vminus_c ( vtarg, vpos ); - mxv_c ( tibf, vpos, vpos ); - mxv_c ( tibf, vpnt, vpnt ); - - surfpt_c ( vpos, vpnt, r[0], r[1], r[2], vsurf, &found ); - - Note that vsurf may or may not be a point of intersection, depending - on whether found is SPICETRUE or SPICEFALSE. Note also that vsurf is - a vector from the center to the surface of the target, in body-fixed - coordinates, which may be converted directly to planetocentric - latitude, longitude, and radius: - - reclat_c ( vsurf, &radius, &long, &lat ); - - To get the inertial vector from the spacecraft to the surface point, - you must subtract vpos from vsurf, and rotate the resulting vector - back to inertial coordinates: - - vsub_c ( vsurf, vpos, vsurf ); - mtxv_c ( tibf, vsurf, vsurf ); - - --Restrictions - - None. - --Exceptions - - 1) If the input vector is the zero vector, the error - SPICE(ZEROVECTOR) is signaled. - - 2) If any of the body's axes is zero, the error - SPICE(BADAXISLENGTH) is signaled. - --Files - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.4.3, 24-OCT-2005 (NJB) - - Header update: reference to bodvar_c was replaced with - references to bodvrd_c and bodvcd_c. - - -CSPICE Version 1.4.2, 27-JUL-2003 (NJB) (CHA) - - Various header corrections were made. - - -CSPICE Version 1.4.1, 28-NOV-2002 (NJB) - - Made miscellaneous updates to header comments. - - -CSPICE Version 1.4.0, 27-AUG-1999 (NJB) - - Now uses local "found" flag of type logical. - - -CSPICE Version 1.3.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.2.0, 08-FEB-1998 (NJB) - - Removed local variables used for temporary capture of outputs. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.1.0, 07-AUG-1996 (WLT) - --Index_Entries - - line of sight intercept with body - point of intersection between ray and ellipsoid - surface point of intersection of ray and ellipsoid - --& -*/ - -{ /* Begin surfpt_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "surfpt_c"); - - - /* - Call the f2c'd surfpt. - */ - surfpt_( (doublereal *) positn, - (doublereal *) u, - (doublereal *) &a, - (doublereal *) &b, - (doublereal *) &c, - (doublereal *) point, - (logical *) &fnd ); - - *found = fnd; - - chkout_c ( "surfpt_c"); - -} /* End surfpt_c */ diff --git a/ext/spice/src/cspice/surfpv.c b/ext/spice/src/cspice/surfpv.c deleted file mode 100644 index d524ce81e1..0000000000 --- a/ext/spice/src/cspice/surfpv.c +++ /dev/null @@ -1,682 +0,0 @@ -/* surfpv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b13 = 1.; - -/* $Procedure SURFPV ( Surface point and velocity ) */ -/* Subroutine */ int surfpv_(doublereal *stvrtx, doublereal *stdir, - doublereal *a, doublereal *b, doublereal *c__, doublereal *stx, - logical *found) -{ - /* System generated locals */ - doublereal d__1, d__2, d__3; - - /* Local variables */ - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal m, n[3], r__, u[3], v[3], x[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), dvhat_(doublereal *, - doublereal *); - doublereal level; - extern doublereal dpmax_(void); - doublereal third[3]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal dsnum; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - extern logical failed_(void); - doublereal du[3], dv[3], second[3], stdhat[6]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), surfnm_(doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int surfpt_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, logical *) - ; - doublereal udn, vmx[3]; - -/* $ Abstract */ - -/* Find the state (position and velocity) of the surface intercept */ -/* defined by a specified ray, ray velocity, and ellipsoid. */ - -/* $ 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 */ - -/* ELLIPSOID */ -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STVRTX I State of ray's vertex. */ -/* STDIR I State of ray's direction vector. */ -/* A I Length of ellipsoid semi-axis along the x-axis. */ -/* B I Length of ellipsoid semi-axis along the y-axis. */ -/* C I Length of ellipsoid semi-axis along the z-axis. */ -/* STX O State of surface intercept. */ -/* FOUND O Flag indicating whether intercept state was found. */ - -/* $ Detailed_Input */ - -/* STVRTX is the state of a ray's vertex. The first three */ -/* components of STVRTX are the vertex's x, y, and z */ -/* position components; the vertex's x, y, and z */ -/* velocity components follow. */ - -/* The reference frame relative to which STVRTX is */ -/* specified has axes aligned with with those of a */ -/* triaxial ellipsoid. See the description below of */ -/* the arguments A, B, and C. */ - -/* The vertex may be inside or outside of this */ -/* ellipsoid, but not on it, since the surface */ -/* intercept is a discontinuous function at */ -/* vertices on the ellipsoid's surface. */ - -/* No assumption is made about the units of length */ -/* and time, but these units must be consistent with */ -/* those of the other inputs. */ - - -/* STDIR is the state of the input ray's direction vector. */ -/* The first three components of STDIR are a non-zero */ -/* vector giving the x, y, and z components of the */ -/* ray's direction; the direction vector's x, y, and */ -/* z velocity components follow. */ - -/* STDIR is specified relative to the same reference */ -/* frame as is STVRTX. */ - - -/* A, */ -/* B, */ -/* C are, respectively, the lengths of a triaxial */ -/* ellipsoid's semi-axes lying along the x, y, and */ -/* z axes of the reference frame relative to which */ -/* STVRTX and STDIR are specified. */ - -/* $ Detailed_Output */ - -/* STX is the state of the intercept of the input ray on */ -/* the surface of the input ellipsoid. The first */ -/* three components of STX are the intercept's x, y, */ -/* and z position components; the intercept's x, y, */ -/* and z velocity components follow. */ - -/* STX is specified relative to the same reference */ -/* frame as are STVRTX and STDIR. */ - -/* STX is defined if and only if both the intercept */ -/* and its velocity are computable, as indicated by */ -/* the output argument FOUND. */ - -/* The position units of STX are the same as those of */ -/* STVRTX, STDIR, and A, B, and C. The time units are */ -/* the same as those of STVRTX and STDIR. */ - - -/* FOUND is a logical flag indicating whether STX is */ -/* defined. FOUND is .TRUE. if and only if both the */ -/* intercept and its velocity are computable. Note */ -/* that in some cases the intercept may computable */ -/* while the velocity is not; this can happen for */ -/* near-tangency cases. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input ray's direction vector is the zero vector, then */ -/* a routine in the call tree of this routine will signal */ -/* an error. */ - -/* 2) If any of the ellipsoid's axis lengths is nonpositive, */ -/* a routine in the call tree of this routine will signal */ -/* an error. */ - -/* 3) If the vertex of the ray is on the ellipsoid, */ -/* the error SPICE(INVALIDVERTEX) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The position and velocity of the ray's vertex as well as the */ -/* ray's direction vector and velocity vary with time. The */ -/* inputs to SURFPV may be considered the values of these */ -/* vector functions at a particular time, say t0. Thus */ - -/* State of vertex: STVRTX = ( V(t0), V'(t0) ) */ - -/* State of direction vector: STDIR = ( D(t0), D'(t0) ) */ - -/* To determine the intercept point, W(t0), we simply compute the */ -/* intersection of the ray originating at V(t0) in the direction of */ -/* D(t0) with the ellipsoid */ - -/* 2 2 2 */ -/* x y z */ -/* --- + --- + --- = 1 */ -/* 2 2 2 */ -/* A B C */ - -/* W(t) is the path of the intercept point along the surface of */ -/* the ellipsoid. To determine the velocity of the intercept point, */ -/* we need to take the time derivative of W(t), and evaluate it at */ -/* t0. Unfortunately W(t) is a complicated expression, and its */ -/* derivative is even more complicated. */ - -/* However, we know that the derivative of W(t) at t0, W'(t0), is */ -/* tangent to W(t) at t0. Thus W'(t0) lies in the plane that is */ -/* tangent to the ellipsoid at t0. Let X(t) be the curve in the */ -/* tangent plane that represents the intersection of the ray */ -/* emanating from V(t0) with direction D(t0) with that tangent */ -/* plane. */ - -/* X'(t0) = W'(t0) */ - -/* The expression for X'(t) is much simpler than that of W'(t); */ -/* SURFPV evaluates X'(t) at t0. */ - - -/* Derivation of X(t) and X'(t) */ -/* ---------------------------------------------------------------- */ - -/* W(t0) is the intercept point. Let N be a surface normal at I(t0). */ -/* Then the tangent plane at W(t0) is the set of points X(t) such */ -/* that */ - -/* < X(t) - I(t0), N > = 0 */ - -/* X(t) can be expressed as the vector sum of the vertex */ -/* and some scalar multiple of the direction vector, */ - -/* X(t) = V(t) + s(t) * D(t) */ - -/* where s(t) is a scalar function of time. The derivative of */ -/* X(t) is given by */ - -/* X'(t) = V'(t) + s(t) * D'(t) + s'(t) * D(t) */ - -/* We have V(t0), V'(t0), D(t0), D'(t0), W(t0), and N, but to */ -/* evaluate X'(t0), we need s(t0) and s'(t0). We derive an */ -/* expression for s(t) as follows. */ - -/* Because X(t) is in the tangent plane, it must satisfy */ - -/* < X(t) - W(t0), N > = 0. */ - -/* Substituting the expression for X(t) into the equation above */ -/* gives */ - -/* < V(t) + s(t) * D(t) - W(t0), N > = 0. */ - -/* Thus */ - -/* < V(t) - W(t0), N > + s(t) * < D(t), N > = 0, */ - -/* and */ -/* < V(t) - W(t0), N > */ -/* s(t) = - ------------------- */ -/* < D(t), N > */ - -/* The derivative of s(t) is given by */ - -/* s'(t) = */ - -/* < D(t),N > * < V'(t),N > - < V(t)-W(t0),N > * < D'(t),N > */ -/* - ----------------------------------------------------------- */ -/* 2 */ -/* < D(t), N > */ - -/* $ Examples */ - - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the compiler and supporting */ -/* libraries, and the machine specific arithmetic implementation. */ - - -/* 1) Illustrate the role of the ray vertex velocity and */ -/* ray direction vector velocity via several simple cases. Also */ -/* show the results of a near-tangency computation. */ - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* CHARACTER*(*) F1 */ -/* PARAMETER ( F1 = '(A,3E23.16)' ) */ - -/* DOUBLE PRECISION A */ -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION C */ -/* DOUBLE PRECISION STVRTX ( 6 ) */ -/* DOUBLE PRECISION STDIR ( 6 ) */ -/* DOUBLE PRECISION STX ( 6 ) */ - -/* INTEGER I */ - -/* LOGICAL FOUND */ - -/* A = 1.D0 */ -/* B = 2.D0 */ -/* C = 3.D0 */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Ellipsoid radii:' */ -/* WRITE (*,*) ' A = ', A */ -/* WRITE (*,*) ' B = ', B */ -/* WRITE (*,*) ' C = ', C */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Case 1: Vertex varies, direction is constant' */ -/* WRITE (*,*) ' ' */ - -/* STVRTX( 1 ) = 2.D0 */ -/* STVRTX( 2 ) = 0.D0 */ -/* STVRTX( 3 ) = 0.D0 */ -/* STVRTX( 4 ) = 0.D0 */ -/* STVRTX( 5 ) = 0.D0 */ -/* STVRTX( 6 ) = 3.D0 */ - - -/* STDIR ( 1 ) = -1.D0 */ -/* STDIR ( 2 ) = 0.D0 */ -/* STDIR ( 3 ) = 0.D0 */ -/* STDIR ( 4 ) = 0.D0 */ -/* STDIR ( 5 ) = 0.D0 */ -/* STDIR ( 6 ) = 0.D0 */ - -/* WRITE (*,* ) 'Vertex:' */ -/* WRITE (*,F1) ' ', ( STVRTX(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Vertex velocity:' */ -/* WRITE (*,F1) ' ', ( STVRTX(I), I = 4,6 ) */ -/* WRITE (*,* ) 'Direction:' */ -/* WRITE (*,F1) ' ', ( STDIR(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Direction velocity:' */ -/* WRITE (*,F1) ' ', ( STDIR(I), I = 4,6 ) */ - -/* CALL SURFPV ( STVRTX, STDIR, A, B, C, STX, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,*) ' No intercept state found.' */ -/* ELSE */ -/* WRITE (*,* ) 'Intercept:' */ -/* WRITE (*,F1) ' ', ( STX(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Intercept velocity:' */ -/* WRITE (*,F1) ' ', ( STX(I), I = 4,6 ) */ -/* WRITE (*,* ) ' ' */ -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Case 2: Vertex and direction both vary' */ -/* WRITE (*,*) ' ' */ - -/* STDIR ( 6 ) = 4.D0 */ - -/* WRITE (*,* ) 'Vertex:' */ -/* WRITE (*,F1) ' ', ( STVRTX(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Vertex velocity:' */ -/* WRITE (*,F1) ' ', ( STVRTX(I), I = 4,6 ) */ -/* WRITE (*,* ) 'Direction:' */ -/* WRITE (*,F1) ' ', ( STDIR(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Direction velocity:' */ -/* WRITE (*,F1) ' ', ( STDIR(I), I = 4,6 ) */ - -/* CALL SURFPV ( STVRTX, STDIR, A, B, C, STX, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,*) ' No intercept state found.' */ -/* ELSE */ -/* WRITE (*,* ) 'Intercept:' */ -/* WRITE (*,F1) ' ', ( STX(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Intercept velocity:' */ -/* WRITE (*,F1) ' ', ( STX(I), I = 4,6 ) */ -/* WRITE (*,* ) ' ' */ -/* END IF */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Case 3: Vertex and direction both vary;' */ -/* WRITE (*,*) ' near-tangent case.' */ -/* WRITE (*,*) ' ' */ - -/* STVRTX( 3 ) = C - 1.D-15 */ -/* STVRTX( 6 ) = 1.D299 */ -/* STDIR ( 6 ) = 1.D299 */ - -/* WRITE (*,* ) 'Vertex:' */ -/* WRITE (*,F1) ' ', ( STVRTX(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Vertex velocity:' */ -/* WRITE (*,F1) ' ', ( STVRTX(I), I = 4,6 ) */ -/* WRITE (*,* ) 'Direction:' */ -/* WRITE (*,F1) ' ', ( STDIR(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Direction velocity:' */ -/* WRITE (*,F1) ' ', ( STDIR(I), I = 4,6 ) */ - -/* CALL SURFPV ( STVRTX, STDIR, A, B, C, STX, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* WRITE (*,*) ' No intercept state found.' */ -/* ELSE */ -/* WRITE (*,* ) 'Intercept:' */ -/* WRITE (*,F1) ' ', ( STX(I), I = 1,3 ) */ -/* WRITE (*,* ) 'Intercept velocity:' */ -/* WRITE (*,F1) ' ', ( STX(I), I = 4,6 ) */ -/* WRITE (*,* ) ' ' */ -/* END IF */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 platform, the */ -/* output was: */ - - -/* Ellipsoid radii: */ -/* A = 1. */ -/* B = 2. */ -/* C = 3. */ - -/* Case 1: Vertex varies, direction is constant */ - -/* Vertex: */ -/* 0.2000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Vertex velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.3000000000000000E+01 */ -/* Direction: */ -/* -0.1000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Direction velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Intercept: */ -/* 0.1000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Intercept velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.3000000000000000E+01 */ - - -/* Case 2: Vertex and direction both vary */ - -/* Vertex: */ -/* 0.2000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Vertex velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.3000000000000000E+01 */ -/* Direction: */ -/* -0.1000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Direction velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.4000000000000000E+01 */ -/* Intercept: */ -/* 0.1000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Intercept velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.7000000000000000E+01 */ - - -/* Case 3: Vertex and direction both vary; */ -/* near-tangent case. */ - -/* Vertex: */ -/* 0.2000000000000000E+01 0.0000000000000000E+00 0.2999999999999999E+01 */ -/* Vertex velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.1000000000000000+300 */ -/* Direction: */ -/* -0.1000000000000000E+01 0.0000000000000000E+00 0.0000000000000000E+00 */ -/* Direction velocity: */ -/* 0.0000000000000000E+00 0.0000000000000000E+00 0.1000000000000000+300 */ -/* Intercept: */ -/* 0.2580956827951785E-07 0.0000000000000000E+00 0.2999999999999999E+01 */ -/* Intercept velocity: */ -/* -0.3874532036207665+307 0.0000000000000000E+00 0.2999999974190432+300 */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 31-MAR-2009 (NJB) (JEM) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* ellipsoid surface point and velocity */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SURFPV", (ftnlen)6); - -/* Determine the ellipsoid surface intercept point of the ray */ -/* emanating from the observer in the direction of D. We'll call it */ -/* X and it will go in the first three elements of STX once we */ -/* determine the velocity. If there is no intersection, we check */ -/* out. */ - -/* SURFPT takes care of some error checking too. It signals an error */ -/* if D is the zero vector or if A, B, or C are bad axis lengths. */ - - surfpt_(stvrtx, stdir, a, b, c__, x, found); - if (failed_() || ! (*found)) { - chkout_("SURFPV", (ftnlen)6); - return 0; - } - -/* No result has been found, since we don't know whether the */ -/* intercept velocity is computable. */ - - *found = FALSE_; - -/* Compute the state of a unit vector parallel to the ray's */ -/* direction "D." We know that the norm of D is not zero because */ -/* SURFPT checked it. */ - - dvhat_(stdir, stdhat); - -/* The velocity vector of the intercept point goes in the last three */ -/* elements of STX. Let */ - -/* X = W(t0) DX = dX/dt at t0 */ -/* V = V(t0) DV = dV/dt at t0 */ -/* U = D(t0) / ||D(t0)|| DU = d ( D(t)/||D(t)|| )/dt at t0 */ - -/* and N be the unit normal to the ellipsoid surface at X. */ -/* Then, from the derivation in $ Particulars above, */ - -/* DX = */ - - -/* < V-X,N > < U,N > < DV,N > - < V-X,N > < DU,N > */ -/* DV - --------- DU - ------------------------------------- U */ -/* < U,N > 2 */ -/* < U,N > */ - -/* Compute the unit normal at the intercept point, and unpack */ -/* the input states into V, U, DV, and DU. Let V-X = VMX. */ - - surfnm_(a, b, c__, x, n); - vequ_(stvrtx, v); - vequ_(stdhat, u); - vequ_(&stvrtx[3], dv); - vequ_(&stdhat[3], du); - vsub_(v, x, vmx); - -/* Reject the vertex if it's on the ellipsoid. */ -/* We check this by determining whether the transformed */ -/* vertex is on or in the unit sphere. */ - -/* Computing 2nd power */ - d__1 = v[0] / *a; -/* Computing 2nd power */ - d__2 = v[1] / *b; -/* Computing 2nd power */ - d__3 = v[2] / *c__; - level = d__1 * d__1 + d__2 * d__2 + d__3 * d__3; - if (level == 1.) { - setmsg_("Ray's vertex (# # #) has level surface parameter #. Vertex " - "must not be on the ellipsoid.", (ftnlen)88); - errdp_("#", v, (ftnlen)1); - errdp_("#", &v[1], (ftnlen)1); - errdp_("#", &v[2], (ftnlen)1); - errdp_("#", &level, (ftnlen)1); - sigerr_("SPICE(INVALIDVERTEX)", (ftnlen)20); - chkout_("SURFPV", (ftnlen)6); - return 0; - } - -/* As the intercept point nears the limb, its velocity may tend to */ -/* infinity. We must check the value of < U,N > before dividing by */ -/* it. If the intercept point is on the limb, then < U,N > = 0. If */ -/* it is near the limb, < U,N > may be so small that dividing by it */ -/* would result in a number that is greater than the maximum double */ -/* precision number for the computer. */ - - udn = vdot_(u, n); - if (udn == 0.) { - -/* The intercept point is on the limb, so its velocity */ -/* is not defined. This means we can't "find" the state */ -/* of the intercept point. */ - - chkout_("SURFPV", (ftnlen)6); - return 0; - } - -/* Evaluate the second term of the equation for DX, but don't */ -/* divide by < U,N > just yet. */ - - d__1 = vdot_(vmx, n); - vscl_(&d__1, du, second); - -/* 2 */ -/* Evaluate the third term, but don't divide by < U,N > just yet. */ - - dsnum = udn * vdot_(dv, n) - vdot_(vmx, n) * vdot_(du, n); - vscl_(&dsnum, u, third); - -/* We'll use the following test. */ - -/* Computing MAX */ - d__1 = vnorm_(second), d__2 = vnorm_(third), d__1 = max(d__1,d__2); - m = max(d__1,1.); - -/* If */ - -/* M DPMAX() */ -/* ------- > ------- */ -/* 2 MARGIN */ -/* < U,N > */ - - -/* or equivalently */ - -/* 2 */ -/* M > DPMAX() * < U,N > / MARGIN */ - - -/* then the velocity is probably too large to compute. We know that */ -/* we can perform the multiplication above because U and N are both */ -/* unit vectors, so the dot product of U and N is less than or equal */ -/* to one. */ - -/* Computing 2nd power */ - d__1 = udn; - if (m > dpmax_() / 10. * (d__1 * d__1)) { - chkout_("SURFPV", (ftnlen)6); - return 0; - } - -/* If < U,N > passed the tests above, we can solve for the */ -/* intercept velocity. */ - -/* 2 */ -/* DX = DV - SECOND / < U,N > - THIRD / < U,N > */ - - - r__ = 1. / udn; - d__1 = -r__; -/* Computing 2nd power */ - d__3 = r__; - d__2 = -(d__3 * d__3); - vlcom3_(&c_b13, dv, &d__1, second, &d__2, third, &stx[3]); - -/* Since we could compute the velocity, we can assign the */ -/* intercept point, and set the found flag to .TRUE. */ - - vequ_(x, stx); - *found = TRUE_; - chkout_("SURFPV", (ftnlen)6); - return 0; -} /* surfpv_ */ - diff --git a/ext/spice/src/cspice/surfpv_c.c b/ext/spice/src/cspice/surfpv_c.c deleted file mode 100644 index d77981b802..0000000000 --- a/ext/spice/src/cspice/surfpv_c.c +++ /dev/null @@ -1,516 +0,0 @@ -/* - --Procedure surfpv_c ( Surface point and velocity ) - --Abstract - - Find the state (position and velocity) of the surface intercept - defined by a specified ray, ray velocity, and ellipsoid. - --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 - - ELLIPSOID - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef surfpv_c - - - void surfpv_c ( ConstSpiceDouble stvrtx[6], - ConstSpiceDouble stdir [6], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble stx [6], - SpiceBoolean * found ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - stvrtx I State of ray's vertex. - stdir I State of ray's direction vector. - a I Length of ellipsoid semi-axis along the x-axis. - b I Length of ellipsoid semi-axis along the y-axis. - c I Length of ellipsoid semi-axis along the z-axis. - stx O State of surface intercept. - found O Flag indicating whether intercept state was found. - --Detailed_Input - - stvrtx is the state of a ray's vertex. The first three - components of `stvrtx' are the vertex's x, y, and z - position components; the vertex's x, y, and z - velocity components follow. - - The reference frame relative to which `stvrtx' is - specified has axes aligned with with those of a - triaxial ellipsoid. See the description below of the - arguments `a', `b', and `c'. - - The vertex may be inside or outside of this - ellipsoid, but not on it, since the surface intercept - is a discontinuous function at vertices on the - ellipsoid's surface. - - No assumption is made about the units of length and - time, but these units must be consistent with those - of the other inputs. - - - stdir is the state of the input ray's direction vector. - The first three components of `stdir' are a non-zero - vector giving the x, y, and z components of the - ray's direction; the direction vector's x, y, and - z velocity components follow. - - `stdir' is specified relative to the same reference - frame as is `stvrtx'. - - - a, - b, - c are, respectively, the lengths of a triaxial - ellipsoid's semi-axes lying along the x, y, and - z axes of the reference frame relative to which - `stvrtx' and `stdir' are specified. - --Detailed_Output - - stx is the state of the intercept of the input ray on the - surface of the input ellipsoid. The first three - components of `stx' are the intercept's x, y, and z - position components; the intercept's x, y, and z - velocity components follow. - - `stx' is specified relative to the same reference - frame as are `stvrtx' and `stdir'. - - `stx' is defined if and only if both the intercept - and its velocity are computable, as indicated by the - output argument `found'. - - The position units of `stx' are the same as those of - `stvrtx', `stdir', and `a', `b', and `c'. The time - units are the same as those of `stvrtx' and `stdir'. - - - found is a logical flag indicating whether `stx' is - defined. `found' is SPICETRUE if and only if both the - intercept and its velocity are computable. Note - that in some cases the intercept may computable - while the velocity is not; this can happen for - near-tangency cases. - --Parameters - - None. - --Exceptions - - 1) If the input ray's direction vector is the zero vector, then - a routine in the call tree of this routine will signal - an error. - - 2) If any of the ellipsoid's axis lengths is nonpositive, - a routine in the call tree of this routine will signal - an error. - - 3) If the vertex of the ray is on the ellipsoid, - the error SPICE(INVALIDVERTEX) is signaled. - --Files - - None. - --Particulars - - The position and velocity of the ray's vertex as well as the - ray's direction vector and velocity vary with time. The - inputs to surfpv_c may be considered the values of these - vector functions at a particular time, say t0. Thus - - State of vertex: stvrtx = ( V(t0), V'(t0) ) - - State of direction vector: stdir = ( D(t0), D'(t0) ) - - To determine the intercept point, W(t0), we simply compute the - intersection of the ray originating at V(t0) in the direction of - D(t0) with the ellipsoid - - 2 2 2 - x y z - --- + --- + --- = 1 - 2 2 2 - A B C - - W(t) is the path of the intercept point along the surface of - the ellipsoid. To determine the velocity of the intercept point, - we need to take the time derivative of W(t), and evaluate it at - t0. Unfortunately W(t) is a complicated expression, and its - derivative is even more complicated. - - However, we know that the derivative of W(t) at t0, W'(t0), is - tangent to W(t) at t0. Thus W'(t0) lies in the plane that is tangent - to the ellipsoid at t0. Let X(t) be the curve in the tangent plane - that represents the intersection of the ray emanating from V(t0) - with direction D(t0) with that tangent plane. - - X'(t0) = W'(t0) - - The expression for X'(t) is much simpler than that of W'(t); - surfpv_c evaluates X'(t) at t0. - - - Derivation of X(t) and X'(t) - ---------------------------------------------------------------- - - W(t0) is the intercept point. Let N be a surface normal at I(t0). - Then the tangent plane at W(t0) is the set of points X(t) such - that - - < X(t) - I(t0), N > = 0 - - X(t) can be expressed as the vector sum of the vertex - and some scalar multiple of the direction vector, - - X(t) = V(t) + s(t) * D(t) - - where s(t) is a scalar function of time. The derivative of - X(t) is given by - - X'(t) = V'(t) + s(t) * D'(t) + s'(t) * D(t) - - We have V(t0), V'(t0), D(t0), D'(t0), W(t0), and N, but to - evaluate X'(t0), we need s(t0) and s'(t0). We derive an - expression for s(t) as follows. - - Because X(t) is in the tangent plane, it must satisfy - - < X(t) - W(t0), N > = 0. - - Substituting the expression for X(t) into the equation above - gives - - < V(t) + s(t) * D(t) - W(t0), N > = 0. - - Thus - - < V(t) - W(t0), N > + s(t) * < D(t), N > = 0, - - and - < V(t) - W(t0), N > - s(t) = - ------------------- - < D(t), N > - - The derivative of s(t) is given by - - s'(t) = - - < D(t),N > * < V'(t),N > - < V(t)-W(t0),N > * < D'(t),N > - - ----------------------------------------------------------- - 2 - < D(t), N > - --Examples - - - The numerical results shown for these examples may differ across - platforms. The results depend on the compiler and supporting - libraries, and the machine specific arithmetic implementation. - - - 1) Illustrate the role of the ray vertex velocity and - ray direction vector velocity via several simple cases. Also - show the results of a near-tangency computation. - - - Example code begins here. - - - #include - #include "SpiceUsr.h" - - int main() - { - /. - Program surfpv_ex1 - ./ - - SpiceBoolean found; - - SpiceDouble a; - SpiceDouble b; - SpiceDouble c; - SpiceDouble stvrtx [6]; - SpiceDouble stdir [6]; - SpiceDouble stx [6]; - - SpiceInt i; - - - a = 1.0; - b = 2.0; - c = 3.0; - - printf ( "\nEllipsoid radii: \n" - " a = %f\n" - " b = %f\n" - " c = %f\n", - a, - b, - c ); - - - for ( i = 0; i < 3; i++ ) - { - if ( i == 0 ) - { - printf ( "\n%s\n\n", - "Case 1: Vertex varies, direction is constant" ); - - stvrtx[0] = 2.0; - stvrtx[1] = 0.0; - stvrtx[2] = 0.0; - stvrtx[3] = 0.0; - stvrtx[4] = 0.0; - stvrtx[5] = 3.0; - - stdir[0] = -1.0; - stdir[1] = 0.0; - stdir[2] = 0.0; - stdir[3] = 0.0; - stdir[4] = 0.0; - stdir[5] = 0.0; - } - else if ( i == 1 ) - { - printf ( "\n%s\n\n", - "Case 2: Vertex and direction both vary" ); - - stvrtx[0] = 2.0; - stvrtx[1] = 0.0; - stvrtx[2] = 0.0; - stvrtx[3] = 0.0; - stvrtx[4] = 0.0; - stvrtx[5] = 3.0; - - stdir[0] = -1.0; - stdir[1] = 0.0; - stdir[2] = 0.0; - stdir[3] = 0.0; - stdir[4] = 0.0; - stdir[5] = 4.0; - } - else - { - printf ( "\n%s\n\n", - "Case 3: Vertex and direction both vary; " - "near-tangent case" ); - - stvrtx[2] = c - 1.e-15; - stvrtx[5] = 1.e299; - stdir[5] = 1.e299; - } - - printf ( "Vertex:\n" - " %23.16e %23.16e %23.16e\n", - stvrtx[0], - stvrtx[1], - stvrtx[2] ); - - printf ( "Vertex velocity:\n" - " %23.16e %23.16e %23.16e\n", - stvrtx[3], - stvrtx[4], - stvrtx[5] ); - - printf ( "Direction:\n" - " %23.16e %23.16e %23.16e\n", - stdir[0], - stdir[1], - stdir[2] ); - - printf ( "Direction velocity:\n" - " %23.16e %23.16e %23.16e\n", - stdir[3], - stdir[4], - stdir[5] ); - - surfpv_c ( stvrtx, stdir, a, b, c, stx, &found ); - - if ( !found) - { - printf ( " No intercept state found.\n" ); - } - else - { - printf ( "Intercept:\n" - " %23.16e %23.16e %23.16e\n", - stx[0], - stx[1], - stx[2] ); - - printf ( "Intercept velocity:\n" - " %23.16e %23.16e %23.16e\n\n", - stx[3], - stx[4], - stx[5] ); - } - } - - return ( 0 ); - } - - - When this program was executed on a PC/Linux/gcc platform, the - output was: - - - Ellipsoid radii: - a = 1.000000 - b = 2.000000 - c = 3.000000 - - Case 1: Vertex varies, direction is constant - - Vertex: - 2.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Vertex velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 3.0000000000000000e+00 - Direction: - -1.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Direction velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Intercept: - 1.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Intercept velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 3.0000000000000000e+00 - - - Case 2: Vertex and direction both vary - - Vertex: - 2.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Vertex velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 3.0000000000000000e+00 - Direction: - -1.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Direction velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 4.0000000000000000e+00 - Intercept: - 1.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Intercept velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 7.0000000000000000e+00 - - - Case 3: Vertex and direction both vary; near-tangent case - - Vertex: - 2.0000000000000000e+00 0.0000000000000000e+00 2.9999999999999991e+00 - Vertex velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 1.0000000000000001e+299 - Direction: - -1.0000000000000000e+00 0.0000000000000000e+00 0.0000000000000000e+00 - Direction velocity: - 0.0000000000000000e+00 0.0000000000000000e+00 1.0000000000000001e+299 - Intercept: - 2.5809568279517847e-08 0.0000000000000000e+00 2.9999999999999991e+00 - Intercept velocity: - -3.8745320362076641e+306 0.0000000000000000e+00 2.9999999741904321e+299 - - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.E. McLean (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.1, 22-JAN-2009 (NJB) (JEM) (WLT) - - Corrected header typo. - - -CSPICE Version 1.0.0, 05-JAN-2009 (NJB) (JEM) (WLT) - --Index_Entries - - ellipsoid surface point and velocity - --& -*/ - -{ /* Begin surfpv_c */ - - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "surfpv_c" ); - - - surfpv_ ( (doublereal *) stvrtx, - (doublereal *) stdir, - (doublereal *) &a, - (doublereal *) &b, - (doublereal *) &c, - (doublereal *) stx, - (logical *) &fnd ); - - - *found = (SpiceBoolean) fnd; - - - chkout_c ( "surfpv_c" ); - -} /* End surfpv_c */ diff --git a/ext/spice/src/cspice/swapac.c b/ext/spice/src/cspice/swapac.c deleted file mode 100644 index 57fc8fa7c5..0000000000 --- a/ext/spice/src/cspice/swapac.c +++ /dev/null @@ -1,442 +0,0 @@ -/* swapac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SWAPAC ( Swap array, character ) */ -/* Subroutine */ int swapac_(integer *n, integer *locn, integer *m, integer * - locm, char *array, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsub, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), swapc_(char *, char *, - ftnlen, ftnlen); - integer extra, lm, ln, nm, nn, begsub; - extern /* Subroutine */ int cyacip_(integer *, char *, integer *, char *, - ftnlen, ftnlen); - integer direct; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - char dir[1]; - -/* $ Abstract */ - -/* Swap (exchange) two non-intersecting groups of contiguous */ -/* elements of a character array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of elements in the first group. */ -/* LOCN I Location of the first group. */ -/* M I Number of elements in the second group. */ -/* LOCM I Location of the second group. */ -/* ARRAY I/O The array. */ - -/* $ Detailed_Input */ - -/* N, */ -/* LOCN define the first group of elements to be exchanged: */ -/* ARRAY(LOCN) through ARRAY(LOCN+N-1). */ - -/* M, */ -/* LOCM define the second group of elements to be exchanged: */ -/* ARRAY(LOCM) through ARRAY(LOCM+M-1). These must be */ -/* distinct from the first group. */ - -/* ARRAY on input contains both groups of elements in their */ -/* original locations. */ - -/* $ Detailed_Output */ - -/* ARRAY on output contains the input array with the indicated */ -/* groups of elements exchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the elements to be swapped are not distinct, the error */ -/* SPICE(NOTDISTINCT) is signalled. */ - -/* 2) If LOCN or LOCM is less than one, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the number of elements to be swapped is less than zero, */ -/* the error SPICE(INVALIDARGUMENT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If N [M] is zero, the second [first] group is removed from */ -/* its current location and inserted in front of ARRAY(LOCN) */ -/* [ARRAY(LOCM)]. Thus, to move the second [first] group to the */ -/* front of the list, set N [M] and LOCN [LOCM] to zero and one */ -/* respectively. To move the group to the end of the list, set */ -/* N [M] and LOCN [LOCM] to zero and one more than the number of */ -/* elements in the array. */ - -/* All of the elements to be swapped must be distinct. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* Roosevelt */ -/* Truman */ -/* Eisenhower */ -/* Kennedy */ -/* Johnson */ -/* Nixon */ -/* Ford */ -/* Carter */ -/* Reagan */ -/* Cuomo */ - -/* Then the following calls */ - -/* CALL SWAPAC ( 1, 2, 2, 7, ARRAY ) */ -/* CALL SWAPAC ( 3, 1, 3, 8, ARRAY ) */ -/* CALL SWAPAC ( 3, 4, 0, 1, ARRAY ) */ -/* CALL SWAPAC ( 2, 4, 0, 11, ARRAY ) */ - -/* yield the following arrays respectively. */ - -/* [1] [2] [3] [4] */ - -/* Roosevelt Carter Kennedy Roosevelt */ -/* Ford Reagan Johnson Truman */ -/* Carter Cuomo Nixon Eisenhower */ -/* Eisenhower Kennedy Roosevelt Nixon */ -/* Kennedy Johnson Truman Ford */ -/* Johnson Nixon Eisenhower Carter */ -/* Nixon Ford Ford Reagan */ -/* Truman Roosevelt Carter Cuomo */ -/* Reagan Truman Reagan Kennedy */ -/* Cuomo Eisenhower Cuomo Johnson */ - -/* The following calls */ - -/* CALL SWAPAC ( 3, 2, 4, 5, ARRAY ) */ -/* CALL SWAPAC ( 4, 5, 3, 2, ARRAY ) */ - -/* yield the following arrays. Note that the resulting arrays */ -/* are equivalent. */ - -/* [1] [2] */ - -/* Roosevelt Roosevelt */ -/* Johnson Johnson */ -/* Nixon Nixon */ -/* Ford Ford */ -/* Carter Carter */ -/* Truman Truman */ -/* Eisenhower Eisenhower */ -/* Kennedy Kennedy */ -/* Reagan Reagan */ -/* Cuomo Cuomo */ - - -/* The calls */ - -/* CALL SWAPAC ( 3, 5, 4, 6, ARRAY ) */ -/* CALL SWAPAC ( 3, -3, 3, 10, ARRAY ) */ - -/* signal the errors */ - -/* SPICE(NOTDISTINCT) */ -/* SPICE(INVALIDINDEX) */ - -/* respectively. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CYCLAC call. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* swap elements of character array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CYCLAC call. */ - -/* - Beta Version 2.0.0, 3-JAN-1989 (HAN) */ - -/* The "Particulars" section stated that by setting N [M] */ -/* to zero, the second [first] group is removed from its current */ -/* location and inserted in front of ARRAY(LOCM) [ARRAY(LOCN)]. */ -/* That statement was incorrect. Insertion occurs in front of */ -/* ARRAY(LOCN) [ARRAY(LOCM)]. The section has been corrected. */ - -/* New checks for locations were added. LOCN and LOCM must be */ -/* greater than one, not zero as specified before. If they are */ -/* not, and error is signalled. */ - -/* More examples were added to the "Examples" section, and */ -/* the long error messages were revised. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* We will assume that LOCN and N refer to the earlier group of */ -/* elements, LOCM and M to the later group. (We can always make */ -/* this true by exchanging their values.) We also assume that */ -/* all the elements to be swapped are distinct. (That is, LOCM */ -/* is greater than or equal to LOCN+N.) */ - -/* It's easy enough to swap elements on a one-to-one basis, but */ -/* what about the ones left over? Without extra storage, they can */ -/* be moved one at a time; but each such move requires moving every */ -/* element between the origin and destination as well. For large */ -/* arrays, this is clearly unacceptable. */ - -/* In the figure below, the array on the left contains two groups */ -/* of elements which are to be swapped. We can begin by swapping the */ -/* leading elements of each group one-for-one. */ - -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | Adam | | Barney | */ -/* +--------------+ +--------------+ */ -/* | Alvin | | Betty | */ -/* +--------------+ +--------------+ */ -/* | | | | <---+ */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | Barney | | Adam | | */ -/* +--------------+ +--------------+ | */ -/* | Betty | | Alvin | | */ -/* +--------------+ +--------------+ | */ -/* | Bill | | Bill | | */ -/* +--------------+ +--------------+ | */ -/* | Bob | | Bob | <---+ */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ - -/* Notice that cycling the indicated sub-array forward twice brings */ -/* the remaining elements to their proper locations. This is most */ -/* fortunate, because cycling the elements of an array is a linear */ -/* operation. (See CYCLAx for details.) */ - -/* And what if the extra elements are in the first group? */ - -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | Barney | | Adam | */ -/* +--------------+ +--------------+ */ -/* | Betty | | Alvin | */ -/* +--------------+ +--------------+ */ -/* | Bill | | Bill | <---+ */ -/* +--------------+ +--------------+ | */ -/* | Bob | | Bob | | */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | Adam | | Barney | | */ -/* +--------------+ +--------------+ | */ -/* | Alvin | | Betty | <---+ */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ - -/* In this case, the indicated sub-array must be cycled backward */ -/* in order to bring the extra elements to their proper places. */ - -/* The algorithm is: */ - -/* 1) Let DIRECT be the smaller of N and M, and let EXTRA */ -/* be the absolute value of the difference (N-M). */ - -/* 2) Exchange DIRECT elements directly. */ - -/* 3) Determine the direction of the cycle: forward when N < M, */ -/* backward when N > M. */ - -/* 4) Determine the sub-array to be cycled. It begins at element */ -/* (LOCN+DIRECT) and contains (LOCM-LOCN) + (M-DIRECT) elements */ - -/* 5) Cycle the sub-array EXTRA times in the indicated direction. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SWAPAC", (ftnlen)6); - } - -/* Check to see if the inputs are valid. */ - - if (*n < 0) { - setmsg_("Number of elements in the first group is *.", (ftnlen)43); - errint_("*", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SWAPAC", (ftnlen)6); - return 0; - } else if (*m < 0) { - setmsg_("Number of elements in the second group is *.", (ftnlen)44); - errint_("*", m, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SWAPAC", (ftnlen)6); - return 0; - } else if (*locn < 1) { - setmsg_("Location of the first group is *.", (ftnlen)33); - errint_("*", locn, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("SWAPAC", (ftnlen)6); - return 0; - } else if (*locm < 1) { - setmsg_("Location of the second group is *.", (ftnlen)34); - errint_("*", locm, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("SWAPAC", (ftnlen)6); - return 0; - } - -/* Make sure we have the groups in the right order. */ - - if (*locn < *locm) { - ln = *locn; - lm = *locm; - nn = *n; - nm = *m; - } else { - ln = *locm; - lm = *locn; - nn = *m; - nm = *n; - } - -/* The elements must be distinct. */ - - if (lm < ln + nn) { - setmsg_("Elements to be swapped are not distinct.", (ftnlen)40); - sigerr_("SPICE(NOTDISTINCT)", (ftnlen)18); - chkout_("SWAPAC", (ftnlen)6); - return 0; - } - -/* Direct exchange. */ - - direct = min(nn,nm); - i__1 = direct - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - swapc_(array + (ln + i__ - 1) * array_len, array + (lm + i__ - 1) * - array_len, array_len, array_len); - } - -/* Cycle. */ - - extra = (i__1 = nn - nm, abs(i__1)); - if (extra > 0) { - if (nn < nm) { - *(unsigned char *)dir = 'F'; - } else { - *(unsigned char *)dir = 'B'; - } - begsub = ln + direct; - nsub = lm - ln + (nm - direct); - cyacip_(&nsub, dir, &extra, array + (begsub - 1) * array_len, (ftnlen) - 1, array_len); - } - chkout_("SWAPAC", (ftnlen)6); - return 0; -} /* swapac_ */ - diff --git a/ext/spice/src/cspice/swapad.c b/ext/spice/src/cspice/swapad.c deleted file mode 100644 index 5b3b93e9c9..0000000000 --- a/ext/spice/src/cspice/swapad.c +++ /dev/null @@ -1,440 +0,0 @@ -/* swapad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SWAPAD ( Swap elements within a DP array ) */ -/* Subroutine */ int swapad_(integer *n, integer *locn, integer *m, integer * - locm, doublereal *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsub, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), swapd_(doublereal *, - doublereal *); - integer extra, lm, ln, nm, nn, begsub; - extern /* Subroutine */ int cyadip_(integer *, char *, integer *, - doublereal *, ftnlen); - integer direct; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - char dir[1]; - -/* $ Abstract */ - -/* Swap (exchange) two non-intersecting groups of contiguous */ -/* elements of a double precision array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of elements in the first group. */ -/* LOCN I Location of the first group. */ -/* M I Number of elements in the second group. */ -/* LOCM I Location of the second group. */ -/* ARRAY I/O The array. */ - -/* $ Detailed_Input */ - -/* N, */ -/* LOCN define the first group of elements to be exchanged: */ -/* ARRAY(LOCN) through ARRAY(LOCN+N-1). */ - -/* M, */ -/* LOCM define the second group of elements to be exchanged: */ -/* ARRAY(LOCM) through ARRAY(LOCM+M-1). These must be */ -/* distinct from the first group. */ - -/* ARRAY on input contains both groups of elements in their */ -/* original locations. */ - -/* $ Detailed_Output */ - -/* ARRAY on output contains the input array with the indicated */ -/* groups of elements exchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the elements to be swapped are not distinct, the error */ -/* SPICE(NOTDISTINCT) is signalled. */ - -/* 2) If LOCN or LOCM is less than one, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the number of elements to be swapped is less than zero, */ -/* the error SPICE(INVALIDARGUMENT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If N [M] is zero, the second [first] group is removed from */ -/* its current location and inserted in front of ARRAY(LOCN) */ -/* [ARRAY(LOCM)]. Thus, to move the second [first] group to the */ -/* front of the list, set N [M] and LOCN [LOCM] to zero and one */ -/* respectively. To move the group to the end of the list, set */ -/* N [M] and LOCN [LOCM] to zero and one more than the number of */ -/* elements in the array. */ - -/* All of the elements to be swapped must be distinct. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* Roosevelt */ -/* Truman */ -/* Eisenhower */ -/* Kennedy */ -/* Johnson */ -/* Nixon */ -/* Ford */ -/* Carter */ -/* Reagan */ -/* Cuomo */ - -/* Then the following calls */ - -/* CALL SWAPAC ( 1, 2, 2, 7, ARRAY ) */ -/* CALL SWAPAC ( 3, 1, 3, 8, ARRAY ) */ -/* CALL SWAPAC ( 3, 4, 0, 1, ARRAY ) */ -/* CALL SWAPAC ( 2, 4, 0, 11, ARRAY ) */ - -/* yield the following arrays respectively. */ - -/* [1] [2] [3] [4] */ - -/* Roosevelt Carter Kennedy Roosevelt */ -/* Ford Reagan Johnson Truman */ -/* Carter Cuomo Nixon Eisenhower */ -/* Eisenhower Kennedy Roosevelt Nixon */ -/* Kennedy Johnson Truman Ford */ -/* Johnson Nixon Eisenhower Carter */ -/* Nixon Ford Ford Reagan */ -/* Truman Roosevelt Carter Cuomo */ -/* Reagan Truman Reagan Kennedy */ -/* Cuomo Eisenhower Cuomo Johnson */ - -/* The following calls */ - -/* CALL SWAPAC ( 3, 2, 4, 5, ARRAY ) */ -/* CALL SWAPAC ( 4, 5, 3, 2, ARRAY ) */ - -/* yield the following arrays. Note that the resulting arrays */ -/* are equivalent. */ - -/* [1] [2] */ - -/* Roosevelt Roosevelt */ -/* Johnson Johnson */ -/* Nixon Nixon */ -/* Ford Ford */ -/* Carter Carter */ -/* Truman Truman */ -/* Eisenhower Eisenhower */ -/* Kennedy Kennedy */ -/* Reagan Reagan */ -/* Cuomo Cuomo */ - - -/* The calls */ - -/* CALL SWAPAC ( 3, 5, 4, 6, ARRAY ) */ -/* CALL SWAPAC ( 3, -3, 3, 10, ARRAY ) */ - -/* signal the errors */ - -/* SPICE(NOTDISTINCT) */ -/* SPICE(INVALIDINDEX) */ - -/* respectively. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" markers from text in the header. */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CYCLAD call. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* swap elements within a d.p. array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CYCLAD call. */ - -/* - Beta Version 2.0.0, 3-JAN-1989 (HAN) */ - -/* The "Particulars" section stated that by setting N [M] */ -/* to zero, the second [first] group is removed from its current */ -/* location and inserted in front of ARRAY(LOCM) [ARRAY(LOCN)]. */ -/* That statement was incorrect. Insertion occurs in front of */ -/* ARRAY(LOCN) [ARRAY(LOCM)]. The section has been corrected. */ - -/* New checks for locations were added. LOCN and LOCM must be */ -/* greater than one, not zero as specified before. If they are */ -/* not, and error is signalled. */ - -/* More examples were added to the "Examples" section, and */ -/* the long error messages were revised. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* We will assume that LOCN and N refer to the earlier group of */ -/* elements, LOCM and M to the later group. (We can always make */ -/* this true by exchanging their values.) We also assume that */ -/* all the elements to be swapped are distinct. (That is, LOCM */ -/* is greater than or equal to LOCN+N.) */ - -/* It's easy enough to swap elements on a one-to-one basis, but */ -/* what about the ones left over? Without extra storage, they can */ -/* be moved one at a time; but each such move requires moving every */ -/* element between the origin and destination as well. For large */ -/* arrays, this is clearly unacceptable. */ - -/* In the figure below, the array on the left contains two groups */ -/* of elements which are to be swapped. We can begin by swapping the */ -/* leading elements of each group one-for-one. */ - -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | Adam | | Barney | */ -/* +--------------+ +--------------+ */ -/* | Alvin | | Betty | */ -/* +--------------+ +--------------+ */ -/* | | | | <---+ */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | Barney | | Adam | | */ -/* +--------------+ +--------------+ | */ -/* | Betty | | Alvin | | */ -/* +--------------+ +--------------+ | */ -/* | Bill | | Bill | | */ -/* +--------------+ +--------------+ | */ -/* | Bob | | Bob | <---+ */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ - -/* Notice that cycling the indicated sub-array forward twice brings */ -/* the remaining elements to their proper locations. This is most */ -/* fortunate, because cycling the elements of an array is a linear */ -/* operation. (See CYCLAx for details.) */ - -/* And what if the extra elements are in the first group? */ - -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | Barney | | Adam | */ -/* +--------------+ +--------------+ */ -/* | Betty | | Alvin | */ -/* +--------------+ +--------------+ */ -/* | Bill | | Bill | <---+ */ -/* +--------------+ +--------------+ | */ -/* | Bob | | Bob | | */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | Adam | | Barney | | */ -/* +--------------+ +--------------+ | */ -/* | Alvin | | Betty | <---+ */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ - -/* In this case, the indicated sub-array must be cycled backward */ -/* in order to bring the extra elements to their proper places. */ - -/* The algorithm is: */ - -/* 1) Let DIRECT be the smaller of N and M, and let EXTRA */ -/* be the absolute value of the difference (N-M). */ - -/* 2) Exchange DIRECT elements directly. */ - -/* 3) Determine the direction of the cycle: forward when N < M, */ -/* backward when N > M. */ - -/* 4) Determine the sub-array to be cycled. It begins at element */ -/* (LOCN+DIRECT) and contains (LOCM-LOCN) + (M-DIRECT) elements */ - -/* 5) Cycle the sub-array EXTRA times in the indicated direction. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SWAPAD", (ftnlen)6); - } - -/* Check to see if the inputs are valid. */ - - if (*n < 0) { - setmsg_("Number of elements in the first group is *.", (ftnlen)43); - errint_("*", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SWAPAD", (ftnlen)6); - return 0; - } else if (*m < 0) { - setmsg_("Number of elements in the second group is *.", (ftnlen)44); - errint_("*", m, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SWAPAD", (ftnlen)6); - return 0; - } else if (*locn < 1) { - setmsg_("Location of the first group is *.", (ftnlen)33); - errint_("*", locn, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("SWAPAD", (ftnlen)6); - return 0; - } else if (*locm < 1) { - setmsg_("Location of the second group is *.", (ftnlen)34); - errint_("*", locm, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("SWAPAD", (ftnlen)6); - return 0; - } - -/* Make sure we have the groups in the right order. */ - - if (*locn < *locm) { - ln = *locn; - lm = *locm; - nn = *n; - nm = *m; - } else { - ln = *locm; - lm = *locn; - nn = *m; - nm = *n; - } - -/* The elements must be distinct. */ - - if (lm < ln + nn) { - setmsg_("Elements to be swapped are not distinct.", (ftnlen)40); - sigerr_("SPICE(NOTDISTINCT)", (ftnlen)18); - chkout_("SWAPAD", (ftnlen)6); - return 0; - } - -/* Direct exchange. */ - - direct = min(nn,nm); - i__1 = direct - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - swapd_(&array[ln + i__ - 1], &array[lm + i__ - 1]); - } - -/* Cycle. */ - - extra = (i__1 = nn - nm, abs(i__1)); - if (extra > 0) { - if (nn < nm) { - *(unsigned char *)dir = 'F'; - } else { - *(unsigned char *)dir = 'B'; - } - begsub = ln + direct; - nsub = lm - ln + (nm - direct); - cyadip_(&nsub, dir, &extra, &array[begsub - 1], (ftnlen)1); - } - chkout_("SWAPAD", (ftnlen)6); - return 0; -} /* swapad_ */ - diff --git a/ext/spice/src/cspice/swapai.c b/ext/spice/src/cspice/swapai.c deleted file mode 100644 index 97b03cbb46..0000000000 --- a/ext/spice/src/cspice/swapai.c +++ /dev/null @@ -1,438 +0,0 @@ -/* swapai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SWAPAI ( Swap elements within an integer array ) */ -/* Subroutine */ int swapai_(integer *n, integer *locn, integer *m, integer * - locm, integer *array) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsub, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer extra; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer lm, ln, nm, nn, begsub, direct; - extern /* Subroutine */ int cyaiip_(integer *, char *, integer *, integer - *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - char dir[1]; - -/* $ Abstract */ - -/* Swap (exchange) two non-intersecting groups of contiguous */ -/* elements of an integer array. */ - -/* $ 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 */ - -/* ARRAY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of elements in the first group. */ -/* LOCN I Location of the first group. */ -/* M I Number of elements in the second group. */ -/* LOCM I Location of the second group. */ -/* ARRAY I/O The array. */ - -/* $ Detailed_Input */ - -/* N, */ -/* LOCN define the first group of elements to be exchanged: */ -/* ARRAY(LOCN) through ARRAY(LOCN+N-1). */ - -/* M, */ -/* LOCM define the second group of elements to be exchanged: */ -/* ARRAY(LOCM) through ARRAY(LOCM+M-1). These must be */ -/* distinct from the first group. */ - -/* ARRAY on input contains both groups of elements in their */ -/* original locations. */ - -/* $ Detailed_Output */ - -/* ARRAY on output contains the input array with the indicated */ -/* groups of elements exchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the elements to be swapped are not distinct, the error */ -/* SPICE(NOTDISTINCT) is signalled. */ - -/* 2) If LOCN or LOCM is less than one, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the number of elements to be swapped is less than zero, */ -/* the error SPICE(INVALIDARGUMENT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* If N [M] is zero, the second [first] group is removed from */ -/* its current location and inserted in front of ARRAY(LOCN) */ -/* [ARRAY(LOCM)]. Thus, to move the second [first] group to the */ -/* front of the list, set N [M] and LOCN [LOCM] to zero and one */ -/* respectively. To move the group to the end of the list, set */ -/* N [M] and LOCN [LOCM] to zero and one more than the number of */ -/* elements in the array. */ - -/* All of the elements to be swapped must be distinct. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements. */ - -/* Roosevelt */ -/* Truman */ -/* Eisenhower */ -/* Kennedy */ -/* Johnson */ -/* Nixon */ -/* Ford */ -/* Carter */ -/* Reagan */ -/* Cuomo */ - -/* Then the following calls */ - -/* CALL SWAPAC ( 1, 2, 2, 7, ARRAY ) */ -/* CALL SWAPAC ( 3, 1, 3, 8, ARRAY ) */ -/* CALL SWAPAC ( 3, 4, 0, 1, ARRAY ) */ -/* CALL SWAPAC ( 2, 4, 0, 11, ARRAY ) */ - -/* yield the following arrays respectively. */ - -/* [1] [2] [3] [4] */ - -/* Roosevelt Carter Kennedy Roosevelt */ -/* Ford Reagan Johnson Truman */ -/* Carter Cuomo Nixon Eisenhower */ -/* Eisenhower Kennedy Roosevelt Nixon */ -/* Kennedy Johnson Truman Ford */ -/* Johnson Nixon Eisenhower Carter */ -/* Nixon Ford Ford Reagan */ -/* Truman Roosevelt Carter Cuomo */ -/* Reagan Truman Reagan Kennedy */ -/* Cuomo Eisenhower Cuomo Johnson */ - -/* The following calls */ - -/* CALL SWAPAC ( 3, 2, 4, 5, ARRAY ) */ -/* CALL SWAPAC ( 4, 5, 3, 2, ARRAY ) */ - -/* yield the following arrays. Note that the resulting arrays */ -/* are equivalent. */ - -/* [1] [2] */ - -/* Roosevelt Roosevelt */ -/* Johnson Johnson */ -/* Nixon Nixon */ -/* Ford Ford */ -/* Carter Carter */ -/* Truman Truman */ -/* Eisenhower Eisenhower */ -/* Kennedy Kennedy */ -/* Reagan Reagan */ -/* Cuomo Cuomo */ - - -/* The calls */ - -/* CALL SWAPAC ( 3, 5, 4, 6, ARRAY ) */ -/* CALL SWAPAC ( 3, -3, 3, 10, ARRAY ) */ - -/* signal the errors */ - -/* SPICE(NOTDISTINCT) */ -/* SPICE(INVALIDINDEX) */ - -/* respectively. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CYCLAI call. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* swap elements within an integer array */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CYCLAI call. */ - -/* - Beta Version 2.0.0, 3-JAN-1989 (HAN) */ - -/* The "Particulars" section stated that by setting N [M] */ -/* to zero, the second [first] group is removed from its current */ -/* location and inserted in front of ARRAY(LOCM) [ARRAY(LOCN)]. */ -/* That statement was incorrect. Insertion occurs in front of */ -/* ARRAY(LOCN) [ARRAY(LOCM)]. The section has been corrected. */ - -/* New checks for locations were added. LOCN and LOCM must be */ -/* greater than one, not zero as specified before. If they are */ -/* not, and error is signalled. */ - -/* More examples were added to the "Examples" section, and */ -/* the long error messages were revised. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* We will assume that LOCN and N refer to the earlier group of */ -/* elements, LOCM and M to the later group. (We can always make */ -/* this true by exchanging their values.) We also assume that */ -/* all the elements to be swapped are distinct. (That is, LOCM */ -/* is greater than or equal to LOCN+N.) */ - -/* It's easy enough to swap elements on a one-to-one basis, but */ -/* what about the ones left over? Without extra storage, they can */ -/* be moved one at a time; but each such move requires moving every */ -/* element between the origin and destination as well. For large */ -/* arrays, this is clearly unacceptable. */ - -/* In the figure below, the array on the left contains two groups */ -/* of elements which are to be swapped. We can begin by swapping the */ -/* leading elements of each group one-for-one. */ - -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | Adam | | Barney | */ -/* +--------------+ +--------------+ */ -/* | Alvin | | Betty | */ -/* +--------------+ +--------------+ */ -/* | | | | <---+ */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | Barney | | Adam | | */ -/* +--------------+ +--------------+ | */ -/* | Betty | | Alvin | | */ -/* +--------------+ +--------------+ | */ -/* | Bill | | Bill | | */ -/* +--------------+ +--------------+ | */ -/* | Bob | | Bob | <---+ */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ - -/* Notice that cycling the indicated sub-array forward twice brings */ -/* the remaining elements to their proper locations. This is most */ -/* fortunate, because cycling the elements of an array is a linear */ -/* operation. (See CYCLAx for details.) */ - -/* And what if the extra elements are in the first group? */ - -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | Barney | | Adam | */ -/* +--------------+ +--------------+ */ -/* | Betty | | Alvin | */ -/* +--------------+ +--------------+ */ -/* | Bill | | Bill | <---+ */ -/* +--------------+ +--------------+ | */ -/* | Bob | | Bob | | */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | | | | | */ -/* +--------------+ +--------------+ | */ -/* | Adam | | Barney | | */ -/* +--------------+ +--------------+ | */ -/* | Alvin | | Betty | <---+ */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ -/* | | | | */ -/* +--------------+ +--------------+ */ - -/* In this case, the indicated sub-array must be cycled backward */ -/* in order to bring the extra elements to their proper places. */ - -/* The algorithm is: */ - -/* 1) Let DIRECT be the smaller of N and M, and let EXTRA */ -/* be the absolute value of the difference (N-M). */ - -/* 2) Exchange DIRECT elements directly. */ - -/* 3) Determine the direction of the cycle: forward when N < M, */ -/* backward when N > M. */ - -/* 4) Determine the sub-array to be cycled. It begins at element */ -/* (LOCN+DIRECT) and contains (LOCM-LOCN) + (M-DIRECT) elements */ - -/* 5) Cycle the sub-array EXTRA times in the indicated direction. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SWAPAI", (ftnlen)6); - } - -/* Check to see if the inputs are valid. */ - - if (*n < 0) { - setmsg_("Number of elements in the first group is *.", (ftnlen)43); - errint_("*", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SWAPAI", (ftnlen)6); - return 0; - } else if (*m < 0) { - setmsg_("Number of elements in the second group is *.", (ftnlen)44); - errint_("*", m, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SWAPAI", (ftnlen)6); - return 0; - } else if (*locn < 1) { - setmsg_("Location of the first group is *.", (ftnlen)33); - errint_("*", locn, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("SWAPAI", (ftnlen)6); - return 0; - } else if (*locm < 1) { - setmsg_("Location of the second group is *.", (ftnlen)34); - errint_("*", locm, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("SWAPAI", (ftnlen)6); - return 0; - } - -/* Make sure we have the groups in the right order. */ - - if (*locn < *locm) { - ln = *locn; - lm = *locm; - nn = *n; - nm = *m; - } else { - ln = *locm; - lm = *locn; - nn = *m; - nm = *n; - } - -/* The elements must be distinct. */ - - if (lm < ln + nn) { - setmsg_("Elements to be swapped are not distinct.", (ftnlen)40); - sigerr_("SPICE(NOTDISTINCT)", (ftnlen)18); - chkout_("SWAPAI", (ftnlen)6); - return 0; - } - -/* Direct exchange. */ - - direct = min(nn,nm); - i__1 = direct - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - swapi_(&array[ln + i__ - 1], &array[lm + i__ - 1]); - } - -/* Cycle. */ - - extra = (i__1 = nn - nm, abs(i__1)); - if (extra > 0) { - if (nn < nm) { - *(unsigned char *)dir = 'F'; - } else { - *(unsigned char *)dir = 'B'; - } - begsub = ln + direct; - nsub = lm - ln + (nm - direct); - cyaiip_(&nsub, dir, &extra, &array[begsub - 1], (ftnlen)1); - } - chkout_("SWAPAI", (ftnlen)6); - return 0; -} /* swapai_ */ - diff --git a/ext/spice/src/cspice/swapc.c b/ext/spice/src/cspice/swapc.c deleted file mode 100644 index 471dcde59e..0000000000 --- a/ext/spice/src/cspice/swapc.c +++ /dev/null @@ -1,173 +0,0 @@ -/* swapc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SWAPC ( Swap character values ) */ -/* Subroutine */ int swapc_(char *a, char *b, ftnlen a_len, ftnlen b_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer alen, blen; - char temp[1]; - integer i__, short__; - -/* $ Abstract */ - -/* Swap the contents of two character strings. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I/O First string. */ -/* B I/O Second string. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are two character strings, the contents of which */ -/* are to be swapped (exchanged). */ - -/* $ Detailed_Output */ - -/* A, */ -/* B are the same two character strings, after their */ -/* contents have been exchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This is just shorthand notation for the code fragment */ - -/* TEMP = A */ -/* A = B */ -/* B = TEMP */ - -/* The characters in the string are swapped one at a time, so */ -/* no intermediate string (TEMP) is needed. This means that the */ -/* strings may be of any length. */ - -/* $ Examples */ - -/* Let */ -/* A = 11.D0 */ -/* B = 22.D0 */ - -/* Then after calling SWAPD (A,B), */ - -/* A = 22.D0 */ -/* B = 11.D0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* swap character values */ - -/* -& */ - -/* Local variables */ - - -/* Get the lengths of the strings. */ - - alen = i_len(a, a_len); - blen = i_len(b, b_len); - short__ = min(alen,blen); - -/* Keep going until the end of the shorter string is reached. */ - - i__1 = short__; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)temp = *(unsigned char *)&a[i__ - 1]; - *(unsigned char *)&a[i__ - 1] = *(unsigned char *)&b[i__ - 1]; - *(unsigned char *)&b[i__ - 1] = *(unsigned char *)temp; - } - -/* If either string is longer than the shortest one, pad it */ -/* with blanks. */ - - if (alen > short__) { - i__1 = short__; - s_copy(a + i__1, " ", a_len - i__1, (ftnlen)1); - } else if (blen > short__) { - i__1 = short__; - s_copy(b + i__1, " ", b_len - i__1, (ftnlen)1); - } - return 0; -} /* swapc_ */ - diff --git a/ext/spice/src/cspice/swapd.c b/ext/spice/src/cspice/swapd.c deleted file mode 100644 index ab3a78905b..0000000000 --- a/ext/spice/src/cspice/swapd.c +++ /dev/null @@ -1,139 +0,0 @@ -/* swapd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SWAPD ( Swap double precision values ) */ -/* Subroutine */ int swapd_(doublereal *a, doublereal *b) -{ - doublereal temp; - -/* $ Abstract */ - -/* Swap the contents of two double precision variables. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I/O First variable. */ -/* B I/O Second variable. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are two variables, the contents of which are to */ -/* be swapped (exchanged). */ - -/* $ Detailed_Output */ - -/* A, */ -/* B are the same two variables, after their contents */ -/* have been exchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This is just shorthand notation for the code fragment */ - -/* TEMP = A */ -/* A = B */ -/* B = TEMP */ - -/* $ Examples */ - -/* Let */ -/* A = 11.D0 */ -/* B = 22.D0 */ - -/* Then after calling SWAPD (A,B), */ - -/* A = 22.D0 */ -/* B = 11.D0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* swap d.p. values */ - -/* -& */ - -/* Local variables */ - - -/* What is there to say? */ - - temp = *a; - *a = *b; - *b = temp; - return 0; -} /* swapd_ */ - diff --git a/ext/spice/src/cspice/swapi.c b/ext/spice/src/cspice/swapi.c deleted file mode 100644 index 8dd10d037b..0000000000 --- a/ext/spice/src/cspice/swapi.c +++ /dev/null @@ -1,139 +0,0 @@ -/* swapi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SWAPI ( Swap integer values ) */ -/* Subroutine */ int swapi_(integer *a, integer *b) -{ - integer temp; - -/* $ Abstract */ - -/* Swap the contents of two integer variables. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I/O First variable. */ -/* B I/O Second variable. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are two variables, the contents of which are to */ -/* be swapped (exchanged). */ - -/* $ Detailed_Output */ - -/* A, */ -/* B are the same two variables, after their contents */ -/* have been exchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This is just shorthand notation for the code fragment */ - -/* TEMP = A */ -/* A = B */ -/* B = TEMP */ - -/* $ Examples */ - -/* Let */ -/* A = 11 */ -/* B = 22 */ - -/* Then after calling SWAPI (A,B), */ - -/* A = 22 */ -/* B = 11 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* swap integer values */ - -/* -& */ - -/* Local variables */ - - -/* What is there to say? */ - - temp = *a; - *a = *b; - *b = temp; - return 0; -} /* swapi_ */ - diff --git a/ext/spice/src/cspice/swpool_c.c b/ext/spice/src/cspice/swpool_c.c deleted file mode 100644 index 078a422feb..0000000000 --- a/ext/spice/src/cspice/swpool_c.c +++ /dev/null @@ -1,290 +0,0 @@ -/* - --Procedure swpool_c ( Set watch on a pool variable ) - --Abstract - - Add a name to the list of agents to notify whenever a member of - a list of kernel variables is updated. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef swpool_c - - - void swpool_c ( ConstSpiceChar * agent, - SpiceInt nnames, - SpiceInt lenvals, - const void * names ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - agent I The name of an agent to be notified after updates. - nnames I The number of variables to associate with agent. - lenvals I Length of strings in the names array. - names I Variable names whose update causes the notice. - --Detailed_Input - - agent is the name of a routine or entry point (agency) that - will want to know when a some variables in the kernel - pool have been updated. - - nnames is the number of kernel pool variable names that will - be associated with agent. - - lenvals is the length of the strings in the array names, - including the null terminators. - - names is an array of names of variables in the kernel pool. - Whenever any of these is updated, a notice will be - posted for agent so that one can quickly check - whether needed data has been modified. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If sufficient room is not available to hold a name or new agent, - a routine in the call tree for this routine will signal an error. - - 2) If either of the input string pointers are null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If any input string agent has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - - 4) The caller must pass a value indicating the length of the strings - in the names array. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) will be signaled. - --Particulars - - The kernel pool is a convenient place to store a wide variety of - data needed by routines in CSPICE and routines that interface with - CSPICE routines. However, when a single name has a large quantity - of data associated with it, it becomes inefficient to constantly - query the kernel pool for values that are not updated on a frequent - basis. - - This entry point allows a routine to instruct the kernel pool to - post a message whenever a particular value gets updated. In this - way, a routine can quickly determine whether or not data it requires - has been updated since the last time the data was accessed. This - makes it reasonable to buffer the data in local storage and update - it only when a variable in the kernel pool that affects this data - has been updated. - - Note that swpool_c has a side effect. Whenever a call to swpool_c - is made, the agent specified in the calling sequence is added to the - list of agents that should be notified that an update of its - variables has occurred. In other words the code - - swpool_c ( agent, nnames, lenvals, names ); - cvpool_c ( agent, &update ); - - will always return update as SPICETRUE. - - This feature allows for a slightly cleaner use of swpool_c and - cvpool_c as shown in the example below. Because swpool_c - automatically loads agent into the list of agents to notify of a - kernel pool update, you do not have to include the code for fetching - the initial values of the kernel variables in the initialization - portion of a subroutine. Instead, the code for the first fetch from - the pool is the same as the code for fetching when the pool is - updated. - --Examples - - Suppose that you have an application subroutine, MYTASK, that - needs to access a large data set in the kernel pool. If this - data could be kept in local storage and kernel pool queries - performed only when the data in the kernel pool has been - updated, the routine can perform much more efficiently. - - The code fragment below illustrates how you might make use of this - feature. - - #include "SpiceUsr.h" - . - . - . - /. - On the first call to this routine establish those variables - that we will want to read from the kernel pool only when - new values have been assigned. - ./ - if ( first ) - { - first = SPICEFALSE; - swpool_c ( "MYTASK", nnames, lenvals, names ); - } - - /. - If any of the variables has been updated, fetch them from the - kernel pool. - ./ - - cvpool_c ( "MYTASK", &update ); - - if ( update ) - { - for ( i = 0; i < NVAR; i++ ) - { - gdpool_c( MYTASK_VAR[i], 1, NMAX, n[i], val[i], &found[i] ); - } - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.3.0, 27-AUG-2002 (NJB) - - Call to C2F_CreateStrArr_Sig replaced with call to C2F_MapStrArr. - - -CSPICE Version 1.2.0, 28-AUG-2001 (NJB) - - Const-qualified input array names. - - -CSPICE Version 1.1.0, 14-FEB-2000 (NJB) - - Calls to C2F_CreateStrArr replaced with calls to error-signaling - version of this routine: C2F_CreateStrArr_Sig. - - -CSPICE Version 1.0.0, 05-JUN-1999 (NJB) (WLT) - --Index_Entries - - Watch for an update to a kernel pool variable - Notify a routine of an update to a kernel pool variable --& -*/ - -{ /* Begin swpool_c */ - - - /* - Local variables - */ - - SpiceChar * fCvalsArr; - - SpiceInt fCvalsLen; - - - /* - Participate in error tracing. - */ - chkin_c ( "swpool_c" ); - - - /* - Make sure the input string pointer for agent is non-null - and that the length is sufficient. - */ - CHKFSTR ( CHK_STANDARD, "swpool_c", agent ); - - /* - Make sure the input string pointer for the names array is non-null - and that the length lenvals is sufficient. - */ - CHKOSTR ( CHK_STANDARD, "swpool_c", names, lenvals ); - - /* - Create a Fortran-style string array. - */ - C2F_MapStrArr ( "swpool_c", - nnames, lenvals, names, &fCvalsLen, &fCvalsArr ); - - if ( failed_c() ) - { - chkout_c ( "swpool_c" ); - return; - } - - - /* - Call the f2c'd routine. - */ - swpool_ ( ( char * ) agent, - ( integer * ) &nnames, - ( char * ) fCvalsArr, - ( ftnlen ) strlen(agent), - ( ftnlen ) fCvalsLen ); - - - /* - Free the dynamically allocated array. - */ - free ( fCvalsArr ); - - - chkout_c ( "swpool_c" ); - -} /* End swpool_c */ - diff --git a/ext/spice/src/cspice/sxform.c b/ext/spice/src/cspice/sxform.c deleted file mode 100644 index a538d8873a..0000000000 --- a/ext/spice/src/cspice/sxform.c +++ /dev/null @@ -1,233 +0,0 @@ -/* sxform.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SXFORM ( State Transformation Matrix ) */ -/* Subroutine */ int sxform_(char *from, char *to, doublereal *et, doublereal - *xform, ftnlen from_len, ftnlen to_len) -{ - integer fcode; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tcode; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - frmchg_(integer *, integer *, doublereal *, doublereal *), - namfrm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the state transformation matrix from one frame to */ -/* another at a specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FROM I Name of the frame to transform from. */ -/* TO I Name of the frame to transform to. */ -/* ET I Epoch of the state transformation matrix. */ -/* XFORM O A state transformation matrix. */ - -/* $ Detailed_Input */ - -/* FROM is the name of a reference frame in which a state is */ -/* known. */ - -/* TO is the name of a reference frame in which it is */ -/* desired to represent the state. */ - -/* ET is the epoch in ephemeris seconds past the epoch of */ -/* J2000 (TDB) at which the state transformation matrix */ -/* should be evaluated. */ - -/* $ Detailed_Output */ - -/* XFORM is the state transformation matrix that transforms */ -/* states from the reference frame FROM to the frame TO */ -/* at epoch ET. If (x, y, z, dx, dy, dz) is a state */ -/* relative to the frame FROM then the vector ( x', y', */ -/* z', dx', dy', dz' ) is the same state relative to the */ -/* frame TO at epoch ET. Here the vector ( x', y', z', */ -/* dx', dy', dz' ) is defined by the equation: */ - -/* - - - - - - */ -/* | x' | | | | x | */ -/* | y' | | | | y | */ -/* | z' | = | XFORM | | z | */ -/* | dx' | | | | dx | */ -/* | dy' | | | | dy | */ -/* | dz' | | | | dz | */ -/* - - - - - - */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If sufficient information has not been supplied via loaded */ -/* SPICE kernels to compute the transformation between the */ -/* two frames, the error will be diagnosed by a routine */ -/* in the call tree to this routine. */ - -/* 2) If either frame FROM or TO is not recognized the error */ -/* SPICE(UNKNOWNFRAME) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the user level interface to computing state */ -/* transformations from one reference frame to another. */ - -/* Note that the reference frames may be inertial or non-inertial. */ -/* However, the user must take care that sufficient SPICE kernel */ -/* information is loaded to provide a complete state transformation */ -/* path from the FROM frame to the TO frame. */ - -/* $ Examples */ - -/* Suppose that you have geodetic coordinates of a station on */ -/* the surface of the earth and that you need the inertial */ -/* (J2000) state of this station. The following code fragment */ -/* illustrates how to transform the position of the station to */ -/* a J2000 state. */ - -/* CALL BODVRD ( 'EARTH', RADII, 3, N, ABC ) */ - -/* EQUATR = ABC(1) */ -/* POLAR = ABC(3) */ -/* F = (EQUATR - POLAR) / EQUATR */ - -/* CALL GEOREC ( LONG, LAT, 0.0D0, EQUATR, F, ESTATE ) */ - -/* ESTATE(4) = 0.0D0 */ -/* ESTATE(5) = 0.0D0 */ -/* ESTATE(6) = 0.0D0 */ - -/* CALL SXFORM ( 'IAU_EARTH', 'J2000', ET, XFORM ) */ -/* CALL MXVG ( XFORM, ESTATE, 6, 6, JSTATE ) */ - -/* The state JSTATE is the desired J2000 state of the station. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 27-FEB-2008 (BVS) */ - -/* Added FRAMES to the Required_Reading section. */ - -/* - SPICELIB Version 1.0.2, 23-OCT-2005 (NJB) */ - -/* Header example had invalid flattening factor computation; */ -/* this was corrected. Reference to BODVAR in header was */ -/* replaced with reference to BODVRD. */ - -/* - SPICELIB Version 1.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a state transformation matrix */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("SXFORM", (ftnlen)6); - namfrm_(from, &fcode, from_len); - namfrm_(to, &tcode, to_len); - -/* Only non-zero id-codes are legitimate frame id-codes. Zero */ -/* indicates that the frame wasn't recognized. */ - - if (fcode != 0 && tcode != 0) { - frmchg_(&fcode, &tcode, et, xform); - } else if (fcode == 0 && tcode == 0) { - setmsg_("Neither of the frames # or # was recognized as a known refe" - "rence frame. ", (ftnlen)72); - errch_("#", from, (ftnlen)1, from_len); - errch_("#", to, (ftnlen)1, to_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - } else if (fcode == 0) { - setmsg_("The frame # was not recognized as a known reference frame. ", - (ftnlen)59); - errch_("#", from, (ftnlen)1, from_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - } else if (tcode == 0) { - setmsg_("The frame # was not recognized as a known reference frame. ", - (ftnlen)59); - errch_("#", to, (ftnlen)1, to_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - } - chkout_("SXFORM", (ftnlen)6); - return 0; -} /* sxform_ */ - diff --git a/ext/spice/src/cspice/sxform_c.c b/ext/spice/src/cspice/sxform_c.c deleted file mode 100644 index e1daace462..0000000000 --- a/ext/spice/src/cspice/sxform_c.c +++ /dev/null @@ -1,236 +0,0 @@ -/* - --Procedure sxform_c ( State Transformation Matrix ) - --Abstract - - Return the state transformation matrix from one frame to - another at a specified epoch. - --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 - - FRAMES - --Keywords - - FRAMES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void sxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble xform[6][6] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - from I Name of the frame to transform from. - to I Name of the frame to transform to. - et I Epoch of the state transformation matrix. - xform O A state transformation matrix. - --Detailed_Input - - from is the name of a reference frame in which a state is - known. - - to is the name of a reference frame in which it is desired - to represent the state. - - et is the epoch in ephemeris seconds past the epoch of - J2000 (TDB) at which the state transformation matrix - should be evaluated. - --Detailed_Output - - xform is the matrix that transforms states from the reference - frame `from' to the frame `to' at epoch `et'. If (x, y, - z, dx, dy, dz) is a state relative to the frame `from' - then the vector ( x', y', z', dx', dy', dz' ) is the - same state relative to the frame `to' at epoch `et'. - Here the vector ( x', y', z', dx', dy', dz' ) is defined - by the equation: - - - - - - - - - | x' | | | | x | - | y' | | | | y | - | z' | = | xform | | z | - | dx' | | | | dx | - | dy' | | | | dy | - | dz' | | | | dz | - - - - - - - - --Parameters - - None. - --Exceptions - - 1) If sufficient information has not been supplied via loaded - SPICE kernels to compute the transformation between the - two frames, the error will be diagnosed by a routine - in the call tree of this routine. - - 2) If either frame `from' or `to' is not recognized the error - SPICE(UNKNOWNFRAME) will be signaled. - --Files - - None. - --Particulars - - This routine provides the user level interface for computing - state transformations from one reference frame to another. - - Note that the reference frames may be inertial or non-inertial. - However, the user must take care that sufficient SPICE kernel - information is loaded to provide a complete state transformation - path from the `from' frame to the `to' frame. - --Examples - - Suppose that you have geodetic coordinates of a station on - the surface of the earth and that you need the inertial - (J2000) state of this station. The following code fragment - illustrates how to transform the position of the station to - a J2000 state. - - #include "SpiceUsr.h" - . - . - . - bodvcd_c ( 399, radii, 3, &n, abc ); - - equatr = abc[0]; - polar = abc[2]; - f = (equatr - polar) / equatr; - - georec_c ( long, lat, 0.0, equatr, f, estate ); - - estate[3] = 0.0; - estate[4] = 0.0; - estate[5] = 0.0; - - sxform_c ( "IAU_EARTH", "J2000", et, xform ); - mxvg_c ( xform, estate, 6, 6, jstate ); - - The state `jstate' is the desired J2000 state of the station. - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - C.H. Acton (JPL) - N.J. Bachman (JPL) - B.V. Semenov (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.3, 27-FEB-2008 (BVS) - - Added FRAMES to the Required_Reading section of the header. - - -CSPICE Version 1.1.2, 24-OCT-2005 (NJB) - - Header updates: example had invalid flattening factor - computation; this was corrected. Reference to bodvar_c was - replaced with reference to bodvcd_c. - - -CSPICE Version 1.1.1, 03-JUL-2003 (NJB) (CHA) - - Various header corrections were made. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) - --Index_Entries - - Find a state transformation matrix - --& -*/ - -{ /* Begin sxform_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "sxform_c"); - - - /* - Check the input strings to make sure the pointers are non-null - and the string lengths are non-zero. - */ - CHKFSTR ( CHK_STANDARD, "sxform_c", from ); - CHKFSTR ( CHK_STANDARD, "sxform_c", to ); - - - /* - Get the desired matrix from sxform_. - */ - sxform_ ( ( char * ) from, - ( char * ) to, - ( doublereal * ) &et, - ( doublereal * ) xform, - ( ftnlen ) strlen(from), - ( ftnlen ) strlen(to) ); - - /* - Transpose the matrix on output. - */ - xpose6_c ( xform, xform ); - - - chkout_c ( "sxform_c"); - -} /* End sxform_c */ diff --git a/ext/spice/src/cspice/sydelc.c b/ext/spice/src/cspice/sydelc.c deleted file mode 100644 index ac483a73d7..0000000000 --- a/ext/spice/src/cspice/sydelc.c +++ /dev/null @@ -1,217 +0,0 @@ -/* sydelc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYDELC ( Delete a symbol from the symbol table ) */ -/* Subroutine */ int sydelc_(char *name__, char *tabsym, integer *tabptr, - char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int scardi_(integer *, integer *), remlai_( - integer *, integer *, integer *, integer *); - integer dimval, locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Delete a symbol from a character symbol table. The symbol and its */ -/* associated values are deleted. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol to be deleted. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol to be deleted from the symbol */ -/* table. If the symbol does not exist, the symbol table */ -/* remains unchanged. This subroutine is case sensitive. */ -/* NAME must the symbol exactly. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* On input, the table may or may not contain the */ -/* symbol NAME. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* On output, the symbol table no longer contains the */ -/* symbol NAME or its associated values. If NAME is not */ -/* a symbol, the components of the symbol table remain */ -/* unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example the subroutine SYDELC is used to delete */ -/* the symbol "BOHR" and its values from the symbol table. */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* The call */ - -/* CALL SYDELC ( 'BOHR', TABSYM, TABPTR, TABVAL ) */ - -/* deletes the symbol "BOHR" from the symbol table. The components */ -/* of the symbol table on output are: */ - -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete a symbol from a symbol table */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYDELC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardc_(tabval, tabval_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, we're done. If it is, we can proceed */ -/* without fear of overflow. */ - - if (locsym > 0) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - remlai_(&c__1, &locsym, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - remlac_(&dimval, &locval, tabval + tabval_len * 6, &nval, tabval_len); - scardc_(&nval, tabval, tabval_len); - } - chkout_("SYDELC", (ftnlen)6); - return 0; -} /* sydelc_ */ - diff --git a/ext/spice/src/cspice/sydeld.c b/ext/spice/src/cspice/sydeld.c deleted file mode 100644 index 49d69996ca..0000000000 --- a/ext/spice/src/cspice/sydeld.c +++ /dev/null @@ -1,220 +0,0 @@ -/* sydeld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYDELD ( Delete a symbol from a symbol table ) */ -/* Subroutine */ int sydeld_(char *name__, char *tabsym, integer *tabptr, - doublereal *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *), cardi_( - integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardd_( - integer *, doublereal *), remlac_(integer *, integer *, char *, - integer *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int scardi_(integer *, integer *), remlad_( - integer *, integer *, doublereal *, integer *), remlai_(integer *, - integer *, integer *, integer *); - integer dimval, locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Delete a symbol from a double precision symbol table. The symbol */ -/* and its associated values are deleted. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol to be deleted. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol to be deleted from the symbol */ -/* table. If the symbol does not exist, the symbol table */ -/* remains unchanged. This subroutine is case sensitive, */ -/* NAME must match the symbol exactly. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* On input, the table may or may not contain the */ -/* symbol NAME. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* On output, the symbol table no longer contains the */ -/* symbol NAME or its associated values. If NAME is not */ -/* a symbol, the components of the symbol table remain */ -/* unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example the subroutine SYDELD is used to delete */ -/* the symbol "MEAN_ANOM" and its values from the symbol table. */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - - -/* The call */ - -/* CALL SYDELC ( 'MEAN_ANOM', TABSYM, TABPTR, TABVAL ) */ - -/* deletes the symbol "MEAN_ANOM" from the symbol table. The */ -/* components of the symbol table on output are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete a symbol from a symbol table */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYDELD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardd_(tabval); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, we're done. If it is, we can proceed */ -/* without fear of overflow. */ - - if (locsym > 0) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - remlai_(&c__1, &locsym, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - remlad_(&dimval, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - } - chkout_("SYDELD", (ftnlen)6); - return 0; -} /* sydeld_ */ - diff --git a/ext/spice/src/cspice/sydeli.c b/ext/spice/src/cspice/sydeli.c deleted file mode 100644 index f00ea4406e..0000000000 --- a/ext/spice/src/cspice/sydeli.c +++ /dev/null @@ -1,217 +0,0 @@ -/* sydeli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYDELI ( Delete a symbol from a symbol table ) */ -/* Subroutine */ int sydeli_(char *name__, char *tabsym, integer *tabptr, - integer *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int scardi_(integer *, integer *), remlai_( - integer *, integer *, integer *, integer *); - integer dimval, locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Delete a symbol from an integer symbol table. The symbol */ -/* and its associated values are deleted. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol to be deleted. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol to be deleted from the symbol */ -/* table. If the symbol does not exist, the symbol table */ -/* remains unchanged. This subroutine is case sensitive, */ -/* NAME must match the symbol exactly. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* On input, the table may or may not contain the */ -/* symbol NAME. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* On output, the symbol table no longer contains the */ -/* symbol NAME or its associated values. If NAME is not */ -/* a symbol, the components of the symbol table remain */ -/* unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* In the following example the subroutine SYDELI is used to delete */ -/* the symbol "pens" and its values from the symbol table. */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The call */ - -/* CALL SYDELI ( 'pens', TABSYM, TABPTR, TABVAL ) */ - -/* deletes the symbol "pens" from the symbol table. The */ -/* components of the symbol table on output are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* delete a symbol from a symbol table */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYDELI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardi_(tabval); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, we're done. If it is, we can proceed */ -/* without fear of overflow. */ - - if (locsym > 0) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - remlai_(&c__1, &locsym, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - remlai_(&dimval, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - } - chkout_("SYDELI", (ftnlen)6); - return 0; -} /* sydeli_ */ - diff --git a/ext/spice/src/cspice/sydimc.c b/ext/spice/src/cspice/sydimc.c deleted file mode 100644 index 5249e0270a..0000000000 --- a/ext/spice/src/cspice/sydimc.c +++ /dev/null @@ -1,210 +0,0 @@ -/* sydimc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYDIMC ( Return the dimension of a symbol ) */ -integer sydimc_(char *name__, char *tabsym, integer *tabptr, char *tabval, - ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the dimension of a particular symbol in a character symbol */ -/* table. If the symbol is not found, the function returns the value */ -/* zero. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose dimension is desired. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* The function returns the dimension of the symbol NAME. If NAME is */ -/* not in the symbol table, the function returns the value zero. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose dimension is to be */ -/* returned. If the symbol is not in the symbol table, the */ -/* function returns the value zero. This function is case */ -/* sensitive, NAME must match a symbol exactly. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The table may or may not contain the symbol NAME. */ - -/* $ Detailed_Output */ - -/* The function returns the dimension of the symbol NAME. The */ -/* dimension of a symbol is the number of values associated with */ -/* that symbol. If NAME is not in the symbol table, the function */ -/* returns the value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - - -/* Perhaps we want to know how many subjects are associated with */ -/* certain scientists. The following code returns the values of */ -/* NUMSUB indicated in the table. */ - -/* NUMSUB = SYDIMC ( 'EINSTEIN', TABSYM, TABPTR, TABVAL ) */ -/* NUMSUB = SYDIMC ( 'BOHR', TABSYM, TABPTR, TABVAL ) */ -/* NUMSUB = SYDIMC ( 'FERMI', TABSYM, TABPTR, TABVAL ) */ -/* NUMSUB = SYDIMC ( 'MILLIKAN', TABSYM, TABPTR, TABVAL ) */ - - -/* ----SYMBOL----------NUMSUB------ */ -/* | EINSTEIN | 3 | */ -/* | BOHR | 1 | */ -/* | FERMI | 1 | */ -/* | MILLIKAN | 0 | */ -/* -------------------------------- */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch the dimension of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("SYDIMC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, return zero. Otherwise, look up */ -/* the dimension directly. */ - - if (locsym == 0) { - ret_val = 0; - } else { - ret_val = tabptr[locsym + 5]; - } - chkout_("SYDIMC", (ftnlen)6); - return ret_val; -} /* sydimc_ */ - diff --git a/ext/spice/src/cspice/sydimd.c b/ext/spice/src/cspice/sydimd.c deleted file mode 100644 index 5cb7c5c598..0000000000 --- a/ext/spice/src/cspice/sydimd.c +++ /dev/null @@ -1,211 +0,0 @@ -/* sydimd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYDIMD ( Return the dimension of a symbol ) */ -integer sydimd_(char *name__, char *tabsym, integer *tabptr, doublereal * - tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the dimension of a particular symbol in a double precision */ -/* symbol table. If the symbol is not found, the function returns the */ -/* value zero. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose dimension is desired. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* The function returns the dimension of the symbol NAME. If NAME is */ -/* not in the symbol table, the function returns the value zero. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose dimension is to be */ -/* returned. If the symbol is not in the symbol table, the */ -/* function returns the value zero. This function is case */ -/* sensitive, NAME must match a symbol exactly. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The table may or may not contain the symbol NAME. */ - -/* $ Detailed_Output */ - -/* The function returns the dimension of the symbol NAME. The */ -/* dimension of a symbol is the number of values associated with */ -/* that symbol. If NAME is not in the symbol table, the function */ -/* returns the value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ - - -/* Let NUMVAL be equal to the dimension of the symbols in the table. */ -/* The following code returns the values of NUMVAL indicated in the */ -/* table. */ - -/* NUMVAL = SYDIMD ( 'MEAN_ANOM', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMD ( 'K', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMD ( 'DELTA_T_A', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMD ( 'BODY10_AXES', TABSYM, TABPTR, TABVAL ) */ - -/* ----SYMBOL----------NUMVAL------ */ -/* | MEAN_ANOM | 2 | */ -/* | K | 1 | */ -/* | DELTA_T_A | 1 | */ -/* | BODY10_AXES | 0 | */ -/* -------------------------------- */ - -/* Note that the dimension of "BODY10_AXES" is zero. This is due to */ -/* the fact that "BODY10_AXES" is not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch the dimension of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("SYDIMD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, return zero. Otherwise, look up */ -/* the dimension directly. */ - - if (locsym == 0) { - ret_val = 0; - } else { - ret_val = tabptr[locsym + 5]; - } - chkout_("SYDIMD", (ftnlen)6); - return ret_val; -} /* sydimd_ */ - diff --git a/ext/spice/src/cspice/sydimi.c b/ext/spice/src/cspice/sydimi.c deleted file mode 100644 index 19e8adc033..0000000000 --- a/ext/spice/src/cspice/sydimi.c +++ /dev/null @@ -1,216 +0,0 @@ -/* sydimi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYDIMI ( Return the dimension of a symbol ) */ -integer sydimi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, - ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the dimension of a particular symbol in an integer symbol */ -/* table. If the symbol is not found, the function returns the */ -/* value zero. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose dimension is desired. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* The function returns the dimension of the symbol NAME. If NAME is */ -/* not in the symbol table, the function returns the value zero. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose dimension is to be */ -/* returned. If the symbol is not in the symbol table, the */ -/* function returns the value zero. This function is case */ -/* sensitive, NAME must match a symbol exactly. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The table may or may not contain the symbol NAME. */ - -/* $ Detailed_Output */ - -/* The function returns the dimension of the symbol NAME. The */ -/* dimension of a symbol is the number of values associated with */ -/* that symbol. If NAME is not in the symbol table, the function */ -/* returns the value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* 8 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* Let NUMVAL be equal to the dimension of the symbols in the table. */ -/* The following code returns the values of NUMVAL indicated in the */ -/* table. */ - -/* NUMVAL = SYDIMI ( 'books', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMI ( 'pencils', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMI ( 'pens', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMI ( 'erasers', TABSYM, TABPTR, TABVAL ) */ -/* NUMVAL = SYDIMI ( 'tablets', TABSYM, TABPTR, TABVAL ) */ - - -/* ----SYMBOL----------NUMVAL------ */ -/* | books | 2 | */ -/* | pencils | 1 | */ -/* | pens | 3 | */ -/* | erasers | 1 | */ -/* | tablets | 0 | */ -/* -------------------------------- */ - -/* Note that the dimension of "tablets" is zero. This is due to the */ -/* fact that "tablets" is not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch the dimension of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("SYDIMI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, return zero. Otherwise, look up */ -/* the dimension directly. */ - - if (locsym == 0) { - ret_val = 0; - } else { - ret_val = tabptr[locsym + 5]; - } - chkout_("SYDIMI", (ftnlen)6); - return ret_val; -} /* sydimi_ */ - diff --git a/ext/spice/src/cspice/sydupc.c b/ext/spice/src/cspice/sydupc.c deleted file mode 100644 index a6ddb756fd..0000000000 --- a/ext/spice/src/cspice/sydupc.c +++ /dev/null @@ -1,342 +0,0 @@ -/* sydupc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYDUPC ( Create a duplicate of a symbol ) */ -/* Subroutine */ int sydupc_(char *name__, char *copy, char *tabsym, integer * - tabptr, char *tabval, ftnlen name_len, ftnlen copy_len, ftnlen - tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym, i__; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *), - sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen), scardi_(integer - *, integer *), inslac_(char *, integer *, integer *, char *, - integer *, ftnlen, ftnlen); - integer dimval[2]; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval[2]; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer locsym[2]; - logical oldsym[2]; - extern logical return_(void); - integer newsym; - -/* $ Abstract */ - -/* Create a duplicate of a symbol within a character symbol table. */ -/* If a symbol with the new name already exists, its components */ -/* are replaced. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol to be duplicated. */ -/* COPY I Name of the new symbol. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol to be duplicated. The */ -/* components associated with NAME will be given to the */ -/* new symbol COPY. If NAME is not in the symbol table, */ -/* no duplicate symbol can be made. */ - -/* COPY is the name of the new symbol. If a symbol with the */ -/* name COPY already exists in the symbol table, its */ -/* components are replaced by the components of NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* On output, the symbol table contains a new symbol COPY */ -/* whose components are the same as the components of */ -/* NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the symbol NAME is not in the symbol table, the error */ -/* SPICE(NOSUCHSYMBOL) is signalled. */ - -/* 2) If duplication of the symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 3) If duplication of the symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 4) If duplication of the symbol causes an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, no duplicate symbol */ -/* can be made. */ -/* If the symbol COPY is already in the symbol table, its components */ -/* are replaced by the components of NAME. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* The code, */ - -/* CALL SYDUPC ( 'FERMI', 'HAHN', TABSYM, TABPTR, TABVAL ) */ - -/* produces the symbol table: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* HAHN --> NUCLEAR FISSION */ - -/* The code, */ - -/* CALL SYDUPC ( 'STRASSMAN', 'HAHN', TABSYM, TABPTR, TABVAL ) */ - -/* produces the error SPICE(NOSUCHSYMBOL) because the symbol */ -/* "STRASSMAN" is not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* create a duplicate of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYDUPC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardc_(tabval, tabval_len); - -/* Where do these symbols belong? Are they already in the table? */ - - locsym[0] = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - locsym[1] = lstlec_(copy, &nsym, tabsym + tabsym_len * 6, copy_len, - tabsym_len); - oldsym[0] = locsym[0] != 0 && s_cmp(tabsym + (locsym[0] + 5) * tabsym_len, - name__, tabsym_len, name_len) == 0; - oldsym[1] = locsym[1] != 0 && s_cmp(tabsym + (locsym[1] + 5) * tabsym_len, - copy, tabsym_len, copy_len) == 0; - -/* If the original symbol is not in the table, we can't make a copy. */ - - if (! oldsym[0]) { - setmsg_("SYDUPC: The symbol to be duplicated, #, is not in the symbo" - "l table.", (ftnlen)67); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NOSUCHSYMBOL)", (ftnlen)19); - -/* Otherwise, we need to know the dimension, to check for overflow. */ - - } else { - i__1 = locsym[0] - 1; - locval[0] = sumai_(&tabptr[6], &i__1) + 1; - dimval[0] = tabptr[locsym[0] + 5]; - -/* If the new symbol already exists, we need to know its dimension */ -/* too, for the same reason. */ - - if (oldsym[1]) { - i__1 = locsym[1] - 1; - locval[1] = sumai_(&tabptr[6], &i__1) + 1; - dimval[1] = tabptr[locsym[1] + 5]; - newsym = 0; - } else { - locval[1] = sumai_(&tabptr[6], &locsym[1]) + 1; - dimval[1] = 0; - newsym = 1; - } - newval = dimval[0] - dimval[1]; - -/* Can we make a copy without overflow? */ - - if (nsym + newsym > sizec_(tabsym, tabsym_len)) { - setmsg_("SYDUPC: Duplication of the symbol # causes an overflow " - "in the name table.", (ftnlen)73); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr + newsym > sizei_(tabptr)) { - setmsg_("SYDUPC: Duplication of the symbol # causes an overflow " - "in the pointer table.", (ftnlen)76); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval + newval > sizec_(tabval, tabval_len)) { - setmsg_("SYDUPC: Duplication of the symbol # causes an overflow " - "in the value table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* Looks like we can. */ - - } else { - -/* If the copy exists, remove the current contents and */ -/* change the dimension. Otherwise add the new name and */ -/* dimension to the name and pointer tables. */ - - if (dimval[1] > 0) { - remlac_(&dimval[1], &locval[1], tabval + tabval_len * 6, & - nval, tabval_len); - scardc_(&nval, tabval, tabval_len); - tabptr[locsym[1] + 5] = dimval[0]; - if (locval[0] > locval[1]) { - locval[0] -= dimval[1]; - } - } else { - i__1 = locsym[1] + 1; - inslac_(copy, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - copy_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym[1] + 1; - inslai_(dimval, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } - -/* In either case, allocate space for the new symbol values, */ -/* and copy them in one by one. (INSLAx won't work if the */ -/* copy is earlier in the table than the original.) */ - - i__1 = locval[1]; - for (i__ = nval; i__ >= i__1; --i__) { - s_copy(tabval + (i__ + dimval[0] + 5) * tabval_len, tabval + ( - i__ + 5) * tabval_len, tabval_len, tabval_len); - } - if (locval[0] > locval[1]) { - locval[0] += dimval[0]; - } - i__1 = dimval[0] - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - s_copy(tabval + (locval[1] + i__ + 5) * tabval_len, tabval + ( - locval[0] + i__ + 5) * tabval_len, tabval_len, - tabval_len); - } - i__1 = nval + dimval[0]; - scardc_(&i__1, tabval, tabval_len); - } - } - chkout_("SYDUPC", (ftnlen)6); - return 0; -} /* sydupc_ */ - diff --git a/ext/spice/src/cspice/sydupd.c b/ext/spice/src/cspice/sydupd.c deleted file mode 100644 index 278e429007..0000000000 --- a/ext/spice/src/cspice/sydupd.c +++ /dev/null @@ -1,339 +0,0 @@ -/* sydupd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYDUPD ( Create a duplicate of a symbol ) */ -/* Subroutine */ int sydupd_(char *name__, char *copy, char *tabsym, integer * - tabptr, doublereal *tabval, ftnlen name_len, ftnlen copy_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym, i__; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *), cardi_( - integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sized_(doublereal *), sumai_( - integer *, integer *), sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardd_( - integer *, doublereal *), remlad_(integer *, integer *, - doublereal *, integer *), scardi_(integer *, integer *), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen); - integer dimval[2]; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval[2]; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer locsym[2]; - logical oldsym[2]; - extern logical return_(void); - integer newsym; - -/* $ Abstract */ - -/* Create a duplicate of a symbol within a double precision symbol */ -/* table. If a symbol with the new name already exists, its */ -/* components are replaced. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol to be duplicated. */ -/* COPY I Name of the new symbol. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol to be duplicated. The */ -/* components associated with NAME will be given to the */ -/* new symbol COPY. If NAME is not in the symbol table, */ -/* no duplicate symbol can be made. */ - -/* COPY is the name of the new symbol. If a symbol with the */ -/* name COPY already exists in the symbol table, its */ -/* components are replaced by the components of NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol */ -/* table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* On output, the symbol table contains a new symbol COPY */ -/* whose components are the same as the components of */ -/* NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the symbol NAME is not in the symbol table, the error */ -/* SPICE(NOSUCHSYMBOL) is signalled. */ - -/* 2) If duplication of the symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 3) If duplication of the symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 4) If duplication of the symbol causes an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, no duplicate symbol */ -/* can be made. */ -/* If the symbol COPY is already in the symbol table, its components */ -/* are replaced by the components of NAME. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The code, */ - -/* CALL SYDUPD ( 'K', 'EB', TABSYM, TABPTR, TABVAL ) */ - -/* produces the symbol table: */ - -/* DELTA_T_A --> 32.184 */ -/* EB --> 1.657D-3 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The code, */ - -/* CALL SYDUPD ( 'M0', 'M1', TABSYM, TABPTR, TABVAL ) */ - -/* produces the error SPICE(NOSUCHSYMBOL) because the symbol "M0" is */ -/* not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* create a duplicate of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYDUPD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardd_(tabval); - -/* Where do these symbols belong? Are they already in the table? */ - - locsym[0] = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - locsym[1] = lstlec_(copy, &nsym, tabsym + tabsym_len * 6, copy_len, - tabsym_len); - oldsym[0] = locsym[0] != 0 && s_cmp(tabsym + (locsym[0] + 5) * tabsym_len, - name__, tabsym_len, name_len) == 0; - oldsym[1] = locsym[1] != 0 && s_cmp(tabsym + (locsym[1] + 5) * tabsym_len, - copy, tabsym_len, copy_len) == 0; - -/* If the original symbol is not in the table, we can't make a copy. */ - - if (! oldsym[0]) { - setmsg_("SYDUPD: The symbol to be duplicated, #, is not in the symbo" - "l table.", (ftnlen)67); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NOSUCHSYMBOL)", (ftnlen)19); - -/* Otherwise, we need to know the dimension, to check for overflow. */ - - } else { - i__1 = locsym[0] - 1; - locval[0] = sumai_(&tabptr[6], &i__1) + 1; - dimval[0] = tabptr[locsym[0] + 5]; - -/* If the new symbol already exists, we need to know its dimension */ -/* too, for the same reason. */ - - if (oldsym[1]) { - i__1 = locsym[1] - 1; - locval[1] = sumai_(&tabptr[6], &i__1) + 1; - dimval[1] = tabptr[locsym[1] + 5]; - newsym = 0; - } else { - locval[1] = sumai_(&tabptr[6], &locsym[1]) + 1; - dimval[1] = 0; - newsym = 1; - } - newval = dimval[0] - dimval[1]; - -/* Can we make a copy without overflow? */ - - if (nsym + newsym > sizec_(tabsym, tabsym_len)) { - setmsg_("SYDUPD: Duplication of the symbol # causes an overflow " - "in the name table.", (ftnlen)73); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr + newsym > sizei_(tabptr)) { - setmsg_("SYDUPD: Duplication of the symbol # causes an overflow " - "in the pointer table.", (ftnlen)76); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval + newval > sized_(tabval)) { - setmsg_("SYDUPD: Duplication of the symbol # causes an overflow " - "in the value table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* Looks like we can. */ - - } else { - -/* If the copy exists, remove the current contents and */ -/* change the dimension. Otherwise add the new name and */ -/* dimension to the name and pointer tables. */ - - if (dimval[1] > 0) { - remlad_(&dimval[1], &locval[1], &tabval[6], &nval); - scardd_(&nval, tabval); - tabptr[locsym[1] + 5] = dimval[0]; - if (locval[0] > locval[1]) { - locval[0] -= dimval[1]; - } - } else { - i__1 = locsym[1] + 1; - inslac_(copy, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - copy_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym[1] + 1; - inslai_(dimval, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } - -/* In either case, allocate space for the new symbol values, */ -/* and copy them in one by one. (INSLAx won't work if the */ -/* copy is earlier in the table than the original.) */ - - i__1 = locval[1]; - for (i__ = nval; i__ >= i__1; --i__) { - tabval[i__ + dimval[0] + 5] = tabval[i__ + 5]; - } - if (locval[0] > locval[1]) { - locval[0] += dimval[0]; - } - i__1 = dimval[0] - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - tabval[locval[1] + i__ + 5] = tabval[locval[0] + i__ + 5]; - } - i__1 = nval + dimval[0]; - scardd_(&i__1, tabval); - } - } - chkout_("SYDUPD", (ftnlen)6); - return 0; -} /* sydupd_ */ - diff --git a/ext/spice/src/cspice/sydupi.c b/ext/spice/src/cspice/sydupi.c deleted file mode 100644 index cf517903eb..0000000000 --- a/ext/spice/src/cspice/sydupi.c +++ /dev/null @@ -1,339 +0,0 @@ -/* sydupi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYDUPI ( Create a duplicate of a symbol ) */ -/* Subroutine */ int sydupi_(char *name__, char *copy, char *tabsym, integer * - tabptr, integer *tabval, ftnlen name_len, ftnlen copy_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym, i__; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *), - sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardi_( - integer *, integer *), remlai_(integer *, integer *, integer *, - integer *), inslac_(char *, integer *, integer *, char *, integer - *, ftnlen, ftnlen); - integer dimval[2]; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval[2]; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer locsym[2]; - logical oldsym[2]; - extern logical return_(void); - integer newsym; - -/* $ Abstract */ - -/* Create a duplicate of a symbol within an integer symbol table. */ -/* If a symbol with the new name already exists, its components */ -/* are replaced. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol to be duplicated. */ -/* COPY I Name of the new symbol. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol to be duplicated. The */ -/* components associated with NAME will be given to the */ -/* new symbol COPY. If NAME is not in the symbol table, */ -/* no duplicate symbol can be made. */ - -/* COPY is the name of the new symbol. If a symbol with the */ -/* name COPY already exists in the symbol table, its */ -/* components are replaced by the components of NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* On output, the symbol table contains a new symbol COPY */ -/* whose components are the same as the components of */ -/* NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the symbol NAME is not in the symbol table, the error */ -/* SPICE(NOSUCHSYMBOL) is signalled. */ - -/* 2) If duplication of the symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 3) If duplication of the symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 4) If duplication of the symbol causes an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, no duplicate symbol */ -/* can be made. */ -/* If the symbol COPY is already in the symbol table, its components */ -/* are replaced by the components of NAME. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The code, */ - -/* CALL SYDUPI ( 'books', 'tablets', TABSYM, TABPTR, TABVAL ) */ - -/* produces the symbol table: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ -/* tablets --> 5 */ - -/* The code, */ - -/* CALL SYDUPC ( 'desks', 'chairs', TABSYM, TABPTR, TABVAL ) */ - -/* produces the error SPICE(NOSUCHSYMBOL) because the symbol */ -/* "desks" is not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* create a duplicate of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } else { - chkin_("SYDUPI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardi_(tabval); - -/* Where do these symbols belong? Are they already in the table? */ - - locsym[0] = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - locsym[1] = lstlec_(copy, &nsym, tabsym + tabsym_len * 6, copy_len, - tabsym_len); - oldsym[0] = locsym[0] != 0 && s_cmp(tabsym + (locsym[0] + 5) * tabsym_len, - name__, tabsym_len, name_len) == 0; - oldsym[1] = locsym[1] != 0 && s_cmp(tabsym + (locsym[1] + 5) * tabsym_len, - copy, tabsym_len, copy_len) == 0; - -/* If the original symbol is not in the table, we can't make a copy. */ - - if (! oldsym[0]) { - setmsg_("SYDUPI: The symbol to be duplicated, #, is not in the symbo" - "l table.", (ftnlen)67); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NOSUCHSYMBOL)", (ftnlen)19); - -/* Otherwise, we need to know the dimension, to check for overflow. */ - - } else { - i__1 = locsym[0] - 1; - locval[0] = sumai_(&tabptr[6], &i__1) + 1; - dimval[0] = tabptr[locsym[0] + 5]; - -/* If the new symbol already exists, we need to know its dimension */ -/* too, for the same reason. */ - - if (oldsym[1]) { - i__1 = locsym[1] - 1; - locval[1] = sumai_(&tabptr[6], &i__1) + 1; - dimval[1] = tabptr[locsym[1] + 5]; - newsym = 0; - } else { - locval[1] = sumai_(&tabptr[6], &locsym[1]) + 1; - dimval[1] = 0; - newsym = 1; - } - newval = dimval[0] - dimval[1]; - -/* Can we make a copy without overflow? */ - - if (nsym + newsym > sizec_(tabsym, tabsym_len)) { - setmsg_("SYDUPI: Duplication of the symbol # causes an overflow " - "in the name table.", (ftnlen)73); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr + newsym > sizei_(tabptr)) { - setmsg_("SYDUPI: Duplication of the symbol # causes an overflow " - "in the pointer table.", (ftnlen)76); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval + newval > sizei_(tabval)) { - setmsg_("SYDUPI: Duplication of the symbol # causes an overflow " - "in the value table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* Looks like we can. */ - - } else { - -/* If the copy exists, remove the current contents and */ -/* change the dimension. Otherwise add the new name and */ -/* dimension to the name and pointer tables. */ - - if (dimval[1] > 0) { - remlai_(&dimval[1], &locval[1], &tabval[6], &nval); - scardi_(&nval, tabval); - tabptr[locsym[1] + 5] = dimval[0]; - if (locval[0] > locval[1]) { - locval[0] -= dimval[1]; - } - } else { - i__1 = locsym[1] + 1; - inslac_(copy, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - copy_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym[1] + 1; - inslai_(dimval, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } - -/* In either case, allocate space for the new symbol values, */ -/* and copy them in one by one. (INSLAx won't work if the */ -/* copy is earlier in the table than the original.) */ - - i__1 = locval[1]; - for (i__ = nval; i__ >= i__1; --i__) { - tabval[i__ + dimval[0] + 5] = tabval[i__ + 5]; - } - if (locval[0] > locval[1]) { - locval[0] += dimval[0]; - } - i__1 = dimval[0] - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - tabval[locval[1] + i__ + 5] = tabval[locval[0] + i__ + 5]; - } - i__1 = nval + dimval[0]; - scardi_(&i__1, tabval); - } - } - chkout_("SYDUPI", (ftnlen)6); - return 0; -} /* sydupi_ */ - diff --git a/ext/spice/src/cspice/syenqc.c b/ext/spice/src/cspice/syenqc.c deleted file mode 100644 index 5853340c67..0000000000 --- a/ext/spice/src/cspice/syenqc.c +++ /dev/null @@ -1,260 +0,0 @@ -/* syenqc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYENQC ( Enqueue a value onto a symbol ) */ -/* Subroutine */ int syenqc_(char *name__, char *value, char *tabsym, integer - *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen - tabsym_len, ftnlen tabval_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern /* Subroutine */ int sysetc_(char *, char *, char *, integer *, - char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Enqueue a value onto a particular symbol in a character */ -/* symbol table. If the symbol is not in the table, a new one */ -/* is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol onto which the value is */ -/* enqueued. */ -/* VALUE I Value to be enqueued. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol onto which the value is to */ -/* be enqueued. If NAME is not in the symbol table, a new */ -/* symbol having the value VALUE is created. */ - -/* VALUE is the value to be enqueued onto the symbol, NAME. */ -/* The value is inserted in the value table after the */ -/* last value associated with the symbol. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The symbol NAME may or may not be in the symbol */ -/* table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* On output, the value table contains the new value */ -/* in addition to the old values associated with the */ -/* symbol NAME. The pointer table is updated to */ -/* reflect the change in the dimension of the symbol. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of the new value to the symbol table */ -/* causes an overflow in the value table, the error */ -/* SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, a new symbol is */ -/* created which has the value VALUE. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - - -/* The call, */ - -/* CALL SYENQC ( 'EINSTEIN', 'GENERAL RELATIVITY', */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* produces the symbol table: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* GENERAL RELATIVITY */ -/* FERMI --> NUCLEAR FISSION */ - -/* The next call, */ - -/* CALL SYENQC ( 'HAHN', 'NUCLEAR FISSION', TABSYM, TABPTR, TABVAL ) */ - -/* then produces the symbol table: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* GENERAL RELATIVITY */ -/* FERMI --> NUCLEAR FISSION */ -/* HAHN --> NUCLEAR FISSION */ - -/* Note that a new symbol "HAHN" was created by the last call. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* enqueue a value onto a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYENQC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nval = cardc_(tabval, tabval_len); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's not already in the table, use SET to create a brand new */ -/* symbol. */ - - if (! oldsym) { - sysetc_(name__, value, tabsym, tabptr, tabval, name_len, value_len, - tabsym_len, tabval_len); - -/* If it is in the table, we can't proceed unless we know that we */ -/* have enough room for one extra addition in the value table. */ - - } else if (nval >= sizec_(tabval, tabval_len)) { - setmsg_("SYENQC: The addition of the value $ to the symbol # causes " - "an overflow in the value table.", (ftnlen)90); - errch_("$", value, (ftnlen)1, value_len); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new value to the value table at the */ -/* correct location, and add one to the dimension. */ - - } else { - locval = sumai_(&tabptr[6], &locsym) + 1; - inslac_(value, &c__1, &locval, tabval + tabval_len * 6, &nval, - value_len, tabval_len); - scardc_(&nval, tabval, tabval_len); - ++tabptr[locsym + 5]; - } - chkout_("SYENQC", (ftnlen)6); - return 0; -} /* syenqc_ */ - diff --git a/ext/spice/src/cspice/syenqd.c b/ext/spice/src/cspice/syenqd.c deleted file mode 100644 index 73c7742135..0000000000 --- a/ext/spice/src/cspice/syenqd.c +++ /dev/null @@ -1,262 +0,0 @@ -/* syenqd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYENQD ( Enqueue a value onto a symbol ) */ -/* Subroutine */ int syenqd_(char *name__, doublereal *value, char *tabsym, - integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen - tabsym_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nsym; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen); - extern integer sized_(doublereal *), sumai_(integer *, integer *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), inslad_( - doublereal *, integer *, integer *, doublereal *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern /* Subroutine */ int sysetd_(char *, doublereal *, char *, integer - *, doublereal *, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Enqueue a value onto a particular symbol in a double precision */ -/* symbol table. If the symbol is not in the table, a new one */ -/* is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol onto which the value is */ -/* enqueued. */ -/* VALUE I Value to be enqueued. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol onto which the value is to */ -/* be enqueued. If NAME is not in the symbol table, a new */ -/* symbol having the value VALUE is created. */ - -/* VALUE is the value to be enqueued onto the symbol, NAME. */ -/* The value is inserted in the value table after the */ -/* last value associated with the symbol. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The symbol NAME may or may not be in the symbol */ -/* table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* On output, the value table contains the new value */ -/* in addition to the old values associated with the */ -/* symbol NAME. The pointer table is updated to */ -/* reflect the change in the dimension of the symbol. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of the new value to the symbol table */ -/* causes an overflow in the value table, the error */ -/* SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, a new symbol is */ -/* created which has the value VALUE. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The call, */ - -/* CALL SYENQD ( 'BODY399_POLE_RA', 0.0D0, TABSYM, TABPTR, TABVAL ) */ - -/* produces the symbol table: */ - -/* BODY399_POLE_RA --> 0.0D0 */ -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* Notice that the new symbol "BODY399_POLE_RA" has been created and */ -/* has the value 0.0D0 associated with it. */ - -/* The next call, */ - -/* CALL SYENQD ( 'BODY399_POLE_RA', -6.4061614D-1, */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* CALL SYENQD ( 'BODY399_POLE_RA', -8.386D-5, */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* then produces the symbol table: */ - -/* BODY399_POLE_RA --> 0.0D0 */ -/* -6.4061614D-1 */ -/* -8.386D-5 */ -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* enqueue a value onto a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYENQD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nval = cardd_(tabval); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's not already in the table, use SET to create a brand new */ -/* symbol. */ - - if (! oldsym) { - sysetd_(name__, value, tabsym, tabptr, tabval, name_len, tabsym_len); - -/* If it is in the table, we can't proceed unless we know that we */ -/* have enough room for one extra addition in the value table. */ - - } else if (nval >= sized_(tabval)) { - setmsg_("SYENQD: The addition of the value $ to the symbol # causes " - "an overflow in the value table.", (ftnlen)90); - errdp_("$", value, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new value to the value table. Add one */ -/* to the dimension, and put the value in the right place. */ - - } else { - locval = sumai_(&tabptr[6], &locsym) + 1; - inslad_(value, &c__1, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - ++tabptr[locsym + 5]; - } - chkout_("SYENQD", (ftnlen)6); - return 0; -} /* syenqd_ */ - diff --git a/ext/spice/src/cspice/syenqi.c b/ext/spice/src/cspice/syenqi.c deleted file mode 100644 index bd9f24ad62..0000000000 --- a/ext/spice/src/cspice/syenqi.c +++ /dev/null @@ -1,259 +0,0 @@ -/* syenqi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYENQI ( Enqueue a value onto a symbol ) */ -/* Subroutine */ int syenqi_(char *name__, integer *value, char *tabsym, - integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), inslai_( - integer *, integer *, integer *, integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - extern /* Subroutine */ int syseti_(char *, integer *, char *, integer *, - integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Enqueue a value onto a particular symbol in an integer */ -/* symbol table. If the symbol is not in the table, a new one */ -/* is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol onto which the value is */ -/* enqueued. */ -/* VALUE I Value to be enqueued. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol onto which the value is to */ -/* be enqueued. If NAME is not in the symbol table, a new */ -/* symbol having the value VALUE is created. */ - -/* VALUE is the value to be enqueued onto the symbol, NAME. */ -/* The value is inserted in the value table after the */ -/* last value associated with the symbol. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The symbol NAME may or may not be in the symbol */ -/* table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* On output, the value table contains the new value */ -/* in addition to the old values associated with the */ -/* symbol NAME. The pointer table is updated to */ -/* reflect the change in the dimension of the symbol. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of the new value to the symbol table */ -/* causes an overflow in the value table, the error */ -/* SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, a new symbol is */ -/* created which has the value VALUE. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The call, */ - -/* CALL SYENQI ( 'books', 12, TABSYM, TABPTR, TABVAL ) */ - -/* produces the symbol table: */ - -/* books --> 5 */ -/* 12 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The next call, */ - -/* CALL SYENQI ( 'desks', 23, TABSYM, TABPTR, TABVAL ) */ - -/* then produces the symbol table: */ - -/* books --> 5 */ -/* 12 */ -/* desks --> 23 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* Notice that the symbol "desks" was created by the last call. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* enqueue a value onto a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYENQI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nval = cardi_(tabval); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's not already in the table, use SET to create a brand new */ -/* symbol. */ - - if (! oldsym) { - syseti_(name__, value, tabsym, tabptr, tabval, name_len, tabsym_len); - -/* If it is in the table, we can't proceed unless we know that we */ -/* have enough room for one extra addition in the value table. */ - - } else if (nval >= sizei_(tabval)) { - setmsg_("SYENQI: The addition of the value $ to the symbol # causes " - "an overflow in the value table.", (ftnlen)90); - errint_("$", value, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new value to the value table. Add one */ -/* to the dimension, and put the value in the right place. */ - - } else { - locval = sumai_(&tabptr[6], &locsym) + 1; - inslai_(value, &c__1, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - ++tabptr[locsym + 5]; - } - chkout_("SYENQI", (ftnlen)6); - return 0; -} /* syenqi_ */ - diff --git a/ext/spice/src/cspice/syfetc.c b/ext/spice/src/cspice/syfetc.c deleted file mode 100644 index 417b882d88..0000000000 --- a/ext/spice/src/cspice/syfetc.c +++ /dev/null @@ -1,205 +0,0 @@ -/* syfetc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYFETC ( Fetch the Nth symbol in the table ) */ -/* Subroutine */ int syfetc_(integer *nth, char *tabsym, integer *tabptr, - char *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen - tabval_len, ftnlen name_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Fetch the Nth symbol in a character symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NTH I Index of symbol to be fetched. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ -/* NAME O Name of the NTH symbol in the symbol table. */ -/* FOUND O True if the NTH symbol is in the symbol table, */ -/* false if it is not. */ - -/* $ Detailed_Input */ - -/* NTH is the index of the symbol to be fetched. If the NTH */ -/* symbol does not exist, FOUND is FALSE. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The NTH symbol may or may not be in the symbol */ -/* table. The symbol table is not modified by this */ -/* subroutine. */ - -/* $ Detailed_Output */ - -/* NAME is the name of the NTH symbol in the symbol table. */ - -/* FOUND is true if the NTH symbol is in the symbol table. */ -/* If the NTH symbol is not in the table, FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* The calls, */ - -/* CALL SYFETC ( 2, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETC ( 3, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETC ( -1, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETC ( 4, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ - -/* result in the values for NAME and FOUND: */ - -/* NAME FOUND */ -/* ---------- ----- */ -/* EINSTEIN TRUE */ -/* FERMI TRUE */ -/* FALSE */ -/* FALSE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch the nth symbol in the table */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused variable SUMAI removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYFETC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* If the value of NTH is out of range, that's a problem. */ - - if (*nth < 1 || *nth > nsym) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ - - } else { - *found = TRUE_; - s_copy(name__, tabsym + (*nth + 5) * tabsym_len, name_len, tabsym_len) - ; - } - chkout_("SYFETC", (ftnlen)6); - return 0; -} /* syfetc_ */ - diff --git a/ext/spice/src/cspice/syfetd.c b/ext/spice/src/cspice/syfetd.c deleted file mode 100644 index 6f438efed0..0000000000 --- a/ext/spice/src/cspice/syfetd.c +++ /dev/null @@ -1,204 +0,0 @@ -/* syfetd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYFETD ( Fetch the Nth symbol in the table ) */ -/* Subroutine */ int syfetd_(integer *nth, char *tabsym, integer *tabptr, - doublereal *tabval, char *name__, logical *found, ftnlen tabsym_len, - ftnlen name_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Fetch the Nth symbol in a double precision symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NTH I Index of symbol to be fetched. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ -/* NAME O Name of the NTH symbol in the symbol table. */ -/* FOUND O True if the NTH symbol is in the symbol table, */ -/* false if it is not. */ - -/* $ Detailed_Input */ - -/* NTH is the index of the symbol to be fetched. If the NTH */ -/* symbol does not exist, FOUND is FALSE. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The NTH symbol may or may not be in the symbol table. */ -/* The symbol table is not modified by this subroutine. */ - -/* $ Detailed_Output */ - -/* NAME is the name of the NTH symbol in the symbol table. */ - -/* FOUND is true if the NTH symbol is in the symbol table. */ -/* If the NTH symbol is not in the table, FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The calls, */ - -/* CALL SYFETD ( 2, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETD ( 3, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETD ( -1, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETD ( 5, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ - -/* result in the values for NAME and FOUND: */ - -/* NAME FOUND */ -/* ---------- ----- */ -/* K TRUE */ -/* MEAN_ANOM TRUE */ -/* FALSE */ -/* FALSE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch the nth symbol in the table */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused variable SUMAI removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYFETD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* If the value of NTH is out of range, that's a problem. */ - - if (*nth < 1 || *nth > nsym) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ - - } else { - *found = TRUE_; - s_copy(name__, tabsym + (*nth + 5) * tabsym_len, name_len, tabsym_len) - ; - } - chkout_("SYFETD", (ftnlen)6); - return 0; -} /* syfetd_ */ - diff --git a/ext/spice/src/cspice/syfeti.c b/ext/spice/src/cspice/syfeti.c deleted file mode 100644 index 0aa2841e8f..0000000000 --- a/ext/spice/src/cspice/syfeti.c +++ /dev/null @@ -1,206 +0,0 @@ -/* syfeti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYFETI ( Fetch the Nth symbol in the table ) */ -/* Subroutine */ int syfeti_(integer *nth, char *tabsym, integer *tabptr, - integer *tabval, char *name__, logical *found, ftnlen tabsym_len, - ftnlen name_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Fetch the Nth symbol in an integer symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NTH I Index of symbol to be fetched. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ -/* NAME O Name of the NTH symbol in the symbol table. */ -/* FOUND O True if the NTH symbol is in the symbol table, */ -/* false if it is not. */ - -/* $ Detailed_Input */ - -/* NTH is the index of the symbol to be fetched. If the NTH */ -/* symbol does not exist, FOUND is FALSE. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The NTH symbol may or may not be in the symbol */ -/* table. The symbol table is not modified by this */ -/* subroutine. */ - -/* $ Detailed_Output */ - -/* NAME is the name of the NTH symbol in the symbol table. */ - -/* FOUND is true if the NTH symbol is in the symbol table. */ -/* If the NTH symbol is not in the table, FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The calls, */ - -/* CALL SYFETI ( 2, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETI ( 3, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETI ( -1, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ -/* CALL SYFETI ( 6, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */ - -/* result in the values for NAME and FOUND: */ - -/* NAME FOUND */ -/* ---------- ----- */ -/* erasers TRUE */ -/* pencils TRUE */ -/* FALSE */ -/* FALSE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch the nth symbol in the table */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused variable SUMAI removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYFETI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* If the value of NTH is out of range, that's a problem. */ - - if (*nth < 1 || *nth > nsym) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ - - } else { - *found = TRUE_; - s_copy(name__, tabsym + (*nth + 5) * tabsym_len, name_len, tabsym_len) - ; - } - chkout_("SYFETI", (ftnlen)6); - return 0; -} /* syfeti_ */ - diff --git a/ext/spice/src/cspice/sygetc.c b/ext/spice/src/cspice/sygetc.c deleted file mode 100644 index 4e1bb09d93..0000000000 --- a/ext/spice/src/cspice/sygetc.c +++ /dev/null @@ -1,244 +0,0 @@ -/* sygetc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYGETC ( Return all components for a symbol ) */ -/* Subroutine */ int sygetc_(char *name__, char *tabsym, integer *tabptr, - char *tabval, integer *n, char *values, logical *found, ftnlen - name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), movec_(char *, - integer *, char *, ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the dimension and associated values for a particular */ -/* symbol. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose components are to be */ -/* returned. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* N O Dimension of the symbol. */ -/* VALUES O Values associated with the symbol. */ -/* FOUND O True if the symbol NAME is in the symbol table, */ -/* false if it is not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose components are to be */ -/* returned. If NAME is not in the symbol table, FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The symbol NAME may or may not be in the symbol */ -/* table. The symbol table is not modified by this */ -/* subroutine. */ - -/* $ Detailed_Output */ - -/* N is the dimension of the symbol NAME. The dimension is */ -/* the number of values associated with the given symbol. */ -/* N is defined only if the output argument FOUND is */ -/* .TRUE. */ - -/* VALUES is an array containing the values associated with the */ -/* symbol. If the array is not large enough to hold all */ -/* of the values associated with NAME, as many as will */ -/* fit are returned. VALUES is defined only if the */ -/* output argument FOUND is .TRUE. */ - -/* FOUND is true if NAME is in the symbol table. If NAME is not */ -/* in the table, FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This subroutine does not check to see if the output array */ -/* VALUES is large enough to hold all of the values associated */ -/* with the symbol NAME. The caller must provide the required */ -/* space. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* Let the dimension of VALUES be 3. */ - -/* The calls, */ - -/* CALL SYGETC ( 'EINSTEIN', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - -/* CALL SYGETC ( 'MILLIKAN', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - -/* CALL SYGETC ( 'BORN', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - - -/* return the values for N, VALUES, and FOUND associated with NAME: */ - -/* NAME N VALUES FOUND */ -/* ---------- --- ----------------------- ------- */ -/* EINSTEIN 3 SPECIAL RELATIVITY TRUE */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* MILLIKAN FALSE */ -/* BORN 1 HYDROGEN ATOM TRUE */ - - -/* $ Restrictions */ - -/* 1) See Exceptions section. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */ - -/* Various header corrections were made. In particular, */ -/* the header no longer asserts that this routine will */ -/* "return as many values as will fit" in the output array */ -/* VALUES. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch all components for a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYGETC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ -/* We trust that the user has supplied enough room. */ - - } else { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - *n = tabptr[locsym + 5]; - movec_(tabval + (locval + 5) * tabval_len, n, values, tabval_len, - values_len); - } - chkout_("SYGETC", (ftnlen)6); - return 0; -} /* sygetc_ */ - diff --git a/ext/spice/src/cspice/sygetd.c b/ext/spice/src/cspice/sygetd.c deleted file mode 100644 index cd8b94e7f8..0000000000 --- a/ext/spice/src/cspice/sygetd.c +++ /dev/null @@ -1,247 +0,0 @@ -/* sygetd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYGETD ( Return all components for a symbol ) */ -/* Subroutine */ int sygetd_(char *name__, char *tabsym, integer *tabptr, - doublereal *tabval, integer *n, doublereal *values, logical *found, - ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the dimension and associated values for a particular */ -/* symbol. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose components are to be */ -/* returned. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* N O Dimension of the symbol. */ -/* VALUES O Values associated with the symbol. */ -/* FOUND O True if the symbol NAME is in the symbol table, */ -/* false if it is not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose components are to be */ -/* returned. If NAME is not in the symbol table, FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The symbol NAME may or may not be in the symbol */ -/* table. The symbol table is not modified by this */ -/* subroutine. */ - -/* $ Detailed_Output */ - -/* N is the dimension of the symbol NAME. The dimension is */ -/* the number of values associated with the given symbol. */ -/* N is defined only if the output argument FOUND is */ -/* .TRUE. */ - -/* VALUES is an array containing the values associated with the */ -/* symbol. If the array is not large enough to hold all */ -/* of the values associated with NAME, as many as will */ -/* fit are returned. VALUES is defined only if the */ -/* output argument FOUND is .TRUE. */ - -/* FOUND is true if NAME is in the symbol table. */ -/* If NAME is not in the table, FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This subroutine does not check to see if the output array */ -/* VALUES is large enough to hold all of the values associated */ -/* with the symbol NAME. The caller must provide the required */ -/* space. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* Let the dimension of VALUES be 3. */ - -/* The calls, */ - -/* CALL SYGETD ( 'K', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - -/* CALL SYGETD ( 'BODY4_POLE_RA', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - -/* CALL SYGETD ( 'BODY4_PRIME', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - - -/* return the values for N, VALUES, and FOUND associated with NAME: */ - - -/* NAME N VALUES FOUND */ -/* ---------- --- ----------------------- ------- */ -/* K 1 1.657D-3 TRUE */ -/* BODY4_POLE_RA 3 3.17681D2 TRUE */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* BODY4_PRIME FALSE */ - - -/* $ Restrictions */ - -/* 1) See Exceptions section. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */ - -/* Various header corrections were made. In particular, */ -/* the header no longer asserts that this routine will */ -/* "return as many values as will fit" in the output array */ -/* VALUES. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch all components for a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYGETD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ -/* We trust that the user has supplied enough room. */ - - } else { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - *n = tabptr[locsym + 5]; - moved_(&tabval[locval + 5], n, values); - } - chkout_("SYGETD", (ftnlen)6); - return 0; -} /* sygetd_ */ - diff --git a/ext/spice/src/cspice/sygeti.c b/ext/spice/src/cspice/sygeti.c deleted file mode 100644 index 1c6f2f1788..0000000000 --- a/ext/spice/src/cspice/sygeti.c +++ /dev/null @@ -1,245 +0,0 @@ -/* sygeti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYGETI ( Return all components for a symbol ) */ -/* Subroutine */ int sygeti_(char *name__, char *tabsym, integer *tabptr, - integer *tabval, integer *n, integer *values, logical *found, ftnlen - name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the dimension and associated values for a particular */ -/* symbol. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose components are to be */ -/* returned. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* N O Dimension of the symbol. */ -/* VALUES O Values associated with the symbol. */ -/* FOUND O True if the symbol NAME is in the symbol table, */ -/* false if it is not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose components are to be */ -/* returned. If NAME is not in the symbol table, FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The symbol NAME may or may not be in the symbol */ -/* table. The symbol table is not modified by this */ -/* subroutine. */ - -/* $ Detailed_Output */ - -/* N is the dimension of the symbol NAME. The dimension is */ -/* the number of values associated with the given symbol. */ -/* N is defined only if the output argument FOUND is */ -/* .TRUE. */ - -/* VALUES is an array containing the values associated with the */ -/* symbol. If the array is not large enough to hold all */ -/* of the values associated with NAME, as many as will */ -/* fit are returned. VALUES is defined only if the */ -/* output argument FOUND is .TRUE. */ - -/* FOUND is true if NAME is in the symbol table. */ -/* If NAME is not in the table, FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This subroutine does not check to see if the output array */ -/* VALUES is large enough to hold all of the values associated */ -/* with the symbol NAME. The caller must provide the required */ -/* space. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 24 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* Let the dimension of VALUES be 3. */ - -/* The calls, */ - -/* CALL SYGETI ( 'pencils', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - -/* CALL SYGETI ( 'pens', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - -/* CALL SYGETI ( 'desks', TABSYM, TABPTR, TABVAL, */ -/* . N, VALUES, FOUND ) */ - - -/* return the values for N, VALUES, and FOUND associated with NAME: */ - -/* NAME N VALUES FOUND */ -/* ---------- --- -------- ------- */ -/* pencils 2 12 TRUE */ -/* 24 */ -/* pens 3 10 TRUE */ -/* 12 */ -/* 24 */ -/* desks FALSE */ - -/* $ Restrictions */ - -/* 1) See Exceptions section. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */ - -/* Various header corrections were made. In particular, */ -/* the header no longer asserts that this routine will */ -/* "return as many values as will fit" in the output array */ -/* VALUES. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch all components for a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYGETI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ -/* We trust that the user has supplied enough room. */ - - } else { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - *n = tabptr[locsym + 5]; - movei_(&tabval[locval + 5], n, values); - } - chkout_("SYGETI", (ftnlen)6); - return 0; -} /* sygeti_ */ - diff --git a/ext/spice/src/cspice/synthc.c b/ext/spice/src/cspice/synthc.c deleted file mode 100644 index 95aa2c9f1e..0000000000 --- a/ext/spice/src/cspice/synthc.c +++ /dev/null @@ -1,235 +0,0 @@ -/* synthc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYNTHC ( Return Nth value associated with the symbol ) */ -/* Subroutine */ int synthc_(char *name__, integer *nth, char *tabsym, - integer *tabptr, char *tabval, char *value, logical *found, ftnlen - name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the Nth value associated with a particular symbol in a */ -/* character symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose Nth associated value is */ -/* to be returned. */ -/* NTH I Index of the value to be returned. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* VALUE O Nth value associated with the symbol. */ -/* FOUND O True if the Nth value of the symbol exists, false */ -/* if it does not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose Nth associated value */ -/* is to be returned. If NAME is not in the symbol table, */ -/* FOUND is false. */ - -/* NTH is the index of the value to be returned. If the */ -/* value of NTH is out of range ( NTH < 1 or NTH is */ -/* greater than the dimension of the symbol ) FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The symbol table is not modified by this subroutine. */ - -/* $ Detailed_Output */ - -/* VALUES is the NTH value associated with the symbol NAME. */ - -/* FOUND is true if NAME is in the symbol table and the NTH */ -/* value associated with NAME exists. Otherwise FOUND */ -/* is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* Two conditions will cause the value of FOUND to be false: */ - -/* 1) The symbol NAME is not in the symbol table. */ - -/* 2) NTH is out of range ( NTH < 1 or NTH is greater than the */ -/* dimension of the symbol ). */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* The calls, */ - -/* CALL SYNTHC ( 'EINSTEIN', 2, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* CALL SYNTHC ( 'BORN', 2, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* CALL SYNTHC ( 'MAXWELL', 5, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* return the values of VALUE and FOUND corresponding to NAME and */ -/* NTH: */ - -/* NAME NTH VALUE FOUND */ -/* ---------- ----- ---------------------- ------- */ -/* EINSTEIN 2 PHOTOELECTRIC EFFECT TRUE */ -/* BORN 2 FALSE */ -/* MAXWELL 5 FALSE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch nth value associated with a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYNTHC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* If the value of NTH is out of range, that's a problem too. */ - - } else if (*nth < 1 || *nth > tabptr[locsym + 5]) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ - - } else { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + *nth; - s_copy(value, tabval + (locval + 5) * tabval_len, value_len, - tabval_len); - } - chkout_("SYNTHC", (ftnlen)6); - return 0; -} /* synthc_ */ - diff --git a/ext/spice/src/cspice/synthd.c b/ext/spice/src/cspice/synthd.c deleted file mode 100644 index a991010773..0000000000 --- a/ext/spice/src/cspice/synthd.c +++ /dev/null @@ -1,231 +0,0 @@ -/* synthd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYNTHD ( Return the Nth component of a symbol ) */ -/* Subroutine */ int synthd_(char *name__, integer *nth, char *tabsym, - integer *tabptr, doublereal *tabval, doublereal *value, logical * - found, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the Nth component of a particular symbol in a double */ -/* precision symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose Nth component is to be */ -/* returned. */ -/* NTH I Index of the value to be returned. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ -/* VALUE O Nth value associated with the symbol. */ -/* FOUND O True if the Nth value of the symbol exists, false */ -/* if it does not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose Nth component is to be */ -/* returned. If NAME is not in the symbol table, FOUND is */ -/* false. */ - -/* NTH is the index of the component to be returned. If the */ -/* value of NTH is out of range ( NTH < 1 or NTH is */ -/* greater than the dimension of the symbol ) FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The symbol table is not modified by this subroutine. */ - -/* $ Detailed_Output */ - -/* VALUES is the NTH component of the symbol NAME. */ - -/* FOUND is true if NAME is in the symbol table and the NTH */ -/* component of NAME exists. Otherwise FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* Two conditions will cause the value of FOUND to be false: */ - -/* 1) The symbol NAME is not in the symbol table. */ - -/* 2) NTH is out of range ( NTH < 1 or NTH is greater than the */ -/* dimension of the symbol ). */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The calls, */ - -/* CALL SYNTHD ( 'MEAN_ANOM', 2, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* CALL SYNTHD ( 'BODY4_PRIME', 1, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* CALL SYNTHD ( 'ORBIT_ECC', -5, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* return the values of VALUE and FOUND corresponding to NAME and */ -/* NTH: */ - -/* NAME NTH VALUE FOUND */ -/* ---------- ----- ---------------- ------- */ -/* MEAN_ANOM 2 1.99096871D-7 TRUE */ -/* BODY4_PRIME 1 FALSE */ -/* ORBIT_ECC -5 FALSE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch nth value associated with a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYNTHD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* If the value of NTH is out of range, that's a problem too. */ - - } else if (*nth < 1 || *nth > tabptr[locsym + 5]) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ - - } else { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + *nth; - *value = tabval[locval + 5]; - } - chkout_("SYNTHD", (ftnlen)6); - return 0; -} /* synthd_ */ - diff --git a/ext/spice/src/cspice/synthi.c b/ext/spice/src/cspice/synthi.c deleted file mode 100644 index 27c6f0bc32..0000000000 --- a/ext/spice/src/cspice/synthi.c +++ /dev/null @@ -1,230 +0,0 @@ -/* synthi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYNTHI ( Return the Nth component of a symbol ) */ -/* Subroutine */ int synthi_(char *name__, integer *nth, char *tabsym, - integer *tabptr, integer *tabval, integer *value, logical *found, - ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Return the Nth component of a particular symbol in an integer */ -/* symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose Nth component is to be */ -/* returned. */ -/* NTH I Index of the value to be returned. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ -/* VALUE O Nth value associated with the symbol. */ -/* FOUND O True if the Nth value of the symbol exists, false */ -/* if it does not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose Nth component is to be */ -/* returned. If NAME is not in the symbol table, FOUND is */ -/* false. */ - -/* NTH is the index of the component to be returned. If the */ -/* value of NTH is out of range ( NTH < 1 or NTH is */ -/* greater than the dimension of the symbol ) FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The symbol table is not modified by this subroutine. */ - -/* $ Detailed_Output */ - -/* VALUES is the NTH component of the symbol NAME. */ - -/* FOUND is true if NAME is in the symbol table and the NTH */ -/* component of NAME exists. Otherwise FOUND is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* Two conditions will cause the value of FOUND to be false: */ - -/* 1) The symbol NAME is not in the symbol table. */ - -/* 2) NTH is out of range ( NTH < 1 or NTH is greater than the */ -/* dimension of the symbol ). */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 24 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The calls, */ - -/* CALL SYNTHI ( 'pens', 2, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* CALL SYNTHI ( 'pencils', 3, TABSYM, TABPTR, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* CALL SYNTHI ( 'chairs', 1, TABPTR, TABVAL, TABVAL, VALUE, */ -/* . FOUND ) */ - -/* return the values of VALUE and FOUND corresponding to NAME and */ -/* NTH: */ - -/* NAME NTH VALUE FOUND */ -/* ---------- ----- ------- ------- */ -/* pens 2 12 TRUE */ -/* pencils FALSE */ -/* chairs FALSE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch nth value associated with a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYNTHI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* If the value of NTH is out of range, that's a problem too. */ - - } else if (*nth < 1 || *nth > tabptr[locsym + 5]) { - *found = FALSE_; - -/* Otherwise, we can proceed without fear of error. Merely locate */ -/* and return the appropriate component from the values table. */ - - } else { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + *nth; - *value = tabval[locval + 5]; - } - chkout_("SYNTHI", (ftnlen)6); - return 0; -} /* synthi_ */ - diff --git a/ext/spice/src/cspice/syordc.c b/ext/spice/src/cspice/syordc.c deleted file mode 100644 index 4efb50ae42..0000000000 --- a/ext/spice/src/cspice/syordc.c +++ /dev/null @@ -1,207 +0,0 @@ -/* syordc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYORDC ( Order the components of a single symbol ) */ -/* Subroutine */ int syordc_(char *name__, char *tabsym, integer *tabptr, - char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - extern /* Subroutine */ int shellc_(integer *, char *, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Order the components of a single symbol in a character symbol */ -/* table. The components are ordered according to the ASCII collating */ -/* sequence. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose components are to be */ -/* ordered. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose components are to be */ -/* ordered. If NAME is not in the symbol table, the symbol */ -/* table is not modified. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The components of the symbol are sorted according to */ -/* ASCII collating sequence. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, the symbol table */ -/* is not modified. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* The call, */ - -/* CALL SYORDC ( 'EINSTEIN', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> BROWNIAN MOTION */ -/* PHOTOELECTRIC EFFECT */ -/* SPECIAL RELATIVITY */ -/* FERMI --> NUCLEAR FISSIONC */ - - -/* Note that the call, */ - -/* CALL SYORDC ( 'MAXWELL', TABSYM, TABPTR, TABVAL ) */ - -/* will not modify the symbol table because the symbol "MAXWELL" is */ -/* not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* order the components of a single symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYORDC", (ftnlen)6); - } - -/* How many symbols? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If so, sort the components in place. */ - - if (locsym > 0) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - n = tabptr[locsym + 5]; - shellc_(&tabptr[locsym + 5], tabval + (locval + 5) * tabval_len, - tabval_len); - } - chkout_("SYORDC", (ftnlen)6); - return 0; -} /* syordc_ */ - diff --git a/ext/spice/src/cspice/syordd.c b/ext/spice/src/cspice/syordd.c deleted file mode 100644 index d923299ad5..0000000000 --- a/ext/spice/src/cspice/syordd.c +++ /dev/null @@ -1,210 +0,0 @@ -/* syordd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYORDD ( Order the components of a single symbol ) */ -/* Subroutine */ int syordd_(char *name__, char *tabsym, integer *tabptr, - doublereal *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - extern /* Subroutine */ int shelld_(integer *, doublereal *); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Order the components of a single symbol in a double precision */ -/* symbol table. The components are sorted in increasing order. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose components are to be */ -/* ordered. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose components are to be */ -/* ordered. If NAME is not in the symbol table, the symbol */ -/* table is not modified. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The components of the symbol are sorted in increasing */ -/* order. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, the symbol table */ -/* is not modified. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The call, */ - -/* CALL SYORDD ( 'BODY4_POLE_RA', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 0.0D0 */ -/* 1.08D-1 */ -/* 3.17681D2 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* Note that the call, */ - -/* CALL SYORDD ( 'BODY4_PRIME', TABSYM, TABPTR, TABVAL ) */ - -/* will not modify the symbol table because the symbol "BODY4_PRIME" */ -/* is not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* order the components of a single symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYORDD", (ftnlen)6); - } - -/* How many symbols? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If so, sort the components in place. */ - - if (locsym > 0) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - n = tabptr[locsym + 5]; - shelld_(&tabptr[locsym + 5], &tabval[locval + 5]); - } - chkout_("SYORDD", (ftnlen)6); - return 0; -} /* syordd_ */ - diff --git a/ext/spice/src/cspice/syordi.c b/ext/spice/src/cspice/syordi.c deleted file mode 100644 index dbe52ddb08..0000000000 --- a/ext/spice/src/cspice/syordi.c +++ /dev/null @@ -1,212 +0,0 @@ -/* syordi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYORDI ( Order the components of a single symbol ) */ -/* Subroutine */ int syordi_(char *name__, char *tabsym, integer *tabptr, - integer *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int shelli_(integer *, integer *), chkout_(char *, - ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Order the components of a single symbol in an integer symbol */ -/* table. The components are sorted in increasing order. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose components are to be */ -/* ordered. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose components are to be */ -/* ordered. If NAME is not in the symbol table, the symbol */ -/* table is not modified. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The components of the symbol are sorted in increasing */ -/* order. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, the symbol table */ -/* is not modified. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 24 */ -/* pens --> 10 */ -/* 24 */ -/* 12 */ -/* 36 */ -/* 4 */ - -/* The call, */ - -/* CALL SYORDI ( 'pens', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 24 */ -/* pens --> 4 */ -/* 10 */ -/* 12 */ -/* 24 */ -/* 36 */ - -/* Note that the call, */ - -/* CALL SYORDI ( 'desks', TABSYM, TABPTR, TABVAL ) */ - -/* will not modify the symbol table because the symbol "desks" is */ -/* not in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* order the components of a single symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYORDI", (ftnlen)6); - } - -/* How many symbols? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If so, sort the components in place. */ - - if (locsym > 0) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - n = tabptr[locsym + 5]; - shelli_(&tabptr[locsym + 5], &tabval[locval + 5]); - } - chkout_("SYORDI", (ftnlen)6); - return 0; -} /* syordi_ */ - diff --git a/ext/spice/src/cspice/sypopc.c b/ext/spice/src/cspice/sypopc.c deleted file mode 100644 index 7fc742fb22..0000000000 --- a/ext/spice/src/cspice/sypopc.c +++ /dev/null @@ -1,268 +0,0 @@ -/* sypopc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPOPC ( Pop a value from a particular symbol ) */ -/* Subroutine */ int sypopc_(char *name__, char *tabsym, integer *tabptr, - char *tabval, char *value, logical *found, ftnlen name_len, ftnlen - tabsym_len, ftnlen tabval_len, ftnlen value_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int scardi_(integer *, integer *), remlai_( - integer *, integer *, integer *, integer *); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Pop a value associated with a particular symbol in a character */ -/* symbol table. The first value associated with the symbol is */ -/* removed, and subsequent values are moved forward. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated value is to be */ -/* popped. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* VALUE O Value that was popped. */ -/* FOUND O True if the symbol exists, false if it does not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated value is to */ -/* be popped. If NAME is not in the symbol table, FOUND */ -/* is false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The value is removed from the symbol table, and the */ -/* remaining values associated with the symbol are moved */ -/* forward in the value table. If no other values are */ -/* associated with the symbol, the symbol is removed from */ -/* the symbol table. */ - -/* VALUE is the value that was popped. This value was the first */ -/* value in the symbol table that was associated with the */ -/* symbol NAME. */ - -/* FOUND is true if NAME is in the symbol table, otherwise */ -/* it is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* If there are no remaining values associated with the symbol */ -/* after VALUE has been popped, the symbol is removed from the */ -/* symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* The call, */ - -/* CALL SYPOPC ( 'EINSTEIN', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ - -/* FOUND is TRUE, and VALUE is 'SPECIAL RELATIVITY'. */ - - -/* The next call, */ - -/* CALL SYPOPC ( 'FERMI', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ - -/* FOUND is TRUE, and VALUE is 'NUCLEAR FISSION'. Note that because */ -/* "FERMI" had only one value associated with it, it was removed */ -/* from the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* pop a value from a particular symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPOPC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardc_(tabval, tabval_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* If it is in the table, we can proceed without fear of overflow. */ - - } else { - *found = TRUE_; - -/* Begin by saving and removing the initial value for this */ -/* symbol from the value table. */ - - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - s_copy(value, tabval + (locval + 5) * tabval_len, value_len, - tabval_len); - remlac_(&c__1, &locval, tabval + tabval_len * 6, &nval, tabval_len); - scardc_(&nval, tabval, tabval_len); - -/* If this was the sole value for the symbol, remove the */ -/* symbol from the name and pointer tables. Otherwise just */ -/* decrement the dimension. */ - - if (tabptr[locsym + 5] == 1) { - remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym, - tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - remlai_(&c__1, &locsym, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } else { - --tabptr[locsym + 5]; - } - } - chkout_("SYPOPC", (ftnlen)6); - return 0; -} /* sypopc_ */ - diff --git a/ext/spice/src/cspice/sypopd.c b/ext/spice/src/cspice/sypopd.c deleted file mode 100644 index 4b9ec0b584..0000000000 --- a/ext/spice/src/cspice/sypopd.c +++ /dev/null @@ -1,275 +0,0 @@ -/* sypopd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPOPD ( Pop a value from a particular symbol ) */ -/* Subroutine */ int sypopd_(char *name__, char *tabsym, integer *tabptr, - doublereal *tabval, doublereal *value, logical *found, ftnlen - name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *), cardi_( - integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardd_( - integer *, doublereal *), remlac_(integer *, integer *, char *, - integer *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int remlad_(integer *, integer *, doublereal *, - integer *), scardi_(integer *, integer *), remlai_(integer *, - integer *, integer *, integer *); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Pop a value associated with a particular symbol in a double */ -/* precision symbol table. The first value associated with the */ -/* symbol is removed, and subsequent values are moved forward. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated value is to be */ -/* popped. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* VALUE O Value that was popped. */ -/* FOUND O True if the symbol exists, false if it does not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated value is to */ -/* be popped. If NAME is not in the symbol table, FOUND is */ -/* false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The value is removed from the symbol table, and the */ -/* remaining values associated with the symbol are moved */ -/* forward in the value table. If no other values are */ -/* associated with the symbol, the symbol is removed from */ -/* the symbol table. */ - -/* VALUE is the value that was popped. This value was the first */ -/* value in the symbol table that was associated with the */ -/* symbol NAME. */ - -/* FOUND is true if NAME is in the symbol table, otherwise */ -/* it is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* If there are no remaining values associated with the symbol */ -/* after VALUE has been popped, the symbol is removed from the */ -/* symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The call, */ - -/* CALL SYPOPD ( 'MEAN_ANOM', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0C */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* FOUND is TRUE, and VALUE is 6.239996D0. */ - - -/* The next call, */ - -/* CALL SYPOPD ( 'K', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0C */ -/* DELTA_T_A --> 3.2184D1 */ -/* MEAN_ANOM --> 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* FOUND is TRUE, and VALUE is 1.657D-3. Note that because */ -/* "K" had only one value associated with it, it was removed */ -/* from the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* pop a value from a particular symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPOPD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardd_(tabval); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* If it is in the table, we can proceed without fear of overflow. */ - - } else { - *found = TRUE_; - -/* Begin by saving and removing the initial value for this */ -/* symbol from the value table. */ - - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - *value = tabval[locval + 5]; - remlad_(&c__1, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - -/* If this was the sole value for the symbol, remove the */ -/* symbol from the name and pointer tables. Otherwise just */ -/* decrement the dimension. */ - - if (tabptr[locsym + 5] == 1) { - remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym, - tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - remlai_(&c__1, &locsym, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } else { - --tabptr[locsym + 5]; - } - } - chkout_("SYPOPD", (ftnlen)6); - return 0; -} /* sypopd_ */ - diff --git a/ext/spice/src/cspice/sypopi.c b/ext/spice/src/cspice/sypopi.c deleted file mode 100644 index 889591043c..0000000000 --- a/ext/spice/src/cspice/sypopi.c +++ /dev/null @@ -1,273 +0,0 @@ -/* sypopi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPOPI ( Pop a value from a particular symbol ) */ -/* Subroutine */ int sypopi_(char *name__, char *tabsym, integer *tabptr, - integer *tabval, integer *value, logical *found, ftnlen name_len, - ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int scardi_(integer *, integer *), remlai_( - integer *, integer *, integer *, integer *); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Pop a value associated with a particular symbol in an integer */ -/* symbol table. The first value associated with the symbol is */ -/* removed, and subsequent values are moved forward. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated value is to be */ -/* popped. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* VALUE O Value that was popped. */ -/* FOUND O True if the symbol exists, false if it does not. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated value is to */ -/* be popped. If NAME is not in the symbol table, FOUND */ -/* is false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The value is removed from the symbol table, and the */ -/* remaining values associated with the symbol are moved */ -/* forward in the value table. If no other values are */ -/* associated with the symbol, the symbol is removed from */ -/* the symbol table. */ - -/* VALUE is the value that was popped. This value was the first */ -/* value in the symbol table that was associated with the */ -/* symbol NAME. */ - -/* FOUND is true if NAME is in the symbol table, otherwise */ -/* it is false. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* If there are no remaining values associated with the symbol */ -/* after VALUE has been popped, the symbol is removed from the */ -/* symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 18 */ -/* 12 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The call, */ - -/* CALL SYPOPI ( 'pens', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 18 */ -/* 12 */ -/* pens --> 12 */ -/* 24 */ - -/* FOUND is TRUE, and VALUE is 10. */ - - -/* The next call, */ - -/* CALL SYPOPI ( 'erasers', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* pencils --> 18 */ -/* 12 */ -/* pens --> 12 */ -/* 24 */ - -/* FOUND is TRUE, and VALUE is 6. Note that because */ -/* "erasers" had only one value associated with it, it was removed */ -/* from the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 10-DEC-2002 (LSE) */ - -/* Fixed typo (FISSION') in header */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* pop a value from a particular symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPOPI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardi_(tabval); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - -/* If it is in the table, we can proceed without fear of overflow. */ - - } else { - *found = TRUE_; - -/* Begin by saving and removing the initial value for this */ -/* symbol from the value table. */ - - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - *value = tabval[locval + 5]; - remlai_(&c__1, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - -/* If this was the sole value for the symbol, remove the */ -/* symbol from the name and pointer tables. Otherwise just */ -/* decrement the dimension. */ - - if (tabptr[locsym + 5] == 1) { - remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym, - tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - remlai_(&c__1, &locsym, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } else { - --tabptr[locsym + 5]; - } - } - chkout_("SYPOPI", (ftnlen)6); - return 0; -} /* sypopi_ */ - diff --git a/ext/spice/src/cspice/sypshc.c b/ext/spice/src/cspice/sypshc.c deleted file mode 100644 index 2bb102d2af..0000000000 --- a/ext/spice/src/cspice/sypshc.c +++ /dev/null @@ -1,261 +0,0 @@ -/* sypshc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPSHC ( Push a value onto a particular symbol ) */ -/* Subroutine */ int sypshc_(char *name__, char *value, char *tabsym, integer - *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen - tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern /* Subroutine */ int sysetc_(char *, char *, char *, integer *, - char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Push a value onto a particular symbol in a character symbol table. */ -/* The previous value(s) associated with the symbol is extended at */ -/* the front. A new symbol is created if necessary. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol onto which the value is to be */ -/* pushed. */ -/* VALUE I Value that is to be pushed onto the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol onto which the value is to */ -/* be pushed. If NAME is not in the symbol table, a new */ -/* symbol is created. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* The value is added to the symbol table at the front */ -/* of the previous value(s) associated with the symbol */ -/* NAME. If NAME is not originally in the symbol table, */ -/* a new symbol is created. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of the new value to the symbol table */ -/* causes an overflow in the value table, the error */ -/* SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, a new symbol */ -/* is created. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ - -/* The call, */ - -/* CALL SYPSHC ( 'PAULI', 'NEUTRINO', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> NEUTRINO */ -/* EXCLUSION PRINCIPLE */ - -/* The next call, */ - -/* CALL SYPSHC ( 'MILLIKAN', 'PHOTOELECTRIC EFFECT', */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* MILLIKAN --> PHOTOELECTRIC EFFECT */ -/* PAULI --> NEUTRINO */ -/* EXCLUSION PRINCIPLE */ - -/* Note that a new symbol "MILLIKAN" was created by the last call. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* push a value onto a particular symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPSHC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nval = cardc_(tabval, tabval_len); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's not already in the table, use SET to create a brand new */ -/* symbol. */ - - if (! oldsym) { - sysetc_(name__, value, tabsym, tabptr, tabval, name_len, value_len, - tabsym_len, tabval_len); - -/* If it is in the table, we can't proceed unless we know that we */ -/* have enough room for one extra addition in the value table. */ - - } else if (nval >= sizec_(tabval, tabval_len)) { - setmsg_("SYPSHC: The addition of the value $ to the symbol # causes " - "an overflow in the value table.", (ftnlen)90); - errch_("$", value, (ftnlen)1, value_len); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new value to the value table. Add one */ -/* to the dimension, and put the value in the right place. */ - - } else { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - inslac_(value, &c__1, &locval, tabval + tabval_len * 6, &nval, - value_len, tabval_len); - scardc_(&nval, tabval, tabval_len); - ++tabptr[locsym + 5]; - } - chkout_("SYPSHC", (ftnlen)6); - return 0; -} /* sypshc_ */ - diff --git a/ext/spice/src/cspice/sypshd.c b/ext/spice/src/cspice/sypshd.c deleted file mode 100644 index ee01813dc5..0000000000 --- a/ext/spice/src/cspice/sypshd.c +++ /dev/null @@ -1,263 +0,0 @@ -/* sypshd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPSHD ( Push a value onto a particular symbol ) */ -/* Subroutine */ int sypshd_(char *name__, doublereal *value, char *tabsym, - integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nsym; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen); - extern integer sized_(doublereal *), sumai_(integer *, integer *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), inslad_( - doublereal *, integer *, integer *, doublereal *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern /* Subroutine */ int sysetd_(char *, doublereal *, char *, integer - *, doublereal *, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Push a value onto a particular symbol in a double precision */ -/* symbol table. The previous value(s) associated with the symbol */ -/* is extended at the front. A new symbol is created if necessary. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol onto which the value is to be */ -/* pushed. */ -/* VALUE I Value that is to be pushed onto the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol onto which the value is to */ -/* be pushed. If NAME is not in the symbol table, a new */ -/* symbol is created. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* The value is added to the symbol table at the front */ -/* of the previous value(s) associated with the symbol */ -/* NAME. If NAME is not originally in the symbol table, */ -/* a new symbol is created. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of the new value to the symbol table */ -/* causes an overflow in the value table, the error */ -/* SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, a new symbol */ -/* is created. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The call, */ - -/* CALL SYPSHD ( 'BODY4_POLE_RA', 3.17681D2, */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The next call, */ - -/* CALL SYPSHC ( 'BODY4_GM', 4.2826286548993737D4, */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_GM --> 4.2826286548993737D4 */ -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* Note that a new symbol "BODY4_GM" was created by the last call. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* push a value onto a particular symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPSHD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nval = cardd_(tabval); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's not already in the table, use SET to create a brand new */ -/* symbol. */ - - if (! oldsym) { - sysetd_(name__, value, tabsym, tabptr, tabval, name_len, tabsym_len); - -/* If it is in the table, we can't proceed unless we know that we */ -/* have enough room for one extra addition in the value table. */ - - } else if (nval >= sized_(tabval)) { - setmsg_("SYPSHD: The addition of the value $ to the symbol # causes " - "an overflow in the value table.", (ftnlen)90); - errdp_("$", value, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new value to the value table. Add one */ -/* to the dimension, and put the value in the right place. */ - - } else { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - inslad_(value, &c__1, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - ++tabptr[locsym + 5]; - } - chkout_("SYPSHD", (ftnlen)6); - return 0; -} /* sypshd_ */ - diff --git a/ext/spice/src/cspice/sypshi.c b/ext/spice/src/cspice/sypshi.c deleted file mode 100644 index 786b82203c..0000000000 --- a/ext/spice/src/cspice/sypshi.c +++ /dev/null @@ -1,260 +0,0 @@ -/* sypshi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPSHI ( Push a value onto a particular symbol ) */ -/* Subroutine */ int sypshi_(char *name__, integer *value, char *tabsym, - integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), inslai_( - integer *, integer *, integer *, integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - extern /* Subroutine */ int syseti_(char *, integer *, char *, integer *, - integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Push a value onto a particular symbol in an integer symbol table. */ -/* The previous value(s) associated with the symbol is extended at */ -/* the front. A new symbol is created if necessary. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol onto which the value is to be */ -/* pushed. */ -/* VALUE I Value that is to be pushed onto the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol onto which the value is to */ -/* be pushed. If NAME is not in the symbol table, a new */ -/* symbol is created. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* The value is added to the symbol table at the front */ -/* of the previous value(s) associated with the symbol */ -/* NAME. If NAME is not originally in the symbol table, */ -/* a new symbol is created. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of the new value to the symbol table */ -/* causes an overflow in the value table, the error */ -/* SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If the symbol NAME is not in the symbol table, a new symbol */ -/* is created. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 18 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The call, */ - -/* CALL SYPSHI ( 'pencils', 45, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 45 */ -/* 12 */ -/* 18 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ -/* The next call, */ - -/* CALL SYPSHC ( 'desks', 31, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* desks --> 31 */ -/* erasers --> 6 */ -/* pencils --> 45 */ -/* 12 */ -/* 18 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* Note that a new symbol "desks" was created by the last call. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* push a value onto a particular symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPSHI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nval = cardi_(tabval); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's not already in the table, use SET to create a brand new */ -/* symbol. */ - - if (! oldsym) { - syseti_(name__, value, tabsym, tabptr, tabval, name_len, tabsym_len); - -/* If it is in the table, we can't proceed unless we know that we */ -/* have enough room for one extra addition in the value table. */ - - } else if (nval >= sizei_(tabval)) { - setmsg_("SYPSHI: The addition of the value $ to the symbol # causes " - "an overflow in the value table.", (ftnlen)90); - errint_("$", value, (ftnlen)1); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new value to the value table. Add one */ -/* to the dimension, and put the value in the right place. */ - - } else { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - inslai_(value, &c__1, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - ++tabptr[locsym + 5]; - } - chkout_("SYPSHI", (ftnlen)6); - return 0; -} /* sypshi_ */ - diff --git a/ext/spice/src/cspice/syputc.c b/ext/spice/src/cspice/syputc.c deleted file mode 100644 index 59236ae0e9..0000000000 --- a/ext/spice/src/cspice/syputc.c +++ /dev/null @@ -1,345 +0,0 @@ -/* syputc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPUTC ( Set the values associated with a symbol ) */ -/* Subroutine */ int syputc_(char *name__, char *values, integer *n, char * - tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen - values_len, ftnlen tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *), - sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen), scardi_(integer - *, integer *), inslac_(char *, integer *, integer *, char *, - integer *, ftnlen, ftnlen); - integer dimval; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - integer newsym; - -/* $ Abstract */ - -/* Set the values of a particular symbol in a character symbol table. */ -/* If the symbol already exists, the previous values associated with */ -/* it are removed, otherwise a new symbol is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be put into the symbol table. */ -/* VALUES I Values to be associated with the symbol NAME. */ -/* N I Number of values in VALUES. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated values are */ -/* to be set. If NAME has values associated with it, */ -/* they are removed, and the elements of VALUES become */ -/* the values associated with NAME. If NAME is not in the */ -/* symbol table, a new symbol is created, provided there */ -/* is room in the symbol table. */ - -/* VALUES are the new values associated with the symbol NAME. */ - -/* N is the number of elements in the VALUES array. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* If NAME has values associated with it, they are */ -/* removed, and the elements of VALUES become the */ -/* values associated with NAME. If NAME is not in the */ -/* symbol table, a new symbol is created, provided */ -/* there is room in the symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of a new symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 2) If the addition of a new symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 3) If the addition of new values causes an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* 4) If N < 1, the error SPICE(INVALIDARGUMENT) is signalled. */ - -/* $ Particulars */ - -/* This subroutine is like SYSETC, but SYPUTC allows several values */ -/* to be associated with a symbol. ------- */ - -/* If NAME has values associated with it, they are removed, and */ -/* the elements of VALUES become the values associated with NAME. */ -/* If NAME is not in the symbol table, a new symbol is created, */ -/* provided there is room in the symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> NEUTRINO */ - -/* If VALUES contains the elements, */ - -/* SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ - -/* the call */ - -/* CALL SYPUTC ( 'EINSTEIN', VALUES, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* ENISTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> NEUTRINO */ - -/* The call, */ - -/* CALL SYPUTC ( 'PAULI', VALUES, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* ENISTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ - -/* Note that the previous values associated with PAULI have been */ -/* replaced by the values in VALUES. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the values associated with a symbol */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused variable I removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPUTC", (ftnlen)6); - } - -/* Check to see if the number of values is a valid quantity. */ - - if (*n < 1) { - setmsg_("SYPUTC: The dimension of the values array isless than one.", - (ftnlen)58); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SYPUTC", (ftnlen)6); - return 0; - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardc_(tabval, tabval_len); - -/* Where does this symbol belong? is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If the new symbol already exists, we need to know its dimension */ -/* to check for overflow. */ - - if (oldsym) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - newsym = 0; - } else { - locval = sumai_(&tabptr[6], &locsym) + 1; - dimval = 0; - newsym = 1; - } - newval = *n - dimval; - -/* Can we do this without overflow? */ - - if (nsym + newsym > sizec_(tabsym, tabsym_len)) { - setmsg_("SYPUTC: Addition of the new symbol # causes an overflow in " - "the name table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr + newsym > sizei_(tabptr)) { - setmsg_("SYPUTC: Addition of the new symbol # causes an overflow in " - "the pointer table.", (ftnlen)77); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval + newval > sizec_(tabval, tabval_len)) { - setmsg_("SYPUTC: Addition of the new symbol # causes an overflow in " - "the value table.", (ftnlen)75); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* Looks like we can. */ - - } else { - -/* If the symbol exists, remove the current contents and */ -/* change the dimension. Otherwise add the new name and */ -/* dimension to the name and pointer tables. */ - - if (dimval > 0) { - remlac_(&dimval, &locval, tabval + tabval_len * 6, &nval, - tabval_len); - scardc_(&nval, tabval, tabval_len); - tabptr[locsym + 5] = *n; - } else { - i__1 = locsym + 1; - inslac_(name__, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - name_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym + 1; - inslai_(n, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } - -/* In either case, insert the values from the input array into */ -/* the value table. */ - - inslac_(values, n, &locval, tabval + tabval_len * 6, &nval, - values_len, tabval_len); - scardc_(&nval, tabval, tabval_len); - } - chkout_("SYPUTC", (ftnlen)6); - return 0; -} /* syputc_ */ - diff --git a/ext/spice/src/cspice/syputd.c b/ext/spice/src/cspice/syputd.c deleted file mode 100644 index dccd92ef01..0000000000 --- a/ext/spice/src/cspice/syputd.c +++ /dev/null @@ -1,361 +0,0 @@ -/* syputd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPUTD ( Set the values associated with a symbol ) */ -/* Subroutine */ int syputd_(char *name__, doublereal *values, integer *n, - char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, - ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *), cardi_( - integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sized_(doublereal *), sumai_( - integer *, integer *), sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardd_( - integer *, doublereal *), remlad_(integer *, integer *, - doublereal *, integer *), scardi_(integer *, integer *), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen), - inslad_(doublereal *, integer *, integer *, doublereal *, integer - *); - integer dimval; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - integer newsym; - -/* $ Abstract */ - -/* Set the values of a particular symbol in a double precision */ -/* symbol table. If the symbol already exists, the previous values */ -/* associated with it are removed, otherwise a new symbol is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be put into the symbol table. */ -/* VALUES I Values to be associated with the symbol NAME. */ -/* N I Number of values in VALUES. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated values are */ -/* to be set. If NAME has values associated with it, */ -/* they are removed, and the elements of VALUES become */ -/* the values associated with NAME. If NAME is not in the */ -/* symbol table, a new symbol is created, provided there */ -/* is room in the symbol table. */ - -/* VALUES are the new values associated with the symbol NAME. */ - -/* N is the number of elements in the VALUES array. */ -/* If N < 1, the symbol table is not modified. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* If NAME has values associated with it, they are */ -/* removed, and the elements of VALUES become the */ -/* values associated with NAME. If NAME is not in the */ -/* symbol table, a new symbol is created, provided */ -/* there is room in the symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of a new symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 2) If the addition of a new symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 3) If the addition of new values causes an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* 4) If N < 1, the error SPICE(INVALIDARGUMENT) is signalled. */ - -/* $ Particulars */ - -/* This subroutine is like SYSETC, but SYPUTC allows several values */ -/* to be associated with a symbol. ------- */ - -/* If NAME has values associated with it, they are removed, and */ -/* the elements of VALUES become the values associated with NAME. */ -/* If NAME is not in the symbol table, a new symbol is created, */ -/* provided there is room in the symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* If VALUES contains the elements, */ - -/* 3.17692D2 */ -/* 1.085D-1 */ -/* 1.000D-5 */ - -/* the call */ - -/* CALL SYPUTC ( 'BODY4_POLE_RA', VALUES, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 3.17692D2 */ -/* 1.085D-1 */ -/* 1.000D-5 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2C */ - -/* The call, */ - -/* CALL SYPUTC ( 'K', VALUES, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 3.17692D2 */ -/* 1.085D-1 */ -/* 1.000D-5 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 3.17692D2 */ -/* 1.085D-1 */ -/* 1.000D-5 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* Note that the previous values associated with "K" have been */ -/* replaced by the values in VALUES. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 06-AUG-1996 (WLT) */ - -/* Fixed the error in the abstract noticed by Ian Jordan */ -/* at the University of Maryland, College Park. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the values associated with a symbol */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused variable I removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPUTD", (ftnlen)6); - } - -/* Check to see if the number of values is a valid quantity. */ - - if (*n < 1) { - setmsg_("SYPUTD: The dimension of the values array isless than one.", - (ftnlen)58); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SYPUTD", (ftnlen)6); - return 0; - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardd_(tabval); - -/* Where does this symbol belong? is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If the new symbol already exists, we need to know its dimension */ -/* to check for overflow. */ - - if (oldsym) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - newsym = 0; - } else { - locval = sumai_(&tabptr[6], &locsym) + 1; - dimval = 0; - newsym = 1; - } - newval = *n - dimval; - -/* Can we do this without overflow? */ - - if (nsym + newsym > sizec_(tabsym, tabsym_len)) { - setmsg_("SYPUTD: Addition of the new symbol # causes an overflow in " - "the name table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr + newsym > sizei_(tabptr)) { - setmsg_("SYPUTD: Addition of the new symbol # causes an overflow in " - "the pointer table.", (ftnlen)77); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval + newval > sized_(tabval)) { - setmsg_("SYPUTD: Addition of the new symbol # causes an overflow in " - "the value table.", (ftnlen)75); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* Looks like we can. */ - - } else { - -/* If the symbol exists, remove the current contents and */ -/* change the dimension. Otherwise add the new name and */ -/* dimension to the name and pointer tables. */ - - if (dimval > 0) { - remlad_(&dimval, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - tabptr[locsym + 5] = *n; - } else { - i__1 = locsym + 1; - inslac_(name__, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - name_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym + 1; - inslai_(n, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } - -/* In either case, insert the values from the input array into */ -/* the value table. */ - - inslad_(values, n, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - } - chkout_("SYPUTD", (ftnlen)6); - return 0; -} /* syputd_ */ - diff --git a/ext/spice/src/cspice/syputi.c b/ext/spice/src/cspice/syputi.c deleted file mode 100644 index e7e3066215..0000000000 --- a/ext/spice/src/cspice/syputi.c +++ /dev/null @@ -1,352 +0,0 @@ -/* syputi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYPUTI ( Set the values associated with a symbol ) */ -/* Subroutine */ int syputi_(char *name__, integer *values, integer *n, char * - tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *), - sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardi_( - integer *, integer *), remlai_(integer *, integer *, integer *, - integer *), inslac_(char *, integer *, integer *, char *, integer - *, ftnlen, ftnlen); - integer dimval; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - integer newsym; - -/* $ Abstract */ - -/* Set the values of a particular symbol in an integer symbol table. */ -/* If the symbol already exists, the previous values associated with */ -/* it are removed, otherwise a new symbol is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be put into the symbol table. */ -/* VALUES I Values to be associated with the symbol NAME. */ -/* N I Number of values in VALUES. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated values are */ -/* to be set. If NAME has values associated with it, */ -/* they are removed, and the elements of VALUES become */ -/* the values associated with NAME. If NAME is not in the */ -/* symbol table, a new symbol is created, provided there */ -/* is room in the symbol table. */ - -/* VALUES are the new values associated with the symbol NAME. */ - -/* N is the number of elements in the VALUES array. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* If NAME has values associated with it, they are */ -/* removed, and the elements of VALUES become the */ -/* values associated with NAME. If NAME is not in the */ -/* symbol table, a new symbol is created, provided */ -/* there is room in the symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of a new symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 2) If the addition of a new symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 3) If the addition of new values causes an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* 4) If N < 1, the error SPICE(INVALIDARGUMENT) is signalled. */ - -/* $ Particulars */ - -/* This subroutine is like SYSETC, but SYPUTC allows several values */ -/* to be associated with a symbol. ------- */ - -/* If NAME has values associated with it, they are removed, and */ -/* the elements of VALUES become the values associated with NAME. */ -/* If NAME is not in the symbol table, a new symbol is created, */ -/* provided there is room in the symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 23 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* If VALUES contains the elements, */ - -/* 12 */ -/* 24 */ -/* 36 */ - -/* the call */ - -/* CALL SYPUTI ( 'desks', VALUES, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* desks --> 12 */ -/* 24 */ -/* 36 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 23 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ -/* The call, */ - -/* CALL SYPUTI ( 'pens', VALUES, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* desks --> 12 */ -/* 24 */ -/* 36 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 23 */ -/* pens --> 12 */ -/* 24 */ -/* 36 */ - -/* Note that the previous values associated with "pens" have been */ -/* replaced by the values in VALUES. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the values associated with a symbol */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused variable I removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYPUTI", (ftnlen)6); - } - -/* Check to see if the number of values is a valid quantity. */ - - if (*n < 1) { - setmsg_("SYPUTI: The dimension of the values array isless than one.", - (ftnlen)58); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("SYPUTI", (ftnlen)6); - return 0; - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardi_(tabval); - -/* Where does this symbol belong? is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If the new symbol already exists, we need to know its dimension */ -/* to check for overflow. */ - - if (oldsym) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - newsym = 0; - } else { - locval = sumai_(&tabptr[6], &locsym) + 1; - dimval = 0; - newsym = 1; - } - newval = *n - dimval; - -/* Can we do this without overflow? */ - - if (nsym + newsym > sizec_(tabsym, tabsym_len)) { - setmsg_("SYPUTI: Addition of the new symbol # causes an overflow in " - "the name table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr + newsym > sizei_(tabptr)) { - setmsg_("SYPUTI: Addition of the new symbol # causes an overflow in " - "the pointer table.", (ftnlen)77); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval + newval > sizei_(tabval)) { - setmsg_("SYPUTC: Addition of the new symbol # causes an overflow in " - "the value table.", (ftnlen)75); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* Looks like we can. */ - - } else { - -/* If the symbol exists, remove the current contents and */ -/* change the dimension. Otherwise add the new name and */ -/* dimension to the name and pointer tables. */ - - if (dimval > 0) { - remlai_(&dimval, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - tabptr[locsym + 5] = *n; - } else { - i__1 = locsym + 1; - inslac_(name__, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - name_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym + 1; - inslai_(n, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - } - -/* In either case, insert the values from the input array into */ -/* the value table. */ - - inslai_(values, n, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - } - chkout_("SYPUTI", (ftnlen)6); - return 0; -} /* syputi_ */ - diff --git a/ext/spice/src/cspice/syrenc.c b/ext/spice/src/cspice/syrenc.c deleted file mode 100644 index e6656d4036..0000000000 --- a/ext/spice/src/cspice/syrenc.c +++ /dev/null @@ -1,303 +0,0 @@ -/* syrenc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure SYRENC ( Rename an existing symbol ) */ -/* Subroutine */ int syrenc_(char *old, char *new__, char *tabsym, integer * - tabptr, char *tabval, ftnlen old_len, ftnlen new_len, ftnlen - tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer olddim, oldloc; - extern /* Subroutine */ int swapac_(integer *, integer *, integer *, - integer *, char *, ftnlen); - integer oldval; - extern /* Subroutine */ int sydelc_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), swapai_(integer *, integer *, integer *, - integer *, integer *); - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - integer newloc; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Rename an existing symbol in a character symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OLD I Name of the symbol to be renamed. */ -/* NEW I New name of the symbol. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* OLD is the name of the symbol to be renamed. If OLD is */ -/* not in the symbol table, the tables are not modified. */ - -/* NEW is the new name of the symbol. If the symbol NEW */ -/* already exists in the symbol table, it is deleted. */ -/* OLD is then renamed to NEW. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the character symbol table. */ -/* The values previously associated with OLD are now */ -/* associated with NEW. If OLD is not in the symbol */ -/* table, the symbol tables are not modified. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* If the symbol OLD is not in the symbol table, the error */ -/* SPICE(NOSUCHSYMBOL) is signalled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* HAHN --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ - -/* The call, */ - -/* CALL SYRENC ( 'FERMI', 'STRASSMAN', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* HAHN --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ -/* STRASSMAN --> NUCLEAR FISSION */ - - -/* The next call, */ - -/* CALL SYRENC ( 'HAHN', 'STRASSMAN', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ -/* HAHN --> NUCLEAR FISSION */ - -/* Note that the symbol "STRASSMAN" was deleted from the table, */ -/* and the symbol "HAHN" was then renamed to "STRASSMAN". If the */ -/* new symbol exists, it is deleted from the table before its name */ -/* is given to another symbol. */ - - -/* The next call, */ - -/* CALL SYRENC ( 'FERMI', 'HAHN', TABSYM, TABPTR, TABVAL ) */ - -/* does not modify the contents of the symbol table. It signals */ -/* the error SPICE(NOSUCHSYMBOL) because the symbol "FERMI" does */ -/* not exist in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* rename an existing symbol */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 28-DEC-1989 (HAN) */ - -/* Changed the call to SYDELD to a call to SYDELC. The variable */ -/* TABVAL of type character was being passed to a dummy argument */ -/* of type double precision. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused function SIZEC removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYRENC", (ftnlen)6); - } - -/* Where was the old symbol? */ - - nsym = cardc_(tabsym, tabsym_len); - oldloc = bsrchc_(old, &nsym, tabsym + tabsym_len * 6, old_len, tabsym_len) - ; - -/* An overflow is simply not possible here. The only thing that can */ -/* go wrong is that the old symbol does not exist. */ - - if (oldloc == 0) { - setmsg_("SYRENC: The symbol # is not in the symbol table.", (ftnlen) - 48); - errch_("#", old, (ftnlen)1, old_len); - sigerr_("SPICE(NOSUCHSYMBOL)", (ftnlen)19); - -/* Are these the same symbol? */ - - } else if (s_cmp(new__, old, new_len, old_len) != 0) { - -/* If the new symbol already exists, delete it. */ - - sydelc_(new__, tabsym, tabptr, tabval, new_len, tabsym_len, - tabval_len); - nsym = cardc_(tabsym, tabsym_len); - oldloc = bsrchc_(old, &nsym, tabsym + tabsym_len * 6, old_len, - tabsym_len); - -/* Swap N elements at the old location with zero elements */ -/* at the new location. */ - - newloc = lstlec_(new__, &nsym, tabsym + tabsym_len * 6, new_len, - tabsym_len) + 1; - i__1 = oldloc - 1; - oldval = sumai_(&tabptr[6], &i__1) + 1; - i__1 = newloc - 1; - newval = sumai_(&tabptr[6], &i__1) + 1; - olddim = tabptr[oldloc + 5]; - swapac_(&olddim, &oldval, &c__0, &newval, tabval + tabval_len * 6, - tabval_len); - -/* Move the name and dimension the same way. */ - - swapac_(&c__1, &oldloc, &c__0, &newloc, tabsym + tabsym_len * 6, - tabsym_len); - swapai_(&c__1, &oldloc, &c__0, &newloc, &tabptr[6]); - if (oldloc < newloc) { - --newloc; - } - s_copy(tabsym + (newloc + 5) * tabsym_len, new__, tabsym_len, new_len) - ; - } - chkout_("SYRENC", (ftnlen)6); - return 0; -} /* syrenc_ */ - diff --git a/ext/spice/src/cspice/syrend.c b/ext/spice/src/cspice/syrend.c deleted file mode 100644 index 2e0b47a3ca..0000000000 --- a/ext/spice/src/cspice/syrend.c +++ /dev/null @@ -1,300 +0,0 @@ -/* syrend.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure SYREND ( Rename an existing symbol ) */ -/* Subroutine */ int syrend_(char *old, char *new__, char *tabsym, integer * - tabptr, doublereal *tabval, ftnlen old_len, ftnlen new_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer olddim, oldloc; - extern /* Subroutine */ int swapac_(integer *, integer *, integer *, - integer *, char *, ftnlen), swapad_(integer *, integer *, integer - *, integer *, doublereal *); - integer oldval; - extern /* Subroutine */ int sydeld_(char *, char *, integer *, doublereal - *, ftnlen, ftnlen), swapai_(integer *, integer *, integer *, - integer *, integer *); - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - integer newloc; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Rename an existing symbol in a double precision symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OLD I Name of the symbol to be renamed. */ -/* NEW I New name of the symbol. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* OLD is the name of the symbol to be renamed. If OLD is */ -/* not in the symbol table, the tables are not modified. */ - -/* NEW is the new name of the symbol. If the symbol NEW */ -/* already exists in the symbol table, it is deleted. */ -/* OLD is then renamed to NEW. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the double precision symbol table. */ -/* The values previously associated with OLD are now */ -/* associated with NEW. If OLD is not in the symbol */ -/* table, the symbol tables are not modified. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* If the symbol OLD is not in the symbol table, the error */ -/* SPICE(NOSUCHSYMBOL) is signalled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - - -/* The call, */ - -/* CALL SYREND ( 'K', 'EB', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* EB --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ -/* 1.08D-1 */ -/* 0.0D0 */ - -/* The next call, */ - -/* CALL SYREND ( 'EB', 'DELTA_T_A', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the table to be: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ -/* 1.08D-1 */ -/* 0.0D0 */ - -/* Note that the symbol "DELTA_T_A" was deleted from the table, */ -/* and the symbol "EB" was then renamed to "DELTA_T_A". If the */ -/* new symbol exists, it is deleted from the table before its name */ -/* is given to another symbol. */ - - -/* The next call, */ - -/* CALL SYREND ( 'K', 'EB', TABSYM, TABPTR, TABVAL ) */ - -/* does not modify the contents of the symbol table. It signals */ -/* the error SPICE(NOSUCHSYMBOL) because the symbol "K" does not */ -/* exist in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* rename an existing symbol */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused function SIZEC removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYREND", (ftnlen)6); - } - -/* Where was the old symbol? */ - - nsym = cardc_(tabsym, tabsym_len); - oldloc = bsrchc_(old, &nsym, tabsym + tabsym_len * 6, old_len, tabsym_len) - ; - -/* An overflow is simply not possible here. The only thing that can */ -/* go wrong is that the old symbol does not exist. */ - - if (oldloc == 0) { - setmsg_("SYREND: The symbol # is not in the symbol table.", (ftnlen) - 48); - errch_("#", old, (ftnlen)1, old_len); - sigerr_("SPICE(NOSUCHSYMBOL)", (ftnlen)19); - -/* Are these the same symbol? */ - - } else if (s_cmp(new__, old, new_len, old_len) != 0) { - -/* If the new symbol already exists, delete it. */ - - sydeld_(new__, tabsym, tabptr, tabval, new_len, tabsym_len); - nsym = cardc_(tabsym, tabsym_len); - oldloc = bsrchc_(old, &nsym, tabsym + tabsym_len * 6, old_len, - tabsym_len); - -/* Swap N elements at the old location with zero elements */ -/* at the new location. */ - - newloc = lstlec_(new__, &nsym, tabsym + tabsym_len * 6, new_len, - tabsym_len) + 1; - i__1 = oldloc - 1; - oldval = sumai_(&tabptr[6], &i__1) + 1; - i__1 = newloc - 1; - newval = sumai_(&tabptr[6], &i__1) + 1; - olddim = tabptr[oldloc + 5]; - swapad_(&olddim, &oldval, &c__0, &newval, &tabval[6]); - -/* Move the name and dimension the same way. */ - - swapac_(&c__1, &oldloc, &c__0, &newloc, tabsym + tabsym_len * 6, - tabsym_len); - swapai_(&c__1, &oldloc, &c__0, &newloc, &tabptr[6]); - if (oldloc < newloc) { - --newloc; - } - s_copy(tabsym + (newloc + 5) * tabsym_len, new__, tabsym_len, new_len) - ; - } - chkout_("SYREND", (ftnlen)6); - return 0; -} /* syrend_ */ - diff --git a/ext/spice/src/cspice/syreni.c b/ext/spice/src/cspice/syreni.c deleted file mode 100644 index 83e9aefa8d..0000000000 --- a/ext/spice/src/cspice/syreni.c +++ /dev/null @@ -1,299 +0,0 @@ -/* syreni.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure SYRENI ( Rename an existing symbol ) */ -/* Subroutine */ int syreni_(char *old, char *new__, char *tabsym, integer * - tabptr, integer *tabval, ftnlen old_len, ftnlen new_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer olddim, oldloc; - extern /* Subroutine */ int swapac_(integer *, integer *, integer *, - integer *, char *, ftnlen); - integer oldval; - extern /* Subroutine */ int swapai_(integer *, integer *, integer *, - integer *, integer *); - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - integer newloc; - extern /* Subroutine */ int sydeli_(char *, char *, integer *, integer *, - ftnlen, ftnlen), sigerr_(char *, ftnlen); - integer newval; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Rename an existing symbol in an integer symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OLD I Name of the symbol to be renamed. */ -/* NEW I New name of the symbol. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* OLD is the name of the symbol to be renamed. If OLD is */ -/* not in the symbol table, the tables are not modified. */ - -/* NEW is the new name of the symbol. If the symbol NEW */ -/* already exists in the symbol table, it is deleted. */ -/* OLD is then renamed to NEW. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the integer symbol table. */ -/* The values previously associated with OLD are now */ -/* associated with NEW. If OLD is not in the symbol */ -/* table, the symbol tables are not modified. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* If the symbol OLD is not in the symbol table, the error */ -/* SPICE(NOSUCHSYMBOL) is signalled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* 10 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 18 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The call, */ - -/* CALL SYRENI ( 'pens', 'desks', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* 10 */ -/* desks --> 10 */ -/* 12 */ -/* 24 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 18 */ - - -/* The next call, */ - -/* CALL SYRENI ( 'erasers', 'desks', TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents fo the symbol table to be: */ - -/* books --> 5 */ -/* 10 */ -/* desks --> 6 */ -/* pencils --> 12 */ -/* 18 */ - -/* Note that the symbol "desks" was deleted from the table, */ -/* and the symbol "erasers" was then renamed to "STRASSMAN". If the */ -/* new symbol exists, it is deleted from the table before its name */ -/* is given to another symbol. */ - - -/* The next call, */ - -/* CALL SYRENI ( 'chairs', 'stools', TABSYM, TABPTR, TABVAL ) */ - -/* does not modify the contents of the symbol table. However, it */ -/* does signal the error SPICE(NOSUCHSYMBOL) because the symbol */ -/* "chairs" does not exist in the symbol table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* rename an existing symbol */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 28-DEC-1989 (HAN) */ - -/* Changed the call to SYDELD to a call to SYDELI. The variable */ -/* TABVAL of type character was being passed to a dummy argument */ -/* of type double precision. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */ - -/* Declaration of the unused function SIZEC removed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYRENI", (ftnlen)6); - } - -/* Where was the old symbol? */ - - nsym = cardc_(tabsym, tabsym_len); - oldloc = bsrchc_(old, &nsym, tabsym + tabsym_len * 6, old_len, tabsym_len) - ; - -/* An overflow is simply not possible here. The only thing that can */ -/* go wrong is that the old symbol does not exist. */ - - if (oldloc == 0) { - setmsg_("SYRENI: The symbol # is not in the symbol table.", (ftnlen) - 48); - errch_("#", old, (ftnlen)1, old_len); - sigerr_("SPICE(NOSUCHSYMBOL)", (ftnlen)19); - -/* Are these the same symbol? */ - - } else if (s_cmp(new__, old, new_len, old_len) != 0) { - -/* If the new symbol already exists, delete it. */ - - sydeli_(new__, tabsym, tabptr, tabval, new_len, tabsym_len); - nsym = cardc_(tabsym, tabsym_len); - oldloc = bsrchc_(old, &nsym, tabsym + tabsym_len * 6, old_len, - tabsym_len); - -/* Swap N elements at the old location with zero elements */ -/* at the new location. */ - - newloc = lstlec_(new__, &nsym, tabsym + tabsym_len * 6, new_len, - tabsym_len) + 1; - i__1 = oldloc - 1; - oldval = sumai_(&tabptr[6], &i__1) + 1; - i__1 = newloc - 1; - newval = sumai_(&tabptr[6], &i__1) + 1; - olddim = tabptr[oldloc + 5]; - swapai_(&olddim, &oldval, &c__0, &newval, &tabval[6]); - -/* Move the name and dimension the same way. */ - - swapac_(&c__1, &oldloc, &c__0, &newloc, tabsym + tabsym_len * 6, - tabsym_len); - swapai_(&c__1, &oldloc, &c__0, &newloc, &tabptr[6]); - if (oldloc < newloc) { - --newloc; - } - s_copy(tabsym + (newloc + 5) * tabsym_len, new__, tabsym_len, new_len) - ; - } - chkout_("SYRENI", (ftnlen)6); - return 0; -} /* syreni_ */ - diff --git a/ext/spice/src/cspice/syselc.c b/ext/spice/src/cspice/syselc.c deleted file mode 100644 index 3e717abb6c..0000000000 --- a/ext/spice/src/cspice/syselc.c +++ /dev/null @@ -1,275 +0,0 @@ -/* syselc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYSELC ( Select a subset of the values of a symbol ) */ -/* Subroutine */ int syselc_(char *name__, integer *begin, integer *end, char - *tabsym, integer *tabptr, char *tabval, char *values, logical *found, - ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen - values_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen), movec_(char *, - integer *, char *, ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Select a subset of the values associated with a particular */ -/* symbol in a character symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be returned. */ -/* BEGIN I Index of the first associated value to be returned. */ -/* END I Index of the last associated value to be returned. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* VALUES O Subset of the values associated with the symbol */ -/* NAME. */ -/* FOUND O True if the subset of values exists. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose subset of associated */ -/* values to be returned. If NAME is not in the symbol */ -/* table, FOUND is false. */ - -/* BEGIN is the index of the first associated value to be */ -/* returned. If BEGIN is out of range (BEGIN < 1 or */ -/* BEGIN > END) FOUND is false. */ - -/* END is the index of the last associated value to be */ -/* returned. If END is out of range (END < 1 or */ -/* END > is greater than the dimension of NAME) */ -/* FOUND is false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the character symbol table. */ - -/* $ Detailed_Output */ - -/* VALUES is a subset of the values associated with the */ -/* symbol NAME. If the subset specified by BEGIN and */ -/* END exists, as many values as will fit in VALUES */ -/* are returned. If the subset does not exist, no */ -/* values are returned and FOUND is false. */ - -/* FOUND is true if the subset of values is exists. */ -/* FOUND is false if BEGIN < 1, BEGIN > END, END < 1, */ -/* END > the dimension of NAME, or NAME is not */ -/* in the symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This subroutine does not check to see if the output array */ -/* VALUES is large enough to hold the selected set of values. */ -/* The caller must provide the required space. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* FOUND will be false if the bounds of the subset specified by */ -/* BEGIN and END are out of range. Values of BEGIN and END that */ -/* specify bounds out of range are BEGIN < 1, BEGIN > END, */ -/* END < 1, or END > the dimension of NAME. FOUND is also false */ -/* if the symbol NAME is not in the symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* GENERAL RELATIVITY */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ - -/* Let the dimension of the array VALUES be 4. */ - - -/* The ouput values of VALUES and FOUND for the input values of */ -/* NAME, BEGIN, and END are contained in this table: */ - -/* NAME BEGIN END VALUES FOUND */ -/* ----------- ----- --- --------------------- ------- */ -/* EINSTEIN 2 3 PHOTOELECTRIC EFFECT TRUE */ -/* BROWNIAN MOTION */ - -/* EINSTEIN 1 4 SPECIAL RELATIVITY TRUE */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* GENERAL RELATIVITY */ - -/* MAXWELL 1 5 FALSE */ - -/* PAULI 2 1 FALSE */ - -/* PAULI 1 -2 FALSE */ - -/* BOHR 1 5 FALSE */ -/* ---------------------------------------------------------------- */ - - -/* Note that FOUND is FALSE for examples 3 through 6 because: */ - -/* - In the 3rd example, the symbol 'MAXWELL' is not in the symbol */ -/* table. */ - -/* - In the 4th example, BEGIN > END. */ - -/* - In the 5th example, END < 0. */ - -/* - In the 6th example, END is greater than the dimension of the */ -/* symbol 'BOHR'. */ - -/* $ Restrictions */ - -/* 1) See Exceptions section. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */ - -/* Various header corrections were made. In particular, */ -/* the header no longer asserts that this routine will */ -/* "return as many values as will fit" in the output array */ -/* VALUES. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* select a subset of the values of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYSELC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - } else { - -/* We could still have a problem: do these components exist? */ -/* Does this request even make sense? */ - - n = tabptr[locsym + 5]; - if (*begin >= 1 && *begin <= n && *end >= 1 && *end <= n && *begin <= - *end) { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - i__1 = *end - *begin + 1; - movec_(tabval + (locval + *begin + 4) * tabval_len, &i__1, values, - tabval_len, values_len); - } else { - *found = FALSE_; - } - } - chkout_("SYSELC", (ftnlen)6); - return 0; -} /* syselc_ */ - diff --git a/ext/spice/src/cspice/syseld.c b/ext/spice/src/cspice/syseld.c deleted file mode 100644 index d2930cb128..0000000000 --- a/ext/spice/src/cspice/syseld.c +++ /dev/null @@ -1,271 +0,0 @@ -/* syseld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYSELD ( Select a subset of the values of a symbol ) */ -/* Subroutine */ int syseld_(char *name__, integer *begin, integer *end, char - *tabsym, integer *tabptr, doublereal *tabval, doublereal *values, - logical *found, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Select a subset of the values associated with a particular */ -/* symbol in a double precision symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be returned. */ -/* BEGIN I Index of the first associated value to be returned. */ -/* END I Index of the last associated value to be returned. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* VALUES O Subset of the values associated with the symbol */ -/* NAME. */ -/* FOUND O True if the subset of values exists. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose subset of associated */ -/* values to be returned. If NAME is not in the symbol */ -/* table, FOUND is false. */ - -/* BEGIN is the index of the first associated value to be */ -/* returned. If BEGIN is out of range (BEGIN < 1 or */ -/* BEGIN > END) FOUND is false. */ - -/* END is the index of the last associated value to be */ -/* returned. If END is out of range (END < 1 or */ -/* END > is greater than the dimension of NAME) */ -/* FOUND is false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the double precision symbol table. */ - -/* $ Detailed_Output */ - -/* VALUES is a subset of the values associated with the */ -/* symbol NAME. If the subset specified by BEGIN and */ -/* END exists, as many values as will fit in VALUES */ -/* are returned. If the subset does not exist, no */ -/* values are returned and FOUND is false. */ - -/* FOUND is true if the subset of values is exists. */ -/* FOUND is false if BEGIN < 1, BEGIN > END, END < 1, */ -/* END > the dimension of NAME, or NAME is not */ -/* in the symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This subroutine does not check to see if the output array */ -/* VALUES is large enough to hold the selected set of values. */ -/* The caller must provide the required space. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* FOUND will be false if the bounds of the subset specified by */ -/* BEGIN and END are out of range. Values of BEGIN and END which */ -/* specify bounds out of range are BEGIN < 1, BEGIN > END, */ -/* END < 1, or END > the dimension of NAME. FOUND is also false */ -/* if the symbol NAME is not in the symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* Let the dimension of the array VALUES be 3. */ - - -/* The ouput values of VALUES and FOUND for the input values of */ -/* NAME, BEGIN, and END are contained in this table: */ - -/* NAME BEGIN END VALUES FOUND */ -/* ------------- ----- --- --------------------- ------- */ -/* MEAN_ANOM 1 2 6.239996D0 TRUE */ -/* 1.99096871D-7 */ - -/* BODY4_POLE_RA 1 3 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ - -/* BODY4_PRIME 1 3 FALSE */ - -/* MEAN_ANOM 2 1 FALSE */ - -/* ORBIT_ECC 1 -2 FALSE */ - -/* K 1 5 FALSE */ -/* ---------------------------------------------------------------- */ - -/* Note that FOUND is FALSE for examples 3 through 6 because: */ - -/* - In the 3rd example, the symbol 'BODY4_PRIME' is not in the */ -/* symbol table. */ - -/* - In the 4th example, BEGIN > END. */ - -/* - In the 5th example, END < 0. */ - -/* - In the 6th example, END is greater than the dimension of the */ -/* symbol 'K'. */ - -/* $ Restrictions */ - -/* 1) See Exceptions section. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */ - -/* Various header corrections were made. In particular, */ -/* the header no longer asserts that this routine will */ -/* "return as many values as will fit" in the output array */ -/* VALUES. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* select a subset of the values of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYSELD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - } else { - -/* We could still have a problem: do these components exist? */ -/* Does this request even make sense? */ - - n = tabptr[locsym + 5]; - if (*begin >= 1 && *begin <= n && *end >= 1 && *end <= n && *begin <= - *end) { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - i__1 = *end - *begin + 1; - moved_(&tabval[locval + *begin + 4], &i__1, values); - } else { - *found = FALSE_; - } - } - chkout_("SYSELD", (ftnlen)6); - return 0; -} /* syseld_ */ - diff --git a/ext/spice/src/cspice/syseli.c b/ext/spice/src/cspice/syseli.c deleted file mode 100644 index df83ccf1b8..0000000000 --- a/ext/spice/src/cspice/syseli.c +++ /dev/null @@ -1,273 +0,0 @@ -/* syseli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYSELI ( Select a subset of the values of a symbol ) */ -/* Subroutine */ int syseli_(char *name__, integer *begin, integer *end, char - *tabsym, integer *tabptr, integer *tabval, integer *values, logical * - found, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Select a subset of the values associated with a particular */ -/* symbol in an integer symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be returned. */ -/* BEGIN I Index of the first associated value to be returned. */ -/* END I Index of the last associated value to be returned. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I Components of the symbol table. */ - -/* VALUES O Subset of the values associated with the symbol */ -/* NAME. */ -/* FOUND O True if the subset of values exists. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose subset of associated */ -/* values to be returned. If NAME is not in the symbol */ -/* table, FOUND is false. */ - -/* BEGIN is the index of the first associated value to be */ -/* returned. If BEGIN is out of range (BEGIN < 1 or */ -/* BEGIN > END) FOUND is false. */ - -/* END is the index of the last associated value to be */ -/* returned. If END is out of range (END < 1 or */ -/* END > is greater than the dimension of NAME) */ -/* FOUND is false. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the integer symbol table. */ - -/* $ Detailed_Output */ - -/* VALUES is a subset of the values associated with the */ -/* symbol NAME. If the subset specified by BEGIN and */ -/* END exists, as many values as will fit in VALUES */ -/* are returned. If the subset does not exist, no */ -/* values are returned and FOUND is false. */ - -/* FOUND is true if the subset of values is exists. */ -/* FOUND is false if BEGIN < 1, BEGIN > END, END < 1, */ -/* END > the dimension of NAME, or NAME is not */ -/* in the symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This subroutine does not check to see if the output array */ -/* VALUES is large enough to hold the selected set of values. */ -/* The caller must provide the required space. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* FOUND will be false if the bounds of the subset specified by */ -/* BEGIN and END are out of range. Values of BEGIN and END which */ -/* specify bounds out of range are BEGIN < 1, BEGIN > END, */ -/* END < 1, or END > the dimension of NAME. FOUND is also false */ -/* if the symbol NAME is not in the symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* 10 */ -/* erasers --> 3 */ -/* pencils --> 12 */ -/* 18 */ -/* 24 */ -/* 30 */ -/* pens --> 10 */ -/* 20 */ -/* 30 */ - -/* Let the dimension of the array VALUES be 4. */ - -/* The ouput values of VALUES and FOUND for the input values of */ -/* NAME, BEGIN, and END are contained in this table: */ - -/* NAME BEGIN END VALUES FOUND */ -/* ---------- ----- --- -------- ------- */ -/* pencils 2 3 18 TRUE */ -/* 24 */ - -/* pencils 1 4 12 TRUE */ -/* 18 */ -/* 24 */ -/* 30 */ - -/* desks 1 5 FALSE */ - -/* books 2 1 FALSE */ - -/* erasers 1 -2 FALSE */ - -/* pens 1 5 FALSE */ -/* ---------------------------------------------------------------- */ - -/* Note that FOUND is FALSE for examples 3 through 6 because: */ - -/* - In the 3rd example, the symbol 'desks' is not in the */ -/* symbol table. */ - -/* - In the 4th example, BEGIN > END. */ - -/* - In the 5th example, END < 0. */ - -/* - In the 6th example, END is greater than the dimension of the */ -/* symbol 'pens'. */ - -/* $ Restrictions */ - -/* 1) See Exceptions section. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */ - -/* Various header corrections were made. In particular, */ -/* the header no longer asserts that this routine will */ -/* "return as many values as will fit" in the output array */ -/* VALUES. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* select a subset of the values of a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYSELI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - -/* If it's not in the table, it's definitely a problem. */ - - if (locsym == 0) { - *found = FALSE_; - } else { - -/* We could still have a problem: do these components exist? */ -/* Does this request even make sense? */ - - n = tabptr[locsym + 5]; - if (*begin >= 1 && *begin <= n && *end >= 1 && *end <= n && *begin <= - *end) { - *found = TRUE_; - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - i__1 = *end - *begin + 1; - movei_(&tabval[locval + *begin + 4], &i__1, values); - } else { - *found = FALSE_; - } - } - chkout_("SYSELI", (ftnlen)6); - return 0; -} /* syseli_ */ - diff --git a/ext/spice/src/cspice/sysetc.c b/ext/spice/src/cspice/sysetc.c deleted file mode 100644 index 96355cc052..0000000000 --- a/ext/spice/src/cspice/sysetc.c +++ /dev/null @@ -1,312 +0,0 @@ -/* sysetc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYSETC ( Set the value associated with a symbol ) */ -/* Subroutine */ int sysetc_(char *name__, char *value, char *tabsym, integer - *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen - tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *), - sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_( - integer *, integer *, char *, integer *, ftnlen), scardi_(integer - *, integer *), inslac_(char *, integer *, integer *, char *, - integer *, ftnlen, ftnlen); - integer dimval; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Set the value of a particular symbol in a character symbol table. */ -/* If the symbol already exists, the previous values associated with */ -/* it are removed, otherwise a new symbol is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated value is to be */ -/* set. */ -/* VALUE I Associated value of the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated value is to */ -/* be set. If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* VALUE is the new value associated with the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a character symbol table. */ -/* If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of a new symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 2) If the addition of a new symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 3) If the addition of a new symbolcauses an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ - -/* The call, */ - -/* CALL SYSETC ( 'EINSTEIN', 'GENERAL RELATIVITY', */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> GENERAL RELATIVITY */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ - -/* Note that the previous values associated with the symbol */ -/* "EINSTEIN" have been deleted, and now only the new value is */ -/* associated with the symbol. */ - - -/* The next call, */ - -/* CALL SYSETC ( 'MILLIKAN', 'PHOTOELECTRIC EFFECT' */ -/* . TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> GENERAL RELATIVITY */ -/* FERMI --> NUCLEAR FISSION */ -/* MILLIKAN --> PHOTOELECTRIC EFFECT */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINOC */ - -/* Note that the new symbol "MILLIKAN" was created by the last call. */ -/* A new symbol is created only if there is room in the symbol */ -/* table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the value associated with a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYSETC", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardc_(tabval, tabval_len); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's already in the table, there's no chance of overflow. */ -/* Leave the name where it is. Remove all but one of the existing */ -/* values, replacing that with the new value. And set the dimension */ -/* to one. */ - - if (oldsym) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - if (dimval > 1) { - i__1 = dimval - 1; - remlac_(&i__1, &locval, tabval + tabval_len * 6, &nval, - tabval_len); - scardc_(&nval, tabval, tabval_len); - } - tabptr[locsym + 5] = 1; - s_copy(tabval + (locval + 5) * tabval_len, value, tabval_len, - value_len); - -/* Otherwise, we can't proceed unless we know that we have enough */ -/* room for one extra addition in all three tables. */ - - } else if (nsym >= sizec_(tabsym, tabsym_len)) { - setmsg_("SYSETC: Addition of the new symbol # causes an overflow in " - "the name table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr >= sizei_(tabptr)) { - setmsg_("SYSETC: Addition of the new symbol # causes an overflow in " - "the pointer table.", (ftnlen)77); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval >= sizec_(tabval, tabval_len)) { - setmsg_("SYSETC: Addition of the new symbol # causes an overflow in" - " the value table.", (ftnlen)76); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new name to the name table. Give the */ -/* symbol dimension one, and put the value in the right place. */ - - } else { - i__1 = locsym + 1; - inslac_(name__, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - name_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym + 1; - inslai_(&c__1, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - locval = sumai_(&tabptr[6], &locsym) + 1; - inslac_(value, &c__1, &locval, tabval + tabval_len * 6, &nval, - value_len, tabval_len); - scardc_(&nval, tabval, tabval_len); - } - chkout_("SYSETC", (ftnlen)6); - return 0; -} /* sysetc_ */ - diff --git a/ext/spice/src/cspice/sysetd.c b/ext/spice/src/cspice/sysetd.c deleted file mode 100644 index 984b92218f..0000000000 --- a/ext/spice/src/cspice/sysetd.c +++ /dev/null @@ -1,307 +0,0 @@ -/* sysetd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYSETD ( Set the value associated with a symbol ) */ -/* Subroutine */ int sysetd_(char *name__, doublereal *value, char *tabsym, - integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardd_(doublereal *), cardi_( - integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sized_(doublereal *), sumai_( - integer *, integer *), sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardd_( - integer *, doublereal *), remlad_(integer *, integer *, - doublereal *, integer *), scardi_(integer *, integer *), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen), - inslad_(doublereal *, integer *, integer *, doublereal *, integer - *); - integer dimval; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Set the value of a particular symbol in a double precision symbol */ -/* table. If the symbol already exists, the previous values */ -/* associated with it are removed, otherwise a new symbol is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated value is to be */ -/* set. */ -/* VALUE I Associated value of the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated value is to */ -/* be set. If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* VALUE is the new value associated with the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol table. */ -/* If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of a new symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 2) If the addition of a new symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 3) If the addition of a new symbolcauses an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The call, */ - -/* CALL SYSETD ( 'ORBIT_ECC', 1.67125D-2, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.67125D-2 */ - -/* Note that the previous value associated with the symbol */ -/* "ORBIT_ECC" has been deleted, and now the value 1.67125D-2 */ -/* is associated with the symbol. */ - - -/* The next call, */ - -/* CALL SYSETD ( 'EB', 1.671D-2, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* DELTA_T_A --> 3.2184D1 */ -/* EB --> 1.671D-2 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.67125D-2 */ - -/* Note that the new symbol "EB" was created by the last call. */ -/* A new symbol is created only if there is room in the symbol */ -/* table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the value associated with a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYSETD", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardd_(tabval); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's already in the table, there's no chance of overflow. */ -/* Leave the name where it is. Remove all but one of the existing */ -/* values, replacing that with the new value. And set the dimension */ -/* to one. */ - - if (oldsym) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - if (dimval > 1) { - i__1 = dimval - 1; - remlad_(&i__1, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - } - tabptr[locsym + 5] = 1; - tabval[locval + 5] = *value; - -/* Otherwise, we can't proceed unless we know that we have enough */ -/* room for one extra addition in all three tables. */ - - } else if (nsym >= sizec_(tabsym, tabsym_len)) { - setmsg_("SYSETD: Addition of the new symbol # causes an overflow in " - "the name table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr >= sizei_(tabptr)) { - setmsg_("SYSETD: Addition of the new symbol # causes an overflow in " - "the pointer table.", (ftnlen)77); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval >= sized_(tabval)) { - setmsg_("SYSETD: Addition of the new symbol # causes an overflow in " - "the value table.", (ftnlen)75); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new name to the name table. Give the */ -/* symbol dimension one, and put the value in the right place. */ - - } else { - i__1 = locsym + 1; - inslac_(name__, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - name_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym + 1; - inslai_(&c__1, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - locval = sumai_(&tabptr[6], &locsym) + 1; - inslad_(value, &c__1, &locval, &tabval[6], &nval); - scardd_(&nval, tabval); - } - chkout_("SYSETD", (ftnlen)6); - return 0; -} /* sysetd_ */ - diff --git a/ext/spice/src/cspice/syseti.c b/ext/spice/src/cspice/syseti.c deleted file mode 100644 index d6ee44a597..0000000000 --- a/ext/spice/src/cspice/syseti.c +++ /dev/null @@ -1,305 +0,0 @@ -/* syseti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SYSETI ( Set the value associated with a symbol ) */ -/* Subroutine */ int syseti_(char *name__, integer *value, char *tabsym, - integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nval, nptr, nsym; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer sizec_(char *, ftnlen), sumai_(integer *, integer *), - sizei_(integer *); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardi_( - integer *, integer *), remlai_(integer *, integer *, integer *, - integer *), inslac_(char *, integer *, integer *, char *, integer - *, ftnlen, ftnlen); - integer dimval; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - integer locval; - extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer locsym; - logical oldsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Set the value of a particular symbol in an integer symbol table. */ -/* If the symbol already exists, the previous values associated with */ -/* it are removed, otherwise a new symbol is created. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated value is to be */ -/* set. */ -/* VALUE I Associated value of the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated value is to */ -/* be set. If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* VALUE is the new value associated with the symbol NAME. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of an integer symbol table. */ -/* If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the addition of a new symbol causes an overflow in the */ -/* name table, the error SPICE(NAMETABLEFULL) is signalled. */ - -/* 2) If the addition of a new symbol causes an overflow in the */ -/* pointer table, the error SPICE(POINTERTABLEFULL) is signalled. */ - -/* 3) If the addition of a new symbolcauses an overflow in the */ -/* value table, the error SPICE(VALUETABLEFULL) is signalled. */ - -/* $ Particulars */ - -/* If NAME has values associated with it, they are */ -/* removed, and VALUE becomes the only value associated */ -/* with NAME. If NAME is not in the symbol table, a new */ -/* symbol is created, provided there is room in the */ -/* symbol table. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 15 */ -/* pens --> 10 */ -/* 12 */ -/* 24 */ - -/* The call, */ - -/* CALL SYSETI ( 'pens', 36, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 15 */ -/* pens --> 36 */ - -/* Note that the previous values associated with the symbol */ -/* "pens" have been deleted, and now only the new value is */ -/* associated with the symbol. */ - - -/* The next call, */ - -/* CALL SYSETI ( 'desks', 31, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* desks --> 31 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 15 */ -/* pens --> 36 */ - -/* Note that the new symbol "desks" was created by the last call. */ -/* A new symbol is created only if there is room in the symbol */ -/* table. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* set the value associated with a symbol */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYSETI", (ftnlen)6); - } - -/* How many symbols to start with? */ - - nsym = cardc_(tabsym, tabsym_len); - nptr = cardi_(tabptr); - nval = cardi_(tabval); - -/* Where does this symbol belong? Is it already in the table? */ - - locsym = lstlec_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - oldsym = locsym != 0 && s_cmp(tabsym + (locsym + 5) * tabsym_len, name__, - tabsym_len, name_len) == 0; - -/* If it's already in the table, there's no chance of overflow. */ -/* Leave the name where it is. Remove all but one of the existing */ -/* values, replacing that with the new value. And set the dimension */ -/* to one. */ - - if (oldsym) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - dimval = tabptr[locsym + 5]; - if (dimval > 1) { - i__1 = dimval - 1; - remlai_(&i__1, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - } - tabptr[locsym + 5] = 1; - tabval[locval + 5] = *value; - -/* Otherwise, we can't proceed unless we know that we have enough */ -/* room for one extra addition in all three tables. */ - - } else if (nsym >= sizec_(tabsym, tabsym_len)) { - setmsg_("SYSETI: Addition of the new symbol # causes an overflow in " - "the name table.", (ftnlen)74); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(NAMETABLEFULL)", (ftnlen)20); - } else if (nptr >= sizei_(tabptr)) { - setmsg_("SYSETI: Addition of the new symbol # causes an overflow in " - "the pointer table.", (ftnlen)77); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(POINTERTABLEFULL)", (ftnlen)23); - } else if (nval >= sizei_(tabval)) { - setmsg_("SYSETI: Addition of the new symbol # causes an overflow in " - "the value table.", (ftnlen)75); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(VALUETABLEFULL)", (ftnlen)21); - -/* If there's room, add the new name to the name table. Give the */ -/* symbol dimension one, and put the value in the right place. */ - - } else { - i__1 = locsym + 1; - inslac_(name__, &c__1, &i__1, tabsym + tabsym_len * 6, &nsym, - name_len, tabsym_len); - scardc_(&nsym, tabsym, tabsym_len); - i__1 = locsym + 1; - inslai_(&c__1, &c__1, &i__1, &tabptr[6], &nptr); - scardi_(&nptr, tabptr); - locval = sumai_(&tabptr[6], &locsym) + 1; - inslai_(value, &c__1, &locval, &tabval[6], &nval); - scardi_(&nval, tabval); - } - chkout_("SYSETI", (ftnlen)6); - return 0; -} /* syseti_ */ - diff --git a/ext/spice/src/cspice/system_.c b/ext/spice/src/cspice/system_.c deleted file mode 100644 index 18fdce9215..0000000000 --- a/ext/spice/src/cspice/system_.c +++ /dev/null @@ -1,122 +0,0 @@ -/* - --Header_File system_.c ( CSPICE version of the system_.c routine ) - --Abstract - - This file replaces the standard f2c system_.c library file. The system_ - code now branches to Mac classic and non Mac classic code. The non Mac - code matches the standard f2c library version, the Mac classic code - returns a 0 as Mac classic has no system call facility. - --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. - --Particulars - - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Restrictions - - 1) Requires CSPICE f2c.h header file. - --Version - - -CSPICE Version 1.0.0, 02-JAN-2002 (EDW) - -*/ - -#include "f2c.h" - -#ifdef KR_headers - - extern char *F77_aloc(); - - integer system_(s, n) register char *s; ftnlen n; - -#else - - #undef abs - #undef min - #undef max - #include "stdlib.h" - - extern char *F77_aloc(ftnlen, char*); - - integer system_(register char *s, ftnlen n) - -#endif - - { - -#ifndef CSPICE_MACPPC - - char buff0[256], *buff; - register char *bp, *blast; - integer rv; - - buff = bp = n < sizeof(buff0) ? buff0 : F77_aloc(n+1, "system_"); - blast = bp + n; - - while(bp < blast && *s) - { - *bp++ = *s++; - } - - *bp = 0; - rv = system(buff); - - if (buff != buff0) - { - free(buff); - } - return rv; - -#endif - -#ifdef CSPICE_MACPPC - - /* - The Macintosh Classic environment lacks a system command. - - Return a fail. - */ - - return 0; - -#endif - - } diff --git a/ext/spice/src/cspice/sytrnc.c b/ext/spice/src/cspice/sytrnc.c deleted file mode 100644 index de10a4a026..0000000000 --- a/ext/spice/src/cspice/sytrnc.c +++ /dev/null @@ -1,260 +0,0 @@ -/* sytrnc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYTRNC (Transpose two values associated with a symbol) */ -/* Subroutine */ int sytrnc_(char *name__, integer *i__, integer *j, char * - tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen - tabsym_len, ftnlen tabval_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen), swapc_(char *, char *, - ftnlen, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Transpose two values associated with a particular symbol in a */ -/* character symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be transposed. */ -/* I I Index of the first associated value to be */ -/* transposed. */ -/* J I Index of the second associated value to be */ -/* transposed. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated values are */ -/* to be transposed. */ - -/* I is the index of the first associated value to be */ -/* transposed. */ - -/* J is the index of the second associated value to be */ -/* transposed. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the character symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the character symbol table. */ -/* If the symbol NAME is not in the symbol table */ -/* the symbol tables are not modified. Otherwise, */ -/* the values that I and J refer to are transposed */ -/* in the value table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If I < 1, J < 1, I > the dimension of NAME, or J > the */ -/* dimension of NAME, the error SPICE(INVALIDINDEX) is signaled. */ - -/* 2) If NAME is not in the symbol table, the symbol tables are not */ -/* modified. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* PHOTOELECTRIC EFFECT */ -/* BROWNIAN MOTION */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ - -/* The call, */ - -/* CALL SYTRNC ( 'EINSTEIN', 2, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* BOHR --> HYDROGEN ATOM */ -/* EINSTEIN --> SPECIAL RELATIVITY */ -/* BROWNIAN MOTION */ -/* PHOTOELECTRIC EFFECT */ -/* FERMI --> NUCLEAR FISSION */ -/* PAULI --> EXCLUSION PRINCIPLE */ -/* NEUTRINO */ - -/* The next call, */ - -/* CALL SYTRNC ( 'PAULI', 2, 4, TABSYM, TABPTR, TABVAL ) */ - -/* causes the error SPICE(INVALIDINDEX) to be signaled. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated so no "exchange" occurs if I equals J. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* transpose two values associated with a symbol */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated so no "exchange" occurs if I equals J. */ - -/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */ - -/* If one of the indices of the values to be transposed is */ -/* invalid, an error is signaled and the symbol table is */ -/* not modified. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYTRNC", (ftnlen)6); - } - -/* How many symbols? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - if (locsym > 0) { - -/* Are there enough values associated with the symbol? */ - - n = tabptr[locsym + 5]; - -/* Are the indices valid? */ - - if (*i__ >= 1 && *i__ <= n && *j >= 1 && *j <= n) { - -/* Exchange the values in place. */ - - if (*i__ != *j) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - swapc_(tabval + (locval + *i__ + 4) * tabval_len, tabval + ( - locval + *j + 4) * tabval_len, tabval_len, tabval_len) - ; - } - } else { - setmsg_("The first index was *. The second index was *.", (ftnlen) - 46); - errint_("*", i__, (ftnlen)1); - errint_("*", j, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - } - } - chkout_("SYTRNC", (ftnlen)6); - return 0; -} /* sytrnc_ */ - diff --git a/ext/spice/src/cspice/sytrnd.c b/ext/spice/src/cspice/sytrnd.c deleted file mode 100644 index da6434679c..0000000000 --- a/ext/spice/src/cspice/sytrnd.c +++ /dev/null @@ -1,265 +0,0 @@ -/* sytrnd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYTRND (Transpose two values associated with a symbol) */ -/* Subroutine */ int sytrnd_(char *name__, integer *i__, integer *j, char * - tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int swapd_(doublereal *, doublereal *); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Transpose two values associated with a particular symbol in a */ -/* double precision symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be transposed. */ -/* I I Index of the first associated value to be */ -/* transposed. */ -/* J I Index of the second associated value to be */ -/* transposed. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated values are */ -/* to be transposed. If NAME is not in the symbol table, */ -/* the symbol tables are not modified. */ - -/* I is the index of the first associated value to be */ -/* transposed. If this index is not valid ( I < 1 or */ -/* I > the dimension of NAME) the symbol table is not */ -/* modified. */ - -/* J is the index of the second associated value to be */ -/* transposed. If this index is not valid ( J < 1 or */ -/* J > the dimension of NAME) the symbol table is not */ -/* modified. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the double precision symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the double precision symbol table. */ -/* If the symbol NAME is not in the symbol table */ -/* the symbol tables are not modified. Otherwise, */ -/* the values that I and J refer to are transposed */ -/* in the value table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If I < 1, J < 1, I > the dimension of NAME, or J > the */ -/* dimension of NAME, the error SPICE(INVALIDINDEX) is signaled. */ - -/* 2) If NAME is not in the symbol table, the symbol tables are not */ -/* modified. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 1.08D-1 */ -/* 0.0D0 */ - -/* The call, */ - -/* CALL SYTRND ( 'BODY4_POLE_RA', 2, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* DELTA_T_A --> 3.2184D1 */ -/* K --> 1.657D-3 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ -/* BODY4_POLE_RA --> 3.17681D2 */ -/* 0.0D0C */ -/* 1.08D-1 */ -/* The next call, */ - -/* CALL SYTRND ( 'MEAN_ANOM', 2, 4, TABSYM, TABPTR, TABVAL ) */ - -/* causes the error SPICE(INVALIDINDEX) to be signaled. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated so no "exchange" occurs if I equals J. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* transpose two values associated with a symbol */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated so no "exchange" occurs if I equals J. */ - -/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */ - -/* If one of the indices of the values to be transposed is */ -/* invalid, an error is signaled and the symbol table is */ -/* not modified. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYTRND", (ftnlen)6); - } - -/* How many symbols? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - if (locsym > 0) { - -/* Are there enough values associated with the symbol? */ - - n = tabptr[locsym + 5]; - -/* Are the indices valid? */ - - if (*i__ >= 1 && *i__ <= n && *j >= 1 && *j <= n) { - -/* Exchange the values in place. */ - - if (*i__ != *j) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - swapd_(&tabval[locval + *i__ + 4], &tabval[locval + *j + 4]); - } - } else { - setmsg_("The first index was *. The second index was *.", (ftnlen) - 46); - errint_("*", i__, (ftnlen)1); - errint_("*", j, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - } - } - chkout_("SYTRND", (ftnlen)6); - return 0; -} /* sytrnd_ */ - diff --git a/ext/spice/src/cspice/sytrni.c b/ext/spice/src/cspice/sytrni.c deleted file mode 100644 index e046a93f9e..0000000000 --- a/ext/spice/src/cspice/sytrni.c +++ /dev/null @@ -1,263 +0,0 @@ -/* sytrni.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYTRNI (Transpose two values associated with a symbol) */ -/* Subroutine */ int sytrni_(char *name__, integer *i__, integer *j, char * - tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen - tabsym_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nsym; - extern integer cardc_(char *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *); - extern /* Subroutine */ int swapi_(integer *, integer *); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer locval; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer locsym; - extern logical return_(void); - -/* $ Abstract */ - -/* Transpose two values associated with a particular symbol in an */ -/* integer symbol table. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the symbol whose associated values are to */ -/* be transposed. */ -/* I I Index of the first associated value to be */ -/* transposed. */ -/* J I Index of the second associated value to be */ -/* transposed. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Components of the symbol table. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the symbol whose associated values are */ -/* to be transposed. If NAME is not in the symbol table, */ -/* the symbol tables are not modified. */ - -/* I is the index of the first associated value to be */ -/* transposed. */ - -/* J is the index of the second associated value to be */ -/* transposed. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the integer symbol table. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are components of the integer symbol table. */ -/* If the symbol NAME is not in the symbol table */ -/* the symbol tables are not modified. Otherwise, */ -/* the values that I and J refer to are transposed */ -/* in the value table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If I < 1, J < 1, I > the dimension of NAME, or J > the */ -/* dimension of NAME, the error SPICE(INVALIDINDEX) is signaled. */ - -/* 2) If NAME is not in the symbol table, the symbol tables are not */ -/* modified. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The contents of the symbol table are: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 18 */ -/* 24 */ -/* pens --> 10 */ -/* 20 */ -/* 30 */ -/* 40 */ - -/* The call, */ - -/* CALL SYTRNI ( 'pens', 2, 3, TABSYM, TABPTR, TABVAL ) */ - -/* modifies the contents of the symbol table to be: */ - -/* books --> 5 */ -/* erasers --> 6 */ -/* pencils --> 12 */ -/* 18 */ -/* 24 */ -/* pens --> 10 */ -/* 30 */ -/* 20 */ -/* 40 */ -/* The next call, */ - -/* CALL SYTRNI ( 'pencils', 2, 4, TABSYM, TABPTR, TABVAL ) */ - -/* causes the error SPICE(INVALIDINDEX) to be signaled. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated so no "exchange" occurs if I equals J. */ - -/* - 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 (IMU) (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* transpose two values associated with a symbol */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated so no "exchange" occurs if I equals J. */ - -/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */ - -/* If one of the indices of the values to be transposed is */ -/* invalid, an error is signaled and the symbol table is */ -/* not modified. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SYTRNI", (ftnlen)6); - } - -/* How many symbols? */ - - nsym = cardc_(tabsym, tabsym_len); - -/* Is this symbol even in the table? */ - - locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len, - tabsym_len); - if (locsym > 0) { - -/* Are there enough values associated with the symbol? */ - - n = tabptr[locsym + 5]; - -/* Are the indices valid? */ - - if (*i__ >= 1 && *i__ <= n && *j >= 1 && *j <= n) { - -/* Exchange the values in place. */ - - if (*i__ != *j) { - i__1 = locsym - 1; - locval = sumai_(&tabptr[6], &i__1) + 1; - swapi_(&tabval[locval + *i__ + 4], &tabval[locval + *j + 4]); - } - } else { - setmsg_("The first index was *. The second index was *.", (ftnlen) - 46); - errint_("*", i__, (ftnlen)1); - errint_("*", j, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - } - } - chkout_("SYTRNI", (ftnlen)6); - return 0; -} /* sytrni_ */ - diff --git a/ext/spice/src/cspice/szpool_c.c b/ext/spice/src/cspice/szpool_c.c deleted file mode 100644 index b20b282d10..0000000000 --- a/ext/spice/src/cspice/szpool_c.c +++ /dev/null @@ -1,238 +0,0 @@ -/* - --Procedure szpool_c (Get size limitations of the kernel pool) - --Abstract - - Return the kernel pool size limitations. - --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 - - KERNEL - --Keywords - - CONSTANTS - FILES - -*/ - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void szpool_c ( ConstSpiceChar * name, - SpiceInt * n, - SpiceBoolean * found ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - name I Name of the parameter to be returned. - n O Value of parameter specified by name. - found O SPICETRUE if name is recognized. - --Detailed_Input - - name is the name of a kernel pool size parameter. - The following parameters may be specified: - - MAXVAR is the maximum number of variables that the - kernel pool may contain at any one time. - MAXVAR should be a prime number. - - MAXLEN is the maximum length of the variable names - that can be stored in the kernel pool. - - MAXVAL is the maximum number of distinct values that - may belong to the variables in the kernel - pool. Each variable must have at least one - value, and may have any number, so long as - the total number does not exceed MAXVAL. - MAXVAL must be at least as large as MAXVAR. - - MXNOTE is the maximum number of distinct - variable-agents pairs that can be maintained - by the kernel pool. (A variable is "paired" - with an agent, if that agent is to be - notified whenever the variable is updated.) - - MAXAGT is the maximum number of agents that can be - kept on the distribution list for - notification of updates to kernel variables. - - MAXCHR is the maximum number of characters that can - be stored in a component of a string valued - kernel variable. - - MAXLIN is the maximum number of character strings - that can be stored as data for kernel pool - variables. - - Note that the case of name is insignificant. Embedded - blanks are also ignored. - --Detailed_Output - - n is the value of the parameter specified by name. If - name is not one of the items specified above, n will - be returned with the value 0. - - found is SPICETRUE if the parameter is recognized and - SPICEFALSE if it is not. - --Parameters - - None. - --Exceptions - - 1) If the specified parameter is not recognized, the value of - n will be set to zero and found will be set to SPICEFALSE. - --Files - - None. - --Particulars - - This routine provides a programmatic interface to the parameters - used to define the capacity limits of kernel pool. It is not - anticipated that most kernel pool users will need to use this - routine. - --Examples - - - 1) The following code fragment demonstrates how to determine the - size of a kernel reader parameter. - - - #include - #include "SpiceUsr.h" - - void main () { - - /. - Local Variables - ./ - ConstSpiceChar * varname = "MAXLEN"; - - SpiceBoolean found; - - SpiceInt n; - - - /. - Make the call to retrieve the value of MAXLEN - ./ - szpool_c ( varname, &n, &found ); - - /. - If MAXLEN parameter was found, print it out - ./ - if ( found ) { - printf ( "Kernel parameter found.\n" ); - printf ( "value:\t%s = %d\n", varname, n ); - } - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - H.W. Taylor (ACT) - --Version - - -CSPICE Version 2.1.0, 02-SEP-1999 (NJB) - - Local type logical variable now used for found flag used in - interface of szpool_. - - -CSPICE Version 1.0.0, 23-MAR-1999 (HWT) - --Index_Entries - - return a kernel pool definition parameter - --& -*/ - -{ /* Begin szpool_c */ - - /* - Local variables - */ - logical fnd; - - - /* - Participate in error tracing. - */ - chkin_c ( "szpool_c" ); - - - /* - Check the input string name to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "szpool_c", name ); - - - /* - Call the f2c'd routine. - */ - szpool_ ( ( char * ) name, - ( integer * ) n, - ( logical * ) &fnd, - ( ftnlen ) strlen(name) ); - - - /* - Assign the SpiceBoolean found flag. - */ - - *found = fnd; - - - - chkout_c ( "szpool_c" ); - - -} /* End szpool_c */ diff --git a/ext/spice/src/cspice/tcheck.c b/ext/spice/src/cspice/tcheck.c deleted file mode 100644 index dc664675ea..0000000000 --- a/ext/spice/src/cspice/tcheck.c +++ /dev/null @@ -1,905 +0,0 @@ -/* tcheck.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__100 = 100; -static integer c__400 = 400; -static integer c__8 = 8; -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure TCHECK ( Time Check) */ -/* Subroutine */ int tcheck_0_(int n__, doublereal *tvec, char *type__, - logical *mods, char *modify, logical *ok, char *error, ftnlen - type_len, ftnlen modify_len, ftnlen error_len) -{ - /* Initialized data */ - - static logical dochck = FALSE_; - static doublereal dinmon[12] = { 31.,28.,31.,30.,31.,30.,31.,31.,30.,31., - 30.,31. }; - static char mnames[10*12] = "January " "February " "March " "Apri" - "l " "May " "June " "July " "August " "Sep" - "tember " "October " "November " "December "; - static char cname[7*4] = "days " "hours " "minutes" "seconds"; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_dnnt(doublereal *), s_cmp(char *, char *, ftnlen, ftnlen), - s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer comp; - static doublereal jun30; - static integer year, hour, i__, j, k; - static doublereal hlbnd, hubnd; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), repmd_(char *, char *, doublereal *, - integer *, char *, ftnlen, ftnlen, ftnlen), repmi_(char *, char *, - integer *, char *, ftnlen, ftnlen, ftnlen); - static doublereal dinyr; - static integer month; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static integer second, leapdy; - static char messge[200]; - static integer minute, day; - static doublereal doy; - -/* $ Abstract */ - -/* If component checking is enabled, this routine */ -/* determines whether the components of a time vector are in */ -/* the "usual" range for the components. If component checking */ -/* is not enabled, this routine simply returns after setting */ -/* the outputs. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TVEC I A vector of time components */ -/* TYPE I The type of time vector. */ -/* MODS I A logical indicating the presence of modifiers */ -/* MODIFY I The values of the modifiers */ -/* OK O Indicates success or failure of component checks. */ -/* ERROR O Diagnostic message if .NOT. OK. */ - -/* $ Detailed_Input */ - -/* TVEC is an array of double precision numbers that */ -/* represent the components of some calendar epoch. */ - -/* TYPE is kind of calendar epoch represented by TVEC */ -/* legitimate values are 'YMD' and 'YD' */ - -/* MODS is a logical flag indicating whether any of the */ -/* items in MODIFY are non-blank. If some item */ -/* in MODIFY is non-blank, MODS will be TRUE. If */ -/* all items in MODIFY are blank, MODS will be FALSE. */ - -/* MODIFY is an array of strings indicating how the */ -/* interpretation of the various components of TVEC */ -/* should be modified. Blank values indicate that */ -/* the default interpretation should be applied. */ -/* Non-blank components will have the following values */ -/* and meanings. */ - - -/* Component Meaning Possible Non-blank Modifier Values */ -/* --------- ------- ---------------------------------- */ -/* 1 ERA 'A.D.', 'B.C.' */ -/* 2 Weekday 'SUN', 'MON', ... etc. */ -/* 3 AM/PM 'A.M.', 'P.M.' */ -/* 4 System 'UTC', 'TDB', 'TDT' */ -/* 5 Time Zone 'UTC+i:i', 'UTC-i:i' */ - - -/* $ Detailed_Output */ - -/* OK is returned TRUE if all components of TVEC are within */ -/* the normal range of values. If some problem arises, */ -/* OK will be returned with the value FALSE. Note that */ -/* component checking has not been enabled by a call */ -/* to TPARCH, the value of OK is automatically set to */ -/* TRUE. */ - -/* ERROR If OK is returned with the value TRUE, ERROR will be */ -/* returned as a blank. However, if OK is FALSE, ERROR */ -/* will contain a diagnostic indicating what was wrong */ -/* with the components of TVEC. Note that */ -/* component checking has not been enabled by a call */ -/* to TPARCH, the value of ERROR is automatically set to */ -/* a blank. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) All problems with TVEC are diagnosed via the logical OK */ -/* and the message ERROR. */ - -/* $ Particulars */ - -/* This routine works in conjunction with the entry point TPARCH. */ -/* If TPARCH has not been called with the input value 'YES' this */ -/* routine simply sets the outputs as indicated above and returns. */ - -/* Usually strings such as February 32, 1997 are regarded as */ -/* erroneous. However, the SPICE time subsystem is capable */ -/* of attaching meaning to such strings. The routines TPARCH and */ -/* TCHECK allow you to treat such strings as erroneous throughout */ -/* the SPICE time sub-system. */ - -/* This routine examines the components of a time vector and */ -/* determines whether or not all of the values in the vector */ -/* are within the normal bounds. */ - -/* To pass inspection: */ - -/* Years must be integers. */ - -/* Months must be in the range from 1 to 12 and must be integers. */ - -/* Days of the month must be in the normal ranges. For example */ -/* if the month specified is January, the day of the month */ -/* must be greater than or equal to 1.0D0 and strictly less */ -/* than 32.0D0 (The normal range for February is a function */ -/* of whether the year specified is a leap year. The */ -/* Gregorian calendar is used to determine leap years.) */ - -/* Day of the year must be greater than or equal to 1.0D0 */ -/* and strictly less than 366.0D0 (367.0D0 in a leap year. */ -/* The Gregorian calendar is used to determine leap years.) */ - -/* Hours must be greater than or equal to 0.0D0 and strictly */ -/* less than 24.0D0. If the AMPM modifier is included */ -/* hours must be greater than or equal to 1.0D0 and strictly */ -/* less than 13.0D0. */ - -/* Minutes must be greater than or equal to 0.0D0 and must */ -/* be strictly less than 60.0D0 */ - -/* Seconds must be greater than or equal to 0.0D0 and strictly */ -/* less than 60.0D0 (61.0D0 during the last minute of the */ -/* 30th of June and the 31st of December). */ - -/* If some component other than the seconds component is */ -/* not an integer, all components of lesser significance must */ -/* be zero. */ - -/* This routine is designed to work in conjunction */ -/* with the SPICE routine TPARTV and it is anticipated that */ -/* it will be called in the following fashion */ - -/* CALL TPARTV ( STRING, TVEC, NTVEC, TYPE, */ -/* . MODIFY, MODS, YABBRV, SUCCES, ERROR ) */ - -/* IF ( .NOT. SUCCES ) THEN */ - -/* communicate the diagnostic message and */ -/* take other actions as appropriate */ - -/* RETURN */ - -/* END IF */ - -/* IF ( SUCCES .AND. CHECK ) THEN */ -/* CALL TCHECK ( TVEC, TYPE, MODS, MODIFY, OK, ERROR ) */ -/* END IF */ - -/* IF ( .NOT. OK ) THEN */ - -/* communicate the diagnostic message and */ -/* take other actions as appropriate */ - -/* RETURN */ - -/* END IF */ - -/* $ Examples */ - -/* Suppose that you have parsed a string (via TPARTV) and want */ -/* to enforce normal ranges of the components. The following */ -/* sequence of calls will perform the checks on components. */ - -/* get the current checking setting */ - -/* CALL TCHCKD ( CURNT ) */ - -/* turn on component checking. */ - -/* CALL TPARCH ( 'YES' ) */ - -/* Check the components. */ - -/* CALL TCHECK ( TVEC, TYPE, MODS, MODIFY, OK, ERROR ) */ - -/* Reset the checking setting to the original value. */ - -/* CALL TPARCH ( CURNT ) */ - - -/* Now handle any problems that were diagnosed by TCHECK */ - -/* IF ( .NOT. OK ) THEN */ - -/* do something */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-JUL-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Check the components of a time vector */ - -/* -& */ - -/* SPICELIB functions */ - - -/* In-line Functions */ - - -/* Local Variables */ - - /* Parameter adjustments */ - if (tvec) { - } - if (modify) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_tparch; - case 2: goto L_tchckd; - } - - -/* The in-line function DIVBLE returns 1 if YEAR is divisible */ -/* by I, it returns 0 otherwise. */ - - -/* If checking isn't enabled, there is nothing to do. */ - - if (! dochck) { - *ok = TRUE_; - s_copy(error, " ", error_len, (ftnlen)1); - return 0; - } - -/* Ok. Checking has been enabled. Proceed with the various */ -/* checks. */ - - year = i_dnnt(tvec); -/* Computing MAX */ - i__1 = 0, i__2 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__400 * c__400 + 1 - abs(year); - leapdy = max(i__1,i__2) - max(i__3,i__4) + max(i__5,i__6); - dinmon[1] = (doublereal) leapdy + 28.; - dinyr = (doublereal) leapdy + 365.; - jun30 = (doublereal) leapdy + 181.; - -/* The error message that will be attached to an out of range */ -/* problem for hours depends upon whether the AMPM modifier */ -/* was specified. We set up valid range as well as the out */ -/* of range messages here. */ - - if (*mods && s_cmp(modify + modify_len * 3, " ", modify_len, (ftnlen)1) != - 0) { - hubnd = 13.; - hlbnd = 1.; - s_copy(messge, "The hours component of the time specified was #. Whe" - "n either A.M. or P.M. is specified with the time the hours c" - "omponent must be at least 1.0D0 and less than 13.0D0. ", ( - ftnlen)200, (ftnlen)166); - } else { - hubnd = 24.; - hlbnd = 0.; - s_copy(messge, "The hours component of the time specified was #. Th" - "e hours component must be greater than or equal to 0.0D0 and" - " less than 24.0D0. ", (ftnlen)200, (ftnlen)131); - } - -/* We only check YD and YMD anything else is out of the */ -/* province of this routine. */ - - if (s_cmp(type__, "YD", type_len, (ftnlen)2) != 0 && s_cmp(type__, "YMD", - type_len, (ftnlen)3) != 0) { - *ok = FALSE_; - s_copy(error, "The type of the time vector specified was #, only 'YD" - "' and 'YMD' are recognized. ", error_len, (ftnlen)81); - repmc_(error, "#", type__, error, error_len, (ftnlen)1, type_len, - error_len); - return 0; - } - -/* First check. The year must be an integer. */ - - if (tvec[0] != (doublereal) year) { - *ok = FALSE_; - s_copy(error, "The year value was #. This must be an integral value" - ". ", error_len, (ftnlen)55); - repmd_(error, "#", tvec, &c__8, error, error_len, (ftnlen)1, - error_len); - return 0; - } - if (s_cmp(type__, "YD", type_len, (ftnlen)2) == 0) { - day = 2; - hour = 3; - minute = 4; - second = 5; - doy = tvec[1]; - if (tvec[1] >= dinyr + 1. || tvec[1] < 1.) { - *ok = FALSE_; - s_copy(error, "Day # has been specified for the year #. The corr" - "ect range for the day of year for this year is from 1 to" - " #. ", error_len, (ftnlen)109); - repmd_(error, "#", &tvec[1], &c__8, error, error_len, (ftnlen)1, - error_len); - repmi_(error, "#", &year, error, error_len, (ftnlen)1, error_len); - i__1 = leapdy + 365; - repmi_(error, "#", &i__1, error, error_len, (ftnlen)1, error_len); - return 0; - } - } else if (s_cmp(type__, "YMD", type_len, (ftnlen)3) == 0) { - month = i_dnnt(&tvec[1]); - day = 3; - hour = 4; - minute = 5; - second = 6; - doy = 0.; - if (tvec[1] != (doublereal) month) { - *ok = FALSE_; - s_copy(error, "The month specified, #, was not an integer. The m" - "onth must be an integer in the range from 1 to 12. ", - error_len, (ftnlen)100); - repmd_(error, "#", &tvec[1], &c__3, error, error_len, (ftnlen)1, - error_len); - return 0; - } else if (tvec[1] < 1. || tvec[1] > 12.) { - *ok = FALSE_; - s_copy(error, "The month specified was #. The month must be an " - "integer in the range from 1 to 12 (inclusive). ", - error_len, (ftnlen)96); - repmi_(error, "#", &month, error, error_len, (ftnlen)1, error_len) - ; - return 0; - } else if (tvec[2] < 1. || tvec[2] >= dinmon[(i__1 = month - 1) < 12 - && 0 <= i__1 ? i__1 : s_rnge("dinmon", i__1, "tcheck_", ( - ftnlen)477)] + 1.) { - *ok = FALSE_; - s_copy(error, "The day of the month specified for the month of #" - " was #. For # the day must be at least 1.0D0 and less t" - "han #. ", error_len, (ftnlen)112); - repmc_(error, "#", mnames + ((i__1 = month - 1) < 12 && 0 <= i__1 - ? i__1 : s_rnge("mnames", i__1, "tcheck_", (ftnlen)484)) * - 10, error, error_len, (ftnlen)1, (ftnlen)10, error_len); - repmd_(error, "#", &tvec[2], &c__3, error, error_len, (ftnlen)1, - error_len); - repmc_(error, "#", mnames + ((i__1 = month - 1) < 12 && 0 <= i__1 - ? i__1 : s_rnge("mnames", i__1, "tcheck_", (ftnlen)486)) * - 10, error, error_len, (ftnlen)1, (ftnlen)10, error_len); - d__1 = dinmon[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dinmon", i__1, "tcheck_", (ftnlen)487)] + 1.; - repmd_(error, "#", &d__1, &c__2, error, error_len, (ftnlen)1, - error_len); - return 0; - } - i__1 = month - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - doy += dinmon[(i__2 = i__ - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge( - "dinmon", i__2, "tcheck_", (ftnlen)493)]; - } - doy += tvec[2]; - } - -/* Make sure the hours, minutes and seconds are all in range. */ - - if (tvec[hour - 1] >= hubnd || tvec[hour - 1] < hlbnd) { - *ok = FALSE_; - s_copy(error, messge, error_len, (ftnlen)200); - repmd_(error, "#", &tvec[hour - 1], &c__2, error, error_len, (ftnlen) - 1, error_len); - return 0; - } else if (tvec[minute - 1] >= 60. || tvec[minute - 1] < 0.) { - *ok = FALSE_; - s_copy(error, "The minutes component of the time specified was #. Th" - "is value must be greater than or equal to 0.0 and less than " - "60.0. ", error_len, (ftnlen)119); - repmd_(error, "#", &tvec[minute - 1], &c__2, error, error_len, ( - ftnlen)1, error_len); - return 0; - } - if (tvec[second - 1] >= 60. || tvec[second - 1] < 0.) { - -/* We allow for the possibility that we might have a leapsecond. */ - - if (tvec[second - 1] < 61. && tvec[second - 1] > 0. && tvec[minute - - 1] == 59. && tvec[hour - 1] == 23. && (doy == dinyr || doy == - jun30)) { - -/* Don't do anything. */ - - } else if (tvec[second - 1] < 61. && tvec[second - 1] > 0. && tvec[ - minute - 1] == 59. && tvec[hour - 1] == 11. && *mods && s_cmp( - modify + modify_len * 3, "P.M.", modify_len, (ftnlen)4) == 0 - && (doy == dinyr || doy == jun30)) { - -/* Don't do anything. */ - - } else { - *ok = FALSE_; - s_copy(error, "The seconds component of time must be at least 0." - "0D0 and less than 60.0D0 (61.0D0 during the last minute " - "of June 30 and December 31). The value supplied was #. ", - error_len, (ftnlen)160); - repmd_(error, "#", &tvec[second - 1], &c__8, error, error_len, ( - ftnlen)1, error_len); - return 0; - } - } - -/* One final check. If some component is not an integer */ -/* the remaining components must be zero. */ - - comp = 0; - i__1 = minute; - for (i__ = day; i__ <= i__1; ++i__) { - ++comp; - k = comp; - if (tvec[i__ - 1] != (doublereal) i_dnnt(&tvec[i__ - 1])) { - i__2 = second; - for (j = i__ + 1; j <= i__2; ++j) { - ++k; - if (tvec[j - 1] != 0.) { - *ok = FALSE_; - s_copy(error, "The '#' component of the date has a fract" - "ional component. This is allowed only if all co" - "mponents of lesser significance have value 0.0D0" - ". However the '#' component has value #. ", - error_len, (ftnlen)178); - repmc_(error, "#", cname + ((i__3 = comp - 1) < 4 && 0 <= - i__3 ? i__3 : s_rnge("cname", i__3, "tcheck_", ( - ftnlen)589)) * 7, error, error_len, (ftnlen)1, ( - ftnlen)7, error_len); - repmc_(error, "#", cname + ((i__3 = k - 1) < 4 && 0 <= - i__3 ? i__3 : s_rnge("cname", i__3, "tcheck_", ( - ftnlen)590)) * 7, error, error_len, (ftnlen)1, ( - ftnlen)7, error_len); - repmd_(error, "#", &tvec[j - 1], &c__2, error, error_len, - (ftnlen)1, error_len); - return 0; - } - } - } - } - -/* If we make it this far, all components pass the reasonableness */ -/* tests. */ - - *ok = TRUE_; - s_copy(error, " ", error_len, (ftnlen)1); - return 0; -/* $Procedure TPARCH ( Parse check---check format of strings ) */ - -L_tparch: -/* $ Abstract */ - -/* Restrict the set of strings that are recognized by */ -/* SPICE time parsing routines to those that have standard */ -/* values for all time components. */ - -/* $ 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 */ - -/* PARSING, TIME */ - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TYPE I String: Use 'YES' to restrict time inputs. */ - -/* $ Detailed_Input */ - -/* TYPE is a character string that is used to adjust the */ -/* set of strings that will be regarded as valid */ -/* time strings by SPICE time parsing routines. */ - -/* The default behavior of SPICE time software */ -/* is to allow */ -/* an extended range of values for the various */ -/* components (tokens) of a time string. For example, */ -/* using its default behavior, TPARSE would regard */ -/* 1993 JAN 367 as a valid time string and return */ -/* the UTCSEC value that corresponds to Jan 2, 1994. */ - -/* While this is a "reasonable" interpretation of */ -/* such a string, there may be occasions when such */ -/* a string should be regarded as an error. */ - -/* By calling TPARCH with a value of 'YES', the */ -/* action of the time software will be modified. Strings */ -/* that have components that are out of the */ -/* range of values used in most English discourse */ -/* will be regarded as errors. Thus the numeric */ -/* values of MONTH, DAY, HOUR, MINUTE, and SECOND */ -/* must satisfy the following conditions to be */ -/* regarded as legitimate calendar time strings. */ - -/* ITEM Valid Range */ -/* ---- ------------------------------------- */ -/* MONTH 1 to 13 */ -/* DAY 1 to 365 (366 for leap years) when */ -/* DAY is interpreted as the day of year */ -/* i.e. the month token is empty. */ -/* 1 to 31 if month is January */ -/* 1 to 28 (29 in leap years) if month is */ -/* February */ -/* 1 to 31 if month is March */ -/* 1 to 30 if month is April */ -/* 1 to 31 if month is May */ -/* 1 to 31 if month is June */ -/* 1 to 30 if month is July */ -/* 1 to 31 if month is August */ -/* 1 to 30 if month is September */ -/* 1 to 31 if month is October */ -/* 1 to 30 if month is November */ -/* 1 to 31 if month is December */ -/* HOUR 0 to 23 */ -/* MINUTE 0 to 59 */ -/* SECOND 0 up to but not including 60 on days that */ -/* can not have a leapsecond. */ -/* 0 up to but not including 61 for times */ -/* that are the last second of June or */ -/* December. In other words, */ -/* JUN 30, 23:59:60.xxxxxx...x */ -/* and DEC 31, 23:59:60.xxxxxx...x */ - -/* To reset the action of time software to the default */ -/* action, set TYPE to a value that is not */ -/* equivalent to 'YES' when case and spaces are */ -/* ignored. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is used to alter the collections of strings */ -/* that SPICE software regards as legitimate calendar strings. The */ -/* default behavior of SPICE software is to accept strings such */ -/* as FEB 34, 1993 and to interpret these in a "natural way" */ -/* (FEB 34, 1993 is regarded as MARCH 6, 1993.) This behavior */ -/* is sometimes useful for "private" programs that you write. */ -/* However, such a string may be a typo (a finger accidentally hit */ -/* two keys for the day instead of one). Given that this string */ -/* does not appear in common usage, you may want to consider */ -/* that it is more likely the result of erroneous input. You */ -/* can alter the behavior of SPICE software so that it will */ -/* treat such a string as an error. To do this call this entry */ -/* point with TYPE having the value 'YES'. */ - -/* CALL TPARCH ( 'YES' ) */ - -/* Until the behavior is reset by calling TPARCH with a value */ -/* other than 'YES' (such as 'NO'), SPICE software will treat all */ -/* out-of-bound components of time strings as errors. */ - -/* If you are happy with the SPICE default interpretation of */ -/* strings, you do not need to make any calls to TPARCH. */ - -/* $ Examples */ - -/* When accepting times as input interactively, you usually */ -/* READ a string typed at a keyboard and then pass that string */ -/* to UTC2ET to convert it to an ephemeris time. If you want */ -/* to restrict the strings accepted by UTC2ET, place the */ -/* following call at a point early in your program. */ - -/* CALL TPARCH ( 'YES' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - - -/* - SPICELIB Version 1.0.0, 7-APR-1996 (WLT) */ - -/* The entry point TPARCH was moved from TPARSE to the routine */ -/* TCHECK so that all time parsing actions could be centralized. */ -/* -& */ -/* $ Index_Entries */ - -/* Restrict time strings to proper form */ - -/* -& */ - dochck = eqstr_(type__, "YES", type_len, (ftnlen)3); - return 0; -/* $Procedure TCHCKD ( Time components are checked ) */ - -L_tchckd: -/* $ Abstract */ - -/* Determine whether component checking is enabled for time strings. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) TYPE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TYPE O Answer to the question: "Is checking enabled?" */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* TYPE is a string that gives the answer to the question */ -/* "Is checking of components enabled?" If checking */ -/* is enabled, the value returned will be "YES" if */ -/* checking is not enabled, the value returned will */ -/* be "NO". */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This entry point allows you to "fetch" the current settings */ -/* regarding the checking of components of a time string. This */ -/* allows you to temporarily set the action to whatever is desired */ -/* in a particular piece of code and then reset the action to */ -/* the setting in effect prior to the routines activities. */ - -/* $ Examples */ - -/* Suppose you'd like to write a routine that always applies */ -/* component checking to the components of a time string. */ - -/* Use this entry point together with TPARCH and TCHECK to */ -/* make use of the built-in SPICE capabilities */ - -/* get the current setting. */ - -/* CALL TCHCKD ( CURNT ) */ -/* CALL TPARCH ( 'YES' ) */ - -/* perform some time */ -/* parsing activities. */ - -/* check the components. */ - -/* CALL TCHECK ( TVEC, TYPE, MODS, MODIFY, OK, ERROR ) */ - -/* Set the checking activity back to the value prior */ -/* to the work done here. */ - -/* CALL TPARCH ( CURNT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 7-APR-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the current time component checking status */ - -/* -& */ - if (dochck) { - s_copy(type__, "YES", type_len, (ftnlen)3); - } else { - s_copy(type__, "NO", type_len, (ftnlen)2); - } - return 0; -} /* tcheck_ */ - -/* Subroutine */ int tcheck_(doublereal *tvec, char *type__, logical *mods, - char *modify, logical *ok, char *error, ftnlen type_len, ftnlen - modify_len, ftnlen error_len) -{ - return tcheck_0_(0, tvec, type__, mods, modify, ok, error, type_len, - modify_len, error_len); - } - -/* Subroutine */ int tparch_(char *type__, ftnlen type_len) -{ - return tcheck_0_(1, (doublereal *)0, type__, (logical *)0, (char *)0, ( - logical *)0, (char *)0, type_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int tchckd_(char *type__, ftnlen type_len) -{ - return tcheck_0_(2, (doublereal *)0, type__, (logical *)0, (char *)0, ( - logical *)0, (char *)0, type_len, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/texpyr.c b/ext/spice/src/cspice/texpyr.c deleted file mode 100644 index c35be5b0ca..0000000000 --- a/ext/spice/src/cspice/texpyr.c +++ /dev/null @@ -1,318 +0,0 @@ -/* texpyr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TEXPYR ( Time --- Expand year ) */ -/* Subroutine */ int texpyr_0_(int n__, integer *year) -{ - /* Initialized data */ - - static integer centry = 1900; - static integer lbound = 1969; - -/* $ Abstract */ - -/* Expand an abbreviated year to a full year specification. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* YEAR I/O The year of some epoch abbreviated/expanded. */ - -/* $ Detailed_Input */ - -/* YEAR is an "abbreviated year." In other words the 98 of */ -/* 1998, 05 of 2005, etc. */ - -/* $ Detailed_Output */ - -/* YEAR is the expansion of the abbreviated year according */ -/* to the lower bound established in the entry point */ -/* TSETYR. By default if YEAR is 69 to 99, the output */ -/* is 1900 + the input value of YEAR. If YEAR is 0 to 68 */ -/* the output value of YEAR is 2000 + the input value of */ -/* YEAR. */ - -/* See the entry point TSETRY to modify this behavior. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If on input YEAR is not in the inclusive interval from */ -/* 0 to 99, YEAR is returned unchanged. */ - -/* $ Particulars */ - -/* This routine allows all of the SPICE time subsystem to handle */ -/* uniformly the expansion of "abbreviated" years. (i.e. the */ -/* remainder after dividing the actual year by 100). */ - -/* By using this routine together with the routine TSETYR you */ -/* can recover the actual year to associate with an abbreviation. */ - -/* The default behavior is as follows */ - -/* YEAR input YEAR Output */ -/* ---------- ----------- */ -/* 00 2000 */ -/* 01 2001 */ -/* . . */ -/* . . */ -/* . . */ -/* 66 2066 */ -/* 67 2067 */ -/* 68 2068 */ -/* 69 1969 */ -/* . . */ -/* . . */ -/* . . */ -/* 99 1999 */ - - -/* $ Examples */ - -/* Suppose that you use TPARTV to parse time strings and that */ -/* you want to treat years components in the range from 0 to 99 */ -/* as being abbreviations for years in the range from */ -/* 1980 to 2079 (provided that the years are not modified by */ -/* an ERA substring). The code fragment below shows how you */ -/* could go about this. */ - -/* Early in your application set up the lower bound for the */ -/* expansion of abbreviated years. */ - -/* CALL TSETYR ( 1980 ) */ - - -/* After calling TPARTV or some other suitable parsing routine */ -/* get the integer value of the year. */ - -/* YEAR = NINT( TVEC(1) ) */ - -/* Having satisfied yourself that the year does not represent */ -/* a year in the range from 99 to 1 B.C. or in the range */ -/* from 1 to 99 A.D. Expand Year to the appropriate value. */ - -/* IF ( YEAR .LT. 100 ) THEN */ - -/* CALL TEXPYR ( YEAR ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 18-NOV-1997 (WLT) */ - -/* The default century was change from 1950-2049 to 1969-2068 */ - -/* - SPICELIB Version 1.0.0, 8-APR-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Expand an abbreviated year to a fully specified year. */ - -/* -& */ - switch(n__) { - case 1: goto L_tsetyr; - } - - if (*year >= 100 || *year < 0) { - return 0; - } - *year += centry; - if (*year < lbound) { - *year += 100; - } - return 0; -/* $Procedure TSETYR ( Time --- set year expansion boundaries ) */ - -L_tsetyr: -/* $ Abstract */ - -/* Set the lower bound on the 100 year range */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ - -/* INTEGER YEAR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* YEAR I Lower bound on the 100 year interval of expansion */ - -/* $ Detailed_Input */ - -/* YEAR is the year associated with the lower bound on all */ -/* year expansions computed by TEXPYR. For example */ -/* if YEAR is 1980, then the range of years that */ -/* can be abbreviated is from 1980 to 2079. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If YEAR is less than 1 no action is taken */ - -/* $ Particulars */ - -/* This entry point allows you to set the range to which years */ -/* abbreviated to the last two digits will be expanded. The input */ -/* supplied to this routine represents the lower bound of the */ -/* expansion interval. The upper bound of the expansion interval */ -/* is YEAR + 99. */ - -/* The default expansion interval is from 1969 to 2068. */ - -/* $ Examples */ - -/* See the main routine TEXPYR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 18-NOV-1997 (WLT) */ - -/* The default century was change from 1950-2049 to 1969-2068 */ - -/* - SPICELIB Version 1.0.0, 8-APR-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Set the interval of expansion for abbreviated years */ - -/* -& */ - centry = *year / 100 * 100; - lbound = *year; - return 0; -} /* texpyr_ */ - -/* Subroutine */ int texpyr_(integer *year) -{ - return texpyr_0_(0, year); - } - -/* Subroutine */ int tsetyr_(integer *year) -{ - return texpyr_0_(1, year); - } - diff --git a/ext/spice/src/cspice/timdef.c b/ext/spice/src/cspice/timdef.c deleted file mode 100644 index 82b30c3e8f..0000000000 --- a/ext/spice/src/cspice/timdef.c +++ /dev/null @@ -1,438 +0,0 @@ -/* timdef.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__8 = 8; -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure TIMDEF ( Time Software Defaults ) */ -/* Subroutine */ int timdef_(char *action, char *item, char *value, ftnlen - action_len, ftnlen item_len, ftnlen value_len) -{ - /* Initialized data */ - - static char defsys[16] = "UTC "; - static char defzon[16] = " "; - static char defcal[16] = "GREGORIAN "; - static char zones[16*8] = "EST " "EDT " "CST " - " " "CDT " "MST " "MDT " - " " "PST " "PDT "; - static char trnslt[16*8] = "UTC-5 " "UTC-4 " "UTC-6 " - " " "UTC-5 " "UTC-7 " "UTC-6 " - " " "UTC-8 " "UTC-7 "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static doublereal hoff, moff; - static integer last, zone; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static char myval[16]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static logical succes; - static char myactn[16]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - setmsg_(char *, ftnlen); - static char myitem[16]; - extern logical return_(void); - extern /* Subroutine */ int zzutcpm_(char *, integer *, doublereal *, - doublereal *, integer *, logical *, ftnlen); - -/* $ Abstract */ - -/* Set and retrieve the defaults associated with calendar */ -/* input strings. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I is the kind of action to take 'SET' or 'GET'. */ -/* ITEM I is the default item of interest. */ -/* VALUE I/O is the value associated with the default item. */ - -/* $ Detailed_Input */ - -/* ACTION is a word that specifies whether TIMDEF sets the */ -/* value associated with ITEM or retrieves the value */ -/* associated with ITEM. The allowed values for */ -/* ACTION are 'SET' and 'GET'. The routine is not */ -/* sensitive to the case of the letters in ACTION. */ - -/* ITEM is the default items whose value should be set or */ -/* retrieved. The items that may be requested are: */ - -/* ITEM Allowed Values */ -/* --------- -------------- */ -/* CALENDAR GREGORIAN */ -/* JULIAN */ -/* MIXED */ - -/* SYSTEM TDB */ -/* TDT */ -/* UTC */ - -/* ZONE EST, EDT, CST, CDT, MST, MDT, PST, PDT */ -/* UTC+HR */ -/* UTC-HR ( 0 <= HR < 13 ) */ -/* UTC+HR:MN ( 0 <= MN < 60 ) */ -/* UTC-HR:MN */ - -/* The case of ITEM is not significant. */ - - -/* VALUE if the action is 'SET' then VALUE is an input and */ -/* is the value to be associated with ITEM. Note that */ -/* VALUE is checked to ensure it is within the range */ -/* of allowed values for ITEM. If it is not within */ -/* the expected range and appropriate error message */ -/* is signalled. The case of VALUE is not significant. */ - -/* $ Detailed_Output */ - -/* VALUE if the action is 'GET' then VALUE will be the */ -/* value associated with the requested ITEM. Note that */ -/* when time zones are set, they are translated to the */ -/* UTC offset form ( UTC(+/-)HR[:MN] ). When VALUE is */ -/* an output it will be in upper case. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the ACTION specified is not SET or GET the error */ -/* 'SPICE(BADACTION)' is signalled. */ - -/* 2) If the ITEM specified is not one the recognized items */ -/* the error 'SPICE(BADTIMEITEM)' is signalled. */ - -/* 3) If the value associated with a 'SET', item input */ -/* is not one of the recognized items, the error */ -/* 'SPICE(BADDEFAULTVALUE)' is signalled. */ - -/* $ Particulars */ - -/* This routine exists to allow SPICE toolkit users to alter */ -/* the default interpretation of time strings made by the */ -/* routine STR2ET. */ - -/* Normally, unlabelled time strings are assumed to belong to */ -/* the Gregorian Calendar and are UTC times. However, you */ -/* may alter the default behavior by calling TIMDEF. */ - -/* Calendar */ -/* -------- */ - -/* You may set the calendar to be one of the following */ - -/* Gregorian --- This is the calendar used daily the */ -/* Western Hemisphere. Leap years occur in this */ -/* calendar every 4 years except on centuries */ -/* such as 1900 that are not divisible by 400. */ - -/* Julian --- This is the calendar that was in use prior */ -/* to October 15, 1582. Leap years occur every */ -/* 4 years on the Julian Calendar (including all */ -/* centuries.) October 5, 1582 on the Julian */ -/* calendar corresponds to October 15, 1582 of the */ -/* Gregorian Calendar. */ - -/* Mixed --- This calendar uses the Julian calendar */ -/* for days prior to October 15, 1582 and */ -/* the Gregorian calendar for days on or after */ -/* October 15, 1582. */ - -/* To set the default calendar, select on of the above for VALUE */ -/* and make the following call. */ - -/* CALL TIMDEF ( 'SET', 'CALENDAR', VALUE ) */ - - -/* System */ -/* ------- */ - -/* You may set the system used for keeping time to be UTC (default) */ -/* TDB (barycentric dynamical time) or TDT (terrestrial dynamical */ -/* time). Both TDB and TDT have no leapseconds. As such the time */ -/* elapsed between any two epochs on these calendars does not depend */ -/* upon when leapseconds occur. */ - -/* To set the default time system, select TDT, TDB or UTC for VALUE */ -/* and make the following call. */ - -/* CALL TIMDEF ( 'SET', 'SYSTEM', VALUE ) */ - -/* Note that such a call has the side effect of setting the value */ -/* associated with ZONE to a blank. */ - -/* Zone */ -/* ----- */ - -/* You may alter the UTC system by specifying a time zone (UTC */ -/* offset). For example you may specify that epochs are referred */ -/* to Pacific Standard Time (PST --- UTC-7). The standard */ -/* abbreviations for U.S. time zones are recognized: */ - -/* EST UTC-5 */ -/* EDT UTC-4 */ -/* CST UTC-6 */ -/* CDT UTC-5 */ -/* MST UTC-7 */ -/* MDT UTC-6 */ -/* PST UTC-8 */ -/* PDT UTC-7 */ - -/* In addition you may specify any commercial time zone by using */ -/* "offset" notation. This notation starts with the letters 'UTC' */ -/* followed by a + for time zones east of Greenwich and - for */ -/* time zones west of Greenwich. This is followed by the number */ -/* of hours to add or subtract from UTC. This is optionally followed */ -/* by a colon ':' and the number of minutes to add or subtract (based */ -/* on the sign that follows 'UTC') to get the */ -/* local time zone. Thus to specify the time zone of Calcutta you */ -/* would specify the time zone to be UTC+5:30. To specify the */ -/* time zone of Newfoundland use the time zone UTC-3:30. */ - -/* To set a default time zone, select one of the "built-in" U.S. */ -/* zones or construct an offset as discussed above. Then make the */ -/* call */ - -/* CALL TIMDEF ( 'SET', 'ZONE', VALUE ) */ - -/* If you 'GET' a 'ZONE' it will either be blank, or have the */ -/* form 'UTC+/-HR[:MN]' */ - -/* Note that such a call has the side effect of setting the value */ -/* associated with SYSTEM to a blank. */ - -/* $ Examples */ - -/* Suppose you wish to modify the behavior of STR2ET so that */ -/* it interprets unlabeled time strings as being times in */ -/* Pacific Daylight Time and that you want the calendar to use */ -/* to be the "Mixed" calendar. The following two calls will */ -/* make the desired changes to the behavior of STR2ET */ - -/* CALL TIMDEF ( 'SET', 'CALENDAR', 'MIXED' ) */ -/* CALL TIMDEF ( 'SET', 'ZONE', 'PDT' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 26-MAY-1998 (WLT) */ - -/* The previous version did not check out and return */ -/* when an error was detected in the if block that */ -/* begins with */ - -/* ELSE IF ( MYITEM .EQ. 'ZONE' ) THEN */ - -/* The routine did eventually check out and return so */ -/* that the trace stack was maintained correctly, but */ -/* the default time zone would be modified which was not */ -/* the desired behavior. */ - -/* - SPICELIB Version 1.1.0, 27-JUN-1997 (WLT) */ - -/* The previous version failed to check out when */ -/* the default value was set. */ - -/* - SPICELIB Version 1.0.0, 13-NOV-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Change time software defaults. */ -/* Time Zones */ -/* Gregorian and Julian Calendars */ - -/* -& */ - - -/* SPICELIB Functions */ - - -/* Local Variables. */ - - if (return_()) { - return 0; - } - chkin_("TIMDEF", (ftnlen)6); - -/* Normalize the input. */ - - ljust_(action, myactn, action_len, (ftnlen)16); - ucase_(myactn, myactn, (ftnlen)16, (ftnlen)16); - ljust_(item, myitem, item_len, (ftnlen)16); - ucase_(myitem, myitem, (ftnlen)16, (ftnlen)16); - ljust_(value, myval, value_len, (ftnlen)16); - ucase_(myval, myval, (ftnlen)16, (ftnlen)16); - -/* Admittedly, the decision making below is not very elegant. */ -/* However, this works and is simpler than anything that comes */ -/* to mind at the moment and allows us to give quite specific */ -/* diagnostic messages easily. */ - - if (s_cmp(myactn, "SET", (ftnlen)16, (ftnlen)3) == 0) { - if (s_cmp(myitem, "SYSTEM", (ftnlen)16, (ftnlen)6) == 0) { - if (s_cmp(myval, "TDB", (ftnlen)16, (ftnlen)3) == 0 || s_cmp( - myval, "TDT", (ftnlen)16, (ftnlen)3) == 0 || s_cmp(myval, - "UTC", (ftnlen)16, (ftnlen)3) == 0) { - s_copy(defzon, " ", (ftnlen)16, (ftnlen)1); - s_copy(defsys, myval, (ftnlen)16, (ftnlen)16); - } else { - setmsg_("The default value assigned to the time system must " - "be one of 'UTC', 'TDT', or 'TDB'. The value supplied" - " was '#'. ", (ftnlen)113); - errch_("#", value, (ftnlen)1, value_len); - sigerr_("SPICE(BADDEFAULTVALUE)", (ftnlen)22); - chkout_("TIMDEF", (ftnlen)6); - return 0; - } - } else if (s_cmp(myitem, "ZONE", (ftnlen)16, (ftnlen)4) == 0) { - zone = isrchc_(myval, &c__8, zones, (ftnlen)16, (ftnlen)16); - -/* If MYVAL was one of the recognized time zones, we */ -/* translate it to the UTC offset form. */ - - if (zone > 0) { - s_copy(myval, trnslt + (((i__1 = zone - 1) < 8 && 0 <= i__1 ? - i__1 : s_rnge("trnslt", i__1, "timdef_", (ftnlen)387)) - << 4), (ftnlen)16, (ftnlen)16); - } - prefix_("::", &c__0, myval, (ftnlen)2, (ftnlen)16); - zzutcpm_(myval, &c__1, &hoff, &moff, &last, &succes, (ftnlen)16); - if (! succes) { - setmsg_("The input value for a time zone \"#\" was not recog" - "nized as known time zone and could not be parsed acc" - "ording to the pattern UTC(+/-)HR[:MN]. Known time zo" - "nes are: 'EST', 'EDT', 'CST', 'CDT', 'MST', 'MDT', '" - "PST', and 'PDT'. ", (ftnlen)222); - errch_("#", value, (ftnlen)1, value_len); - sigerr_("SPICE(BADDEFAULTVALUE)", (ftnlen)22); - chkout_("TIMDEF", (ftnlen)6); - return 0; - } - s_copy(defzon, myval + 2, (ftnlen)16, (ftnlen)14); - s_copy(defsys, " ", (ftnlen)16, (ftnlen)1); - } else if (s_cmp(myitem, "CALENDAR", (ftnlen)16, (ftnlen)8) == 0) { - if (s_cmp(myval, "JULIAN", (ftnlen)16, (ftnlen)6) == 0 || s_cmp( - myval, "GREGORIAN", (ftnlen)16, (ftnlen)9) == 0 || s_cmp( - myval, "MIXED", (ftnlen)16, (ftnlen)5) == 0) { - s_copy(defcal, myval, (ftnlen)16, (ftnlen)16); - } else { - setmsg_("The input value for '#' is not a recognized calenda" - "r type. The recognized calendars are 'GREGORIAN', '" - "JULIAN', and 'MIXED'. ", (ftnlen)125); - errch_("#", value, (ftnlen)1, value_len); - sigerr_("SPICE(BADDEFAULTVALUE)", (ftnlen)22); - chkout_("TIMDEF", (ftnlen)6); - return 0; - } - } else { - setmsg_("The specified item '#' is not a recognized time default" - " item. The items that you may \"SET\" via the routine T" - "IMDEF are 'CALENDAR', 'SYSTEM', or 'ZONE' ", (ftnlen)151); - errch_("#", item, (ftnlen)1, item_len); - sigerr_("SPICE(BADTIMEITEM)", (ftnlen)18); - chkout_("TIMDEF", (ftnlen)6); - return 0; - } - chkout_("TIMDEF", (ftnlen)6); - return 0; - } else if (s_cmp(myactn, "GET", (ftnlen)16, (ftnlen)3) == 0) { - if (s_cmp(myitem, "CALENDAR", (ftnlen)16, (ftnlen)8) == 0) { - s_copy(value, defcal, value_len, (ftnlen)16); - } else if (s_cmp(myitem, "SYSTEM", (ftnlen)16, (ftnlen)6) == 0) { - s_copy(value, defsys, value_len, (ftnlen)16); - } else if (s_cmp(myitem, "ZONE", (ftnlen)16, (ftnlen)4) == 0) { - s_copy(value, defzon, value_len, (ftnlen)16); - } else { - setmsg_("The specified item '#' is not a recognized time default" - " item. The items that you may \"SET\" via the routine T" - "IMDEF are 'CALENDAR', 'SYSTEM', or 'ZONE' ", (ftnlen)151); - errch_("#", item, (ftnlen)1, item_len); - sigerr_("SPICE(BADTIMEITEM)", (ftnlen)18); - chkout_("TIMDEF", (ftnlen)6); - return 0; - } - } else { - setmsg_("The action speficied to TIMDEF was '#'. This is not a reco" - "gnized action. The recognized actions are 'SET' and 'GET'. ", - (ftnlen)118); - errch_("#", action, (ftnlen)1, action_len); - sigerr_("SPICE(BADACTION)", (ftnlen)16); - chkout_("TIMDEF", (ftnlen)6); - return 0; - } - chkout_("TIMDEF", (ftnlen)6); - return 0; -} /* timdef_ */ - diff --git a/ext/spice/src/cspice/timdef_c.c b/ext/spice/src/cspice/timdef_c.c deleted file mode 100644 index 244a0ae585..0000000000 --- a/ext/spice/src/cspice/timdef_c.c +++ /dev/null @@ -1,352 +0,0 @@ -/* - --Procedure timdef_c ( Time Software Defaults ) - --Abstract - - Set and retrieve the defaults associated with calendar - input strings. - --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 - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void timdef_c ( ConstSpiceChar * action, - ConstSpiceChar * item, - SpiceInt lenout, - SpiceChar * value ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - action I is the kind of action to take "SET" or "GET". - item I is the default item of interest. - lenout I Length of list for output. - value I/O is the value associated with the default item. - --Detailed_Input - - action is a word that specifies whether timdef_c sets the - value associated with item or retrieves the value - associated with item. The allowed values for - action are "SET" and "GET". The routine is not - sensitive to the case of the letters in action. - - item is the default items whose value should be set or - retrieved. The items that may be requested are: - - item Allowed Values - --------- -------------- - CALENDAR GREGORIAN - JULIAN - MIXED - - SYSTEM TDB - TDT - UTC - - ZONE EST, EDT, CST, CDT, MST, MDT, PST, PDT - UTC+HR - UTC-HR ( 0 <= HR < 13 ) - UTC+HR:MN ( 0 <= MN < 60 ) - UTC-HR:MN - - The case of item is not significant. - - lenout is the allowed length of the string when returning a - value via a "GET". The size described by lenout should - be large enough to hold any possible output plus 1. - - value if the action is "SET" then value is an input and - is the value to be associated with item. Note that - value is checked to ensure it is within the range - of allowed values for item. If it is not within - the expected range and appropriate error message - is signalled. The case of value is not significant. - --Detailed_Output - - value if the action is "GET" then value will be the - value associated with the requested item. Note that - when time zones are set, they are translated to the - UTC offset form ( UTC(+/-)HR[:MN] ). When value is - an output it will be in upper case. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the action specified is not SET or GET the error - SPICE(BADACTION) is signalled. - - 2) If the item specified is not one the recognized items - the error SPICE(BADTIMEITEM) is signalled. - - 3) If the value associated with a "SET", item input - is not one of the recognized items, the error - SPICE(BADDEFAULTVALUE) is signalled. - --Particulars - - This routine exists to allow SPICE toolkit users to alter - the default interpretation of time strings made by the - routine str2et_c. - - Normally, unlabelled time strings are assumed to belong to - the Gregorian Calendar and are UTC times. However, you - may alter the default behavior by calling timdef_c. - - Calendar - -------- - - You may set the calendar to be one of the following - - Gregorian --- This is the calendar used daily the - Western Hemisphere. Leap years occur in this - calendar every 4 years except on centuries - such as 1900 that are not divisible by 400. - - Julian --- This is the calendar that was in use prior - to October 15, 1582. Leap years occur every - 4 years on the Julian Calendar (including all - centuries.) October 5, 1582 on the Julian - calendar corresponds to October 15, 1582 of the - Gregorian Calendar. - - Mixed --- This calendar uses the Julian calendar - for days prior to October 15, 1582 and - the Gregorian calendar for days on or after - October 15, 1582. - - To set the default calendar, select on of the above for value - and make the following call. - - timdef_c ( "SET", "CALENDAR", lenout, value ); - - - System - ------- - - You may set the system used for keeping time to be UTC (default) - TDB (barycentric dynamical time) or TDT (terrestrial dynamical - time). Both TDB and TDT have no leapseconds. As such the time - elapsed between any two epochs on these calendars does not depend - upon when leapseconds occur. - - To set the default time system, select TDT, TDB or UTC for value - and make the following call. - - timdef_c ( "SET", "SYSTEM", lenout, value ); - - Note that such a call has the side effect of setting the value - associated with ZONE to a blank. - - Zone - ----- - - You may alter the UTC system by specifying a time zone (UTC - offset). For example you may specify that epochs are referred - to Pacific Standard Time (PST --- UTC-7). The standard - abbreviations for U.S. time zones are recognized: - - EST UTC-5 - EDT UTC-4 - CST UTC-6 - CDT UTC-5 - MST UTC-7 - MDT UTC-6 - PST UTC-8 - PDT UTC-7 - - In addition you may specify any commercial time zone by using - "offset" notation. This notation starts with the letters "UTC" - followed by a + for time zones east of Greenwich and - for - time zones west of Greenwich. This is followed by the number - of hours to add or subtract from UTC. This is optionally followed - by a colon ':' and the number of minutes to add or subtract (based - on the sign that follows "UTC") to get the - local time zone. Thus to specify the time zone of Calcutta you - would specify the time zone to be UTC+5:30. To specify the - time zone of Newfoundland use the time zone UTC-3:30. - - To set a default time zone, select one of the "built-in" U.S. - zones or construct an offset as discussed above. Then make the - call - - timdef_c ( "SET", "ZONE", lenout, value ); - - If you "GET" a "ZONE" it will either be blank, or have the - form "UTC+/-HR[:MN]" - - Note that such a call has the side effect of setting the value - associated with SYSTEM to a blank. - --Examples - - Suppose you wish to modify the behavior of str2et_c so that - it interprets unlabeled time strings as being times in - Pacific Daylight Time and that you want the calendar to use - to be the "Mixed" calendar. The following two calls will - make the desired changes to the behavior of str2et_c - - timdef_c ( "SET", "CALENDAR", lenout, "MIXED" ); - timdef_c ( "SET", "ZONE" , lenout, "PDT" ); - --Restrictions - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 13-APR-2000 (NJB) - - Made some minor updates and corrections in the header comments. - - -CSPICE Version 1.0.0, 4-FEB-1998 (EDW) - --Index_Entries - - Change time software defaults. - Time Zones - Gregorian and Julian Calendars - --& -*/ - -{ /* Begin timdef_c */ - - - /* - Participate in error tracing. - */ - - chkin_c ( "timdef_c" ); - - - /* - Check the input strings to make sure the pointers are non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "timdef_c", action ); - - CHKFSTR ( CHK_STANDARD, "timdef_c", item ); - - - - /* Select a task based on the value of the action string. */ - - if ( eqstr_c ( action, "SET") ) - { - - /* - Operation is SET. "value" will be an input string. Check - value as well. - */ - - CHKFSTR ( CHK_STANDARD, "timdef_c", value ); - - - /* - Call the f2c'd Fortran routine. - */ - - timdef_( ( char * ) action, - ( char * ) item, - ( char * ) value, - ( ftnlen ) strlen(action), - ( ftnlen ) strlen(item), - ( ftnlen ) strlen(value) ); - - - } - - else if ( eqstr_c (action, "GET" ) ) - { - - /* - Operation is GET. "action" will be an output string. Make sure - the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "timdef_c", value, lenout ); - - - /* - Call the f2c'd Fortran routine. - */ - - timdef_( ( char * ) action, - ( char * ) item, - ( char * ) value, - ( ftnlen ) strlen(action), - ( ftnlen ) strlen(item), - ( ftnlen ) lenout - 1 ); - - - /* Convert our Fortran string to C. */ - - F2C_ConvertStr( lenout, value ); - - } - - - - chkout_c ( "timdef_c" ); - - -} /* End timdef_c */ - diff --git a/ext/spice/src/cspice/timout.c b/ext/spice/src/cspice/timout.c deleted file mode 100644 index 471c943c89..0000000000 --- a/ext/spice/src/cspice/timout.c +++ /dev/null @@ -1,2099 +0,0 @@ -/* timout.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__100 = 100; -static integer c__0 = 0; -static integer c__1 = 1; -static integer c__14 = 14; -static doublereal c_b274 = 0.; -static doublereal c_b275 = 1.; -static doublereal c_b338 = 100.; - -/* $Procedure TIMOUT ( Time Output ) */ -/* Subroutine */ int timout_(doublereal *et, char *pictur, char *output, - ftnlen pictur_len, ftnlen output_len) -{ - /* Initialized data */ - - static char months[9*12] = "January " "February " "March " "April " - "May " "June " "July " "August " "September" - "October " "November " "December "; - static integer mlen[12] = { 7,8,5,5,3,4,4,6,9,7,8,8 }; - static char wkdays[9*7] = "Sunday " "Monday " "Tuesday " "Wednesday" - "Thursday " "Friday " "Saturday "; - static integer wklen[7] = { 6,6,7,9,8,6,8 }; - static logical first = TRUE_; - static doublereal power[15] = { 1.,10.,100.,1e3,1e4,1e5,1e6,1e7,1e8,1e9, - 1e10,1e11,1e12,1e13,1e14 }; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - double d_int(doublereal *); - integer i_dnnt(doublereal *); - - /* Local variables */ - static doublereal frac, hoff; - extern /* Subroutine */ int scan_(char *, char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - ftnlen, ftnlen); - static logical have[51]; - static doublereal moff; - static integer jday, gday; - static doublereal incr; - static integer last, dump[10]; - static doublereal myet; - static integer part, type__; - static doublereal tvec[8]; - static integer jdoy, gdoy, indx; - static char tsys[16]; - static integer b, e, i__, j; - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen); - static doublereal x, delta; - static logical doera; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - static integer appnd, ident[100], class__[43], gyear; - static doublereal tempd; - static integer jyear; - static doublereal value; - static char marks[8*42]; - extern /* Subroutine */ int dpfmt_(doublereal *, char *, char *, ftnlen, - ftnlen); - static integer width, ndump; - static doublereal ntvec[8]; - extern integer rtrim_(char *, ftnlen); - static integer start; - static doublereal ptvec[8]; - static char mymon[9]; - static integer mylen; - static char intyp[16], mywkd[9]; - static integer pntrs[100]; - static char ywfmt[8]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static char mystr[256]; - static integer wktyp; - static logical go2jul; - extern /* Subroutine */ int gr2jul_(integer *, integer *, integer *, - integer *), jul2gr_(integer *, integer *, integer *, integer *); - static integer id[51]; - static logical ok; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static logical making; - extern /* Subroutine */ int timdef_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int rmaind_(doublereal *, doublereal *, - doublereal *, doublereal *); - extern integer brckti_(integer *, integer *, integer *), isrchi_(integer * - , integer *, integer *); - static integer length[51]; - static doublereal factor; - static integer mrklen[42]; - static doublereal intmed; - static integer nmarks; - static char orignl[32*51]; - static integer caltyp, timfmt; - static doublereal values[51]; - static integer compnt[16] /* was [8][2] */; - static char ymdfmt[8]; - extern doublereal unitim_(doublereal *, char *, char *, ftnlen, ftnlen); - static char string[256], bastyp[16]; - static logical dozone; - static integer stopat, trncat, ntokns; - static doublereal timpad; - extern logical return_(void); - static char substr[256]; - static integer jmonth, gmonth, timtyp, montyp; - static logical unknwn, pumpup; - static integer numtyp; - static logical vanish; - extern /* Subroutine */ int scanpr_(integer *, char *, integer *, integer - *, ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - scanrj_(integer *, integer *, integer *, integer *, integer *, - integer *), ttrans_(char *, char *, doublereal *, ftnlen, ftnlen), - chkout_(char *, ftnlen); - extern doublereal j2000_(void); - static integer beg[100]; - static char cal[16]; - static doublereal pad[51]; - static integer end[100]; - extern doublereal j1950_(void), spd_(void); - static char fmt[32], zon[32]; - extern /* Subroutine */ int zzutcpm_(char *, integer *, doublereal *, - doublereal *, integer *, logical *, ftnlen); - -/* $ Abstract */ - -/* This routine converts an input epoch represented in TDB seconds */ -/* past the TDB epoch of J2000 to a character string formatted to */ -/* the specifications of a user's format picture. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I An epoch in seconds past the ephemeris epoch J2000 */ -/* PICTUR I A format specification for the output string. */ -/* STRING O A string representation of the input epoch. */ - -/* $ Detailed_Input */ - -/* ET a double precision representation of time in seconds */ -/* past the ephemeris epoch J2000. */ - -/* PICTUR is a string that specifies how the output should be */ -/* presented. The string is made up of various markers */ -/* that stand for various components associated with */ -/* a time. */ - -/* There are five types of markers that may appear in a */ -/* format picture. String Markers, Numeric Markers, */ -/* Meta markers, Modifier Markers and Literal Markers. */ - -/* The PICTUR string is examined and the various markers */ -/* are identified. The output time string is constructed */ -/* by replacing each of the identified markers with */ -/* an appropriate time component. */ - -/* The various markers and their meanings are discussed */ -/* in the Particulars section below. */ - -/* Note that leading and trailing blanks in PICTUR are */ -/* ignored. */ - - -/* $ Detailed_Output */ - -/* OUTPUT is a string matching the format of the input string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* No exceptions are detected by this routine. However, the user's */ -/* processing environment must be properly initialized by loading */ -/* a leapseconds kernel via the routine FURNSH before calling this */ -/* routine. If a leapsecond kernel has not been loaded, an error */ -/* will be signalled by a routines called by TIMOUT. */ - -/* $ Files */ - -/* A leapseconds kernel must be "loaded" via the routine FURNSH */ -/* prior to calling TIMOUT. */ - -/* $ Particulars */ - - -/* A format picture is simply a string of letters that lets */ -/* TIMOUT know where various components of a time representation */ -/* should be placed during creation of the time string. */ -/* Here's an example of such a picture: */ - -/* MON DD,YYYY HR:MN:SC.#### (TDB) ::TDB */ - -/* Here is a sample of times that would be created by using this */ -/* format. */ - -/* JAN 12,1992 12:28:18.2772 (TDB) */ -/* FEB 13,1994 23:18:25.2882 (TDB) */ -/* AUG 21,1995 00:02:00.1881 (TDB) */ - -/* As you can see from the samples above, the format picture */ -/* specifies that every time string created should begin with a */ -/* three-letter abbreviation for the month, followed by a space and */ -/* the day of the month. The day of month is followed immediately */ -/* by a comma and the year. The year component is followed by two */ -/* spaces. The next outputs are hours represented as a two digit */ -/* integer, a colon, minutes represented as a two digit integer, */ -/* another colon, and seconds rounded to 4 decimal places and */ -/* having a two digit integer part. This is followed by a space and */ -/* the string (TDB). The special marker `::TDB' in the time picture */ -/* is an ``invisible'' marker. It is used to specify the time */ -/* system that should be used in creating the time string (in this */ -/* case Barycentric Dynamical Time). */ - -/* TIMOUT does not recognize all of the parts of the time format */ -/* picture in the example above. The list of recognized parts and */ -/* unrecognized parts is shown in the table below. */ - -/* Recognized Unrecognized */ -/* ---------- ------------ */ -/* 'MON' ' ' */ -/* 'DD' ',' */ -/* 'YYYY' ' ' */ -/* 'HR' ':' */ -/* 'MN' '(TDB)' */ -/* 'SC' */ -/* '.####' */ -/* '::TDB' */ - -/* The unrecognized parts are called literal markers. They are */ -/* copied exactly as they appear in PICTUR into the output string. */ -/* The recognized parts of the picture are replaced by a */ -/* component of time or, as in the case of `::TDB' are used */ -/* as instructions about the overall properties of the time */ -/* string. */ - -/* The full list of recognized markers, their classification */ -/* and meaning are given below. */ - -/* MARKER CLASS MEANING */ -/* ----------- -------- ----------------------------------------- */ -/* '.##...' modifier represents a numeric component that */ -/* immediately precedes this in a decimal */ -/* format. Number of decimal places */ -/* equals the number of '#' characters */ -/* '::GCAL' meta dates are reported in Gregorian calendar */ -/* '::JCAL' meta dates are reported in Julian calendar */ -/* '::MCAL' meta dates after 15 October, 1582 are reported */ -/* in Gregorian calendar; before that */ -/* dates are reported in Julian calendar */ - -/* '::RND' meta round output to places specified by */ -/* least significant component */ - -/* '::TDB' meta all components should be TDB */ - -/* '::TDT' meta all components should be TDT */ - -/* '::TRNC' meta truncate all output components (default) */ -/* '::UTC' meta all components should be UTC (default) */ -/* '::UTC+h:m' meta all components in UTC offset by +h (hours) */ -/* and +m (minutes) so as to allow time zones. */ -/* '::UTC-h:m' meta all components in UTC offset by -h (hours) */ -/* and -m (minutes) so as to allow time zones. */ -/* 'AMPM' string String (either 'A.M.' or 'P.M.') */ -/* indicating whether hours are before */ -/* or after noon. */ -/* 'ampm' string String (either 'a.m.' or 'p.m.') */ -/* indicating whether hours are before */ -/* or after noon. */ -/* 'AP' numeric AM/PM equivalents of the hour component */ -/* of a time. */ -/* 'DD' numeric Day of month */ -/* 'DOY' numeric Day of year */ -/* 'ERA' string String (either 'B.C.' or 'A.D.') giving */ -/* era associated with an epoch. */ -/* '?ERA?' string String: either ' B.C. ' or ' A.D. ' if the */ -/* year is before 1000 A.D. otherwise a */ -/* blank: ' '. */ -/* 'era' string String (either 'b.c.' or 'a.d.') giving */ -/* era associated with an epoch. */ -/* '?era?' string String: either ' b.c. ' or ' a.d. ' if the */ -/* year is before 1000 A.D. otherwise a */ -/* blank: ' '. */ -/* 'HR' numeric hour component of time */ -/* 'JULIAND' numeric Julian date component of time */ -/* 'MM' numeric numeric representation of month component */ -/* 'MN' numeric minute component of time */ -/* 'MON' string upper case three letter abbreviation for */ -/* month */ -/* 'Mon' string capitalized three letter abbreviation for */ -/* month */ -/* 'mon' string lower case three letter abbreviation for */ -/* month */ -/* 'MONTH' string upper case full name of month */ -/* 'Month' string capitalized full name of month */ -/* 'month' string lower case full name of month */ -/* 'SC' numeric seconds component of time */ -/* 'SP1950' numeric seconds past 1950 component of time */ -/* 'SP2000' numeric seconds past 2000 component of time */ -/* 'YR' numeric last two digits of year component of time */ -/* 'YYYY' numeric year component of time */ -/* 'WEEKDAY' string upper case day of week */ -/* 'Weekday' string capitalized day of week */ -/* 'weekday' string lower case day of week */ -/* 'WKD' string upper case three letter abbreviation for */ -/* day of week. */ -/* 'Wkd' string capitalized three letter abbreviation for */ -/* day of week. */ -/* 'wkd' string lower case three letter abbreviation for */ -/* day of week. */ - -/* String Markers */ - -/* String markers are portions of the format picture that will */ -/* be replaced with a character string that represents the */ -/* corresponding component of a time. */ - -/* Numeric Markers */ - -/* Numeric markers are portions of the format picture that will */ -/* be replaced with a decimal string that represents the */ -/* corresponding component of a time. */ - -/* Meta Markers */ - -/* Meta markers (listed under the class ``meta'' in the */ -/* table above) are used to indicate `global' properties of */ -/* your time string. You may specify time scale and how */ -/* rounding should be performed on the components of time */ -/* in your output string. Meta markers may be placed anywhere */ -/* in your format picture. They do not contribute to placement */ -/* of characters in output time strings. Also there are no */ -/* restrictions on how many meta markers you may place in */ -/* the format picture. However, if you supply conflicting */ -/* `meta' markers (for example ::TDT and ::TDB) in your */ -/* picture the first marker listed (in left to right order) */ -/* overrules the conflicting marker that appears later in */ -/* the picture. */ - -/* Default Meta Markers */ - -/* If you do not specify a time system, calendar, or time */ -/* zone through the use of a Meta Marker, TIMOUT uses the */ -/* values returned by the SPICE routine TIMDEF. The default */ -/* time system, calendar returned by TIMDEF are UTC and */ -/* the Gregorian calendar. The default time zone returned */ -/* by TIMDEF is a blank indicating that no time zone offset */ -/* should be used. */ - -/* See the header for the routine TIMDEF for a more complete */ -/* discussion of setting and retrieving default values. */ - -/* Modifier Markers */ - -/* The numeric markers listed in the table above stand */ -/* for integers unless they are modified through use of a */ -/* modifier marker. The strings */ - -/* .# */ -/* .## */ -/* .### */ -/* .#### */ - -/* are used to this end. When a numeric marker is followed */ -/* immediately by one of these modifiers, the corresponding time */ -/* component will be written with the number of decimal places */ -/* indicated by the number of successive occurrences of the */ -/* character '#'. Any numeric token may be modified. */ - -/* Rounding vs. Truncation */ - -/* The meta markers ::TRNC and ::RND allow you to control */ -/* how the output time picture is rounded. If you specify */ -/* ::TRNC all components of time are simply truncated to */ -/* the precision specified by the marker and any modifier. */ -/* If you specify ::RND the output time is rounded to the */ -/* least significant component of the format picture. The */ -/* default action is truncation. */ - -/* Whether an output time string should be rounded or */ -/* truncated depends upon what you plan to do with the */ -/* string. For example suppose you simply want to get the */ -/* calendar date associated with a time and not the time of */ -/* day. Then you probably do not want to round your output. */ -/* Rounding 1992 Dec 31, 13:12:00 to the nearest day */ -/* produces 1993 Jan 1. Thus in this case rounding is probably */ -/* not appropriate. */ - -/* However, if you are producing output for plotting using */ -/* Julian Date, seconds past 1950 or seconds past 2000, you will */ -/* probably want your output rounded so as to produce a smoother */ -/* plot. */ - -/* Time Systems */ - -/* TIMOUT can produce output strings for epochs relative to */ -/* any of the three systems UTC, TDT, or TDB. If you do not */ -/* explicitly specify a time system, TIMOUT will produce strings */ -/* relative to the time system returned by the SPICE routine */ -/* TIMDEF. Unless you call TIMDEF and change it, the default time */ -/* system is UTC. However, by using one of the Meta Markers */ -/* ::UTC, ::TDT, or ::TDB you may specify that TIMOUT produce */ -/* time strings relative to the UTC, TDT, or TDB system */ -/* respectively. */ - -/* Time Zones */ - -/* The meta markers ::UTC+h:m and ::UTC-h:m allow you to */ -/* offset UTC times so that you may represent times in a time */ -/* zone other than GMT. For example you can output times in */ -/* Pacific Standard time by placing the meta-marker ::UTC-8 in */ -/* your format picture. */ - -/* For instance, if you use the picture */ - -/* YYYY Mon DD, HR:MN:SC ::UTC */ - -/* you will get output strings such as: */ - -/* 1995 Jan 03, 12:00:00 */ - -/* If you use the picture */ - - -/* YYYY Mon DD, HR:MN:SC ::UTC-8 */ - -/* you will get output strings such as: */ - -/* 1995 Jan 03, 04:00:00 */ - -/* Finally, if you use the picture */ - -/* YYYY Mon DD, HR:MN:SC ::UTC-8:15 */ - -/* you will get output string */ - -/* 1995 Jan 03, 03:45:00 */ - -/* Note that the minutes are always added or subtracted based on */ -/* the sign present in the time zone specifier. In the case of */ -/* ::UTC+h:m, minutes are added. In the case ::UTC-h:m, minutes */ -/* are subtracted. */ - -/* The unsigned part of the hours component can be no more than */ -/* 12. The unsigned part of the minutes component can be no */ -/* more than 59. */ - -/* Calendars */ - -/* The calendar currently used by western countries is the */ -/* Gregorian calendar. This calendar begins on Oct 15, 1582. */ -/* Prior to Gregorian calendar the Julian calendar was used. The */ -/* last Julian calendar date prior to the beginning of the */ -/* Gregorian calendar is Oct 5, 1582. */ - -/* The primary difference between the Julian and Gregorian */ -/* calendars is in the determination of leap years. Nevertheless, */ -/* both can be formally extended backward and forward in time */ -/* indefinitely. */ - -/* By default TIMOUT uses the default calendar returned by */ -/* TIMDEF. Under most circumstances this will be the Gregorian */ -/* calendar (::GCAL). However you may specify that TIMOUT use a */ -/* specific calendar through use of one of the calendar Meta */ -/* Markers. You may specify that TIMOUT use the Julian calendar */ -/* (::JCAL), the Gregorian calendar (::GCAL) or a mixture of */ -/* both (::MCAL). */ - -/* If you specify ::MCAL, epochs that occur after the beginning */ -/* of the Gregorian calendar will be represented using the */ -/* Gregorian calendar, and epochs prior to the beginning of the */ -/* Gregorian calendar will be represented using the Julian */ -/* calendar. */ - -/* Getting Software to Construct Pictures for You. */ - -/* Although it is not difficult to construct time format */ -/* pictures, you do need to be aware of the various markers that */ -/* may appear in a format picture. */ - -/* There is an alternative means for getting a format picture. */ -/* The routine TPICTR constructs format pictures from a sample */ -/* time string. For example, suppose you would like your time */ -/* strings to look like the basic pattern of the string below. */ - -/* 'Fri Jul 26 12:22:09 PDT 1996' */ - -/* You can call TPICTR with this string, and it will create the */ -/* appropriate PICTUR for use with TIMOUT. */ - -/* CALL TPICTR ( 'Fri Jul 26 12:22:09 PDT 1996', PICTUR, OK ) */ - -/* The result will be: */ - -/* 'Wkd Mon DD HR:MN:SC (PDT) ::UTC-7' */ - -/* Note: not every date that you can read is interpretable by */ -/* TPICTR. For example, you might be able to understand that */ -/* 19960212121116 is Feb 2 1996, 12:11:16. However, TPICTR */ -/* cannot recognize this string. Thus it is important to check */ -/* the logical output OK to make sure that TPICTR was able to */ -/* understand the time picture you provided. */ - -/* Even thought TPICTR can not recognize every time pattern that */ -/* has been used by various people, it does recognize nearly all */ -/* patterns that you use when you want to communicate outside */ -/* your particular circle of colleagues. */ - -/* $ Examples */ - -/* Example 1. */ -/* ---------- */ - -/* Suppose you need to create time strings similar to the */ -/* default time string produced by the UNIX utility "date" */ -/* (for example a string of the form "Thu Aug 01 09:47:16 PDT 1996") */ - -/* Make the following string assignment. */ - -/* PICTUR = 'Wkd Mon DD HH:MN:SC PDT YYYY ::UTC-7' */ - -/* (Note the meta marker ::UTC-7 is used to adjust the output */ -/* time system from UTC to PDT. Also note that the substring PDT */ -/* is a literal marker. Without it, the time system would not */ -/* appear in the output time string. */ - -/* Now for each time ET for which an output time string is required */ -/* make the call to TIMOUT below, and write the time string. */ - -/* CALL TIMOUT ( ET, PICTUR, STRING ) */ -/* WRITE (*,*) STRING */ - -/* Alternatively, you can let the routine TPICTR create the TIMOUT */ -/* time picture for you. */ - -/* CALL TPICTR ( 'Thu Aug 01 09:47:16 PDT 1996', PICTUR, OK ) */ - -/* IF ( OK ) THEN */ - -/* CALL TIMOUT ( ET, PICTUR, STRING ) */ -/* WRITE (*,*) STRING */ - -/* END IF */ - - -/* Example 2. */ -/* ---------- */ - -/* Suppose you want to output a string that contains both the */ -/* calendar representations of the date as well as the Julian */ -/* date (for example a string of the form: */ -/* "Thu Aug 01 09:47:16 PDT 1996 (2450297.1994 JDUTC)" ) */ - -/* Make the following assignment. */ - -/* PICTUR = 'Wkd Mon DD HR:MN ::UTC-7 YYYY (JULIAND.#### JDUTC)' */ - -/* Now for each time ET for which an output time string is required */ -/* make the call to TIMOUT below, and write the time string. */ - -/* CALL TIMOUT ( ET, PICTUR, STRING ) */ -/* WRITE (*,*) STRING */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAIND call. Replaced header references to LDPOOL with */ -/* references to FURNSH. */ - -/* - Spicelib Version 3.2.0, 09-APR-2002 (WLT) */ - -/* Added code to bracket the fractional part of a time component */ -/* so that it cannot become negative due to inability to invert */ -/* arthmetic operations with double precision arithmetic. */ - -/* - Spicelib Version 3.1.0, 21-JUN-2001 (WLT) */ - -/* Added the format picture components ?ERA? and ?era? which */ -/* vanish for years after 999 A.D. */ - -/* - Spicelib Version 3.0.2, 10-APR-2000 (WLT) */ - -/* Declared SCAN to be external. */ - -/* - Spicelib Version 3.0.1, 22-JUN-1998 (WLT) */ - -/* A number of typographical and grammatical errors */ -/* were corrected in the header. */ - -/* - SPICELIB Version 3.0.0, 30-DEC-1997 (WLT) */ - -/* The previous version of this routine did not output */ -/* fractional components for epochs prior to 1 A.D. */ - -/* In addition, the default time system, calendar and time zone */ -/* are obtained from TIMDEF. */ - -/* - SPICELIB Version 2.0.0, 1-APR-1997 (WLT) */ - -/* In the event that the format picture requested 'YR' as */ -/* the first component of a time string, the previous edition */ -/* of this routine used the year value corresponding to the */ -/* last call to this routine (or whatever happened to be in */ -/* memory on the first call). This error has been corrected. */ - -/* - SPICELIB Version 1.0.0, 26-JUL-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Convert and format d.p. seconds past J2000 as a string */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.3.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAIND call. Replaced header references to LDPOOL with */ -/* references to FURNSH. */ - -/* - Spicelib Version 3.1.0, 21-JUN-2001 (WLT) */ - -/* Added the format picture components ?ERA? and ?era? which */ -/* vanish for years after 999 A.D. */ - -/* - Spicelib Version 3.0.2, 10-APR-2000 (WLT) */ - -/* Declared SCAN to be external. */ - -/* - Spicelib Version 3.0.1, 22-JUN-1998 (WLT) */ - -/* A number of typographical and grammatical errors */ -/* were corrected in the header. */ - -/* - SPICELIB Version 3.0.0, 30-DEC-1997 (WLT) */ - -/* The previous version of this routine did not output */ -/* fractional components for epochs prior to 1 A.D. */ - -/* This error was due to overuse of the original year */ -/* component returned from TTRANS. The original year */ -/* component is now saved for use in computing the fractional */ -/* component. The modified year (used in printing B.C. epochs) */ -/* is stored in a separate variable. */ - -/* - SPICELIB Version 2.0.0, 1-APR-1997 (WLT) */ - -/* In the event that the format picture requested 'YR' as */ -/* the first component of a time string, the previous edition */ -/* of this routine used the year value corresponding to the */ -/* last call to this routine (or whatever happened to be in */ -/* memory on the first call). This error has been corrected. */ - - -/* The error was fixed by recoding the following IF THEN statement */ - -/* IF ( TYPE .EQ. YEAR */ -/* . .OR. TYPE .EQ. MONTH */ -/* . .OR. TYPE .EQ. MON */ -/* . .OR. TYPE .EQ. DAY */ -/* . .OR. TYPE .EQ. DOY */ -/* . .OR. TYPE .EQ. NOON */ -/* . .OR. TYPE .EQ. HOUR */ -/* . .OR. TYPE .EQ. ERA */ -/* . .OR. TYPE .EQ. AMPM */ -/* . .OR. TYPE .EQ. MINUTE */ -/* . .OR. TYPE .EQ. SEC ) THEN */ - -/* as */ - -/* IF ( TYPE .EQ. YEAR */ -/* . .OR. TYPE .EQ. YR */ -/* . .OR. TYPE .EQ. MONTH */ -/* . .OR. TYPE .EQ. MON */ -/* . .OR. TYPE .EQ. DAY */ -/* . .OR. TYPE .EQ. DOY */ -/* . .OR. TYPE .EQ. NOON */ -/* . .OR. TYPE .EQ. HOUR */ -/* . .OR. TYPE .EQ. ERA */ -/* . .OR. TYPE .EQ. AMPM */ -/* . .OR. TYPE .EQ. MINUTE */ -/* . .OR. TYPE .EQ. SEC ) THEN */ - - -/* - Beta Version 2.1.0, 17-MAR-1994 (MJS) (NJB) */ - -/* Integer argument to BRCKTD changed from 0 to 0.0D0. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* The parameters below act essentially as an enumeration */ -/* of the various kinds of components we will be looking at in the */ -/* input time string. */ - - -/* The following parameters serve as an enumeration of the various */ -/* time formats that are recognized. */ - - -/* The parameters below are used to declare the space needed for */ -/* scanning the input format string. */ - - -/* The length of the local string that we will use for copying */ -/* the format string. */ - - -/* Local variables */ - - -/* The next set of variables holds the marks and auxiliary */ -/* arrays used for scanning the format string. */ - - -/* The variables below are used to hold, base formats, values of */ -/* time vector components, adjustments to use when rounding, */ -/* the lengths of the format pictures and whether or not various */ -/* components have already been computed. */ - - -/* The array below contains the indexes of the various values */ -/* associated with the three different times of time vectors */ -/* that we will be using YMD, YD, CONTIN. */ - - -/* We will be making a local copy of the input format string */ -/* and the input time. */ - - -/* The integers below are used to mark substring boundaries. */ - - -/* Times come in three flavors: TDT, TDB, UTC. The one for used */ -/* on this particular invocation of TIMOUT is stored in TIMTYP. */ -/* The routine TTRANS needs to have input and output time vector */ -/* types. The one used based upon the input PICTUR is stored */ -/* in BASTYP. */ - - -/* Loop counters and delimiters */ - - -/* Utility double precision numbers */ - - -/* The array power is used to assist in the truncation of double */ -/* precision values. */ - - -/* calendar variables. */ - - -/* Character string representations for months and week days. */ - - -/* Save everything. */ - - -/* Initial values */ - - if (return_()) { - return 0; - } - chkin_("TIMOUT", (ftnlen)6); - -/* Chapter 1. Initializations. */ -/* ================================================================= */ - -/* On the first pass, we need to set up the recognized tokens */ -/* that will be used for scanning, the classes of these tokens */ -/* and the array of ID's for time systems. */ - - if (first) { - first = FALSE_; - s_copy(marks, "YYYY", (ftnlen)8, (ftnlen)4); - s_copy(marks + 8, "YR", (ftnlen)8, (ftnlen)2); - s_copy(marks + 16, "MON", (ftnlen)8, (ftnlen)3); - s_copy(marks + 24, "Mon", (ftnlen)8, (ftnlen)3); - s_copy(marks + 32, "mon", (ftnlen)8, (ftnlen)3); - s_copy(marks + 40, "MONTH", (ftnlen)8, (ftnlen)5); - s_copy(marks + 48, "Month", (ftnlen)8, (ftnlen)5); - s_copy(marks + 56, "month", (ftnlen)8, (ftnlen)5); - s_copy(marks + 64, "MM", (ftnlen)8, (ftnlen)2); - s_copy(marks + 72, "DOY", (ftnlen)8, (ftnlen)3); - s_copy(marks + 80, "WKD", (ftnlen)8, (ftnlen)3); - s_copy(marks + 88, "Wkd", (ftnlen)8, (ftnlen)3); - s_copy(marks + 96, "wkd", (ftnlen)8, (ftnlen)3); - s_copy(marks + 104, "WEEKDAY", (ftnlen)8, (ftnlen)7); - s_copy(marks + 112, "Weekday", (ftnlen)8, (ftnlen)7); - s_copy(marks + 120, "weekday", (ftnlen)8, (ftnlen)7); - s_copy(marks + 128, "DD", (ftnlen)8, (ftnlen)2); - s_copy(marks + 136, "MN", (ftnlen)8, (ftnlen)2); - s_copy(marks + 144, "HR", (ftnlen)8, (ftnlen)2); - s_copy(marks + 152, "SC", (ftnlen)8, (ftnlen)2); - s_copy(marks + 160, ".#", (ftnlen)8, (ftnlen)2); - s_copy(marks + 168, "#", (ftnlen)8, (ftnlen)1); - s_copy(marks + 176, "JULIAND", (ftnlen)8, (ftnlen)7); - s_copy(marks + 184, "::UTC", (ftnlen)8, (ftnlen)5); - s_copy(marks + 192, "::TDB", (ftnlen)8, (ftnlen)5); - s_copy(marks + 200, "::TDT", (ftnlen)8, (ftnlen)5); - s_copy(marks + 208, "SP2000", (ftnlen)8, (ftnlen)6); - s_copy(marks + 216, "SP1950", (ftnlen)8, (ftnlen)6); - s_copy(marks + 224, "::RND", (ftnlen)8, (ftnlen)5); - s_copy(marks + 232, "::TRNC", (ftnlen)8, (ftnlen)6); - s_copy(marks + 240, "ERA", (ftnlen)8, (ftnlen)3); - s_copy(marks + 248, "era", (ftnlen)8, (ftnlen)3); - s_copy(marks + 256, "AMPM", (ftnlen)8, (ftnlen)4); - s_copy(marks + 264, "ampm", (ftnlen)8, (ftnlen)4); - s_copy(marks + 272, "::UTC+", (ftnlen)8, (ftnlen)6); - s_copy(marks + 280, "::UTC-", (ftnlen)8, (ftnlen)6); - s_copy(marks + 288, "::JCAL", (ftnlen)8, (ftnlen)6); - s_copy(marks + 296, "::GCAL", (ftnlen)8, (ftnlen)6); - s_copy(marks + 304, "::MCAL", (ftnlen)8, (ftnlen)6); - s_copy(marks + 312, "AP", (ftnlen)8, (ftnlen)2); - s_copy(marks + 320, "?ERA?", (ftnlen)8, (ftnlen)5); - s_copy(marks + 328, "?era?", (ftnlen)8, (ftnlen)5); - nmarks = 42; - scanpr_(&nmarks, marks, mrklen, pntrs, (ftnlen)8); - -/* Now that we've prepared our recognized substrings and */ -/* auxiliary arrays for scanning, collect the id's of the */ -/* various marks and classify the various marks. */ -/* substrings. */ - - id[1] = 0; - id[2] = bsrchc_("YYYY", &nmarks, marks, (ftnlen)4, (ftnlen)8); - id[3] = bsrchc_("YR", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[4] = bsrchc_("MON", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[5] = bsrchc_("Mon", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[6] = bsrchc_("mon", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[7] = bsrchc_("MONTH", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[8] = bsrchc_("Month", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[9] = bsrchc_("month", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[10] = bsrchc_("MM", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[11] = bsrchc_("DOY", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[12] = bsrchc_("WKD", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[13] = bsrchc_("Wkd", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[14] = bsrchc_("wkd", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[15] = bsrchc_("WEEKDAY", &nmarks, marks, (ftnlen)7, (ftnlen)8); - id[16] = bsrchc_("Weekday", &nmarks, marks, (ftnlen)7, (ftnlen)8); - id[17] = bsrchc_("weekday", &nmarks, marks, (ftnlen)7, (ftnlen)8); - id[18] = bsrchc_("DD", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[19] = bsrchc_("MN", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[20] = bsrchc_("HR", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[21] = bsrchc_("SC", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[22] = bsrchc_(".#", &nmarks, marks, (ftnlen)2, (ftnlen)8); - id[23] = bsrchc_("#", &nmarks, marks, (ftnlen)1, (ftnlen)8); - id[24] = bsrchc_("JULIAND", &nmarks, marks, (ftnlen)7, (ftnlen)8); - id[25] = bsrchc_("::UTC", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[26] = bsrchc_("::TDB", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[27] = bsrchc_("::TDT", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[28] = bsrchc_("SP2000", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[29] = bsrchc_("SP1950", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[30] = bsrchc_("::RND", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[31] = bsrchc_("::TRNC", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[32] = bsrchc_("ERA", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[33] = bsrchc_("era", &nmarks, marks, (ftnlen)3, (ftnlen)8); - id[34] = bsrchc_("?ERA?", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[35] = bsrchc_("?era?", &nmarks, marks, (ftnlen)5, (ftnlen)8); - id[36] = bsrchc_("AMPM", &nmarks, marks, (ftnlen)4, (ftnlen)8); - id[37] = bsrchc_("ampm", &nmarks, marks, (ftnlen)4, (ftnlen)8); - id[38] = bsrchc_("::UTC+", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[39] = bsrchc_("::UTC-", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[40] = bsrchc_("::JCAL", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[41] = bsrchc_("::GCAL", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[42] = bsrchc_("::MCAL", &nmarks, marks, (ftnlen)6, (ftnlen)8); - id[45] = bsrchc_("AP", &nmarks, marks, (ftnlen)2, (ftnlen)8); - class__[(i__1 = id[1]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1168)] = 2; - class__[(i__1 = id[2]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1169)] = 3; - class__[(i__1 = id[3]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1170)] = 4; - class__[(i__1 = id[4]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1171)] = 47; - class__[(i__1 = id[5]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1172)] = 47; - class__[(i__1 = id[6]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1173)] = 47; - class__[(i__1 = id[7]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1174)] = 47; - class__[(i__1 = id[8]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1175)] = 47; - class__[(i__1 = id[9]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1176)] = 47; - class__[(i__1 = id[10]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1177)] = 11; - class__[(i__1 = id[11]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1178)] = 12; - class__[(i__1 = id[12]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1179)] = 48; - class__[(i__1 = id[13]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1180)] = 48; - class__[(i__1 = id[14]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1181)] = 48; - class__[(i__1 = id[15]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1182)] = 48; - class__[(i__1 = id[16]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1183)] = 48; - class__[(i__1 = id[17]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1184)] = 48; - class__[(i__1 = id[18]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1185)] = 19; - class__[(i__1 = id[19]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1186)] = 20; - class__[(i__1 = id[20]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1187)] = 21; - class__[(i__1 = id[21]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1188)] = 22; - class__[(i__1 = id[22]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1189)] = 23; - class__[(i__1 = id[23]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1190)] = 24; - class__[(i__1 = id[24]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1191)] = 25; - class__[(i__1 = id[25]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1192)] = 44; - class__[(i__1 = id[26]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1193)] = 44; - class__[(i__1 = id[27]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1194)] = 44; - class__[(i__1 = id[28]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1195)] = 29; - class__[(i__1 = id[29]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1196)] = 30; - class__[(i__1 = id[30]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1197)] = 31; - class__[(i__1 = id[31]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1198)] = 32; - class__[(i__1 = id[32]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1199)] = 49; - class__[(i__1 = id[33]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1200)] = 49; - class__[(i__1 = id[34]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1201)] = 49; - class__[(i__1 = id[35]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1202)] = 49; - class__[(i__1 = id[36]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1203)] = 50; - class__[(i__1 = id[37]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1204)] = 50; - class__[(i__1 = id[38]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1205)] = 44; - class__[(i__1 = id[39]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1206)] = 44; - class__[(i__1 = id[40]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1207)] = 45; - class__[(i__1 = id[41]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1208)] = 45; - class__[(i__1 = id[42]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1209)] = 45; - class__[(i__1 = id[45]) < 43 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "timout_", (ftnlen)1210)] = 46; - for (i__ = 1; i__ <= 51; ++i__) { - pad[(i__1 = i__ - 1) < 51 && 0 <= i__1 ? i__1 : s_rnge("pad", - i__1, "timout_", (ftnlen)1213)] = 0.; - } - pad[21] = .5; - pad[19] = pad[21] * 60.; - pad[20] = pad[19] * 60.; - pad[18] = pad[20] * 24.; - pad[10] = pad[18] * 30.; - pad[11] = pad[18]; - pad[46] = pad[10]; - pad[2] = pad[18] * 365.; - pad[3] = pad[18] * 365.; - pad[24] = pad[18]; - pad[28] = pad[21]; - pad[29] = pad[21]; - pad[45] = pad[20]; - -/* After we've made the initial scan for tokens and determined */ -/* the time system requested, we will want to get rid of the */ -/* time system tokens. */ - - dump[0] = id[25]; - dump[1] = id[27]; - dump[2] = id[26]; - dump[3] = id[30]; - dump[4] = id[31]; - dump[5] = id[39]; - dump[6] = id[38]; - dump[7] = id[40]; - dump[8] = id[41]; - dump[9] = id[42]; - ndump = 10; - -/* Set up the default formats for the various time components */ - - s_copy(orignl + 64, "YYYY", (ftnlen)32, (ftnlen)4); - length[2] = 4; - s_copy(orignl + 96, "0Y", (ftnlen)32, (ftnlen)2); - length[3] = 2; - s_copy(orignl + 352, "0DD", (ftnlen)32, (ftnlen)3); - length[11] = 3; - s_copy(orignl + 576, "0D", (ftnlen)32, (ftnlen)2); - length[18] = 2; - s_copy(orignl + 320, "0M", (ftnlen)32, (ftnlen)2); - length[10] = 2; - s_copy(orignl + 640, "0H", (ftnlen)32, (ftnlen)2); - length[20] = 2; - s_copy(orignl + 1440, "0H", (ftnlen)32, (ftnlen)2); - length[45] = 2; - s_copy(orignl + 608, "0M", (ftnlen)32, (ftnlen)2); - length[19] = 2; - s_copy(orignl + 672, "0S", (ftnlen)32, (ftnlen)2); - length[21] = 2; - s_copy(orignl + 768, "XXXXXXX", (ftnlen)32, (ftnlen)7); - length[24] = 7; - s_copy(orignl + 896, "XXXXXXXXXXX", (ftnlen)32, (ftnlen)11); - length[28] = 11; - s_copy(orignl + 928, "XXXXXXXXXXX", (ftnlen)32, (ftnlen)11); - length[29] = 11; - -/* Finally set up the component pointers... */ - - compnt[0] = 51; - compnt[1] = 11; - compnt[2] = 19; - compnt[3] = 21; - compnt[4] = 20; - compnt[5] = 22; - compnt[8] = 1; - } - -/* Chapter 2. Parsing the input picture. */ -/* ============================================================== */ - -/* First let's copy the input picture into local storage */ -/* (left justified) and get just past the end of the */ -/* significant portion (this way the loop that constructs the */ -/* output string will terminate with no unfinished business */ -/* left to resolve). */ - - s_copy(mystr, " ", (ftnlen)256, (ftnlen)1); - ljust_(pictur, mystr, pictur_len, (ftnlen)255); - e = rtrim_(mystr, (ftnlen)256) + 1; - start = 1; - -/* Scan the input string. */ - - scan_(mystr, marks, mrklen, pntrs, &c__100, &start, &ntokns, ident, beg, - end, e, (ftnlen)8); - -/* Locate the time system that will be used. This must */ -/* be one of the following: UTC, TDB, TDT */ - - unknwn = TRUE_; - go2jul = FALSE_; - dozone = FALSE_; - i__ = 1; - hoff = 0.; - moff = 0.; - -/* Get the default time type from TIMDEF */ - - timdef_("GET", "SYSTEM", tsys, (ftnlen)3, (ftnlen)6, (ftnlen)16); - if (s_cmp(tsys, "UTC", (ftnlen)16, (ftnlen)3) == 0) { - timtyp = id[25]; - } else if (s_cmp(tsys, "TDB", (ftnlen)16, (ftnlen)3) == 0) { - timtyp = id[26]; - } else if (s_cmp(tsys, "TDT", (ftnlen)16, (ftnlen)3) == 0) { - timtyp = id[27]; - } else { - timtyp = id[38]; - timdef_("GET", "ZONE", zon, (ftnlen)3, (ftnlen)4, (ftnlen)32); - prefix_("::", &c__0, zon, (ftnlen)2, (ftnlen)32); - zzutcpm_(zon, &c__1, &hoff, &moff, &last, &ok, (ftnlen)32); - dozone = ok; - -/* The routine TIMDEF uses ZZUTCPM to determine whether */ -/* or not a time zone is legitimate before it stores it */ -/* to be "GOTTEN." As a result the value of OK should */ -/* always be TRUE. However, just in case TIMDEF should */ -/* someday use something other that ZZUTCPM for checking */ -/* we put in the unneeded check below. */ - - if (! ok) { - timtyp = id[25]; - } - } - while(unknwn && i__ <= ntokns) { - if (class__[(i__2 = ident[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ident", i__1, "timout_", (ftnlen)1372)]) < 43 && 0 <= - i__2 ? i__2 : s_rnge("class", i__2, "timout_", (ftnlen)1372)] - == 44) { - timtyp = ident[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ident", i__1, "timout_", (ftnlen)1373)]; - unknwn = FALSE_; - dozone = FALSE_; - if (ident[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "ident", i__1, "timout_", (ftnlen)1377)] == id[38] || - ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "timout_", (ftnlen)1377)] == id[39]) { - -/* We've got a time zone specification. Parse it and */ -/* store the offsets from UTC. */ - - zzutcpm_(mystr, &beg[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("beg", i__1, "timout_", (ftnlen)1384)], - &hoff, &moff, &last, &ok, (ftnlen)256); - if (ok) { - dozone = TRUE_; - timtyp = id[38]; - -/* If we ran all the way up to the end of the next */ -/* token, we simply reset the identity of the next */ -/* token to be a zone type and increment I. */ - -/* This way we never see the next token in this loop */ -/* and it gets removed later when time systems and */ -/* other meta markers from our copy of the time */ -/* format string. */ - - if (last == end[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : - s_rnge("end", i__1, "timout_", (ftnlen)1401)]) { - ident[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "ident", i__1, "timout_", (ftnlen)1402)] = - ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("ident", i__2, "timout_", ( - ftnlen)1402)]; - ++i__; - } else { - end[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("end", i__1, "timout_", (ftnlen)1405)] - = last; - beg[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge( - "beg", i__1, "timout_", (ftnlen)1406)] = last - + 1; - } - } - } - } - ++i__; - } - -/* Determine whether we should use the Julian or gregorian (default) */ -/* calendar */ - - unknwn = TRUE_; - i__ = 1; - -/* Get the default calendar from TIMDEF. */ - - timdef_("GET", "CALENDAR", cal, (ftnlen)3, (ftnlen)8, (ftnlen)16); - if (s_cmp(cal, "GREGORIAN", (ftnlen)16, (ftnlen)9) == 0) { - caltyp = id[41]; - } else if (s_cmp(cal, "JULIAN", (ftnlen)16, (ftnlen)6) == 0) { - caltyp = id[40]; - } else { - caltyp = id[42]; - } - while(unknwn && i__ <= ntokns) { - if (class__[(i__2 = ident[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ident", i__1, "timout_", (ftnlen)1442)]) < 43 && 0 <= - i__2 ? i__2 : s_rnge("class", i__2, "timout_", (ftnlen)1442)] - == 45) { - caltyp = ident[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ident", i__1, "timout_", (ftnlen)1443)]; - unknwn = FALSE_; - } - ++i__; - } - -/* Next determine whether or not we shall be performing rounding */ -/* on output. */ - - pumpup = isrchi_(&id[30], &ntokns, ident) != 0; - -/* Determine if we have an Era specification */ - - doera = isrchi_(&id[33], &ntokns, ident) != 0 || isrchi_(&id[32], &ntokns, - ident) != 0 || isrchi_(&id[34], &ntokns, ident) != 0 || isrchi_(& - id[35], &ntokns, ident) != 0; - -/* Until we've examined the year, we assume that the era is not */ -/* supposed to vanish. */ - - vanish = FALSE_; - -/* Next remove all of the time system dudes from the list of */ -/* tokens. */ - - scanrj_(dump, &ndump, &ntokns, ident, beg, end); - -/* If the user wants to round the output, we need to pump up ET */ -/* by the smallest significant part of the input picture. But */ -/* in either case we are going to pad the input time. For now */ -/* we pad it by zero. */ - - timpad = 0.; - if (pumpup) { - -/* We need to determine the amount to pad ET by. So we need */ -/* to look at the string and find the least significant component */ -/* that has been requested. Keep in mind that the last token */ -/* is of type NONAME (its a blank) by construction. */ - - i__ = 1; - while(i__ <= ntokns) { - type__ = class__[(i__2 = ident[(i__1 = i__ - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("ident", i__1, "timout_", (ftnlen) - 1497)]) < 43 && 0 <= i__2 ? i__2 : s_rnge("class", i__2, - "timout_", (ftnlen)1497)]; - if (type__ == 2 || type__ == 23 || type__ == 24 || type__ == 50 || - type__ == 49 || type__ == 47 || type__ == 48) { - -/* Don't do anything, just go on to the next token. */ - - ++i__; - } else { - -/* Look up the amount we should pad our time by. */ - - factor = 1.; - incr = pad[(i__1 = type__ - 1) < 51 && 0 <= i__1 ? i__1 : - s_rnge("pad", i__1, "timout_", (ftnlen)1518)]; - -/* Examine the next token. If it's not a decimal point */ -/* and marker, we have the least significant part of */ -/* this component. */ - - ++i__; - type__ = class__[(i__2 = ident[(i__1 = i__ - 1) < 100 && 0 <= - i__1 ? i__1 : s_rnge("ident", i__1, "timout_", ( - ftnlen)1526)]) < 43 && 0 <= i__2 ? i__2 : s_rnge( - "class", i__2, "timout_", (ftnlen)1526)]; - if (type__ == 23) { - factor *= .1; - ++i__; - -/* Now just look for the end of the string of place */ -/* holders */ - - while(ident[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("ident", i__1, "timout_", (ftnlen)1537)] == - id[23]) { - factor *= .1; - ++i__; - } - } - -/* Now compute the time pad for this component of the */ -/* time string. */ - - incr *= factor; - if (timpad != 0.) { - timpad = min(timpad,incr); - } else { - timpad = incr; - } - } - } - } - -/* Right now we don't have any components of the time format */ -/* and we don't need any of them so far. */ - - for (part = 1; part <= 51; ++part) { - have[(i__1 = part - 1) < 51 && 0 <= i__1 ? i__1 : s_rnge("have", i__1, - "timout_", (ftnlen)1567)] = FALSE_; - } - -/* Set up the input time format and the output time format that will */ -/* be used later. */ - -/* The input time format is used to convert the basic ET we have now */ -/* to one of the various time formats that are supported by the */ -/* routine TTRANS. If we are going to construct a string in one of */ -/* the dynamical time systems we will call the input time a formal */ -/* time in seconds past a formal calendar epoch of J2000. If on the */ -/* other hand we are going to construct a UTC based string, we will */ -/* convert our ET to an earth based epoch (TDT) and use this as our */ -/* base input system. */ - - - myet = *et; - if (timtyp == id[26]) { - -/* Since we are likely to need SP2000, SP1950 or JD, we */ -/* compute them now. */ - - myet += timpad; - values[28] = myet; - values[24] = unitim_(&myet, "TDB", "JDTDB", (ftnlen)3, (ftnlen)5); - values[29] = values[28] + spd_() * (j2000_() - j1950_()); - s_copy(bastyp, "FORMAL", (ftnlen)16, (ftnlen)6); - s_copy(ymdfmt, "YMDF", (ftnlen)8, (ftnlen)4); - s_copy(ywfmt, "YMWDF", (ftnlen)8, (ftnlen)5); - have[28] = TRUE_; - have[29] = TRUE_; - have[24] = TRUE_; - } else if (timtyp == id[27]) { - myet = unitim_(&myet, "TDB", "TDT", (ftnlen)3, (ftnlen)3) + timpad; - values[28] = myet; - values[24] = unitim_(&myet, "TDT", "JDTDT", (ftnlen)3, (ftnlen)5); - values[29] = values[28] + spd_() * (j2000_() - j1950_()); - s_copy(bastyp, "FORMAL", (ftnlen)16, (ftnlen)6); - s_copy(ymdfmt, "YMDF", (ftnlen)8, (ftnlen)4); - s_copy(ywfmt, "YMWDF", (ftnlen)8, (ftnlen)5); - have[28] = TRUE_; - have[29] = TRUE_; - have[24] = TRUE_; - } else { - -/* In this case we convert to an earth based frame for our */ -/* working epoch. This rounds properly when it's time to get */ -/* fractional components. */ - - myet = unitim_(&myet, "TDB", "TDT", (ftnlen)3, (ftnlen)3) + timpad; - s_copy(bastyp, "TDT", (ftnlen)16, (ftnlen)3); - s_copy(ymdfmt, "YMD", (ftnlen)8, (ftnlen)3); - s_copy(ywfmt, "YMWD", (ftnlen)8, (ftnlen)4); - } - -/* Chapter 3. Building the Output String */ -/* ================================================================== */ - - -/* Now we are ready to go, we need to fetch the tokens */ -/* and construct the output string. We will */ -/* put the next portion of the output at APPND */ - - appnd = 1; - making = FALSE_; - i__1 = ntokns; - for (i__ = 1; i__ <= i__1; ++i__) { - type__ = class__[(i__3 = ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("ident", i__2, "timout_", (ftnlen)1648)]) < 43 - && 0 <= i__3 ? i__3 : s_rnge("class", i__3, "timout_", ( - ftnlen)1648)]; - tvec[0] = myet; - -/* If the next marker is not one we use as a place holder */ -/* in the fractional part of decimal formats AND we */ -/* are in the process of building a format, then the format */ -/* building is done. We can construct the component and */ -/* append it to the string we are building. */ - - if (type__ != 24 && making) { - -/* We also need to be sure this isn't a decimal point */ -/* marker before we add on to the output string. */ - - if (type__ != 23 || have[22]) { - -/* We are going to truncate the number to the number of */ -/* places requested NOT round. */ - - i__3 = width - length[(i__2 = numtyp - 1) < 51 && 0 <= i__2 ? - i__2 : s_rnge("length", i__2, "timout_", (ftnlen)1670) - ] - 1; - trncat = brckti_(&i__3, &c__0, &c__14); - frac = value - d_int(&value); - if (frac < 0.) { - value += -1.; - frac += 1.; - } - d__1 = frac * power[(i__2 = trncat) < 15 && 0 <= i__2 ? i__2 : - s_rnge("power", i__2, "timout_", (ftnlen)1678)]; - intmed = (d_int(&d__1) - .125) / power[(i__3 = trncat) < 15 && - 0 <= i__3 ? i__3 : s_rnge("power", i__3, "timout_", ( - ftnlen)1678)]; - frac = brcktd_(&intmed, &c_b274, &c_b275); - value = d_int(&value) + frac; - dpfmt_(&value, fmt, substr, (ftnlen)32, (ftnlen)256); - s_copy(string + (appnd - 1), substr, 256 - (appnd - 1), ( - ftnlen)256); - appnd += width; - have[22] = FALSE_; - making = FALSE_; - } - } - -/* If the token isn't recognized we can just */ -/* append it to the string we are constructing and */ -/* adjust the point at which the next substring is */ -/* to be appended. */ - - if (type__ == 2) { - i__2 = beg[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "beg", i__3, "timout_", (ftnlen)1705)] - 1; - s_copy(string + (appnd - 1), mystr + i__2, 256 - (appnd - 1), end[ - (i__4 = i__ - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge("end", - i__4, "timout_", (ftnlen)1705)] - i__2); - appnd = appnd - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "timout_", (ftnlen)1706)] + end[(i__3 - = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge("end", i__3, - "timout_", (ftnlen)1706)] + 1; - -/* If the token is a place holder, we either just append it */ -/* or tack it on to a format string we are creating.. */ - - } else if (type__ == 24) { - if (making) { - b = width + 1; - e = b - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "timout_", (ftnlen)1717)] + end[( - i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "end", i__3, "timout_", (ftnlen)1717)]; - i__2 = beg[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("beg", i__3, "timout_", (ftnlen)1718)] - 1; - s_copy(fmt + (b - 1), mystr + i__2, e - (b - 1), end[(i__4 = - i__ - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge("end", - i__4, "timout_", (ftnlen)1718)] - i__2); - width = width - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("beg", i__2, "timout_", (ftnlen)1719)] - + end[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("end", i__3, "timout_", (ftnlen)1719)] + 1; - } else { - i__2 = beg[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("beg", i__3, "timout_", (ftnlen)1721)] - 1; - s_copy(string + (appnd - 1), mystr + i__2, (ftnlen)1, end[( - i__4 = i__ - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge( - "end", i__4, "timout_", (ftnlen)1721)] - i__2); - appnd = appnd - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? - i__2 : s_rnge("beg", i__2, "timout_", (ftnlen)1722)] - + end[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("end", i__3, "timout_", (ftnlen)1722)] + 1; - } - -/* If the token is the decimal point plus place holder */ -/* AND we are making a format, we append it to the current */ -/* format and determine the fractional part of the current */ -/* quantity. */ - - } else if (type__ == 23) { - if (! making) { - b = appnd; - e = appnd - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "timout_", (ftnlen)1736)] + end[( - i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "end", i__3, "timout_", (ftnlen)1736)]; - i__2 = beg[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("beg", i__3, "timout_", (ftnlen)1737)] - 1; - s_copy(string + (b - 1), mystr + i__2, e - (b - 1), end[(i__4 - = i__ - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge("end", - i__4, "timout_", (ftnlen)1737)] - i__2); - appnd = e + 1; - have[22] = FALSE_; - } else if (timfmt == 2) { - b = width + 1; - e = b - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "timout_", (ftnlen)1744)] + end[( - i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "end", i__3, "timout_", (ftnlen)1744)]; - i__2 = beg[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("beg", i__3, "timout_", (ftnlen)1745)] - 1; - s_copy(fmt + (b - 1), mystr + i__2, e - (b - 1), end[(i__4 = - i__ - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge("end", - i__4, "timout_", (ftnlen)1745)] - i__2); - width = e; - have[22] = TRUE_; - } else { - b = width + 1; - e = b - beg[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "timout_", (ftnlen)1752)] + end[( - i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "end", i__3, "timout_", (ftnlen)1752)]; - i__2 = beg[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("beg", i__3, "timout_", (ftnlen)1753)] - 1; - s_copy(fmt + (b - 1), mystr + i__2, e - (b - 1), end[(i__4 = - i__ - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge("end", - i__4, "timout_", (ftnlen)1753)] - i__2); - width = e; - have[22] = TRUE_; - -/* Since we obviously are going to be needing */ -/* the fractional part of this component we fetch it */ -/* now and add it to whatever the integer part of the */ -/* current value is. Here's how we do this. */ -/* If we truncated the input time to this component */ -/* we'd have a value on an "integer" portion of the */ -/* time scale. */ -/* . */ -/* . current */ -/* . time */ -/* . truncated .---MYET */ -/* | | */ -/* v v */ -/* time scale: ---------+-------X-----------+----- */ -/* ^ */ -/* | */ -/* . truncated time */ -/* . plus 1 in this */ -/* . component */ -/* . */ -/* Add one to the truncated component to get the */ -/* next integer component. Finally we convert these */ -/* two constructed stings to seconds so that we can */ -/* get the "fractional part" of the current component. */ -/* Fortunately, when we computed the integer value */ -/* for this component we constructed the time */ -/* vectors we need, so we don't have to go to a lot */ -/* of trouble now. */ - - ttrans_(intyp, bastyp, ptvec, (ftnlen)16, (ftnlen)16); - ttrans_(intyp, bastyp, ntvec, (ftnlen)16, (ftnlen)16); -/* Computing MAX */ - d__1 = 1., d__2 = ntvec[0] - ptvec[0]; - delta = max(d__1,d__2); - d__1 = (myet - ptvec[0]) / delta; - frac = brcktd_(&c_b274, &c_b275, &d__1); - value += frac; - } - } else { - -/* If we get to this point we have an honest time */ -/* string component to fetch. We might already have */ -/* this guy. If so we can just collect him from the */ -/* values buffer (although this collection is performed */ -/* after the next long IF-THEN block that gets the value */ -/* if we don't already have it). */ - - making = TRUE_; - have[22] = FALSE_; - s_copy(fmt, orignl + (((i__2 = type__ - 1) < 51 && 0 <= i__2 ? - i__2 : s_rnge("orignl", i__2, "timout_", (ftnlen)1810)) << - 5), (ftnlen)32, (ftnlen)32); - width = length[(i__2 = type__ - 1) < 51 && 0 <= i__2 ? i__2 : - s_rnge("length", i__2, "timout_", (ftnlen)1811)]; - numtyp = type__; - if (! have[(i__2 = type__ - 1) < 51 && 0 <= i__2 ? i__2 : s_rnge( - "have", i__2, "timout_", (ftnlen)1814)]) { - tvec[0] = myet; - -/* Most components are handled in the next block. */ - - if (type__ == 3 || type__ == 4 || type__ == 11 || type__ == - 47 || type__ == 19 || type__ == 12 || type__ == 50 || - type__ == 21 || type__ == 49 || type__ == 46 || - type__ == 20 || type__ == 22) { - ttrans_(bastyp, ymdfmt, tvec, (ftnlen)16, (ftnlen)8); - -/* The seconds component is finished. Regardless */ -/* of any zone or calendar modifications, we just */ -/* don't have to deal with this component any more. */ - - values[21] = tvec[5]; - -/* If we need to deal with time zones, this is */ -/* the time to do it. */ - - if (timtyp == id[38]) { - tvec[3] += hoff; - tvec[4] += moff; - tvec[5] = 0.; - ttrans_("YMDF", "YMDF", tvec, (ftnlen)4, (ftnlen)4); - } - -/* One way or the other the hours and minutes components */ -/* are finished. Record their values. */ - - values[20] = tvec[3]; - values[19] = tvec[4]; - if (values[20] == 0.) { - values[45] = 12.; - } else if (values[20] > 12.) { - values[45] = values[20] - 12.; - } else { - values[45] = values[20]; - } - -/* Finally, if we need to change the calendar to */ -/* Julian this is the place to handle it. */ - - jyear = i_dnnt(tvec); - jmonth = i_dnnt(&tvec[1]); - jday = i_dnnt(&tvec[2]); - gr2jul_(&jyear, &jmonth, &jday, &jdoy); - gyear = jyear; - gmonth = jmonth; - gday = jday; - jul2gr_(&gyear, &gmonth, &gday, &gdoy); - if (caltyp == id[41]) { - values[2] = (doublereal) gyear; - values[10] = (doublereal) gmonth; - values[18] = (doublereal) gday; - values[11] = (doublereal) gdoy; - go2jul = FALSE_; - } else if (caltyp == id[40]) { - values[2] = (doublereal) jyear; - values[10] = (doublereal) jmonth; - values[18] = (doublereal) jday; - values[11] = (doublereal) jdoy; - go2jul = TRUE_; - } else if (caltyp == id[42]) { - if (gyear < 1582) { - go2jul = TRUE_; - } else if (gyear > 1582) { - go2jul = FALSE_; - } else if (gmonth < 10) { - go2jul = TRUE_; - } else if (gmonth > 10) { - go2jul = FALSE_; - } else if (gday >= 15) { - go2jul = FALSE_; - } else { - go2jul = TRUE_; - } - if (go2jul) { - values[2] = (doublereal) jyear; - values[10] = (doublereal) jmonth; - values[18] = (doublereal) jday; - values[11] = (doublereal) jdoy; - } else { - values[2] = (doublereal) gyear; - values[10] = (doublereal) gmonth; - values[18] = (doublereal) gday; - values[11] = (doublereal) gdoy; - } - } - -/* Determine the era associated with the epoch. Also */ -/* if the year component is negative, we handle that */ -/* now. */ - -/* We store the actual value of the year so that */ -/* it can be used when determining rounding of */ -/* other components. */ - - values[50] = values[2]; - if (doera) { - if (values[2] < 1.) { - values[2] = 1. - values[2]; - values[48] = 1.; - } else { - values[48] = 2.; - } - vanish = values[2] >= 1e3; - } - -/* Fetch the last two digits of the year. */ - - rmaind_(&values[2], &c_b338, &x, &tempd); - values[3] = tempd; - have[2] = TRUE_; - have[3] = TRUE_; - have[11] = TRUE_; - have[10] = TRUE_; - have[46] = TRUE_; - have[18] = TRUE_; - have[20] = TRUE_; - have[19] = TRUE_; - have[21] = TRUE_; - have[45] = TRUE_; - have[48] = TRUE_; - } else if (type__ == 48) { - tvec[0] = myet; - ttrans_(bastyp, ywfmt, tvec, (ftnlen)16, (ftnlen)8); - -/* If we need to deal with time zones, this is */ -/* the time to do it. */ - - if (timtyp == id[38]) { - tvec[4] += hoff; - tvec[5] += moff; - tvec[6] = 0.; - ttrans_("YMWDF", "YMWDF", tvec, (ftnlen)5, (ftnlen)5); - } - values[47] = tvec[3]; - have[47] = TRUE_; - } else if (type__ == 30 || type__ == 29) { - -/* The only way to get here is if the output time */ -/* type is UTC or a time zone (otherwise we'd */ -/* already HAVE SP2000 and SP1950). */ - - tvec[0] = myet; - ttrans_(bastyp, "FORMAL", tvec, (ftnlen)16, (ftnlen)6); - values[28] = tvec[0]; - values[29] = values[28] + spd_() * (j2000_() - j1950_()); - have[28] = TRUE_; - have[29] = TRUE_; - } else if (type__ == 25) { - -/* The same tale can be told here as in the last */ -/* case. We can only get here if this is UTC */ -/* output. */ - - tvec[0] = myet; - ttrans_(bastyp, "JDUTC", tvec, (ftnlen)16, (ftnlen)5); - values[24] = tvec[0]; - have[24] = TRUE_; - } - } - -/* O.K. whatever thing we are about to construct, we now */ -/* have it's numeric value. It's time to construct its */ -/* string value. */ - - -/* We need to treat character months, weekdays, eras, a.m.'s */ -/* and p.m.'s specially. */ - - if (type__ == 47) { - indx = i_dnnt(&values[10]); - s_copy(mymon, months + ((i__2 = indx - 1) < 12 && 0 <= i__2 ? - i__2 : s_rnge("months", i__2, "timout_", (ftnlen)2054) - ) * 9, (ftnlen)9, (ftnlen)9); - montyp = ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "timout_", (ftnlen)2055)]; - -/* There is no ELSE case in the block below because all of */ -/* the possible MONTYP values are checked explicitly. */ - - if (montyp == id[4]) { - ucase_(mymon, mymon, (ftnlen)9, (ftnlen)9); - s_copy(mymon + 3, " ", (ftnlen)6, (ftnlen)1); - mylen = 3; - } else if (montyp == id[5]) { - s_copy(mymon + 3, " ", (ftnlen)6, (ftnlen)1); - mylen = 3; - } else if (montyp == id[6]) { - lcase_(mymon, mymon, (ftnlen)9, (ftnlen)9); - s_copy(mymon + 3, " ", (ftnlen)6, (ftnlen)1); - mylen = 3; - } else if (montyp == id[8]) { - mylen = mlen[(i__2 = indx - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("mlen", i__2, "timout_", (ftnlen)2073)]; - } else if (montyp == id[7]) { - ucase_(mymon, mymon, (ftnlen)9, (ftnlen)9); - mylen = mlen[(i__2 = indx - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("mlen", i__2, "timout_", (ftnlen)2076)]; - } else if (montyp == id[9]) { - lcase_(mymon, mymon, (ftnlen)9, (ftnlen)9); - mylen = mlen[(i__2 = indx - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("mlen", i__2, "timout_", (ftnlen)2079)]; - } - s_copy(string + (appnd - 1), mymon, 256 - (appnd - 1), ( - ftnlen)9); - appnd += mylen; - making = FALSE_; - } else if (type__ == 48) { - indx = i_dnnt(&values[47]); - s_copy(mywkd, wkdays + ((i__2 = indx - 1) < 7 && 0 <= i__2 ? - i__2 : s_rnge("wkdays", i__2, "timout_", (ftnlen)2089) - ) * 9, (ftnlen)9, (ftnlen)9); - wktyp = ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "timout_", (ftnlen)2090)]; - -/* There is no ELSE case in the block below because all of */ -/* the possible WKTYP values are checked explicitly. */ - - if (wktyp == id[12]) { - ucase_(mywkd, mywkd, (ftnlen)9, (ftnlen)9); - s_copy(mywkd + 3, " ", (ftnlen)6, (ftnlen)1); - mylen = 3; - } else if (wktyp == id[13]) { - s_copy(mywkd + 3, " ", (ftnlen)6, (ftnlen)1); - mylen = 3; - } else if (wktyp == id[14]) { - lcase_(mywkd, mywkd, (ftnlen)9, (ftnlen)9); - s_copy(mywkd + 3, " ", (ftnlen)6, (ftnlen)1); - mylen = 3; - } else if (wktyp == id[16]) { - mylen = wklen[(i__2 = indx - 1) < 7 && 0 <= i__2 ? i__2 : - s_rnge("wklen", i__2, "timout_", (ftnlen)2108)]; - } else if (wktyp == id[15]) { - ucase_(mywkd, mywkd, (ftnlen)9, (ftnlen)9); - mylen = wklen[(i__2 = indx - 1) < 7 && 0 <= i__2 ? i__2 : - s_rnge("wklen", i__2, "timout_", (ftnlen)2111)]; - } else if (wktyp == id[17]) { - lcase_(mywkd, mywkd, (ftnlen)9, (ftnlen)9); - mylen = wklen[(i__2 = indx - 1) < 7 && 0 <= i__2 ? i__2 : - s_rnge("wklen", i__2, "timout_", (ftnlen)2114)]; - } - s_copy(string + (appnd - 1), mywkd, 256 - (appnd - 1), ( - ftnlen)9); - appnd += mylen; - making = FALSE_; - } else if (type__ == 49) { - if (values[48] == 2. && (ident[(i__2 = i__ - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("ident", i__2, "timout_", ( - ftnlen)2124)] == id[32] || ident[(i__3 = i__ - 1) < - 100 && 0 <= i__3 ? i__3 : s_rnge("ident", i__3, "tim" - "out_", (ftnlen)2124)] == id[34])) { - s_copy(string + (appnd - 1), " A.D.", 256 - (appnd - 1), ( - ftnlen)5); - } else if (values[48] == 2. && (ident[(i__2 = i__ - 1) < 100 - && 0 <= i__2 ? i__2 : s_rnge("ident", i__2, "timout_", - (ftnlen)2130)] == id[33] || ident[(i__3 = i__ - 1) < - 100 && 0 <= i__3 ? i__3 : s_rnge("ident", i__3, "tim" - "out_", (ftnlen)2130)] == id[35])) { - s_copy(string + (appnd - 1), " a.d.", 256 - (appnd - 1), ( - ftnlen)5); - } else if (values[48] == 1. && (ident[(i__2 = i__ - 1) < 100 - && 0 <= i__2 ? i__2 : s_rnge("ident", i__2, "timout_", - (ftnlen)2135)] == id[32] || ident[(i__3 = i__ - 1) < - 100 && 0 <= i__3 ? i__3 : s_rnge("ident", i__3, "tim" - "out_", (ftnlen)2135)] == id[34])) { - s_copy(string + (appnd - 1), " B.C.", 256 - (appnd - 1), ( - ftnlen)5); - } else { - s_copy(string + (appnd - 1), " b.c.", 256 - (appnd - 1), ( - ftnlen)5); - } - -/* If we have the vanishing kind of era, and we've */ -/* determined that it needs to vanish, then blank out the */ -/* portion of the string we just filled in. and don't */ -/* increment the place holder. */ - - if (ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "timout_", (ftnlen)2152)] == id[34] || - ident[(i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : - s_rnge("ident", i__3, "timout_", (ftnlen)2152)] == id[ - 35]) { - if (vanish) { - s_copy(string + (appnd - 1), " ", 256 - (appnd - 1), ( - ftnlen)1); - ++appnd; - } else { - appnd += 6; - } - } else { - ljust_(string + (appnd - 1), string + (appnd - 1), 256 - ( - appnd - 1), 256 - (appnd - 1)); - appnd += 4; - } - making = FALSE_; - } else if (type__ == 50) { - if (ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "timout_", (ftnlen)2172)] == id[36] && - values[20] >= 12.) { - s_copy(string + (appnd - 1), "P.M.", 256 - (appnd - 1), ( - ftnlen)4); - } else if (ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "timout_", (ftnlen)2177)] == id[ - 36] && values[20] < 12.) { - s_copy(string + (appnd - 1), "A.M.", 256 - (appnd - 1), ( - ftnlen)4); - } else if (ident[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "timout_", (ftnlen)2182)] == id[ - 37] && values[20] >= 12.) { - s_copy(string + (appnd - 1), "p.m.", 256 - (appnd - 1), ( - ftnlen)4); - } else { - s_copy(string + (appnd - 1), "a.m.", 256 - (appnd - 1), ( - ftnlen)4); - } - appnd += 4; - making = FALSE_; - } else { - value = values[(i__2 = type__ - 1) < 51 && 0 <= i__2 ? i__2 : - s_rnge("values", i__2, "timout_", (ftnlen)2198)]; - } - -/* If we are now creating a format string, we should */ -/* construct the previous time representation and */ -/* the next for this component (just in case we need it */ -/* later). */ - - if (making) { - -/* We store the value of our current type in the */ -/* CURRNT slot of the values array. This value */ -/* is used by the single numeric types, JD, SP2000, */ -/* and SP1950. */ - - values[0] = values[(i__2 = type__ - 1) < 51 && 0 <= i__2 ? - i__2 : s_rnge("values", i__2, "timout_", (ftnlen)2216) - ]; - -/* Here's how this works: We will copy all of */ -/* the components of the time representation up to */ -/* the current one. This is the truncated representation */ -/* of our epoch. We then copy these same components into */ -/* another time vector, but add an increment to the */ -/* component corresponding to the one we are dealing with */ -/* now. We use an increment of 0 for those components that */ -/* already contain their fractional part. We use an */ -/* increment of 1 for the components that typically have */ -/* integer representations. */ - - -/* Zero out the previous and next time vectors so we won't */ -/* have to do it when we are filling in the truncated */ -/* portions. */ - - for (j = 1; j <= 7; ++j) { - ptvec[(i__2 = j - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge( - "ptvec", i__2, "timout_", (ftnlen)2236)] = 0.; - ntvec[(i__2 = j - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge( - "ntvec", i__2, "timout_", (ftnlen)2237)] = 0.; - } - if (type__ == 3 || type__ == 4) { - stopat = 1; - timfmt = 1; - s_copy(intyp, ymdfmt, (ftnlen)16, (ftnlen)8); - incr = 1.; - } else if (type__ == 11) { - stopat = 2; - timfmt = 1; - s_copy(intyp, ymdfmt, (ftnlen)16, (ftnlen)8); - incr = 1.; - } else if (type__ == 19 || type__ == 12) { - stopat = 3; - timfmt = 1; - s_copy(intyp, ymdfmt, (ftnlen)16, (ftnlen)8); - incr = 1.; - } else if (type__ == 21 || type__ == 46) { - -/* Note that in this case (and the next 2) that if we */ -/* an HOUR component, we had to get it either from */ -/* a Day of Year format or from a Year Month Day */ -/* format. Thus we have all of the more significant */ -/* components for this format. */ - - stopat = 4; - timfmt = 1; - s_copy(intyp, ymdfmt, (ftnlen)16, (ftnlen)8); - incr = 1.; - } else if (type__ == 20) { - stopat = 5; - timfmt = 1; - s_copy(intyp, ymdfmt, (ftnlen)16, (ftnlen)8); - incr = 1.; - } else if (type__ == 22) { - stopat = 6; - timfmt = 1; - s_copy(intyp, ymdfmt, (ftnlen)16, (ftnlen)8); - incr = 0.; - } else if (type__ == 25) { - stopat = 1; - timfmt = 2; - incr = 0.; - if (timtyp == id[27]) { - s_copy(intyp, "JDTDT", (ftnlen)16, (ftnlen)5); - } else if (timtyp == id[26]) { - s_copy(intyp, "JDTDB", (ftnlen)16, (ftnlen)5); - } else if (timtyp == id[25] || timtyp == id[38]) { - s_copy(intyp, "JDUTC", (ftnlen)16, (ftnlen)5); - } - } else { - -/* The only types left are the continuous (numeric) */ -/* types. */ - - stopat = 1; - timfmt = 2; - incr = 0.; - s_copy(intyp, bastyp, (ftnlen)16, (ftnlen)16); - } - -/* Ok. We are now ready to construct the previous */ -/* and next time vectors. */ - - i__2 = stopat; - for (j = 1; j <= i__2; ++j) { - ptvec[(i__3 = j - 1) < 8 && 0 <= i__3 ? i__3 : s_rnge( - "ptvec", i__3, "timout_", (ftnlen)2327)] = values[ - (i__5 = compnt[(i__4 = j + (timfmt << 3) - 9) < - 16 && 0 <= i__4 ? i__4 : s_rnge("compnt", i__4, - "timout_", (ftnlen)2327)] - 1) < 51 && 0 <= i__5 ? - i__5 : s_rnge("values", i__5, "timout_", (ftnlen) - 2327)]; - ntvec[(i__3 = j - 1) < 8 && 0 <= i__3 ? i__3 : s_rnge( - "ntvec", i__3, "timout_", (ftnlen)2328)] = ptvec[( - i__4 = j - 1) < 8 && 0 <= i__4 ? i__4 : s_rnge( - "ptvec", i__4, "timout_", (ftnlen)2328)]; - } - ntvec[(i__2 = stopat - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge( - "ntvec", i__2, "timout_", (ftnlen)2331)] = ntvec[( - i__3 = stopat - 1) < 8 && 0 <= i__3 ? i__3 : s_rnge( - "ntvec", i__3, "timout_", (ftnlen)2331)] + incr; - -/* If the type is a year or month, then we need to set */ -/* the month to 1, so that we will be working with */ -/* beginnings of years not beginning of last months of */ -/* the previous year. */ - - if (type__ == 3 || type__ == 4) { - ptvec[1] = 1.; - ntvec[1] = 1.; - ptvec[2] = 1.; - ntvec[2] = 1.; - } else if (type__ == 11) { - ptvec[2] = 1.; - ntvec[2] = 1.; - } - if (go2jul && timfmt != 2) { - -/* Convert both PTVEC and NTVEC to the gregorian */ -/* calendar */ - - jyear = i_dnnt(ptvec); - jmonth = i_dnnt(&ptvec[1]); - jday = i_dnnt(&ptvec[2]); - jul2gr_(&jyear, &jmonth, &jday, &jdoy); - ptvec[0] = (doublereal) jyear; - ptvec[1] = (doublereal) jmonth; - ptvec[2] = (doublereal) jday; - jyear = i_dnnt(ntvec); - jmonth = i_dnnt(&ntvec[1]); - jday = i_dnnt(&ntvec[2]); - jul2gr_(&jyear, &jmonth, &jday, &jdoy); - ntvec[0] = (doublereal) jyear; - ntvec[1] = (doublereal) jmonth; - ntvec[2] = (doublereal) jday; - } - if (dozone && timfmt != 2) { - ptvec[3] -= hoff; - ntvec[3] = ntvec[4] - hoff; - ptvec[4] -= moff; - ntvec[4] -= moff; - ptvec[5] = 0.; - ntvec[5] = 0.; - ttrans_("YMDF", "YMDF", ptvec, (ftnlen)4, (ftnlen)4); - ttrans_("YMDF", "YMDF", ntvec, (ftnlen)4, (ftnlen)4); - if (type__ == 22) { - ptvec[5] = values[21]; - ntvec[5] = values[21]; - } - } - } - } - } - -/* All that's left to do is to copy the constructed string */ -/* to the output string. */ - - s_copy(output, string, output_len, (ftnlen)256); - chkout_("TIMOUT", (ftnlen)6); - return 0; -} /* timout_ */ - diff --git a/ext/spice/src/cspice/timout_c.c b/ext/spice/src/cspice/timout_c.c deleted file mode 100644 index 567b40c732..0000000000 --- a/ext/spice/src/cspice/timout_c.c +++ /dev/null @@ -1,526 +0,0 @@ -/* - --Procedure timout_c ( Time Output ) - --Abstract - - This routine converts an input epoch represented in TDB seconds - past the TDB epoch of J2000 to a character string formatted to - the specifications of a user's format picture. - --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 - - TIME - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void timout_c ( SpiceDouble et, - ConstSpiceChar * pictur, - SpiceInt lenout, - SpiceChar * output ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - et I An epoch in seconds past the ephemeris epoch J2000. - pictur I A format specification for the output string. - lenout I The length of the output string plus 1. - output O A string representation of the input epoch. - --Detailed_Input - - et a double precision representation of time in seconds - past the ephemeris epoch J2000. - - pictur is a string that specifies how the output should be - presented. The string is made up of various markers - that stand for various components associated with - a time. - - There are five types of markers that may appear in a - format picture. These are String Markers, Numeric - Markers, Meta markers, Modifier Markers and Literal - Markers. - - The pictur string is examined and the various markers - are identified. The output time string is constructed - by replacing each of the identified markers with - an appropriate time component. - - The various markers and their meanings are discussed - in the Particulars section below. - - lenout The allowed length of the output string. This length - must large enough to hold the output string plus the - terminator. If the output string is expected to have x - characters, lenout needs to be x + 1. - --Detailed_Output - - output is the input epoch converted to the string format - described by pictur - --Parameters - - None. - --Exceptions - - 1) The error SPICE(EMPTYSTRING) is signaled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 2) The error SPICE(NULLPOINTER) is signaled if either of - the input or output string pointers is null. - - 3) The user must pass a value indicating the length of the output - string. If this value is not at least 2, the error - SPICE(STRINGTOOSHORT) is signaled. - - The user's processing environment must be properly initialized by - loading a leapseconds kernel via the routine furnsh_c before calling - this routine. If a leapsecond kernel has not been loaded, an error - will be signaled by routines called by timout_c. - --Files - - A leapseconds kernel must be "loaded" via the routine furnsh_c - prior to calling timout_c. - --Particulars - - - A format picture is simply a string of letters that lets - timout_c know where various components of a time representation - should be placed during creation of the time string. - Here's an example of such a picture: - - MON DD,YYYY HR:MN:SC.#### (TDB) ::TDB - - Here is a sample of the times that would be created by - using this format. - - JAN 12,1992 12:28:18.2772 (TDB) - FEB 13,1994 23:18:25.2882 (TDB) - AUG 21,1995 00:02:00.1881 (TDB) - - As you can see from the samples above, the format picture - specifies that every time string created should begin - with a three-letter abbreviation for the month, followed - by a space and the day of the month. The day of month is - followed immediately by a comma and the year. The year - component is followed by two spaces. Next are the output hours, - represented as a two digit integer, a colon, minutes as - a two digit integer, another colon, and seconds rounded - to 4 decimal places and having a two digit integer part. - This is followed by a space and the string "(TDB)". The - special marker "::TDB" in the time picture is an - ``invisible'' marker. It is used to specify the time - system that should be used in creating the time string - (in this case Barycentric Dynamical Time). - - timout_c does not recognize all of the parts - of the time format picture in the example above. The list - of recognized parts and unrecognized parts are listed in - the table below. - - Recognized Unrecognized - ---------- ------------ - "MON" " " - "DD" "," - "YYYY" " " - "HR" ":" - "MN" "(TDB)" - "SC" - ".####" - "::TDB" - - The unrecognized parts are called literal markers. They are - copied exactly as they appear in pictur into the output string. - The recognized parts of the picture are replaced by a - component of time or, as in the case of `::TDB' are used - as instructions about the overall properties of the time - string. - - The full list of recognized markers, their classification - and meaning are given below. - - MARKER CLASS MEANING - ----------- -------- ----------------------------------------- - ".##..." modifier represent a numeric component that - immediately precedes this in a decimal - format. Number of decimal places - equals the number of "#" characters - "::GCAL" meta dates are reported in Gregorian Calendar - "::JCAL" meta dates are reported in Julian Calendar - "::MCAL" meta dates after 15 October, 1582 are reported - in Gregorian Calendar, before that - dates are reported in Julian Calendar - - "::RND" meta round output to places specified by - least significant component - - "::TDB" meta all components should be TDB - - "::TDT" meta all components should be TDT - - "::TRNC" meta truncate all output components (default) - "::UTC" meta all components should be UTC (default) - "::UTC+h:m" meta all components in UTC offset by +h (hours) - and +m (minutes) so as to allow time zones. - "::UTC-h:m" meta all components in UTC offset by -h (hours) - and -m (minutes) so as to allow time zones. - "AMPM" string String (either "A.M." or "P.M.") - indicating whether hours are before - or after noon. - "ampm" string String (either "a.m." or "p.m.") - indicating whether hours are before - or after noon. - "AP" numeric AM/PM equivalents of the hour component - of a time. - "DD" numeric Day of month - "DOY" numeric Day of year - "ERA" string String (either "B.C." or "A.D.") giving - era associated with an epoch. - "era" string String (either "b.c." or "a.d.") giving - era associated with an epoch. - "HR" numeric hour component of time - "JULIAND" numeric julian date component of time - "MM" numeric numeric representation of month component - "MN" numeric minute component of time - "MON" string upper case three letter abbreviation for - month - "Mon" string capitalized three letter abbreviation for - month - "mon" string lower case three letter abbreviation for - month - "MONTH" string upper case full name of month - "Month" string capitalized full name of month - "month" string lower case full name of month - "SC" numeric seconds component of time - "SP1950" numeric seconds past 1950 component of time - "SP2000" numeric seconds past 2000 component of time - "YR" numeric last two digits of year component of time - "YYYY" numeric year component of time - "WEEKDAY" string upper case day of week - "Weekday" string capitalized day of week - "weekday" string lower case day of week - "WKD" string upper case three letter abbreviation for - day of week. - "Wkd" string capitalized three letter abbreviation for - day of week. - "wkd" string lower case three letter abbreviation for - day of week. - - String Markers - - String markers are portions of the format picture that - will be replaced with a character string representing the - corresponding component of a time. - - Numeric Markers - - Numeric markers are portions of the format picture that - will be replaced with a decimal string that represents - the corresponding component of a time. - - Meta Markers - - Meta markers (listed under the class ``meta'' in the - table above) are used to indicate `global' properties of - your time string. You may specify time scale and how - rounding should be performed on the components of time - in your output string. Meta markers may be placed anywhere - in your format picture. They do not contribute to placement - of characters in output time strings. Also there are no - restrictions on how many meta markers you may place in - the format picture. However, if you supply conflicting - `meta' markers (for example ::TDT and ::TDB) in your - picture the first marker listed (in left to right order) - overrules the conflicting marker that appears later in - the picture. - - Modifier Markers - - The numeric markers listed in the table above stand - for integers unless they are modified through use of a - modifier marker. The strings - - .# - .## - .### - .#### - - are used to this end. When a numeric marker is followed - immediately by one of these modifiers, the corresponding - time component will be written with the number of decimal - places indicated by number of successive occurrences of - the character "#". Any numeric token may be modified. - - Rounding vs. Truncation - - The meta markers ::TRNC and ::RND allow you to control - how the output time picture is rounded. If you specify - ::TRNC all components of time are simply truncated to - the precision specified by the marker and any modifier. - If you specify ::RND the output time is rounded to the - least significant component of the format picture. The - default action is truncation. - - Whether an output time string should be rounded or - truncated depends upon what you plan to do with the - string. For example suppose you simply want to get the - calendar date associated with a time and not the time of - day. Then you probably do not want round your output. - Rounding 1992 Dec 31, 13:12:00 to the nearest day - produces 1993 Jan 1. Thus in this case rounding is probably - not appropriate. - - However, if you are producing output for plotting using - Julian Date, seconds past an 1950 or or seconds past - 2000, you will probably want your output rounded so as - to produce a smoother plot. - - Time Zones - - The meta markers ::UTC+h:m and ::UTC-h:m allow you - offset UTC times so that you may represent times in - a time zone other than GMT. For example you can - output times in Pacific Standard time by placing the - meta-marker ::UTC-8 in your format picture. - - For example if you use the picture - - YYYY Mon DD, HR:MN:SC ::UTC - - You will get output strings such as: - - 1995 Jan 03, 12:00:00 - - If you use the picture - - - YYYY Mon DD, HR:MN:SC ::UTC-8 - - You will get output strings such as: - - 1995 Jan 03, 04:00:00 - - Finally, if you use the picture - - YYYY Mon DD, HR:MN:SC ::UTC-8:15 - - You will get output string - - 1995 Jan 03, 03:45:00 - - Note that the minutes are always added or subtracted - based on the sign present in the time zone specifier. - In the case of ::UTC+h:m, minutes are added. In the - case ::UTC-h:m, minutes are subtracted. - - The unsigned part of the hours component can be no more - than 12. The unsigned part of the minutes can be no more - than 59. - - Calendars - - The calendar currently used by western countries is the - Gregorian Calendar. This calendar begins on Oct 15, 1582. - Prior to Gregorian Calendar the Julian calendar was used - The last Julian calendar date prior to the beginning - of the Gregorian Calendar is Oct 5, 1582. - - The primary difference between the Julian and Gregorian - calendars is in the determination of leap years. - Nevertheless both can be formally extended backward and - forward in time indefinitely. - - By default timout_c uses the Gregorian Calendar (::GCAL) in the - determination of the output string. However, you may - specify that timout_c use the Julian Calendar (::JCAL) or a - mixture of both (::MCAL). If you specify ::MCAL, epochs - that occur after the beginning of the Gregorian Calendar - will be represented using the Gregorian Calendar, epochs - prior to the beginning of the Gregorian calendar will - be represented using the Julian Calendar. - - Getting Software to Construct Pictures for You - - Although it is not difficult to construct time format - pictures, you do need to be aware of the various markers - that may appear in a format picture. - - There is an alternative means for getting a format picture. - The routine tpictr_c constructs format pictures from a sample - time string. For example suppose you would like your - time strings to look like the basic pattern of the string - below. - - "Fri Jul 26 12:22:09 PDT 1996" - - You can call tpictr_c with this string, and it will create - the appropriate pictur for use with timout_c. - - tpictr_c ( "Fri Jul 26 12:22:09 PDT 1996", pictur, OK ) - - The result will be: - - "Wkd Mon DD HR:MN:SC (PDT) ::UTC-7" - - Note: not every date that you can read is interpretable - by tpictr_c. For example, you might be able to understand - that 19960212121116 is Feb 12 1996, 12:11:16. However, - tpictr_c cannot recognize this string. Thus it is important - to check the logical OK to make sure that tpictr_c was able - to understand the time picture you provided. - - Even thought tpictr_c can not recognize every time pattern - that has been used by various people, it does recognize - nearly all patterns that you use when you want to communicate - outside your particular circle of colleagues. - --Examples - - Suppose you need to create time strings similar to the - default time string produced by the UNIX utility "date" - (for example a string of the form "Thu Aug 01 09:47:16 PDT 1996") - - Make the following string assignment: - - pictur = "Wkd Mon DD HH:MN:SC PDT YYYY ::UTC-7"; - - (Note the meta marker ::UTC-7 is used to adjust the output - time system from UTC to PDT. Also note that the substring PDT - is a literal marker. Without it, the time system would not - appear in the output time string. - - Now for each time et for which an output time string is required - make the call to timout_c below, and write the time string. - - timout_c ( et, pictur, lenout, string ); - printf ( "%s\n", string); - - Alternatively, you can let the routine tpictr_c create the timout_c - time picture for you. - - tpictr_c ( "Thu Aug 01 09:47:16 PDT 1996", pictur, OK ); - - if ( OK ) - { - timout_c ( et, pictur, lenout, string ); - printf ( "%s\n", string); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.1, 14-AUG-2006 (EDW) - - Edited incorrect description of output. Replace mention of - ldpool_c with furnsh_c. - - -CSPICE Version 1.1.0, 09-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. Updated the Exceptions header section. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - Convert and format d.p. seconds past J2000 as a string - --& -*/ - -{ /* Begin timout_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "timout_c"); - - - /* - Check the input string pictur to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "timout_c", pictur ); - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "timout_c", output, lenout ); - - /* - Call our beloved f2c'd routine - */ - timout_( ( doublereal * ) &et , - ( char * ) pictur, - ( char * ) output, - ( ftnlen ) strlen(pictur), - ( ftnlen ) lenout-1 ); - - /* - The string returned, output, is a Fortranish type string. - Convert the string to C type. - */ - F2C_ConvertStr ( lenout, output ); - - - chkout_c ( "timout_c"); - -} /* End timout_c */ diff --git a/ext/spice/src/cspice/tipbod.c b/ext/spice/src/cspice/tipbod.c deleted file mode 100644 index 1462303d33..0000000000 --- a/ext/spice/src/cspice/tipbod.c +++ /dev/null @@ -1,393 +0,0 @@ -/* tipbod.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure TIPBOD ( Transformation, inertial position to bodyfixed ) */ -/* Subroutine */ int tipbod_(char *ref, integer *body, doublereal *et, - doublereal *tipm, ftnlen ref_len) -{ - doublereal ref2j[9] /* was [3][3] */; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - extern logical failed_(void); - extern /* Subroutine */ int bodmat_(integer *, doublereal *, doublereal *) - , chkout_(char *, ftnlen); - doublereal tmpmat[9] /* was [3][3] */; - extern /* Subroutine */ int irftrn_(char *, char *, doublereal *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* Return a 3x3 matrix that transforms positions in inertial */ -/* coordinates to positions in body-equator-and-prime-meridian */ -/* coordinates. */ - -/* $ 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 */ - -/* PCK */ -/* NAIF_IDS */ -/* ROTATION */ -/* TIME */ - -/* $ Keywords */ - -/* TRANSFORMATION */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* REF I ID of inertial reference frame to transform from. */ -/* BODY I ID code of body. */ -/* ET I Epoch of transformation. */ -/* TIPM O Transformation (position), inertial to prime */ -/* meridian. */ - -/* $ Detailed_Input */ - -/* REF is the NAIF name for an inertial reference frame. */ -/* Acceptable names include: */ - -/* Name Description */ -/* -------- -------------------------------- */ -/* 'J2000' Earth mean equator, dynamical */ -/* equinox of J2000 */ - -/* 'B1950' Earth mean equator, dynamical */ -/* equinox of B1950 */ - -/* 'FK4' Fundamental Catalog (4) */ - -/* 'DE-118' JPL Developmental Ephemeris (118) */ - -/* 'DE-96' JPL Developmental Ephemeris ( 96) */ - -/* 'DE-102' JPL Developmental Ephemeris (102) */ - -/* 'DE-108' JPL Developmental Ephemeris (108) */ - -/* 'DE-111' JPL Developmental Ephemeris (111) */ - -/* 'DE-114' JPL Developmental Ephemeris (114) */ - -/* 'DE-122' JPL Developmental Ephemeris (122) */ - -/* 'DE-125' JPL Developmental Ephemeris (125) */ - -/* 'DE-130' JPL Developmental Ephemeris (130) */ - -/* 'GALACTIC' Galactic System II */ - -/* 'DE-200' JPL Developmental Ephemeris (200) */ - -/* 'DE-202' JPL Developmental Ephemeris (202) */ - -/* (See the routine CHGIRF for a full list of names.) */ - -/* The output TIPM will give the transformation */ -/* from this frame to the bodyfixed frame specified by */ -/* BODY at the epoch specified by ET. */ - - -/* BODY is the integer ID code of the body for which the */ -/* position transformation matrix is requested. Bodies */ -/* are numbered according to the standard NAIF */ -/* numbering scheme. The numbering scheme is */ -/* explained in the NAIF_IDS required reading file. */ - -/* ET is the epoch at which the position transformation */ -/* matrix is requested. (This is typically the */ -/* epoch of observation minus the one-way light time */ -/* from the observer to the body at the epoch of */ -/* observation.) */ - -/* $ Detailed_Output */ - -/* TIPM is a 3x3 coordinate transformation matrix. It is */ -/* used to transform positions from inertial */ -/* coordinates to body fixed (also called equator and */ -/* prime meridian --- PM) coordinates. */ - -/* Given a position P in the inertial reference frame */ -/* specified by REF, the corresponding bodyfixed */ -/* position is given by the matrix vector product: */ - -/* TIPM * S */ - -/* The X axis of the PM system is directed to the */ -/* intersection of the equator and prime meridian. */ -/* The Z axis points along the spin axis and points */ -/* towards the same side of the invariable plane of */ -/* the solar system as does earth's north pole. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the kernel pool does not contain all of the data required */ -/* for computing the transformation matrix, TIPM, the error */ -/* SPICE(INSUFFICIENTANGLES) is signalled. */ - -/* 2) If the reference frame, REF, is not recognized, a routine */ -/* called by TIPBOD will diagnose the condition and invoke the */ -/* SPICE error handling system. */ - -/* 3) If the specified body code, BODY, is not recognized, the */ -/* error is diagnosed by a routine called by TIPBOD. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* TIPBOD takes PCK information as input, either in the */ -/* form of a binary or text PCK file. High precision */ -/* binary files are searched for first (the last loaded */ -/* file takes precedence); then it defaults to the text */ -/* PCK file. If binary information is found for the */ -/* requested body and time, the Euler angles are */ -/* evaluated and the transformation matrix is calculated */ -/* from them. Using the Euler angles PHI, DELTA and W */ -/* we compute */ - -/* TIPM = [W] [DELTA] [PHI] */ -/* 3 1 3 */ - - -/* If no appropriate binary PCK files have been loaded, */ -/* the text PCK file is used. Here information is found */ -/* as RA, DEC and W (with the possible addition of nutation */ -/* and libration terms for satellites). Again, the Euler */ -/* angles are found, and the transformation matrix is */ -/* calculated from them. The transformation from inertial to */ -/* bodyfixed coordinates is represented as: */ - -/* TIPM = [W] [HALFPI-DEC] [RA+HALFPI] */ -/* 3 1 3 */ - -/* These are basically the Euler angles, PHI, DELTA and W: */ - -/* RA = PHI - HALFPI */ -/* DEC = HALFPI - DELTA */ -/* W = W */ - -/* In the text file, RA, DEC, and W are defined as follows: */ - -/* 2 ____ */ -/* RA2*t \ */ -/* RA = RA0 + RA1*t/T + ------ + / a sin theta */ -/* 2 ---- i i */ -/* T i */ - -/* 2 ____ */ -/* DEC2*t \ */ -/* DEC = DEC0 + DEC1*t/T + ------- + / d cos theta */ -/* 2 ---- i i */ -/* T i */ - - -/* 2 ____ */ -/* W2*t \ */ -/* W = W0 + W1*t/d + ----- + / w sin theta */ -/* 2 ---- i i */ -/* d i */ - - -/* where: */ - -/* d = seconds/day */ - -/* T = seconds/Julian century */ - -/* a , d , and w arrays apply to satellites only. */ -/* i i i */ - -/* theta = THETA0(i) + THETA1(i)*t/T are specific to each */ -/* i */ - -/* planet. */ - - -/* These angles -- typically nodal rates -- vary in number and */ -/* definition from one planetary system to the next. */ - -/* $ Examples */ - -/* Note that the items necessary to compute the Euler angles */ -/* must have been loaded into the kernel pool (by one or more */ -/* previous calls to FURNSH). The Euler angles are typically */ -/* stored in the P_constants kernel file that comes with */ -/* SPICELIB. */ - -/* 1) In the following code fragment, TIPBOD is used to transform */ -/* a position in J2000 inertial coordinates to a state in */ -/* bodyfixed coordinates. */ - -/* The 3-vectors POSTN represents the inertial position */ -/* of an object with respect to the center of the */ -/* body at time ET. */ - -/* C */ -/* C First load the kernel pool. */ -/* C */ -/* CALL FURNSH ( 'PLANETARY_CONSTANTS.KER' ) */ - -/* C */ -/* C Next get the transformation and its derivative. */ -/* C */ -/* CALL TIPBOD ( 'J2000', BODY, ET, TIPM ) */ - -/* C */ -/* C Convert position, the first three elements of */ -/* C STATE, to bodyfixed coordinates. */ -/* C */ -/* CALL MXVG ( TIPM, POSTN, BDPOS ) */ - -/* $ Restrictions */ - -/* The kernel pool must be loaded with the appropriate */ -/* coefficients (from the P_constants kernel or binary PCK file) */ -/* prior to calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM call. Replaced header references to LDPOOL with */ -/* references to FURNSH. */ - -/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ - -/* - SPICELIB Version 1.0.3, 10-MAR-1994 (KSZ) */ - -/* Underlying BODMAT code changed to look for binary PCK */ -/* data files, and use them to get orientation information if */ -/* they are available. Only the comments to TIPBOD changed. */ - -/* - SPICELIB Version 1.0.2, 06-JUL-1993 (HAN) */ - -/* Example in header was corrected. Previous version had */ -/* incorrect matrix dimension specifications passed to MXVG. */ - -/* - 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, 05-AUG-1991 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* transformation from inertial position to bodyfixed */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM call. Replaced header references to LDPOOL with */ -/* references to FURNSH. */ - - -/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. The new checks */ -/* are intended to prevent arithmetic operations from */ -/* being performed with uninitialized or invalid data. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("TIPBOD", (ftnlen)6); - } - -/* Get the transformation from the inertial from REF to J2000 */ -/* coordinates. */ - - irftrn_(ref, "J2000", ref2j, ref_len, (ftnlen)5); - -/* Get the transformation from J2000 to body-fixed coordinates */ -/* for the requested epoch. */ - - bodmat_(body, et, tipm); - if (failed_()) { - chkout_("TIPBOD", (ftnlen)6); - return 0; - } - -/* Compose the transformations to arrive at the REF-to-J2000 */ -/* transformation. */ - - mxm_(tipm, ref2j, tmpmat); - moved_(tmpmat, &c__9, tipm); - -/* That's all folks. Check out and get out. */ - - chkout_("TIPBOD", (ftnlen)6); - return 0; -} /* tipbod_ */ - diff --git a/ext/spice/src/cspice/tipbod_c.c b/ext/spice/src/cspice/tipbod_c.c deleted file mode 100644 index 4795dfbd81..0000000000 --- a/ext/spice/src/cspice/tipbod_c.c +++ /dev/null @@ -1,350 +0,0 @@ -/* - --Procedure tipbod_c ( Transformation, inertial position to bodyfixed ) - --Abstract - - Return a 3x3 matrix that transforms positions in inertial - coordinates to positions in body-equator-and-prime-meridian - coordinates. - --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 - - PCK - NAIF_IDS - ROTATION - TIME - --Keywords - - TRANSFORMATION - ROTATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void tipbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tipm[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - ref I ID of inertial reference frame to transform from. - body I ID code of body. - et I Epoch of transformation. - tipm O Transformation (position), inertial to prime - meridian. - --Detailed_Input - - ref is the NAIF name for an inertial reference frame. - Acceptable names include: - - Name Description - -------- -------------------------------- - "J2000" Earth mean equator, dynamical - equinox of J2000 - - "B1950" Earth mean equator, dynamical - equinox of B1950 - - "FK4" Fundamental Catalog (4) - - "DE-118" JPL Developmental Ephemeris (118) - - "DE-96" JPL Developmental Ephemeris ( 96) - - "DE-102" JPL Developmental Ephemeris (102) - - "DE-108" JPL Developmental Ephemeris (108) - - "DE-111" JPL Developmental Ephemeris (111) - - "DE-114" JPL Developmental Ephemeris (114) - - "DE-122" JPL Developmental Ephemeris (122) - - "DE-125" JPL Developmental Ephemeris (125) - - "DE-130" JPL Developmental Ephemeris (130) - - "GALACTIC" Galactic System II - - "DE-200" JPL Developmental Ephemeris (200) - - "DE-202" JPL Developmental Ephemeris (202) - - (See the routine CHGIRF for a full list of names.) - - The output tipm will give the transformation - from this frame to the bodyfixed frame specified by - body at the epoch specified by et. - - - body is the integer ID code of the body for which the - position transformation matrix is requested. Bodies - are numbered according to the standard NAIF - numbering scheme. The numbering scheme is - explained in the NAIF_IDS required reading file. - - et is the epoch at which the position transformation - matrix is requested. (This is typically the - epoch of observation minus the one-way light time - from the observer to the body at the epoch of - observation.) - --Detailed_Output - - tipm is a 3x3 coordinate transformation matrix. It is - used to transform positions from inertial coordinates to - body fixed (also called equator and prime meridian) - coordinates. - - Given a position P in the inertial reference frame - specified by ref, the corresponding bodyfixed - position is given by the matrix vector product - - tipm * s - - The X axis of the PM system is directed to the - intersection of the equator and prime meridian. - The Z axis points along the spin axis and points - towards the same side of the invariable plane of - the solar system as does earth's north pole. - --Parameters - - None. - --Exceptions - - 1) If the kernel pool does not contain all of the data required - for computing the transformation matrix, tipm, the error - SPICE(INSUFFICIENTANGLES) is signalled. - - 2) If the reference frame ref is not recognized, a routine - called by tipbod_c will diagnose the condition and signal an - error. - - 3) If the code body is not recognized, the error is diagnosed by a - routine called by tipbod_c. - - 4) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 5) If the input string has length zero, the error - SPICE(EMPTYSTRING) will be signaled. - --Files - - None. - --Particulars - - tipbod_c takes PCK information as input, either in the form of a - binary or text PCK file. If the data required to compute tipm are - available in a binary PCK, these data will take precedence over data - from a text PCK. If there are multiple binary PCKs containing data - from which tipm can be computed, the last loaded PCK takes - precedence. If binary PCK data are available for the requested body - and time, the Euler angles giving the body's orientation are - evaluated, and the transformation matrix tipm is calculated from - them. Using the Euler angles PHI, DELTA and W we compute - - TIPM = [W] [DELTA] [PHI] - 3 1 3 - - If no appropriate binary PCK files have been loaded, text PCK data - are used. Here information is found as RA, DEC and W (with the - possible addition of nutation and libration terms for satellites). - Again, the Euler angles are found, and the transformation matrix is - calculated from them. The transformation from inertial to - bodyfixed coordinates is represented as: - - TIPM = [W] [HALFPI-DEC] [RA+HALFPI] - 3 1 3 - - These Euler angles RA, DEC and W are related to PHI, DELTA and W - by the equations - - RA = PHI - pi/2 - DEC = pi/2 - DELTA - W = W - - In the text file, RA, DEC, and W are defined as follows: - - 2 ____ - RA2*t \ - RA = RA0 + RA1*t/T + ------ + / a sin theta - 2 ---- i i - T i - - 2 ____ - DEC2*t \ - DEC = DEC0 + DEC1*t/T + ------- + / d cos theta - 2 ---- i i - T i - - - 2 ____ - W2*t \ - W = W0 + W1*t/d + ----- + / w sin theta - 2 ---- i i - d i - - where: - - d = seconds/day - - T = seconds/Julian century - - a , d , and w arrays apply to satellites only. - i i i - - theta = THETA0(i) + THETA1(i)*t/T are specific to each - i - - planet. - - - These angles---typically nodal rates---vary in number and - definition from one planetary system to the next. - --Examples - - Note that the items necessary to compute the Euler angles - must have been loaded into the kernel pool (by one or more - previous calls to furnsh_c). The Euler angles are typically - stored in the P_constants kernel file that comes with - CSPICE. - - 1) In the following code fragment, tipbod_c is used to transform - a position in J2000 inertial coordinates to a position in - bodyfixed coordinates. - - The 3-vector postn represents the inertial position - of an object with respect to the center of the - body at time et. - - #include "SpiceUsr.h" - . - . - . - /. - First load the kernel pool. - ./ - furnsh_c ( "PLANETARY_CONSTANTS.KER" ); - - /. - Next get the transformation. - ./ - tipbod_c ( "J2000", body, et, tipm ); - - /. - Convert position to bodyfixed coordinates. - ./ - mxv_c ( tipm, postn, bfxpos ); - --Restrictions - - The kernel pool must be loaded with the appropriate - coefficients (from the P_constants kernel or binary PCK file) - prior to calling this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - K.S. Zukor (JPL) - --Version - - -CSPICE Version 1.0.2, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.0.1, 13-APR-2000 (NJB) - - Made some minor updates and corrections in the code example. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.0.3, 10-MAR-1994 (KSZ). - --Index_Entries - - transformation from inertial position to bodyfixed - --& -*/ - -{ /* Begin tipbod_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "tipbod_c" ); - - /* - Check the input string ref to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "tipbod_c", ref ); - - /* - Call the f2c'd Fortran routine. - */ - tipbod_ ( ( char * ) ref, - ( integer * ) &body, - ( doublereal * ) &et, - ( doublereal * ) tipm, - ( ftnlen ) strlen(ref) ); - - /* - Transpose the output matrix to put it in row-major order. - */ - xpose_c ( tipm, tipm ); - - chkout_c ( "tipbod_c" ); - - -} /* End tipbod_c */ diff --git a/ext/spice/src/cspice/tisbod.c b/ext/spice/src/cspice/tisbod.c deleted file mode 100644 index f622cd7629..0000000000 --- a/ext/spice/src/cspice/tisbod.c +++ /dev/null @@ -1,1229 +0,0 @@ -/* tisbod.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__3 = 3; -static integer c__100 = 100; - -/* $Procedure TISBOD ( Transformation, inertial state to bodyfixed ) */ -/* Subroutine */ int tisbod_(char *ref, integer *body, doublereal *et, - doublereal *tsipm, ftnlen ref_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical found = FALSE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *) - ; - - /* Local variables */ - doublereal dphi; - integer cent; - char item[32]; - doublereal tipm[9] /* was [3][3] */; - extern integer zzbodbry_(integer *); - doublereal d__; - integer i__, j; - doublereal dcoef[3], t, w; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen); - doublereal delta; - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */; - integer pcref; - doublereal wcoef[3]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal theta; - extern /* Subroutine */ int vpack_(doublereal *, doublereal *, doublereal - *, doublereal *), repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal dtipm[9] /* was [3][3] */; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal costh[100]; - extern doublereal vdotg_(doublereal *, doublereal *, integer *); - char dtype[1]; - doublereal sinth[100], xtipm[9] /* was [3][3] */; - extern doublereal twopi_(void); - static integer j2code; - doublereal req2pc[9] /* was [3][3] */, ac[100]; - extern /* Subroutine */ int eul2xf_(doublereal *, integer *, integer *, - integer *, doublereal *); - doublereal dc[100]; - integer na, nd; - doublereal ra; - extern logical failed_(void); - doublereal wc[100], dw; - extern logical bodfnd_(integer *, char *, ftnlen); - doublereal ddelta; - extern /* Subroutine */ int cleard_(integer *, doublereal *), bodvcd_( - integer *, char *, integer *, integer *, doublereal *, ftnlen); - integer frcode; - extern doublereal halfpi_(void); - extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char - *, integer *, logical *, ftnlen); - doublereal pckepc; - integer nw; - doublereal dtheta, pckref; - extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *, - doublereal *, logical *); - integer ntheta; - doublereal dcosth[100]; - integer reqref; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen); - doublereal dsinth[100]; - char fixfrm[32], errmsg[1840]; - doublereal eulsta[6]; - integer npairs; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen); - doublereal xdtipm[9] /* was [3][3] */; - extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen), errint_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - irfrot_(integer *, integer *, doublereal *); - extern logical return_(void); - char timstr[35]; - extern doublereal j2000_(void); - doublereal dec, dra; - integer dim; - doublereal phi; - extern doublereal rpd_(void), spd_(void); - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - ; - doublereal ddec; - -/* $ Abstract */ - -/* Return a 6x6 matrix that transforms states in inertial */ -/* coordinates to states in body-equator-and-prime-meridian */ -/* coordinates. */ - -/* $ 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 */ - -/* PCK */ -/* NAIF_IDS */ -/* ROTATION */ -/* TIME */ - -/* $ Keywords */ - -/* TRANSFORMATION */ -/* ROTATION */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* REF I ID of inertial reference frame to transform from */ -/* BODY I ID code of body */ -/* ET I Epoch of transformation */ -/* TSIPM O Transformation (state), inertial to prime meridian */ - -/* $ Detailed_Input */ - -/* REF is the NAIF name for an inertial reference frame. */ -/* Acceptable names include: */ - -/* Name Description */ -/* -------- -------------------------------- */ -/* 'J2000' Earth mean equator, dynamical */ -/* equinox of J2000 */ - -/* 'B1950' Earth mean equator, dynamical */ -/* equinox of B1950 */ - -/* 'FK4' Fundamental Catalog (4) */ - -/* 'DE-118' JPL Developmental Ephemeris (118) */ - -/* 'DE-96' JPL Developmental Ephemeris ( 96) */ - -/* 'DE-102' JPL Developmental Ephemeris (102) */ - -/* 'DE-108' JPL Developmental Ephemeris (108) */ - -/* 'DE-111' JPL Developmental Ephemeris (111) */ - -/* 'DE-114' JPL Developmental Ephemeris (114) */ - -/* 'DE-122' JPL Developmental Ephemeris (122) */ - -/* 'DE-125' JPL Developmental Ephemeris (125) */ - -/* 'DE-130' JPL Developmental Ephemeris (130) */ - -/* 'GALACTIC' Galactic System II */ - -/* 'DE-200' JPL Developmental Ephemeris (200) */ - -/* 'DE-202' JPL Developmental Ephemeris (202) */ - -/* (See the routine CHGIRF for a full list of names.) */ - -/* The output TIPM will give the transformation */ -/* from this frame to the bodyfixed frame specified by */ -/* BODY at the epoch specified by ET. */ - -/* BODY is the integer ID code of the body for which the */ -/* state transformation matrix is requested. Bodies */ -/* are numbered according to the standard NAIF */ -/* numbering scheme. The numbering scheme is */ -/* explained in the NAIF_IDS required reading file. */ - -/* ET is the epoch at which the state transformation */ -/* matrix is requested. (This is typically the */ -/* epoch of observation minus the one-way light time */ -/* from the observer to the body at the epoch of */ -/* observation.) */ - -/* $ Detailed_Output */ - -/* TSIPM is a 6x6 transformation matrix. It is used to */ -/* transform states from inertial coordinates to body */ -/* fixed (also called equator and prime meridian --- */ -/* PM) coordinates. */ - -/* Given a state S in the inertial reference frame */ -/* specified by REF, the corresponding bodyfixed state */ -/* is given by the matrix vector product: */ - -/* TSIPM * S */ - -/* The X axis of the PM system is directed to the */ -/* intersection of the equator and prime meridian. */ -/* The Z axis points along the spin axis and points */ -/* towards the same side of the invariable plane of */ -/* the solar system as does earth's north pole. */ - -/* NOTE: The inverse of TSIPM is NOT its transpose. */ -/* The matrix, TSIPM, has a structure as shown */ -/* below: */ - -/* - - */ -/* | : | */ -/* | R : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | dR_dt : R | */ -/* | : | */ -/* - - */ - -/* where R is a time varying rotation matrix and */ -/* dR_dt is its derivative. The inverse of this */ -/* matrix is: */ - -/* - - */ -/* | T : | */ -/* | R : 0 | */ -/* | .......:.......| */ -/* | : | */ -/* | T : T | */ -/* | dR_dt : R | */ -/* | : | */ -/* - - */ - -/* The SPICE routine INVSTM is available for */ -/* producing this inverse. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If data required to define the body-fixed frame associated */ -/* with BODY are not found in the binary PCK system or the kernel */ -/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */ -/* the case of IAU style body-fixed frames, the absence of */ -/* prime meridian polynomial data (which are required) is used */ -/* as an indicator of missing data. */ - -/* 2) If the test for exception (1) passes, but in fact requested */ -/* data are not available in the kernel pool, the error will be */ -/* signaled by routines in the call tree of this routine. */ - -/* 3) If the kernel pool does not contain all of the data required */ -/* to define the number of nutation precession angles */ -/* corresponding to the available nutation precession */ -/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */ -/* signaled. */ - -/* 4) If the reference frame REF is not recognized, a routine */ -/* called by TISBOD will diagnose the condition and invoke the */ -/* SPICE error handling system. */ - -/* 5) If the specified body code BODY is not recognized, the */ -/* error is diagnosed by a routine called by TISBOD. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The matrix for transforming inertial states to bodyfixed */ -/* states is the 6x6 matrix shown below as a block structured */ -/* matrix. */ - -/* - - */ -/* | : | */ -/* | TIPM : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | DTIPM : TIPM | */ -/* | : | */ -/* - - */ - -/* This can also be expressed in terms of Euler angles */ -/* PHI, DELTA and W. The transformation from inertial to */ -/* bodyfixed coordinates is represented in the SPICE kernel */ -/* pool as: */ - -/* TIPM = [W] [DELTA] [PHI] */ -/* 3 1 3 */ -/* Thus */ - -/* DTIPM = d[W] /dt [DELTA] [PHI] */ -/* 3 1 3 */ - -/* + [W] d[DELTA] /dt [PHI] */ -/* 3 1 3 */ - -/* + [W] [DELTA] d[PHI] /dt */ -/* 3 1 3 */ - - -/* If a binary PCK file record can be used for the time and */ -/* body requested, it will be used. The most recently loaded */ -/* binary PCK file has first priority, followed by previously */ -/* loaded binary PCK files in backward time order. If no */ -/* binary PCK file has been loaded, the text P_constants */ -/* kernel file is used. */ - -/* If there is only text PCK kernel information, it is */ -/* expressed in terms of RA, DEC and W (same W as above), where */ - -/* RA = PHI - HALFPI() */ -/* DEC = HALFPI() - DELTA */ - -/* The angles RA, DEC, and W are defined as follows in the */ -/* text PCK file: */ - -/* 2 ____ */ -/* RA2*t \ */ -/* RA = RA0 + RA1*t/T + ------ + / a sin theta */ -/* 2 ---- i i */ -/* T i */ - -/* 2 ____ */ -/* DEC2*t \ */ -/* DEC = DEC0 + DEC1*t/T + ------- + / d cos theta */ -/* 2 ---- i i */ -/* T i */ - - -/* 2 ____ */ -/* W2*t \ */ -/* W = W0 + W1*t/d + ----- + / w sin theta */ -/* 2 ---- i i */ -/* d i */ - - -/* where: */ - -/* d = seconds/day */ - -/* T = seconds/Julian century */ - -/* a , d , and w arrays apply to satellites only. */ -/* i i i */ - -/* theta = THETA0(i) + THETA1(i)*t/T are specific to each */ -/* i */ - -/* planet. */ - - -/* These angles -- typically nodal rates -- vary in number and */ -/* definition from one planetary system to the next. */ - -/* Thus */ -/* ____ */ -/* 2*RA2*t \ */ -/* dRA/dt = RA1/T + ------- + / a THETA1(i)/T cos theta */ -/* 2 ---- i i */ -/* T i */ - -/* ____ */ -/* 2*DEC2*t \ */ -/* dDEC/dt = DEC1/T + -------- - / d THETA1(i)/T sin theta */ -/* 2 ---- i i */ -/* T i */ - -/* ____ */ -/* 2*W2*t \ */ -/* dW/dt = W1/d + ------ + / w THETA1(i)/T cos theta */ -/* 2 ---- i i */ -/* d i */ - - -/* $ Examples */ - -/* Note that the data needed to compute the output state transition */ -/* matrix must have been made available to your program by having */ -/* loaded an appropriate binary or text PCK file via FURNSH. */ - -/* Example 1. */ - -/* In the following code fragment, TISBOD is used to transform */ -/* a state in J2000 inertial coordinates to a state in bodyfixed */ -/* coordinates. */ - -/* The 6-vectors EULANG represents the inertial state (position and */ -/* velocity) of an object with respect to the center of the body */ -/* at time ET. */ - -/* C */ -/* C First load the kernel pool. */ -/* C */ -/* CALL FURNSH ( 'PLANETARY_CONSTANTS.KER' ) */ - -/* C */ -/* C Next get the transformation and its derivative. */ -/* C */ -/* CALL TISBOD ( 'J2000', BODY, ET, TSIPM ) */ - -/* C */ -/* C Convert position to bodyfixed coordinates. */ -/* C */ -/* CALL MXVG ( TSIPM, EULANG, 6, 6, BDSTAT ) */ - - -/* Example 2. */ - -/* In the example below, TISBOD is used to compute */ -/* the angular velocity vector (with respect to an inertial frame) */ -/* of the specified body at time ET. */ - -/* C */ -/* C First get the state transformation matrix. */ -/* C */ -/* CALL TISBOD ( BODY, ET, TSIPM ) */ - -/* C */ -/* C This matrix has the form: */ -/* C */ -/* C - - */ -/* C | : | */ -/* C | TIPM : 0 | */ -/* C | ......:......| */ -/* C | : | */ -/* C | DTIPM : TIPM | */ -/* C | : | */ -/* C - - */ -/* C */ -/* C We extract TIPM and DTIPM */ -/* C */ - -/* DO I = 1,3 */ -/* DO J = 1,3 */ - -/* TIPM ( I, J ) = TSIPM ( I, J ) */ -/* DTIPM ( I, J ) = TSIPM ( I+3, J ) */ - -/* END DO */ -/* END DO */ - -/* C */ -/* C The transpose of TIPM and DTIPM, (TPMI and DTPMI), give */ -/* C the transformation from bodyfixed coordinates to inertial */ -/* C coordinates. */ -/* C */ -/* C Here is a fact about the relationship between angular */ -/* C velocity associated with a time varying rotation matrix */ -/* C that gives the orientation of a body with respect to */ -/* C an inertial frame. */ -/* C */ -/* C The angular velocity vector can be read from the off */ -/* C diagonal components of the matrix product: */ -/* C */ -/* C t */ -/* C OMEGA = DTPMI * TPMI */ -/* C */ -/* C t */ -/* C = DTIPM * TIPM */ -/* C */ -/* C the components of the angular velocity V will appear */ -/* C in this matrix as: */ -/* C */ -/* C _ _ */ -/* C | | */ -/* C | 0 -V(3) V(2) | */ -/* C | | */ -/* C | V(3) 0 -V(1) | */ -/* C | | */ -/* C | -V(2) V(1) 0 | */ -/* C |_ _| */ -/* C */ -/* C */ -/* CALL MTXM ( DTIPM, TIPM, OMEGA ) */ - -/* V(1) = OMEGA (3,2) */ -/* V(2) = OMEGA (1,3) */ -/* V(3) = OMEGA (2,1) */ - -/* $ Restrictions */ - -/* The kernel pool must be loaded with the appropriate coefficients */ -/* (from the P_constants kernel or binary PCK file) prior to */ -/* calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N. J. Bachman (JPL) */ -/* W. L. Taber (JPL) */ -/* K. S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.4.0, 01-FEB-2008 (NJB) */ - -/* The routine was updated to improve the error messages created */ -/* when required PCK data are not found. Now in most cases the */ -/* messages are created locally rather than by the kernel pool */ -/* access routines. In particular missing binary PCK data will */ -/* be indicated with a reasonable error message. */ - -/* - SPICELIB Version 4.3.0, 13-DEC-2005 (NJB) */ - -/* Bug fix: previous update introduced bug in state */ -/* transformation when REF was unequal to PCK native frame. */ - -/* - SPICELIB Version 4.2.0, 23-OCT-2005 (NJB) */ - -/* Re-wrote portions of algorithm to simplify source code. */ -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM and VADDG calls. */ - -/* Replaced calls to ZZBODVCD with calls to BODVCD. */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ - -/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */ - -/* Code has been updated to support satellite ID codes in the */ -/* range 10000 to 99999 and to allow nutation precession angles */ -/* to be associated with any object. */ - -/* Implementation changes were made to improve robustness */ -/* of the code. */ - -/* - SPICELIB Version 3.3.0, 29-MAR-1995 (WLT) */ - -/* Properly initialized the variable NPAIRS. */ - -/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */ - -/* Changed to call PCKMAT rather than PCKEUL. */ - -/* - SPICELIB Version 3.1.0, 18-OCT-1994 (KSZ) */ - -/* Fixed bug which incorrectly modded DW by two pi. */ - -/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */ - -/* Changed to look for binary PCK file, and used this */ -/* to find Euler angles, if such data has been loaded. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* $Required_Reading and $Literature_References sections were */ -/* updated. */ - -/* - SPICELIB Version 1.0.0, 05-NOV-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* transformation from inertial state to bodyfixed */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.2.0, 06-SEP-2005 (NJB) */ - -/* Re-wrote portions of algorithm to simplify source code. */ -/* The routine now takes advantage of EUL2XF, which wasn't */ -/* available when the first version of this routine was written. */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in MXM and VADDG calls. */ - -/* Replaced calls to ZZBODVCD with calls to BODVCD. */ - -/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. The new checks */ -/* are intended to prevent arithmetic operations from */ -/* being performed with uninitialized or invalid data. */ - -/* - SPICELIB Version 4.0.0, 27-JAN-2004 (NJB) */ - -/* Code has been updated to support satellite ID codes in the */ -/* range 10000 to 99999 and to allow nutation precession angles */ -/* to be associated with any object. */ - -/* Calls to deprecated kernel pool access routine RTPOOL */ -/* were replaced by calls to GDPOOL. */ - -/* Calls to BODVAR have been replaced with calls to */ -/* ZZBODVCD. */ - -/* - SPICELIB Version 3.3.0, 29-MAR-1995 (WLT) */ - -/* The variable NPAIRS is now initialized */ -/* at the same point as NA, NTHETA, ND, and NW to be */ -/* zero. This prevents the routine from performing */ -/* needless calculations for planets and avoids possible */ -/* floating point exceptions. */ - -/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */ - -/* TISBOD now gets the TSIPM matrix from PCKMAT. */ -/* Reference frame calculation moved to end. */ - -/* - SPICELIB Version 3.0.1, 07-OCT-1994 (KSZ) */ - -/* TISBOD bug which mistakenly moded DW by 2PI */ -/* was removed. */ - -/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */ - -/* TISBOD now uses new software to check for the */ -/* existence of binary PCK files, search the for */ -/* data corresponding to the requested body and time, */ -/* and return the appropriate Euler angles. Otherwise */ -/* the code calculates the Euler angles from the */ -/* P_constants kernel file. */ - -/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */ - -/* Updated to handle P_constants referenced to different epochs */ -/* and inertial reference frames. */ - -/* TISBOD now checks the kernel pool for presence of the */ -/* variables */ - -/* BODY#_CONSTANTS_REF_FRAME */ - -/* and */ - -/* BODY#_CONSTANTS_JED_EPOCH */ - -/* where # is the NAIF integer code of the barycenter of a */ -/* planetary system or of a body other than a planet or */ -/* satellite. If either or both of these variables are */ -/* present, the P_constants for BODY are presumed to be */ -/* referenced to the specified inertial frame or epoch. */ -/* If the epoch of the constants is not J2000, the input */ -/* time ET is converted to seconds past the reference epoch. */ -/* If the frame of the constants is not the frame specified */ -/* by REF, the rotation from the P_constants' frame to */ -/* body-fixed coordinates is transformed to the rotation from */ -/* the requested frame to body-fixed coordinates. The same */ -/* transformation is applied to the derivative of this */ -/* rotation. */ - -/* Due to the prescience of the original author, the code */ -/* was already prepared to handle the possibility of */ -/* specification of a P_constants inertial reference frame via */ -/* kernel pool variables. */ - - -/* Also, the $Required_Reading and $Literature_References */ -/* sections were updated. The SPK required reading has been */ -/* deleted from the $Literature_References section, and the */ -/* NAIF_IDS, KERNEL, and TIME Required Reading files have */ -/* been added in the $Required_Reading section. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("TISBOD", (ftnlen)6); - } - -/* Get the code for the J2000 frame, if we don't have it yet. */ - - if (first) { - irfnum_("J2000", &j2code, (ftnlen)5); - first = FALSE_; - } - irfnum_(ref, &reqref, ref_len); - -/* Get state transformation matrix from high precision PCK file, if */ -/* available. */ - - pckmat_(body, et, &pcref, tsipm, &found); - if (! found) { - -/* The data for the frame of interest are not available in a */ -/* loaded binary PCK file. This is not an error: the data may be */ -/* present in the kernel pool. */ - -/* Conduct a non-error-signaling check for the presence of a */ -/* kernel variable that is required to implement an IAU style */ -/* body-fixed reference frame. If the data aren't available, we */ -/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */ -/* we want to issue the error signal locally, with a better error */ -/* message. */ - - s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8); - repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1); - if (! found) { - -/* Now we do have an error. */ - -/* We don't have the data we'll need to produced the requested */ -/* state transformation matrix. In order to create an error */ -/* message understandable to the user, find, if possible, the */ -/* name of the reference frame associated with the input body. */ -/* Note that the body is really identified by a PCK frame class */ -/* ID code, though most of the documentation just calls it a */ -/* body ID code. */ - - ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32); - etcal_(et, timstr, (ftnlen)35); - s_copy(errmsg, "PCK data required to compute the orientation of " - "the # # for epoch # TDB were not found. If these data we" - "re to be provided by a binary PCK file, then it is possi" - "ble that the PCK file does not have coverage for the spe" - "cified body-fixed frame at the time of interest. If the " - "data were to be provided by a text PCK file, then possib" - "ly the file does not contain data for the specified body" - "-fixed frame. In either case it is possible that a requi" - "red PCK file was not loaded at all.", (ftnlen)1840, ( - ftnlen)475); - -/* Fill in the variable data in the error message. */ - - if (found) { - -/* The frame system knows the name of the body-fixed frame. */ - - setmsg_(errmsg, (ftnlen)1840); - errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16); - errch_("#", fixfrm, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)35); - } else { - -/* The frame system doesn't know the name of the */ -/* body-fixed frame, most likely due to a missing */ -/* frame kernel. */ - - suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840); - setmsg_(errmsg, (ftnlen)1840); - errch_("#", "body-fixed frame associated with the ID code", ( - ftnlen)1, (ftnlen)44); - errint_("#", body, (ftnlen)1); - errch_("#", timstr, (ftnlen)1, (ftnlen)35); - errch_("#", "Also, a frame kernel defining the body-fixed fr" - "ame associated with body # may need to be loaded.", ( - ftnlen)1, (ftnlen)96); - errint_("#", body, (ftnlen)1); - } - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("TISBOD", (ftnlen)6); - return 0; - } -/* Find the body code used to label the reference frame and epoch */ -/* specifiers for the orientation constants for BODY. */ - -/* For planetary systems, the reference frame and epoch for the */ -/* orientation constants is associated with the system */ -/* barycenter, not with individual bodies in the system. For any */ -/* other bodies, (the Sun or asteroids, for example) the body's */ -/* own code is used as the label. */ - - refid = zzbodbry_(body); - -/* Look up the epoch of the constants. The epoch is specified */ -/* as a Julian ephemeris date. The epoch defaults to J2000. */ - - s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25); - repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(item, &c__1, &c__1, &dim, &pckepc, &found, (ftnlen)32); - if (found) { - -/* The reference epoch is returned as a JED. Convert to */ -/* ephemeris seconds past J2000. Then convert the input */ -/* ET to seconds past the reference epoch. */ - - pckepc = spd_() * (pckepc - j2000_()); - epoch = *et - pckepc; - } else { - epoch = *et; - } - -/* Look up the reference frame of the constants. The reference */ -/* frame is specified by a code recognized by CHGIRF. The default */ -/* frame is J2000, symbolized by the code J2CODE. */ - - s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25); - repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32); - gdpool_(item, &c__1, &c__1, &dim, &pckref, &found, (ftnlen)32); - if (found) { - pcref = i_dnnt(&pckref); - } else { - pcref = j2code; - } - -/* Whatever the body, it has quadratic time polynomials for */ -/* the RA and Dec of the pole, and for the rotation of the */ -/* Prime Meridian. */ - - s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7); - cleard_(&c__3, rcoef); - bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32); - s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8); - cleard_(&c__3, dcoef); - bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32); - s_copy(item, "PM", (ftnlen)32, (ftnlen)2); - cleard_(&c__3, wcoef); - bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32); - -/* If the body is a satellite, there may be additional nutation */ -/* and libration (THETA) terms. */ - - ntheta = 0; - npairs = 0; - na = 0; - nd = 0; - nw = 0; - s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15); - -/* There is something a bit obscure going on below. We are */ -/* passing a two dimensional array ( TCOEF(2, MAXANG) ). But */ -/* BODVCD is expecting a 1- dimensional array. BODVCD loads the */ -/* array TCOEF in the following order */ - -/* TCOEF(1,1), TCOEF(2,1), TCOEF(1,2), TCOEF(2,2), ... */ - -/* The NTHETA that comes back is the total number of items */ -/* loaded, but we will need the actual limit on the second */ -/* dimension. That is --- NTHETA / 2. */ - - if (bodfnd_(&refid, item, (ftnlen)32)) { - bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32); - npairs = ntheta / 2; - } - -/* Look up the right ascension nutations in the precession of the */ -/* pole. NA is the number of Ascension coefficients. AC are the */ -/* Ascension coefficients. */ - - s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32); - } - -/* Look up the declination nutations in the precession of the */ -/* pole. ND is the number of Declination coefficients. DC are */ -/* the Declination coefficients. */ - - s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32); - } - -/* Finally look up the prime meridian nutations. NW is the */ -/* number of coefficients. WC is the array of coefficients. */ - - s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11); - if (bodfnd_(body, item, (ftnlen)32)) { - bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32); - } - -/* The number of coefficients returned had better not be bigger */ -/* than the number of angles we are going to compute. If it */ -/* is we simply signal an error and bag it, fer sure. */ - -/* Computing MAX */ - i__1 = max(na,nd); - if (max(i__1,nw) > npairs) { - setmsg_("TISBOD: Insufficient number of nutation/precession angl" - "es for body * at time #.", (ftnlen)79); - errint_("*", body, (ftnlen)1); - errdp_("#", et, (ftnlen)1); - sigerr_("SPICE(INSUFFICIENTANGLES)", (ftnlen)25); - chkout_("TISBOD", (ftnlen)6); - return 0; - } - -/* Evaluate the time polynomials and their derivatives w.r.t. */ -/* EPOCH at EPOCH. */ - -/* Evaluate the time polynomials at EPOCH. */ - - d__ = spd_(); - t = d__ * 36525.; - ra = rcoef[0] + epoch / t * (rcoef[1] + epoch / t * rcoef[2]); - dec = dcoef[0] + epoch / t * (dcoef[1] + epoch / t * dcoef[2]); - w = wcoef[0] + epoch / d__ * (wcoef[1] + epoch / d__ * wcoef[2]); - dra = (rcoef[1] + epoch / t * 2. * rcoef[2]) / t; - ddec = (dcoef[1] + epoch / t * 2. * dcoef[2]) / t; - dw = (wcoef[1] + epoch / d__ * 2. * wcoef[2]) / d__; - -/* Compute the nutations and librations (and their derivatives) */ -/* as appropriate. */ - - i__1 = npairs; - for (i__ = 1; i__ <= i__1; ++i__) { - theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 : - s_rnge("tcoef", i__2, "tisbod_", (ftnlen)1005)] + epoch / - t * tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? - i__3 : s_rnge("tcoef", i__3, "tisbod_", (ftnlen)1005)]) * - rpd_(); - dtheta = tcoef[(i__2 = (i__ << 1) - 1) < 200 && 0 <= i__2 ? i__2 : - s_rnge("tcoef", i__2, "tisbod_", (ftnlen)1006)] / t * - rpd_(); - sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth", - i__2, "tisbod_", (ftnlen)1008)] = sin(theta); - costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh", - i__2, "tisbod_", (ftnlen)1009)] = cos(theta); - dsinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("dsin" - "th", i__2, "tisbod_", (ftnlen)1010)] = cos(theta) * - dtheta; - dcosth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("dcos" - "th", i__2, "tisbod_", (ftnlen)1011)] = -sin(theta) * - dtheta; - } - -/* Adjust RA, DEC, W and their derivatives by the librations */ -/* and nutations. */ - - ra += vdotg_(ac, sinth, &na); - dec += vdotg_(dc, costh, &nd); - w += vdotg_(wc, sinth, &nw); - dra += vdotg_(ac, dsinth, &na); - ddec += vdotg_(dc, dcosth, &nd); - dw += vdotg_(wc, dsinth, &nw); - -/* Convert from degrees to radians */ - - ra *= rpd_(); - dec *= rpd_(); - w *= rpd_(); - dra *= rpd_(); - ddec *= rpd_(); - dw *= rpd_(); - -/* Convert to Euler angles. */ - - d__1 = twopi_(); - w = d_mod(&w, &d__1); - phi = ra + halfpi_(); - delta = halfpi_() - dec; - dphi = dra; - ddelta = -ddec; - if (failed_()) { - chkout_("TISBOD", (ftnlen)6); - return 0; - } - -/* Pack the Euler angles and their derivatives into */ -/* a state vector. */ - - vpack_(&w, &delta, &phi, eulsta); - vpack_(&dw, &ddelta, &dphi, &eulsta[3]); - -/* Find the state transformation defined by the Euler angle */ -/* state vector. The transformation matrix TSIPM has the */ -/* following structure: */ - -/* - - */ -/* | : | */ -/* | TIPM : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | DTIPM : TIPM | */ -/* | : | */ -/* - - */ - - eul2xf_(eulsta, &c__3, &c__1, &c__3, tsipm); - } - -/* At this point the base frame PCREF has been determined. */ - -/* If the requested base frame is not base frame associated with the */ -/* PCK data, adjust the transformation matrix TSIPM to map from the */ -/* requested frame to the body-fixed frame. */ - - if (reqref != pcref) { - -/* Next get the position transformation from the user specified */ -/* inertial frame to the native PCK inertial frame. */ - - irfrot_(&reqref, &pcref, req2pc); - if (failed_()) { - chkout_("TISBOD", (ftnlen)6); - return 0; - } - -/* Since we're applying an inertial transformation to TSIPM, */ -/* we can rotate the non-zero blocks of TSIPM. This saves */ -/* a bunch of double precision multiplications. */ - -/* Extract the upper and lower left blocks of TSIPM. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("tipm", i__1, "tisbod_", (ftnlen)1109)] = - tsipm[(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? - i__2 : s_rnge("tsipm", i__2, "tisbod_", (ftnlen)1109)] - ; - dtipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("dtipm", i__1, "tisbod_", (ftnlen)1110)] = - tsipm[(i__2 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__2 ? - i__2 : s_rnge("tsipm", i__2, "tisbod_", (ftnlen)1110) - ]; - } - } - -/* Rotate the blocks. Note this is a right multiplication. */ - - mxm_(tipm, req2pc, xtipm); - mxm_(dtipm, req2pc, xdtipm); - -/* Replace the non-zero blocks of TSIPM. This gives us the */ -/* transformation from the requested frame to the */ -/* bodyfixed frame. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - tsipm[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("tsipm", i__1, "tisbod_", (ftnlen)1131)] = - xtipm[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("xtipm", i__2, "tisbod_", (ftnlen)1131)] - ; - tsipm[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("tsipm", i__1, "tisbod_", (ftnlen)1132)] - = xtipm[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("xtipm", i__2, "tisbod_", (ftnlen)1132)] - ; - tsipm[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("tsipm", i__1, "tisbod_", (ftnlen)1133)] = - xdtipm[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("xdtipm", i__2, "tisbod_", (ftnlen)1133) - ]; - } - } - } - -/* That's all folks. Check out and get out. */ - - chkout_("TISBOD", (ftnlen)6); - return 0; -} /* tisbod_ */ - diff --git a/ext/spice/src/cspice/tisbod_c.c b/ext/spice/src/cspice/tisbod_c.c deleted file mode 100644 index 5f0b69cebc..0000000000 --- a/ext/spice/src/cspice/tisbod_c.c +++ /dev/null @@ -1,505 +0,0 @@ -/* - --Procedure tisbod_c ( Transformation, inertial state to bodyfixed ) - --Abstract - - Return a 6x6 matrix that transforms states in inertial coordinates to - states in body-equator-and-prime-meridian coordinates. - --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 - - PCK - NAIF_IDS - ROTATION - TIME - --Keywords - - None. - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void tisbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tsipm[6][6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - ref I ID of inertial reference frame to transform from - body I ID code of body - et I Epoch of transformation - tsipm O Transformation (state), inertial to prime meridian - --Detailed_Input - - ref is the NAIF name for an inertial reference frame. - Acceptable names include: - - Name Description - -------- -------------------------------- - "J2000" Earth mean equator, dynamical - equinox of J2000 - - "B1950" Earth mean equator, dynamical - equinox of B1950 - - "FK4" Fundamental Catalog (4) - - "DE-118" JPL Developmental Ephemeris (118) - - "DE-96" JPL Developmental Ephemeris ( 96) - - "DE-102" JPL Developmental Ephemeris (102) - - "DE-108" JPL Developmental Ephemeris (108) - - "DE-111" JPL Developmental Ephemeris (111) - - "DE-114" JPL Developmental Ephemeris (114) - - "DE-122" JPL Developmental Ephemeris (122) - - "DE-125" JPL Developmental Ephemeris (125) - - "DE-130" JPL Developmental Ephemeris (130) - - "GALACTIC" Galactic System II - - "DE-200" JPL Developmental Ephemeris (200) - - "DE-202" JPL Developmental Ephemeris (202) - - (See the routine chgirf_c for a full list of names.) - - The output tipm will give the transformation - from this frame to the bodyfixed frame specified by - body at the epoch specified by et. - - body is the integer ID code of the body for which the - state transformation matrix is requested. Bodies - are numbered according to the standard NAIF - numbering scheme. The numbering scheme is - explained in the NAIF_IDS required reading file. - - et is the epoch at which the state transformation - matrix is requested. (This is typically the - epoch of observation minus the one-way light time - from the observer to the body at the epoch of - observation.) - --Detailed_Output - - tsipm is a 6x6 transformation matrix. It is used to - transform states from inertial coordinates to body - fixed (also called equator and prime meridian --- PM) - - - Given a state s in the inertial reference frame - specified by ref, the corresponding bodyfixed state - is given by the matrix vector product: - - tsipm * s - - The X axis of the PM system is directed to the - intersection of the equator and prime meridian. - The Z axis points along the spin axis and points - towards the same side of the invariable plane of - the solar system as does earth's north pole. - - NOTE: The inverse of tsipm is NOT its transpose. - The matrix tsipm has the structure shown below: - - - - - | : | - | r : 0 | - | ......:......| - | : | - | dr_dt : r | - | : | - - - - - where r is a time varying rotation matrix and - dr_dt is its derivative. The inverse of this - matrix is: - - - - - | T : | - | r : 0 | - | .......:.......| - | : | - | T : T | - | dr_dt : r | - | : | - - - - - The CSPICE routine invstm_c is available for - producing this inverse. - --Parameters - - None. - --Exceptions - - 1) If the kernel pool does not contain all of the data required - for computing the transformation matrix, tsipm, the error - SPICE(INSUFFICIENTANGLES) is signalled. - - 2) If the reference frame ref is not recognized, a routine - called by tisbod_c will diagnose the condition and invoke the - SPICE error handling system. - - 3) If the specified ID code body is not recognized, the - error is diagnosed by a routine called by tisbod_c. - --Files - - None. - --Particulars - - The matrix for transforming inertial states to bodyfixed - states is the 6x6 matrix shown below as a block structured - matrix. - - - - - | : | - | tipm : 0 | - | ......:......| - | : | - | dtipm : tipm | - | : | - - - - - This can also be expressed in terms of Euler angles - phi, delta and w. The transformation from inertial to - bodyfixed coordinates is represented in the SPICE kernel - pool as: - - tipm = [w] [delta] [phi] - 3 1 3 - Thus - - dtipm = D[w] /Dt [delta] [phi] - 3 1 3 - - + [w] D[delta] /Dt [phi] - 3 1 3 - - + [w] [delta] D[phi] /Dt - 3 1 3 - - If a binary PCK file record can be used for the time and - body requested, it will be used. The most recently loaded - binary PCK file has first priority, followed by previously - loaded binary PCK files in backward time order. If no - binary PCK file has been loaded, the text P_constants - kernel file is used. - - If there is only text PCK kernel information, it is - expressed in terms of ra, dec and w (same w as above), where - - ra = phi - pi/2 - dec = pi/2 - delta - - The angles ra, dec, and w are defined as follows in the - text PCK file: - - 2 ____ - ra2*t \ - ra = ra0 + ra1*t/T + ------ + / a sin theta - 2 ---- i i - T i - - 2 ____ - dec2*t \ - dec = dec0 + dec1*t/T + ------- + / d cos theta - 2 ---- i i - T i - - - 2 ____ - w2*t \ - w = w0 + w1*t/d + ----- + / w sin theta - 2 ---- i i - d i - - - where: - - d = seconds/day - - T = seconds/Julian century - - a , d , and w arrays apply to satellites only. - i i i - - theta = THETA0(i) + THETA1(i)*t/T are specific to each - i - - planet. - - - These angles -- typically nodal rates -- vary in number and - definition from one planetary system to the next. - - Thus - ____ - 2*ra2*t \ - dra/dt = ra1/T + ------- + / a THETA1(i)/T cos theta - 2 ---- i i - T i - - ____ - 2*dec2*t \ - ddec/dt = dec1/T + -------- - / d THETA1(i)/T sin theta - 2 ---- i i - T i - - ____ - 2*w2*t \ - dw/dt = w1/d + ------ + / w THETA1(i)/T cos theta - 2 ---- i i - d i - --Examples - - Note that the data needed to compute the output state transition - matrix must have been made available to your program by having - loaded an appropriate binary or text PCK file via furnsh_c. - - Example 1. - - In the following code fragment, tisbod_c is used to transform - a state in J2000 inertial coordinates to a state in bodyfixed - coordinates. - - The 6-vector eulang represents the inertial state (position and - velocity) of an object with respect to the center of the body - at time et. - - #include "SpiceUsr.h" - . - . - . - - /. - First load the kernel pool. - ./ - furnsh_c ( "planetary_constants.ker" ); - - /. - Next get the transformation and its derivative. - ./ - tisbod_c ( "J2000", body, et, tsipm ); - - /. - Convert position to bodyfixed coordinates. - ./ - mxvg_c ( tsipm, eulang, 6, 6, bdstat ); - - - Example 2. - - In the example below, tisbod_c is used to compute the angular - velocity vector (with respect to an inertial frame) of the - specified body at time et. - - #include "SpiceUsr.h" - . - . - . - /. - First get the state transformation matrix. - ./ - tisbod_c ( body, et, tsipm ); - - - /. - This matrix has the form: - - - - - | : | - | tipm : 0 | - | ......:......| - | : | - | dtipm : tipm | - | : | - - - - - We extract tipm and dtipm: - ./ - - - for ( i = 0; i<3; i++ ) - { - for ( j = 0; j<3; j++ ) - { - tipm [i][j] = tsipm[i ][j]; - dtipm [i][j] = tsipm[i+3][j]; - } - } - - - /. - - The transposes of tipm and dtipm, (tpmi and dtpmi), give - the transformation from bodyfixed coordinates to inertial - coordinates and its time derivative. - - Here is a fact about the relationship between angular - velocity associated with a time varying rotation matrix - that gives the orientation of a body with respect to - an inertial frame: - - The angular velocity vector can be read from the off - diagonal components of the matrix product: - - t - omega = dtpmi * tpmi - - t - = dtipm * tipm - - the components of the angular velocity v will appear - in this matrix as: - - _ _ - | | - | 0 -v(3) v(2) | - | | - | v(3) 0 -v(1) | - | | - | -v(2) v(1) 0 | - |_ _| - - - Pick off the angular velocity components from omega. - - ./ - - mtxm_c ( dtipm, tipm, omega ); - - v[0] = omega [2][1]; - v[1] = omega [0][2]; - v[2] = omega [1][0]; - - --Restrictions - - The kernel pool must be loaded with the appropriate coefficients - (from the P_constants kernel or binary PCK file) prior to calling - this routine. - --Literature_References - - None. - --Author_and_Institution - - N. J. Bachman (JPL) - W. L. Taber (JPL) - K. S. Zukor (JPL) - --Version - - -CSPICE Version 1.0.3, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.2, 10-NOV-2006 (EDW) - - Replace mention of ldpool_c and pcklof_c with furnsh_c. - Added Keywords and Parameters section headers. - Reordered section headers. - - -CSPICE Version 1.0.1, 02-JUL-2003 (EDW) - - Corrected trivial typo in the Version 1.0.0 line. - The typo caused an integrity check script to fail. - - -CSPICE Version 1.0.0, 20-JUN-1999 (NJB) (WLT) (KSZ) - - Initial release, based on SPICELIB Version 3.3.0, 29-MAR-1995 - --Index_Entries - - transformation from inertial state to bodyfixed - --& -*/ - -{ /* Begin tisbod_c */ - - - /* - Participate in tracing. - */ - chkin_c ( "tisbod_c" ); - - - /* - Check the input string ref to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "tisbod_c", ref ); - - - /* - Call the f2c'd Fortran routine. - */ - tisbod_ ( ( char * ) ref, - ( integer * ) &body, - ( doublereal * ) &et, - ( doublereal * ) tsipm, - ( ftnlen ) strlen(ref) ); - - /* - Transpose the output from tisbod_ to put the matrix in row-major - order, which is what C uses. - */ - xpose6_c ( tsipm, tsipm ); - - - chkout_c ( "tisbod_c" ); - -} /* End tisbod_c */ diff --git a/ext/spice/src/cspice/tkfram.c b/ext/spice/src/cspice/tkfram.c deleted file mode 100644 index 68bd12a304..0000000000 --- a/ext/spice/src/cspice/tkfram.c +++ /dev/null @@ -1,881 +0,0 @@ -/* tkfram.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__20 = 20; -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__9 = 9; -static doublereal c_b95 = -1.; -static integer c__3 = 3; -static integer c__4 = 4; -static integer c__14 = 14; - -/* $Procedure TKFRAM (Text kernel frame transformation ) */ -/* Subroutine */ int tkfram_(integer *id, doublereal *rot, integer *frame, - logical *found) -{ - /* Initialized data */ - - static integer at = 0; - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2], i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - static char name__[32]; - static integer tail; - static char spec[32], item[32*14]; - static integer idnt[1], axes[3]; - static logical full; - static integer pool[52] /* was [2][26] */; - extern doublereal vdot_(doublereal *, doublereal *); - static char type__[1]; - static doublereal qtmp[4]; - extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal - *, integer *, integer *, integer *, doublereal *); - static integer i__, n, r__; - static doublereal buffd[180] /* was [9][20] */; - static integer buffi[20] /* was [1][20] */, oldid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char agent[32]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - ident_(doublereal *), errch_(char *, char *, ftnlen, ftnlen); - static doublereal tempd; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen) - , vhatg_(doublereal *, integer *, doublereal *); - extern integer lnktl_(integer *, integer *); - static char idstr[32]; - extern integer rtrim_(char *, ftnlen); - static char versn[8], units[32]; - static integer ar; - extern logical failed_(void), badkpv_(char *, char *, char *, integer *, - integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - static char frname[32]; - static doublereal angles[3]; - static char oldagt[32]; - static logical buffrd; - extern /* Subroutine */ int locati_(integer *, integer *, integer *, - integer *, integer *, logical *), frmnam_(integer *, char *, - ftnlen), namfrm_(char *, integer *, ftnlen); - static logical update; - static char altnat[32]; - extern /* Subroutine */ int lnkini_(integer *, integer *); - extern integer lnknfn_(integer *); - static integer idents[20] /* was [1][20] */; - extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer - *, char *, logical *, ftnlen, ftnlen), gdpool_(char *, integer *, - integer *, integer *, doublereal *, logical *, ftnlen), sigerr_( - char *, ftnlen), gipool_(char *, integer *, integer *, integer *, - integer *, logical *, ftnlen), chkout_(char *, ftnlen), sharpr_( - doublereal *), dtpool_(char *, logical *, integer *, char *, - ftnlen, ftnlen), setmsg_(char *, ftnlen); - static doublereal matrix[9] /* was [3][3] */; - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), dwpool_( - char *, ftnlen), errint_(char *, integer *, ftnlen), vsclip_( - doublereal *, doublereal *); - static doublereal quatrn[4]; - extern /* Subroutine */ int convrt_(doublereal *, char *, char *, - doublereal *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int q2m_(doublereal *, doublereal *), intstr_( - integer *, char *, ftnlen), swpool_(char *, integer *, char *, - ftnlen, ftnlen); - static logical fnd; - static char alt[32*14]; - -/* $ Abstract */ - -/* This routine returns the rotation from the input frame */ -/* specified by ID to the associated frame given by FRAME. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Keywords */ - -/* POINTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ---------------------------------------------- */ -/* ID I Class identification code for the instrument */ -/* ROT O The rotation from ID to FRAME. */ -/* FRAME O The integer code of some reference frame. */ -/* FOUND O TRUE if the rotation could be determined. */ - -/* $ Detailed_Input */ - -/* ID The identification code used to specify an */ -/* instrument in the SPICE system. */ - -/* $ Detailed_Output */ - -/* ROT is a rotation matrix that gives the transformation */ -/* from the frame specified by ID to the frame */ -/* specified by FRAME. */ - -/* FRAME is the id code of the frame used to define the */ -/* orientation of the frame given by ID. ROT gives */ -/* the transformation from the IF frame to */ -/* the frame specified by FRAME. */ - -/* FOUND is a logical indicating whether or not a frame */ -/* definition for frame ID was constructed from */ -/* kernel pool data. If ROT and FRAME were constructed */ -/* FOUND will be returned with the value TRUE. */ -/* Otherwise it will be returned with the value FALSE. */ - -/* $ Parameters */ - -/* BUFSIZ is the number of rotation, frame id pairs that */ -/* can have their instance data buffered for the */ -/* sake of improving run-time performance. This */ -/* value MUST be positive and should probably be */ -/* at least 10. */ - -/* $ Exceptions */ - -/* 1) If some instance value associated with this frame */ -/* cannot be located, or does not have the proper type */ -/* or dimension, the error will be diagnosed by the */ -/* routine BADKPV. In such a case FOUND will be set to .FALSE. */ - -/* 2) If the input ID has the value 0, the error */ -/* SPICE(ZEROFRAMEID) will be signaled. FOUND will be set */ -/* to FALSE. */ - -/* 3) If the name of the frame corresponding to ID cannot be */ -/* determined, the error 'SPICE(INCOMPLETEFRAME)' is signaled. */ - -/* 4) If the frame given by ID is defined relative to a frame */ -/* that is unrecognized, the error SPICE(BADFRAMESPEC) */ -/* will be signaled. FOUND will be set to FALSE. */ - -/* 5) If the kernel pool specification for ID is not one of */ -/* MATRIX, ANGLES, or QUATERNION, then the error */ -/* SPICE(UNKNOWNFRAMESPEC) will be signaled. FOUND will be */ -/* set to FALSE. */ - -/* $ Files */ - -/* This routine makes use of the loaded text kernels to */ -/* determine the rotation from a constant offset frame */ -/* to its defining frame. */ - -/* $ Particulars */ - -/* This routine is used to construct the rotation from some frame */ -/* that is a constant rotation offset from some other reference */ -/* frame. This rotation is derived from data stored in the kernel */ -/* pool. */ - -/* It is considered to be an low level routine that */ -/* will need to be called directly only by persons performing */ -/* high volume processing. */ - -/* $ Examples */ - -/* This is intended to be used as a low level routine by */ -/* the frame system software. However, you could use this */ -/* routine to directly retrieve the rotation from an offset */ -/* frame to its relative frame. One instance in which you */ -/* might do this is if you have a properly specified topocentric */ -/* frame for some site on earth and you wish to determine */ -/* the geodetic latitude and longitude of the site. Here's how. */ - -/* Suppose the name of the topocentric frame is: 'MYTOPO'. */ -/* First we get the id-code of the topocentric frame. */ - -/* CALL NAMFRM ( 'MYTOPO', FRCODE ) */ - -/* Next get the rotation from the topocentric frame to */ -/* the bodyfixed frame. */ - -/* CALL TKFRAM ( FRCODE, ROT, FRAME, FOUND ) */ - -/* Make sure the topoframe is relative to one of the earth */ -/* fixed frames. */ - -/* CALL FRMNAM( FRAME, TEST ) */ - -/* IF ( TEST .NE. 'IAU_EARTH' */ -/* . .AND. TEST .NE. 'EARTH_FIXED' */ -/* . .AND. TEST .NE. 'ITRF93' ) THEN */ - -/* WRITE (*,*) 'The frame MYTOPO does not appear to be ' */ -/* WRITE (*,*) 'defined relative to an earth fixed frame.' */ -/* STOP */ - -/* END IF */ - -/* Things look ok. Get the location of the Z-axis in the */ -/* topocentric frame. */ - -/* Z(1) = ROT(1,3) */ -/* Z(2) = ROT(2,3) */ -/* Z(3) = ROT(3,3) */ - -/* Convert the Z vector to latitude longitude and radius. */ - -/* CALL RECLAT ( Z, LAT, LONG, RAD ) */ - -/* WRITE (*,*) 'The geodetic coordinates of the center of' */ -/* WRITE (*,*) 'the topographic frame are: ' */ -/* WRITE (*,*) */ -/* WRITE (*,*) 'Latitude (deg): ', LAT *DPR() */ -/* WRITE (*,*) 'Longitude (deg): ', LONG*DPR() */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 23-APR-2009 (NJB) */ - -/* Bug fix: watch is deleted only for frames */ -/* that are deleted from the buffer. */ - -/* - SPICELIB Version 2.0.0, 19-MAR-2009 (NJB) */ - -/* Bug fix: this routine now deletes watches set on */ -/* kernel variables of frames that are discarded from */ -/* the local buffering system. */ - -/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CONVRT, UCRSS, VHATG and VSCL calls. */ - -/* - SPICELIB Version 1.1.0, 21-NOV-2001 (FST) */ - -/* Updated this routine to dump the buffer of frame ID codes */ -/* it saves when it or one of the modules in its call tree signals */ -/* an error. This fixes a bug where a frame's ID code is */ -/* buffered, but the matrix and kernel pool watcher were not set */ -/* properly. */ - -/* - SPICELIB Version 1.0.0, 18-NOV-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Fetch the rotation and frame of a text kernel frame */ -/* Fetch the rotation and frame of a constant offset frame */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in CONVRT, UCRSS, VHATG and VSCL calls. */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Programmer's note: this routine makes use of the *implementation* */ -/* of LOCATI. If that routine is changed, the logic this routine */ -/* uses to locate buffered, old frame IDs may need to change as well. */ - - -/* Before we even check in, if N is less than 1 we can */ -/* just return. */ - - -/* Perform any initializations that might be needed for this */ -/* routine. */ - - if (first) { - first = FALSE_; - s_copy(versn, "1.0.0", (ftnlen)8, (ftnlen)5); - lnkini_(&c__20, pool); - } - -/* Now do the standard SPICE error handling. Sure this is */ -/* a bit unconventional, but nothing will be hurt by doing */ -/* the stuff above first. */ - - if (return_()) { - return 0; - } - chkin_("TKFRAM", (ftnlen)6); - -/* So far, we've not FOUND the rotation to the specified frame. */ - - *found = FALSE_; - -/* Check the ID to make sure it is non-zero. */ - - if (*id == 0) { - lnkini_(&c__20, pool); - setmsg_("Frame identification codes are required to be non-zero. Yo" - "u've specified a frame with ID value zero. ", (ftnlen)102); - sigerr_("SPICE(ZEROFRAMEID)", (ftnlen)18); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* Find out whether our linked list pool is already full. */ -/* We'll use this information later to decide whether we're */ -/* going to have to delete a watcher. */ - - full = lnknfn_(pool) == 0; - if (full) { - -/* If the input frame ID is not buffered, we'll need to */ -/* overwrite an existing buffer entry. In this case */ -/* the call to LOCATI we're about to make will overwrite */ -/* the ID code in the slot we're about to use. We need */ -/* this ID code, so extract it now while we have the */ -/* opportunity. The old ID sits at the tail of the list */ -/* whose head node is AT. */ - - tail = lnktl_(&at, pool); - oldid = idents[(i__1 = tail - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "idents", i__1, "tkfram_", (ftnlen)413)]; - -/* Create the name of the agent associated with the old */ -/* frame. */ - - s_copy(oldagt, "TKFRAME_#", (ftnlen)32, (ftnlen)9); - repmi_(oldagt, "#", &oldid, oldagt, (ftnlen)32, (ftnlen)1, (ftnlen)32) - ; - } - -/* Look up the address of the instance data. */ - - idnt[0] = *id; - locati_(idnt, &c__1, idents, pool, &at, &buffrd); - if (full && ! buffrd) { - -/* Since the buffer is already full, we'll delete the watcher for */ -/* the kernel variables associated with OLDID, since there's no */ -/* longer a need for that watcher. */ - -/* First clear the update status of the old agent; DWPOOL won't */ -/* delete an agent with a unchecked update. */ - - cvpool_(oldagt, &update, (ftnlen)32); - dwpool_(oldagt, (ftnlen)32); - } - -/* Until we have better information we put the identity matrix */ -/* into the output rotation and set FRAME to zero. */ - - ident_(rot); - *frame = 0; - -/* If we have to look up the data for our frame, we do */ -/* it now and perform any conversions and computations that */ -/* will be needed when it's time to convert coordinates to */ -/* directions. */ - -/* Construct the name of the agent associated with the */ -/* requested frame. (Each frame has its own agent). */ - - intstr_(id, idstr, (ftnlen)32); - frmnam_(id, frname, (ftnlen)32); - if (s_cmp(frname, " ", (ftnlen)32, (ftnlen)1) == 0) { - lnkini_(&c__20, pool); - setmsg_("The Text Kernel (TK) frame with id-code # does not have a r" - "ecognized name. ", (ftnlen)75); - errint_("#", id, (ftnlen)1); - sigerr_("SPICE(INCOMPLETFRAME)", (ftnlen)21); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } -/* Writing concatenation */ - i__2[0] = 8, a__1[0] = "TKFRAME_"; - i__2[1] = 32, a__1[1] = idstr; - s_cat(agent, a__1, i__2, &c__2, (ftnlen)32); - r__ = rtrim_(agent, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 8, a__1[0] = "TKFRAME_"; - i__2[1] = 32, a__1[1] = frname; - s_cat(altnat, a__1, i__2, &c__2, (ftnlen)32); - ar = rtrim_(altnat, (ftnlen)32); - -/* If the frame is buffered, we check the kernel pool to */ -/* see if there has been an update to this frame. */ - - if (buffrd) { - cvpool_(agent, &update, r__); - } else { - -/* If the frame is not buffered we definitely need to update */ -/* things. */ - update = TRUE_; - } - if (! update) { - -/* Just look up the rotation matrix and relative-to */ -/* information from the local buffer. */ - - rot[0] = buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)506)]; - rot[1] = buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)507)]; - rot[2] = buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)508)]; - rot[3] = buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)509)]; - rot[4] = buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)510)]; - rot[5] = buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)511)]; - rot[6] = buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)512)]; - rot[7] = buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)513)]; - rot[8] = buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge( - "buffd", i__1, "tkfram_", (ftnlen)514)]; - *frame = buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "buffi", i__1, "tkfram_", (ftnlen)516)]; - } else { - -/* Determine how the frame is specified and what it */ -/* is relative to. The variables that specify */ -/* how the frame is represented and what it is relative to */ -/* are TKFRAME_#_SPEC and TKFRAME_#_RELATIVE where # is */ -/* replaced by the text value of ID or the frame name. */ - -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 5, a__1[1] = "_SPEC"; - s_cat(item, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 9, a__1[1] = "_RELATIVE"; - s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 5, a__1[1] = "_SPEC"; - s_cat(alt, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 9, a__1[1] = "_RELATIVE"; - s_cat(alt + 32, a__1, i__2, &c__2, (ftnlen)32); - -/* See if the friendlier version of the kernel pool variables */ -/* are available. */ - - for (i__ = 1; i__ <= 2; ++i__) { - dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 : - s_rnge("alt", i__1, "tkfram_", (ftnlen)537)) << 5), found, - &n, type__, (ftnlen)32, (ftnlen)1); - if (*found) { - s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 : - s_rnge("item", i__1, "tkfram_", (ftnlen)540)) << 5), - alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ? i__3 : - s_rnge("alt", i__3, "tkfram_", (ftnlen)540)) << 5), ( - ftnlen)32, (ftnlen)32); - } - } - -/* If either the SPEC or RELATIVE frame are missing from */ -/* the kernel pool, we simply return. */ - - if (badkpv_("TKFRAM", item, "=", &c__1, &c__1, "C", (ftnlen)6, ( - ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM", item + - 32, "=", &c__1, &c__1, "C", (ftnlen)6, (ftnlen)32, (ftnlen)1, - (ftnlen)1)) { - lnkini_(&c__20, pool); - *frame = 0; - ident_(rot); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* If we make it this far, look up the SPEC and RELATIVE frame. */ - - gcpool_(item, &c__1, &c__1, &n, spec, &fnd, (ftnlen)32, (ftnlen)32); - gcpool_(item + 32, &c__1, &c__1, &n, name__, &fnd, (ftnlen)32, ( - ftnlen)32); - -/* Look up the id-code for this frame. */ - - namfrm_(name__, frame, (ftnlen)32); - if (*frame == 0) { - lnkini_(&c__20, pool); - setmsg_("The frame to which frame # is relatively defined is not" - " recognized. The kernel pool specification of the relati" - "ve frame is '#'. This is not a recognized frame. ", ( - ftnlen)161); - errint_("#", id, (ftnlen)1); - errch_("#", name__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BADFRAMESPEC)", (ftnlen)19); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* Convert SPEC to upper case so that we can easily check */ -/* to see if this is one of the expected specification types. */ - - ucase_(spec, spec, (ftnlen)32, (ftnlen)32); - if (s_cmp(spec, "MATRIX", (ftnlen)32, (ftnlen)6) == 0) { - -/* This is the easiest case. Just grab the matrix */ -/* from the kernel pool (and polish it up a bit just */ -/* to make sure we have a rotation matrix). */ - -/* We give preference to the kernel pool variable */ -/* TKFRAME__MATRIX if it is available. */ - -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 7, a__1[1] = "_MATRIX"; - s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 7, a__1[1] = "_MATRIX"; - s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32); - dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1); - if (*found) { - s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32); - } - if (badkpv_("TKFRAM", item + 64, "=", &c__9, &c__1, "N", (ftnlen) - 6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) { - lnkini_(&c__20, pool); - *frame = 0; - ident_(rot); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* The variable meets current expectations, look it up */ -/* from the kernel pool. */ - - gdpool_(item + 64, &c__1, &c__9, &n, matrix, &fnd, (ftnlen)32); - -/* In this case the full transformation matrix has been */ -/* specified. We simply polish it up a bit. */ - - moved_(matrix, &c__9, rot); - sharpr_(rot); - -/* The matrix might not be right-handed, so correct */ -/* the sense of the second and third columns if necessary. */ - - if (vdot_(&rot[3], &matrix[3]) < 0.) { - vsclip_(&c_b95, &rot[3]); - } - if (vdot_(&rot[6], &matrix[6]) < 0.) { - vsclip_(&c_b95, &rot[6]); - } - } else if (s_cmp(spec, "ANGLES", (ftnlen)32, (ftnlen)6) == 0) { - -/* Look up the angles, their units and axes for the */ -/* frame specified by ID. (Note that UNITS are optional). */ -/* As in the previous case we give preference to the */ -/* form TKFRAME__ over TKFRAME__. */ - -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 7, a__1[1] = "_ANGLES"; - s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 5, a__1[1] = "_AXES"; - s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 6, a__1[1] = "_UNITS"; - s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 7, a__1[1] = "_ANGLES"; - s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 5, a__1[1] = "_AXES"; - s_cat(alt + 96, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 6, a__1[1] = "_UNITS"; - s_cat(alt + 128, a__1, i__2, &c__2, (ftnlen)32); - -/* Again, we give preference to the more friendly form */ -/* of TKFRAME specification. */ - - for (i__ = 3; i__ <= 5; ++i__) { - dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 : - s_rnge("alt", i__1, "tkfram_", (ftnlen)668)) << 5), - found, &n, type__, (ftnlen)32, (ftnlen)1); - if (*found) { - s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 - : s_rnge("item", i__1, "tkfram_", (ftnlen)671)) << - 5), alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ? - i__3 : s_rnge("alt", i__3, "tkfram_", (ftnlen)671) - ) << 5), (ftnlen)32, (ftnlen)32); - } - } - if (badkpv_("TKFRAM", item + 64, "=", &c__3, &c__1, "N", (ftnlen) - 6, (ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM", - item + 96, "=", &c__3, &c__1, "N", (ftnlen)6, (ftnlen)32, - (ftnlen)1, (ftnlen)1)) { - lnkini_(&c__20, pool); - *frame = 0; - ident_(rot); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - s_copy(units, "RADIANS", (ftnlen)32, (ftnlen)7); - gdpool_(item + 64, &c__1, &c__3, &n, angles, &fnd, (ftnlen)32); - gipool_(item + 96, &c__1, &c__3, &n, axes, &fnd, (ftnlen)32); - gcpool_(item + 128, &c__1, &c__1, &n, units, &fnd, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles to radians. */ - - for (i__ = 1; i__ <= 3; ++i__) { - convrt_(&angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("angles", i__1, "tkfram_", (ftnlen)700)], - units, "RADIANS", &tempd, (ftnlen)32, (ftnlen)7); - angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "angles", i__1, "tkfram_", (ftnlen)701)] = tempd; - } - if (failed_()) { - lnkini_(&c__20, pool); - *frame = 0; - ident_(rot); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* Compute the rotation from instrument frame to CK frame. */ - - eul2m_(angles, &angles[1], &angles[2], axes, &axes[1], &axes[2], - rot); - } else if (s_cmp(spec, "QUATERNION", (ftnlen)32, (ftnlen)10) == 0) { - -/* Look up the quaternion and convert it to a rotation */ -/* matrix. Again there are two possible variables that */ -/* may point to the quaternion. We give preference to */ -/* the form TKFRAME__Q over the form TKFRAME__Q. */ - -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 2, a__1[1] = "_Q"; - s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 2, a__1[1] = "_Q"; - s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32); - dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1); - if (*found) { - s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32); - } - if (badkpv_("TKFRAM", item + 64, "=", &c__4, &c__1, "N", (ftnlen) - 6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) { - lnkini_(&c__20, pool); - *frame = 0; - ident_(rot); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* In this case we have the quaternion representation. */ -/* Again, we do a small amount of polishing of the input. */ - - gdpool_(item + 64, &c__1, &c__4, &n, quatrn, &fnd, (ftnlen)32); - vhatg_(quatrn, &c__4, qtmp); - q2m_(qtmp, rot); - } else { - -/* We don't recognize the SPEC for this frame. Say */ -/* so. Also note that perhaps the user needs to upgrade */ -/* the toolkit. */ - - lnkini_(&c__20, pool); - setmsg_("The frame specification \"# = '#'\" is not one of the r" - "econized means of specifying a text-kernel constant offs" - "et frame (as of version # of the routine TKFRAM). This m" - "ay reflect a typographical error or may indicate that yo" - "u need to consider updating your version of the SPICE to" - "olkit. ", (ftnlen)284); - errch_("#", item, (ftnlen)1, (ftnlen)32); - errch_("#", spec, (ftnlen)1, (ftnlen)32); - errch_("#", versn, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(UNKNOWNFRAMESPEC)", (ftnlen)23); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* Buffer the identifier, relative frame and rotation matrix. */ - - buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)784)] = rot[0]; - buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)785)] = rot[1]; - buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)786)] = rot[2]; - buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)787)] = rot[3]; - buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)788)] = rot[4]; - buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)789)] = rot[5]; - buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)790)] = rot[6]; - buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)791)] = rot[7]; - buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd", - i__1, "tkfram_", (ftnlen)792)] = rot[8]; - buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("buffi", i__1, - "tkfram_", (ftnlen)794)] = *frame; - -/* If these were not previously buffered, we need to set */ -/* a watch on the various items that might be used to define */ -/* this frame. */ - - if (! buffrd) { - -/* Immediately check for an update so that we will */ -/* not redundantly look for this item the next time this */ -/* routine is called. */ - -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 9, a__1[1] = "_RELATIVE"; - s_cat(item, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 5, a__1[1] = "_SPEC"; - s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 5, a__1[1] = "_AXES"; - s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 7, a__1[1] = "_MATRIX"; - s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 2, a__1[1] = "_Q"; - s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 7, a__1[1] = "_ANGLES"; - s_cat(item + 160, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = r__, a__1[0] = agent; - i__2[1] = 6, a__1[1] = "_UNITS"; - s_cat(item + 192, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 9, a__1[1] = "_RELATIVE"; - s_cat(item + 224, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 5, a__1[1] = "_SPEC"; - s_cat(item + 256, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 5, a__1[1] = "_AXES"; - s_cat(item + 288, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 7, a__1[1] = "_MATRIX"; - s_cat(item + 320, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 2, a__1[1] = "_Q"; - s_cat(item + 352, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 7, a__1[1] = "_ANGLES"; - s_cat(item + 384, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = ar, a__1[0] = altnat; - i__2[1] = 6, a__1[1] = "_UNITS"; - s_cat(item + 416, a__1, i__2, &c__2, (ftnlen)32); - swpool_(agent, &c__14, item, (ftnlen)32, (ftnlen)32); - cvpool_(agent, &update, (ftnlen)32); - } - } - if (failed_()) { - lnkini_(&c__20, pool); - chkout_("TKFRAM", (ftnlen)6); - return 0; - } - -/* All errors cause the routine to exit before we get to this */ -/* point. If we reach this point we didn't have an error and */ -/* hence did find the rotation from ID to FRAME. */ - - *found = TRUE_; - -/* That's it */ - - chkout_("TKFRAM", (ftnlen)6); - return 0; -} /* tkfram_ */ - diff --git a/ext/spice/src/cspice/tkvrsn.c b/ext/spice/src/cspice/tkvrsn.c deleted file mode 100644 index 18eb2966fb..0000000000 --- a/ext/spice/src/cspice/tkvrsn.c +++ /dev/null @@ -1,279 +0,0 @@ -/* tkvrsn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TKVRSN ( Toolkit version strings ) */ -/* Subroutine */ int tkvrsn_(char *item, char *verstr, ftnlen item_len, - ftnlen verstr_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Given an item such as the toolkit or an entry point name, return */ -/* the latest version 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item for which a version string is desired. */ -/* VERSTR O Version string. */ - -/* $ Detailed_Input */ - -/* ITEM is the item for which a version string is to be */ -/* returned. ITEM may be 'TOOLKIT', entry point names, */ -/* or program names. ITEM is case insensitive. */ - -/* Currently, the only ITEM supported is 'TOOLKIT' */ -/* and it will return the toolkit version number. */ - -/* Any other ITEM will return 'No version found.' */ - -/* $ Detailed_Output */ - -/* VERSTR is the latest version string for the specified ITEM. */ - -/* If ITEM is not one of the items haveing a version, */ -/* the value 'No version found.' will be returned. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If the ITEM whose version string is requested is not */ -/* recognized, the string 'No version found.' is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Suppose you want to find out the recent Toolkit configuration */ -/* version number. Using the code fragment below: */ - -/* CHARACTER*(80) VERSN */ - -/* CALL TKVRSN ( 'TOOLKIT', VERSN ) */ - -/* The variable VERSN would contain a string similar to the one */ -/* shown below: */ - -/* 'N0035' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.12.0, 09-JUN-2010 (WLT) */ - -/* Version update, N0064 */ - -/* - SPICELIB Version 3.11.0, 15-APR-2009 (WLT) */ - -/* Version update, N0063 */ - -/* - SPICELIB Version 3.10.0, 04-MAR-2008 (WLT) */ - -/* Version update, N0062 */ - -/* - SPICELIB Version 3.9.0, 27-NOV-2006 (WLT) */ - -/* Version update, N0061 */ - -/* - SPICELIB Version 3.8.0, 16-DEC-2005 (WLT) */ - -/* Version update, N0060 */ - -/* - SPICELIB Version 3.7.0, 17-NOV-2005 (WLT) */ - -/* Version update, N0059 */ - -/* - SPICELIB Version 3.6.0, 11-JAN-2005 (WLT) */ - -/* Version update, N0058 */ - -/* - SPICELIB Version 3.5.0, 02-MAR-2004 (WLT) */ - -/* Version update, N0057 */ - -/* - SPICELIB Version 3.4.0, 30-JUL-2003 (WLT) */ - -/* Version update, N0056 */ - -/* - SPICELIB Version 3.3.0, 26-FEB-2003 (WLT) */ - -/* Version update, N0055 */ - -/* - SPICELIB Version 3.2.0, 13-DEC-2002 (WLT) */ - -/* Version update, N0054 */ - -/* - SPICELIB Version 3.1.0, 05-SEP-2002 (WLT) */ - -/* Version update, N0053 */ - -/* - SPICELIB Version 3.0.0, 06-FEB-2002 (FST) */ - -/* Version update, N0052a */ - -/* - SPICELIB Version 2.9.0, 17-JAN-2002 (WLT) */ - -/* Version update, N0052 */ - -/* - SPICELIB Version 2.8.0, 07-APR-2000 (WLT) */ - -/* Version update, N0051 */ - -/* - SPICELIB Version 2.7.0, 06-OCT-1999 (WLT) */ - -/* Version update, N0050 */ - -/* - SPICELIB Version 2.6.0, 04-SEP-1998 (WLT) */ - -/* Version update, N0049 */ - -/* - SPICELIB Version 2.5.0, 01-MAY-1998 (WLT) */ - -/* Version update, N0048 */ - -/* - SPICELIB Version 2.4.0, 31-JUL-1997 (WLT) */ - -/* Version update, N0047 */ - -/* - SPICELIB Version 2.3.0, 27-JAN-1997 (WLT) */ - -/* Version update, N0046 */ - -/* - SPICELIB Version 2.2.0, 15-OCT-1996 (WLT) */ - -/* Version update, N0045 */ - -/* - SPICELIB Version 2.1.0, 26-AUG-1996 (WLT) */ - -/* Version update, N0044 */ - -/* - SPICELIB Version 2.0.0, 09-MAY-1996 (KRG) */ - -/* Removed the check of the spicelib function RETURN. This */ -/* routine is called by the error handling after an error */ -/* has been signalled to get the toolkit version, so it */ -/* cannot return on entry after an error. */ - -/* The calls to CHKIN and CHKOUT have also been removed to */ -/* completly isolate this subroutine from the error handling. */ - -/* Version update, N0043. */ - -/* - SPICELIB Version 1.7.0, 2-JAN-1995 (WLT) */ - -/* Version update, N0042. */ - -/* - SPICELIB Version 1.6.0, 28-SEP-1995 (HAN) */ - -/* Version update, N0041. */ - -/* - SPICELIB Version 1.5.0, 19-AUG-1995 (HAN) */ - -/* Version update, N0040. */ - -/* - SPICELIB Version 1.4.0, 5-JUN-1995 (HAN) */ - -/* Version update, N0039. */ - -/* - SPICELIB Version 1.3.0, 28-MAR-1995 (HAN) */ - -/* Version update, N0038. */ - -/* - SPICELIB Version 1.2.0, 23-DEC-1994 (HAN) */ - -/* Version update, N0037. */ - -/* - SPICELIB Version 1.1.0, 31-OCT-1994 (HAN) */ - -/* Version update, N0036. */ - -/* - SPICELIB Version 1.0.0, 23-AUG-1994 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* Return version strings */ -/* -& */ - -/* SPICELIB functions */ - - -/* At the current time only the TOOLKIT version number is */ -/* defined. */ - - if (eqstr_(item, "TOOLKIT", item_len, (ftnlen)7)) { - s_copy(verstr, "N0064", verstr_len, (ftnlen)5); - } else { - s_copy(verstr, "No version found.", verstr_len, (ftnlen)17); - } - return 0; -} /* tkvrsn_ */ - diff --git a/ext/spice/src/cspice/tkvrsn_c.c b/ext/spice/src/cspice/tkvrsn_c.c deleted file mode 100644 index 2fa6fbf6e8..0000000000 --- a/ext/spice/src/cspice/tkvrsn_c.c +++ /dev/null @@ -1,243 +0,0 @@ -/* - --Procedure tkvrsn_c ( Toolkit version strings ) - --Abstract - - Given an item such as the Toolkit or an entry point name, return - the latest version 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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - ConstSpiceChar * tkvrsn_c ( ConstSpiceChar * item ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - item I Item for which a version string is desired. - - The function returns a pointer to a version string. - --Detailed_Input - - item is the item for which a version string is to be - returned. item may be "TOOLKIT", entry point names, - or program names. item is case insensitive. - - Currently, the only item supported is "toolkit" - and it will return the toolkit version number. - - Any other item will return "No version found." - --Detailed_Output - - The function returns a pointer to the latest version string for the - specified item. - - If item is not one of the items haveing a version, a pointer to the - string "No version found." will return. - --Parameters - - None. - --Exceptions - - Error Free. - - 1) The routine returns "No version found." for any unknown item - string. - --Files - - None. - --Particulars - - None. - --Examples - - Suppose you want to find out the recent Toolkit configuration - version number. Using the code fragment below: - - ConstSpiceChar * versn; - - versn = tkvrsn_c ( "TOOLKIT" ); - - The pointer versn would refer to a string similar to the one - shown below (except that the version will be current): - - "CSPICE_N0035" - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - H.A. Neilan (JPL) - --Version - - -CSPICE Version 2.3.0, 06-FEB-2002 (EDW) (NJB) - - Changed the return type from (SpiceChar *) to (ConstSpiceChar *). - Corrected example code to show use of (ConstSpiceChar *) return - type. Edited the header. - - -CSPICE Version 2.2.0, 03-SEP-1999 (NJB) - - Return type changed to (SpiceChar *). Function now cleans - out version string before writing to it. - - -CSPICE Version 2.1.0, 08-FEB-1998 (NJB) - - References to C2F_CreateStr_Sig were removed; code was - cleaned up accordingly. String checks are now done using - the macro CHKFSTR_VAL. - - -CSPICE Version 2.0.0, 11-NOV-1997 (NJB) - - Updated to use the SPICELIB routine TKVRSN to obtain - the version string for SPICELIB. Updated header to remove - outdated restrictions. Changed example to reflect CSPICE - version string. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) - - Based on SPICELIB Version 2.4.0, 31-JUL-1997 (WLT) - --Index_Entries - - Return version strings --& -*/ - -{ /* Begin tkvrsn_c */ - - /* - Local constants - */ - #define MAXLEN 255 - #define CSPICE_PREFIX "CSPICE_" - #define OFFSET ( strlen(CSPICE_PREFIX) ) - - /* - Static variables - */ - static SpiceChar verStr [ MAXLEN ]; - - /* - Local variables - */ - SpiceInt endPos; - - - /* - Participate in error tracing. - */ - chkin_c ( "tkvrsn_c" ); - - - /* - Check the input string to make sure the pointer - is non-null and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "tkvrsn_c", item, (ConstSpiceChar *)NULLCPTR ); - - - /* - Make sure verStr is "empty" before filling it in. - */ - - verStr[0] = NULLCHAR; - - strcpy ( verStr, CSPICE_PREFIX ); - - tkvrsn_ ( ( char * ) item, - ( char * ) (verStr+OFFSET), - ( ftnlen ) strlen(item), - ( ftnlen ) MAXLEN-OFFSET-1 ); - - /* - Null-terminate the returned string. - */ - endPos = F_StrLen ( MAXLEN-1, verStr ); - - * ( verStr + endPos ) = NULLCHAR; - - - - if ( eqstr_c ( item, "TOOLKIT" ) ) - { - /* - Return the string including the prefix. - */ - - chkout_c ( "tkvrsn_c" ); - - return ( (ConstSpiceChar *)verStr ); - - } - else - { - /* - Return whatever was returned by tkvrsn_. - */ - - chkout_c ( "tkvrsn_c" ); - - return ( (ConstSpiceChar *)verStr+OFFSET ); - } - - -} /* End tkvrsn_c */ diff --git a/ext/spice/src/cspice/tostdo.c b/ext/spice/src/cspice/tostdo.c deleted file mode 100644 index 247ca6189b..0000000000 --- a/ext/spice/src/cspice/tostdo.c +++ /dev/null @@ -1,134 +0,0 @@ -/* tostdo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TOSTDO ( To Standard Output) */ -/* Subroutine */ int tostdo_(char *line, ftnlen line_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - extern /* Subroutine */ int stdio_(char *, integer *, ftnlen), writln_( - char *, integer *, ftnlen); - static integer stdout; - -/* $ Abstract */ - -/* Write a line of text to standard output. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LINE I is a line of text to be written to standard output */ - -/* $ Detailed_Input */ - -/* LINE is a character string containing text to be written */ -/* to standard output. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a macro for the subroutine call */ - -/* CALL WRITLN ( LINE, STDOUT ) */ - -/* Where STDOUT is the logical unit connected to standard output. */ - -/* $ Examples */ - -/* Suppose you need to create a message to be printed on the */ -/* user's terminal. Here is how to use TOSTDO to handle this */ -/* task. */ - -/* CALL TOSTDO ( 'Hello. ' ) */ -/* CALL TOSTDO ( 'My Name is HAL.' ) */ -/* CALL TOSTDO ( 'I became operational January 12, 1997 on the ' ) */ -/* CALL TOSTDO ( 'campus of the University of Illinois in ' ) */ -/* CALL TOSTDO ( 'Urbana, Illinois.' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-SEP-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Write a line of text to standard output. */ - -/* -& */ - if (first) { - stdio_("STDOUT", &stdout, (ftnlen)6); - first = FALSE_; - } - writln_(line, &stdout, line_len); - return 0; -} /* tostdo_ */ - diff --git a/ext/spice/src/cspice/touchc.c b/ext/spice/src/cspice/touchc.c deleted file mode 100644 index 4d1de6dc15..0000000000 --- a/ext/spice/src/cspice/touchc.c +++ /dev/null @@ -1,149 +0,0 @@ -/* touchc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TOUCHC ( Touch a variable ) */ -/* Character */ VOID touchc_(char *ret_val, ftnlen ret_val_len, char *string, - ftnlen string_len) -{ -/* $ Abstract */ - -/* Return the first character of a 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I any character string */ - -/* The function returns the first character of the string. */ - -/* $ Detailed_Input */ - -/* STRING is any character string */ - -/* $ Detailed_Output */ - -/* The function returns the first character of the string */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - - -/* $ Particulars */ - -/* This is a utility routine so that formal arguments to a routine */ -/* that are never used can be given the appearance of being used */ -/* to a compiler. In this way it is possible to leave "hooks" in */ -/* a calling sequence even if those variables are for the moment */ -/* unused. Similarly, variables declared for future use can be left */ -/* in place so that they don't need to be commented out */ - -/* $ Examples */ - -/* Suppose that a routine takes as an argument a */ -/* fortran structure implemented as a set of parallel arrays. */ -/* But that one of the arrays is not needed for the purposes of */ -/* the routine. This routine allows you to touch that array */ -/* without changing it. */ - - -/* SUBROUTINE INCPTR ( N, PTR, VALUES ) */ - -/* This routine increments the current pointer into a circular */ -/* array of character strings. */ - -/* INTEGER N */ -/* INTEGER PTR */ -/* CHARACTER*(*) VALUES ( * ) */ - -/* Even though we don't need to do anything with the values */ -/* array, it's passed for the sake of uniformity in calling */ -/* sequences. Touch the VALUES array so that the compiler */ -/* will think it's been used. */ - -/* VALUES(1)(1:1) = TOUCHC ( VALUES(1)(1:1) ) */ - -/* PTR = PTR + 1 */ - -/* IF ( PTR .GT. N ) THEN */ -/* PTR = 1 */ -/* END IF */ -/* RETURN */ - - - -/* $ Restrictions */ - -/* If you use this routine, it would be a very good idea to */ -/* write down why you are using it in the calling routine. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 6-MAy-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* touch a character string */ - -/* -& */ - *(unsigned char *)ret_val = *(unsigned char *)string; - return ; -} /* touchc_ */ - diff --git a/ext/spice/src/cspice/touchd.c b/ext/spice/src/cspice/touchd.c deleted file mode 100644 index 6582fc441a..0000000000 --- a/ext/spice/src/cspice/touchd.c +++ /dev/null @@ -1,151 +0,0 @@ -/* touchd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TOUCHD ( Touch a variable ) */ -doublereal touchd_(doublereal *dp) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the value of a double precision number. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DP I any double precision number */ - -/* The function returns the value of DP. */ - -/* $ Detailed_Input */ - -/* DP is any double precision number */ - -/* $ Detailed_Output */ - -/* The function returns the input d.p. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - - -/* $ Particulars */ - -/* This is a utility routine so that formal arguments to a routine */ -/* that are never used can be given the appearance of being used */ -/* to a compiler. In this way it is possible to leave "hooks" in */ -/* a calling sequence even if those variables are for the moment */ -/* unused. Similarly, variables declared for future use can be left */ -/* in place so that they don't need to be commented out */ - -/* $ Examples */ - -/* Suppose that a routine takes as an argument a */ -/* fortran structure implemented as a set of parallel arrays. */ -/* But that one of the arrays is not needed for the purposes of */ -/* the routine. This routine allows you to touch that array */ -/* without changing it. */ - - -/* SUBROUTINE INCPTR ( N, PTR, VALUES ) */ - -/* This routine increments the current pointer into a circular */ -/* array of double precision numbers. */ - -/* INTEGER N */ -/* INTEGER PTR */ -/* DOUBLE PRECISION VALUES ( * ) */ - -/* Even though we don't need to do anything with the values */ -/* array, it's passed for the sake of uniformity in calling */ -/* sequences. Touch the VALUES array so that the compiler */ -/* will think it's been used. */ - -/* VALUES(1) = TOUCHD ( VALUES(1) ) */ - -/* PTR = PTR + 1 */ - -/* IF ( PTR .GT. N ) THEN */ -/* PTR = 1 */ -/* END IF */ -/* RETURN */ - - - -/* $ Restrictions */ - -/* If you use this routine, it would be a very good idea to */ -/* write down why you are using it in the calling routine. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 6-MAy-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* touch a d.p. number */ - -/* -& */ - ret_val = *dp; - return ret_val; -} /* touchd_ */ - diff --git a/ext/spice/src/cspice/touchi.c b/ext/spice/src/cspice/touchi.c deleted file mode 100644 index 31570ae89d..0000000000 --- a/ext/spice/src/cspice/touchi.c +++ /dev/null @@ -1,151 +0,0 @@ -/* touchi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TOUCHI ( Touch a variable ) */ -integer touchi_(integer *int__) -{ - /* System generated locals */ - integer ret_val; - -/* $ Abstract */ - -/* Return the value of the input integer */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INT I any integer */ - -/* The function returns the value of INT. */ - -/* $ Detailed_Input */ - -/* INT is any integer */ - -/* $ Detailed_Output */ - -/* The function returns the input integer */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - - -/* $ Particulars */ - -/* This is a utility routine so that formal arguments to a routine */ -/* that are never used can be given the appearance of being used */ -/* to a compiler. In this way it is possible to leave "hooks" in */ -/* a calling sequence even if those variables are for the moment */ -/* unused. Similarly, variables declared for future use can be left */ -/* in place so that they don't need to be commented out */ - -/* $ Examples */ - -/* Suppose that a routine takes as an argument a */ -/* fortran structure implemented as a set of parallel arrays. */ -/* But that one of the arrays is not needed for the purposes of */ -/* the routine. This routine allows you to touch that array */ -/* without changing it. */ - - -/* SUBROUTINE INCPTR ( N, PTR, VALUES ) */ - -/* This routine increments the current pointer into a circular */ -/* array of integers. */ - -/* INTEGER N */ -/* INTEGER PTR */ -/* INTEGER VALUES ( * ) */ - -/* Even though we don't need to do anything with the values */ -/* array, it's passed for the sake of uniformity in calling */ -/* sequences. Touch the VALUES array so that the compiler */ -/* will think it's been used. */ - -/* VALUES(1) = TOUCHI ( VALUES(1) ) */ - -/* PTR = PTR + 1 */ - -/* IF ( PTR .GT. N ) THEN */ -/* PTR = 1 */ -/* END IF */ -/* RETURN */ - - - -/* $ Restrictions */ - -/* If you use this routine, it would be a very good idea to */ -/* write down why you are using it in the calling routine. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 6-MAy-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* touch an integer */ - -/* -& */ - ret_val = *int__; - return ret_val; -} /* touchi_ */ - diff --git a/ext/spice/src/cspice/touchl.c b/ext/spice/src/cspice/touchl.c deleted file mode 100644 index 172957a4e3..0000000000 --- a/ext/spice/src/cspice/touchl.c +++ /dev/null @@ -1,151 +0,0 @@ -/* touchl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TOUCHL ( Touch a variable ) */ -logical touchl_(logical *log__) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Return the value of the input logical */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LOG I any logical */ - -/* The function returns the value of LOG. */ - -/* $ Detailed_Input */ - -/* LOG is any logical */ - -/* $ Detailed_Output */ - -/* The function returns the input logical */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - - -/* $ Particulars */ - -/* This is a utility routine so that formal arguments to a routine */ -/* that are never used can be given the appearance of being used */ -/* to a compiler. In this way it is possible to leave "hooks" in */ -/* a calling sequence even if those variables are for the moment */ -/* unused. Similarly, variables declared for future use can be left */ -/* in place so that they don't need to be commented out */ - -/* $ Examples */ - -/* Suppose that a routine takes as an argument a */ -/* fortran structure implemented as a set of parallel arrays. */ -/* But that one of the arrays is not needed for the purposes of */ -/* the routine. This routine allows you to touch that array */ -/* without changing it. */ - - -/* SUBROUTINE INCPTR ( N, PTR, VALUES ) */ - -/* This routine increments the current pointer into a circular */ -/* array of logicals. */ - -/* INTEGER N */ -/* INTEGER PTR */ -/* LOGICAL VALUES ( * ) */ - -/* Even though we don't need to do anything with the values */ -/* array, it's passed for the sake of uniformity in calling */ -/* sequences. Touch the VALUES array so that the compiler */ -/* will think it's been used. */ - -/* VALUES(1) = TOUCHL ( VALUES(1) ) */ - -/* PTR = PTR + 1 */ - -/* IF ( PTR .GT. N ) THEN */ -/* PTR = 1 */ -/* END IF */ -/* RETURN */ - - - -/* $ Restrictions */ - -/* If you use this routine, it would be a very good idea to */ -/* write down why you are using it in the calling routine. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 6-MAy-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* touch a logical */ - -/* -& */ - ret_val = *log__; - return ret_val; -} /* touchl_ */ - diff --git a/ext/spice/src/cspice/tparse.c b/ext/spice/src/cspice/tparse.c deleted file mode 100644 index dedb598c61..0000000000 --- a/ext/spice/src/cspice/tparse.c +++ /dev/null @@ -1,599 +0,0 @@ -/* tparse.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__400 = 400; - -/* $Procedure TPARSE ( Parse a UTC time string ) */ -/* Subroutine */ int tparse_(char *string, doublereal *sp2000, char *error, - ftnlen string_len, ftnlen error_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_dnnt(doublereal *); - - /* Local variables */ - integer year; - doublereal tvec[10]; - logical mods; - integer temp; - char type__[5]; - integer q; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer ntvec, month; - logical ok; - extern /* Subroutine */ int tcheck_(doublereal *, char *, logical *, char - *, logical *, char *, ftnlen, ftnlen, ftnlen), rmaini_(integer *, - integer *, integer *, integer *); - logical succes, yabbrv; - char modify[8*5]; - logical adjust; - char pictur[80]; - extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char - *, char *, logical *, logical *, logical *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), texpyr_(integer *); - extern doublereal j2000_(void); - integer day; - extern doublereal spd_(void); - -/* $ Abstract */ - -/* Parse a time string and return seconds past the J2000 epoch */ -/* on a formal calendar. */ - -/* $ 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 */ - -/* PARSING, TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input time string, UTC. */ -/* SP2000 O Equivalent UTC seconds past J2000. */ -/* ERROR O Descriptive error message. */ - -/* $ Detailed_Input */ - -/* STRING is an input time string, containing a Calendar or */ -/* Julian Date. It may be in several different */ -/* formats and can make use of abbreviations. */ -/* Several example strings and */ -/* the times that they translate to are listed below */ -/* in the Examples section. */ - -/* $ Detailed_Output */ - -/* SP2000 is the equivalent of UTC, expressed in UTC */ -/* seconds past J2000. If an error occurs, or if */ -/* UTC is ambiguous, SP2000 is not changed. */ - -/* ERROR is a descriptive error message, which is blank when */ -/* no error occurs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The input string is examined and the various components of */ -/* a date are identified: julian date, year, month, day of year, */ -/* day of month, hour, minutes, seconds. These items are */ -/* assumed to be components on a calendar that contains no */ -/* leapseconds (i.e. every day is assumed to have exactly 86400 */ -/* seconds). */ - -/* TPARSE recognizes a wide range of standard time formats. */ -/* The examples section contains a list of several common */ -/* strings that are recognized and their interpretation. */ -/* TPARSE relies on the lower lever routine TPARTV to */ -/* interpret the input string. */ - -/* Here is a brief summary of some of the basic rules used */ -/* in the interpretation of strings. */ - -/* 1) Unless the substring JD or jd is present the string is */ -/* assumed to be a calendar format (day-month-year or year and */ -/* day of year). If the substring JD or jd is present, the */ -/* string is assumed to represent a julian date. */ - -/* 2) If the julian date specifier is not present, any integer */ -/* greater than 999 is regarded as being a year specification. */ - -/* 3) A dash '-' can represent a minus sign only if it is precedes */ -/* the first digit in the string and the string contains */ -/* the julian date specifier (JD). (No negative years, */ -/* months, days, etc are allowed). */ - -/* 4) Numeric components of a time string must be separated */ -/* by a character that is not a digit or decimal point. */ -/* Only one decimal component is allowed. For example */ -/* 1994219.12819 is sometimes interpreted as the */ -/* 219th day of 1994 + 0.12819 days. TPARSE does not */ -/* support such strings. */ - -/* No exponential components are allowed. For example you */ -/* can't input 1993 Jun 23 23:00:01.202E-4 you have */ -/* to explicitly list all zeros that follow the decimal */ -/* point: i.e. 1993 Jun 23 23:00:00.0001202 */ - -/* 5) The single colon (:) when used to separate numeric */ -/* components of a string is interpreted as separating */ -/* Hours, Minutes, and Seconds of time. */ - -/* 6) If a double slash (//) or double colon (::) follows */ -/* a pair of integers, those integers are assumed to */ -/* represent the year and day of year. */ - -/* 7) A quote followed by an integer less than 100 is regarded */ -/* as an abbreviated year. For example: '93 would be regarded */ -/* as the 93rd year of the reference century. See TEXPYR */ -/* for further discussion of abbreviated years. */ - -/* 8) An integer followed by 'B.C.' or 'A.D.' is regarded as */ -/* a year in the era associated with that abbreviation. */ - -/* 9) All dates are regarded as belonging to the extended */ -/* Gregorian Calendar (the Gregorian calendar is the calendar */ -/* currently used by western society). See the routine JUL2GR */ -/* for converting from Julian Calendar to the */ -/* Gregorian Calendar. */ -/* western society). */ - -/* 10) When the size of the integer components does not clearly */ -/* specify a year the following patterns are assumed */ - -/* Calendar Format */ - -/* Year Month Day */ -/* Month Day Year */ -/* Year Day Month */ - -/* Where Month is the name of a month, not its numeric */ -/* value. */ - -/* When integer components are separated by slashes (/) */ -/* as in 3/4/5. Month, Day, Year is assumed (2005 March 4) */ - -/* Day of Year Format. */ - -/* If a day of year marker is present (// or ::) the */ -/* pattern */ - -/* I-I// or I-I:: (where I stands for and integer) */ -/* is interpreted as Year Day-of-Year. However, I-I/ is */ -/* regarded as ambiguous. */ - -/* To understand the complete list of strings that can be understood */ -/* by TPARSE you need to examine TPARTV and read the appendix to */ -/* the TIME required reading entitled "Parsing Time Strings" */ - -/* TPARSE does not support the specification of time system */ -/* such as TDT or TDB; AM/PM specifications of time; or time */ -/* zones (such as PDT, UTC+7:20, etc.). */ - -/* If some part of the time string is not recognized or if */ -/* the meaning of the components are not clear, an error string */ -/* is constructed that explains the problem with the string. */ - -/* Since the routine is works by breaking the input string into */ -/* a sequence of tokens whose meanings are determined by position */ -/* and magnitude, you can supply strings such as 1993 FEB 35 and */ -/* have this correctly interpreted as March 7, 1993. However, */ -/* this default action can be modified so that only "proper" */ -/* calendar dates and times are recognized. To do this call */ -/* the routine TPARCH as shown below: */ - -/* CALL TPARCH ( 'YES' ) */ - -/* This will cause the routine to treat dates and times with */ -/* components outside the normal range as errors. */ - -/* To return to the default behavior */ - -/* CALL TPARCH ( 'NO' ) */ - -/* $ Examples */ - -/* The following are examples of valid inputs to TPARSE: */ - - - -/* ISO (T) Formats. */ - -/* String Year Mon DOY DOM HR Min Sec */ -/* ---------------------------- ---- --- --- --- -- --- ------ */ -/* 1996-12-18T12:28:28 1996 Dec na 18 12 28 28 */ -/* 1986-01-18T12 1986 Jan na 18 12 00 00 */ -/* 1986-01-18T12:19 1986 Jan na 18 12 19 00 */ -/* 1986-01-18T12:19:52.18 1986 Jan na 18 12 19 52.18 */ -/* 1995-08T18:28:12 1995 na 008 na 18 28 12 */ -/* 1995-18T 1995 na 018 na 00 00 00 */ - - -/* Calendar Formats. */ - -/* String Year Mon DOM HR Min Sec */ -/* ---------------------------- ---- --- --- -- --- ------ */ -/* Tue Aug 6 11:10:57 1996 1996 Aug 06 11 10 57 */ -/* 1 DEC 1997 12:28:29.192 1997 Dec 01 12 28 29.192 */ -/* 2/3/1996 17:18:12.002 1996 Feb 03 17 18 12.002 */ -/* Mar 2 12:18:17.287 1993 1993 Mar 02 12 18 17.287 */ -/* 1992 11:18:28 3 Jul 1992 Jul 03 11 18 28 */ -/* June 12, 1989 01:21 1989 Jun 12 01 21 00 */ -/* 1978/3/12 23:28:59.29 1978 Mar 12 23 28 59.29 */ -/* 17JUN1982 18:28:28 1982 Jun 17 18 28 28 */ -/* 13:28:28.128 1992 27 Jun 1992 Jun 27 13 28 28.128 */ -/* 1972 27 jun 12:29 1972 Jun 27 12 29 00 */ -/* '93 Jan 23 12:29:47.289 1993* Jan 23 12 29 47.289 */ -/* 27 Jan 3, 19:12:28.182 2027* Jan 03 19 12 28.182 */ -/* 23 A.D. APR 4, 18:28:29.29 0023** Apr 04 18 28 29.29 */ -/* 18 B.C. Jun 3, 12:29:28.291 -017** Jun 03 12 29 28.291 */ -/* 29 Jun 30 12:29:29.298 2029+ Jun 30 12 29 29.298 */ -/* 29 Jun '30 12:29:29.298 2030* Jun 29 12 29 29.298 */ - -/* Day of Year Formats */ - -/* String Year DOY HR Min Sec */ -/* ---------------------------- ---- --- -- --- ------ */ -/* 1997-162::12:18:28.827 1997 162 12 18 28.827 */ -/* 162-1996/12:28:28.287 1996 162 12 28 28.287 */ -/* 1993-321/12:28:28.287 1993 231 12 28 28.287 */ -/* 1992 183// 12 18 19 1992 183 12 18 19 */ -/* 17:28:01.287 1992-272// 1992 272 17 28 01.287 */ -/* 17:28:01.282 272-1994// 1994 272 17 28 01.282 */ -/* '92-271/ 12:28:30.291 1992* 271 12 28 30.291 */ -/* 92-182/ 18:28:28.281 1992* 182 18 28 28.281 */ -/* 182-92/ 12:29:29.192 0182+ 092 12 29 29.192 */ -/* 182-'92/ 12:28:29.182 1992 182 12 28 29.182 */ - - -/* Julian Date Strings */ - -/* jd 28272.291 Julian Date 28272.291 */ -/* 2451515.2981 (JD) Julian Date 2451515.2981 */ -/* 2451515.2981 JD Julian Date 2451515.2981 */ - -/* Abbreviations Used in Tables */ - -/* na --- Not Applicable */ -/* Mon --- Month */ -/* DOY --- Day of Year */ -/* DOM --- Day of Month */ -/* Wkday --- Weekday */ -/* Hr --- Hour */ -/* Min --- Minutes */ -/* Sec --- Sec */ - -/* * The default interpretation of a year that has been abbreviated */ -/* with a leading quote as in 'xy (such as '92) is to treat */ -/* the year as 19xy if xy > 68 and to treat it is 20xy otherwise. */ -/* Thus '70 is interpreted as 1970 and '67 is treated as 2067. */ -/* However, you may change the "split point" and centuries through */ -/* use of the SPICE routine TSETYR which is an entry point in */ -/* the SPICE module TEXPYR. See that routine for a discussion of */ -/* how you may reset the split point. */ - -/* ** All epochs are regarded as belonging to the Gregorian */ -/* calendar. We formally extend the Gregorian calendar backward */ -/* and forward in time for all epochs. If you have epochs belonging */ -/* to the Julian Calendar, consult the routines TPARTV and JUL2GR */ -/* for a discussion concerning conversions to the Gregorian */ -/* calendar and ET. */ - -/* + When a day of year format or calendar format string is */ -/* input and neither of integer components of the date */ -/* is greater than 1000, the first integer */ -/* is regarded as being the year. */ - -/* Any integer greater than 1000 */ -/* is regarded as a year specification. Thus 1001-1821//12:28:28 */ -/* is interpreted as specifying two years and will be rejected */ -/* as ambiguous. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ -/* W.M. Owen (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.0.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 5.0.0, 30-DEC-1997 (WLT) */ - -/* The routine was modified to compensate for the inability */ -/* of the Muller-Wimberly formula to handle negative years */ -/* (that is years prior to 1 AD. */ - -/* Comments concerning the default century used for two */ -/* digit years were upgraded. */ - -/* - SPICELIB Version 4.0.0, 8-APR-1996 (WLT) */ - -/* All of the token recognition and parsing was moved */ -/* into the routine TPARTV. The entry point TPARCH */ -/* was moved to the routine TCHECK. */ - -/* This routine now merely assembles the */ -/* parsed components to produce SP2000. */ - -/* The number of strings now recognized has been greatly */ -/* increased. However, the interpretation given to */ -/* strings such as 31 Jan 32 has been changed. */ - -/* - SPICELIB Version 3.0.0, 30-JUL-1993 (WLT) */ - -/* The entry point TPARCH was added so that users may */ -/* restrict the set of input calendar strings to those */ -/* that are in proper form. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 18-NOV-1991 (MJS) */ - -/* TPARSE no longer accepts a blank time string. */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (JML) */ - -/* In the Detailed_Input section of the header, the */ -/* description of how default values are assigned to */ -/* tokens in STRING was clarified. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* parse a utc time string */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.0.0, 30-DEC-1997 (WLT) */ - -/* The routine was modified to compensate for the inability */ -/* of the Muller-Wimberly formula to handle negative years */ -/* (that is years prior to 1 AD. */ - -/* Comments concerning the default century used for two */ -/* digit years were upgraded. */ - -/* - SPICELIB Version 4.0.0, 8-APR-1996 (WLT) */ - -/* All of the token recognition and parsing was moved */ -/* into the routine TPARTV. The entry point TPARCH */ -/* was moved to the routine TCHECK. */ - -/* This routine now merely assembles the */ -/* the parsed components to produce SP2000. */ - -/* - SPICELIB Version 3.0.0, 30-JUL-1993 (WLT) */ - -/* The entry point TPARCH was added so that users may */ -/* restrict the set of input calendar strings to those */ -/* that are in proper form. */ - -/* - SPICELIB Version 2.0.0, 18-NOV-1991 (MJS) */ - -/* TPARSE no longer accepts a blank time string. Prior to */ -/* this fix, TPARSE interpreted a blank time string to be */ -/* -1577880000.000 UTC seconds (1 JAN 1950 00:00:00). */ - -/* - SPICELIB Version 1.0.1, 26-MAR-1991 (JML) */ - -/* In the Detailed_Input section of the header, the */ -/* description of how default values are assigned to */ -/* tokens in STRING was clarified. */ - -/* NAIFers are accustomed to specifying day of year */ -/* formats of UTC strings in the following form: */ - -/* 1986-247 // 12:00:00 */ - -/* This revision to the header states explicitly that */ -/* the // is a blank token which results in the default */ -/* value being assigned to the month token. The previous */ -/* version of the header implied that tokens could be left */ -/* out or "missing" from the string, and that default values */ -/* would automatically be assigned. This works only for */ -/* tokens missing from the right end of the string. For */ -/* default values to be assigned to tokens missing from the */ -/* middle of a UTC string, consecutive delimiters such as */ -/* // or :: must be included. */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - - -/* Local variables */ - - -/* All the work of taking apart the string is handled */ -/* by TPARTV. */ - - s_copy(error, " ", error_len, (ftnlen)1); - succes = TRUE_; - tpartv_(string, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes, - pictur, error, string_len, (ftnlen)5, (ftnlen)8, (ftnlen)80, - error_len); - if (! succes) { - return 0; - } - -/* We are not going to support all of the various */ -/* time string modifiers that can be parsed. */ - - if (mods) { - if (s_cmp(modify + 32, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(error, "TPARSE does not support the specification of a ti" - "me system in a string. The time system # was specified. " - , error_len, (ftnlen)106); - repmc_(error, "#", modify + 32, error, error_len, (ftnlen)1, ( - ftnlen)8, error_len); - return 0; - } else if (s_cmp(modify + 16, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(error, "TPARSE does not support the specification of a ti" - "me zone in a time string. The time zone '#' was specifi" - "ed. ", error_len, (ftnlen)109); - repmc_(error, "#", modify + 16, error, error_len, (ftnlen)1, ( - ftnlen)8, error_len); - return 0; - } else if (s_cmp(modify + 24, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(error, "TPARSE does not support the AM/PM conventions for" - " time strings. ", error_len, (ftnlen)64); - return 0; - } - } - if (s_cmp(type__, "JD", (ftnlen)5, (ftnlen)2) == 0) { - -/* Nothing to do but convert TVEC(1). */ - - *sp2000 = (tvec[0] - j2000_()) * spd_(); - } else if (s_cmp(type__, "YMD", (ftnlen)5, (ftnlen)3) == 0 || s_cmp( - type__, "YD", (ftnlen)5, (ftnlen)2) == 0) { - tcheck_(tvec, type__, &mods, modify, &ok, error, (ftnlen)5, (ftnlen)8, - error_len); - if (! ok) { - return 0; - } - -/* If we have day of year format, we move it into the */ -/* month-day of month format. */ - - if (s_cmp(type__, "YD", (ftnlen)5, (ftnlen)2) == 0) { - tvec[5] = tvec[4]; - tvec[4] = tvec[3]; - tvec[3] = tvec[2]; - tvec[2] = tvec[1]; - tvec[1] = 1.; - } - -/* Get the year month and day as integers. */ - - year = i_dnnt(tvec); - month = i_dnnt(&tvec[1]); - day = i_dnnt(&tvec[2]); - -/* Fix up the year as needed. */ - - if (s_cmp(modify, "B.C.", (ftnlen)8, (ftnlen)4) == 0) { - year = 1 - year; - } else if (s_cmp(modify, "A.D.", (ftnlen)8, (ftnlen)4) == 0) { - -/* Do nothing. */ - - } else if (year < 100) { - texpyr_(&year); - } - -/* Apply the Muller-Wimberly formula and then tack on */ -/* the seconds. */ - - if (year < 1) { - -/* The Muller-Wimberly formula doesn't work for years */ -/* less than 0. So we boost the year by an appropriate */ -/* multiple of 400 and then subtract the appropriate */ -/* number of days later. */ - - adjust = TRUE_; - temp = year; - rmaini_(&temp, &c__400, &q, &year); - year += 400; - --q; - } else { - adjust = FALSE_; - } - day = year * 367 - (year + (month + 9) / 12) * 7 / 4 - ((year + ( - month - 9) / 7) / 100 + 1) * 3 / 4 + month * 275 / 9 + day - - 730516; - if (adjust) { - -/* Adjust DAY by the appropriate multiple of 400 years. */ - - day += q * 146097; - } - *sp2000 = ((doublereal) day - .5) * spd_() + tvec[3] * 3600. + tvec[4] - * 60. + tvec[5]; - } else { - -/* We've already covered all the bases we are planning to */ -/* cover in this routine. Any other case is regarded as an */ -/* error. */ - - s_copy(error, "The only type of time strings that are handled by TPA" - "RSE are 'JD', 'YMD' and 'YD' (year day-of-year). You've ent" - "ered a string of the type #. ", error_len, (ftnlen)142); - repmc_(error, "#", type__, error, error_len, (ftnlen)1, (ftnlen)5, - error_len); - } - return 0; -} /* tparse_ */ - diff --git a/ext/spice/src/cspice/tparse_c.c b/ext/spice/src/cspice/tparse_c.c deleted file mode 100644 index 89fe88e406..0000000000 --- a/ext/spice/src/cspice/tparse_c.c +++ /dev/null @@ -1,383 +0,0 @@ -/* - --Procedure tparse_c ( Parse a UTC time string ) - --Abstract - - Parse a time string and return seconds past the J2000 epoch - on a formal calendar. - --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 - - PARSING, TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - - void tparse_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * sp2000, - SpiceChar * errmsg ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - string I Input time string, UTC. - lenout I Available space in output error message string. - sp2000 O Equivalent UTC seconds past J2000. - errmsg O Descriptive error message. - --Detailed_Input - - string is an input time string, containing a Calendar or - Julian Date. It may be in several different formats - and can make use of abbreviations. Several example - strings and the times that they translate to are listed - below. - - lenout is the maximum number of characters, including the - terminating null, that may be written to the output - error message string. - --Detailed_Output - - sp2000 is the equivalent of UTC, expressed in UTC - seconds past J2000. If an error occurs, or if - the input time string is ambiguous, sp2000 is not - changed. - - errmsg is a descriptive error message, which is empty when - no error occurs. - --Parameters - - None. - --Exceptions - - 1) - --Files - - None. - --Particulars - - The input string is examined and the various components of a date - are identified: julian date, year, month, day of year, day of month, - hour, minutes, seconds. These items are assumed to be components on - a calendar that contains no leapseconds (i.e. every day is assumed - to have exactly 86400 seconds). - - tparse_c recognizes a wide range of standard time formats. The - examples section contains a list of several common strings that are - recognized and their interpretation. tparse_c relies on the lower - lever routine TPARTV to interpret the input string. - - Here is a brief summary of some of the basic rules used in the - interpretation of strings. - - 1) Unless the substring JD or jd is present the string is assumed to - be a calendar format (day-month-year or year and day of year). - If the substring JD or jd is present, the string is assumed to - represent a julian date. - - 2) If the julian date specifier is not present, any integer greater - than 999 is regarded as being a year specification. - - 3) A dash '-' can represent a minus sign only if it is precedes the - first digit in the string and the string contains the julian - date specifier (JD). (No negative years, months, days, etc are - allowed). - - 4) Numeric components of a time string must be separated - by a character that is not a digit or decimal point. - Only one decimal component is allowed. For example - 1994219.12819 is sometimes interpreted as the - 219th day of 1994 + 0.12819 days. tparse_c does not - support such strings. - - No exponential components are allowed. For example you - can't input 1993 Jun 23 23:00:01.202E-4 you have - to explicitly list all zeros that follow the decimal - point: i.e. 1993 Jun 23 23:00:00.0001202 - - 5) The single colon (:) when used to separate numeric - components of a string is interpreted as separating - Hours, Minutes, and Seconds of time. - - 6) If a double slash (//) or double colon (::) follows - a pair of integers, those integers are assumed to - represent the year and day of year. - - 7) A quote followed by an integer less than 100 is regarded - as an abbreviated year. For example: '93 would be regarded - as the 93rd year of the reference century. See TEXPYR - for further discussion of abbreviated years. - - 8) An integer followed by "B.C." or "A.D." is regarded as - a year in the era associated with that abbreviation. - - 9) All dates are regarded as belonging to the extended - Gregorian Calendar (the Gregorian calendar is the calendar - currently used by western society). See the routine JUL2GR - for converting from Julian Calendar to the - Gregorian Calendar. - western society). - - 10) When the size of the integer components does not clearly - specify a year the following patterns are assumed - - Calendar Format - - Year Month Day - Month Day Year - Year Day Month - - Where Month is the name of a month, not its numeric - value. - - When integer components are separated by slashes (/) - as in 3/4/5. Month, Day, Year is assumed (2005 March 4) - - Day of Year Format. - - If a day of year marker is present (// or ::) the - pattern - - I-I// or I-I:: (where I stands for and integer) - is interpreted as Year Day-of-Year. However, I-I/ is - regarded as ambiguous. - - To understand the complete list of strings that can be understood - by tparse_c you need to examine TPARTV and read the appendix to - the TIME required reading entitled "Parsing Time Strings" - - tparse_c does not support the specification of time system - such as TDT or TDB; AM/PM specifications of time; or time - zones (such as PDT, UTC+7:20, etc.). - - If some part of the time string is not recognized or if - the meaning of the components are not clear, an error string - is constructed that explains the problem with the string. - - Since the routine is works by breaking the input string into - a sequence of tokens whose meanings are determined by position - and magnitude, you can supply strings such as 1993 FEB 35 and - have this correctly interpreted as March 7, 1993. However, - this default action can be modified so that only "proper" - calendar dates and times are recognized. To do this call - the routine TPARCH as shown below: - - TPARCH ( "YES" ) - - This will cause the routine to treat dates and times with - components outside the normal range as errors. - - To return to the default behavior - - TPARCH ( "NO" ) - --Examples - - The following are examples of valid inputs to TPARSE: - - - - ISO (T) Formats. - - String Year Mon DOY DOM HR Min Sec - ---------------------------- ---- --- --- --- -- --- ------ - 1996-12-18T12:28:28 1996 Dec na 18 12 28 28 - 1986-01-18T12 1986 Jan na 18 12 00 00 - 1986-01-18T12:19 1986 Jan na 18 12 19 00 - 1986-01-18T12:19:52.18 1986 Jan na 18 12 19 52.18 - 1995-08T18:28:12 1995 na 008 na 18 28 12 - 1995-18T 1995 na 018 na 00 00 00 - - - Calendar Formats. - - String Year Mon DOM HR Min Sec - ---------------------------- ---- --- --- -- --- ------ - Tue Aug 6 11:10:57 1996 1996 Aug 06 11 10 57 - 1 DEC 1997 12:28:29.192 1997 Dec 01 12 28 29.192 - 2/3/1996 17:18:12.002 1996 Feb 03 17 18 12.002 - Mar 2 12:18:17.287 1993 1993 Mar 02 12 18 17.287 - 1992 11:18:28 3 Jul 1992 Jul 03 11 18 28 - June 12, 1989 01:21 1989 Jun 12 01 21 00 - 1978/3/12 23:28:59.29 1978 Mar 12 23 28 59.29 - 17JUN1982 18:28:28 1982 Jun 17 18 28 28 - 13:28:28.128 1992 27 Jun 1992 Jun 27 13 28 28.128 - 1972 27 jun 12:29 1972 Jun 27 12 29 00 - '93 Jan 23 12:29:47.289 1993* Jan 23 12 29 47.289 - 27 Jan 3, 19:12:28.182 2027* Jan 03 19 12 28.182 - 23 A.D. APR 4, 18:28:29.29 0023** Apr 04 18 28 29.29 - 18 B.C. Jun 3, 12:29:28.291 -017** Jun 03 12 29 28.291 - 29 Jun 30 12:29:29.298 2029+ Jun 30 12 29 29.298 - 29 Jun '30 12:29:29.298 2030* Jun 29 12 29 29.298 - - Day of Year Formats - - String Year DOY HR Min Sec - ---------------------------- ---- --- -- --- ------ - 1997-162::12:18:28.827 1997 162 12 18 28.827 - 162-1996/12:28:28.287 1996 162 12 28 28.287 - 1993-321/12:28:28.287 1993 231 12 28 28.287 - 1992 183// 12 18 19 1992 183 12 18 19 - 17:28:01.287 1992-272// 1992 272 17 28 01.287 - 17:28:01.282 272-1994// 1994 272 17 28 01.282 - '92-271/ 12:28:30.291 1992* 271 12 28 30.291 - 92-182/ 18:28:28.281 1992* 182 18 28 28.281 - 182-92/ 12:29:29.192 0182+ 092 12 29 29.192 - 182-'92/ 12:28:29.182 1992 182 12 28 29.182 - - - Julian Date Strings - - jd 28272.291 Julian Date 28272.291 - 2451515.2981 (JD) Julian Date 2451515.2981 - 2451515.2981 JD Julian Date 2451515.2981 - - Abbreviations Used in Tables - - na --- Not Applicable - Mon --- Month - DOY --- Day of Year - DOM --- Day of Month - Wkday --- Weekday - Hr --- Hour - Min --- Minutes - Sec --- Sec - - * The default interpretation of a year that has been abbreviated - with a leading quote as in 'xy (such as '92) is to treat - the year as 19xy if xy > 68 and to treat it is 20xy otherwise. - Thus '70 is interpreted as 1970 and '67 is treated as 2067. - However, you may change the "split point" and centuries through - use of the SPICE routine tsetyr_c which is an entry point in - the SPICE module TEXPYR. See that routine for a discussion of - how you may reset the split point. - - ** All epochs are regarded as belonging to the Gregorian - calendar. We formally extend the Gregorian calendar backward - and forward in time for all epochs. If you have epochs belonging - to the Julian Calendar, consult the routines TPARTV and JUL2GR - for a discussion concerning conversions to the Gregorian - calendar and ET. - - + When a day of year format or calendar format string is - input and neither of integer components of the date - is greater than 1000, the first integer - is regarded as being the year. - - Any integer greater than 1000 - is regarded as a year specification. Thus 1001-1821//12:28:28 - is interpreted as specifying two years and will be rejected - as ambiguous. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - J.M. Lynch (JPL) - W.M. Owen (JPL) - M.J. Spencer (JPL) - I.M. Underwood (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.0.0, 5-JUN-1999 (NJB)(JML)(WMO)(MJS)(IMU)(WLT) - --Index_Entries - - parse a utc time string - --& -*/ - -{ /* Begin tparse_c */ - - - - /* - Use discovery check-in. - */ - - - /* - Check the input time string to make sure the pointer is non-null and - the string length is non-zero. - */ - CHKFSTR ( CHK_DISCOVER, "tparse_c", string ); - - - /* - Check the output error message string to make sure the pointer is - non-null and the string length is at least 2. - */ - CHKOSTR ( CHK_DISCOVER, "tparse_c", errmsg, lenout ); - - - /* - Call the f2c'd routine. - */ - - tparse_ ( ( char * ) string, - ( doublereal * ) sp2000, - ( char * ) errmsg, - ( ftnlen ) strlen(string), - ( ftnlen ) lenout-1 ); - - /* - Convert the error message from Fortran to C style. - */ - F2C_ConvertStr ( lenout, errmsg ); - - -} /* End tparse_c */ - diff --git a/ext/spice/src/cspice/tpartv.c b/ext/spice/src/cspice/tpartv.c deleted file mode 100644 index 27d33d8b99..0000000000 --- a/ext/spice/src/cspice/tpartv.c +++ /dev/null @@ -1,1291 +0,0 @@ -/* tpartv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__300 = 300; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__8 = 8; - -/* $Procedure TPARTV ( Time string ---parse to a time vector) */ -/* Subroutine */ int tpartv_(char *string, doublereal *tvec, integer *ntvec, - char *type__, char *modify, logical *mods, logical *yabbrv, logical * - succes, char *pictur, char *error, ftnlen string_len, ftnlen type_len, - ftnlen modify_len, ftnlen pictur_len, ftnlen error_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char zones[3*8] = "EST" "EDT" "CST" "CDT" "MST" "MDT" "PST" "PDT"; - static char offset[6*8] = "UTC-5 " "UTC-4 " "UTC-6 " "UTC-5 " "UTC-7 " - "UTC-6 " "UTC-8 " "UTC-7 "; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, - ftnlen, ftnlen), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern logical zztokns_(char *, char *, ftnlen, ftnlen); - static integer begs[5], ends[5], from, b, e; - extern /* Subroutine */ int zzinssub_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer i__, r__; - static char delim[1*3]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen); - static integer mapto, b1, b2, e1, e2; - static char known[12*300]; - extern integer rtrim_(char *, ftnlen); - extern logical zzist_(char *, ftnlen); - static integer to; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char meanng[12*300]; - static logical havera; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static logical havapm; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen); - extern integer intmax_(void); - static logical havwdy; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static logical havzon; - extern logical zzcmbt_(char *, char *, logical *, ftnlen, ftnlen); - static integer nknown; - static logical resolv, havsys; - extern logical zzgrep_(char *, ftnlen); - static logical l2r, r2l; - extern logical zznote_(char *, integer *, integer *, ftnlen), zzvalt_( - char *, integer *, integer *, char *, ftnlen, ftnlen), zzremt_( - char *, ftnlen), zzrept_(char *, char *, logical *, ftnlen, - ftnlen), zzsubt_(char *, char *, logical *, ftnlen, ftnlen), - zzispt_(char *, integer *, integer *, ftnlen); - static char rep[12]; - static integer use; - extern logical zzunpck_(char *, logical *, doublereal *, integer *, char * - , char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), zztpats_( - integer *, integer *, char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine returns the components of a time supplied */ -/* as a string and returns a vector of the components of */ -/* that string together with an array of modifiers that may */ -/* have been supplied with the string that may alter */ -/* the interpretation of the components. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A string to be parsed as a time */ -/* TVEC O A vector giving the components of the time. */ -/* NTVEC O The number of components supplied for TVEC */ -/* TYPE O The type of the "time vector" TVEC */ -/* MODIFY O A list of modifiers present in STRING. */ -/* MODS O A logical indicating the presence of a modifier */ -/* YABBRV O A logical indicating that a year was abbreviated */ -/* SUCCES O A logical indicating whether STRING was parsed. */ -/* PICTUR O A time format picture associated with STRING */ -/* ERROR O A diagnostic message if STRING couldn't be parsed */ - -/* The function returns */ - -/* $ Detailed_Input */ - -/* STRING is a character string that represents some */ -/* julian or calendar epoch. */ - -/* $ Detailed_Output */ - -/* TVEC is a vector of double precision numbers that represent */ -/* the input string. The number and meaning of the */ -/* components of TVEC depend upon the input string. This */ -/* meaning can be determined from the output variable */ -/* TYPE. */ - -/* TYPE NTVEC TVEC Components */ -/* ------------------------------------------------------- */ -/* YMD 3 to 6 TVEC(1) is the calendar year */ -/* TVEC(2) is the numeric value of the */ -/* month (1-12) */ -/* TVEC(3) is the day of the month */ -/* TVEC(4) is the hour of the day */ -/* TVEC(5) is the minute of the hour */ -/* TVEC(6) is the second of the minute */ - -/* YD 2 to 5 TVEC(1) is the calendar year */ -/* TVEC(2) is the day of the year */ -/* TVEC(3) is the hour of the day */ -/* TVEC(4) is the minute of the hour */ -/* TVEC(5) is the second of the minute */ - -/* JD 1 TVEC(1) is the julian date */ - -/* Note that the values of TVEC are not forced into the */ -/* normal ranges used in daily conversation. TPARTV */ -/* simply reports what's found in the string and does */ -/* not pass judgement on the "correctness" of these */ -/* components. */ - -/* NTVEC is the actual number of components that were present */ -/* in the string. For example a user might have */ -/* supplied only year, month and day of an epoch. */ -/* In such a case NTVEC will be set to 3. The components */ -/* actually supplied will be 1 through NTVEC. Values */ -/* not supplied are set to zero. */ - -/* TYPE is the type of time string supplied. This is a function */ -/* of whether the string contains year, month and day, */ -/* day of year, or julian date. */ - -/* MODIFY is an array of character strings that indicate */ -/* whether a modifier to the calendar string was supplied. */ -/* If a particular modifier was not supplied, the */ -/* value of that component of MODIFY will be set to */ -/* a blank. Modifiers are used to change the meaning */ -/* of time strings. */ - -/* For example 12:12:29 Jan 1, 1996 means 12 hours past */ -/* midnight on Jan 1, 1996 in the UTC time system. But */ -/* if we modify the string to be: */ - -/* 12:12:29 A.M. Jan 1, Tuesday PDT 1996 B.C. */ - -/* the string takes on an entirely different meaning. */ - -/* Five different modifiers are recognized by TPARTV: */ -/* the era associated with the epoch, day of week of */ -/* the epoch, time zone of an epoch, AM/PM used in */ -/* daily time usage, and the system (UTC, TDB, or TDT). */ - -/* Again whether or not modifiers are compatible with the */ -/* time and date components or with each other is not */ -/* determined by TPARTV. TPARTV simply reports what is */ -/* present in the string, leaving the task of deciding */ -/* the meaning of the string to the calling routine. */ - -/* The components of MODIFY, their meaning and possible */ -/* values are given below. */ - -/* Component Meaning Possible Non-blank Modifier Values */ -/* --------- ------- ---------------------------------- */ -/* 1 ERA 'A.D.', 'B.C.' */ -/* 2 Weekday 'SUN', 'MON', ... etc. */ -/* 3 Time Zone 'UTC+i:i', 'UTC-i:i' */ -/* 4 AM/PM 'A.M.', 'P.M.' */ -/* 5 System 'UTC', 'TDB', 'TDT' */ - -/* TPARTV recognizes the standard abbreviations of */ -/* all continental U.S. time zones. */ - -/* PDT --- Pacific Daylight Time (UTC-07:00) */ -/* PST --- Pacific Standard Time (UTC-08:00) */ -/* MDT --- Mountain Daylight Time (UTC-06:00) */ -/* MST --- Mountain Standard Time (UTC-07:00) */ -/* CDT --- Central Daylight Time (UTC-05:00) */ -/* CST --- Central Standard Time (UTC-06:00) */ -/* EDT --- Eastern Daylight Time (UTC-04:00) */ -/* EST --- Eastern Standard Time (UTC-05:00) */ - -/* In addition it recognizes offsets from UTC expressed */ -/* as UTC+/-HR:MN. Note that through out SPICELIB */ -/* the minutes component of the UTC offset are always */ -/* regarded as positive offsets from the hour offset. */ - -/* All Time zones are returned in MODIFY as UTC offsets */ -/* as indicated in the table above. */ - -/* MODS is TRUE if some non-blank modifier was supplied. */ - -/* YABBRV is TRUE if a year was supplied in the abbreviated */ -/* form 'YR where YR is a two digit integer. */ - -/* SUCCES is TRUE if the string was successfully parsed. */ -/* Otherwise it is set to FALSE and a diagnostic */ -/* is supplied in the argument ERROR. */ - -/* PICTUR is a string that gives a format picture that can */ -/* be used by the routine TIMOUT to construct a time */ -/* string of the same form as the input time string. */ - -/* If some component of the input string could not be */ -/* identified, PICTUR is returned as a blank. However, */ -/* if all components of the input string could be */ -/* identified and the string is simply ambiguous, PICTUR */ -/* will contain a format picture that corresponds to */ -/* the ambiguous input. Consequently, you must check */ -/* the value of PICTUR to determine if TPARTV has */ -/* been able to construct a format picture. */ - -/* ERROR is blank if the string was successfully parsed. */ -/* Otherwise a human readable diagnostic is returned */ -/* in ERROR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) All problems are diagnosed via the variables SUCCES and */ -/* ERROR. */ - -/* $ Particulars */ - -/* This routine parses in input string that represents some */ -/* epoch in some time system. In addition it constructs a */ -/* format picture that describes the position and meaning */ -/* of the various components of the string. */ - -/* This routine is intended to be used in close conjunction with */ -/* the routines TTRANS and TIMOUT. */ - -/* The string is parsed by first determining its recognizable */ -/* substrings (integers, punctuation marks, names of months, */ -/* names of weekdays, time systems, time zones, etc.) These */ -/* recognizable substrings are called the tokens of the input */ -/* string. The meaning of some tokens are immediately determined. */ -/* For example named months, weekdays, time systems have clear */ -/* meanings. However, the meanings of numeric components must */ -/* be deciphered from their magnitudes and location in */ -/* the string relative to the immediately recognized components */ -/* of the input string. */ - -/* To determine the meaning of the numeric tokens in the input */ -/* string, a set of "productions rules" and transformations are */ -/* applied to the full set of tokens in the string. These */ -/* transformations are repeated until the meaning of every token */ -/* has been determined or until further transformations yield */ -/* no new clues into the meaning of the numeric tokens. */ - -/* 1) Unless the substring JD or jd is present the string is */ -/* assumed to be a calendar format (day-month-year or year and */ -/* day of year). If the substring JD or jd is present, the */ -/* string is assumed to represent a julian date. */ - -/* 2) If the julian date specifier is not present, any integer */ -/* greater than 999 is regarded as being a year specification. */ - -/* 3) A dash '-' can represent a minus sign only if it is precedes */ -/* the first digit in the string and the string contains */ -/* the julian date specifier (JD). (No negative years, */ -/* months, days, etc are allowed). */ - -/* 4) Numeric components of a time string must be separated */ -/* by a character that is not a digit or decimal point. */ -/* Only one decimal component is allowed. For example */ -/* 1994219.12819 is sometimes interpreted as the */ -/* 219th day of 1994 + 0.12819 days. TPARTV does not */ -/* support such strings. */ - -/* No exponential components are allowed. For example you */ -/* can't input 1993 Jun 23 23:00:01.202E-4 you have */ -/* to explicitly list all zeros that follow the decimal */ -/* point: i.e. 1993 Jun 23 23:00:00.0001202 */ - -/* 5) The single colon (:) when used to separate numeric */ -/* components of a string is interpreted as separating */ -/* Hours, Minutes, and Seconds of time. */ - -/* 6) If a double slash (//) or double colon (::) follows */ -/* a pair of integers, those integers are assumed to */ -/* represent the year and day of year. */ - -/* 7) A quote followed by an integer less than 100 is regarded */ -/* as an abbreviated year. For example: '93 would be regarded */ -/* as the 93rd year of the reference century. See TEXPYR */ -/* for further discussion of abbreviated years. */ - -/* 8) An integer followed by 'B.C.' or 'A.D.' is regarded as */ -/* a year in the era associated with that abbreviation. */ - -/* 9) All dates are regarded as belonging to the extended */ -/* Gregorian Calendar (the Gregorian calendar is the calendar */ -/* currently used by western society). See the routine JUL2GR */ -/* for converting from Julian Calendar to the */ -/* Gregorian Calendar. */ -/* western society). */ - -/* 10) If the ISO date-time separator (T) is present in the string */ -/* ISO allowed token patterns are examined for a match */ -/* with the current token list. If no match is found the */ -/* search is abandoned and appropriate diagnostic messages */ -/* are generated. */ - -/* 11) If two delimiters are found in succession in the time */ -/* string, the time string is diagnosed as an erroneous */ -/* string. ( Delimiters are comma, white space, dash, slash, */ -/* period, day of year mark ) */ - -/* Note the delimiters do not have to be the same. The pair */ -/* of characters ",-" counts as two successive delimiters. */ - -/* 12) White space, commas serve only to delimit tokens in the */ -/* input string. They do not affect the meaning of any */ -/* of the tokens. */ - -/* 13) When the size of the integer components does not clearly */ -/* specify a year the following patterns are assumed */ - -/* Calendar Format */ - -/* Year Month Day */ -/* Month Day Year */ -/* Year Day Month */ - -/* Where Month is the name of a month, not its numeric */ -/* value. */ - -/* When integer components are separated by slashes (/) */ -/* as in 3/4/5. Month, Day, Year is assumed (2005 March 4) */ - -/* Day of Year Format. */ - -/* If a day of year marker is present (// or ::) the */ -/* pattern */ - -/* I-I// or I-I:: (where I stands for and integer) */ -/* is interpreted as Year Day-of-Year. However, I-I/ is */ -/* regarded as ambiguous. */ - - -/* The table below gives a list of abbreviations used to */ -/* classify tokens. */ - -/* / --- slash punctuation mark */ -/* H --- hour */ -/* M --- Minute */ -/* S --- Second */ -/* Y --- year */ -/* d --- day of year marker */ -/* i --- unsigned integer */ -/* m --- month */ -/* n --- unsigned decimal number */ -/* y --- day of year */ -/* - --- dash punctuation mark */ -/* D --- day of month */ -/* : --- colon punctuation mark */ - -/* Given these abbreviations the following (rather lengthy) */ -/* table gives the set of built in token patterns that */ -/* are recognized and the associated interpretation of that */ -/* pattern. */ - -/* Pattern Meaning Pattern Meaning */ -/* ------------------------ ------------------------- */ -/* Y-i-it......... YmD i/i/ii:i:n..... mDYHMS */ -/* Y-i-iti........ YmDH i/i/ii:n....... mDYHM */ -/* Y-i-iti:i...... YmDHM i/i/ii:n....... mDYHM */ -/* Y-i-iti:i:i.... YmDHMS i:i:ii-i-Y..... HMSmDY */ -/* Y-i-iti:i:n.... YmDHMS i:i:ii/i/Y..... HMSmDY */ -/* Y-i-iti:n...... YmDHM i:i:ii/i/i..... HMSmDY */ -/* Y-i-itn........ YmDH i:i:iimY....... HMSDmY */ -/* Y-i/........... Yy i:i:imiY....... HMSmDY */ -/* Y-i/i:i........ YyHM i:i:ni-i-Y..... HMSmDY */ -/* Y-i/i:i:i...... YyHMS i:i:ni/i/Y..... HMSmDY */ -/* Y-i/i:i:n...... YyHMS i:i:ni/i/i..... HMSmDY */ -/* Y-i/i:n........ YyHM i:i:nimY....... HMSDmY */ -/* Y-id........... Yy i:i:nmiY....... HMSmDY */ -/* Y-idi:i........ YyHM i:ii-i-Y....... HMmDY */ -/* Y-idi:i:i...... YyHMS i:ii/i/Y....... HMmDY */ -/* Y-idi:i:n...... YyHMS i:ii/i/i....... HMmDY */ -/* Y-idi:n........ YyHM i:iimY......... HMDmY */ -/* Y-it........... Yy i:imiY......... HMmDY */ -/* Y-iti.......... YyH i:ni-i-Y....... HMmDY */ -/* Y-iti:i........ YyHM i:ni/i/Y....... HMmDY */ -/* Y-iti:i:i...... YyHMS i:ni/i/i....... HMmDY */ -/* Y-iti:i:n...... YyHMS i:nimY......... HMDmY */ -/* Y-iti:n........ YyHM i:nmiY......... HMmDY */ -/* Y-itn.......... YyH iYd............ yY */ -/* Yid............ Yy iYdi:i......... yYHM */ -/* Yidi:i......... YyHM iYdi:i:i....... yYHMS */ -/* Yidi:i:i....... YyHMS iYdi:i:n....... yYHMS */ -/* Yidi:i:n....... YyHMS iYdi:n......... yYHM */ -/* Yidi:n......... YyHM iiY............ mDY */ -/* Yii............ YmD iiYi........... mDYH */ -/* Yiii........... YmDH iiYi:i......... mDYHM */ -/* Yiii:i......... YmDHM iiYi:i:i....... mDYHMS */ -/* Yiii:i:i....... YmDHMS iiYi:i:n....... mDYHMS */ -/* Yiii:i:n....... YmDHMS iiYi:n......... mDYHM */ -/* Yiii:n......... YmDHM iiYn........... mDYH */ -/* Yiiii.......... YmDHM iid............ Yy */ -/* Yiiiii......... YmDHMS iidi:i......... YyHM */ -/* Yiiiin......... YmDHMS iidi:i:i....... YyHMS */ -/* Yiiin.......... YmDHM iidi:i:n....... YyHMS */ -/* Yiin........... YmDH iidi:n......... YyHM */ -/* Yim............ YDm iim............ YDm */ -/* Yimi........... YDmH iimi........... YDmH */ -/* Yimi:i......... YDmHM iimi:i......... YDmHM */ -/* Yimi:i:i....... YDmHMS iimi:i:i....... YDmHMS */ -/* Yimi:i:n....... YDmHMS iimi:i:n....... YDmHMS */ -/* Yimi:n......... YDmHM iimi:n......... YDmHM */ -/* Yimn........... YDmH iimii.......... YDmHM */ -/* Yin............ YmD iimiii......... YDmHMS */ -/* Ymi............ YmD iimiin......... YDmHMS */ -/* Ymii........... YmDH iimin.......... YDmHM */ -/* Ymii:i......... YmDHM iimn........... YDmH */ -/* Ymii:i:i....... YmDHMS imY............ DmY */ -/* Ymii:i:n....... YmDHMS imYi........... DmYH */ -/* Ymii:n......... YmDHM imYi:i......... DmYHM */ -/* Ymin........... YmDH imYi:i:i....... DmYHMS */ -/* Ymn............ YmD imYi:i:n....... DmYHMS */ -/* Ynm............ YDm imYi:n......... DmYHM */ -/* i-Y/........... yY imYn........... DmYH */ -/* i-Y/i:i........ yYHM imi............ YmD */ -/* i-Y/i:i:i...... yYHMS imi:i:iY....... DmHMSY */ -/* i-Y/i:i:n...... yYHMS imi:i:nY....... DmHMSY */ -/* i-Y/i:n........ yYHM imi:iY......... DmHMY */ -/* i-Yd........... yY imi:nY......... DmHMY */ -/* i-Ydi:i........ yYHM imii........... YmDH */ -/* i-Ydi:i:i...... yYHMS imii:i......... YmDHM */ -/* i-Ydi:i:n...... yYHMS imii:i:i....... YmDHMS */ -/* i-Ydi:n........ yYHM imii:i:n....... YmDHMS */ -/* i-i-Y.......... mDY imii:n......... YmDHM */ -/* i-i-Yi:i....... mDYHM imiii.......... YmDHM */ -/* i-i-Yi:i:i..... mDYHMS imiiii......... YmDHMS */ -/* i-i-Yi:i:n..... mDYHMS imiiin......... YmDHMS */ -/* i-i-Yi:n....... mDYHM imiin.......... YmDHM */ -/* i-i-it......... YmD imin........... YmDH */ -/* i-i-iti........ YmDH imn............ YmD */ -/* i-i-iti:i...... YmDHM inY............ mDY */ -/* i-i-iti:i:i.... YmDHMS inm............ YDm */ -/* i-i-iti:i:n.... YmDHMS miY............ mDY */ -/* i-i-iti:n...... YmDHM miYi........... mDYH */ -/* i-i-itn........ YmDH miYi:i......... mDYHM */ -/* i-i/i:i........ YyHM miYi:i:i....... mDYHMS */ -/* i-i/i:i:i...... YyHMS miYi:i:n....... mDYHMS */ -/* i-i/i:i:n...... YyHMS miYi:n......... mDYHM */ -/* i-i/i:n........ YyHM miYn........... mDYH */ -/* i-idi:i........ YyHM mii............ mDY */ -/* i-idi:i:i...... YyHMS mii:i:iY....... mDHMSY */ -/* i-idi:i:n...... YyHMS mii:i:nY....... mDHMSY */ -/* i-idi:n........ YyHM mii:iY......... mDHMY */ -/* i-it........... Yy mii:nY......... mDHMY */ -/* i-iti.......... YyH miii........... mDYH */ -/* i-iti:i........ YyHM miii:i......... mDYHM */ -/* i-iti:i:i...... YyHMS miii:i:i....... mDYHMS */ -/* i-iti:i:n...... YyHMS miii:i:n....... mDYHMS */ -/* i-iti:n........ YyHM miii:n......... mDYHM */ -/* i-itn.......... YyH miiii.......... mDYHM */ -/* i/i/Y.......... mDY miiiii......... mDYHMS */ -/* i/i/Y/i:n...... mDYHM miiiin......... mDYHMS */ -/* i/i/Yi:i....... mDYHM miiin.......... mDYHM */ -/* i/i/Yi:i:i..... mDYHMS miin........... mDYH */ -/* i/i/Yi:i:n..... mDYHMS mnY............ mDY */ -/* i/i/i.......... mDY mni............ mDY */ -/* i/i/ii:i....... mDYHM nmY............ DmY */ -/* i/i/ii:i:i..... mDYHMS */ - -/* $ Examples */ - -/* Suppose you need to convert various time strings to ephemeris */ -/* seconds past J2000. The following pair of calls shows */ -/* how you would use this routine together with the routines */ -/* TCHECK and TTRANS to perform this task. */ - - -/* CALL TPARTV ( STRING, */ -/* . TVEC, NTVEC, TYPE, */ -/* . MODIFY, MODS, YABBRV, SUCCES, */ -/* . PICTUR, ERROR ) */ - - -/* IF ( .NOT. SUCCES ) THEN */ - -/* Use the SPICE error handling facility to post an */ -/* error message and signal an error. */ - -/* CALL SETMSG ( ERROR ) */ -/* CALL SIGERR ( 'MYCHECK(BADTIME)' ) */ -/* CALL CHKOUT ( 'MYROUTINE' ) */ -/* RETURN */ -/* END IF */ - -/* Check the components of TVEC to make sure everything */ -/* makes sense. */ - -/* CALL TCHECK( TVEC, TYPE, MODS, MODIFY, OK, ERROR ) */ - -/* IF ( .NOT. OK ) THEN */ - -/* Use the SPICE error handling facility to post an */ -/* error message and signal an error. */ - -/* CALL SETMSG ( ERROR ) */ -/* CALL SIGERR ( 'MYCHECK(BADTIME)' ) */ -/* CALL CHKOUT ( 'MYROUTINE' ) */ -/* RETURN */ -/* END IF */ - -/* CALL TTRANS ( TYPE, 'ET', TVEC ) */ - -/* ET = TVEC(1) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.0, 15-AUG-2002 (WLT) */ - -/* Replaced the call to INSSUB with ZZINSSUB so that this */ -/* routine can legitimately be called error free. */ - -/* - SPICELIB Version 3.0.0, 10-MAY-1999 (WLT) */ - -/* The routine was modified so that weekday followed by a comma */ -/* is recognized as a legitimate pattern when parsing. */ - -/* - SPICELIB Version 2.0.0, 16-APR-1997 (WLT) */ - -/* The routine was modified so that last-chance removal of */ -/* delimiters ',', '-', and '/' are removed one at a time */ -/* (instead of all at once as in version 1.0.0) and the */ -/* resulting representation checked against */ -/* the built-in list. */ - -/* In addition the set of built-in patterns was increased */ -/* from 185 to 203. See ZZTPATS for more details. */ - -/* - SPICELIB Version 1.0.0, 10-AUG-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Parse a time string into a vector of components */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Private Functions */ - - -/* Parameters */ - - -/* ERA */ -/* WDAY */ -/* ZONE */ -/* AMPM */ -/* SYSTEM */ - - -/* Local Variables. */ - -/* The number of known time patterns NKNOWN comes from the include */ -/* file timepars.inc */ - - -/* Time Zone Variables */ - - -/* Standard SPICE error handling. */ - - -/* So far there are no modifiers to the time string. */ - - *mods = FALSE_; - *yabbrv = FALSE_; - for (i__ = 1; i__ <= 5; ++i__) { - s_copy(modify + (i__ - 1) * modify_len, " ", modify_len, (ftnlen)1); - } - -/* On the first call to this routine we load the built in */ -/* representation patterns. */ - - if (first) { - if (zztpats_(&c__300, &nknown, known, meanng, (ftnlen)12, (ftnlen)12)) - { - first = FALSE_; - } else { - s_copy(pictur, " ", pictur_len, (ftnlen)1); - *succes = FALSE_; - s_copy(error, "There is an incompatibility between ZZTPATS and t" - "he room allocated for KNOWN in TPARTV.", error_len, ( - ftnlen)87); - return 0; - } - } - -/* First step is to tokenize the string. The new representation */ -/* is maintained in ZZTIME. We'll get it later if we need it. */ - - resolv = zztokns_(string, error, string_len, error_len); - if (! resolv) { - *succes = FALSE_; - *ntvec = 0; - s_copy(type__, " ", type_len, (ftnlen)1); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - return 0; - } - -/* The result of tokenizing the string will be a representation */ -/* that contains the following letters. */ - -/* ' The quote character */ -/* [ The left parenthesis */ -/* ] The right parenthesis */ -/* , The comma */ -/* - The dash */ -/* . The decimal point */ -/* / The slash---used to separate date components. */ -/* : The colon (used to separate time components) */ -/* N --- stands for one of the symbols A.M. or P.M. */ -/* O stands for the symbol UTC+ */ -/* Z --- stands for a time zone such as PDT, PSD, CDT, etc. */ -/* b stands for a block of white space */ -/* d stands for the day of year marker (// or ::) */ -/* e --- stands for the era (B.C. or A.D.) */ -/* j stands for julian date */ -/* m stands for a month */ -/* o stands for the symbol UTC- */ -/* s --- stands for a time system (UTC, TDT, TDB) */ -/* t stands the ISO date-T-time separator. */ -/* w --- stands for the day of the week. */ -/* i stands for a sequence of digits */ - -/* We will gradually remove many of these and replace the i, i. */ -/* and i.i with the following items */ - -/* n stands for a decimal number */ -/* Y stands for a year */ -/* D stands for the day in a month */ -/* y stands for the day of the year */ -/* H stands for hours */ -/* M stands for minutes */ -/* S stands for seconds. */ - - -/* We will use the following logical functions to modify */ -/* the tokenized representation: */ - -/* ZZTOKNS --- breaks the string down into a list of recognized */ -/* tokens and stores an internal model for this */ -/* list. The begins and ends of the substrings */ -/* associated with the tokenization are maintained */ -/* inside the routine ZZTIME (which ZZTOKNS is an */ -/* entry point to). If some substring cannot be */ -/* recognized, ZZTOKNS returns the value FALSE */ -/* together with a diagnostic indicating what */ -/* was wrong with the input string. */ - -/* ZZCMBT --- combines one or more tokens into a single token. */ -/* this is performed only once and is done either */ -/* scanning left to right or right to left. */ -/* It returns TRUE if a combination is performed. */ - -/* ZZREMT --- removes all instances of a token from the tokenized */ -/* representation. It returns TRUE is an item */ -/* is removed. */ - -/* ZZSUBT --- substitutes the first occurrence of a */ -/* subpattern (scanning left to right or right to */ -/* left) with another pattern of the same length. */ -/* This is where we attach new meaning to the */ -/* tokenized pattern. It returns TRUE if a */ -/* substitution is performed. */ - -/* ZZREPT --- is a combination of the ZZSUBT and ZZREMT */ -/* This performs ZZSUBT on the string, but then */ -/* remove all occurrences of the special character */ -/* * from the tokenized list. It returns TRUE */ -/* is a substitution is performed. */ - -/* ZZNOTE --- returns the begin and end of the first occurrence */ -/* of some token, and then removes the token */ -/* from the tokenized representation. We use this */ -/* primarily to extract modifiers from the tokenized */ -/* string. These should occur only once and once */ -/* removed allow us to more easily attach meaning */ -/* to the remaining tokens. The value of ZZNOTE */ -/* is true if the requested item could be found, */ -/* otherwise it is false and the begin and end */ -/* of the requested substring are set to 0. */ - -/* ZZIST --- returns TRUE if the specified token is present */ -/* in the tokenized substring. */ - -/* ZZISPT --- returns true is a pair of consecutive tokens */ -/* from a list are located in the representation */ -/* of the tokenized string. This is used to */ -/* locate consecutive pairs of delimiters in the */ -/* input string. It returns TRUE if a pair of */ -/* consecutive items is located. Otherwise */ -/* it returns FALSE. */ - -/* ZZVALT --- allows you to substitute a new token for any */ -/* integer (i) that lies within a specified range */ -/* of values. This is primarily used to recognize */ -/* years in the input string. */ - -/* ZZGREP --- is used to get the current representation of the */ -/* tokenized string (with all processing resulting */ -/* from use of the manipulation routines taken into */ -/* account). */ - -/* ZZTPATS --- is used to set up the large list of canned patterns */ -/* that are recognized as legitimate tokenizations. */ -/* Almost all legitimate time strings when tokenized */ -/* will match one of these patterns. */ - -/* ZZUNPCK --- uses STRING together with the current */ -/* representation of it's tokens to return a */ -/* time vector. If a problem is encountered with */ -/* the current tokens, it returns a diagnostic */ -/* message that indicates why the string */ -/* could not be parsed. Note ZZUNPCK should be */ -/* called only after all string modifiers have */ -/* been retrieved via a call to ZZNOTE (or by */ -/* manually removing them). */ - -/* Next Step is to combine some tokens so that we won't run */ -/* into problems later on. We may introduce some new components */ -/* in the process. */ - - l2r = TRUE_; - r2l = ! l2r; - if (zzcmbt_("Oi", "z", &l2r, (ftnlen)2, (ftnlen)1)) { - resolv = zzcmbt_("z:i", "Z", &l2r, (ftnlen)3, (ftnlen)1); - resolv = zzsubt_("z", "Z", &l2r, (ftnlen)1, (ftnlen)1); - } - if (zzcmbt_("oi", "z", &l2r, (ftnlen)2, (ftnlen)1)) { - resolv = zzcmbt_("z:i", "Z", &l2r, (ftnlen)3, (ftnlen)1); - resolv = zzsubt_("z", "Z", &l2r, (ftnlen)1, (ftnlen)1); - } - -/* Next we resolve any months, or weekdays that are followed */ -/* by periods. */ - - resolv = zzrept_("m.", "m*", &l2r, (ftnlen)2, (ftnlen)2); - resolv = zzrept_("w.", "w*", &l2r, (ftnlen)2, (ftnlen)2); - resolv = zzrept_("w,", "w*", &l2r, (ftnlen)2, (ftnlen)2); - -/* Now convert the right most integer-decimal-point pair to the */ -/* number representation. */ - - if (zzcmbt_("i.i", "n", &r2l, (ftnlen)3, (ftnlen)1)) { - -/* We aren't going to do anything here. We are simply */ -/* using the IF-THEN...ELSE IF ... ENDIF to make sure */ -/* we only replace one decimal place. */ - - } else if (zzcmbt_("i.", "n", &r2l, (ftnlen)2, (ftnlen)1)) { - -/* Same as the previous comment. */ - - } - -/* Remove any white space from the tokenization. */ - - resolv = zzremt_("b", (ftnlen)1); - -/* User Custom Formats (this still needs a modicum of work). */ -/* ---------------------------------------------------------------- */ -/* ================================================================ */ - - -/* RESOLV = ZZGREP ( REP ) */ -/* USE = ISRCHC ( REP, NCUSTM, CUSTOM ) */ - -/* IF ( USE .GT. 0 ) THEN */ -/* RESOLV = ZZREPT ( CUSTM(USE), CMEANS(USE), L2R ) */ -/* ELSE */ -/* RESOLV = .FALSE. */ -/* END IF */ - -/* IF ( RESOLV ) THEN */ - -/* SUCCES = ZZUNPCK ( STRING, YABBRV, ... */ -/* TVEC, NTVEC, TYPE, PICTUR, ERROR ) */ -/* ERROR = ' ' */ - -/* RETURN */ -/* END IF */ - - - -/* Julian Date */ -/* ---------------------------------------------------------------- */ -/* ================================================================ */ - - if (zzist_("j", (ftnlen)1)) { - -/* This is some form of Julian Date. Handle this case */ -/* right here and return. */ - - resolv = zzrept_("[s]", "*s*", &l2r, (ftnlen)3, (ftnlen)3); - *mods = *mods || zznote_("s", &b, &e, (ftnlen)1); - if (*mods) { - ucase_(string + (b - 1), modify + (modify_len << 2), e - (b - 1), - modify_len); - } - resolv = zzrept_("[j]", "*j*", &l2r, (ftnlen)3, (ftnlen)3); - resolv = zzremt_("j", (ftnlen)1); - if (! zzist_("n", (ftnlen)1)) { - resolv = zzsubt_("i", "n", &l2r, (ftnlen)1, (ftnlen)1); - } - resolv = zzcmbt_("-n", "n", &l2r, (ftnlen)2, (ftnlen)1); - resolv = zzsubt_("n", "J", &l2r, (ftnlen)1, (ftnlen)1); - -/* We let ZZUNPK handle the parsing or diagnosis of any problems. */ - - *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, error, - string_len, type_len, pictur_len, error_len); - if (i_indx(pictur, "JULIAND.", pictur_len, (ftnlen)8) > 0) { - suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len); - } - if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) != - 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len, - pictur_len); - } - return 0; - } - -/* Calendar Date Formats. */ -/* ---------------------------------------------------------------- */ -/* ================================================================ */ - -/* Replace any integers greater than 1000 by Y. */ - - b = 1000; - e = intmax_(); - resolv = zzvalt_(string, &b, &e, "Y", string_len, (ftnlen)1); - -/* If the ISO time delimiter 't' is present we don't perform */ -/* any further simplifications. */ - - if (zzist_("t", (ftnlen)1)) { - resolv = zzgrep_(rep, (ftnlen)12); - use = bsrchc_(rep, &nknown, known, (ftnlen)12, (ftnlen)12); - if (use != 0) { - resolv = zzrept_(known + ((i__1 = use - 1) < 300 && 0 <= i__1 ? - i__1 : s_rnge("known", i__1, "tpartv_", (ftnlen)1011)) * - 12, meanng + ((i__2 = use - 1) < 300 && 0 <= i__2 ? i__2 : - s_rnge("meanng", i__2, "tpartv_", (ftnlen)1011)) * 12, & - l2r, (ftnlen)12, (ftnlen)12); - *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, - error, string_len, type_len, pictur_len, error_len); - if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) { - suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len); - } - if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1) - != 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len, - pictur_len); - } - if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) - != 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len, - pictur_len); - } - } else { - *succes = FALSE_; - *ntvec = 0; - *mods = FALSE_; - s_copy(type__, " ", type_len, (ftnlen)1); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - s_copy(error, "The input string uses the ISO \"T\" date/time de" - "limiter but does not match any of the accepted ISO forma" - "ts. ", error_len, (ftnlen)107); - } - return 0; - } - -/* If we reach this point, either we didn't have any custom */ -/* formats supplied or we didn't match any of them. */ -/* Resolve any abbreviated years. We've already set integers */ -/* that are 1000 or greater to 'Y' Only 1 or 2 digit integers */ -/* can be year abbreviations. We replace the 3 digit integers */ -/* with I temporarily; locate any abbreviated years; reset all */ -/* the 3-digit back to 'i'. (Note 3-digit means value between */ -/* 100 and 999. 003 is not regarded as a 3 digit number). */ - - b = 100; - e = 1000; - resolv = zzvalt_(string, &b, &e, "I", string_len, (ftnlen)1); - *yabbrv = zzrept_("'i", "*Y", &l2r, (ftnlen)2, (ftnlen)2); - while(zzsubt_("I", "i", &l2r, (ftnlen)1, (ftnlen)1)) { - ++b; - } - -/* Resolve the system, and other text components. */ - - resolv = zzrept_("[e]", "*e*", &l2r, (ftnlen)3, (ftnlen)3); - resolv = zzrept_("[w]", "*w*", &l2r, (ftnlen)3, (ftnlen)3); - resolv = zzrept_("[N]", "*N*", &l2r, (ftnlen)3, (ftnlen)3); - resolv = zzrept_("[Z]", "*Z*", &l2r, (ftnlen)3, (ftnlen)3); - resolv = zzrept_("[s]", "*s*", &l2r, (ftnlen)3, (ftnlen)3); - resolv = zzsubt_("ie", "Ye", &l2r, (ftnlen)2, (ftnlen)2); - -/* Note the positions of ERA, WEEKDAY, TIME-ZONE, AMPM marker */ -/* and time SYSTEM. */ - - havera = zznote_("e", begs, ends, (ftnlen)1); - havwdy = zznote_("w", &begs[1], &ends[1], (ftnlen)1); - havzon = zznote_("Z", &begs[2], &ends[2], (ftnlen)1); - havapm = zznote_("N", &begs[3], &ends[3], (ftnlen)1); - havsys = zznote_("s", &begs[4], &ends[4], (ftnlen)1); - *mods = havera || havwdy || havzon || havapm || havsys; - if (*mods) { - for (i__ = 1; i__ <= 5; ++i__) { - if (begs[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "tpartv_", (ftnlen)1093)] != 0) { - i__1 = begs[(i__2 = i__ - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge( - "begs", i__2, "tpartv_", (ftnlen)1094)] - 1; - ucase_(string + i__1, modify + (i__ - 1) * modify_len, ends[( - i__3 = i__ - 1) < 5 && 0 <= i__3 ? i__3 : s_rnge( - "ends", i__3, "tpartv_", (ftnlen)1094)] - i__1, - modify_len); - } - } - if (havera) { - if (*(unsigned char *)&modify[0] == 'A') { - s_copy(modify, "A.D.", modify_len, (ftnlen)4); - } else { - s_copy(modify, "B.C.", modify_len, (ftnlen)4); - } - } - if (havapm) { - if (*(unsigned char *)&modify[modify_len * 3] == 'A') { - s_copy(modify + modify_len * 3, "A.M.", modify_len, (ftnlen)4) - ; - } else { - s_copy(modify + modify_len * 3, "P.M.", modify_len, (ftnlen)4) - ; - } - } - s_copy(modify + (modify_len + 3), " ", modify_len - 3, (ftnlen)1); - if (havzon) { - mapto = isrchc_(modify + (modify_len << 1), &c__8, zones, - modify_len, (ftnlen)3); - if (mapto != 0) { - s_copy(modify + (modify_len << 1), offset + ((i__1 = mapto - - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("offset", i__1, - "tpartv_", (ftnlen)1121)) * 6, modify_len, (ftnlen)6); - } - } - } - -/* Try our built in formats without any further substitution. */ - - resolv = zzgrep_(rep, (ftnlen)12); - use = bsrchc_(rep, &nknown, known, (ftnlen)12, (ftnlen)12); - if (use > 0) { - resolv = zzrept_(known + ((i__1 = use - 1) < 300 && 0 <= i__1 ? i__1 : - s_rnge("known", i__1, "tpartv_", (ftnlen)1136)) * 12, meanng - + ((i__2 = use - 1) < 300 && 0 <= i__2 ? i__2 : s_rnge("mean" - "ng", i__2, "tpartv_", (ftnlen)1136)) * 12, &l2r, (ftnlen)12, ( - ftnlen)12); - *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, error, - string_len, type_len, pictur_len, error_len); - if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) { - suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len); - } - if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1) != - 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len, - pictur_len); - } - if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) != - 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len, - pictur_len); - } - return 0; - } - -/* Make sure we don't have a pair of successive delimiters */ -/* or a delimiter at either end of the input string. */ - - if (zzispt_(",/-:d.", &from, &to, (ftnlen)6)) { - *succes = FALSE_; - *ntvec = 0; - s_copy(type__, " ", type_len, (ftnlen)1); - s_copy(error, string, error_len, string_len); - i__1 = to + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &from, error, error_len, (ftnlen)1, error_len); - prefix_("There are two successive delimiters <#> in the input string" - ". This is an ambiguous input. ' ", &c__0, error, (ftnlen)92, - error_len); - repmc_(error, "#", string + (from - 1), error, error_len, (ftnlen)1, - to - (from - 1), error_len); - suffix_("'", &c__0, error, (ftnlen)1, error_len); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - return 0; - } - -/* A delimiter hanging at either end of the string shall be */ -/* regarded as an error. */ - - resolv = zzgrep_(rep, (ftnlen)12); - r__ = rtrim_(rep, (ftnlen)12); - if (i_indx(",/-:.", rep, (ftnlen)5, (ftnlen)1) > 0) { - resolv = zzsubt_(rep, "Q", &l2r, (ftnlen)1, (ftnlen)1); - resolv = FALSE_; - } else if (i_indx(",/-:.", rep + (r__ - 1), (ftnlen)5, (ftnlen)1) > 0) { - resolv = zzsubt_(rep + (r__ - 1), "Q", &l2r, (ftnlen)1, (ftnlen)1); - resolv = FALSE_; - } - if (! resolv) { - resolv = zznote_("Q", &from, &to, (ftnlen)1); - s_copy(error, string, error_len, string_len); - i__1 = to + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &from, error, error_len, (ftnlen)1, error_len); - prefix_("An unexpected delimiter ('#') was encountered in the input " - "string. ' ", &c__0, error, (ftnlen)69, error_len); - suffix_("'", &c__0, error, (ftnlen)1, error_len); - repmc_(error, "#", string + (from - 1), error, error_len, (ftnlen)1, - to - (from - 1), error_len); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - *succes = FALSE_; - return 0; - } - -/* We probably made it unscathed through the check above. */ -/* Remove delimiters ',', '/', and '-' and retry the built-in */ -/* patterns. */ - - *(unsigned char *)&delim[0] = ','; - *(unsigned char *)&delim[1] = '-'; - *(unsigned char *)&delim[2] = '/'; - for (i__ = 1; i__ <= 3; ++i__) { - resolv = zzremt_(delim + ((i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("delim", i__1, "tpartv_", (ftnlen)1227)), (ftnlen)1); - resolv = zzgrep_(rep, (ftnlen)12); - use = bsrchc_(rep, &nknown, known, (ftnlen)12, (ftnlen)12); - if (use > 0) { - resolv = zzrept_(known + ((i__1 = use - 1) < 300 && 0 <= i__1 ? - i__1 : s_rnge("known", i__1, "tpartv_", (ftnlen)1234)) * - 12, meanng + ((i__2 = use - 1) < 300 && 0 <= i__2 ? i__2 : - s_rnge("meanng", i__2, "tpartv_", (ftnlen)1234)) * 12, & - l2r, (ftnlen)12, (ftnlen)12); - *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, - error, string_len, type_len, pictur_len, error_len); - if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) { - suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len); - } - if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1) - != 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len, - pictur_len); - } - if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) - != 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len, - pictur_len); - } - return 0; - } - } - -/* If we make it to this point, we must have a pretty funky */ -/* time string. There are some obvious incompatibilities. We */ -/* check them now */ - - if (zznote_("e", &b, &e, (ftnlen)1)) { - } else if (zznote_("s", &b, &e, (ftnlen)1)) { - } else if (zznote_("Z", &b, &e, (ftnlen)1)) { - } else if (zznote_("w", &b, &e, (ftnlen)1)) { - } else if (zznote_("N", &b, &e, (ftnlen)1)) { - } - -/* If B is non-zero the item in question is a duplicate */ -/* modifier. */ - - if (b > 0) { - *succes = FALSE_; - *ntvec = 0; - s_copy(type__, " ", type_len, (ftnlen)1); - s_copy(error, string, error_len, string_len); - i__1 = e + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len); - prefix_("The substring \"#\" is a duplicate modifier of the input st" - "ring: ' ", &c__0, error, (ftnlen)65, error_len); - suffix_("'", &c__0, error, (ftnlen)1, error_len); - repmc_(error, "#", string + (b - 1), error, error_len, (ftnlen)1, e - - (b - 1), error_len); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - return 0; - } - -/* Look for unresolved markers */ - - if (zznote_("[", &b, &e, (ftnlen)1)) { - } else if (zznote_("]", &b, &e, (ftnlen)1)) { - } else if (zznote_("O", &b, &e, (ftnlen)1)) { - } else if (zznote_("o", &b, &e, (ftnlen)1)) { - } else if (zznote_("z", &b, &e, (ftnlen)1)) { - } - if (b > 0) { - *succes = FALSE_; - *ntvec = 0; - s_copy(type__, " ", type_len, (ftnlen)1); - s_copy(error, string, error_len, string_len); - i__1 = e + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len); - prefix_("The substring \"#\" could not be resolved in the input stri" - "ng: ' ", &c__0, error, (ftnlen)63, error_len); - suffix_("'", &c__0, error, (ftnlen)1, error_len); - repmc_(error, "#", string + (b - 1), error, error_len, (ftnlen)1, e - - (b - 1), error_len); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - return 0; - } - if (zzist_("m", (ftnlen)1) && zzist_("d", (ftnlen)1)) { - *succes = FALSE_; - *ntvec = 0; - s_copy(type__, " ", type_len, (ftnlen)1); - s_copy(error, string, error_len, string_len); - resolv = zznote_("m", &b1, &e1, (ftnlen)1); - resolv = zznote_("d", &b2, &e2, (ftnlen)1); - b = max(b1,b2); - e = max(e1,e2); - i__1 = e + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len); - b = min(b1,b2); - e = min(e1,e2); - i__1 = e + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len); - prefix_("Both a month \"#\" and day of year delimiter \"#\" appear i" - "n the input string: ' ", &c__0, error, (ftnlen)77, error_len); - suffix_("'", &c__0, error, (ftnlen)1, error_len); - repmc_(error, "#", string + (b1 - 1), error, error_len, (ftnlen)1, e1 - - (b1 - 1), error_len); - repmc_(error, "#", string + (b2 - 1), error, error_len, (ftnlen)1, e2 - - (b2 - 1), error_len); - s_copy(pictur, " ", pictur_len, (ftnlen)1); - return 0; - } - -/* Make the remaining obvious substitutions for hours, */ -/* minutes, and seconds */ - - if (zzrept_("i:i:i:n", "D*H*M*S", &r2l, (ftnlen)7, (ftnlen)7)) { - } else if (zzrept_("i:i:i:i", "D*H*M*S", &r2l, (ftnlen)7, (ftnlen)7)) { - } else if (zzrept_("i:i:n", "H*M*S", &r2l, (ftnlen)5, (ftnlen)5)) { - } else if (zzrept_("i:i:i", "H*M*S", &r2l, (ftnlen)5, (ftnlen)5)) { - } else if (zzrept_("i:n", "H*M", &r2l, (ftnlen)3, (ftnlen)3)) { - } else if (zzrept_("i:i", "H*M", &r2l, (ftnlen)3, (ftnlen)3)) { - } - resolv = zzremt_(":", (ftnlen)1); - -/* Handle the obvious substitutions of an integer next to */ -/* a Month. */ - - if (zzsubt_("", "SYDm", &l2r, (ftnlen)5, (ftnlen)4)) { - } else if (zzsubt_("im>", "Dm", &l2r, (ftnlen)3, (ftnlen)2)) { - } else if (zzsubt_("miY>", "mDY", &l2r, (ftnlen)4, (ftnlen)3)) { - } else if (zzsubt_("Ymi", "YmD", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzsubt_("Smi", "SmD", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzsubt_("Mmi", "MmD", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzsubt_("imY", "DmY", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzsubt_("imH", "DmH", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzrept_("Yid", "Yy*", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzrept_("iYd", "yY*", &l2r, (ftnlen)3, (ftnlen)3)) { - } else if (zzrept_("Ydi", "Y*y", &l2r, (ftnlen)3, (ftnlen)3)) { - } - -/* That's it we let ZZUNPCK handle the problem of diagnosing */ -/* or decoding the current representation. */ - - *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, error, - string_len, type_len, pictur_len, error_len); - if (s_cmp(pictur, " ", pictur_len, (ftnlen)1) != 0) { - if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) { - suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len); - } - if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1) != - 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len, - pictur_len); - } - if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) != - 0) { - suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len); - suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len, - pictur_len); - } - } - return 0; -} /* tpartv_ */ - diff --git a/ext/spice/src/cspice/tpictr.c b/ext/spice/src/cspice/tpictr.c deleted file mode 100644 index 46a462a3b8..0000000000 --- a/ext/spice/src/cspice/tpictr.c +++ /dev/null @@ -1,209 +0,0 @@ -/* tpictr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TPICTR ( Create a Time Format Picture ) */ -/* Subroutine */ int tpictr_(char *sample, char *pictur, logical *ok, char * - error, ftnlen sample_len, ftnlen pictur_len, ftnlen error_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal tvec[10]; - logical mods; - char type__[5]; - integer ntvec; - logical succes, yabbrv; - char modify[8*5]; - extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char - *, char *, logical *, logical *, logical *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Given a sample time string, create a time format picture */ -/* suitable for use by the routine TIMOUT. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SAMPLE I is a sample date time string */ -/* PICTUR O is a format picture that describes SAMPLE */ -/* OK O indicates success or failure to parse SAMPLE */ -/* ERROR O a diagnostic returned if SAMPLE cannot be parsed */ - -/* $ Detailed_Input */ - -/* SAMPLE is a representative time string that to use */ -/* as a model to format time strings. */ - -/* $ Detailed_Output */ - -/* PICTUR is a format picture suitable for use with the SPICE */ -/* routine TIMOUT. This picture when used to format */ -/* the appropriate epoch via TIMOUT will yield the same */ -/* time components in the same order as the components */ -/* in SAMPLE. */ - -/* Picture should be declared to be at least 80 characters */ -/* in length. If Picture is not sufficiently large */ -/* to contain the format picture, the picture will */ -/* be truncated on the right. */ - -/* OK is a logical flag. If all of the components of SAMPLE */ -/* are recognizable, OK will be returned with the value */ -/* TRUE. If some part of PICTUR cannot be parsed, */ -/* OK will be returned with the value FALSE. */ - -/* ERROR is a diagnostic message that indicates what part of */ -/* SAMPLE was not recognizable. If SAMPLE can be */ -/* successfully parsed, OK will be TRUE and ERROR will */ -/* be returned as a blank string. If ERROR does not */ -/* have sufficient room (up to 400 characters) to */ -/* contain the full message, the message will be truncated */ -/* on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) All problems with the inputs are diagnosed via OK and ERROR. */ - -/* 2) If a format picture can not be created from the sample */ -/* time string, PICTUR is returned as a blank string. */ - -/* $ Particulars */ - -/* Although the routine TIMOUT provides SPICE users with a great */ -/* deal of flexibility in formatting time strings, users must */ -/* master the means by which a time picture is constructed */ -/* suitable for use by TIMOUT. */ - -/* This routine allows SPICE users to supply a sample time string */ -/* from which a corresponding time format picture can be created, */ -/* freeing users from the task of mastering the intricacies of */ -/* the routine TIMOUT. */ - -/* Note that TIMOUT can produce many time strings whose patterns */ -/* can not be discerned by this routine. When such outputs are */ -/* called for, the user must consult TIMOUT and construct the */ -/* appropriate format picture "by hand". However, these exceptional */ -/* formats are not widely used and are not generally recognizable */ -/* to an uninitiated reader. */ - -/* $ Examples */ - -/* Suppose you need to print epochs corresponding to some */ -/* events and you wish the epochs to have the same arrangement */ -/* of components as in the string '10:23 P.M. PDT January 3, 1993' */ - -/* The following subroutine call will construct the appropriate */ -/* format picture for use with TIMOUT. */ - -/* CALL TPICTR ( '10:23 P.M. PDT January 3, 1993', PICTUR, OK, ERROR) */ - -/* The resulting picture is: */ - -/* 'AP:MN AMPM PDT Month DD, YYYY ::UTC-7' */ - -/* This picture can be used with TIMOUT to format a sequence */ -/* of epochs, ET(1),...,ET(N) (given as ephemeris seconds past J2000) */ -/* as shown in the loop below: */ - -/* DO I = 1, N */ -/* CALL TIMOUT ( ET(I), PICTUR, STRING ) */ -/* WRITE (*,*) 'Epoch: ', I, ' --- ', STRING */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 16-MAR-1999 (WLT) */ - -/* Corrected a minor spelling error in the header comments. */ - -/* - SPICELIB Version 1.0.0, 10-AUG-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Use a sample time string to produce a time format picture */ - -/* -& */ - -/* This routine is really just a front for one aspect of */ -/* the routine TPARTV. */ - - s_copy(error, " ", error_len, (ftnlen)1); - tpartv_(sample, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes, - pictur, error, sample_len, (ftnlen)5, (ftnlen)8, pictur_len, - error_len); - if (s_cmp(pictur, " ", pictur_len, (ftnlen)1) == 0) { - *ok = FALSE_; - } else { - *ok = TRUE_; - s_copy(error, " ", error_len, (ftnlen)1); - } - return 0; -} /* tpictr_ */ - diff --git a/ext/spice/src/cspice/tpictr_c.c b/ext/spice/src/cspice/tpictr_c.c deleted file mode 100644 index 2f37b92361..0000000000 --- a/ext/spice/src/cspice/tpictr_c.c +++ /dev/null @@ -1,254 +0,0 @@ -/* - --Procedure tpictr_c ( Create a Time Format Picture ) - --Abstract - - Given a sample time string, create a time format picture - suitable for use by the routine timout_c. - --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 - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - - - void tpictr_c ( ConstSpiceChar * sample, - SpiceInt lenout, - SpiceInt lenerr, - SpiceChar * pictur, - SpiceBoolean * ok, - SpiceChar * errmsg ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - sample I A sample time string. - lenout I The length for the output picture string. - lenerr I The length for the output error string. - pictur O A format picture that describes sample. - ok O Flag indicating whether sample parsed successfully. - errmsg O Diagnostic returned if sample cannot be parsed. - --Detailed_Input - - - sample is a representative time string to use as a model to - format time strings. - - lenout is the allowed length for the output picture. This length - must large enough to hold the output string plus the null - terminator. If the output string is expected to have x - characters, lenout needs to be x + 1. 80 is a reasonable - value for lenout (79 characters plus the null - terminator). - - lenerr is the allowed length for the output error string. - - --Detailed_Output - - - pictur is a format picture suitable for use with the SPICE - routine timout_c. This picture, when used to format an - epoch via timout_c, will yield the same time components in - the same order as the components in sample. - - ok is a logical flag indicating whether the input format - sample could be parsed. If all of the components of - sample are recognizable, ok will be returned with the - value SPICEFALSE. If some part of pictur cannot be - parsed, ok will be returned with the value SPICEFALSE. - - errmsg is a diagnostic message that indicates what part of - sample was not recognizable. If sample was successfully - parsed, ok will be SPICEFALSE and errmsg will be - returned as an empty string. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - 1) All problems with the inputs are diagnosed via ok and errmsg. - - 2) If a format picture can not be created from the sample - time string, pictur is returned as a blank string. - --Particulars - - Although the routine timout_c provides CSPICE users with a great - deal of flexibility in formatting time strings, users must - master the means by which a time picture is constructed - suitable for use by timout_c. - - This routine allows CSPICE users to supply a sample time string - from which a corresponding time format picture can be created, - freeing users from the task of mastering the intricacies of - the routine timout_c. - - Note that timout_c can produce many time strings whose patterns - can not be discerned by this routine. When such outputs are - called for, the user must consult timout_c and construct the - appropriate format picture "by hand." However, these exceptional - formats are not widely used and are not generally recognizable - to an uninitiated reader. - --Examples - - Suppose you need to print epochs corresponding to some events and - you wish the epochs to have the same arrangement of components as in - the string "10:23 P.M. PDT January 3, 1993". - - The following subroutine call will construct the appropriate format - picture for use with timout_c. - - tpictr_c ( "10:23 P.M. PDT January 3, 1993", - lenout, lenerr, pictur, &ok, errmsg ); - - The resulting picture is: - - "AP:MN AMPM PDT Month DD, YYYY ::UTC-7" - - This picture can be used with timout_c to format a sequence - of epochs, et[0],...,et[n-1] (given as ephemeris seconds past J2000) - as shown in the loop below: - - #include "SpiceUsr.h" - . - . - . - for ( i = 0; i < n; i++ ) - { - timout_c ( et[i], pictur, string ); - printf ( "Epoch: %d --- %s\n", i, string ); - } - --Restrictions - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 23-JUL-1999 (EDW) (WLT) - --Index_Entries - - Use a sample time string to produce a time format picture - --& -*/ - -{ /* Begin tpictr_c */ - - /* - Local variables - */ - logical okeydoke; - - /* - Participate in error tracing. - */ - chkin_c ( "tpictr_c" ); - - - /* - Check the input string sample to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "tpictr_c", sample ); - - - /* - Make sure the output strings have at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_STANDARD, "tpictr_c", pictur, lenout ); - CHKOSTR ( CHK_STANDARD, "tpictr_c", errmsg, lenerr ); - - - /* - Call the f2c'd routine. - */ - tpictr_( ( char * ) sample, - ( char * ) pictur, - ( logical * ) &okeydoke, - ( char * ) errmsg, - ( ftnlen ) strlen( sample ), - ( ftnlen ) lenout - 1, - ( ftnlen ) lenerr - 1 ); - - - /* - Convert the output strings to C style. - */ - F2C_ConvertStr( lenout, pictur ); - F2C_ConvertStr( lenerr, errmsg ); - - - /* - Convert the status flag from logical to SpiceBoolean. - */ - - *ok = okeydoke; - - - chkout_c ( "tpictr_c" ); - - -} /* End tpictr_c */ - - diff --git a/ext/spice/src/cspice/trace.c b/ext/spice/src/cspice/trace.c deleted file mode 100644 index abca738686..0000000000 --- a/ext/spice/src/cspice/trace.c +++ /dev/null @@ -1,131 +0,0 @@ -/* trace.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TRACE ( Trace of a 3x3 matrix ) */ -doublereal trace_(doublereal *matrix) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the trace of a 3x3 matrix. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I 3x3 matrix of double precision numbers. */ -/* TRACE O The trace of MATRIX. */ - -/* $ Detailed_Input */ - -/* MATRIX is a double precision 3x3 matrix. */ - -/* $ Detailed_Output */ - -/* TRACE is the trace of MATRIX, i.e. it is the sum of the */ -/* diagonal elements of MATRIX. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* TRACE simply executes in FORTRAN code the following loop: */ - -/* TRACE = Summation from I = 1 to 3 of MATRIX(I,I) */ - -/* No error detection or correction is implemented within this */ -/* function. */ - -/* $ Examples */ - -/* | 3 5 7 | */ -/* Suppose that MATRIX = | 0 -2 8 | , then */ -/* | 4 0 -1 | */ - -/* TRACE (MATRIX) = 0. (which is the sum of 3, -2 and -1). */ - -/* $ Restrictions */ - -/* No checking is performed to guard against floating point overflow */ -/* or underflow. This routine should probably not be used if the */ -/* input matrix is expected to have large double precision numbers */ -/* along the diagonal. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* trace of a 3x3_matrix */ - -/* -& */ - ret_val = matrix[0] + matrix[4] + matrix[8]; - - return ret_val; -} /* trace_ */ - diff --git a/ext/spice/src/cspice/trace_c.c b/ext/spice/src/cspice/trace_c.c deleted file mode 100644 index 2cdf12ad92..0000000000 --- a/ext/spice/src/cspice/trace_c.c +++ /dev/null @@ -1,140 +0,0 @@ -/* - --Procedure trace_c ( Trace of a 3x3 matrix ) - --Abstract - - Return the trace of a 3x3 matrix. - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #undef trace_c - - SpiceDouble trace_c ( ConstSpiceDouble matrix[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - matrix I 3x3 matrix of double precision numbers. - trace O The trace of matrix. - --Detailed_Input - - matrix is a double precision 3x3 matrix. - --Detailed_Output - - trace is the trace of matrix, i.e. it is the sum of the - diagonal elements of matrix. - --Parameters - - None. - --Particulars - - trace_c simply executes in C code the following loop: - - trace_c = Summation from i = 1 to 3 of matrix[i][i] - - This functions implements no error detection. - --Examples - - | 3 5 7 | - Suppose that matrix = | 0 -2 8 | , then - | 4 0 -1 | - - trace_c (matrix) = 0. (which is the sum of 3, -2 and -1). - --Restrictions - - No checking is performed to guard against floating point overflow - or underflow. This routine should probably not be used if the - input matrix is expected to have large double precision numbers - along the diagonal. - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 - --Index_Entries - - trace of a 3x3_matrix - --& -*/ - -{ /* Begin trace_c */ - - /* - Local variables - */ - SpiceInt i; - SpiceDouble trace = 0.; - - - /* Do it. This isn't rocket science. */ - for ( i = 0; i < 3; i++ ) - { - trace += matrix[i][i]; - } - - return trace; - - -} /* End trace_c */ diff --git a/ext/spice/src/cspice/traceg.c b/ext/spice/src/cspice/traceg.c deleted file mode 100644 index 65de9925a4..0000000000 --- a/ext/spice/src/cspice/traceg.c +++ /dev/null @@ -1,154 +0,0 @@ -/* traceg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TRACEG ( Trace of a matrix, general dimension ) */ -doublereal traceg_(doublereal *matrix, integer *ndim) -{ - /* System generated locals */ - integer matrix_dim1, matrix_dim2, matrix_offset, i__1, i__2; - doublereal ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Return the trace of a square matrix of arbitrary dimension. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I NDIM x NDIM matrix of double precision numbers. */ -/* NDIM I Dimension of the matrix. */ -/* TRACEG O The trace of MATRIX. */ - -/* $ Detailed_Input */ - -/* MATRIX is a double precision square matrix of arbitrary */ -/* dimension. The input matrix must be square or else */ -/* the concept is meaningless. */ - -/* NDIM is the dimension of MATRIX. */ - -/* $ Detailed_Output */ - -/* TRACEG is the trace of MATRIX, i.e. it is the sum of the */ -/* diagonal elements of MATRIX. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* TRACEG simply executes in FORTRAN code the following loop: */ - -/* TRACEG = Summation from I = 1 to NDIM of MATRIX(I,I) */ - -/* No error detection or correction is implemented within this */ -/* function. */ - -/* $ Examples */ - -/* | 3 5 7 | */ -/* Suppose that MATRIX = | 0 -2 8 | (with NDIM = 3), then */ -/* | 3 0 -1 | */ - -/* TRACEG (MATRIX, 3) = 0. (which is the sum of 3, -2 and -1). */ - -/* $ Restrictions */ - -/* No checking is performed to guard against floating point overflow */ -/* or underflow. This routine should probably not be used if the */ -/* input matrix is expected to have large double precision numbers */ -/* along the diagonal. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* trace of a nxn_matrix */ - -/* -& */ - /* Parameter adjustments */ - matrix_dim1 = *ndim; - matrix_dim2 = *ndim; - matrix_offset = matrix_dim1 + 1; - - /* Function Body */ - ret_val = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - ret_val += matrix[(i__2 = i__ + i__ * matrix_dim1 - matrix_offset) < - matrix_dim1 * matrix_dim2 && 0 <= i__2 ? i__2 : s_rnge("matr" - "ix", i__2, "traceg_", (ftnlen)133)]; - } - return ret_val; -} /* traceg_ */ - diff --git a/ext/spice/src/cspice/trcoff_c.c b/ext/spice/src/cspice/trcoff_c.c deleted file mode 100644 index c09c57c556..0000000000 --- a/ext/spice/src/cspice/trcoff_c.c +++ /dev/null @@ -1,145 +0,0 @@ -/* - --Procedure trcoff_c ( Turn tracing off ) - --Abstract - - Disable tracing. - --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 - - ERROR - --Keywords - - ERROR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - - void trcoff_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - --Particulars - - This routine disables tracing. Checking in or out does not modify - the current traceback any further after trcoff_c is called. The - routines trcnam_, trcdep_, and qcktrc_ will return information - based on the traceback at the point where trcoff_c is called. - - Once tracing has been disabled, it cannot be re-enabled. - - Additionally, trcoff_c blanks out the existing trace, since the - trace will usually be invalid at the time an error is signalled. - The frozen copy of the trace, if there is one, is not modified. - --Examples - - 1) /. - Program initialization: - - . - . - . - - We disable tracing to enhance speed: - ./ - trcoff_c (); - /. - More initialization code: - ./ - . - . - . - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - turn tracing off - --& -*/ - -{ /* Begin trcoff_c */ - - /* - Call the f2c'd routine - */ - trcoff_(); - - - -} /* End trcoff_c */ diff --git a/ext/spice/src/cspice/trcpkg.c b/ext/spice/src/cspice/trcpkg.c deleted file mode 100644 index 19eaa5d7be..0000000000 --- a/ext/spice/src/cspice/trcpkg.c +++ /dev/null @@ -1,2640 +0,0 @@ -/* trcpkg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure TRCPKG ( Trace package ) */ -/* Subroutine */ int trcpkg_0_(int n__, integer *depth, integer *index, char * - module, char *trace, char *name__, ftnlen module_len, ftnlen - trace_len, ftnlen name_len) -{ - /* Initialized data */ - - static logical notrc = FALSE_; - static integer frzcnt = 0; - static integer frzovr = 0; - static integer maxdep = 0; - static integer modcnt = 0; - static integer ovrflw = 0; - - /* System generated locals */ - address a__1[5], a__2[3]; - integer i__1, i__2, i__3[5], i__4[3], i__5; - char ch__1[149], ch__2[64]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - integer i__, l; - static char stack[32*100]; - integer first; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - char device[255]; - extern /* Subroutine */ int getact_(integer *); - integer action; - extern /* Subroutine */ int getdev_(char *, ftnlen); - char tmpnam[80]; - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int wrline_(char *, char *, ftnlen, ftnlen); - static char frozen[32*100]; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - char string[11]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Maintain a trace of subroutine calls for error messages. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O ENTRY */ -/* -------- --- -------------------------------------------------- */ - -/* DEPTH O TRCDEP */ -/* DEPTH O TRCMXD */ -/* INDEX I TRCNAM */ -/* NAME O TRCNAM */ -/* MODULE I CHKIN, CHKOUT */ -/* TRACE O QCKTRC */ - -/* FILEN P */ -/* NAMLEN P */ -/* MAXMOD P */ - -/* $ Detailed_Input */ - -/* See the ENTRY points for discussions of their arguments. */ - -/* $ Detailed_Output */ - -/* See the ENTRY points for discussions of their arguments. */ - -/* $ Parameters */ - -/* FILEN is the maximum length of a file name. */ - -/* NAMLEN is the maximum length of the significant */ -/* portion of a module name. */ - -/* MAXMOD is the maximum storage depth for names in the */ -/* traceback stack. */ - -/* $ Exceptions */ - -/* 1) If TRCPKG is called directly, the error SPICE(BOGUSENTRY) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The entry points declared in this routine are: */ - -/* CHKIN */ -/* CHKOUT */ -/* TRCDEP */ -/* TRCMXD */ -/* TRCNAM */ -/* QCKTRC */ -/* FREEZE */ -/* TRCOFF */ - -/* This routine serves as an umbrella that allows the entry */ -/* points to share data. TRCPKG should never be called directly. */ - -/* See the subroutine ERRACT for descriptions of the error actions */ -/* and codes. */ - -/* $ Examples */ - -/* See the entry points CHKIN, CHKOUT, TRCDEP, TRCMXD, TRCNAM, */ -/* QCKTRC, FREEZE, and TRCOFF for examples. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* Bug fix: the previous version of entry point CHKOUT failed to */ -/* make a correct module name comparison when the input name */ -/* exceeded NAMLEN characters in length. Now only the initial */ -/* NAMLEN non-blank characters (at most) of the input name are */ -/* used in the comparison. */ - -/* - SPICELIB Version 3.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 2.0.0, 11-NOV-1993 (HAN) */ - -/* Module was updated to include the values for FILEN and */ -/* NAMLEN for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. The previous value of 256 for Unix */ -/* platforms was changed to 255. */ - -/* - SPICELIB Version 1.3.0, 23-OCT-1992 (NJB) */ - -/* Bug fix made to routine QCKTRC: a section of code which */ -/* itself is exercised only if a bug is present inserted the */ -/* wrong variable into an error message. */ - -/* - SPICELIB Version 1.2.0, 12-OCT-1992 (HAN) */ - -/* Module was updated to include the values of the parameters */ -/* for the Hewlett Packard UX 9000/750 environment. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1990 (NJB) */ - -/* Added declarations for trace disabling. Re-organized */ -/* declarations. Updated comments. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* Bug fix: the previous version of entry point CHKOUT failed to */ -/* make a correct module name comparison when the input name */ -/* exceeded NAMLEN characters in length. Now only the initial */ -/* NAMLEN non-blank characters (at most) of the input name are */ -/* used in the comparison. */ - -/* - SPICELIB Version 3.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 2.0.0, 11-NOV-1993 (HAN) */ - -/* Module was updated to include the values for FILEN and */ -/* NAMLEN for the Silicon Graphics, DEC Alpha-OSF/1, and */ -/* NeXT platforms. The previous value of 256 for Unix */ -/* platforms was changed to 255. */ - -/* - SPICELIB Version 1.3.0, 23-OCT-1992 (NJB) */ - -/* Bug fix made to routine QCKTRC: a section of code which */ -/* itself is exercised only if a bug is present inserted the */ -/* wrong variable into an error message. */ - -/* - SPICELIB Version 1.2.0, 12-OCT-1992 (HAN) */ - -/* Module was updated to include the values of the parameters */ -/* for the Hewlett Packard UX 9000/750 environment. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - - -/* - SPICELIB Version 1.1.0, 18-JUN-1990 (NJB) */ - -/* Added declarations for trace disabling. Re-organized */ -/* declarations. Updated comments to reflect inclusion */ -/* of the new entry point TRCOFF. Also updated the header */ -/* to make the style more parallel to other SPICELIB */ -/* umbrella routines. Updated the description line and */ -/* abstract, in particular. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine. */ - -/* -& */ - -/* SPICELIB functions: */ - - -/* Local parameters */ - -/* This is the length for a local temporary string used to help */ -/* format error messages. It and the character string are only */ -/* present to aviod real or potential problems with pedantic */ -/* Fortran compilers. 80 characters should be more than sufficient */ -/* to contain a module name. */ - - -/* The integer mnemonic for the RETURN error action. */ - - -/* Local Variables: */ - - -/* Saved variables: */ - - -/* Initial values: */ - - switch(n__) { - case 1: goto L_chkin; - case 2: goto L_chkout; - case 3: goto L_trcdep; - case 4: goto L_trcmxd; - case 5: goto L_trcnam; - case 6: goto L_qcktrc; - case 7: goto L_freeze; - case 8: goto L_trcoff; - } - - -/* Executable Code: */ - - wrline_("SCREEN", "SPICE(BOGUSENTRY)", (ftnlen)6, (ftnlen)17); - wrline_("SCREEN", "TRCPKG: You have called an entry that performs no run" - "-time function. ", (ftnlen)6, (ftnlen)69); - return 0; -/* $Procedure CHKIN ( Module Check In ) */ - -L_chkin: -/* $ Abstract */ - -/* Inform the SPICELIB error handling mechanism of entry into a */ -/* routine. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) MODULE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* MODULE I The name of the calling routine. */ -/* FILEN P Maximum length of file name. */ - -/* $ Detailed_Input */ - -/* MODULE is the name of the routine calling CHKIN. The */ -/* named routine is supposed to be `checking in' */ -/* when it calls CHKIN; that is, the call should be */ -/* the first executable statement following the */ -/* reference to the function RETURN (which should be */ -/* the first executable statement). */ - -/* Only the first NAMLEN non-blank characters in */ -/* a module name are stored for use in a traceback */ -/* by this subroutine. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN is the maximum file name length that can be */ -/* accommodated by this routine. */ - -/* $ Exceptions */ - -/* CHKIN does not signal errors; rather it writes error messages, */ -/* so as to avoid recursion. */ - - -/* 1) If the traceback storage area overflows, the short error */ -/* message SPICE(TRACEBACKOVERFLOW) is written to the error */ -/* output device. */ - -/* 2) If the input argument MODULE is blank, the short error message */ -/* SPICE(BLANKMODULENAME) is written to the error output device. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* Conceptually, the effect of this routine is to `push' the */ -/* supplied module name onto a stack. The routine CHKOUT performs */ -/* the inverse, or `pop', operation. */ - -/* Every routine that participates in the traceback scheme should */ -/* have a call to CHKIN as the second executable statement. The */ -/* first executable statements should be: */ - -/* IF ( RETURN() ) THEN */ -/* RETURN */ -/* ELSE */ -/* CALL CHKIN ( module ) */ -/* END IF */ - -/* Here module is the name of the routine in which this code appears. */ - -/* The line of code preceding the END or any RETURN statement should */ -/* be */ - -/* CALL CHKOUT ( module ) */ - - -/* All SPICELIB routines should call CHKIN and CHKOUT, unless they */ -/* are classified as `error free'. Programs linked with SPICELIB */ -/* may also use CHKIN and CHKOUT. */ - -/* Routines that don't call CHKIN and CHKOUT won't appear in the */ -/* traceback. */ - -/* All routines that call CHKIN must also call CHKOUT, or else the */ -/* trace mechanism will become very confused. */ - -/* It is possible to disable check-ins (and check-outs) by calling */ -/* the entry point TRCOFF. CHKIN and CHKOUT will return immediately */ -/* upon entry after TRCOFF has been called. It is not possible to */ -/* re-enable check-ins and check-outs after calling TRCOFF. Routines */ -/* that don't call CHKIN and CHKOUT won't appear in the traceback. */ - -/* $ Examples */ - -/* See `Particulars' for an example of how to call this routine. */ - -/* $ Restrictions */ - -/* Routines that call this routine must call CHKOUT immediately */ -/* prior to any RETURN or END statement. */ - -/* Module names are assumed to have no embedded blanks. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* Bug fix: the previous version of entry point CHKOUT failed to */ -/* make a correct module name comparison when the input name */ -/* exceeded NAMLEN characters in length. Now only the initial */ -/* NAMLEN non-blank characters (at most) of the input name are */ -/* used in the comparison. */ - -/* - SPICELIB Version 3.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The short error dealing with embedded blanks has been removed, */ -/* since the new implementation is not hampered by Embedded */ -/* blanks. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 15-JUN-1990 (NJB) */ - -/* Disabling of check-ins implemented. Many parts of the */ -/* header have be re-written. Weird spacing ameliorated. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* module check in */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* Bug fix: the previous version of entry point CHKOUT failed to */ -/* make a correct module name comparison when the input name */ -/* exceeded NAMLEN characters in length. Now only the initial */ -/* NAMLEN non-blank characters (at most) of the input name are */ -/* used in the comparison. */ - -/* - SPICELIB Version 3.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The short error dealing with embedded blanks has been removed, */ -/* since the new implementation is not hampered by Embedded */ -/* blanks. */ - -/* - SPICELIB Version 2.0.0, 15-JUN-1990 (NJB) */ - -/* Disabling of check-ins implemented. Many parts of the */ -/* header have be re-written. Weird spacing ameliorated. */ - -/* - Beta Version 1.1.1, 10-FEB-1988 (NJB) */ - -/* Parameter declarations documented. Parameters section added, */ -/* and parameter declarations listed in `Brief I/O'. */ - -/* - Beta Version 1.1.0, 27-OCT-1988 (NJB) */ - -/* Cosmetic improvement to code. Condensed a continued */ -/* statement into one line. */ - -/* -& */ - -/* Get out immediately if tracing is disabled. */ - - if (notrc) { - return 0; - } - -/* Get the position of the first and last non-blank characters in */ -/* input module name, and set the length of the module name. */ - - first = frstnb_(module, module_len); - -/* Check to see if the module name is blank. */ - - if (first > 0) { - -/* If there is room for the name, place it at the top of the */ -/* stack. If not, increment the overflow counter and signal an */ -/* error. */ - - if (modcnt < 100) { - ++modcnt; - s_copy(stack + (((i__1 = modcnt - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "trcpkg_", (ftnlen)746)) << 5), - module + (first - 1), (ftnlen)32, module_len - (first - 1) - ); - } else { - ++ovrflw; - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(TRACEBACKOVERFLOW)", (ftnlen)255, (ftnlen) - 24); - wrline_(device, "CHKIN: The trace storage is completely full. " - "No further module names can be added.", (ftnlen)255, ( - ftnlen)84); - } - -/* Keep track of the maximum depth encountered. */ - - if (modcnt + ovrflw > maxdep) { - maxdep = modcnt + ovrflw; - } - } else { - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(BLANKMODULENAME)", (ftnlen)255, (ftnlen)22); - wrline_(device, "CHKIN: An attempt to check in was made without sup" - "plying a module name.", (ftnlen)255, (ftnlen)72); - } - -/* We're done now, so return. */ - - return 0; -/* $Procedure CHKOUT ( Module Check Out ) */ - -L_chkout: -/* $ Abstract */ - -/* Inform the SPICELIB error handling mechanism of exit from a */ -/* routine. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) MODULE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MODULE I The name of the calling routine. */ -/* NAMLEN P Maximum module name length. */ -/* FILEN P Maximum file name length. */ - -/* $ Detailed_Input */ - -/* MODULE is the name of the routine calling CHKOUT. The */ -/* named routine is supposed to be `checking out' */ -/* when it calls CHKOUT; that is, the call should be */ -/* the last executable statement preceding any exit */ -/* from the routine. */ - -/* Only the first NAMLEN non-blank characters in */ -/* a module name are used when checking out. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN is the maximum file name length that can be */ -/* accommodated by this routine. */ - -/* NAMLEN is the maximum module name length that can be */ -/* accommodated by this routine. */ - -/* $ Exceptions */ - -/* CHKOUT does not signal errors; rather it writes error messages, */ -/* so as to avoid recursion. */ - -/* 1) If the input module name MODULE does not match the name popped */ -/* from the trace stack, the short error message */ -/* SPICE(NAMESDONOTMATCH) is written to the error output device. */ - -/* 2) If the trace stack is empty, the short error message */ -/* SPICE(TRACESTACKEMPTY) is written to the error output device. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* Conceptually, the effect of this routine is to `pop' a module */ -/* name from a stack. The routine CHKIN performs the inverse, or */ -/* `push' operation. */ - -/* Every routine that participates in the traceback scheme should */ -/* have a call to CHKIN as the second executable statement. */ -/* The first executable statements should be: */ - -/* IF ( RETURN() ) THEN */ -/* RETURN */ -/* ELSE */ -/* CALL CHKIN ( module ) */ -/* END IF */ - -/* Here module is the name of the routine in which this code appears. */ - -/* The line of code preceding the END or any RETURN statement */ -/* should be */ - -/* CALL CHKOUT ( module ) */ - -/* All SPICELIB routines should call CHKIN and CHKOUT, unless they */ -/* are classified as `error free'. Programs linked with SPICELIB */ -/* may also use CHKIN and CHKOUT. */ - -/* Routines that don't call CHKIN and CHKOUT won't appear in the */ -/* traceback. */ - -/* All routines that call CHKIN must also call CHKOUT, or else the */ -/* trace mechanism will become very confused. */ - -/* It is possible to disable check-ins (and check-outs) by calling */ -/* the entry point TRCOFF. CHKIN and CHKOUT will return immediately */ -/* upon entry after TRCOFF has been called. It is not possible to */ -/* re-enable check-ins and check-outs after calling TRCOFF. Routines */ -/* that don't call CHKIN and CHKOUT won't appear in the traceback. */ - -/* $ Examples */ - -/* 1) Call CHKOUT before a RETURN statement: */ - -/* IF ( FAILED() ) THEN */ -/* CALL CHKOUT ( module ) */ -/* RETURN */ -/* END IF */ - - -/* 2) Call CHKOUT before an END statement: */ - -/* CALL CHKOUT ( module ) */ -/* END */ - - -/* 3) Only ONE call to CHKOUT is needed here: */ - -/* CALL CHKOUT ( module ) */ -/* RETURN */ -/* END */ - -/* $ Restrictions */ - -/* Routines that call this routine must call CHKIN as the second */ -/* executable statement. (The first is a call to RETURN). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 4.0.0, 30-OCT-1997 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* Bug fix: The previous version failed to make a correct */ -/* module name comparison when the input name exceeded NAMLEN */ -/* characters in length. Now only the initial NAMLEN non-blank */ -/* characters (at most) of the input name are used in the */ -/* comparison. */ - -/* - SPICELIB Version 3.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 15-JUN-1990 (NJB) */ - -/* Disabling of check-ins implemented. Many parts of the */ -/* header have be re-written. Weird spacing ameliorated. */ -/* Removed a bug check. Short error messages made more */ -/* specific. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* module check out */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 30-OCT-1997 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* Bug fix: The previous version failed to make a correct */ -/* module name comparison when the input name exceeded NAMLEN */ -/* characters in length. Now only the initial NAMLEN non-blank */ -/* characters (at most) of the input name are used in the */ -/* comparison. */ - -/* - SPICELIB Version 3.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* - SPICELIB Version 2.0.0, 15-JUN-1990 (NJB) */ - -/* Disabling of check-ins implemented. Many parts of the */ -/* header have be re-written. Weird spacing ameliorated. */ -/* Removed a bug check. Short error messages changed from */ -/* SPICE(INVALIDCHECKOUT) to SPICE(NAMESDONOTMATCH) and */ -/* SPICE(TRACESTACKEMPTY). */ - -/* - Beta Version 1.1.1, 10-FEB-1988 (NJB) */ - -/* Parameter declarations documented. Parameters section added, */ -/* and parameter declarations listed in `Brief I/O'. */ - -/* - Beta Version 1.1.0, 27-OCT-1988 (NJB) */ - -/* Cosmetic improvement to code. Removed a blank line */ -/* separating the first line of a statement from the next */ -/* continuation line, and condensed and re-organized */ -/* the statement. Note: the precompiler failed to properly */ -/* convert the orginal statement into standard Fortran. */ - -/* -& */ - -/* Get out immediately if tracing is disabled. */ - - if (notrc) { - return 0; - } - -/* Check to be sure we can remove a module name from the stack, */ -/* i.e., that we have not overflowed. */ - - if (ovrflw == 0) { - -/* We are not in overflow mode, compare the module name on */ -/* the top of the stack with the module name passed to us. If */ -/* they differ, it's an error. Regardless, we decrement the */ -/* module count. */ - - if (modcnt > 0) { - -/* Make the comparison using at most NAMLEN characters of the */ -/* initial non-blank substring of MODULE. */ - - first = frstnb_(module, module_len); -/* Computing MIN */ - i__1 = i_len(module, module_len), i__2 = first + 31; - l = min(i__1,i__2); - if (s_cmp(stack + (((i__1 = modcnt - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("stack", i__1, "trcpkg_", (ftnlen)1093)) << 5), - module + (first - 1), (ftnlen)32, l - (first - 1)) != 0) { - s_copy(tmpnam, module + (first - 1), (ftnlen)80, module_len - - (first - 1)); - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(NAMESDONOTMATCH)", (ftnlen)255, ( - ftnlen)22); -/* Writing concatenation */ - i__3[0] = 19, a__1[0] = "CHKOUT: Caller is "; - i__3[1] = rtrim_(tmpnam, (ftnlen)80), a__1[1] = tmpnam; - i__3[2] = 17, a__1[2] = "; popped name is "; - i__3[3] = rtrim_(stack + (((i__2 = modcnt - 1) < 100 && 0 <= - i__2 ? i__2 : s_rnge("stack", i__2, "trcpkg_", ( - ftnlen)1098)) << 5), (ftnlen)32), a__1[3] = stack + (( - (i__1 = modcnt - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "trcpkg_", (ftnlen)1098)) << 5); - i__3[4] = 1, a__1[4] = "."; - s_cat(ch__1, a__1, i__3, &c__5, (ftnlen)149); - wrline_(device, ch__1, (ftnlen)255, rtrim_(tmpnam, (ftnlen)80) - + 36 + rtrim_(stack + (((i__2 = modcnt - 1) < 100 && - 0 <= i__2 ? i__2 : s_rnge("stack", i__2, "trcpkg_", ( - ftnlen)1098)) << 5), (ftnlen)32) + 1); - } - --modcnt; - } else { - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(TRACESTACKEMPTY)", (ftnlen)255, (ftnlen)22) - ; - wrline_(device, "CHKOUT: An attempt to check out was made when n" - "o modules were checked in.", (ftnlen)255, (ftnlen)73); - } - } else { - -/* Overflow case: just decrement the overflow count. */ - - --ovrflw; - } - -/* Return to the caller. */ - - return 0; -/* $Procedure TRCDEP ( Traceback depth ) */ - -L_trcdep: -/* $ Abstract */ - -/* Return the number of modules in the traceback representation. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* INTEGER DEPTH */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ - -/* DEPTH O The number of modules in the traceback. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* DEPTH Indicates the number of module names in the */ -/* traceback representation. */ - -/* The module names represent modules in a call chain, */ -/* with the first name being the top-level module, */ -/* and the name with index DEPTH being the lowest */ -/* level module. */ - -/* The meaning of the traceback depends on the state */ -/* of the error handling mechanism. There are two */ -/* cases: */ - -/* 1. In 'RETURN' mode, when an error is */ -/* signalled, the traceback at that point is */ -/* saved. TRCDEP, TRCNAM, and QCKTRC will */ -/* return values pertaining to the saved */ -/* traceback. */ - -/* 2. In all other modes, the traceback represents */ -/* the CURRENT call chain. TRCDEP, TRCNAM, */ -/* and QCKTRC will return values pertaining to */ -/* the current trace representation. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* $ Examples */ - -/* 1) You can use this routine, together with TRCNAM, to create a */ -/* traceback report. We might wish to create such a report when */ -/* we have detected an error condition (see FAILED). */ - -/* In this example, we assume that the error has already been */ -/* detected, and that we wish to create a traceback report. We */ -/* assume the existence of two user-supplied routines: */ - -/* USER_TRACE_FORMAT -- creates a traceback report in the */ -/* format preferred by the user */ - -/* USER_TRACE_INIT -- indicates that a traceback report */ -/* is to be created; it also */ -/* indicates how many module names */ -/* will be in the report */ - -/* C */ -/* C Get the trace depth, and retrieve that number of */ -/* C module names from the traceback representation. */ -/* C Call USER_TRACE_INIT to indicate that a traceback */ -/* C report is to be created containing `DEPTH' */ -/* C number of module names. Input each of these names, */ -/* C as they are retrieved, to USER_TRACE_FORMAT. */ -/* C */ - -/* CALL TRCDEP ( DEPTH ) */ - -/* CALL USER_TRACE_INIT ( DEPTH ) */ - - -/* DO INDEX = 1, DEPTH */ - -/* CALL TRCNAM ( INDEX, MODULE ) */ - -/* CALL USER_TRACE_FORMAT ( MODULE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 15-JUN-1990 (NJB) */ - -/* Some comments updated. Some cosmetic changes too. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* traceback depth */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 1.0.1, 15-JUN-1990 (NJB) */ - -/* Some comments updated. Some cosmetic changes too. */ -/* -& */ - -/* Find the error handling mode. */ - - getact_(&action); - -/* If we're in 'RETURN' mode, and an error has occurred, we want to */ -/* use the frozen version of the traceback. Otherwise, we want to */ -/* get the use the current module stack depth. */ - - if (action == 3 && failed_()) { - *depth = frzcnt + frzovr; - } else { - *depth = modcnt + ovrflw; - } - -/* Return to the caller. */ - - return 0; -/* $Procedure TRCMXD ( Maximum traceback depth encountered. ) */ - -L_trcmxd: -/* $ Abstract */ - -/* Return the maximum number of modules encountered in the */ -/* traceback so far. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* INTEGER DEPTH */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ - -/* DEPTH O The maximum number of modules encountered. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* DEPTH Indicates the maximum number of module */ -/* names encountered in the traceback stack. */ -/* This would be the longest call chain that */ -/* occurred during the run of a program. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* $ Examples */ - -/* 1) You can use this routine to determine the length of the */ -/* longest sequence of subroutine calls in a program. Suppose */ -/* that you have a program, PROGRAM, that uses the spicelib */ -/* error handling with CHKIN and CHKOUT, and has three */ -/* subroutines, SUB_A, SUB_B, and SUB_C. THe program and */ -/* subroutines have the following relationships: */ - -/* PROGRAM calls SUB_A and SUB_C */ -/* SUB_C calls SUB_B */ - -/* If at the end of the program you were to call TRCMXD, */ - -/* CALL TRCMXD ( MAXDEP ) */ - -/* to obtain the maximum depth reached, MAXDEP woudl have a */ -/* value of three (3), because the program checked in, SUB_C */ -/* checked in, and SUB_B checked in during the longest call */ -/* chain in the program. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.0, 12-MAR-1996 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* traceback maximum depth */ - -/* -& */ - -/* It doesn't get any easier than this, simply set the maximum */ -/* depth and return. */ - - *depth = maxdep; - return 0; -/* $Procedure TRCNAM ( Get Module Name from Traceback ) */ - -L_trcnam: -/* $ Abstract */ - -/* Return the name of the module having the specified position in */ -/* the trace representation. The first module to check in is at */ -/* position 1. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* INTEGER INDEX */ -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* INDEX I The position of the requested module name. */ -/* NAME O The name in the #INDEX position in the traceback. */ -/* FILEN P Maximum file name length. */ - -/* $ Detailed_Input */ - -/* INDEX is the position in the traceback of the requested */ -/* module name. The first module to check in is in */ -/* the first position; the last to check in the */ -/* position indicated by the argument, DEPTH, */ -/* returned by TRCDEP. Note that the first module to */ -/* check in is at the top of the traced call chain. */ - -/* $ Detailed_Output */ - -/* NAME is the name of the module in the position within */ -/* the traceback indicated by INDEX. */ - -/* The meaning of the traceback depends on the state */ -/* of the error handling mechanism. There are two */ -/* cases: */ - -/* 1. In 'RETURN' mode, when an error is */ -/* signalled, the traceback at that point is */ -/* saved. TRCDEP, TRCNAM, and QCKTRC will */ -/* return values pertaining to the saved */ -/* traceback. */ - -/* 2. In all other modes, the traceback represents */ -/* the CURRENT call chain. TRCDEP, TRCNAM, */ -/* and QCKTRC will return values pertaining to */ -/* the current trace representation. */ - -/* $ Parameters */ - -/* FILEN is the maximum file name length that can be */ -/* accommodated by this routine. */ - -/* $ Exceptions */ - -/* Because this routine is below SIGERR in the calling hierarchy, */ -/* this routine can not call SIGERR in the event of an error. */ -/* Therefore, this routine outputs error messages, rather than */ -/* signalling errors. */ - -/* 1) This routine detects the condition of INDEX being out of */ -/* range. The short error message set in that case is */ -/* 'SPICE(INVALIDINDEX)'. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* $ Examples */ - -/* 1) You can use this routine, together with TRCNAM, to create a */ -/* traceback report. We might wish to create such a report when */ -/* we have detected an error condition (see FAILED). */ - -/* In this example, we assume that the error has already been */ -/* detected, and that we wish to create a traceback report. We */ -/* assume the existence of two user-supplied routines: */ - -/* USER_TRACE_FORMAT -- creates a traceback report in the */ -/* format preferred by the user */ - -/* USER_TRACE_INIT -- indicates that a traceback report */ -/* is to be created; it also */ -/* indicates how many module names */ -/* will be in the report */ - -/* C */ -/* C Get the trace depth, and retrieve that number of */ -/* C module names from the traceback representation. */ -/* C Call USER_TRACE_INIT to indicate that a traceback */ -/* C report is to be created containing `DEPTH' */ -/* C number of module names. Input each of these names, */ -/* C as they are retrieved, to USER_TRACE_FORMAT. */ -/* C */ - -/* CALL TRCDEP ( DEPTH ) */ - -/* CALL USER_TRACE_INIT ( DEPTH ) */ - - -/* DO INDEX = 1, DEPTH */ - -/* CALL TRCNAM ( INDEX, MODULE ) */ - -/* CALL USER_TRACE_FORMAT ( MODULE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The exception: */ - -/* 2) If INDEX is in range, but no module name is found */ -/* at the indicated location in the trace representation, */ -/* the error message 'SPICE(INVALIDINDEX)' is set. */ - -/* has been removed. The only way in which a module name cannot */ -/* be found for a specified index is if we have overflowed the */ -/* stack storage for module names, and in this case we return the */ -/* message ''. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 15-JUN-1990 (NJB) */ - -/* Error messages streamlined. Some comments updated. */ -/* Some cosmetic changes too. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get module name from traceback */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The exception: */ - -/* 2) If INDEX is in range, but no module name is found */ -/* at the indicated location in the trace representation, */ -/* the error message 'SPICE(INVALIDINDEX)' is set. */ - -/* has been removed. The only way in which a module name cannot */ -/* be found for a specified index is if we have overflowed the */ -/* stack storage for module names, and in this case we return the */ -/* message ''. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 1.1.0, 15-JUN-1990 (NJB) */ - -/* Error messages streamlined. Some comments updated. */ -/* Some cosmetic changes too. */ - -/* - Beta Version 1.1.1, 10-FEB-1988 (NJB) */ - -/* Parameter declarations documented. Parameters section added, */ -/* and parameter declarations listed in `Brief I/O'. */ - -/* - Beta Version 1.1.0, 27-OCT-1988 (NJB) */ - -/* Added test for failure to remove name from trace */ -/* representation. If LOC equals 0 on return from */ -/* NTHWD, the error SPICE(INVALIDINDEX) is reported. */ -/* SIGERR is not called; that would be overly recursive. */ - -/* Cosmetic changes to header and code were made. Indentation */ -/* of some header items was changed, and some blank lines */ -/* were removed from the code. */ -/* -& */ - -/* Get the error handling mode. */ - - getact_(&action); - -/* If we're in 'RETURN' mode, and an error has occurred, we want to */ -/* use the frozen version of the traceback. Otherwise, we want to */ -/* get the module name from the current traceback. */ - - if (action == 3 && failed_()) { - -/* Check the input index. It must be positive and less than the */ -/* current stack depth. */ - - if (*index <= 0 || *index > frzcnt + frzovr) { - -/* Invalid index...we output the error messages directly */ -/* in this case: */ - - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(INVALIDINDEX)", (ftnlen)255, (ftnlen)19); - intstr_(index, string, (ftnlen)11); -/* Writing concatenation */ - i__4[0] = 52, a__2[0] = "TRCNAM: An invalid index was input. Th" - "e value was: "; - i__4[1] = rtrim_(string, (ftnlen)11), a__2[1] = string; - i__4[2] = 1, a__2[2] = "."; - s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)64); - wrline_(device, ch__2, (ftnlen)255, rtrim_(string, (ftnlen)11) + - 53); - return 0; - } - -/* We're OK, so get the name or not available. */ - - if (*index <= 100) { - s_copy(name__, frozen + (((i__1 = *index - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("frozen", i__1, "trcpkg_", (ftnlen)1868)) - << 5), name_len, (ftnlen)32); - } else { - s_copy(name__, "", name_len, (ftnlen) - 28); - } - } else { - -/* Otherwise, use current traceback: */ - -/* Check the input index. It must be positive and less than the */ -/* current stack depth. */ - - if (*index <= 0 || *index > modcnt + ovrflw) { - -/* Invalid index...we output the error messages directly */ -/* in this case: */ - - getdev_(device, (ftnlen)255); - wrline_(device, "SPICE(INVALIDINDEX)", (ftnlen)255, (ftnlen)19); - intstr_(index, string, (ftnlen)11); -/* Writing concatenation */ - i__4[0] = 52, a__2[0] = "TRCNAM: An invalid index was input. Th" - "e value was: "; - i__4[1] = rtrim_(string, (ftnlen)11), a__2[1] = string; - i__4[2] = 1, a__2[2] = "."; - s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)64); - wrline_(device, ch__2, (ftnlen)255, rtrim_(string, (ftnlen)11) + - 53); - return 0; - } - -/* We're OK, so get the name or name not available. */ - - if (*index <= 100) { - s_copy(name__, stack + (((i__1 = *index - 1) < 100 && 0 <= i__1 ? - i__1 : s_rnge("stack", i__1, "trcpkg_", (ftnlen)1898)) << - 5), name_len, (ftnlen)32); - } else { - s_copy(name__, "", name_len, (ftnlen) - 28); - } - } - return 0; -/* $Procedure QCKTRC ( Get Quick Traceback ) */ - -L_qcktrc: -/* $ Abstract */ - -/* Return a string containing a traceback. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) TRACE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* TRACE O A traceback report. */ -/* NAMLEN P Maximum module name length. */ -/* FILEN P Maximum file name length. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* TRACE is a list of module names, delimited by the */ -/* string, ' -->'. An example would be */ - -/* 'SPUD -->SPAM -->FOOBAR'. */ - -/* In general, the meaning of the trace is as */ -/* follows: */ - -/* The first name in the list is the name of the first */ -/* module to check in (that hasn't yet checked out). */ -/* The last name is the name of the module at the end */ -/* of the call chain; this is the last module that */ -/* checked in. */ - -/* The meaning of the traceback depends on the state */ -/* of the error handling mechanism. There are two */ -/* cases: */ - -/* 1. In 'RETURN' mode, when an error is */ -/* signalled, the traceback at that point is */ -/* saved. TRCDEP, TRCNAM, and QCKTRC will */ -/* return values pertaining to the saved */ -/* traceback. */ - -/* 2. In all other modes, the traceback represents */ -/* the CURRENT call chain. TRCDEP, TRCNAM, */ -/* and QCKTRC will return values pertaining to */ -/* the current trace representation. */ - -/* Any module names exceeding NAMLEN characters in */ -/* length are truncated on the right. */ - -/* $ Parameters */ - -/* FILEN is the maximum file name length that can be */ -/* accommodated by this routine. */ - -/* NAMLEN is the maximum module name length that can be */ -/* accommodated by this routine. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is part of the SPICELIB error handling mechanism. */ - -/* $ Examples */ - -/* 1) Here's an example of how to use this routine: */ - -/* C */ -/* C We call RDTEXT and test for an error condition. */ -/* C If an error occurred, we get the traceback and */ -/* C long error message and output them using the */ -/* C user-defined routine, USER_ERROR. */ -/* C */ - -/* CALL RDTEXT ( FILE, LINE, EOF ) */ - -/* IF ( FAILED() ) THEN */ - -/* CALL QCKTRC ( TRACE ) */ -/* CALL USER_ERROR ( TRACE ) */ - -/* CALL GETMSG ( 'LONG', MSG ) */ -/* CALL USER_ERROR ( MSG ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* It is assumed no module names exceed NAMLEN characters in length. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 1.2.0, 23-OCT-1992 (NJB) */ - -/* Bug fix made to routine QCKTRC: a section of code which */ -/* itself is exercised only if a bug is present inserted the */ -/* wrong variable into an error message. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 15-JUN-1990 (NJB) */ - -/* Error messages streamlined. Some comments updated. */ -/* Some cosmetic changes too. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get quick traceback */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* The error action mechanism has been changed as well. GETACT */ -/* now uses an integer code rather than a short character */ -/* string to represent the error action. The entry points affected */ -/* by this change are: TRCDEP, TRCNAM, QCKTRC. */ - -/* - SPICELIB Version 1.2.0, 23-OCT-1992 (NJB) */ - -/* Bug fix made to routine QCKTRC: a section of code which */ -/* itself is exercised only if a bug is present inserted the */ -/* wrong variable into an error message. The variable in */ -/* question was the input argument INDEX; the correct variable */ -/* to insert in the message is the local variable POS. */ - -/* - SPICELIB Version 1.1.0, 15-JUN-1990 (NJB) */ - -/* Error messages streamlined. Some comments updated. */ -/* Some cosmetic changes too. Use of SUFFIX made more */ -/* rational. */ - -/* - Beta Version 1.1.1, 10-FEB-1988 (NJB) */ - -/* Parameter declarations documented. Parameters section added, */ -/* and parameter declarations listed in `Brief I/O'. */ - -/* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */ - -/* Added test for failure to remove name from trace */ -/* representation. If LOC equals 0 on return from */ -/* NTHWD, the error SPICE(INVALIDINDEX) is reported. */ -/* SIGERR is not called; that would be overly recursive. */ - -/* Also, some cosmetic changes to code were made. Some */ -/* unnecessary continuation lines were removed. */ -/* -& */ - -/* Be sure that the output string is empty. */ - - s_copy(trace, " ", trace_len, (ftnlen)1); - -/* Get the error handling mode. */ - - getact_(&action); - -/* If we're in 'RETURN' mode, and an error has occurred, we want to */ -/* use the frozen version of the traceback. Otherwise, we want to */ -/* use the current traceback. */ - - if (action == 3 && failed_()) { - i__1 = frzcnt; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ > 1) { - suffix_("-->", &c__1, trace, (ftnlen)3, trace_len); - suffix_(frozen + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("frozen", i__2, "trcpkg_", (ftnlen)2190)) << - 5), &c__1, trace, (ftnlen)32, trace_len); - } else { - suffix_(frozen + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("frozen", i__2, "trcpkg_", (ftnlen)2192)) << - 5), &c__0, trace, (ftnlen)32, trace_len); - } - } - if (frzovr > 0) { - suffix_("-->", &c__1, trace, (ftnlen)3, trace_len); - if (frzovr > 1) { - intstr_(&frzovr, string, (ftnlen)11); - suffix_("<", &c__1, trace, (ftnlen)1, trace_len); - suffix_(string, &c__0, trace, (ftnlen)11, trace_len); - suffix_("Names Overflowed>", &c__1, trace, (ftnlen)17, - trace_len); - } else { - suffix_("", &c__1, trace, (ftnlen)21, - trace_len); - } - } - } else { - i__1 = modcnt; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ > 1) { - suffix_("-->", &c__1, trace, (ftnlen)3, trace_len); - suffix_(stack + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("stack", i__2, "trcpkg_", (ftnlen)2217)) << 5) - , &c__1, trace, (ftnlen)32, trace_len); - } else { - suffix_(stack + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("stack", i__2, "trcpkg_", (ftnlen)2219)) << 5) - , &c__0, trace, (ftnlen)32, trace_len); - } - } - if (ovrflw > 0) { - suffix_("-->", &c__1, trace, (ftnlen)3, trace_len); - if (ovrflw > 1) { - intstr_(&ovrflw, string, (ftnlen)11); - suffix_("<", &c__1, trace, (ftnlen)1, trace_len); - suffix_(string, &c__0, trace, (ftnlen)11, trace_len); - suffix_("Names Overflowed>", &c__1, trace, (ftnlen)17, - trace_len); - } else { - suffix_("", &c__1, trace, (ftnlen)21, - trace_len); - } - } - } - return 0; -/* $Procedure FREEZE ( Get frozen copy of traceback ) */ - -L_freeze: -/* $ Abstract */ - -/* Make a copy of the current traceback. This copy is frozen, i.e. */ -/* unchanged, until the next call to FREEZE. DO NOT CALL THIS */ -/* ROUTINE. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* DO NOT CALL THIS ROUTINE. */ - -/* When the error response action is 'RETURN', and an error is */ -/* signalled, a copy of the traceback is saved for later retrieval */ -/* by the application program. This is called the `frozen' version */ -/* of the traceback. FREEZE is used to create this frozen version. */ - -/* This routine is called by the SPICELIB routines SIGERR and RESET. */ - -/* $ Examples */ - -/* 1) */ -/* C */ -/* C Create a frozen traceback: */ -/* C */ -/* CALL FREEZE */ - -/* $ Restrictions */ - -/* For SPICELIB error handling only. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 15-JUN-1990 (NJB) */ - -/* Some comments changed. Cosmetic changes too. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* - SPICELIB Version 1.0.1, 15-JUN-1990 (NJB) */ - -/* Some comments changed. Cosmetic changes too. */ - -/* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ - -/* Warnings added to discourage use of this routine in */ -/* non-error-handling code. */ - -/* -& */ - -/* Create a frozen version of the traceback. To do this, we move */ -/* the current traceback state into the freezer.. */ - - frzcnt = modcnt; - frzovr = ovrflw; - i__1 = modcnt; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(frozen + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "frozen", i__2, "trcpkg_", (ftnlen)2437)) << 5), stack + ((( - i__5 = i__ - 1) < 100 && 0 <= i__5 ? i__5 : s_rnge("stack", - i__5, "trcpkg_", (ftnlen)2437)) << 5), (ftnlen)32, (ftnlen)32) - ; - } - return 0; -/* $Procedure TRCOFF ( Turn tracing off ) */ - -L_trcoff: -/* $ Abstract */ - -/* Disable tracing. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine disables tracing. Checking in or out does not modify */ -/* the current traceback any further after TRCOFF is called. The */ -/* routines TRCNAM, TRCDEP, and QCKTRC will return information */ -/* based on the traceback at the point where TRCOFF is called. */ - -/* Once tracing has been disabled, it cannot be re-enabled. */ - -/* Additionally, TRCOFF blanks out the existing trace, since the */ -/* trace will usually be invalid at the time an error is signalled. */ -/* The frozen copy of the trace, if there is one, is not modified. */ - -/* $ Examples */ - -/* 1) C */ -/* C Program initialization: */ -/* C */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C We disable tracing to enhance speed: */ -/* C */ -/* CALL TRCOFF */ -/* C */ -/* C More initialization code: */ -/* C */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 24-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 12-MAR-1996 (KRG) */ - -/* The structure of this routine has completely changed. A stack, */ -/* implemented as an array of character strings, is now used to */ -/* store subroutine names that use the CHKIN and CHKOUT entry */ -/* points. This change simplified the individual entry points as */ -/* well as speeding up the process of checking in and checking */ -/* out. */ - -/* - 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, 11-JUL-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* turn tracing off */ - -/* -& */ - -/* Indicate that tracing is disabled: */ - - notrc = TRUE_; - -/* The stack depth becomes 0 (it will be referenced if TRCDEP is */ -/* called). The overflow count set to 0 as well, for consistency; */ -/* it will not be referenced again after this code is executed. */ - - modcnt = 0; - ovrflw = 0; - return 0; -} /* trcpkg_ */ - -/* Subroutine */ int trcpkg_(integer *depth, integer *index, char *module, - char *trace, char *name__, ftnlen module_len, ftnlen trace_len, - ftnlen name_len) -{ - return trcpkg_0_(0, depth, index, module, trace, name__, module_len, - trace_len, name_len); - } - -/* Subroutine */ int chkin_(char *module, ftnlen module_len) -{ - return trcpkg_0_(1, (integer *)0, (integer *)0, module, (char *)0, (char * - )0, module_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int chkout_(char *module, ftnlen module_len) -{ - return trcpkg_0_(2, (integer *)0, (integer *)0, module, (char *)0, (char * - )0, module_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int trcdep_(integer *depth) -{ - return trcpkg_0_(3, depth, (integer *)0, (char *)0, (char *)0, (char *)0, - (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int trcmxd_(integer *depth) -{ - return trcpkg_0_(4, depth, (integer *)0, (char *)0, (char *)0, (char *)0, - (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int trcnam_(integer *index, char *name__, ftnlen name_len) -{ - return trcpkg_0_(5, (integer *)0, index, (char *)0, (char *)0, name__, ( - ftnint)0, (ftnint)0, name_len); - } - -/* Subroutine */ int qcktrc_(char *trace, ftnlen trace_len) -{ - return trcpkg_0_(6, (integer *)0, (integer *)0, (char *)0, trace, (char *) - 0, (ftnint)0, trace_len, (ftnint)0); - } - -/* Subroutine */ int freeze_(void) -{ - return trcpkg_0_(7, (integer *)0, (integer *)0, (char *)0, (char *)0, ( - char *)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int trcoff_(void) -{ - return trcpkg_0_(8, (integer *)0, (integer *)0, (char *)0, (char *)0, ( - char *)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/tsetyr_c.c b/ext/spice/src/cspice/tsetyr_c.c deleted file mode 100644 index 71c33648e3..0000000000 --- a/ext/spice/src/cspice/tsetyr_c.c +++ /dev/null @@ -1,177 +0,0 @@ -/* - --Procedure tsetyr_c ( Time --- set year expansion boundaries ) - --Abstract - - Set the lower bound on the 100 year range - --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 - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - void tsetyr_c ( SpiceInt year ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - year I Lower bound on the 100 year interval of expansion - --Detailed_Input - - year is the year associated with the lower bound on all - year expansions computed by texpyr_. For example - if year is 1980, then the range of years that - can be abbreviated is from 1980 to 2079. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error free. - - 1) If year is less than 1 no action is taken - --Particulars - - This routine allows all of the SPICE time subsystem to handle - uniformly the expansion of "abbreviated" years. (i.e. the - remainder after dividing the actual year by 100). The input - supplied to this routine represents the lower bound of the - expansion interval. The upper bound of the expansion interval - is year + 99. - - The default expansion interval is from 1969 to 2068. - - The default behavior is as follows - - year input year Output - ---------- ----------- - 00 2000 - 01 2001 - . . - . . - . . - 67 2067 - 68 2068 - 69 1969 - 70 1970 - . . - . . - . . - 99 1999 - --Examples - - Suppose that you need to manipulate time strings and that - you want to treat years components in the range from 0 to 99 - as being abbreviations for years in the range from - 1980 to 2079 (provided that the years are not modified by - an ERA substring). The code fragment below shows how you - could go about this. - - Early in your application set up the lower bound for the - expansion of abbreviated years. - - tsetyr_c ( 1980 ); - - year input year Output - ---------- ----------- - 00 2000 - 01 2001 - . . - . . - . . - 48 2048 - 49 2049 - . . - . . - . . - 79 2079 - 80 1980 - . . - 99 1999 - - - --Restrictions - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 11-FEB-1998 (EDW) - --Index_Entries - - Set the interval of expansion for abbreviated years - --& -*/ - -{ /* Begin tsetyr_c */ - - - /* Make the call to the f2c'd routine. Not much else. */ - - tsetyr_ ( &year ); - - -} /* End tsetyr_c */ diff --git a/ext/spice/src/cspice/ttrans.c b/ext/spice/src/cspice/ttrans.c deleted file mode 100644 index cb8086f0ce..0000000000 --- a/ext/spice/src/cspice/ttrans.c +++ /dev/null @@ -1,1556 +0,0 @@ -/* ttrans.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2000 = 2000; -static integer c__1 = 1; -static integer c__4 = 4; -static integer c__100 = 100; -static integer c__400 = 400; -static integer c__1991 = 1991; -static integer c__6 = 6; -static integer c__21 = 21; -static integer c__280 = 280; -static integer c__12 = 12; -static integer c__7 = 7; -static doublereal c_b188 = 3600.; -static doublereal c_b189 = 60.; - -/* $Procedure TTRANS ( Time transformation ) */ -/* Subroutine */ int ttrans_(char *from, char *to, doublereal *tvec, ftnlen - from_len, ftnlen to_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer extra[12] = { 0,0,1,1,1,1,1,1,1,1,1,1 }; - static integer dpjan0[12] = { 0,31,59,90,120,151,181,212,243,273,304,334 } - ; - static integer dpbegl[12] = { 0,31,60,91,121,152,182,213,244,274,305,335 } - ; - static logical nodata = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double d_int(doublereal *); - - /* Local variables */ - static doublereal jd1101; - static integer dn2000; - static doublereal dp2000, frac; - static integer nref, week; - static doublereal secs; - static integer year; - static doublereal mins; - static char vars__[32*1]; - static integer qint; - static char rest[32], myto[32]; - static integer i__; - static doublereal halfd; - extern logical elemc_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char recog[8*21]; - static integer fmday; - static doublereal daydp; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - static logical needy[21]; - static integer dyear; - static doublereal tempd; - static logical found; - static integer tempi; - static logical forml[21]; - static integer wkday; - static doublereal tsecs; - static integer dofyr, pfrom, month, dpsun; - static doublereal hours, dt; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static doublereal taitab[280]; - static integer daytab[280]; - extern /* Subroutine */ int rmaind_(doublereal *, doublereal *, - doublereal *, doublereal *); - static doublereal jdsecs, daylen; - static integer parsed[21]; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen); - static doublereal formal, secspd; - static integer ordvec[21]; - static logical update; - static integer doffst, offset; - extern integer lstled_(doublereal *, integer *, doublereal *); - extern /* Subroutine */ int reordc_(integer *, integer *, char *, ftnlen), - reordi_(integer *, integer *, integer *); - static doublereal exsecs, lastdt; - extern integer lstlei_(integer *, integer *, integer *); - static integer daynum, fyrday; - static char unifrm[8*27]; - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen); - static integer refptr, dayptr; - extern doublereal unitim_(doublereal *, char *, char *, ftnlen, ftnlen); - static integer sunday, taiptr; - extern /* Subroutine */ int insrtc_(char *, char *, ftnlen, ftnlen); - static char myfrom[32]; - extern /* Subroutine */ int reordl_(integer *, integer *, logical *); - extern integer lstlti_(integer *, integer *, integer *); - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen), setmsg_(char *, ftnlen), - sigerr_(char *, ftnlen), swpool_(char *, integer *, char *, - ftnlen, ftnlen), chkout_(char *, ftnlen), nextwd_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), rmaini_(integer *, integer *, - integer *, integer *); - static integer yr1, yr4; - extern doublereal j2000_(void); - extern logical odd_(integer *); - static doublereal tai; - static integer day, rem; - extern doublereal spd_(void); - static integer pto, yr100, yr400; - -/* $ Abstract */ - -/* Transform a time vector from one representation and system */ -/* to another. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* PARSING */ -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MXCOMP P maximum number of components allowed for TVEC. */ -/* TO I description of a time vector. */ -/* FROM I description of a time vector. */ -/* TVEC I/O time vector representing an epoch. */ - -/* $ Detailed_Input */ - -/* TVEC is called a time vector. It is an array of double */ -/* precision numbers that represent some epoch. To */ -/* determine its meaning you must examine the string */ -/* FROM. Note that the number of significant entries */ -/* in TVEC is implied by FROM. */ - -/* FROM is a string used to describe the type of time vector */ -/* TO TVEC. FROM is the type of the input vector TVEC */ -/* TO is the type of the output TVEC */ - -/* The interpretation of TVEC is as follows: */ - -/* TYPE Interpretation of TVEC */ -/* ------ ------------------------------------------- */ -/* YMD(F) - year, month, day, hour, minutes, seconds */ -/* YD(F) - year, day-of-year, hour, minutes, seconds */ -/* YD.D(F) - year, number of days past beginning of year */ -/* DAYSEC - calendar days past 1 jan 1 AD, */ -/* seconds past beg day */ -/* DP2000 - calendar days past 1 jan 2000, */ -/* seconds past beg day */ -/* JDUTC - julian date UTC. */ -/* FORMAL - seconds in the formal calendar since J2000. */ -/* YWD(F) - year, week, day, hour, minutes, seconds */ -/* YMWD(F) - year, month, week, day, hour, minutes, */ -/* seconds */ -/* TAI - atomic seconds past Atomic J2000. */ -/* TDT - Terrestrial Dynamical Time */ -/* TDB - Barycentric Dynamical Time */ -/* JED - Julian Ephemeris Date (based on TDB) */ -/* ET - Ephemeris time (same as TDB) */ -/* JDTDB - Julian Date based on TDB (same as JED) */ -/* JDTDT - Julian Date based on TDT */ - -/* The number of components of TVEC implied by TYPE is */ -/* as follows: */ - -/* YMD - 6 */ -/* YD - 5 */ -/* JDUTC - 1 */ -/* FORMAL - 1 */ -/* YD.D - 2 */ -/* DAYSEC - 2 */ -/* DP2000 - 2 */ -/* YWD - 6 */ -/* YMWD - 7 */ -/* TAI - 1 */ -/* TDT - 1 */ -/* TDB - 1 */ -/* JED - 1 */ -/* ET - 1 */ -/* JDTDB - 1 */ -/* JDTDT - 1 */ - - -/* For all types, only the last component of the */ -/* time vector may be non-integer. If other components */ -/* have fractional parts only their truncated integer */ -/* components will be recognized. */ - -/* YMD and YD */ - -/* These types are assumed to be different */ -/* representations on UTC time markers. Thus */ -/* the hour, minutes and seconds portions all */ -/* represent time elapsed */ -/* since the beginning of a day. As such the */ -/* seconds portion of HMS may range up to (but */ -/* not include) 61 on days when positive leap */ -/* seconds occur and may range up to (but not */ -/* include) 59 on days during which negative */ -/* leapseconds occur. */ - -/* YD.D type. */ - -/* Y is the calendar year used in civil time keeping */ -/* D is the day of the calendar year --- for any time */ -/* during the first of January, the integer portion */ -/* of the day will be 1. */ - -/* The fractional portion is the fractional part of */ -/* the specific day. Thus the amount of time */ -/* specified by the fractional portion of the day */ -/* depends upon whether or not the day has a leap */ -/* second. ".D" can be computed from the formula */ - -/* number of seconds past beginning of day */ -/* .D = --------------------------------------- */ -/* number of UTC seconds in the day. */ - -/* FORMAL type. */ - -/* The FORMAL type for TVEC gives the number of */ -/* seconds past the epoch J2000 (noon Jan 1 2000) */ -/* on the formal calendar (no leap seconds --- */ -/* all days contain 86400 seconds) The formal clock */ -/* is simply held still for one second during */ -/* positive leap seconds. Times during leap seconds */ -/* cannot be represented in this system. */ - -/* This system is converted internally to a */ -/* calendar days past epoch and seconds */ -/* past beginning of day form. For this reason, */ -/* times that occur during a positive leap second */ -/* can never be represented. Moreover, if a negative */ -/* leapsecond occurs, times that occur during the */ -/* ``missing'' leapsecond will simply be placed */ -/* at the beginning of the next day. Thus two */ -/* different FORMAL times can represent the */ -/* same time around a negative leap second. */ - -/* FORMAL time is equivalent to somewhat parochial */ -/* ``UTC seconds past J2000'' that is produced */ -/* by the SPICE routine TPARSE. */ - -/* JDUTC type. */ - -/* This system is similar to the FORMAL system */ -/* described above. All days are assumed to have */ -/* 86400 seconds. All numbers of the form */ - -/* integer + 0.5 */ - -/* fall at the beginning of calendar UTC days. */ - -/* There is no way to represent times during a */ -/* positive leapsecond. Times during missing */ -/* negative leap seconds are represented in two ways. */ - -/* DAYSEC type. */ - -/* This time vector has the form of calendar */ -/* days since January 1, of the year 1 A.D. */ -/* and number of seconds past the beginning of the */ -/* calendar day. */ -/* (January 2 of the year 1 A.D. is 1 calendar */ -/* day past January 1, 1 A.D.) */ - -/* DP2000 type. */ - -/* This time vector has the same form as DAYSEC */ -/* time vectors. The only difference is that */ -/* the reference epoch is JAN 1, 2000. */ - -/* YWD and YMWD types. */ - -/* These time vectors are used to specify a time */ -/* that are most conveniently expressed by phrases */ -/* such as ``the third Monday of every month'' or */ -/* ``Beginning with the second Wednesday of the new */ -/* year and every 4th Wednesday thereafter.'' */ - -/* The hours, minutes and seconds components of */ -/* these time vectors are the */ -/* same as for the Year-Month-Day and Year-Day UTC */ -/* time vectors. */ - -/* The Y component refers to the calendar year, and */ -/* in the YMWD vector, the M component refers to */ -/* the calendar month. */ - -/* The W component refers to the week of the */ -/* Year (YWD) or Month (YMWD). The first week */ -/* begins on the first day of the year or the first */ -/* day of the month. The D component is the day of the */ -/* week with 1 corresponding to Sunday, 2 to Monday, */ -/* and so on with 7 corresponding to Saturday. */ - -/* Thus the YMWD time vector */ - -/* 1991 */ -/* 11 */ -/* 3 */ -/* 5 */ -/* 12 */ -/* 0 */ -/* 0 */ - -/* refers to 12:00:00 on the third Thursday of */ -/* November of 1991. */ - -/* The YWD time vector */ - -/* 1997 */ -/* 11 */ -/* 4 */ -/* 13 */ -/* 5 */ -/* 11 */ - -/* refers to 12:05:11 on the eleventh Wednesday */ -/* of 1997. */ - -/* Formal Calendar Time Vectors */ -/* ============================ */ -/* The types YMDF, YDF, YD.D(F), YWDF, YMWDF are similar */ -/* to the corresponding base types: YMD, YD, YD.D, YWD */ -/* and YMWD. However, these types represent formal */ -/* time vectors. Each day contains exactly 86400 seconds. */ -/* The difference between formal and non-formal systems */ -/* can only be seen during a positive leapsecond or */ -/* during the second following a negative leapsecond. */ - -/* Epochs during a positive leapsecond on input are */ -/* placed in the first second of the next day. Epochs */ -/* during a positive leapsecond on output are held */ -/* at 00:00:00 of the next day. */ - -/* Epochs during the first second following a negative */ -/* leapsecond are counted as belonging to the previous */ -/* day if both the input and output types are formal */ -/* types. */ - - -/* Calendars */ -/* ===================== */ -/* In all time vectors for which a year is specified, */ -/* the year is assumed to belong to the Gregorian */ -/* Calendar---every 4th year is a leapyear except */ -/* for centuries (such as 1900) that are not divisible */ -/* by 400. This calendar is formally extended */ -/* indefinitely backward and forward in time. */ - -/* Note that the Gregorian Calendar did not */ -/* formally exist prior to October 15, 1582. Prior to */ -/* that time the Julian Calendar was used (in the */ -/* Julian Calendar every 4th year is a leapyear, including */ -/* all centuries). */ - -/* If you have epochs relative to the Julian calendar, */ -/* the SPICE routine JUL2GR is available for converting */ -/* to the formal Gregorian Calendar. */ - - -/* Epochs Prior to 1972 */ -/* ===================== */ -/* UTC as it exists today, was adopted in 1972. For */ -/* epochs prior to 1972, it is assumed that the difference */ -/* between TAI and UTC is a constant value. */ - -/* Years prior to 1 A.D. */ -/* ===================== */ -/* A year belonging to the B.C. era, may be */ -/* represented by subtracting the year from 1. */ -/* Thus to specify 27 B.C (Gregorian) set the */ -/* year component of the time vector to -26. */ - - -/* Notes: */ -/* ====== */ -/* The FORMAL and JDUTC types should not be used */ -/* for times near a leap second. However, for times */ -/* removed from leap seconds they pose no problems. */ - -/* The DAYSEC and DP2000 are useful for representing */ -/* times that are given in atomic seconds past some */ -/* reference epoch other than J2000. */ - -/* $ Detailed_Output */ - -/* TVEC is the time vector corresponding to the input */ -/* time vector but with components consistent with */ -/* the type specified by input variable TO. */ - -/* $ Parameters */ - -/* MXCOMP is the maximum number of components that can appear in */ -/* TVEC. */ - -/* $ Exceptions */ - -/* 1) If the type of either FROM or TO is not recognized the */ -/* error 'SPICE(UNKNONWNTIMESYSTEM)' is signalled. */ - -/* 2) If a leapseconds kernel has not been loaded prior a call */ -/* to TTRANS the error 'SPICE(NOLEAPSECONDS)' is signalled. */ - -/* 3) If epochs associated with leapseconds in the leapseconds */ -/* kernel are not in increasing order, the error */ -/* 'SPICE(BADLEAPSECONDS)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is the fundamental translator between various */ -/* representations of time in the SPICE system. However, it */ -/* is intended to be a mid-level routine that few user's should */ -/* have need of calling. */ - -/* In addition to translating between time systems, this routine */ -/* can be used to normalize the components of a time string */ -/* so that they are in the normal range for a particular */ -/* representation. This allows you to easily do arithmetic */ -/* with epochs. */ - -/* $ Examples */ - -/* Suppose you need to convert a time expressed as seconds */ -/* past J2000 (TDB) to Pacific Daylight time. The following */ -/* example shows how you might use TTRANS to accomplish this */ -/* task. */ - -/* TVEC(1) = ET */ - -/* CALL TTRANS ( 'TDB', 'YMD', TVEC ) */ - -/* The seconds component of PDT is the same as the seconds */ -/* component of UTC. We save and add the UTC-PDT offset */ -/* to the hours and minutes component of the time vector. */ - -/* SECNDS = TVEC(6) */ -/* TVEC(6) = 0.0D0 */ - -/* TVEC(4) = TVEC(4) - 7.0D0 */ -/* TVEC(5) = TVEC(5) + 0.0D0 */ - -/* CALL TTRANS ( 'YMDF', 'YMDF', TVEC ) */ - -/* Now reset the seconds component to the original value */ -/* and pass the time vector to some formatting routine. */ - -/* TVEC(6) = SECNDS */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.4.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to this routine. */ - -/* - SPICELIB Version 1.3.0, 15-NOV-2006 (NJB) */ - -/* A reference to RTPOOL was replaced by a reference */ -/* to GDPOOL. */ - -/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAIND and RMAINI calls. Changed reference to LDPOOL to */ -/* reference to FURNSH in an error message. */ - -/* - SPICELIB Version 1.1.0, 9-JUN-1999 (WLT) */ - -/* The routine was modified so that uniform time system */ -/* transformations (see UNITIM) are handled without */ -/* performing intermediate computations. This gives a slight */ -/* improvement in the accuracy of some computations. */ - -/* In addition, two unused variables were removed. */ - -/* - Spicelib Version 1.0.0, 17-SEP-1996 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Convert from one time vector to another */ -/* Convert between various parsed time representations */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in RMAIND and RMAINI calls. Changed reference to LDPOOL to */ -/* reference to FURNSH in an error message. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local (in-line) functions */ - - -/* Local parameters */ - - -/* Parameters */ - -/* We declare the variables that contain the number of days in */ -/* 400 years, 100 years, 4 years and 1 year. */ - - -/* The following integers give the number of days during the */ -/* associated month of a non-leap year. */ - - -/* The integers that follow give the number of days in a normal */ -/* year that precede the first of the month. */ - - -/* The integers that follow give the number of days in a leap */ -/* year that precede the first of the month. */ - - -/* MAXLP is the maximum number of leap seconds that can be */ -/* stored internally. The value of 140 should be sufficient */ -/* to store leap seconds through the year 2100. */ - - -/* MAXVAR is the number of kernel pool variables required by this */ -/* routine. */ - - - -/* The following gives us an "enumeration" for all of the */ -/* various types of time vectors that are recognized. */ - -/* DAYSEC */ -/* DAYP2 */ -/* ET */ -/* FRML */ -/* JDTDB */ -/* JDTDT */ -/* JDUTC */ -/* JED */ -/* TAI */ -/* TDB */ -/* TDT */ -/* YD */ -/* YDD */ -/* YDDF */ -/* YDF */ -/* YMD */ -/* YMDF */ -/* YMWD */ -/* YMWDF */ -/* YWD */ -/* YWDF */ - - -/* The following parameters just make the code seem a bit */ -/* more natural. */ - - -/* Local variables */ - - -/* The array EXTRA contains the number of many additional days that */ -/* appear before the first of a month during a leap year (as opposed */ -/* to a non-leap year). */ - - -/* DPJAN0(I) gives the number of days that occur before the I'th */ -/* month of a normal year. */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Definitions of statment functions. */ - -/* The number of days elapsed since Jan 1, of year 1 A.D. to */ -/* Jan 1 of YEAR is given by: */ - - -/* Return 1 if YEAR is divisible by N, otherwise return 0. */ - - -/* The number of leap days in a year is given by: */ - - -/* To compute the day of the year we */ - -/* look up the number of days to the beginning of the month, */ - -/* add on the number leap days that occurred prior to that */ -/* time */ - -/* add on the number of days into the month */ - - -/* The number of days since 1 Jan 1 A.D. is given by: */ - - -/* The number of seconds represented by HOURS hours MINS minutes */ -/* and SECS seconds. */ - - if (return_()) { - return 0; - } else { - chkin_("TTRANS", (ftnlen)6); - } - -/* The first time any of the entry points are called we */ -/* must set up the "watcher" for the kernel pool variables */ -/* that will be needed by this routine. */ - - if (first) { - first = FALSE_; - secspd = spd_(); - halfd = spd_() / 2.; -/* Computing MAX */ - i__3 = 0, i__4 = abs(c__2000) / c__4 * c__4 + 1 - abs(c__2000); -/* Computing MAX */ - i__5 = 0, i__6 = abs(c__2000) / c__100 * c__100 + 1 - abs(c__2000); -/* Computing MAX */ - i__7 = 0, i__8 = abs(c__2000) / c__400 * c__400 + 1 - abs(c__2000); - dn2000 = (c__2000 - 1) * 365 + (c__2000 - 1) / 4 - (c__2000 - 1) / - 100 + (c__2000 - 1) / 400 + (dpjan0[(i__1 = c__1 - 1) < 12 && - 0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen) - 937)] + extra[(i__2 = c__1 - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("extra", i__2, "ttrans_", (ftnlen)937)] * (max(i__3, - i__4) - max(i__5,i__6) + max(i__7,i__8)) + c__1) - 1; -/* Computing MAX */ - i__3 = 0, i__4 = abs(c__1991) / c__4 * c__4 + 1 - abs(c__1991); -/* Computing MAX */ - i__5 = 0, i__6 = abs(c__1991) / c__100 * c__100 + 1 - abs(c__1991); -/* Computing MAX */ - i__7 = 0, i__8 = abs(c__1991) / c__400 * c__400 + 1 - abs(c__1991); - sunday = (c__1991 - 1) * 365 + (c__1991 - 1) / 4 - (c__1991 - 1) / - 100 + (c__1991 - 1) / 400 + (dpjan0[(i__1 = c__1 - 1) < 12 && - 0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen) - 938)] + extra[(i__2 = c__1 - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("extra", i__2, "ttrans_", (ftnlen)938)] * (max(i__3, - i__4) - max(i__5,i__6) + max(i__7,i__8)) + c__6) - 1; - jd1101 = j2000_() - (doublereal) dn2000 - .5; - -/* Initialize the list of Uniform time systems. */ - - ssizec_(&c__21, unifrm, (ftnlen)8); - -/* Set up the set of recognized time vectors. */ - -/* The following 4 parallel arrays are here */ -/* to assist in the task of classifying the */ -/* FROM and TO time representations. The arrays */ -/* contain: */ - -/* RECOG the strings that are recognized as legitimate */ -/* time representations */ - -/* PARSED a unique integer that can be used to stand */ -/* for each recognized format. This is used */ -/* in the various IF THEN blocks to decide */ -/* how a time vector should be processed instead */ -/* of the name because integer compares are */ -/* much faster than string comparisons. */ - -/* FORML is a logical that indicates whether or not the */ -/* corresponding time system is a formal system */ -/* or UTC based system. FORML(I) = YES implies */ -/* the time system is formal. FORML(I) means it */ -/* isn't. */ - -/* NEEDY is a logical that indicates whether or not */ -/* there is a YEAR in the time system. It should */ -/* be read "NEED Y" for "need year" not "needy" */ -/* as when you are destitute. NEEDY(I) = YES means */ -/* the time system has a year. NEEDY(I) = NO means */ -/* it doesn't */ - - s_copy(recog, "DAYSEC ", (ftnlen)8, (ftnlen)7); - parsed[0] = 1; - forml[0] = FALSE_; - needy[0] = FALSE_; - s_copy(recog + 8, "DP2000 ", (ftnlen)8, (ftnlen)7); - parsed[1] = 2; - forml[1] = FALSE_; - needy[1] = FALSE_; - s_copy(recog + 16, "ET ", (ftnlen)8, (ftnlen)3); - parsed[2] = 3; - forml[2] = FALSE_; - needy[2] = FALSE_; - insrtc_("ET", unifrm, (ftnlen)2, (ftnlen)8); - s_copy(recog + 24, "FORMAL ", (ftnlen)8, (ftnlen)7); - parsed[3] = 4; - forml[3] = TRUE_; - needy[3] = FALSE_; - s_copy(recog + 32, "JDTDB ", (ftnlen)8, (ftnlen)6); - parsed[4] = 5; - forml[4] = FALSE_; - needy[4] = FALSE_; - insrtc_("JDTDB", unifrm, (ftnlen)5, (ftnlen)8); - s_copy(recog + 40, "JDTDT ", (ftnlen)8, (ftnlen)6); - parsed[5] = 6; - forml[5] = FALSE_; - needy[5] = FALSE_; - insrtc_("JDTDT", unifrm, (ftnlen)5, (ftnlen)8); - s_copy(recog + 48, "JDUTC ", (ftnlen)8, (ftnlen)6); - parsed[6] = 7; - forml[6] = TRUE_; - needy[6] = FALSE_; - s_copy(recog + 56, "JED ", (ftnlen)8, (ftnlen)4); - parsed[7] = 8; - forml[7] = FALSE_; - needy[7] = FALSE_; - insrtc_("JED", unifrm, (ftnlen)3, (ftnlen)8); - s_copy(recog + 64, "TAI ", (ftnlen)8, (ftnlen)4); - parsed[8] = 9; - forml[8] = FALSE_; - needy[8] = FALSE_; - insrtc_("TAI", unifrm, (ftnlen)3, (ftnlen)8); - s_copy(recog + 72, "TDB ", (ftnlen)8, (ftnlen)4); - parsed[9] = 10; - forml[9] = FALSE_; - needy[9] = FALSE_; - insrtc_("TDB", unifrm, (ftnlen)3, (ftnlen)8); - s_copy(recog + 80, "TDT ", (ftnlen)8, (ftnlen)4); - parsed[10] = 11; - forml[10] = FALSE_; - needy[10] = FALSE_; - insrtc_("TDT", unifrm, (ftnlen)3, (ftnlen)8); - s_copy(recog + 88, "YD ", (ftnlen)8, (ftnlen)3); - parsed[11] = 12; - forml[11] = FALSE_; - needy[11] = TRUE_; - s_copy(recog + 96, "YD.D ", (ftnlen)8, (ftnlen)5); - parsed[12] = 13; - forml[12] = FALSE_; - needy[12] = TRUE_; - s_copy(recog + 104, "YD.DF ", (ftnlen)8, (ftnlen)6); - parsed[13] = 14; - forml[13] = TRUE_; - needy[13] = TRUE_; - s_copy(recog + 112, "YDF ", (ftnlen)8, (ftnlen)4); - parsed[14] = 15; - forml[14] = TRUE_; - needy[14] = TRUE_; - s_copy(recog + 120, "YMD ", (ftnlen)8, (ftnlen)4); - parsed[15] = 16; - forml[15] = FALSE_; - needy[15] = TRUE_; - s_copy(recog + 128, "YMDF ", (ftnlen)8, (ftnlen)5); - parsed[16] = 17; - forml[16] = TRUE_; - needy[16] = TRUE_; - s_copy(recog + 136, "YMWD ", (ftnlen)8, (ftnlen)5); - parsed[17] = 18; - forml[17] = FALSE_; - needy[17] = TRUE_; - s_copy(recog + 144, "YMWDF ", (ftnlen)8, (ftnlen)6); - parsed[18] = 19; - forml[18] = TRUE_; - needy[18] = TRUE_; - s_copy(recog + 152, "YWD ", (ftnlen)8, (ftnlen)4); - parsed[19] = 20; - forml[19] = FALSE_; - needy[19] = TRUE_; - s_copy(recog + 160, "YWDF ", (ftnlen)8, (ftnlen)5); - parsed[20] = 21; - forml[20] = TRUE_; - needy[20] = TRUE_; - orderc_(recog, &c__21, ordvec, (ftnlen)8); - reordc_(ordvec, &c__21, recog, (ftnlen)8); - reordi_(ordvec, &c__21, parsed); - reordl_(ordvec, &c__21, forml); - reordl_(ordvec, &c__21, needy); - -/* Set up the kernel pool watchers */ - - s_copy(vars__, "DELTET/DELTA_AT", (ftnlen)32, (ftnlen)15); - swpool_("TTRANS", &c__1, vars__, (ftnlen)6, (ftnlen)32); - } - -/* Check to see if any of the kernel items required by this */ -/* routine have been updated since the last call to this */ -/* entry point. */ - - cvpool_("TTRANS", &update, (ftnlen)6); - if (update || nodata) { - -/* We load the TAI-UTC offsets and formal leapsecond epochs */ -/* into the TAITAB. (We will modify this array in a minute). */ - - gdpool_("DELTET/DELTA_AT", &c__1, &c__280, &nref, taitab, &found, ( - ftnlen)15); - -/* Make sure all of the requested data was there. */ - - if (! found) { - nodata = TRUE_; - setmsg_("The variable that points to the leapseconds (DELTET/DEL" - "TA_AT) could not be located in the kernel pool. It is l" - "ikely that the leapseconds kernel has not been loaded vi" - "a the routine FURNSH.", (ftnlen)188); - sigerr_("SPICE(NOLEAPSECONDS)", (ftnlen)20); - chkout_("TTRANS", (ftnlen)6); - return 0; - } - -/* Transform the TAITAB in place to give the TAI time tag */ -/* at the beginning of the UTC day in which a leap */ -/* second occurred and the TAI time tag at the beginning */ -/* of the next day. Pictorially, the table is transformed */ - -/* +----------------------+ +-------------------+ */ -/* | DELTA_1 (TAI to UTC) | | TAI at start of | */ -/* | | | day before TAI-UTC| */ -/* | | | change occurred | */ -/* +----------------------+ +-------------------+ */ -/* from: | First Formal time | to: | TAI time at start | */ -/* | associated with | | of next day UTC. | */ -/* | DELTA_1 | | after DELTA_1 jump| */ -/* +----------------------+ +-------------------+ */ -/* | DELTA_2 (TAI to UTC) | | TAI at start of | */ -/* | | | day before TAI-UTC| */ -/* | | | jump occurred | */ -/* +----------------------+ +-------------------+ */ -/* | First Formal time | | TAI time at start | */ -/* | associated with | | of next day UTC. | */ -/* | DELTA_2 | | after DELTA_2 jump| */ -/* +----------------------+ +-------------------+ */ -/* . . */ -/* . . */ -/* . . */ - - -/* At the same time, load the table DAYTAB. It contains the */ -/* the day number past 1 Jan 1 AD for the beginning of the */ -/* days loaded in TAITAB. */ - - lastdt = taitab[0] - 1.; - i__1 = nref; - for (i__ = 1; i__ <= i__1; i__ += 2) { - offset = i__; - refptr = i__ + 1; - dt = taitab[(i__2 = offset - 1) < 280 && 0 <= i__2 ? i__2 : - s_rnge("taitab", i__2, "ttrans_", (ftnlen)1185)]; - formal = taitab[(i__2 = refptr - 1) < 280 && 0 <= i__2 ? i__2 : - s_rnge("taitab", i__2, "ttrans_", (ftnlen)1186)]; - taitab[(i__2 = offset - 1) < 280 && 0 <= i__2 ? i__2 : s_rnge( - "taitab", i__2, "ttrans_", (ftnlen)1187)] = formal - - secspd + lastdt; - taitab[(i__2 = refptr - 1) < 280 && 0 <= i__2 ? i__2 : s_rnge( - "taitab", i__2, "ttrans_", (ftnlen)1188)] = formal + dt; - daynum = (integer) ((formal + halfd) / secspd) + dn2000; - daytab[(i__2 = offset - 1) < 280 && 0 <= i__2 ? i__2 : s_rnge( - "daytab", i__2, "ttrans_", (ftnlen)1193)] = daynum - 1; - daytab[(i__2 = refptr - 1) < 280 && 0 <= i__2 ? i__2 : s_rnge( - "daytab", i__2, "ttrans_", (ftnlen)1194)] = daynum; - lastdt = dt; - } - -/* Since we don't have to do it very often, make sure the */ -/* times in the TAI table are in increasing order. */ - - i__1 = nref; - for (i__ = 2; i__ <= i__1; ++i__) { - nodata = TRUE_; - if (taitab[(i__2 = i__ - 2) < 280 && 0 <= i__2 ? i__2 : s_rnge( - "taitab", i__2, "ttrans_", (ftnlen)1208)] >= taitab[(i__3 - = i__ - 1) < 280 && 0 <= i__3 ? i__3 : s_rnge("taitab", - i__3, "ttrans_", (ftnlen)1208)]) { - setmsg_("Either the leapsecond epochs taken from the kernel " - "pool are not properly ordered or the UTC - TAI offse" - "ts are completely out of range. ", (ftnlen)135); - sigerr_("SPICE(BADLEAPSECONDS)", (ftnlen)21); - chkout_("TTRANS", (ftnlen)6); - return 0; - } - } - -/* At this point, we've completed all checks on kernel data. */ - - nodata = FALSE_; - } - -/* Make local normalized copies of FROM and TO. */ - - nextwd_(from, myfrom, rest, from_len, (ftnlen)32, (ftnlen)32); - nextwd_(to, myto, rest, to_len, (ftnlen)32, (ftnlen)32); - ucase_(myfrom, myfrom, (ftnlen)32, (ftnlen)32); - ucase_(myto, myto, (ftnlen)32, (ftnlen)32); - -/* Make sure that the FROM and TO are recognized time types. */ - - pto = bsrchc_(myto, &c__21, recog, (ftnlen)32, (ftnlen)8); - pfrom = bsrchc_(myfrom, &c__21, recog, (ftnlen)32, (ftnlen)8); - -/* Eventually, we need to handle SCLKs. When that happens */ -/* we will do it here and in a similarly marked spot at */ -/* the end of this routine. First see if we know how to */ -/* handle the FROM system. */ - -/* IF ( PFROM .EQ. 0 ) THEN */ - -/* CALL ISSCLK ( FROM,ERROR, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ -/* IF ( ERROR .NE. ' ' ) THEN */ -/* CALL SETMSG ( ERROR ) */ -/* CALL SIGERR ( 'SPICE(TIMESYSTEMPROBLEM)' ) */ -/* CALL CHKOUT ( 'TTRANS' ) */ -/* RETURN */ -/* END IF */ -/* ELSE */ -/* CALL SCLKTV ( FROM, TVEC ) */ -/* PFROM = TDB */ -/* END IF */ - -/* END IF */ - -/* Now check to see if we know how to handle the TO system. */ - -/* IF ( PTO .EQ. 0 ) THEN */ - -/* CALL ISSCLK ( TO, ERROR, FOUND ) */ - -/* IF ( .NOT. FOUND ) THEN */ - -/* IF ( ERROR .NE. ' ' ) THEN */ -/* CALL SETMSG ( ERROR ) */ -/* CALL SIGERR ( 'SPICE(TIMESYSTEMPROBLEM)' ) */ -/* CALL CHKOUT ( 'TTRANS' ) */ -/* END IF */ - -/* ELSE */ - -/* MKSCLK = .TRUE. */ -/* PTO = TDB */ - -/* END IF */ - -/* END IF */ - - -/* For now we are NOT going to deal with SCLK so if something */ -/* isn't recognized, we can just signal an error and quit. */ - - if (pfrom == 0) { - setmsg_("The FROM time representation '#' is not recognized. ", ( - ftnlen)52); - errch_("#", from, (ftnlen)1, from_len); - sigerr_("SPICE(UNKNONWNTIMESYSTEM)", (ftnlen)25); - chkout_("TTRANS", (ftnlen)6); - return 0; - } else if (pto == 0) { - setmsg_("The TO time representation '#' is not recognized. ", (ftnlen) - 50); - errch_("#", from, (ftnlen)1, from_len); - sigerr_("SPICE(UNKNONWNTIMESYSTEM)", (ftnlen)25); - chkout_("TTRANS", (ftnlen)6); - return 0; - } - -/* OK. We have made our last attempt at diagnosing a user error. */ -/* From this point on we assume that the user input exactly what */ -/* was intended. */ - -/* We convert the time vector to days past 1 jan 01 and seconds */ -/* past the beginning of the day. None of the cases below */ -/* are particularly tricky. There's just a lot of cases. */ - - if (pfrom == 16 || pfrom == 17) { - year = (integer) tvec[0]; - month = (integer) tvec[1]; - day = (integer) tvec[2]; - i__1 = month - 1; - rmaini_(&i__1, &c__12, &dyear, &month); - year += dyear; - ++month; - doffst = 0; - if (year <= 0) { - rmaini_(&year, &c__400, &yr400, &tempi); - year = tempi; - if (year == 0) { - year += 400; - --yr400; - } - doffst = yr400 * 146097; - } -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__7 = 0, i__8 = abs(year) / c__400 * c__400 + 1 - abs(year); - daynum = (year - 1) * 365 + (year - 1) / 4 - (year - 1) / 100 + (year - - 1) / 400 + (dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen)1347)] + - extra[(i__2 = month - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge( - "extra", i__2, "ttrans_", (ftnlen)1347)] * (max(i__3,i__4) - - max(i__5,i__6) + max(i__7,i__8)) + day) - 1 + doffst; - d__1 = d_int(&tvec[3]); - d__2 = d_int(&tvec[4]); - secs = d__1 * 3600. + d__2 * 60. + tvec[5]; - } else if (pfrom == 12 || pfrom == 15) { - year = (integer) tvec[0]; - day = (integer) tvec[1]; - month = 1; - doffst = 0; - if (year <= 0) { - rmaini_(&year, &c__400, &yr400, &tempi); - year = tempi; - if (year == 0) { - year += 400; - --yr400; - } - doffst = yr400 * 146097; - } -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__7 = 0, i__8 = abs(year) / c__400 * c__400 + 1 - abs(year); - daynum = (year - 1) * 365 + (year - 1) / 4 - (year - 1) / 100 + (year - - 1) / 400 + (dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen)1374)] + - extra[(i__2 = month - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge( - "extra", i__2, "ttrans_", (ftnlen)1374)] * (max(i__3,i__4) - - max(i__5,i__6) + max(i__7,i__8)) + day) - 1 + doffst; - d__1 = d_int(&tvec[2]); - d__2 = d_int(&tvec[3]); - secs = d__1 * 3600. + d__2 * 60. + tvec[4]; - } else if (pfrom == 13 || pfrom == 14) { - year = (integer) tvec[0]; - day = (integer) tvec[1]; - month = 1; - doffst = 0; - if (year <= 0) { - rmaini_(&year, &c__400, &yr400, &tempi); - year = tempi; - if (year == 0) { - year += 400; - --yr400; - } - doffst = yr400 * 146097; - } - frac = tvec[1] - (doublereal) day; -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__7 = 0, i__8 = abs(year) / c__400 * c__400 + 1 - abs(year); - daynum = (year - 1) * 365 + (year - 1) / 4 - (year - 1) / 100 + (year - - 1) / 400 + (dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen)1402)] + - extra[(i__2 = month - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge( - "extra", i__2, "ttrans_", (ftnlen)1402)] * (max(i__3,i__4) - - max(i__5,i__6) + max(i__7,i__8)) + day) - 1 + doffst; - -/* Normally the length of a day is 86400 seconds, but this day */ -/* might be a leapsecond day. We will set DAYLEN to SECSPD and */ -/* change it if it turns out this is a day with a leapsecond. */ - - if (pfrom == 14) { - secs = frac * secspd; - } else { - daylen = secspd; - dayptr = lstlei_(&daynum, &nref, daytab); - if (odd_(&dayptr)) { - daylen = taitab[(i__1 = dayptr) < 280 && 0 <= i__1 ? i__1 : - s_rnge("taitab", i__1, "ttrans_", (ftnlen)1417)] - - taitab[(i__2 = dayptr - 1) < 280 && 0 <= i__2 ? i__2 : - s_rnge("taitab", i__2, "ttrans_", (ftnlen)1417)]; - } - secs = frac * daylen; - } - } else if (pfrom == 4) { - -/* First lets get the number of days since 1-Jan-2000 00:00:00 */ - - d__1 = tvec[0] + halfd; - rmaind_(&d__1, &secspd, &dp2000, &secs); - daynum = (integer) dp2000 + dn2000; - } else if (pfrom == 7) { - -/* JD1101 is the julian date UTC of Jan 1, 1 AD. */ - - jdsecs = (tvec[0] - jd1101) * secspd; - rmaind_(&jdsecs, &secspd, &daydp, &secs); - daynum = (integer) daydp; - } else if (pfrom == 1) { - daynum = (integer) tvec[0]; - secs = tvec[1]; - } else if (pfrom == 2) { - daynum = (integer) tvec[0] + dn2000; - secs = tvec[1]; - } else if (pfrom == 20 || pfrom == 21) { - year = (integer) tvec[0]; - week = (integer) tvec[1] - 1; - wkday = (integer) tvec[2]; - month = 1; - -/* Compute the days past 1 jan 1 of the beginning of this */ -/* year and month. */ - - doffst = 0; - if (year <= 0) { - rmaini_(&year, &c__400, &yr400, &tempi); - year = tempi; - if (year == 0) { - year += 400; - --yr400; - } - doffst = yr400 * 146097; - } -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__7 = 0, i__8 = abs(year) / c__400 * c__400 + 1 - abs(year); - daynum = (year - 1) * 365 + (year - 1) / 4 - (year - 1) / 100 + (year - - 1) / 400 + (dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen)1490)] + - extra[(i__2 = month - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge( - "extra", i__2, "ttrans_", (ftnlen)1490)] * (max(i__3,i__4) - - max(i__5,i__6) + max(i__7,i__8)) + c__1) - 1 + doffst; - i__1 = daynum - sunday; - rmaini_(&i__1, &c__7, &qint, &dpsun); - fyrday = dpsun + 1; - i__1 = wkday - fyrday; - rmaini_(&i__1, &c__7, &qint, &offset); - daynum = daynum + week * 7 + offset; - d__1 = d_int(&tvec[3]); - d__2 = d_int(&tvec[4]); - secs = d__1 * 3600. + d__2 * 60. + tvec[5]; - } else if (pfrom == 18 || pfrom == 19) { - year = (integer) tvec[0]; - month = (integer) tvec[1]; - week = (integer) tvec[2] - 1; - day = (integer) tvec[3]; - doffst = 0; - if (year <= 0) { - rmaini_(&year, &c__400, &yr400, &tempi); - year = tempi; - if (year == 0) { - year += 400; - --yr400; - } - doffst = yr400 * 146097; - } -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__7 = 0, i__8 = abs(year) / c__400 * c__400 + 1 - abs(year); - daynum = (year - 1) * 365 + (year - 1) / 4 - (year - 1) / 100 + (year - - 1) / 400 + (dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen)1527)] + - extra[(i__2 = month - 1) < 12 && 0 <= i__2 ? i__2 : s_rnge( - "extra", i__2, "ttrans_", (ftnlen)1527)] * (max(i__3,i__4) - - max(i__5,i__6) + max(i__7,i__8)) + c__1) - 1 + doffst; - i__1 = daynum - sunday; - rmaini_(&i__1, &c__7, &qint, &dpsun); - fmday = dpsun + 1; - i__1 = day - fmday; - rmaini_(&i__1, &c__7, &qint, &offset); - daynum = daynum + week * 7 + offset; - secs = tvec[4] * 3600. + tvec[5] * 60. + tvec[6]; - -/* If we get to this point the type must be one of the continuous */ -/* time types: 'TAI', 'TDT', 'TDB', 'JED', 'ET', 'JDTDT', 'JDTDB'. */ - - } else { - -/* If the output time is one of the continuous time systems */ -/* we can take a short cut and just perform the computation */ -/* directly. */ - - if (elemc_(myto, unifrm, (ftnlen)32, (ftnlen)8)) { - tvec[0] = unitim_(tvec, myfrom, myto, (ftnlen)32, (ftnlen)32); - chkout_("TTRANS", (ftnlen)6); - return 0; - } - -/* The output time system isn't one of the uniform time systems. */ -/* Convert what we have to TAI and then to the DAYNUM, SECOND */ -/* representation. */ - - tai = unitim_(tvec, myfrom, "TAI", (ftnlen)32, (ftnlen)3); - taiptr = lstled_(&tai, &nref, taitab); - -/* If the TAIPTR value is odd, then the TAI time falls during */ -/* a day with a leap second. We can just look up the day */ -/* number and compute the number of seconds into that */ -/* day directly ... */ - - if (odd_(&taiptr)) { - daynum = daytab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? i__1 : - s_rnge("daytab", i__1, "ttrans_", (ftnlen)1575)]; - secs = tai - taitab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? i__1 - : s_rnge("taitab", i__1, "ttrans_", (ftnlen)1576)]; - -/* ...Otherwise, all days since the reference TAI time have */ -/* the same number of seconds (SECSPD). (This statement applies */ -/* to days that precede the first reference TAI time too.) */ -/* Thus we can simply compute the number of days and seconds */ -/* that have elapsed since the reference TAI time. */ - - } else { - -/* If TAI is before the first time in the table, we can */ -/* compute the number of days and seconds before the first */ -/* entry in the TAI table. */ - - taiptr = max(taiptr,1); - d__1 = tai - taitab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? i__1 - : s_rnge("taitab", i__1, "ttrans_", (ftnlen)1595)]; - rmaind_(&d__1, &secspd, &daydp, &secs); - daynum = (integer) daydp + daytab[(i__1 = taiptr - 1) < 280 && 0 - <= i__1 ? i__1 : s_rnge("daytab", i__1, "ttrans_", ( - ftnlen)1598)]; - } - } - if (forml[(i__1 = pfrom - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("forml", - i__1, "ttrans_", (ftnlen)1605)]) { - rmaind_(&secs, &secspd, &daydp, &tsecs); - daynum += (integer) daydp; - secs = tsecs; - } -/* ================================================================== */ - -/* Force the seconds into the range 0 to 86401 or 86400 */ -/* depending upon whether or not the output system is a formal */ -/* time system or not. */ - - if (forml[(i__1 = pto - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("forml", - i__1, "ttrans_", (ftnlen)1620)] && forml[(i__2 = pfrom - 1) < 21 - && 0 <= i__2 ? i__2 : s_rnge("forml", i__2, "ttrans_", (ftnlen) - 1620)]) { - -/* We don't have to do anything here. */ - - } else { - if (secs > secspd - 1. || secs < 0.) { - -/* First convert to TAI... */ - -/* Computing MAX */ - i__1 = 1, i__2 = lstlei_(&daynum, &nref, daytab); - dayptr = max(i__1,i__2); - secs += (doublereal) (daynum - daytab[(i__1 = dayptr - 1) < 280 && - 0 <= i__1 ? i__1 : s_rnge("daytab", i__1, "ttrans_", ( - ftnlen)1633)]) * secspd; - tai = taitab[(i__1 = dayptr - 1) < 280 && 0 <= i__1 ? i__1 : - s_rnge("taitab", i__1, "ttrans_", (ftnlen)1635)] + secs; - -/* ...then back to DAYNUM and SECS */ - - taiptr = lstled_(&tai, &nref, taitab); - if (odd_(&taiptr)) { - daynum = daytab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? i__1 - : s_rnge("daytab", i__1, "ttrans_", (ftnlen)1644)]; - secs = tai - taitab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? - i__1 : s_rnge("taitab", i__1, "ttrans_", (ftnlen)1645) - ]; - } else { - taiptr = max(1,taiptr); - daynum = daytab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? i__1 - : s_rnge("daytab", i__1, "ttrans_", (ftnlen)1651)]; - d__1 = tai - taitab[(i__1 = taiptr - 1) < 280 && 0 <= i__1 ? - i__1 : s_rnge("taitab", i__1, "ttrans_", (ftnlen)1653) - ]; - rmaind_(&d__1, &secspd, &daydp, &secs); - daynum += (integer) daydp; - } - } - } - -/* One last thing. If we are going to a formal time vector, */ -/* we want to ignore positive leapseconds. (Negative ones */ -/* were handled above, the clock jumped ahead one second */ -/* when the second hand got to 59.) */ - -/* The idea is that we want the clock */ -/* to stand still during the leapsecond. Yeah this is bogus, */ -/* but people with analog clocks don't have any other choice. */ - -/* We are in a positive leapsecond only if SECS is greater than */ -/* the number of seconds in a normal day. In that case we */ -/* increment the day number by one and set SECS to zero. */ - - if (forml[(i__1 = pto - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("forml", - i__1, "ttrans_", (ftnlen)1676)] && secs > secspd) { - ++daynum; - secs = 0.; - } - -/* OK. Now we have DAYNUM and SECS, convert this form to the */ -/* one requested. */ - -/* If there is a 'Y' in the form we are to convert to, then we */ -/* will need some form of year, etc. Do the work now and sort it */ -/* it all out at the appropriate time later on. */ - - if (needy[(i__1 = pto - 1) < 21 && 0 <= i__1 ? i__1 : s_rnge("needy", - i__1, "ttrans_", (ftnlen)1688)]) { - yr400 = daynum / 146097; - rem = daynum - yr400 * 146097; - -/* We want to be able to deal with years prior to 1 Jan 1 */ -/* So we make sure the remainder is positive. */ - - if (rem < 0) { - --yr400; - rem += 146097; - } -/* Computing MIN */ - i__1 = 3, i__2 = rem / 36524; - yr100 = min(i__1,i__2); - rem -= yr100 * 36524; -/* Computing MIN */ - i__1 = 24, i__2 = rem / 1461; - yr4 = min(i__1,i__2); - rem -= yr4 * 1461; -/* Computing MIN */ - i__1 = 3, i__2 = rem / 365; - yr1 = min(i__1,i__2); - rem -= yr1 * 365; - dofyr = rem + 1; - year = yr400 * 400 + yr100 * 100 + (yr4 << 2) + yr1 + 1; -/* Computing MAX */ - i__1 = 0, i__2 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__400 * c__400 + 1 - abs(year); - if (max(i__1,i__2) - max(i__3,i__4) + max(i__5,i__6) == 0) { - month = lstlti_(&dofyr, &c__12, dpjan0); - day = dofyr - dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpjan0", i__1, "ttrans_", (ftnlen)1716)]; - } else { - month = lstlti_(&dofyr, &c__12, dpbegl); - day = dofyr - dpbegl[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 : - s_rnge("dpbegl", i__1, "ttrans_", (ftnlen)1719)]; - } - -/* We only want to convert that portion of seconds less than */ -/* 86399 to hours, minutes and seconds. Take anything extra */ -/* and put it in EXSECS. */ - -/* Computing MAX */ - d__1 = 0., d__2 = secs - secspd + 1; - exsecs = max(d__1,d__2); - tsecs = secs - exsecs; - rmaind_(&tsecs, &c_b188, &hours, &tempd); - rmaind_(&tempd, &c_b189, &mins, &tsecs); - tsecs += exsecs; - } -/* ===================================================================== */ - -/* Finally, we convert to the requested output. */ - - if (pto == 16 || pto == 17) { - tvec[0] = (doublereal) year; - tvec[1] = (doublereal) month; - tvec[2] = (doublereal) day; - tvec[3] = hours; - tvec[4] = mins; - tvec[5] = tsecs; - } else if (pto == 12 || pto == 15) { - tvec[0] = (doublereal) year; - tvec[1] = (doublereal) dofyr; - tvec[2] = hours; - tvec[3] = mins; - tvec[4] = tsecs; - } else if (pto == 13 || pto == 14) { - tvec[0] = (doublereal) year; - if (pto == 13) { - dayptr = lstlei_(&daynum, &nref, daytab); - daylen = secspd; - if (odd_(&dayptr)) { - daylen = taitab[(i__1 = dayptr) < 280 && 0 <= i__1 ? i__1 : - s_rnge("taitab", i__1, "ttrans_", (ftnlen)1768)] - - taitab[(i__2 = dayptr - 1) < 280 && 0 <= i__2 ? i__2 : - s_rnge("taitab", i__2, "ttrans_", (ftnlen)1768)]; - } - tvec[1] = (doublereal) dofyr + secs / daylen; - } else { - tvec[1] = (doublereal) dofyr + secs / secspd; - } - } else if (pto == 4) { - tvec[0] = (doublereal) (daynum - dn2000) * secspd - halfd + secs; - } else if (pto == 7) { - tvec[0] = jd1101 + (doublereal) daynum + secs / secspd; - } else if (pto == 1) { - tvec[0] = (doublereal) daynum; - tvec[1] = secs; - } else if (pto == 2) { - tvec[0] = (doublereal) (daynum - dn2000); - tvec[1] = secs; - } else if (pto == 20 || pto == 21) { - -/* First compute the day of the week, and the week number */ - - i__1 = daynum - sunday; - rmaini_(&i__1, &c__7, &qint, &day); - week = (dofyr - 1) / 7 + 1; - -/* Now just put everything where it belongs. */ - - tvec[0] = (doublereal) year; - tvec[1] = (doublereal) week; - tvec[2] = (doublereal) day + 1.; - tvec[3] = hours; - tvec[4] = mins; - tvec[5] = tsecs; - } else if (pto == 18 || pto == 19) { - -/* First compute how many weeks into the month DAYNUM is, */ -/* and compute the day of week number. */ - - tvec[0] = (doublereal) year; - doffst = 0; - if (year <= 0) { - rmaini_(&year, &c__400, &yr400, &tempi); - year = tempi; - if (year == 0) { - year += 400; - --yr400; - } - doffst = yr400 * 146097; - } -/* Computing MAX */ - i__3 = 0, i__4 = abs(year) / c__4 * c__4 + 1 - abs(year); -/* Computing MAX */ - i__5 = 0, i__6 = abs(year) / c__100 * c__100 + 1 - abs(year); -/* Computing MAX */ - i__7 = 0, i__8 = abs(year) / c__400 * c__400 + 1 - abs(year); - week = (daynum - ((year - 1) * 365 + (year - 1) / 4 - (year - 1) / - 100 + (year - 1) / 400 + (dpjan0[(i__1 = month - 1) < 12 && 0 - <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "ttrans_", (ftnlen) - 1837)] + extra[(i__2 = month - 1) < 12 && 0 <= i__2 ? i__2 : - s_rnge("extra", i__2, "ttrans_", (ftnlen)1837)] * (max(i__3, - i__4) - max(i__5,i__6) + max(i__7,i__8)) + c__1) - 1) - - doffst) / 7 + 1; - i__1 = daynum - sunday; - rmaini_(&i__1, &c__7, &qint, &day); - -/* Now just move the remaining stuff into TVEC. */ - - tvec[1] = (doublereal) month; - tvec[2] = (doublereal) week; - tvec[3] = (doublereal) day + 1.; - tvec[4] = hours; - tvec[5] = mins; - tvec[6] = tsecs; - -/* If we get to this point the type must be one of the continuous */ -/* time types: 'TAI', 'TDT', 'TDB', 'JED', 'ET', 'JDTDT', 'JDTDB'. */ - -/* First convert to TAI and then to the appropriate output type. */ - - } else { -/* Computing MAX */ - i__1 = 1, i__2 = lstlei_(&daynum, &nref, daytab); - dayptr = max(i__1,i__2); - secs += (doublereal) (daynum - daytab[(i__1 = dayptr - 1) < 280 && 0 - <= i__1 ? i__1 : s_rnge("daytab", i__1, "ttrans_", (ftnlen) - 1859)]) * secspd; - tai = taitab[(i__1 = dayptr - 1) < 280 && 0 <= i__1 ? i__1 : s_rnge( - "taitab", i__1, "ttrans_", (ftnlen)1861)] + secs; - tvec[0] = unitim_(&tai, "TAI", myto, (ftnlen)3, (ftnlen)32); - } - -/* Here's where we will handle conversion to SCLK when */ -/* we get around to implementing that portion of TTRANS */ - - -/* IF ( MKSCLK ) THEN */ -/* CALL TVSCLK ( TO, TVEC ) */ -/* END IF */ - -/* END IF */ - - chkout_("TTRANS", (ftnlen)6); - return 0; -} /* ttrans_ */ - diff --git a/ext/spice/src/cspice/twopi.c b/ext/spice/src/cspice/twopi.c deleted file mode 100644 index 2553ed1748..0000000000 --- a/ext/spice/src/cspice/twopi.c +++ /dev/null @@ -1,160 +0,0 @@ -/* twopi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TWOPI ( Twice the value of pi ) */ -doublereal twopi_(void) -{ - /* Initialized data */ - - static doublereal value = 0.; - - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double acos(doublereal); - -/* $ Abstract */ - -/* Return twice the value of pi (the ratio of the circumference of */ -/* a circle to its diameter). */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* The function returns twice the value of pi. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns twice the value of pi (the ratio of */ -/* a circle's circumference to its diameter), determined by */ -/* the ACOS function. That is, */ - -/* TWOPI = ACOS ( -1.D0 ) * 2.D0 */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The first time the function is referenced, the value is computed */ -/* as shown above. The value is saved, and returned directly upon */ -/* subsequent reference. */ - -/* $ Examples */ - -/* The code fragment below illustrates the use of TWOPI. */ - -/* C */ -/* C The longitude of the ascending node is the angle */ -/* C between the x-axis and the node vector, n. */ -/* C - */ -/* C */ -/* NODE = ACOS ( N(1) / VNORM(N) ) */ - -/* IF ( NODE .LT. 0.D0 ) THEN */ -/* NODE = NODE + TWOPI() */ -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 28-AUG-1997 (WLT) */ - -/* Fixed the description in the detailed output section */ -/* of the header. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* twice the value of pi */ - -/* -& */ - -/* Local variables */ - - -/* Initial values */ - - -/* What is there to say? */ - - if (value == 0.) { - value = acos(-1.) * 2.; - } - ret_val = value; - return ret_val; -} /* twopi_ */ - diff --git a/ext/spice/src/cspice/twopi_c.c b/ext/spice/src/cspice/twopi_c.c deleted file mode 100644 index f85d0e593b..0000000000 --- a/ext/spice/src/cspice/twopi_c.c +++ /dev/null @@ -1,143 +0,0 @@ -/* - --Procedure twopi_c ( Twice the value of pi ) - --Abstract - - Return twice the value of pi (the ratio of the circumference of - a circle to its diameter). - --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 - - CONSTANTS - -*/ - - #include - #include "SpiceUsr.h" - - SpiceDouble twopi_c ( void ) - -/* - --Brief_I/O - - The function returns twice the value of pi. - --Detailed_Input - - None. - --Detailed_Output - - The function returns twice the value of pi (the ratio of - a circle's circumference to its diameter), determined by - the ACOS function. That is, - - twopi = acos ( -1. ) * 2. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The first time the function is referenced, the value is computed - as shown above. The value is saved, and returned directly upon - subsequent reference. - --Examples - - The code fragment below illustrates the use of twopi_c. - - /. - The longitude of the ascending node is the angle - between the x-axis and the node vector, n. - - - ./ - node = acos ( n[0] / vnorm_c( n ) ); - - if ( node < 0.D0 ) - { - node = node + twopi_c(); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - twice the value of pi - --& -*/ - -{ /* Begin twopi_c */ - - /* - Local Variables - */ - - static SpiceDouble value = 0.; - - if ( value == 0.) - { - value = 2. * acos( -1. ); - } - - - return value; - -} /* End twopi_c */ diff --git a/ext/spice/src/cspice/twovec.c b/ext/spice/src/cspice/twovec.c deleted file mode 100644 index 592154edfa..0000000000 --- a/ext/spice/src/cspice/twovec.c +++ /dev/null @@ -1,319 +0,0 @@ -/* twovec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure TWOVEC ( Two vectors defining an orthonormal frame ) */ -/* Subroutine */ int twovec_(doublereal *axdef, integer *indexa, doublereal * - plndef, integer *indexp, doublereal *mout) -{ - /* Initialized data */ - - static integer seqnce[5] = { 1,2,3,1,2 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), chkin_( - char *, ftnlen), moved_(doublereal *, integer *, doublereal *); - doublereal mtemp[9] /* was [3][3] */; - integer i1, i2, i3; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *), ucrss_( - doublereal *, doublereal *, doublereal *), sigerr_(char *, ftnlen) - , chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char * - , integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Find the transformation to the right-handed frame having a */ -/* given vector as a specified axis and having a second given */ -/* vector lying in a specified coordinate plane. */ - -/* $ 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 */ - -/* AXES, FRAME, ROTATION, TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* AXDEF I Vector defining a principal axis. */ -/* INDEXA I Principal axis number of AXDEF (X=1, Y=2, Z=3). */ -/* PLNDEF I Vector defining (with AXDEF) a principal plane. */ -/* INDEXP I Second axis number (with INDEXA) of principal */ -/* plane. */ -/* MOUT O Output rotation matrix. */ - -/* $ Detailed_Input */ - -/* AXDEF is a vector defining one of the priciple axes of a */ -/* coordinate frame. */ - -/* INDEXA is a number that determines which of the three */ -/* coordinate axes contains AXDEF. */ - -/* If INDEXA is 1 then AXDEF defines the X axis of the */ -/* coordinate frame. */ - -/* If INDEXA is 2 then AXDEF defines the Y axis of the */ -/* coordinate frame. */ - -/* If INDEXA is 3 then AXDEF defines the Z axis of the */ -/* coordinate frame */ - -/* PLNDEF is a vector defining (with AXDEF) a principal plane of */ -/* the coordinate frame. AXDEF and PLNDEF must be */ -/* linearly independent. */ - -/* INDEXP is the second axis of the principal frame determined */ -/* by AXDEF and PLNDEF. INDEXA, INDEXP must be different */ -/* and be integers from 1 to 3. */ - -/* If INDEXP is 1, the second axis of the principal */ -/* plane is the X-axis. */ - -/* If INDEXP is 2, the second axis of the principal */ -/* plane is the Y-axis. */ - -/* If INDEXP is 3, the second axis of the principal plane */ -/* is the Z-axis. */ - - -/* $ Detailed_Output */ - -/* MOUT is a rotation matrix that transforms coordinates given */ -/* in the input frame to the frame determined by AXDEF, */ -/* PLNDEF, INDEXA and INDEXP. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If INDEXA or INDEXP is not in the set {1,2,3} the error */ -/* SPICE(BADINDEX) will be signaled. */ - -/* 2) If INDEXA and INDEXP are the same the error */ -/* SPICE(UNDEFINEDFRAME) will be signaled. */ - -/* 3) If the cross product of the vectors AXDEF and PLNDEF is zero, */ -/* the error SPICE(DEPENDENTVECTORS) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given two linearly independent vectors there is a unique */ -/* right-handed coordinate frame having: */ - -/* AXDEF lying along the INDEXA axis. */ - -/* PLNDEF lying in the INDEXA-INDEXP coordinate plane. */ - -/* This routine determines the transformation matrix that transforms */ -/* from coordinates used to represent the input vectors to the */ -/* the system determined by AXDEF and PLNDEF. Thus a vector */ -/* (x,y,z) in the input coordinate system will have coordinates */ - -/* t */ -/* MOUT* (x,y,z) */ - -/* in the frame determined by AXDEF and PLNDEF. */ - -/* $ Examples */ - -/* The rotation matrix TICC from inertial to Sun-Canopus */ -/* (celestial) coordinates is found by the call */ - -/* CALL TWOVEC (Sun vector, 3, Canopus vector, 1, TICC) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* define an orthonormal frame from two vectors */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - Beta Version 2.0.0, 10-JAN-1989 (WLT) */ - -/* Error checking was added and the algorithm somewhat redesigned. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } else { - chkin_("TWOVEC", (ftnlen)6); - } - -/* Check for obvious bad inputs. */ - - if (max(*indexp,*indexa) > 3 || min(*indexp,*indexa) < 1) { - setmsg_("The definition indexs must lie in the range from 1 to 3. T" - "he value of INDEXA was #. The value of INDEXP was #. ", ( - ftnlen)112); - errint_("#", indexa, (ftnlen)1); - errint_("#", indexp, (ftnlen)1); - sigerr_("SPICE(BADINDEX)", (ftnlen)15); - chkout_("TWOVEC", (ftnlen)6); - return 0; - } else if (*indexa == *indexp) { - setmsg_("The values of INDEXA and INDEXP were the same, namely #. T" - "hey are required to be different.", (ftnlen)92); - errint_("#", indexa, (ftnlen)1); - sigerr_("SPICE(UNDEFINEDFRAME)", (ftnlen)21); - chkout_("TWOVEC", (ftnlen)6); - return 0; - } - -/* Get indices for right-handed axes */ - -/* First AXDEF ... */ - - i1 = *indexa; - -/* ... then the other two. */ - - i2 = seqnce[(i__1 = *indexa) < 5 && 0 <= i__1 ? i__1 : s_rnge("seqnce", - i__1, "twovec_", (ftnlen)270)]; - i3 = seqnce[(i__1 = *indexa + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("seqnce" - , i__1, "twovec_", (ftnlen)271)]; - -/* Row I1 contains normalized AXDEF (store in columns for now) */ - - vhat_(axdef, &mout[(i__1 = i1 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "mout", i__1, "twovec_", (ftnlen)276)]); - -/* Obtain rows I2 and I3 using cross products. Which order to use */ -/* depends on whether INDEXP = I2 (next axis in right-handed order) */ -/* or INDEXP = I3 (previous axis in right-handed order). */ - - if (*indexp == i2) { - ucrss_(axdef, plndef, &mout[(i__1 = i3 * 3 - 3) < 9 && 0 <= i__1 ? - i__1 : s_rnge("mout", i__1, "twovec_", (ftnlen)285)]); - ucrss_(&mout[(i__1 = i3 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "mout", i__1, "twovec_", (ftnlen)286)], axdef, &mout[(i__2 = - i2 * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("mout", i__2, - "twovec_", (ftnlen)286)]); - } else { - ucrss_(plndef, axdef, &mout[(i__1 = i2 * 3 - 3) < 9 && 0 <= i__1 ? - i__1 : s_rnge("mout", i__1, "twovec_", (ftnlen)290)]); - ucrss_(axdef, &mout[(i__1 = i2 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : - s_rnge("mout", i__1, "twovec_", (ftnlen)291)], &mout[(i__2 = - i3 * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("mout", i__2, - "twovec_", (ftnlen)291)]); - } - -/* Finally, check to see that we actually got something non-zero */ -/* in one of the one columns of MOUT(1,I2) and MOUT(1,I3) (we need */ -/* only check one of them since they are related by a cross product). */ - - if (mout[(i__1 = i2 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout", - i__1, "twovec_", (ftnlen)300)] == 0. && mout[(i__2 = i2 * 3 - 2) < - 9 && 0 <= i__2 ? i__2 : s_rnge("mout", i__2, "twovec_", (ftnlen) - 300)] == 0. && mout[(i__3 = i2 * 3 - 1) < 9 && 0 <= i__3 ? i__3 : - s_rnge("mout", i__3, "twovec_", (ftnlen)300)] == 0.) { - setmsg_("The input vectors AXDEF and PLNDEF are linearly dependent.", - (ftnlen)58); - sigerr_("SPICE(DEPENDENTVECTORS)", (ftnlen)23); - } - -/* Transpose MOUT. */ - - xpose_(mout, mtemp); - moved_(mtemp, &c__9, mout); - chkout_("TWOVEC", (ftnlen)6); - return 0; -} /* twovec_ */ - diff --git a/ext/spice/src/cspice/twovec_c.c b/ext/spice/src/cspice/twovec_c.c deleted file mode 100644 index 2ba0e19071..0000000000 --- a/ext/spice/src/cspice/twovec_c.c +++ /dev/null @@ -1,208 +0,0 @@ -/* - --Procedure twovec_c ( Two vectors defining an orthonormal frame ) - --Abstract - - Find the transformation to the right-handed frame having a - given vector as a specified axis and having a second given - vector lying in a specified coordinate plane. - --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 - - AXES, FRAME, ROTATION, TRANSFORMATION - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef twovec_c - - - void twovec_c ( ConstSpiceDouble axdef [3], - SpiceInt indexa, - ConstSpiceDouble plndef [3], - SpiceInt indexp, - SpiceDouble mout [3][3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- ------------------------------------------------- - axdef I Vector defining a principal axis. - indexa I Principal axis number of axdef (X=1, Y=2, Z=3). - plndef I Vector defining (with axdef) a principal plane. - indexp I Second axis number (with indexa) of principal - plane. - mout O Output rotation matrix. - --Detailed_Input - - axdef is a vector defining one of the principal axes of a - coordinate frame. - - indexa is a number that determines which of the three - coordinate axes contains axdef. - - If indexa is 1 then axdef defines the X axis of the - coordinate frame. - - If indexa is 2 then axdef defines the Y axis of the - coordinate frame. - - If indexa is 3 then axdef defines the Z axis of the - coordinate frame - - plndef is a vector defining (with axdef) a principal plane of - the coordinate frame. - - indexp is the second axis of the principal frame determined - by axdef and plndef. - - If indexp is 1, the second axis of the principal - plane is the X-axis. - - If indexp is 2, the second axis of the principal - plane is the Y-axis. - - If indexp is 3, the second axis of the principal plane - is the Z-axis. - --Detailed_Output - - mout is a rotation matrix that transforms coordinates given - in the input frame to the frame determined by axdef, - plndef, indexa and indexp. - --Parameters - - None. - --Exceptions - - 1) If indexa or indexp is not in the set {1,2,3} the error - SPICE(BADINDEX) will be signalled. - - 2) If indexa and indexp are the same the error - SPICE(UNDEFINEDFRAME) will be signalled. - - 3) If the cross product of the vectors axdef and plndef is zero, - the error SPICE(DEPENDENTVECTORS) will be signalled. - --Files - - None. - --Particulars - - Given two linearly independent vectors there is a unique - right-handed coordinate frame having: - - 1) axdef lying along the indexa axis. - - 2) plndef lying in the indexa-indexp coordinate plane. - - This routine determines the transformation matrix that transforms - from coordinates used to represent the input vectors to the - the system determined by axdef and plndef. Thus a vector - (x,y,z) in the input coordinate system will have coordinates - - t - mout * (x,y,z) - - in the frame determined by axdef and plndef. - --Examples - - The rotation matrix ticc from inertial to Sun-Canopus - (celestial) coordinates is found by the call - - twovec_c ( Sun_vector, 3, Canopus_vector, 1, ticc ); - - --Restrictions - - indexa, indexp must be different and be integers from 1 to 3. - - axdef and plndef must be linearly independent. - --Author_and_Institution - - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input matrices const. - - -CSPICE Version 1.0.0, 2-MAR-1998 - --Index_Entries - - define an orthonormal frame from two vectors - --& -*/ - -{ /* Begin twovec_c */ - - /* - Participate in error tracing. - */ - chkin_c ( "twovec_c" ); - - /* - Call the f2c'd routine. - */ - twovec_ ( ( doublereal * ) axdef, - ( integer * ) &indexa, - ( doublereal * ) plndef, - ( integer * ) &indexp, - ( doublereal * ) mout ); - - /* - Transpose the output matrix to put it in row-major - order. - */ - xpose_c ( mout, mout ); - - - chkout_c ( "twovec_c" ); - -} /* End twovec_c */ diff --git a/ext/spice/src/cspice/twovxf.c b/ext/spice/src/cspice/twovxf.c deleted file mode 100644 index 0b328d56ae..0000000000 --- a/ext/spice/src/cspice/twovxf.c +++ /dev/null @@ -1,332 +0,0 @@ -/* twovxf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TWOVXF ( Two states defining a frame transformation ) */ -/* Subroutine */ int twovxf_(doublereal *axdef, integer *indexa, doublereal * - plndef, integer *indexp, doublereal *xform) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), zztwovxf_(doublereal * - , integer *, doublereal *, integer *, doublereal *); - doublereal xi[36] /* was [6][6] */; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Find the state transformation from a base frame to the */ -/* right-handed frame defined by two state vectors: one state */ -/* vector defining a specified axis and a second state vector */ -/* defining a specified coordinate plane. */ - -/* $ 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 */ - -/* AXES */ -/* FRAMES */ -/* MATRIX */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* AXDEF I State defining a principal axis. */ -/* INDEXA I Principal axis number of AXDEF (X=1, Y=2, Z=3). */ -/* PLNDEF I State defining (with AXDEF) a principal plane. */ -/* INDEXP I Second axis number (with INDEXA) of principal */ -/* plane. */ -/* XFORM O Output state transformation matrix. */ - -/* $ Detailed_Input */ - -/* AXDEF is a "generalized" state vector defining one of the */ -/* principal axes of a reference frame. This vector */ -/* consists of three components of a vector-valued */ -/* function of one independent variable t followed by */ -/* the derivatives of the components with respect to that */ -/* variable: */ - -/* ( a, b, c, da/dt, db/dt, dc/dt ) */ - -/* This routine treats the input states as unitless, but */ -/* in most applications the input states represent */ -/* quantities that have associated units. The first three */ -/* components must have the same units, and the units of */ -/* the last three components must be compatible with */ -/* those of the first three: if the first three */ -/* components of AXDEF */ - -/* ( a, b, c ) */ - -/* have units U and t has units T, then the units of */ -/* AXDEF normally would be */ - -/* ( U, U, U, U/T, U/T, U/T ) */ - -/* Note that the direction and angular velocity defined */ -/* by AXDEF are actually independent of U, so scaling */ -/* AXDEF doesn't affect the output of this routine. */ - -/* AXDEF could represent position and velocity; it could */ -/* also represent velocity and acceleration. AXDEF could */ -/* for example represent the velocity and acceleration of */ -/* a time-dependent position vector ( x(t), y(t), z(t) ), */ -/* in which case AXDEF would be defined by */ - -/* a = dx/dt */ -/* b = dy/dt */ -/* c = dz/dt */ - -/* 2 2 */ -/* da/dt = d x / dt */ - -/* 2 2 */ -/* db/dt = d y / dt */ - -/* 2 2 */ -/* dc/dt = d z / dt */ - -/* Below, we'll call the normalized (unit length) version */ -/* of */ - -/* ( a, b, c ) */ - -/* the "direction" of AXDEF. */ - -/* We call the frame relative to which AXDEF is specified */ -/* the "base frame." The input state PLNDEF must be */ -/* specified relative to the same base frame. */ - - -/* INDEXA is the index of the reference frame axis that is */ -/* parallel to the direction of AXDEF. */ - -/* Value of INDEXA Axis */ - -/* 1 X */ -/* 2 Y */ -/* 3 Z */ - - -/* PLNDEF is a state vector defining (with AXDEF) a principal */ -/* plane of the reference frame. This vector consists */ -/* of three components followed by their derivatives with */ -/* respect to the independent variable t associated with */ -/* AXDEF, so PLNDEF is */ - -/* ( e, f, g, de/dt, df/dt, dg/dt ) */ - -/* Below, we'll call the unitized version of */ - -/* ( e, f, g ) */ - -/* the "direction" of PLNDEF. */ - -/* The second axis of the principal plane containing the */ -/* direction vectors of AXDEF and PLNDEF is perpendicular */ -/* to the first axis and has positive dot product with */ -/* the direction vector of PLNDEF. */ - -/* The first three components of PLNDEF must have the */ -/* same units, and the units of the last three components */ -/* must be compatible with those of the first three: if */ -/* the first three components of PLNDEF */ - -/* ( e, f, g ) */ - -/* have units U2 and t has units T, then the units of */ -/* PLNDEF normally would be */ - -/* ( U2, U2, U2, U2/T, U2/T, U2/T ) */ - -/* ***For meaningful results, the angular velocities */ -/* defined by AXDEF and PLNDEF must both have units of */ -/* 1/T.*** */ - -/* As with AXDEF, scaling PLNDEF doesn't affect the */ -/* output of this routine. */ - -/* AXDEF and PLNDEF must be specified relative to a */ -/* common reference frame, which we call the "base */ -/* frame." */ - - -/* INDEXP is the index of second axis of the principal frame */ -/* determined by AXDEF and PLNDEF. The association of */ -/* integer values and axes is the same as for INDEXA. */ - -/* $ Detailed_Output */ - -/* XFORM is the 6x6 matrix that transforms states from the */ -/* frame relative to which AXDEF and PLNDEF are specified */ -/* (the "base frame") to the frame whose axes and */ -/* derivative are determined by AXDEF, PLNDEF, INDEXA and */ -/* INDEXP. */ - -/* The matrix XFORM has the structure shown below: */ - -/* - - */ -/* | : | */ -/* | R : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | dR_dt : R | */ -/* | : | */ -/* - - */ - -/* where R is a rotation matrix that is a function of */ -/* the independent variable associated with AXDEF and */ -/* PLNDEF, and where dR_dt is the derivative of R */ -/* with respect to that independent variable. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If INDEXA or INDEXP is not in the set {1,2,3} the error */ -/* SPICE(BADINDEX) will be signaled. */ - -/* 2) If INDEXA and INDEXP are the same the error */ -/* SPICE(UNDEFINEDFRAME) will be signaled. */ - -/* 3) If the cross product of the vectors AXDEF and PLNDEF is zero, */ -/* the error SPICE(DEPENDENTVECTORS) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given two linearly independent state vectors AXDEF and PLNDEF, */ -/* define vectors DIR1 and DIR2 by */ - -/* DIR1 = ( AXDEF(1), AXDEF(2), AXDEF(3) ) */ -/* DIR2 = ( PLNDEF(1), PLNDEF(2), PLNDEF(3) ) */ - -/* Then there is a unique right-handed reference frame F having: */ - -/* DIR1 lying along the INDEXA axis. */ - -/* DIR2 lying in the INDEXA-INDEXP coordinate plane, such that */ -/* the dot product of DIR2 with the positive INDEXP axis is */ -/* positive. */ - -/* This routine determines the 6x6 matrix that transforms states */ -/* from the base frame used to represent the input vectors to the */ -/* the frame F determined by AXDEF and PLNDEF. Thus a state vector */ - -/* S = ( x, y, z, dx/dt, dy/dt, dz/dt ) */ -/* base */ - -/* in the input reference frame will be transformed to */ - -/* S = XFORM * S */ -/* F base */ - -/* in the frame F determined by AXDEF and PLNDEF. */ - -/* $ Examples */ - -/* The time-dependent Sun-Canopus reference frame associated with a */ -/* spacecraft uses the spacecraft-sun state to define the Z axis and */ -/* the Canopus direction to define the X-Z plane. */ - -/* Define an approximate "state vector" for Canopus using the */ -/* J2000-relative, unit direction vector toward Canopus at a */ -/* specified time ET (time is needed to compute proper motion) as */ -/* position and the zero vector as velocity. Call this state vector */ -/* STCANO. Let STSUN be the J2000-relative state of the sun */ -/* relative to the spacecraft at ET. */ - -/* Then the matrix XFISC that transforms states from J2000 to the */ -/* Sun-Canopus reference frame at ET is returned by the call */ - -/* CALL TWOVXF ( STSUN, 3, STCANO, 1, XFISC ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) (WMO) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* define a state transformation matrix from two states */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("TWOVXF", (ftnlen)6); - -/* Get the matrix XI that transforms states from the frame */ -/* defined by AXDEF and PLNDEF to their base frame. */ - - zztwovxf_(axdef, indexa, plndef, indexp, xi); - -/* Invert XI. */ - - invstm_(xi, xform); - chkout_("TWOVXF", (ftnlen)6); - return 0; -} /* twovxf_ */ - diff --git a/ext/spice/src/cspice/txtopn.c b/ext/spice/src/cspice/txtopn.c deleted file mode 100644 index 65d480a2c1..0000000000 --- a/ext/spice/src/cspice/txtopn.c +++ /dev/null @@ -1,349 +0,0 @@ -/* txtopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TXTOPN ( Text file, open new ) */ -/* Subroutine */ int txtopn_(char *fname, integer *unit, ftnlen fname_len) -{ - /* System generated locals */ - olist o__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - , getlun_(integer *), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open a new text file for subsequent write access. */ - -/* $ 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 */ - -/* FILES */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of file. */ -/* UNIT O Logical unit. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of the new text file to be opened. */ - -/* $ Detailed_Output */ - -/* UNIT is the logical unit connected to the opened file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file cannot be opened, the error SPICE(FILEOPENFAILED) */ -/* is signalled. */ - -/* 2) If FNAME is a blank string, the error SPICE(BLANKFILENAME) is */ -/* signalled. */ - -/* $ Files */ - -/* See FNAME and UNIT above. */ - -/* $ Particulars */ - -/* In SPICELIB, a text file is formatted and sequential and may */ -/* contain only printable ASCII characters and blanks (ASCII 32-127). */ -/* When printing a text file, records are single spaced; the first */ -/* character will not be interpreted as a carriage control character. */ - -/* TXTOPN opens a new text file and makes use of the SPICELIB */ -/* mechanism for coordinating the use of logical units. */ - -/* System Dependencies */ -/* =================== */ - -/* The open statement will include the following keyword = value */ -/* pairs: */ - -/* UNIT = UNIT */ -/* FILE = FNAME */ -/* FORM = 'FORMATTED' */ -/* ACCESS = 'SEQUENTIAL' */ -/* STATUS = 'NEW' */ -/* IOSTAT = IOSTAT */ - -/* In addition, the statement will include */ - -/* CARRIAGECONTROL = 'LIST' */ - -/* for the Vax and Macintosh. */ - -/* $ Examples */ - -/* The following example reads a line from an input file, */ -/* 'INPUT.TXT', and writes it to an output file, 'OUTPUT.TXT'. */ - -/* CALL TXTOPR ( 'INPUT.TXT', IN ) */ -/* CALL TXTOPN ( 'OUTPUT.TXT', OUT ) */ - -/* READ ( IN, FMT='(A)' ) LINE */ -/* WRITE ( OUT, FMT='(A)' ) LINE */ - -/* CLOSE ( IN ) */ -/* CLOSE ( OUT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1. "Absoft FORTRAN 77 Language Reference Manual", page 7-12 for */ -/* the NeXT. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 2.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 2.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 2.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 1.2.0, 11-NOV-1993 (HAN) */ - -/* Module was updated for the Silicon Graphics, DEC Alpha-OSF/1, */ -/* and NeXT platforms. */ - -/* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ - -/* The code was reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - 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, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* text file open new */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 07-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 1.2.0, 11-NOV-1993 (HAN) */ - -/* Module was updated for the Silicon Graphics, DEC Alpha-OSF/1, */ -/* and NeXT platforms. */ - -/* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ - -/* The code was reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("TXTOPN", (ftnlen)6); - } - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - setmsg_("A blank string is unacceptable as a file name", (ftnlen)45); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("TXTOPN", (ftnlen)6); - return 0; - } - getlun_(unit); - o__1.oerr = 1; - o__1.ounit = *unit; - o__1.ofnmlen = fname_len; - o__1.ofnm = fname; - o__1.orl = 0; - o__1.osta = "NEW"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = "FORMATTED"; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Could not open file #. IOSTAT was #. ", (ftnlen)37); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("TXTOPN", (ftnlen)6); - return 0; - } - chkout_("TXTOPN", (ftnlen)6); - return 0; -} /* txtopn_ */ - diff --git a/ext/spice/src/cspice/txtopr.c b/ext/spice/src/cspice/txtopr.c deleted file mode 100644 index 67c6e898dc..0000000000 --- a/ext/spice/src/cspice/txtopr.c +++ /dev/null @@ -1,374 +0,0 @@ -/* txtopr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TXTOPR ( Text file, open for read ) */ -/* Subroutine */ int txtopr_(char *fname, integer *unit, ftnlen fname_len) -{ - /* System generated locals */ - olist o__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - , getlun_(integer *), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open a text file for read access. */ - -/* $ 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 */ - -/* TEXT */ - -/* $ Keywords */ - -/* FILES */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of file. */ -/* UNIT O Logical unit. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of the text file to be opened. */ - -/* $ Detailed_Output */ - -/* UNIT is the logical unit connected to the opened file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If FNAME is a blank string, the error SPICE(BLANKFILENAME) is */ -/* signalled. */ - -/* 2) If the file cannot be opened, the error SPICE(FILEOPENFAILED) */ -/* is signalled. */ - -/* $ Files */ - -/* See FNAME and UNIT above. */ - -/* $ Particulars */ - -/* In SPICELIB, a text file is formatted and sequential and may */ -/* contain only printable ASCII characters and blanks (ASCII 32-127). */ -/* When printing a text file, records are single spaced; the first */ -/* character will not be interpreted as a carriage control character. */ - -/* TXTOPR opens an existing text file for read access and makes use */ -/* of the SPICELIB mechanism for coordinating use of logical units. */ - -/* System Dependencies */ -/* =================== */ - -/* The open statement will include the following keyword = value */ -/* pairs: */ - -/* UNIT = UNIT */ -/* FILE = FNAME */ -/* FORM = 'FORMATTED' */ -/* ACCESS = 'SEQUENTIAL' */ -/* STATUS = 'OLD' */ -/* IOSTAT = IOSTAT */ - -/* In addition, the statement will include */ - -/* CARRIAGECONTROL = 'LIST' */ -/* READONLY */ - -/* for the Vax and the OS X Absoft compiler, or */ - -/* MODE = 'READ' */ - -/* for the IBM pc. */ - -/* $ Examples */ - -/* The following example reads the first line from an input file, */ -/* 'INPUT.TXT', and writes it to an output file, 'OUTPUT.TXT'. */ - -/* CALL TXTOPR ( 'INPUT.TXT', IN ) */ -/* CALL TXTOPN ( 'OUTPUT.TXT', OUT ) */ - -/* READ ( IN, FMT='(A)' ) LINE */ -/* WRITE ( OUT, FMT='(A)' ) LINE */ - -/* CLOSE ( IN ) */ -/* CLOSE ( OUT ) */ - -/* $ Restrictions */ - -/* The file, FNAME, must exist prior to calling TXTOPR. */ - -/* $ Literature_References */ - -/* 1. "Lahey F77L EM/32 FORTRAN Language Reference Manual", page */ -/* 145. */ - -/* 2. "Absoft FORTRAN 77 Language Reference Manual", page 7-12 for */ -/* the NeXT. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.0.6, 24-APR-2003 (EDW) */ - -/* Added MAC-OSX-F77 to the list of platforms */ -/* that require READONLY to read write protected */ -/* kernels. */ - -/* - SPICELIB Version 2.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 2.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 2.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 2.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 05-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* - SPICELIB Version 1.3.0, 11-NOV-1993 (HAN) */ - -/* Module was updated for the Silicon Graphics, DEC Alpha-OSF/1, */ -/* and NeXT platforms. */ - -/* - SPICELIB Version 1.2.0, 12-OCT-1992 (HAN) */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.1.0, 13-NOV-1991 (MJS) */ - -/* Module updated to allow portability to the Lahey F77L EM/32 */ -/* FORTRAN V 4.0 environment. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* text file open for read */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 05-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* - SPICELIB Version 1.3.0, 11-NOV-1993 (HAN) */ - -/* Module was updated for the Silicon Graphics, DEC Alpha-OSF/1, */ -/* and NeXT platforms. */ - -/* - SPICELIB Version 1.2.0, 12-OCT-1992 (HAN) */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 1.1.0, 13-NOV-1991 (MJS) */ - -/* Module updated to allow portability to the Lahey F77L EM/32 */ -/* FORTRAN V 4.0 environment. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("TXTOPR", (ftnlen)6); - } - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - setmsg_("A blank string is unacceptable as a file name", (ftnlen)45); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("TXTOPR", (ftnlen)6); - return 0; - } - getlun_(unit); - o__1.oerr = 1; - o__1.ounit = *unit; - o__1.ofnmlen = fname_len; - o__1.ofnm = fname; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = "FORMATTED"; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Could not open file #. IOSTAT was #. ", (ftnlen)37); - errch_("#", fname, (ftnlen)1, fname_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("TXTOPR", (ftnlen)6); - return 0; - } - chkout_("TXTOPR", (ftnlen)6); - return 0; -} /* txtopr_ */ - diff --git a/ext/spice/src/cspice/tyear.c b/ext/spice/src/cspice/tyear.c deleted file mode 100644 index 6ff78113ef..0000000000 --- a/ext/spice/src/cspice/tyear.c +++ /dev/null @@ -1,129 +0,0 @@ -/* tyear.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TYEAR ( Seconds per tropical year ) */ -doublereal tyear_(void) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Return the number of seconds in a tropical year. */ - -/* $ 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 */ - -/* CONSTANTS */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TYEAR O The number of seconds/tropical year */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* The function returns the number of seconds per tropical */ -/* year. This value is taken from the 1992 Explanatory Supplement */ -/* to the Astronomical Almanac. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The tropical year is often used as a fundamental unit */ -/* of time when dealing with older ephemeris data. For this */ -/* reason its value in terms of ephemeris seconds is */ -/* recorded in this function. */ - -/* $ Examples */ - -/* Suppose you wish to compute the number of tropical centuries */ -/* that have elapsed since the ephemeris epoch B1950 (beginning */ -/* of the Besselian year 1950) at a particular ET epoch. The */ -/* following line of code will do the trick. */ - - -/* CENTRY = ( ET - UNITIM ( B1950(), 'JED', 'ET' ) ) */ -/* . / ( 100.0D0 * TYEAR() ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Explanatory Supplement to the Astronomical Almanac. */ -/* Page 80. University Science Books, 20 Edgehill Road, */ -/* Mill Valley, CA 94941 */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 13-JUL-1993 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Number of seconds per tropical year */ - -/* -& */ - ret_val = 31556925.9747; - return ret_val; -} /* tyear_ */ - diff --git a/ext/spice/src/cspice/tyear_c.c b/ext/spice/src/cspice/tyear_c.c deleted file mode 100644 index 096a5d6ec9..0000000000 --- a/ext/spice/src/cspice/tyear_c.c +++ /dev/null @@ -1,127 +0,0 @@ -/* - --Procedure tyear_c ( Seconds per tropical year ) - --Abstract - - Return the number of seconds in a tropical year. - --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 - - CONSTANTS - -*/ - - #include "SpiceUsr.h" - - SpiceDouble tyear_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - tyear_c O The number of seconds/tropical year - --Detailed_Input - - None. - --Detailed_Output - - The function returns the number of seconds per tropical - year. This value is taken from the 1992 Explanatory Supplement - to the Astronomical Almanac. - --Parameters - - None. - --Particulars - - The tropical year is often used as a fundamental unit - of time when dealing with older ephemeris data. For this - reason its value in terms of ephemeris seconds is - recorded in this function. - --Examples - - Suppose you wish to compute the number of tropical centuries - that have elapsed since the ephemeris epoch B1950 (beginning - of the Besselian year 1950) at a particular ET epoch. The - following line of code will do the trick. - - - century = ( et - unitim_ ( b1950_c(), "JED", "ET" ) ) - / ( 100.0 * tyear_c() ); - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - Explanatory Supplement to the Astronomical Almanac. - Page 80. University Science Books, 20 Edgehill Road, - Mill Valley, CA 94941 - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - Number of seconds per tropical year - --& -*/ - -{ /* Begin tyear_c */ - - return 31556925.9747; - -} /* End tyear_c */ diff --git a/ext/spice/src/cspice/typesize.c b/ext/spice/src/cspice/typesize.c deleted file mode 100644 index 1cb20ff286..0000000000 --- a/ext/spice/src/cspice/typesize.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -ftnlen f__typesize[] = { 0, 0, sizeof(shortint), sizeof(integer), - sizeof(real), sizeof(doublereal), - sizeof(complex), sizeof(doublecomplex), - sizeof(logical), sizeof(char), - 0, sizeof(integer1), - sizeof(logical1), sizeof(shortlogical), -#ifdef Allow_TYQUAD - sizeof(longint), -#endif - 0}; diff --git a/ext/spice/src/cspice/ucase.c b/ext/spice/src/cspice/ucase.c deleted file mode 100644 index 3f6216f8e0..0000000000 --- a/ext/spice/src/cspice/ucase.c +++ /dev/null @@ -1,185 +0,0 @@ -/* ucase.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UCASE ( Convert to uppercase ) */ -/* Subroutine */ int ucase_(char *in, char *out, ftnlen in_len, ftnlen - out_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - static integer lowa, lowz; - integer i__; - static integer shift; - integer ich; - -/* $ Abstract */ - -/* Convert the characters in a string to uppercase. */ - -/* $ 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 */ - -/* ASCII, CHARACTER */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* OUT O Output string, all uppercase. */ - -/* $ Detailed_Input */ - -/* IN is the input string. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is the input string */ -/* with all lowercase letters converted to uppercase. */ -/* Non-letters are not affected. */ - -/* OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Convert each lowercase character in IN to uppercase. */ - -/* $ Examples */ - -/* 'This is an example' becomes 'THIS IS AN EXAMPLE' */ -/* '12345 +-=? > * $ &' '12345 +-=? > * $ &' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 13-MAR-1996 (KRG) */ - -/* Removed the calls to the string lexicographic functions. */ - -/* Modified the algorithm to use the ICHAR() intrinsic function */ -/* and some local integer storage for the bases of the lower and */ -/* upper case letters. */ - -/* Added a "FIRST" clause to the code so that the lower and */ -/* upper case bases and the separation between them are only */ -/* initialized the first time the subroutine is called rather */ -/* than every time. */ - -/* These changes were made to improve the execution speed of */ -/* the subroutine */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert to uppercase */ - -/* -& */ - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial Data */ - - -/* Do some set up stuff the first time through so that we do not */ -/* need to reinitialize the boundary values used for comparisons */ -/* and the shift on each call. */ - - if (first) { - first = FALSE_; - lowa = 'a'; - lowz = 'z'; - shift = 'A' - lowa; - } - -/* Move the string from IN to OUT. Step through OUT one character */ -/* at a time, translating letters between 'a' and 'z' to uppercase. */ - - s_copy(out, in, out_len, in_len); - i__1 = i_len(out, out_len); - for (i__ = 1; i__ <= i__1; ++i__) { - ich = *(unsigned char *)&out[i__ - 1]; - if (ich >= lowa && ich <= lowz) { - *(unsigned char *)&out[i__ - 1] = (char) (ich + shift); - } - } - return 0; -} /* ucase_ */ - diff --git a/ext/spice/src/cspice/ucase_c.c b/ext/spice/src/cspice/ucase_c.c deleted file mode 100644 index 5f1bae2d76..0000000000 --- a/ext/spice/src/cspice/ucase_c.c +++ /dev/null @@ -1,226 +0,0 @@ -/* - --Procedure ucase_c ( Convert to uppercase ) - --Abstract - - Convert the characters in a string to uppercase. - --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 - - ASCII, CHARACTER - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - - void ucase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - in I Input string. - lenout I Maximum length of output string. - out O Output string, all uppercase. - --Detailed_Input - - in is the input string. - - lenout is the maximum allowed length of the output string, - including the terminating null. - --Detailed_Output - - out is the output string. This is the input string - with all lowercase letters converted to uppercase. - Non-letters are not affected. - - If - - lenout < strlen(in)+1 - - the output string will be truncated on the right. - - A terminating null will be placed in out at position - - min ( strlen(in), lenout-1 ) - - unless lenout is less than or equal to zero. - - - out may overwrite in. - --Parameters - - None. - --Particulars - - Convert each lowercase character in IN to uppercase. - --Examples - - "This is an example" becomes "THIS IS AN EXAMPLE" - "12345 +-=? > * $ &" "12345 +-=? > * $ &" - --Restrictions - - None. - --Exceptions - - - 1) If the input string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 2) If the output string pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If lenout is less than or equal to zero, the error - SPICE(STRINGTOOSHORT) will be signaled. - - 4) If the output string is shorter than the input string, the - result will be truncated on the right. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 26-JAN-2005 (NJB) - - Cast to SpiceInt was applied to strlen output to suppress - compiler warnings about comparison of signed and unsigned types. - - -CSPICE Version 2.0.0, 26-AUG-1999 (NJB) - - Added string error checks. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) - - Based on SPICELIB Version 1.1.0, 13-MAR-1996 (KRG) - - --Index_Entries - - convert to uppercase - --& -*/ - -{ /* Begin ucase_c */ - - - /* - Local macros - */ - #define LOWA ( (SpiceInt) ('a') ) - #define LOWZ ( (SpiceInt) ('z') ) - #define SHIFT ( (SpiceInt) ('A') - LOWA ) - - - /* - Local variables - */ - SpiceInt i; - SpiceInt ich; - SpiceInt nmove; - - - - - /* - Check the input string pointer to make sure it's non-null. - */ - CHKPTR( CHK_DISCOVER, "ucase_c", in ); - - - /* - Make sure the output string has at least enough room for one output - character and a null terminator. Also check for a null pointer. - */ - CHKOSTR ( CHK_DISCOVER, "ucase_c", out, lenout ); - - - /* - Move the string from in to out. Step through in one character - at a time, translating letters between 'a' and 'z' to uppercase. - - First, determine how many characters to move. - */ - - nmove = MinVal ( (SpiceInt)strlen(in), lenout-1 ); - - - for ( i = 0; i < nmove; i++ ) - { - ich = (SpiceInt) in[i]; - - if ( ( ich >= LOWA ) && ( ich <= LOWZ ) ) - { - out[i] = (char) ( ich + SHIFT ); - } - else - { - out[i] = in[i]; - } - } - - - /* - Terminate the output string with a null. We know it has room for at - least one character. - */ - out[nmove] = NULLCHAR; - - -} /* End ucase_c */ diff --git a/ext/spice/src/cspice/ucrss.c b/ext/spice/src/cspice/ucrss.c deleted file mode 100644 index f81a65d637..0000000000 --- a/ext/spice/src/cspice/ucrss.c +++ /dev/null @@ -1,191 +0,0 @@ -/* ucrss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UCRSS ( Unitized cross product, 3x3 ) */ -/* Subroutine */ int ucrss_(doublereal *v1, doublereal *v2, doublereal *vout) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - doublereal vmag, maxv1, maxv2; - extern doublereal vnorm_(doublereal *); - doublereal vcross[3], tv1[3], tv2[3]; - -/* $ Abstract */ - -/* Compute the normalized cross product of two 3-vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Left vector for cross product. */ -/* V2 I Right vector for cross product. */ -/* VOUT O Normalized cross product (V1xV2) / |V1xV2|. */ - -/* $ Detailed_Input */ - -/* V1 A 3-vector. */ - -/* V2 A 3-vector. */ - -/* $ Detailed_Output */ - -/* VOUT is the result of the computation (V1xV2)/|V1xV2| */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* To get a unit normal to the plane spanned by two vectors */ -/* V1 and V2. Simply call */ - -/* CALL UCRSS ( V1, V2, NORMAL ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the cross product of V1 and V2 yields the zero-vector, then */ -/* the zero-vector is returned instead of a vector of unit length. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* unitized cross product */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 10-JAN-1989 (WLT) */ - -/* Error free specification added. In addition the algorithm was made */ -/* more robust in the sense that floating point overflows cannot */ -/* occur. */ - -/* -& */ - -/* Get the biggest component of each of the two vectors. */ - -/* Computing MAX */ - d__1 = abs(v1[0]), d__2 = abs(v1[1]), d__1 = max(d__1,d__2), d__2 = abs( - v1[2]); - maxv1 = max(d__1,d__2); -/* Computing MAX */ - d__1 = abs(v2[0]), d__2 = abs(v2[1]), d__1 = max(d__1,d__2), d__2 = abs( - v2[2]); - maxv2 = max(d__1,d__2); - -/* Scale V1 and V2 by 1/MAXV1 and 1/MAXV2 respectively */ - - if (maxv1 != 0.) { - tv1[0] = v1[0] / maxv1; - tv1[1] = v1[1] / maxv1; - tv1[2] = v1[2] / maxv1; - } else { - tv1[0] = 0.; - tv1[1] = 0.; - tv1[2] = 0.; - } - if (maxv2 != 0.) { - tv2[0] = v2[0] / maxv2; - tv2[1] = v2[1] / maxv2; - tv2[2] = v2[2] / maxv2; - } else { - tv2[0] = 0.; - tv2[1] = 0.; - tv2[2] = 0.; - } - -/* Calculate the cross product of V1 and V2 */ - - vcross[0] = tv1[1] * tv2[2] - tv1[2] * tv2[1]; - vcross[1] = tv1[2] * tv2[0] - tv1[0] * tv2[2]; - vcross[2] = tv1[0] * tv2[1] - tv1[1] * tv2[0]; - -/* Get the magnitude of VCROSS and normalize it */ - - vmag = vnorm_(vcross); - if (vmag > 0.) { - vout[0] = vcross[0] / vmag; - vout[1] = vcross[1] / vmag; - vout[2] = vcross[2] / vmag; - } else { - vout[0] = 0.; - vout[1] = 0.; - vout[2] = 0.; - } - return 0; -} /* ucrss_ */ - diff --git a/ext/spice/src/cspice/ucrss_c.c b/ext/spice/src/cspice/ucrss_c.c deleted file mode 100644 index 9df94a25ee..0000000000 --- a/ext/spice/src/cspice/ucrss_c.c +++ /dev/null @@ -1,216 +0,0 @@ -/* - --Procedure ucrss_c ( Unitized cross product, 3x3 ) - --Abstract - - Compute the normalized cross product of two 3-vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef ucrss_c - - - void ucrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Left vector for cross product. - v2 I Right vector for cross product. - vout O Normalized cross product (v1xv2) / |v1xv2|. - --Detailed_Input - - v1 A 3-vector. - - v2 A 3-vector. - --Detailed_Output - - vout is the result of the computation (v1xv2)/|v1xv2| - --Parameters - - None. - --Particulars - - None. - --Examples - - To get a unit normal to the plane spanned by two vectors - v1 and v2. Simply call - - ucrss_c ( v1, v2, normal ); - --Restrictions - - None. - --Exceptions - - Error free. - - 1) If the cross product of v1 and v2 yields the zero-vector, then - the zero-vector is returned instead of a vector of unit length. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - unitized cross product - --& -*/ - -{ /* Begin ucrss_c */ - - - /* - Local variables - */ - - SpiceDouble vcross [ 3 ]; - SpiceDouble vmag; - - SpiceDouble maxv1; - SpiceDouble maxv2; - - SpiceDouble tv1 [ 3 ]; - SpiceDouble tv2 [ 3 ]; - - - /* - Get the biggest component of each of the two vectors. - */ - - maxv1 = MaxAbs( v1[0], v1[1] ); - maxv1 = MaxAbs( maxv1, v1[2] ); - - maxv2 = MaxAbs( v2[0], v2[1] ); - maxv2 = MaxAbs( maxv2, v2[2] ); - - - /* - Scale v1 and v2 by 1/maxv1 and 1/maxv2 respectively - */ - - if ( maxv1 != 0. ) - { - tv1[0] = v1[0]/maxv1; - tv1[1] = v1[1]/maxv1; - tv1[2] = v1[2]/maxv1; - } - else - { - tv1[0] = 0.00; - tv1[1] = 0.00; - tv1[2] = 0.00; - } - - - - if ( maxv2 != 0. ) - { - tv2[0] = v2[0]/maxv2; - tv2[1] = v2[1]/maxv2; - tv2[2] = v2[2]/maxv2; - } - else - { - tv2[0] = 0.00; - tv2[1] = 0.00; - tv2[2] = 0.00; - } - - - /* - Calculate the cross product of v1 and v2 - */ - - vcross[0] = tv1[1]*tv2[2] - tv1[2]*tv2[1]; - vcross[1] = tv1[2]*tv2[0] - tv1[0]*tv2[2]; - vcross[2] = tv1[0]*tv2[1] - tv1[1]*tv2[0]; - - - /* - Get the magnitude of vcross and normalize it - */ - - vmag = vnorm_c( vcross ); - - if ( vmag > 0. ) - { - vout[0] = vcross[0] / vmag; - vout[1] = vcross[1] / vmag; - vout[2] = vcross[2] / vmag; - } - else - { - vout[0] = 0.0; - vout[1] = 0.0; - vout[2] = 0.0; - } - - -} /* End ucrss_c */ diff --git a/ext/spice/src/cspice/uddc.c b/ext/spice/src/cspice/uddc.c deleted file mode 100644 index 0db1c3c236..0000000000 --- a/ext/spice/src/cspice/uddc.c +++ /dev/null @@ -1,201 +0,0 @@ -/* uddc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UDDC ( Derivative of function less than zero, df(x)/dx < 0 ) */ -/* Subroutine */ int uddc_(U_fp udfunc, doublereal *x, doublereal *dx, - logical *isdecr) -{ - extern /* Subroutine */ int uddf_(U_fp, doublereal *, doublereal *, - doublereal *), chkin_(char *, ftnlen); - doublereal deriv; - extern logical failed_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* This routine calculates the derivative of UDFUNC with respect */ -/* to time for X, then determines if the derivative has */ -/* a negative value. */ - -/* $ 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 */ - -/* MATH */ -/* DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UDFUNC I The routine that computes the scalar value */ -/* of interest. */ -/* X I Independent variable of UDFUNC. */ -/* DX I Interval from X for derivative calculation. */ -/* ISDECR O Boolean indicating if the derivative is negative. */ - -/* $ Detailed_Input */ - -/* UDFUNC the routine that returns the value of the scalar */ -/* quantity function of interest at X. The calling */ -/* sequence for UDFUNC is: */ - -/* CALL UDFUNC ( X, VALUE ) */ - -/* where: */ - -/* X the double precision value of the */ -/* independent variable of the function */ -/* at which to determine the scalar value. */ - -/* VALUE the double precision value returned by */ -/* UDFUNC at X. */ - -/* Functionally: */ - -/* VALUE = UDFUNC ( X ) */ - -/* X a scalar double precision value at which to determine */ -/* the derivative of UDFUNC. */ - -/* For many SPICE uses, X will represent ephemeris time, */ -/* expressed as seconds past J2000 TDB. */ - -/* DX a scalar double precision value representing half the */ -/* interval in units of X separating the evaluation */ -/* values of UDFUNC; the evaluations occur at (X + DX) */ -/* and (X - DX). */ - -/* DX may be negative but must be non-zero. */ - -/* $ Detailed_Output */ - -/* ISDECR a scalar boolean indicating if the first derivative */ -/* of UDFUNC with respect to the independent variable */ -/* at X is less than zero. */ - -/* Functionally: */ - -/* d UDFUNC(x) | */ -/* ISDECR = -- | < 0 */ -/* dx | */ -/* X */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) A routine in the call tree of this routine signals */ -/* SPICE(DIVIDEBYZERO) if DX has a value of zero. */ - -/* $ Files */ - -/* If the evaluation of UDFUNC requires SPICE kernel data, the */ -/* appropriate kernels must be loaded before calling this routine. */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer for the time */ -/* used in the evaluation. If aberration corrections are */ -/* used, the states of target and observer relative to the */ -/* solar system barycenter must be calculable from the */ -/* available ephemeris data. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Such kernel data are normally loaded once per program run, NOT */ -/* every time this routine is called. */ - -/* $ Particulars */ - -/* This routine only wraps a UDDF call, examining the sign of the */ -/* derivative value returned by UDDF. */ - -/* $ Examples */ - -/* See GFUDS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* See UDDF header */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 31-MAR-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* first derivative of scalar function less than zero */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - if (return_()) { - return 0; - } - chkin_("UDDC", (ftnlen)4); - *isdecr = FALSE_; - -/* Numerically calculate the derivative of UDFUNC at X. */ - - uddf_((U_fp)udfunc, x, dx, &deriv); - if (failed_()) { - chkout_("UDDC", (ftnlen)4); - return 0; - } - *isdecr = deriv < 0.; - chkout_("UDDC", (ftnlen)4); - return 0; -} /* uddc_ */ - diff --git a/ext/spice/src/cspice/uddc_c.c b/ext/spice/src/cspice/uddc_c.c deleted file mode 100644 index 33e95c24fa..0000000000 --- a/ext/spice/src/cspice/uddc_c.c +++ /dev/null @@ -1,206 +0,0 @@ -/* --Procedure uddc_c ( Derivative of function less than zero, df(x)/dx < 0 ) - --Abstract - - SPICE private routine intended solely for the support of SPICE - routines. Users should not call this routine directly due to the - volatile nature of this routine. - - This routine calculates the derivative of 'udfunc' with respect - to time for 'et', then determines if the derivative has a - negative value. - --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 - - GF - --Keywords - - DERIVATIVE - GEOMETRY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef uddc_c - - void uddc_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - SpiceDouble x, - SpiceDouble dx, - SpiceBoolean * isdecr ) - -/* --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - udfunc I The routine that computes the scalar value - of interest. - x I Independent variable of 'udfunc'. - dx I Interval from 'x' for derivative calculation. - isdecr O Boolean indicating if the derivative is negative. - --Detailed_Input - - udfunc the routine that returns the value of the scalar quantity - function of interest at X. The calling sequence for UDFUNC is: - - udfunc ( x, &value ); - - where: - - x the double precision value of the - independent variable of the function - at which to determine the scalar value. - - value the double precision value returned by - 'udfunc' at 'x'. - - Functionally: - - value = udfunc ( x ) - - x a scalar double precision value at which to determine - the derivative of 'udfunc'. - - For many SPICE uses, 'x' will represent ephemeris time, - expressed as seconds past J2000 TDB. - - dx a scalar double precision value representing half the - interval in units of 'x' separating the evaluation - values of 'udfunc'; the evaluations occur at (x + dx) - and (x - dx). - - 'dx' may be negative but must be non-zero. - --Detailed_Output - - isdecr a scalar boolean indicating if the first derivative - of 'udfunc' with respect to time at 'et' is less than - zero. - - Functionally: - - d udfunc(x) | - -- | < 0 - dx | - x - --Parameters - - None. - --Exceptions - - 1) A routine in the call tree of this routine signals - SPICE(DIVIDEBYZERO) if DX has a value of zero. - --Files - - If the evaluation of 'udfunc' requires SPICE kernel data, the - appropriate kernels must be loaded before calling this routine. - - - SPK data: the calling application must load ephemeris data - for the targets, observer, and any intermediate objects in - a chain connecting the targets and observer for the time - used in the evaluation. If aberration corrections are used, - the states of target and observer relative to the solar system - barycenter must be calculable from the available ephemeris - data. - - - If non-inertial reference frames are used, then PCK - files, frame kernels, C-kernels, and SCLK kernels may be - needed. - - Such kernel data are normally loaded once per program run, NOT - every time this routine is called. - --Particulars - - None. - --Examples - - See gfuds_c. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 31-MAR-2010 (EDW) - --Index_Entries - - first derivative less-than zero - --& -*/ - - { - - SpiceDouble deriv; - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "uddc_c" ); - - *isdecr = SPICEFALSE; - - uddf_c ( udfunc, x, dx, &deriv ); - - if ( failed_c() ) - { - chkout_c ( "uddc_c" ); - return; - } - - *isdecr = deriv < 0.; - - chkout_c ( "uddc_c" ); - return; - } diff --git a/ext/spice/src/cspice/uddf.c b/ext/spice/src/cspice/uddf.c deleted file mode 100644 index 7cb4e7304d..0000000000 --- a/ext/spice/src/cspice/uddf.c +++ /dev/null @@ -1,311 +0,0 @@ -/* uddf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UDDF ( First derivative of a function, df(x)/dx ) */ -/* Subroutine */ int uddf_(S_fp udfunc, doublereal *x, doublereal *dx, - doublereal *deriv) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - doublereal dfdx[1]; - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal udval[2]; - extern logical failed_(void); - extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Routine to calculate the first derivative of a caller-specified */ -/* scalar function using a three-point estimation. */ - -/* $ 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 */ - -/* MATH */ -/* DERIVATIVE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UDFUNC I The routine that computes the scalar value */ -/* of interest. */ -/* X I Independent variable of UDFUNC. */ -/* DX I Interval from X for derivative calculation. */ -/* DERIV O Approximate derivative of UDFUNC at X. */ - -/* $ Detailed_Input */ - -/* UDFUNC the routine that returns the value of the scalar */ -/* quantity function of interest at X. The calling */ -/* sequence for UDFUNC is: */ - -/* CALL UDFUNC ( X, VALUE ) */ - -/* where: */ - -/* X the double precision value of the */ -/* independent variable of the function */ -/* at which to determine the scalar value. */ - -/* VALUE the double precision value returned by */ -/* UDFUNC at X. */ - -/* Functionally: */ - -/* VALUE = UDFUNC ( X ) */ - -/* X a scalar double precision value at which to determine */ -/* the derivative of UDFUNC. */ - -/* For many SPICE uses, X will represent ephemeris time, */ -/* expressed as seconds past J2000 TDB. */ - -/* DX a scalar double precision value representing half the */ -/* interval in units of X separating the evaluation */ -/* values of UDFUNC; the evaluations occur at (X + DX) */ -/* and (X - DX). */ - -/* DX may be negative but must be non-zero. */ - -/* $ Detailed_Output */ - -/* DERIV the scalar double precision approximate value of the */ -/* first derivative of UDFUNC with respect to X. */ - -/* Functionally: */ - -/* d UDFUNC ( x ) | */ -/* DERIV = -- | */ -/* dx | */ -/* X */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) A routine in the call tree of this routine signals */ -/* SPICE(DIVIDEBYZERO) if DX has a value of zero. */ - -/* $ Files */ - -/* If the evaluation of UDFUNC requires SPICE kernel data, the */ -/* appropriate kernels must be loaded before calling this routine. */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the targets, observer, and any intermediate objects in */ -/* a chain connecting the targets and observer for the time */ -/* used in the evaluation. If aberration corrections are */ -/* used, the states of target and observer relative to the */ -/* solar system barycenter must be calculable from the */ -/* available ephemeris data. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* Such kernel data are normally loaded once per program run, NOT */ -/* every time this routine is called. */ - -/* $ Particulars */ - -/* This routine provides a simple interface to numerically calculate */ -/* the first derivative of a scalar quantity function, UDFUNC. */ -/* UDFUNC is expected to be "well behaved" across at the evaluation */ -/* interval [ X - DX, X + DX ]. This means a linear approximation to */ -/* the function over the interval is sufficiently accurate to */ -/* calculate the approximate derivative at X. */ - -/* The routine QDERIV performs the differentiation using a three */ -/* point estimation. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* Calculate the time derivative of the light time corresponding to */ -/* the apparent position of Mercury relative to the Moon at */ -/* time "JAN 1 2009." */ - -/* PROGRAM UDDF_T */ - -/* EXTERNAL UDFUNC */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION DT */ -/* DOUBLE PRECISION DERIV */ - -/* C */ -/* C Load leapsecond and SPK kernels. The name of the */ -/* C meta kernel file shown here is fictitious; you */ -/* C must supply the name of a file available */ -/* C on your own computer system. */ -/* C */ -/* CALL FURNSH ( 'standard.tm' ) */ - -/* C */ -/* C Use a shift of one second off the epoch of interest. */ -/* C */ -/* DT = 1.D0 */ - -/* C */ -/* C Convert the epoch date string to ephemeris seconds. */ -/* C */ -/* CALL STR2ET ( 'JAN 1 2009', ET ) */ - -/* C */ -/* C Calculate the derivative of UDFUNC at ET. */ -/* C */ -/* CALL UDDF ( UDFUNC, ET, DT, DERIV ) */ - -/* C */ -/* C Output the calculated derivative. */ -/* C */ -/* WRITE(*,*) DERIV */ - -/* END */ - -/* C */ -/* C A scalar quantity function that returns the light-time */ -/* C between the Moon and Mercury at ET. */ -/* C */ -/* SUBROUTINE UDFUNC ( ET, VALUE ) */ - -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION VALUE */ - -/* DOUBLE PRECISION POS (3) */ -/* DOUBLE PRECISION LT */ - -/* C */ -/* C Evaluate the apparent position of Mercury with respect */ -/* C to the Moon at ET. */ -/* C */ -/* CALL SPKPOS ( 'MERCURY', ET, 'J2000', 'LT+S', 'MOON', */ -/* . POS, LT ) */ - -/* C */ -/* C Return the light-time value as the scalar quantity. */ -/* C */ -/* VALUE = LT */ - -/* END */ - -/* The program outputs (OS X Intel run): */ - -/* -0.00013567094 */ - -/* $ Restrictions */ - -/* The function UDFUNC must exist everywhere within [X - DX, X + DX]. */ - -/* $ Literature_References */ - -/* See QDERIV header */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 31-MAR-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* first derivative of a user-defined scalar function */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - if (return_()) { - return 0; - } - chkin_("UDDF", (ftnlen)4); - -/* Apply a three-point estimation of the derivative for */ -/* UDFUNC at X by evaluating UDFUNC at [X-DX, X+DX]. */ - -/* The QDERIV call returns a single value in the DFDX array. */ - - n = 1; - -/* Evaluate the scalar function at the interval boundaries. */ -/* Check for a FAILED event. */ - - d__1 = *x - *dx; - (*udfunc)(&d__1, udval); - if (failed_()) { - chkout_("UDDF", (ftnlen)4); - return 0; - } - d__1 = *x + *dx; - (*udfunc)(&d__1, &udval[1]); - if (failed_()) { - chkout_("UDDF", (ftnlen)4); - return 0; - } - -/* Estimate the derivative at X. */ - - qderiv_(&n, udval, &udval[1], dx, dfdx); - if (failed_()) { - chkout_("UDDF", (ftnlen)4); - return 0; - } - *deriv = dfdx[0]; - chkout_("UDDF", (ftnlen)4); - return 0; -} /* uddf_ */ - diff --git a/ext/spice/src/cspice/uddf_c.c b/ext/spice/src/cspice/uddf_c.c deleted file mode 100644 index 6c01009eb5..0000000000 --- a/ext/spice/src/cspice/uddf_c.c +++ /dev/null @@ -1,274 +0,0 @@ -/* - --Procedure uddf_c ( First derivative of a function, df(x)/dx ) - --Abstract - - Routine to calculate the first derivative of a caller-specified - function using a three-point estimation. - --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 - - DERIVATIVE - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef uddf_c - - void uddf_c ( void ( * udfunc ) ( SpiceDouble et, - SpiceDouble * value ), - SpiceDouble x, - SpiceDouble dx, - SpiceDouble * deriv ) - -/* --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - udfunc I Name of the routine that computes the scalar value - of interest. - x I Independent variable of 'udfunc' - dx I Interval from 'x' for derivative calculation - deriv O Approximate derivative of 'udfunc' at 'x' - --Detailed_Input - - udfunc is an externally specified routine that returns the - value of the scalar quantity function of interest - at x. - - The prototype for 'udfunc' is - - void ( * udfunc ) ( SpiceDouble et, - SpiceDouble * value ) - - where: - - et an input double precision value of the independent - variable the function at which to determine the - scalar value. - - value the scalar double precision value of 'udfunc' - at 'x'. - - x a scalar double precision value representing the independent - variable at which to determine the derivative of 'udfunc'. - - For many SPICE uses, 'x' will represent the TDB ephemeris - time. - - dx a scalar double precision value representing half the - interval in units of X separating the evaluation - epochs of UDFUNC; the evaluations occur at (x + dx)) - and (x - dx). - - 'dx' may be negative but must be non-zero. - --Detailed_Output - - deriv the scalar double precision approximate value of the - first derivative of udfunc with respect to 'x'. - - Functionally: - - d udfunc ( x ) - deriv = -- - dx - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - This routine provides a simple interface to numerically calculate - the first derivative of a scalar quantity function. - --Examples - - The numerical results shown for these examples may differ across - platforms. The results depend on the SPICE kernels used as - input, the compiler and supporting libraries, and the machine - specific arithmetic implementation. - - - #include - #include "SpiceUsr.h" - - void udfunc ( SpiceDouble et, SpiceDouble * value ); - - int main() - { - - SpiceDouble et; - SpiceDouble dt; - SpiceDouble deriv; - - /. - Load leapsecond and SPK kernels. The name of the - meta kernel file shown here is fictitious; you - must supply the name of a file available - on your own computer system. - ./ - - furnsh_c ( "standard.tm" ); - - /. - Use a shift of one second off the epoch of interest. - ./ - dt = 1.; - - /. - Convert the epoch date string to ephemeris seconds. - ./ - str2et_c ( "JAN 1 2009", &et ); - - /. - Calculate the derivative of UDFUNC at ET. - ./ - uddf_c( udfunc, et, dt, &deriv ); - - /. - Output the calculated derivative. - ./ - - printf( "%18.12f\n", deriv ); - - return ( 0 ); - } - - - /. - A scalar quantity function that returns the light-time - between the Moon and Mercury at 'et'. - ./ - - void udfunc ( SpiceDouble et, SpiceDouble * value ) - { - - SpiceDouble lt; - SpiceDouble pos[3]; - - /. - Evaluate the apparent position of Mercury with respect - to the Moon at 'et'. - ./ - spkpos_c ( "MERCURY", et, "J2000", "LT+S", "MOON", pos, < ); - - /. - Return the light-time value as the scalar quantity. - ./ - *value = lt; - - return; - } - - The program outputs: - - -0.000135670940 - --Restrictions - - 'udfunc' must evaluate to real values at x + dx and x - dx. - --Literature_References - - See qderiv.c header. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - CSPICE Version 1.0.0 31-MAR-2010 (EDW) - --Index_Entries - - first derivative of a function - --& -*/ - - { /* Begin uddf_c */ - - /* - Local variables - */ - - SpiceInt n; - SpiceDouble dfdx [1]; - SpiceDouble udval [2]; - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "uddf_c" ); - - /* - Apply a three-point estimation of the derivative for 'udfunc' at - 'x' by evaluating udfunc at [x-dx, x+dx]. - - The qderiv_ call returns a single value in the 'dfdx' array. - */ - n = 1; - - udfunc ( x - dx, &(udval[0]) ); - udfunc ( x + dx, &(udval[1]) ); - - (void) qderiv_( (integer *) &n, - (doublereal *) &(udval[0]), - (doublereal *) &(udval[1]), - (doublereal *) &dx, - (doublereal *) dfdx ); - - *deriv = dfdx[0]; - - chkout_c ( "uddf_c" ); - } - diff --git a/ext/spice/src/cspice/uio.c b/ext/spice/src/cspice/uio.c deleted file mode 100644 index e40875e0f7..0000000000 --- a/ext/spice/src/cspice/uio.c +++ /dev/null @@ -1,68 +0,0 @@ -#include "f2c.h" -#include "fio.h" -uiolen f__reclen; - -#ifdef KR_headers -do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len; -#else -do_us(ftnint *number, char *ptr, ftnlen len) -#endif -{ - if(f__reading) - { - f__recpos += (int)(*number * len); - if(f__recpos>f__reclen) - err(f__elist->cierr, 110, "do_us"); - if (fread(ptr,(int)len,(int)(*number),f__cf) != *number) - err(f__elist->ciend, EOF, "do_us"); - return(0); - } - else - { - f__reclen += *number * len; - (void) fwrite(ptr,(int)len,(int)(*number),f__cf); - return(0); - } -} -#ifdef KR_headers -integer do_ud(number,ptr,len) ftnint *number; char *ptr; ftnlen len; -#else -integer do_ud(ftnint *number, char *ptr, ftnlen len) -#endif -{ - f__recpos += (int)(*number * len); - if(f__recpos > f__curunit->url && f__curunit->url!=1) - err(f__elist->cierr,110,"do_ud"); - if(f__reading) - { -#ifdef Pad_UDread -#ifdef KR_headers - int i; -#else - size_t i; -#endif - if (!(i = fread(ptr,(int)len,(int)(*number),f__cf)) - && !(f__recpos - *number*len)) - err(f__elist->cierr,EOF,"do_ud") - if (i < *number) - memset(ptr + i*len, 0, (*number - i)*len); - return 0; -#else - if(fread(ptr,(int)len,(int)(*number),f__cf) != *number) - err(f__elist->cierr,EOF,"do_ud") - else return(0); -#endif - } - (void) fwrite(ptr,(int)len,(int)(*number),f__cf); - return(0); -} -#ifdef KR_headers -integer do_uio(number,ptr,len) ftnint *number; char *ptr; ftnlen len; -#else -integer do_uio(ftnint *number, char *ptr, ftnlen len) -#endif -{ - if(f__sequential) - return(do_us(number,ptr,len)); - else return(do_ud(number,ptr,len)); -} diff --git a/ext/spice/src/cspice/union_c.c b/ext/spice/src/cspice/union_c.c deleted file mode 100644 index d5fd096618..0000000000 --- a/ext/spice/src/cspice/union_c.c +++ /dev/null @@ -1,377 +0,0 @@ -/* - --Procedure union_c ( Union of two sets ) - --Abstract - - Compute the union of two sets of any data type to form a third set. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void union_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I First input set. - b I Second input set. - c O Union of a and b. - --Detailed_Input - - a is a CSPICE set. a must be declared as a SpiceCell - of data type character, double precision, or integer. - - b is a CSPICE set, distinct from a. b must have the - same data type as a. - --Detailed_Output - - c is a CSPICE set, distinct from sets a and b, which - contains the union of a and b (that is, all of - the elements which are in a or b or both). c must - have the same data type as a and b. - - When comparing elements of character sets, this routine - ignores trailing blanks. Trailing blanks will be - trimmed from the members of the output set c. - --Parameters - - None. - --Exceptions - - 1) If the input set arguments don't have identical data types, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the union of the two sets contains more elements than can be - contained in the output set, the error SPICE(SETEXCESS) is signaled. - - 3) If the set arguments have character type and the length of the - elements of the output set is less than the maximum of the - lengths of the elements of the input sets, the error - SPICE(ELEMENTSTOOSHORT) is signaled. - - 4) If either of the input arguments may be unordered or contain - duplicates, the error SPICE(NOTASET) is signaled. - --Files - - None. - --Particulars - - This is a generic CSPICE set routine; it operates on sets of any - supported data type. - - The union of two sets contains every element which is - in the first set, or in the second set, or in both sets. - - {a,b} union {c,d} = {a,b,c,d} - {a,b,c} {b,c,d} {a,b,c,d} - {a,b,c,d} {} {a,b,c,d} - {} {a,b,c,d} {a,b,c,d} - {} {} {} - --Examples - - 1) The following code fragment places the union of the character sets - planets and asteroids into the character set result. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with string length NAMLEN and with maximum - number of elements MAXSIZ. - ./ - SPICECHAR_CELL ( planets, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( asteroids, MAXSIZ, NAMLEN ); - SPICECHAR_CELL ( result, MAXSIZ, NAMLEN ); - . - . - . - /. - Compute the union. - ./ - union_c ( &planets, &asteroids, &result ); - - - 2) Repeat example #1, this time using integer sets containing - ID codes of the bodies of interest. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEINT_CELL ( planets, MAXSIZ ); - SPICEINT_CELL ( asteroids, MAXSIZ ); - SPICEINT_CELL ( result, MAXSIZ ); - . - . - . - /. - Compute the union. - ./ - union_c ( &planets, &asteroids, &result ); - - - 3) Construct a set containing the periapse and apoapse TDB epochs - of an orbiter, given two separate sets containing the epochs of - those events. - - - #include "SpiceUsr.h" - . - . - . - /. - Declare the sets with maximum number of elements MAXSIZ. - ./ - SPICEDOUBLE_CELL ( periapse, MAXSIZ ); - SPICEDOUBLE_CELL ( apoapse, MAXSIZ ); - SPICEDOUBLE_CELL ( result, MAXSIZ ); - . - . - . - /. - Compute the union. - ./ - union_c ( &periapse, &apoapse, &result ); - - --Restrictions - - 1) The output set must be distinct from both of the input sets. - For example, the following calls are invalid. - - union_c ( ¤t, &new, ¤t ); - union_c ( &new, ¤t, ¤t ); - - In each of the examples above, whether or not the subroutine - signals an error, the results will almost certainly be wrong. - Nearly the same effect can be achieved, however, by placing the - result into a temporary set, which is immediately copied back - into one of the input sets, as shown below. - - union_c ( ¤t, &new, &temp ); - copy_c ( &temp, &new ); - - - 2) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input sets 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) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 15-FEB-2005 (NJB) - - Bug fix: loop bound changed from 2 to 3 in loop used - to free dynamically allocated arrays. - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - union of two sets - --& -*/ - - -{ /* Begin union_c */ - - - /* - Local variables - */ - SpiceChar * fCell[3]; - - SpiceInt fLen [3]; - SpiceInt i; - - - /* - Standard SPICE error handling. - */ - if ( return_c() ) - { - return; - } - - chkin_c ( "union_c" ); - - /* - Make sure data types match. - */ - CELLMATCH3 ( CHK_STANDARD, "union_c", a, b, c ); - - /* - Make sure the input cells are sets. - */ - CELLISSETCHK2 ( CHK_STANDARD, "union_c", a, b ); - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - /* - Call the union routine appropriate for the data type of the cells. - */ - if ( a->dtype == SPICE_CHR ) - { - - /* - Construct Fortran-style sets suitable for passing to unionc_. - */ - C2F_MAP_CELL3 ( "", - a, fCell, fLen, - b, fCell+1, fLen+1, - c, fCell+2, fLen+2 ); - - - if ( failed_c() ) - { - chkout_c ( "union_c" ); - return; - } - - - unionc_ ( (char * ) fCell[0], - (char * ) fCell[1], - (char * ) fCell[2], - (ftnlen ) fLen[0], - (ftnlen ) fLen[1], - (ftnlen ) fLen[2] ); - - /* - Map the union back to a C style cell. - */ - F2C_MAP_CELL ( fCell[2], fLen[2], c ); - - - /* - We're done with the dynamically allocated Fortran-style arrays. - */ - for ( i = 0; i < 3; i++ ) - { - free ( fCell[i] ); - } - - } - - else if ( a->dtype == SPICE_DP ) - { - uniond_ ( (doublereal * ) (a->base), - (doublereal * ) (b->base), - (doublereal * ) (c->base) ); - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - } - - else if ( a->dtype == SPICE_INT ) - { - unioni_ ( (integer * ) (a->base), - (integer * ) (b->base), - (integer * ) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - } - - else - { - setmsg_c ( "Cell a contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (a->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "union_c" ); - return; - } - - - /* - Indicate the result is a set. - */ - c->isSet = SPICETRUE; - - - chkout_c ( "union_c" ); - -} /* End union_c */ diff --git a/ext/spice/src/cspice/unionc.c b/ext/spice/src/cspice/unionc.c deleted file mode 100644 index 29e0b976ba..0000000000 --- a/ext/spice/src/cspice/unionc.c +++ /dev/null @@ -1,324 +0,0 @@ -/* unionc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UNIONC ( Union two character sets ) */ -/* Subroutine */ int unionc_(char *a, char *b, char *c__, ftnlen a_len, - ftnlen b_len, ftnlen c_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen, - ftnlen); - - /* Local variables */ - integer over, acard, bcard; - extern integer cardc_(char *, ftnlen); - integer ccard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - integer csize; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - integer apoint, bpoint; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), excess_(integer *, char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Union two character sets to form a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Union of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the union of A and B (that is, all of */ -/* the elements which are in A or B or both). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the union of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The UNION of two sets contains every element which is */ -/* in the first set, or in the second set, or in both sets. */ - -/* {a,b} union {c,d} = {a,b,c,d} */ -/* {a,b,c} {b,c,d} {a,b,c,d} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {a,b,c,d} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL UNIONC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the union of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL UNIONI ( CURRENT, NEW, CURRENT ) */ -/* CALL UNIONI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL UNIONI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the union of the two sets causes an excess of elements, the */ -/* error SPICE(SETEXCESS) is signalled. */ - -/* 2) If length of the elements of the output set is < the */ -/* maximum of the lengths of the elements of the input */ -/* sets, the error SPICE(ELEMENTSTOOSHORT) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Made CHKOUT calls consistent with CHKIN. */ - -/* - 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* union two character sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 05-JAN-1989 (NJB) */ - -/* Error signalled if output set elements are not long enough. */ -/* Length must be at least max of lengths of input elements. */ -/* Also, calling protocol for EXCESS has been changed. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("UNIONC", (ftnlen)6); - -/* Make sure output set elements are long enough. */ - -/* Computing MAX */ - i__1 = i_len(a, a_len), i__2 = i_len(b, b_len); - if (i_len(c__, c_len) < max(i__1,i__2)) { - setmsg_("Length of output cell is #. Length required to contain res" - "ult is #.", (ftnlen)68); - i__1 = i_len(c__, c_len); - errint_("#", &i__1, (ftnlen)1); -/* Computing MAX */ - i__2 = i_len(a, a_len), i__3 = i_len(b, b_len); - i__1 = max(i__2,i__3); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(ELEMENTSTOOSHORT)", (ftnlen)23); - chkout_("UNIONC", (ftnlen)6); - return 0; - } - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardc_(a, a_len); - bcard = cardc_(b, b_len); - csize = sizec_(c__, c_len); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the ends of both input sets are reached, we're done. */ - - while(apoint <= acard || bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (apoint > acard) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, b + (bpoint + 5) * b_len, - c_len, b_len); - ++bpoint; - } else if (bpoint > bcard) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - } else if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len) == 0) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, a + (apoint + 5) * a_len, - c_len, a_len); - ++apoint; - } else if (l_gt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++ccard; - s_copy(c__ + (ccard + 5) * c_len, b + (bpoint + 5) * b_len, - c_len, b_len); - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (apoint > acard) { - ++over; - ++bpoint; - } else if (bpoint > bcard) { - ++over; - ++apoint; - } else if (s_cmp(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len) == 0) { - ++over; - ++apoint; - ++bpoint; - } else if (l_lt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++over; - ++apoint; - } else if (l_gt(a + (apoint + 5) * a_len, b + (bpoint + 5) * - b_len, a_len, b_len)) { - ++over; - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardc_(&ccard, c__, c_len); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("UNIONC", (ftnlen)6); - return 0; -} /* unionc_ */ - diff --git a/ext/spice/src/cspice/uniond.c b/ext/spice/src/cspice/uniond.c deleted file mode 100644 index 568ecce784..0000000000 --- a/ext/spice/src/cspice/uniond.c +++ /dev/null @@ -1,272 +0,0 @@ -/* uniond.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UNIOND ( Union two double precision sets ) */ -/* Subroutine */ int uniond_(doublereal *a, doublereal *b, doublereal *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Union two double precision sets to form a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Union of A and B. */ - -/* $ Detailed_Input */ - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the union of A and B (that is, all of */ -/* the elements which are in A or B or both). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the union of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The UNION of two sets contains every element which is */ -/* in the first set, or in the second set, or in both sets. */ - -/* {a,b} union {c,d} = {a,b,c,d} */ -/* {a,b,c} {b,c,d} {a,b,c,d} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {a,b,c,d} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL UNIONC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the union of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL UNIONI ( CURRENT, NEW, CURRENT ) */ -/* CALL UNIONI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL UNIONI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the union of the two sets causes an excess of elements, the */ -/* error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* union two d.p. sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 05-JAN-1989 (NJB) */ - -/* Calling protocol for EXCESS updated. Call to SETMSG */ -/* deleted. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("UNIOND", (ftnlen)6); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the ends of both input sets are reached, we're done. */ - - while(apoint <= acard || bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (apoint > acard) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } else if (bpoint > bcard) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] > b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (apoint > acard) { - ++over; - ++bpoint; - } else if (bpoint > bcard) { - ++over; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++over; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++over; - ++apoint; - } else if (a[apoint + 5] > b[bpoint + 5]) { - ++over; - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardd_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("UNIOND", (ftnlen)6); - return 0; -} /* uniond_ */ - diff --git a/ext/spice/src/cspice/unioni.c b/ext/spice/src/cspice/unioni.c deleted file mode 100644 index 14d584bfbb..0000000000 --- a/ext/spice/src/cspice/unioni.c +++ /dev/null @@ -1,273 +0,0 @@ -/* unioni.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UNIONI ( Union two integer sets ) */ -/* Subroutine */ int unioni_(integer *a, integer *b, integer *c__) -{ - integer over, acard, bcard, ccard; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *); - integer apoint, bpoint; - extern /* Subroutine */ int excess_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Union two integer sets to form a third set. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First input set. */ -/* B I Second input set. */ -/* C O Union of A and B. */ - -/* $ Detailed_Input */ - - -/* A is a set. */ - - -/* B is a set, distinct from A. */ - -/* $ Detailed_Output */ - -/* C is a set, distinct from sets A and B, which */ -/* contains the union of A and B (that is, all of */ -/* the elements which are in A or B or both). */ - -/* If the size (maximum cardinality) of C is smaller */ -/* than the cardinality of the union of A and B, */ -/* then only as many items as will fit in C are */ -/* included, and an error is signalled. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* The UNION of two sets contains every element which is */ -/* in the first set, or in the second set, or in both sets. */ - -/* {a,b} union {c,d} = {a,b,c,d} */ -/* {a,b,c} {b,c,d} {a,b,c,d} */ -/* {a,b,c,d} {} {a,b,c,d} */ -/* {} {a,b,c,d} {a,b,c,d} */ -/* {} {} {} */ - -/* The following call */ - -/* CALL UNIONC ( PLANETS, ASTEROIDS, RESULT ) */ - -/* places the union of the character sets PLANETS and */ -/* ASTEROIDS into the character set RESULT. */ - -/* The output set must be distinct from both of the input sets. */ -/* For example, the following calls are invalid. */ - -/* CALL UNIONI ( CURRENT, NEW, CURRENT ) */ -/* CALL UNIONI ( NEW, CURRENT, CURRENT ) */ - -/* In each of the examples above, whether or not the subroutine */ -/* signals an error, the results will almost certainly be wrong. */ -/* Nearly the same effect can be achieved, however, by placing the */ -/* result into a temporary set, which is immediately copied back */ -/* into one of the input sets, as shown below. */ - -/* CALL UNIONI ( CURRENT, NEW, TEMP ) */ -/* CALL COPYI ( TEMP, NEW ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the union of the two sets causes an excess of elements, the */ -/* error SPICE(SETEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* union two integer sets */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 05-JAN-1989 (NJB) */ - -/* Calling protocol for EXCESS updated. Call to SETMSG */ -/* deleted. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("UNIONI", (ftnlen)6); - -/* Find the cardinality of the input sets, and the allowed size */ -/* of the output set. */ - - acard = cardi_(a); - bcard = cardi_(b); - csize = sizei_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input sets. The cardinality of the output set is zero. */ -/* And there is no overflow so far. */ - - apoint = 1; - bpoint = 1; - ccard = 0; - over = 0; - -/* When the ends of both input sets are reached, we're done. */ - - while(apoint <= acard || bpoint <= bcard) { - -/* If there is still space in the output set, fill it */ -/* as necessary. */ - - if (ccard < csize) { - if (apoint > acard) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } else if (bpoint > bcard) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = a[apoint + 5]; - ++apoint; - } else if (a[apoint + 5] > b[bpoint + 5]) { - ++ccard; - c__[ccard + 5] = b[bpoint + 5]; - ++bpoint; - } - -/* Otherwise, stop filling the array, but continue to count the */ -/* number of elements in excess of the size of the output set. */ - - } else { - if (apoint > acard) { - ++over; - ++bpoint; - } else if (bpoint > bcard) { - ++over; - ++apoint; - } else if (a[apoint + 5] == b[bpoint + 5]) { - ++over; - ++apoint; - ++bpoint; - } else if (a[apoint + 5] < b[bpoint + 5]) { - ++over; - ++apoint; - } else if (a[apoint + 5] > b[bpoint + 5]) { - ++over; - ++bpoint; - } - } - } - -/* Set the cardinality of the output set. */ - - scardi_(&ccard, c__); - -/* Report any excess. */ - - if (over > 0) { - excess_(&over, "set", (ftnlen)3); - sigerr_("SPICE(SETEXCESS)", (ftnlen)16); - } - chkout_("UNIONI", (ftnlen)6); - return 0; -} /* unioni_ */ - diff --git a/ext/spice/src/cspice/unitim.c b/ext/spice/src/cspice/unitim.c deleted file mode 100644 index 9babb9450b..0000000000 --- a/ext/spice/src/cspice/unitim.c +++ /dev/null @@ -1,652 +0,0 @@ -/* unitim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__4 = 4; -static integer c__7 = 7; -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__14 = 14; - -/* $Procedure UNITIM ( Uniform time scale transformation ) */ -doublereal unitim_(doublereal *epoch, char *insys, char *outsys, ftnlen - insys_len, ftnlen outsys_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char missed[20*4] = "DELTET/DELTA_T_A, # " "DELTET/K, # " - "DELTET/EB, # " "DELTET/M, # "; - static logical nodata = TRUE_; - static char vars__[16*4] = "DELTET/DELTA_T_A" "DELTET/K " "DELTET" - "/EB " "DELTET/M "; - - /* System generated locals */ - address a__1[14]; - integer i__1[14], i__2; - doublereal ret_val; - char ch__1[714]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - double sin(doublereal); - - /* Local variables */ - extern logical setc_(char *, char *, char *, ftnlen, ftnlen, ftnlen); - char myin[8]; - integer i__; - static doublereal k, m[2]; - integer n; - extern logical elemc_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char recog[8*13]; - logical intdb; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - logical found[4], intdt; - char types[8*8], myout[8]; - static doublereal eb; - extern logical failed_(void); - extern /* Subroutine */ int validc_(integer *, integer *, char *, ftnlen); - static char bslash[1]; - static doublereal secspd; - logical update; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen), unionc_(char *, char *, char - *, ftnlen, ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen), ssizec_(integer *, char *, ftnlen); - logical outtdb; - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen); - extern logical somfls_(logical *, integer *); - doublereal mytime; - static char typtdb[8*10]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), insrtc_(char *, char - *, ftnlen, ftnlen); - extern logical return_(void); - logical outtdt; - extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen, - ftnlen); - static char typtdt[8*9]; - extern doublereal j2000_(void); - static doublereal dta; - doublereal tdb; - extern doublereal spd_(void); - doublereal tdt; - static doublereal jd2000; - -/* $ Abstract */ - -/* Transform time from one uniform scale to another. The uniform */ -/* time scales are TAI, TDT, TDB, ET, JED, JDTDB, JDTDT. */ - -/* $ 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 */ - -/* TIME */ - -/* $ Keywords */ - -/* TIME */ -/* CONVERSION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EPOCH I An epoch. */ -/* INSYS I The time scale associated with the input EPOCH. */ -/* OUTSYS I The time scale associated with the function value. */ - -/* The function returns the d.p. in OUTSYS that is equivalent to the */ -/* EPOCH on the INSYS time scale. */ - -/* $ Detailed_Input */ - -/* EPOCH is an epoch relative to the INSYS time scale. */ - -/* INSYS is a time scale. Acceptable values are: */ - -/* 'TAI' International Atomic Time. */ -/* 'TDB' Barycentric Dynamical Time. */ -/* 'TDT' Terrestrial Dynamical Time. */ -/* 'ET' Ephemeris time (in the SPICE system, this is */ -/* equivalent to TDB). */ -/* 'JDTDB' Julian Date relative to TDB. */ -/* 'JDTDT' Julian Date relative to TDT. */ -/* 'JED' Julian Ephemeris date (in the SPICE system */ -/* this is equivalent to JDTDB). */ - -/* The routine is not sensitive to the case of the */ -/* characters in INSYS; 'tai' 'Tai' and 'TAI' are */ -/* all equivalent from the point of view of this routine. */ - -/* OUTSYS is the time scale to which EPOCH should be converted. */ -/* Acceptable values are the same as for INSYS. The */ -/* routine is not sensitive to the case of OUTSYS. */ - -/* $ Detailed_Output */ - -/* The function returns the time in the system specified by OUTSYS */ -/* that is equivalent to the EPOCH in the INSYS time scale. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The kernel pool must contain the variables: */ - -/* 'DELTET/DELTA_T_A' */ -/* 'DELTET/K' */ -/* 'DELTET/EB' */ -/* 'DELTET/M' */ - -/* If these are not present, the error 'SPICE(MISSINGTIMEINFO)' */ -/* will be signalled. (These variables are typically inserted */ -/* into the kernel pool by loading a leapseconds kernel with */ -/* the SPICE routine FURNSH.) */ - -/* 2) If the names of either the input or output time types are */ -/* unrecognized, the error 'SPICE(BADTIMETYPE)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* We use the term uniform time scale to refer to those */ -/* representations of time that are numeric (each epoch is */ -/* represented by a number) and additive. A numeric time */ -/* system is additive if given the representations, E1 and E2, */ -/* of any pair of successive epochs, the time elapsed between */ -/* the epochs is given by E2 - E1. */ - -/* Given an epoch in one of the uniform time scales */ -/* specified by INSYS, the function returns the equivalent */ -/* representation in the scale specified by OUTSYS. A list */ -/* of the recognized uniform time scales is given in the */ -/* detailed input for INSYS. */ - -/* $ Examples */ - -/* To convert an epoch with respect to the International Atomic */ -/* Time (TAI) scale to ET (Barycentric Dynamical Time), make the */ -/* following assignment. */ - -/* ET = UNITIM ( TAI, 'TAI', 'ET' ) */ - -/* $ Restrictions */ - -/* The appropriate variable must be loaded into the SPICE kernel pool */ -/* (normally by loading a leapseconds kernel with FURNSH) prior to */ -/* calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 05-MAR-2009 (NJB) */ - -/* This routine now keeps track of whether its kernel pool */ -/* look-up failed. If so, a kernel pool lookup is attempted on */ -/* the next call to this routine. This change is an enhancement, */ -/* not a bug fix (unlike similar modifications in SCLK routines). */ - -/* - SPICELIB Version 1.2.1, 15-NOV-2006 (EDW) (NJB) */ - -/* Replaced references to LDPOOL with references to FURNSH. */ -/* Replaced references to RTPOOL with references to GDPOOL. */ -/* Enhanced long error message associated with missing kernel */ -/* variables. */ - -/* - SPICELIB Version 1.2.0, 17-FEB-1999 (WLT) */ - -/* Added a second call to SWPOOL in the event some required */ -/* kernel pool variable is not supplied. */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - SPICELIB Version 1.0.0, 28-MAR-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Transform between two uniform numeric time systems */ -/* Transform between two additive numeric time systems */ -/* Convert one uniform numeric time system to another */ -/* Convert one additive numeric time system to another */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* LBCELL is the bottom slot of a cell. */ - - -/* NEEDED is the number of kernel pool variables needed by this */ -/* routine. */ - - -/* LNGVAR is the length of the longest kernel pool variable name */ -/* that is used by this routine. */ - - -/* MISLEN is the length required by the MISSED array of strings */ -/* used for error messages. */ - - -/* TYPLEN is the maximum length allowed for names of uniform */ -/* time types. */ - - -/* NTDT is the number of time types based on terrestrial dynamical */ -/* time (TDT). */ - - -/* NTDB is the number of time types base on barycentric dynamical */ -/* time (TDB). */ - - -/* NRECOG is the total number of recognized types. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = 0.; - return ret_val; - } - chkin_("UNITIM", (ftnlen)6); - if (first) { - first = FALSE_; - -/* Initialize the backslash character. We use this for error */ -/* message construction. */ - - *(unsigned char *)bslash = '\\'; - -/* Set up the parameters that we are going to need often. */ - - secspd = spd_(); - jd2000 = j2000_(); - -/* Initialize the sets that we will use. */ - - s_copy(typtdt + 48, "JDTDT", (ftnlen)8, (ftnlen)5); - s_copy(typtdt + 56, "TAI", (ftnlen)8, (ftnlen)3); - s_copy(typtdt + 64, "TDT", (ftnlen)8, (ftnlen)3); - s_copy(typtdb + 48, "ET", (ftnlen)8, (ftnlen)2); - s_copy(typtdb + 56, "JDTDB", (ftnlen)8, (ftnlen)5); - s_copy(typtdb + 64, "JED", (ftnlen)8, (ftnlen)3); - s_copy(typtdb + 72, "TDB", (ftnlen)8, (ftnlen)3); - validc_(&c__3, &c__3, typtdt, (ftnlen)8); - validc_(&c__4, &c__4, typtdb, (ftnlen)8); - ssizec_(&c__7, recog, (ftnlen)8); - unionc_(typtdt, typtdb, recog, (ftnlen)8, (ftnlen)8, (ftnlen)8); - -/* Set up the kernel pool watchers */ - - swpool_("UNITIM", &c__4, vars__, (ftnlen)6, (ftnlen)16); - } - -/* Check to see if any of the kernel items required by this */ -/* routine have been updated since the last call to this */ -/* entry point. */ - - cvpool_("UNITIM", &update, (ftnlen)6); - if (update || nodata) { - -/* Fetch all of the time parameters from the kernel pool. */ - - gdpool_("DELTET/DELTA_T_A", &c__1, &c__1, &n, &dta, found, (ftnlen)16) - ; - gdpool_("DELTET/K", &c__1, &c__1, &n, &k, &found[1], (ftnlen)8); - gdpool_("DELTET/EB", &c__1, &c__1, &n, &eb, &found[2], (ftnlen)9); - gdpool_("DELTET/M", &c__1, &c__2, &n, m, &found[3], (ftnlen)8); - if (failed_()) { - nodata = TRUE_; - ret_val = 0.; - chkout_("UNITIM", (ftnlen)6); - return ret_val; - } - -/* If anything wasn't found, it's an error dude. */ - - if (somfls_(found, &c__4)) { - nodata = TRUE_; - -/* If we didn't get all of the things we needed for time */ -/* conversion, we need to reset the watch. Otherwise */ -/* subsequent calls to this routine will never have the */ -/* needed data. */ - - swpool_("UNITIM", &c__4, vars__, (ftnlen)6, (ftnlen)16); -/* Writing concatenation */ - i__1[0] = 281, a__1[0] = "The following, needed to convert betwe" - "en the input uniform time scales, were not found in the " - "kernel pool: # Your program may have failed to load a le" - "apseconds kernel. Other possible causes of this problem" - " include loading an invalid leapseconds kernel---one tha" - "t lacks an initial "; - i__1[1] = 1, a__1[1] = bslash; - i__1[2] = 10, a__1[2] = "begindata "; - i__1[3] = 41, a__1[3] = "marker or final newline character, or i" - "s "; - i__1[4] = 42, a__1[4] = "otherwise corrupted---or deleting previ" - "ous"; - i__1[5] = 42, a__1[5] = "ly loaded kernel pool variables via cal" - "ls "; - i__1[6] = 30, a__1[6] = "to UNLOAD, KCLEAR, or CLPOOL. "; - i__1[7] = 41, a__1[7] = "Use the SPICE routine FURNSH (in Fortra" - "n "; - i__1[8] = 38, a__1[8] = "Toolkits, FURNSH is an entry point of "; - i__1[9] = 38, a__1[9] = "KEEPER) to load a leapseconds kernel; "; - i__1[10] = 36, a__1[10] = "make sure the kernel is up to date. "; - i__1[11] = 41, a__1[11] = "See the Kernel and Time Required Read" - "ing "; - i__1[12] = 39, a__1[12] = "or the \"Intro to Kernels\" and \"LSK" - " and "; - i__1[13] = 34, a__1[13] = "SCLK\" SPICE Tutorials for details."; - s_cat(ch__1, a__1, i__1, &c__14, (ftnlen)714); - setmsg_(ch__1, (ftnlen)714); - for (i__ = 1; i__ <= 4; ++i__) { - if (! found[(i__2 = i__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge( - "found", i__2, "unitim_", (ftnlen)450)]) { - errch_("#", missed + ((i__2 = i__ - 1) < 4 && 0 <= i__2 ? - i__2 : s_rnge("missed", i__2, "unitim_", (ftnlen) - 451)) * 20, (ftnlen)1, (ftnlen)20); - } - } - errch_(", #", ".", (ftnlen)3, (ftnlen)1); - sigerr_("SPICE(MISSINGTIMEINFO)", (ftnlen)22); - chkout_("UNITIM", (ftnlen)6); - ret_val = *epoch; - return ret_val; - } - -/* At this point the kernel data checks are done. */ - - nodata = FALSE_; - } - -/* Normalize the IN and OUT scale variables */ - - ucase_(insys, myin, insys_len, (ftnlen)8); - ucase_(outsys, myout, outsys_len, (ftnlen)8); - ssizec_(&c__2, types, (ftnlen)8); - insrtc_(myin, types, (ftnlen)8, (ftnlen)8); - insrtc_(myout, types, (ftnlen)8, (ftnlen)8); - -/* We will work with a local copy of EPOCH. */ - - mytime = *epoch; - -/* First make sure both types are recognized. */ - - if (! setc_(types, "<", recog, (ftnlen)8, (ftnlen)1, (ftnlen)8)) { - setmsg_("The time types recognized by UNITIM are: TAI, TDT, JDTDT, T" - "DB, ET, JED, JDTDB. At least one of the inputs (#, #) was n" - "ot in the list of recognized types. ", (ftnlen)155); - errch_("#", myin, (ftnlen)1, (ftnlen)8); - errch_("#", myout, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BADTIMETYPE)", (ftnlen)18); - chkout_("UNITIM", (ftnlen)6); - ret_val = *epoch; - return ret_val; - } - -/* If the input and output types are the same, just copy the input */ -/* epoch to the output and call it quits. */ - - if (s_cmp(myin, myout, (ftnlen)8, (ftnlen)8) == 0) { - ret_val = mytime; - chkout_("UNITIM", (ftnlen)6); - return ret_val; - } - -/* Determine the base types of the input and output types. */ - - intdt = elemc_(myin, typtdt, (ftnlen)8, (ftnlen)8); - outtdt = elemc_(myout, typtdt, (ftnlen)8, (ftnlen)8); - intdb = ! intdt; - outtdb = ! outtdt; - -/* The two types, TDT and TDB, will be used as the fundamental */ -/* base used in conversions. */ - -/* TAI and JDTDT will be converted to TDT */ -/* JED and JDTDB will be converted to TDB. */ -/* (ET is already TDB.) */ - - - if (s_cmp(myin, "TAI", (ftnlen)8, (ftnlen)3) == 0) { - mytime += dta; - } else if (s_cmp(myin, "JDTDT", (ftnlen)8, (ftnlen)5) == 0) { - mytime = (mytime - jd2000) * secspd; - } else if (s_cmp(myin, "JED", (ftnlen)8, (ftnlen)3) == 0) { - mytime = (mytime - jd2000) * secspd; - } else if (s_cmp(myin, "JDTDB", (ftnlen)8, (ftnlen)5) == 0) { - mytime = (mytime - jd2000) * secspd; - } - -/* At this point, MYTIME has been converted from its input */ -/* to one of the base types. */ - -/* Next change type from TDB to TDT or vice versa, if */ -/* required. (The time is already in TDT or TDB). */ - - if (intdt && outtdb) { - tdt = mytime; - tdb = tdt + k * sin(m[0] + m[1] * tdt + eb * sin(m[0] + m[1] * tdt)); - mytime = tdb; - } else if (intdb && outtdt) { - -/* What we have to do here is invert the formula used to get */ -/* TDB from TDT that was used above. */ - -/* Of course solving the equation */ - -/* TDB = TDT + K*SIN { M0 + M1*TDT + EB*SIN( MO + M1*TDT ) } */ - -/* analytically for TDT if given TDB is no piece of cake. */ -/* However, we can get as close as we want to TDT if */ -/* we notice a few tricks. First, let's let f(t) denote the */ -/* function */ - -/* f(t) = SIN( M0 + M1*t + EB*SIN( M0 + M1*t ) ) */ - -/* With this simpler notation we can rewrite our problem */ -/* as that of solving the equation */ - -/* y = t + K*f(t) */ - -/* for t given y. Whichever t satisfies this equation will be */ -/* unique. The uniqueness of the solution is ensured because the */ -/* expression on the right-hand side of the equation is */ -/* monotone increasing in t. */ - -/* Let's suppose that t is the solution, then the following */ -/* is true. */ - -/* t = y - K*f(t) */ - -/* but we can also replace the t on the right hand side of the */ -/* equation by y - K*f(t). Thus */ - -/* t = y - K*f( y - K*f(t)) */ - -/* = y - K*f( y - K*f( y - K*f(t))) */ - -/* = y - K*f( y - K*f( y - K*f( y - K*f(t)))) */ - -/* = y - K*f( y - K*f( y - K*f( y - K*f( y - K*f(t))))) */ -/* . */ -/* . */ -/* . */ -/* = y - K*f( y - K*f( y - K*f( y - K*f( y - K*f(y - ... ))) */ - -/* and so on, for as long as we have patience to perform the */ -/* substitutions. */ - -/* The point of doing this recursive substitution is that we */ -/* hope to move t to an insignificant part of the computation. */ -/* This would seem to have a reasonable chance of success since */ -/* K is a small number and f is bounded by 1. */ - -/* Following this idea, we will attempt to solve for t using */ -/* the recursive method outlined below. */ - -/* We will make our first guess at t, call it t_0. */ - -/* t_0 = y */ - -/* Our next guess, t_1, is given by: */ - -/* t_1 = y - K*f(t_0) */ - -/* And so on: */ - -/* t_2 = y - K*f(t_1) [ = y - K*f(y - K*f(y)) ] */ -/* t_3 = y - K*f(t_2) [ = y - K*f(y - K*f(y - K*f(y))) ] */ -/* . */ -/* . */ -/* . */ -/* t_n = y - K*f(t_(n-1)) [ = y - K*f(y - K*f(y - K*f(y...)))] */ - -/* The questions to ask at this point are: */ - -/* 1) Do the t_i's converge? */ -/* 2) If they converge, do they converge to t? */ -/* 3) If they converge to t, how fast do they get there? */ - -/* 1) The sequence of approximations converges. */ - -/* | t_n - t_(n-1) | = [ y - K*f( t_(n-1) ) ] */ -/* - [ y - K*f( t_(n-2) ) ] */ - -/* = K*[ f( t_(n-2) ) - f( t_(n-1) ) ] */ - -/* The function f has an important property. The absolute */ -/* value of its derivative is always less than M1*(1+EB). */ -/* This means that for any pair of real numbers s,t */ - -/* | f(t) - f(s) | < M1*(1+EB)*| t - s |. */ - -/* From this observation, we can see that */ - -/* | t_n - t_(n-1) | < K*M1*(1+EB)*| t_(n-1) - t_(n-2) | */ - -/* With this fact available, we could (with a bit more work) */ -/* conclude that the sequence of t_i's converges and that */ -/* it converges at a rate that is at least as fast as the */ -/* sequence L, L**2, L**3, .... */ - -/* Where L = K*M1*(1+EB) << 1. */ - -/* 2) If we let t be the limit of the t_i's then it follows */ -/* that */ - -/* t = y - K*f(t). */ - -/* or that */ - -/* y = t + K*f(t). */ - -/* 3) As we already pointed out, the sequence of t_i's */ -/* converges at least as fast as the geometric series */ -/* L, L**2, ... */ - - -/* Since K*M1*(1+EB) is quite small (on the order of 10**-9) */ -/* 3 iterations should get us as close as we can get to the */ -/* solution for TDT */ - - tdb = mytime; - tdt = tdb; - for (i__ = 1; i__ <= 3; ++i__) { - tdt = tdb - k * sin(m[0] + m[1] * tdt + eb * sin(m[0] + m[1] * - tdt)); - } - mytime = tdt; - } - -/* Now MYTIME is in the base type of the requested output. */ -/* If further conversion is required, we do it here. */ - - if (s_cmp(myout, "TAI", (ftnlen)8, (ftnlen)3) == 0) { - mytime -= dta; - } else if (s_cmp(myout, "JDTDT", (ftnlen)8, (ftnlen)5) == 0) { - mytime = mytime / secspd + jd2000; - } else if (s_cmp(myout, "JED", (ftnlen)8, (ftnlen)3) == 0) { - mytime = mytime / secspd + jd2000; - } else if (s_cmp(myout, "JDTDB", (ftnlen)8, (ftnlen)5) == 0) { - mytime = mytime / secspd + jd2000; - } - ret_val = mytime; - chkout_("UNITIM", (ftnlen)6); - return ret_val; -} /* unitim_ */ - diff --git a/ext/spice/src/cspice/unitim_c.c b/ext/spice/src/cspice/unitim_c.c deleted file mode 100644 index 67c7339b7f..0000000000 --- a/ext/spice/src/cspice/unitim_c.c +++ /dev/null @@ -1,231 +0,0 @@ -/* - --Procedure unitim_c ( Uniform time scale transformation ) - --Abstract - - Transform time from one uniform scale to another. The uniform - time scales are TAI, TDT, TDB, ET, JED, JDTDB, JDTDT. - --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 - - TIME - --Keywords - - TIME - CONVERSION - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - SpiceDouble unitim_c ( SpiceDouble epoch, - ConstSpiceChar * insys, - ConstSpiceChar * outsys ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - epoch I An epoch to be converted. - insys I The time scale associated with the input epoch. - outsys I The time scale associated with the function value. - - The function returns the d.p. in outsys that is equivalent to the - epoch on the insys time scale. - --Detailed_Input - - epoch is an epoch relative to the insys time scale. - - insys is a time scale. Acceptable values are: - - "TAI" International Atomic Time. - "TDB" Barycentric Dynamical Time. - "TDT" Terrestrial Dynamical Time. - "ET" Ephemeris time (in the SPICE system, this is - equivalent to TDB). - "JDTDB" Julian Date relative to TDB. - "JDTDT" Julian Date relative to TDT. - "JED" Julian Ephemeris date (in the SPICE system - this is equivalent to JDTDB). - - The routine is not sensitive to the case of the - characters in insys; "tai" "Tai" and "TAI" are - all equivalent from the point of view of this routine. - - outsys is the time scale to which epoch should be converted. - Acceptable values are the same as for insys. The - routine is not sensitive to the case of outsys. - --Detailed_Output - - The function returns the time in the system specified by outsys - that is equivalent to the epoch in the insys time scale. - --Parameters - - None. - --Exceptions - - 1) The kernel pool must contain the variables: - - "DELTET/DELTA_T_A" - "DELTET/K" - "DELTET/EB" - "DELTET/M" - - If these are not present, the error SPICE(MISSINGTIMEINFO) - will be signalled. (These variables are typically inserted - into the kernel pool by loading a leapseconds kernel with - the SPICE routine furnsh_c.) - - 2) If the names of either the input or output time types are - unrecognized, the error SPICE(BADTIMETYPE) will be signalled. - - 4) The error SPICE(EMPTYSTRING) is signalled if either input - string does not contain at least one character, since an - empty input string cannot be converted to a Fortran-style string. - - 5) The error SPICE(NULLPOINTER) is signalled if either input string - pointer is null. - --Files - - None. - --Particulars - - We use the term uniform time scale to refer to those - representations of time that are numeric (each epoch is - represented by a number) and additive. A numeric time - system is additive if given the representations, E1 and E2, - of any pair of successive epochs, the time elapsed between - the epochs is given by E2 - E1. - - Given an epoch in one of the uniform time scales - specified by insys, the function returns the equivalent - representation in the scale specified by outsys. A list - of the recognized uniform time scales is given in the - detailed input for insys. - --Examples - - To convert an epoch with respect to the International Atomic - Time (TAI) scale to ET (Barycentric Dynamical Time), make the - following assignment. - - et = unitim_c ( tai, "TAI", "ET" ); - --Restrictions - - The appropriate variable must be loaded into the SPICE kernel pool - (normally by loading a leapseconds kernel with furnsh_c) prior to - calling this routine. - --Literature_References - - None. - --Author_and_Institution - - H.A. Neilan (JPL) - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.1.1, 14-AUG-2006 (EDW) - - Replace mention of ldpool_c with furnsh_c. - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) - - Re-implemented routine without dynamically allocated, temporary - strings. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - Transform between two uniform numeric time systems - Transform between two additive numeric time systems - Convert one uniform numeric time system to another - Convert one additive numeric time system to another - --& -*/ - -{ /* Begin unitim_c */ - - /* - Local variables - */ - SpiceDouble result; - - - /* - Participate in error tracing. - */ - chkin_c ( "unitim_c"); - - - /* - Check the input string insys to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "unitim_c", insys, 0. ); - - /* - Check the input string outsys to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "unitim_c", outsys, 0. ); - - /* - Call the f2c'd routine. - */ - result = (SpiceDouble) unitim_( ( doublereal * ) &epoch, - ( char * ) insys, - ( char * ) outsys, - ( ftnlen ) strlen(insys), - ( ftnlen ) strlen(outsys) ); - - chkout_c ( "unitim_c"); - - return ( result ); - - -} /* End unitim_c */ diff --git a/ext/spice/src/cspice/unload_c.c b/ext/spice/src/cspice/unload_c.c deleted file mode 100644 index cc7b1782d2..0000000000 --- a/ext/spice/src/cspice/unload_c.c +++ /dev/null @@ -1,207 +0,0 @@ -/* - --Procedure unload_c ( Unload a kernel ) - --Abstract - - Unload a SPICE kernel. - --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 - - KERNEL - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void unload_c ( ConstSpiceChar * file ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - file I The name of a kernel to unload. - --Detailed_Input - - file is the name of a file to unload. This file - should be one loaded through the interface furnsh_c. - If the file is not on the list of loaded kernels - no action is taken. - - Note that if file is a meta-text kernel, all of - the files loaded as a result of loading the meta-text - kernel will be unloaded. - --Detailed_Output - - None. - --Parameters - - None. - --Files - - None. - --Exceptions - - 1) If the specified kernel is not on the list of loaded kernels - no action is taken. - - 2) If the input file argument pointer is null, the error - SPICE(NULLPOINTER) will be signaled. - - 3) If the input file argument pointer is the empty string, the error - SPICE(EMPTYSTRING) will be signaled. - --Particulars - - The call - - unload_c ( file ); - - has the effect of "erasing" the last previous call: - - furnsh_c ( file ); - - This interface allows you to unload binary and text kernels. - Moreover, if you used a meta-text kernel to set up your - working environment, you can unload all of the kernels loaded - through the meta-kernel by unloading the meta-kernel. - - Unloading Text or Meta-text Kernels. - - Part of the action of unloading text (or meta-text kernels) is - clearing the kernel pool and re-loading any kernels that were not in - the specified set of kernels to unload. Since loading of text - kernels is not a very fast process, unloading text kernels takes - considerably longer than unloading binary kernels. Moreover, since - the kernel pool is cleared, any kernel pool variables you have set - from your program by using one of the interfaces pcpool_c, pdpool_c, - pipool_c, or lmpool_c will be removed from the kernel pool. For - this reason, if you plan to use this feature in your program, - together with one of the routines specified above, you will need to - take special precautions to make sure kernel pool variables required - by your program do not inadvertently disappear. - --Examples - - Suppose that you wish to compare two different sets of kernels - used to describe the geometry of a mission (for example a predict - model and a reconstructed model). You can place all of the - kernels for one model in one meta-text kernel, and the other set - in a second meta-text kernel. Let's call these predict.mta and - actual.mta. - - #include "SpiceUsr.h" - . - . - . - furnsh_c ( "predct.mta" ); - - /. - Compute quantities of interest and store them - for comparison with results of reconstructed - (actual) kernels. - - Now unload the predict model and load the reconstructed - model. - ./ - unload_c ( "predct.mta" ); - furnsh_c ( "actual.mta" ); - - /. - Re-compute quantities of interest and compare them - with the stored quantities. - ./ - - --Restrictions - - See the note regarding the unloading of text and meta-text - kernels. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 01-SEP-1999 (NJB) (WLT) - --Index_Entries - - Unload a SPICE kernel - --& -*/ - -{ /* Begin unload_c */ - - - - /* - Participate in error tracing. - */ - - chkin_c ( "unload_c" ); - - - /* - Check the input filename to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "unload_c", file ); - - - /* - Call the f2c'd Fortran routine. - */ - unload_ ( ( char * ) file, - ( ftnlen ) strlen(file) ); - - - chkout_c ( "unload_c" ); - -} /* End unload_c */ diff --git a/ext/spice/src/cspice/unorm.c b/ext/spice/src/cspice/unorm.c deleted file mode 100644 index 4a45ccf1e6..0000000000 --- a/ext/spice/src/cspice/unorm.c +++ /dev/null @@ -1,170 +0,0 @@ -/* unorm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UNORM ( Unit vector and norm, 3 dimensional ) */ -/* Subroutine */ int unorm_(doublereal *v1, doublereal *vout, doublereal * - vmag) -{ - extern doublereal vnorm_(doublereal *); - -/* $ Abstract */ - -/* Normalize a double precision 3-vector and return its magnitude. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector to be normalized. */ -/* VOUT O Unit vector V1 / |V1|. */ -/* If V1 is the zero vector, then VOUT will also */ -/* be zero. */ -/* VMAG O Magnitude of V1, i.e. |V1|. */ - -/* $ Detailed_Input */ - -/* V1 This variable may contain any 3-vector, including the */ -/* zero vector. */ - -/* $ Detailed_Output */ - -/* VOUT This variable contains the unit vector in the direction */ -/* of V1. If V1 is the zero vector, then VOUT will also be */ -/* the zero vector. */ - -/* VMAG This is the magnitude of V1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* UNORM references a function called VNORM (which itself is */ -/* numerically stable) to calculate the norm of the input vector V1. */ -/* If the norm is equal to zero, then each component of the output */ -/* vector VOUT is set to zero. Otherwise, VOUT is calculated by */ -/* dividing V1 by the norm. */ - -/* $ Examples */ - -/* The following table shows how selected V1 implies VOUT and MAG. */ - -/* V1 VOUT MAG */ -/* ------------------ ------------------ ---- */ -/* (5, 12, 0) (5/13, 12/13, 0) 13 */ -/* (1D-7, 2D-7, 2D-7) (1/3, 2/3, 2/3) 3D-7 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* 3-dimensional unit vector and norm */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 10-JAN-1989 (WLT) */ - -/* Error free specification added. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Obtain the magnitude of V1 */ - - *vmag = vnorm_(v1); - -/* If VMAG is nonzero, then normalize. Note that this process is */ -/* numerically stable: overflow could only happen if VMAG were small, */ -/* but this could only happen if each component of V1 were small. */ -/* In fact, the magnitude of any vector is never less than the */ -/* magnitude of any component. */ - - if (*vmag > 0.) { - vout[0] = v1[0] / *vmag; - vout[1] = v1[1] / *vmag; - vout[2] = v1[2] / *vmag; - } else { - vout[0] = 0.; - vout[1] = 0.; - vout[2] = 0.; - } - return 0; -} /* unorm_ */ - diff --git a/ext/spice/src/cspice/unorm_c.c b/ext/spice/src/cspice/unorm_c.c deleted file mode 100644 index 89f24decb2..0000000000 --- a/ext/spice/src/cspice/unorm_c.c +++ /dev/null @@ -1,166 +0,0 @@ -/* - --Procedure unorm_c ( Unit vector and norm, 3 dimensional ) - --Abstract - - Normalize a double precision 3-vector and return its magnitude. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef unorm_c - - - void unorm_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3], - SpiceDouble * vmag ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector to be normalized. - vout O Unit vector v1 / |v1|. - If v1 is the zero vector, then vout will also - be zero. vout can overwrite v1. - vmag O Magnitude of v1, i.e. |v1|. - --Detailed_Input - - v1 This variable may contain any 3-vector, including the - zero vector. - --Detailed_Output - - vout This variable contains the unit vector in the direction - of v1. If v1 is the zero vector, then vout will also be - the zero vector. - vmag This is the magnitude of v1. - --Parameters - - None. - --Particulars - - unorm_c references a function called vnorm_c (which itself is - numerically stable) to calculate the norm of the input vector v1. - If the norm is equal to zero, then each component of the output - vector vout is set to zero. Otherwise, vout is calculated by - dividing v1 by the norm. - --Examples - - The following table shows how selected v1 implies vout and mag. - - v1 vout mag - ------------------ ------------------ ------ - (5, 12, 0) (5/13, 12/13, 0) 13 - (1D-7, 2D-7, 2D-7) (1/3, 2/3, 2/3) 3D-7 - --Restrictions - - None - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. - - CSPICE Version 1.0.0, 17-OCT-1997 (EDW) - --Index_Entries - - 3-dimensional unit vector and norm - --& -*/ - -{ /* Begin unorm_c */ - - - /* - Obtain the magnitude of v1. Note: since vmage is a pointer, the - value of what vmag is pointing at is *vmag. - */ - - *vmag = vnorm_c( v1 ); - - - - /* - If *vmag is nonzero, then normalize. Note that this process is - numerically stable: overflow could only happen if vmag were small, - but this could only happen if each component of v1 were small. - In fact, the magnitude of any vector is never less than the - magnitude of any component. - */ - - if ( *vmag > 0.0 ) - { - vout[0] = v1[0] / *vmag; - vout[1] = v1[1] / *vmag; - vout[2] = v1[2] / *vmag; - } - else - { - vout[0] = 0.; - vout[1] = 0.; - vout[2] = 0.; - } - -} /* End unorm_c */ diff --git a/ext/spice/src/cspice/unormg.c b/ext/spice/src/cspice/unormg.c deleted file mode 100644 index fd6bafaaff..0000000000 --- a/ext/spice/src/cspice/unormg.c +++ /dev/null @@ -1,189 +0,0 @@ -/* unormg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UNORMG ( Unit vector and norm, general dimension ) */ -/* Subroutine */ int unormg_(doublereal *v1, integer *ndim, doublereal *vout, - doublereal *vmag) -{ - /* System generated locals */ - integer v1_dim1, vout_dim1, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - extern doublereal vnormg_(doublereal *, integer *); - -/* $ Abstract */ - -/* Normalize a double precision vector of arbitrary dimension and */ -/* return its magnitude. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector to be normalized. */ -/* NDIM I Dimension of V1 (and also VOUT). */ -/* VOUT O Unit vector V1 / |V1|. */ -/* If V1 = 0, VOUT will also be zero. */ -/* VMAG O Magnitude of V1, that is, |V1|. */ - -/* $ Detailed_Input */ - -/* V1 This variable may contain any vector of arbitrary */ -/* dimension, including the zero vector. */ -/* NDIM This is the dimension of V1 and VOUT. */ - -/* $ Detailed_Output */ - -/* VOUT This variable contains the unit vector in the direction */ -/* of V1. If V1 is the zero vector, then VOUT will also be */ -/* the zero vector. */ -/* VMAG This is the magnitude of V1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* UNORMG references a function called VNORMG (which itself is */ -/* numerically stable) to calculate the norm of the input vector V1. */ -/* If the norm is equal to zero, then each component of the output */ -/* vector VOUT is set to zero. Otherwise, VOUT is calculated by */ -/* dividing V1 by the norm. No error detection or correction is */ -/* implemented. */ - -/* $ Examples */ - -/* The following table shows how selected V1 implies VOUT and MAG. */ - -/* V1 NDIM VOUT MAG */ -/* -------------------------------------------------------- */ -/* (5, 12) 2 (5/13, 12/13) 13 */ -/* (1D-7, 2D-7, 2D-7) 3 (1/3, 2/3, 2/3) 3D-7 */ - -/* $ Restrictions */ - -/* No error checking is implemented in this subroutine to guard */ -/* against numeric overflow. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* n-dimensional unit vector and norm */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 10-JAN-1989 (WLT) */ - -/* Error free specification added. */ - -/* -& */ - -/* Obtain the magnitude of V1 */ - - /* Parameter adjustments */ - vout_dim1 = *ndim; - v1_dim1 = *ndim; - - /* Function Body */ - *vmag = vnormg_(v1, ndim); - -/* If VMAG is nonzero, then normalize. Note that this process is */ -/* numerically stable: overflow could only happen if VMAG were small, */ -/* but this could only happen if each component of V1 were also small. */ -/* In fact, the magnitude of any vector is never less than the */ -/* magnitude of any component. */ - - if (*vmag > 0.) { - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "vout", i__2, "unormg_", (ftnlen)161)] = v1[(i__3 = i__ - - 1) < v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3, - "unormg_", (ftnlen)161)] / *vmag; - } - } else { - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "vout", i__2, "unormg_", (ftnlen)165)] = 0.; - } - } - - return 0; -} /* unormg_ */ - diff --git a/ext/spice/src/cspice/unormg_c.c b/ext/spice/src/cspice/unormg_c.c deleted file mode 100644 index 531d7410b8..0000000000 --- a/ext/spice/src/cspice/unormg_c.c +++ /dev/null @@ -1,205 +0,0 @@ -/* - --Procedure unormg_c ( Unit vector and norm, general dimension ) - --Abstract - - Normalize a double precision vector of arbitrary dimension and - return its magnitude. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef unormg_c - - - void unormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout, - SpiceDouble * vmag ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector to be normalized. - ndim I Dimension of v1 (and also vout). - vout O Unit vector v1 / |v1|. - If v1 = 0, vout will also be zero. - vout can overwrite v1. - vmag O Magnitude of v1, that is, |v1|. - --Detailed_Input - - v1 This variable may contain any vector of arbitrary - dimension, including the zero vector. - ndim This is the dimension of v1 and vout. - --Detailed_Output - - vout This variable contains the unit vector in the direction - of v1. If v1 is the zero vector, then vout will also be - the zero vector. - - vmag This is the magnitude of v1. - --Parameters - - None. - --Particulars - - unormg_c references a function called vnormg_c (which itself is - numerically stable) to calculate the norm of the input vector v1. - If the norm is equal to zero, then each component of the output - vector vout is set to zero. Otherwise, vout is calculated by - dividing v1 by the norm. No error detection or correction is - implemented. - --Examples - - The following table shows how selected v1 implies vout and mag. - - v1 ndim vout mag - ----------------------------------------------------------------- - (5, 12) 2 (5/13, 12/13) 13 - (1D-7, 2D-7, 2D-7) 3 (1/3, 2/3, 2/3) 3D-7 - --Restrictions - - No error checking is implemented in this subroutine to guard - against numeric overflow. - --Exceptions - - 1) If ndim is not physically realistic, greater than zero, a - BADDIMENSION error is flagged. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. Converted check-in style to discovery. - - -CSPICE Version 1.0.0, 31-MAR-1998 (EDW) - --Index_Entries - - n-dimensional unit vector and norm - --& -*/ - -{ /* Begin unormg_c */ - - /* - Local variables - */ - SpiceInt i; - - - - /* - Use discovery check-in. - */ - - - - /* Check ndim is cool. Dimension is positive definite. */ - - if ( ndim <= 0 ) - { - - chkin_c ( "unormg_c" ); - SpiceError ( "Vector dimension less than or equal to zero", - "BADDIMENSION" ); - chkout_c ( "unormg_c" ); - return; - - } - - - - /* Get the magnitude of the vector. */ - - *vmag = vnormg_c ( v1, ndim ); - - - /* - If vmag is nonzero, then normalize. Note that this process is - numerically stable: overflow could only happen if vmag were small, - but this could only happen if each component of v1 were also small. - In fact, the magnitude of any vector is never less than the - magnitude of any component. - */ - - if ( *vmag > 0. ) - { - - for ( i = 0; i < ndim; i++ ) - { - vout[i] = v1[i]/ (*vmag); - } - - } - else - { - - for ( i = 0; i < ndim ; i++ ); - { - vout[i] = 0.; - } - - } - - -} /* End unormg_c */ diff --git a/ext/spice/src/cspice/utc2et.c b/ext/spice/src/cspice/utc2et.c deleted file mode 100644 index 9392a88fb1..0000000000 --- a/ext/spice/src/cspice/utc2et.c +++ /dev/null @@ -1,420 +0,0 @@ -/* utc2et.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UTC2ET ( UTC to Ephemeris Time ) */ -/* Subroutine */ int utc2et_(char *utcstr, doublereal *et, ftnlen utcstr_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_dnnt(doublereal *); - - /* Local variables */ - integer year; - doublereal tvec[10]; - logical mods; - char type__[8]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer ntvec; - char error[480]; - logical ok; - extern /* Subroutine */ int tcheck_(doublereal *, char *, logical *, char - *, logical *, char *, ftnlen, ftnlen, ftnlen); - logical succes, yabbrv; - char modify[8*5]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - char pictur[80]; - extern /* Subroutine */ int ttrans_(char *, char *, doublereal *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char - *, char *, logical *, logical *, logical *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), texpyr_(integer *); - -/* $ Abstract */ - -/* Convert an input time from Calendar or Julian Date format, UTC, */ -/* to ephemeris seconds past J2000. */ - -/* $ 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 */ - -/* TIME, KERNEL */ - -/* $ Keywords */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UTCSTR I Input time string, UTC. */ -/* ET O Output epoch, ephemeris seconds past J2000. */ - -/* $ Detailed_Input */ - -/* UTCSTR is an input time string, containing a Calendar or */ -/* Julian Date, UTC. Any input string acceptable to the */ -/* routine TPARTV are acceptable to UTC2ET. The length */ -/* of UTCSTR should not exceed 80 characters. */ - -/* $ Detailed_Output */ - -/* ET is the equivalent of UTCSTR, expressed in ephemeris */ -/* seconds past J2000. If an error occurs, or if the */ -/* input string is ambiguous, ET is not changed. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input time string is ambiguous, the error */ -/* SPICE(INVALIDTIMESTRING) is signalled. */ - -/* 2) This routine does not attempt to account for variations */ -/* in the length of the second that were in effect prior */ -/* to Jan 1, 1972. For days prior to that date, we assume */ -/* there are exactly 86400 ephemeris seconds. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine handles that task of converting strings */ -/* representing epochs in the UTC system to ephemeris seconds */ -/* (TDB) past the epoch of the J2000 frame. */ - -/* Although this routine is intended primarily for the */ -/* conversion of epochs during the "space age" it may also */ -/* be used to convert much earlier epochs. However, before */ -/* using this routine to convert epochs prior to 1972 */ -/* you must be sure that the assumptions made by in the */ -/* implementation are consistent with the accuracy of */ -/* the input calendar string. */ - -/* As noted in the "Exceptions" section above, this routine */ -/* does not attempt to account for variations in the */ -/* length of the second that were used prior to Jan 1, 1972. */ -/* Instead each "UTC" day prior to Jan 1, 1972 is assumed */ -/* to have exactly 86400 TDT seconds. */ - -/* Ancient Epochs */ -/* -------------- */ - -/* The calendar used today, the Gregorian calendar, has its */ -/* initial epoch on 15 October, 1582. Prior to that epoch the */ -/* Julian calendar was used for the recording of epochs. */ -/* October 15, 1582 (Gregorian) corresponds to */ -/* October 05, 1582 (Julian). From the point of view of the */ -/* implementation of this routine, all epochs belong to the */ -/* Gregorian calendar extended indefinitely backward in time. */ -/* If you need to obtain ephemeris seconds past the J2000 epoch */ -/* from Julian Calendar strings, we suggest that */ -/* you make use of the SPICE routine STR2ET. */ - -/* $ Examples */ - -/* Below is a sampling of some of the time formats that */ -/* are acceptable as inputs to UTC2ET. A complete discussion */ -/* of permissible formats is given in the SPICE routine */ -/* TPARTV as well as the User's reference file time.req */ -/* located in the "doc" directory of the toolkit. */ - -/* ISO (T) Formats. */ - -/* String Year Mon DOY DOM HR Min Sec */ -/* ---------------------------- ---- --- --- --- -- --- ------ */ -/* 1996-12-18T12:28:28 1996 Dec na 18 12 28 28 */ -/* 1986-01-18T12 1986 Jan na 18 12 00 00 */ -/* 1986-01-18T12:19 1986 Jan na 18 12 19 00 */ -/* 1986-01-18T12:19:52.18 1986 Jan na 18 12 19 52.18 */ -/* 1995-08T18:28:12 1995 na 008 na 18 28 12 */ -/* 1995-18T 1995 na 018 na 00 00 00 */ - - -/* Calendar Formats. */ - -/* String Year Mon DOM HR Min Sec */ -/* ---------------------------- ---- --- --- -- --- ------ */ -/* Tue Aug 6 11:10:57 1996 1996 Aug 06 11 10 57 */ -/* 1 DEC 1997 12:28:29.192 1997 Dec 01 12 28 29.192 */ -/* 2/3/1996 17:18:12.002 1996 Feb 03 17 18 12.002 */ -/* Mar 2 12:18:17.287 1993 1993 Mar 02 12 18 17.287 */ -/* 1992 11:18:28 3 Jul 1992 Jul 03 11 18 28 */ -/* June 12, 1989 01:21 1989 Jun 12 01 21 00 */ -/* 1978/3/12 23:28:59.29 1978 Mar 12 23 28 59.29 */ -/* 17JUN1982 18:28:28 1982 Jun 17 18 28 28 */ -/* 13:28:28.128 1992 27 Jun 1992 Jun 27 13 28 28.128 */ -/* 1972 27 jun 12:29 1972 Jun 27 12 29 00 */ -/* '93 Jan 23 12:29:47.289 1993* Jan 23 12 29 47.289 */ -/* 27 Jan 3, 19:12:28.182 2027* Jan 03 19 12 28.182 */ -/* 23 A.D. APR 4, 18:28:29.29 0023** Apr 04 18 28 29.29 */ -/* 18 B.C. Jun 3, 12:29:28.291 -017** Jun 03 12 29 28.291 */ -/* 29 Jun 30 12:29:29.298 2029+ Jun 30 12 29 29.298 */ -/* 29 Jun '30 12:29:29.298 2030* Jun 29 12 29 29.298 */ - -/* Day of Year Formats */ - -/* String Year DOY HR Min Sec */ -/* ---------------------------- ---- --- -- --- ------ */ -/* 1997-162::12:18:28.827 1997 162 12 18 28.827 */ -/* 162-1996/12:28:28.287 1996 162 12 28 28.287 */ -/* 1993-321/12:28:28.287 1993 231 12 28 28.287 */ -/* 1992 183// 12 18 19 1992 183 12 18 19 */ -/* 17:28:01.287 1992-272// 1992 272 17 28 01.287 */ -/* 17:28:01.282 272-1994// 1994 272 17 28 01.282 */ -/* '92-271/ 12:28:30.291 1992* 271 12 28 30.291 */ -/* 92-182/ 18:28:28.281 1992* 182 18 28 28.281 */ -/* 182-92/ 12:29:29.192 0182+ 092 12 29 29.192 */ -/* 182-'92/ 12:28:29.182 1992 182 12 28 29.182 */ - - -/* Julian Date Strings */ - -/* jd 28272.291 Julian Date 28272.291 */ -/* 2451515.2981 (JD) Julian Date 2451515.2981 */ -/* 2451515.2981 JD Julian Date 2451515.2981 */ - -/* Abbreviations Used in Tables */ - -/* na --- Not Applicable */ -/* Mon --- Month */ -/* DOY --- Day of Year */ -/* DOM --- Day of Month */ -/* Wkday --- Weekday */ -/* Hr --- Hour */ -/* Min --- Minutes */ -/* Sec --- Sec */ - -/* * The default interpretation of a year that has been abbreviated */ -/* with a leading quote as in 'xy (such as '92) is to treat */ -/* the year as 19xy if xy > 68 and to treat it is 20xy otherwise. */ -/* Thus '70 is interpreted as 1970 and '47 is treated as 2047. */ -/* However, you may change the "split point" and centuries through */ -/* use of the SPICE routine TSETYR which is an entry point in */ -/* the SPICE module TEXPYR. See that routine for a discussion of */ -/* how you may reset the split point. */ - -/* ** All epochs are regarded as belonging to the Gregorian */ -/* calendar. We formally extend the Gregorian calendar backward */ -/* and forward in time for all epochs. If you have epochs belonging */ -/* to the Julian Calendar, consult the routines TPARTV and JUL2GR */ -/* for a discussion concerning conversions to the Gregorian */ -/* calendar and ET. */ - -/* + When a day of year format or calendar format string is */ -/* input and neither of integer components of the date */ -/* is greater than 1000, the first integer */ -/* is regarded as being the year. */ - - -/* $ Restrictions */ - -/* The conversion between ET and UTC depends on the values in the */ -/* input kernel pool. The kernel pool should be loaded prior to */ -/* calling this routine. */ - -/* Before using this routine for epochs prior to Jan 1, 1972 */ -/* be sure to check the "Particulars" section to make sure */ -/* that the assumptions made in this routine are consistent */ -/* with the accuracy you require for your application. */ - -/* $ Literature_References */ - -/* Jesperson and Fitz-Randolph, From Sundials to Atomic Clocks, */ -/* Dover Publications, New York, 1977. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* W.M. Owen (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 05-JAN-1998 (WLT) */ - -/* Comments concerning the default century for abbreviated */ -/* years were updated to reflect changes to TEXPYR. */ - -/* - SPICELIB Version 2.0.0, 20-NOV-1996 (WLT) */ - -/* About the only thing that is the same in this routine */ -/* from the previous editions, is that the interface is */ -/* unchanged. Nearly everything else has been modified. */ -/* The routine was modified to make use of TPARTV */ -/* and TTRANS to handle the task of parsing and */ -/* computing seconds past 2000 TDB. This version */ -/* now handles leap seconds correctly. */ - -/* - 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 (WMO) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* utc to ephemeris time */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("UTC2ET", (ftnlen)6); - -/* So far we have no errors, the type of input is unknown. */ - - s_copy(error, " ", (ftnlen)480, (ftnlen)1); - s_copy(type__, " ", (ftnlen)8, (ftnlen)1); - -/* First parse the string and perform the various tests on */ -/* the validity of its components. */ - - tpartv_(utcstr, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes, - pictur, error, utcstr_len, (ftnlen)8, (ftnlen)8, (ftnlen)80, ( - ftnlen)480); - if (! succes) { - setmsg_(error, (ftnlen)480); - sigerr_("SPICE(INVALIDTIMESTRING)", (ftnlen)24); - chkout_("UTC2ET", (ftnlen)6); - return 0; - } - -/* We are not going to allow most of the modifiers in strings. */ - - if (mods) { - if (s_cmp(modify + 32, " ", (ftnlen)8, (ftnlen)1) != 0 && s_cmp( - modify + 32, "UTC", (ftnlen)8, (ftnlen)3) != 0) { - s_copy(error, "UTC2ET does not support the specification of a ti" - "me system in a string. The time system # was specified." - " Try the routine STR2ET.", (ftnlen)480, (ftnlen)129); - repmc_(error, "#", modify + 32, error, (ftnlen)480, (ftnlen)1, ( - ftnlen)8, (ftnlen)480); - setmsg_(error, (ftnlen)480); - sigerr_("SPICE(INVALIDTIMESTRING)", (ftnlen)24); - chkout_("UTC2ET", (ftnlen)6); - return 0; - } else if (s_cmp(modify + 16, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(error, "UTC2ET does not support the specification of a ti" - "me zone in a time string. The time zone '#' was specifi" - "ed. Try the routine STR2ET.", (ftnlen)480, (ftnlen)132); - repmc_(error, "#", modify + 16, error, (ftnlen)480, (ftnlen)1, ( - ftnlen)8, (ftnlen)480); - setmsg_(error, (ftnlen)480); - sigerr_("SPICE(INVALIDTIMESTRING)", (ftnlen)24); - chkout_("UTC2ET", (ftnlen)6); - return 0; - } else if (s_cmp(modify + 24, " ", (ftnlen)8, (ftnlen)1) != 0) { - s_copy(error, "UTC2ET does not support the AM/PM conventions for" - " time strings. Try the routine STR2ET.", (ftnlen)480, ( - ftnlen)87); - setmsg_(error, (ftnlen)480); - sigerr_("SPICE(INVALIDTIMESTRING)", (ftnlen)24); - chkout_("UTC2ET", (ftnlen)6); - return 0; - } - } - -/* If parsing the time string went well, we let TTRANS handle */ -/* the problem of transforming the time vector to TDB. */ - - if (s_cmp(type__, "YMD", (ftnlen)8, (ftnlen)3) == 0 || s_cmp(type__, - "YD", (ftnlen)8, (ftnlen)2) == 0) { - -/* Check the components of the time vector for reasonableness. */ - - tcheck_(tvec, type__, &mods, modify, &ok, error, (ftnlen)8, (ftnlen)8, - (ftnlen)480); - if (! ok) { - setmsg_(error, (ftnlen)480); - sigerr_("SPICE(INVALIDTIMESTRING)", (ftnlen)24); - } - -/* Fix up the year as needed. */ - - year = i_dnnt(tvec); - if (s_cmp(modify, "B.C.", (ftnlen)8, (ftnlen)4) == 0) { - year = 1 - year; - } else if (s_cmp(modify, "A.D.", (ftnlen)8, (ftnlen)4) == 0) { - -/* Do nothing. */ - - } else if (year < 100) { - texpyr_(&year); - } - tvec[0] = (doublereal) year; - -/* We are ready for launch, convert the time vector. */ - - ttrans_(type__, "TDB", tvec, (ftnlen)8, (ftnlen)3); - *et = tvec[0]; - } else if (s_cmp(type__, "JD", (ftnlen)8, (ftnlen)2) == 0) { - ttrans_("JDUTC", "TDB", tvec, (ftnlen)5, (ftnlen)3); - *et = tvec[0]; - } else { - -/* The only way to get here is if we got some unexpected */ -/* type of time string. Signal an error. */ - - setmsg_("# time strings are not handled by UTC2ET. ", (ftnlen)42); - errch_("#", type__, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(INVALIDTIMESTRING)", (ftnlen)24); - chkout_("UTC2ET", (ftnlen)6); - return 0; - } - chkout_("UTC2ET", (ftnlen)6); - return 0; -} /* utc2et_ */ - diff --git a/ext/spice/src/cspice/utc2et_c.c b/ext/spice/src/cspice/utc2et_c.c deleted file mode 100644 index d0ea1134df..0000000000 --- a/ext/spice/src/cspice/utc2et_c.c +++ /dev/null @@ -1,296 +0,0 @@ -/* - --Procedure utc2et_c ( UTC to Ephemeris Time ) - --Abstract - - Convert an input time from Calendar or Julian Date format, UTC, - to ephemeris seconds past J2000. - --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 - - TIME, KERNEL - --Keywords - - TIME - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void utc2et_c ( ConstSpiceChar * utcstr, - SpiceDouble * et ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - utcstr I Input time string, UTC. - et O Output epoch, ephemeris seconds past J2000. - --Detailed_Input - - utcstr is an input time string, containing a Calendar or - Julian Date, UTC. Any input string acceptable to the - routine tpartv_ are acceptable to utc2et_c. The length - of utcstr should not exceed 80 characters. - --Detailed_Output - - et is the equivalent of utcstr, expressed in ephemeris - seconds past J2000. If an error occurs, or if the - input string is ambiguous, et is not changed. - - --Parameters - - None. - --Exceptions - - 1) If the input time string is ambiguous, the error - SPICE(INVALIDTIMESTRING) is signalled. - - 2) This routine does not attempt to account for variations - in the length of the second that were in effect prior - to Jan 1, 1972. For days prior to that date, we assume - there are exactly 86400 ephemeris seconds. - - 3) The error SPICE(EMPTYSTRING) is signalled if the input - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 4) The error SPICE(NULLPOINTER) is signalled if the input string - pointer is null. - --Files - - None. - --Particulars - - This routine handles that task of converting strings - representing epochs in the UTC system to ephemeris seconds - (TDB) past the epoch of the J2000 frame. - - Although this routine is intended primarily for the - conversion of epochs during the "space age" it may also - be used to convert much earlier epochs. However, before - using this routine to convert epochs prior to 1972 - you must be sure that the assumptions made by in the - implementation are consistent with the accuracy of - the input calendar string. - - As noted in the "Exceptions" section above, this routine - does not attempt to account for variations in the - length of the second that were used prior to Jan 1, 1972. - Instead each "UTC" day prior to Jan 1, 1972 is assumed - to have exactly 86400 TDT seconds. - -Ancient Epochs --------------- - - The calendar used today, the Gregorian calendar, has its - initial epoch on 15 October, 1582. Prior to that epoch the - Julian calendar was used for the recording of epochs. - October 15, 1582 (Gregorian) corresponds to - October 05, 1582 (Julian). From the point of view of the - implementation of this routine, all epochs belong to the - Gregorian calendar extended indefinitely backward in time. - If you need to obtain ephemeris seconds past the J2000 epoch - from Julian Calendar strings, we suggest that - you make use of the SPICE routine str2et_c. - --Examples - - Below is a sampling of some of the time formats that - are acceptable as inputs to utc2et_c. A complete discussion - of permissible formats is given in the SPICE routine - tpartv_ as well as the User's reference file time.req - located in the "doc" directory of the toolkit. - - ISO (T) Formats. - - String Year Mon DOY DOM HR Min Sec - ---------------------------- ---- --- --- --- -- --- ------ - 1996-12-18T12:28:28 1996 Dec na 18 12 28 28 - 1986-01-18T12 1986 Jan na 18 12 00 00 - 1986-01-18T12:19 1986 Jan na 18 12 19 00 - 1986-01-18T12:19:52.18 1986 Jan na 18 12 19 52.18 - 1995-08T18:28:12 1995 na 008 na 18 28 12 - 1995-18T 1995 na 018 na 00 00 00 - - - Calendar Formats. - - String Year Mon DOM HR Min Sec - ---------------------------- ---- --- --- -- --- ------ - Tue Aug 6 11:10:57 1996 1996 Aug 06 11 10 57 - 1 DEC 1997 12:28:29.192 1997 Dec 01 12 28 29.192 - 2/3/1996 17:18:12.002 1996 Feb 03 17 18 12.002 - Mar 2 12:18:17.287 1993 1993 Mar 02 12 18 17.287 - 1992 11:18:28 3 Jul 1992 Jul 03 11 18 28 - June 12, 1989 01:21 1989 Jun 12 01 21 00 - 1978/3/12 23:28:59.29 1978 Mar 12 23 28 59.29 - 17JUN1982 18:28:28 1982 Jun 17 18 28 28 - 13:28:28.128 1992 27 Jun 1992 Jun 27 13 28 28.128 - 1972 27 jun 12:29 1972 Jun 27 12 29 00 - '93 Jan 23 12:29:47.289 1993* Jan 23 12 29 47.289 - 27 Jan 3, 19:12:28.182 2027* Jan 03 19 12 28.182 - 23 A.D. APR 4, 18:28:29.29 0023** Apr 04 18 28 29.29 - 18 B.C. Jun 3, 12:29:28.291 -017** Jun 03 12 29 28.291 - 29 Jun 30 12:29:29.298 2029+ Jun 30 12 29 29.298 - 29 Jun '30 12:29:29.298 2030* Jun 29 12 29 29.298 - - Day of Year Formats - - String Year DOY HR Min Sec - ---------------------------- ---- --- -- --- ------ - 1997-162::12:18:28.827 1997 162 12 18 28.827 - 162-1996/12:28:28.287 1996 162 12 28 28.287 - 1993-321/12:28:28.287 1993 231 12 28 28.287 - 1992 183// 12 18 19 1992 183 12 18 19 - 17:28:01.287 1992-272// 1992 272 17 28 01.287 - 17:28:01.282 272-1994// 1994 272 17 28 01.282 - '92-271/ 12:28:30.291 1992* 271 12 28 30.291 - 92-182/ 18:28:28.281 1992* 182 18 28 28.281 - 182-92/ 12:29:29.192 0182+ 092 12 29 29.192 - 182-'92/ 12:28:29.182 1992 182 12 28 29.182 - - - Julian Date Strings - - jd 28272.291 Julian Date 28272.291 - 2451515.2981 (JD) Julian Date 2451515.2981 - 2451515.2981 JD Julian Date 2451515.2981 - - Abbreviations Used in Tables - - na --- Not Applicable - Mon --- Month - DOY --- Day of Year - DOM --- Day of Month - Wkday --- Weekday - Hr --- Hour - Min --- Minutes - Sec --- Sec - - * The default interpretation of a year that has been abbreviated - with a leading quote as in 'xy (such as '92) is to treat - the year as 19xy if xy > 49 and to treat it is 20xy otherwise. - Thus '52 is interpreted as 1952 and '47 is treated as 2047. - However, you may change the "split point" and centuries through - use of the SPICE routine tsetyr_. See that routine for a discussion - of how you may reset the split point. - - ** All epochs are regarded as belonging to the Gregorian - calendar. We formally extend the Gregorian calendar backward - and forward in time for all epochs. If you have epochs belonging - to the Julian Calendar, consult the routines tpartv_ and JUL2GR - for a discussion concerning conversions to the Gregorian - calendar and et. - - + When a day of year format or calendar format string is - input and neither of integer components of the date - is greater than 1000, the first integer - is regarded as being the year. - - --Restrictions - - The conversion between et and UTC depends on the values in the - input kernel pool. The kernel pool should be loaded prior to - calling this routine. - - Before using this routine for epochs prior to Jan 1, 1972 - be sure to check the "Particulars" section to make sure - that the assumptions made in this routine are consistent - with the accuracy you require for your application. - --Literature_References - - Jesperson and Fitz-Randolph, From Sundials to Atomic Clocks, - Dover Publications, New York, 1977. - --Author_and_Institution - - W.L. Taber (JPL) - W.M. Owen (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 08-FEB-1998 (NJB) (EDW) - - Re-implemented routine without dynamically allocated, temporary - strings. Corrected typo in chkout_c module name. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) - --Index_Entries - - utc to ephemeris time - --& -*/ - -{ /* Begin utc2et_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "utc2et_c" ); - - - /* - Check the input string utcstr to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR ( CHK_STANDARD, "utc2et_c", utcstr ); - - - /* - Call the f2c'd routine. - */ - utc2et_( ( char * ) utcstr, - ( doublereal * ) et, - ( ftnlen ) strlen(utcstr) ); - - - chkout_c ( "utc2et_c" ); - - -} /* End utc2et_c */ diff --git a/ext/spice/src/cspice/util.c b/ext/spice/src/cspice/util.c deleted file mode 100644 index 6468db0cd2..0000000000 --- a/ext/spice/src/cspice/util.c +++ /dev/null @@ -1,53 +0,0 @@ -#ifndef NON_UNIX_STDIO -#define _INCLUDE_POSIX_SOURCE /* for HP-UX */ -#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ -#include "sys/types.h" -#include "sys/stat.h" -#endif -#include "f2c.h" -#include "fio.h" - - VOID -#ifdef KR_headers -g_char(a,alen,b) char *a,*b; ftnlen alen; -#else -g_char(char *a, ftnlen alen, char *b) -#endif -{ - char *x = a + alen, *y = b + alen; - - for(;; y--) { - if (x <= a) { - *b = 0; - return; - } - if (*--x != ' ') - break; - } - *y-- = 0; - do *y-- = *x; - while(x-- > a); - } - - VOID -#ifdef KR_headers -b_char(a,b,blen) char *a,*b; ftnlen blen; -#else -b_char(char *a, char *b, ftnlen blen) -#endif -{ int i; - for(i=0;i VOUT */ -/* -------------- -------------- -------------- */ -/* (1.0, 2.0, 3.0) (4.0, 5.0, 6.0) (5.0, 7.0, 9.0) */ -/* (1D-7,1D23,0) (1D24, 1D23, 0.0) (1D24,2D23,0.0) */ - -/* $ Restrictions */ - -/* The user is required to determine that the magnitude each */ -/* component of the vectors is within the appropriate range so as */ -/* not to cause floating point overflow. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* 3-dimensional vector addition */ - -/* -& */ - vout[0] = v1[0] + v2[0]; - vout[1] = v1[1] + v2[1]; - vout[2] = v1[2] + v2[2]; - return 0; -} /* vadd_ */ - diff --git a/ext/spice/src/cspice/vadd_c.c b/ext/spice/src/cspice/vadd_c.c deleted file mode 100644 index 180b713be1..0000000000 --- a/ext/spice/src/cspice/vadd_c.c +++ /dev/null @@ -1,139 +0,0 @@ -/* - --Procedure vadd_c ( Vector addition, 3 dimensional ) - --Abstract - - Add two 3 dimensional vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vadd_c - - - void vadd_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector to be added. - v2 I Second vector to be added. - vout O Sum vector, v1 + v2. - vout can overwrite either v1 or v2. - --Detailed_Input - - v1 This may be any 3-element vector. - - v2 Likewise. - --Detailed_Output - - vout This is vector sum of v1 and v2. vout may overwrite either - v1 or v2. - --Parameters - - None. - --Particulars - - This routine simply performs addition between components of v1 - and v2. No checking is performed to determine whether floating - point overflow has occurred. - --Examples - - The following table shows the output vout as a function of the - the input v1 and v2 from the subroutine vadd_c. - - v1 v2 ---> vout - -------------- -------------- -------------- - (1.0, 2.0, 3.0) (4.0, 5.0, 6.0) (5.0, 7.0, 9.0) - (1D-7,1D23,0) (1D24, 1D23, 0.0) (1D24,2D23,0.0) - --Restrictions - - The user is required to determine that the magnitude each - component of the vectors is within the appropriate range so as - not to cause floating point overflow. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - 3-dimensional vector addition - --& -*/ - -{ /* Begin vadd_c */ - - - vout[0] = v1[0] + v2[0]; - vout[1] = v1[1] + v2[1]; - vout[2] = v1[2] + v2[2]; - - -} /* End vadd_c */ diff --git a/ext/spice/src/cspice/vaddg.c b/ext/spice/src/cspice/vaddg.c deleted file mode 100644 index a45b5d4e7b..0000000000 --- a/ext/spice/src/cspice/vaddg.c +++ /dev/null @@ -1,166 +0,0 @@ -/* vaddg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VADDG ( Vector addition, general dimension ) */ -/* Subroutine */ int vaddg_(doublereal *v1, doublereal *v2, integer *ndim, - doublereal *vout) -{ - /* System generated locals */ - integer v1_dim1, v2_dim1, vout_dim1, i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Add two vectors of arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector to be added. */ -/* V2 I Second vector to be added. */ -/* NDIM I Dimension of V1, V2, and VOUT. */ -/* VOUT O Sum vector, V1 + V2. */ - -/* $ Detailed_Input */ - -/* V1 This may be any double precision vector of arbitrary */ -/* dimension. */ - -/* V2 Likewise. */ - -/* NDIM is the dimension of V1, V2 and VOUT. */ - -/* $ Detailed_Output */ - -/* VOUT This is vector sum of V1 and V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simply performs addition between components of V1 */ -/* and V2. No checking is performed to determine whether floating */ -/* point overflow has occurred. */ - -/* $ Examples */ - -/* The following table shows the output VOUT as a function of the */ -/* the input V1 and V2 from the subroutine VADD. */ - -/* V1 V2 NDIM VOUT */ -/* --------------------------------------------------------------- */ -/* (1.0, 2.0, 3.0) (4.0, 5.0, 6.0) 3 (5.0, 7.0, 9.0) */ -/* (1D-7,1D23) (1D24, 1D23) 2 (1D24, 2D23) */ - -/* $ Restrictions */ - -/* The user is required to determine that the magnitude each */ -/* component of the vectors is within the appropriate range so as */ -/* not to cause floating point overflow. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.0.2, 07-NOV-2003 (EDW) */ - -/* Corrected a mistake in the second example's value */ -/* for VOUT, i.e. replaced (1D24, 2D23, 0.0) with */ -/* (1D24, 2D23). */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* n-dimensional vector addition */ - -/* -& */ - - /* Parameter adjustments */ - vout_dim1 = *ndim; - v2_dim1 = *ndim; - v1_dim1 = *ndim; - - /* Function Body */ - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "vaddg_", (ftnlen)144)] = v1[(i__3 = i__ - 1) < - v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3, "vaddg_", ( - ftnlen)144)] + v2[(i__4 = i__ - 1) < v2_dim1 && 0 <= i__4 ? - i__4 : s_rnge("v2", i__4, "vaddg_", (ftnlen)144)]; - } - return 0; -} /* vaddg_ */ - diff --git a/ext/spice/src/cspice/vaddg_c.c b/ext/spice/src/cspice/vaddg_c.c deleted file mode 100644 index df8740dc59..0000000000 --- a/ext/spice/src/cspice/vaddg_c.c +++ /dev/null @@ -1,155 +0,0 @@ -/* - --Procedure vaddg_c ( Vector addition, general dimension ) - --Abstract - - Add two vectors of arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vaddg_c - - void vaddg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector to be added. - v2 I Second vector to be added. - ndim I Dimension of v1, v2, and vout. - vout O Sum vector, v1 + v2. - vout can overwrite either v1 or v2. - --Detailed_Input - - v1 This may be any double precision vector of arbitrary - dimension. - - v2 Likewise. - - ndim the dimension of v1, v2 and vout. - --Detailed_Output - - vout This is vector sum of v1 and v2. vout may overwrite either - v1 or v2. - --Parameters - - None. - --Particulars - - This routine simply performs addition between components of v1 - and v2. No checking is performed to determine whether floating - point overflow has occurred. - --Examples - - The following table shows the output vout as a function of the - the input v1 and v2 from the subroutine vaddg_c. - - v1 v2 ndim vout - ----------------------------------------------------------------- - [1.0, 2.0, 3.0] [4.0, 5.0, 6.0] 3 [5.0, 7.0, 9.0] - [1e-7,1e23] [1e24, 1e23] 2 [1e24, 2e23] - --Restrictions - - The user is required to determine that the magnitude each - component of the vectors is within the appropriate range so as - not to cause floating point overflow. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1 07-NOV-2003 (EDW) - - Corrected a mistake in the second example's value - for VOUT, i.e. replaced [1D24, 2D23, 0.0] with - [1e24, 2e23]. - - -CSPICE Version 1.0.0, 29-JUN-1999 - --Index_Entries - - n-dimensional vector addition - --& -*/ - -{ /* Begin vaddg_c */ - - /* - Local variables - */ - SpiceInt i; - - - /* - Do it. This isn't rocket science. - */ - for ( i = 0; i < ndim; i++ ) - { - vout[i] = v1[i] + v2[i]; - } - - -} /* End vaddg_c */ diff --git a/ext/spice/src/cspice/valid_c.c b/ext/spice/src/cspice/valid_c.c deleted file mode 100644 index 7cb9d96d98..0000000000 --- a/ext/spice/src/cspice/valid_c.c +++ /dev/null @@ -1,322 +0,0 @@ -/* - --Procedure valid_c ( Validate a set ) - --Abstract - - Create a valid CSPICE set from a CSPICE Cell of any data type. - --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 - - SETS - --Keywords - - CELLS, SETS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - void valid_c ( SpiceInt size, - SpiceInt n, - SpiceCell * set ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - size I Size (maximum cardinality) of the set. - n I Initial no. of (possibly non-distinct) elements. - set I/O Set to be validated. - --Detailed_Input - - size is the maximum cardinality (number of elements) - of the set. size must not exceed the declared size - of the set's data array. - - n is the number of (possibly non-distinct) elements - initially contained in the set's data array. - N cannot be greater than the size of the set. - - set is a CSPICE set. set must be declared as a character, - double precision, or integer SpiceCell. - - On input, set contains n elements. - --Detailed_Output - - set on output is a valid set created from the input set. - - To create a valid set, the elements are ordered, and - duplicate elements are removed. The set's size and - cardinality members are assigned their correct values. - - The set is ready for use with other set routines. - - When validating a character set, trailing blanks are not - considered significant in process of sorting and - removing duplicates. Trailing blanks are not preserved - on output. - --Parameters - - None. - --Exceptions - - 1) If the size of the set is too small to hold the set - BEFORE validation, the error SPICE(INVALIDSIZE) is signaled. - The set is not modified. - --Files - - None. - --Particulars - - Because a set is ordered and contains distinct values, to create a - set from a cell, it is necessary to sort the data array and remove - duplicates. Once the array has been sorted, duplicate elements - (adjacent after sorting) are removed. The size and cardinality of - the set are initialized, and the set is ready to go. - - This routine is typically used to create a CSPICE set from a CSPICE - cell whose array which has been initialized via calls the appnd*_c - routines, or through compile-time array initializers, or I/O - statements. The resulting set can then be used with the other set - routines. - - When a set is constructed from a large set of unordered values, - it is far more efficient to append the values to the set and - then validate the set, than to build up the set via calls to the - insrt*_c routines. The latter sort the set and remove duplicates - on each insertion. - - Because validation is done in place, there is no chance of - overflow. - --Examples - - 1) Build a double precision cell via a series of calls to appndd_c. - Create a set from this set by calling valid_c. - - #include "SpiceUsr.h" - - int main() - { - /. - Declare the set. SETSIZ is the maximum capacity of the set. - ./ - #define SETSIZ 1000000 - - SPICEDOUBLE_CELL ( dpSet, SETSIZ ); - - /. - INISIZ will be the initial number of elements in the set. - ./ - #define INISIZ 100000 - - /. - Other local variables: - ./ - SpiceInt i; - - /. - Initialize the cell's data array. We use bogus values to - simplify the example. - ./ - for ( i = 0; i < INISIZ; i++ ) - { - appndd_c ( (SpiceDouble)(-i), &dpset ); - } - - /. - Validate the set. The elements of the set will be arranged - in increasing order after this call. - ./ - valid_c ( SETSIZ, INISIZ, &dpSet ); - - return ( 0 ); - } - - --Restrictions - - None. - --Literature_References - - 1) String comparisons performed by this routine are Fortran-style: - trailing blanks in the input sets 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. - --Author_and_Institution - - N.J. Bachman (JPL) - C.A. Curzon (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 12-NOV-2006 (EDW) - - Corrected minor type, the Literature_References header - lacked the prefix "-". - - -CSPICE Version 1.0.0, 08-AUG-2002 (NJB) (CAC) (WLT) (IMU) - --Index_Entries - - validate a set - --& -*/ -{ - /* - Local variables - */ - SpiceChar * fCell; - - SpiceInt fLen; - - - - /* - Standard SPICE error handling. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "valid_c" ); - - - /* - Unlike most other cell routines, we do not initialize the cell's - size and cardinality at this point. - */ - - - /* - Call the valid* routine appropriate for the data type of the set. - */ - if ( set->dtype == SPICE_CHR ) - { - - /* - Construct a Fortran-style set suitable for passing to validc_. - */ - C2F_MAP_CELL ( "valid_c", set, &fCell, &fLen ); - - - if ( failed_c() ) - { - chkout_c ( "valid_c" ); - return; - } - - - validc_ ( (integer *) &size, - (integer *) &n, - (char *) fCell, - (ftnlen ) fLen ); - - /* - Map the validated set back to a C style set. This mapping - sets the size and cardinality members of the cell. - */ - F2C_MAP_CELL ( fCell, fLen, set ); - - /* - We're done with the dynamically allocated Fortran-style array. - */ - free ( fCell ); - - } - - else if ( set->dtype == SPICE_DP ) - { - validd_ ( (integer *) &size, - (integer *) &n, - (doublereal *) (set->base) ); - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, set ); - } - - } - - else if ( set->dtype == SPICE_INT ) - { - validi_ ( (integer *) &size, - (integer *) &n, - (integer *) (set->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, set ); - } - - } - - else - { - setmsg_c ( "Cell set contains unrecognized data type code #." ); - errint_c ( "#", (SpiceInt) (set->dtype) ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "valid_c" ); - return; - } - - - /* - Indicate the result is a set. - */ - set->isSet = SPICETRUE; - - - chkout_c ( "valid_c" ); -} diff --git a/ext/spice/src/cspice/validc.c b/ext/spice/src/cspice/validc.c deleted file mode 100644 index a860bfeddd..0000000000 --- a/ext/spice/src/cspice/validc.c +++ /dev/null @@ -1,225 +0,0 @@ -/* validc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VALIDC ( Validate a character set ) */ -/* Subroutine */ int validc_(integer *size, integer *n, char *a, ftnlen a_len) -{ - integer card; - extern /* Subroutine */ int chkin_(char *, ftnlen), scardc_(integer *, - char *, ftnlen), rmdupc_(integer *, char *, ftnlen), sigerr_(char - *, ftnlen), chkout_(char *, ftnlen), ssizec_(integer *, char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Create a valid set from a character set array. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size (maximum cardinality) of the set. */ -/* N I Initial no. of (possibly non-distinct) elements. */ -/* A I/O Set to be validated. */ - -/* $ Detailed_Input */ - -/* SIZE is the maximum cardinality (number of elements) */ -/* of the set. */ - -/* N is the number of (possibly non-distinct) elements */ -/* initially contained in the array used to maintain */ -/* the set. N cannot be greater than the size of the */ -/* set. */ - - -/* A is a set. */ - - -/* On input, A contains N elements beginning at A(1). */ -/* To create a valid set, the elements are ordered, */ -/* and duplicate elements are removed. The contents */ -/* of A(LBCELL) through A(0) are lost during validation. */ - -/* $ Detailed_Output */ - -/* A on output, is the set containing the ordered, */ -/* distinct values in the input array, ready for */ -/* use with other set routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is typically used to turn an array which has been */ -/* initialized through DATA or I/O statements into a set, which */ -/* can then be used with the other set routines. */ - -/* Because a set is ordered and contains distinct values, to */ -/* create a set from an array, it is necessary to sort the array */ -/* into the set and remove duplicates. Once the array has been */ -/* sorted, duplicate elements (adjacent after sorting) are removed. */ -/* The size and cardinality of the set are initialized, and the */ -/* set is ready to go. */ - -/* Because validation is done in place, there is no chance of */ -/* overflow. */ - -/* $ Examples */ - -/* Empty sets may be initialized with the cell routines SSIZEx. */ -/* Sets may also be initialized from nonempty set arrays. */ -/* This process, called validation, is done by the set routines */ -/* VALIDC and VALIDI. In the following example, */ - -/* INTEGER BODIES ( LBCELL:100 ) */ - -/* DATA ( BODIES(I), I=1,8) / 3, 301, */ -/* . 3, 399, */ -/* . 5, 501, */ -/* . 6, 601, / */ - -/* CALL VALIDI ( 100, 8, BODIES ) */ - -/* the integer set BODIES is validated. The size of BODIES set to */ -/* 100. The eight elements of the array (stored in elements 1-8) */ -/* are sorted, and duplicate elements (in this case, the number 3, */ -/* which appears twice) are removed, and the cardinality of the set */ -/* is set to the number of distinct elements, now seven. The set is */ -/* now ready for use with the rest of the set routines. */ - -/* The previous contents of elements LBCELL through 0 are lost */ -/* during the process of validation. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the set is too small to hold the set */ -/* BEFORE validation, the error SPICE(INVALIDSIZE) is */ -/* signalled. The array A is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* validate a character set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. Check for adequate set size added. */ - -/* The examples have been updated to illustrate set initialization */ -/* without the use of the EMPTYx routines, which have been */ -/* removed from the library. Errors in the examples have been */ -/* removed, also. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("VALIDC", (ftnlen)6); - } - -/* Is the set size big enough? */ - - if (*n > *size) { - setmsg_("Size of un-validated set is too small. Size is #, size req" - "uired is #. ", (ftnlen)71); - errint_("#", size, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("VALIDC", (ftnlen)6); - return 0; - } - -/* Just like it says above. Order the array, and remove duplicates. */ - - card = *n; - rmdupc_(&card, a + a_len * 6, a_len); - -/* Set the size and cardinality of the input set. */ - - ssizec_(size, a, a_len); - scardc_(&card, a, a_len); - chkout_("VALIDC", (ftnlen)6); - return 0; -} /* validc_ */ - diff --git a/ext/spice/src/cspice/validd.c b/ext/spice/src/cspice/validd.c deleted file mode 100644 index 8d5043dd5c..0000000000 --- a/ext/spice/src/cspice/validd.c +++ /dev/null @@ -1,228 +0,0 @@ -/* validd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VALIDD ( Validate a double precision set ) */ -/* Subroutine */ int validd_(integer *size, integer *n, doublereal *a) -{ - integer card; - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), sigerr_(char *, ftnlen), rmdupd_(integer *, - doublereal *), chkout_(char *, ftnlen), ssized_(integer *, - doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Create a valid set from a double precision set array. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size (maximum cardinality) of the set. */ -/* N I Initial no. of (possibly non-distinct) elements. */ -/* A I/O Set to be validated. */ - -/* $ Detailed_Input */ - -/* SIZE is the maximum cardinality (number of elements) */ -/* of the set. */ - -/* N is the number of (possibly non-distinct) elements */ -/* initially contained in the array used to maintain */ -/* the set. N cannot be greater than the size of the */ -/* set. */ - - -/* A is a set. */ - - -/* On input, A contains N elements beginning at A(1). */ -/* To create a valid set, the elements are ordered, */ -/* and duplicate elements are removed. The contents */ -/* of A(LBCELL) through A(0) are lost during validation. */ - -/* $ Detailed_Output */ - -/* A on output, is the set containing the ordered, */ -/* distinct values in the input array, ready for */ -/* use with other set routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is typically used to turn an array which has been */ -/* initialized through DATA or I/O statements into a set, which */ -/* can then be used with the other set routines. */ - -/* Because a set is ordered and contains distinct values, to */ -/* create a set from an array, it is necessary to sort the array */ -/* into the set and remove duplicates. Once the array has been */ -/* sorted, duplicate elements (adjacent after sorting) are removed. */ -/* The size and cardinality of the set are initialized, and the */ -/* set is ready to go. */ - -/* Because validation is done in place, there is no chance of */ -/* overflow. */ - -/* $ Examples */ - -/* Empty sets may be initialized with the cell routines SSIZEx. */ -/* Sets may also be initialized from nonempty set arrays. */ -/* This process, called validation, is done by the set routines */ -/* VALIDC and VALIDI. In the following example, */ - -/* INTEGER BODIES ( LBCELL:100 ) */ - -/* DATA ( BODIES(I), I=1,8) / 3, 301, */ -/* . 3, 399, */ -/* . 5, 501, */ -/* . 6, 601, / */ - -/* CALL VALIDI ( 100, 8, BODIES ) */ - -/* the integer set BODIES is validated. The size of BODIES set to */ -/* 100. The eight elements of the array (stored in elements 1-8) */ -/* are sorted, and duplicate elements (in this case, the number 3, */ -/* which appears twice) are removed, and the cardinality of the set */ -/* is set to the number of distinct elements, now seven. The set is */ -/* now ready for use with the rest of the set routines. */ - -/* The previous contents of elements LBCELL through 0 are lost */ -/* during the process of validation. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the set is too small to hold the set */ -/* BEFORE validation, the error SPICE(INVALIDSIZE) is */ -/* signalled. The array A is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* validate a d.p. set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. Check for adequate set size added. */ - -/* The examples have been updated to illustrate set initialization */ -/* without the use of the EMPTYx routines, which have been */ -/* removed from the library. Errors in the examples have been */ -/* removed, also. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling: */ - - if (return_()) { - return 0; - } else { - chkin_("VALIDD", (ftnlen)6); - } - -/* Is the set size big enough? */ - - if (*n > *size) { - setmsg_("Size of un-validated set is too small. Size is #, size req" - "uired is #. ", (ftnlen)71); - errint_("#", size, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("VALIDD", (ftnlen)6); - return 0; - } - -/* Just like it says above. Order the array, and remove duplicates. */ - - card = *n; - rmdupd_(&card, &a[6]); - -/* Set the size and cardinality of the input set. */ - - ssized_(size, a); - scardd_(&card, a); - chkout_("VALIDD", (ftnlen)6); - return 0; -} /* validd_ */ - diff --git a/ext/spice/src/cspice/validi.c b/ext/spice/src/cspice/validi.c deleted file mode 100644 index e5a36a2072..0000000000 --- a/ext/spice/src/cspice/validi.c +++ /dev/null @@ -1,224 +0,0 @@ -/* validi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VALIDI ( Validate an integer set ) */ -/* Subroutine */ int validi_(integer *size, integer *n, integer *a) -{ - integer card; - extern /* Subroutine */ int chkin_(char *, ftnlen), scardi_(integer *, - integer *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - rmdupi_(integer *, integer *), setmsg_(char *, ftnlen), errint_( - char *, integer *, ftnlen), ssizei_(integer *, integer *); - extern logical return_(void); - -/* $ Abstract */ - -/* Create a valid set from an integer set array. */ - -/* $ 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 */ - -/* SETS */ - -/* $ Keywords */ - -/* CELLS, SETS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size (maximum cardinality) of the set. */ -/* N I Initial no. of (possibly non-distinct) elements. */ -/* A I/O Set to be validated. */ - -/* $ Detailed_Input */ - -/* SIZE is the maximum cardinality (number of elements) */ -/* of the set. */ - -/* N is the number of (possibly non-distinct) elements */ -/* initially contained in the array used to maintain */ -/* the set. N cannot be greater than the size of the */ -/* set. */ - - -/* A is a set. */ - - -/* On input, A contains N elements beginning at A(1). */ -/* To create a valid set, the elements are ordered, */ -/* and duplicate elements are removed. The contents */ -/* of A(LBCELL) through A(0) are lost during validation. */ - -/* $ Detailed_Output */ - -/* A on output, is the set containing the ordered, */ -/* distinct values in the input array, ready for */ -/* use with other set routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is typically used to turn an array which has been */ -/* initialized through DATA or I/O statements into a set, which */ -/* can then be used with the other set routines. */ - -/* Because a set is ordered and contains distinct values, to */ -/* create a set from an array, it is necessary to sort the array */ -/* into the set and remove duplicates. Once the array has been */ -/* sorted, duplicate elements (adjacent after sorting) are removed. */ -/* The size and cardinality of the set are initialized, and the */ -/* set is ready to go. */ - -/* Because validation is done in place, there is no chance of */ -/* overflow. */ - -/* $ Examples */ - -/* Empty sets may be initialized with the cell routines SSIZEx. */ -/* Sets may also be initialized from nonempty set arrays. */ -/* This process, called validation, is done by the set routines */ -/* VALIDC, VALIDD, and VALIDI. In the following example, */ - -/* INTEGER BODIES ( LBCELL:100 ) */ - -/* DATA ( BODIES(I), I=1,8) / 3, 301, */ -/* . 3, 399, */ -/* . 5, 501, */ -/* . 6, 601, / */ - -/* CALL VALIDI ( 100, 8, BODIES ) */ - -/* the integer set BODIES is validated. The size of BODIES set to */ -/* 100. The eight elements of the array (stored in elements 1-8) */ -/* are sorted, and duplicate elements (in this case, the number 3, */ -/* which appears twice) are removed, and the cardinality of the set */ -/* is set to the number of distinct elements, now seven. The set is */ -/* now ready for use with the rest of the set routines. */ - -/* The previous contents of elements LBCELL through 0 are lost */ -/* during the process of validation. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the set is too small to hold the set */ -/* BEFORE validation, the error SPICE(INVALIDSIZE) is */ -/* signalled. The array A is not modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* C.A. Curzon (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (CAC) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* validate an integer set */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */ - -/* Now participates in error handling. References to RETURN, */ -/* CHKIN, and CHKOUT added. Check for adequate set size added. */ - -/* The examples have been updated to illustrate set initialization */ -/* without the use of the EMPTYx routines, which have been */ -/* removed from the library. Errors in the examples have been */ -/* removed, also. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } else { - chkin_("VALIDI", (ftnlen)6); - } - -/* Is the set size big enough? */ - - if (*n > *size) { - setmsg_("Size of un-validated set is too small. Size is #, size req" - "uired is #. ", (ftnlen)71); - errint_("#", size, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("VALIDI", (ftnlen)6); - return 0; - } - -/* Just like it says above. Order the array, and remove duplicates. */ - - card = *n; - rmdupi_(&card, &a[6]); - -/* Set the size and cardinality of the input set. */ - - ssizei_(size, a); - scardi_(&card, a); - chkout_("VALIDI", (ftnlen)6); - return 0; -} /* validi_ */ - diff --git a/ext/spice/src/cspice/vcrss.c b/ext/spice/src/cspice/vcrss.c deleted file mode 100644 index 38d7c2b4f2..0000000000 --- a/ext/spice/src/cspice/vcrss.c +++ /dev/null @@ -1,155 +0,0 @@ -/* vcrss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VCRSS ( Vector cross product, 3 dimensions ) */ -/* Subroutine */ int vcrss_(doublereal *v1, doublereal *v2, doublereal *vout) -{ - doublereal vtemp[3]; - -/* $ Abstract */ - -/* Compute the cross product of two 3-dimensional vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Left hand vector for cross product. */ -/* V2 I Right hand vector for cross product. */ -/* VOUT O Cross product V1xV2. */ - -/* $ Detailed_Input */ - -/* V1 This may be any 3-dimensional vector. Typically, this */ -/* might represent the (possibly unit) vector to a planet, */ -/* sun, or a star which defines the orientation of axes of */ -/* some coordinate system. */ - -/* V2 Ditto. */ - -/* $ Detailed_Output */ - -/* VOUT This variable represents the cross product of V1 and V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* VCRSS calculates the three dimensional cross product of two */ -/* vectors according to the definition. */ - -/* If V1 and V2 are large in magnitude (taken together, their */ -/* magnitude surpasses the limit allow by the computer) then it may */ -/* be possible to generate a floating point overflow from an */ -/* intermediate computation even though the actual cross product may */ -/* be well within the range of double precision numbers. VCRSS does */ -/* NOT check the magnitude of V1 or V2 to insure that overflow will */ -/* not occur. */ -/* $ Examples */ - -/* V1 V2 VOUT (=V1XV2) */ -/* ----------------------------------------------------------------- */ -/* (0, 1, 0) (1, 0, 0) (0, 0, -1) */ -/* (5, 5, 5) (-1, -1, -1) (0, 0, 0) */ - -/* $ Restrictions */ - -/* No checking of V1 or V2 is done to prevent floating point */ -/* overflow. The user is required to determine that the magnitude of */ -/* each component of the vectors is within an appropriate range so */ -/* as not to cause floating point overflow. In almost every case */ -/* there will be no problem and no checking actually needs to be */ -/* done. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* vector cross product */ - -/* -& */ - -/* Calculate the cross product of V1 and V2, store in VTEMP */ - - vtemp[0] = v1[1] * v2[2] - v1[2] * v2[1]; - vtemp[1] = v1[2] * v2[0] - v1[0] * v2[2]; - vtemp[2] = v1[0] * v2[1] - v1[1] * v2[0]; - -/* Now move the result into VOUT */ - - vout[0] = vtemp[0]; - vout[1] = vtemp[1]; - vout[2] = vtemp[2]; - - return 0; -} /* vcrss_ */ - diff --git a/ext/spice/src/cspice/vcrss_c.c b/ext/spice/src/cspice/vcrss_c.c deleted file mode 100644 index 9635fcb3e1..0000000000 --- a/ext/spice/src/cspice/vcrss_c.c +++ /dev/null @@ -1,174 +0,0 @@ -/* - --Procedure vcrss_c ( Vector cross product, 3 dimensions ) - --Abstract - - Compute the cross product of two 3-dimensional vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vcrss_c - - - void vcrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Left hand vector for cross product. - v2 I Right hand vector for cross product. - vout O Cross product v1xv2. - vout can overwrite either v1 or v2. - --Detailed_Input - - v1 This may be any 3-dimensional vector. Typically, this - might represent the (possibly unit) vector to a planet, - sun, or a star which defines the orientation of axes of - some coordinate system. - - v2 Ditto. - --Detailed_Output - - vout This variable represents the cross product of v1 and v2. - vout may overwrite v1 or v2. - --Parameters - - None. - --Particulars - - vcrss_c calculates the three dimensional cross product of two - vectors according to the definition. The cross product is stored - in a buffer vector until the calculation is complete. Thus vout - may overwrite v1 or v2 without interfering with intermediate - computations. - - If v1 and v2 are large in magnitude (taken together, their - magnitude surpasses the limit allow by the computer) then it may - be possible to generate a floating point overflow from an - intermediate computation even though the actual cross product - may be well within the range of double precision numbers. - vcrss_c does NOT check the magnitude of v1 or v2 to insure that - overflow will not occur. - --Examples - - v1 v2 vout (=v1Xv2) - ----------------------------------------------------------------- - (0, 1, 0) (1, 0, 0) (0, 0, -1) - (5, 5, 5) (-1, -1, -1) (0, 0, 0) - --Restrictions - - No checking of v1 or v2 is done to prevent floating point - overflow. The user is required to determine that the magnitude - of each component of the vectors is within an appropriate range - so as not to cause floating point overflow. In almost every case - there will be no problem and no checking actually needs to be - done. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.1, 06-MAR-1998 (EDW) - - Minor header correction. Added use of MOVED. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - vector cross product - --& -*/ - -{ /* Begin vcrss_c */ - - /* - Local variables - */ - - SpiceDouble vtemp[3]; - - - /* - Calculate the cross product of v1 and v2, store in vtemp. - */ - - vtemp[0] = v1[1]*v2[2] - v1[2]*v2[1]; - vtemp[1] = v1[2]*v2[0] - v1[0]*v2[2]; - vtemp[2] = v1[0]*v2[1] - v1[1]*v2[0]; - - - /* - Now move the result into vout. - */ - - MOVED ( vtemp, 3, vout ); - - -} /* End vcrss_c */ diff --git a/ext/spice/src/cspice/vdist.c b/ext/spice/src/cspice/vdist.c deleted file mode 100644 index ba394730d3..0000000000 --- a/ext/spice/src/cspice/vdist.c +++ /dev/null @@ -1,192 +0,0 @@ -/* vdist.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VDIST ( Vector distance ) */ -doublereal vdist_(doublereal *v1, doublereal *v2) -{ - /* System generated locals */ - doublereal ret_val; - - /* Local variables */ - doublereal diff[3]; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vnorm_(doublereal *); - -/* $ Abstract */ - -/* Return the distance between two three-dimensional vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ - -/* V1, */ -/* V2 I Two 3-vectors. */ - -/* The function returns the distance between V1 and V2. */ - -/* $ Detailed_Input */ - -/* V1, */ -/* V2 are two vectors in three-dimensional space, the */ -/* distance between which is desired. */ - -/* $ Detailed_Output */ - -/* The function returns the distance between V1 and V2. This is */ -/* defined as */ - -/* || V1 - V2 ||, */ - -/* where || x || indicates the Euclidean norm of the vector x. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function is simply shorthand for the code */ - -/* CALL VSUB ( V1, V2, DIFF ) */ - -/* DIST = VNORM ( DIFF ) */ - -/* Using this function saves you the annoyance of declaring local */ -/* storage for the difference vector DIFF. */ - - -/* The Euclidean norm of a three-dimensional vector (x, y, z) is */ -/* defined as */ - -/* 1/2 */ -/* 2 2 2 */ -/* ( x + y + z ). */ - - -/* This number is the distance of the point (x, y, z) from the */ -/* origin. If A and B are two vectors whose components are */ - -/* ( A(1), A(2), A(3) ) and ( B(1), B(2), B(3) ), */ - -/* then the distance between A and B is the norm of the difference */ -/* A - B, which has components */ - - -/* ( A(1) - B(1), A(2) - B(2), A(3) - B(3) ). */ - - -/* A related routine is VDISTG, which computes the distance between */ -/* two vectors of general dimension. */ - -/* $ Examples */ - -/* 1) If V1 is */ - -/* ( 2.0D0, 3.0D0, 0.D0 ) */ - -/* and V2 is */ - -/* ( 5.0D0, 7.0D0, 12.D0 ), */ - -/* VDIST (V1, V2) will be 13.D0. */ - - -/* 2) If VGR2 and NEP are states of the Voyager 2 spacecraft and */ -/* Neptune with respect to some common center at a given time */ -/* ET, then */ - -/* VDIST ( VGR2, NEP ) */ - -/* yields the distance between the spacecraft and Neptune at time */ -/* ET. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 08-JUL-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* distance between 3-dimensional vectors */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* No surprises. */ - - vsub_(v1, v2, diff); - ret_val = vnorm_(diff); - return ret_val; -} /* vdist_ */ - diff --git a/ext/spice/src/cspice/vdist_c.c b/ext/spice/src/cspice/vdist_c.c deleted file mode 100644 index e0cc56f6e2..0000000000 --- a/ext/spice/src/cspice/vdist_c.c +++ /dev/null @@ -1,194 +0,0 @@ -/* - --Procedure vdist_c ( Vector distance ) - --Abstract - - Return the distance between two three-dimensional vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vdist_c - - - SpiceDouble vdist_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - - v1, - v2 I Two 3-vectors. - - The function returns the distance between v1 and v2. - --Detailed_Input - - v1, - v2 are two vectors in three-dimensional space, the - distance between which is desired. - --Detailed_Output - - The function returns the distance between v1 and v2. This is - defined as - - || v1 - v2 ||, - - where || x || indicates the Euclidean norm of the vector x. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This function is simply shorthand for the code - - vsub_c ( v1, v2, diff ); - - dist = vnorm_c ( diff ); - - Using this function saves you the annoyance of declaring local - storage for the difference vector diff. - - - The Euclidean norm of a three-dimensional vector (x, y, z) is - defined as - - 1/2 - 2 2 2 - ( x + y + z ). - - - This number is the distance of the point (x, y, z) from the - origin. If A and B are two vectors whose components are - - ( A(1), A(2), A(3) ) and ( B(1), B(2), B(3) ), - - then the distance between A and B is the norm of the difference - A - B, which has components - - - ( A(1) - B(1), A(2) - B(2), A(3) - B(3) ). - - - A related routine is vdistg_, which computes the distance between - two vectors of general dimension. - --Examples - - 1) If v1 is - - ( 2.0, 3.0, 0. ) - - and v2 is - - ( 5.0, 7.0, 12. ), - - vdist_c (v1, v2) will be 13.. - - - 2) If VGR2 and NEP are states of the Voyager 2 spacecraft and - Neptune with respect to some common center at a given time - ET, then - - vdist_c ( VGR2, NEP ) - - yields the distance between the spacecraft and Neptune at time - ET. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.2.0, 22-OCT-1998 (NJB) - - Made input vectors const. Removed #include of SpiceZfc.h. - - -CSPICE Version 1.1.0, 06-MAR-1998 (EDW) - - Removed non printing character. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - distance between 3-dimensional vectors - --& -*/ - -{ /* Begin vdist_c */ - - /* - Local constants - */ - - SpiceDouble diff[3]; - - - /* Function Body */ - - vsub_c ( v1, v2, diff); - - - return vnorm_c (diff); - -} /* End vdist_c */ diff --git a/ext/spice/src/cspice/vdistg.c b/ext/spice/src/cspice/vdistg.c deleted file mode 100644 index 25a9f924d6..0000000000 --- a/ext/spice/src/cspice/vdistg.c +++ /dev/null @@ -1,212 +0,0 @@ -/* vdistg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VDISTG ( Vector distance, general dimension ) */ -doublereal vdistg_(doublereal *v1, doublereal *v2, integer *ndim) -{ - /* System generated locals */ - integer i__1; - doublereal ret_val, d__1, d__2, d__3; - - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - integer i__; - doublereal scale; - -/* $ Abstract */ - -/* Return the distance between two vectors of arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* V1, */ -/* V2 I Two vectors of arbitrary dimension. */ -/* NDIM I The common dimension of V1 and V2 */ - -/* The function returns the distance between V1 and V2. */ - -/* $ Detailed_Input */ - -/* V1, */ -/* V2 are two vectors of arbitrary dimension, the */ -/* distance between which is desired. */ - -/* NDIM is the common dimension of V1 and V2. NDIM must be */ -/* non-negative and must not exceed the minimum of the */ -/* declared sizes of the actual arguments corresponding */ -/* to V1 and V2. */ - -/* $ Detailed_Output */ - -/* The function returns the distance between V1 and V2. This is */ -/* defined as */ - -/* || V1 - V2 ||, */ - -/* where || x || indicates the Euclidean norm of the vector x. */ - -/* If NDIM is less than 1, the function value is set to 0.D0. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The Euclidean norm of an n-dimensional vector */ - -/* (x , x , ... , x ) */ -/* 1 2 n */ - -/* is defined as */ - -/* 1/2 */ -/* 2 2 2 */ -/* ( x + x + . . . + x ). */ -/* 1 2 n */ - -/* This number is the distance of the point (x, y, z) from the */ -/* origin. If n = 3, and A and B are two vectors whose components */ -/* are */ - -/* ( A(1), A(2), A(3) ) and ( B(1), B(2), B(3) ), */ - -/* then the distance between A and B is the norm of the difference */ -/* A - B, which has components */ - -/* ( A(1) - B(1), A(2) - B(2), A(3) - B(3) ). */ - -/* A related routine is VDIST, which computes the distance between */ -/* two 3-vectors. */ - -/* $ Examples */ - -/* 1) If V1 is */ - -/* ( 2.0D0, 3.0D0 ) */ - -/* and V2 is */ - -/* ( 5.0D0, 7.0D0 ), */ - -/* and NDIM is 2, then */ - -/* VDISTG (V1, V2, NDIM ) */ - -/* will be 5.D0. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 17-JUL-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* distance between n-dimensional vectors */ - -/* -& */ - -/* Local variables */ - - -/* We find the norm of a scaled version of the difference vector, */ -/* and then rescale this norm. This method helps prevent overflow */ -/* due to squaring the components of the difference vector. */ - -/* The code here is almost identical to that of VNORMG. We'd love */ -/* to just call VNORMG, but that would require storage for the */ -/* difference vector. So we do the job ourselves. */ - - -/* Find the scale factor. */ - - scale = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing MAX */ - d__2 = scale, d__3 = (d__1 = v1[i__ - 1] - v2[i__ - 1], abs(d__1)); - scale = max(d__2,d__3); - } - if (scale == 0.) { - ret_val = 0.; - return ret_val; - } else { - ret_val = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing 2nd power */ - d__1 = (v1[i__ - 1] - v2[i__ - 1]) / scale; - ret_val += d__1 * d__1; - } - ret_val = scale * sqrt(ret_val); - } - return ret_val; -} /* vdistg_ */ - diff --git a/ext/spice/src/cspice/vdistg_c.c b/ext/spice/src/cspice/vdistg_c.c deleted file mode 100644 index 9342730df0..0000000000 --- a/ext/spice/src/cspice/vdistg_c.c +++ /dev/null @@ -1,224 +0,0 @@ -/* - --Procedure vdistg_c ( Vector distance, general dimension ) - --Abstract - - Return the distance between two vectors of arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vdistg_c - - - SpiceDouble vdistg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - v1, - v2 I Two vectors of arbitrary dimension. - ndim I The common dimension of v1 and v2 - - The function returns the distance between v1 and v2. - --Detailed_Input - - v1, - v2 are two vectors of arbitrary dimension, the - distance between which is desired. - - ndim is the common dimension of v1 and v2. ndim must be - non-negative and must not exceed the minimum of the - declared sizes of the actual arguments corresponding - to v1 and v2. - --Detailed_Output - - The function returns the distance between v1 and v2. This is - defined as - - || v1 - v2 ||, - - where || x || indicates the Euclidean norm of the vector x. - - If ndim is less than 1, the function value is set to 0.. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - The Euclidean norm of an n-dimensional vector - - (x , x , ... , x ) - 1 2 n - - is defined as - - 1/2 - 2 2 2 - ( x + x + . . . + x ). - 1 2 n - - This number is the distance of the point (x, y, z) from the - origin. If n = 3, and A and B are two vectors whose components - are - - ( a[0], a[1], a[2] ) and ( b[0], b[1], b[2] ), - - then the distance between A and B is the norm of the difference - A - B, which has components - - ( a[0] - b[0], a[1] - b[1], a[2] - b[2] ). - - A related routine is vdist_c, which computes the distance between - two 3-vectors. - --Examples - - 1) If v1 is - - [ 2.0, 3.0 ] - - and v2 is - - [ 5.0, 7.0 ], - - and ndim is 2, then - - vdistg_c ( v1, v2, ndim ); - - will be 5.0. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 23-MAR-1998 (EDW) - --Index_Entries - - distance between n-dimensional vectors - --& -*/ - -{ /* Begin vdistg_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceDouble dist; - SpiceDouble scale; - - - /* Initialize dist and scale to zero. */ - - dist = 0.; - scale = 0.; - - - /* Check ndim makes sense. */ - - if ( ndim <= 0 ) - { - return 0.; - } - - - /* - Determine an appropriate scale factor to prevent numerical - overflow. Overflow would be bad! - */ - - for ( i = 0; i < ndim; i++ ) - { - scale = MaxAbs( scale, v1[i] - v2[i] ); - } - - - /* If the vectors are equal, return zero. */ - - if ( scale == 0. ) - { - return 0.; - } - - - /* Do the calculation. Not very involved. */ - - for ( i = 0; i < ndim; i++ ) - { - dist += pow( ( v1[i] - v2[i] ) / scale, 2 ); - } - - return ( scale * sqrt( dist ) ); - - -} /* End vdistg_c */ diff --git a/ext/spice/src/cspice/vdot.c b/ext/spice/src/cspice/vdot.c deleted file mode 100644 index 41460f2cc8..0000000000 --- a/ext/spice/src/cspice/vdot.c +++ /dev/null @@ -1,137 +0,0 @@ -/* vdot.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VDOT ( Vector dot product, 3 dimensions ) */ -doublereal vdot_(doublereal *v1, doublereal *v2) -{ - /* System generated locals */ - doublereal ret_val; - -/* $ Abstract */ - -/* Compute the dot product of two double precision, 3-dimensional */ -/* vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector in the dot product. */ -/* V2 I Second vector in the dot product. */ - -/* The function returns the value of the dot product of V1 and V2. */ - -/* $ Detailed_Input */ - -/* V1 This may be any 3-dimensional, double precision vector. */ - -/* V2 This may be any 3-dimensional, double precision vector. */ - -/* $ Detailed_Output */ - -/* The function returns the value of the dot product of V1 and V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* VDOT calculates the dot product of V1 and V2 by a simple */ -/* application of the definition. No error checking is */ -/* performed to prevent numeric overflow. */ - -/* $ Examples */ - -/* Suppose that given two position vectors, we want to change */ -/* one of the positions until the two vectors are perpendicular. */ -/* The following code fragment demonstrates the use of VDOT to do */ -/* so. */ - -/* DOT = VDOT ( V1, V2 ) */ - -/* DO WHILE ( DOT .NE. 0.0D0 ) */ -/* change one of the position vectors */ -/* DOT = VDOT ( V1, V2 ) */ -/* END DO */ - -/* $ Restrictions */ - -/* The user is responsible for determining that the vectors V1 and */ -/* V2 are not so large as to cause numeric overflow. In most cases */ -/* this won't present a problem. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* dot product 3-dimensional vectors */ - -/* -& */ - ret_val = v1[0] * v2[0] + v1[1] * v2[1] + v1[2] * v2[2]; - - return ret_val; -} /* vdot_ */ - diff --git a/ext/spice/src/cspice/vdot_c.c b/ext/spice/src/cspice/vdot_c.c deleted file mode 100644 index 9895b1d1e5..0000000000 --- a/ext/spice/src/cspice/vdot_c.c +++ /dev/null @@ -1,151 +0,0 @@ -/* - --Procedure vdot_c ( Vector dot product, 3 dimensions ) - --Abstract - - Compute the dot product of two double precision, 3-dimensional - vectors. - --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 - - VECTOR - -*/ - - #include - #include "SpiceUsr.h" - #undef vdot_c - - - SpiceDouble vdot_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector in the dot product. - v2 I Second vector in the dot product. - - The function returns the value of the dot product of v1 and v2. - --Detailed_Input - - v1 This may be any 3-dimensional, double precision vector. - - v2 This may be any 3-dimensional, double precision vector. - --Detailed_Output - - The function returns the value of the dot product of v1 and v2. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - vdot_c calculates the dot product of v1 and v2 by a simple - application of the definition. No error checking is performed to - prevent numeric overflow. - --Examples - - Suppose that given two position vectors, we want to change - one of the positions until the two vectors are perpendicular. - The following code fragment demonstrates the use of vdot_c to do so. - - dot = vdot_c ( v1, v2 ) - - while ( fabs(dot) > tolerance ) - { - [ CHANGE ONE OF THE POSITION VECTORS ] - - dot = vdot_c ( v1, v2 ) - } - - --Restrictions - - The user is responsible for determining that the vectors v1 and - v2 are not so large as to cause numeric overflow. In most cases - this won't present a problem. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.1, 12-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - dot product 3-dimensional vectors - --& -*/ - -{ /* Begin vdot_c */ - - - return ( v1[0]*v2[0] + v1[1]*v2[1] + v1[2]*v2[2] ); - - -} /* End vdot_c */ diff --git a/ext/spice/src/cspice/vdotg.c b/ext/spice/src/cspice/vdotg.c deleted file mode 100644 index 1f99337580..0000000000 --- a/ext/spice/src/cspice/vdotg.c +++ /dev/null @@ -1,147 +0,0 @@ -/* vdotg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VDOTG ( Vector dot product, general dimension ) */ -doublereal vdotg_(doublereal *v1, doublereal *v2, integer *ndim) -{ - /* System generated locals */ - integer i__1; - doublereal ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Compute the dot product of two vectors of arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector in the dot product. */ -/* V2 I Second vector in the dot product. */ -/* NDIM I Dimension of V1 and V2. */ - -/* The function returns the value of the dot product of V1 and V2. */ - -/* $ Detailed_Input */ - -/* V1 This may be any double precision vector of arbitrary */ -/* dimension. */ - -/* V2 This may be any double precision vector of arbitrary */ -/* dimension. */ - -/* $ Detailed_Output */ - -/* The function returns the value of the dot product of V1 and V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* VDOTG calculates the dot product of V1 and V2 by a simple */ -/* application of the definition. No error checking is */ -/* performed to prevent or recover from numeric overflow. */ - -/* $ Examples */ - -/* Suppose that given two n-dimensional vectors, we want to change */ -/* one of the vectors until the two vectors are perpendicular. */ -/* The following code fragment demonstrates the use of VDOT to do */ -/* so. */ - -/* DOT = VDOTG ( V1, V2, NDIM ) */ - -/* DO WHILE ( DOT .NE. 0.0D0 ) */ -/* change one of the vectors */ -/* DOT = VDOTG ( V1, V2, NDIM ) */ -/* END DO */ - -/* $ Restrictions */ - -/* The user is responsible for determining that the vectors V1 and */ -/* V2 are not so large as to cause numeric overflow. In most cases */ -/* this won't present a problem. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* dot product of n-dimensional vectors */ - -/* -& */ - - ret_val = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - ret_val += v1[i__ - 1] * v2[i__ - 1]; - } - return ret_val; -} /* vdotg_ */ - diff --git a/ext/spice/src/cspice/vdotg_c.c b/ext/spice/src/cspice/vdotg_c.c deleted file mode 100644 index d44642a1b6..0000000000 --- a/ext/spice/src/cspice/vdotg_c.c +++ /dev/null @@ -1,191 +0,0 @@ -/* - --Procedure vdotg_c ( Vector dot product, general dimension ) - --Abstract - - Compute the dot product of two vectors of arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vdotg_c - - - SpiceDouble vdotg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector in the dot product. - v2 I Second vector in the dot product. - ndim I Dimension of v1 and v2. - - The function returns the value of the dot product of v1 and v2. - --Detailed_Input - - v1 This may be any double precision vector of arbitrary - dimension. - - v2 This may be any double precision vector of arbitrary - dimension. - --Detailed_Output - - The function returns the value of the dot product of v1 and v2. - --Parameters - - None. - --Particulars - - vdotg_c calculates the dot product of v1 and v2 by a simple - application of the definition. No error checking is - performed to prevent or recover from numeric overflow. - --Examples - - Suppose that given two n-dimensional vectors, we want to change - one of the vectors until the two vectors are perpendicular. - The following code fragment demonstrates the use of vdot_c to do - so. - - dot = vdotg_c ( v1, v2, ndim ); - - while ( dot != 0. ) - { - - /. change one of the vectors ./ - .... - - dot = vdotg_c ( v1, v2, ndim ); - } - - --Restrictions - - The user is responsible for determining that the vectors v1 and - v2 are not so large as to cause numeric overflow. In most cases - this won't present a problem. - --Exceptions - - 1) If ndim is not physically realistic, greater than zero, a - BADDIMENSION error is signaled. The value 0. is returned. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. Converted check-in style to discovery. - - -CSPICE Version 1.0.0, 31-MAR-1998 (EDW) - --Index_Entries - - dot product of n-dimensional vectors - --& -*/ - -{ /* Begin vdotg_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceDouble dot; - - - /* - Use discovery check-in. - */ - - - /* Initialize dot to zero. */ - - dot = 0.; - - - /* Check ndim is cool. Dimension is positive definite. */ - - if ( ndim <= 0 ) - { - - chkin_c ( "vdotg_c" ); - SpiceError ( "Vector dimension less than or equal to zero", - "BADDIMENSION" ); - chkout_c ( "vdotg_c" ); - return ( 0. ); - - } - - - /* Do the calculation. Not very involved. */ - - for ( i = 0; i < ndim; i++ ) - { - dot += v1[i] * v2[i]; - } - - - /* Return the value. */ - - return dot; - - -} /* End vdotg_c */ diff --git a/ext/spice/src/cspice/vequ.c b/ext/spice/src/cspice/vequ.c deleted file mode 100644 index ce5d7e8cf5..0000000000 --- a/ext/spice/src/cspice/vequ.c +++ /dev/null @@ -1,129 +0,0 @@ -/* vequ.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VEQU ( Vector equality, 3 dimensions ) */ -/* Subroutine */ int vequ_(doublereal *vin, doublereal *vout) -{ -/* $ Abstract */ - -/* Make one double precision 3-dimensional vector equal to */ -/* another. */ - -/* $ 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 */ - -/* ASSIGNMENT, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VIN I 3-dimensional double precision vector. */ -/* VOUT O 3-dimensional double precision vector set equal */ -/* to VIN. */ - -/* $ Detailed_Input */ - -/* VIN This may be ANY 3-dimensional double precision vector. */ - -/* $ Detailed_Output */ - -/* VOUT This 3-dimensional double precision vector is set equal */ -/* to VIN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* VEQU simply sets each component of VOUT in turn equal to VIN. No */ -/* error checking is performed because none is needed. */ - -/* $ Examples */ - -/* Let STATE be a state vector. The angular momentum vector is */ -/* determined by the cross product of the position vector and the */ -/* velocity vector. */ - -/* CALL VEQU ( STATE(1), R ) */ -/* CALL VEQU ( STATE(4), V ) */ - -/* CALL VCRSS ( R, V, H ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* assign a 3-dimensional vector to another */ - -/* -& */ - vout[0] = vin[0]; - vout[1] = vin[1]; - vout[2] = vin[2]; - - return 0; -} /* vequ_ */ - diff --git a/ext/spice/src/cspice/vequ_c.c b/ext/spice/src/cspice/vequ_c.c deleted file mode 100644 index 730685101a..0000000000 --- a/ext/spice/src/cspice/vequ_c.c +++ /dev/null @@ -1,133 +0,0 @@ -/* - --Procedure vequ_c ( Vector equality, 3 dimensions ) - --Abstract - - Make one double precision 3-dimensional vector equal to - another. - --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 - - ASSIGNMENT, VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vequ_c - - - void vequ_c ( ConstSpiceDouble vin[3], - SpiceDouble vout[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - vin I 3-dimensional double precision vector. - vout O 3-dimensional double precision vector set equal - to vin. - --Detailed_Input - - vin This may be ANY 3-dimensional double precision vector. - --Detailed_Output - - vout This 3-dimensional double precision vector is set equal - to vin. - --Parameters - - None. - --Particulars - - vequ_c simply sets each component of vout in turn equal to vin. No - error checking is performed because none is needed. - --Examples - - Let state be a state vector. The angular momentum vector is - determined by the cross product of the position vector and the - velocity vector. - - vequ_c ( state[0], R ); - vequ_c ( state[3], V ); - - vcrss_c ( R, V, H ); - - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. Removed #include of SpiceZfc.h. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - assign a 3-dimensional vector to another - --& -*/ - -{ /* Begin vequ_c */ - - vout[0] = vin[0]; - vout[1] = vin[1]; - vout[2] = vin[2]; - - -} /* End vequ_c */ diff --git a/ext/spice/src/cspice/vequg.c b/ext/spice/src/cspice/vequg.c deleted file mode 100644 index 85615c4cb5..0000000000 --- a/ext/spice/src/cspice/vequg.c +++ /dev/null @@ -1,150 +0,0 @@ -/* vequg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VEQUG ( Vector equality, general dimension ) */ -/* Subroutine */ int vequg_(doublereal *vin, integer *ndim, doublereal *vout) -{ - /* System generated locals */ - integer vin_dim1, vout_dim1, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Make one double precision vector of arbitrary dimension equal */ -/* to another. */ - -/* $ 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 */ - -/* ASSIGNMENT, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VIN I NDIM-dimensional double precision vector. */ -/* NDIM I Dimension of VIN (and also VOUT). */ -/* VOUT O NDIM-dimensional double precision vector set */ -/* equal to VIN. */ - -/* $ Detailed_Input */ - -/* VIN is a double precision vector of arbitrary dimension. */ - -/* NDIM is the number of components of VIN. */ - -/* $ Detailed_Output */ - -/* VOUT is a double precision vector set equal to VIN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The code simply sets each component of VOUT equal to the */ -/* corresponding component of VIN. */ - -/* $ Examples */ - -/* Let STATE be a state vector. Set ABSTAT equal to STATE, and */ -/* correct ABSTAT for stellar aberration. */ - -/* CALL VEQUG ( STATE, 6, ABSTAT ) */ -/* CALL STELAB ( STATE(1), STATE(4), ABSPOS ) */ -/* CALL VEQU ( ABSPOS, ABSTAT(1) ) */ - - -/* Note that this routine may be used in place of MOVED, which */ -/* sets each output array element equal to the corresponding */ -/* input array element. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* assign an n-dimensional vector to another */ - -/* -& */ - /* Parameter adjustments */ - vout_dim1 = *ndim; - vin_dim1 = *ndim; - - /* Function Body */ - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "vequg_", (ftnlen)131)] = vin[(i__3 = i__ - 1) < - vin_dim1 && 0 <= i__3 ? i__3 : s_rnge("vin", i__3, "vequg_", ( - ftnlen)131)]; - } - return 0; -} /* vequg_ */ - diff --git a/ext/spice/src/cspice/vequg_c.c b/ext/spice/src/cspice/vequg_c.c deleted file mode 100644 index daf91ca52c..0000000000 --- a/ext/spice/src/cspice/vequg_c.c +++ /dev/null @@ -1,155 +0,0 @@ -/* - --Procedure vequg_c ( Vector equality, general dimension ) - --Abstract - - Make one double precision vector of arbitrary dimension equal - to another. - --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 - - ASSIGNMENT - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vequg_c - - - void vequg_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - vin I ndim-dimensional double precision vector. - ndim I Dimension of vin (and also vout). - vout O ndim-dimensional double precision vector set - equal to vin. - --Detailed_Input - - vin is a double precision vector of arbitrary dimension. - - ndim is the number of components of vin. - --Detailed_Output - - vout is a double precision vector set equal to vin. - --Parameters - - None. - --Particulars - - The code simply sets each component of vout equal to the - corresponding component of vin. - --Examples - - Let state be a state vector. Set abstat equal to state. - - vequg_c ( state, 6, abstate ); - - Note that this routine may be used in place of MOVED, which - sets each output array element equal to the corresponding - input array element. - --Restrictions - - None. - --Exceptions - - 1) If ndim is not physically realistic, greater than zero, a - BADDIMENSION error is flagged. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 23-AUG-1999 (EDW) (NJB) - --Index_Entries - - assign an n-dimensional vector to another - --& -*/ - -{ /* Begin vequg_c */ - - - /* - Use discovery check-in. - */ - - - /* Check ndim is cool. Dimension is positive definite. */ - - if ( ndim <= 0 ) - { - - chkin_c ( "vequg_c" ); - SpiceError ( "Vector dimension less than or equal to zero", - "BADDIMENSION" ); - chkout_c ( "vequg_c" ); - return; - - } - - - /* Do the equality thing. */ - - MOVED ( vin, ndim, vout ); - - -} /* End vequg_c */ - diff --git a/ext/spice/src/cspice/vhat.c b/ext/spice/src/cspice/vhat.c deleted file mode 100644 index b5a80eba30..0000000000 --- a/ext/spice/src/cspice/vhat.c +++ /dev/null @@ -1,165 +0,0 @@ -/* vhat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VHAT ( "V-Hat", unit vector along V, 3 dimensions ) */ -/* Subroutine */ int vhat_(doublereal *v1, doublereal *vout) -{ - doublereal vmag; - extern doublereal vnorm_(doublereal *); - -/* $ Abstract */ - -/* Find the unit vector along a double precision 3-dimensional */ -/* vector. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector to be normalized. */ -/* VOUT O Unit vector V1 / |V1|. */ -/* If V1 = 0, VOUT will also be zero. */ -/* VOUT can overwrite V1. */ - -/* $ Detailed_Input */ - -/* V1 This is any double precision, 3-dimensional vector. If */ -/* this vector is the zero vector, this routine will detect */ -/* it, and will not attempt to divide by zero. */ - -/* $ Detailed_Output */ - -/* VOUT VOUT contains the unit vector in the direction of V1. If */ -/* V1 represents the zero vector, then VOUT will also be the */ -/* zero vector. VOUT may overwrite V1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* VHAT determines the magnitude of V1 and then divides each */ -/* component of V1 by the magnitude. This process is highly stable */ -/* over the whole range of 3-dimensional vectors. */ - -/* $ Examples */ - -/* The following table shows how selected V1 implies VOUT. */ - -/* V1 VOUT */ -/* ------------------ ------------------ */ -/* (5, 12, 0) (5/13, 12/13, 0) */ -/* (1D-7, 2D-7, 2D-7) (1/3, 2/3, 2/3) */ - - -/* $ Restrictions */ - -/* There is no known case whereby floating point overflow may occur. */ -/* Thus, no error recovery or reporting scheme is incorporated */ -/* into this subroutine. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* unitize a 3-dimensional vector */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 10-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ -/* Also, the declaration of the unused variable I was */ -/* removed. */ -/* -& */ - -/* Obtain the magnitude of V1 */ - - vmag = vnorm_(v1); - -/* If VMAG is nonzero, then normalize. Note that this process is */ -/* numerically stable: overflow could only happen if VMAG were small, */ -/* but this could only happen if each component of V1 were small. */ -/* In fact, the magnitude of any vector is never less than the */ -/* magnitude of any component. */ - - if (vmag > 0.) { - vout[0] = v1[0] / vmag; - vout[1] = v1[1] / vmag; - vout[2] = v1[2] / vmag; - } else { - vout[0] = 0.; - vout[1] = 0.; - vout[2] = 0.; - } - return 0; -} /* vhat_ */ - diff --git a/ext/spice/src/cspice/vhat_c.c b/ext/spice/src/cspice/vhat_c.c deleted file mode 100644 index 35ac8eb3c9..0000000000 --- a/ext/spice/src/cspice/vhat_c.c +++ /dev/null @@ -1,177 +0,0 @@ -/* - --Procedure vhat_c ( "V-Hat", unit vector along V, 3 dimensions ) - --Abstract - - Find the unit vector along a double precision 3-dimensional vector. - --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 - - VECTOR - -*/ - - #include - #include "SpiceUsr.h" - #undef vhat_c - - - void vhat_c ( ConstSpiceDouble v1 [3], - SpiceDouble vout[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector to be unitized. - vout O Unit vector v1 / |v1|. - --Detailed_Input - - v1 This is any double precision, 3-dimensional vector. - --Detailed_Output - - vout vout contains the unit vector in the direction of v1. - If v1 represents the zero vector, then vout will also - be the zero vector. vout may overwrite v1. - --Parameters - - None. - --Exceptions - - Error free. - - If v1 represents the zero vector, then vout will also be the zero - vector. - --Files - - None. - --Particulars - - vhat_c determines the magnitude of v1 and then divides each - component of v1 by the magnitude. This process is highly stable - over the whole range of 3-dimensional vectors. - --Examples - - The following table shows how v1 maps to vout. - - v1 vout - ------------------ ------------------ - ( 5, 12, 0 ) ( 5/13, 12/13, 0 ) - ( 1.e-7, 2.e-7, 2.e-7 ) ( 1/3, 2/3, 2/3 ) - - --Restrictions - - None. - - There is no known case whereby floating point overflow may occur. - Thus, no error recovery or reporting scheme is incorporated - into this subroutine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.1, 12-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 16-APR-1999 (EDW) - --Index_Entries - - unitize a 3-dimensional vector - --& -*/ - -{ /* Begin vhat_c */ - - - /* - Local variables - */ - SpiceDouble vmag; - - - /* - Obtain the magnitude of v1. - */ - vmag = vnorm_c(v1); - - /* - If vmag is nonzero, then unitize. Note that this process is - numerically stable: overflow could only happen if vmag were small, - but this could only happen if each component of v1 were small. - In fact, the magnitude of any vector is never less than the - magnitude of any component. - */ - - if ( vmag > 0.0 ) - { - vout[0] = v1[0] / vmag; - vout[1] = v1[1] / vmag; - vout[2] = v1[2] / vmag; - } - else - { - vout[0] = 0.0; - vout[1] = 0.0; - vout[2] = 0.0; - } - - -} /* End vhat_c */ diff --git a/ext/spice/src/cspice/vhatg.c b/ext/spice/src/cspice/vhatg.c deleted file mode 100644 index e379f4dbf1..0000000000 --- a/ext/spice/src/cspice/vhatg.c +++ /dev/null @@ -1,179 +0,0 @@ -/* vhatg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VHATG ( "V-Hat", unit vector along V, general dimension ) */ -/* Subroutine */ int vhatg_(doublereal *v1, integer *ndim, doublereal *vout) -{ - /* System generated locals */ - integer v1_dim1, vout_dim1, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal vmag; - integer i__; - extern doublereal vnormg_(doublereal *, integer *); - -/* $ Abstract */ - -/* Find the unit vector along a double precision vector of */ -/* arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector to be normalized. */ -/* NDIM I Dimension of V1 (and also VOUT). */ -/* VOUT O Unit vector V1 / |V1|. */ -/* If V1 = 0, VOUT will also be zero. */ - -/* $ Detailed_Input */ - -/* V1 This is any double precision vector of arbitrary */ -/* dimension. This routine will detect if V1 the zero */ -/* vector, and will not attempt to divide by zero. */ - -/* NDIM is the dimension of V1 (and also VOUT). */ - -/* $ Detailed_Output */ - -/* VOUT VOUT contains the unit vector in the direction of V1. If */ -/* V1 represents the zero vector, then VOUT will also be the */ -/* zero vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* VHATG determines the magnitude of V1 and then divides each */ -/* component of V1 by the magnitude. This process is highly stable */ -/* over the whole range of multi-dimensional vectors. */ - -/* $ Examples */ - -/* The following table shows how selected V1 implies VOUT. */ - -/* V1 NDIM VOUT */ -/* -------------------------------------------------------- */ -/* (5, 12, 0, 0) 4 (5/13, 12/13, 0, 0) */ -/* (1D-7, 2D-7, 2D-7) 3 (1/3, 2/3, 2/3) */ - -/* $ Restrictions */ - -/* The relative number of cases whereby floating point overflow may */ -/* occur is negligible. Thus, no error recovery or reporting scheme */ -/* is incorporated into this subroutine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* unitize a n-dimensional vector */ - -/* -& */ - -/* Obtain the magnitude of V1 */ - - /* Parameter adjustments */ - vout_dim1 = *ndim; - v1_dim1 = *ndim; - - /* Function Body */ - vmag = vnormg_(v1, ndim); - -/* If VMAG is nonzero, then normalize. Note that this process is */ -/* numerically stable: overflow could only happen if VMAG were small, */ -/* but this could only happen if each component of V1 were small. */ -/* In fact, the magnitude of any vector is never less than the */ -/* magnitude of any component. */ - - if (vmag > 0.) { - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "vout", i__2, "vhatg_", (ftnlen)151)] = v1[(i__3 = i__ - - 1) < v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3, - "vhatg_", (ftnlen)151)] / vmag; - } - } else { - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "vout", i__2, "vhatg_", (ftnlen)155)] = 0.; - } - } - - return 0; -} /* vhatg_ */ - diff --git a/ext/spice/src/cspice/vhatg_c.c b/ext/spice/src/cspice/vhatg_c.c deleted file mode 100644 index 8b7e63feff..0000000000 --- a/ext/spice/src/cspice/vhatg_c.c +++ /dev/null @@ -1,174 +0,0 @@ -/* - --Procedure vhatg_c ( "V-Hat", unit vector along V, general dimension ) - --Abstract - - Find the unit vector along a double precision vector of - arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef vhatg_c - - - void vhatg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector to be normalized. - ndim I Dimension of v1 (and also vout). - vout O Unit vector v1 / |v1|. - If v1 = 0, vout will also be zero. - vout can overwrite v1. - --Detailed_Input - - v1 This is any double precision vector of arbitrary - dimension. This routine will detect if is V1 the - zero vector, and will not attempt to divide by zero. - - ndim is the dimension of V1 (and also VOUT). - --Detailed_Output - - vout contains the unit vector in the direction of v1. If - v1 represents the zero vector, then vout will also be - the zero vector. vout may overwrite v1. - --Parameters - - None. - --Particulars - - vhatg_c determines the magnitude of V1 and then divides each - component of V1 by the magnitude. This process is highly stable - over the whole range of multi-dimensional vectors. - --Examples - - The following table shows how selected v1 maps to vout. - - v1 ndim vout - ----------------------------------------------------------------- - (5, 12, 0, 0) 4 (5/13, 12/13, 0, 0) - (1e-7, 2D-e, 2e-7) 3 (1/3, 2/3, 2/3) - --Restrictions - - The relative number of cases whereby floating point overflow may - occur is negligible. Thus, no error recovery or reporting scheme - is incorporated into this subroutine. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 13-JUL-1999 (NJB) (WMO) - --Index_Entries - - unitize a n-dimensional vector - --& -*/ - -{ /* Begin vhatg_c */ - - - /* - Local variables - */ - SpiceDouble vmag; - SpiceInt i; - - - - /* - Obtain the magnitude of v1. - */ - vmag = vnormg_c ( v1, ndim ); - - /* - If vmag is nonzero, then normalize. Note that this process is - numerically stable: overflow could only happen if vmag were small, - but this could only happen if each component of v1 were small. - In fact, the magnitude of any vector is never less than the - magnitude of any component. - */ - - if ( vmag > 0.0 ) - { - for ( i = 0; i < ndim; i++ ) - { - vout[i] = v1[i] / vmag; - } - } - else - { - for ( i = 0; i < ndim; i++ ) - { - vout[i] = 0.; - } - } - -} /* End vhatg_c */ - diff --git a/ext/spice/src/cspice/vhatip.c b/ext/spice/src/cspice/vhatip.c deleted file mode 100644 index cff05b0022..0000000000 --- a/ext/spice/src/cspice/vhatip.c +++ /dev/null @@ -1,166 +0,0 @@ -/* vhatip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VHATIP ( "V-Hat", 3-d unit vector along V, in place ) */ -/* Subroutine */ int vhatip_(doublereal *v) -{ - doublereal vmag; - extern doublereal vnorm_(doublereal *); - -/* $ Abstract */ - -/* Scale a three-dimensional vector to unit length. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V I-O Vector to be normalized/unit vector. */ - -/* $ Detailed_Input */ - -/* V This is any double precision, 3-dimensional vector. If */ -/* this vector is the zero vector, this routine will detect */ -/* it, and will not attempt to divide by zero. */ - -/* $ Detailed_Output */ - -/* V V contains the unit vector in the direction of the input */ -/* vector. If on input V represents the zero vector, then */ -/* V will be returned as the zero vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) The zero vector is returned if the input value of V is the */ -/* zero vector. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is provided for situation where it is convenient */ -/* to scale a vector to unit length in place rather than store */ -/* the result in a separate variable. Note that the call */ - -/* CALL VHAT ( V, V ) */ - -/* is not permitted by the ANSI Fortran 77 standard; this routine */ -/* can be called instead to achieve the same result. */ - -/* VHATIP determines the magnitude of V and then, if the magnitude */ -/* is non-zero, divides each component of V by the magnitude. This */ -/* process is highly stable over the whole range of 3-dimensional */ -/* vectors. */ - -/* $ Examples */ - -/* The following table shows how selected vectors are mapped to */ -/* unit vectors */ - -/* V on input V on output */ -/* ------------------ ------------------ */ -/* (5, 12, 0) (5/13, 12/13, 0) */ -/* (1D-7, 2D-7, 2D-7) (1/3, 2/3, 2/3) */ - -/* $ Restrictions */ - -/* There is no known case whereby floating point overflow may occur. */ -/* Thus, no error recovery or reporting scheme is incorporated */ -/* into this subroutine. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 01-SEP-2005 (NJB) (HAN) (WMO) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* unitize a 3-dimensional vector in place */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Obtain the magnitude of V. */ - - vmag = vnorm_(v); - -/* If VMAG is nonzero, then normalize. Note that this process is */ -/* numerically stable: overflow could only happen if VMAG were */ -/* small, but this could only happen if each component of V1 were */ -/* small. In fact, the magnitude of any vector is never less than */ -/* the magnitude of any component. */ - - if (vmag > 0.) { - v[0] /= vmag; - v[1] /= vmag; - v[2] /= vmag; - } else { - v[0] = 0.; - v[1] = 0.; - v[2] = 0.; - } - return 0; -} /* vhatip_ */ - diff --git a/ext/spice/src/cspice/vlcom.c b/ext/spice/src/cspice/vlcom.c deleted file mode 100644 index d68350d48d..0000000000 --- a/ext/spice/src/cspice/vlcom.c +++ /dev/null @@ -1,164 +0,0 @@ -/* vlcom.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VLCOM ( Vector linear combination, 3 dimensions ) */ -/* Subroutine */ int vlcom_(doublereal *a, doublereal *v1, doublereal *b, - doublereal *v2, doublereal *sum) -{ -/* $ Abstract */ - -/* Compute a vector linear combination of two double precision, */ -/* 3-dimensional vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I Coefficient of V1 */ -/* V1 I Vector in 3-space */ -/* B I Coefficient of V2 */ -/* V2 I Vector in 3-space */ -/* SUM O Linear Vector Combination A*V1 + B*V2 */ - -/* $ Detailed_Input */ - -/* A This double precision variable multiplies V1. */ -/* V1 This is an arbitrary, double precision 3-dimensional */ -/* vector. */ -/* B This double precision variable multiplies V2. */ -/* V2 This is an arbitrary, double precision 3-dimensional */ -/* vector. */ - -/* $ Detailed_Output */ - -/* SUM is an arbitrary, double precision 3-dimensional vector */ -/* which contains the linear combination A*V1 + B*V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* For each index from 1 to 3, this routine implements in FORTRAN */ -/* code the expression: */ - -/* SUM(I) = A*V1(I) + B*V2(I) */ - -/* No error checking is performed to guard against numeric overflow. */ - -/* $ Examples */ - -/* To generate a sequence of points on an ellipse with major */ -/* and minor axis vectors MAJOR and MINOR, one could use the */ -/* following code fragment */ - -/* STEP = TWOPI()/ N */ -/* ANG = 0.0D0 */ - -/* DO I = 0,N */ - -/* CALL VLCOM ( DCOS(ANG),MAJOR, DSIN(ANG),MINOR, POINT ) */ - -/* do something with the ellipse point just constructed */ - -/* ANG = ANG + STEP */ - -/* END DO */ - -/* As a second example, suppose that U and V are orthonormal vectors */ -/* that form a basis of a plane. Moreover suppose that we wish to */ -/* project a vector X onto this plane, we could use the following */ -/* call inserts this projection into PROJ. */ - -/* CALL VLCOM ( VDOT(X,V),V, VDOT(X,U),U, PROJ ) */ - - -/* $ Restrictions */ - -/* No error checking is performed to guard against numeric overflow */ -/* or underflow. The user is responsible for insuring that the */ -/* input values are reasonable. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* linear combination of two 3-dimensional vectors */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - sum[0] = *a * v1[0] + *b * v2[0]; - sum[1] = *a * v1[1] + *b * v2[1]; - sum[2] = *a * v1[2] + *b * v2[2]; - return 0; -} /* vlcom_ */ - diff --git a/ext/spice/src/cspice/vlcom3.c b/ext/spice/src/cspice/vlcom3.c deleted file mode 100644 index 3b3e965cac..0000000000 --- a/ext/spice/src/cspice/vlcom3.c +++ /dev/null @@ -1,143 +0,0 @@ -/* vlcom3.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VLCOM3 ( Vector linear combination, 3 dimensions ) */ -/* Subroutine */ int vlcom3_(doublereal *a, doublereal *v1, doublereal *b, - doublereal *v2, doublereal *c__, doublereal *v3, doublereal *sum) -{ -/* $ Abstract */ - -/* This subroutine computes the vector linear combination */ -/* A*V1 + B*V2 + C*V3 of double precision, 3-dimensional vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I Coefficient of V1 */ -/* V1 I Vector in 3-space */ -/* B I Coefficient of V2 */ -/* V2 I Vector in 3-space */ -/* C I Coefficient of V3 */ -/* V3 I Vector in 3-space */ -/* SUM O Linear Vector Combination A*V1 + B*V2 + C*V3 */ - -/* $ Detailed_Input */ - -/* A is a double precision number. */ - -/* V1 is a double precision 3-dimensional vector. */ - -/* B is a double precision number. */ - -/* V2 is a double precision 3-dimensional vector. */ - -/* C is a double precision number. */ - -/* V3 is a double precision 3-dimensional vector. */ - -/* $ Detailed_Output */ - -/* SUM is a double precision 3-dimensional vector which contains */ -/* the linear combination A*V1 + B*V2 + C*V3 */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For each index from 1 to 3, this routine implements in FORTRAN */ -/* code the expression: */ - -/* SUM(I) = A*V1(I) + B*V2(I) + C*V3(I) */ - -/* No error checking is performed to guard against numeric overflow. */ - -/* $ Examples */ - -/* Often one has the components (A,B,C) of a vector in terms */ -/* of a basis V1, V2, V3. The vector represented by (A,B,C) can */ -/* be obtained immediately from the call */ - -/* CALL VLCOM3 ( A, V1, B, V2, C, V3, VECTOR ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ 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, 1-NOV-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* linear combination of three 3-dimensional vectors */ - -/* -& */ - sum[0] = *a * v1[0] + *b * v2[0] + *c__ * v3[0]; - sum[1] = *a * v1[1] + *b * v2[1] + *c__ * v3[1]; - sum[2] = *a * v1[2] + *b * v2[2] + *c__ * v3[2]; - return 0; -} /* vlcom3_ */ - diff --git a/ext/spice/src/cspice/vlcom3_c.c b/ext/spice/src/cspice/vlcom3_c.c deleted file mode 100644 index 8a4e1f66b9..0000000000 --- a/ext/spice/src/cspice/vlcom3_c.c +++ /dev/null @@ -1,157 +0,0 @@ -/* - --Procedure vlcom3_c ( Vector linear combination, 3 dimensions ) - --Abstract - - This subroutine computes the vector linear combination - a*v1 + b*v2 + c*v3 of double precision, 3-dimensional vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vlcom3_c - - - void vlcom3_c ( SpiceDouble a, - ConstSpiceDouble v1 [3], - SpiceDouble b, - ConstSpiceDouble v2 [3], - SpiceDouble c, - ConstSpiceDouble v3 [3], - SpiceDouble sum[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I Coefficient of v1 - v1 I Vector in 3-space - b I Coefficient of v2 - v2 I Vector in 3-space - c I Coefficient of v3 - v3 I Vector in 3-space - sum O Linear Vector Combination a*v1 + b*v2 + c*v3 - --Detailed_Input - - a is a double precision number. - - v1 is a double precision 3-dimensional vector. - - b is a double precision number. - - v2 is a double precision 3-dimensional vector. - - c is a double precision number. - - v3 is a double precision 3-dimensional vector. - --Detailed_Output - - sum is a double precision 3-dimensional vector which contains - the linear combination a*v1 + b*v2 + c*v3 - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - For each index from 0 to 2, this routine implements in FORTRAN - code the expression: - - sum[i] = a*v1[i] + b*v2[i] + c*v3[i] - - No error checking is performed to guard against numeric overflow. - --Examples - - Often one has the components (a,b,c) of a vector in terms - of a basis v1, v2, v3. The vector represented by (a,b,c) can - be obtained immediately from the call - - vlcom3_c ( a, v1, b, v2, c, v3, VECTOR ) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - linear combination of three 3-dimensional vectors - --& -*/ - -{ /* Begin vlcom3_c */ - - - /* This really doesn't require a degree in rocket science */ - - sum[0] = a*v1[0] + b*v2[0] + c*v3[0]; - sum[1] = a*v1[1] + b*v2[1] + c*v3[1]; - sum[2] = a*v1[2] + b*v2[2] + c*v3[2]; - - -} /* End vlcom3_c */ diff --git a/ext/spice/src/cspice/vlcom_c.c b/ext/spice/src/cspice/vlcom_c.c deleted file mode 100644 index 66d120420b..0000000000 --- a/ext/spice/src/cspice/vlcom_c.c +++ /dev/null @@ -1,166 +0,0 @@ -/* - --Procedure vlcom_c ( Vector linear combination, 3 dimensions ) - --Abstract - - Compute a vector linear combination of two double precision, - 3-dimensional vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vlcom_c - - - void vlcom_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble sum[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I Coefficient of v1 - v1 I Vector in 3-space - b I Coefficient of v2 - v2 I Vector in 3-space - sum O Linear Vector Combination a*v1 + b*v2 - --Detailed_Input - - a This double precision variable multiplies v1. - v1 This is an arbitrary, double precision 3-dimensional - vector. - b This double precision variable multiplies v2. - v2 This is an arbitrary, double precision 3-dimensional - vector. - --Detailed_Output - - sum is an arbitrary, double precision 3-dimensional vector - which contains the linear combination a*v1 + b*v2. - --Parameters - - None. - --Particulars - - For each index from 0 to 2, this routine implements in C - code the expression: - - sum[i] = a*v1[i] + b*v2[i] - - No error checking is performed to guard against numeric overflow. - --Examples - - To generate a sequence of points on an ellipse with major - and minor axis vectors major and minor, one could use the - following code fragment - - step = twopi_c()/ n; - ang = 0.0; - - for ( i = 0; i < n; i++ ) - { - vlcom_c ( cos(ang),major, sin(ang),minor, point ); - - do something with the ellipse point just constructed - - ang = ang + step; - } - - As a second example, suppose that u and v are orthonormal vectors - that form a basis of a plane. Moreover suppose that we wish to - project a vector x onto this plane, we could use the following - call inserts this projection into proj. - - vlcom_c ( vdot_c(x,v),v, vdot_c(x,u),u, proj ) - - --Restrictions - - No error checking is performed to guard against numeric overflow - or underflow. The user is responsible for insuring that the - input values are reasonable. - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - linear combination of two 3-dimensional vectors - --& -*/ - -{ /* Begin vlcom_c */ - - /* This really doesn't require a degree in rocket science */ - - sum[0] = a*v1[0] + b*v2[0]; - sum[1] = a*v1[1] + b*v2[1]; - sum[2] = a*v1[2] + b*v2[2]; - - -} /* End vlcom_c */ diff --git a/ext/spice/src/cspice/vlcomg.c b/ext/spice/src/cspice/vlcomg.c deleted file mode 100644 index 71ba236c2e..0000000000 --- a/ext/spice/src/cspice/vlcomg.c +++ /dev/null @@ -1,167 +0,0 @@ -/* vlcomg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VLCOMG ( Vector linear combination, general dimension ) */ -/* Subroutine */ int vlcomg_(integer *n, doublereal *a, doublereal *v1, - doublereal *b, doublereal *v2, doublereal *sum) -{ - /* System generated locals */ - integer v1_dim1, v2_dim1, sum_dim1, i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Compute a vector linear combination of two double precision */ -/* vectors of arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I Dimension of vector space */ -/* A I Coefficient of V1 */ -/* V1 I Vector in N-space */ -/* B I Coefficient of V2 */ -/* V2 I Vector in N-space */ -/* SUM O Linear Vector Combination A*V1 + B*V2 */ - -/* $ Detailed_Input */ - -/* N This variable contains the dimension of the V1, V2 and SUM. */ -/* A This double precision variable multiplies V1. */ -/* V1 This is an arbitrary, double precision N-dimensional vector. */ -/* B This double precision variable multiplies V2. */ -/* V2 This is an arbitrary, double precision N-dimensional vector. */ - -/* $ Detailed_Output */ - -/* SUM is an arbitrary, double precision N-dimensional vector */ -/* which contains the linear combination A*V1 + B*V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* For each index from 1 to N, this routine implements in FORTRAN */ -/* code the expression: */ - -/* SUM(I) = A*V1(I) + B*V2(I) */ - -/* No error checking is performed to guard against numeric overflow. */ - -/* $ Examples */ - -/* We can easily use this routine to perform vector projections */ -/* to 2-planes in N-space. Let X be an arbitray N-vector */ -/* and let U and V be orthonormal N-vectors spanning the plane */ -/* of interest. The projection of X onto this 2-plane, PROJUV can */ -/* be obtained by the following code fragment. */ - -/* CALL VLCOMG ( N, VDOT(X,U,N), U, VDOT(X,V,N), V, PROJUV ) */ - -/* $ Restrictions */ - -/* No error checking is performed to guard against numeric overflow */ -/* or underflow. The user is responsible for insuring that the */ -/* input values are reasonable. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* linear combination of two n-dimensional vectors */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */ - -/* Example section of header upgraded. */ - -/* -& */ - /* Parameter adjustments */ - sum_dim1 = *n; - v2_dim1 = *n; - v1_dim1 = *n; - - /* Function Body */ - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sum[(i__2 = i__ - 1) < sum_dim1 && 0 <= i__2 ? i__2 : s_rnge("sum", - i__2, "vlcomg_", (ftnlen)150)] = *a * v1[(i__3 = i__ - 1) < - v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3, "vlcomg_", ( - ftnlen)150)] + *b * v2[(i__4 = i__ - 1) < v2_dim1 && 0 <= - i__4 ? i__4 : s_rnge("v2", i__4, "vlcomg_", (ftnlen)150)]; - } - return 0; -} /* vlcomg_ */ - diff --git a/ext/spice/src/cspice/vlcomg_c.c b/ext/spice/src/cspice/vlcomg_c.c deleted file mode 100644 index 142f9da545..0000000000 --- a/ext/spice/src/cspice/vlcomg_c.c +++ /dev/null @@ -1,152 +0,0 @@ -/* - --Procedure vlcomg_c ( Vector linear combination, general dimension ) - --Abstract - - Compute a vector linear combination of two double precision - vectors of arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vlcomg_c - - void vlcomg_c ( SpiceInt n, - SpiceDouble a, - ConstSpiceDouble * v1, - SpiceDouble b, - ConstSpiceDouble * v2, - SpiceDouble * sum ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - n I Dimension of vector space - a I Coefficient of v1 - v1 I Vector in n-space - b I Coefficient of v2 - v2 I Vector in n-space - sum O Linear Vector Combination a*v1 + b*v2 - --Detailed_Input - - n This variable contains the dimension of the v1, v2 and sum. - a This double precision variable multiplies v1. - v1 This is an arbitrary, double precision n-dimensional vector. - b This double precision variable multiplies v2. - v2 This is an arbitrary, double precision n-dimensional vector. - --Detailed_Output - - sum is an arbitrary, double precision n-dimensional vector - which contains the linear combination a*v1 + b*v2. - --Parameters - - None. - --Particulars - - For each index from 1 to n, this routine implements in C - code the expression: - - sum[i] = a*v1[i] + b*v2[i] - - No error checking is performed to guard against numeric overflow. - --Examples - - We can easily use this routine to perform vector projections - to 2-planes in n-space. Let x be an arbitray n-vector - and let u and v be orthonormal n-vectors spanning the plane - of interest. The projection of x onto this 2-plane, projuv can - be obtained by the following code fragment. - - vlcomg_c ( n, vdot_c(x,u,n), u, vdot_c(x,v,n), v, projuv ); - --Restrictions - - No error checking is performed to guard against numeric overflow - or underflow. The user is responsible for insuring that the - input values are reasonable. - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - W.L. Taber (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.0.0, 30-JUN-1999 - --Index_Entries - - linear combination of two n-dimensional vectors - --& -*/ - -{ /* Begin vlcomg_c */ - - /* - Local variables - */ - SpiceInt i; - - - /* A simple loop to do the work. */ - for ( i = 0; i < n; i++ ) - { - sum[i] = a*v1[i] + b*v2[i]; - } - - -} /* End vlcomg_c */ diff --git a/ext/spice/src/cspice/vminug.c b/ext/spice/src/cspice/vminug.c deleted file mode 100644 index 152959d0c2..0000000000 --- a/ext/spice/src/cspice/vminug.c +++ /dev/null @@ -1,158 +0,0 @@ -/* vminug.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VMINUG ( Minus V, "-V", general dimension ) */ -/* Subroutine */ int vminug_(doublereal *vin, integer *ndim, doublereal *vout) -{ - /* System generated locals */ - integer vin_dim1, vout_dim1, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Negate a double precision vector of arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VIN I NDIM-dimensional double precision vector to */ -/* be negated. */ -/* NDIM I Dimension of VIN (and also VOUT). */ -/* VOUT O NDIM-dimensional double precision vector equal to */ -/* -VIN. */ - -/* $ Detailed_Input */ - -/* VIN is double precision vector of arbitrary size. */ - -/* NDIM is the dimension of VIN and VOUT. */ - -/* $ Detailed_Output */ - -/* VOUT is a double precision vector which contains the negation */ -/* of VIN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For each value of the index I from 1 to NDIM, VMINUG negates VIN */ -/* by the expression: */ - -/* VOUT(I) = - VIN(I) */ - -/* $ Examples */ - -/* Let VIN = ( -10.0D0, 15.0D0, -5.0D0, 20.0D0 ) */ - -/* The call */ - -/* CALL VMINUG ( VIN, 4, VOUT ) */ - -/* negates all of the components of the vector VIN. */ -/* The vector VOUT then contains the components */ - -/* VOUT = ( 10.0D0, -15.0D0, 5.0D0, -20.0D0 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* negate an n-dimensional vector */ - -/* -& */ - - /* Parameter adjustments */ - vout_dim1 = *ndim; - vin_dim1 = *ndim; - - /* Function Body */ - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "vminug_", (ftnlen)138)] = -vin[(i__3 = i__ - 1) < - vin_dim1 && 0 <= i__3 ? i__3 : s_rnge("vin", i__3, "vminug_", - (ftnlen)138)]; - } - return 0; -} /* vminug_ */ - diff --git a/ext/spice/src/cspice/vminug_c.c b/ext/spice/src/cspice/vminug_c.c deleted file mode 100644 index fabb1ec1a2..0000000000 --- a/ext/spice/src/cspice/vminug_c.c +++ /dev/null @@ -1,146 +0,0 @@ -/* - --Procedure vminug_c ( Minus V, "-V", general dimension ) - --Abstract - - Negate a double precision vector of arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vminug_c - - void vminug_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - vin I ndim-dimensional double precision vector to - be negated. - ndim I Dimension of vin (and also vout). - vout O ndim-dimensional double precision vector equal to - -vin. - --Detailed_Input - - vin double precision vector of arbitrary size. - - ndim the dimension of vin and vout. - --Detailed_Output - - vout a double precision vector which contains the negation - of vin. vout may overwrite vin. - --Parameters - - None. - --Particulars - - For each value of the index i from 1 to ndim, vminug_c negates vin - by the expression: - - vout[i] = - vin[i]; - --Examples - - Let vin = [ -10.0, 15.0, -5.0, 20.0 ] - - The call - - vminug_c ( vin, 4, vin ) - - negates all of the components of the vector VIN, and overwrites - the original components. The vector VIN then contains the - components - - vin = [ 10.0, -15.0, 5.0, -20.0 ] - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 - --Index_Entries - - negate an n-dimensional vector - --& -*/ - -{ /* Begin vminug_c */ - - /* - Local variables - */ - SpiceInt i; - - - /* Do it. This isn't rocket science. */ - for ( i = 0; i < ndim; i++ ) - { - vout[i] = -vin[i]; - } - - -} /* End vminug_c */ diff --git a/ext/spice/src/cspice/vminus.c b/ext/spice/src/cspice/vminus.c deleted file mode 100644 index b914aeb244..0000000000 --- a/ext/spice/src/cspice/vminus.c +++ /dev/null @@ -1,134 +0,0 @@ -/* vminus.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VMINUS ( Minus V, "-V", 3 dimensions ) */ -/* Subroutine */ int vminus_(doublereal *v1, doublereal *vout) -{ -/* $ Abstract */ - -/* Negate a double precision 3-dimensional vector. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector to be negated. */ -/* VOUT O Negated vector -V1. */ - -/* $ Detailed_Input */ - -/* V1 This may be any 3-dimensional, double precision vector. */ - -/* $ Detailed_Output */ - -/* VOUT This will be the negation (additive inverse) of V1. It */ -/* is a 3-dimensional, double precision vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* VMINUS implements (by components) the expression VMINUS = -V1. No */ -/* error checking is performed since overflow can occur ONLY if the */ -/* dynamic range of positive floating point numbers is not the same */ -/* size as the dynamic range of negative floating point numbers AND */ -/* at least one component of V1 falls outside the common range. The */ -/* likelihood of this occuring is so small as to be of no concern. */ - -/* $ Examples */ - -/* The following table shows the output VOUT as a function of the */ -/* the input V1 from the subroutine VMINUS. */ - -/* V1 VOUT */ -/* --------------------------------------- */ -/* (1D0, -2D0, 0D0) (-1D0, 2D0, 0D0) */ -/* (0D0, 0D0, 0D0) (0D0, 0D0, 0D0) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* negate a 3-dimensional vector */ - -/* -& */ - vout[0] = -v1[0]; - vout[1] = -v1[1]; - vout[2] = -v1[2]; - - return 0; -} /* vminus_ */ - diff --git a/ext/spice/src/cspice/vminus_c.c b/ext/spice/src/cspice/vminus_c.c deleted file mode 100644 index 87f6175878..0000000000 --- a/ext/spice/src/cspice/vminus_c.c +++ /dev/null @@ -1,138 +0,0 @@ -/* - --Procedure vminus_c ( Minus V, "-V", 3 dimensions ) - --Abstract - - Negate a double precision 3-dimensional vector. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vminus_c - - - void vminus_c ( ConstSpiceDouble v1[3], SpiceDouble vout[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector to be negated. - vout O Negated vector -v1. vout can overwrite v1. - - --Detailed_Input - - v1 This may be any 3-dimensional, double precision vector. - --Detailed_Output - - vout This will be the negation (additive inverse) of v1. It - is a 3-dimensional, double precision vector. vout may - overwrite v1. - --Parameters - - None. - --Particulars - - vminus_c implements (by components) the expression vminus_c = -v1. - No error checking is performed since overflow can occur ONLY if - the dynamic range of positive floating point numbers is not the - same size as the dynamic range of negative floating point - numbers AND at least one component of v1 falls outside the - common range. The likelihood of this occuring is so small as to - be of no concern. - --Examples - - The following table shows the output vout as a function of the - the input v1 from the subroutine vminus_c. - - v1 vout - ------------------------------------------------------- - (1, -2, 0) (-1, 2, 0) - (0, 0, 0) (0, 0, 0) - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - negate a 3-dimensional vector - --& -*/ - -{ /* Begin vminus_c */ - - - vout[0] = -v1[0]; - vout[1] = -v1[1]; - vout[2] = -v1[2]; - - -} /* End vminus_c */ diff --git a/ext/spice/src/cspice/vnorm.c b/ext/spice/src/cspice/vnorm.c deleted file mode 100644 index e4d5e1190c..0000000000 --- a/ext/spice/src/cspice/vnorm.c +++ /dev/null @@ -1,168 +0,0 @@ -/* vnorm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VNORM ( Vector norm, 3 dimensions ) */ -doublereal vnorm_(doublereal *v1) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2, d__3; - - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - doublereal v1max; - -/* $ Abstract */ - -/* Compute the magnitude of a double precision, 3-dimensional */ -/* vector. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector whose magnitude is to be found. */ - -/* $ Detailed_Input */ - -/* V1 This may be any 3-dimensional, double precision vector. */ - -/* $ Detailed_Output */ - -/* VNORM is the magnitude of V1 calculated in a numerically stable */ -/* way. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* VNORM finds the component of V1 whose magnitude is the largest. */ -/* If the absolute magnitude of that component indicates that a */ -/* numeric overflow would occur when it is squared, or if it */ -/* indicates that an underflow would occur when square (giving a */ -/* magnitude of zero) then the following expression is used: */ - -/* VNORM = V1MAX * MAGNITUDE OF [ (1/V1MAX)*V1 ] */ - -/* Otherwise a simpler expression is used: */ - -/* VNORM = MAGNITUDE OF [ V1 ] */ - -/* Beyond the logic described above, no further checking of the */ -/* validity of the input is performed. */ - -/* $ Examples */ - -/* The following table show the correlation between various input */ -/* vectors V1 and VNORM: */ - -/* V1 VNORM */ -/* ----------------------------------------------------------------- */ -/* (1.D0, 2.D0, 2.D0) 3.D0 */ -/* (5.D0, 12.D0, 0.D0) 13.D0 */ -/* (-5.D-17, 0.0D0, 12.D-17) 13.D-17 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* norm of 3-dimensional vector */ - -/* -& */ - -/* Determine the maximum component of the vector. */ - -/* Computing MAX */ - d__1 = abs(v1[0]), d__2 = abs(v1[1]), d__1 = max(d__1,d__2), d__2 = abs( - v1[2]); - v1max = max(d__1,d__2); - -/* If the vector is zero, return zero; otherwise normalize first. */ -/* Normalizing helps in the cases where squaring would cause overflow */ -/* or underflow. In the cases where such is not a problem it not worth */ -/* it to optimize further. */ - - if (v1max == 0.) { - ret_val = 0.; - } else { -/* Computing 2nd power */ - d__1 = v1[0] / v1max; -/* Computing 2nd power */ - d__2 = v1[1] / v1max; -/* Computing 2nd power */ - d__3 = v1[2] / v1max; - ret_val = v1max * sqrt(d__1 * d__1 + d__2 * d__2 + d__3 * d__3); - } - - return ret_val; -} /* vnorm_ */ - diff --git a/ext/spice/src/cspice/vnorm_c.c b/ext/spice/src/cspice/vnorm_c.c deleted file mode 100644 index 73020cf00c..0000000000 --- a/ext/spice/src/cspice/vnorm_c.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - --Procedure vnorm_c ( Vector norm, 3 dimensions ) - --Abstract - - Compute the magnitude of a double precision, 3-dimensional vector. - --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 - - VECTOR - -*/ - #include - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vnorm_c - - - SpiceDouble vnorm_c ( ConstSpiceDouble v1[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector whose magnitude is to be found. - - The function returns the norm of v1. - --Detailed_Input - - v1 may be any 3-dimensional, double precision vector. - --Detailed_Output - - The function returns the magnitude of v1 calculated in a numerically - stable way. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - vnorm_c takes care to avoid overflow while computing the norm of the - input vector v1. vnorm_c finds the component of v1 whose magnitude - is the largest. Calling this magnitude v1max, the norm is computed - using the formula - - vnorm_c = v1max * || (1/v1max) * v1 || - - where the notation ||x|| indicates the norm of the vector x. - --Examples - - The following table show the correlation between various input - vectors v1 and vnorm_c: - - v1 vnorm_c - ----------------------------------------------------------------- - ( 1.e0, 2.e0, 2.e0 ) 3.e0 - ( 5.e0, 12.e0, 0.e0 ) 13.e0 - ( -5.e-17, 0.0e0, 12.e-17 ) 13.e-17 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.1, 12-NOV-2006 (EDW) - - Added Parameters section header. - - -CSPICE Version 1.0.0, 16-APR-1999 (NJB) - --Index_Entries - - norm of 3-dimensional vector - --& -*/ - -{ /* Begin vnorm_c */ - - /* - Local variables - */ - SpiceDouble normSqr; - SpiceDouble tmp0; - SpiceDouble tmp1; - SpiceDouble tmp2; - SpiceDouble v1max; - - - /* - Determine the maximum component of the vector. - */ - v1max = MaxAbs( v1[0], MaxAbs( v1[1], v1[2] ) ); - - - /* - If the vector is zero, return zero; otherwise normalize first. - Normalizing helps in the cases where squaring would cause overflow - or underflow. In the cases where such is not a problem it not worth - it to optimize further. - */ - - if ( v1max == 0.0 ) - { - return ( 0.0 ); - } - else - { - tmp0 = v1[0]/v1max; - tmp1 = v1[1]/v1max; - tmp2 = v1[2]/v1max; - - normSqr = tmp0*tmp0 + tmp1*tmp1 + tmp2*tmp2; - - return ( v1max * sqrt( normSqr ) ); - } - - -} /* End vnorm_c */ diff --git a/ext/spice/src/cspice/vnormg.c b/ext/spice/src/cspice/vnormg.c deleted file mode 100644 index 65d32c58d4..0000000000 --- a/ext/spice/src/cspice/vnormg.c +++ /dev/null @@ -1,187 +0,0 @@ -/* vnormg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VNORMG ( Vector norm, general dimension ) */ -doublereal vnormg_(doublereal *v1, integer *ndim) -{ - /* System generated locals */ - integer v1_dim1, i__1, i__2, i__3; - doublereal ret_val, d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double sqrt(doublereal); - - /* Local variables */ - doublereal v1max, a; - integer i__; - -/* $ Abstract */ - -/* Compute the magnitude of a double precision vector of arbitrary */ -/* dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I Vector whose magnitude is to be found. */ -/* NDIM I Dimension of V1. */ - -/* $ Detailed_Input */ - -/* V1 This may be any double precision vector or arbitrary */ -/* size. */ - -/* $ Detailed_Output */ - -/* VNORMG is the magnitude of V1 calculated in a numerically stable */ -/* way. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* VNORMG finds the component of V1 whose magnitude is the largest. */ -/* If the absolute magnitude of that component indicates that a */ -/* numeric overflow would occur when it is squared, or if it */ -/* indicates that an underflow would occur when squared (falsely */ -/* giving a magnitude of zero) then the following expression is */ -/* used: */ - -/* VNORMG = V1MAX * MAGNITUDE OF [ (1/V1MAX)*V1 ] */ - -/* Otherwise a simpler expression is used: */ - -/* VNORMG = MAGNITUDE OF [ V1 ] */ - -/* Beyond the logic described above, no further checking of the */ -/* validity of the input is performed. */ - -/* $ Examples */ - -/* The following table show the correlation between various input */ -/* vectors V1 and VNORMG: */ - -/* NDIM V1(NDIM) VNORMG */ -/* ----------------------------------------------------------------- */ -/* 1 (-7.0D20) 7.D20 */ -/* 3 (1.D0, 2.D0, 2.D0) 3.D0 */ -/* 4 (3.D0, 3.D0, 3.D0, 3.D0) 6.D0 */ -/* 5 (5.D0, 12.D0, 0.D0, 0.D0, 0.D0) 13.D0 */ -/* 3 (-5.D-17, 0.0D0, 12.D-17) 13.D-17 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* norm of n-dimensional vector */ - -/* -& */ - -/* Determine the maximum component of the vector. */ - - /* Parameter adjustments */ - v1_dim1 = *ndim; - - /* Function Body */ - v1max = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if ((d__1 = v1[(i__2 = i__ - 1) < v1_dim1 && 0 <= i__2 ? i__2 : - s_rnge("v1", i__2, "vnormg_", (ftnlen)148)], abs(d__1)) > - v1max) { - v1max = (d__2 = v1[(i__3 = i__ - 1) < v1_dim1 && 0 <= i__3 ? i__3 - : s_rnge("v1", i__3, "vnormg_", (ftnlen)148)], abs(d__2)); - } - } - -/* If the vector is zero, return zero; otherwise normalize first. */ -/* Normalizing helps in the cases where squaring would cause overflow */ -/* or underflow. In the cases where such is not a problem it not worth */ -/* it to optimize further. */ - - if (v1max == 0.) { - ret_val = 0.; - } else { - ret_val = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - a = v1[(i__2 = i__ - 1) < v1_dim1 && 0 <= i__2 ? i__2 : s_rnge( - "v1", i__2, "vnormg_", (ftnlen)167)] / v1max; - ret_val += a * a; - } - ret_val = v1max * sqrt(ret_val); - } - - return ret_val; -} /* vnormg_ */ - diff --git a/ext/spice/src/cspice/vnormg_c.c b/ext/spice/src/cspice/vnormg_c.c deleted file mode 100644 index d785dff1a6..0000000000 --- a/ext/spice/src/cspice/vnormg_c.c +++ /dev/null @@ -1,212 +0,0 @@ -/* - --Procedure vnormg_c ( Vector norm, general dimension ) - --Abstract - - Compute the magnitude of a double precision vector of arbitrary - dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vnormg_c - - - SpiceDouble vnormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I Vector whose magnitude is to be found. - ndim I Dimension of v1. - --Detailed_Input - - v1 This may be any double precision vector or arbitrary - size. - --Detailed_Output - - vnormg_c is the magnitude of v1 calculated in a numerically stable - way. - --Parameters - - None. - --Exceptions - - 1) If ndim is not physically realistic, greater than zero, a - BADDIMENSION error is signaled. The value 0. is returned. - --Files - - None. - --Particulars - - vnormg_c finds the component of v1 whose magnitude is the largest. - If the absolute magnitude of that component indicates that a - numeric overflow would occur when it is squared, or if it - indicates that an underflow would occur when squared (falsely - giving a magnitude of zero) then the following expression is - used: - - vnormg_c = v1max * MAGNITUDE OF [ (1/v1max)*v1 ] - - therwise a simpler expression is used: - - vnormg_c = MAGNITUDE OF [ v1 ] - - Beyond the logic described above, no further checking of the - validity of the input is performed. - --Examples - - The following table show the correlation between various input - vectors v1 and vnormg_c: - - ndim v1 ndim vnormg_c - ----------------------------------------------------------------- - 1 (-7.0D20) 1 7.D20 - 3 (1., 2., 2.) 3 3. - 4 (3., 3., 3., 3.) 4 6. - 5 (5., 12., 0., 0., 0.) 5 13. - 3 (-5.D-17, 0.0, 12.D-17) 3 13.D-17 - --Restrictions - - None. - --Author_and_Institution - - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 1-APR-1998 (EDW) - --Index_Entries - - norm of n-dimensional vector - --& -*/ - -{ /* Begin vnormg_c */ - - /* - Local variables - */ - - SpiceInt i; - SpiceDouble norm; - SpiceDouble scale; - - - /* - Use discovery check-in. - */ - - /* Initialize norm and scale to zero. */ - - norm = 0.; - scale = 0.; - - - /* Check ndim is cool. Dimension is positive definite. */ - - if ( ndim <= 0 ) - { - - chkin_c ( "vnormg_c" ); - SpiceError ( "Vector dimension less than or equal to zero", - "BADDIMENSION" ); - chkout_c ( "vnormg_c" ); - return ( 0. ); - - } - - - /* - Determine an appropriate scale factor to prevent numerical - overflow. Overflow would be bad! - */ - - for ( i = 0; i < ndim; i++ ) - { - scale = MaxAbs( scale, v1[i] ); - } - - - /* If the vector is zero, return zero. */ - - if ( scale == 0. ) - { - return 0.; - } - - - /* Do the calculation. Not very involved. */ - - for ( i = 0; i < ndim; i++ ) - { - norm += pow( v1[i] / scale, 2 ); - } - - - - /* Return the value. */ - - - return ( scale * sqrt( norm ) ); - - -} /* End vnormg_c */ diff --git a/ext/spice/src/cspice/vpack.c b/ext/spice/src/cspice/vpack.c deleted file mode 100644 index fb81ba72a4..0000000000 --- a/ext/spice/src/cspice/vpack.c +++ /dev/null @@ -1,151 +0,0 @@ -/* vpack.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VPACK ( Pack three scalar components into a vector ) */ -/* Subroutine */ int vpack_(doublereal *x, doublereal *y, doublereal *z__, - doublereal *v) -{ -/* $ Abstract */ - -/* Pack three scalar components into a vector. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X, */ -/* Y, */ -/* Z I Scalar components of a vector. */ -/* V O Equivalent vector. */ - -/* $ Detailed_Input */ - -/* X, */ -/* Y, */ -/* Z are the scalar components of a 3-vector. */ - -/* $ Detailed_Output */ - -/* V is the equivalent vector, such that V(1) = X */ -/* V(2) = Y */ -/* V(3) = Z */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Basically, this is just shorthand notation for the common */ -/* sequence */ - -/* V(1) = X */ -/* V(2) = Y */ -/* V(3) = Z */ - -/* The routine is useful largely for two reasons. First, it */ -/* reduces the chance that the programmer will make a "cut and */ -/* paste" mistake, like */ - -/* V(1) = X */ -/* V(1) = Y */ -/* V(1) = Z */ - -/* Second, it makes conversions between equivalent units simpler, */ -/* and clearer. For instance, the sequence */ - -/* V(1) = X * RPD */ -/* V(2) = Y * RPD */ -/* V(3) = Z * RPD */ - -/* can be replaced by the (nearly) equivalent sequence */ - -/* CALL VPACK ( X, Y, Z, V ) */ -/* CALL VSCL ( RPD, V, V ) */ - -/* $ Examples */ - -/* See: Detailed_Description. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* pack three scalar components into a vector */ - -/* -& */ - -/* Just shorthand, like it says above. */ - - v[0] = *x; - v[1] = *y; - v[2] = *z__; - return 0; -} /* vpack_ */ - diff --git a/ext/spice/src/cspice/vpack_c.c b/ext/spice/src/cspice/vpack_c.c deleted file mode 100644 index a3e6e5e0df..0000000000 --- a/ext/spice/src/cspice/vpack_c.c +++ /dev/null @@ -1,155 +0,0 @@ -/* - --Procedure vpack_c ( Pack three scalar components into a vector ) - --Abstract - - Pack three scalar components into a vector. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - - - void vpack_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble v[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - x, - y, - z I Scalar components of a 3-vector. - v O Equivalent 3-vector. - --Detailed_Input - - x, - y, - z are the scalar components of a 3-vector. - --Detailed_Output - - v is the equivalent vector, such that v[0] == x - v[1] == y - v[2] == z - --Parameters - - None. - --Particulars - - Basically, this is just shorthand notation for the common - sequence - - v[0] = x; - v[1] = y; - v[2] = z; - - The routine is useful largely for two reasons. First, it - reduces the chance that the programmer will make a "cut and - paste" mistake, like - - v[0] = x; - v[0] = y; - v[0] = z; - - Second, it makes conversions between equivalent units simpler, - and clearer. For instance, the sequence - - v[0] = x * rpd_c(); - v[1] = y * rpd_c(); - v[2] = z * rpd_c(); - - can be replaced by the (nearly) equivalent sequence - - vpack_c ( x, y, z, v ); - vscl_c ( rpd_c(), v, v ); - --Examples - - See: Detailed_Description. - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 24-MAY-1999 (IMU) (NJB) - --Index_Entries - - pack three scalar components into a vector - --& -*/ - -{ /* Begin vpack_c */ - - - - v[0] = x; - v[1] = y; - v[2] = z; - - - -} /* End vpack_c */ - diff --git a/ext/spice/src/cspice/vperp.c b/ext/spice/src/cspice/vperp.c deleted file mode 100644 index eda62b58fd..0000000000 --- a/ext/spice/src/cspice/vperp.c +++ /dev/null @@ -1,204 +0,0 @@ -/* vperp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VPERP ( Perpendicular component of a 3-vector ) */ -/* Subroutine */ int vperp_(doublereal *a, doublereal *b, doublereal *p) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - doublereal biga, bigb; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ); - doublereal r__[3], t[3], v[3]; - extern /* Subroutine */ int vproj_(doublereal *, doublereal *, doublereal - *), vsclip_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* Find the component of a vector that is perpendicular to a second */ -/* vector. All vectors are 3-dimensional. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I The vector whose orthogonal component is sought. */ -/* B I The vector used as the orthogonal reference. */ -/* P O The component of A orthogonal to B. */ - -/* $ Detailed_Input */ - -/* A is a double precision, 3-dimensional vector. It the vector */ -/* whose component orthogonal to B is sought. (There is a */ -/* unique decomposition of A into a sum V + P, where V is */ -/* parallel to B and P is orthogonal to B. We want the */ -/* component P.) */ - -/* B is a double precision, 3-dimensional vector. This */ -/* vector is the vector used as a reference for the */ -/* decomposition of A. */ - - -/* $ Detailed_Output */ - -/* P is a double precision, 3-dimensional vector containing */ -/* the component of A that is orthogonal to B. */ -/* P may overwrite either A or B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Given and non-zero vector B and a vector A, there is a unique */ -/* decomposition of A as a sum V + P such that P is orthogonal */ -/* to B and V is parallel to B. This routine finds the vector P. */ - -/* If B is a zero vector, P will be identical to A. */ - -/* $ Examples */ - -/* The following table gives sample inputs and results from calling */ -/* VPERP. */ - -/* A B P */ -/* ------------------------------------------ */ -/* (6, 6, 6) ( 2, 0, 0) (0, 6, 6) */ -/* (6, 6, 6) (-3, 0, 0) (0, 6, 6) */ -/* (6, 6, 0) ( 0, 7, 0) (6, 0, 0) */ -/* (6, 0, 0) ( 0, 0, 9) (6, 0, 0) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* Any reasonable calculus text (for example Thomas) */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 11-MAY-2010 (EDW) */ - -/* Minor edit to code comments eliminating typo. */ - -/* Reordered header sections to proper NAIF convention. */ -/* Removed Revision section, it listed a duplication of a */ -/* Version section entry. */ - -/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSCL call. */ - -/* - 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 */ - -/* perpendicular component of a 3-vector */ - -/* -& */ - -/* Local variables */ - - -/* Error free routine: no check-in. */ - -/* Computing MAX */ - d__1 = abs(a[0]), d__2 = abs(a[1]), d__1 = max(d__1,d__2), d__2 = abs(a[2] - ); - biga = max(d__1,d__2); -/* Computing MAX */ - d__1 = abs(b[0]), d__2 = abs(b[1]), d__1 = max(d__1,d__2), d__2 = abs(b[2] - ); - bigb = max(d__1,d__2); - -/* If A is the zero vector, just set P to zero and return. */ - - if (biga == 0.) { - p[0] = 0.; - p[1] = 0.; - p[2] = 0.; - return 0; - } - -/* If B is the zero vector, then set P equal to A. */ - - if (bigb == 0.) { - p[0] = a[0]; - p[1] = a[1]; - p[2] = a[2]; - return 0; - } - t[0] = a[0] / biga; - t[1] = a[1] / biga; - t[2] = a[2] / biga; - r__[0] = b[0] / bigb; - r__[1] = b[1] / bigb; - r__[2] = b[2] / bigb; - vproj_(t, r__, v); - vsub_(t, v, p); - vsclip_(&biga, p); - return 0; -} /* vperp_ */ - diff --git a/ext/spice/src/cspice/vperp_c.c b/ext/spice/src/cspice/vperp_c.c deleted file mode 100644 index f808b49c0b..0000000000 --- a/ext/spice/src/cspice/vperp_c.c +++ /dev/null @@ -1,187 +0,0 @@ -/* - --Procedure vperp_c ( Perpendicular component of a 3-vector) - --Abstract - - Find the component of a vector that is perpendicular to a second - vector. All vectors are 3-dimensional. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vperp_c - - - void vperp_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I The vector whose orthogonal component is sought. - b I The vector used as the orthogonal reference. - p O The component of a orthogonal to b. - --Detailed_Input - - a is a double precision, 3-dimensional vector. It the vector - whose component orthogonal to b is sought. (There is a - unique decomposition of a into a sum v + p, where v is - parallel to b and p is orthogonal to b. We want the - component p.) - - b is a double precision, 3-dimensional vector. This - vector is the vector used as a reference for the - decomposition of a. - - --Detailed_Output - - p is a double precision, 3-dimensional vector containing - the component of a that is orthogonal to b. - p may overwrite either a or b. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - Given and non-zero vector b and a vector a, there is a unique - decomposition of a as a sum v + p such that p is orthogonal - to b and v is parallel to b. This routine finds the vector p. - - If b is a zero vector, p will be identical to a. - --Examples - - The following table gives sample inputs and results from calling - vperp_c. - - a b p - ------------------------------------------ - (6, 6, 6) ( 2, 0, 0) (0, 6, 6) - (6, 6, 6) (-3, 0, 0) (0, 6, 6) - (6, 6, 0) ( 0, 7, 0) (6, 0, 0) - (6, 0, 0) ( 0, 0, 9) (6, 0, 0) - --Restrictions - - None. - --Literature_References - - REFERENCE: Any reasonable calculus text (for example Thomas) - --Author_and_Institution - - W.L. Taber (JPL) - --Version - - -CSPICE Version 1.2.1, 24-APR-2010 (EDW) - - Minor edit to code comments eliminating typo. - - -CSPICE Version 1.2.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.1.0, 06-MAR-1998 (EDW) - - Removed non printing character. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - perpendicular component of a 3-vector - --& -*/ - -{ /* Begin vperp_c */ - - /* - Local variables - */ - - SpiceDouble biga; - SpiceDouble bigb; - SpiceDouble r[3]; - SpiceDouble t[3]; - SpiceDouble v[3]; - - - biga = MaxAbs( a[0] , MaxAbs( a[1], a[2] ) ); - bigb = MaxAbs( b[0] , MaxAbs( b[1], b[2] ) ); - - - /* - If a or b is zero, set p to zero and return. - */ - - if ( biga == 0. || bigb == 0. ) - { - p[0] = 0.; - p[1] = 0.; - p[2] = 0.; - return; - } - - - vscl_c ( 1./biga, a, t ); - vscl_c ( 1./bigb, b, r ); - - vproj_c ( t, r, v ); - vsub_c ( t, v, p ); - vscl_c ( biga, p, p ); - - -} /* End vperp_c */ diff --git a/ext/spice/src/cspice/vprjp.c b/ext/spice/src/cspice/vprjp.c deleted file mode 100644 index f76f9bbf20..0000000000 --- a/ext/spice/src/cspice/vprjp.c +++ /dev/null @@ -1,199 +0,0 @@ -/* vprjp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b3 = 1.; - -/* $Procedure VPRJP ( Vector projection onto plane ) */ -/* Subroutine */ int vprjp_(doublereal *vin, doublereal *plane, doublereal * - vout) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), vlcom_(doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *); - doublereal const__; - extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, - doublereal *); - doublereal normal[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Project a vector onto a specified plane, orthogonally. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VIN I Vector to be projected. */ -/* PLANE I A SPICELIB plane onto which VIN is projected. */ -/* VOUT O Vector resulting from projection. */ - -/* $ Detailed_Input */ - -/* VIN is a 3-vector that is to be orthogonally projected */ -/* onto a specified plane. */ - -/* PLANE is a SPICELIB plane that represents the geometric */ -/* plane onto which VIN is to be projected. */ - -/* $ Detailed_Output */ - -/* VOUT is the vector resulting from the orthogonal */ -/* projection of VIN onto PLANE. VOUT is the closest */ -/* point in the specified plane to VIN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Invalid input planes are diagnosed by the routine PL2NVC, */ -/* which is called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Projecting a vector V orthogonally onto a plane can be thought of */ -/* as finding the closest vector in the plane to V. This `closest */ -/* vector' always exists; it may be coincident with the original */ -/* vector. */ - -/* Two related routines are VPRJPI, which inverts an orthogonal */ -/* projection of a vector onto a plane, and VPROJ, which projects */ -/* a vector orthogonally onto another vector. */ - -/* $ Examples */ - -/* 1) Find the closest point in the ring plane of a planet to a */ -/* spacecraft located at POSITN (in body-fixed coordinates). */ -/* Suppose the vector NORMAL is normal to the ring plane, and */ -/* that ORIGIN, which represents the body center, is in the */ -/* ring plane. Then we can make a `plane' with the code */ - -/* CALL PNV2PL ( ORIGIN, NORMAL, PLANE ) */ - -/* can find the projection by making the call */ - -/* CALL VPRJP ( POSITN, PLANE, PROJ ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* vector projection onto plane */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("VPRJP", (ftnlen)5); - } - -/* Obtain a unit vector normal to the input plane, and a constant */ -/* for the plane. */ - - pl2nvc_(plane, normal, &const__); - -/* Let the notation < a, b > indicate the inner product of vectors */ -/* a and b. */ - -/* VIN differs from its projection onto PLANE by some multiple of */ -/* NORMAL. That multiple is */ - - -/* < VIN - VOUT, NORMAL > * NORMAL */ - -/* = ( < VIN, NORMAL > - < VOUT, NORMAL > ) * NORMAL */ - -/* = ( < VIN, NORMAL > - CONST ) * NORMAL */ - - -/* Subtracting this multiple of NORMAL from VIN yields VOUT. */ - - d__1 = const__ - vdot_(vin, normal); - vlcom_(&c_b3, vin, &d__1, normal, vout); - chkout_("VPRJP", (ftnlen)5); - return 0; -} /* vprjp_ */ - diff --git a/ext/spice/src/cspice/vprjp_c.c b/ext/spice/src/cspice/vprjp_c.c deleted file mode 100644 index 7c9dbff125..0000000000 --- a/ext/spice/src/cspice/vprjp_c.c +++ /dev/null @@ -1,197 +0,0 @@ -/* - --Procedure vprjp_c ( Vector projection onto plane ) - --Abstract - - Project a vector onto a specified plane, orthogonally. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vprjp_c - - - void vprjp_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * plane, - SpiceDouble vout [3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - vin I Vector to be projected. - plane I A CSPICE plane onto which vin is projected. - vout O Vector resulting from projection. - --Detailed_Input - - vin is a 3-vector that is to be orthogonally projected - onto a specified plane. - - plane is a CSPICE plane that represents the geometric - plane onto which vin is to be projected. - --Detailed_Output - - vout is the vector resulting from the orthogonal - projection of vin onto plane. vout is the closest - point in the specified plane to vin. - --Parameters - - None. - --Exceptions - - 1) Invalid input planes are diagnosed by the routine pl2nvc_c, - which is called by this routine. - --Files - - None. - --Particulars - - Projecting a vector v orthogonally onto a plane can be thought of - as finding the closest vector in the plane to v. This `closest - vector' always exists; it may be coincident with the original - vector. - - Two related routines are vprjpi_c, which inverts an orthogonal - projection of a vector onto a plane, and vproj_c, which projects - a vector orthogonally onto another vector. - --Examples - - 1) Find the closest point in the ring plane of a planet to a - spacecraft located at positn (in body-fixed coordinates). - Suppose the vector normal is normal to the ring plane, and - that origin, which represents the body center, is in the - ring plane. Then we can make a `plane' with the code - - pnv2pl_c ( origin, normal, &plane ); - - can find the projection by making the call - - vprjp_c ( positn, &plane, proj ); - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - vector projection onto plane - --& -*/ - -{ /* Begin vprjp_c */ - - - /* - Local variables - */ - SpiceDouble constant; - SpiceDouble normal [3]; - - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return; - } - - chkin_c ( "vprjp_c" ); - - - /* - Obtain a unit vector normal to the input plane, and a constant - for the plane. - */ - pl2nvc_c ( plane, normal, &constant ); - - - /* - Let the notation < a, b > indicate the inner product of vectors - a and b. - - vin differs from its projection onto plane by some multiple of - normal. That multiple is - - - < vin - vout, normal > * normal - - = ( < vin, normal > - < vout, normal > ) * normal - - = ( < vin, normal > - const ) * normal - - - Subtracting this multiple of normal from vin yields vout. - */ - - vlcom_c ( 1.0, - vin, - constant - vdot_c ( vin, normal ), - normal, - vout ); - - - chkout_c ( "vprjp_c" ); - -} /* End vprjp_c */ - diff --git a/ext/spice/src/cspice/vprjpi.c b/ext/spice/src/cspice/vprjpi.c deleted file mode 100644 index d41c849889..0000000000 --- a/ext/spice/src/cspice/vprjpi.c +++ /dev/null @@ -1,352 +0,0 @@ -/* vprjpi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b3 = 1.; - -/* $Procedure VPRJPI ( Vector projection onto plane, inverted ) */ -/* Subroutine */ int vprjpi_(doublereal *vin, doublereal *projpl, doublereal * - invpl, doublereal *vout, logical *found) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - doublereal invc, invn[3]; - extern doublereal vdot_(doublereal *, doublereal *); - doublereal mult; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal denom; - extern doublereal dpmax_(void); - doublereal projc, limit; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *); - doublereal numer, projn[3]; - extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, - doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Find the vector in a specified plane that maps to a specified */ -/* vector in another plane under orthogonal projection. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VIN I The projected vector. */ -/* PROJPL I Plane containing VIN. */ -/* INVPL I Plane containing inverse image of VIN. */ -/* VOUT O Inverse projection of VIN. */ -/* FOUND O Flag indicating whether VOUT could be calculated. */ - -/* $ Detailed_Input */ - -/* VIN, */ -/* PROJPL, */ -/* INVPL are, respectively, a 3-vector, a SPICELIB plane */ -/* containing the vector, and a SPICELIB plane */ -/* containing the inverse image of the vector under */ -/* orthogonal projection onto PROJPL. */ - -/* $ Detailed_Output */ - -/* VOUT is the inverse orthogonal projection of VIN. This */ -/* is the vector lying in the plane INVPL whose */ -/* orthogonal projection onto the plane PROJPL is */ -/* VIN. VOUT is valid only when FOUND (defined below) */ -/* is .TRUE. Otherwise, VOUT is undefined. */ - -/* FOUND indicates whether the inverse orthogonal projection */ -/* of VIN could be computed. FOUND is .TRUE. if so, */ -/* .FALSE. otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the geometric planes defined by PROJPL and INVPL are */ -/* orthogonal, or nearly so, the inverse orthogonal projection */ -/* of VIN may be undefined or have magnitude too large to */ -/* represent with double precision numbers. In either such */ -/* case, FOUND will be set to .FALSE. */ - -/* 2) Even when FOUND is .TRUE., VOUT may be a vector of extremely */ -/* large magnitude, perhaps so large that it is impractical to */ -/* compute with it. It's up to you to make sure that this */ -/* situation does not occur in your application of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Projecting a vector orthogonally onto a plane can be thought of */ -/* as finding the closest vector in the plane to the original vector. */ -/* This `closest vector' always exists; it may be coincident with the */ -/* original vector. Inverting an orthogonal projection means finding */ -/* the vector in a specified plane whose orthogonal projection onto */ -/* a second specified plane is a specified vector. The vector whose */ -/* projection is the specified vector is the inverse projection of */ -/* the specified vector, also called the `inverse image under */ -/* orthogonal projection' of the specified vector. This routine */ -/* finds the inverse orthogonal projection of a vector onto a plane. */ - -/* Related routines are VPRJP, which projects a vector onto a plane */ -/* orthogonally, and VPROJ, which projects a vector onto another */ -/* vector orthogonally. */ - -/* $ Examples */ - -/* 1) Suppose */ - -/* VIN = ( 0.0, 1.0, 0.0 ), */ - -/* and that PROJPL has normal vector */ - -/* PROJN = ( 0.0, 0.0, 1.0 ). */ - -/* Also, let's suppose that INVPL has normal vector and constant */ - -/* INVN = ( 0.0, 2.0, 2.0 ) */ -/* INVC = 4.0. */ - -/* Then VIN lies on the y-axis in the x-y plane, and we want to */ -/* find the vector VOUT lying in INVPL such that the orthogonal */ -/* projection of VOUT the x-y plane is VIN. Let the notation */ -/* < a, b > indicate the inner product of vectors a and b. */ -/* Since every point X in INVPL satisfies the equation */ - -/* < X, (0.0, 2.0, 2.0) > = 4.0, */ - -/* we can verify by inspection that the vector */ - -/* ( 0.0, 1.0, 1.0 ) */ - -/* is in INVPL and differs from VIN by a multiple of PROJN. So */ - -/* ( 0.0, 1.0, 1.0 ) */ - -/* must be VOUT. */ - -/* To find this result using SPICELIB, we can create the */ -/* SPICELIB planes PROJPL and INVPL using the code fragment */ - -/* CALL NVP2PL ( PROJN, VIN, PROJPL ) */ -/* CALL NVC2PL ( INVN, INVC, INVPL ) */ - -/* and then perform the inverse projection using the call */ - -/* CALL VPRJPI ( VIN, PROJPL, INVPL, VOUT ) */ - -/* VPRJPI will return the value */ - -/* VOUT = ( 0.0, 1.0, 1.0 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 17-FEB-2004 (NJB) */ - -/* Computation of LIMIT was re-structured to avoid */ -/* run-time underflow warnings on some platforms. */ - -/* - 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, 01-NOV-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* vector projection onto plane inverted */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 17-FEB-2004 (NJB) */ - -/* Computation of LIMIT was re-structured to avoid */ -/* run-time underflow warnings on some platforms. */ -/* In the revised code, BOUND/DPMAX() is never */ -/* scaled by a number having absolute value < 1. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* BOUND is used to bound the magnitudes of the numbers that we */ -/* try to take the reciprocal of, since we can't necessarily invert */ -/* any non-zero number. We won't try to invert any numbers with */ -/* magnitude less than */ - -/* BOUND / DPMAX(). */ - -/* BOUND is chosen somewhat arbitrarily.... */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("VPRJPI", (ftnlen)6); - } - -/* Unpack the planes. */ - - pl2nvc_(projpl, projn, &projc); - pl2nvc_(invpl, invn, &invc); - -/* We'll first discuss the computation of VOUT in the nominal case, */ -/* and then deal with the exceptional cases. */ - -/* When PROJPL and INVPL are not orthogonal to each other, the */ -/* inverse projection of VIN will differ from VIN by a multiple of */ -/* PROJN, the unit normal vector to PROJPL. We find this multiple */ -/* by using the fact that the inverse projection VOUT satisfies the */ -/* plane equation for the inverse projection plane INVPL. */ - -/* We have */ - -/* VOUT = VIN + MULT * PROJN; (1) */ - -/* since VOUT satisfies */ - -/* < VOUT, INVN > = INVC */ - -/* we must have */ - -/* < VIN + MULT * PROJN, INVN > = INVC */ - -/* which in turn implies */ - - -/* INVC - < VIN, INVN > */ -/* MULT = ------------------------. (2) */ -/* < PROJN, INVN > */ - -/* Having MULT, we can compute VOUT according to equation (1). */ - -/* Now, if the denominator in the above expression for MULT is zero */ -/* or just too small, performing the division would cause a */ -/* divide-by-zero error or an overflow of MULT. In either case, we */ -/* will avoid carrying out the division, and we'll set FOUND to */ -/* .FALSE. */ - - -/* Compute the numerator and denominator of the right side of (2). */ - - numer = invc - vdot_(vin, invn); - denom = vdot_(projn, invn); - -/* If the magnitude of the denominator is greater than the absolute */ -/* value of */ - -/* BOUND */ -/* LIMIT = --------- * NUMER, */ -/* DPMAX() */ - -/* we can safely divide the numerator by the denominator, and the */ -/* magnitude of the result will be no greater than */ - -/* DPMAX() */ -/* --------- . */ -/* BOUND */ - -/* Note that we have ruled out the case where NUMER and DENOM are */ -/* both zero by insisting on strict inequality in the comparison of */ -/* DENOM and LIMIT. */ - -/* We never set LIMIT smaller than BOUND/DPMAX(), since */ -/* the computation using NUMER causes underflow to be signaled */ -/* on some systems. */ - - if (abs(numer) < 1.) { - limit = 10. / dpmax_(); - } else { - limit = (d__1 = 10. / dpmax_() * numer, abs(d__1)); - } - if (abs(denom) > limit) { - -/* We can find VOUT after all. */ - - mult = numer / denom; - vlcom_(&c_b3, vin, &mult, projn, vout); - *found = TRUE_; - } else { - -/* No dice. */ - - *found = FALSE_; - } - chkout_("VPRJPI", (ftnlen)6); - return 0; -} /* vprjpi_ */ - diff --git a/ext/spice/src/cspice/vprjpi_c.c b/ext/spice/src/cspice/vprjpi_c.c deleted file mode 100644 index 8151635a21..0000000000 --- a/ext/spice/src/cspice/vprjpi_c.c +++ /dev/null @@ -1,362 +0,0 @@ -/* - --Procedure vprjpi_c ( Vector projection onto plane, inverted ) - --Abstract - - Find the vector in a specified plane that maps to a specified - vector in another plane under orthogonal projection. - --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 - - PLANES - --Keywords - - GEOMETRY - MATH - PLANE - VECTOR - -*/ - #include - #include "SpiceUsr.h" - #undef vprjpi_c - - - void vprjpi_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * projpl, - ConstSpicePlane * invpl, - SpiceDouble vout [3], - SpiceBoolean * found ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - vin I The projected vector. - projpl I Plane containing vin. - invpl I Plane containing inverse image of vin. - vout O Inverse projection of vin. - found O Flag indicating whether vout could be calculated. - --Detailed_Input - - vin, - projpl, - invpl are, respectively, a 3-vector, a CSPICE plane - containing the vector, and a CSPICE plane - containing the inverse image of the vector under - orthogonal projection onto projpl. - --Detailed_Output - - vout is the inverse orthogonal projection of vin. This - is the vector lying in the plane invpl whose - orthogonal projection onto the plane projpl is - vin. vout is valid only when found (defined below) - is SPICETRUE. Otherwise, vout is undefined. - - found indicates whether the inverse orthogonal projection - of vin could be computed. found is SPICETRUE if so, - SPICEFALSE otherwise. - --Parameters - - None. - --Exceptions - - 1) If the geometric planes defined by projpl and invpl are - orthogonal, or nearly so, the inverse orthogonal projection - of vin may be undefined or have magnitude too large to - represent with double precision numbers. In either such - case, found will be set to SPICEFALSE. - - 2) Even when found is SPICETRUE, vout may be a vector of extremely - large magnitude, perhaps so large that it is impractical to - compute with it. It's up to you to make sure that this - situation does not occur in your application of this routine. - --Files - - None. - --Particulars - - Projecting a vector orthogonally onto a plane can be thought of - as finding the closest vector in the plane to the original vector. - This `closest vector' always exists; it may be coincident with the - original vector. Inverting an orthogonal projection means finding - the vector in a specified plane whose orthogonal projection onto - a second specified plane is a specified vector. The vector whose - projection is the specified vector is the inverse projection of - the specified vector, also called the `inverse image under - orthogonal projection' of the specified vector. This routine - finds the inverse orthogonal projection of a vector onto a plane. - - Related routines are vprjp_c, which projects a vector onto a plane - orthogonally, and vproj_c, which projects a vector onto another - vector orthogonally. - --Examples - - 1) Suppose - - vin = ( 0.0, 1.0, 0.0 ), - - and that projpl has normal vector - - projn = ( 0.0, 0.0, 1.0 ). - - Also, let's suppose that invpl has normal vector and constant - - invn = ( 0.0, 2.0, 2.0 ) - invc = 4.0. - - Then vin lies on the y-axis in the x-y plane, and we want to - find the vector vout lying in invpl such that the orthogonal - projection of vout the x-y plane is vin. Let the notation - < a, b > indicate the inner product of vectors a and b. - Since every point x in invpl satisfies the equation - - < x, (0.0, 2.0, 2.0) > = 4.0, - - we can verify by inspection that the vector - - ( 0.0, 1.0, 1.0 ) - - is in invpl and differs from vin by a multiple of projn. So - - ( 0.0, 1.0, 1.0 ) - - must be vout. - - To find this result using CSPICE, we can create the - CSPICE planes projpl and invpl using the code fragment - - nvp2pl_c ( projn, vin, &projpl ); - nvc2pl_c ( invn, invc, &invpl ); - - and then perform the inverse projection using the call - - vprjpi_c ( vin, &projpl, &invpl, vout ); - - vprjpi_c will return the value - - vout = ( 0.0, 1.0, 1.0 ); - --Restrictions - - None. - --Literature_References - - [1] `Calculus and Analytic Geometry', Thomas and Finney. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.1.0, 05-APR-2004 (NJB) - - Computation of LIMIT was re-structured to avoid - run-time underflow warnings on some platforms. - - -CSPICE Version 1.0.0, 05-MAR-1999 (NJB) - --Index_Entries - - vector projection onto plane inverted - --& -*/ - - -/* --Revisions - - -CSPICE Version 1.1.0, 05-APR-2004 (NJB) - - Computation of LIMIT was re-structured to avoid run-time - underflow warnings on some platforms. In the revised code, - BOUND/dpmax_c() is never scaled by a number having absolute value - < 1. - --& -*/ - - -{ /* Begin vprjpi_c */ - - /* - Local constants - */ - - /* - BOUND is used to bound the magnitudes of the numbers that we - try to take the reciprocal of, since we can't necessarily invert - any non-zero number. We won't try to invert any numbers with - magnitude less than - - BOUND / dpmax_c() - - BOUND is chosen somewhat arbitrarily.... - */ - - #define BOUND 10.0 - - - - /* - Local variables - */ - SpiceDouble denom; - SpiceDouble invc; - SpiceDouble invn [3]; - SpiceDouble limit; - SpiceDouble mult; - SpiceDouble numer; - SpiceDouble projc; - SpiceDouble projn [3]; - - - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return; - } - - chkin_c ( "vprjpi_c" ); - - - /* - Unpack the planes. - */ - pl2nvc_c ( projpl, projn, &projc ); - pl2nvc_c ( invpl, invn, &invc ); - - /* - We'll first discuss the computation of VOUT in the nominal case, - and then deal with the exceptional cases. - - When projpl and invpl are not orthogonal to each other, the - inverse projection of vin will differ from vin by a multiple of - projn, the unit normal vector to projpl. We find this multiple - by using the fact that the inverse projection vout satisfies the - plane equation for the inverse projection plane invpl. - - We have - - vout = vin + mult * projn; (1) - - since vout satisfies - - < vout, invn > = invc - - we must have - - < vin + mult * projn, invn > = invc - - which in turn implies - - - invc - < vin, invn > - mult = ------------------------. (2) - < projn, invn > - - Having mult, we can compute vout according to equation (1). - - Now, if the denominator in the above expression for mult is zero - or just too small, performing the division would cause a - divide-by-zero error or an overflow of mult. In either case, we - will avoid carrying out the division, and we'll set found to - SPICEFALSE. - - - Compute the numerator and denominator of the right side of (2). - */ - - numer = invc - vdot_c ( vin, invn ); - denom = vdot_c ( projn, invn ); - - - /* - If the magnitude of the denominator is greater than - - BOUND - limit = abs ( ---------- * numer ), - dpmax_c() - - we can safely divide the numerator by the denominator, and the - magnitude of the result will be no greater than - - dpmax_c() - ----------- . - BOUND - - Note that we have ruled out the case where numer and denom are - both zero by insisting on strict inequality in the comparison of - denom and limit: - */ - - if ( fabs(numer) < 1.0 ) - { - limit = fabs ( BOUND / dpmax_c() ); - } - else - { - limit = fabs ( ( BOUND / dpmax_c() ) * numer ); - } - - *found = ( fabs (denom) > limit ); - - - if ( *found ) - { - /* - We'll compute vout after all. - */ - mult = numer / denom; - - vlcom_c ( 1.0, vin, mult, projn, vout ); - } - - - chkout_c ( "vprjpi_c" ); - -} /* End vprjpi_c */ - diff --git a/ext/spice/src/cspice/vproj.c b/ext/spice/src/cspice/vproj.c deleted file mode 100644 index 755211946e..0000000000 --- a/ext/spice/src/cspice/vproj.c +++ /dev/null @@ -1,186 +0,0 @@ -/* vproj.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VPROJ ( Vector projection, 3 dimensions ) */ -/* Subroutine */ int vproj_(doublereal *a, doublereal *b, doublereal *p) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - doublereal biga, bigb; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vdot_(doublereal *, doublereal *); - doublereal r__[3], t[3], scale; - -/* $ Abstract */ - -/* VPROJ finds the projection of one vector onto another vector. */ -/* All vectors are 3-dimensional. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I The vector to be projected. */ -/* B I The vector onto which A is to be projected. */ -/* P O The projection of A onto B. */ - -/* $ Detailed_Input */ - -/* A is a double precision, 3-dimensional vector. This */ -/* vector is to be projected onto the vector B. */ - -/* B is a double precision, 3-dimensional vector. This */ -/* vector is the vector which receives the projection. */ - -/* $ Detailed_Output */ - -/* P is a double precision, 3-dimensional vector containing the */ -/* projection of A onto B. (P is necessarily parallel to B.) */ -/* If B is the zero vector then P will be returned as the zero */ -/* vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The given any vectors A and B there is a unique decomposition of */ -/* A as a sum V + P such that V the dot product of V and B is zero, */ -/* and the dot product of P with B is equal the product of the */ -/* lengths of P and B. P is called the projection of A onto B. It */ -/* can be expressed mathematically as */ - -/* DOT(A,B) */ -/* -------- * B */ -/* DOT(B,B) */ - -/* (This is not necessarily the prescription used to compute the */ -/* projection. It is intended only for descriptive purposes.) */ - -/* $ Examples */ - -/* The following table gives sample inputs and results from calling */ -/* VPROJ. */ - -/* A B NDIM P */ -/* ------------------------------------------------------- */ -/* (6, 6, 6) ( 2, 0, 0) 3 (6, 0, 0) */ -/* (6, 6, 6) (-3, 0, 0) 3 (6, 0, 0) */ -/* (6, 6, 0) ( 0, 7, 0) 3 (0, 6, 0) */ -/* (6, 0, 0) ( 0, 0, 9) 3 (0, 0, 0) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* Any reasonable calculus text (for example Thomas) */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 */ - -/* 3-dimensional vector projection */ - -/* -& */ - - -/* Computing MAX */ - d__1 = abs(a[0]), d__2 = abs(a[1]), d__1 = max(d__1,d__2), d__2 = abs(a[2] - ); - biga = max(d__1,d__2); -/* Computing MAX */ - d__1 = abs(b[0]), d__2 = abs(b[1]), d__1 = max(d__1,d__2), d__2 = abs(b[2] - ); - bigb = max(d__1,d__2); - if (biga == 0.) { - p[0] = 0.; - p[1] = 0.; - p[2] = 0.; - return 0; - } - if (bigb == 0.) { - p[0] = 0.; - p[1] = 0.; - p[2] = 0.; - return 0; - } - r__[0] = b[0] / bigb; - r__[1] = b[1] / bigb; - r__[2] = b[2] / bigb; - t[0] = a[0] / biga; - t[1] = a[1] / biga; - t[2] = a[2] / biga; - scale = vdot_(t, r__) * biga / vdot_(r__, r__); - vscl_(&scale, r__, p); - return 0; -} /* vproj_ */ - diff --git a/ext/spice/src/cspice/vproj_c.c b/ext/spice/src/cspice/vproj_c.c deleted file mode 100644 index 0c2d521b41..0000000000 --- a/ext/spice/src/cspice/vproj_c.c +++ /dev/null @@ -1,179 +0,0 @@ -/* - --Procedure vproj_c ( Vector projection, 3 dimensions ) - --Abstract - - vproj_c finds the projection of one vector onto another vector. - All vectors are 3-dimensional. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef vproj_c - - void vproj_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I The vector to be projected. - b I The vector onto which a is to be projected. - p O The projection of a onto b. - --Detailed_Input - - a is a double precision, 3-dimensional vector. This - vector is to be projected onto the vector b. - - b is a double precision, 3-dimensional vector. This - vector is the vector which receives the projection. - --Detailed_Output - - p is a double precision, 3-dimensional vector containing - the projection of a onto b. p may overwrite either - a or b. (p is necessarily parallel to b.) If b is - the zero vector then p will be returned as the zero vector. - --Parameters - - None. - --Particulars - - The given any vectors a and b there is a unique decomposition - of a as a sum v + p such that v the dot product of v and b - is zero, and the dot product of p with b is equal the product - of the lengths of p and b. p is called the projection of - a onto b. It can be expressed mathematically as - - dot(a,b) - -------- * b - dot(b,b) - - (This is not necessarily the prescription used to compute - the projection. It is intended only for descriptive purposes.) - --Examples - - The following table gives sample inputs and results from calling - vproj_c. - - a b p - -------------------------------------------------- - (6, 6, 6) ( 2, 0, 0) (6, 0, 0) - (6, 6, 6) (-3, 0, 0) (6, 0, 0) - (6, 6, 0) ( 0, 7, 0) (0, 6, 0) - (6, 0, 0) ( 0, 0, 9) (0, 0, 0) - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.L. Taber (JPL) - --Literature_References - - REFERENCE: Any reasonable calculus text (for example Thomas) - --Version - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - 3-dimensional vector projection - --& -*/ - -{ /* Begin vproj_c */ - - - /* - Local variables - */ - - SpiceDouble biga; - SpiceDouble bigb; - SpiceDouble r[3]; - SpiceDouble t[3]; - SpiceDouble scale; - - - biga = MaxAbs ( a[0] ,MaxAbs ( a[1], a[2] ) ); - bigb = MaxAbs ( b[0] ,MaxAbs ( b[1], b[2] ) ); - - - /* - If a or b is zero, return the zero vector. - */ - - if ( biga == 0 || bigb == 0 ) - { - p[0] = 0.0; - p[1] = 0.0; - p[2] = 0.0; - return; - } - - - vscl_c ( 1./biga, a, t ); - vscl_c ( 1./bigb, b, r ); - - scale = vdot_c (t,r) * biga / vdot_c (r,r); - - vscl_c ( scale, r, p ); - - -} /* End vproj_c */ diff --git a/ext/spice/src/cspice/vprojg.c b/ext/spice/src/cspice/vprojg.c deleted file mode 100644 index 3f5495fd6a..0000000000 --- a/ext/spice/src/cspice/vprojg.c +++ /dev/null @@ -1,186 +0,0 @@ -/* vprojg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VPROJG ( Vector projection, general dimension ) */ -/* Subroutine */ int vprojg_(doublereal *a, doublereal *b, integer *ndim, - doublereal *p) -{ - doublereal scale, adotb, bdotb; - extern /* Subroutine */ int vsclg_(doublereal *, doublereal *, integer *, - doublereal *); - extern doublereal vdotg_(doublereal *, doublereal *, integer *); - -/* $ Abstract */ - -/* VPROJG finds the projection of the one vector onto another */ -/* vector. All vectors are of arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I The vector to be projected. */ -/* B I The vector onto which A is to be projected. */ -/* NDIM I Dimension of A, B, and P. */ -/* P O The projection of A onto B. */ - -/* $ Detailed_Input */ - -/* A is a double precision vector of arbitrary dimension. This */ -/* vector is to be projected onto the vector B. */ - -/* B is a double precision vector of arbitrary dimension. This */ -/* vector is the vector which receives the projection. */ - -/* NDIM is the dimension of A, B and P. */ - -/* $ Detailed_Output */ - -/* P is a double precision vector of arbitrary dimension */ -/* containing the projection of A onto B. (P is necessarily */ -/* parallel to B.) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The projection of a vector A onto a vector B is, by definition, */ -/* that component of A which is parallel to B. To find this */ -/* component it is enough to find the scalar ratio of the length of */ -/* B to the projection of A onto B, and then use this number to */ -/* scale the length of B. This ratio is given by */ - -/* RATIO = (A DOT B) / (B DOT B) */ - -/* where DOT denotes the general vector dot product. This routine */ -/* does not attempt to divide by zero in the event that B is the */ -/* zero vector. */ - -/* $ Examples */ - -/* The following table gives sample inputs and results from calling */ -/* VPROJG. */ - -/* A B NDIM P */ -/* ----------------------------------------------------------- */ -/* (6, 6, 6, 6) ( 2, 0, 0, 0) 4 (6, 0, 0, 0) */ -/* (6, 6, 6, 0) (-3, 0, 0, 0) 4 (6, 0, 0, 0) */ -/* (6, 6, 0, 0) ( 0, 7, 0, 0) 4 (0, 6, 0, 0) */ -/* (6, 0, 0, 0) ( 0, 0, 9, 0) 4 (0, 0, 0, 0) */ - -/* $ Restrictions */ - -/* No error detection or recovery schemes are incorporated into this */ -/* subroutine except to insure that no attempt is made to divide by */ -/* zero. Thus, the user is required to make sure that the vectors */ -/* A and B are such that no floating point overflow will occur when */ -/* the dot products are calculated. */ - -/* $ Literature_References */ - -/* Any reasonable calculus text (for example Thomas) */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.0.2, 22-AUG-2001 (EDW) */ - -/* Corrected ENDIF to END IF. */ - -/* - 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 */ - -/* n-dimensional vector projection */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ - -/* The declaration of the unused variable I was removed. */ -/* -& */ - - - adotb = vdotg_(a, b, ndim); - bdotb = vdotg_(b, b, ndim); - - if (bdotb == 0.) { - scale = 0.; - } else { - scale = adotb / bdotb; - } - - vsclg_(&scale, b, ndim, p); - - return 0; -} /* vprojg_ */ - diff --git a/ext/spice/src/cspice/vrel.c b/ext/spice/src/cspice/vrel.c deleted file mode 100644 index 0f5f996b6f..0000000000 --- a/ext/spice/src/cspice/vrel.c +++ /dev/null @@ -1,220 +0,0 @@ -/* vrel.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VREL ( Vector relative difference, 3 dimensions ) */ -doublereal vrel_(doublereal *v1, doublereal *v2) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - - /* Local variables */ - extern doublereal vdist_(doublereal *, doublereal *), vnorm_(doublereal *) - ; - doublereal denorm, nunorm; - -/* $ Abstract */ - -/* Return the relative difference between two 3-dimensional vectors. */ - -/* $ 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 */ - -/* MATH */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* V1,V2 I Input vectors. */ - -/* $ Detailed_Input */ - -/* V1, V2 are two 3-dimensional vectors for which the */ -/* relative difference is to be computed. */ - -/* $ Detailed_Output */ - -/* VREL is the relative difference between V1 and V2. */ -/* It is defined as: */ -/* || V1 - V2 || */ -/* VREL = ---------------------- */ -/* MAX ( ||V1||, ||V2|| ) */ - -/* where || X || indicates the Euclidean norm of */ -/* the vector X. */ - -/* VREL assumes values in the range [0,2]. If both */ -/* V1 and V2 are zero vectors then VREL is defined */ -/* to be zero. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If both V1 and V2 are zero vectors then VREL is defined */ -/* to be zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function computes the relative difference between two */ -/* 3-dimensional vectors as defined above. */ - -/* The function VRELG may be used to find the relative difference */ -/* for two vectors of general dimension. */ - -/* $ Examples */ - -/* This example code fragment computes the relative difference */ -/* between the geometric and light time corrected state of Io */ -/* with respect to Voyager 2 at a given UTC time. */ - -/* C */ -/* C The NAIF integer code for Io is 501 and the code for */ -/* C Voyager 2 is -32. */ -/* C */ - -/* INTEGER IO */ -/* PARAMETER ( IO = 501 ) */ - -/* INTEGER VG2 */ -/* PARAMETER ( VG2 = -32 ) */ - -/* C */ -/* C Spicelib function */ -/* C */ -/* DOUBLE PRECISION VREL */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION POS1 ( 3 ) */ -/* DOUBLE PRECISION POS2 ( 3 ) */ -/* DOUBLE PRECISION DIFF */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION ET */ - -/* INTEGER HANDLE */ - -/* CHARACTER*(20) UTC */ - -/* DATA UTC / '1979 JUN 25 12:00:00' / */ - -/* C */ -/* C Load the sample SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'VG2_JUP.BSP', HANDLE ) */ -/* C */ -/* C Convert the UTC time string to ephemeris time. */ -/* C */ -/* CALL UTC2ET ( UTC, ET ) */ -/* C */ -/* C First calculate the geometric state and then the light */ -/* C time corrected state. */ -/* C */ -/* CALL SPKEZ ( IO, ET, 'J2000', 'NONE', VG2, STATE, LT ) */ - -/* CALL VEQU ( STATE, POS1 ) */ - -/* CALL SPKEZ ( IO, ET, 'J2000', 'LT', VG2, STATE, LT ) */ - -/* CALL VEQU ( STATE, POS2 ) */ -/* C */ -/* C Call VREL to find the relative difference between the */ -/* C two states. */ -/* C */ -/* DIFF = VREL ( POS1, POS2 ) */ - -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-JUN-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* relative difference of 3-dimensional vectors */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* If the numerator is zero then set VREL equal to zero. Otherwise, */ -/* perform the rest of the calculation. */ - -/* This handles the case where both vectors are zero vectors since */ -/* the distance between them will be zero. */ - - nunorm = vdist_(v1, v2); - if (nunorm == 0.) { - ret_val = 0.; - } else { -/* Computing MAX */ - d__1 = vnorm_(v1), d__2 = vnorm_(v2); - denorm = max(d__1,d__2); - ret_val = nunorm / denorm; - } - return ret_val; -} /* vrel_ */ - diff --git a/ext/spice/src/cspice/vrel_c.c b/ext/spice/src/cspice/vrel_c.c deleted file mode 100644 index ecbedce4d1..0000000000 --- a/ext/spice/src/cspice/vrel_c.c +++ /dev/null @@ -1,227 +0,0 @@ -/* - --Procedure vrel_c ( Vector relative difference, 3 dimensions ) - --Abstract - - Return the relative difference between two 3-dimensional vectors. - --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 - - MATH - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef vrel_c - - SpiceDouble vrel_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - v1,v2 I Input vectors. - --Detailed_Input - - v1, v2 are two 3-dimensional vectors for which the - relative difference is to be computed. - --Detailed_Output - - vrel_c the relative difference between V1 and V2. - It is defined as: - || v1 - v2 || - vrel_c = ---------------------- - max ( ||v1||, ||v2|| ) - - where || x || indicates the Euclidean norm of - the vector x ( ||x|| = sqrt( x . x ) ). - - vrel_c assumes values in the range [0,2]. If both - v1 and v2 are zero vectors then vrel_c is defined - to be zero. - - --Parameters - - None. - --Exceptions - - Error free. - - If both v1 and v2 are zero vectors then vrel_c is defined - to be zero. - --Files - - None. - --Particulars - - This function computes the relative difference between two - 3-dimensional vectors as defined above. - - The function vrelg_c may be used to find the relative difference - for two vectors of general dimension. - --Examples - - This example code fragment computes the relative difference - between the geometric and light time corrected state of Io - with respect to Voyager 2 at a given UTC time. - - #include "SpiceUsr.h" - . - . - . - /. - The NAIF integer code for Io is 501 and the code for - Voyager 2 is -32. - ./ - - #define IO 501 - #define VG2 -32 - - - /. - Local variables - ./ - SpiceDouble state [ 6 ]; - SpiceDouble pos1 [ 3 ]; - SpiceDouble pos2 [ 3 ]; - SpiceDouble diff; - SpiceDouble lt; - SpiceDouble et; - - SpiceChar * utc = "1979 JUN 25 12:00:00"; - - /. - Load the sample SPK ephemeris file. - ./ - furnsh_c ( "VG2_JUP.BSP" ); - - - /. - Convert the UTC time string to ephemeris time. - ./ - utc2et_c ( utc, &et ); - - - /. - First calculate the geometric state and then the light - time corrected state. - ./ - spkez_c ( IO, et, "J2000", "none", VG2, state, < ); - - vequ_c ( state, pos1 ); - - spkez_c ( IO, et, "J2000", "lt", VG2, state, < ); - - vequ_c ( state, pos2 ); - - /. - Call vrel_c to find the relative difference between the - two states. - ./ - diff = vrel_c ( pos1, pos2 ); - - . - . - . - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - J.M. Lynch (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.0, 28-AUG-2001 (NJB) - - Include interface macro definition file SpiceZim.h. - - -CSPICE Version 1.0.1, 13-APR-2000 (NJB) - - Made some minor updates and corrections in the code example. - - -CSPICE Version 1.0.0, 6-JUL-1999 - --Index_Entries - - relative difference of 3-dimensional vectors - --& -*/ - -{ /* Begin vrel_c */ - - - /* - Local variables - */ - SpiceDouble nunorm; - SpiceDouble denorm; - - - /* If the vectors are both zero or equivalent, return 0. */ - - nunorm = vdist_c ( v1, v2 ); - - if ( nunorm == 0. ) - { - return 0.; - } - else - { - denorm = MaxVal( vnorm_c( v1 ), vnorm_c( v2 ) ); - return ( nunorm/denorm ); - } - - -} /* End vrel_c */ diff --git a/ext/spice/src/cspice/vrelg.c b/ext/spice/src/cspice/vrelg.c deleted file mode 100644 index 3a5c5edc22..0000000000 --- a/ext/spice/src/cspice/vrelg.c +++ /dev/null @@ -1,249 +0,0 @@ -/* vrelg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VRELG ( Vector relative difference, general dimension ) */ -doublereal vrelg_(doublereal *v1, doublereal *v2, integer *ndim) -{ - /* System generated locals */ - doublereal ret_val, d__1, d__2; - - /* Local variables */ - doublereal denorm; - extern doublereal vdistg_(doublereal *, doublereal *, integer *), vnormg_( - doublereal *, integer *); - doublereal nunorm; - -/* $ Abstract */ - -/* Return the relative difference between two vectors of general */ -/* dimension. */ - -/* $ 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 */ - -/* MATH */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* V1,V2 I Input vectors. */ -/* NDIM I Dimension of V1 and V2. */ - -/* $ Detailed_Input */ - -/* V1, V2 are two vectors for which the relative difference */ -/* is to be computed. */ - -/* NDIM is the dimension of V1 and V2. */ - -/* $ Detailed_Output */ - -/* VRELG is the relative difference between V1 and V2. */ -/* It is defined as: */ -/* || V1 - V2 || */ -/* VRELG = ---------------------- */ -/* MAX ( ||V1||, ||V2|| ) */ - -/* where || X || indicates the Euclidean norm of */ -/* the vector X. */ - -/* VRELG assumes values in the range [0,2]. If both */ -/* V1 and V2 are zero vectors then VRELG is defined */ -/* to be zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* If both V1 and V2 are zero vectors then VRELG is defined to be */ -/* zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function computes the relative difference between two vectors */ -/* of general dimension as defined above. */ - -/* The function VREL may be used to find the relative difference */ -/* for two 3-dimensional vectors. */ - -/* $ Examples */ - -/* This example determines if the state of Jupiter, with respect */ -/* to Voyager 2, for a set of times is the same for two different */ -/* ephemeris files. Instead of insisting on absolute equality */ -/* between the state vectors, the program will check if the relative */ -/* difference between the vectors is greater than a fixed tolerance. */ - -/* C */ -/* C The NAIF code for Jupiter is 599 and for Voyager 2 is -32. */ -/* C Set the tolerance to be 0.0005. */ -/* C */ -/* INTEGER JUP */ -/* PARAMETER ( JUP = 599 ) */ - -/* INTEGER VG2 */ -/* PARAMETER ( VG2 = -32 ) */ - -/* INTEGER NUM */ -/* PARAMETER ( NUM = 500 ) */ - -/* DOUBLE PRECISION TOL */ -/* PARAMETER ( TOL = 5.D-04 ) */ - -/* C */ -/* C Spicelib function */ -/* C */ -/* DOUBLE PRECISION VRELG */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION STATE1 ( 6, NUM ) */ -/* DOUBLE PRECISION STATE2 ( 6, NUM ) */ -/* DOUBLE PRECISION ET ( NUM ) */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION DIFF */ - -/* INTEGER HANDLE */ -/* INTEGER I */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Load the first SPK file. */ -/* C */ -/* CALL SPKLEF ( 'VG2_SOURCE_1.BSP', HANDLE ) */ -/* C */ -/* C Find the states for each time in the array ET. */ -/* C This example assumes that the SPK file can */ -/* C provide states for all of the times in the array. */ -/* C */ -/* DO I = 1, NUM */ - -/* CALL SPKEZ ( JUP, ET(I), 'J2000', 'LT', */ -/* . VG2, STATE1(1,I), LT ) */ - -/* END DO */ -/* C */ -/* C Unload the first file and load the second one. */ -/* C */ -/* CALL SPKUEF ( HANDLE ) */ - -/* CALL SPKLEF ( 'VG2_SOURCE_2.BSP', HANDLE ) */ -/* C */ -/* C Find the states from the new file. */ -/* C */ -/* DO I = 1, NUM */ - -/* CALL SPKEZ ( JUP, ET(I), 'J2000', 'LT', */ -/* . VG2, STATE2(1,I), LT ) */ - -/* END DO */ -/* C */ -/* C Now compare the two state vectors for each time. */ -/* C */ -/* DO I = 1, NUM */ - -/* DIFF = VRELG ( STATE1(1,I), STATE2(1,I), 6 ) */ - -/* IF ( DIFF .GT. TOL ) THEN */ - -/* . */ -/* . */ -/* . */ - -/* END IF */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.M. Lynch (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-JUN-1992 (JML) */ - -/* -& */ -/* $ Index_Entries */ - -/* relative difference of n-dimensional vectors */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* If the numerator is zero then set VRELG equal to zero. Otherwise, */ -/* perform the rest of the calculation. */ - -/* This handles the case where both vectors are zero vectors since */ -/* the distance between them will be zero. */ - - nunorm = vdistg_(v1, v2, ndim); - if (nunorm == 0.) { - ret_val = 0.; - } else { -/* Computing MAX */ - d__1 = vnormg_(v1, ndim), d__2 = vnormg_(v2, ndim); - denorm = max(d__1,d__2); - ret_val = nunorm / denorm; - } - return ret_val; -} /* vrelg_ */ - diff --git a/ext/spice/src/cspice/vrelg_c.c b/ext/spice/src/cspice/vrelg_c.c deleted file mode 100644 index e6b7912e50..0000000000 --- a/ext/spice/src/cspice/vrelg_c.c +++ /dev/null @@ -1,249 +0,0 @@ -/* - --Procedure vrelg_c ( Vector relative difference, general dimension ) - --Abstract - - Return the relative difference between two vectors of general - dimension. - --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 - - MATH - VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #include "SpiceZim.h" - #undef vrelg_c - - SpiceDouble vrelg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - v1,v2 I Input vectors. - ndim I Dimension of v1 and v2. - --Detailed_Input - - v1, v2 are two vectors for which the relative difference - is to be computed. - - ndim is the dimension of v1 and v2. - --Detailed_Output - - vrelg_c is the relative difference between v1 and v2. - It is defined as: - || v1 - v2 || - vrelg_c = ---------------------- - max ( ||v1||, ||v2|| ) - - where || x || indicates the euclidean norm of - the vector x ( ||x|| = sqrt( x . x ) ). - - vrelg_c assumes values in the range [0,2]. If both - v1 and v2 are zero vectors then vrelg_c is defined - to be zero. - --Parameters - - None. - --Exceptions - - Error free. - - If both v1 and v2 are zero vectors then vrelg_c is defined to be - zero. - --Files - - None. - --Particulars - - This function computes the relative difference between two vectors - of general dimension as defined above. - - The function vrel_c may be used to find the relative difference - for two 3-dimensional vectors. - --Examples - - This example determines if the state of Jupiter, with respect - to Voyager 2, for a set of times is the same for two different - ephemeris files. Instead of insisting on absolute equality - between the state vectors, the program will check if the relative - difference between the vectors is greater than a fixed tolerance. - - #include "SpiceUsr.h" - . - . - . - /. - The NAIF code for Jupiter is 599 and for Voyager 2 is -32. - Set the tolerance to be 0.0005. - ./ - - #define NUM 500 - #define JUP 599 - #define VG2 -32 - #define TOL .0005 - - /. - Local variables - ./ - SpiceDouble state1 [6][NUM]; - SpiceDouble state2 [6][NUM]; - SpiceDouble et [NUM]; - SpiceDouble lt; - SpiceDouble diff; - - SpiceInt i; - - . - . - . - - /. - Load the first SPK file. - ./ - furnsh_c ( "VG2_SOURCE_1.BSP" ); - - - /. - Find the states for each time in the array ET. - This example assumes that the SPK file can - provide states for all of the times in the array. - ./ - for ( i = 0; i < NUM; i++ ) - { - spkez_c ( JUP, et[i], "J2000", "lt", VG2, - state1[1][i], < ); - } - - - /. - Unload the first file and load the second one. - ./ - unload_c ( "VG2_SOURCE_1.BSP" ); - - furnsh_c ( "VG2_SOURCE_2.BSP" ); - - - /. - Find the states from the new file. - ./ - for ( i = 0; i < NUM; i++ ) - { - spkez_c ( JUP, et[i], "J2000", "lt", - VG2, state2[1][i], < ); - } - - - /. - Now compare the two state vectors for each time. - ./ - for ( i = 0; i < NUM; i++ ) - { - diff = vrelg_c ( state1[1][i], state2[1][i], 6 ); - - if ( diff > TOL ) - { - ... - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - J.M. Lynch (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.1.0, 28-AUG-2001 (NJB) - - Include interface macro definition file SpiceZim.h. - Made some minor updates and corrections in the code example. - - -CSPICE Version 1.0.0, 6-JUL-1999 - --Index_Entries - - relative difference of n-dimensional vectors - --& -*/ - -{ /* Begin vrelg_c */ - - /* - Local variables - */ - SpiceDouble nunorm; - SpiceDouble denorm; - - - - /* If the vectors are both zero or equivalent, return 0. */ - - nunorm = vdistg_c ( v1, v2, ndim ); - - if ( nunorm == 0. ) - { - return 0.; - } - else - { - denorm = MaxVal( vnormg_c( v1, ndim ), vnormg_c( v2, ndim ) ); - return ( nunorm/denorm ); - } - - -} /* End vrelg_c */ diff --git a/ext/spice/src/cspice/vrotv.c b/ext/spice/src/cspice/vrotv.c deleted file mode 100644 index 7cd540c35f..0000000000 --- a/ext/spice/src/cspice/vrotv.c +++ /dev/null @@ -1,246 +0,0 @@ -/* vrotv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure VROTV ( Vector rotation about an axis ) */ -/* Subroutine */ int vrotv_(doublereal *v, doublereal *axis, doublereal * - theta, doublereal *r__) -{ - /* Builtin functions */ - double cos(doublereal), sin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ), vhat_(doublereal *, doublereal *), vsub_(doublereal *, - doublereal *, doublereal *); - doublereal c__, p[3], s, x[3]; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), vproj_(doublereal *, doublereal *, doublereal *); - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal - *); - doublereal v1[3], v2[3], rplane[3]; - -/* $ Abstract */ - -/* Rotate a vector about a specified axis vector by a specified */ -/* angle and return the rotated vector. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* ROTATION, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V I Vector to be rotated. */ -/* AXIS I Axis of the rotation. */ -/* THETA I Angle of rotation (radians). */ -/* R O Result of rotating V about AXIS by THETA. */ - -/* $ Detailed_Input */ - -/* V is a 3-dimensional vector to be rotated. */ - -/* AXIS is the axis about which the rotation is to be */ -/* performed. */ - -/* THETA is the angle through which V is to be rotated about */ -/* AXIS. */ - -/* $ Detailed_Output */ - -/* R is the result of rotating V about AXIS by THETA. */ -/* If AXIS is the zero vector, R = V. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the input axis is the zero vector R will be returned */ -/* as V. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes the result of rotating (in a right handed */ -/* sense) the vector V about the axis represented by AXIS through */ -/* an angle of THETA radians. */ - -/* If W is a unit vector parallel to AXIS, then R is given by: */ - -/* R = V + ( 1 - cos(THETA) ) Wx(WxV) + sin(THETA) (WxV) */ - -/* where "x" above denotes the vector cross product. */ - -/* $ Examples */ - -/* If AXIS = ( 0, 0, 1 ) and THETA = PI/2 then the following results */ -/* for R will be obtained */ - -/* V R */ -/* ------------- ---------------- */ -/* ( 1, 2, 3 ) ( -2, 1, 3 ) */ -/* ( 1, 0, 0 ) ( 0, 1, 0 ) */ -/* ( 0, 1, 0 ) ( -1, 0, 0 ) */ - - -/* If AXIS = ( 0, 1, 0 ) and THETA = PI/2 then the following results */ -/* for R will be obtained */ - -/* V R */ -/* ------------- ---------------- */ -/* ( 1, 2, 3 ) ( 3, 2, -1 ) */ -/* ( 1, 0, 0 ) ( 0, 0, -1 ) */ -/* ( 0, 1, 0 ) ( 0, 1, 0 ) */ - - -/* If AXIS = ( 1, 1, 1 ) and THETA = PI/2 then the following results */ -/* for R will be obtained */ - -/* V R */ -/* ----------------------------- ----------------------------- */ -/* ( 1.0, 2.0, 3.0 ) ( 2.577.., 0.845.., 2.577.. ) */ -/* ( 2.577.., 0.845.., 2.577.. ) ( 3.0 2.0, 1.0 ) */ -/* ( 3.0 2.0, 1.0 ) ( 1.422.., 3.154.., 1.422.. ) */ -/* ( 1.422.., 3.154.., 1.422.. ) ( 1.0 2.0, 3.0 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 5-FEB-2003 (NJB) */ - -/* Header examples were corrected. Exceptions section */ -/* filled in. Miscellaneous header corrections were made. */ - -/* - 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 */ - -/* vector rotation about an axis */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Exceptions section was changed */ -/* to "error free" to reflect the decision that the */ -/* module will never participate in error handling. */ -/* Also, the declarations of the unused variable I and the */ -/* unused function VDOT were removed. */ -/* -& */ - - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Just in case the user tries to rotate about the zero vector - */ -/* check, and if so return the input vector */ - - if (vnorm_(axis) == 0.) { - moved_(v, &c__3, r__); - return 0; - } - -/* Compute the unit vector that lies in the direction of the */ -/* AXIS. Call it X. */ - - vhat_(axis, x); - -/* Compute the projection of V onto AXIS. Call it P. */ - - vproj_(v, x, p); - -/* Compute the component of V orthogonal to the AXIS. Call it V1. */ - - vsub_(v, p, v1); - -/* Rotate V1 by 90 degrees about the AXIS and call the result V2. */ - - vcrss_(x, v1, v2); - -/* Compute COS(THETA)*V1 + SIN(THETA)*V2. This is V1 rotated about */ -/* the AXIS in the plane normal to the axis, call the result RPLANE */ - - c__ = cos(*theta); - s = sin(*theta); - vlcom_(&c__, v1, &s, v2, rplane); - -/* Add the rotated component in the normal plane to AXIS to the */ -/* projection of V onto AXIS (P) to obtain R. */ - - vadd_(rplane, p, r__); - - return 0; -} /* vrotv_ */ - diff --git a/ext/spice/src/cspice/vrotv_c.c b/ext/spice/src/cspice/vrotv_c.c deleted file mode 100644 index c32373f925..0000000000 --- a/ext/spice/src/cspice/vrotv_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure vrotv_c ( Vector rotation about an axis ) - --Abstract - - Rotate a vector about a specified axis vector by a specified - angle and return the rotated vector. - --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 - - ROTATION - --Keywords - - ROTATION, VECTOR - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #undef vrotv_c - - - void vrotv_c ( ConstSpiceDouble v [3], - ConstSpiceDouble axis [3], - SpiceDouble theta, - SpiceDouble r [3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v I Vector to be rotated. - axis I Axis of the rotation. - theta I Angle of rotation (radians). - r O Result of rotating v about axis by theta. - --Detailed_Input - - v is a 3-dimensional vector to be rotated. - - axis is the axis about which the rotation is to be - performed. - - theta is the angle through which v is to be rotated about - axis. - --Detailed_Output - - r is the result of rotating v about axis by theta. - If axis is the zero vector, r = v. - --Parameters - - None. - --Exceptions - - Error free. - - 1) If the input axis is the zero vector r will be returned - as v. - --Files - - None. - --Particulars - - This routine computes the result of rotating (in a right handed - sense) the vector v about the axis represented by axis through - an angle of theta radians. - - If w is a unit vector parallel to axis, then r is given by: - - r = v + ( 1 - cos(theta) ) (w X(w X v)) + sin(theta) (w X v) - - where "X" above denotes the vector cross product. - --Examples - - - If axis = ( 0, 0, 1 ) and theta = pi/2 then the following results - for r will be obtained - - v r - ------------- ---------------- - ( 1, 2, 3 ) ( -2, 1, 3 ) - ( 1, 0, 0 ) ( 0, 1, 0 ) - ( 0, 1, 0 ) ( -1, 0, 0 ) - - - If axis = ( 0, 1, 0 ) and theta = pi/2 then the following results - for r will be obtained - - v r - ------------- ---------------- - ( 1, 2, 3 ) ( 3, 2, -1 ) - ( 1, 0, 0 ) ( 0, 0, -1 ) - ( 0, 1, 0 ) ( 0, 1, 0 ) - - - If axis = ( 1, 1, 1 ) and theta = pi/2 then the following results - for r will be obtained - - v r - ----------------------------- ----------------------------- - ( 1.0, 2.0, 3.0 ) ( 2.577.., 0.845.., 2.577.. ) - ( 2.577.., 0.845.., 2.577.. ) ( 3.0 2.0, 1.0 ) - ( 3.0 2.0, 1.0 ) ( 1.422.., 3.154.., 1.422.. ) - ( 1.422.., 3.154.., 1.422.. ) ( 1.0 2.0, 3.0 ) - - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.1, 05-FEB-2003 (NJB) - - Header examples were corrected. Exceptions section filled in. - Miscellaneous header corrections were made. - - -CSPICE Version 1.0.0, 22-OCT-1998 (NJB) - --Index_Entries - - vector rotation about an axis - --& -*/ - -{ /* Begin vrotv_c */ - - - vrotv_ ( ( doublereal * ) v, - ( doublereal * ) axis, - ( doublereal * ) &theta, - ( doublereal * ) r ); - - -} /* End vrotv_c */ - diff --git a/ext/spice/src/cspice/vscl.c b/ext/spice/src/cspice/vscl.c deleted file mode 100644 index 0ba1e7bbb5..0000000000 --- a/ext/spice/src/cspice/vscl.c +++ /dev/null @@ -1,137 +0,0 @@ -/* vscl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSCL ( Vector scaling, 3 dimensions ) */ -/* Subroutine */ int vscl_(doublereal *s, doublereal *v1, doublereal *vout) -{ -/* $ Abstract */ - -/* Multiply a scalar and a 3-dimensional double precision vector. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S I Scalar to multiply a vector. */ -/* V1 I Vector to be multiplied. */ -/* VOUT O Product vector, S*V1. */ - -/* $ Detailed_Input */ - -/* S This is a double precision scalar used to multiply the */ -/* vector V1. */ - -/* V1 This is a 3-dimensional, double precision vector which is */ -/* to be scaled by S. */ - -/* $ Detailed_Output */ - -/* VOUT This is a 3-dimensional, double precision vector which */ -/* is the scalar multiple of V1. VOUT = S*V1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* VSCL multiplies each component of V1 by S to form the respective */ -/* components of VOUT. No error checking is performed. */ - -/* $ Examples */ - -/* The following table shows the output VOUT as a function of the */ -/* the inputs V1, and S from the subroutine VSCL. */ - -/* V1 S VOUT */ -/* ---------------------------------------------- */ -/* (1D0, -2D0, 0D0) -1D0 (-1D0, 2D0, 0D0) */ -/* (0D0, 0D0, 0D0) 5D0 (0D0, 0D0, 0D0) */ - -/* $ Restrictions */ - -/* The user is responsible for insuring that no floating point */ -/* overflow occurs from multiplying S by any component of V1. No */ -/* error recovery or reporting scheme is incorporated in this */ -/* subroutine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* 3-dimensional vector scaling */ - -/* -& */ - vout[0] = *s * v1[0]; - vout[1] = *s * v1[1]; - vout[2] = *s * v1[2]; - return 0; -} /* vscl_ */ - diff --git a/ext/spice/src/cspice/vscl_c.c b/ext/spice/src/cspice/vscl_c.c deleted file mode 100644 index 23143b53a9..0000000000 --- a/ext/spice/src/cspice/vscl_c.c +++ /dev/null @@ -1,140 +0,0 @@ -/* - --Procedure vscl_c ( Vector scaling, 3 dimensions ) - --Abstract - - Multiply a scalar and a 3-dimensional double precision vector. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vscl_c - - - void vscl_c ( SpiceDouble s, - ConstSpiceDouble v1[3], - SpiceDouble vout[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s I Scalar to multiply a vector. - v1 I Vector to be multiplied. - vout O Product vector, s*v1. vout can overwrite v1. - --Detailed_Input - - s This is a double precision scalar used to multiply the - vector v1. - - v1 This is a 3-dimensional, double precision vector which is - to be scaled by s. - --Detailed_Output - - vout This is a 3-dimensional, double precision vector which - is the scalar multiple of v1. vout = s*v1. - --Parameters - - None. - --Particulars - - vscl_c multiplies each component of v1 by s to form the respective - components of vout. No error checking is performed. - --Examples - - The following table shows the output vout as a function of the - the inputs v1, and s from the subroutine vscl_c. - - v1 s vout - ------------------------------------------------------- - (1, -2, 0) -1 (-1, 2, 0) - (0, 0, 0) 5 ( 0, 0, 0) - --Restrictions - - The user is responsible for insuring that no floating point - overflow occurs from multiplying s by any component of v1. - No error recovery or reporting scheme is incorporated in this - subroutine. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - 3-dimensional vector scaling - --& -*/ - -{ /* Begin vscl_c */ - - vout[0] = s * v1[0]; - vout[1] = s * v1[1]; - vout[2] = s * v1[2]; - - -} /* End vscl_c */ diff --git a/ext/spice/src/cspice/vsclg.c b/ext/spice/src/cspice/vsclg.c deleted file mode 100644 index 42b947ec6c..0000000000 --- a/ext/spice/src/cspice/vsclg.c +++ /dev/null @@ -1,163 +0,0 @@ -/* vsclg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSCLG ( Vector scaling, general dimension ) */ -/* Subroutine */ int vsclg_(doublereal *s, doublereal *v1, integer *ndim, - doublereal *vout) -{ - /* System generated locals */ - integer v1_dim1, vout_dim1, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Multiply a scalar and a double precision vector of arbitrary */ -/* dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S I Scalar to multiply a vector. */ -/* V1 I Vector to be multiplied. */ -/* NDIM I Dimension of V1 (and also VOUT). */ -/* VOUT O Product vector, S*V1. */ - -/* $ Detailed_Input */ - -/* S is a double precision scalar. */ - -/* V1 is a double precision vector of arbitrary dimension. */ - -/* NDIM is the dimension of V1 (and VOUT). */ - -/* $ Detailed_Output */ - -/* VOUT is a double precision vector of arbitrary dimension */ -/* containing the product of the scalar with the vector V1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For each value of the index I from 1 to NDIM, this subroutine */ -/* performs the following multiplication */ - -/* VOUT(I) = S * V1(I) */ - -/* No error checking is performed to guard against numeric overflow */ -/* or underflow. */ - -/* $ Examples */ - -/* The following table shows the results of VSCLG from various */ -/* inputs. */ - -/* V1 S NDIM VOUT */ -/* ---------------------------------------------------------- */ -/* (1, 2, -3, 4) 3 4 ( 3, 6, -9, 12) */ -/* (1, 2, -3, 4) 0 4 ( 0, 0, 0, 0) */ -/* (1, 2, -3, 4) -1 4 (-3, -6, 9,-12) */ - -/* $ Restrictions */ - -/* No error checking is performed to guard against numeric overflow. */ -/* The programmer is thus required to insure that the values in V1 */ -/* and S are reasonable and will not cause overflow. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* n-dimensional vector scaling */ - -/* -& */ - /* Parameter adjustments */ - vout_dim1 = *ndim; - v1_dim1 = *ndim; - - /* Function Body */ - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "vsclg_", (ftnlen)145)] = *s * v1[(i__3 = i__ - 1) < - v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3, "vsclg_", ( - ftnlen)145)]; - } - return 0; -} /* vsclg_ */ - diff --git a/ext/spice/src/cspice/vsclg_c.c b/ext/spice/src/cspice/vsclg_c.c deleted file mode 100644 index 78aa34c646..0000000000 --- a/ext/spice/src/cspice/vsclg_c.c +++ /dev/null @@ -1,157 +0,0 @@ -/* - --Procedure vsclg_c ( Vector scaling, general dimension ) - --Abstract - - Multiply a scalar and a double precision vector of arbitrary - dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vsclg_c - - - void vsclg_c ( SpiceDouble s, - ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - s I Scalar to multiply a vector. - v1 I Vector to be multiplied. - ndim I Dimension of v1 (and also vout). - vout O Product vector, s*v1. vout can overwrite v1. - --Detailed_Input - - s is a double precision scalar. - - v1 is a double precision vector of arbitrary dimension. - - ndim is the dimension of v1 (and vout). - --Detailed_Output - - vout is a double precision vector of arbitrary dimension - containing the product of the scalar with the vector v1. - vout may overwrite v1. - --Parameters - - None. - --Exceptions - - Error free. - --Particulars - - For each value of the index i from 0 to ndim-1, this subroutine - performs the following multiplication - - vout[i] = s * v1[i]; - - No error checking is performed to guard against numeric overflow - or underflow. vout may overwrite v1. - --Examples - - The following table shows the results of vsclg_c from various - inputs. - - v1 s ndim vout - ----------------------------------------------------------------- - (1, 2, -3, 4) 3 4 ( 3, 6, -9, 12) - (1, 2, -3, 4) 0 4 ( 0, 0, 0, 0) - (1, 2, -3, 4) -1 4 (-3, -6, 9,-12) - --Restrictions - - No error checking is performed to guard against numeric overflow. - The programmer is thus required to insure that the values in v1 - and s are reasonable and will not cause overflow. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. Removed #includes of SpiceZfc.h and - SpiceZst.h. - - -CSPICE Version 1.0.0, 13-JUL-1998 (NJB) (WMO) - --Index_Entries - - n-dimensional vector scaling - --& -*/ - -{ /* Begin vsclg_c */ - - - /* - Local variables - */ - - SpiceInt i; - - - for ( i = 0; i < ndim; i++ ) - { - vout[i] = s * v1[i]; - } - - -} /* End vsclg_c */ diff --git a/ext/spice/src/cspice/vsclip.c b/ext/spice/src/cspice/vsclip.c deleted file mode 100644 index 6ddb7711c9..0000000000 --- a/ext/spice/src/cspice/vsclip.c +++ /dev/null @@ -1,139 +0,0 @@ -/* vsclip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSCLIP ( Vector scaling, 3 dimensions, in place ) */ -/* Subroutine */ int vsclip_(doublereal *s, doublereal *v) -{ -/* $ Abstract */ - -/* Multiply a scalar and a 3-dimensional double precision vector, */ -/* replacing the input vector with the result. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* S I Scalar by which to multiply a vector. */ -/* V I-O Vector to be multiplied/result of multiplication. */ - -/* $ Detailed_Input */ - -/* S This is a double precision scalar used to multiply the */ -/* vector V. */ - -/* V This is a 3-dimensional, double precision vector which is */ -/* to be scaled by S. */ - -/* $ Detailed_Output */ - -/* V This is a 3-dimensional, double precision vector resulting */ -/* from the scalar multiplication */ - -/* S * V */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is provided for situation where it is convenient to */ -/* scale a vector in place rather than store the result in a */ -/* separate variable. Note that the call */ - -/* CALL VSCL ( S, V, V ) */ - -/* is not permitted by the ANSI Fortran 77 standard; this routine */ -/* can be called instead to achieve the same result. */ - -/* VSCLIP multiplies each component of V by S to form the respective */ -/* components of the output vector. No error checking is performed. */ - -/* $ Examples */ - -/* The following table shows the output V as a function of the */ -/* the inputs V and S. */ - -/* V on input S V on output */ -/* ------------------------------------------------------- */ -/* (1D0, -2D0, 0D0) -1D0 (-1D0, 2D0, 0D0) */ -/* (0D0, 0D0, 0D0) 5D0 (0D0, 0D0, 0D0) */ - -/* $ Restrictions */ - -/* The user is responsible for insuring that no floating point */ -/* overflow occurs from multiplying S by any component of V. No */ -/* error recovery or reporting scheme is incorporated in this */ -/* subroutine. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.M. Owen (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-SEP-2005 (NJB) (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* 3-dimensional vector scaling in place */ - -/* -& */ - v[0] = *s * v[0]; - v[1] = *s * v[1]; - v[2] = *s * v[2]; - return 0; -} /* vsclip_ */ - diff --git a/ext/spice/src/cspice/vsep.c b/ext/spice/src/cspice/vsep.c deleted file mode 100644 index 867440ea7d..0000000000 --- a/ext/spice/src/cspice/vsep.c +++ /dev/null @@ -1,242 +0,0 @@ -/* vsep.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSEP ( Angular separation of vectors, 3 dimensions ) */ -doublereal vsep_(doublereal *v1, doublereal *v2) -{ - /* System generated locals */ - doublereal ret_val; - - /* Builtin functions */ - double asin(doublereal); - - /* Local variables */ - extern doublereal vdot_(doublereal *, doublereal *); - doublereal dmag1, dmag2, vtemp[3]; - extern /* Subroutine */ int unorm_(doublereal *, doublereal *, doublereal - *); - extern doublereal vnorm_(doublereal *); - doublereal u1[3], u2[3]; - extern doublereal pi_(void); - -/* $ Abstract */ - -/* Find the separation angle in radians between two double */ -/* precision, 3-dimensional vectors. This angle is defined as zero */ -/* if either vector is zero. */ - -/* $ 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 */ - -/* ANGLE, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector. */ -/* V2 I Second vector. */ - - -/* $ Detailed_Input */ - -/* V1 is an arbitrary double precision, 3-dimensional vector. */ -/* V2 is also an arbitrary double precision, 3-dimensional */ -/* vector. V1 or V2 or both may be the zero vector. */ - -/* $ Detailed_Output */ - -/* VSEP is the angle between V1 and V2 expressed in radians. */ -/* VSEP is strictly non-negative. If either V1 or V2 is */ -/* the zero vector, then VSEP is defined to be 0 radians. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* In the plane, it is a simple matter to calculate the angle */ -/* between two vectors once the two vectors have been made to be */ -/* unit length. Then, since the two vectors form the two equal */ -/* sides of an isosceles triangle, the length of the third side */ -/* is given by the expression */ - -/* LENGTH = 2.0 * SINE ( VSEP/2.0 ) */ - -/* The length is given by the magnitude of the difference of the */ -/* two unit vectors */ - -/* LENGTH = NORM ( U1 - U2 ) */ - -/* Once the length is found, the value of VSEP may be calculated */ -/* by inverting the first expression given above as */ - -/* VSEP = 2.0 * ARCSINE ( LENGTH/2.0 ) */ - -/* This expression becomes increasingly unstable when VSEP gets */ -/* larger than PI/2 or 90 degrees. In this situation (which is */ -/* easily detected by determining the sign of the dot product of */ -/* V1 and V2) the supplementary angle is calculated first and */ -/* then VSEP is given by */ - -/* VSEP = PI - SUPPLEMENTARY_ANGLE */ - -/* $ Examples */ - -/* The following table gives sample values for V1, V2 and VSEP */ -/* implied by the inputs. */ - -/* V1 V2 VSEP */ -/* ---------------------------------------------------------------- */ -/* (1, 0, 0) (1, 0, 0) 0.0D0 */ -/* (1, 0, 0) (0, 1, 0) PI/2 (=1.571...) */ - - -/* $ Restrictions */ - -/* The user is required to insure that the input vectors will not */ -/* cause floating point overflow upon calculation of the vector */ -/* dot product since no error detection or correction code is */ -/* implemented. In practice, this is not a significant */ -/* restriction. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 17-APR-2006 (EDW) */ - -/* Typo correction to the value of PI/2 in the Examples */ -/* section, 1.571 instead of 1.71. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation of 3-dimensional vectors */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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 (WMO) */ - -/* - Beta Version 1.0.1, 10-JAN-1989 (WLT) */ - -/* Error free specification added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - -/* The following declarations represent, respectively: */ -/* Magnitudes of V1, V2 */ -/* Either of the difference vectors: V1-V2 or V1-(-V2) */ -/* Unit vectors parallel to V1 and V2 */ - - -/* Calculate the magnitudes of V1 and V2; if either is 0, VSEP = 0 */ - - unorm_(v1, u1, &dmag1); - if (dmag1 == 0.) { - ret_val = 0.; - return ret_val; - } - unorm_(v2, u2, &dmag2); - if (dmag2 == 0.) { - ret_val = 0.; - return ret_val; - } - if (vdot_(u1, u2) > 0.) { - vtemp[0] = u1[0] - u2[0]; - vtemp[1] = u1[1] - u2[1]; - vtemp[2] = u1[2] - u2[2]; - ret_val = asin(vnorm_(vtemp) * .5) * 2.; - } else if (vdot_(u1, u2) < 0.) { - vtemp[0] = u1[0] + u2[0]; - vtemp[1] = u1[1] + u2[1]; - vtemp[2] = u1[2] + u2[2]; - ret_val = pi_() - asin(vnorm_(vtemp) * .5) * 2.; - } else { - ret_val = pi_() / 2.; - } - return ret_val; -} /* vsep_ */ - diff --git a/ext/spice/src/cspice/vsep_c.c b/ext/spice/src/cspice/vsep_c.c deleted file mode 100644 index 4b828fe8e1..0000000000 --- a/ext/spice/src/cspice/vsep_c.c +++ /dev/null @@ -1,231 +0,0 @@ -/* - --Procedure vsep_c ( Angular separation of vectors, 3 dimensions ) - --Abstract - - Find the separation angle in radians between two double - precision, 3-dimensional vectors. This angle is defined as zero - if either vector is zero. - --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 - - ANGLE, VECTOR - -*/ - - #include - #include "SpiceUsr.h" - #undef vsep_c - - - SpiceDouble vsep_c ( ConstSpiceDouble v1[3], ConstSpiceDouble v2[3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector. - v2 I Second vector. - - --Detailed_Input - - v1 is an arbitrary double precision, 3-dimensional vector. - v2 is also an arbitrary double precision, 3-dimensional - vector. v1 or v2 or both may be the zero vector. - --Detailed_Output - - vsep_c is the angle between v1 and v2 expressed in radians. - vsep_c is strictly non-negative. If either v1 or v2 is - the zero vector, then vsep_c is defined to be 0 radians. - --Parameters - - None. - --Particulars - - In the plane, it is a simple matter to calculate the angle - between two vectors once the two vectors have been made to be - unit length. Then, since the two vectors form the two equal - sides of an isosceles triangle, the length of the third side - is given by the expression - - length = 2.0 * sin ( vsep /2.0 ) - - The length is given by the magnitude of the difference of the - two unit vectors - - length = norm_c ( u1 - u2 ) - - Once the length is found, the value of vsep_c may be calculated - by inverting the first expression given above as - - vsep = 2.0 * arcsin ( length/2.0 ) - - This expression becomes increasingly unstable when vsep_c gets - larger than PI/2 or 90 degrees. In this situation (which is - easily detected by determining the sign of the dot product of - v1 and v2) the supplementary angle is calculated first and - then vsep_c is given by - - vsep = pi - supplementary_angle - --Examples - - The following table gives sample values for v1, v2 and vsep_c - implied by the inputs. - - v1 v2 vsep_c - ----------------------------------------------------------------- - (1, 0, 0) (1, 0, 0) 0.0 - (1, 0, 0) (0, 1, 0) PI/2 (=1.571...) - - --Restrictions - - The user is required to insure that the input vectors will not - cause floating point overflow upon calculation of the vector - dot product since no error detection or correction code is - implemented. In practice, this is not a significant - restriction. - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - K.R. Gehringer (JPL) - W.M. Owen (JPL) - W.L. Taber (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.1.1, 17-APR-2006 (EDW) - - Typo correction to the value of PI/2 in the Examples - section, 1.571 instead of 1.71. - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - angular separation of 3-dimensional vectors - --& -*/ - -{ /* Begin vsep_c */ - - - /* - Local variables - - The following declarations represent, respectively: - - Magnitudes of v1, v2 - Either of the difference vectors: v1-v2 or v1-(-v2) - Unit vectors parallel to v1 and v2 - */ - - SpiceDouble dmag1; - SpiceDouble dmag2; - SpiceDouble vtemp[3]; - SpiceDouble u1[3]; - SpiceDouble u2[3]; - SpiceDouble vsep; - - - /* - Calculate the magnitudes of v1 and v2; if either is 0, vsep = 0 - */ - - unorm_c ( v1, u1, &dmag1 ); - - if ( dmag1 == 0.0 ) - { - vsep = 0.0; - return vsep; - } - - unorm_c ( v2, u2, &dmag2 ); - - if ( dmag2 == 0.0 ) - { - vsep = 0.0; - return vsep; - } - - if ( vdot_c(u1,u2) > 0. ) - { - vtemp[0] = u1[0] - u2[0]; - vtemp[1] = u1[1] - u2[1]; - vtemp[2] = u1[2] - u2[2]; - - vsep = 2.00 * asin (0.50 * vnorm_c(vtemp)); - } - - else if ( vdot_c(u1,u2) < 0. ) - { - vtemp[0] = u1[0] + u2[0]; - vtemp[1] = u1[1] + u2[1]; - vtemp[2] = u1[2] + u2[2]; - - vsep = pi_c() - 2.00 * asin (0.50 * vnorm_c(vtemp)); - } - - else - { - vsep = halfpi_c(); - } - - - return vsep; - -} /* End vsep_c */ diff --git a/ext/spice/src/cspice/vsepg.c b/ext/spice/src/cspice/vsepg.c deleted file mode 100644 index 7ca5d80085..0000000000 --- a/ext/spice/src/cspice/vsepg.c +++ /dev/null @@ -1,268 +0,0 @@ -/* vsepg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSEPG ( Angular separation of vectors, general dimension ) */ -doublereal vsepg_(doublereal *v1, doublereal *v2, integer *ndim) -{ - /* System generated locals */ - integer i__1; - doublereal ret_val, d__1; - - /* Builtin functions */ - double sqrt(doublereal), asin(doublereal); - - /* Local variables */ - doublereal dmag1, dmag2; - integer i__; - extern doublereal vdotg_(doublereal *, doublereal *, integer *); - doublereal r1, r2, magdif; - extern doublereal pi_(void), vnormg_(doublereal *, integer *); - -/* $ Abstract */ - -/* VSEPG finds the separation angle in radians between two double */ -/* precision vectors of arbitrary dimension. This angle is defined */ -/* as zero if either vector is zero. */ - -/* $ 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 */ - -/* ANGLE, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector. */ -/* V2 I Second vector. */ -/* NDIM I The number of elements in V1 and V2. */ - -/* $ Detailed_Input */ - -/* V1 is any double precision vector of arbitrary dimension. */ -/* V2 is also a double precision vector of arbitrary dimension. */ -/* V1 or V2 or both may be the zero vector. */ -/* NDIM is the dimension of the both of the input vectors */ -/* V1 and V2. */ - -/* $ Detailed_Output */ - -/* VSEPG is the angle between V1 and V2 expressed in radians. */ -/* VSEPG is strictly non-negative. For input vectors of */ -/* four or more dimensions, the angle is defined as the */ -/* generalization of the definition for three dimensions. */ -/* If either V1 or V2 is the zero vector, then VSEPG is */ -/* defined to be 0 radians. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* In four or more dimensions this angle does not have a physically */ -/* realizable interpretation. However, the angle is defined as */ -/* the generalization of the following definition which is valid in */ -/* three or two dimensions: */ - -/* In the plane, it is a simple matter to calculate the angle */ -/* between two vectors once the two vectors have been made to be */ -/* unit length. Then, since the two vectors form the two equal */ -/* sides of an isosceles triangle, the length of the third side */ -/* is given by the expression */ - -/* LENGTH = 2.0 * SINE ( VSEPG/2.0 ) */ - -/* The length is given by the magnitude of the difference of the */ -/* two unit vectors */ - -/* LENGTH = NORM ( U1 - U2 ) */ - -/* Once the length is found, the value of VSEPG may be calculated */ -/* by inverting the first expression given above as */ - -/* VSEPG = 2.0 * ARCSINE ( LENGTH/2.0 ) */ - -/* This expression becomes increasingly unstable when VSEPG gets */ -/* larger than PI/2 or 90 degrees. In this situation (which is */ -/* easily detected by determining the sign of the dot product of */ -/* V1 and V2) the supplementary angle is calculated first and */ -/* then VSEPG is given by */ - -/* VSEPG = PI - SUPPLEMENTARY_ANGLE */ - -/* $ Examples */ - -/* The following table gives sample values for V1, V2 and VSEPG */ -/* implied by the inputs. */ - -/* V1 V2 NDIM VSEPG */ -/* ----------------------------------------------------------------- */ -/* (1, 0, 0, 0) (1, 0, 0, 0) 4 0.0D0 */ -/* (1, 0, 0) (0, 1, 0) 3 PI/2 (=1.71...) */ -/* (3, 0) (-5, 0) 2 PI (=3.14...) */ - -/* $ Restrictions */ - -/* The user is required to insure that the input vectors will not */ -/* cause floating point overflow upon calculation of the vector */ -/* dot product since no error detection or correction code is */ -/* implemented. In practice, this is not a significant */ -/* restriction. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None */ - -/* $ Author_and_Institution */ - -/* C.A. Curzon (JPL) */ -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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 (CAC) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation of n-dimensional vectors */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* The declaration for the SPICELIB function PI is now */ -/* preceded by an EXTERNAL statement declaring PI to be an */ -/* external function. This removes a conflict with any */ -/* compilers that have a PI intrinsic function. */ - -/* - 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 (CAC) */ - -/* - Beta Version 1.1.0, 02-MAR-1989 (HAN) */ - -/* The variable MAGDIFF was changed to MAGDIF in order to */ -/* comply with the ANSI Fortran Standard six character */ -/* variable name length restriction. */ - -/* - Beta Version 1.0.1, 10-JAN-1989 (WLT) */ - -/* Error free specification added. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - -/* The following declarations represent, respectively: */ -/* Magnitudes of V1, V2 */ -/* Reciprocals of the magnitudes of V1, V2 */ -/* Magnitude of either of the difference vectors: V1-V2 or */ -/* V1-(-V2) */ - - -/* Calculate the magnitudes of V1 and V2; if either is 0, VSEPG = 0 */ - - dmag1 = vnormg_(v1, ndim); - if (dmag1 == 0.) { - ret_val = 0.; - return ret_val; - } - dmag2 = vnormg_(v2, ndim); - if (dmag2 == 0.) { - ret_val = 0.; - return ret_val; - } - if (vdotg_(v1, v2, ndim) > 0.) { - r1 = 1. / dmag1; - r2 = 1. / dmag2; - magdif = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing 2nd power */ - d__1 = v1[i__ - 1] * r1 - v2[i__ - 1] * r2; - magdif += d__1 * d__1; - } - magdif = sqrt(magdif); - ret_val = asin(magdif * .5) * 2.; - } else if (vdotg_(v1, v2, ndim) < 0.) { - r1 = 1. / dmag1; - r2 = 1. / dmag2; - magdif = 0.; - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing 2nd power */ - d__1 = v1[i__ - 1] * r1 + v2[i__ - 1] * r2; - magdif += d__1 * d__1; - } - magdif = sqrt(magdif); - ret_val = pi_() - asin(magdif * .5) * 2.; - } else { - ret_val = pi_() / 2.; - } - return ret_val; -} /* vsepg_ */ - diff --git a/ext/spice/src/cspice/vsepg_c.c b/ext/spice/src/cspice/vsepg_c.c deleted file mode 100644 index 202ee7b4a7..0000000000 --- a/ext/spice/src/cspice/vsepg_c.c +++ /dev/null @@ -1,230 +0,0 @@ -/* - --Procedure vsepg_c ( Angular separation of vectors, general dimension ) - --Abstract - - vsepg_c finds the separation angle in radians between two double - precision vectors of arbitrary dimension. This angle is defined - as zero if either vector is zero. - --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 - - ANGLE - VECTOR - -*/ - - #include - #include "SpiceUsr.h" - #undef vsepg_c - - SpiceDouble vsepg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector. - v2 I Second vector. - ndim I The number of elements in v1 and v2. - --Detailed_Input - - v1 is any double precision vector of arbitrary dimension. - v2 is also a double precision vector of arbitrary dimension. - v1 or v2 or both may be the zero vector. - ndim is the dimension of the both of the input vectors - v1 and v2. - --Detailed_Output - - vsepg_c the angle between v1 and v2 expressed in radians. - vsepg_c is strictly non-negative. For input vectors of - four or more dimensions, the angle is defined as the - generalization of the definition for three dimensions. - If either v1 or v2 is the zero vector, then vsepg_c is - defined to be 0 radians. - --Parameters - - None. - --Particulars - - In four or more dimensions this angle does not have a physically - realizable interpretation. However, the angle is defined as - the generalization of the following definition which is valid in - three or two dimensions: - - In the plane, it is a simple matter to calculate the angle - between two vectors once the two vectors have been made to be - unit length. Then, since the two vectors form the two equal - sides of an isosceles triangle, the length of the third side - is given by the expression - - length = 2.0 * sine ( vsepg/2.0 ) - - The length is given by the magnitude of the difference of the - two unit vectors - - length = norm ( u1 - u2 ) - - Once the length is found, the value of vsepg_c may be calculated - by inverting the first expression given above as - - vsepg_c = 2.0 * arcsine ( length/2.0 ) - - This expression becomes increasingly unstable when vsepg_c gets - larger than pi/2 or 90 degrees. In this situation (which is - easily detected by determining the sign of the dot product of - v1 and v2) the supplementary angle is calculated first and - then vsepg_c is given by - - vsepg_c = pi - SUPPLEMENTARY_ANGLE - --Examples - - The following table gives sample values for v1, v2 and vsepg_c - implied by the inputs. - - v1 v2 ndim vsepg_c - ----------------------------------------------------------------- - (1, 0, 0, 0) (1, 0, 0, 0) 4 0.0 - (1, 0, 0) (0, 1, 0) 3 pi/2 (=1.71...) - (3, 0) (-5, 0) 2 pi (=3.14...) - --Restrictions - - The user is required to insure that the input vectors will not - cause floating point overflow upon calculation of the vector - dot product since no error detection or correction code is - implemented. In practice, this is not a significant - restriction. - --Exceptions - - Error free. - --Files - - None - --Author_and_Institution - - C.A. Curzon (JPL) - K.R. Gehringer (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - E.D. Wright (JPL) - --Literature_References - - None - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 - --Index_Entries - - angular separation of n-dimensional vectors - --& -*/ - -{ /* Begin vsepg_c */ - - - /* - Local variables - */ - SpiceDouble mag1; - SpiceDouble mag2; - SpiceDouble mag_dif; - SpiceDouble r1; - SpiceDouble r2; - SpiceInt i; - - mag1 = vnormg_c( v1, ndim); - mag2 = vnormg_c( v2, ndim); - - - /* - If either v1 or v2 have magnitude zero, the separation is 0. - */ - if ( ( mag1 == 0.) || ( mag2 == 0.) ) - { - return 0; - } - - if ( vdotg_c( v1, v2, ndim ) < 0. ) - { - r1 = 1./mag1; - r2 = 1./mag2; - mag_dif = 0.; - - for ( i = 0; i < ndim; i++ ) - { - mag_dif += pow( ( v1[i]*r1 - v2[i]*r2 ), 2); - } - - mag_dif = sqrt(mag_dif); - - return ( 2. * asin (0.5 * mag_dif) ); - - } - else if ( vdotg_c (v1, v2, ndim) > 0. ) - { - r1 = 1./mag1; - r2 = 1./mag2; - mag_dif = 0.; - - for ( i = 0; i < ndim; i++ ) - { - mag_dif += pow( ( v1[i]*r1 + v2[i]*r2 ), 2); - } - - mag_dif = sqrt(mag_dif); - - return ( pi_c() - 2. * asin (0.5 * mag_dif) ); - } - - return ( halfpi_c()); - - - -} /* End vsepg_c */ diff --git a/ext/spice/src/cspice/vsub.c b/ext/spice/src/cspice/vsub.c deleted file mode 100644 index cd47b2728e..0000000000 --- a/ext/spice/src/cspice/vsub.c +++ /dev/null @@ -1,143 +0,0 @@ -/* vsub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSUB ( Vector subtraction, 3 dimensions ) */ -/* Subroutine */ int vsub_(doublereal *v1, doublereal *v2, doublereal *vout) -{ -/* $ Abstract */ - -/* Compute the difference between two 3-dimensional, double */ -/* precision vectors. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector (minuend). */ -/* V2 I Second vector (subtrahend). */ -/* VOUT O Difference vector, V1 - V2. */ - -/* $ Detailed_Input */ - -/* V1 This can be any 3-dimensional, double precision vector. */ - -/* V2 Ditto. */ - -/* $ Detailed_Output */ - -/* VOUT This is a 3-dimensional, double precision vector which */ -/* represents the vector difference, V1 - V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simply performs subtraction between components of V1 */ -/* and V2. No checking is performed to determine whether floating */ -/* point overflow has occurred. */ - -/* $ Examples */ - -/* The following table shows the output VOUT as a function of the */ -/* the input V1 and V2 from the subroutine VSUB. */ - -/* V1 V2 ---> VOUT */ -/* -------------- -------------- -------------- */ -/* ( 1.0, 2.0, 3.0) ( 4.0, 5.0, 6.0) (-3.0, -3.0, -3.0) */ -/* (1D-7, 1D23,0.0) (1D24, 1D23, 0.0) (-1D24, 0.0, 0.0) */ - -/* $ Restrictions */ - -/* The user is required to determine that the magnitude each */ -/* component of the vectors is within the appropriate range so as */ -/* not to cause floating point overflow. No error recovery or */ -/* reporting scheme is incorporated in this subroutine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.0.2, 07-NOV-2003 (EDW) */ - -/* Corrected a mistake in the second example's value */ -/* for VOUT, i.e. replaced (1D24, 2D23, 0.0) with */ -/* (-1D24, 0.0, 0.0). */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* 3-dimensional vector subtraction */ - -/* -& */ - vout[0] = v1[0] - v2[0]; - vout[1] = v1[1] - v2[1]; - vout[2] = v1[2] - v2[2]; - return 0; -} /* vsub_ */ - diff --git a/ext/spice/src/cspice/vsub_c.c b/ext/spice/src/cspice/vsub_c.c deleted file mode 100644 index 8920b12f97..0000000000 --- a/ext/spice/src/cspice/vsub_c.c +++ /dev/null @@ -1,147 +0,0 @@ -/* - --Procedure vsub_c ( Vector subtraction, 3 dimensions ) - --Abstract - - Compute the difference between two 3-dimensional, double - precision vectors. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vsub_c - - - void vsub_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector (minuend). - v2 I Second vector (subtrahend). - vout O Difference vector, v1 - v2. vout can overwrite - either v1 or v2. - --Detailed_Input - - v1 This can be any 3-dimensional, double precision vector. - - v2 Ditto. - --Detailed_Output - - vout This is a 3-dimensional, double precision vector which - represents the vector difference, v1 - v2. - --Parameters - - None. - --Particulars - - This routine simply performs subtraction between components of v1 - and v2. No checking is performed to determine whether floating - point overflow has occurred. - --Examples - - The following table shows the output vout as a function of the - the input v1 and v2 from the subroutine vsub_c. - - v1 v2 ---> vout - -------------- -------------- -------------- - [1.0 , 2.0, 3.0] [4.0 , 5.0 , 6.0] [-3.0 , -3.0, -3.0] - [1e-7,1e23, 0.0] [1e24, 1e23, 0.0] [-1e24, 0.0, 0.0] - --Restrictions - - The user is required to determine that the magnitude each - component of the vectors is within the appropriate range so as - not to cause floating point overflow. No error recovery or - reporting scheme is incorporated in this subroutine. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.1, 07-NOV-2003 (EDW) - - Corrected a mistake in the second example's value - for VOUT, i.e. replaced [1D24, 2D23, 0.0] with - [-1e24, 0.0, 0.0]. - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - 3-dimensional vector subtraction - --& -*/ - -{ /* Begin vsub_c */ - - - vout[0] = v1[0] - v2[0]; - vout[1] = v1[1] - v2[1]; - vout[2] = v1[2] - v2[2]; - - -} /* End vsub_c */ diff --git a/ext/spice/src/cspice/vsubg.c b/ext/spice/src/cspice/vsubg.c deleted file mode 100644 index 7bbb12f636..0000000000 --- a/ext/spice/src/cspice/vsubg.c +++ /dev/null @@ -1,173 +0,0 @@ -/* vsubg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VSUBG ( Vector subtraction, general dimension ) */ -/* Subroutine */ int vsubg_(doublereal *v1, doublereal *v2, integer *ndim, - doublereal *vout) -{ - /* System generated locals */ - integer v1_dim1, v2_dim1, vout_dim1, i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Compute the difference between two double precision vectors of */ -/* arbitrary dimension. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I First vector (minuend). */ -/* V2 I Second vector (subtrahend). */ -/* NDIM I Dimension of V1, V2, and VOUT. */ -/* VOUT O Difference vector, V1 - V2. */ - -/* $ Detailed_Input */ - -/* V1 is a double precision vector of arbitrary dimension which */ -/* is the minuend (i.e. first or left-hand member) in the */ -/* vector subtraction. */ - -/* V2 is a double precision vector of arbitrary dimension which */ -/* is the subtrahend (i.e. second or right-hand member) in */ -/* the vector subtraction. */ - -/* NDIM is the dimension of V1 and V2 (and VOUT). */ - -/* $ Detailed_Output */ - -/* VOUT is a double precision vector containing the difference */ -/* V1 - V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For each value of the index I from 1 to NDIM, this subroutine */ -/* performs the following subtraction: */ - -/* VOUT(I) = V1(I) - V2(I) */ - -/* No error checking is performed to guard against numeric overflow */ -/* or underflow. */ - -/* $ Examples */ - -/* The following table shows the results of VSUBG from various */ -/* inputs. */ - -/* V1 V2 NDIM VOUT */ -/* ----------------------------------------------------------- */ -/* (1, 2, 3, 4) ( 1, 1, 1, 1 ) 4 ( 0, 1, 2, 3 ) */ -/* (1, 2, 3, 4) (-1,-2,-3,-4 ) 4 ( 2, 4, 6, 8 ) */ -/* (1, 2, 3, 4) (-1, 2,-3, 4 ) 4 ( 2, 0, 6, 0 ) */ - -/* $ Restrictions */ - -/* No error checking is performed to guard against numeric overflow. */ -/* The programmer is thus required to insure that the values in V1 */ -/* and V2 are reasonable and will not cause overflow. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.0.1, 9-MAY-1990 (HAN) */ - -/* Several errors in the header documentation were corrected. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* n-dimensional vector subtraction */ - -/* -& */ - /* Parameter adjustments */ - vout_dim1 = *ndim; - v2_dim1 = *ndim; - v1_dim1 = *ndim; - - /* Function Body */ - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge("vout", - i__2, "vsubg_", (ftnlen)152)] = v1[(i__3 = i__ - 1) < - v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3, "vsubg_", ( - ftnlen)152)] - v2[(i__4 = i__ - 1) < v2_dim1 && 0 <= i__4 ? - i__4 : s_rnge("v2", i__4, "vsubg_", (ftnlen)152)]; - } - return 0; -} /* vsubg_ */ - diff --git a/ext/spice/src/cspice/vsubg_c.c b/ext/spice/src/cspice/vsubg_c.c deleted file mode 100644 index 2fdd2e133d..0000000000 --- a/ext/spice/src/cspice/vsubg_c.c +++ /dev/null @@ -1,165 +0,0 @@ -/* - --Procedure vsubg_c ( Vector subtraction, general dimension ) - --Abstract - - Compute the difference between two double precision vectors of - arbitrary dimension. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vsubg_c - - - void vsubg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I First vector (minuend). - v2 I Second vector (subtrahend). - ndim I Dimension of v1, v2, and vout. - vout O Difference vector, v1 - v2. - vout can overwrite either v1 or v2. - --Detailed_Input - - v1 is a double precision vector of arbitrary dimension which - is the minuend (i.e. first or left-hand member) in the - vector subtraction. - - v2 is a double precision vector of arbitrary dimension which - is the subtrahend (i.e. second or right-hand member) in - the vector subtraction. - - ndim is the dimension of v1 and v2 (and vout). - --Detailed_Output - - vout is a double precision vector containing the difference - v1 - v2. - --Parameters - - None. - --Particulars - - For each value of the index i from 0 to (ndim - 1), this subroutine - performs the following subtraction: - - vout(i) = v1(i) - v2(i) - - No error checking is performed to guard against numeric overflow - or underflow. vout may overwrite v1 or v2. - --Examples - - The following table shows the results of vsubg_c from various - inputs. - - v1 v2 ndim vout - ----------------------------------------------------------------- - (1, 2, 3, 4) ( 1, 1, 1, 1 ) 4 ( 0, 1, 2, 3 ) - (1, 2, 3, 4) (-1,-2,-3,-4 ) 4 ( 2, 4, 6, 8 ) - (1, 2, 3, 4) (-1, 2,-3, 4 ) 4 ( 2, 0, 6, 0 ) - --Restrictions - - No error checking is performed to guard against numeric overflow. - The programmer is thus required to insure that the values in v1 - and v2 are reasonable and will not cause overflow. - - It is assumed the proper amount of memory has been allocated for - v1, v2 and vout. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vectors const. - - -CSPICE Version 1.0.0, 05-MAR-1998 (EDW) - --Index_Entries - - n-dimensional vector subtraction - --& -*/ - -{ /* Begin vsubg_c */ - - /* - Local variables - */ - - SpiceInt i; - - - /* Do the calculation. Not very involved. */ - - for ( i = 0; i < ndim; i++ ) - { - vout[i] = v1[i] - v2[i]; - } - - -} /* End vsubg_c */ diff --git a/ext/spice/src/cspice/vtmv.c b/ext/spice/src/cspice/vtmv.c deleted file mode 100644 index c367d614b1..0000000000 --- a/ext/spice/src/cspice/vtmv.c +++ /dev/null @@ -1,172 +0,0 @@ -/* vtmv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VTMV ( Vector transpose times matrix times vector, 3 dim ) */ -doublereal vtmv_(doublereal *v1, doublereal *matrix, doublereal *v2) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer k, l; - -/* $ Abstract */ - -/* Multiply the transpose of a 3-dimensional column vector, */ -/* a 3x3 matrix, and a 3-dimensional column vector. */ - -/* $ 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 */ - -/* MATRIX, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I 3 dimensional double precision column vector. */ -/* MATRIX I 3x3 double precision matrix. */ -/* V2 I 3 dimensional double precision column vector. */ - -/* The function returns the result of (V1**T * MATRIX * V2 ). */ - -/* $ Detailed_Input */ - -/* V1 This may be any 3-dimensional, double precision */ -/* column vector. */ - -/* MATRIX This may be any 3x3, double precision matrix. */ - -/* V2 This may be any 3-dimensional, double precision */ -/* column vector. */ - -/* $ Detailed_Output */ - -/* The function returns the double precision value of the equation */ -/* (V1**T * MATRIX * V2 ). */ - -/* Notice that VTMV is actually the dot product of the vector */ -/* resulting from multiplying the transpose of V1 and MATRIX and the */ -/* vector V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine implements the following vector/matrix/vector */ -/* multiplication: */ - -/* T */ -/* VTMV = | V1 | | | | | */ -/* | MATRIX | |V2| */ -/* | | | | */ - -/* V1 is a column vector which becomes a row vector when transposed. */ -/* V2 is a column vector. */ - -/* No checking is performed to determine whether floating point */ -/* overflow has occurred. */ - -/* $ Examples */ - -/* If V1 = | 2.0D0 | MATRIX = | 0.0D0 1.0D0 0.0D0 | */ -/* | | | | */ -/* | 4.0D0 | | -1.0D0 0.0D0 0.0D0 | */ -/* | | | | */ -/* | 6.0D0 | | 0.0D0 0.0D0 1.0D0 | */ - -/* V2 = | 1.0D0 | */ -/* | | */ -/* | 1.0D0 | */ -/* | | */ -/* | 1.0D0 | */ - -/* then function value is equal to 4.0D0. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* 3-dimensional vector_transpose times matrix times vector */ - -/* -& */ - ret_val = 0.; - for (k = 1; k <= 3; ++k) { - for (l = 1; l <= 3; ++l) { - ret_val += v1[(i__1 = k - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "v1", i__1, "vtmv_", (ftnlen)156)] * matrix[(i__2 = k + l - * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("matrix", i__2, - "vtmv_", (ftnlen)156)] * v2[(i__3 = l - 1) < 3 && 0 <= - i__3 ? i__3 : s_rnge("v2", i__3, "vtmv_", (ftnlen)156)]; - } - } - return ret_val; -} /* vtmv_ */ - diff --git a/ext/spice/src/cspice/vtmv_c.c b/ext/spice/src/cspice/vtmv_c.c deleted file mode 100644 index a8ee325557..0000000000 --- a/ext/spice/src/cspice/vtmv_c.c +++ /dev/null @@ -1,171 +0,0 @@ -/* - --Procedure vtmv_c ( Vector transpose times matrix times vector, 3 dim ) - --Abstract - - Multiply the transpose of a 3-dimensional column vector, - a 3x3 matrix, and a 3-dimensional column vector. - --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 - - MATRIX, VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vtmv_c - - SpiceDouble vtmv_c ( ConstSpiceDouble v1 [3], - ConstSpiceDouble matrix [3][3], - ConstSpiceDouble v2 [3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I 3 dimensional double precision column vector. - matrix I 3x3 double precision matrix. - v2 I 3 dimensional double precision column vector. - - The function returns the result of (v1**t * matrix * v2 ). - --Detailed_Input - - v1 This may be any 3-dimensional, double precision - column vector. - - matrix This may be any 3x3, double precision matrix. - - v2 This may be any 3-dimensional, double precision - column vector. - --Detailed_Output - - the function returns the double precision value of the equation - (v1**t * matrix * v2 ). - - Notice that vtmv_c is actually the dot product of the vector - resulting from multiplying the transpose of v1 and matrix and the - vector v2. - --Parameters - - None. - --Particulars - - This routine implements the following vector/matrix/vector - multiplication: - - T - vtmv_c = | v1 | | | | | - | matrix | |v2| - | | | | - - v1 is a column vector which becomes a row vector when transposed. - v2 is a column vector. - - No checking is performed to determine whether floating point - overflow has occurred. - --Examples - - if v1 = | 2.0 | matrix = | 0.0 1.0 0.0 | - | | | | - | 4.0 | | -1.0 0.0 0.0 | - | | | | - | 6.0 | | 0.0 0.0 1.0 | - - v2 = | 1.0 | - | | - | 1.0 | - | | - | 1.0 | - - then function value is equal to 4.0. - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 1-JUL-1999 - --Index_Entries - - 3-dimensional vector_transpose times matrix times vector - --& -*/ - -{ /* Begin vtmv_c */ - - - /* - Local variables - */ - SpiceInt k; - SpiceInt l; - SpiceDouble val = 0.; - - for ( k = 0; k < 3; k++ ) - { - for ( l = 0; l < 3; l++ ) - { - val += v1[k] * matrix[k][l] * v2[l]; - } - } - - return val; - -} /* End vtmv_c */ diff --git a/ext/spice/src/cspice/vtmvg.c b/ext/spice/src/cspice/vtmvg.c deleted file mode 100644 index c59dc56090..0000000000 --- a/ext/spice/src/cspice/vtmvg.c +++ /dev/null @@ -1,200 +0,0 @@ -/* vtmvg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VTMVG ( Vector transpose times matrix times vector ) */ -doublereal vtmvg_(doublereal *v1, doublereal *matrix, doublereal *v2, integer - *nrow, integer *ncol) -{ - /* System generated locals */ - integer v1_dim1, matrix_dim1, matrix_dim2, matrix_offset, v2_dim1, i__1, - i__2, i__3, i__4, i__5; - doublereal ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer k, l; - -/* $ Abstract */ - -/* Multiply the transpose of a n-dimensional column vector, */ -/* a nxm matrix, and a m-dimensional column vector. */ - -/* $ 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 */ - -/* MATRIX, VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V1 I N-dimensional double precision column vector. */ -/* MATRIX I NxM double precision matrix. */ -/* V2 I M-dimensional double porecision column vector. */ -/* NROW I Number of rows in MATRIX (number of rows in V1.) */ -/* NCOL I Number of columns in MATRIX (number of rows in */ -/* V2.) */ - -/* The function returns the result of (V1**T * MATRIX * V2 ). */ - -/* $ Detailed_Input */ - -/* V1 is an n-dimensional double precision vector. */ - -/* MATRIX is an n x m double precision matrix. */ - -/* V2 is an m-dimensional double precision vector. */ - -/* NROW is the number of rows in MATRIX. This is also */ -/* equivalent to the number of rows in the vector V1. */ - -/* NCOL is the number of columns in MATRIX. This is also */ -/* equivalent to the number of rows in the vector V2. */ - -/* $ Detailed_Output */ - -/* The function returns the double precision value of the equation */ -/* (V1**T * MATRIX * V2 ). */ - -/* Notice that VTMVG is actually the dot product of the vector */ -/* resulting from multiplying the transpose of V1 and MATRIX and the */ -/* vector V2. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine implements the following vector/matrix/vector */ -/* multiplication: */ - -/* T */ -/* VTMVG = [ V1 ] | | | | */ -/* | MATRIX | |V2| */ -/* | | | | */ - -/* by calculating over all values of the indices K and L from 1 to */ -/* NROW and 1 to NCOL, respectively, the expression */ - -/* VTMVG = Summation of ( V1(K)*MATRIX(K,L)*V2(L) ) . */ - -/* V1 is a column vector which becomes a row vector when transposed. */ -/* V2 is a column vector. */ - -/* No checking is performed to determine whether floating point */ -/* overflow has occurred. */ - -/* $ Examples */ - -/* If V1 = | 1.0D0 | MATRIX = | 2.0D0 0.0D0 | V2 = | 1.0D0 | */ -/* | | | | | | */ -/* | 2.0D0 | | 1.0D0 2.0D0 | | 2.0D0 | */ -/* | | | | */ -/* | 3.0D0 | | 1.0D0 1.0D0 | */ - -/* NROW = 3 */ -/* NCOL = 2 */ - -/* then the value of the function is 21.0D0. */ - -/* $ Restrictions */ - -/* Since no error detection or recovery is implemented, the */ -/* programmer is required to insure that the inputs to this routine */ -/* are both valid and within the proper range. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* n-dimensional vector_transpose times matrix times vector */ - -/* -& */ - -/* Perform the multiplication */ - - /* Parameter adjustments */ - v1_dim1 = *nrow; - v2_dim1 = *ncol; - matrix_dim1 = *nrow; - matrix_dim2 = *ncol; - matrix_offset = matrix_dim1 + 1; - - /* Function Body */ - ret_val = 0.; - i__1 = *nrow; - for (k = 1; k <= i__1; ++k) { - i__2 = *ncol; - for (l = 1; l <= i__2; ++l) { - ret_val += v1[(i__3 = k - 1) < v1_dim1 && 0 <= i__3 ? i__3 : - s_rnge("v1", i__3, "vtmvg_", (ftnlen)171)] * matrix[(i__4 - = k + l * matrix_dim1 - matrix_offset) < matrix_dim1 * - matrix_dim2 && 0 <= i__4 ? i__4 : s_rnge("matrix", i__4, - "vtmvg_", (ftnlen)171)] * v2[(i__5 = l - 1) < v2_dim1 && - 0 <= i__5 ? i__5 : s_rnge("v2", i__5, "vtmvg_", (ftnlen) - 171)]; - } - } - return ret_val; -} /* vtmvg_ */ - diff --git a/ext/spice/src/cspice/vtmvg_c.c b/ext/spice/src/cspice/vtmvg_c.c deleted file mode 100644 index 7029b5938d..0000000000 --- a/ext/spice/src/cspice/vtmvg_c.c +++ /dev/null @@ -1,219 +0,0 @@ -/* - --Procedure vtmvg_c ( Vector transpose times matrix times vector ) - --Abstract - - Multiply the transpose of a n-dimensional column vector, - a nxm matrix, and a m-dimensional column vector. - --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 - - MATRIX - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vtmvg_c - - SpiceDouble vtmvg_c ( const void * v1, - const void * matrix, - const void * v2, - SpiceInt nrow, - SpiceInt ncol ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v1 I n-dimensional double precision column vector. - matrix I nxm double precision matrix. - v2 I m-dimensional double porecision column vector. - nrow I Number of rows in matrix (number of rows in v1.) - ncol I Number of columns in matrix (number of rows in - v2.) - - The function returns the result of (v1**t * matrix * v2 ). - --Detailed_Input - - v1 is an n-dimensional double precision vector. - - matrix is an n x m double precision matrix. - - v2 is an m-dimensional double precision vector. - - nrow is the number of rows in matrix. this is also - equivalent to the number of rows in the vector v1. - - ncol is the number of columns in matrix. this is also - equivalent to the number of rows in the vector v2. - --Detailed_Output - - The function returns the double precision value of the equation - (v1**t * matrix * v2 ). - - Notice that vtmvg_c is actually the dot product of the vector - resulting from multiplying the transpose of V1 and MATRIX and the - vector V2. - --Parameters - - None. - --Particulars - - This routine implements the following vector/matrix/vector - multiplication: - - T - vtmvg_c = [ V1 ] | | | | - | MATRIX | |V2| - | | | | - - by calculating over all values of the indices k and l from 1 to - nrow and 1 to ncol, respectively, the expression - - vtmvg_c = Summation of ( v1(k)*matrix(k,l)*v2(l) ) . - - v1 is a column vector which becomes a row vector when transposed. - v2 is a column vector. - - No check performed to determine whether floating point - overflow has occurred. - --Examples - - If v1 = | 1.0 | matrix = | 2.0 0.0 | v2 = | 1.0 | - | | | | | | - | 2.0 | | 1.0 2.0 | | 2.0 | - | | | | - | 3.0 | | 1.0 1.0 | - - nrow = 3 - ncol = 2 - - Then the value of the function is 21.0. - --Restrictions - - Since no error detection or recovery is implemented, the - programmer is required to insure that the inputs to this routine - are both valid and within the proper range. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - W.M. Owen (JPL) - E.D. Wright (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 1-JUL-1999 - --Index_Entries - - n-dimensional vector_transpose times matrix times vector - --& -*/ - -{ /* Begin vtmvg_c */ - - - /* - Local macros - - We'd like to be able to refer to the elements of the input and output - matrices using normal subscripts, for example, m1[2][3]. Since the - compiler doesn't know how to compute index offsets for the array - arguments, which have user-adjustable size, we must compute the - offsets ourselves. To make syntax a little easier to read (we hope), - we'll use macros to do the computations. - - The macro INDEX(width, i,j) computes the index offset from the array - base of the element at position [i][j] in a 2-dimensional matrix - having the number of columns indicated by width. For example, if - the input matrix m1 has 2 rows and 3 columns, the element at position - [0][1] would be indicated by - - m1[ INDEX(3,0,1) ] - - */ - - #define INDEX( width, row, col ) ( (row)*(width) + (col) ) - - - /* - Local variables - */ - ConstSpiceDouble * loc_v1; - ConstSpiceDouble * loc_m1; - ConstSpiceDouble * loc_v2; - - - SpiceInt k; - SpiceInt l; - SpiceDouble val = 0.; - - - loc_v1 = ( ConstSpiceDouble * ) v1; - loc_v2 = ( ConstSpiceDouble * ) v2; - loc_m1 = ( ConstSpiceDouble * ) matrix; - - - for ( k = 0; k < nrow; k++ ) - { - for ( l = 0; l < ncol; l++ ) - { - val += loc_v1[k] * loc_m1[ INDEX(ncol,k,l) ] * loc_v2[l]; - } - } - - return val; - -} /* End vtmvg_c */ diff --git a/ext/spice/src/cspice/vupack.c b/ext/spice/src/cspice/vupack.c deleted file mode 100644 index eef106279c..0000000000 --- a/ext/spice/src/cspice/vupack.c +++ /dev/null @@ -1,150 +0,0 @@ -/* vupack.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VUPACK ( Unpack three scalar components from a vector ) */ -/* Subroutine */ int vupack_(doublereal *v, doublereal *x, doublereal *y, - doublereal *z__) -{ -/* $ Abstract */ - -/* Unpack three scalar components from a vector. */ - -/* $ 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 */ - -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* V I Input vector. */ -/* X, */ -/* Y, */ -/* Z O Scalar components of the vector. */ - -/* $ Detailed_Input */ - -/* V is a vector with components V(1) = X */ -/* V(2) = Y */ -/* V(3) = Z */ -/* $ Detailed_Output */ - -/* X, */ -/* Y, */ -/* Z are the scalar components of the vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Basically, this is just shorthand notation for the common */ -/* sequence */ - -/* X = V(1) */ -/* Y = V(2) */ -/* Z = V(3) */ - -/* The routine is useful largely for two reasons. First, it */ -/* reduces the chance that the programmer will make a "cut and */ -/* paste" mistake, like */ - -/* X = V(1) */ -/* Y = V(1) */ -/* Z = V(1) */ - -/* Second, it makes conversions between equivalent units simpler, */ -/* and clearer. For instance, the sequence */ - -/* X = V(1) * RPD */ -/* Y = V(2) * RPD */ -/* Z = V(3) * RPD */ - -/* can be replaced by the (nearly) equivalent sequence */ - -/* CALL VSCL ( RPD, V, V ) */ -/* CALL VUPACK ( V, X, Y, Z ) */ - -/* $ Examples */ - -/* See: Detailed_Description. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* unpack three scalar components from a vector */ - -/* -& */ - -/* Just shorthand, like it says above. */ - - *x = v[0]; - *y = v[1]; - *z__ = v[2]; - return 0; -} /* vupack_ */ - diff --git a/ext/spice/src/cspice/vupack_c.c b/ext/spice/src/cspice/vupack_c.c deleted file mode 100644 index 4524b2c0ff..0000000000 --- a/ext/spice/src/cspice/vupack_c.c +++ /dev/null @@ -1,163 +0,0 @@ -/* - --Procedure vupack_c ( Unpack three scalar components from a vector ) - --Abstract - - Unpack three scalar components from a vector. - --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 - - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vupack_c - - - void vupack_c ( ConstSpiceDouble v[3], - SpiceDouble * x, - SpiceDouble * y, - SpiceDouble * z ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - v I 3-vector. - x, - y, - z O Scalar components of 3-vector. - --Detailed_Input - - v is a double precision 3-vector. - --Detailed_Output - - x, - y, - z are the scalar components of the 3-vector v. On output, - the following equalities hold: - - x = v[0] - y = v[1] - z = v[2] - --Parameters - - None. - --Particulars - - Basically, this is just shorthand notation for the common - sequence - - x = v[0]; - y = v[1]; - z = v[2] ; - - The routine is useful largely for two reasons. First, it - reduces the chance that the programmer will make a "cut and - paste" mistake, like - - x = v[0]; - y = v[0]; - z = v[0]; - - Second, it makes conversions between equivalent units simpler, - and clearer. For instance, the sequence - - x = v[0] * rpd_c(); - y = v[1] * rpd_c(); - z = v[2] * rpd_c(); - - can be replaced by the (nearly) equivalent sequence - - vscl_c ( rpd_c(), v, v ); - vupack_c ( v, &x, &y, &z ); - --Examples - - See: Detailed_Description. - --Restrictions - - None. - --Exceptions - - Error free. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.0.0, 07-NOV-2006 (NJB) - - Corrected header errors that claimed this routine - performs the function of vpack_c. - - -CSPICE Version 1.0.0, 28-JUN-1999 (IMU) (NJB) - --Index_Entries - - - unpack three scalar components from a vector - --& -*/ - -{ /* Begin vupack_c */ - - - *x = v[0]; - *y = v[1]; - *z = v[2]; - - -} /* End vupack_c */ - diff --git a/ext/spice/src/cspice/vzero.c b/ext/spice/src/cspice/vzero.c deleted file mode 100644 index 702127777b..0000000000 --- a/ext/spice/src/cspice/vzero.c +++ /dev/null @@ -1,169 +0,0 @@ -/* vzero.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VZERO ( Is a vector the zero vector? ) */ -logical vzero_(doublereal *v) -{ - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* Indicate whether a 3-vector is the zero vector. */ - -/* $ 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 */ - -/* MATH */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* V I Vector to be tested. */ - -/* The function returns the value .TRUE. if and only if V is the */ -/* zero vector. */ - -/* $ Detailed_Input */ - -/* V is a vector in 3-space. */ - -/* $ Detailed_Output */ - -/* The function returns the value .TRUE. if and only if V is the */ -/* zero vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function has the same truth value as the logical expression */ - -/* VNORM ( V ) .EQ. 0.D0 */ - -/* Replacing the above expression by */ - -/* VZERO ( V ) */ - -/* has several advantages: the latter expresses the test more */ -/* clearly, looks better, and doesn't go through the work of scaling, */ -/* squaring, taking a square root, and re-scaling (all of which */ -/* VNORM must do) just to find out that a vector is non-zero. */ - -/* A related function is VZEROG, which accepts vectors of arbitrary */ -/* dimension. */ - -/* $ Examples */ - -/* 1) When testing whether a vector is the zero vector, one */ -/* normally constructs tests like */ - -/* IF ( VNORM ( V ) .EQ. 0.D0 ) THEN */ -/* . */ -/* . */ -/* . */ - - -/* These can be replaced with the code */ - -/* IF ( VZERO ( V ) ) THEN */ -/* . */ -/* . */ -/* . */ - - -/* 2) Check that a normal vector is non-zero before creating */ -/* a plane with PNV2PL: */ - -/* IF ( VZERO ( NORMAL ) ) THEN */ - -/* [ handle error ] */ - -/* ELSE */ - -/* CALL PNV2PL ( POINT, NORMAL, PLANE ) */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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, 17-JUL-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether a 3-dimensional vector is the zero vector */ - -/* -& */ - -/* `Just do it'. */ - - - ret_val = v[0] == 0. && v[1] == 0. && v[2] == 0.; - return ret_val; -} /* vzero_ */ - diff --git a/ext/spice/src/cspice/vzero_c.c b/ext/spice/src/cspice/vzero_c.c deleted file mode 100644 index b90cbf6328..0000000000 --- a/ext/spice/src/cspice/vzero_c.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure vzero_c ( Is a vector the zero vector? ) - --Abstract - - Indicate whether a 3-vector is the zero vector. - --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 - - MATH - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vzero_c - - - SpiceBoolean vzero_c ( ConstSpiceDouble v[3] ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - v I Vector to be tested. - - The function returns the value SPICETRUE if and only if v is the - zero vector. - --Detailed_Input - - v is a vector in 3-space. - --Detailed_Output - - The function returns the value SPICETRUE if and only if v is the - zero vector. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This function has the same truth value as the logical expression - - vnorm_c ( v ) == 0. - - Replacing the above expression by - - vzero_c ( v ); - - has several advantages: the latter expresses the test more - clearly, looks better, and doesn't go through the work of scaling, - squaring, taking a square root, and re-scaling (all of which - vnorm_c must do) just to find out that a vector is non-zero. - - A related function is vzerog_, which accepts vectors of arbitrary - dimension. - --Examples - - 1) When testing whether a vector is the zero vector, one - normally constructs tests like - - if ( vnorm_c ( v ) == 0. ) - { - . - . - . - - - These can be replaced with the code - - if ( vzero_c ( v ) ) - { - . - . - . - - - 2) Check that a normal vector is non-zero before creating - a plane with PNV2PL: - - if ( vzero_c ( NORMAL ) ) - { - [ handle error ] - } - - else - { - pnv2pl_ ( POINT, NORMAL, PLANE ) - . - . - . - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.1.0, 22-OCT-1998 (NJB) - - Made input vector const. Removed #include of SpiceZfc.h. - - -CSPICE Version 1.0.0, 08-FEB-1998 (EDW) - --Index_Entries - - test whether a 3-dimensional vector is the zero vector - --& -*/ - -{ /* Begin vzero_c */ - - return ( SpiceBoolean ) ( v[0] == 0. && v[1] == 0. && v[2] == 0.) ; - -} /* End vzero_c */ diff --git a/ext/spice/src/cspice/vzerog.c b/ext/spice/src/cspice/vzerog.c deleted file mode 100644 index 6ceb06724a..0000000000 --- a/ext/spice/src/cspice/vzerog.c +++ /dev/null @@ -1,193 +0,0 @@ -/* vzerog.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure VZEROG ( Is a vector the zero vector?---general dim. ) */ -logical vzerog_(doublereal *v, integer *ndim) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* Indicate whether a general-dimensional vector is the zero vector. */ - -/* $ 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 */ - -/* MATH */ -/* VECTOR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* V I Vector to be tested. */ -/* NDIM I Dimension of V. */ - -/* The function returns the value .TRUE. if and only if V is the */ -/* zero vector. */ - -/* $ Detailed_Input */ - -/* V, */ -/* NDIM are, respectively, a vector and its dimension. */ - -/* $ Detailed_Output */ - -/* The function returns the value .TRUE. if and only if V is the */ -/* zero vector. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) When NDIM is non-positive, this function returns the value */ -/* .FALSE. (A vector of non-positive dimension cannot be the */ -/* zero vector.) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function has the same truth value as the logical expression */ - -/* VNORMG ( V, NDIM ) .EQ. 0.D0 */ - -/* Replacing the above expression by */ - -/* VZEROG ( V, NDIM ) */ - -/* has several advantages: the latter expresses the test more */ -/* clearly, looks better, and doesn't go through the work of scaling, */ -/* squaring, taking a square root, and re-scaling (all of which */ -/* VNORMG must do) just to find out that a vector is non-zero. */ - -/* A related function is VZERO, which accepts three-dimensional */ -/* vectors. */ - -/* $ Examples */ - -/* 1) When testing whether a vector is the zero vector, one */ -/* normally constructs tests like */ - -/* IF ( VNORMG ( V, NDIM ) .EQ. 0.D0 ) THEN */ -/* . */ -/* . */ -/* . */ - -/* These can be replaced with the code */ - -/* IF ( VZEROG ( V, NDIM ) ) THEN */ -/* . */ -/* . */ -/* . */ - -/* 2) Make sure that a `unit' quaternion is non-zero before */ -/* converting it to a rotation matrix. */ - -/* IF ( VZEROG ( Q, 4 ) ) THEN */ - -/* [ handle error ] */ - -/* ELSE */ - -/* CALL VHATG ( Q, 4, Q ) */ -/* CALL Q2M ( Q, M ) */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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, 18-JUL-1990 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether an n-dimensional vector is the zero vector */ - -/* -& */ - -/* Local variables */ - - -/* Leave as soon as we find a non-zero component. If we get through */ -/* the loop, we have a zero vector, as long as the vector's dimension */ -/* is valid. */ - - i__1 = *ndim; - for (i__ = 1; i__ <= i__1; ++i__) { - if (v[i__ - 1] != 0.) { - ret_val = FALSE_; - return ret_val; - } - } - -/* We have a zero vector if and only if the vector's dimension is at */ -/* least 1. */ - - ret_val = *ndim >= 1; - return ret_val; -} /* vzerog_ */ - diff --git a/ext/spice/src/cspice/vzerog_c.c b/ext/spice/src/cspice/vzerog_c.c deleted file mode 100644 index 5dbfb4bc7b..0000000000 --- a/ext/spice/src/cspice/vzerog_c.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - --Procedure vzerog_c ( Is a vector the zero vector?---general dim. ) - --Abstract - - Indicate whether a general-dimensional vector is the zero vector. - --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 - - MATH - VECTOR - -*/ - - #include "SpiceUsr.h" - #undef vzerog_c - - SpiceBoolean vzerog_c ( ConstSpiceDouble * v, SpiceInt ndim ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - v I Vector to be tested. - ndim I Dimension of v. - - The function returns the value SPICETRUE if and only if v is the - zero vector. - --Detailed_Input - - v, - ndim are, respectively, a vector and its dimension. - --Detailed_Output - - The function returns the value SPICETRUE if and only if v is the - zero vector. - --Parameters - - None. - --Exceptions - - Error free. - - 1) When ndim is non-positive, this function returns the value - SPICEFALSE (A vector of non-positive dimension cannot be the - zero vector.) - --Files - - None. - --Particulars - - This function has the same truth value as the logical expression - - ( vnormg_c ( v, ndim ) == 0. ) - - Replacing the above expression by - - vzerog_c ( v, ndim ); - - has several advantages: the latter expresses the test more - clearly, looks better, and doesn't go through the work of scaling, - squaring, taking a square root, and re-scaling (all of which - vnormg_c must do) just to find out that a vector is non-zero. - - A related function is vzero_c, which accepts three-dimensional - vectors. - --Examples - - 1) When testing whether a vector is the zero vector, one - normally constructs tests like - - if ( vnormg_c ( v, ndim ) == 0. ) - { - . - . - . - - These can be replaced with the code - - if ( vzerog_c ( v, ndim ) ) - { - . - . - . - - 2) Make sure that a `unit' quaternion is non-zero before - converting it to a rotation matrix. - - if ( vzerog_c ( q, 4 ) ) - { - - [ handle error ] - - else - { - vhatg_c ( q, 4, q ) - q2m_c ( q, m ) - . - . - . - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUN-1999 - --Index_Entries - - test whether an n-dimensional vector is the zero vector - --& -*/ - -{ /* Begin vzerog_c */ - - - /* - Local variables. - */ - SpiceInt i; - - /* ndim must be at least 1. */ - if ( ndim < 1 ) - { - return SPICEFALSE; - } - - - /* Check for any non-zero entries. If they exist, test fails. */ - for ( i=0; i < ndim; i++ ) - { - if ( v[i] != 0. ) - { - return SPICEFALSE; - } - } - - - /* If we are here, the vector is zero. */ - return SPICETRUE; - - - -} /* End vzerog_c */ diff --git a/ext/spice/src/cspice/wdcnt.c b/ext/spice/src/cspice/wdcnt.c deleted file mode 100644 index 02f574ae54..0000000000 --- a/ext/spice/src/cspice/wdcnt.c +++ /dev/null @@ -1,214 +0,0 @@ -/* wdcnt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WDCNT ( Word Count ) */ -integer wdcnt_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - logical cont; - integer n, length, loc; - -/* $ Abstract */ - -/* Return the number of words in a 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 */ - -/* STRING, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* WDCNT O The number of words in string. */ - -/* $ Detailed_Input */ - -/* STRING is the input string to be parsed. It contains */ -/* some number of words, where a word is any string */ -/* of consecutive non-blank characters delimited */ -/* by a blank or by either end of the string. */ - -/* $ Detailed_Output */ - -/* WDCNT is the number of words in the input character */ -/* string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* WDCNT, like NTHWD and NEXTWD, is useful primarily for parsing */ -/* input commands consisting of one or more words, where a word is */ -/* defined to be any sequence of consecutive non-blank characters */ -/* delimited by either a blank or by either end of the string. */ - -/* $ Examples */ - -/* The following examples illustrate the use of WDCNT. */ - -/* WDCNT ( 'Now is the time' ) = 4 */ -/* WDCNT ( ' for all ' ) = 2 */ -/* WDCNT ( 'good,men.to_come' ) = 1 */ -/* WDCNT ( ' ' ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 10-JAN-2005 (EDW) */ - -/* Added logic to prevent the evaluation of STRING(LOC:LOC) */ -/* if LOC exceeds the length of string. Functionally, the */ -/* evaluation had no effect on WDCNT's output, but the NAG */ -/* F95 compiler flagged the evaluation as an array */ -/* overrun error. This occurred because given: */ - -/* A .AND. B */ - -/* NAG evaluates A then B then performs the logical */ -/* comparison. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* word count */ - -/* -& */ - -/* Local variables */ - - -/* This is just NTHWD, except that it keeps looking until */ -/* it finds the last word. */ - - -/* Trivial case first. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - ret_val = 0; - return ret_val; - } else { - length = i_len(string, string_len); - } - -/* Skip leading blanks. */ - - loc = 1; - while(*(unsigned char *)&string[loc - 1] == ' ') { - ++loc; - } - -/* Keep stepping through STRING, counting words as we go. */ -/* (The current word is ended whenever a blank is encountered.) */ -/* Quit when the end of the string is reached. */ - -/* N is the number of words found so far. */ -/* LOC is the current location in STRING. */ - - n = 1; - while(loc < length) { - ++loc; - -/* Blank signals end of the current word. */ - - if (*(unsigned char *)&string[loc - 1] == ' ') { - -/* Skip ahead to the next word. Ensure no */ -/* evaluation of STRING(LOC:LOC) when */ -/* LOC = LENGTH+1. */ - - cont = loc <= length; - if (cont) { - cont = cont && *(unsigned char *)&string[loc - 1] == ' '; - } - while(cont) { - ++loc; - cont = loc <= length; - if (cont) { - cont = cont && *(unsigned char *)&string[loc - 1] == ' '; - } - } - -/* If not at the end of the string, we have another word. */ - - if (loc <= length) { - ++n; - } - } - } - -/* Return the number of words found. */ - - ret_val = n; - return ret_val; -} /* wdcnt_ */ - diff --git a/ext/spice/src/cspice/wdindx.c b/ext/spice/src/cspice/wdindx.c deleted file mode 100644 index 23d2acb9cb..0000000000 --- a/ext/spice/src/cspice/wdindx.c +++ /dev/null @@ -1,239 +0,0 @@ -/* wdindx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WDINDX ( Index of a Word Within a String ) */ -integer wdindx_(char *string, char *word, ftnlen string_len, ftnlen word_len) -{ - /* System generated locals */ - integer ret_val, i__1, i__2; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j, begwd, endwd, wdlen, bgtond; - extern integer lastnb_(char *, ftnlen); - integer begstr; - extern integer frstnb_(char *, ftnlen); - integer endstr, strlen; - -/* $ Abstract */ - -/* Find the index of a word within a string. If the word does not */ -/* exist as a word within the string, the value zero is returned. */ - -/* $ 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 */ - -/* PARSING, SEARCH, WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String of characters, potentially containing words */ -/* WORD I A string of consecutive non-blank letters. */ -/* WDINDX O The location of the word within the string. */ - -/* $ Detailed_Input */ - -/* STRING String of characters, potentially containing words. */ -/* WORD A string of consecutive non-blank letters. */ - -/* $ Detailed_Output */ - -/* WDINDX The location of the word within the string. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* A word within a string is a substring beginning and ending with */ -/* a non-blank characters that is delimited by blanks on each end. */ -/* ( A blank is assumed to precede and follow the first and last */ -/* characters of a string. ) */ - -/* Given a word, this routine returns the index of the first letter */ -/* of the first word of STRING that matches the word. */ - -/* $ Examples */ - -/* STRING: */ -/* 1 2 3 4 */ -/* WORD 1234567890123456789012345678901234567890123456 WDINDX */ -/* ------ ---------------------------------------------- ------ */ -/* 'POT' 'PUT THE POTATOES IN THE POT' 25 */ -/* 'TOES' 0 */ -/* 'PUT' 1 */ -/* 'THE' 5 */ -/* 'IN THE' 18 */ -/* 'THE PO' 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* 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 */ - -/* index of a word within a string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Find the ends of the word and input string. */ - - endstr = lastnb_(string, string_len); - begstr = frstnb_(string, string_len); - endwd = lastnb_(word, word_len); - begwd = frstnb_(word, word_len); - -/* Get the offset from the beginning of the word to the end of the */ -/* word, the word length and the string length. */ - - bgtond = endwd - begwd; - wdlen = bgtond + 1; - strlen = endstr + 1 - begstr; - -/* We deal with all of the pathologies first... */ - - if (endwd < 1 || strlen < wdlen) { - -/* ... If we got a blank word or a string that is too short, then */ -/* the index of the word is zero. */ - - ret_val = 0; - return ret_val; - } else if (strlen == wdlen) { - -/* ... the word and string have the same non-blank length. */ -/* Either they match up or they don't. Find out and return. */ - - if (s_cmp(string + (begstr - 1), word + (begwd - 1), endstr - (begstr - - 1), endwd - (begwd - 1)) == 0) { - ret_val = begstr; - } else { - ret_val = 0; - } - return ret_val; - } - -/* Ok. Now we've got a realistic case to deal with. The string */ -/* length is longer than the word length. Check to see if we have a */ -/* match at the beginning of the string. */ - - i__ = begstr; - j = i__ + bgtond; - i__1 = j; - if (s_cmp(string + (i__ - 1), word + (begwd - 1), j - (i__ - 1), endwd - ( - begwd - 1)) == 0 && s_cmp(string + i__1, " ", j + 1 - i__1, ( - ftnlen)1) == 0) { - ret_val = i__; - return ret_val; - } - -/* No luck yet? Search the string until we find a word match or */ -/* we run out of string to check. */ - - i__ = begstr + 1; - j = i__ + bgtond; - for(;;) { /* while(complicated condition) */ - i__1 = i__ - 2; - i__2 = j; - if (!(j < endstr && ! (s_cmp(string + (i__ - 1), word + (begwd - 1), - j - (i__ - 1), endwd - (begwd - 1)) == 0 && s_cmp(string + - i__1, " ", i__ - 1 - i__1, (ftnlen)1) == 0 && s_cmp(string + - i__2, " ", j + 1 - i__2, (ftnlen)1) == 0))) - break; - ++i__; - ++j; - } - -/* If J equals ENDSTR then no match was found in the interior of the */ -/* string. We make a last check at the end. */ - - if (j == endstr) { - i__1 = i__ - 2; - if (s_cmp(string + i__1, " ", i__ - 1 - i__1, (ftnlen)1) == 0 && - s_cmp(string + (i__ - 1), word + (begwd - 1), j - (i__ - 1), - endwd - (begwd - 1)) == 0) { - ret_val = i__; - } else { - ret_val = 0; - } - } else { - -/* The only way to get here is if we exited the above loop before */ -/* running out of room --- that is we had a word match. Set */ -/* the index to the value of "I" that got us out of the loop. */ - - ret_val = i__; - } - return ret_val; -} /* wdindx_ */ - diff --git a/ext/spice/src/cspice/wncard.c b/ext/spice/src/cspice/wncard.c deleted file mode 100644 index 6a2d0b1b4a..0000000000 --- a/ext/spice/src/cspice/wncard.c +++ /dev/null @@ -1,201 +0,0 @@ -/* wncard.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNCARD ( Cardinality of a double precision window ) */ -integer wncard_(doublereal *window) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern logical even_(integer *); - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the cardinality (number of intervals) of a double */ -/* precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WINDOW I Input window. */ - -/* The function returns the cardinality of the input window. */ - -/* $ Detailed_Input */ - -/* WINDOW is a window containing zero or more intervals. */ - -/* $ Detailed_Output */ - -/* The function returns the cardinality of (number of intervals in) */ -/* the input window. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of elements in WINDOW is not even */ -/* the error SPICE(INVALIDSIZE) signals. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The window cardinality (WNCARD) function simply wraps a CARD call */ -/* then divides the result by 2. A common error when using the SPICE */ -/* windows function is to use the CARDD value as the number of */ -/* window intervals rather than the CARDD/2 value. */ - -/* $ Examples */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER WNSIZE */ -/* PARAMETER ( WNSIZE = 10 ) */ - -/* DOUBLE PRECISION WINDOW ( LBCELL:WNSIZE ) */ -/* DOUBLE PRECISION LEFT */ -/* DOUBLE PRECISION RIGHT */ - -/* INTEGER WNCARD */ -/* INTEGER I */ - -/* Validate the window with size WNSIZE and zero elements. */ - -/* CALL WNVALD( WNSIZE, 0, WINDOW ) */ - -/* Insert the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* into WINDOW. */ - -/* CALL WNINSD( 1.D0, 3.D0, WINDOW ) */ -/* CALL WNINSD( 7.D0, 11.D0, WINDOW ) */ -/* CALL WNINSD( 23.D0, 27.D0, WINDOW ) */ - -/* Loop over the number of intervals in WINDOW, output */ -/* the LEFT and RIGHT endpoints for each interval. */ - -/* DO I=1, WNCARD(WINDOW) */ - -/* CALL WNFETD( WINDOW, I, LEFT, RIGHT ) */ - -/* WRITE(*,*) 'Interval', I, ' [', LEFT, RIGHT, ']' */ - -/* END DO */ - -/* The code outputs: */ - -/* Interval 1 [ 1. 3.] */ -/* Interval 2 [ 7. 11.] */ -/* Interval 3 [ 23. 27.] */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 24-APR-2010 (EDW) */ - -/* Minor edit to code comments eliminating typo. */ - -/* - SPICELIB Version 1.0.0, 10-AUG-2007 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* cardinality of a d.p. window */ - -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("WNCARD", (ftnlen)6); - } - ret_val = cardd_(window); - -/* Confirm the cardinality as an even integer. */ - - if (! even_(&ret_val)) { - setmsg_("Invalid window size, a window should have an even number of" - " elements. The size was #.", (ftnlen)85); - errint_("#", &ret_val, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("WNCARD", (ftnlen)6); - ret_val = 0; - return ret_val; - } - -/* Set return value. Cardinality in a SPICE window sense */ -/* means the number of intervals, half the cell */ -/* cardinality value. */ - - ret_val /= 2; - chkout_("WNCARD", (ftnlen)6); - return ret_val; -} /* wncard_ */ - diff --git a/ext/spice/src/cspice/wncard_c.c b/ext/spice/src/cspice/wncard_c.c deleted file mode 100644 index 132ce1240a..0000000000 --- a/ext/spice/src/cspice/wncard_c.c +++ /dev/null @@ -1,173 +0,0 @@ -/* - --Procedure wncard_c ( Cardinality of a double precision window ) - --Abstract - - Return the cardinality (number of intervals) of a double - precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceInt wncard_c ( SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - window I Input window - - The function returns the window cardinality of the window. - --Detailed_Input - - window a window containing zero or more intervals - - 'window' must be declared as a double precision SpiceCell. - --Detailed_Output - - The function returns the cardinality of (number of intervals in) - the input window. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - This function returns the value of card_c(window)/2. - --Examples - - - /. Include needed headers. ./ - - #include - #include "SpiceUsr.h" - - #define WNSIZE 10 - - int main() - { - - - SpiceInt i; - SpiceDouble left; - SpiceDouble right; - - SPICEDOUBLE_CELL ( window, WNSIZE ); - - wnvald_c ( WNSIZE, 0, &window ); - - wninsd_c ( 1.0, 3.0, &window ); - wninsd_c ( 7.0, 11.0, &window ); - wninsd_c ( 23.0, 27.0, &window ); - - for ( i=0; ibase) ); - - return( retval ); - -} /* End wncard_c */ - diff --git a/ext/spice/src/cspice/wncomd.c b/ext/spice/src/cspice/wncomd.c deleted file mode 100644 index 4df8c2b71b..0000000000 --- a/ext/spice/src/cspice/wncomd.c +++ /dev/null @@ -1,287 +0,0 @@ -/* wncomd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure WNCOMD ( Complement a DP window ) */ -/* Subroutine */ int wncomd_(doublereal *left, doublereal *right, doublereal * - window, doublereal *result) -{ - integer card, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int scardd_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - wninsd_(doublereal *, doublereal *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Determine the complement of a double precision window with */ -/* respect to the interval [LEFT,RIGHT]. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LEFT, */ -/* RIGHT I Left, right endpoints of complement interval. */ -/* WINDOW I Input window. */ -/* RESULT O Complement of WINDOW with respect to [LEFT,RIGHT]. */ - -/* $ Detailed_Input */ - -/* LEFT, */ -/* RIGHT are the left and right endpoints of the complement */ -/* interval. */ - -/* WINDOW is the window to be complemented. */ - -/* $ Detailed_Output */ - -/* RESULT is the output window, containing the complement */ -/* of WINDOW with respect to the interval from LEFT */ -/* to RIGHT. If the output window is not large enough */ -/* to contain the result, as many intervals as will */ -/* fit are returned. */ - -/* RESULT must be distinct from WINDOW. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* Mathematically, the complement of a window contains those */ -/* points that are not contained in the window. That is, the */ -/* complement of the set of closed intervals */ - -/* [ a(1), b(1) ], [ a(2), b(2) ], ..., [ a(n), b(n) ] */ - -/* is the set of open intervals */ - -/* ( -inf, a(1) ), ( b(1), a(2) ), ..., ( b(n), +inf ) */ - -/* Because Fortran offers no satisfactory representation of */ -/* infinity, we must take the complement with respect to a */ -/* finite interval. */ - -/* In addition, Fortran offers no satisfactory floating point */ -/* representation of open intervals. Therefore, the complement */ -/* of a floating point window is closure of the set theoretical */ -/* complement. In short, the floating point complement of the */ -/* window */ - -/* [ a(1), b(1) ], [ a(2), b(2) ], ..., [ a(n), b(n) ] */ - -/* with respect to the interval from LEFT to RIGHT is the */ -/* intersection of the windows */ - -/* ( -inf, a(1) ], [ b(1), a(2) ], ..., [ b(n), +inf ) */ - -/* and */ - -/* [ LEFT, RIGHT ] */ - -/* Note that floating point intervals of measure zero (singleton */ -/* intervals) in the original window are replaced by gaps of */ -/* measure zero, which are filled. Thus, complementing a floating */ -/* point window twice does not necessarily yield the original */ -/* window. */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Then the floating point complement of WINDOW with respect */ -/* to [2,20] contains the intervals */ - -/* [ 3, 7 ] [ 11, 20 ] */ - -/* and the complement with respect to [ 0, 100 ] contains */ - -/* [ 0, 1 ] [ 3, 7 ] [ 11, 23 ] [ 27, 100 ] */ - -/* $ Exceptions */ - -/* If LEFT is greater than RIGHT, the error SPICE(BADENDPOINTS) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* complement a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Required_Reading section was */ -/* changed from "None." to "WINDOWS". Also, the */ -/* declaration of the unused variable J was removed. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("WNCOMD", (ftnlen)6); - -/* Get the cardinality of the input window. */ - - card = cardd_(window); - -/* Empty out the result window before proceeding. */ - - scardd_(&c__0, result); - -/* Check to see if the input interval is valid. If it is not, signal */ -/* an error and return. */ - - if (*left > *right) { - setmsg_("WNCOMD: Left endpoint may not exceed right endpoint.", ( - ftnlen)52); - sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19); - chkout_("WNCOMD", (ftnlen)6); - return 0; - } - -/* There are two trivial cases: the window is empty, or it does not */ -/* intersect the input interval. In either case, the complement is */ -/* the entire interval. */ - - if (card == 0 || window[6] >= *right || window[card + 5] <= *left) { - wninsd_(left, right, result); - chkout_("WNCOMD", (ftnlen)6); - return 0; - } - -/* Let WINDOW represent the set of intervals */ - -/* [a1,b1], [a2,b2], ..., [aN,bN] */ - -/* Then the closure of the complement of WINDOW in the reals is */ - -/* (-infinity,a1], [b1,a2], [b2,a3], ..., [bN, infinity) */ - -/* Thus the sequence of endpoints of WINDOW is also the sequence */ -/* of finite endpoints of its complement. Moreover, these endpoints */ -/* are simply "shifted" from their original positions in WINDOW. */ -/* This makes finding the complement of WINDOW with respect to */ -/* a given interval almost trivial. */ - - -/* Find the first right not less than the beginning of the input */ -/* interval. */ - - i__ = 2; - while(i__ <= card && window[i__ + 5] < *left) { - i__ += 2; - } - -/* If the beginning of the input interval doesn't split an interval */ -/* in the input window, the complement begins with LEFT. */ - - if (i__ <= card && window[i__ + 4] > *left) { - wninsd_(left, &window[i__ + 4], result); - } - -/* Start schlepping endpoints [b(i),a(i+1)] from the input window */ -/* to the output window. Stop when we find one of our new right */ -/* endpoints exceeds the end of the input interval. */ - - while(! failed_() && i__ < card && window[i__ + 6] < *right) { - wninsd_(&window[i__ + 5], &window[i__ + 6], result); - i__ += 2; - } - -/* If the end of the input interval doesn't split an interval */ -/* in the input window, the complement ends with RIGHT. */ - - if (i__ <= card && window[i__ + 5] < *right) { - wninsd_(&window[i__ + 5], right, result); - } - chkout_("WNCOMD", (ftnlen)6); - return 0; -} /* wncomd_ */ - diff --git a/ext/spice/src/cspice/wncomd_c.c b/ext/spice/src/cspice/wncomd_c.c deleted file mode 100644 index 95cd119546..0000000000 --- a/ext/spice/src/cspice/wncomd_c.c +++ /dev/null @@ -1,225 +0,0 @@ -/* - --Procedure wncomd_c ( Complement a DP window ) - --Abstract - - Determine the complement of a double precision window with - respect to a specified interval. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void wncomd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window, - SpiceCell * result ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - left, - right I Left, right endpoints of complement interval. - window I Input window. - result O Complement of window with respect to [left,right]. - --Detailed_Input - - left, - right are the left and right endpoints of the complement - interval. - - window is the window to be complemented. window must be - declared as a double precision SpiceCell. - --Detailed_Output - - result is the output window, containing the complement - of window with respect to the interval from left - to right. If the output window is not large enough - to contain the result, as many intervals as will - fit are returned. - - result must be declared as a double precision SpiceCell. - - result must be distinct from window. - --Parameters - - None. - --Exceptions - - 1) If either input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If left is greater than right, the error SPICE(BADENDPOINTS) is - signaled. - --Files - - None. - --Particulars - - Mathematically, the complement of a window contains those - points that are not contained in the window. That is, the - complement of the set of closed intervals - - [ a(0), b(0) ], [ a(1), b(1) ], ..., [ a(n), b(n) ] - - is the set of open intervals - - ( -inf, a(0) ), ( b(0), a(1) ), ..., ( b(n), +inf ) - - Because ANSI C offers no satisfactory representation of - infinity, we must take the complement with respect to a - finite interval. - - In addition, ANSI C offers no satisfactory floating point - representation of open intervals. Therefore, the complement - of a floating point window is closure of the set theoretical - complement. In short, the floating point complement of the - window - - [ a(0), b(0) ], [ a(1), b(1) ], ..., [ a(n), b(n) ] - - with respect to the interval from left to right is the - intersection of the windows - - ( -inf, a(0) ), ( b(0), a(1) ), ..., ( b(n), +inf ) - - and - - [ left, right ] - - Note that floating point intervals of measure zero (singleton - intervals) in the original window are replaced by gaps of - measure zero, which are filled. Thus, complementing a floating - point window twice does not necessarily yield the original window. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - Then the floating point complement of window with respect - to [2,20] contains the intervals - - [ 3, 7 ] [ 11, 20 ] - - and the complement with respect to [ 0, 100 ] contains - - [ 0, 1 ] [ 3, 7 ] [ 11, 23 ] [ 27, 100 ] - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 27-AUG-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - complement a d.p. window - --& -*/ - -{ /* Begin wncomd_c */ - - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "wncomd_c" ); - - - /* - Make sure data types are d.p. - */ - CELLTYPECHK2 ( CHK_STANDARD, "wncomd_c", SPICE_DP, window, result ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT2 ( window, result ); - - /* - Let the f2c'd routine do the work. - */ - wncomd_ ( (doublereal * ) &left, - (doublereal * ) &right, - (doublereal * ) (window->base), - (doublereal * ) (result->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, result ); - } - - chkout_c ( "wncomd_c" ); - -} /* End wncomd_c */ diff --git a/ext/spice/src/cspice/wncond.c b/ext/spice/src/cspice/wncond.c deleted file mode 100644 index 006fb7488b..0000000000 --- a/ext/spice/src/cspice/wncond.c +++ /dev/null @@ -1,191 +0,0 @@ -/* wncond.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNCOND ( Contract the intervals of a DP window ) */ -/* Subroutine */ int wncond_(doublereal *left, doublereal *right, doublereal * - window) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen), wnexpd_(doublereal *, doublereal *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* Contract each of the intervals of a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LEFT I Amount added to each left endpoint. */ -/* RIGHT I Amount subtracted from each right endpoint. */ -/* WINDOW I,O Window to be contracted. */ - -/* $ Detailed_Input */ - -/* LEFT is the amount to be added to the left endpoint of */ -/* each interval in the input window. */ - -/* RIGHT is the amount to be subtracted from the right */ -/* endpoint of each interval in the window. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the original window with each of its */ -/* intervals contracted by LEFT units on the left and */ -/* RIGHT units on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine contracts (shortens) each of the intervals in */ -/* the input window. The adjustments are not necessarily symmetric. */ -/* That is, LEFT units are added to the left endpoint of each */ -/* interval, and RIGHT units are subtracted from the right endpoint */ -/* of each interval, where LEFT and RIGHT may be different. */ - -/* Intervals are dropped when they are contracted by amounts */ -/* greater than their measures. */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] */ - -/* Then the following series of calls */ - -/* CALL WNCOND ( 2, 1, WINDOW ) (1) */ -/* CALL WNCOND ( -2, 2, WINDOW ) (2) */ -/* CALL WNCOND ( -2, -1, WINDOW ) (3) */ - -/* produces the following series of windows */ - -/* [ 9, 10 ] [ 25, 26 ] (1) */ -/* [ 7, 8 ] [ 23, 24 ] (2) */ -/* [ 5, 9 ] [ 21, 25 ] (3) */ - -/* Note that intervals may be "contracted" by negative amounts. */ -/* In the example above, the second call shifts each interval to */ -/* the left, while the third call undoes the effect of the first */ -/* call (without restoring the destroyed intervals). */ - -/* Note also that the third call is exactly equivalent to the */ -/* call */ - -/* CALL WNEXPD ( 2, 1, WINDOW ) */ - - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* contract the intervals of a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* Spicelib functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNCOND", (ftnlen)6); - } - -/* This is just negative expansion. */ - - d__1 = -(*left); - d__2 = -(*right); - wnexpd_(&d__1, &d__2, window); - chkout_("WNCOND", (ftnlen)6); - return 0; -} /* wncond_ */ - diff --git a/ext/spice/src/cspice/wncond_c.c b/ext/spice/src/cspice/wncond_c.c deleted file mode 100644 index fef7bd97ae..0000000000 --- a/ext/spice/src/cspice/wncond_c.c +++ /dev/null @@ -1,188 +0,0 @@ -/* - --Procedure wncond_c ( Contract the intervals of a DP window ) - --Abstract - - Contract each of the intervals of a double precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wncond_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - left I Amount added to each left endpoint. - right I Amount subtracted from each right endpoint. - window I,O Window to be contracted. - --Detailed_Input - - left is the amount to be added to the left endpoint of - each interval in the input window. - - right is the amount to be subtracted from the right - endpoint of each interval in the window. - - window on input, is a CSPICE window containing zero or more - intervals. window must be declared as a double precision - SpiceCell. - --Detailed_Output - - window on output, is the original window with each of its - intervals contracted by left units on the left and - right units on the right. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - None. - --Particulars - - This routine contracts (shortens) each of the intervals in - the input window. The adjustments are not necessarily symmetric. - That is, left units are added to the left endpoint of each - interval, and right units are subtracted from the right endpoint - of each interval, where left and right may be different. - - Intervals are dropped when they are contracted by amounts - greater than their measures. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] - - Then the following series of calls - - wncond_c ( 2, 1, &window ); (1) - wncond_c ( -2, 2, &window ); (2) - wncond_c ( -2, -1, &window ); (3) - - produces the following series of windows - - [ 9, 10 ] [ 25, 26 ] (1) - [ 7, 8 ] [ 23, 24 ] (2) - [ 5, 9 ] [ 21, 25 ] (3) - - Note that intervals may be "contracted" by negative amounts. - In the example above, the second call shifts each interval to - the left, while the third call undoes the effect of the first - call (without restoring the destroyed intervals). - - Note also that the third call is exactly equivalent to the - call - - wnexpd_c ( 2, 1, window ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 21-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - contract the intervals of a d.p. window - --& -*/ - -{ /* Begin wncond_c */ - - /* - Use discovery check-in. - - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_DISCOVER, "wncond_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - /* - Let the f2c'd routine do the work. - */ - wncond_ ( (doublereal * ) &left, - (doublereal * ) &right, - (doublereal * ) (window->base) ); - - /* - Sync the output cell. - */ - zzsynccl_c ( F2C, window ); - - -} /* End wncond_c */ diff --git a/ext/spice/src/cspice/wndifd.c b/ext/spice/src/cspice/wndifd.c deleted file mode 100644 index d4853f58e0..0000000000 --- a/ext/spice/src/cspice/wndifd.c +++ /dev/null @@ -1,403 +0,0 @@ -/* wndifd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNDIFD ( Difference two DP windows ) */ -/* Subroutine */ int wndifd_(doublereal *a, doublereal *b, doublereal *c__) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - logical keep; - integer over; - doublereal f; - integer acard, bcard; - doublereal l; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - extern /* Subroutine */ int copyd_(doublereal *, doublereal *); - integer needed; - extern /* Subroutine */ int scardd_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), ssized_(integer *, - doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - logical unrslv; - integer apb, bpb, ape, bpe, put; - -/* $ Abstract */ - -/* Place the difference of two double precision windows into */ -/* a third window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A, */ -/* B I Input windows. */ -/* C I Difference of A and B. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are windows, each of which contains zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* C is the output window, containing the difference */ -/* of A and B---every point contained in A, but not */ -/* contained in B. */ - -/* C must be distinct from both A and B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1. If the difference of the two windows results in an excess of */ -/* elements, the error SPICE(WINDOWEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Mathematically, the difference of two windows contains every */ -/* point contained in the first window but not contained in the */ -/* second window. */ - -/* Fortran offers no satisfactory floating point representation */ -/* of open intervals. Thus, for floating point windows we must */ -/* return the closure of the set theoretical difference: that is, */ -/* the difference plus the endpoints of the first window that are */ -/* contained in the second window. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* and B contain the intervals */ - -/* [ 2, 4 ] [ 8, 10 ] [ 16, 18 ] */ - -/* Then the difference of A and B contains the intervals */ - -/* [ 1, 2 ] [ 7, 8 ] [ 10, 11 ] [ 23, 27 ] */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 16-SEP-1998 (WLT) */ - -/* The previous version did not work when removing */ -/* singletons. This has been corrected. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* difference two d.p. windows */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) */ - -/* Due to the calling sequence and functionality changes */ -/* in the routine EXCESS, the method of signalling an */ -/* excess of elements needed to be changed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("WNDIFD", (ftnlen)6); - -/* Find the cardinality of the input windows, and the allowed size */ -/* of the output window. Also, save the size of the second window. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - over = 0; - -/* Empty out the output window. */ - - ssized_(&csize, c__); - -/* Let's handle the pathological cases first. */ - - if (bcard == 0) { - copyd_(a, c__); - chkout_("WNDIFD", (ftnlen)6); - return 0; - } else if (acard == 0) { - chkout_("WNDIFD", (ftnlen)6); - return 0; - } - -/* Now get pointers to the first intervals of A and B. */ - - apb = 1; - ape = 2; - bpb = 1; - bpe = 2; - put = 1; - -/* As long as the endpointer for A is less than the cardinality */ -/* of A we need to examine intervals and decide how much of */ -/* them to keep in C. */ - - while(ape <= acard) { - -/* We will work with the interval [F,L] which starts out */ -/* as the next interval of A. We modify it below as required */ -/* when subtracting out intervals of B. */ - - f = a[apb + 5]; - l = a[ape + 5]; - -/* Right now we have not resolved whether to keep the interval */ -/* [F,L], but until we know better we assume it is a keeper. */ - - unrslv = bpe <= bcard; - keep = TRUE_; - while(unrslv) { - if (l < b[bpb + 5]) { - -/* The interval [F,L] is before the next interval of B, we */ -/* have resolved what to do with this one. It is a */ -/* keeper. */ - - unrslv = FALSE_; - } else if (f > b[bpe + 5]) { - -/* [F,L] is after the end of the current interval in B, */ -/* we need to look at the next interval of B */ - - bpb += 2; - bpe += 2; - unrslv = bpe <= bcard; - } else { - -/* There is some overlap between the current interval */ -/* of B and the current interval of A. There are */ -/* several possibilities */ - -/* 1) The current interval of A is contained in the */ -/* current interval of B (This includes singleton */ -/* intervals in A). We just mark [F,L] so that it */ -/* won't be kept. We have fully resolved what to */ -/* do with [F,L]. */ - -/* 2) The interval from B overlaps at the beginning */ -/* of the interval of A */ - -/* B interval [......] */ -/* A interval [............] */ -/* result of A-B [.........] */ - -/* In this case we need to shrink the interval [F,L] */ -/* but we have not resolved how much of the result */ -/* to keep. */ - -/* 3) The interval from B falls inside the current */ -/* interval [F,L] */ - -/* B interval [......] */ -/* A interval [............] */ -/* result of A-B [..] [..] */ - -/* If the interval from B is not a singleton, we store */ -/* the first part of [F,L] in C and then set [F,L] to */ -/* be the right interval which is still not resolved. */ - -/* If the B interval is a singleton we can ignore ignore */ -/* it. But we have not resolved what to do about */ -/* [F,L], we need to look at the next interval of B. */ - - -/* 4) The interval from B overlaps at the ending */ -/* of the interval of A */ - -/* B interval [......] */ -/* A interval [......] */ -/* result of A-B [....] */ - -/* We need to shrink [F,L]. In this case we know we can */ -/* keep all of what's left because all other intervals */ -/* of B are to the right of [F,L] */ - - if (b[bpb + 5] <= f && l <= b[bpe + 5]) { - -/* Case 1 above */ - - keep = FALSE_; - unrslv = FALSE_; - } else if (b[bpb + 5] <= f) { - -/* Case 2 above */ - - f = b[bpe + 5]; - bpb += 2; - bpe += 2; - unrslv = bpe <= bcard; - } else if (f <= b[bpb + 5] && l >= b[bpe + 5] && b[bpb + 5] < - b[bpe + 5]) { - -/* Case 3 above (non-singleton interval of B). */ - - if (put < csize) { - c__[put + 5] = f; - c__[put + 6] = b[bpb + 5]; - i__1 = put + 1; - scardd_(&i__1, c__); - put += 2; - } else { - over += 2; - } - f = b[bpe + 5]; - -/* If the interval from B contained L, we will not */ -/* want to be keeping the singleton [F,L]. */ - - if (f == l) { - keep = FALSE_; - unrslv = FALSE_; - } - bpb += 2; - bpe += 2; - unrslv = unrslv && bpe <= bcard; - } else if (f <= b[bpb + 5] && l >= b[bpe + 5] && b[bpb + 5] == - b[bpe + 5]) { - -/* Case 3 above (singleton interval of B). */ - - bpb += 2; - bpe += 2; - unrslv = bpe <= bcard; - } else { - -/* Case 4 above */ - - l = b[bpb + 5]; - unrslv = FALSE_; - } - } - } - -/* If there is anything to keep in C, put it there. */ - - if (keep) { - -/* Make sure there is sufficient room to do the putting. */ - - if (put < csize) { - c__[put + 5] = f; - c__[put + 6] = l; - i__1 = put + 1; - scardd_(&i__1, c__); - put += 2; - } else { - over += 2; - } - } - -/* Move the pointers in A to the next interval. */ - - apb += 2; - ape += 2; - } - -/* We've examined all of the intervals of A and B, but if we */ -/* didn't actually store all of the difference, signal an error. */ - - if (over > 0) { - needed = over + csize; - setmsg_("The output window did not have sufficient room to contain t" - "he result of the window difference. It has room for # endpo" - "ints, but # were needed to describe the difference. ", ( - ftnlen)171); - errint_("#", &csize, (ftnlen)1); - errint_("#", &needed, (ftnlen)1); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - } - chkout_("WNDIFD", (ftnlen)6); - return 0; -} /* wndifd_ */ - diff --git a/ext/spice/src/cspice/wndifd_c.c b/ext/spice/src/cspice/wndifd_c.c deleted file mode 100644 index 0cb5bb1d21..0000000000 --- a/ext/spice/src/cspice/wndifd_c.c +++ /dev/null @@ -1,195 +0,0 @@ -/* - --Procedure wndifd_c ( Difference two DP windows ) - --Abstract - - Place the difference of two double precision windows into - a third window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wndifd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a, - b I Input windows. - c I Difference of a and b. - --Detailed_Input - - a, - b are CSPICE windows, each of which contains zero or more - intervals. - - a and b must be declared as double precision - SpiceCells. - --Detailed_Output - - c is the output CSPICE window, containing the difference - of a and b---every point contained in a, but not - contained in b. - - c must be declared as a double precision SpiceCell. - - c must be distinct from both a and b. --Parameters - - None. - --Exceptions - - 1) If any of the function arguments are SpiceCells of type - other than double precision, the error SPICE(TYPEMISMATCH) - is signaled. - - 2) If the difference of the two windows results in an excess of - elements, the error SPICE(WINDOWEXCESS) is signaled. - --Files - - None. - --Particulars - - Mathematically, the difference of two windows contains every - point contained in the first window but not contained in the - second window. - - Fortran offers no satisfactory floating point representation - of open intervals. Thus, for floating point windows we must - return the closure of the set theoretical difference. - --Examples - - Let a contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - and b contain the intervals - - [ 2, 4 ] [ 8, 10 ] [ 16, 18 ] - - Then the difference of a and b contains the intervals - - [ 1, 2 ] [ 7, 8 ] [ 10, 11 ] [ 23, 27 ] - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - difference two d.p. windows - --& -*/ - -{ /* Begin wndifd_c */ - - /* - Local constants - */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "wndifd_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK3 ( CHK_STANDARD, "wndifd_c", SPICE_DP, a, b, c ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - - /* - Let the f2c'd routine do the work. - */ - wndifd_ ( (doublereal * ) (a->base), - (doublereal * ) (b->base), - (doublereal * ) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - - chkout_c ( "wndifd_c" ); - -} /* End wndifd_c */ diff --git a/ext/spice/src/cspice/wnelmd.c b/ext/spice/src/cspice/wnelmd.c deleted file mode 100644 index 65a2f5c9f3..0000000000 --- a/ext/spice/src/cspice/wnelmd.c +++ /dev/null @@ -1,199 +0,0 @@ -/* wnelmd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNELMD ( Element of a DP window ) */ -logical wnelmd_(doublereal *point, doublereal *window) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer card, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Determine whether a point is an element of a double precision */ -/* window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* POINT I Input point. */ -/* WINDOW I Input window. */ - -/* The function returns TRUE if POINT is an element of WINDOW. */ - -/* $ Detailed_Input */ - -/* POINT is a point, which may or may not be contained in */ -/* one of the intervals in WINDOW. */ - -/* WINDOW is a window containing zero or more intervals. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if the input point is an element of */ -/* the input window---that is, if */ - -/* a(i) < POINT < b(i) */ -/* - - */ - -/* for some interval [ a(i), b(i) ] in WINDOW---and returns FALSE */ -/* otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Then the following expressions are true */ - -/* WNELMD ( 1, WINDOW ) */ -/* WNELMD ( 9, WINDOW ) */ - -/* and the following expressions are false. */ - -/* WNELMD ( 0, WINDOW ) */ -/* WNELMD ( 13, WINDOW ) */ -/* WNELMD ( 29, WINDOW ) */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* element of a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("WNELMD", (ftnlen)6); - } - -/* How many endpoints in the window? */ - - card = cardd_(window); - -/* Check the point against every interval in the window. Quit if */ -/* we find an interval that contains it. Inefficient, but it works. */ - - i__1 = card; - for (i__ = 1; i__ <= i__1; i__ += 2) { - if (*point >= window[i__ + 5] && *point <= window[i__ + 6]) { - ret_val = TRUE_; - chkout_("WNELMD", (ftnlen)6); - return ret_val; - } - } - ret_val = FALSE_; - chkout_("WNELMD", (ftnlen)6); - return ret_val; -} /* wnelmd_ */ - diff --git a/ext/spice/src/cspice/wnelmd_c.c b/ext/spice/src/cspice/wnelmd_c.c deleted file mode 100644 index cffb38fc25..0000000000 --- a/ext/spice/src/cspice/wnelmd_c.c +++ /dev/null @@ -1,172 +0,0 @@ -/* - --Procedure wnelmd_c ( Element of a DP window ) - --Abstract - - Determine whether a point is an element of a double precision - window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceBoolean wnelmd_c ( SpiceDouble point, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - point I Input point. - window I Input window. - - The function returns SPICETRUE if point is an element of window. - --Detailed_Input - - point is a point, which may or may not be contained in - one of the intervals in window. - - window is a CSPICE window containing zero or more intervals. - - window must be declared as a double precision SpiceCell. - --Detailed_Output - - The function returns SPICETRUE if the input point is an element of - the input window---that is, if - - a(i) < point < b(i) - - - - - for some interval [ a(i), b(i) ] in window---and returns SPICEFALSE - otherwise. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - None. - --Particulars - - None. - --Examples - - Let a contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - Then the following expressions take the value SPICETRUE - - wnelmd_c ( 1.0, &window ); - wnelmd_c ( 9.0, &window ); - - and the following expressions take the value SPICEFALSE - - wnelmd_c ( 0.0, &window ); - wnelmd_c ( 13.0, &window ); - wnelmd_c ( 29.0, &window ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - element of a d.p. window - --& -*/ - -{ /* Begin wnelmd_c */ - - /* - Local variables - */ - SpiceBoolean retval; - - - /* - Use discovery check-in. - - Make sure cell data type is d.p. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, - "wnelmd_c", SPICE_DP, window, SPICEFALSE ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - /* - Let the f2c'd routine do the work. - */ - retval = wnelmd_ ( (doublereal * ) &point, - (doublereal * ) (window->base) ); - - return ( retval ); - -} /* End wnelmd_c */ diff --git a/ext/spice/src/cspice/wnexpd.c b/ext/spice/src/cspice/wnexpd.c deleted file mode 100644 index 88ca269cf3..0000000000 --- a/ext/spice/src/cspice/wnexpd.c +++ /dev/null @@ -1,246 +0,0 @@ -/* wnexpd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure WNEXPD ( Expand the intervals of a DP window ) */ -/* Subroutine */ int wnexpd_(doublereal *left, doublereal *right, doublereal * - window) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, gone, i__, j; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Expand each of the intervals of a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LEFT I Amount subtracted from each left endpoint. */ -/* RIGHT I Amount added to each right endpoint. */ -/* WINDOW I,O Window to be expanded. */ - -/* $ Detailed_Input */ - -/* LEFT is the amount to be subtracted from the left */ -/* endpoint of each interval in the input window. */ - -/* RIGHT is the amount to be added to the right endpoint */ -/* of each interval in the window. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the original window with each of its */ -/* intervals expanded by LEFT units on the left and */ -/* RIGHT units on the right. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine expands (lengthens) each of the intervals in */ -/* the input window. The adjustments are not necessarily symmetric. */ -/* That is, LEFT units are subtracted from the left endpoint of */ -/* each interval, and RIGHT units are added to the right endpoint */ -/* of each interval, where LEFT and RIGHT may be different. */ - -/* Intervals are merged when expansion causes them to overlap. */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] */ - -/* Then the following series of calls */ - -/* CALL WNEXPD ( 2, 1, WINDOW ) (1) */ -/* CALL WNEXPD ( -2, 2, WINDOW ) (2) */ -/* CALL WNEXPD ( -2, -1, WINDOW ) (3) */ - -/* produces the following series of windows */ - -/* [ -1, 4 ] [ 5, 12 ] [ 21, 30 ] (1) */ -/* [ 1, 6 ] [ 7, 14 ] [ 23, 32 ] (2) */ -/* [ 3, 5 ] [ 9, 13 ] [ 25, 31 ] (3) */ - -/* Note that intervals may be "expanded" by negative amounts. */ -/* In the example above, the second call shifts each interval to */ -/* the right, while the third call undoes the effect of the first */ -/* call (without restoring the merged intervals). */ - -/* Note also that the third call is exactly equivalent to the */ -/* call */ - -/* CALL WNCOND ( 2, 1, WINDOW ) */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* expand the intervals of a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNEXPD", (ftnlen)6); - } - -/* Get the cardinality of the window. (The size is not important; */ -/* this routine can't create any new intervals.) */ - - card = cardd_(window); - -/* Expand the intervals individually. We'll take care of */ -/* overlaps later on. Negative expansion may cause some */ -/* intervals to disappear. */ - - gone = 0; - i__1 = card; - for (i__ = 1; i__ <= i__1; i__ += 2) { - window[i__ - gone + 5] = window[i__ + 5] - *left; - window[i__ - gone + 6] = window[i__ + 6] + *right; - if (window[i__ - gone + 5] > window[i__ - gone + 6]) { - gone += 2; - } - } - -/* Proceed only if at least one interval remains. (If there were */ -/* no intervals to begin with, we skip the previous loop and come */ -/* here without delay. Do not pass GO, do not collect $200.) */ - - card -= gone; - if (card == 0) { - scardd_(&c__0, window); - chkout_("WNEXPD", (ftnlen)6); - return 0; - } - -/* None of the intervals can have extended to completely contain */ -/* any of the other intervals. (They were all expanded by the */ -/* same amount. Convince yourself that this is true.) So the first */ -/* endpoint is still the first endpoint (so to speak). */ - -/* Step through the window, looking for the next right endpoint */ -/* less than the following left endpoint. This marks the end of */ -/* the new first interval, and the beginning of the new second */ -/* interval. Keep this up until the last right endpoint has been */ -/* reached. This remains the last right endpoint. */ - - i__ = 2; - j = 2; - while(j < card) { - if (window[j + 5] < window[j + 6]) { - window[i__ + 5] = window[j + 5]; - window[i__ + 6] = window[j + 6]; - i__ += 2; - } - j += 2; - } - window[i__ + 5] = window[j + 5]; - scardd_(&i__, window); - chkout_("WNEXPD", (ftnlen)6); - return 0; -} /* wnexpd_ */ - diff --git a/ext/spice/src/cspice/wnexpd_c.c b/ext/spice/src/cspice/wnexpd_c.c deleted file mode 100644 index 0a6f428819..0000000000 --- a/ext/spice/src/cspice/wnexpd_c.c +++ /dev/null @@ -1,191 +0,0 @@ -/* - --Procedure wnexpd_c ( Expand the intervals of a DP window ) - --Abstract - - Expand each of the intervals of a double precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void wnexpd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - left I Amount subtracted from each left endpoint. - right I Amount added to each right endpoint. - window I,O Window to be expanded. - --Detailed_Input - - left is the amount to be subtracted from the left - endpoint of each interval in the input window. - - right is the amount to be added to the right endpoint - of each interval in the window. - - window on input, is a window containing zero or more - intervals. - - window must be declared as a double precision - SpiceCell. - --Detailed_Output - - window on output, is the original window with each of its - intervals expanded by left units on the left and - right units on the right. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - None. - --Particulars - - This routine expands (lengthens) each of the intervals in - the input window. The adjustments are not necessarily symmetric. - That is, left units are subtracted from the left endpoint of - each interval, and right units are added to the right endpoint - of each interval, where left and right may be different. - - Intervals are merged when expansion causes them to overlap. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] - - Then the following series of calls - - wnexpd_c ( 2.0, 1.0, &window ); (1) - wnexpd_c ( -2.0, 2.0, &window ); (2) - wnexpd_c ( -2.0, -1.0, &window ); (3) - - produces the following series of windows - - [ -1, 4 ] [ 5, 12 ] [ 21, 30 ] (1) - [ 1, 6 ] [ 7, 14 ] [ 23, 32 ] (2) - [ 3, 5 ] [ 9, 13 ] [ 25, 31 ] (3) - - Note that intervals may be "expanded" by negative amounts. - In the example above, the second call shifts each interval to - the right, while the third call undoes the effect of the first - call (without restoring the merged intervals). - - Note also that the third call is exactly equivalent to the - call - - wncond_c ( 2, 1, &window ); - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - expand the intervals of a d.p. window - --& -*/ - -{ /* Begin wnexpd_c */ - - - /* - Use discovery check-in. - - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_DISCOVER, "wnexpd_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - /* - Let the f2c'd routine do the work. - */ - wnexpd_ ( (doublereal * ) &left, - (doublereal * ) &right, - (doublereal * ) (window->base) ); - - /* - Sync the output cell. - */ - zzsynccl_c ( F2C, window ); - - -} /* End wnexpd_c */ diff --git a/ext/spice/src/cspice/wnextd.c b/ext/spice/src/cspice/wnextd.c deleted file mode 100644 index 52cedc50cf..0000000000 --- a/ext/spice/src/cspice/wnextd.c +++ /dev/null @@ -1,210 +0,0 @@ -/* wnextd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNEXTD ( Extract the endpoints from a DP window ) */ -/* Subroutine */ int wnextd_(char *side, doublereal *window, ftnlen side_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer card, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - , setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Extract the left or right endpoints from a double precision */ -/* window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIDE I Extract left ('L') or right ('R') endpoints. */ -/* WINDOW I,O Window to be extracted. */ - -/* $ Detailed_Input */ - -/* SIDE indicates whether the left or right endpoints of */ -/* the intervals in the window are to be extracted. */ - -/* 'L', 'l' Left endpoints. */ -/* 'R', 'r' Right endpoints. */ - -/* If SIDE is not recognized, the input window is */ -/* not changed. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the collection of singleton intervals */ -/* containing either the left or the right endpoints */ -/* of the intervals in the original window. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine replaces every interval in the input window with */ -/* the singleton interval containing one of the endpoints of the */ -/* interval. */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] */ - -/* Then the call */ - -/* CALL WNEXTD ( 'L', WINDOW ) */ - -/* produces the window */ - -/* [ 1, 1 ] [ 7, 7 ] [ 23, 23 ] [ 29, 29 ] */ - -/* And the call */ - -/* CALL WNEXTD ( 'R', WINDOW ) */ - -/* produces the window */ - -/* [ 3, 3 ] [ 11, 11 ] [ 27, 27 ] [ 29, 29 ] */ - -/* $ Exceptions */ - -/* 1) If the endpoint specification, SIDE, is not recognized, the */ -/* error SPICE(INVALIDENDPNTSPEC) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract the endpoints from a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. Error handling was added to */ -/* detect invalid endpoint specification. The previous version */ -/* did not signal an error if SIDE was not 'R', 'r', 'L', or 'l'. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNEXTD", (ftnlen)6); - } - -/* Get the cardinality of the window. (The size is not important; */ -/* this routine can't create any new intervals.) */ - - card = cardd_(window); - -/* Step through the window, keeping one endpoint from each interval. */ -/* For the sake of efficiency, we have separate loops for the two */ -/* possible values of SIDE. */ - - if (*(unsigned char *)side == 'L' || *(unsigned char *)side == 'l') { - i__1 = card; - for (i__ = 1; i__ <= i__1; i__ += 2) { - window[i__ + 6] = window[i__ + 5]; - } - } else if (*(unsigned char *)side == 'R' || *(unsigned char *)side == 'r') - { - i__1 = card; - for (i__ = 1; i__ <= i__1; i__ += 2) { - window[i__ + 5] = window[i__ + 6]; - } - } else { - setmsg_("SIDE was *.", (ftnlen)11); - errch_("*", side, (ftnlen)1, (ftnlen)1); - sigerr_("SPICE(INVALIDENDPNTSPEC)", (ftnlen)24); - } - chkout_("WNEXTD", (ftnlen)6); - return 0; -} /* wnextd_ */ - diff --git a/ext/spice/src/cspice/wnextd_c.c b/ext/spice/src/cspice/wnextd_c.c deleted file mode 100644 index 8f2734cba4..0000000000 --- a/ext/spice/src/cspice/wnextd_c.c +++ /dev/null @@ -1,189 +0,0 @@ -/* - --Procedure wnextd_c ( Extract the endpoints from a DP window ) - --Abstract - - Extract the left or right endpoints from a double precision - window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void wnextd_c ( SpiceChar side, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - side I Extract left ('L') or right ('R') endpoints. - window I,O Window to be extracted. - --Detailed_Input - - side indicates whether the left or right endpoints of - the intervals in the window are to be extracted. - - 'L', 'l' Left endpoints. - 'R', 'r' Right endpoints. - - If side is not recognized, the input window is - not changed. - - window on input, is a window containing zero or more intervals. - window must be declared as a double precision SpiceCell. - --Detailed_Output - - window on output, is the collection of singleton intervals - containing either the left or the right endpoints - of the intervals in the original window. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the endpoint specification side is not recognized, the - error SPICE(INVALIDENDPNTSPEC) is signaled. - --Files - - None. - --Particulars - - This routine replaces every interval in the input window with - the singleton interval containing one of the endpoints of the - interval. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] - - Then the call - - wnextd_c ( 'L', &window ); - - produces the window - - [ 1, 1 ] [ 7, 7 ] [ 23, 23 ] [ 29, 29 ] - - And the call - - wnextd_c ( 'R', &window ); - - produces the window - - [ 3, 3 ] [ 11, 11 ] [ 27, 27 ] [ 29, 29 ] - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - extract the endpoints from a d.p. window - --& -*/ - -{ /* Begin wnextd_c */ - - - /* - Participate in error tracing. - */ - if ( failed_c() ) - { - return; - } - chkin_c ( "wnextd_c" ); - - - /* - Make sure data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "wnextd_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - wnextd_ ( ( char * ) &side, - ( doublereal * ) window->base, - ( ftnlen ) 1 ); - - - /* - Note: we don't sync the cell because the size and cardinality - are unchanged. - */ - - chkout_c ( "wnextd_c" ); - -} /* End wnextd_c */ diff --git a/ext/spice/src/cspice/wnfetd.c b/ext/spice/src/cspice/wnfetd.c deleted file mode 100644 index 4e3ec8fbe7..0000000000 --- a/ext/spice/src/cspice/wnfetd.c +++ /dev/null @@ -1,186 +0,0 @@ -/* wnfetd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNFETD ( Fetch an interval from a DP window ) */ -/* Subroutine */ int wnfetd_(doublereal *window, integer *n, doublereal *left, - doublereal *right) -{ - integer card; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Fetch a particular interval from a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WINDOW I Input window. */ -/* N I Index of interval to be fetched. */ -/* LEFT, */ -/* RIGHT O Left, right endpoints of the Nth interval. */ - -/* $ Detailed_Input */ - -/* WINDOW is a window containing zero or more intervals. */ - -/* N is the index of a particular interval within the */ -/* window. Indices range from 1 to CARD(WINDOW)/2. */ - -/* $ Detailed_Output */ - -/* LEFT, */ -/* RIGHT are the left and right endpoints of the Nth interval */ -/* in the input window. If the interval is not found, */ -/* LEFT and RIGHT are not defined. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is less than one, the error SPICE(NOINTERVAL) signals. */ - -/* 2) If the interval does not exist, i.e. N > CARD(WINDOW)/2, the */ -/* error SPICE(NOINTERVAL) signals. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* This window has a cardinality of 6, so N may have */ -/* value 1, 2, or 3 ( N =< CARD(WINDOW)/2 ). */ - -/* Then the following calls */ - -/* CALL WNFETD ( A, 1, LEFT, RIGHT ) [1] */ -/* CALL WNFETD ( A, 2, LEFT, RIGHT ) [2] */ -/* CALL WNFETD ( A, 3, LEFT, RIGHT ) [3] */ - -/* yield the following values of LEFT and RIGHT */ - -/* LEFT RIGHT */ -/* --------- --------- */ -/* 1 3 */ -/* 7 11 */ -/* 23 27 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 30-JUL-2007 (EDW) */ - -/* Removed erroneous description in the Examples section */ -/* indicating "Undefined" as a return state after an error */ -/* event caused by an invalid value of N. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch an interval from a d.p. window */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Set up the error processing. */ - - if (return_()) { - return 0; - } - chkin_("WNFETD", (ftnlen)6); - - -/* How many endpoints in the window? Enough? Normally, endpoints */ -/* of the Nth interval are stored in elements 2N and 2N-1. */ - - card = cardd_(window); - end = *n << 1; - if (*n < 1 || card < end) { - setmsg_("WNFETD: No such interval.", (ftnlen)25); - sigerr_("SPICE(NOINTERVAL)", (ftnlen)17); - } else { - *left = window[end + 4]; - *right = window[end + 5]; - } - chkout_("WNFETD", (ftnlen)6); - return 0; -} /* wnfetd_ */ - diff --git a/ext/spice/src/cspice/wnfetd_c.c b/ext/spice/src/cspice/wnfetd_c.c deleted file mode 100644 index b933df65a5..0000000000 --- a/ext/spice/src/cspice/wnfetd_c.c +++ /dev/null @@ -1,200 +0,0 @@ -/* - --Procedure wnfetd_c ( Fetch an interval from a DP window ) - --Abstract - - Fetch a particular interval from a double precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void wnfetd_c ( SpiceCell * window, - SpiceInt n, - SpiceDouble * left, - SpiceDouble * right ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - window I Input window. - n I Index of interval to be fetched. - left, - right O Left, right endpoints of the nth interval. - --Detailed_Input - - window is a window containing zero or more intervals. - - window must be declared as a double precision SpiceCell. - - n is the index of a particular interval within the - window. Indices range from 0 to N-1, where N is the - number of intervals in the window. - --Detailed_Output - - left, - right are the left and right endpoints of the nth interval - in the input window. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) signals. - - 2) If n is less than zero, the error SPICE(NOINTERVAL) is - signaled. - - 3) If the interval does not exist, i.e., n >= card_c(&window)/2, - the error SPICE(NOINTERVAL) signals. - --Files - - None. - --Particulars - - None. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - This window has a cardinality of 6 ( N=3 intervals), so 'n' may have - value 0, 1, or 2, (n < cardinality/2) - - Then the following calls - - wnfetd_c ( &window, 0, &left, &right ); (1) - wnfetd_c ( &window, 1, &left, &right ); (2) - wnfetd_c ( &window, 2, &left, &right ); (3) - - yield the following values of left and right - - left right - --------- --------- - 1 3 - 7 11 - 23 27 - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.2, 30-JUL-2007 (EDW) - - Removed erroneous description in the Examples section - indicating "Undefined" as a return state after an error - event caused by an invalid value of n. - - -CSPICE Version 1.0.0, 22-AUG-2002 (NJB) (WLT) (IMU) - --Index_Entries - - fetch an interval from a d.p. window - --& -*/ - -{ /* Begin wnfetd_c */ - - - /* - Local variables - */ - SpiceInt fn; - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "wnfetd_c" ); - - - /* - Make sure the window's data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "wnfetd_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - /* - Map the index to a Fortran-style index. - */ - fn = n + 1; - - wnfetd_ ( ( doublereal * ) window->base, - ( integer * ) &fn, - ( doublereal * ) left, - ( doublereal * ) right ); - - - chkout_c ( "wnfetd_c" ); - -} /* End wnfetd_c */ diff --git a/ext/spice/src/cspice/wnfild.c b/ext/spice/src/cspice/wnfild.c deleted file mode 100644 index 44569035e5..0000000000 --- a/ext/spice/src/cspice/wnfild.c +++ /dev/null @@ -1,205 +0,0 @@ -/* wnfild.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNFILD ( Fill small gaps in a DP window ) */ -/* Subroutine */ int wnfild_(doublereal *small, doublereal *window) -{ - integer card, i__, j; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Fill small gaps between adjacent intervals of a double precision */ -/* window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SMALL I Limiting measure of small gaps. */ -/* WINDOW I,O Window to be filled. */ - -/* $ Detailed_Input */ - -/* SMALL is the limiting measure of the small gaps to be */ -/* filled. Adjacent intervals separated by gaps of */ -/* measure less than or equal to SMALL are merged. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the original window, after adjacent */ -/* intervals separated by small gaps have been merged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine removes small gaps between adjacent intervals */ -/* by merging intervals separated by gaps of measure less than */ -/* or equal to the limiting measure (SMALL). */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] */ - -/* Then the following series of calls */ - -/* CALL WNFILD ( 1, WINDOW ) (1) */ -/* CALL WNFILD ( 2, WINDOW ) (2) */ -/* CALL WNFILD ( 3, WINDOW ) (3) */ -/* CALL WNFILD ( 12, WINDOW ) (4) */ - -/* produces the following series of windows */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] (1) */ -/* [ 1, 3 ] [ 7, 11 ] [ 23, 29 ] (2) */ -/* [ 1, 3 ] [ 7, 11 ] [ 23, 29 ] (3) */ -/* [ 1, 29 ] (4) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.3, 29-JUL-2007 (NJB) */ - -/* Corrected typo in the previous Version line date string, */ -/* "29-JUL-20022" to "29-JUL-2002." */ - -/* - SPICELIB Version 1.0.2, 29-JUL-2002 (NJB) */ - -/* Changed gap size from 10 to 12 to correct erroneous example. */ - - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fill small gaps in a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNFILD", (ftnlen)6); - } - -/* Get the cardinality of the window. (The size is not important; */ -/* this routine can't create any new intervals.) */ - - card = cardd_(window); - -/* Step through the window, looking for the next right endpoint */ -/* more than SMALL away from the following left endpoint. This marks */ -/* the end of the new first interval, and the beginning of the new */ -/* second interval. Keep this up until the last right endpoint has */ -/* been reached. This remains the last right endpoint. */ - - if (card > 0) { - i__ = 2; - j = 2; - while(j < card) { - if (window[j + 5] + *small < window[j + 6]) { - window[i__ + 5] = window[j + 5]; - window[i__ + 6] = window[j + 6]; - i__ += 2; - } - j += 2; - } - window[i__ + 5] = window[j + 5]; - scardd_(&i__, window); - } - chkout_("WNFILD", (ftnlen)6); - return 0; -} /* wnfild_ */ - diff --git a/ext/spice/src/cspice/wnfild_c.c b/ext/spice/src/cspice/wnfild_c.c deleted file mode 100644 index fe11005c56..0000000000 --- a/ext/spice/src/cspice/wnfild_c.c +++ /dev/null @@ -1,180 +0,0 @@ -/* - --Procedure wnfild_c ( Fill small gaps in a DP window ) - --Abstract - - Fill small gaps between adjacent intervals of a double precision - window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - - void wnfild_c ( SpiceDouble small, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - small I Limiting measure of small gaps. - window I,O Window to be filled. - --Detailed_Input - - small is the limiting measure of the small gaps to be - filled. Adjacent intervals separated by gaps of - measure less than or equal to small are merged. - - window on input, is a window containing zero or more - intervals. - - window must be declared as a double precision SpiceCell. - --Detailed_Output - - window on output, is the original window, after adjacent - intervals separated by small gaps have been merged. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If small is less than or equal to zero, this routine has - no effect on the window. - --Files - - None. - --Particulars - - This routine removes small gaps between adjacent intervals - by merging intervals separated by gaps of measure less than - or equal to the limiting measure small. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] - - Then the following series of calls - - wnfild_c ( 1, &window ); (1) - wnfild_c ( 2, &window ); (2) - wnfild_c ( 3, &window ); (3) - wnfild_c ( 12, &window ); (4) - - produces the following series of windows - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] (1) - [ 1, 3 ] [ 7, 11 ] [ 23, 29 ] (2) - [ 1, 3 ] [ 7, 11 ] [ 23, 29 ] (3) - [ 1, 29 ] (4) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 27-JUL-2007 (EDW) - - Changed gap size in Examples (4) from 10 to 12 to correct - erroneous example. - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - fill small gaps in a d.p. window - --& -*/ - -{ /* Begin wnfild_c */ - - - /* - Use discovery check-in. - - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_DISCOVER, "wnfild_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - /* - Let the f2c'd routine do the work. - */ - wnfild_ ( (doublereal * ) &small, - (doublereal * ) (window->base) ); - - /* - Sync the output cell. - */ - zzsynccl_c ( F2C, window ); - - -} /* End wnfild_c */ diff --git a/ext/spice/src/cspice/wnfltd.c b/ext/spice/src/cspice/wnfltd.c deleted file mode 100644 index 8b4ff21070..0000000000 --- a/ext/spice/src/cspice/wnfltd.c +++ /dev/null @@ -1,185 +0,0 @@ -/* wnfltd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNFLTD ( Filter small intervals from a DP window ) */ -/* Subroutine */ int wnfltd_(doublereal *small, doublereal *window) -{ - integer card, i__, j; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Filter (remove) small intervals from a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SMALL I Limiting measure of small intervals. */ -/* WINDOW I,O Window to be filtered. */ - -/* $ Detailed_Input */ - -/* SMALL is the limiting measure of the small intervals to */ -/* be filtered. Intervals of measure less than or equal */ -/* to SMALL are removed from the window. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the original window, after small */ -/* intervals have been removed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine removes from the input window every interval with */ -/* measure less than or equal to the limiting measure (SMALL). */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] */ - -/* Then the following series of calls */ - -/* CALL WNFLTD ( 0, WINDOW ) (1) */ -/* CALL WNFLTD ( 2, WINDOW ) (2) */ -/* CALL WNFLTD ( 3, WINDOW ) (3) */ - -/* produces the following series of windows */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] (1) */ -/* [ 7, 11 ] [ 23, 27 ] (2) */ -/* [ 7, 11 ] [ 23, 27 ] (3) */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* filter small intervals from a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNFLTD", (ftnlen)6); - } - -/* Get the cardinality of the window. (The size is not important; */ -/* this routine can't create any new intervals.) */ - - card = cardd_(window); - -/* Step through the window, looking for the next interval big */ -/* enough to get stuck in the filter. Keep this up until the last */ -/* interval has been checked. */ - - i__ = 0; - j = 2; - while(j <= card) { - if (window[j + 5] - window[j + 4] > *small) { - i__ += 2; - window[i__ + 4] = window[j + 4]; - window[i__ + 5] = window[j + 5]; - } - j += 2; - } - scardd_(&i__, window); - chkout_("WNFLTD", (ftnlen)6); - return 0; -} /* wnfltd_ */ - diff --git a/ext/spice/src/cspice/wnfltd_c.c b/ext/spice/src/cspice/wnfltd_c.c deleted file mode 100644 index 961e16127a..0000000000 --- a/ext/spice/src/cspice/wnfltd_c.c +++ /dev/null @@ -1,166 +0,0 @@ -/* - --Procedure wnfltd_c ( Filter small intervals from a DP window ) - --Abstract - - Filter (remove) small intervals from a double precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wnfltd_c ( SpiceDouble small, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - small I Limiting measure of small intervals. - window I,O Window to be filtered. - --Detailed_Input - - small is the limiting measure of the small intervals to - be filtered. Intervals of measure less than or equal - to small are removed from the window. - - window on input, is a window containing zero or more - intervals. window must be declared as a double precision - SpiceCell. - --Detailed_Output - - window on output, is the original window, after small - intervals have been removed. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If small is less than or equal to zero, this routine has - no effect on the window. - --Files - - None. - --Particulars - - This routine removes from the input window every interval with - measure less than or equal to the limiting measure (small). - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] [ 29, 29 ] - - Then the following series of calls - - wnfltd_c ( 0, &window ); (1) - wnfltd_c ( 2, &window ); (2) - wnfltd_c ( 3, &window ); (3) - - produces the following series of windows - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] (1) - [ 7, 11 ] [ 23, 27 ] (2) - [ 7, 11 ] [ 23, 27 ] (3) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 21-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - filter small intervals from a d.p. window - --& -*/ - -{ /* Begin wnfltd_c */ - - - /* - Use discovery check-in. - - Make sure data type is d.p. - */ - CELLTYPECHK ( CHK_DISCOVER, "wnfltd_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - wnfltd_ ( ( doublereal * ) &small, - ( doublereal * ) window->base ); - - /* - Sync the output cell. - */ - zzsynccl_c ( F2C, window ); - - -} /* End wnfltd_c */ diff --git a/ext/spice/src/cspice/wnincd.c b/ext/spice/src/cspice/wnincd.c deleted file mode 100644 index 397a2290f0..0000000000 --- a/ext/spice/src/cspice/wnincd.c +++ /dev/null @@ -1,202 +0,0 @@ -/* wnincd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNINCD ( Included in a double precision window ) */ -logical wnincd_(doublereal *left, doublereal *right, doublereal *window) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - integer card, i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Determine whether an interval is included in a double precision */ -/* window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LEFT, */ -/* RIGHT I Input interval. */ -/* WINDOW I Input window. */ - -/* The function returns TRUE if POINT is an element of WINDOW. */ - -/* $ Detailed_Input */ - -/* LEFT, */ -/* RIGHT are the endpoints of an interval, which may or */ -/* may not be contained in one of the intervals in */ -/* WINDOW. */ - -/* WINDOW is a window containing zero or more intervals. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if the input interval is included */ -/* in the input window---that is, if */ - -/* a(i) < LEFT < RIGHT < b(i) */ -/* - - - */ - -/* for some interval [ a(i), b(i) ] in WINDOW---and */ -/* is false otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Then the following expressions are true */ - -/* WNINCD ( 1.D0, 3.D0, WINDOW ) */ -/* WNINCD ( 9.D0, 10.D0, WINDOW ) */ - -/* and the following expressions are false. */ - -/* WNINCD ( 0, 2, WINDOW ) */ -/* WNINCD ( 13, 15, WINDOW ) */ -/* WNINCD ( 29, 30, WINDOW ) */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* If the value of the function RETURN is TRUE upon execution of */ -/* this module, this function is assigned a default value of */ -/* either 0, 0.0D0, .FALSE., or blank depending on the type of */ -/* the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* included in a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("WNINCD", (ftnlen)6); - } - -/* How many endpoints in the window? */ - - card = cardd_(window); - -/* Check this interval agains every interval in the window. */ -/* Inefficient, but foolproof. */ - - i__1 = card; - for (i__ = 1; i__ <= i__1; i__ += 2) { - if (*left >= window[i__ + 5] && *right <= window[i__ + 6]) { - ret_val = TRUE_; - chkout_("WNINCD", (ftnlen)6); - return ret_val; - } - } - ret_val = FALSE_; - chkout_("WNINCD", (ftnlen)6); - return ret_val; -} /* wnincd_ */ - diff --git a/ext/spice/src/cspice/wnincd_c.c b/ext/spice/src/cspice/wnincd_c.c deleted file mode 100644 index 72e3f8e5ea..0000000000 --- a/ext/spice/src/cspice/wnincd_c.c +++ /dev/null @@ -1,173 +0,0 @@ -/* - --Procedure wnincd_c ( Included in a double precision window ) - --Abstract - - Determine whether an interval is included in a double precision - window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceBoolean wnincd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - left, - right I Input interval. - window I Input window. - - The function returns SPICETRUE if the input interval is included in - ---is a subset of some interval in---window. - --Detailed_Input - - left, - right are the endpoints of an interval, which may or - may not be contained in one of the intervals in - window. - - window is a CSPICE window containing zero or more intervals. - - window must be declared as a double precision SPICECELL. - --Detailed_Output - - The function returns SPICETRUE if the input interval is included - in the input window---that is, if - - a(i) < left < right < b(i) - - - - - - for some interval [ a(i), b(i) ] in window---and is SPICEFALSE - otherwise. - --Parameters - - None. - --Exceptions - - 1) If the input window is a SpiceCell of type other than double - precision, the error SPICE(TYPEMISMATCH) is signaled. - --Files - - None. - --Particulars - - None. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - Then the following expressions are SPICETRUE - - wnincd_c ( 1.0, 3.0, &window ); - wnincd_c ( 9.0, 10.0, &window ); - - and the following expressions are SPICEFALSE. - - wnincd_c ( 0.0, 2.0, &window ); - wnincd_c ( 13.0, 15.0, &window ); - wnincd_c ( 29.0, 30.0, &window ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - included in a d.p. window - --& -*/ - -{ /* Begin wnincd_c */ - - - /* - Use discovery check-in. - - Make sure cell data type is d.p. - */ - CELLTYPECHK_VAL ( CHK_DISCOVER, - "wnincd_c", SPICE_DP, window, SPICEFALSE ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - /* - Let the f2c'd routine do the work. - */ - return ( (SpiceBoolean) wnincd_ ( (doublereal *) &left, - (doublereal *) &right, - (doublereal *) (window->base) ) ); - -} /* End wnincd_c */ diff --git a/ext/spice/src/cspice/wninsd.c b/ext/spice/src/cspice/wninsd.c deleted file mode 100644 index ec211f1d65..0000000000 --- a/ext/spice/src/cspice/wninsd.c +++ /dev/null @@ -1,371 +0,0 @@ -/* wninsd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure WNINSD ( Insert an interval into a DP window ) */ -/* Subroutine */ int wninsd_(doublereal *left, doublereal *right, doublereal * - window) -{ - /* System generated locals */ - integer i__1; - doublereal d__1, d__2; - - /* Local variables */ - integer card, size, i__, j; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), excess_( - integer *, char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Insert an interval into a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LEFT, */ -/* RIGHT I Left, right endpoints of new interval. */ -/* WINDOW I,O Input, output window. */ - -/* $ Detailed_Input */ - -/* LEFT, */ -/* RIGHT are the left and right endpoints of the interval */ -/* to be inserted. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the original window following the */ -/* insertion of the interval from LEFT to RIGHT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine inserts the interval from LEFT to RIGHT into the */ -/* input window. If the new interval overlaps any of the intervals */ -/* in the window, the intervals are merged. Thus, the cardinality */ -/* of the input window can actually decrease as the result of an */ -/* insertion. However, because inserting an interval that is */ -/* disjoint from the other intervals in the window can increase the */ -/* cardinality of the window, the routine signals an error. */ - -/* This is the only unary routine to signal an error. No */ -/* other unary routine can increase the number of intervals in */ -/* the input window. */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Then the following series of calls */ - -/* CALL WNINSD ( 5, 5, WINDOW ) (1) */ -/* CALL WNINSD ( 4, 8, WINDOW ) (2) */ -/* CALL WNINSD ( 0, 30, WINDOW ) (3) */ - -/* produces the following series of windows */ - -/* [ 1, 3 ] [ 5, 5 ] [ 7, 11 ] [ 23, 27 ] (1) */ -/* [ 1, 3 ] [ 4, 11 ] [ 23, 27 ] (2) */ -/* [ 0, 30 ] (3) */ - -/* $ Exceptions */ - -/* 1) If LEFT is greater than RIGHT, the error SPICE(BADENDPOINTS) is */ -/* signalled. */ - -/* 2) If the insertion of the interval causes an excess of elements, */ -/* the error SPICE(WINDOWEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.3.0, 04-MAR-1993 (KRG) */ - -/* There was a bug when moving the intervals in the cell */ -/* to the right when inserting a new interval to the left */ -/* of the left most interval. the incrementing in the DO */ -/* loop was incorrect. */ - -/* The loop used to read: */ - -/* DO J = I-1, CARD */ -/* WINDOW(J+2) = WINDOW(J) */ -/* END DO */ - -/* which squashed everything to the right of the first interval */ -/* with the values of the first interval. */ - -/* The loop now reads: */ - -/* DO J = CARD, I-1, -1 */ -/* WINDOW(J+2) = WINDOW(J) */ -/* END DO */ - -/* which correctly scoots the elements in reverse order, */ -/* preserving their values. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* insert an interval into a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.3.0, 04-MAR-1993 (KRG) */ - -/* There was a bug when moving the intervals in the cell */ -/* to the right when inserting a new interval to the left */ -/* of the left most interval. the incrementing in the DO */ -/* loop was incorrect. */ - -/* The loop used to read: */ - -/* DO J = I-1, CARD */ -/* WINDOW(J+2) = WINDOW(J) */ -/* END DO */ - -/* which squashed everything to the right of the first interval */ -/* with the values of the first interval. */ - -/* The loop now reads: */ - -/* DO J = CARD, I-1, -1 */ -/* WINDOW(J+2) = WINDOW(J) */ -/* END DO */ - -/* which correctly scoots the elements in reverse order, */ -/* preserving their values. */ - -/* - Beta Version 1.2.0, 27-FEB-1989 (HAN) */ - -/* Due to the calling sequence and functionality changes */ -/* in the routine EXCESS, the method of signalling an */ -/* excess of elements needed to be changed. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Required_Reading section was */ -/* changed from "None." to "WINDOWS". Also, the */ -/* declaration of the unused variable K was removed. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNINSD", (ftnlen)6); - } - -/* Get the size and cardinality of the window. */ - - size = sized_(window); - card = cardd_(window); - -/* Let's try the easy cases first. No input interval? No change. */ -/* Signal that an error has occurred and set the error message. */ - - if (*left > *right) { - setmsg_("Left endpoint was *. Right endpoint was *.", (ftnlen)42); - errdp_("*", left, (ftnlen)1); - errdp_("*", right, (ftnlen)1); - sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19); - chkout_("WNINSD", (ftnlen)6); - return 0; - -/* Empty window? Input interval later than the end of the window? */ -/* Just insert the interval, if there's room. */ - - } else if (card == 0 || *left > window[card + 5]) { - if (size >= card + 2) { - i__1 = card + 2; - scardd_(&i__1, window); - window[card + 6] = *left; - window[card + 7] = *right; - } else { - excess_(&c__2, "window", (ftnlen)6); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - } - chkout_("WNINSD", (ftnlen)6); - return 0; - } - -/* Now on to the tougher cases. */ - -/* Skip intervals which lie completely to the left of the input */ -/* interval. (The index I will always point to the right endpoint */ -/* of an interval). */ - - i__ = 2; - while(i__ <= card && window[i__ + 5] < *left) { - i__ += 2; - } - -/* There are three ways this can go. The new interval can: */ - -/* 1) lie entirely between the previous interval and the next. */ - -/* 2) overlap the next interval, but no others. */ - -/* 3) overlap more than one interval. */ - -/* Only the first case can possibly cause an overflow, since the */ -/* other two cases require existing intervals to be merged. */ - - -/* Case (1). If there's room, move succeeding intervals back and */ -/* insert the new one. If there isn't room, signal an error. */ - - if (*right < window[i__ + 4]) { - if (size >= card + 2) { - i__1 = i__ - 1; - for (j = card; j >= i__1; --j) { - window[j + 7] = window[j + 5]; - } - i__1 = card + 2; - scardd_(&i__1, window); - window[i__ + 4] = *left; - window[i__ + 5] = *right; - } else { - excess_(&c__2, "window", (ftnlen)6); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - chkout_("WNINSD", (ftnlen)6); - return 0; - } - -/* Cases (2) and (3). */ - - } else { - -/* The left and right endpoints of the new interval may or */ -/* may not replace the left and right endpoints of the existing */ -/* interval. */ - -/* Computing MIN */ - d__1 = *left, d__2 = window[i__ + 4]; - window[i__ + 4] = min(d__1,d__2); -/* Computing MAX */ - d__1 = *right, d__2 = window[i__ + 5]; - window[i__ + 5] = max(d__1,d__2); - -/* Skip any intervals contained in the one we modified. */ -/* (Like I, J always points to the right endpoint of an */ -/* interval.) */ - - j = i__ + 2; - while(j <= card && window[j + 5] <= window[i__ + 5]) { - j += 2; - } - -/* If the modified interval extends into the next interval, */ -/* merge the two. (The modified interval grows to the right.) */ - - if (j <= card && window[i__ + 5] >= window[j + 4]) { - window[i__ + 5] = window[j + 5]; - j += 2; - } - -/* Move the rest of the intervals forward to take up the */ -/* spaces left by the absorbed intervals. */ - - while(j <= card) { - i__ += 2; - window[i__ + 4] = window[j + 4]; - window[i__ + 5] = window[j + 5]; - j += 2; - } - scardd_(&i__, window); - } - chkout_("WNINSD", (ftnlen)6); - return 0; -} /* wninsd_ */ - diff --git a/ext/spice/src/cspice/wninsd_c.c b/ext/spice/src/cspice/wninsd_c.c deleted file mode 100644 index 2d6df4d365..0000000000 --- a/ext/spice/src/cspice/wninsd_c.c +++ /dev/null @@ -1,200 +0,0 @@ -/* - --Procedure wninsd_c ( Insert an interval into a DP window ) - --Abstract - - Insert an interval into a double precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wninsd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - left, - right I Left, right endpoints of new interval. - window I,O Input, output window. - --Detailed_Input - - left, - right are the left and right endpoints of the interval - to be inserted. - - window on input, is a CSPICE window containing zero or more - intervals. - - window must be declared as a double precision - SpiceCell. - --Detailed_Output - - window on output, is the original window following the - insertion of the interval from left to right. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If left is greater than right, the error SPICE(BADENDPOINTS) is - signaled. - - 3) If the insertion of the interval causes an excess of elements, - the error SPICE(WINDOWEXCESS) is signaled. - --Files - - None. - --Particulars - - This routine inserts the interval from left to right into the - input window. If the new interval overlaps any of the intervals - in the window, the intervals are merged. Thus, the cardinality - of the input window can actually decrease as the result of an - insertion. However, because inserting an interval that is - disjoint from the other intervals in the window can increase the - cardinality of the window, the routine signals an error. - - No other CSPICE unary window routine can increase the number of - intervals in the input window. - --Examples - - Let window contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - Then the following series of calls - - wninsd_c ( 5.0, 5.0, &window ) (1) - wninsd_c ( 4.0, 8.0, &window ) (2) - wninsd_c ( 0.0, 30.0, &window ) (3) - - produces the following series of windows - - [ 1, 3 ] [ 5, 5 ] [ 7, 11 ] [ 23, 27 ] (1) - [ 1, 3 ] [ 4, 11 ] [ 23, 27 ] (2) - [ 0, 30 ] (3) - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (KRG) (HAN) (WLT) (IMU) - --Index_Entries - - insert an interval into a d.p. window - --& -*/ - -{ /* Begin wninsd_c */ - - - /* - Standard SPICE error handling. - */ - - if ( return_c() ) - { - return; - } - chkin_c ( "wninsd_c" ); - - - /* - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "wninsd_c", SPICE_DP, window ); - - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - - /* - Let the f2c'd routine do the work. - */ - wninsd_ ( (doublereal * ) &left, - (doublereal * ) &right, - (doublereal * ) (window->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, window ); - } - - - chkout_c ( "wninsd_c" ); - -} /* End wninsd_c */ diff --git a/ext/spice/src/cspice/wnintd.c b/ext/spice/src/cspice/wnintd.c deleted file mode 100644 index a6f1a1267a..0000000000 --- a/ext/spice/src/cspice/wnintd.c +++ /dev/null @@ -1,260 +0,0 @@ -/* wnintd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNINTD ( Intersect two DP windows ) */ -/* Subroutine */ int wnintd_(doublereal *a, doublereal *b, doublereal *c__) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - integer over, acard, bcard; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - integer ap, bp, cp; - extern /* Subroutine */ int scardd_(integer *, doublereal *), excess_( - integer *, char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen); - extern logical return_(void); - char use[1]; - -/* $ Abstract */ - -/* Place the intersection of two double precision windows into */ -/* a third window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A, */ -/* B I Input windows. */ -/* C I Intersection of A and B. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are windows, each of which contains zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* C is the output window, containing the intersection */ -/* of A and B---every point contained in both A and B. */ - -/* C must be distinct from both A and B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The intersection of two windows contains every point contained */ -/* both in the first window and in the second window. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* and B contain the intervals */ - -/* [ 2, 4 ] [ 8, 10 ] [ 16, 18 ] */ - -/* Then the intersection of A and B contains the intervals */ - -/* [ 2, 3 ] [ 8, 10 ] */ - -/* $ Exceptions */ - -/* 1. If the intersection of the two windows results in an excess of */ -/* elements, the error SPICE(WINDOWEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* intersect two d.p. windows */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) */ - -/* Due to the calling sequence and functionality changes */ -/* in the routine EXCESS, the method of signalling an */ -/* excess of elements needed to be changed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNINTD", (ftnlen)6); - } - -/* Find the cardinality of the input windows, and the allowed size */ -/* of the output window. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input windows. The initial cardinality of the output window */ -/* is zero. And there is no overflow so far. */ - -/* (Note that AP and BP point to the LEFT endpoints of intervals */ -/* in A and B, while CP points to the RIGHT endpoint of the latest */ -/* interval in C.) */ - - ap = 1; - bp = 1; - cp = 0; - over = 0; - -/* When the end of either input window is reached, we're done. */ - - while(ap < acard && bp < bcard) { - -/* Let's see what we can do with the earlier of the next */ -/* intervals from A and B. */ - - if (a[ap + 6] < b[bp + 6]) { - *(unsigned char *)use = 'A'; - } else if (b[bp + 6] <= a[ap + 6]) { - *(unsigned char *)use = 'B'; - } - -/* If there is still space in the output window, fill it */ -/* as necessary. Otherwise, stop filling the array, but continue */ -/* to count the number of elements in excess of the size of the */ -/* output window. */ - -/* The general idea is this: if the next interval of A overlaps */ -/* the next interval of B, save the area of overlap. (Similarly */ -/* for B.) */ - - if (*(unsigned char *)use == 'A') { - if (a[ap + 6] >= b[bp + 5]) { - if (cp < csize) { - cp += 2; -/* Computing MAX */ - d__1 = b[bp + 5], d__2 = a[ap + 5]; - c__[cp + 4] = max(d__1,d__2); - c__[cp + 5] = a[ap + 6]; - } else { - over += 2; - } - } - ap += 2; - -/* This is the same as the last clause, with B replacing A. */ - - } else if (*(unsigned char *)use == 'B') { - if (b[bp + 6] >= a[ap + 5]) { - if (cp < csize) { - cp += 2; -/* Computing MAX */ - d__1 = a[ap + 5], d__2 = b[bp + 5]; - c__[cp + 4] = max(d__1,d__2); - c__[cp + 5] = b[bp + 6]; - } else { - over += 2; - } - } - bp += 2; - } - } - -/* Set the cardinality of the output window. */ - - scardd_(&cp, c__); - -/* If there are any excess elements, signal an error and check out */ -/* as usual. */ - - if (over > 0) { - excess_(&over, "window", (ftnlen)6); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - } - chkout_("WNINTD", (ftnlen)6); - return 0; -} /* wnintd_ */ - diff --git a/ext/spice/src/cspice/wnintd_c.c b/ext/spice/src/cspice/wnintd_c.c deleted file mode 100644 index 698cf2fefb..0000000000 --- a/ext/spice/src/cspice/wnintd_c.c +++ /dev/null @@ -1,185 +0,0 @@ -/* - --Procedure wnintd_c ( Intersect two DP windows ) - --Abstract - - Place the intersection of two double precision windows into - a third window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wnintd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a, - b I Input windows. - c I Intersection of a and b. - --Detailed_Input - - a, - b are CSPICE windows, each of which contains zero or more - intervals. - - a and b must be declared as double precision - SpiceCells. - --Detailed_Output - - c is the output CSPICE window, containing the intersection - of a and b---every point contained in both a and b. - - c must be declared as a double precision SpiceCell. - - c must be distinct from both a and b. - --Parameters - - None. - --Exceptions - - 1) If any of the function arguments are SpiceCells of type - other than double precision, the error SPICE(TYPEMISMATCH) - is signaled. - - 2) If the intersection of the two windows results in an excess of - elements, the error SPICE(WINDOWEXCESS) is signaled. - --Files - - None. - --Particulars - - The intersection of two windows contains every point contained - both in the first window and in the second window. - --Examples - - Let a contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - and b contain the intervals - - [ 2, 4 ] [ 8, 10 ] [ 16, 18 ] - - Then the intersection of a and b contains the intervals - - [ 2, 3 ] [ 8, 10 ] - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - intersect two d.p. windows - --& -*/ - -{ /* Begin wnintd_c */ - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "wnintd_c" ); - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK3 ( CHK_STANDARD, "wnintd_c", SPICE_DP, a, b, c ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - - /* - Let the f2c'd routine do the work. - */ - wnintd_ ( (doublereal * ) (a->base), - (doublereal * ) (b->base), - (doublereal * ) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - - chkout_c ( "wnintd_c" ); - -} /* End wnintd_c */ diff --git a/ext/spice/src/cspice/wnreld.c b/ext/spice/src/cspice/wnreld.c deleted file mode 100644 index 9a8bd38b75..0000000000 --- a/ext/spice/src/cspice/wnreld.c +++ /dev/null @@ -1,364 +0,0 @@ -/* wnreld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNRELD ( Compare two DP windows ) */ -logical wnreld_(doublereal *a, char *op, doublereal *b, ftnlen op_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, acard, bcard; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical equal; - extern logical wnincd_(doublereal *, doublereal *, doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - logical subset; - extern logical return_(void); - -/* $ Abstract */ - -/* Compare two double precision windows. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A I First window. */ -/* OP I Comparison operator. */ -/* B I Second window. */ - -/* The function returns the result of comparison: A (OP) B. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are windows, each of which contains zero or more */ -/* intervals. */ - -/* OP is a comparison operator, indicating the way in */ -/* which the input sets are to be compared. OP may */ -/* be any of the following: */ - -/* Operator Meaning */ -/* -------- ------------------------------------- */ -/* '=' A = B is true if A and B are equal */ -/* (contain the same intervals). */ - -/* '<>' A <> B is true if A and B are not */ -/* equal. */ - -/* '<=' A <= B is true if A is a subset of B. */ - -/* '<' A < B is true is A is a proper subset */ -/* of B. */ - -/* '>=' A >= B is true if B is a subset of A. */ - -/* '>' A > B is true if B is a proper subset */ -/* of A. */ - -/* $ Detailed_Output */ - -/* The function returns the result of the comparison. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This function is true whenever the specified relationship */ -/* between the input windows, A and B, is satisfied. For example, */ -/* the expression */ - -/* WNRELD ( NEEDED, '<=', AVAIL ) */ - -/* is true whenever the window NEEDED is a subset of the window */ -/* AVAIL. One window is a subset of another window if each of */ -/* the intervals in the first window is included in one of the */ -/* intervals in the second window. In addition, the first window */ -/* is a proper subset of the second if the second window contains */ -/* at least one point not contained in the first window. (Thus, */ -/* '<' implies '<=', and '>' implies '>='.) */ - -/* The following pairs of expressions are equivalent. */ - -/* WNRELD ( A, '>', B ) */ -/* WNRELD ( B, '<', A ) */ - -/* WNRELD ( A, '>=', B ) */ -/* WNRELD ( B, '<=', A ) */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Let B and C contain the intervals */ - -/* [ 1, 2 ] [ 9, 9 ] [ 24, 27 ] */ - -/* Let D contain the intervals */ - -/* [ 5, 10 ] [ 15, 25 ] */ - -/* Finally, let E and F be empty windows (containing no intervals). */ - -/* Because B and C contain the same intervals, */ - -/* WNRELD ( B, '=', C ) */ -/* WNRELD ( B, '<=', C ) */ -/* WNRELD ( B, '>=', C ) */ - -/* are all true, while */ - -/* WNRELD ( B, '<>', C ) */ - -/* is false. Because neither B nor C contains any points not also */ -/* contained by the other, neither is a proper subset of the other. */ -/* Thus, */ - -/* WNRELD ( B, '<', C ) */ -/* WNRELD ( B, '>', C ) */ - -/* are both false. */ - -/* Every point contained in B and C is also contained in A. Thus, */ - -/* WNRELD ( B, '<=', A ) */ -/* WNRELD ( A, '>=', C ) */ - -/* are both true. In addition, A contains points not contained in */ -/* B and C. (That is, the differences A-B and A-C are not empty.) */ -/* Thus, B and C are peoper subsets of A as well, and */ - -/* WNRELD ( B, '<', A ) */ -/* WNRELD ( A, '>', B ) */ - -/* are both true. */ - -/* Although A and D have points in common, neither contains the */ -/* other. Thus */ - -/* WNRELD ( A, '=', D ) */ -/* WNRELD ( A, '<=', D ) */ -/* WNRELD ( A, '>=', D ) */ - -/* are all false. */ - -/* In addition, any window is equal to itself, a subset of itself, */ -/* and a superset of itself. Thus, */ - -/* WNRELD ( A, '=', A ) */ -/* WNRELD ( A, '<=', A ) */ -/* WNRELD ( A, '>=', A ) */ - -/* are always true. However, no window is a proper subset or a */ -/* proper superset of itself. Thus, */ - -/* WNRELD ( A, '<', A ) */ -/* WNRELD ( A, '>', A ) */ - -/* are always false. */ - -/* Finally, an empty window is a a proper subset of any window */ -/* except another empty window. Thus, */ - -/* WNRELD ( E, '<', A ) */ - -/* is true, but */ - -/* WNRELD ( E, '<', F ) */ - -/* is false. */ - -/* $ Exceptions */ - -/* If the relational operator is not recognized, the error */ -/* SPICE(INVALIDOPERATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ - -/* Set the default function value to either 0, 0.0D0, .FALSE., */ -/* or blank depending on the type of the function. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* compare two d.p. windows */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 2.0.0, 2-FEB-1989 (HAN) */ - -/* If the relational operator is not recognized, an error is */ -/* signalled. The previous version returned .FALSE. as the */ -/* function value, and no error was signalled. */ - -/* Also, the Required_Reading section has been changed to */ -/* include WINDOWS as the required reading for the module. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = FALSE_; - return ret_val; - } else { - chkin_("WNRELD", (ftnlen)6); - ret_val = FALSE_; - } - -/* Find the cardinality of the input windows. */ - - acard = cardd_(a); - bcard = cardd_(b); - -/* A and B are equal if they contain exactly the same intervals. */ -/* We need to know this for nearly every relationship, so find out */ -/* before going any further. */ - - if (acard != bcard) { - equal = FALSE_; - } else { - equal = TRUE_; - i__1 = acard; - for (i__ = 1; i__ <= i__1; ++i__) { - equal = equal && a[i__ + 5] == b[i__ + 5]; - } - } - -/* Simple equality and inequality are trivial at this point. */ - - if (s_cmp(op, "=", op_len, (ftnlen)1) == 0) { - ret_val = equal; - } else if (s_cmp(op, "<>", op_len, (ftnlen)2) == 0) { - ret_val = ! equal; - -/* Subsets are a little trickier. A is a subset of B if every */ -/* interval in A is included in B. In addition, A is a proper */ -/* subset if A and B are not equal. */ - - } else if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0 || s_cmp(op, "<", - op_len, (ftnlen)1) == 0) { - subset = TRUE_; - i__1 = acard; - for (i__ = 1; i__ <= i__1; i__ += 2) { - subset = subset && wnincd_(&a[i__ + 5], &a[i__ + 6], b); - } - if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0) { - ret_val = subset; - } else { - ret_val = subset && ! equal; - } - -/* A and B change places here... */ - - } else if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0 || s_cmp(op, ">", - op_len, (ftnlen)1) == 0) { - subset = TRUE_; - i__1 = bcard; - for (i__ = 1; i__ <= i__1; i__ += 2) { - subset = subset && wnincd_(&b[i__ + 5], &b[i__ + 6], a); - } - if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0) { - ret_val = subset; - } else { - ret_val = subset && ! equal; - } - -/* An unrecognized operator always fails. */ - - } else { - setmsg_("Relational operator, *, is not recognized.", (ftnlen)42); - errch_("*", op, (ftnlen)1, op_len); - sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23); - chkout_("WNRELD", (ftnlen)6); - return ret_val; - } - chkout_("WNRELD", (ftnlen)6); - return ret_val; -} /* wnreld_ */ - diff --git a/ext/spice/src/cspice/wnreld_c.c b/ext/spice/src/cspice/wnreld_c.c deleted file mode 100644 index 2754b2c864..0000000000 --- a/ext/spice/src/cspice/wnreld_c.c +++ /dev/null @@ -1,312 +0,0 @@ -/* - --Procedure wnreld_c ( Compare two DP windows ) - --Abstract - - Compare two double precision windows. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - SpiceBoolean wnreld_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a I First window. - op I Comparison operator. - b I Second window. - - The function returns the result of comparison: a (op) b. - --Detailed_Input - - a, - b are CSPICE windows, each of which contains zero or more - intervals. - - a and b must be declared as double precision SpiceCells. - - - op is a comparison operator, indicating the way in - which the input sets are to be compared. op may - be any of the following: - - Operator Meaning - -------- ------------------------------------- - "=" a = b is SPICETRUE if a and b are equal - (contain the same intervals). - - "<>" a <> b is SPICETRUE if a and b are not - equal. - - "<=" a <= b is SPICETRUE if a is a subset of b. - - "<" a < b is SPICETRUE is a is a proper subset - of b. - - ">=" a >= b is SPICETRUE if b is a subset of a. - - ">" a > b is SPICETRUE if b is a proper subset - of a. - --Detailed_Output - - The function returns the result of the comparison. - --Parameters - - None. - --Exceptions - - 1) If any of the function arguments are SpiceCells of type - other than double precision, the error SPICE(TYPEMISMATCH) - is signaled. - - 2) If the relational operator is not recognized, the error - SPICE(INVALIDOPERATION) is signaled. - - 3) The error SPICE(EMPTYSTRING) is signaled if the input operator - string does not contain at least one character, since the - input string cannot be converted to a Fortran-style string - in this case. - - 4) The error SPICE(NULLPOINTER) is signalled if the input operator - string pointer is null. - --Files - - None. - --Particulars - - This function returns SPICETRUE whenever the specified relationship - between the input windows a and b is satisfied. For example, - the expression - - wnreld_c ( &needed, "<=", &avail ) - - is SPICETRUE whenever the window needed is a subset of the window - avail. One window is a subset of another window if each of - the intervals in the first window is included in one of the - intervals in the second window. In addition, the first window - is a proper subset of the second if the second window contains - at least one point not contained in the first window. (Thus, - "<" implies "<=", and ">" implies ">=".) - - The following pairs of expressions are equivalent. - - wnreld_c ( &a, ">", &b ); - wnreld_c ( &b, "<", &a ); - - wnreld_c ( &a, ">=", &b ); - wnreld_c ( &b, "<=", &a ); - --Examples - - Let a contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - Let b and c contain the intervals - - [ 1, 2 ] [ 9, 9 ] [ 24, 27 ] - - Let d contain the intervals - - [ 5, 10 ] [ 15, 25 ] - - Finally, let e and f be empty windows (containing no intervals). - - Because b and c contain the same intervals, - - wnreld_c ( &b, "=", &c ) - wnreld_c ( &b, "<=", &c ) - wnreld_c ( &b, ">=", &c ) - - are all SPICETRUE, while - - wnreld_c ( &b, "<>", &c ) - - is SPICEFALSE. Because neither b nor c contains any points not also - contained by the other, neither is a proper subset of the other. - Thus, - - wnreld_c ( &b, "<", &c ) - wnreld_c ( &b, ">", &c ) - - are both SPICEFALSE. - - Every point contained in b and c is also contained in a. Thus, - - wnreld_c ( &b, "<=", &a ) - wnreld_c ( &a, ">=", &c ) - - are both SPICETRUE. In addition, a contains points not contained in - b and c. (That is, the differences a-b and a-c are not empty.) - Thus, b and c are peoper subsets of a as well, and - - wnreld_c ( &b, "<", &a ) - wnreld_c ( &a, ">", &b ) - - are both SPICETRUE. - - Although a and d have points in common, neither contains the - other. Thus - - wnreld_c ( &a, "=", &d ) - wnreld_c ( &a, "<=", &d ) - wnreld_c ( &a, ">=", &d ) - - are all SPICEFALSE. - - In addition, any window is equal to itself, a subset of itself, - and a superset of itself. Thus, - - wnreld_c ( &a, "=", &a ) - wnreld_c ( &a, "<=", &a ) - wnreld_c ( &a, ">=", &a ) - - are always SPICETRUE. However, no window is a proper subset or a - proper superset of itself. Thus, - - wnreld_c ( &a, "<", &a ) - wnreld_c ( &a, ">", &a ) - - are always SPICEFALSE. - - Finally, an empty window is a proper subset of any window - except another empty window. Thus, - - wnreld_c ( &e, "<", &a ) - - is SPICETRUE, but - - wnreld_c ( &e, "<", &f ) - - is SPICEFALSE. - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 27-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - compare two d.p. windows - --& -*/ - -{ /* Begin wnreld_c */ - - /* - Local variables - */ - SpiceBoolean retval; - - - - /* - Participate in error tracing. - */ - if ( failed_c() ) - { - return ( SPICEFALSE ); - } - chkin_c ( "wnreld_c" ); - - - /* - Check the input string str to make sure the pointer is non-null - and the string length is non-zero. - */ - CHKFSTR_VAL ( CHK_STANDARD, "wnreld_c", op, SPICEFALSE ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK2_VAL ( CHK_STANDARD, - "wnreld_c", SPICE_DP, a, b, SPICEFALSE ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT2 ( a, b ); - - - /* - Let the f2c'd routine do the work. - */ - retval = wnreld_ ( (doublereal * ) (a->base), - (char * ) op, - (doublereal * ) (b->base), - (ftnlen ) strlen(op) ); - - - chkout_c ( "wnreld_c" ); - - return ( retval ); - -} /* End wnreld_c */ diff --git a/ext/spice/src/cspice/wnsumd.c b/ext/spice/src/cspice/wnsumd.c deleted file mode 100644 index 63d04e9557..0000000000 --- a/ext/spice/src/cspice/wnsumd.c +++ /dev/null @@ -1,292 +0,0 @@ -/* wnsumd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNSUMD ( Summary of a double precision window ) */ -/* Subroutine */ int wnsumd_(doublereal *window, doublereal *meas, doublereal - *avg, doublereal *stddev, integer *short__, integer *long__) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - double sqrt(doublereal); - - /* Local variables */ - integer card; - extern logical even_(integer *); - integer i__; - extern integer cardd_(doublereal *); - doublereal m; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal mlong; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal mshort; - extern logical return_(void); - doublereal sumsqr, sum; - -/* $ Abstract */ - -/* Summarize the contents of a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WINDOW I Window to be summarized. */ -/* MEAS O Total measure of intervals in WINDOW. */ -/* AVG O Average measure. */ -/* STDDEV O Standard deviation. */ -/* SHORT, */ -/* LONG O Locations of shortest, longest intervals. */ - -/* $ Detailed_Input */ - -/* WINDOW is a window containing zero or more intervals. */ - -/* $ Detailed_Output */ - -/* MEAS is the total measure of the intervals in the input */ -/* window. This is just the sum of the measures of the */ -/* individual intervals. */ - -/* AVG is the average of the measures of the intervals in */ -/* the input window. */ - -/* STDDEV is the standard deviation of the measures of the */ -/* intervals in the input window. */ - -/* SHORT, */ -/* LONG are the locations of the shortest and longest */ -/* intervals in the input window. The shortest interval */ -/* is */ - -/* [ WINDOW(SHORT), WINDOW(SHORT+1) ] */ - -/* and the longest is */ - -/* [ WINDOW(LONG), WINDOW(LONG+1) ] */ - -/* SHORT and LONG are both zero if the input window */ -/* contains no intervals. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(INVALIDCARDINALITY) signals if WINDOW has odd */ -/* cardinality. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a summary of the input window, consisting */ -/* of the following items: */ - -/* - The measure of the window. */ - -/* - The average and standard deviation of the measures */ -/* of the individual intervals in the window. */ - -/* - The indices of the left endpoints of the shortest */ -/* and longest intervals in the window. */ - -/* All of these quantities are zero if the window contains no */ -/* intervals. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Let B contain the singleton intervals */ - -/* [ 2, 2 ] [ 9, 9 ] [ 27, 27 ] */ - -/* The measures of A and B are */ - -/* (3-1) + (11-7) + (27-23) = 10 */ - -/* and */ - -/* (2-2) + (9-9) + (27-27) = 0 */ - -/* respectively. Each window has three intervals; thus, the average */ -/* measures of the windows are 10/3 and 0. The standard deviations */ -/* are */ - -/* ---------------------------------------------- */ -/* | 2 2 2 */ -/* | (3-1) + (11-7) + (27-23) 2 1/2 */ -/* | --------------------------- - (10/3) = (8/9) */ -/* | 3 */ -/* \ | */ -/* \| */ - -/* and 0. Neither window has one "shortest" interval or "longest" */ -/* interval; so the first ones found are returned: SHORT and LONG */ -/* are 1 and 3 for A, 1 and 1 for B. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 25-FEB-2009 (EDW) */ - -/* Added error test to confirm input window has even cardinality. */ -/* Corrected section order to match NAIF standard. */ - -/* - SPICELIB Version 1.0.2, 29-JUL-2002 (NJB) */ - -/* Corrected error in example section: changed claimed value */ -/* of longest interval for window A from 2 to 3. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* summary of a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */ - -/* Added calls to CHKIN and CHKOUT. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - -/* Get the cardinality (number of endpoints) of the window. */ - - card = cardd_(window); - -/* Confirm evenness of CARD. */ - - if (! even_(&card)) { - chkin_("WNSUMD", (ftnlen)6); - setmsg_("Input window has odd cardinality. A valid SPICE window must" - " have even element cardinality.", (ftnlen)90); - sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25); - chkout_("WNSUMD", (ftnlen)6); - return 0; - } - -/* Trivial case: no intervals. Return all zeros. */ - - if (card == 0) { - *meas = 0.; - *avg = 0.; - *stddev = 0.; - *short__ = 0; - *long__ = 0; - -/* Collect the sum of the measures and the squares of the measures */ -/* for each of the intervals in the window. At the same time, keep */ -/* track of the shortest and longest intervals encountered. */ - - } else { - sum = 0.; - sumsqr = 0.; - *short__ = 1; - mshort = window[7] - window[6]; - *long__ = 1; - mlong = window[7] - window[6]; - i__1 = card; - for (i__ = 1; i__ <= i__1; i__ += 2) { - m = window[i__ + 6] - window[i__ + 5]; - sum += m; - sumsqr += m * m; - if (m < mshort) { - *short__ = i__; - mshort = m; - } - if (m > mlong) { - *long__ = i__; - mlong = m; - } - } - -/* The envelope please? */ - - *meas = sum; - *avg = *meas * 2. / (doublereal) card; - *stddev = sqrt(sumsqr * 2. / (doublereal) card - *avg * *avg); - } - return 0; -} /* wnsumd_ */ - diff --git a/ext/spice/src/cspice/wnsumd_c.c b/ext/spice/src/cspice/wnsumd_c.c deleted file mode 100644 index 0342b42aad..0000000000 --- a/ext/spice/src/cspice/wnsumd_c.c +++ /dev/null @@ -1,233 +0,0 @@ -/* - --Procedure wnsumd_c ( Summary of a double precision window ) - --Abstract - - Summarize the contents of a double precision window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wnsumd_c ( SpiceCell * window, - SpiceDouble * meas, - SpiceDouble * avg, - SpiceDouble * stddev, - SpiceInt * shortest, - SpiceInt * longest ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - window I Window to be summarized. - meas O Total measure of intervals in window. - avg O Average measure. - stddev O Standard deviation. - shortest, - longest O Locations of shortest, longest intervals. - --Detailed_Input - - window is a window containing zero or more intervals. - - window must be declared as a double precision SpiceCell. - --Detailed_Output - - meas is the total measure of the intervals in the input - window. This is just the sum of the measures of the - individual intervals. - - avg is the average of the measures of the intervals in - the input window. - - stddev is the standard deviation of the measures of the - intervals in the input window. - - shortest, - longest are the locations of the shortest and longest - intervals in the input window. The shortest interval - is - - [ SPICE_CELL_ELEM_D( window, shortest ), - SPICE_CELL_ELEM_D( window, shortest+1 ) ] - - and the longest is - - [ SPICE_CELL_ELEM_D( window, longest ), - SPICE_CELL_ELEM_D( window, longest+1 ) ] - - shortest and longest are both zero if the input window - contains no intervals. - - If window contains multiple intervals having the shortest - length, shortest is the index of the first such interval. - Likewise for the longest length. - - Indices range from 0 to N-1, where N is the number of - intervals in the window. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - --Files - - None. - --Particulars - - This routine provides a summary of the input window, consisting - of the following items: - - - The measure of the window. - - - The average and standard deviation of the measures - of the individual intervals in the window. - - - The indices of the left endpoints of the shortest - and longest intervals in the window. - - All of these quantities are zero if the window contains no - intervals. - --Examples - - Let a contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - Let b contain the singleton intervals - - [ 2, 2 ] [ 9, 9 ] [ 27, 27 ] - - The measures of a and b are - - (3-1) + (11-7) + (27-23) = 10 - - and - - (2-2) + (9-9) + (27-27) = 0 - - respectively. Each window has three intervals; thus, the average - measures of the windows are 10/3 and 0. The standard deviations - are - - ---------------------------------------------- - | 2 2 2 - | (3-1) + (11-7) + (27-23) 2 1/2 - | --------------------------- - (10/3) = (8/9) - | 3 - \ | - \| - - and 0. Neither window has one "shortest" interval or "longest" - interval; so the first ones found are returned: shortest and longest - are 0 and 2 for a, 0 and 0 for b. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.1, 27-JAN-2009 (EDW) - - Corrected argument names shown in Brief I/O list. - "short" to "shortest"; "long" to "longest". - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - summary of a d.p. window - --& -*/ - -{ /* Begin wnsumd_c */ - - - /* - Use discovery check-in. - - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_DISCOVER, "wnsumd_c", SPICE_DP, window ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - /* - Let the f2c'd routine do the work. - */ - wnsumd_ ( (doublereal * ) (window->base), - (doublereal * ) meas, - (doublereal * ) avg, - (doublereal * ) stddev, - (integer * ) shortest, - (integer * ) longest ); - - /* - Map shortest and longest from Fortran style to C style indices. - */ - (*shortest) --; - (*longest ) --; - -} /* End wnsumd_c */ diff --git a/ext/spice/src/cspice/wnunid.c b/ext/spice/src/cspice/wnunid.c deleted file mode 100644 index 9776e59f21..0000000000 --- a/ext/spice/src/cspice/wnunid.c +++ /dev/null @@ -1,298 +0,0 @@ -/* wnunid.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WNUNID ( Union two DP windows ) */ -/* Subroutine */ int wnunid_(doublereal *a, doublereal *b, doublereal *c__) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - integer over, acard, bcard; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer csize; - extern integer sized_(doublereal *); - integer ap, bp, cp; - extern /* Subroutine */ int scardd_(integer *, doublereal *), excess_( - integer *, char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen); - extern logical return_(void); - doublereal end; - char use[1]; - -/* $ Abstract */ - -/* Place the union of two double precision windows into a third */ -/* window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* A, */ -/* B I Input windows. */ -/* C I Union of A and B. */ - -/* $ Detailed_Input */ - -/* A, */ -/* B are windows, each of which contains zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* C is the output window, containing the union of */ -/* A and B---every point contained in A, or in B, */ -/* or in both. */ - -/* C must be distinct from both A and B. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The union of two windows contains every point contained in the */ -/* first window, or the second window, or both. */ - -/* $ Examples */ - -/* Let A contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* and B contain the intervals */ - -/* [ 2, 6 ] [ 8, 10 ] [ 16, 18 ] */ - -/* Then the union of A and B contains the intervals */ - -/* [ 1, 6 ] [ 7, 11 ] [ 16, 18 ] [ 23, 27 ] */ - -/* $ Exceptions */ - -/* 1. If the union of the two windows results in an excess of */ -/* elements, the error SPICE(WINDOWEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 8-FEB-1999 (WLT) */ - -/* The variable END was not initialized in the previous */ -/* edition. It is now initialized to be the minimum of */ -/* A(1) and B(1). */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* union two d.p. windows */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) */ - -/* Due to the calling sequence and functionality changes */ -/* in the routine EXCESS, the method of signalling an */ -/* excess of elements needed to be changed. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WNUNID", (ftnlen)6); - } - -/* Find the cardinality of the input windows, and the allowed size */ -/* of the output window. */ - - acard = cardd_(a); - bcard = cardd_(b); - csize = sized_(c__); - -/* Begin with the input pointers at the first elements of the */ -/* input windows. The initial cardinality of the output window */ -/* is zero. And there is no overflow so far. */ - -/* (Note that AP and BP point to the LEFT endpoints of intervals */ -/* in A and B, while CP points to the RIGHT endpoint of the latest */ -/* interval in C.) */ - - ap = 1; - bp = 1; - cp = 0; - end = min(a[6],b[6]); - over = 0; - -/* When the ends of both input windows are reached, we're done. */ - - while(ap < acard || bp < bcard) { - -/* If the end of one window has been reached, copy (or merge) */ -/* the next interval from the other window. */ - - if (ap > acard) { - *(unsigned char *)use = 'B'; - } else if (bp > bcard) { - *(unsigned char *)use = 'A'; - -/* Otherwise, let's see what we can do with the earlier of */ -/* the next intervals from A and B. */ - - } else if (a[ap + 5] < b[bp + 5]) { - *(unsigned char *)use = 'A'; - } else if (b[bp + 5] <= a[ap + 5]) { - *(unsigned char *)use = 'B'; - } - -/* If there is still space in the output window, fill it */ -/* as necessary. Otherwise, stop filling the array, but continue */ -/* to count the number of elements in excess of the size of the */ -/* output window. */ - -/* The general idea is this: if the next interval overlaps the */ -/* latest output interval, merge the two (extending the output */ -/* interval to the right). Otherwise, insert the next interval */ -/* intact. */ - - if (*(unsigned char *)use == 'A') { - if (cp < csize) { - if (a[ap + 5] <= end && cp > 0) { -/* Computing MAX */ - d__1 = c__[cp + 5], d__2 = a[ap + 6]; - c__[cp + 5] = max(d__1,d__2); - } else { - cp += 2; - c__[cp + 4] = a[ap + 5]; - c__[cp + 5] = a[ap + 6]; - } - end = c__[cp + 5]; - } else { - if (a[ap + 5] <= end) { -/* Computing MAX */ - d__1 = end, d__2 = a[ap + 6]; - end = max(d__1,d__2); - } else { - over += 2; - end = a[ap + 6]; - } - } - ap += 2; - -/* This is the same as the last clause, with B replacing A. */ - - } else if (*(unsigned char *)use == 'B') { - if (cp < csize) { - if (b[bp + 5] <= end && cp > 0) { -/* Computing MAX */ - d__1 = c__[cp + 5], d__2 = b[bp + 6]; - c__[cp + 5] = max(d__1,d__2); - } else { - cp += 2; - c__[cp + 4] = b[bp + 5]; - c__[cp + 5] = b[bp + 6]; - } - end = c__[cp + 5]; - } else { - if (b[bp + 5] <= end) { -/* Computing MAX */ - d__1 = end, d__2 = b[bp + 6]; - end = max(d__1,d__2); - } else { - over += 2; - end = b[bp + 6]; - } - } - bp += 2; - } - } - -/* Set the cardinality of the output window. */ - - scardd_(&cp, c__); - -/* If there is an excess of elements, signal an error and check out */ -/* as usual. */ - - if (over > 0) { - excess_(&over, "window", (ftnlen)6); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - } - chkout_("WNUNID", (ftnlen)6); - return 0; -} /* wnunid_ */ - diff --git a/ext/spice/src/cspice/wnunid_c.c b/ext/spice/src/cspice/wnunid_c.c deleted file mode 100644 index a76e7010d5..0000000000 --- a/ext/spice/src/cspice/wnunid_c.c +++ /dev/null @@ -1,188 +0,0 @@ -/* - --Procedure wnunid_c ( Union two DP windows ) - --Abstract - - Place the union of two double precision windows into a third - window. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wnunid_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - a, - b I Input windows. - c I Union of a and b. - --Detailed_Input - - a, - b are CSPICE windows, each of which contains zero or more - intervals. - - a and b must be declared as double precision - SpiceCells. - --Detailed_Output - - c is the output CSPICE window, containing the union of - a and b---every point contained in a, or in b, - or in both. - - c must be declared as a double precision SpiceCell. - - c must be distinct from both a and b. - --Parameters - - None. - --Exceptions - - 1) If any of the function arguments are SpiceCells of type - other than double precision, the error SPICE(TYPEMISMATCH) - is signaled. - - 2) If the union of the two windows results in an excess of - elements, the error SPICE(WINDOWEXCESS) is signaled. - --Files - - None. - --Particulars - - The union of two windows contains every point contained in the - first window, or the second window, or both. - --Examples - - Let a contain the intervals - - [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] - - and b contain the intervals - - [ 2, 6 ] [ 8, 10 ] [ 16, 18 ] - - Then the union of a and b contains the intervals - - [ 1, 6 ] [ 7, 11 ] [ 16, 18 ] [ 23, 27 ] - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - union two d.p. windows - --& -*/ - -{ /* Begin wnunid_c */ - - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "wnunid_c" ); - - - /* - Make sure cell data types are d.p. - */ - CELLTYPECHK3 ( CHK_STANDARD, "wnunid_c", SPICE_DP, a, b, c ); - - - /* - Initialize the cells if necessary. - */ - CELLINIT3 ( a, b, c ); - - - /* - Let the f2c'd routine do the work. - */ - wnunid_ ( (doublereal *) (a->base), - (doublereal *) (b->base), - (doublereal *) (c->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, c ); - } - - - chkout_c ( "wnunid_c" ); - -} /* End wnunid_c */ diff --git a/ext/spice/src/cspice/wnvald.c b/ext/spice/src/cspice/wnvald.c deleted file mode 100644 index 9039b838e7..0000000000 --- a/ext/spice/src/cspice/wnvald.c +++ /dev/null @@ -1,283 +0,0 @@ -/* wnvald.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure WNVALD ( Validate a DP window ) */ -/* Subroutine */ int wnvald_(integer *size, integer *n, doublereal *a) -{ - doublereal left; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal right; - extern /* Subroutine */ int scardd_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), ssized_(integer *, - doublereal *), setmsg_(char *, ftnlen), wninsd_(doublereal *, - doublereal *, doublereal *); - extern logical return_(void), odd_(integer *); - -/* $ Abstract */ - -/* Form a valid double precision window from the contents */ -/* of a window array. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Size of window. */ -/* N I Original number of endpoints. */ -/* A I,O Input, output window. */ - -/* $ Detailed_Input */ - -/* SIZE is the size of the window to be validated. This */ -/* is the maximum number of endpoints that the cell */ -/* used to implement the window is capable of holding */ -/* at any one time. */ - -/* N is the original number of endpoints in the input */ -/* cell. */ - -/* A on input, is a (possibly uninitialized) cell array */ -/* SIZE containing N endpoints of (possibly unordered */ -/* and non-disjoint) intervals. */ - -/* $ Detailed_Output */ - -/* A on output, is a window containing the union of the */ -/* intervals in the input cell. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* This routine takes as input a cell array containing pairs of */ -/* endpoints and validates it to form a window. */ - -/* On input, A is a cell of size SIZE containing N endpoints. */ -/* During validation, the intervals are ordered, and overlapping */ -/* intervals are merged. On output, the cardinality of A is */ -/* the number of endpoints remaining, and it is ready for use with */ -/* any of the window routines. */ - -/* Because validation is done in place, there is no chance of */ -/* overflow. */ - -/* Validation is primarily useful for ordering and merging */ -/* intervals read from input files or initialized in DATA */ -/* statements. */ - -/* $ Examples */ - -/* The following small program */ - -/* INTEGER CARDD */ -/* INTEGER SIZED */ - -/* DOUBLE PRECISION WINDOW ( LBCELL:20 ) */ - -/* DATA WINDOW / 0, 0, */ -/* . 10, 12, */ -/* 2, 7, */ -/* 13, 15, */ -/* 1, 5, */ -/* 23, 29, 8*0 / */ - -/* CALL WNVALD ( 20, 10, WINDOW ) */ - -/* WRITE (6,*) 'Current intervals: ', CARDD ( WINDOW ) / 2 */ -/* WRITE (6,*) 'Maximum intervals: ', SIZED ( WINDOW ) / 2 */ -/* WRITE (6,*) */ -/* WRITE (6,*) 'Intervals:' */ -/* WRITE (6,*) */ - -/* DO I = 1, CARDD ( WINDOW ), 2 */ -/* WRITE (6,*) WINDOW(I), WINDOW(I+1) */ -/* END DO */ - -/* END */ - -/* produces the following output (possibly formatted differently). */ - -/* Current intervals: 5 */ -/* Maximum intervals: 10 */ - -/* Intervals: */ - -/* 0.000000000000000 0.000000000000000 */ -/* 1.000000000000000 7.000000000000000 */ -/* 10.00000000000000 12.00000000000000 */ -/* 13.00000000000000 15.00000000000000 */ -/* 23.00000000000000 29.00000000000000 */ - -/* $ Exceptions */ - -/* 1. If the number of endpoints N is odd, the error */ -/* SPICE(UNMATCHENDPTS) is signalled. */ - -/* 2. If the number of end points of the window exceeds its size, the */ -/* error SPICE(WINDOWTOOSMALL) is signalled. */ - -/* 3. If the left endpoint is greater than the right endpoint, the */ -/* error SPICE(BADENDPOINTS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 30-JUL-2002 (NJB) */ - -/* Fixed bugs in example program. */ - -/* - SPICELIB Version 1.1.0, 14-AUG-1995 (HAN) */ - -/* Fixed a character string that continued over two lines. */ -/* The "//" characters were missing. The Alpha/OpenVMS compiler */ -/* issued a warning regarding this incorrect statement syntax. */ - -/* - 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) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* validate a d.p. window */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 14-AUG-1995 (HAN) */ - -/* Fixed a character string that continued over two lines. */ -/* The "//" characters were missing. The Alpha/OpenVMS compiler */ -/* issued a warning regarding this incorrect statement syntax. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */ - -/* Contents of the Required_Reading section was */ -/* changed from "None." to "WINDOWS". Also, the */ -/* declaration of the unused function FAILED was */ -/* removed. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Setting up error processing. */ - - if (return_()) { - return 0; - } - chkin_("WNVALD", (ftnlen)6); - -/* First, some error checks. The number of endpoints must be even, */ -/* and smaller than the reported size of the window. */ - - if (odd_(n)) { - setmsg_("WNVALD: Unmatched endpoints", (ftnlen)27); - sigerr_("SPICE(UNMATCHENDPTS)", (ftnlen)20); - chkout_("WNVALD", (ftnlen)6); - return 0; - } else if (*n > *size) { - setmsg_("WNVALD: Inconsistent value for SIZE.", (ftnlen)36); - sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21); - chkout_("WNVALD", (ftnlen)6); - return 0; - } - -/* Taking the easy way out, we will simply insert each new interval */ -/* as we happen upon it. We can do this safely in place. The output */ -/* window can't possibly contain more intervals than the input array. */ - -/* What can go wrong is this: a left endpoint might be greater than */ -/* the corresponding left endpoint. This is a boo-boo, and should be */ -/* reported. */ - - ssized_(size, a); - scardd_(&c__0, a); - i__ = 1; - while(i__ < *n) { - left = a[i__ + 5]; - right = a[i__ + 6]; - if (left > right) { - setmsg_("WNVALD: Left endpoint may not exceed right endpoint.", ( - ftnlen)52); - sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19); - chkout_("WNVALD", (ftnlen)6); - return 0; - } - wninsd_(&left, &right, a); - i__ += 2; - } - chkout_("WNVALD", (ftnlen)6); - return 0; -} /* wnvald_ */ - diff --git a/ext/spice/src/cspice/wnvald_c.c b/ext/spice/src/cspice/wnvald_c.c deleted file mode 100644 index 989f298128..0000000000 --- a/ext/spice/src/cspice/wnvald_c.c +++ /dev/null @@ -1,264 +0,0 @@ -/* - --Procedure wnvald_c ( Validate a DP window ) - --Abstract - - Form a valid double precision window from the contents - of a window array. - --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 - - WINDOWS - --Keywords - - WINDOWS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - void wnvald_c ( SpiceInt size, - SpiceInt n, - SpiceCell * window ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - size I Size of window. - n I Original number of endpoints. - window I,O Input, output window. - --Detailed_Input - - size is the size of the window to be validated. This - is the maximum number of endpoints that the cell - used to implement the window is capable of holding - at any one time. - - n is the original number of endpoints in the input - cell. - - window on input, is a (possibly uninitialized) cell array - containing n endpoints of (possibly unordered - and non-disjoint) intervals. - - window must be declared as a double precision SpiceCell. - --Detailed_Output - - window on output, is a window containing the union of the - intervals in the input cell. - --Parameters - - None. - --Exceptions - - 1) If the input window does not have double precision type, - the error SPICE(TYPEMISMATCH) is signaled. - - 2) If the number of endpoints n is odd, the error - SPICE(UNMATCHENDPTS) is signaled. - - 3) If the number of end points of the window exceeds its size, the - error SPICE(WINDOWTOOSMALL) is signaled. - - 4) If any left endpoint is greater than the corresponding right endpoint, - the error SPICE(BADENDPOINTS) is signaled. - --Files - - None. - --Particulars - - This routine takes as input a cell array containing pairs of - endpoints and validates it to form a window. - - On input, window is a cell of size size containing n endpoints. - During validation, the intervals are ordered, and overlapping - intervals are merged. On output, the cardinality of window is - the number of endpoints remaining, and window is ready for use with - any of the window routines. - - Because validation is done in place, there is no chance of - overflow. - --Examples - - The following small program - - #include - #include - #include "SpiceUsr.h" - - int main() - { - #define WINSIZ 20 - - SPICEDOUBLE_CELL ( window, WINSIZ ); - - SpiceDouble winData [WINSIZ] = - { - 0.0, 0.0, - 10.0, 12.0, - 2.0, 7.0, - 13.0, 15.0, - 1.0, 5.0, - 23.0, 29.0, - 0.0, 0.0, - 0.0, 0.0, - 0.0, 0.0, - 0.0, 0.0 - }; - - SpiceInt i; - - - - memmove ( (SpiceDouble *)(window.data), - winData, - WINSIZ * sizeof(SpiceDouble) ); - - wnvald_c ( 20, 16, &window ); - - printf ( "Current intervals: %ld\n", card_c(&window)/2 ); - printf ( "Maximum intervals: %ld\n", size_c(&window)/2 ); - printf ( "\nIntervals\n\n" ); - - for ( i = 0; i < card_c(&window); i+=2 ) - { - printf ( "%10.6f %10.6f\n", - SPICE_CELL_ELEM_D (&window, i ), - SPICE_CELL_ELEM_D (&window, i+1) ); - } - - return ( 0 ); - } - - produces the following output (possibly with different formatting). - - - Current intervals: 5 - Maximum intervals: 10 - - Intervals - - 0.000000 0.000000 - 1.000000 7.000000 - 10.000000 12.000000 - 13.000000 15.000000 - 23.000000 29.000000 - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - H.A. Neilan (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - --Version - - -CSPICE Version 1.0.2, 18-DEC-2008 (EDW) - - Corrected a typo in the version ID of the 08-OCT-2004 - Version entry. 1.0.0 changed to 1.0.1. - - -CSPICE Version 1.0.1, 08-OCT-2004 (NJB) - - Corrected typo in code example; also added "return" - statement to code example. - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) (HAN) (WLT) (IMU) - --Index_Entries - - validate a d.p. window - --& -*/ - -{ /* Begin wnvald_c */ - - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return; - } - chkin_c ( "wnvald_c" ); - - /* - Make sure cell data type is d.p. - */ - CELLTYPECHK ( CHK_STANDARD, "wnvald_c", SPICE_DP, window ); - - /* - Initialize the cell if necessary. - */ - CELLINIT ( window ); - - /* - Let the f2c'd routine do the work. - */ - wnvald_ ( (integer * ) &size, - (integer * ) &n, - (doublereal * ) (window->base) ); - - /* - Sync the output cell. - */ - if ( !failed_c() ) - { - zzsynccl_c ( F2C, window ); - } - - - chkout_c ( "wnvald_c" ); - -} /* End wnvald_c */ diff --git a/ext/spice/src/cspice/wref.c b/ext/spice/src/cspice/wref.c deleted file mode 100644 index 2f3fce89dd..0000000000 --- a/ext/spice/src/cspice/wref.c +++ /dev/null @@ -1,276 +0,0 @@ -#include "f2c.h" -#include "fio.h" - -#ifndef KR_headers -#undef abs -#undef min -#undef max -#include "stdlib.h" -#include "string.h" -#endif - -#include "fmt.h" -#include "fp.h" -#ifndef VAX -#include "ctype.h" -#endif - -#ifdef KR_headers -wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; -#else -wrt_E(ufloat *p, int w, int d, int e, ftnlen len) -#endif -{ - char buf[FMAX+EXPMAXDIGS+4], *s, *se; - int d1, delta, e1, i, sign, signspace; - double dd; -#ifdef WANT_LEAD_0 - int insert0 = 0; -#endif -#ifndef VAX - int e0 = e; -#endif - - if(e <= 0) - e = 2; - if(f__scale) { - if(f__scale >= d + 2 || f__scale <= -d) - goto nogood; - } - if(f__scale <= 0) - --d; - if (len == sizeof(real)) - dd = p->pf; - else - dd = p->pd; - if (dd < 0.) { - signspace = sign = 1; - dd = -dd; - } - else { - sign = 0; - signspace = (int)f__cplus; -#ifndef VAX - if (!dd) - dd = 0.; /* avoid -0 */ -#endif - } - delta = w - (2 /* for the . and the d adjustment above */ - + 2 /* for the E+ */ + signspace + d + e); -#ifdef WANT_LEAD_0 - if (f__scale <= 0 && delta > 0) { - delta--; - insert0 = 1; - } - else -#endif - if (delta < 0) { -nogood: - while(--w >= 0) - PUT('*'); - return(0); - } - if (f__scale < 0) - d += f__scale; - if (d > FMAX) { - d1 = d - FMAX; - d = FMAX; - } - else - d1 = 0; - sprintf(buf,"%#.*E", d, dd); -#ifndef VAX - /* check for NaN, Infinity */ - if (!isdigit(buf[0])) { - switch(buf[0]) { - case 'n': - case 'N': - signspace = 0; /* no sign for NaNs */ - } - delta = w - strlen(buf) - signspace; - if (delta < 0) - goto nogood; - while(--delta >= 0) - PUT(' '); - if (signspace) - PUT(sign ? '-' : '+'); - for(s = buf; *s; s++) - PUT(*s); - return 0; - } -#endif - se = buf + d + 3; -#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */ - if (f__scale != 1 && dd) - sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); -#else - if (dd) - sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); - else - strcpy(se, "+00"); -#endif - s = ++se; - if (e < 2) { - if (*s != '0') - goto nogood; - } -#ifndef VAX - /* accommodate 3 significant digits in exponent */ - if (s[2]) { -#ifdef Pedantic - if (!e0 && !s[3]) - for(s -= 2, e1 = 2; s[0] = s[1]; s++); - - /* Pedantic gives the behavior that Fortran 77 specifies, */ - /* i.e., requires that E be specified for exponent fields */ - /* of more than 3 digits. With Pedantic undefined, we get */ - /* the behavior that Cray displays -- you get a bigger */ - /* exponent field if it fits. */ -#else - if (!e0) { - for(s -= 2, e1 = 2; s[0] = s[1]; s++) -#ifdef CRAY - delta--; - if ((delta += 4) < 0) - goto nogood -#endif - ; - } -#endif - else if (e0 >= 0) - goto shift; - else - e1 = e; - } - else - shift: -#endif - for(s += 2, e1 = 2; *s; ++e1, ++s) - if (e1 >= e) - goto nogood; - while(--delta >= 0) - PUT(' '); - if (signspace) - PUT(sign ? '-' : '+'); - s = buf; - i = f__scale; - if (f__scale <= 0) { -#ifdef WANT_LEAD_0 - if (insert0) - PUT('0'); -#endif - PUT('.'); - for(; i < 0; ++i) - PUT('0'); - PUT(*s); - s += 2; - } - else if (f__scale > 1) { - PUT(*s); - s += 2; - while(--i > 0) - PUT(*s++); - PUT('.'); - } - if (d1) { - se -= 2; - while(s < se) PUT(*s++); - se += 2; - do PUT('0'); while(--d1 > 0); - } - while(s < se) - PUT(*s++); - if (e < 2) - PUT(s[1]); - else { - while(++e1 <= e) - PUT('0'); - while(*s) - PUT(*s++); - } - return 0; - } - -#ifdef KR_headers -wrt_F(p,w,d,len) ufloat *p; ftnlen len; -#else -wrt_F(ufloat *p, int w, int d, ftnlen len) -#endif -{ - int d1, sign, n; - double x; - char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s; - - x= (len==sizeof(real)?p->pf:p->pd); - if (d < MAXFRACDIGS) - d1 = 0; - else { - d1 = d - MAXFRACDIGS; - d = MAXFRACDIGS; - } - if (x < 0.) - { x = -x; sign = 1; } - else { - sign = 0; -#ifndef VAX - if (!x) - x = 0.; -#endif - } - - if (n = f__scale) - if (n > 0) - do x *= 10.; while(--n > 0); - else - do x *= 0.1; while(++n < 0); - -#ifdef USE_STRLEN - sprintf(b = buf, "%#.*f", d, x); - n = strlen(b) + d1; -#else - n = sprintf(b = buf, "%#.*f", d, x) + d1; -#endif - -#ifndef WANT_LEAD_0 - if (buf[0] == '0' && d) - { ++b; --n; } -#endif - if (sign) { - /* check for all zeros */ - for(s = b;;) { - while(*s == '0') s++; - switch(*s) { - case '.': - s++; continue; - case 0: - sign = 0; - } - break; - } - } - if (sign || f__cplus) - ++n; - if (n > w) { -#ifdef WANT_LEAD_0 - if (buf[0] == '0' && --n == w) - ++b; - else -#endif - { - while(--w >= 0) - PUT('*'); - return 0; - } - } - for(w -= n; --w >= 0; ) - PUT(' '); - if (sign) - PUT('-'); - else if (f__cplus) - PUT('+'); - while(n = *b++) - PUT(n); - while(--d1 >= 0) - PUT('0'); - return 0; - } diff --git a/ext/spice/src/cspice/wrencc.c b/ext/spice/src/cspice/wrencc.c deleted file mode 100644 index f5db5e776b..0000000000 --- a/ext/spice/src/cspice/wrencc.c +++ /dev/null @@ -1,775 +0,0 @@ -/* wrencc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure WRENCC ( Write characters to text file encoded ) */ -/* Subroutine */ int wrencc_(integer *unit, integer *n, char *data, ftnlen - data_len) -{ - /* Initialized data */ - - static char hexdig[1*16] = "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" - "B" "C" "D" "E" "F"; - static logical first = TRUE_; - - /* System generated locals */ - address a__1[3]; - integer i__1, i__2, i__3[3]; - char ch__1[1], ch__2[66]; - cilist ci__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_wsfe(cilist *); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer do_fio(integer *, char *, ftnlen), e_wsfe(void); - - /* Local variables */ - integer room; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer intch; - char ch[1], encchr[64]; - integer dtalen, dtalin, nchars, hibits; - static integer intfpc, intesc; - integer encpos; - static integer intlpc; - integer dtapos; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer lobits; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer nchout; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - char lftovr[2]; - extern logical return_(void); - static integer intquo; - -/* $ Abstract */ - -/* Encode and write characters to a text file. */ - -/* $ 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 */ - -/* CHARACTERS */ -/* CONVERSION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number of output text file. */ -/* N I Number of characters to encode and write. */ -/* DATA I List of characters to encode and write. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for a previously opened text */ -/* file. All writing will begin at the CURRENT POSITION */ -/* in the text file. */ - -/* N The number of data items, characters, to be encoded and */ -/* written to the text file attached to UNIT. */ - -/* DATA List of characters to be encoded and written to the */ -/* text file attached to UNIT. */ - -/* $ Detailed_Output */ - -/* See the Particulars section for a description of the effect of */ -/* this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N, the number of data items, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while writing to the text file attached */ -/* to unit UNIT, the error SPICE(FILEWRITEFAILED) will be */ -/* signalled. */ - -/* 3) If the Fortran logical unit UNIT is not defined, the results */ -/* of this routine are unpredictable. */ - -/* $ Files */ - -/* See the description of UNIT in the Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine will encode and write the first N contiguous */ -/* characters contained in the data buffer array DATA. The */ -/* encoded characters will be written to a previously opened */ -/* text file attached to logical unit UNIT beginning at the */ -/* current position in the file. The current position in a */ -/* file is defined to be the text line immediately following */ -/* the last text line that was written or read. */ - -/* The first N contiguous characters in the data buffer array */ -/* DATA are defined to be those N characters encountered while */ -/* moving from the lowest array indices to highest array indices, */ -/* i.e., those characters encountered while moving from ``left'' */ -/* to ``right'' and ``top'' to ``bottom'' in the character array */ -/* DATA, beginning at the first character position, DATA(1)(1:1). */ -/* Logically all of the array elements in the data buffer DATA */ -/* containing characters to be encoded can be thought of as being */ -/* concatenated together into one long character string. */ - -/* On any single call to this routine, the encoded characters */ -/* will be contiguous when written, and all but possibly the */ -/* final character string written to the file will contain */ -/* MAXENC characters. The last, if it does not contain MAXENC */ -/* characters, will be padded with blanks so that it has a */ -/* length of MAXENC characters. The encoded character strings */ -/* are meant to be read and processed in blocks of MAXENC */ -/* characters. */ - -/* This routine is one of a pair of routines which are used to */ -/* encode and decode ASCII characters: */ - -/* WRENCC -- Encode and write ASCII characters to a file. */ -/* RDENCC -- Read and decode ASCII characters from a file. */ - -/* The encoding/decoding of characters is performed to provide */ -/* a portable means for transferring character data values. */ - -/* The encoded characters are written to the output text file as */ -/* quoted character strings so that a Fortran list directed read */ -/* may be used to read the character strings, rather than a Fortran */ -/* formatted read with format specifier FMT = '(A)'. */ - -/* This routine is for use with the ASCII character set and */ -/* extensions to it. The supported characters must have decimal */ -/* values in the range from 0 to 255. */ - -/* $ Examples */ - -/* The following examples demonstrate the use of this routine. In */ -/* each of the examples, the variable UNIT is the Fortran logical */ -/* unit of a previously opened text file, and the variable N is */ -/* an integer which will represent the number of characters to be */ -/* encoded. */ - -/* The first example demonstrates a typical correct usage of this */ -/* routine. The second example demonstrates what would probably */ -/* be the most common incorrect usage of this routine. The first */ -/* two examples are attempting to encode the sentence 'This is the */ -/* data.', which has a length of N = 17 characters. The third */ -/* example presents ``before'' and ``after'' pictures of the complete */ -/* ASCII character set. */ - -/* Example 1 */ -/* --------- */ - -/* This example demonstrates a typical usage of this routine. */ - -/* Let the character data buffer have the following declaration */ -/* in the calling program: */ - -/* CHARACTER*(4) DATA(5) */ - -/* We make the following variable assignments: */ - -/* DATA(1) = 'This' */ -/* DATA(2) = ' is ' */ -/* DATA(3) = 'the ' */ -/* DATA(4) = 'data' */ -/* DATA(5) = '.' */ -/* N = 17 */ - -/* The subroutine call */ - -/* CALL WRENCC( UNIT, N, DATA ) */ - -/* will produce a record in the text file attached to the */ -/* logical unit UNIT which is identical to the following */ -/* except for the length of the character string written. */ - -/* 'This is the data. ' */ - - -/* Example 2 */ -/* --------- */ - -/* This example is meant to demonstrate what would probably be */ -/* a common misuse of this routine. */ - -/* Let the character data buffer have the following declaration */ -/* in the calling program: */ - -/* CHARACTER*(10) DATA(2) */ - -/* We make the following variable assignments: */ - -/* DATA(1) = 'This is' */ -/* DATA(2) = ' the data.' */ -/* N = 17 */ - -/* The subroutine call */ - -/* CALL WRENCC( UNIT, N, DATA ) */ - -/* will produce a record in the text file attached to the */ -/* logical unit UNIT which is identical to the following */ -/* except for the length of the character string written. */ - -/* 'This is the da ' */ - -/* This is probably not what was intended. The problem is that */ -/* all of the characters which were to be encoded did not appear */ -/* contiguously in the data buffer DATA. The first element of the */ -/* character string array DATA has three ``extra'' blanks */ -/* following the 's' in the word 'is'. To correctly encode the */ -/* data, the following assignments should be made: */ - -/* DATA(1) = 'This is th' */ -/* DATA(2) = 'e data.' */ - -/* Example 3 */ -/* --------- */ - -/* This example presents the results of applying WRENCC to */ -/* the complete ASCII character set and an extension with */ -/* characters having decimal values form 128 to 255. */ - -/* Let the character data buffer have the following declaration */ -/* in the calling program: */ - -/* CHARACTER*(1) DATA(0:255) */ - -/* Then, letting */ - -/* DATA(I) = CHAR( I ), I = 0, 255 */ -/* N = 256 */ - -/* the subroutine call */ - -/* CALL WRENCC( UNIT, N, DATA ) */ - -/* would produce */ - -/* '@00@01@02@03@04@05@06@07@08@09@0A@0B@0C@0D@0E@0F@10@11@12@13@14@' */ -/* '15@16@17@18@19@1A@1B@1C@1D@1E@1F !"#$%&@27()*+,-./0123456789:;<=' */ -/* '>?@40ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{' */ -/* '|}~@7F@80@81@82@83@84@85@86@87@88@89@8A@8B@8C@8D@8E@8F@90@91@92@' */ -/* '93@94@95@96@97@98@99@9A@9B@9C@9D@9E@9F@A0@A1@A2@A3@A4@A5@A6@A7@A' */ -/* '8@A9@AA@AB@AC@AD@AE@AF@B0@B1@B2@B3@B4@B5@B6@B7@B8@B9@BA@BB@BC@BD' */ -/* '@BE@BF@C0@C1@C2@C3@C4@C5@C6@C7@C8@C9@CA@CB@CC@CD@CE@CF@D0@D1@D2@' */ -/* 'D3@D4@D5@D6@D7@D8@D9@DA@DB@DC@DD@DE@DF@E0@E1@E2@E3@E4@E5@E6@E7@E' */ -/* '8@E9@EA@EB@EC@ED@EE@EF@F0@F1@F2@F3@F4@F5@F6@F7@F8@F9@FA@FB@FC@FD' */ -/* '@FE@FF ' */ - -/* Example 4 */ -/* --------- */ - -/* This example demonstrates the use of WRENCC and RDENCC for */ -/* writing and subsequent reading of character data using data */ -/* buffers that are ``shaped'' differently, i.e., that have */ -/* different dimensions. */ - -/* Let the input and output character data buffers have the */ -/* following declarations: */ - -/* CHARACTER*(25) OUTBUF(3) */ -/* CHARACTER*(10) INPBUF(7) */ - -/* Further, let the output buffer contain the following data: */ - -/* OUTBUF(1) = 'Today is the first day of' */ -/* OUTBUF(2) = ' the rest of my life, so ' */ -/* OUTBUF(3) = 'I will enjoy it.' */ - -/* There are exactly N = 66 significant characters in the output */ -/* buffer. The code fragment */ - -/* N = 66 */ -/* CALL WRENCC ( UNIT, N, OUTBUF ) */ -/* REWIND ( UNIT ) */ -/* CALL RDENCC ( UNIT, N, INPBUF ) */ - -/* has the effect of placing the original data into the */ -/* differently ``shaped'' input buffer with the following */ -/* results: */ - -/* INPBUF(1) = 'Today is t' */ -/* INPBUF(2) = 'he first d' */ -/* INPBUF(3) = 'ay of the ' */ -/* INPBUF(4) = 'rest of my' */ -/* INPBUF(5) = ' life, so ' */ -/* INPBUF(6) = 'I will enj' */ -/* INPBUF(7) = 'oy it. ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.23.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.22.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.21.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.13.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.12.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.11.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.10.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.9.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.8.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.6.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.5.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.4.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.3.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.3.0, 05-DEC-2001 (FST) */ - -/* Replaced ICHAR with the statement function ZZICHR */ -/* to fix a problem on some PC-LINUX environments. */ - -/* - SPICELIB Version 1.2.0, 09-SEP-1993 (KRG) */ - -/* The list directed write was changed to a formatted write using */ -/* the specifier FMT='(A)'. This was done in order to prevent a */ -/* space from appearing as the first character on each line of the */ -/* file for certian computer platforms. */ - -/* - SPICELIB Version 1.1.0, 08-MAR-1993 (KRG) */ - -/* The variables INTESC, INTFPC, INTLPC, INTQUO were not saved */ -/* when they should have been. This eventually caused some */ -/* problems, so it was fixed. They are now saved. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* encode and write characters to a text file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.3.0, 05-DEC-2001 (FST) */ - -/* Previous versions of this routine required the range */ -/* of ICHAR to be [0,255]. This is not the case on some */ -/* environments, so references to ICHAR were replaced */ -/* with a ZZICHR statement function that returns values */ -/* in this range for all supported environments. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Statement Functions */ - - -/* Saved variables */ - - -/* Initial values */ - -/* Define the hexadecimal digits */ - - -/* Statement Function Definitions */ - -/* This function controls the conversion of characters to integers. */ -/* On some supported environments, ICHAR is not sufficient to */ -/* produce the desired results. This, however, is not the case */ -/* with this particular environment. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WRENCC", (ftnlen)6); - } - if (first) { - -/* Initialize the integer values for the special characters */ - - first = FALSE_; - *(unsigned char *)&ch__1[0] = '@'; - intesc = *(unsigned char *)&ch__1[0]; - *(unsigned char *)&ch__1[0] = '\''; - intquo = *(unsigned char *)&ch__1[0]; - *(unsigned char *)&ch__1[0] = ' '; - intfpc = *(unsigned char *)&ch__1[0]; - *(unsigned char *)&ch__1[0] = '~'; - intlpc = *(unsigned char *)&ch__1[0]; - } - -/* Get the length of a data ``line'' in the data buffer DATA. */ - - dtalen = i_len(data, data_len); - -/* Make sure that the encoding character string is empty when we */ -/* start. */ - - s_copy(encchr, " ", (ftnlen)64, (ftnlen)1); - -/* Check to see if the number of data items is less than or equal */ -/* to zero. If it is, signal an error. */ - - if (*n < 1) { - setmsg_("The number of data items to be written was not positive: #.", - (ftnlen)59); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("WRENCC", (ftnlen)6); - return 0; - } - -/* We need to begin scanning through the characters and placing them */ -/* into a temporary buffer that is an appropriate length for output */ -/* to the text file (see the parameter MAXENC above). */ - -/* Initialize all of the counters and pointers used to move through */ -/* the various character data buffers and count the number of */ -/* characters processed. */ - -/* Initialize the data line and data line position. */ - - dtalin = 1; - dtapos = 1; - -/* Initialize the encoded character buffer position. */ - - encpos = 1; - -/* Set the number of characters encoded to zero, and set the number */ -/* of characters output to zero. The number of output characters may */ -/* be larger than the number of characters because characters that */ -/* are escaped are more than one character in length. */ - - nchars = 0; - nchout = 0; - while(nchars < *n) { - -/* At this point, we know the following: */ - -/* (1) 1 <= ENCPOS <= MAXENC */ -/* (2) 1 <= DTAPOS <= DTALEN */ -/* (3) 1 <= DTALIN */ -/* (4) 0 <= NCHARS <= N */ -/* (5) 0 <= NCHOUT */ - - *(unsigned char *)ch = *(unsigned char *)&data[(dtalin - 1) * - data_len + (dtapos - 1)]; - *(unsigned char *)&ch__1[0] = *(unsigned char *)ch; - intch = *(unsigned char *)&ch__1[0]; - -/* If the character is a special character, then encode it and */ -/* place it in the encoded character buffer. Otherwise the */ -/* character is a printing character, so just put it in the */ -/* encoded character buffer. */ - - if (intch < intfpc || intch > intlpc || intch == intesc || intch == - intquo) { - -/* The character is a nonprinting character, the escape */ -/* character, or a single quote, and so we need to encode */ -/* it using the escape character ESCCHR followed by two */ -/* hexadecimal digits which represent the position of the */ -/* character in the ASCII character sequence. */ - - hibits = intch / 16; - lobits = intch - (hibits << 4); - *(unsigned char *)&encchr[encpos - 1] = '@'; - -/* We need to see if there is enough room in the encoded */ -/* character buffer to place all of the hexadecimal digits */ -/* in the encoding. If not, we need to put what we can in the */ -/* encoded character buffer and temporarily store the rest, */ -/* which will be placed in the encoded character buffer after */ -/* the filled buffer is written to the file. */ - - room = 64 - encpos; - if (room >= 2) { - i__1 = encpos; - s_copy(encchr + i__1, hexdig + ((i__2 = hibits) < 16 && 0 <= - i__2 ? i__2 : s_rnge("hexdig", i__2, "wrencc_", ( - ftnlen)644)), encpos + 1 - i__1, (ftnlen)1); - i__1 = encpos + 1; - s_copy(encchr + i__1, hexdig + ((i__2 = lobits) < 16 && 0 <= - i__2 ? i__2 : s_rnge("hexdig", i__2, "wrencc_", ( - ftnlen)645)), encpos + 2 - i__1, (ftnlen)1); - } else if (room == 1) { - i__1 = encpos; - s_copy(encchr + i__1, hexdig + ((i__2 = hibits) < 16 && 0 <= - i__2 ? i__2 : s_rnge("hexdig", i__2, "wrencc_", ( - ftnlen)649)), encpos + 1 - i__1, (ftnlen)1); - *(unsigned char *)lftovr = *(unsigned char *)&hexdig[(i__1 = - lobits) < 16 && 0 <= i__1 ? i__1 : s_rnge("hexdig", - i__1, "wrencc_", (ftnlen)650)]; - *(unsigned char *)&lftovr[1] = ' '; - } else { - *(unsigned char *)lftovr = *(unsigned char *)&hexdig[(i__1 = - hibits) < 16 && 0 <= i__1 ? i__1 : s_rnge("hexdig", - i__1, "wrencc_", (ftnlen)655)]; - *(unsigned char *)&lftovr[1] = *(unsigned char *)&hexdig[( - i__1 = lobits) < 16 && 0 <= i__1 ? i__1 : s_rnge( - "hexdig", i__1, "wrencc_", (ftnlen)656)]; - } - -/* Increment the character buffer pointers, including the */ -/* pointer for the encoded character (possibly over */ -/* incrementing, but that's OK). */ - - ++nchars; - ++dtapos; - encpos += 3; - nchout += 3; - } else { - -/* The character is a printing character, and we encode it */ -/* as itself and increment the character buffer pointers */ -/* appropriately. */ - - *(unsigned char *)&encchr[encpos - 1] = *(unsigned char *)ch; - ++nchars; - ++dtapos; - ++encpos; - ++nchout; - } - -/* If we have filled the encoded character buffer, we need to */ -/* write it out to the file and prepare it for reuse. */ - - if (encpos > 64) { - -/* Write out the encoded character buffer placing single */ -/* quotes around it so that it may be read using a Fortran */ -/* list directed read statement rather than the format */ -/* specifier FMT = '(A)'. */ - - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } -/* Writing concatenation */ - i__3[0] = 1, a__1[0] = "'"; - i__3[1] = 64, a__1[1] = encchr; - i__3[2] = 1, a__1[2] = "'"; - s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)66); - iostat = do_fio(&c__1, ch__2, (ftnlen)66); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - if (iostat != 0) { - setmsg_("Error writing to logical unit #, IOSTAT = #.", ( - ftnlen)44); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("WRENCC", (ftnlen)6); - return 0; - } - -/* Get ready to fill up the encoded character buffer again, */ -/* taking care to place any leftover characters in the buffer */ -/* first. */ - - nchout += -64; - if (nchout > 0) { - s_copy(encchr, lftovr, (ftnlen)2, (ftnlen)2); - } - encpos = nchout + 1; - s_copy(encchr + (encpos - 1), " ", 64 - (encpos - 1), (ftnlen)1); - s_copy(lftovr, " ", (ftnlen)2, (ftnlen)1); - } - -/* If we have reached the end of the current data ``line'' in the */ -/* data buffer DATA, we need to increment the data line pointer */ -/* and reset the data position pointer. */ - - if (dtapos > dtalen) { - ++dtalin; - dtapos = 1; - } - } - -/* If the number of output characters remaining is greater than */ -/* zero, we need to flush the encoded character buffer before */ -/* exiting, because we have a partially filled encoded character */ -/* buffer. Otherwise, we're done. */ - -/* This last encoded string that is written will be padded with */ -/* blanks out to MAXENC character positions, so there is no */ -/* ``garbage'' written at the end of the data. */ - - if (nchout > 0) { - -/* Write out the encoded character buffer placing single */ -/* quotes around it so that it may be read using a Fortran */ -/* list directed read statement rather than the format */ -/* specifier FMT = '(A)'. */ - - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } -/* Writing concatenation */ - i__3[0] = 1, a__1[0] = "'"; - i__3[1] = 64, a__1[1] = encchr; - i__3[2] = 1, a__1[2] = "'"; - s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)66); - iostat = do_fio(&c__1, ch__2, (ftnlen)66); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsfe(); -L100002: - if (iostat != 0) { - setmsg_("Error writing to logical unit #, IOSTAT = #.", (ftnlen) - 44); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("WRENCC", (ftnlen)6); - return 0; - } - } - chkout_("WRENCC", (ftnlen)6); - return 0; -} /* wrencc_ */ - diff --git a/ext/spice/src/cspice/wrencd.c b/ext/spice/src/cspice/wrencd.c deleted file mode 100644 index fdeaf30d42..0000000000 --- a/ext/spice/src/cspice/wrencd.c +++ /dev/null @@ -1,391 +0,0 @@ -/* wrencd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure WRENCD ( Write encoded d.p. numbers to text file ) */ -/* Subroutine */ int wrencd_(integer *unit, integer *n, doublereal *data) -{ - /* System generated locals */ - address a__1[3]; - integer i__1, i__2, i__3, i__4[3]; - char ch__1[66]; - cilist ci__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_wsfe(cilist *); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer do_fio(integer *, char *, ftnlen), e_wsfe(void); - - /* Local variables */ - char work[64*64]; - extern /* Subroutine */ int dp2hx_(doublereal *, char *, integer *, - ftnlen); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nitms, itmbeg, length[64]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Encode and write d.p. numbers to a text file. */ - -/* $ 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 */ - -/* CONVERSION */ -/* NUMBERS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number of output text file. */ -/* N I Number of d.p. numbers to encode and write. */ -/* DATA I List of d.p. numbers to encode and write. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for a previously opened text */ -/* file. All writing will begin at the CURRENT POSITION */ -/* in the text file. */ - -/* N The number of double precision numbers to be encoded */ -/* and written to the text file attached to UNIT. */ - -/* DATA List of double precision numbers to be encoded and */ -/* written to the text file attached to UNIT. */ - -/* $ Detailed_Output */ - -/* See the Particulars section for a description of the effect of */ -/* this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N, the number of data items, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while writing to the text file attached */ -/* to UNIT, the error SPICE(FILEWRITEFAILED) will be signalled. */ - -/* 3) If the Fortran logical unit UNIT is not defined, the results */ -/* of this routine are unpredictable. */ - -/* $ Files */ - -/* See the description of UNIT in the Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine will accept a list of one or more double precision */ -/* numbers which it will encode into equivalent text strings and */ -/* write to the current position in a text file. The current */ -/* position in a file is defined to be the text line immediately */ -/* following the last text line that was written or read. The */ -/* encoded d.p. numbers are written to the output text file as */ -/* quoted character strings so that a Fortran list directed read may */ -/* be used to read the encoded values, rather than a formatted read */ -/* with the format specifier FMT = '(A)'. */ - -/* This routine is one of a pair of routines which are used to */ -/* encode and decode d.p. numbers: */ - -/* WRENCD -- Encode and write d.p. numbers to a file. */ -/* RDENCD -- Read and decode d.p. numbers from a file. */ - -/* The encoding/decoding of d.p.numbers is performed to provide a */ -/* portable means for transferring data values. */ - -/* Currently the text string produced will be in a base 16 */ -/* ``scientific notation.'' This format retains the full precision */ -/* available for d.p. numbers on any given computer architecture. */ -/* See DP2HX.FOR and HX2DP.FOR for details. */ - -/* $ Examples */ - -/* Please note that the output format in the examples is not */ -/* intended to be exactly identical with the output format of this */ -/* routine in actual use. The output format used in the examples is */ -/* intended to aid in the understanding of how this routine works. */ -/* It is NOT intended to be a specification of the output format for */ -/* this routine. */ - -/* Let */ - -/* UNIT be the Fortran logical unit of a previously opened */ -/* text file. */ - -/* N = 100 */ - -/* DATA(I) = DBLE(I), I = 1,N */ - -/* Then, the subroutine call */ - -/* CALL WRENCD( UNIT, N, DATA ) */ - -/* will write the first 100 integers as encoded d.p. numbers to the */ -/* output text file attached to UNIT, beginning at the current */ -/* position in the output file, which is marked by an arrow, '-->'. */ -/* The resulting output will look something like the following: */ - -/* -->'1^1' '2^1' '3^1' '4^1' '5^1' '6^1' '7^1' '8^1' '9^1' */ -/* 'A^1' 'B^1' 'C^1' 'D^1' 'E^1' 'F^1' '1^2' '11^2' '12^2' */ -/* '13^2' '14^2' '15^2' '16^2' '17^2' '18^2' '19^2' '1A^2' */ -/* '1B^2' '1C^2' '1D^2' '1E^2' '1F^2' '2^2' '21^2' '22^2' */ -/* '23^2' '24^2' '25^2' '26^2' '27^2' '28^2' '29^2' '2A^2' */ -/* '2B^2' '2C^2' '2D^2' '2E^2' '2F^2' '3^2' '31^2' '32^2' */ -/* '33^2' '34^2' '35^2' '36^2' '37^2' '38^2' '39^2' '3A^2' */ -/* '3B^2' '3C^2' '3D^2' '3E^2' '3F^2' '4^2' */ -/* '41^2' '42^2' '43^2' '44^2' '45^2' '46^2' '47^2' '48^2' */ -/* '49^2' '4A^2' '4B^2' '4C^2' '4D^2' '4E^2' '4F^2' '5^2' */ -/* '51^2' '52^2' '53^2' '54^2' '55^2' '56^2' '57^2' '58^2' */ -/* '59^2' '5A^2' '5B^2' '5C^2' '5D^2' '5E^2' '5F^2' '6^2' */ -/* '61^2' '62^2' '63^2' '64^2' */ -/* --> */ - -/* At this point, the arrow marks the position of the file pointer */ -/* immediately after the call to WRENCD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 09-SEP-1993 (KRG) */ - -/* The list directed write was changed to a formatted write using */ -/* the specifier FMT='(A)'. This was done in order to prevent a */ -/* space from appearing as the first character on each line of the */ -/* file for certian computer platforms. */ - -/* - SPICELIB Version 1.1.0, 21-JUN-1993 (KRG) */ - -/* This routine was modified to avoid the creation of long output */ -/* lines on some of the supported systems, such as the NeXT with */ -/* Absoft Fortran 3.2. */ - -/* A disclaimer was added to the $ Examples section concerning */ -/* the output format used. The disclaimer simply states that the */ -/* output format used in the example is not necessarily the */ -/* output format actually used by the routine. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* encode and write d.p. numbers to a text file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 09-SEP-1993 (KRG) */ - -/* The list directed write was changed to a formatted write using */ -/* the specifier FMT='(A)'. This was done in order to prevent a */ -/* space from appearing as the first character on each line of the */ -/* file for certian computer platforms. */ - -/* - SPICELIB Version 1.1.0, 21-JUN-1993 (KRG) */ - -/* This routine was modified to avoid the creation of long output */ -/* lines on some of the supported systems, such as the NeXT with */ -/* Absoft Fortran 3.2. */ - -/* On some of the supported computers this routine would produce */ -/* very long (greater than 1000 characters) output lines due to */ -/* the implicit DO loop used in the WRITE statment: */ - -/* WRITE (UNIT,IOSTAT=IOSTAT,FMT=*) */ -/* . ( QUOTE//WORK(I)(1:LENGTH(I))//QUOTE//' ', I=1,NITMS ) */ - -/* This problem was fixed by removing the implicit DO loop from */ -/* the WRITE statement and placing an equivalent DO loop around */ -/* the WRITE statemtent: */ - -/* DO I = 1, NITMS */ -/* WRITE (UNIT,IOSTAT=IOSTAT,FMT=*) */ -/* . QUOTE//WORK(I)(1:LENGTH(I))//QUOTE */ -/* END DO */ - -/* The net effect of this will be that only a single datum will */ -/* be written on each line of output. */ - -/* A disclaimer was added to the $ Examples section concerning */ -/* the output format used. The disclaimer simply states that the */ -/* output format used in the example is not necessarily the */ -/* output format actually used by the routine. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WRENCD", (ftnlen)6); - } - -/* Check to see if the number of data items is less than or equal */ -/* to zero. If it is, signal an error. */ - - if (*n < 1) { - setmsg_("The number of data items to be written was not positive: #.", - (ftnlen)59); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("WRENCD", (ftnlen)6); - return 0; - } - -/* Initialize the beginning location for the data items to be */ -/* encoded. */ - - itmbeg = 1; - -/* Begin encoding the input data items in blocks of size NITMS. */ -/* Each time the number of data items NITMS is reached, write */ -/* out the encoded items in the workspace. */ - - while(itmbeg <= *n) { - -/* The number of items is either the size of the workspace, or */ -/* the number of data items which remain to be processed, which */ -/* should always be less than or equal to the size of the */ -/* workspace. */ - -/* Computing MIN */ - i__1 = 64, i__2 = *n - itmbeg + 1; - nitms = min(i__1,i__2); - -/* Encode each of the numbers into an equivalent character string. */ - - i__1 = nitms; - for (i__ = 1; i__ <= i__1; ++i__) { - dp2hx_(&data[itmbeg + i__ - 2], work + (((i__2 = i__ - 1) < 64 && - 0 <= i__2 ? i__2 : s_rnge("work", i__2, "wrencd_", ( - ftnlen)324)) << 6), &length[(i__3 = i__ - 1) < 64 && 0 <= - i__3 ? i__3 : s_rnge("length", i__3, "wrencd_", (ftnlen) - 324)], (ftnlen)64); - } - -/* Write out the current workspace, placing single quotes around */ -/* each of the character strings so that they may be read using */ -/* Fortran list directed read statements rather than the format */ -/* specifier FMT = '(A)'. */ - - i__1 = nitms; - for (i__ = 1; i__ <= i__1; ++i__) { - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = "'"; - i__4[1] = length[(i__3 = i__ - 1) < 64 && 0 <= i__3 ? i__3 : - s_rnge("length", i__3, "wrencd_", (ftnlen)335)], a__1[1] = - work + (((i__2 = i__ - 1) < 64 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "wrencd_", (ftnlen)335)) << 6); - i__4[2] = 1, a__1[2] = "'"; - s_cat(ch__1, a__1, i__4, &c__3, (ftnlen)66); - iostat = do_fio(&c__1, ch__1, length[(i__3 = i__ - 1) < 64 && 0 <= - i__3 ? i__3 : s_rnge("length", i__3, "wrencd_", (ftnlen) - 335)] + 2); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - -/* Check to see if we got a write error, IOSTAT .NE. 0. */ - - if (iostat != 0) { - setmsg_("Error writing to logical unit #, IOSTAT = #.", ( - ftnlen)44); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("WRENCD", (ftnlen)6); - return 0; - } - } - -/* Position the data item pointer at the next location to begin */ -/* encoding the items in the array DATA, and continue processing */ -/* the data items until done. */ - - itmbeg += nitms; - } - chkout_("WRENCD", (ftnlen)6); - return 0; -} /* wrencd_ */ - diff --git a/ext/spice/src/cspice/wrenci.c b/ext/spice/src/cspice/wrenci.c deleted file mode 100644 index 481e1be0b4..0000000000 --- a/ext/spice/src/cspice/wrenci.c +++ /dev/null @@ -1,386 +0,0 @@ -/* wrenci.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure WRENCI ( Write encoded integers to text file ) */ -/* Subroutine */ int wrenci_(integer *unit, integer *n, integer *data) -{ - /* System generated locals */ - address a__1[3]; - integer i__1, i__2, i__3, i__4[3]; - char ch__1[66]; - cilist ci__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_wsfe(cilist *); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer do_fio(integer *, char *, ftnlen), e_wsfe(void); - - /* Local variables */ - char work[64*64]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nitms; - extern /* Subroutine */ int int2hx_(integer *, char *, integer *, ftnlen); - integer itmbeg, length[64]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Encode and write integers to a text file. */ - -/* $ 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 */ - -/* CONVERSION */ -/* NUMBERS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Fortran unit number of output text file. */ -/* N I Number of integers to encode and write. */ -/* DATA I List of integers to be encoded and written. */ - -/* $ Detailed_Input */ - -/* UNIT The Fortran unit number for a previously opened text */ -/* file. All writing will begin at the CURRENT POSITION */ -/* in the text file. */ - -/* N The number of integers to be encoded and written to the */ -/* text file attached to UNIT. */ - -/* DATA List of integers to be encoded and written to the text */ -/* file attached to UNIT. */ - -/* $ Detailed_Output */ - -/* See the Particulars section for a description of the effect of */ -/* this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N, the number of data items, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while writing to the text file attached */ -/* to UNIT, the error SPICE(FILEWRITEFAILED) will be signalled. */ - -/* 3) If the Fortran logical unit UNIT is not defined, the results */ -/* of this routine are unpredictable. */ - -/* $ Files */ - -/* See the description of UNIT in the Detailed_Input section. */ - -/* $ Particulars */ - -/* This routine will accept a list of one or more integers which */ -/* it will encode into equivalent text strings and write to the */ -/* current position in a text file. The current position in a file */ -/* is defined to be the text line immediately following the last */ -/* text line that was written or read. The encoded integers are */ -/* written to the output text file as quoted character strings so */ -/* that a Fortran list directed read may be used to read the */ -/* encoded values, rather than a formatted read with the format */ -/* specifier FMT = '(A)'. */ - -/* This routine is one of a pair of routines which are used to */ -/* encode and decode integers: */ - -/* WRENCI -- Encode and write integers to a file. */ -/* RDENCI -- Read and decode integers from a file. */ - -/* The encoding/decoding of integers is performed to provide a */ -/* portable means for transferring data values. */ - -/* Currently the text string produced will be a signed hexadecimal */ -/* number See INT2HX.FOR and HX2INT.FOR for details. */ - -/* $ Examples */ - -/* Please note that the output format in the examples is not */ -/* intended to be exactly identical with the output format of this */ -/* routine in actual use. The output format used in the examples is */ -/* intended to aid in the understanding of how this routine works. */ -/* It is NOT intended to be a specification of the output format for */ -/* this routine. */ - -/* Let */ - -/* UNIT be the Fortran logical unit of a previously opened */ -/* text file. */ - -/* N = 100 */ - -/* DATA(I) = I, I = 1, N */ - -/* Then, the subroutine call */ - -/* CALL WRENCI( UNIT, N, DATA ) */ - -/* will write the first 100 integers, encoded, to the output text */ -/* file attached to UNIT, beginning at the current position in the */ -/* output file, which is marked by an arrow, '-->'. The resulting */ -/* output will look something like the following: */ - -/* -->'1' '2' '3' '4' '5' '6' '7' '8' '9' 'A' 'B' 'C' 'D' 'E' */ -/* 'F' '10' '11' '12' '13' '14' '15' '16' '17' '18' '19' */ -/* '1A' '1B' '1C' '1D' '1E' '1F' '20' '21' '22' '23' '24' */ -/* '25' '26' '27' '28' '29' '2A' '2B' '2C' '2D' '2E' '2F' */ -/* '30' '31' '32' '33' '34' '35' '36' '37' '38' '39' '3A' */ -/* '3B' '3C' '3D' '3E' '3F' '40' */ -/* '41' '42' '43' '44' '45' '46' '47' '48' '49' '4A' '4B' */ -/* '4C' '4D' '4E' '4F' '50' '51' '52' '53' '54' '55' '56' */ -/* '57' '58' '59' '5A' '5B' '5C' '5D' '5E' '5F' '60' '61' */ -/* '62' '63' '64' */ -/* --> */ - -/* At this point, the arrow marks the position of the file pointer */ -/* immediately after the call to WRENCI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 09-SEP-1993 (KRG) */ - -/* The list directed write was changed to a formatted write using */ -/* the specifier FMT='(A)'. This was done in order to prevent a */ -/* space from appearing as the first character on each line of the */ -/* file for certian computer platforms. */ - -/* - SPICELIB Version 1.1.0, 21-JUN-1993 (KRG) */ - -/* This routine was modified to avoid the creation of long output */ -/* lines on some of the supported systems, such as the NeXT with */ -/* Absoft Fortran 3.2. */ - -/* A disclaimer was added to the $ Examples section concerning */ -/* the output format used. The disclaimer simply states that the */ -/* output format used in the example is not necessarily the */ -/* output format actually used by the routine. */ - -/* - SPICELIB Version 1.0.0, 19-OCT-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* encode and write integers to a text file */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 09-SEP-1993 (KRG) */ - -/* The list directed write was changed to a formatted write using */ -/* the specifier FMT='(A)'. This was done in order to prevent a */ -/* space from appearing as the first character on each line of the */ -/* file for certian computer platforms. */ - -/* - SPICELIB Version 1.1.0, 21-JUN-1993 (KRG) */ - -/* This routine was modified to avoid the creation of long output */ -/* lines on some of the supported systems, such as the NeXT with */ -/* Absoft Fortran 3.2. */ - -/* On some of the supported computers this routine would produce */ -/* very long (greater than 1000 characters) output lines due to */ -/* the implicit DO loop used in the WRITE statment: */ - -/* WRITE (UNIT,IOSTAT=IOSTAT,FMT=*) */ -/* . ( QUOTE//WORK(I)(1:LENGTH(I))//QUOTE//' ', I=1,NITMS ) */ - -/* This problem was fixed by removing the implicit DO loop from */ -/* the WRITE statement and placing an equivalent DO loop around */ -/* the WRITE statemtent: */ - -/* DO I = 1, NITMS */ -/* WRITE (UNIT,IOSTAT=IOSTAT,FMT=*) */ -/* . QUOTE//WORK(I)(1:LENGTH(I))//QUOTE */ -/* END DO */ - -/* The net effect of this will be that only a single datum will */ -/* be written on each line of output. */ - -/* A disclaimer was added to the $ Examples section concerning */ -/* the output format used. The disclaimer simply states that the */ -/* output format used in the example is not necessarily the */ -/* output format actually used by the routine. */ - -/* - SPICELIB Version 1.0.0, 20-OCT-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WRENCI", (ftnlen)6); - } - -/* Check to see if the number of data items is less than or equal */ -/* to zero. If it is, signal an error. */ - - if (*n < 1) { - setmsg_("The number of data items to be written was not positive: #.", - (ftnlen)59); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("WRENCI", (ftnlen)6); - return 0; - } - -/* Initialize the beginning location for the data items to be */ -/* encoded. */ - - itmbeg = 1; - -/* Begin encoding the input data items in blocks of size NITMS. */ -/* Each time the number of data items NITMS is reached, write */ -/* out the encoded items in the workspace. */ - - while(itmbeg <= *n) { - -/* The number of items is either the size of the workspace, or */ -/* the number of data items which remain to be processed, which */ -/* should always be less than or equal to the size of the */ -/* workspace. */ - -/* Computing MIN */ - i__1 = 64, i__2 = *n - itmbeg + 1; - nitms = min(i__1,i__2); - -/* Encode each of the numbers into an equivalent character string. */ - - i__1 = nitms; - for (i__ = 1; i__ <= i__1; ++i__) { - int2hx_(&data[itmbeg + i__ - 2], work + (((i__2 = i__ - 1) < 64 && - 0 <= i__2 ? i__2 : s_rnge("work", i__2, "wrenci_", ( - ftnlen)319)) << 6), &length[(i__3 = i__ - 1) < 64 && 0 <= - i__3 ? i__3 : s_rnge("length", i__3, "wrenci_", (ftnlen) - 319)], (ftnlen)64); - } - -/* Write out the current workspace, placing single quotes around */ -/* each of the character strings so that they may be read using */ -/* Fortran list directed read statements rather than the format */ -/* specifier FMT = '(A)'. */ - - i__1 = nitms; - for (i__ = 1; i__ <= i__1; ++i__) { - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = "'"; - i__4[1] = length[(i__3 = i__ - 1) < 64 && 0 <= i__3 ? i__3 : - s_rnge("length", i__3, "wrenci_", (ftnlen)330)], a__1[1] = - work + (((i__2 = i__ - 1) < 64 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "wrenci_", (ftnlen)330)) << 6); - i__4[2] = 1, a__1[2] = "'"; - s_cat(ch__1, a__1, i__4, &c__3, (ftnlen)66); - iostat = do_fio(&c__1, ch__1, length[(i__3 = i__ - 1) < 64 && 0 <= - i__3 ? i__3 : s_rnge("length", i__3, "wrenci_", (ftnlen) - 330)] + 2); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - -/* Check to see if we got a write error, IOSTAT .NE. 0. */ - - if (iostat != 0) { - setmsg_("Error writing to logical unit #, IOSTAT = #.", ( - ftnlen)44); - errint_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("WRENCI", (ftnlen)6); - return 0; - } - } - -/* Position the data item pointer at the next location to begin */ -/* encoding the items in the array DATA, and continue processing */ -/* the data items until done. */ - - itmbeg += nitms; - } - chkout_("WRENCI", (ftnlen)6); - return 0; -} /* wrenci_ */ - diff --git a/ext/spice/src/cspice/writla.c b/ext/spice/src/cspice/writla.c deleted file mode 100644 index 3439597b07..0000000000 --- a/ext/spice/src/cspice/writla.c +++ /dev/null @@ -1,212 +0,0 @@ -/* writla.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure WRITLA ( Write array of lines to a logical unit ) */ -/* Subroutine */ int writla_(integer *numlin, char *array, integer *unit, - ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int writln_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* This routine will write an array of text lines to a Fortran */ -/* logical unit. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NUMLIN I Number of lines to be written to the file. */ -/* ARRAY I Array containing the lines to be written. */ -/* UNIT I Fortran unit number to use for output. */ - -/* $ Detailed_Input */ - - -/* NUMLIN The number of text lines in ARRAY which are to be */ -/* written to UNIT. NUMLIN > 0. */ - -/* ARRAY The array which contains the text lines to be written to */ -/* UNIT. */ - -/* The contents of this variable are not modified. */ - -/* UNIT The Fortran unit number for the output. This may */ -/* be either the unit number for the terminal, or the */ -/* unit number of a previously opened text file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of lines, NUMLIN, is not positive, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If an error occurs while attempting to write to the text */ -/* file attached to UNIT, a routine called by this routine will */ -/* detect and signal the error. */ - -/* $ Files */ - -/* See the description of UNIT above. */ - -/* $ Particulars */ - -/* This routine writes an array of character strings to a specified */ -/* Fortran logical unit, writing each array element as a line of */ -/* output. */ - -/* $ Examples */ - -/* The following example demonstrates the use of this routine, */ -/* displaying a short poem on the standard output device, typically a */ -/* terminal screen. */ - -/* PROGRAM EXAMPL */ -/* C */ -/* C Example program for WRITLA. */ -/* C */ -/* CHARACTER*(80) LINES(4) */ - -/* LINES(1) = 'Mary had a little lamb' */ -/* LINES(2) = 'Whose fleece was white as snow' */ -/* LINES(3) = 'And everywhere that mary went' */ -/* LINES(4) = 'The lamb was sure to go' */ - -/* CALL WRITLA ( 4, LINES, 6 ) */ - -/* END */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.0.0, 20-DEC-1995 (KRG) */ - -/* The routine graduated */ - -/* - Beta Version 2.0.0, 13-OCT-1994 (KRG) */ - -/* This routine now participates fully with the SPICELIB error */ -/* handler, checking in on entry and checking out on exit. The */ -/* overhead associated with the error handler should not be */ -/* significant relative to the operation of this routine. */ - -/* - Beta Version 1.0.0, 18-DEC-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* write an array of text lines to a logical unit */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WRITLA", (ftnlen)6); - } - -/* Check to see if the maximum number of lines is positive. */ - - if (*numlin <= 0) { - setmsg_("The number of lines to be written was not positive. It was " - "#.", (ftnlen)61); - errint_("#", numlin, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("WRITLA", (ftnlen)6); - return 0; - } - -/* Begin writing the lines to UNIT. Stop when an error occurs, or */ -/* when we have finished writing all of the lines. */ - - i__1 = *numlin; - for (i__ = 1; i__ <= i__1; ++i__) { - writln_(array + (i__ - 1) * array_len, unit, array_len); - if (failed_()) { - -/* If the write failed, an appropriate error message has */ -/* already been set, so we simply need to return. */ - - chkout_("WRITLA", (ftnlen)6); - return 0; - } - } - chkout_("WRITLA", (ftnlen)6); - return 0; -} /* writla_ */ - diff --git a/ext/spice/src/cspice/writln.c b/ext/spice/src/cspice/writln.c deleted file mode 100644 index b005f7a3b9..0000000000 --- a/ext/spice/src/cspice/writln.c +++ /dev/null @@ -1,397 +0,0 @@ -/* writln.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure WRITLN ( Write a text line to a logical unit ) */ -/* Subroutine */ int writln_(char *line, integer *unit, ftnlen line_len) -{ - /* System generated locals */ - cilist ci__1; - - /* Builtin functions */ - integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Write a single line of text to the Fortran logical unit UNIT. */ - -/* $ 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 */ - -/* ASCII */ -/* TEXT */ -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LINE I The line which is to be written to UNIT. */ -/* UNIT I The Fortran unit number to use for output. */ - -/* $ Detailed_Input */ - -/* LINE This contains the text line which is to be written */ -/* to UNIT. */ - -/* The value of this variable is not modified. */ - -/* UNIT The Fortran unit number for the output. This may be */ -/* either the unit number for the terminal, or the unit */ -/* number of a previously opened text file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while attempting to write to the text */ -/* file attached to UNIT, the error SPICE(FILEWRITEFAILED) will */ -/* be signalled. */ - -/* This routine only checks in with the error handler in the event */ -/* that an error occurred. (Discovery check in) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will write a single text line to the device */ -/* specified by UNIT. UNIT may be the terminal, or it may be */ -/* a logical unit number obtained from a Fortran OPEN or INQUIRE */ -/* statement. When written, the line will have trailing spaces */ -/* removed. */ - -/* $ Examples */ - -/* CALL WRITLN( LINE, UNIT ) */ - -/* You have now written a line of text to unit UNIT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.20.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" marker from text in the header. */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 2.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 2.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 2.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 1.1.1, 20-AUG-1996 (WLT) */ - -/* Corrected the heading for the Index_Entries section. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* For the Macintosh, we need to use real Fortran I/O, i.e., */ -/* using the first column for carriage control. The change */ -/* was to move the MAC environment indicator from one */ -/* environment case to the other. */ - -/* Also, for UNIX environments, the parameter STDOUT is no */ -/* longer defined. This only appears for platforms that */ -/* need it to differentiate between writing to a file and */ -/* the terminal screen (standard output), currently: VAX, */ -/* PC-LAHEY, PC-MS, and MAC. */ - -/* - SPICELIB Version 1.0.0, 20-DEC-1995 (KRG) */ - -/* The routine graduated */ - -/* - Beta Version 3.1.0, 18-AUG-1995 (KRG) */ - -/* Moved the PC-LAHEY environment indicator from one environment */ -/* case to the other. The Lahey compiler on the PC does treat text */ -/* files and the standard output device differently. */ - -/* - Beta Version 3.0.1, 01-JAN-1995 (KRG) */ - -/* Moved the description of the input variable UNIT from the $ */ -/* Detailed_Output section of the header to the correct location */ -/* in the $ Detailed_Input section of the header. */ - -/* - Beta Version 3.0.0, 11-JUL-1994 (HAN) */ - -/* Edited master source file to correct the code for the */ -/* PC/Microsoft FORTRAN PowerStation environment. It should use */ -/* the same code as the VAX, not the PC/Lahey Fortran code. Also, */ -/* code was included for the DEC Alpha OpenVMS/DEC Fortran and */ -/* Sun Solaris/Sun Fortran environments. */ - -/* - Beta Version 2.0.0, 30-MAR-1994 (HAN) */ - -/* Edited master source file to include new environments: */ -/* Silicon Graphics IRIX/Silicon Graphics Fortran, */ -/* DEC Alpha-OSF/1, and NeXT/Absoft Fortran. */ - -/* - Beta Version 1.0.0, 17-DEC-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* write a text line to a logical unit */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 08-APR-1998 (NJB) */ - -/* Module was updated for the PC-LINUX platform. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ - -/* For the Macintosh, we need to use real Fortran I/O, i.e., */ -/* using the first column for carriage control. The change */ -/* was to move the MAC environment indicator from one */ -/* environment case to the other. */ - -/* Also, for UNIX environments, the parameter STDOUT is no */ -/* longer defined. This only appears for platforms that */ -/* need it to differentiate between writing to a file and */ -/* the terminal screen (standard output), currently: VAX, */ -/* PC-LAHEY, PC-MS, and MAC. */ - -/* - SPICELIB Version 1.0.0, 20-DEC-1995 (KRG) */ - -/* The routine graduated */ - -/* - Beta Version 3.1.0, 18-AUG-1995 (KRG) */ - -/* Moved the PC-LAHEY environment indicator from one environment */ -/* case to the other. The Lahey compiler on the PC does treat text */ -/* files and the standard output device differently. */ - -/* - Beta Version 3.0.1, 01-JAN-1995 (KRG) */ - -/* Moved the description of the input variable UNIT from the $ */ -/* Detailed_Output section of the header to the correct location */ -/* in the $ Detailed_Input section of the header. */ - -/* - Beta Version 3.0.0, 11-JUL-1994 (HAN) */ - -/* Edited master source file to correct the code for the */ -/* PC/Microsoft FORTRAN PowerStation environment. It should use */ -/* the same code as the VAX, not the PC/Lahey Fortran code. Also, */ -/* code was included for the DEC Alpha OpenVMS/DEC Fortran and */ -/* Sun Solaris/Sun Fortran environments. */ - -/* - Beta Version 2.0.0, 30-MAR-1994 (HAN) */ - -/* Edited master source file to include new environments: */ -/* Silicon Graphics IRIX/Silicon Graphics Fortran, */ -/* DEC Alpha-OSF/1, and NeXT/Absoft Fortran. */ - -/* - Beta Version 1.0.0, 17-DEC-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* UNIX based fortran implementations typically do not distinguish */ -/* between a text file and the standard output unit, so no leading */ -/* vertical spacing character is required. */ - - ci__1.cierr = 1; - ci__1.ciunit = *unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, rtrim_(line, line_len)); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - -/* Check to see if we got a write error, and signal it if we did. */ -/* Also check in and check out. */ - - if (iostat != 0) { - chkin_("WRITLN", (ftnlen)6); - setmsg_("Error Writing to file: #. IOSTAT = #.", (ftnlen)37); - errfnm_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("WRITLN", (ftnlen)6); - return 0; - } - return 0; -} /* writln_ */ - diff --git a/ext/spice/src/cspice/wrkvar.c b/ext/spice/src/cspice/wrkvar.c deleted file mode 100644 index 6c0f87efd3..0000000000 --- a/ext/spice/src/cspice/wrkvar.c +++ /dev/null @@ -1,346 +0,0 @@ -/* wrkvar.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; -static integer c__5 = 5; - -/* $Procedure WRKVAR ( Write a variable to a kernel file ) */ -/* Subroutine */ int wrkvar_(integer *unit, char *name__, char *dirctv, char * - tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen - dirctv_len, ftnlen tabsym_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), - e_wsle(void); - - /* Local variables */ - char line[132]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int ioerr_(char *, char *, integer *, ftnlen, - ftnlen), ljust_(char *, char *, ftnlen, ftnlen), rjust_(char *, - char *, ftnlen, ftnlen); - integer margin; - doublereal dvalue; - integer vardim, varlen; - extern integer sydimd_(char *, char *, integer *, doublereal *, ftnlen, - ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer iostat; - extern /* Subroutine */ int synthd_(char *, integer *, char *, integer *, - doublereal *, doublereal *, logical *, ftnlen, ftnlen); - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___9 = { 1, 0, 0, 0, 0 }; - static cilist io___10 = { 1, 0, 0, 0, 0 }; - static cilist io___11 = { 1, 0, 0, 0, 0 }; - static cilist io___12 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Write the value of a variable in a double precision symbol */ -/* table to a NAIF ASCII kernel file. */ - -/* $ 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 */ - -/* KERNEL, SYMBOLS */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Output logical unit. */ -/* NAME I Name of the variable. */ -/* DIRCTV I Kernel directive: '=' or '+='. */ -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL I/O Symbol table. */ - -/* $ Detailed_Input */ - -/* UNIT is the logical unit to which the variable will be */ -/* written. This is usually the logical unit to which */ -/* the output kernel file is connected. */ - -/* NAME is the name of the variable to be written to UNIT. */ - -/* DIRCTV is the directive linking NAME and its associated */ -/* values in the kernel file. This may be any of the */ -/* directives recognized by RDKVAR. */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol */ -/* table. On input, the table may or may not contain */ -/* any variables. */ - -/* $ Detailed_Output */ - -/* TABSYM, */ -/* TABPTR, */ -/* TABVAL are the components of a double precision symbol */ -/* table. This subroutine does not change the components; */ -/* they contain the same values on output as they did */ -/* on input. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* If the variable is to be written to an output kernel file, the */ -/* file should be opened with a logical unit determined by the */ -/* calling program. */ - -/* $ Exceptions */ - -/* 1) If an error occurs writing the variable to UNIT, the */ -/* error SPICE(WRITEERROR) is signalled. */ - -/* $ Particulars */ - -/* If the table symbol table does not contain any variables, nothing */ -/* will be written to UNIT. */ - -/* $ Examples */ - -/* If NAME = 'MEAN_ANOM' */ -/* DIRCTV = '=' */ - -/* And the contents of the symbol table are: */ - -/* DELTA_T_A --> 32.184 */ -/* K --> 0.D0 */ -/* MEAN_ANOM --> 6.239996D0 */ -/* 1.99096871D-7 */ -/* ORBIT_ECC --> 1.671D-2 */ - -/* The output to UNIT might look like this, depending on the */ -/* length of the symbol table variables: */ - -/* MEAN_ANOM = ( 6.239996D0, */ -/* 1.99096871D-7 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* write a variable to a kernel file */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 20-DEC-1988 (NJB) */ - -/* Call to IOERR changed to be consistent with new calling */ -/* protocol. SETMSG call deleted, since IOERR now calls SETMSG. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("WRKVAR", (ftnlen)6); - } - -/* Preliminary measurements. */ - - varlen = i_len(tabsym + tabsym_len * 6, tabsym_len); - margin = varlen + 6; - vardim = sydimd_(name__, tabsym, tabptr, tabval, name_len, tabsym_len); - -/* One value per line. */ - - i__1 = vardim; - for (i__ = 1; i__ <= i__1; ++i__) { - synthd_(name__, &i__, tabsym, tabptr, tabval, &dvalue, &found, - name_len, tabsym_len); - -/* The first line contains the variable name, the directive, */ -/* an optional left parenthesis, and the first value. The values */ -/* of a multi-dimensional variable are separated by commas. */ - - if (i__ == 1) { - ljust_(name__, line, name_len, (ftnlen)132); - i__2 = margin - 5; - rjust_(dirctv, line + i__2, dirctv_len, margin - 3 - i__2); - if (vardim > 1) { - i__2 = margin - 2; - s_copy(line + i__2, "(", margin - 1 - i__2, (ftnlen)1); - io___9.ciunit = *unit; - iostat = s_wsle(&io___9); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, line, margin); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__5, &c__1, (char *)&dvalue, (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, ", ", (ftnlen)2); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsle(); -L100001: - ; - } else { - io___10.ciunit = *unit; - iostat = s_wsle(&io___10); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__9, &c__1, line, margin); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__5, &c__1, (char *)&dvalue, (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsle(); -L100002: - ; - } - -/* The last line of a multi-dimensional variable ends with a */ -/* right parenthesis. */ - - } else if (i__ > 1 && i__ == vardim) { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - io___11.ciunit = *unit; - iostat = s_wsle(&io___11); - if (iostat != 0) { - goto L100003; - } - iostat = do_lio(&c__9, &c__1, line, margin); - if (iostat != 0) { - goto L100003; - } - iostat = do_lio(&c__5, &c__1, (char *)&dvalue, (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100003; - } - iostat = do_lio(&c__9, &c__1, " )", (ftnlen)3); - if (iostat != 0) { - goto L100003; - } - iostat = e_wsle(); -L100003: - ; - } else { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - io___12.ciunit = *unit; - iostat = s_wsle(&io___12); - if (iostat != 0) { - goto L100004; - } - iostat = do_lio(&c__9, &c__1, line, margin); - if (iostat != 0) { - goto L100004; - } - iostat = do_lio(&c__5, &c__1, (char *)&dvalue, (ftnlen)sizeof( - doublereal)); - if (iostat != 0) { - goto L100004; - } - iostat = do_lio(&c__9, &c__1, ", ", (ftnlen)2); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsle(); -L100004: - ; - } - } - if (iostat != 0) { - ioerr_("writing a variable to the output kernel file", " ", &iostat, ( - ftnlen)44, (ftnlen)1); - sigerr_("SPICE(WRITEERROR)", (ftnlen)17); - } - chkout_("WRKVAR", (ftnlen)6); - return 0; -} /* wrkvar_ */ - diff --git a/ext/spice/src/cspice/wrline.c b/ext/spice/src/cspice/wrline.c deleted file mode 100644 index 93c9c8766e..0000000000 --- a/ext/spice/src/cspice/wrline.c +++ /dev/null @@ -1,965 +0,0 @@ -/* wrline.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__9 = 9; -static integer c__3 = 3; -static integer c__0 = 0; -static integer c__2 = 2; - -/* $Procedure WRLINE ( Write Output Line to a Device ) */ -/* Subroutine */ int wrline_0_(int n__, char *device, char *line, ftnlen - device_len, ftnlen line_len) -{ - /* System generated locals */ - integer i__1; - cilist ci__1; - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio( - integer *, char *, ftnlen), e_wsfe(void), f_inqu(inlist *), - s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), - e_wsle(void), f_open(olist *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer f_clos(cllist *); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - extern integer ltrim_(char *, ftnlen); - char error[240]; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - logical opened; - extern /* Subroutine */ int fndlun_(integer *); - char tmpnam[255]; - integer iostat; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - logical exists; - char errstr[11]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - - /* Fortran I/O blocks */ - static cilist io___6 = { 0, 6, 0, 0, 0 }; - static cilist io___7 = { 0, 6, 0, 0, 0 }; - static cilist io___8 = { 0, 6, 0, 0, 0 }; - static cilist io___9 = { 0, 6, 0, 0, 0 }; - static cilist io___10 = { 0, 6, 0, 0, 0 }; - static cilist io___11 = { 0, 6, 0, 0, 0 }; - static cilist io___12 = { 0, 6, 0, 0, 0 }; - static cilist io___15 = { 0, 6, 0, 0, 0 }; - static cilist io___16 = { 0, 6, 0, 0, 0 }; - static cilist io___17 = { 0, 6, 0, 0, 0 }; - static cilist io___18 = { 0, 6, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Write a character string to an output device. */ - -/* $ 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 */ - -/* TEXT */ -/* FILES */ -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DEVICE I A string specifying an output device. */ -/* LINE I A line of text to be output. */ -/* FILEN P Maximum length of a file name. */ - -/* $ Detailed_Input */ - -/* LINE is a line of text to be written to the output */ -/* device specified by DEVICE. */ - -/* DEVICE is the output device to which the line of text */ -/* will be written. */ - -/* Possible values and meanings of DEVICE are: */ - -/* a device name This may be the name of a */ -/* file, or any other name that */ -/* is valid in a FORTRAN OPEN */ -/* statement. For example, on a */ -/* VAX, a logical name may be */ -/* used. */ - -/* The device name must not */ -/* be any of the reserved strings */ -/* below. */ - - -/* 'SCREEN' The output will go to the */ -/* terminal screen. */ - - -/* 'NULL' The data will not be output. */ - - -/* 'SCREEN' and 'NULL' can be written in mixed */ -/* case. For example, the following call will work: */ - -/* CALL WRLINE ( 'screEn', LINE ) */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* FILEN is the maximum length of a file name. */ - -/* $ Exceptions */ - -/* This routine is a special case as far as error handling */ -/* is concerned because it is called to output error */ -/* messages resulting from errors detected by other routines. */ -/* In such a case, calling SIGERR would constitute recursion. */ -/* Therefore, this routine prints error messages rather */ -/* than signalling errors via SIGERR and setting the long */ -/* error message via SETMSG. */ - -/* The following exceptional cases are treated as errors: */ - -/* 1) SPICE(NOFREELOGICALUNIT) -- No logical unit number */ -/* is available to refer to the device. */ - -/* 2) SPICE(FILEOPENFAILED) -- General file open error. */ - -/* 3) SPICE(FILEWRITEFAILED) -- General file write error. */ - -/* 4) SPICE(INQUIREFAILED) -- INQUIRE statement failed. */ - -/* 5) Leading blanks in (non-blank) file names are not */ -/* significant. The file names */ - -/* 'MYFILE.DAT' */ -/* ' MYFILE.DAT' */ - -/* are considered to name the same file. */ - -/* 6) If different names that indicate the same file are supplied */ -/* to this routine on different calls, all output associated */ -/* with these calls WILL be written to the file. For example, */ -/* on a system where logical filenames are supported, if */ -/* ALIAS is a logical name pointing to MYFILE, then the calls */ - -/* CALL WRLINE ( 'MYFILE', 'This is the first line' ) */ -/* CALL WRLINE ( 'ALIAS', 'This is the second line' ) */ - -/* will place the lines of text */ - -/* 'This is the first line' */ -/* 'This is the second line' */ - -/* in MYFILE. See $Restrictions for more information on use */ -/* of logical names on VAX systems. */ - -/* $ Files */ - -/* 1) If DEVICE specifies a device other than 'SCREEN' or 'NULL', */ -/* that device is opened (if it's not already open) as a NEW, */ -/* SEQUENTIAL, FORMATTED file. The logical unit used is */ -/* determined at run time. */ - -/* $ Particulars */ - -/* If the output device is a file that is not open, the file will */ -/* be opened (if possible) as a NEW, sequential, formatted file, */ -/* and the line of text will be written to the file. If the file */ -/* is already opened as a sequential, formatted file, the line of */ -/* text will be written to the file. */ - -/* Use the entry point CLLINE to close files opened by WRLINE. */ - -/* $ Examples */ - -/* 1) Write a message to the screen: */ - -/* CALL WRLINE ( 'SCREEN', 'Here''s a message.' ) */ - -/* The text */ - -/* Here's a message. */ - -/* will be written to the screen. */ - - -/* 2) Write out all of the elements of a character string array */ -/* to a file. */ - -/* CHARACTER*(80) STRING ( ASIZE ) */ -/* . */ -/* . */ -/* . */ -/* DO I = 1, ASIZE */ -/* CALL WRLINE ( FILE, STRING(I) ) */ -/* END DO */ - - -/* 3) Set DEVICE to NULL to suppress output: */ - -/* C */ -/* C Ask the user whether verbose program output is */ -/* C desired. Set the output device accordingly. */ -/* C */ -/* WRITE (*,*) 'Do you want to see test results ' // */ -/* . 'on the screen?' */ -/* READ (*,FMT='(A)') VERBOS */ - -/* CALL LJUST ( VERBOS, VERBOS ) */ -/* CALL UCASE ( VERBOS, VERBOS ) */ - -/* IF ( VERBOS(1:1) .EQ. 'Y' ) THEN */ -/* DEVICE = 'SCREEN' */ -/* ELSE */ -/* DEVICE = 'NULL' */ -/* ENDIF */ -/* . */ -/* . */ -/* . */ -/* C */ -/* C Output test results. */ -/* C */ -/* CALL WRLINE ( DEVICE, STRING ) */ -/* . */ -/* . */ -/* . */ - -/* $ Restrictions */ - -/* 1) File names must not exceed FILEN characters. */ - -/* 2) On VAX systems, caution should be exercised when using */ -/* multiple logical names to point to the same file. Logical */ -/* name translation supporting execution of the Fortran */ -/* INQUIRE statement does not appear to work reliably in all */ -/* cases, which may lead this routine to believe that different */ -/* logical names indicate different files. The specific problem */ -/* that has been observed is that logical names that include */ -/* disk specifications are not always recognized as pointing */ -/* to the file they actually name. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.3, 16-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. The */ -/* write format for the case where the output device is the */ -/* screen has been made system-dependent; list-directed output */ -/* format is now used for systems that require a leading carriage */ -/* control character; other systems use character format. The */ -/* write format for the case where the output device is a file */ -/* has been changed from list-directed to character. */ - - -/* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* and the appropriate OPEN statement for the Silicon */ -/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */ -/* value of 256 for Unix platforms was changed to 255. */ - -/* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */ - -/* Module was updated to include the value of FILEN for the */ -/* Hewlett Packard UX 9000/750 environment. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */ - -/* This routine now can write to files that have been opened */ -/* by other routines. */ - -/* The limit imposed by this routine on the number of files it */ -/* can open has been removed. */ - -/* The output file is now opened as a normal text file on */ -/* VAX systems. */ - -/* Improper treatment of the case where DEVICE is blank was */ -/* remedied. */ - -/* Unneeded variable declarations and references were removed. */ - -/* Initialization of SAVED variables was added. */ - -/* All occurrences of "PRINT *" have been replaced by */ -/* "WRITE (*,*)". */ - -/* Calls to UCASE and LJUST replace in-line code that performed */ -/* these operations. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* write output line to a device */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */ - -/* References to the PC-LINUX environment were added. */ - -/* The write format for the case where the output device is the */ -/* screen has been made system-dependent; list-directed output */ -/* format is now used for systems that require a leading carriage */ -/* control character; other systems use character format. The */ -/* write format for the case where the output device is a file */ -/* has been changed from list-directed to character. */ - -/* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */ - -/* Module was updated to include the value for FILEN */ -/* and the appropriate OPEN statement for the Silicon */ -/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */ -/* value of 256 for Unix platforms was changed to 255. */ - -/* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */ - -/* Module was updated to include the value of FILEN for the */ -/* Hewlett Packard UX 9000/750 environment. */ - -/* The code was also reformatted so that a utility program can */ -/* create the source file for a specific environment given a */ -/* master source file. */ - -/* - SPICELIB Version 2.0.0, 25-MAR-1991 (NJB) */ - -/* 1) This routine now can write to files that have been opened */ -/* by other routines. WRLINE uses an INQUIRE statement to */ -/* determine whether the file indicated by DEVICE is open, */ -/* and if it is, WRLINE does not attempt to open it. This */ -/* allows use of WRLINE to feed error output into a log file */ -/* opened by another routine. */ - -/* The header has been updated accordingly. */ - -/* This fix also fixes a bug wherein this routine would treat */ -/* different character strings naming the same file as though */ -/* they indicated different files. */ - -/* 2) The limit imposed by this routine on the number of files it */ -/* can open has been removed. The file database used in */ -/* previous versions of this routine is no longer used. */ - -/* 3) On VAX systems, this routine now opens the output file */ -/* (when required to do so) as a normal text file. */ - -/* 4) Improper treatment of the case where DEVICE is blank was */ -/* remedied. Any value of DEVICE that is not equal to */ -/* 'SCREEN' or 'NULL' after being left-justified and */ -/* converted to upper case is considered to be a file name. */ - -/* 5) Unneeded variable declarations and references were removed. */ -/* The arrays called STATUS and FILES are not needed. */ - -/* 6) All instances if "PRINT *" have been replaced by */ -/* "WRITE (*,*)" because Language Systems Fortran on the */ -/* Macintosh interprets "PRINT *" in a non-standard manner. */ - -/* 7) Use of the EXIST specifier was added to the INQUIRE */ -/* statement used to determine whether the file named by */ -/* DEVICE is open. This is a work-around for a rather */ -/* peculiar behavior of at least one version of Sun Fortran: */ -/* files that don't exist may be considered to be open, as */ -/* indicated by the OPENED specifier of the INQUIRE statement. */ - -/* 8) One other thing: now that LJUST and UCASE are error-free, */ -/* WRLINE uses them; this simplifies the code. */ - - -/* - Beta Version 1.2.0, 27-FEB-1989 (NJB) */ - -/* Call to GETLUN replaced by call to FNDLUN, which is error-free. */ -/* Call to IOERR replaced with in-line code to construct long */ -/* error message indicating file open failure. Arrangement of */ -/* declarations changed. Keywords added. FILEN declaration */ -/* moved to "declarations" section. Parameters section added. */ - -/* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */ - -/* Upper bound of written substring changed to prevent use of */ -/* invalid substring bound. Specifically, LASTNB ( LINE ) was */ -/* replaced by MAX ( 1, LASTNB (LINE) ). This upper bound */ -/* now used in the PRINT statement as well. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Executable Code: */ - - switch(n__) { - case 1: goto L_clline; - } - - ljust_(device, tmpnam, device_len, (ftnlen)255); - ucase_(tmpnam, tmpnam, (ftnlen)255, (ftnlen)255); - -/* TMPNAM is now left justified and is in upper case. */ - - if (s_cmp(tmpnam, "NULL", (ftnlen)255, (ftnlen)4) == 0) { - return 0; - } else if (s_cmp(tmpnam, "SCREEN", (ftnlen)255, (ftnlen)6) == 0) { - ci__1.cierr = 1; - ci__1.ciunit = 6; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, rtrim_(line, line_len)); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsfe(); -L100001: - return 0; - } - -/* Find out whether we'll need to open the file. */ - -/* We use the EXIST inquiry specifier because files that don't exist */ -/* may be (possibly due to a Sun compiler bug) deemed to be OPEN by */ -/* Sun Fortran. */ - - i__1 = ltrim_(device, device_len) - 1; - ioin__1.inerr = 1; - ioin__1.infilen = device_len - i__1; - ioin__1.infile = device + i__1; - ioin__1.inex = &exists; - ioin__1.inopen = &opened; - ioin__1.innum = &unit; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - -/* This is weird. How can an INQUIRE statement fail, */ -/* if the syntax is correct? But just in case... */ - - s_wsle(&io___6); - do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20); - e_wsle(); - s_wsle(&io___7); - do_lio(&c__9, &c__1, "WRLINE: File = ", (ftnlen)15); - do_lio(&c__9, &c__1, device, device_len); - do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9); - do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer)); - e_wsle(); - return 0; - } - if (! (opened && exists)) { - -/* We will need a free logical unit. There is always the chance */ -/* that no units are available. */ - - fndlun_(&unit); - if (unit < 1) { - s_wsle(&io___8); - do_lio(&c__9, &c__1, "SPICE(NOFREELOGICALUNIT)", (ftnlen)24); - e_wsle(); - s_wsle(&io___9); - do_lio(&c__9, &c__1, " ", (ftnlen)1); - e_wsle(); - s_wsle(&io___10); - do_lio(&c__9, &c__1, "WRLINE: Maximum number of logical units th" - "at can be allocated by SPICELIB has already been reached", - (ftnlen)98); - e_wsle(); - return 0; - } - -/* Okay, we have a unit. Open the file, and hope nothing */ -/* goes awry. (On the VAX, the qualifier */ - -/* CARRIAGECONTROL = 'LIST' */ - -/* may be inserted into the OPEN statement.) */ - - i__1 = ltrim_(device, device_len) - 1; - o__1.oerr = 1; - o__1.ounit = unit; - o__1.ofnmlen = device_len - i__1; - o__1.ofnm = device + i__1; - o__1.orl = 0; - o__1.osta = "NEW"; - o__1.oacc = 0; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - s_wsle(&io___11); - do_lio(&c__9, &c__1, "SPICE(FILEOPENFAILED)", (ftnlen)21); - e_wsle(); - s_wsle(&io___12); - do_lio(&c__9, &c__1, " ", (ftnlen)1); - e_wsle(); - s_copy(error, "WRLINE: An error occurred while attempting to open" - , (ftnlen)240, (ftnlen)50); - suffix_(device, &c__1, error, device_len, (ftnlen)240); - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240); - suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen) - 32, (ftnlen)240); - suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240); - intstr_(&iostat, errstr, (ftnlen)11); - suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240); - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240); - s_wsle(&io___15); - do_lio(&c__9, &c__1, error, (ftnlen)240); - e_wsle(); - return 0; - } - -/* Whew! We're ready to write to this file. */ - - } - -/* At this point, either we opened the file, or it was already */ -/* opened by somebody else. */ - -/* This is the easy part. Write the next line to the file. */ - - ci__1.cierr = 1; - ci__1.ciunit = unit; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, line, rtrim_(line, line_len)); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsfe(); -L100002: - -/* Well, what happened? Any non-zero value for IOSTAT indicates */ -/* an error. */ - - if (iostat != 0) { - s_copy(error, "WRLINE: An error occurred while attempting to WRITE t" - "o ", (ftnlen)240, (ftnlen)55); - suffix_(device, &c__1, error, device_len, (ftnlen)240); - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240); - suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)32, - (ftnlen)240); - suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240); - intstr_(&iostat, errstr, (ftnlen)11); - suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240); - suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240); - s_wsle(&io___16); - do_lio(&c__9, &c__1, error, (ftnlen)240); - e_wsle(); - return 0; - } - return 0; -/* $Procedure CLLINE ( Close a device ) */ - -L_clline: -/* $ Abstract */ - -/* Close a device. */ - -/* $ 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 */ - -/* TEXT, FILES, ERROR */ - -/* $ Declarations */ - -/* CHARACTER*(*) DEVICE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DEVICE I Device to be closed. */ - -/* $ Detailed_Input */ - -/* DEVICE is the name of a device which is currently */ -/* opened for reading or writing. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* This routine is called by SPICELIB error handling routines, so */ -/* it cannot use the normal SPICELIB error signalling mechanism. */ -/* Instead, it writes error messages to the screen if necessary. */ - -/* 1) If the device indicated by DEVICE was not opened by WRLINE, */ -/* this routine closes it anyway. */ - -/* 2) If the INQUIRE performed by this routine fails, an error */ -/* diagnosis is printed to the screen. */ - -/* $ Files */ - -/* This routin */ - -/* $ Particulars */ - -/* CLLINE closes a device that is currently open. */ - -/* $ Examples */ - -/* 1) Write two lines to the file, SPUD.DAT (VAX file name */ -/* syntax), and then close the file. */ - -/* CALL WRLINE ( 'SPUD.DAT', ' This is line 1 ' ) */ -/* CALL WRLINE ( 'SPUD.DAT', ' This is line 2 ' ) */ -/* CALL CLLINE ( 'SPUD.DAT' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */ - -/* All occurrences of "PRINT *" have been replaced by */ -/* "WRITE (*,*)". */ - -/* Also, this routine now closes the device named by DEVICE */ -/* whether or not the device was opened by WRLINE. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* None. */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */ - -/* All instances if "PRINT *" have been replaced by "WRITE (*,*)" */ -/* because Language Systems Fortran on the Macintosh interprets */ -/* "PRINT *" in a non-standard manner. */ - -/* This routine no longer has to maintain the file database, since */ -/* WRLINE does not use it any more. */ - -/* Also, this routine now closes the device named by DEVICE, */ -/* whether or not the device was opened by WRLINE. */ - -/* - Beta Version 1.0.1, 08-NOV-1988 (NJB) */ - -/* Keywords added. */ -/* -& */ - -/* Find the unit connected to DEVICE. */ - - i__1 = ltrim_(device, device_len) - 1; - ioin__1.inerr = 1; - ioin__1.infilen = device_len - i__1; - ioin__1.infile = device + i__1; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = &unit; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - -/* This is weird. How can an INQUIRE statement fail, */ -/* if the syntax is correct? But just in case... */ - - s_wsle(&io___17); - do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20); - e_wsle(); - s_wsle(&io___18); - do_lio(&c__9, &c__1, "CLLINE: File = ", (ftnlen)16); - do_lio(&c__9, &c__1, device, device_len); - do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9); - do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer)); - e_wsle(); - return 0; - } - cl__1.cerr = 0; - cl__1.cunit = unit; - cl__1.csta = 0; - f_clos(&cl__1); - return 0; -} /* wrline_ */ - -/* Subroutine */ int wrline_(char *device, char *line, ftnlen device_len, - ftnlen line_len) -{ - return wrline_0_(0, device, line, device_len, line_len); - } - -/* Subroutine */ int clline_(char *device, ftnlen device_len) -{ - return wrline_0_(1, device, (char *)0, device_len, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/wrtfmt.c b/ext/spice/src/cspice/wrtfmt.c deleted file mode 100644 index 477c40f5d3..0000000000 --- a/ext/spice/src/cspice/wrtfmt.c +++ /dev/null @@ -1,365 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" - -extern icilist *f__svic; -extern char *f__icptr; - - static int -mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */ - /* instead we know too much about stdio */ -{ - int cursor = f__cursor; - f__cursor = 0; - if(f__external == 0) { - if(cursor < 0) { - if(f__hiwater < f__recpos) - f__hiwater = f__recpos; - f__recpos += cursor; - f__icptr += cursor; - if(f__recpos < 0) - err(f__elist->cierr, 110, "left off"); - } - else if(cursor > 0) { - if(f__recpos + cursor >= f__svic->icirlen) - err(f__elist->cierr, 110, "recend"); - if(f__hiwater <= f__recpos) - for(; cursor > 0; cursor--) - (*f__putn)(' '); - else if(f__hiwater <= f__recpos + cursor) { - cursor -= f__hiwater - f__recpos; - f__icptr += f__hiwater - f__recpos; - f__recpos = f__hiwater; - for(; cursor > 0; cursor--) - (*f__putn)(' '); - } - else { - f__icptr += cursor; - f__recpos += cursor; - } - } - return(0); - } - if (cursor > 0) { - if(f__hiwater <= f__recpos) - for(;cursor>0;cursor--) (*f__putn)(' '); - else if(f__hiwater <= f__recpos + cursor) { - cursor -= f__hiwater - f__recpos; - f__recpos = f__hiwater; - for(; cursor > 0; cursor--) - (*f__putn)(' '); - } - else { - f__recpos += cursor; - } - } - else if (cursor < 0) - { - if(cursor + f__recpos < 0) - err(f__elist->cierr,110,"left off"); - if(f__hiwater < f__recpos) - f__hiwater = f__recpos; - f__recpos += cursor; - } - return(0); -} - - static int -#ifdef KR_headers -wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len; -#else -wrt_Z(Uint *n, int w, int minlen, ftnlen len) -#endif -{ - register char *s, *se; - register int i, w1; - static int one = 1; - static char hex[] = "0123456789ABCDEF"; - s = (char *)n; - --len; - if (*(char *)&one) { - /* little endian */ - se = s; - s += len; - i = -1; - } - else { - se = s + len; - i = 1; - } - for(;; s += i) - if (s == se || *s) - break; - w1 = (i*(se-s) << 1) + 1; - if (*s & 0xf0) - w1++; - if (w1 > w) - for(i = 0; i < w; i++) - (*f__putn)('*'); - else { - if ((minlen -= w1) > 0) - w1 += minlen; - while(--w >= w1) - (*f__putn)(' '); - while(--minlen >= 0) - (*f__putn)('0'); - if (!(*s & 0xf0)) { - (*f__putn)(hex[*s & 0xf]); - if (s == se) - return 0; - s += i; - } - for(;; s += i) { - (*f__putn)(hex[*s >> 4 & 0xf]); - (*f__putn)(hex[*s & 0xf]); - if (s == se) - break; - } - } - return 0; - } - - static int -#ifdef KR_headers -wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base; -#else -wrt_I(Uint *n, int w, ftnlen len, register int base) -#endif -{ int ndigit,sign,spare,i; - longint x; - char *ans; - if(len==sizeof(integer)) x=n->il; - else if(len == sizeof(char)) x = n->ic; -#ifdef Allow_TYQUAD - else if (len == sizeof(longint)) x = n->ili; -#endif - else x=n->is; - ans=f__icvt(x,&ndigit,&sign, base); - spare=w-ndigit; - if(sign || f__cplus) spare--; - if(spare<0) - for(i=0;iil; - else if(len == sizeof(char)) x = n->ic; -#ifdef Allow_TYQUAD - else if (len == sizeof(longint)) x = n->ili; -#endif - else x=n->is; - ans=f__icvt(x,&ndigit,&sign, base); - if(sign || f__cplus) xsign=1; - else xsign=0; - if(ndigit+xsign>w || m+xsign>w) - { for(i=0;i=m) - spare=w-ndigit-xsign; - else - spare=w-m-xsign; - for(i=0;iil; - else if(sz == sizeof(char)) x = n->ic; - else x=n->is; - for(i=0;i 0) (*f__putn)(*p++); - return(0); -} - static int -#ifdef KR_headers -wrt_AW(p,w,len) char * p; ftnlen len; -#else -wrt_AW(char * p, int w, ftnlen len) -#endif -{ - while(w>len) - { w--; - (*f__putn)(' '); - } - while(w-- > 0) - (*f__putn)(*p++); - return(0); -} - - static int -#ifdef KR_headers -wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; -#else -wrt_G(ufloat *p, int w, int d, int e, ftnlen len) -#endif -{ double up = 1,x; - int i=0,oldscale,n,j; - x = len==sizeof(real)?p->pf:p->pd; - if(x < 0 ) x = -x; - if(x<.1) { - if (x != 0.) - return(wrt_E(p,w,d,e,len)); - i = 1; - goto have_i; - } - for(;i<=d;i++,up*=10) - { if(x>=up) continue; - have_i: - oldscale = f__scale; - f__scale = 0; - if(e==0) n=4; - else n=e+2; - i=wrt_F(p,w-n,d-i,len); - for(j=0;jop) - { - default: - fprintf(stderr,"w_ed, unexpected code: %d\n", p->op); - sig_die(f__fmtbuf, 1); - case I: return(wrt_I((Uint *)ptr,p->p1,len, 10)); - case IM: - return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10)); - - /* O and OM don't work right for character, double, complex, */ - /* or doublecomplex, and they differ from Fortran 90 in */ - /* showing a minus sign for negative values. */ - - case O: return(wrt_I((Uint *)ptr, p->p1, len, 8)); - case OM: - return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8)); - case L: return(wrt_L((Uint *)ptr,p->p1, len)); - case A: return(wrt_A(ptr,len)); - case AW: - return(wrt_AW(ptr,p->p1,len)); - case D: - case E: - case EE: - return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); - case G: - case GE: - return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); - case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len)); - - /* Z and ZM assume 8-bit bytes. */ - - case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len)); - case ZM: - return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len)); - } -} -#ifdef KR_headers -w_ned(p) struct syl *p; -#else -w_ned(struct syl *p) -#endif -{ - switch(p->op) - { - default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op); - sig_die(f__fmtbuf, 1); - case SLASH: - return((*f__donewrec)()); - case T: f__cursor = p->p1-f__recpos - 1; - return(1); - case TL: f__cursor -= p->p1; - if(f__cursor < -f__recpos) /* TL1000, 1X */ - f__cursor = -f__recpos; - return(1); - case TR: - case X: - f__cursor += p->p1; - return(1); - case APOS: - return(wrt_AP(p->p2.s)); - case H: - return(wrt_H(p->p1,p->p2.s)); - } -} diff --git a/ext/spice/src/cspice/wsfe.c b/ext/spice/src/cspice/wsfe.c deleted file mode 100644 index a74e2d5c2a..0000000000 --- a/ext/spice/src/cspice/wsfe.c +++ /dev/null @@ -1,73 +0,0 @@ -/*write sequential formatted external*/ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" -extern int f__hiwater; - - int -x_wSL(Void) -{ - int n = f__putbuf('\n'); - f__hiwater = f__recpos = f__cursor = 0; - return(n == 0); -} - - static int -xw_end(Void) -{ - int n; - - if(f__nonl) { - f__putbuf(n = 0); - fflush(f__cf); - } - else - n = f__putbuf('\n'); - f__hiwater = f__recpos = f__cursor = 0; - return n; -} - - static int -xw_rev(Void) -{ - int n = 0; - if(f__workdone) { - n = f__putbuf('\n'); - f__workdone = 0; - } - f__hiwater = f__recpos = f__cursor = 0; - return n; -} - -#ifdef KR_headers -integer s_wsfe(a) cilist *a; /*start*/ -#else -integer s_wsfe(cilist *a) /*start*/ -#endif -{ int n; - if(!f__init) f_init(); - f__reading=0; - f__sequential=1; - f__formatted=1; - f__external=1; - if(n=c_sfe(a)) return(n); - f__elist=a; - f__hiwater = f__cursor=f__recpos=0; - f__nonl = 0; - f__scale=0; - f__fmtbuf=a->cifmt; - f__cf=f__curunit->ufd; - if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); - f__putn= x_putc; - f__doed= w_ed; - f__doned= w_ned; - f__doend=xw_end; - f__dorevert=xw_rev; - f__donewrec=x_wSL; - fmt_bg(); - f__cplus=0; - f__cblank=f__curunit->ublnk; - if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) - err(a->cierr,errno,"write start"); - return(0); -} diff --git a/ext/spice/src/cspice/wsle.c b/ext/spice/src/cspice/wsle.c deleted file mode 100644 index 4bb862f43d..0000000000 --- a/ext/spice/src/cspice/wsle.c +++ /dev/null @@ -1,36 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "fmt.h" -#include "lio.h" -#include "string.h" - -#ifdef KR_headers -integer s_wsle(a) cilist *a; -#else -integer s_wsle(cilist *a) -#endif -{ - int n; - if(n=c_le(a)) return(n); - f__reading=0; - f__external=1; - f__formatted=1; - f__putn = x_putc; - f__lioproc = l_write; - L_len = LINE; - f__donewrec = x_wSL; - if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) - err(a->cierr, errno, "list output start"); - return(0); - } - -integer e_wsle(Void) -{ - int n = f__putbuf('\n'); - f__recpos=0; -#ifdef ALWAYS_FLUSH - if (!n && fflush(f__cf)) - err(f__elist->cierr, errno, "write end"); -#endif - return(n); - } diff --git a/ext/spice/src/cspice/wsne.c b/ext/spice/src/cspice/wsne.c deleted file mode 100644 index ae3f817894..0000000000 --- a/ext/spice/src/cspice/wsne.c +++ /dev/null @@ -1,26 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "lio.h" - - integer -#ifdef KR_headers -s_wsne(a) cilist *a; -#else -s_wsne(cilist *a) -#endif -{ - int n; - - if(n=c_le(a)) - return(n); - f__reading=0; - f__external=1; - f__formatted=1; - f__putn = x_putc; - L_len = LINE; - f__donewrec = x_wSL; - if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) - err(a->cierr, errno, "namelist output start"); - x_wsne(a); - return e_wsle(); - } diff --git a/ext/spice/src/cspice/xf2eul.c b/ext/spice/src/cspice/xf2eul.c deleted file mode 100644 index 8574499431..0000000000 --- a/ext/spice/src/cspice/xf2eul.c +++ /dev/null @@ -1,1234 +0,0 @@ -/* xf2eul.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure XF2EUL ( State transformation to Euler angles ) */ -/* Subroutine */ int xf2eul_0_(int n__, doublereal *xform, integer *axisa, - integer *axisb, integer *axisc, doublereal *eulang, logical *unique) -{ - /* Initialized data */ - - static doublereal delta[9] /* was [3][3] */ = { 0.,-1.,1.,1.,0.,-1.,-1., - 1.,0. }; - static integer next[3] = { 2,3,1 }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal drdt[9] /* was [3][3] */; - extern /* Subroutine */ int mxmt_(doublereal *, doublereal *, doublereal * - ), m2eul_(doublereal *, integer *, integer *, integer *, - doublereal *, doublereal *, doublereal *), eul2m_(doublereal *, - doublereal *, doublereal *, integer *, integer *, integer *, - doublereal *); - integer a, b; - doublereal d__; - integer i__, j, k, l; - doublereal r__[9] /* was [3][3] */, u, v, omega[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - doublereal ca; - extern logical failed_(void); - doublereal sa, domega[3], locang[6]; - integer locaxa, locaxb, locaxc; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal drdtrt[9] /* was [3][3] */; - extern logical return_(void); - doublereal solutn[9] /* was [3][3] */; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - , mxv_(doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Convert a state transformation matrix to Euler angles and their */ -/* derivatives with respect to a specified set of axes. */ - -/* The companion entry point EUL2XF converts Euler angles and their */ -/* derivatives with respect to a specified set of axes to a state */ -/* transformation matrix. */ - -/* $ 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 */ - -/* ROTATION */ -/* PCK */ - -/* $ Keywords */ - -/* ANGLES */ -/* STATE */ -/* DERIVATIVES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* XFORM I A state transformation matrix. */ -/* AXISA I Axis A of the Euler angle factorization. */ -/* AXISB I Axis B of the Euler angle factorization. */ -/* AXISC I Axis C of the Euler angle factorization. */ -/* EULANG O An array of Euler angles and their derivatives. */ -/* UNIQUE O Indicates if EULANG is a unique representation. */ - -/* $ Detailed_Input */ - -/* XFORM is a state transformation from some frame FRAME1 to */ -/* another frame FRAME2. Pictorially, XFORM has the */ -/* structure shown here. */ - -/* [ | ] */ -/* | R | 0 | */ -/* | | | */ -/* |-------+--------| */ -/* | | | */ -/* | dR/dt | R | */ -/* [ | ] */ - -/* where R is a rotation that varies with respect to time */ -/* and dR/dt is its time derivative. */ - -/* More specifically, if S1 is the state of some object */ -/* in FRAME1, then S2, the state of the same object */ -/* relative to FRAME2 is given by */ - -/* S2 = XFORM*S1 */ - -/* where '*' denotes the matrix vector product. */ - -/* AXISA are the axes desired for the factorization of R. */ -/* AXISB All must be in the range from 1 to 3. Moreover */ -/* AXISC it must be the case that AXISA and AXISB are distinct */ -/* and that AXISB and AXISC are distinct. */ - -/* Every rotation matrix can be represented as a product */ -/* of three rotation matrices about the principal axes */ -/* of a reference frame. */ - -/* R = [ ALPHA ] [ BETA ] [ GAMMA ] */ -/* AXISA AXISB AXISC */ - -/* The value 1 corresponds to the X axis. */ -/* The value 2 corresponds to the Y axis. */ -/* The value 3 corresponds to the Z axis. */ - -/* $ Detailed_Output */ - -/* EULANG is the set of Euler angles corresponding to the */ -/* specified factorization. */ - -/* If we represent R as shown here: */ - -/* R = [ ALPHA ] [ BETA ] [ GAMMA ] */ -/* AXISA AXISB AXISC */ - -/* then */ - - -/* EULANG(1) = ALPHA */ -/* EULANG(2) = BETA */ -/* EULANG(3) = GAMMA */ -/* EULANG(4) = dALPHA/dt */ -/* EULANG(5) = dBETA/dt */ -/* EULANG(6) = dGAMMA/dt */ - -/* The range of ALPHA and GAMMA is (-pi, pi]. */ - -/* The range of BETA depends on the exact set of */ -/* axes used for the factorization. For */ -/* factorizations in which the first and third axes */ -/* are the same, the range of BETA is [0, pi]. */ - -/* For factorizations in which the first and third */ -/* axes are different, the range of BETA is */ -/* [-pi/2, pi/2]. */ - -/* For rotations such that ALPHA and GAMMA are not */ -/* uniquely determined, ALPHA and dALPHA/dt will */ -/* always be set to zero; GAMMA and dGAMMA/dt are */ -/* then uniquely determined. */ - -/* UNIQUE is a logical that indicates whether or not the */ -/* values in EULANG are uniquely determined. If */ -/* the values are unique then UNIQUE will be set to */ -/* TRUE. If the values are not unique and some */ -/* components ( EULANG(1) and EULANG(4) ) have been set */ -/* to zero, then UNIQUE will have the value FALSE. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* All erroneous inputs are diagnosed by routines in the call */ -/* tree to this routines. These include */ - -/* 1) If any of AXISA, AXISB, or AXISC do not have values in */ - -/* { 1, 2, 3 }, */ - -/* then the error SPICE(INPUTOUTOFRANGE) is signaled. */ - -/* 2) An arbitrary rotation matrix cannot be expressed using */ -/* a sequence of Euler angles unless the second rotation axis */ -/* differs from the other two. If AXISB is equal to AXISC or */ -/* AXISA, then the error SPICE(BADAXISNUMBERS) is signaled. */ - -/* 3) If the input matrix R is not a rotation matrix, the error */ -/* SPICE(NOTAROTATION) is signaled. */ - -/* 4) If EULANG(1) and EULANG(3) are not uniquely determined, */ -/* EULANG(1) is set to zero, and EULANG(3) is determined. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A word about notation: the symbol */ - -/* [ x ] */ -/* i */ - -/* indicates a coordinate system rotation of x radians about the */ -/* ith coordinate axis. To be specific, the symbol */ - -/* [ x ] */ -/* 1 */ - -/* indicates a coordinate system rotation of x radians about the */ -/* first, or x-, axis; the corresponding matrix is */ - -/* +- -+ */ -/* | 1 0 0 | */ -/* | | */ -/* | 0 cos(x) sin(x) |. */ -/* | | */ -/* | 0 -sin(x) cos(x) | */ -/* +- -+ */ - -/* Remember, this is a COORDINATE SYSTEM rotation by x radians; this */ -/* matrix, when applied to a vector, rotates the vector by -x */ -/* radians, not x radians. Applying the matrix to a vector yields */ -/* the vector's representation relative to the rotated coordinate */ -/* system. */ - -/* The analogous rotation about the second, or y-, axis is */ -/* represented by */ - -/* [ x ] */ -/* 2 */ - -/* which symbolizes the matrix */ - -/* +- -+ */ -/* | cos(x) 0 -sin(x) | */ -/* | | */ -/* | 0 1 0 |, */ -/* | | */ -/* | sin(x) 0 cos(x) | */ -/* +- -+ */ - -/* and the analogous rotation about the third, or z-, axis is */ -/* represented by */ - -/* [ x ] */ -/* 3 */ - -/* which symbolizes the matrix */ - -/* +- -+ */ -/* | cos(x) sin(x) 0 | */ -/* | | */ -/* | -sin(x) cos(x) 0 |. */ -/* | | */ -/* | 0 0 1 | */ -/* +- -+ */ - - -/* The input matrix is assumed to be the product of three */ -/* rotation matrices, each one of the form */ - -/* +- -+ */ -/* | 1 0 0 | */ -/* | | */ -/* | 0 cos(r) sin(r) | (rotation of r radians about the */ -/* | | x-axis), */ -/* | 0 -sin(r) cos(r) | */ -/* +- -+ */ - - -/* +- -+ */ -/* | cos(s) 0 -sin(s) | */ -/* | | */ -/* | 0 1 0 | (rotation of s radians about the */ -/* | | y-axis), */ -/* | sin(s) 0 cos(s) | */ -/* +- -+ */ - -/* or */ - -/* +- -+ */ -/* | cos(t) sin(t) 0 | */ -/* | | */ -/* | -sin(t) cos(t) 0 | (rotation of t radians about the */ -/* | | z-axis), */ -/* | 0 0 1 | */ -/* +- -+ */ - -/* where the second rotation axis is not equal to the first or */ -/* third. Any rotation matrix can be factored as a sequence of */ -/* three such rotations, provided that this last criterion is met. */ - -/* This routine is related to the routine EUL2XF which produces */ -/* a state transformation from an input set of axes, Euler angles */ -/* and derivatives. */ - -/* The two subroutine calls shown here will not change */ -/* XFORM except for round off errors. */ - -/* CALL XF2EUL ( XFORM, AXISA, AXISB, AXISC, EULANG, UNIQUE ) */ -/* CALL EUL2XF ( EULANG, AXISA, AXISB, AXISC, XFORM ) */ - -/* On the other hand the two calls */ - -/* CALL EUL2XF ( EULANG, AXISA, AXISB, AXISC, XFORM ) */ -/* CALL XF2EUL ( XFORM, AXISA, AXISB, AXISC, EULANG, UNIQUE ) */ - -/* will leave EULANG unchanged only if the components of EULANG */ -/* are in the range produced by EUL2XF and the Euler representation */ -/* of the rotation component of XFORM is unique within that range. */ - - -/* $ Examples */ - -/* Suppose that you wish to determine the rate of change of */ -/* the right ascension and declination of the pole of an object, */ -/* from the state transformation matrix that transforms J2000 */ -/* states to object fixed states. */ - -/* Using this routine with the routine TISBOD you can determine */ -/* these instanteous rates. */ - -/* Recall that the rotation component of TSIPM is given by */ - -/* [W] [HALFPI-DEC] [RA+HALFPI] */ -/* 3 1 3 */ - - -/* Thus the calls: */ - -/* CALL TISBOD ( 'J2000', BODY, ET, TSIPM ) */ -/* CALL XF2EUL ( TSIPM, 3, 1, 3, EULANG, UNIQUE ) */ - -/* yield the following: */ - -/* EULANG(1) is W */ -/* EULANG(2) is HALFPI - DEC */ -/* EULANG(3) is RA + HALFPI */ -/* EULANG(4) is dW/dt */ -/* EULANG(5) is -dDEC/dt */ -/* EULANG(6) is dRA/dt */ - -/* Hence: */ - -/* dDEC/dt = -EULANG(5) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 25-APR-2007 (EDW) */ - -/* Corrected code in EUL2EF entry point Examples section, example */ -/* showed a XF2EUL call: */ - -/* CALL XF2EUL ( XFORM, 1, 2, 3, RPYANG ) */ - -/* The proper form of the call: */ - -/* CALL XF2EUL ( XFORM, 1, 2, 3, RPYANG, UNIQUE ) */ - -/* - SPICELIB Version 2.0.0, 31-OCT-2005 (NJB) */ - -/* Entry point EUL2XF was updated to allow axis sequences */ -/* in which the second angle is not distinct from the first */ -/* or third. */ - -/* - SPICELIB Version 1.0.0, 31-JUL-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Euler angles and derivatives from state transformation */ - -/* -& */ - -/* Spicelib Functions. */ - - -/* Parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - -/* Keep in mind that matrices are stored in column order first so */ -/* the matrix below looks like the transpose of what's needed. But */ -/* in fact it is the correct thing. */ - - switch(n__) { - case 1: goto L_eul2xf; - } - - -/* The computation of the non-derivative terms EULANG is handled */ -/* by the SPICE routine M2EUL. This routine contributes by */ -/* determining the derivative components of EULANG. */ - -/* To understand the code below a rather lengthy derivation is */ -/* required. If you're not interested in the details of this */ -/* derivation skip down to the IF ( RETURN() ) THEN line of */ -/* code below. */ - -/* First we note that if b is one of the basis vectors i,j, or k */ -/* or the opposite of one of these (-i, -j, or -k) then */ - -/* [ ANGLE ] * b = COS( {1 - ||}*ANGLE )b */ -/* n */ -/* - SIN( ANGLE ) e_n x b */ - -/* where <,> denotes the dot product, and x is used to denote the */ -/* cross product operation and e_1, e_2, and e_3 are the standard */ -/* basis vectors i, j, and k respectively. */ - -/* Using M2EUL we can readily determine the values of ALPHA, BETA */ -/* and GAMMA such that */ - - -/* R = [ ALPHA ] [ BETA ] [ GAMMA ] */ -/* A B C */ - - -/* From this equation we have: */ - -/* dR/dt = dALPHA/dt OMEGA [ ALPHA ] [ BETA ] [ GAMMA ] */ -/* A A B C */ - -/* + dBETA/dt [ ALPHA ] OMEGA [ BETA ] [ GAMMA ] */ -/* A B B C */ - -/* + dGAMMA/dt [ ALPHA ] [ BETA ] OMEGA [ GAMMA ] */ -/* A B C C */ - -/* where OMEGA is the cross product matrix. */ -/* n */ - - -/* [ 0 D_3n -D_2n ] */ -/* | -D_3n 0 D_1n | */ -/* [ D_2n -D_1n 0 ] */ - - -/* (D_ij denotes the Kronecker delta.) Note that OMEGA * v */ -/* n */ -/* yields -e x v for all vectors v. */ -/* n */ - -/* Multiplying both sides of the equation for dR/dt by the transpose */ -/* of R yields: */ - -/* T */ -/* dR/dt*R = dALPHA/dt OMEGA */ -/* A */ - -/* + dBETA/dt [ ALPHA ] OMEGA [ -ALPHA ] */ -/* A B A */ - -/* + dGAMMA/dt [ ALPHA ] [ BETA ] OMEGA [ -BETA ] [-ALPHA] */ -/* A B C B A */ -/* T */ -/* The product dR/dt*R is a skew symmetric matrix and hence can */ -/* be represented as a cross product, */ -/* T */ -/* dR/dt*R V = W x V */ - -/* for all vectors V, provided that */ - -/* T */ -/* W(1) = dR/dt*R (3,2) */ - -/* T */ -/* W(2) = dR/dt*R (1,3) */ - -/* T */ -/* W(3) = dR/dt*R (2,1) */ - -/* For any vector V, there is a corresponding skew symmetric */ -/* matrix CROSS{V} such that CROSS{V} * W = V x W for all vectors */ -/* W. Moreover, if ROT is any rotation, then */ - -/* T */ -/* CROSS{ROT(V)} = ROT CROSS{V} ROT */ - -/* This can easily be verified by noting that */ - -/* ROT(VxU) = ROT(V) X ROT(U) */ - -/* From these observations it follows that */ - - -/* W = -dALPHA/dt e_A */ - - -/* - dBETA/dt [ALPHA] e_B */ -/* A */ - -/* - dGAMMA/dt [ ALPHA ] [ BETA ] e_C */ -/* A B */ - - -/* W = -dALPHA/dt e_A */ - - -/* - dBETA/dt { COS ( ALPHA (1 - ||)) e_B */ - -/* - SIN ( ALPHA ) e_A x e_B } */ - - -/* - dGAMMA/dt [ ALPHA ] { COS(BETA(1 - ||)) e_C */ -/* A */ -/* - SIN (BETA) e_B x e_C } */ - -/* But = 0 = so that the above expression */ -/* simplifies to */ - -/* W = -dALPHA/dt e_A */ - - -/* - dBETA/dt {COS(ALPHA)e_B - SIN(ALPHA) e_A x e_B} */ - - -/* - dGAMMA/dt [ ALPHA ] {COS(BETA)e_C - SIN(BETA)e_B x e_C} */ -/* A */ - -/* If we let L = 6 - A - B, then by construction e_L is the third */ -/* vector needed to complete the basis containing e_A and e_B. */ -/* Let D be +1 or -1, so that D*e_L = e_A x e_B */ -/* (note D = ) */ - -/* Then applying our rotation formula again and simplifying we have */ - -/* W = -dALPHA/dt e_A */ - - -/* - dBETA/dt {COS(ALPHA)e_B - D*SIN(ALPHA) e_L } */ - - -/* - dGAMMA/dt COS(BETA){ COS(ALPHA(1-))e_C */ -/* -SIN(ALPHA) e_A x e_C } */ - -/* + dGAMMA/dt SIN(BETA){ COS(ALPHA(1-||))e_B x e_C */ -/* -SIN(ALPHA) e_A x (e_B x e_C ) */ - - -/* Now we have two cases: 1) e_A = e_C or 2) e_C = e_L */ - -/* Case 1. e_A = e_C */ -/* ==================== */ - -/* W = -dALPHA/dt e_A */ - - -/* - dBETA/dt {COS(ALPHA)e_B - D*SIN(ALPHA) e_L } */ - - -/* - dGAMMA/dt COS(BETA)e_A */ - -/* - dGAMMA/dt D*SIN(BETA)COS(ALPHA)e_L */ - -/* - dGAMMA/dt SIN(BETA)SIN(ALPHA)e_B */ - - -/* W = e_A{-dALPHA/dt - COS(BETA)dGAMMA/dt} */ -/* + e_B{ -COS(ALPHA)dBETA/dt - SIN(ALPHA)SIN(BETA)dGAMMA/dt} */ -/* + e_L{D*SIN(ALPHA)dBETA/dt - D*COS(ALPHA)SIN(BETA)dGAMMA/dt} */ - - -/* let U = COS(BETA) */ -/* V = D*SIN(BETA) */ - -/* then */ - -/* W = e_A{-dALPHA/dt -U*dGAMMA/dt} */ -/* + e_B{ -COS(ALPHA)dBETA/dt -D*SIN(ALPHA)*V*dGAMMA/dt} */ -/* + e_L{ D*SIN(ALPHA)dBETA/dt -COS(ALPHA)*V*dGAMMA/dt} */ - - -/* Case 2. e_L = e_C */ -/* ==================== */ - -/* W = -dALPHA/dt e_A */ - - -/* - dBETA/dt {COS(ALPHA)e_B - D*SIN(ALPHA) e_L } */ - - -/* - dGAMMA/dt COS(BETA){ COS(ALPHA)e_L */ -/* -D*SIN(ALPHA)e_B } */ - -/* + dGAMMA/dt SIN(BETA) D*e_A */ - - -/* W = e_A{-dALPHA/dt + D*SIN(BETA)dGAMMA/dt} */ -/* + e_B{-COS(ALPHA)dBETA/dt - D*SIN(ALPHA)COS(BETA)dGAMMA/dt} */ -/* + e_L{D*SIN(ALPHA)dBETA/dt - COS(ALPHA)COS(BETA)dGAMMA/dt} */ - - -/* Let U = -D*SIN(BETA) */ -/* V = COS(BETA) */ - -/* then */ - -/* W = e_A{-dALPHA/dt - U*dGAMMA/dt} */ -/* + e_B{ -COS(ALPHA)*dBETA/dt - D*SIN(ALPHA)*V*dGAMMA/dt} */ -/* + e_L{ D*SIN(ALPHA)dBETA/dt - COS(ALPHA)*V*dGAMMA/dt} */ - -/* As we can see from the above, by choosing appropriate assignments */ -/* for U and V, the two cases can be unified in a single expression. */ - -/* Substituting CA and SA for COS(ALPHA) and SIN(ALPHA) and */ -/* re-writing the last expression in matrix form we have: */ - - -/* [ -1 0 0 ][ 1 0 U ] [dALPHA/dt] */ -/* W = {e_A e_B e_L}| 0 -CA -D*SA || 0 1 0 | |dBETA /dt| */ -/* [ 0 D*SA -CA ][ 0 0 V ] [dGAMMA/dt] */ - - -/* If we let E_n stand for the transpose of e_n, then solving for */ -/* the derivative vector we have: */ - -/* [dALPHA/dt] [ 1 0 -U/V ] [ -1 0 0] [ E_A ] */ -/* |dBETA /dt| = | 0 1 0 | | 0 -CA D*SA| | E_B | W */ -/* [dGAMMA/dt] [ 0 0 1/V ] [ 0 -D*SA -CA] [ E_L ] */ - - -/* But since the matrix product E_n W is = W(n) this can */ -/* be rewritten as */ - -/* [dALPHA/dt] [ -1 U*D*SA/V U*CA/V ] [ W(A) ] */ -/* |dBETA /dt| = | 0 -CA D*SA | [ W(B) | */ -/* [dGAMMA/dt] [ 0 -D*SA/V -CA/V ] [ W(L) ] */ - - -/* Thus we see that there is a relatively elementary computation */ -/* required to determine the derivatives of the three Euler angles */ -/* returned by M2EUL. */ - - -/* Standard SPICE exception handling. */ - - if (return_()) { - return 0; - } - chkin_("XF2EUL", (ftnlen)6); - -/* Get the rotation and derivative of the rotation separately. */ - - for (i__ = 1; i__ <= 3; ++i__) { - k = i__ + 3; - for (j = 1; j <= 3; ++j) { - r__[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "r", i__1, "xf2eul_", (ftnlen)714)] = xform[(i__2 = i__ + - j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("xform", - i__2, "xf2eul_", (ftnlen)714)]; - drdt[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "drdt", i__1, "xf2eul_", (ftnlen)715)] = xform[(i__2 = k - + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("xform", - i__2, "xf2eul_", (ftnlen)715)]; - } - } - -/* We have to do it sooner or later so we take care of getting */ -/* the various Euler angles now. This will take care of all the */ -/* bad axis cases too so we don't have to check here. */ - - m2eul_(r__, axisa, axisb, axisc, eulang, &eulang[1], &eulang[2]); - if (failed_()) { - chkout_("XF2EUL", (ftnlen)6); - return 0; - } - -/* Construct local copies of the axes, determine L and D from the */ -/* derivation above. */ - - a = *axisa; - b = *axisb; - l = 6 - a - b; - d__ = delta[(i__1 = a + b * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("del" - "ta", i__1, "xf2eul_", (ftnlen)740)]; - -/* t */ -/* Compute DR/DT * R and extract OMEGA */ - - mxmt_(drdt, r__, drdtrt); - -/* The vector corresponding to DRDTRT is computed as shown below. */ - -/* w(1) = drdtrt (3,2) */ -/* w(2) = drdtrt (1,3) */ -/* w(3) = drdtrt (2,1) */ - -/* However, we need the 3-vector */ - -/* w(A) */ -/* w(B) */ -/* w(L) */ - -/* We'll call this vector omega. It's computed as shown here. */ - -/* omega(1) = w(A) = d*drdtrt(L,B) */ -/* omega(2) = w(B) = d*drdtrt(A,L) */ -/* omega(3) = w(L) = d*drdtrt(B,A) */ - - omega[0] = d__ * drdtrt[(i__1 = l + b * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("drdtrt", i__1, "xf2eul_", (ftnlen)768)]; - omega[1] = d__ * drdtrt[(i__1 = a + l * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("drdtrt", i__1, "xf2eul_", (ftnlen)769)]; - omega[2] = d__ * drdtrt[(i__1 = b + a * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("drdtrt", i__1, "xf2eul_", (ftnlen)770)]; - -/* Compute the various sines and cosines that we need. */ - - ca = cos(eulang[0]); - sa = sin(eulang[0]); - if (*axisa == *axisc) { - u = cos(eulang[1]); - v = d__ * sin(eulang[1]); - } else { - u = -d__ * sin(eulang[1]); - v = cos(eulang[1]); - } - -/* To avoid floating point overflows we make sure that we */ -/* can perform a division by V. We do this by looking at U. */ -/* If it has absolute value 1, then we set V equal to zero. */ -/* After all U*U + V*V = 1 if SIN and COS and various arithmetic */ -/* operations work perfectly. */ - - if (abs(u) == 1.) { - v = 0.; - } - -/* We have to look at the singular case first. Recall from above that */ - -/* [ W(A) ] [ -1 0 -U ][dALPHA/dt] */ -/* | W(B) | = | 0 -CA -D*SA*V ||dBETA /dt| */ -/* [ W(C) ] [ 0 D*SA -CA*V ][dGAMMA/dt] */ - -/* The singularity arises if V = 0. In this case the equation */ -/* becomes: ( Note that U is plus or minus 1 so that division */ -/* by U is the same as multiplication by U. ) */ - -/* [ OMEGA(1) ] [ -1 0 -U ][dALPHA/dt] */ -/* | OMEGA(2) | = | 0 -CA 0 ||dBETA /dt| */ -/* [ OMEGA(3) ] [ 0 D*SA 0 ][dGAMMA/dt] */ - - if (v == 0.) { - *unique = FALSE_; - eulang[3] = 0.; - eulang[5] = -u * omega[0]; - -/* We solve for EULANG(DBETA) by selecting the more stable of */ -/* the two available equations. */ - - if (abs(ca) > abs(sa)) { - eulang[4] = -omega[1] / ca; - } else { - eulang[4] = d__ * omega[2] / sa; - } - chkout_("XF2EUL", (ftnlen)6); - return 0; - } - -/* The matrix needed to compute the derivatives uniquely */ -/* exists. Construct it and carry out the multiplication. */ - -/* [dALPHA/dt] [ -1 U*D*SA/V U*CA/V ] [ OMEGA(1) ] */ -/* |dBETA /dt| = | 0 -CA D*SA | [ OMEGA(2) | */ -/* [dGAMMA/dt] [ 0 -D*SA/V -CA/V ] [ OMEGA(3) ] */ - - *unique = TRUE_; - solutn[0] = -1.; - solutn[1] = 0.; - solutn[2] = 0.; - solutn[3] = u * d__ * sa / v; - solutn[4] = -ca; - solutn[5] = -d__ * sa / v; - solutn[6] = u * ca / v; - solutn[7] = d__ * sa; - solutn[8] = -ca / v; - mxv_(solutn, omega, &eulang[3]); - chkout_("XF2EUL", (ftnlen)6); - return 0; -/* $Procedure EUL2XF ( Euler angles and derivative to transformation) */ - -L_eul2xf: -/* $ Abstract */ - -/* This routine computes a state transformation from an Euler angle */ -/* factorization of a rotation and the derivatives of those Euler */ -/* angles. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* ANGLES */ -/* STATE */ -/* DERIVATIVES */ - -/* $ Declarations */ - -/* DOUBLE PRECISION EULANG ( 6 ) */ -/* INTEGER AXISA */ -/* INTEGER AXISB */ -/* INTEGER AXISC */ -/* DOUBLE PRECISION XFORM ( 6, 6 ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* EULANG I An array of Euler angles and their derivatives. */ -/* AXISA I Axis A of the Euler angle factorization. */ -/* AXISB I Axis B of the Euler angle factorization. */ -/* AXISC I Axis C of the Euler angle factorization. */ -/* XFORM O A state transformation matrix. */ - -/* $ Detailed_Input */ - - -/* EULANG is the set of Euler angles corresponding to the */ -/* specified factorization. */ - -/* If we represent R as shown here: */ - -/* R = [ ALPHA ] [ BETA ] [ GAMMA ] */ -/* AXISA AXISB AXISC */ - -/* then */ - - -/* EULANG(1) = ALPHA */ -/* EULANG(2) = BETA */ -/* EULANG(3) = GAMMA */ -/* EULANG(4) = dALPHA/dt */ -/* EULANG(5) = dBETA/dt */ -/* EULANG(6) = dGAMMA/dt */ - - -/* AXISA are the axes desired for the factorization of R. */ -/* AXISB All must be in the range from 1 to 3. Moreover */ -/* AXISC it must be the case that AXISA and AXISB are distinct */ -/* and that AXISB and AXISC are distinct. */ - -/* Every rotation matrix can be represented as a product */ -/* of three rotation matrices about the principal axes */ -/* of a reference frame. */ - -/* R = [ ALPHA ] [ BETA ] [ GAMMA ] */ -/* AXISA AXISB AXISC */ - -/* The value 1 corresponds to the X axis. */ -/* The value 2 corresponds to the Y axis. */ -/* The value 3 corresponds to the Z axis. */ - -/* $ Detailed_Output */ - -/* XFORM is the state transformation corresponding R and dR/dt */ -/* as described above. Pictorially, */ - -/* [ | ] */ -/* | R | 0 | */ -/* | | | */ -/* |-------+--------| */ -/* | | | */ -/* | dR/dt | R | */ -/* [ | ] */ - -/* where R is a rotation that varies with respect to time */ -/* and dR/dt is its time derivative. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* All erroneous inputs are diagnosed by routines in the call */ -/* tree to this routine. These include */ - -/* 1) If any of AXISA, AXISB, or AXISC do not have values in */ - -/* { 1, 2, 3 }, */ - -/* then the error SPICE(INPUTOUTOFRANGE) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is intended to provide an inverse for the */ -/* entry point XF2EUL. See that entry point for a discussion */ -/* of notation. */ - -/* $ Examples */ - -/* Suppose you have a set of Euler angles and their derivatives */ -/* for a 3 1 3 rotation, and that you would like to determine */ -/* the equivalent angles and derivatives for a 1 2 3 rotation. */ - -/* R = [ALPHA] [BETA] [GAMMA] */ -/* 3 1 3 */ - -/* R = [ROLL] [PITCH] [YAW] */ -/* 1 2 3 */ - -/* The following pair of subroutine calls will perform the */ -/* desired computation. */ - -/* ABGANG(1) = ALPHA */ -/* ABGANG(2) = BETA */ -/* ABGANG(3) = GAMMA */ -/* ABGANG(4) = DALPHA */ -/* ABGANG(5) = DBETA */ -/* ABGANG(6) = DGAMMA */ - -/* CALL EUL2XF ( ABGANG, 3, 1, 3, XFORM ) */ -/* CALL XF2EUL ( XFORM, 1, 2, 3, RPYANG, UNIQUE ) */ - -/* ROLL = RPYANG(1) */ -/* PITCH = RPYANG(2) */ -/* YAW = RPYANG(3) */ -/* DROLL = RPYANG(4) */ -/* DPITCH = RPYANG(5) */ -/* DYAW = RPYANG(6) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 25-APR-2007 (EDW) */ - -/* Corrected code in Examples section, example showed */ -/* a XF2EUL call: */ - -/* CALL XF2EUL ( XFORM, 1, 2, 3, RPYANG ) */ - -/* The proper form of the call: */ - -/* CALL XF2EUL ( XFORM, 1, 2, 3, RPYANG, UNIQUE ) */ - -/* - SPICELIB Version 2.0.0, 31-OCT-2005 (NJB) */ - -/* Restriction that second axis must differ from both the first */ -/* and third axes was removed. */ - -/* - SPICELIB Version 1.0.0, 31-JUL-1995 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* State transformation from Euler angles and derivatives */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("EUL2XF", (ftnlen)6); - -/* We're going to work with a local copy LOCANG of the euler angle */ -/* state vector EULANG. We'll also use a local set of axis */ -/* numbers. */ - - moved_(eulang, &c__6, locang); - locaxa = *axisa; - locaxb = *axisb; - locaxc = *axisc; - -/* Parts of the following algorithm depend on the central axis */ -/* being different from the first and third axes. We'll adjust */ -/* the axes and angles to make this so, if necessary. */ - - if (*axisb == *axisa || *axisb == *axisc) { - if (*axisb == *axisa) { - -/* The first angle will "absorb" the second, and the */ -/* second will be set to zero. All we do here is select */ -/* the first angle. */ - - i__ = 1; - } else { - i__ = 3; - } - -/* Absorb the second angle into the selected angle and set the */ -/* second angle to zero. The same goes for the angular rates. */ - - locang[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("locang", - i__1, "xf2eul_", (ftnlen)1119)] = locang[(i__2 = i__ - 1) < 6 - && 0 <= i__2 ? i__2 : s_rnge("locang", i__2, "xf2eul_", ( - ftnlen)1119)] + locang[1]; - locang[1] = 0.; - locang[(i__1 = i__ + 2) < 6 && 0 <= i__1 ? i__1 : s_rnge("locang", - i__1, "xf2eul_", (ftnlen)1122)] = locang[(i__2 = i__ + 2) < 6 - && 0 <= i__2 ? i__2 : s_rnge("locang", i__2, "xf2eul_", ( - ftnlen)1122)] + locang[4]; - locang[4] = 0.; - -/* Pick a second axis that doesn't match the others. Since */ -/* the rotation angle about the second axis is zero, all that */ -/* matters here is picking a distinct axis. */ - - if (*axisc == next[(i__1 = *axisa - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("next", i__1, "xf2eul_", (ftnlen)1130)]) { - -/* The first axis is the predecessor of the third, so we pick */ -/* the successor of the third. */ - - locaxb = next[(i__1 = *axisc - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("next", i__1, "xf2eul_", (ftnlen)1135)]; - } else { - -/* Either the third axis is the predecessor of the first or */ -/* matches the first, so the successor of the first is our */ -/* choice. */ - - locaxb = next[(i__1 = *axisa - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("next", i__1, "xf2eul_", (ftnlen)1143)]; - } - } - -/* The following local variables are set: */ - -/* LOCANG(*), LOCAXA, LOCAXB, LOCAXC */ - -/* These variables describe the input rotation, but the second */ -/* axis is now guaranteed to differ from the first and third. */ - -/* The derivation for everything that is about to happen here */ -/* is included in the previous entry point. */ - - eul2m_(locang, &locang[1], &locang[2], &locaxa, &locaxb, &locaxc, r__); - if (failed_()) { - chkout_("EUL2XF", (ftnlen)6); - return 0; - } - -/* Construct local copies of the axes, determine L and D from the */ -/* derivation above. */ - - a = locaxa; - b = locaxb; - l = 6 - a - b; - d__ = delta[(i__1 = a + b * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("del" - "ta", i__1, "xf2eul_", (ftnlen)1175)]; - -/* Compute the various sines and cosines that we need. */ - - ca = cos(locang[0]); - sa = sin(locang[0]); - if (locaxa == locaxc) { - u = cos(locang[1]); - v = d__ * sin(locang[1]); - } else { - u = -d__ * sin(locang[1]); - v = cos(locang[1]); - } - -/* t */ -/* Next we compute dR/dt R. Recall from the derivation above */ -/* that */ - - -/* [ W(A) ] [ -1 0 -U ][dALPHA/dt] */ -/* | W(B) | = | 0 -CA -D*SA*V ||dBETA /dt| */ -/* [ W(L) ] [ 0 D*SA -CA*V ][dGAMMA/dt] */ - -/* In the previous entry point we used OMEGA for the vector */ -/* of rearranged components of W. */ - -/* OMEGA(1) = W(A) = D*DRDTRT(L,B) */ -/* OMEGA(2) = W(B) = D*DRDTRT(A,L) */ -/* OMEGA(3) = W(L) = D*DRDTRT(B,A) */ - -/* DRDTRT(L,B) = D*OMEGA(1) */ -/* DRDTRT(A,L) = D*OMEGA(2) */ -/* DRDTRT(B,A) = D*OMEGA(3) */ - -/* [ DRDTRT(L,B) ] [ -D 0 -D*U ][dALPHA/dt] */ -/* | DRDTRT(A,L) | = | 0 -D*CA -SA*V ||dBETA /dt| */ -/* [ DRDTRT(B,A) ] [ 0 SA -D*CA*V ][dGAMMA/dt] */ - -/* We set up the matrix of this equation in SOLUTN below */ -/* and compute D*OMEGA which we denote by the variable DOMEGA. */ - - solutn[0] = -d__; - solutn[1] = 0.; - solutn[2] = 0.; - solutn[3] = 0.; - solutn[4] = -d__ * ca; - solutn[5] = sa; - solutn[6] = -d__ * u; - solutn[7] = -sa * v; - solutn[8] = -d__ * ca * v; - mxv_(solutn, &locang[3], domega); - drdtrt[(i__1 = l + b * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("drdtrt", - i__1, "xf2eul_", (ftnlen)1233)] = domega[0]; - drdtrt[(i__1 = b + l * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("drdtrt", - i__1, "xf2eul_", (ftnlen)1234)] = -domega[0]; - drdtrt[(i__1 = a + l * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("drdtrt", - i__1, "xf2eul_", (ftnlen)1236)] = domega[1]; - drdtrt[(i__1 = l + a * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("drdtrt", - i__1, "xf2eul_", (ftnlen)1237)] = -domega[1]; - drdtrt[(i__1 = b + a * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("drdtrt", - i__1, "xf2eul_", (ftnlen)1239)] = domega[2]; - drdtrt[(i__1 = a + b * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge("drdtrt", - i__1, "xf2eul_", (ftnlen)1240)] = -domega[2]; - drdtrt[0] = 0.; - drdtrt[4] = 0.; - drdtrt[8] = 0.; - mxm_(drdtrt, r__, drdt); - for (j = 1; j <= 3; ++j) { - for (i__ = 1; i__ <= 3; ++i__) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : s_rnge( - "xform", i__1, "xf2eul_", (ftnlen)1250)] = r__[(i__2 = - i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("r", - i__2, "xf2eul_", (ftnlen)1250)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "xf2eul_", (ftnlen)1251)] = r__[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge( - "r", i__2, "xf2eul_", (ftnlen)1251)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "xf2eul_", (ftnlen)1252)] = drdt[( - i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge( - "drdt", i__2, "xf2eul_", (ftnlen)1252)]; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "xf2eul_", (ftnlen)1253)] = 0.; - } - } - chkout_("EUL2XF", (ftnlen)6); - return 0; -} /* xf2eul_ */ - -/* Subroutine */ int xf2eul_(doublereal *xform, integer *axisa, integer * - axisb, integer *axisc, doublereal *eulang, logical *unique) -{ - return xf2eul_0_(0, xform, axisa, axisb, axisc, eulang, unique); - } - -/* Subroutine */ int eul2xf_(doublereal *eulang, integer *axisa, integer * - axisb, integer *axisc, doublereal *xform) -{ - return xf2eul_0_(1, xform, axisa, axisb, axisc, eulang, (logical *)0); - } - diff --git a/ext/spice/src/cspice/xf2eul_c.c b/ext/spice/src/cspice/xf2eul_c.c deleted file mode 100644 index a788c5d873..0000000000 --- a/ext/spice/src/cspice/xf2eul_c.c +++ /dev/null @@ -1,407 +0,0 @@ -/* - --Procedure xf2eul_c ( State transformation to Euler angles ) - --Abstract - - Convert a state transformation matrix to Euler angles and their - derivatives with respect to a specified set of axes. - - The companion routine eul2xf_c converts Euler angles and their - derivatives with respect to a specified set of axes to a state - transformation matrix. - --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 - - ROTATION - PCK - --Keywords - - ANGLES - STATE - DERIVATIVES - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #undef xf2eul_c - - - void xf2eul_c ( ConstSpiceDouble xform [6][6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble eulang [6], - SpiceBoolean * unique ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - xform I A state transformation matrix. - axisa I Axis A of the Euler angle factorization. - axisb I Axis B of the Euler angle factorization. - axisc I Axis C of the Euler angle factorization. - eulang O An array of Euler angles and their derivatives. - unique O Indicates if eulang is a unique representation. - --Detailed_Input - - xform is a state transformation from some frame frame1 to - another frame frame2. Pictorially, xform has the - structure shown here. - - [ | ] - | r | 0 | - | | | - |-------+--------| - | | | - | dr/dt | r | - [ | ] - - where r is a rotation that varies with respect to time - and dr/dt is its time derivative. - - More specifically, if s1 is the state of some object - in frame1, then s2, the state of the same object - relative to frame2 is given by - - s2 = xform*s1 - - where '*' denotes the matrix vector product. - - axisa are the axes desired for the factorization of r. - axisb All must be in the range from 1 to 3. Moreover - axisc it must be the case that axisa and axisb are distinct - and that axisb and axisc are distinct. - - Every rotation matrix can be represented as a product - of three rotation matrices about the principal axes - of a reference frame. - - r = [ alpha ] [ beta ] [ gamma ] - axisa axisb axisc - - The value 1 corresponds to the X axis. - The value 2 corresponds to the Y axis. - The value 3 corresponds to the Z axis. - --Detailed_Output - - eulang is the set of Euler angles corresponding to the - specified factorization. - - If we represent r as shown here: - - r = [ alpha ] [ beta ] [ gamma ] - axisa axisb axisc - - then - - - eulang[0] = alpha - eulang[1] = beta - eulang[2] = gamma - eulang[3] = dalpha/dt - eulang[4] = dbeta/dt - eulang[5] = dgamma/dt - - The range of alpha and gamma is (-pi, pi]. - - The range of beta depends on the exact set of - axes used for the factorization. For - factorizations in which the first and third axes - are the same, the range of beta is [0, pi]. - - For factorizations in which the first and third - axes are different, the range of beta is - [-pi/2, pi/2]. - - For rotations such that alpha and gamma are not - uniquely determined, alpha and dalpha/dt will - always be set to zero; gamma and dgamma/dt are - then uniquely determined. - - unique is a logical that indicates whether or not the - values in eulang are uniquely determined. If - the values are unique then unique will be set to - SPICETRUE. If the values are not unique and some - components ( eulang[0] and eulang[3] ) have been set - to zero, then unique will have the value SPICEFALSE. - - --Parameters - - None. - --Exceptions - - All erroneous inputs are diagnosed by routines in the call - tree to this routines. These include - - 1) If any of axisa, axisb, or axisc do not have values in - - { 1, 2, 3 }, - - then the error SPICE(INPUTOUTOFRANGE) is signaled. - - 2) An arbitrary rotation matrix cannot be expressed using - a sequence of Euler angles unless the second rotation axis - differs from the other two. If axisb is equal to axisc or - axisa, then the error SPICE(BADAXISNUMBERS) is signaled. - - 3) If the input matrix r is not a rotation matrix, the error - SPICE(NOTAROTATION) is signaled. - - 4) If eulang[0] and eulang[2] are not uniquely determined, - EULANG[0] is set to zero, and EULANG[2] is determined. - --Files - - None. - --Particulars - - A word about notation: the symbol - - [ x ] - i - - indicates a coordinate system rotation of x radians about the - ith coordinate axis. To be specific, the symbol - - [ x ] - 1 - - indicates a coordinate system rotation of x radians about the - first, or x-, axis; the corresponding matrix is - - +- -+ - | 1 0 0 | - | | - | 0 cos(x) sin(x) |. - | | - | 0 -sin(x) cos(x) | - +- -+ - - Remember, this is a COORDINATE SYSTEM rotation by x radians; this - matrix, when applied to a vector, rotates the vector by -x - radians, not x radians. Applying the matrix to a vector yields - the vector's representation relative to the rotated coordinate - system. - - The analogous rotation about the second, or y-, axis is - represented by - - [ x ] - 2 - - which symbolizes the matrix - - +- -+ - | cos(x) 0 -sin(x) | - | | - | 0 1 0 |, - | | - | sin(x) 0 cos(x) | - +- -+ - - and the analogous rotation about the third, or z-, axis is - represented by - - [ x ] - 3 - - which symbolizes the matrix - - +- -+ - | cos(x) sin(x) 0 | - | | - | -sin(x) cos(x) 0 |. - | | - | 0 0 1 | - +- -+ - - - The input matrix is assumed to be the product of three - rotation matrices, each one of the form - - +- -+ - | 1 0 0 | - | | - | 0 cos(r) sin(r) | (rotation of r radians about the - | | x-axis), - | 0 -sin(r) cos(r) | - +- -+ - - - +- -+ - | cos(s) 0 -sin(s) | - | | - | 0 1 0 | (rotation of s radians about the - | | y-axis), - | sin(s) 0 cos(s) | - +- -+ - - or - - +- -+ - | cos(t) sin(t) 0 | - | | - | -sin(t) cos(t) 0 | (rotation of t radians about the - | | z-axis), - | 0 0 1 | - +- -+ - - where the second rotation axis is not equal to the first or - third. Any rotation matrix can be factored as a sequence of - three such rotations, provided that this last criterion is met. - - This routine is related to the routine eul2xf_c which produces - a state transformation from an input set of axes, Euler angles - and derivatives. - - The two function calls shown here will not change xform except for - round off errors. - - xf2eul_c ( xform, axisa, axisb, axisc, eulang, &unique ); - eul2xf_c ( eulang, axisa, axisb, axisc, xform ); - - On the other hand the two calls - - eul2xf_c ( eulang, axisa, axisb, axisc, xform ); - xf2eul_c ( xform, axisa, axisb, axisc, eulang, &unique ); - - will leave eulang unchanged only if the components of eulang - are in the range produced by xf2eul_c and the Euler representation - of the rotation component of xform is unique within that range. - - --Examples - - Suppose that you wish to determine the rate of change of - the right ascension and declination of the pole of Jupiter, - from the state transformation matrix that transforms J2000 - states to object fixed states. - - Using this routine with the routine sxform_c you can determine - these instanteous rates. - - Recall that the rotation component of tsipm is given by - - [w] [halfpi_c-dec] [ra+halfpi_c] - 3 1 3 - - - Thus the calls - - sxform_c ( "J2000", "IAU_JUPITER", et, tsipm ); - xf2eul_c ( tsipm, 3, 1, 3, eulang, &unique ); - - yield the following: - - eulang[0] is w - eulang[1] is pi/2 - dec - eulang[2] is ra + pi/2 - eulang[3] is d w/dt - eulang[4] is -d dec/dt - eulang[5] is d ra/dt - - Hence: - - d dec/dt = -eulang[4] - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - W.L. Taber (JPL) - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.1, 05-MAR-2008 (NJB) - - Fixed typo (missing double quote character) in code example. - Corrected order of header sections. - - -CSPICE Version 1.0.0, 15-JUN-1999 (WLT) (NJB) - --Index_Entries - - Euler angles and derivatives from state transformation - --& -*/ - - -{ /* Begin xf2eul_c */ - - /* - Local variables - */ - logical u; - SpiceDouble fXform[6][6]; - - - /* - Participate in error tracing. - */ - chkin_c ( "xf2eul_c" ); - - - /* - Convert the state transformation matrix to column-major order. - The let the f2c'd routine do the real work. - */ - - xpose6_c ( xform, fXform ); - - xf2eul_ ( ( doublereal * ) fXform, - ( integer * ) &axisa, - ( integer * ) &axisb, - ( integer * ) &axisc, - ( doublereal * ) eulang, - ( logical * ) &u ); - - - *unique = u; - - chkout_c ( "xf2eul_c" ); - -} /* End xf2eul_c */ diff --git a/ext/spice/src/cspice/xf2rav.c b/ext/spice/src/cspice/xf2rav.c deleted file mode 100644 index 22c9f161f5..0000000000 --- a/ext/spice/src/cspice/xf2rav.c +++ /dev/null @@ -1,244 +0,0 @@ -/* xf2rav.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure XF2RAV ( Transform to rotation and angular velocity) */ -/* Subroutine */ int xf2rav_(doublereal *xform, doublereal *rot, doublereal * - av) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal drdt[9] /* was [3][3] */; - extern /* Subroutine */ int mtxm_(doublereal *, doublereal *, doublereal * - ); - integer i__, j; - doublereal omega[9] /* was [3][3] */; - -/* $ Abstract */ - -/* This routine determines from a state transformation matrix */ -/* the associated rotation matrix and angular velocity of the */ -/* rotation. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* XFORM I is a state transformation matrix */ -/* ROT O is the rotation associated with XFORM */ -/* AV O is the angular velocity associated with XFORM */ - -/* $ Detailed_Input */ - -/* XFORM is a state transformation matrix from one frame */ -/* FRAME1 to some other frame FRAME2. */ - -/* $ Detailed_Output */ - -/* ROT is a rotation that gives the transformation from */ -/* some frame FRAME1 to another frame FRAME2. */ - -/* AV is the angular velocity of the transformation. */ -/* In other words, if P is the position of a fixed */ -/* point in FRAME2, then from the point of view of */ -/* FRAME1, P rotates (in a right handed sense) about */ -/* an axis parallel to AV. Moreover the rate of rotation */ -/* in radians per unit time is given by the length of */ -/* AV. */ - -/* More formally, the velocity V of P in FRAME1 is */ -/* given by */ -/* t */ -/* V = AV x ( ROT * P ) */ - -/* The components of AV are given relative to FRAME1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) No checks are performed on XFORM to ensure that it is indeed */ -/* a state transformation matrix. */ - -/* $ Particulars */ - -/* This routine is essentially a macro routine for converting */ -/* state transformation matrices into the equivalent representation */ -/* in terms of a rotation and angular velocity. */ - -/* This routine is an inverse of the routine RAV2XF. */ - -/* $ Examples */ - -/* Suppose that you wanted to determine the angular velocity */ -/* of the earth with respect to J2000 at a particular epoch ET. */ -/* The following code fragment illustrates a procedure for */ -/* computing the angular velocity. */ - -/* CALL TISBOD ( 'J2000', 399, ET, TSIPM ) */ - - -/* Now get the angular velocity by calling XF2RAV */ - -/* CALL XF2RAV ( TSPMI, TPMI, AV ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (WLT) */ - -/* The example in version 1.0.0 was incorrect. The example */ -/* in version 1.1.0 fixes the previous problem. */ - -/* - SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* State transformation to rotation and angular velocity */ - -/* -& */ - -/* A state transformation matrix XFORM has the following form */ - - -/* [ | ] */ -/* | R | 0 | */ -/* | | | */ -/* | -----+-----| */ -/* | dR | | */ -/* | -- | R | */ -/* [ dt | ] */ - - -/* where R is a rotation and dR/dt is the time derivative of that */ -/* rotation. From this we can immediately read the rotation and */ -/* its derivative. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "rot", i__1, "xf2rav_", (ftnlen)178)] = xform[(i__2 = i__ - + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("xform", - i__2, "xf2rav_", (ftnlen)178)]; - drdt[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "drdt", i__1, "xf2rav_", (ftnlen)179)] = xform[(i__2 = - i__ + 3 + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge( - "xform", i__2, "xf2rav_", (ftnlen)179)]; - } - } - -/* Recall that ROT is a transformation that converts positions */ -/* in some frame FRAME1 to positions in a second frame FRAME2. */ - -/* The angular velocity matrix OMEGA (the cross product matrix */ -/* corresponding to AV) has the following property. */ - -/* If P is the position of an object that is stationary with */ -/* respect to FRAME2 then the velocity V of that object in FRAME1 */ -/* is given by: */ -/* t */ -/* V = OMEGA * ROT * P */ - -/* But V is also given by */ - -/* t */ -/* d ROT */ -/* V = ----- * P */ -/* dt */ - -/* So that */ -/* t */ -/* t d ROT */ -/* OMEGA * ROT = ------- */ -/* dt */ - -/* Hence */ -/* t */ -/* d ROT */ -/* OMEGA = ------- * ROT */ -/* dt */ - - - - mtxm_(drdt, rot, omega); - -/* Recall that OMEGA has the form */ - -/* _ _ */ -/* | | */ -/* | 0 -AV(3) AV(2) | */ -/* | | */ -/* | AV(3) 0 -AV(1) | */ -/* | | */ -/* | -AV(2) AV(1) 0 | */ -/* |_ _| */ - - av[0] = omega[5]; - av[1] = omega[6]; - av[2] = omega[1]; - return 0; -} /* xf2rav_ */ - diff --git a/ext/spice/src/cspice/xf2rav_c.c b/ext/spice/src/cspice/xf2rav_c.c deleted file mode 100644 index 4680b0e0f6..0000000000 --- a/ext/spice/src/cspice/xf2rav_c.c +++ /dev/null @@ -1,255 +0,0 @@ -/* - --Procedure xf2rav_c ( Transform to rotation and angular velocity) - --Abstract - - This routine determines the rotation matrix and angular - velocity of the rotation from a state transformation matrix. - --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 - - FRAMES - -*/ - - #include "SpiceUsr.h" - #undef xf2rav_c - - - void xf2rav_c ( ConstSpiceDouble xform [6][6], - SpiceDouble rot [3][3], - SpiceDouble av [3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - xform I is a state transformation matrix. - rot O is the rotation associated with xform. - av O is the angular velocity associated with xform. - --Detailed_Input - - xform is a state transformation matrix from one frame - frame1 to some other frame frame2. - --Detailed_Output - - rot is a rotation that gives the transformation from - some frame frame1 to another frame frame2. - - av is the angular velocity of the transformation. - In other words, if p is the position of a fixed - point in frame2, then from the point of view of - frame1, p rotates (in a right handed sense) about - an axis parallel to AV. Moreover the rate of rotation - in radians per unit time is given by the length of - av. - - More formally, the velocity v of p in frame1 is - given by - t - v = av x ( rot * p ) - - The components of av are given relative to frame1. - --Parameters - - None. - --Exceptions - - Error free. - - 1) No checks are performed on xform to ensure that it is indeed - a state transformation matrix. - --Files - - None. - --Particulars - - This routine is essentially a macro routine for converting - state transformation matrices into the equivalent representation - in terms of a rotation and angular velocity. - - This routine is an inverse of the routine rav2xf_c. - --Examples - - Suppose that you wanted to determine the angular velocity - of the earth with respect to J2000 at a particular epoch et. - The following code fragment illustrates a procedure for - computing the angular velocity. - - sxform_c ( "J2000", "IAU_EARTH", et, tsipm ) ; - - Now get the angular velocity by calling xf2rav_c: - - xf2rav_c ( tsipm, tpmi, av ); - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Version - - - -CSPICE Version 1.0.1, 12-APR-2007 (EDW) - - Edit to abstract. - - -CSPICE Version 1.0.0, 18-JUN-1999 (WLT) (NJB) - --Index_Entries - - State transformation to rotation and angular velocity - --& -*/ - - { /* Begin xf2rav_c */ - - /* - Local variables - */ - - SpiceDouble drdt [3][3]; - SpiceDouble omega [3][3]; - - SpiceInt i; - SpiceInt j; - - - /* - Error free: no tracing required. - - - A state transformation matrix xform has the following form - - - [ | ] - | r | 0 | - | | | - | -----+-----| - | dr | | - | -- | r | - [ dt | ] - - - where r is a rotation and dr/dt is the time derivative of that - rotation. From this we can immediately read the rotation and - its derivative. - */ - - for ( i = 0; i < 3; i++ ) - { - for ( j = 0; j < 3; j++ ) - { - rot [i][j] = xform[i ][j]; - drdt[i][j] = xform[i+3][j]; - } - } - - - /* - Recall that rot is a transformation that converts positions - in some frame frame1 to positions in a second frame frame2. - - The angular velocity matrix omega (the cross product matrix - corresponding to av) has the following property. - - If p is the position of an object that is stationary with - respect to frame2 then the velocity v of that object in frame1 - is given by: - t - v = omega * rot * p - - But v is also given by - - t - d rot - v = ----- * p - dt - - So that - t - t d rot - omega * rot = ------- - dt - - Hence - t - d rot - omega = ------- * rot - dt - - */ - - mtxm_c ( drdt, rot, omega ); - - - /* - - Recall that omega has the form - - _ _ - | | - | 0 -av[2] av[1] | - | | - | av[2] 0 -av[0] | - | | - | -av[1] av[0] 0 | - |_ _| - - */ - - - av[0] = omega[2][1]; - av[1] = omega[0][2]; - av[2] = omega[1][0]; - - - } /* End xf2rav_c */ diff --git a/ext/spice/src/cspice/xposbl.c b/ext/spice/src/cspice/xposbl.c deleted file mode 100644 index daa9f68b73..0000000000 --- a/ext/spice/src/cspice/xposbl.c +++ /dev/null @@ -1,404 +0,0 @@ -/* xposbl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure XPOSBL ( Transpose a matrix by blocks ) */ -/* Subroutine */ int xposbl_(doublereal *bmat, integer *nrow, integer *ncol, - integer *bsize, doublereal *btmat) -{ - /* System generated locals */ - integer bmat_dim1, bmat_dim2, bmat_offset, btmat_dim1, btmat_dim2, - btmat_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal temp; - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer cb, rb; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Transpose the square blocks within a matrix. */ - -/* $ 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 */ - -/* MATH */ -/* MATRIX */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BMAT I a matrix composed of square block submatrices */ -/* NROW I the number of rows in the matrix BMAT */ -/* NCOL I the number of columns in the matrix BMAT */ -/* BSIZE I the size of the square blocks in BMAT */ -/* BTMAT O the result of transposing the blocks of BMAT */ - -/* $ Detailed_Input */ - -/* BMAT is a block structured matrix. In other words */ -/* it looks like: */ - - -/* - - */ -/* | : : : : | */ -/* | B : B : B : : B | */ -/* | 11 : 12 : 13 : ... : 1C | */ -/* |......:......:.......: :......| */ -/* | : : : : | */ -/* | B : B : B : : B | */ -/* | 21 : 22 : 23 : ... : 2C | */ -/* |......:......:.......: :......| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |...................... .......| */ -/* | : : : : | */ -/* | B : B : B : : B | */ -/* | R1 : R2 : R3 : ... : RC | */ -/* |......:......:.......: :......| */ -/* - - */ - -/* where each B is a square matrix of BSIZE rows and */ -/* ij */ -/* and columns. */ - -/* NROW is the number of rows in the input matrix. */ - -/* NCOL is the number of columns in the input matrix. */ - -/* BSIZE is the number of rows and columns in each block */ -/* of the input matrix. */ - -/* $ Detailed_Output */ - -/* BTMAT is the matrix obtained from BMAT when each of its */ -/* blocks is transposed. Given the description of */ -/* BMAT above, BTMAT looks like: */ - - -/* - - */ -/* | t : t : t : : t | */ -/* | B : B : B : : B | */ -/* | 11 : 12 : 13 : ... : 1C | */ -/* |......:......:.......: :......| */ -/* | : : : : | */ -/* | t : t : t : : t | */ -/* | B : B : B : : B | */ -/* | 21 : 22 : 23 : ... : 2C | */ -/* |......:......:.......: :......| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |...................... .......| */ -/* | : : : : | */ -/* | t : t : t : : t | */ -/* | B : B : B : : B | */ -/* | R1 : R2 : R3 : ... : RC | */ -/* |......:......:.......: :......| */ -/* - - */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of rows input is not positive, your program */ -/* will probably experience a run-time error. However, in the */ -/* event that your system does not catch this error, this routine */ -/* will diagnose it and signal the error 'SPICE(BADROWCOUNT)'. */ - -/* 1) If the number of columns input is not positive, your program */ -/* will probably experience a run-time error. However, in the */ -/* event that your system does not catch this error, this routine */ -/* will diagnose it and signal the error 'SPICE(BADCOLUMNCOUNT)'. */ - -/* 3) If the block size input is not positive, the error */ -/* 'SPICE(BADBLOCKSIZE)' is signalled. */ - -/* 4) If BMAT cannot be partitioned into an integer number of */ -/* blocks, the error 'SPICE(BLOCKSNOTEVEN)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine transposes the blocks of a block structured */ -/* matrix. This operation is valuable, as it is a means */ -/* for computing the inverse of a state transformation matrix */ -/* (see the example below). */ - -/* $ Examples */ - -/* The following code fragment illustrates how you would convert */ -/* a state relative to earth-fixed coordinates to J2000 coordinates. */ - -/* C */ -/* C We want to state earthfixed coordinates (399) to J2000 */ -/* C coordinates */ -/* C */ -/* BODY = 399 */ -/* REF = 'J2000' */ - -/* C */ -/* C Get the 6 by 6 state transformation matrix from J2000 */ -/* C coordinates to earthfixed coordinates. */ -/* C */ -/* CALL TISBOD ( REF, BODY, ET, TISPM ) */ - -/* C */ -/* C The inverse of TISPM can be obtained by transposing the */ -/* C 3 by 3 blocks of the 6 by 6 matrix TISPM. */ -/* C */ -/* CALL XPOSBL ( TISPM, 6, 6, 3, TSPMI ) */ - - -/* C */ -/* C Now transform the earthfixed state (ESTATE) to the */ -/* C inertial state (ISTATE). */ -/* C */ -/* CALL MXVG ( TSPMI, ESTATE, 6, 6, ISTATE ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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, 5-NOV-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* transpose a matrix by blocks */ - -/* -& */ - -/* Local variables */ - - -/* Ok. Here's what's going to happen. */ - -/* The matrix has the form: */ - -/* - - */ -/* | : : : : | */ -/* | B : B : B : : B | */ -/* | 11 : 12 : 13 : ... : 1C | */ -/* |......:......:.......: :......| */ -/* | : : : : | */ -/* | B : B : B : : B | */ -/* | 21 : 22 : 23 : ... : 2C | */ -/* |......:......:.......: :......| */ -/* | . | */ -/* | . | */ -/* | . | */ -/* |...................... .......| */ -/* | : : : : | */ -/* | B : B : B : : B | */ -/* | R1 : R2 : R3 : ... : RC | */ -/* |......:......:.......: :......| */ - -/* Where each block B is a square matrix. */ -/* ij */ - -/* All we really need to do is figure out how to transpose any */ -/* of the blocks. Once that is done we can just cycle over */ -/* all of the blocks in the matrix. */ - -/* So what does the ij block look like? Well, this is it. */ - - -/* a a ... a */ -/* RB+1 CB+1 RB+1 CB+2 RB+1 CB+BSIZE */ - -/* a a ... a */ -/* RB+2 CB+1 RB+2 CB+2 RB+2 CB+BSIZE */ - -/* a a ... a */ -/* RB+3 CB+1 RB+3 CB+2 RB+3 CB+BSIZE */ - -/* . */ -/* . */ -/* . */ - -/* a a ... a */ -/* RB+BSIZE CB+1 RB+BSIZE CB+2 RB+BSIZE CB+BSIZE */ - - -/* where RB = (i-1)*BSIZE, and CB = (j-1)*BSIZE. But inspection of */ -/* this block shows that to transpose it we simply need to swap */ -/* the entries */ - -/* a and a */ -/* RB+m CB+n RB+n CB+m */ - -/* where m and n range over all integers from 1 to BSIZE. */ - - -/* Let's first check to make sure that the requested operation */ -/* makes sense. Are all of the integers positive? */ - - /* Parameter adjustments */ - btmat_dim1 = *nrow; - btmat_dim2 = *ncol; - btmat_offset = btmat_dim1 + 1; - bmat_dim1 = *nrow; - bmat_dim2 = *ncol; - bmat_offset = bmat_dim1 + 1; - - /* Function Body */ - if (*bsize < 1) { - chkin_("XPOSBL", (ftnlen)6); - setmsg_("The block size is not positive. The block size is #.", ( - ftnlen)52); - errint_("#", bsize, (ftnlen)1); - sigerr_("SPICE(BADBLOCKSIZE)", (ftnlen)19); - chkout_("XPOSBL", (ftnlen)6); - return 0; - } - if (*nrow < 1) { - chkin_("XPOSBL", (ftnlen)6); - setmsg_("The number of rows in the matrix is not positive. The numbe" - "r of rows is #.", (ftnlen)74); - errint_("#", nrow, (ftnlen)1); - sigerr_("SPICE(BADROWCOUNT)", (ftnlen)18); - chkout_("XPOSBL", (ftnlen)6); - return 0; - } - if (*ncol < 1) { - chkin_("XPOSBL", (ftnlen)6); - setmsg_("The number of columns in the matrix is not positive. The nu" - "mber of columns is #.", (ftnlen)80); - errint_("#", ncol, (ftnlen)1); - sigerr_("SPICE(BADCOLUMNCOUNT)", (ftnlen)21); - chkout_("XPOSBL", (ftnlen)6); - return 0; - } - -/* Is there a whole number of blocks in the matrix. */ - - if (*ncol % *bsize != 0 || *nrow % *bsize != 0) { - chkin_("XPOSBL", (ftnlen)6); - setmsg_("The block size does not evenly divide both the number of ro" - "ws and the number of columns. The block size is #; the numbe" - "r of rows is #; the number of columns is #. ", (ftnlen)163); - errint_("#", bsize, (ftnlen)1); - errint_("#", nrow, (ftnlen)1); - errint_("#", ncol, (ftnlen)1); - sigerr_("SPICE(BLOCKSNOTEVEN)", (ftnlen)20); - chkout_("XPOSBL", (ftnlen)6); - return 0; - } - -/* If we get to this point we are ready to do the transposes. */ -/* Cycle over all of the blocks in the matrix. */ - - i__1 = *ncol - 1; - i__2 = *bsize; - for (cb = 0; i__2 < 0 ? cb >= i__1 : cb <= i__1; cb += i__2) { - i__3 = *nrow - 1; - i__4 = *bsize; - for (rb = 0; i__4 < 0 ? rb >= i__3 : rb <= i__3; rb += i__4) { - -/* OK. Transpose block ( RB, CB ). */ - - i__5 = *bsize; - for (i__ = 1; i__ <= i__5; ++i__) { - i__6 = i__; - for (j = 1; j <= i__6; ++j) { - if (i__ == j) { - btmat[(i__7 = rb + i__ + (cb + j) * btmat_dim1 - - btmat_offset) < btmat_dim1 * btmat_dim2 && 0 - <= i__7 ? i__7 : s_rnge("btmat", i__7, "xpos" - "bl_", (ftnlen)370)] = bmat[(i__8 = rb + i__ + - (cb + j) * bmat_dim1 - bmat_offset) < - bmat_dim1 * bmat_dim2 && 0 <= i__8 ? i__8 : - s_rnge("bmat", i__8, "xposbl_", (ftnlen)370)]; - } else { - temp = bmat[(i__7 = rb + i__ + (cb + j) * bmat_dim1 - - bmat_offset) < bmat_dim1 * bmat_dim2 && 0 <= - i__7 ? i__7 : s_rnge("bmat", i__7, "xposbl_", - (ftnlen)372)]; - btmat[(i__7 = rb + i__ + (cb + j) * btmat_dim1 - - btmat_offset) < btmat_dim1 * btmat_dim2 && 0 - <= i__7 ? i__7 : s_rnge("btmat", i__7, "xpos" - "bl_", (ftnlen)373)] = bmat[(i__8 = rb + j + ( - cb + i__) * bmat_dim1 - bmat_offset) < - bmat_dim1 * bmat_dim2 && 0 <= i__8 ? i__8 : - s_rnge("bmat", i__8, "xposbl_", (ftnlen)373)]; - btmat[(i__7 = rb + j + (cb + i__) * btmat_dim1 - - btmat_offset) < btmat_dim1 * btmat_dim2 && 0 - <= i__7 ? i__7 : s_rnge("btmat", i__7, "xpos" - "bl_", (ftnlen)374)] = temp; - } - } - } - } - } - return 0; -} /* xposbl_ */ - diff --git a/ext/spice/src/cspice/xpose.c b/ext/spice/src/cspice/xpose.c deleted file mode 100644 index 6199249436..0000000000 --- a/ext/spice/src/cspice/xpose.c +++ /dev/null @@ -1,151 +0,0 @@ -/* xpose.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure XPOSE ( Transpose a matrix, 3x3 ) */ -/* Subroutine */ int xpose_(doublereal *m1, doublereal *mout) -{ - doublereal temp; - -/* $ Abstract */ - -/* Transpose a 3x3 matrix. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M1 I Matrix to be transposed. */ -/* MOUT O Transposed matrix (M1)**T. */ - -/* $ Detailed_Input */ - -/* M1 This variable may contain any double precision 3x3 */ -/* matrix. */ - -/* $ Detailed_Output */ - -/* MOUT This variable is a double precision, 3x3 matrix which */ -/* contains the transpose of M1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* XPOSE first copies the diagonal elements of M1 to MOUT. Then */ -/* the off-diagonal elements are transposed using a temporary */ -/* variable in the following order: (1,2) <---> (2,1), */ -/* (1,3) <---> (3,1) and finally (2,3) <---> (3,2). */ - -/* $ Examples */ - -/* Given below is one example of a matrix M1 with the output matrix */ -/* MOUT which is implied by M1. */ - -/* | 1 2 3 | | 1 0 0 | */ -/* M1 = | 0 4 5 | then MOUT = | 2 4 6 | */ -/* | 0 6 0 | | 3 5 0 | */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.M. Owen (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - 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 (WMO) */ - -/* -& */ -/* $ Index_Entries */ - -/* transpose a 3x3_matrix */ - -/* -& */ - -/* Move the three diagonal elements from M1 to MOUT */ - - mout[0] = m1[0]; - mout[4] = m1[4]; - mout[8] = m1[8]; - -/* Switch the three pairs of off-diagonal elements */ - - temp = m1[3]; - mout[3] = m1[1]; - mout[1] = temp; - - temp = m1[6]; - mout[6] = m1[2]; - mout[2] = temp; - - temp = m1[7]; - mout[7] = m1[5]; - mout[5] = temp; - - return 0; -} /* xpose_ */ - diff --git a/ext/spice/src/cspice/xpose6_c.c b/ext/spice/src/cspice/xpose6_c.c deleted file mode 100644 index cb4debcad7..0000000000 --- a/ext/spice/src/cspice/xpose6_c.c +++ /dev/null @@ -1,171 +0,0 @@ -/* - --Procedure xpose6_c ( Transpose a matrix, 6x6 ) - --Abstract - - Transpose a 6x6 matrix. - --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 - - None. - -*/ - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - #undef xpose6_c - - - void xpose6_c ( ConstSpiceDouble m1[6][6], SpiceDouble mout[6][6] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I 6x6 matrix to be transposed. - mout I Transpose of m1. mout can overwrite m1. - --Detailed_Input - - m1 This variable may contain any double precision 6x6 - matrix. - --Detailed_Output - - mout This variable is a double precision, 6x6 matrix which - contains the transpose of m1. mout may overwrite m1. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - This is a utility routine intended to facilitate passing state - transformation matrices between C and Fortan. - --Examples - - Given below is one example of a matrix m1 with the output matrix - mout which is implied by m1. - - | 1 2 3 4 5 6 | | 1 0 0 0 0 0 | - | 0 7 8 9 10 11 | | 2 7 0 0 0 0 | - | 0 0 12 13 14 15 | | 3 8 12 0 0 0 | - m1= | 0 0 0 16 17 18 | then mout = | 4 9 13 16 0 0 | - | 0 0 0 0 19 20 | | 5 10 14 17 19 0 | - | 0 0 0 0 0 21 | | 6 11 15 18 20 21| - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.0.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.0.1, 10-NOV-2006 (EDW) - - Added Keywords and Parameters section headers. - Reordered section headers. - - -CSPICE Version 1.0.0, 16-APR-1999 (NJB) - --Index_Entries - - transpose a 6x6_matrix - --& -*/ - -{ /* Begin xpose6_c */ - - - /* - Local constants - */ - #define SIZE 6 - #define SIZESQ 36 - - /* - Local variables - */ - SpiceInt col; - SpiceInt row; - - SpiceDouble temp[SIZE][SIZE]; - - - /* - Capture a temporary copy of the input matrix. - */ - MOVED ( m1, SIZESQ, temp ); - - /* - Move the temporary matrix to the output matrix, transposing as - we go. - */ - for ( row = 0; row < SIZE; row++ ) - { - for ( col = 0; col < SIZE; col++ ) - { - mout[row][col] = temp[col][row]; - } - } - -} /* End xpose6_c */ diff --git a/ext/spice/src/cspice/xpose_c.c b/ext/spice/src/cspice/xpose_c.c deleted file mode 100644 index 15199203de..0000000000 --- a/ext/spice/src/cspice/xpose_c.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - --Procedure xpose_c ( Transpose a matrix, 3x3 ) - --Abstract - - Transpose a 3x3 matrix. - --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 - - None. - -*/ - #include "SpiceUsr.h" - #undef xpose_c - - - void xpose_c ( ConstSpiceDouble m1[3][3], SpiceDouble mout[3][3] ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - m1 I 3x3 matrix to be transposed. - mout I Transpose of m1. mout can overwrite m1. - --Detailed_Input - - m1 This variable may contain any double precision 3x3 - matrix. - --Detailed_Output - - mout This variable is a double precision, 3x3 matrix which - contains the transpose of m1. mout may overwrite m1. - --Parameters - - None. - --Exceptions - - Error free. - --Files - - None. - --Particulars - - xpose_c first copies the diagonal elements of m1 to mout. Then - the off-diagonal elements are transposed using a temporary - variable in the following order: - - (1,2) <---> (2,1) - (1,3) <---> (3,1) - (2,3) <---> (3,2) - - Since a temporary variable is used, it is possible to transpose a - matrix in place. In other words, mout may overwrite m1. - --Examples - - Given below is one example of a matrix m1 with the output matrix - mout which is implied by m1. - - | 1 2 3 | | 1 0 0 | - m1 = | 0 4 5 | then mout = | 2 4 6 | - | 0 6 0 | | 3 5 0 | - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - W.M. Owen (JPL) - --Version - - -CSPICE Version 1.2.2, 16-JAN-2008 (EDW) - - Corrected typos in header titles: - - Detailed Input to Detailed_Input - Detailed Output to Detailed_Output - - -CSPICE Version 1.2.1, 10-NOV-2006 (EDW) - - Added Keywords and Parameters section headers. - Reordered section headers. - - -CSPICE Version 1.2.0, 22-OCT-1998 (NJB) - - Made input matrix const. - - -CSPICE Version 1.1.0, 06-MAR-1998 (EDW) - - Minor correction to header. - - -CSPICE Version 1.0.0, 08-FEB-1998 (NJB) (WLT) (WMO) - - Based on SPICELIB Version 1.0.1, 10-MAR-1992. - --Index_Entries - - transpose a 3x3_matrix - --& -*/ - -{ /* Begin xpose_c */ - - - /* - Local variables - */ - SpiceDouble temp; - - - /* - Move the three diagonal elements from m1 to mout. - */ - mout[0][0] = m1[0][0]; - mout[1][1] = m1[1][1]; - mout[2][2] = m1[2][2]; - - /* - Switch the three pairs of off-diagonal elements. - */ - temp = m1[0][1]; - mout[0][1] = m1[1][0]; - mout[1][0] = temp; - - temp = m1[0][2]; - mout[0][2] = m1[2][0]; - mout[2][0] = temp; - - temp = m1[1][2]; - mout[1][2] = m1[2][1]; - mout[2][1] = temp; - - -} /* End xpose_c */ diff --git a/ext/spice/src/cspice/xposeg.c b/ext/spice/src/cspice/xposeg.c deleted file mode 100644 index 7aa35dd017..0000000000 --- a/ext/spice/src/cspice/xposeg.c +++ /dev/null @@ -1,306 +0,0 @@ -/* xposeg.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure XPOSEG ( Transpose a matrix, general ) */ -/* Subroutine */ int xposeg_(doublereal *matrix, integer *nrow, integer *ncol, - doublereal *xposem) -{ - integer dest; - doublereal temp; - integer k, m, n, r__, moved, start; - doublereal source; - integer nmoves; - -/* $ Abstract */ - -/* Transpose a matrix of arbitrary size (the matrix */ -/* need not be square). */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I Matrix to be transposed. */ -/* NROW I Number of rows of input matrix M1. */ -/* NCOL I Number of columns of input matrix M1. */ -/* XPOSEM O Transposed matrix. */ - -/* $ Detailed_Input */ - -/* MATRIX Matrix to be transposed. */ - -/* NROW Number of rows of input matrix M1. */ - -/* NCOL Number of columns of input matrix M1. */ - -/* $ Detailed_Output */ - -/* XPOSEM O Transposed matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If either NROW or NCOL is less than or equal to zero, no action */ -/* is taken. The routine simply returns. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine transposes the input matrix MATRIX and writes the */ -/* result to the matrix XPOSEM. This algorithm is performed in */ -/* such a way that the transpose can be performed in place. That */ -/* is, MATRIX and XPOSEM can use the same storage area in memory. */ - -/* NOTE: The matrices MATRIX and XPOSEM are declared */ -/* one-dimensional for computational purposes only. The */ -/* calling program should declare them as MATRIX(NROW,NCOL) */ -/* and XPOSEM(NCOL,NROW). */ - -/* This routine works on the assumption that the input and */ -/* output matrices are defined as described above. More */ -/* specifically it assuses that the elements of the matrix */ -/* to be transformed is stored in contiguous memory locations */ -/* as shown here. On output these elements will be */ -/* rearranged in consecutive memory locations as shown. */ - -/* MATRIX XPOSEM */ - -/* m_11 m_11 */ -/* m_21 m_12 */ -/* m_31 m_13 */ -/* . . */ -/* . . */ -/* . m_1ncol */ -/* m_nrow1 m_21 */ -/* m_12 m_22 */ -/* m_22 m_23 */ -/* m_32 . */ -/* . . */ -/* . m_2ncol */ -/* . . */ -/* m_nrow2 */ -/* . . */ - -/* . . */ - -/* . . */ -/* m_1ncol */ -/* m_2ncol m_nrow1 */ -/* m_3ncol m_nrow2 */ -/* . m_nrow3 */ -/* . . */ -/* . . */ -/* m_nrowncol m_nrowncol */ - - -/* For those familiar with permutations, this algorithm relies */ -/* upon the fact that the transposition of a matrix, which has */ -/* been stored as a string, is simply the action of a */ -/* permutation applied to that string. Since any permutation */ -/* can be decomposed as a product of disjoint cycles, it is */ -/* possible to transpose the matrix with only one additional */ -/* storage register. However, once a cycle has been computed */ -/* it is necessary to find the next entry in the string that */ -/* has not been moved by the permutation. For this reason the */ -/* algorithm is slower than would be necessary if the numbers */ -/* of rows and columns were known in advance. */ - -/* $ Examples */ - -/* This routine is primarily useful when attempting to transpose */ -/* large matrices, where inplace transposition is important. For */ -/* example suppose you have the following declarations */ - -/* DOUBLE PRECISION MATRIX ( 1003, 800 ) */ - -/* If the transpose of the matrix is needed, it may not be */ -/* possible to fit a second matrix requiring the same storage */ -/* into memory. Instead declare XPOSEM as below and use */ -/* an equivalence so that the same area of memory is allocated. */ - -/* DOUBLE PRECISION XPOSEM ( 800, 1003 ) */ -/* EQUIVALENCE ( MATRIX (1,1), XPOSEM(1,1) ) */ - -/* To obtain the transpose simply execute */ - -/* CALL XPOSEG ( MATRIX, 1003, 800, XPOSEM ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.3, 22-APR-2010 (NJB) */ - -/* Header correction: assertions that the output */ -/* can overwrite the input have been removed. */ - -/* - SPICELIB Version 1.2.2, 4-MAY-1993 (HAN) */ - -/* The example listed arguments in the call to XPOSEG incorrectly. */ -/* The number of rows was listed as the number of columns, and */ -/* the number of columns was listed as the number of rows. */ - -/* - SPICELIB Version 1.2.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 1.2.0, 6-AUG-1990 (WLT) */ - -/* The original version of the routine had a bug. It worked */ -/* in place, but the fixed points (1,1) and (n,m) were not */ -/* moved so that the routine did not work if input and output */ -/* matrices were different. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* transpose a matrix general */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 6-AUG-1990 (WLT) */ - -/* The original version of the routine had a bug. It worked */ -/* in place, but the fixed points (1,1) and (n,m) were not */ -/* moved so that the routine did not work if input and output */ -/* matrices were different. */ - -/* - Beta Version 1.1.0, 17-FEB-1989 (WLT) (NJB) */ - -/* Example section of header upgraded. Declarations of unused */ -/* variables I, J, and COUNT were removed. Case of negative */ -/* matrix dimensions now is handled. */ - -/* -& */ - -/* Local Variables */ - - -/* Take care of dumb cases first. */ - - if (*nrow <= 0 || *ncol <= 0) { - return 0; - } - n = *nrow; - m = *ncol; - -/* Set up the upper bound for the number of objects to be moved and */ -/* initialize the counters. */ - - nmoves = n * m - 2; - moved = 0; - start = 1; - -/* Until MOVED is equal to NMOVES, there is some matrix element that */ -/* has not been moved to its proper location in the transpose matrix. */ - - while(moved < nmoves) { - source = matrix[start]; - k = start / n; - r__ = start - n * k; - dest = r__ * m + k; - -/* Perform this cycle of the permutation. We will be done when */ -/* the destination of the next element is equal to the starting */ -/* position of the first element to be moved in this cycle. */ - - while(dest != start) { - temp = matrix[dest]; - xposem[dest] = source; - source = temp; - ++moved; - k = dest / n; - r__ = dest - k * n; - dest = m * r__ + k; - } - xposem[dest] = source; - dest = 0; - ++moved; - -/* Find the next element of the matrix that has not already been */ -/* moved by the transposition operation. */ - - if (moved < nmoves) { - while(dest != start) { - ++start; - k = start / n; - r__ = start - k * n; - dest = r__ * m + k; - while(dest > start) { - k = dest / n; - r__ = dest - k * n; - dest = m * r__ + k; - } - } - } - } - -/* Just in case this isn't an in-place transpose, move the last */ -/* element of MATRIX to XPOSEM */ - - xposem[0] = matrix[0]; - xposem[n * m - 1] = matrix[n * m - 1]; - return 0; -} /* xposeg_ */ - diff --git a/ext/spice/src/cspice/xposeg_c.c b/ext/spice/src/cspice/xposeg_c.c deleted file mode 100644 index 7e7359b6e2..0000000000 --- a/ext/spice/src/cspice/xposeg_c.c +++ /dev/null @@ -1,222 +0,0 @@ -/* - --Procedure xposeg_c ( Transpose a matrix, general ) - --Abstract - - Transpose a matrix of arbitrary size (in place, the matrix - need not be square). - --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 - - MATRIX - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZim.h" - #undef xposeg_c - - - void xposeg_c ( const void * matrix, - SpiceInt nrow, - SpiceInt ncol, - void * xposem ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - matrix I Matrix to be transposed. - nrow I Number of rows of input matrix. - ncol I Number of columns of input matrix. - xposem O Transposed matrix (xposem can overwrite matrix). - --Detailed_Input - - matrix Matrix to be transposed. - - nrow Number of rows of input matrix. - - ncol Number of columns of input matrix. - --Detailed_Output - - xposem Transposed matrix. xposem can overwrite matrix. - --Parameters - - None. - --Files - - None. - --Exceptions - - Error Free. - - 1) If either nrow or ncol is less than or equal to zero, no action - is taken. The routine simply returns. - --Particulars - - This routine transposes the input matrix and writes the - result to the matrix xposem. This algorithm is performed in - such a way that the transpose can be performed in place. That - is, matrix and xposem can use the same storage area in memory. - - NOTE: The matrices matrix and xposem are declared - one-dimensional for computational purposes only. The - calling program should declare them as matrix[nrow][ncol] - and xposem[ncol][nrow]. - - This routine works on the assumption that the input and - output matrices are defined as described above. More - specifically it assumes that the elements of the matrix - to be transformed is stored in contiguous memory locations - as shown here. On output these elements will be - rearranged in consecutive memory locations as shown. - - - matrix xposem - - m[0][0] m[0][0] - m[0][1] m[1][0] - m[0][2] m[2][0] - . . - . . - m[0][ncol-1] . - m[1][0] m[nrow-1][0] - m[1][1] m[0][1] - m[1][2] m[1][1] - . m[2][1] - . . - m[1][ncol-1] . - . . - m[nrow-1][1] - . . - - . . - - . . - m[0][ncol-1] - m[nrow-1][0] m[1][ncol-1] - m[nrow-1][1] m[2][ncol-1] - m[nrow-1][2] . - . . - . . - m[nrow-1][ncol-1] m[nrow-1][ncol-1] - - - For those familiar with permutations, this algorithm relies upon the - fact that the transposition of a matrix, which has been stored as a - string, is simply the action of a permutation applied to that - string. Since any permutation can be decomposed as a product of - disjoint cycles, it is possible to transpose the matrix with only - one additional storage register. However, once a cycle has been - computed it is necessary to find the next entry in the string that - has not been moved by the permutation. For this reason the - algorithm is slower than would be necessary if the numbers of rows - and columns were known in advance. - --Examples - - This routine is primarily useful when attempting to transpose large - matrices, where inplace transposition is important. For example - suppose you have the following declarations - - SpiceDouble matrix [1003][800]; - - If the transpose of the matrix is needed, it may not be possible to - fit a second matrix requiring the same storage into memory. Instead - declare xposem as below so that no additional memory is allocated. - - SpiceDouble (* xposem) [1003] = matrix; - - To obtain the transpose simply execute - - xposeg_c ( matrix, 1003, 800, xposem ); - --Restrictions - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - --Literature_References - - None. - --Version - - -CSPICE Version 1.1.0, 24-JUL-2001 (NJB) - - Changed protoype: input matrix is now type (const void *). - Implemented interface macro for casting input matrix to const. - - -CSPICE Version 1.0.0, 31-MAY-1999 (NJB) (WLT) - --Index_Entries - - transpose a matrix general - --& -*/ - -{ /* Begin xposeg_c */ - - - /* - Error free. - */ - - /* - The matrix looks to the f2c'd routine xposeg_ as though it has - ncol rows and nrow columns. xposeg_ will do a perfectly good job - of transposing it if told that these are the dimensions of the input - matrix. - */ - - xposeg_ ( ( doublereal * ) matrix, - ( integer * ) &ncol, - ( integer * ) &nrow, - ( doublereal * ) xposem ); - - -} /* End xposeg_c */ - diff --git a/ext/spice/src/cspice/xpsgip.c b/ext/spice/src/cspice/xpsgip.c deleted file mode 100644 index d1f81d5d13..0000000000 --- a/ext/spice/src/cspice/xpsgip.c +++ /dev/null @@ -1,252 +0,0 @@ -/* xpsgip.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure XPSGIP ( Transpose a matrix, general dimension, in place ) */ -/* Subroutine */ int xpsgip_(integer *nrow, integer *ncol, doublereal *matrix) -{ - integer dest; - doublereal temp; - integer k, m, n, r__, moved, start; - doublereal source; - integer nmoves; - -/* $ Abstract */ - -/* Transpose a matrix of arbitrary size and shape in place. */ - -/* $ 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 */ - -/* MATRIX */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NROW I Number of rows of input matrix. */ -/* NCOL I Number of columns of input matrix. */ -/* MATRIX I-O Matrix to be transposed/transposed matrix. */ - -/* $ Detailed_Input */ - -/* MATRIX Matrix to be transposed. */ - -/* NROW Number of rows of input matrix MATRIX. */ - -/* NCOL Number of columns of input matrix MATRIX. */ - -/* $ Detailed_Output */ - -/* MATRIX Transposed matrix: element (i,j) of the input */ -/* matrix is element (j,i) of the output matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If either NROW or NCOL is less than or equal to zero, no action */ -/* is taken. The routine simply returns. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine replaces the input matrix MATRIX with its transpose. */ - -/* NOTE: The matrix MATRIX is declared one-dimensional for */ -/* computational purposes only. The calling program may */ -/* declare it as MATRIX(NROW,NCOL) or MATRIX(NCOL,NROW). */ - -/* This routine assumes that the elements of the matrix to be */ -/* transformed are stored in contiguous memory locations as */ -/* shown here. On output these elements will be rearranged */ -/* in consecutive memory locations as shown. */ - -/* MATRIX on input MATRIX on output */ - -/* m_11 m_11 */ -/* m_21 m_12 */ -/* m_31 m_13 */ -/* . . */ -/* . . */ -/* . m_1ncol */ -/* m_nrow1 m_21 */ -/* m_12 m_22 */ -/* m_22 m_23 */ -/* m_32 . */ -/* . . */ -/* . m_2ncol */ -/* . . */ -/* m_nrow2 */ -/* . . */ - -/* . . */ - -/* . . */ -/* m_1ncol */ -/* m_2ncol m_nrow1 */ -/* m_3ncol m_nrow2 */ -/* . m_nrow3 */ -/* . . */ -/* . . */ -/* m_nrowncol m_nrowncol */ - - -/* For those familiar with permutations, this algorithm relies */ -/* upon the fact that the transposition of a matrix, which has */ -/* been stored as a 1-dimensional array, is simply the action of a */ -/* permutation applied to that array. Since any permutation */ -/* can be decomposed as a product of disjoint cycles, it is */ -/* possible to transpose the matrix with only one additional */ -/* storage register. However, once a cycle has been computed */ -/* it is necessary to find the next entry in the array that */ -/* has not been moved by the permutation. For this reason the */ -/* algorithm is slower than would be necessary if the numbers */ -/* of rows and columns were known in advance. */ - -/* $ Examples */ - -/* This routine is provided for situation where it is convenient to */ -/* transpose a general two-dimensional matrix */ -/* in place rather than store the result in a */ -/* separate array. Note that the call */ - -/* CALL XPOSEG ( MATRIX, NROW, NCOL, MATRIX ) */ - -/* is not permitted by the ANSI Fortran 77 standard; this routine */ -/* can be called instead to achieve the same result. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 19-SEP-2006 (EDW) */ - -/* Initial version date unknown. Version data entry */ -/* added this date. */ - - -/* -& */ -/* $ Index_Entries */ - -/* transpose a matrix general */ - -/* -& */ - -/* Local Variables */ - - -/* Take care of dumb cases first. */ - - if (*nrow <= 0 || *ncol <= 0) { - return 0; - } - -/* Use the abbreviations N and M for NROW and NCOL. */ - - n = *nrow; - m = *ncol; - -/* Set up the upper bound for the number of objects to be moved and */ -/* initialize the counters. */ - - nmoves = n * m - 2; - moved = 0; - start = 1; - -/* Until MOVED is equal to NMOVES, there is some matrix element that */ -/* has not been moved to its proper location in the transpose matrix. */ - - while(moved < nmoves) { - source = matrix[start]; - k = start / n; - r__ = start - n * k; - dest = r__ * m + k; - -/* Perform this cycle of the permutation. We will be done when */ -/* the destination of the next element is equal to the starting */ -/* position of the first element to be moved in this cycle. */ - - while(dest != start) { - temp = matrix[dest]; - matrix[dest] = source; - source = temp; - ++moved; - k = dest / n; - r__ = dest - k * n; - dest = m * r__ + k; - } - matrix[dest] = source; - dest = 0; - ++moved; - -/* Find the next element of the matrix that has not already been */ -/* moved by the transposition operation. */ - - if (moved < nmoves) { - while(dest != start) { - ++start; - k = start / n; - r__ = start - k * n; - dest = r__ * m + k; - while(dest > start) { - k = dest / n; - r__ = dest - k * n; - dest = m * r__ + k; - } - } - } - } - return 0; -} /* xpsgip_ */ - diff --git a/ext/spice/src/cspice/xwsne.c b/ext/spice/src/cspice/xwsne.c deleted file mode 100644 index 41c929b079..0000000000 --- a/ext/spice/src/cspice/xwsne.c +++ /dev/null @@ -1,72 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#include "lio.h" -#include "fmt.h" - -extern int f__Aquote; - - static VOID -nl_donewrec(Void) -{ - (*f__donewrec)(); - PUT(' '); - } - -#ifdef KR_headers -x_wsne(a) cilist *a; -#else -#include "string.h" - - VOID -x_wsne(cilist *a) -#endif -{ - Namelist *nl; - char *s; - Vardesc *v, **vd, **vde; - ftnint *number, type; - ftnlen *dims; - ftnlen size; - static ftnint one = 1; - extern ftnlen f__typesize[]; - - nl = (Namelist *)a->cifmt; - PUT('&'); - for(s = nl->name; *s; s++) - PUT(*s); - PUT(' '); - f__Aquote = 1; - vd = nl->vars; - vde = vd + nl->nvars; - while(vd < vde) { - v = *vd++; - s = v->name; -#ifdef No_Extra_Namelist_Newlines - if (f__recpos+strlen(s)+2 >= L_len) -#endif - nl_donewrec(); - while(*s) - PUT(*s++); - PUT(' '); - PUT('='); - number = (dims = v->dims) ? dims + 1 : &one; - type = v->type; - if (type < 0) { - size = -type; - type = TYCHAR; - } - else - size = f__typesize[type]; - l_write(number, v->addr, size, type); - if (vd < vde) { - if (f__recpos+2 >= L_len) - nl_donewrec(); - PUT(','); - PUT(' '); - } - else if (f__recpos+1 >= L_len) - nl_donewrec(); - } - f__Aquote = 0; - PUT('/'); - } diff --git a/ext/spice/src/cspice/z_abs.c b/ext/spice/src/cspice/z_abs.c deleted file mode 100644 index 7e67ad2957..0000000000 --- a/ext/spice/src/cspice/z_abs.c +++ /dev/null @@ -1,12 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double f__cabs(); -double z_abs(z) doublecomplex *z; -#else -double f__cabs(double, double); -double z_abs(doublecomplex *z) -#endif -{ -return( f__cabs( z->r, z->i ) ); -} diff --git a/ext/spice/src/cspice/z_cos.c b/ext/spice/src/cspice/z_cos.c deleted file mode 100644 index fdd1510db4..0000000000 --- a/ext/spice/src/cspice/z_cos.c +++ /dev/null @@ -1,15 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sin(), cos(), sinh(), cosh(); -VOID z_cos(r, z) doublecomplex *r, *z; -#else -#undef abs -#include "math.h" -void z_cos(doublecomplex *r, doublecomplex *z) -#endif -{ - double zr = z->r; - r->r = cos(zr) * cosh(z->i); - r->i = - sin(zr) * sinh(z->i); - } diff --git a/ext/spice/src/cspice/z_div.c b/ext/spice/src/cspice/z_div.c deleted file mode 100644 index 22153fa451..0000000000 --- a/ext/spice/src/cspice/z_div.c +++ /dev/null @@ -1,36 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -extern VOID sig_die(); -VOID z_div(c, a, b) doublecomplex *a, *b, *c; -#else -extern void sig_die(char*, int); -void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) -#endif -{ - double ratio, den; - double abr, abi, cr; - - if( (abr = b->r) < 0.) - abr = - abr; - if( (abi = b->i) < 0.) - abi = - abi; - if( abr <= abi ) - { - if(abi == 0) - sig_die("complex division by zero", 1); - ratio = b->r / b->i ; - den = b->i * (1 + ratio*ratio); - cr = (a->r*ratio + a->i) / den; - c->i = (a->i*ratio - a->r) / den; - } - - else - { - ratio = b->i / b->r ; - den = b->r * (1 + ratio*ratio); - cr = (a->r + a->i*ratio) / den; - c->i = (a->i - a->r*ratio) / den; - } - c->r = cr; - } diff --git a/ext/spice/src/cspice/z_exp.c b/ext/spice/src/cspice/z_exp.c deleted file mode 100644 index 56138f3d34..0000000000 --- a/ext/spice/src/cspice/z_exp.c +++ /dev/null @@ -1,17 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double exp(), cos(), sin(); -VOID z_exp(r, z) doublecomplex *r, *z; -#else -#undef abs -#include "math.h" -void z_exp(doublecomplex *r, doublecomplex *z) -#endif -{ -double expx; - -expx = exp(z->r); -r->r = expx * cos(z->i); -r->i = expx * sin(z->i); -} diff --git a/ext/spice/src/cspice/z_log.c b/ext/spice/src/cspice/z_log.c deleted file mode 100644 index 2d52b941d6..0000000000 --- a/ext/spice/src/cspice/z_log.c +++ /dev/null @@ -1,16 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double log(), f__cabs(), atan2(); -VOID z_log(r, z) doublecomplex *r, *z; -#else -#undef abs -#include "math.h" -extern double f__cabs(double, double); -void z_log(doublecomplex *r, doublecomplex *z) -#endif -{ - double zi = z->i; - r->i = atan2(zi, z->r); - r->r = log( f__cabs( z->r, zi ) ); - } diff --git a/ext/spice/src/cspice/z_sin.c b/ext/spice/src/cspice/z_sin.c deleted file mode 100644 index 577be1d85f..0000000000 --- a/ext/spice/src/cspice/z_sin.c +++ /dev/null @@ -1,15 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sin(), cos(), sinh(), cosh(); -VOID z_sin(r, z) doublecomplex *r, *z; -#else -#undef abs -#include "math.h" -void z_sin(doublecomplex *r, doublecomplex *z) -#endif -{ - double zr = z->r; - r->r = sin(zr) * cosh(z->i); - r->i = cos(zr) * sinh(z->i); - } diff --git a/ext/spice/src/cspice/z_sqrt.c b/ext/spice/src/cspice/z_sqrt.c deleted file mode 100644 index c04e8f0a1a..0000000000 --- a/ext/spice/src/cspice/z_sqrt.c +++ /dev/null @@ -1,29 +0,0 @@ -#include "f2c.h" - -#ifdef KR_headers -double sqrt(), f__cabs(); -VOID z_sqrt(r, z) doublecomplex *r, *z; -#else -#undef abs -#include "math.h" -extern double f__cabs(double, double); -void z_sqrt(doublecomplex *r, doublecomplex *z) -#endif -{ - double mag, zi = z->i, zr = z->r; - - if( (mag = f__cabs(zr, zi)) == 0.) - r->r = r->i = 0.; - else if(zr > 0) - { - r->r = sqrt(0.5 * (mag + zr) ); - r->i = zi / r->r / 2; - } - else - { - r->i = sqrt(0.5 * (mag - zr) ); - if(zi < 0) - r->i = - r->i; - r->r = zi / r->i / 2; - } - } diff --git a/ext/spice/src/cspice/zzadbail_c.c b/ext/spice/src/cspice/zzadbail_c.c deleted file mode 100644 index dc9380022c..0000000000 --- a/ext/spice/src/cspice/zzadbail_c.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - --Procedure zzadbail_c (GF, bail out inquiry adapter ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran code to call a - CSPICE-style GF bail out inquiry function. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - #undef zzadbail_c - - logical zzadbail_c () - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - The function returns the logical value SPICEFALSE. - --Detailed_Input - - None. - --Detailed_Output - - The function returns the logical value SPICEFALSE. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style GF bail out inquiry function - has been stored via a call to zzadsave_c. - - The argument list of the stored function must match that of - gfbail_c. - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code that - requires a "bail out" inquiry function input argument. This - function tests whether the current GF search should be terminated - in response to an interrupt. - - The argument list of this routine matches that of the f2c'd routine - - gfbail_ - - This routine calls the CSPICE-style bail out inquiry function passed - into a CSPICE wrapper for an intermediate-level GF function. A - pointer to this bail out inquiry function must be stored via a call - to zzadsave_c before this routine is called. - - The argument list of the function referenced by the saved pointer - must match that of - - gfbail_c - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 25-MAR-2008 (NJB) - --Index_Entries - - adapter for gf bail out inquiry - --& -*/ - -{ /* Begin zzadbail_c */ - - - /* - Local variables - */ - logical retval; - - SpiceBoolean ( * fPtr ) (); - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( (logical)SPICEFALSE ); - } - chkin_c ( "zzadbail_c" ); - - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of gfbail_c. - */ - - fPtr = ( SpiceBoolean (*) () ) zzadget_c ( UDBAIL ); - - /* - Call the CSPICE-style bail-out function. - */ - - retval = (logical) ( ( *fPtr )() ); - - - chkout_c ( "zzadbail_c" ); - - return ( retval ); - -} /* End zzadbail_c */ diff --git a/ext/spice/src/cspice/zzadfunc_c.c b/ext/spice/src/cspice/zzadfunc_c.c deleted file mode 100644 index e0d1bdf531..0000000000 --- a/ext/spice/src/cspice/zzadfunc_c.c +++ /dev/null @@ -1,170 +0,0 @@ -/* - --Procedure zzadfunc_c ( Private - GF, f(x) adapter ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran - code to call a CSPICE-style routine that calculates - the gfuds_c scalar quantity value. - --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 - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - - int zzadfunc_c ( doublereal * et, - doublereal * value ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - et I Epoch of interest in TDB seconds - value O Function value at 'et' - --Detailed_Input - - et The epoch in TDB seconds for which to calculate the user - defined scalar quantity function. - --Detailed_Output - - value The double precision value of the scalar quantity function - at 'et'. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style function has been stored via - a call to zzadfunc_c. - - The argument list of the stored function must match that of - udfunc (refer to gfuds_c.c). - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code that - requires a user defined scalar value function as an argument. - - This routine calls the CSPICE-style scalar value function passed - to a CSPICE wrapper for use by an intermediate-level GF - function. A pointer to this function must be stored via a call - to zzadsave_c before this routine is called. - --Examples - - None. - --Restrictions - - 1) This function is intended only for internal use by GF routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 24-OCT-2008 (EDW) - --Index_Entries - - adapter for gf scalar value routine - --& -*/ - -{ /* Begin zzadfunc_c */ - - - /* - Local variables - */ - void ( * fPtr ) ( SpiceDouble, - SpiceDouble * ); - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadfunc_c" ); - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of "udfunc." - */ - - fPtr = ( void (*) (SpiceDouble, SpiceDouble*) ) zzadget_c ( UDFUNC ); - - /* - Call the stored function. - */ - - (*fPtr) ( (SpiceDouble)(*et), (SpiceDouble *)value ); - - - chkout_c ( "zzadfunc_c" ); - - return ( 0 ); - -} /* End zzadfunc_c */ diff --git a/ext/spice/src/cspice/zzadqdec_c.c b/ext/spice/src/cspice/zzadqdec_c.c deleted file mode 100644 index f03a71113d..0000000000 --- a/ext/spice/src/cspice/zzadqdec_c.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - --Procedure zzadqdec_c ( Private - GF, df(x)/dx < 0 adapter ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran - code to call a CSPICE-style GF routine that determines if - the derivative of the gfuds_c scalar quantity is negative. - --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 - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - - int zzadqdec_c ( U_fp udfunc, - doublereal * et, - logical * xbool ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - et I Epoch of interest in TDB seconds - xbool O Boolean value of df(x)/dt < 0 at 'et' - --Detailed_Input - - et The epoch in TDB seconds for which to determine if the value - of the derivative with respect to time of the user defined - scalar quantity function is less than zero. - --Detailed_Output - - xbool The boolean value of the relation - - d f(x) | - ------ | < 0 - d x | et - - with f(x) the user defined scalar quantity function. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style function has been stored via - a call to zzadqdec_c. - - The argument list of the stored function must match that of - udqdec (refer to gfuds_c.c). - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code that - requires a derivative sign test function as an argument. - - This routine calls the CSPICE-style derivative test function - passed to a CSPICE wrapper for use by an intermediate-level GF - function. A pointer to this function must be stored via a call - to zzadsave_c before this routine is called. - --Examples - - None. - --Restrictions - - 1) This function is intended only for internal use by GF routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 21-DEC-2008 (EDW) - --Index_Entries - - adapter for gf scalar quantity derivative test routine - --& -*/ - - { /* Begin zzadqdec_c */ - - /* - Local variables - */ - void ( * fPtr ) ( void ( * ) ( SpiceDouble, - SpiceDouble *), - SpiceDouble, - SpiceBoolean * ); - - void ( * fPtr2) ( SpiceDouble, - SpiceDouble * ); - - SpiceBoolean bool_loc; - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadqdec_c" ); - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of "udqdec." - */ - fPtr = ( void (*) ( void ( * ) ( SpiceDouble, SpiceDouble *), - SpiceDouble, - SpiceBoolean*) ) zzadget_c ( UDQDEC ); - - /* - Retrieve the stored pointer for the user defined scalar function. The - 'udfunc' pointer passed to zzadqdec_c as an argument corresponds to - the adapter for the scalar function, but the function pointer - argument in 'fPtr' requires the non-adapter pointer. Ignore 'udfunc'. - */ - fPtr2= ( void (*) (SpiceDouble, SpiceDouble*) ) zzadget_c ( UDFUNC ); - - /* - Call the stored function. - */ - (*fPtr) ( fPtr2, (SpiceDouble)(*et), (SpiceBoolean *) &bool_loc ); - - /* - Cast the "SpiceBoolean" to "logical" to prevent any future size mismatches - or compiler warnings. - */ - *xbool = (logical) bool_loc; - - chkout_c ( "zzadqdec_c" ); - - return ( 0 ); - - } /* End zzadqdec_c */ diff --git a/ext/spice/src/cspice/zzadrefn_c.c b/ext/spice/src/cspice/zzadrefn_c.c deleted file mode 100644 index 0c4a7eb85d..0000000000 --- a/ext/spice/src/cspice/zzadrefn_c.c +++ /dev/null @@ -1,202 +0,0 @@ -/* - --Procedure zzadrefn_c ( GF, adapter for refinement function ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran - code to call a CSPICE-style GF refinement function. - --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 - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - - - int zzadrefn_c ( doublereal * t1, - doublereal * t2, - logical * s1, - logical * s2, - doublereal * t ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - t1 I One of two times bracketing a state change. - t2 I The other time that brackets a state change. - s1 I State at t1. - s2 I State at t2. - t O New time at which to check for transition. - --Detailed_Input - - t1 One of two times bracketing a state change. - `t1' is expressed as seconds past J2000 TDB. - - t2 The other time that brackets a state change. - `t2' is expressed as seconds past J2000 TDB. - - n1 Number of times state state of interest - matched the value at t1. - - n2 Number of times state state of interest - matched the value at t2. - --Detailed_Output - - t is the value returned by the stored, passed-in - refinement function. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style GF refinement function has - been stored via a call to zzadsave_c. - - The argument list of the stored function must match that of - gfrefn_c. - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code - that requires a refinement function input argument. The argument - list of this routine matches that of the f2c'd routine - - gfrefn_ - - This routine calls the CSPICE-style refinement function passed - into a CSPICE wrapper for an intermediate-level GF function. - A pointer to this refinement function must be stored via - a call to zzadsave_c before this routine is called. - --Examples - - None. - --Restrictions - - No errors are returned by this routine. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 09-MAR-2009 (NJB) - --Index_Entries - - adapter for gf refinement function - --& -*/ - -{ /* Begin zzadrefn_c */ - - - /* - Local variables - */ - SpiceBoolean bs1; - SpiceBoolean bs2; - - void ( * fPtr ) ( SpiceDouble, - SpiceDouble, - SpiceBoolean, - SpiceBoolean, - SpiceDouble * ); - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadrefn_c" ); - - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of gfrefn_c. - */ - - fPtr = ( void (*) ( SpiceDouble, - SpiceDouble, - SpiceBoolean, - SpiceBoolean, - SpiceDouble * ) ) zzadget_c ( UDREFN ); - - /* - Call the stored function. - */ - - bs1 = (SpiceBoolean) (*s1); - bs2 = (SpiceBoolean) (*s2); - - (*fPtr) ( (SpiceDouble ) (*t1), - (SpiceDouble ) (*t2), - bs1, - bs2, - (SpiceDouble *) t ); - - - chkout_c ( "zzadrefn_c" ); - - return ( 0 ); - - -} /* End zzadrefn_c */ diff --git a/ext/spice/src/cspice/zzadrepf_c.c b/ext/spice/src/cspice/zzadrepf_c.c deleted file mode 100644 index e758c53535..0000000000 --- a/ext/spice/src/cspice/zzadrepf_c.c +++ /dev/null @@ -1,174 +0,0 @@ -/* - --Procedure zzadrepf_c (GF, progress report termination adapter ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran code to call a - CSPICE-style GF progress reporting termination function. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - #undef zzadrepf_c - - int zzadrepf_c () - - -/* - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style GF progress reporting - termination function has been stored via a call to zzadsave_c. - - The argument list of the stored function must match that of - gfrepf_c. - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code that - requires a progress reporting termination function input argument. - The argument list of this routine matches that of the f2c'd routine - - gfrepf_ - - This routine calls the CSPICE-style progress reporting termination - function passed into a CSPICE wrapper for an intermediate-level GF - function. A pointer to this progress reporting termination function - must be stored via a call to zzadsave_c before this routine is - called. - - The argument list of the function referenced by the saved pointer - must match that of - - gfrepf_c - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 29-MAR-2008 (NJB) - --Index_Entries - - terminate a gf progress report - --& -*/ - -{ /* Begin zzadrepf_c */ - - - /* - Local variables - */ - void ( * fPtr ) (); - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadrepf_c" ); - - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of gfrepf_c. - */ - - fPtr = ( void (*) () ) zzadget_c ( UDREPF ); - - /* - Call the CSPICE-style progress report termination function. - */ - - ( *fPtr ) (); - - - chkout_c ( "zzadrepf_c" ); - - return ( 0 ); - -} /* End zzadrepf_c */ diff --git a/ext/spice/src/cspice/zzadrepi_c.c b/ext/spice/src/cspice/zzadrepi_c.c deleted file mode 100644 index 2b77205600..0000000000 --- a/ext/spice/src/cspice/zzadrepi_c.c +++ /dev/null @@ -1,305 +0,0 @@ -/* - --Procedure zzadrpin_c (GF, progress report initialization adapter ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran code to call a - CSPICE-style GF progress reporting initialization function. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - #undef zzadrepi_c - - int zzadrepi_c ( doublereal * cnfine, - char * begmss, - char * endmss, - ftnlen begmssLen, - ftnlen endmssLen ) - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - cnfine I Confinement window. - begmss I Beginning of the text portion of the output message. - endmss I End of the text portion of the output message. - --Detailed_Input - - cnfine is an array of type double containing a SPICE window. - This is the confinement window associated with some - GF root finding activity. It is used to determine how - much total time is being searched in order to find - the events of interest. - - - begmss is the beginning of the output message reported by - the routine gfrpwk_. This output message has the form - - begmss ' xx.xx% ' endmss - - `begmss' is a Fortran-style string. - - - endmss is the last portion of the output message reported by - the routine gfrpwk_. - - `endmss' is a Fortran-style string. - - - begmssLen is the length of the string `begmss'. The total - length of `begmss' must be less than 40 characters. - - endmssLen is the length of the string `endmss'. The total - length of `endmss' must be less than 40 characters. - - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style GF progress reporting - initialization function has been stored via a call to zzadsave_c. - - The argument list of the stored function must match that of - gfrepi_c. - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code that - requires a progress reporting initialization function input argument. - The argument list of this routine matches that of the f2c'd routine - - gfrepi_ - - This routine calls the CSPICE-style progress reporting - initialization function passed into a CSPICE wrapper for an - intermediate-level GF function. A pointer to this progress reporting - initialization function must be stored via a call to zzadsave_c - before this routine is called. - - The argument list of the function referenced by the saved pointer - must match that of - - gfrepi_c - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 29-MAR-2008 (NJB) - --Index_Entries - - provide status of a job in progress - --& -*/ - -{ /* Begin zzadrepi_c */ - - - - /* - Local variables - */ - SpiceCell cnfineCell; - - SpiceChar * prefstr; - SpiceChar * suffstr; - - SpiceInt nBytes; - - /* - Function pointer for CSPICE-style progress reporting - initialization function: - */ - void ( * fPtr ) ( ConstSpiceCell *, - ConstSpiceChar *, - ConstSpiceChar * ); - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadrepi_c" ); - - - /* - In order to call the saved, passed-in progress report - initialization function, we'll have to prepare - some of the input arguments. We need C-style strings, - and we need a confinement cell rather than an array. - - Set up the cell first. - */ - cnfineCell.dtype = SPICE_DP; - cnfineCell.length = 0; - cnfineCell.size = sized_(cnfine); - cnfineCell.card = cardd_(cnfine); - cnfineCell.isSet = SPICEFALSE; - cnfineCell.adjust = SPICEFALSE; - cnfineCell.init = SPICETRUE; - cnfineCell.base = cnfine; - cnfineCell.data = (SpiceDouble *)cnfine + SPICE_CELL_CTRLSZ; - - /* - Allocate memory to hold C-style versions of the input strings. - - First create a C-style prefix string. - */ - nBytes = (begmssLen+1) * sizeof(char); - - prefstr = (SpiceChar *) malloc( nBytes ); - - if ( !prefstr ) - { - setmsg_c ( "Could not allocate # bytes for progress report " - "prefix string." ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILURE)" ); - chkout_c ( "zzadrepi_c" ); - - /* - Return status of "0" because we don't want to invoke any f2c - error handling mechanism that may exist. - */ - return ( 0 ); - } - - strncpy ( prefstr, begmss, begmssLen ); - prefstr[begmssLen] = NULLCHAR; - - - /* - Create a C-style suffix string. - */ - nBytes = (endmssLen+1) * sizeof(char); - - suffstr = (SpiceChar *) malloc( nBytes ); - - if ( !suffstr ) - { - /* - Free the dynamically allocated prefix string before doing - anything else. - */ - free ( prefstr ); - - - setmsg_c ( "Could not allocate # bytes for progress report " - "suffix string." ); - errint_c ( "#", nBytes ); - sigerr_c ( "SPICE(MALLOCFAILURE)" ); - chkout_c ( "zzadrepi_c" ); - - return ( 0 ); - } - - strncpy ( suffstr, endmss, endmssLen ); - suffstr[endmssLen] = NULLCHAR; - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of gfrepi_c. - */ - - fPtr = ( void (*) ( ConstSpiceCell *, - ConstSpiceChar *, - ConstSpiceChar * ) ) zzadget_c ( UDREPI ); - /* - At this point we have the inputs required by the saved - GF progress report initialization function. - */ - - ( *fPtr ) ( (ConstSpiceCell *) &cnfineCell, - (ConstSpiceChar *) prefstr, - (ConstSpiceChar *) suffstr ); - - /* - Free the dynamically allocated strings. - */ - free ( prefstr ); - free ( suffstr ); - - - chkout_c ( "zzadrepi_c" ); - - return ( 0 ); - -} /* End zzadrepi_c */ diff --git a/ext/spice/src/cspice/zzadrepu_c.c b/ext/spice/src/cspice/zzadrepu_c.c deleted file mode 100644 index a335368ab7..0000000000 --- a/ext/spice/src/cspice/zzadrepu_c.c +++ /dev/null @@ -1,197 +0,0 @@ -/* - --Procedure zzadrepu_c (GF, progress report update adapter ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran code to call a - CSPICE-style GF progress reporting update function. - --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 - - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - #undef zzadrepu_c - - int zzadrepu_c ( doublereal * ivbeg, - doublereal * ivend, - doublereal * time ) - - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - ivbeg I Current confinement window interval start time. - ivend I Current confinement window interval stop time. - time I Current time indicating search progress. - --Detailed_Input - - ivbeg, - ivend are the time bounds of the current interval of the - confinement window. This is the window associated - with some root finding activity. It is used to - determine how much total time is being searched in - order to find the events of interest. - - Both times are expressed as seconds past J2000 TDB. - - time is the current time reached in the search for an - event. `time' is expressed as seconds past J2000 TDB. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style GF progress reporting - update function has been stored via a call to zzadsave_c. - - The argument list of the stored function must match that of - gfrepu_c. - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code that - requires a progress reporting update function input argument. - The argument list of this routine matches that of the f2c'd routine - - gfrepu_ - - This routine calls the CSPICE-style progress reporting - update function passed into a CSPICE wrapper for an - intermediate-level GF function. A pointer to this progress reporting - update function must be stored via a call to zzadsave_c - before this routine is called. - - The argument list of the function referenced by the saved pointer - must match that of - - gfrepu_c - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - L.S. Elson (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 29-MAR-2008 (NJB) - --Index_Entries - - provide status of a job in progress - --& -*/ - -{ /* Begin zzadrepu_c */ - - - /* - Local variables - */ - void ( * fPtr ) ( SpiceDouble, - SpiceDouble, - SpiceDouble ); - - - /* - Participate in error tracing. - */ - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadrepu_c" ); - - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of gfrepu_c. - */ - - fPtr = ( void (*) ( SpiceDouble, - SpiceDouble, - SpiceDouble ) ) zzadget_c ( UDREPU ); - - /* - Call the CSPICE-style progress report update function. - */ - - ( *fPtr ) ( (SpiceDouble) (*ivbeg), - (SpiceDouble) (*ivend), - (SpiceDouble) (*time ) ); - - - chkout_c ( "zzadrepu_c" ); - - return ( 0 ); - -} /* End zzadrepu_c */ diff --git a/ext/spice/src/cspice/zzadsave_c.c b/ext/spice/src/cspice/zzadsave_c.c deleted file mode 100644 index afadab13a1..0000000000 --- a/ext/spice/src/cspice/zzadsave_c.c +++ /dev/null @@ -1,412 +0,0 @@ -/* - --Procedure zzadsave_c ( Save passed-in function pointer arguments ) - --Abstract - - CSPICE Private routine intended solely for the support of CSPICE - routines. Users should not call this routine directly due - to the volatile nature of this routine. - - Save passed-in function pointer arguments to make them available - for use by CSPICE adapter functions. - --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 - - None - -*/ - - #include "SpiceUsr.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - - /* - Static file scope variables - - The function pointer list is accessed by the functions - - zzadsave_c ( Save a function pointer for adapter use ) - zzadget_c ( Get a function pointer for adapter use ) - - */ - static void * funcPtrList [ SPICE_N_PASSED_IN_FUNC ]; - - - - - void zzadsave_c ( SpicePassedInFunc funcID, - void * funcPtr ) -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - funcID I Enum constant identifying function. - funcPtr I Function pointer acting as a passed-in argument. - --Detailed_Input - - funcID is an ID of type SpicePassedInFunc; `funcID' - identifies the function pointed to by the - input argument `funcPtr'. - - funcPtr is a function pointer acting as a passed-in - argument to a CSPICE wrapper. This function - pointer is to be stored so that the function - it points to can be called by a CSPICE adapter. - --Detailed_Output - - None. This routine operates by side effects. - --Parameters - - None. - --Exceptions - - 1) If the input ID `funcID' is not in the range corresponding - to the values of the enum SpicePassedInFunc, the error - SPICE(VALUEOUTOFRANGE) is signaled. - --Files - - None. - --Particulars - - This private utility package provides access to a static array - of function pointers. The package contains the two functions - - zzadsave_c ( Save a function pointer for adapter use ) - zzadget_c ( Get a function pointer for adapter use ) - - These two function are present in the same file because the - functions share data. The shared array is declared at file - scope rather than as an extern variable to limit access. The - effect is similar to that of sharing data between Fortran - entry points. - - The stored function pointers are associated with passed-in function - pointer arguments of CSPICE wrappers. These functions are called - by CSPICE adapter routines. - --Examples - - 1) Store a pointer to the default GF step routine. Retrieve - the pointer and call the function using this pointer. - - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZad.h" - - int main() - { - - /. - Declare `userstepPtr' as a pointer to a function of the - type of the GF default step function: - ./ - void ( * userstepPtr ) ( SpiceDouble et, - SpiceDouble * step ); - - SpiceDouble et; - SpiceDouble step; - - - /. - Store a pointer to the GF default step function. - ./ - zzadsave_c ( UDSTEP, gfstep_c ); - - /. - Set step size to 5 minutes (units are seconds). - ./ - gfsstp_c ( 300.0 ); - - /. - Fetch the desired pointer and cast to the type of the GF - step function: - ./ - userstepPtr = ( void (*)(SpiceDouble, - SpiceDouble*) ) zzadget_c( UDSTEP ); - - /. - Call the function for a given ET and retrieve the step size: - ./ - et = 1.e8; - - userstepPtr ( et, &step ); - - printf ( "Returned step size was %f\n", step ); - - return ( 0 ); - } - - --Restrictions - - 1) These utilities must be used only to store function pointers - to be used by existing CSPICE adapter routines. See the header - file - - SpiceZad.h - - for the list of supported routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 09-MAR-2009 (NJB) - --Index_Entries - - save passed-in function pointer argument - --& -*/ - -{ /* Begin zzadsave_c */ - - - - /* - Participate in error tracing. - */ - chkin_c ( "zzadsave_c" ); - - - /* - Make sure function ID is in range. - */ - - if ( ( funcID < 0 ) || ( funcID >= SPICE_N_PASSED_IN_FUNC ) ) - { - setmsg_c ( "Input function ID was #; valid range is 0:#. " - "Function ID doesn't correspond to a known " - "passed-in function argument." ); - errint_c ( "#", (SpiceInt) funcID ); - errint_c ( "#", (SpiceInt) SPICE_N_PASSED_IN_FUNC - 1 ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "zzadsave_c" ); - return; - } - - - /* - Store the function pointer at the index indicated by the - function ID. - */ - funcPtrList[ funcID ] = funcPtr; - - - chkout_c ( "zzadsave_c" ); - -} /* End zzadsave_c */ - - - - -/* - --Procedure zzadget_c ( Get passed-in function pointer arguments ) - --Abstract - - CSPICE Private routine intended solely for the support of CSPICE - routines. Users should not call this routine directly due - to the volatile nature of this routine. - - Get passed-in function pointer arguments to make them available - for use by CSPICE adapter functions. - --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 - - None - -*/ - - void * zzadget_c ( SpicePassedInFunc funcID ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - funcID I Enum constant identifying function. - - This function returns the specified function pointer acting as - a passed-in argument. - --Detailed_Input - - funcID is an ID of type SpicePassedInFunc; `funcID' - identifies the function whose saved pointer - is to be returned. - --Detailed_Output - - This function returns the specified function pointer. The caller - should cast the pointer to the correct type to allow compile-time - type checking. - --Parameters - - None. - --Exceptions - - 1) If the input ID `funcID' is not in the range corresponding - to the values of the enum SpicePassedInFunc, the error - SPICE(VALUEOUTOFRANGE) is signaled. - --Files - - None. - --Particulars - - See the Particulars section of zzadsave_c. - --Examples - - See the Examples section of zzadsave_c. - --Restrictions - - 1) These utilities must be used only to store function pointers - to be used by existing CSPICE adapter routines. See the header - file - - SpiceZad.h - - for the list of supported routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 09-MAR-2009 (NJB) - --Index_Entries - - get passed-in function pointer argument - --& -*/ - -{ /* Begin zzadget_c */ - - - /* - Participate in error tracing. - */ - chkin_c ( "zzadget_c" ); - - /* - Make sure function ID is in range. - */ - if ( ( funcID < 0 ) || ( funcID >= SPICE_N_PASSED_IN_FUNC ) ) - { - setmsg_c ( "Input function ID was #; valid range is 0:#. " - "Function ID doesn't correspond to a known " - "passed-in function argument." ); - errint_c ( "#", (SpiceInt) funcID ); - errint_c ( "#", (SpiceInt) SPICE_N_PASSED_IN_FUNC - 1 ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "zzadget_c" ); - - /* - Return an invalid pointer if we can't perform the lookup. - */ - return ( 0 ); - } - - /* - Check-out now since this is a non-void function. - */ - chkout_c ( "zzadget_c" ); - - /* - Return the function pointer as a void pointer. - */ - return ( funcPtrList[ funcID ] ); - - -} /* End zzadget_c */ diff --git a/ext/spice/src/cspice/zzadstep_c.c b/ext/spice/src/cspice/zzadstep_c.c deleted file mode 100644 index 03adf5b350..0000000000 --- a/ext/spice/src/cspice/zzadstep_c.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - --Procedure zzadstep_c ( GF, adapter for step size function ) - --Abstract - - Provide an f2c-style interface allowing f2c'd Fortran - code to call a CSPICE-style GF stepsize function. - --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 - UTILITY - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - #include "SpiceZad.h" - - int zzadstep_c ( doublereal * time, - doublereal * step ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - time I Time from which the next step will be taken. - step O Time step to take. - --Detailed_Input - - time is the input start time from which the algorithm is to - search forward for a state transition. `time' is expressed - as seconds past J2000 TDB. - - --Detailed_Output - - step is the output step size. `step' is the value stored via the - last call to gfsstp_c. Units are TDB seconds. - --Parameters - - None. - --Exceptions - - 1) A run-time error will result if this routine is called before - a valid pointer to a CSPICE-style GF step size function has - been stored via a call to zzadsave_c. - - The argument list of the stored function must match that of - gfstep_c. - --Files - - None. - --Particulars - - This routine is meant to be passed to f2c'd Fortran GF code - that requires a step size function input argument. The argument - list of this routine matches that of the f2c'd routine - - gfstep_ - - This routine calls the CSPICE-style stepsize function passed - into a CSPICE wrapper for an intermediate-level GF function. - A pointer to this step size function must be stored via - a call to zzadsave_c before this routine is called. - - When set properly, `step' indicates how far to advance `time' so - that `time' and `time+step' may bracket a state transition and - definitely do not bracket more than one state transition. - - The calling application can change the step size value via the entry - point gfsstp_c. - --Examples - - None. - --Restrictions - - 1) This function is intended only for internal use by GF routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - W.L. Taber (JPL) - I.M. Underwood (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0, 24-MAR-2008 (NJB) - --Index_Entries - - adapter for gf step size function - - --& -*/ - -{ /* Begin zzadstep_c */ - - - /* - Local variables - */ - void ( * fPtr ) ( SpiceDouble, - SpiceDouble * ); - - - /* - Participate in error tracing. - */ - - if ( return_c() ) - { - return ( 0 ); - } - chkin_c ( "zzadstep_c" ); - - /* - Retrieve the stored pointer for the passed-in function; cast - the pointer from (void *) to that of a function whose argument - list matches that of gfstep_c. - */ - - fPtr = ( void (*) (SpiceDouble, SpiceDouble*) ) zzadget_c ( UDSTEP ); - - /* - Call the stored function. - */ - - (*fPtr) ( (SpiceDouble)(*time), (SpiceDouble *)step ); - - - chkout_c ( "zzadstep_c" ); - - return ( 0 ); - -} /* End zzadstep_c */ diff --git a/ext/spice/src/cspice/zzalloc.c b/ext/spice/src/cspice/zzalloc.c deleted file mode 100644 index e6b2b049a8..0000000000 --- a/ext/spice/src/cspice/zzalloc.c +++ /dev/null @@ -1,1743 +0,0 @@ -/* - --Procedure zzalloc ( Umbrella routine for CSPICE amemory allocation cals ) - --Abstract - - Set of routines to manage allocation and deallocation of memory - for variables used by CSPICE calls. primary usage intended for - interfaces to external languages and applications (IDL, MATLAB, etc. ) - --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 - - error - -*/ - - - /* - Prevent the redefinition of malloc and free in these routines. - Note, this line must preceed all #includes. - */ -#define NO_NEW_ALLOC - -#include -#include -#include -#include -#include "SpiceUsr.h" -#include "zzalloc.h" - - /* - Define 'op' tags for zzalloc_count control. - */ -enum{ ALLOC_INC, /* Increment the count value by +1. */ - ALLOC_DEC, /* Decrement the count value by -1. */ - ALLOC_EQU }; /* Return the current value of count. */ - - -/* - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - Routines coded in this file: - - Private: - - zzalloc_count - - Public: - - alloc_SpiceMemory - alloc_SpiceString_C_array - alloc_SpiceString_C_Copy_array - alloc_SpiceDouble_C_array - alloc_SpiceInt_C_array - alloc_SpiceString - alloc_SpiceString_Pointer_array - free_SpiceString_C_array - free_SpiceMemory - alloc_count - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - CSPICE 1.2.0 02-MAY-2008 (EDW) - - Implemented use of enums as input flags to zzalloc_count. - Added a routine alloc_count function as an accessor to - the allocation count stored in zzalloc_count. - - CSPICE 1.1.0 10-MAY-2007 (EDW) - - Added additional error checks on 'row' and 'cols' arguments in - alloc_SpiceInt_C_array and alloc_SpiceDouble_C_array. - - CSPICE 1.0.10 10-MAY-2007 (EDW) - - Minor edits to clarify declarations and remove unneeded casts. - - Icy 1.0.9 23-JUN-2005 (EDW) - - Added alloc_SpiceString_Pointer_array routine to allocate - an array of pointers to SpiceChars - a more conventional - manner to define an array of strings. - - Edited alloc_SpiceMemory to pass an unsigned int rather than - an int. Added error check for 'op' value in zzalloc_count. - Cast zzalloc_count calls to void when ignoring the return value. - - Defined NO_NEW_ALLOC preprocessor flag to prevent the memory - test malloc/free macros from redefining the calls to C malloc/free - in this routine. Implement the malloc/free macros with: - - #ifndef NO_NEW_ALLOC - - #define malloc(x) alloc_SpiceMemory(x) - #define free(x) free_SpiceMemory(x) - - #endif - - placed as the first directives in SpiceUsr.h. - - Icy 1.0.7 13-JUL-2004 (EDW) - - Added proper header documentation. - --Index_Entries - - None. - --& -*/ - - - - -/* - --Procedure zzalloc_count ( Track number of allocations/deallocations) - --Abstract - - The count increments when allocating memory, the count - decrements when deallocating memory. The routine can also - return the current allocation count. - --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 - - None. - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - None. - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - None. - --Version - - None. - --Index_Entries - - None. - --& -*/ -int zzalloc_count ( int op ) - { - - /* - Initialize the count to zero. Save the value - between calls. - */ - static int count = 0; - - /* - Respond according to the op variable. - */ - switch (op) - { - case ALLOC_INC: - - /* - An allocation, increment the count. - */ - ++count; - - return count; - break; - - - case ALLOC_DEC: - - /* - A free, decrement the count. - */ - --count; - - return count; - break; - - case ALLOC_EQU: - - /* - Return the current count. Should equal zero at end of - program run and NEVER have a negative value. - */ - return count; - break; - - default: - - setmsg_c ( "Unknown op in zzalloc_count: #"); - errint_c ( "#", op ); - sigerr_c ( "SPICE(UNKNOWNOP)" ); - return 0; - break; - - } - - } - - - -/* - --Procedure alloc_SpiceString ( Allocate a string ) - --Abstract - - Allocate a block of memory for a SpiceChar string. Signal an - error if the malloc fails. - --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 - - None. - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - None. - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - None. - --Version - - None. - --Index_Entries - - None. - --& -*/ - -SpiceChar * alloc_SpiceString ( int length ) - { - - SpiceChar * str; - - chkin_c ( "alloc_SpiceString" ); - - /* Allocate the needed memory for the double array. Check for errors. */ - str = (SpiceChar *) alloc_SpiceMemory ( length * sizeof(SpiceChar) ); - - /* - Check for a malloc failure. Signal a SPICE error if error found. - */ - if (str == NULL ) - { - - /* Malloc failed; signal an error; return a NULL. */ - setmsg_c ( "Malloc failed to allocate space for a string of length #. "); - errint_c ( "#", (SpiceInt) length ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "alloc_SpiceString" ); - return NULL; - } - - chkout_c ( "alloc_SpiceString" ); - return str; - } - - - -/* - --Procedure alloc_SpiceInt_C_array ( Allocate an array of SpiceInts) - --Abstract - - Allocate a block of memory for an array of SpiceInts. Signal an - error if the malloc fails. - --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 - - None. - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - None. - --Examples - - None. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - None. - --Version - - None. - --Index_Entries - - None. - --& -*/ -SpiceInt * alloc_SpiceInt_C_array ( int rows, int cols ) - { - - SpiceInt * mat; - - chkin_c ( "alloc_SpiceInt_C_array" ); - - if ( rows*cols < 1 ) - { - setmsg_c ( "The specified total workspace size #1 was " - "less than the minimum allowed value (1). " - "The value for both rows, #2, and cols, #3, " - "must excceed zero." ); - errint_c ( "#1", (SpiceInt) (rows*cols) ); - errint_c ( "#2", (SpiceInt) rows ); - errint_c ( "#3", (SpiceInt) cols ); - sigerr_c ( "SPICE(VALUEOUTOFRANGE)" ); - chkout_c ( "alloc_SpiceInt_C_array" ); - return NULL; - } - - /* - Allocate the needed memory for the double array. Check for errors. - */ - mat = (SpiceInt *) alloc_SpiceMemory ( rows * cols * sizeof(SpiceInt) ); - - /* - Check for a malloc failure. Signal a SPICE error if error found. - */ - if ( mat == NULL ) - { - - /* Malloc failed; signal an error; return a NULL. */ - setmsg_c ( "Malloc failed to allocate space for an array of " - "$1 * $2 SpiceInts. "); - errint_c ( "#", (SpiceInt) rows ); - errint_c ( "#", (SpiceInt) cols ); - sigerr_c ( "SPICE(MALLOCFAILED)" ); - chkout_c ( "alloc_SpiceInt_C_array" ); - return NULL; - } - - chkout_c ( "alloc_SpiceInt_C_array" ); - return mat; - } - - - -/* - --Procedure alloc_SpiceDouble_C_array ( Allocate an array of SpiceDoubles) - --Abstract - - Allocate a block of memory for an array of SpiceDoubles. Signal an - error if the malloc fails. - --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 - - None. - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - The routine allocates a block of contiguous memory then returns a - pointer the block. It does not return an array of pointers or - a pointer to an array of pointers. - --Examples - - SpiceInt n = 2; - SpiceChar * utc[] = { "Jan 1 2006", - "Jan 1 2007" }; - - et = (SpiceDouble*)alloc_SpiceDouble_C_array( 1, n ); - - for( i=0; i 0 && unxcnt == 0 && maccnt == 0) { - -/* Only DOS terminator counter is non-zero. ID the file as DOS. */ - - s_copy(termin, "CR-LF", termin_len, (ftnlen)5); - } else if (doscnt == 0 && unxcnt > 0 && maccnt == 0) { - -/* Only Unix terminator counter is non-zero. ID the file as UNIX. */ - - s_copy(termin, "LF", termin_len, (ftnlen)2); - } else if (doscnt == 0 && unxcnt == 0 && maccnt > 0) { - -/* Only Mac terminator counter is non-zero. ID the file as Mac */ -/* Classic. */ - - s_copy(termin, "CR", termin_len, (ftnlen)2); - } else { - -/* We can get here in two cases. First if the line did not */ -/* contain any CRs or LFs. Second if the line contained more than */ -/* one kind of terminators. In either case the format of the file */ -/* is unclear. */ - - s_copy(termin, "?", termin_len, (ftnlen)1); - } - -/* Close the file. */ - - cl__1.cerr = 0; - cl__1.cunit = number; - cl__1.csta = 0; - f_clos(&cl__1); - -/* If we were told check the terminator against the native one, do */ -/* it. */ - - if (*check) { - -/* If the terminator was identified and does not match the native */ -/* one, error out. */ - - if (! eqstr_(termin, native, termin_len, (ftnlen)5) && ! eqstr_( - termin, "?", termin_len, (ftnlen)1)) { - setmsg_("Text file '$1' contains lines terminated with '$2' whil" - "e the expected terminator for this platform is '$3'. SPI" - "CE cannot process the file in the current form. This pro" - "blem likely occurred because the file was copied in bina" - "ry mode between operating systems where the operating sy" - "stems use different text line terminators. Try convertin" - "g the file to native text form using a utility such as d" - "os2unix or unix2dos.", (ftnlen)411); - errch_("$1", file, (ftnlen)2, file_len); - errch_("$2", termin, (ftnlen)2, termin_len); - errch_("$3", native, (ftnlen)2, (ftnlen)5); - sigerr_("SPICE(INCOMPATIBLEEOL)", (ftnlen)22); - chkout_("ZZASCII", (ftnlen)7); - return 0; - } - } - chkout_("ZZASCII", (ftnlen)7); - return 0; -} /* zzascii_ */ - diff --git a/ext/spice/src/cspice/zzasryel.c b/ext/spice/src/cspice/zzasryel.c deleted file mode 100644 index a1796576de..0000000000 --- a/ext/spice/src/cspice/zzasryel.c +++ /dev/null @@ -1,857 +0,0 @@ -/* zzasryel.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static doublereal c_b26 = -1.; - -/* $Procedure ZZASRYEL ( Angular separation of ray and ellipse ) */ -/* Subroutine */ int zzasryel_(char *extrem, doublereal *ellips, doublereal * - vertex, doublereal *dir, doublereal *angle, doublereal *extpt, ftnlen - extrem_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1, d__2, d__3, d__4; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - double cos(doublereal), sin(doublereal), sqrt(doublereal); - - /* Local variables */ - doublereal diff[3]; - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal udir[3], xoff[3]; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - integer nitr; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ); - doublereal vprj[3], a, b; - integer i__; - doublereal delta; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal udiff[3], acomp, bcomp, asign; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal theta; - logical domin; - doublereal level; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), swapd_( - doublereal *, doublereal *); - doublereal lower; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal upper, newpt; - extern doublereal vnorm_(doublereal *), twopi_(void); - doublereal p2; - extern logical vzero_(doublereal *); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - vprjp_(doublereal *, doublereal *, doublereal *); - doublereal v2[3]; - integer nxpts; - doublereal proxy; - extern /* Subroutine */ int el2cgv_(doublereal *, doublereal *, - doublereal *, doublereal *), vlcom3_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - extern logical failed_(void); - extern /* Subroutine */ int psv2pl_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal gr, eplane[4], center[3], btween; - extern doublereal touchd_(doublereal *); - doublereal smajor[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer extidx; - doublereal sminor[3]; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int inrypl_(doublereal *, doublereal *, - doublereal *, integer *, doublereal *); - doublereal btwprx, extprx; - char exttyp[3]; - doublereal lpt[3]; - integer npt; - doublereal xpt[3]; - -/* $ Abstract */ - -/* Find the minimum or maximum angular separation between a */ -/* specified ray and ellipse. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* ELLIPSOID */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UBEL P Upper bound of SPICELIB ellipse. */ -/* UBPL P Upper bound of SPICELIB plane. */ -/* EXTREM I Type of extremum to find. */ -/* ELLIPS I SPICE ellipse. */ -/* VERTEX, */ -/* DIR I Vertex and direction vector of ray. */ -/* ANGLE O Angular separation of ray and ellipse (radians). */ -/* EXTPT O Point on ellipse where extremum is achieved. */ - -/* $ Detailed_Input */ - -/* EXTREM is a string indicating the type of extremum to */ -/* find. Values are 'MIN' and 'MAX'. Blanks and */ -/* case are not significant. Only the first three */ -/* non-blank characters of EXTREM are significant. */ - - -/* ELLIPS is a SPICELIB ellipse data structure. ELLIPS must */ -/* have non-zero semi-axis lengths. */ - - -/* VERTEX, */ -/* DIR are the vertex and direction vector of a ray in */ -/* three-dimensional space. */ - -/* $ Detailed_Output */ - -/* ANGLE is the specified extremum of angular separation of */ -/* the input ray and the ellipse. This is the */ -/* minimum or maximum angular separation of the ray */ -/* and any line segment extending from the ray's */ -/* vertex to a point on the surface of the ellipse. */ -/* Units are radians. */ - -/* If the input ray actually intersects the plane */ -/* region bounded by the ellipse, ANGLE is set to a */ -/* non-positive value whose magnitude is the minimum */ -/* or maximum angular separation of the input ray and */ -/* the ellipse. */ - - -/* EXTPT is the point on the ellipse where the specified */ -/* extreme value of the angular separation is */ -/* achieved. If there are multiple points where the */ -/* extremum is achieved, any such point may be */ -/* selected. */ - -/* $ Parameters */ - -/* UBEL is the upper bound of a SPICELIB ellipse data */ -/* structure. */ - -/* UBPL is the upper bound of a SPICELIB plane data */ -/* structure. */ - -/* $ Exceptions */ - -/* 1) If the length of any semi-axis of the ellipse is */ -/* non-positive, the error SPICE(INVALIDAXISLENGTH) is */ -/* signaled. ANGLE and EXTPT are not modified. */ - -/* 2) If VERTEX lies in the plane of the ellipse, the error */ -/* SPICE(DEGENERATECASE) is signaled. ANGLE and EXTPT are not */ -/* modified. */ - -/* 3) If DIR is the zero vector, the error SPICE(ZEROVECTOR) is */ -/* signaled. ANGLE and EXTPT are not modified. */ - -/* 4) If EXTREM contains an unrecognized value, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Definition */ -/* ========== */ - -/* The minimum or maximum angular separation of a ray and ellipse is */ -/* the minimum or maximum, taken over all points on the ellipse, of */ -/* the angular separation of the ray and the vector from the ray's */ -/* vertex to a point on the ellipse. */ - -/* Uniqueness or multiplicity of minima */ -/* ==================================== */ - -/* Let's presume that the ray does not intersect the plane region */ -/* bounded by the ellipse. If the ray's vertex does not lie in the */ -/* plane of the ellipse, the uniqueness of the minimizing point can */ -/* be verified by observing that the right circular cone of minimum */ -/* angular extent whose axis is the ray, and that is tangent to the */ -/* ellipse, will be tangent at the minimizing point and no other. */ -/* If the ray's vertex does lie in the plane of the ellipse, there */ -/* can be multiple tangency points. */ - -/* If the ray intersects the plane region bounded by the ellipse, */ -/* there may be multiple absolute minima of the angular separation. */ -/* Consider the case where the ellipse is a circular cross section */ -/* of a right circular cone, and the ray is the cone's axis: there */ -/* is an infinite set of solutions, since the minimum angular */ -/* separation is achieved at every point on the circle. */ - - -/* Uniqueness or multiplicity of maxima */ -/* ==================================== */ - -/* Let's presume that the ray does not intersect the plane region */ -/* bounded by the ellipse. If the ray's vertex does not lie in the */ -/* plane of the ellipse, one observes that the right circular cone */ -/* of maximum angular extent whose axis is the ray, and that is */ -/* tangent to the ellipse, can still easily be tangent to the */ -/* ellipse at multiple points (consider an ellipse whose shape is */ -/* "almost" a line segment). The ray's vertex need not lie in the */ -/* plane of the ellipse for multiple tangency points to exist. */ - -/* If the ray intersects the plane region bounded by the ellipse, */ -/* there may be multiple absolute maxima of the angular separation. */ - - -/* Extremum of angular separation versus distance */ -/* ============================================== */ - -/* Note the point on the ellipse having minimum angular separation */ -/* from a ray is NOT necessarily the closest point on the ellipse to */ -/* the ray. You can verify this by considering the case of an */ -/* extremely eccentric ellipse and a ray that passes above it. The */ -/* diagram below illustrates this situation. The series of three */ -/* asterisks rising from left to right represents the ray; the other */ -/* asterisks represent the ellipse. The point `c' is the closest */ -/* point on the ellipse to the ray; the point `m' has the minimum */ -/* angular separation from the ray. */ - -/* The analoguous distinction applies to maximum angular separation */ -/* and maximum distance: compare the points labeled 'M' and 'F' */ -/* in the diagram below. */ - - - -/* * */ -/* (ray) */ -/* * */ -/* ray's vertex (ray) */ -/* * */ - - -/* closest ellipse ----> c * * * * * * * * m <-- point of minimum */ -/* point to the ray * * angular */ -/* M * * * * * * * * F separation */ - -/* ^ ^ */ -/* point of maximum angular farthest ellipse */ -/* separation point from ray */ - - - - -/* Applications */ -/* ============ */ - -/* This subroutine can be used to: */ - -/* - measure the angular separation of */ -/* an instrument boresight from a body's limb */ - -/* - test for visibility of an ellipsoidal body within an */ -/* circular field of view (or, with more work, an elliptical */ -/* field of view) */ - -/* - test for occultation of one ellipsoidal body by another */ - -/* - support tests for intersection of an ellipsoidal body with */ -/* an umbral or penumbral shadow cast by another ellipsoidal */ -/* body blocking an ellipsoidal light source. */ - -/* $ Examples */ - -/* 1) An example that can be readily checked by hand computation. */ - -/* Let */ - -/* A = 1 */ -/* B = 1 */ -/* C = 1 */ - -/* V = ( 2, 0, 0 ) */ -/* D = ( -1, 0, SQRT(3) ) */ - -/* The limb of the sphere as seen from the ray's vertex will */ -/* be the circle centered at ( .5, 0, 0 ), parallel to the */ -/* y-z plane, with radius SQRT(3)/2. The ray lies in the */ -/* x-z plane and passes over the ellipse, so the limb point */ -/* of minimum angular separation should be the highest point */ -/* on the limb. This would be the point */ - -/* ( .5, 0, SQRT(3)/2 ). */ - -/* The tangent segment extending from the ray's vertex to the */ -/* point of mimimum angular separation makes an angle of */ -/* 30 degrees with the x-axis, and the ray makes angle of 60 */ -/* degrees with the x-axis, so the angular separation of the */ -/* ray and the limb should be 30 degrees. */ - -/* For a ray have the same vertex but pointing in the -x */ -/* direction, the minimum point can be anywhere on the limb, */ -/* but the angle should be -30 degrees. */ - -/* If the vertex is raised slightly (that is, the z-component */ -/* is increased slightly) and the ray points in the -x */ -/* direction, the mimimum point should be at the top of the */ -/* limb, and the angle should be a negative value with */ -/* magnitude slightly less than 30 degrees. */ - -/* The program below should verify these results. */ - - -/* PROGRAM MINANG */ -/* IMPLICIT NONE */ - -/* INTEGER UBEL */ -/* PARAMETER ( UBEL = 9 ) */ - -/* DOUBLE PRECISION DPR */ - -/* DOUBLE PRECISION V(3) */ -/* DOUBLE PRECISION D(3) */ -/* DOUBLE PRECISION A */ -/* DOUBLE PRECISION B */ -/* DOUBLE PRECISION C */ -/* DOUBLE PRECISION ANGLE */ -/* DOUBLE PRECISION LIMB ( UBEL ) */ -/* DOUBLE PRECISION EXTPT ( 3 ) */ - -/* V(1) = 2.D0 */ -/* V(2) = 0.D0 */ -/* V(3) = 0.D0 */ - -/* D(1) = -1.D0 */ -/* D(2) = 0.D0 */ -/* D(3) = SQRT( 3.D0 ) */ - -/* A = 1.D0 */ -/* B = 1.D0 */ -/* C = 1.D0 */ - -/* CALL EDLIMB ( A, B, C, V, LIMB ) */ - -/* CALL ZZASRYEL ( 'MIN', LIMB, V, D, ANGLE, EXTPT ) */ - -/* PRINT *, ' ' */ -/* PRINT *, 'Angle is' */ -/* PRINT *, DPR() * ANGLE */ -/* PRINT *, 'Point of mimimum separation is' */ -/* PRINT *, EXTPT */ - -/* C */ -/* C Now take the ray along the x-axis, */ -/* C pointing in the -x direction. */ -/* C */ -/* D(1) = -1.D0 */ -/* D(2) = 0.D0 */ -/* D(3) = 0.D0 */ - -/* CALL ZZASRYEL ( 'MIN', LIMB, V, D, ANGLE, EXTPT ) */ - -/* PRINT *, ' ' */ -/* PRINT *, 'Angle is' */ -/* PRINT *, DPR() * ANGLE */ -/* PRINT *, 'Point of mimimum separation is' */ -/* PRINT *, EXTPT */ - -/* C */ -/* C Raise the vertex a bit and repeat. */ -/* C */ -/* V(1) = 2.D0 */ -/* V(2) = 0.D0 */ -/* V(3) = 1.D-6 */ - -/* CALL ZZASRYEL ( 'MIN', LIMB, V, D, ANGLE, EXTPT ) */ - -/* PRINT *, ' ' */ -/* PRINT *, 'Angle is' */ -/* PRINT *, DPR() * ANGLE */ -/* PRINT *, 'Point of mimimum separation is' */ -/* PRINT *, EXTPT */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) Under some unusual geometric conditions, the search used */ -/* in this algorithm may find a relative extremum which is not */ -/* an absolute extremum. This can occur if there are two local */ -/* extrema of separation (both minima or both maxima) */ -/* located less than (2*pi/20) apart in the parameter domain for */ -/* the ellipse's limb, where the limb is parameterized as */ - -/* CENTER + cos(theta)*SMAJOR + sin(theta)*SMINOR, */ - -/* 0 <= theta <= 2*pi */ - -/* and */ - -/* CENTER is the center of the limb */ -/* SMAJOR is a semi-major axis vector of the limb */ -/* SMINOR is a semi-minor axis vector of the limb */ - -/* The search can also fail to find an absolute extremum in cases */ -/* where there are two extrema (both minima or both maxima) that */ -/* are distant but very close to equal in terms of angular */ -/* separation from the input ray. */ - - -/* 2) The point at which the minimum or maximum angular separation */ -/* occurs is determined to single precision. Specifically, the */ -/* angular parameter THETA defining the location relative to the */ -/* semi-axes is determined at the single precision level. */ - - -/* $ Literature_References */ - -/* [1] "Numerical Recipes -- The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* Willam T. Vetterling. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.1.0, 14-NOV-2006 (NJB) */ - -/* The parameter NPT has been replaced by two different */ -/* parameters: one for the exterior minimum case and one for the */ -/* complementary cases. This change was made to improve accuracy. */ - -/* - SPICELIB Version 1.0.0, 07-SEP-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation of ray and ellipse */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Tolerance used for loop convergence. This tolerance applies */ -/* to the angular parameter used to specify points on the ellipse. */ - - -/* Number of steps used to search the ellipse for region containing */ -/* the point of extreme angular separation. We use two different */ -/* values: one for the outer minimum case, which is mathematically */ -/* well behaved, and one for the other cases. */ - - -/* Maximum number of loop iterations allowed for extremum search. */ - - -/* Code returned in INRYPL indicating ray lies in plane. */ - - -/* String length for extremum specifier. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZASRYEL", (ftnlen)8); - } - -/* Decide whether we're looking for a minimum or maximum. */ - - cmprss_(" ", &c__0, extrem, exttyp, (ftnlen)1, extrem_len, (ftnlen)3); - ljust_(exttyp, exttyp, (ftnlen)3, (ftnlen)3); - if (s_cmp(exttyp, "MIN", (ftnlen)3, (ftnlen)3) == 0) { - domin = TRUE_; - } else if (s_cmp(exttyp, "MAX", (ftnlen)3, (ftnlen)3) == 0) { - domin = FALSE_; - } else { - setmsg_("Extremum specifier # was not recognized.", (ftnlen)40); - errch_("#", extrem, (ftnlen)1, extrem_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZASRYEL", (ftnlen)8); - return 0; - } - -/* Get the center and semi-axes of the ellipse. */ - - el2cgv_(ellips, center, smajor, sminor); - -/* The ellipse semi-axes must have positive length. */ - - a = vnorm_(smajor); - b = vnorm_(sminor); - if (vzero_(smajor) || vzero_(sminor)) { - setmsg_("Semi-axis lengths: A = #, B = #.", (ftnlen)33); - errdp_("#", &a, (ftnlen)1); - errdp_("#", &b, (ftnlen)1); - sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24); - chkout_("ZZASRYEL", (ftnlen)8); - return 0; - } - -/* Find the plane of the ellipse. */ - - psv2pl_(center, smajor, sminor, eplane); - if (failed_()) { - chkout_("ZZASRYEL", (ftnlen)8); - return 0; - } - -/* The ray's direction vector must be non-zero. */ - - if (vzero_(dir)) { - setmsg_("Ray's direction vector must be non-zero.", (ftnlen)40); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("ZZASRYEL", (ftnlen)8); - return 0; - } - -/* The ray's vertex must not lie in the plane of the ellipse. */ -/* The orthogonal projection of the point onto the plane should */ -/* yield a distinct vector. */ - - vprjp_(vertex, eplane, vprj); - if (vdist_(vertex, vprj) == 0.) { - setmsg_("Viewing point is in the plane of the ellipse.", (ftnlen)45); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZASRYEL", (ftnlen)8); - return 0; - } - -/* See whether the ray intersects the plane region bounded by the */ -/* ellipse. If it does, set the limb angle sign to -1. Otherwise */ -/* the sign is +1. */ - -/* First, find the intersection of the ray and plane. */ - - inrypl_(vertex, dir, eplane, &nxpts, xpt); - if (nxpts == -1) { - -/* We don't expect to hit this case since we've already tested */ -/* for the vertex lying in the ellipse plane. However, */ -/* variations in round-off error make this case possible though */ -/* unlikely. */ - - setmsg_("Ray lies in the plane of the ellipse.", (ftnlen)37); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZASRYEL", (ftnlen)8); - return 0; - } - -/* Give NPT an initial value. */ - - npt = 400; - if (nxpts == 0) { - -/* The ray does not intersect the plane. */ - - asign = 1.; - } else { - -/* The ray intersects the plane. We must determine if the */ -/* ray intersects the region bounded by the ellipse. */ - -/* Find the coordinates of the intersection point in a frame */ -/* aligned with the axes of the ellipse and centered at */ -/* the ellipse's center. */ - - vsub_(xpt, center, xoff); - acomp = vdot_(xoff, smajor) / a; - bcomp = vdot_(xoff, sminor) / b; - -/* Now find the "level curve parameter" LEVEL for the offset of */ -/* the intersection point from the ellipse's center. */ - -/* Computing 2nd power */ - d__1 = acomp; -/* Computing 2nd power */ - d__2 = a; -/* Computing 2nd power */ - d__3 = bcomp; -/* Computing 2nd power */ - d__4 = b; - level = d__1 * d__1 / (d__2 * d__2) + d__3 * d__3 / (d__4 * d__4); - if (level <= 1.) { - -/* The ray-plane intersection is on the ellipse or inside the */ -/* plane region bounded by the ellipse. */ - - asign = -1.; - } else { - asign = 1.; - if (domin) { - -/* We have the exterior minimum case: the ray doesn't */ -/* penetrate the plane region bounded by the ellipse, */ -/* and we're looking for an absolute minimum of angular */ -/* separation. We can use a fairly small number of test */ -/* points on the limb and still find the location of */ -/* minimum angular separation. */ - - npt = 320; - } - } - } - -/* ASIGN has been set. */ - - -/* The limb is the set of points */ - -/* CENTER + cos(theta) SMAJOR + sin(theta) SMINOR */ - -/* where theta is in the interval (-pi, pi]. */ - -/* We want to find the value of `theta' for which the angular */ -/* separation of ray and ellipse is minimized (or maximized). To */ -/* improve efficiency, instead of working with angular separation, */ -/* we'll find the extremum of a proxy function: the distance */ -/* between the unit ray direction vector and the unit vector in the */ -/* direction from the ray's vertex to a selected point on the */ -/* ellipse. This function doesn't require an arcsine evaluation, */ -/* and its extrema occur at the same locations as the extrema of the */ -/* angular separation. */ - -/* We'll compute the proxy value for the angular separation of the */ -/* ray and limb at NPT different points on the limb, where the */ -/* points are generated by taking equally spaced values of theta. */ -/* We'll find the extremum of the proxy function on this set of */ -/* points, and then search for the absolute extremum. */ - -/* To make our computations more efficient, we'll subtract off */ -/* the ellipse's center from the vertex position to obtain a */ -/* translated ellipse centered at the origin. */ - - vsub_(vertex, center, v2); - if (domin) { - extprx = 2.; - } else { - extprx = 0.; - } - extidx = 0; - p2 = twopi_(); - delta = p2 / npt; - vhat_(dir, udir); - i__1 = npt - 1; - for (i__ = 0; i__ <= i__1; ++i__) { - theta = i__ * delta; - d__1 = cos(theta); - d__2 = sin(theta); - vlcom3_(&c_b26, v2, &d__1, smajor, &d__2, sminor, diff); - vhat_(diff, udiff); - proxy = vdist_(udiff, udir); - if (domin) { - if (proxy < extprx) { - extidx = i__; - extprx = proxy; - } - } else { - if (proxy > extprx) { - extidx = i__; - extprx = proxy; - } - } - } - -/* The extreme value of the proxy function is EXTPRX, and was */ -/* obtained at the test point indexed by EXTIDX. We find the values */ -/* of the proxy function at the neighboring points and perform a */ -/* `golden section' search. */ - -/* In the following section of code, */ - -/* LOWER is the lower bound of the interval in which */ -/* the extremum is bracketed. */ - -/* UPPER is the upper bound of the interval in which */ -/* the extremum is bracketed. */ - -/* BTWEEN is a point between LOWER and UPPER. The proxy */ -/* function value corresponding to the angle */ -/* BTWEEN is less than the proxy function value */ -/* corresponding to LOWER and UPPER. */ - -/* NEWPT is a point between LOWER and UPPER such that */ -/* ___ */ -/* BTWEEN - LOWER 3 - \/ 5 */ -/* -------------- = GR = ------------ */ -/* UPPER - LOWER 2 */ - - - gr = (3. - sqrt(5.)) / 2.; - lower = p2 / npt * (extidx - 1); - upper = p2 / npt * (extidx + 1); - -/* We're going to move LOWER and UPPER closer together at each */ -/* iteration of the following loop, thus trapping the extremum. The */ -/* invariant condition that we will maintain is that the proxy value */ -/* corresponding to the angle BTWEEN is less (or more) than the proxy */ -/* value for the limb points corresponding to LOWER and UPPER. */ - -/* The loop terminates when the offset by which we adjust LOWER or */ -/* UPPER is smaller than our tolerance value. This offset is no */ -/* larger than the difference between LOWER and BTWEEN. */ - - btween = p2 / npt * extidx; - -/* We'll give the names LOWPRX and UPRPRX to the proxy function */ -/* values at the limb points corresponding to LOWER and UPPER, */ -/* respectively. We don't actually have to evaluate these values, */ -/* however. They are useful for understanding the minimization */ -/* algorithm we'll use, but are not actually used in the code. */ - -/* We already know that the proxy function value corresponding to */ -/* BTWEEN is EXTPRX; this was computed above. */ - - btwprx = extprx; - -/* Before starting our loop, we're going to shift all of our angles */ -/* by 2*pi, so that they're bounded away from zero. */ - - lower += p2; - upper += p2; - btween += p2; - nitr = 0; - proxy = 3.; - for(;;) { /* while(complicated condition) */ - d__1 = upper - lower; - if (!(nitr <= 100 && touchd_(&d__1) > 1e-9)) - break; - -/* At this point, the following order relations hold: */ - -/* LOWER < BTWEEN < UPPER */ -/* - - */ - -/* BTWPRX < MIN ( LOWPRX, UPRPRX ) */ -/* - */ - -/* Compute NEWPT. This point is always located at the fraction */ -/* GR of the way into the larger of the intervals */ -/* [ LOWER, BTWEEN ] and [ BTWEEN, UPPER ]. */ - - - if (btween - lower > upper - btween) { - newpt = lower + gr * (btween - lower); - } else { - newpt = btween + gr * (upper - btween); - } - -/* We are going to shorten our interval by changing LOWER to */ -/* NEWPT or UPPER to BTWEEN, and if necessary, BTWEEN to NEWPT, */ -/* while maintaining the order relations of UPPER, LOWER, and */ -/* BTWEEN, and also the order relations of UPRPRX, LOWPRX, and */ -/* BTWPRX. To do this, we need the proxy function value at */ -/* NEWPT. */ - - d__1 = cos(newpt); - d__2 = sin(newpt); - vlcom3_(&c_b26, v2, &d__1, smajor, &d__2, sminor, diff); - vhat_(diff, udiff); - proxy = vdist_(udiff, udir); - -/* Swap NEWPT and BTWEEN if necessary, to ensure that */ - -/* NEWPT < BTWEEN. */ -/* _ */ - - if (newpt > btween) { - swapd_(&btween, &newpt); - swapd_(&btwprx, &proxy); - } - if (domin) { - if (proxy > btwprx) { - lower = newpt; - } else { - upper = btween; - btween = newpt; - btwprx = proxy; - } - } else { - if (proxy < btwprx) { - lower = newpt; - } else { - upper = btween; - btween = newpt; - btwprx = proxy; - } - } - ++nitr; - } - -/* At this point, LPT is a good estimate of the limb point at which */ -/* the extremum of the angular separation from the ray occurs. */ - - vadd_(diff, v2, lpt); - -/* Add the center back to LPT to find EXTPT on the original ellipse. */ - - vadd_(center, lpt, extpt); - -/* Set the angular separation at EXTPT. */ - - *angle = vsep_(diff, udir) * asign; - chkout_("ZZASRYEL", (ftnlen)8); - return 0; -} /* zzasryel_ */ - diff --git a/ext/spice/src/cspice/zzbodblt.c b/ext/spice/src/cspice/zzbodblt.c deleted file mode 100644 index 27d7a68b73..0000000000 --- a/ext/spice/src/cspice/zzbodblt.c +++ /dev/null @@ -1,943 +0,0 @@ -/* zzbodblt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__563 = 563; -static integer c__2 = 2; -static integer c__3 = 3; - -/* $Procedure ZZBODBLT ( Private --- Retrieve Built-In Body-Code Maps ) */ -/* Subroutine */ int zzbodblt_0_(int n__, integer *room, char *names, char * - nornam, integer *codes, integer *nvals, char *device, char *reqst, - ftnlen names_len, ftnlen nornam_len, ftnlen device_len, ftnlen - reqst_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2], a__2[3]; - integer i__1, i__2, i__3[2], i__4[3]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), movec_(char *, integer *, char *, ftnlen, - ftnlen), movei_(integer *, integer *, integer *); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char zzint[36]; - static integer bltcod[563]; - static char bltnam[36*563]; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int orderi_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - static char bltnor[36*563]; - extern /* Subroutine */ int wrline_(char *, char *, ftnlen, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), - cmprss_(char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen) - ; - integer zzocod[563]; - char zzline[75]; - integer zzonam[563]; - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - char zzrqst[4]; - extern /* Subroutine */ int zzidmap_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the umbrella routine that contains entry points to */ -/* access the built-in body name-code mappings. */ - -/* $ 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 */ - -/* BODY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ROOM I ZZBODGET */ -/* NAMES O ZZBODGET */ -/* NORNAM O ZZBODGET */ -/* CODES O ZZBODGET */ -/* NVALS O ZZBODGET */ -/* DEVICE I ZZBODLST */ -/* REQST I ZZBODLST */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Parameters */ - -/* See the include file 'zzbodtrn.inc' for the list of parameters */ -/* this routine utilizes. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(BOGUSENTRY) is signaled if ZZBODBLT is */ -/* called directly. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ZZBODBLT should never be called directly, instead access */ -/* the entry points: */ - -/* ZZBODGET Fetch the built-in body name/code list. */ - -/* ZZBODLST Output the name-ID mapping list. */ - -/* $ Examples */ - -/* See ZZBODTRN and its entry points for details. */ - -/* $ Restrictions */ - -/* 1) No duplicate entries should appear in the built-in */ -/* BLTNAM list. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.3.1, 27-FEB-2007 (EDW) */ - -/* Completed the ZZBODLST decalrations section. */ - -/* - SPICELIB Version 2.3.0, 17-MAR-2003 (EDW) */ - -/* Added a call to ZZIDMAP to retrieve the default */ -/* mapping list. "zzbodtrn.inc" no longer */ -/* contains the default mapping list. */ - -/* - SPICELIB Version 2.2.0 21-FEB-2003 (BVS) */ - -/* Changed MER-A and MER-B to MER-1 and MER-2. */ - -/* - SPICELIB Version 2.1.0 04-DEC-2002 (EDW) */ - -/* Added new assignments to the default collection: */ - -/* -226 ROSETTA */ -/* 517 CALLIRRHOE */ -/* 518 THEMISTO */ -/* 519 MAGACLITE */ -/* 520 TAYGETE */ -/* 521 CHALDENE */ -/* 522 HARPALYKE */ -/* 523 KALYKE */ -/* 524 IOCASTE */ -/* 525 ERINOME */ -/* 526 ISONOE */ -/* 527 PRAXIDIKE */ - -/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ - -/* Initial release. This begins at Version 2.0.0 because */ -/* the entry point ZZBODLST was cut out of ZZBODTRN and */ -/* placed here at Version 1.0.0. */ -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ - -/* The entries following this one were copied from */ -/* the version section of ZZBODTRN. SPICELIB has */ -/* been changed to ZZBODTRN for convenience in noting */ -/* version information relevant for that module. */ - -/* This was done to carry the history of body name-code */ -/* additions with this new umbrella. */ - -/* Added to the collection: */ -/* -236 MESSENGER */ - -/* - ZZBODTRN Version 3.2.0, 14-AUG-2002 (EDW) */ - -/* Added the ZZBODKIK entry point. */ - -/* Moved the NAIF_BODY_NAME/CODE to subroutine */ -/* ZZBODKER. No change in logic. */ - -/* Added logic to enforce the precedence masking; */ -/* logic removes duplicate assignments of ZZBODDEF. */ -/* Removed the NAMENOTUNIQUE error block. */ - -/* - ZZBODTRN Version 3.1.5, 27-NOV-2001 (EDW) */ - -/* Added to the collection: */ -/* -200 CONTOUR */ -/* -146 LUNAR-A */ -/* -135 DRTS-W */ - -/* Added the subroutine ZZBODLST as an entry point. */ -/* The routine outputs the current name-ID mapping */ -/* list to some output device. */ - -/* - ZZBODTRN Version 3.1.0, 17-OCT-2001 (EDW) */ - -/* To improve clarity, the BEGXX block initialization now */ -/* exists in the include file zzbodtrn.inc. */ - -/* Removed the comments concerning the 851, 852, ... temporary */ -/* codes. */ - -/* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */ -/* as a DATA statement. */ - -/* Edited headers to match information in naif_ids required */ -/* reading. */ - -/* Edited headers, removed typos and bad grammar, clarified */ -/* descriptions. */ - -/* Added to the collection */ -/* -41 MARS EXPRESS, MEX */ -/* -44 BEAGLE 2, BEAGLE2 */ -/* -70 DEEP IMPACT IMPACTOR SPACECRAFT */ -/* -94 MO, MARS OBSERVER */ -/* -140 DEEP IMPACT FLYBY SPACECRAFT */ -/* -172 SLCOMB, STARLIGHT COMBINER */ -/* -205 SLCOLL, STARLIGHT COLLECTOR */ -/* -253 MER-A */ -/* -254 MER-B */ - -/* Corrected typo, vehicle -188 should properly be MUSES-C, */ -/* previous versions listed the name as MUSES-B. */ - -/* Removed from collection */ -/* -84 MARS SURVEYOR 01 LANDER */ -/* -154 EOS-PM1 */ -/* -200 PLUTO EXPRESS 1, PEX1 */ -/* -202 PLUTO EXPRESS 2, PEX2 */ - -/* - ZZBODTRN Version 3.0.0, 29-MAR-2000 (WLT) */ - -/* The ID codes for Cluster 1, 2, 3 and 4 were added. The */ -/* ID coded for Pluto Express were removed. The ID codes */ -/* for Pluto-Kuiper Express, Pluto-Kuiper Express Simulation */ -/* and Contour were added. */ - -/* - ZZBODTRN Version 2.0.0, 26-JAN-1998 (EDW) */ - -/* The Galileo probe ID -228 replaces the incorrect ID -344. */ -/* DSS stations 5 through 65 added to the collection. */ - -/* Added to the collection */ -/* -107 TROPICAL RAINFALL MEASURING MISSION, TRMM */ -/* -154, EOS-PM1 */ -/* -142 EOS-AM1 */ -/* -151 AXAF */ -/* -1 GEOTAIL */ -/* -13 POLAR */ -/* -21 SOHO */ -/* -8 WIND */ -/* -25 LUNAR PROSPECTOR, LPM */ -/* -116 MARS POLAR LANDER, MPL */ -/* -127 MARS CLIMATE ORBITER, MCO */ -/* -188 MUSES-C */ -/* -97 TOPEX/POSEIDON */ -/* -6 PIONEER-6, P6 */ -/* -7 PIONEER-7, P7 */ -/* -20 PIONEER-8, P8 */ -/* -23 PIONEER-10, P10 */ -/* -24 PIONEER-11, P11 */ -/* -178 NOZOMI, PLANET-B */ -/* -79 SPACE INFRARED TELESCOPE FACILITY, SIRTF */ -/* -29 STARDUST, SDU */ -/* -47 GENESIS */ -/* -48 HUBBLE SPACE TELESCOPE, HST */ -/* -200 PLUTO EXPRESS 1, PEX1 */ -/* -202 PLUTO EXPRESS 2, PEX2 */ -/* -164 YOHKOH, SOLAR-A */ -/* -165 MAP */ -/* -166 IMAGE */ -/* -53 MARS SURVEYOR 01 ORBITER */ -/* 618 PAN */ -/* 716 CALIBAN */ -/* 717 SYCORAX */ -/* -30 DS-1 (low priority) */ -/* -58 HALCA */ -/* -150 HUYGEN PROBE, CASP */ -/* -55 ULS */ - -/* Modified ZZBODC2N and ZZBODN2C so the user may load an */ -/* external IDs kernel to override or supplement the standard */ -/* collection. The kernel must be loaded prior a call to */ -/* ZZBODC2N or ZZBODN2C. */ - -/* - ZZBODTRN Version 1.1.0, 22-MAY-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp, */ -/* Mars 96, Cassini Simulation, MGS Simulation. */ - -/* - ZZBODTRN Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed umbrella subroutine and entry points to */ -/* correspond private routine convention (ZZ...). Added IDs for */ -/* tracking stations Goldstone (399001), Canberra (399002), */ -/* Madrid (399003), Usuda (399004). */ - -/* - ZZBODTRN Version 2.2.0, 01-AUG-1995 (HAN) */ - -/* Added the IDs for Near Earth Asteroid Rendezvous (-93), */ -/* Mars Pathfinder (-53), Ulysses (-55), VSOP (-58), */ -/* Radioastron (-59), Cassini spacecraft (-82), and Cassini */ -/* Huygens probe (-150). */ -/* Mars Observer (-94) was replaced with Mars Global */ -/* Surveyor (-94). */ - -/* - ZZBODTRN Version 2.1.0, 15-MAR-1995 (KSZ) (HAN) */ - -/* Two Shoemaker Levy 9 fragments were added, Q1 and P2 */ -/* (IDs 50000022 and 50000023). Two asteroids were added, */ -/* Eros and Mathilde (IDs 2000433 and 2000253). The */ -/* Saturnian satellite Pan (ID 618) was added. */ - -/* - ZZBODTRN Version 2.0.0, 03-FEB-1995 (NJB) */ - -/* The Galileo probe (ID -344) has been added to the permanent */ -/* collection. */ - -/* - ZZBODTRN Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. Also, */ -/* this version does not support reading body name ID pairs from a */ -/* file. */ - -/* - ZZBODTRN Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - ZZBODTRN Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - ZZBODTRN Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Some items previously considered errors were removed */ -/* and some minor modifications were made to improve the */ -/* robustness of the routines. */ - -/* - ZZBODTRN Version 1.0.0, 28-JUN-1990 (JEM) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - /* Parameter adjustments */ - if (names) { - } - if (nornam) { - } - if (codes) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzbodget; - case 2: goto L_zzbodlst; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODBLT", (ftnlen)8); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZBODBLT", (ftnlen)8); - } - return 0; -/* $Procedure ZZBODGET ( Private --- Body-Code Get Built-In List ) */ - -L_zzbodget: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Retrieve a copy of the built-in body name-code mapping lists. */ - -/* $ 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 */ - -/* PRIVATE */ -/* BODY */ - -/* $ Declarations */ - -/* INTEGER ROOM */ -/* CHARACTER*(*) NAMES ( * ) */ -/* CHARACTER*(*) NORNAM ( * ) */ -/* INTEGER CODES ( * ) */ -/* INTEGER NVALS */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ROOM I Space available in NAMES, NORNAM, and CODES. */ -/* NAMES O Array of built-in body names. */ -/* NORNAM O Array of normalized built-in body names. */ -/* CODES O Array of built-in ID codes for NAMES/NORNAM. */ -/* NVALS O Length of NAMES, NORNAM, CODES, and ORDNOM arrays. */ - -/* $ Detailed_Input */ - -/* ROOM is the maximum number of entries that NAMES, NORNAM, */ -/* and CODES may receive. */ - -/* $ Detailed_Output */ - -/* NAMES the array of built-in names. This array is parallel */ -/* to NORNAM and CODES. */ - -/* NORNAM the array of normalized built-in body names. This */ -/* array is computed from the NAMES array by compressing */ -/* groups of spaces into a single space, left-justifying */ -/* the name, and uppercasing the letters. */ - -/* CODES the array of built-in codes associated with NAMES */ -/* and NORNAM entries. */ - -/* NVALS the number of items returned in NAMES, NORNAM, */ -/* and CODES. */ - -/* $ Parameters */ - -/* NPERM the number of permanent, or built-in, body name-code */ -/* mappings. */ - -/* $ Exceptions */ - -/* 1) SPICE(BUG) is signaled if ROOM is less than NPERM, the */ -/* amount of space required to store the entire list of */ -/* body names and codes. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simply copies it's local buffered version of the */ -/* built-in name-code mappings to the output arguments. */ - -/* $ Examples */ - -/* See ZZBODTRN for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 17-MAR-2003 (EDW) */ - -/* Added a call to ZZIDMAP to retrieve the default */ -/* mapping list. "zzbodtrn.inc" no longer */ -/* contains the default mapping list. */ - -/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODGET", (ftnlen)8); - } - -/* On the first invocation compute the normalized forms of BLTNAM */ -/* and store them in BLTNOR. */ - - if (first) { - -/* Retrieve the default mapping list. */ - - zzidmap_(bltcod, bltnam, (ftnlen)36); - for (i__ = 1; i__ <= 563; ++i__) { - ljust_(bltnam + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : - s_rnge("bltnam", i__1, "zzbodblt_", (ftnlen)565)) * 36, - bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 : - s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)565)) * 36, ( - ftnlen)36, (ftnlen)36); - ucase_(bltnor + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : - s_rnge("bltnor", i__1, "zzbodblt_", (ftnlen)566)) * 36, - bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 : - s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)566)) * 36, ( - ftnlen)36, (ftnlen)36); - cmprss_(" ", &c__1, bltnor + ((i__1 = i__ - 1) < 563 && 0 <= i__1 - ? i__1 : s_rnge("bltnor", i__1, "zzbodblt_", (ftnlen)567)) - * 36, bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? - i__2 : s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)567)) * - 36, (ftnlen)1, (ftnlen)36, (ftnlen)36); - } - -/* Do not do this again. */ - - first = FALSE_; - } - -/* Copy the contents of BLTNAM, BLTNOR, and BLTCOD to the output */ -/* arguments, but only if there is sufficient room. */ - - if (*room < 563) { - setmsg_("Insufficient room to copy the stored body name-code mapping" - "s to the output arguments. Space required is #, but the cal" - "ler supplied #.", (ftnlen)134); - errint_("#", &c__563, (ftnlen)1); - errint_("#", room, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZBODGET", (ftnlen)8); - return 0; - } - movec_(bltnam, &c__563, names, (ftnlen)36, names_len); - movec_(bltnor, &c__563, nornam, (ftnlen)36, nornam_len); - movei_(bltcod, &c__563, codes); - *nvals = 563; - chkout_("ZZBODGET", (ftnlen)8); - return 0; -/* $Procedure ZZBODLST ( Output permanent collection to some device. ) */ - -L_zzbodlst: -/* $ Abstract */ - -/* Output the complete list of built-in body/ID mappings to */ -/* some output devide. Thw routine generates 2 lists: one */ -/* sorted by ID number, one sorted by name. */ - -/* $ 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 */ - -/* BODY */ - -/* $ Declarations */ - -/* CHARACTER*(*) DEVICE */ -/* CHARACTER*(*) REQST */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* DEVICE I Device name to receive the output. */ -/* REQST I Data list name to output. */ - -/* $ Detailed_Input */ - -/* DEVICE identifies the device to receive the */ -/* body/ID mapping list. WRLINE performs the */ -/* output function and so DEVICE may have */ -/* the values 'SCREEN' (to generate a screen dump), */ -/* 'NULL' (do nothing), or a device name (a */ -/* file, or any other name valid in a FORTRAN OPEN */ -/* statement). */ - -/* REQST A case insensitive string indicating the data */ -/* set to output. REQST may have the value 'ID', */ -/* 'NAME', or 'BOTH'. 'ID' outputs the name/ID mapping */ -/* ordered by ID number from least to highest value. */ -/* 'NAME' outputs the name/ID mapping ordered by ASCII */ -/* sort on the name string. 'BOTH' outputs both */ -/* ordered lists. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The entry point outputs ordered lists of the name/ID mappings */ -/* defined in ZZBODTRN. */ - -/* $ Examples */ - -/* 1. Write both sorted lists to screen. */ - -/* PROGRAM X */ - -/* CALL ZZBODLST( 'SCREEN', 'BOTH' ) */ - -/* END */ - -/* 2. Write an ID number sorted list to a file, "body.txt". */ - -/* PROGRAM X */ - -/* CALL ZZBODLST( 'body.txt', 'ID' ) */ - -/* END */ - -/* With SCREEN output of the form: */ - -/* Total number of name/ID mappings: 414 */ - -/* ID to name mappings. */ -/* -550 | M96 */ -/* -550 | MARS 96 */ -/* -550 | MARS-96 */ -/* -550 | MARS96 */ -/* -254 | MER-2 */ -/* -253 | MER-1 */ - -/* .. .. */ - -/* 50000020 | SHOEMAKER-LEVY 9-B */ -/* 50000021 | SHOEMAKER-LEVY 9-A */ -/* 50000022 | SHOEMAKER-LEVY 9-Q1 */ -/* 50000023 | SHOEMAKER-LEVY 9-P2 */ - -/* Name to ID mappings. */ -/* 1978P1 | 901 */ -/* 1979J1 | 515 */ - -/* .. .. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.1, 27-FEB-2007 (EDW) */ - -/* Completed the ZZBODLST declarations section. */ - -/* - SPICELIB Version 2.1.0, 17-MAR-2003 (EDW) */ - -/* Added a call to ZZIDMAP to retrieve the default */ -/* mapping list. "zzbodtrn.inc" no longer */ -/* contains the default mapping list. */ - -/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ - -/* This entry point was moved into ZZBODBLT and some */ -/* variable names were changed to refer to variables */ -/* in the umbrella. */ - -/* - SPICELIB Version 1.0.0, 26-NOV-2001 (EDW) */ - -/* -& */ - if (return_()) { - return 0; - } else { - chkin_("ZZBODLST", (ftnlen)8); - } - -/* Upper case the ZZRQST value. */ - - ucase_(reqst, zzrqst, reqst_len, (ftnlen)4); - intstr_(&c__563, zzint, (ftnlen)36); -/* Writing concatenation */ - i__3[0] = 34, a__1[0] = "Total number of name/ID mappings: "; - i__3[1] = 36, a__1[1] = zzint; - s_cat(zzline, a__1, i__3, &c__2, (ftnlen)75); - wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75)); - -/* Retrieve the current set of name/ID mappings */ - - zzidmap_(bltcod, bltnam, (ftnlen)36); - -/* Branch as defined by the value of ZZRQST. 'ID' or 'BOTH'. */ - - if (eqstr_(zzrqst, "ID", (ftnlen)4, (ftnlen)2) || eqstr_(zzrqst, "BOTH", ( - ftnlen)4, (ftnlen)4)) { - orderi_(bltcod, &c__563, zzocod); - wrline_(device, " ", device_len, (ftnlen)1); - wrline_(device, "ID to name mappings.", device_len, (ftnlen)20); - for (i__ = 1; i__ <= 563; ++i__) { - intstr_(&bltcod[(i__2 = zzocod[(i__1 = i__ - 1) < 563 && 0 <= - i__1 ? i__1 : s_rnge("zzocod", i__1, "zzbodblt_", (ftnlen) - 812)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltcod", - i__2, "zzbodblt_", (ftnlen)812)], zzint, (ftnlen)36); -/* Writing concatenation */ - i__4[0] = 36, a__2[0] = zzint; - i__4[1] = 3, a__2[1] = " | "; - i__4[2] = 36, a__2[2] = bltnam + ((i__2 = zzocod[(i__1 = i__ - 1) - < 563 && 0 <= i__1 ? i__1 : s_rnge("zzocod", i__1, "zzbo" - "dblt_", (ftnlen)814)] - 1) < 563 && 0 <= i__2 ? i__2 : - s_rnge("bltnam", i__2, "zzbodblt_", (ftnlen)814)) * 36; - s_cat(zzline, a__2, i__4, &c__3, (ftnlen)75); - wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75)); - } - } - -/* ... 'NAME' or 'BOTH'. */ - - if (eqstr_(zzrqst, "NAME", (ftnlen)4, (ftnlen)4) || eqstr_(zzrqst, "BOTH", - (ftnlen)4, (ftnlen)4)) { - orderc_(bltnam, &c__563, zzonam, (ftnlen)36); - wrline_(device, " ", device_len, (ftnlen)1); - wrline_(device, "Name to ID mappings.", device_len, (ftnlen)20); - for (i__ = 1; i__ <= 563; ++i__) { - intstr_(&bltcod[(i__2 = zzonam[(i__1 = i__ - 1) < 563 && 0 <= - i__1 ? i__1 : s_rnge("zzonam", i__1, "zzbodblt_", (ftnlen) - 834)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltcod", - i__2, "zzbodblt_", (ftnlen)834)], zzint, (ftnlen)36); -/* Writing concatenation */ - i__4[0] = 36, a__2[0] = bltnam + ((i__2 = zzonam[(i__1 = i__ - 1) - < 563 && 0 <= i__1 ? i__1 : s_rnge("zzonam", i__1, "zzbo" - "dblt_", (ftnlen)836)] - 1) < 563 && 0 <= i__2 ? i__2 : - s_rnge("bltnam", i__2, "zzbodblt_", (ftnlen)836)) * 36; - i__4[1] = 3, a__2[1] = " | "; - i__4[2] = 36, a__2[2] = zzint; - s_cat(zzline, a__2, i__4, &c__3, (ftnlen)75); - wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75)); - } - } - chkout_("ZZBODLST", (ftnlen)8); - return 0; -} /* zzbodblt_ */ - -/* Subroutine */ int zzbodblt_(integer *room, char *names, char *nornam, - integer *codes, integer *nvals, char *device, char *reqst, ftnlen - names_len, ftnlen nornam_len, ftnlen device_len, ftnlen reqst_len) -{ - return zzbodblt_0_(0, room, names, nornam, codes, nvals, device, reqst, - names_len, nornam_len, device_len, reqst_len); - } - -/* Subroutine */ int zzbodget_(integer *room, char *names, char *nornam, - integer *codes, integer *nvals, ftnlen names_len, ftnlen nornam_len) -{ - return zzbodblt_0_(1, room, names, nornam, codes, nvals, (char *)0, (char - *)0, names_len, nornam_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzbodlst_(char *device, char *reqst, ftnlen device_len, - ftnlen reqst_len) -{ - return zzbodblt_0_(2, (integer *)0, (char *)0, (char *)0, (integer *)0, ( - integer *)0, device, reqst, (ftnint)0, (ftnint)0, device_len, - reqst_len); - } - diff --git a/ext/spice/src/cspice/zzbodbry.c b/ext/spice/src/cspice/zzbodbry.c deleted file mode 100644 index b0bbfadd26..0000000000 --- a/ext/spice/src/cspice/zzbodbry.c +++ /dev/null @@ -1,226 +0,0 @@ -/* zzbodbry.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZBODBRY ( Return barycenter code for a body ) */ -integer zzbodbry_(integer *body) -{ - /* System generated locals */ - integer ret_val; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the barycenter code associated with a body belonging to */ -/* a planetary system. For other bodies, simply return the */ -/* input ID code. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I ID code of body. */ - -/* The function returns the NAIF integer ID code of the barycenter, */ -/* if any, associated with BODY. */ - -/* $ Detailed_Input */ - -/* BODY is the integer ID code of the body for which the */ -/* barycenter ID code is requested. */ - -/* $ Detailed_Output */ - -/* The function returns the NAIF integer ID code of the barycenter, */ -/* if any, associated with BODY. If BODY is not the NAIF integer */ -/* ID code of a planet or satellite, the value BODY is returned. */ - -/* Planetary barycenter codes are the integers 1, ..., 9. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If BODY is not the NAIF integer ID code of a planet or */ -/* satellite, the value BODY is returned. This case is */ -/* not considered to be an error. */ - -/* 2) Codes of the form */ - -/* PXNNN, where */ - -/* P is 1, ..., 9, */ -/* X is 1, 2, 3, 4, 6, 7, 8, 9 */ -/* and NNN is 001, ... 999 */ - -/* are mapped to the integer P. These codes are not */ -/* considered to be erroneous, though they were not */ -/* part of the planned satellite numbering scheme at */ -/* the date this routine was released. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine enables the caller to determine to which */ -/* planetary system, if any, a planet or natural satellite belongs. */ -/* This capability is used by the SPICELIB PCK subsystem. */ - -/* Planets have ID codes of the form P99, where P is 1, ..., 9. */ - -/* Natural satellites have ID codes of the form */ - -/* PNN, where */ - -/* P is 1, ..., 9 */ -/* and NN is 01, ... 98 */ - -/* or */ - -/* PXNNN, where */ - -/* P is 1, ..., 9, */ -/* X is 0 or 5, */ -/* and NNN is 001, ... 999 */ - -/* Codes with X = 5 are provisional. */ - -/* $ Examples */ - -/* 1) Find the planetary system (indicated by a barycenter ID */ -/* code) associated with the ID code 65001 (a provisional code */ -/* for a Saturnian satellite): */ - -/* BODY = 65001 */ -/* BARY = ZZBODBRY ( BODY ) */ - -/* BARY is assigned the value 6. */ - -/* 2) Find the planetary system associated with the ID code */ -/* 60001 (an "extended" code for a Saturnian satellite): */ - -/* BODY = 60001 */ -/* BARY = ZZBODBRY ( BODY ) */ - -/* BARY is assigned the value 6. */ - -/* 3) Find the planetary system associated with the ID code */ -/* 606 (Titan): */ - -/* BODY = 606 */ -/* BARY = ZZBODBRY ( BODY ) */ - -/* BARY is assigned the value 6. */ - -/* 4) Find the planetary system associated with the ID code */ -/* 699 (Saturn): */ - -/* BODY = 699 */ -/* BARY = ZZBODBRY ( BODY ) */ - -/* BARY is assigned the value 6. */ - -/* 5) Find the planetary system associated with the ID code 6 */ -/* (Saturn system barycenter): */ - -/* BODY = 6 */ -/* BARY = ZZBODBRY ( BODY ) */ - -/* BARY is assigned the value 6. */ - -/* 6) Find the planetary system associated with the ID code */ -/* 9511010 (asteroid Gaspra): */ - -/* BODY = 9511010 */ -/* BARY = ZZBODBRY ( BODY ) */ - -/* BARY is assigned the value 9511010. */ - -/* $ Restrictions */ - -/* 1) This routine should not be called from routines outside */ -/* of SPICELIB. The interface and functionality may change */ -/* without notice. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-FEB-2004 (NJB) */ - -/* -& */ - if (*body >= 100 && *body <= 999) { - -/* BODY is a "traditional" NAIF planet or natural satellite */ -/* ID code. */ - - ret_val = *body / 100; - } else if (*body >= 10000 && *body <= 99999) { - -/* BODY is an "extended" NAIF natural satellite ID code. */ - - ret_val = *body / 10000; - } else { - -/* BODY is a barycenter code or is not associated with a */ -/* planetary system. In either case, we simply return */ -/* the input value BODY. */ - - ret_val = *body; - } - return ret_val; -} /* zzbodbry_ */ - diff --git a/ext/spice/src/cspice/zzbodini.c b/ext/spice/src/cspice/zzbodini.c deleted file mode 100644 index 1156a29f07..0000000000 --- a/ext/spice/src/cspice/zzbodini.c +++ /dev/null @@ -1,305 +0,0 @@ -/* zzbodini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZBODINI ( Private --- Body-Code Initialization ) */ -/* Subroutine */ int zzbodini_(char *names, char *nornam, integer *codes, - integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, - ftnlen names_len, ftnlen nornam_len) -{ - integer i__, n; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen), - orderi_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Initialize the two order vectors. This routine should be called */ -/* by ZZBODTRN only. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAMES I Array of kernel pool assigned names. */ -/* NORNAM I Array of normalized kernel pool assigned names. */ -/* CODES I Array of ID codes for NAMES/NORNAM. */ -/* NVALS I Length of NAMES, NORNAM, CODES, and ORDNOM arrays. */ -/* ORDNOM O Order vector for NORNAM. */ -/* ORDCOD O Modified order vector for CODES. */ -/* NOCDS O Length of ORDCOD array. */ -/* MAXL P Maximum length of body name strings. */ - -/* $ Detailed_Input */ - -/* NAMES the array of highest precedent names extracted */ -/* from the kernel pool vector NAIF_BODY_NAME. This */ -/* array is parallel to NORNAM and CODES. */ - -/* NORNAM the array of highest precedent names extracted */ -/* from the kernel pool vector NAIF_BODY_NAME. After */ -/* extraction, each entry is converted to uppercase, */ -/* and groups of spaces are compressed to a single */ -/* space. This represents the canonical member of the */ -/* equivalence class each parallel entry in NAMES */ -/* belongs. */ - -/* CODES the array of highest precedent codes extracted */ -/* from the kernel pool vector NAIF_BODY_CODE. This */ -/* array is parallel to NAMES and NORNAM. */ - -/* NVALS the number of items contained in NAMES, NORNAM, */ -/* CODES and ORDNOM. */ - -/* $ Detailed_Output */ - -/* ORDNOM the order vector of indexes for NORNAM. The set */ -/* of values NORNAM( ORDNOM(1) ), NORNAM( ORDNOM(2) ), */ -/* ... forms an increasing list of name values. */ - -/* ORDCOD the modified ordering vector of indexes into */ -/* CODES. The list CODES( ORDCOD(1) ), */ -/* CODES( ORDCOD(2) ), ... , CODES( ORDCOD(NOCDS) ) */ -/* forms an increasing non-repeating list of integers. */ -/* Moreover, every value in CODES is listed exactly */ -/* once in this sequence. */ - -/* NOCDS the number of indexes listed in ORDCOD. This */ -/* value will never exceed NVALS.C */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a body name. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine used for initializing the ordering */ -/* vectors that point to the recognized names and codes used by */ -/* the private routine ZZBODTRN. */ - -/* $ Examples */ - -/* See the routine ZZBODTRN. */ - -/* $ Restrictions */ - -/* 1) This routine is intended only for use by ZZBODTRN. */ - -/* 2) NAMES and NORNAM must contain only unique entries. */ -/* If duplicate entries exist, this routine may not */ -/* perform as expected. */ - -/* 3) This routine relies rather heavily on the implementation of */ -/* BSCHOI. The specification of BSCHOI requires an order vector */ -/* as input, however it turns out that a generalization of an */ -/* order vector (as defined by this routine) will work as well. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 23-AUG-2002 (FST) */ - -/* Implemented changes to support the new precedence */ -/* system. */ - -/* Altered the calling sequence of ZZBODINI to remove */ -/* unused arguments. This routine also no longer computes */ -/* NORNAM from NAMES, since it is used in a more general */ -/* capacity. */ - -/* Updated module header and comments to document additional */ -/* assumptions this module now makes about its inputs. */ - -/* This routine is now error free. */ - -/* - SPICELIB Version 2.1.1, 07-MAR-2002 (EDW) */ - -/* Modified error logic to allow duplicate */ -/* NAME -> CODE mappings without signaling an error. */ -/* The mapping operation is a no-op, but might */ -/* cause a user problems if an error signals. */ - -/* - SPICELIB Version 2.1.0, 12-AUG-2001 (EDW) */ - -/* Modified logic for all ZZBOD routines to function with */ -/* equivalence class concept. A body name now exists */ -/* as a member of an equivalence class named by the */ -/* normalized form of the body name. To facilitate this */ -/* concept, an addition name vector, NORNAM, and */ -/* order vector, ORDNOM, now exist. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) (WLT) */ - -/* Renamed to ZZBODINI and filled out the comments on what this */ -/* routine does and how it works. */ - -/* -& */ - -/* Local Variables */ - - -/* Create the order vectors ORDCOD and ORDNOM. */ - - orderc_(nornam, nvals, ordnom, (ftnlen)36); - orderi_(codes, nvals, ordcod); - -/* Remove duplicate entries in the code order table. The entry that */ -/* points to the highest entry in CODES should remain. */ - - n = 1; - i__ = 2; - -/* Now for some very funky maneuvering. We are going to take our */ -/* order vector for the id-codes and modify it! */ - -/* Here's what is true now. */ - -/* CODES(ORDCOD(1)) <= CODES(ORDCOD(2)) <=...<= CODES(ORDCOD(NVALS) */ - -/* For each element such that CODES(ORDCOD(I)) = CODES(ORDCOD(I+1)) */ -/* we are going to "shift" the items ORDCOD(I+1), ORDCOD(I+2), ... */ -/* left by one. We will then repeat the test and shift as needed. */ -/* When we get done we will have a possibly shorter array ORDCOD */ -/* and the array will satisfy */ - -/* CODES(ORDCOD(1)) < CODES(ORDCOD(2)) < ... < CODES(ORDCOD(NVALS) */ - -/* We can still use the resulting "ordered vector" (as opposed to */ -/* order vector) in the BSCHOI routine because it only relies */ -/* upon the indexes to ORDCOD and not to CODES itself. This is */ -/* making very heavy use of the implementation of BSCHOI but we */ -/* are going to let it go for the moment because this is a private */ -/* routine. */ - - while(i__ <= *nvals) { - if (codes[ordcod[i__ - 1] - 1] == codes[ordcod[n - 1] - 1]) { - if (ordcod[i__ - 1] > ordcod[n - 1]) { - ordcod[n - 1] = ordcod[i__ - 1]; - } - } else { - ++n; - ordcod[n - 1] = ordcod[i__ - 1]; - } - ++i__; - } - *nocds = n; - return 0; -} /* zzbodini_ */ - diff --git a/ext/spice/src/cspice/zzbodker.c b/ext/spice/src/cspice/zzbodker.c deleted file mode 100644 index 90c9069028..0000000000 --- a/ext/spice/src/cspice/zzbodker.c +++ /dev/null @@ -1,514 +0,0 @@ -/* zzbodker.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2000 = 2000; - -/* $Procedure ZZBODKER ( Private --- Process Body-Name Kernel Pool Maps ) */ -/* Subroutine */ int zzbodker_(char *names, char *nornam, integer *codes, - integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, - logical *extker, ftnlen names_len, ftnlen nornam_len) -{ - /* Initialized data */ - - static char nbc[32] = "NAIF_BODY_CODE "; - static char nbn[32] = "NAIF_BODY_NAME "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical drop[2000]; - char type__[1*2]; - integer nsiz[2]; - extern /* Subroutine */ int zzbodini_(char *, char *, integer *, integer * - , integer *, integer *, integer *, ftnlen, ftnlen); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - logical plfind[2]; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen), - gcpool_(char *, integer *, integer *, integer *, char *, logical - *, ftnlen, ftnlen), gipool_(char *, integer *, integer *, integer - *, integer *, logical *, ftnlen), sigerr_(char *, ftnlen); - logical remdup; - extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *, - logical *, integer *, char *, ftnlen, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - integer num[2]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine processes the kernel pool vectors NAIF_BODY_NAME */ -/* and NAIF_BODY_CODE into the formatted lists required by ZZBODTRN */ -/* to successfully compute code-name mappings. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAMES O Array of kernel pool assigned names. */ -/* NORNAM O Array of normalized kernel pool assigned names. */ -/* CODES O Array of ID codes for NAMES/NORNAM. */ -/* NVALS O Length of NAMES, NORNAM, CODES, and ORDNOM arrays. */ -/* ORDNOM O Order vector for NORNAM. */ -/* ORDCOD O Modified order vector for CODES. */ -/* NOCDS O Length of ORDCOD array. */ -/* EXTKER O Logical indicating presence of kernel pool names. */ -/* MAXL P Maximum length of body name strings. */ -/* NROOM P Maximum length of kernel pool data vectors. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* NAMES the array of highest precedent names extracted */ -/* from the kernel pool vector NAIF_BODY_NAME. This */ -/* array is parallel to NORNAM and CODES. */ - -/* NORNAM the array of highest precedent names extracted */ -/* from the kernel pool vector NAIF_BODY_NAME. After */ -/* extraction, each entry is converted to uppercase, */ -/* and groups of spaces are compressed to a single */ -/* space. This represents the canonical member of the */ -/* equivalence class each parallel entry in NAMES */ -/* belongs. */ - -/* CODES the array of highest precedent codes extracted */ -/* from the kernel pool vector NAIF_BODY_CODE. This */ -/* array is parallel to NAMES and NORNAM. */ - -/* NVALS the number of items contained in NAMES, NORNAM, */ -/* CODES and ORDNOM. */ - -/* ORDNOM the order vector of indexes for NORNAM. The set */ -/* of values NORNAM( ORDNOM(1) ), NORNAM( ORDNOM(2) ), */ -/* ... forms an increasing list of name values. */ - -/* ORDCOD the modified ordering vector of indexes into */ -/* CODES. The list CODES( ORDCOD(1) ), */ -/* CODES( ORDCOD(2) ), ... , CODES( ORDCOD(NOCDS) ) */ -/* forms an increasing non-repeating list of integers. */ -/* Moreover, every value in CODES is listed exactly */ -/* once in this sequence. */ - -/* NOCDS the number of indexes listed in ORDCOD. This */ -/* value will never exceed NVALS. */ - -/* EXTKER is a logical that indicates to the caller whether */ -/* any kernel pool name-code maps have been defined. */ -/* If EXTKER is .FALSE., then the kernel pool variables */ -/* NAIF_BODY_CODE and NAIF_BODY_NAME are empty and */ -/* only the built-in and ZZBODDEF code-name mappings */ -/* need consideration. If .TRUE., then the values */ -/* returned by this module need consideration. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a body name. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* NROOM is the maximum number of kernel pool data items */ -/* that can be processed from the NAIF_BODY_CODE */ -/* and NAIF_BODY_NAME lists. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(MISSINGKPV) is signaled when one of the */ -/* NAIF_BODY_CODE and NAIF_BODY_NAME keywords is present in the */ -/* kernel pool and the other is not. */ - -/* 2) The error SPICE(KERVARTOOBIG) is signaled if one or both of */ -/* the NAIF_BODY_CODE and NAIF_BODY_NAME kernel pool vectors */ -/* have a cardinality that exceeds NROOM. */ - -/* 3) The error SPICE(BADDIMENSIONS) is signaled if the cardinality */ -/* of the NAIF_BODY_CODE and NAIF_BODY_NAME kernel pool vectors do */ -/* not match. */ - -/* 4) The error SPICE(BLANKNAMEASSIGNED) is signaled if an entry */ -/* in the NAIF_BODY_NAME kernel pool vector is a blank string. */ -/* ID codes may not be assigned to a blank string. */ - -/* $ Particulars */ - -/* This routine examines the contents of the kernel pool, ingests */ -/* the contents of the NAIF_BODY_CODE and NAIF_BODY_NAME keywords, */ -/* and produces the order vectors and name/code lists that ZZBODTRN */ -/* requires to resolve code to name and name to code mappings. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 23-AUG-2002 (EDW) (FST) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODKER", (ftnlen)8); - } - -/* Until the code below proves otherwise, we shall assume */ -/* we lack kernel pool name/code mappings. */ - - *extker = FALSE_; - -/* Check for the external body ID variables in the kernel pool. */ - - gcpool_(nbn, &c__1, &c__2000, num, names, plfind, (ftnlen)32, (ftnlen)36); - gipool_(nbc, &c__1, &c__2000, &num[1], codes, &plfind[1], (ftnlen)32); - -/* Examine PLFIND(1) and PLFIND(2) for problems. */ - - if (plfind[0] != plfind[1]) { - -/* If they are not both present or absent, signal an error. */ - - setmsg_("The kernel pool vector, #, used in mapping between names an" - "d ID-codes is absent, while # is not. This is often due to " - "an improperly constructed text kernel. Check loaded kernels" - " for these keywords.", (ftnlen)199); - if (plfind[0]) { - errch_("#", nbc, (ftnlen)1, (ftnlen)32); - errch_("#", nbn, (ftnlen)1, (ftnlen)32); - } else { - errch_("#", nbn, (ftnlen)1, (ftnlen)32); - errch_("#", nbc, (ftnlen)1, (ftnlen)32); - } - sigerr_("SPICE(MISSINGKPV)", (ftnlen)17); - chkout_("ZZBODKER", (ftnlen)8); - return 0; - } else if (! plfind[0]) { - -/* Return if both keywords are absent. */ - - chkout_("ZZBODKER", (ftnlen)8); - return 0; - } - -/* If we reach here, then both kernel pool variables are present. */ -/* Perform some simple sanity checks on their lengths. */ - - dtpool_(nbn, &found, nsiz, type__, (ftnlen)32, (ftnlen)1); - dtpool_(nbc, &found, &nsiz[1], type__ + 1, (ftnlen)32, (ftnlen)1); - if (nsiz[0] > 2000 || nsiz[1] > 2000) { - setmsg_("The kernel pool vectors used to define the names/ID-codes m" - "appingexceeds the max size. The size of the NAME vector is #" - "1. The size of the CODE vector is #2. The max number allowed" - " of elements is #3.", (ftnlen)198); - errint_("#1", nsiz, (ftnlen)2); - errint_("#2", &nsiz[1], (ftnlen)2); - errint_("#3", &c__2000, (ftnlen)2); - sigerr_("SPICE(KERVARTOOBIG)", (ftnlen)19); - chkout_("ZZBODKER", (ftnlen)8); - return 0; - } else if (nsiz[0] != nsiz[1]) { - setmsg_("The kernel pool vectors used for mapping between names and " - "ID-codes are not the same size. The size of the name vector" - ", NAIF_BODY_NAME is #. The size of the ID-code vector, NAIF_" - "BODY_CODE is #. You need to examine the ID-code kernel you l" - "oaded and correct the mismatch.", (ftnlen)270); - errint_("#", nsiz, (ftnlen)1); - errint_("#", &nsiz[1], (ftnlen)1); - sigerr_("SPICE(BADDIMENSIONS)", (ftnlen)20); - chkout_("ZZBODKER", (ftnlen)8); - return 0; - } - -/* Compute the canonical member of the equivalence class of NAMES, */ -/* NORNAM. This normalization compresses groups of spaces into a */ -/* single space, left justifies the string, and uppercases the */ -/* contents. While passing through the NAMES array, look for any */ -/* blank strings and signal an appropriate error. */ - - *nvals = num[0]; - i__1 = *nvals; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Check for blank strings. */ - - if (s_cmp(names + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : - s_rnge("names", i__2, "zzbodker_", (ftnlen)345)) * 36, " ", ( - ftnlen)36, (ftnlen)1) == 0) { - setmsg_("An attempt to assign the code, #, to a blank string was" - " made. Check loaded text kernels for a blank string in " - "the NAIF_BODY_NAME array.", (ftnlen)136); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BLANKNAMEASSIGNED)", (ftnlen)24); - chkout_("ZZBODKER", (ftnlen)8); - return 0; - } - -/* Compute the canonical member of the equivalence class. */ - - ljust_(names + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge( - "names", i__2, "zzbodker_", (ftnlen)361)) * 36, nornam + (( - i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("nornam", - i__3, "zzbodker_", (ftnlen)361)) * 36, (ftnlen)36, (ftnlen)36) - ; - ucase_(nornam + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge( - "nornam", i__2, "zzbodker_", (ftnlen)362)) * 36, nornam + (( - i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("nornam", - i__3, "zzbodker_", (ftnlen)362)) * 36, (ftnlen)36, (ftnlen)36) - ; - cmprss_(" ", &c__1, nornam + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? - i__2 : s_rnge("nornam", i__2, "zzbodker_", (ftnlen)363)) * 36, - nornam + ((i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : - s_rnge("nornam", i__3, "zzbodker_", (ftnlen)363)) * 36, ( - ftnlen)1, (ftnlen)36, (ftnlen)36); - } - -/* Determine a preliminary order vector for NORNAM. */ - - orderc_(nornam, nvals, ordnom, (ftnlen)36); - -/* We are about to remove duplicates. Make some initial */ -/* assumptions, no duplicates exist in NORNAM. */ - - i__1 = *nvals; - for (i__ = 1; i__ <= i__1; ++i__) { - drop[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge("drop", - i__2, "zzbodker_", (ftnlen)377)] = FALSE_; - } - remdup = FALSE_; - -/* ORDERC clusters duplicate entries in NORNAM together. */ -/* Use this fact to locate duplicates on one pass through */ -/* NORNAM. */ - - i__1 = *nvals - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(nornam + ((i__3 = ordnom[(i__2 = i__ - 1) < 2000 && 0 <= - i__2 ? i__2 : s_rnge("ordnom", i__2, "zzbodker_", (ftnlen)389) - ] - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("nornam", i__3, - "zzbodker_", (ftnlen)389)) * 36, nornam + ((i__5 = ordnom[( - i__4 = i__) < 2000 && 0 <= i__4 ? i__4 : s_rnge("ordnom", - i__4, "zzbodker_", (ftnlen)389)] - 1) < 2000 && 0 <= i__5 ? - i__5 : s_rnge("nornam", i__5, "zzbodker_", (ftnlen)389)) * 36, - (ftnlen)36, (ftnlen)36) == 0) { - -/* We have at least one duplicate to remove. */ - - remdup = TRUE_; - -/* If the normalized entries are equal, drop the one with */ -/* the lower index in the NAMES array. Entries defined */ -/* later in the kernel pool have higher precedence. */ - - if (ordnom[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge( - "ordnom", i__2, "zzbodker_", (ftnlen)401)] < ordnom[(i__3 - = i__) < 2000 && 0 <= i__3 ? i__3 : s_rnge("ordnom", i__3, - "zzbodker_", (ftnlen)401)]) { - drop[(i__3 = ordnom[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? - i__2 : s_rnge("ordnom", i__2, "zzbodker_", (ftnlen) - 402)] - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("drop", - i__3, "zzbodker_", (ftnlen)402)] = TRUE_; - } else { - drop[(i__3 = ordnom[(i__2 = i__) < 2000 && 0 <= i__2 ? i__2 : - s_rnge("ordnom", i__2, "zzbodker_", (ftnlen)404)] - 1) - < 2000 && 0 <= i__3 ? i__3 : s_rnge("drop", i__3, - "zzbodker_", (ftnlen)404)] = TRUE_; - } - } - } - -/* If necessary, remove duplicates. */ - - if (remdup) { - -/* Sweep through the DROP array, compressing off any elements */ -/* that are to be dropped. */ - - j = 0; - i__1 = *nvals; - for (i__ = 1; i__ <= i__1; ++i__) { - if (! drop[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge( - "drop", i__2, "zzbodker_", (ftnlen)423)]) { - ++j; - s_copy(names + ((i__2 = j - 1) < 2000 && 0 <= i__2 ? i__2 : - s_rnge("names", i__2, "zzbodker_", (ftnlen)425)) * 36, - names + ((i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 - : s_rnge("names", i__3, "zzbodker_", (ftnlen)425)) * - 36, (ftnlen)36, (ftnlen)36); - s_copy(nornam + ((i__2 = j - 1) < 2000 && 0 <= i__2 ? i__2 : - s_rnge("nornam", i__2, "zzbodker_", (ftnlen)426)) * - 36, nornam + ((i__3 = i__ - 1) < 2000 && 0 <= i__3 ? - i__3 : s_rnge("nornam", i__3, "zzbodker_", (ftnlen) - 426)) * 36, (ftnlen)36, (ftnlen)36); - codes[(i__2 = j - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge( - "codes", i__2, "zzbodker_", (ftnlen)427)] = codes[( - i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge( - "codes", i__3, "zzbodker_", (ftnlen)427)]; - } - } - -/* Adjust NVALS to compensate for the number of elements that */ -/* were compressed off the list. */ - - *nvals = j; - } - -/* Compute the order vectors that ZZBODTRN requires. */ - - zzbodini_(names, nornam, codes, nvals, ordnom, ordcod, nocds, (ftnlen)36, - (ftnlen)36); - -/* We're on the home stretch if we make it to this point. */ -/* Set EXTKER to .TRUE., check out and return. */ - - *extker = TRUE_; - chkout_("ZZBODKER", (ftnlen)8); - return 0; -} /* zzbodker_ */ - diff --git a/ext/spice/src/cspice/zzbodtrn.c b/ext/spice/src/cspice/zzbodtrn.c deleted file mode 100644 index 906c9645c2..0000000000 --- a/ext/spice/src/cspice/zzbodtrn.c +++ /dev/null @@ -1,2344 +0,0 @@ -/* zzbodtrn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__713 = 713; -static integer c__1 = 1; - -/* $Procedure ZZBODTRN ( Private --- Body name and code translation ) */ -/* Subroutine */ int zzbodtrn_0_(int n__, char *name__, integer *code, - logical *found, ftnlen name_len) -{ - /* Initialized data */ - - static logical bodchg = FALSE_; - static logical first = TRUE_; - static logical extker = FALSE_; - static logical nodata = TRUE_; - static char wnames[32*2] = "NAIF_BODY_NAME " "NAIF_BODY" - "_CODE "; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzbodget_(integer *, char *, char *, integer * - , integer *, ftnlen, ftnlen), zzbodini_(char *, char *, integer *, - integer *, integer *, integer *, integer *, ftnlen, ftnlen), - zzbodker_(char *, char *, integer *, integer *, integer *, - integer *, integer *, logical *, ftnlen, ftnlen); - static integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static integer index; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - static integer defcod[713], defocd[713]; - static char defnam[36*713]; - extern integer bschoc_(char *, integer *, char *, integer *, ftnlen, - ftnlen), bschoi_(integer *, integer *, integer *, integer *); - static integer kercod[2000], kerocd[2000], codidx; - static char defnor[36*713], kernam[36*2000]; - static integer defonr[713]; - static logical update; - static integer defsiz, nwatch, defosz; - static char tmpnam[36]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - static char kernor[36*2000]; - static integer keronr[2000]; - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen); - static integer kersiz; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - static integer kerosz; - extern logical return_(void); - extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the umbrella routine that contains entry points to */ -/* translate between body names and NAIF integer codes, and */ -/* for definition of new name/code pairs. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I/O ZZBODN2C, ZZBODDEF, ZZBODC2N */ -/* CODE I/O ZZBODC2N, ZZBODDEF, ZZBODN2C */ -/* FOUND O ZZBODN2C and ZZBODC2N */ -/* MAXL P (All) */ -/* MAXP P ZZBODDEF */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a body name. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* MAXP is the maximum number of additional names that may */ -/* be added via the ZZBODDEF interface. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(BOGUSENTRY) is signaled if ZZBODTRN */ -/* is called directly. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ZZBODTRN should never be called, instead access the entry */ -/* points: */ - -/* ZZBODN2C Body name to code */ - -/* ZZBODC2N Body code to name */ - -/* ZZBODDEF Body name/code definition */ - -/* ZZBODKIK Force an examination of the kernel pool */ -/* variables, subsequent processing and */ -/* the generation of any error messages */ -/* resultant from the processing. */ - -/* ZZBODRST Reset the mappings provided via the ZZBODDEF */ -/* interface. */ - -/* ZZBODN2C and ZZBODC2N perform translations between body names */ -/* and their corresponding integer codes used in SPK and PCK files */ -/* and associated routines. A default set of name/code */ -/* pairs are automatically defined during the first call to */ -/* any of the entry points. Additional name/code pairs may */ -/* be defined via ZZBODDEF for two purposes: */ - -/* 1) to associate another, perhaps more familiar or */ -/* abbreviated name with a previously defined body */ -/* integer code */ - -/* 2) to define a new body integer code and name */ - -/* Each body name maps to a unique integer code, but more than */ -/* one name may map to a code. Associating more than one */ -/* integer code with a particular name creates ambiguity. */ -/* Therefore the name-code mapping system establishes a */ -/* clearly defined precedence structure that assures at any */ -/* given instant only one code is assigned to a particular */ -/* name. */ - -/* Entries provided via the kernel pool variables are examined */ -/* first to resolve name-code mappings. The last listed entries */ -/* in the kernel pool arrays NAIF_BODY_CODE and NAIF_BODY_NAME */ -/* resolve any ambiguities that occur. For example, consider */ -/* the following text kernel excerpt: */ - -/* \begindata */ - -/* NAIF_BODY_NAME += 'NAME' */ -/* NAIF_BODY_CODE += 1000 */ - -/* NAIF_BODY_NAME += 'NAME' */ -/* NAIF_BODY_CODE += 1001 */ - -/* \begintext */ - -/* If, after loading this kernel, the following calls are made: */ - -/* CALL ZZBODN2C ( 'NAME', CODE, NAMFND ) */ - -/* CALL ZZBODC2N ( 1000, NAME0, FND000 ) */ -/* CALL ZZBODC2N ( 1001, NAME1, FND001 ) */ - -/* The values of CODE, NAMFND, NAME0, FND000, NAME1, and FND001 */ -/* will be: */ - -/* NAMFND = .TRUE., CODE = 1001 */ -/* FND000 = .FALSE., NAME0 remains unchanged */ -/* FND001 = .TRUE., NAME1 = 'NAME' */ - -/* FND000 is .FALSE., because this name-code mapping is masked */ -/* by the higher precedent 'NAME' <-> 1001 mapping. */ - -/* If the name-code mapping is not resolved by the entries */ -/* provided in the kernel pool, the values assigned via the */ -/* ZZBODDEF interface are examined next. As with the kernel */ -/* pool, the last assignment made via the ZZBODDEF interface */ -/* has the highest precedence. Lastly, if the name-code */ -/* mapping is not resolved by the contents of ZZBODDEF, the */ -/* built-in mappings are examined. In actuality, the built-in */ -/* mappings represent an initial state of the ZZBODDEF listings. */ -/* As changes are made to this listing, the original mappings */ -/* are discarded. */ - -/* For the case in which multiple names map to a single code, a */ -/* ZZBODC2N call returns the name last assigned to that code - a */ -/* LIFO situation. */ - -/* $ Examples */ - -/* 1) The following code fragment shows SPKEZ compute the state */ -/* (position and velocity) of Jupiter as seen from the Galileo */ -/* Orbiter. It requires the NAIF integer codes of the target */ -/* and observer, so we use ZZBODN2C to convert names to integer */ -/* codes for those bodies. */ - -/* CALL ZZBODN2C ( 'JUPITER', TARGET, FOUND ) */ - -/* CALL ZZBODN2C ( 'GALILEO ORBITER', OBSRVR, FOUND ) */ - -/* CALL SPKEZ ( TARGET, EPOCH, FRAME, ABCORR, */ -/* . OBSRVR, STATE, LT ) */ - - -/* 2) This example assumes ZZBODDEF has not been called. */ -/* Thus, only the set of default name/code pairs has been */ -/* defined. */ - -/* Given these names, ZZBODN2C returns the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - -/* and, given these codes, ZZBODC2N returns the following */ -/* names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ -/* -1 'GEOTAIL' Yes */ - -/* 3) This example shows the method to define a name/code pair. */ -/* You may associate a new name with a previously defined */ -/* code: */ - -/* CALL ZZBODDEF ( 'JB', 5 ) */ - -/* You may also define the name and integer code for a new */ -/* body: */ - -/* CALL ZZBODDEF ( 'Asteroid Frank', 20103456 ) */ - -/* After these calls to ZZBODDEF, ZZBODN2C would return */ -/* the following translations: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'JB' 5 Yes */ -/* 'Jupiter Barycenter' 5 Yes */ -/* 'ASTEROID FRANK' 20103456 Yes */ -/* 'ASTEROIDFRANK' - No */ -/* 'Frank' - No */ - -/* and ZZBODC2N returns these translations: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 5 'JB' Yes */ -/* 20103456 'Asteroid Frank' Yes */ - -/* ZZBODC2N exactly returns the string as used in the */ -/* body name/ID mapping definition. */ - -/* 4) To use an external IDs kernel, simply load via a FURNSH */ -/* call. */ - -/* CALL FURNSH ( 'ids.ker' ) */ - -/* With ids.ker listing data such as: */ - -/* \begintext */ - -/* Define an additional set of body, ID code mappings. */ - -/* \begindata */ - -/* NAIF_BODY_CODE = ( 22, 23, 24, 25 ) */ - -/* NAIF_BODY_NAME = ( 'LARRY', 'MOE', 'CURLEY', 'SHEMP' ) */ - -/* Which maps the names defined in NAIF_BODY_NAME */ -/* to the corresponding index of NAIF_BODY_CODE, i.e. */ -/* LARRY -> 22, MOE -> 23, etc, and the IDs in NAIF_BODY_CODE */ -/* map to the corresponding index of NAIF_BODY_NAME. */ - -/* NOTE: When using an external NAME-ID kernel, all ID codes */ -/* MUST be listed in the kernel variable NAIF_BODY_CODE, and */ -/* all names MUST be listed in the kernel variable */ -/* NAIF_BODY_NAME. */ - -/* 5) Suppose you ran the utility program SPACIT to summarize */ -/* an SPK ephemeris file and the following data was output */ -/* to the terminal screen. */ - -/* ---------------------------------------------------------- */ -/* Segment identifier: JPL archive 21354 */ -/* Body : -77 Center : 399 */ -/* From : 1990 DEC 08 18:00:00.000 */ -/* To : 1990 DEC 10 21:10:00.000 */ -/* Reference : DE-200 SPK Type :1 */ -/* ---------------------------------------------------------- */ - -/* You could write a program to translate the body codes */ -/* shown in the SPACIT output: */ - -/* CALL ZZBODC2N ( -77, BODY, FOUND ) */ -/* CALL ZZBODC2N ( 399, CENTER, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* WRITE ( *,* ) 'BODY: -77 = ', BODY */ -/* WRITE ( *,* ) 'CENTER: 399 = ', CENTER */ - -/* END IF */ - -/* You could also read the body and center codes directly from */ -/* the SPK files, using the appropriate DAF routines, and then */ -/* translate them, as above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.3.0, 05-MAR-2009 (NJB) */ - -/* Bug fixes: the entry points ZZBODN2C, ZZBODC2N, and ZZBODKIK */ -/* now keep track of whether their kernel pool look-ups */ -/* succeeded. If not, a kernel pool lookup is attempted on the */ -/* next call to any entry point that calls ZZBODKER. */ - -/* - SPICELIB Version 4.0.2, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Declarations section. */ - -/* - SPICELIB Version 4.0.1, 17-APR-2003 (EDW) */ - -/* Corrected typo in header docs. */ - -/* - SPICELIB Version 4.0.0, 23-AUG-2002 (FST) */ - -/* Cleaned up ZZBODTRN routine/entry point source code */ -/* and private subroutines used exclusively by ZZBODTRN */ -/* to process name-code mappings. */ - -/* ZZBODLST has been removed from this umbrella and */ -/* added to the ZZBODBLT umbrella. */ - -/* The built-in (permanent collection) of name-code */ -/* mappings has been moved from this umbrella into */ -/* the ZZBODBLT umbrella. The collection is retrieved */ -/* from the entry point ZZBODGET in ZZBODBLT. */ - -/* See the Revisions section below for details. */ - -/* - SPICELIB Version 3.2.0, 14-AUG-2002 (EDW) */ - -/* Added the ZZBODKIK entry point. */ - -/* Moved the NAIF_BODY_NAME/CODE to subroutine */ -/* ZZBODKER. No change in logic. */ - -/* Added logic to enforce the precedence masking; */ -/* logic removes duplicate assignments of ZZBODDEF. */ -/* Removed the NAMENOTUNIQUE error block. */ - -/* - SPICELIB Version 3.1.5, 27-NOV-2001 (EDW) */ - -/* Added to the collection: */ -/* -200 CONTOUR */ -/* -146 LUNAR-A */ -/* -135 DRTS-W */ - -/* Added the subroutine ZZBODLST as an entry point. */ -/* The routine outputs the current name-ID mapping */ -/* list to some output device. */ - -/* - SPICELIB Version 3.1.0, 17-OCT-2001 (EDW) */ - -/* To improve clarity, the BEGXX block initialization now */ -/* exists in the include file zzbodtrn.inc. */ - -/* Removed the comments concerning the 851, 852, ... temporary */ -/* codes. */ - -/* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */ -/* as a DATA statement. */ - -/* Edited headers to match information in naif_ids required */ -/* reading. */ - -/* Edited headers, removed typos and bad grammar, clarified */ -/* descriptions. */ - -/* Added to the collection */ -/* -41 MARS EXPRESS, MEX */ -/* -44 BEAGLE 2, BEAGLE2 */ -/* -70 DEEP IMPACT IMPACTOR SPACECRAFT */ -/* -94 MO, MARS OBSERVER */ -/* -140 DEEP IMPACT FLYBY SPACECRAFT */ -/* -172 SLCOMB, STARLIGHT COMBINER */ -/* -205 SLCOLL, STARLIGHT COLLECTOR */ -/* -253 MER-A */ -/* -254 MER-B */ - -/* Corrected typo, vehicle -188 should properly be MUSES-C, */ -/* previous versions listed the name as MUSES-B. */ - -/* Removed from collection */ -/* -84 MARS SURVEYOR 01 LANDER */ -/* -154 EOS-PM1 */ -/* -200 PLUTO EXPRESS 1, PEX1 */ -/* -202 PLUTO EXPRESS 2, PEX2 */ - -/* - SPICELIB Version 3.0.0, 29-MAR-2000 (WLT) */ - -/* The ID codes for Cluster 1, 2, 3 and 4 were added. The */ -/* ID coded for Pluto Express were removed. The ID codes */ -/* for Pluto-Kuiper Express, Pluto-Kuiper Express Simulation */ -/* and Contour were added. */ - -/* - SPICELIB Version 2.0.0, 26-JAN-1998 (EDW) */ - -/* The Galileo probe ID -228 replaces the incorrect ID -344. */ -/* DSS stations 5 through 65 added to the collection. */ - -/* Added to the collection */ -/* -107 TROPICAL RAINFALL MEASURING MISSION, TRMM */ -/* -154, EOS-PM1 */ -/* -142 EOS-AM1 */ -/* -151 AXAF */ -/* -1 GEOTAIL */ -/* -13 POLAR */ -/* -21 SOHO */ -/* -8 WIND */ -/* -25 LUNAR PROSPECTOR, LPM */ -/* -116 MARS POLAR LANDER, MPL */ -/* -127 MARS CLIMATE ORBITER, MCO */ -/* -188 MUSES-C */ -/* -97 TOPEX/POSEIDON */ -/* -6 PIONEER-6, P6 */ -/* -7 PIONEER-7, P7 */ -/* -20 PIONEER-8, P8 */ -/* -23 PIONEER-10, P10 */ -/* -24 PIONEER-11, P11 */ -/* -178 NOZOMI, PLANET-B */ -/* -79 SPACE INFRARED TELESCOPE FACILITY, SIRTF */ -/* -29 STARDUST, SDU */ -/* -47 GENESIS */ -/* -48 HUBBLE SPACE TELESCOPE, HST */ -/* -200 PLUTO EXPRESS 1, PEX1 */ -/* -202 PLUTO EXPRESS 2, PEX2 */ -/* -164 YOHKOH, SOLAR-A */ -/* -165 MAP */ -/* -166 IMAGE */ -/* -53 MARS SURVEYOR 01 ORBITER */ -/* 618 PAN */ -/* 716 CALIBAN */ -/* 717 SYCORAX */ -/* -30 DS-1 (low priority) */ -/* -58 HALCA */ -/* -150 HUYGEN PROBE, CASP */ -/* -55 ULS */ - -/* Modified ZZBODC2N and ZZBODN2C so the user may load an */ -/* external IDs kernel to override or supplement the standard */ -/* collection. The kernel must be loaded prior a call to */ -/* ZZBODC2N or ZZBODN2C. */ - -/* - SPICELIB Version 1.1.0, 22-MAY-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp, */ -/* Mars 96, Cassini Simulation, MGS Simulation. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed umbrella subroutine and entry points to */ -/* correspond private routine convention (ZZ...). Added IDs for */ -/* tracking stations Goldstone (399001), Canberra (399002), */ -/* Madrid (399003), Usuda (399004). */ - -/* - Beta Version 2.2.0, 01-AUG-1995 (HAN) */ - -/* Added the IDs for Near Earth Asteroid Rendezvous (-93), */ -/* Mars Pathfinder (-53), Ulysses (-55), VSOP (-58), */ -/* Radioastron (-59), Cassini spacecraft (-82), and Cassini */ -/* Huygens probe (-150). */ -/* Mars Observer (-94) was replaced with Mars Global */ -/* Surveyor (-94). */ - -/* - Beta Version 2.1.0, 15-MAR-1995 (KSZ) (HAN) */ - -/* Two Shoemaker Levy 9 fragments were added, Q1 and P2 */ -/* (IDs 50000022 and 50000023). Two asteroids were added, */ -/* Eros and Mathilde (IDs 2000433 and 2000253). The */ -/* Saturnian satellite Pan (ID 618) was added. */ - -/* - Beta Version 2.0.0, 03-FEB-1995 (NJB) */ - -/* The Galileo probe (ID -344) has been added to the permanent */ -/* collection. */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. Also, */ -/* this version does not support reading body name ID pairs from a */ -/* file. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Some items previously considered errors were removed */ -/* and some minor modifications were made to improve the */ -/* robustness of the routines. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.0.0, 23-AUG-2002 (FST) */ - -/* For clarity, some variable names have changed. The */ -/* mappings from the old names to the new are provided */ -/* below: */ - -/* Old New Function */ -/* --- --- -------- */ -/* NAMES DEFNAM Name definition as provided with ZZBODDEF */ -/* NORNAM DEFNOR Normalized name definitions */ -/* CODES DEFCOD Integer codes mapping to entries in DEFNAM */ -/* ORDCOD DEFOCD "Modified" order vector for DEFCOD */ -/* ORDNOM DEFONR Order vector for DEFNOR */ -/* NNAM DEFSIZ Size of DEFNAM, DEFNOR, DEFCOD, and DEFONR */ -/* NCOD DEFOSZ Size of DEFOCD */ - -/* CVALS KERNAM Name definition as provided from pool */ -/* CVLNOM KERNOM Normalized name definitions */ -/* IVALS KERCOD Integer codes mapping to entries in KERNAM */ -/* XORDCD KEROCD "Modified" order vector for KERCOD */ -/* XORNOM KERONR Order vector for KERNOR */ -/* NUM(1) DEFSIZ Size of KERNAM, KERNOR, KERCOD, and KERONR */ -/* NUM(2) DEFOSZ Size of KEROCD */ - -/* The reason for changing the names in this fashion, */ -/* is simply that these are two instances of variables */ -/* that have the same properties and utility. The first */ -/* set implements the ZZBODDEF style mappings, and the */ -/* second implements the kernel pool style mappings. */ - -/* ZZBODDEF now properly signals an error when a caller */ -/* attempts to use it to assign a blank string an ID code. */ -/* This should have never been allowed, but somehow */ -/* slipped by in previous versions. */ - -/* The argument lists for ZZBODKER and ZZBODINI have */ -/* changed as of previous versions. Some arguments */ -/* were removed, as they were no longer necessary. */ - -/* ZZBODINI no longer normalizes the input name array; */ -/* rather it simply computes the order vector for the */ -/* normalized array input and the "modified" order */ -/* vector for the input code array. This was done to */ -/* save from unnecessarily recomputing the normalization */ -/* array. */ - -/* An additional umbrella has been added to the set of */ -/* modules of which ZZBODTRN makes use: ZZBODBLT. This */ -/* umbrella houses the data statements that used to be */ -/* present in this module, which defines the "built-in" */ -/* name-code mappings. These mappings, as of the changes */ -/* in N0053, store the mappings the define the initial */ -/* state of the DEF* arrays. It contains two entry */ -/* points: */ - -/* ZZBODGET retrieve the initial values of DEFNAM, */ -/* DEFNOR, DEFCOD, and DEFSIZ. */ - -/* ZZBODLST dump the "built-in" codes to a device. */ - -/* ZZBODLST used to be present in this umbrella, but the */ -/* creation of ZZBODBLT made moving it there the logical */ -/* choice. */ - -/* The entry point ZZBODRST has been added to the */ -/* ZZBODTRN umbrella. This entry point resets the */ -/* state of the DEF* arrays to their initial values. */ -/* This effectively resets any changes made via the */ -/* ZZBODDEF interface. It does not effect the kernel */ -/* pool mappings. */ - -/* To support ZZBODRST, a logical BODCHG has been added */ -/* to the list of saved variables. This variable */ -/* indicates when ZZBODDEF has been used to change the */ -/* built-in body list. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Save all variables. */ - - -/* Data statements. */ - - switch(n__) { - case 1: goto L_zzbodn2c; - case 2: goto L_zzbodc2n; - case 3: goto L_zzboddef; - case 4: goto L_zzbodkik; - case 5: goto L_zzbodrst; - } - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODTRN", (ftnlen)8); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZBODTRN", (ftnlen)8); - } - return 0; -/* $Procedure ZZBODN2C ( Private --- Body name to code ) */ - -L_zzbodn2c: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Translate a body name to the corresponding SPICE integer code. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER CODE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Body name to be translated. */ -/* CODE O Integer code for that body. */ -/* FOUND O True if translated, otherwise false. */ -/* MAXL P Max name length. */ - -/* $ Detailed_Input */ - -/* NAME is an arbitrary name of a body which could be */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* Case and leading and trailing blanks in a name */ -/* are not significant. However, when a name consists */ -/* of more than one word, they must be separated by */ -/* at least one blank, i.e., all of the following */ -/* strings are equivalent names: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is not equivalent to */ -/* the names above. */ - -/* When ignoring trailing blanks, NAME must have fewer */ -/* than MAXL characters. */ - -/* $ Detailed_Output */ - -/* CODE is the NAIF or user defined integer code for the */ -/* named body. */ - -/* FOUND return as true if NAME has a translation. */ -/* Otherwise, FOUND returns as false. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a body name. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* Errors may be signaled by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ZZBODN2C is one of three related entry points, */ - -/* ZZBODN2C Body name to code */ - -/* ZZBODC2N Body code to name */ - -/* ZZBODDEF Body name/code definition */ - -/* ZZBODN2C and ZZBODC2N perform translations between body names */ -/* and their corresponding integer codes used in SPK and PCK files */ -/* and associated routines. A default set of name/code */ -/* pairs are automatically defined during the first call to */ -/* any of the entry points. Additional name/code pairs may */ -/* be defined via ZZBODDEF. */ - -/* $ Examples */ - -/* See the Examples section of the ZZBODTRN umbrella header. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to any entry */ -/* point that calls ZZBODKER. */ - -/* - SPICELIB Version 4.0.0, 23-AUG-2002 (FST) */ - -/* Cleaned up module header and source. See the Revisions */ -/* section of ZZBODTRN for detailed update information. */ - -/* - SPICELIB Version 3.1.0, 12-FEB-2001 (EDW) */ - -/* Added logic to ensure the routine returns the NAME string */ -/* in the same format as when defined (case and space). */ -/* Added logic to handle error response in ZZBODINI. */ - -/* To improve clarity, the BEGXX block initialization now */ -/* exists in the include file zzbodtrn.inc. */ - -/* Removed the comments concerning the 851, 852, ... temporary */ -/* codes. */ - -/* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */ -/* as a DATA statement. */ - -/* Edited headers, removed typos and bad grammar, clarified */ -/* descriptions. */ - -/* - SPICELIB Version 3.0.0, 29-MAR-2000 (WLT) */ - -/* The ID codes for Cluster 1, 2, 3 and 4 were added. The */ -/* ID coded for Pluto Express were removed. The ID codes */ -/* for Pluto-Kuiper Express, Pluto-Kuiper Express Simulation */ -/* and Contour were added. */ - -/* - SPICELIB Version 2.0.0, 21-JAN-1999 (EDW) */ - -/* Added code to use the external name/ID kernel. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed to ZZBODN2C (BVS) */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Items previously considered errors were downgraded */ -/* to simply be exceptions. Any NAME is a legitimate input now. */ -/* If its not in the table, the FOUND flag is just set to .FALSE. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODN2C", (ftnlen)8); - } - -/* Assume we will not find the code we seek. */ - - *found = FALSE_; - -/* On the first pass through the umbrella's entry point, */ -/* initialize the ZZBODDEF arrays and set the kernel pool */ -/* watchers. */ - - if (first) { - -/* Populate the initial values of the DEFNAM, DEFNOR, */ -/* and DEFCOD arrays from the built-in code list. */ - - zzbodget_(&c__713, defnam, defnor, defcod, &defsiz, (ftnlen)36, ( - ftnlen)36); - -/* ZZBODGET may signal an error if the toolkit is improperly */ -/* configured. Check FAILED() and return if this occurs. */ - - if (failed_()) { - chkout_("ZZBODN2C", (ftnlen)8); - return 0; - } - -/* Produce the initial order ZZBODDEF order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - -/* Set up the watchers for the kernel pool name-code mapping */ -/* variables. */ - - nwatch = 2; - swpool_("ZZBODTRN", &nwatch, wnames, (ftnlen)8, (ftnlen)32); - -/* SWPOOL may signal an error if any difficulties arise in */ -/* setting the watcher. Check FAILED() and return if this */ -/* occurs. */ - - if (failed_()) { - chkout_("ZZBODN2C", (ftnlen)8); - return 0; - } - -/* Set FIRST to .FALSE., so this initialization block is */ -/* not repeated. */ - - first = FALSE_; - } - -/* Check for updates to the kernel pool variables. Note: */ -/* the first call to CVPOOL after initialization always returns */ -/* .TRUE. for UPDATE. This ensures that any initial */ -/* assignments are properly processed. */ - - cvpool_("ZZBODTRN", &update, (ftnlen)8); - if (update || nodata) { - zzbodker_(kernam, kernor, kercod, &kersiz, keronr, kerocd, &kerosz, & - extker, (ftnlen)36, (ftnlen)36); - if (failed_()) { - nodata = TRUE_; - chkout_("ZZBODN2C", (ftnlen)8); - return 0; - } - nodata = FALSE_; - } - -/* Compute the canonical member of the equivalence class */ -/* for the input argument NAME. This will enable a quick */ -/* search through KERNOR and DEFNOR to locate the desired */ -/* code. */ - - ljust_(name__, tmpnam, name_len, (ftnlen)36); - ucase_(tmpnam, tmpnam, (ftnlen)36, (ftnlen)36); - cmprss_(" ", &c__1, tmpnam, tmpnam, (ftnlen)1, (ftnlen)36, (ftnlen)36); - -/* If necessary, first examine the contents of the kernel pool */ -/* name-code mapping list. */ - - if (extker) { - i__ = bschoc_(tmpnam, &kersiz, kernor, keronr, (ftnlen)36, (ftnlen)36) - ; - -/* If we obtained a match, copy the relevant code to the */ -/* output argument and return. */ - - if (i__ != 0) { - *code = kercod[(i__1 = i__ - 1) < 2000 && 0 <= i__1 ? i__1 : - s_rnge("kercod", i__1, "zzbodtrn_", (ftnlen)1043)]; - *found = TRUE_; - chkout_("ZZBODN2C", (ftnlen)8); - return 0; - } - } - -/* If we reach here, either the kernel pool mapping list was */ -/* blank or there was no mapping that matched. Check the */ -/* ZZBODDEF mappings for a match. */ - - i__ = bschoc_(tmpnam, &defsiz, defnor, defonr, (ftnlen)36, (ftnlen)36); - if (i__ != 0) { - *code = defcod[(i__1 = i__ - 1) < 713 && 0 <= i__1 ? i__1 : s_rnge( - "defcod", i__1, "zzbodtrn_", (ftnlen)1059)]; - *found = TRUE_; - } - chkout_("ZZBODN2C", (ftnlen)8); - return 0; -/* $Procedure ZZBODC2N ( Private --- Body code to name ) */ - -L_zzbodc2n: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Translate the integer code of a body into a common name for */ -/* that body. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ - -/* INTEGER CODE */ -/* CHARACTER*(*) NAME */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CODE I Integer code to be translated. */ -/* NAME O Common name for the body identified by CODE. */ -/* FOUND O True if translated, otherwise false. */ -/* MAXL P Max name length. */ - -/* $ Detailed_Input */ - -/* CODE is an integer code for a body --- */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* $ Detailed_Output */ - -/* NAME is the common name of the body identified by CODE. */ -/* If CODE has more than one translation, then the */ -/* most recently defined NAME corresponding to CODE */ -/* is returned. The routine returns NAME in the exact */ -/* format (case and blanks) as used when defining */ -/* the name/code pair. */ - -/* FOUND returns as true if NAME has a translation. */ -/* Otherwise, FOUND returns as false. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a body name. Defined in */ -/* the include file 'zzbodtrn.inc'. */ -/* $ Exceptions */ - -/* Errors may be signaled by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ZZBODC2N is one of three related entry points, */ - -/* ZZBODN2C Body name to code */ - -/* ZZBODC2N Body code to name */ - -/* ZZBODDEF Body name/code definition */ - -/* ZZBODN2C and ZZBODC2N perform translations between body names */ -/* and their corresponding integer codes used in SPK and PCK files */ -/* and associated routines. A default set of name/code */ -/* pairs are automatically defined during the first call to */ -/* any of the entry points. Additional name/code pairs may */ -/* be defined via ZZBODDEF. */ - -/* For the case in which multiple names map to a single code, a */ -/* ZZBODC2N call returns the name last assigned to that code - a */ -/* LIFO situation. */ - -/* $ Examples */ - -/* See Examples section of ZZBODTRN umbrella header. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to any entry */ -/* point that calls ZZBODKER. */ - -/* - SPICELIB Version 4.0.0, 23-AUG-2002 (FST) */ - -/* Cleaned up module header and source code. See the Revisions */ -/* section of ZZBODTRN for detailed update information. */ - -/* - SPICELIB Version 3.2.0, 19-JUL-2002 (EDW) */ - -/* Added logic to enforce the precedence masking. */ - -/* - SPICELIB Version 3.1.0, 5-SEP-2001 (EDW) */ - -/* Added logic to ensure the routine returns the NAME string */ -/* in the same format as when defined (case and space). */ -/* Added logic to handle error response in ZZBODINI. */ - -/* To improve clarity, the BEGXX block initialization now */ -/* exists in the include file zzbodtrn.inc. */ - -/* Removed the comments concerning the 851, 852, ... temporary */ -/* codes. */ - -/* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */ -/* as a DATA statement. */ - -/* Edited headers, removed typos and bad grammar, clarified */ -/* descriptions. */ - -/* - SPICELIB Version 3.0.0, 29-MAR-2000 (WLT) */ - -/* The ID codes for Cluster 1, 2, 3 and 4 were added. The */ -/* ID coded for Pluto Express were removed. The ID codes */ -/* for Pluto-Kuiper Express, Pluto-Kuiper Express Simulation */ -/* and Contour were added. */ - -/* - SPICELIB Version 2.0.0, 21-JAN-1999 (EDW) */ - -/* Added code to use the external name/ID kernel. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed to ZZBODC2N (BVS) */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Checks to see the input integer code can be represented */ -/* as a character string were removed along with the exceptions */ -/* associated with these checks. It is now the responsibility */ -/* of a maintenance programmer to make sure MAXL is large */ -/* enough to allow any integer to be converted to a string */ -/* representation. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODC2N", (ftnlen)8); - } - -/* Assume we will not find the name we seek. */ - - *found = FALSE_; - -/* On the first pass through the umbrella's entry point, */ -/* initialize the ZZBODDEF arrays and set the kernel pool */ -/* watchers. */ - - if (first) { - -/* Populate the initial values of the DEFNAM, DEFNOR, */ -/* and DEFCOD arrays from the built-in code list. */ - - zzbodget_(&c__713, defnam, defnor, defcod, &defsiz, (ftnlen)36, ( - ftnlen)36); - -/* ZZBODGET may signal an error if the toolkit is improperly */ -/* configured. Check FAILED() and return if this occurs. */ - - if (failed_()) { - chkout_("ZZBODC2N", (ftnlen)8); - return 0; - } - -/* Produce the initial order ZZBODDEF order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - -/* Set up the watchers for the kernel pool name-code mapping */ -/* variables. */ - - nwatch = 2; - swpool_("ZZBODTRN", &nwatch, wnames, (ftnlen)8, (ftnlen)32); - -/* SWPOOL may signal an error if any difficulties arise in */ -/* setting the watcher. Check FAILED() and return if this */ -/* occurs. */ - - if (failed_()) { - chkout_("ZZBODC2N", (ftnlen)8); - return 0; - } - -/* Set FIRST to .FALSE., so this initialization block is */ -/* not repeated. */ - - first = FALSE_; - } - -/* Check for updates to the kernel pool variables. Note: */ -/* the first call to CVPOOL after initialization always returns */ -/* .TRUE. for UPDATE. This ensures that any initial */ -/* assignments are properly processed. */ - - cvpool_("ZZBODTRN", &update, (ftnlen)8); - if (update || nodata) { - zzbodker_(kernam, kernor, kercod, &kersiz, keronr, kerocd, &kerosz, & - extker, (ftnlen)36, (ftnlen)36); - if (failed_()) { - nodata = TRUE_; - chkout_("ZZBODC2N", (ftnlen)8); - return 0; - } - nodata = FALSE_; - } - -/* If necessary, first examine the contents of the kernel pool */ -/* name-code mapping list. */ - - if (extker) { - -/* Search the list of codes, KERCOD, using the */ -/* modified order vector KEROCD. */ - - i__ = bschoi_(code, &kerosz, kercod, kerocd); - -/* If we obtained a match, copy the original name to the */ -/* output argument and return. */ - - if (i__ != 0) { - s_copy(name__, kernam + ((i__1 = i__ - 1) < 2000 && 0 <= i__1 ? - i__1 : s_rnge("kernam", i__1, "zzbodtrn_", (ftnlen)1401)) - * 36, name_len, (ftnlen)36); - *found = TRUE_; - chkout_("ZZBODC2N", (ftnlen)8); - return 0; - } - } - -/* If we reach here, either the kernel pool mapping list was */ -/* blank or there was no mapping that matched. Check the */ -/* ZZBODDEF mappings for a match. */ - - i__ = bschoi_(code, &defosz, defcod, defocd); - -/* If we find a match, verify that it is not masked by */ -/* a kernel pool entry before returning. */ - - if (i__ != 0) { - if (extker) { - -/* Only bother performing this check if there are actually */ -/* mappings present in the kernel pool lists. */ - - ljust_(defnam + ((i__1 = i__ - 1) < 713 && 0 <= i__1 ? i__1 : - s_rnge("defnam", i__1, "zzbodtrn_", (ftnlen)1428)) * 36, - tmpnam, (ftnlen)36, (ftnlen)36); - ucase_(tmpnam, tmpnam, (ftnlen)36, (ftnlen)36); - cmprss_(" ", &c__1, tmpnam, tmpnam, (ftnlen)1, (ftnlen)36, ( - ftnlen)36); - j = bschoc_(tmpnam, &kersiz, kernor, keronr, (ftnlen)36, (ftnlen) - 36); - if (j != 0) { - -/* If a match has occurred, then set FOUND to .FALSE., */ -/* as the contents of the kernel pool have higher */ -/* precedence than any entries in the ZZBODDEF mapping */ -/* list. */ - - *found = FALSE_; - } else { - -/* No match for DEFNAM(I) in the kernel pool mapping list. */ -/* Return the name. */ - - s_copy(name__, defnam + ((i__1 = i__ - 1) < 713 && 0 <= i__1 ? - i__1 : s_rnge("defnam", i__1, "zzbodtrn_", (ftnlen) - 1450)) * 36, name_len, (ftnlen)36); - *found = TRUE_; - } - } else { - -/* No kernel pool mappings were defined, simply return */ -/* return the name. */ - - s_copy(name__, defnam + ((i__1 = i__ - 1) < 713 && 0 <= i__1 ? - i__1 : s_rnge("defnam", i__1, "zzbodtrn_", (ftnlen)1461)) - * 36, name_len, (ftnlen)36); - *found = TRUE_; - } - } - chkout_("ZZBODC2N", (ftnlen)8); - return 0; -/* $Procedure ZZBODDEF ( Private --- Body name/code definition ) */ - -L_zzboddef: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Define a body name/code pair for later translation by */ -/* ZZBODN2C or ZZBODC2N. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER CODE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Common name of some body. */ -/* CODE I Integer code for that body. */ -/* MAXL P Max name length and max number of digits in code. */ -/* MAXP P Maximum number of name/code pair definitions. */ - -/* $ Detailed_Input */ - -/* NAME is an arbitrary name of a body which could be */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* The case and positions of blanks in a name */ -/* are significant. ZZBODC2N returns the exact */ -/* string (case and space) last mapped to a code. */ -/* When a name is made up of more than one word, */ -/* the words require separation by at least one blank, */ -/* i.e., all of the following strings belong to */ -/* the same equivalence class: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is not equivalent to */ -/* the names above. */ - -/* When ignoring trailing blanks, NAME must have fewer */ -/* than MAXL characters. */ - -/* CODE is the integer code for the named body. */ - -/* CODE may already have a name as defined by a */ -/* previous call to ZZBODDEF or as part of the set of */ -/* default definitions. That previous definition */ -/* remains and a translation of that name still */ -/* returns the same CODE. However, future translations */ -/* of CODE will give the new NAME instead of the */ -/* previous one. This feature is useful for assigning */ -/* a more familiar or abbreviated name to a body. */ -/* For example, in addition to the default name for */ -/* body 5, 'JUPITER BARYCENTER', you could define the */ -/* abbreviation 'JB' to mean 5. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a body name. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* MAXP is the maximum number of additional names that may */ -/* be added via the ZZBODDEF interface. Defined in */ -/* the include file 'zzbodtrn.inc'. */ - -/* $ Exceptions */ - -/* 1) If the maximum number of definitions is exceeded, a the */ -/* error SPICE(TOOMANYPAIRS) is signaled. */ - -/* 2) If an attempt to assign a blank string an ID code is made, */ -/* the error SPICE(BLANKNAMEASSIGNED) is signaled. */ - -/* 3) Routines in the call tree of this routine may signal */ -/* errors. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ZZBODDEF is one of three related entry points, */ - -/* ZZBODN2C Body name to code */ - -/* ZZBODC2N Body code to name */ - -/* ZZBODDEF Body name/code definition */ - -/* ZZBODN2C and ZZBODC2N perform translations between body names */ -/* and their corresponding integer codes used in SPK and PCK files */ -/* and associated routines. A default set of name/code */ -/* pairs are automatically defined during the first call to */ -/* any of the entry points. Additional name/code pairs may */ -/* be defined via ZZBODDEF for two purposes: */ - -/* 1. to associate another, perhaps more familiar or */ -/* abbreviated name with a previously defined body integer */ -/* code or */ - -/* 2. to define a new body integer code and name, */ - -/* Each body has a unique integer code, but may have several */ -/* names. Thus you may associate more than one name with */ -/* a particular integer code. However, associating more */ -/* than one integer code with a particular name creates ambiguity. */ -/* Therefore, once a name has been defined, it may not be redefined */ -/* with a different integer code. */ - -/* For example, Europa is the name of the second satellite of */ -/* Jupiter, and has the NAIF integer code 502. Thus (EUROPA, 502) */ -/* is one of the default definitions. Europa is also the name */ -/* of an asteroid. Suppose you were able to associate the asteroid */ -/* integer code with the name EUROPA. Then when you call ZZBODN2C to */ -/* translate the name EUROPA, which code should be returned? That */ -/* of the asteroid or 502? */ - -/* ZZBODDEF prevents this ambiguity by signalling an error */ -/* if the specified name has already been defined with a */ -/* different code. In the case of EUROPA, you may want to use the */ -/* name ASTEROID EUROPA. The set of default definitions are listed */ -/* in DATA statements in the umbrella routine ZZBODTRN for easy */ -/* reference. */ - -/* $ Examples */ - -/* See the Examples section of the ZZBODTRN umbrella header. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.1, 17-APR-2003 (EDW) */ - -/* Correct typo in header docs. */ - -/* SPICELIB Version 4.0.0, 23-AUG-2002 (FST) */ - -/* Cleaned up module header and source code. See the Revisions */ -/* section of ZZBODTRN for detailed update information. */ - -/* Added the error SPICE(BLANKNAMEASSIGNED), when the caller */ -/* attempts to assign an ID code to a blank string. */ - -/* - SPICELIB Version 1.3.0, 14-AUG-2002 (EDW) */ - -/* Added logic to enforce the precedence masking; */ -/* logic removes duplicate assignments of ZZBODDEF. */ -/* Removed the NAMENOTUNIQUE error block. */ - -/* - SPICELIB Version 1.2.0, 5-SEP-2001 (EDW) */ - -/* Added logic to ensure the routine returns the NAME string */ -/* in the same format as when defined (case and space). */ -/* Added logic to handle error response from ZZBODINI. */ - -/* To improve clarity, the BEGXX block initialization now */ -/* exists in the include file zzbodtrn.inc. */ - -/* Removed the comments concerning the 851, 852, ... temporary */ -/* codes. */ - -/* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */ -/* as a DATA statement. */ - -/* Edited headers, removed typos and bad grammar, clarified */ -/* descriptions. */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed to ZZBODDEF (BVS). More careful checking for overflow */ -/* of the recognized names is now performed. */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Checks to see an integer code can be represented */ -/* as a character string were removed along with the exceptions */ -/* associated with these checks. It is now the responsibility */ -/* of a maintenance programmer to make sure MAXL is large */ -/* enough to allow any integer to be converted to a string */ -/* representation. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODDEF", (ftnlen)8); - } - -/* On the first pass through the umbrella's entry point, */ -/* initialize the ZZBODDEF arrays and set the kernel pool */ -/* watchers. */ - - if (first) { - -/* Populate the initial values of the DEFNAM, DEFNOR, */ -/* and DEFCOD arrays from the built-in code list. */ - - zzbodget_(&c__713, defnam, defnor, defcod, &defsiz, (ftnlen)36, ( - ftnlen)36); - -/* ZZBODGET may signal an error if the toolkit is improperly */ -/* configured. Check FAILED() and return if this occurs. */ - - if (failed_()) { - chkout_("ZZBODDEF", (ftnlen)8); - return 0; - } - -/* Produce the initial order ZZBODDEF order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - -/* Set up the watchers for the kernel pool name-code mapping */ -/* variables. */ - - nwatch = 2; - swpool_("ZZBODTRN", &nwatch, wnames, (ftnlen)8, (ftnlen)32); - -/* SWPOOL may signal an error if any difficulties arise in */ -/* setting the watcher. Check FAILED() and return if this */ -/* occurs. */ - - if (failed_()) { - chkout_("ZZBODDEF", (ftnlen)8); - return 0; - } - -/* Set FIRST to .FALSE., so this initialization block is */ -/* not repeated. */ - - first = FALSE_; - } - -/* Begin by verifying that the user is not attempting to assign */ -/* a blank string a code. */ - - if (s_cmp(name__, " ", name_len, (ftnlen)1) == 0) { - setmsg_("An attempt to assign the code, #, to a blank string was mad" - "e. Check loaded text kernels for a blank string in the NAIF" - "_BODY_NAME array.", (ftnlen)136); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BLANKNAMEASSIGNED)", (ftnlen)24); - chkout_("ZZBODDEF", (ftnlen)8); - return 0; - } - -/* Compute the normalization of NAME. This will allow simple */ -/* searches through the existing mapping list. */ - - ljust_(name__, tmpnam, name_len, (ftnlen)36); - ucase_(tmpnam, tmpnam, (ftnlen)36, (ftnlen)36); - cmprss_(" ", &c__1, tmpnam, tmpnam, (ftnlen)1, (ftnlen)36, (ftnlen)36); - -/* Determine if we are going to replace an entry currently */ -/* present in the DEF* lists. */ - - index = bschoc_(tmpnam, &defsiz, defnor, defonr, (ftnlen)36, (ftnlen)36); - if (index != 0) { - -/* We are going to replace an existing entry. There are */ -/* two possible ways in which a replace operation can */ -/* happen: */ - -/* 1) The caller is attempting to replace the highest */ -/* precedent name-code mapping for a particular */ -/* ID code. When this happens, we need only change */ -/* the entry in DEFNAM at position INDEX. The user */ -/* is simply changing the name. */ - -/* 2) The caller is attempting to change the code */ -/* associated with a name, bump a lower precedence */ -/* name-code mapping to highest precedence, or some */ -/* combination of the two. */ - -/* See if we should handle 1) first. */ - - codidx = bschoi_(code, &defosz, defcod, defocd); - -/* If CODIDX matches INDEX, then we simply have to replace */ -/* the entry in DEFNAM and return. */ - - if (codidx == index) { - -/* We altered the built-in body list. Set BODCHG to */ -/* .TRUE. */ - - bodchg = TRUE_; - s_copy(defnam + ((i__1 = index - 1) < 713 && 0 <= i__1 ? i__1 : - s_rnge("defnam", i__1, "zzbodtrn_", (ftnlen)1872)) * 36, - name__, (ftnlen)36, name_len); - chkout_("ZZBODDEF", (ftnlen)8); - return 0; - } - -/* At this point we have to replace all of the values */ -/* for the mapping defined at the INDEX position in */ -/* DEFNAM, DEFNOR, and DEFCOD. This will require */ -/* recomputing the order vectors. First compress */ -/* out the existing entry. */ - - i__1 = defsiz; - for (i__ = index + 1; i__ <= i__1; ++i__) { - s_copy(defnam + ((i__2 = i__ - 2) < 713 && 0 <= i__2 ? i__2 : - s_rnge("defnam", i__2, "zzbodtrn_", (ftnlen)1888)) * 36, - defnam + ((i__3 = i__ - 1) < 713 && 0 <= i__3 ? i__3 : - s_rnge("defnam", i__3, "zzbodtrn_", (ftnlen)1888)) * 36, ( - ftnlen)36, (ftnlen)36); - s_copy(defnor + ((i__2 = i__ - 2) < 713 && 0 <= i__2 ? i__2 : - s_rnge("defnor", i__2, "zzbodtrn_", (ftnlen)1889)) * 36, - defnor + ((i__3 = i__ - 1) < 713 && 0 <= i__3 ? i__3 : - s_rnge("defnor", i__3, "zzbodtrn_", (ftnlen)1889)) * 36, ( - ftnlen)36, (ftnlen)36); - defcod[(i__2 = i__ - 2) < 713 && 0 <= i__2 ? i__2 : s_rnge("defc" - "od", i__2, "zzbodtrn_", (ftnlen)1890)] = defcod[(i__3 = - i__ - 1) < 713 && 0 <= i__3 ? i__3 : s_rnge("defcod", - i__3, "zzbodtrn_", (ftnlen)1890)]; - } - } else { - -/* We need to add this entry to the list. See if there */ -/* is room; signal an error and return if there is not. */ - - if (defsiz >= 713) { - setmsg_("There is no room available for adding '#' to the list " - "of name/code pairs. The number of names that can be supp" - "orted is #. This number has been reached. ", (ftnlen)154) - ; - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &defsiz, (ftnlen)1); - sigerr_("SPICE(TOOMANYPAIRS)", (ftnlen)19); - chkout_("ZZBODDEF", (ftnlen)8); - return 0; - } - -/* If we reach here, then there is room in the list. */ -/* Increase it's size counter. */ - - ++defsiz; - } - -/* We are changing the body list, inform ZZBODRST by setting BODCHG */ -/* to .TRUE. */ - - bodchg = TRUE_; - -/* Now, we need to add the new entry on to the end of the */ -/* DEFNAM, DEFNOR, and DEFCOD lists. */ - - s_copy(defnam + ((i__1 = defsiz - 1) < 713 && 0 <= i__1 ? i__1 : s_rnge( - "defnam", i__1, "zzbodtrn_", (ftnlen)1933)) * 36, name__, (ftnlen) - 36, name_len); - s_copy(defnor + ((i__1 = defsiz - 1) < 713 && 0 <= i__1 ? i__1 : s_rnge( - "defnor", i__1, "zzbodtrn_", (ftnlen)1934)) * 36, tmpnam, (ftnlen) - 36, (ftnlen)36); - defcod[(i__1 = defsiz - 1) < 713 && 0 <= i__1 ? i__1 : s_rnge("defcod", - i__1, "zzbodtrn_", (ftnlen)1935)] = *code; - -/* Compute the new order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - chkout_("ZZBODDEF", (ftnlen)8); - return 0; -/* $Procedure ZZBODKIK ( Private --- Run the kernel read block ) */ - -L_zzbodkik: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine executes the kernel pool read instructions */ -/* if necessary. */ - -/* $ 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 */ - -/* BODY MAPPING */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* None. */ - -/* $ Detailed_Input */ - -/* NONE. */ - -/* $ Detailed_Output */ - -/* NONE. */ - -/* $ Parameters */ - -/* NONE. */ - -/* $ Exceptions */ - -/* NONE. */ - -/* $ Files */ - -/* NONE. */ - -/* $ Particulars */ - -/* This entry point provides a mechanism to allow a caller */ -/* to force the examination of the kernel pool variables that */ -/* define name-code mappings. This is useful, if once a new */ -/* mapping is defined, diagnostics at the time of definition */ -/* are useful. The way the system performs otherwise, the */ -/* diagnostics are not provided until a name-code conversion */ -/* is attempted. */ - -/* $ Examples */ - -/* See ZZLDKER for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 05-MAR-2009 (NJB) */ - -/* Bug fix: this routine now keeps track of whether its */ -/* kernel pool look-up succeeded. If not, a kernel pool */ -/* lookup is attempted on the next call to any entry */ -/* point that calls ZZBODKER. */ - -/* - SPICELIB Version 4.0.2, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Declarations section. */ - -/* - SPICELIB Version 4.0.0, 23-AUG-2002 (FST) */ - -/* Added checks to watchers and the initialization */ -/* block. */ - -/* - SPICELIB Version 1.0.0, 16-JUN-2002 (EDW) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODKIK", (ftnlen)8); - } - -/* On the first pass through the umbrella's entry point, */ -/* initialize the ZZBODDEF arrays and set the kernel pool */ -/* watchers. */ - - if (first) { - -/* Populate the initial values of the DEFNAM, DEFNOR, */ -/* and DEFCOD arrays from the built-in code list. */ - - zzbodget_(&c__713, defnam, defnor, defcod, &defsiz, (ftnlen)36, ( - ftnlen)36); - -/* ZZBODGET may signal an error if the toolkit is improperly */ -/* configured. Check FAILED() and return if this occurs. */ - - if (failed_()) { - chkout_("ZZBODKIK", (ftnlen)8); - return 0; - } - -/* Produce the initial order ZZBODDEF order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - -/* Set up the watchers for the kernel pool name-code mapping */ -/* variables. */ - - nwatch = 2; - swpool_("ZZBODTRN", &nwatch, wnames, (ftnlen)8, (ftnlen)32); - -/* SWPOOL may signal an error if any difficulties arise in */ -/* setting the watcher. Check FAILED() and return if this */ -/* occurs. */ - - if (failed_()) { - chkout_("ZZBODKIK", (ftnlen)8); - return 0; - } - -/* Set FIRST to .FALSE., so this initialization block is */ -/* not repeated. */ - - first = FALSE_; - } - -/* Check for updates to the kernel pool variables. Note: */ -/* the first call to CVPOOL after initialization always */ -/* returns .TRUE. for UPDATE. This ensures that any */ -/* initial assignments are properly processed. */ - - cvpool_("ZZBODTRN", &update, (ftnlen)8); - if (update || nodata) { - zzbodker_(kernam, kernor, kercod, &kersiz, keronr, kerocd, &kerosz, & - extker, (ftnlen)36, (ftnlen)36); - if (failed_()) { - nodata = TRUE_; - chkout_("ZZBODKIK", (ftnlen)8); - return 0; - } - nodata = FALSE_; - } - chkout_("ZZBODKIK", (ftnlen)8); - return 0; -/* $Procedure ZZBODRST ( Private --- Body List Reset ) */ - -L_zzbodrst: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine resets the built-in body list, removing any */ -/* assignments or alterations made by the ZZBODDEF entry point. */ - -/* $ 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 */ - -/* BODY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Routines in the call tree of this routine may signal errors. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* ZZBODRST resets the built-in body name-code mapping list. This */ -/* list may only be modified by ZZBODDEF. Further, any assignments */ -/* made through the kernel pool mechanism remain unaltered as a */ -/* result of invoking this routine. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.0.0, 26-AUG-2002 (FST) */ - - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODRST", (ftnlen)8); - } - -/* On the first pass through the umbrella's entry point, */ -/* initialize the ZZBODDEF arrays and set the kernel pool */ -/* watchers. */ - - if (first) { - -/* Populate the initial values of the DEFNAM, DEFNOR, */ -/* and DEFCOD arrays from the built-in code list. */ - - zzbodget_(&c__713, defnam, defnor, defcod, &defsiz, (ftnlen)36, ( - ftnlen)36); - -/* ZZBODGET may signal an error if the toolkit is improperly */ -/* configured. Check FAILED() and return if this occurs. */ - - if (failed_()) { - chkout_("ZZBODRST", (ftnlen)8); - return 0; - } - -/* Produce the initial order ZZBODDEF order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - -/* Set up the watchers for the kernel pool name-code mapping */ -/* variables. */ - - nwatch = 2; - swpool_("ZZBODTRN", &nwatch, wnames, (ftnlen)8, (ftnlen)32); - -/* SWPOOL may signal an error if any difficulties arise in */ -/* setting the watcher. Check FAILED() and return if this */ -/* occurs. */ - - if (failed_()) { - chkout_("ZZBODRST", (ftnlen)8); - return 0; - } - -/* Set FIRST to .FALSE., so this initialization block is */ -/* not repeated. */ - - first = FALSE_; - } - -/* See if the body list needs to be reset. */ - - if (bodchg) { - bodchg = FALSE_; - -/* Fetch the initial body name-code mapping list. Note: */ -/* we need not check FAILED() here, because if an error */ -/* had occurred due to the improper specification of MAXE */ -/* it would have been signaled already to the user. */ - - zzbodget_(&c__713, defnam, defnor, defcod, &defsiz, (ftnlen)36, ( - ftnlen)36); - -/* Prepare the order vectors. */ - - zzbodini_(defnam, defnor, defcod, &defsiz, defonr, defocd, &defosz, ( - ftnlen)36, (ftnlen)36); - } - chkout_("ZZBODRST", (ftnlen)8); - return 0; -} /* zzbodtrn_ */ - -/* Subroutine */ int zzbodtrn_(char *name__, integer *code, logical *found, - ftnlen name_len) -{ - return zzbodtrn_0_(0, name__, code, found, name_len); - } - -/* Subroutine */ int zzbodn2c_(char *name__, integer *code, logical *found, - ftnlen name_len) -{ - return zzbodtrn_0_(1, name__, code, found, name_len); - } - -/* Subroutine */ int zzbodc2n_(integer *code, char *name__, logical *found, - ftnlen name_len) -{ - return zzbodtrn_0_(2, name__, code, found, name_len); - } - -/* Subroutine */ int zzboddef_(char *name__, integer *code, ftnlen name_len) -{ - return zzbodtrn_0_(3, name__, code, (logical *)0, name_len); - } - -/* Subroutine */ int zzbodkik_(void) -{ - return zzbodtrn_0_(4, (char *)0, (integer *)0, (logical *)0, (ftnint)0); - } - -/* Subroutine */ int zzbodrst_(void) -{ - return zzbodtrn_0_(5, (char *)0, (integer *)0, (logical *)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzbodvcd.c b/ext/spice/src/cspice/zzbodvcd.c deleted file mode 100644 index 22739e1116..0000000000 --- a/ext/spice/src/cspice/zzbodvcd.c +++ /dev/null @@ -1,282 +0,0 @@ -/* zzbodvcd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure ZZBODVCD ( Return d.p. values from the kernel pool ) */ -/* Subroutine */ int zzbodvcd_(integer *bodyid, char *item, integer *maxn, - integer *dim, doublereal *values, ftnlen item_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char code[16], type__[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - char varnam[32]; - extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer - *, doublereal *, logical *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), dtpool_(char *, logical *, integer *, - char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Fetch from the kernel pool the double precision values */ -/* of an item associated with a body. Use an integer ID code */ -/* rather than name to identify the body of interest. */ - -/* $ 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 */ - -/* KERNEL */ -/* NAIF_IDS */ - -/* $ Keywords */ - -/* PRIVATE */ -/* CONSTANTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODYID I Body ID code. */ -/* ITEM I Item for which values are desired. ('RADII', */ -/* 'NUT_PREC_ANGLES', etc. ) */ -/* MAXN I Maximum number of values that may be returned. */ -/* DIM O Number of values returned. */ -/* VALUES O Values. */ - -/* $ Detailed_Input */ - -/* BODYID is the NAIF ID code of the body for which ITEM is */ -/* requested. */ - -/* ITEM is the item to be returned. Together, the NAIF ID */ -/* code of the body and the item name combine to form a */ -/* variable name, e.g., */ - -/* 'BODY599_RADII' */ -/* 'BODY401_POLE_RA' */ - -/* Note that ITEM *is* case-sensitive. */ - -/* MAXN is the maximum number of values that may be */ -/* returned. The output array VALUES should be */ -/* declared with size at least MAXN. */ - -/* $ Detailed_Output */ - -/* DIM is the number of values associated with the variable. */ - -/* VALUES are the values associated with the variable. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the requested item is not found in the kernel pool, */ -/* the error SPICE(KERNELVARNOTFOUND) is signaled. */ - -/* 2) If the requested item is found but the associated values */ -/* aren't numeric, the error SPICE(TYPEMISMATCH) is signaled. */ - -/* 3) If there's not enough room in the output array to capture */ -/* the requested values, the error SPICE(ARRAYTOOSMALL) is */ -/* signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simplifies looking up PCK kernel variables by */ -/* constructing the kernel variable names and performing */ -/* error checking. */ - -/* For cases where it's not an error if the requested variable */ -/* is not present in the kernel pool, or for cases where the */ -/* data array associated with the kernel variable is too large */ -/* to fetch in one shot, use the lower-level routine GDPOOL. */ - -/* $ Examples */ - -/* 1) When the kernel variable */ - -/* BODY399_RADII */ - -/* is present in the kernel pool---normally because a PCK */ -/* defining this variable has been loaded---the call */ - -/* CALL ZZBODVCD ( 399, 'RADII', 3, DIM, VALUE ) */ - -/* returns the dimension and values associated with the variable */ -/* 'BODY399_RADII', for example, */ - -/* DIM = 3 */ -/* VALUE(1) = 6378.140 */ -/* VALUE(2) = 6378.140 */ -/* VALUE(3) = 6356.755 */ - -/* 2) The call */ - -/* CALL ZZBODVCD ( 399, 'radii', 3, DIM, VALUE ) */ - -/* usually will cause a SPICE(KERNELVARNOTFOUND) error to be */ -/* signaled, because this call will attempt to look up the */ -/* values associated with a kernel variable of the name */ - -/* BODY399_radii */ - -/* Since kernel variable names are case sensitive, this */ -/* name is not considered to match the name */ - -/* BODY399_RADII */ - -/* which normally would be present after a text PCK */ -/* containing data for all planets and satellites has */ -/* been loaded. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-FEB-2004 (NJB) (BVS) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch constants for a body from the kernel pool */ -/* physical constants for a body */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZBODVCD", (ftnlen)8); - } - -/* Construct the variable name from BODY and ITEM. */ - - s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4); - intstr_(bodyid, code, (ftnlen)16); - suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32); - suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32); - suffix_(item, &c__0, varnam, item_len, (ftnlen)32); - -/* Make sure the item is present in the kernel pool. */ - - dtpool_(varnam, &found, dim, type__, (ftnlen)32, (ftnlen)1); - if (! found) { - setmsg_("The variable # could not be found in the kernel pool.", ( - ftnlen)53); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZBODVCD", (ftnlen)8); - return 0; - } - -/* Make sure the item's data type is numeric. */ - - if (*(unsigned char *)type__ != 'N') { - setmsg_("The data associated with variable # are not of numeric type." - , (ftnlen)60); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZBODVCD", (ftnlen)8); - return 0; - } - -/* Make sure there's enough room in the array VALUES to hold */ -/* the requested data. */ - - if (*maxn < *dim) { - setmsg_("The data array associated with variable # has dimension #, " - "which is larger than the available space # in the output arr" - "ay.", (ftnlen)122); - errch_("#", varnam, (ftnlen)1, (ftnlen)32); - errint_("#", dim, (ftnlen)1); - errint_("#", maxn, (ftnlen)1); - sigerr_("SPICE(ARRAYTOOSMALL)", (ftnlen)20); - chkout_("ZZBODVCD", (ftnlen)8); - return 0; - } - -/* Grab the values. We know at this point they're present in */ -/* the kernel pool, so we don't check the FOUND flag. */ - - gdpool_(varnam, &c__1, maxn, dim, values, &found, (ftnlen)32); - chkout_("ZZBODVCD", (ftnlen)8); - return 0; -} /* zzbodvcd_ */ - diff --git a/ext/spice/src/cspice/zzck4d2i.c b/ext/spice/src/cspice/zzck4d2i.c deleted file mode 100644 index e4c112c3a0..0000000000 --- a/ext/spice/src/cspice/zzck4d2i.c +++ /dev/null @@ -1,163 +0,0 @@ -/* zzck4d2i.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCK4D2I ( Unpack a set of integers from DP number ) */ -/* Subroutine */ int zzck4d2i_(doublereal *dpcoef, integer *nsets, doublereal - *parcod, integer *i__) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - double pow_di(doublereal *, integer *); - - /* Local variables */ - integer k; - doublereal x; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the routine that unpacks a set integer numbers stored in */ -/* a single double precision number. */ - -/* Its current specific use is to "uncompress" seven integer numbers */ -/* representing numbers of polynomial coefficients in a logical */ -/* type 4 CK record from a single DP number stored in a physical */ -/* type 4 CK record in a file. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* DPCOEF I DP number containing packed integer numbers. */ -/* NSETS I Number of integer components packed in DPCOEF. */ -/* PARCOD I Packing base. */ -/* I O Array of NSETS integer components. */ - -/* $ Detailed_Input */ - -/* DPCOEF is a DP number containing NSETS integers packed */ -/* together. */ - -/* NSETS is the number of integers packed in the DPCOEF. */ - -/* PARCOD is the packing base. */ - -/* $ Detailed_Output */ - -/* I is an array containing unpacked integers. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine unpacks NSETS integers packed in a single double */ -/* precision number using base specified by PARCOD and stored them */ -/* in the array I. The integers are packed in the DP using the */ -/* following algorithm: */ - -/* [DPCOEF]= PARCOD ** ( NSETS - 1 ) * I( 1 ) + */ -/* PARCOD ** ( NSETS - 2 ) * I( 2 ) + */ -/* ... */ -/* PARCOD ** 1 * I( NSETS - 1 )+ */ -/* PARCOD ** 0 * I( NSETS ) */ -/* where: */ - -/* I(1:NSETS) - is an array of integer numbers with values */ -/* in the range [0:PARCOD-1]. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* Output integer array I must have enough space to hold NSETS */ -/* numbers. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ - -/* Local variables. */ - - -/* Let's unpack it! */ - - i__1 = *nsets - 1; - x = pow_di(parcod, &i__1); - i__1 = *nsets - 1; - for (k = 0; k <= i__1; ++k) { - i__[*nsets - k - 1] = (integer) (*dpcoef / x); - *dpcoef -= i__[*nsets - k - 1] * x; - x /= *parcod; - } - -/* All done. */ - - return 0; -} /* zzck4d2i_ */ - diff --git a/ext/spice/src/cspice/zzck4i2d.c b/ext/spice/src/cspice/zzck4i2d.c deleted file mode 100644 index 43e00a9a8e..0000000000 --- a/ext/spice/src/cspice/zzck4i2d.c +++ /dev/null @@ -1,167 +0,0 @@ -/* zzck4i2d.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCK4I2D ( Pack set of integers into a single DP ) */ -/* Subroutine */ int zzck4i2d_(integer *i__, integer *nsets, doublereal * - parcod, doublereal *dpcoef) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer k; - doublereal x; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the routine that packs a set integer numbers into a */ -/* single double precision number. */ - -/* Its current specific use is to "compress" seven integer numbers */ -/* representing numbers of polynomial coefficients in a logical */ -/* type 4 CK record into a single DP number stored in a physical */ -/* type 4 CK record in a file. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* I I Array of NSETS integer components. */ -/* NSETS I Number of integer components in input array I. */ -/* PARCOD I Packing base. */ -/* DPCOEF O DP number containing NSETS packed integer numbers. */ - -/* $ Detailed_Input */ - -/* I is an array containing integers to be packed. */ - -/* NSETS is the number of elements in the array I. */ - -/* PARCOD is the packing base. */ - -/* $ Detailed_Output */ - -/* DPCOEF is a DP number containing elements of the input */ -/* array packed together. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* No checking is done to determine whether elements of the array */ -/* I are within range [0:PARCOD-1] and whether PARCOD**NSETS will */ -/* cause DPCOEF mantissa overflow. */ - -/* $ Particulars */ - -/* This routine packs NSETS elements of the array I into a single */ -/* double precision variable using base specified by PARCOD. When */ -/* packed the double precision number DPCOEF represents NSETS of */ -/* integer elements of the array I as follows: */ - -/* [DPCOEF]= PARCOD ** ( NSETS - 1 ) * I( 1 ) + */ -/* PARCOD ** ( NSETS - 2 ) * I( 2 ) + */ -/* ... */ -/* PARCOD ** 1 * I( NSETS - 1 )+ */ -/* PARCOD ** 0 * I( NSETS ) */ -/* where: */ - -/* I(1:NSETS) - is an array of integer numbers with values */ -/* in the range [0:PARCOD-1]. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) No checking is done to determine whether elements of the */ -/* array I are within range [0:PARCOD-1] to prevent "overflow" */ -/* of particular */ - -/* 2) No checking is done to determine whether PARCOD**NSETS */ -/* will cause DPCOEF mantissa overflow. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Y.K. Zaiko (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */ - -/* -& */ - -/* Local variables */ - - -/* Let's pack it! */ - - *dpcoef = 0.; - x = 1.; - i__1 = *nsets; - for (k = 1; k <= i__1; ++k) { - *dpcoef += i__[k - 1] * x; - x *= *parcod; - } - -/* All done. */ - - return 0; -} /* zzck4i2d_ */ - diff --git a/ext/spice/src/cspice/zzckcv01.c b/ext/spice/src/cspice/zzckcv01.c deleted file mode 100644 index 5916a5607c..0000000000 --- a/ext/spice/src/cspice/zzckcv01.c +++ /dev/null @@ -1,361 +0,0 @@ -/* zzckcv01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCV01 ( Private --- C-kernel segment coverage, type 01 ) */ -/* Subroutine */ int zzckcv01_(integer *handle, integer *arrbeg, integer * - arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal * - schedl, ftnlen timsys_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec, psiz; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - integer i__, n; - doublereal begin; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tbase; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - logical istdb; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer avsln; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal et, buffer[100]; - integer remain, seglen; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen); - doublereal finish; - integer offset; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer navsln; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), wninsd_(doublereal *, doublereal *, - doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 01 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCLKID I ID of SCLK associated with segment. */ -/* TOL I Tolerance in ticks. */ -/* TIMSYS I Time system used to represent coverage. */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 01 segment */ - -/* ARREND is the ending address of a type 01 segment. */ - -/* SCLKID is the ID code of the spacecraft clock associated with */ -/* the object for which the segment contains pointing. */ -/* This is the ID code used by the SCLK conversion */ -/* routines. */ - -/* TOL is a tolerance value expressed in ticks of the */ -/* spacecraft clock associated with the segment. Before */ -/* each interval is inserted into the coverage window, */ -/* the intervals are expanded by TOL: the left endpoint */ -/* of each interval is reduced by TOL and the right */ -/* endpoint is increased by TOL. Any intervals that */ -/* overlap as a result of the expansion are merged. */ - -/* The coverage window returned when TOL > 0 indicates */ -/* the coverage provided by the file to the CK readers */ -/* CKGPAV and CKGP when that value of TOL is passed to */ -/* them as an input. */ - - -/* TIMSYS is a string indicating the time system used in the */ -/* output coverage window. TIMSYS may have the values: */ - -/* 'SCLK' Elements of SCHEDL are expressed in */ -/* encoded SCLK ("ticks"), where the clock */ -/* is associated with the object designated */ -/* by IDCODE. */ - -/* 'TDB' Elements of SCHEDL are expressed as */ -/* seconds past J2000 TDB. */ - -/* TIMSYS must be consistent with the system used for */ -/* the contents of SCHEDL on input, if any. */ - - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. Since type 01 segments, */ -/* don't have interpolation intervals, each epoch */ -/* associated with a pointing instance is treated as a */ -/* singleton interval. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(BADCK1SEGMENT) is signaled if the derived */ -/* segment length from ARRBEG and ARREND does not match */ -/* the possible lengths computed from the segment metadata. */ - -/* 2) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* 3) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* 4) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */ -/* is signaled. */ - -/* 5) If a time conversion error occurs, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ -/* C */ -/* $ Particulars */ - -/* This is a utility routine that determines the intervals of */ -/* coverage for a type 01 C-kernel segment. Since type 01 segments, */ -/* don't have interpolation intervals, each epoch associated with a */ -/* pointing instance is treated as a singleton interval. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SUPPORT Version 1.0.0, 03-JAN-2005 (WLT)(NJB)(BVS) */ - -/* Initial version. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCV01", (ftnlen)8); - } - -/* Check tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative; actual value was #.", ( - ftnlen)51); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZCKCV01", (ftnlen)8); - return 0; - } - -/* Set a logical flag indicating whether the time systm is SCLK. */ - - istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3); - -/* Check time system. */ - - if (! istdb) { - if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) { - setmsg_("Time system spec TIMSYS was #; allowed values are SCLK " - "and TDB.", (ftnlen)63); - errch_("#", timsys, (ftnlen)1, timsys_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZCKCV01", (ftnlen)8); - return 0; - } - } - -/* The coverage window is the set of singleton intervals consisting */ -/* of the epochs of the pointing records. We'll need to find the */ -/* epochs. */ - -/* First, get the number of records in this segment. */ - - dafgda_(handle, arrend, arrend, buffer); - nrec = (integer) buffer[0]; - -/* Determine the size of the pointing packets. This is dependent */ -/* on whether angular rate data is present in the segment or not. */ -/* We can determine this with the following computation: */ - -/* Assume a record size of 4, i.e. no angular rate data. */ - - navsln = nrec * 5 + (nrec - 1) / 100 + 1; - -/* Assume a record size of 7, i.e. angular rate data. */ - - avsln = (nrec << 3) + (nrec - 1) / 100 + 1; - -/* Compute the actual length of the segment. */ - - seglen = *arrend - *arrbeg + 1; - if (seglen == navsln) { - psiz = 4; - } else if (seglen == avsln) { - psiz = 7; - } else { - setmsg_("The requested segment in file # reports a length of # d.p. " - "numbers, but the metadata in the segment indicates the lengt" - "h must either be # (no angular rate data) or # (angular rate" - " data). Perhaps the segment is not type 1?", (ftnlen)221); - errhan_("#", handle, (ftnlen)1); - errint_("#", &seglen, (ftnlen)1); - errint_("#", &navsln, (ftnlen)1); - errint_("#", &avsln, (ftnlen)1); - sigerr_("SPICE(BADCK1SEGMENT)", (ftnlen)20); - chkout_("ZZCKCV01", (ftnlen)8); - return 0; - } - -/* The epochs start right after the pointing data. Let TBASE be the */ -/* address preceding the first epoch. */ - - tbase = *arrbeg + nrec * psiz - 1; - -/* Grab the epochs. Make a singleton interval out of each one; add */ -/* the interval to the coverage window. */ - -/* For efficiency, we'll read the epochs into a buffer of length */ -/* BUFSIZ. */ - - remain = nrec; - offset = 0; - while(remain > 0) { - -/* Buffer the next set of epochs. */ - - n = min(100,remain); - i__1 = tbase + offset + 1; - i__2 = tbase + offset + n; - dafgda_(handle, &i__1, &i__2, buffer); - -/* Insert the current batch of N singleton intervals. */ - - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - begin = buffer[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("buffer", i__2, "zzckcv01_", (ftnlen)359)]; - finish = buffer[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("buffer", i__2, "zzckcv01_", (ftnlen)360)]; - if (*tol > 0.) { - -/* Adjust the interval using the tolerance. */ - -/* Computing MAX */ - d__1 = begin - *tol; - begin = max(d__1,0.); - finish += *tol; - } - -/* Convert the time to TDB if necessary. */ - - if (istdb) { - sct2e_(sclkid, &begin, &et); - begin = et; - sct2e_(sclkid, &finish, &et); - finish = et; - } - wninsd_(&begin, &finish, schedl); - } - offset += n; - remain -= n; - } - chkout_("ZZCKCV01", (ftnlen)8); - return 0; -} /* zzckcv01_ */ - diff --git a/ext/spice/src/cspice/zzckcv02.c b/ext/spice/src/cspice/zzckcv02.c deleted file mode 100644 index 56a342a321..0000000000 --- a/ext/spice/src/cspice/zzckcv02.c +++ /dev/null @@ -1,308 +0,0 @@ -/* zzckcv02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCV02 ( Private --- C-kernel segment coverage, type 02 ) */ -/* Subroutine */ int zzckcv02_(integer *handle, integer *arrbeg, integer * - arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal * - schedl, ftnlen timsys_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec; - doublereal last[100]; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - integer i__, begat; - doublereal begin; - integer endat; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical istdb; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal first[100]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal et, finish; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), wninsd_(doublereal *, - doublereal *, doublereal *); - integer arrsiz; - extern logical return_(void); - integer get, got; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 02 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCLKID I ID of SCLK associated with segment. */ -/* TOL I Tolerance in ticks. */ -/* TIMSYS I Time system used to represent coverage. */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 02 segment */ - -/* ARREND is the ending address of a type 02 segment. */ - - -/* SCLKID is the ID code of the spacecraft clock associated with */ -/* the object for which the segment contains pointing. */ -/* This is the ID code used by the SCLK conversion */ -/* routines. */ - -/* TOL is a tolerance value expressed in ticks of the */ -/* spacecraft clock associated with the segment. Before */ -/* each interval is inserted into the coverage window, */ -/* the intervals are expanded by TOL: the left endpoint */ -/* of each interval is reduced by TOL and the right */ -/* endpoint is increased by TOL. Any intervals that */ -/* overlap as a result of the expansion are merged. */ - -/* The coverage window returned when TOL > 0 indicates */ -/* the coverage provided by the file to the CK readers */ -/* CKGPAV and CKGP when that value of TOL is passed to */ -/* them as an input. */ - - -/* TIMSYS is a string indicating the time system used in the */ -/* output coverage window. TIMSYS may have the values: */ - -/* 'SCLK' Elements of SCHEDL are expressed in */ -/* encoded SCLK ("ticks"), where the clock */ -/* is associated with the object designated */ -/* by IDCODE. */ - -/* 'TDB' Elements of SCHEDL are expressed as */ -/* seconds past J2000 TDB. */ - -/* TIMSYS must be consistent with the system used for */ -/* the contents of SCHEDL on input, if any. */ - - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* 2) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* 3) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */ -/* is signaled. */ - -/* 4) If a time conversion error occurs, the error will be */ -/* diagnosed by a routine in the call tree of this routine */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 02 C-kernel segment. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-JAN-2005 (NJB) (FST) (WLT) (BVS) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCV02", (ftnlen)8); - } - -/* Check tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative; actual value was #.", ( - ftnlen)51); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZCKCV02", (ftnlen)8); - return 0; - } - -/* Set a logical flag indicating whether the time systm is SCLK. */ - - istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3); - -/* Check time system. */ - - if (! istdb) { - if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) { - setmsg_("Time system spec TIMSYS was #; allowed values are SCLK " - "and TDB.", (ftnlen)63); - errch_("#", timsys, (ftnlen)1, timsys_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZCKCV02", (ftnlen)8); - return 0; - } - } - -/* Determine the size of the array and the number of records */ -/* in it. */ - - arrsiz = *arrend - *arrbeg + 1; - d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.; - nrec = i_dnnt(&d__1); - -/* The variable GOT tells us how many time endpoints we've */ -/* gotten so far. */ - - got = 0; - while(got < nrec) { -/* Computing MIN */ - i__1 = 100, i__2 = nrec - got; - get = min(i__1,i__2); - begat = *arrbeg + (nrec << 3) + got; - endat = *arrbeg + (nrec << 3) + nrec + got; - -/* Retrieve the list next list of windows. */ - - i__1 = begat + get - 1; - dafgda_(handle, &begat, &i__1, first); - i__1 = endat + get - 1; - dafgda_(handle, &endat, &i__1, last); - -/* Insert the coverage intervals into the schedule. */ - - i__1 = get; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Adjust the interval using the tolerance. */ - - begin = first[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "first", i__2, "zzckcv02_", (ftnlen)295)]; - finish = last[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge( - "last", i__2, "zzckcv02_", (ftnlen)296)]; - if (*tol > 0.) { -/* Computing MAX */ - d__1 = begin - *tol; - begin = max(d__1,0.); - finish += *tol; - } - -/* Convert the time to TDB if necessary. */ - - if (istdb) { - sct2e_(sclkid, &begin, &et); - begin = et; - sct2e_(sclkid, &finish, &et); - finish = et; - } - wninsd_(&begin, &finish, schedl); - } - got += get; - } - chkout_("ZZCKCV02", (ftnlen)8); - return 0; -} /* zzckcv02_ */ - diff --git a/ext/spice/src/cspice/zzckcv03.c b/ext/spice/src/cspice/zzckcv03.c deleted file mode 100644 index e62e513cf7..0000000000 --- a/ext/spice/src/cspice/zzckcv03.c +++ /dev/null @@ -1,427 +0,0 @@ -/* zzckcv03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCV03 ( Private --- C-kernel segment coverage, type 03 ) */ -/* Subroutine */ int zzckcv03_(integer *handle, integer *arrbeg, integer * - arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal * - schedl, ftnlen timsys_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - logical bail; - integer nrec; - doublereal tick; - integer ndir; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - doublereal begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical istdb; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer intat, avsln, invls, rsize; - doublereal start; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal et; - integer intbeg; - doublereal buffer[2]; - integer seglen, tickat; - doublereal finish; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - integer navsln; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), wninsd_(doublereal *, doublereal *, - doublereal *); - integer lsttik, lstint; - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 03 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCLKID I ID of SCLK associated with segment. */ -/* TOL I Tolerance in ticks. */ -/* TIMSYS I Time system used to represent coverage. */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 03 segment */ - -/* ARREND is the ending address of a type 03 segment. */ - -/* SCLKID is the ID code of the spacecraft clock associated with */ -/* the object for which the segment contains pointing. */ -/* This is the ID code used by the SCLK conversion */ -/* routines. */ - -/* TOL is a tolerance value expressed in ticks of the */ -/* spacecraft clock associated with the segment. Before */ -/* each interval is inserted into the coverage window, */ -/* the intervals are expanded by TOL: the left endpoint */ -/* of each interval is reduced by TOL and the right */ -/* endpoint is increased by TOL. Any intervals that */ -/* overlap as a result of the expansion are merged. */ - -/* The coverage window returned when TOL > 0 indicates */ -/* the coverage provided by the file to the CK readers */ -/* CKGPAV and CKGP when that value of TOL is passed to */ -/* them as an input. */ - - -/* TIMSYS is a string indicating the time system used in the */ -/* output coverage window. TIMSYS may have the values: */ - -/* 'SCLK' Elements of SCHEDL are expressed in */ -/* encoded SCLK ("ticks"), where the clock */ -/* is associated with the object designated */ -/* by IDCODE. */ - -/* 'TDB' Elements of SCHEDL are expressed as */ -/* seconds past J2000 TDB. */ - -/* TIMSYS must be consistent with the system used for */ -/* the contents of SCHEDL on input, if any. */ - - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(BADCK3SEGMENT) is signaled if the derived */ -/* segment length from ARRBEG and ARREND does not match */ -/* the possible lengths computed from the segment metadata. */ - -/* 2) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* 3) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* 4) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */ -/* is signaled. */ - -/* 5) If a time conversion error occurs, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 03 C-kernel segment. */ - -/* $ Examples */ - -/* See CKBRIEF's main driver. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-JAN-2005 (NJB) (FST) (WLT) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCV03", (ftnlen)8); - } - -/* Check tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative; actual value was #.", ( - ftnlen)51); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZCKCV03", (ftnlen)8); - return 0; - } - -/* Set a logical flag indicating whether the time systm is SCLK. */ - - istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3); - -/* Check time system. */ - - if (! istdb) { - if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) { - setmsg_("Time system spec TIMSYS was #; allowed values are SCLK " - "and TDB.", (ftnlen)63); - errch_("#", timsys, (ftnlen)1, timsys_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZCKCV03", (ftnlen)8); - return 0; - } - } - -/* Get the number of intervals and pointing instances ( records ) */ -/* in this segment, and from that determine the number of respective */ -/* directory epochs. */ - - i__1 = *arrend - 1; - dafgda_(handle, &i__1, arrend, buffer); - invls = i_dnnt(buffer); - nrec = i_dnnt(&buffer[1]); - ndir = (nrec - 1) / 100; - -/* Determine the size of the pointing packets. This is dependent */ -/* on whether angular rate data is present in the segment or not. */ -/* We can determine this with the following computation: */ - -/* Assume a record size of 4, i.e. no angular rate data. */ - - navsln = nrec * 5 + ndir + invls + (invls - 1) / 100 + 2; - -/* Assume a record size of 7, i.e. angular rate data. */ - - avsln = (nrec << 3) + ndir + invls + (invls - 1) / 100 + 2; - -/* Compute the actual length of the segment. */ - - seglen = *arrend - *arrbeg + 1; - if (seglen == navsln) { - rsize = 4; - } else if (seglen == avsln) { - rsize = 7; - } else { - setmsg_("The requested segment in file # reports a length of # d.p. " - "numbers, but the metadata in the segment indicates the lengt" - "h must either be # (no angular rate data) or # (angular rate" - " data). Perhaps the segment is not type 3?", (ftnlen)221); - errhan_("#", handle, (ftnlen)1); - errint_("#", &seglen, (ftnlen)1); - errint_("#", &navsln, (ftnlen)1); - errint_("#", &avsln, (ftnlen)1); - sigerr_("SPICE(BADCK3SEGMENT)", (ftnlen)20); - chkout_("ZZCKCV03", (ftnlen)8); - return 0; - } - -/* Recall that the segment is layed out as: */ - -/* +------------------------------+ */ -/* | | */ -/* | Pointing | */ -/* | | */ -/* +------------------------------+ */ -/* | | */ -/* | SCLK times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | SCLK directory | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Interval start times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Start times directory | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Number of intervals | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Number of pointing | */ -/* | instances | */ -/* | | */ -/* +------------------------+ */ - - tickat = *arrbeg + rsize * nrec; - lsttik = tickat + nrec - 1; - intbeg = *arrbeg + rsize * nrec + nrec + ndir; - intat = intbeg; - lstint = intbeg + invls - 1; - dafgda_(handle, &intat, &intat, &start); - dafgda_(handle, &tickat, &tickat, &tick); - while(tick < start && tickat < lsttik) { - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* If we did not find a TICK at least as big as START, we can */ -/* just return now. */ - - if (tick < start) { - chkout_("ZZCKCV03", (ftnlen)8); - return 0; - } - bail = FALSE_; - while(intat <= lstint && tickat <= lsttik && ! bail) { - -/* At this point, we have an interval that begins at START */ -/* and ends at FINISH (unless of course we never found a "good" */ -/* TICK to start with.) */ - - begin = start; - -/* If the start of the interval was the start of the LAST */ -/* interval available, we can short cut the remainder of the */ -/* reads. */ - - if (intat == lstint) { - dafgda_(handle, &lsttik, &lsttik, &finish); - bail = TRUE_; - -/* The routine will return at the end of this loop */ -/* iteration. But first, we may have to update BEGIN */ -/* and FINISH, depending on the values of TOL and TIMSYS, */ -/* and we have to insert these values into SCHEDL. */ -/* We'll carry out these tasks at the end of this IF block. */ - - } else { - -/* This is the expected case. Get the start of the next */ -/* interval. */ - - ++intat; - dafgda_(handle, &intat, &intat, &start); - -/* Read forward from the last tick until we reach the */ -/* START of the next interval or until we run out of TICKS. */ - - while(tick < start && tickat < lsttik) { - finish = tick; - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* A structurally correct CK-3 segment should never allow the */ -/* next test to pass, but it's just easier to check than */ -/* police the writers of C-kernels. The only way to get into */ -/* the block below is if TICKAT .EQ. LSTTIK */ - - if (tick < start) { - finish = tick; - ++tickat; - } - } - -/* Adjust the interval using the tolerance. */ - - if (*tol > 0.) { -/* Computing MAX */ - d__1 = begin - *tol; - begin = max(d__1,0.); - finish += *tol; - } - -/* Convert the time to TDB if necessary. */ - - if (istdb) { - sct2e_(sclkid, &begin, &et); - begin = et; - sct2e_(sclkid, &finish, &et); - finish = et; - } - -/* Insert the interval into the window. */ - - wninsd_(&begin, &finish, schedl); - } - chkout_("ZZCKCV03", (ftnlen)8); - return 0; -} /* zzckcv03_ */ - diff --git a/ext/spice/src/cspice/zzckcv04.c b/ext/spice/src/cspice/zzckcv04.c deleted file mode 100644 index f3e915204b..0000000000 --- a/ext/spice/src/cspice/zzckcv04.c +++ /dev/null @@ -1,462 +0,0 @@ -/* zzckcv04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure ZZCKCV04 ( Private --- C-kernel segment coverage, type 04 ) */ -/* Subroutine */ int zzckcv04_(integer *handle, integer *arrbeg, integer * - arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal * - schedl, ftnlen timsys_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Local variables */ - integer nrec, ends[2]; - doublereal left; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int cknr04_(integer *, doublereal *, integer *), - errch_(char *, char *, ftnlen, ftnlen); - logical istdb; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal right; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal dc[2]; - integer ic[6]; - doublereal et; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), sgfpkt_(integer *, doublereal *, integer *, integer *, - doublereal *, integer *); - doublereal values[143]; - extern integer intmax_(void); - extern /* Subroutine */ int setmsg_(char *, ftnlen), wninsd_(doublereal *, - doublereal *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 04 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCLKID I ID of SCLK associated with segment. */ -/* TOL I Tolerance in ticks. */ -/* TIMSYS I Time system used to represent coverage. */ -/* SCHEDL I/O An initialized window/schedule of interval */ -/* CK4RSZ P C-kernel Type 04 Maximum Record Size */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 04 segment */ - -/* ARREND is the ending address of a type 04 segment. */ - - -/* SCLKID is the ID code of the spacecraft clock associated with */ -/* the object for which the segment contains pointing. */ -/* This is the ID code used by the SCLK conversion */ -/* routines. */ - -/* TOL is a tolerance value expressed in ticks of the */ -/* spacecraft clock associated with the segment. Before */ -/* each interval is inserted into the coverage window, */ -/* the intervals are expanded by TOL: the left endpoint */ -/* of each interval is reduced by TOL and the right */ -/* endpoint is increased by TOL. Any intervals that */ -/* overlap as a result of the expansion are merged. */ - -/* The coverage window returned when TOL > 0 indicates */ -/* the coverage provided by the file to the CK readers */ -/* CKGPAV and CKGP when that value of TOL is passed to */ -/* them as an input. */ - - -/* TIMSYS is a string indicating the time system used in the */ -/* output coverage window. TIMSYS may have the values: */ - -/* 'SCLK' Elements of SCHEDL are expressed in */ -/* encoded SCLK ("ticks"), where the clock */ -/* is associated with the object designated */ -/* by IDCODE. */ - -/* 'TDB' Elements of SCHEDL are expressed as */ -/* seconds past J2000 TDB. */ - -/* TIMSYS must be consistent with the system used for */ -/* the contents of SCHEDL on input, if any. */ - - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* CK4RSZ is the maximum length of a CK4 record (with angular */ -/* velocity). Defined in the include file 'ckparam.inc'. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* 2) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* 3) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */ -/* is signaled. */ - -/* 4) If a time conversion error occurs, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 04 C-kernel segment. */ - -/* $ Examples */ - -/* See CKCOV. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-DEC-2004 (NJB) (FST) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZCKCV04", (ftnlen)8); - -/* Check tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative; actual value was #.", ( - ftnlen)51); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZCKCV04", (ftnlen)8); - return 0; - } - -/* Set a logical flag indicating whether the time systm is SCLK. */ - - istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3); - -/* Check time system. */ - - if (! istdb) { - if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) { - setmsg_("Time system spec TIMSYS was #; allowed values are SCLK " - "and TDB.", (ftnlen)63); - errch_("#", timsys, (ftnlen)1, timsys_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZCKCV04", (ftnlen)8); - return 0; - } - } - -/* Build a descriptor record that satisfies the requirements */ -/* of CKNR04 and SGFPKT. */ - -/* Note: This is a hack dependent on the implementation of */ -/* the generic segments routines. But for C-kernels it */ -/* should always work, as ND and NI aren't changing any */ -/* time soon. */ - - ic[0] = intmax_(); - ic[1] = intmax_(); - ic[2] = 4; - ic[3] = intmax_(); - ic[4] = *arrbeg; - ic[5] = *arrend; - dc[0] = 0.; - dc[1] = 0.; - dafps_(&c__2, &c__6, dc, ic, descr); - -/* Determine the number of records in the array. */ - - cknr04_(handle, descr, &nrec); - i__1 = nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Extract each packet of pointing coefficients. */ - - sgfpkt_(handle, descr, &i__, &i__, values, ends); - -/* Compute the left and right end points of the interval */ -/* of coverage related to this packet. */ - - left = values[0] - values[1]; - right = values[0] + values[1]; - -/* Adjust the interval using the tolerance. */ - - if (*tol > 0.) { -/* Computing MAX */ - d__1 = left - *tol; - left = max(d__1,0.); - right += *tol; - } - -/* Convert the time to TDB if necessary. */ - - if (istdb) { - sct2e_(sclkid, &left, &et); - left = et; - sct2e_(sclkid, &right, &et); - right = et; - } - -/* Store the results in the schedule. */ - - wninsd_(&left, &right, schedl); - } - chkout_("ZZCKCV04", (ftnlen)8); - return 0; -} /* zzckcv04_ */ - diff --git a/ext/spice/src/cspice/zzckcv05.c b/ext/spice/src/cspice/zzckcv05.c deleted file mode 100644 index f70c4e8de0..0000000000 --- a/ext/spice/src/cspice/zzckcv05.c +++ /dev/null @@ -1,549 +0,0 @@ -/* zzckcv05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCV05 ( Private --- C-kernel segment coverage, type 05 ) */ -/* Subroutine */ int zzckcv05_(integer *handle, integer *arrbeg, integer * - arrend, integer *sclkid, doublereal *dc, doublereal *tol, char * - timsys, doublereal *schedl, ftnlen timsys_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - logical bail; - integer nrec; - doublereal tick; - integer ndir; - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - doublereal begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical istdb; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - integer intat, invls, rsize; - doublereal start; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal et; - integer intbeg; - doublereal buffer[4]; - integer tickat; - doublereal finish; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, doublereal *, - ftnlen), wninsd_(doublereal *, doublereal *, doublereal *); - integer lsttik, lstint; - extern logical return_(void); - integer subtyp; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 05 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to CK type 05. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ - -/* CK type 5 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ -/* and quaternion derivatives only, no angular velocity */ -/* vector provided. Quaternion elements are listed */ -/* first, followed by derivatives. Angular velocity is */ -/* derived from the quaternions and quaternion */ -/* derivatives. */ - - -/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ -/* only. Angular velocity is derived by differentiating */ -/* the interpolating polynomials. */ - - -/* Subtype 2: Hermite interpolation, 14-element packets. */ -/* Quaternion and angular angular velocity vector, as */ -/* well as derivatives of each, are provided. The */ -/* quaternion comes first, then quaternion derivatives, */ -/* then angular velocity and its derivatives. */ - - -/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ -/* and angular velocity vector provided. The quaternion */ -/* comes first. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of file ck05.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCLKID I ID of SCLK associated with segment. */ -/* DC I D.p. component of CK segment descriptor. */ -/* TOL I Tolerance in ticks. */ -/* TIMSYS I Time system used to represent coverage. */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 05 segment */ - -/* ARREND is the ending address of a type 05 segment. */ - -/* SCLKID is the ID code of the spacecraft clock associated with */ -/* the object for which the segment contains pointing. */ -/* This is the ID code used by the SCLK conversion */ -/* routines. */ - -/* DC is the double precision component of the descriptor of */ -/* the CK segment. The components are the segment start */ -/* and stop times. */ - -/* Each interpolation interval is replaced with its */ -/* intersection with the segment coverage interval */ - -/* [ DC(1), DC(2) ] */ - -/* before being expanded by TOL. Interpolation intervals */ -/* that don't intersect the segment coverage interval are */ -/* discarded, even if after expansion by TOL they would */ -/* have non-empty intersection with the segment coverage */ -/* interval. */ - -/* TOL is a tolerance value expressed in ticks of the */ -/* spacecraft clock associated with the segment. After */ -/* truncation by the segment coverage interval, and */ -/* before insertion into the coverage window, each */ -/* non-empty truncated interpolation interval is expanded */ -/* by TOL: the left endpoint of each interval is reduced */ -/* by TOL and the right endpoint is increased by TOL. */ -/* Any intervals that overlap as a result of the */ -/* expansion are merged. */ - -/* The coverage window returned when TOL > 0 indicates */ -/* the coverage provided by the file to the CK readers */ -/* CKGPAV and CKGP when that value of TOL is passed to */ -/* them as an input. */ - - -/* TIMSYS is a string indicating the time system used in the */ -/* output coverage window. TIMSYS may have the values: */ - -/* 'SCLK' Elements of SCHEDL are expressed in */ -/* encoded SCLK ("ticks"), where the clock */ -/* is associated with the object designated */ -/* by IDCODE. */ - -/* 'TDB' Elements of SCHEDL are expressed as */ -/* seconds past J2000 TDB. */ - -/* TIMSYS must be consistent with the system used for */ -/* the contents of SCHEDL on input, if any. */ - - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. The schedule has */ -/* been adjusted to account for the provided tolerance */ -/* value. Coverage lying outside the interval */ - -/* DC(1) - TOL : DC(2) + TOL */ - -/* is excluded. */ - -/* The elements of SCHEDL are given in the time system */ -/* indicated by TIMSYS. */ - -/* $ Parameters */ - -/* Several parameters associated with the type 05 C-kernel */ -/* are utilized to compute the packet size of each subtype. */ -/* See the include file 'ck05.inc' for details. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(NOTSUPPORTED) is signaled if the subtype of */ -/* the CK type 05 segment is not recognized. */ - -/* 2) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* 3) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */ -/* signaled. */ - -/* 4) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */ -/* is signaled. */ - -/* 5) If a time conversion error occurs, the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 05 C-kernel segment. */ - -/* $ Examples */ - -/* See CKCOV. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) (FST) (WLT) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCV05", (ftnlen)8); - } - -/* Check tolerance value. */ - - if (*tol < 0.) { - setmsg_("Tolerance must be non-negative; actual value was #.", ( - ftnlen)51); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZCKCV05", (ftnlen)8); - return 0; - } - -/* Set a logical flag indicating whether the time systm is SCLK. */ - - istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3); - -/* Check time system. */ - - if (! istdb) { - if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) { - setmsg_("Time system spec TIMSYS was #; allowed values are SCLK " - "and TDB.", (ftnlen)63); - errch_("#", timsys, (ftnlen)1, timsys_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZCKCV05", (ftnlen)8); - return 0; - } - } - -/* Get the meta-data associated with this segment that we */ -/* require to produce the schedule. */ - -/* BUFFER(1) = Subtype Code */ -/* BUFFER(2) = Window Size */ -/* BUFFER(3) = Number of Interpolation Intervals */ -/* BUFFER(4) = Number of Packets */ - - i__1 = *arrend - 3; - dafgda_(handle, &i__1, arrend, buffer); - subtyp = i_dnnt(buffer); - invls = i_dnnt(&buffer[2]); - nrec = i_dnnt(&buffer[3]); - ndir = (nrec - 1) / 100; - -/* Compute the packet size. This requires parameters listed */ -/* in the include file 'ck05.inc' and is based on the subtype. */ - - if (subtyp == 0) { - rsize = 8; - } else if (subtyp == 1) { - rsize = 4; - } else if (subtyp == 2) { - rsize = 14; - } else if (subtyp == 3) { - rsize = 7; - } else { - setmsg_("CK type 5 subtype <#> is not supported.", (ftnlen)39); - errint_("#", buffer, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZCKCV05", (ftnlen)8); - return 0; - } - -/* Recall that the segment is layed out as: */ - - -/* +------------------------------+ */ -/* | | */ -/* | Pointing | */ -/* | | */ -/* +------------------------------+ */ -/* | | */ -/* | SCLK times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | SCLK directory | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Interval start times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Start times directory | */ -/* | | */ -/* +------------------------+ */ -/* | Seconds per tick | */ -/* +------------------------+ */ -/* | Subtype code | */ -/* +------------------------+ */ -/* | Window size | */ -/* +------------------------+ */ -/* | | */ -/* | Number of intervals | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Number of pointing | */ -/* | instances | */ -/* | | */ -/* +------------------------+ */ - - tickat = *arrbeg + rsize * nrec; - lsttik = tickat + nrec - 1; - intbeg = *arrbeg + rsize * nrec + nrec + ndir; - intat = intbeg; - lstint = intbeg + invls - 1; - dafgda_(handle, &intat, &intat, &start); - dafgda_(handle, &tickat, &tickat, &tick); - while(tick < start && tickat < lsttik) { - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* If we did not find a TICK at least as big as START, we can */ -/* just return now. */ - - if (tick < start) { - chkout_("ZZCKCV05", (ftnlen)8); - return 0; - } - bail = FALSE_; - while(intat <= lstint && tickat <= lsttik && ! bail) { - -/* At this point, we have an interval that begins at START */ -/* and ends at FINISH (unless of course we never found a "good" */ -/* TICK to start with.) */ - - begin = start; - -/* If the start of the interval was the start of the LAST */ -/* interval available, we can short cut the remainder of the */ -/* reads. */ - - if (intat == lstint) { - dafgda_(handle, &lsttik, &lsttik, &finish); - bail = TRUE_; - -/* The routine will return at the end of this loop */ -/* iteration. But first, we may have to update BEGIN */ -/* and FINISH, depending on the values of TOL and TIMSYS, */ -/* and we have to insert these values into SCHEDL. */ -/* We'll carry out these tasks at the end of this IF block. */ - } else { - -/* This is the expected case. Get the start of the next */ -/* interval. */ - - ++intat; - dafgda_(handle, &intat, &intat, &start); - -/* Read forward from the last tick until we reach the */ -/* START of the next interval or until we run out of TICKS. */ - - while(tick < start && tickat < lsttik) { - finish = tick; - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* A structurally correct CK-5 segment should never allow the */ -/* next test to pass, but it's just easier to check than */ -/* police the writers of C-kernels. The only way to get into */ -/* the block below is if TICKAT .EQ. LSTTIK */ - - if (tick < start) { - finish = tick; - ++tickat; - } - } - -/* Truncate the interval using the segment bounds. */ - - begin = max(begin,dc[0]); - finish = min(finish,dc[1]); - -/* Adjust the interval using the tolerance. Empty */ -/* intervals *do not get expanded*; this choice is */ -/* consistent with the type 5 reading algorithm. */ - - if (begin <= finish) { - if (*tol > 0.) { -/* Computing MAX */ - d__1 = begin - *tol; - begin = max(d__1,0.); - finish += *tol; - } - } - -/* Convert the time to TDB if necessary. */ - - if (istdb) { - sct2e_(sclkid, &begin, &et); - begin = et; - sct2e_(sclkid, &finish, &et); - finish = et; - } - -/* Insert the interval into the window. */ - - if (begin <= finish) { - wninsd_(&begin, &finish, schedl); - } - } - chkout_("ZZCKCV05", (ftnlen)8); - return 0; -} /* zzckcv05_ */ - diff --git a/ext/spice/src/cspice/zzckspk.c b/ext/spice/src/cspice/zzckspk.c deleted file mode 100644 index 1ea7331b58..0000000000 --- a/ext/spice/src/cspice/zzckspk.c +++ /dev/null @@ -1,383 +0,0 @@ -/* zzckspk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; -static integer c__72 = 72; -static integer c__100 = 100; -static integer c__0 = 0; -static integer c__10 = 10; -static integer c__1 = 1; - -/* $Procedure ZZCKSPK ( SPK or CK ) */ -/* Subroutine */ int zzckspk_(integer *handle, char *ckspk, ftnlen ckspk_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer from, last, size, nspk, type__; - logical ck2ok; - extern /* Subroutine */ int zzsizeok_(integer *, integer *, integer *, - integer *, logical *, integer *), dafgs_(doublereal *), chkin_( - char *, ftnlen), dafus_(doublereal *, integer *, integer *, - doublereal *, integer *); - logical found; - doublereal times[2]; - integer first; - logical spkok; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - doublereal dc[2]; - integer ic[6]; - extern /* Subroutine */ int daffna_(logical *); - extern logical failed_(void); - extern /* Subroutine */ int dafbfs_(integer *), dafhsf_(integer *, - integer *, integer *); - integer to; - doublereal chcktm; - integer angvel; - doublereal lastdp; - integer thisnd; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer thisni; - extern logical return_(void); - doublereal frsttm, sum[5]; - integer nck2; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine determines whether or not a DAF file attached to */ -/* the supplied handle is an SPK, CK or unknown file. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I the handle of a DAF file open for read access. */ -/* CKSPK O the type of the DAF file (SPK,CK or ?) */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of a DAF file open for read. */ - -/* $ Detailed_Output */ - -/* CKSPK is a string containing one of the following 3 values */ -/* 'SPK', 'CK' or '?' */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This routine examines the first segment of a DAF that is */ -/* a candidate for being an SPK or CK and returns a diagnosis */ -/* of the type of the file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */ - -/* Replaced DAFRDA call with DAFGDA. */ -/* Added IMPLICIT NONE. */ - -/* - SPICELIB Version 1.0.0, 03-DEC-1999 (WLT) */ - -/* -& */ - -/* Local parameters */ - - -/* The following parameters point to the various slots in the */ -/* integer portion of the DAF descriptor where the values are */ -/* located. */ - - -/* These parameters give the number of integer and double precision */ -/* components of the descriptor for SPK and CK files. */ - - -/* The size of a summary. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZCKSPK", (ftnlen)7); - -/* Make sure the values of ND and NI associated with this file */ -/* have the correct values. */ - - dafhsf_(handle, &thisnd, &thisni); - if (thisnd != 2 || thisni != 6) { - s_copy(ckspk, "?", ckspk_len, (ftnlen)1); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* We've got the correct values for ND and NI, examine the descriptor */ -/* for the first array. */ - - dafbfs_(handle); - daffna_(&found); - if (failed_()) { - s_copy(ckspk, "?", ckspk_len, (ftnlen)1); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* If we don't find any segments, we don't have a clue about */ -/* the file type. */ - - if (! found) { - s_copy(ckspk, "?", ckspk_len, (ftnlen)1); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* Unpack the summary record. */ - - dafgs_(sum); - dafus_(sum, &c__2, &c__6, dc, ic); - -/* Look at the slot where the angular velocity flag would */ -/* be located if this is a CK file. */ - - angvel = ic[3]; - type__ = ic[2]; - -/* Test 1. The value of ANGVEL may do the trick */ -/* right at the start. */ - - if (angvel == 0) { - s_copy(ckspk, "CK", ckspk_len, (ftnlen)2); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - if (angvel > 1) { - s_copy(ckspk, "SPK", ckspk_len, (ftnlen)3); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* Test 2. If this is an SPK file, it has a type 01 segment. */ -/* See if this is something orbiting the solar system */ -/* barycenter. */ - - if (ic[1] == 0) { - s_copy(ckspk, "SPK", ckspk_len, (ftnlen)3); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* Test 3. This is the super test. Compute the size of the */ -/* segment and fetch the last d.p. from the segment. */ - - first = ic[4]; - last = ic[5]; - size = last - first + 1; - -/* Check the size of the array to see if it has any chance */ -/* of being an SPK and if it does get the number of MDA records. */ - - i__1 = size - 1; - zzsizeok_(&i__1, &c__72, &c__100, &c__0, &spkok, &nspk); - if (! spkok) { - s_copy(ckspk, "CK", ckspk_len, (ftnlen)2); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - dafgda_(handle, &last, &last, &lastdp); - -/* See if the last number in the file is the allowed number of */ -/* MDA records. If not, this must be a CK segment. */ - - if (lastdp != (doublereal) nspk) { - s_copy(ckspk, "CK", ckspk_len, (ftnlen)2); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* If we are still here, the last d.p. in the segment matches the */ -/* expected number of MDA records. If the potential CK type is */ -/* not 2, we must have an SPK file. */ - - if (type__ != 2) { - s_copy(ckspk, "SPK", ckspk_len, (ftnlen)3); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* We are getting down to the nitty gritty here. See if the */ -/* size is compatible with a type 02 C-kernel. */ - - zzsizeok_(&size, &c__10, &c__100, &c__1, &ck2ok, &nck2); - if (! ck2ok) { - s_copy(ckspk, "SPK", ckspk_len, (ftnlen)3); - chkout_("ZZCKSPK", (ftnlen)7); - return 0; - } - -/* So much for being nice. We need to examine the structure of the */ -/* actual data in the segment. There are two cases to consider: */ -/* when there is 1 or fewer type 02 CK directory records and when */ -/* there is more than 1. Note that to get to this point there must */ -/* be at least 1 directory value if this is a CK type 02 segment. */ -/* (To see this check the sizes when ZZSIZEOK returns TRUE for */ -/* both type 1 SPK and type 02 CK. The only such sizes in which */ -/* there the number CK type 02 directory values is one or fewer */ -/* are SIZE = 1081, 1441, and 1801 which correspond to (NSPK,NCK2) = */ -/* (15,108), (20,144), (25, 180). In all of these cases there is */ -/* exactly 1 ck type 02 directory value.) */ - - if (nck2 < 201) { - -/* Recall that MDA record contains its stop time as the first */ -/* entry of the record. These epochs show up duplicated in the */ -/* epochs portion of the segment. */ - -/* If this is a type 01 SPK segment, there are no directory */ -/* records and the first epoch shows up in the slot NSPK before */ -/* the last slot of the segment. If it is a type 02 CK segment */ -/* the last stop tick shows up in this slot. We need to look */ -/* at this value to see what's up. */ - - i__1 = last - nspk; - i__2 = last - nspk; - dafgda_(handle, &i__1, &i__2, &frsttm); - -/* Now (under the assumption that we have an SPK segment) look */ -/* up the epoch from the last MDA record--- the NSPK'th */ -/* record. This epoch must be greater than the first epoch */ -/* in the array of epochs. */ - from = first + (nspk - 1) * 71; - to = from; - dafgda_(handle, &from, &to, &chcktm); - -/* If this is a type 02 segment. The value we just picked out */ -/* will come from the array of stop ticks. The array of stop */ -/* ticks is non-decreasing so: */ - - if (chcktm > frsttm) { - s_copy(ckspk, "SPK", ckspk_len, (ftnlen)3); - } else { - s_copy(ckspk, "CK", ckspk_len, (ftnlen)2); - } - } else { - -/* In this case there are at least 2 directory records if we */ -/* have a CK. We read the last potential tick value and the */ -/* first potential directory value.. Note that the last potential */ -/* stop tick must be greater than the first potential directory */ -/* record. */ - - from = last - (nck2 - 1) / 100; - to = from + 1; - dafgda_(handle, &from, &to, times); - -/* If we happen to have a TYPE 01 SPK segment we've just */ -/* read two consecutive values from the epochs sub-array of the */ -/* segment. Here's a sketch of why this is so: */ - -/* The number of directory records for a CK type 02 segment is */ -/* (NCK2-1)/100 which is the same as SIZE/1001. */ - -/* The number of directory records for an SPK type 01 segment is */ -/* (NSPK-1)/100 which is the same as SIZE/7201. */ - -/* The number of stop ticks for type 02 CK is NCK2 ~ SIZE/10 */ - -/* The number of epochs for a type 01 SPK is NSPK ~ SIZE/72 */ - -/* so NSPK directories < NCK2 directories < NCK2 directories + 1 */ -/* < NSPK + NSPK directories < NCK2. Consequently, the */ -/* two values just read are either the last stop tick and the */ -/* first CK directory value or two consecutive epochs. */ -/* In the first case TIMES(1) > TIMES(2), in the later case */ -/* we have TIMES(1) < TIMES(2) */ - - if (times[0] > times[1]) { - s_copy(ckspk, "CK", ckspk_len, (ftnlen)2); - } else { - s_copy(ckspk, "SPK", ckspk_len, (ftnlen)3); - } - } - chkout_("ZZCKSPK", (ftnlen)7); - return 0; -} /* zzckspk_ */ - diff --git a/ext/spice/src/cspice/zzcln.c b/ext/spice/src/cspice/zzcln.c deleted file mode 100644 index f7fff77315..0000000000 --- a/ext/spice/src/cspice/zzcln.c +++ /dev/null @@ -1,202 +0,0 @@ -/* zzcln.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCLN ( Private --- clean up ) */ -/* Subroutine */ int zzcln_(integer *lookat, integer *nameat, integer *namlst, - integer *datlst, integer *nmpool, integer *chpool, integer *dppool) -{ - integer head, tail; - extern /* Subroutine */ int chkin_(char *, ftnlen), lnkfsl_(integer *, - integer *, integer *), chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine cleans up changes to the kernel pool that were */ -/* made prior to the detection of a parsing error. It is purely */ -/* a utility for use only by ZZRVAR. */ - -/* $ 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 */ - -/* PRIVATE UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* LOOKAT I The hash value of some name. */ -/* NAMEAT I The actual node where the name was stored */ -/* NAMLST I/O The array of heads of name lists. */ -/* DATLST I/O The array of heads of lists of values */ -/* NMPOOL I/O The linked list pool of variable names. */ -/* CHPOOL I/O The linked list pool of variable d.p. values. */ -/* DPPOOL I/O The linked list pool of variable string values. */ - - -/* $ Detailed_Input */ - -/* LOOKAT is the hash value of some string. NAMLST(LOOKAT) is */ -/* the head of some collision resolution list of names. */ - -/* NAMEAT is the node in the list headed by NAMLST(LOOKAT) where */ -/* some name has been stored in the kernel pool */ -/* collection of NAMES. The node NAMEAT needs to be */ -/* removed from its list in NMPOOL. */ - -/* NAMLST is an array of heads of collision */ -/* resolution lists in NMPOOL. If NAMLST(LOOKAT) is */ -/* the same as NAMEAT, we need to adjust NAMLST(LOOKAT) */ -/* so that it points to the next node in the list. */ - -/* DATLST is an array of heads of data value lists for the */ -/* variables in the kernel pool. We will need to free */ -/* the data list pointed to by DATLST(NAMEAT) and */ -/* zero out DATLST(NAMEAT). */ - -/* NMPOOL is a linked list pool for collision resolutions of */ -/* a string hash function. The node NAMEAT needs to */ -/* be freed. */ - -/* CHPOOL is a linked list pool for string values associated */ -/* with a kernel pool variable If DATLST(NAMEAT) points */ -/* into CHPOOL, then the list containing this node must */ -/* be freed. */ - -/* DPPOOL is a linked list pool for d.p. values associated */ -/* with a kernel pool variable. If DATLST(NAMEAT) points */ -/* into DPPOOL, then the list containing this node must */ -/* be freed. */ - - -/* $ Detailed_Output */ - -/* NAMLST are the same structures as the input with the */ -/* DATLST corrections made for the freeing of the NMPOOL */ -/* NMPOOL node NAMEAT. */ -/* CHPOOL */ -/* DPPOOL */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* During the course of reading and parsing a kernel pool variable */ -/* it may happen that an error in the input text is encountered after */ -/* a kernel pool variable update has been initiated. This routine */ -/* removes all traces of that variable from the kernel pool storage */ -/* structures. */ - -/* $ Examples */ - -/* See ZZRVAR */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ - -/* Local Parameters and Variables */ - - -/* First perform the clean up function. This variable */ -/* has been corrupted so there's no point in hanging */ -/* on to it. */ - -/* First remove the data... */ - - chkin_("ZZCLN", (ftnlen)5); - head = datlst[*nameat - 1]; - if (head < 0) { - head = -head; - tail = -chpool[(head << 1) + 11]; - lnkfsl_(&head, &tail, chpool); - } else if (head > 0) { - tail = -dppool[(head << 1) + 11]; - lnkfsl_(&head, &tail, dppool); - } - -/* Remove the sub-list head from the data list. */ - - datlst[*nameat - 1] = 0; - -/* If this was a singleton list remove the pointer to */ -/* the head of the list. */ - - head = namlst[*lookat - 1]; - tail = -nmpool[(head << 1) + 11]; - if (head == tail) { - namlst[*lookat - 1] = 0; - } else if (namlst[*lookat - 1] == *nameat) { - namlst[*lookat - 1] = nmpool[(*nameat << 1) + 10]; - } - -/* Finally free up this node in the NMPOOL. */ - - head = *nameat; - tail = *nameat; - lnkfsl_(&head, &tail, nmpool); - chkout_("ZZCLN", (ftnlen)5); - return 0; -} /* zzcln_ */ - diff --git a/ext/spice/src/cspice/zzcorepc.c b/ext/spice/src/cspice/zzcorepc.c deleted file mode 100644 index da2e10accc..0000000000 --- a/ext/spice/src/cspice/zzcorepc.c +++ /dev/null @@ -1,335 +0,0 @@ -/* zzcorepc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCOREPC ( Correct epoch for aberration ) */ -/* Subroutine */ int zzcorepc_(char *abcorr, doublereal *et, doublereal *lt, - doublereal *etcorr, ftnlen abcorr_len) -{ - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen), chkin_( - char *, ftnlen); - logical corblk[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute an aberration corrected epoch, given an aberration */ -/* correction specification, an epoch, and a light time. */ - -/* $ 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 */ - -/* ABERRATION */ -/* PARSING */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ABCORR I Aberration correction string. */ -/* ET I Ephemeris time, seconds past J2000. */ -/* LT I Light time. */ -/* ETCORR O Light time-corrected epoch. */ - -/* $ Detailed_Input */ - -/* ABCORR is a string representing a aberration */ -/* correction. The supported values are: */ - -/* 'CN' */ -/* 'CN+S' */ -/* 'LT' */ -/* 'LT+S' */ -/* 'NONE' */ -/* 'RL' */ -/* 'RL+S' */ -/* 'S' */ -/* 'XCN' */ -/* 'XCN+S' */ -/* 'XLT' */ -/* 'XLT+S' */ -/* 'XRL' */ -/* 'XRL+S' */ -/* 'XS' */ - -/* Note that some values not supported by the */ -/* SPICELIB SPK subsystem are supported by */ -/* this routine: */ - -/* - The letter 'R' indicates relativistic */ -/* corrections. */ - -/* - Stellar aberration-only corrections are */ -/* indicated by the strings */ - -/* 'S' */ -/* 'XS' */ - -/* Case and leading and trailing blanks are not */ -/* significant in ABCORR. */ - - -/* ET is an epoch, expressed as seconds past J2000 TDB. */ - -/* LT is a light time value, expressed as TDB seconds. */ - - -/* $ Detailed_Output */ - - -/* ETCORR is the input epoch ET, corrected for light time: */ - -/* If the specified aberration correction calls */ -/* for some type of light time correction (normal, */ -/* converged Newtonian, relativistic), LT will be */ -/* added to or subtracted from ET. If the */ -/* correction is of the transmission type, then */ - -/* ETCORR = ET + LT */ - -/* If the correction is of the reception type, */ -/* then */ - -/* ETCORR = ET - LT */ - -/* If no light time correction is specified, then */ - -/* ETCORR = ET */ - -/* $ Parameters */ - -/* See INCLUDE file zzabcorr.inc. */ - -/* $ Exceptions */ - -/* 1) If the input aberration correction choice is not recognized, */ -/* the error SPICE(INVALIDOPTION) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Many SPICELIB routines have logic branches based on the */ -/* attributes of aberration corrections. Much duplicated */ -/* parsing code can be avoided by using this routine. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 24-NOV-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - - -/* Local parameters */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("ZZCOREPC", (ftnlen)8); - -/* Parse the aberration correction string. Obtain a correction */ -/* attribute block. */ - - zzprscor_(abcorr, corblk, abcorr_len); - if (corblk[1]) { - -/* Light time corrections are used. The output epoch */ -/* must be adjusted according to whether the correction */ -/* is for received or transmitted radiation. */ - - if (corblk[4]) { - -/* This is the transmission case. */ - - *etcorr = *et + *lt; - } else { - -/* This is the reception case. */ - - *etcorr = *et - *lt; - } - } else { - -/* Light time corrections are not used. */ - - *etcorr = *et; - } - chkout_("ZZCOREPC", (ftnlen)8); - return 0; -} /* zzcorepc_ */ - diff --git a/ext/spice/src/cspice/zzcorsxf.c b/ext/spice/src/cspice/zzcorsxf.c deleted file mode 100644 index ab2f551b7b..0000000000 --- a/ext/spice/src/cspice/zzcorsxf.c +++ /dev/null @@ -1,456 +0,0 @@ -/* zzcorsxf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__36 = 36; - -/* $Procedure ZZCORSXF ( Correct state transformation matrix ) */ -/* Subroutine */ int zzcorsxf_(logical *xmit, doublereal *dlt, doublereal * - xform, doublereal *corxfm) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal scale; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - doublereal ltsign; - extern /* Subroutine */ int vsclip_(doublereal *, doublereal *); - integer col; - -/* $ Abstract */ - -/* Correct a state transformation matrix for the rate of change of */ -/* light time. */ - -/* $ 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 */ - -/* ROTATION */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ -/* STATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* XMIT I Radiation direction flag. */ -/* DLT I Light time derivative with respect to TDB. */ -/* XFORM I State transformation matrix. */ -/* CORXFM O Corrected state transformation matrix. */ - -/* $ Detailed_Input */ - -/* XMIT is a logical flag indicating the sense of */ -/* radiation transmission associated with */ -/* the light time correction: XMIT is .TRUE. */ -/* for transmission corrections and .FALSE. */ -/* for reception corrections. See the header */ -/* of SPKEZR for a detailed discussion of */ -/* light time corrections. */ - -/* DLT is the derivative of one way light time measured */ -/* in TDB seconds with respect to TDB. DLT is */ -/* signed and unitless. */ - -/* XFORM is a 6x6 state transformation matrix. XFORM */ -/* may transform states from an inertial frame to a */ -/* body-fixed frame or vice versa. XFORM has the form */ - -/* - - */ -/* | : | */ -/* | R(t) : 0 | */ -/* |........ :.......| */ -/* | : | */ -/* | d(R)/dt : R(t) | */ -/* | : | */ -/* - - */ - -/* where R(t) is a time-dependent rotation matrix. */ - -/* $ Detailed_Output */ - -/* CORXFM is the input matrix XFORM after correction for the */ -/* rate of change of light time indicated by DLT. Let */ -/* LTSIGN be 1 for transmission corrections and -1 */ -/* for reception corrections. Then CORXFM has the */ -/* form */ - -/* - - */ -/* | : | */ -/* | R(t) : 0 | */ -/* |.............:............| */ -/* | : | */ -/* | S * d(R)/dt : R(t) | */ -/* | : | */ -/* - - */ - -/* where */ - -/* S = 1 + LTSIGN*DLT */ - -/* CORXFM may be used to transform state vectors */ -/* between an inertial reference frame and a */ -/* body-fixed reference frame associated with a */ -/* light-time corrected epoch. See the Particulars */ -/* section for details. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine designed to simplify transformation of */ -/* state vectors between an inertial and a body-fixed reference */ -/* frame, where the evaluation epoch of the body-fixed frame is */ -/* adjusted by a light time value. */ - -/* For example, suppose the aberration-corrected velocity of a */ -/* target relative to an observer is to be transformed from an */ -/* inertial reference frame into a target centered, target */ -/* body-fixed reference frame, where the orientation of this frame */ -/* is to be corrected for one-way light time between a surface point */ -/* on the target body and the observer. */ - -/* In the discussion below, we use ET as a synonym for TDB, since */ -/* this terminology is used throughout the SPICE system. */ - -/* The orientation of the reference frame can be expressed as */ - -/* R ( ET + LTSIGN*LT(ET) ) */ - -/* where R is a rotation matrix, ET is the TDB epoch associated with */ -/* an observer, LT(ET) is the light time magnitude associated with */ -/* the epoch ET at the observer, and LTSIGN is the sign of the light */ -/* time; LTSIGN is negative for reception case corrections. */ - -/* The expression */ - -/* ET + LTSIGN*LT(ET) */ - -/* represents the light time corrected epoch. Then, according to the */ -/* chain rule, the derivative with respect to ET of R is */ - -/* | */ -/* d(R)/dt| * ( 1 + LTSIGN*d(LT)/d(ET) ) */ -/* |ET + LTSIGN*LT(ET) */ - -/* In the expression above, the factor on the left is the rotation */ -/* derivative that could be obtained by calling SXFORM to look up */ -/* the inertial-to-body-fixed state transformation matrix at the */ -/* epoch */ - -/* ET + LTSIGN*LT(ET) */ - -/* This is the rotation derivative that would apply if light */ -/* time were constant. */ - -/* The factor on the right is the scale factor S shown in the */ -/* Detailed Output section above. */ - -/* $ Examples */ - -/* 1) Express the velocity of Mars as seen from Earth in */ -/* the IAU_MARS reference frame, where the frame orientation is */ -/* corrected for light time. Contrast the results obtained */ -/* using uncorrected and corrected state transformation matrices. */ -/* Show that the result obtained using a corrected matrix */ -/* matches that obtained from SPKEZR. */ - -/* Note that, while the velocity we'll compute is not physically */ -/* realistic, it's perfectly usable for computations such as */ -/* finding the velocity of the apparent sub-Earth point on Mars. */ - -/* Use the meta-kernel shown below to load the required SPICE */ -/* kernels. */ - - -/* KPL/MK */ - -/* File: zzcorsxf_ex1.tm */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - -/* The names and contents of the kernels referenced */ -/* by this meta-kernel are as follows: */ - -/* File name Contents */ -/* --------- -------- */ -/* de421.bsp Planetary ephemeris */ -/* pck00008.tpc Planet orientation and */ -/* radii */ -/* naif0008.tls Leapseconds */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de421.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - -/* End of meta-kernel */ - - - -/* Example code begins here. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION XFORM ( 6, 6 ) */ -/* DOUBLE PRECISION CORXFM ( 6, 6 ) */ -/* DOUBLE PRECISION STATE0 ( 6 ) */ -/* DOUBLE PRECISION STATE1 ( 6 ) */ -/* DOUBLE PRECISION STATE2 ( 6 ) */ -/* DOUBLE PRECISION STATE3 ( 6 ) */ -/* DOUBLE PRECISION VELDIF ( 3 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load kernels. */ -/* C */ -/* CALL FURNSH ( 'corsxf_ex1.tm' ) */ - -/* C */ -/* C Convert an observation epoch to TDB. */ -/* C */ -/* CALL STR2ET ( '2008 MAR 23', ET ) */ - -/* C */ -/* C Look up the aberration-corrected state */ -/* C of Mars as seen from the Earth at ET */ -/* C in the J2000 frame. Use SPKACS since this */ -/* C routine returns the light time derivative. */ -/* C */ -/* CALL SPKACS ( 499, ET, 'J2000', 'LT+S', */ -/* . 399, STATE0, LT, DLT ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Mars-Earth light time derivative = ', DLT */ - -/* C */ -/* C Convert the state into the IAU_MARS frame at */ -/* C ET-LT. This gives us the state without accounting */ -/* C for the rate of change of light time. */ -/* C */ -/* CALL SXFORM ( 'J2000', 'IAU_MARS', ET-LT, XFORM ) */ -/* CALL MXVG ( XFORM, STATE0, 6, 6, STATE1 ) */ - -/* C */ -/* C Display the velocity portion of the state. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'IAU_MARS-relative velocity obtained ' */ -/* WRITE (*,*) 'using SPKACS and SXFORM (km/s):' */ - -/* WRITE (*, '(E24.16)' ) ( STATE1(I), I = 4, 6 ) */ - -/* C */ -/* C Obtain the correct state transformation matrix */ -/* C from ZZCORSXF; transform the state using this matrix. */ -/* C */ -/* CALL ZZCORSXF ( .FALSE., DLT, XFORM, CORXFM ) */ -/* CALL MXVG ( CORXFM, STATE0, 6, 6, STATE2 ) */ - -/* C */ -/* C Display the velocity portion of the state. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'IAU_MARS-relative velocity obtained ' */ -/* .// 'using ZZCORSXF (km/s):' */ - -/* WRITE (*, '(E24.16)' ) ( STATE2(I), I = 4, 6 ) */ - -/* C */ -/* C Display the velocity difference: */ -/* C */ -/* CALL VSUB ( STATE2(4), STATE1(4), VELDIF ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Velocity difference (km/s):' */ -/* WRITE (*, '(E24.16)' ) ( VELDIF(I), I = 1, 3 ) */ - -/* C */ -/* C Look up the desired state using SPKEZR for comparison. */ -/* C */ -/* CALL SPKEZR ( 'MARS', ET, 'IAU_MARS', 'LT+S', */ -/* . 'EARTH', STATE3, LT ) */ - -/* C */ -/* C Display the velocity portion of the state. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'IAU_MARS-relative velocity obtained ' */ -/* .// 'using SPKEZR (km/s):' */ - -/* WRITE (*, '(E24.16)' ) ( STATE3(I), I = 4, 6 ) */ - -/* C */ -/* C Display the velocity difference: */ -/* C */ -/* CALL VSUB ( STATE3(4), STATE2(4), VELDIF ) */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'SPKEZR vs ZZCORSXF velocity difference (km/s):' */ -/* WRITE (*, '(E24.16)' ) ( VELDIF(I), I = 1, 3 ) */ - -/* END */ - - -/* When this program was executed on a PC/Linux/g77 system, the */ -/* output was */ - -/* Mars-Earth light time derivative = 5.70610116E-05 */ - -/* IAU_MARS-relative velocity obtained */ -/* using SPKACS and SXFORM (km/s): */ -/* 0.1094230439483713E+05 */ -/* -0.7388150695390612E+04 */ -/* -0.8550198289693935E+01 */ - -/* IAU_MARS-relative velocity obtained using ZZCORSXF (km/s): */ -/* 0.1094167989684505E+05 */ -/* -0.7387727898874676E+04 */ -/* -0.8550198284585768E+01 */ - -/* Velocity difference (km/s): */ -/* -0.6244979920775222E+00 */ -/* 0.4227965159361702E+00 */ -/* 0.5108166334366615E-08 */ - -/* IAU_MARS-relative velocity obtained using SPKEZR (km/s): */ -/* 0.1094167989684505E+05 */ -/* -0.7387727898874676E+04 */ -/* -0.8550198284585768E+01 */ - -/* SPKEZR vs ZZCORSXF velocity difference (km/s): */ -/* 0.0000000000000000E+00 */ -/* 0.0000000000000000E+00 */ -/* 0.0000000000000000E+00 */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-MAY-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* correct state transformation for light time rate */ - -/* -& */ - -/* Local variables */ - - -/* Determine the sign of the light time correction. */ - - if (*xmit) { - ltsign = 1.; - } else { - ltsign = -1.; - } - -/* Since the only block we're changing is */ -/* the lower left, first copy the input matrix */ -/* to the output matrix. */ - - moved_(xform, &c__36, corxfm); - -/* Adjust the rotation derivative block for */ -/* the rate of change of light time. All */ -/* that's required is to scale the block by */ - -/* 1 + LTSIGN*DLT */ - - - scale = ltsign * *dlt + 1.; - for (col = 1; col <= 3; ++col) { - -/* Scale the vector starting at index */ -/* (4,COL) in place. */ - - vsclip_(&scale, &corxfm[(i__1 = col * 6 - 3) < 36 && 0 <= i__1 ? i__1 - : s_rnge("corxfm", i__1, "zzcorsxf_", (ftnlen)447)]); - } - return 0; -} /* zzcorsxf_ */ - diff --git a/ext/spice/src/cspice/zzcputim.c b/ext/spice/src/cspice/zzcputim.c deleted file mode 100644 index 2141277dce..0000000000 --- a/ext/spice/src/cspice/zzcputim.c +++ /dev/null @@ -1,241 +0,0 @@ -/* - --Procedure zzcputim ( CPU Time ) - --Abstract - - Fetch the current CPU date and time and store the result - as a double precision 6-vector. - --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 - - TIME - UTILITY - -*/ - #include - #include "SpiceUsr.h" - - int zzcputim_ ( SpiceDouble *tvec ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - tvec O contains year, month, day, hours, minutes, seconds - - The function returns a status value that indicates whether an error - occurred. This is in addition to standard CSPICE error handling. - --Detailed_Input - - None. - --Detailed_Output - - tvec is a 6-vector containing the current system time. - The various components have the following meaning - - tvec[0] --- current calendar year - tvec[1] --- current month - tvec[2] --- current day of month - tvec[3] --- current hour. Hours have a range from - 0 to 23. 0 corresponds to system - midnight. - tvec[4] --- current minutes - tvec[5] --- current seconds - - All six components will be double precision - integers. (They truncate without change.) - - The function returns a status value that indicates whether an error - occurred. This is in addition to standard CSPICE error handling. - --Parameters - - None. - --Exceptions - - 1) If the system time cannot be obtained, the error - SPICE(CLIBCALLFAILED) is signaled. The returned status value - from the C library routine "time" is output as a function return - value. - --Files - - None. - --Particulars - - This routine returns the components of the current date and - time as determined by the system clock. - - This routine replaces the routine produced by running f2c on - zzcputim.f. - --Examples - - Example 1. - - The following routine illustrates how you might use zzcputim_ - to generate a "time stamp" that might be used to tag data - you plan to write to a file. - - #include "SpiceUsr.h" - - void tstamp ( SpiceChar *stamp ) - { - - SpiceDouble tvec[6]; - - /. - First fetch the current system time. - ./ - zzcputim_ ( tvec ); - - /. - Now form a time stamp of the form YYYYYMMDDhhmmss. - ./ - dpfmt_c ( tvec[0], "0yyyy", 5, stamp ); - dpfmt_c ( tvec[1], "0m", 2, stamp+5 ); - dpfmt_c ( tvec[2], "0d", 2, stamp+7 ); - dpfmt_c ( tvec[3], "0H", 2, stamp+9 ); - dpfmt_c ( tvec[4], "0M", 2, stamp+11 ); - dpfmt_c ( tvec[5], "0S", 2, stamp+13 ); - } - - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - --Version - - -CSPICE Version 1.0.0, 18-FEB-2008 (KRG)(NJB)(BVS) - - Initial version. Except for the function name it is identical - to the cputim.c provided in CSUPPORT from 1999 through 2007. - --Index_Entries - - get system date and time - --& -*/ - -{ /* Begin zzcputim_c */ - - /* - Local constants - */ - - /* - The C library routine time returns the value -1 if "the time is - not available" according to K&R, Second Edition. - - We also return this non-zero value if the call to the C library - routine localtime gives us a null pointer. - */ - #define TIME_ERROR -1 - - - /* - Local variables - */ - int status; - time_t localTime; - struct tm * timeStruct; - - - /* - Participate in error tracing. - */ - chkin_c ( "zzcputim_" ); - - /* - Get the local time. The returned status will be TIME_ERROR if - an error occurred. - */ - status = time ( &localTime ); - - if ( status == TIME_ERROR ) - { - setmsg_c ( "C function \"time\" returned status #." ); - errint_c ( "#", status ); - sigerr_c ( "SPICE(CLIBCALLFAILED)" ); - chkout_c ( "zzcputim_" ); - return ( status ); - } - - /* - Get a local pointer to a "tm" structure representing the time. - We can extract integer components from this structure. - */ - timeStruct = localtime ( &localTime ); - - if ( timeStruct == (struct tm *) NULL ) - { - setmsg_c ( "C function \"localtime\" returned null pointer." ); - sigerr_c ( "SPICE(CLIBCALLFAILED)" ); - chkout_c ( "zzcputim_" ); - return ( TIME_ERROR ); - } - - /* - Set the output time vector. Conversion from int to double is - automatic. Return a value of 0 indicating "success." - */ - tvec[0] = timeStruct-> tm_year + 1900; - tvec[1] = timeStruct-> tm_mon + 1; - tvec[2] = timeStruct-> tm_mday; - tvec[3] = timeStruct-> tm_hour; - tvec[4] = timeStruct-> tm_min; - tvec[5] = timeStruct-> tm_sec; - - - chkout_c ( "zzcputim_" ); - return ( 0 ); - -} /* End zzcputim_ */ diff --git a/ext/spice/src/cspice/zzdafgdr.c b/ext/spice/src/cspice/zzdafgdr.c deleted file mode 100644 index 23bde1a15b..0000000000 --- a/ext/spice/src/cspice/zzdafgdr.c +++ /dev/null @@ -1,605 +0,0 @@ -/* zzdafgdr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static logical c_false = FALSE_; -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure ZZDAFGDR ( Private --- DAF Get Data Record ) */ -/* Subroutine */ int zzdafgdr_(integer *handle, integer *recno, doublereal * - dprec, logical *found) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer natbff = 0; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_rdue(cilist *), - do_uio(integer *, char *, ftnlen), e_rdue(void); - - /* Local variables */ - integer ibff, iamh; - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzddhnfo_(integer *, char *, integer *, integer *, - integer *, logical *, ftnlen), zzddhhlu_(integer *, char *, - logical *, integer *, ftnlen), zzxlated_(integer *, char *, - integer *, doublereal *, ftnlen), zzplatfm_(char *, char *, - ftnlen, ftnlen); - integer i__; - char fname[255]; - integer iarch; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal dpbuf[128]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen), moved_(doublereal *, - integer *, doublereal *); - extern logical failed_(void); - logical locfnd; - char chrbuf[1024]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char strbff[8*4]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - char tmpstr[8]; - integer lun; - - /* Fortran I/O blocks */ - static cilist io___13 = { 1, 0, 1, 0, 0 }; - static cilist io___15 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a data record from a DAF. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the DAF. */ -/* RECNO I Record number. */ -/* DPREC O Contents of the record. */ -/* FOUND O Logical indicating whether the record was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with the DAF. */ - -/* RECNO is the record number of a particular double precision */ -/* record within the DAF, whose contents are to be read. */ - -/* $ Detailed_Output */ - -/* DPREC contains the contents of the specified record from */ -/* the DAF associated with HANDLE. */ - -/* FOUND is TRUE when the specified record is found, and is */ -/* FALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads data from the DAF associated with HANDLE. */ -/* This action may result in connecting a logical unit to the */ -/* file, if the handle manager has rotated the file out of the */ -/* unit table. */ - -/* $ Exceptions */ - -/* 1) SPICE(HANDLENOTFOUND) is signaled if HANDLE can not be */ -/* found in the set of loaded handles. */ - -/* 2) Routines in the call tree of this routine may trap and */ -/* signal errors. */ - -/* $ Particulars */ - -/* This routine reads records of double precision numbers */ -/* from native and supported non-native DAFs. */ - -/* The size of the character buffer and the number of records */ -/* read may have to change to support new environments. As of */ -/* the original release of this routine, all systems currently */ -/* supported have a 1 kilobyte record length. */ - -/* $ Examples */ - -/* See DAFGDR for sample usage. */ - -/* $ Restrictions */ - -/* 1) Numeric data when read as characters from a file preserves */ -/* the bit patterns present in the file in memory. */ - -/* 2) A record of double precision data is at most 1024 characters */ -/* in length. */ - -/* 3) DPREC has enough space to store 128 double precision numbers. */ - -/* 4) RECNO points to a record that contains double precision data */ -/* in the file to which HANDLE refers. */ - -/* 5) ZZXLATED will translate all possible inputs (garbage or not) */ -/* coming from the file associated with HANDLE. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDAFGDR", (ftnlen)8); - } - -/* Perform some initialization tasks. */ - - if (first) { - -/* Populate STRBFF, the buffer that contains the labels */ -/* for each binary file format. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzdafgdr_", (ftnlen) - 206)) << 3), (ftnlen)3, (ftnlen)8); - } - -/* Fetch the native binary file format and determine its */ -/* integer code. */ - - zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8); - if (natbff == 0) { - setmsg_("The binary file format, '#', is not supported by this v" - "ersion of the toolkit. This is a serious problem, contac" - "t NAIF.", (ftnlen)118); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; - } - -/* Do not perform initialization tasks again. */ - - first = FALSE_; - } - -/* Assume the data record will not be found, until it has been read */ -/* from the file, and if necessary, successfully translated. */ - - *found = FALSE_; - -/* Retrieve information regarding the file from the handle manager. */ -/* The value of IARCH is not a concern, since this is a DAF routine */ -/* all values passed into handle manager entry points will have */ -/* 'DAF' as their architecture arguments. */ - - zzddhnfo_(handle, fname, &iarch, &ibff, &iamh, &locfnd, (ftnlen)255); - if (! locfnd) { - setmsg_("Unable to locate file associated with HANDLE, #. The most " - "likely cause of this is the file that you are trying to read" - " has been closed.", (ftnlen)136); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(HANDLENOTFOUND)", (ftnlen)21); - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; - } - -/* Now get a logical unit for the handle. Check FAILED() in */ -/* case an error occurs. */ - - zzddhhlu_(handle, "DAF", &c_false, &lun, (ftnlen)3); - if (failed_()) { - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; - } - -/* Branch based on whether the binary file format is native */ -/* or not. Only supported formats can be opened by ZZDDHOPN, */ -/* so no check of IBFF is required. */ - - if (ibff == natbff) { - -/* In the native case, just read the double precision */ -/* numbers from the file. */ - - io___13.ciunit = lun; - io___13.cirec = *recno; - iostat = s_rdue(&io___13); - if (iostat != 0) { - goto L100001; - } - for (i__ = 1; i__ <= 128; ++i__) { - iostat = do_uio(&c__1, (char *)&dpbuf[(i__1 = i__ - 1) < 128 && 0 - <= i__1 ? i__1 : s_rnge("dpbuf", i__1, "zzdafgdr_", ( - ftnlen)284)], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100001; - } - } - iostat = e_rdue(); -L100001: - -/* Since this routine does not signal any IOSTAT based */ -/* errors, return if a non-zero value is assigned to IOSTAT. */ - - if (iostat != 0) { - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; - } - -/* Process the non-native binary file format case. */ - - } else { - -/* Read the data record as characters. */ - - io___15.ciunit = lun; - io___15.cirec = *recno; - iostat = s_rdue(&io___15); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, chrbuf, (ftnlen)1024); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - -/* Again, since this routine does not signal any IOSTAT */ -/* based errors, return if one occurs. */ - - if (iostat != 0) { - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; - } - -/* Translate the data record. Assume (improperly in the */ -/* general case) that ZZXLATED will translate the contents */ -/* of the entire record without signaling an error. This */ -/* is appropriate at this stage since ZZXLATED simply swaps */ -/* bytes between BIG-IEEE and LTL-IEEE environments. In */ -/* the future, updates may be necessary to prevent */ -/* processing of garbage data. */ - - zzxlated_(&ibff, chrbuf, &c__128, dpbuf, (ftnlen)1024); - if (failed_()) { - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; - } - } - -/* Transfer the DPs to the output argument and return */ -/* to the caller. */ - - *found = TRUE_; - moved_(dpbuf, &c__128, dprec); - chkout_("ZZDAFGDR", (ftnlen)8); - return 0; -} /* zzdafgdr_ */ - diff --git a/ext/spice/src/cspice/zzdafgfr.c b/ext/spice/src/cspice/zzdafgfr.c deleted file mode 100644 index b3237f9a0d..0000000000 --- a/ext/spice/src/cspice/zzdafgfr.c +++ /dev/null @@ -1,684 +0,0 @@ -/* zzdafgfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure ZZDAFGFR ( Private --- DAF Get Data Record ) */ -/* Subroutine */ int zzdafgfr_(integer *handle, char *idword, integer *nd, - integer *ni, char *ifname, integer *fward, integer *bward, integer * - free, logical *found, ftnlen idword_len, ftnlen ifname_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer natbff = 0; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_rdue(cilist *), - do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer ibff, iamh; - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzddhnfo_(integer *, char *, integer *, integer *, - integer *, logical *, ftnlen), zzddhhlu_(integer *, char *, - logical *, integer *, ftnlen), zzplatfm_(char *, char *, ftnlen, - ftnlen), zzxlatei_(integer *, char *, integer *, integer *, - ftnlen); - integer i__; - char fname[255]; - integer iarch; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer locnd; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - integer locni; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - logical locfnd; - char chrbuf[1024], locifn[60]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer cindex, locbwd; - char locidw[8]; - integer locfre; - static char strbff[8*4]; - integer locfwd; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - char tmpstr[8]; - integer lun; - - /* Fortran I/O blocks */ - static cilist io___13 = { 1, 0, 1, 0, 1 }; - static cilist io___21 = { 1, 0, 1, 0, 1 }; - - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read the contents of the file record of a DAF. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the DAF. */ -/* IDWORD O DAF ID Word that indicates file type. */ -/* ND O Number of double precision components in summaries. */ -/* NI O Number of integer components in summaries. */ -/* IFNAME O Internal file name. */ -/* FWARD O Forward list pointer. */ -/* BWARD O Backward list pointer. */ -/* FREE O Free address pointer. */ -/* FOUND O Logical indicating whether the record was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with the DAF. */ - -/* $ Detailed_Output */ - -/* IDWORD is a character string identifying the architecture */ -/* and type of a SPICE binary kernel. In this case */ -/* it will be a string identifying the type of DAF. */ - -/* ND, */ -/* NI are the number of double precision and integer */ -/* components, respectively, in each array summary in */ -/* the specified file. */ - -/* IFNAME is the internal file name stored in the first */ -/* (or file) record of the specified file. */ - -/* FWARD is the forward list pointer. This points to the */ -/* first summary record in the file. (Records between */ -/* the first record and the first summary record are */ -/* reserved when the file is created, and are invisible */ -/* to DAF routines.) */ - -/* BWARD is the backward list pointer. This points */ -/* to the final summary record in the file. */ - -/* FREE is the free address pointer. This contains the */ -/* first free address in the file. (That is, the */ -/* initial address of the next array to be added */ -/* to the file.) */ - -/* FOUND is TRUE when the file record is found, and is */ -/* FALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads data from the DAF associated with HANDLE. */ -/* This action may result in connecting a logical unit to the */ -/* file, if the handle manager has rotated the file out of the */ -/* unit table. */ - -/* $ Exceptions */ - -/* 1) SPICE(HANDLENOTFOUND) is signaled if HANDLE can not be */ -/* found in the set of loaded handles. The output arguments */ -/* are unmodified when this error occurs. */ - -/* 2) Routines in the call tree of this routine may trap and */ -/* signal errors. The output arguments are unmodified in */ -/* these cases. */ - -/* $ Particulars */ - -/* This routine reads the publically available components of */ -/* file records from native and supported non-native DAFs. */ - -/* The size of the character buffer and the number of records */ -/* read may have to change to support new environments. As of */ -/* the original release of this routine, all systems currently */ -/* supported have a 1 kilobyte record length. */ - -/* $ Examples */ - -/* See DAFRFR for sample usage. */ - -/* $ Restrictions */ - -/* 1) Numeric data when read as characters from a file preserves */ -/* the bit patterns present in the file in memory. */ - -/* 2) A record of double precision data is at most 1024 characters */ -/* in length. */ - -/* 3) Future updates to this module must preserve the fact that */ -/* FOUND is returned as FALSE whenever an error occurs. An */ -/* incompletely translated or extracted file record is NOT */ -/* FOUND. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - -/* Record Number of the file record in a DAF. */ - - -/* Length of the IDWORD string. */ - - -/* Length of the internal filename string. */ - - -/* Starting location in bytes of the internal filename in the */ -/* file record. */ - - -/* Size of an integer in bytes. */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDAFGFR", (ftnlen)8); - } - -/* Perform some initialization tasks. */ - - if (first) { - -/* Populate STRBFF, the buffer that contains the labels */ -/* for each binary file format. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzdafgfr_", (ftnlen) - 275)) << 3), (ftnlen)3, (ftnlen)8); - } - -/* Fetch the native binary file format and determine its */ -/* integer code. */ - - zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8); - if (natbff == 0) { - setmsg_("The binary file format, '#', is not supported by this v" - "ersion of the toolkit. This is a serious problem, contac" - "t NAIF.", (ftnlen)118); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; - } - -/* Do not perform initialization tasks again. */ - - first = FALSE_; - } - -/* Assume the data record will not be found, until it has been read */ -/* from the file, and if necessary, successfully translated. */ - - *found = FALSE_; - -/* Retrieve information regarding the file from the handle manager. */ -/* The value of IARCH is not a concern, since this is a DAF routine */ -/* all values passed into handle manager entry points will have */ -/* 'DAF' as their architecture arguments. */ - - zzddhnfo_(handle, fname, &iarch, &ibff, &iamh, &locfnd, (ftnlen)255); - if (! locfnd) { - setmsg_("Unable to locate file associated with HANDLE, #. The most " - "likely cause of this is the file that you are trying to read" - " has been closed.", (ftnlen)136); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(HANDLENOTFOUND)", (ftnlen)21); - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; - } - -/* Now get a logical unit for the handle. Check FAILED() in */ -/* case an error occurs. */ - - zzddhhlu_(handle, "DAF", &c_false, &lun, (ftnlen)3); - if (failed_()) { - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; - } - -/* Branch based on whether the binary file format is native */ -/* or not. Only supported formats can be opened by ZZDDHOPN, */ -/* so no check of IBFF is required. */ - - if (ibff == natbff) { - -/* In the native case, just read the components of the file */ -/* record from the file. */ - - io___13.ciunit = lun; - iostat = s_rdue(&io___13); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locidw, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locnd, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locni, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locfwd, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locbwd, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&locfre, (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - -/* Since this routine does not signal any IOSTAT based */ -/* errors, return if a non-zero value is assigned to IOSTAT. */ - - if (iostat != 0) { - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; - } - -/* Process the non-native binary file format case. */ - - } else { - -/* Read the data record as characters. */ - - io___21.ciunit = lun; - iostat = s_rdue(&io___21); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, chrbuf, (ftnlen)1024); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - -/* Again, since this routine does not signal any IOSTAT */ -/* based errors, return if one occurs. */ - - if (iostat != 0) { - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; - } - -/* Assign the character components of the file record. */ - - s_copy(locidw, chrbuf, (ftnlen)8, (ftnlen)8); - s_copy(locifn, chrbuf + 16, (ftnlen)60, (ftnlen)60); - -/* Convert the integer components. */ - - cindex = 9; - zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locnd, (ftnlen)4); - cindex += 4; - zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locni, (ftnlen)4); - cindex = 77; - zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locfwd, (ftnlen)4); - cindex += 4; - zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locbwd, (ftnlen)4); - cindex += 4; - zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locfre, (ftnlen)4); - if (failed_()) { - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; - } - } - -/* Transfer the contents of the record to the output arguments */ -/* and return to the caller. */ - - *found = TRUE_; - s_copy(idword, locidw, idword_len, (ftnlen)8); - *nd = locnd; - *ni = locni; - s_copy(ifname, locifn, ifname_len, (ftnlen)60); - *fward = locfwd; - *bward = locbwd; - *free = locfre; - chkout_("ZZDAFGFR", (ftnlen)8); - return 0; -} /* zzdafgfr_ */ - diff --git a/ext/spice/src/cspice/zzdafgsr.c b/ext/spice/src/cspice/zzdafgsr.c deleted file mode 100644 index 725c70af7d..0000000000 --- a/ext/spice/src/cspice/zzdafgsr.c +++ /dev/null @@ -1,736 +0,0 @@ -/* zzdafgsr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static logical c_false = FALSE_; -static integer c__1 = 1; -static integer c__128 = 128; - -/* $Procedure ZZDAFGSR ( Private --- DAF Get Summary/Descriptor Record ) */ -/* Subroutine */ int zzdafgsr_(integer *handle, integer *recno, integer *nd, - integer *ni, doublereal *dprec, logical *found) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer natbff = 0; - - /* System generated locals */ - integer i__1, i__2; - static doublereal equiv_0[128]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_rdue(cilist *), - do_uio(integer *, char *, ftnlen), e_rdue(void); - - /* Local variables */ - integer ibff, iamh, left, nsum; - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzddhnfo_(integer *, char *, integer *, integer *, - integer *, logical *, ftnlen), zzddhhlu_(integer *, char *, - logical *, integer *, ftnlen), zzxlated_(integer *, char *, - integer *, doublereal *, ftnlen), zzplatfm_(char *, char *, - ftnlen, ftnlen), zzxlatei_(integer *, char *, integer *, integer * - , ftnlen); - integer i__; - char fname[255]; - integer iarch; - extern /* Subroutine */ int chkin_(char *, ftnlen); -#define dpbuf (equiv_0) - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); -#define inbuf ((integer *)equiv_0) - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - extern logical failed_(void); - logical locfnd; - char chrbuf[1024]; - integer cindex; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer dindex; - static char strbff[8*4]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - char tmpstr[8]; - integer sumsiz, lun; - - /* Fortran I/O blocks */ - static cilist io___15 = { 1, 0, 1, 0, 0 }; - static cilist io___16 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a summary/descriptor record from a DAF. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of the DAF. */ -/* RECNO I Record number. */ -/* ND I Number of double precision components in a summary. */ -/* NI I Number of integer components in a summary. */ -/* DPREC O Contents of the record. */ -/* FOUND O Logical indicating whether the record was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with the DAF. */ - -/* RECNO is the record number of a particular summary record */ -/* within the DAF, whose contents are to be read. */ -/* ND, */ -/* NI are the number of double precision and integer */ -/* components, respectively, in each array summary */ -/* in the specified file. */ - -/* $ Detailed_Output */ - -/* DPREC contains the contents of the specified record from */ -/* the DAF associated with HANDLE, properly translated */ -/* for use on the native environment. */ - -/* FOUND is TRUE when the specified record is found, and is */ -/* FALSE otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads data from the DAF associated with HANDLE. */ -/* This action may result in connecting a logical unit to the */ -/* file, if the handle manager has rotated the file out of the */ -/* unit table. */ - -/* $ Exceptions */ - -/* 1) SPICE(HANDLENOTFOUND) is signaled if HANDLE can not be */ -/* found in the set of loaded handles. */ - -/* 2) Routines in the call tree of this routine may trap and */ -/* signal errors. */ - -/* $ Particulars */ - -/* This routine reads summary records of double precision */ -/* numbers which contain integers packed through an EQUIVALENCE */ -/* statement from native and supported non-native DAFs. */ - -/* The size of the character buffer and the number of records */ -/* read may have to change to support new environments. As of */ -/* the original release of this routine, all systems currently */ -/* supported have a 1 kilobyte record length. */ - -/* $ Examples */ - -/* See DAFGSR for sample usage. */ - -/* $ Restrictions */ - -/* 1) Numeric data when read as characters from a file preserves */ -/* the bit patterns present in the file in memory. */ - -/* 2) A record of double precision data is at most 1024 characters */ -/* in length. */ - -/* 3) DPREC has enough space to store 128 double precision numbers. */ - -/* 4) Characters a byte-sized, 8 characters constitute a double */ -/* precision number, and 4 characters an integer. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - -/* Length in bytes of double precision numbers and integers. */ - - -/* Local Variables */ - - -/* Equivalence DPBUF to INBUF. */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDAFGSR", (ftnlen)8); - } - -/* Perform some initialization tasks. */ - - if (first) { - -/* Populate STRBFF, the buffer that contains the labels */ -/* for each binary file format. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzdafgsr_", (ftnlen) - 235)) << 3), (ftnlen)3, (ftnlen)8); - } - -/* Fetch the native binary file format and determine its */ -/* integer code. */ - - zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8); - if (natbff == 0) { - setmsg_("The binary file format, '#', is not supported by this v" - "ersion of the toolkit. This is a serious problem, contac" - "t NAIF.", (ftnlen)118); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Do not perform initialization tasks again. */ - - first = FALSE_; - } - -/* Assume the data record will not be found, until it has been read */ -/* from the file, and if necessary, successfully translated. */ - - *found = FALSE_; - -/* Retrieve information regarding the file from the handle manager. */ -/* The value of IARCH is not a concern, since this is a DAF routine */ -/* all values passed into handle manager entry points will have */ -/* 'DAF' as their architecture arguments. */ - - zzddhnfo_(handle, fname, &iarch, &ibff, &iamh, &locfnd, (ftnlen)255); - if (! locfnd) { - setmsg_("Unable to locate file associated with HANDLE, #. The most " - "likely cause of this is the file that you are trying to read" - " has been closed.", (ftnlen)136); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(HANDLENOTFOUND)", (ftnlen)21); - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Now get a logical unit for the handle. Check FAILED() */ -/* in case an error occurs. */ - - zzddhhlu_(handle, "DAF", &c_false, &lun, (ftnlen)3); - if (failed_()) { - *found = FALSE_; - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Branch based on whether the binary file format is native */ -/* or not. Only supported formats can be opened by ZZDDHOPN, */ -/* so no check of IBFF is required. */ - - if (ibff == natbff) { - -/* In the native case, just read the array of double precision */ -/* numbers from the file. The packed integers will be */ -/* processed properly by the READ. */ - - io___15.ciunit = lun; - io___15.cirec = *recno; - iostat = s_rdue(&io___15); - if (iostat != 0) { - goto L100001; - } - for (i__ = 1; i__ <= 128; ++i__) { - iostat = do_uio(&c__1, (char *)&dpbuf[(i__1 = i__ - 1) < 128 && 0 - <= i__1 ? i__1 : s_rnge("dpbuf", i__1, "zzdafgsr_", ( - ftnlen)315)], (ftnlen)sizeof(doublereal)); - if (iostat != 0) { - goto L100001; - } - } - iostat = e_rdue(); -L100001: - -/* Since this routine does not signal any IOSTAT based */ -/* errors, return if a non-zero value is assigned to IOSTAT. */ - - if (iostat != 0) { - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Process the non-native binary file format case. */ - - } else { - -/* Read the record as characters. */ - - io___16.ciunit = lun; - io___16.cirec = *recno; - iostat = s_rdue(&io___16); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, chrbuf, (ftnlen)1024); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - -/* Again, since this routine does not signal any IOSTAT */ -/* based errors, return if one occurs. */ - - if (iostat != 0) { - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Translate the summary record. First extract the leading */ -/* 3 double precision numbers from the summary record as these */ -/* respectively are NEXT, PREV, and NSUM. */ - - zzxlated_(&ibff, chrbuf, &c__128, dpbuf, (ftnlen)24); - -/* Check FAILED() in case the translation process fails for */ -/* any reason. */ - - if (failed_()) { - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Convert NSUM to an integer, and compute the number of */ -/* double precision numbers required to store each individual */ -/* summary in the record. */ - - nsum = (integer) dpbuf[2]; - sumsiz = *nd + (*ni + 1) / 2; - -/* Convert each of the summaries one at a time. */ - - i__1 = nsum; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Set the start index into the double precision array */ -/* to receive the componets. Also set the character */ -/* substring index to the start location for this summary. */ -/* In the diagram below, each box represents a double */ -/* precision number. The figure assumes SUMSIZ is 5 */ -/* double precision numbers: */ - -/* |--- 1 ---|--- 2 ---|--- 3 ---| |- (I-1) -| */ -/* ------------------------------------- ------------- */ -/* | | | | | | | | | | | | | | | | | | |...| | | | | | |... */ -/* ------------------------------------- ------------- */ -/* |-----| ^ */ -/* ^ | */ -/* | Summary */ -/* NEXT, PREV, NSUM Start */ - - dindex = (i__ - 1) * sumsiz + 4; - cindex = (dindex - 1 << 3) + 1; - -/* First, check to see if there are any double precision */ -/* numbers to translate. If so, translate, and then */ -/* increment DINDEX and CINDEX accordingly. */ - - if (*nd > 0) { - -/* DPBUF has room for 128 double precision numbers */ -/* total. Compute the amount of space left in the */ -/* buffer. */ - - left = 128 - (i__ - 1) * sumsiz - 3; - zzxlated_(&ibff, chrbuf + (cindex - 1), &left, &dpbuf[(i__2 = - dindex - 1) < 128 && 0 <= i__2 ? i__2 : s_rnge("dpbuf" - , i__2, "zzdafgsr_", (ftnlen)412)], cindex + (*nd << - 3) - 1 - (cindex - 1)); - -/* If the translation routine fails for any reason, */ -/* check out and return. */ - - if (failed_()) { - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - dindex += *nd; - cindex += *nd << 3; - } - -/* At this point DINDEX and CINDEX are pointing at the */ -/* locations for the packed integers in the record. */ -/* Use DINDEX to compute the index into INBUF, the */ -/* equivalenced integer buffer and translate. */ - - if (*ni > 0) { - -/* INBUF has room for 256 integers total. Compute */ -/* the amount of space left in the buffer. Since */ -/* it is equivalenced to DPBUF, account for the */ -/* double precision numbers that were just added. */ - - left = 256 - (i__ - 1 << 1) * sumsiz - (*nd << 1) - 6; - zzxlatei_(&ibff, chrbuf + (cindex - 1), &left, &inbuf[(i__2 = - (dindex << 1) - 2) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbuf", i__2, "zzdafgsr_", (ftnlen)447)], cindex + (* - ni << 2) - 1 - (cindex - 1)); - -/* If the translation routine fails for any reason, */ -/* check out and return. */ - - if (failed_()) { - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; - } - -/* Now check to see if NI is odd. If so, then zero */ -/* the last integer occupied by the newly translated */ -/* summary. This is necessary to purge any garbage */ -/* present in memory. */ - - if (*ni % 2 == 1) { - inbuf[(i__2 = (dindex << 1) - 1 + *ni - 1) < 256 && 0 <= - i__2 ? i__2 : s_rnge("inbuf", i__2, "zzdafgsr_", ( - ftnlen)468)] = 0; - } - } - } - -/* Translating garbage is a bad idea in general, so set */ -/* the any remaining double precision numbers in the summary */ -/* record to 0. */ - - dindex = nsum * sumsiz + 4; - for (i__ = dindex; i__ <= 128; ++i__) { - dpbuf[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("dpbuf", - i__1, "zzdafgsr_", (ftnlen)483)] = 0.; - } - } - -/* Transfer the DPs to the output argument and return to the */ -/* caller. */ - - *found = TRUE_; - moved_(dpbuf, &c__128, dprec); - chkout_("ZZDAFGSR", (ftnlen)8); - return 0; -} /* zzdafgsr_ */ - -#undef inbuf -#undef dpbuf - - diff --git a/ext/spice/src/cspice/zzdafnfr.c b/ext/spice/src/cspice/zzdafnfr.c deleted file mode 100644 index 3852f3c8a9..0000000000 --- a/ext/spice/src/cspice/zzdafnfr.c +++ /dev/null @@ -1,438 +0,0 @@ -/* zzdafnfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure ZZDAFNFR ( Private --- DAF write New File Record ) */ -/* Subroutine */ int zzdafnfr_(integer *lun, char *idword, integer *nd, - integer *ni, char *ifname, integer *fward, integer *bward, integer * - free, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen - format_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[3]; - integer i__1[3]; - cllist cl__1; - - /* Builtin functions */ - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - integer s_wdue(cilist *), do_uio(integer *, char *, ftnlen), e_wdue(void), - f_clos(cllist *); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int zzftpstr_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - char delim[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - char locifn[60], locidw[8], locfmt[8], nullch[1], lftbkt[6]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - char rgtbkt[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static char prenul[603]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - static char ftpstr[28], pstnul[297]; - char tststr[16]; - - /* Fortran I/O blocks */ - static cilist io___15 = { 1, 0, 0, 0, 1 }; - - -/* $ Abstract */ - -/* Write the file record to a new DAF file. */ - -/* $ 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 */ - -/* DAF */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: Private FTP Validation String Parameters */ - -/* zzftprms.inc Version 1 01-MAR-1999 (FST) */ - -/* This include file centralizes the definition of string sizes */ -/* and other parameters that are necessary to properly implement */ -/* the FTP error detection scheme for binary kernels. */ - -/* Before making any alterations to the contents of this file, */ -/* refer to the header of ZZFTPSTR for a detailed discussion of */ -/* the FTP validation string. */ - -/* Size of FTP Test String Component: */ - - -/* Size of Maximum Expanded FTP Validation String: */ - -/* (This indicates the size of a buffer to hold the test */ -/* string sequence from a possibly corrupt file. Empirical */ -/* evidence strongly indicates that expansion due to FTP */ -/* corruption at worst doubles the number of characters. */ -/* So take 3*SIZSTR to be on the safe side.) */ - - -/* Size of FTP Validation String Brackets: */ - - -/* Size of FTP Validation String: */ - - -/* Size of DELIM. */ - - -/* Number of character clusters present in the validation string. */ - - -/* End Include Section: Private FTP Validation String Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LUN I Logical unit number of an open DAF file. */ -/* IDWORD I DAF ID word. */ -/* ND I Number of double precision components in a summary. */ -/* NI I Number of integer componenets in a summary. */ -/* IFNAME I Internal filename. */ -/* FWARD I First descriptor record. */ -/* BWARD I Last descriptor record. */ -/* FREE I First free address. */ -/* FORMAT I File binary format identifier string. */ - -/* $ Detailed_Input */ - -/* LUN is a logical unit number of a DAF whose first record is */ -/* to be created with a DAF file record bearing the */ -/* attributes specified by the other arguments. */ - -/* IDWORD is the 'ID word' contained in the first eight */ -/* characters of the file record. */ - -/* ND, are the number of double precision and integer */ -/* NI components, respectively, in each array summary */ -/* in the specified file. */ - -/* IFNAME is the internal filename to be stored in the file */ -/* record for identification purposes. */ - -/* FWARD, are the record numbers of the first and last */ -/* BWARD descriptor records in the DAF file, respectively. */ -/* FWARD is greater than 2 whenever reserved records */ -/* are present. */ - -/* FREE is the first free address pointer. This integer */ -/* stores the first free DAF address for writing the */ -/* next array to be appended to the file. */ - -/* FORMAT is a character string that indicates what the numeric */ -/* binary format the DAF is utilizing. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See include file zzftprms.inc. */ - -/* $ Files */ - -/* This routine writes to the first record of the DAF whose */ -/* logical unit is LUN. */ - -/* $ Exceptions */ - -/* 1) If any errors occur from the WRITE to the logical unit LUN, */ -/* the error SPICE(DAFWRITEFAIL) is signaled. Before returning */ -/* to the caller, the file attached to LUN is closed and deleted. */ - -/* $ Particulars */ - -/* This routine assembles the file record and writes it to the */ -/* first record in a DAF. Its purpose is to write new file */ -/* records only. For updates, use DAFWFR. */ - -/* Make certain the caller checks FAILED() after this returns, since */ -/* on error it closes and deletes the file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) An individual character must occupy 1 byte of space and */ -/* conform to the ASCII standard. */ - -/* 2) The word size for the machine should be at least 32 bits, */ -/* else the computations to null pad the gaps in the file */ -/* record may overstep record boundaries. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 11-DEC-2001 (FST) */ - -/* Corrected the omission of IDWORD from the Brief_I/O and */ -/* Detailed_Input sections of the module header. */ - -/* - SPICELIB Version 1.0.0, 02-MAR-1999 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - -/* Amount of space measured in characters necessary to */ -/* null pad between the last character of FORMAT and the */ -/* first character of FTPSTR to keep FTPSTR at character */ -/* 700 in a 1024 byte record. */ - - -/* Amount of space measured in characters necessary to */ -/* null pad from the last character of FTPSTR to the */ -/* end of the file record. Note: This value assumes the */ -/* length of the file record is 1024 bytes. The DAF */ -/* specification only requires the presence of 1000 */ -/* characters, so this may requiremodification for */ -/* non-standard platforms. */ - - -/* Lengths of internal file name, ID word, and format word. */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDAFNFR", (ftnlen)8); - } - -/* On the first pass, format the PRENUL and PSTNUL strings, */ -/* and build FTPSTR from its components. */ - - if (first) { - -/* Store NULL into NULLCH. */ - - *(unsigned char *)nullch = '\0'; - -/* Set all of the characters of PRENUL to nulls. */ - - for (i__ = 1; i__ <= 603; ++i__) { - *(unsigned char *)&prenul[i__ - 1] = *(unsigned char *)nullch; - } - -/* Set all of the characters of PSTNUL to nulls. */ - - for (i__ = 1; i__ <= 297; ++i__) { - *(unsigned char *)&pstnul[i__ - 1] = *(unsigned char *)nullch; - } - -/* Build FTPSTR from its components that come back from */ -/* ZZFTPSTR. This private SPICE routine returns the */ -/* following components: */ -/* 7 */ -/* TSTSTR - The test component of the FTP string */ -/* LFTBKT - The left bracketing, printable, component of */ -/* the FTP string. */ -/* RGTBKT - The right bracketing, printable, component of */ -/* the FTP string. */ -/* DELIM - The printable delimiter that separates the */ -/* individual test character blocks in TSTSTR. */ - -/* which are assembled into the FTP string as it appears in */ -/* the DAF file record. */ - - zzftpstr_(tststr, lftbkt, rgtbkt, delim, (ftnlen)16, (ftnlen)6, ( - ftnlen)6, (ftnlen)1); -/* Writing concatenation */ - i__1[0] = rtrim_(lftbkt, (ftnlen)6), a__1[0] = lftbkt; - i__1[1] = rtrim_(tststr, (ftnlen)16), a__1[1] = tststr; - i__1[2] = rtrim_(rgtbkt, (ftnlen)6), a__1[2] = rgtbkt; - s_cat(ftpstr, a__1, i__1, &c__3, (ftnlen)28); - -/* Stop this block from executing except on the first pass. */ - - first = FALSE_; - } - -/* Make local copies of each of the string arguments. This way we */ -/* maintain the proper sizes for each of the string objects, in */ -/* the event larger or smaller strings are passed in. */ - - s_copy(locidw, idword, (ftnlen)8, idword_len); - s_copy(locifn, ifname, (ftnlen)60, ifname_len); - s_copy(locfmt, format, (ftnlen)8, format_len); - -/* Write the file record components out to the first record of the */ -/* file. */ - - io___15.ciunit = *lun; - iostat = s_wdue(&io___15); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locidw, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*nd), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*ni), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*fward), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*bward), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*free), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locfmt, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, prenul, (ftnlen)603); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, ftpstr, (ftnlen)28); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, pstnul, (ftnlen)297); - if (iostat != 0) { - goto L100001; - } - iostat = e_wdue(); -L100001: - -/* Check IOSTAT for errors. */ - - if (iostat != 0) { - -/* Since we are unable to write to the file record, make */ -/* certain the output file is destroyed. */ - - setmsg_("Attempt to write file '#' failed. Value of IOSTAT was #. Th" - "e file has been deleted.", (ftnlen)83); - errfnm_("#", lun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - cl__1.cerr = 0; - cl__1.cunit = *lun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - sigerr_("SPICE(DAFWRITEFAIL)", (ftnlen)19); - chkout_("ZZDAFNFR", (ftnlen)8); - return 0; - } - chkout_("ZZDAFNFR", (ftnlen)8); - return 0; -} /* zzdafnfr_ */ - diff --git a/ext/spice/src/cspice/zzdasnfr.c b/ext/spice/src/cspice/zzdasnfr.c deleted file mode 100644 index 5edcd26280..0000000000 --- a/ext/spice/src/cspice/zzdasnfr.c +++ /dev/null @@ -1,424 +0,0 @@ -/* zzdasnfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure ZZDASNFR ( Private --- DAS write New File Record ) */ -/* Subroutine */ int zzdasnfr_(integer *lun, char *idword, char *ifname, - integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, - char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[3]; - integer i__1[3]; - cllist cl__1; - - /* Builtin functions */ - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - integer s_wdue(cilist *), do_uio(integer *, char *, ftnlen), e_wdue(void), - f_clos(cllist *); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int zzftpstr_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - char delim[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - char locifn[60], locidw[8], locfmt[8], nullch[1], lftbkt[6]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - char rgtbkt[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static char prenul[607]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - static char ftpstr[28], pstnul[297]; - char tststr[16]; - - /* Fortran I/O blocks */ - static cilist io___15 = { 1, 0, 0, 0, 1 }; - - -/* $ Abstract */ - -/* Write the file record to a new DAS file. */ - -/* $ 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 */ - -/* DAS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: Private FTP Validation String Parameters */ - -/* zzftprms.inc Version 1 01-MAR-1999 (FST) */ - -/* This include file centralizes the definition of string sizes */ -/* and other parameters that are necessary to properly implement */ -/* the FTP error detection scheme for binary kernels. */ - -/* Before making any alterations to the contents of this file, */ -/* refer to the header of ZZFTPSTR for a detailed discussion of */ -/* the FTP validation string. */ - -/* Size of FTP Test String Component: */ - - -/* Size of Maximum Expanded FTP Validation String: */ - -/* (This indicates the size of a buffer to hold the test */ -/* string sequence from a possibly corrupt file. Empirical */ -/* evidence strongly indicates that expansion due to FTP */ -/* corruption at worst doubles the number of characters. */ -/* So take 3*SIZSTR to be on the safe side.) */ - - -/* Size of FTP Validation String Brackets: */ - - -/* Size of FTP Validation String: */ - - -/* Size of DELIM. */ - - -/* Number of character clusters present in the validation string. */ - - -/* End Include Section: Private FTP Validation String Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LUN I Logical unit number of an open DAS file. */ -/* IDWORD I DAS File ID word. */ -/* IFNAME I DAS internal file name. */ -/* NRESVR I Number of reserved records in file. */ -/* NRESVC I Number of characters in use in reserved rec. area. */ -/* NCOMR I Number of comment records in file. */ -/* NCOMC I Number of characters in use in comment area. */ -/* FORMAT I File binary format identifier string. */ - -/* $ Detailed_Input */ - -/* LUN is a logical unit number of a DAS whose first record is */ -/* to be created with a DAS file record bearing the */ -/* attributes specified by the other arguments. */ - -/* IDWORD is the 'ID word' contained in the first eight */ -/* characters of the file record. */ - -/* IFNAME is the internal file name of the DAS file. The */ -/* maximum length of the internal file name is 60 */ -/* characters. */ - -/* NRESVR is the number of reserved records in the DAS file */ -/* specified by HANDLE. */ - -/* NRESVC is the number of characters in use in the reserved */ -/* record area of the DAS file specified by HANDLE. */ - -/* NCOMR is the number of comment records in the DAS file */ -/* specified by HANDLE. */ - -/* NCOMC is the number of characters in use in the comment area */ -/* of the DAS file specified by HANDLE. */ - -/* FORMAT is a character string that indicates what the numeric */ -/* binary format the DAS is utilizing. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See include file zzftprms.inc. */ - -/* $ Files */ - -/* This routine writes to the first record of the DAS whose */ -/* logical unit is LUN. */ - -/* $ Exceptions */ - -/* 1) If any errors occur from the WRITE to the logical unit LUN, */ -/* the error SPICE(DASWRITEFAIL) is signaled. Before returing */ -/* to the caller, the file attached to LUN is closed and deleted. */ - -/* $ Particulars */ - -/* This routine assembles the file record and writes it to the */ -/* first record in a DAS. Its purpose is to write new file */ -/* records only. For updates, use DASWFR. */ - -/* Make certain the caller checks FAILED() after this returns, */ -/* since on error it closes and deletes the file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) An individual character must occupy 1 byte of space and */ -/* conform to the ASCII standard. */ - -/* 2) The word size for the machine should be at least 32 bits, */ -/* else the computations to null pad the gaps in the file */ -/* record may overstep record boundaries. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-DEC-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - -/* Amount of space measured in characters necessary to null pad */ -/* between the last character of FORMAT and the first character */ -/* of FTPSTR to keep FTPSTR at character 700 in a 1024 byte */ -/* record. */ - - -/* Amount of space measured in characters necessary to */ -/* null pad from the last character of FTPSTR to the */ -/* end of the file record. Note: This value assumes the */ -/* length of the file record is 1024 bytes. */ - - -/* Lengths of internal file name, ID word, and format word. */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDASNFR", (ftnlen)8); - } - -/* On the first pass, format the PRENUL and PSTNUL strings, */ -/* and build FTPSTR from its components. */ - - if (first) { - -/* Store NULL into NULLCH. */ - - *(unsigned char *)nullch = '\0'; - -/* Set all of the characters of PRENUL to nulls. */ - - for (i__ = 1; i__ <= 607; ++i__) { - *(unsigned char *)&prenul[i__ - 1] = *(unsigned char *)nullch; - } - -/* Set all of the characters of PSTNUL to nulls. */ - - for (i__ = 1; i__ <= 297; ++i__) { - *(unsigned char *)&pstnul[i__ - 1] = *(unsigned char *)nullch; - } - -/* Build FTPSTR from its components that come back from */ -/* ZZFTPSTR. This private SPICE routine returns the */ -/* following components: */ - -/* TSTSTR - The test component of the FTP string */ -/* LFTBKT - The left bracketing, printable, component of */ -/* the FTP string. */ -/* RGTBKT - The right bracketing, printable, component of */ -/* the FTP string. */ -/* DELIM - The printable delimiter that separates the */ -/* individual test character blocks in TSTSTR. */ - -/* which are assembled into the FTP string as it appears in */ -/* the DAS file record. */ - - zzftpstr_(tststr, lftbkt, rgtbkt, delim, (ftnlen)16, (ftnlen)6, ( - ftnlen)6, (ftnlen)1); -/* Writing concatenation */ - i__1[0] = rtrim_(lftbkt, (ftnlen)6), a__1[0] = lftbkt; - i__1[1] = rtrim_(tststr, (ftnlen)16), a__1[1] = tststr; - i__1[2] = rtrim_(rgtbkt, (ftnlen)6), a__1[2] = rgtbkt; - s_cat(ftpstr, a__1, i__1, &c__3, (ftnlen)28); - -/* Stop this block from executing except on the first pass. */ - - first = FALSE_; - } - -/* Make local copies of each of the string arguments. This way we */ -/* maintain the proper sizes for each of the string objects, in */ -/* the event larger or smaller strings are passed in. */ - - s_copy(locidw, idword, (ftnlen)8, idword_len); - s_copy(locifn, ifname, (ftnlen)60, ifname_len); - s_copy(locfmt, format, (ftnlen)8, format_len); - -/* Write the file record components out to the first record of the */ -/* file. */ - - io___15.ciunit = *lun; - iostat = s_wdue(&io___15); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locidw, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locifn, (ftnlen)60); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer)); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, locfmt, (ftnlen)8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, prenul, (ftnlen)607); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, ftpstr, (ftnlen)28); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, pstnul, (ftnlen)297); - if (iostat != 0) { - goto L100001; - } - iostat = e_wdue(); -L100001: - -/* Check IOSTAT for errors. */ - - if (iostat != 0) { - -/* Since we are unable to write to the file record, make */ -/* certain the output file is destroyed. */ - - setmsg_("Attempt to write file '#' failed. Value of IOSTAT was #. Th" - "e file has been deleted.", (ftnlen)83); - errfnm_("#", lun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - cl__1.cerr = 0; - cl__1.cunit = *lun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - sigerr_("SPICE(DASWRITEFAIL)", (ftnlen)19); - chkout_("ZZDASNFR", (ftnlen)8); - return 0; - } - chkout_("ZZDASNFR", (ftnlen)8); - return 0; -} /* zzdasnfr_ */ - diff --git a/ext/spice/src/cspice/zzddhclu.c b/ext/spice/src/cspice/zzddhclu.c deleted file mode 100644 index a2845dece8..0000000000 --- a/ext/spice/src/cspice/zzddhclu.c +++ /dev/null @@ -1,134 +0,0 @@ -/* zzddhclu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZDDHCLU ( Private --- DDH Count Locks ) */ -integer zzddhclu_(logical *utlck, integer *nut) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer i__; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Retrieve the number of locked units in the unit table. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UTLCK I Lock column of the unit table. */ -/* NUT I Number of entries in the unit table. */ - -/* This function return the number of locked units in the unit table. */ - -/* $ Detailed_Input */ - -/* UTLCK is the lock column of the unit table. TRUE entries in */ -/* this column indicate a handle is locked to a particular */ -/* unit. */ - -/* NUT is the number of entries in the unit table. */ - -/* $ Detailed_Output */ - -/* The function returns the number of locked units in the unit table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine simply encapsulates some logic used in several */ -/* places in ZZDDHMAN. */ - -/* $ Examples */ - -/* See ZZDDHMAN for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 04-OCT-2001 (FST) */ - - -/* -& */ - -/* Local Variables */ - - -/* Loop through UTLCK counting the number of TRUE values. */ - - ret_val = 0; - i__1 = *nut; - for (i__ = 1; i__ <= i__1; ++i__) { - if (utlck[i__ - 1]) { - ++ret_val; - } - } - return ret_val; -} /* zzddhclu_ */ - diff --git a/ext/spice/src/cspice/zzddhf2h.c b/ext/spice/src/cspice/zzddhf2h.c deleted file mode 100644 index 77a1fe5466..0000000000 --- a/ext/spice/src/cspice/zzddhf2h.c +++ /dev/null @@ -1,773 +0,0 @@ -/* zzddhf2h.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZDDHF2H ( Private --- DDH Filename to Handle ) */ -/* Subroutine */ int zzddhf2h_(char *fname, integer *ftabs, integer *ftamh, - integer *ftarc, integer *ftbff, integer *fthan, char *ftnam, integer * - ftrtm, integer *nft, integer *utcst, integer *uthan, logical *utlck, - integer *utlun, integer *nut, logical *exists, logical *opened, - integer *handle, logical *found, ftnlen fname_len, ftnlen ftnam_len) -{ - /* System generated locals */ - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open( - olist *), f_clos(cllist *); - - /* Local variables */ - integer unit; - extern /* Subroutine */ int zzddhgtu_(integer *, integer *, logical *, - integer *, integer *, integer *), zzddhrmu_(integer *, integer *, - integer *, integer *, logical *, integer *, integer *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer rchar; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - extern integer isrchi_(integer *, integer *, integer *); - logical locopn; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer uindex; - logical locexs; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Convert filename to a handle. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of the file to convert to a handle. */ -/* FTABS, */ -/* FTAMH, */ -/* FTARC, */ -/* FTBFF, */ -/* FTHAN, */ -/* FTNAM, */ -/* FTRTM I File table. */ -/* NFT I Number of entries in the file table. */ -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN I/O Unit table. */ -/* NUT I/O Number of entries in the unit table. */ -/* EXISTS O Logical indicating if FNAME exists. */ -/* OPENED O Logical indicating if FNAME is opened. */ -/* HANDLE O Handle associated with FNAME. */ -/* FOUND O Logical indicating if FNAME's HANDLE was found. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of the file to locate in the file table. */ - -/* FTABS, */ -/* FTAMH, */ -/* FTARC, */ -/* FTBFF, */ -/* FTHAN, */ -/* FTNAM, */ -/* FTRTM are the arrays respectively containing the absolute */ -/* value of the handle, access method, architecture, */ -/* binary file format, handle, name, and RTRIM columns of */ -/* the file table. */ - -/* NFT is the number of entries in the file table. */ - -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN are the arrays respectively containing the cost, */ -/* handle, locked, and logical unit columns of the unit */ -/* table. */ - -/* NUT is the number of entries in the unit table. */ - -/* $ Detailed_Output */ - -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN are the arrays respectively containing the cost, */ -/* handle, locked, and logical unit columns of the unit */ -/* table. If ZZDDHF2H requires a logical unit, then */ -/* it will borrow one from the unit table. Depending */ -/* on the state of the table passed in from the caller */ -/* one of three possible scenarios may occur (Recall */ -/* that 'zero-cost' rows are ones whose units are */ -/* reserved with RESLUN and not currently connected */ -/* to any file.) */ - -/* A 'zero-cost' row exists in the table, in */ -/* which case the row is used temporarily and */ -/* may be removed depending on the number of entries */ -/* in the file table (NFT). */ - -/* The unit table is full (NUT=UTSIZE), in which */ -/* case the unit with the lowest cost that is not */ -/* locked to its handle will be disconnected, used, */ -/* and then returned to the table as a 'zero-cost' */ -/* row before returning to the caller. */ - -/* The unit table is not full (NUT= 1 && *id <= 4) { - s_copy(label, stramh + (((i__1 = *id - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("stramh", i__1, "zzddhgsd_", (ftnlen)216)) << 3), - label_len, (ftnlen)8); - } else if (clsid == 2 && *id >= 1 && *id <= 2) { - s_copy(label, strarc + (((i__1 = *id - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("strarc", i__1, "zzddhgsd_", (ftnlen)222)) << 3), - label_len, (ftnlen)8); - } else if (clsid == 3 && *id >= 1 && *id <= 4) { - s_copy(label, strbff + (((i__1 = *id - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("strbff", i__1, "zzddhgsd_", (ftnlen)228)) << 3), - label_len, (ftnlen)8); - } - return 0; -} /* zzddhgsd_ */ - diff --git a/ext/spice/src/cspice/zzddhgtu.c b/ext/spice/src/cspice/zzddhgtu.c deleted file mode 100644 index 94a3879c0a..0000000000 --- a/ext/spice/src/cspice/zzddhgtu.c +++ /dev/null @@ -1,539 +0,0 @@ -/* zzddhgtu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZDDHGTU ( Private --- DDH Get Unit ) */ -/* Subroutine */ int zzddhgtu_(integer *utcst, integer *uthan, logical *utlck, - integer *utlun, integer *nut, integer *uindex) -{ - /* System generated locals */ - integer i__1; - cllist cl__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), f_clos(cllist *); - - /* Local variables */ - logical done; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int orderi_(integer *, integer *, integer *), - frelun_(integer *), sigerr_(char *, ftnlen), getlun_(integer *), - chkout_(char *, ftnlen); - integer orderv[23]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Get or prepare an entry in the unit table to receive a new */ -/* file. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN, I/O Unit table. */ -/* NUT I/O Number of entries in the unit table. */ -/* UINDEX O Row in the unit table that can be replaced. */ - -/* $ Detailed_Input */ - -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN, are the arrays respectively containing the cost, */ -/* handle, locked, and logical unit columns of the */ -/* unit table. */ - -/* NUT is the number of entries in the unit table. */ - -/* $ Detailed_Output */ - -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN, are the arrays respectively containing the cost, */ -/* handle, locked, and logical unit columns of the */ -/* unit table. This may change as a new unit is */ -/* added or old ones are removed. */ - -/* NUT is the number of entries in the unit table. This may */ -/* change as new entries are added. */ - -/* UINDEX is the index of the row where the new unit should */ -/* be attached. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine may disconnect a file from its logical unit, to */ -/* successfully process the caller's request for a unit. */ - -/* $ Exceptions */ - -/* 1) If GETLUN fails to assign a logical unit for any reason to */ -/* the row of interest, this routine sets the logical unit to -1, */ -/* since negative logical units in Fortran are not permitted. */ - -/* $ Particulars */ - -/* This routine only manipulates the contents of the unit table. */ -/* Any "zero" cost rows in the table indicate rows where the */ -/* listed logical unit has been reserved, but no file is currently */ -/* attached. */ - -/* Callers of this routine should check FAILED since this */ -/* routine may invoke GETLUN. */ - -/* $ Examples */ - -/* See ZZDDHHLU for sample usage. */ - -/* $ Restrictions */ - -/* 1) This routine must not be used to retrieve a unit for a */ -/* file that is already connected to a unit listed in the */ -/* unit table. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 29-MAY-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE discovery error handling. */ - - if (return_()) { - return 0; - } - -/* First check the case when the unit table is completely empty. */ - - if (*nut == 0) { - *nut = 1; - *uindex = 1; - utcst[*uindex - 1] = 0; - uthan[*uindex - 1] = 0; - utlck[*uindex - 1] = FALSE_; - getlun_(&utlun[*uindex - 1]); - -/* Check FAILED to see if GETLUN signaled an error. If so, then */ -/* return an invalid unit to the caller. */ - - if (failed_()) { - utlun[*uindex - 1] = -1; - return 0; - } - -/* If we end up here, then GETLUN succeeded and we have the new */ -/* unit. Now return. */ - - return 0; - } - -/* If we reach here, then the table contains at least one entry. */ -/* Order the table rows by cost. */ - - orderi_(utcst, nut, orderv); - -/* Now check to for '0' cost rows as this indicates rows whose */ -/* logical units are reserved for this suite of routines usage, */ -/* but are not currently assigned a file. */ - - if (utcst[orderv[0] - 1] <= 0) { - *uindex = orderv[0]; - -/* '0' cost rows end up in the unit table as the result of a */ -/* row deletion, occurring when excess files are present. */ -/* When this process occurs, the logical unit listed in this */ -/* row is reserved for this module's usage only with RESLUN. */ -/* Free it, since we're about to reassign it. */ - - frelun_(&utlun[*uindex - 1]); - return 0; - } - -/* Now if no '0' cost rows exist, check to see if we can */ -/* expand the table. */ - - if (*nut < 23) { - -/* Now increment NUT and set UINDEX. */ - - ++(*nut); - *uindex = *nut; - -/* Prepare the default values for the new row. */ - - utcst[*uindex - 1] = 0; - uthan[*uindex - 1] = 0; - utlck[*uindex - 1] = FALSE_; - getlun_(&utlun[*uindex - 1]); - -/* Check FAILED to see if GETLUN signaled an error. If so, then */ -/* return an invalid unit to the caller. */ - - if (failed_()) { - utlun[*uindex - 1] = -1; - return 0; - } - -/* If we end up here, then GETLUN worked properly. Now return. */ - - return 0; - } - -/* If we reach here, then we have no zero-cost rows and a full unit */ -/* table. Now it's time to determine which entry in the table to */ -/* bump. We do this by stepping through the order vector until */ -/* we find the first 'non-locked' row. */ - - i__ = 0; - done = FALSE_; - while(! done && i__ != *nut) { - ++i__; - done = ! utlck[orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("orderv", i__1, "zzddhgtu_", (ftnlen)279)] - 1]; - } - -/* Before going any further, signal an error if we discover */ -/* we have not found a row. */ - - if (! done) { - *uindex = 0; - chkin_("ZZDDHGTU", (ftnlen)8); - setmsg_("The unit table is full and all entries are locked. This sh" - "ould never happen. Contact NAIF.", (ftnlen)91); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHGTU", (ftnlen)8); - return 0; - } - -/* Clear UTCST and UTHAN since we intend to disconnect */ -/* the unit upon return. */ - - utcst[orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("orderv", - i__1, "zzddhgtu_", (ftnlen)304)] - 1] = 0; - uthan[orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("orderv", - i__1, "zzddhgtu_", (ftnlen)305)] - 1] = 0; - -/* Set UINDEX and CLSLUN, then return. */ - - *uindex = orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("ord" - "erv", i__1, "zzddhgtu_", (ftnlen)310)]; - -/* At this point we need to close the unit from the row of interest. */ - - cl__1.cerr = 0; - cl__1.cunit = utlun[*uindex - 1]; - cl__1.csta = 0; - f_clos(&cl__1); - return 0; -} /* zzddhgtu_ */ - diff --git a/ext/spice/src/cspice/zzddhini.c b/ext/spice/src/cspice/zzddhini.c deleted file mode 100644 index d220f3d1a0..0000000000 --- a/ext/spice/src/cspice/zzddhini.c +++ /dev/null @@ -1,500 +0,0 @@ -/* zzddhini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure ZZDDHINI ( Private --- DDH Initialize Structures ) */ -/* Subroutine */ int zzddhini_(integer *natbff, integer *supbff, integer * - numsup, char *stramh, char *strarc, char *strbff, ftnlen stramh_len, - ftnlen strarc_len, ftnlen strbff_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical done; - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzplatfm_(char *, char *, ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), nextwd_(char *, char *, char *, - ftnlen, ftnlen, ftnlen); - char linstr[36]; - extern logical return_(void); - char tmpstr[8]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Initialize ZZDDHMAN data structures. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NATBFF O Native binary file format. */ -/* SUPBFF O List of supported binary file formats for reading. */ -/* NUMSUP O Number of entries returned in SUPBFF. */ -/* STRAMH O List of labels for METHOD ID codes */ -/* STRARC O List of labels for ARCH ID codes */ -/* STRBFF O List of labels for BFF ID codes */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* NATBFF is an integer code for the binary file format native */ -/* to this system as described in the include file */ -/* 'zzddhman.inc'. Possible values are the parameters: */ - -/* BIGI3E */ -/* LTLI3E */ -/* VAXGFL */ -/* VAXDFL */ - -/* SUPBFF is an array of integer codes for the binary file */ -/* formats supports for reading. At the very minimum */ -/* it includes NATBFF, but potentially NUMBFF entries. */ -/* See the include file 'zzddhman.inc'. */ - -/* NUMSUP is the number of entries in the SUPBFF list. */ - -/* STRAMH is a list of strings containing the labels for the */ -/* access method ID codes defined in the include file */ -/* 'zzddhman.inc'. These values are retrieved from */ -/* ZZDDHGSD. See it for details. */ - -/* STRARC is a list of strings containing the labels for the */ -/* file architecture ID codes defined in the include file */ -/* 'zzddhman.inc'. These values are retrieved from */ -/* ZZDDHGSD. See it for details. */ - -/* STRBFF is a list of strings containing the labels for the */ -/* binary file format ID codes defined in the include */ -/* file 'zzddhman.inc'. These values are retrieved from */ -/* ZZDDHGSD. See it for details. */ - -/* $ Parameters */ - -/* See the include file 'zzddhman.inc'. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This routine populates a variety data structures that ZZDDHMAN */ -/* requires to perform its functions. */ - -/* $ Examples */ - -/* See ZZDDHMAN for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 13-AUGUST-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables. */ - - -/* Standard SPICE error handling with discovery check in/out. */ - - if (return_()) { - return 0; - } - -/* Populate the STR### arrays. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("METHOD", &i__, stramh + (i__ - 1) * stramh_len, (ftnlen)6, - stramh_len); - } - for (i__ = 1; i__ <= 2; ++i__) { - zzddhgsd_("ARCH", &i__, strarc + (i__ - 1) * strarc_len, (ftnlen)4, - strarc_len); - } - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (i__ - 1) * strbff_len, (ftnlen)3, - strbff_len); - } - -/* Get the native binary file format. */ - - zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - *natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, strbff_len); - if (*natbff == 0) { - chkin_("ZZDDHINI", (ftnlen)8); - setmsg_("The binary file format, '#', is not supported by this veris" - "on of the toolkit. This is a serious problem, contact NAIF.", - (ftnlen)118); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHINI", (ftnlen)8); - return 0; - } - -/* Now fetch the list of supported binary file formats. */ - - zzplatfm_("READS_BFF", linstr, (ftnlen)9, (ftnlen)36); - -/* Parse the wordlist that is sitting in LINSTR. */ - - i__ = 0; - done = FALSE_; - while(! done) { - -/* Increment the counter and pop the next word */ -/* off. */ - - ++i__; - nextwd_(linstr, tmpstr, linstr, (ftnlen)36, (ftnlen)8, (ftnlen)36); - -/* See if we're done. */ - - done = i__ > 4 || s_cmp(tmpstr, " ", (ftnlen)8, (ftnlen)1) == 0; - -/* If we're not done, then convert this string to the */ -/* appropriate integer code. */ - - if (! done) { - supbff[i__ - 1] = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, - strbff_len); - -/* Check to see if the binary file format listed */ -/* is properly supported. */ - - if (supbff[i__ - 1] == 0) { - chkin_("ZZDDHINI", (ftnlen)8); - setmsg_("The binary file format, '#', is not supported by th" - "is verison of the toolkit. This is a serious problem" - ", contact NAIF. ", (ftnlen)130); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHINI", (ftnlen)8); - return 0; - } - } - } - -/* Now setup NUMSUP. Given the way the WHILE loop above executes, */ -/* we need to subtract one from I to get the number of entries added */ -/* to SUPBFF. This smacks of kludge... but it works. */ - - *numsup = i__ - 1; - return 0; -} /* zzddhini_ */ - diff --git a/ext/spice/src/cspice/zzddhivf.c b/ext/spice/src/cspice/zzddhivf.c deleted file mode 100644 index 53f9f711cf..0000000000 --- a/ext/spice/src/cspice/zzddhivf.c +++ /dev/null @@ -1,642 +0,0 @@ -/* zzddhivf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZDDHIVF ( Private --- DDH Identify VAX DAF File Format ) */ -/* Subroutine */ int zzddhivf_(char *nsum, integer *bff, logical *found, - ftnlen nsum_len) -{ - /* System generated locals */ - char ch__1[1]; - - /* Local variables */ - integer leader, trailr; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Identify VAX DAF file format. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NSUM I String storing the 8 bytes of the FDREC NSUM DP. */ -/* BFF O Integer code indicating the binary file format. */ -/* FOUND O Logical indicating that BFF was determined. */ - -/* $ Detailed_Input */ - -/* NSUM is a string whose first 8 bytes contain NSUM (the third */ -/* double precision number) from the first descriptor */ -/* record of a non-empty DAF suspected to be in one of */ -/* the VAX binary file formats. */ - -/* $ Detailed_Output */ - -/* BFF is an integer that signals whether NSUM indicates the */ -/* DAF is VAX-DFLT or VAX-GFLT. Possible values are: */ - -/* VAXGFL */ -/* VAXDFL */ - -/* as defined in the include file 'zzddhman.inc'. See it */ -/* for details. */ - -/* FOUND is a logical that indicates whether the ZZDDHVFF check */ -/* was successful. If TRUE, BFF contains the code for */ -/* VAX-DFLT or VAX-GFLT binary file format. If FALSE, */ -/* then BFF is untouched. */ - -/* $ Parameters */ - -/* See the include file 'zzddhman.inc'. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* This routine examines a series of bytes from a potential pre-N0050 */ -/* DAF to determine its architecture, but does not access the file */ -/* itself. */ - -/* $ Particulars */ - -/* This routine examines the bit patterns stored in NSUM to determine */ -/* which of the two VAX binary file formats are used to store the */ -/* double precision values in the DAF file. */ - -/* $ Examples */ - -/* See ZZDDHPPF for sample usage. */ - -/* $ Restrictions */ - -/* 1) The first 8 bytes of NSUM must contain the third double */ -/* precision value from the first descriptor record in a DAF */ -/* file not in BIG-IEEE binary file format. */ - -/* 2) The DAF file from which NSUM is extracted must be correct */ -/* or this routine may produce incorrect results. */ - -/* 3) Assumes CHARACTER*(1) is byte sized. */ - -/* 4) Assumes that ICHAR(CHAR(CHARACTER)) yields an integer with */ -/* the same bit pattern as the source character. */ - -/* $ Literature_References */ - -/* 1) Binary File Formats and Code Relying on Function Not Addressed */ -/* by the ANSI '77 Fortran Standard. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 04-OCT-2001 (FST) */ - - -/* -& */ - -/* Local Variables */ - - -/* Statement Functions */ - - -/* Statement Function Definitions */ - -/* This function controls the conversion of characters to integers. */ -/* On some supported environments, ICHAR is not sufficient to */ -/* produce the desired results. This however, is not the case */ -/* with this particular environment. */ - - -/* Before diving right into the code that examines the bit patterns */ -/* stored in NSUM, review exactly what checks require completion and */ -/* why they function. */ - -/* When this module is invoked, we already know that the DAF from */ -/* which NSUM was extracted is little endian, and that it is not */ -/* a LTL-IEEE file. This leaves us with one of 3 sources for */ -/* NSUM: */ - -/* (a) A VAX D-Floating file */ -/* (b) A VAX G-Floating file */ -/* (c) A damaged file */ - -/* In the case of (c) the algorithm outlined below is not guarenteed */ -/* to produce correct results. If the case is either (a) or (b), */ -/* then the routine will correctly determine the source binary file */ -/* format. Here's why: */ - -/* NSUM is the third double precision number from the first */ -/* descriptor record of a non-empty DAF file. This number is */ -/* an integral valued DP bounded between 1 and 125 inclusive. */ - -/* An examination of a binary file created with the following */ -/* code fragment: */ - -/* INCLUDE 'zzddhman.inc' */ - -/* DOUBLE PRECISION DPDATA ( 125 ) */ -/* INTEGER I */ -/* INTEGER LUN */ -/* . */ -/* . */ -/* . */ -/* CALL GETLUN( LUN ) */ - -/* DO I = 1, 125 */ -/* DPDATA (I) = DBLE (I) */ -/* END DO */ - -/* OPEN ( UNIT = LUN, */ -/* . FILE = FNAME, */ -/* . STATUS = 'NEW', */ -/* . ACCESS = 'DIRECT', */ -/* . RECL = RECL ) */ - -/* WRITE ( UNIT = LUN, REC = 1 ) ( DPDATA(I), I = 1, 125 ) */ - -/* END */ - -/* This source file was compiled on a VMS VAX system both with */ -/* G-Floating and D-Floating options, and executed to produce */ -/* the binary file of interest. The bit patterns for each of */ -/* the 125 entries were compared using the UNIX command 'od'. */ - -/* This comparison yielded the fact that these two sets of 125 */ -/* bit patterns did not intersect, and all that remained was to */ -/* uncover an efficient means of identifying which set a */ -/* particular member belonged to. */ - -/* The following was observed: */ - -/* With the exception of the first entry representing the */ -/* number 1.0D0 in the D-Floating case, all entries */ -/* appeared as: (hexadecimal byte dump from 'od' output) */ - -/* 0041 0000 0000 0000 */ -/* 4041 0000 0000 0000 */ -/* 8041 0000 0000 0000 */ -/* . */ -/* . */ -/* . */ -/* f643 0000 0000 0000 */ -/* f843 0000 0000 0000 */ -/* fa43 0000 0000 0000 */ - -/* While the G-Floating case: */ - -/* 1040 0000 0000 0000 */ -/* 2040 0000 0000 0000 */ -/* 2840 0000 0000 0000 */ -/* . */ -/* . */ -/* . */ -/* 7e40 00c0 0000 0000 */ -/* 7f40 0000 0000 0000 */ -/* 7f40 0040 0000 0000 */ - -/* The important thing to note is that the fourth entry in */ -/* G-Floating bit patterns is always '0', and in the */ -/* D-Floating case (with the exception of the first entry) */ -/* is always non-zero. The first entry in the D-Floating */ -/* table is: */ - -/* 8040 0000 0000 0000 */ - -/* It also happens to be the case that the leading value */ -/* of all G-Floating cases are numbers less than 8. */ -/* Constructing a series of tests around these observations */ -/* will produce correct results. When the input file meets */ -/* the restrictions non-empty and correct. */ - -/* So now all that remains is to lay out the specifics of the test. */ -/* First extract the leading 4 bits from NSUM(1:1) and the trailing */ -/* four bits from NSUM(2:2). Then enter this IF/ELSE IF block: */ - -/* If the value of the leading 4 bits from NSUM(1:1) is 8 and */ -/* the trailing 4 bits from NSUM(2:2) are 0, then the file is */ -/* of the D-Floating binary format. */ - -/* Else if the value of the trailing 4 bits of NSUM(2:2) is */ -/* non-zero, then the file is also of the D-Floating binary */ -/* format. */ - -/* Else if the value of the leading 4 bits of NSUM(1:1) is */ -/* strictly less than 8 and the trailing bits of NSUM(2:2) */ -/* are 0, then the file is of the G-Floating binary format. */ - -/* Else the file is not of VAX type. */ - -/* This routine could be reimplemented to examine all 8 bytes of */ -/* each double precision number and compare it to two tables of */ -/* values. In the interest of simplicity the preceding option */ -/* was selected. */ - - - -/* Convert the first and second characters in NSUM to integers. */ - - *(unsigned char *)&ch__1[0] = *(unsigned char *)nsum; - leader = *(unsigned char *)&ch__1[0]; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&nsum[1]; - trailr = *(unsigned char *)&ch__1[0]; - -/* Shift the trailing 4 bits off LEADER. */ - - leader /= 16; - -/* Subtract the leading bits off TRAILR. */ - - trailr -= trailr / 16 << 4; - -/* Now determine what file we are looking at. */ - - if (leader == 8 && trailr == 0) { - *found = TRUE_; - *bff = 4; - } else if (trailr != 0) { - *found = TRUE_; - *bff = 4; - } else if (leader < 8 && trailr == 0) { - *found = TRUE_; - *bff = 3; - } else { - *found = FALSE_; - } - return 0; -} /* zzddhivf_ */ - diff --git a/ext/spice/src/cspice/zzddhman.c b/ext/spice/src/cspice/zzddhman.c deleted file mode 100644 index 08f4e83236..0000000000 --- a/ext/spice/src/cspice/zzddhman.c +++ /dev/null @@ -1,3351 +0,0 @@ -/* zzddhman.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__2 = 2; -static integer c__0 = 0; - -/* $Procedure ZZDDHMAN ( Private --- DAF/DAS Handle Manager ) */ -/* Subroutine */ int zzddhman_0_(int n__, logical *lock, char *arch, char * - fname, char *method, integer *handle, integer *unit, integer *intamh, - integer *intarc, integer *intbff, logical *native, logical *found, - logical *kill, ftnlen arch_len, ftnlen fname_len, ftnlen method_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical opnfst = TRUE_; - static integer nft = 0; - static integer next = 0; - static integer nut = 0; - static integer reqcnt = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), s_rnge( - char *, integer, char *, integer), f_open(olist *), f_clos(cllist - *); - - /* Local variables */ - extern /* Subroutine */ int zzddhf2h_(char *, integer *, integer *, - integer *, integer *, integer *, char *, integer *, integer *, - integer *, integer *, logical *, integer *, integer *, logical *, - logical *, integer *, logical *, ftnlen, ftnlen), zzddhini_( - integer *, integer *, integer *, char *, char *, char *, ftnlen, - ftnlen, ftnlen), zzddhrcm_(integer *, integer *, integer *); - extern integer zzddhclu_(logical *, integer *); - extern /* Subroutine */ int zzddhppf_(integer *, integer *, integer *), - zzddhgtu_(integer *, integer *, logical *, integer *, integer *, - integer *), zzddhrmu_(integer *, integer *, integer *, integer *, - logical *, integer *, integer *), zzpltchk_(logical *); - integer i__; - static integer ftbff[1000]; - integer lchar; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer ftabs[1000], ftamh[1000], ftarc[1000], fthan[1000]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - static char ftnam[255*1000]; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - static integer uthan[23]; - static logical utlck[23]; - logical error; - static integer ftrtm[1000]; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static integer utcst[23], utlun[23]; - extern logical failed_(void); - integer accmet, filarc, locked; - static integer natbff; - logical locfnd; - extern integer bsrchi_(integer *, integer *, integer *), isrchc_(char *, - integer *, char *, ftnlen, ftnlen); - char locfnm[255]; - integer inqhan; - extern integer isrchi_(integer *, integer *, integer *); - logical platok; - integer loclun; - static char strbff[8*4], stramh[8*4], strarc[8*2]; - integer findex, uindex; - static integer supbff[4]; - integer iostat; - logical inqopn, inqext; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer supidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), frelun_( - integer *); - static integer numsup; - char tmpstr[8]; - integer bff; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is an umbrella routine for a collection of entry points */ -/* to the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF */ -/* DAS */ -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LOCK I HLU */ -/* ARCH I/O OPN, CLS, HLU, UNL */ -/* FNAME I/O OPN, NFO, FNH */ -/* METHOD I/O OPN */ -/* HANDLE I/O OPN, CLS, HLU, UNL, ISN, NFO, FNH, LUH */ -/* UNIT I/O HLU, LUH */ -/* INTAMH O NFO */ -/* INTARC O NFO */ -/* INTBFF O NFO */ -/* NATIVE O ISN */ -/* FOUND O ISN, NFO, FNH, LUH */ -/* KILL I CLS */ - -/* $ Detailed_Input */ - -/* See the entry points for descriptions of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for descriptions of their outputs. */ - -/* $ Parameters */ - -/* See the include file 'zzddhman.inc' for details of parameter */ -/* definitions used within this module. */ - -/* $ Files */ - -/* This set of routines is intended to provide low-level services */ -/* for the creation, updating, and reading of Fortran direct access */ -/* files utilized by the DAF and DAS systems within SPICE. */ - -/* $ Exceptions */ - -/* 1) If ZZDDHMAN is called directly, the error SPICE(BOGUSENTRY) */ -/* is signaled. */ - -/* 2) See entry points ZZDDHOPN, ZZDDHCLS, ZZDDHHLU, ZZDDHUNL, */ -/* ZZDDHISN, ZZDDHNFO, ZZDDHFNH, and ZZDDHLUH for exceptions */ -/* specific to those entry points. */ - -/* $ Particulars */ - -/* ZZDDHMAN serves as an umbrella, allowing data to be shared by */ -/* its entry points: */ - -/* ZZDDHOPN Open file. */ -/* ZZDDHCLS Close file. */ -/* ZZDDHHLU Handle to logical unit. */ -/* ZZDDHUNL Unlock handle from unit. */ -/* ZZDDHISN Is the file native architecture? */ -/* ZZDDHNFO Fetch information about a handle. */ -/* ZZDDHFNH Filename to handle. */ -/* ZZDDFLUH Logical unit to handle. */ - -/* This umbrella serves a variety of functions to the DAS/DAF */ -/* families of routines. */ - -/* (1) DAF/DAS handle consolidation */ -/* (2) Binary file format detection and tracking */ -/* (3) FTP error detection services */ -/* (4) Logical unit sharing */ -/* (5) Filename and unit to handle mapping services */ - -/* $ Examples */ - -/* See individual entry points for pointers to modules that utilize */ -/* their capabilities. */ - -/* $ Restrictions */ - -/* 1) Changing the current working directory of a program when */ -/* more than UTSIZE files are loaded into this interface requires */ -/* that all filenames passed into ZZDDHOPN are specified with */ -/* absolute pathnames. Otherwise the OPEN/CLOSE switching */ -/* logic will fail to OPEN files that are loaded. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.1, 24-APR-2003 (EDW) */ - -/* Added MAC-OSX-F77 to the list of platforms */ -/* that require READONLY to read write protected */ -/* kernels. */ - -/* - SPICELIB Version 2.0.0, 07-AUG-2002 (FST) */ - -/* The entry point ZZDDHOPN now invokes ZZPLTCHK, to verify */ -/* that the runtime environment's binary file format matches */ -/* the one for which the toolkit is configured. */ - -/* The entry point ZZDDHCLS has had its argument list augmented */ -/* to include a "KILL" flag. Check the entry point header for */ -/* details. */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 07-AUG-2002 (FST) */ - -/* The toolkit source code is far more sensitive to blind */ -/* porting of source packaged for one environment to another. */ -/* This sensitivity has already caused a few of our users */ -/* some difficulty. In an attempt to address these problems */ -/* with future toolkits, ZZDDHOPN now invokes ZZPLTCHK on */ -/* it's first pass. This will perform any necessary checks */ -/* on the runtime environment against the values recorded */ -/* in ZZPLATFM and other environment specific components */ -/* of the library. */ - -/* As of this release, all that is verified is that the */ -/* BFF ID listed in ZZPLATFM is compatible with the runtime */ -/* environment. See ZZPLTCHK's header for deatils. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* This logical allows initialization code to execute. */ - - -/* These strings store the labels for the parameters defined */ -/* in the include file and retrieved by ZZDDHINI. */ - - -/* The file table consists of a set of arrays which serve as */ -/* 'columns' of the table. The sets of elements having the same */ -/* index in the arrays form the 'rows' of the table. Each column */ -/* contains a particular type of information; each row contains */ -/* all of the information pertaining to a particular file. */ - -/* All column names in the file table begin with 'FT'. The columns */ -/* are: */ - -/* ABS Absolute value of HAN */ -/* AMH File access method */ -/* ARC File architecture */ -/* BFF Binary file format */ -/* HAN Handle */ -/* NAM Filename */ -/* RTM RTRIM (right trimmed value for NAM) */ - -/* New 'rows' are added to the end of the list; the list is repacked */ -/* whenever a file is removed from the list. */ - -/* NFT is the number of files currently loaded; this may not be */ -/* greater than FTSIZE. FINDEX refers to a file of interest within */ -/* the table. Since handles are always assigned in an increasing */ -/* fashion, FTABS is guaranteed to be a sorted list. We will use */ -/* this fact to improve handle lookups in the file table. */ - - -/* NEXT stores the next handle to be used for file access. This */ -/* could be either for read or write based operations. NEXT is */ -/* incremented just before entries in the file table are made. */ -/* It begins as zero valued. */ - - -/* The unit table consists of a set of arrays which serve as */ -/* 'columns' of the table. The sets of elements having the same */ -/* index in the arrays form the 'rows' of the table. Each column */ -/* contains a particular type of information; each row contains */ -/* all of the information pertaining to a particular logical unit. */ - -/* All column names in the unit table begin with 'UT'. The columns */ -/* are: */ - -/* CST Cost to remove the file from the unit table */ -/* HAN Handle */ -/* LCK Is this logical unit locked to this handle? */ -/* LUN Logical unit */ - -/* New 'rows' are added to the end of the list; the list is repacked */ -/* whenever a logical unit is no longer needed. */ - -/* NUT is the number of units currently stored in the table; this */ -/* may not exceed UTSIZE. UINDEX referes to a unit of interest */ -/* within the table. */ - - -/* The following stores the native binary file format, a list of */ -/* codes for supported binary formats, and the number of entries */ -/* in SUPBFF. */ - - -/* Request counter used to determine cost. */ - - -/* Saved Variables */ - - -/* Data Statements */ - - switch(n__) { - case 1: goto L_zzddhopn; - case 2: goto L_zzddhcls; - case 3: goto L_zzddhhlu; - case 4: goto L_zzddhunl; - case 5: goto L_zzddhnfo; - case 6: goto L_zzddhisn; - case 7: goto L_zzddhfnh; - case 8: goto L_zzddhluh; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDDHMAN", (ftnlen)8); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZDDHMAN", (ftnlen)8); - } - return 0; -/* $Procedure ZZDDHOPN ( Private --- Load file ) */ - -L_zzddhopn: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Load a new direct access file. */ - -/* $ 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 */ - -/* DAS */ -/* DAF */ -/* PRIVATE */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* CHARACTER*(*) METHOD */ -/* CHARACTER*(*) ARCH */ -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of file to be loaded. */ -/* METHOD I Access method used to load the file. */ -/* ARCH I Expected architecture of the file to load. */ -/* HANDLE O Handle assigned to file. */ - -/* $ Detailed_Input */ - -/* FNAME is the file name of the file to be loaded for direct */ -/* access. */ - -/* METHOD is the method by which to load the file. Acceptable */ -/* values are: */ - -/* 'READ' - Load existing file for read access. */ -/* 'WRITE' - Load existing file for write access. */ -/* 'SCRATCH' - Load scratch file. */ -/* 'NEW' - Load a new file for write access. */ - -/* Note: The value of METHOD is case-insensitive. */ - -/* ARCH is the architecture of the file to be loaded. */ -/* Acceptable values are: */ - -/* 'DAF' - Load a DAF file */ -/* 'DAS' - Load a DAS file */ - -/* Note: The value of ARCH is case-insensitive. */ - -/* $ Detailed_Output */ - -/* HANDLE is the file handle associated with the file. This */ -/* handle is used to identify the file in subsequent */ -/* calls to other routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* 1) All direct access files loaded by this routine for */ -/* access methods other than 'SCRATCH' are specified by name. */ - -/* 2) Files opened with access method 'SCRATCH' are referenced */ -/* only by their logical unit. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(UNSUPPORTEDMETHOD) is signaled when the */ -/* METHOD input argument is improperly specified. The value of */ -/* the output argument HANDLE is undefined when this error is */ -/* signaled. */ - -/* 2) The error SPICE(UNSUPPORTEDARCH) is signaled when the ARCH */ -/* input argument is improperly specified. The value of the */ -/* output argument HANDLE is undefined when this error is */ -/* signaled. */ - -/* 3) The error SPICE(UTFULL) is signaled whenever METHOD is */ -/* set to 'SCRATCH' and no available units exist in the */ -/* unit table for locking. The value of the output argument */ -/* HANDLE is undefined when this error is signaled. */ - -/* 4) The error SPICE(BLANKFILENAME) is signaled whenever METHOD */ -/* is set to 'READ', 'WRITE', or 'NEW' and the FNAME argument */ -/* is a blank string. The value of the output argument HANDLE */ -/* is undefined when this error is signaled. */ - -/* 5) The error SPICE(FILENOTFOUND) is signaled whenever METHOD */ -/* is set to 'READ' or 'WRITE' and an INQUIRE performed on FNAME */ -/* indicates the file does not exist. The value of the output */ -/* argument HANDLE is undefined when this error is signaled. */ - -/* 6) The error SPICE(IMPROPEROPEN) is signaled if the file */ -/* associated with FNAME is attached to a unit from some */ -/* source external to ZZDDHMAN's entry points. The value of the */ -/* output argument HANDLE is undefined when this error is */ -/* signaled. */ - -/* 7) The error SPICE(FILARCMISMATCH) is signaled when a file is */ -/* loaded for 'READ' or 'WRITE' and the architecture of the */ -/* existing file disagrees with that of the input argument ARCH. */ -/* The value of the output argument HANDLE is undefined when */ -/* this error is signaled. */ - -/* 8) The error SPICE(FILEOPENCONFLICT) is signaled when an attempt */ -/* to load an already loaded file for any access other than READ. */ -/* The value of the output argument HANDLE is undefined when this */ -/* error is signaled. */ - -/* 9) The error SPICE(RWCONFLICT) is signaled when an attempt to */ -/* load a file for READ access that is already loaded into the */ -/* handle manager with a conflicting access method. The value of */ -/* the output argument HANDLE is undefined when this error is */ -/* signaled. */ - -/* 10) The error SPICE(FTFULL) is signaled when an attempt to load */ -/* more than the maximum number of allowable files, FTSIZE, */ -/* is made. The value of the output argument HANDLE is undefined */ -/* when this error is signaled. */ - -/* 11) The error SPICE(FILEOPENFAIL) is signaled whenever the */ -/* the file open fails with non-zero IOSTAT. The value of the */ -/* output argument HANDLE is undefined when this error is */ -/* signaled. */ - -/* 12) The error SPICE(UNSUPPORTEDBFF) is signaled whenever the file */ -/* to be opened utilizes a binary file format that the platform */ -/* does not currently support. The value of the output argument */ -/* HANDLE is undefined when this error is signaled. */ - -/* 13) When loading files with METHOD set to 'NEW', any errors */ -/* generated by this routine will cause the newly created file */ -/* to be deleted. */ - -/* 14) If the toolkit source is improperly configured for the */ -/* runtime environment, routines in the call tree of this */ -/* routine may signal errors. */ - -/* $ Particulars */ - -/* This private routine is designed to provide a common, unified */ -/* file load interface for DAF and DAS. */ - -/* $ Examples */ - -/* See DAFOPR, DAFONW, DAFOPW, DASOPR, DASOPS, DASONW, DASOPW for */ -/* sample usage. */ - -/* $ Restrictions */ - -/* 1) Files loaded through this interface should not be opened by */ -/* any other mechanism until the appropriate call to ZZDDHCLS */ -/* is made. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 07-AUG-2002 (FST) */ - -/* This entry point was updated to perform checks on the */ -/* runtime environment, to verify that the source is properly */ -/* configured for execution on this environment. See the */ -/* Revisions section of ZZDDHMAN for details. */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDDHOPN", (ftnlen)8); - } - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED() to handle the unlikely event that */ -/* ZZDDHINI signaled SPICE(BUG). */ - - if (failed_()) { - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* On first pass, perform any runtime environment checks. */ - - if (opnfst) { - zzpltchk_(&platok); - if (failed_()) { - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Clear OPNFST, since we've performed the diagnostics. */ - - opnfst = FALSE_; - } - -/* Initialize the value of HANDLE to 0. In the event an error */ -/* is signaled this invalid value will be returned to the caller */ -/* for safety. */ - - *handle = 0; - -/* Left justify FNAME to compress off any leading spaces. */ - - ljust_(fname, locfnm, fname_len, (ftnlen)255); - -/* Translate the value of the requested access method to the */ -/* corresponding integer code. */ - - s_copy(tmpstr, method, (ftnlen)8, method_len); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - accmet = isrchc_(tmpstr, &c__4, stramh, (ftnlen)8, (ftnlen)8); - -/* Check if the code was located. */ - - if (accmet == 0) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The attempt to load file, '#', with access method, '#', fai" - "led because this access method is unsupported.", (ftnlen)105); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(UNSUPPORTEDMETHOD)", (ftnlen)24); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Translate the value of the requested file architecture to */ -/* the appropriate integer code. */ - - s_copy(tmpstr, arch, (ftnlen)8, arch_len); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - filarc = isrchc_(tmpstr, &c__2, strarc, (ftnlen)8, (ftnlen)8); - -/* Check if the code was located. */ - - if (filarc == 0) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The attempt to load file, '#', with architecture, '#', fail" - "ed because this file architecture is unsupported.", (ftnlen) - 108); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errch_("#", arch, (ftnlen)1, arch_len); - sigerr_("SPICE(UNSUPPORTEDARCH)", (ftnlen)22); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Perform any preliminary checks that must be done before */ -/* fetching a logical unit from the unit table. This requires */ -/* branching based on ACCMET's value. */ - - if (accmet == 3) { - -/* Check to see if there are enough units available for locking */ -/* in the unit table. If not, signal an error as all files */ -/* open with SCRTCH access must be locked to their units. */ - - locked = zzddhclu_(utlck, &nut); - if (locked >= 21) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The maximum number of units are locked to handles. As " - "such, there is no room to open the requested scratch fil" - "e.", (ftnlen)113); - sigerr_("SPICE(UTFULL)", (ftnlen)13); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* The NEW, READ, and WRITE access methods perform the same */ -/* checks on LOCFNM. */ - - } else if (accmet == 4 || accmet == 1 || accmet == 2) { - -/* Check for a non-blank file name. */ - - if (s_cmp(locfnm, " ", (ftnlen)255, (ftnlen)1) == 0) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The attempt to load the file has failed, because the fi" - "lename is blank.", (ftnlen)71); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - } - -/* In the READ or WRITE cases verify that LOCFNM is not already */ -/* in the file table. */ - - if (accmet == 1 || accmet == 2) { - -/* Check to see if the file associated with LOCFNM is already in */ -/* the file table. */ - - zzddhf2h_(locfnm, ftabs, ftamh, ftarc, ftbff, fthan, ftnam, ftrtm, & - nft, utcst, uthan, utlck, utlun, &nut, &inqext, &inqopn, & - inqhan, &locfnd, (ftnlen)255, (ftnlen)255); - -/* First, check FAILED(), and return if anything has gone awry. */ -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - if (failed_()) { - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Now perform some simple sanity checks before preparing to */ -/* load the file. First check to see if the file exists, it must */ -/* if we are going to open it with ACCMET set to READ or WRITE. */ - - if (! inqext) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The file '#' does not exist.", (ftnlen)28); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Now if the file was not found in the file table, and it is */ -/* attached to a unit, this presents a problem. */ - - if (! locfnd && inqopn) { - -/* Get the unit to include in the error message. */ - - ioin__1.inerr = 1; - ioin__1.infilen = 255; - ioin__1.infile = locfnm; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = &loclun; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - -/* Since we performed a very similar INQUIRE statement in */ -/* ZZDDHF2H, a non-zero IOSTAT value indicates a severe error. */ - - if (iostat != 0) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("INQUIRE failed.", (ftnlen)15); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Signal the error. Recall HANDLE was initialized to 0, and */ -/* this invalid value is returned to the caller. */ - - setmsg_("The file '#' is already connected to unit #.", (ftnlen) - 44); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errint_("#", &loclun, (ftnlen)1); - sigerr_("SPICE(IMPROPEROPEN)", (ftnlen)19); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Lastly check to see if the file in the file table, and */ -/* perform the appropriate sanity checks. */ - - if (locfnd) { - i__1 = abs(inqhan); - findex = bsrchi_(&i__1, &nft, ftabs); - -/* Check to see if the requested architecture does not match */ -/* that of the entry in the file table. */ - - if (filarc != ftarc[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("ftarc", i__1, "zzddhman_", (ftnlen)894)]) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The attempt to load file '#' as a # has failed beca" - "use it is already loaded as a #.", (ftnlen)83); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errch_("#", strarc + (((i__1 = filarc - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("strarc", i__1, "zzddhman_", (ftnlen) - 904)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strarc + (((i__2 = ftarc[(i__1 = findex - 1) < - 1000 && 0 <= i__1 ? i__1 : s_rnge("ftarc", i__1, - "zzddhman_", (ftnlen)905)] - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("strarc", i__2, "zzddhman_", (ftnlen) - 905)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(FILARCMISMATCH)", (ftnlen)21); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Check to see if the access method is anything other */ -/* than READ. If so, signal the appropriate error. */ -/* Note: this is only for READ. */ - - if (accmet != 1) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("File '#' already loaded.", (ftnlen)24); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(FILEOPENCONFLICT)", (ftnlen)23); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* If we reach here, then we have a file that exists */ -/* in the table, and the caller is attempting to load it */ -/* for READ access. Check to make certain it is not */ -/* already loaded with another method. */ - - if (accmet != ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("ftamh", i__1, "zzddhman_", (ftnlen)937)]) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("Unable to load file '#' for # access. It is alread" - "y loaded with the conflicting access #.", (ftnlen)90); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errch_("#", stramh + (((i__1 = accmet - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("stramh", i__1, "zzddhman_", (ftnlen) - 947)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", stramh + (((i__2 = ftamh[(i__1 = findex - 1) < - 1000 && 0 <= i__1 ? i__1 : s_rnge("ftamh", i__1, - "zzddhman_", (ftnlen)948)] - 1) < 4 && 0 <= i__2 ? - i__2 : s_rnge("stramh", i__2, "zzddhman_", (ftnlen) - 948)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(RWCONFLICT)", (ftnlen)17); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* If we make it this far, the file is in the file table */ -/* and all the sanity checks have passed. Return to the */ -/* caller as this is effectively a no-op. */ - - *handle = fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("fthan", i__1, "zzddhman_", (ftnlen)960)]; - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - } - -/* Now check to see if there is room in the file table for this */ -/* new file. */ - - if (nft == 1000) { - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - setmsg_("The file table is full, with # entries. As a result, the fi" - "le '#' could not be loaded.", (ftnlen)86); - errint_("#", &nft, (ftnlen)1); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(FTFULL)", (ftnlen)13); - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* We are about to attempt a HANDLE to LUN connection, increment */ -/* the request counter. */ - - zzddhrcm_(&nut, utcst, &reqcnt); - -/* Free up a logical unit in the UNIT table for our usage. */ - - zzddhgtu_(utcst, uthan, utlck, utlun, &nut, &uindex); - -/* Check FAILED() since ZZDDHGTU may have invoked GETLUN. */ -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - if (failed_()) { - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Trim up the filename. */ - - if (accmet != 3) { - lchar = rtrim_(locfnm, (ftnlen)255); - } - -/* If we have made it this far, then we're ready to perform the */ -/* appropriate open. First get the handle ready. */ - - ++next; - -/* Determine the sign of the new handle based on the requested */ -/* METHOD. */ - - if (accmet == 1) { - uthan[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("uthan", - i__1, "zzddhman_", (ftnlen)1029)] = next; - } else { - uthan[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("uthan", - i__1, "zzddhman_", (ftnlen)1031)] = -next; - } - -/* The code that follows is structured a little strangely. This */ -/* discussion is an attempt to clarify what the code does and */ -/* the motivation that led to its peculiar construction. */ - -/* First, the file, scratch or otherwise, is opened with the */ -/* appropriate OPEN statement. Then, the logical ERROR is set */ -/* to TRUE or FALSE depending on whether and IOSTAT error has */ -/* occurred as a result of the OPEN. At this point, the code */ -/* enters into a IF block structured in the following manner: */ - -/* IF ( ERROR ) THEN */ - -/* Signal the IOSTAT related error from the OPEN statement. */ - -/* ELSE IF ( ACCMET .EQ SCRTCH ) THEN */ - -/* Attempt to INQUIRE on the UNIT assigned to the scratch */ -/* file to determine its name. Store a default value, */ -/* in the event one is not returned. */ - -/* ELSE IF ( ACCMET .EQ. READ ) .OR. ( ACCMET .EQ. WRITE ) THEN */ - -/* Examine the preexisting file to determine if its FTP */ -/* detection string, file architecture, and binary */ -/* file format are acceptable. If not, then signal the */ -/* error, set ERROR to TRUE, and do not check out or */ -/* return. */ - -/* END IF */ - -/* IF ( ERROR ) THEN */ - -/* Remove the UNIT from the unit table. Decrement NEXT, */ -/* since the current value is not to be assigned as */ -/* a handle for this file. Check out and return. */ - -/* END IF */ - -/* The reason the code is structured in this unusual fashion */ -/* is to allow for a single treatment of the clean up on error */ -/* code to exist. */ - - -/* Perform the OPEN. Branch on the appropriate access method. */ - - if (accmet == 3) { - o__1.oerr = 1; - o__1.ounit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1083)]; - o__1.ofnm = 0; - o__1.orl = 1024; - o__1.osta = "SCRATCH"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - bff = natbff; - } else if (accmet == 4) { - o__1.oerr = 1; - o__1.ounit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1093)]; - o__1.ofnmlen = lchar; - o__1.ofnm = locfnm; - o__1.orl = 1024; - o__1.osta = "NEW"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - bff = natbff; - } else if (accmet == 1) { - o__1.oerr = 1; - o__1.ounit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1104)]; - o__1.ofnmlen = lchar; - o__1.ofnm = locfnm; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - } else if (accmet == 2) { - o__1.oerr = 1; - o__1.ounit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1113)]; - o__1.ofnmlen = lchar; - o__1.ofnm = locfnm; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - } - -/* Verify that IOSTAT is non-zero. */ - - error = iostat != 0; - -/* Partially process the error. */ - - if (error) { - -/* Now signal the error, but delay cleaning up and checking */ -/* out until leaving this IF block. */ - - if (accmet == 3) { - setmsg_("Attempt to open scratch file failed. IOSTAT was #.", ( - ftnlen)50); - } else if (accmet == 4) { - setmsg_("Attempt to create new file, '$' failed. IOSTAT was #.", ( - ftnlen)53); - } else { - setmsg_("Attempt to open file, '$' for % access failed. IOSTAT w" - "as #.", (ftnlen)60); - } - errch_("$", locfnm, (ftnlen)1, (ftnlen)255); - errch_("%", stramh + (((i__1 = accmet - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("stramh", i__1, "zzddhman_", (ftnlen)1148)) << 3), ( - ftnlen)1, (ftnlen)8); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAIL)", (ftnlen)19); - -/* If no IOSTAT based error has occurred as a result of the OPEN */ -/* statement, then perform any remaining checks or I/O operations */ -/* that are necessary to support loading the file. */ - - } else if (accmet == 3) { - -/* Inquire on the logical unit to produce the file name for */ -/* the scratch file. Set the initial value of LOCFNM, in case */ -/* the INQUIRE does not replace it. */ - - s_copy(locfnm, "# SCRATCH FILE", (ftnlen)255, (ftnlen)14); - repmc_(locfnm, "#", strarc + (((i__1 = filarc - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("strarc", i__1, "zzddhman_", (ftnlen)1165)) << - 3), locfnm, (ftnlen)255, (ftnlen)1, (ftnlen)8, (ftnlen)255); - ioin__1.inerr = 1; - ioin__1.inunit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1167)]; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = 0; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.innamlen = 255; - ioin__1.inname = locfnm; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - -/* In the event that this INQUIRE failed, replace the value */ -/* stored in LOCFNM with the initial value. */ - - if (iostat != 0) { - s_copy(locfnm, "# SCRATCH FILE", (ftnlen)255, (ftnlen)14); - repmc_(locfnm, "#", strarc + (((i__1 = filarc - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("strarc", i__1, "zzddhman_", (ftnlen) - 1178)) << 3), locfnm, (ftnlen)255, (ftnlen)1, (ftnlen)8, ( - ftnlen)255); - } - -/* Store the RTRIM value of this filename in LCHAR. */ - - lchar = rtrim_(locfnm, (ftnlen)255); - } else if (accmet == 1 || accmet == 2) { - -/* Check for FTP errors, verify that FILARC is appropriate, */ -/* and determine the binary file format of the preexisting */ -/* file LOCFNM. */ - - zzddhppf_(&utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1195)], &filarc, & - bff); - -/* Set ERROR. */ - - error = failed_(); - -/* If no error has occurred, verify that BFF is among the */ -/* list of supported format ID codes for the requested access */ -/* method. */ - - if (! error) { - -/* This platform supports reading from files whose */ -/* format codes are listed in SUPBFF. */ - - if (accmet == 1) { - supidx = isrchi_(&bff, &numsup, supbff); - if (supidx == 0) { - -/* Delay clean up and check out. */ - - error = TRUE_; - if (bff == 0) { - setmsg_("Attempt to open file, '#', for read access " - "has failed. This file utilizes an unknown b" - "inary file format. This error may result fr" - "om attempting to open a corrupt file or one " - "of an unknown type.", (ftnlen)194); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(UNSUPPORTEDBFF)", (ftnlen)21); - } else { - setmsg_("Attempt to open file, '#', for read access " - "has failed. The non-native binary file form" - "at '#' is not currently supported on this pl" - "atform. Obtain a transfer format version, a" - "nd convert it to the native format. See the " - "Convert User's Guide for details.", (ftnlen) - 252); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errch_("#", strbff + (((i__1 = bff - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzddhm" - "an_", (ftnlen)1248)) << 3), (ftnlen)1, ( - ftnlen)8); - sigerr_("SPICE(UNSUPPORTEDBFF)", (ftnlen)21); - } - } - -/* This platform only supports writing to files whose */ -/* binary formats are native. */ - - } else { - -/* Delay clean up and check out. */ - - if (bff == 0) { - error = TRUE_; - setmsg_("Attempt to open file, '#', for write access has" - " failed. This file utilizes an unknown binary f" - "ile format. This error may result from attempti" - "ng to open a corrupt file or one of an unknown t" - "ype.", (ftnlen)195); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(UNSUPPORTEDBFF)", (ftnlen)21); - } else if (bff != natbff) { - error = TRUE_; - setmsg_("Attempt to open file, '#', for write access has" - " failed. This file utilizes the non-native bina" - "ry file format '#'. At this time only files of " - "the native format, '#', are supported for write " - "access. See the Convert User's Guide for detail" - "s.", (ftnlen)241); - errch_("#", locfnm, (ftnlen)1, (ftnlen)255); - errch_("#", strbff + (((i__1 = bff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzddhman_", ( - ftnlen)1292)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzddhman_", - (ftnlen)1293)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(UNSUPPORTEDBFF)", (ftnlen)21); - } - } - } - } - -/* If an error has occurred as a result of opening the file or */ -/* examining its contents, clean up and check out. */ - - if (error) { - -/* Close the unit we were using. Remember to delete the file */ -/* if it was a 'new' one. */ - - if (accmet == 4) { - cl__1.cerr = 0; - cl__1.cunit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1315)]; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - } else { - cl__1.cerr = 0; - cl__1.cunit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1317)]; - cl__1.csta = 0; - f_clos(&cl__1); - } - -/* Remove the unit from the unit table, since this UNIT */ -/* is no longer in use. */ - - zzddhrmu_(&uindex, &nft, utcst, uthan, utlck, utlun, &nut); - -/* Decrement NEXT since this handle was never assigned to */ -/* a file. */ - - --next; - -/* Recall HANDLE was initialized to 0, and this invalid */ -/* value is returned to the caller. */ - - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; - } - -/* Finish filling out the unit table. */ - - utcst[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utcst", i__1, - "zzddhman_", (ftnlen)1345)] = reqcnt; - -/* Only scratch files get the units locked to handles, this is */ -/* because they only exist as long as they have a unit. */ - - utlck[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utlck", i__1, - "zzddhman_", (ftnlen)1351)] = accmet == 3; - -/* Now fill out the file table. */ - - ++nft; - -/* Use the absolute value of the handle used to index the file */ -/* table. */ - - ftabs[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftabs", i__1, - "zzddhman_", (ftnlen)1362)] = (i__3 = uthan[(i__2 = uindex - 1) < - 23 && 0 <= i__2 ? i__2 : s_rnge("uthan", i__2, "zzddhman_", ( - ftnlen)1362)], abs(i__3)); - -/* Assign access method, file architecture, and native binary file */ -/* format to the appropriate columns. */ - - ftamh[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftamh", i__1, - "zzddhman_", (ftnlen)1368)] = accmet; - ftarc[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftarc", i__1, - "zzddhman_", (ftnlen)1369)] = filarc; - ftbff[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftbff", i__1, - "zzddhman_", (ftnlen)1370)] = bff; - -/* Assign the handle, filename, and RTRIM ( FTNAM(NFT) ) as */ -/* FTRTM. */ - - fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("fthan", i__1, - "zzddhman_", (ftnlen)1376)] = uthan[(i__2 = uindex - 1) < 23 && 0 - <= i__2 ? i__2 : s_rnge("uthan", i__2, "zzddhman_", (ftnlen)1376)] - ; - s_copy(ftnam + ((i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftnam", i__1, "zzddhman_", (ftnlen)1377)) * 255, locfnm, (ftnlen) - 255, lchar); - ftrtm[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftrtm", i__1, - "zzddhman_", (ftnlen)1378)] = lchar; - -/* Assign HANDLE the value of the new handle. */ - - *handle = fthan[(i__1 = nft - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "zzddhman_", (ftnlen)1383)]; - chkout_("ZZDDHOPN", (ftnlen)8); - return 0; -/* $Procedure ZZDDHCLS ( Private --- Close file ) */ - -L_zzddhcls: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Close the file associated with HANDLE. */ - -/* $ 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 */ - -/* DAF */ -/* DAS */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) ARCH */ -/* LOGICAL KILL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle associated with the file to close. */ -/* ARCH I Expected architecture of the handle to close. */ -/* KILL I Logical indicating whether to delete the file. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle associated with the file that is */ -/* to be closed. */ - -/* ARCH is the expected architecture of the file associated */ -/* with HANDLE. */ - -/* KILL is a logical that indicates whether to kill the file */ -/* associated with HANDLE. Essentially it performs: */ - -/* CLOSE ( UNIT, STATUS = 'DELETE') */ - -/* on the file. This only works if HANDLE is currently */ -/* assigned a UNIT in the UNIT table. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine will close the file associated with HANDLE if it */ -/* is currently utilizing a logical unit. */ - -/* $ Exceptions */ - -/* 1) SPICE(FILARCMISMATCH) is signaled if the specified architecture */ -/* does not match the one listed in the file table. */ - -/* 2) SPICE(INVALIDACCESS) is signaled if KILL is set to .TRUE., and */ -/* HANDLE is associated with a file open for READ access. */ - -/* 3) SPICE(FILENOTCONNECTED) is signaled if KILL is set to .TRUE., */ -/* and the file associated with handle is not currently in the */ -/* unit table. The file is removed from the file table (closed) */ -/* as a result, even if this error is signaled. */ - -/* 4) If HANDLE is not found in the file table, this routine simply */ -/* returns to the caller. */ - -/* $ Particulars */ - -/* This routine closes files in the file table and performs */ -/* any necessary operations to facilitate the proper disconnect */ -/* from any logical unit. */ - -/* This routine may also be used to delete a file that is open */ -/* for write access if it currently has an entry in the UNIT table. */ - -/* $ Examples */ - -/* See DAFCLS or DASLLC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 02-APR-2001 (FST) */ - -/* Added a "KILL" argument to the argument list of the routine. */ -/* This will allow certain raw close statements to be replaced */ -/* with calls to ZZDDHCLS. */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - -/* -& */ - -/* % Revisions */ - -/* - SPICELIB Version 2.0.0, 02-APR-2002 (FST) */ - -/* Added the error SPICE(FILENOTCONNECTED) since the KILL */ -/* functionality is only required in the entry points: */ - -/* DASFM - DASOPN, DASONW */ -/* DAFAH - DAFOPN, DAFONW */ - -/* These routines open new files, so they reference newly */ -/* created handles that have entries in the UNIT table. Thus */ -/* the decision was made to signal the error */ -/* SPICE(FILENOTCONNECTED) rather than connect a file not */ -/* present in the unit table when KILL is set. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDDHCLS", (ftnlen)8); - } - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED() only to trap the possibility of ZZDDHINI */ -/* signaling SPICE(BUG). */ - - if (failed_()) { - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Find the file in the handle table. */ - - i__1 = abs(*handle); - findex = bsrchi_(&i__1, &nft, ftabs); - -/* Check to see whether we found the handle or not. */ - - if (findex == 0) { - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } else if (fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "zzddhman_", (ftnlen)1596)] != *handle) { - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } - -/* Before actually closing the file, check the input architecture */ -/* matches that listed in the file table for this handle. This is */ -/* to prevent one architecture's code from stepping on anothers. */ - - s_copy(tmpstr, arch, (ftnlen)8, arch_len); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - filarc = isrchc_(tmpstr, &c__2, strarc, (ftnlen)8, (ftnlen)8); - -/* Check to see if FILARC matches the code stored in the FTARC */ -/* column of the file table for this handle. If it doesn't, */ -/* signal an error. */ - - if (filarc != ftarc[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftarc", i__1, "zzddhman_", (ftnlen)1615)]) { - setmsg_("Logical unit associated with # file $, is trying to be clos" - "ed by routines in in the % system.", (ftnlen)93); - errch_("#", strarc + (((i__2 = ftarc[(i__1 = findex - 1) < 1000 && 0 - <= i__1 ? i__1 : s_rnge("ftarc", i__1, "zzddhman_", (ftnlen) - 1620)] - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("strarc", i__2, - "zzddhman_", (ftnlen)1620)) << 3), (ftnlen)1, (ftnlen)8); - errch_("%", tmpstr, (ftnlen)1, (ftnlen)8); - errch_("$", ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)1622)) * 255, ( - ftnlen)1, (ftnlen)255); - sigerr_("SPICE(FILARCMISMATCH)", (ftnlen)21); - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } - -/* Now check that if KILL is set, the file is accessible for */ -/* WRITE. */ - - if (*kill && ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftamh", i__1, "zzddhman_", (ftnlen)1633)] == 1) { - setmsg_("# file $ is open for READ access. Attempt to close and del" - "ete file has failed. ", (ftnlen)80); - errch_("#", strarc + (((i__2 = ftarc[(i__1 = findex - 1) < 1000 && 0 - <= i__1 ? i__1 : s_rnge("ftarc", i__1, "zzddhman_", (ftnlen) - 1637)] - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("strarc", i__2, - "zzddhman_", (ftnlen)1637)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)1638)) * 255, ( - ftnlen)1, (ftnlen)255); - sigerr_("SPICE(INVALIDACCESS)", (ftnlen)20); - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } - -/* Buffer the access method for HANDLE, since we may need it */ -/* when deciding which close to perform. */ - - accmet = ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftamh", i__1, "zzddhman_", (ftnlen)1649)]; - -/* If we reach here, we need to remove the row FINDEX from */ -/* the file table. */ - - i__1 = nft; - for (i__ = findex + 1; i__ <= i__1; ++i__) { - ftabs[(i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftabs", - i__2, "zzddhman_", (ftnlen)1657)] = ftabs[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftabs", i__3, "zzddhman_", - (ftnlen)1657)]; - ftamh[(i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftamh", - i__2, "zzddhman_", (ftnlen)1658)] = ftamh[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftamh", i__3, "zzddhman_", - (ftnlen)1658)]; - ftarc[(i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftarc", - i__2, "zzddhman_", (ftnlen)1659)] = ftarc[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftarc", i__3, "zzddhman_", - (ftnlen)1659)]; - ftbff[(i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftbff", - i__2, "zzddhman_", (ftnlen)1660)] = ftbff[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftbff", i__3, "zzddhman_", - (ftnlen)1660)]; - fthan[(i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan", - i__2, "zzddhman_", (ftnlen)1661)] = fthan[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("fthan", i__3, "zzddhman_", - (ftnlen)1661)]; - s_copy(ftnam + ((i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "ftnam", i__2, "zzddhman_", (ftnlen)1662)) * 255, ftnam + (( - i__3 = i__ - 1) < 1000 && 0 <= i__3 ? i__3 : s_rnge("ftnam", - i__3, "zzddhman_", (ftnlen)1662)) * 255, (ftnlen)255, (ftnlen) - 255); - ftrtm[(i__2 = i__ - 2) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftrtm", - i__2, "zzddhman_", (ftnlen)1663)] = ftrtm[(i__3 = i__ - 1) < - 1000 && 0 <= i__3 ? i__3 : s_rnge("ftrtm", i__3, "zzddhman_", - (ftnlen)1663)]; - } - --nft; - -/* Locate HANDLE in the unit table. */ - - uindex = isrchi_(handle, &nut, uthan); - if (uindex != 0) { - -/* Close the unit. */ - - if (*kill && accmet != 3) { - cl__1.cerr = 0; - cl__1.cunit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1680)]; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - } else { - cl__1.cerr = 0; - cl__1.cunit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1682)]; - cl__1.csta = 0; - f_clos(&cl__1); - } - -/* Remove its entry from the unit table. */ - - zzddhrmu_(&uindex, &nft, utcst, uthan, utlck, utlun, &nut); - } else { - -/* First, check to see if KILL is set, if it is signal an error */ -/* since we are unable to delete the file. */ - - if (*kill && accmet != 3) { - setmsg_("File successfully closed. Unable to delete file as req" - "uested. File not currently present in the UNIT table. ", - (ftnlen)110); - sigerr_("SPICE(FILENOTCONNECTED)", (ftnlen)23); - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } - -/* If we were unable to find the HANDLE in the unit table, */ -/* check to see if we have to clean up the UNIT table. */ - - if (nft < nut) { - uindex = isrchi_(&c__0, &nut, uthan); - -/* Now check to see if we located a zero valued handle. */ -/* If we did not manage to, then this is an error condition, */ -/* since we have more LUNs listed in the unit table than */ -/* files in the file table. */ - - if (uindex == 0) { - setmsg_("There are less files in the file table than units i" - "n the unit table, and no row with a zero-valued hand" - "le can be found. This should never occur.", (ftnlen) - 145); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; - } - -/* Free the unit. */ - - frelun_(&utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)1734)]); - -/* Compress the table. */ - - i__1 = nut; - for (i__ = uindex + 1; i__ <= i__1; ++i__) { - utcst[(i__2 = i__ - 2) < 23 && 0 <= i__2 ? i__2 : s_rnge( - "utcst", i__2, "zzddhman_", (ftnlen)1741)] = utcst[( - i__3 = i__ - 1) < 23 && 0 <= i__3 ? i__3 : s_rnge( - "utcst", i__3, "zzddhman_", (ftnlen)1741)]; - uthan[(i__2 = i__ - 2) < 23 && 0 <= i__2 ? i__2 : s_rnge( - "uthan", i__2, "zzddhman_", (ftnlen)1742)] = uthan[( - i__3 = i__ - 1) < 23 && 0 <= i__3 ? i__3 : s_rnge( - "uthan", i__3, "zzddhman_", (ftnlen)1742)]; - utlck[(i__2 = i__ - 2) < 23 && 0 <= i__2 ? i__2 : s_rnge( - "utlck", i__2, "zzddhman_", (ftnlen)1743)] = utlck[( - i__3 = i__ - 1) < 23 && 0 <= i__3 ? i__3 : s_rnge( - "utlck", i__3, "zzddhman_", (ftnlen)1743)]; - utlun[(i__2 = i__ - 2) < 23 && 0 <= i__2 ? i__2 : s_rnge( - "utlun", i__2, "zzddhman_", (ftnlen)1744)] = utlun[( - i__3 = i__ - 1) < 23 && 0 <= i__3 ? i__3 : s_rnge( - "utlun", i__3, "zzddhman_", (ftnlen)1744)]; - } - -/* Decrement NUT. */ - - --nut; - } - } - chkout_("ZZDDHCLS", (ftnlen)8); - return 0; -/* $Procedure ZZDDHHLU ( Private --- Handle to Logical Unit ) */ - -L_zzddhhlu: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the logical unit associated with a handle, in the event */ -/* the handle is not connected to a unit, connect it to one. */ - -/* $ 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 */ - -/* DAS */ -/* DAF */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) ARCH */ -/* LOGICAL LOCK */ -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle associated with the file of interest. */ -/* ARCH I Expected file architecture. */ -/* LOCK I Logical indicating to lock UNIT to HANDLE. */ -/* UNIT O Corresponding logical unit. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle associated with the file to retrieve a */ -/* logical unit. */ - -/* ARCH is the expected file architecture of the file */ -/* associated with HANDLE. */ - -/* LOCK is a logical that indicates whether the UNIT should be */ -/* locked to HANDLE. Locked units will keep the files */ -/* open and assigned the same logical unit. They may */ -/* only be unlocked by calling ZZDDHUNL. */ - -/* $ Detailed_Output */ - -/* UNIT is the logical unit that is currently assigned to */ -/* HANDLE. This unit may be used to perform I/O */ -/* operations on the file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* If HANDLE refers to a file not currently connected to a logical */ -/* unit, this routine will locate an entry in the unit table; */ -/* disconnect it if necessary; and connect the file associated with */ -/* HANDLE in its place. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(NOSUCHHANDLE) is signaled when HANDLE is not */ -/* found in the file table. The value of UNIT is undefined when */ -/* this error occurs. */ - -/* 2) The error SPICE(FILARCMISMATCH) is signaled if the specified */ -/* architecture does not match the one listed for HANDLE in the */ -/* file table. The value of UNIT is undefined when this error */ -/* occurs. */ - -/* 3) SPICE(FILEOPENFAIL) is signaled only when an attempt to */ -/* attach a logical unit to the file associated with HANDLE */ -/* fails. The value of UNIT is undefined when this error */ -/* occurs. */ - -/* 4) The error SPICE(HLULOCKFAILED) is signaled when the input */ -/* LOCK logical has a value of TRUE, and there are no free */ -/* 'lockable' units left in the unit table. The value of UNIT */ -/* returned when this error is signaled is undefined. */ - -/* $ Particulars */ - -/* This routine is used to retrieve a logical unit for a desired */ -/* handle. It also serves as a mechanism for locking the UNIT */ -/* to HANDLE relationship for a particular handle. This routine */ -/* can not be used to unlock this relationship. See ZZDDHUNL for */ -/* that functionality. */ - -/* $ Examples */ - -/* See DAFHLU or DASHLU for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDDHHLU", (ftnlen)8); - } - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED() only to trap the possibility of ZZDDHINI */ -/* signaling SPICE(BUG). */ - - if (failed_()) { - *unit = 0; - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Locate HANDLE in the file table. */ - - i__1 = abs(*handle); - findex = bsrchi_(&i__1, &nft, ftabs); - if (findex == 0) { - error = TRUE_; - } else if (fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "zzddhman_", (ftnlen)1949)] != *handle) { - error = TRUE_; - } else { - error = FALSE_; - } - if (error) { - *unit = 0; - setmsg_("There is no file loaded with handle = #", (ftnlen)39); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(NOSUCHHANDLE)", (ftnlen)19); - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - -/* Before actually fetching the unit, check the input architecture */ -/* matches that listed in the file table for this handle. This is */ -/* to prevent one architectures code from stepping on anothers. */ - - s_copy(tmpstr, arch, (ftnlen)8, arch_len); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - filarc = isrchc_(tmpstr, &c__2, strarc, (ftnlen)8, (ftnlen)8); - -/* Check to see if FILARC matches the code stored in the FTARC */ -/* column of the file table for this handle. If it doesn't, */ -/* signal an error. */ - - if (filarc != ftarc[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftarc", i__1, "zzddhman_", (ftnlen)1980)]) { - *unit = 0; - setmsg_("Logical unit associated with # file $, is trying to be unlo" - "cked by routines in in the % system.", (ftnlen)95); - errch_("#", strarc + (((i__2 = ftarc[(i__1 = findex - 1) < 1000 && 0 - <= i__1 ? i__1 : s_rnge("ftarc", i__1, "zzddhman_", (ftnlen) - 1987)] - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("strarc", i__2, - "zzddhman_", (ftnlen)1987)) << 3), (ftnlen)1, (ftnlen)8); - errch_("%", tmpstr, (ftnlen)1, (ftnlen)8); - errch_("$", ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)1989)) * 255, ( - ftnlen)1, (ftnlen)255); - sigerr_("SPICE(FILARCMISMATCH)", (ftnlen)21); - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - -/* If we make it this far, then we will be processing a handle */ -/* to logical unit request. Increment REQCNT. */ - - zzddhrcm_(&nut, utcst, &reqcnt); - -/* Now check to see if the handle is already present in the */ -/* unit table. */ - - uindex = isrchi_(handle, &nut, uthan); - -/* Check to see if we didn't locate the HANDLE in the table. */ -/* If we didn't, open the file associated with HANDLE again, */ -/* and get it into the unit table. */ - - if (uindex == 0) { - -/* We need a unit from the unit table, get one. */ - - zzddhgtu_(utcst, uthan, utlck, utlun, &nut, &uindex); - -/* Check FAILED, since ZZDDHGTU may have invoked GETLUN. */ - - if (failed_()) { - *unit = 0; - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - -/* Re-attach the file to a logical unit. Branch based on the */ -/* access method stored in the file table. */ - - if (ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftamh", i__1, "zzddhman_", (ftnlen)2035)] == 4 || ftamh[( - i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("ftamh" - , i__2, "zzddhman_", (ftnlen)2035)] == 2) { - o__1.oerr = 1; - o__1.ounit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)2038)]; - o__1.ofnmlen = ftrtm[(i__3 = findex - 1) < 1000 && 0 <= i__3 ? - i__3 : s_rnge("ftrtm", i__3, "zzddhman_", (ftnlen)2038)]; - o__1.ofnm = ftnam + ((i__2 = findex - 1) < 1000 && 0 <= i__2 ? - i__2 : s_rnge("ftnam", i__2, "zzddhman_", (ftnlen)2038)) * - 255; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - } else if (ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftamh", i__1, "zzddhman_", (ftnlen)2045)] == 1) { - o__1.oerr = 1; - o__1.ounit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlun", i__1, "zzddhman_", (ftnlen)2047)]; - o__1.ofnmlen = ftrtm[(i__3 = findex - 1) < 1000 && 0 <= i__3 ? - i__3 : s_rnge("ftrtm", i__3, "zzddhman_", (ftnlen)2047)]; - o__1.ofnm = ftnam + ((i__2 = findex - 1) < 1000 && 0 <= i__2 ? - i__2 : s_rnge("ftnam", i__2, "zzddhman_", (ftnlen)2047)) * - 255; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - } else { - *unit = 0; - setmsg_("Invalid access method. This error should never be sign" - "alled.", (ftnlen)61); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - -/* Check IOSTAT for troubles. */ - - if (iostat != 0) { - -/* The re-open was unsuccessful, leave the entry in the file */ -/* table and clean up the row in the unit table before */ -/* returning. Normally when we call ZZDDHRMU it is to */ -/* remove a unit from the unit table. In this case we */ -/* know the unit will remain since we have not decreased */ -/* the entries in the file table. */ - - zzddhrmu_(&uindex, &nft, utcst, uthan, utlck, utlun, &nut); - -/* Now signal the error. */ - - *unit = 0; - setmsg_("Attempt to reconnect logical unit to file '#' failed. I" - "OSTAT was #.", (ftnlen)67); - errch_("#", ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)2088)) * - 255, (ftnlen)1, (ftnlen)255); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAIL)", (ftnlen)19); - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - -/* Lastly populate the unit table values. */ - - uthan[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("uthan", - i__1, "zzddhman_", (ftnlen)2099)] = fthan[(i__2 = findex - 1) - < 1000 && 0 <= i__2 ? i__2 : s_rnge("fthan", i__2, "zzddhman_" - , (ftnlen)2099)]; - utlck[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utlck", - i__1, "zzddhman_", (ftnlen)2100)] = FALSE_; - } - -/* At this point UINDEX points to the row in the unit table that */ -/* contains the connection information. We need to update the cost */ -/* row with the new value of REQCNT, and then set the lock row to */ -/* TRUE if a lock request was made. */ - - utcst[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utcst", i__1, - "zzddhman_", (ftnlen)2110)] = reqcnt; - if (*lock && ! utlck[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : - s_rnge("utlck", i__1, "zzddhman_", (ftnlen)2112)]) { - -/* First check to see if we have enough lockable units */ -/* left in the unit table. */ - - locked = zzddhclu_(utlck, &nut); - if (locked >= 20) { - *unit = 0; - setmsg_("Unable to lock handle for file '#' to a logical unit. " - "There are no rows available for locking in the unit tabl" - "e.", (ftnlen)113); - errch_("#", ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? - i__1 : s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)2127)) * - 255, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(HLULOCKFAILED)", (ftnlen)20); - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; - } - utlck[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utlck", - i__1, "zzddhman_", (ftnlen)2134)] = TRUE_; - } - -/* Set the value of UNIT and return. */ - - *unit = utlun[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utl" - "un", i__1, "zzddhman_", (ftnlen)2141)]; - chkout_("ZZDDHHLU", (ftnlen)8); - return 0; -/* $Procedure ZZDDHUNL ( Private --- Unlock Logical Unit from Handle ) */ - -L_zzddhunl: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Unlock a logical unit from the specified handle. */ - -/* $ 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 */ - -/* DAS */ -/* DAF */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) ARCH */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle assigned to the file to unlock. */ -/* ARCH I Expected architecture of the handle to unlock. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle associated with the file that */ -/* is to have its logicial unit lock released. */ - -/* ARCH is the expected architecture of the file associated */ -/* with HANDLE. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine does not explicitly alter the open or closed */ -/* state of the file associated with HANDLE. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is 0, not found in the unit table, or found and */ -/* not currently locked, this routine just returns to the */ -/* caller. */ - -/* 2) SPICE(FILARCMISMATCH) is signaled if the specified architecture */ -/* does not match the one listed in the file table. */ - -/* 3) If HANDLE is associated with a scratch file, this routine */ -/* simply returns, as scratch files may not be unlocked from */ -/* their logical units. */ - -/* $ Particulars */ - -/* This routine allows users to unlock a handle from it's logical */ -/* unit in the event a handle to logical unit request was made */ -/* with the LOCK argument set to true. (DAFHLU and DASHLU both */ -/* lock units, and require a call to this routine to unlock them). */ - -/* $ Examples */ - -/* See some routine that calls this one (TBD). */ - -/* $ Restrictions */ - -/* This routine utilizes discovery check in and out. However, */ -/* routines in the initialization loop may signal the error */ -/* SPICE(BUG) under the conditions of the existence of a bug. */ -/* Since this routine utilizes discovery check in and out, */ -/* no check in or out is performed around the initialization */ -/* block. This is by design. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ - -/* Standard SPICE discovery error handling. */ - - if (return_()) { - return 0; - } - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED() only to trap the possibility of ZZDDHINI */ -/* signaling SPICE(BUG). No check out is performed, see the */ -/* $Restrictions section of the entry point header for details. */ - - if (failed_()) { - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Prevent the user from locating zero handle rows. This is not */ -/* really necessary since zero handle rows in the unit table are */ -/* empty and awaiting connections. The state of the UTLCK is */ -/* not significant. */ - - if (*handle == 0) { - return 0; - } - -/* Look up the handle in the unit table. */ - - uindex = isrchi_(handle, &nut, uthan); - -/* Now check the results of the lookup. If HANDLE was not found */ -/* in the unit table or the unit was not locked, just return as */ -/* there is nothing to do. */ - - if (uindex == 0) { - return 0; - } else if (! utlck[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge( - "utlck", i__1, "zzddhman_", (ftnlen)2329)]) { - return 0; - } - -/* Now look up the handle in the table. Remember FTABS is a sorted */ -/* list in increasing order. */ - - i__1 = abs(*handle); - findex = bsrchi_(&i__1, &nft, ftabs); - -/* Check to see if HANDLE is in the file table. We know it has */ -/* to be since it is in the unit table if we make it this far. */ -/* These checks are just for safety's sake. */ - - if (findex == 0) { - chkin_("ZZDDHUNL", (ftnlen)8); - setmsg_("HANDLE # was not found in the file table but was located in" - " the unit table. This error should never occur.", (ftnlen) - 107); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHUNL", (ftnlen)8); - return 0; - } else if (fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "zzddhman_", (ftnlen)2355)] != *handle) { - chkin_("ZZDDHUNL", (ftnlen)8); - setmsg_("HANDLE # was not found in the file table but was located in" - " the unit table. This error should never occur.", (ftnlen) - 107); - errint_("#", handle, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHUNL", (ftnlen)8); - return 0; - } - -/* Before actually unlocking the unit, check the input architecture */ -/* matches that listed in the file table for this handle. This is */ -/* to prevent one architectures code from stepping on anothers. */ - - s_copy(tmpstr, arch, (ftnlen)8, arch_len); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - filarc = isrchc_(tmpstr, &c__2, strarc, (ftnlen)8, (ftnlen)8); - -/* Check to see if FILARC matches the code stored in the FTARC */ -/* column of the file table for this handle. If it doesn't, */ -/* signal an error. */ - - if (filarc != ftarc[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftarc", i__1, "zzddhman_", (ftnlen)2382)]) { - chkin_("ZZDDHUNL", (ftnlen)8); - setmsg_("Logical unit associated with # file $, is trying to be unlo" - "cked by routines in in the % system.", (ftnlen)95); - errch_("#", strarc + (((i__2 = ftarc[(i__1 = findex - 1) < 1000 && 0 - <= i__1 ? i__1 : s_rnge("ftarc", i__1, "zzddhman_", (ftnlen) - 2388)] - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("strarc", i__2, - "zzddhman_", (ftnlen)2388)) << 3), (ftnlen)1, (ftnlen)8); - errch_("%", tmpstr, (ftnlen)1, (ftnlen)8); - errch_("$", ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)2390)) * 255, ( - ftnlen)1, (ftnlen)255); - sigerr_("SPICE(FILARCMISMATCH)", (ftnlen)21); - chkout_("ZZDDHUNL", (ftnlen)8); - return 0; - } - -/* Lastly, check to see if the access method for HANDLE indicates */ -/* scratch access. If it is, just return, since scratch files */ -/* can not have their units unlocked. */ - - if (ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("ftamh", - i__1, "zzddhman_", (ftnlen)2402)] == 3) { - return 0; - } - utlck[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("utlck", i__1, - "zzddhman_", (ftnlen)2406)] = FALSE_; - return 0; -/* $Procedure ZZDDHNFO ( Private --- Get information about a Handle ) */ - -L_zzddhnfo: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Get information about the file attached to HANDLE. */ - -/* $ 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 */ - -/* DAF */ -/* DAS */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) FNAME */ -/* INTEGER INTARC */ -/* INTEGER INTBFF */ -/* INTEGER INTAMH */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle assigned to file of interest. */ -/* FNAME O Name of the file associated with HANDLE. */ -/* INTARC O Integer code for FNAME's file architecture. */ -/* INTBFF O Integer code for FNAME's binary file format. */ -/* INTAMH O Integer code for FNAME's access method. */ -/* FOUND O Logical that indicates if HANDLE was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle associated with the file for which */ -/* information is requested. */ - -/* $ Detailed_Output */ - -/* FNAME is the name of the file used associated with HANDLE. */ -/* This is the name used to load the file originally. */ - -/* INTARC is an integer code for FNAME's file architecture. */ -/* See the include file 'zzddhman.inc' for particulars. */ -/* The following are possible outputs: */ - -/* DAS - Direct Access, Segregated File Architecture */ -/* DAF - Double Precision Array File Architecture */ - -/* INTBFF is an integer code that represents FNAME's binary */ -/* file format. See the include file 'zzddhman.inc' for */ -/* particulars. The following are the possible outputs: */ - -/* BIGI3E - Big Endian IEEE Floating Point Format */ -/* LTLI3E - Little Endian IEEE Floating Point Format */ -/* VAXGFL - VAX G-Float Format */ -/* VAXDFL - VAX D-Float Format */ - -/* INTAMH is an integer code that represents FNAME's access */ -/* method. See the include file 'zzddhman.inc' for */ -/* particulars. The following are possible outputs: */ - -/* READ - File was loaded for read access */ -/* WRITE - File was loaded for read/write access */ -/* NEW - New file was created for read/write access */ -/* SCRTCH - Scratch file created for read/write access */ - -/* FOUND is a logical if set to TRUE indicates that HANDLE */ -/* was located in the file table. Otherwise, it was */ -/* not found in the table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If FOUND is FALSE, then the other output arguments */ -/* are undefined. */ - -/* $ Particulars */ - -/* This routine provides access to information necessary for */ -/* translation and other I/O based tasks to modules that are */ -/* not entry points to this handle manager. */ - -/* $ Examples */ - -/* See ZZDAFGFR, ZZDAFGSR, or ZZDAFGDR for sample usage. */ - -/* $ Restrictions */ - -/* Routines in the call tree of this routine may signal the error */ -/* SPICE(BUG) under the conditions of the existence of a bug */ -/* in routines the initialization loop invokes. Since this */ -/* routine is error free with the exception of this bug condition, */ -/* it does not participate in tracing by design. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED(), and return on failure. We are not checking */ -/* out or in since this routine would be error free if not for */ -/* the possibility of ZZDDHINI signaling SPICE(BUG). See */ -/* $Restrictions for details. */ - - if (failed_()) { - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Look up the handle in the table. Remember FTABS is sorted */ -/* listed in increasing order. */ - - i__1 = abs(*handle); - findex = bsrchi_(&i__1, &nft, ftabs); - -/* Check to see if HANDLE is in the handle table. Remember that */ -/* we are indexing the table using the absolute value of handle. */ -/* So include a check to see that HANDLE is FTHAN(FINDEX). */ - - if (findex == 0) { - s_copy(fname, " ", fname_len, (ftnlen)1); - *intarc = 0; - *intbff = 0; - *intamh = 0; - *found = FALSE_; - return 0; - } else if (fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "zzddhman_", (ftnlen)2610)] != *handle) { - s_copy(fname, " ", fname_len, (ftnlen)1); - *intarc = 0; - *intbff = 0; - *intamh = 0; - *found = FALSE_; - return 0; - } - -/* If we make it this far, then we have a handle that is in */ -/* the handle table at row FINDEX. */ - - *found = TRUE_; - s_copy(fname, ftnam + ((i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftnam", i__1, "zzddhman_", (ftnlen)2624)) * 255, - fname_len, ftrtm[(i__2 = findex - 1) < 1000 && 0 <= i__2 ? i__2 : - s_rnge("ftrtm", i__2, "zzddhman_", (ftnlen)2624)]); - *intarc = ftarc[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftarc", i__1, "zzddhman_", (ftnlen)2625)]; - *intbff = ftbff[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftbff", i__1, "zzddhman_", (ftnlen)2626)]; - *intamh = ftamh[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "ftamh", i__1, "zzddhman_", (ftnlen)2627)]; - return 0; -/* $Procedure ZZDDHISN ( Private --- Is Handle Native? ) */ - -L_zzddhisn: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine whether the file attached to HANDLE is uses the */ -/* binary file format native to the system. */ - -/* $ 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 */ - -/* DAS */ -/* DAF */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* LOGICAL NATIVE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle assigned to file to determine format. */ -/* NATIVE O Indicates if the file format is native. */ -/* FOUND O Indicates if HANDLE is currently attached to file. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle associated with the file that is */ -/* to be determined to be native or not. */ - -/* $ Detailed_Output */ - -/* NATIVE is a logical that when set to TRUE indicates that */ -/* the file associated with HANDLE is of the native */ -/* binary file format for the current platform. If */ -/* FALSE, then the file is of an alien file format. */ - -/* FOUND is a logical that when set to TRUE indicates that */ -/* HANDLE was found in the file table and is associated */ -/* with a file. If FALSE, then NATIVE remains unchanged, */ -/* since the file was not found in the table. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) In the event that HANDLE can not be found in the file table, */ -/* FOUND is set to FALSE and NATIVE is left unchanged. */ - -/* $ Particulars */ - -/* This routine simply answers the question: "Is the file attached */ -/* to this handle of the native binary file format?" */ - -/* $ Examples */ - -/* See DAFRDA for sample usage. */ - -/* $ Restrictions */ - -/* Routines in the call tree of this routine may signal the error */ -/* SPICE(BUG) under the conditions of the existence of a bug */ -/* in routines the initialization loop invokes. Since this */ -/* routine is error free with the exception of this bug condition, */ -/* it does not participate in tracing by design. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED(), and return on failure. We are not checking */ -/* out or in since this routine would be error free if not for */ -/* the possibility of ZZDDHINI signaling SPICE(BUG). See */ -/* $Restrictions for details. */ - - if (failed_()) { - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Look up the handle in the table. Remember FTABS is sorted */ -/* listed in increasing order. */ - - i__1 = abs(*handle); - findex = bsrchi_(&i__1, &nft, ftabs); - -/* Check to see if HANDLE is in the handle table. Remember */ -/* that we are indexing the table using the absolute value of */ -/* handle. So include a check to see that HANDLE is FTHAN(FINDEX). */ - - if (findex == 0) { - *found = FALSE_; - return 0; - } else if (fthan[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "fthan", i__1, "zzddhman_", (ftnlen)2799)] != *handle) { - *found = FALSE_; - return 0; - } - -/* If we make it this far, then we have found HANDLE in the file */ -/* table. Set NATIVE appropriately and FOUND to TRUE. */ - - *native = natbff == ftbff[(i__1 = findex - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("ftbff", i__1, "zzddhman_", (ftnlen)2808)]; - *found = TRUE_; - return 0; -/* $Procedure ZZDDHFNH ( Private --- Filename to Handle ) */ - -L_zzddhfnh: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Retrieve handle associated with filename. */ - -/* $ 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 */ - -/* DAF */ -/* DAS */ -/* PRIVATE */ - -/* $ Declarations */ - -/* CHARACTER*(*) FNAME */ -/* INTEGER HANDLE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of a file previously loaded with ZZDDHOPN. */ -/* HANDLE O Corresponding file handle. */ -/* FOUND O Logical indicating whether HANDLE was located. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of a file previously loaded with ZZDDHOPN. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle associated with the file. */ - -/* FOUND is a logical when TRUE indicates HANDLE was located */ -/* for FNAME. If FALSE no handle was found associated */ -/* with FNAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) ZZDDHF2H in the call tree of this routine performs I/O */ -/* functions and may signal errors that are the result of */ -/* I/O failures. See ZZDDHF2H header for details. */ - -/* $ Particulars */ - -/* This routine is provided for completeness and serves only to */ -/* support the DAFFNH and DASFNH interfaces. */ - -/* $ Examples */ - -/* See DAFFNH or DASFNH for sample usage. */ - -/* $ Restrictions */ - -/* 1) On VAX environments, this routine may only be used when */ -/* FNAME refers to a DAF or DAS file. An error may be */ -/* signaled when used with unopened files that utilize other */ -/* architectures. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ - if (return_()) { - return 0; - } else { - chkin_("ZZDDHFNH", (ftnlen)8); - } - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED() only to trap the possibility of ZZDDHINI */ -/* signaling SPICE(BUG). */ - - if (failed_()) { - *handle = 0; - chkout_("ZZDDHFNH", (ftnlen)8); - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Left justify FNAME to trim any leading white space. */ - - ljust_(fname, locfnm, fname_len, (ftnlen)255); - -/* Look up FNAME in the handle table. */ - - zzddhf2h_(locfnm, ftabs, ftamh, ftarc, ftbff, fthan, ftnam, ftrtm, &nft, - utcst, uthan, utlck, utlun, &nut, &inqext, &inqopn, &inqhan, - found, (ftnlen)255, (ftnlen)255); - -/* Check found and set HANDLE if we have got one. No need to */ -/* check FAILED() since ZZDDHF2H returns FOUND set to FALSE on */ -/* error. */ - - if (*found) { - *handle = inqhan; - } else { - *handle = 0; - } - chkout_("ZZDDHFNH", (ftnlen)8); - return 0; -/* $Procedure ZZDDHLUH ( Private --- Logical Unit to Handle ) */ - -L_zzddhluh: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the handle associated with a logical unit. */ - -/* $ 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 */ - -/* DAS */ -/* DAF */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER UNIT */ -/* INTEGER HANDLE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit connected to a file. */ -/* HANDLE O Corresponding handle. */ -/* FOUND O Logical indicating the handle was located. */ - -/* $ Detailed_Input */ - -/* UNIT is the logical unit to which a file managed by DDH is */ -/* currently connected. */ - -/* $ Detailed_Output */ - -/* HANDLE is the handle associated with the logical unit of */ -/* interest. */ - -/* FOUND is a logical flag if TRUE indicates that a HANDLE */ -/* was found associated with UNIT. If FALSE indicates */ -/* no handle was found for UNIT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If UNIT is not found in the unit table, HANDLE is undefined */ -/* and FOUND is set to .FALSE. */ - -/* $ Particulars */ - -/* This routine is provided for completeness and serves only to */ -/* support the DAFLUH and DASLUH interfaces. */ - -/* $ Examples */ - -/* See DAFLUH or DASLUH for usage. */ - -/* $ Restrictions */ - -/* Routines in the call tree of this routine may signal the error */ -/* SPICE(BUG) under the conditions of the existence of a bug */ -/* in routines the initialization loop invokes. Since this */ -/* routine is error free with the exception of this bug condition, */ -/* it does not participate in tracing by design. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-NOV-2001 (FST) */ - - -/* -& */ - -/* Do the initialization tasks. */ - - if (first) { - zzddhini_(&natbff, supbff, &numsup, stramh, strarc, strbff, (ftnlen)8, - (ftnlen)8, (ftnlen)8); - -/* Check FAILED(), and return on failure. We are not checking */ -/* out or in since this routine would be error free if not for */ -/* the possibility of ZZDDHINI signaling SPICE(BUG). See */ -/* $Restrictions for details. */ - - if (failed_()) { - *handle = 0; - return 0; - } - -/* Clear FIRST since we've done the initialization. */ - - first = FALSE_; - } - -/* Look up the unit in the table. */ - - uindex = isrchi_(unit, &nut, utlun); - if (uindex == 0) { - *handle = 0; - *found = FALSE_; - return 0; - } else if (uthan[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge( - "uthan", i__1, "zzddhman_", (ftnlen)3153)] == 0) { - *handle = 0; - *found = FALSE_; - return 0; - } - -/* We've got a handle, store the value and return. */ - - *handle = uthan[(i__1 = uindex - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge( - "uthan", i__1, "zzddhman_", (ftnlen)3162)]; - *found = TRUE_; - return 0; -} /* zzddhman_ */ - -/* Subroutine */ int zzddhman_(logical *lock, char *arch, char *fname, char * - method, integer *handle, integer *unit, integer *intamh, integer * - intarc, integer *intbff, logical *native, logical *found, logical * - kill, ftnlen arch_len, ftnlen fname_len, ftnlen method_len) -{ - return zzddhman_0_(0, lock, arch, fname, method, handle, unit, intamh, - intarc, intbff, native, found, kill, arch_len, fname_len, - method_len); - } - -/* Subroutine */ int zzddhopn_(char *fname, char *method, char *arch, integer - *handle, ftnlen fname_len, ftnlen method_len, ftnlen arch_len) -{ - return zzddhman_0_(1, (logical *)0, arch, fname, method, handle, (integer - *)0, (integer *)0, (integer *)0, (integer *)0, (logical *)0, ( - logical *)0, (logical *)0, arch_len, fname_len, method_len); - } - -/* Subroutine */ int zzddhcls_(integer *handle, char *arch, logical *kill, - ftnlen arch_len) -{ - return zzddhman_0_(2, (logical *)0, arch, (char *)0, (char *)0, handle, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (logical *) - 0, (logical *)0, kill, arch_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzddhhlu_(integer *handle, char *arch, logical *lock, - integer *unit, ftnlen arch_len) -{ - return zzddhman_0_(3, lock, arch, (char *)0, (char *)0, handle, unit, ( - integer *)0, (integer *)0, (integer *)0, (logical *)0, (logical *) - 0, (logical *)0, arch_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzddhunl_(integer *handle, char *arch, ftnlen arch_len) -{ - return zzddhman_0_(4, (logical *)0, arch, (char *)0, (char *)0, handle, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (logical *) - 0, (logical *)0, (logical *)0, arch_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzddhnfo_(integer *handle, char *fname, integer *intarc, - integer *intbff, integer *intamh, logical *found, ftnlen fname_len) -{ - return zzddhman_0_(5, (logical *)0, (char *)0, fname, (char *)0, handle, ( - integer *)0, intamh, intarc, intbff, (logical *)0, found, ( - logical *)0, (ftnint)0, fname_len, (ftnint)0); - } - -/* Subroutine */ int zzddhisn_(integer *handle, logical *native, logical * - found) -{ - return zzddhman_0_(6, (logical *)0, (char *)0, (char *)0, (char *)0, - handle, (integer *)0, (integer *)0, (integer *)0, (integer *)0, - native, found, (logical *)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzddhfnh_(char *fname, integer *handle, logical *found, - ftnlen fname_len) -{ - return zzddhman_0_(7, (logical *)0, (char *)0, fname, (char *)0, handle, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (logical *) - 0, found, (logical *)0, (ftnint)0, fname_len, (ftnint)0); - } - -/* Subroutine */ int zzddhluh_(integer *unit, integer *handle, logical *found) -{ - return zzddhman_0_(8, (logical *)0, (char *)0, (char *)0, (char *)0, - handle, unit, (integer *)0, (integer *)0, (integer *)0, (logical * - )0, found, (logical *)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzddhppf.c b/ext/spice/src/cspice/zzddhppf.c deleted file mode 100644 index bc05af9507..0000000000 --- a/ext/spice/src/cspice/zzddhppf.c +++ /dev/null @@ -1,1084 +0,0 @@ -/* zzddhppf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__5 = 5; -static integer c__4 = 4; - -/* $Procedure ZZDDHPPF ( Private --- DDH Prepare Preexisting File ) */ -/* Subroutine */ int zzddhppf_(integer *unit, integer *arch, integer *bff) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - char ch__1[1]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_rdue(cilist *), - do_uio(integer *, char *, ftnlen), e_rdue(void); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char null[1]; - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzddhivf_(char *, integer *, logical *, ftnlen), - zzftpchk_(char *, logical *, ftnlen), zzplatfm_(char *, char *, - ftnlen, ftnlen); - integer i__, fdrec; - extern /* Subroutine */ int zzftpstr_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen), chkin_(char *, ftnlen), ucase_( - char *, char *, ftnlen, ftnlen), errch_(char *, char *, ftnlen, - ftnlen); - logical found; - extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - char filarc[4], bffidw[8], chrrec[1000]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char ftpdlm[1], ftpmem[16], ftplft[6], strarc[8*2], strbff[8*5]; - integer iostat, tstarc; - static char ftprgt[6]; - char filtyp[4]; - logical ftperr; - integer ftppos; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), errfnm_(char *, integer - *, ftnlen); - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - - /* Fortran I/O blocks */ - static cilist io___11 = { 1, 0, 1, 0, 1 }; - static cilist io___20 = { 1, 0, 1, 0, 0 }; - - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Prepare preexisting binary file for entry into the handle */ -/* table. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ 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. */ - - -/* Include Section: Private FTP Validation String Parameters */ - -/* zzftprms.inc Version 1 01-MAR-1999 (FST) */ - -/* This include file centralizes the definition of string sizes */ -/* and other parameters that are necessary to properly implement */ -/* the FTP error detection scheme for binary kernels. */ - -/* Before making any alterations to the contents of this file, */ -/* refer to the header of ZZFTPSTR for a detailed discussion of */ -/* the FTP validation string. */ - -/* Size of FTP Test String Component: */ - - -/* Size of Maximum Expanded FTP Validation String: */ - -/* (This indicates the size of a buffer to hold the test */ -/* string sequence from a possibly corrupt file. Empirical */ -/* evidence strongly indicates that expansion due to FTP */ -/* corruption at worst doubles the number of characters. */ -/* So take 3*SIZSTR to be on the safe side.) */ - - -/* Size of FTP Validation String Brackets: */ - - -/* Size of FTP Validation String: */ - - -/* Size of DELIM. */ - - -/* Number of character clusters present in the validation string. */ - - -/* End Include Section: Private FTP Validation String Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Logical unit attached to the binary file. */ -/* ARCH I Integer code indicating the file architecture. */ -/* BFF O Integer code indicating the binary file format. */ - -/* $ Detailed_Input */ - -/* UNIT is a logical unit attached to the binary file to be */ -/* prepared for inclusion into the handle table. */ - -/* ARCH is an integer that indicates the architecture of */ -/* the file attached to UNIT. Acceptable values are */ -/* the parameters: */ - -/* DAF */ -/* DAS */ - -/* defined in ZZDDHMAN.INC. */ - -/* $ Detailed_Output */ - -/* BFF is an integer that indicates the binary file format */ -/* of the DAF attached to UNIT. Possible values are */ -/* the parameters: */ - -/* BIGI3E */ -/* LTLI3E */ -/* VAXGFL */ -/* VAXDFL */ - -/* defined in ZZDDHMAN.INC. */ - -/* $ Parameters */ - -/* See the include file ZZDDHMAN.INC. */ - -/* $ Exceptions */ - -/* 1) SPICE(UNKNOWNFILARC) is signaled when ARCH is not in the */ -/* range of codes for known file architectures or the binary */ -/* file's ID word is unknown to IDW2AT. BFF is set to 0 when */ -/* this error is signaled. UNIT is not closed. */ - -/* 2) SPICE(FILEREADFAILED) is signaled when either of the two */ -/* READ statements in the module returns non-zero IOSTAT, thus */ -/* indicating read failure. BFF is set to 0 in this case. Unit */ -/* is not closed. */ - -/* 3) SPICE(FILARCMISMATCH) is signaled when the file attached to */ -/* UNIT is determined to utilize an architecture that is */ -/* different from the one to which the input argument ARCH */ -/* refers. Unit is not closed. */ - -/* 4) SPICE(UNKNOWNBFF) is signaled whenever the binary file */ -/* format detection algorithm reaches a state of uncertainty */ -/* for DAFs. This can be the result of several conditions, */ -/* an empty pre-N0052 DAF, reading a DAF with an unknown BFF */ -/* from a future toolkit, etc. In all cases, BFF is set to 0. */ -/* Unit is not closed. */ - -/* 5) If a pre-FTP string binary is loaded, no FTP based */ -/* diagnostics are performed, and the file is assumed to be */ -/* in proper, working order. */ - -/* $ Files */ - -/* This routine reads at least one, and potentially, several records */ -/* from the file attached to UNIT. */ - -/* $ Particulars */ - -/* This routine exists to prepare a binary file for inclusion */ -/* in the handle table in ZZDDHMAN. This includes verifying */ -/* that the file is suitable to load and determining the binary */ -/* file format where possible. */ - -/* For DAF files: */ - -/* The binary file format of old (pre-N0050) binaries is */ -/* detectable if the file is non-empty and undamaged. */ -/* New files contain the binary file format identification */ -/* string in the file record along with the FTP error */ -/* detection string. They are correctly identified in most */ -/* cases, including damaged. */ - -/* For DAS files: */ - -/* The binary file format of old (pre-N0052) binaries is */ -/* not detectable. This this module will assume that any */ -/* old DAS binaries are of the native format. New binaries */ -/* include the binary file format identification string as */ -/* well as the FTP error detection string. They are */ -/* correctly identified in most cases as well. */ - -/* FTP Error Detection: */ - -/* FTP error detection occurs when at least part of the */ -/* detection string is detected in the file record. When */ -/* absent, no errors are signaled and the file is then */ -/* assumed to be an old binary. In the event that the FTP */ -/* detection string is present, and additional unknown */ -/* sequences are present, diagnostics are only performed on */ -/* sequences known to this version of the toolkit. */ - -/* $ Examples */ - -/* See ZZDDHMAN for sample usage. */ - -/* $ Restrictions */ - -/* 1) The file attached to UNIT was written on a platform whose */ -/* characters are of a single byte in length. */ - -/* 2) Numeric data when read as characters from the UNIT */ -/* preserves the bit patterns present in the file in */ -/* memory. */ - -/* 3) The intrinsic ICHAR preserves the bit pattern of the */ -/* character byte read from a file. Namely if one examines */ -/* the integer created the 8 least significant bits will be */ -/* precisely those found in the character. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.0.0, 06-FEB-2002 (FST) */ - -/* This routine was updated to load binaries created by */ -/* N0051 versions of Sun Solaris Native C Toolkits. See */ -/* the Revisions section for details. */ - -/* - SPICELIB Version 1.0.0, 04-OCT-2001 (FST) */ - - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 06-FEB-2002 (FST) */ - -/* Shortly after releasing N0052, a few of our users */ -/* discovered that they were unable to load binary */ -/* DAFs created with the N0051 Sun Solaris Native C */ -/* (SUN-SOLARIS-NATIVE_C) Toolkits. The reason for this */ -/* is the previous version of ZZDDHPPF released with N0052 */ -/* assumed that if a DAF file record possessed a valid */ -/* FTP error detection string, then it must contain a */ -/* binary file format ID string as well. Both were added */ -/* to the DAF file record in N0050. */ - -/* However, a bug in the N0051 version of the ZZPLATFM */ -/* master file, the source of the binary file format ID */ -/* string for a given platform, neglected to assign a */ -/* value to the string. Since it was a C environment */ -/* and the implementation of ZZPLATFM resulted in the */ -/* string being a static variable, it was initialized */ -/* to nulls and written into the file. */ - -/* This version of ZZDDHPPF has been extended to recognize */ -/* a null binary file format ID, and apply the byte */ -/* examination algorithm used on pre-N0050 DAFs to determine */ -/* its format. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - -/* Number of characters to be read in from a record. */ - - -/* Bounding indices for the window that brackets the FTP */ -/* error detection string in the file record. */ - - -/* Index of the start of the binary file format identification */ -/* string in DAF binaries. */ - - -/* Index of the start of the binary file format identification */ -/* string in DAS binaries. */ - - -/* Size of the binary format identification string. */ - - -/* Index of the first byte of NI in the DAF file record. */ - - -/* Index of the first byte of NSUM in the DAF descriptor record. */ - - -/* Index of the first byte of FDREC in the DAF file record. */ - - -/* Integer code such that CHAR(INTNUL) produces the NULL character. */ - - -/* IDW2AT Output Argument Lengths. */ - - -/* NULLID is the index of the extended STRBFF "NULL" string ID. */ - - -/* Local Variables */ - - -/* Statement Functions */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Statement Function Definitions */ - -/* This function controls the conversion of characters to integers. */ -/* On some supported environments, ICHAR is not sufficient to */ -/* produce the desired results. This however, is not the case */ -/* with this particular environment. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZDDHPPF", (ftnlen)8); - } - -/* If this is the first time into the routine, populate local */ -/* copies of reference values. This includes the names of the */ -/* BFF parameters, the names of the ARCH parameters, and the */ -/* local copy of the FTP string. */ - - if (first) { - -/* Construct and store the NULL valued byte. */ - - *(unsigned char *)null = '\0'; - -/* Retrieve the BFF and ARCH names. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 5 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzddhppf_", (ftnlen) - 484)) << 3), (ftnlen)3, (ftnlen)8); - } - for (i__ = 1; i__ <= 2; ++i__) { - zzddhgsd_("ARCH", &i__, strarc + (((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("strarc", i__1, "zzddhppf_", (ftnlen) - 488)) << 3), (ftnlen)4, (ftnlen)8); - } - -/* Extend STRBFF to include the null BFFID. This addresses */ -/* the N0051 Sun Solaris Native C toolkit binary files. */ - - for (i__ = 1; i__ <= 8; ++i__) { - *(unsigned char *)&strbff[i__ + 31] = *(unsigned char *)null; - } - -/* Fetch the FTP string. */ - - zzftpstr_(ftpmem, ftplft, ftprgt, ftpdlm, (ftnlen)16, (ftnlen)6, ( - ftnlen)6, (ftnlen)1); - -/* Set FIRST to FALSE so we will not reassign any of these values. */ - - first = FALSE_; - } - -/* Get the simple consistency checks out of the way first. Is */ -/* the input ARCH value valid? */ - - if (*arch <= 0 || *arch > 2) { - *bff = 0; - setmsg_("The integer code, '#' indicating the file architecture to e" - "xamine is out of range.", (ftnlen)82); - errint_("#", arch, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFILARC)", (ftnlen)20); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* Read the first record from the file as a string of NUMCHR */ -/* characters. */ - - io___11.ciunit = *unit; - iostat = s_rdue(&io___11); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, chrrec, (ftnlen)1000); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - -/* Check for read failure. */ - - if (iostat != 0) { - *bff = 0; - setmsg_("Error reading the file record from the binary DAF file '#'." - " IOSTAT = #.", (ftnlen)72); - errfnm_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* First check the ID word from the input file. */ - - idw2at_(chrrec, filarc, filtyp, (ftnlen)8, (ftnlen)4, (ftnlen)4); - -/* Now locate FILARC in the STRARC array. */ - - tstarc = isrchc_(filarc, &c__2, strarc, (ftnlen)4, (ftnlen)8); - -/* If FILARC was not found, signal an appropriate error. */ - - if (tstarc == 0) { - *bff = 0; - setmsg_("The file, #, has a unidentified file architecture. Check t" - "hat this file is a properly created binary SPICE kernel.", ( - ftnlen)115); - errfnm_("#", unit, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFILARC)", (ftnlen)20); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - -/* Otherwise we have an architecture mismatch error, if */ -/* FILARC does not agree with ARCH. */ - - } else if (tstarc != *arch) { - *bff = 0; - setmsg_("A request to load the # file, $, has been made by the % sys" - "tem. This operation is not permitted.", (ftnlen)97); - errch_("#", strarc + (((i__1 = tstarc - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("strarc", i__1, "zzddhppf_", (ftnlen)588)) << 3), ( - ftnlen)1, (ftnlen)8); - errfnm_("$", unit, (ftnlen)1); - errch_("%", strarc + (((i__1 = *arch - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("strarc", i__1, "zzddhppf_", (ftnlen)590)) << 3), ( - ftnlen)1, (ftnlen)8); - sigerr_("SPICE(FILARCHMISMATCH)", (ftnlen)22); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* Now check for possible FTP transfer errors. */ - - zzftpchk_(chrrec + 499, &ftperr, (ftnlen)501); - if (ftperr) { - *bff = 0; - setmsg_("FTP transfer error detected. This binary $, '#', has most " - "likely been corrupted by an ASCII mode FTP transfer. Obtain " - "the file using IMAGE or BINARY transfer mode from the source." - , (ftnlen)180); - errch_("$", strarc + (((i__1 = tstarc - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("strarc", i__1, "zzddhppf_", (ftnlen)611)) << 3), ( - ftnlen)1, (ftnlen)8); - errfnm_("#", unit, (ftnlen)1); - sigerr_("SPICE(FTPXFERERROR)", (ftnlen)19); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* Now this search is redundant, but the presence of the */ -/* FTPLFT string in the latter half of the file record */ -/* is fairly conclusive evidence that this is a "new" binary, */ -/* and we can expect to locate the binary file format */ -/* identification string. */ - - ftppos = pos_(chrrec + 499, ftplft, &c__1, (ftnlen)501, (ftnlen)6); - -/* Check to see if we found FTPLFT. If so extract the binary */ -/* file format ID word from the file record. */ - - if (ftppos != 0) { - -/* Extract BFFIDW from CHRREC. */ - - if (*arch == 1) { - s_copy(bffidw, chrrec + 88, (ftnlen)8, (ftnlen)8); - } else if (*arch == 2) { - s_copy(bffidw, chrrec + 84, (ftnlen)8, (ftnlen)8); - } - -/* See if we can find BFFIDW in the STRBFF list. */ - - *bff = isrchc_(bffidw, &c__5, strbff, (ftnlen)8, (ftnlen)8); - -/* Check to see if BFF is 0, if it is, signal an error since */ -/* this indicates an unrecognized BFF. */ - - if (*bff == 0) { - setmsg_("The file '#' utilizes the binary file format '#'. This" - " format is currently unknown to this toolkit. A toolkit" - " update may be in order.", (ftnlen)135); - errfnm_("#", unit, (ftnlen)1); - errch_("#", bffidw, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(UNKNOWNBFF)", (ftnlen)17); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* See if we have a NULLID situation, if not check out and */ -/* return as swe have identified the BFF. */ - - if (*bff != 5) { - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - } - -/* There is no FTP string, if the file is a DAS, we have to */ -/* assume it is of the native architecture. */ - - if (*arch == 2) { - zzplatfm_("FILE_FORMAT", bffidw, (ftnlen)11, (ftnlen)8); - ucase_(bffidw, bffidw, (ftnlen)8, (ftnlen)8); - *bff = isrchc_(bffidw, &c__4, strbff, (ftnlen)8, (ftnlen)8); - if (*bff == 0) { - setmsg_("The native architecture for this platform is unknown to" - " this version of the toolkit. This is a severe problem t" - "hat should never occur, please contact NAIF.", (ftnlen) - 155); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* If we reach this point, then we are either dealing with */ -/* an old DAF (created by a pre-N0050 toolkit) or one of the */ -/* DAFs created by the N0051 Sun Solaris Native C version of */ -/* the toolkit. This requires an examination of the bits */ -/* and bytes in the file that works this way: */ - -/* Since in a valid DAF, 2 <= NI <= 250, we can easily */ -/* determine whether the 4 bytes used to store NI in the */ -/* file record are little or big endian. If we discover */ -/* that the integer is encoded as big-endian, then stop */ -/* as this file must be 'BIG-IEEE'. If it is little */ -/* endian, then locate the first descriptor record */ -/* in the file. */ - -/* Read the first descriptor record. Extract NSUM, the */ -/* 3rd DP from the record. If it is 0.0D0, signal an error */ -/* as this is an empty DAF and we can not determine its */ -/* type. If it's non-zero, then check to see if the first */ -/* 4 bytes are "0s". If they are it must be 'LTL-IEEE'. */ -/* Otherwise pass it off to ZZDDHIVF to discriminate between */ -/* 'VAX-GFLT' and 'VAX-DFLT'. We know the first 4 bytes must */ -/* be "0s" in the 'LTL-IEEE" case, since NSUM is subject to */ -/* the following inequality: 1 <= NSUM <= 125 */ - -/* Having laid out the scheme, let's get to it. First take a */ -/* look at the four character bytes that hold NI. These bytes */ -/* be one of the following: */ - -/* Little Endian: VAL, 0, 0, 0 */ -/* Big Endian: 0, 0, 0, VAL */ - -/* where VAL is some non-zero value. */ - - if (*(unsigned char *)&chrrec[12] == *(unsigned char *)null && *(unsigned - char *)&chrrec[13] == *(unsigned char *)null && *(unsigned char *) - &chrrec[14] == *(unsigned char *)null && *(unsigned char *)& - chrrec[15] != *(unsigned char *)null) { - *bff = 1; - } else if (*(unsigned char *)&chrrec[12] != *(unsigned char *)null && *( - unsigned char *)&chrrec[13] == *(unsigned char *)null && *( - unsigned char *)&chrrec[14] == *(unsigned char *)null && *( - unsigned char *)&chrrec[15] == *(unsigned char *)null) { - -/* At this point we know we are dealing with a little endian */ -/* file. Locate the first descriptor record. */ - - *(unsigned char *)&ch__1[0] = *(unsigned char *)&chrrec[76]; - fdrec = *(unsigned char *)&ch__1[0]; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&chrrec[77]; - fdrec = (*(unsigned char *)&ch__1[0] << 4) + fdrec; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&chrrec[78]; - fdrec = (*(unsigned char *)&ch__1[0] << 8) + fdrec; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&chrrec[79]; - fdrec = (*(unsigned char *)&ch__1[0] << 12) + fdrec; - -/* Read the record into CHRREC. */ - - io___20.ciunit = *unit; - io___20.cirec = fdrec; - iostat = s_rdue(&io___20); - if (iostat != 0) { - goto L100002; - } - iostat = do_uio(&c__1, chrrec, (ftnlen)1000); - if (iostat != 0) { - goto L100002; - } - iostat = e_rdue(); -L100002: - -/* Check for read failure. */ - - if (iostat != 0) { - *bff = 0; - setmsg_("Error reading a descriptor record from the binary DAF f" - "ile '#'. IOSTAT = #.", (ftnlen)76); - errfnm_("#", unit, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - -/* Now examine the NSUM DP in this record to determine the */ -/* architecture. */ - - if (*(unsigned char *)&chrrec[16] == *(unsigned char *)null && *( - unsigned char *)&chrrec[17] == *(unsigned char *)null && *( - unsigned char *)&chrrec[18] == *(unsigned char *)null && *( - unsigned char *)&chrrec[19] == *(unsigned char *)null && *( - unsigned char *)&chrrec[20] == *(unsigned char *)null && *( - unsigned char *)&chrrec[21] == *(unsigned char *)null && *( - unsigned char *)&chrrec[22] == *(unsigned char *)null && *( - unsigned char *)&chrrec[23] == *(unsigned char *)null) { - -/* In this case we have an empty DAF, and can not distinguish */ -/* between little endian formats. Signal an error and return. */ - - *bff = 0; - setmsg_("The DAF, '#', appears to contain no data. As such, its" - " binary file format can not be determined which prevents" - " it from being loaded.", (ftnlen)133); - errfnm_("#", unit, (ftnlen)1); - sigerr_("SPICE(UNKNOWNBFF)", (ftnlen)17); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } else if (*(unsigned char *)&chrrec[16] == *(unsigned char *)null && - *(unsigned char *)&chrrec[17] == *(unsigned char *)null && *( - unsigned char *)&chrrec[18] == *(unsigned char *)null && *( - unsigned char *)&chrrec[19] == *(unsigned char *)null) { - -/* In this case the file is little endian IEEE. Set BFF. */ - - *bff = 2; - } else { - -/* We are probably looking at a VAX file. Find out which */ -/* format. */ - - zzddhivf_(chrrec + 16, bff, &found, (ftnlen)8); - if (! found) { - *bff = 0; - setmsg_("Unable to determine the binary file format of DAF '" - "#'.", (ftnlen)54); - errfnm_("#", unit, (ftnlen)1); - sigerr_("SPICE(UNKNOWNBFF)", (ftnlen)17); - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; - } - } - } else { - *bff = 0; - } - chkout_("ZZDDHPPF", (ftnlen)8); - return 0; -} /* zzddhppf_ */ - diff --git a/ext/spice/src/cspice/zzddhrcm.c b/ext/spice/src/cspice/zzddhrcm.c deleted file mode 100644 index 806371a8ff..0000000000 --- a/ext/spice/src/cspice/zzddhrcm.c +++ /dev/null @@ -1,169 +0,0 @@ -/* zzddhrcm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZDDHRCM ( Private --- DDH Request Count ) */ -/* Subroutine */ int zzddhrcm_(integer *nut, integer *utcst, integer *reqcnt) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Local variables */ - integer i__; - extern integer intmax_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Manage augmentation of the handle to logical unit request counter */ -/* and the cost column in the unit table. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NUT I Number of entries in the unit table. */ -/* UTCST I/O Cost column of the unit table. */ -/* REQCNT I/O Value of the HLU request counter. */ - -/* $ Detailed_Input */ - -/* NUT is the number of entries in the unit table. */ - -/* UTCST is the current cost column of the unit table. */ - -/* REQCNT is the current value of the HLU request counter to */ -/* adjust. */ - -/* $ Detailed_Output */ - -/* UTCST is the updated cost column of the unit table. In */ -/* the nominal case, UTCST will not be adjusted, but */ -/* if REQCNT overflows, then adjustments will be made */ -/* to approximately preserve the priority. */ - -/* REQCNT is the updated value of the request counter. */ -/* Nominally this will be 1 more than the input */ -/* value. However, in the case where REQCNT will */ -/* exceed INTMAX it will be assigned to INTMAX()/2 + 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If REQCNT on input is INTMAX(), then REQCNT on output will */ -/* be assigned INTMAX()/2 + 1 and the UTCST column will be */ -/* recomputed. */ - -/* $ Particulars */ - -/* This module manages the request counter and the cost column of */ -/* the unit table which is used to determine the expense of */ -/* disconnecting a handle from its logical unit. */ - -/* In the nominal mode of operation, the request counter is simply */ -/* incremented by one and the cost column remains untouched. */ -/* However, when the request counter passed into the routine is */ -/* INTMAX, then REQCNT is not incremented. In an attempt to preserve */ -/* the relationships between costs, all entries in the cost column */ -/* are halved and REQCNT is set to INTMAX()/2 + 1. This has the */ -/* effect of preserving the cost relationships between rows, except */ -/* in half the cases where subsequent cost values are present. */ - -/* The occurrence of rollover is rare, and thus the destruction of */ -/* relative cost relationships as well. */ - -/* $ Examples */ - -/* See ZZDDHHLU for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 04-OCT-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Check to see if REQCNT is INTMAX, otherwise just increment */ -/* REQCNT. */ - - if (*reqcnt == intmax_()) { - *reqcnt = intmax_() / 2 + 1; - i__1 = *nut; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing MAX */ - i__2 = 1, i__3 = utcst[i__ - 1] / 2; - utcst[i__ - 1] = max(i__2,i__3); - } - } else { - ++(*reqcnt); - } - return 0; -} /* zzddhrcm_ */ - diff --git a/ext/spice/src/cspice/zzddhrmu.c b/ext/spice/src/cspice/zzddhrmu.c deleted file mode 100644 index 27e0eac9b5..0000000000 --- a/ext/spice/src/cspice/zzddhrmu.c +++ /dev/null @@ -1,478 +0,0 @@ -/* zzddhrmu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZDDHRMU ( Private --- DDH Remove Unit ) */ -/* Subroutine */ int zzddhrmu_(integer *uindex, integer *nft, integer *utcst, - integer *uthan, logical *utlck, integer *utlun, integer *nut) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen), reslun_(integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Remove an entry from the unit table. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UINDEX I Row index to remove from the unit table. */ -/* NFT I Number of entries in the file table. */ -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN I/O Unit table. */ -/* NUT I/O Number of entries in the unit table. */ - -/* $ Detailed_Input */ - -/* HANDLE is the index of the row in the unit table for the */ -/* unit to remove. */ - -/* NFT is the number of entries in the file table after */ -/* the file whose unit is about to be disconnected */ -/* has been removed. */ - -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN, are the cost, handle, locked, and logical unit columns */ -/* of the unit table respectively. */ - -/* NUT is the number of entries in the unit table. */ - -/* $ Detailed_Output */ - -/* UTCST, */ -/* UTHAN, */ -/* UTLCK, */ -/* UTLUN, are the cost, handle, locked, and logical unit columns */ -/* of the unit table respectively. The contents will */ -/* change, for specifics see the Particulars section */ -/* below. */ - -/* NUT is the number of entries in the unit table. Depending */ -/* on the state of the file table, this may or may not */ -/* change. See the $Particulars section below for */ -/* details. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) SPICE(INDEXOUTOFRANGE) is signaled when the input UINDEX is */ -/* either greater than NUT or less than 1. */ - -/* 2) If NUT is 0 on input, then this module simply returns. */ - -/* $ Particulars */ - -/* This routine only manipulates the contents of the unit table. */ -/* It is utilized to delete an entry in the unit table that is */ -/* the result of a file 'unload' or close operation. */ - -/* If the number of files listed in the file table exceeds the */ -/* number of entries in the unit table, then this module will */ -/* reserve the logical unit listed in the row to remove, zero */ -/* out the cost and return. In this event, NUT will remain */ -/* unchanged. */ - -/* However, if there are less files in the file table than the */ -/* number of entries in the unit table, then this routine removes */ -/* the row and compresses the unit table, as one would expect. */ - -/* The file attached to UNIT is not closed by this routine, the */ -/* closure should occur before invoking this module. */ - -/* $ Examples */ - -/* See ZZDDHHLU for sample usage. */ - -/* $ Restrictions */ - -/* 1) This routine operates when an error condition introduced */ -/* by a prior call to SIGERR exists. It calls no routines */ -/* that return on entry when proper inputs are provided. */ -/* Any updates to this routine must preserve this behavior. */ - -/* 2) The file attached to the unit that is to be removed should */ -/* already have been removed from the file table. This is */ -/* necessary so the value of NFT reflects the number of files */ -/* available after the removal. */ - -/* 3) The logical unit in UTLUN(UINDEX) must be closed or buffered */ -/* externally prior to calling this routine. Knowledge of its */ -/* value could be lost otherwise. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-NOV-2001 (FST) */ - - -/* -& */ - -/* Local Variables */ - - -/* First check to see if NUT is 0. If so, just return, as there */ -/* are no rows to remove. */ - - if (*nut == 0) { - return 0; - } - -/* Check to see if we found the UINDEX in the unit table. */ -/* If not, use discovery check-in, signal an error and return. */ - - if (*uindex > *nut || *uindex < 1) { - chkin_("ZZDDHRMU", (ftnlen)8); - setmsg_("Attempt to remove row # from the unit table failed because " - "valid row indices range from 1 to NUT.", (ftnlen)97); - errint_("#", uindex, (ftnlen)1); - errint_("#", nut, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("ZZDDHRMU", (ftnlen)8); - return 0; - } - -/* We have found the row we need to remove from the table. */ -/* Check to see whether we are to remove this row or simply */ -/* mark it as zero cost and reserve the unit. We know this */ -/* is the case when NFT is greater than or equal to NUT. */ - - if (*nft >= *nut) { - -/* Zero the cost, clear the handle, and unlock the unit. */ - - utcst[*uindex - 1] = 0; - uthan[*uindex - 1] = 0; - utlck[*uindex - 1] = FALSE_; - -/* Reserve the unit for the handle manager's usage and */ -/* return. */ - - reslun_(&utlun[*uindex - 1]); - return 0; - } - -/* If we reach here, then we have to remove the row from the */ -/* unit table and compress. */ - - i__1 = *nut; - for (i__ = *uindex + 1; i__ <= i__1; ++i__) { - utcst[i__ - 2] = utcst[i__ - 1]; - uthan[i__ - 2] = uthan[i__ - 1]; - utlck[i__ - 2] = utlck[i__ - 1]; - utlun[i__ - 2] = utlun[i__ - 1]; - } - -/* Decrement NUT. */ - - --(*nut); - return 0; -} /* zzddhrmu_ */ - diff --git a/ext/spice/src/cspice/zzdynbid.c b/ext/spice/src/cspice/zzdynbid.c deleted file mode 100644 index 4fea8a76ae..0000000000 --- a/ext/spice/src/cspice/zzdynbid.c +++ /dev/null @@ -1,952 +0,0 @@ -/* zzdynbid.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNBID ( Fetch body ID kernel variable ) */ -/* Subroutine */ int zzdynbid_(char *frname, integer *frcode, char *item, - integer *idcode, ftnlen frname_len, ftnlen item_len) -{ - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen); - extern logical failed_(void); - char bodnam[36]; - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gcpool_(char *, integer *, integer *, integer *, char - *, logical *, ftnlen, ftnlen), gipool_(char *, integer *, integer - *, integer *, integer *, logical *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up a frame definition kernel variable whose associated value */ -/* is a body name or body ID code. The returned value is always an */ -/* ID code. The frame name or frame ID may be used as part of the */ -/* variable's name. */ - -/* If the kernel variable is not present, or if the variable */ -/* is not a body name or a numeric value, signal an error. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* IDCODE O Body ID code. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a numeric variable */ -/* of that name first. */ - -/* The value associated with the kernel variable */ -/* must be one of */ - -/* - a nbody ID code */ - -/* - a string representation of an integer, */ -/* for example '5' */ - -/* - a body frame name */ - -/* $ Detailed_Output */ - -/* IDCODE is the requested body ID code. */ - -/* The kernel variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has numeric type, the associated */ -/* value will be returned. If this variable is */ -/* found and has character type, the value will */ -/* be converted to a body ID code, and that */ -/* code will be returned. */ - -/* If this variable is not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If this variable is found and */ -/* has numeric type, the associated value will be */ -/* returned. If this variable is found and has */ -/* character type, the value will be converted to a */ -/* body ID code, and that code will be returned. */ - -/* If a numeric value associated with the selected */ -/* kernel variable is not integral, it will be */ -/* rounded to the closest integer. */ - -/* $ Parameters */ - -/* See zzdyn.inc for definition of KVNMLN. */ - -/* $ Exceptions */ - -/* 1) If neither the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name matches a kernel variable */ -/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */ -/* will be signaled. */ - -/* 2) If either the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name has length greater than KVNMLN, */ -/* that variable will not be searched for. */ - -/* 3) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than 1 */ -/* associated value, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* 5) If a name match is found for a character kernel variable, but */ -/* the value associated with the variable cannot be mapped to a */ -/* body ID code, the error SPICE(NOTRANSLATION) will be */ -/* signaled. */ - -/* 6) If a name match is found for a numeric kernel variable, */ -/* but that variable has a value that cannot be rounded to an */ -/* integer representable on the host platform, an error will */ -/* be signaled by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. Part of the */ -/* functionality of this routine consists of handling error */ -/* conditions such as the unavailability of required kernel */ -/* variables; hence no "found" flag is returned to the caller. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* access routines, these names are distinct. Hence kernel */ -/* variables having names of both forms, but having possibly */ -/* different attributes, can be simultaneously present in the kernel */ -/* pool. Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* 1) See ZZDYNFRM. */ - -/* 2) Applications of this routine include finding ID codes of */ -/* observer or target bodies serving to define two-vector dynamic */ -/* frames. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) An array-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially */ -/* mask a scalar-valued kernel variable matching the "name */ -/* form" of the requested name. This problem can be prevented */ -/* by sensible frame kernel design. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */ - -/* References to parameterized dynamic frames in long error */ -/* messages were changed to references to "reference frames." */ -/* This change was made to enable this utility to support */ -/* kernel variable look-ups for non-dynamic frames. */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */ - -/* References to parameterized dynamic frames in long error */ -/* messages were changed to references to "reference frames." */ -/* This change was made to enable this utility to support */ -/* kernel variable look-ups for non-dynamic frames. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNBID", (ftnlen)8); - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - found = FALSE_; - } - if (! found) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - -/* Note that at this point KVNAME contains the ID-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the reference frame #. Usually this type of problem" - " is due to a missing keyword assignment in a frame kerne" - "l. Another, less likely, possibility is that other erro" - "rs in a frame kernel have confused the frame subsystem i" - "nto wrongly deciding these variables are needed.", ( - ftnlen)551); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1); - if (! found && reqnum > 32) { - -/* The kernel variable's presence (in one form or the other) */ -/* is mandatory: signal an error. The error message */ -/* depends on which variables we were able to try to */ -/* look up. In this case, we never tried to look up the */ -/* frame ID-based name. */ - -/* Note that at this point KVNAME contains the name-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the reference frame #. Usually this type of problem" - " is due to a missing keyword assignment in a frame kerne" - "l. Another, less likely, possibility is that other erro" - "rs in a frame kernel have confused the frame subsystem i" - "nto wrongly deciding these variables are needed.", ( - ftnlen)551); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } else if (! found) { - -/* We tried to look up both names and failed. */ - - setmsg_("At least one of the kernel variables FRAME_#_# or FRAME" - "_#_# was expected to be present in the kernel pool but n" - "either was found. One of these variables is needed to de" - "fine the reference frame #. Usually this type of proble" - "m is due to a missing keyword assignment in a frame kern" - "el. Another, less likely, possibility is that other err" - "ors in a frame kernel have confused the frame subsystem " - "into wrongly deciding these variables are needed.", ( - ftnlen)440); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - - if (*(unsigned char *)dtype == 'C') { - -/* Rather than using BADKPV, we check the cardinality of the */ -/* kernel variable in-line so we can create a more detailed error */ -/* message if need be. */ - - if (n > 1) { - setmsg_("The kernel variable # has used to define frame # was ex" - "pected to have size not exceeding 1 but in fact has size" - " #. Usually this type of problem is due to an error in a" - " frame definition provided in a frame kernel.", (ftnlen) - 212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gcpool_(kvname, &c__1, &c__1, &n, bodnam, &found, (ftnlen)32, (ftnlen) - 36); - if (! found) { - setmsg_("Variable # not found after DTPOOL indicated it was pres" - "ent in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - -/* Convert the body name to a body code. */ - - bods2c_(bodnam, idcode, &found, (ftnlen)36); - if (! found) { - setmsg_("Body name # could not be translated to an ID code.", ( - ftnlen)50); - errch_("#", bodnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - } else { - -/* The variable has numeric type. */ - - if (n > 1) { - setmsg_("The kernel variable # has used to define frame # was ex" - "pected to have size not exceeding 1 but in fact has size" - " #. Usually this type of problem is due to an error in a" - " frame definition provided in a frame kernel.", (ftnlen) - 212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gipool_(kvname, &c__1, &c__1, &n, idcode, &found, (ftnlen)32); - if (! found) { - setmsg_("Variable # not found after DTPOOL indicated it was pres" - "ent in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNBID", (ftnlen)8); - return 0; - } - } - chkout_("ZZDYNBID", (ftnlen)8); - return 0; -} /* zzdynbid_ */ - diff --git a/ext/spice/src/cspice/zzdynfid.c b/ext/spice/src/cspice/zzdynfid.c deleted file mode 100644 index f53cd72ba2..0000000000 --- a/ext/spice/src/cspice/zzdynfid.c +++ /dev/null @@ -1,911 +0,0 @@ -/* zzdynfid.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNFID ( Fetch frame ID kernel variable ) */ -/* Subroutine */ int zzdynfid_(char *frname, integer *frcode, char *item, - integer *idcode, ftnlen frname_len, ftnlen item_len) -{ - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical beint_(char *, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - char outnam[32]; - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gcpool_(char *, integer *, integer *, integer *, char - *, logical *, ftnlen, ftnlen), namfrm_(char *, integer *, ftnlen), - prsint_(char *, integer *, ftnlen), gipool_(char *, integer *, - integer *, integer *, integer *, logical *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up a frame definition kernel variable whose associated */ -/* value is a frame name or frame ID code. The returned value is */ -/* always an ID code. The kernel variable name can refer to */ -/* the frame being defined by either name or ID code. */ - -/* If the kernel variable is not present, or if the variable */ -/* is not a frame name or a numeric value, signal an error. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* IDCODE O Output kernel variable. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. This frame */ -/* may be thought of as the frame associated with */ -/* "left hand side" of the kernel variable */ -/* assignment. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. This */ -/* is the ID code corresponding to FRNAME. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a numeric variable */ -/* of that name first. */ - -/* The value associated with the kernel variable */ -/* must be one of */ - -/* - a reference frame ID code */ - -/* - a string representation of an integer, */ -/* for example '5' */ - -/* - a reference frame name */ - -/* $ Detailed_Output */ - -/* IDCODE is the frame ID code associated with the value of */ -/* the requested kernel variable. This frame may be */ -/* regarded as being associated with the "right hand */ -/* side." of the kernel variable assignment. The */ -/* kernel variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has numeric type, the associated */ -/* value will be returned. If this variable is */ -/* found and has character type, the value will */ -/* be converted to a frame ID code, and that */ -/* code will be returned. */ - -/* If this variable is not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If this variable is found and */ -/* has numeric type, the associated value will be */ -/* returned. If this variable is found and has */ -/* character type, the value will be converted to a */ -/* frame ID code, and that code will be returned. */ - -/* If a numeric value associated with the selected */ -/* kernel variable is not integral, it will be */ -/* rounded to the closest integer. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - - -/* 1) If neither the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name matches a kernel variable */ -/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */ -/* will be signaled. */ - -/* 2) If either the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name has length greater than KVNMLN, */ -/* the excessively long name will not be searched for. A search */ -/* will still be done using the alternative form of the name if */ -/* that form has length less than or equal to KVNMLN. */ - -/* 3) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than one */ -/* associated value, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* 5) If a name match is found for a character kernel variable, but */ -/* the value associated with the variable cannot be mapped to a */ -/* frame ID code or an integer, the error SPICE(NOTRANSLATION) */ -/* is signaled. */ - -/* 6) If a name match is found for a numeric kernel variable, */ -/* but that variable has a value that cannot be rounded to an */ -/* integer representable on the host platform, an error will */ -/* be signaled by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. Part of the */ -/* functionality of this routine consists of handling error */ -/* conditions such as the unavailability of required kernel */ -/* variables; hence no "found" flag is returned to the caller. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* data structure, these names are distinct. Hence kernel variables */ -/* having names of both forms, but having possibly different */ -/* attributes, can be simultaneously present in the kernel pool. */ -/* Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* 1) See ZZDYNFRM. */ - -/* 2) Applications of this routine include finding ID codes of */ -/* frames associated with velocity vectors or constant vectors */ -/* serving to define two-vector dynamic frames. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) An array-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially */ -/* mask a scalar-valued kernel variable matching the "name */ -/* form" of the requested name. This problem can be prevented */ -/* by sensible frame kernel design. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNFID", (ftnlen)8); - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - found = FALSE_; - } - if (! found) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - -/* Note that at this point KVNAME contains the ID-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to a missing keyword assignment in a" - " frame kernel. Another, less likely, possibility is tha" - "t other errors in a frame kernel have confused the frame" - " subsystem into wrongly deciding these variables are nee" - "ded.", (ftnlen)563); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1); - if (! found && reqnum > 32) { - -/* The kernel variable's presence (in one form or the other) */ -/* is mandatory: signal an error. The error message */ -/* depends on which variables we were able to try to */ -/* look up. In this case, we never tried to look up the */ -/* frame ID-based name. */ - -/* Note that at this point KVNAME contains the name-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to a missing keyword assignment in a" - " frame kernel. Another, less likely, possibility is tha" - "t other errors in a frame kernel have confused the frame" - " subsystem into wrongly deciding these variables are nee" - "ded.", (ftnlen)563); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } else if (! found) { - -/* We tried to look up both names and failed. */ - - setmsg_("At least one of the kernel variables FRAME_#_# or FRAME" - "_#_# was expected to be present in the kernel pool but n" - "either was found. One of these variables is needed to de" - "fine the parameterized dynamic frame #. Usually this ty" - "pe of problem is due to a missing keyword assignment in " - "a frame kernel. Another, less likely, possibility is th" - "at other errors in a frame kernel have confused the fram" - "e subsystem into wrongly deciding these variables are ne" - "eded.", (ftnlen)452); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - - if (*(unsigned char *)dtype == 'C') { - -/* Rather than using BADKPV, we check the cardinality of the */ -/* kernel variable in-line so we can create a more detailed error */ -/* message if need be. */ - - if (n > 1) { - setmsg_("The kernel variable # has used to define frame # was ex" - "pected to have size not exceeding 1 but in fact has size" - " #. Usually this type of problem is due to an error in a" - " frame definition provided in a frame kernel.", (ftnlen) - 212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gcpool_(kvname, &c__1, &c__1, &n, outnam, &found, (ftnlen)32, (ftnlen) - 32); - if (! found) { - setmsg_("The kernel variable # has used to define frame # was no" - "t found after DTPOOL indicated it was present in pool.", ( - ftnlen)109); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - -/* Convert the output frame name to a frame code. */ - - namfrm_(outnam, idcode, (ftnlen)32); - if (*idcode == 0) { - -/* If IDCODE is zero, that means NAMFRM couldn't translate */ -/* the name. Perhaps the name is an integer? */ - - if (beint_(outnam, (ftnlen)32)) { - prsint_(outnam, idcode, (ftnlen)32); - } else { - -/* We're outta aces. */ - - setmsg_("The kernel variable # used to define frame # is ass" - "igned the character value #. This value was expecte" - "d to be a reference frame name, but NAMFRM cannot tr" - "anslate this name to a frame ID code.", (ftnlen)192); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", outnam, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - } - -/* IDCODE has been assigned a value at this point. */ - - } else { - -/* The variable has numeric type. */ - - if (n > 1) { - setmsg_("The kernel variable # has used to define frame # was ex" - "pected to have size not exceeding 1 but in fact has size" - " #. Usually this type of problem is due to an error in a" - " frame definition provided in a frame kernel.", (ftnlen) - 212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gipool_(kvname, &c__1, &c__1, &n, idcode, &found, (ftnlen)32); - if (! found) { - setmsg_("The kernel variable # has used to define frame # was no" - "t found after DTPOOL indicated it was present in pool.", ( - ftnlen)109); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNFID", (ftnlen)8); - return 0; - } - } - chkout_("ZZDYNFID", (ftnlen)8); - return 0; -} /* zzdynfid_ */ - diff --git a/ext/spice/src/cspice/zzdynfr0.c b/ext/spice/src/cspice/zzdynfr0.c deleted file mode 100644 index 48ec2ad6aa..0000000000 --- a/ext/spice/src/cspice/zzdynfr0.c +++ /dev/null @@ -1,2631 +0,0 @@ -/* zzdynfr0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__36 = 36; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__6 = 6; -static integer c__3 = 3; -static integer c__12 = 12; -static doublereal c_b386 = 1.; -static integer c__20 = 20; - -/* $Procedure ZZDYNFR0 ( Dynamic state transformation evaluation ) */ -/* Subroutine */ int zzdynfr0_(integer *infram, integer *center, doublereal * - et, doublereal *xform, integer *basfrm) -{ - /* Initialized data */ - - static char axes[1*3] = "X" "Y" "Z"; - static logical first = TRUE_; - static char itmcof[32*3] = "ANGLE_1_COEFFS " "ANGLE_2_C" - "OEFFS " "ANGLE_3_COEFFS "; - static char itmsep[32] = "ANGLE_SEP_TOL "; - static char vname[4*2] = "PRI_" "SEC_"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double sin(doublereal); - - /* Local variables */ - doublereal xf2000[36] /* was [6][6] */, dmob; - integer degs[3]; - extern /* Subroutine */ int zzfrmch1_(integer *, integer *, doublereal *, - doublereal *); - integer frid; - char spec[80]; - integer targ; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - integer axis[2]; - extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *, - doublereal *, ftnlen), mxmg_(doublereal *, doublereal *, integer * - , integer *, integer *, doublereal *); - doublereal vflt; - extern doublereal vsep_(doublereal *, doublereal *); - doublereal xipm[36] /* was [6][6] */; - extern /* Subroutine */ int zzspkez1_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vequ_(doublereal *, doublereal *), mxvg_(doublereal *, doublereal - *, integer *, integer *, doublereal *); - doublereal poly[2]; - extern /* Subroutine */ int zzspkzp1_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen); - doublereal xout[36] /* was [6][6] */; - extern /* Subroutine */ int zzdynbid_(char *, integer *, char *, integer * - , ftnlen, ftnlen), zzdynfid_(char *, integer *, char *, integer *, - ftnlen, ftnlen), zzdynoad_(char *, integer *, char *, integer *, - integer *, doublereal *, logical *, ftnlen, ftnlen), zzdynoac_( - char *, integer *, char *, integer *, integer *, char *, logical * - , ftnlen, ftnlen, ftnlen), zzcorepc_(char *, doublereal *, - doublereal *, doublereal *, ftnlen), zzmobliq_(doublereal *, - doublereal *, doublereal *), zzdynvac_(char *, integer *, char *, - integer *, integer *, char *, ftnlen, ftnlen, ftnlen), zzdynvad_( - char *, integer *, char *, integer *, integer *, doublereal *, - ftnlen, ftnlen), zzdynvai_(char *, integer *, char *, integer *, - integer *, integer *, ftnlen, ftnlen); - integer i__, j; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer n, frcid; - doublereal radii[3], delta; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen); - doublereal epoch; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - zztwovxf_(doublereal *, integer *, doublereal *, integer *, - doublereal *); - static integer earth; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - vpack_(doublereal *, doublereal *, doublereal *, doublereal *); - integer frcls; - doublereal oblxf[36] /* was [6][6] */; - integer iaxes[3]; - static char itmra[32*2]; - integer cvobs, frctr; - logical inert; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - errdp_(char *, doublereal *, ftnlen), vsubg_(doublereal *, - doublereal *, integer *, doublereal *); - doublereal stalt[2], stemp[6], stobs[6]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal xfinv[36] /* was [6][6] */; - char units[80]; - doublereal nutxf[36] /* was [6][6] */, s2[12] /* was [6][2] - */, t0; - extern /* Subroutine */ int bodn2c_(char *, integer *, logical *, ftnlen), - bodc2n_(integer *, char *, logical *, ftnlen), eul2xf_( - doublereal *, integer *, integer *, integer *, doublereal *); - doublereal ra; - extern logical failed_(void); - logical meanec; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - char vecdef[80*2]; - static char itmabc[32*2]; - char basnam[32]; - doublereal lt; - logical negate; - static char itmdec[32*2]; - doublereal coeffs[60] /* was [20][3] */; - char inname__[32], abcorr[5], axname[80]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - char cfrmnm[32], ctrnam[36], cvcorr[5], dynstl[80], dynfam[80]; - static char itmaxe[32*2], itmfrm[32*2], itmlat[32*2], itmlon[32*2], - itmobs[32*2], itmspc[32*2], itmtrg[32*2], itmunt[32*2], itmvdf[32* - 2], itmvec[32*2]; - char nutmod[80], oblmod[80], prcmod[80], rotsta[80], timstr[50], tmpfam[ - 80], velfrm[32]; - doublereal acc[3], angles[2], ctrpos[3], dec, dirvec[3], eulang[6], fet, - lat, minsep, mob, precxf[36] /* was [6][6] */, stnear[6], - tarray[3], varray[9] /* was [3][3] */, sep, lon, xftemp[36] - /* was [6][6] */; - integer cfrmid; - static integer j2000; - integer obs; - doublereal vet; - logical corblk[15], fnd, frozen, meaneq, ofdate, trueeq; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), frmnam_( - integer *, char *, ftnlen), chkout_(char *, ftnlen), cmprss_(char - *, integer *, char *, char *, ftnlen, ftnlen, ftnlen), setmsg_( - char *, ftnlen), sigerr_(char *, ftnlen), intstr_(integer *, char - *, ftnlen), invstm_(doublereal *, doublereal *), errint_(char *, - integer *, ftnlen), qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *), frinfo_(integer *, integer *, - integer *, integer *, logical *), cidfrm_(integer *, integer *, - char *, logical *, ftnlen), bodvcd_(integer *, char *, integer *, - integer *, doublereal *, ftnlen), vminug_(doublereal *, integer *, - doublereal *), dnearp_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *), convrt_( - doublereal *, char *, char *, doublereal *, ftnlen, ftnlen), - latrec_(doublereal *, doublereal *, doublereal *, doublereal *), - stlabx_(doublereal *, doublereal *, doublereal *), stelab_( - doublereal *, doublereal *, doublereal *), polyds_(doublereal *, - integer *, integer *, doublereal *, doublereal *), zzeprc76_( - doublereal *, doublereal *), zzenut80_(doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* For a specified dynamic frame, find the transformation */ -/* that maps states from the dynamic frame to its base frame. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* PCK */ -/* SPK */ - -/* $ Keywords */ - -/* FRAMES */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRAM I Frame ID code for a SPICE dynamic reference frame. */ -/* CENTER I ID code for the center of the input frame. */ -/* ET I An epoch in seconds past J2000 TDB. */ -/* XFORM O The requested state transformation matrix. */ -/* BASFRM O Frame ID of base frame associated with INFRAM. */ - -/* $ Detailed_Input */ - -/* INFRAM is the frame ID code for a dynamic reference frame. */ -/* Note that this interface differs from that of TKFRAM, */ -/* which uses a class ID to identify the frame. */ - -/* In this routine, we refer this frame both as the */ -/* "input frame" and the "defined frame." */ - -/* CENTER is NAIF ID code for the center of the frame */ -/* designated by INFRAM. This code, although derivable */ -/* from INFRAM, is passed in for convenience. */ - -/* ET is an epoch in ephemeris seconds past J2000 for which */ -/* the caller requests a state transformation matrix. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6x6 matrix that transforms states relative to */ -/* INFRAM to states relative to BASFRM. */ - -/* BASFRM is the frame ID code of the base frame associated */ -/* with INFRAM. The 6x6 matrix XFORM transforms states */ -/* relative to INFRAM to states relative to BASFRM. The */ -/* state transformation is performed by left-multiplying */ -/* by XFORM a state expressed relative to INFRAM. This */ -/* is easily accomplished via the subroutine call shown */ -/* below. */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, OSTATE ) */ - -/* $ Parameters */ - -/* See include file zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If a dynamic frame evaluation requires unavailable kernel */ -/* data, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 2) If a precession model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 3) If a nutation model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 4) If an obliquity model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 5) If an unrecognized precession model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 6) If an unrecognized nutation model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 7) If an unrecognized obliquity model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 8) If an attempt to look up the center of a frame does */ -/* not yield data, the error SPICE(FRAMEDATANOTFOUND) is */ -/* signaled. */ - -/* 9) In a two-vector frame definition, if a constant vector */ -/* specification method is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 10) In a two-vector frame definition, if a vector definition */ -/* method is not recognized, the error SPICE(NOTSUPPORTED) */ -/* is signaled. */ - -/* 11) If an unrecognized dynamic frame family is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 12) If an unrecognized dynamic frame definition style is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 13) If an unrecognized dynamic frame rotation state is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 14) If both a freeze epoch and a rotation state are specified, */ -/* the error SPICE(FRAMEDEFERROR) is signaled. */ - -/* 15) If neither a freeze epoch nor a rotation state are specified */ -/* for an "of date" frame, the error SPICE(FRAMEDEFERROR) is */ -/* signaled. */ - -/* 16) In a two-vector frame definition, if an invalid axis */ -/* specification is encountered, the error SPICE(INVALIDAXIS) is */ -/* signaled. */ - -/* 17) In a two-vector frame definition using a target near point */ -/* vector, if the body-fixed frame associated with the target */ -/* is not found, the error SPICE(FRAMEDATANOTFOUND) is signaled. */ - -/* 18) If the state of the near point on a target as seen from */ -/* an observer cannot be computed, the error */ -/* SPICE(DEGENERATECASE) is signaled. */ - -/* 19) If a dynamic frame evaluation requires excessive recursion */ -/* depth, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 20) When a two-vector dynamic frame is evaluated, if the */ -/* primary and secondary vectors have angular separation less */ -/* than the minimum allowed value, or if the angular separation */ -/* differs from Pi by less than the minimum allowed value, the */ -/* error SPICE(DEGENERATECASE) is signaled. The default minimum */ -/* separation is given by the parameter LBSEP; this value may be */ -/* overridden by supplying a different value in the frame */ -/* definition. */ - -/* 21) If invalid units occur in a frame definition, the error */ -/* will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 22) If an invalid Euler axis sequence occurs in a frame */ -/* definition, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* 1) SPK files containing data for each observer and target */ -/* are required to support two-vector frames. Note that */ -/* observer-target pairs can be implicit, as in the case */ -/* of a constant vector whose frame is evaluated at a */ -/* light-time corrected epoch: the light time the frame */ -/* center to an observer must be computable in this case, */ -/* which implies the state of the frame center as seen by */ -/* the observer must be computable. */ - -/* 2) Any of SPK, CK, PCK, and frame kernels will also be required */ -/* if any frames referenced in the definition of INFRAM (as a */ -/* base frame, velocity vector frame, or constant vector frame) */ -/* require them, or if any vectors used to define INFRAM require */ -/* these data in order to be computable. */ - -/* 3) When CK data are required, one or more associated SCLK kernels */ -/* ---normally, one kernel per spacecraft clock---are */ -/* required as well. A leapseconds kernel may be required */ -/* whenever an SCLK kernel is required. */ - -/* 4) When a two-vector frame is defined using a target near point, */ -/* a PCK file giving orientation and providing a triaxial shape */ -/* model for the target body is required. */ - -/* $ Particulars */ - -/* Currently only parameterized dynamic frames are supported by */ -/* this routine. */ - -/* Currently supported parameterized dynamic families are: */ - -/* Two-vector */ -/* ========== */ - -/* Vector definitions */ -/* ------------------ */ -/* Observer-target position */ -/* Observer-target velocity */ -/* Near point on target */ -/* Constant vector in specified frame */ - - -/* Mean Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ - - -/* Mean Ecliptic and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU mean obliquity model */ - - -/* True Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU nutation model */ - - -/* Euler frames */ -/* ============ */ - -/* Euler angle definitions */ -/* ----------------------- */ -/* Polynomial */ - - -/* $ Examples */ - -/* See FRMGET. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) Many numerical problems can occur when dynamic frames */ -/* are evaluated. Users must determine whether dynamic frame */ -/* definitions are suitable for their applications. See the */ -/* Exceptions section for a list of possible problems. */ - -/* 3) Use of aberration corrections may lead to severe loss of */ -/* accuracy in state transformation derivatives. */ - -/* 4) Two-vector frame definitions can suffer extreme loss of */ -/* precision due to near-singular geometry. */ - -/* 5) Two-vector frame definitions involving velocity vectors */ -/* require numerical differentiation in order to compute the */ -/* derivative of the state transformation. Such derivatives may */ -/* have low accuracy. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 02-MAR-2010 (NJB) */ - -/* Typo in Brief_I/O section was corrected: "Class ID" */ -/* was changed to "Frame ID." Corrected order of header */ -/* sections. */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ were renamed to KVX, KVY, KVZ. */ - -/* Call to ZZBODVCD was replaced with call to BODVCD. */ - -/* - SPICELIB Version 1.0.0, 10-JAN-2005 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNFR0", (ftnlen)8); - if (first) { - -/* Get the ID code for the J2000 frame. */ - - irfnum_("J2000", &j2000, (ftnlen)5); - -/* Get the ID code for the earth (we needn't check the found */ -/* flag). */ - - bodn2c_("EARTH", &earth, &fnd, (ftnlen)5); - -/* Initialize "item" strings used to create kernel variable */ -/* names. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Vector axis: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 520)) << 2); - i__3[1] = 4, a__1[1] = "AXIS"; - s_cat(itmaxe + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmaxe", i__1, "zzdynfr0_", (ftnlen)520)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector definition: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 524)) << 2); - i__3[1] = 10, a__1[1] = "VECTOR_DEF"; - s_cat(itmvdf + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvdf", i__1, "zzdynfr0_", (ftnlen)524)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector aberration correction: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 528)) << 2); - i__3[1] = 6, a__1[1] = "ABCORR"; - s_cat(itmabc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmabc", i__1, "zzdynfr0_", (ftnlen)528)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector frame: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 532)) << 2); - i__3[1] = 5, a__1[1] = "FRAME"; - s_cat(itmfrm + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmfrm", i__1, "zzdynfr0_", (ftnlen)532)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector observer: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 536)) << 2); - i__3[1] = 8, a__1[1] = "OBSERVER"; - s_cat(itmobs + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynfr0_", (ftnlen)536)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector target: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 540)) << 2); - i__3[1] = 6, a__1[1] = "TARGET"; - s_cat(itmtrg + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmtrg", i__1, "zzdynfr0_", (ftnlen)540)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector longitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 544)) << 2); - i__3[1] = 9, a__1[1] = "LONGITUDE"; - s_cat(itmlon + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlon", i__1, "zzdynfr0_", (ftnlen)544)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector latitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 548)) << 2); - i__3[1] = 8, a__1[1] = "LATITUDE"; - s_cat(itmlat + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlat", i__1, "zzdynfr0_", (ftnlen)548)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector right ascension: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 552)) << 2); - i__3[1] = 2, a__1[1] = "RA"; - s_cat(itmra + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynfr0_", (ftnlen)552)) << 5), a__1, - i__3, &c__2, (ftnlen)32); - -/* Vector declination: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 556)) << 2); - i__3[1] = 3, a__1[1] = "DEC"; - s_cat(itmdec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmdec", i__1, "zzdynfr0_", (ftnlen)556)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector units: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 560)) << 2); - i__3[1] = 5, a__1[1] = "UNITS"; - s_cat(itmunt + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmunt", i__1, "zzdynfr0_", (ftnlen)560)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector coordinate specification: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 564)) << 2); - i__3[1] = 4, a__1[1] = "SPEC"; - s_cat(itmspc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmspc", i__1, "zzdynfr0_", (ftnlen)564)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector in cartesian coordinates, literal value: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfr0_", (ftnlen) - 568)) << 2); - i__3[1] = 6, a__1[1] = "VECTOR"; - s_cat(itmvec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvec", i__1, "zzdynfr0_", (ftnlen)568)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - } - first = FALSE_; - } - -/* Initialize the output arguments. */ - - cleard_(&c__36, xform); - *basfrm = 0; - -/* Initialize certain variables to ensure that we don't do */ -/* arithmetic operations using bogus, possibly large, */ -/* undefined values. */ - - cleard_(&c__36, nutxf); - cleard_(&c__36, oblxf); - cleard_(&c__36, precxf); - cleard_(&c__36, xf2000); - cleard_(&c__36, xfinv); - cleard_(&c__36, xipm); - mob = 0.; - dmob = 0.; - t0 = 0.; - frozen = FALSE_; - -/* Get the input frame name. */ - - frmnam_(infram, inname__, (ftnlen)32); - -/* We need the name of the base frame. */ - - zzdynfid_(inname__, infram, "RELATIVE", basfrm, (ftnlen)32, (ftnlen)8); - frmnam_(basfrm, basnam, (ftnlen)32); - -/* The output frame code and name are set. */ - -/* Look up the dynamic frame definition style from the kernel pool. */ -/* The kernel variable's name might be specified by name or ID. */ - - zzdynvac_(inname__, infram, "DEF_STYLE", &c__1, &n, dynstl, (ftnlen)32, ( - ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* At this time, the only supported dynamic frame definition style is */ -/* PARAMETERIZED. */ - - if (eqstr_(dynstl, "PARAMETERIZED", (ftnlen)80, (ftnlen)13)) { - -/* Parameterized dynamic frames belong to families. Look up */ -/* the family for this frame. */ - - zzdynvac_(inname__, infram, "FAMILY", &c__1, &n, dynfam, (ftnlen)32, ( - ftnlen)6, (ftnlen)80); - cmprss_(" ", &c__0, dynfam, tmpfam, (ftnlen)1, (ftnlen)80, (ftnlen)80) - ; - ucase_(tmpfam, dynfam, (ftnlen)80, (ftnlen)80); - -/* Determine whether we have an "of-date" frame family. */ -/* The logical flags used here and respective meanings are: */ - -/* MEANEQ Mean equator and equinox of date */ -/* TRUEEQ True equator and equinox of date */ -/* MEANEC Mean ecliptic and equinox of date */ - - meaneq = s_cmp(dynfam, "MEAN_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - trueeq = s_cmp(dynfam, "TRUE_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - meanec = s_cmp(dynfam, "MEAN_ECLIPTIC_AND_EQUINOX_OF_DATE", (ftnlen) - 80, (ftnlen)33) == 0; - ofdate = meaneq || meanec || trueeq; - -/* Set the evaluation epoch T0. Normally this epoch is ET, */ -/* but if the frame is frozen, the freeze epoch from the */ -/* frame definition is used. */ - -/* Read the freeze epoch into T0 if a freeze epoch was */ -/* specified; let FROZEN receive the FOUND flag value */ -/* returned by ZZDYNOAD. */ - - zzdynoad_(inname__, infram, "FREEZE_EPOCH", &c__1, &n, &t0, &frozen, ( - ftnlen)32, (ftnlen)12); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - if (! frozen) { - -/* Normal case: just use the input epoch. */ - - t0 = *et; - } - -/* Look up the rotation state keyword. Rather than checking */ -/* FAILED() after every call, we'll do it after we're */ -/* done with processing the rotation state. */ - - zzdynoac_(inname__, infram, "ROTATION_STATE", &c__1, &n, rotsta, &fnd, - (ftnlen)32, (ftnlen)14, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* If the frame is frozen, the rotation state keyword *must be */ -/* absent*. */ - - if (frozen && fnd) { - setmsg_("Definition of frame # contains both # and # keywords; a" - "t most one of these must be present in the frame definit" - "ion. This situation is usually caused by an error in a f" - "rame kernel in which the frame is defined.", (ftnlen)209); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* If the frame belongs to an "of date" family, either the */ -/* rotation state must be specified or the frame must be */ -/* frozen. */ - - if (ofdate && ! frozen && ! fnd) { - setmsg_("Definition of frame #, which belongs to parameterized d" - "ynamic frame family #, contains neither # nor # keywords" - "; frames in this family require exactly one of these in " - "their frame definitions. This situation is usually cause" - "d by an error in a frame kernel in which the frame is de" - "fined.", (ftnlen)285); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Set the rotation state logical flag indicating whether */ -/* the state is 'INERTIAL'. */ - - if (fnd) { - -/* A rotation state keyword was found. */ - -/* We know the state is not frozen if we arrive here. */ - - inert = eqstr_(rotsta, "INERTIAL", (ftnlen)80, (ftnlen)8); - if (! inert) { - -/* Catch invalid rotation states here. */ - - if (! eqstr_(rotsta, "ROTATING", (ftnlen)80, (ftnlen)8)) { - setmsg_("Definition of frame # contains # specification " - "#. The only valid rotation states are # or #. Th" - "is situation is usually caused by an error in a " - "frame kernel in which the frame is defined.", ( - ftnlen)186); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - errch_("#", rotsta, (ftnlen)1, (ftnlen)80); - errch_("#", "ROTATING", (ftnlen)1, (ftnlen)8); - errch_("#", "INERTIAL", (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - } - } else { - -/* The state is not inertial unless there's a ROTATION_STATE */ -/* keyword assignment telling us it is. */ - - inert = FALSE_; - } - -/* INERT and FROZEN are both set. The evaluation epoch T0 is also */ -/* set. */ - -/* The following code block performs actions specific to */ -/* the various dynamic frame families. */ - - if (ofdate) { - -/* Fetch the name of the true equator and equinox of date */ -/* precession model. */ - - zzdynvac_(inname__, infram, "PREC_MODEL", &c__1, &n, prcmod, ( - ftnlen)32, (ftnlen)10, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Get the precession transformation. */ - - if (eqstr_(prcmod, "EARTH_IAU_1976", (ftnlen)80, (ftnlen)14)) { - -/* This is the 1976 IAU earth precession model. */ - -/* Make sure the center of the input frame is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame center # " - "and precession model #. This precession model is" - " not applicable to body #. This situation is usu" - "ally caused by an error in a frame kernel in whi" - "ch the frame is defined.", (ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1976", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Look up the precession transformation. */ - - zzeprc76_(&t0, precxf); - -/* If we're in the mean-of-date case, invert this */ -/* transformation to obtain the mapping from the */ -/* mean-of-date frame to J2000. */ - - if (meaneq) { - invstm_(precxf, xftemp); - } - } else { - setmsg_("Definition of frame # specifies precession model #," - " which is not recognized. This situation is usually " - "caused by an error in a frame kernel in which the fr" - "ame is defined.", (ftnlen)170); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", prcmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* At this point the precession transformation PRECXF is set. */ -/* If INFRAM is a mean equator and equinox of date frame, the */ -/* inverse of PRECXF is currently stored in XFTEMP. */ - if (trueeq) { - -/* We need a nutation transformation as well. Get the name */ -/* of the nutation model. */ - - zzdynvac_(inname__, infram, "NUT_MODEL", &c__1, &n, nutmod, ( - ftnlen)32, (ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Get the nutation transformation. */ - - if (eqstr_(nutmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth nutation model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and nutation model #. This nutation mode" - "l is not applicable to body #. This situati" - "on is usually caused by an error in a frame " - "kernel in which the frame is defined.", ( - ftnlen)212); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Look up the nutation transformation. */ - - zzenut80_(&t0, nutxf); - -/* Find the transformation from the J2000 frame to the */ -/* earth true of date frame. Invert. */ - - mxmg_(nutxf, precxf, &c__6, &c__6, &c__6, xfinv); - invstm_(xfinv, xftemp); - } else { - setmsg_("Definition of frame # specifies nutation model " - "#, which is not recognized. This situation is us" - "ually caused by an error in a frame kernel in wh" - "ich the frame is defined.", (ftnlen)168); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", nutmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - } else if (meanec) { - -/* We need a mean obliquity transformation as well. */ -/* Get the name of the obliquity model. */ - - zzdynvac_(inname__, infram, "OBLIQ_MODEL", &c__1, &n, oblmod, - (ftnlen)32, (ftnlen)11, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Get the obliquity transformation. */ - - if (eqstr_(oblmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth mean obliquity of */ -/* date model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and obliquity model #. This obliquity m" - "odel is not applicable to body #. This situa" - "tion is usually caused by an error in a fram" - "e kernel in which the frame is defined.", ( - ftnlen)214); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Create the obliquity transformation. First look up */ -/* the obliquity state (angle and angular rate). */ - - zzmobliq_(&t0, &mob, &dmob); - -/* The obliquity rotation is about the mean-of-date */ -/* x-axis. The other Euler angles are identically */ -/* zero; the axes are arbitrary, as long as the */ -/* middle axis is distinct from the other two. */ - - cleard_(&c__6, eulang); - eulang[2] = mob; - eulang[5] = dmob; - eul2xf_(eulang, &c__1, &c__3, &c__1, oblxf); - -/* Find the transformation from the J2000 to the */ -/* earth mean ecliptic of date frame. Invert. */ - - mxmg_(oblxf, precxf, &c__6, &c__6, &c__6, xfinv); - invstm_(xfinv, xftemp); - } else { - setmsg_("Definition of frame # specifies obliquity model" - " #, which is not recognized. This situation is u" - "sually caused by an error in a frame kernel in w" - "hich the frame is defined.", (ftnlen)169); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", oblmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - } - -/* At this point, XFTEMP contains the mapping from the */ -/* specified mean of date or true of date frame to J2000. */ - -/* If the base frame is not J2000, we must find the */ -/* transformation from J2000 to the base frame. */ - - if (*basfrm != j2000) { - zzfrmch1_(&j2000, basfrm, &t0, xf2000); - mxmg_(xf2000, xftemp, &c__6, &c__6, &c__6, xform); - } else { - -/* Otherwise, XFTEMP is the matrix we want. */ - - moved_(xftemp, &c__36, xform); - } - -/* Now XFORM is the state transformation mapping from */ -/* the input frame INFRAM to the base frame BASFRM. */ - -/* This is the end of the work specific to "of-date" frames. */ -/* From here we drop out of the IF block. At the end of this */ -/* routine, the derivative block of XFORM will be zeroed out */ -/* if the frame is frozen. If the rotation state is */ -/* 'INERTIAL', we will make sure the transformation between */ -/* the defined frame and the J2000 frame has time derivative */ -/* zero. */ - - } else if (s_cmp(dynfam, "TWO-VECTOR", (ftnlen)80, (ftnlen)10) == 0) { - -/* The frame belongs to the TWO-VECTOR family. */ - -/* Initialize the array S2. */ - - cleard_(&c__12, s2); - -/* Fetch the specifications of the primary and secondary */ -/* axes. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Get the name of the axis associated with the Ith */ -/* defining vector. */ - - zzdynvac_(inname__, infram, itmaxe + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmaxe", i__1, "zzdynfr0_" - , (ftnlen)1087)) << 5), &c__1, &n, axname, (ftnlen)32, - (ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(axname, axname, (ftnlen)80, (ftnlen)80); - -/* Set the sign flag associated with the axis. */ - - negate = *(unsigned char *)axname == '-'; - cmprss_("-", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - cmprss_("+", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("axis", - i__1, "zzdynfr0_", (ftnlen)1100)] = isrchc_(axname, & - c__3, axes, (ftnlen)80, (ftnlen)1); - if (axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "axis", i__1, "zzdynfr0_", (ftnlen)1103)] == 0) { - setmsg_("Definition of frame # associates vector # with " - "axis #. The only valid axis values are { X, -X," - " Y, -Y, Z, -Z }. This situation is usually cause" - "d by an error in a frame kernel in which the fra" - "me is defined.", (ftnlen)205); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &i__, (ftnlen)1); - errch_("#", axname, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDAXIS)", (ftnlen)18); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Find out how the vector is defined: */ - -/* - Observer-target position vector */ -/* - Observer-target velocity vector */ -/* - Observer-target near point vector */ -/* - Constant vector */ - -/* VECDEF(I) indicates the vector definition method */ -/* for the Ith vector. */ - - zzdynvac_(inname__, infram, itmvdf + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmvdf", i__1, "zzdynfr0_" - , (ftnlen)1132)) << 5), &c__1, &n, vecdef + ((i__2 = - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("vecdef", - i__2, "zzdynfr0_", (ftnlen)1132)) * 80, (ftnlen)32, ( - ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, vecdef + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("vecdef", i__1, "zzdynfr0_", ( - ftnlen)1135)) * 80, vecdef + ((i__2 = i__ - 1) < 2 && - 0 <= i__2 ? i__2 : s_rnge("vecdef", i__2, "zzdynfr0_", - (ftnlen)1135)) * 80, (ftnlen)1, (ftnlen)80, (ftnlen) - 80); - ucase_(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynfr0_", (ftnlen)1136)) * - 80, vecdef + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("vecdef", i__2, "zzdynfr0_", (ftnlen) - 1136)) * 80, (ftnlen)80, (ftnlen)80); - if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynfr0_", (ftnlen)1139)) * - 80, "OBSERVER_TARGET_POSITION", (ftnlen)80, (ftnlen) - 24) == 0) { - -/* The vector is the position of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynfr0_", (ftnlen)1146)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynfr0_", (ftnlen)1148)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfr0_", (ftnlen)1150)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* Look up the Ith state vector in the J2000 frame. */ - - zzspkez1_(&targ, &t0, "J2000", abcorr, &obs, &s2[(i__1 = - i__ * 6 - 6) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "s2", i__1, "zzdynfr0_", (ftnlen)1156)], <, ( - ftnlen)5, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* At this point, S2(*,I) contains position and */ -/* velocity relative to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfr0_", (ftnlen) - 1169)) * 80, "OBSERVER_TARGET_VELOCITY", (ftnlen)80, ( - ftnlen)24) == 0) { - -/* The vector is the velocity of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynfr0_", (ftnlen)1176)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynfr0_", (ftnlen)1178)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfr0_", (ftnlen)1180)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* We need to know the frame in which the velocity is */ -/* defined. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynfr0_", (ftnlen)1187)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - frmnam_(&frid, velfrm, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Obtain the velocity vector in the specified velocity */ -/* frame. Also obtain bracketing vectors to support */ -/* discrete differentiation. (See notes in zzdyn.inc */ -/* regarding definition of DELTA.) */ - -/* Computing MAX */ - d__1 = 1., d__2 = t0 * 7.4505805969238281e-9; - delta = max(d__1,d__2); - d__1 = t0 - delta; - d__2 = t0 + delta; - vpack_(&d__1, &t0, &d__2, tarray); - for (j = 1; j <= 3; ++j) { - zzspkez1_(&targ, &tarray[(i__1 = j - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("tarray", i__1, "zzdynf" - "r0_", (ftnlen)1208)], velfrm, abcorr, &obs, - stemp, <, (ftnlen)32, (ftnlen)5); - -/* We compute the derivative using unit */ -/* velocity vectors. */ - - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - vhat_(&stemp[3], &varray[(i__1 = j * 3 - 3) < 9 && 0 - <= i__1 ? i__1 : s_rnge("varray", i__1, "zzd" - "ynfr0_", (ftnlen)1219)]); - } - -/* Compute acceleration and fill in the velocity state */ -/* vector S2(*,I). */ - - qderiv_(&c__3, varray, &varray[6], &delta, acc); - vequ_(&varray[3], &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfr0_", ( - ftnlen)1230)]); - vequ_(acc, &s2[(i__1 = i__ * 6 - 3) < 12 && 0 <= i__1 ? - i__1 : s_rnge("s2", i__1, "zzdynfr0_", (ftnlen) - 1231)]); - -/* We need the epoch VET at which VELFRM is evaluated. */ -/* This epoch will be used to transform the velocity's */ -/* "state" vector from VELFRM to J2000. */ - -/* Set the default value of VET here. */ - - vet = t0; - -/* Parse the aberration correction. Find the epoch used */ -/* to evaluate the velocity vector's frame. */ - - zzprscor_(abcorr, corblk, (ftnlen)5); - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the velocity vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the velocity frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame ass" - "ociated with a velocity vector has frame" - " ID code #, but no frame center, frame c" - "lass, or frame class ID was found by FRI" - "NFO. This situation MAY be caused by an" - " error in a frame kernel in which the fr" - "ame is defined. The problem also could b" - "e indicative of a SPICELIB bug.", (ftnlen) - 310); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* If the velocity frame is non-inertial, we'll need */ -/* to compute the evaluation epoch for this frame. */ - - if (frcls != 1) { - -/* Obtain light time from the observer to the */ -/* frame's center; find the evaluation epoch VET */ -/* for the frame. */ - zzspkzp1_(&frctr, &t0, "J2000", abcorr, &obs, - ctrpos, &vflt, (ftnlen)5, (ftnlen)5); - zzcorepc_(abcorr, &t0, &vflt, &vet, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - } - } - -/* The velocity frame's evaluation epoch VET is now set. */ - -/* We must rotate the velocity vector and transform the */ -/* acceleration from the velocity frame (evaluated at */ -/* VET) to the output frame at T0. We'll do this in two */ -/* stages, first mapping velocity and acceleration into */ -/* the J2000 frame. */ - - if (frid != j2000) { - zzfrmch1_(&frid, &j2000, &vet, xf2000); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - mxvg_(xf2000, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfr0_", - (ftnlen)1322)], &c__6, &c__6, stemp); - moved_(stemp, &c__6, &s2[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("s2", i__1, "zzdyn" - "fr0_", (ftnlen)1323)]); - } - -/* At this point, S2(*,I) contains velocity and */ -/* acceleration relative to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfr0_", (ftnlen) - 1333)) * 80, "TARGET_NEAR_POINT", (ftnlen)80, (ftnlen) - 17) == 0) { - -/* The vector points from an observer to the */ -/* sub-observer point (nearest point to the observer) on */ -/* the target body. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynfr0_", (ftnlen)1341)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynfr0_", (ftnlen)1343)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfr0_", (ftnlen)1345)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* The vector points from the observer to the nearest */ -/* point on the target. We need the state of the near */ -/* point relative to the observer. */ - -/* We'll look up the state of the target center relative */ -/* to the observer and the state of the near point */ -/* relative to the target center, both in the body-fixed */ -/* frame associated with the target. */ - -/* Look up the body-fixed frame associated with the */ -/* target body. */ - - cidfrm_(&targ, &cfrmid, cfrmnm, &fnd, (ftnlen)32); - if (! fnd) { - setmsg_("Definition of frame # requires definition o" - "f body-fixed frame associated with target bo" - "dy #. A call to CIDFRM indicated no body-fix" - "ed frame is associated with the target body." - " This situation can arise when a frame kern" - "el defining the target's body-fixed frame l" - "acks the OBJECT__FRAME or OBJECT__" - "FRAME keywords. The problem also could be c" - "aused by an error in a frame kernel in which" - " the parameterized two-vector dynamic frame " - "# is defined.", (ftnlen)452); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &targ, (ftnlen)1); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Get the radii of the target body. */ - - bodvcd_(&targ, "RADII", &c__3, &n, radii, (ftnlen)5); - -/* Look up the Ith state vector in the target-fixed */ -/* frame. Negate the vector to obtain the target-to- */ -/* observer vector. */ - - zzspkez1_(&targ, &t0, cfrmnm, abcorr, &obs, stemp, <, ( - ftnlen)32, (ftnlen)5); - -/* We check FAILED() here because VMINUG is a simple */ -/* arithmetic routine that doesn't return on entry. */ - - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - vminug_(stemp, &c__6, stobs); - dnearp_(stobs, radii, &radii[1], &radii[2], stnear, stalt, - &fnd); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - if (! fnd) { - setmsg_("In definition of frame #, vector # is defin" - "ed by the near point on body # as seen from " - "body #. The state of this near point was no" - "t found. See the routine DNEARP for an expla" - "nation. This situation MAY be caused by an " - "error in a frame kernel in which the frame i" - "s defined. The problem also could be indicat" - "ive of a SPICELIB bug.", (ftnlen)329); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &i__, (ftnlen)1); - errint_("#", &targ, (ftnlen)1); - errint_("#", &obs, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Find the observer-near point state in the target */ -/* body-fixed frame. */ - - vsubg_(stnear, stobs, &c__6, stemp); - -/* Transform the state to frame J2000. To get the */ -/* required transformation matrix, we'll need to obtain */ -/* the epoch associated with CNMFRM. Parse the */ -/* aberration correction and adjust the frame evaluation */ -/* epoch as needed. */ - - zzcorepc_(abcorr, &t0, <, &fet, (ftnlen)5); - -/* Obtain the matrix for transforming state vectors */ -/* from the target center frame to the J2000 frame and */ -/* apply it to the observer-to-near point state vector. */ - - zzfrmch1_(&cfrmid, &j2000, &fet, xipm); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - mxvg_(xipm, stemp, &c__6, &c__6, &s2[(i__1 = i__ * 6 - 6) - < 12 && 0 <= i__1 ? i__1 : s_rnge("s2", i__1, - "zzdynfr0_", (ftnlen)1476)]); - -/* At this point, S2(*,I) contains position and */ -/* velocity of the near point on the target as */ -/* seen by the observer, relative to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfr0_", (ftnlen) - 1484)) * 80, "CONSTANT", (ftnlen)80, (ftnlen)8) == 0) - { - -/* The vector is constant in a specified frame. */ - - -/* We need a 3-vector and an associated reference */ -/* frame relative to which the vector is specified. */ - -/* Look up the ID of the frame first. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynfr0_", (ftnlen)1494)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - -/* Let FET ("frame ET") be the evaluation epoch for */ -/* the constant vector's frame. By default, this */ -/* frame is just T0, but if we're using light time */ -/* corrections, FET must be adjusted for one-way */ -/* light time between the frame's center and the */ -/* observer. */ - -/* Set the default value of FET here. */ - - fet = t0; - -/* Optionally, there is an aberration correction */ -/* associated with the constant vector's frame. */ -/* If so, an observer must be associated with the */ -/* frame. Look up the correction first. */ - - zzdynoac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfr0_", (ftnlen)1514)) << 5), &c__1, &n, - cvcorr, &fnd, (ftnlen)32, (ftnlen)32, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - if (! fnd) { - s_copy(cvcorr, "NONE", (ftnlen)5, (ftnlen)4); - } - zzprscor_(cvcorr, corblk, (ftnlen)5); - if (! corblk[0]) { - -/* We need to apply an aberration correction to */ -/* the constant vector. */ - -/* Check for errors in the aberration correction */ -/* specification. */ - -/* - Light time and stellar aberration corrections */ -/* are mutually exclusive. */ - - if (corblk[1] && corblk[2]) { - setmsg_("Definition of frame # specifies aberrat" - "ion correction # for constant vector. L" - "ight time and stellar aberration correct" - "ions are mutually exclusive for constant" - " vectors used in two-vector parameterize" - "d dynamic frame definitions. This situa" - "tion is usually caused by an error in a " - "frame kernel in which the frame is defin" - "ed.", (ftnlen)322); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", cvcorr, (ftnlen)1, (ftnlen)5); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the constant vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the constant vector frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame" - " associated with a constant vector h" - "as frame ID code #, but no frame cen" - "ter, frame class, or frame class ID " - "was found by FRINFO. This situation" - " MAY be caused by an error in a fram" - "e kernel in which the frame is defin" - "ed. The problem also could be indica" - "tive of a SPICELIB bug.", (ftnlen)310) - ; - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen) - 24); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* If the constant vector frame is non-inertial, */ -/* we'll need to compute the evaluation epoch for */ -/* this frame. */ - - if (frcls != 1) { - -/* Look up the observer associated with the */ -/* constant vector's frame. This observer, */ -/* together with the frame's center, determines */ -/* the evaluation epoch for the frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynfr0_", ( - ftnlen)1607)) << 5), &cvobs, (ftnlen) - 32, (ftnlen)32); - -/* Obtain light time from the observer to the */ -/* frame's center. */ - - zzspkzp1_(&frctr, &t0, "J2000", cvcorr, & - cvobs, ctrpos, <, (ftnlen)5, ( - ftnlen)5); - -/* Re-set the evaluation epoch for the frame. */ - - zzcorepc_(cvcorr, &t0, <, &fet, (ftnlen)5); - } - -/* The constant vector frame's evaluation epoch */ -/* FET has been set. */ - - } else if (corblk[2]) { - -/* Stellar aberration case. */ - -/* The constant vector must be corrected for */ -/* stellar aberration induced by the observer's */ -/* velocity relative to the solar system */ -/* barycenter. First, find this velocity in */ -/* the J2000 frame. We'll apply the correction */ -/* later, when the constant vector has been */ -/* transformed to the J2000 frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmobs", i__1, "zzdynfr0_", (ftnlen)1640) - ) << 5), &cvobs, (ftnlen)32, (ftnlen)32); - zzspksb1_(&cvobs, &t0, "J2000", stobs, (ftnlen)5); - } - } - -/* At this point FET is the frame evaluation epoch */ -/* for the frame associated with the constant vector. */ - -/* If stellar aberration correction has been specified, */ -/* STOBS is the state of the observer relative to the */ -/* solar system barycenter, expressed in the J2000 */ -/* frame. */ - -/* Get the constant vector specification. */ - - zzdynvac_(inname__, infram, itmspc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmspc", i__1, - "zzdynfr0_", (ftnlen)1660)) << 5), &c__1, &n, - spec, (ftnlen)32, (ftnlen)32, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - cmprss_(" ", &c__0, spec, spec, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(spec, spec, (ftnlen)80, (ftnlen)80); - if (s_cmp(spec, "RECTANGULAR", (ftnlen)80, (ftnlen)11) == - 0) { - -/* The coordinate system is rectangular. */ - -/* Look up the constant vector. */ - - zzdynvad_(inname__, infram, itmvec + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmvec", - i__1, "zzdynfr0_", (ftnlen)1678)) << 5), & - c__3, &n, dirvec, (ftnlen)32, (ftnlen)32); - } else if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen) - 11) == 0 || s_cmp(spec, "RA/DEC", (ftnlen)80, ( - ftnlen)6) == 0) { - -/* The coordinate system is latitudinal or RA/DEC. */ - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, itmunt + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmunt", - i__1, "zzdynfr0_", (ftnlen)1689)) << 5), & - c__1, &n, units, (ftnlen)32, (ftnlen)32, ( - ftnlen)80); - if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen)11) - == 0) { - -/* Look up longitude and latitude. */ - - zzdynvad_(inname__, infram, itmlon + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlon", i__1, "zzdynfr0_", (ftnlen)1697) - ) << 5), &c__1, &n, &lon, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmlat + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlat", i__1, "zzdynfr0_", (ftnlen)1700) - ) << 5), &c__1, &n, &lat, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&lon, units, "RADIANS", angles, (ftnlen) - 80, (ftnlen)7); - convrt_(&lat, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } else { - -/* Look up RA and DEC. */ - - zzdynvad_(inname__, infram, itmra + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynfr0_", (ftnlen)1713)) - << 5), &c__1, &n, &ra, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmdec + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmdec", i__1, "zzdynfr0_", (ftnlen)1716) - ) << 5), &c__1, &n, &dec, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&ra, units, "RADIANS", angles, (ftnlen)80, - (ftnlen)7); - convrt_(&dec, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Now produce a direction vector. */ - - latrec_(&c_b386, angles, &angles[1], dirvec); - } else { - setmsg_("Definition of two-vector parameterized dyna" - "mic frame # includes constant vector specifi" - "cation #, which is not supported. This situ" - "ation is usually caused by an error in a fra" - "me kernel in which the frame is defined.", ( - ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", spec, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* At this point, the cartesian coordinates of the */ -/* vector relative to the constant vector frame */ -/* are stored in DIRVEC. */ - -/* Convert the direction vector to the J2000 frame. */ -/* Fill in the state vector. The velocity in the */ -/* constant vector's frame is zero. */ - - vequ_(dirvec, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= i__1 ? - i__1 : s_rnge("s2", i__1, "zzdynfr0_", (ftnlen) - 1765)]); - cleard_(&c__3, &s2[(i__1 = i__ * 6 - 3) < 12 && 0 <= i__1 - ? i__1 : s_rnge("s2", i__1, "zzdynfr0_", (ftnlen) - 1766)]); - if (frid != j2000) { - zzfrmch1_(&frid, &j2000, &fet, xipm); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - mxvg_(xipm, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfr0_", - (ftnlen)1777)], &c__6, &c__6, stemp); - moved_(stemp, &c__6, &s2[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("s2", i__1, "zzdyn" - "fr0_", (ftnlen)1778)]); - } - -/* The state of the constant vector is now represented */ -/* in the J2000 frame, but we may still need to */ -/* apply a stellar aberration correction. */ - - if (corblk[2]) { - -/* Perform the stellar aberration correction */ -/* appropriate to the radiation travel sense. */ - if (corblk[4]) { - -/* The correction is for transmission. */ - - stlabx_(&s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynf" - "r0_", (ftnlen)1796)], &stobs[3], stemp); - } else { - -/* The correction is for reception. */ - - stelab_(&s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynf" - "r0_", (ftnlen)1802)], &stobs[3], stemp); - } - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Update the position portion of S2(*,I). */ - - vequ_(stemp, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfr0_", - (ftnlen)1814)]); - } - -/* At this point, S2(*,I) contains position and velocity */ -/* of the constant (constant relative to its associated */ -/* frame, that is) vector as seen by the observer, */ -/* relative to frame J2000. */ - - } else { - setmsg_("Definition of two-vector parameterized dynamic " - "frame # includes vector definition #, which is n" - "ot supported. This situation is usually caused " - "by an error in a frame kernel in which the frame" - " is defined.", (ftnlen)203); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfr0_", ( - ftnlen)1836)) * 80, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Negate the state vector if the axis has negative sign. */ - - if (negate) { - vminug_(&s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= i__1 ? i__1 - : s_rnge("s2", i__1, "zzdynfr0_", (ftnlen)1847)], - &c__6, stemp); - moved_(stemp, &c__6, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfr0_", ( - ftnlen)1848)]); - } - } - -/* Look up the lower bound for the angular separation of */ -/* the defining vectors. Use the default value if none */ -/* was supplied. */ - - zzdynoad_(inname__, infram, itmsep, &c__1, &n, &minsep, &fnd, ( - ftnlen)32, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - if (! fnd) { - minsep = .001; - } - -/* Now use our states to compute our state transformation */ -/* matrix. */ - -/* Check the angular separation of the defining vectors. We */ -/* want to ensure that the vectors are not too close to being */ -/* linearly dependent. We can handle both cases---separation */ -/* close to 0 or separation close to Pi---by comparing the */ -/* sine of the separation to the sine of the separation limit. */ - - sep = vsep_(s2, &s2[6]); - if (sin(sep) < sin(minsep)) { - etcal_(&t0, timstr, (ftnlen)50); - setmsg_("Angular separation of vectors defining two-vector p" - "arameterized dynamic frame # is # (radians); minimum" - " allowed difference of separation from 0 or Pi is # " - "radians. Evaluation epoch is #. Extreme loss of pr" - "ecision can occur when defining vectors are nearly l" - "inearly dependent. This type of error can be due to" - " using a dynamic frame outside of the time range for" - " which it is meant. It also can be due to a conceptu" - "al error pertaining to the frame's definition, or to" - " an implementation error in the frame kernel contain" - "ing the frame definition. However, if you wish to pr" - "oceed with this computation, the # keyword can be us" - "ed in the frame definition to adjust the separation " - "limit.", (ftnlen)681); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errdp_("#", &sep, (ftnlen)1); - errdp_("#", &minsep, (ftnlen)1); - errch_("#", timstr, (ftnlen)1, (ftnlen)50); - errch_("#", "ANGLE_SEP_TOL", (ftnlen)1, (ftnlen)13); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* We have both states expressed relative to frame J2000 */ -/* at this point. Find the transformation from INNAME to */ -/* the frame J2000, then from J2000 to frame BASNAM. */ - - zztwovxf_(s2, axis, &s2[6], &axis[1], xform); - if (*basfrm != j2000) { - moved_(xform, &c__36, xftemp); - zzfrmch1_(&j2000, basfrm, &t0, xf2000); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - mxmg_(xf2000, xftemp, &c__6, &c__6, &c__6, xform); - } - -/* This is the end of the work specific to two-vector frames. */ -/* From here we drop out of the IF block. At the end of this */ -/* routine, the derivative block of XFORM will be zeroed out */ -/* if the frame is frozen. If the rotation state is */ -/* 'INERTIAL', we will make sure the transformation between */ -/* the defined frame and the J2000 frame has time derivative */ -/* zero. */ - - } else if (s_cmp(dynfam, "EULER", (ftnlen)80, (ftnlen)5) == 0) { - -/* The frame belongs to the Euler family. */ - -/* We expect to specifications of an axis sequence, units, */ -/* and angles via polynomial coefficients. We also expect */ -/* to see an ET epoch. */ - -/* Look up the epoch first. Let DELTA represent the offset */ -/* of T0 relative to the epoch. */ - -/* Initialize EPOCH so subtraction doesn't overflow if EPOCH */ -/* is invalid due to a lookup error. */ - - epoch = 0.; - zzdynvad_(inname__, infram, "EPOCH", &c__1, &n, &epoch, (ftnlen) - 32, (ftnlen)5); - delta = t0 - epoch; - -/* Now the axis sequence. */ - - zzdynvai_(inname__, infram, "AXES", &c__3, &n, iaxes, (ftnlen)32, - (ftnlen)4); - -/* Now the coefficients for the angles. */ - - for (i__ = 1; i__ <= 3; ++i__) { - -/* Initialize N so subtraction doesn't overflow if N */ -/* is invalid due to a lookup error. */ - - n = 0; - zzdynvad_(inname__, infram, itmcof + (((i__1 = i__ - 1) < 3 && - 0 <= i__1 ? i__1 : s_rnge("itmcof", i__1, "zzdynfr0_" - , (ftnlen)1983)) << 5), &c__20, &n, &coeffs[(i__2 = - i__ * 20 - 20) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "coeffs", i__2, "zzdynfr0_", (ftnlen)1983)], (ftnlen) - 32, (ftnlen)32); - -/* Set the polynomial degree for the Ith angle. */ - - degs[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("degs", - i__1, "zzdynfr0_", (ftnlen)1989)] = n - 1; - } - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, "UNITS", &c__1, &n, units, (ftnlen)32, - (ftnlen)5, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* Evaluate the angles and their derivatives at DELTA. Convert */ -/* angles from input units to radians and radians/sec. */ - - for (i__ = 1; i__ <= 3; ++i__) { - polyds_(&coeffs[(i__1 = i__ * 20 - 20) < 60 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "zzdynfr0_", (ftnlen) - 2009)], °s[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("degs", i__2, "zzdynfr0_", (ftnlen)2009) - ], &c__1, &delta, poly); - -/* Convert units. Fill in the Euler angle state vector. */ - - convrt_(poly, units, "RADIANS", &eulang[(i__1 = i__ - 1) < 6 - && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzdynf" - "r0_", (ftnlen)2013)], (ftnlen)80, (ftnlen)7); - convrt_(&poly[1], units, "RADIANS", &eulang[(i__1 = i__ + 2) < - 6 && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzd" - "ynfr0_", (ftnlen)2014)], (ftnlen)80, (ftnlen)7); - } - -/* Produce a state transformation matrix that maps from */ -/* the defined frame to the base frame. */ - - eul2xf_(eulang, iaxes, &iaxes[1], &iaxes[2], xform); - -/* This is the end of the work specific to Euler frames. */ -/* From here we drop out of the IF block. At the end of this */ -/* routine, the derivative block of XFORM will be zeroed out */ -/* if the frame is frozen. If the rotation state is */ -/* 'INERTIAL', we will make sure the transformation between */ -/* the defined frame and the J2000 frame has time derivative */ -/* zero. */ - - } else { - setmsg_("Dynamic frame family # (in definition of frame #) is no" - "t supported. This situation is usually caused by an erro" - "r in a frame kernel in which the frame is defined.", ( - ftnlen)161); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* This is the end of the IF block that processes the */ -/* parameterized dynamic frame families. */ - - } else { - setmsg_("Dynamic frame style # (in definition of frame #) is not sup" - "ported. This situation is usually caused by an error in a fr" - "ame kernel in which the frame is defined.", (ftnlen)160); - errch_("#", dynstl, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - -/* At this point XFORM is the state transformation matrix mapping */ -/* from the input frame INFRAM to the base frame BASFRM. */ - -/* If the frame has rotation state 'INERTIAL', the frame must have */ -/* zero derivative with respect to any inertial frame. Set the */ -/* derivative block accordingly. */ - - if (inert) { - -/* See whether the base frame is inertial. */ - - irfnum_(basnam, &j, (ftnlen)32); - if (j > 0) { - -/* The base frame is a recognized inertial frame. Zero */ -/* out the derivative block. */ - - for (i__ = 1; i__ <= 3; ++i__) { - cleard_(&c__3, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzdynfr0_", (ftnlen) - 2093)]); - } - } else { - -/* The base frame is *not* a recognized inertial frame. */ - -/* Create the state transformation matrix that maps from the */ -/* defined frame to J2000. Zero out the derivative block of */ -/* this matrix. Convert the resulting matrix to the state */ -/* transformation from the defined frame to the output frame. */ - - zzfrmch1_(basfrm, &j2000, &t0, xf2000); - if (failed_()) { - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; - } - mxmg_(xf2000, xform, &c__6, &c__6, &c__6, xftemp); - for (i__ = 1; i__ <= 3; ++i__) { - cleard_(&c__3, &xftemp[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 - ? i__1 : s_rnge("xftemp", i__1, "zzdynfr0_", (ftnlen) - 2115)]); - } - -/* XFTEMP now represents the transformation from a */ -/* constant frame matching the defined frame at T0 to the */ -/* J2000 frame. Produce the transformation from this constant */ -/* frame to the output frame. */ - -/* To avoid introducing additional round-off error into */ -/* the rotation blocks of XFORM, we overwrite only the */ -/* derivative block of XFORM with the derivative block */ -/* of the "inertial" transformation. */ - - invstm_(xf2000, xfinv); - mxmg_(xfinv, xftemp, &c__6, &c__6, &c__6, xout); - for (i__ = 1; i__ <= 3; ++i__) { - vequ_(&xout[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xout", i__1, "zzdynfr0_", (ftnlen)2133)], & - xform[(i__2 = i__ * 6 - 3) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zzdynfr0_", (ftnlen)2133)]); - } - } - } - -/* If the frame is frozen, zero out the derivative block of the */ -/* transformation matrix. */ - - if (frozen) { - for (i__ = 1; i__ <= 3; ++i__) { - cleard_(&c__3, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzdynfr0_", (ftnlen)2147)]); - } - } - -/* XFORM and BASFRM are set. */ - - chkout_("ZZDYNFR0", (ftnlen)8); - return 0; -} /* zzdynfr0_ */ - diff --git a/ext/spice/src/cspice/zzdynfrm.c b/ext/spice/src/cspice/zzdynfrm.c deleted file mode 100644 index 9daa36c2e0..0000000000 --- a/ext/spice/src/cspice/zzdynfrm.c +++ /dev/null @@ -1,2631 +0,0 @@ -/* zzdynfrm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__36 = 36; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__6 = 6; -static integer c__3 = 3; -static integer c__12 = 12; -static doublereal c_b386 = 1.; -static integer c__20 = 20; - -/* $Procedure ZZDYNFRM ( Dynamic state transformation evaluation ) */ -/* Subroutine */ int zzdynfrm_(integer *infram, integer *center, doublereal * - et, doublereal *xform, integer *basfrm) -{ - /* Initialized data */ - - static char axes[1*3] = "X" "Y" "Z"; - static logical first = TRUE_; - static char itmcof[32*3] = "ANGLE_1_COEFFS " "ANGLE_2_C" - "OEFFS " "ANGLE_3_COEFFS "; - static char itmsep[32] = "ANGLE_SEP_TOL "; - static char vname[4*2] = "PRI_" "SEC_"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double sin(doublereal); - - /* Local variables */ - doublereal xf2000[36] /* was [6][6] */, dmob; - integer degs[3]; - extern /* Subroutine */ int zzfrmch0_(integer *, integer *, doublereal *, - doublereal *); - integer frid; - char spec[80]; - integer targ; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - integer axis[2]; - extern /* Subroutine */ int zzspksb0_(integer *, doublereal *, char *, - doublereal *, ftnlen), mxmg_(doublereal *, doublereal *, integer * - , integer *, integer *, doublereal *); - doublereal vflt; - extern doublereal vsep_(doublereal *, doublereal *); - doublereal xipm[36] /* was [6][6] */; - extern /* Subroutine */ int zzspkez0_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vequ_(doublereal *, doublereal *), mxvg_(doublereal *, doublereal - *, integer *, integer *, doublereal *); - doublereal poly[2]; - extern /* Subroutine */ int zzspkzp0_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen); - doublereal xout[36] /* was [6][6] */; - extern /* Subroutine */ int zzdynbid_(char *, integer *, char *, integer * - , ftnlen, ftnlen), zzdynfid_(char *, integer *, char *, integer *, - ftnlen, ftnlen), zzdynoad_(char *, integer *, char *, integer *, - integer *, doublereal *, logical *, ftnlen, ftnlen), zzdynoac_( - char *, integer *, char *, integer *, integer *, char *, logical * - , ftnlen, ftnlen, ftnlen), zzcorepc_(char *, doublereal *, - doublereal *, doublereal *, ftnlen), zzmobliq_(doublereal *, - doublereal *, doublereal *), zzdynvac_(char *, integer *, char *, - integer *, integer *, char *, ftnlen, ftnlen, ftnlen), zzdynvad_( - char *, integer *, char *, integer *, integer *, doublereal *, - ftnlen, ftnlen), zzdynvai_(char *, integer *, char *, integer *, - integer *, integer *, ftnlen, ftnlen); - integer i__, j; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer n, frcid; - doublereal radii[3], delta; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen); - doublereal epoch; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - zztwovxf_(doublereal *, integer *, doublereal *, integer *, - doublereal *); - static integer earth; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - vpack_(doublereal *, doublereal *, doublereal *, doublereal *); - integer frcls; - doublereal oblxf[36] /* was [6][6] */; - integer iaxes[3]; - static char itmra[32*2]; - integer cvobs, frctr; - logical inert; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - errdp_(char *, doublereal *, ftnlen), vsubg_(doublereal *, - doublereal *, integer *, doublereal *); - doublereal stalt[2], stemp[6], stobs[6]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal xfinv[36] /* was [6][6] */; - char units[80]; - doublereal nutxf[36] /* was [6][6] */, s2[12] /* was [6][2] - */, t0; - extern /* Subroutine */ int bodn2c_(char *, integer *, logical *, ftnlen), - bodc2n_(integer *, char *, logical *, ftnlen), eul2xf_( - doublereal *, integer *, integer *, integer *, doublereal *); - doublereal ra; - extern logical failed_(void); - logical meanec; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - char vecdef[80*2]; - static char itmabc[32*2]; - char basnam[32]; - doublereal lt; - logical negate; - static char itmdec[32*2]; - doublereal coeffs[60] /* was [20][3] */; - char inname__[32], abcorr[5], axname[80]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - char cfrmnm[32], ctrnam[36], cvcorr[5], dynstl[80], dynfam[80]; - static char itmaxe[32*2], itmfrm[32*2], itmlat[32*2], itmlon[32*2], - itmobs[32*2], itmspc[32*2], itmtrg[32*2], itmunt[32*2], itmvdf[32* - 2], itmvec[32*2]; - char nutmod[80], oblmod[80], prcmod[80], rotsta[80], timstr[50], tmpfam[ - 80], velfrm[32]; - doublereal acc[3], angles[2], ctrpos[3], dec, dirvec[3], eulang[6], fet, - lat, minsep, mob, precxf[36] /* was [6][6] */, stnear[6], - tarray[3], varray[9] /* was [3][3] */, sep, lon, xftemp[36] - /* was [6][6] */; - integer cfrmid; - static integer j2000; - integer obs; - doublereal vet; - logical corblk[15], fnd, frozen, meaneq, ofdate, trueeq; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), frmnam_( - integer *, char *, ftnlen), chkout_(char *, ftnlen), cmprss_(char - *, integer *, char *, char *, ftnlen, ftnlen, ftnlen), setmsg_( - char *, ftnlen), sigerr_(char *, ftnlen), intstr_(integer *, char - *, ftnlen), invstm_(doublereal *, doublereal *), errint_(char *, - integer *, ftnlen), qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *), frinfo_(integer *, integer *, - integer *, integer *, logical *), cidfrm_(integer *, integer *, - char *, logical *, ftnlen), bodvcd_(integer *, char *, integer *, - integer *, doublereal *, ftnlen), vminug_(doublereal *, integer *, - doublereal *), dnearp_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *), convrt_( - doublereal *, char *, char *, doublereal *, ftnlen, ftnlen), - latrec_(doublereal *, doublereal *, doublereal *, doublereal *), - stlabx_(doublereal *, doublereal *, doublereal *), stelab_( - doublereal *, doublereal *, doublereal *), polyds_(doublereal *, - integer *, integer *, doublereal *, doublereal *), zzeprc76_( - doublereal *, doublereal *), zzenut80_(doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* For a specified dynamic frame, find the transformation */ -/* that maps states from the dynamic frame to its base frame. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* PCK */ -/* SPK */ - -/* $ Keywords */ - -/* FRAMES */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRAM I Frame ID code for a SPICE dynamic reference frame. */ -/* CENTER I ID code for the center of the input frame. */ -/* ET I An epoch in seconds past J2000 TDB. */ -/* XFORM O The requested state transformation matrix. */ -/* BASFRM O Frame ID of base frame associated with INFRAM. */ - -/* $ Detailed_Input */ - -/* INFRAM is the frame ID code for a dynamic reference frame. */ -/* Note that this interface differs from that of TKFRAM, */ -/* which uses a class ID to identify the frame. */ - -/* In this routine, we refer this frame both as the */ -/* "input frame" and the "defined frame." */ - -/* CENTER is NAIF ID code for the center of the frame */ -/* designated by INFRAM. This code, although derivable */ -/* from INFRAM, is passed in for convenience. */ - -/* ET is an epoch in ephemeris seconds past J2000 for which */ -/* the caller requests a state transformation matrix. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6x6 matrix that transforms states relative to */ -/* INFRAM to states relative to BASFRM. */ - -/* BASFRM is the frame ID code of the base frame associated */ -/* with INFRAM. The 6x6 matrix XFORM transforms states */ -/* relative to INFRAM to states relative to BASFRM. The */ -/* state transformation is performed by left-multiplying */ -/* by XFORM a state expressed relative to INFRAM. This */ -/* is easily accomplished via the subroutine call shown */ -/* below. */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, OSTATE ) */ - -/* $ Parameters */ - -/* See include file zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If a dynamic frame evaluation requires unavailable kernel */ -/* data, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 2) If a precession model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 3) If a nutation model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 4) If an obliquity model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 5) If an unrecognized precession model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 6) If an unrecognized nutation model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 7) If an unrecognized obliquity model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 8) If an attempt to look up the center of a frame does */ -/* not yield data, the error SPICE(FRAMEDATANOTFOUND) is */ -/* signaled. */ - -/* 9) In a two-vector frame definition, if a constant vector */ -/* specification method is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 10) In a two-vector frame definition, if a vector definition */ -/* method is not recognized, the error SPICE(NOTSUPPORTED) */ -/* is signaled. */ - -/* 11) If an unrecognized dynamic frame family is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 12) If an unrecognized dynamic frame definition style is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 13) If an unrecognized dynamic frame rotation state is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 14) If both a freeze epoch and a rotation state are specified, */ -/* the error SPICE(FRAMEDEFERROR) is signaled. */ - -/* 15) If neither a freeze epoch nor a rotation state are specified */ -/* for an "of date" frame, the error SPICE(FRAMEDEFERROR) is */ -/* signaled. */ - -/* 16) In a two-vector frame definition, if an invalid axis */ -/* specification is encountered, the error SPICE(INVALIDAXIS) is */ -/* signaled. */ - -/* 17) In a two-vector frame definition using a target near point */ -/* vector, if the body-fixed frame associated with the target */ -/* is not found, the error SPICE(FRAMEDATANOTFOUND) is signaled. */ - -/* 18) If the state of the near point on a target as seen from */ -/* an observer cannot be computed, the error */ -/* SPICE(DEGENERATECASE) is signaled. */ - -/* 19) If a dynamic frame evaluation requires excessive recursion */ -/* depth, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 20) When a two-vector dynamic frame is evaluated, if the */ -/* primary and secondary vectors have angular separation less */ -/* than the minimum allowed value, or if the angular separation */ -/* differs from Pi by less than the minimum allowed value, the */ -/* error SPICE(DEGENERATECASE) is signaled. The default minimum */ -/* separation is given by the parameter LBSEP; this value may be */ -/* overridden by supplying a different value in the frame */ -/* definition. */ - -/* 21) If invalid units occur in a frame definition, the error */ -/* will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 22) If an invalid Euler axis sequence occurs in a frame */ -/* definition, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* 1) SPK files containing data for each observer and target */ -/* are required to support two-vector frames. Note that */ -/* observer-target pairs can be implicit, as in the case */ -/* of a constant vector whose frame is evaluated at a */ -/* light-time corrected epoch: the light time the frame */ -/* center to an observer must be computable in this case, */ -/* which implies the state of the frame center as seen by */ -/* the observer must be computable. */ - -/* 2) Any of SPK, CK, PCK, and frame kernels will also be required */ -/* if any frames referenced in the definition of INFRAM (as a */ -/* base frame, velocity vector frame, or constant vector frame) */ -/* require them, or if any vectors used to define INFRAM require */ -/* these data in order to be computable. */ - -/* 3) When CK data are required, one or more associated SCLK kernels */ -/* ---normally, one kernel per spacecraft clock---are */ -/* required as well. A leapseconds kernel may be required */ -/* whenever an SCLK kernel is required. */ - -/* 4) When a two-vector frame is defined using a target near point, */ -/* a PCK file giving orientation and providing a triaxial shape */ -/* model for the target body is required. */ - -/* $ Particulars */ - -/* Currently only parameterized dynamic frames are supported by */ -/* this routine. */ - -/* Currently supported parameterized dynamic families are: */ - -/* Two-vector */ -/* ========== */ - -/* Vector definitions */ -/* ------------------ */ -/* Observer-target position */ -/* Observer-target velocity */ -/* Near point on target */ -/* Constant vector in specified frame */ - - -/* Mean Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ - - -/* Mean Ecliptic and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU mean obliquity model */ - - -/* True Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU nutation model */ - - -/* Euler frames */ -/* ============ */ - -/* Euler angle definitions */ -/* ----------------------- */ -/* Polynomial */ - - -/* $ Examples */ - -/* See FRMGET. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) Many numerical problems can occur when dynamic frames */ -/* are evaluated. Users must determine whether dynamic frame */ -/* definitions are suitable for their applications. See the */ -/* Exceptions section for a list of possible problems. */ - -/* 3) Use of aberration corrections may lead to severe loss of */ -/* accuracy in state transformation derivatives. */ - -/* 4) Two-vector frame definitions can suffer extreme loss of */ -/* precision due to near-singular geometry. */ - -/* 5) Two-vector frame definitions involving velocity vectors */ -/* require numerical differentiation in order to compute the */ -/* derivative of the state transformation. Such derivatives may */ -/* have low accuracy. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 02-MAR-2010 (NJB) */ - -/* Typo in Brief_I/O section was corrected: "Class ID" */ -/* was changed to "Frame ID." Corrected order of header */ -/* sections. */ - -/* - SPICELIB Version 1.1.0, 23-OCT-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ were renamed to KVX, KVY, KVZ. */ - -/* Call to ZZBODVCD was replaced with call to BODVCD. */ - -/* - SPICELIB Version 1.0.0, 10-JAN-2005 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNFRM", (ftnlen)8); - if (first) { - -/* Get the ID code for the J2000 frame. */ - - irfnum_("J2000", &j2000, (ftnlen)5); - -/* Get the ID code for the earth (we needn't check the found */ -/* flag). */ - - bodn2c_("EARTH", &earth, &fnd, (ftnlen)5); - -/* Initialize "item" strings used to create kernel variable */ -/* names. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Vector axis: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 520)) << 2); - i__3[1] = 4, a__1[1] = "AXIS"; - s_cat(itmaxe + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmaxe", i__1, "zzdynfrm_", (ftnlen)520)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector definition: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 524)) << 2); - i__3[1] = 10, a__1[1] = "VECTOR_DEF"; - s_cat(itmvdf + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvdf", i__1, "zzdynfrm_", (ftnlen)524)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector aberration correction: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 528)) << 2); - i__3[1] = 6, a__1[1] = "ABCORR"; - s_cat(itmabc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmabc", i__1, "zzdynfrm_", (ftnlen)528)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector frame: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 532)) << 2); - i__3[1] = 5, a__1[1] = "FRAME"; - s_cat(itmfrm + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmfrm", i__1, "zzdynfrm_", (ftnlen)532)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector observer: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 536)) << 2); - i__3[1] = 8, a__1[1] = "OBSERVER"; - s_cat(itmobs + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynfrm_", (ftnlen)536)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector target: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 540)) << 2); - i__3[1] = 6, a__1[1] = "TARGET"; - s_cat(itmtrg + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmtrg", i__1, "zzdynfrm_", (ftnlen)540)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector longitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 544)) << 2); - i__3[1] = 9, a__1[1] = "LONGITUDE"; - s_cat(itmlon + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlon", i__1, "zzdynfrm_", (ftnlen)544)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector latitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 548)) << 2); - i__3[1] = 8, a__1[1] = "LATITUDE"; - s_cat(itmlat + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlat", i__1, "zzdynfrm_", (ftnlen)548)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector right ascension: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 552)) << 2); - i__3[1] = 2, a__1[1] = "RA"; - s_cat(itmra + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynfrm_", (ftnlen)552)) << 5), a__1, - i__3, &c__2, (ftnlen)32); - -/* Vector declination: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 556)) << 2); - i__3[1] = 3, a__1[1] = "DEC"; - s_cat(itmdec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmdec", i__1, "zzdynfrm_", (ftnlen)556)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector units: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 560)) << 2); - i__3[1] = 5, a__1[1] = "UNITS"; - s_cat(itmunt + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmunt", i__1, "zzdynfrm_", (ftnlen)560)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector coordinate specification: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 564)) << 2); - i__3[1] = 4, a__1[1] = "SPEC"; - s_cat(itmspc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmspc", i__1, "zzdynfrm_", (ftnlen)564)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector in cartesian coordinates, literal value: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynfrm_", (ftnlen) - 568)) << 2); - i__3[1] = 6, a__1[1] = "VECTOR"; - s_cat(itmvec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvec", i__1, "zzdynfrm_", (ftnlen)568)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - } - first = FALSE_; - } - -/* Initialize the output arguments. */ - - cleard_(&c__36, xform); - *basfrm = 0; - -/* Initialize certain variables to ensure that we don't do */ -/* arithmetic operations using bogus, possibly large, */ -/* undefined values. */ - - cleard_(&c__36, nutxf); - cleard_(&c__36, oblxf); - cleard_(&c__36, precxf); - cleard_(&c__36, xf2000); - cleard_(&c__36, xfinv); - cleard_(&c__36, xipm); - mob = 0.; - dmob = 0.; - t0 = 0.; - frozen = FALSE_; - -/* Get the input frame name. */ - - frmnam_(infram, inname__, (ftnlen)32); - -/* We need the name of the base frame. */ - - zzdynfid_(inname__, infram, "RELATIVE", basfrm, (ftnlen)32, (ftnlen)8); - frmnam_(basfrm, basnam, (ftnlen)32); - -/* The output frame code and name are set. */ - -/* Look up the dynamic frame definition style from the kernel pool. */ -/* The kernel variable's name might be specified by name or ID. */ - - zzdynvac_(inname__, infram, "DEF_STYLE", &c__1, &n, dynstl, (ftnlen)32, ( - ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* At this time, the only supported dynamic frame definition style is */ -/* PARAMETERIZED. */ - - if (eqstr_(dynstl, "PARAMETERIZED", (ftnlen)80, (ftnlen)13)) { - -/* Parameterized dynamic frames belong to families. Look up */ -/* the family for this frame. */ - - zzdynvac_(inname__, infram, "FAMILY", &c__1, &n, dynfam, (ftnlen)32, ( - ftnlen)6, (ftnlen)80); - cmprss_(" ", &c__0, dynfam, tmpfam, (ftnlen)1, (ftnlen)80, (ftnlen)80) - ; - ucase_(tmpfam, dynfam, (ftnlen)80, (ftnlen)80); - -/* Determine whether we have an "of-date" frame family. */ -/* The logical flags used here and respective meanings are: */ - -/* MEANEQ Mean equator and equinox of date */ -/* TRUEEQ True equator and equinox of date */ -/* MEANEC Mean ecliptic and equinox of date */ - - meaneq = s_cmp(dynfam, "MEAN_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - trueeq = s_cmp(dynfam, "TRUE_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - meanec = s_cmp(dynfam, "MEAN_ECLIPTIC_AND_EQUINOX_OF_DATE", (ftnlen) - 80, (ftnlen)33) == 0; - ofdate = meaneq || meanec || trueeq; - -/* Set the evaluation epoch T0. Normally this epoch is ET, */ -/* but if the frame is frozen, the freeze epoch from the */ -/* frame definition is used. */ - -/* Read the freeze epoch into T0 if a freeze epoch was */ -/* specified; let FROZEN receive the FOUND flag value */ -/* returned by ZZDYNOAD. */ - - zzdynoad_(inname__, infram, "FREEZE_EPOCH", &c__1, &n, &t0, &frozen, ( - ftnlen)32, (ftnlen)12); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - if (! frozen) { - -/* Normal case: just use the input epoch. */ - - t0 = *et; - } - -/* Look up the rotation state keyword. Rather than checking */ -/* FAILED() after every call, we'll do it after we're */ -/* done with processing the rotation state. */ - - zzdynoac_(inname__, infram, "ROTATION_STATE", &c__1, &n, rotsta, &fnd, - (ftnlen)32, (ftnlen)14, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* If the frame is frozen, the rotation state keyword *must be */ -/* absent*. */ - - if (frozen && fnd) { - setmsg_("Definition of frame # contains both # and # keywords; a" - "t most one of these must be present in the frame definit" - "ion. This situation is usually caused by an error in a f" - "rame kernel in which the frame is defined.", (ftnlen)209); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* If the frame belongs to an "of date" family, either the */ -/* rotation state must be specified or the frame must be */ -/* frozen. */ - - if (ofdate && ! frozen && ! fnd) { - setmsg_("Definition of frame #, which belongs to parameterized d" - "ynamic frame family #, contains neither # nor # keywords" - "; frames in this family require exactly one of these in " - "their frame definitions. This situation is usually cause" - "d by an error in a frame kernel in which the frame is de" - "fined.", (ftnlen)285); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Set the rotation state logical flag indicating whether */ -/* the state is 'INERTIAL'. */ - - if (fnd) { - -/* A rotation state keyword was found. */ - -/* We know the state is not frozen if we arrive here. */ - - inert = eqstr_(rotsta, "INERTIAL", (ftnlen)80, (ftnlen)8); - if (! inert) { - -/* Catch invalid rotation states here. */ - - if (! eqstr_(rotsta, "ROTATING", (ftnlen)80, (ftnlen)8)) { - setmsg_("Definition of frame # contains # specification " - "#. The only valid rotation states are # or #. Th" - "is situation is usually caused by an error in a " - "frame kernel in which the frame is defined.", ( - ftnlen)186); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - errch_("#", rotsta, (ftnlen)1, (ftnlen)80); - errch_("#", "ROTATING", (ftnlen)1, (ftnlen)8); - errch_("#", "INERTIAL", (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - } - } else { - -/* The state is not inertial unless there's a ROTATION_STATE */ -/* keyword assignment telling us it is. */ - - inert = FALSE_; - } - -/* INERT and FROZEN are both set. The evaluation epoch T0 is also */ -/* set. */ - -/* The following code block performs actions specific to */ -/* the various dynamic frame families. */ - - if (ofdate) { - -/* Fetch the name of the true equator and equinox of date */ -/* precession model. */ - - zzdynvac_(inname__, infram, "PREC_MODEL", &c__1, &n, prcmod, ( - ftnlen)32, (ftnlen)10, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Get the precession transformation. */ - - if (eqstr_(prcmod, "EARTH_IAU_1976", (ftnlen)80, (ftnlen)14)) { - -/* This is the 1976 IAU earth precession model. */ - -/* Make sure the center of the input frame is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame center # " - "and precession model #. This precession model is" - " not applicable to body #. This situation is usu" - "ally caused by an error in a frame kernel in whi" - "ch the frame is defined.", (ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1976", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Look up the precession transformation. */ - - zzeprc76_(&t0, precxf); - -/* If we're in the mean-of-date case, invert this */ -/* transformation to obtain the mapping from the */ -/* mean-of-date frame to J2000. */ - - if (meaneq) { - invstm_(precxf, xftemp); - } - } else { - setmsg_("Definition of frame # specifies precession model #," - " which is not recognized. This situation is usually " - "caused by an error in a frame kernel in which the fr" - "ame is defined.", (ftnlen)170); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", prcmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* At this point the precession transformation PRECXF is set. */ -/* If INFRAM is a mean equator and equinox of date frame, the */ -/* inverse of PRECXF is currently stored in XFTEMP. */ - if (trueeq) { - -/* We need a nutation transformation as well. Get the name */ -/* of the nutation model. */ - - zzdynvac_(inname__, infram, "NUT_MODEL", &c__1, &n, nutmod, ( - ftnlen)32, (ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Get the nutation transformation. */ - - if (eqstr_(nutmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth nutation model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and nutation model #. This nutation mode" - "l is not applicable to body #. This situati" - "on is usually caused by an error in a frame " - "kernel in which the frame is defined.", ( - ftnlen)212); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Look up the nutation transformation. */ - - zzenut80_(&t0, nutxf); - -/* Find the transformation from the J2000 frame to the */ -/* earth true of date frame. Invert. */ - - mxmg_(nutxf, precxf, &c__6, &c__6, &c__6, xfinv); - invstm_(xfinv, xftemp); - } else { - setmsg_("Definition of frame # specifies nutation model " - "#, which is not recognized. This situation is us" - "ually caused by an error in a frame kernel in wh" - "ich the frame is defined.", (ftnlen)168); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", nutmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - } else if (meanec) { - -/* We need a mean obliquity transformation as well. */ -/* Get the name of the obliquity model. */ - - zzdynvac_(inname__, infram, "OBLIQ_MODEL", &c__1, &n, oblmod, - (ftnlen)32, (ftnlen)11, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Get the obliquity transformation. */ - - if (eqstr_(oblmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth mean obliquity of */ -/* date model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and obliquity model #. This obliquity m" - "odel is not applicable to body #. This situa" - "tion is usually caused by an error in a fram" - "e kernel in which the frame is defined.", ( - ftnlen)214); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Create the obliquity transformation. First look up */ -/* the obliquity state (angle and angular rate). */ - - zzmobliq_(&t0, &mob, &dmob); - -/* The obliquity rotation is about the mean-of-date */ -/* x-axis. The other Euler angles are identically */ -/* zero; the axes are arbitrary, as long as the */ -/* middle axis is distinct from the other two. */ - - cleard_(&c__6, eulang); - eulang[2] = mob; - eulang[5] = dmob; - eul2xf_(eulang, &c__1, &c__3, &c__1, oblxf); - -/* Find the transformation from the J2000 to the */ -/* earth mean ecliptic of date frame. Invert. */ - - mxmg_(oblxf, precxf, &c__6, &c__6, &c__6, xfinv); - invstm_(xfinv, xftemp); - } else { - setmsg_("Definition of frame # specifies obliquity model" - " #, which is not recognized. This situation is u" - "sually caused by an error in a frame kernel in w" - "hich the frame is defined.", (ftnlen)169); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", oblmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - } - -/* At this point, XFTEMP contains the mapping from the */ -/* specified mean of date or true of date frame to J2000. */ - -/* If the base frame is not J2000, we must find the */ -/* transformation from J2000 to the base frame. */ - - if (*basfrm != j2000) { - zzfrmch0_(&j2000, basfrm, &t0, xf2000); - mxmg_(xf2000, xftemp, &c__6, &c__6, &c__6, xform); - } else { - -/* Otherwise, XFTEMP is the matrix we want. */ - - moved_(xftemp, &c__36, xform); - } - -/* Now XFORM is the state transformation mapping from */ -/* the input frame INFRAM to the base frame BASFRM. */ - -/* This is the end of the work specific to "of-date" frames. */ -/* From here we drop out of the IF block. At the end of this */ -/* routine, the derivative block of XFORM will be zeroed out */ -/* if the frame is frozen. If the rotation state is */ -/* 'INERTIAL', we will make sure the transformation between */ -/* the defined frame and the J2000 frame has time derivative */ -/* zero. */ - - } else if (s_cmp(dynfam, "TWO-VECTOR", (ftnlen)80, (ftnlen)10) == 0) { - -/* The frame belongs to the TWO-VECTOR family. */ - -/* Initialize the array S2. */ - - cleard_(&c__12, s2); - -/* Fetch the specifications of the primary and secondary */ -/* axes. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Get the name of the axis associated with the Ith */ -/* defining vector. */ - - zzdynvac_(inname__, infram, itmaxe + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmaxe", i__1, "zzdynfrm_" - , (ftnlen)1087)) << 5), &c__1, &n, axname, (ftnlen)32, - (ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(axname, axname, (ftnlen)80, (ftnlen)80); - -/* Set the sign flag associated with the axis. */ - - negate = *(unsigned char *)axname == '-'; - cmprss_("-", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - cmprss_("+", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("axis", - i__1, "zzdynfrm_", (ftnlen)1100)] = isrchc_(axname, & - c__3, axes, (ftnlen)80, (ftnlen)1); - if (axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "axis", i__1, "zzdynfrm_", (ftnlen)1103)] == 0) { - setmsg_("Definition of frame # associates vector # with " - "axis #. The only valid axis values are { X, -X," - " Y, -Y, Z, -Z }. This situation is usually cause" - "d by an error in a frame kernel in which the fra" - "me is defined.", (ftnlen)205); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &i__, (ftnlen)1); - errch_("#", axname, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDAXIS)", (ftnlen)18); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Find out how the vector is defined: */ - -/* - Observer-target position vector */ -/* - Observer-target velocity vector */ -/* - Observer-target near point vector */ -/* - Constant vector */ - -/* VECDEF(I) indicates the vector definition method */ -/* for the Ith vector. */ - - zzdynvac_(inname__, infram, itmvdf + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmvdf", i__1, "zzdynfrm_" - , (ftnlen)1132)) << 5), &c__1, &n, vecdef + ((i__2 = - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("vecdef", - i__2, "zzdynfrm_", (ftnlen)1132)) * 80, (ftnlen)32, ( - ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, vecdef + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("vecdef", i__1, "zzdynfrm_", ( - ftnlen)1135)) * 80, vecdef + ((i__2 = i__ - 1) < 2 && - 0 <= i__2 ? i__2 : s_rnge("vecdef", i__2, "zzdynfrm_", - (ftnlen)1135)) * 80, (ftnlen)1, (ftnlen)80, (ftnlen) - 80); - ucase_(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynfrm_", (ftnlen)1136)) * - 80, vecdef + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("vecdef", i__2, "zzdynfrm_", (ftnlen) - 1136)) * 80, (ftnlen)80, (ftnlen)80); - if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynfrm_", (ftnlen)1139)) * - 80, "OBSERVER_TARGET_POSITION", (ftnlen)80, (ftnlen) - 24) == 0) { - -/* The vector is the position of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynfrm_", (ftnlen)1146)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynfrm_", (ftnlen)1148)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfrm_", (ftnlen)1150)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* Look up the Ith state vector in the J2000 frame. */ - - zzspkez0_(&targ, &t0, "J2000", abcorr, &obs, &s2[(i__1 = - i__ * 6 - 6) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "s2", i__1, "zzdynfrm_", (ftnlen)1156)], <, ( - ftnlen)5, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* At this point, S2(*,I) contains position and */ -/* velocity relative to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfrm_", (ftnlen) - 1169)) * 80, "OBSERVER_TARGET_VELOCITY", (ftnlen)80, ( - ftnlen)24) == 0) { - -/* The vector is the velocity of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynfrm_", (ftnlen)1176)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynfrm_", (ftnlen)1178)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfrm_", (ftnlen)1180)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* We need to know the frame in which the velocity is */ -/* defined. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynfrm_", (ftnlen)1187)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - frmnam_(&frid, velfrm, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Obtain the velocity vector in the specified velocity */ -/* frame. Also obtain bracketing vectors to support */ -/* discrete differentiation. (See notes in zzdyn.inc */ -/* regarding definition of DELTA.) */ - -/* Computing MAX */ - d__1 = 1., d__2 = t0 * 7.4505805969238281e-9; - delta = max(d__1,d__2); - d__1 = t0 - delta; - d__2 = t0 + delta; - vpack_(&d__1, &t0, &d__2, tarray); - for (j = 1; j <= 3; ++j) { - zzspkez0_(&targ, &tarray[(i__1 = j - 1) < 3 && 0 <= - i__1 ? i__1 : s_rnge("tarray", i__1, "zzdynf" - "rm_", (ftnlen)1208)], velfrm, abcorr, &obs, - stemp, <, (ftnlen)32, (ftnlen)5); - -/* We compute the derivative using unit */ -/* velocity vectors. */ - - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - vhat_(&stemp[3], &varray[(i__1 = j * 3 - 3) < 9 && 0 - <= i__1 ? i__1 : s_rnge("varray", i__1, "zzd" - "ynfrm_", (ftnlen)1219)]); - } - -/* Compute acceleration and fill in the velocity state */ -/* vector S2(*,I). */ - - qderiv_(&c__3, varray, &varray[6], &delta, acc); - vequ_(&varray[3], &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfrm_", ( - ftnlen)1230)]); - vequ_(acc, &s2[(i__1 = i__ * 6 - 3) < 12 && 0 <= i__1 ? - i__1 : s_rnge("s2", i__1, "zzdynfrm_", (ftnlen) - 1231)]); - -/* We need the epoch VET at which VELFRM is evaluated. */ -/* This epoch will be used to transform the velocity's */ -/* "state" vector from VELFRM to J2000. */ - -/* Set the default value of VET here. */ - - vet = t0; - -/* Parse the aberration correction. Find the epoch used */ -/* to evaluate the velocity vector's frame. */ - - zzprscor_(abcorr, corblk, (ftnlen)5); - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the velocity vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the velocity frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame ass" - "ociated with a velocity vector has frame" - " ID code #, but no frame center, frame c" - "lass, or frame class ID was found by FRI" - "NFO. This situation MAY be caused by an" - " error in a frame kernel in which the fr" - "ame is defined. The problem also could b" - "e indicative of a SPICELIB bug.", (ftnlen) - 310); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* If the velocity frame is non-inertial, we'll need */ -/* to compute the evaluation epoch for this frame. */ - - if (frcls != 1) { - -/* Obtain light time from the observer to the */ -/* frame's center; find the evaluation epoch VET */ -/* for the frame. */ - zzspkzp0_(&frctr, &t0, "J2000", abcorr, &obs, - ctrpos, &vflt, (ftnlen)5, (ftnlen)5); - zzcorepc_(abcorr, &t0, &vflt, &vet, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - } - } - -/* The velocity frame's evaluation epoch VET is now set. */ - -/* We must rotate the velocity vector and transform the */ -/* acceleration from the velocity frame (evaluated at */ -/* VET) to the output frame at T0. We'll do this in two */ -/* stages, first mapping velocity and acceleration into */ -/* the J2000 frame. */ - - if (frid != j2000) { - zzfrmch0_(&frid, &j2000, &vet, xf2000); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - mxvg_(xf2000, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfrm_", - (ftnlen)1322)], &c__6, &c__6, stemp); - moved_(stemp, &c__6, &s2[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("s2", i__1, "zzdyn" - "frm_", (ftnlen)1323)]); - } - -/* At this point, S2(*,I) contains velocity and */ -/* acceleration relative to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfrm_", (ftnlen) - 1333)) * 80, "TARGET_NEAR_POINT", (ftnlen)80, (ftnlen) - 17) == 0) { - -/* The vector points from an observer to the */ -/* sub-observer point (nearest point to the observer) on */ -/* the target body. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynfrm_", (ftnlen)1341)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynfrm_", (ftnlen)1343)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfrm_", (ftnlen)1345)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* The vector points from the observer to the nearest */ -/* point on the target. We need the state of the near */ -/* point relative to the observer. */ - -/* We'll look up the state of the target center relative */ -/* to the observer and the state of the near point */ -/* relative to the target center, both in the body-fixed */ -/* frame associated with the target. */ - -/* Look up the body-fixed frame associated with the */ -/* target body. */ - - cidfrm_(&targ, &cfrmid, cfrmnm, &fnd, (ftnlen)32); - if (! fnd) { - setmsg_("Definition of frame # requires definition o" - "f body-fixed frame associated with target bo" - "dy #. A call to CIDFRM indicated no body-fix" - "ed frame is associated with the target body." - " This situation can arise when a frame kern" - "el defining the target's body-fixed frame l" - "acks the OBJECT__FRAME or OBJECT__" - "FRAME keywords. The problem also could be c" - "aused by an error in a frame kernel in which" - " the parameterized two-vector dynamic frame " - "# is defined.", (ftnlen)452); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &targ, (ftnlen)1); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Get the radii of the target body. */ - - bodvcd_(&targ, "RADII", &c__3, &n, radii, (ftnlen)5); - -/* Look up the Ith state vector in the target-fixed */ -/* frame. Negate the vector to obtain the target-to- */ -/* observer vector. */ - - zzspkez0_(&targ, &t0, cfrmnm, abcorr, &obs, stemp, <, ( - ftnlen)32, (ftnlen)5); - -/* We check FAILED() here because VMINUG is a simple */ -/* arithmetic routine that doesn't return on entry. */ - - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - vminug_(stemp, &c__6, stobs); - dnearp_(stobs, radii, &radii[1], &radii[2], stnear, stalt, - &fnd); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - if (! fnd) { - setmsg_("In definition of frame #, vector # is defin" - "ed by the near point on body # as seen from " - "body #. The state of this near point was no" - "t found. See the routine DNEARP for an expla" - "nation. This situation MAY be caused by an " - "error in a frame kernel in which the frame i" - "s defined. The problem also could be indicat" - "ive of a SPICELIB bug.", (ftnlen)329); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &i__, (ftnlen)1); - errint_("#", &targ, (ftnlen)1); - errint_("#", &obs, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Find the observer-near point state in the target */ -/* body-fixed frame. */ - - vsubg_(stnear, stobs, &c__6, stemp); - -/* Transform the state to frame J2000. To get the */ -/* required transformation matrix, we'll need to obtain */ -/* the epoch associated with CNMFRM. Parse the */ -/* aberration correction and adjust the frame evaluation */ -/* epoch as needed. */ - - zzcorepc_(abcorr, &t0, <, &fet, (ftnlen)5); - -/* Obtain the matrix for transforming state vectors */ -/* from the target center frame to the J2000 frame and */ -/* apply it to the observer-to-near point state vector. */ - - zzfrmch0_(&cfrmid, &j2000, &fet, xipm); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - mxvg_(xipm, stemp, &c__6, &c__6, &s2[(i__1 = i__ * 6 - 6) - < 12 && 0 <= i__1 ? i__1 : s_rnge("s2", i__1, - "zzdynfrm_", (ftnlen)1476)]); - -/* At this point, S2(*,I) contains position and */ -/* velocity of the near point on the target as */ -/* seen by the observer, relative to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfrm_", (ftnlen) - 1484)) * 80, "CONSTANT", (ftnlen)80, (ftnlen)8) == 0) - { - -/* The vector is constant in a specified frame. */ - - -/* We need a 3-vector and an associated reference */ -/* frame relative to which the vector is specified. */ - -/* Look up the ID of the frame first. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynfrm_", (ftnlen)1494)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - -/* Let FET ("frame ET") be the evaluation epoch for */ -/* the constant vector's frame. By default, this */ -/* frame is just T0, but if we're using light time */ -/* corrections, FET must be adjusted for one-way */ -/* light time between the frame's center and the */ -/* observer. */ - -/* Set the default value of FET here. */ - - fet = t0; - -/* Optionally, there is an aberration correction */ -/* associated with the constant vector's frame. */ -/* If so, an observer must be associated with the */ -/* frame. Look up the correction first. */ - - zzdynoac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynfrm_", (ftnlen)1514)) << 5), &c__1, &n, - cvcorr, &fnd, (ftnlen)32, (ftnlen)32, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - if (! fnd) { - s_copy(cvcorr, "NONE", (ftnlen)5, (ftnlen)4); - } - zzprscor_(cvcorr, corblk, (ftnlen)5); - if (! corblk[0]) { - -/* We need to apply an aberration correction to */ -/* the constant vector. */ - -/* Check for errors in the aberration correction */ -/* specification. */ - -/* - Light time and stellar aberration corrections */ -/* are mutually exclusive. */ - - if (corblk[1] && corblk[2]) { - setmsg_("Definition of frame # specifies aberrat" - "ion correction # for constant vector. L" - "ight time and stellar aberration correct" - "ions are mutually exclusive for constant" - " vectors used in two-vector parameterize" - "d dynamic frame definitions. This situa" - "tion is usually caused by an error in a " - "frame kernel in which the frame is defin" - "ed.", (ftnlen)322); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", cvcorr, (ftnlen)1, (ftnlen)5); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the constant vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the constant vector frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame" - " associated with a constant vector h" - "as frame ID code #, but no frame cen" - "ter, frame class, or frame class ID " - "was found by FRINFO. This situation" - " MAY be caused by an error in a fram" - "e kernel in which the frame is defin" - "ed. The problem also could be indica" - "tive of a SPICELIB bug.", (ftnlen)310) - ; - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen) - 24); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* If the constant vector frame is non-inertial, */ -/* we'll need to compute the evaluation epoch for */ -/* this frame. */ - - if (frcls != 1) { - -/* Look up the observer associated with the */ -/* constant vector's frame. This observer, */ -/* together with the frame's center, determines */ -/* the evaluation epoch for the frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynfrm_", ( - ftnlen)1607)) << 5), &cvobs, (ftnlen) - 32, (ftnlen)32); - -/* Obtain light time from the observer to the */ -/* frame's center. */ - - zzspkzp0_(&frctr, &t0, "J2000", cvcorr, & - cvobs, ctrpos, <, (ftnlen)5, ( - ftnlen)5); - -/* Re-set the evaluation epoch for the frame. */ - - zzcorepc_(cvcorr, &t0, <, &fet, (ftnlen)5); - } - -/* The constant vector frame's evaluation epoch */ -/* FET has been set. */ - - } else if (corblk[2]) { - -/* Stellar aberration case. */ - -/* The constant vector must be corrected for */ -/* stellar aberration induced by the observer's */ -/* velocity relative to the solar system */ -/* barycenter. First, find this velocity in */ -/* the J2000 frame. We'll apply the correction */ -/* later, when the constant vector has been */ -/* transformed to the J2000 frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmobs", i__1, "zzdynfrm_", (ftnlen)1640) - ) << 5), &cvobs, (ftnlen)32, (ftnlen)32); - zzspksb0_(&cvobs, &t0, "J2000", stobs, (ftnlen)5); - } - } - -/* At this point FET is the frame evaluation epoch */ -/* for the frame associated with the constant vector. */ - -/* If stellar aberration correction has been specified, */ -/* STOBS is the state of the observer relative to the */ -/* solar system barycenter, expressed in the J2000 */ -/* frame. */ - -/* Get the constant vector specification. */ - - zzdynvac_(inname__, infram, itmspc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmspc", i__1, - "zzdynfrm_", (ftnlen)1660)) << 5), &c__1, &n, - spec, (ftnlen)32, (ftnlen)32, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - cmprss_(" ", &c__0, spec, spec, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(spec, spec, (ftnlen)80, (ftnlen)80); - if (s_cmp(spec, "RECTANGULAR", (ftnlen)80, (ftnlen)11) == - 0) { - -/* The coordinate system is rectangular. */ - -/* Look up the constant vector. */ - - zzdynvad_(inname__, infram, itmvec + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmvec", - i__1, "zzdynfrm_", (ftnlen)1678)) << 5), & - c__3, &n, dirvec, (ftnlen)32, (ftnlen)32); - } else if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen) - 11) == 0 || s_cmp(spec, "RA/DEC", (ftnlen)80, ( - ftnlen)6) == 0) { - -/* The coordinate system is latitudinal or RA/DEC. */ - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, itmunt + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmunt", - i__1, "zzdynfrm_", (ftnlen)1689)) << 5), & - c__1, &n, units, (ftnlen)32, (ftnlen)32, ( - ftnlen)80); - if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen)11) - == 0) { - -/* Look up longitude and latitude. */ - - zzdynvad_(inname__, infram, itmlon + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlon", i__1, "zzdynfrm_", (ftnlen)1697) - ) << 5), &c__1, &n, &lon, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmlat + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlat", i__1, "zzdynfrm_", (ftnlen)1700) - ) << 5), &c__1, &n, &lat, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&lon, units, "RADIANS", angles, (ftnlen) - 80, (ftnlen)7); - convrt_(&lat, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } else { - -/* Look up RA and DEC. */ - - zzdynvad_(inname__, infram, itmra + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynfrm_", (ftnlen)1713)) - << 5), &c__1, &n, &ra, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmdec + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmdec", i__1, "zzdynfrm_", (ftnlen)1716) - ) << 5), &c__1, &n, &dec, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&ra, units, "RADIANS", angles, (ftnlen)80, - (ftnlen)7); - convrt_(&dec, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Now produce a direction vector. */ - - latrec_(&c_b386, angles, &angles[1], dirvec); - } else { - setmsg_("Definition of two-vector parameterized dyna" - "mic frame # includes constant vector specifi" - "cation #, which is not supported. This situ" - "ation is usually caused by an error in a fra" - "me kernel in which the frame is defined.", ( - ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", spec, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* At this point, the cartesian coordinates of the */ -/* vector relative to the constant vector frame */ -/* are stored in DIRVEC. */ - -/* Convert the direction vector to the J2000 frame. */ -/* Fill in the state vector. The velocity in the */ -/* constant vector's frame is zero. */ - - vequ_(dirvec, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= i__1 ? - i__1 : s_rnge("s2", i__1, "zzdynfrm_", (ftnlen) - 1765)]); - cleard_(&c__3, &s2[(i__1 = i__ * 6 - 3) < 12 && 0 <= i__1 - ? i__1 : s_rnge("s2", i__1, "zzdynfrm_", (ftnlen) - 1766)]); - if (frid != j2000) { - zzfrmch0_(&frid, &j2000, &fet, xipm); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - mxvg_(xipm, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfrm_", - (ftnlen)1777)], &c__6, &c__6, stemp); - moved_(stemp, &c__6, &s2[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("s2", i__1, "zzdyn" - "frm_", (ftnlen)1778)]); - } - -/* The state of the constant vector is now represented */ -/* in the J2000 frame, but we may still need to */ -/* apply a stellar aberration correction. */ - - if (corblk[2]) { - -/* Perform the stellar aberration correction */ -/* appropriate to the radiation travel sense. */ - if (corblk[4]) { - -/* The correction is for transmission. */ - - stlabx_(&s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynf" - "rm_", (ftnlen)1796)], &stobs[3], stemp); - } else { - -/* The correction is for reception. */ - - stelab_(&s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynf" - "rm_", (ftnlen)1802)], &stobs[3], stemp); - } - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Update the position portion of S2(*,I). */ - - vequ_(stemp, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfrm_", - (ftnlen)1814)]); - } - -/* At this point, S2(*,I) contains position and velocity */ -/* of the constant (constant relative to its associated */ -/* frame, that is) vector as seen by the observer, */ -/* relative to frame J2000. */ - - } else { - setmsg_("Definition of two-vector parameterized dynamic " - "frame # includes vector definition #, which is n" - "ot supported. This situation is usually caused " - "by an error in a frame kernel in which the frame" - " is defined.", (ftnlen)203); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynfrm_", ( - ftnlen)1836)) * 80, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Negate the state vector if the axis has negative sign. */ - - if (negate) { - vminug_(&s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= i__1 ? i__1 - : s_rnge("s2", i__1, "zzdynfrm_", (ftnlen)1847)], - &c__6, stemp); - moved_(stemp, &c__6, &s2[(i__1 = i__ * 6 - 6) < 12 && 0 <= - i__1 ? i__1 : s_rnge("s2", i__1, "zzdynfrm_", ( - ftnlen)1848)]); - } - } - -/* Look up the lower bound for the angular separation of */ -/* the defining vectors. Use the default value if none */ -/* was supplied. */ - - zzdynoad_(inname__, infram, itmsep, &c__1, &n, &minsep, &fnd, ( - ftnlen)32, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - if (! fnd) { - minsep = .001; - } - -/* Now use our states to compute our state transformation */ -/* matrix. */ - -/* Check the angular separation of the defining vectors. We */ -/* want to ensure that the vectors are not too close to being */ -/* linearly dependent. We can handle both cases---separation */ -/* close to 0 or separation close to Pi---by comparing the */ -/* sine of the separation to the sine of the separation limit. */ - - sep = vsep_(s2, &s2[6]); - if (sin(sep) < sin(minsep)) { - etcal_(&t0, timstr, (ftnlen)50); - setmsg_("Angular separation of vectors defining two-vector p" - "arameterized dynamic frame # is # (radians); minimum" - " allowed difference of separation from 0 or Pi is # " - "radians. Evaluation epoch is #. Extreme loss of pr" - "ecision can occur when defining vectors are nearly l" - "inearly dependent. This type of error can be due to" - " using a dynamic frame outside of the time range for" - " which it is meant. It also can be due to a conceptu" - "al error pertaining to the frame's definition, or to" - " an implementation error in the frame kernel contain" - "ing the frame definition. However, if you wish to pr" - "oceed with this computation, the # keyword can be us" - "ed in the frame definition to adjust the separation " - "limit.", (ftnlen)681); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errdp_("#", &sep, (ftnlen)1); - errdp_("#", &minsep, (ftnlen)1); - errch_("#", timstr, (ftnlen)1, (ftnlen)50); - errch_("#", "ANGLE_SEP_TOL", (ftnlen)1, (ftnlen)13); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* We have both states expressed relative to frame J2000 */ -/* at this point. Find the transformation from INNAME to */ -/* the frame J2000, then from J2000 to frame BASNAM. */ - - zztwovxf_(s2, axis, &s2[6], &axis[1], xform); - if (*basfrm != j2000) { - moved_(xform, &c__36, xftemp); - zzfrmch0_(&j2000, basfrm, &t0, xf2000); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - mxmg_(xf2000, xftemp, &c__6, &c__6, &c__6, xform); - } - -/* This is the end of the work specific to two-vector frames. */ -/* From here we drop out of the IF block. At the end of this */ -/* routine, the derivative block of XFORM will be zeroed out */ -/* if the frame is frozen. If the rotation state is */ -/* 'INERTIAL', we will make sure the transformation between */ -/* the defined frame and the J2000 frame has time derivative */ -/* zero. */ - - } else if (s_cmp(dynfam, "EULER", (ftnlen)80, (ftnlen)5) == 0) { - -/* The frame belongs to the Euler family. */ - -/* We expect to specifications of an axis sequence, units, */ -/* and angles via polynomial coefficients. We also expect */ -/* to see an ET epoch. */ - -/* Look up the epoch first. Let DELTA represent the offset */ -/* of T0 relative to the epoch. */ - -/* Initialize EPOCH so subtraction doesn't overflow if EPOCH */ -/* is invalid due to a lookup error. */ - - epoch = 0.; - zzdynvad_(inname__, infram, "EPOCH", &c__1, &n, &epoch, (ftnlen) - 32, (ftnlen)5); - delta = t0 - epoch; - -/* Now the axis sequence. */ - - zzdynvai_(inname__, infram, "AXES", &c__3, &n, iaxes, (ftnlen)32, - (ftnlen)4); - -/* Now the coefficients for the angles. */ - - for (i__ = 1; i__ <= 3; ++i__) { - -/* Initialize N so subtraction doesn't overflow if N */ -/* is invalid due to a lookup error. */ - - n = 0; - zzdynvad_(inname__, infram, itmcof + (((i__1 = i__ - 1) < 3 && - 0 <= i__1 ? i__1 : s_rnge("itmcof", i__1, "zzdynfrm_" - , (ftnlen)1983)) << 5), &c__20, &n, &coeffs[(i__2 = - i__ * 20 - 20) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "coeffs", i__2, "zzdynfrm_", (ftnlen)1983)], (ftnlen) - 32, (ftnlen)32); - -/* Set the polynomial degree for the Ith angle. */ - - degs[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("degs", - i__1, "zzdynfrm_", (ftnlen)1989)] = n - 1; - } - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, "UNITS", &c__1, &n, units, (ftnlen)32, - (ftnlen)5, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* Evaluate the angles and their derivatives at DELTA. Convert */ -/* angles from input units to radians and radians/sec. */ - - for (i__ = 1; i__ <= 3; ++i__) { - polyds_(&coeffs[(i__1 = i__ * 20 - 20) < 60 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "zzdynfrm_", (ftnlen) - 2009)], °s[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("degs", i__2, "zzdynfrm_", (ftnlen)2009) - ], &c__1, &delta, poly); - -/* Convert units. Fill in the Euler angle state vector. */ - - convrt_(poly, units, "RADIANS", &eulang[(i__1 = i__ - 1) < 6 - && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzdynf" - "rm_", (ftnlen)2013)], (ftnlen)80, (ftnlen)7); - convrt_(&poly[1], units, "RADIANS", &eulang[(i__1 = i__ + 2) < - 6 && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzd" - "ynfrm_", (ftnlen)2014)], (ftnlen)80, (ftnlen)7); - } - -/* Produce a state transformation matrix that maps from */ -/* the defined frame to the base frame. */ - - eul2xf_(eulang, iaxes, &iaxes[1], &iaxes[2], xform); - -/* This is the end of the work specific to Euler frames. */ -/* From here we drop out of the IF block. At the end of this */ -/* routine, the derivative block of XFORM will be zeroed out */ -/* if the frame is frozen. If the rotation state is */ -/* 'INERTIAL', we will make sure the transformation between */ -/* the defined frame and the J2000 frame has time derivative */ -/* zero. */ - - } else { - setmsg_("Dynamic frame family # (in definition of frame #) is no" - "t supported. This situation is usually caused by an erro" - "r in a frame kernel in which the frame is defined.", ( - ftnlen)161); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* This is the end of the IF block that processes the */ -/* parameterized dynamic frame families. */ - - } else { - setmsg_("Dynamic frame style # (in definition of frame #) is not sup" - "ported. This situation is usually caused by an error in a fr" - "ame kernel in which the frame is defined.", (ftnlen)160); - errch_("#", dynstl, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - -/* At this point XFORM is the state transformation matrix mapping */ -/* from the input frame INFRAM to the base frame BASFRM. */ - -/* If the frame has rotation state 'INERTIAL', the frame must have */ -/* zero derivative with respect to any inertial frame. Set the */ -/* derivative block accordingly. */ - - if (inert) { - -/* See whether the base frame is inertial. */ - - irfnum_(basnam, &j, (ftnlen)32); - if (j > 0) { - -/* The base frame is a recognized inertial frame. Zero */ -/* out the derivative block. */ - - for (i__ = 1; i__ <= 3; ++i__) { - cleard_(&c__3, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzdynfrm_", (ftnlen) - 2093)]); - } - } else { - -/* The base frame is *not* a recognized inertial frame. */ - -/* Create the state transformation matrix that maps from the */ -/* defined frame to J2000. Zero out the derivative block of */ -/* this matrix. Convert the resulting matrix to the state */ -/* transformation from the defined frame to the output frame. */ - - zzfrmch0_(basfrm, &j2000, &t0, xf2000); - if (failed_()) { - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; - } - mxmg_(xf2000, xform, &c__6, &c__6, &c__6, xftemp); - for (i__ = 1; i__ <= 3; ++i__) { - cleard_(&c__3, &xftemp[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 - ? i__1 : s_rnge("xftemp", i__1, "zzdynfrm_", (ftnlen) - 2115)]); - } - -/* XFTEMP now represents the transformation from a */ -/* constant frame matching the defined frame at T0 to the */ -/* J2000 frame. Produce the transformation from this constant */ -/* frame to the output frame. */ - -/* To avoid introducing additional round-off error into */ -/* the rotation blocks of XFORM, we overwrite only the */ -/* derivative block of XFORM with the derivative block */ -/* of the "inertial" transformation. */ - - invstm_(xf2000, xfinv); - mxmg_(xfinv, xftemp, &c__6, &c__6, &c__6, xout); - for (i__ = 1; i__ <= 3; ++i__) { - vequ_(&xout[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xout", i__1, "zzdynfrm_", (ftnlen)2133)], & - xform[(i__2 = i__ * 6 - 3) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zzdynfrm_", (ftnlen)2133)]); - } - } - } - -/* If the frame is frozen, zero out the derivative block of the */ -/* transformation matrix. */ - - if (frozen) { - for (i__ = 1; i__ <= 3; ++i__) { - cleard_(&c__3, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzdynfrm_", (ftnlen)2147)]); - } - } - -/* XFORM and BASFRM are set. */ - - chkout_("ZZDYNFRM", (ftnlen)8); - return 0; -} /* zzdynfrm_ */ - diff --git a/ext/spice/src/cspice/zzdynoac.c b/ext/spice/src/cspice/zzdynoac.c deleted file mode 100644 index 666fb200be..0000000000 --- a/ext/spice/src/cspice/zzdynoac.c +++ /dev/null @@ -1,758 +0,0 @@ -/* zzdynoac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNOAC ( Fetch optional array, character frame variable ) */ -/* Subroutine */ int zzdynoac_(char *frname, integer *frcode, char *item, - integer *maxn, integer *n, char *values, logical *found, ftnlen - frname_len, ftnlen item_len, ftnlen values_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gcpool_(char *, integer *, integer *, integer *, char - *, logical *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up optional array-valued character frame kernel variable. */ -/* The frame name or frame ID may be used as part of the variable's */ -/* name. */ - -/* If the kernel variable is not present, or if the variable */ -/* has the wrong data type or size, set the FOUND flag to .FALSE. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* N O Number of returned values. */ -/* VALUES O Output kernel variable. */ -/* FOUND O "Found" flag. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a character variable */ -/* of that name first. */ - -/* $ Detailed_Output */ - -/* N is the number of values returned in the array */ -/* VALUES. */ - -/* VALUES are the values associated with the requested */ -/* array-valued, character kernel variable. The */ -/* kernel variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has character type, the associated */ -/* values will be returned. If this variable is */ -/* not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If a character variable */ -/* having that name is found, the associated */ -/* values will be returned. */ - -/* VALUES is not defined if the requested kernel */ -/* variable is not found. */ - -/* FOUND is a logical flag indicating whether the requested */ -/* kernel variable was found. If the search described */ -/* above (in the detailed description of the output */ -/* argument VALUES) is successful, FOUND is set to */ -/* .TRUE.; otherwise FOUND is set to .FALSE. */ - -/* $ Parameters */ - -/* See zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 2) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has numeric data */ -/* type, the error SPICE(BADVARIABLETYPE) will be signaled. */ - -/* 3) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than MAXN */ -/* associated values, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than MAXN */ -/* associated values, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. This routine */ -/* is meant to look up array-valued character variables whose */ -/* presence is optional. For required array character variables, */ -/* use ZZDYNVAC. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* data structure, these names are distinct. Hence kernel variables */ -/* having names of both forms, but having possibly different */ -/* attributes, can be simultaneously present in the kernel pool. */ -/* Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) A scalar-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially mask a */ -/* array-valued kernel variable matching the "name form" of the */ -/* requested name. This problem can be prevented by sensible */ -/* frame kernel design. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNOAC", (ftnlen)8); - -/* Nothing found yet. */ - - *found = FALSE_; - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, found, n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - *found = FALSE_; - } - if (! (*found)) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, found, n, dtype, (ftnlen)32, (ftnlen)1); - if (! (*found)) { - -/* The FOUND flag is set appropriately. */ - - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - -/* Rather than using BADKPV, we check the data type and cardinality */ -/* of the kernel variable in-line so we can create a more detailed */ -/* error message if need be. */ - - if (*(unsigned char *)dtype == 'N') { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have character data type but in fact has numeric data " - "type. Usually this type of problem is due to an error in a " - "frame definition provided in a frame kernel.", (ftnlen)223); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } - if (*n > *maxn) { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have size not exceeding # but in fact has size #. Usua" - "lly this type of problem is due to an error in a frame defin" - "ition provided in a frame kernel.", (ftnlen)212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", maxn, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gcpool_(kvname, &c__1, maxn, n, values, found, (ftnlen)32, values_len); - if (! (*found)) { - setmsg_("Variable # not found after DTPOOL indicated it was present " - "in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; - } - chkout_("ZZDYNOAC", (ftnlen)8); - return 0; -} /* zzdynoac_ */ - diff --git a/ext/spice/src/cspice/zzdynoad.c b/ext/spice/src/cspice/zzdynoad.c deleted file mode 100644 index dcd917cabe..0000000000 --- a/ext/spice/src/cspice/zzdynoad.c +++ /dev/null @@ -1,817 +0,0 @@ -/* zzdynoad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNOAD ( Fetch optional array, d.p. frame variable ) */ -/* Subroutine */ int zzdynoad_(char *frname, integer *frcode, char *item, - integer *maxn, integer *n, doublereal *values, logical *found, ftnlen - frname_len, ftnlen item_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gdpool_(char *, integer *, integer *, integer *, - doublereal *, logical *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up optional array-valued double precision frame kernel */ -/* variable. The frame name or frame ID may be used as part of the */ -/* variable's name. */ - -/* If the kernel variable is not present, or if the variable */ -/* has the wrong data type, set the FOUND flag to .FALSE. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* MAXN I Maximum number of values to return. */ -/* N O Number of returned values. */ -/* VALUES O Output kernel variable. */ -/* FOUND O "Found" flag. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a numeric variable */ -/* of that name first. */ - -/* $ Detailed_Output */ - -/* N is the number of values returned in the array */ -/* VALUES. */ - -/* VALUES are the values associated with the requested */ -/* array-valued, double precision kernel variable. */ -/* The kernel variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has numeric type, the associated */ -/* values will be returned. If this variable is */ -/* not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If a numeric variable */ -/* having that name is found, the associated */ -/* values will be returned. */ - -/* VALUES is not defined if the requested kernel */ -/* variable is not found. */ - -/* FOUND is a logical flag indicating whether the requested */ -/* kernel variable was found. If the search described */ -/* above (in the detailed description of the output */ -/* argument VALUES) is successful, FOUND is set to */ -/* .TRUE.; otherwise FOUND is set to .FALSE. */ - -/* $ Parameters */ - -/* See zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 2) If either the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name has length greater than KVNMLN, */ -/* the excessively long name will not be searched for. A search */ -/* will still be done using the alternative form of the name if */ -/* that form has length less than or equal to KVNMLN. */ - -/* 3) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has character data */ -/* type, the error SPICE(BADVARIABLETYPE) will be signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than MAXN */ -/* associated values, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. This routine */ -/* is meant to look up array-valued double precision variables whose */ -/* presence is optional. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* data structure, these names are distinct. Hence kernel */ -/* variables having names of both forms, but having possibly */ -/* different attributes, can be simultaneously present in the kernel */ -/* pool. Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) A scalar-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially */ -/* mask an array-valued kernel variable matching the "name */ -/* form" of the requested name. This problem can be prevented */ -/* by sensible frame kernel design. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNOAD", (ftnlen)8); - -/* Nothing found yet. */ - - *found = FALSE_; - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, found, n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - *found = FALSE_; - } - if (! (*found)) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, found, n, dtype, (ftnlen)32, (ftnlen)1); - if (! (*found)) { - -/* The FOUND flag is set appropriately. */ - - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - -/* Rather than using BADKPV, we check the data type and cardinality */ -/* of the kernel variable in-line so we can create a more detailed */ -/* error message if need be. */ - - if (*(unsigned char *)dtype == 'C') { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have double precision data type but in fact has chara" - "cter type. Usually this type of problem is due to an error " - "in a frame definition provided in a frame kernel.", (ftnlen) - 228); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } - if (*n > *maxn) { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have size not exceeding # but in fact has size #. Usua" - "lly this type of problem is due to an error in a frame defin" - "ition provided in a frame kernel.", (ftnlen)212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", maxn, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gdpool_(kvname, &c__1, maxn, n, values, found, (ftnlen)32); - if (! (*found)) { - setmsg_("Variable # not found after DTPOOL indicated it was present " - "in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; - } - chkout_("ZZDYNOAD", (ftnlen)8); - return 0; -} /* zzdynoad_ */ - diff --git a/ext/spice/src/cspice/zzdynrot.c b/ext/spice/src/cspice/zzdynrot.c deleted file mode 100644 index 376b688f0a..0000000000 --- a/ext/spice/src/cspice/zzdynrot.c +++ /dev/null @@ -1,2443 +0,0 @@ -/* zzdynrot.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__9 = 9; -static integer c__36 = 36; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b192 = 0.; -static integer c__6 = 6; -static doublereal c_b365 = 1.; -static integer c__20 = 20; - -/* $Procedure ZZDYNROT ( Dynamic position transformation evaluation ) */ -/* Subroutine */ int zzdynrot_(integer *infram, integer *center, doublereal * - et, doublereal *rotate, integer *basfrm) -{ - /* Initialized data */ - - static char axes[1*3] = "X" "Y" "Z"; - static logical first = TRUE_; - static char itmcof[32*3] = "ANGLE_1_COEFFS " "ANGLE_2_C" - "OEFFS " "ANGLE_3_COEFFS "; - static char itmsep[32] = "ANGLE_SEP_TOL "; - static char vname[4*2] = "PRI_" "SEC_"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double sin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int zzrefch0_(integer *, integer *, doublereal *, - doublereal *); - doublereal dmob; - integer degs[3], frid; - char spec[80]; - integer targ; - doublereal oblr[9] /* was [3][3] */; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal pobs[3]; - integer axis[2]; - extern /* Subroutine */ int zzspksb0_(integer *, doublereal *, char *, - doublereal *, ftnlen); - doublereal tipm[9] /* was [3][3] */, vflt; - extern doublereal vsep_(doublereal *, doublereal *); - doublereal rinv[9] /* was [3][3] */; - extern /* Subroutine */ int zzspkez0_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vsub_(doublereal *, doublereal *, doublereal *), vequ_(doublereal - *, doublereal *); - doublereal poly[2], rnut[9] /* was [3][3] */; - extern /* Subroutine */ int zzspkzp0_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - zzdynbid_(char *, integer *, char *, integer *, ftnlen, ftnlen), - zzdynfid_(char *, integer *, char *, integer *, ftnlen, ftnlen), - zzdynoad_(char *, integer *, char *, integer *, integer *, - doublereal *, logical *, ftnlen, ftnlen), zzdynoac_(char *, - integer *, char *, integer *, integer *, char *, logical *, - ftnlen, ftnlen, ftnlen), eul2m_(doublereal *, doublereal *, - doublereal *, integer *, integer *, integer *, doublereal *), - zzcorepc_(char *, doublereal *, doublereal *, doublereal *, - ftnlen), zzmobliq_(doublereal *, doublereal *, doublereal *), - zzdynvac_(char *, integer *, char *, integer *, integer *, char *, - ftnlen, ftnlen, ftnlen), zzdynvad_(char *, integer *, char *, - integer *, integer *, doublereal *, ftnlen, ftnlen), zzdynvai_( - char *, integer *, char *, integer *, integer *, integer *, - ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer n, frcid; - doublereal radii[3], delta; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen); - doublereal epoch; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static integer earth; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal pnear[3]; - integer frcls, iaxes[3]; - doublereal rprec[9] /* was [3][3] */; - static char itmra[32*2]; - integer cvobs, frctr; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - errdp_(char *, doublereal *, ftnlen); - doublereal ptemp[3], rtemp[9] /* was [3][3] */, stemp[6], stobs[6]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int xpose_(doublereal *, doublereal *); - char units[80]; - doublereal nutxf[36] /* was [6][6] */, t0; - extern /* Subroutine */ int bodn2c_(char *, integer *, logical *, ftnlen); - doublereal v2[6] /* was [3][2] */; - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - doublereal ra; - extern logical failed_(void); - logical meanec; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - char vecdef[80*2]; - static char itmabc[32*2]; - char basnam[32]; - doublereal lt; - logical negate; - static char itmdec[32*2]; - doublereal coeffs[60] /* was [20][3] */; - char inname__[32], abcorr[5], axname[80]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - char cfrmnm[32], ctrnam[36], cvcorr[5], dynstl[80], dynfam[80]; - static char itmaxe[32*2], itmfrm[32*2], itmlat[32*2], itmlon[32*2], - itmobs[32*2], itmspc[32*2], itmtrg[32*2], itmunt[32*2], itmvdf[32* - 2], itmvec[32*2]; - char nutmod[80], oblmod[80], prcmod[80], rotsta[80], timstr[50], tmpfam[ - 80], velfrm[32]; - doublereal angles[2], ctrpos[3], dec, dirvec[3], eulang[3], fet, alt, lat, - minsep, mob, precxf[36] /* was [6][6] */, r2000[9] /* - was [3][3] */; - integer cfrmid; - doublereal sep, lon; - static integer j2000; - integer obs; - logical corblk[15], fnd; - doublereal vet; - logical frozen, meaneq, ofdate, trueeq; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), frmnam_( - integer *, char *, ftnlen), chkout_(char *, ftnlen), cmprss_(char - *, integer *, char *, char *, ftnlen, ftnlen, ftnlen), setmsg_( - char *, ftnlen), sigerr_(char *, ftnlen), intstr_(integer *, char - *, ftnlen), mxm_(doublereal *, doublereal *, doublereal *), - errint_(char *, integer *, ftnlen), frinfo_(integer *, integer *, - integer *, integer *, logical *), mxv_(doublereal *, doublereal *, - doublereal *), cidfrm_(integer *, integer *, char *, logical *, - ftnlen), bodvcd_(integer *, char *, integer *, integer *, - doublereal *, ftnlen), vminus_(doublereal *, doublereal *), - nearpt_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *), convrt_(doublereal *, char *, char *, - doublereal *, ftnlen, ftnlen), latrec_(doublereal *, doublereal * - , doublereal *, doublereal *), stlabx_(doublereal *, doublereal *, - doublereal *), stelab_(doublereal *, doublereal *, doublereal *), - twovec_(doublereal *, integer *, doublereal *, integer *, - doublereal *), polyds_(doublereal *, integer *, integer *, - doublereal *, doublereal *), zzeprc76_(doublereal *, doublereal *) - , zzenut80_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* For a specified dynamic frame, find the rotation that maps */ -/* positions from the dynamic frame to its base frame. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* PCK */ -/* SPK */ - -/* $ Keywords */ - -/* FRAMES */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRAM I Class ID code for a SPICE dynamic reference frame. */ -/* CENTER I ID code for the center of the input frame. */ -/* ET I An epoch in seconds past J2000 TDB. */ -/* ROTATE O The requested rotation matrix. */ -/* BASFRM O Frame ID of base frame associated with INFRAM. */ - -/* $ Detailed_Input */ - -/* INFRAM is the frame ID code for a dynamic reference frame. */ -/* Note that this interface differs from that of TKFRAM, */ -/* which uses a class ID to identify the frame. */ - -/* In this routine, we refer this frame both as the */ -/* "input frame" and the "defined frame." */ - -/* CENTER is NAIF ID code for the center of the frame */ -/* designated by INFRAM. This code, although derivable */ -/* from INFRAM, is passed in for convenience. */ - -/* ET is an epoch in ephemeris seconds past J2000 for which */ -/* the caller requests a rotation matrix. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3x3 rotation matrix that transforms positions */ -/* relative to INFRAM to positions relative to BASFRM. */ - -/* BASFRM is the frame ID code of the base frame associated */ -/* with INFRAM. The 3x3 matrix ROTATE transforms */ -/* positions relative to INFRAM to positions relative to */ -/* BASFRM. The position transformation is performed by */ -/* left-multiplying by ROTATE a position expressed */ -/* relative to INFRAM. This is easily accomplished via */ -/* the subroutine call shown below. */ - -/* CALL MXV ( ROTATE, INPOS, OUTPOS ) */ - -/* $ Parameters */ - -/* See include file zzdyn.inc. */ - -/* $ Files */ - -/* 1) SPK files containing data for each observer and target */ -/* are required to support two-vector frames. Note that */ -/* observer-target pairs can be implicit, as in the case */ -/* of a constant vector whose frame is evaluated at a */ -/* light-time corrected epoch: the light time the frame */ -/* center to an observer must be computable in this case, */ -/* which implies the state of the frame center as seen by */ -/* the observer must be computable. */ - -/* 2) Any of SPK, CK, PCK, and frame kernels will also be required */ -/* if any frames referenced in the definition of INFRAM (as a */ -/* base frame, velocity vector frame, or constant vector frame) */ -/* require them, or if any vectors used to define INFRAM require */ -/* these data in order to be computable. */ - -/* 3) When CK data are required, one or more associated SCLK kernels */ -/* ---normally, one kernel per spacecraft clock---are */ -/* required as well. A leapseconds kernel may be required */ -/* whenever an SCLK kernel is required. */ - -/* 4) When a two-vector frame is defined using a target near point, */ -/* a PCK file giving orientation and providing a triaxial shape */ -/* model for the target body is required. */ - - -/* $ Exceptions */ - -/* 1) If a dynamic frame evaluation requires unavailable kernel */ -/* data, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 2) If a precession model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 3) If a nutation model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 4) If an obliquity model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 5) If an unrecognized precession model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 6) If an unrecognized nutation model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 7) If an unrecognized obliquity model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 8) If an attempt to look up the center of a frame does */ -/* not yield data, the error SPICE(FRAMEDATANOTFOUND) is */ -/* signaled. */ - -/* 9) In a two-vector frame definition, if a constant vector */ -/* specification method is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 10) In a two-vector frame definition, if a vector definition */ -/* method is not recognized, the error SPICE(NOTSUPPORTED) */ -/* is signaled. */ - -/* 11) If an unrecognized dynamic frame family is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 12) If an unrecognized dynamic frame definition style is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 13) If an unrecognized dynamic frame rotation state is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 14) If both a freeze epoch and a rotation state are specified, */ -/* the error SPICE(FRAMEDEFERROR) is signaled. */ - -/* 15) If neither a freeze epoch nor a rotation state are specified */ -/* for an "of date" frame, the error SPICE(FRAMEDEFERROR) is */ -/* signaled. */ - -/* 16) In a two-vector frame definition, if an invalid axis */ -/* specification is encountered, the error SPICE(INVALIDAXIS) is */ -/* signaled. */ - -/* 17) In a two-vector frame definition using a target near point */ -/* vector, if the body-fixed frame associated with the target */ -/* is not found, the error SPICE(FRAMEDATANOTFOUND) is signaled. */ - -/* 18) If a dynamic frame evaluation requires excessive recursion */ -/* depth, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 19) When a two-vector dynamic frame is evaluated, if the */ -/* primary and secondary vectors have angular separation less */ -/* than the minimum allowed value, or if the angular separation */ -/* differs from Pi by less than the minimum allowed value, the */ -/* error SPICE(DEGENERATECASE) is signaled. The default minimum */ -/* separation is given by the parameter LBSEP; this value may be */ -/* overridden by supplying a different value in the frame */ -/* definition. */ - -/* 20) If invalid units occur in a frame definition, the error */ -/* will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 21) If an invalid Euler axis sequence occurs in a frame */ -/* definition, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* $ Particulars */ - -/* Currently only parameterized dynamic frames are supported by */ -/* this routine. */ - -/* Currently supported parameterized dynamic families are: */ - -/* Two-vector */ -/* ========== */ - -/* Vector definitions */ -/* ------------------ */ -/* Observer-target position */ -/* Observer-target velocity */ -/* Near point on target */ -/* Constant vector in specified frame */ - - -/* Mean Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ - - -/* Mean Ecliptic and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU mean obliquity model */ - - -/* True Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU nutation model */ - - -/* Euler frames */ -/* ============ */ - -/* Euler angle definitions */ -/* ----------------------- */ -/* Polynomial */ - - -/* $ Examples */ - -/* See ROTGET. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) Many numerical problems can occur when dynamic frames */ -/* are evaluated. Users must determine whether dynamic frame */ -/* definitions are suitable for their applications. See the */ -/* Exceptions section for a list of possible problems. */ - -/* 3) Two-vector frame definitions can suffer extreme loss of */ -/* precision due to near-singular geometry. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 24-OCT-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ were renamed to KVX, KVY, KVZ. */ - -/* Call to ZZBODVCD was replaced with call to BODVCD. */ - -/* - SPICELIB Version 1.0.0, 10-JAN-2005 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNROT", (ftnlen)8); - if (first) { - -/* Get the ID code for the J2000 frame. */ - - irfnum_("J2000", &j2000, (ftnlen)5); - -/* Get the ID code for the earth (we needn't check the found */ -/* flag). */ - - bodn2c_("EARTH", &earth, &fnd, (ftnlen)5); - -/* Initialize "item" strings used to create kernel variable */ -/* names. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Vector axis: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 502)) << 2); - i__3[1] = 4, a__1[1] = "AXIS"; - s_cat(itmaxe + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmaxe", i__1, "zzdynrot_", (ftnlen)502)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector definition: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 506)) << 2); - i__3[1] = 10, a__1[1] = "VECTOR_DEF"; - s_cat(itmvdf + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvdf", i__1, "zzdynrot_", (ftnlen)506)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector aberration correction: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 510)) << 2); - i__3[1] = 6, a__1[1] = "ABCORR"; - s_cat(itmabc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmabc", i__1, "zzdynrot_", (ftnlen)510)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector frame: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 514)) << 2); - i__3[1] = 5, a__1[1] = "FRAME"; - s_cat(itmfrm + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmfrm", i__1, "zzdynrot_", (ftnlen)514)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector observer: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 518)) << 2); - i__3[1] = 8, a__1[1] = "OBSERVER"; - s_cat(itmobs + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynrot_", (ftnlen)518)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector target: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 522)) << 2); - i__3[1] = 6, a__1[1] = "TARGET"; - s_cat(itmtrg + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmtrg", i__1, "zzdynrot_", (ftnlen)522)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector longitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 526)) << 2); - i__3[1] = 9, a__1[1] = "LONGITUDE"; - s_cat(itmlon + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlon", i__1, "zzdynrot_", (ftnlen)526)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector latitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 530)) << 2); - i__3[1] = 8, a__1[1] = "LATITUDE"; - s_cat(itmlat + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlat", i__1, "zzdynrot_", (ftnlen)530)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector right ascension: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 534)) << 2); - i__3[1] = 2, a__1[1] = "RA"; - s_cat(itmra + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynrot_", (ftnlen)534)) << 5), a__1, - i__3, &c__2, (ftnlen)32); - -/* Vector declination: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 538)) << 2); - i__3[1] = 3, a__1[1] = "DEC"; - s_cat(itmdec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmdec", i__1, "zzdynrot_", (ftnlen)538)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector units: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 542)) << 2); - i__3[1] = 5, a__1[1] = "UNITS"; - s_cat(itmunt + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmunt", i__1, "zzdynrot_", (ftnlen)542)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector coordinate specification: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 546)) << 2); - i__3[1] = 4, a__1[1] = "SPEC"; - s_cat(itmspc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmspc", i__1, "zzdynrot_", (ftnlen)546)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector in cartesian coordinates, literal value: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrot_", (ftnlen) - 550)) << 2); - i__3[1] = 6, a__1[1] = "VECTOR"; - s_cat(itmvec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvec", i__1, "zzdynrot_", (ftnlen)550)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - } - first = FALSE_; - } - -/* Initialize the output arguments. */ - - cleard_(&c__9, rotate); - *basfrm = 0; - -/* Initialize certain variables to ensure that we don't do */ -/* arithmetic operations using bogus, possibly large, */ -/* undefined values. */ - - cleard_(&c__36, nutxf); - cleard_(&c__9, oblr); - cleard_(&c__36, precxf); - cleard_(&c__9, r2000); - cleard_(&c__9, rtemp); - cleard_(&c__9, rinv); - cleard_(&c__9, tipm); - mob = 0.; - dmob = 0.; - t0 = 0.; - frozen = FALSE_; - -/* Get the input frame name. */ - - frmnam_(infram, inname__, (ftnlen)32); - -/* We need the name of the base frame. */ - - zzdynfid_(inname__, infram, "RELATIVE", basfrm, (ftnlen)32, (ftnlen)8); - frmnam_(basfrm, basnam, (ftnlen)32); - -/* The output frame code and name are set. */ - -/* Look up the dynamic frame definition style from the kernel pool. */ -/* The kernel variable's name might be specified by name or ID. */ - - zzdynvac_(inname__, infram, "DEF_STYLE", &c__1, &n, dynstl, (ftnlen)32, ( - ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* At this time, the only supported dynamic frame definition style is */ -/* PARAMETERIZED. */ - - if (eqstr_(dynstl, "PARAMETERIZED", (ftnlen)80, (ftnlen)13)) { - -/* Parameterized dynamic frames belong to families. Look up */ -/* the family for this frame. */ - - zzdynvac_(inname__, infram, "FAMILY", &c__1, &n, dynfam, (ftnlen)32, ( - ftnlen)6, (ftnlen)80); - cmprss_(" ", &c__0, dynfam, tmpfam, (ftnlen)1, (ftnlen)80, (ftnlen)80) - ; - ucase_(tmpfam, dynfam, (ftnlen)80, (ftnlen)80); - -/* Determine whether we have an "of-date" frame family. */ -/* The logical flags used here and respective meanings are: */ - -/* MEANEQ Mean equator and equinox of date */ -/* TRUEEQ True equator and equinox of date */ -/* MEANEC Mean ecliptic and equinox of date */ - - meaneq = s_cmp(dynfam, "MEAN_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - trueeq = s_cmp(dynfam, "TRUE_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - meanec = s_cmp(dynfam, "MEAN_ECLIPTIC_AND_EQUINOX_OF_DATE", (ftnlen) - 80, (ftnlen)33) == 0; - ofdate = meaneq || meanec || trueeq; - -/* Set the evaluation epoch T0. Normally this epoch is ET, */ -/* but if the frame is frozen, the freeze epoch from the */ -/* frame definition is used. */ - -/* Read the freeze epoch into T0 if a freeze epoch was */ -/* specified; let FROZEN receive the FOUND flag value */ -/* returned by ZZDYNOAD. */ - - zzdynoad_(inname__, infram, "FREEZE_EPOCH", &c__1, &n, &t0, &frozen, ( - ftnlen)32, (ftnlen)12); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (! frozen) { - -/* Normal case: just use the input epoch. */ - - t0 = *et; - } - -/* Look up the rotation state keyword. In this routine, */ -/* the rotation state keyword is examined only to support */ -/* semantic checking: there's no use made of the fact that */ -/* the rotation state is 'ROTATING' or 'INERTIAL'. */ - - zzdynoac_(inname__, infram, "ROTATION_STATE", &c__1, &n, rotsta, &fnd, - (ftnlen)32, (ftnlen)14, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (fnd) { - -/* Catch invalid rotation states here. */ - - if (! eqstr_(rotsta, "ROTATING", (ftnlen)80, (ftnlen)8) && ! - eqstr_(rotsta, "INERTIAL", (ftnlen)80, (ftnlen)8)) { - setmsg_("Definition of frame # contains # specification #. T" - "he only valid rotation states are # or #. This situa" - "tion is usually caused by an error in a frame kernel" - " in which the frame is defined.", (ftnlen)186); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - errch_("#", rotsta, (ftnlen)1, (ftnlen)80); - errch_("#", "ROTATING", (ftnlen)1, (ftnlen)8); - errch_("#", "INERTIAL", (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - } - - -/* If the frame is frozen, the rotation state keyword *must be */ -/* absent*. */ - - if (frozen && fnd) { - setmsg_("Definition of frame # contains both # and # keywords; a" - "t most one of these must be present in the frame definit" - "ion. This situation is usually caused by an error in a f" - "rame kernel in which the frame is defined.", (ftnlen)209); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* If the frame belongs to an "of date" family, either the */ -/* rotation state must be specified or the frame must be */ -/* frozen. */ - - if (ofdate && ! frozen && ! fnd) { - setmsg_("Definition of frame #, which belongs to parameterized d" - "ynamic frame family #, contains neither # nor # keywords" - "; frames in this family require exactly one of these in " - "their frame definitions. This situation is usually cause" - "d by an error in a frame kernel in which the frame is de" - "fined.", (ftnlen)285); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* The evaluation epoch T0 is set. */ - -/* In this routine, unlike its companion ZZDYNFRM, there is no */ -/* need to make further reference to the rotation state. Hence */ -/* the flag INERT used in ZZDYNFRM doesn't appear here. */ - -/* The following code block performs actions specific to */ -/* the various dynamic frame families. */ - - if (ofdate) { - -/* Fetch the name of the true equator and equinox of date */ -/* precession model. */ - - zzdynvac_(inname__, infram, "PREC_MODEL", &c__1, &n, prcmod, ( - ftnlen)32, (ftnlen)10, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Get the precession transformation. */ - - if (eqstr_(prcmod, "EARTH_IAU_1976", (ftnlen)80, (ftnlen)14)) { - -/* This is the 1976 IAU earth precession model. */ - -/* Make sure the center of the input frame is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame center # " - "and precession model #. This precession model is" - " not applicable to body #. This situation is usu" - "ally caused by an error in a frame kernel in whi" - "ch the frame is defined.", (ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1976", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Look up the precession transformation. Extract */ -/* the precession rotation matrix. */ - - zzeprc76_(&t0, precxf); - moved_(precxf, &c__3, rprec); - moved_(&precxf[6], &c__3, &rprec[3]); - moved_(&precxf[12], &c__3, &rprec[6]); - -/* If we're in the mean-of-date case, invert this */ -/* transformation to obtain the mapping from the */ -/* mean-of-date frame to J2000. */ - - if (meaneq) { - xpose_(rprec, rtemp); - } - } else { - setmsg_("Definition of frame # specifies precession model #," - " which is not recognized. This situation is usually " - "caused by an error in a frame kernel in which the fr" - "ame is defined.", (ftnlen)170); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", prcmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* At this point the precession transformation REPREC is set. */ -/* If INFRAM is a mean equator and equinox of date frame, the */ -/* inverse of REPREC is currently stored in RTEMP. */ - if (trueeq) { - -/* We need a nutation transformation as well. Get the name */ -/* of the nutation model. */ - - zzdynvac_(inname__, infram, "NUT_MODEL", &c__1, &n, nutmod, ( - ftnlen)32, (ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Get the nutation transformation. */ - - if (eqstr_(nutmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth nutation model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and nutation model #. This nutation mode" - "l is not applicable to body #. This situati" - "on is usually caused by an error in a frame " - "kernel in which the frame is defined.", ( - ftnlen)212); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Look up the nutation transformation. Extract */ -/* the nutation rotation matrix. */ - - zzenut80_(&t0, nutxf); - moved_(nutxf, &c__3, rnut); - moved_(&nutxf[6], &c__3, &rnut[3]); - moved_(&nutxf[12], &c__3, &rnut[6]); - -/* Find the rotation from the J2000 frame to the earth */ -/* true of date frame. Invert. */ - - mxm_(rnut, rprec, rinv); - xpose_(rinv, rtemp); - } else { - setmsg_("Definition of frame # specifies nutation model " - "#, which is not recognized. This situation is us" - "ually caused by an error in a frame kernel in wh" - "ich the frame is defined.", (ftnlen)168); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", nutmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - } else if (meanec) { - -/* We need a mean obliquity transformation as well. */ -/* Get the name of the obliquity model. */ - - zzdynvac_(inname__, infram, "OBLIQ_MODEL", &c__1, &n, oblmod, - (ftnlen)32, (ftnlen)11, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Get the obliquity transformation. */ - - if (eqstr_(oblmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth mean obliquity of */ -/* date model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and obliquity model #. This obliquity m" - "odel is not applicable to body #. This situa" - "tion is usually caused by an error in a fram" - "e kernel in which the frame is defined.", ( - ftnlen)214); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Create the obliquity transformation. */ -/* First look up the obliquity state. */ - - zzmobliq_(&t0, &mob, &dmob); - -/* The obliquity rotation is about the mean-of-date */ -/* x-axis. The other Euler angles are identically */ -/* zero; the axes are arbitrary, as long as the */ -/* middle axis is distinct from the other two. */ - - eul2m_(&c_b192, &c_b192, &mob, &c__1, &c__3, &c__1, oblr); - -/* Find the rotation from the J2000 to the */ -/* earth mean ecliptic of date frame. Invert. */ - - mxm_(oblr, rprec, rinv); - xpose_(rinv, rtemp); - } else { - setmsg_("Definition of frame # specifies obliquity model" - " #, which is not recognized. This situation is u" - "sually caused by an error in a frame kernel in w" - "hich the frame is defined.", (ftnlen)169); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", oblmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - } - -/* At this point, RTEMP contains the rotation from the */ -/* specified mean of date or true of date frame to J2000. */ - -/* If the base frame is not J2000, we must find the */ -/* transformation from J2000 to the base frame. */ - if (*basfrm != j2000) { - zzrefch0_(&j2000, basfrm, &t0, r2000); - mxm_(r2000, rtemp, rotate); - } else { - -/* Otherwise, RTEMP is the matrix we want. */ - - moved_(rtemp, &c__9, rotate); - } - -/* Now ROTATE is the state transformation mapping from */ -/* the input frame INFRAM to the base frame BASFRM. */ - -/* This is the end of the work specific to "of-date" frames. */ -/* From here we drop out of the IF block. */ - - } else if (s_cmp(dynfam, "TWO-VECTOR", (ftnlen)80, (ftnlen)10) == 0) { - -/* The frame belongs to the TWO-VECTOR family. */ - -/* Fetch the specifications of the primary and secondary */ -/* axes. */ - - cleard_(&c__6, v2); - for (i__ = 1; i__ <= 2; ++i__) { - -/* Get the name of the axis associated with the Ith */ -/* defining vector. */ - - zzdynvac_(inname__, infram, itmaxe + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmaxe", i__1, "zzdynrot_" - , (ftnlen)1058)) << 5), &c__1, &n, axname, (ftnlen)32, - (ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(axname, axname, (ftnlen)80, (ftnlen)80); - -/* Set the sign flag associated with the axis. */ - - negate = *(unsigned char *)axname == '-'; - cmprss_("-", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - cmprss_("+", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("axis", - i__1, "zzdynrot_", (ftnlen)1071)] = isrchc_(axname, & - c__3, axes, (ftnlen)80, (ftnlen)1); - if (axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "axis", i__1, "zzdynrot_", (ftnlen)1074)] == 0) { - setmsg_("Definition of frame # associates vector # with " - "axis #. The only valid axis values are { X, -X," - " Y, -Y, Z, -Z }. This situation is usually cause" - "d by an error in a frame kernel in which the fra" - "me is defined.", (ftnlen)205); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &i__, (ftnlen)1); - errch_("#", axname, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDAXIS)", (ftnlen)18); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Find out how the vector is defined: */ - -/* - Observer-target position vector */ -/* - Observer-target velocity vector */ -/* - Observer-target near point vector */ -/* - Constant vector */ - -/* VECDEF(I) indicates the vector definition method */ -/* for the Ith vector. */ - - zzdynvac_(inname__, infram, itmvdf + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmvdf", i__1, "zzdynrot_" - , (ftnlen)1103)) << 5), &c__1, &n, vecdef + ((i__2 = - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("vecdef", - i__2, "zzdynrot_", (ftnlen)1103)) * 80, (ftnlen)32, ( - ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, vecdef + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("vecdef", i__1, "zzdynrot_", ( - ftnlen)1106)) * 80, vecdef + ((i__2 = i__ - 1) < 2 && - 0 <= i__2 ? i__2 : s_rnge("vecdef", i__2, "zzdynrot_", - (ftnlen)1106)) * 80, (ftnlen)1, (ftnlen)80, (ftnlen) - 80); - ucase_(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynrot_", (ftnlen)1107)) * - 80, vecdef + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("vecdef", i__2, "zzdynrot_", (ftnlen) - 1107)) * 80, (ftnlen)80, (ftnlen)80); - if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynrot_", (ftnlen)1110)) * - 80, "OBSERVER_TARGET_POSITION", (ftnlen)80, (ftnlen) - 24) == 0) { - -/* The vector is the position of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynrot_", (ftnlen)1117)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynrot_", (ftnlen)1119)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrot_", (ftnlen)1121)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* Look up the Ith position vector in the J2000 frame. */ - - zzspkzp0_(&targ, &t0, "J2000", abcorr, &obs, &v2[(i__1 = - i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "v2", i__1, "zzdynrot_", (ftnlen)1127)], <, ( - ftnlen)5, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* At this point, V2(*,I) contains position relative to */ -/* frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrot_", (ftnlen) - 1140)) * 80, "OBSERVER_TARGET_VELOCITY", (ftnlen)80, ( - ftnlen)24) == 0) { - -/* The vector is the velocity of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynrot_", (ftnlen)1147)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynrot_", (ftnlen)1149)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrot_", (ftnlen)1151)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* We need to know the frame in which the velocity is */ -/* defined. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynrot_", (ftnlen)1158)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - frmnam_(&frid, velfrm, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Look up the Ith velocity vector in the velocity frame. */ - - zzspkez0_(&targ, &t0, velfrm, abcorr, &obs, stemp, <, ( - ftnlen)32, (ftnlen)5); - -/* We'll work with the unit velocity vector. */ - - vhat_(&stemp[3], &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrot_", ( - ftnlen)1175)]); - -/* We need the epoch VET at which VELFRM is evaluated. */ -/* This epoch will be used to transform the velocity */ -/* vector from VELFRM to J2000. */ - -/* Set the default value of VET here. */ - - vet = t0; - -/* Parse the aberration correction. Capture the */ -/* epoch used to evaluate the velocity vector's frame. */ - - zzprscor_(abcorr, corblk, (ftnlen)5); - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the velocity vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the velocity frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame ass" - "ociated with a velocity vector has frame" - " ID code #, but no frame center, frame c" - "lass, or frame class ID was found by FRI" - "NFO. This situation MAY be caused by an" - " error in a frame kernel in which the fr" - "ame is defined. The problem also could b" - "e indicative of a SPICELIB bug.", (ftnlen) - 310); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (frcls != 1) { - -/* Obtain light time from the observer to the */ -/* frame's center. */ - - zzspkzp0_(&frctr, &t0, "J2000", abcorr, &obs, - ctrpos, &vflt, (ftnlen)5, (ftnlen)5); - zzcorepc_(abcorr, &t0, &vflt, &vet, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - } - } else { - -/* No aberration correction was specified. Evaluate */ -/* the frame at T0. */ - - vet = t0; - } - -/* The velocity frame evaluation epoch VET is now set. */ - -/* We must rotate the velocity vector from the velocity */ -/* frame (evaluated at VET) to the output frame at T0. */ -/* We'll do this in two stages, first mapping velocity */ -/* into the J2000 frame. */ - - if (frid != j2000) { - zzrefch0_(&frid, &j2000, &vet, r2000); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - mxv_(r2000, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 - ? i__1 : s_rnge("v2", i__1, "zzdynrot_", ( - ftnlen)1267)], ptemp); - moved_(ptemp, &c__3, &v2[(i__1 = i__ * 3 - 3) < 6 && - 0 <= i__1 ? i__1 : s_rnge("v2", i__1, "zzdyn" - "rot_", (ftnlen)1268)]); - } - -/* At this point, V2(*,I) contains velocity */ -/* relative to frame J2000. */ - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrot_", (ftnlen) - 1277)) * 80, "TARGET_NEAR_POINT", (ftnlen)80, (ftnlen) - 17) == 0) { - -/* The vector points from an observer to the near */ -/* point to the observer on the target body. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynrot_", (ftnlen)1284)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynrot_", (ftnlen)1286)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrot_", (ftnlen)1288)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* The vector points from an observer to the */ -/* sub-observer point (nearest point to the observer) on */ -/* the target body. We need the position of the near */ -/* point relative to the observer. */ - -/* We'll look up the position of the target center */ -/* relative to the observer, as well as the position of */ -/* the near point relative to the target center, both in */ -/* the body-fixed frame associated with the target. */ - -/* Look up the body-fixed frame associated with the */ -/* target body. */ - - cidfrm_(&targ, &cfrmid, cfrmnm, &fnd, (ftnlen)32); - if (! fnd) { - setmsg_("Definition of frame # requires definition o" - "f body-fixed frame associated with target bo" - "dy #. A call to CIDFRM indicated no body-fix" - "ed frame is associated with the target body." - " This situation can arise when a frame kern" - "el defining the target's body-fixed frame l" - "acks the OBJECT__FRAME or OBJECT__" - "FRAME keywords. The problem also could be c" - "aused by an error in a frame kernel in which" - " the parameterized two-vector dynamic frame " - "# is defined.", (ftnlen)452); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &targ, (ftnlen)1); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Get the radii of the target body. */ - - bodvcd_(&targ, "RADII", &c__3, &n, radii, (ftnlen)5); - -/* Look up the Ith position vector in the target-fixed */ -/* frame. Negate the vector to obtain the target-to- */ -/* observer vector. */ - - zzspkzp0_(&targ, &t0, cfrmnm, abcorr, &obs, ptemp, <, ( - ftnlen)32, (ftnlen)5); - -/* We check FAILED() here because VMINUS is a simple */ -/* arithmetic routine that doesn't return on entry. */ - - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - vminus_(ptemp, pobs); - nearpt_(pobs, radii, &radii[1], &radii[2], pnear, &alt); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Find the observer-near point vector in the current */ -/* frame CFRMNM. */ - - vsub_(pnear, pobs, ptemp); - -/* Rotate the vector to frame J2000. To get the required */ -/* rotation matrix, we'll need to obtain the epoch */ -/* associated with CNMFRM. Parse the aberration */ -/* correction and adjust the frame evaluation epoch as */ -/* needed. */ - - zzcorepc_(abcorr, &t0, <, &fet, (ftnlen)5); - -/* Obtain the matrix for transforming position vectors */ -/* from the target center frame to the J2000 frame and */ -/* apply it to the observer-to-near point position */ -/* vector. */ - - zzrefch0_(&cfrmid, &j2000, &fet, tipm); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - mxv_(tipm, ptemp, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrot_", ( - ftnlen)1395)]); - -/* At this point, V2(*,I) contains position of the near */ -/* point on the target as seen by the observer, relative */ -/* to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrot_", (ftnlen) - 1403)) * 80, "CONSTANT", (ftnlen)80, (ftnlen)8) == 0) - { - -/* The vector is constant in a specified frame. */ - -/* We need a 3-vector and an associated reference */ -/* frame relative to which the vector is specified. */ - -/* Look up the ID of the frame first. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynrot_", (ftnlen)1412)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - -/* Let FET ("frame ET") be the evaluation epoch for */ -/* the constant vector's frame. By default, this */ -/* frame is just T0, but if we're using light time */ -/* corrections, FET must be adjusted for one-way */ -/* light time between the frame's center and the */ -/* observer. */ - -/* Set the default value of FET here. */ - - fet = t0; - -/* Optionally, there is an aberration correction */ -/* associated with the constant vector's frame. */ -/* If so, an observer must be associated with the */ -/* frame. Look up the correction first. */ - - zzdynoac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrot_", (ftnlen)1432)) << 5), &c__1, &n, - cvcorr, &fnd, (ftnlen)32, (ftnlen)32, (ftnlen)5); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (! fnd) { - s_copy(cvcorr, "NONE", (ftnlen)5, (ftnlen)4); - } - zzprscor_(cvcorr, corblk, (ftnlen)5); - if (! corblk[0]) { - -/* We need to apply an aberration correction to */ -/* the constant vector. */ - zzprscor_(cvcorr, corblk, (ftnlen)5); - -/* Check for errors in the aberration correction */ -/* specification. */ - -/* - Light time and stellar aberration corrections */ -/* are mutually exclusive. */ - - if (corblk[1] && corblk[2]) { - setmsg_("Definition of frame # specifies aberrat" - "ion correction # for constant vector. L" - "ight time and stellar aberration correct" - "ions are mutually exclusive for constant" - " vectors used in two-vector parameterize" - "d dynamic frame definitions. This situa" - "tion is usually caused by an error in a " - "frame kernel in which the frame is defin" - "ed.", (ftnlen)322); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", cvcorr, (ftnlen)1, (ftnlen)5); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the constant vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the constant vector frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame" - " associated with a constant vector h" - "as frame ID code #, but no frame cen" - "ter, frame class, or frame class ID " - "was found by FRINFO. This situation" - " MAY be caused by an error in a fram" - "e kernel in which the frame is defin" - "ed. The problem also could be indica" - "tive of a SPICELIB bug.", (ftnlen)310) - ; - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen) - 24); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (frcls != 1) { - -/* Look up the observer associated with the */ -/* constant vector's frame. This observer, */ -/* together with the frame's center, determines */ -/* the evaluation epoch for the frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynrot_", ( - ftnlen)1525)) << 5), &cvobs, (ftnlen) - 32, (ftnlen)32); - -/* Obtain light time from the observer to the */ -/* frame's center. */ - - zzspkzp0_(&frctr, &t0, "J2000", cvcorr, & - cvobs, ctrpos, <, (ftnlen)5, ( - ftnlen)5); - -/* Find the evaluation epoch for the frame. */ - - zzcorepc_(cvcorr, &t0, <, &fet, (ftnlen)5); - } - } else if (corblk[2]) { - -/* Stellar aberration case. */ - -/* The constant vector must be corrected for */ -/* stellar aberration induced by the observer's */ -/* velocity relative to the solar system */ -/* barycenter. First, find this velocity in */ -/* the J2000 frame. We'll apply the correction */ -/* later, when the constant vector has been */ -/* transformed to the J2000 frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmobs", i__1, "zzdynrot_", (ftnlen)1555) - ) << 5), &cvobs, (ftnlen)32, (ftnlen)32); - zzspksb0_(&cvobs, &t0, "J2000", stobs, (ftnlen)5); - } - } - -/* Get the constant vector specification. */ - - zzdynvac_(inname__, infram, itmspc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmspc", i__1, - "zzdynrot_", (ftnlen)1567)) << 5), &c__1, &n, - spec, (ftnlen)32, (ftnlen)32, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - cmprss_(" ", &c__0, spec, spec, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(spec, spec, (ftnlen)80, (ftnlen)80); - if (s_cmp(spec, "RECTANGULAR", (ftnlen)80, (ftnlen)11) == - 0) { - -/* The coordinate system is rectangular. */ - -/* Look up the constant vector. */ - - zzdynvad_(inname__, infram, itmvec + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmvec", - i__1, "zzdynrot_", (ftnlen)1584)) << 5), & - c__3, &n, dirvec, (ftnlen)32, (ftnlen)32); - } else if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen) - 11) == 0 || s_cmp(spec, "RA/DEC", (ftnlen)80, ( - ftnlen)6) == 0) { - -/* The coordinate system is latitudinal or RA/DEC. */ - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, itmunt + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmunt", - i__1, "zzdynrot_", (ftnlen)1595)) << 5), & - c__1, &n, units, (ftnlen)32, (ftnlen)32, ( - ftnlen)80); - if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen)11) - == 0) { - -/* Look up longitude and latitude. */ - - zzdynvad_(inname__, infram, itmlon + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlon", i__1, "zzdynrot_", (ftnlen)1603) - ) << 5), &c__1, &n, &lon, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmlat + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlat", i__1, "zzdynrot_", (ftnlen)1606) - ) << 5), &c__1, &n, &lat, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&lon, units, "RADIANS", angles, (ftnlen) - 80, (ftnlen)7); - convrt_(&lat, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } else { - -/* Look up RA and DEC. */ - - zzdynvad_(inname__, infram, itmra + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynrot_", (ftnlen)1619)) - << 5), &c__1, &n, &ra, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmdec + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmdec", i__1, "zzdynrot_", (ftnlen)1622) - ) << 5), &c__1, &n, &dec, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&ra, units, "RADIANS", angles, (ftnlen)80, - (ftnlen)7); - convrt_(&dec, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Now produce a direction vector. */ - - latrec_(&c_b365, angles, &angles[1], dirvec); - } else { - setmsg_("Definition of two-vector parameterized dyna" - "mic frame # includes constant vector specifi" - "cation #, which is not supported. This situ" - "ation is usually caused by an error in a fra" - "me kernel in which the frame is defined.", ( - ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", spec, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* At this point, the cartesian coordinates of the */ -/* vector relative to the constant vector frame */ -/* are stored in DIRVEC. */ - - if (frid == j2000) { - vequ_(dirvec, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrot_", - (ftnlen)1669)]); - } else { - -/* Convert the direction vector to the J2000 frame. */ - - zzrefch0_(&frid, &j2000, &fet, r2000); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - mxv_(r2000, dirvec, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 - <= i__1 ? i__1 : s_rnge("v2", i__1, "zzdynro" - "t_", (ftnlen)1682)]); - } - -/* The constant vector is now represented */ -/* in the J2000 frame, but we may still need to */ -/* apply a stellar aberration correction. */ - - if (corblk[2]) { - -/* Perform the correction appropriate to the */ -/* radiation travel sense. */ - - if (corblk[4]) { - -/* The correction is for transmission. */ - - stlabx_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 - ? i__1 : s_rnge("v2", i__1, "zzdynrot_", ( - ftnlen)1700)], &stobs[3], ptemp); - } else { - -/* The correction is for reception. */ - - stelab_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 - ? i__1 : s_rnge("v2", i__1, "zzdynrot_", ( - ftnlen)1706)], &stobs[3], ptemp); - } - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - vequ_(ptemp, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrot_", - (ftnlen)1715)]); - } - -/* At this point, V2(*,I) contains the constant */ -/* (constant relative to its associated frame, that is) */ -/* vector as seen by the observer, relative to frame */ -/* J2000. */ - - } else { - setmsg_("Definition of two-vector parameterized dynamic " - "frame # includes vector definition #, which is n" - "ot supported. This situation is usually caused " - "by an error in a frame kernel in which the frame" - " is defined.", (ftnlen)203); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrot_", ( - ftnlen)1736)) * 80, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Negate the vector if the axis has negative sign. */ - - if (negate) { - vminus_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("v2", i__1, "zzdynrot_", (ftnlen)1747)], - ptemp); - moved_(ptemp, &c__3, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrot_", ( - ftnlen)1748)]); - } - } - -/* Look up the lower bound for the angular separation of */ -/* the defining vectors. Use the default value if none */ -/* was supplied. */ - - zzdynoad_(inname__, infram, itmsep, &c__1, &n, &minsep, &fnd, ( - ftnlen)32, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - if (! fnd) { - minsep = .001; - } - -/* Now use our vectors to compute our position transformation */ -/* matrix. */ - -/* Check the angular separation of the defining vectors. We */ -/* want to ensure that the vectors are not too close to being */ -/* linearly dependent. We can handle both cases---separation */ -/* close to 0 or separation close to Pi---by comparing the */ -/* sine of the separation to the sine of the separation limit. */ - - sep = vsep_(v2, &v2[3]); - if (sin(sep) < sin(minsep)) { - etcal_(&t0, timstr, (ftnlen)50); - setmsg_("Angular separation of vectors defining two-vector p" - "arameterized dynamic frame # is # (radians); minimum" - " allowed difference of separation from 0 or Pi is # " - "radians. Evaluation epoch is #. Extreme loss of pr" - "ecision can occur when defining vectors are nearly l" - "inearly dependent. This type of error can be due to" - " using a dynamic frame outside of the time range for" - " which it is meant. It also can be due to a conceptu" - "al error pertaining to the frame's definition, or to" - " an implementation error in the frame kernel contain" - "ing the frame definition. However, if you wish to pr" - "oceed with this computation, the # keyword can be us" - "ed in the frame definition to adjust the separation " - "limit.", (ftnlen)681); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errdp_("#", &sep, (ftnlen)1); - errdp_("#", &minsep, (ftnlen)1); - errch_("#", timstr, (ftnlen)1, (ftnlen)50); - errch_("#", "ANGLE_SEP_TOL", (ftnlen)1, (ftnlen)13); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* We have both positions expressed relative to frame J2000 */ -/* at this point. Find the transformation from INNAME to */ -/* the frame J2000, then from J2000 to frame BASNAM. */ - - twovec_(v2, axis, &v2[3], &axis[1], rinv); - xpose_(rinv, rotate); - if (*basfrm != j2000) { - moved_(rotate, &c__9, rtemp); - zzrefch0_(&j2000, basfrm, &t0, r2000); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - mxm_(r2000, rtemp, rotate); - } - -/* ROTATE is set. */ - -/* This is the end of the work specific to two-vector frames. */ -/* From here we drop out of the IF block. */ - - } else if (s_cmp(dynfam, "EULER", (ftnlen)80, (ftnlen)5) == 0) { - -/* The frame belongs to the Euler family. */ - -/* We expect to specifications of an axis sequence, units, */ -/* and angles via polynomial coefficients. We also expect */ -/* to see an ET epoch. */ - -/* Look up the epoch first. Let DELTA represent the offset */ -/* of T0 relative to the epoch. */ - -/* Initialize EPOCH so subtraction doesn't overflow if EPOCH */ -/* is invalid due to a lookup error. */ - - epoch = 0.; - zzdynvad_(inname__, infram, "EPOCH", &c__1, &n, &epoch, (ftnlen) - 32, (ftnlen)5); - delta = t0 - epoch; - -/* Now the axis sequence. */ - - zzdynvai_(inname__, infram, "AXES", &c__3, &n, iaxes, (ftnlen)32, - (ftnlen)4); - -/* Now the coefficients for the angles. */ - - for (i__ = 1; i__ <= 3; ++i__) { - -/* Initialize N so subtraction doesn't overflow if N */ -/* is invalid due to a lookup error. */ - - n = 0; - zzdynvad_(inname__, infram, itmcof + (((i__1 = i__ - 1) < 3 && - 0 <= i__1 ? i__1 : s_rnge("itmcof", i__1, "zzdynrot_" - , (ftnlen)1880)) << 5), &c__20, &n, &coeffs[(i__2 = - i__ * 20 - 20) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "coeffs", i__2, "zzdynrot_", (ftnlen)1880)], (ftnlen) - 32, (ftnlen)32); - -/* Set the polynomial degree for the Ith angle. */ - - degs[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("degs", - i__1, "zzdynrot_", (ftnlen)1886)] = n - 1; - } - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, "UNITS", &c__1, &n, units, (ftnlen)32, - (ftnlen)5, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* Evaluate the angles at DELTA. Convert angles from input */ -/* units to radians. */ - - for (i__ = 1; i__ <= 3; ++i__) { - polyds_(&coeffs[(i__1 = i__ * 20 - 20) < 60 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "zzdynrot_", (ftnlen) - 1906)], °s[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("degs", i__2, "zzdynrot_", (ftnlen)1906) - ], &c__0, &delta, poly); - -/* Convert units. Fill in the Euler angle vector. */ - - convrt_(poly, units, "RADIANS", &eulang[(i__1 = i__ - 1) < 3 - && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzdynr" - "ot_", (ftnlen)1910)], (ftnlen)80, (ftnlen)7); - } - -/* Produce a position transformation matrix that maps from */ -/* the defined frame to the base frame. */ - - eul2m_(eulang, &eulang[1], &eulang[2], iaxes, &iaxes[1], &iaxes[2] - , rotate); - -/* This is the end of the work specific to Euler frames. */ -/* From here we drop out of the IF block. */ - - } else { - setmsg_("Dynamic frame family # (in definition of frame #) is no" - "t supported. This situation is usually caused by an erro" - "r in a frame kernel in which the frame is defined.", ( - ftnlen)161); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* This is the end of the IF block that processes the */ -/* parameterized dynamic frame families. */ - - } else { - setmsg_("Dynamic frame style # (in definition of frame #) is not sup" - "ported. This situation is usually caused by an error in a fr" - "ame kernel in which the frame is defined.", (ftnlen)160); - errch_("#", dynstl, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNROT", (ftnlen)8); - return 0; - } - -/* At this point ROTATE is the position transformation matrix */ -/* mapping from the input frame INFRAM to the base frame BASFRM. */ - -/* ROTATE and BASFRM is set. */ - - chkout_("ZZDYNROT", (ftnlen)8); - return 0; -} /* zzdynrot_ */ - diff --git a/ext/spice/src/cspice/zzdynrt0.c b/ext/spice/src/cspice/zzdynrt0.c deleted file mode 100644 index b225327c1e..0000000000 --- a/ext/spice/src/cspice/zzdynrt0.c +++ /dev/null @@ -1,2363 +0,0 @@ -/* zzdynrt0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__9 = 9; -static integer c__36 = 36; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b190 = 0.; -static integer c__6 = 6; -static doublereal c_b356 = 1.; -static integer c__20 = 20; - -/* $Procedure ZZDYNRT0 ( Dynamic position transformation evaluation ) */ -/* Subroutine */ int zzdynrt0_(integer *infram, integer *center, doublereal * - et, doublereal *rotate, integer *basfrm) -{ - /* Initialized data */ - - static char axes[1*3] = "X" "Y" "Z"; - static logical first = TRUE_; - static char itmcof[32*3] = "ANGLE_1_COEFFS " "ANGLE_2_C" - "OEFFS " "ANGLE_3_COEFFS "; - static char itmsep[32] = "ANGLE_SEP_TOL "; - static char vname[4*2] = "PRI_" "SEC_"; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2, i__3[2]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double sin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int zzrefch1_(integer *, integer *, doublereal *, - doublereal *); - doublereal dmob; - integer degs[3], frid; - char spec[80]; - integer targ; - doublereal oblr[9] /* was [3][3] */; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal pobs[3]; - integer axis[2]; - extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *, - doublereal *, ftnlen); - doublereal tipm[9] /* was [3][3] */, vflt; - extern doublereal vsep_(doublereal *, doublereal *); - doublereal rinv[9] /* was [3][3] */; - extern /* Subroutine */ int zzspkez1_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - vsub_(doublereal *, doublereal *, doublereal *), vequ_(doublereal - *, doublereal *); - doublereal poly[2], rnut[9] /* was [3][3] */; - extern /* Subroutine */ int zzspkzp1_(integer *, doublereal *, char *, - char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen), - zzdynbid_(char *, integer *, char *, integer *, ftnlen, ftnlen), - zzdynfid_(char *, integer *, char *, integer *, ftnlen, ftnlen), - zzdynoad_(char *, integer *, char *, integer *, integer *, - doublereal *, logical *, ftnlen, ftnlen), zzdynoac_(char *, - integer *, char *, integer *, integer *, char *, logical *, - ftnlen, ftnlen, ftnlen), eul2m_(doublereal *, doublereal *, - doublereal *, integer *, integer *, integer *, doublereal *), - zzcorepc_(char *, doublereal *, doublereal *, doublereal *, - ftnlen), zzmobliq_(doublereal *, doublereal *, doublereal *), - zzdynvac_(char *, integer *, char *, integer *, integer *, char *, - ftnlen, ftnlen, ftnlen), zzdynvad_(char *, integer *, char *, - integer *, integer *, doublereal *, ftnlen, ftnlen), zzdynvai_( - char *, integer *, char *, integer *, integer *, integer *, - ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer n, frcid; - doublereal radii[3], delta; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen); - doublereal epoch; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static integer earth; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - doublereal pnear[3]; - integer frcls, iaxes[3]; - doublereal rprec[9] /* was [3][3] */; - static char itmra[32*2]; - integer cvobs, frctr; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - errdp_(char *, doublereal *, ftnlen); - doublereal ptemp[3], rtemp[9] /* was [3][3] */, stemp[6], stobs[6]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int xpose_(doublereal *, doublereal *); - char units[80]; - doublereal nutxf[36] /* was [6][6] */, t0; - extern /* Subroutine */ int bodn2c_(char *, integer *, logical *, ftnlen); - doublereal v2[6] /* was [3][2] */; - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - doublereal ra; - extern logical failed_(void); - logical meanec; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - char vecdef[80*2]; - static char itmabc[32*2]; - char basnam[32]; - doublereal lt; - logical negate; - static char itmdec[32*2]; - doublereal coeffs[60] /* was [20][3] */; - char inname__[32], abcorr[5], axname[80]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - char cfrmnm[32], ctrnam[36], cvcorr[5], dynstl[80], dynfam[80]; - static char itmaxe[32*2], itmfrm[32*2], itmlat[32*2], itmlon[32*2], - itmobs[32*2], itmspc[32*2], itmtrg[32*2], itmunt[32*2], itmvdf[32* - 2], itmvec[32*2]; - char nutmod[80], oblmod[80], prcmod[80], rotsta[80], timstr[50], tmpfam[ - 80], velfrm[32]; - doublereal angles[2], ctrpos[3], dec, dirvec[3], eulang[3], fet, alt, lat, - minsep, mob, precxf[36] /* was [6][6] */, r2000[9] /* - was [3][3] */; - integer cfrmid; - doublereal sep, lon; - static integer j2000; - integer obs; - logical corblk[15], fnd; - doublereal vet; - logical frozen, meaneq, ofdate, trueeq; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), frmnam_( - integer *, char *, ftnlen), chkout_(char *, ftnlen), cmprss_(char - *, integer *, char *, char *, ftnlen, ftnlen, ftnlen), setmsg_( - char *, ftnlen), sigerr_(char *, ftnlen), intstr_(integer *, char - *, ftnlen), mxm_(doublereal *, doublereal *, doublereal *), - errint_(char *, integer *, ftnlen), frinfo_(integer *, integer *, - integer *, integer *, logical *), mxv_(doublereal *, doublereal *, - doublereal *), cidfrm_(integer *, integer *, char *, logical *, - ftnlen), bodvcd_(integer *, char *, integer *, integer *, - doublereal *, ftnlen), vminus_(doublereal *, doublereal *), - nearpt_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *), convrt_(doublereal *, char *, char *, - doublereal *, ftnlen, ftnlen), latrec_(doublereal *, doublereal * - , doublereal *, doublereal *), stlabx_(doublereal *, doublereal *, - doublereal *), stelab_(doublereal *, doublereal *, doublereal *), - twovec_(doublereal *, integer *, doublereal *, integer *, - doublereal *), polyds_(doublereal *, integer *, integer *, - doublereal *, doublereal *), zzeprc76_(doublereal *, doublereal *) - , zzenut80_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* For a specified dynamic frame, find the rotation that maps */ -/* positions from the dynamic frame to its base frame. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* PCK */ -/* SPK */ - -/* $ Keywords */ - -/* FRAMES */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRAM I Class ID code for a SPICE dynamic reference frame. */ -/* CENTER I ID code for the center of the input frame. */ -/* ET I An epoch in seconds past J2000 TDB. */ -/* ROTATE O The requested rotation matrix. */ -/* BASFRM O Frame ID of base frame associated with INFRAM. */ - -/* $ Detailed_Input */ - -/* INFRAM is the frame ID code for a dynamic reference frame. */ -/* Note that this interface differs from that of TKFRAM, */ -/* which uses a class ID to identify the frame. */ - -/* In this routine, we refer this frame both as the */ -/* "input frame" and the "defined frame." */ - -/* CENTER is NAIF ID code for the center of the frame */ -/* designated by INFRAM. This code, although derivable */ -/* from INFRAM, is passed in for convenience. */ - -/* ET is an epoch in ephemeris seconds past J2000 for which */ -/* the caller requests a rotation matrix. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3x3 rotation matrix that transforms positions */ -/* relative to INFRAM to positions relative to BASFRM. */ - -/* BASFRM is the frame ID code of the base frame associated */ -/* with INFRAM. The 3x3 matrix ROTATE transforms */ -/* positions relative to INFRAM to positions relative to */ -/* BASFRM. The position transformation is performed by */ -/* left-multiplying by ROTATE a position expressed */ -/* relative to INFRAM. This is easily accomplished via */ -/* the subroutine call shown below. */ - -/* CALL MXV ( ROTATE, INPOS, OUTPOS ) */ - -/* $ Parameters */ - -/* See include file zzdyn.inc. */ - -/* $ Files */ - -/* 1) SPK files containing data for each observer and target */ -/* are required to support two-vector frames. Note that */ -/* observer-target pairs can be implicit, as in the case */ -/* of a constant vector whose frame is evaluated at a */ -/* light-time corrected epoch: the light time the frame */ -/* center to an observer must be computable in this case, */ -/* which implies the state of the frame center as seen by */ -/* the observer must be computable. */ - -/* 2) Any of SPK, CK, PCK, and frame kernels will also be required */ -/* if any frames referenced in the definition of INFRAM (as a */ -/* base frame, velocity vector frame, or constant vector frame) */ -/* require them, or if any vectors used to define INFRAM require */ -/* these data in order to be computable. */ - -/* 3) When CK data are required, one or more associated SCLK kernels */ -/* ---normally, one kernel per spacecraft clock---are */ -/* required as well. A leapseconds kernel may be required */ -/* whenever an SCLK kernel is required. */ - -/* 4) When a two-vector frame is defined using a target near point, */ -/* a PCK file giving orientation and providing a triaxial shape */ -/* model for the target body is required. */ - - -/* $ Exceptions */ - -/* 1) If a dynamic frame evaluation requires unavailable kernel */ -/* data, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 2) If a precession model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 3) If a nutation model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 4) If an obliquity model is used to implement a frame centered */ -/* at a body for which the model is not applicable, the error */ -/* SPICE(INVALIDSELECTION) will be signaled. */ - -/* 5) If an unrecognized precession model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 6) If an unrecognized nutation model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 7) If an unrecognized obliquity model is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 8) If an attempt to look up the center of a frame does */ -/* not yield data, the error SPICE(FRAMEDATANOTFOUND) is */ -/* signaled. */ - -/* 9) In a two-vector frame definition, if a constant vector */ -/* specification method is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 10) In a two-vector frame definition, if a vector definition */ -/* method is not recognized, the error SPICE(NOTSUPPORTED) */ -/* is signaled. */ - -/* 11) If an unrecognized dynamic frame family is specified, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 12) If an unrecognized dynamic frame definition style is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 13) If an unrecognized dynamic frame rotation state is */ -/* specified, the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 14) If both a freeze epoch and a rotation state are specified, */ -/* the error SPICE(FRAMEDEFERROR) is signaled. */ - -/* 15) If neither a freeze epoch nor a rotation state are specified */ -/* for an "of date" frame, the error SPICE(FRAMEDEFERROR) is */ -/* signaled. */ - -/* 16) In a two-vector frame definition, if an invalid axis */ -/* specification is encountered, the error SPICE(INVALIDAXIS) is */ -/* signaled. */ - -/* 17) In a two-vector frame definition using a target near point */ -/* vector, if the body-fixed frame associated with the target */ -/* is not found, the error SPICE(FRAMEDATANOTFOUND) is signaled. */ - -/* 18) If a dynamic frame evaluation requires excessive recursion */ -/* depth, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 19) When a two-vector dynamic frame is evaluated, if the */ -/* primary and secondary vectors have angular separation less */ -/* than the minimum allowed value, or if the angular separation */ -/* differs from Pi by less than the minimum allowed value, the */ -/* error SPICE(DEGENERATECASE) is signaled. The default minimum */ -/* separation is given by the parameter LBSEP; this value may be */ -/* overridden by supplying a different value in the frame */ -/* definition. */ - -/* 20) If invalid units occur in a frame definition, the error */ -/* will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 21) If an invalid Euler axis sequence occurs in a frame */ -/* definition, the error will be diagnosed by a routine in the */ -/* call tree of this routine. */ - -/* $ Particulars */ - -/* Currently only parameterized dynamic frames are supported by */ -/* this routine. */ - -/* Currently supported parameterized dynamic families are: */ - -/* Two-vector */ -/* ========== */ - -/* Vector definitions */ -/* ------------------ */ -/* Observer-target position */ -/* Observer-target velocity */ -/* Near point on target */ -/* Constant vector in specified frame */ - - -/* Mean Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ - - -/* Mean Ecliptic and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU mean obliquity model */ - - -/* True Equator and Equinox of Date */ -/* ================================ */ - -/* Bodies and models */ -/* ----------------- */ -/* Earth: 1976 IAU precession model */ -/* 1980 IAU nutation model */ - - -/* Euler frames */ -/* ============ */ - -/* Euler angle definitions */ -/* ----------------------- */ -/* Polynomial */ - - -/* $ Examples */ - -/* See ROTGET. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) Many numerical problems can occur when dynamic frames */ -/* are evaluated. Users must determine whether dynamic frame */ -/* definitions are suitable for their applications. See the */ -/* Exceptions section for a list of possible problems. */ - -/* 3) Two-vector frame definitions can suffer extreme loss of */ -/* precision due to near-singular geometry. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 24-OCT-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ were renamed to KVX, KVY, KVZ. */ - -/* Call to ZZBODVCD was replaced with call to BODVCD. */ - -/* - SPICELIB Version 1.0.0, 10-JAN-2005 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNRT0", (ftnlen)8); - if (first) { - -/* Get the ID code for the J2000 frame. */ - - irfnum_("J2000", &j2000, (ftnlen)5); - -/* Get the ID code for the earth (we needn't check the found */ -/* flag). */ - - bodn2c_("EARTH", &earth, &fnd, (ftnlen)5); - -/* Initialize "item" strings used to create kernel variable */ -/* names. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Vector axis: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 502)) << 2); - i__3[1] = 4, a__1[1] = "AXIS"; - s_cat(itmaxe + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmaxe", i__1, "zzdynrt0_", (ftnlen)502)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector definition: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 506)) << 2); - i__3[1] = 10, a__1[1] = "VECTOR_DEF"; - s_cat(itmvdf + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvdf", i__1, "zzdynrt0_", (ftnlen)506)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector aberration correction: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 510)) << 2); - i__3[1] = 6, a__1[1] = "ABCORR"; - s_cat(itmabc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmabc", i__1, "zzdynrt0_", (ftnlen)510)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector frame: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 514)) << 2); - i__3[1] = 5, a__1[1] = "FRAME"; - s_cat(itmfrm + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmfrm", i__1, "zzdynrt0_", (ftnlen)514)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector observer: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 518)) << 2); - i__3[1] = 8, a__1[1] = "OBSERVER"; - s_cat(itmobs + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmobs", i__1, "zzdynrt0_", (ftnlen)518)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector target: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 522)) << 2); - i__3[1] = 6, a__1[1] = "TARGET"; - s_cat(itmtrg + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmtrg", i__1, "zzdynrt0_", (ftnlen)522)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector longitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 526)) << 2); - i__3[1] = 9, a__1[1] = "LONGITUDE"; - s_cat(itmlon + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlon", i__1, "zzdynrt0_", (ftnlen)526)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector latitude: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 530)) << 2); - i__3[1] = 8, a__1[1] = "LATITUDE"; - s_cat(itmlat + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmlat", i__1, "zzdynrt0_", (ftnlen)530)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector right ascension: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 534)) << 2); - i__3[1] = 2, a__1[1] = "RA"; - s_cat(itmra + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynrt0_", (ftnlen)534)) << 5), a__1, - i__3, &c__2, (ftnlen)32); - -/* Vector declination: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 538)) << 2); - i__3[1] = 3, a__1[1] = "DEC"; - s_cat(itmdec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmdec", i__1, "zzdynrt0_", (ftnlen)538)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Vector units: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 542)) << 2); - i__3[1] = 5, a__1[1] = "UNITS"; - s_cat(itmunt + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmunt", i__1, "zzdynrt0_", (ftnlen)542)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector coordinate specification: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 546)) << 2); - i__3[1] = 4, a__1[1] = "SPEC"; - s_cat(itmspc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmspc", i__1, "zzdynrt0_", (ftnlen)546)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - -/* Constant vector in cartesian coordinates, literal value: */ - -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen) - 550)) << 2); - i__3[1] = 6, a__1[1] = "VECTOR"; - s_cat(itmvec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("itmvec", i__1, "zzdynrt0_", (ftnlen)550)) << 5), - a__1, i__3, &c__2, (ftnlen)32); - } - first = FALSE_; - } - -/* Initialize the output arguments. */ - - cleard_(&c__9, rotate); - *basfrm = 0; - -/* Initialize certain variables to ensure that we don't do */ -/* arithmetic operations using bogus, possibly large, */ -/* undefined values. */ - - cleard_(&c__36, nutxf); - cleard_(&c__9, oblr); - cleard_(&c__36, precxf); - cleard_(&c__9, r2000); - cleard_(&c__9, rtemp); - cleard_(&c__9, rinv); - cleard_(&c__9, tipm); - mob = 0.; - dmob = 0.; - t0 = 0.; - frozen = FALSE_; - -/* Get the input frame name. */ - - frmnam_(infram, inname__, (ftnlen)32); - -/* We need the name of the base frame. */ - - zzdynfid_(inname__, infram, "RELATIVE", basfrm, (ftnlen)32, (ftnlen)8); - frmnam_(basfrm, basnam, (ftnlen)32); - -/* The output frame code and name are set. */ - -/* Look up the dynamic frame definition style from the kernel pool. */ -/* The kernel variable's name might be specified by name or ID. */ - - zzdynvac_(inname__, infram, "DEF_STYLE", &c__1, &n, dynstl, (ftnlen)32, ( - ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* At this time, the only supported dynamic frame definition style is */ -/* PARAMETERIZED. */ - - if (eqstr_(dynstl, "PARAMETERIZED", (ftnlen)80, (ftnlen)13)) { - -/* Parameterized dynamic frames belong to families. Look up */ -/* the family for this frame. */ - - zzdynvac_(inname__, infram, "FAMILY", &c__1, &n, dynfam, (ftnlen)32, ( - ftnlen)6, (ftnlen)80); - cmprss_(" ", &c__0, dynfam, tmpfam, (ftnlen)1, (ftnlen)80, (ftnlen)80) - ; - ucase_(tmpfam, dynfam, (ftnlen)80, (ftnlen)80); - -/* Determine whether we have an "of-date" frame family. */ -/* The logical flags used here and respective meanings are: */ - -/* MEANEQ Mean equator and equinox of date */ -/* TRUEEQ True equator and equinox of date */ -/* MEANEC Mean ecliptic and equinox of date */ - - meaneq = s_cmp(dynfam, "MEAN_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - trueeq = s_cmp(dynfam, "TRUE_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80, - (ftnlen)32) == 0; - meanec = s_cmp(dynfam, "MEAN_ECLIPTIC_AND_EQUINOX_OF_DATE", (ftnlen) - 80, (ftnlen)33) == 0; - ofdate = meaneq || meanec || trueeq; - -/* Set the evaluation epoch T0. Normally this epoch is ET, */ -/* but if the frame is frozen, the freeze epoch from the */ -/* frame definition is used. */ - -/* Read the freeze epoch into T0 if a freeze epoch was */ -/* specified; let FROZEN receive the FOUND flag value */ -/* returned by ZZDYNOAD. */ - - zzdynoad_(inname__, infram, "FREEZE_EPOCH", &c__1, &n, &t0, &frozen, ( - ftnlen)32, (ftnlen)12); - if (! frozen) { - -/* Normal case: just use the input epoch. */ - - t0 = *et; - } - -/* Look up the rotation state keyword. In this routine, */ -/* the rotation state keyword is examined only to support */ -/* semantic checking: there's no use made of the fact that */ -/* the rotation state is 'ROTATING' or 'INERTIAL'. */ - - zzdynoac_(inname__, infram, "ROTATION_STATE", &c__1, &n, rotsta, &fnd, - (ftnlen)32, (ftnlen)14, (ftnlen)80); - if (fnd) { - -/* Catch invalid rotation states here. */ - - if (! eqstr_(rotsta, "ROTATING", (ftnlen)80, (ftnlen)8) && ! - eqstr_(rotsta, "INERTIAL", (ftnlen)80, (ftnlen)8)) { - setmsg_("Definition of frame # contains # specification #. T" - "he only valid rotation states are # or #. This situa" - "tion is usually caused by an error in a frame kernel" - " in which the frame is defined.", (ftnlen)186); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - errch_("#", rotsta, (ftnlen)1, (ftnlen)80); - errch_("#", "ROTATING", (ftnlen)1, (ftnlen)8); - errch_("#", "INERTIAL", (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - } - - -/* If the frame is frozen, the rotation state keyword *must be */ -/* absent*. */ - - if (frozen && fnd) { - setmsg_("Definition of frame # contains both # and # keywords; a" - "t most one of these must be present in the frame definit" - "ion. This situation is usually caused by an error in a f" - "rame kernel in which the frame is defined.", (ftnlen)209); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* If the frame belongs to an "of date" family, either the */ -/* rotation state must be specified or the frame must be */ -/* frozen. */ - - if (ofdate && ! frozen && ! fnd) { - setmsg_("Definition of frame #, which belongs to parameterized d" - "ynamic frame family #, contains neither # nor # keywords" - "; frames in this family require exactly one of these in " - "their frame definitions. This situation is usually cause" - "d by an error in a frame kernel in which the frame is de" - "fined.", (ftnlen)285); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12); - errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14); - sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* The evaluation epoch T0 is set. */ - -/* In this routine, unlike its companion ZZDYNFRM, there is no */ -/* need to make further reference to the rotation state. Hence */ -/* the flag INERT used in ZZDYNFRM doesn't appear here. */ - - -/* The following code block performs actions specific to */ -/* the various dynamic frame families. */ - - if (ofdate) { - -/* Fetch the name of the true equator and equinox of date */ -/* precession model. */ - - zzdynvac_(inname__, infram, "PREC_MODEL", &c__1, &n, prcmod, ( - ftnlen)32, (ftnlen)10, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Get the precession transformation. */ - - if (eqstr_(prcmod, "EARTH_IAU_1976", (ftnlen)80, (ftnlen)14)) { - -/* This is the 1976 IAU earth precession model. */ - -/* Make sure the center of the input frame is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame center # " - "and precession model #. This precession model is" - " not applicable to body #. This situation is usu" - "ally caused by an error in a frame kernel in whi" - "ch the frame is defined.", (ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1976", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Look up the precession transformation. Extract */ -/* the precession rotation matrix. */ - - zzeprc76_(&t0, precxf); - moved_(precxf, &c__3, rprec); - moved_(&precxf[6], &c__3, &rprec[3]); - moved_(&precxf[12], &c__3, &rprec[6]); - -/* If we're in the mean-of-date case, invert this */ -/* transformation to obtain the mapping from the */ -/* mean-of-date frame to J2000. */ - - if (meaneq) { - xpose_(rprec, rtemp); - } - } else { - setmsg_("Definition of frame # specifies precession model #," - " which is not recognized. This situation is usually " - "caused by an error in a frame kernel in which the fr" - "ame is defined.", (ftnlen)170); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", prcmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* At this point the precession transformation REPREC is set. */ -/* If INFRAM is a mean equator and equinox of date frame, the */ -/* inverse of REPREC is currently stored in RTEMP. */ - if (trueeq) { - -/* We need a nutation transformation as well. Get the name */ -/* of the nutation model. */ - - zzdynvac_(inname__, infram, "NUT_MODEL", &c__1, &n, nutmod, ( - ftnlen)32, (ftnlen)9, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Get the nutation transformation. */ - - if (eqstr_(nutmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth nutation model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and nutation model #. This nutation mode" - "l is not applicable to body #. This situati" - "on is usually caused by an error in a frame " - "kernel in which the frame is defined.", ( - ftnlen)212); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Look up the nutation transformation. Extract */ -/* the nutation rotation matrix. */ - - zzenut80_(&t0, nutxf); - moved_(nutxf, &c__3, rnut); - moved_(&nutxf[6], &c__3, &rnut[3]); - moved_(&nutxf[12], &c__3, &rnut[6]); - -/* Find the rotation from the J2000 frame to the earth */ -/* true of date frame. Invert. */ - - mxm_(rnut, rprec, rinv); - xpose_(rinv, rtemp); - } else { - setmsg_("Definition of frame # specifies nutation model " - "#, which is not recognized. This situation is us" - "ually caused by an error in a frame kernel in wh" - "ich the frame is defined.", (ftnlen)168); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", nutmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - } else if (meanec) { - -/* We need a mean obliquity transformation as well. */ -/* Get the name of the obliquity model. */ - - zzdynvac_(inname__, infram, "OBLIQ_MODEL", &c__1, &n, oblmod, - (ftnlen)32, (ftnlen)11, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Get the obliquity transformation. */ - - if (eqstr_(oblmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14)) - { - -/* This is the 1980 IAU earth mean obliquity of */ -/* date model. */ - -/* Make sure the center is the earth. */ - - if (*center != earth) { - bodc2n_(center, ctrnam, &fnd, (ftnlen)36); - if (! fnd) { - intstr_(center, ctrnam, (ftnlen)36); - } - setmsg_("Definition of frame # specifies frame cente" - "r # and obliquity model #. This obliquity m" - "odel is not applicable to body #. This situa" - "tion is usually caused by an error in a fram" - "e kernel in which the frame is defined.", ( - ftnlen)214); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14); - errch_("#", ctrnam, (ftnlen)1, (ftnlen)36); - sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Create the obliquity transformation. */ -/* First look up the obliquity state. */ - - zzmobliq_(&t0, &mob, &dmob); - -/* The obliquity rotation is about the mean-of-date */ -/* x-axis. The other Euler angles are identically */ -/* zero; the axes are arbitrary, as long as the */ -/* middle axis is distinct from the other two. */ - - eul2m_(&c_b190, &c_b190, &mob, &c__1, &c__3, &c__1, oblr); - -/* Find the rotation from the J2000 to the */ -/* earth mean ecliptic of date frame. Invert. */ - - mxm_(oblr, rprec, rinv); - xpose_(rinv, rtemp); - } else { - setmsg_("Definition of frame # specifies obliquity model" - " #, which is not recognized. This situation is u" - "sually caused by an error in a frame kernel in w" - "hich the frame is defined.", (ftnlen)169); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", oblmod, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - } - -/* At this point, RTEMP contains the rotation from the */ -/* specified mean of date or true of date frame to J2000. */ - -/* If the base frame is not J2000, we must find the */ -/* transformation from J2000 to the base frame. */ - if (*basfrm != j2000) { - zzrefch1_(&j2000, basfrm, &t0, r2000); - mxm_(r2000, rtemp, rotate); - } else { - -/* Otherwise, RTEMP is the matrix we want. */ - - moved_(rtemp, &c__9, rotate); - } - -/* Now ROTATE is the state transformation mapping from */ -/* the input frame INFRAM to the base frame BASFRM. */ - -/* This is the end of the work specific to "of-date" frames. */ -/* From here we drop out of the IF block. */ - - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - } else if (s_cmp(dynfam, "TWO-VECTOR", (ftnlen)80, (ftnlen)10) == 0) { - -/* The frame belongs to the TWO-VECTOR family. */ - -/* Fetch the specifications of the primary and secondary */ -/* axes. */ - - cleard_(&c__6, v2); - for (i__ = 1; i__ <= 2; ++i__) { - -/* Get the name of the axis associated with the Ith */ -/* defining vector. */ - - zzdynvac_(inname__, infram, itmaxe + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmaxe", i__1, "zzdynrt0_" - , (ftnlen)1054)) << 5), &c__1, &n, axname, (ftnlen)32, - (ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(axname, axname, (ftnlen)80, (ftnlen)80); - -/* Set the sign flag associated with the axis. */ - - negate = *(unsigned char *)axname == '-'; - cmprss_("-", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - cmprss_("+", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("axis", - i__1, "zzdynrt0_", (ftnlen)1067)] = isrchc_(axname, & - c__3, axes, (ftnlen)80, (ftnlen)1); - if (axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "axis", i__1, "zzdynrt0_", (ftnlen)1070)] == 0) { - setmsg_("Definition of frame # associates vector # with " - "axis #. The only valid axis values are { X, -X," - " Y, -Y, Z, -Z }. This situation is usually cause" - "d by an error in a frame kernel in which the fra" - "me is defined.", (ftnlen)205); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &i__, (ftnlen)1); - errch_("#", axname, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(INVALIDAXIS)", (ftnlen)18); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Find out how the vector is defined: */ - -/* - Observer-target position vector */ -/* - Observer-target velocity vector */ -/* - Observer-target near point vector */ -/* - Constant vector */ - -/* VECDEF(I) indicates the vector definition method */ -/* for the Ith vector. */ - - zzdynvac_(inname__, infram, itmvdf + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("itmvdf", i__1, "zzdynrt0_" - , (ftnlen)1099)) << 5), &c__1, &n, vecdef + ((i__2 = - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("vecdef", - i__2, "zzdynrt0_", (ftnlen)1099)) * 80, (ftnlen)32, ( - ftnlen)32, (ftnlen)80); - cmprss_(" ", &c__0, vecdef + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", ( - ftnlen)1102)) * 80, vecdef + ((i__2 = i__ - 1) < 2 && - 0 <= i__2 ? i__2 : s_rnge("vecdef", i__2, "zzdynrt0_", - (ftnlen)1102)) * 80, (ftnlen)1, (ftnlen)80, (ftnlen) - 80); - ucase_(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)1103)) * - 80, vecdef + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("vecdef", i__2, "zzdynrt0_", (ftnlen) - 1103)) * 80, (ftnlen)80, (ftnlen)80); - if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)1106)) * - 80, "OBSERVER_TARGET_POSITION", (ftnlen)80, (ftnlen) - 24) == 0) { - -/* The vector is the position of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynrt0_", (ftnlen)1113)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynrt0_", (ftnlen)1115)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrt0_", (ftnlen)1117)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* Look up the Ith position vector in the J2000 frame. */ - - zzspkzp1_(&targ, &t0, "J2000", abcorr, &obs, &v2[(i__1 = - i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "v2", i__1, "zzdynrt0_", (ftnlen)1123)], <, ( - ftnlen)5, (ftnlen)5); - -/* At this point, V2(*,I) contains position relative to */ -/* frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen) - 1131)) * 80, "OBSERVER_TARGET_VELOCITY", (ftnlen)80, ( - ftnlen)24) == 0) { - -/* The vector is the velocity of a target relative */ -/* to an observer. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynrt0_", (ftnlen)1138)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynrt0_", (ftnlen)1140)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrt0_", (ftnlen)1142)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* We need to know the frame in which the velocity is */ -/* defined. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynrt0_", (ftnlen)1149)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - frmnam_(&frid, velfrm, (ftnlen)32); - -/* Look up the Ith velocity vector in the velocity frame. */ - - zzspkez1_(&targ, &t0, velfrm, abcorr, &obs, stemp, <, ( - ftnlen)32, (ftnlen)5); - -/* We'll work with the unit velocity vector. */ - - vhat_(&stemp[3], &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1161)]); - -/* We need the epoch VET at which VELFRM is evaluated. */ -/* This epoch will be used to transform the velocity */ -/* vector from VELFRM to J2000. */ - -/* Parse the aberration correction. Capture the */ -/* epoch used to evaluate the velocity vector's frame. */ - - zzprscor_(abcorr, corblk, (ftnlen)5); - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the velocity vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the velocity frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame ass" - "ociated with a velocity vector has frame" - " ID code #, but no frame center, frame c" - "lass, or frame class ID was found by FRI" - "NFO. This situation MAY be caused by an" - " error in a frame kernel in which the fr" - "ame is defined. The problem also could b" - "e indicative of a SPICELIB bug.", (ftnlen) - 310); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Obtain light time from the observer to the frame's */ -/* center. */ - - zzspkzp1_(&frctr, &t0, "J2000", abcorr, &obs, ctrpos, - &vflt, (ftnlen)5, (ftnlen)5); - zzcorepc_(abcorr, &t0, &vflt, &vet, (ftnlen)5); - } else { - -/* No aberration correction was specified. Evaluate */ -/* the frame at T0. */ - - vet = t0; - } - -/* The velocity frame evaluation epoch VET is now set. */ - -/* We must rotate the velocity vector from the velocity */ -/* frame (evaluated at VET) to the output frame at T0. */ -/* We'll do this in two stages, first mapping velocity */ -/* into the J2000 frame. */ - - zzrefch1_(&frid, &j2000, &vet, r2000); - mxv_(r2000, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? - i__1 : s_rnge("v2", i__1, "zzdynrt0_", (ftnlen) - 1234)], ptemp); - moved_(ptemp, &c__3, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1235)]); - -/* At this point, V2(*,I) contains velocity */ -/* relative to frame J2000. */ - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen) - 1242)) * 80, "TARGET_NEAR_POINT", (ftnlen)80, (ftnlen) - 17) == 0) { - -/* The vector points from an observer to the near */ -/* point to the observer on the target body. */ - -/* We need a target, observer, and aberration correction. */ - - zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1, - "zzdynrt0_", (ftnlen)1249)) << 5), &targ, (ftnlen) - 32, (ftnlen)32); - zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1, - "zzdynrt0_", (ftnlen)1251)) << 5), &obs, (ftnlen) - 32, (ftnlen)32); - zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrt0_", (ftnlen)1253)) << 5), &c__1, &n, - abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5); - -/* The vector points from an observer to the */ -/* sub-observer point (nearest point to the observer) on */ -/* the target body. We need the position of the near */ -/* point relative to the observer. */ - -/* We'll look up the position of the target center */ -/* relative to the observer, as well as the position of */ -/* the near point relative to the target center, both in */ -/* the body-fixed frame associated with the target. */ - -/* Look up the body-fixed frame associated with the */ -/* target body. */ - - cidfrm_(&targ, &cfrmid, cfrmnm, &fnd, (ftnlen)32); - if (! fnd) { - setmsg_("Definition of frame # requires definition o" - "f body-fixed frame associated with target bo" - "dy #. A call to CIDFRM indicated no body-fix" - "ed frame is associated with the target body." - " This situation can arise when a frame kern" - "el defining the target's body-fixed frame l" - "acks the OBJECT__FRAME or OBJECT__" - "FRAME keywords. The problem also could be c" - "aused by an error in a frame kernel in which" - " the parameterized two-vector dynamic frame " - "# is defined.", (ftnlen)452); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &targ, (ftnlen)1); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Get the radii of the target body. */ - - bodvcd_(&targ, "RADII", &c__3, &n, radii, (ftnlen)5); - -/* Look up the Ith position vector in the target-fixed */ -/* frame. Negate the vector to obtain the target-to- */ -/* observer vector. */ - - zzspkzp1_(&targ, &t0, cfrmnm, abcorr, &obs, ptemp, <, ( - ftnlen)32, (ftnlen)5); - vminus_(ptemp, pobs); - nearpt_(pobs, radii, &radii[1], &radii[2], pnear, &alt); - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Find the observer-near point vector in the current */ -/* frame CFRMNM. */ - - vsub_(pnear, pobs, ptemp); - -/* Rotate the vector to frame J2000. To get the required */ -/* rotation matrix, we'll need to obtain the epoch */ -/* associated with CNMFRM. Parse the aberration */ -/* correction and adjust the frame evaluation epoch as */ -/* needed. */ - - zzcorepc_(abcorr, &t0, <, &fet, (ftnlen)5); - -/* Obtain the matrix for transforming position vectors */ -/* from the target center frame to the J2000 frame and */ -/* apply it to the observer-to-near point position */ -/* vector. */ - - zzrefch1_(&cfrmid, &j2000, &fet, tipm); - mxv_(tipm, ptemp, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1345)]); - -/* At this point, V2(*,I) contains position of the near */ -/* point on the target as seen by the observer, relative */ -/* to frame J2000. */ - - } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen) - 1353)) * 80, "CONSTANT", (ftnlen)80, (ftnlen)8) == 0) - { - -/* The vector is constant in a specified frame. */ - -/* We need a 3-vector and an associated reference */ -/* frame relative to which the vector is specified. */ - -/* Look up the ID of the frame first. */ - - zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1, - "zzdynrt0_", (ftnlen)1362)) << 5), &frid, (ftnlen) - 32, (ftnlen)32); - -/* Let FET ("frame ET") be the evaluation epoch for */ -/* the constant vector's frame. By default, this */ -/* frame is just T0, but if we're using light time */ -/* corrections, FET must be adjusted for one-way */ -/* light time between the frame's center and the */ -/* observer. */ - -/* Set the default value of FET here. */ - - fet = t0; - -/* Optionally, there is an aberration correction */ -/* associated with the constant vector's frame. */ -/* If so, an observer must be associated with the */ -/* frame. Look up the correction first. */ - - zzdynoac_(inname__, infram, itmabc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1, - "zzdynrt0_", (ftnlen)1382)) << 5), &c__1, &n, - cvcorr, &fnd, (ftnlen)32, (ftnlen)32, (ftnlen)5); - if (! fnd) { - s_copy(cvcorr, "NONE", (ftnlen)5, (ftnlen)4); - } - zzprscor_(cvcorr, corblk, (ftnlen)5); - if (! corblk[0]) { - -/* We need to apply an aberration correction to */ -/* the constant vector. */ - zzprscor_(cvcorr, corblk, (ftnlen)5); - -/* Check for errors in the aberration correction */ -/* specification. */ - -/* - Light time and stellar aberration corrections */ -/* are mutually exclusive. */ - - if (corblk[1] && corblk[2]) { - setmsg_("Definition of frame # specifies aberrat" - "ion correction # for constant vector. L" - "ight time and stellar aberration correct" - "ions are mutually exclusive for constant" - " vectors used in two-vector parameterize" - "d dynamic frame definitions. This situa" - "tion is usually caused by an error in a " - "frame kernel in which the frame is defin" - "ed.", (ftnlen)322); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", cvcorr, (ftnlen)1, (ftnlen)5); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - if (corblk[1]) { - -/* Light time correction is used. The epoch used */ -/* to evaluate the constant vector's frame depends */ -/* on the frame's observer and center. */ - -/* Look up the constant vector frame's center. */ - - frinfo_(&frid, &frctr, &frcls, &frcid, &fnd); - if (! fnd) { - setmsg_("In definition of frame #, the frame" - " associated with a constant vector h" - "as frame ID code #, but no frame cen" - "ter, frame class, or frame class ID " - "was found by FRINFO. This situation" - " MAY be caused by an error in a fram" - "e kernel in which the frame is defin" - "ed. The problem also could be indica" - "tive of a SPICELIB bug.", (ftnlen)310) - ; - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errint_("#", &frid, (ftnlen)1); - sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen) - 24); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } -/* Look up the observer associated with the */ -/* constant vector's frame. This observer, */ -/* together with the frame's center, determines */ -/* the evaluation epoch for the frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmobs", i__1, "zzdynrt0_", (ftnlen)1468) - ) << 5), &cvobs, (ftnlen)32, (ftnlen)32); - -/* Obtain light time from the observer to the */ -/* frame's center. */ - - zzspkzp1_(&frctr, &t0, "J2000", cvcorr, &cvobs, - ctrpos, <, (ftnlen)5, (ftnlen)5); - -/* Find the evaluation epoch for the frame. */ - - zzcorepc_(cvcorr, &t0, <, &fet, (ftnlen)5); - } else if (corblk[2]) { - -/* Stellar aberration case. */ - -/* The constant vector must be corrected for */ -/* stellar aberration induced by the observer's */ -/* velocity relative to the solar system */ -/* barycenter. First, find this velocity in */ -/* the J2000 frame. We'll apply the correction */ -/* later, when the constant vector has been */ -/* transformed to the J2000 frame. */ - - zzdynbid_(inname__, infram, itmobs + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmobs", i__1, "zzdynrt0_", (ftnlen)1496) - ) << 5), &cvobs, (ftnlen)32, (ftnlen)32); - zzspksb1_(&cvobs, &t0, "J2000", stobs, (ftnlen)5); - } - } - -/* Get the constant vector specification. */ - - zzdynvac_(inname__, infram, itmspc + (((i__1 = i__ - 1) < - 2 && 0 <= i__1 ? i__1 : s_rnge("itmspc", i__1, - "zzdynrt0_", (ftnlen)1508)) << 5), &c__1, &n, - spec, (ftnlen)32, (ftnlen)32, (ftnlen)80); - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - cmprss_(" ", &c__0, spec, spec, (ftnlen)1, (ftnlen)80, ( - ftnlen)80); - ucase_(spec, spec, (ftnlen)80, (ftnlen)80); - if (s_cmp(spec, "RECTANGULAR", (ftnlen)80, (ftnlen)11) == - 0) { - -/* The coordinate system is rectangular. */ - -/* Look up the constant vector. */ - - zzdynvad_(inname__, infram, itmvec + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmvec", - i__1, "zzdynrt0_", (ftnlen)1525)) << 5), & - c__3, &n, dirvec, (ftnlen)32, (ftnlen)32); - } else if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen) - 11) == 0 || s_cmp(spec, "RA/DEC", (ftnlen)80, ( - ftnlen)6) == 0) { - -/* The coordinate system is latitudinal or RA/DEC. */ - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, itmunt + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmunt", - i__1, "zzdynrt0_", (ftnlen)1536)) << 5), & - c__1, &n, units, (ftnlen)32, (ftnlen)32, ( - ftnlen)80); - if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen)11) - == 0) { - -/* Look up longitude and latitude. */ - - zzdynvad_(inname__, infram, itmlon + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlon", i__1, "zzdynrt0_", (ftnlen)1544) - ) << 5), &c__1, &n, &lon, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmlat + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmlat", i__1, "zzdynrt0_", (ftnlen)1547) - ) << 5), &c__1, &n, &lat, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&lon, units, "RADIANS", angles, (ftnlen) - 80, (ftnlen)7); - convrt_(&lat, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } else { - -/* Look up RA and DEC. */ - - zzdynvad_(inname__, infram, itmra + (((i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmra", i__1, "zzdynrt0_", (ftnlen)1560)) - << 5), &c__1, &n, &ra, (ftnlen)32, ( - ftnlen)32); - zzdynvad_(inname__, infram, itmdec + (((i__1 = - i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "itmdec", i__1, "zzdynrt0_", (ftnlen)1563) - ) << 5), &c__1, &n, &dec, (ftnlen)32, ( - ftnlen)32); - -/* Convert angles from input units to radians. */ - - convrt_(&ra, units, "RADIANS", angles, (ftnlen)80, - (ftnlen)7); - convrt_(&dec, units, "RADIANS", &angles[1], ( - ftnlen)80, (ftnlen)7); - } - -/* Now produce a direction vector. */ - - latrec_(&c_b356, angles, &angles[1], dirvec); - } else { - setmsg_("Definition of two-vector parameterized dyna" - "mic frame # includes constant vector specifi" - "cation #, which is not supported. This situ" - "ation is usually caused by an error in a fra" - "me kernel in which the frame is defined.", ( - ftnlen)215); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", spec, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Convert the direction vector to the J2000 frame. */ - - zzrefch1_(&frid, &j2000, &fet, r2000); - mxv_(r2000, dirvec, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1602)]); - -/* The constant vector is now represented */ -/* in the J2000 frame, but we may still need to */ -/* apply a stellar aberration correction. */ - - if (corblk[2]) { - -/* Perform the correction appropriate to the */ -/* radiation travel sense. */ - - if (corblk[4]) { - -/* The correction is for transmission. */ - - stlabx_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 - ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1618)], &stobs[3], ptemp); - } else { - -/* The correction is for reception. */ - - stelab_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 - ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1624)], &stobs[3], ptemp); - } - vequ_(ptemp, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", - (ftnlen)1628)]); - } - -/* At this point, V2(*,I) contains the constant */ -/* (constant relative to its associated frame, that is) */ -/* vector as seen by the observer, relative to frame */ -/* J2000. */ - - } else { - setmsg_("Definition of two-vector parameterized dynamic " - "frame # includes vector definition #, which is n" - "ot supported. This situation is usually caused " - "by an error in a frame kernel in which the frame" - " is defined.", (ftnlen)203); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errch_("#", vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", ( - ftnlen)1649)) * 80, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* Negate the vector if the axis has negative sign. */ - - if (negate) { - vminus_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("v2", i__1, "zzdynrt0_", (ftnlen)1660)], - ptemp); - moved_(ptemp, &c__3, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= - i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", ( - ftnlen)1661)]); - } - } - -/* Look up the lower bound for the angular separation of */ -/* the defining vectors. Use the default value if none */ -/* was supplied. */ - - zzdynoad_(inname__, infram, itmsep, &c__1, &n, &minsep, &fnd, ( - ftnlen)32, (ftnlen)32); - if (! fnd) { - minsep = .001; - } - -/* Now use our vectors to compute our position transformation */ -/* matrix. */ - -/* Check the angular separation of the defining vectors. We */ -/* want to ensure that the vectors are not too close to being */ -/* linearly dependent. We can handle both cases---separation */ -/* close to 0 or separation close to Pi---by comparing the */ -/* sine of the separation to the sine of the separation limit. */ - - sep = vsep_(v2, &v2[3]); - if (sin(sep) < sin(minsep)) { - etcal_(&t0, timstr, (ftnlen)50); - setmsg_("Angular separation of vectors defining two-vector p" - "arameterized dynamic frame # is # (radians); minimum" - " allowed difference of separation from 0 or Pi is # " - "radians. Evaluation epoch is #. Extreme loss of pr" - "ecision can occur when defining vectors are nearly l" - "inearly dependent. This type of error can be due to" - " using a dynamic frame outside of the time range for" - " which it is meant. It also can be due to a conceptu" - "al error pertaining to the frame's definition, or to" - " an implementation error in the frame kernel contain" - "ing the frame definition. However, if you wish to pr" - "oceed with this computation, the # keyword can be us" - "ed in the frame definition to adjust the separation " - "limit.", (ftnlen)681); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - errdp_("#", &sep, (ftnlen)1); - errdp_("#", &minsep, (ftnlen)1); - errch_("#", timstr, (ftnlen)1, (ftnlen)50); - errch_("#", "ANGLE_SEP_TOL", (ftnlen)1, (ftnlen)13); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* We have both positions expressed relative to frame J2000 */ -/* at this point. Find the transformation from INNAME to */ -/* the frame J2000, then from J2000 to frame BASNAM. */ - - twovec_(v2, axis, &v2[3], &axis[1], rinv); - xpose_(rinv, rtemp); - zzrefch1_(&j2000, basfrm, &t0, r2000); - mxm_(r2000, rtemp, rotate); - -/* This is the end of the work specific to two-vector frames. */ -/* From here we drop out of the IF block. */ - - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - } else if (s_cmp(dynfam, "EULER", (ftnlen)80, (ftnlen)5) == 0) { - -/* The frame belongs to the Euler family. */ - -/* We expect to specifications of an axis sequence, units, */ -/* and angles via polynomial coefficients. We also expect */ -/* to see an ET epoch. */ - -/* Look up the epoch first. Let DELTA represent the offset */ -/* of T0 relative to the epoch. */ - -/* Initialize EPOCH so subtraction doesn't overflow if EPOCH */ -/* is invalid due to a lookup error. */ - - epoch = 0.; - zzdynvad_(inname__, infram, "EPOCH", &c__1, &n, &epoch, (ftnlen) - 32, (ftnlen)5); - delta = t0 - epoch; - -/* Now the axis sequence. */ - - zzdynvai_(inname__, infram, "AXES", &c__3, &n, iaxes, (ftnlen)32, - (ftnlen)4); - -/* Now the coefficients for the angles. */ - - for (i__ = 1; i__ <= 3; ++i__) { - -/* Initialize N so subtraction doesn't overflow if N */ -/* is invalid due to a lookup error. */ - - n = 0; - zzdynvad_(inname__, infram, itmcof + (((i__1 = i__ - 1) < 3 && - 0 <= i__1 ? i__1 : s_rnge("itmcof", i__1, "zzdynrt0_" - , (ftnlen)1778)) << 5), &c__20, &n, &coeffs[(i__2 = - i__ * 20 - 20) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "coeffs", i__2, "zzdynrt0_", (ftnlen)1778)], (ftnlen) - 32, (ftnlen)32); - -/* Set the polynomial degree for the Ith angle. */ - - degs[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("degs", - i__1, "zzdynrt0_", (ftnlen)1784)] = n - 1; - } - -/* Look up the units associated with the angles. */ - - zzdynvac_(inname__, infram, "UNITS", &c__1, &n, units, (ftnlen)32, - (ftnlen)5, (ftnlen)80); - -/* Evaluate the angles at DELTA. Convert angles from input */ -/* units to radians. */ - - for (i__ = 1; i__ <= 3; ++i__) { - polyds_(&coeffs[(i__1 = i__ * 20 - 20) < 60 && 0 <= i__1 ? - i__1 : s_rnge("coeffs", i__1, "zzdynrt0_", (ftnlen) - 1799)], °s[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("degs", i__2, "zzdynrt0_", (ftnlen)1799) - ], &c__0, &delta, poly); - -/* Convert units. Fill in the Euler angle vector. */ - - convrt_(poly, units, "RADIANS", &eulang[(i__1 = i__ - 1) < 3 - && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzdynr" - "t0_", (ftnlen)1803)], (ftnlen)80, (ftnlen)7); - } - -/* Produce a position transformation matrix that maps from */ -/* the defined frame to the base frame. */ - - eul2m_(eulang, &eulang[1], &eulang[2], iaxes, &iaxes[1], &iaxes[2] - , rotate); - -/* This is the end of the work specific to Euler frames. */ -/* From here we drop out of the IF block. */ - - if (failed_()) { - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - } else { - setmsg_("Dynamic frame family # (in definition of frame #) is no" - "t supported. This situation is usually caused by an erro" - "r in a frame kernel in which the frame is defined.", ( - ftnlen)161); - errch_("#", dynfam, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* This is the end of the IF block that processes the */ -/* parameterized dynamic frame families. */ - - } else { - setmsg_("Dynamic frame style # (in definition of frame #) is not sup" - "ported. This situation is usually caused by an error in a fr" - "ame kernel in which the frame is defined.", (ftnlen)160); - errch_("#", dynstl, (ftnlen)1, (ftnlen)80); - errch_("#", inname__, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; - } - -/* At this point ROTATE is the position transformation matrix */ -/* mapping from the input frame INFRAM to the base frame BASFRM. */ - -/* ROTATE and BASFRM is set. */ - - chkout_("ZZDYNRT0", (ftnlen)8); - return 0; -} /* zzdynrt0_ */ - diff --git a/ext/spice/src/cspice/zzdynvac.c b/ext/spice/src/cspice/zzdynvac.c deleted file mode 100644 index e60068745d..0000000000 --- a/ext/spice/src/cspice/zzdynvac.c +++ /dev/null @@ -1,813 +0,0 @@ -/* zzdynvac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNVAC ( Fetch array, character frame kernel variable ) */ -/* Subroutine */ int zzdynvac_(char *frname, integer *frcode, char *item, - integer *maxn, integer *n, char *values, ftnlen frname_len, ftnlen - item_len, ftnlen values_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gcpool_(char *, integer *, integer *, integer *, char - *, logical *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up array-valued character frame kernel variable. The frame */ -/* name or frame ID may be used as part of the variable's name. */ - -/* If the kernel variable is not present, or if the variable */ -/* has the wrong data type, signal an error. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* MAXN I Maximum number of values to return. */ -/* N O Number of returned values. */ -/* VALUES O Output kernel variable. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a character variable */ -/* of that name first. */ - -/* $ Detailed_Output */ - -/* N is the number of values returned in the array */ -/* VALUES. */ - -/* VALUES are the values associated with the requested */ -/* array-valued, character kernel variable. The */ -/* kernel variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has character type, the associated */ -/* values will be returned. If this variable is */ -/* not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If a character variable */ -/* having that name is found, the associated */ -/* values will be returned. */ - -/* $ Parameters */ - -/* See zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If neither the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name matches a kernel variable */ -/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */ -/* will be signaled. */ - -/* 2) If either the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name has length greater than KVNMLN, */ -/* the excessively long name will not be searched for. A search */ -/* will still be done using the alternative form of the name if */ -/* that form has length less than or equal to KVNMLN. */ - -/* 3) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has numeric data */ -/* type, the error SPICE(BADVARIABLETYPE) will be signaled. */ - -/* 5) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than MAXN */ -/* associated values, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. Part of the */ -/* functionality of this routine consists of handling error */ -/* conditions such as the unavailability of required kernel */ -/* variables; hence no "found" flag is returned to the caller. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* data structure, these names are distinct. Hence kernel variables */ -/* having names of both forms, but having possibly different */ -/* attributes, can be simultaneously present in the kernel pool. */ -/* Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) A scalar-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially */ -/* mask an array-valued kernel variable matching the "name */ -/* form" of the requested name. This problem can be prevented */ -/* by sensible frame kernel design. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNVAC", (ftnlen)8); - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - found = FALSE_; - } - if (! found) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - -/* Note that at this point KVNAME contains the ID-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to an error in a frame definition pr" - "ovided in a frame kernel.", (ftnlen)416); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1); - if (! found && reqnum > 32) { - -/* The kernel variable's presence (in one form or the other) */ -/* is mandatory: signal an error. The error message */ -/* depends on which variables we were able to try to */ -/* look up. In this case, we never tried to look up the */ -/* frame ID-based name. */ - -/* Note that at this point KVNAME contains the name-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to an error in a frame definition pr" - "ovided in a frame kernel.", (ftnlen)416); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } else if (! found) { - -/* We tried to look up both names and failed. */ - - setmsg_("At least one of the kernel variables FRAME_#_# or FRAME" - "_#_# was expected to be present in the kernel pool but n" - "either was found. One of these variables is needed to de" - "fine the parameterized dynamic frame #. Usually this ty" - "pe of problem is due to a missing keyword assignment in " - "a frame kernel. Another, less likely, possibility is th" - "at other errors in a frame kernel have confused the fram" - "e subsystem into wrongly deciding these variables are ne" - "eded.", (ftnlen)452); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - -/* Rather than using BADKPV, we check the data type and cardinality */ -/* of the kernel variable in-line so we can create a more detailed */ -/* error message if need be. */ - - if (*(unsigned char *)dtype == 'N') { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have character data type but in fact has numeric data " - "type. Usually this type of problem is due to an error in a " - "frame definition provided in a frame kernel.", (ftnlen)223); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } - if (*n > *maxn) { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have size not exceeding # but in fact has size #. Usua" - "lly this type of problem is due to an error in a frame defin" - "ition provided in a frame kernel.", (ftnlen)212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", maxn, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gcpool_(kvname, &c__1, maxn, n, values, &found, (ftnlen)32, values_len); - if (! found) { - setmsg_("Variable # not found after DTPOOL indicated it was present " - "in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; - } - chkout_("ZZDYNVAC", (ftnlen)8); - return 0; -} /* zzdynvac_ */ - diff --git a/ext/spice/src/cspice/zzdynvad.c b/ext/spice/src/cspice/zzdynvad.c deleted file mode 100644 index 02a5e6e7d5..0000000000 --- a/ext/spice/src/cspice/zzdynvad.c +++ /dev/null @@ -1,815 +0,0 @@ -/* zzdynvad.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNVAD ( Fetch array, d.p. frame kernel variable ) */ -/* Subroutine */ int zzdynvad_(char *frname, integer *frcode, char *item, - integer *maxn, integer *n, doublereal *values, ftnlen frname_len, - ftnlen item_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gdpool_(char *, integer *, integer *, integer *, - doublereal *, logical *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up array-valued double precision frame kernel variable. */ -/* The frame name or frame ID may be used as part of the variable's */ -/* name. */ - -/* If the kernel variable is not present, or if the variable */ -/* has the wrong data type, signal an error. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* MAXN I Maximum number of values to return. */ -/* N O Number of returned values. */ -/* VALUES O Output kernel variable. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a numeric variable */ -/* of that name first. */ - -/* $ Detailed_Output */ - -/* N is the number of values returned in the array */ -/* VALUES. */ - -/* VALUES are the values associated with the requested */ -/* array-valued, double precision kernel variable. */ -/* The kernel variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has numeric type, the associated */ -/* values will be returned. If this variable is */ -/* not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If a numeric variable */ -/* having that name is found, the associated */ -/* values will be returned. */ - -/* $ Parameters */ - -/* See zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If neither the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name matches a kernel variable */ -/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */ -/* will be signaled. */ - -/* 2) If either the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name has length greater than KVNMLN, */ -/* the excessively long name will not be searched for. A search */ -/* will still be done using the alternative form of the name if */ -/* that form has length less than or equal to KVNMLN. */ - -/* 3) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has character data */ -/* type, the error SPICE(BADVARIABLETYPE) will be signaled. */ - -/* 5) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than MAXN */ -/* associated values, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. Part of the */ -/* functionality of this routine consists of handling error */ -/* conditions such as the unavailability of required kernel */ -/* variables; hence no "found" flag is returned to the caller. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* data structure, these names are distinct. Hence kernel variables */ -/* having names of both forms, but having possibly different */ -/* attributes, can be simultaneously present in the kernel pool. */ -/* Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) A scalar-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially */ -/* mask an array-valued kernel variable matching the "name */ -/* form" of the requested name. This problem can be prevented */ -/* by sensible frame kernel design. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNVAD", (ftnlen)8); - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - found = FALSE_; - } - if (! found) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - -/* Note that at this point KVNAME contains the ID-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to an error in a frame definition pr" - "ovided in a frame kernel.", (ftnlen)416); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1); - if (! found && reqnum > 32) { - -/* The kernel variable's presence (in one form or the other) */ -/* is mandatory: signal an error. The error message */ -/* depends on which variables we were able to try to */ -/* look up. In this case, we never tried to look up the */ -/* frame ID-based name. */ - -/* Note that at this point KVNAME contains the name-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to an error in a frame definition pr" - "ovided in a frame kernel.", (ftnlen)416); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } else if (! found) { - -/* We tried to look up both names and failed. */ - - setmsg_("At least one of the kernel variables FRAME_#_# or FRAME" - "_#_# was expected to be present in the kernel pool but n" - "either was found. One of these variables is needed to de" - "fine the parameterized dynamic frame #. Usually this ty" - "pe of problem is due to a missing keyword assignment in " - "a frame kernel. Another, less likely, possibility is th" - "at other errors in a frame kernel have confused the fram" - "e subsystem into wrongly deciding these variables are ne" - "eded.", (ftnlen)452); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - -/* Rather than using BADKPV, we check the data type and cardinality */ -/* of the kernel variable in-line so we can create a more detailed */ -/* error message if need be. */ - - if (*(unsigned char *)dtype == 'C') { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have double precision data type but in fact has chara" - "cter type. Usually this type of problem is due to an error " - "in a frame definition provided in a frame kernel.", (ftnlen) - 228); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } - if (*n > *maxn) { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have size not exceeding # but in fact has size #. Usua" - "lly this type of problem is due to an error in a frame defin" - "ition provided in a frame kernel.", (ftnlen)212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", maxn, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gdpool_(kvname, &c__1, maxn, n, values, &found, (ftnlen)32); - if (! found) { - setmsg_("Variable # not found after DTPOOL indicated it was present " - "in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; - } - chkout_("ZZDYNVAD", (ftnlen)8); - return 0; -} /* zzdynvad_ */ - diff --git a/ext/spice/src/cspice/zzdynvai.c b/ext/spice/src/cspice/zzdynvai.c deleted file mode 100644 index ddd5c6cacc..0000000000 --- a/ext/spice/src/cspice/zzdynvai.c +++ /dev/null @@ -1,818 +0,0 @@ -/* zzdynvai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__1 = 1; - -/* $Procedure ZZDYNVAI ( Fetch array, integer frame kernel variable ) */ -/* Subroutine */ int zzdynvai_(char *frname, integer *frcode, char *item, - integer *maxn, integer *n, integer *values, ftnlen frname_len, ftnlen - item_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - char dtype[1]; - extern integer rtrim_(char *, ftnlen); - extern logical failed_(void); - integer codeln, nameln; - char kvname[32], cdestr[32]; - integer itemln, reqnam; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer reqnum; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_( - char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), gipool_(char *, integer *, integer *, integer *, - integer *, logical *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up array-valued integer frame kernel variable. The frame */ -/* name or frame ID may be used as part of the variable's name. */ - -/* If the kernel variable is not present, or if the variable */ -/* has the wrong data type, signal an error. */ - -/* $ 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 */ - -/* FRAMES */ -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzdyn.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters defined below are used by the SPICELIB dynamic */ -/* frame subsystem. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* This file declares parameters required by the dynamic */ -/* frame routines of the SPICELIB frame subsystem. */ - -/* $ Restrictions */ - -/* The parameter BDNMLN is this routine must be kept */ -/* consistent with the parameter MAXL defined in */ - -/* zzbodtrn.inc */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */ - -/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */ - -/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */ - -/* -& */ - -/* String length parameters */ -/* ======================== */ - - -/* Kernel variable name length. This parameter must be */ -/* kept consistent with the parameter MAXLEN used in the */ -/* POOL umbrella routine. */ - - -/* Length of a character kernel pool datum. This parameter must be */ -/* kept consistent with the parameter MAXCHR used in the POOL */ -/* umbrella routine. */ - - -/* Reference frame name length. This parameter must be */ -/* kept consistent with the parameter WDSIZE used in the */ -/* FRAMEX umbrella routine. */ - - -/* Body name length. This parameter is used to provide a level */ -/* of indirection so the dynamic frame source code doesn't */ -/* have to change if the name of this SPICELIB-scope parameter */ -/* is changed. The value MAXL used here is defined in the */ -/* INCLUDE file */ - -/* zzbodtrn.inc */ - -/* Current value of MAXL = 36 */ - - -/* Numeric parameters */ -/* =================================== */ - -/* The parameter MAXCOF is the maximum number of polynomial */ -/* coefficients that may be used to define an Euler angle */ -/* in an "Euler frame" definition */ - - -/* The parameter LBSEP is the default angular separation limit for */ -/* the vectors defining a two-vector frame. The angular separation */ -/* of the vectors must differ from Pi and 0 by at least this amount. */ - - -/* The parameter QEXP is used to determine the width of */ -/* the interval DELTA used for the discrete differentiation */ -/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */ -/* recursive analogs. This parameter is appropriate for */ -/* 64-bit IEEE double precision numbers; when SPICELIB */ -/* is hosted on platforms where longer mantissas are supported, */ -/* this parameter (and hence this INCLUDE file) will become */ -/* platform-dependent. */ - -/* The choice of QEXP is based on heuristics. It's believed to */ -/* be a reasonable choice obtainable without expensive computation. */ - -/* QEXP is the largest power of 2 such that */ - -/* 1.D0 + 2**QEXP = 1.D0 */ - -/* Given an epoch T0 at which a discrete derivative is to be */ -/* computed, this choice provides a value of DELTA that usually */ -/* contributes no round-off error in the computation of the function */ -/* evaluation epochs */ - -/* T0 +/- DELTA */ - -/* while providing the largest value of DELTA having this form that */ -/* causes the order of the error term O(DELTA**2) in the quadratric */ -/* function approximation to round to zero. Note that the error */ -/* itself will normally be small but doesn't necessarily round to */ -/* zero. Note also that the small function approximation error */ -/* is not a measurement of the error in the discrete derivative */ -/* itself. */ - -/* For ET values T0 > 2**27 seconds past J2000, the value of */ -/* DELTA will be set to */ - -/* T0 * 2**QEXP */ - -/* For smaller values of T0, DELTA should be set to 1.D0. */ - - -/* Frame kernel parameters */ -/* ======================= */ - -/* Parameters relating to kernel variable names (keywords) start */ -/* with the letters */ - -/* KW */ - -/* Parameters relating to kernel variable values start with the */ -/* letters */ - -/* KV */ - - -/* Generic parameters */ -/* --------------------------------- */ - -/* Token used to build the base frame keyword: */ - - -/* Frame definition style parameters */ -/* --------------------------------- */ - -/* Token used to build the frame definition style keyword: */ - - -/* Token indicating parameterized dynamic frame. */ - - -/* Freeze epoch parameters */ -/* --------------------------------- */ - -/* Token used to build the freeze epoch keyword: */ - - -/* Rotation state parameters */ -/* --------------------------------- */ - -/* Token used to build the rotation state keyword: */ - - -/* Token indicating rotating rotation state: */ - - -/* Token indicating inertial rotation state: */ - - -/* Frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the frame family keyword: */ - - -/* Token indicating mean equator and equinox of date frame. */ - - -/* Token indicating mean ecliptic and equinox of date frame. */ - - -/* Token indicating true equator and equinox of date frame. */ - - -/* Token indicating two-vector frame. */ - - -/* Token indicating Euler frame. */ - - -/* "Of date" frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the precession model keyword: */ - - -/* Token used to build the nutation model keyword: */ - - -/* Token used to build the obliquity model keyword: */ - - -/* Mathematical models used to define "of date" frames will */ -/* likely accrue over time. We will simply assign them */ -/* numbers. */ - - -/* Token indicating the Lieske earth precession model: */ - - -/* Token indicating the IAU 1980 earth nutation model: */ - - -/* Token indicating the IAU 1980 earth mean obliqity of */ -/* date model. Note the name matches that of the preceding */ -/* nutation model---this is intentional. The keyword */ -/* used in the kernel variable definition indicates what */ -/* kind of model is being defined. */ - - -/* Two-vector frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the vector axis keyword: */ - - -/* Tokens indicating axis values: */ - - -/* Prefixes used for primary and secondary vector definition */ -/* keywords: */ - - -/* Token used to build the vector definition keyword: */ - - -/* Token indicating observer-target position vector: */ - - -/* Token indicating observer-target velocity vector: */ - - -/* Token indicating observer-target near point vector: */ - - -/* Token indicating constant vector: */ - - -/* Token used to build the vector observer keyword: */ - - -/* Token used to build the vector target keyword: */ - - -/* Token used to build the vector frame keyword: */ - - -/* Token used to build the vector aberration correction keyword: */ - - -/* Token used to build the constant vector specification keyword: */ - - -/* Token indicating rectangular coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating latitudinal coordinates used to */ -/* specify constant vector: */ - - -/* Token indicating RA/DEC coordinates used to */ -/* specify constant vector: */ - - -/* Token used to build the cartesian vector literal keyword: */ - - -/* Token used to build the constant vector latitude keyword: */ - - -/* Token used to build the constant vector longitude keyword: */ - - -/* Token used to build the constant vector right ascension keyword: */ - - -/* Token used to build the constant vector declination keyword: */ - - -/* Token used to build the angular separation tolerance keyword: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to two-vector frames. */ - - -/* Euler frame family parameters */ -/* --------------------------------- */ - -/* Token used to build the epoch keyword: */ - - -/* Token used to build the Euler axis sequence keyword: */ - - -/* Tokens used to build the Euler angle coefficients keywords: */ - - -/* See the section "Physical unit parameters" below for additional */ -/* parameters applicable to Euler frames. */ - - -/* Physical unit parameters */ -/* --------------------------------- */ - -/* Token used to build the units keyword: */ - - -/* Token indicating radians: */ - - -/* Token indicating degrees: */ - - -/* End of include file zzdyn.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* FRNAME I Frame name. */ -/* FRCODE I Frame ID code. */ -/* ITEM I Item associated with frame definition. */ -/* MAXN I Maximum number of values to return. */ -/* N O Number of returned values. */ -/* VALUES O Output kernel variable. */ - -/* $ Detailed_Input */ - -/* FRNAME is the name of the reference frame with which */ -/* the requested variable is associated. */ - -/* FRCODE is the frame ID code of the reference frame with */ -/* which the requested variable is associated. */ - -/* ITEM is a string identifying the specific datum */ -/* to be fetched. The kernel variable name */ -/* has the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* The former of the two names takes precedence: */ -/* this routine will look for a numeric variable */ -/* of that name first. */ - -/* $ Detailed_Output */ - -/* N is the number of values returned in the array */ -/* VALUES. */ - -/* VALUES are the values associated with the requested */ -/* array-valued, integer kernel variable. The kernel */ -/* variable name of the form */ - -/* FRAME__ */ - -/* will be looked up first; if this variable */ -/* is found and has numeric type, the associated */ -/* values will be returned. If this variable is */ -/* not found, the variable */ - -/* FRAME__ */ - -/* will be looked up. If a numeric variable */ -/* having that name is found, the associated */ -/* values will be returned. */ - -/* $ Parameters */ - -/* See zzdyn.inc. */ - -/* $ Exceptions */ - -/* 1) If neither the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name matches a kernel variable */ -/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */ -/* will be signaled. */ - -/* 2) If either the frame-ID-based or frame-name-based form of the */ -/* requested kernel variable name has length greater than KVNMLN, */ -/* the excessively long name will not be searched for. A search */ -/* will still be done using the alternative form of the name if */ -/* that form has length less than or equal to KVNMLN. */ - -/* 3) If both the frame-ID-based and frame-name-based forms of the */ -/* requested kernel variable name have length greater than KVNMLN, */ -/* the error SPICE(VARNAMETOOLONG) will be signaled. */ - -/* 4) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has character data */ -/* type, the error SPICE(BADVARIABLETYPE) will be signaled. */ - -/* 5) If kernel variable matching one form of the requested kernel */ -/* variable names is found, but that variable has more than MAXN */ -/* associated values, the error SPICE(BADVARIABLESIZE) will be */ -/* signaled. */ - -/* 6) If a name match is found for a numeric kernel variable, */ -/* but that variable has a value that cannot be rounded to an */ -/* integer representable on the host platform, an error will */ -/* be signaled by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* 1) Kernel variables fetched by this routine are normally */ -/* introduced into the kernel pool by loading one or more */ -/* frame kernels. See the Frames Required Reading for */ -/* details. */ - -/* $ Particulars */ - -/* This routine centralizes logic for kernel variable lookups that */ -/* must be performed by the SPICELIB frame subsystem. Part of the */ -/* functionality of this routine consists of handling error */ -/* conditions such as the unavailability of required kernel */ -/* variables; hence no "found" flag is returned to the caller. */ - -/* As indicated above, the requested kernel variable may have a name */ -/* of the form */ - -/* FRAME__ */ - -/* or */ - -/* FRAME__ */ - -/* Because most frame definition keywords have the first form, this */ -/* routine looks for a name of that form first. */ - -/* Note that although this routine considers the two forms of the */ -/* names to be synonymous, from the point of view of the kernel pool */ -/* data structure, these names are distinct. Hence kernel variables */ -/* having names of both forms, but having possibly different */ -/* attributes, can be simultaneously present in the kernel pool. */ -/* Intentional use of this kernel pool feature is discouraged. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) A scalar-valued kernel variable matching the "ID code form" */ -/* of the requested kernel variable name could potentially */ -/* mask an array-valued kernel variable matching the "name */ -/* form" of the requested name. This problem can be prevented */ -/* by sensible frame kernel design. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* TEMPLN is the length of the keyword template, minus */ -/* the sum of the lengths of the two substitution markers ('#'). */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("ZZDYNVAI", (ftnlen)8); - -/* Prepare to check the name of the kernel variable we're about */ -/* to look up. */ - -/* Convert the frame code to a string. */ - - intstr_(frcode, cdestr, (ftnlen)32); - if (failed_()) { - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } - -/* Get the lengths of the input frame code, name and item. */ -/* Compute the length of the ID-based kernel variable name; */ -/* check this length against the maximum allowed value. If */ -/* the name is too long, proceed to look up the form of the */ -/* kernel variable name based on the frame name. */ - - codeln = rtrim_(cdestr, (ftnlen)32); - nameln = rtrim_(frname, frname_len); - itemln = rtrim_(item, item_len); - reqnum = codeln + itemln + 7; - if (reqnum <= 32) { - -/* First try looking for a kernel variable including the frame ID */ -/* code. */ - -/* Note the template is */ - -/* 'FRAME_#_#' */ - - repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, ( - ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1); - } else { - -/* The ID-based name is too long. We can't find the variable if */ -/* we can't look it up. */ - - found = FALSE_; - } - if (! found) { - -/* We need to look up the frame name-based kernel variable. */ -/* Determine the length of the name of this variable; make */ -/* sure it's not too long. */ - - reqnam = nameln + itemln + 7; - if (reqnam > 32 && reqnum > 32) { - -/* Both forms of the name are too long. */ - - setmsg_("Kernel variable FRAME_#_# has length #; kernel variable" - " FRAME_#_# has length #; maximum allowed length is #. N" - "either variable could be searched for in the kernel pool" - " due to these name length errors.", (ftnlen)200); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } else if (reqnam > 32) { - -/* We couldn't find the variable having the ID-based name, */ -/* and the frame name-based variable name is too long to */ -/* look up. */ - -/* Note that at this point KVNAME contains the ID-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to an error in a frame definition pr" - "ovided in a frame kernel.", (ftnlen)416); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnam, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } - -/* Now try looking for a kernel variable including the frame */ -/* name. */ - - repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, - frname_len, (ftnlen)32); - repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, ( - ftnlen)32); - dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1); - if (! found && reqnum > 32) { - -/* The kernel variable's presence (in one form or the other) */ -/* is mandatory: signal an error. The error message */ -/* depends on which variables we were able to try to */ -/* look up. In this case, we never tried to look up the */ -/* frame ID-based name. */ - -/* Note that at this point KVNAME contains the name-based */ -/* kernel variable name. */ - - setmsg_("Kernel variable # was expected to be present in the ker" - "nel pool but was not found. The alternative form of ker" - "nel variable name FRAME_#_# was not searched for because" - " this name has excessive length (# characters vs allowed" - " maximum of #). One of these variables is needed to def" - "ine the parameterized dynamic frame #. Usually this typ" - "e of problem is due to an error in a frame definition pr" - "ovided in a frame kernel.", (ftnlen)416); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errint_("#", &reqnum, (ftnlen)1); - errint_("#", &c__32, (ftnlen)1); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } else if (! found) { - -/* We tried to look up both names and failed. */ - - setmsg_("At least one of the kernel variables FRAME_#_# or FRAME" - "_#_# was expected to be present in the kernel pool but n" - "either was found. One of these variables is needed to de" - "fine the parameterized dynamic frame #. Usually this ty" - "pe of problem is due to a missing keyword assignment in " - "a frame kernel. Another, less likely, possibility is th" - "at other errors in a frame kernel have confused the fram" - "e subsystem into wrongly deciding these variables are ne" - "eded.", (ftnlen)452); - errint_("#", frcode, (ftnlen)1); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - errch_("#", item, (ftnlen)1, item_len); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } - } - -/* Getting to this point means we found a kernel variable. The name */ -/* of the variable is KVNAME. The data type is DTYPE and the */ -/* cardinality is N. */ - -/* Rather than using BADKPV, we check the data type and cardinality */ -/* of the kernel variable in-line so we can create a more detailed */ -/* error message if need be. */ - - if (*(unsigned char *)dtype == 'C') { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have integer data type but in fact has character type." - " Usually this type of problem is due to an error in a frame" - " definition provided in a frame kernel.", (ftnlen)218); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } - if (*n > *maxn) { - setmsg_("The kernel variable # has used to define frame # was expect" - "ed to have size not exceeding # but in fact has size #. Usua" - "lly this type of problem is due to an error in a frame defin" - "ition provided in a frame kernel.", (ftnlen)212); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - errch_("#", frname, (ftnlen)1, frname_len); - errint_("#", maxn, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } - -/* Look up the kernel variable. */ - - gipool_(kvname, &c__1, maxn, n, values, &found, (ftnlen)32); - if (! found) { - setmsg_("Variable # not found after DTPOOL indicated it was present " - "in pool.", (ftnlen)67); - errch_("#", kvname, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; - } - chkout_("ZZDYNVAI", (ftnlen)8); - return 0; -} /* zzdynvai_ */ - diff --git a/ext/spice/src/cspice/zzedterm.c b/ext/spice/src/cspice/zzedterm.c deleted file mode 100644 index 3b9a17c22b..0000000000 --- a/ext/spice/src/cspice/zzedterm.c +++ /dev/null @@ -1,598 +0,0 @@ -/* zzedterm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b30 = 0.; -static doublereal c_b35 = 1.; - -/* $Procedure ZZEDTERM ( Ellipsoid terminator ) */ -/* Subroutine */ int zzedterm_(char *type__, doublereal *a, doublereal *b, - doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer * - npts, doublereal *trmpts, ftnlen type_len) -{ - /* System generated locals */ - integer trmpts_dim2, i__1, i__2; - doublereal d__1, d__2, d__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - double asin(doublereal); - integer s_rnge(char *, integer, char *, integer); - double d_sign(doublereal *, doublereal *); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal rmin, rmax; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - integer nitr; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal d__, e[3]; - integer i__; - doublereal s, angle, v[3], x[3], delta, y[3], z__[3], inang; - extern /* Subroutine */ int chkin_(char *, ftnlen), frame_(doublereal *, - doublereal *, doublereal *); - doublereal plane[4]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen), vpack_(doublereal *, - doublereal *, doublereal *, doublereal *); - doublereal theta; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal trans[9] /* was [3][3] */, srcpt[3], vtemp[3]; - extern doublereal vnorm_(doublereal *), twopi_(void); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - pl2nvc_(doublereal *, doublereal *, doublereal *); - doublereal lambda; - extern /* Subroutine */ int nvp2pl_(doublereal *, doublereal *, - doublereal *); - extern doublereal halfpi_(void); - doublereal minang, minrad, maxang, maxrad; - extern /* Subroutine */ int latrec_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal angerr; - logical umbral; - extern doublereal touchd_(doublereal *); - doublereal offset[3], prvdif; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - doublereal outang, plcons, prvang; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - char loctyp[50]; - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - doublereal dir[3]; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - doublereal vtx[3]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute a set of points on the umbral or penumbral terminator of */ -/* a specified ellipsoid, given a spherical light source. */ - -/* $ 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 */ - -/* ELLIPSES */ - -/* $ Keywords */ - -/* BODY */ -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TYPE I Terminator type. */ -/* A I Length of ellipsoid semi-axis lying on the x-axis. */ -/* B I Length of ellipsoid semi-axis lying on the y-axis. */ -/* C I Length of ellipsoid semi-axis lying on the z-axis. */ -/* SRCRAD I Radius of light source. */ -/* SRCPOS I Position of center of light source. */ -/* NPTS I Number of points in terminator point set. */ -/* TRMPTS O Terminator point set. */ - -/* $ Detailed_Input */ - -/* TYPE is a string indicating the type of terminator to */ -/* compute: umbral or penumbral. The umbral */ -/* terminator is the boundary of the portion of the */ -/* ellipsoid surface in total shadow. The penumbral */ -/* terminator is the boundary of the portion of the */ -/* surface that is completely illuminated. Possible */ -/* values of TYPE are */ - -/* 'UMBRAL' */ -/* 'PENUMBRAL' */ - -/* Case and leading or trailing blanks in TYPE are */ -/* not significant. */ - -/* A, */ -/* B, */ -/* C are the lengths of the semi-axes of a triaxial */ -/* ellipsoid. The ellipsoid is centered at the */ -/* origin and oriented so that its axes lie on the */ -/* x, y and z axes. A, B, and C are the lengths of */ -/* the semi-axes that point in the x, y, and z */ -/* directions respectively. */ - -/* Length units associated with A, B, and C must */ -/* match those associated with SRCRAD, SRCPOS, */ -/* and the output TRMPTS. */ - -/* SRCRAD is the radius of the spherical light source. */ - -/* SRCPOS is the position of the center of the light source */ -/* relative to the center of the ellipsoid. */ - -/* NPTS is the number of terminator points to compute. */ - - -/* $ Detailed_Output */ - -/* TRMPTS is an array of points on the umbral or penumbral */ -/* terminator of the ellipsoid, as specified by the */ -/* input argument TYPE. The Ith point is contained */ -/* in the array elements */ - -/* TRMPTS(J,I), J = 1, 2, 3 */ - -/* The terminator points are expressed in the */ -/* body-fixed reference frame associated with the */ -/* ellipsoid. Units are those associated with */ -/* the input axis lengths. */ - -/* Each terminator point is the point of tangency of */ -/* a plane that is also tangent to the light source. */ -/* These associated points of tangency on the light */ -/* source have uniform distribution in longitude when */ -/* expressed in a cylindrical coordinate system whose */ -/* Z-axis is SRCPOS. The magnitude of the separation */ -/* in longitude between these tangency points on the */ -/* light source is */ - -/* 2*Pi / NPTS */ - -/* If the target is spherical, the terminator points */ -/* also are uniformly distributed in longitude in the */ -/* cylindrical system described above. If the target */ -/* is non-spherical, the longitude distribution of */ -/* the points generally is not uniform. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the terminator type is not recognized, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 2) If the set size NPTS is not at least 1, the error */ -/* SPICE(INVALIDSIZE) is signaled. */ - -/* 3) If any of the ellipsoid's semi-axis lengths is non-positive, */ -/* the error SPICE(INVALIDAXISLENGTH) is signaled. */ - -/* 4) If the light source has non-positive radius, the error */ -/* SPICE(INVALIDRADIUS) is signaled. */ - -/* 5) If the light source intersects the smallest sphere */ -/* centered at the origin and containing the ellipsoid, the */ -/* error SPICE(OBJECTSTOOCLOSE) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine models the boundaries of shadow regions on an */ -/* ellipsoid "illuminated" by a spherical light source. Light rays */ -/* are assumed to travel along straight lines; refraction is not */ -/* modeled. */ - -/* Points on the ellipsoid at which the entire cap of the light */ -/* source is visible are considered to be completely illuminated. */ -/* Points on the ellipsoid at which some portion (or all) of the cap */ -/* of the light source are blocked are considered to be in partial */ -/* (or total) shadow. */ - -/* In this routine, we use the term "umbral terminator" to denote */ -/* the curve ususally called the "terminator": this curve is the */ -/* boundary of the portion of the surface that lies in total shadow. */ -/* We use the term "penumbral terminator" to denote the boundary of */ -/* the completely illuminated portion of the surface. */ - -/* In general, the terminator on an ellipsoid is a more complicated */ -/* curve than the limb (which is always an ellipse). Aside from */ -/* various special cases, the terminator does not lie in a plane. */ - -/* However, the condition for a point X on the ellipsoid to lie on */ -/* the terminator is simple: a plane tangent to the ellipsoid at X */ -/* must also be tangent to the light source. If this tangent plane */ -/* does not intersect the vector from the center of the ellipsoid to */ -/* the center of the light source, then X lies on the umbral */ -/* terminator; otherwise X lies on the penumbral terminator. */ - -/* $ Examples */ - -/* See the SPICELIB routine EDTERM. */ - -/* $ Restrictions */ - -/* This is a private SPICELIB routine. User applications should not */ -/* call this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-FEB-2007 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find terminator on ellipsoid */ -/* find umbral terminator on ellipsoid */ -/* find penumbral terminator on ellipsoid */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICELIB error handling. */ - - /* Parameter adjustments */ - trmpts_dim2 = *npts; - - /* Function Body */ - if (return_()) { - return 0; - } - chkin_("ZZEDTERM", (ftnlen)8); - -/* Check the terminator type. */ - - ljust_(type__, loctyp, type_len, (ftnlen)50); - ucase_(loctyp, loctyp, (ftnlen)50, (ftnlen)50); - if (s_cmp(loctyp, "UMBRAL", (ftnlen)50, (ftnlen)6) == 0) { - umbral = TRUE_; - } else if (s_cmp(loctyp, "PENUMBRAL", (ftnlen)50, (ftnlen)9) == 0) { - umbral = FALSE_; - } else { - setmsg_("Terminator type must be UMBRAL or PENUMBRAL but was actuall" - "y #.", (ftnlen)63); - errch_("#", type__, (ftnlen)1, type_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZEDTERM", (ftnlen)8); - return 0; - } - -/* Check the terminator set dimension. */ - - if (*npts < 1) { - setmsg_("Set must contain at least one point; NPTS = #.", (ftnlen)47) - ; - errint_("#", npts, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEDTERM", (ftnlen)8); - return 0; - } - -/* The ellipsoid semi-axes must have positive length. */ - - if (*a <= 0. || *b <= 0. || *c__ <= 0.) { - setmsg_("Semi-axis lengths: A = #, B = #, C = #. ", (ftnlen)41); - errdp_("#", a, (ftnlen)1); - errdp_("#", b, (ftnlen)1); - errdp_("#", c__, (ftnlen)1); - sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24); - chkout_("ZZEDTERM", (ftnlen)8); - return 0; - } - -/* Check the input light source radius. */ - - if (*srcrad <= 0.) { - setmsg_("Light source must have positive radius; actual radius was #." - , (ftnlen)60); - errdp_("#", srcrad, (ftnlen)1); - sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20); - chkout_("ZZEDTERM", (ftnlen)8); - return 0; - } - -/* The light source must not intersect the outer bounding */ -/* sphere of the ellipsoid. */ - - d__ = vnorm_(srcpos); -/* Computing MAX */ - d__1 = max(*a,*b); - rmax = max(d__1,*c__); -/* Computing MIN */ - d__1 = min(*a,*b); - rmin = min(d__1,*c__); - if (*srcrad + rmax >= d__) { - -/* The light source is too close. */ - - setmsg_("Light source intersects outer bounding sphere of the ellips" - "oid. Light source radius = #; ellipsoid's longest axis = #;" - " sum = #; distance between centers = #.", (ftnlen)158); - errdp_("#", srcrad, (ftnlen)1); - errdp_("#", &rmax, (ftnlen)1); - d__1 = *srcrad + rmax; - errdp_("#", &d__1, (ftnlen)1); - errdp_("#", &d__, (ftnlen)1); - sigerr_("SPICE(OBJECTSTOOCLOSE)", (ftnlen)22); - chkout_("ZZEDTERM", (ftnlen)8); - return 0; - } - -/* Find bounds on the angular size of the target as seen */ -/* from the source. */ - -/* Computing MIN */ - d__1 = rmax / d__; - minang = asin((min(d__1,1.))); -/* Computing MIN */ - d__1 = rmin / d__; - maxang = asin((min(d__1,1.))); - -/* Let the inverse of the ellipsoid-light source vector be the */ -/* Z-axis of a frame we'll use to generate the terminator set. */ - - vminus_(srcpos, z__); - frame_(z__, x, y); - -/* Create the rotation matrix required to convert vectors */ -/* from the source-centered frame back to the target body-fixed */ -/* frame. */ - - vequ_(x, trans); - vequ_(y, &trans[3]); - vequ_(z__, &trans[6]); - -/* Find the maximum and minimum target radii. */ - -/* Computing MAX */ - d__1 = max(*a,*b); - maxrad = max(d__1,*c__); -/* Computing MIN */ - d__1 = min(*a,*b); - minrad = min(d__1,*c__); - if (umbral) { - -/* Compute the angular offsets from the axis of rays tangent to */ -/* both the source and the bounding spheres of the target, where */ -/* the tangency points lie in a half-plane bounded by the line */ -/* containing the origin and SRCPOS. (We'll call this line */ -/* the "axis.") */ - -/* OUTANG corresponds to the target's outer bounding sphere; */ -/* INANG to the inner bounding sphere. */ - - outang = asin((*srcrad - maxrad) / d__); - inang = asin((*srcrad - minrad) / d__); - } else { - -/* Compute the angular offsets from the axis of rays tangent to */ -/* both the source and the bounding spheres of the target, where */ -/* the tangency points lie in opposite half-planes bounded by the */ -/* axis (compare the case above). */ - -/* OUTANG corresponds to the target's outer bounding sphere; */ -/* INANG to the inner bounding sphere. */ - - outang = asin((*srcrad + maxrad) / d__); - inang = asin((*srcrad + minrad) / d__); - } - -/* Compute the angular delta we'll use for generating */ -/* terminator points. */ - - delta = twopi_() / *npts; - -/* Generate the terminator points. */ - - i__1 = *npts; - for (i__ = 1; i__ <= i__1; ++i__) { - theta = (i__ - 1) * delta; - -/* Let SRCPT be the surface point on the source lying in */ -/* the X-Y plane of the frame produced by FRAME */ -/* and corresponding to the angle THETA. */ - - latrec_(srcrad, &theta, &c_b30, srcpt); - -/* Now solve for the angle by which SRCPT must be rotated (toward */ -/* +Z in the umbral case, away from +Z in the penumbral case) */ -/* so that a plane tangent to the source at SRCPT is also tangent */ -/* to the target. The rotation is bracketed by OUTANG on the low */ -/* side and INANG on the high side in the umbral case; the */ -/* bracketing values are reversed in the penumbral case. */ - - if (umbral) { - angle = outang; - } else { - angle = inang; - } - prvdif = twopi_(); - prvang = angle + halfpi_(); - nitr = 0; - for(;;) { /* while(complicated condition) */ - d__2 = (d__1 = angle - prvang, abs(d__1)); - if (!(nitr <= 10 && touchd_(&d__2) < prvdif)) - break; - ++nitr; - d__2 = (d__1 = angle - prvang, abs(d__1)); - prvdif = touchd_(&d__2); - prvang = angle; - -/* Find the closest point on the ellipsoid to the plane */ -/* corresponding to "ANGLE". */ - -/* The tangent point on the source is obtained by rotating */ -/* SRCPT by ANGLE towards +Z. The plane's normal vector is */ -/* parallel to VTX in the source-centered frame. */ - - latrec_(srcrad, &theta, &angle, vtx); - vequ_(vtx, dir); - -/* VTX and DIR are expressed in the source-centered frame. We */ -/* must translate VTX to the target frame and rotate both */ -/* vectors into that frame. */ - - mxv_(trans, vtx, vtemp); - vadd_(srcpos, vtemp, vtx); - mxv_(trans, dir, vtemp); - vequ_(vtemp, dir); - -/* Create the plane defined by VTX and DIR. */ - - nvp2pl_(dir, vtx, plane); - -/* Find the closest point on the ellipsoid to the plane. At */ -/* the point we seek, the outward normal on the ellipsoid is */ -/* parallel to the choice of plane normal that points away */ -/* from the origin. We can always obtain this choice from */ -/* PL2NVC. */ - - pl2nvc_(plane, dir, &plcons); - -/* At the point */ - -/* E = (x, y, z) */ - -/* on the ellipsoid's surface, an outward normal */ -/* is */ - -/* N = ( x/A**2, y/B**2, z/C**2 ) */ - -/* which is also */ - -/* lambda * ( DIR(1), DIR(2), DIR(3) ) */ - -/* Equating components in the normal vectors yields */ - -/* E = lambda * ( DIR(1)*A**2, DIR(2)*B**2, DIR(3)*C**2 ) */ - -/* Taking the inner product with the point E itself and */ -/* applying the ellipsoid equation, we find */ - -/* lambda * = < N, E > = 1 */ - -/* The first term above is */ - -/* lambda**2 * || ( A*DIR(1), B*DIR(2), C*DIR(3) ) ||**2 */ - -/* So the positive root lambda is */ - -/* 1 / || ( A*DIR(1), B*DIR(2), C*DIR(3) ) || */ - -/* Having lambda we can compute E. */ - - d__1 = *a * dir[0]; - d__2 = *b * dir[1]; - d__3 = *c__ * dir[2]; - vpack_(&d__1, &d__2, &d__3, v); - lambda = 1. / vnorm_(v); - d__1 = *a * v[0]; - d__2 = *b * v[1]; - d__3 = *c__ * v[2]; - vpack_(&d__1, &d__2, &d__3, e); - vscl_(&lambda, e, &trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 - && 0 <= i__2 ? i__2 : s_rnge("trmpts", i__2, "zzedterm_", - (ftnlen)586)]); - -/* Make a new estimate of the plane rotation required to touch */ -/* the target. */ - - vsub_(&trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 && 0 <= i__2 - ? i__2 : s_rnge("trmpts", i__2, "zzedterm_", (ftnlen)592)] - , vtx, offset); - -/* Let ANGERR be an estimate of the magnitude of angular error */ -/* between the plane and the terminator. */ - - angerr = vsep_(dir, offset) - halfpi_(); - -/* Let S indicate the sign of the altitude error: where */ -/* S is positive, the plane is above E. */ - - d__1 = vdot_(e, dir); - s = d_sign(&c_b35, &d__1); - if (umbral) { - -/* If the plane is above the target, increase the */ -/* rotation angle; otherwise decrease the angle. */ - - angle += s * angerr; - } else { - -/* This is the penumbral case; decreasing the angle */ -/* "lowers" the plane toward the target. */ - - angle -= s * angerr; - } - } - } - chkout_("ZZEDTERM", (ftnlen)8); - return 0; -} /* zzedterm_ */ - diff --git a/ext/spice/src/cspice/zzekac01.c b/ext/spice/src/cspice/zzekac01.c deleted file mode 100644 index 975ca58d1f..0000000000 --- a/ext/spice/src/cspice/zzekac01.c +++ /dev/null @@ -1,1110 +0,0 @@ -/* zzekac01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static logical c_false = FALSE_; -static integer c__256 = 256; - -/* $Procedure ZZEKAC01 ( EK, add class 1 column to segment ) */ -/* Subroutine */ int zzekac01_(integer *handle, integer *segdsc, integer * - coldsc, integer *ivals, logical *nlflgs, integer *rcptrs, integer * - wkindx) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer page[256], tree, from; - extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *, - integer *), zzekcnam_(integer *, integer *, char *, ftnlen), - zzekordi_(integer *, logical *, logical *, integer *, integer *), - zzekpgwi_(integer *, integer *, integer *), zzekspsh_(integer *, - integer *), zzektrit_(integer *, integer *); - integer i__, n, p, mbase, ndata, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nnull, nrows; - extern logical return_(void); - char column[32]; - integer adrbuf[254], bufptr, colidx, dscbas, idxtyp, nulptr, nwrite, - remain, to; - logical indexd, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), cleari_(integer *, integer *), dasudi_(integer *, - integer *, integer *, integer *), zzekaps_(integer *, integer *, - integer *, logical *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 1 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IVALS I Integer values to add to column. */ -/* NLFLGS I Array of null flags for column entries. */ -/* RCPTRS I Array of record pointers for segment. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* IVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. Elements must be */ -/* allocated for each column entry, including null */ -/* entries. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by IVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. These pointers are base addresses of the */ -/* `record pointer structures' for the segment. */ -/* These pointers are used instead of record numbers */ -/* in column indexes: the indexes map ordinal */ -/* positions to record pointers. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEI, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* See EKACLI. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK scratch area has been set up */ -/* properly for a fast load operation. This routine writes */ -/* to the EK scratch area as well. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. The test to determine when to write a page */ -/* was fixed to handle this case. */ - -/* Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC01", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - idxtyp = coldsc[5]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - nullok = nulptr != -1; - indexd = idxtyp != -1; - -/* This column had better be class 1. */ - - if (class__ != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 1.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC01", (ftnlen)8); - return 0; - } - -/* If the column is indexed, the index type should be 1; we don't */ -/* know how to create any other type of index. */ - - if (indexd && idxtyp != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Index type code # found in descriptor for column #. Code s" - "hould be 1.", (ftnlen)70); - errint_("#", &idxtyp, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNRECOGNIZEDTYPE)", (ftnlen)23); - chkout_("ZZEKAC01", (ftnlen)8); - return 0; - } - -/* Push the column's ordinal index on the stack. This allows us */ -/* to identify the column the addresses belong to. */ - - zzekspsh_(&c__1, &colidx); - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Decide how many pages we'll need to store the data. Also */ -/* record the number of data values to write. */ - - if (nullok) { - -/* Count the non-null rows; these are the ones that will take */ -/* up space. */ - - nnull = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - if (nlflgs[i__ - 1]) { - ++nnull; - } - } - ndata = nrows - nnull; - } else { - ndata = nrows; - } - if (ndata > 0) { - -/* There's some data to write, so allocate a page. Also */ -/* prepare a data buffer to be written out as a page. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); - cleari_(&c__256, page); - } - -/* Write the input data out to the target file a page at a time. */ -/* Null values don't get written. */ - -/* While we're at it, we'll push onto the EK stack the addresses */ -/* of the column entries. We use the constant NULL rather than an */ -/* address to represent null entries. */ - -/* We'll use FROM to indicate the element of IVALS we're */ -/* considering, TO to indicate the element of PAGE to write */ -/* to, and BUFPTR to indicate the element of ADRBUF to write */ -/* addresses to. The variable N indicates the number of data */ -/* items in the current page. */ - - remain = nrows; - from = 1; - to = 1; - bufptr = 1; - nwrite = 0; - n = 0; - while(remain > 0) { - if (nullok && nlflgs[from - 1]) { - adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac01_", (ftnlen)378)] = -2; - } else { - adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac01_", (ftnlen)382)] = to + pbase; - page[(i__1 = to - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", - i__1, "zzekac01_", (ftnlen)383)] = ivals[from - 1]; - ++to; - ++nwrite; - ++n; - } - ++from; - --remain; - if (bufptr == 254 || remain == 0) { - -/* The address buffer is full or we're out of input values */ -/* to look at, so push the buffer contents on the stack. */ - - zzekspsh_(&bufptr, adrbuf); - bufptr = 1; - } else { - ++bufptr; - } - if (n == 254 || nwrite == ndata && ndata != 0) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. First set the link count. */ - - page[255] = n; - -/* Write out the data page. */ - - zzekpgwi_(handle, &p, page); - -/* If there's more data to write, allocate another page. */ - - if (nwrite < ndata) { - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); - cleari_(&c__256, page); - n = 0; - to = 1; - } - } - } - -/* If the column is supposed to have an index, now is the time to */ -/* build that index. We'll find the order vector for the input */ -/* values, overwrite the elements of the order vector with the */ -/* corresponding elements of the input array of record pointers, then */ -/* load this sorted copy of the record pointer array into a tree in */ -/* one shot. */ - - if (indexd) { - zzekordi_(ivals, &nullok, nlflgs, &nrows, wkindx); - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - wkindx[i__ - 1] = rcptrs[wkindx[i__ - 1] - 1]; - } - zzektrit_(handle, &tree); - zzektr1s_(handle, &tree, &nrows, wkindx); - -/* Update the segment's metadata to point to the index. The */ -/* pointer indicates the root page of the tree. */ - - mbase = segdsc[2]; - dscbas = mbase + 24 + (colidx - 1) * 11; - i__1 = dscbas + 7; - i__2 = dscbas + 7; - dasudi_(handle, &i__1, &i__2, &tree); - } - chkout_("ZZEKAC01", (ftnlen)8); - return 0; -} /* zzekac01_ */ - diff --git a/ext/spice/src/cspice/zzekac02.c b/ext/spice/src/cspice/zzekac02.c deleted file mode 100644 index a8b770a6e0..0000000000 --- a/ext/spice/src/cspice/zzekac02.c +++ /dev/null @@ -1,1112 +0,0 @@ -/* zzekac02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static logical c_false = FALSE_; -static integer c__128 = 128; - -/* $Procedure ZZEKAC02 ( EK, add class 2 column to segment ) */ -/* Subroutine */ int zzekac02_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dvals, logical *nlflgs, integer *rcptrs, integer * - wkindx) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal page[128]; - integer tree, from; - extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *, - integer *), zzekcnam_(integer *, integer *, char *, ftnlen), - zzekordd_(doublereal *, logical *, logical *, integer *, integer * - ), zzekpgwd_(integer *, integer *, doublereal *), zzekspsh_( - integer *, integer *), zzektrit_(integer *, integer *); - integer i__, n, p, mbase, ndata, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nnull, nrows; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - extern logical return_(void); - char column[32]; - integer adrbuf[126], bufptr, colidx, dscbas, idxtyp, nulptr, nwrite, - remain, to; - logical indexd, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasudi_(integer *, integer *, integer *, integer *), - zzekaps_(integer *, integer *, integer *, logical *, integer *, - integer *); - -/* $ Abstract */ - -/* Add an entire class 2 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DVALS I D.p. values to add to column. */ -/* NLFLGS I Array of null flags for column entries. */ -/* RCPTRS I Array of record pointers for segment. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* DVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. Elements must be */ -/* allocated for each column entry, including null */ -/* entries. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by DVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. These pointers are base addresses of the */ -/* `record pointer structures' for the segment. */ -/* These pointers are used instead of record numbers */ -/* in column indexes: the indexes map ordinal */ -/* positions to record pointers. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACED, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* See EKACLD. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK scratch area has been set up */ -/* properly for a fast load operation. This routine writes */ -/* to the EK scratch area as well. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. The test to determine when to write a page */ -/* was fixed to handle this case. */ - -/* Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC02", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - idxtyp = coldsc[5]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - nullok = nulptr != -1; - indexd = idxtyp != -1; - -/* This column had better be class 2. */ - - if (class__ != 2) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 2.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC02", (ftnlen)8); - return 0; - } - -/* If the column is indexed, the index type should be 1; we don't */ -/* know how to create any other type of index. */ - - if (indexd && idxtyp != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Index type code # found in descriptor for column #. Code s" - "hould be 1.", (ftnlen)70); - errint_("#", &idxtyp, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNRECOGNIZEDTYPE)", (ftnlen)23); - chkout_("ZZEKAC02", (ftnlen)8); - return 0; - } - -/* Push the column's ordinal index on the stack. This allows us */ -/* to identify the column the addresses belong to. */ - - zzekspsh_(&c__1, &colidx); - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Decide how many pages we'll need to store the data. Also */ -/* record the number of data values to write. */ - - if (nullok) { - -/* Count the non-null rows; these are the ones that will take */ -/* up space. */ - - nnull = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - if (nlflgs[i__ - 1]) { - ++nnull; - } - } - ndata = nrows - nnull; - } else { - ndata = nrows; - } - if (ndata > 0) { - -/* There's some data to write, so allocate a page. Also */ -/* prepare a data buffer to be written out as a page. */ - - zzekaps_(handle, segdsc, &c__2, &c_false, &p, &pbase); - cleard_(&c__128, page); - } - -/* Write the input data out to the target file a page at a time. */ -/* Null values don't get written. */ - -/* While we're at it, we'll push onto the EK stack the addresses */ -/* of the column entries. We use the constant NULL rather than an */ -/* address to represent null entries. */ - -/* We'll use FROM to indicate the element of DVALS we're */ -/* considering, TO to indicate the element of PAGE to write */ -/* to, and BUFPTR to indicate the element of ADRBUF to write */ -/* addresses to. The variable N indicates the number of data */ -/* items in the current page. */ - - remain = nrows; - from = 1; - to = 1; - bufptr = 1; - nwrite = 0; - n = 0; - while(remain > 0) { - if (nullok && nlflgs[from - 1]) { - adrbuf[(i__1 = bufptr - 1) < 126 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac02_", (ftnlen)379)] = -2; - } else { - adrbuf[(i__1 = bufptr - 1) < 126 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac02_", (ftnlen)383)] = to + pbase; - page[(i__1 = to - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("page", - i__1, "zzekac02_", (ftnlen)384)] = dvals[from - 1]; - ++to; - ++nwrite; - ++n; - } - ++from; - --remain; - if (bufptr == 126 || remain == 0) { - -/* The address buffer is full or we're out of input values */ -/* to look at, so push the buffer contents on the stack. */ - - zzekspsh_(&bufptr, adrbuf); - bufptr = 1; - } else { - ++bufptr; - } - if (n == 126 || nwrite == ndata && ndata != 0) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. First set the link count. */ - - page[127] = (doublereal) n; - -/* Write out the data page. */ - - zzekpgwd_(handle, &p, page); - -/* If there's more data to write, allocate another page. */ - - if (nwrite < ndata) { - zzekaps_(handle, segdsc, &c__2, &c_false, &p, &pbase); - cleard_(&c__128, page); - n = 0; - to = 1; - } - } - } - -/* If the column is supposed to have an index, now is the time to */ -/* build that index. We'll find the order vector for the input */ -/* values, overwrite the elements of the order vector with the */ -/* corresponding elements of the input array of record pointers, then */ -/* load this sorted copy of the record pointer array into a tree in */ -/* one shot. */ - - if (indexd) { - zzekordd_(dvals, &nullok, nlflgs, &nrows, wkindx); - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - wkindx[i__ - 1] = rcptrs[wkindx[i__ - 1] - 1]; - } - zzektrit_(handle, &tree); - zzektr1s_(handle, &tree, &nrows, wkindx); - -/* Update the segment's metadata to point to the index. The */ -/* pointer indicates the root page of the tree. */ - - mbase = segdsc[2]; - dscbas = mbase + 24 + (colidx - 1) * 11; - i__1 = dscbas + 7; - i__2 = dscbas + 7; - dasudi_(handle, &i__1, &i__2, &tree); - } - chkout_("ZZEKAC02", (ftnlen)8); - return 0; -} /* zzekac02_ */ - diff --git a/ext/spice/src/cspice/zzekac03.c b/ext/spice/src/cspice/zzekac03.c deleted file mode 100644 index e77be157cc..0000000000 --- a/ext/spice/src/cspice/zzekac03.c +++ /dev/null @@ -1,1193 +0,0 @@ -/* zzekac03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static logical c_false = FALSE_; -static integer c__0 = 0; - -/* $Procedure ZZEKAC03 ( EK, add class 3 column to segment ) */ -/* Subroutine */ int zzekac03_(integer *handle, integer *segdsc, integer * - coldsc, char *cvals, logical *nlflgs, integer *rcptrs, integer * - wkindx, ftnlen cvals_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char page[1024]; - integer tree, from, room; - extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *, - integer *), zzekcnam_(integer *, integer *, char *, ftnlen), - zzekordc_(char *, logical *, logical *, integer *, integer *, - ftnlen), zzekpgwc_(integer *, integer *, char *, ftnlen), - zzekspsh_(integer *, integer *), zzektrit_(integer *, integer *); - integer i__, n, p, mbase, ndata, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nnull; - extern integer rtrim_(char *, ftnlen); - integer p2, nrows; - extern logical return_(void); - char column[32]; - integer adrbuf[1014], bufptr, colidx, colwid, dscbas, idxtyp, nchars, - nlinks, nulptr, nwrite, remain, strlen, to; - logical fixlen, indexd, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prtenc_(integer *, char *, ftnlen), prtdec_(char *, - integer *, ftnlen), dasudi_(integer *, integer *, integer *, - integer *); - integer pos; - extern /* Subroutine */ int zzekaps_(integer *, integer *, integer *, - logical *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 3 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CVALS I Character values to add to column. */ -/* NLFLGS I Array of null flags for column entries. */ -/* RCPTRS I Array of record pointers for segment. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* CVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. Elements must be */ -/* allocated for each column entry, including null */ -/* entries. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by CVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. These pointers are base addresses of the */ -/* `record pointer structures' for the segment. */ -/* These pointers are used instead of record numbers */ -/* in column indexes: the indexes map ordinal */ -/* positions to record pointers. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEC, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* See EKACLC. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK scratch area has been set up */ -/* properly for a fast load operation. This routine writes */ -/* to the EK scratch area as well. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC03", (ftnlen)8); - } - -/* Grab the column's attributes. Initialize the maximum non-blank */ -/* width of the column. */ - - class__ = coldsc[0]; - idxtyp = coldsc[5]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - colwid = coldsc[2]; - nullok = nulptr != -1; - indexd = idxtyp != -1; - fixlen = colwid != -1; - -/* This column had better be class 3. */ - - if (class__ != 3) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 3.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC03", (ftnlen)8); - return 0; - } - -/* If the column is indexed, the index type should be 1; we don't */ -/* know how to create any other type of index. */ - - if (indexd && idxtyp != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Index type code # found in descriptor for column #. Code s" - "hould be 1.", (ftnlen)70); - errint_("#", &idxtyp, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNRECOGNIZEDTYPE)", (ftnlen)23); - chkout_("ZZEKAC03", (ftnlen)8); - return 0; - } - -/* Push the column's ordinal index on the stack. This allows us */ -/* to identify the column the addresses belong to. */ - - zzekspsh_(&c__1, &colidx); - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Count the number of strings to write. */ - - if (nullok) { - -/* Count the non-null column entries; these are the */ -/* ones that will take up space. */ - - nnull = 0; - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - if (nlflgs[i__ - 1]) { - ++nnull; - } - } - ndata = nrows - nnull; - } else { - ndata = nrows; - } - if (ndata > 0) { - -/* There's some data to write, so allocate a page. Also */ -/* prepare a data buffer to be written out as a page. */ - - zzekaps_(handle, segdsc, &c__1, &c_false, &p, &pbase); - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - -/* The link count starts out at zero. */ - - prtenc_(&c__0, page + 1019, (ftnlen)5); - } - -/* Write the input data out to the target file a page at a time. */ -/* Null values don't get written. */ - -/* While we're at it, we'll push onto the EK stack the addresses */ -/* of the column entries. We use the constant NULL rather than an */ -/* address to represent null entries. */ - -/* We'll use FROM to indicate the element of CVALS we're */ -/* considering, TO to indicate the first character of PAGE to write */ -/* to, and BUFPTR to indicate the element of ADRBUF to write */ -/* addresses to. The variable N indicates the number of characters */ -/* written to the current page. NCHARS indicates the number of */ -/* characters left to write from the current input element. NWRITE */ -/* will be used to count the column entries written so far. */ - - remain = nrows; - from = 0; - to = 1; - bufptr = 1; - nwrite = 0; - n = 0; - while(remain > 0) { - -/* Examine a column entry. Write it out if it's non-null. */ - - ++from; - if (nullok && nlflgs[from - 1]) { - adrbuf[(i__1 = bufptr - 1) < 1014 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac03_", (ftnlen)382)] = -2; - } else { - -/* Write out the current column entry. The entry */ -/* might span multiple pages. However, we're guaranteed */ -/* enough room to write out to the current page the encoded */ -/* character count and at least one character of data. */ - -/* Update the non-blank width for the column each time we */ -/* determine the length of an input string. */ - - if (fixlen) { -/* Computing MIN */ - i__1 = rtrim_(cvals + (from - 1) * cvals_len, cvals_len); - strlen = min(i__1,colwid); - } else { - strlen = rtrim_(cvals + (from - 1) * cvals_len, cvals_len); - } - adrbuf[(i__1 = bufptr - 1) < 1014 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac03_", (ftnlen)400)] = to + pbase; - pos = 1; - -/* Start out with the string length. */ - - prtenc_(&strlen, page + (to - 1), (ftnlen)5); - n += 5; - to = n + 1; - nchars = strlen; - while(nchars > 0) { - room = 1014 - n; - if (nchars <= room) { - -/* The remaining portion of the string will fit on the */ -/* current page. */ - - s_copy(page + (to - 1), cvals + ((from - 1) * cvals_len + - (pos - 1)), to + nchars - 1 - (to - 1), pos + - nchars - 1 - (pos - 1)); - n += nchars; - to = n + 1; - nchars = 0; - -/* Add a link to the current page. */ - - prtdec_(page + 1019, &nlinks, (ftnlen)5); - i__1 = nlinks + 1; - prtenc_(&i__1, page + 1019, (ftnlen)5); - } else { - -/* The string will have to be continued on another page. */ -/* Write out the first ROOM characters to the current */ -/* page first. */ - - s_copy(page + (to - 1), cvals + ((from - 1) * cvals_len + - (pos - 1)), 1014 - (to - 1), pos + room - 1 - ( - pos - 1)); - pos += room; - nchars -= room; - -/* Add a link to the current page. */ - - prtdec_(page + 1019, &nlinks, (ftnlen)5); - i__1 = nlinks + 1; - prtenc_(&i__1, page + 1019, (ftnlen)5); - -/* Allocate another page. Fill in the forward pointer */ -/* in the previous page. */ - - zzekaps_(handle, segdsc, &c__1, &c_false, &p2, &pbase); - prtenc_(&p2, page + 1014, (ftnlen)5); - -/* Write out the full data page. Get ready to write */ -/* to the new page. */ - - zzekpgwc_(handle, &p, page, (ftnlen)1024); - p = p2; - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - prtenc_(&c__0, page + 1019, (ftnlen)5); - n = 0; - to = 1; - } - } - -/* We've written out a column entry. */ - - ++nwrite; - } - -/* We're done with the current column entry, null or not. */ - - if (nwrite < ndata) { - -/* There is at least one more column entry to write. */ -/* If there's not enough room on the current page to begin */ -/* writing another column entry, write out the page and */ -/* allocate another. */ - - room = 1014 - n; - if (room < 6) { - zzekpgwc_(handle, &p, page, (ftnlen)1024); - zzekaps_(handle, segdsc, &c__1, &c_false, &p, &pbase); - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - prtenc_(&c__0, page + 1019, (ftnlen)5); - n = 0; - to = 1; - } - } else if (n > 0) { - -/* We've written the last of the non-null data to the current */ -/* page. Write out this page. */ - - zzekpgwc_(handle, &p, page, (ftnlen)1024); - n = 0; - } - --remain; - if (bufptr == 1014 || remain == 0) { - -/* The address buffer is full or we're out of input values */ -/* to look at, so push the buffer contents on the stack. */ - - zzekspsh_(&bufptr, adrbuf); - bufptr = 1; - } else { - ++bufptr; - } - } - -/* If the column is supposed to have an index, now is the time to */ -/* build that index. We'll find the order vector for the input */ -/* values, overwrite the elements of the order vector with the */ -/* corresponding elements of the input array of record pointers, then */ -/* load this sorted copy of the record pointer array into a tree in */ -/* one shot. */ - - if (indexd) { - zzekordc_(cvals, &nullok, nlflgs, &nrows, wkindx, cvals_len); - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - wkindx[i__ - 1] = rcptrs[wkindx[i__ - 1] - 1]; - } - zzektrit_(handle, &tree); - zzektr1s_(handle, &tree, &nrows, wkindx); - -/* Update the segment's metadata to point to the index. The */ -/* pointer indicates the root page of the tree. */ - - mbase = segdsc[2]; - dscbas = mbase + 24 + (colidx - 1) * 11; - i__1 = dscbas + 7; - i__2 = dscbas + 7; - dasudi_(handle, &i__1, &i__2, &tree); - } - chkout_("ZZEKAC03", (ftnlen)8); - return 0; -} /* zzekac03_ */ - diff --git a/ext/spice/src/cspice/zzekac04.c b/ext/spice/src/cspice/zzekac04.c deleted file mode 100644 index 9ba0689e1c..0000000000 --- a/ext/spice/src/cspice/zzekac04.c +++ /dev/null @@ -1,1179 +0,0 @@ -/* zzekac04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static logical c_false = FALSE_; -static integer c__256 = 256; - -/* $Procedure ZZEKAC04 ( EK, add class 4 column to segment ) */ -/* Subroutine */ int zzekac04_(integer *handle, integer *segdsc, integer * - coldsc, integer *ivals, integer *entszs, logical *nlflgs) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer page[256], nelt, from, size; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzeksfwd_(integer *, integer *, integer *, integer *), - zzekpgwi_(integer *, integer *, integer *), zzekspsh_(integer *, - integer *); - integer i__, n, p, ndata, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nlink, p2, nrows; - extern logical return_(void); - char column[32]; - integer adrbuf[254], bufptr, colidx, cursiz, nulptr, remain, to; - logical cntinu, fixsiz, newreq, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), cleari_(integer *, integer *); - integer row; - extern /* Subroutine */ int zzekaps_(integer *, integer *, integer *, - logical *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 4 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IVALS I Integer values to add to column. */ -/* ENTSZS I Array of sizes of column entries. */ -/* NLFLGS I Array of null flags for column entries. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* IVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. For columns having */ -/* fixed-size entries, a null entry must be allocated */ -/* the same amount of space occupied by a non-null */ -/* entry in the array IVALS. For columns having */ -/* variable-size entries, null entries do not require */ -/* any space in the IVALS array, but in any case must */ -/* have their allocated space described correctly by */ -/* the corresponding element of the ENTSZS array */ -/* (described below). */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by IVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEI, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* See EKACLI. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK scratch area has been set up */ -/* properly for a fast load operation. This routine writes */ -/* to the EK scratch area as well. */ - -/* 2) Only one segment can be created at a time using the fast */ -/* load routines. */ - -/* 3) No other EK operation may interrupt a fast load. For */ -/* example, it is not valid to issue a query while a fast load */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. The test to determine when to write a page */ -/* was fixed to handle this case. */ - -/* Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC04", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - size = coldsc[3]; - nullok = nulptr != -1; - fixsiz = size != -1; - -/* This column had better be class 4. */ - - if (class__ != 4) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 4.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC04", (ftnlen)8); - return 0; - } - -/* Push the column's ordinal index on the stack. This allows us */ -/* to identify the column the addresses belong to. */ - - zzekspsh_(&c__1, &colidx); - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Record the number of data values to write. */ - - if (nullok) { - -/* Sum the sizes of the non-null column entries; these are the */ -/* ones that will take up space. */ - - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - if (! nlflgs[i__ - 1]) { - if (fixsiz) { - ndata += size; - } else { - ndata += entszs[i__ - 1]; - } - } - } - } else { - if (fixsiz) { - ndata = nrows * size; - } else { - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - ndata += entszs[i__ - 1]; - } - } - } - if (ndata > 0) { - -/* There's some data to write, so allocate a page. Also */ -/* prepare a data buffer to be written out as a page. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); - cleari_(&c__256, page); - } - -/* Write the input data out to the target file a page at a time. */ -/* Null values don't get written. */ - -/* While we're at it, we'll push onto the EK stack the addresses */ -/* of the column entries. We use the constant NULL rather than an */ -/* address to represent null entries. */ - -/* We'll use FROM to indicate the element of IVALS we're */ -/* considering, TO to indicate the element of PAGE to write */ -/* to, and BUFPTR to indicate the element of ADRBUF to write */ -/* addresses to. The variable NELT is the count of the column entry */ -/* elements written for the current entry. The variable N indicates */ -/* the number of integers written to the current page. */ - - remain = ndata; - from = 1; - to = 1; - bufptr = 1; - row = 1; - nelt = 1; - n = 0; - nlink = 0; - while(row <= nrows) { - -/* NEWREQ is set to TRUE if we discover that the next column */ -/* entry must start on a new page. */ - - newreq = FALSE_; - if (nullok && nlflgs[row - 1]) { - if (fixsiz) { - cursiz = size; - } else { - cursiz = entszs[row - 1]; - } - from += cursiz; - adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac04_", (ftnlen)415)] = -2; - ++bufptr; - ++row; - nelt = 1; - cntinu = FALSE_; - } else { - if (nelt == 1) { - -/* We're about to write out a new column entry. We must */ -/* insert the element count into the page before writing the */ -/* data. The link count for the current page must be */ -/* incremented to account for this new entry. */ - -/* At this point, we're guaranteed at least two free */ -/* spaces in the current page. */ - - if (fixsiz) { - cursiz = size; - } else { - cursiz = entszs[row - 1]; - } - adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac04_", (ftnlen)441)] = to + - pbase; - ++bufptr; - page[(i__1 = to - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page" - , i__1, "zzekac04_", (ftnlen)443)] = cursiz; - ++to; - ++n; - ++nlink; - } - -/* At this point, there's at least one free space in the */ -/* current page. */ - - page[(i__1 = to - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", - i__1, "zzekac04_", (ftnlen)454)] = ivals[from - 1]; - ++to; - ++n; - ++from; - --remain; - -/* Decide whether we must continue the current entry on another */ -/* data page. */ - - cntinu = nelt < cursiz && n == 254; - if (nelt == cursiz) { - -/* The current element is the last of the current column */ -/* entry. */ - -/* Determine whether we must start the next column entry on */ -/* a new page. To start a column entry on the current page, */ -/* we must have enough room for the element count and at */ -/* least the first entry element. */ - - if (remain > 0) { - newreq = n > 252; - } - nelt = 1; - ++row; - } else { - ++nelt; - } - } - if (bufptr > 254 || row > nrows) { - -/* The address buffer is full or we're out of input values */ -/* to look at, so push the buffer contents on the stack. */ - - i__1 = bufptr - 1; - zzekspsh_(&i__1, adrbuf); - bufptr = 1; - } - if (cntinu || newreq || row > nrows && ndata > 0) { - -/* It's time to write out the current page. First set the link */ -/* count. */ - - page[255] = nlink; - -/* Write out the data page. */ - - zzekpgwi_(handle, &p, page); - -/* If there's more data to write, allocate another page. */ - - if (remain > 0) { - zzekaps_(handle, segdsc, &c__3, &c_false, &p2, &pbase); - cleari_(&c__256, page); - n = 0; - nlink = 0; - to = 1; - -/* If we're continuing an element from the previous page, */ -/* link the previous page to the current one. */ - - if (cntinu) { - zzeksfwd_(handle, &c__3, &p, &p2); - } - p = p2; - } - -/* We've allocated a new data page if we needed one. */ - - } - -/* We've written out the last completed data page. */ - - } - -/* We've processed all entries of the input array. */ - - chkout_("ZZEKAC04", (ftnlen)8); - return 0; -} /* zzekac04_ */ - diff --git a/ext/spice/src/cspice/zzekac05.c b/ext/spice/src/cspice/zzekac05.c deleted file mode 100644 index dcfb1ba69e..0000000000 --- a/ext/spice/src/cspice/zzekac05.c +++ /dev/null @@ -1,1182 +0,0 @@ -/* zzekac05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static logical c_false = FALSE_; -static integer c__128 = 128; - -/* $Procedure ZZEKAC05 ( EK, add class 5 column to segment ) */ -/* Subroutine */ int zzekac05_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dvals, integer *entszs, logical *nlflgs) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal page[128]; - integer nelt, from, size; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekpgwd_(integer *, integer *, doublereal *), zzeksfwd_( - integer *, integer *, integer *, integer *), zzekspsh_(integer *, - integer *); - integer i__, n, p, ndata, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nlink, p2, nrows; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - extern logical return_(void); - char column[32]; - integer adrbuf[126], bufptr, colidx, cursiz, nulptr, remain, to; - logical cntinu, fixsiz, newreq, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer row; - extern /* Subroutine */ int zzekaps_(integer *, integer *, integer *, - logical *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 5 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DVALS I D.p. values to add to column. */ -/* ENTSZS I Array of sizes of column entries. */ -/* NLFLGS I Array of null flags for column entries. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* DVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. For columns having */ -/* fixed-size entries, a null entry must be allocated */ -/* the same amount of space occupied by a non-null */ -/* entry in the array DVALS. For columns having */ -/* variable-size entries, null entries do not require */ -/* any space in the DVALS array, but in any case must */ -/* have their allocated space described correctly by */ -/* the corresponding element of the ENTSZS array */ -/* (described below). */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by DVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACED, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* See EKACLD. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK scratch area has been set up */ -/* properly for a fast load operation. This routine writes */ -/* to the EK scratch area as well. */ - -/* 2) Only one segment can be created at a time using the fast */ -/* load routines. */ - -/* 3) No other EK operation may interrupt a fast load. For */ -/* example, it is not valid to issue a query while a fast load */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 23-SEP-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. The test to determine when to write a page */ -/* was fixed to handle this case. */ - -/* Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC05", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - size = coldsc[3]; - nullok = nulptr != -1; - fixsiz = size != -1; - -/* This column had better be class 5. */ - - if (class__ != 5) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 5.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC05", (ftnlen)8); - return 0; - } - -/* Push the column's ordinal index on the stack. This allows us */ -/* to identify the column the addresses belong to. */ - - zzekspsh_(&c__1, &colidx); - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Record the number of data values to write. */ - - if (nullok) { - -/* Sum the sizes of the non-null column entries; these are the */ -/* ones that will take up space. */ - - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - if (! nlflgs[i__ - 1]) { - if (fixsiz) { - ndata += size; - } else { - ndata += entszs[i__ - 1]; - } - } - } - } else { - if (fixsiz) { - ndata = nrows * size; - } else { - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - ndata += entszs[i__ - 1]; - } - } - } - if (ndata > 0) { - -/* There's some data to write, so allocate a page. Also */ -/* prepare a data buffer to be written out as a page. */ - - zzekaps_(handle, segdsc, &c__2, &c_false, &p, &pbase); - cleard_(&c__128, page); - } - -/* Write the input data out to the target file a page at a time. */ -/* Null values don't get written. */ - -/* While we're at it, we'll push onto the EK stack the addresses */ -/* of the column entries. We use the constant NULL rather than an */ -/* address to represent null entries. */ - -/* We'll use FROM to indicate the element of DVALS we're */ -/* considering, TO to indicate the element of PAGE to write */ -/* to, and BUFPTR to indicate the element of ADRBUF to write */ -/* addresses to. The variable NELT is the count of the column entry */ -/* elements written for the current entry. The variable N indicates */ -/* the number of d.p. numbers written to the current page. */ - - remain = ndata; - from = 1; - to = 1; - bufptr = 1; - row = 1; - nelt = 1; - n = 0; - nlink = 0; - while(row <= nrows) { - -/* NEWREQ is set to TRUE if we discover that the next column */ -/* entry must start on a new page. */ - - newreq = FALSE_; - if (nullok && nlflgs[row - 1]) { - if (fixsiz) { - cursiz = size; - } else { - cursiz = entszs[row - 1]; - } - from += cursiz; - adrbuf[(i__1 = bufptr - 1) < 126 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac05_", (ftnlen)417)] = -2; - ++bufptr; - ++row; - nelt = 1; - cntinu = FALSE_; - } else { - if (nelt == 1) { - -/* We're about to write out a new column entry. We must */ -/* insert the element count into the page before writing the */ -/* data. The link count for the current page must be */ -/* incremented to account for this new entry. */ - -/* At this point, we're guaranteed at least two free */ -/* spaces in the current page. */ - - if (fixsiz) { - cursiz = size; - } else { - cursiz = entszs[row - 1]; - } - adrbuf[(i__1 = bufptr - 1) < 126 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac05_", (ftnlen)443)] = to + - pbase; - ++bufptr; - page[(i__1 = to - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("page" - , i__1, "zzekac05_", (ftnlen)445)] = (doublereal) - cursiz; - ++to; - ++n; - ++nlink; - } - -/* At this point, there's at least one free space in the */ -/* current page. */ - - page[(i__1 = to - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("page", - i__1, "zzekac05_", (ftnlen)456)] = dvals[from - 1]; - ++to; - ++n; - ++from; - --remain; - -/* Decide whether we must continue the current entry on another */ -/* data page. */ - - cntinu = nelt < cursiz && n == 126; - if (nelt == cursiz) { - -/* The current element is the last of the current column */ -/* entry. */ - -/* Determine whether we must start the next column entry on */ -/* a new page. To start a column entry on the current page, */ -/* we must have enough room for the element count and at */ -/* least the first entry element. */ - - if (remain > 0) { - newreq = n > 124; - } - nelt = 1; - ++row; - } else { - ++nelt; - } - } - if (bufptr > 126 || row > nrows) { - -/* The address buffer is full or we're out of input values */ -/* to look at, so push the buffer contents on the stack. */ - - i__1 = bufptr - 1; - zzekspsh_(&i__1, adrbuf); - bufptr = 1; - } - if (cntinu || newreq || row > nrows && ndata > 0) { - -/* It's time to write out the current page. First set the link */ -/* count. */ - - page[127] = (doublereal) nlink; - -/* Write out the data page. */ - - zzekpgwd_(handle, &p, page); - -/* If there's more data to write, allocate another page. */ - - if (remain > 0) { - zzekaps_(handle, segdsc, &c__2, &c_false, &p2, &pbase); - cleard_(&c__128, page); - n = 0; - nlink = 0; - to = 1; - -/* If we're continuing an element from the previous page, */ -/* link the previous page to the current one. */ - - if (cntinu) { - zzeksfwd_(handle, &c__2, &p, &p2); - } - p = p2; - } - -/* We've allocated a new data page if we needed one. */ - - } - -/* We've written out the last completed data page. */ - - } - -/* We've processed all entries of the input array. */ - - chkout_("ZZEKAC05", (ftnlen)8); - return 0; -} /* zzekac05_ */ - diff --git a/ext/spice/src/cspice/zzekac06.c b/ext/spice/src/cspice/zzekac06.c deleted file mode 100644 index d57cdd1ffb..0000000000 --- a/ext/spice/src/cspice/zzekac06.c +++ /dev/null @@ -1,1290 +0,0 @@ -/* zzekac06.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static logical c_false = FALSE_; - -/* $Procedure ZZEKAC06 ( EK, add class 6 column to segment ) */ -/* Subroutine */ int zzekac06_(integer *handle, integer *segdsc, integer * - coldsc, char *cvals, integer *entszs, logical *nlflgs, ftnlen - cvals_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char page[1024]; - integer from, size, room; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekpgwc_(integer *, integer *, char *, ftnlen), - zzeksfwd_(integer *, integer *, integer *, integer *), zzekspsh_( - integer *, integer *); - integer i__, l, n, p, ndata, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, cvlen, nlink, p2, nrows, cp; - extern logical return_(void); - char column[32]; - integer adrbuf[1014], bufptr, colidx, curchr, cursiz, nchars, nulptr, nw, - nwrite, padlen, remain, strlen, to; - logical cntinu, fixsiz, newent, newreq, nullok, pad; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prtenc_(integer *, char *, ftnlen); - integer row; - extern /* Subroutine */ int zzekaps_(integer *, integer *, integer *, - logical *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 6 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CVALS I Character values to add to column. */ -/* ENTSZS I Array of sizes of column entries. */ -/* NLFLGS I Array of null flags for column entries. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* CVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. For columns having */ -/* fixed-size entries, a null entry must be allocated */ -/* the same amount of space occupied by a non-null */ -/* entry in the array CVALS. For columns having */ -/* variable-size entries, null entries do not require */ -/* any space in the CVALS array, but in any case must */ -/* have their allocated space described correctly by */ -/* the corresponding element of the ENTSZS array */ -/* (described below). */ - -/* ENTSZS is an array containing sizes of column entries. */ -/* The Ith element of ENTSZS gives the size of the */ -/* Ith column entry. ENTSZS is used only for columns */ -/* having variable-size entries. For such columns, */ -/* the dimension of ENTSZS must be at least NROWS. */ -/* The size of null entries should be set to zero. */ - -/* For columns having fixed-size entries, the */ -/* dimension of this array may be any positive value. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by CVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEI, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* $ Examples */ - -/* See EKACLC. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK scratch area has been set up */ -/* properly for a fast load operation. This routine writes */ -/* to the EK scratch area as well. */ - -/* 2) Currently, the EK system can handle only one fast load */ -/* at at time---one segment created by a fast load must be */ -/* be completed by a call to EKFFLD before another segment */ -/* can be created by a fast load, even if the two segments */ -/* reside in different files. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */ - -/* Bug fix: case of 100% null data values is now handled */ -/* correctly. The test to determine when to write a page */ -/* was fixed to handle this case. */ - -/* Previous version line was changed from "Beta" */ -/* to "SPICELIB." */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC06", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - size = coldsc[3]; - strlen = coldsc[2]; - nullok = nulptr != -1; - fixsiz = size != -1; - -/* This column had better be class 6. */ - - if (class__ != 6) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 6.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC06", (ftnlen)8); - return 0; - } - -/* Push the column's ordinal index on the stack. This allows us */ -/* to identify the column the addresses belong to. */ - - zzekspsh_(&c__1, &colidx); - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Record the number of data values to write. */ - - if (nullok) { - -/* Sum the sizes of the non-null column entries; these are the */ -/* ones that will take up space. */ - - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - if (! nlflgs[i__ - 1]) { - if (fixsiz) { - ndata += strlen * size; - } else { - ndata += strlen * entszs[i__ - 1]; - } - } - } - } else { - if (fixsiz) { - ndata = nrows * strlen * size; - } else { - ndata = 0; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - ndata += strlen * entszs[i__ - 1]; - } - } - } - if (ndata > 0) { - -/* There's some data to write, so allocate a page. Also */ -/* prepare a data buffer to be written out as a page. */ - - zzekaps_(handle, segdsc, &c__1, &c_false, &p, &pbase); - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - -/* Decide now whether we will need to pad the input entry */ -/* elements with trailing blanks, and if so how much padding */ -/* we'll need. */ - -/* Computing MIN */ - i__1 = i_len(cvals, cvals_len); - cvlen = min(i__1,strlen); - pad = cvlen < strlen; - if (pad) { - padlen = strlen - cvlen; - } - } - -/* Write the input data out to the target file a page at a time. */ -/* Null values don't get written. */ - -/* While we're at it, we'll push onto the EK stack the addresses */ -/* of the column entries. We use the constant NULL rather than an */ -/* address to represent null entries. */ - -/* We'll use FROM to indicate the element of CVALS we're */ -/* considering, TO to indicate the element of PAGE to write */ -/* to, and BUFPTR to indicate the element of ADRBUF to write */ -/* addresses to. The variable N indicates the number of characters */ -/* written to the current page. NCHARS is the number of characters */ -/* written in the current column entry. CP is the position in the */ -/* current input string of the character which we'll read next. */ - - remain = ndata; - from = 1; - to = 1; - bufptr = 1; - row = 1; - cp = 1; - n = 0; - nchars = 0; - nlink = 0; - newent = TRUE_; - while(row <= nrows) { - -/* NEWREQ is set to TRUE if we discover that the next column */ -/* entry must start on a new page. */ - - newreq = FALSE_; - -/* FROM and TO are expected to be properly set at this point. */ - - if (nullok && nlflgs[row - 1]) { - if (fixsiz) { - cursiz = size; - } else { - cursiz = entszs[row - 1]; - } - from += cursiz; - adrbuf[(i__1 = bufptr - 1) < 1014 && 0 <= i__1 ? i__1 : s_rnge( - "adrbuf", i__1, "zzekac06_", (ftnlen)442)] = -2; - ++bufptr; - ++row; - cntinu = FALSE_; - newent = TRUE_; - } else { - if (newent) { - -/* We're about to write out a new column entry. We must */ -/* insert the element count into the page before writing the */ -/* data. The link count for the current page must be */ -/* incremented to account for this new entry. */ - -/* At this point, we're guaranteed at least ENCSIZ+1 free */ -/* spaces in the current page. */ - - if (fixsiz) { - cursiz = size; - } else { - cursiz = entszs[row - 1]; - } - curchr = cursiz * strlen; - nchars = 0; - cp = 1; - adrbuf[(i__1 = bufptr - 1) < 1014 && 0 <= i__1 ? i__1 : - s_rnge("adrbuf", i__1, "zzekac06_", (ftnlen)472)] = - to + pbase; - ++bufptr; - prtenc_(&cursiz, page + (to - 1), (ftnlen)5); - to += 5; - n += 5; - ++nlink; - newent = FALSE_; - } - -/* At this point, there's at least one free space in the */ -/* current page. There's also at least one character to */ -/* write. Transfer as much as possible of the current */ -/* column entry to the current page. */ - - room = 1014 - n; -/* Computing MIN */ - i__1 = curchr - nchars; - nwrite = min(i__1,room); - nw = nwrite; - while(nw > 0) { - -/* At this point, we're guaranteed that */ - -/* CP <= STRLEN */ -/* TO < CPSIZE */ -/* FROM is set correctly. */ - - if (pad) { - -/* The input strings must be padded with blanks up to */ -/* a length of STRLEN characters. The number of blanks */ -/* used to pad the input is PADLEN. */ - - if (cp < cvlen) { - -/* Compute the number of `actual' characters of data */ -/* left in the current input string. */ - -/* Transfer the characters we have room for from the */ -/* current input string to the current page. */ - - l = cvlen - cp + 1; - l = min(l,nw); - s_copy(page + (to - 1), cvals + ((from - 1) * - cvals_len + (cp - 1)), to + l - 1 - (to - 1), - cp + l - 1 - (cp - 1)); - cp += l; - nw -= l; - to += l; - } else { - -/* The input character pointer is in the `pad' zone. */ -/* Let L be the length of padding that is required */ -/* and can fit in the page. */ - - l = strlen - cp + 1; - l = min(l,nw); - s_copy(page + (to - 1), " ", to + l - 1 - (to - 1), ( - ftnlen)1); - cp += l; - nw -= l; - to += l; - } - } else { - -/* The input data doesn't require padding. */ - -/* Compute the number of `actual' characters of data */ -/* left in the current input string. */ - -/* Transfer the characters we have room for from the */ -/* current input string to the current page. */ - - l = strlen - cp + 1; - l = min(l,nw); - s_copy(page + (to - 1), cvals + ((from - 1) * cvals_len + - (cp - 1)), to + l - 1 - (to - 1), cp + l - 1 - ( - cp - 1)); - cp += l; - nw -= l; - to += l; - } - -/* If the input pointer is beyond the end of the declared */ -/* length of the target column's strings STRLEN, it's time */ -/* to look at the next input string. */ - - if (cp > strlen) { - ++from; - cp = 1; - } - } - -/* We've written NWRITE characters to the current page. FROM, */ -/* TO, and CP are set. */ - - n += nwrite; - remain -= nwrite; - nchars += nwrite; - -/* Decide whether we must continue the current entry on another */ -/* data page. */ - - cntinu = nchars < curchr && n == 1014; - -/* If we've finished writing out a column entry, get ready */ -/* to write the next one. */ - - if (nchars == curchr) { - -/* The current character is the last of the current column */ -/* entry. */ - -/* Determine whether we must start the next column entry on */ -/* a new page. To start a column entry on the current page, */ -/* we must have enough room for the element count and at */ -/* least one character of data. */ - - if (remain > 0) { - newreq = n > 1008; - } - ++row; - newent = TRUE_; - } - } - -/* At this point, CNTINU indicates whether we need to continue */ -/* the current entry on another page. If we finished writing out */ -/* the entry, CNTINU is .FALSE. */ - - if (bufptr > 1014 || row > nrows) { - -/* The address buffer is full or we're out of input values */ -/* to look at, so push the buffer contents on the stack. */ - - i__1 = bufptr - 1; - zzekspsh_(&i__1, adrbuf); - bufptr = 1; - } - if (cntinu || newreq || row > nrows && ndata > 0) { - -/* It's time to write out the current page. First set the link */ -/* count. */ - - prtenc_(&nlink, page + 1019, (ftnlen)5); - -/* Write out the data page. */ - - zzekpgwc_(handle, &p, page, (ftnlen)1024); - -/* If there's more data to write, allocate another page. */ - - if (remain > 0) { - zzekaps_(handle, segdsc, &c__1, &c_false, &p2, &pbase); - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - n = 0; - nlink = 0; - to = 1; - -/* If we're continuing an element from the previous page, */ -/* link the previous page to the current one. */ - - if (cntinu) { - zzeksfwd_(handle, &c__1, &p, &p2); - } - p = p2; - } - -/* We've allocated a new data page if we needed one. */ - - } - -/* We've written out the last completed data page. */ - - } - -/* We've processed all entries of the input array. */ - - chkout_("ZZEKAC06", (ftnlen)8); - return 0; -} /* zzekac06_ */ - diff --git a/ext/spice/src/cspice/zzekac07.c b/ext/spice/src/cspice/zzekac07.c deleted file mode 100644 index c204986881..0000000000 --- a/ext/spice/src/cspice/zzekac07.c +++ /dev/null @@ -1,959 +0,0 @@ -/* zzekac07.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__256 = 256; -static integer c__2 = 2; - -/* $Procedure ZZEKAC07 ( EK, add class 7 column to segment ) */ -/* Subroutine */ int zzekac07_(integer *handle, integer *segdsc, integer * - coldsc, integer *ivals, logical *nlflgs, integer *wkindx) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer page[256], from; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekacps_(integer *, integer *, integer *, integer *, - integer *, integer *), zzekordi_(integer *, logical *, logical *, - integer *, integer *), zzekwpai_(integer *, integer *, integer *, - integer *, integer *, integer *), zzekwpal_(integer *, integer *, - integer *, logical *, integer *, integer *), zzekpgwi_(integer *, - integer *, integer *); - integer p, mbase, npage; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nrows, cmbase; - extern logical return_(void); - char column[32]; - integer colidx, datbas, dscbas, idxbas, idxpag, idxtyp, nflbas, nflpag, - nulptr, to; - logical indexd, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), cleari_(integer *, integer *), dasudi_(integer *, - integer *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 7 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 7 Parameters */ - -/* ekclas07.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 7 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 7 metadata array: */ - - -/* End Include Section: EK Column Class 7 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IVALS I Integer values to add to column. */ -/* NLFLGS I Array of null flags for column entries. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* IVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. Elements must be */ -/* allocated for each column entry, including null */ -/* entries. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by IVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEI, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* Class 7 columns have fixed record counts and contain scalar, */ -/* integer data. */ - -/* $ Examples */ - -/* See EKACLI. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK file has been set up */ -/* properly for a fast load operation. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 13-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC07", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - idxtyp = coldsc[5]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - nullok = nulptr != -1; - indexd = idxtyp != -1; - -/* This column had better be class 7. */ - - if (class__ != 7) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 7.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC07", (ftnlen)8); - return 0; - } - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Decide how many pages are required to hold the array, and */ -/* allocate that many new, contiguous pages. */ - - npage = (nrows + 253) / 254; - zzekacps_(handle, segdsc, &c__3, &npage, &p, &datbas); - -/* We'll use FROM to indicate the element of IVALS we're */ -/* considering and TO to indicate the element of PAGE to write */ -/* to. */ - - to = 1; - cleari_(&c__256, page); - i__1 = nrows; - for (from = 1; from <= i__1; ++from) { - -/* The Assignment. */ - - if (! nullok || ! nlflgs[from - 1]) { - -/* The current item is non-null. */ - - page[(i__2 = to - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", - i__2, "zzekac07_", (ftnlen)279)] = ivals[from - 1]; - } - ++to; - if (to > 254 || from == nrows) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. First set the link count. */ - - page[255] = to - 1; - -/* Write out the data page. */ - - zzekpgwi_(handle, &p, page); - -/* Next page. */ - - ++p; - to = 1; - } - } - -/* Update the column's metadata area to point to the data array. */ - - cmbase = coldsc[9]; - i__1 = cmbase + 1; - i__2 = cmbase + 1; - dasudi_(handle, &i__1, &i__2, &datbas); - -/* If the column is supposed to have an index, now is the time to */ -/* build that index. Type 2 indexes are just order vectors. */ - - if (indexd) { - -/* Compute the order vector. */ - - zzekordi_(ivals, &nullok, nlflgs, &nrows, wkindx); - -/* Write out the index. */ - - zzekwpai_(handle, segdsc, &nrows, wkindx, &idxpag, &idxbas); - -/* Update the column's metadata to point to the index. The */ -/* pointer indicates base address of the index. Also set the */ -/* index type in the column descriptor. */ - - mbase = segdsc[2]; - dscbas = mbase + 24 + (colidx - 1) * 11; - i__1 = dscbas + 7; - i__2 = dscbas + 7; - dasudi_(handle, &i__1, &i__2, &idxbas); - i__1 = dscbas + 6; - i__2 = dscbas + 6; - dasudi_(handle, &i__1, &i__2, &c__2); - } - if (nullok) { - -/* Nulls are allowed. Write out the null flag array. */ - - zzekwpal_(handle, segdsc, &nrows, nlflgs, &nflpag, &nflbas); - -/* Update the column's metadata area to point to the null flag */ -/* array. */ - - i__1 = cmbase + 2; - i__2 = cmbase + 2; - dasudi_(handle, &i__1, &i__2, &nflbas); - } - chkout_("ZZEKAC07", (ftnlen)8); - return 0; -} /* zzekac07_ */ - diff --git a/ext/spice/src/cspice/zzekac08.c b/ext/spice/src/cspice/zzekac08.c deleted file mode 100644 index 6762e4aeb4..0000000000 --- a/ext/spice/src/cspice/zzekac08.c +++ /dev/null @@ -1,959 +0,0 @@ -/* zzekac08.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__128 = 128; - -/* $Procedure ZZEKAC08 ( EK, add class 8 column to segment ) */ -/* Subroutine */ int zzekac08_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dvals, logical *nlflgs, integer *wkindx) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal page[128]; - integer from; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekacps_(integer *, integer *, integer *, integer *, - integer *, integer *), zzekordd_(doublereal *, logical *, logical - *, integer *, integer *), zzekwpai_(integer *, integer *, integer - *, integer *, integer *, integer *), zzekpgwd_(integer *, integer - *, doublereal *), zzekwpal_(integer *, integer *, integer *, - logical *, integer *, integer *); - integer p, mbase, npage; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nrows, cmbase; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - extern logical return_(void); - char column[32]; - integer colidx, datbas, dscbas, idxbas, idxpag, idxtyp, nflbas, nflpag, - nulptr, to; - logical indexd, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasudi_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Add an entire class 8 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 8 Parameters */ - -/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 8 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 8 metadata array: */ - - -/* End Include Section: EK Column Class 8 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DVALS I D.p. values to add to column. */ -/* NLFLGS I Array of null flags for column entries. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* DVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. Elements must be */ -/* allocated for each column entry, including null */ -/* entries. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by DVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACED, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* Class 8 columns have fixed record counts and contain scalar, */ -/* double precision data. */ - -/* $ Examples */ - -/* See EKACLD. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK file has been set up */ -/* properly for a fast load operation. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 13-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC08", (ftnlen)8); - } - -/* Grab the column's attributes. */ - - class__ = coldsc[0]; - idxtyp = coldsc[5]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - nullok = nulptr != -1; - indexd = idxtyp != -1; - -/* This column had better be class 8. */ - - if (class__ != 8) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 8.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC08", (ftnlen)8); - return 0; - } - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Decide how many pages are required to hold the array, and */ -/* allocate that many new, contiguous pages. */ - - npage = (nrows + 125) / 126; - zzekacps_(handle, segdsc, &c__2, &npage, &p, &datbas); - -/* We'll use FROM to indicate the element of DVALS we're */ -/* considering and TO to indicate the element of PAGE to write */ -/* to. */ - - to = 1; - cleard_(&c__128, page); - i__1 = nrows; - for (from = 1; from <= i__1; ++from) { - -/* The Assignment. */ - - if (! nullok || ! nlflgs[from - 1]) { - -/* The current item is non-null. */ - - page[(i__2 = to - 1) < 128 && 0 <= i__2 ? i__2 : s_rnge("page", - i__2, "zzekac08_", (ftnlen)280)] = dvals[from - 1]; - } - ++to; - if (to > 126 || from == nrows) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. First set the link count. */ - - page[127] = (doublereal) (to - 1); - -/* Write out the data page. */ - - zzekpgwd_(handle, &p, page); - -/* Next page. */ - - ++p; - to = 1; - } - } - -/* Update the column's metadata area to point to the data array. */ - - cmbase = coldsc[9]; - i__1 = cmbase + 1; - i__2 = cmbase + 1; - dasudi_(handle, &i__1, &i__2, &datbas); - -/* If the column is supposed to have an index, now is the time to */ -/* build that index. Type 2 indexes are just order vectors. */ - - if (indexd) { - -/* Compute the order vector. */ - - zzekordd_(dvals, &nullok, nlflgs, &nrows, wkindx); - -/* Write out the index. */ - - zzekwpai_(handle, segdsc, &nrows, wkindx, &idxpag, &idxbas); - -/* Update the column's metadata to point to the index. The */ -/* pointer indicates base address of the index. Also set the */ -/* index type in the column descriptor. */ - - mbase = segdsc[2]; - dscbas = mbase + 24 + (colidx - 1) * 11; - i__1 = dscbas + 7; - i__2 = dscbas + 7; - dasudi_(handle, &i__1, &i__2, &idxbas); - i__1 = dscbas + 6; - i__2 = dscbas + 6; - dasudi_(handle, &i__1, &i__2, &c__2); - } - if (nullok) { - -/* Nulls are allowed. Write out the null flag array. */ - - zzekwpal_(handle, segdsc, &nrows, nlflgs, &nflpag, &nflbas); - -/* Update the column's metadata area to point to the null flag */ -/* array. */ - - i__1 = cmbase + 2; - i__2 = cmbase + 2; - dasudi_(handle, &i__1, &i__2, &nflbas); - } - chkout_("ZZEKAC08", (ftnlen)8); - return 0; -} /* zzekac08_ */ - diff --git a/ext/spice/src/cspice/zzekac09.c b/ext/spice/src/cspice/zzekac09.c deleted file mode 100644 index 374ba98ab4..0000000000 --- a/ext/spice/src/cspice/zzekac09.c +++ /dev/null @@ -1,989 +0,0 @@ -/* zzekac09.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; - -/* $Procedure ZZEKAC09 ( EK, add class 9 column to segment ) */ -/* Subroutine */ int zzekac09_(integer *handle, integer *segdsc, integer * - coldsc, char *cvals, logical *nlflgs, integer *wkindx, ftnlen - cvals_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char page[1024]; - integer from; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekacps_(integer *, integer *, integer *, integer *, - integer *, integer *), zzekordc_(char *, logical *, logical *, - integer *, integer *, ftnlen), zzekpgwc_(integer *, integer *, - char *, ftnlen), zzekwpai_(integer *, integer *, integer *, - integer *, integer *, integer *), zzekwpal_(integer *, integer *, - integer *, logical *, integer *, integer *), zzekslnk_(integer *, - integer *, integer *, integer *); - integer l, p, mbase, npage; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer class__, nrows, cmbase; - extern logical return_(void); - char column[32]; - integer colidx, datbas, dscbas, idxbas, idxpag, idxtyp, nflbas, nflpag, - nulptr, to; - logical fixlen, indexd, nullok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasudi_(integer *, integer *, integer *, integer *); - integer spp; - -/* $ Abstract */ - -/* Add an entire class 9 column to an EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 9 Parameters */ - -/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 9 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 9 metadata array: */ - - -/* End Include Section: EK Column Class 9 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CVALS I Character values to add to column. */ -/* NLFLGS I Array of null flags for column entries. */ -/* WKINDX I-O Work space for column index. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* COLDSC is a descriptor for the column to be added. The */ -/* column attributes must be filled in, but any */ -/* pointers may be uninitialized. */ - -/* CVALS is an array containing the entire set of column */ -/* entries for the specified column. The entries */ -/* are listed in row-order: the column entry for the */ -/* first row of the segment is first, followed by the */ -/* column entry for the second row, and so on. The */ -/* number of column entries must match the declared */ -/* number of rows in the segment. Elements must be */ -/* allocated for each column entry, including null */ -/* entries. */ - -/* NLFLGS is an array of logical flags indicating whether */ -/* the corresponding entries are null. If the Ith */ -/* element of NLFLGS is .FALSE., the Ith column entry */ -/* defined by CVALS is added to the specified segment */ -/* in the specified kernel file. */ - -/* If the Ith element of NLFGLS is .TRUE., the */ -/* contents of the Ith column entry are undefined. */ - -/* NLFLGS is used only for columns that allow null */ -/* values; it's ignored for other columns. */ - -/* WKINDX is a work space array used for building a column */ -/* index. If the column is indexed, the dimension of */ -/* WKINDX must be at NROWS, where NROWS is the number */ -/* of rows in the column. If the column is not */ -/* indexed, this work space is not used, so the */ -/* dimension may be any positive value. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the named */ -/* EK file by adding data to the specified column. This routine */ -/* writes the entire contents of the specified column in one shot. */ -/* This routine creates columns much more efficiently than can be */ -/* done by sequential calls to EKACEC, but has the drawback that */ -/* the caller must use more memory for the routine's inputs. This */ -/* routine cannot be used to add data to a partially completed */ -/* column. */ - -/* Class 9 columns have fixed record counts, and contain */ -/* fixed-length strings. */ - -/* $ Examples */ - -/* See EKACLC. */ - -/* $ Restrictions */ - -/* 1) This routine assumes the EK file has been set up */ -/* properly for a fast load operation. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKAC09", (ftnlen)8); - } - -/* Grab the column's attributes. Initialize the maximum non-blank */ -/* width of the column. */ - - class__ = coldsc[0]; - idxtyp = coldsc[5]; - nulptr = coldsc[7]; - colidx = coldsc[8]; - l = coldsc[2]; - nullok = nulptr != -1; - indexd = idxtyp != -1; - fixlen = l != -1; - -/* This column had better be class 9. */ - - if (class__ != 9) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column class code # found in descriptor for column #. Clas" - "s should be 9.", (ftnlen)73); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKAC09", (ftnlen)8); - return 0; - } - -/* Make sure the column has fixed-length strings. */ - - if (! fixlen) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - setmsg_("Column # has variable string length; class 9 supports fixed" - "-length strings only.", (ftnlen)80); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKAC09", (ftnlen)8); - return 0; - } - -/* Check the input string length. */ - - if (l < 0 || l > i_len(cvals, cvals_len) || l > 1014) { - setmsg_("String length # is just plain wrong.", (ftnlen)36); - errint_("#", &l, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEKAC09", (ftnlen)8); - return 0; - } - -/* Compute the number of strings we can hold in one page. */ - - spp = 1014 / l; - -/* Find the number of rows in the segment. */ - - nrows = segdsc[5]; - -/* Decide how many pages are required to hold the array, and */ -/* allocate that many new, contiguous pages. */ - - npage = (nrows + spp - 1) / spp; - zzekacps_(handle, segdsc, &c__1, &npage, &p, &datbas); - -/* We'll use FROM to indicate the element of CVALS we're */ -/* considering and TO to indicate the element of PAGE to write */ -/* to. */ - - to = 1; - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - i__1 = nrows; - for (from = 1; from <= i__1; ++from) { - -/* The Assignment. */ - - if (! nullok || ! nlflgs[from - 1]) { - s_copy(page + (to - 1), cvals + (from - 1) * cvals_len, to + l - - 1 - (to - 1), cvals_len); - } - to += l; - if (to > 1014 - l + 1 || from == nrows) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. */ - - zzekpgwc_(handle, &p, page, (ftnlen)1024); - -/* Set the link count. */ - - i__2 = (to - l) / l; - zzekslnk_(handle, &c__1, &p, &i__2); - -/* Next page. */ - - ++p; - to = 1; - } - } - -/* Update the column's metadata area to point to the data array. */ - - cmbase = coldsc[9]; - i__1 = cmbase + 1; - i__2 = cmbase + 1; - dasudi_(handle, &i__1, &i__2, &datbas); - -/* If the column is supposed to have an index, now is the time to */ -/* build that index. Type 2 indexes are just order vectors. */ - - if (indexd) { - -/* Compute the order vector. */ - - zzekordc_(cvals, &nullok, nlflgs, &nrows, wkindx, cvals_len); - -/* Write out the index. */ - - zzekwpai_(handle, segdsc, &nrows, wkindx, &idxpag, &idxbas); - -/* Update the column's metadata to point to the index. The */ -/* pointer indicates base address of the index. Also set the */ -/* index type in the column descriptor. */ - - mbase = segdsc[2]; - dscbas = mbase + 24 + (colidx - 1) * 11; - i__1 = dscbas + 7; - i__2 = dscbas + 7; - dasudi_(handle, &i__1, &i__2, &idxbas); - i__1 = dscbas + 6; - i__2 = dscbas + 6; - dasudi_(handle, &i__1, &i__2, &c__2); - } - if (nullok) { - -/* Nulls are allowed. Write out the null flag array. */ - - zzekwpal_(handle, segdsc, &nrows, nlflgs, &nflpag, &nflbas); - -/* Update the column's metadata area to point to the null flag */ -/* array. */ - - i__1 = cmbase + 2; - i__2 = cmbase + 2; - dasudi_(handle, &i__1, &i__2, &nflbas); - } - chkout_("ZZEKAC09", (ftnlen)8); - return 0; -} /* zzekac09_ */ - diff --git a/ext/spice/src/cspice/zzekacps.c b/ext/spice/src/cspice/zzekacps.c deleted file mode 100644 index 0a9d84ae51..0000000000 --- a/ext/spice/src/cspice/zzekacps.c +++ /dev/null @@ -1,392 +0,0 @@ -/* zzekacps.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZEKACPS ( EK, allocate contiguous pages for segment ) */ -/* Subroutine */ int zzekacps_(integer *handle, integer *segdsc, integer * - type__, integer *n, integer *p, integer *base) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer tree; - extern /* Subroutine */ int zzekpgan_(integer *, integer *, integer *, - integer *), zzeksfwd_(integer *, integer *, integer *, integer *), - zzektrap_(integer *, integer *, integer *, integer *), zzekslnk_( - integer *, integer *, integer *, integer *); - integer b, i__, p2; - extern logical failed_(void); - integer idx; - -/* $ Abstract */ - -/* Allocate a series of contiguous data pages for a specified EK */ -/* segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* TYPE I Data type of page. */ -/* N I Number of pages to allocate. */ -/* P O Page number. */ -/* BASE O DAS base address of page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment for which to */ -/* allocate a series of data pages. */ - -/* TYPE is the data type of the desired pages. */ - -/* N is the number of pages desired. All pages */ -/* allocated are new. A new page is one that has not */ -/* been allocated before. */ - -/* $ Detailed_Output */ - -/* P is the number of the first page of the allocated */ -/* series. The rest of the pages have numbers */ - -/* P+1, P+2, ... , P+N-1 */ - -/* These numbers are recognized by the EK paged access */ -/* routines. */ - -/* BASE is the DAS base address of the first allocated */ -/* page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it allocates a series of */ -/* new, contiguous EK data pages for a specified segment. The */ -/* segment's metadata are updated to reflect aquisition of the pages. */ - -/* This routine, not ZZEKAPS, should be used when contiguous pages */ -/* are required. */ - -/* Each allocated page is initialized as follows: */ - -/* - The page's link count is zeroed out. */ - -/* - The page's forward pointer is zeroed out. */ - -/* After all pages are allocated, the metadata for the segment are */ -/* adjusted to reflect ownership of the allocated pages. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See ZZEKWPAI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Allocate the pages. */ - - zzekpgan_(handle, type__, p, base); - i__1 = *n; - for (i__ = 2; i__ <= i__1; ++i__) { - zzekpgan_(handle, type__, &p2, &b); - } - if (failed_()) { - return 0; - } - -/* Initialize the pages. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Zero out the page's link count and forward pointer. */ - - i__2 = *p + i__ - 1; - zzekslnk_(handle, type__, &i__2, &c__0); - i__2 = *p + i__ - 1; - zzeksfwd_(handle, type__, &i__2, &c__0); - } - -/* Update the segment's metadata. Insert the number of each new */ -/* page into the page tree of the appropriate data type. */ - - if (*type__ == 1) { - tree = segdsc[7]; - } else if (*type__ == 2) { - tree = segdsc[8]; - } else { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, one of the allocation routines would have */ -/* complained. */ - - tree = segdsc[9]; - } - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = *p + i__ - 1; - zzektrap_(handle, &tree, &i__2, &idx); - } - return 0; -} /* zzekacps_ */ - diff --git a/ext/spice/src/cspice/zzekad01.c b/ext/spice/src/cspice/zzekad01.c deleted file mode 100644 index 3e617ad640..0000000000 --- a/ext/spice/src/cspice/zzekad01.c +++ /dev/null @@ -1,890 +0,0 @@ -/* zzekad01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n2 = -2; -static integer c__3 = 3; -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure ZZEKAD01 ( EK, add data to class 1 column ) */ -/* Subroutine */ int zzekad01_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *ival, logical *isnull) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - extern /* Subroutine */ int zzekiii1_(integer *, integer *, integer *, - integer *, integer *, logical *); - extern integer zzekrp2n_(integer *, integer *, integer *); - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *), - zzekglnk_(integer *, integer *, integer *, integer *), zzekslnk_( - integer *, integer *, integer *, integer *); - integer p, mbase, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, itype, lastw; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - integer colidx, datptr, nlinks, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzekaps_(integer *, integer *, integer *, logical *, - integer *, integer *); - -/* $ Abstract */ - -/* Add a column entry to a class 1 column in a specified EK record. */ -/* Class 1 columns contain scalar, integer values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* IVAL I Integer value. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment in which */ -/* the specified column entry is to be written. */ - -/* COLDSC is the descriptor of the column in which */ -/* the specified column entry is to be written. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* IVAL is the integer value that will be written */ -/* to the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input IVAL is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file is not modified. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ -/* The file is not modified. */ - -/* 3) If the input flag ISNULL is .TRUE. but the target column */ -/* does not allow nulls, the error SPICE(BADATTRIBUTE) is */ -/* signalled. The file is not modified. */ - -/* 4) If RECPTR is invalid, a DAS addressing error may occur. The */ -/* error in *not* trapped in advance. This routine assumes that */ -/* a valid value of RECPTR has been supplied by the caller. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it sets the value of a */ -/* column entry in an EK segment. If the column is indexed, the */ -/* index is updated to reflect the presence of the new entry. This */ -/* routine is intended to set values of uninitialized column entries */ -/* only. To update existing entries, use the ZZEKUExx routines, or */ -/* at the user level, the EKUCEx routines. */ - -/* This routine does not participate in shadowing functions. If the */ -/* target EK is shadowed, the caller is responsible for performing */ -/* necessary backup operations. If the target EK is not shadowed, */ -/* the target record's status is not modified. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKACEI. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to update existing column entries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKAD01", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &ncols, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKAD01", (ftnlen)8); - return 0; - } - -/* If the value is null, make sure that nulls are permitted */ -/* in this column. */ - - if (*isnull && coldsc[7] != 1) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD01", (ftnlen)8); - setmsg_("Column having index # in segment # does not allow nulls, bu" - "t a null value was supplied for the element in record #.", ( - ftnlen)115); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTE)", (ftnlen)19); - chkout_("ZZEKAD01", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location. Check the data pointer to */ -/* make sure the column entry we're writing to is uninitialized. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr != -1 && datptr != -3) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD01", (ftnlen)8); - setmsg_("Column having index # in segment # has non-empty element in" - " record #.", (ftnlen)69); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(NONEMPTYENTRY)", (ftnlen)20); - chkout_("ZZEKAD01", (ftnlen)8); - return 0; - } - -/* Set the data value. */ - - if (*isnull) { - -/* All we need do is set the data pointer. The segment's */ -/* metadata are not affected. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - -/* Decide where to write the data value. If there's room left */ -/* in the last integer data page, append the value there. */ - - lastw = segdsc[20]; - if (lastw < 254) { - -/* There's room in the current page. Set the data pointer */ -/* and count, and write the value out to the first free */ -/* location. */ - - p = segdsc[17]; - zzekpgbs_(&c__3, &p, &pbase); - datptr = pbase + lastw + 1; - dasudi_(handle, &ptrloc, &ptrloc, &datptr); - dasudi_(handle, &datptr, &datptr, ival); - -/* The page containing the data item gains a link. */ - - zzekglnk_(handle, &c__3, &p, &nlinks); - i__1 = nlinks + 1; - zzekslnk_(handle, &c__3, &p, &i__1); - -/* The last integer word in use must be updated. */ - - segdsc[20] = lastw + 1; - } else { - -/* Allocate a data page. Write the data value into the */ -/* first word of the new page. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); - i__1 = pbase + 1; - i__2 = pbase + 1; - dasudi_(handle, &i__1, &i__2, ival); - -/* The page containing the data item now has one link. */ - - zzekslnk_(handle, &c__3, &p, &c__1); - -/* The last integer page and word in use must be updated. */ - - segdsc[17] = p; - segdsc[20] = 1; - -/* The record pointer must point to this data item. */ - - i__1 = pbase + 1; - dasudi_(handle, &ptrloc, &ptrloc, &i__1); - } - } - -/* Write out the updated segment descriptor. */ - - mbase = segdsc[2]; - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - -/* If the column is indexed, we must update the index to account */ -/* for the new element. */ - - itype = coldsc[5]; - if (itype != -1) { - -/* The column is indexed. */ - - if (itype == 1) { - -/* The column has a type 1 index. Insert the record pointer */ -/* of the current element at the appropriate location. */ - - zzekiii1_(handle, segdsc, coldsc, ival, recptr, isnull); - } else { - chkin_("ZZEKAD01", (ftnlen)8); - setmsg_("Column having index # in segment # has index type #.", ( - ftnlen)52); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKAD01", (ftnlen)8); - return 0; - } - } - return 0; -} /* zzekad01_ */ - diff --git a/ext/spice/src/cspice/zzekad02.c b/ext/spice/src/cspice/zzekad02.c deleted file mode 100644 index c065b4c6ca..0000000000 --- a/ext/spice/src/cspice/zzekad02.c +++ /dev/null @@ -1,887 +0,0 @@ -/* zzekad02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n2 = -2; -static integer c__2 = 2; -static logical c_false = FALSE_; -static integer c__1 = 1; - -/* $Procedure ZZEKAD02 ( EK, add data to class 2 column ) */ -/* Subroutine */ int zzekad02_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, doublereal *dval, logical *isnull) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - extern /* Subroutine */ int zzekiid1_(integer *, integer *, integer *, - doublereal *, integer *, logical *); - extern integer zzekrp2n_(integer *, integer *, integer *); - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *), - zzekglnk_(integer *, integer *, integer *, integer *), zzekslnk_( - integer *, integer *, integer *, integer *); - integer p, mbase, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, itype, lastw; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - integer colidx, datptr, nlinks, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasudd_(integer *, integer *, integer *, doublereal *), - zzekaps_(integer *, integer *, integer *, logical *, integer *, - integer *); - -/* $ Abstract */ - -/* Add a column entry to a specified record in a class 2 column. */ -/* Class 2 columns contain scalar double precision values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* DVAL I Double precision value. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment in which */ -/* the specified column entry is to be written. */ - -/* COLDSC is the descriptor of the column in which */ -/* the specified column entry is to be written. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* DVAL is the double precision value that will be written */ -/* to the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input DVAL is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file is not modified. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ -/* The file is not modified. */ - -/* 3) If the input flag ISNULL is .TRUE. but the target column */ -/* does not allow nulls, the error SPICE(BADATTRIBUTE) is */ -/* signalled. The file is not modified. */ - -/* 4) If RECPTR is invalid, a DAS addressing error may occur. The */ -/* error in *not* trapped in advance. This routine assumes that */ -/* a valid value of RECPTR has been supplied by the caller. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it sets the value of a */ -/* column entry in an EK segment. If the column is indexed, the */ -/* index is updated to reflect the presence of the new entry. This */ -/* routine is intended to set values of uninitialized column entries */ -/* only. To update existing entries, use the ZZEKUExx routines, or */ -/* at the user level, the EKUCEx routines. */ - -/* This routine does not participate in shadowing functions. If the */ -/* target EK is shadowed, the caller is responsible for performing */ -/* necessary backup operations. If the target EK is not shadowed, */ -/* the target record's status is not modified. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKACED. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to update existing column entries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKAD02", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &ncols, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKAD02", (ftnlen)8); - return 0; - } - -/* If the value is null, make sure that nulls are permitted */ -/* in this column. */ - - if (*isnull && coldsc[7] != 1) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD02", (ftnlen)8); - setmsg_("Column having index # in segment # does not allow nulls, bu" - "t a null value was supplied for the element in record #.", ( - ftnlen)115); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTE)", (ftnlen)19); - chkout_("ZZEKAD02", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location. Check the data pointer to */ -/* make sure the column entry we're writing to is uninitialized. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr != -1 && datptr != -3) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD02", (ftnlen)8); - setmsg_("Column having index # in segment # has non-empty element in" - " record #.", (ftnlen)69); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(NONEMPTYENTRY)", (ftnlen)20); - chkout_("ZZEKAD02", (ftnlen)8); - return 0; - } - if (*isnull) { - -/* All we need do is set the data pointer. The segment's */ -/* metadata are not affected. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - -/* Decide where to write the data value. If there's room left */ -/* in the last double precision data page, append the value there. */ - - lastw = segdsc[19]; - if (lastw < 126) { - -/* There's room in the current page. Set the data pointer */ -/* and count, and write the value out to the first free */ -/* location. */ - - p = segdsc[16]; - zzekpgbs_(&c__2, &p, &pbase); - datptr = pbase + lastw + 1; - dasudi_(handle, &ptrloc, &ptrloc, &datptr); - dasudd_(handle, &datptr, &datptr, dval); - zzekglnk_(handle, &c__2, &p, &nlinks); - i__1 = nlinks + 1; - zzekslnk_(handle, &c__2, &p, &i__1); - -/* The last double precision word in use must be updated. */ - - segdsc[19] = lastw + 1; - } else { - -/* Allocate a data page. Write the data value into the */ -/* first word of the new page. */ - - zzekaps_(handle, segdsc, &c__2, &c_false, &p, &pbase); - i__1 = pbase + 1; - i__2 = pbase + 1; - dasudd_(handle, &i__1, &i__2, dval); - -/* The page containing the data item now has one link. */ - - zzekslnk_(handle, &c__2, &p, &c__1); - -/* The last d.p. page and word in use must be updated. */ - - segdsc[16] = p; - segdsc[19] = 1; - -/* The record pointer must point to this data item. */ - - i__1 = pbase + 1; - dasudi_(handle, &ptrloc, &ptrloc, &i__1); - } - } - -/* Write out the updated segment descriptor. */ - - mbase = segdsc[2]; - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - -/* If the column is indexed, we must update the index to account */ -/* for the new element. */ - - itype = coldsc[5]; - if (itype != -1) { - -/* The column is indexed. */ - - if (itype == 1) { - -/* The column has a type 1 index. Insert the record number */ -/* of the current element at the appropriate location. */ - - zzekiid1_(handle, segdsc, coldsc, dval, recptr, isnull); - } else { - chkin_("ZZEKAD02", (ftnlen)8); - setmsg_("Column having index # in segment # has index type #.", ( - ftnlen)52); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKAD02", (ftnlen)8); - return 0; - } - } - return 0; -} /* zzekad02_ */ - diff --git a/ext/spice/src/cspice/zzekad03.c b/ext/spice/src/cspice/zzekad03.c deleted file mode 100644 index 7dbd876a71..0000000000 --- a/ext/spice/src/cspice/zzekad03.c +++ /dev/null @@ -1,947 +0,0 @@ -/* zzekad03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n2 = -2; -static integer c__1 = 1; -static logical c_false = FALSE_; -static integer c__0 = 0; - -/* $Procedure ZZEKAD03 ( EK, add data to class 3 column ) */ -/* Subroutine */ int zzekad03_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - extern /* Subroutine */ int zzekiic1_(integer *, integer *, integer *, - char *, integer *, logical *, ftnlen); - extern integer zzekrp2n_(integer *, integer *, integer *); - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *), - zzekglnk_(integer *, integer *, integer *, integer *), zzeksfwd_( - integer *, integer *, integer *, integer *), zzekslnk_(integer *, - integer *, integer *, integer *); - integer n, p, mbase, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, itype, lastw; - extern integer rtrim_(char *, ftnlen); - integer p2; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *), dasudc_(integer *, integer *, integer *, integer *, - integer *, char *, ftnlen); - integer colidx, datptr, nlinks, nwrite, pcount, prvbas, ptrloc, strlen; - logical fixlen; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer lnb, pos; - extern /* Subroutine */ int zzeksei_(integer *, integer *, integer *), - zzekaps_(integer *, integer *, integer *, logical *, integer *, - integer *); - -/* $ Abstract */ - -/* Add a column entry to a class 3 column in a specified EK record. */ -/* Class 3 columns contain scalar, character values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* CVAL I Character string value. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment in which */ -/* the specified column entry is to be written. */ - -/* COLDSC is the descriptor of the column in which */ -/* the specified column entry is to be written. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* CVAL is the character string value that will be written */ -/* to the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input CVAL is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file is not modified. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ -/* The file is not modified. */ - -/* 3) If the input flag ISNULL is .TRUE. but the target column */ -/* does not allow nulls, the error SPICE(BADATTRIBUTE) is */ -/* signalled. The file is not modified. */ - -/* 4) If RECPTR is invalid, a DAS addressing error may occur. The */ -/* error in *not* trapped in advance. This routine assumes that */ -/* a valid value of RECPTR has been supplied by the caller. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it sets the value of a */ -/* column entry in an EK segment. If the column is indexed, the */ -/* index is updated to reflect the presence of the new entry. This */ -/* routine is intended to set values of uninitialized column entries */ -/* only. To update existing entries, use the ZZEKUExx routines, or */ -/* at the user level, the EKUCEx routines. */ - -/* This routine does not participate in shadowing functions. If the */ -/* target EK is shadowed, the caller is responsible for performing */ -/* necessary backup operations. If the target EK is not shadowed, */ -/* the target record's status is not modified. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKACEC. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to update existing column entries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKAD03", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &ncols, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKAD03", (ftnlen)8); - return 0; - } - -/* If the value is null, make sure that nulls are permitted */ -/* in this column. */ - - if (*isnull && coldsc[7] != 1) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD03", (ftnlen)8); - setmsg_("Column having index # in segment # does not allow nulls, bu" - "t a null value was supplied for the element in record #.", ( - ftnlen)115); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTE)", (ftnlen)19); - chkout_("ZZEKAD03", (ftnlen)8); - return 0; - } - -/* Decide the length of the string value. If the column contains */ -/* variable-length strings, the effective length of the string is */ -/* just the non-blank length of CVAL. Otherwise, the effective */ -/* string length is the minimum of the non-blank length and the */ -/* column's declared string length. We don't store trailing blanks. */ - - fixlen = coldsc[2] != -1; - lnb = rtrim_(cval, cval_len); - if (fixlen) { - strlen = min(coldsc[2],lnb); - } else { - strlen = lnb; - } - -/* Compute the data pointer location. */ - - ptrloc = *recptr + 2 + colidx; - if (*isnull) { - -/* All we need do is set the data pointer. The segment's */ -/* metadata are not affected. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - -/* Write out the data value. If we run out of room in the */ -/* page we're writing to, we allocate a new page and link */ -/* the previous page to it. */ - - n = strlen; - pos = 1; - lastw = segdsc[18]; - p = segdsc[15]; - pcount = 0; - while(n > 0) { - -/* Write as much data as possible into the current page. */ - - if (lastw < 1009) { - -/* There's room in the current page. We never split an */ -/* encoded character count across pages, and we always */ -/* write at least one data character to the current page. */ -/* This practice is slightly wasteful of space but greatly */ -/* simplifies our logic. */ - -/* Keep track of the number of pages our string spans. */ - - ++pcount; - -/* If this is the first data page, write the data pointer */ -/* into the record pointer and the character count into */ -/* the data page. */ - - if (pcount == 1) { - zzekpgbs_(&c__1, &p, &pbase); - datptr = pbase + lastw + 1; - dasudi_(handle, &ptrloc, &ptrloc, &datptr); - zzeksei_(handle, &datptr, &strlen); - -/* Advance the data pointer to the first data */ -/* character's position. The last word in use */ -/* increases as well. */ - - datptr += 5; - lastw += 5; - } else { - -/* We still need the data pointer. */ - - datptr = pbase + 1; - } - -/* Compute the number of characters to write into this page, */ -/* and write that number of characters. */ - -/* Computing MIN */ - i__1 = 1014 - lastw; - nwrite = min(i__1,n); - i__1 = datptr + nwrite - 1; - dasudc_(handle, &datptr, &i__1, &c__1, &nwrite, cval + (pos - - 1), cval_len - (pos - 1)); - n -= nwrite; - pos += nwrite; - -/* The page containing the data item gains a link. */ - - zzekglnk_(handle, &c__1, &p, &nlinks); - i__1 = nlinks + 1; - zzekslnk_(handle, &c__1, &p, &i__1); - -/* The last character word in use must be updated. */ - - lastw += nwrite; - segdsc[18] = lastw; - -/* Retain the base address of this data page. */ - - prvbas = pbase; - } else { - -/* Allocate a data page. If this is not the first data */ -/* page written to, link the previous page to the current */ -/* one. */ - - zzekaps_(handle, segdsc, &c__1, &c_false, &p2, &pbase); - if (pcount > 0) { - zzeksfwd_(handle, &c__1, &p, &p2); - } - -/* The last character page and word in use must be updated. */ - - p = p2; - lastw = 0; - segdsc[15] = p; - segdsc[18] = lastw; - -/* Make sure the link count is zeroed out. */ - - zzekslnk_(handle, &c__1, &p, &c__0); - } - } - } - -/* Write out the updated segment descriptor. */ - - mbase = segdsc[2]; - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - -/* If the column is indexed, we must update the index to account */ -/* for the new element. */ - - itype = coldsc[5]; - if (itype != -1) { - -/* The column is indexed. */ - - if (itype == 1) { - -/* The column has a type 1 index. Insert the record number */ -/* of the current element at the appropriate location. */ - - zzekiic1_(handle, segdsc, coldsc, cval, recptr, isnull, cval_len); - } else { - chkin_("ZZEKAD03", (ftnlen)8); - setmsg_("Column having index # in segment # has index type #.", ( - ftnlen)52); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKAD03", (ftnlen)8); - return 0; - } - } - return 0; -} /* zzekad03_ */ - diff --git a/ext/spice/src/cspice/zzekad04.c b/ext/spice/src/cspice/zzekad04.c deleted file mode 100644 index eba5a7e404..0000000000 --- a/ext/spice/src/cspice/zzekad04.c +++ /dev/null @@ -1,927 +0,0 @@ -/* zzekad04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n2 = -2; -static integer c__3 = 3; -static logical c_false = FALSE_; -static integer c__0 = 0; - -/* $Procedure ZZEKAD04 ( EK, add data to class 4 column ) */ -/* Subroutine */ int zzekad04_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *nvals, integer *ivals, logical * - isnull) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer room; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *), - zzekglnk_(integer *, integer *, integer *, integer *), zzeksfwd_( - integer *, integer *, integer *, integer *), zzekslnk_(integer *, - integer *, integer *, integer *); - integer p, mbase, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, lastw, start, p2; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - integer remain, colidx, datptr, nlinks, nwrite, ptrloc; - logical fstpag; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzekaps_(integer *, integer *, integer *, logical *, - integer *, integer *); - -/* $ Abstract */ - -/* Add a column entry to a specified record in a class 4 column. */ -/* The entries of class 4 columns are arrays of integer values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* NVALS I Number of values to add to column. */ -/* IVALS I Integer values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment in which */ -/* the specified column entry is to be written. */ - -/* COLDSC is the descriptor of the column in which */ -/* the specified column entry is to be written. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* NVALS, */ -/* IVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written into the */ -/* specified column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* Only one value can be added to a virtual column. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and IVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and IVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file is not modified. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ -/* The file is not modified. */ - -/* 3) If the input flag ISNULL is .TRUE. but the target column */ -/* does not allow nulls, the error SPICE(BADATTRIBUTE) is */ -/* signalled. The file is not modified. */ - -/* 4) If RECPTR is invalid, a DAS addressing error may occur. The */ -/* error in *not* trapped in advance. This routine assumes that */ -/* a valid value of RECPTR has been supplied by the caller. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it sets the value of a */ -/* column entry in an EK segment. If the column is indexed, the */ -/* index is updated to reflect the presence of the new entry. This */ -/* routine is intended to set values of uninitialized column entries */ -/* only. To update existing entries, use the ZZEKUExx routines, or */ -/* at the user level, the EKUCEx routines. */ - -/* This routine does not participate in shadowing functions. If the */ -/* target EK is shadowed, the caller is responsible for performing */ -/* necessary backup operations. If the target EK is not shadowed, */ -/* the target record's status is not modified. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKACEI. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to update existing column entries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nrec = segdsc[5]; - colidx = coldsc[8]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKAD04", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKAD04", (ftnlen)8); - return 0; - } - -/* If the value is null, make sure that nulls are permitted */ -/* in this column. */ - - if (*isnull && coldsc[7] != 1) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD04", (ftnlen)8); - setmsg_("Column having index # in segment # does not allow nulls, bu" - "t a null value was supplied for the element in record #.", ( - ftnlen)115); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTE)", (ftnlen)19); - chkout_("ZZEKAD04", (ftnlen)8); - return 0; - } - -/* Check NVALS. If the column has fixed-size entries, NVALS must */ -/* match the declared entry size. In all cases, NVALS must be */ -/* positive. */ - - if (*nvals < 1) { - chkin_("ZZEKAD04", (ftnlen)8); - setmsg_("COLIDX = #; segment = #; NVALS = #; NVALS must be positiv" - "e ", (ftnlen)61); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", nvals, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKAD04", (ftnlen)8); - return 0; - } - if (coldsc[3] != -1) { - if (*nvals != coldsc[3]) { - chkin_("ZZEKAD04", (ftnlen)8); - setmsg_("COLIDX = #; segment = #; NVALS = #; declared entry siz" - "e = #. Sizes must match.", (ftnlen)80); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", nvals, (ftnlen)1); - errint_("#", &coldsc[3], (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKAD04", (ftnlen)8); - return 0; - } - } - -/* Compute the data pointer location. */ - - ptrloc = *recptr + 2 + colidx; - if (*isnull) { - -/* All we need do is set the data pointer. The segment's */ -/* metadata are not affected. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - lastw = segdsc[20]; - room = 254 - lastw; - remain = *nvals; - start = 1; - fstpag = TRUE_; - while(remain > 0) { - -/* Decide where to write the data values. In order to write */ -/* to the current page, we require enough room for the count */ -/* and at least one column entry element. */ - - if (room >= 2) { - -/* There's room in the current page. If this is the first */ -/* page this entry is written on, set the data pointer */ -/* and count. Write as much of the value as possible to */ -/* the current page. */ - - p = segdsc[17]; - zzekpgbs_(&c__3, &p, &pbase); - datptr = pbase + lastw + 1; - if (fstpag) { - dasudi_(handle, &ptrloc, &ptrloc, &datptr); - dasudi_(handle, &datptr, &datptr, nvals); - --room; - ++datptr; - } - nwrite = min(remain,room); - i__1 = datptr + nwrite - 1; - dasudi_(handle, &datptr, &i__1, &ivals[start - 1]); - remain -= nwrite; - room -= nwrite; - start += nwrite; - -/* The page containing the data item gains a link. */ - - zzekglnk_(handle, &c__3, &p, &nlinks); - i__1 = nlinks + 1; - zzekslnk_(handle, &c__3, &p, &i__1); - -/* The last integer word in use must be updated. Account */ -/* for the count, if this is the first page on which the */ -/* current entry is written. */ - - if (fstpag) { - segdsc[20] = lastw + 1 + nwrite; - fstpag = FALSE_; - } else { - segdsc[20] = lastw + nwrite; - } - } else { - -/* Allocate a data page. If this is not the first data */ -/* page written to, link the previous page to the current */ -/* one. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p2, &pbase); - if (! fstpag) { - zzeksfwd_(handle, &c__3, &p, &p2); - } - -/* The last integer page and word in use must be updated. */ - - p = p2; - lastw = 0; - segdsc[17] = p; - segdsc[20] = lastw; - room = 254; - -/* Make sure the link count is zeroed out. */ - - zzekslnk_(handle, &c__3, &p, &c__0); - } - } - } - -/* Write out the updated segment descriptor. */ - - mbase = segdsc[2]; - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - -/* Class 4 columns are not indexed, so we need not update any */ -/* index to account for the new element. */ - - return 0; -} /* zzekad04_ */ - diff --git a/ext/spice/src/cspice/zzekad05.c b/ext/spice/src/cspice/zzekad05.c deleted file mode 100644 index 30b3204bfd..0000000000 --- a/ext/spice/src/cspice/zzekad05.c +++ /dev/null @@ -1,934 +0,0 @@ -/* zzekad05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n2 = -2; -static integer c__2 = 2; -static logical c_false = FALSE_; -static integer c__0 = 0; - -/* $Procedure ZZEKAD05 ( EK, add data to class 5 column ) */ -/* Subroutine */ int zzekad05_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical * - isnull) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Local variables */ - integer nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer room; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *), - zzekglnk_(integer *, integer *, integer *, integer *), zzeksfwd_( - integer *, integer *, integer *, integer *), zzekslnk_(integer *, - integer *, integer *, integer *); - integer p, mbase, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, lastw, start, p2; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - integer remain, colidx, datptr, nlinks, nwrite, prvbas, ptrloc; - logical fstpag; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasudd_(integer *, integer *, integer *, doublereal *), - zzekaps_(integer *, integer *, integer *, logical *, integer *, - integer *); - -/* $ Abstract */ - -/* Add a column entry to a specified record in a class 5 column. */ -/* The entries of class 5 columns are arrays of d.p. values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to new EK file. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record to which data is to be added. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values to add to column. */ -/* DVALS I Double precision values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGNO is the index of the segment to which data is to */ -/* be added. */ - -/* RECNO is the index of the record to which data is to be */ -/* added. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column to which data is to be */ -/* added. */ - -/* NVALS, */ -/* DVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written into the */ -/* specified column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* Only one value can be added to a virtual column. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and DVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and DVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file is not modified. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ -/* The file is not modified. */ - -/* 3) If the input flag ISNULL is .TRUE. but the target column */ -/* does not allow nulls, the error SPICE(BADATTRIBUTE) is */ -/* signalled. The file is not modified. */ - -/* 4) If RECPTR is invalid, a DAS addressing error may occur. The */ -/* error in *not* trapped in advance. This routine assumes that */ -/* a valid value of RECPTR has been supplied by the caller. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it sets the value of a */ -/* column entry in an EK segment. If the column is indexed, the */ -/* index is updated to reflect the presence of the new entry. This */ -/* routine is intended to set values of uninitialized column entries */ -/* only. To update existing entries, use the ZZEKUExx routines, or */ -/* at the user level, the EKUCEx routines. */ - -/* This routine does not participate in shadowing functions. If the */ -/* target EK is shadowed, the caller is responsible for performing */ -/* necessary backup operations. If the target EK is not shadowed, */ -/* the target record's status is not modified. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKACED. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to update existing column entries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nrec = segdsc[5]; - colidx = coldsc[8]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKAD05", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKAD05", (ftnlen)8); - return 0; - } - -/* If the value is null, make sure that nulls are permitted */ -/* in this column. */ - - if (*isnull && coldsc[7] != 1) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD05", (ftnlen)8); - setmsg_("Column having index # in segment # does not allow nulls, bu" - "t a null value was supplied for the element in record #.", ( - ftnlen)115); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTE)", (ftnlen)19); - chkout_("ZZEKAD05", (ftnlen)8); - return 0; - } - -/* Check NVALS. If the column has fixed-size entries, NVALS must */ -/* match the declared entry size. In all cases, NVALS must be */ -/* positive. */ - - if (*nvals < 1) { - chkin_("ZZEKAD05", (ftnlen)8); - setmsg_("COLIDX = #; segment = #; NVALS = #; NVALS must be positiv" - "e ", (ftnlen)61); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", nvals, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKAD05", (ftnlen)8); - return 0; - } - if (coldsc[3] != -1) { - if (*nvals != coldsc[3]) { - chkin_("ZZEKAD05", (ftnlen)8); - setmsg_("COLIDX = #; segment = #; NVALS = #; declared entry siz" - "e = #. Sizes must match.", (ftnlen)80); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", nvals, (ftnlen)1); - errint_("#", &coldsc[3], (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKAD05", (ftnlen)8); - return 0; - } - } - -/* Compute the data pointer location. */ - - ptrloc = *recptr + 2 + colidx; - if (*isnull) { - -/* All we need do is set the data pointer. The segment's */ -/* metadata are not affected. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - lastw = segdsc[19]; - room = 126 - lastw; - remain = *nvals; - start = 1; - fstpag = TRUE_; - while(remain > 0) { - -/* Decide where to write the data values. In order to write */ -/* to the current page, we require enough room for the count */ -/* and at least one column entry element. */ - - if (room >= 2) { - -/* There's room in the current page. If this is the first */ -/* page this entry is written on, set the data pointer */ -/* and count. Write as much of the value as possible to */ -/* the current page. */ - - p = segdsc[16]; - zzekpgbs_(&c__2, &p, &pbase); - prvbas = pbase; - datptr = pbase + lastw + 1; - if (fstpag) { - dasudi_(handle, &ptrloc, &ptrloc, &datptr); - d__1 = (doublereal) (*nvals); - dasudd_(handle, &datptr, &datptr, &d__1); - --room; - ++datptr; - } - nwrite = min(remain,room); - i__1 = datptr + nwrite - 1; - dasudd_(handle, &datptr, &i__1, &dvals[start - 1]); - remain -= nwrite; - room -= nwrite; - start += nwrite; - -/* The page containing the data item gains a link. */ - - zzekglnk_(handle, &c__2, &p, &nlinks); - i__1 = nlinks + 1; - zzekslnk_(handle, &c__2, &p, &i__1); - -/* The last d.p. word in use must be updated. Account */ -/* for the count, if this is the first page on which the */ -/* current entry is written. */ - - if (fstpag) { - segdsc[19] = lastw + 1 + nwrite; - fstpag = FALSE_; - } else { - segdsc[19] = lastw + nwrite; - } - } else { - -/* Allocate a d.p. data page. If this is not the first data */ -/* page written to, link the previous page to the current */ -/* one. */ - - zzekaps_(handle, segdsc, &c__2, &c_false, &p2, &pbase); - if (! fstpag) { - zzeksfwd_(handle, &c__2, &p, &p2); - } - -/* The last d.p. page and word in use must be updated. */ - - p = p2; - lastw = 0; - segdsc[16] = p; - segdsc[19] = lastw; - room = 126; - -/* Make sure the link count is zeroed out. */ - - zzekslnk_(handle, &c__2, &p, &c__0); - } - } - } - -/* Write out the updated segment descriptor. */ - - mbase = segdsc[2]; - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - -/* Class 5 columns are not indexed, so we need not update any */ -/* index to account for the new element. */ - - return 0; -} /* zzekad05_ */ - diff --git a/ext/spice/src/cspice/zzekad06.c b/ext/spice/src/cspice/zzekad06.c deleted file mode 100644 index c520f18bb5..0000000000 --- a/ext/spice/src/cspice/zzekad06.c +++ /dev/null @@ -1,1047 +0,0 @@ -/* zzekad06.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n2 = -2; -static integer c__1 = 1; -static logical c_false = FALSE_; - -/* $Procedure ZZEKAD06 ( EK, add data to class 6 column ) */ -/* Subroutine */ int zzekad06_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, - ftnlen cvals_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - static integer npad, nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - static integer room; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *), - zzekglnk_(integer *, integer *, integer *, integer *), zzeksfwd_( - integer *, integer *, integer *, integer *), zzekslnk_(integer *, - integer *, integer *, integer *); - static integer n, p, mbase, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer recno, cvlen, nchrs, ncols, lastw, p2; - extern logical failed_(void); - static integer np; - static char padbuf[100]; - static integer padlen, colidx, datptr, eltidx, mnroom, nlinks, nwrite, - ptrloc, remain, strlen, wp; - static logical fstpag; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasudi_(integer *, integer *, integer *, integer *), - dasudc_(integer *, integer *, integer *, integer *, integer *, - char *, ftnlen); - static logical pad; - static integer pos; - extern /* Subroutine */ int zzeksei_(integer *, integer *, integer *), - zzekaps_(integer *, integer *, integer *, logical *, integer *, - integer *); - -/* $ Abstract */ - -/* Add a column entry to a specified record in a class 6 column. */ -/* The entries of class 6 columns are arrays of character string */ -/* values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGNO I Index of segment containing record. */ -/* RECNO I Record to which data is to be added. */ -/* COLUMN I Column name. */ -/* NVALS I Number of values to add to column. */ -/* CVALS I Character values to add to column. */ -/* ISNULL I Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file that is open for write */ -/* access. */ - -/* SEGNO is the index of the segment to which data is to */ -/* be added. */ - -/* RECNO is the index of the record to which data is to be */ -/* added. This record number is relative to the start */ -/* of the segment indicated by SEGNO; the first */ -/* record in the segment has index 1. */ - -/* COLUMN is the name of the column to which data is to be */ -/* added. */ - -/* NVALS, */ -/* CVALS are, respectively, the number of values to add to */ -/* the specified column and the set of values */ -/* themselves. The data values are written into the */ -/* specified column and record. */ - -/* If the column has fixed-size entries, then NVALS */ -/* must equal the entry size for the specified column. */ - -/* Only one value can be added to a virtual column. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. If ISNULL is .FALSE., the column entry */ -/* defined by NVALS and CVALS is added to the */ -/* specified kernel file. */ - -/* If ISNULL is .TRUE., NVALS and CVALS are ignored. */ -/* The contents of the column entry are undefined. */ -/* If the column has fixed-length, variable-size */ -/* entries, the number of entries is considered to */ -/* be 1. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file is not modified. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ -/* The file is not modified. */ - -/* 3) If the input flag ISNULL is .TRUE. but the target column */ -/* does not allow nulls, the error SPICE(BADATTRIBUTE) is */ -/* signalled. The file is not modified. */ - -/* 4) If RECPTR is invalid, a DAS addressing error may occur. The */ -/* error in *not* trapped in advance. This routine assumes that */ -/* a valid value of RECPTR has been supplied by the caller. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it sets the value of a */ -/* column entry in an EK segment. If the column is indexed, the */ -/* index is updated to reflect the presence of the new entry. This */ -/* routine is intended to set values of uninitialized column entries */ -/* only. To update existing entries, use the ZZEKUExx routines, or */ -/* at the user level, the EKUCEx routines. */ - -/* This routine does not participate in shadowing functions. If the */ -/* target EK is shadowed, the caller is responsible for performing */ -/* necessary backup operations. If the target EK is not shadowed, */ -/* the target record's status is not modified. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKACEC. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to update existing column entries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. */ - - if (first) { - s_copy(padbuf, " ", (ftnlen)100, (ftnlen)1); - first = FALSE_; - } - -/* Make sure the record exists. */ - - nrec = segdsc[5]; - colidx = coldsc[8]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKAD06", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKAD06", (ftnlen)8); - return 0; - } - -/* If the value is null, make sure that nulls are permitted */ -/* in this column. */ - - if (*isnull && coldsc[7] != 1) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKAD06", (ftnlen)8); - setmsg_("Column having index # in segment # does not allow nulls, bu" - "t a null value was supplied for the element in record #.", ( - ftnlen)115); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - sigerr_("SPICE(BADATTRIBUTE)", (ftnlen)19); - chkout_("ZZEKAD06", (ftnlen)8); - return 0; - } - -/* Check NVALS. If the column has fixed-size entries, NVALS must */ -/* match the declared entry size. In all cases, NVALS must be */ -/* positive. */ - - if (*nvals < 1) { - chkin_("ZZEKAD06", (ftnlen)8); - setmsg_("COLIDX = #; segment = #; NVALS = #; NVALS must be positiv" - "e ", (ftnlen)61); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", nvals, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKAD06", (ftnlen)8); - return 0; - } - if (coldsc[3] != -1) { - if (*nvals != coldsc[3]) { - chkin_("ZZEKAD06", (ftnlen)8); - setmsg_("COLIDX = #; segment = #; NVALS = #; declared entry siz" - "e = #. Sizes must match.", (ftnlen)80); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", nvals, (ftnlen)1); - errint_("#", &coldsc[3], (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKAD06", (ftnlen)8); - return 0; - } - } - -/* Compute the data pointer location. */ - - ptrloc = *recptr + 2 + colidx; - if (*isnull) { - -/* All we need do is set the data pointer. The segment's */ -/* metadata are not affected. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - -/* Decide now whether we will need to pad the input entry */ -/* elements with trailing blanks, and if so how much padding */ -/* we'll need. */ - - strlen = coldsc[2]; - cvlen = i_len(cvals, cvals_len); - pad = cvlen < strlen; - if (pad) { - padlen = strlen - cvlen; - } - lastw = segdsc[18]; - room = 1014 - lastw; - fstpag = TRUE_; - -/* Initialize the page base and target data pointer, if possible. */ -/* If the current page is full, these functions will be performed */ -/* below in the code section in which a new page is allocated. */ - - if (lastw < 1014) { - p = segdsc[15]; - zzekpgbs_(&c__1, &p, &pbase); - datptr = pbase + lastw + 1; - } - eltidx = 1; - while(eltidx <= *nvals && ! failed_()) { - -/* Write out the element having index ELTIDX. */ - - pos = 0; - remain = strlen; - while(remain > 0) { - -/* Decide where to write the data values. In order to write */ -/* a new entry, we require enough room for the count */ -/* and at least one character of data. */ - - if (fstpag) { - mnroom = 6; - } else { - mnroom = 1; - } - if (room >= mnroom) { - -/* There's room in the current page. If this is the */ -/* first page this entry is written on, set the data */ -/* pointer and count. Write as much of the value as */ -/* possible to the current page. */ - - if (fstpag) { - dasudi_(handle, &ptrloc, &ptrloc, &datptr); - zzeksei_(handle, &datptr, nvals); - room += -5; - datptr += 5; - -/* The first page containing some or all of the data */ -/* item gains a link. */ - - zzekglnk_(handle, &c__1, &p, &nlinks); - i__1 = nlinks + 1; - zzekslnk_(handle, &c__1, &p, &i__1); - } - -/* Write the characters we can fit onto the current page. */ - - nwrite = min(remain,room); - n = nwrite; - while(n > 0) { - if (pos < cvlen) { - -/* Take data from the input string CVALS(ELTIDX). */ - -/* Computing MIN */ - i__1 = n, i__2 = cvlen - pos; - nchrs = min(i__1,i__2); - i__1 = datptr + nchrs - 1; - i__2 = pos + 1; - i__3 = pos + nchrs; - dasudc_(handle, &datptr, &i__1, &i__2, &i__3, - cvals + (eltidx - 1) * cvals_len, - cvals_len); - n -= nchrs; - pos += nchrs; - datptr += nchrs; - } else if (pad) { - -/* We must add trailing blanks to the column */ -/* entry at this point. */ - - npad = min(n,padlen); - np = npad; - while(np > 0) { - wp = min(np,100); - i__1 = datptr + wp - 1; - dasudc_(handle, &datptr, &i__1, &c__1, &wp, - padbuf, (ftnlen)100); - np -= wp; - datptr += wp; - } - n -= npad; - pos += npad; - } - } - -/* We've written all we can to the current page. */ - - remain -= nwrite; - room -= nwrite; - -/* The last character word in use must be updated. */ -/* Account for the count, if this is the first page on */ -/* which the current entry is written. */ - - if (fstpag) { - lastw = lastw + 5 + nwrite; - segdsc[18] = lastw; - fstpag = FALSE_; - } else { - lastw += nwrite; - segdsc[18] = lastw; - } - } else { - -/* Allocate a character data page. If this is not the */ -/* first data page written to, link the previous page to */ -/* the current one. */ - - zzekaps_(handle, segdsc, &c__1, &c_false, &p2, &pbase); - if (! fstpag) { - zzeksfwd_(handle, &c__1, &p, &p2); - } - p = p2; - lastw = 0; - segdsc[15] = p; - segdsc[18] = lastw; - room = 1014; - datptr = pbase + 1; - -/* Set the link count. If this is the first page */ -/* onto which the input column entry is written, */ -/* just zero out the count; the count will be set above. */ -/* Additional pages get one link. */ - - if (fstpag) { - nlinks = 0; - } else { - nlinks = 1; - } - zzekslnk_(handle, &c__1, &p, &nlinks); - } - } - -/* We've written out the current element. */ - - ++eltidx; - } - } - -/* Write out the updated segment descriptor. */ - - mbase = segdsc[2]; - i__1 = mbase + 1; - i__2 = mbase + 24; - dasudi_(handle, &i__1, &i__2, segdsc); - -/* Class 6 columns are not indexed, so we need not update any */ -/* index to account for the new element. */ - - return 0; -} /* zzekad06_ */ - diff --git a/ext/spice/src/cspice/zzekaps.c b/ext/spice/src/cspice/zzekaps.c deleted file mode 100644 index c7d84f8694..0000000000 --- a/ext/spice/src/cspice/zzekaps.c +++ /dev/null @@ -1,374 +0,0 @@ -/* zzekaps.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZEKAPS ( EK, allocate page for segment ) */ -/* Subroutine */ int zzekaps_(integer *handle, integer *segdsc, integer * - type__, logical *new__, integer *p, integer *base) -{ - integer tree; - extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, - integer *), zzekpgan_(integer *, integer *, integer *, integer *), - zzeksfwd_(integer *, integer *, integer *, integer *), zzektrap_( - integer *, integer *, integer *, integer *), zzekslnk_(integer *, - integer *, integer *, integer *); - extern logical failed_(void); - integer idx; - -/* $ Abstract */ - -/* Allocate a data page for a specified EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* TYPE I Data type of page. */ -/* NEW I Flag indicating whether page is new. */ -/* P O Page number. */ -/* BASE O DAS base address of page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment for which to */ -/* allocate a data page. */ - -/* TYPE is the data type of the desired page. */ - -/* NEW is a logical flag indicating whether a new page */ -/* is desired. A new page is one that has not been */ -/* allocated before. If NEW is .FALSE., a page */ -/* on the free list may be returned. */ - -/* $ Detailed_Output */ - -/* P is the page number of the allocated page. This */ -/* number is recognized by the EK paged access */ -/* routines. */ - -/* BASE is the DAS base address of the allocated page. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it allocates an EK data */ -/* page for a specified segment. The segment's metadata is updated */ -/* to reflect aquisition of the page. */ - -/* The allocated page is initialized as follows: */ - -/* - The page's link count is zeroed out. */ - -/* - The page's forward pointer is zeroed out. */ - -/* - The metadata for the segment is adjusted to reflect ownership */ -/* of the allocated page. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKIFLD. */ - -/* $ Restrictions */ - -/* 1) This routine cannot be used to allocate series of contiguous */ -/* pages! Use ZZEKACPS if contiguous pages are required. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (*new__) { - -/* We must allocate a new page. */ - - zzekpgan_(handle, type__, p, base); - } else { - -/* We can allocate a page from the free list if one is available. */ -/* Otherwise take a new page. */ - - zzekpgal_(handle, type__, p, base); - } - if (failed_()) { - return 0; - } - -/* Zero out the page's link count and forward pointer. */ - - zzekslnk_(handle, type__, p, &c__0); - zzeksfwd_(handle, type__, p, &c__0); - -/* Update the segment's metadata. For type 1 segments, */ -/* the new page into the page tree of the appropriate data type. */ - - if (*type__ == 1) { - tree = segdsc[7]; - } else if (*type__ == 2) { - tree = segdsc[8]; - } else if (*type__ == 3) { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, one of the allocation routines would have */ -/* complained. */ - - tree = segdsc[9]; - } - zzektrap_(handle, &tree, p, &idx); - return 0; -} /* zzekaps_ */ - diff --git a/ext/spice/src/cspice/zzekbs01.c b/ext/spice/src/cspice/zzekbs01.c deleted file mode 100644 index a905cf99c9..0000000000 --- a/ext/spice/src/cspice/zzekbs01.c +++ /dev/null @@ -1,1285 +0,0 @@ -/* zzekbs01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__256 = 256; -static integer c__11 = 11; - -/* $Procedure ZZEKBS01 ( EK, begin segment, type 1 ) */ -/* Subroutine */ int zzekbs01_(integer *handle, char *tabnam, integer *ncols, - char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, - ftnlen cnames_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekcix1_(integer *, integer *); - integer room; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekpgan_(integer *, integer *, integer *, integer *), zzekpgbs_( - integer *, integer *, integer *), zzekpgwc_(integer *, integer *, - char *, ftnlen), zzekpgwi_(integer *, integer *, integer *), - zzektrap_(integer *, integer *, integer *, integer *), zzektrit_( - integer *, integer *); - integer i__, cbase; - char cpage[1024]; - integer p, ipage[256]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), movei_(integer *, integer *, integer *); - integer p1; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer p1base, cp; - extern logical failed_(void); - extern integer eknseg_(integer *); - extern logical return_(void); - char tmpcnm[32], tmptnm[64]; - integer cp1, cpagno, dscbas, ipagno, metasz, nambas, ncpage, nipage, rec, - sgtree; - extern /* Subroutine */ int chkout_(char *, ftnlen), cleari_(integer *, - integer *), dasrdi_(integer *, integer *, integer *, integer *); - integer cpt, dpt, ipt; - -/* $ Abstract */ - -/* Start a new type 1 segment in an E-kernel. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TABNAM I Table name. */ -/* NCOLS I Number of columns in the segment. */ -/* CNAMES I Names of columns. */ -/* CDSCRS I Descriptors of columns. */ -/* SEGNO O Segment number. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ - -/* TABNAM is the name of the EK table to which the current */ -/* segment belongs. All segments in the EK file */ -/* designated by HANDLE must have identical column */ -/* attributes. TABNAM must not exceed 32 characters */ -/* in length. Case is not significant. Table names */ -/* must start with a letter and contain only */ -/* characters from the set {A-Z,a-z,0-9,$,_}. */ - -/* NCOLS is the number of columns in a new segment. */ - -/* CNAMES, */ -/* CDSCRS are, respectively, and array of column names and */ -/* their corresponding descriptors: the Ith element */ -/* of CNAMES and the Ith descriptor apply to */ -/* the Ith column in the segment. */ - - -/* $ Detailed_Output */ - -/* SEGNO is the number of the segment created by this */ -/* routine. Segment numbers are used as unique */ -/* identifiers by other EK access routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it prepares an EK for */ -/* the addition of a new type 1 segment. Type 1 segments are */ -/* `ordinary' in the sense that they support record insertion, */ -/* column entry update, and record deletion operations. */ - -/* Type 1 segments may contains columns of class 1 through 6. */ - -/* By way of contrast, type 2 segments have fixed record counts. */ - -/* $ Examples */ - -/* See EKBSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKBS01", (ftnlen)8); - } - -/* Before trying to actually write anything, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKBS01", (ftnlen)8); - return 0; - } - -/* The metadata layout has the following form: */ - -/* +------------------------------------------+ */ -/* | | */ -/* | segment descriptor | */ -/* | | */ -/* +------------------------------------------+ */ -/* | column descriptor 1 | */ -/* +------------------------------------------+ */ -/* | column descriptor 2 | */ -/* +------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +------------------------------------------+ */ -/* | column descriptor m | */ -/* +------------------------------------------+ */ - -/* The column descriptors may span multiple pages, but they */ -/* always occupy contiguous DAS integer addresses. */ - -/* In addition, the metadata area includes a character page */ -/* that contains the segment's table name and the table's */ -/* column names. */ - -/* Calculate the number of contiguous integer pages we'll need. */ -/* This value is a function of the number of columns. */ - - metasz = *ncols * 11 + 24; - nipage = (metasz + 255) / 256; - -/* Allocate NIPAGE new integer pages. Insisting on new pages */ -/* enforces contiguity. Also allocate one character page, which */ -/* need not be new. */ - - zzekpgan_(handle, &c__3, &p1, &p1base); - i__1 = nipage; - for (i__ = 2; i__ <= i__1; ++i__) { - zzekpgan_(handle, &c__3, &p, &base); - } - -/* Calculate the number of contiguous character pages we'll need. */ - - ncpage = ((*ncols << 5) + 1087) / 1024; - zzekpgan_(handle, &c__1, &cp1, &cbase); - i__1 = ncpage; - for (i__ = 2; i__ <= i__1; ++i__) { - zzekpgan_(handle, &c__1, &p, &base); - } - -/* Initialize the record tree. */ - - zzektrit_(handle, &rec); - -/* On the third day of Christmas, we initialized three data page */ -/* trees: one for each data type. */ - - zzektrit_(handle, &cpt); - zzektrit_(handle, &dpt); - zzektrit_(handle, &ipt); - -/* Prepare the contents of the first integer page: initialize */ -/* everything other than the column descriptors. */ - -/* The last data word in use for each data type is initialized */ -/* to indicate that no room is left in the current page. This */ -/* forces allocation of a new page when data must be added. The */ -/* `last word' counts of each type for both the data and modified */ -/* record trees are initialized in this fashion. */ - - cleari_(&c__256, ipage); - -/* The value at index EKTIDX is the segment type. */ - - ipage[0] = 1; - ipage[1] = eknseg_(handle) + 1; - ipage[2] = p1base; - ipage[3] = cbase; - ipage[4] = *ncols; - ipage[5] = 0; - ipage[6] = rec; - ipage[7] = cpt; - ipage[8] = dpt; - ipage[9] = ipt; - ipage[10] = 1; - ipage[11] = -1; - ipage[12] = -1; - ipage[13] = 0; - ipage[14] = 0; - ipage[15] = 0; - ipage[16] = 0; - ipage[17] = 0; - ipage[18] = 1014; - ipage[19] = 126; - ipage[20] = 254; - ipage[21] = cbase + 64; - -/* Initialize the character metadata page: fill in the table name. */ -/* The table name gets converted to upper case and is left justified. */ - - s_copy(cpage, " ", (ftnlen)1024, (ftnlen)1); - ljust_(tabnam, tmptnm, tabnam_len, (ftnlen)64); - ucase_(tmptnm, tmptnm, (ftnlen)64, (ftnlen)64); - s_copy(cpage, tmptnm, (ftnlen)64, (ftnlen)64); - -/* Now for the column-specific tasks. We write out a descriptor for */ -/* each column. At the same time, we write out the column's name. */ - - ipagno = 1; - cpagno = 1; - p = p1; - cp = cp1; - i__1 = *ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Insert the column's ordinal position in the segment into */ -/* the column's descriptor. */ - - cdscrs[i__ * 11 - 3] = i__; - -/* Write the Ith column name into the character metdata page. (We */ -/* know the name is non-blank.) Blank-pad the name on the right, */ -/* up to a length of CNAMSZ characters, if necessary. Convert the */ -/* name to upper case as well. */ - - ucase_(cnames + (i__ - 1) * cnames_len, tmpcnm, cnames_len, (ftnlen) - 32); - nambas = (i__ - 1 << 5) + 64 - (cpagno - 1 << 10); - room = 1024 - nambas; - if (32 <= room) { - i__2 = nambas; - s_copy(cpage + i__2, tmpcnm, nambas + 32 - i__2, (ftnlen)32); - -/* Fill the column name's base address into the descriptor. */ - - cdscrs[i__ * 11 - 7] = cbase + (cpagno - 1 << 10) + nambas; - } else { - -/* Some or all of the column name will overflow onto the next */ -/* page. */ - - if (room > 0) { - i__2 = nambas; - s_copy(cpage + i__2, tmpcnm, nambas + room - i__2, room); - cdscrs[i__ * 11 - 7] = cbase + (cpagno - 1 << 10) + nambas; - } else { - cdscrs[i__ * 11 - 7] = cbase + (cpagno << 10); - } - -/* Write out the page we just filled up. */ - - zzekpgwc_(handle, &cp, cpage, (ftnlen)1024); - -/* The next character page will hold the overflow. The next */ -/* page is the successor of page CP, since we allocated */ -/* consecutive character pages. */ - - ++cp; - ++cpagno; - i__2 = room; - s_copy(cpage, tmpcnm + i__2, (ftnlen)1024, 32 - i__2); - } - -/* If the column is indexed, create a new index for this column. */ -/* Currently, data type 1 indexes are in vogue. Set the */ -/* descriptor to indicate the data type and to point to the index. */ - - if (cdscrs[i__ * 11 - 6] != -1) { - -/* ZZEKCIX1 will update the descriptor to indicate the type and */ -/* location of the new index. */ - - zzekcix1_(handle, &cdscrs[i__ * 11 - 11]); - } - -/* Add the column descriptor to the metadata page, if the */ -/* descriptor will fit. We may need to allocate another page */ -/* to hold the descriptor. */ - - dscbas = (i__ - 1) * 11 + 24 - (ipagno - 1 << 8); - room = 256 - dscbas; - if (11 <= room) { - -/* The whole descriptor fits in the current page. */ - - movei_(&cdscrs[i__ * 11 - 11], &c__11, &ipage[(i__2 = dscbas) < - 256 && 0 <= i__2 ? i__2 : s_rnge("ipage", i__2, "zzekbs0" - "1_", (ftnlen)442)]); - } else { - -/* Some or all of the descriptor will overflow onto the next */ -/* page. */ - - if (room > 0) { - movei_(&cdscrs[i__ * 11 - 11], &room, &ipage[(i__2 = dscbas) < - 256 && 0 <= i__2 ? i__2 : s_rnge("ipage", i__2, - "zzekbs01_", (ftnlen)451)]); - } - -/* Write out the page we just filled up. */ - - zzekpgwi_(handle, &p, ipage); - -/* The next integer page will hold the overflow. The next page */ -/* is the successor of page P, since we allocated consecutive */ -/* pages. */ - - ++p; - ++ipagno; - cleari_(&c__256, ipage); - i__2 = 11 - room; - movei_(&cdscrs[room + 1 + i__ * 11 - 12], &i__2, ipage); - } - -/* If we encountered a DAS error, leave now. */ - - if (failed_()) { - chkout_("ZZEKBS01", (ftnlen)8); - return 0; - } - } - -/* Write out the last integer metadata page, and write out the */ -/* character metadata page. */ - - zzekpgwi_(handle, &p, ipage); - zzekpgwc_(handle, &cp, cpage, (ftnlen)1024); - -/* At this point, the segment's metadata is filled in. We must */ -/* update the file's segment list information to account for this */ -/* segment. All we need do is add a new entry to the file's */ -/* segment pointer tree. First, look up the tree. */ - - zzekpgbs_(&c__3, &c__1, &base); - i__1 = base + 1; - i__2 = base + 1; - dasrdi_(handle, &i__1, &i__2, &sgtree); - -/* Append the head node of this segment at the end of the segment */ -/* tree. The tree will point to the first integer metadata page of */ -/* the new segment. */ - - zzektrap_(handle, &sgtree, &p1, segno); - chkout_("ZZEKBS01", (ftnlen)8); - return 0; -} /* zzekbs01_ */ - diff --git a/ext/spice/src/cspice/zzekbs02.c b/ext/spice/src/cspice/zzekbs02.c deleted file mode 100644 index 571157495e..0000000000 --- a/ext/spice/src/cspice/zzekbs02.c +++ /dev/null @@ -1,1273 +0,0 @@ -/* zzekbs02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__256 = 256; -static integer c__11 = 11; - -/* $Procedure ZZEKBS02 ( EK, begin segment, type 1 ) */ -/* Subroutine */ int zzekbs02_(integer *handle, char *tabnam, integer *ncols, - char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, - ftnlen cnames_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base, room; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekpgan_(integer *, integer *, integer *, integer *), zzekpgbs_( - integer *, integer *, integer *), zzekpgwc_(integer *, integer *, - char *, ftnlen), zzekpgwi_(integer *, integer *, integer *), - zzektrap_(integer *, integer *, integer *, integer *), zzektrit_( - integer *, integer *); - integer i__, cbase; - char cpage[1024]; - integer p, ipage[256]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), movei_(integer *, integer *, integer *); - integer p1; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer p1base, cp; - extern logical failed_(void); - extern integer eknseg_(integer *); - extern logical return_(void); - char tmpcnm[32], tmptnm[64]; - integer cp1, cpagno, dscbas, ipagno, metasz, nambas, ncpage, nipage, - sgtree; - extern /* Subroutine */ int chkout_(char *, ftnlen), cleari_(integer *, - integer *), dasrdi_(integer *, integer *, integer *, integer *); - integer cpt, dpt, ipt; - -/* $ Abstract */ - -/* Start a new type 2 segment in an E-kernel. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TABNAM I Table name. */ -/* NCOLS I Number of columns in the segment. */ -/* CNAMES I Names of columns. */ -/* CDSCRS I-O Descriptors of columns. */ -/* SEGNO O Segment number. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ - -/* TABNAM is the name of the EK table to which the current */ -/* segment belongs. All segments in the EK file */ -/* designated by HANDLE must have identical column */ -/* attributes. TABNAM must not exceed 32 characters */ -/* in length. Case is not significant. Table names */ -/* must start with a letter and contain only */ -/* characters from the set {A-Z,a-z,0-9,$,_}. */ - -/* NCOLS is the number of columns in a new segment. */ - -/* CNAMES, */ -/* CDSCRS are, respectively, and array of column names and */ -/* their corresponding descriptors: the Ith element */ -/* of CNAMES and the Ith descriptor apply to */ -/* the Ith column in the segment. */ - - -/* $ Detailed_Output */ - -/* CDSCRS are the input column descriptors, with their name */ -/* base and ordinal position elements filled in. */ - -/* SEGNO is the number of the segment created by this */ -/* routine. Segment numbers are used as unique */ -/* identifiers by other EK access routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it prepares an EK for */ -/* the addition of a new type 2 segment. Type 2 segments have */ -/* fixed record counts: they do not support record insertion, */ -/* or deletion operations. They do not support arbitrary column */ -/* entry update operations either, since some updates change the */ -/* size of the affected entries. */ - -/* Type 2 segments may contains columns of class 7 through 9. */ - -/* By way of contrast, type 1 segments support variable record */ -/* counts. */ - -/* $ Examples */ - -/* See EKBSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKBS02", (ftnlen)8); - } - -/* Before trying to actually write anything, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKBS02", (ftnlen)8); - return 0; - } - -/* The metadata layout has the following form: */ - -/* +------------------------------------------+ */ -/* | | */ -/* | segment descriptor | */ -/* | | */ -/* +------------------------------------------+ */ -/* | column descriptor 1 | */ -/* +------------------------------------------+ */ -/* | column descriptor 2 | */ -/* +------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +------------------------------------------+ */ -/* | column descriptor m | */ -/* +------------------------------------------+ */ - -/* The column descriptors may span multiple pages, but they */ -/* always occupy contiguous DAS integer addresses. */ - -/* In addition, the metadata area includes a character page */ -/* that contains the segment's table name and the table's */ -/* column names. */ - -/* Calculate the number of contiguous integer pages we'll need. */ -/* This value is a function of the number of columns. */ - - metasz = *ncols * 11 + 24; - nipage = (metasz + 255) / 256; - -/* Allocate NIPAGE new integer pages. Insisting on new pages */ -/* enforces contiguity. Also allocate one character page, which */ -/* need not be new. */ - - zzekpgan_(handle, &c__3, &p1, &p1base); - i__1 = nipage; - for (i__ = 2; i__ <= i__1; ++i__) { - zzekpgan_(handle, &c__3, &p, &base); - } - -/* Calculate the number of contiguous character pages we'll need. */ - - ncpage = ((*ncols << 5) + 1087) / 1024; - zzekpgan_(handle, &c__1, &cp1, &cbase); - i__1 = ncpage; - for (i__ = 2; i__ <= i__1; ++i__) { - zzekpgan_(handle, &c__1, &p, &base); - } - -/* On the third day of Christmas, we initialized three data page */ -/* trees: one for each data type. */ - - zzektrit_(handle, &cpt); - zzektrit_(handle, &dpt); - zzektrit_(handle, &ipt); - -/* Prepare the contents of the first integer page: initialize */ -/* everything other than the column descriptors. */ - -/* The last data word in use for each data type is initialized */ -/* to indicate that no room is left in the current page. This */ -/* forces allocation of a new page when data must be added. The */ -/* `last word' counts of each type for both the data and modified */ -/* record trees are initialized in this fashion. */ - - cleari_(&c__256, ipage); - -/* The value at index EKTIDX is the segment type. */ - - ipage[0] = 2; - ipage[1] = eknseg_(handle) + 1; - ipage[2] = p1base; - ipage[3] = cbase; - ipage[4] = *ncols; - ipage[5] = 0; - ipage[6] = 0; - ipage[7] = cpt; - ipage[8] = dpt; - ipage[9] = ipt; - ipage[10] = 1; - ipage[11] = -1; - ipage[12] = -1; - ipage[13] = 0; - ipage[14] = 0; - ipage[15] = 0; - ipage[16] = 0; - ipage[17] = 0; - ipage[18] = 1014; - ipage[19] = 126; - ipage[20] = 254; - ipage[21] = cbase + 64; - -/* Initialize the character metadata page: fill in the table name. */ -/* The table name gets converted to upper case and is left justified. */ - - s_copy(cpage, " ", (ftnlen)1024, (ftnlen)1); - ljust_(tabnam, tmptnm, tabnam_len, (ftnlen)64); - ucase_(tmptnm, tmptnm, (ftnlen)64, (ftnlen)64); - s_copy(cpage, tmptnm, (ftnlen)64, (ftnlen)64); - -/* Now for the column-specific tasks. We write out a descriptor for */ -/* each column. At the same time, we write out the column's name. */ - - ipagno = 1; - cpagno = 1; - p = p1; - cp = cp1; - i__1 = *ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Insert the column's ordinal position in the segment into */ -/* the column's descriptor. */ - - cdscrs[i__ * 11 - 3] = i__; - -/* Write the Ith column name into the character metdata page. (We */ -/* know the name is non-blank.) Blank-pad the name on the right, */ -/* up to a length of CNAMSZ characters, if necessary. Convert the */ -/* name to upper case as well. */ - - ucase_(cnames + (i__ - 1) * cnames_len, tmpcnm, cnames_len, (ftnlen) - 32); - nambas = (i__ - 1 << 5) + 64 - (cpagno - 1 << 10); - room = 1024 - nambas; - if (32 <= room) { - i__2 = nambas; - s_copy(cpage + i__2, tmpcnm, nambas + 32 - i__2, (ftnlen)32); - -/* Fill the column name's base address into the descriptor. */ - - cdscrs[i__ * 11 - 7] = cbase + (cpagno - 1 << 10) + nambas; - } else { - -/* Some or all of the column name will overflow onto the next */ -/* page. */ - - if (room > 0) { - i__2 = nambas; - s_copy(cpage + i__2, tmpcnm, nambas + room - i__2, room); - cdscrs[i__ * 11 - 7] = cbase + (cpagno - 1 << 10) + nambas; - } else { - cdscrs[i__ * 11 - 7] = cbase + (cpagno << 10); - } - -/* Write out the page we just filled up. */ - - zzekpgwc_(handle, &cp, cpage, (ftnlen)1024); - -/* The next character page will hold the overflow. The next */ -/* page is the successor of page CP, since we allocated */ -/* consecutive character pages. */ - - ++cp; - ++cpagno; - i__2 = room; - s_copy(cpage, tmpcnm + i__2, (ftnlen)1024, 32 - i__2); - } - -/* Add the column descriptor to the metadata page, if the */ -/* descriptor will fit. We may need to allocate another page */ -/* to hold the descriptor. */ - - dscbas = (i__ - 1) * 11 + 24 - (ipagno - 1 << 8); - room = 256 - dscbas; - if (11 <= room) { - -/* The whole descriptor fits in the current page. */ - - movei_(&cdscrs[i__ * 11 - 11], &c__11, &ipage[(i__2 = dscbas) < - 256 && 0 <= i__2 ? i__2 : s_rnge("ipage", i__2, "zzekbs0" - "2_", (ftnlen)426)]); - } else { - -/* Some or all of the descriptor will overflow onto the next */ -/* page. */ - - if (room > 0) { - movei_(&cdscrs[i__ * 11 - 11], &room, &ipage[(i__2 = dscbas) < - 256 && 0 <= i__2 ? i__2 : s_rnge("ipage", i__2, - "zzekbs02_", (ftnlen)435)]); - } - -/* Write out the page we just filled up. */ - - zzekpgwi_(handle, &p, ipage); - -/* The next integer page will hold the overflow. The next page */ -/* is the successor of page P, since we allocated consecutive */ -/* pages. */ - - ++p; - ++ipagno; - cleari_(&c__256, ipage); - i__2 = 11 - room; - movei_(&cdscrs[room + 1 + i__ * 11 - 12], &i__2, ipage); - } - -/* If we encountered a DAS error, leave now. */ - - if (failed_()) { - chkout_("ZZEKBS02", (ftnlen)8); - return 0; - } - } - -/* Write out the last integer metadata page, and write out the */ -/* character metadata page. */ - - zzekpgwi_(handle, &p, ipage); - zzekpgwc_(handle, &cp, cpage, (ftnlen)1024); - -/* At this point, the segment's metadata is filled in. We must */ -/* update the file's segment list information to account for this */ -/* segment. All we need do is add a new entry to the file's */ -/* segment pointer tree. First, look up the tree. */ - - zzekpgbs_(&c__3, &c__1, &base); - i__1 = base + 1; - i__2 = base + 1; - dasrdi_(handle, &i__1, &i__2, &sgtree); - -/* Append the head node of this segment at the end of the segment */ -/* tree. The tree will point to the first integer metadata page of */ -/* the new segment. */ - - zzektrap_(handle, &sgtree, &p1, segno); - chkout_("ZZEKBS02", (ftnlen)8); - return 0; -} /* zzekbs02_ */ - diff --git a/ext/spice/src/cspice/zzekcchk.c b/ext/spice/src/cspice/zzekcchk.c deleted file mode 100644 index 8a32aa1191..0000000000 --- a/ext/spice/src/cspice/zzekcchk.c +++ /dev/null @@ -1,994 +0,0 @@ -/* zzekcchk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKCCHK ( Private: EK, check names in encoded query ) */ -/* Subroutine */ int zzekcchk_(char *query, integer *eqryi, char *eqryc, - integer *ntab, char *tablst, char *alslst, integer *base, logical * - error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen - eqryc_len, ftnlen tablst_len, ftnlen alslst_len, ftnlen errmsg_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen); - integer i__, j; - extern /* Subroutine */ int ekcii_(char *, integer *, char *, integer *, - ftnlen, ftnlen), chkin_(char *, ftnlen), repmc_(char *, char *, - char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - integer cb, cc, ce; - extern logical failed_(void); - integer tb, te; - extern /* Subroutine */ int ekccnt_(char *, integer *, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - char column[32], ctouch[1]; - integer attdsc[6], colidx, iparse, nmatch, tabidx; - logical noname; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen); - logical fnd; - extern /* Subroutine */ int chkout_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer lxb[2]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Check and resolve a specified column name in an encoded EK query. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Attribute Descriptor Parameters */ - -/* ekattdsc.inc Version 1 23-AUG-1995 (NJB) */ - - -/* This include file declares parameters used in EK column */ -/* attribute descriptors. Column attribute descriptors are */ -/* a simplified version of column descriptors: attribute */ -/* descriptors describe attributes of a column but do not contain */ -/* addresses or pointers. */ - - -/* Size of column attribute descriptor */ - - -/* Indices of various pieces of attribute descriptors: */ - - -/* ATTSIZ is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* ATTTYP is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* ATTLEN is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* ATTSIZ is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* ATTIDX is the location of a flag that indicates whether the column */ -/* is indexed. The flag takes the value ITRUE if the column is */ -/* indexed and otherwise takes the value IFALSE. */ - - -/* ATTNFL is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* End Include Section: EK Column Attribute Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I-O Integer component of query. */ -/* EQRYC I-O Character component of query. */ -/* NTAB I Number of tables in FROM clause. */ -/* TABLST I List of table names. */ -/* ALSLST I List of table aliases. */ -/* BASE I Base address of table/column descriptor pair. */ -/* ERROR O Error flag. */ -/* ERRMSG O Error message. */ -/* ERRPTR O Position in query where error was detected. */ - -/* $ Detailed_Input */ - -/* QUERY is the original query from which EQRYI and EQRYC */ -/* were obtained. QUERY is used only for */ -/* construction of error messages. */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* NTAB is the number of tables in the FROM clause of */ -/* the input query. */ - -/* TABLST is a list of table names present in the FROM */ -/* clause of the input query. */ - -/* ALSLST is a list of table aliases present in the FROM */ -/* clause of the input query. Absent aliases are */ -/* represented by blank strings. */ - -/* BASE is the base address of a pair of descriptors */ -/* for a qualified column. The column may appear on */ -/* either side of a query constraint, or it may */ -/* appear in an order-by clause. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* On output, the specified column will have been */ -/* resolved and checked. Specifically, the table */ -/* descriptor will have the ordinal position of the */ -/* table in the FROM clause filled in, and the */ -/* index of the column within the virtual table */ -/* containing it will be filled in. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* ERROR is a logical flag indicating whether an error was */ -/* detected. The error could be a name resolution */ -/* error or a semantic error. */ - -/* ERRMSG is an error message describing an error in the */ -/* input query, if one was detected. If ERROR is */ -/* returned .FALSE., then ERRPTR is undefined. */ - -/* ERRPTR is the character position in the original query */ -/* at which an error was detected, if an error was */ -/* found. This index refers to the offending lexeme's */ -/* position in the original query represented by the */ -/* input encoded query. If ERROR is returned .FALSE., */ -/* ERRPTR is undefined. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been parsed, the error */ -/* SPICE(QUERYNOTPARSED) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If any sort of name resolution error or semantic error is */ -/* detected in the input query, the output flag ERROR is set, */ -/* and an error message is returned. The checks performed by */ -/* this routine are listed below: */ - -/* - No column name may be qualified with a name that is not */ -/* the name or alias of a table in the FROM clause. */ - -/* - Each qualified column must be present in the table */ -/* indicated by its qualifying name. */ - -/* - Each unqualified column name must be the name of a */ -/* column present in exactly one of the tables listed in the */ -/* FROM clause. */ -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine exists for the sole purpose of centralizing code */ -/* used in multiple places by the name resolver ZZEKNRES. */ - -/* This routine assumes that encoded EK query architecture version */ -/* 1 is to be used with the query to be initialized; this routine */ -/* will not work with any other architecture version. */ - -/* $ Examples */ - -/* See ZZEKNRES. */ - -/* $ Restrictions */ - -/* 1) This routine relies on the internals of the EK encoded query */ -/* structure. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-OCT-1996 (NJB) */ - -/* Error checking of column string bounds was added. */ - -/* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 15-OCT-1996 (NJB) */ - -/* Error checking of column string bounds was added. These */ -/* bounds should never be out of range, but if they are, the */ -/* error diagnosis should be more graceful than a memory */ -/* violation. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* No error to start with. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *errptr = 0; - *(unsigned char *)ctouch = *(unsigned char *)query; - -/* The query must have been parsed at this point, or it's no go. */ - - zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6); - if (failed_()) { - return 0; - } - if (iparse == -1) { - chkin_("ZZEKCCHK", (ftnlen)8); - setmsg_("Encoded query has not been parsed.", (ftnlen)34); - sigerr_("SPICE(QUERYNOTPARSED)", (ftnlen)21); - chkout_("ZZEKCCHK", (ftnlen)8); - return 0; - } - -/* Get the name and lexeme pointers for both the table and column. */ -/* Decide whether a table name was supplied. */ - - tb = eqryi[*base + 9]; - te = eqryi[*base + 10]; - lxb[0] = eqryi[*base + 7]; - cb = eqryi[*base + 15]; - ce = eqryi[*base + 16]; - lxb[1] = eqryi[*base + 13]; - if (cb <= 0 || ce <= 0) { - chkin_("ZZEKCCHK", (ftnlen)8); - setmsg_("Invalid string bounds #:# for column. Column name descript" - "or base is #.", (ftnlen)72); - errint_("#", &cb, (ftnlen)1); - errint_("#", &ce, (ftnlen)1); - errint_("#", base, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKCCHK", (ftnlen)8); - return 0; - } - noname = tb == 0; - if (noname) { - -/* If no table name is present, search for the LHS column among */ -/* the tables in the FROM clause. If exactly one table */ -/* contains the column, that table is considered to be the */ -/* qualifying table. Otherwise, the qualification is in error. */ - - nmatch = 0; - i__1 = *ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - ekccnt_(tablst + (i__ - 1) * tablst_len, &cc, tablst_len); - i__2 = cc; - for (j = 1; j <= i__2; ++j) { - ekcii_(tablst + (i__ - 1) * tablst_len, &j, column, attdsc, - tablst_len, (ftnlen)32); - if (s_cmp(eqryc + (cb - 1), column, ce - (cb - 1), (ftnlen)32) - == 0) { - ++nmatch; - colidx = j; - tabidx = i__; - } - } - } - if (nmatch == 0) { - *error = TRUE_; - s_copy(errmsg, "Column <#> is not present in any table in FROM c" - "lause.", errmsg_len, (ftnlen)54); - repmc_(errmsg, "#", eqryc + (cb - 1), errmsg, errmsg_len, (ftnlen) - 1, ce - (cb - 1), errmsg_len); - *errptr = lxb[1]; - return 0; - } else if (nmatch > 1) { - *error = TRUE_; - s_copy(errmsg, "Column name <#> is ambiguous; a qualifying table" - " name or alias is required.", errmsg_len, (ftnlen)75); - repmc_(errmsg, "#", eqryc + (cb - 1), errmsg, errmsg_len, (ftnlen) - 1, ce - (cb - 1), errmsg_len); - *errptr = lxb[1]; - return 0; - } - } else { - -/* Find the qualifying name in the FROM table list. If the */ -/* name is not there, look in the alias list. */ - - tabidx = isrchc_(eqryc + (tb - 1), ntab, tablst, te - (tb - 1), - tablst_len); - if (tabidx == 0) { - tabidx = isrchc_(eqryc + (tb - 1), ntab, alslst, te - (tb - 1), - alslst_len); - } - -/* If the table name wasn't in either list, we can't use it. */ - - if (tabidx == 0) { - *error = TRUE_; - s_copy(errmsg, "Table name <#> is not present in FROM clause.", - errmsg_len, (ftnlen)45); - repmc_(errmsg, "#", eqryc + (tb - 1), errmsg, errmsg_len, (ftnlen) - 1, te - (tb - 1), errmsg_len); - *errptr = lxb[0]; - return 0; - } - -/* Check the column. This column must be present in the */ -/* table that qualifies it. */ - - ekccnt_(tablst + (tabidx - 1) * tablst_len, &cc, tablst_len); - fnd = FALSE_; - i__ = 1; - while(i__ <= cc && ! fnd) { - ekcii_(tablst + (tabidx - 1) * tablst_len, &i__, column, attdsc, - tablst_len, (ftnlen)32); - if (s_cmp(eqryc + (cb - 1), column, ce - (cb - 1), (ftnlen)32) == - 0) { - fnd = TRUE_; - colidx = i__; - } else { - ++i__; - } - } - if (! fnd) { - *error = TRUE_; - s_copy(errmsg, "Column <#> does not exist in table <#>.", - errmsg_len, (ftnlen)39); - repmc_(errmsg, "#", eqryc + (cb - 1), errmsg, errmsg_len, (ftnlen) - 1, ce - (cb - 1), errmsg_len); - repmc_(errmsg, "#", eqryc + (tb - 1), errmsg, errmsg_len, (ftnlen) - 1, te - (tb - 1), errmsg_len); - *errptr = lxb[1]; - return 0; - } - } - -/* If we got this far, the table and column check out. Fill in the */ -/* table and column indices in their respective descriptors. */ - - eqryi[*base + 11] = tabidx; - eqryi[*base + 17] = colidx; - return 0; -} /* zzekcchk_ */ - diff --git a/ext/spice/src/cspice/zzekcdsc.c b/ext/spice/src/cspice/zzekcdsc.c deleted file mode 100644 index 5713372dc2..0000000000 --- a/ext/spice/src/cspice/zzekcdsc.c +++ /dev/null @@ -1,457 +0,0 @@ -/* zzekcdsc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__32 = 32; - -/* $Procedure ZZEKCDSC ( Private: EK, return column descriptor ) */ -/* Subroutine */ int zzekcdsc_(integer *handle, integer *segdsc, char *column, - integer *coldsc, ftnlen column_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer unit, i__; - char cname[32]; - integer mbase; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - integer ncols; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - integer dscbas; - extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen); - integer nambas; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dashlu_(integer *, integer *), setmsg_(char *, ftnlen) - , errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Look up the column descriptor for a column of a given name */ -/* in a specified segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to an EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLUMN I Name of column. */ -/* COLDSC O Descriptor for specified column. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle for the file containing the */ -/* column of interest. The EK may be open for read */ -/* or write access. */ - -/* SEGDSC is the descriptor of the segment containing the */ -/* column for which a descriptor is desired. */ - -/* COLUMN is the name of the column whose descriptor is */ -/* desired. Case and white space are not significant. */ - -/* $ Detailed_Output */ - -/* COLDSC is the descriptor of the column belonging to the */ -/* specified file and segment and having name COLUMN. */ -/* See the include file ekcoldsc.inc for details */ -/* regarding the structure of EK column descriptors. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input column name does not match any column in the */ -/* designated segment, the error SPICE(BUG) is signalled. It */ -/* is the caller's responsibility to call this routine with */ -/* valid input arguments. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine exists for the sole purpose of centralizing code */ -/* used to perform column descriptor look-ups. */ - -/* $ Examples */ - -/* See the EKACEx routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Get the segment's integer metadata's base address. */ - - mbase = segdsc[2]; - -/* Get the number of columns. */ - - ncols = segdsc[4]; - -/* Search linearly through the column descriptors, looking for */ -/* a column name match. It's an error if we don't find the input */ -/* name. */ - - found = FALSE_; - i__ = 1; - while(i__ <= ncols && ! found) { - dscbas = mbase + 24 + (i__ - 1) * 11; - -/* Get the character base address of the column name from the */ -/* current descriptor. */ - - i__1 = dscbas + 1; - i__2 = dscbas + 11; - dasrdi_(handle, &i__1, &i__2, coldsc); - nambas = coldsc[4]; - -/* Look up the name and compare. */ - - i__1 = nambas + 1; - i__2 = nambas + 32; - dasrdc_(handle, &i__1, &i__2, &c__1, &c__32, cname, (ftnlen)32); - if (eqstr_(cname, column, (ftnlen)32, column_len)) { - found = TRUE_; - } else { - ++i__; - } - } - if (! found) { - dashlu_(handle, &unit); - chkin_("ZZEKCDSC", (ftnlen)8); - setmsg_("Descriptor for column # was not found. Segment base = #; fi" - "le = #.", (ftnlen)66); - errch_("#", column, (ftnlen)1, column_len); - errint_("#", &mbase, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKCDSC", (ftnlen)8); - return 0; - } - return 0; -} /* zzekcdsc_ */ - diff --git a/ext/spice/src/cspice/zzekcix1.c b/ext/spice/src/cspice/zzekcix1.c deleted file mode 100644 index b6dcdd074c..0000000000 --- a/ext/spice/src/cspice/zzekcix1.c +++ /dev/null @@ -1,267 +0,0 @@ -/* zzekcix1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKCIX1 ( EK, create index, type 1 ) */ -/* Subroutine */ int zzekcix1_(integer *handle, integer *coldsc) -{ - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzektrit_(integer *, integer *), chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Create a new type 1 index for a specified EK column. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* COLDSC I Column descriptor. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK that is open for write */ -/* access. */ - -/* COLDSC is the column descriptor of the column for */ -/* which the index is to be created. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it creates a new, empty */ -/* type 1 index for a specified EK column. Though this routine */ -/* does not require a segment to be specified, normally indexes */ -/* are created for columns belonging to specific segments. */ - -/* Type 1 indexes are implemented as DAS B*-trees. The data */ -/* pointers of an index tree contain record numbers. Therefore, the */ -/* tree implements an abstract order vector. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not check that the specified column is empty. The caller */ -/* must populate the index appropriately to reflect the order of */ -/* elements in the associated column. */ - -/* $ Examples */ - -/* See EKBSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKCIX1", (ftnlen)8); - } - -/* Before trying to actually write anything, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKCIX1", (ftnlen)8); - return 0; - } - -/* An empty type 1 segment is just an empty B*-tree. The root */ -/* page number of the tree serves as the index pointer. */ - - coldsc[5] = 1; - zzektrit_(handle, &coldsc[6]); - chkout_("ZZEKCIX1", (ftnlen)8); - return 0; -} /* zzekcix1_ */ - diff --git a/ext/spice/src/cspice/zzekcnam.c b/ext/spice/src/cspice/zzekcnam.c deleted file mode 100644 index d84bbc7696..0000000000 --- a/ext/spice/src/cspice/zzekcnam.c +++ /dev/null @@ -1,392 +0,0 @@ -/* zzekcnam.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__32 = 32; - -/* $Procedure ZZEKCNAM ( EK, get column name ) */ -/* Subroutine */ int zzekcnam_(integer *handle, integer *coldsc, char *column, - ftnlen column_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen); - integer nambas; - -/* $ Abstract */ - -/* Look up the name of a column, given the column's descriptor. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* COLDSC I Column descriptor. */ -/* COLUMN O Column name. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* COLDSC is the column descriptor of a column whose name is */ -/* desired. */ - -/* $ Detailed_Output */ - -/* COLNAM is the name of the specified column. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine centralizes the coded needed to look up the */ -/* name of a specified column. This is a frequently */ -/* performed function. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Look up the name. */ - - nambas = coldsc[4]; - i__1 = nambas + 1; - i__2 = nambas + 32; - dasrdc_(handle, &i__1, &i__2, &c__1, &c__32, column, column_len); - return 0; -} /* zzekcnam_ */ - diff --git a/ext/spice/src/cspice/zzekde01.c b/ext/spice/src/cspice/zzekde01.c deleted file mode 100644 index f2d05fe273..0000000000 --- a/ext/spice/src/cspice/zzekde01.c +++ /dev/null @@ -1,835 +0,0 @@ -/* zzekde01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c_n1 = -1; - -/* $Procedure ZZEKDE01 ( EK, delete column entry, class 1 ) */ -/* Subroutine */ int zzekde01_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer base; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekglnk_(integer *, integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *), zzekixdl_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, idxtyp, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekdps_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified class 1 column entry from an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to delete. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a column entry */ -/* from an EK segment. The deleted entry is marked as */ -/* `uninitialized'. If the column containing the entry is indexed, */ -/* the corresponding entry in the index is removed. The entry must */ -/* be replaced with a new entry in order to be readable. */ - -/* The link count for the page containing the deleted column entry */ -/* is decremented. If the count becomes zero, the page is freed. */ -/* If the entry to be deleted is already uninitialized upon entry */ -/* to this routine, no link counts are modified. The record */ -/* containing the entry is still marked `updated' in this */ -/* case. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKDE01", (ftnlen)8); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKDE01", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - -/* Compute the data pointer location. If the data pointer is */ -/* already set to `uninitialized', there's nothing to do. If */ -/* the element is null, just set it to `uninitialized'. The */ -/* presence of actual data obligates us to clean up, however. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Determine whether the column is indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } - -/* Find the number of the page containing the column entry. */ - - zzekpgpg_(&c__3, &datptr, &p, &base); - -/* Get the link count for the page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__3, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__3, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__3, &p); - } - -/* Set the data pointer to indicate the item is uninitialized. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr == -2) { - -/* Determine whether the column is indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } - -/* Mark the entry as `uninitialized'. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr != -1) { - -/* UNINIT was the last valid possibility. The data pointer is */ -/* corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKDE01", (ftnlen)8); - return 0; - } - chkout_("ZZEKDE01", (ftnlen)8); - return 0; -} /* zzekde01_ */ - diff --git a/ext/spice/src/cspice/zzekde02.c b/ext/spice/src/cspice/zzekde02.c deleted file mode 100644 index 5156ad5014..0000000000 --- a/ext/spice/src/cspice/zzekde02.c +++ /dev/null @@ -1,835 +0,0 @@ -/* zzekde02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c_n1 = -1; - -/* $Procedure ZZEKDE02 ( EK, delete column entry, class 2 ) */ -/* Subroutine */ int zzekde02_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer base; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekglnk_(integer *, integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *), zzekixdl_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, idxtyp, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekdps_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified class 2 column entry from an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to delete. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a column entry */ -/* from an EK segment. The deleted entry is marked as */ -/* `uninitialized'. If the column containing the entry is indexed, */ -/* the corresponding entry in the index is removed. The entry must */ -/* be replaced with a new entry in order to be readable. */ - -/* The link count for the page containing the deleted column entry */ -/* is decremented. If the count becomes zero, the page is freed. */ -/* If the entry to be deleted is already uninitialized upon entry */ -/* to this routine, no link counts are modified. The record */ -/* containing the entry is still marked `updated' in this */ -/* case. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKDE02", (ftnlen)8); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKDE02", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - -/* Compute the data pointer location. If the data pointer is */ -/* already set to `uninitialized', there's nothing to do. If */ -/* the element is null, just set it to `uninitialized'. The */ -/* presence of actual data obligates us to clean up, however. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Determine whether the column is indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } - -/* Find the number of the page containing the column entry. */ - - zzekpgpg_(&c__2, &datptr, &p, &base); - -/* Get the link count for the page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__2, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__2, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__2, &p); - } - -/* Set the data pointer to indicate the item is uninitialized. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr == -2) { - -/* Determine whether the column is indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } - -/* Mark the entry as `uninitialized'. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr != -1) { - -/* UNINIT was the last valid possibility. The data pointer is */ -/* corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKDE02", (ftnlen)8); - return 0; - } - chkout_("ZZEKDE02", (ftnlen)8); - return 0; -} /* zzekde02_ */ - diff --git a/ext/spice/src/cspice/zzekde03.c b/ext/spice/src/cspice/zzekde03.c deleted file mode 100644 index 52866b9aaa..0000000000 --- a/ext/spice/src/cspice/zzekde03.c +++ /dev/null @@ -1,880 +0,0 @@ -/* zzekde03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n1 = -1; -static integer c__1 = 1; - -/* $Procedure ZZEKDE03 ( EK, delete column entry, class 3 ) */ -/* Subroutine */ int zzekde03_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer next, unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekgfwd_(integer *, integer *, integer *, integer *), zzekglnk_( - integer *, integer *, integer *, integer *), zzekpgpg_(integer *, - integer *, integer *, integer *), zzekixdl_(integer *, integer *, - integer *, integer *), zzekslnk_(integer *, integer *, integer *, - integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, nseen, ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, idxtyp, nchars, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekgei_(integer *, integer *, integer *), zzekdps_( - integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified class 3 column entry from an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to delete. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If RECNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a column entry */ -/* from an EK segment. The deleted entry is marked as */ -/* `uninitialized'. If the column containing the entry is indexed, */ -/* the corresponding entry in the index is removed. The entry must */ -/* be replaced with a new entry in order to be readable. */ - -/* The link count for the page containing the deleted column entry */ -/* is decremented. If the count becomes zero, the page is freed. */ -/* If the entry to be deleted is already uninitialized upon entry */ -/* to this routine, no link counts are modified. The record */ -/* containing the entry is still marked `updated' in this */ -/* case. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKDE03", (ftnlen)8); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKDE03", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - -/* Compute the data pointer location. If the data pointer is */ -/* already set to `uninitialized', there's nothing to do. If */ -/* the element is null, just set it to `uninitialized'. The */ -/* presence of actual data obligates us to clean up, however. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Determine whether the column is indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } - -/* Get the character count for the entry. */ - - zzekgei_(handle, &datptr, &nchars); - -/* Set the data pointer to indicate the item is uninitialized. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - -/* Find the number of the page containing the column entry. */ - - zzekpgpg_(&c__1, &datptr, &p, &base); - -/* Look up the forward pointer. This pointer will be valid */ -/* if the column entry is continued on another page. */ - - zzekgfwd_(handle, &c__1, &p, &next); - -/* Get the link count for the page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__1, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__1, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__1, &p); - } -/* Computing MIN */ - i__1 = nchars, i__2 = base + 1014 - datptr; - nseen = min(i__1,i__2); - while(nseen < nchars && ! failed_()) { - -/* The column entry is continued on the page indicated by */ -/* NEXT. */ - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - p = next; - zzekgfwd_(handle, &c__1, &p, &next); - zzekglnk_(handle, &c__1, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__1, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__1, &p); - } -/* Computing MIN */ - i__1 = nchars, i__2 = nseen + 1014; - nseen = min(i__1,i__2); - } - } else if (datptr == -2) { - -/* Determine whether the column is indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } - -/* Mark the entry as `uninitialized'. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr != -1) { - -/* UNINIT was the last valid possibility. The data pointer is */ -/* corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKDE03", (ftnlen)8); - return 0; - } - chkout_("ZZEKDE03", (ftnlen)8); - return 0; -} /* zzekde03_ */ - diff --git a/ext/spice/src/cspice/zzekde04.c b/ext/spice/src/cspice/zzekde04.c deleted file mode 100644 index f62a318d78..0000000000 --- a/ext/spice/src/cspice/zzekde04.c +++ /dev/null @@ -1,804 +0,0 @@ -/* zzekde04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n1 = -1; -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure ZZEKDE04 ( EK, delete column entry, class 4 ) */ -/* Subroutine */ int zzekde04_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base, nrec, next, unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekgfwd_(integer *, integer *, integer *, integer *), zzekglnk_( - integer *, integer *, integer *, integer *), zzekpgpg_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, nseen, ncols, nelts; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekdps_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified class 4 column entry from an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to delete. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a column entry */ -/* from an EK segment. The status of the record containing the entry */ -/* is set to `updated'. The deleted entry is marked as */ -/* `uninitialized'. */ - -/* The link counts for the pages containing the deleted column entry */ -/* are decremented. If the count for a page becomes zero, that page */ -/* is freed. If the entry to be deleted is already uninitialized */ -/* upon entry to this routine, no link counts are modified. The */ -/* record containing the entry is still marked `updated' in this */ -/* case. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKDE04", (ftnlen)8); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKDE04", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - nrec = segdsc[5]; - -/* Compute the data pointer location. If the data pointer is */ -/* already set to `uninitialized', there's nothing to do. If */ -/* the element is null, just set it to `uninitialized'. The */ -/* presence of actual data obligates us to clean up, however. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Get the element count for the entry. */ - - dasrdi_(handle, &datptr, &datptr, &nelts); - -/* Set the data pointer to indicate the item is uninitialized. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - -/* Find the number of the page containing the column entry. */ - - zzekpgpg_(&c__3, &datptr, &p, &base); - -/* Look up the forward pointer. This pointer will be valid */ -/* if the column entry is continued on another page. */ - - zzekgfwd_(handle, &c__3, &p, &next); - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__3, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__3, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__3, &p); - } -/* Computing MIN */ - i__1 = nelts, i__2 = base + 254 - datptr; - nseen = min(i__1,i__2); - while(nseen < nelts && ! failed_()) { - -/* The column entry is continued on the page indicated by */ -/* NEXT. */ - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - p = next; - zzekgfwd_(handle, &c__3, &p, &next); - zzekglnk_(handle, &c__3, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__3, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__3, &p); - } -/* Computing MIN */ - i__1 = nelts, i__2 = nseen + 254; - nseen = min(i__1,i__2); - } - } else if (datptr == -2) { - -/* Mark the entry as `uninitialized'. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr != -1) { - -/* UNINIT was the last valid possibility. The data pointer is */ -/* corrupted. */ - - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKDE04", (ftnlen)8); - return 0; - } - -/* Set the record's status to indicate that this record is updated. */ - - i__1 = *recptr + 1; - i__2 = *recptr + 1; - dasudi_(handle, &i__1, &i__2, &c__2); - chkout_("ZZEKDE04", (ftnlen)8); - return 0; -} /* zzekde04_ */ - diff --git a/ext/spice/src/cspice/zzekde05.c b/ext/spice/src/cspice/zzekde05.c deleted file mode 100644 index a28e2fdf8e..0000000000 --- a/ext/spice/src/cspice/zzekde05.c +++ /dev/null @@ -1,865 +0,0 @@ -/* zzekde05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n1 = -1; -static integer c__2 = 2; - -/* $Procedure ZZEKDE05 ( EK, delete column entry, class 5 ) */ -/* Subroutine */ int zzekde05_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer base, nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer next, unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekgfwd_(integer *, integer *, integer *, integer *), zzekglnk_( - integer *, integer *, integer *, integer *), zzekpgpg_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, nseen, ncols, nelts; - extern logical failed_(void); - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dasrdi_(integer *, integer *, integer *, integer *) - , dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - doublereal dpnelt; - integer datptr, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekdps_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified class 5 column entry from an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to delete. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a column entry */ -/* from an EK segment. The status of the record containing the entry */ -/* is set to `updated'. The deleted entry is marked as */ -/* `uninitialized'. */ - -/* The link counts for the pages containing the deleted column entry */ -/* are decremented. If the count for a page becomes zero, that page */ -/* is freed. If the entry to be deleted is already uninitialized */ -/* upon entry to this routine, no link counts are modified. The */ -/* record containing the entry is still marked `updated' in this */ -/* case. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKDE05", (ftnlen)8); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKDE05", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - nrec = segdsc[5]; - -/* Compute the data pointer location. If the data pointer is */ -/* already set to `uninitialized', there's nothing to do. If */ -/* the element is null, just set it to `uninitialized'. The */ -/* presence of actual data obligates us to clean up, however. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Get the element count for the entry. */ - - dasrdd_(handle, &datptr, &datptr, &dpnelt); - nelts = i_dnnt(&dpnelt); - -/* Set the data pointer to indicate the item is uninitialized. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - -/* Find the number of the page containing the column entry. */ - - zzekpgpg_(&c__2, &datptr, &p, &base); - -/* Look up the forward pointer. This pointer will be valid */ -/* if the column entry is continued on another page. */ - - zzekgfwd_(handle, &c__2, &p, &next); - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__2, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__2, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__2, &p); - } -/* Computing MIN */ - i__1 = nelts, i__2 = base + 126 - datptr; - nseen = min(i__1,i__2); - while(nseen < nelts && ! failed_()) { - -/* The column entry is continued on the page indicated by */ -/* NEXT. */ - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - p = next; - zzekgfwd_(handle, &c__2, &p, &next); - zzekglnk_(handle, &c__2, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__2, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__2, &p); - } -/* Computing MIN */ - i__1 = nelts, i__2 = nseen + 126; - nseen = min(i__1,i__2); - } - } else if (datptr == -2) { - -/* Mark the entry as `uninitialized'. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr != -1) { - -/* UNINIT was the last valid possibility. The data pointer is */ -/* corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKDE05", (ftnlen)8); - return 0; - } - -/* Set the record's status to indicate that this record is updated. */ - - i__1 = *recptr + 1; - i__2 = *recptr + 1; - dasudi_(handle, &i__1, &i__2, &c__2); - chkout_("ZZEKDE05", (ftnlen)8); - return 0; -} /* zzekde05_ */ - diff --git a/ext/spice/src/cspice/zzekde06.c b/ext/spice/src/cspice/zzekde06.c deleted file mode 100644 index ad57cd362a..0000000000 --- a/ext/spice/src/cspice/zzekde06.c +++ /dev/null @@ -1,863 +0,0 @@ -/* zzekde06.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c_n1 = -1; -static integer c__1 = 1; -static integer c__2 = 2; - -/* $Procedure ZZEKDE06 ( EK, delete column entry, class 6 ) */ -/* Subroutine */ int zzekde06_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base, nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer next, unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekgfwd_(integer *, integer *, integer *, integer *), zzekglnk_( - integer *, integer *, integer *, integer *), zzekpgpg_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, nseen, ncols, nelts; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, nchars, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, - integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), zzekgei_(integer *, integer *, integer *), zzekdps_( - integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Delete a specified class 6 column entry from an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to delete. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a column entry */ -/* from an EK segment. The status of the record containing the entry */ -/* is set to `updated'. The deleted entry is marked as */ -/* `uninitialized'. */ - -/* The link counts for the pages containing the deleted column entry */ -/* are decremented. If the count for a page becomes zero, that page */ -/* is freed. If the entry to be deleted is already uninitialized */ -/* upon entry to this routine, no link counts are modified. The */ -/* record containing the entry is still marked `updated' in this */ -/* case. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKDE06", (ftnlen)8); - } - -/* Before trying to actually modify the file, do every error */ -/* check we can. */ - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKDE06", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - nrec = segdsc[5]; - -/* Compute the data pointer location. If the data pointer is */ -/* already set to `uninitialized', there's nothing to do. If */ -/* the element is null, just set it to `uninitialized'. The */ -/* presence of actual data obligates us to clean up, however. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Get the element count for the entry. Compute the character */ -/* count for the entry. */ - - zzekgei_(handle, &datptr, &nelts); - nchars = coldsc[2] * nelts; - -/* Set the data pointer to indicate the item is uninitialized. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - -/* Find the number of the page containing the column entry. */ - - zzekpgpg_(&c__1, &datptr, &p, &base); - -/* Look up the forward pointer. This pointer will be valid */ -/* if the column entry is continued on another page. */ - - zzekgfwd_(handle, &c__1, &p, &next); - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - zzekglnk_(handle, &c__1, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__1, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__1, &p); - } -/* Computing MIN */ - i__1 = nchars, i__2 = base + 1014 - datptr; - nseen = min(i__1,i__2); - while(nseen < nchars && ! failed_()) { - -/* The column entry is continued on the page indicated by */ -/* NEXT. */ - -/* Get the link count for the current page. If we have more */ -/* than one link to the page, decrement the link count. If */ -/* we're down to one link, this deletion will finish off the */ -/* page: we'll deallocate it. */ - - p = next; - zzekgfwd_(handle, &c__1, &p, &next); - zzekglnk_(handle, &c__1, &p, &nlinks); - if (nlinks > 1) { - i__1 = nlinks - 1; - zzekslnk_(handle, &c__1, &p, &i__1); - } else { - -/* If we removed the last item from the page, we can delete */ -/* the page. ZZEKDPS adjusts the segment's metadata */ -/* to reflect the deallocation. */ - - zzekdps_(handle, segdsc, &c__1, &p); - } -/* Computing MIN */ - i__1 = nchars, i__2 = nseen + 1014; - nseen = min(i__1,i__2); - } - } else if (datptr == -2) { - -/* Mark the entry as `uninitialized'. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - } else if (datptr != -1) { - -/* UNINIT was the last valid possibility. The data pointer is */ -/* corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKDE06", (ftnlen)8); - return 0; - } - -/* Set the record's status to indicate that this record is updated. */ - - i__1 = *recptr + 1; - i__2 = *recptr + 1; - dasudi_(handle, &i__1, &i__2, &c__2); - chkout_("ZZEKDE06", (ftnlen)8); - return 0; -} /* zzekde06_ */ - diff --git a/ext/spice/src/cspice/zzekdps.c b/ext/spice/src/cspice/zzekdps.c deleted file mode 100644 index ddc3cb0d11..0000000000 --- a/ext/spice/src/cspice/zzekdps.c +++ /dev/null @@ -1,512 +0,0 @@ -/* zzekdps.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1014 = 1014; -static integer c__126 = 126; -static integer c__254 = 254; - -/* $Procedure ZZEKDPS ( EK, delete page from segment ) */ -/* Subroutine */ int zzekdps_(integer *handle, integer *segdsc, integer * - type__, integer *p) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer tree; - extern /* Subroutine */ int zzekpgfr_(integer *, integer *, integer *), - zzektrdl_(integer *, integer *, integer *); - extern integer zzektrls_(integer *, integer *, integer *); - integer mbase; - extern logical failed_(void); - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - integer loc; - -/* $ Abstract */ - -/* Delete a specified data page for a specified EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I-O Segment descriptor. */ -/* TYPE I Data type of page. */ -/* P I Page number. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete a data page. */ - -/* TYPE is the data type of the page. */ - -/* P is number of the page to delete. This */ -/* number is recognized by the EK paged access */ -/* routines. */ - -/* $ Detailed_Output */ - -/* SEGDSC is the descriptor of the segment from which the */ -/* specified page was deleted. If P is the current */ -/* data page of TYPE, the descriptor element */ -/* specifying the last word in use of this data type */ -/* will be updated on exit from this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes an EK data */ -/* page from a specified segment. The segment's metadata is updated */ -/* to reflect deletion of the page. If the deleted page is the last */ -/* one of its type in use in the specified segment, the last word in */ -/* use of that type is set to the maximum value. This prevents */ -/* further attempts to write to the page. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 2.0.0, 02-APR-1996 (NJB) */ - -/* Updated to make SEGDSC an in-out argument. The last word */ -/* in use of the data type of P is set to the maximum value */ -/* on output. Also, an error in the deletion of the page */ -/* from the parent data page tree was corrected. */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Ashes to ashes, dust to dust. This page goes to the free list. */ - - zzekpgfr_(handle, type__, p); - if (failed_()) { - return 0; - } - -/* Update the segment's metadata. For type 1 segments, */ -/* the new page into the page tree of the appropriate data type. */ - -/* If this page is the last one in use in the segment, set the last */ -/* word in use of the appropriate type to the maximum number. This */ -/* prevents further writing to the page we're deleting. */ - - mbase = segdsc[2]; - if (*type__ == 1) { - tree = segdsc[7]; - if (segdsc[15] == *p) { - i__1 = mbase + 19; - i__2 = mbase + 19; - dasudi_(handle, &i__1, &i__2, &c__1014); - } - if (*p == segdsc[15]) { - segdsc[18] = 1014; - } - } else if (*type__ == 2) { - tree = segdsc[8]; - if (segdsc[16] == *p) { - i__1 = mbase + 20; - i__2 = mbase + 20; - dasudi_(handle, &i__1, &i__2, &c__126); - } - if (*p == segdsc[16]) { - segdsc[19] = 126; - } - } else if (*type__ == 3) { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, one of the allocation routines would have */ -/* complained. */ - - tree = segdsc[9]; - if (segdsc[17] == *p) { - i__1 = mbase + 21; - i__2 = mbase + 21; - dasudi_(handle, &i__1, &i__2, &c__254); - } - if (*p == segdsc[17]) { - segdsc[20] = 254; - } - } - -/* Remove the page's number from the data page tree of the */ -/* appropriate type. This removal requires finding the key that */ -/* points to the page to be removed. */ - - loc = zzektrls_(handle, &tree, p); - zzektrdl_(handle, &tree, &loc); - return 0; -} /* zzekdps_ */ - diff --git a/ext/spice/src/cspice/zzekecmp.c b/ext/spice/src/cspice/zzekecmp.c deleted file mode 100644 index b6d128f726..0000000000 --- a/ext/spice/src/cspice/zzekecmp.c +++ /dev/null @@ -1,980 +0,0 @@ -/* zzekecmp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKECMP ( EK, column entry element comparison ) */ -integer zzekecmp_(integer *hans, integer *sgdscs, integer *cldscs, integer * - rows, integer *elts) -{ - /* System generated locals */ - integer ret_val, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen, - ftnlen); - - /* Local variables */ - char cval[1024*2]; - doublereal dval[2]; - integer ival[2]; - logical null[2]; - integer unit, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer cvlen[2]; - logical found; - integer cmplen[2], lhstyp, rhstyp; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errfnm_(char *, integer *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzekrsc_(integer *, integer *, integer *, integer *, - integer *, integer *, char *, logical *, logical *, ftnlen), - zzekrsd_(integer *, integer *, integer *, integer *, integer *, - doublereal *, logical *, logical *), zzekrsi_(integer *, integer * - , integer *, integer *, integer *, integer *, logical *, logical * - ); - -/* $ Abstract */ - -/* Compare two column entry elements, and return the relation of the */ -/* first to the second: LT, EQ, or GT. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* COMPARE */ -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANS I EK handles. */ -/* SGDSCS I Segment descriptors. */ -/* CLDSCS I Column descriptors. */ -/* ROWS I Row numbers. */ -/* ELTS I Element indices. */ - -/* The function returns a parameter indicating the order relation */ -/* satisfied by the input arguments. Possible values are LT, EQ, */ -/* and GT. */ - -/* $ Detailed_Input */ - -/* HANS is an array containing file handles of two EKs */ -/* containing column entry elements to be compared. */ - -/* SGDSCS is an array containing segment descriptors of */ -/* the segments that contain the elements to be */ -/* compared. */ - -/* CLDSCS is an array containing column descriptors for the */ -/* columns containing the elements to be compared. */ - -/* ROWS is an array containing row numbers of the */ -/* elements to be compared. */ - -/* ELTS is an array containing element indices of the */ -/* elements to be compared. These indices locate */ -/* an element within the column entry it belongs to. */ - -/* $ Detailed_Output */ - -/* The function returns a parameter indicating the order relation */ -/* satisfied by the input arguments. Possible values are LT, EQ, */ -/* and GT. If OP is the returned value, the scalar values */ -/* specified by the input arguments satisfy the relation */ - -/* OP */ - -/* $ Parameters */ - -/* See the include file ekopcd.inc. */ - -/* $ Exceptions */ - -/* 1) If the either of input file handles is invalid, the error */ -/* will be diagnosed by routines called by this routine. */ -/* The function value is EQ in this case. */ - -/* 2) If an I/O error occurs while attempting to look up */ -/* the specified column entry elements, the error will */ -/* be diagnosed by routines called by this routine. The */ -/* function value is EQ in this case. */ - -/* 3) If any of the input segment descriptors, column descriptors, */ -/* or row numbers are invalid, this routine may fail in */ -/* unpredictable, but possibly spectacular, ways. Except */ -/* as described in this header section, no attempt is made to */ -/* handle these errors. */ - -/* 4) If the data type code in the input column descriptor is not */ -/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ -/* The function value is EQ in this case. */ - -/* $ Files */ - -/* See the descriptions of the arguments HAN(1) and HAN(2) in */ -/* $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is an EK utility intended to centralize a frequently */ -/* performed comparison operation. */ - -/* $ Examples */ - -/* See ZZEKRCMP, ZZEKVCMP, ZZEKVMCH. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* 2) This routine depends on the requested comparison to have */ -/* been semantically checked. Semantically invalid comparisons */ -/* are treated as bugs. */ - -/* 3) Only the first MAXSTR characters of character strings are */ -/* used in comparisons. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 26-MAY-2010 (NJB) */ - -/* Bug fix: subscript out of range error caused by */ -/* column entry strings longer than MAXLEN has been */ -/* corrected. Also updated Restrictions header section. */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - -/* The function value defaults to `equal'. */ - - ret_val = 1; - lhstyp = cldscs[1]; - rhstyp = cldscs[12]; - if (lhstyp == 3) { - -/* The entities we're comparing are supposed to be */ -/* scalar. The left hand side has integer type. Either */ -/* integer or double precision types are acceptable on */ -/* the right hand side. */ - - zzekrsi_(hans, sgdscs, cldscs, rows, elts, ival, null, &found); - if (! found) { - dashlu_(hans, &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry e" - "lement was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[8], (ftnlen)1); - errint_("#", rows, (ftnlen)1); - errint_("#", elts, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - if (rhstyp == 3) { - zzekrsi_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, & - ival[1], &null[1], &found); - if (! found) { - dashlu_(&hans[1], &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent" - "ry element was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[19], (ftnlen)1); - errint_("#", &rows[1], (ftnlen)1); - errint_("#", &elts[1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - -/* Null values precede all others. */ - - if (null[0] || null[1]) { - if (! null[1]) { - ret_val = 5; - } else if (! null[0]) { - ret_val = 3; - } - } else { - if (ival[0] < ival[1]) { - ret_val = 5; - } else if (ival[0] > ival[1]) { - ret_val = 3; - } - } - } else if (rhstyp == 2) { - zzekrsd_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, & - dval[1], &null[1], &found); - if (! found) { - dashlu_(&hans[1], &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent" - "ry element was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[19], (ftnlen)1); - errint_("#", &rows[1], (ftnlen)1); - errint_("#", &elts[1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - if (null[0] || null[1]) { - if (! null[1]) { - ret_val = 5; - } else if (! null[0]) { - ret_val = 3; - } - } else { - if ((doublereal) ival[0] < dval[1]) { - ret_val = 5; - } else if ((doublereal) ival[0] > dval[1]) { - ret_val = 3; - } - } - } else { - -/* This is a big-time semantic error. We should */ -/* never arrive here. */ - - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32); - errint_("#", &lhstyp, (ftnlen)1); - errint_("#", &rhstyp, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - } else if (lhstyp == 2) { - -/* This is a mirror image of the INT case. */ - - zzekrsd_(hans, sgdscs, cldscs, rows, elts, dval, null, &found); - if (! found) { - dashlu_(hans, &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry e" - "lement was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[8], (ftnlen)1); - errint_("#", rows, (ftnlen)1); - errint_("#", elts, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - if (rhstyp == 3) { - zzekrsi_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, & - ival[1], &null[1], &found); - if (! found) { - dashlu_(&hans[1], &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent" - "ry element was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[19], (ftnlen)1); - errint_("#", &rows[1], (ftnlen)1); - errint_("#", &elts[1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - -/* Null values precede all others. */ - - if (null[0] || null[1]) { - if (! null[1]) { - ret_val = 5; - } else if (! null[0]) { - ret_val = 3; - } - } else { - if (dval[0] < (doublereal) ival[1]) { - ret_val = 5; - } else if (dval[0] > (doublereal) ival[1]) { - ret_val = 3; - } - } - } else if (rhstyp == 2) { - zzekrsd_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, & - dval[1], &null[1], &found); - if (! found) { - dashlu_(&hans[1], &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent" - "ry element was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[19], (ftnlen)1); - errint_("#", &rows[1], (ftnlen)1); - errint_("#", &elts[1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - if (null[0] || null[1]) { - if (! null[1]) { - ret_val = 5; - } else if (! null[0]) { - ret_val = 3; - } - } else { - if (dval[0] < dval[1]) { - ret_val = 5; - } else if (dval[0] > dval[1]) { - ret_val = 3; - } - } - } else { - -/* This is a big-time semantic error. We should */ -/* never arrive here. */ - - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32); - errint_("#", &lhstyp, (ftnlen)1); - errint_("#", &rhstyp, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - } else if (lhstyp == 4) { - -/* The entities we're comparing are supposed to be time values. */ - - if (rhstyp != 4) { - -/* This is a big-time semantic error. We should */ -/* never arrive here. */ - - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32); - errint_("#", &lhstyp, (ftnlen)1); - errint_("#", &rhstyp, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - for (i__ = 1; i__ <= 2; ++i__) { - zzekrsd_(&hans[i__ - 1], &sgdscs[i__ * 24 - 24], &cldscs[i__ * 11 - - 11], &rows[i__ - 1], &elts[i__ - 1], &dval[(i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("dval", i__1, "zze" - "kecmp_", (ftnlen)494)], &null[(i__2 = i__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("null", i__2, "zzekecmp_", (ftnlen) - 494)], &found); - if (! found) { - dashlu_(&hans[i__ - 1], &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent" - "ry element was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[i__ * 11 - 3], (ftnlen)1); - errint_("#", &rows[i__ - 1], (ftnlen)1); - errint_("#", &elts[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - } - if (null[0] || null[1]) { - if (! null[1]) { - ret_val = 5; - } else if (! null[0]) { - ret_val = 3; - } - } else { - if (dval[0] < dval[1]) { - ret_val = 5; - } else if (dval[0] > dval[1]) { - ret_val = 3; - } - } - } else if (lhstyp == 1) { - -/* The entities we're comparing are supposed to be scalar. */ - - if (rhstyp != 1) { - -/* You know what kind of semantic error this is. */ - - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32); - errint_("#", &lhstyp, (ftnlen)1); - errint_("#", &rhstyp, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - for (i__ = 1; i__ <= 2; ++i__) { - zzekrsc_(&hans[i__ - 1], &sgdscs[i__ * 24 - 24], &cldscs[i__ * 11 - - 11], &rows[i__ - 1], &elts[i__ - 1], &cvlen[(i__1 = i__ - - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cvlen", i__1, - "zzekecmp_", (ftnlen)558)], cval + (((i__2 = i__ - 1) < 2 - && 0 <= i__2 ? i__2 : s_rnge("cval", i__2, "zzekecmp_", ( - ftnlen)558)) << 10), &null[(i__3 = i__ - 1) < 2 && 0 <= - i__3 ? i__3 : s_rnge("null", i__3, "zzekecmp_", (ftnlen) - 558)], &found, (ftnlen)1024); - if (! found) { - dashlu_(&hans[i__ - 1], &unit); - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent" - "ry element was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[i__ * 11 - 3], (ftnlen)1); - errint_("#", &rows[i__ - 1], (ftnlen)1); - errint_("#", &elts[i__ - 1], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - -/* Let CMPLEN(I) be the string length to use in comparisons. */ - -/* Computing MIN */ - i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge( - "cvlen", i__2, "zzekecmp_", (ftnlen)589)]; - cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cmplen", - i__1, "zzekecmp_", (ftnlen)589)] = min(i__3,1024); - } - if (null[0] || null[1]) { - if (! null[1]) { - ret_val = 5; - } else if (! null[0]) { - ret_val = 3; - } - } else { - if (l_lt(cval, cval + 1024, cmplen[0], cmplen[1])) { - ret_val = 5; - } else if (l_gt(cval, cval + 1024, cmplen[0], cmplen[1])) { - ret_val = 3; - } else { - ret_val = 1; - } - } - } else { - -/* Something untoward has happened in our descriptor. */ - - chkin_("ZZEKECMP", (ftnlen)8); - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", &lhstyp, (ftnlen)1); - sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22); - chkout_("ZZEKECMP", (ftnlen)8); - return ret_val; - } - return ret_val; -} /* zzekecmp_ */ - diff --git a/ext/spice/src/cspice/zzekencd.c b/ext/spice/src/cspice/zzekencd.c deleted file mode 100644 index b3a3c677e1..0000000000 --- a/ext/spice/src/cspice/zzekencd.c +++ /dev/null @@ -1,820 +0,0 @@ -/* zzekencd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__27869 = 27869; -static integer c__100 = 100; -static integer c__500 = 500; - -/* $Procedure ZZEKENCD ( EK, encode query ) */ -/* Subroutine */ int zzekencd_(char *query, integer *eqryi, char *eqryc, - doublereal *eqryd, logical *error, char *errmsg, integer *errptr, - ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len) -{ - extern /* Subroutine */ int zzekscan_(char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, doublereal - *, char *, integer *, integer *, logical *, char *, ftnlen, - ftnlen, ftnlen), zzeksemc_(char *, integer *, char *, logical *, - char *, integer *, ftnlen, ftnlen, ftnlen), zzekqini_(integer *, - integer *, integer *, char *, doublereal *, ftnlen), zzekpars_( - char *, integer *, integer *, integer *, integer *, integer *, - doublereal *, char *, integer *, integer *, integer *, char *, - doublereal *, logical *, char *, ftnlen, ftnlen, ftnlen, ftnlen), - zzeknres_(char *, integer *, char *, logical *, char *, integer *, - ftnlen, ftnlen, ftnlen), zzektres_(char *, integer *, char *, - doublereal *, logical *, char *, integer *, ftnlen, ftnlen, - ftnlen), chkin_(char *, ftnlen); - integer chbegs[500], chends[500]; - char chrbuf[2000]; - extern logical return_(void); - doublereal numvls[100]; - integer lxbegs[500], lxends[500], ntoken, tokens[500], values[500]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* Convert an EK query to encoded form. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I Query specifying events to be found. */ -/* EQRYI O Integer component of encoded query. */ -/* EQRYC O Character component of encoded query. */ -/* EQRYD O Numeric component of encoded query. */ -/* ERROR O Flag indicating whether query parsed correctly. */ -/* ERRMSG O Parse error description. */ -/* ERRPTR O Error pointer. */ - -/* $ Detailed_Input */ - -/* QUERY is an EK query, starting after the FROM keyword. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* Semantic checking will have been performed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* EQRYD is the numeric portion of an encoded EK query. */ - -/* ERROR is a logical flag indicating whether the query */ -/* was syntactically correct and, as far as this */ -/* routine could determine, semantically correct. */ - -/* ERRMSG is a character string that describes ZZEKENCD's */ -/* diagnosis of a parse error, should one occur. */ -/* Otherwise, ERRMSG will be returned blank. */ - -/* ERRPTR is the index, within the input query, of the */ -/* first character at which an error was detected */ -/* ERRPTR is valid only if ERROR is returned .TRUE. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* If a parse error occurs, either the outputs ERROR, ERRMSG, and */ -/* ERRPTR will be set by routines called by this routine, or an */ -/* error will be signalled by routines called by this routine. */ -/* Under normal circumstances, no errors will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine assumes that encoded EK query architecture version */ -/* 1 is to be used with the query to be initialized; this routine */ -/* will not work with any other architecture version. */ - -/* $ Examples */ - -/* See EKPSEL. */ - -/* $ Restrictions */ - -/* 1) Uses EK encoded query architecture version 1. */ - -/* 2) A leapseconds kernel must be loaded before this routine may */ -/* be called, if UTC time values are used in input queries. */ - -/* 3) An appropriate SCLK kernel must be loaded before this routine */ -/* may be called, if SCLK values are used in input queries. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 4.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Storage limits: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKENCD", (ftnlen)8); - } - -/* Initialize the encoded query each time, for safety. */ - - zzekqini_(&c__27869, &c__100, eqryi, eqryc, eqryd, eqryc_len); - -/* Find the tokens in the input query. */ - - zzekscan_(query, &c__500, &c__100, &ntoken, tokens, lxbegs, lxends, - values, numvls, chrbuf, chbegs, chends, error, errmsg, query_len, - (ftnlen)2000, errmsg_len); - if (*error) { - *errptr = 1; - chkout_("ZZEKENCD", (ftnlen)8); - return 0; - } - -/* Now parse the query. */ - - zzekpars_(query, &ntoken, lxbegs, lxends, tokens, values, numvls, chrbuf, - chbegs, chends, eqryi, eqryc, eqryd, error, errmsg, query_len, ( - ftnlen)2000, eqryc_len, errmsg_len); - if (*error) { - *errptr = 1; - chkout_("ZZEKENCD", (ftnlen)8); - return 0; - } - -/* Resolve names. */ - - zzeknres_(query, eqryi, eqryc, error, errmsg, errptr, query_len, - eqryc_len, errmsg_len); - if (*error) { - chkout_("ZZEKENCD", (ftnlen)8); - return 0; - } - -/* Resolve time values, if necessary. */ - - zzektres_(query, eqryi, eqryc, eqryd, error, errmsg, errptr, query_len, - eqryc_len, errmsg_len); - if (*error) { - chkout_("ZZEKENCD", (ftnlen)8); - return 0; - } - -/* Perform semantic checks. */ - - zzeksemc_(query, eqryi, eqryc, error, errmsg, errptr, query_len, - eqryc_len, errmsg_len); - if (*error) { - chkout_("ZZEKENCD", (ftnlen)8); - return 0; - } - chkout_("ZZEKENCD", (ftnlen)8); - return 0; -} /* zzekencd_ */ - diff --git a/ext/spice/src/cspice/zzekerc1.c b/ext/spice/src/cspice/zzekerc1.c deleted file mode 100644 index 003336afa4..0000000000 --- a/ext/spice/src/cspice/zzekerc1.c +++ /dev/null @@ -1,705 +0,0 @@ -/* zzekerc1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static doublereal c_b11 = 0.; -static integer c__0 = 0; -static integer c__5 = 5; - -/* $Procedure ZZEKERC1 ( EK, LLE using record pointers, char, type 1 ) */ -/* Subroutine */ int zzekerc1_(integer *handle, integer *segdsc, integer * - coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, - integer *prvptr, ftnlen ckey_len) -{ - integer nrec, tree; - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *); - integer begin; - extern integer zzektrsz_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tsize; - extern logical failed_(void); - integer middle, begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer end; - logical leq; - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specifed character EK column having a type 1 index, using */ -/* dictionary ordering on character data values and record pointers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CKEY I Character key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ -/* PRVIDX O Ordinal position of predecessor of CKEY. */ -/* PRVPTR O Record pointer for predecessor of CKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* CKEY, */ -/* RECPTR are, respectively, a character key and a pointer */ -/* to an EK record containing that key. The last */ -/* column entry less than or equal to this key is */ -/* sought. The order relation used is dictionary */ -/* ordering on the pair (CKEY, RECPTR). */ - -/* NULL is a logical flag indicating whether the input */ -/* key is null. When NULL is .TRUE., CKEY is */ -/* ignored by this routine. */ - -/* $ Detailed_Output */ - -/* PRVIDX is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to CKEY, where the order relation is */ -/* as indicated above. If the column contains */ -/* elements equal to CKEY, PRVIDX is the index of the */ -/* record designated by the input RECPTR. */ - -/* If all elements of the column are greater than */ -/* CKEY, PRVIDX is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVIDX. */ - -/* If all elements of the column are greater than */ -/* CKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the tree is empty, PRVIDX and PRVPTR are set to zero. */ -/* This case is not considered an error. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified character key, within a specified segment and */ -/* column. The column must be indexed by a type 1 index. The order */ -/* relation used is dictionary ordering on ordered pairs consisting */ -/* of data values and record pointers: if the data values in two */ -/* column entries are equal, the associated record pointers determine */ -/* the order relation of the column entries. */ - -/* Type 1 indexes are implemented as DAS B*-trees. The data */ -/* pointers of an index tree contain record pointers. Therefore, the */ -/* tree implements an abstract order vector. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKLERC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-MAY-1997 (NJB) */ - -/* Errors in comparisons of items of equal value were fixed. */ -/* In such cases, items are compared according to order of */ -/* their record pointers. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* Make sure the number of records in the segment is at least as */ -/* large as the number of entries in the index: we must not look */ -/* up any entries that don't exist! */ - - tree = coldsc[6]; - tsize = zzektrsz_(handle, &tree); - nrec = segdsc[5]; - if (tsize > nrec) { - chkin_("ZZEKERC1", (ftnlen)8); - setmsg_("Index size = # but column contains # records.", (ftnlen)45); - errint_("#", &tsize, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(SIZEMISMATCH)", (ftnlen)19); - chkout_("ZZEKERC1", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty tree gracefully. */ - - if (tsize == 0) { - *prvidx = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLED. */ - - begin = 1; - end = tsize; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzektrdp_(handle, &tree, &begin, &begptr); - zzektrdp_(handle, &tree, &end, &endptr); - -/* Compare the input value to the smallest value in the column. */ - - if (zzekscmp_(&c__3, handle, segdsc, coldsc, &begptr, &c__1, &c__1, ckey, - &c_b11, &c__0, null, ckey_len)) { - -/* The smallest entry of the column is greater than */ -/* the input value, so none of the entries */ -/* are less than or equal to the input value. */ - - *prvidx = 0; - *prvptr = 0; - return 0; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &begptr, &c__1, &c__1, - ckey, &c_b11, &c__0, null, ckey_len) && *recptr < begptr) { - -/* The smallest entry of the column is greater than the input */ -/* value, based on a comparison of record pointers, so none of the */ -/* entries are less than or equal to the input value. */ - - *prvidx = 0; - *prvptr = 0; - return 0; - } - -/* At this point, we know the input value is greater than or equal */ -/* to the smallest element of the column. */ - -/* Compare the input value to the greatest value in the column. */ - - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &endptr, &c__1, &c__1, ckey, - &c_b11, &c__0, null, ckey_len)) { - -/* The last element of the column is less than the */ -/* input value. */ - - *prvidx = tsize; - zzektrdp_(handle, &tree, prvidx, prvptr); - return 0; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &endptr, &c__1, &c__1, - ckey, &c_b11, &c__0, null, ckey_len) && endptr <= *recptr) { - -/* The last element of the column is less than or equal to the */ -/* input value, based on a comparison of record pointers. */ - - *prvidx = tsize; - *prvptr = endptr; - return 0; - } - -/* The input value lies between some pair of column entries. */ -/* The value is greater than or equal to the smallest column entry */ -/* and less than the greatest entry, according to the dictionary */ -/* ordering we're using. */ - -/* Below, we'll use the variable LEQ to indicate whether the "middle" */ -/* element in our search is less than or equal to the input value. */ - - while(end > begin + 1) { - -/* Find the record pointer of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzektrdp_(handle, &tree, &middle, &midptr); - -/* Determine the order relation between CKEY and the column */ -/* entry at record MIDPTR. */ - - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &midptr, &c__1, &c__1, - ckey, &c_b11, &c__0, null, ckey_len)) { - -/* The column element at record MIDPTR is less than */ -/* or equal to CKEY, based on data values. */ - - leq = TRUE_; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &midptr, &c__1, & - c__1, ckey, &c_b11, &c__0, null, ckey_len)) { - -/* The column entry's value matches CKEY. We must */ -/* compare record pointers at this point. */ - - leq = midptr <= *recptr; - } else { - -/* The inequality of data values is strict. */ - - leq = FALSE_; - } - if (leq) { - -/* The middle value is less than or equal to the input */ -/* value. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than or equal to the element */ -/* having ordinal position BEGIN and strictly less than the */ -/* element having ordinal position END. */ - - } - *prvidx = begin; - zzektrdp_(handle, &tree, prvidx, prvptr); - return 0; -} /* zzekerc1_ */ - diff --git a/ext/spice/src/cspice/zzekerd1.c b/ext/spice/src/cspice/zzekerd1.c deleted file mode 100644 index c8b8a2c1f9..0000000000 --- a/ext/spice/src/cspice/zzekerd1.c +++ /dev/null @@ -1,705 +0,0 @@ -/* zzekerd1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__0 = 0; -static integer c__5 = 5; - -/* $Procedure ZZEKERD1 ( EK, LLE using record pointers, d.p., type 1 ) */ -/* Subroutine */ int zzekerd1_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dkey, integer *recptr, logical *null, integer * - prvidx, integer *prvptr) -{ - integer nrec, tree; - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *); - integer begin; - extern integer zzektrsz_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tsize; - extern logical failed_(void); - integer middle, begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer end; - logical leq; - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specifed d.p. EK column having a type 1 index, using */ -/* dictionary ordering on d.p. data values and record pointers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DKEY I Double precision key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ -/* PRVIDX O Ordinal position of predecessor of DKEY. */ -/* PRVPTR O Pointer to record containing predecessor of DKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* DKEY, */ -/* RECPTR are, respectively, a d.p. key and a pointer to */ -/* an EK record containing that key. The last column */ -/* entry less than or equal to this key is sought. */ -/* The order relation used is dictionary ordering on */ -/* the pair (DKEY, RECPTR). */ - -/* NULL is a logical flag indicating whether the input */ -/* key is null. When NULL is .TRUE., DKEY is */ -/* ignored by this routine. */ - -/* $ Detailed_Output */ - -/* PRVIDX is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to DKEY, where the order relation is */ -/* as indicated above. If the column contains */ -/* elements equal to DKEY, PRVIDX is the index of the */ -/* record designated by the input RECPTR. */ - -/* If all elements of the column are greater than */ -/* DKEY, PRVIDX is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVIDX. */ - -/* If all elements of the column are greater than */ -/* DKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the tree is empty, PRVLOC and PRVPTR are set to zero. */ -/* This case is not considered an error. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified d.p. key, within a specified segment and */ -/* column. The column must be indexed by a type 1 index. The order */ -/* relation used is dictionary ordering on ordered pairs consisting */ -/* of data values and record pointers: if the data values in two */ -/* column entries are equal, the associated record pointers determine */ -/* the order relation of the column entries. */ - -/* Type 1 indexes are implemented as DAS B*-trees. The data */ -/* pointers of an index tree contain record pointers. Therefore, the */ -/* tree implements an abstract order vector. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKLERD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-MAY-1997 (NJB) */ - -/* Errors in comparisons of items of equal value were fixed. */ -/* In such cases, items are compared according to order of */ -/* their record pointers. */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* Make sure the number of records in the segment is at least as */ -/* large as the number of entries in the index: we must not look */ -/* up any entries that don't exist! */ - - tree = coldsc[6]; - tsize = zzektrsz_(handle, &tree); - nrec = segdsc[5]; - if (tsize > nrec) { - chkin_("ZZEKERD1", (ftnlen)8); - setmsg_("Index size = # but column contains # records.", (ftnlen)45); - errint_("#", &tsize, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(SIZEMISMATCH)", (ftnlen)19); - chkout_("ZZEKERD1", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty tree gracefully. */ - - if (tsize == 0) { - *prvidx = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLED. */ - - begin = 1; - end = tsize; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzektrdp_(handle, &tree, &begin, &begptr); - zzektrdp_(handle, &tree, &end, &endptr); - -/* Compare the input value to the smallest value in the column. */ - - if (zzekscmp_(&c__3, handle, segdsc, coldsc, &begptr, &c__1, &c__2, " ", - dkey, &c__0, null, (ftnlen)1)) { - -/* The smallest entry of the column is greater than the input */ -/* value, so none of the entries are less than or equal to the */ -/* input value. */ - - *prvidx = 0; - *prvptr = 0; - return 0; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &begptr, &c__1, &c__2, - " ", dkey, &c__0, null, (ftnlen)1) && *recptr < begptr) { - -/* The smallest entry of the column is greater than the input */ -/* value, based on a comparison of record pointers, so none of the */ -/* entries are less than or equal to the input value. */ - - *prvidx = 0; - *prvptr = 0; - return 0; - } - -/* At this point, we know the input value is greater than or equal */ -/* to the smallest element of the column. */ - -/* Compare the input value to the greatest value in the column. */ - - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &endptr, &c__1, &c__2, " ", - dkey, &c__0, null, (ftnlen)1)) { - -/* The last element of the column is less than the */ -/* input value. */ - - *prvidx = tsize; - zzektrdp_(handle, &tree, prvidx, prvptr); - return 0; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &endptr, &c__1, &c__2, - " ", dkey, &c__0, null, (ftnlen)1) && endptr <= *recptr) { - -/* The last element of the column is less than or equal to the */ -/* input value, based on a comparison of record pointers. */ - - *prvidx = tsize; - *prvptr = endptr; - return 0; - } - -/* The input value lies between some pair of column entries. */ -/* The value is greater than or equal to the smallest column entry */ -/* and less than the greatest entry, according to the dictionary */ -/* ordering we're using. */ - -/* Below, we'll use the variable LEQ to indicate whether the "middle" */ -/* element in our search is less than or equal to the input value. */ - - while(end > begin + 1) { - -/* Find the record pointer of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzektrdp_(handle, &tree, &middle, &midptr); - -/* Determine the order relation between DKEY and the column */ -/* entry at record MIDPTR. */ - - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &midptr, &c__1, &c__2, - " ", dkey, &c__0, null, (ftnlen)1)) { - -/* The column element at record MIDPTR is strictly less than */ -/* IKEY, based on data values. */ - - leq = TRUE_; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &midptr, &c__1, & - c__2, " ", dkey, &c__0, null, (ftnlen)1)) { - -/* The column entry's value matches DKEY. We must */ -/* compare record pointers at this point. */ - - leq = midptr <= *recptr; - } else { - -/* The inequality of data values is strict. */ - - leq = FALSE_; - } - if (leq) { - -/* The middle value is less than or equal to the input */ -/* value. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than or equal to the element */ -/* having ordinal position BEGIN and strictly less than the */ -/* element having ordinal position END. */ - - } - *prvidx = begin; - zzektrdp_(handle, &tree, prvidx, prvptr); - return 0; -} /* zzekerd1_ */ - diff --git a/ext/spice/src/cspice/zzekeri1.c b/ext/spice/src/cspice/zzekeri1.c deleted file mode 100644 index 9e174c6563..0000000000 --- a/ext/spice/src/cspice/zzekeri1.c +++ /dev/null @@ -1,704 +0,0 @@ -/* zzekeri1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static doublereal c_b12 = 0.; -static integer c__5 = 5; - -/* $Procedure ZZEKERI1 ( EK, LLE using record pointers, integer, type 1 ) */ -/* Subroutine */ int zzekeri1_(integer *handle, integer *segdsc, integer * - coldsc, integer *ikey, integer *recptr, logical *null, integer * - prvidx, integer *prvptr) -{ - integer nrec, tree; - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *); - integer begin; - extern integer zzektrsz_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tsize; - extern logical failed_(void); - integer middle, begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer end; - logical leq; - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specifed integer EK column having a type 1 index, using */ -/* dictionary ordering on integer data values and record pointers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IKEY I Integer key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ -/* PRVIDX O Ordinal position of predecessor of IKEY. */ -/* PRVPTR O Pointer to record containing predecessor of IKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* IKEY, */ -/* RECPTR are, respectively, an integer key and a pointer to */ -/* an EK record containing that key. The last column */ -/* entry less than or equal to this key is sought. */ -/* The order relation used is dictionary ordering on */ -/* the pair (IKEY, RECPTR). */ - -/* NULL is a logical flag indicating whether the input */ -/* key is null. When NULL is .TRUE., IKEY is */ -/* ignored by this routine. */ - -/* $ Detailed_Output */ - -/* PRVIDX is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to IKEY, where the order relation is */ -/* as indicated above. If the column contains */ -/* elements equal to IKEY, PRVIDX is the index of the */ -/* record designated by the input RECPTR. */ - -/* If all elements of the column are greater than */ -/* IKEY, PRVIDX is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVIDX. */ - -/* If all elements of the column are greater than */ -/* IKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the tree is empty, PRVIDX and PRVPTR are set to zero. */ -/* This case is not considered an error. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified integer key, within a specified segment and */ -/* column. The column must be indexed by a type 1 index. The order */ -/* relation used is dictionary ordering on ordered pairs consisting */ -/* of data values and record pointers: if the data values in two */ -/* column entries are equal, the associated record pointers determine */ -/* the order relation of the column entries. */ - -/* Type 1 indexes are implemented as DAS B*-trees. The data */ -/* pointers of an index tree contain record pointers. Therefore, the */ -/* tree implements an abstract order vector. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKLERI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 07-FEB-1997 (NJB) */ - -/* Errors in comparisons of items of equal value were fixed. */ -/* In such cases, items are compared according to order of */ -/* their record pointers. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* Make sure the number of records in the segment is at least as */ -/* large as the number of entries in the index: we must not look */ -/* up any entries that don't exist! */ - - tree = coldsc[6]; - tsize = zzektrsz_(handle, &tree); - nrec = segdsc[5]; - if (tsize > nrec) { - chkin_("ZZEKERI1", (ftnlen)8); - setmsg_("Index size = # but column contains # records.", (ftnlen)45); - errint_("#", &tsize, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(SIZEMISMATCH)", (ftnlen)19); - chkout_("ZZEKERI1", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty tree gracefully. */ - - if (tsize == 0) { - *prvidx = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLED. */ - - begin = 1; - end = tsize; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzektrdp_(handle, &tree, &begin, &begptr); - zzektrdp_(handle, &tree, &end, &endptr); - -/* Compare the input value to the smallest value in the column. */ - - if (zzekscmp_(&c__3, handle, segdsc, coldsc, &begptr, &c__1, &c__3, " ", & - c_b12, ikey, null, (ftnlen)1)) { - -/* The smallest entry of the column is greater than the input */ -/* value, so none of the entries are less than or equal to the */ -/* input value. */ - - *prvidx = 0; - *prvptr = 0; - return 0; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &begptr, &c__1, &c__3, - " ", &c_b12, ikey, null, (ftnlen)1) && *recptr < begptr) { - -/* The smallest entry of the column is greater than the input */ -/* value, based on a comparison of record pointers, so none of the */ -/* entries are less than or equal to the input value. */ - - *prvidx = 0; - *prvptr = 0; - return 0; - } - -/* At this point, we know the input value is greater than or equal */ -/* to the smallest element of the column. */ - -/* Compare the input value to the greatest value in the column. */ - - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &endptr, &c__1, &c__3, " ", & - c_b12, ikey, null, (ftnlen)1)) { - -/* The last element of the column is less than the */ -/* input value. */ - - *prvidx = tsize; - zzektrdp_(handle, &tree, prvidx, prvptr); - return 0; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &endptr, &c__1, &c__3, - " ", &c_b12, ikey, null, (ftnlen)1) && endptr <= *recptr) { - -/* The last element of the column is less than or equal to the */ -/* input value, based on a comparison of record pointers. */ - - *prvidx = tsize; - *prvptr = endptr; - return 0; - } - -/* The input value lies between some pair of column entries. */ -/* The value is greater than or equal to the smallest column entry */ -/* and less than the greatest entry, according to the dictionary */ -/* ordering we're using. */ - -/* Below, we'll use the variable LEQ to indicate whether the "middle" */ -/* element in our search is less than or equal to the input value. */ - - while(end > begin + 1) { - -/* Find the record pointer of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzektrdp_(handle, &tree, &middle, &midptr); - -/* Determine the order relation between IKEY and the column */ -/* entry at record MIDPTR. */ - - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &midptr, &c__1, &c__3, - " ", &c_b12, ikey, null, (ftnlen)1)) { - -/* The column element at record MIDPTR is strictly less than */ -/* IKEY, based on data values. */ - - leq = TRUE_; - } else if (zzekscmp_(&c__1, handle, segdsc, coldsc, &midptr, &c__1, & - c__3, " ", &c_b12, ikey, null, (ftnlen)1)) { - -/* The column entry's value matches IKEY. We must */ -/* compare record pointers at this point. */ - - leq = midptr <= *recptr; - } else { - -/* The inequality of data values is strict. */ - - leq = FALSE_; - } - if (leq) { - -/* The middle value is less than or equal to the input */ -/* value. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than or equal to the element */ -/* having ordinal position BEGIN and strictly less than the */ -/* element having ordinal position END. */ - - } - *prvidx = begin; - zzektrdp_(handle, &tree, prvidx, prvptr); - return 0; -} /* zzekeri1_ */ - diff --git a/ext/spice/src/cspice/zzekesiz.c b/ext/spice/src/cspice/zzekesiz.c deleted file mode 100644 index f48bd94e0b..0000000000 --- a/ext/spice/src/cspice/zzekesiz.c +++ /dev/null @@ -1,453 +0,0 @@ -/* zzekesiz.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKESIZ ( EK, element entry size ) */ -integer zzekesiz_(integer *handle, integer *segdsc, integer *coldsc, integer * - recptr) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, - ftnlen); - integer class__, recno, segno; - extern /* Subroutine */ int dashlu_(integer *, integer *); - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern integer zzeksz04_(integer *, integer *, integer *, integer *), - zzeksz05_(integer *, integer *, integer *, integer *), zzeksz06_( - integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Return the size of a specified column entry. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column containing */ -/* the entry whose size is requested. */ - -/* RECPTR is a pointer to the EK record containing the */ -/* column entry of interest. */ - -/* $ Detailed_Output */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This utility centralizes the commonly performed function of */ -/* determining the element count of a column entry. */ - -/* $ Examples */ - -/* See EKRCEI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Initialize the function's return value. */ - - ret_val = 0; - -/* Use discovery check-in. */ - -/* Delegate the problem to the routine of the appropriate class. */ -/* The first three classes are scalars. */ - - - class__ = coldsc[0]; - if (class__ == 1) { - ret_val = 1; - } else if (class__ == 2) { - ret_val = 1; - } else if (class__ == 3) { - ret_val = 1; - } else if (class__ == 4) { - ret_val = zzeksz04_(handle, segdsc, coldsc, recptr); - } else if (class__ == 5) { - ret_val = zzeksz05_(handle, segdsc, coldsc, recptr); - } else if (class__ == 6) { - ret_val = zzeksz06_(handle, segdsc, coldsc, recptr); - } else if (class__ == 7) { - ret_val = 1; - } else if (class__ == 8) { - ret_val = 1; - } else if (class__ == 9) { - ret_val = 1; - } else { - -/* This is an unsupported column class. */ - - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - recno = zzekrp2n_(handle, &segdsc[1], recptr); - segno = segdsc[1]; - chkin_("ZZEKESIZ", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported int" - "eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)113); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKESIZ", (ftnlen)8); - return ret_val; - } - return ret_val; -} /* zzekesiz_ */ - diff --git a/ext/spice/src/cspice/zzekff01.c b/ext/spice/src/cspice/zzekff01.c deleted file mode 100644 index e5ba8311c5..0000000000 --- a/ext/spice/src/cspice/zzekff01.c +++ /dev/null @@ -1,886 +0,0 @@ -/* zzekff01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__3 = 3; -static integer c__254 = 254; -static integer c__1014 = 1014; -static integer c__126 = 126; - -/* $Procedure ZZEKFF01 ( EK, finish fast load, segment type 1 ) */ -/* Subroutine */ int zzekff01_(integer *handle, integer *segno, integer * - rcptrs) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base, tree; - extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *, - integer *), zzekmloc_(integer *, integer *, integer *, integer *), - zzekpgpg_(integer *, integer *, integer *, integer *), zzekpgwi_( - integer *, integer *, integer *), zzektrit_(integer *, integer *); - integer i__, j, p, ipage[256], mbase, npage, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, nrows, adrbuf[100], nr; - extern logical return_(void); - integer addrss, colidx, colord[100], pagloc, remain, rpsize, segdsc[24], - stkbas, stkhan, stkseg; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasrdi_(integer *, integer *, integer *, integer *), - cleari_(integer *, integer *), dasudi_(integer *, integer *, - integer *, integer *); - integer col, loc, nrp, row; - extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Complete a fast load operation on a new type 1 E-kernel segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RCPTRS I-O Record pointers. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ -/* A `begin segment for fast load' operation must */ -/* have already been performed for the designated */ -/* segment. */ - -/* SEGNO is the number of the type 1 segment to complete. */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array is obtained as an output */ -/* from EKIFLD, the routine called to initiate a */ -/* fast load. */ - -/* $ Detailed_Output */ - -/* WORK is the input work space array, after use. WORK */ -/* will generally be modified by this routine. */ - -/* See the $Particulars section for a description of the */ -/* effects of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an attempt is made to finish a segment other than the */ -/* one last initialized by EKIFLD, the error SPICE(WRONGSEGMENT) */ -/* is signalled. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine completes a type 1 EK segment after the data has been */ -/* written via the fast column loader routines. */ - -/* $ Examples */ - -/* See EKFFLD. */ - -/* $ Restrictions */ - -/* 1) Only one segment can be created at a time using the fast */ -/* load routines. */ - -/* 2) No other EK operation may interrupt a fast load. For */ -/* example, it is not valid to issue a query while a fast load */ -/* is in progress. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKFF01", (ftnlen)8); - } - -/* Dig the handle and segment number out of the EK stack. If the */ -/* stacked values don't match the inputs HANDLE and SEGNO, we've */ -/* got trouble. */ - - zzeksrd_(&c__1, &c__1, &stkhan); - zzeksrd_(&c__2, &c__2, &stkseg); - if (stkhan != *handle || stkseg != *segno) { - setmsg_("Attempt to finish fast load of wrong segment. Input segmen" - "t number is #; stacked segment number is #. Input handle is" - " #; stacked handle is #.", (ftnlen)143); - errint_("#", segno, (ftnlen)1); - errint_("#", &stkseg, (ftnlen)1); - errint_("#", handle, (ftnlen)1); - errint_("#", &stkhan, (ftnlen)1); - sigerr_("SPICE(WRONGSEGMENT)", (ftnlen)19); - chkout_("ZZEKFF01", (ftnlen)8); - return 0; - } - -/* Look up the segment descriptor for the indicated segment. Find */ -/* out how many rows and columns the segment contains. */ - - zzekmloc_(handle, segno, &p, &mbase); - i__1 = mbase + 1; - i__2 = mbase + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - nrows = segdsc[5]; - ncols = segdsc[4]; - -/* Determine the order in which the columns were added. The order */ -/* may differ from that in which the columns were declared. The */ -/* ordinal position of each column is stored on the stack right */ -/* before its address data. COLORD will map ordinal positions given */ -/* by a column declaration to ordinal positions on the stack. */ - - - i__1 = ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - loc = (i__ - 1) * (nrows + 1) + 3; - zzeksrd_(&loc, &loc, &colidx); - colord[(i__2 = colidx - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("colord" - , i__2, "zzekff01_", (ftnlen)240)] = i__; - } - -/* We'll need to create a record pointer structure for each row */ -/* in the segment. We compute the number of record pointers that */ -/* can fit on one page. We also compute the number of pages we'll */ -/* need to hold the pointers. */ - - rpsize = ncols + 2; - nrp = 254 / rpsize; - npage = (nrows + nrp - 1) / nrp; - -/* We'll write out record pointers a pageful at a time. Each */ -/* record pointer is initialized to indicate that the record is */ -/* old, and that there is no corresponding modified record. */ - - remain = nrows; - recno = 0; - i__1 = npage; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the base address of the current page. The address */ -/* can be derived from the address of the first record pointer */ -/* structure on the page. */ - - addrss = rcptrs[recno] + 1; - zzekpgpg_(&c__3, &addrss, &p, &pbase); - cleari_(&c__254, ipage); - -/* NR is the number of record pointers we'll write to this page. */ - - nr = min(nrp,remain); - i__2 = nr; - for (j = 1; j <= i__2; ++j) { - -/* Initialize the modified record pointer and status for */ -/* each record pointer on the page. */ - - base = (j - 1) * rpsize; - ipage[(i__3 = base) < 256 && 0 <= i__3 ? i__3 : s_rnge("ipage", - i__3, "zzekff01_", (ftnlen)285)] = 1; - ipage[(i__3 = base + 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("ipage" - , i__3, "zzekff01_", (ftnlen)286)] = -1; - } - -/* For each column, take NR addresses off the stack and */ -/* write them into the page. */ - - i__2 = ncols; - for (col = 1; col <= i__2; ++col) { - -/* The stack starts out with the target file handle and */ -/* segment number. Next comes the data for each column. */ -/* Each column is identified by its ordinal position. The */ -/* addresses for the data of each column follow. The addresses */ -/* for each column are stored contiguously. */ - - j = colord[(i__3 = col - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge( - "colord", i__3, "zzekff01_", (ftnlen)302)]; - stkbas = (j - 1) * (nrows + 1) + 3; - loc = stkbas + recno; - i__3 = loc + 1; - i__4 = loc + nr; - zzeksrd_(&i__3, &i__4, adrbuf); - i__3 = nr; - for (row = 1; row <= i__3; ++row) { - base = (row - 1) * rpsize; - pagloc = base + 2 + col; - ipage[(i__4 = pagloc - 1) < 256 && 0 <= i__4 ? i__4 : s_rnge( - "ipage", i__4, "zzekff01_", (ftnlen)312)] = adrbuf[( - i__5 = row - 1) < 100 && 0 <= i__5 ? i__5 : s_rnge( - "adrbuf", i__5, "zzekff01_", (ftnlen)312)]; - } - } - -/* Write out the initialized pointer page. */ - - zzekpgwi_(handle, &p, ipage); - recno += nr; - remain -= nr; - } - -/* Create the record pointer tree for this segment. */ - - zzektrit_(handle, &tree); - zzektr1s_(handle, &tree, &nrows, rcptrs); - -/* Update the record tree pointer and row count in the segment */ -/* descriptor. Set the records of the last DAS words in use */ -/* to their maximum values, to ensure allocation of new pages */ -/* if further writes are done. */ - - zzekmloc_(handle, segno, &p, &base); - i__1 = base + 7; - i__2 = base + 7; - dasudi_(handle, &i__1, &i__2, &tree); - i__1 = base + 6; - i__2 = base + 6; - dasudi_(handle, &i__1, &i__2, &nrows); - i__1 = base + 19; - i__2 = base + 19; - dasudi_(handle, &i__1, &i__2, &c__1014); - i__1 = base + 20; - i__2 = base + 20; - dasudi_(handle, &i__1, &i__2, &c__126); - i__1 = base + 21; - i__2 = base + 21; - dasudi_(handle, &i__1, &i__2, &c__254); - chkout_("ZZEKFF01", (ftnlen)8); - return 0; -} /* zzekff01_ */ - diff --git a/ext/spice/src/cspice/zzekfrx.c b/ext/spice/src/cspice/zzekfrx.c deleted file mode 100644 index 3b63204a4a..0000000000 --- a/ext/spice/src/cspice/zzekfrx.c +++ /dev/null @@ -1,661 +0,0 @@ -/* zzekfrx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKFRX ( EK, find record in index ) */ -/* Subroutine */ int zzekfrx_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *pos) -{ - char cval[1024]; - doublereal dval; - integer ival; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzeklerc_(integer *, integer *, integer *, - char *, integer *, logical *, integer *, integer *, ftnlen), - zzeklerd_(integer *, integer *, integer *, doublereal *, integer * - , logical *, integer *, integer *), zzekleri_(integer *, integer * - , integer *, integer *, integer *, logical *, integer *, integer * - ), chkin_(char *, ftnlen); - integer recno, cvlen; - logical found; - integer dtype, cmplen; - extern logical return_(void); - logical isnull; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errfnm_(char *, integer *, ftnlen); - integer prvptr; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrsc_(integer *, - integer *, integer *, integer *, integer *, integer *, char *, - logical *, logical *, ftnlen), zzekrsd_(integer *, integer *, - integer *, integer *, integer *, doublereal *, logical *, logical - *), zzekrsi_(integer *, integer *, integer *, integer *, integer * - , integer *, logical *, logical *); - -/* $ Abstract */ - -/* Find the ordinal position of a specified record in a specified, */ -/* indexed EK column. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Pointer to record to locate. */ -/* POS O Ordinal position of record. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column to be searched. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* RECPTR is a pointer to the record whose ordinal position */ -/* is to be found. */ - -/* $ Detailed_Output */ - -/* POS is the ordinal position in the specified column */ -/* of the input record, where the order relation is */ -/* specified by the column's index. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Various EK write operations require the capability of locating */ -/* the index key that maps to a given record number. An example is */ -/* updating a column's index to reflect deletion of a specified */ -/* record: the key that maps to the record must be deleted. */ -/* Locating this key is the inverse of the problem that the index */ -/* is meant to solve. */ - -/* $ Examples */ - -/* See ZZEKIXDL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 31-MAY-2010 (NJB) */ - -/* Bug fix: substring bound out-of-range violation */ -/* in reference to local variable CVAL has been */ -/* corrected. This error could occur if the a */ -/* class 3 column entry had length exceeding MAXSTR. */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKFRX", (ftnlen)7); - } - -/* Determine the data type of the column, and look up the value */ -/* associated with RECPTR. */ - - dtype = coldsc[1]; - if (dtype == 1) { - zzekrsc_(handle, segdsc, coldsc, recptr, &c__1, &cvlen, cval, &isnull, - &found, (ftnlen)1024); - if (found && ! isnull) { - cmplen = min(cvlen,1024); - } else { - cmplen = 0; - } - } else if (dtype == 2 || dtype == 4) { - zzekrsd_(handle, segdsc, coldsc, recptr, &c__1, &dval, &isnull, & - found); - } else if (dtype == 3) { - zzekrsi_(handle, segdsc, coldsc, recptr, &c__1, &ival, &isnull, & - found); - } else { - dashlu_(handle, &unit); - setmsg_("File = #; COLIDX = #. Unrecognized data type code # found i" - "n descriptor.", (ftnlen)72); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); - chkout_("ZZEKFRX", (ftnlen)7); - return 0; - } - if (! found) { - -/* We have a most heinous situation. We should always be able */ -/* to find the value associated with a record. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("File = #; RECNO = #; COLIDX = #. Column entry was not found" - ". This probably indicates a corrupted file or a bug in the " - "EK code.", (ftnlen)127); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); - chkout_("ZZEKFRX", (ftnlen)7); - return 0; - } - -/* Find the last column entry less than or equal to the one */ -/* associated with the input record, where the order relation is */ -/* dictionary ordering on (, ) pairs. */ -/* These ordered pairs are distinct, even if the column entries */ -/* are not. Therefore, the ordinal position POS will actually be */ -/* the ordinal position of our record. */ - - if (dtype == 1) { - zzeklerc_(handle, segdsc, coldsc, cval, recptr, &isnull, pos, &prvptr, - cmplen); - } else if (dtype == 2 || dtype == 4) { - zzeklerd_(handle, segdsc, coldsc, &dval, recptr, &isnull, pos, & - prvptr); - } else { - -/* The data type is INT. (We've already checked for invalid */ -/* types.) */ - - zzekleri_(handle, segdsc, coldsc, &ival, recptr, &isnull, pos, & - prvptr); - } - if (prvptr != *recptr) { - -/* Big problem. This should never happen. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("File = #; RECNO = #; COLIDX = #. Record that was last less" - " than or equal to RECNO was not equal to RECNO. This probab" - "ly indicates a corrupted file or a bug in the EK code.", ( - ftnlen)174); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); - chkout_("ZZEKFRX", (ftnlen)7); - return 0; - } - chkout_("ZZEKFRX", (ftnlen)7); - return 0; -} /* zzekfrx_ */ - diff --git a/ext/spice/src/cspice/zzekgcdp.c b/ext/spice/src/cspice/zzekgcdp.c deleted file mode 100644 index 307350882a..0000000000 --- a/ext/spice/src/cspice/zzekgcdp.c +++ /dev/null @@ -1,570 +0,0 @@ -/* zzekgcdp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKGCDP ( EK, get column data pointer ) */ -/* Subroutine */ int zzekgcdp_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *datptr) -{ - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer colidx, ptrloc; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Return the data pointer for a specified EK column entry. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* DATPTR O Data pointer of column entry. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry whose data pointer is desired. */ - - -/* $ Detailed_Output */ - -/* DATPTR is the data pointer of the specified column entry. */ -/* When DATPTR is positive, it represents a pointer */ -/* to a data value. The interpretation of the */ -/* pointer depends on the class of the column entry. */ -/* DATPTR may also take on the distinguished values */ - -/* UNINIT (indicated uninitialized entry) */ -/* NULL (indicated null entry) */ -/* NOBACK (indicated uninitialized backup entry) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine hides details of column entry data pointer access. */ - -/* $ Examples */ - -/* See ZZEKRFIL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKGCDP", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " - "EK = #", (ftnlen)65); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &ncols, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKGCDP", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, datptr); - return 0; -} /* zzekgcdp_ */ - diff --git a/ext/spice/src/cspice/zzekgei.c b/ext/spice/src/cspice/zzekgei.c deleted file mode 100644 index 1dfaad9381..0000000000 --- a/ext/spice/src/cspice/zzekgei.c +++ /dev/null @@ -1,274 +0,0 @@ -/* zzekgei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__5 = 5; - -/* $Procedure ZZEKGEI ( Private: EK, get encoded integer ) */ -/* Subroutine */ int zzekgei_(integer *handle, integer *addrss, integer *ival) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - char cval[5]; - extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen), prtdec_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Get an encoded integer at a specifed address from a character */ -/* data page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* ADDRSS I DAS character address to read encoded value from. */ -/* IVAL O Decoded integer value. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for read or */ -/* write access. */ - -/* ADDRSS is the DAS character start address from which an */ -/* integer, encoded as a string, is to be read. */ -/* An encoded integer occupies ENCSIZ characters, */ -/* where the parameter ENCSIZ is defined in the */ -/* include file ekdatpag.inc. */ - -/* $ Detailed_Output */ - -/* IVAL is an integer value obtained by decoding an */ -/* encoded integer read from the specified */ -/* location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the DAS character address range */ - -/* ADDRSS .. ADDRSS+ENCSIZ-1 */ - -/* is not a range of DAS character addresses that have been */ -/* initialized, the error wll be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If the character data starting at the specified address */ -/* does not represent an encoded integer, the error wll be */ -/* diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine should be used for all EK applications reading */ -/* integer values that have been encoded as characters. This */ -/* routine expects the encoding to have been done by ZZEKSEI. */ - -/* $ Examples */ - -/* See ZZEKRD03. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Discovery error handling should be used in this utility. */ - - -/* Read the encoded value. The value is represented by a string of */ -/* characters. */ - - i__1 = *addrss + 4; - dasrdc_(handle, addrss, &i__1, &c__1, &c__5, cval, (ftnlen)5); - -/* Decode the number. */ - - prtdec_(cval, ival, (ftnlen)5); - return 0; -} /* zzekgei_ */ - diff --git a/ext/spice/src/cspice/zzekgfwd.c b/ext/spice/src/cspice/zzekgfwd.c deleted file mode 100644 index db45377a15..0000000000 --- a/ext/spice/src/cspice/zzekgfwd.c +++ /dev/null @@ -1,459 +0,0 @@ -/* zzekgfwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKGFWD ( EK, get forward pointer for data page ) */ -/* Subroutine */ int zzekgfwd_(integer *handle, integer *type__, integer *p, - integer *fward) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *); - doublereal dpptr; - extern logical failed_(void); - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dasrdi_(integer *, integer *, integer *, integer *) - , zzekgei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Return the forward data pointer for a specified EK data page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TYPE I Data type of page. */ -/* P I Page number. */ -/* FWARD O Forward data pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TYPE is the data type of the desired page. */ - -/* P is the page number of the allocated page. This */ -/* number is recognized by the EK paged access */ -/* routines. */ - -/* $ Detailed_Output */ - -/* FWARD is a forward data pointer. This is the number */ -/* of a data page on which the last column entry */ -/* on page P is continued. */ - -/* FWARD may overwrite P. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TYPE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine returns the forward data pointer of the specified EK */ -/* data page. The value of the pointer is a page number. */ - -/* $ Examples */ - -/* See ZZEKDE03. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Look up the base address of the page. */ - - zzekpgbs_(type__, p, &base); - if (failed_()) { - return 0; - } - if (*type__ == 1) { - -/* Get the encoded pointer. */ - - i__1 = base + 1015; - zzekgei_(handle, &i__1, fward); - } else if (*type__ == 2) { - -/* Convert the d.p. pointer to integer type. */ - - i__1 = base + 127; - i__2 = base + 127; - dasrdd_(handle, &i__1, &i__2, &dpptr); - *fward = i_dnnt(&dpptr); - } else { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, ZZEKPGBS would have complained. */ - - i__1 = base + 255; - i__2 = base + 255; - dasrdi_(handle, &i__1, &i__2, fward); - } - return 0; -} /* zzekgfwd_ */ - diff --git a/ext/spice/src/cspice/zzekglnk.c b/ext/spice/src/cspice/zzekglnk.c deleted file mode 100644 index f3cdeebfa4..0000000000 --- a/ext/spice/src/cspice/zzekglnk.c +++ /dev/null @@ -1,455 +0,0 @@ -/* zzekglnk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKGLNK ( EK, get link count for data page ) */ -/* Subroutine */ int zzekglnk_(integer *handle, integer *type__, integer *p, - integer *nlinks) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *); - doublereal dplnk; - extern logical failed_(void); - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dasrdi_(integer *, integer *, integer *, integer *) - , zzekgei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Return the link count for a specified EK data page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TYPE I Data type of page. */ -/* P I Page number. */ -/* NLINKS O Number of links to page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TYPE is the data type of the desired page. */ - -/* P is the page number of the allocated page. This */ -/* number is recognized by the EK paged access */ -/* routines. */ - -/* $ Detailed_Output */ - -/* NLINKS is the currently held number of links to the */ -/* specified data page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TYPE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine centralizes EK data page link count accesses. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Look up the base address of the page. */ - - zzekpgbs_(type__, p, &base); - if (failed_()) { - return 0; - } - if (*type__ == 1) { - -/* Look up the encoded count. */ - - i__1 = base + 1020; - zzekgei_(handle, &i__1, nlinks); - } else if (*type__ == 2) { - -/* Convert the encoded count to integer type. */ - - i__1 = base + 128; - i__2 = base + 128; - dasrdd_(handle, &i__1, &i__2, &dplnk); - *nlinks = i_dnnt(&dplnk); - } else { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, ZZEKPGBS would have complained. */ - - i__1 = base + 256; - i__2 = base + 256; - dasrdi_(handle, &i__1, &i__2, nlinks); - } - return 0; -} /* zzekglnk_ */ - diff --git a/ext/spice/src/cspice/zzekgrcp.c b/ext/spice/src/cspice/zzekgrcp.c deleted file mode 100644 index 3df7408834..0000000000 --- a/ext/spice/src/cspice/zzekgrcp.c +++ /dev/null @@ -1,375 +0,0 @@ -/* zzekgrcp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKGRCP ( EK, get record companion pointer ) */ -/* Subroutine */ int zzekgrcp_(integer *handle, integer *recptr, integer *ptr) -{ - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer loc; - -/* $ Abstract */ - -/* Get the companion pointer of a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* RECPTR I Record pointer. */ -/* PTR O Pointer to companion of specified EK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* RECPTRC is a pointer to the record whose companion pointer */ -/* is desired. */ - -/* $ Detailed_Output */ - -/* PTR is a pointer to the companion record of the */ -/* specified input record. If the input record */ -/* belongs to a shadowed EK, the companion record */ -/* is the corresponding backup record. If the input */ -/* record is a backup record, the companion record */ -/* is the corresponding source record. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine sets the companion record pointer of a specified EK */ -/* record. */ - -/* $ Examples */ - -/* See EKROLL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Compute the companion pointer and set the pointer. */ - - loc = *recptr + 2; - dasrdi_(handle, &loc, &loc, ptr); - return 0; -} /* zzekgrcp_ */ - diff --git a/ext/spice/src/cspice/zzekgrs.c b/ext/spice/src/cspice/zzekgrs.c deleted file mode 100644 index 1c02ba1894..0000000000 --- a/ext/spice/src/cspice/zzekgrs.c +++ /dev/null @@ -1,250 +0,0 @@ -/* zzekgrs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKGRS ( EK, get record status ) */ -/* Subroutine */ int zzekgrs_(integer *handle, integer *recptr, integer * - status) -{ - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer loc; - -/* $ Abstract */ - -/* Return the status of a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* RECPTR I Record pointer. */ -/* STATUS O Status of specified EK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* RECPTR is a pointer to the record whose status is desired. */ - -/* $ Detailed_Output */ - -/* STATUS is the status word of the specified record. See */ -/* the include file ekrecptr.inc for values and */ -/* meanings. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine hides details of status word access. */ - -/* $ Examples */ - -/* See EKCOMM. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Compute the status word location, and read the status. */ - - loc = *recptr + 1; - dasrdi_(handle, &loc, &loc, status); - return 0; -} /* zzekgrs_ */ - diff --git a/ext/spice/src/cspice/zzekif01.c b/ext/spice/src/cspice/zzekif01.c deleted file mode 100644 index 9768f7f2e4..0000000000 --- a/ext/spice/src/cspice/zzekif01.c +++ /dev/null @@ -1,630 +0,0 @@ -/* zzekif01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; -static logical c_false = FALSE_; - -/* $Procedure ZZEKIF01 ( EK, initialize type 1 segment for fast load ) */ -/* Subroutine */ int zzekif01_(integer *handle, integer *segno, integer * - rcptrs) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzeksdec_(integer *), zzeksdsc_(integer *, - integer *, integer *), zzekspsh_(integer *, integer *), zzekstop_( - integer *); - integer i__, j, p, npage, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, nrows, nr, segdsc[24], remain; - extern logical return_(void); - integer rpsize; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer nrp, top; - extern /* Subroutine */ int zzekaps_(integer *, integer *, integer *, - logical *, integer *, integer *); - -/* $ Abstract */ - -/* Initialize a new type 1 EK segment to allow fast loading. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RCPTRS O Array of record pointers. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ -/* A new type 1 segment is to be created in this file */ -/* via a fast load. The segment's metadata has */ -/* already been set up by EKBSEG. */ - -/* SEGNO is the number of the segment to prepare for a */ -/* fast load. */ - -/* $ Detailed_Output */ - -/* RCPTRS is an array of record pointers for the input */ -/* segment. This array must not be modified by the */ -/* caller. */ - -/* The array RCPTRS must be passed as an input to */ -/* each column addition routine called while */ -/* writing the specified segment. */ - -/* RCPTRS must be declared with dimension equal to */ -/* the number of rows in the segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine carries out the type-1-specific preparation for */ -/* populating a type 1 EK segment with data via the fast column */ -/* loader routines. This routine expects the segment's metadata to */ -/* already have been written by EKBSEG. */ - -/* $ Examples */ - -/* See EKIFLD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */ - -/* Added Restrictions section to header. Changed */ -/* previous version line's product from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKIF01", (ftnlen)8); - } - -/* Read in the segment descriptor. */ - - zzeksdsc_(handle, segno, segdsc); - ncols = segdsc[4]; - nrows = segdsc[5]; - -/* Empty the EK scratch area stack. */ - - zzekstop_(&top); - zzeksdec_(&top); - -/* Push the handle and segment number onto the stack. */ - - zzekspsh_(&c__1, handle); - zzekspsh_(&c__1, segno); - -/* The segment will require a record pointer structure for each row */ -/* in the segment. Right now, all we're going to do is allocate */ -/* integer pages to hold these structures and save the base */ -/* addresses of each structure. */ - -/* We compute the number of record pointers that can fit on one page. */ -/* We also compute the number of pages we'll need to hold the */ -/* pointers. */ - - rpsize = ncols + 2; - nrp = 254 / rpsize; - npage = (nrows + nrp - 1) / nrp; - -/* We'll compute addresses of record pointers a pageful at a time. */ - - remain = nrows; - recno = 0; - i__1 = npage; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Allocate a page to hold the record pointers. A page from */ -/* the free list is acceptable, hence the argument .FALSE. */ -/* passed to ZZEKAPS. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase); - -/* NR is the number of record pointers we'll eventually write to */ -/* this page. */ - - nr = min(nrp,remain); - i__2 = nr; - for (j = 1; j <= i__2; ++j) { - -/* Record the base address of the current record pointer */ -/* in the record pointer array. */ - - base = (j - 1) * rpsize; - rcptrs[recno + j - 1] = pbase + base; - } - recno += nr; - remain -= nr; - } - chkout_("ZZEKIF01", (ftnlen)8); - return 0; -} /* zzekif01_ */ - diff --git a/ext/spice/src/cspice/zzekif02.c b/ext/spice/src/cspice/zzekif02.c deleted file mode 100644 index 7183ec3a16..0000000000 --- a/ext/spice/src/cspice/zzekif02.c +++ /dev/null @@ -1,737 +0,0 @@ -/* zzekif02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static logical c_false = FALSE_; - -/* $Procedure ZZEKIF02 ( EK, initialize type 2 segment for fast load ) */ -/* Subroutine */ int zzekif02_(integer *handle, integer *segno) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Local variables */ - integer base, page[256]; - extern /* Subroutine */ int zzekmloc_(integer *, integer *, integer *, - integer *); - integer i__, p, mbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer class__, ncols, nrows, dscbas; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer segdsc[24]; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - extern logical return_(void); - integer offset; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzekaps_(integer *, integer *, integer *, logical *, - integer *, integer *); - -/* $ Abstract */ - -/* Initialize a new type 2 EK segment to allow fast loading. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Class 7 Parameters */ - -/* ekclas07.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 7 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 7 metadata array: */ - - -/* End Include Section: EK Column Class 7 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 8 Parameters */ - -/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 8 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 8 metadata array: */ - - -/* End Include Section: EK Column Class 8 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 9 Parameters */ - -/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 9 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 9 metadata array: */ - - -/* End Include Section: EK Column Class 9 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ -/* A new type 2 segment is to be created in this file */ -/* via a fast load. The segment's metadata has */ -/* already been set up by EKBSEG. */ - -/* SEGNO is the number of the segment to prepare for a */ -/* fast load. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine carries out the type-2-specific preparation for */ -/* populating a type 2 EK segment with data via the fast column */ -/* loader routines. This routine expects the segment's metadata to */ -/* already have been written by EKBSEG. */ - -/* This routine expects the segment to contain columns having class */ -/* 7, 8, or 9. */ - -/* $ Examples */ - -/* See EKIFLD. */ - -/* $ Restrictions */ - -/* 1) Assumes total number of words required for column metadata */ -/* is no greater than IPSIZE. Currently, with a maximum of 100 */ -/* columns and a maximum metadata size of 2 words per column, */ -/* this condition is met. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKIF02", (ftnlen)8); - } - -/* Read in the segment descriptor. */ - - zzekmloc_(handle, segno, page, &mbase); - i__1 = mbase + 1; - i__2 = mbase + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - ncols = segdsc[4]; - nrows = segdsc[5]; - -/* Allocate space for column metadata. We assume that one page */ -/* of IPSIZE integers is enough room. */ - - zzekaps_(handle, segdsc, &c__3, &c_false, &p, &base); - offset = base; - i__1 = ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Read the class from the descriptor of the Ith column directly */ -/* from the file. We'll need the descriptor's address in order to */ -/* update the descriptor in the file. */ - - dscbas = mbase + 24 + (i__ - 1) * 11; - i__2 = dscbas + 1; - i__3 = dscbas + 1; - dasrdi_(handle, &i__2, &i__3, &class__); - -/* Update the file. Set the column descriptor's metadata pointer */ -/* to the base address of the metadata area. */ - - i__2 = dscbas + 10; - i__3 = dscbas + 10; - dasudi_(handle, &i__2, &i__3, &offset); - -/* Increment the metadata offset by the size of the metadata */ -/* for the current column. The classes of interest range from */ -/* 7 to 9. */ - - if (class__ == 7) { - offset += 2; - } else if (class__ == 8) { - offset += 2; - } else if (class__ == 9) { - offset += 2; - } else { - setmsg_("Class # is not supported.", (ftnlen)25); - errint_("#", &class__, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKIF02", (ftnlen)8); - return 0; - } - } - chkout_("ZZEKIF02", (ftnlen)8); - return 0; -} /* zzekif02_ */ - diff --git a/ext/spice/src/cspice/zzekiic1.c b/ext/spice/src/cspice/zzekiic1.c deleted file mode 100644 index 04a7304072..0000000000 --- a/ext/spice/src/cspice/zzekiic1.c +++ /dev/null @@ -1,672 +0,0 @@ -/* zzekiic1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKIIC1 ( EK, insert into index, character, type 1 ) */ -/* Subroutine */ int zzekiic1_(integer *handle, integer *segdsc, integer * - coldsc, char *ckey, integer *recptr, logical *null, ftnlen ckey_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer tree; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzeklerc_(integer *, integer *, integer *, char *, - integer *, logical *, integer *, integer *, ftnlen), zzektrin_( - integer *, integer *, integer *, integer *), chkin_(char *, - ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer dtype, itype; - extern logical failed_(void); - logical indexd; - char column[32]; - integer prvidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer prvptr; - -/* $ Abstract */ - -/* Insert into a type 1 EK index a record pointer associated with a */ -/* character key. The key and record pointer determine the insertion */ -/* point via dictionary ordering on (value, record pointer) pairs. */ - -/* $ 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 */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CKEY I Character key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to */ -/* which the index corresponds. */ - -/* CKEY is a character string key. */ - -/* RECPTR is a record pointer associated with the input key. */ - -/* NULL is a logical flag indicating whether the input */ -/* value is null. */ - -/* $ Detailed_Output */ - -/* None. This routine operates by side effects. See $Particulars */ -/* for a description of the effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine updates the index of an EK segment to reflect the */ -/* addition of a record to the segment. The index must be */ -/* associated with a character, scalar column. The type of the */ -/* index must be 1. */ - -/* The ordinal position of the new item is determined by the key */ -/* CKEY. The new item will follow the last item already present */ -/* in the column having a value less than or equal to CKEY. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKAD03. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIIC1", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKIIC1", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIIC1", (ftnlen)8); - setmsg_("Column # should be CHR but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIIC1", (ftnlen)8); - return 0; - } - itype = coldsc[5]; - if (itype == 1) { - -/* Get the tree pointer from the column descriptor. */ - - tree = coldsc[6]; - -/* Locate the predecessor of the input key, record pair. */ - - zzeklerc_(handle, segdsc, coldsc, ckey, recptr, null, &prvidx, & - prvptr, ckey_len); - -/* Insert the new record number right after the item we've found. */ - - i__1 = prvidx + 1; - zzektrin_(handle, &tree, &i__1, recptr); - } else { - zzekcnam_(handle, segdsc, column, (ftnlen)32); - chkin_("ZZEKIIC1", (ftnlen)8); - setmsg_("Column # has index type #.", (ftnlen)26); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIIC1", (ftnlen)8); - return 0; - } - return 0; -} /* zzekiic1_ */ - diff --git a/ext/spice/src/cspice/zzekiid1.c b/ext/spice/src/cspice/zzekiid1.c deleted file mode 100644 index b5a2c26891..0000000000 --- a/ext/spice/src/cspice/zzekiid1.c +++ /dev/null @@ -1,672 +0,0 @@ -/* zzekiid1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKIID1 ( EK, insert into index, d.p., type 1 ) */ -/* Subroutine */ int zzekiid1_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dkey, integer *recptr, logical *null) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer tree; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzeklerd_(integer *, integer *, integer *, doublereal *, - integer *, logical *, integer *, integer *), zzektrin_(integer *, - integer *, integer *, integer *), chkin_(char *, ftnlen), errch_( - char *, char *, ftnlen, ftnlen); - integer dtype, itype; - extern logical failed_(void); - logical indexd; - char column[32]; - integer prvidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer prvptr; - -/* $ Abstract */ - -/* Insert into a type 1 EK index a record pointer associated with a */ -/* d.p. key. The key and record pointer determine the insertion */ -/* point via dictionary ordering on (value, record pointer) pairs. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DKEY I Double precision key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to */ -/* which the index corresponds. */ - -/* DKEY is a double precision key. */ - -/* RECPTR is a record pointer associated with the input key. */ - -/* NULL is a logical flag indicating whether the input */ -/* value is null. */ - -/* $ Detailed_Output */ - -/* None. This routine operates by side effects. See $Particulars */ -/* for a description of the effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not double precision, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine updates the index of an EK segment to reflect the */ -/* addition of a record to the segment. The index must be */ -/* associated with a double precision, scalar column. The type of */ -/* the double precision index must be 1. */ - -/* The ordinal position of the new item is determined by the key */ -/* DKEY. The new item will follow the last item already present */ -/* in the column having a value less than or equal to DKEY. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKAD02. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIID1", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKIID1", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIID1", (ftnlen)8); - setmsg_("Column # should be DP or TIME but has type #.", (ftnlen)45); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIID1", (ftnlen)8); - return 0; - } - itype = coldsc[5]; - if (itype == 1) { - -/* Get the tree pointer from the column descriptor. */ - - tree = coldsc[6]; - -/* Locate the predecessor of the input key, record pointer pair. */ - - zzeklerd_(handle, segdsc, coldsc, dkey, recptr, null, &prvidx, & - prvptr); - -/* Insert the new record pointer right after the item we've found. */ - - i__1 = prvidx + 1; - zzektrin_(handle, &tree, &i__1, recptr); - } else { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIID1", (ftnlen)8); - setmsg_("Column # has index type #.", (ftnlen)26); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIID1", (ftnlen)8); - return 0; - } - return 0; -} /* zzekiid1_ */ - diff --git a/ext/spice/src/cspice/zzekiii1.c b/ext/spice/src/cspice/zzekiii1.c deleted file mode 100644 index 3b30ca6cfc..0000000000 --- a/ext/spice/src/cspice/zzekiii1.c +++ /dev/null @@ -1,668 +0,0 @@ -/* zzekiii1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKIII1 ( EK, insert into index, integer, type 1 ) */ -/* Subroutine */ int zzekiii1_(integer *handle, integer *segdsc, integer * - coldsc, integer *ikey, integer *recptr, logical *null) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer tree; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekleri_(integer *, integer *, integer *, integer *, - integer *, logical *, integer *, integer *), zzektrin_(integer *, - integer *, integer *, integer *), chkin_(char *, ftnlen), errch_( - char *, char *, ftnlen, ftnlen); - integer dtype, itype; - extern logical failed_(void); - logical indexd; - char column[32]; - integer prvidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer prvptr; - -/* $ Abstract */ - -/* Insert into a type 1 EK index a record pointer associated with an */ -/* integer key. The key and record pointer determine the insertion */ -/* point via dictionary ordering on (value, record pointer) pairs. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IKEY I Integer key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to */ -/* which the index corresponds. */ - -/* IKEY is an integer key. */ - -/* RECPTR is a record pointer associated with the input key. */ - -/* NULL is a logical flag indicating whether the input */ -/* value is null. */ - -/* $ Detailed_Output */ - -/* None. This routine operates by side effects. See $Particulars */ -/* for a description of the effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not integer, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine updates the index of an EK segment to reflect the */ -/* addition of a record to the segment. The index must be */ -/* associated with an integer, scalar column. The type of the */ -/* index must be 1. */ - -/* The ordinal position of the new item is determined by the key */ -/* IKEY. The new item will follow the last item already present */ -/* in the column having a value less than or equal to IKEY. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKAD01. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIII1", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKIII1", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIII1", (ftnlen)8); - setmsg_("Column # should be INT but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIII1", (ftnlen)8); - return 0; - } - itype = coldsc[5]; - if (itype == 1) { - -/* Get the tree pointer from the column descriptor. */ - - tree = coldsc[6]; - -/* Locate the predecessor of the input key, record pointer pair. */ - - zzekleri_(handle, segdsc, coldsc, ikey, recptr, null, &prvidx, & - prvptr); - -/* Insert the new record pointer right after the item we've found. */ - - i__1 = prvidx + 1; - zzektrin_(handle, &tree, &i__1, recptr); - } else { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKIII1", (ftnlen)8); - setmsg_("Column # has index type #.", (ftnlen)26); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIII1", (ftnlen)8); - return 0; - } - return 0; -} /* zzekiii1_ */ - diff --git a/ext/spice/src/cspice/zzekille.c b/ext/spice/src/cspice/zzekille.c deleted file mode 100644 index 6c1ef126dc..0000000000 --- a/ext/spice/src/cspice/zzekille.c +++ /dev/null @@ -1,589 +0,0 @@ -/* zzekille.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKILLE ( EK, indirect, last elt less than or equal to ) */ -integer zzekille_(integer *handle, integer *segdsc, integer *coldsc, integer * - nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, - ftnlen cval_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - doublereal dnum; - integer inum; - extern /* Subroutine */ int zzekllec_(integer *, integer *, integer *, - char *, integer *, integer *, ftnlen), zzeklled_(integer *, - integer *, integer *, doublereal *, integer *, integer *), - zzekllei_(integer *, integer *, integer *, integer *, integer *, - integer *), chkin_(char *, ftnlen); - extern logical return_(void); - integer coltyp; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer rec; - -/* $ Abstract */ - -/* Find the ordinal position of the row, in an specified EK segment, */ -/* whose value in a specified column is the last last element less */ -/* than or equal to a specified value, where the order relation is */ -/* given by an order vector in a specified DAS file. */ - -/* $ 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 */ - -/* DAS */ -/* EK */ - -/* $ Keywords */ - -/* ARRAY */ -/* FILES */ -/* SORT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I HANDLE of EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Descriptor of column to be searched. */ -/* NROWS I Number of rows in column. */ -/* DTYPE I Data type of input value. */ -/* CVAL I Character string value. */ -/* DVAL I Double precision value. */ -/* IVAL I Integer value. */ - -/* The function returns the index of the last order vector element */ -/* that points to an array element that is less than or equal to */ -/* the input value of the same data type as the column. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of the EK containing the */ -/* segment of interest. */ - -/* SEGDSC is the segment descriptor of the EK */ -/* segment of interest. */ - -/* COLDSC is a column descriptor for the column whose */ -/* entries are to be compared with an input scalar */ -/* value. The column must be indexed. */ - -/* NROWS is the number of rows in the segment of interest. */ - -/* DTYPE is the data type of the input scalar value. */ - -/* CVAL, */ -/* DVAL, */ -/* IVAL are a set of scalar variables of character, */ -/* double precision, and integer type. Whichever */ -/* of these has the same data type as the column */ -/* indicated by COLDSC is used to compare rows */ -/* against. If COLDSC has data type TIME, DVAL */ -/* is used in the comparison. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the last order vector element */ -/* that points to a column entry that is less than or equal to */ -/* whichever of CVAL, DVAL, or IVAL has the same data type as the */ -/* input column. If the least element of the column is greater than */ -/* the input value of the matching type, the function returns the */ -/* value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the array size NROWS is non-positive, the error */ -/* SPICE(INVALIDSIZE) will be signalled. */ - -/* 2) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs during any access to the file */ -/* specified by HANDLE, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 4) If any of SEGBAS, COLDSC, or NROWS are invalid, this routine */ -/* may fail in unpredictable, but possibly spectacular, ways. */ -/* Except as described in this header section, no attempt is */ -/* made to handle these errors. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine supports allow rapid look-up of elements in indexed */ -/* EK columns. */ - -/* $ Examples */ - -/* See ZZEKKEY. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Initialize the function's return value. */ - - ret_val = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return ret_val; - } else { - chkin_("ZZEKILLE", (ftnlen)8); - } - -/* Validate the number of rows in the column. */ - - if (*nrows < 1) { - -/* 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; - setmsg_("Number of rows must be positive; was #.", (ftnlen)39); - errint_("#", nrows, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEKILLE", (ftnlen)8); - return ret_val; - } - -/* Hand off the problem to the LLE routine of the correct type. */ - - coltyp = coldsc[1]; - if (coltyp == 1) { - zzekllec_(handle, segdsc, coldsc, cval, &ret_val, &rec, cval_len); - } else if (coltyp == 2) { - if (*dtype == 2) { - dnum = *dval; - } else { - dnum = (doublereal) (*ival); - } - zzeklled_(handle, segdsc, coldsc, &dnum, &ret_val, &rec); - } else if (coltyp == 4) { - zzeklled_(handle, segdsc, coldsc, dval, &ret_val, &rec); - } else if (coltyp == 3) { - if (*dtype == 2) { - inum = i_dnnt(dval); - } else { - inum = *ival; - } - zzekllei_(handle, segdsc, coldsc, &inum, &ret_val, &rec); - } else { - setmsg_("The data type # is not supported.", (ftnlen)33); - errint_("#", &coltyp, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEKILLE", (ftnlen)8); - return ret_val; - } - chkout_("ZZEKILLE", (ftnlen)8); - return ret_val; -} /* zzekille_ */ - diff --git a/ext/spice/src/cspice/zzekillt.c b/ext/spice/src/cspice/zzekillt.c deleted file mode 100644 index 0a92752d7d..0000000000 --- a/ext/spice/src/cspice/zzekillt.c +++ /dev/null @@ -1,586 +0,0 @@ -/* zzekillt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKILLT ( EK, indirect, last element less than ) */ -integer zzekillt_(integer *handle, integer *segdsc, integer *coldsc, integer * - nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, - ftnlen cval_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - doublereal dnum; - integer inum; - extern /* Subroutine */ int zzeklltc_(integer *, integer *, integer *, - char *, integer *, integer *, ftnlen), zzeklltd_(integer *, - integer *, integer *, doublereal *, integer *, integer *), - zzekllti_(integer *, integer *, integer *, integer *, integer *, - integer *), chkin_(char *, ftnlen); - extern logical return_(void); - integer coltyp; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer rec; - -/* $ Abstract */ - -/* Find the ordinal position of the row, in an specified EK segment, */ -/* whose value in a specified column is the last last element less */ -/* than a specified value, where the order relation is given by an */ -/* order vector in a specified DAS file. */ - -/* $ 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 */ - -/* DAS */ -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I HANDLE of EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Descriptor of column to be searched. */ -/* NROWS I Number of rows in column. */ -/* DTYPE I Data type of input value. */ -/* CVAL I Character string value. */ -/* DVAL I Double precision value. */ -/* IVAL I Integer value. */ - -/* The function returns the index of the last order vector element */ -/* that points to an array element that is less than the input */ -/* value of the same data type as the column. */ - -/* $ Detailed_Input */ - -/* HANDLE is the file handle of the EK containing the */ -/* segment of interest. */ - -/* SEGDSC is the segment descriptor of the EK */ -/* segment of interest. */ - -/* COLDSC is a column descriptor for the column whose */ -/* entries are to be compared with an input scalar */ -/* value. The column must be indexed. */ - -/* NROWS is the number of rows in the segment of interest. */ - -/* DTYPE is the data type of the input scalar value. */ - -/* CVAL, */ -/* DVAL, */ -/* IVAL are a set of scalar variables of character, */ -/* double precision, and integer type. Whichever */ -/* of these has the same data type as the column */ -/* indicated by COLDSC is used to compare rows */ -/* against. If COLDSC has data type TIME, DVAL */ -/* is used in the comparison. */ - -/* $ Detailed_Output */ - -/* The function returns the index of the last order vector element */ -/* that points to a column entry that is less than whichever of */ -/* CVAL, DVAL, or IVAL has the same data type as the input column. */ -/* If the least element of the column is greater than the input */ -/* value of the matching type, the function returns the value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the array size NROWS is non-positive, the error */ -/* SPICE(INVALIDSIZE) will be signalled. */ - -/* 2) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs during any access to the file */ -/* specified by HANDLE, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 4) If any of SEGDSC, COLDSC, or NROWS are invalid, this routine */ -/* may fail in unpredictable, but possibly spectacular, ways. */ -/* Except as described in this header section, no attempt is */ -/* made to handle these errors. */ - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine supports allow rapid look-up of elements in indexed */ -/* EK columns. */ - -/* $ Examples */ - -/* See ZZEKKEY. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Initialize the function's return value. */ - - ret_val = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return ret_val; - } else { - chkin_("ZZEKILLT", (ftnlen)8); - } - -/* Validate the number of rows in the column. */ - - if (*nrows < 1) { - -/* 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; - setmsg_("Number of rows must be positive; was #.", (ftnlen)39); - errint_("#", nrows, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEKILLT", (ftnlen)8); - return ret_val; - } - -/* Hand off the problem to the LLT routine of the correct type. */ - - coltyp = coldsc[1]; - if (coltyp == 1) { - zzeklltc_(handle, segdsc, coldsc, cval, &ret_val, &rec, cval_len); - } else if (coltyp == 2) { - if (*dtype == 2) { - dnum = *dval; - } else { - dnum = (doublereal) (*ival); - } - zzeklltd_(handle, segdsc, coldsc, &dnum, &ret_val, &rec); - } else if (coltyp == 4) { - zzeklltd_(handle, segdsc, coldsc, dval, &ret_val, &rec); - } else if (coltyp == 3) { - if (*dtype == 2) { - inum = i_dnnt(dval); - } else { - inum = *ival; - } - zzekllti_(handle, segdsc, coldsc, &inum, &ret_val, &rec); - } else { - setmsg_("The data type # is not supported.", (ftnlen)33); - errint_("#", &coltyp, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEKILLT", (ftnlen)8); - return ret_val; - } - chkout_("ZZEKILLT", (ftnlen)8); - return ret_val; -} /* zzekillt_ */ - diff --git a/ext/spice/src/cspice/zzekinqc.c b/ext/spice/src/cspice/zzekinqc.c deleted file mode 100644 index b5f77d1b0e..0000000000 --- a/ext/spice/src/cspice/zzekinqc.c +++ /dev/null @@ -1,682 +0,0 @@ -/* zzekinqc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure ZZEKINQC ( Private: EK, insert into query, character ) */ -/* Subroutine */ int zzekinqc_(char *value, integer *length, integer *lexbeg, - integer *lexend, integer *eqryi, char *eqryc, integer *descr, ftnlen - value_len, ftnlen eqryc_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer free, init, size, room; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), zzekweqi_(char *, integer *, integer *, ftnlen); - integer l; - extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *, - integer *), setmsg_(char *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Insert a character value into a specified encoded EK query, and */ -/* obtain a descriptor for the stored value. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Character value. */ -/* LENGTH I Length of item to insert. */ -/* LEXBEG, */ -/* LEXEND I Begin and end positions of value's lexeme. */ -/* EQRYI I-O Integer portion of encoded query. */ -/* EQRYC I-O Character portion of encoded query. */ -/* DESCR O Descriptor for value. */ - -/* $ Detailed_Input */ - -/* VALUE is a character value to be inserted into an */ -/* encoded query. */ - -/* LENGTH indicates the length of the input character value. */ -/* If LENGTH exceeds LEN(VALUE), the stored value */ -/* is padded with trailing blanks. This allows */ -/* faithful representation of literal strings. */ - -/* LEXBEG, */ -/* LEXEND are the begin and end character positions in the */ -/* original query of the lexeme that generated the */ -/* input value. These indices may be used for error */ -/* correction. */ - -/* EQRYI is the integer portion of an encoded EK query */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query, */ -/* updated to reflect the addition of a value to the */ -/* encoded query's character buffer. */ - -/* EQRYC is the character portion of an encoded EK query, */ -/* with the input value added. */ - -/* DESCR is a descriptor for the input value. The */ -/* descriptor contains EQVDSZ elements. */ - -/* $ Parameters */ - -/* See the INCLUDE files. */ - -/* $ Exceptions */ - -/* 1) If the input query is uninitialized, the error */ -/* SPICE(NOTINITIALIZED) will be signalled. */ - -/* 2) If the input character count LENGTH is non-positive, the */ -/* error SPICE(INVALIDCOUNT) is signalled. */ - -/* 3) If there is insufficient space in the encoded query's */ -/* character component, the error SPICE(BUFFERTOOSMALL) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine should always be used to insert character values */ -/* into an encoded query; the insertion should never be done */ -/* directly. */ - -/* $ Examples */ - -/* See ZZEKNRML. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "INITIALIZED", &init, (ftnlen)11); - if (init != 1) { - chkin_("ZZEKINQC", (ftnlen)8); - setmsg_("Encoded query must be initialized before it may be written.", - (ftnlen)59); - sigerr_("SPICE(NOTINITIALIZED)", (ftnlen)21); - chkout_("ZZEKINQC", (ftnlen)8); - return 0; - } - -/* Check the input length value. */ - - if (*length < 1) { - chkin_("ZZEKINQC", (ftnlen)8); - setmsg_("Length of string value was #; must be > 0.", (ftnlen)42); - errint_("#", length, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKINQC", (ftnlen)8); - return 0; - } - -/* Get the character free pointer; make sure there's enough room. */ - - zzekreqi_(eqryi, "FREE_CHR", &free, (ftnlen)8); - zzekreqi_(eqryi, "CHR_BUF_SIZE", &size, (ftnlen)12); - room = size - free + 1; - if (*length > room) { - chkin_("ZZEKINQC", (ftnlen)8); - setmsg_("Out of room in character portion of encoded query; only # e" - "lements were available; # are needed.", (ftnlen)96); - errint_("#", &room, (ftnlen)1); - errint_("#", length, (ftnlen)1); - sigerr_("SPICE(BUFFERTOOSMALL)", (ftnlen)21); - chkout_("ZZEKINQC", (ftnlen)8); - return 0; - } - -/* Insert the value into the character portion of the encoded query. */ - -/* Computing MIN */ - i__1 = *length, i__2 = i_len(value, value_len); - l = min(i__1,i__2); - s_copy(eqryc + (free - 1), value, eqryc_len - (free - 1), l); - -/* Fill in the descriptor. */ - - cleari_(&c__6, descr); - descr[0] = 1; - descr[1] = *lexbeg; - descr[2] = *lexend; - descr[3] = free; - descr[4] = free + *length - 1; - -/* Update the character free pointer. */ - - i__1 = free + *length; - zzekweqi_("FREE_CHR", &i__1, eqryi, (ftnlen)8); - return 0; -} /* zzekinqc_ */ - diff --git a/ext/spice/src/cspice/zzekinqn.c b/ext/spice/src/cspice/zzekinqn.c deleted file mode 100644 index 56bd13a039..0000000000 --- a/ext/spice/src/cspice/zzekinqn.c +++ /dev/null @@ -1,657 +0,0 @@ -/* zzekinqn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure ZZEKINQN ( Private: EK, insert into query, numeric ) */ -/* Subroutine */ int zzekinqn_(doublereal *value, integer *type__, integer * - lexbeg, integer *lexend, integer *eqryi, doublereal *eqryd, integer * - descr) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer free, init, size, room; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), zzekweqi_(char *, integer *, integer *, ftnlen), chkin_( - char *, ftnlen), cleari_(integer *, integer *), setmsg_(char *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Insert a numeric value into a specified encoded EK query, and */ -/* obtain a descriptor for the stored value. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Numeric value. */ -/* TYPE I Data type. May be INT, DP, or TIME. */ -/* LEXBEG, */ -/* LEXEND I Begin and end positions of value's lexeme. */ -/* EQRYI I-O Integer portion of encoded query. */ -/* EQRYD I-O Numeric portion of encoded query. */ -/* DESCR O Descriptor for value. */ - -/* $ Detailed_Input */ - -/* VALUE is a numeric value to be inserted into an */ -/* encoded query. */ - -/* TYPE indicates the data type of the numeric value. */ -/* TYPE may be INT, DP, or TIME. */ - -/* LEXBEG, */ -/* LEXEND are the begin and end character positions in the */ -/* original query of the lexeme that generated the */ -/* input value. These indices may be used for error */ -/* correction. */ - -/* EQRYI is the integer portion of an encoded EK query */ - -/* EQRYD is the numeric portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query, */ -/* updated to reflect the addition of a value to the */ -/* encoded query's numeric buffer. */ - -/* EQRYD is the numeric portion of an encoded EK query, */ -/* with the input numeric value added. */ - -/* DESCR is a descriptor for the input value. The */ -/* descriptor contains EQVDSZ elements. */ - -/* $ Parameters */ - -/* See the INCLUDE files. */ - -/* $ Exceptions */ - -/* 1) If the input query is uninitialized, the error */ -/* SPICE(NOTINITIALIZED) will be signalled. */ - -/* 2) If there is insufficient space in the encoded query's */ -/* numeric component, the error SPICE(BUFFERTOOSMALL) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine should always be used to insert numeric values */ -/* into an encoded query; the insertion should never be done */ -/* directly. */ - -/* $ Examples */ - -/* See ZZEKNRML. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "INITIALIZED", &init, (ftnlen)11); - if (init != 1) { - chkin_("ZZEKINQN", (ftnlen)8); - setmsg_("Encoded query must be initialized before it may be written.", - (ftnlen)59); - sigerr_("SPICE(NOTINITIALIZED)", (ftnlen)21); - chkout_("ZZEKINQN", (ftnlen)8); - return 0; - } - -/* Get the numeric free pointer; make sure there's enough room. */ - - zzekreqi_(eqryi, "FREE_NUM", &free, (ftnlen)8); - zzekreqi_(eqryi, "NUM_BUF_SIZE", &size, (ftnlen)12); - room = size - free + 1; - if (room <= 0) { - chkin_("ZZEKINQN", (ftnlen)8); - setmsg_("Out of room in numeric portion of encoded query; only # ele" - "ments were available.", (ftnlen)80); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(BUFFERTOOSMALL)", (ftnlen)21); - chkout_("ZZEKINQN", (ftnlen)8); - return 0; - } - -/* Insert the value into the double precision portion of the encoded */ -/* query. */ - - eqryd[free - 1] = *value; - -/* Fill in the descriptor. */ - - cleari_(&c__6, descr); - descr[0] = *type__; - descr[1] = *lexbeg; - descr[2] = *lexend; - descr[3] = free; - -/* Update the numeric free pointer. */ - - i__1 = free + 1; - zzekweqi_("FREE_NUM", &i__1, eqryi, (ftnlen)8); - return 0; -} /* zzekinqn_ */ - diff --git a/ext/spice/src/cspice/zzekixdl.c b/ext/spice/src/cspice/zzekixdl.c deleted file mode 100644 index acfafa9930..0000000000 --- a/ext/spice/src/cspice/zzekixdl.c +++ /dev/null @@ -1,525 +0,0 @@ -/* zzekixdl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKIXDL ( EK, delete record from index ) */ -/* Subroutine */ int zzekixdl_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr) -{ - integer tree; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzektrdl_(integer *, integer *, integer *), - chkin_(char *, ftnlen); - integer recno; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer idxtyp; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), errfnm_(char *, integer *, ftnlen); - integer idx; - extern /* Subroutine */ int zzekfrx_(integer *, integer *, integer *, - integer *, integer *); - -/* $ Abstract */ - -/* Update an EK column index to reflect deletion of a record */ -/* specified by a record pointer. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer to locate. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of an EK file open for write access. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column to be searched. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* RECPTR is a pointer to a record whose corresponding */ -/* index entry is to be deleted. */ - -/* $ Detailed_Output */ - -/* None. This routine operates by side effects. See $Particulars */ -/* for a discussion of the action of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine supports EK update or delete operations, both of */ -/* which involve removing pointers to records from column indexes. */ - -/* $ Examples */ - -/* See ZZEKDE01. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKIXDL", (ftnlen)8); - } - idxtyp = coldsc[5]; - if (idxtyp != -1) { - -/* This column is indexed. */ - -/* Some entry in the index points to RECPTR. Find the entry */ -/* and delete it. */ - - zzekfrx_(handle, segdsc, coldsc, recptr, &idx); - if (idxtyp == 1) { - -/* For type 1 indexes, the index pointer is the root node of */ -/* a B*-tree. Just use the tree deletion routine. */ - - tree = coldsc[6]; - zzektrdl_(handle, &tree, &idx); - } else { - -/* Sorry, no other types of indexes are supported. */ - - setmsg_("The index type # is not supported.", (ftnlen)34); - errint_("#", &idxtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIXDL", (ftnlen)8); - return 0; - } - } else { - -/* This routine should not have been called if the column in */ -/* question is not indexed. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Column was not indexed. File = #; RECNO = #; COLIDX = #.", ( - ftnlen)56); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKIXDL", (ftnlen)8); - return 0; - } - chkout_("ZZEKIXDL", (ftnlen)8); - return 0; -} /* zzekixdl_ */ - diff --git a/ext/spice/src/cspice/zzekixlk.c b/ext/spice/src/cspice/zzekixlk.c deleted file mode 100644 index ea73581573..0000000000 --- a/ext/spice/src/cspice/zzekixlk.c +++ /dev/null @@ -1,503 +0,0 @@ -/* zzekixlk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKIXLK ( EK, look up record pointer in EK index ) */ -/* Subroutine */ int zzekixlk_(integer *handle, integer *coldsc, integer *key, - integer *recptr) -{ - integer base, tree; - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *); - integer q, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer itype; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer addrss; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Look up a specified record pointer from an EK index. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* COLDSC I Column descriptor. */ -/* KEY I Key. */ -/* RECPTR O Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* COLDSC is the column descriptor of the column to which */ -/* the index of interest belongs. */ - -/* KEY is the key of the record pointer of interest. This */ -/* key is the ordinal position of the record pointer */ -/* in the index. */ - -/* $ Detailed_Output */ - -/* RECPTR is the record pointer corresponding to the input */ -/* key. This pointer gives the base address of */ -/* the record pointer structure for the record having */ -/* ordinal position KEY within the specified column, */ -/* where the order is defined by the column's index. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If KEY is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 3) If an I/O error occurs while reading or the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the record pointer for a record having a */ -/* specified ordinal position in a column, where the order is */ -/* defined by the column's index. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - - itype = coldsc[5]; - if (itype == 1) { - -/* For type 1 indexes, the index pointer is the root node of */ -/* a B*-tree. Just use the tree look up routine. */ - - tree = coldsc[6]; - zzektrdp_(handle, &tree, key, recptr); - } else if (itype == 2) { - -/* For type 2 indexes, the index pointer is the base address */ -/* of the index. We must compute the offset from this base to */ -/* the index element having ordinal position KEY. */ - - base = coldsc[6]; - q = (*key - 1) / 254; - r__ = *key - q * 254; - addrss = base + (q << 8) + r__; - dasrdi_(handle, &addrss, &addrss, recptr); - } else { - -/* Sorry, no other types of indexes are supported. */ - - chkin_("ZZEKIXLK", (ftnlen)8); - setmsg_("The index type # is not supported.", (ftnlen)34); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKIXLK", (ftnlen)8); - return 0; - } - return 0; -} /* zzekixlk_ */ - diff --git a/ext/spice/src/cspice/zzekjoin.c b/ext/spice/src/cspice/zzekjoin.c deleted file mode 100644 index f0ef40298b..0000000000 --- a/ext/spice/src/cspice/zzekjoin.c +++ /dev/null @@ -1,1010 +0,0 @@ -/* zzekjoin.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__100 = 100; -static integer c__9 = 9; -static integer c__10 = 10; -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure ZZEKJOIN ( Perform join on two join row sets ) */ -/* Subroutine */ int zzekjoin_(integer *jbase1, integer *jbase2, integer * - njcnst, logical *active, integer *cpidx1, integer *clidx1, integer * - elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, - integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, - integer *dtdscs, integer *jbase3, integer *nrows) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *), - zzekjprp_(integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, logical *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *), - zzekspsh_(integer *, integer *), zzekjnxt_(logical *, integer *), - zzekstop_(integer *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - integer nresv, s1, s2, s3, segvec[10], offset, nr1, nr2, nr3, nt1, nt2, - nt3, rb1, rb2, rb3, rowvec[11], sgvbas; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer top; - extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); - integer nsv1, nsv2, nsv3; - -/* $ Abstract */ - -/* Perform join of two EK join row sets, subject to a specified set */ -/* of EK join constraints, yielding an EK join row set. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ - - -/* Maximum number of join row sets in a join row set union: */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ -/* +--------------------------------------------+ elements */ - - -/* The following parameters indicate positions of elements in the */ -/* join row set structure: */ - - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* JBASE1 I Scratch area base address of first join row set. */ -/* JBASE2 I Scratch area base address of second join row set. */ -/* NJCNST I Number of join constraints. */ -/* ACTIVE I Array of flags indicating applicable constraints. */ -/* CPIDX1 I Cross product indices for LHS's of constraints. */ -/* CLIDX1 I Column indices for LHS's of constraints. */ -/* ELTS1 I Column entry elt. indices for LHS'of constraints. */ -/* OPS I Operator codes for constraints. */ -/* CPIDX2 I Cross product indices for RHS's of constraints. */ -/* CLIDX2 I Column indices for RHS's of constraints. */ -/* ELTS2 I Column entry elt. indices for RHS'of constraints. */ -/* STHAN I Array of EK handles corresponding to segments. */ -/* STSDSC I Array of segment descriptors. */ -/* STDTPT I Array of set table column descriptor pointers. */ -/* DTPOOL I Linked list pool for column descriptors. */ -/* DTDSCS I Array of column descriptors. */ -/* JBASE3 O Scratch area base address of output join row set. */ -/* NROWS O Number of rows in output join row set. */ -/* CDSCSZ P Size of column descriptor. */ - -/* $ Detailed_Input */ - -/* JBASE1 is the EK scratch area base address of the first */ -/* input join row set. This address is one less than */ -/* the first address occupied by the join row set. */ -/* See the $Particulars section for a description of */ -/* join row sets. */ - -/* JBASE2 is the EK scratch area base address of the second */ -/* input join row set. This address is one less than */ -/* the first address occupied by the join row set. */ - -/* NJCNST is the number of join constraints that must be */ -/* satisfied by the output join row set. Each of the */ -/* input arrays CPIDX1, CLIDX1, OPS, CPIDX2, and */ -/* CLIDX2 contains NJCNST elements. */ - -/* ACTIVE is an array of logical flags indicating which */ -/* constraints are currently applicable. The Nth */ -/* element of ACTIVE indicates whether or not to apply */ -/* the Nth constraint: if ACTIVE(N) is .TRUE., the */ -/* constraint is applicable, otherwise it isn't. */ - -/* The elements of the other input arguments that */ -/* define constraints are defined when the */ -/* corresponding element of ACTIVE is .TRUE. For */ -/* example, when the second constraint is not active, */ -/* the second column descriptor in DTDSCS may not be */ -/* defined. */ - -/* CPIDX1, */ -/* CLIDX1 are, respectively, a set of cross product indices */ -/* and column indices that define the columns on the */ -/* left-hand sides of the input constraints. If the */ -/* first input join row set contains rows from NT1 */ -/* tables and the second input join row set contains */ -/* rows from NT2 tables, then there are (NT1+NT2) */ -/* components in the cross product of the tables */ -/* specified by the input join row sets. We'll index */ -/* these from 1 to (NT1+NT2), with table 1 being the */ -/* first table of the first input join row set, table */ -/* 2 being the second table of the first input join */ -/* row set, table (NT1+1) being the first table of the */ -/* second input join row set, and so on. Each element */ -/* of the argument CPIDX1 designates a table by this */ -/* counting scheme. The corresponding element of the */ -/* argument CLIDX1 is the index of a column in the */ -/* specified table. The index is the ordinal position */ -/* of the column's attributes in the column attribute */ -/* list for the table containing the column. */ - -/* ELTS1 is an array of column entry element indices. These */ -/* indices specify the elements of the LHS column */ -/* entries to be used in testing the join constraints. */ -/* For scalar columns, the corresponding values of */ -/* ELTS1 are ignored. */ - -/* OPS is an array of relational operator codes. The */ -/* Ith code applies to the Ith join constraint. */ - -/* CPIDX2, */ -/* CLIDX2 are, respectively, a set of cross product indices */ -/* and column indices that define the columns on the */ -/* right-hand sides of the input constraints. The */ -/* meanings of these arrays are analogous to those */ -/* of CPIDX1 and CLIDX1. */ - -/* ELTS2 is an array of column entry element indices. These */ -/* indices specify the elements of the LHS column */ -/* entries to be used in testing the join constraints. */ -/* For scalar columns, the corresponding values of */ -/* ELTS2 are ignored. */ - -/* STHAN is an array of EK file handles. The Ith element */ -/* of STHAN is the handle of the EK containing the */ -/* Ith loaded segment. */ - -/* STSDSC is an array of segment descriptors for all of the */ -/* loaded segments. */ - -/* STDTPT is an array of descriptor table pointers all of */ -/* the loaded segments. For the Ith loaded segment, */ - -/* STDTPT(I) */ - -/* contains the node number of the descriptor entry */ -/* of the first column in the Ith segment, where the */ -/* order of columns is determined by the order in */ -/* which the columns appear in the parent table's */ -/* column attribute list. */ - -/* DTPOOL, */ -/* DTDSCS are, respectively, the linked list pool for */ -/* the column descriptor array and the column */ -/* descriptor array itself. The latter contains */ -/* a descriptor for each loaded column. */ - -/* $ Detailed_Output */ - -/* JBASE3 is the EK scratch area base address of the output */ -/* join row set. This join row set represents that */ -/* subset of the Cartesian product of the input */ -/* join row sets which satisfies all of the input */ -/* join constraints. */ - -/* NROWS is the number of `rows' in the output join row set. */ -/* Each such row is actually a vector of rows, one */ -/* belonging to each table in the Cartesian product */ -/* of tables specified by the join operation. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* 1) If the number of constaints NCNSTR is out of range, the */ -/* error SPICE(INVALIDCOUNT) is signalled. */ - -/* 2) If the table count in either input join row set is out of */ -/* range, the error SPICE(INVALIDCOUNT) is signalled. */ - -/* 3) If the sum of the table counts of the input join row sets is */ -/* too large, the error SPICE(INVALIDCOUNT) is signalled. */ - -/* 4) If either of cross product table indices for the input */ -/* constraints is out of range, the error SPICE(INVALIDINDEX) is */ -/* signalled. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* The purpose of this routine is to compute the set of rows */ -/* resulting from joining two `join row sets'. A join row set */ -/* is a structure in the EK scratch area that represents the */ -/* result of a table join, subject to constraints. A join of */ -/* n tables, subject to constraints, may be computed by joining */ -/* the join of the first n-1 tables with the nth table; such a */ -/* procedure is the typical application evisioned for this routine. */ - -/* Since all EK rows belong to segments, the set of rows formed by */ -/* taking the Cartesian product of two tables is actually the union */ -/* of the sets of rows belonging to the Cartesian products of the */ -/* possible pairs of segments, where the segments are taken from */ -/* the two tables being crossed. Therefore, each join row set is */ -/* characterized by a list of n-tuples of segments, and by a list of */ -/* sets of n-tuples of row numbers, one row number set per segment */ -/* n-tuple. The segments are identified by a vector of segment */ -/* list indices, which is called a `segment vector'. The n-tuples */ -/* of rows are called `row vectors'. Each segment vector has a */ -/* pointer and count that allow addressing the corresponding row */ -/* vectors. */ - -/* Each join row set consists of: */ - -/* - a base address in the scratch area */ -/* - a table count */ -/* - a segment vector count */ -/* - a set of segment vectors */ -/* - a set of segment vector row vector base addresses */ -/* (these are relative to the base of the join row set) */ -/* - a set of segment vector row vector counts */ -/* - a set of row vectors, augmented by offsets of their */ -/* parent segment vectors (these offsets are at the */ -/* end of each row vector) */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* in the include file for the join row set parameters. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* 1) Relies on the EK scratch area. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 20-JUL-1998 (NJB) */ - -/* Deleted comment about squeezing out segment vectors without */ -/* corresponding row vectors; also deleted comment containing */ -/* a call to ZZEKJSQZ. */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* For speed, we use discovery check-in. We don't check */ -/* RETURN at all. */ - - -/* Validate constraint count. */ - - if (*njcnst < 0 || *njcnst > 100) { - chkin_("ZZEKJOIN", (ftnlen)8); - setmsg_("Number of join constraints was #; valid range is 0:#", ( - ftnlen)52); - errint_("#", njcnst, (ftnlen)1); - errint_("#", &c__100, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKJOIN", (ftnlen)8); - return 0; - } - -/* Get the table count and segment vector count for each input join */ -/* row set. */ - - i__1 = *jbase1 + 3; - i__2 = *jbase1 + 3; - zzeksrd_(&i__1, &i__2, &nt1); - i__1 = *jbase1 + 4; - i__2 = *jbase1 + 4; - zzeksrd_(&i__1, &i__2, &nsv1); - i__1 = *jbase2 + 3; - i__2 = *jbase2 + 3; - zzeksrd_(&i__1, &i__2, &nt2); - i__1 = *jbase2 + 4; - i__2 = *jbase2 + 4; - zzeksrd_(&i__1, &i__2, &nsv2); - -/* Set the table count and segment vector count for the output join */ -/* row set. */ - - nt3 = nt1 + nt2; - nsv3 = nsv1 * nsv2; - if (nt1 < 1 || nt2 > 9) { - chkin_("ZZEKJOIN", (ftnlen)8); - setmsg_("Number tables in first join row set was #; valid range is 1" - ":#", (ftnlen)61); - errint_("#", &nt1, (ftnlen)1); - errint_("#", &c__9, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKJOIN", (ftnlen)8); - return 0; - } else if (nt2 < 1 || nt2 > 9) { - chkin_("ZZEKJOIN", (ftnlen)8); - setmsg_("Number tables in second join row set was #; valid range is " - "1:#", (ftnlen)62); - errint_("#", &nt2, (ftnlen)1); - errint_("#", &c__9, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKJOIN", (ftnlen)8); - return 0; - } else if (nt3 > 10) { - chkin_("ZZEKJOIN", (ftnlen)8); - setmsg_("Number of crossed tables was #; valid range is 0:#", (ftnlen) - 50); - errint_("#", &nt3, (ftnlen)1); - errint_("#", &c__10, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKJOIN", (ftnlen)8); - return 0; - } - -/* Validate cross product indices. The column indices don't lend */ -/* themselves to such a convenient check; we'll check those as we */ -/* use them. */ - - i__1 = *njcnst; - for (i__ = 1; i__ <= i__1; ++i__) { - if (active[i__ - 1]) { - if (cpidx1[i__ - 1] < 1 || cpidx1[i__ - 1] > nt3) { - chkin_("ZZEKJOIN", (ftnlen)8); - setmsg_("Cross product table index for left hand side of con" - "straint # was #; valid range is 1:#", (ftnlen)86); - errint_("#", &i__, (ftnlen)1); - errint_("#", &cpidx1[i__ - 1], (ftnlen)1); - errint_("#", &nt3, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKJOIN", (ftnlen)8); - return 0; - } else if (cpidx2[i__ - 1] < 1 || cpidx2[i__ - 1] > nt3) { - chkin_("ZZEKJOIN", (ftnlen)8); - setmsg_("Cross product table index for right hand side of co" - "nstraint # was #; valid range is 1:#", (ftnlen)87); - errint_("#", &i__, (ftnlen)1); - errint_("#", &cpidx2[i__ - 1], (ftnlen)1); - errint_("#", &nt3, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKJOIN", (ftnlen)8); - return 0; - } - } - } - -/* Form the joint row set control area for output join row set. */ - -/* The current stack top is the base address of the output join row */ -/* set. */ - - zzekstop_(jbase3); - -/* Save room for the size and row vector count */ - - for (i__ = 1; i__ <= 2; ++i__) { - zzekspsh_(&c__1, &c__0); - } - -/* The table count and segment vector count come next. */ - - zzekspsh_(&c__1, &nt3); - zzekspsh_(&c__1, &nsv3); - -/* Just reserve room for the segment vectors and the segment vector */ -/* row set base addresses and counts. */ - - nresv = nsv3 * (nt3 + 2); - i__1 = nresv; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekspsh_(&c__1, &c__0); - } - -/* Initialize the output segment vector count and the total row */ -/* count. */ - - s3 = 0; - *nrows = 0; - -/* For every segment vector in the first join row set, */ - - i__1 = nsv1; - for (s1 = 1; s1 <= i__1; ++s1) { - -/* Fill in the first NT1 elements of our composite segment vector */ -/* with the current segment vector from the first join row set. */ - - offset = (s1 - 1) * nt1 + 4; - i__2 = *jbase1 + offset + 1; - i__3 = *jbase1 + offset + nt1; - zzeksrd_(&i__2, &i__3, segvec); - -/* Get the row set base address and count for this segment vector. */ - - offset = nsv1 * nt1 + 4 + (s1 - 1 << 1) + 1; - i__2 = *jbase1 + offset; - i__3 = *jbase1 + offset; - zzeksrd_(&i__2, &i__3, &rb1); - i__2 = *jbase1 + offset + 1; - i__3 = *jbase1 + offset + 1; - zzeksrd_(&i__2, &i__3, &nr1); - -/* For every segment vector in the second join row set, */ - - i__2 = nsv2; - for (s2 = 1; s2 <= i__2; ++s2) { - -/* Fill in the last NT2 elements of our composite segment */ -/* vector with the current segment vector from the second join */ -/* row set. */ - - offset = (s2 - 1) * nt2 + 4; - i__4 = *jbase2 + offset + 1; - i__5 = *jbase2 + offset + nt2; - zzeksrd_(&i__4, &i__5, &segvec[(i__3 = nt1) < 10 && 0 <= i__3 ? - i__3 : s_rnge("segvec", i__3, "zzekjoin_", (ftnlen)516)]); - -/* Write this segment vector to the output join row set. */ - - ++s3; - sgvbas = (s3 - 1) * nt3 + 4; - i__3 = *jbase3 + sgvbas + 1; - i__4 = *jbase3 + sgvbas + nt3; - zzeksupd_(&i__3, &i__4, segvec); - -/* Get the row set base address and count for this segment */ -/* vector. */ - - offset = nsv2 * nt2 + 4 + (s2 - 1 << 1) + 1; - i__3 = *jbase2 + offset; - i__4 = *jbase2 + offset; - zzeksrd_(&i__3, &i__4, &rb2); - i__3 = *jbase2 + offset + 1; - i__4 = *jbase2 + offset + 1; - zzeksrd_(&i__3, &i__4, &nr2); - -/* It's time to decide which row vectors corresponding to */ -/* our two segment vectors satisfy the join constraints. */ -/* We pass off the job of determining which row vectors to */ -/* consider to the subroutine pair ZZEKJPRP (join preparation) */ -/* and ZZEKJNXT (get next joined row vector). */ - -/* We defer establishing the base address of the output */ -/* row vector set until the join reduction is done, since */ -/* the join operation will use the scratch area. */ - - zzekjprp_(segvec, jbase1, &nt1, &rb1, &nr1, jbase2, &nt2, &rb2, & - nr2, njcnst, active, cpidx1, clidx1, elts1, ops, cpidx2, - clidx2, elts2, sthan, stsdsc, stdtpt, dtpool, dtdscs); - -/* Initialize the row count for the current output segment */ -/* vector. Also set the segment vector row set base address. */ - - nr3 = 0; - zzekstop_(&top); - rb3 = top - *jbase3; - offset = nsv3 * nt3 + 4 + (s3 - 1 << 1) + 1; - i__3 = *jbase3 + offset; - i__4 = *jbase3 + offset; - zzeksupd_(&i__3, &i__4, &rb3); - -/* Fetch the row vectors that satisfy the join constraints. */ - - nr3 = 0; - zzekjnxt_(&found, rowvec); - while(found) { - -/* Append the base offset of the parent segment vector */ -/* to the row vector. The base offset is one less than */ -/* the base-relative address of the segment vector. */ - - ++nr3; - rowvec[(i__3 = nt3) < 11 && 0 <= i__3 ? i__3 : s_rnge("rowvec" - , i__3, "zzekjoin_", (ftnlen)584)] = sgvbas; - -/* Add this vector to the output join row set. Get the */ -/* next row vector. */ - - i__3 = nt3 + 1; - zzekspsh_(&i__3, rowvec); - zzekjnxt_(&found, rowvec); - } - -/* At this point, we've tested every row corresponding to the */ -/* current segment vector. Update the row count for this */ -/* segment vector. */ - - offset = nsv3 * nt3 + 4 + (s3 - 1 << 1) + 2; - i__3 = *jbase3 + offset; - i__4 = *jbase3 + offset; - zzeksupd_(&i__3, &i__4, &nr3); - -/* Keep the overall row total up to date. */ - - *nrows += nr3; - } - } - -/* Fill in the row count and size values in the output join row */ -/* set. */ - - zzekstop_(&top); - i__1 = *jbase3 + 1; - i__2 = *jbase3 + 1; - i__3 = top - *jbase3; - zzeksupd_(&i__1, &i__2, &i__3); - i__1 = *jbase3 + 2; - i__2 = *jbase3 + 2; - zzeksupd_(&i__1, &i__2, nrows); - -/* We've constructed the output join row set resulting from */ -/* joining the input row sets. */ - - return 0; -} /* zzekjoin_ */ - diff --git a/ext/spice/src/cspice/zzekjsqz.c b/ext/spice/src/cspice/zzekjsqz.c deleted file mode 100644 index 613956211a..0000000000 --- a/ext/spice/src/cspice/zzekjsqz.c +++ /dev/null @@ -1,616 +0,0 @@ -/* zzekjsqz.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKJSQZ ( Private: EK, join row set squeeze ) */ -/* Subroutine */ int zzekjsqz_(integer *jrsbas) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer ntab, size; - extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *); - integer i__, j, delta, rbase, nrloc, ptarg, ntloc, rtarg, vtarg; - extern logical failed_(void); - integer rc, nr, segvec[10], pcpair[2], ptbase, setbas, cntloc, nsvdel, - nrvdel, svbase, nsvloc, ptrloc, rowvec[11], sizloc, newnsv, - rvsize, svsize, nsv; - extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compress a join row set by eliminating segment vectors for */ -/* which there are no corresponding row vectors. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ - - -/* Maximum number of join row sets in a join row set union: */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ -/* +--------------------------------------------+ elements */ - - -/* The following parameters indicate positions of elements in the */ -/* join row set structure: */ - - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* JRSBAS I Scratch area base address of join row set. */ - -/* $ Detailed_Input */ - -/* JRSBAS is the base address, in the scratch area, of a */ -/* join row set to be compressed. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If JRSBAS is not the base address of a structurally valid */ -/* join row set, the results of this routine will be */ -/* unpredictable. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the join row */ -/* set designated by the input argument JRSBAS. Every row vector */ -/* marked for deletion is removed. Every empty segment vector is */ -/* removed, along with the row count and row vector base for that */ -/* segment vector. The join row set is compressed to remove all */ -/* gaps. All counts are updated to reflect the updated join row */ -/* set. */ - -/* The purpose of the compression performed by this routine is to */ -/* save work during joins by reducing the size of the cartesian */ -/* products of sets of segment vectors. Also, special cases */ -/* involving null segment vectors can be avoided by this clean-up */ -/* mechanism. Finally, it may be possible to save space in the EK */ -/* scratch area freed by the compression. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* 1) Relies on the EK scratch area. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable NRVDEL to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable NRVDEL to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. The */ -/* statement referencing the uninitialized variable */ -/* was: */ - -/* IF ( ( RC .EQ. 0 ) .OR. ( NRVDEL .EQ. RC ) ) THEN */ - -/* In the previous version of the code, NRVDEL is uninitialized */ -/* when NRVDEL is 0. NRVDEL *is* initialized when RC is */ -/* non-zero, so the logical value of the IF expression is not */ -/* affected by the lack of proper intialization. */ - -/* However, the Intel Fortran compiler for the Mac flags a runtime */ -/* error when the above code is exercised. So NRVDEL is now */ -/* initialized prior to the above IF statement. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Look up the counts that are of interest: */ - -/* -- The table count */ -/* -- The segment vector count */ -/* -- The join row set size */ - -/* Save the address of each count. */ - - sizloc = *jrsbas + 1; - nsvloc = *jrsbas + 4; - ntloc = *jrsbas + 3; - zzeksrd_(&sizloc, &sizloc, &size); - zzeksrd_(&ntloc, &ntloc, &ntab); - zzeksrd_(&nsvloc, &nsvloc, &nsv); - if (failed_()) { - return 0; - } - -/* Set the sizes of segment and row vectors. */ - - svsize = ntab; - rvsize = ntab + 1; - -/* For each segment vector, obtain the row count. Clean up after */ -/* null segment vectors: compress out the space allocated for their */ -/* row vector pointers. Keep track of the number of deletions. */ - - nsvdel = 0; - nrvdel = 0; - vtarg = *jrsbas + 4; - i__1 = nsv; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* The location of the row count is CNTLOC. The row vector base */ -/* pointer precedes the row count. */ - - cntloc = *jrsbas + 4 + nsv * svsize + (i__ - 1 << 1) + 2; - ptrloc = cntloc - 1; - zzeksrd_(&cntloc, &cntloc, &rc); - if (rc > 0) { - -/* The row vector set for this segment vector is non-empty. */ -/* scan the rows, looking for those marked for deletion, and */ -/* update the row count to reflect the number of rows that */ -/* we're going to keep. */ - - zzeksrd_(&ptrloc, &ptrloc, &setbas); - nrvdel = 0; - i__2 = rc; - for (j = 1; j <= i__2; ++j) { - rbase = *jrsbas + setbas + (j - 1) * rvsize; - i__3 = rbase + 1; - i__4 = rbase + 1; - zzeksrd_(&i__3, &i__4, rowvec); - if (rowvec[0] == 0) { - ++nrvdel; - } - } - } - -/* Compute the base address of the current segment vector. */ - - svbase = *jrsbas + 4 + (i__ - 1) * svsize; - if (rc == 0 || nrvdel == rc) { - -/* We're going to delete the current segment vector. We'll */ -/* just skip over it without advancing our target pointers. */ - - ++nsvdel; - } else if (nsvdel > 0) { - -/* We need to shift the current segment vector to its */ -/* destination. */ - - i__2 = svbase + 1; - i__3 = svbase + svsize; - zzeksrd_(&i__2, &i__3, segvec); - i__2 = vtarg + 1; - i__3 = vtarg + svsize; - zzeksupd_(&i__2, &i__3, segvec); - vtarg += svsize; - } else { - -/* No segment vectors have been deleted yet. We still must */ -/* update the target in case we shift vectors later on in this */ -/* loop. */ - - vtarg += svsize; - } - } - -/* At this point, we've compressed out the null segment vectors. */ -/* The next step is to compress out the row vector counts and row */ -/* vector pointers that corresponded to those segment vectors. We */ -/* also want to remove the gap between the segment vectors and the */ -/* row vector pointer/count pairs. */ - -/* We need to do this only if we deleted some segment vectors. */ - - if (nsvdel > 0) { - newnsv = nsv - nsvdel; - ptarg = *jrsbas + 4 + newnsv * svsize; - i__1 = nsv; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* The row count is RC. */ - - svsize = ntab; - cntloc = *jrsbas + 4 + nsv * svsize + (i__ - 1 << 1) + 2; - zzeksrd_(&cntloc, &cntloc, &rc); - ptbase = cntloc - 2; - if (rc > 0) { - -/* Shift the current row vector pointer and row vector */ -/* count. */ - - i__2 = ptbase + 1; - i__3 = ptbase + 2; - zzeksrd_(&i__2, &i__3, pcpair); - i__2 = ptarg + 1; - i__3 = ptarg + 2; - zzeksupd_(&i__2, &i__3, pcpair); - ptarg += 2; - } - } - } else { - newnsv = nsv; - } - -/* Update the segment vector count. */ - - zzeksupd_(&nsvloc, &nsvloc, &newnsv); - -/* Remove any gaps that may exist between any of the row vectors, */ -/* or between the end of the segment vector's row vector counts */ -/* and base addresses and the first row vector. */ - -/* The initial target location is the first element following the */ -/* last segment vector's row vector count. RTARG is used as a base */ -/* address; it precedes this location by 1. */ - -/* If we deleted any segment vectors, the segment vector pointers */ -/* embedded in the row vectors must change. Make these updates */ -/* if necessary. */ - - - rtarg = *jrsbas + 4 + newnsv * (svsize + 2); - i__1 = newnsv; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Find the row count and row pointer for the current segment */ -/* vector. */ - - cntloc = *jrsbas + 4 + newnsv * svsize + (i__ - 1 << 1) + 2; - zzeksrd_(&cntloc, &cntloc, &rc); - ptrloc = cntloc - 1; - -/* Get the row vector set base pointer. After capturing the */ -/* current value, we'll update this pointer to account for */ -/* the shifting of row vectors. */ - - zzeksrd_(&ptrloc, &ptrloc, &setbas); - rbase = *jrsbas + setbas; - delta = rtarg - rbase; - i__2 = setbas + delta; - zzeksupd_(&ptrloc, &ptrloc, &i__2); - -/* Shift the row vectors for the current segment vector, */ -/* leaving behind the row vectors marked for deletion. */ - - nrvdel = 0; - i__2 = rc; - for (j = 1; j <= i__2; ++j) { - i__3 = rbase + 1; - i__4 = rbase + rvsize; - zzeksrd_(&i__3, &i__4, rowvec); - if (rowvec[0] == 0) { - -/* This row vector is to be deleted; don't copy it. */ - - rbase += rvsize; - ++nrvdel; - } else { - -/* The segment vector pointer is base-relative. */ - - rowvec[(i__3 = rvsize - 1) < 11 && 0 <= i__3 ? i__3 : s_rnge( - "rowvec", i__3, "zzekjsqz_", (ftnlen)415)] = (i__ - 1) - * svsize + 4; - i__3 = rtarg + 1; - i__4 = rtarg + rvsize; - zzeksupd_(&i__3, &i__4, rowvec); - rbase += rvsize; - rtarg += rvsize; - } - } - -/* Update the row count for the current segment vector, if */ -/* necessary. Note that no segment vector will become empty */ -/* as a result of the row vector deletions we've done; we */ -/* already eliminated any segment vectors for which that */ -/* could happen, before we entered this loop. */ - - if (nrvdel > 0) { - i__2 = rc - nrvdel; - zzeksupd_(&cntloc, &cntloc, &i__2); - } - } - -/* Update the total row count and size of the join row set. */ - - nr = 0; - i__1 = newnsv; - for (i__ = 1; i__ <= i__1; ++i__) { - cntloc = *jrsbas + 4 + newnsv * svsize + (i__ - 1 << 1) + 2; - zzeksrd_(&cntloc, &cntloc, &rc); - nr += rc; - } - nrloc = *jrsbas + 2; - size = newnsv * (svsize + 2) + 4 + nr * rvsize; - zzeksupd_(&nrloc, &nrloc, &nr); - zzeksupd_(&sizloc, &sizloc, &size); - return 0; -} /* zzekjsqz_ */ - diff --git a/ext/spice/src/cspice/zzekjsrt.c b/ext/spice/src/cspice/zzekjsrt.c deleted file mode 100644 index 4a4c07af91..0000000000 --- a/ext/spice/src/cspice/zzekjsrt.c +++ /dev/null @@ -1,1877 +0,0 @@ -/* zzekjsrt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__4 = 4; - -/* $Procedure ZZEKJSRT ( EK, join row set union sort ) */ -/* Subroutine */ int zzekjsrt_(integer *njrs, integer *ubases, integer * - norder, integer *otabs, integer *ocols, integer *oelts, integer * - senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer * - dtpool, integer *dtdscs, integer *ordbas) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - char ch__1[32], ch__2[32]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char cdat[32*250000]; - static doublereal ddat[250000]; - static integer idat[250000]; - integer ntab; - logical nfjg, null; - integer unit; - extern /* Subroutine */ int zzekvcal_(integer *, integer *, integer *); - extern logical zzekvcmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *); - extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *), - zzekspsh_(integer *, integer *), zzekvset_(integer *, integer *), - zzekstop_(integer *); - integer i__, j, addrj; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer cvlen, rvecj[11], svecj[10]; - logical found; - integer nrloc; - logical brute; - integer dtype; - logical trunc; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer nrows, jg; - static char nf[1*250000]; - integer addrjg, handle, nr, rj; - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - integer cprime, colptr, eltidx, gap; - static integer ordvec[250000]; - integer prvbas, row, rjg, rowvec[11], rvecjg[11], rvsize, rwvbas, seg, - segvec[10], sgvbas, svecjg[10], svsize, tabloc, tprime; - logical jle, nfj; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, - ftnlen), zzekrsc_(integer *, integer *, integer *, integer *, - integer *, integer *, char *, logical *, logical *, ftnlen), - zzeksrd_(integer *, integer *, integer *), zzekrsd_(integer *, - integer *, integer *, integer *, integer *, doublereal *, logical - *, logical *), zzekrsi_(integer *, integer *, integer *, integer * - , integer *, integer *, logical *, logical *); - -/* $ Abstract */ - -/* Sort the row vectors of a join row set union, given an order */ -/* relation defined by a set of qualified order-by columns. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ - - -/* Maximum number of join row sets in a join row set union: */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ -/* +--------------------------------------------+ elements */ - - -/* The following parameters indicate positions of elements in the */ -/* join row set structure: */ - - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NJRS I Number of join row sets in union. */ -/* UBASES I Base addresses of join row sets of union. */ -/* NORDER I Number of order-by columns. */ -/* OTABS I Order-by table indices relative to FROM clause. */ -/* OCOLS I Order-by column indices. */ -/* OELTS I Order-by element indices. */ -/* SENSES I Order directions. */ -/* STHAN I Handles of loaded files from segment table. */ -/* STSDSC I Array of descriptors of loaded segments. */ -/* STDTPT I Array of pointers to column descriptors. */ -/* DTPOOL I Column descriptor table pool. */ -/* DTDSCS I Column descriptor table. */ -/* ORDBAS O Scratch area base address for order vector. */ - -/* $ Detailed_Input */ - -/* NJRS, */ -/* UBASES are, respectively, the number of join row sets in */ -/* the input join row set union, and the base */ -/* addresses of those join row sets. */ - -/* NORDER is the number of order-by columns used to define */ -/* the order relation used for sorting. */ - -/* OTABS is an array of indices identifying the parent */ -/* tables of the order-by columns. These indices */ -/* are the ordinal positions of the parent tables */ -/* in the FROM clause of the query to which the */ -/* input joint row set corresponds. */ - -/* OCOLS is an array of indices identifying the order-by */ -/* columns. These indices are the ordinal positions */ -/* of the columns in their virtual parent tables. */ -/* The order of columns in virtual tables is set */ -/* when EKs are loaded by the routine EKLEF. The */ -/* Nth element of OCOLS applies to the Nth order-by */ -/* column. */ - -/* OELTS is an array of element indices identifying the */ -/* order-by column entry elements to use when making */ -/* order comparisons. These indices are ignored for */ -/* scalar order-by columns, but must be set properly */ -/* for vector-valued order-by columns. For example, */ -/* if an order-by column has size 5, one could make */ -/* order comparisons using the third elements of */ -/* entries in this column. The Nth element of OELTS */ -/* applies to the Nth order-by column. */ - -/* SENSES is an array of parameters indicating the ordering */ -/* sense for each order-by column. An ordering sense */ -/* can be ascending (the default) or descending. The */ -/* values indicating these senses are EQASND and */ -/* EQDSND respectively. These parameters are defined */ -/* in the include file ekquery.inc. The Nth element */ -/* of SENSES applies to the Nth order-by column. */ - -/* STHAN is an array of EK handles corresponding to loaded */ -/* segments. STHAN is expected to be the array of */ -/* the same name maintained by EKQMGR. */ - -/* STSDSC is an array of descriptors of loaded segments. */ -/* STSDSC is expected to be the array of the same name */ -/* maintained by EKQMGR. */ - -/* STDTPT is an array of pointers that map segments to lists */ -/* of column descriptors in the column descriptor */ -/* pool. The Nth element of STDTPT is the head node */ -/* number for the column descriptor list of the Nth */ -/* loaded segment. The column descriptor list is */ -/* indexed by the linked list pool DTPOOL. STDTPT is */ -/* expected to be the array of the same name */ -/* maintained by EKQMGR. */ - -/* DTPOOL is a linked list pool used to index the column */ -/* descriptor array DTDSCS. DTPOOL is expected to be */ -/* the array of the same name maintained by EKQMGR. */ - -/* DTDSCS is an array of column descriptors for each loaded */ -/* column. There is a separate descriptor for each */ -/* column in each segment. The Nth node of DTPOOL */ -/* is considered to point to the Nth element of */ -/* DTDSCS. DTDSCS is expected to be the array of the */ -/* same name maintained by EKQMGR. */ - -/* $ Detailed_Output */ - -/* ORDBAS is the scratch area base address of the order */ -/* vector created by this routine. This address is */ -/* the predecessor of the first scratch area address */ -/* occupied by the order vector. */ - -/* The order vector indicates the order of the row */ -/* vectors of the input join row set union, where the */ -/* order relation is defined by the order-by columns, */ -/* column entry element indices, and order senses. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of order-by columns NORDER is non-positive, */ -/* the error SPICE(INVALIDCOUNT) is signalled. */ - -/* 2) If an I/O error occurs while attempting to create an order */ -/* vector for the specified row set, the error will be diagnosed */ -/* by routines called by this routine. */ - -/* 3) If the first order-by column descriptor in the list has */ -/* an invalid data type code, the error SPICE(INVALIDTYPE) */ -/* is signalled. */ -/* $ Files */ - -/* The input join row set is presumed to refer to EK files currently */ -/* loaded via EKLEF. */ - -/* $ Particulars */ - -/* This routine writes to the EK scratch area an order vector for the */ -/* specified join row set union. The order vector is written in */ -/* ascending order starting at the location following ORDBAS. The */ -/* order relation is defined by the order-by columns, column entry */ -/* element indices, and order senses. */ - -/* $ Examples */ - -/* See EKGC. */ - -/* $ Restrictions */ - -/* 1) This routine modifies the EK scratch area, and therefore */ -/* should not be used by routines outside of the EK system. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable PRVBAS to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. */ - -/* - SPICELIB Version 2.0.0, 09-SEP-2005 (NJB) */ - -/* Increased buffer size parameter LIMIT1 from 25K to 250K. */ -/* Declared large buffers SAVED to prevent memory errors */ -/* under CYGWIN. */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed several redundant calls to CHKIN */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.1.0, 07-AUG-2006 (NJB) */ - -/* Bug fix: added intialization of variable PRVBAS to support */ -/* operation under the Macintosh Intel Fortran */ -/* compiler. Note that this bug did not affect */ -/* operation of this routine on other platforms. The */ -/* statement referencing the uninitialized variable */ -/* was: */ - -/* IF ( ( I .EQ. 1 ) .OR. ( SGVBAS .NE. PRVBAS ) ) THEN */ - -/* In the previous version of the code, PRVBAS is uninitialized */ -/* when the loop counter I is 1. PRVBAS *is* initialized when I */ -/* is greater than 1, so the logical value of the IF expression */ -/* is not affected by the lack of proper intialization. */ - -/* However, the Intel Fortran compiler for the Mac flags a runtime */ -/* error when the above code is exercised. So PRVBAS is now */ -/* initialized prior to the above IF statement. */ - - -/* - SPICELIB Version 2.0.0, 08-SEP-2005 (NJB) */ - -/* Increased buffer size parameter LIMIT1 from 25K to 250K. */ -/* Declared large buffers SAVED to prevent memory errors */ -/* under CYGWIN. The saved buffers are */ - -/* CDAT */ -/* DDAT */ -/* IDAT */ -/* NF */ -/* ORDVEC */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Other local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - -/* The following variables are saved in order to prevent */ -/* memory errors under Cygwin and in shared object libraries */ -/* under various Unix systems. */ - - -/* Statement functions */ - - - -/* The following functions test whether two column entries */ -/* are equal. In the integer and d.p. cases, the test is conclusive. */ -/* In the character case, the test indicates whether the initial */ -/* substrings consisting of the first INISUB characters of each of */ -/* the two entries are equal. */ - - -/* The following functions indicate whether the first of two column */ -/* entries is less than or equal to the second. In the integer and */ -/* d.p. cases, the test is conclusive. In the character case, the */ -/* test indicates whether the initial substring consisting of the */ -/* first INISUB characters of the first entry is less than or equal */ -/* to the corresponding initial substring of length INISUB of the */ -/* second entry. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKJSRT", (ftnlen)8); - } - -/* If there are no order-by columns, that's an error. */ - - if (*norder < 1) { - setmsg_("Number of order-by columns must be positive but was #.", ( - ftnlen)54); - errint_("#", norder, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKJSRT", (ftnlen)8); - return 0; - } - -/* We split the sorting job up into two cases: */ - -/* 1) If the number of rows to be sorted is not too large, */ -/* we can gain speed by reading data from the primary */ -/* order-by column into memory and sorting the row number */ -/* array in memory. */ - -/* 2) If there's too much data for option (1) to handle, */ -/* we just read data from the order-by columns as needed. */ -/* This algorithm is simple, but very slow, since many */ -/* DAS reads of individual column entries are required. */ - - -/* Find out how many rows are in the join row set union. */ - - nrows = 0; - i__1 = *njrs; - for (i__ = 1; i__ <= i__1; ++i__) { - nrloc = ubases[i__ - 1] + 2; - zzeksrd_(&nrloc, &nrloc, &nr); - nrows += nr; - } - -/* Get the number of tables in the cartesian product represented */ -/* by the join row set union. The number of tables in the first */ -/* join row set suffices. */ - - tabloc = ubases[0] + 3; - zzeksrd_(&tabloc, &tabloc, &ntab); - svsize = ntab; - rvsize = ntab + 1; - -/* We can get the data types of the order-by columns from the */ -/* segment vector of the first row vector in the first join row set. */ -/* Initialize addressing in the join row set union so we can look up */ -/* the locations of these vectors. */ - - zzekvset_(njrs, ubases); - zzekvcal_(&c__1, &rwvbas, &sgvbas); - i__1 = sgvbas + 1; - i__2 = sgvbas + svsize; - zzeksrd_(&i__1, &i__2, segvec); - tprime = otabs[0]; - cprime = ocols[0]; - seg = segvec[(i__1 = tprime - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("segv" - "ec", i__1, "zzekjsrt_", (ftnlen)528)]; - colptr = stdtpt[seg - 1]; - i__1 = cprime; - for (i__ = 2; i__ <= i__1; ++i__) { - colptr = lnknxt_(&colptr, dtpool); - } - dtype = dtdscs[colptr * 11 - 10]; - if (nrows <= 250000) { - -/* Case 1. */ - -/* We have a small enough quantity of data that we may be able */ -/* to speed up sorting by using memory. Here's the plan: */ - -/* We'll read data for the primary order-by column into memory. */ -/* The `primary' column is the one whose index appears first */ -/* in the input list of column indices. We'll also maintain a */ -/* null flag array for the primary column. If we can figure out */ -/* the order relation between two rows by looking at entries in */ -/* the primary order-by column, fine. Otherwise, we let ZZEKVCMP */ -/* perform the comparison. */ - -/* We'll sort the set of row vector numbers of the matching rows */ -/* in parallel with our data sort. */ - -/* Character columns present a special case: their string length */ -/* can get pretty big, and it could take a lot of memory to store */ -/* their column entries. We compromise here: we store only the */ -/* first INISUB chararacters of each character column entry. If */ -/* we can't decide the order of two strings based on these initial */ -/* substrings, we let ZZEKVCMP handle the matter. */ - -/* Read the primary column data. Keep track of whether we've */ -/* truncated any strings. */ - - trunc = FALSE_; - prvbas = -1; - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekvcal_(&i__, &rwvbas, &sgvbas); - if (i__ == 1 || sgvbas != prvbas) { - i__2 = sgvbas + 1; - i__3 = sgvbas + svsize; - zzeksrd_(&i__2, &i__3, segvec); - seg = segvec[(i__2 = tprime - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("segvec", i__2, "zzekjsrt_", (ftnlen)579)]; - handle = sthan[seg - 1]; - colptr = stdtpt[seg - 1]; - i__2 = cprime; - for (j = 2; j <= i__2; ++j) { - colptr = lnknxt_(&colptr, dtpool); - } - } - i__2 = rwvbas + 1; - i__3 = rwvbas + rvsize; - zzeksrd_(&i__2, &i__3, rowvec); - row = rowvec[(i__2 = tprime - 1) < 11 && 0 <= i__2 ? i__2 : - s_rnge("rowvec", i__2, "zzekjsrt_", (ftnlen)592)]; - eltidx = oelts[cprime - 1]; - if (dtype == 1) { - zzekrsc_(&handle, &stsdsc[seg * 24 - 24], &dtdscs[colptr * 11 - - 11], &row, &eltidx, &cvlen, cdat + (((i__2 = i__ - - 1) < 250000 && 0 <= i__2 ? i__2 : s_rnge("cdat", i__2, - "zzekjsrt_", (ftnlen)598)) << 5), &null, &found, ( - ftnlen)32); - if (! found) { - dashlu_(&handle, &unit); - setmsg_("EK = #; SEG = #; ROW = #; COLIDX = #; ELT = #; " - "column entry elt was not found.", (ftnlen)78); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &seg, (ftnlen)1); - errint_("#", &row, (ftnlen)1); - errint_("#", &dtdscs[colptr * 11 - 3], (ftnlen)1); - errint_("#", &eltidx, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKJSRT", (ftnlen)8); - return 0; - } - trunc = trunc || cvlen > 32; - } else if (dtype == 2 || dtype == 4) { - zzekrsd_(&handle, &stsdsc[seg * 24 - 24], &dtdscs[colptr * 11 - - 11], &row, &eltidx, &ddat[(i__2 = i__ - 1) < 250000 - && 0 <= i__2 ? i__2 : s_rnge("ddat", i__2, "zzekjsrt_" - , (ftnlen)632)], &null, &found); - if (! found) { - dashlu_(&handle, &unit); - setmsg_("EK = #; SEG = #; ROW = #; COLIDX = #; ELT = #; " - "column entry elt was not found.", (ftnlen)78); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &seg, (ftnlen)1); - errint_("#", &row, (ftnlen)1); - errint_("#", &dtdscs[colptr * 11 - 3], (ftnlen)1); - errint_("#", &eltidx, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKJSRT", (ftnlen)8); - return 0; - } - } else if (dtype == 3) { - zzekrsi_(&handle, &stsdsc[seg * 24 - 24], &dtdscs[colptr * 11 - - 11], &row, &eltidx, &idat[(i__2 = i__ - 1) < 250000 - && 0 <= i__2 ? i__2 : s_rnge("idat", i__2, "zzekjsrt_" - , (ftnlen)664)], &null, &found); - if (! found) { - dashlu_(&handle, &unit); - setmsg_("EK = #; SEG = #; ROW = #; COLIDX = #; ELT = #; " - "column entry elt was not found.", (ftnlen)78); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &seg, (ftnlen)1); - errint_("#", &row, (ftnlen)1); - errint_("#", &dtdscs[colptr * 11 - 3], (ftnlen)1); - errint_("#", &eltidx, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKJSRT", (ftnlen)8); - return 0; - } - } else { - -/* We must have a bogus column descriptor. */ - - setmsg_("Unrecognized data type # for first column.", (ftnlen) - 42); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKJSRT", (ftnlen)8); - return 0; - } - -/* Set the character null flag for the current column entry. */ - - if (null) { - *(unsigned char *)&nf[(i__2 = i__ - 1) < 250000 && 0 <= i__2 ? - i__2 : s_rnge("nf", i__2, "zzekjsrt_", (ftnlen)710)] - = 'T'; - } else { - *(unsigned char *)&nf[(i__2 = i__ - 1) < 250000 && 0 <= i__2 ? - i__2 : s_rnge("nf", i__2, "zzekjsrt_", (ftnlen)712)] - = 'F'; - } - prvbas = sgvbas; - } - -/* Initialize the order vector. */ - - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - ordvec[(i__2 = i__ - 1) < 250000 && 0 <= i__2 ? i__2 : s_rnge( - "ordvec", i__2, "zzekjsrt_", (ftnlen)724)] = i__; - } - -/* At this point, we've read in the data for the primary order-by */ -/* column, and also have set the null flag array for the column. */ -/* We're ready to proceed with our sort. */ - - gap = nrows / 2; - while(gap > 0) { - i__1 = nrows; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - -/* Compare the Jth and JGth rows of the row set. The */ -/* logical JLE is TRUE when the Jth element is less than */ -/* or equal to the JGth. If the Jth and JGth elements */ -/* compare equal, and there is more than one order-by */ -/* column or if we've truncated string data, we'll have */ -/* to go on and make a conclusive test. Otherwise, we */ -/* can set JLE based on the data we've read. */ - -/* Set the data array indices of the Jth and JGth */ -/* elements, as indicated by the order vector. */ - - rj = ordvec[(i__2 = j - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("ordvec", i__2, "zzekjsrt_", (ftnlen)755)]; - rjg = ordvec[(i__2 = jg - 1) < 250000 && 0 <= i__2 ? i__2 - : s_rnge("ordvec", i__2, "zzekjsrt_", (ftnlen)756) - ]; - nfj = *(unsigned char *)&nf[(i__2 = rj - 1) < 250000 && 0 - <= i__2 ? i__2 : s_rnge("nf", i__2, "zzekjsrt_", ( - ftnlen)758)] == 'T'; - nfjg = *(unsigned char *)&nf[(i__2 = rjg - 1) < 250000 && - 0 <= i__2 ? i__2 : s_rnge("nf", i__2, "zzekjsrt_", - (ftnlen)759)] == 'T'; - -/* Start out hoping for the best: that we won't have */ -/* to do a brute-force comparison. */ - - brute = FALSE_; - if (dtype == 3) { - if (*norder == 1) { - -/* We can make a decision based on the data in */ -/* memory. */ - - if (senses[0] == 0) { - jle = nfj || ! (nfj || nfjg) && idat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("idat", i__2, "zzekjsrt_", ( - ftnlen)777)] <= idat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "idat", i__3, "zzekjsrt_", (ftnlen) - 777)]; - } else { - jle = nfjg || ! (nfj || nfjg) && idat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("idat", i__2, "zzekjsrt_", ( - ftnlen)779)] >= idat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "idat", i__3, "zzekjsrt_", (ftnlen) - 779)]; - } - } else if (! (nfj && nfjg || ! (nfj || nfjg) && idat[( - i__2 = rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("idat", i__2, "zzekjsrt_", (ftnlen)783) - ] == idat[(i__3 = rjg - 1) < 250000 && 0 <= - i__3 ? i__3 : s_rnge("idat", i__3, "zzekjsrt_" - , (ftnlen)783)])) { - -/* If the items we're comparing are unequal, we can */ -/* still make a decision. */ - - if (senses[0] == 0) { - jle = nfj || ! (nfj || nfjg) && idat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("idat", i__2, "zzekjsrt_", ( - ftnlen)791)] <= idat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "idat", i__3, "zzekjsrt_", (ftnlen) - 791)]; - } else { - jle = nfjg || ! (nfj || nfjg) && idat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("idat", i__2, "zzekjsrt_", ( - ftnlen)793)] >= idat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "idat", i__3, "zzekjsrt_", (ftnlen) - 793)]; - } - } else { - -/* Otherwise, we'll have to look at values in the */ -/* other order-by columns. Get the segment and */ -/* row vectors to be compared. */ - - brute = TRUE_; - } - } else if (dtype == 2 || dtype == 4) { - -/* The D.P. case parallels the integer case. */ - - if (*norder == 1) { - if (senses[0] == 0) { - jle = nfj || ! (nfj || nfjg) && ddat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("ddat", i__2, "zzekjsrt_", ( - ftnlen)819)] <= ddat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "ddat", i__3, "zzekjsrt_", (ftnlen) - 819)]; - } else { - jle = nfjg || ! (nfj || nfjg) && ddat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("ddat", i__2, "zzekjsrt_", ( - ftnlen)821)] >= ddat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "ddat", i__3, "zzekjsrt_", (ftnlen) - 821)]; - } - } else if (! (nfj && nfjg || ! (nfj || nfjg) && ddat[( - i__2 = rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("ddat", i__2, "zzekjsrt_", (ftnlen)825) - ] == ddat[(i__3 = rjg - 1) < 250000 && 0 <= - i__3 ? i__3 : s_rnge("ddat", i__3, "zzekjsrt_" - , (ftnlen)825)])) { - if (senses[0] == 0) { - jle = nfj || ! (nfj || nfjg) && ddat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("ddat", i__2, "zzekjsrt_", ( - ftnlen)830)] <= ddat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "ddat", i__3, "zzekjsrt_", (ftnlen) - 830)]; - } else { - jle = nfjg || ! (nfj || nfjg) && ddat[(i__2 = - rj - 1) < 250000 && 0 <= i__2 ? i__2 : - s_rnge("ddat", i__2, "zzekjsrt_", ( - ftnlen)832)] >= ddat[(i__3 = rjg - 1) - < 250000 && 0 <= i__3 ? i__3 : s_rnge( - "ddat", i__3, "zzekjsrt_", (ftnlen) - 832)]; - } - } else { - -/* Otherwise, we'll have to look at values in the */ -/* other order-by columns. Get the segment and */ -/* row vectors to be compared. */ - - brute = TRUE_; - } - } else { - -/* In the character case where there is one order-by */ -/* column, equality is a problem unless no truncation */ -/* occurred. */ - - if (*norder == 1 && ! trunc) { - if (senses[0] == 0) { - s_copy(ch__1, cdat + (((i__2 = rj - 1) < - 250000 && 0 <= i__2 ? i__2 : s_rnge( - "cdat", i__2, "zzekjsrt_", (ftnlen) - 858)) << 5), (ftnlen)32, (ftnlen)32); - s_copy(ch__2, cdat + (((i__3 = rjg - 1) < - 250000 && 0 <= i__3 ? i__3 : s_rnge( - "cdat", i__3, "zzekjsrt_", (ftnlen) - 858)) << 5), (ftnlen)32, (ftnlen)32); - jle = nfj || ! (nfj || nfjg) && s_cmp(ch__1, - ch__2, (ftnlen)32, (ftnlen)32) <= 0; - } else { - s_copy(ch__1, cdat + (((i__2 = rj - 1) < - 250000 && 0 <= i__2 ? i__2 : s_rnge( - "cdat", i__2, "zzekjsrt_", (ftnlen) - 860)) << 5), (ftnlen)32, (ftnlen)32); - s_copy(ch__2, cdat + (((i__3 = rjg - 1) < - 250000 && 0 <= i__3 ? i__3 : s_rnge( - "cdat", i__3, "zzekjsrt_", (ftnlen) - 860)) << 5), (ftnlen)32, (ftnlen)32); - jle = nfjg || ! (nfj || nfjg) && s_cmp(ch__1, - ch__2, (ftnlen)32, (ftnlen)32) >= 0; - } - } else /* if(complicated condition) */ { - s_copy(ch__1, cdat + (((i__2 = rj - 1) < 250000 && - 0 <= i__2 ? i__2 : s_rnge("cdat", i__2, - "zzekjsrt_", (ftnlen)864)) << 5), (ftnlen) - 32, (ftnlen)32); - s_copy(ch__2, cdat + (((i__3 = rjg - 1) < 250000 - && 0 <= i__3 ? i__3 : s_rnge("cdat", i__3, - "zzekjsrt_", (ftnlen)864)) << 5), ( - ftnlen)32, (ftnlen)32); - if (! (nfj && nfjg || ! (nfj || nfjg) && s_cmp( - ch__1, ch__2, (ftnlen)32, (ftnlen)32) == - 0)) { - -/* If the items we're comparing are unequal, we can */ -/* still make a decision. */ - - if (senses[0] == 0) { - s_copy(ch__1, cdat + (((i__2 = rj - 1) < - 250000 && 0 <= i__2 ? i__2 : - s_rnge("cdat", i__2, "zzekjsrt_", - (ftnlen)872)) << 5), (ftnlen)32, ( - ftnlen)32); - s_copy(ch__2, cdat + (((i__3 = rjg - 1) < - 250000 && 0 <= i__3 ? i__3 : - s_rnge("cdat", i__3, "zzekjsrt_", - (ftnlen)872)) << 5), (ftnlen)32, ( - ftnlen)32); - jle = nfj || ! (nfj || nfjg) && s_cmp( - ch__1, ch__2, (ftnlen)32, (ftnlen) - 32) <= 0; - } else { - s_copy(ch__1, cdat + (((i__2 = rj - 1) < - 250000 && 0 <= i__2 ? i__2 : - s_rnge("cdat", i__2, "zzekjsrt_", - (ftnlen)874)) << 5), (ftnlen)32, ( - ftnlen)32); - s_copy(ch__2, cdat + (((i__3 = rjg - 1) < - 250000 && 0 <= i__3 ? i__3 : - s_rnge("cdat", i__3, "zzekjsrt_", - (ftnlen)874)) << 5), (ftnlen)32, ( - ftnlen)32); - jle = nfjg || ! (nfj || nfjg) && s_cmp( - ch__1, ch__2, (ftnlen)32, (ftnlen) - 32) >= 0; - } - } else { - -/* Otherwise, we'll have to look at values in the */ -/* other order-by columns. Get the segment and */ -/* row vectors to be compared. */ - - brute = TRUE_; - } - } - } - if (brute) { - zzekvcal_(&rj, &rwvbas, &sgvbas); - i__2 = sgvbas + 1; - i__3 = sgvbas + svsize; - zzeksrd_(&i__2, &i__3, svecj); - i__2 = rwvbas + 1; - i__3 = rwvbas + rvsize; - zzeksrd_(&i__2, &i__3, rvecj); - zzekvcal_(&rjg, &rwvbas, &sgvbas); - i__2 = sgvbas + 1; - i__3 = sgvbas + svsize; - zzeksrd_(&i__2, &i__3, svecjg); - i__2 = rwvbas + 1; - i__3 = rwvbas + rvsize; - zzeksrd_(&i__2, &i__3, rvecjg); - jle = zzekvcmp_(&c__4, norder, otabs, ocols, oelts, - senses, sthan, stsdsc, stdtpt, dtpool, dtdscs, - svecj, rvecj, svecjg, rvecjg); - } - -/* At this point, JLE is set. */ - - if (jle) { - j = 0; - } else { - -/* Swap the Jth and JGth elements of the order vector. */ - - swapi_(&ordvec[(i__2 = j - 1) < 250000 && 0 <= i__2 ? - i__2 : s_rnge("ordvec", i__2, "zzekjsrt_", ( - ftnlen)920)], &ordvec[(i__3 = jg - 1) < - 250000 && 0 <= i__3 ? i__3 : s_rnge("ordvec", - i__3, "zzekjsrt_", (ftnlen)920)]); - } - j -= gap; - } - } - -/* The following division guarantees loop termination, even */ -/* if a DAS error occurs. */ - - gap /= 2; - } - -/* We've sorted the row numbers in Case 1. Push the order vector */ -/* onto the scratch area stack. */ - - zzekstop_(ordbas); - zzekspsh_(&nrows, ordvec); - } else { - -/* Case 2. */ - -/* Well, we really have a lot of data. Don't try to read it into */ -/* memory. Build the order vector in the scratch area. */ - - zzekstop_(ordbas); - i__1 = nrows; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekspsh_(&c__1, &i__); - } - -/* Re-order the order vector elements to reflect the order of the */ -/* corresponding rows. This uses the Shell Sort algorithm, but */ -/* swaps the elements of the order vector instead of the rows */ -/* themselves. */ - - gap = nrows / 2; - while(gap > 0) { - i__1 = nrows; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - -/* Set the indices of the Jth and JGth */ -/* row vectors, as indicated by the order vector. */ - - i__2 = *ordbas + j; - i__3 = *ordbas + j; - zzeksrd_(&i__2, &i__3, &rj); - i__2 = *ordbas + jg; - i__3 = *ordbas + jg; - zzeksrd_(&i__2, &i__3, &rjg); - -/* Compare the two row vectors. */ - - zzekvcal_(&rj, &rwvbas, &sgvbas); - i__2 = sgvbas + 1; - i__3 = sgvbas + svsize; - zzeksrd_(&i__2, &i__3, svecj); - i__2 = rwvbas + 1; - i__3 = rwvbas + rvsize; - zzeksrd_(&i__2, &i__3, rvecj); - zzekvcal_(&rjg, &rwvbas, &sgvbas); - i__2 = sgvbas + 1; - i__3 = sgvbas + svsize; - zzeksrd_(&i__2, &i__3, svecjg); - i__2 = rwvbas + 1; - i__3 = rwvbas + rvsize; - zzeksrd_(&i__2, &i__3, rvecjg); - if (zzekvcmp_(&c__4, norder, otabs, ocols, oelts, senses, - sthan, stsdsc, stdtpt, dtpool, dtdscs, svecj, - rvecj, svecjg, rvecjg)) { - j = 0; - } else { - -/* Swap the order vectors's Jth and JGth elements. */ - - addrj = *ordbas + j; - addrjg = *ordbas + jg; - zzeksupd_(&addrj, &addrj, &rjg); - zzeksupd_(&addrjg, &addrjg, &rj); - } - j -= gap; - } - } - -/* The following division guarantees loop termination, even */ -/* if a DAS error occurs. */ - - gap /= 2; - } - -/* We've sorted the row numbers for case (2). */ - - } - -/* We've sorted the row numbers, no matter how many there were. */ - - chkout_("ZZEKJSRT", (ftnlen)8); - return 0; -} /* zzekjsrt_ */ - diff --git a/ext/spice/src/cspice/zzekjtst.c b/ext/spice/src/cspice/zzekjtst.c deleted file mode 100644 index 9cf1e45679..0000000000 --- a/ext/spice/src/cspice/zzekjtst.c +++ /dev/null @@ -1,2316 +0,0 @@ -/* zzekjtst.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__24 = 24; -static integer c__11 = 11; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__7 = 7; -static integer c__2 = 2; -static integer c__5 = 5; - -/* $Procedure ZZEKJTST ( Test join candidates ) */ -/* Subroutine */ int zzekjtst_0_(int n__, integer *segvec, integer *jbase1, - integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer * - nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, - integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, - integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, - integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, - logical *found, integer *rowvec) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer base, case__, ltab; - static logical done; - static integer rtab, lcol, lseg, rcol, lelt, rseg, lcur, relt, lptr, lrow, - rptr, rrow; - extern logical zzekvmch_(integer *, logical *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *), zzekrcmp_(integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - static integer svcp1[100], svcp2[100], svrb1, svrb2; - extern /* Subroutine */ int zzekspsh_(integer *, integer *), zzeksupd_( - integer *, integer *, integer *), zzekjsrt_(integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *), zzekstop_( - integer *); - static integer i__, j, k, svnr1, svnr2, svnt1, svnt2, jbase, lbase, rbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer lhans[100], lsdsc[2400] /* was [24][100] */, rhans[ - 100], rsdsc[2400] /* was [24][100] */; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - static integer lelts[100], cnstr, relts[100], dtptr, lrows[100], svops[ - 100], rrows[100], svbas1, svbas2, rb, nr, nt; - static logical locact[100]; - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - static integer addrss, ldscrs[1100] /* was [11][100] */, lovbas, lrvidx, - minirv[2], offset, nt3, rdscrs[1100] /* was [11][100] */, - rovbas, rrvidx, svncon, tab, top; - static logical fnd, lsmall; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzeksrd_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Test a set of candidate row vectors, all corresponding to the same */ -/* segment vector, against join constraints. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ - - -/* Maximum number of join row sets in a join row set union: */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ -/* +--------------------------------------------+ elements */ - - -/* The following parameters indicate positions of elements in the */ -/* join row set structure: */ - - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* SEGVEC I ZZEKJPRP */ -/* JBASE1 I ZZEKJPRP */ -/* NT1 I ZZEKJPRP */ -/* RB1 I ZZEKJPRP */ -/* NR1 I ZZEKJPRP */ -/* JBASE2 I ZZEKJPRP */ -/* NT2 I ZZEKJPRP */ -/* RB2 I ZZEKJPRP */ -/* NR2 I ZZEKJPRP */ -/* NJCNST I ZZEKJPRP */ -/* ACTIVE I ZZEKJPRP */ -/* CPIDX1 I ZZEKJPRP */ -/* CLIDX1 I ZZEKJPRP */ -/* ELTS1 I ZZEKJPRP */ -/* OPS I ZZEKJPRP */ -/* CPIDX2 I ZZEKJPRP */ -/* CLIDX2 I ZZEKJPRP */ -/* ELTS2 I ZZEKJPRP */ -/* STHAN I ZZEKJPRP */ -/* STSDSC I ZZEKJPRP */ -/* STDTPT I ZZEKJPRP */ -/* DTPOOL I ZZEKJPRP */ -/* DTDSCS I ZZEKJPRP */ -/* FOUND O ZZEKJNXT */ -/* ROWVEC O ZZEKJNXT */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their inputs. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error */ -/* SPICE(BOGUSENTRY) is signalled. */ - -/* See the entry points for discussions of exceptions pertaining to */ -/* those routines. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* This suite of routines enables the EK system to execute table */ -/* joins with reasonable efficiency. These routines make use of */ -/* join constraints to limit the number of joined row vectors that */ -/* must be considered in computing a join. */ - -/* These routines deal with a limited case of the join problem: */ -/* the inputs define, for both join row sets participating in the */ -/* join, row vectors that are qualified by a single segment vector. */ -/* Thus this routine is meant to be called once for every pair of */ -/* segment vectors to be considered in executing the join. */ - -/* The layout of a join row set in the EK scratch area is shown */ -/* in the include file for the join row set parameters. */ - -/* $ Examples */ - -/* To use these routines, the normal sequence of actions is to */ -/* call ZZEKJPRP once to initialize them, and then to call */ -/* ZZEKJNXT in a loop to retrieve the row vectors satisfying */ -/* the join constraints. See ZZEKJOIN for an example application. */ - -/* $ Restrictions */ - -/* 1) This routine should not be called by routines outside of the */ -/* EK system. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 20-JUL-1998 (NJB) */ - -/* Modified entry point ZZEKJPRP to set CASE to EMPTY when either */ -/* input row count is zero. Modified entry point ZZEKJNXT to */ -/* set FOUND to .FALSE. on the first pass when CASE is EMPTY. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - /* Parameter adjustments */ - if (segvec) { - } - if (active) { - } - if (cpidx1) { - } - if (clidx1) { - } - if (elts1) { - } - if (ops) { - } - if (cpidx2) { - } - if (clidx2) { - } - if (elts2) { - } - if (sthan) { - } - if (stsdsc) { - } - if (stdtpt) { - } - if (dtpool) { - } - if (dtdscs) { - } - if (rowvec) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzekjprp; - case 2: goto L_zzekjnxt; - } - - chkin_("ZZEKJTST", (ftnlen)8); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZEKJTST", (ftnlen)8); - return 0; -/* $Procedure ZZEKJPRP ( Prepare join condition test ) */ - -L_zzekjprp: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Prepare to test a set of candidate row vectors, all corresponding */ -/* to the same segment vector, against join constraints. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER LBPOOL */ -/* PARAMETER ( LBPOOL = -5 ) */ - -/* INTEGER SEGVEC ( * ) */ -/* INTEGER JBASE1 */ -/* INTEGER NT1 */ -/* INTEGER RB1 */ -/* INTEGER NR1 */ -/* INTEGER JBASE2 */ -/* INTEGER NT2 */ -/* INTEGER RB2 */ -/* INTEGER NR2 */ -/* INTEGER NJCNST */ -/* LOGICAL ACTIVE ( * ) */ -/* INTEGER CPIDX1 ( * ) */ -/* INTEGER CLIDX1 ( * ) */ -/* INTEGER OPS ( * ) */ -/* INTEGER CPIDX2 ( * ) */ -/* INTEGER CLIDX2 ( * ) */ -/* INTEGER STHAN ( * ) */ -/* INTEGER STSDSC ( 3, * ) */ -/* INTEGER STDTPT ( * ) */ -/* INTEGER DTPOOL ( 2, LBPOOL : * ) */ -/* INTEGER DTDSCS ( CDSCSZ, * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SEGVEC I Composite segment vector for joined table. */ -/* JBASE1 I Scratch area base address for first join row set. */ -/* NT1 I Width of first table. */ -/* RB1 I Row vector base address from first join row set. */ -/* NR1 I Number of row vectors from first join row set. */ -/* JBASE2 I Scratch area base address for second join row set. */ -/* NT2 I Width of second table. */ -/* RB2 I Row vector base address from second join row set. */ -/* NR2 I Number of row vectors from second join row set. */ -/* JBASE1 I Scratch area base address of first join row set. */ -/* JBASE2 I Scratch area base address of second join row set. */ -/* NJCNST I Number of join constraints. */ -/* ACTIVE I Array of flags indicating applicable constraints. */ -/* CPIDX1 I Cross product indices for LHS's of constraints. */ -/* CLIDX1 I Column indices for LHS's of constraints. */ -/* OPS I Operator codes for constraints. */ -/* CPIDX2 I Cross product indices for RHS's of constraints. */ -/* CLIDX2 I Column indices for RHS's of constraints. */ -/* STHAN I Array of EK handles corresponding to segments. */ -/* STSDSC I Array of segment descriptors. */ -/* STDTPT I Array of set table column descriptor pointers. */ -/* DTPOOL I Linked list pool for column descriptors. */ -/* DTDSCS I Array of column descriptors. */ - -/* $ Detailed_Input */ - -/* SEGVEC is a composite segment vector for the output row */ -/* vectors resulting from the join done by these */ -/* routines. SEGVEC has been created by suffixing */ -/* a segment vector from the second input join row */ -/* set onto a segment vector from the first join row */ -/* set. */ - -/* JBASE1 is the EK scratch area base address of the first */ -/* input join row set. This address is one less than */ -/* the first address occupied by the join row set. */ -/* See the $Particulars section for a description of */ -/* join row sets. */ - -/* NT1 is the number of tables in the first join row set. */ - -/* RB1 is the scratch area base address of the considered */ -/* row vectors from the first join row set. This */ -/* address is base-relative: JBASE1+RB1 is the actual */ -/* base address of the row vectors. */ - -/* NR1 is the number of rows in the considered portion of */ -/* the first join row set. The portion in question */ -/* is the set of row vectors corresponding to a */ -/* single segment vector, namely, the one occupying */ -/* the first NT1 elements of SEGVEC. */ - -/* JBASE2, */ -/* NT2, */ -/* RB2, */ -/* NR2 are analogous quantities to JBASE1, NT2, RB1, and */ -/* NR1; the quantities here apply to the second input */ -/* join row set. The segment vector qualifying the */ -/* input row vectors from the second join row set */ -/* occupies elements NT1+1 through NT1+NT2 of SEGVEC. */ - - -/* NJCNST is the number of join constraints that must be */ -/* satisfied by the output join row set. Each of the */ -/* input arrays CPIDX1, CLIDX1, OPS, CPIDX2, and */ -/* CLIDX2 contains NJCNST elements. */ - -/* ACTIVE is an array of logical flags indicating which */ -/* constraints are currently applicable. The Nth */ -/* element of ACTIVE indicates whether or not to apply */ -/* the Nth constraint: if ACTIVE(N) is .TRUE., the */ -/* constraint is applicable, otherwise it isn't. */ - -/* In order for a join constraint to be active, it */ -/* must relate a column in the first join row set */ -/* to a column in the second join row set. The LHS */ -/* and RHS of the constraint need not refer */ -/* to the first and second join row sets respectively. */ - -/* The elements of the other input arguments that */ -/* define constraints are defined when the */ -/* corresponding element of ACTIVE is .TRUE. For */ -/* example, when the second constraint is not active, */ -/* the second column descriptor in DTDSCS may not be */ -/* defined. */ - -/* CPIDX1, */ -/* CLIDX1 are, respectively, a set of cross product indices */ -/* and column indices that define the columns on the */ -/* left-hand sides of the input constraints. If the */ -/* first input join row set contains rows from NT1 */ -/* tables and the second input join row set contains */ -/* rows from NT2 tables, then there are (NT1+NT2) */ -/* components in the cross product of the tables */ -/* specified by the input join row sets. We'll index */ -/* these from 1 to (NT1+NT2), with table 1 being the */ -/* first table of the first input join row set, table */ -/* 2 being the second table of the first input join */ -/* row set, table (NT1+1) being the first table of the */ -/* second input join row set, and so on. Each element */ -/* of the argument CPIDX1 designates a table by this */ -/* counting scheme. The corresponding element of the */ -/* argument CLIDX1 is the index of a column in the */ -/* specified table. The index is the ordinal position */ -/* of the column's attributes in the column attribute */ -/* list for the table containing the column. */ - - -/* ELTS1 is an array of element indices that apply to the */ -/* columns on the left-hand-sides of constraints. The */ -/* Ith element of ELTS1 is the column entry index */ -/* that applies to the Ith constraint. */ - -/* OPS is an array of relational operator codes. The */ -/* Ith code applies to the Ith join constraint. */ - -/* CPIDX2, */ -/* CLIDX2 are, respectively, a set of cross product indices */ -/* and column indices that define the columns on the */ -/* right-hand sides of the input constraints. The */ -/* meanings of these arrays are analogous to those */ -/* of CPIDX1 and CLIDX1. Note that the indices are */ -/* relative to the combined table of width NT1+NT2, */ -/* *not* to the second table. */ - -/* ELTS2 is an array of element indices that apply to the */ -/* columns on the right-hand-sides of constraints. */ -/* The Ith element of ELTS2 is the column entry index */ -/* that applies to the Ith constraint. */ - -/* STHAN is an array of EK file handles. The Ith element */ -/* of STHAN is the handle of the EK containing the */ -/* Ith loaded segment. */ - -/* STSDSC is an array of segment descriptors for all */ -/* loaded segments. */ - -/* STDTPT is an array of descriptor table pointers all of */ -/* the loaded segments. For the Ith loaded segment, */ - -/* STDTPT(I) */ - -/* contains the node number of the descriptor entry */ -/* of the first column in the Ith segment, where the */ -/* order of columns is determined by the order in */ -/* which the columns appear in the parent table's */ -/* column attribute list. */ - -/* DTPOOL, */ -/* DTDSCS are, respectively, the linked list pool for */ -/* the column descriptor array and the column */ -/* descriptor array itself. The latter contains */ -/* a descriptor for each loaded column. */ - -/* $ Detailed_Output */ - -/* None. This routine operates entirely by side effects. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* 1) This routine */ - -/* All other error checking must be performed by the caller of this */ -/* routine. Presently, that caller is ZZEKJOIN. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* This routine prepares ZZEKJNXT to return row vectors satisfying */ -/* a specified set of join constraints. The principal job of this */ -/* routine is to determine key columns to guide the order in which */ -/* candidate row vectors are tested. When key columns are */ -/* available, this routine produces order vectors for those columns. */ - -/* This routine writes to the EK scratch area. The caller of this */ -/* routine must take this fact into account, because this routine */ -/* will normally be called during the construction of a join row set, */ -/* and scratch area addresses claimed by this routine will be */ -/* interspersed with those owned by the caller. */ - -/* The territory occupied by this routine may be reclaimed later by */ -/* `squeezing' unused addresses out of the final join row set. This */ -/* operation can be performed by ZZEKJSQZ. */ - -/* $ Examples */ - -/* See ZZEKJOIN. */ - -/* $ Restrictions */ - -/* 1) This routine should not be called by routines outside of the */ -/* EK system. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 20-JUL-1998 (NJB) */ - -/* Modified entry point to set CASE to EMPTY when either */ -/* input row count is zero. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZEKJPRP", (ftnlen)8); - -/* We don't validate the inputs; these must be checked by ZZEKJOIN, */ -/* the only routine that should call this one. */ - -/* Not much preparation is required if either input row count is */ -/* zero, since the cartesian product will be zero. */ - - if (*nr1 == 0 || *nr2 == 0) { - case__ = 4; - chkout_("ZZEKJPRP", (ftnlen)8); - return 0; - } - -/* Set the table count and segment vector count for the output join */ -/* row set. */ - - nt3 = *nt1 + *nt2; - -/* Create handle, segment base, and column descriptor */ -/* arrays for both sides of each active relational constraint. */ - - i__1 = *njcnst; - for (j = 1; j <= i__1; ++j) { - if (active[j - 1]) { - ltab = cpidx1[j - 1]; - rtab = cpidx2[j - 1]; - lseg = segvec[ltab - 1]; - rseg = segvec[rtab - 1]; - lhans[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("lhans", - i__2, "zzekjtst_", (ftnlen)650)] = sthan[lseg - 1]; - rhans[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("rhans", - i__2, "zzekjtst_", (ftnlen)651)] = sthan[rseg - 1]; - movei_(&stsdsc[lseg * 24 - 24], &c__24, &lsdsc[(i__2 = j * 24 - - 24) < 2400 && 0 <= i__2 ? i__2 : s_rnge("lsdsc", i__2, - "zzekjtst_", (ftnlen)653)]); - movei_(&stsdsc[rseg * 24 - 24], &c__24, &rsdsc[(i__2 = j * 24 - - 24) < 2400 && 0 <= i__2 ? i__2 : s_rnge("rsdsc", i__2, - "zzekjtst_", (ftnlen)654)]); - dtptr = stdtpt[lseg - 1]; - i__2 = clidx1[j - 1]; - for (k = 2; k <= i__2; ++k) { - dtptr = lnknxt_(&dtptr, dtpool); - } - movei_(&dtdscs[dtptr * 11 - 11], &c__11, &ldscrs[(i__2 = j * 11 - - 11) < 1100 && 0 <= i__2 ? i__2 : s_rnge("ldscrs", i__2, - "zzekjtst_", (ftnlen)662)]); - dtptr = stdtpt[rseg - 1]; - i__2 = clidx2[j - 1]; - for (k = 2; k <= i__2; ++k) { - dtptr = lnknxt_(&dtptr, dtpool); - } - movei_(&dtdscs[dtptr * 11 - 11], &c__11, &rdscrs[(i__2 = j * 11 - - 11) < 1100 && 0 <= i__2 ? i__2 : s_rnge("rdscrs", i__2, - "zzekjtst_", (ftnlen)672)]); - } - } - -/* Our objective is to limit as far as possible the number of */ -/* row vectors that have to be tested against the join constraints. */ - -/* We break the problem down into cases as follows: */ - -/* 1) Try to find a pair of columns related by an equi-join */ -/* constraint. If such a pair is found, sort each input */ -/* join row set using the appropriate column as a key. */ -/* We then can fairly rapidly compare row vectors for */ -/* equality in the columns to which the equi-join constraint */ -/* applies, and limit the application of the remaining tests */ -/* to row vectors that satisfy the first test. */ - -/* 2) If no equi-join constraints are available, look for */ -/* join constraints using the operators LE, LT, GE, or GT. */ -/* Sort as in (1); then apply the rest of the constraints. */ - -/* 3) Hard luck: the only constraints we have (if any) involve */ -/* the operators NE, LIKE, or UNLIKE, none of which are */ -/* helpful. Test every row vector. */ - - -/* First step: We try to find a pair of columns related by an */ -/* equi-join constraint. */ - - case__ = 3; - j = 1; - fnd = FALSE_; - while(j <= *njcnst && ! fnd) { - if (active[j - 1] && ops[j - 1] == 1) { - -/* Good deal, we've got an equi-join constraint. Save the */ -/* index of this constraint. */ - - case__ = 1; - cnstr = j; - fnd = TRUE_; - } else { - ++j; - } - } - if (case__ == 3) { - j = 1; - fnd = FALSE_; - while(j <= *njcnst && ! fnd) { - if (active[j - 1]) { - if (ops[j - 1] == 5 || ops[j - 1] == 4 || ops[j - 1] == 2 || - ops[j - 1] == 3) { - -/* We've got a non-equi-join constraint. Save the */ -/* index of this constraint. */ - - case__ = 2; - cnstr = j; - fnd = TRUE_; - } - } - if (! fnd) { - ++j; - } - } - } - -/* At this point, we know which case we've got. If we've picked */ -/* a distinguished constraint, produce order vectors for each */ -/* set of input rows vectors, using the keys defined by the */ -/* join constraint. */ - - if (case__ != 3) { - -/* Produce an order vector for the column on the left side of */ -/* the CNSTR constraint. We'll do this by turning the set of */ -/* row vectors we want to sort into a join row set. We'll */ -/* create the join row set metadata and just make it point to */ -/* the collection of row vectors we wish to sort. Consult the */ -/* join row set include file for a picture of the data structure */ -/* we're creating. */ - - zzekstop_(&lbase); - ltab = cpidx1[cnstr - 1]; - lcol = clidx1[cnstr - 1]; - lelt = elts1[cnstr - 1]; - -/* Set JBASE to the base address of the join row set containing */ -/* the table indicated by LTAB. Set NT, NR and RB to indicate, */ -/* respectively, the number of tables in this join row set, the */ -/* number of rows in the join row set, and the base address of the */ -/* relevant row vector set. If LTAB is in the second join row */ -/* set, we'll adjust TAB to indicate position relative to the set */ -/* of tables defining the second join row set. */ - - if (ltab <= *nt1) { - jbase = *jbase1; - nt = *nt1; - nr = *nr1; - rb = *rb1; - tab = ltab; - } else { - jbase = *jbase2; - nt = *nt2; - nr = *nr2; - rb = *rb2; - tab = ltab - *nt1; - } - -/* Save the dimensions and base addresses we'll need later. */ - - svbas1 = jbase; - svnt1 = nt; - svrb1 = rb; - svnr1 = nr; - zzekspsh_(&c__1, &c__0); - zzekspsh_(&c__1, &nr); - zzekspsh_(&c__1, &c__1); - zzekspsh_(&c__1, &c__1); - zzekspsh_(&c__1, &segvec[ltab - 1]); - zzekspsh_(&c__1, &c__7); - zzekspsh_(&c__1, &nr); - i__1 = nr; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Grab the row pointer in position TAB from the Ith row */ -/* vector from the join row set containing the parent table */ -/* of the LHS constraint column. */ - - base = jbase + rb + (i__ - 1) * (nt + 1); - i__2 = base + tab; - i__3 = base + tab; - zzeksrd_(&i__2, &i__3, minirv); - -/* Fill in the segment vector pointer for the new very */ -/* narrow row vector. */ - - minirv[1] = 4; - -/* Append to the join row set under construction. */ - - zzekspsh_(&c__2, minirv); - } - zzekstop_(&top); - i__1 = lbase + 1; - i__2 = lbase + 1; - i__3 = top - lbase; - zzeksupd_(&i__1, &i__2, &i__3); - zzekjsrt_(&c__1, &lbase, &c__1, &c__1, &lcol, &lelt, &c__0, sthan, - stsdsc, stdtpt, dtpool, dtdscs, &lovbas); - -/* Produce an order vector for the column on the right side of */ -/* the CNSTR constraint. */ - - zzekstop_(&rbase); - rtab = cpidx2[cnstr - 1]; - rcol = clidx2[cnstr - 1]; - relt = elts2[cnstr - 1]; - -/* Set JBASE to the base address of the join row set containing */ -/* the table indicated by RTAB. Set NT, NR and RB to indicate, */ -/* respectively, the number of tables in this join row set, the */ -/* number of rows in the join row set, and the base address of the */ -/* relevant row vector set. If RTAB is in the second join row */ -/* set, we'll adjust TAB to indicate position relative to the set */ -/* of tables defining the second join row set. */ - - if (rtab <= *nt1) { - jbase = *jbase1; - nt = *nt1; - nr = *nr1; - rb = *rb1; - tab = rtab; - } else { - jbase = *jbase2; - nt = *nt2; - nr = *nr2; - rb = *rb2; - tab = rtab - *nt1; - } - -/* Save the dimensions and base addresses we'll need later. */ - - svbas2 = jbase; - svnt2 = nt; - svrb2 = rb; - svnr2 = nr; - zzekspsh_(&c__1, &c__0); - zzekspsh_(&c__1, &nr); - zzekspsh_(&c__1, &c__1); - zzekspsh_(&c__1, &c__1); - zzekspsh_(&c__1, &segvec[rtab - 1]); - zzekspsh_(&c__1, &c__7); - zzekspsh_(&c__1, &nr); - i__1 = nr; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Grab the row pointer in position TAB from the Ith row */ -/* vector from the join row set containing the parent table */ -/* of the RHS constraint column. */ - - base = jbase + rb + (i__ - 1) * (nt + 1); - i__2 = base + tab; - i__3 = base + tab; - zzeksrd_(&i__2, &i__3, minirv); - -/* Fill in the segment vector pointer for the new very */ -/* narrow row vector. */ - - minirv[1] = 4; - -/* Append to the join row set under construction. */ - - zzekspsh_(&c__2, minirv); - } - zzekstop_(&top); - i__1 = rbase + 1; - i__2 = rbase + 1; - i__3 = top - rbase; - zzeksupd_(&i__1, &i__2, &i__3); - zzekjsrt_(&c__1, &rbase, &c__1, &c__1, &rcol, &relt, &c__0, sthan, - stsdsc, stdtpt, dtpool, dtdscs, &rovbas); - -/* Keep a local copy of the active constraint flags, deactivating */ -/* the distinguished one. */ - - i__1 = *njcnst; - for (i__ = 1; i__ <= i__1; ++i__) { - locact[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("loca" - "ct", i__2, "zzekjtst_", (ftnlen)935)] = active[i__ - 1]; - } - locact[(i__1 = cnstr - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge("locact", - i__1, "zzekjtst_", (ftnlen)938)] = FALSE_; - } else { - -/* This is the `no luck' case. Save all of the constraints. */ - - i__1 = *njcnst; - for (i__ = 1; i__ <= i__1; ++i__) { - locact[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("loca" - "ct", i__2, "zzekjtst_", (ftnlen)946)] = active[i__ - 1]; - } - -/* Save the counts pertaining to the input join row sets. */ - - svnt1 = *nt1; - svnt2 = *nt2; - svnr1 = *nr1; - svnr2 = *nr2; - svrb1 = *rb1; - svrb2 = *rb2; - svbas1 = *jbase1; - svbas2 = *jbase2; - } - -/* In the non-equi-join case, record whether the join constraint */ -/* requires the left side to be less than, or less than or equal to, */ -/* the right side. */ - - if (case__ == 2) { - lsmall = ops[cnstr - 1] == 5 || ops[cnstr - 1] == 4; - } - -/* Keep our own copy of the relational constraints, except for the */ -/* column indices, which are used only in this routine. */ - - svncon = *njcnst; - i__1 = svncon; - for (i__ = 1; i__ <= i__1; ++i__) { - svcp1[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("svcp1", - i__2, "zzekjtst_", (ftnlen)980)] = cpidx1[i__ - 1]; - svops[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("svops", - i__2, "zzekjtst_", (ftnlen)981)] = ops[i__ - 1]; - svcp2[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("svcp2", - i__2, "zzekjtst_", (ftnlen)982)] = cpidx2[i__ - 1]; - } - -/* Initialize the pointers we'll use to keep track of the */ -/* row vectors we'll be comparing. Initialize the DONE flag */ -/* as well. */ - - lptr = 1; - lcur = 1; - rptr = 1; - done = FALSE_; - chkout_("ZZEKJPRP", (ftnlen)8); - return 0; -/* $Procedure ZZEKJNXT ( Return next join row vector ) */ - -L_zzekjnxt: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return row vectors resulting from the join of two collections */ -/* of row vectors from two join row sets. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* LOGICAL FOUND */ -/* INTEGER ROWVEC ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FOUND O Flag indicating whether a row vector was found. */ -/* ROWVEC O Row vector matching join constraints. */ - -/* $ Detailed_Input */ - -/* None. Inputs are set up by calling ZZEKJPRP. */ - -/* $ Detailed_Output */ - -/* FOUND is a logical flag indicating whether a row vector */ -/* was found on the current call to this routine. */ - -/* ROWVEC is a row vector that satisfies the join */ -/* constraints specified by the last set-up call to */ -/* ZZEKJPRP. ROWVEC is a composite of two row */ -/* vectors from the join row sets specified by inputs */ -/* to ZZEKJPRP. This row vector does not have the */ -/* segment vector pointer filled in. ROWVEC is */ -/* valid only when FOUND is TRUE. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* All error checking must be performed by the caller of this */ -/* routine. Presently, that caller is ZZEKJOIN. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* This routine takes advantage of the preparation performed by */ -/* ZZEKJPRP to find with reasonable efficiency row vectors satisfying */ -/* a specified set of join constraints. */ - -/* $ Examples */ - -/* The normal usage of this routine is to call it repeatedly to */ -/* retrieve one row vector at a time, after setting up the */ -/* operation by calling ZZEKJPRP: */ - -/* CALL ZZEKJPRP ( ... ) */ - -/* CALL ZZEKJNXT ( FOUND, ROWVEC ) */ - -/* DO WHILE ( FOUND ) */ - -/* . */ -/* . */ -/* . */ - -/* CALL ZZEKJNXT ( FOUND, ROWVEC ) */ - -/* END DO */ - - -/* $ Restrictions */ - -/* 1) This routine should not be called by routines outside of the */ -/* EK system. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 20-JUL-1998 (NJB) */ - -/* Modified entry point ZZEKJNXT to set FOUND to .FALSE. on the */ -/* first pass when CASE is EMPTY. */ - -/* - Beta Version 1.0.0, 08-AUG-1995 (NJB) */ - -/* -& */ - -/* No row vector found to start with. */ - - *found = FALSE_; - -/* The action we take depends on the join constraint situation. */ -/* Handle the "empty" case first. */ - - if (case__ == 4) { - return 0; - } else if (case__ == 1) { - while(! done && ! (*found)) { - -/* At this point, LCUR and RPTR should point to the current */ -/* pair of order vector entries to use. We should always have */ - -/* 1 < LPTR < SVNR1 */ -/* - - */ - -/* LPTR < LCUR < SVNR1 */ -/* - - */ - -/* 1 < RPTR < SVNR2 */ -/* - - */ - -/* here. */ - -/* Look up the next set of row vector indices. Get the row */ -/* numbers in the join columns for each order vector in our */ -/* mini-join row sets that we created for sorting. */ - - i__1 = lovbas + lcur; - i__2 = lovbas + lcur; - zzeksrd_(&i__1, &i__2, &lrvidx); - i__1 = rovbas + rptr; - i__2 = rovbas + rptr; - zzeksrd_(&i__1, &i__2, &rrvidx); - addrss = lbase + 7 + (lrvidx - 1 << 1) + 1; - zzeksrd_(&addrss, &addrss, &lrow); - addrss = rbase + 7 + (rrvidx - 1 << 1) + 1; - zzeksrd_(&addrss, &addrss, &rrow); - -/* Compare column entries, and advance the pointers as */ -/* required. */ - - if (zzekrcmp_(&c__5, &c__1, &lhans[(i__1 = cnstr - 1) < 100 && 0 - <= i__1 ? i__1 : s_rnge("lhans", i__1, "zzekjtst_", ( - ftnlen)1197)], &lsdsc[(i__2 = cnstr * 24 - 24) < 2400 && - 0 <= i__2 ? i__2 : s_rnge("lsdsc", i__2, "zzekjtst_", ( - ftnlen)1197)], &ldscrs[(i__3 = cnstr * 11 - 11) < 1100 && - 0 <= i__3 ? i__3 : s_rnge("ldscrs", i__3, "zzekjtst_", ( - ftnlen)1197)], &lrow, &lelt, &rhans[(i__4 = cnstr - 1) < - 100 && 0 <= i__4 ? i__4 : s_rnge("rhans", i__4, "zzekjts" - "t_", (ftnlen)1197)], &rsdsc[(i__5 = cnstr * 24 - 24) < - 2400 && 0 <= i__5 ? i__5 : s_rnge("rsdsc", i__5, "zzekjt" - "st_", (ftnlen)1197)], &rdscrs[(i__6 = cnstr * 11 - 11) < - 1100 && 0 <= i__6 ? i__6 : s_rnge("rdscrs", i__6, "zzekj" - "tst_", (ftnlen)1197)], &rrow, &relt)) { - - -/* The `left' key entry is smaller. Advance the bottom */ -/* pointer on the left side. */ - - if (lptr < svnr1) { - ++lptr; - lcur = lptr; - } else { - done = TRUE_; - } - } else if (zzekrcmp_(&c__1, &c__1, &lhans[(i__1 = cnstr - 1) < - 100 && 0 <= i__1 ? i__1 : s_rnge("lhans", i__1, "zzekjts" - "t_", (ftnlen)1223)], &lsdsc[(i__2 = cnstr * 24 - 24) < - 2400 && 0 <= i__2 ? i__2 : s_rnge("lsdsc", i__2, "zzekjt" - "st_", (ftnlen)1223)], &ldscrs[(i__3 = cnstr * 11 - 11) < - 1100 && 0 <= i__3 ? i__3 : s_rnge("ldscrs", i__3, "zzekj" - "tst_", (ftnlen)1223)], &lrow, &lelt, &rhans[(i__4 = cnstr - - 1) < 100 && 0 <= i__4 ? i__4 : s_rnge("rhans", i__4, - "zzekjtst_", (ftnlen)1223)], &rsdsc[(i__5 = cnstr * 24 - - 24) < 2400 && 0 <= i__5 ? i__5 : s_rnge("rsdsc", i__5, - "zzekjtst_", (ftnlen)1223)], &rdscrs[(i__6 = cnstr * 11 - - 11) < 1100 && 0 <= i__6 ? i__6 : s_rnge("rdscrs", i__6, - "zzekjtst_", (ftnlen)1223)], &rrow, &relt)) { - - -/* The `left' key entry is equal. Form a composite */ -/* row vector and test it against the full set of active */ -/* constraints. */ - - if (svcp1[(i__1 = cnstr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("svcp1", i__1, "zzekjtst_", (ftnlen)1241)] <= - svnt1) { - -/* The parent table of the column on the LHS of our */ -/* equi-join constraint belongs to the first join */ -/* row set. */ - - j = 1; - k = svnt1 + 1; - } else { - j = svnt2 + 1; - k = 1; - } - offset = svrb1 + (lrvidx - 1) * (svnt1 + 1); - i__1 = svbas1 + offset + 1; - i__2 = svbas1 + offset + svnt1; - zzeksrd_(&i__1, &i__2, &rowvec[j - 1]); - offset = svrb2 + (rrvidx - 1) * (svnt2 + 1); - i__1 = svbas2 + offset + 1; - i__2 = svbas2 + offset + svnt2; - zzeksrd_(&i__1, &i__2, &rowvec[k - 1]); - -/* Create row arrays for both sides of each active */ -/* relational constraint. */ - - i__1 = svncon; - for (j = 1; j <= i__1; ++j) { - if (locact[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("locact", i__2, "zzekjtst_", (ftnlen)1274)] - ) { - ltab = svcp1[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("svcp1", i__2, "zzekjtst_", (ftnlen) - 1275)]; - rtab = svcp2[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("svcp2", i__2, "zzekjtst_", (ftnlen) - 1276)]; - lrows[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("lrows", i__2, "zzekjtst_", (ftnlen) - 1277)] = rowvec[ltab - 1]; - rrows[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rrows", i__2, "zzekjtst_", (ftnlen) - 1278)] = rowvec[rtab - 1]; - } - } - *found = zzekvmch_(&svncon, locact, lhans, lsdsc, ldscrs, - lrows, lelts, svops, rhans, rsdsc, rdscrs, rrows, - relts); - -/* Update the pointers. */ - - if (lcur < svnr1) { - ++lcur; - } else if (lcur == svnr1 && rptr < svnr2) { - -/* We've compared every left hand entry from RPTR */ -/* upwards to the right hand entry. Time to work on */ -/* the next right hand entry. */ - - ++rptr; - lcur = lptr; - } else { - -/* LCUR and RPTR point to the last entries in their */ -/* respective row sets. */ - - done = TRUE_; - } - } else { - -/* The current left key entry is greater than that */ -/* on the right. It's time to look at the next entry */ -/* on the right, if possible. */ - - if (rptr < svnr2) { - ++rptr; - lcur = lptr; - } else { - done = TRUE_; - } - } - -/* At this point, we've advanced at least one of LPTR, RPTR, */ -/* or LCUR, or else we've set DONE to .TRUE. */ - - } - } else if (case__ == 2) { - -/* This is the non-equi-join case. */ - - while(! done && ! (*found)) { - -/* At this point, LPTR and RPTR should point to the current */ -/* pair of order vector entries to use. We should always have */ - -/* 1 < LPTR < SVNR1 */ -/* - - */ - -/* 1 < RPTR < SVNR2 */ -/* - - */ - -/* here. */ - -/* Look up the next set of row vector indices. Get the row */ -/* numbers in the join columns for each order vector in our */ -/* mini-join row sets that we created for sorting. */ - - i__1 = lovbas + lptr; - i__2 = lovbas + lptr; - zzeksrd_(&i__1, &i__2, &lrvidx); - i__1 = rovbas + rptr; - i__2 = rovbas + rptr; - zzeksrd_(&i__1, &i__2, &rrvidx); - addrss = lbase + 7 + (lrvidx - 1 << 1) + 1; - zzeksrd_(&addrss, &addrss, &lrow); - addrss = rbase + 7 + (rrvidx - 1 << 1) + 1; - zzeksrd_(&addrss, &addrss, &rrow); - -/* Compare column entries, and advance the pointers as */ -/* required. */ - - if (zzekrcmp_(&svops[(i__1 = cnstr - 1) < 100 && 0 <= i__1 ? i__1 - : s_rnge("svops", i__1, "zzekjtst_", (ftnlen)1374)], & - c__1, &lhans[(i__2 = cnstr - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("lhans", i__2, "zzekjtst_", (ftnlen)1374)], & - lsdsc[(i__3 = cnstr * 24 - 24) < 2400 && 0 <= i__3 ? i__3 - : s_rnge("lsdsc", i__3, "zzekjtst_", (ftnlen)1374)], & - ldscrs[(i__4 = cnstr * 11 - 11) < 1100 && 0 <= i__4 ? - i__4 : s_rnge("ldscrs", i__4, "zzekjtst_", (ftnlen)1374)], - &lrow, &lelt, &rhans[(i__5 = cnstr - 1) < 100 && 0 <= - i__5 ? i__5 : s_rnge("rhans", i__5, "zzekjtst_", (ftnlen) - 1374)], &rsdsc[(i__6 = cnstr * 24 - 24) < 2400 && 0 <= - i__6 ? i__6 : s_rnge("rsdsc", i__6, "zzekjtst_", (ftnlen) - 1374)], &rdscrs[(i__7 = cnstr * 11 - 11) < 1100 && 0 <= - i__7 ? i__7 : s_rnge("rdscrs", i__7, "zzekjtst_", (ftnlen) - 1374)], &rrow, &relt)) { - - -/* This pair of row vectors satisfies the join constraint. */ -/* Form a composite row vector and test it against the full */ -/* set of active constraints. */ - - if (svcp1[(i__1 = cnstr - 1) < 100 && 0 <= i__1 ? i__1 : - s_rnge("svcp1", i__1, "zzekjtst_", (ftnlen)1392)] <= - svnt1) { - -/* The parent table of the column on the LHS of our */ -/* equi-join constraint belongs to the first join */ -/* row set. */ - - j = 1; - k = svnt1 + 1; - } else { - j = svnt2 + 1; - k = 1; - } - offset = svrb1 + (lrvidx - 1) * (svnt1 + 1); - i__1 = svbas1 + offset + 1; - i__2 = svbas1 + offset + svnt1; - zzeksrd_(&i__1, &i__2, &rowvec[j - 1]); - offset = svrb2 + (rrvidx - 1) * (svnt2 + 1); - i__1 = svbas2 + offset + 1; - i__2 = svbas2 + offset + svnt2; - zzeksrd_(&i__1, &i__2, &rowvec[k - 1]); - -/* Create row arrays for both sides of each active */ -/* relational constraint. */ - - i__1 = svncon; - for (j = 1; j <= i__1; ++j) { - if (locact[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("locact", i__2, "zzekjtst_", (ftnlen)1426)] - ) { - ltab = svcp1[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("svcp1", i__2, "zzekjtst_", (ftnlen) - 1427)]; - rtab = svcp2[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("svcp2", i__2, "zzekjtst_", (ftnlen) - 1428)]; - lrows[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("lrows", i__2, "zzekjtst_", (ftnlen) - 1429)] = rowvec[ltab - 1]; - rrows[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rrows", i__2, "zzekjtst_", (ftnlen) - 1430)] = rowvec[rtab - 1]; - } - } - *found = zzekvmch_(&svncon, locact, lhans, lsdsc, ldscrs, - lrows, lelts, svops, rhans, rsdsc, rdscrs, rrows, - relts); - if (lsmall) { - -/* The `left' key entry is smaller. All higher-indexed */ -/* rows on the right side also satisfy the join */ -/* constraint, combined with the current left hand side. */ - - if (rptr < svnr2) { - ++rptr; - } else if (lptr < svnr1) { - ++lptr; - rptr = 1; - } else { - done = TRUE_; - } - } else { - -/* The `right' key entry is smaller. All higher-indexed */ -/* rows on the left side also satisfy the join */ -/* constraint, combined with the current right hand side. */ - - if (lptr < svnr1) { - ++lptr; - } else if (rptr < svnr2) { - ++rptr; - lptr = 1; - } else { - done = TRUE_; - } - } - -/* We incremented LPTR or RPTR, or else we set DONE to */ -/* .TRUE. */ - - } else { - -/* The constraint was not met by the rows under */ -/* consideration. */ - - if (lsmall) { - -/* If the right side can be incremented, there's a */ -/* chance of a match. */ - - if (rptr < svnr2) { - ++rptr; - } else { - done = TRUE_; - } - } else { - -/* If the left side can be incremented, there's a */ -/* chance of a match. */ - - if (lptr < svnr1) { - ++lptr; - } else { - done = TRUE_; - } - } - -/* We incremented LPTR or RPTR, or else we set DONE to */ -/* .TRUE. */ - - } - } - } else { - -/* We have no order vectors to help us out, so we just loop */ -/* through every possible combination. When we find a match, */ -/* we return immediately, leaving the pointers set to enable */ -/* continuation of our search when we drop back into the loop */ -/* on a subsequent call. */ - - while(lptr <= svnr1) { - while(rptr <= svnr2) { - -/* Form a composite row vector and test it against the full */ -/* set of active constraints. */ - - offset = svrb1 + (lptr - 1) * (svnt1 + 1); - i__1 = svbas1 + offset + 1; - i__2 = svbas1 + offset + svnt1; - zzeksrd_(&i__1, &i__2, rowvec); - offset = svrb2 + (rptr - 1) * (svnt2 + 1); - i__1 = svbas2 + offset + 1; - i__2 = svbas2 + offset + svnt2; - zzeksrd_(&i__1, &i__2, &rowvec[svnt1]); - -/* Create row arrays for both sides of each active */ -/* relational constraint. */ - - i__1 = svncon; - for (j = 1; j <= i__1; ++j) { - if (locact[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("locact", i__2, "zzekjtst_", (ftnlen)1567)] - ) { - ltab = svcp1[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("svcp1", i__2, "zzekjtst_", (ftnlen) - 1568)]; - rtab = svcp2[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 - : s_rnge("svcp2", i__2, "zzekjtst_", (ftnlen) - 1569)]; - lrows[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("lrows", i__2, "zzekjtst_", (ftnlen) - 1570)] = rowvec[ltab - 1]; - rrows[(i__2 = j - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("rrows", i__2, "zzekjtst_", (ftnlen) - 1571)] = rowvec[rtab - 1]; - } - } - *found = zzekvmch_(&svncon, locact, lhans, lsdsc, ldscrs, - lrows, lelts, svops, rhans, rsdsc, rdscrs, rrows, - relts); - ++rptr; - if (*found) { - return 0; - } - } - ++lptr; - rptr = 1; - } - } - return 0; -} /* zzekjtst_ */ - -/* Subroutine */ int zzekjtst_(integer *segvec, integer *jbase1, integer *nt1, - integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer * - rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, - integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, - integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, - integer *stdtpt, integer *dtpool, integer *dtdscs, logical *found, - integer *rowvec) -{ - return zzekjtst_0_(0, segvec, jbase1, nt1, rb1, nr1, jbase2, nt2, rb2, - nr2, njcnst, active, cpidx1, clidx1, elts1, ops, cpidx2, clidx2, - elts2, sthan, stsdsc, stdtpt, dtpool, dtdscs, found, rowvec); - } - -/* Subroutine */ int zzekjprp_(integer *segvec, integer *jbase1, integer *nt1, - integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer * - rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, - integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, - integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, - integer *stdtpt, integer *dtpool, integer *dtdscs) -{ - return zzekjtst_0_(1, segvec, jbase1, nt1, rb1, nr1, jbase2, nt2, rb2, - nr2, njcnst, active, cpidx1, clidx1, elts1, ops, cpidx2, clidx2, - elts2, sthan, stsdsc, stdtpt, dtpool, dtdscs, (logical *)0, ( - integer *)0); - } - -/* Subroutine */ int zzekjnxt_(logical *found, integer *rowvec) -{ - return zzekjtst_0_(2, (integer *)0, (integer *)0, (integer *)0, (integer * - )0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, ( - integer *)0, (integer *)0, (logical *)0, (integer *)0, (integer *) - 0, (integer *)0, (integer *)0, (integer *)0, (integer *)0, ( - integer *)0, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0, found, rowvec); - } - diff --git a/ext/spice/src/cspice/zzekkey.c b/ext/spice/src/cspice/zzekkey.c deleted file mode 100644 index fc6bb88da8..0000000000 --- a/ext/spice/src/cspice/zzekkey.c +++ /dev/null @@ -1,1145 +0,0 @@ -/* zzekkey.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1000 = 1000; -static integer c__11 = 11; - -/* $Procedure ZZEKKEY ( EK, determine key column ) */ -/* Subroutine */ int zzekkey_(integer *handle, integer *segdsc, integer * - nrows, integer *ncnstr, integer *clidxs, integer *dsclst, integer * - ops, integer *dtypes, char *chrbuf, integer *cbegs, integer *cends, - doublereal *dvals, integer *ivals, logical *active, integer *key, - integer *keydsc, integer *begidx, integer *endidx, logical *found, - ftnlen chrbuf_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - logical elim; - extern integer ordi_(integer *, integer *); - integer best; - extern integer zzekille_(integer *, integer *, integer *, integer *, - integer *, char *, doublereal *, integer *, ftnlen), zzekillt_( - integer *, integer *, integer *, integer *, integer *, char *, - doublereal *, integer *, ftnlen); - integer b, e, i__, j; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), movei_(integer *, - integer *, integer *); - integer dtype; - extern logical failed_(void); - integer nmatch, conmap[1000]; - extern logical return_(void); - integer eltidx, idxset[1006], lastle, lastlt, maxptr, minptr; - logical indexd; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssizei_(integer *, integer *), insrti_(integer *, - integer *); - logical fnd; - integer col; - -/* $ Abstract */ - -/* Determine the key column to use when searching an EK segment */ -/* for rows matching query constraints. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of EK file containing segment. */ -/* SEGDSC I Segment descriptor. */ -/* NROWS I Number of rows in segment. */ -/* NCNSTR I Number of relational constraints in query. */ -/* CLIDXS I Column attribute table indices for columns. */ -/* DSCLST I Array of column descriptors for constraints. */ -/* OPS I Operations used in query constraints. */ -/* DTYPES I Data types of scalar values used in constraints. */ -/* CHRBUF I Buffer containting query tokens. */ -/* CBEGS I Begin indices of character query tokens. */ -/* CENDS I End indices of character query tokens. */ -/* DVALS I D.p. values used in query constraints. */ -/* IVALS I Integer values used in query constraints. */ -/* ACTIVE I-O Array of flags indicating applicable constraints. */ -/* KEY O Index of key column. */ -/* KEYDSC O Descriptor of key column. */ -/* BEGIDX O Begin index of candidate row set. */ -/* ENDIDX O End index of candidate row set. */ -/* FOUND O Flag indicating whether a key column was found. */ -/* MAXCON P Maximum number of constraints allowed in query. */ -/* CDSCSZ P Column descriptor size. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of the EK file containing the */ -/* segment currently being searched for matching rows. */ - -/* SEGDSC the descriptor of the segment. */ - -/* NROWS is the number of rows in the segment designated by */ -/* HANDLE and SEGDSC. */ - -/* NCNSTR is the number of input relational constraints. */ -/* The input arrays CLIDXS, DSCLST, OPS, CHRBUF, */ -/* CBEGS, CENDS, DVALS, and IVALS define these */ -/* constraints. Not all of the constraints may */ -/* be applicable; the applicable constraints are */ -/* identified by the input argument ACTIVE, which */ -/* is described below. Each *applicable* constraint */ -/* has the form */ - -/* */ - -/* CLIDXS is an array of column indices; the Nth index */ -/* identifies the column on the left hand side of the */ -/* Nth constraint. Each index indicates the ordinal */ -/* position of the attribute information for the */ -/* corresponding column within the column attribute */ -/* list for the column's parent table. See the */ -/* local variable declarations in EKBSR for further */ -/* information on the column attribute list. */ - -/* DSCLST is an array of column descriptors for the columns */ -/* referenced in the input constraints. The Ith */ -/* descriptor corresponds to the Ith constraint. */ - - -/* OPS are relational operators used in the input */ -/* constraints. The elements of OPS are any of the */ -/* integer parameters */ - -/* EQ, GE, GT, LE, LT, NE, LIKE, UNLIKE */ - -/* The Nth element of OPS corresponds to the Nth */ -/* constraint. */ - -/* DTYPES is an array of data type codes for the values on */ -/* the right hand sides of the input constraints. */ -/* The Ith element of DTYPES applies to the Ith */ -/* constraint. */ - -/* CHRBUF, */ -/* CBEGS, */ -/* CENDS are, respectively, a string containing character */ -/* tokens representing values on the right hand sides */ -/* of query constraints, and arrays of begin and end */ -/* indices of these tokens within CHRBUF. If the Nth */ -/* constraint has a character value on the right hand */ -/* side, that value is CHRBUF( CBEGS(N) : CENDS(N) ). */ -/* For constraints whose right hand sides do not */ -/* specify character values, the corresponding */ -/* elements of CBEGS and CENDS are not used. */ - -/* DVALS, */ -/* IVALS are, respectively, arrays of double precision and */ -/* integer values appearing on the right hand sides of */ -/* input constraints. The contents of DVALS and IVALS */ -/* are meaningful only for those constraints whose */ -/* right hand sides specify values having these data */ -/* types. */ - -/* ACTIVE is an array of logical flags indicating which */ -/* constraints are currently applicable. The Nth */ -/* element of ACTIVE indicates whether or not to apply */ -/* the Nth constraint: if ACTIVE(N) is .TRUE., the */ -/* constraint is applicable, otherwise it isn't. */ - -/* The elements of the other input arguments that */ -/* define constraints are defined when the */ -/* corresponding element of ACTIVE is .TRUE. For */ -/* example, when the second constraint is not active, */ -/* the second column descriptor in DSCLST may not be */ -/* defined. */ - -/* Only constraints relating column entries to literal */ -/* values may be active. */ - -/* $ Detailed_Output */ - -/* ACTIVE indicates, on output, which constraints are still */ -/* active. All constraints satisfied by the candidate */ -/* row set are turned off on output. */ - -/* KEY is the index of the key column. This index is */ -/* taken from the input argument CLIDXS. */ - -/* KEYDSC is the column descriptor for the key column. Note */ -/* that this descriptor indicates whether the key */ -/* column is indexed. */ - -/* BEGIDX, */ -/* ENDIDX are, respectively, begin and end indices for the */ -/* candidate matching rows in the segment being */ -/* searched. These indices refer to positions in the */ -/* key column's index: the candidate rows are pointed */ -/* to index elements having indices ranging from */ -/* BEGIDX to ENDIDX, inclusively. The actual */ -/* candidate rows are referred to with one level of */ -/* indirection. */ - -/* If the constraints on the key column entirely */ -/* eliminate all rows in the segment, the returned */ -/* values of BEGIDX and ENDIDX are, respectively, 1 */ -/* and 0. */ - -/* FOUND is a logical flag indicating whether a key column */ -/* was determined. The other outputs of this routine */ -/* are valid only if a key column was found. This */ -/* routine will fail to find a key column if there are */ -/* no active constraints on indexed columns. */ - -/* $ Parameters */ - -/* MAXCON is the maximum number of constraints that may */ -/* be used in a query. */ - -/* CDSCSZ is the size of a column descriptor. */ - -/* $ Exceptions */ - -/* 1) If the segment contains no indexed columns on which there are */ -/* active constraints, the output argument FOUND is set to */ -/* .FALSE. The other output arguments are undefined in this */ -/* case. */ - -/* 2) If the constraints on the key column entirely eliminate all */ -/* rows in the segment, the returned values of BEGIDX and ENDIDX */ -/* are, respectively, 1 and 0. */ - -/* 3) If the number of input constraints is out of range, the error */ -/* SPICE(INVALIDCOUNT) is signalled. */ - -/* $ Files */ - -/* See the description of the input argument HANDLE. */ - -/* $ Particulars */ - -/* The EKSRCH algorithm for finding rows matching a given set */ -/* of constraints attempts to use constraints on indexed columns */ -/* to enable the matching process to be performed efficiently. */ -/* The idea is to find the indexed column whose constraints limit */ -/* the possible set of matching rows to the smallest number; then */ -/* to linearly search through this set of candidate rows to see */ -/* which ones satisfy the remaining applicable constraints. The */ -/* column used to initially limit the set of candidate rows is */ -/* called the `key column'. The constraints on the key column that */ -/* are of interest are ones involving order relations or equality: */ -/* these constraints use the operators */ - -/* EQ GE GT LE LT */ - -/* Note that the NE operator is not of much use here. */ - -/* The set of candidate rows simultaneously satisifies all such */ -/* constraints on the key column, and therefore is the intersection */ -/* of the set of rows satisfying each such constraint. This method */ -/* of selecting candidate rows can rapidly eliminate large numbers of */ -/* rows from consideration, because the index on the key column can */ -/* be employed in finding rows that match constraints involving order */ -/* relations: the start and end indices of such rows can be found */ -/* by a binary, rather than linear, search. */ - -/* A segment may have multiple indexed columns on which there are */ -/* constraints involving order or equality relations; in this case */ -/* the column whose constraints are most restrictive is selected as */ -/* the key column. */ - -/* It may also happen that a segment contains no indexed columns. */ -/* In such a case, the key column is not useful for narrowing the */ -/* set of candidate rows. The first column of the segment is */ -/* arbitrarily selected as the key column in this case. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 26-JUL-1996 (NJB) */ - -/* Added check of FAILED after calls to the EK search functions. */ - -/* - SPICELIB Version 1.1.0, 17-APR-1996 (WLT) */ - -/* Removed spurious periods that appeared at the */ -/* end of lines 524 and 577 in previous edition. */ - -/* - Beta Version 1.0.0, 23-OCT-1995 (NJB) */ - - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 26-JUL-1996 (NJB) */ - -/* Added check of FAILED after calls to the EK search functions. */ -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKKEY", (ftnlen)7); - } - -/* There's no key column to begin with. */ - - *found = FALSE_; - if (*ncnstr < 0 || *ncnstr > 1000) { - setmsg_("The number of constraints was #; valid range is 0:#", ( - ftnlen)51); - errint_("#", ncnstr, (ftnlen)1); - errint_("#", &c__1000, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKKEY", (ftnlen)7); - return 0; - } - -/* Make a set out of the indices of indexed columns referenced */ -/* in active constraints. Maintain a mapping from each column */ -/* to the index of some constraint that references that column. */ - - ssizei_(&c__1000, idxset); - i__1 = *ncnstr; - for (i__ = 1; i__ <= i__1; ++i__) { - if (active[i__ - 1]) { - indexd = dsclst[i__ * 11 - 6] != -1; - if (indexd) { - insrti_(&clidxs[i__ - 1], idxset); - } - } - } - i__1 = cardi_(idxset); - for (i__ = 1; i__ <= i__1; ++i__) { - fnd = FALSE_; - j = 1; - while(j <= *ncnstr && ! fnd) { - if (active[j - 1] && clidxs[j - 1] == idxset[(i__2 = i__ + 5) < - 1006 && 0 <= i__2 ? i__2 : s_rnge("idxset", i__2, "zzekk" - "ey_", (ftnlen)427)]) { - fnd = TRUE_; - conmap[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "conmap", i__2, "zzekkey_", (ftnlen)429)] = j; - } else { - ++j; - } - } - } - -/* We finish up now if there are no indexed columns */ -/* on which there are active constraints. */ - - if (cardi_(idxset) == 0) { - chkout_("ZZEKKEY", (ftnlen)7); - return 0; - } - -/* For each column in the `indexed' set, find out how many */ -/* candidate rows we'd have if we picked that column as the key */ -/* column. If we find that the constraints on some column eliminate */ -/* all matching rows, we can stop. */ - - *begidx = 1; - *endidx = *nrows; - best = idxset[6]; - nmatch = *nrows; - elim = FALSE_; - eltidx = 1; - while(eltidx <= cardi_(idxset) && ! elim) { - -/* Get the attribute list pointer for the current column. */ - - col = idxset[(i__1 = eltidx + 5) < 1006 && 0 <= i__1 ? i__1 : s_rnge( - "idxset", i__1, "zzekkey_", (ftnlen)468)]; - -/* Set the initial values of MINPTR, MAXPTR, and NMATCH */ - - minptr = 1; - maxptr = *nrows; - i__ = 1; - while(i__ <= *ncnstr && ! elim) { - -/* For each constraint, increase MINPTR or decrease MAXPTR */ -/* if the constraint allows us to do so. */ - - if (clidxs[i__ - 1] == col && active[i__ - 1]) { - -/* The Ith constraint is active and applies to this column. */ - -/* If the column has character type, set the bounds of the */ -/* token on the right hand side of the constraint. */ -/* Otherwise, set the bounds to default valid values to */ -/* avoid subscript bounds errors. */ - - dtype = dsclst[i__ * 11 - 10]; - if (dtype == 1) { - b = cbegs[i__ - 1]; - e = cends[i__ - 1]; - } else { - b = 1; - e = 1; - } - -/* At this point, MINPTR and MAXPTR are in the range */ -/* 1:NROWS, and MINPTR is less than or equal to MAXPTR. */ - - if (ops[i__ - 1] == 5) { - -/* Find the index of the pointer to the last row */ -/* whose value in this column is less than the */ -/* value cited in the Ith constraint. */ - - lastlt = zzekillt_(handle, segdsc, &dsclst[i__ * 11 - 11], - nrows, &dtypes[i__ - 1], chrbuf + (b - 1), & - dvals[i__ - 1], &ivals[i__ - 1], e - (b - 1)); - -/* If all column elements were greater than or equal */ -/* to the specified value, MAXPTR will be set to zero. */ - - maxptr = min(lastlt,maxptr); - elim = maxptr == 0; - } else if (ops[i__ - 1] == 4) { - -/* Find the index of the pointer to the last row */ -/* whose value in this column is less or equal to */ -/* the value cited in the Ith constraint. */ - - lastle = zzekille_(handle, segdsc, &dsclst[i__ * 11 - 11], - nrows, &dtypes[i__ - 1], chrbuf + (b - 1), & - dvals[i__ - 1], &ivals[i__ - 1], e - (b - 1)); - maxptr = min(lastle,maxptr); - elim = maxptr == 0; - } else if (ops[i__ - 1] == 1) { - -/* Find both the pointer to the last row whose */ -/* value in this column is less than the value cited in */ -/* the Ith constraint, and the pointer to the last row */ -/* whose value in this column is less than or equal to */ -/* the value cited in the Ith constraint. The */ -/* successor of the former pointer, together with */ -/* the latter pointer, bound the range of pointers */ -/* to possible matching rows. */ - - lastlt = zzekillt_(handle, segdsc, &dsclst[i__ * 11 - 11], - nrows, &dtypes[i__ - 1], chrbuf + (b - 1), & - dvals[i__ - 1], &ivals[i__ - 1], e - (b - 1)); - lastle = zzekille_(handle, segdsc, &dsclst[i__ * 11 - 11], - nrows, &dtypes[i__ - 1], chrbuf + (b - 1), & - dvals[i__ - 1], &ivals[i__ - 1], e - (b - 1)); - if (lastlt < lastle) { - -/* There is at least one row whose value in the */ -/* current column matches the value cited in the Ith */ -/* constraint, and LASTLE is the index of the pointer */ -/* to the last such row. The successor of LASTLT is */ -/* the first pointer to such a row (even if LASTLT is */ -/* zero). */ - -/* Computing MAX */ - i__1 = lastlt + 1; - minptr = max(i__1,minptr); - maxptr = min(lastle,maxptr); - } else { - -/* No rows match this constraint. */ - - elim = TRUE_; - } - } else if (ops[i__ - 1] == 3) { - -/* Find the index of the pointer to the last row */ -/* whose value in this column is less or equal to */ -/* the value cited in the Ith constraint. The index of */ -/* the pointer to the first row satisfying all of the */ -/* constraints on this column is the successor of */ -/* this pointer or a greater pointer. */ - - lastle = zzekille_(handle, segdsc, &dsclst[i__ * 11 - 11], - nrows, &dtypes[i__ - 1], chrbuf + (b - 1), & - dvals[i__ - 1], &ivals[i__ - 1], e - (b - 1)); -/* Computing MAX */ - i__1 = lastle + 1; - minptr = max(i__1,minptr); - elim = lastle == *nrows; - } else if (ops[i__ - 1] == 2) { - -/* Find the index of the pointer to the last row */ -/* whose value in this column is less than the */ -/* value cited in the Ith constraint. The index of the */ -/* pointer to the first row satisfying all of the */ -/* constraints on this column is the successor of */ -/* this pointer or a greater pointer. */ - - lastlt = zzekillt_(handle, segdsc, &dsclst[i__ * 11 - 11], - nrows, &dtypes[i__ - 1], chrbuf + (b - 1), & - dvals[i__ - 1], &ivals[i__ - 1], e - (b - 1)); -/* Computing MAX */ - i__1 = lastlt + 1; - minptr = max(i__1,minptr); - elim = lastlt == *nrows; - } - -/* We've checked the Ith constraint to see whether */ -/* it applied to the current column, and if it did, */ -/* we adjusted MINPTR and MAXPTR to reflect the */ -/* constraint. */ - - } - -/* We've applied the Ith constraint, if it was active. */ - - if (minptr > maxptr) { - elim = TRUE_; - } - if (! elim) { - ++i__; - } - if (failed_()) { - chkout_("ZZEKKEY", (ftnlen)7); - return 0; - } - } - -/* We've applied all of active, applicable constraints to column */ -/* COL. If these constraints did not eliminate the current */ -/* segment entirely, save the number of candidate rows we'd have */ -/* if we kept this column as the key column. */ - - if (! elim) { - nmatch = maxptr - minptr + 1; - if (nmatch < *endidx - *begidx + 1) { - -/* This is our new key column, until a better one comes */ -/* along. */ - - best = col; - *begidx = minptr; - *endidx = maxptr; - } - ++eltidx; - } - } - if (elim) { - -/* If the segment was eliminated by constraints on the last column */ -/* we looked at, set BEGIDX and ENDIDX to indicate the absence of */ -/* matching rows. */ - - *key = col; - *begidx = 1; - *endidx = 0; - } else { - -/* BEST, BEGIDX, and ENDIDX are set to reflect the key column. */ -/* Set KEY and grab the descriptor of the key column. */ - - *key = best; - } - i__ = conmap[(i__1 = ordi_(key, idxset) - 1) < 1000 && 0 <= i__1 ? i__1 : - s_rnge("conmap", i__1, "zzekkey_", (ftnlen)694)]; - movei_(&dsclst[i__ * 11 - 11], &c__11, keydsc); - -/* De-activate constraints on the key column that we've already */ -/* applied. */ - - i__1 = *ncnstr; - for (i__ = 1; i__ <= i__1; ++i__) { - if (active[i__ - 1] && clidxs[i__ - 1] == *key) { - if (ops[i__ - 1] == 5 || ops[i__ - 1] == 4 || ops[i__ - 1] == 1 || - ops[i__ - 1] == 2 || ops[i__ - 1] == 3) { - -/* This constraint is met by the candidate rows; we can */ -/* turn it off. */ - - active[i__ - 1] = FALSE_; - } - } - } - -/* At this point, we've found a key column. */ - - *found = TRUE_; - chkout_("ZZEKKEY", (ftnlen)7); - return 0; -} /* zzekkey_ */ - diff --git a/ext/spice/src/cspice/zzeklerc.c b/ext/spice/src/cspice/zzeklerc.c deleted file mode 100644 index abcb31c570..0000000000 --- a/ext/spice/src/cspice/zzeklerc.c +++ /dev/null @@ -1,603 +0,0 @@ -/* zzeklerc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKLERC ( EK, LLE, using record pointers, character ) */ -/* Subroutine */ int zzeklerc_(integer *handle, integer *segdsc, integer * - coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, - integer *prvptr, ftnlen ckey_len) -{ - extern /* Subroutine */ int zzekerc1_(integer *, integer *, integer *, - char *, integer *, logical *, integer *, integer *, ftnlen), - zzekcnam_(integer *, integer *, char *, ftnlen), chkin_(char *, - ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer dtype, itype; - extern logical failed_(void); - logical indexd; - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specified, indexed character EK column, using dictionary */ -/* ordering on character data values and record pointers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CKEY I Double precision key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ -/* PRVIDX O Ordinal position of predecessor of CKEY. */ -/* PRVPTR O Record pointer for predecessor of CKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK that is open for read or */ -/* write access. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* CKEY, */ -/* RECPTR are, respectively, a character key and a pointer */ -/* to the EK record containing that key. */ -/* The last column entry less than or equal to */ -/* this key is sought. The order relation used */ -/* is dictionary ordering on the pair (CKEY, RECPTR). */ - -/* NULL is a logical flag indicating whether the input */ -/* key is null. When NULL is .TRUE., CKEY is */ -/* ignored by this routine. */ - -/* $ Detailed_Output */ - -/* PRVIDX is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to CKEY, where the order relation is */ -/* as indicated above. If the column contains */ -/* elements equal to CKEY, PRVIDX is the index of the */ -/* last such element. */ - -/* If all elements of the column are greater than */ -/* CKEY, PRVIDX is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVIDX. */ - -/* If all elements of the column are greater than */ -/* CKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified character key, within a specified segment and */ -/* column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKIIXC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERC ", (ftnlen)9); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLERC ", (ftnlen)9); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERC ", (ftnlen)9); - setmsg_("Column # should be CHR but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLERC ", (ftnlen)9); - return 0; - } - -/* Hand the problem off to the subroutine that understands this */ -/* column's index type. */ - - itype = coldsc[5]; - if (itype == 1) { - zzekerc1_(handle, segdsc, coldsc, ckey, recptr, null, prvidx, prvptr, - ckey_len); - } else { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERC ", (ftnlen)9); - setmsg_("Column # has index type #.", (ftnlen)26); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLERC ", (ftnlen)9); - return 0; - } - return 0; -} /* zzeklerc_ */ - diff --git a/ext/spice/src/cspice/zzeklerd.c b/ext/spice/src/cspice/zzeklerd.c deleted file mode 100644 index 0dcf5fb59e..0000000000 --- a/ext/spice/src/cspice/zzeklerd.c +++ /dev/null @@ -1,602 +0,0 @@ -/* zzeklerd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKLERD ( EK, LLE, using record numbers, d.p. ) */ -/* Subroutine */ int zzeklerd_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dkey, integer *recptr, logical *null, integer * - prvidx, integer *prvptr) -{ - extern /* Subroutine */ int zzekerd1_(integer *, integer *, integer *, - doublereal *, integer *, logical *, integer *, integer *), - zzekcnam_(integer *, integer *, char *, ftnlen), chkin_(char *, - ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer dtype, itype; - extern logical failed_(void); - logical indexd; - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specified, indexed d.p. EK column, using dictionary */ -/* ordering on d.p. data values and record pointers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DKEY I Double precision key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ -/* PRVIDX O Ordinal position of predecessor of DKEY. */ -/* PRVPTR O Pointer to record containing predecessor of DKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* DKEY, */ -/* RECPTR are, respectively, a double precision key and */ -/* a pointer to the EK record containing that key. */ -/* The last column entry less than or equal to */ -/* this key is sought. The order relation used */ -/* is dictionary ordering on the pair (DKEY, RECPTR). */ - -/* NULL is a logical flag indicating whether the input */ -/* key is null. When NULL is .TRUE., DKEY is */ -/* ignored by this routine. */ - -/* $ Detailed_Output */ - -/* PRVIDX is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to DKEY, where the order relation is */ -/* as indicated above. If the column contains */ -/* elements equal to DKEY, PRVIDX is the index of the */ -/* last such element. */ - -/* If all elements of the column are greater than */ -/* DKEY, PRVIDX is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVIDX. */ - -/* If all elements of the column are greater than */ -/* DKEY, PRVPTR is set to zero. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not d.p., */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified d.p. key, within a specified segment and */ -/* column. The order relation used is dictionary ordering on the */ -/* pair (DKEY, RECPTR). */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKIID1. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT. */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERD", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLERD", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERD", (ftnlen)8); - setmsg_("Column # should be DP or TIME but has type #.", (ftnlen)45); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLERD", (ftnlen)8); - return 0; - } - -/* Hand the problem off to the subroutine that understands this */ -/* column's index type. */ - - itype = coldsc[5]; - if (itype == 1) { - zzekerd1_(handle, segdsc, coldsc, dkey, recptr, null, prvidx, prvptr); - } else { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERD", (ftnlen)8); - setmsg_("Column # has index type #.", (ftnlen)26); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLERD", (ftnlen)8); - return 0; - } - return 0; -} /* zzeklerd_ */ - diff --git a/ext/spice/src/cspice/zzekleri.c b/ext/spice/src/cspice/zzekleri.c deleted file mode 100644 index c04d799abb..0000000000 --- a/ext/spice/src/cspice/zzekleri.c +++ /dev/null @@ -1,603 +0,0 @@ -/* zzekleri.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKLERI ( EK, LLE, using record pointers, integer ) */ -/* Subroutine */ int zzekleri_(integer *handle, integer *segdsc, integer * - coldsc, integer *ikey, integer *recptr, logical *null, integer * - prvidx, integer *prvptr) -{ - extern /* Subroutine */ int zzekeri1_(integer *, integer *, integer *, - integer *, integer *, logical *, integer *, integer *), zzekcnam_( - integer *, integer *, char *, ftnlen), chkin_(char *, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - integer dtype, itype; - extern logical failed_(void); - logical indexd; - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specified, indexed integer EK column, using dictionary */ -/* ordering on integer data values and record pointers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IKEY I Integer key. */ -/* RECPTR I Record pointer. */ -/* NULL I Null flag. */ -/* PRVIDX O Ordinal position of predecessor of IKEY. */ -/* PRVPTR O Pointer to record containing predecessor of IKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* IKEY, */ -/* RECPTR are, respectively, an integer key and a */ -/* pointer to the EK record containing that key. */ -/* The last column entry less than or equal to */ -/* this key is sought. The order relation used */ -/* is dictionary ordering on the pair (IKEY, RECPTR). */ - -/* NULL is a logical flag indicating whether the input */ -/* key is null. When NULL is .TRUE., IKEY is */ -/* ignored by this routine. */ - -/* $ Detailed_Output */ - -/* PRVIDX is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to IKEY, where the order relation is */ -/* as indicated above. If the column contains */ -/* elements equal to IKEY, PRVIDX is the index of the */ -/* last such element. */ - -/* If all elements of the column are greater than */ -/* IKEY, PRVIDX is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVIDX. */ - -/* If all elements of the column are greater than */ -/* IKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not integer, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified integer key, within a specified segment and */ -/* column. The order relation used is dictionary ordering on the */ -/* pair (IKEY, RECPTR). */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that the number of elements referenced by the */ -/* input column's index match the pointer of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKIII1. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed an unbalanced call to CHKOUT */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (failed_()) { - return 0; - } - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERI", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLERI", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERI", (ftnlen)8); - setmsg_("Column # should be INT but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLERI", (ftnlen)8); - return 0; - } - -/* Hand the problem off to the subroutine that understands this */ -/* column's index type. */ - - itype = coldsc[5]; - if (itype == 1) { - zzekeri1_(handle, segdsc, coldsc, ikey, recptr, null, prvidx, prvptr); - } else { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLERI", (ftnlen)8); - setmsg_("Column # has index type #.", (ftnlen)26); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &itype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLERI", (ftnlen)8); - return 0; - } - return 0; -} /* zzekleri_ */ - diff --git a/ext/spice/src/cspice/zzekllec.c b/ext/spice/src/cspice/zzekllec.c deleted file mode 100644 index 185d73144b..0000000000 --- a/ext/spice/src/cspice/zzekllec.c +++ /dev/null @@ -1,721 +0,0 @@ -/* zzekllec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static doublereal c_b16 = 0.; -static integer c__0 = 0; -static logical c_false = FALSE_; -static integer c__4 = 4; - -/* $Procedure ZZEKLLEC ( EK, last less than or equal to, character ) */ -/* Subroutine */ int zzekllec_(integer *handle, integer *segdsc, integer * - coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len) -{ - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzekixlk_(integer *, integer *, integer *, - integer *); - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer dtype, nrows, middle; - logical indexd; - char column[32]; - integer begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer end; - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specified, indexed character EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CKEY I Character key. */ -/* PRVLOC O Ordinal position of predecessor of CKEY. */ -/* PRVPTR O Record pointer for predecessor of CKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* CKEY is a character string key. The last column entry */ -/* less than this key is sought. */ - -/* $ Detailed_Output */ - -/* PRVLOC is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to CKEY. If the column contains elements */ -/* equal to CKEY, PRVLOC is the index of the last */ -/* such element. */ - -/* If all elements of the column are greater than */ -/* CKEY, PRVLOC is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVLOC. */ - -/* If all elements of the column are greater than */ -/* CKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified character key, within a specified segment and */ -/* column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKILLE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLEC", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLLEC", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLEC", (ftnlen)8); - setmsg_("Column # should be CHR but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLLEC", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty segment gracefully. */ - - nrows = segdsc[5]; - if (nrows == 0) { - *prvloc = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLED. */ - - begin = 1; - end = nrows; - -/* Get the record pointers BEGPTR and ENDPTR to the least and */ -/* greatest elements in the column. */ - - zzekixlk_(handle, coldsc, &begin, &begptr); - zzekixlk_(handle, coldsc, &end, &endptr); - if (zzekscmp_(&c__3, handle, segdsc, coldsc, &begptr, &c__1, &c__1, ckey, - &c_b16, &c__0, &c_false, ckey_len)) { - -/* The smallest entry of the column is greater than */ -/* the input value, so none of the entries */ -/* are less than or equal to the input value. */ - - *prvloc = 0; - *prvptr = 0; - } else if (zzekscmp_(&c__4, handle, segdsc, coldsc, &endptr, &c__1, &c__1, - ckey, &c_b16, &c__0, &c_false, ckey_len)) { - -/* The last element of the array is less than or equal to the */ -/* input value. */ - - *prvloc = nrows; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } else { - -/* The input value lies between some pair of column entries. */ -/* The value is greater than or equal to the smallest column entry */ -/* and less than the greatest entry. */ - - while(end > begin + 1) { - -/* Find the address of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzekixlk_(handle, coldsc, &middle, &midptr); - if (zzekscmp_(&c__4, handle, segdsc, coldsc, &midptr, &c__1, & - c__1, ckey, &c_b16, &c__0, &c_false, ckey_len)) { - -/* The middle value is less than the input value of the */ -/* same data type. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than or equal to the element */ -/* having ordinal position BEGIN and strictly less than the */ -/* element having ordinal position END. */ - - } - *prvloc = begin; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } - return 0; -} /* zzekllec_ */ - diff --git a/ext/spice/src/cspice/zzeklled.c b/ext/spice/src/cspice/zzeklled.c deleted file mode 100644 index 54eb13daf6..0000000000 --- a/ext/spice/src/cspice/zzeklled.c +++ /dev/null @@ -1,720 +0,0 @@ -/* zzeklled.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__0 = 0; -static logical c_false = FALSE_; -static integer c__4 = 4; - -/* $Procedure ZZEKLLED ( EK, last less than or equal to, d.p. ) */ -/* Subroutine */ int zzeklled_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dkey, integer *prvloc, integer *prvptr) -{ - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzekixlk_(integer *, integer *, integer *, - integer *); - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer dtype, nrows, middle; - logical indexd; - char column[32]; - integer begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer end; - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specified, indexed double precision EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DKEY I Double precision key. */ -/* PRVLOC O Ordinal position of predecessor of DKEY. */ -/* PRVPTR O Record pointer for predecessor of DKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* DKEY is an double precision string key. The last column */ -/* entry less than this key is sought. */ - -/* $ Detailed_Output */ - -/* PRVLOC is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to DKEY. If the column contains elements */ -/* equal to DKEY, PRVLOC is the index of the last */ -/* such element. */ - -/* If all elements of the column are greater than */ -/* DKEY, PRVLOC is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVLOC. */ - -/* If all elements of the column are greater than */ -/* DKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified double precision key, within a specified segment */ -/* and column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKILLE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLED", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLLED", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLED", (ftnlen)8); - setmsg_("Column # should be DP or TIME but has type #.", (ftnlen)45); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLLED", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty segment gracefully. */ - - nrows = segdsc[5]; - if (nrows == 0) { - *prvloc = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLED. */ - - begin = 1; - end = nrows; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzekixlk_(handle, coldsc, &begin, &begptr); - zzekixlk_(handle, coldsc, &end, &endptr); - if (zzekscmp_(&c__3, handle, segdsc, coldsc, &begptr, &c__1, &c__2, " ", - dkey, &c__0, &c_false, (ftnlen)1)) { - -/* The smallest entry of the column is greater than */ -/* the input value, so none of the entries */ -/* are less than or equal to the input value. */ - - *prvloc = 0; - *prvptr = 0; - } else if (zzekscmp_(&c__4, handle, segdsc, coldsc, &endptr, &c__1, &c__2, - " ", dkey, &c__0, &c_false, (ftnlen)1)) { - -/* The last element of the array is less than or equal to the */ -/* input value. */ - - *prvloc = nrows; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } else { - -/* The input value lies between some pair of column entries. */ -/* The value is greater than or equal to the smallest column entry */ -/* and less than the greatest entry. */ - - while(end > begin + 1) { - -/* Find the address of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzekixlk_(handle, coldsc, &middle, &midptr); - if (zzekscmp_(&c__4, handle, segdsc, coldsc, &midptr, &c__1, & - c__2, " ", dkey, &c__0, &c_false, (ftnlen)1)) { - -/* The middle value is less than or equal to the input */ -/* value. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than or equal to the element */ -/* having ordinal position BEGIN and strictly less than the */ -/* element having ordinal position END. */ - - } - *prvloc = begin; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } - return 0; -} /* zzeklled_ */ - diff --git a/ext/spice/src/cspice/zzekllei.c b/ext/spice/src/cspice/zzekllei.c deleted file mode 100644 index e94253a6d8..0000000000 --- a/ext/spice/src/cspice/zzekllei.c +++ /dev/null @@ -1,719 +0,0 @@ -/* zzekllei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; -static doublereal c_b17 = 0.; -static logical c_false = FALSE_; -static integer c__4 = 4; - -/* $Procedure ZZEKLLEI ( EK, last less than or equal to, integer ) */ -/* Subroutine */ int zzekllei_(integer *handle, integer *segdsc, integer * - coldsc, integer *ikey, integer *prvloc, integer *prvptr) -{ - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzekixlk_(integer *, integer *, integer *, - integer *); - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer dtype, nrows, middle; - logical indexd; - char column[32]; - integer begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer end; - -/* $ Abstract */ - -/* Find the last column value less than or equal to a specified key, */ -/* for a specified, indexed integer EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IKEY I Integer key. */ -/* PRVLOC O Ordinal position of predecessor of IKEY. */ -/* PRVPTR O Pointer to a record containing predecessor of IKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* IKEY is an integer key. The last column entry */ -/* less than or equal to this key is sought. */ - -/* $ Detailed_Output */ - -/* PRVLOC is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than or */ -/* equal to IKEY. If the column contains elements */ -/* equal to IKEY, PRVLOC is the index of the last */ -/* such element. */ - -/* If all elements of the column are greater than */ -/* IKEY, PRVLOC is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVLOC. */ - -/* If all elements of the column are greater than */ -/* IKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than or equal */ -/* to a specified integer key, within a specified segment and */ -/* column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKILLE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLEI", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLLEI", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLEI", (ftnlen)8); - setmsg_("Column # should be INT but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLLEI", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty segment gracefully. */ - - nrows = segdsc[5]; - if (nrows == 0) { - *prvloc = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLED. */ - - begin = 1; - end = nrows; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzekixlk_(handle, coldsc, &begin, &begptr); - zzekixlk_(handle, coldsc, &end, &endptr); - if (zzekscmp_(&c__3, handle, segdsc, coldsc, &begptr, &c__1, &c__3, " ", & - c_b17, ikey, &c_false, (ftnlen)1)) { - -/* The smallest entry of the column is greater than */ -/* the input value, so none of the entries */ -/* are less than or equal to the input value. */ - - *prvloc = 0; - *prvptr = 0; - } else if (zzekscmp_(&c__4, handle, segdsc, coldsc, &endptr, &c__1, &c__3, - " ", &c_b17, ikey, &c_false, (ftnlen)1)) { - -/* The last element of the array is less than or equal to the */ -/* input value. */ - - *prvloc = nrows; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } else { - -/* The input value lies between some pair of column entries. */ -/* The value is greater than or equal to the smallest column entry */ -/* and less than the greatest entry. */ - - while(end > begin + 1) { - -/* Find the address of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzekixlk_(handle, coldsc, &middle, &midptr); - if (zzekscmp_(&c__4, handle, segdsc, coldsc, &midptr, &c__1, & - c__3, " ", &c_b17, ikey, &c_false, (ftnlen)1)) { - -/* The middle value is less than or equal to the input */ -/* value. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than or equal to the element */ -/* having ordinal position BEGIN and strictly less than the */ -/* element having ordinal position END. */ - - } - *prvloc = begin; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } - return 0; -} /* zzekllei_ */ - diff --git a/ext/spice/src/cspice/zzeklltc.c b/ext/spice/src/cspice/zzeklltc.c deleted file mode 100644 index ef1567acfd..0000000000 --- a/ext/spice/src/cspice/zzeklltc.c +++ /dev/null @@ -1,718 +0,0 @@ -/* zzeklltc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static doublereal c_b16 = 0.; -static integer c__0 = 0; -static logical c_false = FALSE_; -static integer c__5 = 5; - -/* $Procedure ZZEKLLTC ( EK, last less than, character ) */ -/* Subroutine */ int zzeklltc_(integer *handle, integer *segdsc, integer * - coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len) -{ - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzekixlk_(integer *, integer *, integer *, - integer *); - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer dtype, nrows, middle; - logical indexd; - char column[32]; - integer begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer end; - -/* $ Abstract */ - -/* Find the last column value less than a specified key, */ -/* for a specified, indexed character EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* CKEY I Character key. */ -/* PRVLOC O Ordinal position of predecessor of CKEY. */ -/* PRVPTR O Pointer to record containing predecessor of CKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* CKEY is a character string key. The last column entry */ -/* less than this key is sought. */ - -/* $ Detailed_Output */ - -/* PRVLOC is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than CKEY. */ - -/* If all elements of the column are greater than */ -/* or equal to CKEY, PRVLOC is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVLOC. */ - -/* If all elements of the column are greater than */ -/* or equal to CKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than a specified */ -/* character key, within a specified segment and column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKILLT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLTC", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLLTC", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLTC", (ftnlen)8); - setmsg_("Column # should be CHR but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLLTC", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty segment gracefully. */ - - nrows = segdsc[5]; - if (nrows == 0) { - *prvloc = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLTD. */ - - begin = 1; - end = nrows; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzekixlk_(handle, coldsc, &begin, &begptr); - zzekixlk_(handle, coldsc, &end, &endptr); - if (zzekscmp_(&c__2, handle, segdsc, coldsc, &begptr, &c__1, &c__1, ckey, - &c_b16, &c__0, &c_false, ckey_len)) { - -/* The smallest entry of the column is greater than or equal to */ -/* the input value of the same data type, so none of the entries */ -/* are less than the input value. */ - - *prvloc = 0; - *prvptr = 0; - } else if (zzekscmp_(&c__5, handle, segdsc, coldsc, &endptr, &c__1, &c__1, - ckey, &c_b16, &c__0, &c_false, ckey_len)) { - -/* The last element of the array is less than the input value of */ -/* the same data type, so it's the last item less than the input */ -/* value. */ - - *prvloc = nrows; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } else { - -/* The input value lies between some pair of column entries. */ -/* The value is greater than the smallest column entry and */ -/* less than or equal to the greatest entry. */ - - while(end > begin + 1) { - -/* Find the address of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzekixlk_(handle, coldsc, &middle, &midptr); - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &midptr, &c__1, & - c__1, ckey, &c_b16, &c__0, &c_false, ckey_len)) { - -/* The middle value is less than the input value of the */ -/* same data type. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than the element having ordinal */ -/* position BEGIN and less than or equal to the element having */ -/* ordinal position END. */ - - } - *prvloc = begin; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } - return 0; -} /* zzeklltc_ */ - diff --git a/ext/spice/src/cspice/zzeklltd.c b/ext/spice/src/cspice/zzeklltd.c deleted file mode 100644 index 6beaa4a6fa..0000000000 --- a/ext/spice/src/cspice/zzeklltd.c +++ /dev/null @@ -1,715 +0,0 @@ -/* zzeklltd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__0 = 0; -static logical c_false = FALSE_; -static integer c__5 = 5; - -/* $Procedure ZZEKLLTD ( EK, last less than, d.p. ) */ -/* Subroutine */ int zzeklltd_(integer *handle, integer *segdsc, integer * - coldsc, doublereal *dkey, integer *prvloc, integer *prvptr) -{ - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzekixlk_(integer *, integer *, integer *, - integer *); - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer dtype, nrows, middle; - logical indexd; - char column[32]; - integer begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer end; - -/* $ Abstract */ - -/* Find the last column value less than a specified key, */ -/* for a specified, indexed double precision EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* DKEY I Double precision key. */ -/* PRVLOC O Ordinal position of predecessor of DKEY. */ -/* PRVPTR O Pointer to a record containing predecessor of DKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* DKEY is a double precision key. The last column entry */ -/* less than this key is sought. */ - -/* $ Detailed_Output */ - -/* PRVLOC is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than DKEY. */ - -/* If all elements of the column are greater than */ -/* or equal to DKEY, PRVLOC is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVLOC. */ - -/* If all elements of the column are greater than */ -/* or equal to DKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not double precision, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than a specified */ -/* double precision key, within a specified segment and column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKILLT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLTD", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLLTD", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLTD", (ftnlen)8); - setmsg_("Column # should be DP or TIME but has type #.", (ftnlen)45); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLLTD", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty segment gracefully. */ - - nrows = segdsc[5]; - if (nrows == 0) { - *prvloc = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLTD. */ - - begin = 1; - end = nrows; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzekixlk_(handle, coldsc, &begin, &begptr); - zzekixlk_(handle, coldsc, &end, &endptr); - if (zzekscmp_(&c__2, handle, segdsc, coldsc, &begptr, &c__1, &c__2, " ", - dkey, &c__0, &c_false, (ftnlen)1)) { - -/* The smallest entry of the column is greater than or equal to */ -/* the input value of the same data type, so none of the entries */ -/* are less than the input value. */ - - *prvloc = 0; - *prvptr = 0; - } else if (zzekscmp_(&c__5, handle, segdsc, coldsc, &endptr, &c__1, &c__2, - " ", dkey, &c__0, &c_false, (ftnlen)1)) { - -/* The last element of the array is less than the input value of */ -/* the same data type, so it's the last item less than the input */ -/* value. */ - - *prvloc = nrows; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } else { - -/* The input value lies between some pair of column entries. */ -/* The value is greater than the smallest column entry and */ -/* less than or equal to the greatest entry. */ - - while(end > begin + 1) { - -/* Find the address of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzekixlk_(handle, coldsc, &middle, &midptr); - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &midptr, &c__1, & - c__2, " ", dkey, &c__0, &c_false, (ftnlen)1)) { - -/* The middle value is less than the input value of the */ -/* same data type. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than the element having ordinal */ -/* position BEGIN and less than or equal to the element having */ -/* ordinal position END. */ - - } - *prvloc = begin; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } - return 0; -} /* zzeklltd_ */ - diff --git a/ext/spice/src/cspice/zzekllti.c b/ext/spice/src/cspice/zzekllti.c deleted file mode 100644 index 0eb2c3ec17..0000000000 --- a/ext/spice/src/cspice/zzekllti.c +++ /dev/null @@ -1,717 +0,0 @@ -/* zzekllti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__3 = 3; -static doublereal c_b17 = 0.; -static logical c_false = FALSE_; -static integer c__5 = 5; - -/* $Procedure ZZEKLLTI ( EK, last less than, integer ) */ -/* Subroutine */ int zzekllti_(integer *handle, integer *segdsc, integer * - coldsc, integer *ikey, integer *prvloc, integer *prvptr) -{ - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - extern /* Subroutine */ int zzekixlk_(integer *, integer *, integer *, - integer *); - integer begin; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer dtype, nrows, middle; - logical indexd; - char column[32]; - integer begptr, endptr, midptr; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer end; - -/* $ Abstract */ - -/* Find the last column value less than a specified key, */ -/* for a specified, indexed integer EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* IKEY I Integer key. */ -/* PRVLOC O Ordinal position of predecessor of IKEY. */ -/* PRVPTR O Pointer to record containing predecessor of IKEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column to be */ -/* searched. */ - -/* IKEY is an integer key. The last column entry */ -/* less than this key is sought. */ - -/* $ Detailed_Output */ - -/* PRVLOC is the ordinal position, according to the order */ -/* relation implied by the column's index, of the */ -/* record containing the last element less than IKEY. */ - -/* If all elements of the column are greater than */ -/* or equal to IKEY, PRVLOC is set to zero. */ - -/* PRVPTR is a pointer to the record containing the element */ -/* whose ordinal position is PRVLOC. */ - -/* If all elements of the column are greater than */ -/* or equal to IKEY, PRVPTR is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the data type of the input column is not character, */ -/* the error SPICE(INVALIDTYPE) is signalled. */ - -/* 3) If the input column is not indexed, the error */ -/* SPICE(NOTINDEXED) is signalled. */ - -/* 4) If the index type of the input column is not recognized, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 5) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the last column element less than a specified */ -/* integer key, within a specified segment and column. */ - -/* In order to support the capability of creating an index for a */ -/* column that has already been populated with data, this routine */ -/* does not require that number of elements referenced by the */ -/* input column's index match the number of elements in the column; */ -/* the index is allowed to reference fewer elements. However, */ -/* every record referenced by the index must be populated with data. */ - -/* $ Examples */ - -/* See ZZEKILLT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* If the column's not indexed, we have no business being here. */ - - indexd = coldsc[5] != -1; - if (! indexd) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLTI", (ftnlen)8); - setmsg_("Column # is not indexed.", (ftnlen)24); - errch_("#", column, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); - chkout_("ZZEKLLTI", (ftnlen)8); - return 0; - } - -/* Check the column's data type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKLLTI", (ftnlen)8); - setmsg_("Column # should be INT but has type #.", (ftnlen)38); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKLLTI", (ftnlen)8); - return 0; - } - -/* Handle the case of an empty segment gracefully. */ - - nrows = segdsc[5]; - if (nrows == 0) { - *prvloc = 0; - *prvptr = 0; - return 0; - } - -/* The algorithm used here is very like unto that used in LSTLTD. */ - - begin = 1; - end = nrows; - -/* Get the record pointers BEGPTR and ENDPTR of the least and */ -/* greatest elements in the column. */ - - zzekixlk_(handle, coldsc, &begin, &begptr); - zzekixlk_(handle, coldsc, &end, &endptr); - if (zzekscmp_(&c__2, handle, segdsc, coldsc, &begptr, &c__1, &c__3, " ", & - c_b17, ikey, &c_false, (ftnlen)1)) { - -/* The smallest entry of the column is greater than or equal to */ -/* the input value of the same data type, so none of the entries */ -/* are less than the input value. */ - - *prvloc = 0; - *prvptr = 0; - } else if (zzekscmp_(&c__5, handle, segdsc, coldsc, &endptr, &c__1, &c__3, - " ", &c_b17, ikey, &c_false, (ftnlen)1)) { - -/* The last element of the array is less than the input value of */ -/* the same data type, so it's the last item less than the input */ -/* value. */ - - *prvloc = nrows; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } else { - -/* The input value lies between some pair of column entries. */ -/* The value is greater than the smallest column entry and */ -/* less than or equal to the greatest entry. */ - - while(end > begin + 1) { - -/* Find the address of the element whose ordinal position */ -/* is halfway between BEGIN and END. */ - - middle = (begin + end) / 2; - zzekixlk_(handle, coldsc, &middle, &midptr); - if (zzekscmp_(&c__5, handle, segdsc, coldsc, &midptr, &c__1, & - c__3, " ", &c_b17, ikey, &c_false, (ftnlen)1)) { - -/* The middle value is less than the input value of the */ -/* same data type. */ - - begin = middle; - } else { - end = middle; - } - -/* The input value is greater than the element having ordinal */ -/* position BEGIN and less than or equal to the element having */ -/* ordinal position END. */ - - } - *prvloc = begin; - zzekixlk_(handle, coldsc, prvloc, prvptr); - } - return 0; -} /* zzekllti_ */ - diff --git a/ext/spice/src/cspice/zzekmloc.c b/ext/spice/src/cspice/zzekmloc.c deleted file mode 100644 index eab1c27e1b..0000000000 --- a/ext/spice/src/cspice/zzekmloc.c +++ /dev/null @@ -1,279 +0,0 @@ -/* zzekmloc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKMLOC ( EK, return integer metadata location ) */ -/* Subroutine */ int zzekmloc_(integer *handle, integer *segno, integer *page, - integer *base) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer nseg, tree; - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *); - extern integer zzektrbs_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer tbase; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - extern integer eknseg_(integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Return the integer metadata location of a specified segment. The */ -/* number and DAS integer base address of the first integer */ -/* page of the metadata are returned. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK File Metadata Parameters */ - -/* ekfilpar.inc Version 1 28-MAR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* The metadata for an architecture 4 EK file is very simple: it */ -/* consists of a single integer, which is a pointer to a tree */ -/* that in turn points to the segments in the EK. However, in the */ -/* interest of upward compatibility, one integer page is reserved */ -/* for the file's metadata. */ - - -/* Size of file parameter block: */ - - -/* All offsets shown below are relative to the beginning of the */ -/* first integer page in the EK. */ - - -/* Index of the segment pointer tree---this location contains the */ -/* root page number of the tree: */ - - -/* End Include Section: EK File Metadata Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* PAGE O Integer metadata start page number. */ -/* BASE O Page base. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The EK may be open for read */ -/* or write access. */ - -/* SEGNO is the number of the segment whose integer metadata */ -/* location is sought. */ - -/* $ Detailed_Output */ - -/* PAGE is the number of the first page containing integer */ -/* metadata for the specified segment. The segment */ -/* descriptor starts at the first address of this */ -/* page. */ - -/* BASE is the DAS integer base address of the page */ -/* whose number is given by PAGE. BASE is the */ -/* predecessor of the first DAS integer word */ -/* belonging to this page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it deletes a record */ -/* from an EK segment. Deleting a record implies: */ - -/* 1) All column entries in the record are deleted. */ - -/* 2) Link counts are decremented for data pages containing */ -/* column entries in the record to be deleted. Pages whose */ -/* link counts drop to zero are freed. */ - -/* 3) All column indexes are updated for the parent segment. */ - -/* 4) The link count is decremented for the page containing the */ -/* record pointer structure of the record to be deleted. If */ -/* the link count drops to zero, the page is freed. */ - -/* 5) The pointer to the deleted record is deleted from the */ -/* record tree for the parent segment. */ - -/* 6) The segment's metadata is updated to reflect the new */ -/* record count. */ - -/* $ Examples */ - -/* See EKINSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Added the required discovery CHKIN. */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Validate the segment number to start out. */ - - -/* Get the segment count; valididate SEGNO. */ - - nseg = eknseg_(handle); - -/* Check out SEGNO. */ - - if (*segno < 1 || *segno > nseg) { - chkin_("ZZEKMLOC", (ftnlen)8); - setmsg_("Segment number = #; valid range is 1:#.", (ftnlen)39); - errint_("#", segno, (ftnlen)1); - errint_("#", &nseg, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX )", (ftnlen)20); - chkout_("ZZEKMLOC", (ftnlen)8); - return 0; - } - -/* Find the segment in the segment tree. */ -/* Obtain the base address of the first integer page. */ - - tbase = zzektrbs_(&c__1); - -/* Look up the head node of the segment tree. */ - - i__1 = tbase + 1; - i__2 = tbase + 1; - dasrdi_(handle, &i__1, &i__2, &tree); - -/* Get the segment pointer for the segment having index SEGNO. */ -/* This pointer is actually the page number we're looking for. */ - - zzektrdp_(handle, &tree, segno, page); - -/* Return the base address of the metadata page as well. */ - - *base = zzektrbs_(page); - return 0; -} /* zzekmloc_ */ - diff --git a/ext/spice/src/cspice/zzeknres.c b/ext/spice/src/cspice/zzeknres.c deleted file mode 100644 index 7a2afdc97f..0000000000 --- a/ext/spice/src/cspice/zzeknres.c +++ /dev/null @@ -1,974 +0,0 @@ -/* zzeknres.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKNRES ( Private: EK, resolve names in encoded query ) */ -/* Subroutine */ int zzeknres_(char *query, integer *eqryi, char *eqryc, - logical *error, char *errmsg, integer *errptr, ftnlen query_len, - ftnlen eqryc_len, ftnlen errmsg_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - integer base, ntab, ncnj, ncns, nord, nsel; - extern /* Subroutine */ int zzekcchk_(char *, integer *, char *, integer * - , char *, char *, integer *, logical *, char *, integer *, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen), zzekqtab_(integer *, char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen), zzekreqi_( - integer *, char *, integer *, ftnlen), zzekweqi_(char *, integer * - , integer *, ftnlen); - integer i__, j; - char table[64*10], alias[64*10]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nload; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer cc[10]; - extern logical failed_(void); - char ltable[64]; - extern /* Subroutine */ int ekntab_(integer *); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer cnstyp, iparse; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), ektnam_(integer *, char *, - ftnlen), ekccnt_(char *, integer *, ftnlen); - logical fnd; - integer lxb, lxe; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Resolve and semantically check table names, aliases, and column */ -/* names in an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I-O Integer component of query. */ -/* EQRYC I-O Character component of query. */ -/* ERROR O Error flag. */ -/* ERRMSG O Error message. */ -/* ERRPTR O Position in query where error was detected. */ - -/* $ Detailed_Input */ - -/* QUERY is the original query from which EQRYI and EQRYC */ -/* were obtained. QUERY is used only for */ -/* construction of error messages. */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* On output, all names have been resolved, and */ -/* table names, aliases, and column names have */ -/* been semantically checked. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* ERROR is a logical flag indicating whether an error was */ -/* detected. The error could be a name resolution */ -/* error or a semantic error. */ - -/* ERRMSG is an error message describing an error in the */ -/* input query, if one was detected. If ERROR is */ -/* returned .FALSE., then ERRPTR is undefined. */ - -/* ERRPTR is the character position in the original query */ -/* at which an error was detected, if an error was */ -/* found. This index refers to the offending lexeme's */ -/* position in the original query represented by the */ -/* input encoded query. If ERROR is returned .FALSE., */ -/* ERRPTR is undefined. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been parsed, the error */ -/* SPICE(QUERYNOTPARSED) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If any sort of name resolution error or semantic error is */ -/* detected in the input query, the output flag ERROR is set, */ -/* and an error message is returned. The checks performed by */ -/* this routine are listed below: */ - -/* - All tables named in the FROM clause must be loaded */ -/* in the EK system. */ - -/* - All aliases in the FROM clause must be distinct. */ - -/* - No alias may be the name of a table in the FROM clause, */ -/* unless it is identical to the name of the table it is */ -/* associated with. */ - -/* - No column name may be qualified with a name that is not */ -/* the name or alias of a table in the FROM clause. */ - -/* - Each qualified column must be present in the table */ -/* indicated by its qualifying name. */ - -/* - Each unqualified column name must be the name of a */ -/* column present in exactly one of the tables listed in the */ -/* FROM clause. */ -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Resolution of table names involves finding each table's ordinal */ -/* position in the FROM clause, and setting the table's descriptor */ -/* to record that position. The same is done for column descriptors. */ - -/* $ Examples */ - -/* See EKFIND. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* No error to start with. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *errptr = 0; - -/* The query must have been parsed at this point, or it's no go. */ - - zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6); - if (failed_()) { - return 0; - } - if (iparse == -1) { - chkin_("ZZEKNRES", (ftnlen)8); - setmsg_("Encoded query has not been parsed.", (ftnlen)34); - sigerr_("SPICE(QUERYNOTPARSED)", (ftnlen)21); - chkout_("ZZEKNRES", (ftnlen)8); - return 0; - } - -/* Get the important counts from the query. */ - - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &ncnj, (ftnlen)16); - zzekreqi_(eqryi, "NUM_ORDERBY_COLS", &nord, (ftnlen)16); - zzekreqi_(eqryi, "NUM_SELECT_COLS", &nsel, (ftnlen)15); - -/* Start out by fetching the table names and their aliases. */ - - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqtab_(eqryi, eqryc, &i__, table + (((i__2 = i__ - 1) < 10 && 0 <= - i__2 ? i__2 : s_rnge("table", i__2, "zzeknres_", (ftnlen)254)) - << 6), alias + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("alias", i__3, "zzeknres_", (ftnlen)254)) << 6), - eqryc_len, (ftnlen)64, (ftnlen)64); - } - -/* Make sure that the aliases are distinct. Rather than sorting */ -/* them, we'll check them in left-to-right order. */ - - i__1 = ntab - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = ntab; - for (j = i__ + 1; j <= i__2; ++j) { - if (s_cmp(alias + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("alias", i__3, "zzeknres_", (ftnlen)265)) << 6), - alias + (((i__4 = j - 1) < 10 && 0 <= i__4 ? i__4 : - s_rnge("alias", i__4, "zzeknres_", (ftnlen)265)) << 6), ( - ftnlen)64, (ftnlen)64) == 0 && s_cmp(alias + (((i__5 = - i__ - 1) < 10 && 0 <= i__5 ? i__5 : s_rnge("alias", i__5, - "zzeknres_", (ftnlen)265)) << 6), " ", (ftnlen)64, ( - ftnlen)1) != 0) { - *error = TRUE_; - s_copy(errmsg, "Non-distinct alias <#> was found.", - errmsg_len, (ftnlen)33); - base = ((j - 1 << 1) + 1) * 6 + 19; - lxb = eqryi[base + 7]; - lxe = eqryi[base + 8]; - repmc_(errmsg, "#", query + (lxb - 1), errmsg, errmsg_len, ( - ftnlen)1, lxe - (lxb - 1), errmsg_len); - *errptr = lxb; - return 0; - } - -/* We've checked the Jth alias for a match. */ - - } - } - -/* Make sure that no alias matches a table name other than that of */ -/* the table it corresponds to. */ - - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - j = isrchc_(alias + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("alias", i__2, "zzeknres_", (ftnlen)295)) << 6), &ntab, - table, (ftnlen)64, (ftnlen)64); - if (j != 0) { - if (j != i__) { - *error = TRUE_; - s_copy(errmsg, "Alias <#> conflicts with table name.", - errmsg_len, (ftnlen)36); - base = ((i__ - 1 << 1) + 1) * 6 + 19; - lxb = eqryi[base + 7]; - lxe = eqryi[base + 8]; - repmc_(errmsg, "#", query + (lxb - 1), errmsg, errmsg_len, ( - ftnlen)1, lxe - (lxb - 1), errmsg_len); - *errptr = lxb; - return 0; - } - } - } - -/* Make sure that all of the tables are loaded in the EK system. */ - - ekntab_(&nload); - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - fnd = FALSE_; - j = 1; - while(j <= nload && ! fnd) { - ektnam_(&j, ltable, (ftnlen)64); - if (s_cmp(table + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("table", i__2, "zzeknres_", (ftnlen)336)) << 6), - ltable, (ftnlen)64, (ftnlen)64) == 0) { - -/* When we find a loaded table, save the column count for */ -/* that table. */ - - fnd = TRUE_; - ekccnt_(table, &cc[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("cc", i__2, "zzeknres_", (ftnlen)342)], ( - ftnlen)64); - } else { - ++j; - } - } - if (! fnd) { - *error = TRUE_; - s_copy(errmsg, "Table <#> is not currently loaded.", errmsg_len, ( - ftnlen)34); - -/* In order to set the error pointer, we'll need the */ -/* lexeme begin value for the offending table. */ - - base = (i__ - 1) * 12 + 19; - lxb = eqryi[base + 7]; - lxe = eqryi[base + 8]; - repmc_(errmsg, "#", query + (lxb - 1), errmsg, errmsg_len, ( - ftnlen)1, lxe - (lxb - 1), errmsg_len); - *errptr = lxb; - return 0; - } - } - -/* At this point, the tables and aliases are deemed correct. For */ -/* safety, fill in each table and alias descriptor with its */ -/* ordinal position. */ - - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - base = (i__ - 1) * 12 + 19; - eqryi[base + 11] = i__; - eqryi[base + 17] = i__; - } - -/* Check the column names used in the constraints. */ - - i__1 = ncns; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the base address of the constraint. */ - - base = ntab * 12 + 19 + (i__ - 1) * 26; - -/* Obtain the constraint type. */ - - cnstyp = eqryi[base + 6]; - -/* Check the column and table on the LHS of the constraint. */ - - i__2 = base + 1; - zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &i__2, error, - errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)64, - errmsg_len); - if (*error) { - return 0; - } - if (cnstyp == 1) { - -/* Check the column and table on the RHS of the constraint. */ - - i__2 = base + 14; - zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &i__2, error, - errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen) - 64, errmsg_len); - if (*error) { - return 0; - } - } - } - -/* Do the same checks and assignments for the SELECT columns. */ - - i__1 = nsel; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the base address of the SELECT column descriptor. */ - - base = ntab * 12 + 19 + ncnj + ncns * 26 + nord * 13 + (i__ - 1) * 12; - zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &base, error, - errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)64, - errmsg_len); - if (*error) { - return 0; - } - } - -/* Do the same checks and assignments for the order-by columns. */ - - i__1 = nord; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the base address of the order-by column descriptor. */ - - base = ntab * 12 + 19 + ncnj + ncns * 26 + (i__ - 1) * 13; - zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &base, error, - errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)64, - errmsg_len); - if (*error) { - return 0; - } - } - -/* Indicate completion of name resolution. */ - - zzekweqi_("NAMES_RESOLVED", &c__1, eqryi, (ftnlen)14); - return 0; -} /* zzeknres_ */ - diff --git a/ext/spice/src/cspice/zzeknrml.c b/ext/spice/src/cspice/zzeknrml.c deleted file mode 100644 index c50ec69992..0000000000 --- a/ext/spice/src/cspice/zzeknrml.c +++ /dev/null @@ -1,3444 +0,0 @@ -/* zzeknrml.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__500 = 500; -static integer c__1 = 1; -static integer c__29 = 29; -static integer c__5000 = 5000; -static integer c__3 = 3; -static integer c__7 = 7; -static integer c__8 = 8; -static integer c__0 = 0; - -/* $Procedure ZZEKNRML ( EK, normalize WHERE clause ) */ -/* Subroutine */ int zzeknrml_(char *query, integer *ntoken, integer *lxbegs, - integer *lxends, integer *tokens, integer *values, doublereal *numvls, - char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char - *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen - query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len) -{ - /* Initialized data */ - - static integer logops[3] = { 2,25,23 }; - static integer logcde[3] = { -10,-11,-12 }; - static integer cmpops[7] = { 10,12,14,17,19,22,18 }; - static integer cmpcde[8] = { 1,2,3,4,5,6,7,8 }; - static integer cmpneg[8] = { 6,5,4,3,2,1,8,7 }; - static integer endkw[3] = { 11,26,27 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer node, tail, rels[15000] /* was [3][5000] */, skip; - static logical qual; - static integer head1, head2, next, prev, type__; - extern /* Subroutine */ int zzekinqc_(char *, integer *, integer *, - integer *, integer *, char *, integer *, ftnlen, ftnlen), - zzektloc_(integer *, integer *, integer *, integer *, integer *, - integer *, logical *), zzekinqn_(doublereal *, integer *, integer - *, integer *, integer *, doublereal *, integer *), zzekweqi_(char - *, integer *, integer *, ftnlen); - static integer b, e, i__, j, k; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer nmeta, level; - extern integer lnkhl_(integer *, integer *); - static integer nconj, newcj; - extern integer lnktl_(integer *, integer *); - static integer first, newdj, nrels, sizes[1000], start, state, third; - static logical donow; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), lnkan_(integer *, integer *), repmc_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - static integer cj[4], dj[2], op; - extern integer isrchi_(integer *, integer *, integer *), lnknfn_(integer * - ), lnknxt_(integer *, integer *), lnkprv_(integer *, integer *); - extern logical return_(void); - static integer rlpool[10012] /* was [2][5006] */, cjpool[10012] - /* was [2][5006] */, cjptrs[5000], djpool[10012] /* was [2][ - 5006] */, djptrs[5000], mtpool[1012] /* was [2][506] */, - mtcode[500], mtexpr[500], mstart[500], popcnd[500], cjnode, - colptr, djnode, djtail, dspool[10012] /* was [2][5006] */, - dscbuf[35000] /* was [7][5000] */, endloc, exprhd, fourth, - lxb, lxe, metahd, newrel, rel[4], relptr, relset[5006], retcnd, - rhsptr, second, tabptr, whrbeg, whrend, whrsiz; - static logical fnd; - extern /* Subroutine */ int chkout_(char *, ftnlen), lnkini_(integer *, - integer *), lnkila_(integer *, integer *, integer *), lnkfsl_( - integer *, integer *, integer *), cleari_(integer *, integer *), - lnkilb_(integer *, integer *, integer *), ssizei_(integer *, - integer *), insrti_(integer *, integer *), appndi_(integer *, - integer *); - -/* $ Abstract */ - -/* Convert the WHERE clause of an EK query to a normalized form. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Keyword Code Parameters */ - -/* ekkeyw.inc Version 4 24-JAN-1995 (NJB) */ - - - -/* The EK query language keywords and codes are: */ - -/* ALL */ -/* AND */ -/* ASC */ -/* AVG */ -/* BETWEEN */ -/* BY */ -/* COUNT */ -/* DESC */ -/* DISTINCT */ -/* EQ */ -/* FROM */ -/* GE */ -/* GROUP */ -/* GT */ -/* HAVING */ -/* IS */ -/* LE */ -/* LT */ -/* LIKE */ -/* MAX */ -/* MIN */ -/* NE */ -/* NOT */ -/* NULL */ -/* OR */ -/* ORDER */ -/* SELECT */ -/* SUM */ -/* WHERE */ - - -/* End Include Section: EK Keyword Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Token Code Parameters */ - -/* ektokn.inc Version 2 25-JAN-1995 (NJB) */ - -/* Updated to distinguish between special characters. */ - - -/* ektokn.inc Version 1 05-DEC-1994 (NJB) */ - - -/* The EK query language tokens and codes are: */ - -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ - - - -/* End Include Section: EK Token Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I Input EK query. */ -/* NTOKEN I Number of tokens in query. */ -/* LXBEGS I Start positions of lexemes comprising WHERE clause. */ -/* LXENDS I End positions of lexemes comprising WHERE clause. */ -/* TOKENS I Tokens comprising query. */ -/* VALUES I Values associated with tokens. */ -/* NUMVLS I Buffer containing numeric token values. */ -/* CHRBUF I Buffer containing string token values. */ -/* CHBEGS, */ -/* CHENDS I String token begin and end character positions. */ -/* EQRYI, */ -/* EQRYC, */ -/* EQRYD O Parsed query and string and number value buffers. */ -/* ERROR O Parse error flag. */ -/* PRSERR O Parse error message. */ - -/* $ Detailed_Input */ - -/* QUERY is an EK query to be parsed. The tokens of the */ -/* query have been found already. See the header */ -/* of the subroutine EKFIND for a detailed */ -/* description of the EK query language. */ - -/* NTOKEN is the number of tokens in the input query. */ - -/* LXBEGS, */ -/* LXENDS are lexeme begin and end pointers; the Ith */ -/* lexeme in the query is */ - -/* QUERY ( LXBEGS(I) : LXENDS(I) ) */ - -/* (Lexemes are strings that correspond to tokens */ -/* in the language.) */ - -/* TOKENS is an array of token codes. The Ith element of */ -/* TOKENS represents the Ith token in the scanned */ -/* query. */ - -/* VALUES is an array of values associated with tokens; the */ -/* Ith element of VALUES corresponds to the Ith */ -/* token. Keywords, for example, are distinguished */ -/* by codes in the VALUES array. Literal numeric */ -/* and string tokens use the VALUES array to point */ -/* to elements of NUMVLS or CHBEGS and CHENDS, */ -/* respectively. Some tokens don't need to use */ -/* VALUES, but to simplify indexing, each token gets */ -/* an element of this array. */ - -/* NUMVLS is an array of double precision numbers used to */ -/* store the values corresponding to literal numeric */ -/* tokens. */ - -/* CHRBUF is a string used to store the values of literal */ -/* string tokens. */ - -/* CHBEGS, */ -/* CHENDS are pairs of begin and end pointers into CHRBUF. */ -/* These pointers delimit character values */ -/* associated with literal string tokens. */ - -/* $ Detailed_Output */ - -/* EQRYI, */ -/* EQRYC, */ -/* EQRYD are the integer, character, and numeric portions */ -/* of an encoded form of the input query. The WHERE */ -/* clause of the input query is represented in this */ -/* encoding. The WHERE clause constraints have been */ -/* normalized. */ - -/* Normalized queries have their constraints grouped */ -/* into a disjunction of conjunctions of relational */ -/* expressions, as symbolized below: */ - -/* ( and and ... ) */ -/* or ( and and ... ) */ -/* . */ -/* . */ -/* . */ -/* or ( and and ... ) */ - -/* ERROR, */ -/* PRSERR are, respectively, a flag indicating whether the */ -/* input query parsed correctly, and a message */ -/* describing the parse error, if one occurred. If */ -/* no error occurred, ERROR is .FALSE. and PRSERR */ -/* is blank. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* No matter how ridiculous the query passed to ZZEKNRML, the */ -/* routine diagnoses errors via the output arguments ERROR and */ -/* PRSERR. No errors are signalled. The possible error messages */ -/* returned by this routine are: */ - - -/* Conjunction table is full. */ - -/* Disjunction table is full. */ - -/* Empty WHERE clause. */ - -/* Missing WHERE keyword. */ - -/* More tokens expected. */ - -/* NULL values are not allowed in BETWEEN or NOT BETWEEN clauses. */ - -/* NULL values can only be used with the operators */ -/* "IS NULL", "NOT NULL" or equivalents. */ - -/* Relation table is full. */ - -/* Stack is full. */ - -/* Syntax error: badly formed WHERE clause. */ - -/* Token following BETWEEN operator is invalid. */ - -/* Token following NOT operator was invalid. */ - -/* Token must be followed by a comparison operator. */ - -/* Token must be followed by the AND operator. */ - -/* Token sequence must be followed by a value. */ - -/* Tokens were missing from comparison relation. */ - -/* Tokens were missing from logical expression. */ - -/* Too few tokens in WHERE clause. */ - -/* Too many tokens in query; max allowed is #. */ - -/* Unexpected keyword # found at location #. */ - -/* Unexpected right parenthesis found. */ - -/* Unexpected token # found at location #. */ - -/* Unexpected token found following valid expression. */ - -/* Unexpected token found. */ - -/* WHERE clause ran out of tokens unexpectedly. */ -/* This may be due to an extra left parenthesis. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Here is the grammar for the EK WHERE clause: */ - -/* => WHERE */ - - -/* => */ - -/* */ - -/* | NOT */ - -/* | ( ) */ - -/* | */ -/* AND */ - -/* | */ -/* OR */ - - -/* => */ - -/* | BETWEEN AND */ - -/* | NOT BETWEEN AND */ - - -/* => NULL */ - - -/* => */ - - -/* => */ -/* | */ - - -/* => . */ -/* | */ - - -/* => EQ */ -/* | GE */ -/* | GT */ -/* | LE */ -/* | LT */ -/* | NE */ -/* | LIKE */ -/* | NOT LIKE */ -/* | = */ -/* | >= */ -/* | > */ -/* | <= */ -/* | < */ -/* | != */ -/* | <> */ - - -/* => IS */ -/* | IS NOT */ -/* | EQ */ -/* | NE */ -/* | = */ -/* | != */ -/* | <> */ - - -/* => */ -/* | */ -/* | */ - -/* $ Examples */ - -/* 1) This routine breaks down the constraints of the WHERE clause */ - -/* WHERE ( ( COL1 EQ VAL1 ) OR ( COL2 NE VAL2 ) ) */ -/* AND ( ( COL3 LE VAL3 ) OR ( COL4 GT VAL4 ) ) */ - -/* as */ - -/* ( ( COL1 EQ VAL1 ) AND ( COL3 LE VAL3 ) ) */ -/* OR ( ( COL1 EQ VAL1 ) AND ( COL4 GT VAL4 ) ) */ -/* OR ( ( COL2 NE VAL2 ) AND ( COL3 LE VAL3 ) ) */ -/* OR ( ( COL2 NE VAL2 ) AND ( COL4 GT VAL4 ) ) */ - - - -/* 2) This routine breaks down the constraints of the WHERE clause */ - -/* WHERE NOT ( ( COL1 EQ VAL1 ) OR ( COL2 NE VAL2 ) ) */ - -/* as */ -/* ( COL1 NE VAL1 ) AND ( COL3 EQ VAL3 ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 3.0.0, 17-NOV-1995 (NJB) */ - -/* Significantly re-written for architecture 3. */ - -/* -& */ - - -/* SPICELIB functions */ - - - -/* Local parameters */ - - -/* Data structure bounds: */ - - -/* MAXREL is the maximum number of relations that can be handled */ -/* by this routine. */ - - -/* MAXMET is the maximum number of meta-tokens making up any */ -/* expression. */ - - -/* LBPOOL is the lower bound of the second index of a linked list */ -/* pool array. */ - - - -/* Stack parameters: */ - - - -/* Operator parameters: */ - - -/* NLOGOP is the number of recognized logical operators. These */ -/* are AND, OR, and NOT. */ - - -/* NRELOP is the number of arithmetic and character comparision */ -/* operators. */ - - - -/* Meta-token codes, excluding codes for relational operators: */ - - -/* Number of keywords that can terminate a WHERE clause. */ - - - -/* State parameters: */ - - - -/* 'Pop condition' codes: */ - - -/* Token descriptor size: */ - - -/* Local variables */ - - -/* Each comparison relation is expressed by three tokens, so the */ -/* comparison relations are represented by a 3 x MAXREL array. The */ -/* first and third elements of each row of RELS are array indices */ -/* that point into the input array TOKENS; the middle element */ -/* of each row is an operator code. The set of triples representing */ -/* comparison relations is indexed by a doubly linked list pool. */ -/* Each conjunction of comparison relations is represented by a */ -/* linked list of pointers to entries in the RELS array. These */ -/* pointers are contained in the CJPTRS array. The pointers are */ -/* linked via entries in the double linked list pool CJPOOL. */ - - -/* Each normalized expression is a disjunction of conjunctions. Each */ -/* such disjunction is represented by a linked list of nodes */ -/* associated with pointers to entries in the CJPOOL array. DJPTRS */ -/* is the parallel array used to associate each node of a disjunction */ -/* with the head node of a conjunction list in CJPOOL. */ - - -/* Meta-tokens are groups of tokens that comprise syntactic units */ -/* in a query. Each symbol that appears on the left hand side of */ -/* a production rule in the grammar corresponds to a type of */ -/* meta-token. */ - -/* Throughout the parsing process, the meta-tokens representing the */ -/* query are organized as a linked list. Each meta-token is also */ -/* associated with a more detailed classification MTCODE. */ - -/* For each meta-token that represents an identifier, a value, */ -/* a name, or an expression, there is a corresponding element of */ -/* MTEXPR. This element contains a pointer to a token or to a */ -/* normalized expression. In the latter case, the pointer is the */ -/* head node of a list in the disjunction table. */ - - -/* Stack variables */ - -/* These variables have the following meanings: */ - -/* MSTART is the node number of the first meta-token of */ -/* the current expression being parsed. */ - -/* NMETA is the number of meta-tokens in the query. */ - -/* POPCND is the `pop condition'. This is a code indicating */ -/* what event must occur to trigger popping the current state. */ -/* The two events that can cause the state to be popped are */ -/* the execution of a reduction and encountering a right grouper. */ - - - -/* Other local variables */ - - -/* Saved variables */ - - - -/* Initial values */ - - -/* Note: there is no "UNLIKE" keyword, but there is an UNLIKE */ -/* operator, which is the complement of the LIKE operator. */ - - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKNRML", (ftnlen)8); - } - -/* No error at this point. */ - - *error = FALSE_; - s_copy(prserr, " ", prserr_len, (ftnlen)1); - if (*ntoken > 500) { - *error = TRUE_; - s_copy(prserr, "Too many tokens in query; max allowed is #.", - prserr_len, (ftnlen)43); - repmi_(prserr, "#", &c__500, prserr, prserr_len, (ftnlen)1, - prserr_len); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* Find out the start and end indices of the tokens comprising the */ -/* WHERE clause. If there are no tokens in the WHERE clause, we may */ -/* as well go home. */ - - zzektloc_(&c__1, &c__29, ntoken, tokens, values, &whrbeg, &fnd); - ++whrbeg; - if (! fnd) { - *error = TRUE_; - s_copy(prserr, "Missing WHERE keyword.", prserr_len, (ftnlen)22); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* The WHERE clause is terminated by the end of the query or by */ -/* the first keyword of the set {SELECT, FROM, ORDER} that follows */ -/* the WHERE keyword. */ - - whrend = *ntoken; - for (i__ = 1; i__ <= 3; ++i__) { - zzektloc_(&c__1, &endkw[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("endkw", i__1, "zzeknrml_", (ftnlen)728)], ntoken, - tokens, values, &endloc, &fnd); - if (fnd) { - if (endloc < whrend && endloc > whrbeg) { - whrend = endloc - 1; - } - } - } - whrsiz = whrend - whrbeg + 1; - if (whrsiz == 0) { - *error = TRUE_; - s_copy(prserr, "Empty WHERE clause.", prserr_len, (ftnlen)19); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* Initialize the pools. */ - - lnkini_(&c__5000, rlpool); - lnkini_(&c__5000, cjpool); - lnkini_(&c__5000, djpool); - lnkini_(&c__500, mtpool); - lnkini_(&c__5000, dspool); - -/* Loop through our token list and classify the tokens. Initialize */ -/* the meta-token list. */ - - nmeta = 0; - tail = 0; - i__ = whrbeg; - while(i__ <= whrend) { - -/* Allocate a node and link it in at the tail of the meta-token */ -/* list. */ - - lnkan_(mtpool, &node); - lnkila_(&tail, &node, mtpool); - tail = node; - -/* Each meta-token's expression pointer points to its original */ -/* token index, by default. */ - - mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtexpr", - i__1, "zzeknrml_", (ftnlen)784)] = i__; - if (tokens[i__ - 1] == 6) { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)789)] = -2; - } else if (tokens[i__ - 1] == 7) { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)794)] = -1; - } else if (tokens[i__ - 1] == 3 || tokens[i__ - 1] == 4) { - -/* Numeric values must be added to the encoded query. We */ -/* allocate a descriptor from the descriptor pool for */ -/* each identifier. The expression pointer for the */ -/* identifier points to the descriptor. Note: the */ -/* allocation should be safe, since we've checked the total */ -/* number of tokens in the query. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)807)] = -8; - lnkan_(dspool, &mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)809)]); - if (tokens[i__ - 1] == 3) { - type__ = 3; - } else { - type__ = 2; - } - zzekinqn_(&numvls[values[i__ - 1] - 1], &type__, &lxbegs[i__ - 1], - &lxends[i__ - 1], eqryi, eqryd, &dscbuf[(i__2 = mtexpr[( - i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mte" - "xpr", i__1, "zzeknrml_", (ftnlen)817)] * 7 - 7) < 35000 && - 0 <= i__2 ? i__2 : s_rnge("dscbuf", i__2, "zzeknrml_", ( - ftnlen)817)]); - -/* Set the descriptor to indicate that it represents a value. */ - - dscbuf[(i__2 = mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 - : s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)828)] * 7 - - 1) < 35000 && 0 <= i__2 ? i__2 : s_rnge("dscbuf", i__2, - "zzeknrml_", (ftnlen)828)] = -8; - } else if (tokens[i__ - 1] == 5) { - -/* The treatment of strings is analogous to that of numbers. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)835)] = -8; - lnkan_(dspool, &mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)837)]); - b = chbegs[values[i__ - 1] - 1]; - e = chends[values[i__ - 1] - 1]; - i__3 = e - b + 1; - zzekinqc_(chrbuf + (b - 1), &i__3, &lxbegs[i__ - 1], &lxends[i__ - - 1], eqryi, eqryc, &dscbuf[(i__2 = mtexpr[(i__1 = node - - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtexpr", i__1, - "zzeknrml_", (ftnlen)842)] * 7 - 7) < 35000 && 0 <= i__2 ? - i__2 : s_rnge("dscbuf", i__2, "zzeknrml_", (ftnlen)842)], - e - (b - 1), eqryc_len); - -/* Set the descriptor to indicate that it represents a value. */ - - dscbuf[(i__2 = mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 - : s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)853)] * 7 - - 1) < 35000 && 0 <= i__2 ? i__2 : s_rnge("dscbuf", i__2, - "zzeknrml_", (ftnlen)853)] = -8; - } else if (tokens[i__ - 1] == 2) { - -/* Identifiers must be added to the encoded query. We */ -/* allocate a descriptor from the descriptor pool for */ -/* each identifier. The expression pointer for the */ -/* identifier points to the descriptor. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)863)] = -7; - lnkan_(dspool, &mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)865)]); - b = chbegs[values[i__ - 1] - 1]; - e = chends[values[i__ - 1] - 1]; - i__3 = e - b + 1; - zzekinqc_(chrbuf + (b - 1), &i__3, &lxbegs[i__ - 1], &lxends[i__ - - 1], eqryi, eqryc, &dscbuf[(i__2 = mtexpr[(i__1 = node - - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtexpr", i__1, - "zzeknrml_", (ftnlen)870)] * 7 - 7) < 35000 && 0 <= i__2 ? - i__2 : s_rnge("dscbuf", i__2, "zzeknrml_", (ftnlen)870)], - e - (b - 1), eqryc_len); - -/* Set the descriptor to indicate that it represents an */ -/* identifier. */ - - dscbuf[(i__2 = mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 - : s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)882)] * 7 - - 1) < 35000 && 0 <= i__2 ? i__2 : s_rnge("dscbuf", i__2, - "zzeknrml_", (ftnlen)882)] = -7; - } else if (tokens[i__ - 1] == 9) { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)887)] = -9; - } else if (tokens[i__ - 1] == 1) { - -/* We have a keyword. Identify it and locate the corresponding */ -/* code. */ - - j = isrchi_(&values[i__ - 1], &c__3, logops); - k = isrchi_(&values[i__ - 1], &c__7, cmpops); - if (j > 0) { - -/* We have a logical operator, unless we have the NOT LIKE */ -/* or NOT BETWEEN sequence. */ - - if (logcde[(i__1 = j - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "logcde", i__1, "zzeknrml_", (ftnlen)904)] != -12) { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)906)] - = logcde[(i__2 = j - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("logcde", i__2, "zzeknrml_", (ftnlen)906)]; - } else { - if (i__ <= whrend) { - if (tokens[i__] == 1 && values[i__] == 18) { - -/* Replace the NOT LIKE sequence with the */ -/* UNLIKE operator. Skip over the LIKE token. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", - (ftnlen)918)] = 8; - ++i__; - } else if (tokens[i__] == 1 && values[i__] == 5) { - -/* Replace the NOT BETWEEN sequence with the */ -/* NOTBTW operator. Skip over the BETWEEN token. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", - (ftnlen)927)] = -4; - ++i__; - } else { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", - (ftnlen)931)] = -12; - } - } else { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 935)] = -12; - } - } - } else if (k > 0) { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mtcode", i__1, "zzeknrml_", (ftnlen)942)] = cmpcde[( - i__2 = k - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("cmpc" - "de", i__2, "zzeknrml_", (ftnlen)942)]; - } else if (values[i__ - 1] == 5) { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mtcode", i__1, "zzeknrml_", (ftnlen)946)] = -3; - } else if (values[i__ - 1] == 16) { - -/* The token IS translates to EQ; the token sequence */ -/* IS NOT translates to NE. */ - - if (i__ < whrend) { - if (tokens[i__] == 1 && values[i__] == 23) { - -/* We have an IS NOT sequence. Skip over the NOT */ -/* token; indicate the sequence with a single NE */ -/* meta-token. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 963)] = 6; - ++i__; - } else { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 966)] = 1; - } - } else { - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)970)] - = 1; - } - } else if (values[i__ - 1] == 24) { - -/* The expression pointer for null values is NIL. */ - - mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mtcode", i__1, "zzeknrml_", (ftnlen)978)] = -8; - mtexpr[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mtexpr", i__1, "zzeknrml_", (ftnlen)979)] = 0; - } else { - -/* Sorry, that was the last chance for valid keywords. */ - - lxb = lxbegs[i__ - 1]; - lxe = lxends[i__ - 1]; - *error = TRUE_; - s_copy(prserr, "Unexpected keyword # found at location #.", - prserr_len, (ftnlen)41); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - } else { - -/* Sorry, that was the last chance, period. */ - - lxb = lxbegs[i__ - 1]; - lxe = lxends[i__ - 1]; - *error = TRUE_; - s_copy(prserr, "Unexpected token # found at location #.", - prserr_len, (ftnlen)39); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* At this point, we've classified the Ith token. MTCODE(NODE) */ -/* is the meta-token code for this token. */ - - ++i__; - ++nmeta; - } - -/* Initialize the head of the meta-token list. */ - - metahd = lnkhl_(&tail, mtpool); - -/* Filter out extraneous parentheses around column names or */ -/* values. */ - - node = metahd; - while(node > 0) { - if (mtcode[(i__1 = node - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mtc" - "ode", i__1, "zzeknrml_", (ftnlen)1032)] == -6 || mtcode[(i__2 - = node - 1) < 500 && 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, - "zzeknrml_", (ftnlen)1032)] == -8) { - -/* If the current metatoken is bracketed by parentheses, */ -/* remove them and update the metatoken count accordingly. */ - - prev = lnkprv_(&node, mtpool); - next = lnknxt_(&node, mtpool); - if (prev > 0 && next > 0) { - if (mtcode[(i__1 = prev - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1043)] == - -2 && mtcode[(i__2 = next - 1) < 500 && 0 <= i__2 ? - i__2 : s_rnge("mtcode", i__2, "zzeknrml_", (ftnlen) - 1043)] == -1) { - lnkfsl_(&prev, &prev, mtpool); - lnkfsl_(&next, &next, mtpool); - metahd = lnkhl_(&node, mtpool); - nmeta += -2; - -/* We don't advance the current token in this case */ -/* because there may be more parentheses to remove. */ - - } else { - -/* This token is not bracketed by parentheses; look at */ -/* the next metatoken. */ - - node = next; - } - } else { - -/* This token is not bracketed by tokens on both sides; look */ -/* at the next metatoken. It's ok for the next token to be */ -/* NIL. */ - - node = next; - } - } else { - -/* The current token is not a name or value; look at the next */ -/* token. */ - - node = lnknxt_(&node, mtpool); - } - } - - -/* Now it's time to parse our expression. We will validate the */ -/* expression by using our grammar rules to condense groups of */ -/* meta-tokens that correspond to the right-hand sides of grammatical */ -/* rules into meta-tokens that correspond to the left-hand sides */ -/* of those same rules. Each such application of a grammar rule */ -/* is called a `reduction.' When we're left with a single */ -/* meta-token of type , we're done. */ - -/* If, before reaching the desired final state, we get to a point */ -/* where no reductions can be performed, we have a syntax error. */ - -/* As parsing advances, we'll start to get meta-tokens that are */ -/* logical expressions. Each logical expression will be represented */ -/* by a data structure that organizes the expression in a way that */ -/* we'll refer to as `normalized': the expression will be */ -/* represented as a disjuction of conjunctions, for example */ - -/* ( A AND B AND C ) OR ( D AND E ) OR ( F ) OR ( G AND H AND I ) */ - -/* Each metatoken that represents a logical expression will */ -/* refer to it through a pointer which is a member of the MTEXPR */ -/* array. */ - - if (whrsiz < 3) { - *error = TRUE_; - s_copy(prserr, "Too few tokens in WHERE clause.", prserr_len, (ftnlen) - 31); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } else { - level = 1; - mstart[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("mstart", - i__1, "zzeknrml_", (ftnlen)1121)] = metahd; - popcnd[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge("popcnd", - i__1, "zzeknrml_", (ftnlen)1122)] = 0; - state = 2; - } - while(state != 4) { - if (state == 2) { - -/* If the input query is valid, we're looking at the leftmost */ -/* meta-token of an expression that matches the right-hand */ -/* side of one of the grammar rules. Referring back to the */ -/* rules, we see that there are only a few meta-tokens that are */ -/* valid as the first token of such an expression: */ - -/* - A left grouper */ -/* - An identifier */ -/* - A name */ -/* - An expression */ -/* - A unary operator (`NOT' ) */ - -/* We'll see if we can perform a reduction. The reductions */ -/* that are possible depend on how many meta-tokens are */ -/* present in the expression we're looking at. */ - -/* FIRST is the node number of the first meta-token to look */ -/* at, in an attempt to perform a reduction. SECOND, THIRD, */ -/* and FOURTH have the obvious meanings; some of these may */ -/* be 0. */ - - first = mstart[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mstart", i__1, "zzeknrml_", (ftnlen)1155)]; - if (first > 0) { - second = lnknxt_(&first, mtpool); - } else { - second = 0; - } - if (second > 0) { - third = lnknxt_(&second, mtpool); - } else { - third = 0; - } - if (third > 0) { - fourth = lnknxt_(&third, mtpool); - } else { - fourth = 0; - } - if (first <= 0) { - -/* This never happens to good commands. */ - - *error = TRUE_; - s_copy(prserr, "WHERE clause ran out of tokens unexpectedly." - " This may be due to an extra left parenthesis.", - prserr_len, (ftnlen)91); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* We have at least one meta-token to work with. We'll */ -/* take different actions depending on its type. */ - - if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mtcode", i__1, "zzeknrml_", (ftnlen)1195)] == -7) { - -/* This is a simple case to deal with: in valid queries, */ -/* we have either the sequence */ - -/* . */ - -/* or */ - -/* */ - -/* Both of these token sequences represent a column name; */ -/* in the former case, the name is qualified by a table */ -/* name, in the latter, the column name is unqualified. */ -/* If the table name is absent, we'll simply save a null */ -/* descriptor for it. The descriptors will be linked, with */ -/* the table descriptor coming first, and the NAME token */ -/* resulting from reducing this token sequence will point to */ -/* the list of descriptors via the MTEXPR pointer. */ - - - if (third > 0) { - -/* We can look at the following two tokens. */ - - if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1220) - ] == -9 && mtcode[(i__2 = third - 1) < 500 && 0 <= - i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)1220)] == -7) { - qual = TRUE_; - } else { - qual = FALSE_; - } - } else { - -/* There aren't enough tokens for this name to be */ -/* qualified. */ - - qual = FALSE_; - } - if (qual) { - -/* We have a fully qualified column name. Hook up the */ -/* table and column name descriptors. */ - - tabptr = mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)1243)]; - colptr = mtexpr[(i__1 = third - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)1244)]; - lnkila_(&tabptr, &colptr, dspool); - -/* Reduce the expression to a metatoken. */ - - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1251)] - = -6; - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - } else { - -/* We have an unqualified column name. Allocate a table */ -/* descriptor. Set the table descriptor to indicate a */ -/* null character descriptor. Link this descriptor in */ -/* before the column descriptor. */ - - lnkan_(dspool, &tabptr); - cleari_(&c__7, &dscbuf[(i__1 = tabptr * 7 - 7) < 35000 && - 0 <= i__1 ? i__1 : s_rnge("dscbuf", i__1, "zzekn" - "rml_", (ftnlen)1266)]); - dscbuf[(i__1 = tabptr * 7 - 7) < 35000 && 0 <= i__1 ? - i__1 : s_rnge("dscbuf", i__1, "zzeknrml_", ( - ftnlen)1267)] = 1; - dscbuf[(i__1 = tabptr * 7 - 1) < 35000 && 0 <= i__1 ? - i__1 : s_rnge("dscbuf", i__1, "zzeknrml_", ( - ftnlen)1268)] = -7; - colptr = mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)1270)]; - lnkila_(&tabptr, &colptr, dspool); - -/* Reduce the expression to a metatoken. */ -/* The reduction doesn't change the number of metatokens. */ - - mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)1278)] - = tabptr; - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1279)] - = -6; - } - -/* Decide the next state. */ - - state = 3; - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1290)] == -8) - { - -/* If the query is valid, the sequence of meta-tokens */ -/* should be one of */ - -/* AND */ -/* AND */ - -/* Both of these reduce to the symbol . */ - - - if (third <= 0) { - *error = TRUE_; - s_copy(prserr, "Tokens were missing from comparison rela" - "tion.", prserr_len, (ftnlen)45); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* Null values are not allowed in BETWEEN expressions. */ - - if (mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)1314)] == - 0 || mtexpr[(i__2 = third - 1) < 500 && 0 <= i__2 ? - i__2 : s_rnge("mtexpr", i__2, "zzeknrml_", (ftnlen) - 1314)] == 0) { - *error = TRUE_; - s_copy(prserr, "NULL values are not allowed in BETWEEN o" - "r NOT BETWEEN clauses.", prserr_len, (ftnlen)62); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - if (mtcode[(i__1 = third - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1326)] == - -7) { - -/* We'll need to reduce the IDENT before proceeding. */ - - start = third; - retcnd = 1; - state = 0; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1335)] == -10 && (mtcode[(i__2 = third - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)1335)] == -6 || mtcode[(i__3 = third - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)1335)] == -8)) { - -/* This sequence of tokens, when seen in the PARSE */ -/* state, is a set of value bounds for a BETWEEN or */ -/* NOT BETWEEN expression. Note that this token sequence */ -/* can occur elsewhere, but not in the PARSE state. */ -/* This is because the meta-token sequences */ - -/* AND */ -/* AND */ - -/* occur at the start of the RHS of only two */ -/* productions, namely */ - -/* => AND */ -/* => AND */ - - -/* Hook up the name or value descriptors. */ - - lnkilb_(&mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)1358)], &mtexpr[(i__2 = third - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtexpr", i__2, "zzek" - "nrml_", (ftnlen)1358)], dspool); - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1360)] - = -5; - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* Decide the next state. */ - - state = 3; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1372)] > 0) { - -/* The third meta-token is in the wrong place at the */ -/* wrong time. */ - - *error = TRUE_; - s_copy(prserr, "Token sequence must be followed by a val" - "ue.", prserr_len, (ftnlen)43); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } else { - -/* The second meta-token is supposed to be the AND token, */ -/* but it's actually something else. */ - - *error = TRUE_; - s_copy(prserr, "Token must be followed by the AND operat" - "or.", prserr_len, (ftnlen)43); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1402)] == -6) - { - -/* If the query is valid, the sequence of meta-tokens */ -/* should be any of */ - -/* */ -/* */ -/* */ - -/* or */ - -/* AND */ -/* AND */ -/* AND */ - -/* or */ - -/* BETWEEN */ -/* BETWEEN */ -/* BETWEEN */ -/* BETWEEN */ - -/* or */ - -/* */ -/* */ -/* */ -/* */ - -/* There must be at least three meta-tokens here. */ - - - if (third <= 0) { - *error = TRUE_; - s_copy(prserr, "Tokens were missing from comparison rela" - "tion.", prserr_len, (ftnlen)45); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - if (mtcode[(i__1 = third - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1445)] == - -7) { - -/* We'll need to reduce the IDENT before proceeding. */ - - start = third; - retcnd = 1; - state = 0; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1454)] == -10 && (mtcode[(i__2 = third - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)1454)] == -6 || mtcode[(i__3 = third - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)1454)] == -8)) { - -/* This sequence of tokens, when seen in the PARSE */ -/* state, is a set of value bounds for a BETWEEN or */ -/* NOT BETWEEN expression. Note that this token sequence */ -/* can occur elsewhere, but not in the PARSE state. */ -/* This is because the meta-token sequences */ - -/* AND */ -/* AND */ - -/* occur at the start of the RHS of only two */ -/* productions, namely */ - -/* => AND */ -/* => AND */ - - -/* Null values are not allowed in BETWEEN expressions. */ - - if (mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)1477)] - == 0 || mtexpr[(i__2 = third - 1) < 500 && 0 <= - i__2 ? i__2 : s_rnge("mtexpr", i__2, "zzeknrml_", - (ftnlen)1477)] == 0) { - *error = TRUE_; - s_copy(prserr, "NULL values are not allowed in BETWE" - "EN or NOT BETWEEN clauses.", prserr_len, ( - ftnlen)62); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* Hook up the name or value descriptors. */ - - lnkilb_(&mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)1491)], &mtexpr[(i__2 = third - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtexpr", i__2, "zzek" - "nrml_", (ftnlen)1491)], dspool); - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1493)] - = -5; - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* Decide the next state. */ - - state = 3; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1506)] > 0 && (mtcode[(i__2 = third - 1) < 500 && 0 <= - i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", ( - ftnlen)1506)] == -6 || mtcode[(i__3 = third - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)1506)] == -8)) { - -/* Positive meta-token codes denote comparison */ -/* operators. */ - -/* We have an arithmetic, string, or column comparison */ -/* expression. This is a trivial normalized */ -/* relational expression. All we have to do */ -/* is store the expression in the relation table, */ -/* and free the second and third meta-tokens. */ - - if (lnknfn_(rlpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Relation table is full.", prserr_len, - (ftnlen)23); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(rlpool, &newrel); - rels[(i__1 = newrel * 3 - 3) < 15000 && 0 <= i__1 ? i__1 : - s_rnge("rels", i__1, "zzeknrml_", (ftnlen)1529)] - = mtexpr[(i__2 = first - 1) < 500 && 0 <= i__2 ? - i__2 : s_rnge("mtexpr", i__2, "zzeknrml_", ( - ftnlen)1529)]; - rels[(i__1 = newrel * 3 - 2) < 15000 && 0 <= i__1 ? i__1 : - s_rnge("rels", i__1, "zzeknrml_", (ftnlen)1530)] - = mtcode[(i__2 = second - 1) < 500 && 0 <= i__2 ? - i__2 : s_rnge("mtcode", i__2, "zzeknrml_", ( - ftnlen)1530)]; - rels[(i__1 = newrel * 3 - 1) < 15000 && 0 <= i__1 ? i__1 : - s_rnge("rels", i__1, "zzeknrml_", (ftnlen)1531)] - = mtexpr[(i__2 = third - 1) < 500 && 0 <= i__2 ? - i__2 : s_rnge("mtexpr", i__2, "zzeknrml_", ( - ftnlen)1531)]; - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* Now allocate an entry in the conjunction pool */ -/* and make this entry point to the relation table */ -/* entry. */ - - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &newcj); - cjptrs[(i__1 = newcj - 1) < 5000 && 0 <= i__1 ? i__1 : - s_rnge("cjptrs", i__1, "zzeknrml_", (ftnlen)1552)] - = newrel; - -/* Now allocate an entry in the disjunction pool */ -/* and make this entry point to the conjunction pool */ -/* entry. */ - - if (lnknfn_(djpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Disjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(djpool, &newdj); - djptrs[(i__1 = newdj - 1) < 5000 && 0 <= i__1 ? i__1 : - s_rnge("djptrs", i__1, "zzeknrml_", (ftnlen)1568)] - = newcj; - -/* Change the type of the first meta-token to EXPR and */ -/* have that meta-token point to this table entry. Bag */ -/* the other two meta-tokens. */ - - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1575)] - = -13; - mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)1576)] - = newdj; - -/* Decide the next state. */ - - state = 3; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1584)] == -3 || mtcode[(i__2 = second - 1) < 500 && 0 - <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", ( - ftnlen)1584)] == -4) { - -/* If the command is syntactically correct, the */ -/* meta-token sequence should be one of: */ - -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ - - - if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1598) - ] == -3 && mtcode[(i__2 = third - 1) < 500 && 0 <= - i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)1598)] == -5) { - -/* It's a BETWEEN comparison. We treat this as a */ -/* disjunction of conjunctions of comparison */ -/* relations: */ -/* >= */ -/* AND <= */ - -/* OR */ -/* <= */ -/* AND >= */ - -/* where item1 and item2 are specified by the */ -/* descriptors belonging to the third meta-token. */ - - for (i__ = 1; i__ <= 4; ++i__) { - if (i__ == 1 || i__ == 3) { - k = mtexpr[(i__1 = third - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("mtexpr", i__1, - "zzeknrml_", (ftnlen)1618)]; - } else { - -/* We need the descriptor pointer for the RHS */ -/* item. This descriptor is linked to the tail */ -/* of the descriptor for the LHS item. The */ -/* number of nodes to skip over depends on */ -/* whether the LHS item is a name or value. */ - - k = mtexpr[(i__1 = third - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("mtexpr", i__1, - "zzeknrml_", (ftnlen)1628)]; - if (dscbuf[(i__1 = k * 7 - 1) < 35000 && 0 <= - i__1 ? i__1 : s_rnge("dscbuf", i__1, - "zzeknrml_", (ftnlen)1630)] == -7) { - skip = 1; - } else { - skip = 0; - } - i__1 = skip + 1; - for (j = 1; j <= i__1; ++j) { - k = lnknxt_(&k, dspool); - } - } - if (lnknfn_(rlpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Relation table is full.", - prserr_len, (ftnlen)23); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(rlpool, &rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, "zzekn" - "rml_", (ftnlen)1650)]); - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, "zzekn" - "rml_", (ftnlen)1653)] * 3 - 3) < 15000 && - 0 <= i__2 ? i__2 : s_rnge("rels", i__2, - "zzeknrml_", (ftnlen)1653)] = mtexpr[( - i__3 = first - 1) < 500 && 0 <= i__3 ? - i__3 : s_rnge("mtexpr", i__3, "zzeknrml_", - (ftnlen)1653)]; - if (i__ == 1 || i__ == 4) { - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, - "zzeknrml_", (ftnlen)1656)] * 3 - 2) < - 15000 && 0 <= i__2 ? i__2 : s_rnge( - "rels", i__2, "zzeknrml_", (ftnlen) - 1656)] = 2; - } else { - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, - "zzeknrml_", (ftnlen)1658)] * 3 - 2) < - 15000 && 0 <= i__2 ? i__2 : s_rnge( - "rels", i__2, "zzeknrml_", (ftnlen) - 1658)] = 4; - } - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, "zzekn" - "rml_", (ftnlen)1661)] * 3 - 1) < 15000 && - 0 <= i__2 ? i__2 : s_rnge("rels", i__2, - "zzeknrml_", (ftnlen)1661)] = k; - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &cj[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("cj", i__1, "zzeknr" - "ml_", (ftnlen)1671)]); - cjptrs[(i__2 = cj[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("cj", i__1, "zzeknr" - "ml_", (ftnlen)1673)] - 1) < 5000 && 0 <= - i__2 ? i__2 : s_rnge("cjptrs", i__2, - "zzeknrml_", (ftnlen)1673)] = rel[(i__3 = - i__ - 1) < 4 && 0 <= i__3 ? i__3 : s_rnge( - "rel", i__3, "zzeknrml_", (ftnlen)1673)]; - } - -/* Link the conjunction nodes to form the two */ -/* conjunctions shown above. */ - - lnkila_(cj, &cj[1], cjpool); - lnkila_(&cj[2], &cj[3], cjpool); - -/* Allocate disjunction pool entries and make them */ -/* point to the two respective conjunctions. */ - - for (i__ = 1; i__ <= 2; ++i__) { - if (lnknfn_(djpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Disjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(djpool, &dj[(i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("dj", i__1, "zzeknr" - "ml_", (ftnlen)1697)]); - djptrs[(i__2 = dj[(i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("dj", i__1, "zzeknr" - "ml_", (ftnlen)1698)] - 1) < 5000 && 0 <= - i__2 ? i__2 : s_rnge("djptrs", i__2, - "zzeknrml_", (ftnlen)1698)] = cj[(i__3 = ( - i__ << 1) - 2) < 4 && 0 <= i__3 ? i__3 : - s_rnge("cj", i__3, "zzeknrml_", (ftnlen) - 1698)]; - } - -/* Finally, link the disjunction pool entries, and */ -/* create an meta-token. Free the unused */ -/* meta-tokens. */ - - lnkila_(dj, &dj[1], djpool); - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1709)] = -13; - mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen) - 1710)] = dj[0]; - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* Decide the next state. */ - - state = 3; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", ( - ftnlen)1721)] == -4 && mtcode[(i__2 = third - 1) < - 500 && 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, - "zzeknrml_", (ftnlen)1721)] == -5) { - -/* It's a NOT BETWEEN comparison. We treat */ -/* this as a disjunction of conjunctions of comparison */ -/* relations: */ - -/* < */ -/* AND < */ - -/* OR */ -/* > */ -/* AND > */ - -/* where item1 and item2 are specified by the */ -/* descriptors belonging to the third meta-token. */ - -/* The actions here are closely analogous to those */ -/* for the BETWEEN case. */ - - for (i__ = 1; i__ <= 4; ++i__) { - if (i__ == 1 || i__ == 3) { - k = mtexpr[(i__1 = third - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("mtexpr", i__1, - "zzeknrml_", (ftnlen)1745)]; - } else { - -/* We need the descriptor pointer for the RHS */ -/* item. This descriptor is linked to the tail */ -/* of the descriptor for the LHS item. The */ -/* number of nodes to skip over depends on */ -/* whether the LHS item is a name or value. */ - - k = mtexpr[(i__1 = third - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("mtexpr", i__1, - "zzeknrml_", (ftnlen)1755)]; - if (dscbuf[(i__1 = k * 7 - 1) < 35000 && 0 <= - i__1 ? i__1 : s_rnge("dscbuf", i__1, - "zzeknrml_", (ftnlen)1757)] == -7) { - skip = 1; - } else { - skip = 0; - } - i__1 = skip + 1; - for (j = 1; j <= i__1; ++j) { - k = lnknxt_(&k, dspool); - } - } - if (lnknfn_(rlpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Relation table is full.", - prserr_len, (ftnlen)23); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(rlpool, &rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, "zzekn" - "rml_", (ftnlen)1777)]); - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, "zzekn" - "rml_", (ftnlen)1780)] * 3 - 3) < 15000 && - 0 <= i__2 ? i__2 : s_rnge("rels", i__2, - "zzeknrml_", (ftnlen)1780)] = mtexpr[( - i__3 = first - 1) < 500 && 0 <= i__3 ? - i__3 : s_rnge("mtexpr", i__3, "zzeknrml_", - (ftnlen)1780)]; - if (i__ <= 2) { - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, - "zzeknrml_", (ftnlen)1783)] * 3 - 2) < - 15000 && 0 <= i__2 ? i__2 : s_rnge( - "rels", i__2, "zzeknrml_", (ftnlen) - 1783)] = 5; - } else { - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, - "zzeknrml_", (ftnlen)1785)] * 3 - 2) < - 15000 && 0 <= i__2 ? i__2 : s_rnge( - "rels", i__2, "zzeknrml_", (ftnlen) - 1785)] = 3; - } - rels[(i__2 = rel[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("rel", i__1, "zzekn" - "rml_", (ftnlen)1788)] * 3 - 1) < 15000 && - 0 <= i__2 ? i__2 : s_rnge("rels", i__2, - "zzeknrml_", (ftnlen)1788)] = k; - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &cj[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("cj", i__1, "zzeknr" - "ml_", (ftnlen)1798)]); - cjptrs[(i__2 = cj[(i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("cj", i__1, "zzeknr" - "ml_", (ftnlen)1800)] - 1) < 5000 && 0 <= - i__2 ? i__2 : s_rnge("cjptrs", i__2, - "zzeknrml_", (ftnlen)1800)] = rel[(i__3 = - i__ - 1) < 4 && 0 <= i__3 ? i__3 : s_rnge( - "rel", i__3, "zzeknrml_", (ftnlen)1800)]; - } - -/* Link the conjunction nodes to form the two */ -/* conjunctions shown above. */ - - lnkila_(cj, &cj[1], cjpool); - lnkila_(&cj[2], &cj[3], cjpool); - -/* Allocate disjunction pool entries and make them */ -/* point to the two respective conjunctions. */ - - for (i__ = 1; i__ <= 2; ++i__) { - if (lnknfn_(djpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Disjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(djpool, &dj[(i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("dj", i__1, "zzeknr" - "ml_", (ftnlen)1824)]); - djptrs[(i__2 = dj[(i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("dj", i__1, "zzeknr" - "ml_", (ftnlen)1825)] - 1) < 5000 && 0 <= - i__2 ? i__2 : s_rnge("djptrs", i__2, - "zzeknrml_", (ftnlen)1825)] = cj[(i__3 = ( - i__ << 1) - 2) < 4 && 0 <= i__3 ? i__3 : - s_rnge("cj", i__3, "zzeknrml_", (ftnlen) - 1825)]; - } - -/* Finally, link the disjunction pool entries, and */ -/* create an meta-token. Free the unused */ -/* meta-tokens. */ - - lnkila_(dj, &dj[1], djpool); - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1836)] = -13; - mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen) - 1837)] = dj[0]; - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* Decide the next state. */ - - state = 3; - } else if (mtcode[(i__1 = third - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", ( - ftnlen)1847)] == -6 || mtcode[(i__2 = third - 1) < - 500 && 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, - "zzeknrml_", (ftnlen)1847)] == -8) { - -/* If the third meta-token is anything other than */ -/* , we'll have to parse the portion of */ -/* the query following the BETWEEN keyword before */ -/* reducing the or expression. */ - - start = third; - retcnd = 1; - state = 0; - } else { - *error = TRUE_; - s_copy(prserr, "Token following BETWEEN operator is " - "invalid.", prserr_len, (ftnlen)44); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1870)] > 0) { - -/* The third meta-token is in the wrong place at the */ -/* wrong time. */ - - *error = TRUE_; - s_copy(prserr, "Token sequence must be followed by a val" - "ue.", prserr_len, (ftnlen)43); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } else { - -/* The second meta-token is supposed to be a comparison */ -/* operator, but it's actually something else. */ - - *error = TRUE_; - s_copy(prserr, "Token must be followed by a comparison o" - "perator.", prserr_len, (ftnlen)48); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)1899)] == -13) - { - -/* If the query is valid, the sequence of meta-tokens */ -/* should be one of */ - -/* */ -/* ) */ -/* OR */ -/* OR NAME */ -/* OR IDENT */ -/* OR NOT */ -/* OR ( */ -/* AND */ -/* AND NAME */ -/* AND IDENT */ -/* AND NOT */ -/* AND ( */ - - if (second <= 0) { - -/* This is the last state we pass through */ -/* before exiting the loop. However, some syntax errors */ -/* can get us here as well. */ - - if (level > 1 || nmeta > 1) { - *error = TRUE_; - s_copy(prserr, "More tokens expected.", prserr_len, ( - ftnlen)21); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - state = 4; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1935)] == -1) { - -/* We've reached the end of a `parenthesized' */ -/* expression. */ - - if (level > 1 && popcnd[(i__1 = level - 1) < 500 && 0 <= - i__1 ? i__1 : s_rnge("popcnd", i__1, "zzeknrml_", - (ftnlen)1940)] == 2) { - -/* Time to pop the state. */ - - state = 1; - } else { - -/* There should not be a right grouper here. */ - - *error = TRUE_; - s_copy(prserr, "Unexpected right parenthesis found.", - prserr_len, (ftnlen)35); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* In all other cases, there must be at least three */ -/* meta-tokens here. Make sure there are. */ - - } else if (third <= 0) { - *error = TRUE_; - s_copy(prserr, "More tokens expected.", prserr_len, ( - ftnlen)21); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - -/* Take care of the cases that will require reducing a sub- */ -/* expression before reducing the current expression. */ - - } else if (mtcode[(i__1 = third - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1975)] == -7 || mtcode[(i__2 = third - 1) < 500 && 0 - <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", ( - ftnlen)1975)] == -6 || mtcode[(i__3 = third - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)1975)] == -12) { - start = third; - retcnd = 1; - state = 0; - } else if (mtcode[(i__1 = third - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1984)] == -2) { - -/* We'll have to push our state before continuing. */ - - start = fourth; - retcnd = 2; - state = 0; - -/* Now continue with the interesting cases. */ - - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 1995)] == -13 && mtcode[(i__2 = second - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)1995)] == -11 && mtcode[(i__3 = third - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)1995)] == -13) { - -/* We have a disjunction of two normalized */ -/* expressions. We're not ready to perform a */ -/* reduction yet; we need to see whether there's */ -/* a higher priority operator, namely AND, on the */ -/* right of the second expression. */ - - donow = TRUE_; - if (fourth > 0) { - if (mtcode[(i__1 = fourth - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", ( - ftnlen)2009)] == -10) { - -/* The third token is already spoken for: */ -/* the expression involving the operator */ -/* to its right must be processed first. */ - - donow = FALSE_; - } - } - if (donow) { - -/* This is an easy case to handle: */ -/* we can form the resulting normalized */ -/* expression by just linking together the two */ -/* lists in the disjunction table. */ - - dj[0] = mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2028)]; - dj[1] = mtexpr[(i__1 = third - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2029)]; - lnkilb_(dj, &dj[1], djpool); - -/* The first meta-token will point to the resulting */ -/* normalized expression; we'll discard the other */ -/* two meta-tokens. */ - - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* MTEXPR(FIRST) and MTCODE(FIRST) are already */ -/* set correctly. All we need to do is determine */ -/* our next state. The next state defaults to */ -/* PARSE; the other possibility is POP. */ - - state = 3; - } else { - -/* We'll have to reduce the expression on the right */ -/* of the third meta-token before coming back to */ -/* this expression. Get ready to push our state. */ - -/* The condition that must be met in order to pop our */ -/* state will be that we've performed a reduction. */ - - retcnd = 1; - start = third; - state = 0; - } - -/* Either we've reduced an OR expression, in which case */ -/* the state has been set to PARSE or POP, or we've */ -/* found a sub-expression that must be reduced before */ -/* we attack the current expression, in which case the */ -/* state has been set to PUSH. */ - - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 2070)] == -13 && mtcode[(i__2 = second - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)2070)] == -10 && mtcode[(i__3 = third - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)2070)] == -13) { - -/* We have the conjunction of two normalized */ -/* expressions. This case requires application of */ -/* DeMorgan's laws to convert the expression to a */ -/* normalized form. */ - -/* If we have two normalized expressions, say */ - -/* EXPR1 = ( A11 and A12 and ... ) */ -/* or ( A21 and A22 and ... ) */ -/* . */ -/* . */ -/* . */ -/* or ( AM1 and AM2 and ... ) */ - - -/* EXPR2 = ( B11 and B12 and ... ) */ -/* or ( B21 and B22 and ... ) */ -/* . */ -/* . */ -/* . */ -/* or ( BN1 and BN2 and ... ) */ - - - -/* Then ( EXPR1 and EXPR2 ) = */ - - -/* or { ( ( AI1 and AI2 and ... ) */ -/* I = 1,...,M and ( BJ1 and BJ2 and ... ) ) } */ -/* J = 1,...,N */ - - -/* We have the conjunction of two normalized */ -/* So, to represent the normalized expression resulting */ -/* from the conjuction of the expressions represented by */ -/* the meta-tokens FIRST and THIRD, we will loop through */ -/* each disjunction list and form the disjunction of all */ -/* conjunctions of pairs of conjunctions, one of which is */ -/* from the first expression and one of which is from the */ -/* second. After doing this, we'll clean up the */ -/* conjunction and disjunction pools by freeing the */ -/* elements in those pools used by the original two */ -/* meta-tokens FIRST and THIRD. */ - - - dj[0] = mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2119)]; - djtail = 0; - while(dj[0] > 0) { - dj[1] = mtexpr[(i__1 = third - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2124)]; - while(dj[1] > 0) { - -/* Allocate a new disjunction table entry, */ -/* and create a new conjunction that represents */ -/* the conjunction of the conjunction lists */ -/* pointed to by DJ(1) and DJ(2). */ - - if (lnknfn_(djpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Disjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(djpool, &newdj); - -/* Make copies of the conjunction lists pointed */ -/* to by DJ(1) and DJ(2). */ - - cj[0] = djptrs[(i__1 = dj[0] - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("djptrs", i__1, - "zzeknrml_", (ftnlen)2146)]; - tail = 0; - while(cj[0] > 0) { - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is ful" - "l.", prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &newcj); - lnkila_(&tail, &newcj, cjpool); - tail = newcj; - cjptrs[(i__1 = tail - 1) < 5000 && 0 <= i__1 ? - i__1 : s_rnge("cjptrs", i__1, "zzek" - "nrml_", (ftnlen)2161)] = cjptrs[(i__2 - = cj[0] - 1) < 5000 && 0 <= i__2 ? - i__2 : s_rnge("cjptrs", i__2, "zzekn" - "rml_", (ftnlen)2161)]; - cj[0] = lnknxt_(cj, cjpool); - } - head1 = lnkhl_(&tail, cjpool); - cj[1] = djptrs[(i__1 = dj[1] - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("djptrs", i__1, - "zzeknrml_", (ftnlen)2170)]; - tail = 0; - while(cj[1] > 0) { - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is ful" - "l.", prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &newcj); - lnkila_(&tail, &newcj, cjpool); - tail = newcj; - cjptrs[(i__1 = tail - 1) < 5000 && 0 <= i__1 ? - i__1 : s_rnge("cjptrs", i__1, "zzek" - "nrml_", (ftnlen)2185)] = cjptrs[(i__2 - = cj[1] - 1) < 5000 && 0 <= i__2 ? - i__2 : s_rnge("cjptrs", i__2, "zzekn" - "rml_", (ftnlen)2185)]; - cj[1] = lnknxt_(&cj[1], cjpool); - } - head2 = lnkhl_(&tail, cjpool); - -/* Now link these copies and make NEWDJ point to */ -/* the resulting list. */ - - lnkilb_(&head1, &head2, cjpool); - djptrs[(i__1 = newdj - 1) < 5000 && 0 <= i__1 ? - i__1 : s_rnge("djptrs", i__1, "zzeknrml_", - (ftnlen)2199)] = head1; - -/* Link NEWDJ in at the tail of the disjunction */ -/* list. */ - - lnkila_(&djtail, &newdj, djpool); - djtail = newdj; - dj[1] = lnknxt_(&dj[1], djpool); - } - dj[0] = lnknxt_(dj, djpool); - } - -/* We've now created the new normalized expression that */ -/* represents the conjunction of our original two */ -/* expressions. */ - -/* Before continuing, we should clean up the entries in */ -/* the disjunction and conjunction pools used by the */ -/* original expressions. We can save a little work */ -/* by linking those entries before freeing them. */ - - lnkilb_(&mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2226)], &mtexpr[(i__2 = third - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtexpr", i__2, "zzek" - "nrml_", (ftnlen)2226)], djpool); - djnode = mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2228)]; - while(djnode > 0) { - -/* Free the conjunction list pointed to by DJNODE. */ - - cjnode = djptrs[(i__1 = djnode - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("djptrs", i__1, "zzeknr" - "ml_", (ftnlen)2234)]; - i__1 = lnktl_(&cjnode, cjpool); - lnkfsl_(&cjnode, &i__1, cjpool); - djnode = lnknxt_(&djnode, djpool); - } - -/* Free the disjunction list that starts with */ -/* MTEXPR(FIRST). */ - - i__3 = lnktl_(&mtexpr[(i__2 = first - 1) < 500 && 0 <= - i__2 ? i__2 : s_rnge("mtexpr", i__2, "zzeknrml_", - (ftnlen)2247)], djpool); - lnkfsl_(&mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2247)], &i__3, djpool); - -/* NEWDJ is the tail node of the list of disjunctions */ -/* we've just finished. The first meta-token should */ -/* point to the head of this disjunction list. */ - - mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)2256)] - = lnkhl_(&newdj, djpool); - -/* We no longer need the other two meta-tokens. */ - - lnkfsl_(&second, &third, mtpool); - nmeta += -2; - -/* Decide the next state. */ - - state = 3; - } else { - -/* There are no other valid cases in which the first */ -/* meta-token is an expression. */ - - *error = TRUE_; - s_copy(prserr, "Unexpected token found following valid e" - "xpression.", prserr_len, (ftnlen)50); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)2284)] == -12) - { - -/* There are four valid token sequences that we could */ -/* see here: */ - -/* NOT */ -/* NOT IDENT */ -/* NOT NAME */ -/* NOT NOT */ -/* NOT ( */ - - if (second <= 0) { - *error = TRUE_; - s_copy(prserr, "Tokens were missing from logical express" - "ion.", prserr_len, (ftnlen)44); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 2303)] == -2) { - -/* We'll have to push our state before continuing. */ - - start = third; - retcnd = 2; - state = 0; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 2312)] == -12 || mtcode[(i__2 = second - 1) < 500 && - 0 <= i__2 ? i__2 : s_rnge("mtcode", i__2, "zzeknrml_", - (ftnlen)2312)] == -7 || mtcode[(i__3 = second - 1) < - 500 && 0 <= i__3 ? i__3 : s_rnge("mtcode", i__3, - "zzeknrml_", (ftnlen)2312)] == -6) { - start = second; - retcnd = 1; - state = 0; - } else if (mtcode[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen) - 2321)] == -13) { - -/* We have the negation of a normalized expression. Since */ -/* the NOT operator has higher precedence than any other, */ -/* we need not concern ourselves with the token on the */ -/* right of the expression. */ - -/* This case requires application of DeMorgan's laws to */ -/* convert the expression to a normalized form. */ - - -/* If we have a normalized expression, say */ - -/* EXPR = ( A11 and A12 and ... ) */ -/* or ( A21 and A22 and ... ) */ -/* . */ -/* . */ -/* . */ -/* or ( AM1 and AM2 and ... ) */ - -/* Then (using the tilde to express negation): */ - -/* ~EXPR = ( ~A11 or ~A12 or ... ) */ -/* and ( ~A21 or ~A22 or ... ) */ -/* . */ -/* . */ -/* . */ -/* and ( ~AM1 or ~AM2 or ... ) */ - -/* Since each parenthesized expression above is a */ -/* normalized expression, we can convert the conjunction */ -/* of any of these expressions and a second normalized */ -/* expression to normalized form using the method of the */ -/* AND case above. */ - -/* We'll first build the expression */ - -/* ( ~A11 or ~A12 or ... ) */ - -/* and then combine the others with it, one by one. */ -/* When we're all done, we'll negate the operators used */ -/* in the comparison relations. */ - -/* The pointer EXPRHD will denote the head of the */ -/* combined normalized expression. */ - - djnode = mtexpr[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2367)]; - cjnode = djptrs[(i__1 = djnode - 1) < 5000 && 0 <= i__1 ? - i__1 : s_rnge("djptrs", i__1, "zzeknrml_", ( - ftnlen)2369)]; - tail = 0; - while(cjnode > 0) { - -/* Create a new singleton disjunction list */ -/* that points to the relation pointed to by */ -/* CJNODE. */ - - if (lnknfn_(djpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Disjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(djpool, &newdj); - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is full.", - prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &newcj); - cjptrs[(i__1 = newcj - 1) < 5000 && 0 <= i__1 ? i__1 : - s_rnge("cjptrs", i__1, "zzeknrml_", (ftnlen) - 2396)] = cjptrs[(i__2 = cjnode - 1) < 5000 && - 0 <= i__2 ? i__2 : s_rnge("cjptrs", i__2, - "zzeknrml_", (ftnlen)2396)]; - djptrs[(i__1 = newdj - 1) < 5000 && 0 <= i__1 ? i__1 : - s_rnge("djptrs", i__1, "zzeknrml_", (ftnlen) - 2397)] = newcj; - -/* Now link the new singleton disjunction list in */ -/* at the tail of the disjunction list that */ -/* parallels the conjunction list we're currently */ -/* traversing. */ - - lnkila_(&tail, &newdj, djpool); - tail = newdj; - cjnode = lnknxt_(&cjnode, cjpool); - } - -/* Keep track of the head of the new normalized */ -/* expression. */ - - exprhd = lnkhl_(&tail, djpool); - -/* Now, for every remaining conjunction in the original */ -/* expression, we'll form the normalized expression */ -/* resulting from the conjunction of its negation and */ -/* of our cumulative normalized expression. As mentioned */ -/* before, we won't negate the comparison operators */ -/* just yet. */ - - - djnode = lnknxt_(&djnode, djpool); - while(djnode > 0) { - -/* Loop through our existing cumulative */ -/* expression and the latest conjunction, forming */ -/* all pairwise conjunctions. */ - - dj[0] = exprhd; - djtail = 0; - while(dj[0] > 0) { - cj[1] = djptrs[(i__1 = djnode - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("djptrs", i__1, - "zzeknrml_", (ftnlen)2439)]; - while(cj[1] > 0) { - -/* Make a copy of the conjunction list pointed */ -/* to by DJPTRS(DJ(1)). */ - - cjnode = djptrs[(i__1 = dj[0] - 1) < 5000 && - 0 <= i__1 ? i__1 : s_rnge("djptrs", - i__1, "zzeknrml_", (ftnlen)2446)]; - tail = 0; - while(cjnode > 0) { - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is" - " full.", prserr_len, (ftnlen) - 26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &newcj); - lnkila_(&tail, &newcj, cjpool); - cjptrs[(i__1 = newcj - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("cjptrs", - i__1, "zzeknrml_", (ftnlen)2461)] - = cjptrs[(i__2 = cjnode - 1) < - 5000 && 0 <= i__2 ? i__2 : s_rnge( - "cjptrs", i__2, "zzeknrml_", ( - ftnlen)2461)]; - tail = newcj; - cjnode = lnknxt_(&cjnode, cjpool); - } - cj[0] = lnkhl_(&tail, cjpool); - -/* Allocate a new conjunction table entry for */ -/* the conjunction of the expressions */ -/* pointed to by CJ(1) and CJ(2). Allocate a */ -/* new disjunction table entry to point to this */ -/* new conjunction. */ - - if (lnknfn_(cjpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Conjunction table is ful" - "l.", prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(cjpool, &newcj); - cjptrs[(i__1 = newcj - 1) < 5000 && 0 <= i__1 - ? i__1 : s_rnge("cjptrs", i__1, "zze" - "knrml_", (ftnlen)2484)] = cjptrs[( - i__2 = cj[1] - 1) < 5000 && 0 <= i__2 - ? i__2 : s_rnge("cjptrs", i__2, "zze" - "knrml_", (ftnlen)2484)]; - if (lnknfn_(djpool) < 1) { - *error = TRUE_; - s_copy(prserr, "Disjunction table is ful" - "l.", prserr_len, (ftnlen)26); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - lnkan_(djpool, &newdj); - -/* Hook everything up. */ - - lnkilb_(cj, &newcj, cjpool); - djptrs[(i__1 = newdj - 1) < 5000 && 0 <= i__1 - ? i__1 : s_rnge("djptrs", i__1, "zze" - "knrml_", (ftnlen)2500)] = cj[0]; - lnkila_(&djtail, &newdj, djpool); - djtail = newdj; - cj[1] = lnknxt_(&cj[1], cjpool); - } - dj[0] = lnknxt_(dj, djpool); - } - -/* Before going on, clean up the conjunction and */ -/* disjunction pool entries used by our last */ -/* version of the cumulative expression. */ - - dj[0] = exprhd; - while(dj[0] > 0) { - cj[0] = djptrs[(i__1 = dj[0] - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("djptrs", i__1, - "zzeknrml_", (ftnlen)2522)]; - cj[1] = lnktl_(cj, cjpool); - lnkfsl_(cj, &cj[1], cjpool); - dj[0] = lnknxt_(dj, djpool); - } - i__1 = lnktl_(&exprhd, djpool); - lnkfsl_(&exprhd, &i__1, djpool); - -/* Set EXPRHD to be the head of our updated, */ -/* cumulative expression. Start to work on the */ -/* next conjunction. */ - - exprhd = lnkhl_(&djtail, djpool); - djnode = lnknxt_(&djnode, djpool); - } - -/* EXPRHD now points to a new expression that will */ -/* represent the negation of the expression pointed */ -/* to by MTEXPR(SECOND), as soon as we negate the */ -/* comparison operators referenced in the expression. */ -/* Take care of this last step now. To make sure that */ -/* we negate each operator exactly once, we build a set */ -/* of relations to be negated, then negate each relation */ -/* in the set. */ - - ssizei_(&c__5000, relset); - djnode = mtexpr[(i__1 = second - 1) < 500 && 0 <= i__1 ? - i__1 : s_rnge("mtexpr", i__1, "zzeknrml_", ( - ftnlen)2557)]; - while(djnode > 0) { - cjnode = djptrs[(i__1 = djnode - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("djptrs", i__1, "zzeknr" - "ml_", (ftnlen)2562)]; - while(cjnode > 0) { - relptr = cjptrs[(i__1 = cjnode - 1) < 5000 && 0 <= - i__1 ? i__1 : s_rnge("cjptrs", i__1, - "zzeknrml_", (ftnlen)2566)]; - insrti_(&relptr, relset); - cjnode = lnknxt_(&cjnode, cjpool); - } - djnode = lnknxt_(&djnode, djpool); - } - i__1 = cardi_(relset); - for (i__ = 1; i__ <= i__1; ++i__) { - relptr = relset[(i__2 = i__ + 5) < 5006 && 0 <= i__2 ? - i__2 : s_rnge("relset", i__2, "zzeknrml_", ( - ftnlen)2580)]; - j = isrchi_(&rels[(i__2 = relptr * 3 - 2) < 15000 && - 0 <= i__2 ? i__2 : s_rnge("rels", i__2, "zze" - "knrml_", (ftnlen)2581)], &c__8, cmpcde); - rels[(i__2 = relptr * 3 - 2) < 15000 && 0 <= i__2 ? - i__2 : s_rnge("rels", i__2, "zzeknrml_", ( - ftnlen)2584)] = cmpneg[(i__3 = j - 1) < 8 && - 0 <= i__3 ? i__3 : s_rnge("cmpneg", i__3, - "zzeknrml_", (ftnlen)2584)]; - } - -/* Set the pointer of the first meta-token to point */ -/* to our normalized expression, and change the */ -/* meta-token's code to . */ - - mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtexpr", i__1, "zzeknrml_", (ftnlen)2593)] - = exprhd; - mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)2594)] - = -13; - -/* Get rid of the second meta-token, and determine the */ -/* next state. */ - - lnkfsl_(&second, &second, mtpool); - --nmeta; - state = 3; - } else { - -/* The second token is invalid in this context. */ - - *error = TRUE_; - s_copy(prserr, "Token following NOT operator was invalid." - , prserr_len, (ftnlen)41); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* This is the end of the NOT case. */ - - } else if (mtcode[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mtcode", i__1, "zzeknrml_", (ftnlen)2621)] == -2) - { - -/* We're looking at the start of a `parenthesized' */ -/* sub-expression. */ - -/* Push our state, and start parsing at meta-token */ -/* SECOND. The condition for popping our state will be */ -/* that we encounter a right grouper. */ - - retcnd = 2; - start = second; - state = 0; - } else { - -/* Only a syntax error could get us here. */ - - *error = TRUE_; - s_copy(prserr, "Unexpected token found.", prserr_len, (ftnlen) - 23); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* This is the end of the code for the PARSE state. We've */ -/* determined the next parsing state at this point. */ - - } else if (state == 3) { - -/* A reduction has been done. Decide the next state. */ - - state = 3; - if (popcnd[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "popcnd", i__1, "zzeknrml_", (ftnlen)2657)] == 1) { - state = 1; - } else { - mstart[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mstart", i__1, "zzeknrml_", (ftnlen)2660)] = first; - state = 2; - } - } else if (state == 0) { - -/* Increment the stack level, and save the current */ -/* starting point and pop condition. */ - - ++level; - if (level > 500) { - *error = TRUE_; - s_copy(prserr, "Stack is full", prserr_len, (ftnlen)13); - state = 4; - } else { - mstart[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mstart", i__1, "zzeknrml_", (ftnlen)2678)] = start; - popcnd[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "popcnd", i__1, "zzeknrml_", (ftnlen)2679)] = retcnd; - state = 2; - } - } else if (state == 1) { - -/* If we can, pop the state. */ - - if (level > 1) { - if (popcnd[(i__1 = level - 1) < 500 && 0 <= i__1 ? i__1 : - s_rnge("popcnd", i__1, "zzeknrml_", (ftnlen)2690)] == - 2) { - -/* If we're popping the state because we encountered a */ -/* right grouper, we have a meta-token sequence that */ -/* looks like this: */ - -/* ( EXPR ) */ - -/* ^ ^ */ -/* FIRST SECOND */ - -/* We need to remove the grouping tokens, taking care to */ -/* update the starting token at the next lower level, if */ -/* the left grouper was the starting token. */ - - prev = lnkprv_(&first, mtpool); - if (mstart[(i__1 = level - 2) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mstart", i__1, "zzeknrml_", (ftnlen)2707)] - == prev) { - mstart[(i__1 = level - 2) < 500 && 0 <= i__1 ? i__1 : - s_rnge("mstart", i__1, "zzeknrml_", (ftnlen) - 2708)] = first; - } - if (metahd == prev) { - metahd = first; - } - lnkfsl_(&prev, &prev, mtpool); - lnkfsl_(&second, &second, mtpool); - nmeta += -2; - } - --level; - state = 2; - } else { - *error = TRUE_; - s_copy(prserr, "Syntax error: badly formed WHERE clause.", - prserr_len, (ftnlen)41); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - } - -/* We've considered all states. */ - - } - -/* At this point, there should be a single meta-token of type EXPR. */ -/* This meta-token should point to a normalized expression. We'll */ -/* set the encoded query to represent this expression. For each */ -/* constraint, we'll add a constraint descriptor to the encoded */ -/* query. We'll also update the count of constraints, the count of */ -/* conjunctions, and we'll add a list of conjunction sizes. */ - - djnode = mtexpr[(i__1 = first - 1) < 500 && 0 <= i__1 ? i__1 : s_rnge( - "mtexpr", i__1, "zzeknrml_", (ftnlen)2750)]; - nconj = 0; - nrels = 0; - while(djnode > 0) { - ++nconj; - sizes[(i__1 = nconj - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge("sizes", - i__1, "zzeknrml_", (ftnlen)2757)] = 0; - cjnode = djptrs[(i__1 = djnode - 1) < 5000 && 0 <= i__1 ? i__1 : - s_rnge("djptrs", i__1, "zzeknrml_", (ftnlen)2758)]; - while(cjnode > 0) { - ++nrels; - sizes[(i__1 = nconj - 1) < 1000 && 0 <= i__1 ? i__1 : s_rnge( - "sizes", i__1, "zzeknrml_", (ftnlen)2763)] = sizes[(i__2 = - nconj - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge("sizes", - i__2, "zzeknrml_", (ftnlen)2763)] + 1; - relptr = cjptrs[(i__1 = cjnode - 1) < 5000 && 0 <= i__1 ? i__1 : - s_rnge("cjptrs", i__1, "zzeknrml_", (ftnlen)2764)]; - tabptr = rels[(i__1 = relptr * 3 - 3) < 15000 && 0 <= i__1 ? i__1 - : s_rnge("rels", i__1, "zzeknrml_", (ftnlen)2766)]; - op = rels[(i__1 = relptr * 3 - 2) < 15000 && 0 <= i__1 ? i__1 : - s_rnge("rels", i__1, "zzeknrml_", (ftnlen)2767)]; - rhsptr = rels[(i__1 = relptr * 3 - 1) < 15000 && 0 <= i__1 ? i__1 - : s_rnge("rels", i__1, "zzeknrml_", (ftnlen)2768)]; - -/* Add a constraint descriptor to the encoded query. The */ -/* structure of these descriptors is documented in the include */ -/* file for encoded query parameters. */ - -/* First, save space for the constraint type. We'll fill this */ -/* in after finding out what's on the right hand side. */ - - appndi_(&c__0, eqryi); - k = cardi_(eqryi); - -/* Next, add name descriptors for the table and column on */ -/* the left-hand side. These descriptors are linked and */ -/* pointed to by NAMPTR. */ - - for (i__ = 1; i__ <= 6; ++i__) { - appndi_(&dscbuf[(i__1 = i__ + tabptr * 7 - 8) < 35000 && 0 <= - i__1 ? i__1 : s_rnge("dscbuf", i__1, "zzeknrml_", ( - ftnlen)2787)], eqryi); - } - colptr = lnknxt_(&tabptr, dspool); - for (i__ = 1; i__ <= 6; ++i__) { - appndi_(&dscbuf[(i__1 = i__ + colptr * 7 - 8) < 35000 && 0 <= - i__1 ? i__1 : s_rnge("dscbuf", i__1, "zzeknrml_", ( - ftnlen)2793)], eqryi); - } - -/* What happens next depends on whether the query has a null */ -/* value on the right hand side. This is indicated by the */ -/* relation's value pointer being NIL. */ - - if (rhsptr == 0) { - -/* For constraints involving null values, we change the */ -/* operator to ISNULL or NOTNUL as appropriate. */ - - if (op == 1) { - op = 9; - } else if (op == 6) { - op = 10; - } else { - *error = TRUE_; - s_copy(prserr, "NULL values can only be used with the op" - "erators \"IS NULL\", \"NOT NULL\", or equivalent" - "s.", prserr_len, (ftnlen)86); - chkout_("ZZEKNRML", (ftnlen)8); - return 0; - } - -/* Set the operator code. */ - - appndi_(&op, eqryi); - -/* Pad the constraint descriptor up to the full length. */ - - for (i__ = 1; i__ <= 12; ++i__) { - appndi_(&c__0, eqryi); - } - -/* Set the descriptor's type by updating the reserved */ -/* location. */ - - eqryi[k + 5] = 2; - } else { - -/* For `normal' constraints, that is, constraints that don't */ -/* involve null values, we set the operator code, then */ -/* fill in the information describing the RHS of the */ -/* constraint. */ - - appndi_(&op, eqryi); - if (dscbuf[(i__1 = rhsptr * 7 - 1) < 35000 && 0 <= i__1 ? - i__1 : s_rnge("dscbuf", i__1, "zzeknrml_", (ftnlen) - 2851)] == -8) { - -/* The RHS contains a value. Append the descriptor */ -/* for the value, then pad the constraint descriptor. */ - - for (i__ = 1; i__ <= 6; ++i__) { - appndi_(&dscbuf[(i__1 = i__ + rhsptr * 7 - 8) < 35000 - && 0 <= i__1 ? i__1 : s_rnge("dscbuf", i__1, - "zzeknrml_", (ftnlen)2857)], eqryi); - } - for (i__ = 1; i__ <= 6; ++i__) { - appndi_(&c__0, eqryi); - } - -/* Set the descriptor's type by updating the reserved */ -/* location. */ - - eqryi[k + 5] = 2; - } else { - -/* The RHS contains a column name. Append the */ -/* descriptors for the table and column. */ - - for (i__ = 1; i__ <= 6; ++i__) { - appndi_(&dscbuf[(i__1 = i__ + rhsptr * 7 - 8) < 35000 - && 0 <= i__1 ? i__1 : s_rnge("dscbuf", i__1, - "zzeknrml_", (ftnlen)2877)], eqryi); - } - colptr = lnknxt_(&rhsptr, dspool); - for (i__ = 1; i__ <= 6; ++i__) { - appndi_(&dscbuf[(i__1 = i__ + colptr * 7 - 8) < 35000 - && 0 <= i__1 ? i__1 : s_rnge("dscbuf", i__1, - "zzeknrml_", (ftnlen)2883)], eqryi); - } - -/* Set the descriptor's type by updating the reserved */ -/* location. */ - - eqryi[k + 5] = 1; - } - } - -/* We've updated the encoded query to reflect the current */ -/* constraint relation. */ - - cjnode = lnknxt_(&cjnode, cjpool); - } - -/* We've set the array element SIZES(NCONJ). */ - - djnode = lnknxt_(&djnode, djpool); - } - -/* Set the counts of constraints and conjunctions in the encoded */ -/* query. */ - - zzekweqi_("NUM_CONSTRAINTS", &nrels, eqryi, (ftnlen)15); - zzekweqi_("NUM_CONJUNCTIONS", &nconj, eqryi, (ftnlen)16); - -/* Add the conjunction size list to the encoded query. */ - - i__1 = nconj; - for (i__ = 1; i__ <= i__1; ++i__) { - appndi_(&sizes[(i__2 = i__ - 1) < 1000 && 0 <= i__2 ? i__2 : s_rnge( - "sizes", i__2, "zzeknrml_", (ftnlen)2920)], eqryi); - } - chkout_("ZZEKNRML", (ftnlen)8); - return 0; -} /* zzeknrml_ */ - diff --git a/ext/spice/src/cspice/zzekordc.c b/ext/spice/src/cspice/zzekordc.c deleted file mode 100644 index a94092df95..0000000000 --- a/ext/spice/src/cspice/zzekordc.c +++ /dev/null @@ -1,263 +0,0 @@ -/* zzekordc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKORDC ( Order of a character EK column ) */ -/* Subroutine */ int zzekordc_(char *cvals, logical *nullok, logical *nlflgs, - integer *nvals, integer *iorder, ftnlen cvals_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - logical l_le(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg; - logical le1, eq1; - integer gap; - -/* $ Abstract */ - -/* Determine the order of elements in a character EK column, */ -/* using dictionary ordering on character data values and array */ -/* indices. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CVALS I Array of character string column values. */ -/* NULLOK I Logical flag indicating whether nulls are allowed. */ -/* NLFLGS I Flags indicating whether column entries are null. */ -/* NVALS I Dimension of CVALS. */ -/* IORDER O Order vector for CVALS. */ - -/* $ Detailed_Input */ - -/* CVALS is an array of character string EK column values, */ -/* some of which may be null, if null values are */ -/* permitted. See the description of the input */ -/* arguments NULLOK and NLFLGS below. */ - -/* NULLOK is a logical flag indicating whether column */ -/* elements may be null. If NULLOK is TRUE, then */ -/* NLFLGS must be set to indicate the status of each */ -/* element of CVALS. */ - -/* NLFLGS is an array of logical flags that indicate whether */ -/* the corresponding elements of CVALS are null. */ -/* NLFLGS is meaningful only when NULLOK is .TRUE. */ -/* When NULLOK is .TRUE., the Ith element of CVALS is */ -/* null if and only if the Ith element of NLFLGS */ -/* is .TRUE. */ - -/* When NULLOK is .FALSE., all elements of CVALS are */ -/* considered to be non-null. */ - -/* NVALS is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* IORDER is the order vector for the input array. */ -/* IORDER(1) is the index of the smallest element */ -/* of CVALS; IORDER(2) is the index of the next */ -/* smallest; and so on. Null values, if allowed, are */ -/* considered to be less than all non-null values. */ -/* The order relation between equal values is */ -/* determined by the indices of the values in the */ -/* input array; values with lower indices are */ -/* considered to be smaller. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* ZZEKORDC creates an order vector for an array of character */ -/* column values. Null values are allowed. The order relation used */ -/* is dictionary ordering on ordered pairs consisting of data */ -/* values and array indices: if two input data values are equal, */ -/* the associated array indices determine the order relation of the */ -/* values, where the smaller index is considered to precede the */ -/* greater. */ - -/* $ Examples */ - -/* 1) Sort the following list of values, some of which are null: */ - -/* Value Null? */ -/* ------------------ --------------------- */ -/* CVALS(1) = 'CAT' NLFLGS(1) = .FALSE. */ -/* CVALS(2) = 'APT' NLFLGS(2) = .FALSE. */ -/* CVALS(3) = 'DOG' NLFLGS(3) = .TRUE. */ -/* CVALS(4) = 'EAT' NLFLGS(4) = .FALSE. */ -/* CVALS(5) = 'BAD' NLFLGS(5) = .TRUE. */ - - -/* The subroutine call */ - -/* CALL ZZEKORDC ( CVALS, .TRUE., NLFLGS, 5, IORDER ) */ - -/* generates the output */ - -/* IORDER(1) = 3 */ -/* IORDER(2) = 5 */ -/* IORDER(3) = 2 */ -/* IORDER(4) = 1 */ -/* IORDER(5) = 4 */ - - - -/* 2) Given the same inputs values of CVALS and NLFLGS, the */ -/* subroutine call */ - -/* CALL ZZEKORDC ( CVALS, .FALSE., NLFLGS, 5, IORDER ) */ - -/* generates the output */ - -/* IORDER(1) = 2 */ -/* IORDER(2) = 5 */ -/* IORDER(3) = 1 */ -/* IORDER(4) = 3 */ -/* IORDER(5) = 4 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Beta Version 3.0.0, 26-MAY-1995 (NJB) */ - -/* Re-written to use dictionary ordering on values and input */ -/* array indices. */ - -/* - Beta Version 2.0.0, 13-FEB-1995 (NJB) */ - -/* Renamed as a private routine. */ - -/* - Beta Version 1.0.0, 13-APR-1994 (NJB) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* order of a character EK column */ - -/* -& */ - -/* Local variables */ - - -/* Statement functions */ - - -/* Begin with the initial ordering. */ - - i__1 = *nvals; - for (i__ = 1; i__ <= i__1; ++i__) { - iorder[i__ - 1] = i__; - } - -/* Find the smallest element, then the next smallest, and so on. */ -/* This uses the Shell Sort algorithm, but swaps the elements of */ -/* the order vector instead of the array itself. */ - - gap = *nvals / 2; - while(gap > 0) { - i__1 = *nvals; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - le1 = l_le(cvals + (iorder[j - 1] - 1) * cvals_len, cvals + ( - iorder[jg - 1] - 1) * cvals_len, cvals_len, cvals_len) - ; - eq1 = s_cmp(cvals + (iorder[j - 1] - 1) * cvals_len, cvals + ( - iorder[jg - 1] - 1) * cvals_len, cvals_len, cvals_len) - == 0; - if (! (*nullok) && (le1 || eq1 && iorder[j - 1] < iorder[jg - - 1]) || *nullok && (nlflgs[iorder[j - 1] - 1] && ! - nlflgs[iorder[jg - 1] - 1] || nlflgs[iorder[j - 1] - - 1] && nlflgs[iorder[jg - 1] - 1] && iorder[j - 1] < - iorder[jg - 1] || ! (nlflgs[iorder[j - 1] - 1] || - nlflgs[iorder[jg - 1] - 1]) && (le1 || eq1 && iorder[ - j - 1] < iorder[jg - 1]))) { - -/* Getting here means that */ - -/* CVALS(IORDER(J)) .LE. CVALS(IORDER(JG)) */ - -/* according to our order relation. */ - - j = 0; - } else { - swapi_(&iorder[j - 1], &iorder[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* zzekordc_ */ - diff --git a/ext/spice/src/cspice/zzekordd.c b/ext/spice/src/cspice/zzekordd.c deleted file mode 100644 index d5c77b01b0..0000000000 --- a/ext/spice/src/cspice/zzekordd.c +++ /dev/null @@ -1,250 +0,0 @@ -/* zzekordd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKORDD ( Order of a double precision EK column ) */ -/* Subroutine */ int zzekordd_(doublereal *dvals, logical *nullok, logical * - nlflgs, integer *nvals, integer *iorder) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg, gap; - -/* $ Abstract */ - -/* Determine the order of elements in a double precision EK column, */ -/* using dictionary ordering on d.p. data values and array */ -/* indices. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DVALS I Array of d.p. column values. */ -/* NULLOK I Logical flag indicating whether nulls are allowed. */ -/* NLFLGS I Flags indicating whether column entries are null. */ -/* NVALS I Dimension of DVALS. */ -/* IORDER O Order vector for DVALS. */ - -/* $ Detailed_Input */ - -/* DVALS is an array of double precision EK column values, */ -/* some of which may be null, if null values are */ -/* permitted. See the description of the input */ -/* arguments NULLOK and NLFLGS below. */ - -/* NULLOK is a logical flag indicating whether column */ -/* elements may be null. If NULLOK is TRUE, then */ -/* NLFLGS must be set to indicate the status of each */ -/* element of DVALS. */ - -/* NLFLGS is an array of logical flags that indicate whether */ -/* the corresponding elements of DVALS are null. */ -/* NLFLGS is meaningful only when NULLOK is .TRUE. */ -/* When NULLOK is .TRUE., the Ith element of DVALS is */ -/* null if and only if the Ith element of NLFLGS */ -/* is .TRUE. */ - -/* When NULLOK is .FALSE., all elements of DVALS are */ -/* considered to be non-null. */ - -/* NVALS is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* IORDER is the order vector for the input array. */ -/* IORDER(1) is the index of the smallest element */ -/* of DVALS; IORDER(2) is the index of the next */ -/* smallest; and so on. Null values, if allowed, are */ -/* considered to be less than all non-null values. */ -/* The order relation between equal values is */ -/* determined by the indices of the values in the */ -/* input array; values with lower indices are */ -/* considered to be smaller. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* ZZEKORDD creates an order vector for an array of double precision */ -/* column values. Null values are allowed. The order relation used */ -/* is dictionary ordering on ordered pairs consisting of data */ -/* values and array indices: if two input data values are equal, */ -/* the associated array indices determine the order relation of the */ -/* values, where the smaller index is considered to precede the */ -/* greater. */ - -/* $ Examples */ - -/* 1) Sort the following list of values, some of which are */ -/* null: */ - -/* Value Null? */ -/* -------------- --------------------- */ -/* DVALS(1) = 3 NLFLGS(1) = .FALSE. */ -/* DVALS(2) = 1 NLFLGS(2) = .FALSE. */ -/* DVALS(3) = 4 NLFLGS(3) = .TRUE. */ -/* DVALS(4) = 5 NLFLGS(4) = .FALSE. */ -/* DVALS(5) = 2 NLFLGS(5) = .TRUE. */ - - -/* The subroutine call */ - -/* CALL ZZEKORDD ( DVALS, .TRUE., NLFLGS, 5, IORDER ) */ - -/* generates the output */ - -/* IORDER(1) = 3 */ -/* IORDER(2) = 5 */ -/* IORDER(3) = 2 */ -/* IORDER(4) = 1 */ -/* IORDER(5) = 4 */ - - -/* 2) Given the same inputs values of DVALS and NLFLGS, the */ -/* subroutine call */ - -/* CALL ZZEKORDD ( DVALS, .FALSE., NLFLGS, 5, IORDER ) */ - -/* generates the output */ - -/* IORDER(1) = 2 */ -/* IORDER(2) = 5 */ -/* IORDER(3) = 1 */ -/* IORDER(4) = 3 */ -/* IORDER(5) = 4 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Beta Version 3.0.0, 08-SEP-1995 (NJB) */ - -/* Re-written to use dictionary ordering on values and input */ -/* array indices. */ - -/* - Beta Version 2.0.0, 13-FEB-1995 (NJB) */ - -/* Renamed as a private routine. */ - -/* - Beta Version 1.0.0, 13-APR-1994 (NJB) (IMU) */ - -/* -& */ - -/* Local variables */ - - -/* Statement functions */ - - -/* Begin with the initial ordering. */ - - i__1 = *nvals; - for (i__ = 1; i__ <= i__1; ++i__) { - iorder[i__ - 1] = i__; - } - -/* Find the smallest element, then the next smallest, and so on. */ -/* This uses the Shell Sort algorithm, but swaps the elements of */ -/* the order vector instead of the array itself. */ - - gap = *nvals / 2; - while(gap > 0) { - i__1 = *nvals; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (! (*nullok) && (dvals[iorder[j - 1] - 1] < dvals[iorder[ - jg - 1] - 1] || dvals[iorder[j - 1] - 1] == dvals[ - iorder[jg - 1] - 1] && iorder[j - 1] < iorder[jg - 1]) - || *nullok && (nlflgs[iorder[j - 1] - 1] && ! nlflgs[ - iorder[jg - 1] - 1] || nlflgs[iorder[j - 1] - 1] && - nlflgs[iorder[jg - 1] - 1] && iorder[j - 1] < iorder[ - jg - 1] || ! (nlflgs[iorder[j - 1] - 1] || nlflgs[ - iorder[jg - 1] - 1]) && (dvals[iorder[j - 1] - 1] < - dvals[iorder[jg - 1] - 1] || dvals[iorder[j - 1] - 1] - == dvals[iorder[jg - 1] - 1] && iorder[j - 1] < - iorder[jg - 1]))) { - -/* Getting here means that */ - -/* DVALS(IORDER(J)) .LE. DVALS(IORDER(JG)) */ - -/* according to our order relation. */ - - j = 0; - } else { - swapi_(&iorder[j - 1], &iorder[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* zzekordd_ */ - diff --git a/ext/spice/src/cspice/zzekordi.c b/ext/spice/src/cspice/zzekordi.c deleted file mode 100644 index 9c3fa7f503..0000000000 --- a/ext/spice/src/cspice/zzekordi.c +++ /dev/null @@ -1,252 +0,0 @@ -/* zzekordi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKORDI ( Order of an integer EK column ) */ -/* Subroutine */ int zzekordi_(integer *ivals, logical *nullok, logical * - nlflgs, integer *nvals, integer *iorder) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer jg, gap; - -/* $ Abstract */ - -/* Determine the order of elements in an integer EK column, using */ -/* dictionary ordering on integer data values and array indices. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IVALS I Array of integer column values. */ -/* NULLOK I Logical flag indicating whether nulls are allowed. */ -/* NLFLGS I Flags indicating whether column entries are null. */ -/* NVALS I Dimension of IVALS. */ -/* IORDER O Order vector for IVALS. */ - -/* $ Detailed_Input */ - -/* IVALS is an array of integer EK column values, */ -/* some of which may be null, if null values are */ -/* permitted. See the description of the input */ -/* arguments NULLOK and NLFLGS below. */ - -/* NULLOK is a logical flag indicating whether column */ -/* elements may be null. If NULLOK is TRUE, then */ -/* NLFLGS must be set to indicate the status of each */ -/* element of IVALS. */ - -/* NLFLGS is an array of logical flags that indicate whether */ -/* the corresponding elements of IVALS are null. */ -/* NLFLGS is meaningful only when NULLOK is .TRUE. */ -/* When NULLOK is .TRUE., the Ith element of IVALS is */ -/* null if and only if the Ith element of NLFLGS */ -/* is .TRUE. */ - -/* When NULLOK is .FALSE., all elements of IVALS are */ -/* considered to be non-null. */ - -/* NVALS is the number of elements in the input array. */ - -/* $ Detailed_Output */ - -/* IORDER is the order vector for the input array. */ -/* IORDER(1) is the index of the smallest element */ -/* of IVALS; IORDER(2) is the index of the next */ -/* smallest; and so on. Null values, if allowed, are */ -/* considered to be less than all non-null values. The */ -/* order relation between equal values is determined */ -/* by the indices of the values in the input array; */ -/* values with lower indices are considered to be */ -/* smaller. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* ZZEKORDI creates an order vector for an array of integer */ -/* column values. Null values are allowed. The order */ -/* relation used is dictionary ordering on ordered pairs consisting */ -/* of data values and array indices: if two input data values */ -/* are equal, the associated array indices determine the order */ -/* relation of the values, where the smaller index is considered */ -/* to precede the greater. */ - -/* $ Examples */ - -/* 1) Sort the following list of values, some of which are */ -/* null: */ - -/* Value Null? */ -/* -------------- --------------------- */ -/* IVALS(1) = 3 NLFLGS(1) = .FALSE. */ -/* IVALS(2) = 1 NLFLGS(2) = .FALSE. */ -/* IVALS(3) = 4 NLFLGS(3) = .TRUE. */ -/* IVALS(4) = 5 NLFLGS(4) = .FALSE. */ -/* IVALS(5) = 2 NLFLGS(5) = .TRUE. */ - - -/* The subroutine call */ - -/* CALL ZZEKORDI ( IVALS, .TRUE., NLFLGS, 5, IORDER ) */ - -/* generates the output */ - -/* IORDER(1) = 3 */ -/* IORDER(2) = 5 */ -/* IORDER(3) = 2 */ -/* IORDER(4) = 1 */ -/* IORDER(5) = 4 */ - -/* Note that the order of the null values is determined by */ -/* their indices in the input array. */ - - -/* 2) Given the same inputs values of IVALS and NLFLGS, the */ -/* subroutine call */ - -/* CALL ZZEKORDI ( IVALS, .FALSE., NLFLGS, 5, IORDER ) */ - -/* generates the output */ - -/* IORDER(1) = 2 */ -/* IORDER(2) = 5 */ -/* IORDER(3) = 1 */ -/* IORDER(4) = 3 */ -/* IORDER(5) = 4 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Beta Version 3.0.0, 26-MAY-1995 (NJB) */ - -/* Re-written to use dictionary ordering on values and input */ -/* array indices. */ - -/* - Beta Version 2.0.0, 13-FEB-1995 (NJB) */ - -/* Renamed as a private routine. */ - -/* - Beta Version 1.0.0, 13-APR-1994 (NJB) (IMU) */ - -/* -& */ - -/* Local variables */ - - -/* Statement functions */ - - -/* Begin with the initial ordering. */ - - i__1 = *nvals; - for (i__ = 1; i__ <= i__1; ++i__) { - iorder[i__ - 1] = i__; - } - -/* Find the smallest element, then the next smallest, and so on. */ -/* This uses the Shell Sort algorithm, but swaps the elements of */ -/* the order vector instead of the array itself. */ - - gap = *nvals / 2; - while(gap > 0) { - i__1 = *nvals; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - if (! (*nullok) && (ivals[iorder[j - 1] - 1] < ivals[iorder[ - jg - 1] - 1] || ivals[iorder[j - 1] - 1] == ivals[ - iorder[jg - 1] - 1] && iorder[j - 1] < iorder[jg - 1]) - || *nullok && (nlflgs[iorder[j - 1] - 1] && ! nlflgs[ - iorder[jg - 1] - 1] || nlflgs[iorder[j - 1] - 1] && - nlflgs[iorder[jg - 1] - 1] && iorder[j - 1] < iorder[ - jg - 1] || ! (nlflgs[iorder[j - 1] - 1] || nlflgs[ - iorder[jg - 1] - 1]) && (ivals[iorder[j - 1] - 1] < - ivals[iorder[jg - 1] - 1] || ivals[iorder[j - 1] - 1] - == ivals[iorder[jg - 1] - 1] && iorder[j - 1] < - iorder[jg - 1]))) { - -/* Getting here means that */ - -/* IVALS(IORDER(J)) .LE. IVALS(IORDER(JG)) */ - -/* according to our order relation. */ - - j = 0; - } else { - swapi_(&iorder[j - 1], &iorder[jg - 1]); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* zzekordi_ */ - diff --git a/ext/spice/src/cspice/zzekpage.c b/ext/spice/src/cspice/zzekpage.c deleted file mode 100644 index 0fdacd010f..0000000000 --- a/ext/spice/src/cspice/zzekpage.c +++ /dev/null @@ -1,2764 +0,0 @@ -/* zzekpage.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static doublereal c_b15 = 0.; -static integer c__128 = 128; -static integer c__0 = 0; -static integer c__256 = 256; -static integer c__8 = 8; -static integer c__2 = 2; -static integer c__1024 = 1024; -static integer c__7 = 7; -static integer c__12 = 12; -static integer c__3 = 3; -static integer c__13 = 13; -static integer c__4 = 4; -static integer c__9 = 9; -static integer c__14 = 14; -static integer c__6 = 6; -static integer c__5 = 5; -static integer c__11 = 11; -static integer c__10 = 10; -static integer c__16 = 16; -static integer c__15 = 15; - -/* $Procedure ZZEKPAGE ( Private: Manage EK DAS paging system ) */ -/* Subroutine */ int zzekpage_0_(int n__, integer *handle, integer *type__, - integer *addrss, char *stat, integer *p, char *pagec, doublereal * - paged, integer *pagei, integer *base, integer *value, ftnlen stat_len, - ftnlen pagec_len) -{ - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer addr__, unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen); - static integer e, l, freec, freed; - static char cfill[1024]; - static doublereal dfill[128]; - static integer freei; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer ifill[256]; - extern /* Subroutine */ int fillc_(char *, integer *, char *, ftnlen, - ftnlen), filld_(doublereal *, integer *, doublereal *), filli_( - integer *, integer *, integer *), errch_(char *, char *, ftnlen, - ftnlen); - static integer lastc, lastd, lasti; - static doublereal dpptr; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int dasadc_(integer *, integer *, integer *, - integer *, char *, ftnlen), dasadd_(integer *, integer *, - doublereal *); - extern logical failed_(void); - extern /* Subroutine */ int dasadi_(integer *, integer *, integer *); - static char encpag[5]; - static integer nfreec, nfreed; - extern /* Subroutine */ int daslla_(integer *, integer *, integer *, - integer *); - static integer nfreei; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *), dasrdi_(integer *, integer *, integer *, integer *), - dassih_(integer *, char *, ftnlen), dasrdc_(integer *, integer *, - integer *, integer *, integer *, char *, ftnlen), dasrdd_(integer - *, integer *, integer *, doublereal *), dashlu_(integer *, - integer *), prtdec_(char *, integer *, ftnlen), dasudc_(integer *, - integer *, integer *, integer *, integer *, char *, ftnlen), - dasudd_(integer *, integer *, integer *, doublereal *), errfnm_( - char *, integer *, ftnlen), sigerr_(char *, ftnlen), prtenc_( - integer *, char *, ftnlen), chkout_(char *, ftnlen); - static integer forwrd; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - static integer npc, npd, npi; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Manage EK DAS paging system. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Architecture Version Parameters */ - -/* ekarch.inc Version 1 01-NOV-1995 (NJB) */ - - -/* The following parameter indicates the EK file architecture */ -/* version. EK files read by the EK system must have the */ -/* architecture expected by the reader software; the architecture ID */ -/* below is used to test for compatibility. */ - -/* Architecture code: */ - - -/* End Include Section: EK Architecture Version Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Entries */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I PGIN, PGAN, PGAL, PGFR, PGRx, PGWx, PGST. */ -/* TYPE I PGBS, PGPG. */ -/* ADDRSS I PGPG. */ -/* STAT I PGST. */ -/* P I-O PGAN, PGAL, PGFR, PGRx, PGWx, PGBS, PGPG. */ -/* PAGEC I-O PGRC, PGWC. */ -/* PAGED I-O PGRD, PGWD. */ -/* PAGEI I-O PGRI, PGWI. */ -/* BASE O PGAN, PGAL, PGBS, PGPG. */ -/* VALUE O PGST. */ - -/* $ Detailed_Input */ - -/* See the entry points for descriptions of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for descriptions of their outputs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error */ -/* SPICE(BOGUSENTRY) will be signalled. */ - -/* See the entry points for discussions of errors particular to */ -/* those routines. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* The EK paging system provides a means for the rest of the EK */ -/* system to allocate and deallocate contiguous blocks of DAS */ -/* addresses of character, d.p. and integer type. The rest of the EK */ -/* system never accesses EK files directly; it only reads and writes */ -/* pages allocated via this system. */ - -/* Much of the page allocation and de-allocation performed by */ -/* higher-level routines is done via the routines ZZEKAPS and */ -/* ZZEKDPS; those routines should be called if applicable, rather */ -/* than ZZEKPGAL, ZZEKPGAN, or ZZEKPGFR. */ - -/* $ Examples */ - -/* Initialization: see EKOPN. */ -/* Page allocation: see EKAPS. */ -/* Writing: see ZZEKAD01, ZZEKAD02, ZZEKAD03. */ -/* Reading: see ZZEKRD01, ZZEKRD02, ZZEKRD03. */ -/* Freeing pages: see ZZEKDPS. */ -/* Address-to-page mapping: see EKDELR. */ -/* Page number-to-base mapping: see ZZEKAD0x */ - -/* $ Restrictions */ - -/* 1) Only `empty' DAS files may be initialized for paged access. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Note: the integer fill buffer should be as large as the maximum */ -/* of the integer page size and the metadata area size. */ - - -/* Saved variables */ - - /* Parameter adjustments */ - if (paged) { - } - if (pagei) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzekpgin; - case 2: goto L_zzekpgan; - case 3: goto L_zzekpgal; - case 4: goto L_zzekpgfr; - case 5: goto L_zzekpgrc; - case 6: goto L_zzekpgrd; - case 7: goto L_zzekpgri; - case 8: goto L_zzekpgwc; - case 9: goto L_zzekpgwd; - case 10: goto L_zzekpgwi; - case 11: goto L_zzekpgbs; - case 12: goto L_zzekpgpg; - case 13: goto L_zzekpgst; - } - - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - return 0; -/* $Procedure ZZEKPGIN ( Private: Initialize DAS for paged access ) */ - -L_zzekpgin: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Initialize an open DAS file for paged access. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I DAS file handle. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a DAS file open for write access. */ -/* The file must be empty: the last address of */ -/* each type (character, d.p. and integer) must be */ -/* zero. */ - -/* $ Detailed_Output */ - -/* None. This routine operates by side effects; see $Particulars */ -/* for a description of the effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the DAS file designated by HANDLE is not empty, the error */ -/* SPICE(DASNOTEMPTY) is signalled. */ - -/* 2) Any read or write errors detected during reading or writing */ -/* the DAS file will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine initializes a DAS file for paged access. */ -/* Initialization consists of: */ - -/* - Setting up the metadata area. This structure is defined in */ -/* the include file ekpage.inc. For each data type, there is */ -/* a free list pointer and an allocated page count. */ - -/* - Writing the architecture code to the file. This code is */ -/* defined in the include file ekarch.inc. */ - -/* $ Examples */ - -/* See EKOPN. */ - -/* $ Restrictions */ - -/* 1) Only `empty' DAS files may be initialized for paged access. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - chkin_("ZZEKPGIN", (ftnlen)8); - -/* The file must be open for write access. */ - - dassih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKPGIN", (ftnlen)8); - return 0; - } - -/* Find out which addresses are already in use. A file containing */ -/* data cannot be initialized. */ - - daslla_(handle, &lastc, &lastd, &lasti); - if (lastc > 0 || lastd > 0 || lasti > 0) { - dashlu_(handle, &unit); - setmsg_("File # contains data; LASTC = #; LASTD = #; LASTI = #.", ( - ftnlen)54); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &lastc, (ftnlen)1); - errint_("#", &lastd, (ftnlen)1); - errint_("#", &lasti, (ftnlen)1); - sigerr_("SPICE(DASNOTEMPTY)", (ftnlen)18); - chkout_("ZZEKPGIN", (ftnlen)8); - return 0; - } - -/* Initialize our fill buffers. */ - - fillc_(" ", &c__1, cfill, (ftnlen)1, (ftnlen)1024); - filld_(&c_b15, &c__128, dfill); - filli_(&c__0, &c__256, ifill); - -/* Initialize enough integer addresses to hold the metadata area. */ - - dasadi_(handle, &c__256, ifill); - -/* Set the architecture code. */ - - dasudi_(handle, &c__1, &c__1, &c__8); - -/* Set the page sizes and base addresses. */ - - dasudi_(handle, &c__2, &c__2, &c__1024); - dasudi_(handle, &c__7, &c__7, &c__128); - dasudi_(handle, &c__12, &c__12, &c__256); - dasudi_(handle, &c__3, &c__3, &c__0); - dasudi_(handle, &c__8, &c__8, &c__0); - dasudi_(handle, &c__13, &c__13, &c__256); - -/* Since the integer fill value is zero, and since zero is */ -/* interpreted as null pointer, all pointers are initialized. */ - - chkout_("ZZEKPGIN", (ftnlen)8); - return 0; -/* $Procedure ZZEKPGAN ( Private: EK, allocate new page ) */ - -L_zzekpgan: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Allocate a new page of a specified data type. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER TYPE */ -/* INTEGER P */ -/* INTEGER BASE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* TYPE I Data type of page to allocate. */ -/* P O Page number. */ -/* BASE O DAS base address of page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file must */ -/* be open for write access. */ - -/* TYPE is the data type of the page to allocate. The */ -/* type may be CHR, DP, or INT. Values of these */ -/* parameters are defined in ektype.inc. */ - -/* $ Detailed_Output */ - -/* P is the number of an allocated page. The returned */ -/* page is never taken from the free list; it is */ -/* the lowest-addressed page of the specifed type */ -/* that has never been allocated. */ - -/* BASE is the base DAS address of the page. This address */ -/* is the predecessor of the first DAS word of the */ -/* page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the DAS file designated by HANDLE is not open for paged */ -/* write access, the error will be diagnosed by routines called */ -/* by this routine. */ - -/* 2) Any read or write errors detected during reading or writing */ -/* the DAS file will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the requested data type is not recognized, the error */ -/* SPICE(INVALIDTYPE) is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* The pages returned by this routine lie on DAS record boundaries. */ -/* Successive requests for pages of the same data type will return */ -/* pages that are adjacent in the DAS address space of that type. */ -/* In fact, the main reason to call this routine rather than */ -/* ZZEKPGAL is to allocate adjacent pages. */ - -/* Use ZZEKPGAL for normal allocation. */ - -/* $ Examples */ - -/* See EKAPS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - chkin_("ZZEKPGAN", (ftnlen)8); - -/* Validate the file. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKPGAN", (ftnlen)8); - return 0; - } - if (*type__ == 1) { - -/* The new page follows the last character address. */ - - dasadc_(handle, &c__1024, &c__1, &c__1024, cfill, (ftnlen)1024); - -/* Update the character page count. */ - - dasrdi_(handle, &c__4, &c__4, &npc); - i__1 = npc + 1; - dasudi_(handle, &c__4, &c__4, &i__1); - -/* Set the page number and base address. */ - - *p = npc + 1; - *base = npc << 10; - } else if (*type__ == 2) { - dasadd_(handle, &c__128, dfill); - dasrdi_(handle, &c__9, &c__9, &npd); - i__1 = npd + 1; - dasudi_(handle, &c__9, &c__9, &i__1); - *p = npd + 1; - *base = npd << 7; - } else if (*type__ == 3) { - dasadi_(handle, &c__256, ifill); - dasrdi_(handle, &c__14, &c__14, &npi); - i__1 = npi + 1; - dasudi_(handle, &c__14, &c__14, &i__1); - *p = npi + 1; - *base = (npi << 8) + 256; - } else { - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKPGAN", (ftnlen)8); - return 0; - } - chkout_("ZZEKPGAN", (ftnlen)8); - return 0; -/* $Procedure ZZEKPGAL ( Private: EK, allocate page ) */ - -L_zzekpgal: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Allocate a page of a specified data type. The page need not */ -/* be new: free pages are returned if possible. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER TYPE */ -/* INTEGER P */ -/* INTEGER BASE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* TYPE I Data type of page to allocate. */ -/* P O Page number. */ -/* BASE O DAS base address of page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file must */ -/* be open for write access. */ - -/* TYPE is the data type of the page to allocate. The */ -/* type may be CHR, DP, or INT. Values of these */ -/* parameters are defined in ektype.inc. */ - -/* $ Detailed_Output */ - -/* P is the number of an allocated page. The returned */ -/* page is taken from the free list if the free list */ -/* is non-empty; otherwise, a new page is returned. */ - -/* BASE is the base DAS address of the page. This address */ -/* is the predecessor of the first DAS word of the */ -/* page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the DAS file designated by HANDLE is not open for paged */ -/* write access, the error will be diagnosed by routines called */ -/* by this routine. */ - -/* 2) Any read or write errors detected during reading or writing */ -/* the DAS file will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the requested data type is not recognized, the error */ -/* SPICE(INVALIDTYPE) is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine should be used for page allocation, except for */ -/* applications requiring allocation of contiguous pages. If */ -/* contiguous pages are required, use ZZEKPGAN. */ - -/* $ Examples */ - -/* See EKAPS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - chkin_("ZZEKPGAL", (ftnlen)8); - -/* Validate the file. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKPGAL", (ftnlen)8); - return 0; - } - if (*type__ == 1) { - -/* If the character free list is non-empty, take a page from */ -/* that list. */ - - dasrdi_(handle, &c__6, &c__6, &freec); - if (freec > 0) { - -/* We'll return the first free page. */ - - *p = freec; - -/* The new head of the list is the successor of FREEC, if */ -/* any. Obtain the forward pointer from the page. */ - - addr__ = (freec - 1 << 10) + 1; - i__1 = addr__ + 4; - dasrdc_(handle, &addr__, &i__1, &c__1, &c__5, encpag, (ftnlen)5); - prtdec_(encpag, &forwrd, (ftnlen)5); - freec = forwrd; - -/* Decrement the free page count, and write the free pointer */ -/* back to the file. */ - - dasrdi_(handle, &c__5, &c__5, &nfreec); - i__1 = nfreec - 1; - dasudi_(handle, &c__5, &c__5, &i__1); - dasudi_(handle, &c__6, &c__6, &freec); - -/* Set base address. */ - - *base = *p - 1 << 10; - } else { - -/* The new page follows the last character address. */ - - dasadc_(handle, &c__1024, &c__1, &c__1024, cfill, (ftnlen)1024); - -/* Update the character page count. */ - - dasrdi_(handle, &c__4, &c__4, &npc); - i__1 = npc + 1; - dasudi_(handle, &c__4, &c__4, &i__1); - -/* Set the page number and base address. */ - - *p = npc + 1; - *base = npc << 10; - } - } else if (*type__ == 2) { - -/* If the d.p. free list is non-empty, take a page from */ -/* that list. */ - - dasrdi_(handle, &c__11, &c__11, &freed); - if (freed > 0) { - -/* We'll return the first free page. */ - - *p = freed; - -/* The new head of the list is the successor of FREED, if */ -/* any. Obtain the forward pointer from the page. */ - - addr__ = (freed - 1 << 7) + 1; - dasrdd_(handle, &addr__, &addr__, &dpptr); - freed = i_dnnt(&dpptr); - -/* Decrement the free page count, and write the free pointer */ -/* back to the file. */ - - dasrdi_(handle, &c__10, &c__10, &nfreed); - i__1 = nfreed - 1; - dasudi_(handle, &c__10, &c__10, &i__1); - dasudi_(handle, &c__11, &c__11, &freed); - -/* Set base address. */ - - *base = *p - 1 << 7; - } else { - -/* The new page follows the last d.p. address. */ - - dasadd_(handle, &c__128, dfill); - -/* Update the d.p. page count. */ - - dasrdi_(handle, &c__9, &c__9, &npd); - i__1 = npd + 1; - dasudi_(handle, &c__9, &c__9, &i__1); - -/* Set the page number and base address. */ - - *p = npd + 1; - *base = npd << 7; - } - } else if (*type__ == 3) { - -/* If the integer free list is non-empty, take a page from */ -/* that list. */ - - dasrdi_(handle, &c__16, &c__16, &freei); - if (freei > 0) { - -/* We'll return the first free page. */ - - *p = freei; - -/* The new head of the list is the successor of FREEI, if */ -/* any. Obtain the forward pointer from the page. */ - - addr__ = (freei - 1 << 8) + 257; - dasrdi_(handle, &addr__, &addr__, &freei); - -/* Decrement the free page count, and write the free pointer */ -/* back to the file. */ - - dasrdi_(handle, &c__15, &c__15, &nfreei); - i__1 = nfreei - 1; - dasudi_(handle, &c__15, &c__15, &i__1); - dasudi_(handle, &c__16, &c__16, &freei); - -/* Set base address. */ - - *base = (*p - 1 << 8) + 256; - } else { - dasadi_(handle, &c__256, ifill); - dasrdi_(handle, &c__14, &c__14, &npi); - i__1 = npi + 1; - dasudi_(handle, &c__14, &c__14, &i__1); - *p = npi + 1; - *base = (npi << 8) + 256; - } - } else { - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKPGAL", (ftnlen)8); - return 0; - } - chkout_("ZZEKPGAL", (ftnlen)8); - return 0; -/* $Procedure ZZEKPGFR ( Private: EK, free page ) */ - -L_zzekpgfr: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Free a specified page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER TYPE */ -/* INTEGER P */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* TYPE I Data type of page to allocate. */ -/* P I Page number. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file must */ -/* be open for write access. */ - -/* TYPE is the data type of the page to allocate. The */ -/* type may be CHR, DP, or INT. Values of these */ -/* parameters are defined in ektype.inc. */ - -/* P is the number of an allocated page to be freed. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the DAS file designated by HANDLE is not open for paged */ -/* write access, the error will be diagnosed by routines called */ -/* by this routine. */ - -/* 2) Any read or write errors detected during reading or writing */ -/* the DAS file will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the requested data type is not recognized, the error */ -/* SPICE(INVALIDTYPE) is signalled. */ - -/* 4) If the number of the page to be freed is not that of an */ -/* allocated page of the specified type, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine should be used for page deallocation. The input */ -/* page is placed at the head of the free list of the specified */ -/* data type. */ - -/* $ Examples */ - -/* See EKDPS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - chkin_("ZZEKPGFR", (ftnlen)8); - -/* Check the file. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKPGFR", (ftnlen)8); - return 0; - } - if (*type__ == 1) { - -/* Validate the page number. Find out how many pages are */ -/* out there. */ - - dasrdi_(handle, &c__4, &c__4, &npc); - if (*p < 1 || *p > npc) { - setmsg_("Attempt to free non-existent CHR page. Page number = #;" - " valid range is 1:#", (ftnlen)74); - errint_("#", p, (ftnlen)1); - errint_("#", &npc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGFR", (ftnlen)8); - return 0; - } - -/* Get the current character free pointer and free page count. */ - - dasrdi_(handle, &c__6, &c__6, &freec); - dasrdi_(handle, &c__5, &c__5, &nfreec); - -/* Insert into the freed page a pointer to the head of the */ -/* free list. */ - - prtenc_(&freec, encpag, (ftnlen)5); - addr__ = (*p - 1 << 10) + 1; - i__1 = addr__ + 4; - dasudc_(handle, &addr__, &i__1, &c__1, &c__5, encpag, (ftnlen)5); - -/* Update the current character free pointer and free page count. */ - - dasudi_(handle, &c__6, &c__6, p); - i__1 = nfreec + 1; - dasudi_(handle, &c__5, &c__5, &i__1); - } else if (*type__ == 2) { - -/* Validate the page number. Find out how many pages are */ -/* out there. */ - - dasrdi_(handle, &c__9, &c__9, &npd); - if (*p < 1 || *p > npd) { - setmsg_("Attempt to free non-existent DP page. Page number = #; " - "valid range is 1:#", (ftnlen)73); - errint_("#", p, (ftnlen)1); - errint_("#", &npd, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGFR", (ftnlen)8); - return 0; - } - -/* Get the current d.p. free pointer and free page count. */ - - dasrdi_(handle, &c__11, &c__11, &freed); - dasrdi_(handle, &c__10, &c__10, &nfreed); - -/* Insert into the freed page a pointer to the head of the */ -/* free list. */ - - addr__ = (*p - 1 << 7) + 1; - d__1 = (doublereal) freed; - dasudd_(handle, &addr__, &addr__, &d__1); - -/* Update the current d.p. free pointer and free page count. */ - - dasudi_(handle, &c__11, &c__11, p); - i__1 = nfreed + 1; - dasudi_(handle, &c__10, &c__10, &i__1); - } else if (*type__ == 3) { - -/* Validate the page number. Find out how many pages are */ -/* out there. */ - - dasrdi_(handle, &c__14, &c__14, &npi); - if (*p < 1 || *p > npi) { - setmsg_("Attempt to free non-existent INT page. Page number = #;" - " valid range is 1:#", (ftnlen)74); - errint_("#", p, (ftnlen)1); - errint_("#", &npi, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGFR", (ftnlen)8); - return 0; - } - -/* Get the current integer free pointer and free page count. */ - - dasrdi_(handle, &c__16, &c__16, &freei); - dasrdi_(handle, &c__15, &c__15, &nfreei); - -/* Insert into the freed page a pointer to the head of the */ -/* free list. */ - - addr__ = (*p - 1 << 8) + 257; - dasudi_(handle, &addr__, &addr__, &freei); - -/* Update the current integer free pointer and free page count. */ - - dasudi_(handle, &c__16, &c__16, p); - i__1 = nfreei + 1; - dasudi_(handle, &c__15, &c__15, &i__1); - } else { - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKPGFR", (ftnlen)8); - return 0; - } - chkout_("ZZEKPGFR", (ftnlen)8); - return 0; -/* $Procedure ZZEKPGRC ( Private: EK, read character page ) */ - -L_zzekpgrc: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a specified character page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER P */ -/* CHARACTER*(*) PAGEC */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* P I Page number. */ -/* PAGEC O Character page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file may */ -/* be open for read or write access. */ - -/* P is the number of a character page to read. */ - -/* $ Detailed_Output */ - -/* PAGEC is a string containing the contents of the */ -/* specified page. PAGEC should be declared with */ -/* length at PGSIZC characters. This parameter is */ -/* declared in the include file ekpage.inc. */ - -/* If PAGEC has length less than PGSIZC characters, */ -/* the output will be truncated on the right. If */ -/* PAGEC is longer than PGSIZC characters, the output */ -/* will be padded with trailing blanks. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors detected during reading the DAS file will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the number of the page to read is not that of an */ -/* allocated character page, the error SPICE(INVALIDINDEX) is */ -/* signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine should be used to read character pages. */ - -/* $ Examples */ - -/* See ZZEKRD03. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Use discovery check-in. */ - - -/* Find out how many character pages are in use. */ - - dasrdi_(handle, &c__4, &c__4, &npc); - if (*p < 1 || *p > npc) { - chkin_("ZZEKPGRC", (ftnlen)8); - setmsg_("CHR page = #; valid range is [1:#]", (ftnlen)34); - errint_("#", p, (ftnlen)1); - errint_("#", &npc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGRC", (ftnlen)8); - return 0; - } - l = i_len(pagec, pagec_len); - e = min(l,1024); - addr__ = (*p - 1 << 10) + 1; - i__1 = addr__ + 1023; - dasrdc_(handle, &addr__, &i__1, &c__1, &e, pagec, pagec_len); - if (l > e) { - i__1 = e; - s_copy(pagec + i__1, " ", pagec_len - i__1, (ftnlen)1); - } - return 0; -/* $Procedure ZZEKPGRD ( Private: EK, read d.p. page ) */ - -L_zzekpgrd: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a specified double precision page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER P */ -/* DOUBLE PRECISION PAGED ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* P I Page number. */ -/* PAGED O Double precision page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file may */ -/* be open for read or write access. */ - -/* P is the number of a double precision page to read. */ - -/* $ Detailed_Output */ - -/* PAGED is a double precision array containing the contents */ -/* of the specified page. PAGED should be declared */ -/* with dimension PGSIZD. This parameter is */ -/* declared in the include file ekpage.inc. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors detected during reading the DAS file will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the number of the page to read is not that of an */ -/* allocated double precision page, the error SPICE(INVALIDINDEX) */ -/* is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine should be used to read double precision pages. */ - -/* $ Examples */ - -/* See ZZEKRD02. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Use discovery check-in. */ - - -/* Find out how many d.p. pages are in use. */ - - dasrdi_(handle, &c__9, &c__9, &npd); - if (*p < 1 || *p > npd) { - chkin_("ZZEKPGRD", (ftnlen)8); - setmsg_("DP page = #; valid range is [1:#]", (ftnlen)33); - errint_("#", p, (ftnlen)1); - errint_("#", &npd, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGRD", (ftnlen)8); - return 0; - } - addr__ = (*p - 1 << 7) + 1; - i__1 = addr__ + 127; - dasrdd_(handle, &addr__, &i__1, paged); - return 0; -/* $Procedure ZZEKPGRI ( Private: EK, read integer page ) */ - -L_zzekpgri: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a specified integer page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER P */ -/* INTEGER PAGEI ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* P I Page number. */ -/* PAGEI O Integer page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file may */ -/* be open for read or write access. */ - -/* P is the number of an integer page to read. */ - -/* $ Detailed_Output */ - -/* PAGEI is an integer array containing the contents */ -/* of the specified page. PAGEI should be declared */ -/* with dimension PGSIZI. This parameter is */ -/* declared in the include file ekpage.inc. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors detected during reading the DAS file will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the number of the page to read is not that of an */ -/* allocated double precision page, the error SPICE(INVALIDINDEX) */ -/* is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine should be used to read integer pages. */ - -/* $ Examples */ - -/* See ZZEKRD01. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Use discovery check-in. */ - - -/* Find out how many integer pages are in use. */ - - dasrdi_(handle, &c__14, &c__14, &npi); - if (*p < 1 || *p > npi) { - chkin_("ZZEKPGRI", (ftnlen)8); - setmsg_("INT page = #; valid range is [1:#]", (ftnlen)34); - errint_("#", p, (ftnlen)1); - errint_("#", &npi, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGRI", (ftnlen)8); - return 0; - } - addr__ = (*p - 1 << 8) + 257; - i__1 = addr__ + 255; - dasrdi_(handle, &addr__, &i__1, pagei); - return 0; -/* $Procedure ZZEKPGWC ( Private: EK, write character page ) */ - -L_zzekpgwc: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Write a specified character page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER P */ -/* CHARACTER*(*) PAGEC */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* P I Page number. */ -/* PAGEC I Character page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file must */ -/* be open for write access. */ - -/* P is the number of an allocated character page to */ -/* write. */ - -/* PAGEC is a string to be written to the specified page. */ -/* PAGEC must be declared with length at PGSIZC */ -/* characters. This parameter is declared in the */ -/* include file ekpage.inc. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors detected during reading or writing the DAS file */ -/* will be diagnosed by routines called by this routine. */ - -/* 2) If the number of the page to write is not that of an */ -/* allocated character page, the error SPICE(INVALIDINDEX) is */ -/* signalled. */ - -/* 3) If the input string has length less than PGSIZC characters, */ -/* the error SPICE(STRINGTOOSHORT) is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine writes the input string to the DAS address range */ -/* corresponding to the specified page. The file must be closed */ -/* properly (via EKCLS) in order to make the change permanent. */ - -/* $ Examples */ - -/* See ZZEKAD03. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Use discovery check-in. */ - -/* Validate the file. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Find out how many character pages are in use. */ - - dasrdi_(handle, &c__4, &c__4, &npc); - if (*p < 1 || *p > npc) { - chkin_("ZZEKPGWC", (ftnlen)8); - setmsg_("CHR page = #; valid range is [1:#]", (ftnlen)34); - errint_("#", p, (ftnlen)1); - errint_("#", &npc, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGWC", (ftnlen)8); - return 0; - } - l = i_len(pagec, pagec_len); - if (l < 1024) { - chkin_("ZZEKPGWC", (ftnlen)8); - setmsg_("Input CHR page size = #; valid size is [#:]", (ftnlen)43); - errint_("#", &l, (ftnlen)1); - errint_("#", &c__1024, (ftnlen)1); - sigerr_("SPICE(STRINGTOOSHORT)", (ftnlen)21); - chkout_("ZZEKPGWC", (ftnlen)8); - return 0; - } - addr__ = (*p - 1 << 10) + 1; - i__1 = addr__ + 1023; - dasudc_(handle, &addr__, &i__1, &c__1, &c__1024, pagec, pagec_len); - return 0; -/* $Procedure ZZEKPGWD ( Private: EK, write d.p. page ) */ - -L_zzekpgwd: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Write a specified double precision page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER P */ -/* DOUBLE PRECISION PAGED ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* P I Page number. */ -/* PAGED I Double precision page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file must */ -/* be open for write access. */ - -/* P is the number of an allocated double precision */ -/* page to write. */ - -/* PAGED is a double precision array to be written to */ -/* the specified page. PAGED must be declared with */ -/* dimension at PGSIZD. This parameter is */ -/* declared in the include file ekpage.inc. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors detected during reading or writing the DAS file */ -/* will be diagnosed by routines called by this routine. */ - -/* 2) If the number of the page to write is not that of an */ -/* allocated d.p. page, the error SPICE(INVALIDINDEX) is */ -/* signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine writes the input array to the DAS address range */ -/* corresponding to the specified page. The file must be closed */ -/* properly (via EKCLS) in order to make the change permanent. */ - -/* $ Examples */ - -/* See ZZEKAD02. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Use discovery check-in. */ - - -/* Validate the file. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Find out how many d.p. pages are in use. */ - - dasrdi_(handle, &c__9, &c__9, &npd); - if (*p < 1 || *p > npd) { - chkin_("ZZEKPGWD", (ftnlen)8); - setmsg_("DP page = #; valid range is [1:#]", (ftnlen)33); - errint_("#", p, (ftnlen)1); - errint_("#", &npd, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGWD", (ftnlen)8); - return 0; - } - addr__ = (*p - 1 << 7) + 1; - i__1 = addr__ + 127; - dasudd_(handle, &addr__, &i__1, paged); - return 0; -/* $Procedure ZZEKPGWI ( Private: EK, write integer page ) */ - -L_zzekpgwi: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Write a specified integer page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* INTEGER P */ -/* INTEGER PAGEI ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* P I Page number. */ -/* PAGEI I Integer page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file must */ -/* be open for write access. */ - -/* P is the number of an allocated integer */ -/* page to write. */ - -/* PAGEI is an integer array to be written to */ -/* the specified page. PAGEI must be declared with */ -/* dimension at PGSIZI. This parameter is */ -/* declared in the include file ekpage.inc. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Any errors detected during reading or writing the DAS file */ -/* will be diagnosed by routines called by this routine. */ - -/* 2) If the number of the page to write is not that of an */ -/* allocated integer page, the error SPICE(INVALIDINDEX) is */ -/* signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine writes the input array to the DAS address range */ -/* corresponding to the specified page. The file must be closed */ -/* properly (via EKCLS) in order to make the change permanent. */ - -/* $ Examples */ - -/* See ZZEKAD01. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Use discovery check-in. */ - -/* Validate the file. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Find out how many integer pages are in use. */ - - dasrdi_(handle, &c__14, &c__14, &npi); - if (*p < 1 || *p > npi) { - chkin_("ZZEKPGWI", (ftnlen)8); - setmsg_("INT page = #; valid range is [1:#]", (ftnlen)34); - errint_("#", p, (ftnlen)1); - errint_("#", &npi, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKPGWI", (ftnlen)8); - return 0; - } - addr__ = (*p - 1 << 8) + 257; - i__1 = addr__ + 255; - dasudi_(handle, &addr__, &i__1, pagei); - return 0; -/* $Procedure ZZEKPGBS ( Private: EK, map page to base address ) */ - -L_zzekpgbs: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Map a page to its base address. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER TYPE */ -/* INTEGER P */ -/* INTEGER BASE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TYPE I Data type of page. */ -/* P I Page number. */ -/* BASE O DAS base address of page. */ - -/* $ Detailed_Input */ - -/* TYPE is the data type of the page whose base address */ -/* is requested. The type may be CHR, DP, or INT. */ -/* Values of these parameters are defined in */ -/* ektype.inc. */ - -/* P is the number of the page of interest. */ - -/* $ Detailed_Output */ - -/* BASE is the base DAS address of the page. This address */ -/* is the predecessor of the first DAS word of the */ -/* page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the requested data type is not recognized, the error */ -/* SPICE(INVALIDTYPE) is signalled. */ - -/* 2) Range checking is not performed on the input page number P. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine provides tranlation from page numbers to DAS */ -/* addresses. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - if (*type__ == 1) { - *base = *p - 1 << 10; - } else if (*type__ == 2) { - *base = *p - 1 << 7; - } else if (*type__ == 3) { - *base = (*p - 1 << 8) + 256; - } else { - chkin_("ZZEKPGBS", (ftnlen)8); - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKPGBS", (ftnlen)8); - return 0; - } - return 0; -/* $Procedure ZZEKPGPG ( Private: EK, map address to page ) */ - -L_zzekpgpg: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Map a DAS address to the number of the page containing it. Also */ -/* return the base address of the page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER TYPE */ -/* INTEGER ADDRSS */ -/* INTEGER P */ -/* INTEGER BASE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TYPE I Data type of address. */ -/* ADDRSS I DAS address to be mapped. */ -/* P O Page number. */ -/* BASE O DAS base address of page. */ - -/* $ Detailed_Input */ - -/* TYPE is the data type of a DAS address to be mapped to */ -/* a page number. The type may be CHR, DP, or INT. */ -/* Values of these parameters are defined in */ -/* ektype.inc. */ - -/* ADDRSS is a DAS address to be mapped to a page number. */ - -/* $ Detailed_Output */ - -/* P is the number of the page containing the input */ -/* address. */ - -/* BASE is the base DAS address of the page. This address */ -/* is the predecessor of the first DAS word of the */ -/* page. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the requested data type is not recognized, the error */ -/* SPICE(INVALIDTYPE) is signalled. */ - -/* 2) Range checking is not performed on the input address. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine provides tranlation from DAS addresses to page */ -/* numbers. */ - -/* $ Examples */ - -/* See ZZEKAD01. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - if (*type__ == 1) { - *p = (*addrss + 1023) / 1024; - *base = *p - 1 << 10; - } else if (*type__ == 2) { - *p = (*addrss + 127) / 128; - *base = *p - 1 << 7; - } else if (*type__ == 3) { - *p = (*addrss - 1) / 256; - *base = (*p - 1 << 8) + 256; - } else { - chkin_("ZZEKPGBS", (ftnlen)8); - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", type__, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKPGBS", (ftnlen)8); - return 0; - } - return 0; -/* $Procedure ZZEKPGST ( Private: EK, return paging statistics ) */ - -L_zzekpgst: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return paging statistics. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ - -/* INTEGER HANDLE */ -/* CHARACTER*(*) STAT */ -/* INTEGER VALUE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Paged EK file handle. */ -/* STAT I Name of requested statistic. */ -/* VALUE O Value of requested statistic. */ - -/* $ Detailed_Input */ - -/* HANDLE is a handle of a paged EK file. The file may */ -/* be open for read or write access. */ - -/* STAT is the name of the requested statistic. Possible */ -/* values and meanings of STAT are: */ - -/* 'N_C_ALLOC' Number of character pages */ -/* allocated. Pages on the free */ -/* list are not included. */ - -/* 'N_D_ALLOC' Number of d.p. pages allocated. */ - -/* 'N_I_ALLOC' Number of integer pages */ -/* allocated. */ - -/* 'N_C_FREE' Number of pages in character free */ -/* list. */ - -/* 'N_D_FREE' Number of pages in d.p. free */ -/* list. */ - -/* 'N_I_FREE' Number of pages in integer free */ -/* list. */ - -/* $ Detailed_Output */ - -/* VALUE is the value of the requested statistic. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the requested statistic is not recognized, the error */ -/* SPICE(INVALIDOPTION) is signalled. */ - -/* $ Files */ - -/* This suite of routines provides paged access to DAS files. Only */ -/* DAS files initialized via a call to ZZEKPGIN may be written or */ -/* read by these routines. */ - -/* $ Particulars */ - -/* This routine provides tranlation from DAS addresses to page */ -/* numbers. */ - -/* $ Examples */ - -/* 1) Find the number of pages on the integer free list of the */ -/* paged EK designated by HANDLE: */ - -/* CALL ZZEKPGST ( HANDLE, 'N_I_FREE', NFREE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - chkin_("ZZEKPGST", (ftnlen)8); - if (eqstr_(stat, "N_C_ALLOC", stat_len, (ftnlen)9)) { - dasrdi_(handle, &c__4, &c__4, value); - } else if (eqstr_(stat, "N_D_ALLOC", stat_len, (ftnlen)9)) { - dasrdi_(handle, &c__9, &c__9, value); - } else if (eqstr_(stat, "N_I_ALLOC", stat_len, (ftnlen)9)) { - dasrdi_(handle, &c__14, &c__14, value); - } else if (eqstr_(stat, "N_C_FREE", stat_len, (ftnlen)8)) { - dasrdi_(handle, &c__5, &c__5, value); - } else if (eqstr_(stat, "N_D_FREE", stat_len, (ftnlen)8)) { - dasrdi_(handle, &c__10, &c__10, value); - } else if (eqstr_(stat, "N_I_FREE", stat_len, (ftnlen)8)) { - dasrdi_(handle, &c__15, &c__15, value); - } else { - setmsg_("Statistic # is not supported.", (ftnlen)29); - errch_("#", stat, (ftnlen)1, stat_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZEKPGST", (ftnlen)8); - return 0; - } - chkout_("ZZEKPGST", (ftnlen)8); - return 0; -} /* zzekpage_ */ - -/* Subroutine */ int zzekpage_(integer *handle, integer *type__, integer * - addrss, char *stat, integer *p, char *pagec, doublereal *paged, - integer *pagei, integer *base, integer *value, ftnlen stat_len, - ftnlen pagec_len) -{ - return zzekpage_0_(0, handle, type__, addrss, stat, p, pagec, paged, - pagei, base, value, stat_len, pagec_len); - } - -/* Subroutine */ int zzekpgin_(integer *handle) -{ - return zzekpage_0_(1, handle, (integer *)0, (integer *)0, (char *)0, ( - integer *)0, (char *)0, (doublereal *)0, (integer *)0, (integer *) - 0, (integer *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgan_(integer *handle, integer *type__, integer *p, - integer *base) -{ - return zzekpage_0_(2, handle, type__, (integer *)0, (char *)0, p, (char *) - 0, (doublereal *)0, (integer *)0, base, (integer *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int zzekpgal_(integer *handle, integer *type__, integer *p, - integer *base) -{ - return zzekpage_0_(3, handle, type__, (integer *)0, (char *)0, p, (char *) - 0, (doublereal *)0, (integer *)0, base, (integer *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int zzekpgfr_(integer *handle, integer *type__, integer *p) -{ - return zzekpage_0_(4, handle, type__, (integer *)0, (char *)0, p, (char *) - 0, (doublereal *)0, (integer *)0, (integer *)0, (integer *)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgrc_(integer *handle, integer *p, char *pagec, - ftnlen pagec_len) -{ - return zzekpage_0_(5, handle, (integer *)0, (integer *)0, (char *)0, p, - pagec, (doublereal *)0, (integer *)0, (integer *)0, (integer *)0, - (ftnint)0, pagec_len); - } - -/* Subroutine */ int zzekpgrd_(integer *handle, integer *p, doublereal *paged) -{ - return zzekpage_0_(6, handle, (integer *)0, (integer *)0, (char *)0, p, ( - char *)0, paged, (integer *)0, (integer *)0, (integer *)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgri_(integer *handle, integer *p, integer *pagei) -{ - return zzekpage_0_(7, handle, (integer *)0, (integer *)0, (char *)0, p, ( - char *)0, (doublereal *)0, pagei, (integer *)0, (integer *)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgwc_(integer *handle, integer *p, char *pagec, - ftnlen pagec_len) -{ - return zzekpage_0_(8, handle, (integer *)0, (integer *)0, (char *)0, p, - pagec, (doublereal *)0, (integer *)0, (integer *)0, (integer *)0, - (ftnint)0, pagec_len); - } - -/* Subroutine */ int zzekpgwd_(integer *handle, integer *p, doublereal *paged) -{ - return zzekpage_0_(9, handle, (integer *)0, (integer *)0, (char *)0, p, ( - char *)0, paged, (integer *)0, (integer *)0, (integer *)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgwi_(integer *handle, integer *p, integer *pagei) -{ - return zzekpage_0_(10, handle, (integer *)0, (integer *)0, (char *)0, p, ( - char *)0, (doublereal *)0, pagei, (integer *)0, (integer *)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgbs_(integer *type__, integer *p, integer *base) -{ - return zzekpage_0_(11, (integer *)0, type__, (integer *)0, (char *)0, p, ( - char *)0, (doublereal *)0, (integer *)0, base, (integer *)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzekpgpg_(integer *type__, integer *addrss, integer *p, - integer *base) -{ - return zzekpage_0_(12, (integer *)0, type__, addrss, (char *)0, p, (char * - )0, (doublereal *)0, (integer *)0, base, (integer *)0, (ftnint)0, - (ftnint)0); - } - -/* Subroutine */ int zzekpgst_(integer *handle, char *stat, integer *value, - ftnlen stat_len) -{ - return zzekpage_0_(13, handle, (integer *)0, (integer *)0, stat, (integer - *)0, (char *)0, (doublereal *)0, (integer *)0, (integer *)0, - value, stat_len, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzekpars.c b/ext/spice/src/cspice/zzekpars.c deleted file mode 100644 index 4d9d9842f6..0000000000 --- a/ext/spice/src/cspice/zzekpars.c +++ /dev/null @@ -1,2153 +0,0 @@ -/* zzekpars.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__27869 = 27869; -static integer c__100 = 100; -static integer c__1 = 1; -static integer c__11 = 11; -static integer c__6 = 6; -static integer c__27 = 27; -static integer c__29 = 29; -static integer c__26 = 26; -static integer c__0 = 0; -static integer c__10 = 10; -static integer c__50 = 50; - -/* $Procedure ZZEKPARS ( EK, parse tokenized EK query ) */ -/* Subroutine */ int zzekpars_(char *query, integer *ntoken, integer *lxbegs, - integer *lxends, integer *tokens, integer *values, doublereal *numvls, - char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char - *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen - query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - integer nsel; - extern /* Subroutine */ int zzekinqc_(char *, integer *, integer *, - integer *, integer *, char *, integer *, ftnlen, ftnlen), - zzekqini_(integer *, integer *, integer *, char *, doublereal *, - ftnlen), zzektloc_(integer *, integer *, integer *, integer *, - integer *, integer *, logical *), zzekweqi_(char *, integer *, - integer *, ftnlen), zzeknrml_(char *, integer *, integer *, - integer *, integer *, integer *, doublereal *, char *, integer *, - integer *, integer *, char *, doublereal *, logical *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - integer b, e, i__, j, l; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *, - char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - integer ntabs; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - integer state, token; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - extern logical failed_(void); - integer tabdsc[6]; - extern logical return_(void); - char errtyp[32], expkey[32]; - integer alsdsc[6], coldsc[6], lxb, lxe, namdsc[6], ncnstr, norder, toknum, - valdsc[6]; - logical fnd; - extern /* Subroutine */ int chkout_(char *, ftnlen), appndi_(integer *, - integer *), cleari_(integer *, integer *); - -/* $ Abstract */ - -/* Parse an EK query that has been scanned and tokenized. */ -/* Represent the result as an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PARSE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Token Code Parameters */ - -/* ektokn.inc Version 2 25-JAN-1995 (NJB) */ - -/* Updated to distinguish between special characters. */ - - -/* ektokn.inc Version 1 05-DEC-1994 (NJB) */ - - -/* The EK query language tokens and codes are: */ - -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ - - - -/* End Include Section: EK Token Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Keyword Code Parameters */ - -/* ekkeyw.inc Version 4 24-JAN-1995 (NJB) */ - - - -/* The EK query language keywords and codes are: */ - -/* ALL */ -/* AND */ -/* ASC */ -/* AVG */ -/* BETWEEN */ -/* BY */ -/* COUNT */ -/* DESC */ -/* DISTINCT */ -/* EQ */ -/* FROM */ -/* GE */ -/* GROUP */ -/* GT */ -/* HAVING */ -/* IS */ -/* LE */ -/* LT */ -/* LIKE */ -/* MAX */ -/* MIN */ -/* NE */ -/* NOT */ -/* NULL */ -/* OR */ -/* ORDER */ -/* SELECT */ -/* SUM */ -/* WHERE */ - - -/* End Include Section: EK Keyword Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I Query in string form. */ -/* NTOKEN I Number of tokens in query. */ -/* LXBEGS, */ -/* LXENDS I Lexeme begin and end positions in QUERY. */ -/* TOKENS I Token codes. */ -/* VALUES I Values associated with tokens. */ -/* NUMVLS I Buffer containing numeric token values. */ -/* CHRBUF I Buffer containing string token values. */ -/* CHBEGS, */ -/* CHENDS I String token begin and end character positions. */ -/* EQRYI, */ -/* EQRYC, */ -/* EQRYD O Parsed query and string and number value buffers. */ -/* ERROR O Flag indicating whether query parsed correctly. */ -/* PRSERR O Parse error description. */ - -/* $ Detailed_Input */ - -/* QUERY is a string containing the original input query. */ -/* QUERY is used only for creating error messages. */ - -/* NTOKEN is the number of tokens in the input query. */ - -/* LXBEGS, */ -/* LXENDS are lexeme begin and end pointers; the Ith */ -/* lexeme in the query is */ - -/* QUERY ( LXBEGS(I) : LXENDS(I) ) */ - -/* (Lexemes are strings that correspond to tokens */ -/* in the language.) */ - -/* TOKENS is an array of token codes. The Ith element of */ -/* TOKENS represents the Ith token in the scanned */ -/* query. */ - -/* VALUES is an array of values associated with tokens; the */ -/* Ith element of VALUES corresponds to the Ith */ -/* token. Keywords, for example, are distinguished */ -/* by codes in the VALUES array. Literal numeric */ -/* and string tokens use the VALUES array to point */ -/* to elements of NUMVLS or CHBEGS and CHENDS, */ -/* respectively. Some tokens don't need to use */ -/* VALUES, but to simplify indexing, each token gets */ -/* an element of this array. */ - -/* NUMVLS is an array of double precision numbers used to */ -/* store the values corresponding to literal numeric */ -/* tokens. */ - -/* CHRBUF is a string used to store the values of literal */ -/* string tokens. */ - -/* CHBEGS, */ -/* CHENDS are pairs of begin and end pointers into CHRBUF. */ -/* These pointers delimit character values */ -/* associated with literal string tokens. */ - - -/* $ Detailed_Output */ - -/* EQRYI, */ -/* EQRYC, */ -/* EQRYD are the integer, character, and numeric portions */ -/* of an encoded form of the input query. The */ -/* SELECT, FROM, WHERE, and ORDER BY clauses of the */ -/* input query are all represented in this encoding. */ -/* WHERE clause constraints have been normalized. */ - -/* Normalized queries have their constraints grouped */ -/* into a disjunction of conjunctions of relational */ -/* expressions, as symbolized below: */ - -/* ( and and ... ) */ -/* or ( and and ... ) */ -/* . */ -/* . */ -/* . */ -/* or ( and and ... ) */ - -/* ERROR, */ -/* PRSERR are, respectively, a flag indicating whether the */ -/* input query parsed correctly, and a message */ -/* describing the parse error, if one occurred. If */ -/* no error occurred, ERROR is .FALSE. and PRSERR */ -/* is blank. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Most of the exceptions that can occur on a call to */ -/* ZZEKPARS are caused by errors in the input query. ZZEKPARS */ -/* attempts to diagnose these via the output error flag and */ -/* error message, instead of signalling errors. The */ -/* error messages that ZZEKPARS can return are listed below. */ -/* In the messages shown, the symbol # is used to designate */ -/* a marker for which a value can be substituted in an actual */ -/* message. */ - - -/* The BY keyword was not found following the */ -/* ORDER keyword. */ - -/* Invalid keyword at location #. */ -/* Actual token was: # */ - -/* Table or column name expected at location */ -/* #. Actual token was: # */ - -/* Table name expected at location #. */ -/* Actual token was: # */ - -/* Column name expected at location #. */ -/* Actual token was: # */ - -/* Table alias, comma, or keyword expected at */ -/* location #. Actual token was: # */ - -/* Comma or keyword expected at */ -/* location #. Actual token was: # */ - -/* Comma expected at location #. Actual token was: # */ - -/* PRSERR = More tokens were expected in query. */ - -/* The keyword # was expected at location */ -/* #. Actual token was: # */ - -/* Invalid token at location #. Token was: # */ - -/* PRSERR = Number of tables in "FROM" clause exceeds */ -/* allowed maximum of #. */ - -/* PRSERR = Number of order-by columns exceeds allowed */ -/* maximum of #. */ - -/* PRSERR = Number of SELECT columns exceeds allowed */ -/* maximum of #. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether a query is syntactically correct; */ -/* it tranforms correct queries into the EK system's encoded query */ -/* representation. */ - -/* The encoded queries output by this routine are not ready for */ -/* execution; they still must undergo name resolution, time value */ -/* conversion, and semantic checking. See EKFIND for an example of */ -/* the normal sequence of query processing. */ - -/* $ Examples */ - -/* See the header of EKFIND for examples of valid and invalid */ -/* queries. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.1.0, 15-OCT-1996 (NJB) */ - -/* Bug fix: default order sense was not encoded when ORDER-BY */ -/* clause was not the last clause of the query. */ - -/* - SPICELIB Version 4.0.0, 17-NOV-1995 (NJB) */ - -/* Complete re-write for architecture 3. */ - -/* -& */ -/* $ Index_Entries */ - -/* parse EK query */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 4.1.0, 15-OCT-1996 (NJB) */ - -/* Bug fix: default order sense was not encoded when ORDER-BY */ -/* clause was not the last clause of the query. The old algorithm */ -/* assumed that no clauses followed the ORDER-BY clause, which */ -/* at one time was a limitation of the EK query language. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* State parameters */ - - -/* Other local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKPARS", (ftnlen)8); - } - -/* Initialize the encoded query each time, for safety. */ - - zzekqini_(&c__27869, &c__100, eqryi, eqryc, eqryd, eqryc_len); - if (failed_()) { - *error = TRUE_; - s_copy(prserr, "SPICE(BUG): encoded query init failed.", prserr_len, - (ftnlen)39); - chkout_("ZZEKPARS", (ftnlen)8); - return 0; - } - -/* The structure of a query is */ - -/* => => SELECT => */ -/* |
. */ -/* | */ - -/* =>
*/ - -/*
=>
*/ -/* |
,
*/ - -/*
=>
*/ -/* |
*/ - -/* => WHERE */ -/* | */ - -/* => ORDER BY */ -/* | */ - -/* => */ -/* | , */ -/* */ - -/* => */ - -/* => ASC */ -/* | DESC */ -/* | */ - - - -/* We'll parse the clauses of the query in the following order: */ - -/* FROM */ -/* WHERE (if present) */ -/* ORDER BY (if present) */ -/* SELECT */ - - - zzektloc_(&c__1, &c__11, ntoken, tokens, values, &toknum, &fnd); - if (! fnd) { - *error = TRUE_; - s_copy(errtyp, "FROM_NOT_FOUND", (ftnlen)32, (ftnlen)14); - state = 16; - } else { - state = 0; - ntabs = 0; - nsel = 0; - ncnstr = 0; - norder = 0; - *error = FALSE_; - s_copy(prserr, " ", prserr_len, (ftnlen)1); - s_copy(errtyp, " ", (ftnlen)32, (ftnlen)1); - } - while(state != 16) { - -/* Advance to the next token, if there is one. */ - - ++toknum; - if (toknum > *ntoken) { - -/* We're out of tokens. Set the token value to indicate */ -/* `end of query'. */ - - token = 11; - } else { - token = tokens[toknum - 1]; - } - -/* Perform semantic actions based on the state and current token. */ - - if (state == 0) { - -/* We expect to see an identifier representing a table name. */ -/* No other tokens are allowed. */ - - if (token == 2) { - -/* We've found a table name (as far as we can tell at */ -/* this point). Make sure we haven't exceeded the limit */ -/* for table names; if not, add the appropriate information */ -/* to the encoded query. */ - - ++ntabs; - if (ntabs > 10) { - *error = TRUE_; - s_copy(errtyp, "TOO_MANY_TABLES", (ftnlen)32, (ftnlen)15); - state = 16; - } else { - i__ = values[toknum - 1]; - b = chbegs[i__ - 1]; - e = chends[i__ - 1]; - l = e - b + 1; - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - zzekinqc_(chrbuf + (b - 1), &l, &lxb, &lxe, eqryi, eqryc, - tabdsc, e - (b - 1), eqryc_len); - -/* Append the table descriptor to the integer part of the */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&tabdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? - i__1 : s_rnge("tabdsc", i__1, "zzekpars_", ( - ftnlen)554)], eqryi); - } - -/* Add a place-holder value descriptor to reserve */ -/* space for an alias descriptor for this table. If an */ -/* actual alias is supplied, we'll update this */ -/* descriptor. */ - - cleari_(&c__6, alsdsc); - alsdsc[0] = 1; - for (j = 1; j <= 6; ++j) { - appndi_(&alsdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? - i__1 : s_rnge("alsdsc", i__1, "zzekpars_", ( - ftnlen)567)], eqryi); - } - -/* Update the table count in the encoded query. */ - - zzekweqi_("NUM_TABLES", &ntabs, eqryi, (ftnlen)10); - state = 1; - } - } else if (token == 11) { - *error = TRUE_; - s_copy(errtyp, "MORE_TOKENS_EXP", (ftnlen)32, (ftnlen)15); - state = 16; - } else { - -/* We've got the wrong kind of token here. */ - - *error = TRUE_; - s_copy(errtyp, "TABLE_EXP", (ftnlen)32, (ftnlen)9); - state = 16; - } - -/* State is a member of {FRMTAB, TERM}. */ - - } else if (state == 1) { - -/* We should see a comma, an alias, one of the SELECT, */ -/* WHERE or ORDER keywords, or the end of the query. */ - - if (token == 11) { - -/* We're out of tokens. It's time to parse the */ -/* WHERE clause. */ - - state = 4; - } else if (token == 8) { - -/* It's time to look for another table name. */ - - state = 0; - } else if (token == 2) { - -/* We've got an alias. Add this string to the encoded */ -/* query. */ - - i__ = values[toknum - 1]; - b = chbegs[i__ - 1]; - e = chends[i__ - 1]; - l = e - b + 1; - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - zzekinqc_(chrbuf + (b - 1), &l, &lxb, &lxe, eqryi, eqryc, - alsdsc, e - (b - 1), eqryc_len); - -/* Update the place-holder alias descriptor in the integer */ -/* part of the query. */ - - movei_(alsdsc, &c__6, &eqryi[cardi_(eqryi)]); - state = 3; - } else if (token == 1) { - -/* The last table name in the FROM clause is followed by */ -/* a keyword. SELECT, WHERE and ORDER are the only valid */ -/* possibilities. */ - - if (values[toknum - 1] != 29 && values[toknum - 1] != 27 && - values[toknum - 1] != 26) { - -/* We've got a keyword we don't want here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } else { - -/* Parse the WHERE clause. */ - - state = 4; - } - } else { - -/* We've got the wrong kind of token altogether. */ - - *error = TRUE_; - s_copy(errtyp, "ALIAS_EXP", (ftnlen)32, (ftnlen)9); - state = 16; - } - -/* STATE is a member of {FROM, FRMALS, WHERE, TERM}. */ - - } else if (state == 3) { - -/* We should see a comma, the SELECT, WHERE or ORDER */ -/* keywords, or the end of the query. */ - - if (token == 11) { - -/* We're out of tokens. It's time to parse the */ -/* WHERE clause. */ - - state = 4; - } else if (token == 8) { - -/* It's time to look for another table name. */ - - state = 0; - } else if (token == 1) { - -/* The last table name in the FROM clause is followed by */ -/* a keyword. SELECT, WHERE and ORDER are the only valid */ -/* possibilities. */ - - if (values[toknum - 1] != 29 && values[toknum - 1] != 27 && - values[toknum - 1] != 26) { - -/* We've got a keyword we don't want here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } else { - -/* Parse the WHERE clause. */ - - state = 4; - } - } else { - -/* We've got the wrong kind of token altogether. */ - - *error = TRUE_; - s_copy(errtyp, "COMMA_OR_KEY_EXP", (ftnlen)32, (ftnlen)16); - state = 16; - } - -/* STATE is a member of {FROM, WHERE, TERM}. */ - - } else if (state == 11) { - -/* It's time to parse the SELECT clause. We'll need to */ -/* locate the SELECT keyword. */ - - zzektloc_(&c__1, &c__27, ntoken, tokens, values, &toknum, &fnd); - if (! fnd) { - *error = TRUE_; - s_copy(errtyp, "SELECT_NOT_FOUND", (ftnlen)32, (ftnlen)16); - state = 16; - } else { - state = 12; - } - } else if (state == 12) { - -/* We must see either the * token, the ALL keyword, */ -/* or an identifier here. The identifier may be a lone */ -/* column name, or it may be a column name qualified by a */ -/* table name or alias. */ - -/* For the moment, we don't support the * or ALL options. */ - - if (token == 2) { - -/* We've found a name (as far as we can tell at this point). */ -/* Make sure we haven't exceeded the limit for SELECT */ -/* column names; if not, store the name string in the */ -/* encoded query, and save the descriptor until we've */ -/* figured out whether we're looking at a column name or */ -/* table name. */ - - ++nsel; - if (nsel > 50) { - *error = TRUE_; - s_copy(errtyp, "TOO_MANY_SEL_COLS", (ftnlen)32, (ftnlen) - 17); - state = 16; - } else { - i__ = values[toknum - 1]; - b = chbegs[i__ - 1]; - e = chends[i__ - 1]; - l = e - b + 1; - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - zzekinqc_(chrbuf + (b - 1), &l, &lxb, &lxe, eqryi, eqryc, - namdsc, e - (b - 1), eqryc_len); - -/* Add a place-holder value descriptor to reserve */ -/* space for a table descriptor for this name. If it */ -/* turns out that the current name is a table name, we'll */ -/* update this descriptor. */ - - cleari_(&c__6, valdsc); - valdsc[0] = 1; - for (j = 1; j <= 6; ++j) { - appndi_(&valdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? - i__1 : s_rnge("valdsc", i__1, "zzekpars_", ( - ftnlen)828)], eqryi); - } - -/* Update the SELECT column count in the encoded query. */ - - zzekweqi_("NUM_SELECT_COLS", &nsel, eqryi, (ftnlen)15); - state = 14; - } - } else if (token == 11) { - *error = TRUE_; - s_copy(errtyp, "MORE_TOKENS_EXP", (ftnlen)32, (ftnlen)15); - state = 16; - } else { - -/* We've got the wrong kind of token here. */ - - *error = TRUE_; - s_copy(errtyp, "TABLE_OR_COLUMN_EXP", (ftnlen)32, (ftnlen)19); - state = 16; - } - -/* State is a member of {SELNAM, TERM}. */ - - } else if (state == 14) { - -/* We've seen a SELECT column name, or else the name */ -/* of a table qualifying a SELECT column name. */ - - if (token == 11) { - -/* The name we picked up was an unqualified column */ -/* name. Append the saved name descriptor to the encoded */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&namdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("namdsc", i__1, "zzekpars_", (ftnlen)875)], - eqryi); - } - state = 16; - } else if (token == 8) { - -/* The name we picked up was an unqualified column */ -/* name. Append the saved name descriptor to the encoded */ -/* query. Another name should follow. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&namdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("namdsc", i__1, "zzekpars_", (ftnlen)888)], - eqryi); - } - state = 12; - } else if (token == 9) { - -/* The name we picked up was a table name or alias. A */ -/* column name should follow. */ - - state = 13; - } else if (token == 1) { - -/* We have the last column name in the SELECT clause. */ - -/* Append the saved name descriptor to the encoded */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&namdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("namdsc", i__1, "zzekpars_", (ftnlen)910)], - eqryi); - } - -/* The last column name in the SELECT clause is followed by */ -/* a keyword. FROM, WHERE and ORDER are the only valid */ -/* possibilities. */ - - if (values[toknum - 1] == 29 || values[toknum - 1] == 11 || - values[toknum - 1] == 26) { - -/* We're done with the SELECT clause. */ - - state = 16; - } else { - -/* We've got a keyword we don't want here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else { - -/* We've got the wrong kind of token here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_TOKEN", (ftnlen)32, (ftnlen)9); - state = 16; - } - -/* STATE is a member of {SELECT, SELTAB, TERM}. */ - - } else if (state == 13) { - -/* We've picked up a qualifying table name for a SELECT */ -/* column. We must see a column name here. */ - - if (token == 2) { - -/* Update the place-holder table name descriptor in the */ -/* encoded query. */ - - movei_(namdsc, &c__6, &eqryi[cardi_(eqryi)]); - -/* Add the column name to the character part of the */ -/* encoded query. */ - - i__ = values[toknum - 1]; - b = chbegs[i__ - 1]; - e = chends[i__ - 1]; - l = e - b + 1; - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - zzekinqc_(chrbuf + (b - 1), &l, &lxb, &lxe, eqryi, eqryc, - coldsc, e - (b - 1), eqryc_len); - -/* Add the descriptor for the column name to the encoded */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&coldsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("coldsc", i__1, "zzekpars_", (ftnlen)988)], - eqryi); - } - state = 15; - } else if (token == 11) { - *error = TRUE_; - s_copy(errtyp, "MORE_TOKENS_EXP", (ftnlen)32, (ftnlen)15); - state = 16; - } else { - *error = TRUE_; - s_copy(errtyp, "COLUMN_EXP", (ftnlen)32, (ftnlen)10); - state = 16; - } - -/* STATE is a member of {SELCOL, TERM}. */ - - } else if (state == 15) { - -/* We've picked up a qualified column name. At this point, */ -/* we should see a keyword, a comma, or the end of the */ -/* query. */ - - if (token == 1) { - -/* The last column name in the SELECT clause is followed by */ -/* a keyword. FROM, WHERE and ORDER are the only valid */ -/* possibilities. */ - - if (values[toknum - 1] == 29 || values[toknum - 1] == 11 || - values[toknum - 1] == 26) { - -/* We're done with the SELECT clause. */ - - state = 16; - } else { - -/* We've got a keyword we don't want here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else if (token == 8) { - -/* We expect another SELECT column. */ - - state = 12; - } else if (token == 11) { - -/* We're done with the SELECT clause. */ - - state = 16; - } else { - *error = TRUE_; - s_copy(errtyp, "COMMA_OR_KEY_EXP", (ftnlen)32, (ftnlen)16); - state = 16; - } - -/* STATE is a member of {SELECT, TERM}. */ - - } else if (state == 4) { - -/* The WHERE clause is optional. See whether we have one. The */ -/* clause is started by a WHERE keyword. */ - - zzektloc_(&c__1, &c__29, ntoken, tokens, values, &toknum, &fnd); - if (fnd) { - -/* We're going to hand off the list of tokens that comprise */ -/* the WHERE clause of the query to a routine that will */ -/* parse the tokens and form a list of relational */ -/* constraints. Once this is done, all we have to do here */ -/* is check the validity of the column names and the values */ -/* used in the constraints. */ - - zzeknrml_(query, ntoken, lxbegs, lxends, tokens, values, - numvls, chrbuf, chbegs, chends, eqryi, eqryc, eqryd, - error, prserr, query_len, chrbuf_len, eqryc_len, - prserr_len); - if (*error) { - s_copy(errtyp, "WHERE_ERROR", (ftnlen)32, (ftnlen)11); - state = 16; - } else { - -/* Parse the ORDER BY clause, if one is present. */ - - state = 5; - } - } else { - -/* Parse the ORDER BY clause, if one is present. */ - - state = 5; - } - -/* STATE is a member of {ORDER, TERM}. */ - - } else if (state == 5) { - -/* The ORDER BY clause is optional. See whether we have one. */ -/* The clause is started by an ORDER keyword. */ - - zzektloc_(&c__1, &c__26, ntoken, tokens, values, &toknum, &fnd); - if (fnd) { - -/* The BY keyword should follow the ORDER keyword. */ - - if (toknum < *ntoken) { - ++toknum; - if (tokens[toknum - 1] == 1 && values[toknum - 1] == 6) { - -/* We're ready to parse the ORDER BY clause. */ - - state = 6; - } else { - -/* No BY keyword followed the ORDER keyword. */ - - *error = TRUE_; - s_copy(errtyp, "BY_EXPECTED", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else { - -/* We're out of tokens where we shouldn't be. */ - - *error = TRUE_; - s_copy(errtyp, "BY_EXPECTED", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else { - -/* We're ready to go on to the SELECT clause. */ - - state = 11; - } - -/* STATE is a member of {ORDRBY, SELKEY, TERM}. */ - - } else if (state == 6) { - -/* We must see a name in the order column list here. */ -/* The name may be a lone column name, or it may be a column */ -/* name qualified by a table name or alias. */ - - if (token == 2) { - -/* We've found a name (as far as we can tell at this point). */ -/* Make sure we haven't exceeded the limit for order-by */ -/* column names; if not, store the name string in the */ -/* encoded query, and save the descriptor until we've */ -/* figured out whether we're looking at a column name or */ -/* table name. */ - - ++norder; - if (norder > 10) { - *error = TRUE_; - s_copy(errtyp, "TOO_MANY_ORD_COLS", (ftnlen)32, (ftnlen) - 17); - state = 16; - } else { - i__ = values[toknum - 1]; - b = chbegs[i__ - 1]; - e = chends[i__ - 1]; - l = e - b + 1; - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - zzekinqc_(chrbuf + (b - 1), &l, &lxb, &lxe, eqryi, eqryc, - namdsc, e - (b - 1), eqryc_len); - -/* Add a place-holder value descriptor to reserve */ -/* space for a table descriptor for this name. If it */ -/* turns out that the current name is a table name, we'll */ -/* update this descriptor. */ - - cleari_(&c__6, valdsc); - valdsc[0] = 1; - for (j = 1; j <= 6; ++j) { - appndi_(&valdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? - i__1 : s_rnge("valdsc", i__1, "zzekpars_", ( - ftnlen)1240)], eqryi); - } - -/* Update the order-by column count in the encoded query. */ - - zzekweqi_("NUM_ORDERBY_COLS", &norder, eqryi, (ftnlen)16); - state = 8; - } - } else if (token == 11) { - *error = TRUE_; - s_copy(errtyp, "MORE_TOKENS_EXP", (ftnlen)32, (ftnlen)15); - state = 16; - } else { - -/* We've got the wrong kind of token here. */ - - *error = TRUE_; - s_copy(errtyp, "TABLE_OR_COLUMN_EXP", (ftnlen)32, (ftnlen)19); - state = 16; - } - -/* State is a member of {ORDNAM, TERM}. */ - - } else if (state == 8) { - -/* We've seen an order-by column name, or else the name */ -/* of a table qualifying an order-by column name. */ - - if (token == 11) { - -/* The name we picked up was an unqualified column */ -/* name. Append the saved name descriptor to the encoded */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&namdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("namdsc", i__1, "zzekpars_", (ftnlen)1287)] - , eqryi); - } - -/* Since no ASCENDING or DESCENDING sense keyword was */ -/* supplied, append the default value ASCENDING to the */ -/* order-by column descriptor in the encoded query. */ - - appndi_(&c__0, eqryi); - -/* We're done with the ORDER BY clause; go on to parse the */ -/* SELECT clause. */ - - state = 11; - } else if (token == 8) { - -/* The name we picked up was an unqualified column */ -/* name. Append the saved name descriptor to the encoded */ -/* query. Another name should follow. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&namdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("namdsc", i__1, "zzekpars_", (ftnlen)1311)] - , eqryi); - } - -/* Since no ASCENDING or DESCENDING sense keyword was */ -/* supplied, append the default value ASCENDING to the */ -/* order-by column descriptor in the encoded query. */ - - appndi_(&c__0, eqryi); - state = 6; - } else if (token == 9) { - -/* The name we picked up was a table name or alias. A */ -/* column name should follow. */ - - state = 7; - } else if (token == 1) { - -/* We have a column name, which may be followed by a */ -/* keyword indicating the sense of the ordering, or may */ -/* be followed by a keyword starting a new clause. */ - -/* Append the saved name descriptor to the encoded */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&namdsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("namdsc", i__1, "zzekpars_", (ftnlen)1342)] - , eqryi); - } - -/* Set the sense descriptor according to the keyword we've */ -/* picked up. After this, we're ready to look for another */ -/* order-by column. */ - - if (values[toknum - 1] == 3) { - appndi_(&c__0, eqryi); - state = 10; - } else if (values[toknum - 1] == 8) { - appndi_(&c__1, eqryi); - state = 10; - } else if (values[toknum - 1] == 29 || values[toknum - 1] == - 11 || values[toknum - 1] == 27) { - -/* Since no ASCENDING or DESCENDING sense keyword was */ -/* supplied, append the default value ASCENDING to the */ -/* order-by column descriptor in the encoded query. */ - - appndi_(&c__0, eqryi); - -/* We're done with the ORDER BY clause. Go on to */ -/* parse the SELECT clause. */ - - state = 11; - } else { - -/* We've got a keyword we don't want here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else { - -/* We've got the wrong kind of token here. */ - - *error = TRUE_; - s_copy(errtyp, "BAD_TOKEN", (ftnlen)32, (ftnlen)9); - state = 16; - } - -/* STATE is a member of {ORDRBY, ORDTAB, ORDSNS, SELKEY, TERM}. */ - - } else if (state == 7) { - -/* We've picked up a qualifying table name for an order-by */ -/* column. We must see a column name here. */ - - if (token == 2) { - -/* Update the place-holder table name descriptor in the */ -/* encoded query. */ - - movei_(namdsc, &c__6, &eqryi[cardi_(eqryi)]); - -/* Add the column name to the character part of the */ -/* encoded query. */ - - i__ = values[toknum - 1]; - b = chbegs[i__ - 1]; - e = chends[i__ - 1]; - l = e - b + 1; - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - zzekinqc_(chrbuf + (b - 1), &l, &lxb, &lxe, eqryi, eqryc, - coldsc, e - (b - 1), eqryc_len); - -/* Add the descriptor for the column name to the encoded */ -/* query. */ - - for (j = 1; j <= 6; ++j) { - appndi_(&coldsc[(i__1 = j - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("coldsc", i__1, "zzekpars_", (ftnlen)1444)] - , eqryi); - } - state = 9; - } else if (token == 11) { - *error = TRUE_; - s_copy(errtyp, "MORE_TOKENS_EXP", (ftnlen)32, (ftnlen)15); - state = 16; - } else { - *error = TRUE_; - s_copy(errtyp, "COLUMN_EXP", (ftnlen)32, (ftnlen)10); - state = 16; - } - -/* STATE is a member of {ORDCOL, TERM}. */ - - } else if (state == 9) { - -/* We've picked up a qualified column name. At this point, */ -/* we should see a sense keyword, a comma, the end of the */ -/* query, or one of the FROM, SELECT, or WHERE keywords. */ - - if (token == 1) { - if (values[toknum - 1] == 3) { - -/* The ASCENDING keyword has been supplied. After this, */ -/* look for another column. */ - - appndi_(&c__0, eqryi); - state = 10; - } else if (values[toknum - 1] == 8) { - -/* The DESCENDING keyword has been supplied. After this, */ -/* look for another column. */ - - appndi_(&c__1, eqryi); - state = 10; - } else if (values[toknum - 1] == 29 || values[toknum - 1] == - 11 || values[toknum - 1] == 27) { - -/* We're done with the ORDER BY clause. Go on to */ -/* parse the SELECT clause. */ - - state = 11; - } else { - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else if (token == 8) { - -/* The ASCENDING keyword is implied. */ - - appndi_(&c__0, eqryi); - state = 6; - } else if (token == 11) { - -/* The ASCENDING keyword is implied. */ - - appndi_(&c__0, eqryi); - -/* We're done with the ORDER BY clause. Parse the SELECT */ -/* clause. */ - - state = 11; - } else { - *error = TRUE_; - s_copy(errtyp, "COMMA_OR_KEY_EXP", (ftnlen)32, (ftnlen)16); - state = 16; - } - -/* STATE is a member of {ORDRBY, ORDSNS, SELKEY, TERM}. */ - - } else if (state == 10) { - -/* We've picked up an order sense keyword. At this point, */ -/* we should see comma or the end of the query, or one of the */ -/* FROM, SELECT, or WHERE keywords. */ - - if (token == 8) { - -/* We're ready to look for another column. */ - - state = 6; - } else if (token == 11) { - -/* We're done with the ORDER BY clause. Parse the SELECT */ -/* clause. */ - - state = 11; - } else if (token == 1) { - if (values[toknum - 1] == 29 || values[toknum - 1] == 11 || - values[toknum - 1] == 27) { - -/* We're done with the ORDER BY clause. Go on to */ -/* parse the SELECT clause. */ - - state = 11; - } else { - *error = TRUE_; - s_copy(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11); - state = 16; - } - } else { - *error = TRUE_; - s_copy(errtyp, "COMMA_EXP", (ftnlen)32, (ftnlen)9); - state = 16; - } - -/* STATE is a member of {ORDRBY, SELKEY, TERM}. */ - - } else { - -/* Somehow, we've reached an invalid state. */ - - *error = TRUE_; - s_copy(prserr, "SPICE(BUG) -- Invalid state reached in EK parser." - , prserr_len, (ftnlen)49); - state = 16; - } - -/* STATE is a member of {ORDRBY, TERM}. */ - - } - -/* At this point, either an error has been detected, or the query */ -/* has been parsed, and the query is represented in encoded form */ -/* in the outputs EQRYI, EQRYC, and EQRYD. */ - - -/* We centralize construction of error messages in the following */ -/* section. */ - - if (*error) { - if (s_cmp(errtyp, "FROM_NOT_FOUND", (ftnlen)32, (ftnlen)14) == 0) { - s_copy(prserr, "Every query must contain a FROM clause. The FROM" - " keyword was not found.", prserr_len, (ftnlen)71); - } else if (s_cmp(errtyp, "SELECT_NOT_FOUND", (ftnlen)32, (ftnlen)16) - == 0) { - s_copy(prserr, "Every query must contain a SELECT clause. The SE" - "LECT keyword was not found.", prserr_len, (ftnlen)75); - } else if (s_cmp(errtyp, "BY_EXPECTED", (ftnlen)32, (ftnlen)11) == 0) - { - s_copy(prserr, "The BY keyword was not found following the ORDER" - " keyword.", prserr_len, (ftnlen)57); - } else if (s_cmp(errtyp, "BAD_KEYWORD", (ftnlen)32, (ftnlen)11) == 0) - { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Invalid keyword at location #. Actual token was:" - " #", prserr_len, (ftnlen)50); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "TABLE_OR_COLUMN_EXP", (ftnlen)32, (ftnlen) - 19) == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Table or column name expected at location #. Act" - "ual token was: #", prserr_len, (ftnlen)64); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "TABLE_EXP", (ftnlen)32, (ftnlen)9) == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Table name expected at location #. Actual token " - "was: #", prserr_len, (ftnlen)54); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "COLUMN_EXP", (ftnlen)32, (ftnlen)10) == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Column name expected at location #. Actual token" - " was: #", prserr_len, (ftnlen)55); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "ALIAS_EXP", (ftnlen)32, (ftnlen)9) == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Table alias, comma, or keyword expected at locat" - "ion #. Actual token was: #", prserr_len, (ftnlen)74); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "COMMA_OR_KEY_EXP", (ftnlen)32, (ftnlen)16) - == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Comma or keyword expected at location #. Actual " - "token was: #", prserr_len, (ftnlen)60); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "COMMA_EXP", (ftnlen)32, (ftnlen)9) == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Comma expected at location #. Actual token was: #" - , prserr_len, (ftnlen)49); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "MORE_TOKENS_EXP", (ftnlen)32, (ftnlen)15) == - 0) { - s_copy(prserr, "More tokens were expected in query.", prserr_len, - (ftnlen)35); - } else if (s_cmp(errtyp, "KEYWORD_EXP", (ftnlen)32, (ftnlen)11) == 0) - { - s_copy(prserr, "The keyword # was expected at location #. Actual" - " token was: #", prserr_len, (ftnlen)61); - repmc_(prserr, "#", expkey, prserr, prserr_len, (ftnlen)1, ( - ftnlen)32, prserr_len); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "BAD_TOKEN", (ftnlen)32, (ftnlen)9) == 0) { - lxb = lxbegs[toknum - 1]; - lxe = lxends[toknum - 1]; - s_copy(prserr, "Invalid token at location #. Token was: #", - prserr_len, (ftnlen)41); - repmi_(prserr, "#", &lxb, prserr, prserr_len, (ftnlen)1, - prserr_len); - repmc_(prserr, "#", query + (lxb - 1), prserr, prserr_len, ( - ftnlen)1, lxe - (lxb - 1), prserr_len); - } else if (s_cmp(errtyp, "TOO_MANY_TABLES", (ftnlen)32, (ftnlen)15) == - 0) { - s_copy(prserr, "Number of tables in \"FROM\" clause exceeds allo" - "wed maximum of #.", prserr_len, (ftnlen)63); - repmi_(prserr, "#", &c__10, prserr, prserr_len, (ftnlen)1, - prserr_len); - } else if (s_cmp(errtyp, "TOO_MANY_ORD_COLS", (ftnlen)32, (ftnlen)17) - == 0) { - s_copy(prserr, "Number of order-by columns exceeds allowed maxim" - "um of #.", prserr_len, (ftnlen)56); - repmi_(prserr, "#", &c__10, prserr, prserr_len, (ftnlen)1, - prserr_len); - } else if (s_cmp(errtyp, "TOO_MANY_SEL_COLS", (ftnlen)32, (ftnlen)17) - == 0) { - s_copy(prserr, "Number of SELECT columns exceeds allowed maximum" - " of #.", prserr_len, (ftnlen)54); - repmi_(prserr, "#", &c__50, prserr, prserr_len, (ftnlen)1, - prserr_len); - } else if (s_cmp(errtyp, "WHERE_ERROR", (ftnlen)32, (ftnlen)11) != 0) - { - s_copy(prserr, "SPICE(BUG)--Unrecognized error type. Type was #." - , prserr_len, (ftnlen)49); - repmc_(prserr, "#", errtyp, prserr, prserr_len, (ftnlen)1, ( - ftnlen)32, prserr_len); - } - } else { - -/* Indicate that parsing is complete. */ - - zzekweqi_("PARSED", &c__1, eqryi, (ftnlen)6); - } - chkout_("ZZEKPARS", (ftnlen)8); - return 0; -} /* zzekpars_ */ - diff --git a/ext/spice/src/cspice/zzekpcol.c b/ext/spice/src/cspice/zzekpcol.c deleted file mode 100644 index 803fb7afe6..0000000000 --- a/ext/spice/src/cspice/zzekpcol.c +++ /dev/null @@ -1,1173 +0,0 @@ -/* zzekpcol.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__0 = 0; - -/* $Procedure ZZEKPCOL ( Private: EK, parse column name ) */ -/* Subroutine */ int zzekpcol_(char *qcol, integer *eqryi, char *eqryc, char * - table, char *alias, integer *tabidx, char *column, integer *colidx, - logical *error, char *errmsg, ftnlen qcol_len, ftnlen eqryc_len, - ftnlen table_len, ftnlen alias_len, ftnlen column_len, ftnlen - errmsg_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - integer ntab; - logical qual; - extern /* Subroutine */ int zzekscan_(char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, doublereal - *, char *, integer *, integer *, logical *, char *, ftnlen, - ftnlen, ftnlen), zzekqtab_(integer *, char *, integer *, char *, - char *, ftnlen, ftnlen, ftnlen), zzekreqi_(integer *, char *, - integer *, ftnlen); - integer i__, j; - extern /* Subroutine */ int ekcii_(char *, integer *, char *, integer *, - ftnlen, ftnlen), chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer cc; - extern logical failed_(void); - integer icheck, chbegs[3], chends[3]; - char chrbuf[160]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - char alslst[64*10], tablst[64*10], tmpcol[32], tmptab[64]; - doublereal numvls[3]; - integer attdsc[6], lxbegs[3], lxends[3], nmatch, ntoken, tokens[3], - values[3]; - logical fnd; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), ekccnt_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Given an encoded query, parse the name of a column appearing in */ -/* that query, returning full particulars concerning the column and */ -/* its parent table. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Attribute Descriptor Parameters */ - -/* ekattdsc.inc Version 1 23-AUG-1995 (NJB) */ - - -/* This include file declares parameters used in EK column */ -/* attribute descriptors. Column attribute descriptors are */ -/* a simplified version of column descriptors: attribute */ -/* descriptors describe attributes of a column but do not contain */ -/* addresses or pointers. */ - - -/* Size of column attribute descriptor */ - - -/* Indices of various pieces of attribute descriptors: */ - - -/* ATTSIZ is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* ATTTYP is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* ATTLEN is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* ATTSIZ is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* ATTIDX is the location of a flag that indicates whether the column */ -/* is indexed. The flag takes the value ITRUE if the column is */ -/* indexed and otherwise takes the value IFALSE. */ - - -/* ATTNFL is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* End Include Section: EK Column Attribute Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Token Code Parameters */ - -/* ektokn.inc Version 2 25-JAN-1995 (NJB) */ - -/* Updated to distinguish between special characters. */ - - -/* ektokn.inc Version 1 05-DEC-1994 (NJB) */ - - -/* The EK query language tokens and codes are: */ - -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ - - - -/* End Include Section: EK Token Code Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QCOL I Column name, possibly qualified. */ -/* EQRYI I Integer component of query. */ -/* EQRYC I Character component of query. */ -/* TABLE O Name of table qualifying column. */ -/* ALIAS O Alias of table, if present. */ -/* TABIDX O Index of TABLE in FROM clause, if known. */ -/* COLUMN O Name of QCOL, unqualified. */ -/* COLIDX O Index of QCOL within its parent virtual table. */ -/* ERROR O Error flag. */ -/* ERRMSG O Parse error message. */ - -/* $ Detailed_Input */ - -/* QCOL is a column name from an EK query. QCOL may be */ -/* qualified by a table name, in which case it */ -/* conforms to the sytax */ - -/* . */ - -/* or QCOL may be unqualified, in which case it */ -/* is simply an in the EK query language. */ - - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* TABLE is the name of the table containing the column */ -/* identified by QCOL. If QCOL contains a table name */ -/* to begin with, TABLE is that name, converted to */ -/* upper case. */ - -/* ALIAS is the alias of the table containing the column */ -/* identified by QCOL, if an alias for that table is */ -/* present in the input query. If QCOL contains a */ -/* table alias to begin with, TABLE is that alias, */ -/* converted to upper case. */ - -/* TABIDX is the ordinal position in the FROM clause of the */ -/* input query of the table containing the column */ -/* designated by QCOL. */ - -/* COLUMN is the name of the column designated by QCOL, */ -/* converted to upper case. */ - -/* COLIDX is the ordinal position column designated by QCOL */ -/* with respect to the virtual table containing that */ -/* column. */ - -/* ERROR is a logical flag indicating whether QCOL was */ -/* parsed correctly. The previous list of outputs */ -/* are undefined if a parse error occurred. ERROR */ -/* is returned .TRUE. if a parse error occurred, */ -/* .FALSE. otherwise. */ - -/* ERRMSG is a character string describing the cause of a */ -/* parse error, if such an error occurred. Otherwise, */ -/* ERRMSG is returned blank. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been semantically checked, the */ -/* error SPICE(NOTSEMCHECKED) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If the input QCOL does not parse as a qualified or */ -/* unqualified column name, the error flag and message will */ -/* indicate that a parse error occurred. No error will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine supports parsing of the SELECT clause of EK */ -/* queries by higher-level routines. This routine is */ -/* superseded by the SPICELIB routine EKPSEL. */ - -/* $ Examples */ - -/* 1) Suppose that EQRYI and EQRYC have been obtained by */ -/* encoding the query */ - -/* 'SELECT T1.COL1, T2.COL2 FROM TABLE1 T1, TABLE2 T2' */ - -/* Suppose also that the table TABLE1 contains two columns */ -/* named COL1 and COL2, and that the columns occur in that */ -/* order in the table. */ - -/* Then the call */ - -/* CALL ZZEKPCOL ( 'T1.COL', EQRYI, EQRYC, TABLE, ALIAS, */ -/* . TABIDX, COLUMN, COLIDX, ERROR, ERRMSG ) */ - -/* will return */ - -/* TABLE = 'TABLE1' */ -/* ALIAS = 'T1' */ -/* TABIDX = 1 */ -/* COLUMN = 'COL1' */ -/* COLIDX = 1 */ -/* ERROR = .FALSE. */ -/* ERRMSG = ' ' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - zzekreqi_(eqryi, "SEM_CHECKED", &icheck, (ftnlen)11); - if (failed_()) { - return 0; - } - -/* Make sure the encoded query is in order before proceeding. */ - - if (icheck == -1) { - chkin_("ZZEKPCOL", (ftnlen)8); - setmsg_("Encoded query has not yet been semantically checked.", ( - ftnlen)52); - sigerr_("SPICE(NOTSEMCHECKED)", (ftnlen)20); - chkout_("ZZEKPCOL", (ftnlen)8); - return 0; - } - -/* Scan the input column name. There are only two valid token */ -/* sequences possible: */ - -/* */ - -/* . */ - -/* ZZEKSCAN should therefore return 1 or 3 tokens. */ - - zzekscan_(qcol, &c__3, &c__0, &ntoken, tokens, lxbegs, lxends, values, - numvls, chrbuf, chbegs, chends, error, errmsg, qcol_len, (ftnlen) - 160, errmsg_len); - if (*error) { - return 0; - } - if (ntoken == 1) { - if (tokens[0] != 2) { - *error = TRUE_; - s_copy(errmsg, "Invalid column name; name should consist of an i" - "dentifier.", errmsg_len, (ftnlen)58); - return 0; - } - ucase_(qcol, column, qcol_len, column_len); - qual = FALSE_; - } else if (ntoken == 3) { - if (tokens[0] != 2) { - *error = TRUE_; - s_copy(errmsg, "Invalid table name; name should consist of an id" - "entifier.", errmsg_len, (ftnlen)57); - return 0; - } else if (tokens[1] != 9) { - *error = TRUE_; - s_copy(errmsg, "Invalid qualified column name; table name should" - " be followed by a period.", errmsg_len, (ftnlen)73); - return 0; - } else if (tokens[2] != 2) { - *error = TRUE_; - s_copy(errmsg, "Invalid column name; name should consist of an i" - "dentifier.", errmsg_len, (ftnlen)58); - return 0; - } - i__ = values[0]; - j = values[2]; - i__1 = chbegs[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("chb" - "egs", i__2, "zzekpcol_", (ftnlen)346)] - 1; - s_copy(tmptab, chrbuf + i__1, (ftnlen)64, chends[(i__3 = i__ - 1) < 3 - && 0 <= i__3 ? i__3 : s_rnge("chends", i__3, "zzekpcol_", ( - ftnlen)346)] - i__1); - i__1 = chbegs[(i__2 = j - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("chbegs" - , i__2, "zzekpcol_", (ftnlen)347)] - 1; - s_copy(column, chrbuf + i__1, column_len, chends[(i__3 = j - 1) < 3 && - 0 <= i__3 ? i__3 : s_rnge("chends", i__3, "zzekpcol_", ( - ftnlen)347)] - i__1); - qual = TRUE_; - } else { - *error = TRUE_; - s_copy(errmsg, "Invalid tokens present in qualified column name. Val" - "id syntax is or
.", errmsg_len, ( - ftnlen)93); - return 0; - } - -/* At this point, COLUMN and QUAL are set. If a qualifying table */ -/* or alias was supplied, that string is stored in TMPTAB. Both */ -/* COLUMN and TMPTAB are in upper case. */ - -/* If we got this far, we'll need to look up the table names and */ -/* aliases from the query. */ - - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - zzekqtab_(eqryi, eqryc, &i__, tablst + (((i__2 = i__ - 1) < 10 && 0 <= - i__2 ? i__2 : s_rnge("tablst", i__2, "zzekpcol_", (ftnlen) - 371)) << 6), alslst + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? - i__3 : s_rnge("alslst", i__3, "zzekpcol_", (ftnlen)371)) << 6) - , eqryc_len, (ftnlen)64, (ftnlen)64); - } - -/* If QCOL contains a table name, look for that name in the */ -/* table list, and if necessary, in the alias list. */ - - if (qual) { - *tabidx = isrchc_(tmptab, &ntab, tablst, (ftnlen)64, (ftnlen)64); - if (*tabidx == 0) { - *tabidx = isrchc_(tmptab, &ntab, alslst, (ftnlen)64, (ftnlen)64); - } - -/* If we didn't find the table name in either list, it's just */ -/* plain wrong. */ - - if (*tabidx == 0) { - *error = TRUE_; - s_copy(errmsg, "Table name <#> does not match table or alias fro" - "m query.", errmsg_len, (ftnlen)56); - repmc_(errmsg, "#", tmptab, errmsg, errmsg_len, (ftnlen)1, ( - ftnlen)64, errmsg_len); - return 0; - } - -/* At this point, TABIDX is valid. Locate the column within */ -/* the table. */ - - ekccnt_(tablst + (((i__1 = *tabidx - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("tablst", i__1, "zzekpcol_", (ftnlen)402)) << 6), &cc, - (ftnlen)64); - if (failed_()) { - return 0; - } - fnd = FALSE_; - j = 1; - while(j <= cc && ! fnd) { - ekcii_(tablst + (((i__1 = *tabidx - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("tablst", i__1, "zzekpcol_", (ftnlen)414)) << 6), & - j, tmpcol, attdsc, (ftnlen)64, (ftnlen)32); - if (s_cmp(tmpcol, column, (ftnlen)32, column_len) == 0) { - *colidx = j; - fnd = TRUE_; - } else { - ++j; - } - } - if (! fnd) { - *error = TRUE_; - s_copy(errmsg, "Column name <#> does not appear in the qualifyin" - "g table <#>.", errmsg_len, (ftnlen)60); - repmc_(errmsg, "#", column, errmsg, errmsg_len, (ftnlen)1, - column_len, errmsg_len); - repmc_(errmsg, "#", tmptab, errmsg, errmsg_len, (ftnlen)1, ( - ftnlen)64, errmsg_len); - return 0; - } - -/* At this point, TABIDX and COLIDX are set correctly. */ - - } else { - -/* No qualifying table name was supplied. COLUMN had better */ -/* be a unique column name among the set of columns belong to */ -/* tables in the FROM clause of the input query. Check the */ -/* columns for each table in the FROM clause, looking for */ -/* matches. */ - - nmatch = 0; - i__1 = ntab; - for (i__ = 1; i__ <= i__1; ++i__) { - ekccnt_(tablst + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("tablst", i__2, "zzekpcol_", (ftnlen)452)) << 6), & - cc, (ftnlen)64); - if (failed_()) { - return 0; - } - i__2 = cc; - for (j = 1; j <= i__2; ++j) { - ekcii_(tablst + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : - s_rnge("tablst", i__3, "zzekpcol_", (ftnlen)460)) << - 6), &j, tmpcol, attdsc, (ftnlen)64, (ftnlen)32); - if (s_cmp(tmpcol, column, (ftnlen)32, column_len) == 0) { - ++nmatch; - s_copy(column, tmpcol, column_len, (ftnlen)32); - *colidx = j; - *tabidx = i__; - } - } - } - -/* Check to see whether we have the unique identification we're */ -/* hoping for. */ - - if (nmatch == 0) { - *error = TRUE_; - s_copy(errmsg, "Column name <#> does not appear in any table in " - "FROM clause of query.", errmsg_len, (ftnlen)69); - repmc_(errmsg, "#", column, errmsg, errmsg_len, (ftnlen)1, - column_len, errmsg_len); - return 0; - } else if (nmatch > 1) { - *error = TRUE_; - s_copy(errmsg, "Column name <#> is ambiguous without a qualifyin" - "g table name.", errmsg_len, (ftnlen)61); - repmc_(errmsg, "#", column, errmsg, errmsg_len, (ftnlen)1, - column_len, errmsg_len); - return 0; - } - -/* At this point, COLUMN, TABIDX and COLIDX are set correctly. */ - - } - -/* At this point, COLUMN, TABIDX and COLIDX are set correctly, */ -/* regardless of whether the input name was qualified. Fill the rest */ -/* of our output variables. */ - - s_copy(table, tablst + (((i__1 = *tabidx - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("tablst", i__1, "zzekpcol_", (ftnlen)504)) << 6), - table_len, (ftnlen)64); - s_copy(alias, alslst + (((i__1 = *tabidx - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("alslst", i__1, "zzekpcol_", (ftnlen)505)) << 6), - alias_len, (ftnlen)64); - return 0; -} /* zzekpcol_ */ - diff --git a/ext/spice/src/cspice/zzekpdec.c b/ext/spice/src/cspice/zzekpdec.c deleted file mode 100644 index 3a2e97eaa0..0000000000 --- a/ext/spice/src/cspice/zzekpdec.c +++ /dev/null @@ -1,1061 +0,0 @@ -/* zzekpdec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__11 = 11; -static integer c__20 = 20; -static integer c__0 = 0; - -/* $Procedure ZZEKPDEC ( EK, parse column declaration ) */ -/* Subroutine */ int zzekpdec_(char *decl, integer *pardsc, ftnlen decl_len) -{ - /* Initialized data */ - - static char attkey[32*5] = "DATATYPE " "SIZE " - " " "INDEXED " "NUL" - "LS_OK " "FIXED_COUNT "; - static integer reqkey[1] = { 1 }; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__, j, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int cleari_(integer *, integer *); - logical attfnd[11]; - integer attloc[11], tokloc; - extern /* Subroutine */ int lparsm_(char *, char *, integer *, integer *, - char *, ftnlen, ftnlen, ftnlen), sigerr_(char *, ftnlen); - char tokens[32*20]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), chkout_(char *, - ftnlen), cmprss_(char *, integer *, char *, char *, ftnlen, - ftnlen, ftnlen), nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - extern logical return_(void); - char msg[320]; - integer ptr; - -/* $ Abstract */ - -/* Parse a declaration of a new EK column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* DECL I String containing column declaration. */ -/* PARDSC O Partial column descriptor. */ - -/* $ Detailed_Input */ - -/* DECL is a character string containing a column */ -/* declaration. Column declarations are strings that */ -/* contain `keyword=value' assignments that define */ -/* the attributes of the columns to which they apply. */ - -/* The attributes of a column defined by a */ -/* declaration are: */ - -/* DATA TYPE */ -/* */ -/* */ -/* */ -/* */ - -/* The form of a column declaration is */ - -/* .'DATATYPE = ,' // */ -/* .'[SIZE = ],' // */ -/* .'[INDEXED = ],' // */ -/* .'[NULLS_OK = ]' // */ -/* .'[FIXED_COUNT = ]' */ - -/* The order of the assignments does not matter. */ - -/* Here can be any of */ - -/* CHARACTER* */ -/* CHARACTER*(*) */ -/* DOUBLE PRECISION */ -/* INTEGER */ - -/* and the optional can be either of */ - -/* */ -/* VARIABLE */ - -/* Character columns may not have both variable */ -/* string length and variable size. */ - -/* The column entry size defaults to 1 if the size */ -/* descriptor is omitted. */ - -/* The optional clauses using the INDEXED, NULLS_OK, */ -/* and FIXED_COUNT keywords take the values */ - -/* TRUE */ -/* FALSE */ - -/* on the right-hand-sides of the equal signs. */ - -/* The INDEXED clause indicates that the column is */ -/* indexed. If the clause is omitted, the column is */ -/* not indexed. Only scalar-valued columns can be */ -/* indexed. */ - -/* The NULLS_OK indicates that null values are */ -/* permitted in the column; if the clause is omitted, */ -/* null values are not permitted in the column. */ - -/* The FIXED_COUNT clause indicates that the column */ -/* has a fixed number of entries; no records may be */ -/* added to or deleted from the column. If any */ -/* column in a segment has a fixed record count, all */ -/* columns in the segment must have the FIXED_COUNT */ -/* attribute. */ - -/* FIXED_COUNT columns may be loaded only by the */ -/* fast load routines. */ - -/* Unless the FIXED_COUNT keyword is used, the column */ -/* does not have a fixed record count. */ - -/* Commas are required to separate the assignments */ -/* within declarations. White space is optional. */ -/* Case is not significant. */ - -/* $ Detailed_Output */ - -/* PARDSC is an integer array that specifies the attributes */ -/* of the column. PARDSC is basically a */ -/* partially-filled-in column descriptor: it */ -/* doesn't contain any pointer information. In the */ -/* locations where a column descriptor would contain */ -/* an index pointer or a null flag array pointer, */ -/* PARDSC contains boolean values indicating whether */ -/* these items are supposed to be filled in later. */ - -/* The elements of PARDSC that are filled in upon */ -/* return from this routine are: */ - -/* -- Class. The column class is automatically */ -/* determined from the declared attributes. */ - -/* -- Data type. */ - -/* -- String length, if applicable. Variable- */ -/* length strings are represented by a length */ -/* specification of IFALSE. */ - -/* -- Column entry size. Variable-size entries */ -/* are represented by a size specification of */ -/* IFALSE. */ - -/* -- The column's index type. This element, */ -/* which in a normal column descriptor contains */ -/* an index type code, takes the boolean value */ -/* ITRUE if the column is indexed and IFALSE */ -/* otherwise. */ - -/* -- The column's null flag. This element takes */ -/* the boolean value ITRUE if the column can */ -/* contain null values and is set to IFALSE */ -/* otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input declaration does not conform to the specification */ -/* given in $Detailed_Input, the error SPICE(BADCOLUMNDECL) is */ -/* signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a utility that supports EK writing subroutines. */ - -/* $ Examples */ - -/* 1) Parse a declaration of an indexed column of 80-character */ -/* strings, in which null values are allowed: */ - -/* CALL ZZEKPDEC ( 'DATATYPE = CHARACTER*80, ' // */ -/* . 'SIZE = 1,' // */ -/* . 'INDEXED = TRUE', // */ -/* . 'NULLS_OK = TRUE', */ -/* . PARDSC ) */ - - -/* When ZZEKPDEC returns, the values of its output column */ -/* descriptor will be */ - -/* When ZZEKPDEC returns, the value of its output argument */ -/* PARDSC will be */ - -/* +---------------+ */ -/* | 3 | Class */ -/* +---------------+ */ -/* | | Data type */ -/* +---------------+ */ -/* | 80 | String length */ -/* +---------------+ */ -/* | 1 | Size */ -/* +---------------+ */ -/* | 0 | Base addres of column name (not yet set) */ -/* +---------------+ */ -/* | ITRUE | Index type (ITRUE means col is indexed) */ -/* +---------------+ */ -/* | 0 | Index pointer */ -/* +---------------+ */ -/* | ITRUE | Null flag (ITRUE means nulls are */ -/* +---------------+ allowed) */ -/* | 0 | Ordinal position of column in segment */ -/* +---------------+ */ -/* | 0 | Metadata pointer */ -/* +---------------+ */ -/* | 0 | (Reserved) */ -/* +---------------+ */ - - - -/* 2) Parse a declaration of a variable-size column of 80-character */ -/* strings: */ - -/* CALL ZZEKPDEC ( 'DATATYPE = CHARACTER*80, ' // */ -/* . 'SIZE = VARIABLE', */ -/* . PARDSC ) */ - -/* When ZZEKPDEC returns, the value of its output argument */ -/* PARDSC will be */ - -/* +---------------+ */ -/* | 3 | Class */ -/* +---------------+ */ -/* | | Data type */ -/* +---------------+ */ -/* | 80 | String length */ -/* +---------------+ */ -/* | IFALSE | Size (IFALSE indicates variable size) */ -/* +---------------+ */ -/* | 0 | Base addres of column name (not yet set) */ -/* +---------------+ */ -/* | IFALSE | Index type (IFALSE means unindexed col) */ -/* +---------------+ */ -/* | 0 | Index pointer */ -/* +---------------+ */ -/* | IFALSE | Null flag (IFALSE means nulls are not */ -/* +---------------+ allowed) */ -/* | 0 | Ordinal position of column in segment */ -/* +---------------+ */ -/* | 0 | Metadata pointer */ -/* +---------------+ */ -/* | 0 | (Reserved) */ -/* +---------------+ */ - - -/* $ Restrictions */ - -/* 1) Currently does not diagnose extraneous keyword assignments. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 14-SEP-2005 (NJB) */ - -/* Bug fix: several error handling logic blocks were */ -/* missing SIGERR calls; these have been corrected. */ - -/* Bug fix: No diagnostic was issued for a declaration */ -/* of a variable-size, variable-string-length column. */ -/* This has been corrected. */ - -/* - Beta Version 1.0.0, 16-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Parameters naming indices of keywords in the attribute list */ -/* ATTKEY: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKPDEC", (ftnlen)8); - } - -/* Start with a clean slate. */ - - cleari_(&c__11, pardsc); - -/* Our declaration language has been cleverly designed so that the */ -/* characters */ - -/* ',' */ -/* '=' */ - -/* act as delimiters that LPARSM can make use */ -/* of. LPARSM will hand us back a token list that contains these */ -/* pairs of consecutive tokens: */ - -/* +----------------------+ */ -/* | CLASS | */ -/* +----------------------+ */ -/* | | */ -/* +----------------------+ */ - -/* +----------------------+ */ -/* | DATATYPE | */ -/* +----------------------+ */ -/* | | */ -/* +----------------------+ */ - -/* +----------------------+ */ -/* | SIZE | */ -/* +----------------------+ */ -/* | | ( 'VARIABLE' or ) */ -/* +----------------------+ */ - -/* +----------------------+ */ -/* | INDEXED | (fixed-size columns only, optional) */ -/* +----------------------+ */ -/* | | */ -/* +----------------------+ */ - -/* +----------------------+ */ -/* | NULLS_OK | (optional) */ -/* +----------------------+ */ -/* | | */ -/* +----------------------+ */ - - -/* The order of the token pairs is not necessarily as shown. */ - - - lparsm_(decl, ",=", &c__20, &n, tokens, decl_len, (ftnlen)2, (ftnlen)32); - -/* Make sure the tokens are in upper case. They are already */ -/* left-justified. */ - - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - ucase_(tokens + (((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge( - "tokens", i__2, "zzekpdec_", (ftnlen)453)) << 5), tokens + ((( - i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge("tokens", - i__3, "zzekpdec_", (ftnlen)453)) << 5), (ftnlen)32, (ftnlen) - 32); - } - -/* See which clauses are present in the declaration, and keep track */ -/* of the token indices of the keywords that start the clauses. */ - - for (i__ = 1; i__ <= 5; ++i__) { - attfnd[(i__1 = i__ - 1) < 11 && 0 <= i__1 ? i__1 : s_rnge("attfnd", - i__1, "zzekpdec_", (ftnlen)461)] = FALSE_; - } - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - j = 1; - found = FALSE_; - while(j <= 5 && ! found) { - if (s_cmp(tokens + (((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tokens", i__2, "zzekpdec_", (ftnlen)471)) << 5), - attkey + (((i__3 = j - 1) < 5 && 0 <= i__3 ? i__3 : - s_rnge("attkey", i__3, "zzekpdec_", (ftnlen)471)) << 5), ( - ftnlen)32, (ftnlen)32) == 0) { - found = TRUE_; - attfnd[(i__2 = j - 1) < 11 && 0 <= i__2 ? i__2 : s_rnge("att" - "fnd", i__2, "zzekpdec_", (ftnlen)473)] = TRUE_; - attloc[(i__2 = j - 1) < 11 && 0 <= i__2 ? i__2 : s_rnge("att" - "loc", i__2, "zzekpdec_", (ftnlen)474)] = i__; - } else { - ++j; - } - } - } - -/* Make sure we got the required keyword tokens we were expecting. */ - - for (i__ = 1; i__ <= 1; ++i__) { - if (! attfnd[(i__2 = reqkey[(i__1 = i__ - 1) < 1 && 0 <= i__1 ? i__1 : - s_rnge("reqkey", i__1, "zzekpdec_", (ftnlen)488)] - 1) < 11 - && 0 <= i__2 ? i__2 : s_rnge("attfnd", i__2, "zzekpdec_", ( - ftnlen)488)]) { - setmsg_("Required keyword # was not found in column declaration " - "#.", (ftnlen)57); - errch_("#", attkey + (((i__2 = reqkey[(i__1 = i__ - 1) < 1 && 0 <= - i__1 ? i__1 : s_rnge("reqkey", i__1, "zzekpdec_", ( - ftnlen)492)] - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("attk" - "ey", i__2, "zzekpdec_", (ftnlen)492)) << 5), (ftnlen)1, ( - ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMDECL)", (ftnlen)19); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } - -/* If we got this far, we can start to fill in the data type */ -/* descriptor. Starting at the location of the DATATYPE keyword, */ -/* we should see one of the following token sequences: */ - -/* DATATYPE = DOUBLE PRECISION */ -/* DATATYPE = INTEGER */ -/* DATATYPE = TIME */ -/* DATATYPE = CHARACTER* */ -/* DATATYPE = CHARACTER*() */ -/* DATATYPE = CHARACTER** */ -/* DATATYPE = CHARACTER*(*) */ - -/* The character declarations may have white space surrounding */ -/* the length specifier. */ - -/* Find the location where the data type token should be. */ - - tokloc = attloc[0] + 1; - if (n < tokloc) { - setmsg_("Column data type specification did not follow \"DATATYPE\" " - "keyword in declaration #.", (ftnlen)82); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)531)) << 5), "INTEGER" - , (ftnlen)32, (ftnlen)7) == 0) { - pardsc[1] = 3; - pardsc[2] = 1; - } else if (eqstr_(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)536)) << 5), "DOUB" - "LE PRECISION", (ftnlen)32, (ftnlen)16)) { - pardsc[1] = 2; - pardsc[2] = 1; - } else if (eqstr_(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 - : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)541)) << 5), "TIME", - (ftnlen)32, (ftnlen)4)) { - pardsc[1] = 4; - pardsc[2] = 1; - } else if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)546)) << 5), "CHARA" - "CTER", (ftnlen)9, (ftnlen)9) == 0) { - pardsc[1] = 1; - -/* To simplify picking up the length specification, compress */ -/* out blanks and parentheses. This should leave us with */ -/* a token of the form */ - -/* CHARACTER* */ - -/* or */ - -/* CHARACTER** */ - - - cmprss_(" ", &c__0, tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)561)) << - 5), tokens + (((i__2 = tokloc - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tokens", i__2, "zzekpdec_", (ftnlen)561)) << 5), ( - ftnlen)1, (ftnlen)32, (ftnlen)32); - cmprss_("(", &c__0, tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)562)) << - 5), tokens + (((i__2 = tokloc - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tokens", i__2, "zzekpdec_", (ftnlen)562)) << 5), ( - ftnlen)1, (ftnlen)32, (ftnlen)32); - cmprss_(")", &c__0, tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)563)) << - 5), tokens + (((i__2 = tokloc - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tokens", i__2, "zzekpdec_", (ftnlen)563)) << 5), ( - ftnlen)1, (ftnlen)32, (ftnlen)32); - if (*(unsigned char *)&tokens[(((i__1 = tokloc - 1) < 20 && 0 <= i__1 - ? i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)566)) << - 5) + 9] != '*') { - setmsg_("Required asterisk missing from character column declara" - "tion: # in declaration: #", (ftnlen)83); - errch_("#", tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)571)) - << 5), (ftnlen)1, (ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - if (*(unsigned char *)&tokens[(((i__1 = tokloc - 1) < 20 && 0 <= i__1 - ? i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)580)) << - 5) + 10] == '*') { - -/* The string length is variable. */ - - pardsc[2] = -1; - } else { - -/* The portion of the token following the asterisk should be a */ -/* string length. */ - - s_copy(msg, " ", (ftnlen)320, (ftnlen)1); - nparsi_(tokens + ((((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)592)) << 5) - + 10), &pardsc[2], msg, &ptr, (ftnlen)22, (ftnlen)320); - if (s_cmp(msg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("String length specification # didn't parse as an in" - "teger in declaration #", (ftnlen)75); - errch_("#", tokens + ((((i__1 = tokloc - 1) < 20 && 0 <= i__1 - ? i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen) - 598)) << 5) + 10), (ftnlen)1, (ftnlen)22); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } - } else { - -/* The type specification is invalid. */ - - setmsg_("Data type specification # is unrecognized in declaration #.", - (ftnlen)59); - errch_("#", tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)614)) << 5), ( - ftnlen)1, (ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - -/* Next, parse the size specification, if we have one. If it's */ -/* valid, it's either the string 'VARIABLE' or it's an integer. */ - - if (attfnd[1]) { - tokloc = attloc[1] + 1; - if (n < tokloc) { - setmsg_("Column size specification did not follow \"SIZE\" keywo" - "rd in declaration #.", (ftnlen)73); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)643)) << 5), - "VARIABLE", (ftnlen)32, (ftnlen)8) == 0) { - -/* Variable size entries are not allowed for CHARACTER*(*) */ -/* columns. */ - - if (pardsc[1] == 1) { - if (pardsc[2] == -1) { - setmsg_("Column size specification was VARIABLE for a CH" - "ARACTER*(*) column in declaration #.", (ftnlen) - 84); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } - pardsc[3] = -1; - } else { - nparsi_(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)669)) << 5), & - pardsc[3], msg, &ptr, (ftnlen)32, (ftnlen)320); - if (s_cmp(msg, " ", (ftnlen)320, (ftnlen)1) != 0) { - setmsg_("Column element size specification # didn't parse a" - "s an integer in in declaration #", (ftnlen)83); - errch_("#", tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen) - 676)) << 5), (ftnlen)1, (ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } - } else { - -/* If the size is not specified, it defaults to 1. */ - - pardsc[3] = 1; - } - -/* The data type and entry size determine the column's class. */ - - if (pardsc[1] == 1) { - -/* The character classes are 3 for scalars, 6 for arrays. */ - - if (pardsc[3] == 1) { - pardsc[0] = 3; - } else { - pardsc[0] = 6; - } - } else if (pardsc[1] == 3) { - -/* The integer classes are 1 for scalars, 4 for arrays. */ - - if (pardsc[3] == 1) { - pardsc[0] = 1; - } else { - pardsc[0] = 4; - } - } else if (pardsc[1] == 2 || pardsc[1] == 4) { - -/* The d.p. classes are 2 for scalars, 6 for arrays. TIME */ -/* values are represented using d.p. classes as well. */ - - if (pardsc[3] == 1) { - pardsc[0] = 2; - } else { - pardsc[0] = 5; - } - } - -/* Parse the `NULLS_OK' clause, if we have one. */ - - if (attfnd[3]) { - tokloc = attloc[3] + 1; - if (n < tokloc) { - setmsg_("Boolean value did not follow \"NULLS_OK\" keyword in de" - "claration #.", (ftnlen)65); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)751)) << 5), - "TRUE", (ftnlen)32, (ftnlen)4) == 0) { - pardsc[7] = 1; - } else if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)755)) << 5) - , "FALSE", (ftnlen)32, (ftnlen)5) == 0) { - pardsc[7] = -1; - } else { - setmsg_("Invalid token # follows NULLS_OK keyword in declaration" - " #. ", (ftnlen)59); - errch_("#", tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)763)) - << 5), (ftnlen)1, (ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } else { - -/* As a default, nulls are not allowed. */ - - pardsc[7] = -1; - } - - -/* Parse the `INDEXED' clause, if we have one. */ - - if (attfnd[2]) { - tokloc = attloc[2] + 1; - if (n < tokloc) { - setmsg_("Boolean value did not follow \"INDEXED\" keyword in dec" - "laration #.", (ftnlen)64); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)802)) << 5), - "TRUE", (ftnlen)32, (ftnlen)4) == 0) { - -/* If we have a fixed-size column whose size is 1, then it's */ -/* possible to index that column. Otherwise, we should not */ -/* have an `INDEXED' clause. */ - - if (pardsc[3] != 1) { - setmsg_("Non-scalar columns cannot be indexed. Declaration w" - "as #.", (ftnlen)56); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - pardsc[5] = 1; - } else if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)821)) << 5) - , "FALSE", (ftnlen)32, (ftnlen)5) == 0) { - pardsc[5] = -1; - } else { - setmsg_("Invalid token # follows INDEXED keyword in declaration " - "#. ", (ftnlen)58); - errch_("#", tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)829)) - << 5), (ftnlen)1, (ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } else { - -/* As a default, the column is not indexed. */ - - pardsc[5] = -1; - } - -/* Parse the `FIXED_COUNT' clause, if we have one. */ - - if (attfnd[4]) { - tokloc = attloc[4] + 1; - if (n < tokloc) { - setmsg_("Boolean value did not follow \"FIXED_COUNT\" keyword in" - " declaration #.", (ftnlen)68); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)867)) << 5), - "TRUE", (ftnlen)32, (ftnlen)4) == 0) { - -/* The column is a fixed-count column. Only scalar columns */ -/* are permitted to have fixed count. We adjust the column */ -/* class to indicate fixed-count columns. */ - - if (pardsc[0] == 1) { - -/* Map scalar integers. */ - - pardsc[0] = 7; - } else if (pardsc[0] == 2) { - -/* Map scalar d.p. numbers. */ - - pardsc[0] = 8; - } else if (pardsc[0] == 3) { - -/* Map scalar strings. */ - - pardsc[0] = 9; - } else { - setmsg_("FIXED_COUNT attribute used in non-scalar column dec" - "laration #. ", (ftnlen)63); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } else if (s_cmp(tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)903)) << 5) - , "FALSE", (ftnlen)32, (ftnlen)5) != 0) { - -/* No action is required if the FIXED_COUNT keyword is set */ -/* to FALSE, but no value other than FALSE or TRUE may appear */ -/* on the RHS. */ - - setmsg_("Invalid token # follows NULLS_OK keyword in declaration" - " #. ", (ftnlen)59); - errch_("#", tokens + (((i__1 = tokloc - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("tokens", i__1, "zzekpdec_", (ftnlen)911)) - << 5), (ftnlen)1, (ftnlen)32); - errch_("#", decl, (ftnlen)1, decl_len); - sigerr_("SPICE(BADCOLUMNDECL)", (ftnlen)20); - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; - } - } - chkout_("ZZEKPDEC", (ftnlen)8); - return 0; -} /* zzekpdec_ */ - diff --git a/ext/spice/src/cspice/zzekpgch.c b/ext/spice/src/cspice/zzekpgch.c deleted file mode 100644 index 232f00237c..0000000000 --- a/ext/spice/src/cspice/zzekpgch.c +++ /dev/null @@ -1,446 +0,0 @@ -/* zzekpgch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__8 = 8; -static integer c__4 = 4; -static integer c__9 = 9; -static integer c__14 = 14; - -/* $Procedure ZZEKPGCH ( EK, paging system access check ) */ -/* Subroutine */ int zzekpgch_(integer *handle, char *access, ftnlen - access_len) -{ - integer topc, topd, topi, unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer lastc, lastd, lasti, id; - extern logical failed_(void); - extern /* Subroutine */ int daslla_(integer *, integer *, integer *, - integer *), dasrdi_(integer *, integer *, integer *, integer *), - dassih_(integer *, char *, ftnlen), dashlu_(integer *, integer *), - errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer npc, npd, npi; - -/* $ Abstract */ - -/* Check that an EK is valid for a specified type of access by the */ -/* paging system. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Architecture Version Parameters */ - -/* ekarch.inc Version 1 01-NOV-1995 (NJB) */ - - -/* The following parameter indicates the EK file architecture */ -/* version. EK files read by the EK system must have the */ -/* architecture expected by the reader software; the architecture ID */ -/* below is used to test for compatibility. */ - -/* Architecture code: */ - - -/* End Include Section: EK Architecture Version Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* ACCESS I Access type. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The specified file is to be */ -/* checked to see whether it is a valid paged EK and */ -/* whether it is open for the specified type of */ -/* access. */ - -/* ACCESS is a short string indicating the type of access */ -/* desired. Possible values are 'READ' and 'WRITE'. */ - -/* Leading and trailing blanks in ACCESS are ignored, */ -/* and case is not significant. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the EK architecture version is not current, the error */ -/* SPICE(WRONGARCHITECTURE) is signalled. */ - -/* 3) If the DAS logical address ranges occupied by the EK are */ -/* not consistent with those recorded by the paging system, */ -/* the error SPICE(INVALIDFORMAT) is signalled. */ - -/* 4) If the EK is not open for the specified type of access, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine centralizes a validation check performed by many */ -/* EK routines. The EK designated by HANDLE is tested to see */ -/* whether some aspects of its structure are valid, and whether */ -/* the specified type of access (read or write) is allowed. */ -/* The tests performed are: */ - -/* - Is the file a DAS file open for the specified type of access? */ - -/* - Is the file's EK architecture version correct? */ - -/* - Are the DAS address ranges in use consistent with those */ -/* recorded in the file by the paging system? */ - -/* If the file fails any test, an error is signalled. */ - -/* $ Examples */ - -/* See EKINSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - chkin_("ZZEKPGCH", (ftnlen)8); - -/* Check whether the DAS is opened for the specified access method. */ - - dassih_(handle, access, access_len); - if (failed_()) { - chkout_("ZZEKPGCH", (ftnlen)8); - return 0; - } - -/* Make sure the DAS file is of the right type. */ - - dasrdi_(handle, &c__1, &c__1, &id); - if (id != 8) { - dashlu_(handle, &unit); - setmsg_("File # has architecture #, which is invalid for paged acces" - "s. You are using EK software version #.", (ftnlen)99); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &id, (ftnlen)1); - errint_("#", &c__8, (ftnlen)1); - sigerr_("SPICE(WRONGARCHITECTURE)", (ftnlen)24); - chkout_("ZZEKPGCH", (ftnlen)8); - return 0; - } - -/* Obtain the page counts. Set the `top' addresses. */ - - dasrdi_(handle, &c__4, &c__4, &npc); - dasrdi_(handle, &c__9, &c__9, &npd); - dasrdi_(handle, &c__14, &c__14, &npi); - topc = npc << 10; - topd = npd << 7; - topi = (npi << 8) + 256; - -/* Verify that the last addresses in use are consistent with the */ -/* `top' addresses known to this system. */ - - daslla_(handle, &lastc, &lastd, &lasti); - if (lastc > topc) { - dashlu_(handle, &unit); - setmsg_("File # has last char address #; `top' = #.", (ftnlen)42); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &lastc, (ftnlen)1); - errint_("#", &topc, (ftnlen)1); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("ZZEKPGCH", (ftnlen)8); - return 0; - } else if (lastd > topd) { - dashlu_(handle, &unit); - setmsg_("File # has last d.p. address #; `top' = #.", (ftnlen)42); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &lastd, (ftnlen)1); - errint_("#", &topd, (ftnlen)1); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("ZZEKPGCH", (ftnlen)8); - return 0; - } else if (lasti > topi) { - dashlu_(handle, &unit); - setmsg_("File # has last int. address #; `top' = #.", (ftnlen)42); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &lasti, (ftnlen)1); - errint_("#", &topi, (ftnlen)1); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("ZZEKPGCH", (ftnlen)8); - return 0; - } - chkout_("ZZEKPGCH", (ftnlen)8); - return 0; -} /* zzekpgch_ */ - diff --git a/ext/spice/src/cspice/zzekqcnj.c b/ext/spice/src/cspice/zzekqcnj.c deleted file mode 100644 index c599288cb3..0000000000 --- a/ext/spice/src/cspice/zzekqcnj.c +++ /dev/null @@ -1,565 +0,0 @@ -/* zzekqcnj.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKQCNJ ( Private: EK, read conjunction sizes from query ) */ -/* Subroutine */ int zzekqcnj_(integer *eqryi, integer *n, integer *size) -{ - integer ntab, ncnj, ncns; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), chkin_(char *, ftnlen); - extern logical failed_(void); - integer iparse; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer loc; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read conjunction sizes from an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of query. */ -/* N I Index within FROM clause of table name to read. */ -/* SIZE O Size of Nth conjunction in WHERE clause. */ - -/* $ Detailed_Input */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* N is the index, within the FROM clause of the query, */ -/* of the table whose name is to be fetched. */ - -/* $ Detailed_Output */ - -/* SIZE is the size of the Nth conjunction of */ -/* constraints in the input encoded query. The size */ -/* applies to the constraints after `normalization'. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been parsed, the error */ -/* SPICE(UNPARSEDQUERY) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If the index N is less than 1 or greater than the number of */ -/* conjunctions in the query, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The outputs will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The call */ - -/* CALL ZZEKREQI ( EQRYI, 'NUM_CONJUNCTIONS', N ) */ - -/* may be used to get the conjunction count from an encoded query. */ - -/* This routine assumes that encoded EK query architecture version */ -/* 1 is to be used with the query to be initialized; this routine */ -/* will not work with any other architecture version. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6); - if (failed_()) { - return 0; - } - if (iparse == -1) { - chkin_("ZZEKQCNJ", (ftnlen)8); - setmsg_("Encoded query has not yet been parsed.", (ftnlen)38); - sigerr_("SPICE(UNPARSEDQUERY)", (ftnlen)20); - chkout_("ZZEKQCNJ", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &ncnj, (ftnlen)16); - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - if (*n < 1 || *n > ncnj) { - chkin_("ZZEKQCNJ", (ftnlen)8); - setmsg_("Table index # is out of valid range 1:#.", (ftnlen)40); - errint_("#", n, (ftnlen)1); - errint_("#", &ncnj, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKQCNJ", (ftnlen)8); - return 0; - } - -/* Compute the location of the requested conjunction size value. */ - - loc = ntab * 12 + 19 + ncns * 26 + *n; - *size = eqryi[loc + 5]; - return 0; -} /* zzekqcnj_ */ - diff --git a/ext/spice/src/cspice/zzekqcon.c b/ext/spice/src/cspice/zzekqcon.c deleted file mode 100644 index 9921f84dbc..0000000000 --- a/ext/spice/src/cspice/zzekqcon.c +++ /dev/null @@ -1,889 +0,0 @@ -/* zzekqcon.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKQCON ( Private: EK, read constraints from query ) */ -/* Subroutine */ int zzekqcon_(integer *eqryi, char *eqryc, doublereal *eqryd, - integer *n, integer *cnstyp, char *ltname, integer *ltidx, char * - lcname, integer *lcidx, integer *opcode, char *rtname, integer *rtidx, - char *rcname, integer *rcidx, integer *dtype, integer *cbeg, integer - *cend, doublereal *dval, integer *ival, ftnlen eqryc_len, ftnlen - ltname_len, ftnlen lcname_len, ftnlen rtname_len, ftnlen rcname_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_dnnt(doublereal *); - - /* Local variables */ - integer base, ntab, ncns; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), chkin_(char *, ftnlen); - integer cb, ce; - extern logical failed_(void); - integer icheck, tb, te; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer ptr; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return elements of a specified constraint from an encoded EK */ -/* query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of query. */ -/* EQRYC I Character component of query. */ -/* EQRYD I Numeric component of query. */ -/* N I Index of constraint to read. */ -/* CNSTYP O Type of constraint (column or value comparison). */ -/* LTNAME O LHS table name. */ -/* LTIDX O LHS table index in FROM clause. */ -/* LCNAME O LHS column name. */ -/* LCIDX O LHS column index in virtual parent table. */ -/* OPCODE O Operation code. */ -/* RTNAME O RHS table name. */ -/* RTIDX O RHS table index in FROM clause. */ -/* RCNAME O RHS column name. */ -/* RCIDX O RHS column index in virtual parent table. */ -/* DTYPE O Data type of RHS value. */ -/* CBEG O Character begin pointer for RHS value. */ -/* CEND O Character end pointer for RHS value. */ -/* DVAL O RHS double precision value. */ -/* IVAL O RHS integer value. */ - -/* $ Detailed_Input */ - -/* EQRYI, */ -/* EQRYC, */ -/* EQRYD are, respectively, the integer, character, and */ -/* numeric components of an encoded EK query. */ -/* The query must have names and values resolved and */ -/* must have been semantically checked. */ - -/* N is the index, within the WHERE clause of the query, */ -/* of the constraint to be fetched. */ - -/* $ Detailed_Output */ - -/* CNSTYP is the constraint type. Possible values are */ - -/* EQCOL ... constraint compares two columns */ -/* EQVAL ... constraint compares column and value */ - -/* LTNAME is the table name for the LHS of the constraint. */ -/* If an alias was supplied in the query, that */ -/* alias is returned. If the column was unqualified, */ -/* LTNAME is returned blank. */ - -/* LTIDX is the index of the LHS table in the FROM clause. */ - -/* LCNAME is the name of the LHS column. */ - -/* LCIDX is the index of the LHS column in the virtual */ -/* table containing the column. */ - -/* OPCODE is the operator code used in the constraint. */ - -/* RTNAME is the table name for the RHS of the constraint. */ -/* RTNAME is meaningful only if the constraint */ -/* compares two columns, as indicated by CNSTYP. */ -/* If an alias was supplied in the query, that */ -/* alias is returned. If the column was unqualified, */ -/* RTNAME is returned blank. */ - -/* RTIDX is the index of the RHS table in the FROM clause. */ -/* RTIDX is meaningful only if the constraint */ -/* compares two columns, as indicated by CNSTYP. */ - -/* RCNAME is the name of the RHS column. RCNAME is */ -/* meaningful only if the constraint compares two */ -/* columns, as indicated by CNSTYP. */ - -/* RCIDX is the index of the RHS column in the virtual */ -/* table containing the column. RCIDX is */ -/* meaningful only if the constraint compares two */ -/* columns, as indicated by CNSTYP. */ - -/* DTYPE is the data type of the value on the RHS of the */ -/* constraint. DTYPE is meaningful only if the */ -/* constraint compares a column against a value, */ -/* as indicated by CNSTYP. */ - -/* CBEG, */ -/* CEND are, respectively, begin and end character pointers */ -/* into the EQRYC array; these pointers give the */ -/* location of a character value on the RHS of a */ -/* query constraint. CBEG and CEND are meaningful */ -/* only if the constraint compares a column against a */ -/* value, as indicated by CNSTYP, and if the value's */ -/* data type is CHR, as indicated by DTYPE. */ - -/* IVAL is an integer value on the RHS of the constraint. */ -/* IVAL is meaningful only if the constraint compares */ -/* a column against a value, as indicated by CNSTYP, */ -/* and if the value's data type is INT, as indicated */ -/* by DTYPE. */ - -/* DVAL is a double precision value on the RHS of the */ -/* constraint. DVAL is meaningful only if the */ -/* constraint compares a column against a value, as */ -/* indicated by CNSTYP, and if the value's data type */ -/* is DP or TIME, as indicated by DTYPE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been semantically checked, the */ -/* error SPICE(NOTSEMCHECKED) will be signaled. The outputs */ -/* will not be modified. */ - -/* 3) If the index N is less than 1 or greater than the number of */ -/* constraints in the query, the error SPICE(INVALIDINDEX) */ -/* will be signaled. The outputs */ -/* will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The call */ - -/* CALL ZZEKREQI ( EQRYI, 'NUM_CONSTRAINTS', N ) */ - -/* may be used to get the constraint count from an encoded query. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-APR-2009 (NJB) */ - -/* Bug fix: this routine now does not attempt to */ -/* read constraint RHS value parameters from the */ -/* encoded query when the RHS value is NULL, as */ -/* indicated by the opcode. */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "SEM_CHECKED", &icheck, (ftnlen)11); - if (failed_()) { - return 0; - } - if (icheck == -1) { - chkin_("ZZEKQCON", (ftnlen)8); - setmsg_("Encoded query has not been semantically checked.", (ftnlen) - 48); - sigerr_("SPICE(NOTSEMCHECKED)", (ftnlen)20); - chkout_("ZZEKQCON", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - if (*n < 1 || *n > ncns) { - chkin_("ZZEKQCON", (ftnlen)8); - setmsg_("Constraint index # is out of valid range 1:#.", (ftnlen)45); - errint_("#", n, (ftnlen)1); - errint_("#", &ncns, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKQCON", (ftnlen)8); - return 0; - } - -/* Compute the base address of the Nth constraint. */ - - base = ntab * 12 + 19 + (*n - 1) * 26; - -/* Get the constraint type. */ - - *cnstyp = eqryi[base + 6]; - -/* Get the LHS items. */ - - *ltidx = eqryi[base + 12]; - tb = eqryi[base + 10]; - te = eqryi[base + 11]; - if (tb != 0) { - s_copy(ltname, eqryc + (tb - 1), ltname_len, te - (tb - 1)); - } else { - s_copy(ltname, " ", ltname_len, (ftnlen)1); - } - *lcidx = eqryi[base + 18]; - cb = eqryi[base + 16]; - ce = eqryi[base + 17]; - s_copy(lcname, eqryc + (cb - 1), lcname_len, ce - (cb - 1)); - -/* Next, the opcode. */ - - *opcode = eqryi[base + 19]; - -/* If the constraint compares two columns, get the RHS table and */ -/* column info. */ - - if (*cnstyp == 1) { - *rtidx = eqryi[base + 25]; - tb = eqryi[base + 23]; - te = eqryi[base + 24]; - if (tb != 0) { - s_copy(rtname, eqryc + (tb - 1), rtname_len, te - (tb - 1)); - } else { - s_copy(rtname, " ", rtname_len, (ftnlen)1); - } - *rcidx = eqryi[base + 31]; - cb = eqryi[base + 29]; - ce = eqryi[base + 30]; - s_copy(rcname, eqryc + (cb - 1), rcname_len, ce - (cb - 1)); - -/* ...and clear out the scalar outputs. */ - - *cbeg = 1; - *cend = 1; - *dval = 0.; - *ival = 0; - } else { - -/* The constraint compares a column and a value. Set the */ -/* appropriate scalar output, and clear out the other outputs. */ - - if (*opcode == 9 || *opcode == 10) { - -/* There's no output value; the opcode implies the value NULL. */ -/* Set the outputs to innocuous defaults. */ - - *cbeg = 1; - *cend = 1; - *dval = 0.; - *ival = 0; - } else { - -/* This is the normal case; set the scalar output values */ -/* according to the RHS data type. */ - - *dtype = eqryi[base + 20]; - if (*dtype == 1) { - *cbeg = eqryi[base + 23]; - *cend = eqryi[base + 24]; - *dval = 0.; - *ival = 0; - } else if (*dtype == 3) { - ptr = eqryi[base + 23]; - *ival = i_dnnt(&eqryd[ptr - 1]); - *dval = 0.; - *cbeg = 1; - *cend = 1; - } else { - -/* The data type is DP or TIME. */ - - ptr = eqryi[base + 23]; - *dval = eqryd[ptr - 1]; - *ival = 0; - *cbeg = 1; - *cend = 1; - } - } - -/* Set the RHS table and column outputs. */ - - *rtidx = 0; - s_copy(rtname, " ", rtname_len, (ftnlen)1); - *rcidx = 0; - s_copy(rtname, " ", rtname_len, (ftnlen)1); - } - return 0; -} /* zzekqcon_ */ - diff --git a/ext/spice/src/cspice/zzekqini.c b/ext/spice/src/cspice/zzekqini.c deleted file mode 100644 index 2b9884e48b..0000000000 --- a/ext/spice/src/cspice/zzekqini.c +++ /dev/null @@ -1,768 +0,0 @@ -/* zzekqini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__27869 = 27869; -static integer c__100 = 100; -static integer c__2000 = 2000; -static integer c__0 = 0; -static integer c__19 = 19; - -/* $Procedure ZZEKQINI ( Private: EK, intialize encoded query ) */ -/* Subroutine */ int zzekqini_(integer *isize, integer *dsize, integer *eqryi, - char *eqryc, doublereal *eqryd, ftnlen eqryc_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), cleard_(integer *, - doublereal *), cleari_(integer *, integer *); - extern logical return_(void); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssizei_(integer *, integer *), appndi_(integer *, - integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Initialize encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ISIZE I Size of integer component of encoded query. */ -/* DSIZE I Size of d.p. component of encoded query. */ -/* EQRYI I-O Integer component of query. */ -/* EQRYC I-O Character component of query. */ -/* EQRYD I-O D.p. component of query. */ - -/* $ Detailed_Input */ - -/* ISIZE is the size of the cell comprising the integer */ -/* component of the encoded query. */ - -/* DSIZE is the size of the array comprising the double */ -/* precision component of the encoded query. */ - -/* EQRYI is an integer array that is to serve as the */ -/* integer portion of an encoded EK query. EQRYI */ -/* will be initialized as an integer cell having */ -/* size ISIZE. */ - -/* EQRYC is a character string that is to serve as */ -/* the character portion of an encoded EK query. */ -/* EQRYC will be set to blank. */ - -/* EQRYD is a double precision array that is to serve as */ -/* the numeric portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI, */ -/* EQRYD, */ -/* EQRYC are the components of an initialized EK query. */ -/* The query's architecture code will be set to 1. */ -/* All counts will be set to zero. The array */ -/* EQRYD will be zeroed out. The character string */ -/* EQRYC will be blank. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) ISIZE must be large enough to accommodate a query with the */ -/* maximum number of tables, constraints, and tokens, and */ -/* indicated by the parameters in ekqlimit.inc. If ISIZE is */ -/* too small, the error SPICE(CELLTOOSMALL) will be signalled. */ - -/* 2) DSIZE must be large enough to accommodate the largest number */ -/* of numeric tokens that can occur in a query. If DSIZE is */ -/* too small, the error SPICE(CELLTOOSMALL) will be signalled. */ - -/* 3) EQRYC must be long enough to accommodate all of the character */ -/* data that can occur in a query. If EQRYC is too short, the */ -/* error SPICE(STRINGTOOSHORT) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine assumes that encoded EK query architecture version */ -/* 1 is to be used with the query to be initialized; this routine */ -/* will not work with any other architecture version. */ - -/* $ Examples */ - -/* See ZZEKPARS. */ - -/* $ Restrictions */ - -/* 1) This routine is private to the EK library. No routines */ -/* external to the EK library should call this routine. */ - -/* 2) Uses EK encoded query architecture version 1. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Minimum upper bound for the integer cell of an encoded query: */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKQINI", (ftnlen)8); - } - -/* Check sizes: */ - - if (*isize < 27869) { - setmsg_("Size of integer component of encoded query is #; at least #" - " elements are required.", (ftnlen)82); - errint_("#", isize, (ftnlen)1); - errint_("#", &c__27869, (ftnlen)1); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - chkout_("ZZEKQINI", (ftnlen)8); - return 0; - } - if (*dsize < 100) { - setmsg_("Size of d.p. component of encoded query is #; at least # el" - "ements are required.", (ftnlen)79); - errint_("#", dsize, (ftnlen)1); - errint_("#", &c__100, (ftnlen)1); - sigerr_("SPICE(CELLTOOSMALL)", (ftnlen)19); - chkout_("ZZEKQINI", (ftnlen)8); - return 0; - } - if (i_len(eqryc, eqryc_len) < 2000) { - setmsg_("Size of character component of encoded query is #; a length" - " of at least # characters is required.", (ftnlen)97); - i__1 = i_len(eqryc, eqryc_len); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__2000, (ftnlen)1); - sigerr_("SPICE(STRINGTOOSHORT)", (ftnlen)21); - chkout_("ZZEKQINI", (ftnlen)8); - return 0; - } - -/* Initialize the integer cell, the d.p. array, and the string. */ - - ssizei_(isize, eqryi); - cleard_(dsize, eqryd); - s_copy(eqryc, " ", eqryc_len, (ftnlen)1); - -/* Append enough elements to the integer cell to contain the */ -/* fixed-size portion of the encoded query: */ - - for (i__ = 1; i__ <= 19; ++i__) { - appndi_(&c__0, eqryi); - } - -/* Clear out the fixed-size portion of the integer cell. */ - - cleari_(&c__19, &eqryi[6]); - -/* Fill in the architecture version. */ - - eqryi[7] = 1; - -/* Set the parse completion and name and time resolution flags to */ -/* indicate `not done': */ - - eqryi[9] = -1; - eqryi[10] = -1; - eqryi[11] = -1; - -/* Set the buffer sizes: */ - - eqryi[20] = i_len(eqryc, eqryc_len); - eqryi[18] = *dsize; - -/* Set the free pointers: */ - - eqryi[19] = 1; - eqryi[21] = 1; - -/* Indicate that initialization has been done: */ - - eqryi[8] = 1; - chkout_("ZZEKQINI", (ftnlen)8); - return 0; -} /* zzekqini_ */ - diff --git a/ext/spice/src/cspice/zzekqord.c b/ext/spice/src/cspice/zzekqord.c deleted file mode 100644 index 9115cf528e..0000000000 --- a/ext/spice/src/cspice/zzekqord.c +++ /dev/null @@ -1,680 +0,0 @@ -/* zzekqord.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKQORD ( Private: EK, read order-by columns from query ) */ -/* Subroutine */ int zzekqord_(integer *eqryi, char *eqryc, integer *n, char * - table, integer *tabidx, char *column, integer *colidx, integer *sense, - ftnlen eqryc_len, ftnlen table_len, ftnlen column_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer base, ntab, ncnj, ncns, nord; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), chkin_(char *, ftnlen); - integer cb, ce; - extern logical failed_(void); - integer tb, te, buflen, iparse, resolv; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a specified order-by table and column name, along with the */ -/* corresponding order sense, from an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of query. */ -/* EQRYC I Character component of query. */ -/* N I Index within FROM clause of table name to read. */ -/* TABLE O Name of table qualifying Nth ORDER BY column. */ -/* TABIDX O Index of TABLE in FROM clause, if known. */ -/* COLUMN O Nth column in ORDER BY clause of query. */ -/* TABIDX O Index of column in TABLE, if known. */ -/* SENSE O Code giving order sense for Nth column. */ - -/* $ Detailed_Input */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* N is the index, within the ORDER BY clause of the */ -/* query, of the table whose name is to be fetched. */ - -/* $ Detailed_Output */ - -/* TABLE is the table name or alias associated with the Nth */ -/* column in the ORDER BY clause of an the input */ -/* encoded query. If the Nth column is unqualified, */ -/* TABLE is returned blank. */ - -/* TABIDX is the ordinal position in the FROM clause of the */ -/* input query of the table containing the Nth order- */ -/* by column. TABIDX is meaningful only if name */ -/* resolution has not been performed on the input */ -/* query; otherwise, TABIDX is returned as zero. */ - -/* COLUMN is the name of the Nth column in the ORDER BY */ -/* clause of an the input encoded query. */ - -/* COLIDX is the ordinal position of the Nth column in the */ -/* ORDER BY clause with respect to the virtual table */ -/* designated by TABLE. This index is available only */ -/* if the query has already had names resolved; */ -/* otherwise, COLIDX is returned as zero. */ - -/* SENSE is an integer code giving the ordering sense to */ -/* use with the specified column. The possible values */ -/* of SENSE are EQASND, which indicates that the */ -/* order sense is acscending, and EQDSND, which */ -/* indicates that the order sense is descending. */ -/* `Ascending order' means that the order relation */ -/* defined by the indicated column orders rows */ -/* according to the order of elements in the */ -/* indicated order-by column; `descending order' means */ -/* that the order relation orders columns in the */ -/* reverse of ascending order. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been parsed, the error */ -/* SPICE(UNPARSEDQUERY) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If the index N is less than 1 or greater than the number of */ -/* columns in the ORDER BY clause, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The outputs */ -/* will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The call */ - -/* CALL ZZEKREQI ( EQRYI, 'NUM_ORDERBY_COLS', N ) */ - -/* may be used to get the ORDER BY column count from an encoded */ -/* query. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6); - if (failed_()) { - return 0; - } - if (iparse == -1) { - chkin_("ZZEKQORD", (ftnlen)8); - setmsg_("Encoded query has not yet been parsed.", (ftnlen)38); - sigerr_("SPICE(UNPARSEDQUERY)", (ftnlen)20); - chkout_("ZZEKQORD", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "NUM_ORDERBY_COLS", &nord, (ftnlen)16); - if (*n < 1 || *n > nord) { - chkin_("ZZEKQORD", (ftnlen)8); - setmsg_("Column index # is out of valid range 1:#.", (ftnlen)41); - errint_("#", n, (ftnlen)1); - errint_("#", &nord, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKQORD", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &ncnj, (ftnlen)16); - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - zzekreqi_(eqryi, "CHR_BUF_SIZE", &buflen, (ftnlen)12); - -/* Get the Nth table and column from the query. The table */ -/* descriptor lies beyond the fixed-size portion of the query, the */ -/* conjunction size list, and the constraint descriptors, as */ -/* well as the (N-1) previous order-by column descriptors. */ - - base = ntab * 12 + 19 + ncnj + ncns * 26 + (*n - 1) * 13; - -/* Pick up the column name first. */ - - cb = eqryi[base + 15]; - ce = eqryi[base + 16]; - if (cb > 0 && ce > 0 && cb <= buflen && ce <= buflen && cb <= ce) { - s_copy(column, eqryc + (cb - 1), column_len, ce - (cb - 1)); - } else { - -/* We should never see invalid pointers in a parsed, encoded */ -/* query, but let's not take chances. */ - - chkin_("ZZEKQORD", (ftnlen)8); - setmsg_("Invalid string bounds #:# for column #.", (ftnlen)39); - errint_("#", &cb, (ftnlen)1); - errint_("#", &ce, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKQORD", (ftnlen)8); - return 0; - } - -/* Same deal for the qualifying table or alias, except that the begin */ -/* pointer is set to zero if there's no name. */ - - tb = eqryi[base + 9]; - te = eqryi[base + 10]; - if (tb > 0) { - if (te > 0 && tb <= buflen && te <= buflen && tb <= te) { - s_copy(table, eqryc + (tb - 1), table_len, te - (tb - 1)); - } else { - -/* If the first pointer is non-zero, both pointers should have */ -/* been valid. */ - - chkin_("ZZEKQORD", (ftnlen)8); - setmsg_("Invalid string bounds #:# for the table qualifying colu" - "mn #.", (ftnlen)60); - errint_("#", &tb, (ftnlen)1); - errint_("#", &te, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKQORD", (ftnlen)8); - return 0; - } - } else { - -/* No table was supplied. */ - - s_copy(table, " ", table_len, (ftnlen)1); - } - -/* Set the order sense. */ - - *sense = eqryi[base + 18]; - -/* If names have been resolved already, we can determine the index */ -/* of the table to which the specified order-by column belongs. */ - - zzekreqi_(eqryi, "NAMES_RESOLVED", &resolv, (ftnlen)14); - if (resolv == 1) { - -/* The qualifying table's index in the FROM clause is available. */ -/* So is the index of the column within the table. */ - - *tabidx = eqryi[base + 11]; - *colidx = eqryi[base + 17]; - } else { - *tabidx = 0; - *colidx = 0; - } - return 0; -} /* zzekqord_ */ - diff --git a/ext/spice/src/cspice/zzekqsel.c b/ext/spice/src/cspice/zzekqsel.c deleted file mode 100644 index 8022c065b8..0000000000 --- a/ext/spice/src/cspice/zzekqsel.c +++ /dev/null @@ -1,694 +0,0 @@ -/* zzekqsel.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKQSEL ( Private: EK, read SELECT columns from query ) */ -/* Subroutine */ int zzekqsel_(integer *eqryi, char *eqryc, integer *n, - integer *lxbeg, integer *lxend, char *table, integer *tabidx, char * - column, integer *colidx, ftnlen eqryc_len, ftnlen table_len, ftnlen - column_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer base, ntab, ncnj, ncns, nord, nsel; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), chkin_(char *, ftnlen); - integer cb, ce; - extern logical failed_(void); - integer tb, te, buflen, iparse, resolv; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read a specified SELECT clause table and column name from an */ -/* encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of query. */ -/* EQRYC I Character component of query. */ -/* N I Index within SELECT clause of table name to read. */ -/* LXBEG O Begin index in query of selected item. */ -/* LXEND O End index in query of selected item. */ -/* TABLE O Name of table qualifying Nth SELECT column. */ -/* TABIDX O Index of TABLE in FROM clause, if known. */ -/* COLUMN O Nth column in SELECT clause of query. */ -/* TABIDX O Index of column in TABLE, if known. */ - -/* $ Detailed_Input */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* N is the index, within the SELECT clause of the */ -/* query, of the table whose name is to be fetched. */ - -/* $ Detailed_Output */ - -/* LXBEG, */ -/* LXEND are, respectively, the begin and end indices in */ -/* the original query of the selected item. */ - -/* TABLE is the table name or alias associated with the Nth */ -/* column in the SELECT clause of an the input */ -/* encoded query. If the Nth column is unqualified, */ -/* TABLE is returned blank. */ - -/* TABIDX is the ordinal position in the FROM clause of the */ -/* input query of the table containing the Nth order- */ -/* by column. TABIDX is meaningful only if name */ -/* resolution has not been performed on the input */ -/* query; otherwise, TABIDX is returned as zero. */ - -/* COLUMN is the name of the Nth column in the SELECT */ -/* clause of an the input encoded query. */ - -/* COLIDX is the ordinal position of the Nth column in the */ -/* SELECT clause with respect to the virtual table */ -/* designated by TABLE. This index is available only */ -/* if the query has already had names resolved; */ -/* otherwise, COLIDX is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been parsed, the error */ -/* SPICE(UNPARSEDQUERY) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If the index N is less than 1 or greater than the number of */ -/* columns in the SELECT clause, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The outputs */ -/* will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The call */ - -/* CALL ZZEKREQI ( EQRYI, 'NUM_SELECT_COLS', N ) */ - -/* may be used to get the SELECT column count from an encoded */ -/* query. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6); - if (failed_()) { - return 0; - } - if (iparse == -1) { - chkin_("ZZEKQSEL", (ftnlen)8); - setmsg_("Encoded query has not yet been parsed.", (ftnlen)38); - sigerr_("SPICE(UNPARSEDQUERY)", (ftnlen)20); - chkout_("ZZEKQSEL", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "NUM_SELECT_COLS", &nsel, (ftnlen)15); - if (*n < 1 || *n > nsel) { - chkin_("ZZEKQSEL", (ftnlen)8); - setmsg_("Column index # is out of valid range 1:#.", (ftnlen)41); - errint_("#", n, (ftnlen)1); - errint_("#", &nsel, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKQSEL", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &ncnj, (ftnlen)16); - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - zzekreqi_(eqryi, "NUM_ORDERBY_COLS", &nord, (ftnlen)16); - zzekreqi_(eqryi, "CHR_BUF_SIZE", &buflen, (ftnlen)12); - -/* The lexeme begin and end values start out as invalid values. */ -/* We'll set these when we discover what form the SELECT item has. */ - - - *lxbeg = 0; - *lxend = 0; - -/* Get the Nth table and column from the query. The table */ -/* descriptor lies beyond the fixed-size portion of the query, the */ -/* conjunction size list, the constraint descriptors, the order-by */ -/* column descriptors, as well as the (N-1) previous SELECT column */ -/* descriptors. */ - - base = ntab * 12 + 19 + ncnj + ncns * 26 + nord * 13 + (*n - 1) * 12; - -/* Pick up the column name first. */ - - cb = eqryi[base + 15]; - ce = eqryi[base + 16]; - if (cb > 0 && ce > 0 && cb <= buflen && ce <= buflen && cb <= ce) { - s_copy(column, eqryc + (cb - 1), column_len, ce - (cb - 1)); - -/* The end of the column name is always the end of the SELECT */ -/* item, at least until we handle more general expressions. */ - - *lxend = eqryi[base + 14]; - } else { - -/* We should never see invalid pointers in a parsed, encoded */ -/* query, but let's not take chances. */ - - chkin_("ZZEKQSEL", (ftnlen)8); - setmsg_("Invalid string bounds #:# for column #.", (ftnlen)39); - errint_("#", &cb, (ftnlen)1); - errint_("#", &ce, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKQSEL", (ftnlen)8); - return 0; - } - -/* Same deal for the qualifying table or alias, except that the begin */ -/* pointer is set to zero if there's no name. */ - - tb = eqryi[base + 9]; - te = eqryi[base + 10]; - if (tb > 0) { - if (te > 0 && tb <= buflen && te <= buflen && tb <= te) { - s_copy(table, eqryc + (tb - 1), table_len, te - (tb - 1)); - -/* The start position of the table name is the start of */ -/* the SELECT item. */ - - *lxbeg = eqryi[base + 7]; - } else { - -/* If the first pointer is non-zero, both pointers should have */ -/* been valid. */ - - chkin_("ZZEKQSEL", (ftnlen)8); - setmsg_("Invalid string bounds #:# for the table qualifying colu" - "mn #.", (ftnlen)60); - errint_("#", &tb, (ftnlen)1); - errint_("#", &te, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKQSEL", (ftnlen)8); - return 0; - } - } else { - -/* No table was supplied. */ - - s_copy(table, " ", table_len, (ftnlen)1); - -/* The start position of the column name is the start of */ -/* the SELECT item. */ - - *lxbeg = eqryi[base + 13]; - } - -/* If names have been resolved already, we can determine the index */ -/* of the table to which the specified order-by column belongs. */ - - zzekreqi_(eqryi, "NAMES_RESOLVED", &resolv, (ftnlen)14); - if (resolv == 1) { - -/* The qualifying table's index in the FROM clause is available. */ -/* So is the index of the column within the table. */ - - *tabidx = eqryi[base + 11]; - *colidx = eqryi[base + 17]; - } else { - *tabidx = 0; - *colidx = 0; - } - return 0; -} /* zzekqsel_ */ - diff --git a/ext/spice/src/cspice/zzekqtab.c b/ext/spice/src/cspice/zzekqtab.c deleted file mode 100644 index 803f4ec887..0000000000 --- a/ext/spice/src/cspice/zzekqtab.c +++ /dev/null @@ -1,623 +0,0 @@ -/* zzekqtab.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKQTAB ( Private: EK, read table names from query ) */ -/* Subroutine */ int zzekqtab_(integer *eqryi, char *eqryc, integer *n, char * - table, char *alias, ftnlen eqryc_len, ftnlen table_len, ftnlen - alias_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer base, ntab; - extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *, - ftnlen), chkin_(char *, ftnlen); - integer ab, ae; - extern logical failed_(void); - integer tb, te, buflen, iparse; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read table names and aliases from an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of query. */ -/* EQRYC I Character component of query. */ -/* N I Index within FROM clause of table name to read. */ -/* TABLE O Name of Nth table in FROM clause. */ -/* ALIAS O Alias of Nth table in FROM clause. */ - -/* $ Detailed_Input */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* N is the index, within the FROM clause of the query, */ -/* of the table whose name is to be fetched. */ - -/* $ Detailed_Output */ - -/* TABLE is the name of the Nth table in the FROM clause of */ -/* the input encoded query. */ - -/* ALIAS is the alias of TABLE. If no alias for TABLE is */ -/* present, ALIAS is returned blank. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If the input query has not been parsed, the error */ -/* SPICE(UNPARSEDQUERY) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If the index N is less than 1 or greater than the number of */ -/* tables in the FROM clause, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The outputs */ -/* will not be modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The call */ - -/* CALL ZZEKREQI ( EQRYI, 'NUM_TABLES', N ) */ - -/* may be used to get the FROM table count from an encoded query. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6); - if (failed_()) { - return 0; - } - if (iparse == -1) { - chkin_("ZZEKQTAB", (ftnlen)8); - setmsg_("Encoded query has not yet been parsed.", (ftnlen)38); - sigerr_("SPICE(UNPARSEDQUERY)", (ftnlen)20); - chkout_("ZZEKQTAB", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "CHR_BUF_SIZE", &buflen, (ftnlen)12); - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - if (*n < 1 || *n > ntab) { - chkin_("ZZEKQTAB", (ftnlen)8); - setmsg_("Table index # is out of valid range 1:#.", (ftnlen)40); - errint_("#", n, (ftnlen)1); - errint_("#", &ntab, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKQTAB", (ftnlen)8); - return 0; - } - -/* Get the Nth table and alias from the query. The table */ -/* descriptor lies beyond the fixed-size portion of the query, as */ -/* well as the (N-1) previous descriptors, each one of which has */ -/* size 2*EQVDSZ. */ - - base = (*n - 1) * 12 + 19; - tb = eqryi[base + 9]; - te = eqryi[base + 10]; - if (tb > 0 && te > 0 && tb <= buflen && te <= buflen && tb <= te) { - s_copy(table, eqryc + (tb - 1), table_len, te - (tb - 1)); - } else { - -/* We should never see invalid pointers in a parsed, encoded */ -/* query, but let's not take chances. */ - - chkin_("ZZEKQTAB", (ftnlen)8); - setmsg_("Invalid string bounds #:# for table #.", (ftnlen)38); - errint_("#", &tb, (ftnlen)1); - errint_("#", &te, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKQTAB", (ftnlen)8); - return 0; - } - -/* Same deal for the alias, except that the begin pointer is */ -/* set to zero if there's no alias. */ - - ab = eqryi[base + 15]; - ae = eqryi[base + 16]; - if (ab > 0) { - if (ae > 0 && ab <= buflen && ae <= buflen && ab <= ae) { - s_copy(alias, eqryc + (ab - 1), alias_len, ae - (ab - 1)); - } else { - -/* If the first pointer is non-zero, both pointers should have */ -/* been valid. */ - - chkin_("ZZEKQTAB", (ftnlen)8); - setmsg_("Invalid string bounds #:# for the alias of table #.", ( - ftnlen)51); - errint_("#", &ab, (ftnlen)1); - errint_("#", &ae, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKQTAB", (ftnlen)8); - return 0; - } - } else { - -/* No alias was supplied. */ - - s_copy(alias, " ", alias_len, (ftnlen)1); - } - return 0; -} /* zzekqtab_ */ - diff --git a/ext/spice/src/cspice/zzekrbck.c b/ext/spice/src/cspice/zzekrbck.c deleted file mode 100644 index 10274f61d7..0000000000 --- a/ext/spice/src/cspice/zzekrbck.c +++ /dev/null @@ -1,834 +0,0 @@ -/* zzekrbck.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRBCK ( EK, record backup ) */ -/* Subroutine */ int zzekrbck_(char *action, integer *handle, integer *segdsc, - integer *coldsc, integer *recno, ftnlen action_len) -{ - integer i__; - char tmpchr[1]; - -/* $ Abstract */ - -/* Back up a modified EK record belonging to a shadowed EK. */ -/* This is a stub routine. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action necessitating backup. */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record number. */ - -/* $ Detailed_Input */ - -/* ACTION is a short string indicating the action taken */ -/* that necessitated backing up a record from the */ -/* specified EK file. Values and meanings of */ -/* ACTION are: */ - -/* 'ADD' The indicated record is being */ -/* added to the input EK. No data */ -/* is backed up in this case, since */ -/* a rollback will remove the */ -/* indicated record from the input */ -/* EK file. */ - -/* 'UPDATE' The indicated record is being */ -/* updated. When ACTION indicates a */ -/* record update, the argument COLDSC */ -/* (see below) indicates the column */ -/* that was affected. If the */ -/* specified column entry has not yet */ -/* been backed up, it will be. */ -/* Otherwise, no action is taken. */ - -/* 'DELETE' The indicated record is being */ -/* deleted from the input EK. If the */ -/* record has been added since the */ -/* last commit, no data from the */ -/* record is backed up, but a */ -/* placeholder record is created. */ -/* If the record to be deleted */ -/* existed at the time of the last */ -/* commit, the entire original */ -/* record is backed up. */ - - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment from which to */ -/* delete the specified column entry. */ - -/* COLDSC is the descriptor of the column from which to */ -/* delete the specified column entry. COLDSC is */ -/* ignored unless ACTION is set to 'UPDATE'. */ - -/* RECNO is the number of the record containing the column */ -/* entry to back up. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it performs record backup */ -/* functions to support EK shadowing. If the input file is not */ -/* shadowed, this routine returns without taking any action. */ - -/* This routine uses a shadow EK file to store sufficient information */ -/* to restore the data in an EK file to its state at the time of */ -/* the last commit. The segments in the backup file are in */ -/* one-to-one correspondence with the modified segments of loaded */ -/* EK files. If the backup file doesn't contain a backup */ -/* segment corresponding to the specified segment in the input file, */ -/* a new backup segment is started. */ - -/* Whenever this routine is called, it modifies the backup segment */ -/* as necessary to reflect changes made to the source segment. */ -/* The actions taken are as follows: */ - -/* Updates */ -/* ------- */ - -/* The first time an OLD record is updated, a backup record is */ -/* created for that record. The old value of the updated column */ -/* entry is saved in the backup record. The status of the */ -/* source record becomes UPDATE. The status of the backup */ -/* record is OLD. */ - -/* Updates to unmodified entries in an UPDATEd record cause the */ -/* original values of those entries to be stored in the backup */ -/* record. Unmodified entries are not backed up. Once an entry */ -/* has been updated, further updates to that entry do not cause */ -/* any backup action to be taken. */ - -/* Updates to NEW records do not result in any action. */ - - -/* Additions */ -/* --------- */ - -/* When a new record is added to the source segment, an empty */ -/* record is appended to the backup segment. The backup record */ -/* has status NEW and points back to the new source record. Note */ -/* that this backward pointer is guaranteed to be valid only when */ -/* the source record occupies its current ordinal position in the */ -/* source segment. */ - - -/* Deletions */ -/* --------- */ - -/* When any record is deleted from the source segment, a backup */ -/* record is appended to the backup segment. The backup record */ -/* has a pointer to the corresponding source record. The pointer */ -/* is the record number of the deleted record at the time of */ -/* deletion. If the deleted record had NEW status, the backup */ -/* record is empty and has DELNEW status. If the deleted record */ -/* had OLD or UPDATE status, the backup record is a copy of the */ -/* original state of the deleted record and has DELOLD status. */ - -/* When a rollback is performed, the set of backup records that */ -/* denote additions and deletions is processed in LIFO order. Each */ -/* record with DELETE status is copied to the source segment and */ -/* inserted at the ordinal position indicated by its backward */ -/* pointer. Records with NEW status signal that the corresponding */ -/* source records are to be deleted. Backup records having OLD */ -/* status are ignored during this step. The inversion of additions */ -/* and deletions performed on the source segment ensures that */ -/* the backup records' pointers to source records are valid at the */ -/* time they are referenced. After all insertions and deletions */ -/* are processed, all records having UPDATE status in the source */ -/* segment are returned to their original status by copying values */ -/* from their backup records into the corresponding column entries. */ -/* Forward pointers in the source records are used to identify the */ -/* corresponding backup records. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) This is a stub version of the routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */ - -/* -& */ - *(unsigned char *)tmpchr = *(unsigned char *)action; - i__ = *handle; - i__ = segdsc[0]; - i__ = coldsc[0]; - i__ = *recno; - return 0; -} /* zzekrbck_ */ - diff --git a/ext/spice/src/cspice/zzekrcmp.c b/ext/spice/src/cspice/zzekrcmp.c deleted file mode 100644 index a4bf5c5a3a..0000000000 --- a/ext/spice/src/cspice/zzekrcmp.c +++ /dev/null @@ -1,798 +0,0 @@ -/* zzekrcmp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__24 = 24; -static integer c__11 = 11; - -/* $Procedure ZZEKRCMP ( EK, row comparison ) */ -logical zzekrcmp_(integer *op, integer *ncols, integer *han1, integer *sgdsc1, - integer *cdlst1, integer *row1, integer *elts1, integer *han2, - integer *sgdsc2, integer *cdlst2, integer *row2, integer *elts2) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - integer hans[2], elts[2], rows[2]; - extern integer zzekecmp_(integer *, integer *, integer *, integer *, - integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), movei_(integer *, - integer *, integer *); - integer cldscs[22] /* was [11][2] */, sgdscs[48] /* was [24][2] */; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer col, rel; - -/* $ Abstract */ - -/* Compare two EK rows, using as the order relation dictionary */ -/* ordering on a specified list of columns. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* OP I Code for relational operator. */ -/* NCOLS I Number of columns used to define order relation. */ -/* HAN1 I Handle of EK containing first row to compare. */ -/* SGDSC1 I Descriptor of segment containing first row. */ -/* ROW1 I Number of first row (relative to segment). */ -/* ELTS1 I List of element indices for first row. */ -/* CDLST1 I List of column descriptors for first row. */ -/* HAN2 I Handle of EK containing second row to compare. */ -/* SGDSC2 I Descriptor of segment containing second row. */ -/* ROW2 I Number of second row (relative to segment). */ -/* CDLST2 I List of column descriptors for second row. */ -/* ELTS2 I List of element indices for second row. */ - -/* The function returns .TRUE. if and only if the two rows */ -/* satisfy the order relation specified by the input arguments. */ - -/* $ Detailed_Input */ - -/* OP is an integer code representing a binary operator */ -/* that expresses an order relation. The allowed */ -/* values of OP are the parameters */ - -/* EQ */ -/* GE */ -/* GT */ -/* LE */ -/* LT */ -/* NE */ - -/* This routine test whether the input rows satisfy */ -/* the order relation */ - -/* OP */ - - -/* NCOLS is the number of columns used to define a */ -/* dictionary ordering. */ - -/* HAN1 is the file handle of the EK containing the first */ -/* row. */ - -/* SGDSC1 is the segment descriptor of the EK segment */ -/* containing the first of the two rows to be */ -/* compared. */ - -/* CDLST1 is a list of column descriptors. These descriptors */ -/* identify the columns that define the dictionary */ -/* ordering used to compare the input rows. */ - -/* ROW1 is the row number of the first row to be compared. */ - -/* ELTS1 is a list of column entry element indices for the */ -/* first row. These indices identify the elements */ -/* to be used in the row comparison. The value of */ -/* ELTS1(I) is used only if the column specified by */ -/* the Ith column descriptor of CDLST1 is */ -/* array-valued. */ - -/* HAN2 is the file handle of the EK containing the second */ -/* row to be compared. */ - -/* SGDSC2 is the segment descriptor of the EK segment */ -/* containing the second row. */ - -/* CDLST2 is a list of column descriptors for the second row. */ -/* This list parallels CDLST1: the Nth descriptor */ -/* in CDLST2 is for a column having the same name and */ -/* attributes as that designated by the Nth descriptor */ -/* in CDLST1. */ - -/* ROW2 is the row number of the second row. */ - -/* ELTS2 is a list of column entry element indices for the */ -/* second row. These indices identify the elements */ -/* to be used in the row comparison. The value of */ -/* ELTS2(I) is used only if the column specified by */ -/* the Ith column descriptor of CDLST2 is */ -/* array-valued. */ - -/* $ Detailed_Output */ - -/* The function returns .TRUE. if and only if the two rows satisfy */ -/* the order relation specified by the input arguments: */ - -/* OP */ - -/* The ordering used to compare the rows is a dictionary ordering */ -/* defined by the column descriptor lists CDLST1 and CDLST2. The */ -/* order relationship between the columns is determined by comparing */ -/* the entries in both rows in the column identified by CDLST1(*,1) */ -/* and CDLST2(*,1); if these column entries are equal, the entries */ -/* identified by CDLST1(*,2) and CDLST2(*,2) are compared, and so */ -/* on, until the tie is broken or all of the specified column entries */ -/* have been compared. */ - -/* $ Parameters */ - -/* Within the EK system, relational operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. In the character case, the same operators */ -/* may be used; the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - -/* Null values are considered to precede all non-null values. */ - -/* $ Exceptions */ - -/* 1) If the either of input file handles is invalid, the error */ -/* will be diagnosed by routines called by this routine. */ -/* The function value is .FALSE. in this case. */ - -/* 2) If an I/O error occurs while attempting to find the address */ -/* range of the specified column entry element, the error will */ -/* be diagnosed by routines called by this routine. The */ -/* function value is .FALSE. in this case. */ - -/* 3) If any of the input segment descriptors, column descriptors, */ -/* or row numbers are invalid, this routine may fail in */ -/* unpredictable, but possibly spectacular, ways. Except */ -/* as described in this header section, no attempt is made to */ -/* handle these errors. */ - -/* 4) If the data type code in the input column descriptor is not */ -/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* 5) If the relational operator code OP is not recognized, the */ -/* error SPICE(UNNATURALRELATION) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* $ Files */ - -/* See the descriptions of the arguments HAN1 and HAN2 in */ -/* $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is an EK utility intended to centralize a frequently */ -/* performed comparison operation. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 02-JAN-2007 (EDW) */ - -/* Edited to remove typo in function declaration. */ -/* Declaration included an extraneous continutation */ -/* marker. */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - -/* The function value defaults to .FALSE. */ - - ret_val = FALSE_; - -/* The input column descriptors identify the columns to be used */ -/* to define an order relation on the input rows. The order */ -/* relation is `dictionary' ordering: if the elements of the */ -/* first n columns of both rows are equal, the corresponding */ -/* elements in the (n+1)st columns are compared to attempt to */ -/* break the tie. */ - -/* The first step is to determine the relation that holds between */ -/* the rows. We start out assuming we have equality. */ - - hans[0] = *han1; - hans[1] = *han2; - movei_(sgdsc1, &c__24, sgdscs); - movei_(sgdsc2, &c__24, &sgdscs[24]); - rows[0] = *row1; - rows[1] = *row2; - rel = 1; - col = 1; - while(col <= *ncols && rel == 1) { - -/* Compare the entries in the two rows in the columns indicated */ -/* by the Nth column descriptor pair. */ - - movei_(&cdlst1[col * 11 - 11], &c__11, cldscs); - movei_(&cdlst2[col * 11 - 11], &c__11, &cldscs[11]); - elts[0] = elts1[col - 1]; - elts[1] = elts2[col - 1]; - rel = zzekecmp_(hans, sgdscs, cldscs, rows, elts); - -/* We've completed the comparison for the column numbered COL. */ - - ++col; - } - -/* Determine the truth of the input relational expression. */ - - if (*op == 1) { - ret_val = rel == 1; - } else if (*op == 5) { - ret_val = rel == 5; - } else if (*op == 4) { - ret_val = rel != 3; - } else if (*op == 3) { - ret_val = rel == 3; - } else if (*op == 2) { - ret_val = rel != 5; - } else if (*op == 6) { - ret_val = rel != 1; - } else { - -/* Sorry, we couldn't resist. */ - - ret_val = FALSE_; - chkin_("ZZEKRCMP", (ftnlen)8); - setmsg_("The relational operator # was not recognized.", (ftnlen)45); - errint_("#", op, (ftnlen)1); - sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24); - chkout_("ZZEKRCMP", (ftnlen)8); - return ret_val; - } - return ret_val; -} /* zzekrcmp_ */ - diff --git a/ext/spice/src/cspice/zzekrd01.c b/ext/spice/src/cspice/zzekrd01.c deleted file mode 100644 index 80d027ded4..0000000000 --- a/ext/spice/src/cspice/zzekrd01.c +++ /dev/null @@ -1,777 +0,0 @@ -/* zzekrd01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRD01 ( EK, read class 1 column entry ) */ -/* Subroutine */ int zzekrd01_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *ival, logical *isnull) -{ - integer nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer colidx, datptr, ptrloc; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Read a column entry from a specified record in a class 1 column. */ -/* Class 1 columns contain scalar integer values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* IVAL O Integer value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* $ Detailed_Output */ - -/* IVAL is the value read from the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the column */ -/* entry is null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the specified column entry has not been initialized, the */ -/* error SPICE(UNINITIALIZEDVALUE) is signalled. */ - -/* 3) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 1 columns. */ - -/* $ Examples */ - -/* See EKRCEI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD01", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " - "EK = #", (ftnlen)65); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD01", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Just read the value. */ - - dasrdi_(handle, &datptr, &datptr, ival); - *isnull = FALSE_; - } else if (datptr == -2) { - -/* The value is null. */ - - *isnull = TRUE_; - } else if (datptr == -1 || datptr == -3) { - -/* The data value is absent. This is an error. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD01", (ftnlen)8); - setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" - "OLIDX = #; RECNO = #; EK = #", (ftnlen)87); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25); - chkout_("ZZEKRD01", (ftnlen)8); - return 0; - } else { - -/* The data pointer is corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD01", (ftnlen)8); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRD01", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrd01_ */ - diff --git a/ext/spice/src/cspice/zzekrd02.c b/ext/spice/src/cspice/zzekrd02.c deleted file mode 100644 index ea56af6846..0000000000 --- a/ext/spice/src/cspice/zzekrd02.c +++ /dev/null @@ -1,772 +0,0 @@ -/* zzekrd02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRD02 ( EK, read class 2 column entry ) */ -/* Subroutine */ int zzekrd02_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, doublereal *dval, logical *isnull) -{ - integer nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dasrdi_(integer *, integer *, integer *, integer *) - ; - integer colidx, datptr, ptrloc; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), errfnm_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Read a column entry from a specified record in a class 2 column. */ -/* Class 2 columns contain scalar double precision values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* DVAL O Double precision value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* $ Detailed_Output */ - -/* DVAL is the value read from the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the specified column entry has not been initialized, the */ -/* error SPICE(UNINITIALIZEDVALUE) is signalled. */ - -/* 3) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 2 columns. */ - -/* $ Examples */ - -/* See EKRCED. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - dashlu_(handle, &unit); - chkin_("ZZEKRD02", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD02", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Just read the value. */ - - dasrdd_(handle, &datptr, &datptr, dval); - *isnull = FALSE_; - } else if (datptr == -2) { - -/* The value is null. */ - - *isnull = TRUE_; - } else if (datptr == -1 || datptr == -3) { - -/* The data value is absent. This is an error. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD02", (ftnlen)8); - setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" - "OLIDX = #; RECNO = #; EK = #", (ftnlen)87); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25); - chkout_("ZZEKRD02", (ftnlen)8); - return 0; - } else { - -/* The data pointer is corrupted. */ - - dashlu_(handle, &unit); - chkin_("ZZEKRD02", (ftnlen)8); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRD02", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrd02_ */ - diff --git a/ext/spice/src/cspice/zzekrd03.c b/ext/spice/src/cspice/zzekrd03.c deleted file mode 100644 index d6c0fd551e..0000000000 --- a/ext/spice/src/cspice/zzekrd03.c +++ /dev/null @@ -1,952 +0,0 @@ -/* zzekrd03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKRD03 ( EK, read class 3 column entry elements ) */ -/* Subroutine */ int zzekrd03_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *cvlen, char *cval, logical *isnull, - ftnlen cval_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer nrec, bpos; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer epos, unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *); - integer b, e, l, n, p, pbase, avail; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer recno, ncols; - extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen), dasrdi_(integer *, integer - *, integer *, integer *); - char column[32]; - integer colidx, datptr, relptr, ptrloc; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzekgei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Read a column entry from a specified record in a class 3 column. */ -/* Class 3 columns contain scalar character values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* CVLEN O Length of returned character value. */ -/* CVAL O Character value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* $ Detailed_Output */ - -/* CVLEN is the length of the returned string value. This */ -/* is the index of the last non-blank character of */ -/* the string. This definition applies to both fixed- */ -/* and variable-length strings. */ - -/* CVLEN is set to 1 if the column entry is null. */ - -/* CVAL is the value read from the specified column entry. */ -/* If CVAL has insufficient length to hold the */ -/* returned string value, the output value is */ -/* truncated on the right. Entries that are shorter */ -/* than the string length of CVAL are padded with */ -/* trailing blanks. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the specified column entry has not been initialized, the */ -/* error SPICE(UNINITIALIZED) is signaled. */ - -/* 3) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signaled. */ - -/* 4) If the output string CVAL is too short to accommodate the */ -/* returned string value, the output value is truncated on the */ -/* right. No error is signaled. */ - -/* 5) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 3 columns. */ - -/* $ Examples */ - -/* See EKRCEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.3.0, 31-MAY-2010 (NJB) */ - -/* Bug fix: call to DASRDI was overwriting local memory. This */ -/* problem did not affect operation of the routine except on */ -/* the Mac/Intel/OSX/ifort/32-bit platform, on which it caused */ -/* a segmentation fault when this routine was compiled with */ -/* default optimization. */ - -/* - SPICELIB Version 1.2.0, 23-JUL-1999 (NJB) */ - -/* Error check for string truncation on output was removed. */ -/* This error check interfered with the use of this routine */ -/* (via a call to ZZEKRSC) within ZZEKJSRT, which relies on */ -/* being able to read into a buffer initial substrings of scalar */ -/* data. */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Error check for string truncation on output was added. */ -/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ -/* to SPICE(UNINITIALIZED). Error messages were enhanced so */ -/* as to use column names rather than indices. Miscellaneous */ -/* header fixes were made. */ - -/* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.2.0, 23-JUL-1999 (NJB) */ - -/* Error check for string truncation on output was removed. */ -/* This error check interfered with the use of this routine */ -/* (via a call to ZZEKRSC) within ZZEKJSRT, which relies on */ -/* being able to read into a buffer initial substrings of scalar */ -/* data. */ - -/* - SPICELIB Version 1.1.0, 25-JUL-1997 (NJB) */ - -/* Error check for string truncation on output was added. */ -/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ -/* to SPICE(UNINITIALIZED), since the previous string exceeded */ -/* the maximum allowed length for the short error message. */ - -/* Error messages were enhanced so as to use column names rather */ -/* than indices. */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD03", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " - "EK = #", (ftnlen)65); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD03", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read both the pointer */ -/* and the stored string size. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* Read the value. This is slightly more complicated than */ -/* the numeric cases, because the value may be spread across */ -/* multiple pages. Also, we must not write past the end of the */ -/* output string. */ - -/* We'll need the number of the page at which the first character */ -/* of the string is stored. This page contains at least one */ -/* character of the data value. */ - - zzekgei_(handle, &datptr, cvlen); - -/* Set the data pointer to the start of the string data, skipping */ -/* over the encoded string length. */ - - datptr += 5; -/* Computing MIN */ - i__1 = *cvlen, i__2 = i_len(cval, cval_len); - n = min(i__1,i__2); - -/* Read the available data from the page under consideration. */ - - zzekpgpg_(&c__1, &datptr, &p, &pbase); - relptr = datptr - pbase; -/* Computing MIN */ - i__1 = n, i__2 = 1014 - relptr + 1; - avail = min(i__1,i__2); - b = datptr; - e = datptr + avail - 1; - bpos = 1; - epos = avail; - l = epos - bpos + 1; - dasrdc_(handle, &b, &e, &bpos, &epos, cval, cval_len); - n -= l; - while(n > 0) { - -/* Read the forward page pointer from the current page; find */ -/* the base address of the referenced page. */ - - i__1 = pbase + 1015; - zzekgei_(handle, &i__1, &p); - zzekpgbs_(&c__1, &p, &pbase); - avail = min(n,1014); - b = pbase + 1; - e = pbase + avail; - bpos = epos + 1; - epos += avail; - dasrdc_(handle, &b, &e, &bpos, &epos, cval, cval_len); - n -= avail; - bpos = epos + 1; - } - -/* Blank-pad CVAL if required. */ - - if (i_len(cval, cval_len) > epos) { - i__1 = epos; - s_copy(cval + i__1, " ", cval_len - i__1, (ftnlen)1); - } - *isnull = FALSE_; - } else if (datptr == -2) { - -/* The value is null. */ - - *isnull = TRUE_; - *cvlen = 1; - } else if (datptr == -1 || datptr == -3) { - -/* The data value is absent. This is an error. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKRD03", (ftnlen)8); - setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" - "OLUMN = #; RECNO = #; EK = #", (ftnlen)87); - errint_("#", &segdsc[1], (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(UNINITIALIZED)", (ftnlen)20); - chkout_("ZZEKRD03", (ftnlen)8); - return 0; - } else { - -/* The data pointer is corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKRD03", (ftnlen)8); - setmsg_("Data pointer is corrupted. SEGNO = #; COLUMN = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRD03", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrd03_ */ - diff --git a/ext/spice/src/cspice/zzekrd04.c b/ext/spice/src/cspice/zzekrd04.c deleted file mode 100644 index 8663a940b9..0000000000 --- a/ext/spice/src/cspice/zzekrd04.c +++ /dev/null @@ -1,910 +0,0 @@ -/* zzekrd04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure ZZEKRD04 ( EK, read class 4 column entry elements ) */ -/* Subroutine */ int zzekrd04_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *beg, integer *end, integer *ivals, - logical *isnull, logical *found) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base, nrec, nelt; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekgfwd_(integer *, integer *, integer *, - integer *), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *); - integer p, nread; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, ptemp, start; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer remain, colidx, datptr, maxidx, minidx, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Read a specified element range from a column entry in a specified */ -/* record in a class 4 column. Class 4 columns have integer arrays */ -/* as column entries. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* BEG I Start element index. */ -/* END I End element index. */ -/* IVALS O Integer values in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ -/* FOUND O Flag indicating whether elements were found. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* BEG, */ -/* END are, respectively, the start and end indices of */ -/* the contiguous range of elements to be read from */ -/* the specified column entry. */ - -/* $ Detailed_Output */ - -/* IVALS are the values read from the specified column */ -/* entry. The mapping of elements of the column entry */ -/* to elements of IVALS is as shown below: */ - -/* Column entry element IVALS element */ -/* -------------------- ------------- */ -/* BEG 1 */ -/* BEG+1 2 */ -/* . . */ -/* . . */ -/* . . */ -/* END END-BEG+1 */ - -/* IVALS is valid only if the output argument */ -/* FOUND is returned .TRUE. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. ISNULL is set on output whether or not */ -/* the range of elements designated by BEG and END */ -/* exists. */ - -/* FOUND is a logical flag indicating whether the range */ -/* of elements designated by BEG and END exists. */ -/* If the number of elements in the specified column */ -/* entry is not at least END, FOUND will be returned */ -/* .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the specified column entry has not been initialized, the */ -/* error SPICE(UNINITIALIZEDVALUE) is signalled. */ - -/* 3) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 4 columns. */ - -/* $ Examples */ - -/* See EKRCEI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in ZZEKGFWD call. */ - -/* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in ZZEKGFWD call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nrec = segdsc[5]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKRD04", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD04", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* The entry is non-null. */ - - *isnull = FALSE_; - -/* Get the element count. Check for range specifications that */ -/* can't be met. */ - - dasrdi_(handle, &datptr, &datptr, &nelt); - if (*beg < 1 || *beg > nelt) { - *found = FALSE_; - return 0; - } else if (*end < 1 || *end > nelt) { - *found = FALSE_; - return 0; - } else if (*end < *beg) { - *found = FALSE_; - return 0; - } - -/* The request is valid, so read the data. The first step is to */ -/* locate the element at index BEG. */ - - zzekpgpg_(&c__3, &datptr, &p, &base); - minidx = 1; - maxidx = base + 254 - datptr; - datptr += *beg; - while(maxidx < *beg) { - -/* Locate the page on which the element is continued. */ - - i__1 = base + 255; - i__2 = base + 255; - dasrdi_(handle, &i__1, &i__2, &p); - -/* Determine the highest-indexed element of the column entry */ -/* located on the current page. */ - - zzekpgbs_(&c__3, &p, &base); - minidx = maxidx + 1; -/* Computing MIN */ - i__1 = maxidx + 254; - maxidx = min(i__1,nelt); - -/* The following assignment will set DATPTR to the correct */ -/* value on the last pass through this loop. */ - - datptr = base + 1 + (*beg - minidx); - } - -/* At this point, P is the page on which the element having index */ -/* BEG is located. BASE is the base address of this page. */ -/* MAXIDX is the highest index of any element on the current page. */ - - remain = *end - *beg + 1; - start = 1; - -/* Decide how many elements to read from the current page, and */ -/* read them. */ - -/* Computing MIN */ - i__1 = remain, i__2 = base + 254 - datptr + 1; - nread = min(i__1,i__2); - i__1 = datptr + nread - 1; - dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]); - remain -= nread; - while(remain > 0 && ! failed_()) { - -/* Locate the page on which the element is continued. */ - - zzekgfwd_(handle, &c__3, &p, &ptemp); - p = ptemp; - zzekpgbs_(&c__3, &p, &base); - datptr = base + 1; - start += nread; - nread = min(remain,254); - i__1 = datptr + nread - 1; - dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]); - remain -= nread; - } - *found = ! failed_(); - } else if (datptr == -2) { - -/* The value is null. */ - - *isnull = TRUE_; - *found = TRUE_; - } else if (datptr == -1) { - -/* The data value is absent. This is an error. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD04", (ftnlen)8); - setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" - "OLIDX = #; RECNO = #; EK = #", (ftnlen)87); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25); - chkout_("ZZEKRD04", (ftnlen)8); - return 0; - } else { - -/* The data pointer is corrupted. */ - - dashlu_(handle, &unit); - chkin_("ZZEKRD04", (ftnlen)8); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRD04", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrd04_ */ - diff --git a/ext/spice/src/cspice/zzekrd05.c b/ext/spice/src/cspice/zzekrd05.c deleted file mode 100644 index a951f18c61..0000000000 --- a/ext/spice/src/cspice/zzekrd05.c +++ /dev/null @@ -1,866 +0,0 @@ -/* zzekrd05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ZZEKRD05 ( EK, read class 5 column entry elements ) */ -/* Subroutine */ int zzekrd05_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *beg, integer *end, doublereal * - dvals, logical *isnull, logical *found) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer base, nrec, nelt; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekgfwd_(integer *, integer *, integer *, - integer *), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *); - integer p, nread; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, ptemp, start; - extern logical failed_(void); - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dasrdi_(integer *, integer *, integer *, integer *) - ; - integer remain; - doublereal dpnelt; - integer colidx, datptr, maxidx, minidx, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* Read a specified element range from a column entry in a specified */ -/* record in a class 5 column. Class 5 columns have d.p. arrays */ -/* as column entries. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* BEG I Start element index. */ -/* END I End element index. */ -/* DVALS O Double precision values in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ -/* FOUND O Flag indicating whether elements were found. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* BEG, */ -/* END are, respectively, the start and end indices of */ -/* the contiguous range of elements to be read from */ -/* the specified column entry. */ - -/* $ Detailed_Output */ - -/* DVALS are the values read from the specified column */ -/* entry. The mapping of elements of the column entry */ -/* to elements of DVALS is as shown below: */ - -/* Column entry element DVALS element */ -/* -------------------- ------------- */ -/* BEG 1 */ -/* BEG+1 2 */ -/* . . */ -/* . . */ -/* . . */ -/* END END-BEG+1 */ - -/* DVALS is valid only if the output argument */ -/* FOUND is returned .TRUE. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. ISNULL is set on output whether or not */ -/* the range of elements designated by BEG and END */ -/* exists. */ - -/* FOUND is a logical flag indicating whether the range */ -/* of elements designated by BEG and END exists. */ -/* If the number of elements in the specified column */ -/* entry is not at least END, FOUND will be returned */ -/* .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the specified column entry has not been initialized, the */ -/* error SPICE(UNINITIALIZEDVALUE) is signalled. */ - -/* 3) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 5 columns. */ - -/* $ Examples */ - -/* See EKRCED. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 12-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in ZZEKGFWD calls. */ - -/* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 12-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in ZZEKGFWD calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nrec = segdsc[5]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKRD05", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD05", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* The entry is non-null. */ - - *isnull = FALSE_; - -/* Get the element count. Check for range specifications that */ -/* can't be met. */ - - dasrdd_(handle, &datptr, &datptr, &dpnelt); - nelt = i_dnnt(&dpnelt); - if (*beg < 1 || *beg > nelt) { - *found = FALSE_; - return 0; - } else if (*end < 1 || *end > nelt) { - *found = FALSE_; - return 0; - } else if (*end < *beg) { - *found = FALSE_; - return 0; - } - -/* The request is valid, so read the data. The first step is to */ -/* locate the element at index BEG. */ - - zzekpgpg_(&c__2, &datptr, &p, &base); - minidx = 1; - maxidx = base + 126 - datptr; - datptr += *beg; - while(maxidx < *beg) { - -/* Locate the page on which the element is continued. */ - - zzekgfwd_(handle, &c__2, &p, &ptemp); - p = ptemp; - zzekpgbs_(&c__2, &p, &base); - -/* Determine the highest-indexed element of the column entry */ -/* located on the current page. */ - - minidx = maxidx + 1; -/* Computing MIN */ - i__1 = maxidx + 126; - maxidx = min(i__1,nelt); - -/* The following assignment will set DATPTR to the correct */ -/* value on the last pass through this loop. */ - - datptr = base + 1 + (*beg - minidx); - } - -/* At this point, P is the page on which the element having index */ -/* BEG is located. BASE is the base address of this page. */ -/* MAXIDX is the highest index of any element on the current page. */ - - remain = *end - *beg + 1; - start = 1; - -/* Decide how many elements to read from the current page, and */ -/* read them. */ - -/* Computing MIN */ - i__1 = remain, i__2 = base + 126 - datptr + 1; - nread = min(i__1,i__2); - i__1 = datptr + nread - 1; - dasrdd_(handle, &datptr, &i__1, &dvals[start - 1]); - remain -= nread; - while(remain > 0 && ! failed_()) { - -/* Locate the page on which the element is continued. */ - - zzekgfwd_(handle, &c__2, &p, &ptemp); - p = ptemp; - zzekpgbs_(&c__2, &p, &base); - datptr = base + 1; - start += nread; - nread = min(remain,126); - i__1 = datptr + nread - 1; - dasrdd_(handle, &datptr, &i__1, &dvals[start - 1]); - remain -= nread; - } - *found = ! failed_(); - } else if (datptr == -2) { - -/* The value is null. */ - - *isnull = TRUE_; - *found = TRUE_; - } else if (datptr == -1) { - -/* The data value is absent. This is an error. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD05", (ftnlen)8); - setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" - "OLIDX = #; RECNO = #; EK = #", (ftnlen)87); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25); - chkout_("ZZEKRD05", (ftnlen)8); - return 0; - } else { - -/* The data pointer is corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD05", (ftnlen)8); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRD05", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrd05_ */ - diff --git a/ext/spice/src/cspice/zzekrd06.c b/ext/spice/src/cspice/zzekrd06.c deleted file mode 100644 index 119e919359..0000000000 --- a/ext/spice/src/cspice/zzekrd06.c +++ /dev/null @@ -1,1057 +0,0 @@ -/* zzekrd06.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKRD06 ( EK, read class 6 column entry elements ) */ -/* Subroutine */ int zzekrd06_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *beg, integer *end, char *cvals, - logical *isnull, logical *found, ftnlen cvals_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer base, nrec, nelt; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *); - integer d__, p, delta, nread, avail; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer recno, cvlen, ncols, nskip, start; - extern logical failed_(void); - integer pg; - extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen), dasrdi_(integer *, integer - *, integer *, integer *); - integer remain; - char column[32]; - integer colidx, datptr, eltidx, eltoff, maxelt, offset, pagnum, ptrloc, - ptroff, strlen; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, - ftnlen), zzekgei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Read a specified element range from a column entry in a specified */ -/* record in a class 6 column. Class 6 columns have character arrays */ -/* as column entries. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* BEG I Start element index. */ -/* END I End element index. */ -/* CVALS O Character values in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ -/* FOUND O Flag indicating whether elements were found. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. */ - -/* BEG, */ -/* END are, respectively, the start and end indices of */ -/* the contiguous range of elements to be read from */ -/* the specified column entry. */ - -/* $ Detailed_Output */ - -/* CVALS are the values read from the specified column */ -/* entry. The mapping of elements of the column entry */ -/* to elements of CVALS is as shown below: */ - -/* Column entry element CVALS element */ -/* -------------------- ------------- */ -/* BEG 1 */ -/* BEG+1 2 */ -/* . . */ -/* . . */ -/* . . */ -/* END END-BEG+1 */ - -/* CVALS must have sufficient string length to hold */ -/* the longest returned string value. Entries that */ -/* are shorter than the string length of CVALS are */ -/* padded with trailing blanks. */ - -/* CVALS is valid only if the output argument */ -/* FOUND is returned .TRUE. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. ISNULL is set on output whether or not */ -/* the range of elements designated by BEG and END */ -/* exists. */ - -/* FOUND is a logical flag indicating whether the range */ -/* of elements designated by BEG and END exists. */ -/* If the number of elements in the specified column */ -/* entry is not at least END, FOUND will be returned */ -/* .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the specified column entry has not been initialized, the */ -/* error SPICE(UNINITIALIZED) is signalled. */ - -/* 3) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If the string length of CVALS is shorter than the declared */ -/* string length of the specified column, the error */ -/* SPICE(STRINGTRUNCATED) is signalled. */ - -/* 5) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 6 columns. */ - -/* $ Examples */ - -/* See EKRCEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Error check for string truncation on output was added. */ -/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ -/* to SPICE(UNINITIALIZED). Error messages were enhanced so */ -/* as to use column names rather than indices. */ - -/* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Error check for string truncation on output was added. */ -/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ -/* to SPICE(UNINITIALIZED). Error messages were enhanced so */ -/* as to use column names rather than indices. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - nrec = segdsc[5]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKRD06", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD06", (ftnlen)8); - return 0; - } - -/* Make sure the output buffer is wide enough to hold the returned */ -/* strings. */ - - cvlen = i_len(cvals, cvals_len); - strlen = coldsc[2]; - if (strlen > cvlen) { - -/* We have a string truncation error. Look up the column */ -/* name, record number, and file name before signalling an */ -/* error. */ - - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRD06", (ftnlen)8); - setmsg_("String value has length #; output string can hold only # ch" - "aracters. COLUMN = #; SEGNO = #; RECNO = #; EK = #", (ftnlen) - 110); - errint_("#", &strlen, (ftnlen)1); - errint_("#", &cvlen, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(STRINGTRUNCATED)", (ftnlen)22); - chkout_("ZZEKRD06", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and read the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* The entry is non-null. */ - - *isnull = FALSE_; - -/* Get the element count. Check for range specifications that */ -/* can't be met. */ - - zzekgei_(handle, &datptr, &nelt); - if (*beg < 1 || *beg > nelt) { - *found = FALSE_; - return 0; - } else if (*end < 1 || *end > nelt) { - *found = FALSE_; - return 0; - } else if (*end < *beg) { - *found = FALSE_; - return 0; - } - -/* The request is valid, so read the data. The first step is to */ -/* locate the element at index BEG. We'll first decide on which */ -/* page the desired element starts. The first page holds up to */ -/* CPSIZE - ENCSIZ characters; the rest hold CPSIZE characters. */ -/* While we're at it, we'll compute the offset ELTOFF of the */ -/* element from the base of the page on which the element starts. */ -/* We'll use the name OFFSET to represent the character offset */ -/* of the element from the base of the page on which the column */ -/* entry starts. */ - - zzekpgpg_(&c__1, &datptr, &p, &base); - ptroff = datptr - base; - offset = ptroff + 5 + strlen * (*beg - 1); - if (offset <= 1014) { - pagnum = 1; - eltoff = offset; - } else { - pagnum = (offset + 1013) / 1014; - eltoff = offset - (pagnum - 1) * 1014; - } - -/* Get the absolute page number and base address of the page */ -/* on which the element starts. If this is not the page on */ -/* which the column entry starts, we'll chain along using */ -/* the page's forward links until we arrive at the correct page. */ - - pg = 1; - while(pg < pagnum) { - -/* Get the link to the next page, then look up the base */ -/* address of that page. */ - - i__1 = base + 1015; - zzekgei_(handle, &i__1, &p); - zzekpgbs_(&c__1, &p, &base); - ++pg; - } - -/* The desired element starts at address BASE + ELTOFF. */ - - datptr = base + eltoff; - -/* At this point, P is the page on which the element having index */ -/* BEG is located. BASE is the base address of this page. */ - -/* Read the strings one at a time. */ - - eltidx = 1; - maxelt = *end - *beg + 1; - while(eltidx <= maxelt && ! failed_()) { - -/* Read the current string. The string may be continued over */ -/* multiple pages. Read only as many characters as will fit */ -/* in the output buffer element CVALS(ELTIDX). */ - - remain = min(cvlen,strlen); - start = 1; - while(remain > 0 && ! failed_()) { - avail = base + 1014 - datptr + 1; - nread = min(remain,avail); - if (nread > 0) { - i__1 = datptr + nread - 1; - i__2 = start + nread - 1; - dasrdc_(handle, &datptr, &i__1, &start, &i__2, cvals + ( - eltidx - 1) * cvals_len, cvals_len); - start += nread; - remain -= nread; - datptr += nread; - } else { - -/* Go to the next page for the continuation of the */ -/* current string. */ - - i__1 = base + 1015; - zzekgei_(handle, &i__1, &p); - zzekpgbs_(&c__1, &p, &base); - datptr = base + 1; - } - } - -/* If we did not read all of the current array element, */ -/* we'll need to advance DATPTR past the end of the element. */ -/* If this advance moved DATPTR beyond the last character */ -/* of the current page, the logic above will set DATPTR to */ -/* indicate the first character of the next continuation page. */ - - delta = strlen - cvlen; - if (delta > 0) { - d__ = delta; - while(d__ > 0) { - avail = base + 1014 - datptr + 1; - nskip = min(d__,avail); - if (nskip > 0) { - d__ -= nskip; - datptr += nskip; - } else { - -/* Go to the next page for the continuation of the */ -/* current string. */ - - i__1 = base + 1015; - zzekgei_(handle, &i__1, &p); - zzekpgbs_(&c__1, &p, &base); - datptr = base + 1; - } - } - } - -/* Blank-pad the output string if necessary. */ - - if (cvlen > strlen) { - i__1 = strlen; - s_copy(cvals + ((eltidx - 1) * cvals_len + i__1), " ", - cvals_len - i__1, (ftnlen)1); - } - ++eltidx; - } - *found = ! failed_(); - } else if (datptr == -2) { - -/* The value is null. */ - - *isnull = TRUE_; - *found = TRUE_; - } else if (datptr == -1) { - -/* The data value is absent. This is an error. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKRD06", (ftnlen)8); - setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" - "OLUMN = #; RECNO = #; EK = #", (ftnlen)87); - errint_("#", &segdsc[1], (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(UNINITIALIZED)", (ftnlen)20); - chkout_("ZZEKRD06", (ftnlen)8); - return 0; - } else { - -/* The data pointer is corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKRD06", (ftnlen)8); - setmsg_("Data pointer is corrupted. SEGNO = #; COLUMN = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRD06", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrd06_ */ - diff --git a/ext/spice/src/cspice/zzekrd07.c b/ext/spice/src/cspice/zzekrd07.c deleted file mode 100644 index 1d4b241dbb..0000000000 --- a/ext/spice/src/cspice/zzekrd07.c +++ /dev/null @@ -1,818 +0,0 @@ -/* zzekrd07.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKRD07 ( EK, read class 7 column entry ) */ -/* Subroutine */ int zzekrd07_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *ival, logical *isnull) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer mdat[2], nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - char cflag[1]; - integer q, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, addrss, colidx, datbas, metloc, nflbas, offset; - logical nullok; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasrdi_(integer *, integer *, integer *, integer *), - dasrdc_(integer *, integer *, integer *, integer *, integer *, - char *, ftnlen); - -/* $ Abstract */ - -/* Read a column entry from a specified record in a class 7 column. */ -/* Class 7 columns contain fixed-count, scalar integer values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 7 Parameters */ - -/* ekclas07.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 7 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 7 metadata array: */ - - -/* End Include Section: EK Column Class 7 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* IVAL O Integer value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. For class 7 columns, record */ -/* pointers are identical to record numbers. */ - -/* $ Detailed_Output */ - -/* IVAL is the value read from the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the column */ -/* entry is null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 7 columns. */ - -/* $ Examples */ - -/* See EKRCEI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - metloc = coldsc[9]; - nullok = coldsc[7] == 1; - if (colidx < 1 || colidx > ncols) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD07", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " - "EK = #", (ftnlen)65); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD07", (ftnlen)8); - return 0; - } - -/* Read the metadata block. There are two items in the block: */ - -/* 1) The base address of the first page of the data */ -/* 2) The base address of the null flag array, if nulls are */ -/* permitted. */ - - i__1 = metloc + 1; - i__2 = metloc + 2; - dasrdi_(handle, &i__1, &i__2, mdat); - datbas = mdat[0]; - nflbas = mdat[1]; - -/* If null values are permitted, the first step is to get */ -/* the null flag for the value of interest. Compute the */ -/* address of this flag. */ - -/* There are CPSIZE null flags per page, and each page has size */ -/* PGSIZC. The null flags start at the beginning of the page. */ - - if (nullok) { - q = (*recptr - 1) / 1014; - r__ = *recptr - q * 1014; - offset = r__ + (q << 10); - addrss = nflbas + offset; - dasrdc_(handle, &addrss, &addrss, &c__1, &c__1, cflag, (ftnlen)1); - *isnull = *(unsigned char *)cflag == 'T'; - if (*isnull) { - return 0; - } - } - -/* If we're still here, we'll read the data value. */ - - *isnull = FALSE_; - -/* The address calculation for the value is analogous to that */ -/* for the null flag. */ - - q = (*recptr - 1) / 254; - r__ = *recptr - q * 254; - offset = r__ + (q << 8); - addrss = datbas + offset; - dasrdi_(handle, &addrss, &addrss, ival); - return 0; -} /* zzekrd07_ */ - diff --git a/ext/spice/src/cspice/zzekrd08.c b/ext/spice/src/cspice/zzekrd08.c deleted file mode 100644 index ca549f26ab..0000000000 --- a/ext/spice/src/cspice/zzekrd08.c +++ /dev/null @@ -1,815 +0,0 @@ -/* zzekrd08.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKRD08 ( EK, read class 8 column entry ) */ -/* Subroutine */ int zzekrd08_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, doublereal *dval, logical *isnull) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer mdat[2], nrec; - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - char cflag[1]; - integer q, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols, addrss, colidx, datbas, metloc, nflbas, offset; - logical nullok; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), dasrdi_(integer *, integer *, - integer *, integer *), dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen), dasrdd_(integer *, integer - *, integer *, doublereal *); - -/* $ Abstract */ - -/* Read a column entry from a specified record in a class 8 column. */ -/* Class 8 columns contain fixed-count, scalar, double precision */ -/* values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 8 Parameters */ - -/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 8 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 8 metadata array: */ - - -/* End Include Section: EK Column Class 8 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* DVAL O Double precision value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to be written. For class 8 columns, record */ -/* pointers are identical to record numbers. */ - -/* $ Detailed_Output */ - -/* DVAL is the value read from the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 8 columns. */ - -/* $ Examples */ - -/* See EKRCED. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - metloc = coldsc[9]; - nullok = coldsc[7] == 1; - if (colidx < 1 || colidx > ncols) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKRD08", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD08", (ftnlen)8); - return 0; - } - -/* Read the metadata block. There are two items in the block: */ - -/* 1) The base address of the first page of the data */ -/* 2) The base address of the null flag array, if nulls are */ -/* permitted. */ - - i__1 = metloc + 1; - i__2 = metloc + 2; - dasrdi_(handle, &i__1, &i__2, mdat); - datbas = mdat[0]; - nflbas = mdat[1]; - -/* If null values are permitted, the first step is to get */ -/* the null flag for the value of interest. Compute the */ -/* address of this flag. */ - -/* There are CPSIZE null flags per page, and each page has size */ -/* PGSIZC. The null flags start at the beginning of the page. */ - - if (nullok) { - q = (*recptr - 1) / 1014; - r__ = *recptr - q * 1014; - offset = r__ + (q << 10); - addrss = nflbas + offset; - dasrdc_(handle, &addrss, &addrss, &c__1, &c__1, cflag, (ftnlen)1); - *isnull = *(unsigned char *)cflag == 'T'; - if (*isnull) { - return 0; - } - } - -/* If we're still here, we'll read the data value. */ - - *isnull = FALSE_; - -/* The address calculation for the value is analogous to that */ -/* for the null flag. */ - - q = (*recptr - 1) / 126; - r__ = *recptr - q * 126; - offset = r__ + (q << 7); - addrss = datbas + offset; - dasrdd_(handle, &addrss, &addrss, dval); - return 0; -} /* zzekrd08_ */ - diff --git a/ext/spice/src/cspice/zzekrd09.c b/ext/spice/src/cspice/zzekrd09.c deleted file mode 100644 index 09bbf4a3f5..0000000000 --- a/ext/spice/src/cspice/zzekrd09.c +++ /dev/null @@ -1,938 +0,0 @@ -/* zzekrd09.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKRD09 ( EK, read class 9 column entry elements ) */ -/* Subroutine */ int zzekrd09_(integer *handle, integer *segdsc, integer * - coldsc, integer *recno, integer *cvlen, char *cval, logical *isnull, - ftnlen cval_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer mdat[2], nrec, unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen); - char cflag[1]; - integer l, q, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer ncols; - char column[32]; - integer addrss, colidx, datbas, metloc, nflbas, offset; - logical nullok; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dasrdi_(integer *, integer *, integer *, integer *), - dasrdc_(integer *, integer *, integer *, integer *, integer *, - char *, ftnlen); - integer spp; - -/* $ Abstract */ - -/* Read a column entry from a specified record in a class 9 column. */ -/* Class 9 columns contain fixed record count, fixed-length, */ -/* scalar character values. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Class 9 Parameters */ - -/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */ - - -/* The following parameters give the offsets of items in the */ -/* class 9 integer metadata array. */ - -/* Data array base address: */ - - -/* Null flag array base address: */ - - -/* Size of class 9 metadata array: */ - - -/* End Include Section: EK Column Class 9 Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECNO I Record number. */ -/* CVLEN O Length of returned character value. */ -/* CVAL O Character value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the descriptor of the column from which data is */ -/* to be read. */ - -/* RECNO is the number of the record containing the column */ -/* entry to be written. */ - -/* $ Detailed_Output */ - -/* CVLEN is the length of the returned string value. This */ -/* is the declared string length of the column being */ -/* read. Note this definition differs from that used */ -/* for class 3 columns. In the class 9 case, no */ -/* string length is stored in the file, so extra work */ -/* at run time would be required to determine whether */ -/* truncation would occur. */ - -/* CVAL is the value read from the specified column entry. */ -/* CVAL must have sufficient length to hold the */ -/* returned string value. Entries that are shorter */ -/* than the string length of CVAL are padded with */ -/* trailing blanks. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the ordinal position of the column specified by COLDSC */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* 3) If the output string CVAL is too short to accommodate the */ -/* returned string value, the error SPICE(STRINGTRUNCATED) */ -/* is signalled. CVAL must be at least as long as the declared */ -/* length of the column being read. */ - -/* 4) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility for reading data from class 9 columns. */ - -/* $ Examples */ - -/* See EKRCEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Error check for string truncation on output was added. */ -/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ -/* to SPICE(UNINITIALIZED). */ - -/* The argument RECPTR was renamed to RECNO. The reference to */ -/* ZZEKRP2N was removed. */ - -/* Miscellaneous header corrections were made. */ - -/* - SPICELIB Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ - -/* Error check for string truncation on output was added. */ -/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ -/* to SPICE(UNINITIALIZED). */ - -/* The argument RECPTR was renamed to RECNO. The reference to */ -/* ZZEKRP2N was removed. */ - - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - metloc = coldsc[9]; - nullok = coldsc[7] == 1; - l = coldsc[2]; - if (colidx < 1 || colidx > ncols) { - dashlu_(handle, &unit); - chkin_("ZZEKRD09", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " - "EK = #", (ftnlen)65); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKRD09", (ftnlen)8); - return 0; - } - -/* Since class 9 columns have fixed-length strings, we already */ -/* know the string length. */ - - *cvlen = l; - if (*cvlen > i_len(cval, cval_len)) { - -/* We have a string truncation error. Look up the column */ -/* name, record number, and file name before signalling an */ -/* error. */ - - dashlu_(handle, &unit); - zzekcnam_(handle, coldsc, column, (ftnlen)32); - chkin_("ZZEKRD09", (ftnlen)8); - setmsg_("String value has length #; output string can hold only # ch" - "aracters. COLUMN = #; SEGNO = #; RECNO = #; EK = #", (ftnlen) - 110); - errint_("#", cvlen, (ftnlen)1); - i__1 = i_len(cval, cval_len); - errint_("#", &i__1, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(STRINGTRUNCATED)", (ftnlen)22); - chkout_("ZZEKRD09", (ftnlen)8); - return 0; - } - -/* Read the metadata block. There are two items in the block: */ - -/* 1) The base address of the first page of the data */ -/* 2) The base address of the null flag array, if nulls are */ -/* permitted. */ - - i__1 = metloc + 1; - i__2 = metloc + 2; - dasrdi_(handle, &i__1, &i__2, mdat); - datbas = mdat[0]; - nflbas = mdat[1]; - -/* If null values are permitted, the first step is to get */ -/* the null flag for the value of interest. Compute the */ -/* address of this flag. */ - -/* There are CPSIZE null flags per page, and each page has size */ -/* PGSIZC. The null flags start at the beginning of the page. */ - - if (nullok) { - q = (*recno - 1) / 1014; - r__ = *recno - q * 1014; - offset = r__ + (q << 10); - addrss = nflbas + offset; - dasrdc_(handle, &addrss, &addrss, &c__1, &c__1, cflag, (ftnlen)1); - *isnull = *(unsigned char *)cflag == 'T'; - if (*isnull) { - return 0; - } - } - -/* If we're still here, we'll read the data value. */ - - *isnull = FALSE_; - -/* The address calculation for the value is similar to that */ -/* for the null flag. However, the string length must be */ -/* taken into account. */ - - spp = 1014 / l; - q = (*recno - 1) / spp; - r__ = *recno - q * spp; - addrss = datbas + (q << 10) + (r__ - 1) * l + 1; - i__1 = addrss + l - 1; - dasrdc_(handle, &addrss, &i__1, &c__1, &l, cval, cval_len); - -/* Blank-pad CVAL if required. */ - - if (i_len(cval, cval_len) > l) { - i__1 = l; - s_copy(cval + i__1, " ", cval_len - i__1, (ftnlen)1); - } - return 0; -} /* zzekrd09_ */ - diff --git a/ext/spice/src/cspice/zzekreqi.c b/ext/spice/src/cspice/zzekreqi.c deleted file mode 100644 index eb002bf591..0000000000 --- a/ext/spice/src/cspice/zzekreqi.c +++ /dev/null @@ -1,521 +0,0 @@ -/* zzekreqi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; - -/* $Procedure ZZEKREQI ( Private: EK, read from encoded query, integer ) */ -/* Subroutine */ int zzekreqi_(integer *eqryi, char *name__, integer *value, - ftnlen name_len) -{ - /* Initialized data */ - - static char namlst[32*15] = "ARCHITECTURE " "INITIALI" - "ZED " "PARSED " - "NAMES_RESOLVED " "TIMES_RESOLVED " - " " "SEM_CHECKED " "NUM_TABLES " - " " "NUM_CONJUNCTIONS " "NUM_CONSTRAINTS " - " " "NUM_SELECT_COLS " "NUM_ORDERB" - "Y_COLS " "NUM_BUF_SIZE " "FREE" - "_NUM " "CHR_BUF_SIZE " - "FREE_CHR "; - static integer namidx[15] = { 2,3,4,5,6,7,8,10,9,12,11,13,14,15,16 }; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), ljust_( - char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char tmpnam[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read scalar integer value from encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I Integer component of query. */ -/* NAME I Name of scalar item to read. */ -/* VALUE O Value of item. */ - -/* $ Detailed_Input */ - -/* EQRYI is the integer portion of an encoded EK query. */ - -/* NAME is the name of the item whose value is to be read. */ -/* This item is some element of the integer portion */ -/* of an encoded query. */ - -/* $ Detailed_Output */ - -/* VALUE is the integer value designated by NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input name is not recognized, the error */ -/* SPICE(INVALIDNAME) is signalled. The encoded query is not */ -/* modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is the inverse of ZZEKWEQI. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. */ - - -/* Find the location of the named item. */ - - ljust_(name__, tmpnam, name_len, (ftnlen)32); - ucase_(tmpnam, tmpnam, (ftnlen)32, (ftnlen)32); - i__ = isrchc_(tmpnam, &c__15, namlst, (ftnlen)32, (ftnlen)32); - if (i__ == 0) { - chkin_("ZZEKREQI", (ftnlen)8); - setmsg_("Item # not found.", (ftnlen)17); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(INVALIDNAME)", (ftnlen)18); - chkout_("ZZEKREQI", (ftnlen)8); - return 0; - } - -/* Do the deed. */ - - *value = eqryi[namidx[(i__1 = i__ - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge( - "namidx", i__1, "zzekreqi_", (ftnlen)191)] + 5]; - return 0; -} /* zzekreqi_ */ - diff --git a/ext/spice/src/cspice/zzekrmch.c b/ext/spice/src/cspice/zzekrmch.c deleted file mode 100644 index 2922ad3005..0000000000 --- a/ext/spice/src/cspice/zzekrmch.c +++ /dev/null @@ -1,714 +0,0 @@ -/* zzekrmch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_false = FALSE_; - -/* $Procedure ZZEKRMCH ( EK, row match ) */ -logical zzekrmch_(integer *ncnstr, logical *active, integer *handle, integer * - segdsc, integer *cdscrs, integer *row, integer *elts, integer *ops, - integer *vtypes, char *chrbuf, integer *cbegs, integer *cends, - doublereal *dvals, integer *ivals, ftnlen chrbuf_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Local variables */ - extern logical zzekscmp_(integer *, integer *, integer *, integer *, - integer *, integer *, integer *, char *, doublereal *, integer *, - logical *, ftnlen); - integer i__; - -/* $ Abstract */ - -/* Determine whether a specified row in an EK file satisfies */ -/* a specified set of constraints. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Template Matching Wild Characters */ - - -/* ekwild.inc Version 1 16-JAN-1995 (NJB) */ - - -/* Within the EK system, templates used for pattern matching */ -/* are those accepted by the SPICELIB routine MATCHW. MATCHW */ -/* accepts two special characters: one representing wild */ -/* strings and one representing wild characters. This include */ -/* file defines those special characters for use within the EK */ -/* system. */ - - -/* Wild string symbol: this character matches any string. */ - - -/* Wild character symbol: this character matches any character. */ - - -/* End Include Section: EK Template Matching Wild Characters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NCNSTR I Number of constraints present in query. */ -/* ACTIVE I Array of flags indicating applicable constraints. */ -/* HANDLE I Handle of EK file containing row. */ -/* SEGDSC I Segment descriptor. */ -/* CDSCRS I Descriptors of columns referenced in query. */ -/* ROW I Index of row to match. */ -/* ELTS I Indices of column entry elements to match. */ -/* OPS I Operators used in query constraints. */ -/* VTYPES I Data types of values on RHS of constraints. */ -/* CHRBUF I Buffer containting query tokens. */ -/* CBEGS I Begin indices of character query tokens. */ -/* CENDS I End indices of character query tokens. */ -/* DVALS I D.p. values used in query constraints. */ -/* IVALS I Integer values used in query constraints. */ -/* MAXCOL P Maximum number of columns per segment. */ - -/* The function returns .TRUE. if and only if the specified */ -/* EK row satisfies the input constraints. */ - -/* $ Detailed_Input */ - -/* NCNSTR is the number of input constraints against which */ -/* the input row is to be compared. */ - -/* ACTIVE is an array of logical flags indicating which */ -/* constraints are currently applicable. The Nth */ -/* element of ACTIVE indicates whether or not to apply */ -/* the Nth constraint: if ACTIVE(N) is .TRUE., the */ -/* constraint is applicable, otherwise it isn't. */ - -/* The elements of the other input arguments that */ -/* define constraints are defined when the */ -/* corresponding element of ACTIVE is .TRUE. For */ -/* example, when the second constraint is not active, */ -/* the second column descriptor in LDSCRS may not be */ -/* defined. */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the descriptor of the EK segment containing the */ -/* column entry to be compared. */ - -/* CDSCRS is an array of column descriptors for the columns */ -/* referenced in the input constraints. The Ith */ -/* descriptor corresponds to the Ith constraint. */ - -/* ROW is the index of the row to compare against the */ -/* input constraints. */ - -/* ELTS is an array of column entry elements to match. */ - - -/* OPS are relational operators used in the input */ -/* constraints. The elements of OPS are any of the */ -/* integer parameters */ - -/* EQ, GE, GT, LE, LT, NE, LIKE, ISNULL, NOTNUL */ - -/* The Ith element of OPS corresponds to the Ith */ -/* constraint. */ - -/* VTYPES is an array of data type codes which indicate the */ -/* types of the values on the right hand sides of the */ -/* input constraints. The Ith element of VTYPES */ -/* applies to the Ith constraint. */ - -/* CHRBUF, */ -/* CBEGS, */ -/* CENDS are, respectively, a string containing character */ -/* tokens representing values on the right hand sides */ -/* of query constraints, and arrays of begin and end */ -/* indices of these tokens within CHRBUF. If the Nth */ -/* constraint has a character value on the right hand */ -/* side, that value is CHRBUF( CBEGS(N) : CENDS(N) ). */ -/* For constraints whose right hand sides do not */ -/* specify character values, the corresponding */ -/* elements of CBEGS and CENDS are not used. */ - -/* DVALS, */ -/* IVALS are, respectively, arrays of double precision and */ -/* integer values appearing on the right hand sides of */ -/* input constraints. The contents of DVALS and IVALS */ -/* are meaningful only for those constraints whose */ -/* right hand sides specify values having these data */ -/* types. */ - -/* Constraints involving unary operators can be either */ - -/* COLUMN_ENTRY(I) ISNULL */ -/* COLUMN_ENTRY(I) NOTNUL */ - -/* For constraints of this form, the corresponding */ -/* elements of the value arrays are ignored. */ - -/* $ Detailed_Output */ - -/* The function returns .TRUE. if and only if the specified */ -/* EK row satisfies the input constraints. */ - -/* $ Parameters */ - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operator */ - -/* LIKE */ - -/* which is used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - -/* $ Exceptions */ - -/* 1) If an error is detected, the function will return the value */ -/* .FALSE. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a utility intended primarily for use by EKSRCH. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* 1) Constraints must apply to scalar columns only. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* For each active constraint in the list, see whether the specified */ -/* row satisfies the constraint. If any constraint is not satisfied, */ -/* return immediately. */ - - i__ = 1; - ret_val = TRUE_; - while(i__ <= *ncnstr && ret_val) { - if (active[i__ - 1]) { - -/* See whether the row satisfies the Ith constraint. */ - - i__1 = cbegs[i__ - 1] - 1; - ret_val = zzekscmp_(&ops[i__ - 1], handle, segdsc, &cdscrs[i__ * - 11 - 11], row, &elts[i__ - 1], &vtypes[i__ - 1], chrbuf + - i__1, &dvals[i__ - 1], &ivals[i__ - 1], &c_false, cends[ - i__ - 1] - i__1); - } - -/* Take a look at the next constraint. */ - - ++i__; - } - -/* It's a match if we got this far. */ - - return ret_val; -} /* zzekrmch_ */ - diff --git a/ext/spice/src/cspice/zzekrp2n.c b/ext/spice/src/cspice/zzekrp2n.c deleted file mode 100644 index 41d506a725..0000000000 --- a/ext/spice/src/cspice/zzekrp2n.c +++ /dev/null @@ -1,299 +0,0 @@ -/* zzekrp2n.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRP2N ( EK, record pointer to number ) */ -integer zzekrp2n_(integer *handle, integer *segno, integer *recptr) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer unit; - extern /* Subroutine */ int zzeksdsc_(integer *, integer *, integer *); - extern integer zzektrls_(integer *, integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer stype; - extern logical failed_(void); - integer segdsc[24]; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Find the EK record number corresponding to a specified record */ -/* pointer. Beware, for type 1 segments, this is done by linear */ -/* searching. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* RECTPR I Record pointer. */ - -/* The function returns the number of the record having the */ -/* specified record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* SEGNO is the number of the segment containing the */ -/* record of interest. */ - -/* RECPTR is a record pointer. The number of the record */ -/* having this pointer is sought. */ - -/* $ Detailed_Output */ - -/* The function returns the number of the record having the */ -/* specified record pointer. The record should always be found. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 4) This routine should never be passed an input record pointer */ -/* that is not known to be valid. If this error is trapped, */ -/* it is evidence of a bug. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This searches an EK record tree for the record number */ -/* corresponding to a specified record pointer. Caution: this */ -/* routine plods along in linear time. It is intended primarily */ -/* for use in error handling. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - ret_val = 0; - zzeksdsc_(handle, segno, segdsc); - if (failed_()) { - return ret_val; - } - stype = segdsc[0]; - if (stype == 1) { - ret_val = zzektrls_(handle, &segdsc[6], recptr); - if (ret_val == 0) { - dashlu_(handle, &unit); - chkin_("ZZEKRP2N", (ftnlen)8); - setmsg_("Record having pointer # not found in segment # of file #" - , (ftnlen)56); - errint_("#", recptr, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRP2N", (ftnlen)8); - } - } else if (stype == 2) { - ret_val = *recptr; - } else { - dashlu_(handle, &unit); - chkin_("ZZEKRP2N", (ftnlen)8); - setmsg_("Segment type # is not supported. SEGNO = #. File = #.", ( - ftnlen)54); - errint_("#", &stype, (ftnlen)1); - errint_("#", segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKRP2N", (ftnlen)8); - } - return ret_val; -} /* zzekrp2n_ */ - diff --git a/ext/spice/src/cspice/zzekrplk.c b/ext/spice/src/cspice/zzekrplk.c deleted file mode 100644 index f8abe2f59d..0000000000 --- a/ext/spice/src/cspice/zzekrplk.c +++ /dev/null @@ -1,495 +0,0 @@ -/* zzekrplk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRPLK ( EK, look up record pointer ) */ -/* Subroutine */ int zzekrplk_(integer *handle, integer *segdsc, integer *n, - integer *recptr) -{ - integer tree; - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *), chkin_(char *, ftnlen); - integer stype; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Look up the record pointer of an EK record having a specified */ -/* ordinal position in a specified EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* N I Ordinal position of record. */ -/* RECPTR O Record pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the descriptor of the segment to which the */ -/* record of interest belongs. */ - -/* N is the ordinal position of the record in the */ -/* segment. */ - -/* $ Detailed_Output */ - -/* RECPTR is the record pointer corresponding to the input */ -/* key. This pointer identifies the record of */ -/* interest. The interpretation of RECPTR depends */ -/* on the type of segment to which the record belongs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If N is out of range, the error will be diagnosed by */ -/* routines called by this routine. */ - -/* 3) If an I/O error occurs while reading or the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine finds the record pointer for a record having a */ -/* specified ordinal position in a segment. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - - stype = segdsc[0]; - if (stype == 1) { - -/* For type 1 segments, the record pointer is obtained from */ -/* the record tree. */ - - tree = segdsc[6]; - zzektrdp_(handle, &tree, n, recptr); - } else if (stype == 2) { - -/* For type 2 segments, the record pointer *is* the ordinal */ -/* position of the record. */ - - *recptr = *n; - } else { - -/* Sorry, no other types of segments are supported. */ - - chkin_("ZZEKRPLK", (ftnlen)8); - setmsg_("The segment type # is not supported.", (ftnlen)36); - errint_("#", &stype, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKRPLK", (ftnlen)8); - return 0; - } - return 0; -} /* zzekrplk_ */ - diff --git a/ext/spice/src/cspice/zzekrsc.c b/ext/spice/src/cspice/zzekrsc.c deleted file mode 100644 index b403cb8560..0000000000 --- a/ext/spice/src/cspice/zzekrsc.c +++ /dev/null @@ -1,573 +0,0 @@ -/* zzekrsc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRSC ( EK, read scalar, character ) */ -/* Subroutine */ int zzekrsc_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *eltidx, integer *cvlen, char *cval, - logical *isnull, logical *found, ftnlen cval_len) -{ - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, - ftnlen); - integer class__, recno, segno, dtype; - extern /* Subroutine */ int dashlu_(integer *, integer *); - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrd03_(integer *, - integer *, integer *, integer *, integer *, char *, logical *, - ftnlen), zzekrd06_(integer *, integer *, integer *, integer *, - integer *, integer *, char *, logical *, logical *, ftnlen), - zzekrd09_(integer *, integer *, integer *, integer *, integer *, - char *, logical *, ftnlen); - -/* $ Abstract */ - -/* Read scalar data from a character column in a specified EK */ -/* record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Pointer to record from which data is to be read. */ -/* ELTIDX I Index of column entry element to be read. */ -/* CVLEN O Length of stored string. */ -/* CVAL O Character value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ -/* FOUND O Flag indicting whether entry element was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the column descriptor corresponding to the */ -/* column from which data is to be read. */ - -/* RECPTR is a pointer to the record from which data is to be */ -/* read. */ - -/* ELTIDX is the index of the column entry element to read. */ -/* If the column entry is scalar, this argument is */ -/* ignored. */ - -/* $ Detailed_Output */ - -/* CVLEN is the length of the stored character string value. */ -/* This is the actual number of characters stored; */ -/* CVLEN may be less than the declared length of */ -/* the column to which the value belongs, if the */ -/* column is declared to contain fixed-length strings. */ -/* CVLEN is valid only when FOUND is set to .TRUE. */ - -/* CVAL is the specified column entry. CVAL is valid only */ -/* when FOUND is set to .TRUE. */ - - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. ISNULL is valid only when FOUND is set to */ -/* .TRUE. */ - -/* FOUND is a logical flag indicating whether the specified */ -/* column entry element was found. For vector-valued */ -/* columns, if ELTIDX refers to a non-existent */ -/* column entry element, FOUND is set to .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If COLDSC is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 3) If COLDSC specifies a column of whose data type is not */ -/* character, the error SPICE(WRONGDATATYPE) will be signalled. */ - -/* 4) If COLDSC specifies a column of whose class is not */ -/* a character class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 5) If the indicated column is array-valued, and if ELTIDX is */ -/* non-positive, the error will be diagnosed by routines called */ -/* by this routine. However, if ELTIDX is greater than the */ -/* number of elements in the specified column entry, FOUND is */ -/* set to .FALSE. and no error is signalled. */ - -/* 6) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* The ZZEKRSx routines are low-level readers that expect column */ -/* entries to be defined by descriptors. Since these routines do not */ -/* look up descriptors, in cases where many successive accesses to */ -/* the same segment and column are required, these routines are */ -/* considerably more efficient than the high-level readers. */ - -/* These routines do not participate in tracing. */ - -/* $ Examples */ - -/* See ZZEKECMP. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Nothing found to begin with. */ - - *found = FALSE_; - -/* This column had better be of character type. */ - - dtype = coldsc[1]; - if (dtype != 1) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - segno = segdsc[1]; - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRSC", (ftnlen)7); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; ZZEKRSC only works with integer colu" - "mns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)94); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("ZZEKRSC", (ftnlen)7); - return 0; - } - -/* Now it's time to read data from the file. Call the low-level */ -/* reader appropriate to the column's class. */ - - class__ = coldsc[0]; - if (class__ == 3) { - zzekrd03_(handle, segdsc, coldsc, recptr, cvlen, cval, isnull, - cval_len); - *found = TRUE_; - } else if (class__ == 6) { - -/* Class 6 columns contain character string array entries. */ - - zzekrd06_(handle, segdsc, coldsc, recptr, eltidx, eltidx, cval, - isnull, found, cval_len); - } else if (class__ == 9) { - zzekrd09_(handle, segdsc, coldsc, recptr, cvlen, cval, isnull, - cval_len); - *found = TRUE_; - } else { - -/* This is an unsupported character column class. */ - - zzekcnam_(handle, coldsc, column, (ftnlen)32); - dashlu_(handle, &unit); - segno = segdsc[1]; - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRSC", (ftnlen)7); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported cha" - "racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)115); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKRSC", (ftnlen)7); - return 0; - } - return 0; -} /* zzekrsc_ */ - diff --git a/ext/spice/src/cspice/zzekrsd.c b/ext/spice/src/cspice/zzekrsd.c deleted file mode 100644 index bbccd93c2d..0000000000 --- a/ext/spice/src/cspice/zzekrsd.c +++ /dev/null @@ -1,563 +0,0 @@ -/* zzekrsd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRSD ( EK, read scalar, double precision ) */ -/* Subroutine */ int zzekrsd_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *eltidx, doublereal *dval, logical * - isnull, logical *found) -{ - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, - ftnlen); - integer class__, recno, segno, dtype; - extern /* Subroutine */ int dashlu_(integer *, integer *); - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrd02_(integer *, - integer *, integer *, integer *, doublereal *, logical *), - zzekrd05_(integer *, integer *, integer *, integer *, integer *, - integer *, doublereal *, logical *, logical *), zzekrd08_(integer - *, integer *, integer *, integer *, doublereal *, logical *); - -/* $ Abstract */ - -/* Read scalar data from a double precision column in a specified EK */ -/* record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Pointer to record from which data is to be read. */ -/* ELTIDX I Index of column entry element to be read. */ -/* DVAL O D.p. value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ -/* FOUND O Flag indicting whether entry element was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the column descriptor corresponding to the */ -/* column from which data is to be read. */ - -/* RECPTR is a pointer to the record from which data is to be */ -/* read. */ - -/* ELTIDX is the index of the column entry element to read. */ -/* If the column entry is scalar, this argument is */ -/* ignored. */ - -/* $ Detailed_Output */ - -/* DVAL is the specified column entry. DVAL is valid only */ -/* when FOUND is set to .TRUE. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. ISNULL is valid only when FOUND is set to */ -/* .TRUE. */ - -/* FOUND is a logical flag indicating whether the specified */ -/* column entry element was found. For vector-valued */ -/* columns, if ELTIDX refers to a non-existent */ -/* column entry element, FOUND is set to .FALSE. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If COLDSC is not the name of a declared column, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* 3) If COLDSC specifies a column of whose data type is not */ -/* double precision, the error SPICE(WRONGDATATYPE) will be */ -/* signalled. */ - -/* 4) If COLDSC specifies a column of whose class is not */ -/* an double precision class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 5) If the indicated column is array-valued, and if ELTIDX is */ -/* non-positive, the error will be diagnosed by routines called */ -/* by this routine. However, if ELTIDX is greater than the */ -/* number of elements in the specified column entry, FOUND is */ -/* set to .FALSE. and no error is signalled. */ - -/* 6) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* The ZZEKRSx routines are low-level readers that expect column */ -/* entries to be defined by descriptors. Since these routines do not */ -/* look up descriptors, in cases where many successive accesses to */ -/* the same segment and column are required, these routines are */ -/* considerably more efficient than the high-level readers. */ - -/* These routines do not participate in tracing. */ - -/* $ Examples */ - -/* See ZZEKECMP. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Nothing found to begin with. */ - - *found = FALSE_; - -/* This column had better be of d.p. or TIME type. */ - - dtype = coldsc[1]; - if (dtype != 2 && dtype != 4) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - dashlu_(handle, &unit); - segno = segdsc[1]; - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRSD", (ftnlen)7); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; ZZEKRSD only works with DP or TIME c" - "olumns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)97); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("ZZEKRSD", (ftnlen)7); - return 0; - } - -/* Now it's time to read data from the file. Call the low-level */ -/* reader appropriate to the column's class. */ - - class__ = coldsc[0]; - if (class__ == 2) { - zzekrd02_(handle, segdsc, coldsc, recptr, dval, isnull); - *found = TRUE_; - } else if (class__ == 5) { - -/* Class 5 columns contain d.p. array entries. */ - - zzekrd05_(handle, segdsc, coldsc, recptr, eltidx, eltidx, dval, - isnull, found); - } else if (class__ == 8) { - zzekrd08_(handle, segdsc, coldsc, recptr, dval, isnull); - *found = TRUE_; - } else { - -/* This is an unsupported d.p. column class. */ - - zzekcnam_(handle, coldsc, column, (ftnlen)32); - dashlu_(handle, &unit); - segno = segdsc[1]; - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRSD", (ftnlen)7); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported d.p" - ". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen) - 110); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKRSD", (ftnlen)7); - return 0; - } - return 0; -} /* zzekrsd_ */ - diff --git a/ext/spice/src/cspice/zzekrsi.c b/ext/spice/src/cspice/zzekrsi.c deleted file mode 100644 index 6197051b3f..0000000000 --- a/ext/spice/src/cspice/zzekrsi.c +++ /dev/null @@ -1,568 +0,0 @@ -/* zzekrsi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKRSI ( EK, read scalar, integer ) */ -/* Subroutine */ int zzekrsi_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *eltidx, integer *ival, logical * - isnull, logical *found) -{ - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, - ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, - ftnlen); - integer class__, recno, segno, dtype; - extern /* Subroutine */ int dashlu_(integer *, integer *); - char column[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), zzekrd01_(integer *, - integer *, integer *, integer *, integer *, logical *), zzekrd04_( - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, logical *, logical *), zzekrd07_(integer *, integer *, - integer *, integer *, integer *, logical *); - -/* $ Abstract */ - -/* Read scalar data from an integer column in a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Pointer to record from which data is to be read. */ -/* ELTIDX I Index of column entry element to be read. */ -/* IVAL O Integer value in column entry. */ -/* ISNULL O Flag indicating whether column entry is null. */ -/* FOUND O Flag indicting whether entry element was found. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. */ - -/* SEGDSC is the descriptor of the segment from which data is */ -/* to be read. */ - -/* COLDSC is the column descriptor corresponding to the */ -/* column from which to read. */ - -/* RECPTR is a pointer to the record from which data is to be */ -/* read. */ - -/* ELTIDX is the index of the column entry element to read. */ -/* If the column entry is scalar, this argument is */ -/* ignored. */ - -/* $ Detailed_Output */ - -/* IVAL is the specified column entry. IVAL is valid only */ -/* when FOUND is set to .TRUE. */ - -/* ISNULL is a logical flag indicating whether the entry is */ -/* null. ISNULL is valid only when FOUND is set to */ -/* .TRUE. */ - -/* FOUND is a logical flag indicating whether the specified */ -/* column entry element was found. For vector-valued */ -/* columns, if ELTIDX refers to a non-existent */ -/* column entry element, FOUND is set to .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If COLDSC is not the descriptor of a declared column, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If COLDSC specifies a column of whose data type is not */ -/* integer, the error SPICE(WRONGDATATYPE) will be signalled. */ - -/* 4) If COLDSC specifies a column of whose class is not */ -/* an integer class known to this routine, the error */ -/* SPICE(NOCLASS) will be signalled. */ - -/* 5) If the indicated column is array-valued, and if ELTIDX is */ -/* non-positive, the error will be diagnosed by routines called */ -/* by this routine. However, if ELTIDX is greater than the */ -/* number of elements in the specified column entry, FOUND is */ -/* set to .FALSE. and no error is signalled. */ - -/* 6) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* The ZZEKRSx routines are low-level readers that expect column */ -/* entries to be defined by descriptors. Since these routines do not */ -/* look up descriptors, in cases where many successive accesses to */ -/* the same segment and column are required, these routines are */ -/* considerably more efficient than the high-level readers. */ - -/* These routines do not participate in tracing. */ - -/* $ Examples */ - -/* See ZZEKECMP. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Nothing found to begin with. */ - - *found = FALSE_; - -/* This column had better be of integer type. */ - - dtype = coldsc[1]; - if (dtype != 3) { - zzekcnam_(handle, coldsc, column, (ftnlen)32); - dashlu_(handle, &unit); - segno = segdsc[1]; - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRSI", (ftnlen)7); - dashlu_(handle, &unit); - setmsg_("Column # is of type #; ZZEKRSI only works with integer colu" - "mns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)94); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &dtype, (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); - chkout_("ZZEKRSI", (ftnlen)7); - return 0; - } - -/* Now it's time to read data from the file. Call the low-level */ -/* reader appropriate to the column's class. */ - - class__ = coldsc[0]; - if (class__ == 1) { - -/* Class 1 columns contain scalar, integer entries. */ - - zzekrd01_(handle, segdsc, coldsc, recptr, ival, isnull); - *found = TRUE_; - } else if (class__ == 4) { - -/* Class 4 columns contain integer array entries. */ - - zzekrd04_(handle, segdsc, coldsc, recptr, eltidx, eltidx, ival, - isnull, found); - } else if (class__ == 7) { - -/* Class 7 columns are fixed-count columns that contain scalar, */ -/* integer entries. */ - - zzekrd07_(handle, segdsc, coldsc, recptr, ival, isnull); - *found = TRUE_; - } else { - -/* This is an unsupported integer column class. */ - - zzekcnam_(handle, coldsc, column, (ftnlen)32); - dashlu_(handle, &unit); - segno = segdsc[1]; - recno = zzekrp2n_(handle, &segdsc[1], recptr); - chkin_("ZZEKRSI", (ftnlen)7); - dashlu_(handle, &unit); - setmsg_("Class # from input column descriptor is not a supported int" - "eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( - ftnlen)113); - errint_("#", &class__, (ftnlen)1); - errch_("#", column, (ftnlen)1, (ftnlen)32); - errint_("#", &recno, (ftnlen)1); - errint_("#", &segno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(NOCLASS)", (ftnlen)14); - chkout_("ZZEKRSI", (ftnlen)7); - return 0; - } - return 0; -} /* zzekrsi_ */ - diff --git a/ext/spice/src/cspice/zzeksca.c b/ext/spice/src/cspice/zzeksca.c deleted file mode 100644 index fc877ddaf8..0000000000 --- a/ext/spice/src/cspice/zzeksca.c +++ /dev/null @@ -1,1607 +0,0 @@ -/* zzeksca.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c_b65 = 2500000; - -/* $Procedure ZZEKSCA ( EK, scratch area ) */ -/* Subroutine */ int zzeksca_0_(int n__, integer *n, integer *beg, integer * - end, integer *idata, integer *top) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer t = 0; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer base, b, e, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer lastc, lastd, lasti, numrd, start; - extern logical failed_(void); - static integer rb; - extern /* Subroutine */ int dasadi_(integer *, integer *, integer *), - cleari_(integer *, integer *), daslla_(integer *, integer *, - integer *, integer *), dasllc_(integer *); - static integer rt; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - static integer numadd; - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - static integer remain, scrhan; - extern /* Subroutine */ int daswbr_(integer *); - static integer scrtch[2500000]; - extern /* Subroutine */ int dasops_(integer *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Manage the EK scratch area. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* N I ZZEKSPSH, ZZEKSPOP, ZZEKSDEC */ -/* BEG I ZZEKSUPD, ZZEKSRD */ -/* END I ZZEKSUPD, ZZEKSRD */ -/* IDATA I-O ZZEKSPSH, ZZEKSPOP, ZZEKSUPD, ZZEKSRD */ -/* TOP O ZZEKSTOP */ - -/* $ Detailed_Input */ - -/* See the entry points for descriptions of their inputs. */ - -/* $ Detailed_Output */ - -/* See the entry points for descriptions of their outputs. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error SPICE(BOGUSENTRY) */ -/* is signalled. */ - -/* See the entry points for discussions of exceptions specific to */ -/* those routines. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The specific implementation of the EK scratch area is NOT */ -/* considered part of the specification of this suite of routines: */ -/* the implementation may be changed without notice. However, */ -/* some aspects of the current implementation, such as scratch */ -/* file usage, are visible to users and therefore are discussed */ -/* in this subroutine header. */ - -/* The EK system, in searching for events that satisfy a query, */ -/* produces intermediate results that require a potentially very */ -/* large amount of storage, more than can be expected to be */ -/* available in the form of memory. On the other hand, in order */ -/* to achieve reasonable query response time, these intermediate */ -/* results must be capable of being accessed quickly. The EK */ -/* scratch area provides a storage location that uses a combination */ -/* of memory and disk storage to give the EK system a large storage */ -/* area, part of which can be rapidly accessed. */ - -/* The logical structure of the EK scratch area is that of a large */ -/* one-dimensional integer stack. The indices of the elements of */ -/* this stack are referred to as scratch area `addresses'. Scratch */ -/* area addresses start at 1 and increase. The maximum address is */ -/* the maximum integer representable on the host computer, but the */ -/* maximum usable address depends on the disk storage available */ -/* to the calling program at the time the program is run. */ - -/* The EK scratch area has access routines that allow a calling */ -/* program to write to and read from it. Calling routines must */ -/* coordinate their use of the scratch area: the scratch area is */ -/* effectively a global data structure. Routines outside of the EK */ -/* system should not use the scratch area. */ - -/* The EK scratch area routines are: */ - -/* ZZEKSCA ( EK scratch area umbrella routine ) */ -/* ZZEKSTOP ( EK scratch area, return stack pointer ) */ -/* ZZEKSPSH ( EK scratch area, push data onto stack ) */ -/* ZZEKSDEC ( EK scratch area, decrement stack pointer ) */ -/* ZZEKSPOP ( EK scratch area, pop data from stack ) */ -/* ZZEKSUPD ( EK scratch area, update data ) */ -/* ZZEKSRD ( EK scratch area, read data ) */ -/* ZZEKSCLN ( EK scratch area, clean up ) */ - -/* $ Examples */ - -/* 1) Push data on the scratch area stack. */ - -/* C */ -/* C Push N items onto the stack. */ -/* C */ -/* CALL ZZEKSPSH ( N, DATA ) */ - - -/* 2) Update a range of addresses that may span the stack top. */ - -/* C */ -/* C Since we can't leave a gap between the stack top */ -/* C and the start of the range of addresses we write to, */ -/* C we'll need to know where the top is. The address */ -/* C range to update is BEG:END. */ -/* C */ -/* CALL ZZEKSTOP ( TOP ) */ - -/* IF ( BEG .GT. TOP ) THEN */ - -/* [ Handle error case ] */ - -/* ELSE */ - -/* CALL ZZEKSUPD ( BEG, END, DATA ) */ - -/* END IF */ - - - -/* 3) Read from the scratch area. */ - -/* C */ -/* C Read the contents of the scratch area address */ -/* C range BEG:END into the integer array DATA: */ -/* C */ -/* CALL ZZEKSTOP ( TOP ) */ - -/* IF ( BEG .GT. TOP ) THEN */ - -/* [ Handle error case ] */ - -/* ELSE */ - -/* CALL ZZEKSRD ( BEG, END, DATA ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) The current implementation of this suite of routines opens */ -/* a scratch file. The logical unit connected to the scratch */ -/* file counts against the total that may be used by the calling */ -/* program. Also, the scratch file, if written to, will occupy */ -/* additional disk storage. */ - -/* 2) This suite of routines should not be used by routines outside */ -/* of the EK system. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.2.0, 28-JUN-2005 (NJB) */ - -/* Increased buffer size from 500K to 2M integers. */ - -/* - SPICELIB Version 3.1.0, 29-JUL-2003 (NJB) */ - -/* Added DASWBR call to entry point ZZEKCLN. This call frees */ -/* the buffer records used by the scratch file. */ - -/* - SPICELIB Version 3.0.0, 13-DEC-2001 (NJB) */ - -/* Added entry point ZZEKCLN. */ - -/* - Beta Version 2.0.0, 02-NOV-1995 (NJB) */ - -/* Updated for EK architecture 3. */ - -/* - Beta Version 1.1.0, 01-AUG-1994 (NJB) */ - -/* Scratch area buffer size increased to 500K integers. */ -/* On 32-bit systems, this amounts to 2Mb of storage. */ - -/* - Beta Version 1.0.1, 25-FEB-1993 (NJB) */ - -/* Documented. */ - -/* - Beta Version 1.0.0, 16-DEC-1992 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* manage the EK scratch area */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 3.2.0, 28-JUN-2005 (NJB) */ - -/* Increased buffer size from 500K to 2M integers. */ - -/* - Beta Version 2.0.0, 08-SEP-1994 (NJB) */ - -/* Updated for EK architecture 3. */ - -/* - Beta Version 1.1.0, 01-AUG-1994 (NJB) */ - -/* Scratch area buffer size increased to 500K integers. */ -/* On 32-bit systems, this amounts to 2Mb of storage. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* The parameter MEMSIZ is the size of an integer array used as */ -/* part of the scratch area. The first MEMSIZ scratch area addresses */ -/* refer to elements of this array. Additional storage is supplied */ -/* by the integer logical array of a scratch DAS file; the first */ -/* word of the scratch DAS file corresponds to scratch area address */ -/* MEMSIZ + 1. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (idata) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzekstop; - case 2: goto L_zzekspsh; - case 3: goto L_zzekspop; - case 4: goto L_zzeksdec; - case 5: goto L_zzeksupd; - case 6: goto L_zzeksrd; - case 7: goto L_zzekscln; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKSCA", (ftnlen)7); - } - -/* This routine should never be called directly. */ - - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZEKSCA", (ftnlen)7); - return 0; -/* $Procedure ZZEKSTOP ( EK scratch area, stack top ) */ - -L_zzekstop: -/* $ Abstract */ - -/* Obtain last address in use in EK scratch area. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER TOP */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TOP O EK scratch area stack top. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* TOP is the last address of the EK scratch area stack */ -/* top. This is the highest EK scratch area address */ -/* currently in use. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The EK scratch area stack top ranges from zero to, theoretically, */ -/* the largest integer representable on the host system. */ -/* and never decreases during a program run. Data pushed on the */ -/* EK stack is inserted at address TOP+1 and occupies a contiguous */ -/* range of addresses that extends upwards from this address. */ - -/* $ Examples */ - -/* See the header of the umbrella routine ZZEKSCA for an example */ -/* of use of this routine. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 2.0.0, 08-SEP-1994 (NJB) */ - -/* Updated for EK architecture 3. */ - -/* - Beta Version 1.0.0, 25-FEB-1993 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read from EK scratch area */ - -/* -& */ - *top = t; - return 0; -/* $Procedure ZZEKSPSH ( EK scratch area, push data ) */ - -L_zzekspsh: -/* $ Abstract */ - -/* Push the contents of an integer array onto the EK scratch area */ -/* stack. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER N */ -/* INTEGER IDATA ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of integers to push. */ -/* IDATA I Integer data. */ - -/* $ Detailed_Input */ - -/* N is the number of integers in the array IDATA to */ -/* append to the EK scratch area. The data is */ -/* stored in scratch area addresses T+1:T+N, */ -/* where T is the EK scratch area stack top prior to */ -/* the call to ZZEKSPSH. */ - -/* IDATA is an integer array containing data to append to */ -/* the EK scratch area. The first N elements of */ -/* IDATA are appended to the EK scratch area, in */ -/* order. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is non-positive, this routine simply returns. No error */ -/* is signalled. */ - -/* 2) If an I/O error occurs during the data addition, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let TOP be the EK scratch area stack top prior to a call to this */ -/* routine. Data that is appended to the EK scratch area by this */ -/* routine is inserted at address TOP+1 and occupies a contiguous */ -/* range of addresses that extends upwards from this address. */ - -/* As a side effect of calling this routine, TOP is set to TOP + N. */ - -/* $ Examples */ - -/* See the header of the umbrella routine ZZEKSCA for an example */ -/* of use of this routine. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JAN-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* push integer data onto EK scratch area stack */ - -/* -& */ - -/* No checking in here. */ - - -/* First time through, open a scratch DAS file. */ - - if (first) { - first = FALSE_; - dasops_(&scrhan); - if (failed_()) { - return 0; - } - } - -/* Go back if there's no data to write. */ - - if (*n < 1) { - return 0; - } - -/* Add as much data as possible to our big array. */ - - if (t < 2500000) { -/* Computing MIN */ - i__1 = *n, i__2 = 2500000 - t; - numadd = min(i__1,i__2); - i__1 = numadd; - for (i__ = 1; i__ <= i__1; ++i__) { - scrtch[(i__2 = t + i__ - 1) < 2500000 && 0 <= i__2 ? i__2 : - s_rnge("scrtch", i__2, "zzeksca_", (ftnlen)624)] = idata[ - i__ - 1]; - } - t += numadd; - if (numadd == *n) { - return 0; - } - remain = *n - numadd; - start = numadd + 1; - if (remain == 0) { - return 0; - } - } else { - remain = *n; - start = 1; - } - -/* At this point, REMAIN and START are set, and T reflects the */ -/* amount of data we've pushed so far. If we got this far, */ -/* we'll need to put the rest of the data in the scratch DAS. */ - -/* The DAS system requires separate operations for updating */ -/* an existing range of addresses and for appending data. */ -/* We need to know the last integer address in use in the DAS */ -/* file in order to determine which part of the data will */ -/* be written to addresses previously written to, and which */ -/* part will be appended. */ - - daslla_(&scrhan, &lastc, &lastd, &lasti); - -/* To simplify our arithmetic, we'll work with a variable RT */ -/* that represents the stack top measured relative to the base */ -/* of the DAS integer array. At this point, RT is greater than */ -/* or equal to zero. */ - - rt = t - 2500000; - if (rt < lasti) { - -/* Some data can be added by updating DAS addresses. The */ -/* available range for updating is B:E, where B and E are */ -/* calculated below. This case can occur only when LASTI > 0. */ - - b = rt + 1; -/* Computing MIN */ - i__1 = lasti, i__2 = rt + remain; - e = min(i__1,i__2); - dasudi_(&scrhan, &b, &e, &idata[start - 1]); - numadd = e - b + 1; - start += numadd; - remain -= numadd; - t += numadd; - if (remain == 0) { - return 0; - } - } - -/* At this point, START and REMAIN are set, and T reflects the */ -/* amount of data we've pushed so far.. The remaining data */ -/* must be appended to the scratch DAS file. */ - - dasadi_(&scrhan, &remain, &idata[start - 1]); - t += remain; - return 0; -/* $Procedure ZZEKSPOP ( EK scratch area, pop data ) */ - -L_zzekspop: -/* $ Abstract */ - -/* Pop a specified number of elements from the top of the EK scratch */ -/* area stack, transferring this data to an integer array. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER N */ -/* INTEGER IDATA ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of integers to pop. */ -/* IDATA O Integer data. */ - -/* $ Detailed_Input */ - -/* N is the number of integers to pop from the */ -/* EK scratch area stack. The data is */ -/* read from the scratch area addresses T-N+1:T, */ -/* where T is the stack top prior to the call to */ -/* ZZEKSPOP. */ - -/* $ Detailed_Output */ - -/* IDATA is an integer array containing data read from */ -/* the EK scratch area. The first N elements of */ -/* IDATA assigned the values occupying the top N */ -/* elements of the EK stack. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is non-positive or if N is greater than the number of */ -/* items on the stack, the error SPICE(INVALIDCOUNT) is */ -/* signalled. */ - -/* 2) If an I/O error occurs during the data read, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let TOP be the EK scratch area stack top prior to a call to this */ -/* routine. Data that is read from the EK scratch area by this */ -/* routine is transferred from addresses TOP-N+1 to TOP and occupies */ -/* to the range of addresses 1 to N in the array IDATA. */ - -/* As a side effect of calling this routine, TOP is set to TOP - N. */ - -/* $ Examples */ - -/* See the header of the umbrella routine ZZEKSCA for an example */ -/* of use of this routine. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-SEP-1994 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* pop integer data from EK scratch area stack */ - -/* -& */ - -/* No checking in here. */ - - -/* First time through, open a scratch DAS file. */ - - if (first) { - first = FALSE_; - dasops_(&scrhan); - if (failed_()) { - return 0; - } - } - -/* You can't pop a negative number of elements. */ - - if (*n < 0) { - chkin_("ZZEKSPOP", (ftnlen)8); - setmsg_("Pop count must be non-negative; call requests popping # ele" - "ments.", (ftnlen)65); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKSPOP", (ftnlen)8); - return 0; - -/* It's an error to try to pop more data than we have on the */ -/* stack. */ - - } else if (*n > t) { - chkin_("ZZEKSPOP", (ftnlen)8); - setmsg_("EK stack pointer = #; call requests popping # items.", ( - ftnlen)52); - errint_("#", &t, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKSPOP", (ftnlen)8); - return 0; - } - -/* Read as much data as possible from our big array. */ - - base = t - *n; - if (base < 2500000) { -/* Computing MIN */ - i__1 = *n, i__2 = 2500000 - base; - numrd = min(i__1,i__2); - i__1 = numrd; - for (i__ = 1; i__ <= i__1; ++i__) { - idata[i__ - 1] = scrtch[(i__2 = base + i__ - 1) < 2500000 && 0 <= - i__2 ? i__2 : s_rnge("scrtch", i__2, "zzeksca_", (ftnlen) - 895)]; - } - if (numrd == *n) { - t -= numrd; - return 0; - } - remain = *n - numrd; - base = 2500000; - start = numrd + 1; - } else { - remain = *n; - start = 1; - } - -/* At this point, REMAIN, START and BASE are set. If we got this */ -/* far, we'll need to read the rest of the data from the scratch DAS. */ -/* Compute the base address to read from relative to the start of */ -/* the DAS array. */ - - rb = base - 2500000; - b = rb + 1; - e = rb + remain; - dasrdi_(&scrhan, &b, &e, &idata[start - 1]); - t -= *n; - return 0; -/* $Procedure ZZEKSDEC ( EK scratch area, decrement stack pointer ) */ - -L_zzeksdec: -/* $ Abstract */ - -/* Decrement the EK scratch area stack pointer by a specified count. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER N */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Decrement count. */ - -/* $ Detailed_Input */ - -/* N is the number to subtract from the EK scratch */ -/* area stack pointer. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is non-positive or if N is greater than the number of */ -/* items on the stack, the error SPICE(INVALIDCOUNT) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let TOP be the EK scratch area stack top prior to a call to this */ -/* routine. The effect of calling this routine is that TOP is set */ -/* to TOP - N. */ - -/* $ Examples */ - -/* See the header of the umbrella routine ZZEKSCA for an example */ -/* of use of this routine. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-SEP-1994 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* decrement EK scratch area stack pointer */ - -/* -& */ - -/* No checking in here. */ - - -/* First time through, open a scratch DAS file. */ - - if (first) { - first = FALSE_; - dasops_(&scrhan); - if (failed_()) { - return 0; - } - } - -/* Catch non-positive decrement requests. */ - - if (*n < 0) { - chkin_("ZZEKSDEC", (ftnlen)8); - setmsg_("Decrement value must be non-negative; call requests decreme" - "nt by #.", (ftnlen)67); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKSDEC", (ftnlen)8); - return 0; - -/* It's an error to try to decrement the pointer by more than */ -/* the current stack depth. */ - - } else if (*n > t) { - chkin_("ZZEKSDEC", (ftnlen)8); - setmsg_("EK stack pointer = #; call requests decrement by #.", ( - ftnlen)52); - errint_("#", &t, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKSDEC", (ftnlen)8); - return 0; - } - t -= *n; - return 0; -/* $Procedure ZZEKSUPD ( EK scratch area, update ) */ - -L_zzeksupd: -/* $ Abstract */ - -/* Update the contents of a range of addresses already in use in the */ -/* EK scratch area. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER BEG */ -/* INTEGER END */ -/* INTEGER IDATA ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BEG, */ -/* END I Begin and end addresses of range to update. */ -/* IDATA I Integer data. */ - -/* $ Detailed_Input */ - -/* BEG, */ -/* END are the first and last of a range of EK scratch */ -/* area addresses to write to. BEG and END must */ -/* satisfy the relations */ - -/* 1 < BEG < END < TOP */ -/* - - - */ - -/* where TOP is the last EK scratch area stack top */ -/* at the time this routine is called. */ - -/* IDATA is an integer array containing data to write to */ -/* the specified range of addresses in the EK scratch */ -/* area. The first END-BEG+1 elements of IDATA are */ -/* written to the specified range in the EK scratch */ -/* area, in order. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of BEG or END are outside of the range 1:TOP, */ -/* where TOP is the EK scratch area stack top, the error */ -/* SPICE(INVALIDADDRESS) is signalled. */ - -/* 2) If END < BEG, this routine simply returns. No error */ -/* is signalled. */ - -/* 3) If an I/O error occurs during the data addition, the error */ -/* will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let TOP be the EK scratch area stack top prior to a call to this */ -/* routine. This routine is used to modify values in the scratch */ -/* area that lie in the address range 1:TOP. */ - -/* $ Examples */ - -/* See the header of the umbrella routine ZZEKSCA for an example */ -/* of use of this routine. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 2.0.0, 23-FEB-1995 (NJB) */ - -/* Updated for EK architecture 3. */ - -/* - Beta Version 1.0.0, 25-FEB-1993 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* update data in EK scratch area */ - -/* -& */ - -/* No checking in here. */ - - -/* Validate the addresses. */ - - if (*beg < 1 || *beg > t) { - chkin_("ZZEKSUPD", (ftnlen)8); - setmsg_("Start address BEG was #; valid range is 1:#", (ftnlen)43); - errint_("#", beg, (ftnlen)1); - errint_("#", &t, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("ZZEKSUPD", (ftnlen)8); - return 0; - } else if (*end < 1 || *end > t) { - chkin_("ZZEKSUPD", (ftnlen)8); - setmsg_("End address END was #; valid range is 1:#", (ftnlen)41); - errint_("#", end, (ftnlen)1); - errint_("#", &t, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("ZZEKSUPD", (ftnlen)8); - return 0; - } else if (*beg > *end) { - return 0; - } - if (*end <= 2500000) { - -/* If the entire range is in memory, fine. Update the range */ -/* now. */ - - i__1 = *end; - for (i__ = *beg; i__ <= i__1; ++i__) { - scrtch[(i__2 = i__ - 1) < 2500000 && 0 <= i__2 ? i__2 : s_rnge( - "scrtch", i__2, "zzeksca_", (ftnlen)1296)] = idata[i__ - * - beg]; - } - } else if (*beg <= 2500000) { - -/* Update the portion of the address range that's in memory. */ - - for (i__ = *beg; i__ <= 2500000; ++i__) { - scrtch[(i__1 = i__ - 1) < 2500000 && 0 <= i__1 ? i__1 : s_rnge( - "scrtch", i__1, "zzeksca_", (ftnlen)1305)] = idata[i__ - * - beg]; - } - -/* Now update the rest of the range, which is in the scratch */ -/* DAS file. */ - - i__1 = *end - 2500000; - dasudi_(&scrhan, &c__1, &i__1, &idata[2500000 - *beg + 1]); - } else { - -/* The whole range is in the DAS file. */ - - i__1 = *beg - 2500000; - i__2 = *end - 2500000; - dasudi_(&scrhan, &i__1, &i__2, idata); - } - return 0; -/* $Procedure ZZEKSRD ( EK scratch area, read ) */ - -L_zzeksrd: -/* $ Abstract */ - -/* Read from a range of addresses in the EK scratch area. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER BEG */ -/* INTEGER END */ -/* INTEGER IDATA ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BEG, */ -/* END I Begin and end addresses of range to read from. */ -/* IDATA O Integer data. */ - -/* $ Detailed_Input */ - -/* BEG, */ -/* END are the first and last of a range of EK scratch */ -/* area addresses to read from. BEG and END must */ -/* satisfy the relations */ - -/* 1 < BEG < END < LAST */ -/* - - - */ - -/* where LAST is the last EK scratch area address */ -/* in use at the time this routine is called. */ - -/* $ Detailed_Output */ - -/* IDATA is an integer array containing data read from the */ -/* range of addresses BEG:END in the EK scratch area. */ -/* The first END-BEG+1 elements of IDATA are assigned */ -/* in order using the contents of this address range. */ -/* IDATA must have dimension at least END-BEG+1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of BEG or END are outside of the range 1:LAST, */ -/* where LAST is the last address already in use in the EK */ -/* scratch area, the error SPICE(INVALIDADDRESS) is signalled. */ - -/* 2) If END < BEG, this routine simply returns. No error */ -/* is signalled. */ - -/* 3) If an I/O error occurs during the read, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 4) If IDATA has dimension less than END-BEG+1, the results of */ -/* a call to this routine will be unpredictable, except that */ -/* you can safely predict they'll be wrong. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Let LAST be the last address in use in the EK scratch area prior */ -/* to a call to this routine. This routine is used to read values */ -/* in the scratch area that lie in the address range 1:LAST. */ - -/* $ Examples */ - -/* See the header of the umbrella routine ZZEKSCA for an example */ -/* of use of this routine. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-FEB-1995 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* read from EK scratch area */ - -/* -& */ - -/* No checking in here. */ - - -/* Validate the addresses. */ - - if (*beg < 1 || *beg > t) { - chkin_("ZZEKSRD", (ftnlen)7); - setmsg_("Start address BEG was #; valid range is 1:#", (ftnlen)43); - errint_("#", beg, (ftnlen)1); - errint_("#", &t, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("ZZEKSRD", (ftnlen)7); - return 0; - } else if (*end < 1 || *end > t) { - chkin_("ZZEKSRD", (ftnlen)7); - setmsg_("End address END was #; valid range is 1:#", (ftnlen)41); - errint_("#", end, (ftnlen)1); - errint_("#", &t, (ftnlen)1); - sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21); - chkout_("ZZEKSRD", (ftnlen)7); - return 0; - } else if (*beg > *end) { - return 0; - } - if (*end <= 2500000) { - -/* If the entire range is in memory, fine. Read from the range */ -/* now. */ - - i__1 = *end; - for (i__ = *beg; i__ <= i__1; ++i__) { - idata[i__ - *beg] = scrtch[(i__2 = i__ - 1) < 2500000 && 0 <= - i__2 ? i__2 : s_rnge("scrtch", i__2, "zzeksca_", (ftnlen) - 1512)]; - } - } else if (*beg <= 2500000) { - -/* Read from the portion of the address range that's in memory. */ - - for (i__ = *beg; i__ <= 2500000; ++i__) { - idata[i__ - *beg] = scrtch[(i__1 = i__ - 1) < 2500000 && 0 <= - i__1 ? i__1 : s_rnge("scrtch", i__1, "zzeksca_", (ftnlen) - 1521)]; - } - -/* Now read the rest of the range, which is in the scratch */ -/* DAS file. */ - - i__1 = *end - 2500000; - dasrdi_(&scrhan, &c__1, &i__1, &idata[2500000 - *beg + 1]); - } else { - -/* The whole range is in the DAS file. */ - - i__1 = *beg - 2500000; - i__2 = *end - 2500000; - dasrdi_(&scrhan, &i__1, &i__2, idata); - } - return 0; -/* $Procedure ZZEKSCLN ( EK scratch area, clean up ) */ - -L_zzekscln: -/* $ Abstract */ - -/* Clean up: re-initialize the EK scratch area; unload the */ -/* scratch file. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* This routine unloads the scratch DAS used by this system. */ - -/* $ Particulars */ - -/* This routine is intended to enable test software to unload */ -/* the scratch DAS file used by the EK scratch area routines. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) Many EK routines operate by side effects on the EK scratch */ -/* area, so this routine must be used with caution. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.1.0, 29-JUL-2003 (NJB) */ - -/* Added DASWBR call. This call frees the buffer records used by */ -/* the scratch file. */ - -/* - SPICELIB Version 3.0.0, 27-DEC-2001 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* clean up EK scratch area */ - -/* -& */ - -/* No checking in here. */ - - -/* Clean out the stack buffer. */ - - cleari_(&c_b65, scrtch); - t = 0; - -/* If FIRST has been set to .FALSE., we've an open scratch DAS */ -/* to dispose of. */ - - if (! first) { - -/* Write out the buffered records belonging to the scratch file; */ -/* this will cause them to be returned to the free list. */ - - daswbr_(&scrhan); - -/* Dump the scratch DAS. */ - - dasllc_(&scrhan); - } - -/* Tell the system to re-initialize on the next pass. */ - - first = TRUE_; - return 0; -} /* zzeksca_ */ - -/* Subroutine */ int zzeksca_(integer *n, integer *beg, integer *end, integer - *idata, integer *top) -{ - return zzeksca_0_(0, n, beg, end, idata, top); - } - -/* Subroutine */ int zzekstop_(integer *top) -{ - return zzeksca_0_(1, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, top); - } - -/* Subroutine */ int zzekspsh_(integer *n, integer *idata) -{ - return zzeksca_0_(2, n, (integer *)0, (integer *)0, idata, (integer *)0); - } - -/* Subroutine */ int zzekspop_(integer *n, integer *idata) -{ - return zzeksca_0_(3, n, (integer *)0, (integer *)0, idata, (integer *)0); - } - -/* Subroutine */ int zzeksdec_(integer *n) -{ - return zzeksca_0_(4, n, (integer *)0, (integer *)0, (integer *)0, ( - integer *)0); - } - -/* Subroutine */ int zzeksupd_(integer *beg, integer *end, integer *idata) -{ - return zzeksca_0_(5, (integer *)0, beg, end, idata, (integer *)0); - } - -/* Subroutine */ int zzeksrd_(integer *beg, integer *end, integer *idata) -{ - return zzeksca_0_(6, (integer *)0, beg, end, idata, (integer *)0); - } - -/* Subroutine */ int zzekscln_(void) -{ - return zzeksca_0_(7, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (integer *)0); - } - diff --git a/ext/spice/src/cspice/zzekscan.c b/ext/spice/src/cspice/zzekscan.c deleted file mode 100644 index 9a51e9574e..0000000000 --- a/ext/spice/src/cspice/zzekscan.c +++ /dev/null @@ -1,1096 +0,0 @@ -/* zzekscan.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__512 = 512; -static integer c__2 = 2; -static integer c__29 = 29; -static integer c__13 = 13; - -/* $Procedure ZZEKSCAN ( EK, scan query ) */ -/* Subroutine */ int zzekscan_(char *query, integer *maxntk, integer *maxnum, - integer *ntoken, integer *tokens, integer *lxbegs, integer *lxends, - integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, - integer *chends, logical *scnerr, char *errmsg, ftnlen query_len, - ftnlen chrbuf_len, ftnlen errmsg_len) -{ - /* Initialized data */ - - static char keywds[32*29] = "ALL " "AND " - " " "ASC " - "AVG " "BETWEEN " - " " "BY " "COUNT " - " " "DESC " "DISTINCT " - " " "EQ " "FROM " - " " "GE " "GROU" - "P " "GT " - "HAVING " "IS " - " " "LE " "LIKE " - " " "LT " "MAX " - " " "MIN " "NE " - " " "NOT " "NULL" - " " "OR " - "ORDER " "SELECT " - " " "SUM " "WHERE " - " "; - static integer kwvals[29] = { 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, - 18,19,20,21,22,23,24,25,26,27,28,29 }; - static char spcstr[2*13] = "!=" "^=" "<>" "<=" ">=" "< " "> " "= " "( " - ") " ", " ". " "* "; - static integer spctok[13] = { 1,1,1,1,1,1,1,1,6,7,8,9,10 }; - static integer spcval[13] = { 22,22,22,17,12,19,14,10,0,0,0,0,0 }; - static logical pass1 = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - char ch__1[1], ch__2[1], ch__3[1]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen), - s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer last, cptr, room, i__, j, l; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - extern logical beint_(char *, ftnlen); - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), repmi_(char *, char *, integer *, char * - , ftnlen, ftnlen, ftnlen); - static integer state; - extern integer rtrim_(char *, ftnlen); - static integer nnums, nstrs, chcard; - extern /* Subroutine */ int lx4num_(char *, integer *, integer *, integer - *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer idspec[518]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char hdchrs[80]; - static integer nchars, length; - extern integer frstpc_(char *, ftnlen); - extern logical return_(void); - static char tlchrs[80], tquery[2000]; - extern /* Subroutine */ int ssizei_(integer *, integer *), lxcsid_(char *, - char *, integer *, ftnlen, ftnlen), chkout_(char *, ftnlen), - lxqstr_(char *, char *, integer *, integer *, integer *, ftnlen, - ftnlen), parsqs_(char *, char *, char *, integer *, logical *, - char *, integer *, ftnlen, ftnlen, ftnlen, ftnlen), prefix_(char * - , integer *, char *, ftnlen, ftnlen), nparsd_(char *, doublereal * - , char *, integer *, ftnlen, ftnlen), lxidnt_(integer *, char *, - integer *, integer *, integer *, ftnlen), suffix_(char *, integer - *, char *, ftnlen, ftnlen); - static char chr[1]; - static integer ptr; - -/* $ Abstract */ - -/* Scan tokens in an EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PARSE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Keyword Code Parameters */ - -/* ekkeyw.inc Version 4 24-JAN-1995 (NJB) */ - - - -/* The EK query language keywords and codes are: */ - -/* ALL */ -/* AND */ -/* ASC */ -/* AVG */ -/* BETWEEN */ -/* BY */ -/* COUNT */ -/* DESC */ -/* DISTINCT */ -/* EQ */ -/* FROM */ -/* GE */ -/* GROUP */ -/* GT */ -/* HAVING */ -/* IS */ -/* LE */ -/* LT */ -/* LIKE */ -/* MAX */ -/* MIN */ -/* NE */ -/* NOT */ -/* NULL */ -/* OR */ -/* ORDER */ -/* SELECT */ -/* SUM */ -/* WHERE */ - - -/* End Include Section: EK Keyword Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Token Code Parameters */ - -/* ektokn.inc Version 2 25-JAN-1995 (NJB) */ - -/* Updated to distinguish between special characters. */ - - -/* ektokn.inc Version 1 05-DEC-1994 (NJB) */ - - -/* The EK query language tokens and codes are: */ - -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ - - - -/* End Include Section: EK Token Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I Query specifying events to be found. */ -/* MAXNTK I Maximum number of tokens to return. */ -/* MAXNUM I Maximum number of numeric tokens allowed. */ -/* NTOKEN O Number of tokens returned. */ -/* TOKENS O Code numbers of identified tokens. */ -/* LXBEGS, */ -/* LXENDS O Start and end locations of lexemes in query. */ -/* VALUES O Token values or value pointers, as needed. */ -/* NUMVLS O Buffer containing values of numeric tokens. */ -/* CHRBUF O Buffer containing string tokens and identifiers. */ -/* CHBEGS O Begin locations of string tokens in CHRBUF. */ -/* CHENDS O End locations of string tokens in CHRBUF. */ -/* SCNERR O Flag indicating whether query parsed correctly. */ -/* ERRMSG O Scan error description. */ - -/* $ Detailed_Input */ - -/* QUERY is character string containing an EK query. See */ -/* the header of the subroutine EKFIND for a */ -/* detailed description of the EK query language. */ - -/* MAXNTK is the maximum number of tokens that may occur */ -/* in QUERY. */ - -/* MAXNUM is the maximum number of tokens representing */ -/* numeric values that may occur in QUERY. */ - -/* $ Detailed_Output */ - -/* NTOKEN is the number of tokens found in the input QUERY. */ -/* This number will be less than or equal to MAXNTK. */ - -/* TOKENS is an array of codes for the tokens found in QUERY. */ -/* The parameter values for these codes are not part */ -/* of the EKSCAN specification; however, these values */ -/* must be kept consistent with those used by EKPARS. */ -/* The caller of EKSCAN should declare TOKENS with */ -/* dimension MAXNTK. */ - -/* LXBEGS, */ -/* LXENDS are, respectively, arrays of begin and end pointers */ -/* for the lexemes occuring in QUERY. Lexemes are the */ -/* strings in QUERY that correspond to tokens. For */ -/* example, '4.9D0' and '3' are both lexemes that map */ -/* to the token . */ - -/* VALUES is an array of token values. The Ith element of */ -/* VALUES refers to the Ith token. */ - -/* If the Ith token is a number, the Ith element of */ -/* VALUES is a pointer into the NUMVLS array where */ -/* the value of the number is stored. The Ith token */ -/* code indicates whether the number was a signed */ -/* integer or d.p. number. */ - -/* If the Ith token is a keyword, the Ith element of */ -/* VALUES is the code for that keyword. */ - -/* If the Ith token is a quoted string, the Ith */ -/* element of VALUES is the common index in the arrays */ -/* CHBEGS and CHENDS where the begin and end positions */ -/* in CHRBUF of the parsed identifier are stored. */ -/* Identifiers are converted to upper case when they */ -/* are scanned. */ - -/* If the Ith token is an identifier, the Ith element */ -/* of VALUES has the same role as in the case of a */ -/* quoted string. */ - -/* If the Ith token is a special character, the Ith */ -/* element of values is undefined; the value of */ -/* TOKENS is the value of ICHAR() applied to the */ -/* character. */ - -/* The caller of EKSCAN should declare VALUES with */ -/* dimension MAXNTK. */ - - -/* NUMVLS is an array of numeric values of parsed numeric */ -/* tokens. The caller of EKSCAN should declare */ -/* NUMVLS with dimension at least MAXNUM. */ - -/* CHRBUF is a character string used to contain the values */ -/* of literal string tokens and identifiers. The */ -/* value MAXQRY is guaranteed to be a safe length for */ -/* CHRBUF, though the caller of EKSCAN can probably */ -/* get away with less. */ - -/* The reason for the existence of CHRBUF is that */ -/* the lexemes representing quoted strings may contain */ -/* doubled quote characters representing embedded */ -/* quotes; these characters are undoubled when the */ -/* lexemes are parsed. Hence the parsed quoted */ -/* strings are not necessarily substrings of the */ -/* original lexemes from which they are derived. */ - -/* CHBEGS, */ -/* CHENDS are, respectively, arrays of begin and end pointers */ -/* for parsed quoted strings and identifiers stored in */ -/* CHRBUF. */ - -/* SCNERR is a logical flag which is set to .TRUE. if a */ -/* scanning error is detected, and is set to .FALSE. */ -/* otherwise. If SCNERR is returned .TRUE., all */ -/* outputs save ERRMSG are undefined. */ - -/* ERRMSG is an error message that describes the cause of */ -/* a scanning error, if such an error is detected. */ -/* When SCNERR is returned .FALSE., ERRMSG is set to */ -/* blank. */ - -/* $ Parameters */ - -/* See the include files. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* This routine set the error flag ERROR to .TRUE. and returns an */ -/* error message in the event that a syntax error precludes scanning */ -/* the input string. Note that incorrect queries may scan */ -/* successfully; it is the responsibility of the caller to ensure */ -/* syntactic and semantic correctness of queries. */ - -/* The following error messages are returned by this routine: */ - -/* 'No table list preceded first keyword.' */ -/* 'Column clause and WHERE keyword are missing.' */ -/* 'WHERE keyword is missing.' */ -/* 'Too many tokens in query; max allowed is #.' */ -/* 'Column list was empty.' */ -/* 'Quoted string in positions #:# is empty.' */ -/* 'Unexpected token found in query: #' */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine breaks up a valid EK query into an array of */ -/* individual tokens in order to facilitate parsing. */ - -/* Time values and quoted strings are treated as single tokens. */ - -/* $ Examples */ - -/* 1) Examples of strings containing lexically valid queries */ -/* are: */ - -/* FROM TIME * WHERE TIME LT 'MO SCLK 15328997.121' */ - -/* from time, event_type where event_type eq "MOC_EVENT" */ - -/* FROM * WHERE TIME GE "1994 MAR 1" AND IDCODE EQ -94030 */ - -/* FROM * WHERE */ -/* TIME GE "1994 MAR 1" */ -/* AND TIME LE '1-MAR-1994 18:4:1' */ -/* AND EVENT_TYPE LIKE '*PMIRR*' */ - -/* FROM * WHERE TIME LT "MO SCLK 15328997.121" ORDER BY TIME */ - -/* from col_1 col_2 col_3 where time lt '2010' */ - -/* from col_1 col_2 col_3 */ - -/* from * */ - -/* from * order by event_type */ - -/* For a query to be semantically valid, all of the column names */ -/* referenced in the query must be present in at least one */ -/* loaded E-kernel. */ - - -/* 2) Examples of lexically invalid queries are: */ - -/* from time where time lt */ -/* 1991 jan 1 {time string is not */ -/* quoted} */ - -/* from time * where time */ -/* .lt. 1991 jan 1 {operator should be lt} */ - - -/* from event_type * where */ -/* event_type eq "" {quoted string is empty} */ - -/* from event_type ^ where */ -/* event_type eq "cmd" {unexpected token} */ - -/* from column1 where */ -/* column1 eq 3c {invalid numeric token} */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.1, 22-OCT-1996 (NJB) */ - -/* Corrected miscellaneous errors in the header. */ - -/* - SPICELIB Version 3.0.0, 14-NOV-1995 (NJB) */ - -/* Complete re-write for architecture 3. */ - -/* -& */ -/* $ Index_Entries */ - -/* scan EK query */ -/* find tokens in EK query */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 3.0.0, 14-NOV-1995 (NJB) */ - -/* Complete re-write for architecture 3. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Number of tokens made up of special characters: */ - - -/* Max length of any such token: */ - - -/* Local variables */ - - -/* Statement Functions */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* These keyword declarations must be made in alphabetical order! */ - - -/* The following tokens are sequences of special characters. Some */ -/* of these are synonyms for keywords; some have other meanings. In */ -/* this data statement, the longer sequences must precede the shorter */ -/* ones, in order for the matching algorithm to work properly. */ - - -/* Statement Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKSCAN", (ftnlen)8); - } - -/* The first time through, set up our identifier character set. */ - - if (pass1) { - -/* Each identifier must start with a letter (of either case). */ -/* The subsequent characters must be letters, numbers, dollar */ -/* signs or underscores. */ - - s_copy(hdchrs, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", - (ftnlen)80, (ftnlen)52); - s_copy(tlchrs, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789$_", (ftnlen)80, (ftnlen)64); - ssizei_(&c__512, idspec); - lxcsid_(hdchrs, tlchrs, idspec, (ftnlen)80, (ftnlen)80); - pass1 = FALSE_; - } - -/* We'll work with a local copy of the query. */ - - l = rtrim_(query, query_len); - s_copy(tquery, query, (ftnlen)2000, l); - -/* Initialize pointers and counts. */ - - cptr = 1; - nnums = 0; - nstrs = 0; - chcard = 0; - *ntoken = 0; - -/* Start out in the token search state. */ - - state = 1; - while(state != 3) { - if (state == 1) { - -/* In our initial state, we're looking for a new token. */ -/* We stop when we have enough characters to determine */ -/* which kind of token we have, or if we run out of */ -/* characters. */ - -/* Set our character pointer to the beginning of the next */ -/* token. */ - - if (*ntoken > 0) { - cptr = lxends[*ntoken - 1] + 1; - } - if (cptr > l) { - state = 3; - } else { - while(*(unsigned char *)&tquery[cptr - 1] == ' ' && cptr < l) - { - ++cptr; - } - if (*(unsigned char *)&tquery[cptr - 1] == ' ') { - -/* We're out of non-blank characters to look at. */ - - state = 3; - } else { - *(unsigned char *)chr = *(unsigned char *)&tquery[cptr - - 1]; - state = 2; - } - } - -/* STATE is in the set {NEWTOK, TERM}. */ - - } else if (state == 2) { - -/* If we got this far, we have the initial character of */ -/* something that could be a valid token. We test for */ - -/* - quoted strings */ -/* - numbers */ -/* - identifiers */ -/* - special symbols */ - -/* in that order. Of course, we must have room in our output */ -/* arrays for the token. */ - - if (*ntoken == *maxntk) { - s_copy(errmsg, "Maximum allowed number of tokens is #; at le" - "ast # tokens are present in QUERY.", errmsg_len, ( - ftnlen)78); - repmi_(errmsg, "#", maxntk, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - i__1 = *maxntk + 1; - repmi_(errmsg, "#", &i__1, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - *(unsigned char *)&ch__1[0] = *(unsigned char *)chr; - if (*(unsigned char *)&ch__1[0] == '\'' || *(unsigned char *)& - ch__1[0] == '"') { - state = 4; - } else /* if(complicated condition) */ { - *(unsigned char *)&ch__1[0] = *(unsigned char *)chr; - if (*(unsigned char *)&ch__1[0] == '.') { - state = 5; - } else /* if(complicated condition) */ { - *(unsigned char *)&ch__1[0] = *(unsigned char *)chr; - *(unsigned char *)&ch__2[0] = *(unsigned char *)&ch__1[0]; - *(unsigned char *)&ch__3[0] = *(unsigned char *)&ch__1[0]; - if (*(unsigned char *)&ch__2[0] >= '0' && *(unsigned char - *)&ch__2[0] <= '9' || (*(unsigned char *)&ch__3[0] - == '+' || *(unsigned char *)&ch__3[0] == '-') || - *(unsigned char *)&ch__1[0] == '.') { - state = 6; - } else /* if(complicated condition) */ { - *(unsigned char *)&ch__1[0] = *(unsigned char *)chr; - if (*(unsigned char *)&ch__1[0] >= 'A' && *(unsigned - char *)&ch__1[0] <= 'Z' || *(unsigned char *)& - ch__1[0] >= 'a' && *(unsigned char *)&ch__1[0] - <= 'z') { - state = 7; - } else { - state = 8; - } - } - } - } - -/* At this point, the next value of STATE has been determined. */ -/* STATE is in the set */ - -/* {QSTR, NUMBER, IDENT, SPCIAL} */ - - } else if (state == 4) { - -/* Look for a quoted string starting at location CPTR. */ -/* Use the current character as the quote character. */ - - lxqstr_(tquery, chr, &cptr, &last, &nchars, (ftnlen)2000, (ftnlen) - 1); - if (nchars == 0) { - s_copy(errmsg, "Invalid quoted string at location #.", - errmsg_len, (ftnlen)36); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* We've located a quoted string lexeme. Parse the lexeme */ -/* and obtain the corresponding string value. First make */ -/* sure we have enough room for the parsed string. */ - - room = i_len(chrbuf, chrbuf_len) - chcard; - if (nchars > room) { - s_copy(errmsg, "Insufficient space to store quoted string at" - " location #; # chars needed; only # are available.", - errmsg_len, (ftnlen)94); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - repmi_(errmsg, "#", &nchars, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - repmi_(errmsg, "#", &room, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - i__1 = chcard; - parsqs_(tquery + (cptr - 1), chr, chrbuf + i__1, &length, scnerr, - errmsg, &ptr, cptr + nchars - 1 - (cptr - 1), (ftnlen)1, - chrbuf_len - i__1, errmsg_len); - if (*scnerr) { - prefix_("#", &c__2, errmsg, (ftnlen)1, errmsg_len); - repmc_(errmsg, "#", "Error occurred while parsing quoted str" - "ing token at location #:", errmsg, errmsg_len, ( - ftnlen)1, (ftnlen)63, errmsg_len); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* We've found a valid quoted string. Set our outputs. */ - - ++(*ntoken); - tokens[*ntoken - 1] = 5; - ++nstrs; - values[*ntoken - 1] = nstrs; - chbegs[nstrs - 1] = chcard + 1; - chends[nstrs - 1] = chcard + length; - chcard = chends[nstrs - 1]; - lxbegs[*ntoken - 1] = cptr; - lxends[*ntoken - 1] = last; - state = 1; - -/* STATE is now NXTTOK. */ - - } else if (state == 5) { - -/* The token begins with a period. We could be looking at */ -/* a floating point number, or we could be looking at a */ -/* period in a compound identifier. */ - -/* Look for a number starting at location CPTR. */ - - lx4num_(tquery, &cptr, &last, &nchars, (ftnlen)2000); - if (nchars > 0) { - state = 6; - } else { - state = 8; - } - -/* STATE has been set to NUMBER or SPCIAL. CPTR and NTOKEN */ -/* remain unchanged. */ - - } else if (state == 6) { - -/* Look for a number starting at location CPTR. */ - - lx4num_(tquery, &cptr, &last, &nchars, (ftnlen)2000); - if (nchars == 0) { - s_copy(errmsg, "Invalid numeric token at location #.", - errmsg_len, (ftnlen)36); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* Parse the token, but only do so if there's enough */ -/* room to store the result. */ - - room = *maxnum - nnums; - if (room < 1) { - s_copy(errmsg, "Insufficient space to store value of number " - "at location #; # elements are available in the NUMVL" - "S array; # are required.", errmsg_len, (ftnlen)120); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - repmi_(errmsg, "#", maxnum, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - i__1 = *maxnum + 1; - repmi_(errmsg, "#", &i__1, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - nparsd_(tquery + (cptr - 1), &numvls[nnums], errmsg, &ptr, last - - (cptr - 1), errmsg_len); - if (s_cmp(errmsg, " ", errmsg_len, (ftnlen)1) != 0) { - -/* This check is done for safety; by construction, we */ -/* should always have a valid number if LX4NUM */ -/* thinks we have a valid number, so in fact ERRMSG */ -/* should always be blank. */ - - prefix_("#", &c__2, errmsg, (ftnlen)1, errmsg_len); - repmc_(errmsg, "#", "Error found in numeric token at locatio" - "n #:", errmsg, errmsg_len, (ftnlen)1, (ftnlen)43, - errmsg_len); - i__1 = cptr + ptr - 1; - repmi_(errmsg, "#", &i__1, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* We found a valid numeric token. We distinguish */ -/* between integers and d.p. numbers; set the token */ -/* to the most restrictive category possible. */ - - ++(*ntoken); - if (beint_(tquery + (cptr - 1), last - (cptr - 1))) { - tokens[*ntoken - 1] = 3; - } else { - tokens[*ntoken - 1] = 4; - } - -/* Set the rest of our outputs. */ - - ++nnums; - values[*ntoken - 1] = nnums; - lxbegs[*ntoken - 1] = cptr; - lxends[*ntoken - 1] = last; - state = 1; - -/* STATE is now NXTTOK. */ - - } else if (state == 7) { - -/* Look for an identifier starting at location CPTR. */ - - lxidnt_(idspec, tquery, &cptr, &last, &nchars, (ftnlen)2000); - if (nchars == 0) { - -/* This check is done for safety; by construction, we */ -/* should always have a valid identifier of at least one */ -/* character if we get to the IDENT state, so in fact */ -/* NCHARS should never equal zero. */ - - s_copy(errmsg, "Invalid identifier at location #.", - errmsg_len, (ftnlen)33); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* We've located an identifier lexeme. Make sure we have */ -/* enough room for the string. */ - - room = i_len(chrbuf, chrbuf_len) - chcard; - if (nchars > room) { - s_copy(errmsg, "Insufficient space to store identifier strin" - "g at location #; # chars needed; only # are availabl" - "e.", errmsg_len, (ftnlen)98); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - repmi_(errmsg, "#", &nchars, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - repmi_(errmsg, "#", &room, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* We've found a valid identifier or keyword. Set our */ -/* outputs. Convert the string to upper case. */ - - ++(*ntoken); - i__1 = chcard; - ucase_(tquery + (cptr - 1), chrbuf + i__1, last - (cptr - 1), - chcard + nchars - i__1); - i__1 = chcard; - i__ = bsrchc_(chrbuf + i__1, &c__29, keywds, chcard + nchars - - i__1, (ftnlen)32); - if (i__ > 0) { - -/* It's a keyword. */ - - tokens[*ntoken - 1] = 1; - values[*ntoken - 1] = kwvals[(i__1 = i__ - 1) < 29 && 0 <= - i__1 ? i__1 : s_rnge("kwvals", i__1, "zzekscan_", ( - ftnlen)952)]; - lxbegs[*ntoken - 1] = cptr; - lxends[*ntoken - 1] = last; - state = 1; - } else { - -/* It's an identifier. */ - - ++nstrs; - chbegs[nstrs - 1] = chcard + 1; - chends[nstrs - 1] = chcard + nchars; - chcard = chends[nstrs - 1]; - tokens[*ntoken - 1] = 2; - values[*ntoken - 1] = nstrs; - lxbegs[*ntoken - 1] = cptr; - lxends[*ntoken - 1] = last; - state = 1; - -/* We finished scanning an identifier. */ - -/* STATE is set to NXTTOK. */ - - } - -/* We scanned a keyword or an identifier. */ - -/* STATE is set to NXTTOK. */ - - } else if (state == 8) { - -/* Look for a valid token starting with a special character at */ -/* location CPTR. We attempt to match the longest possible */ -/* special token. */ - -/* Computing MIN */ - i__1 = 2, i__2 = l - cptr + 1; - i__ = min(i__1,i__2); - j = 0; - while(i__ >= 1 && j == 0) { - last = cptr + i__ - 1; - j = isrchc_(tquery + (cptr - 1), &c__13, spcstr, last - (cptr - - 1), (ftnlen)2); - if (j == 0) { - --i__; - } - } - if (j > 0) { - -/* We've identified a valid token. */ - - ++(*ntoken); - tokens[*ntoken - 1] = spctok[(i__1 = j - 1) < 13 && 0 <= i__1 - ? i__1 : s_rnge("spctok", i__1, "zzekscan_", (ftnlen) - 1013)]; - values[*ntoken - 1] = spcval[(i__1 = j - 1) < 13 && 0 <= i__1 - ? i__1 : s_rnge("spcval", i__1, "zzekscan_", (ftnlen) - 1014)]; - lxbegs[*ntoken - 1] = cptr; - lxends[*ntoken - 1] = cptr - 1 + rtrim_(spcstr + (((i__1 = j - - 1) < 13 && 0 <= i__1 ? i__1 : s_rnge("spcstr", i__1, - "zzekscan_", (ftnlen)1016)) << 1), (ftnlen)2); - state = 1; - } else { - s_copy(errmsg, "Invalid character found at location #. ", - errmsg_len, (ftnlen)39); - repmi_(errmsg, "#", &cptr, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - -/* If the offending character is printable, include it */ -/* in the error message. Otherwise, include the integer */ -/* code for the character. */ - - if (frstpc_(chr, (ftnlen)1) > 0) { - suffix_(" = '#'", &c__2, errmsg, (ftnlen)17, - errmsg_len); - repmc_(errmsg, "#", chr, errmsg, errmsg_len, (ftnlen)1, ( - ftnlen)1, errmsg_len); - } else { - suffix_("ICHAR() = #", &c__2, errmsg, (ftnlen) - 22, errmsg_len); - i__1 = *(unsigned char *)chr; - repmi_(errmsg, "#", &i__1, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - } - *scnerr = TRUE_; - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; - } - -/* STATE is now NXTTOK. */ - - } - } - -/* If we got this far, we've found the tokens in the query. */ - - *scnerr = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - chkout_("ZZEKSCAN", (ftnlen)8); - return 0; -} /* zzekscan_ */ - diff --git a/ext/spice/src/cspice/zzekscdp.c b/ext/spice/src/cspice/zzekscdp.c deleted file mode 100644 index bb614c7f8f..0000000000 --- a/ext/spice/src/cspice/zzekscdp.c +++ /dev/null @@ -1,529 +0,0 @@ -/* zzekscdp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSCDP ( EK, set column data pointer ) */ -/* Subroutine */ int zzekscdp_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *datptr) -{ - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), chkin_( - char *, ftnlen); - integer recno, ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - integer colidx, ptrloc; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Set the data pointer for a specified EK column entry. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* DATPTR I Data pointer of column entry. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry whose data pointer is to be set. */ - -/* DATPTR is the data pointer of the specified column entry. */ -/* When DATPTR is positive, it represents a pointer */ -/* to a data value. The interpretation of the */ -/* pointer depends on the class of the column entry. */ -/* DATPTR may also take on the distinguished values */ - -/* UNINIT (indicated uninitialized entry) */ -/* NULL (indicated null entry) */ -/* NOBACK (indicated uninitialized backup entry) */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine hides details of column entry data pointer access. */ -/* The inverse of this routine is ZZEKGCDP. */ - -/* $ Examples */ - -/* 1) Set a colummn's data pointer to indicate that a column entry */ -/* is uninitialized. The parameter UNINIT is defined in */ -/* ekrecptr.inc */ - -/* CALL ZZEKSCDP ( HANDLE, SEGDSC, COLDSC, RECPTR, UNINIT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - colidx = coldsc[8]; - if (colidx < 1 || colidx > ncols) { - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - chkin_("ZZEKSCDP", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " - "EK = #", (ftnlen)65); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &ncols, (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKSCDP", (ftnlen)8); - return 0; - } - -/* Compute the data pointer location, and set the pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasudi_(handle, &ptrloc, &ptrloc, datptr); - return 0; -} /* zzekscdp_ */ - diff --git a/ext/spice/src/cspice/zzekscmp.c b/ext/spice/src/cspice/zzekscmp.c deleted file mode 100644 index 61f7d60e1d..0000000000 --- a/ext/spice/src/cspice/zzekscmp.c +++ /dev/null @@ -1,1025 +0,0 @@ -/* zzekscmp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSCMP ( EK, scalar value comparison ) */ -logical zzekscmp_(integer *op, integer *handle, integer *segdsc, integer * - coldsc, integer *row, integer *eltidx, integer *dtype, char *cval, - doublereal *dval, integer *ival, logical *null, ftnlen cval_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen, - ftnlen); - - /* Local variables */ - char eltc[1024]; - doublereal eltd; - integer elti, unit; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer cvlen; - logical found, enull; - extern logical failed_(void), matchi_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - integer cmplen; - doublereal numval; - integer coltyp, strlen; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, - ftnlen); - integer rel; - extern /* Subroutine */ int zzekrsc_(integer *, integer *, integer *, - integer *, integer *, integer *, char *, logical *, logical *, - ftnlen), zzekrsd_(integer *, integer *, integer *, integer *, - integer *, doublereal *, logical *, logical *), zzekrsi_(integer * - , integer *, integer *, integer *, integer *, integer *, logical * - , logical *); - -/* $ Abstract */ - -/* Compare a specified scalar EK column entry with a scalar value. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Template Matching Wild Characters */ - - -/* ekwild.inc Version 1 16-JAN-1995 (NJB) */ - - -/* Within the EK system, templates used for pattern matching */ -/* are those accepted by the SPICELIB routine MATCHW. MATCHW */ -/* accepts two special characters: one representing wild */ -/* strings and one representing wild characters. This include */ -/* file defines those special characters for use within the EK */ -/* system. */ - - -/* Wild string symbol: this character matches any string. */ - - -/* Wild character symbol: this character matches any character. */ - - -/* End Include Section: EK Template Matching Wild Characters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* OP I Relational operator code. */ -/* HANDLE I EK file handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* ROW I ID of row containing column entry to compare. */ -/* ELTIDX I Index of element in array-valued column entry. */ -/* DTYPE I Data type of input value. */ -/* CVAL I Character string to compare with column entry. */ -/* DVAL I D.p. value to compare with column entry. */ -/* IVAL I Integer value to compare with column entry. */ -/* NULL I Flag indicating whether scalar is null. */ - -/* The function returns .TRUE. if and only if the specified column */ -/* entry and input value of the corresponding data type satisfy the */ -/* relation specified by the input argument OP. */ - -/* $ Detailed_Input */ - -/* OP is an integer code representing a binary relational */ -/* operator. The possible values of OP are the */ -/* parameters */ - -/* EQ */ -/* GE */ -/* GT */ -/* LE */ -/* LIKE */ -/* LT */ -/* NE */ -/* ISNULL */ -/* NOTNUL */ - - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the EK segment descriptor of the column entry */ -/* to be compared. */ - -/* COLDSC is an EK column descriptor for the column */ -/* containing the entry to be compared. */ - -/* ROW is the identifier of the row containing the column */ -/* entry to be compared. Note that these identifiers */ -/* are polymorphic: their meaning is a function of */ -/* the class of column that contains the entry of */ -/* interest. */ - -/* ELTIDX is the index of the column entry element to be */ -/* compared, if the column is array-valued. ELTIDX */ -/* is ignored for scalar columns. */ - -/* DTYPE is the data type of the input scalar value. */ - - -/* CVAL, */ -/* DVAL, */ -/* IVAL are, respectively, character, double precision, */ -/* and integer scalar variables. The column entry */ -/* is compared against whichever of these has the */ -/* same data type as the entry; the other two */ -/* variables are ignored. If the data type of the */ -/* column entry is TIME, the entry is compared with */ -/* the variable DVAL. */ - -/* NULL */ - -/* $ Detailed_Output */ - -/* The function returns .TRUE. if and only if the specified column */ -/* entry and input value of the corresponding data type satisfy the */ -/* relation specified by the input argument OP. */ - -/* If the specified column entry is null, it is considered to */ -/* precede all non-null values, and the logical value of the */ -/* expression */ - -/* OP */ - -/* is determined accordingly. Null character values do not satisfy */ -/* the relation */ - -/* LIKE */ - -/* for any character value. */ - -/* $ Parameters */ - -/* Within the EK system, relational operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operator */ - -/* LIKE */ - -/* which is used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - -/* Null values are considered to precede all non-null values. */ - -/* $ Exceptions */ - -/* 1) If the input file handle is invalid, the error will be */ -/* diagnosed by routines called by this routine. */ -/* The function value is .FALSE. in this case. */ - -/* 2) If an I/O error occurs while attempting to find the address */ -/* range of the specified column entry element, the error will */ -/* be diagnosed by routines called by this routine. The */ -/* function value is .FALSE. in this case. */ - -/* 3) If any of SEGDSC, COLDSC, or ROW are invalid, this routine */ -/* may fail in unpredictable, but possibly spectacular, ways. */ -/* Except as described in this header section, no attempt is */ -/* made to handle these errors. */ - -/* 4) If the data type code in the input column descriptor is not */ -/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* 5) If the specified column entry cannot be found, the error */ -/* SPICE(INVALIDINDEX) is signalled. The function value is */ -/* .FALSE. in this case. */ - -/* 6) If the relational operator code OP is not recognized, the */ -/* error SPICE(UNNATURALRELATION) is signalled. The function */ -/* value is .FALSE. in this case. */ - - -/* $ Files */ - -/* See the description of the argument HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is an EK utility intended to centralize a frequently */ -/* performed comparison operation. */ - -/* $ Examples */ - -/* See ZZEKRMCH. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 31-MAY-2009 (NJB) */ - -/* Bug fix: routine failed to account for the possibility */ -/* that scalar string column entries can have unlimited */ -/* length. Now at most the first MAXSTR characters of such */ -/* an entry are used in comparisons. */ - -/* - SPICELIB Version 1.1.0, 21-DEC-2001 (NJB) */ - -/* Bug fix: routine now indicates "no match" when operator */ -/* is LIKE or UNLIKE and column entry is null. */ - -/* - SPICELIB Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - -/* The function value defaults to .FALSE. */ - - ret_val = FALSE_; - -/* Look up the specified column element. */ - - coltyp = coldsc[1]; - if (coltyp == 1) { - -/* We'll use at most the first MAXSTR characters of the input */ -/* string. */ - -/* Computing MIN */ - i__1 = i_len(cval, cval_len); - cvlen = min(i__1,1024); - -/* Fetch the column entry to be compared. Note that ROW */ -/* is a polymorphic identifier. See ZZEKRSC for details */ -/* on how ROW is used. */ - - zzekrsc_(handle, segdsc, coldsc, row, eltidx, &strlen, eltc, &enull, & - found, (ftnlen)1024); - if (failed_()) { - -/* Don't check out here because we haven't checked in. */ - - return ret_val; - } - -/* Let CMPLEN be the string length to use in comparisons. */ - - if (found && ! enull) { - cmplen = min(strlen,1024); - } else { - cmplen = 0; - } - } else if (coltyp == 2 || coltyp == 4) { - zzekrsd_(handle, segdsc, coldsc, row, eltidx, &eltd, &enull, &found); - } else if (coltyp == 3) { - zzekrsi_(handle, segdsc, coldsc, row, eltidx, &elti, &enull, &found); - } else { - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("Data type code # not recognized.", (ftnlen)32); - errint_("#", &coltyp, (ftnlen)1); - sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - if (! found) { - dashlu_(handle, &unit); - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry eleme" - "nt was not found.", (ftnlen)76); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", row, (ftnlen)1); - errint_("#", eltidx, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - -/* Handle the ISNULL and NOTNUL operators, if perchance we see them. */ - - if (*op == 9) { - ret_val = enull; - return ret_val; - } else if (*op == 10) { - ret_val = ! enull; - return ret_val; - } - -/* Find the order relation that applies to the input values. */ - -/* Null values precede all others. */ - - if (enull) { - if (*null) { - rel = 1; - } else { - rel = 5; - } - } else if (*null) { - if (enull) { - rel = 1; - } else { - rel = 3; - } - } else { - - -/* Compare the value we looked up with the input scalar value. */ - - if (coltyp == 1) { - if (*dtype != 1) { - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("Column type is #; value type is #.", (ftnlen)34); - errint_("#", &coltyp, (ftnlen)1); - errint_("#", dtype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - if (l_lt(eltc, cval, cmplen, cvlen)) { - rel = 5; - } else if (l_gt(eltc, cval, cmplen, cvlen)) { - rel = 3; - } else { - rel = 1; - } - } else if (coltyp == 4) { - if (*dtype != 4 && *dtype != 2) { - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("Column type is #; value type is #.", (ftnlen)34); - errint_("#", &coltyp, (ftnlen)1); - errint_("#", dtype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - if (eltd < *dval) { - rel = 5; - } else if (eltd > *dval) { - rel = 3; - } else { - rel = 1; - } - } else if (coltyp == 2) { - if (*dtype == 3) { - numval = (doublereal) (*ival); - } else if (*dtype == 2 || *dtype == 4) { - numval = *dval; - } else { - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("Column type is #; value type is #.", (ftnlen)34); - errint_("#", &coltyp, (ftnlen)1); - errint_("#", dtype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - if (eltd < numval) { - rel = 5; - } else if (eltd > numval) { - rel = 3; - } else { - rel = 1; - } - } else if (coltyp == 3) { - if (*dtype == 3) { - numval = (doublereal) (*ival); - } else if (*dtype == 2) { - numval = *dval; - } else { - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("Column type is #; value type is #.", (ftnlen)34); - errint_("#", &coltyp, (ftnlen)1); - errint_("#", dtype, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - if ((doublereal) elti < numval) { - rel = 5; - } else if ((doublereal) elti > numval) { - rel = 3; - } else { - rel = 1; - } - } else { - -/* Something untoward has happened in our column descriptor */ -/* argument. */ - - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("The data type code # was not recognized.", (ftnlen)40); - errint_("#", &coltyp, (ftnlen)1); - sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - } - -/* Determine the truth of the input relational expression. */ - - if (*op == 1) { - ret_val = rel == 1; - } else if (*op == 5) { - ret_val = rel == 5; - } else if (*op == 4) { - ret_val = rel != 3; - } else if (*op == 3) { - ret_val = rel == 3; - } else if (*op == 2) { - ret_val = rel != 5; - } else if (*op == 6) { - ret_val = rel != 1; - } else if (*op == 7 && *dtype == 1) { - if (*null || enull) { - ret_val = FALSE_; - } else { - ret_val = matchi_(eltc, cval, "*", "%", cmplen, cvlen, (ftnlen)1, - (ftnlen)1); - } - } else if (*op == 8 && *dtype == 1) { - if (*null || enull) { - ret_val = FALSE_; - } else { - ret_val = ! matchi_(eltc, cval, "*", "%", cmplen, cvlen, (ftnlen) - 1, (ftnlen)1); - } - } else { - -/* Sorry, we couldn't resist. */ - - chkin_("ZZEKSCMP", (ftnlen)8); - setmsg_("The relational operator # was not recognized or was not app" - "licable for data type #.", (ftnlen)83); - errint_("#", op, (ftnlen)1); - errint_("#", dtype, (ftnlen)1); - sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24); - chkout_("ZZEKSCMP", (ftnlen)8); - return ret_val; - } - return ret_val; -} /* zzekscmp_ */ - diff --git a/ext/spice/src/cspice/zzeksdsc.c b/ext/spice/src/cspice/zzeksdsc.c deleted file mode 100644 index 2d9074d7e6..0000000000 --- a/ext/spice/src/cspice/zzeksdsc.c +++ /dev/null @@ -1,250 +0,0 @@ -/* zzeksdsc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSDSC ( EK, get segment descriptor ) */ -/* Subroutine */ int zzeksdsc_(integer *handle, integer *segno, integer * - segdsc) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - extern /* Subroutine */ int zzekmloc_(integer *, integer *, integer *, - integer *); - integer mbase, mp; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - -/* $ Abstract */ - -/* Look up the descriptor of a specified EK segment. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGNO I Segment number. */ -/* SEGDSC O Segment descriptor. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* SEGNO is the number of a segment whose descriptor is */ -/* desired. A segment number is simply the ordinal */ -/* position of the segment in its parent EK. */ - -/* $ Detailed_Output */ - -/* SEGDSC is the descriptor of the specified segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If SEGNO is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine centralizes the coded needed to look up the */ -/* descriptor of a specified segment. This is a frequently */ -/* performed function. */ - -/* $ Examples */ - -/* See EKACEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - - zzekmloc_(handle, segno, &mp, &mbase); - i__1 = mbase + 1; - i__2 = mbase + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - return 0; -} /* zzeksdsc_ */ - diff --git a/ext/spice/src/cspice/zzeksei.c b/ext/spice/src/cspice/zzeksei.c deleted file mode 100644 index e19371965e..0000000000 --- a/ext/spice/src/cspice/zzeksei.c +++ /dev/null @@ -1,274 +0,0 @@ -/* zzeksei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__5 = 5; - -/* $Procedure ZZEKSEI ( Private: EK, set encoded integer ) */ -/* Subroutine */ int zzeksei_(integer *handle, integer *addrss, integer *ival) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - char cval[5]; - extern /* Subroutine */ int dasudc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen), prtenc_(integer *, char *, - ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Set an encoded integer at a specifed address from a character */ -/* data page. */ - - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I EK file handle. */ -/* ADDRSS I DAS character address. */ -/* IVAL I Integer value to write. */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of an EK file open for write access. */ - -/* ADDRSS is the DAS character start address at which an */ -/* integer, encoded as a string, is to be written. */ -/* An encoded integer occupies ENCSIZ characters, */ -/* where the parameter ENCSIZ is defined in the */ -/* include file ekdatpag.inc. */ - -/* IVAL is an integer value to be written in encoded form. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If the DAS character address range */ - -/* ADDRSS .. ADDRSS+ENCSIZ-1 */ - -/* is not a range of DAS character addresses that have been */ -/* initialized, the error wll be diagnosed by routines */ -/* called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine should be used for all EK applications requiring */ -/* storage of encoded integer values as characters. Use of this */ -/* routine should ensure consistent encoding across the library. */ - -/* Encoded integers written by this routine should be read using */ -/* ZZEKGEI. */ - -/* $ Examples */ - -/* See ZZEKAD03. */ - -/* $ Restrictions */ - -/* 1) Portability dictates that the base used for encoding be */ -/* no greater than 128. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Discovery error handling should be used in this utility. */ - - -/* Encode the number. */ - - prtenc_(ival, cval, (ftnlen)5); - -/* Write the encoded value. */ - - i__1 = *addrss + 4; - dasudc_(handle, addrss, &i__1, &c__1, &c__5, cval, (ftnlen)5); - return 0; -} /* zzeksei_ */ - diff --git a/ext/spice/src/cspice/zzeksemc.c b/ext/spice/src/cspice/zzeksemc.c deleted file mode 100644 index 14b1117b8b..0000000000 --- a/ext/spice/src/cspice/zzeksemc.c +++ /dev/null @@ -1,1163 +0,0 @@ -/* zzeksemc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKSEMC ( Private: EK, semantically check encoded query ) */ -/* Subroutine */ int zzeksemc_(char *query, integer *eqryi, char *eqryc, - logical *error, char *errmsg, integer *errptr, ftnlen query_len, - ftnlen eqryc_len, ftnlen errmsg_len) -{ - /* Initialized data */ - - static char typstr[32*4] = "CHARACTER " "DOUBLE PR" - "ECISION " "INTEGER " "TIM" - "E "; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base, ntab, ncnj, ncns, nord; - extern /* Subroutine */ int zzekqtab_(integer *, char *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen), zzekreqi_(integer *, char *, - integer *, ftnlen), zzekweqi_(char *, integer *, integer *, - ftnlen); - integer i__; - extern /* Subroutine */ int ekcii_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - char alias[64]; - extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *, - char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), repmi_(char *, - char *, integer *, char *, ftnlen, ftnlen, ftnlen); - extern logical failed_(void); - char colnam[32], lhstab[64], ordtab[64], rhstab[64]; - integer attdsc[6], cnstyp, colidx, irsolv, lhssiz, lhstyp, opcode, rhssiz, - rhstyp, tabidx, trsolv; - logical likeop, nulval; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - integer lxb[2], lxe[2]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Semantically check an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Attribute Descriptor Parameters */ - -/* ekattdsc.inc Version 1 23-AUG-1995 (NJB) */ - - -/* This include file declares parameters used in EK column */ -/* attribute descriptors. Column attribute descriptors are */ -/* a simplified version of column descriptors: attribute */ -/* descriptors describe attributes of a column but do not contain */ -/* addresses or pointers. */ - - -/* Size of column attribute descriptor */ - - -/* Indices of various pieces of attribute descriptors: */ - - -/* ATTSIZ is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* ATTTYP is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* ATTLEN is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* ATTSIZ is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* ATTIDX is the location of a flag that indicates whether the column */ -/* is indexed. The flag takes the value ITRUE if the column is */ -/* indexed and otherwise takes the value IFALSE. */ - - -/* ATTNFL is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* End Include Section: EK Column Attribute Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* QUERY I Original query. */ -/* EQRYI I-O Integer component of query. */ -/* EQRYC I-O Character component of query. */ -/* ERROR O Error flag. */ -/* ERRMSG O Semantic error message. */ -/* ERRPTR O Position in query where error was detected. */ - -/* $ Detailed_Input */ - -/* QUERY is the original query from which EQRYI and EQRYC */ -/* were obtained. QUERY is used only for */ -/* construction of error messages. */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed and must have */ -/* its table and column names resolved. Time values */ -/* must also have been resolved. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* On output, semantic checking will have been */ -/* performed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* ERROR is a logical flag indicating whether a semantic */ -/* error was detected. */ - -/* ERRMSG is an error message describing a semantic error, */ -/* if such an error was detected. If ERROR is */ -/* returned .FALSE., then ERRPTR is undefined. */ - -/* ERRPTR is the character position in the original query */ -/* at which a semantic error was detected, if the */ -/* input query contains a semantic error. This */ -/* index refers to the offending lexeme's position in */ -/* the original query represented by the input encoded */ -/* query. If ERROR is returned .FALSE., ERRPTR is */ -/* undefined. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If no EK files are loaded at the time this routine is called, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 2) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 3) If the input query has not had its names resolved, the error */ -/* SPICE(UNRESOLVEDNAMES) will be signalled. The outputs */ -/* will not be modified. */ - -/* 4) If the input query contains time values that have not been */ -/* resolved, the error SPICE(UNRESOLVEDTIMES) will be signalled. */ -/* The outputs will not be modified. */ - -/* 5) If any sort of semantic error is detected in the input query, */ -/* the output flag ERROR is set, an error message is returned, */ -/* and LXBEG and LXEND are set to indicate the location of the */ -/* first lexeme at which an error was detected. */ - -/* The checks performed by this routine are listed below: */ - -/* - Constraints comparing values from two columns must */ -/* refer to columns having identical data types, or else */ -/* both types must be numeric. */ - -/* - Constraints comparing values from a column with literal */ -/* values must refer to columns having the data type of the */ -/* literal value. */ - -/* - The LIKE and NOT LIKE operators may be used only with */ -/* string values. */ - -/* - Columns named in constraints must be scalar-valued. */ - -/* - Columns named as order-by columns must be scalar-valued. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The semantic checking performed by this routine is dependent on */ -/* the kernels loaded at the time this routine is called. */ - -/* This routine assumes that encoded EK query architecture version */ -/* 1 is to be used with the query to be initialized; this routine */ -/* will not work with any other architecture version. */ - -/* $ Examples */ - -/* See EKFIND. */ - -/* $ Restrictions */ - -/* 1) Loading or unloading EK files between name resolution of the */ -/* the input query and passing the query to this routine will */ -/* invalidate the checking done by this routine, and may cause */ -/* the routine to fail. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *errptr = 0; - zzekreqi_(eqryi, "NAMES_RESOLVED", &irsolv, (ftnlen)14); - if (failed_()) { - return 0; - } - if (irsolv == -1) { - chkin_("ZZEKSEMC", (ftnlen)8); - setmsg_("Encoded query has not had names resolved.", (ftnlen)41); - sigerr_("SPICE(UNRESOLVEDNAMES)", (ftnlen)22); - chkout_("ZZEKSEMC", (ftnlen)8); - return 0; - } - zzekreqi_(eqryi, "TIMES_RESOLVED", &trsolv, (ftnlen)14); - if (failed_()) { - return 0; - } - if (trsolv == -1) { - chkin_("ZZEKSEMC", (ftnlen)8); - setmsg_("Encoded query has not had time values resolved.", (ftnlen)47) - ; - sigerr_("SPICE(UNRESOLVEDTIMES)", (ftnlen)22); - chkout_("ZZEKSEMC", (ftnlen)8); - return 0; - } - -/* Get the important counts from the query. */ - - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &ncnj, (ftnlen)16); - zzekreqi_(eqryi, "NUM_ORDERBY_COLS", &nord, (ftnlen)16); - -/* Perform semantic checks applicable to constraints. */ - - i__1 = ncns; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the base address of the constraint. */ - - base = ntab * 12 + 19 + (i__ - 1) * 26; - -/* Obtain the constraint type. */ - - cnstyp = eqryi[base + 6]; - -/* Get the index of the table containing the LHS column, and get */ -/* the index of this column within that table. Look up the */ -/* table name. */ - - tabidx = eqryi[base + 12]; - colidx = eqryi[base + 18]; - lxb[0] = eqryi[base + 14]; - lxe[0] = eqryi[base + 15]; - zzekqtab_(eqryi, eqryc, &tabidx, lhstab, alias, eqryc_len, (ftnlen)64, - (ftnlen)64); - -/* Look up the name and attributes of the column on the LHS of the */ -/* constraint. */ - - ekcii_(lhstab, &colidx, colnam, attdsc, (ftnlen)64, (ftnlen)32); - lhstyp = attdsc[1]; - lhssiz = attdsc[3]; - if (lhssiz != 1) { - *error = TRUE_; - s_copy(errmsg, "Non-scalar column <#> having size # found in que" - "ry constraint.", errmsg_len, (ftnlen)62); - i__2 = lxb[0] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, (ftnlen)1, - lxe[1] - i__2, errmsg_len); - repmi_(errmsg, "#", &lhssiz, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *errptr = lxb[0]; - return 0; - } - -/* Get the operator for the current constraint. */ - - opcode = eqryi[base + 19]; - -/* Decide whether the constraint is an `IS NULL' or `IS NOT NULL' */ -/* test. */ - - nulval = opcode == 9 || opcode == 10; - -/* Check for use of the LIKE or NOT LIKE operators. These */ -/* operators may be used only if the LHS column has character */ -/* type. */ - - likeop = opcode == 7 || opcode == 8; - if (likeop && lhstyp != 1) { - *error = TRUE_; - s_copy(errmsg, "LIKE and NOT LIKE operators may be used only wit" - "h character columns. Column <#> has type #.", errmsg_len, - (ftnlen)92); - i__2 = lxb[0] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, (ftnlen)1, - lxe[0] - i__2, errmsg_len); - repmc_(errmsg, "#", typstr + (((i__2 = lhstyp - 1) < 4 && 0 <= - i__2 ? i__2 : s_rnge("typstr", i__2, "zzeksemc_", (ftnlen) - 379)) << 5), errmsg, errmsg_len, (ftnlen)1, (ftnlen)32, - errmsg_len); - *errptr = lxb[0]; - return 0; - } - -/* If the constraint compares two columns, get the same */ -/* information for the RHS column. */ - - if (cnstyp == 1) { - tabidx = eqryi[base + 25]; - colidx = eqryi[base + 31]; - lxb[1] = eqryi[base + 27]; - lxe[1] = eqryi[base + 28]; - zzekqtab_(eqryi, eqryc, &tabidx, rhstab, alias, eqryc_len, ( - ftnlen)64, (ftnlen)64); - -/* Look up the name and attributes of the column on the RHS of */ -/* the constraint. */ - - ekcii_(rhstab, &colidx, colnam, attdsc, (ftnlen)64, (ftnlen)32); - rhstyp = attdsc[1]; - rhssiz = attdsc[3]; - if (rhssiz != 1) { - *error = TRUE_; - s_copy(errmsg, "Non-scalar column <#> having size # found in" - " query constraint.", errmsg_len, (ftnlen)62); - i__2 = lxb[0] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, (ftnlen) - 1, lxe[1] - i__2, errmsg_len); - repmi_(errmsg, "#", &rhssiz, errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *errptr = lxb[1]; - return 0; - } - -/* Check for data type mismatch. */ - - if (rhstyp != lhstyp) { - -/* The only allowed mismatch is between integers and */ -/* d.p. numbers. */ - - if (lhstyp == 4 || lhstyp == 1 || rhstyp == 4 || rhstyp == 1) - { - *error = TRUE_; - s_copy(errmsg, "Data type mismatch: column <#> has data " - "type #; column <#> has data type #.", errmsg_len, - (ftnlen)75); - i__2 = lxb[0] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, ( - ftnlen)1, lxe[0] - i__2, errmsg_len); - repmc_(errmsg, "#", typstr + (((i__2 = lhstyp - 1) < 4 && - 0 <= i__2 ? i__2 : s_rnge("typstr", i__2, "zzeks" - "emc_", (ftnlen)440)) << 5), errmsg, errmsg_len, ( - ftnlen)1, (ftnlen)32, errmsg_len); - i__2 = lxb[1] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, ( - ftnlen)1, lxe[1] - i__2, errmsg_len); - repmc_(errmsg, "#", typstr + (((i__2 = rhstyp - 1) < 4 && - 0 <= i__2 ? i__2 : s_rnge("typstr", i__2, "zzeks" - "emc_", (ftnlen)442)) << 5), errmsg, errmsg_len, ( - ftnlen)1, (ftnlen)32, errmsg_len); - *errptr = lxb[1]; - return 0; - } - } - } else { - -/* The constraint compares a column against a value. If the */ -/* operator is `IS NULL' or `IS NOT NULL', there are no */ -/* further semantic checks to be made. */ - - if (nulval) { - return 0; - } - -/* Get the data type of the value on the RHS. */ - - rhstyp = eqryi[base + 20]; - lxb[1] = eqryi[base + 21]; - lxe[1] = eqryi[base + 22]; - if (rhstyp != lhstyp) { - -/* The only allowed mismatch is between integers and */ -/* d.p. numbers. */ - - if (lhstyp == 4 || lhstyp == 1 || rhstyp == 4 || rhstyp == 1) - { - *error = TRUE_; - s_copy(errmsg, "Data type mismatch: column <#> has data " - "type #; value <#> has data type #.", errmsg_len, ( - ftnlen)74); - i__2 = lxb[0] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, ( - ftnlen)1, lxe[0] - i__2, errmsg_len); - repmc_(errmsg, "#", typstr + (((i__2 = lhstyp - 1) < 4 && - 0 <= i__2 ? i__2 : s_rnge("typstr", i__2, "zzeks" - "emc_", (ftnlen)484)) << 5), errmsg, errmsg_len, ( - ftnlen)1, (ftnlen)32, errmsg_len); - i__2 = lxb[1] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, ( - ftnlen)1, lxe[1] - i__2, errmsg_len); - repmc_(errmsg, "#", typstr + (((i__2 = rhstyp - 1) < 4 && - 0 <= i__2 ? i__2 : s_rnge("typstr", i__2, "zzeks" - "emc_", (ftnlen)486)) << 5), errmsg, errmsg_len, ( - ftnlen)1, (ftnlen)32, errmsg_len); - *errptr = lxb[1]; - return 0; - } - } - } - -/* We've finished the checks on the current constraint. */ - - } - -/* Now check the order-by columns, if any are present. These */ -/* columns must have scalar type. */ - - i__1 = nord; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the query column descriptor for the Ith order-by column. */ - - base = ntab * 12 + 19 + ncnj + ncns * 26 + (i__ - 1) * 13; - -/* Look up the attributes of the column. It's the size we're */ -/* after. */ - - tabidx = eqryi[base + 11]; - colidx = eqryi[base + 17]; - lxb[0] = eqryi[base + 13]; - lxe[0] = eqryi[base + 14]; - zzekqtab_(eqryi, eqryc, &tabidx, ordtab, alias, eqryc_len, (ftnlen)64, - (ftnlen)64); - ekcii_(ordtab, &colidx, colnam, attdsc, (ftnlen)64, (ftnlen)32); - if (attdsc[3] != 1) { - *error = TRUE_; - s_copy(errmsg, "Non-scalar column <#> having size # found in ord" - "er-by column.", errmsg_len, (ftnlen)61); - i__2 = lxb[0] - 1; - repmc_(errmsg, "#", query + i__2, errmsg, errmsg_len, (ftnlen)1, - lxe[1] - i__2, errmsg_len); - repmi_(errmsg, "#", &attdsc[3], errmsg, errmsg_len, (ftnlen)1, - errmsg_len); - *errptr = lxb[0]; - return 0; - } - } - -/* Indicate completion of semantic checking. */ - - zzekweqi_("SEM_CHECKED", &c__1, eqryi, (ftnlen)11); - return 0; -} /* zzeksemc_ */ - diff --git a/ext/spice/src/cspice/zzeksfwd.c b/ext/spice/src/cspice/zzeksfwd.c deleted file mode 100644 index 25b1c7cb19..0000000000 --- a/ext/spice/src/cspice/zzeksfwd.c +++ /dev/null @@ -1,457 +0,0 @@ -/* zzeksfwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSFWD ( EK, set forward pointer for data page ) */ -/* Subroutine */ int zzeksfwd_(integer *handle, integer *type__, integer *p, - integer *fward) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *); - doublereal dpptr; - extern logical failed_(void); - extern /* Subroutine */ int dasudd_(integer *, integer *, integer *, - doublereal *), dasudi_(integer *, integer *, integer *, integer *) - , zzeksei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Set the forward data pointer for a specified EK data page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TYPE I Data type of page. */ -/* P I Page number. */ -/* FWARD I Forward data pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TYPE is the data type of the desired page. */ - -/* P is the page number of the allocated page. This */ -/* number is recognized by the EK paged access */ -/* routines. */ - -/* FWARD is a forward data pointer. This is the number */ -/* of a data page on which the last column entry */ -/* on page P is continued. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TYPE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine sets the forward data pointer of the specified EK */ -/* data page. The value of the pointer is a page number. */ - -/* $ Examples */ - -/* See ZZEKAPS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Look up the base address of the page. */ - - zzekpgbs_(type__, p, &base); - if (failed_()) { - return 0; - } - if (*type__ == 1) { - -/* Set the encoded count. */ - - i__1 = base + 1015; - zzeksei_(handle, &i__1, fward); - } else if (*type__ == 2) { - -/* Convert the input count to d.p. type. */ - - dpptr = (doublereal) (*fward); - i__1 = base + 127; - i__2 = base + 127; - dasudd_(handle, &i__1, &i__2, &dpptr); - } else { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, ZZEKPGBS would have complained. */ - - i__1 = base + 255; - i__2 = base + 255; - dasudi_(handle, &i__1, &i__2, fward); - } - return 0; -} /* zzeksfwd_ */ - diff --git a/ext/spice/src/cspice/zzeksinf.c b/ext/spice/src/cspice/zzeksinf.c deleted file mode 100644 index e0651a7d20..0000000000 --- a/ext/spice/src/cspice/zzeksinf.c +++ /dev/null @@ -1,653 +0,0 @@ -/* zzeksinf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__64 = 64; -static integer c__32 = 32; - -/* $Procedure ZZEKSINF ( EK, return segment information ) */ -/* Subroutine */ int zzeksinf_(integer *handle, integer *segno, char *tabnam, - integer *segdsc, char *cnames, integer *cdscrs, ftnlen tabnam_len, - ftnlen cnames_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer base, nseg; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekmloc_(integer *, integer *, integer *, integer *); - integer i__, p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, - integer *, integer *, char *, ftnlen), dasrdi_(integer *, integer - *, integer *, integer *); - extern integer eknseg_(integer *); - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen); - -/* $ Abstract */ - -/* Return general segment information for a specified segment in a */ -/* specified EK. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of EK. */ -/* SEGNO I Number of segment to be summarized. */ -/* TABNAM O Name of table containing segment. */ -/* SEGDSC O Segment descriptor. */ -/* CNAMES O Names of columns in segment. */ -/* CDSCRS O Descriptors of columns in segment. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGNO is the number of the segment whose summary is */ -/* desired. Segments are numbered from 1 to NSEG, */ -/* where NSEG is the count of segments in the file. */ - -/* $ Detailed_Output */ - -/* TABNAM is the name of the table to which the segment */ -/* belongs. */ - -/* SEGDSC is an EK segment descriptor. The contents of this */ -/* integer array are described in the include file */ - -/* eksegdsc.inc. */ - -/* Two commonly used elements of the */ -/* descriptor are the number of rows in the table */ -/* and the number of columns in the table. The */ -/* indices of these items are given by the parameters */ -/* NRIDX and NCIDX, respectively. */ - - -/* CNAMES is a list of names of data columns in the segment. */ - -/* CDSCRS is a list of descriptors of columns in the segment. */ -/* Elements (1:CDSCSZ,I) of this integer array */ -/* comprise the descriptor of the Ith column in the */ -/* segment. The contents of a column descriptor are */ -/* listed below. The parameters shown in the first */ -/* subscript of CDSCRS are declared in the include */ -/* file */ - -/* ekcoldsc.inc. */ - -/* We recommend using these parameters in any calling */ -/* routine. */ - -/* CDSCRS(CLSIDX,I): Column class */ -/* CDSCRS(TYPIDX,I): Data type */ -/* CDSCRS(LENIDX,I): String length */ -/* CDSCRS(SIZIDX,I): Element size */ -/* CDSCRS(NAMIDX,I): Column name base address */ -/* CDSCRS(IXTIDX,I): Column index's type code */ -/* CDSCRS(IXPIDX,I): Column index's pointer */ -/* CDSCRS(NULIDX,I): Null flag */ -/* CDSCRS(ORDIDX,I): Column's ordinal position */ -/* in parent table */ -/* CDSCRS(METIDX,I): Column's integer metadata */ -/* pointer */ -/* CDSCRS(11,I): Reserved. */ - -/* Notes: */ - -/* 1) Element 3 applies only to character columns. */ - -/* Element 3 takes the boolean value IFALSE */ -/* if the column contains variable-length */ -/* strings. */ - -/* The boolean parameter IFALSE is represented */ -/* by the integer -1. */ - -/* 2) Element 4 takes the boolean value IFALSE */ -/* if the column contains variable-size */ -/* arrays. */ - -/* 3) Element 6 takes the value IFALSE if the */ -/* column is not indexed. */ - -/* 4) Element 8 takes the value IFALSE if null */ -/* values are not allowed in the column. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The output arguments will not be */ -/* modified. */ - -/* 2) If SEGNO is not the index of an existing segment in the */ -/* specified file, the error SPICE(INDEXOUTOFRANGE) will be */ -/* signalled. The output arguments will not be modified. */ - -/* 3) If an I/O error occurs while attempting to obtain summary */ -/* information for the specified segment, the error will be */ -/* diagnosed by routines called by this routine. The output */ -/* arguments may be modified in this case. */ - -/* $ Files */ - -/* See the description of HANDLE in $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine supports the function of summarizing a binary */ -/* EK file, allowing NAIF Toolkit users to determine whether it */ -/* contains data of interest. The routine also also provides */ -/* address information necessary to retrieve information from the */ -/* segment. */ - -/* $ Examples */ - -/* 1) Dump the table and column names of the segments in an EK. */ - -/* C */ -/* C Open the EK for read access and get the number of */ -/* C segments it */ -/* C contains. */ -/* C */ -/* CALL EKOPR ( EKNAME, HANDLE ) */ - -/* NSEG = EKNSEG ( HANDLE ) */ - -/* C */ -/* C Loop through the segments, dumping the desired */ -/* C summary information for each one. */ -/* C */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Segment summary for file ', EKNAME */ -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) ' ' */ - -/* DO I = 1, NSEG */ - -/* CALL ZZEKSINF ( HANDLE, I, TABNAM, */ -/* . SEGDSC, CNAMES, CDSCRS ) */ - -/* WRITE (*,*) */ -/* . '========================================' // */ -/* . '========================================' */ - - -/* WRITE (*,*) 'Table containing segment: ', TABNAM */ - -/* WRITE (*,*) ' ' */ -/* WRITE (*,*) 'Column names: ' */ -/* WRITE (*,*) ' ' */ - -/* DO J = 1, SEGDSC(NCIDX) */ - -/* WRITE (*,*) ' '//CNAMES(J) */ - -/* END DO */ - -/* WRITE (*,*) */ -/* . '========================================' // */ -/* . '========================================' */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 03-JUL-1996 (NJB) */ - -/* Bug fix: table and column names are now padded with trailing */ -/* blanks on output if necessary. */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 1.1.0, 03-JUL-1996 (NJB) */ - -/* Bug fix: table and column names are now padded with trailing */ -/* blanks on output if necessary. Previously, if the caller */ -/* declared these variables with string lengths longer than */ -/* TNAMSZ and CNAMSZ respectively, the trailing characters */ -/* at positions past those designated by these parameters were */ -/* left unassigned on output. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKSINF", (ftnlen)8); - } - -/* Verify that the target file is a paged DAS EK open for read */ -/* access, or we can't summarize the file. */ - - zzekpgch_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("ZZEKSINF", (ftnlen)8); - return 0; - } - -/* Find out how many segments are in the file, so we can check */ -/* the index for validity. */ - - nseg = eknseg_(handle); - if (*segno < 1 || *segno > nseg) { - setmsg_("Segment index was #; valid range is 1:#", (ftnlen)39); - errint_("#", segno, (ftnlen)1); - errint_("#", &nseg, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("ZZEKSINF", (ftnlen)8); - return 0; - } - -/* We're ready to proceed. The first step is to find the */ -/* segment's metadata location and look up the segment descriptor. */ - - zzekmloc_(handle, segno, &p, &base); - i__1 = base + 1; - i__2 = base + 24; - dasrdi_(handle, &i__1, &i__2, segdsc); - -/* Get the table name. The table's base address is in the segment */ -/* descriptor. */ - - i__1 = segdsc[3] + 1; - i__2 = segdsc[3] + 64; - dasrdc_(handle, &i__1, &i__2, &c__1, &c__64, tabnam, tabnam_len); - if (i_len(tabnam, tabnam_len) > 64) { - s_copy(tabnam + 64, " ", tabnam_len - 64, (ftnlen)1); - } - -/* Read the column descriptors. The first one starts at DAS */ -/* integer address */ - -/* BASE + CDOFF + 1. */ - - - ncols = segdsc[4]; - i__1 = base + 25; - i__2 = base + 24 + ncols * 11; - dasrdi_(handle, &i__1, &i__2, cdscrs); - -/* Now read the column names into the names array. */ - - i__1 = segdsc[21] + 1; - i__2 = segdsc[21] + (ncols << 5); - dasrdc_(handle, &i__1, &i__2, &c__1, &c__32, cnames, cnames_len); - if (i_len(cnames, cnames_len) > 32) { - i__1 = ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(cnames + ((i__ - 1) * cnames_len + 32), " ", cnames_len - - 32, (ftnlen)1); - } - } - -/* All output arguments are set, or else FAILED() is .TRUE. */ - - chkout_("ZZEKSINF", (ftnlen)8); - return 0; -} /* zzeksinf_ */ - diff --git a/ext/spice/src/cspice/zzekslnk.c b/ext/spice/src/cspice/zzekslnk.c deleted file mode 100644 index dfc228a21b..0000000000 --- a/ext/spice/src/cspice/zzekslnk.c +++ /dev/null @@ -1,459 +0,0 @@ -/* zzekslnk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSLNK ( EK, set link count for data page ) */ -/* Subroutine */ int zzekslnk_(integer *handle, integer *type__, integer *p, - integer *nlinks) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer base; - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *); - doublereal dplnk; - extern logical failed_(void); - extern /* Subroutine */ int dasudd_(integer *, integer *, integer *, - doublereal *), dasudi_(integer *, integer *, integer *, integer *) - , zzeksei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Set the link count for a specified EK data page. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TYPE I Data type of page. */ -/* P I Page number. */ -/* NLINKS I Number of links to page. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TYPE is the data type of the desired page. */ - -/* P is the page number of the allocated page. This */ -/* number is recognized by the EK paged access */ -/* routines. */ - -/* NLINKS is the new number of links to the specified data */ -/* page. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TYPE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine updates the link count of the specified EK data page. */ - -/* Link counts are used to indicate how many `users' of a page */ -/* there are. When the link count of a page drops to zero, that */ -/* page is eligible to be freed. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Look up the base address of the page. */ - - zzekpgbs_(type__, p, &base); - if (failed_()) { - return 0; - } - if (*type__ == 1) { - -/* Set the encoded count. */ - - i__1 = base + 1020; - zzeksei_(handle, &i__1, nlinks); - } else if (*type__ == 2) { - -/* Convert the input count to d.p. type. */ - - dplnk = (doublereal) (*nlinks); - i__1 = base + 128; - i__2 = base + 128; - dasudd_(handle, &i__1, &i__2, &dplnk); - } else { - -/* The remaining possibility is that TYPE is INT. If we had had */ -/* an unrecognized type, ZZEKPGBS would have complained. */ - - i__1 = base + 256; - i__2 = base + 256; - dasudi_(handle, &i__1, &i__2, nlinks); - } - return 0; -} /* zzekslnk_ */ - diff --git a/ext/spice/src/cspice/zzeksrcp.c b/ext/spice/src/cspice/zzeksrcp.c deleted file mode 100644 index 08a36f0029..0000000000 --- a/ext/spice/src/cspice/zzeksrcp.c +++ /dev/null @@ -1,277 +0,0 @@ -/* zzeksrcp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSRCP ( EK, set record companion pointer ) */ -/* Subroutine */ int zzeksrcp_(integer *handle, integer *recptr, integer * - recno) -{ - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - integer loc; - -/* $ Abstract */ - -/* Set the companion pointer of a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* RECPTR I Record pointer. */ -/* RECNO I Record number of companion of specified EK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* RECPTR is a pointer to the record whose companion pointer */ -/* is to be set. */ - -/* RECNO is the `companion record pointer' of the record */ -/* designated by RECPTR. This name is a little */ -/* misleading: we identify the companion record */ -/* by its record number, not by an address. So RECNO */ -/* is a pointer only in an abstract sense. */ - -/* If the input record belongs to a shadowed EK, the */ -/* companion record is the corresponding backup */ -/* record. If the input record is a backup record, */ -/* the companion record is the corresponding source */ -/* record. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine sets the companion record pointer of a specified EK */ -/* record. As noted in $Detailed_Input, the `pointer' is simply */ -/* the number of the companion record. */ - -/* $ Examples */ - -/* See ZZEKRBCK. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Compute the companion pointer and set the pointer. */ - - loc = *recptr + 2; - dasudi_(handle, &loc, &loc, recno); - return 0; -} /* zzeksrcp_ */ - diff --git a/ext/spice/src/cspice/zzeksrs.c b/ext/spice/src/cspice/zzeksrs.c deleted file mode 100644 index 7efe09262e..0000000000 --- a/ext/spice/src/cspice/zzeksrs.c +++ /dev/null @@ -1,267 +0,0 @@ -/* zzeksrs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSRS ( EK, set record status ) */ -/* Subroutine */ int zzeksrs_(integer *handle, integer *recptr, integer * - status) -{ - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dasudi_(integer *, integer *, integer *, - integer *); - integer loc; - -/* $ Abstract */ - -/* Set the status of a specified EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* RECPTR I Record pointer. */ -/* STATUS I Status of specified EK record. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* RECPTR is a pointer to the record whose status is to be */ -/* set. */ - -/* STATUS is the status word of the specified record. See */ -/* the include file ekrecptr.inc for values and */ -/* meanings. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine sets the status word of a specified EK record. */ - -/* $ Examples */ - -/* See EKCOMM. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - return 0; - } - -/* Compute the status word location and set the status. */ - - loc = *recptr + 1; - dasudi_(handle, &loc, &loc, status); - return 0; -} /* zzeksrs_ */ - diff --git a/ext/spice/src/cspice/zzekstyp.c b/ext/spice/src/cspice/zzekstyp.c deleted file mode 100644 index f81b8a3dc1..0000000000 --- a/ext/spice/src/cspice/zzekstyp.c +++ /dev/null @@ -1,324 +0,0 @@ -/* zzekstyp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSTYP ( EK, determine segment type ) */ -integer zzekstyp_(integer *ncols, integer *cdscrs) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical fixed; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - logical var; - -/* $ Abstract */ - -/* Determine the type of segment required to support a specified */ -/* set of columns. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK General Limit Parameters */ - -/* ekglimit.inc Version 1 21-MAY-1995 (NJB) */ - - -/* This file contains general limits for the EK system. */ - -/* MXCLSG is the maximum number of columns allowed in a segment. */ -/* This limit applies to logical tables as well, since all segments */ -/* in a logical table must have the same column definitions. */ - - -/* End Include Section: EK General Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NCOLS I Number of columns in the segment. */ -/* CDSCRS I Descriptors of columns. */ - -/* The function returns the type of segment that is compatible with */ -/* the input column descriptors. */ - -/* $ Detailed_Input */ - - -/* NCOLS is the number of columns in a new segment. */ - -/* CDSCRS is an array of column descriptors: the Ith */ -/* descriptor applies to the Ith column in the */ -/* segment. */ - -/* $ Detailed_Output */ - -/* The function returns the type of segment that is compatible with */ -/* the input column descriptors. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NCOLS is non-positive or greater than the maximum allowed */ -/* number MXCLSG, the error SPICE(INVALIDCOUNT) is signalled. */ - -/* 2) If the input column descriptors do not contain compatible */ -/* attributes, the error SPICE(BADATTRIBUTES) will be signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine determines the appropriate segment type to contain */ -/* a specified set of columns. Currently, there are two segment */ -/* types. The first type accommodates column classes 1 through 6; */ -/* the second type accommodates column classes 7 through 9. The */ -/* latter set of column classes are `fixed_count' classes: a column */ -/* in one of these classes may not have entries added or deleted */ -/* after the column is created. Fixed and variable count columns */ -/* may not coexist in the same segment. */ - -/* $ Examples */ - -/* See EKBSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - ret_val = 0; - return ret_val; - } else { - chkin_("ZZEKSTYP", (ftnlen)8); - } - -/* FIXED and VAR indicate whether we've seen any fixed or variable */ -/* column classes so far. */ - - fixed = FALSE_; - var = FALSE_; - i__1 = *ncols; - for (i__ = 1; i__ <= i__1; ++i__) { - if (cdscrs[i__ * 11 - 11] >= 1 && cdscrs[i__ * 11 - 11] <= 6) { - var = TRUE_; - } else if (cdscrs[i__ * 11 - 11] >= 7 && cdscrs[i__ * 11 - 11] <= 9) { - fixed = TRUE_; - } - } - if (var && ! fixed) { - ret_val = 1; - } else if (fixed && ! var) { - ret_val = 2; - } else { - ret_val = 0; - setmsg_("Column set contains a mixture of variable and fixed-count c" - "olumns. Segments must contain all variable or all fixed cou" - "nt columns.", (ftnlen)130); - sigerr_("SPICE(BADATTRIBUTES)", (ftnlen)20); - chkout_("ZZEKSTYP", (ftnlen)8); - return ret_val; - } - chkout_("ZZEKSTYP", (ftnlen)8); - return ret_val; -} /* zzekstyp_ */ - diff --git a/ext/spice/src/cspice/zzeksz04.c b/ext/spice/src/cspice/zzeksz04.c deleted file mode 100644 index b6f860ccbd..0000000000 --- a/ext/spice/src/cspice/zzeksz04.c +++ /dev/null @@ -1,747 +0,0 @@ -/* zzeksz04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSZ04 ( EK, element entry size, class 4 ) */ -integer zzeksz04_(integer *handle, integer *segdsc, integer *coldsc, integer * - recptr) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer nrec; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncols; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer colidx, datptr, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Return the size of a specified entry in a class 4 column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column containing */ -/* the entry whose size is requested. The column */ -/* must be class 4. */ - -/* RECPTR is a pointer to the EK record containing the */ -/* column entry of interest. */ - -/* $ Detailed_Output */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the column index contained in the input column descriptor */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This utility supports the commonly performed function of */ -/* determining the element count of a column entry. */ - -/* $ Examples */ - -/* See ZZEKESIZ. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Initialize the function's return value. */ - - ret_val = 0; - nrec = segdsc[5]; - colidx = coldsc[8]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKSZ04", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKSZ04", (ftnlen)8); - return ret_val; - } - -/* If the column has fixed-size entries, just return the declared */ -/* size. */ - - if (coldsc[3] != -1) { - ret_val = coldsc[3]; - return ret_val; - } - -/* Compute the data pointer location. Read the data pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr < 1) { - -/* The value is null. Null entries are always considered to have */ -/* size 1. */ - - ret_val = 1; - } else { - -/* DATPTR points to the element count. */ - - dasrdi_(handle, &datptr, &datptr, &ret_val); - } - return ret_val; -} /* zzeksz04_ */ - diff --git a/ext/spice/src/cspice/zzeksz05.c b/ext/spice/src/cspice/zzeksz05.c deleted file mode 100644 index fc48667b45..0000000000 --- a/ext/spice/src/cspice/zzeksz05.c +++ /dev/null @@ -1,753 +0,0 @@ -/* zzeksz05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSZ05 ( EK, element entry size, class 5 ) */ -integer zzeksz05_(integer *handle, integer *segdsc, integer *coldsc, integer * - recptr) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer nrec; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal dpcnt; - integer ncols; - extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, - doublereal *), dasrdi_(integer *, integer *, integer *, integer *) - ; - integer colidx, datptr, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Return the size of a specified entry in a class 5 column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column containing */ -/* the entry whose size is requested. The column */ -/* must be class 5. */ - -/* RECPTR is a pointer to the EK record containing the */ -/* column entry of interest. */ - -/* $ Detailed_Output */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the column index contained in the input column descriptor */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This utility supports the commonly performed function of */ -/* determining the element count of a column entry. */ - -/* $ Examples */ - -/* See ZZEKESIZ. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Initialize the function's return value. */ - - ret_val = 0; - nrec = segdsc[5]; - colidx = coldsc[8]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKSZ05", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKSZ05", (ftnlen)8); - return ret_val; - } - -/* If the column has fixed-size entries, just return the declared */ -/* size. */ - - if (coldsc[3] != -1) { - ret_val = coldsc[3]; - return ret_val; - } - -/* Compute the data pointer location. Read the data pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr < 1) { - -/* The value is null. Null entries are always considered to have */ -/* size 1. */ - - ret_val = 1; - } else { - -/* DATPTR points to the element count. */ - - dasrdd_(handle, &datptr, &datptr, &dpcnt); - ret_val = i_dnnt(&dpcnt); - } - return ret_val; -} /* zzeksz05_ */ - diff --git a/ext/spice/src/cspice/zzeksz06.c b/ext/spice/src/cspice/zzeksz06.c deleted file mode 100644 index 15311cf13a..0000000000 --- a/ext/spice/src/cspice/zzeksz06.c +++ /dev/null @@ -1,747 +0,0 @@ -/* zzeksz06.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKSZ06 ( EK, element entry size, class 6 ) */ -integer zzeksz06_(integer *handle, integer *segdsc, integer *coldsc, integer * - recptr) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - integer nrec; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer ncols; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer colidx, datptr, ptrloc; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), zzekgei_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Return the size of a specified entry in a class 6 column. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Detailed_Input */ - -/* HANDLE is an EK file handle. The file may be open for */ -/* reading or writing. */ - -/* SEGDSC is the segment descriptor of the segment */ -/* containing the column specified by COLDSC. */ - -/* COLDSC is the column descriptor of the column containing */ -/* the entry whose size is requested. The column */ -/* must be class 6. */ - -/* RECPTR is a pointer to the EK record containing the */ -/* column entry of interest. */ - -/* $ Detailed_Output */ - -/* The function returns the number of elements in the specified */ -/* column entry. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the column index contained in the input column descriptor */ -/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This utility supports the commonly performed function of */ -/* determining the element count of a column entry. */ - -/* $ Examples */ - -/* See ZZEKESIZ. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 18-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in. */ - -/* Initialize the function's return value. */ - - ret_val = 0; - nrec = segdsc[5]; - colidx = coldsc[8]; - -/* Make sure the column exists. */ - - ncols = segdsc[4]; - if (colidx < 1 || colidx > ncols) { - chkin_("ZZEKSZ06", (ftnlen)8); - setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); - errint_("#", &colidx, (ftnlen)1); - errint_("#", &nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKSZ06", (ftnlen)8); - return ret_val; - } - -/* If the column has fixed-size entries, just return the declared */ -/* size. */ - - if (coldsc[3] != -1) { - ret_val = coldsc[3]; - return ret_val; - } - -/* Compute the data pointer location. Read the data pointer. */ - - ptrloc = *recptr + 2 + colidx; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr < 1) { - -/* The value is null. Null entries are always considered to have */ -/* size 1. */ - - ret_val = 1; - } else { - -/* DATPTR points to the element count. */ - - zzekgei_(handle, &datptr, &ret_val); - } - return ret_val; -} /* zzeksz06_ */ - diff --git a/ext/spice/src/cspice/zzektcnv.c b/ext/spice/src/cspice/zzektcnv.c deleted file mode 100644 index 3436e9ee41..0000000000 --- a/ext/spice/src/cspice/zzektcnv.c +++ /dev/null @@ -1,412 +0,0 @@ -/* zzektcnv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__3 = 3; - -/* $Procedure ZZEKTCNV ( Private: EK, time conversion ) */ -/* Subroutine */ int zzektcnv_(char *timstr, doublereal *et, logical *error, - char *errmsg, ftnlen timstr_len, ftnlen errmsg_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal tvec[10]; - logical mods; - char type__[32]; - extern integer posr_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *); - integer clkid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer ntvec; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - scn2id_(char *, integer *, logical *, ftnlen), str2et_(char *, - doublereal *, ftnlen); - extern logical failed_(void); - doublereal sclkdp; - char modify[32*10], sclmsg[160]; - logical succes, yabbrv; - extern /* Subroutine */ int scpars_(integer *, char *, logical *, char *, - doublereal *, ftnlen, ftnlen), chkout_(char *, ftnlen), suffix_( - char *, integer *, char *, ftnlen, ftnlen); - char locstr[80], pictur[80]; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char - *, char *, logical *, logical *, logical *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - logical fnd; - integer loc; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Convert time strings from EK query to ephemeris time. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TIMSTR I Time string. */ -/* ET O Ephemeris time in seconds past J2000, TDB. */ -/* ERROR O Error flag. */ -/* ERRMSG O Error message. */ - -/* $ Detailed_Input */ - -/* TIMSTR is a string representing a time value. The value */ -/* make be an SCLK string in the form */ - -/* SCLK */ - -/* or may be any string acceptable to ST2ET. */ - -/* $ Detailed_Output */ - -/* ET is the ephemeris time equivalent to the input */ -/* time. */ - -/* ERROR is a logical flag indicating whether an error was */ -/* detected. Note that a time string might be */ -/* syntactically valid, but incapable of being */ -/* converted to ET if the appropriate time kernels */ -/* (Leapseconds or SCLK) are not loaded. */ - -/* ERRMSG is an error message describing an error in the */ -/* input query, if one was detected. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any sort of time conversion error occurs, the output flag */ -/* ERROR is set, and an error message is returned. */ - -/* The routine attempts to avoid causing errors that must */ -/* be trapped by SPICELIB error handling. Time string syntax */ -/* errors or missing kernel files, for example, should not trip */ -/* SPICELIB error handling. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Strings representing time values are interpreted as follows: */ - -/* 1) The string is first examined to see whether it's an */ -/* SCLK string for a recognized clock; if it is, the */ -/* string is converted to the equivalent ET. */ - -/* 2) If the string is not a SCLK string, it is expected */ -/* to be some sort of standard time representation. */ -/* The string is checked to see whether it's in a format */ -/* that TPARTV can handle. If TPARTV can't deal with it, */ -/* the string is considered to be invalid. */ - -/* $ Examples */ - -/* See ZZEKTRES. */ - -/* $ Restrictions */ - -/* 1) A leapseconds kernel must be loaded at the time this routine */ -/* is called. */ - -/* 2) In order to convert SCLK strings, an appropriate SCLK kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 12-AUG-2001 (NJB) */ - -/* Now converts standard time strings to ET via STR2ET instead */ -/* of the less general routines ISO2UTC and UTC2ET. */ - -/* Bug fix: modified algorithm to handle case where string */ -/* "SCLK" appears in SCLK name. */ - -/* Bug fix: construction of error messages in case where */ -/* FAILED() returns .TRUE. has been changed so that REPMC is */ -/* not called. Instead, the error-free routine SUFFIX is */ -/* used. */ - -/* - SPICELIB Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 12-AUG-2001 (NJB) */ - -/* Now converts standard time strings to ET via STR2ET instead */ -/* of the less general routines ISO2UTC and UTC2ET. */ - -/* Bug fix: modified algorithm to handle case where string */ -/* "SCLK" appears in SCLK name. */ - -/* Bug fix: construction of error messages in case where */ -/* FAILED() returns .TRUE. has been changed so that REPMC is */ -/* not called. Instead, the error-free routine SUFFIX is */ -/* used. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("ZZEKTCNV", (ftnlen)8); - -/* No error to start with. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - -/* Get a left-justified, compressed, upper-case copy of */ -/* the string, so we can easily search it for substrings */ -/* that would identify it as SCLK. If we do find a */ -/* match, remove the identifying substring (of the form */ -/* 'MO SCLK', 'VGR1 SCLK', etc.). */ - - cmprss_(" ", &c__1, timstr, locstr, (ftnlen)1, timstr_len, (ftnlen)80); - ljust_(locstr, locstr, (ftnlen)80, (ftnlen)80); - ucase_(locstr, locstr, (ftnlen)80, (ftnlen)80); - i__1 = rtrim_(locstr, (ftnlen)80); - loc = posr_(locstr, "SCLK", &i__1, (ftnlen)80, (ftnlen)4); - if (loc > 0) { - -/* It's a SCLK string. Find the ID code, if we can. */ - - scn2id_(locstr, &clkid, &fnd, loc + 3); - if (! fnd) { - -/* We don't recognize this SCLK type. */ - - *error = TRUE_; - if (loc > 1) { - s_copy(errmsg, "Time conversion failed; SCLK type <#> was no" - "t recognized.", errmsg_len, (ftnlen)57); - repmc_(errmsg, "#", timstr, errmsg, errmsg_len, (ftnlen)1, - loc - 1, errmsg_len); - } else { - s_copy(errmsg, "Time conversion failed; SCLK name was not su" - "pplied.", errmsg_len, (ftnlen)51); - } - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; - } - -/* If we got this far, we recognized the SCLK type. */ -/* Convert the time to ET. */ - - i__1 = loc + 3; - scpars_(&clkid, locstr + i__1, error, sclmsg, &sclkdp, 80 - i__1, ( - ftnlen)160); - if (failed_()) { - -/* We'll arrive here if the required SCLK kernel hasn't */ -/* been loaded. */ - - *error = TRUE_; - s_copy(errmsg, "Unexpected SPICELIB error encountered while atte" - "mpting to parse the string <", errmsg_len, (ftnlen)76); - suffix_(timstr, &c__0, errmsg, timstr_len, errmsg_len); - suffix_(">", &c__0, errmsg, (ftnlen)1, errmsg_len); - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; - } else if (*error) { - s_copy(errmsg, "The string <#> didn't parse as a spacecraft cloc" - "k string.", errmsg_len, (ftnlen)57); - repmc_(errmsg, "#", timstr, errmsg, errmsg_len, (ftnlen)1, - timstr_len, errmsg_len); - suffix_(sclmsg, &c__3, errmsg, (ftnlen)160, errmsg_len); - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; - } else { - sct2e_(&clkid, &sclkdp, et); - if (failed_()) { - *error = TRUE_; - s_copy(errmsg, "Unexpected SPICELIB error encountered while " - "attempting to parse the string <", errmsg_len, ( - ftnlen)76); - suffix_(timstr, &c__0, errmsg, timstr_len, errmsg_len); - suffix_(">", &c__0, errmsg, (ftnlen)1, errmsg_len); - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; - } - } - } else { - -/* We could have a standard time string. Make sure that the */ -/* time string is acceptable before actually calling STR2ET. */ - - tpartv_(locstr, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes, - pictur, errmsg, (ftnlen)80, (ftnlen)32, (ftnlen)32, (ftnlen) - 80, errmsg_len); - if (succes) { - -/* It's safe to pass the string to STR2ET. */ - - str2et_(locstr, et, (ftnlen)80); - if (failed_()) { - *error = TRUE_; - s_copy(errmsg, "Unexpected SPICELIB error encountered while " - "attempting to parse the string <", errmsg_len, ( - ftnlen)76); - suffix_(timstr, &c__0, errmsg, timstr_len, errmsg_len); - suffix_(">", &c__0, errmsg, (ftnlen)1, errmsg_len); - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; - } - } else { - -/* The string cannot be parsed by STR2ET. The error message */ -/* was set by TPARTV. */ - - *error = TRUE_; - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; - } - -/* We're done with the standard time string case. */ - - } - -/* We've parsed a time string, if it was an SCLK or standard string. */ - - chkout_("ZZEKTCNV", (ftnlen)8); - return 0; -} /* zzektcnv_ */ - diff --git a/ext/spice/src/cspice/zzektloc.c b/ext/spice/src/cspice/zzektloc.c deleted file mode 100644 index 19e65bc94b..0000000000 --- a/ext/spice/src/cspice/zzektloc.c +++ /dev/null @@ -1,281 +0,0 @@ -/* zzektloc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTLOC ( EK, locate token in tokenized EK query ) */ -/* Subroutine */ int zzektloc_(integer *tokid, integer *kwcode, integer * - ntoken, integer *tokens, integer *values, integer *loc, logical * - found) -{ -/* $ Abstract */ - -/* Locate the first occurrence of a specified token in a tokenized */ -/* EK query. The input may actually be any subset of token codes */ -/* and corresponding keyword codes from a tokenized query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Token Code Parameters */ - -/* ektokn.inc Version 2 25-JAN-1995 (NJB) */ - -/* Updated to distinguish between special characters. */ - - -/* ektokn.inc Version 1 05-DEC-1994 (NJB) */ - - -/* The EK query language tokens and codes are: */ - -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ -/* */ - - - -/* End Include Section: EK Token Code Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Keyword Code Parameters */ - -/* ekkeyw.inc Version 4 24-JAN-1995 (NJB) */ - - - -/* The EK query language keywords and codes are: */ - -/* ALL */ -/* AND */ -/* ASC */ -/* AVG */ -/* BETWEEN */ -/* BY */ -/* COUNT */ -/* DESC */ -/* DISTINCT */ -/* EQ */ -/* FROM */ -/* GE */ -/* GROUP */ -/* GT */ -/* HAVING */ -/* IS */ -/* LE */ -/* LT */ -/* LIKE */ -/* MAX */ -/* MIN */ -/* NE */ -/* NOT */ -/* NULL */ -/* OR */ -/* ORDER */ -/* SELECT */ -/* SUM */ -/* WHERE */ - - -/* End Include Section: EK Keyword Code Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TOKID I Token ID. */ -/* KWCODE I Keyword code. */ -/* NTOKEN I Number of tokens in query. */ -/* TOKENS I Token codes. */ -/* VALUES I Pointers to numeric and string token values. */ -/* LOC O Location of first occurence of token. */ -/* FOUND O Flag indicating whether token was found. */ - -/* $ Detailed_Input */ - -/* TOKID is a token code identifying the type of token */ -/* sought. */ - -/* KWCODE is a code that specifies the desired keyword, */ -/* if the desired token is a keyword. KWCODE is */ -/* ignored if the desired token is not a keyword. */ - -/* NTOKEN is the number of tokens in the input query. */ - -/* TOKENS is an array of token codes. This array normally */ -/* represents a tokenized EK query or a sublist of */ -/* such a query. */ - -/* VALUES is a list of values associated with the codes */ -/* contained in TOKENS. When the Ith element of */ -/* TOKENS indicates that the Ith token is a keyword, */ -/* the Ith element of VALUES contains the code */ -/* specifying which keyword is meant. */ - -/* $ Detailed_Output */ - -/* LOC is the index in the input token list at which */ -/* the desired token was first encountered. LOC */ -/* is meaningful only if FOUND is .TRUE. */ - -/* FOUND is a logical flag indicating whether the desired */ -/* token was found. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility that simplifies parsing of tokenized EK */ -/* queries. */ - -/* $ Examples */ - -/* See ZZEKPARS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* Error free. */ - - *found = FALSE_; - *loc = 1; - while(*loc <= *ntoken) { - if (tokens[*loc - 1] == *tokid) { - if (*tokid == 1) { - -/* To get a match, the keyword codes must match. */ - - if (values[*loc - 1] == *kwcode) { - *found = TRUE_; - return 0; - } - } else { - -/* For non-keyword tokens, we're done at this point. */ - - *found = TRUE_; - return 0; - } - } - ++(*loc); - } - return 0; -} /* zzektloc_ */ - diff --git a/ext/spice/src/cspice/zzektr13.c b/ext/spice/src/cspice/zzektr13.c deleted file mode 100644 index aab8f6f890..0000000000 --- a/ext/spice/src/cspice/zzektr13.c +++ /dev/null @@ -1,683 +0,0 @@ -/* zzektr13.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__83 = 83; -static integer c__3 = 3; -static integer c__256 = 256; -static integer c__41 = 41; -static integer c__42 = 42; -static integer c__82 = 82; - -/* $Procedure ZZEKTR13 ( EK tree, 1-3 split ) */ -/* Subroutine */ int zzektr13_(integer *handle, integer *tree) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base, root; - extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, - integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_( - integer *, integer *, integer *); - integer i__, child[2], delta; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer rpage[256]; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - integer c1page[256], c2page[256], middle; - extern /* Subroutine */ int cleari_(integer *, integer *), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - integer nrkeys; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - -/* $ Abstract */ - -/* Execute a 1-3 split: split the root node to create two new */ -/* children, leaving a single key in the root. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If the number of keys in the root does not correspond to an */ -/* overflow of exactly 1 key, the error SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Insertions into an EK tree start at a leaf node. If the node */ -/* overflows, the EK system attempts to shuffle keys at the leaf */ -/* level to resolve the overflow. That attempt failing, the system */ -/* delegates the problem upward to the next higher level. Overflow */ -/* may occur there as well; if it does, the problem gets passed */ -/* upward again. If the root overflows, the system makes room by */ -/* executing what's called a `1-3' split: the root gets two new */ -/* children, and all but one of the keys in the root are moved into */ -/* the new children. The former children of the root become */ -/* children of the two new children of the root. */ - -/* After the 1-3 split, the tree is balanced and all invariants */ -/* relating to key counts are restored. */ - -/* The tree grows taller by one level as a result of a 1-3 split; */ -/* this is the only circumstance under which the tree grows taller. */ - -/* Below are the gory details concerning the actions of this routine. */ -/* All of the parameters referred to here (in capital letters) are */ -/* defined in the include file ektree.inc. */ - -/* In a 1-3 split: */ - -/* - The leftmost MNKEYC keys of the root are moved into the */ -/* new left child. */ - -/* - The data values associated with the first MNKEYC keys of the */ -/* root are moved along with the keys. */ - -/* - The left child pointers associated with the first MNKEYC keys */ -/* of the root are moved along with the keys. */ - -/* - The right child pointer of the key at location MNKEYC+1 in */ -/* the root is moved to location MYKEYC+1 in the child pointer */ -/* array of the left child. */ - -/* - The rightmost MNKEYC keys of the root are moved into the */ -/* new right child. */ - -/* - The data values associated with the last MNKEYC keys of the */ -/* root are moved along with the keys. */ - -/* - The left child pointers associated with the last MNKEYC keys */ -/* of the root are moved along with the keys. */ - -/* - The right child pointer of the last in the root is moved to */ -/* location MYKEYC+1 in the child pointer array of the right */ -/* child. */ - -/* - The left child pointer of the one key left in the root */ -/* points to the new left child. */ - -/* - The right child pointer of the one key left in the root */ -/* points to the new right child. */ - -/* As the above list shows, each of the new children of the root */ -/* contains the minimum allowed number of keys that a child node */ -/* may have. Thus the size constraints on child nodes are met. */ -/* The root must be non-empty unless the tree is empty; this */ -/* condition is also met. */ - -/* $ Examples */ - -/* See ZZEKTRIN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - root = *tree; - zzekpgri_(handle, &root, rpage); - nrkeys = rpage[4]; - -/* The number of keys in the root must correspond exactly to an */ -/* overflow level of 1 key. */ - - if (nrkeys != 83) { - chkin_("ZZEKTR13", (ftnlen)8); - setmsg_("Number of keys in root = #; should be #.", (ftnlen)40); - errint_("#", &nrkeys, (ftnlen)1); - errint_("#", &c__83, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR13", (ftnlen)8); - return 0; - } - -/* Allocate two new pages; these will become children of the root. */ -/* Each one will be assigned MNKEYC keys. */ - - for (i__ = 1; i__ <= 2; ++i__) { - zzekpgal_(handle, &c__3, &child[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("child", i__1, "zzektr13_", (ftnlen)221)], & - base); - } - -/* Set the key count in the first child. */ - - cleari_(&c__256, c1page); - c1page[0] = 41; - -/* Copy in the keys, data pointers, and child pointers from the */ -/* first MNKEYC locations in the root. Also take the left child */ -/* pointer of the middle key. */ - - movei_(&rpage[5], &c__41, &c1page[1]); - movei_(&rpage[172], &c__41, &c1page[128]); - movei_(&rpage[88], &c__42, &c1page[64]); - -/* Set up the key count in the second child. */ - - cleari_(&c__256, c2page); - c2page[0] = 41; - -/* Copy in the keys, data pointers, and child pointers from the */ -/* last MNKEYC locations in the root. Also take the last right */ -/* child pointer. */ - - middle = 42; - movei_(&rpage[(i__1 = middle + 5) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektr13_", (ftnlen)254)], &c__41, &c2page[1]); - movei_(&rpage[(i__1 = middle + 172) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektr13_", (ftnlen)255)], &c__41, &c2page[128]); - movei_(&rpage[(i__1 = middle + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektr13_", (ftnlen)256)], &c__42, &c2page[64]); - -/* The keys in this second node must be adjusted to account for the */ -/* loss of the predecessors assigned to the subtree headed by the */ -/* left child, as well as of the middle key. */ - - delta = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektr13_", (ftnlen)263)]; - for (i__ = 1; i__ <= 41; ++i__) { - c2page[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("c2page", i__1, - "zzektr13_", (ftnlen)266)] = c2page[(i__2 = i__) < 256 && 0 - <= i__2 ? i__2 : s_rnge("c2page", i__2, "zzektr13_", (ftnlen) - 266)] - delta; - } - -/* Now the root must be updated. The root now contains just 1 */ -/* key; that key should be shifted left to the first key location. */ -/* There are two child pointers; these point to the children just */ -/* created. The depth of the tree has increased, as well as the */ -/* number of nodes in the tree. */ - - rpage[5] = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektr13_", (ftnlen)276)]; - rpage[172] = rpage[(i__1 = middle + 171) < 256 && 0 <= i__1 ? i__1 : - s_rnge("rpage", i__1, "zzektr13_", (ftnlen)277)]; - rpage[88] = child[0]; - rpage[89] = child[1]; - rpage[4] = 1; - ++rpage[3]; - rpage[1] += 2; - cleari_(&c__82, &rpage[6]); - cleari_(&c__82, &rpage[173]); - cleari_(&c__82, &rpage[90]); - -/* Write out our updates. */ - - zzekpgwi_(handle, &root, rpage); - zzekpgwi_(handle, child, c1page); - zzekpgwi_(handle, &child[1], c2page); - return 0; -} /* zzektr13_ */ - diff --git a/ext/spice/src/cspice/zzektr1s.c b/ext/spice/src/cspice/zzektr1s.c deleted file mode 100644 index 1ede941f82..0000000000 --- a/ext/spice/src/cspice/zzektr1s.c +++ /dev/null @@ -1,1204 +0,0 @@ -/* zzektr1s.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__3 = 3; -static integer c__256 = 256; - -/* $Procedure ZZEKTR1S ( EK tree, one-shot load ) */ -/* Subroutine */ int zzektr1s_(integer *handle, integer *tree, integer *size, - integer *values) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base, page[256], nbig, node, subd, next, unit; - extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, - integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_( - integer *, integer *, integer *); - extern integer zzektrbs_(integer *); - integer d__, i__, n, q, child, s; - extern integer zzektrsz_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer level, nkids, npred, nkeys, tsize, kidbas; - extern /* Subroutine */ int cleari_(integer *, integer *), dasudi_( - integer *, integer *, integer *, integer *); - integer basidx; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer bigsiz, nnodes, nsmall, stnbig[10], stnbas[10], stnode[10]; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen); - extern logical return_(void); - integer maxsiz, reqsiz, stlsiz[10], stnext[10], stnkey[10], stsbsz[10], - subsiz, totnod; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer div, key; - -/* $ Abstract */ - -/* One-shot tree load: insert an entire array into an empty */ -/* tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* SIZE I Size of tree. */ -/* VALUES I Values to insert. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ -/* The tree must be empty. */ - -/* SIZE is the size of the tree to create: SIZE is the */ -/* number of values that will be inserted into the */ -/* tree. */ - -/* VALUES is an array of integer values to be inserted into */ -/* the tree. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input tree is not empty, the error SPICE(NONEMPTYTREE) */ -/* is signalled. */ - -/* 4) If the depth of the tree needed to hold the number of values */ -/* indicated by SIZE exceeds the maximum depth limit, the error */ -/* SPICE(COUNTTOOLARGE) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine creates an EK tree and loads the tree with the */ -/* integer values supplied in the array VALUES. The ordinal */ -/* positions of the values in the tree correspond to the positions */ -/* of the values in the input array: for example, the 10th element */ -/* of the array is pointed to by the key 10. */ - -/* This routine loads a tree much faster than can be done by */ -/* sequentially loading the set of values by successive calls to */ -/* ZZEKTRIN. On the other hand, the caller must declare an array */ -/* large enough to hold all of the values to be loaded. Note that */ -/* a partially full tree cannot be extended using this routine. */ - -/* $ Examples */ - -/* See EKFFLD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed redundant calls to CHKIN */ - -/* - Beta Version 1.0.0, 22-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKTR1S", (ftnlen)8); - } - -/* Make sure the input tree is empty. */ - - tsize = zzektrsz_(handle, tree); - if (tsize > 0) { - dashlu_(handle, &unit); - setmsg_("Tree has size #; should be empty.EK = #; TREE = #.", (ftnlen) - 50); - errint_("#", &tsize, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - sigerr_("SPICE(NONEMPTYTREE)", (ftnlen)19); - chkout_("ZZEKTR1S", (ftnlen)8); - return 0; - } - -/* Compute the tree depth required. The largest tree of a given */ -/* depth D contains the root node plus S(D) child nodes, where */ - - -/* S(1) = 1 */ - - -/* and if D is at least 2, */ -/* D - 2 */ -/* ____ */ -/* \ i */ -/* S(D) = MAX_SIZE * / MAX_SIZE */ -/* Root ---- Child */ -/* i = 0 */ - - -/* D - 2 */ -/* ____ */ -/* \ i */ -/* = MXKIDR * / MXKIDC */ -/* ---- */ -/* i = 0 */ - - -/* D-1 */ -/* MXKIDC - 1 */ -/* = MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* If all of these nodes are full, the number of keys that */ -/* can be held in this tree is */ - -/* MXKEYR + S(D) * MXKEYC */ - -/* We want the minimum value of D such that this expression */ -/* is greater than or equal to SIZE. */ - - tsize = 82; - d__ = 1; - s = 1; - while(tsize < *size) { - ++d__; - if (d__ == 2) { - s = 82; - } else { - -/* For computational purposes, the relationship */ - -/* S(D+1) = MXKIDR + MXKIDC * S(D) */ - -/* is handy. */ - - - s = s * 63 + 83; - } - tsize = s * 62 + 82; - } - -/* If the tree must be deeper than we expected, we've a problem. */ - - if (d__ > 10) { - dashlu_(handle, &unit); - setmsg_("Tree has depth #; max supported depth is #.EK = #; TREE = #." - , (ftnlen)60); - errint_("#", &d__, (ftnlen)1); - errint_("#", &c__10, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - sigerr_("SPICE(COUNTTOOLARGE)", (ftnlen)20); - chkout_("ZZEKTR1S", (ftnlen)8); - return 0; - } - -/* The basic error checks are done. At this point, we can build the */ -/* tree. */ - -/* The approach is to fill in the tree in a top-down fashion. */ -/* We decide how big each subtree of the root will be; this */ -/* information allows us to decide which keys actually belong */ -/* in the root. Having filled in the root, we repeat the process */ -/* for each subtree of the root in left-to-right order. */ - -/* We use a stack to keep track of the ancestors of the */ -/* node we're currently considering. The table below shows the */ -/* items we save on the stack and the stack variables associated */ -/* with those items: */ - - -/* Item Stack Variable */ -/* ---- --------------- */ -/* Node number STNODE */ - -/* Size, in keys, of the */ -/* subtree headed by node STSBSZ */ - -/* Number of keys in node STNKEY */ - -/* Larger subtree size STLSIZ */ - -/* Number of large subtrees STNBIG */ - -/* Index of next subtree to visit STNEXT */ - -/* Base index of node STNBAS */ - - - node = *tree; - subsiz = *size; - next = 1; - level = 1; - basidx = 0; - while(level > 0) { - -/* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */ - - if (next == 1) { - -/* This node has not been visited yet. We'll fill in this */ -/* node before proceeding to fill in its descendants. The */ -/* first step is to compute the number and sizes of the */ -/* subtrees of this node. */ - -/* Decide the large subtree size and the number of subtrees of */ -/* this node. The depth SUBD of the subtrees of this node is */ -/* D - LEVEL. Each subtree has size bounded by the sizes of */ -/* the subtree of depth SUBD in which all nodes contain MNKEYC */ -/* keys and the by the subtree of depth SUBD in which all nodes */ -/* contain MXKEYC keys. If this node is not the root and is */ -/* not a leaf node, the number of subtrees must be between */ -/* MNKIDC and MXKIDC. */ - - if (level == 1) { - -/* We're working on the root. The number of subtrees is */ -/* anywhere between 0 and MXKIDR, inclusive. We'll create */ -/* a tree with the minimum number of subtrees of the root. */ - - if (d__ > 1) { - -/* We'll find the number of subtrees of maximum size */ -/* that we would need to hold the non-root keys of the */ -/* tree. We'll then determine the actual required sizes */ -/* of these subtrees. */ - - subd = d__ - 1; - nnodes = 0; - i__1 = subd; - for (i__ = 1; i__ <= i__1; ++i__) { - nnodes = nnodes * 63 + 1; - } - maxsiz = nnodes * 62; - -/* If we had NKIDS subtrees of size MAXSIZ, NKIDS */ -/* would be the smallest integer such that */ - -/* ( NKIDS - 1 ) + NKIDS * MAXSIZ > SUBSIZ */ -/* - */ - -/* or equivalently, */ - -/* NKIDS * ( MAXSIZ + 1 ) > SUBSIZ + 1 */ -/* - */ - -/* We'll compute this value of NKIDS. */ - - - q = subsiz + 1; - div = maxsiz + 1; - nkids = (q + div - 1) / div; - -/* The minimum number of keys we must store in child */ -/* nodes is the number of keys in the tree, minus those */ -/* that can be accommodated in the root: */ - - n = subsiz - (nkids - 1); - -/* Now we can figure out how large the subtrees would */ -/* have to be in order to hold N keys, if all subtrees */ -/* had the same size. */ - - bigsiz = (n + nkids - 1) / nkids; - -/* We may have more capacity than we need if all subtrees */ -/* have size BIGSIZ. So, we'll allow some subtrees to */ -/* have size BIGSIZ-1. Not all subtrees can have the */ -/* smaller size (otherwise BIGSIZ would have been */ -/* smaller). The first NBIG subtrees will have the */ -/* larger size. */ - - nsmall = nkids * bigsiz - n; - nbig = nkids - nsmall; - nkeys = nkids - 1; - } else { - -/* All keys are in the root. */ - - nkeys = *size; - nkids = 0; - } - -/* Read in the root page. */ - - zzekpgri_(handle, tree, page); - -/* We have enough information to fill in the root node. */ -/* We'll allocate nodes for the immediate children. */ -/* There is one key `between' each child pointer. */ - - i__1 = nkeys; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* The Ith key may be found by considering the number */ -/* of keys in the subtree between the Ith key and its */ -/* predecessor in the root. */ - - if (i__ == 1) { - npred = 0; - } else { - npred = page[(i__2 = i__ + 3) < 256 && 0 <= i__2 ? - i__2 : s_rnge("page", i__2, "zzektr1s_", ( - ftnlen)480)]; - } - if (d__ > 1) { - -/* The tree contains subtrees. */ - - if (i__ <= nbig) { - key = npred + bigsiz + 1; - } else { - key = npred + bigsiz; - } - } else { - key = i__; - } - page[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "zzektr1s_", (ftnlen)499)] = key; - page[(i__2 = i__ + 171) < 256 && 0 <= i__2 ? i__2 : - s_rnge("page", i__2, "zzektr1s_", (ftnlen)500)] = - values[key - 1]; - } - totnod = 1; - i__1 = nkids; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Allocate a node for the Ith child. Store pointers */ -/* to these nodes. */ - - zzekpgal_(handle, &c__3, &child, &base); - page[(i__2 = i__ + 87) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "zzektr1s_", (ftnlen)513)] = child; - ++totnod; - } - -/* Fill in the root's metadata. There is one item that */ -/* we'll have to fill in when we're done: the number of */ -/* nodes in the tree. We know the rest of the information */ -/* now. */ - - page[2] = *size; - page[3] = d__; - page[4] = nkeys; - page[1] = 0; - -/* Write out the root. */ - - zzekpgwi_(handle, tree, page); - } else if (level < d__) { - -/* The current node is a non-leaf child node. */ - - cleari_(&c__256, page); - -/* The tree headed by this node has depth D-LEVEL+1 and */ -/* must hold SUBSIZ keys. We must figure out the size */ -/* and number of subtrees of the current node. Unlike in */ -/* the case of the root, we must have between MNKIDC */ -/* and MXKIDC subtrees of this node. We start out by */ -/* computing the required subtree size if there were */ -/* exactly MNKIDC subtrees. In this case, the total */ -/* number of keys in the subtrees would be */ - -/* SUBSIZ - MNKEYC */ - - - n = subsiz - 41; - reqsiz = (n + 40) / 41; - -/* Compute the maximum allowable number of keys in */ -/* a subtree. */ - - subd = d__ - level; - nnodes = 0; - i__1 = subd; - for (i__ = 1; i__ <= i__1; ++i__) { - nnodes = nnodes * 63 + 1; - } - maxsiz = nnodes * 62; - -/* If the number REQSIZ we came up with is a valid size, */ -/* we'll be able to get the correct number of children */ -/* by using subtrees of size REQSIZ and REQSIZ-1. Note */ -/* that it's impossible for REQSIZ to be too small, */ -/* since the smallest possible number of subtrees is */ -/* MNKIDC. */ - - if (reqsiz <= maxsiz) { - -/* Decide how many large and small subtrees we need. */ - - nkids = 42; - bigsiz = reqsiz; - nsmall = bigsiz * nkids - n; - nbig = nkids - nsmall; - } else { - - -/* See how many subtrees of size MAXSIZ it would take */ -/* to hold the requisite number of keys. We know the */ -/* number is more than MNKIDC. If we have NKIDS */ -/* subtrees of size MAXSIZ, the total number of */ -/* keys in the subtree headed by NODE is */ - -/* ( NKIDS - 1 ) + ( NKIDS * MAXSIZ ) */ - -/* or */ - -/* NKIDS * ( MAXSIZ + 1 ) - 1 */ - -/* We must find the smallest value of NKIDS such */ -/* that the above quantity is greater than or equal */ -/* to SUBSIZ. */ - - q = subsiz + 1; - div = maxsiz + 1; - nkids = (q + div - 1) / div; - -/* We know that NKIDS subtrees of size MAXSIZ, plus */ -/* NKIDS-1 keys in NODE, can hold at least SUBSIZ */ -/* keys. We now want to find the smallest subtree */ -/* size such that NKIDS subtrees of that size, */ -/* together with the NKIDS-1 keys in NODE, contain */ -/* at least SUBSIZ keys. The size we seek will */ -/* become BIGSIZ, the larger of the two subtree */ -/* sizes we'll use. So BIGSIZ is the smallest */ -/* integer such that */ - -/* ( NKIDS - 1 ) + ( NKIDS * BIGSIZ ) > SUBSIZ */ -/* - */ - -/* or equivalently */ - -/* BIGSIZ * NKIDS > SUBSIZ - NKIDS + 1 */ -/* - */ - - q = subsiz - nkids + 1; - div = nkids; - bigsiz = (q + div - 1) / div; - nsmall = bigsiz * nkids - q; - nbig = nkids - nsmall; - } - -/* Fill in the keys for the current node. */ - - nkeys = nkids - 1; - i__1 = nkeys; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* The Ith key may be found by considering the number */ -/* of keys in the subtree between the Ith key and its */ -/* predecessor in the current node. */ - - if (i__ == 1) { - npred = basidx; - } else { - npred = basidx + page[(i__2 = i__ - 1) < 256 && 0 <= - i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_" - , (ftnlen)652)]; - } - if (i__ <= nbig) { - key = npred + bigsiz + 1; - } else { - key = npred + bigsiz; - } - page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "zzektr1s_", (ftnlen)661)] = key - - basidx; - page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : - s_rnge("page", i__2, "zzektr1s_", (ftnlen)662)] = - values[key - 1]; - } - i__1 = nkids; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Allocate a node for the Ith child. Store pointers */ -/* to these nodes. */ - - zzekpgal_(handle, &c__3, &child, &base); - page[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "zzektr1s_", (ftnlen)674)] = child; - ++totnod; - } - -/* We can now fill in the metadata for the current node. */ - - page[0] = nkeys; - zzekpgwi_(handle, &node, page); - } - -/* Unless the current node is a leaf node, prepare to visit */ -/* the first child of the current node. */ - - if (level < d__) { - -/* Push our current state. */ - - stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stnode", i__1, "zzektr1s_", (ftnlen)696)] = node; - stsbsz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stsbsz", i__1, "zzektr1s_", (ftnlen)697)] = subsiz; - stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stnkey", i__1, "zzektr1s_", (ftnlen)698)] = nkeys; - stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stlsiz", i__1, "zzektr1s_", (ftnlen)699)] = bigsiz; - stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stnbig", i__1, "zzektr1s_", (ftnlen)700)] = nbig; - stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stnext", i__1, "zzektr1s_", (ftnlen)701)] = 2; - stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stnbas", i__1, "zzektr1s_", (ftnlen)702)] = basidx; - -/* NEXT is already set to 1. BASIDX is set, since the */ -/* base index of the first child is that of the parent. */ - - if (level == 1) { - kidbas = 88; - } else { - kidbas = 64; - } - ++level; - node = page[(i__1 = kidbas) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektr1s_", (ftnlen)715)]; - subsiz = bigsiz; - } else if (level > 1) { - -/* The current node is a child leaf node. There are no */ -/* calculations to do; we simply assign keys and pointers, */ -/* write out metadata, and pop our state. */ - - nkeys = subsiz; - i__1 = nkeys; - for (i__ = 1; i__ <= i__1; ++i__) { - key = basidx + i__; - page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "zzektr1s_", (ftnlen)730)] = i__; - page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : - s_rnge("page", i__2, "zzektr1s_", (ftnlen)731)] = - values[key - 1]; - } - -/* We can now fill in the metadata for the current node. */ - - page[0] = nkeys; - zzekpgwi_(handle, &node, page); - -/* A leaf node is a subtree unto itself, and we're */ -/* done with this subtree. Pop our state. */ - - --level; - if (level >= 1) { - node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)750) - ]; - nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stnkey", i__1, "zzektr1s_", ( - ftnlen)751)]; - bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( - ftnlen)752)]; - nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)753) - ]; - next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)754) - ]; - basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( - ftnlen)755)]; - nkids = nkeys + 1; - -/* Read in the current node. */ - - zzekpgri_(handle, &node, page); - } - } else { - -/* The only node is the root. Pop out. */ - - level = 0; - } - -/* We've decided which node to go to next at this point. */ -/* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */ - - } else { - -/* The current node has been visited already. Visit the */ -/* next child, if there is one. */ - - if (next <= nkids) { - -/* Prepare to visit the next child of the current node. */ - - stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "stnext", i__1, "zzektr1s_", (ftnlen)787)] = next + 1; - if (level == 1) { - kidbas = 88; - } else { - kidbas = 64; - } - node = page[(i__1 = kidbas + next - 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("page", i__1, "zzektr1s_", (ftnlen)797)] - ; - if (next <= nbig) { - subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( - ftnlen)801)]; - } else { - subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( - ftnlen)803)] - 1; - } - if (next <= nbig + 1) { - basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( - ftnlen)809)] + (next - 1) * stlsiz[(i__2 = level - - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz", - i__2, "zzektr1s_", (ftnlen)809)] + (next - 1); - } else { - basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( - ftnlen)815)] + nbig * stlsiz[(i__2 = level - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz", i__2, - "zzektr1s_", (ftnlen)815)] + (next - nbig - 1) * ( - stlsiz[(i__3 = level - 1) < 10 && 0 <= i__3 ? - i__3 : s_rnge("stlsiz", i__3, "zzektr1s_", ( - ftnlen)815)] - 1) + (next - 1); - } - ++level; - next = 1; - -/* LEVEL, NEXT, NODE, SUBSIZ, and BASIDX are set. */ - - } else { - -/* We're done with the current subtree. Pop the stack. */ - - --level; - if (level >= 1) { - node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)836) - ]; - nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stnkey", i__1, "zzektr1s_", ( - ftnlen)837)]; - bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", ( - ftnlen)838)]; - nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)839) - ]; - next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)840) - ]; - basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("stnbas", i__1, "zzektr1s_", ( - ftnlen)841)]; - nkids = nkeys + 1; - -/* Read in the current node. */ - - zzekpgri_(handle, &node, page); - } - } - } - -/* On this pass through the loop, we either--- */ - -/* - Visited a node for the first time and filled in the */ -/* node. */ - -/* - Advanced to a new node that has not yet been visited. */ - -/* - Exited from a completed subtree. */ - -/* Each of these actions can be performed a finite number of */ -/* times. Therefore, we made progress toward loop termination. */ - - } - -/* The last chore is setting the total number of nodes in the root. */ - - base = zzektrbs_(tree); - i__1 = base + 2; - i__2 = base + 2; - dasudi_(handle, &i__1, &i__2, &totnod); - chkout_("ZZEKTR1S", (ftnlen)8); - return 0; -} /* zzektr1s_ */ - diff --git a/ext/spice/src/cspice/zzektr23.c b/ext/spice/src/cspice/zzektr23.c deleted file mode 100644 index 8ebd0e016c..0000000000 --- a/ext/spice/src/cspice/zzektr23.c +++ /dev/null @@ -1,1043 +0,0 @@ -/* zzektr23.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__125 = 125; -static integer c__3 = 3; -static integer c__256 = 256; - -/* $Procedure ZZEKTR23 ( EK tree, 2-3 split ) */ -/* Subroutine */ int zzektr23_(integer *handle, integer *tree, integer *left, - integer *right, integer *parent, integer *pkidx, logical *overfl) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer base, lsib, rsib, root; - extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, - integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_( - integer *, integer *, integer *); - extern integer zzektrbs_(integer *); - integer i__, ppage[256], rbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nnode; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - integer lsize, msize, rsize, c1page[256], c2page[256], c3page[256], - datbas, kidbas, ldelta; - extern /* Subroutine */ int cleari_(integer *, integer *), dasrdi_( - integer *, integer *, integer *, integer *), dasudi_(integer *, - integer *, integer *, integer *); - integer rdelta, keybas, lshift; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer lnmove, nlkeys, npkeys, nrkeys, ltrsiz, rnmove, rshift; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - integer new__, sum; - -/* $ Abstract */ - -/* Execute a 2-3 split: split two sibling nodes into three nodes, */ -/* each one approximately 2/3 full. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* LEFT I Left sibling node. */ -/* RIGHT I Right sibling node. */ -/* PARENT I Common parent node. */ -/* PKIDX I Node-relative index of parent key. */ -/* OVERFL O Overflow flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* LEFT is the node number of the left node of a pair of */ -/* siblings. LEFT is either full or overflowing by */ -/* one key. */ - -/* RIGHT is the node number of the right node of a pair of */ -/* siblings. The total number of keys in nodes */ -/* LEFT and RIGHT amounts to an overflow of 1 key. */ - -/* PARENT is the node number of the common parent of LEFT */ -/* and RIGHT. */ - -/* PKIDX is the node-relative index in PARENT of the key */ -/* that sits between nodes LEFT and RIGHT. */ - -/* $ Detailed_Output */ - -/* OVERFL is a logical flag indicating whether the parent */ -/* node overflowed as a result of the 2-3 split. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If LEFT and RIGHT are not neighboring siblings, the error */ -/* SPICE(BUG) is signalled. */ - -/* 4) If either LEFT or RIGHT are not children of PARENT, the error */ -/* SPICE(BUG) is signalled. */ - -/* 5) If the sum of the number of keys in LEFT and RIGHT does not */ -/* correspond to an overflow of exactly 1 key, the error */ -/* SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Insertions into an EK tree start at a leaf node. If the node */ -/* overflows, the EK system attempts to shuffle keys at the leaf */ -/* level to resolve the overflow. That attempt failing, the system */ -/* delegates the problem upward to the next higher level. */ - -/* There are two ways to resolve overflow in a non-root node: */ -/* balance the overflowing node with one of its closest siblings */ -/* (see ZZEKTRBN), or if the closest siblings are full, execute a 2-3 */ -/* split. */ - -/* A 2-3 split involves creation of a new sibling node between two */ -/* siblings, one of which is full and one of which contains one */ -/* excess key, and redistributing the keys between the three nodes */ -/* and their common parent so that each of the three siblings is */ -/* approximately two-thirds full. The parent gains a key in the */ -/* process. */ - -/* After the 2-3 split, the tree is balanced and the siblings */ -/* satisfy the key count invariants. However, the parent of the */ -/* siblings may overflow by one key. */ - -/* Below are the gory details concerning the actions of this routine. */ -/* All of the parameters referred to here (in capital letters) are */ -/* defined in the include file ektree.inc. */ - -/* In a 2-3 split: */ - -/* - The leftmost (2*MXKEYC)/3 keys of the left child remain in */ -/* that child. */ - -/* - The rest of the keys in the left child node are rotated */ -/* through the parent into the middle child. The last of these */ -/* rotated keys remains in the parent. The others become the */ -/* leftmost keys of the middle child. */ - -/* - The data values associated with the rotated keys of the */ -/* left child are moved along with the keys. */ - -/* - All but the leftmost of the left child pointers associated */ -/* with the rotated keys of the left child are moved along with */ -/* the keys. The leftmost of these pointers remains in the left */ -/* child node. */ - -/* - The right child pointers associated with the rotated keys */ -/* of the left child node move along with the keys, except for */ -/* the right child pointer of the leftmost key of the rotated */ -/* set. This leftmost key ends up in the parent, but its right */ -/* child pointer becomes the leftmost left child pointer of the */ -/* center sibling. */ - -/* - The key from the left child node that is rotated into the */ -/* parent loses both of its original child pointers; these */ -/* are replaced by pointers to the left and center siblings. */ - -/* - The parent key that originally sat between the left and */ -/* right siblings is moved down into the center sibling, along */ -/* with its data value. It becomes the immediate successor of */ -/* the set of nodes rotated into the center from the left child. */ - -/* - The actions taken to rotate keys from the right child are */ -/* basically symmetric with those that apply to the left child, */ -/* except that the number of keys left in the right node is */ -/* (2*MXKEYC+2)/3, and these keys are shifted to the left side */ -/* of the right node. The rightmost key of the rotated set */ -/* contributed by the right child is placed in the parent as */ -/* the successor of the key moved into the parent from the left */ -/* child. The rest of the rotated set become successors of */ -/* the key moved into the middle child from the parent. */ - -/* - The middle child ends up with (2*MXKEYC+1)/3 keys. This */ -/* may be deduced from the facts that the original two children */ -/* had between them an overflow of one key, the parent gained */ -/* a key, and the expression */ - -/* 2*MXKEYC 2*MXKEYC+1 2*MXKEYC+2 */ -/* -------- + ---------- + ---------- */ -/* 3 3 3 */ - -/* where integer division is performed, yields one less than */ -/* the same expression when real division is performed (since */ -/* exactly one of the numerators is a multiple of 3). So the */ -/* above expression evaluates to */ - -/* 2*MXKEYC */ - -/* which is exactly one less than the number of keys in the */ -/* original two siblings. */ - -/* Since */ - -/* MNKEYC = MNKIDC - 1 */ -/* = ( ( 2*MXKIDC + 1 ) / 3 ) - 1 */ -/* = ( 2*MXKIDC - 2 ) / 3 */ -/* = ( 2*MXKEYC ) / 3 */ - -/* we see that the smallest of the new child nodes has at */ -/* least the minimum allowed number of keys. The constraint */ -/* on the maximum is met as well, since the maximum is */ -/* approximately 3/2 times the minimum, and the minimum is */ -/* approximately 40. */ - - -/* As the above description shows, the parent gains a key as a */ -/* result of a 2-3 split. This may cause the parent to overflow; */ -/* if it does, the overflow at the parent's level must be resolved. */ - -/* $ Examples */ - -/* See ZZEKTRIN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 16-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - -/* The plan is to take two sibling nodes, one of which is full and */ -/* one of which is overflowing by 1 key, and to split off about */ -/* one third of the keys from each one into a new node. The new */ -/* node will be a child of the common parent of the input nodes and */ -/* will be inserted between them. */ - -/* After the split, the sum of the numbers of keys in the three */ -/* children will be exactly 2*MXKEYC. The numbers of keys in the */ -/* left, middle, and right nodes will be, respectively: */ - - lsize = 41; - msize = 41; - rsize = 42; - -/* Note that exactly one of the numerators above is a multiple of 3, */ -/* so the sum of the above numbers is 1 less than if real division */ -/* were performed. Therefore, the sum of the numbers of keys in the */ -/* child nodes is 2*MXKEYC. The parent will contain one more node */ -/* than it did before the split: the key originally between LEFT and */ -/* RIGHT will be moved down into the middle child, and the */ -/* smallest key moved from LEFT and the largest key moved from RIGHT */ -/* will go into PARENT. */ - - zzekpgri_(handle, left, c1page); - zzekpgri_(handle, right, c2page); - zzekpgri_(handle, parent, ppage); - -/* The actual addresses in the parent node depend on whether the */ -/* parent is the root. Compute the necessary bases to avoid a lot */ -/* of cases. */ - - root = *tree; - if (*parent == root) { - keybas = 5; - datbas = 172; - kidbas = 88; - } else { - keybas = 1; - datbas = 128; - kidbas = 64; - } - -/* Verify that LEFT and RIGHT are siblings, and that PARENT is */ -/* their common parent. */ - - lsib = ppage[(i__1 = kidbas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("ppage", i__1, "zzektr23_", (ftnlen)344)]; - rsib = ppage[(i__1 = kidbas + *pkidx) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr23_", (ftnlen)345)]; - if (lsib != *left || rsib != *right) { - chkin_("ZZEKTR23", (ftnlen)8); - setmsg_("LEFT, RIGHT, PARENT, and PKIDX are inconsistent. LEFT = #; " - "RIGHT = #; PARENT = #; PKIDX = #; LSIB derived from PARENT =" - " #; RSIB = #.", (ftnlen)132); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", parent, (ftnlen)1); - errint_("#", pkidx, (ftnlen)1); - errint_("#", &lsib, (ftnlen)1); - errint_("#", &rsib, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR23", (ftnlen)8); - return 0; - } - nlkeys = c1page[0]; - nrkeys = c2page[0]; - sum = nlkeys + nrkeys; - -/* The sum of the number of keys in the two input nodes must */ -/* sum exactly to the value representing an overflow level of 1 key. */ - - if (sum != 125) { - chkin_("ZZEKTR23", (ftnlen)8); - setmsg_("Number of keys in LEFT = #; number of keys in right = #; bu" - "t sum should be #.", (ftnlen)77); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", &c__125, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR23", (ftnlen)8); - return 0; - } - -/* Allocate a new page. This page will become the right sibling */ -/* of LEFT and the left sibling of RIGHT. */ - - zzekpgal_(handle, &c__3, &new__, &base); - cleari_(&c__256, c3page); - -/* It's time to set up the keys in the middle child. First, we'll */ -/* take the last LSHIFT keys from the left node, where */ - - lshift = nlkeys - (lsize + 1); - -/* When these keys are moved, they lose LDELTA predecessors, where */ -/* LDELTA is the size of the key set preceding and including the key */ -/* at location LSIZE + 1. The size of this subtree is just the */ -/* key value at location LSIZE+1. */ - - ldelta = c1page[(i__1 = lsize + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "c1page", i__1, "zzektr23_", (ftnlen)407)]; - i__1 = lshift; - for (i__ = 1; i__ <= i__1; ++i__) { - c3page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("c3page", i__2, - "zzektr23_", (ftnlen)410)] = c1page[(i__3 = lsize + 2 + i__ - - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("c1page", i__3, "zze" - "ktr23_", (ftnlen)410)] - ldelta; - } - movei_(&c1page[(i__1 = lsize + 129) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "c1page", i__1, "zzektr23_", (ftnlen)413)], &lshift, &c3page[128]) - ; - i__2 = lshift + 1; - movei_(&c1page[(i__1 = lsize + 65) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "c1page", i__1, "zzektr23_", (ftnlen)414)], &i__2, &c3page[64]); - -/* Compute the size of the tree headed by the left subnode. We'll */ -/* need this shortly. The size of this tree is one less than the */ -/* difference of the parent key and its predecessor, if any. */ - - if (*pkidx == 1) { - ltrsiz = ppage[(i__1 = keybas) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr23_", (ftnlen)424)] - 1; - } else { - ltrsiz = ppage[(i__1 = keybas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 - : s_rnge("ppage", i__1, "zzektr23_", (ftnlen)426)] - ppage[( - i__2 = keybas + *pkidx - 2) < 256 && 0 <= i__2 ? i__2 : - s_rnge("ppage", i__2, "zzektr23_", (ftnlen)426)] - 1; - } - -/* The next item to add to the middle child is the middle key */ -/* from the parent. The data pointer is copied; the key value is */ -/* simply set. The value of the key is one more than the size of */ -/* the entire key set (including descendants) we moved into the */ -/* middle from the left. LNMOVE is the size of this key set. */ - -/* No child pointer is copied. */ - - lnmove = ltrsiz - ldelta; - c3page[(i__1 = lshift + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("c3page", - i__1, "zzektr23_", (ftnlen)439)] = lnmove + 1; - c3page[(i__1 = lshift + 128) < 256 && 0 <= i__1 ? i__1 : s_rnge("c3page", - i__1, "zzektr23_", (ftnlen)442)] = ppage[(i__2 = datbas + *pkidx - - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage", i__2, "zzektr23_" - , (ftnlen)442)]; - -/* Now we copy keys from the right child into the middle. We'll */ -/* take the first RSHIFT keys from the right node, where */ - - rshift = nrkeys - (rsize + 1); - -/* When these keys are moved, they gain RDELTA predecessors, where */ -/* RDELTA is the size of the key set already in the middle node. */ - - rdelta = lnmove + 1; - i__1 = rshift; - for (i__ = 1; i__ <= i__1; ++i__) { - c3page[(i__2 = lshift + 2 + i__ - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("c3page", i__2, "zzektr23_", (ftnlen)457)] = c2page[( - i__3 = i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", i__3, - "zzektr23_", (ftnlen)457)] + rdelta; - } - movei_(&c2page[128], &rshift, &c3page[(i__1 = lshift + 129) < 256 && 0 <= - i__1 ? i__1 : s_rnge("c3page", i__1, "zzektr23_", (ftnlen)460)]); - i__2 = rshift + 1; - movei_(&c2page[64], &i__2, &c3page[(i__1 = lshift + 65) < 256 && 0 <= - i__1 ? i__1 : s_rnge("c3page", i__1, "zzektr23_", (ftnlen)461)]); - -/* Save the size of the entire key set moved into the middle from */ -/* the right. */ - - rnmove = c2page[(i__1 = rshift + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "c2page", i__1, "zzektr23_", (ftnlen)467)] - 1; - -/* Set the key count in the new child. */ - - c3page[0] = msize; - -/* The middle child is complete. */ - -/* The next step is to set up the parent node. The original parent */ -/* key at index PKIDX is replaced by the key from the left child */ -/* at location LSIZE + 1. The following parent keys are shifted */ -/* right by one location, making room for a second key following */ -/* the one at PKIDX. This newly freed slot is filled in with the */ -/* key at location RSHIFT+1 in the right child. */ - -/* The keys in the parent to the right of position PKIDX+1 gain no */ -/* predecessors as the result of these re-arrangements. */ - -/* Get the number of keys in the parent. */ - - if (*parent == root) { - npkeys = ppage[4]; - } else { - npkeys = ppage[0]; - } - -/* Make room for the new key. Shift elements starting from the */ -/* right. */ - - i__1 = *pkidx + 1; - for (i__ = npkeys; i__ >= i__1; --i__) { - ppage[(i__2 = keybas + i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage" - , i__2, "zzektr23_", (ftnlen)500)] = ppage[(i__3 = keybas + - i__ - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("ppage", i__3, - "zzektr23_", (ftnlen)500)]; - } - i__1 = *pkidx + 1; - for (i__ = npkeys; i__ >= i__1; --i__) { - ppage[(i__2 = datbas + i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage" - , i__2, "zzektr23_", (ftnlen)504)] = ppage[(i__3 = datbas + - i__ - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("ppage", i__3, - "zzektr23_", (ftnlen)504)]; - } - i__1 = *pkidx + 1; - for (i__ = npkeys + 1; i__ >= i__1; --i__) { - ppage[(i__2 = kidbas + i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage" - , i__2, "zzektr23_", (ftnlen)508)] = ppage[(i__3 = kidbas + - i__ - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("ppage", i__3, - "zzektr23_", (ftnlen)508)]; - } - -/* Copy in the data pointer from the left child. Note that */ -/* no child pointer comes along. */ - - ppage[(i__1 = datbas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr23_", (ftnlen)515)] = c1page[(i__2 = lsize - + 128) < 256 && 0 <= i__2 ? i__2 : s_rnge("c1page", i__2, "zzekt" - "r23_", (ftnlen)515)]; - -/* Set the key value at PKIDX. The value exceeds that of the */ -/* preceding key, if any, by one more than the size of the subtree */ -/* headed by the left child. That size is one less than */ -/* LDELTA, since LDELTA includes the key at location LSIZE+1. */ - - if (*pkidx == 1) { - ppage[(i__1 = keybas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr23_", (ftnlen)524)] = ldelta; - } else { - ppage[(i__1 = keybas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr23_", (ftnlen)526)] = ppage[(i__2 = - keybas + *pkidx - 2) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppa" - "ge", i__2, "zzektr23_", (ftnlen)526)] + ldelta; - } - -/* Copy in the data pointer from the right child. Again, note that */ -/* no child pointer comes along. */ - - ppage[(i__1 = datbas + *pkidx) < 256 && 0 <= i__1 ? i__1 : s_rnge("ppage", - i__1, "zzektr23_", (ftnlen)533)] = c2page[(i__2 = rshift + 128) < - 256 && 0 <= i__2 ? i__2 : s_rnge("c2page", i__2, "zzektr23_", ( - ftnlen)533)]; - -/* Set the key value at PKIDX+1. The value exceeds that of the */ -/* preceding key by one more than the size of the subtree headed by */ -/* the middle child. */ - - ppage[(i__1 = keybas + *pkidx) < 256 && 0 <= i__1 ? i__1 : s_rnge("ppage", - i__1, "zzektr23_", (ftnlen)540)] = ppage[(i__2 = keybas + *pkidx - - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage", i__2, "zzektr23_" - , (ftnlen)540)] + lnmove + rnmove + 2; - -/* The child pointer at PKIDX+1 does get set: it points to the */ -/* middle child. */ - - ppage[(i__1 = kidbas + *pkidx) < 256 && 0 <= i__1 ? i__1 : s_rnge("ppage", - i__1, "zzektr23_", (ftnlen)549)] = new__; - -/* Remarkably, the only required change to the parent's metadata is */ -/* updating the key count. At this point, we can set the overflow */ -/* flag, depending on the status of the parent. */ - - if (*parent == root) { - ++ppage[4]; - *overfl = ppage[4] == 83; - } else { - ++ppage[0]; - *overfl = ppage[0] == 63; - } - -/* Update the metadata in the first child. This node has lost */ -/* just enough keys to give it size LSIZE. */ - - c1page[0] = lsize; - -/* For safety, clean out the vacated key and pointer locations. */ -/* Clear the overflow addresses as well. */ - - i__2 = 63 - lsize; - cleari_(&i__2, &c1page[(i__1 = lsize + 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c1page", i__1, "zzektr23_", (ftnlen)578)]); - i__2 = 63 - lsize; - cleari_(&i__2, &c1page[(i__1 = lsize + 128) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c1page", i__1, "zzektr23_", (ftnlen)579)]); - i__2 = 64 - (lsize + 1); - cleari_(&i__2, &c1page[(i__1 = lsize + 65) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c1page", i__1, "zzektr23_", (ftnlen)580)]); - -/* The first child is set. */ - -/* To adjust the second child, we must shift the keys and pointers */ -/* left to fill in the vacated space. The keys in this second child */ -/* must be adjusted to account for the loss of the predecessors */ -/* moved to the middle child and the parent. */ - -/* Shift elements starting from the left. */ - - i__1 = rsize; - for (i__ = 1; i__ <= i__1; ++i__) { - c2page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("c2page", i__2, - "zzektr23_", (ftnlen)593)] = c2page[(i__3 = rshift + 2 + i__ - - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", i__3, "zze" - "ktr23_", (ftnlen)593)] - (rnmove + 1); - } - i__1 = rsize; - for (i__ = 1; i__ <= i__1; ++i__) { - c2page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("c2page", - i__2, "zzektr23_", (ftnlen)597)] = c2page[(i__3 = rshift + - 129 + i__ - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", - i__3, "zzektr23_", (ftnlen)597)]; - } - i__1 = rsize + 1; - for (i__ = 1; i__ <= i__1; ++i__) { - c2page[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge("c2page", - i__2, "zzektr23_", (ftnlen)601)] = c2page[(i__3 = rshift + 65 - + i__ - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", i__3, - "zzektr23_", (ftnlen)601)]; - } - -/* Update the key count in the second child. This node has lost */ -/* just enough keys to give it size RSIZE. */ - - c2page[0] = rsize; - -/* For safety, clean out the vacated key and pointer locations. */ -/* Clear the overflow addresses as well. */ - - i__2 = 63 - rsize; - cleari_(&i__2, &c2page[(i__1 = rsize + 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c2page", i__1, "zzektr23_", (ftnlen)614)]); - i__2 = 63 - rsize; - cleari_(&i__2, &c2page[(i__1 = rsize + 128) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c2page", i__1, "zzektr23_", (ftnlen)615)]); - i__2 = 64 - (rsize + 1); - cleari_(&i__2, &c2page[(i__1 = rsize + 65) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c2page", i__1, "zzektr23_", (ftnlen)616)]); - -/* The second child is set. */ - -/* The last change we must make is to update the node count in */ -/* the root. */ - - if (*parent == root) { - ++ppage[1]; - } else { - -/* We won't read in the whole root page; we'll just get the */ -/* base address of the root and update the affected location. */ - - rbase = zzektrbs_(&root); - i__1 = rbase + 2; - i__2 = rbase + 2; - dasrdi_(handle, &i__1, &i__2, &nnode); - i__1 = rbase + 2; - i__2 = rbase + 2; - i__3 = nnode + 1; - dasudi_(handle, &i__1, &i__2, &i__3); - } - -/* Write out our updates. */ - - zzekpgwi_(handle, parent, ppage); - zzekpgwi_(handle, left, c1page); - zzekpgwi_(handle, right, c2page); - zzekpgwi_(handle, &new__, c3page); - return 0; -} /* zzektr23_ */ - diff --git a/ext/spice/src/cspice/zzektr31.c b/ext/spice/src/cspice/zzektr31.c deleted file mode 100644 index b9bbcd2cfb..0000000000 --- a/ext/spice/src/cspice/zzektr31.c +++ /dev/null @@ -1,712 +0,0 @@ -/* zzektr31.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__81 = 81; -static integer c__3 = 3; - -/* $Procedure ZZEKTR31 ( EK tree, 3-1 merge ) */ -/* Subroutine */ int zzektr31_(integer *handle, integer *tree) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer root; - extern /* Subroutine */ int zzekpgfr_(integer *, integer *, integer *), - zzekpgri_(integer *, integer *, integer *), zzekpgwi_(integer *, - integer *, integer *); - integer i__, child[2], delta; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer rpage[256]; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - integer c1page[256], c2page[256], middle; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer nlkeys, nrkeys; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer sum; - -/* $ Abstract */ - -/* Execute a 3-1 merge: move the contents of two children into */ -/* the root node and delete the children. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If there is not exactly 1 key in the root at the time this */ -/* routine is called, the error SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Deletions from an EK tree start at a leaf node. If the node */ -/* underflows, the EK system attempts to shuffle keys at the leaf */ -/* level to resolve the underflow. That attempt failing, the system */ -/* delegates the problem upward to the next higher level. Underflow */ -/* may occur there as well; if it does, the problem gets passed */ -/* upward again. If the root has only two children and one of these */ -/* underflows, the system reduces the height of the tree by */ -/* executing what's called a `3-1' merge: the root loses its two */ -/* children, and all of the keys in the children are moved into */ -/* the root. The former grandchildren of the root become */ -/* children of the root. */ - -/* A tree is eligible for a 3-1 merge only if the root has exactly */ -/* two children, and the sum of the key counts of the children */ -/* constitutes an underflow of 1 key: that is, the sum is */ - -/* 2*MNKEYC - 1 */ - -/* After the 3-1 merge, the tree is balanced and all invariants */ -/* relating to key counts are restored. */ - -/* The tree grows shorter by one level as a result of a 3-1 merge; */ -/* this is the only circumstance under which the tree grows shorter. */ - -/* Below are the gory details concerning the actions of this routine. */ -/* All of the parameters referred to here (in capital letters) are */ -/* defined in the include file ektree.inc. */ - -/* In a 3-1 merge: */ - - -/* - The keys of the left child are moved into the root. These */ -/* become the leftmost MNKEYC or MNKEYC-1 keys of the root, */ -/* depending on whether the underflow occurred in the left */ -/* child. */ - -/* - The data values associated with the keys of the left child */ -/* of the root are moved into the root along with the keys. */ - -/* - The left child pointers associated with the keys of the left */ -/* child of the root are moved into the root along with the */ -/* keys. */ - -/* - The last right child pointer in the left child of the root */ -/* the root is moved to location NLEFT+1 in the child pointer */ -/* array of the root, where NLEFT is the number of keys in */ -/* the former left child. This pointer overwrites the root's */ -/* pointer to the left child. */ - -/* - The keys of the right child are moved into the root. These */ -/* become the rightmost MNKEYC or MNKEYC-1 keys of the root, */ -/* depending on whether the underflow occurred in the right */ -/* child. */ - -/* - The data values associated with the keys of the right child */ -/* of the root are moved into the root along with the keys. */ - -/* - The left child pointers associated with the keys of the right */ -/* child of the root are moved into the root along with the */ -/* keys. The first of these pointers overwrites the root's */ -/* pointer to the right child. */ - -/* - The last right child pointer in the right child of the root */ -/* the root is moved to location 2*MNKEYC+1 in the child pointer */ -/* array of the root. */ - -/* - The former children of the root are deleted. */ - -/* As the above list shows, the root contains the maximum allowed */ -/* number of keys after a 3-1 merge. This is because */ - -/* MXKEYR = MXKIDR - 1 */ - -/* = 2 * ( (2*MXKIDC - 2)/3 ) */ - -/* = 2 * ( (2*MXKIDC + 1)/3 - 1 ) */ - -/* = 2 * ( MNKIDC - 1) */ - -/* = 2 * MNKEYC */ - -/* Our assumptions were that there was one key in the root and */ -/* that the sum of the key counts of the two children of the root */ -/* was */ - -/* ( 2 * MNKEYC ) - 1 */ - -/* Thus the size constraints on the root node are met. */ - -/* $ Examples */ - -/* See ZZEKTRDL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - root = *tree; - zzekpgri_(handle, &root, rpage); - nrkeys = rpage[4]; - -/* There must be exactly 1 key in the root. */ - - if (nrkeys != 1) { - chkin_("ZZEKTR31", (ftnlen)8); - setmsg_("Number of keys in root = #; should be 1.", (ftnlen)40); - errint_("#", &nrkeys, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR31", (ftnlen)8); - return 0; - } - -/* Read in the child pages. Get the key counts for these pages. */ - - child[0] = rpage[88]; - child[1] = rpage[89]; - zzekpgri_(handle, child, c1page); - zzekpgri_(handle, &child[1], c2page); - nlkeys = c1page[0]; - nrkeys = c2page[0]; - sum = nlkeys + nrkeys; - -/* The sum of the number of keys in the two input nodes must */ -/* sum exactly to value representing an underflow level of 1 key. */ - - if (sum != 81) { - chkin_("ZZEKTR31", (ftnlen)8); - setmsg_("Number of keys in nodes LEFT = #; in RIGHT = #; counts summ" - "ing to # were expected.", (ftnlen)82); - errint_("#", &nlkeys, (ftnlen)1); - errint_("#", &nrkeys, (ftnlen)1); - errint_("#", &c__81, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR31", (ftnlen)8); - return 0; - } - -/* Shift the key and data pointer in the root to right to allow */ -/* insertion of NLKEYS new entries on the left. The child pointers */ -/* need not be shifted; they'll be overwritten later. */ - - rpage[(i__1 = nlkeys + 5) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektr31_", (ftnlen)279)] = rpage[5]; - rpage[(i__1 = nlkeys + 172) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektr31_", (ftnlen)280)] = rpage[172]; - -/* Copy in the keys, data pointers, and child pointers from the */ -/* left child into the root. The number of predecessors of the */ -/* new keys is unchanged by this operation. */ - - movei_(&c1page[1], &nlkeys, &rpage[5]); - movei_(&c1page[128], &nlkeys, &rpage[172]); - i__1 = nlkeys + 1; - movei_(&c1page[64], &i__1, &rpage[88]); - -/* Copy in the keys, data pointers, and child pointers from the */ -/* right child into the root. The number of predecessors of the */ -/* new keys is increased by the value of the last key already */ -/* present. */ - - middle = nlkeys + 1; - delta = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektr31_", (ftnlen)298)]; - i__1 = nrkeys; - for (i__ = 1; i__ <= i__1; ++i__) { - rpage[(i__2 = middle + 5 + i__ - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("rpage", i__2, "zzektr31_", (ftnlen)301)] = c2page[( - i__3 = i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", i__3, - "zzektr31_", (ftnlen)301)] + delta; - } - movei_(&c2page[128], &nrkeys, &rpage[(i__1 = middle + 172) < 256 && 0 <= - i__1 ? i__1 : s_rnge("rpage", i__1, "zzektr31_", (ftnlen)304)]); - i__2 = nrkeys + 1; - movei_(&c2page[64], &i__2, &rpage[(i__1 = middle + 88) < 256 && 0 <= i__1 - ? i__1 : s_rnge("rpage", i__1, "zzektr31_", (ftnlen)305)]); - -/* Now the root must be updated. The root now contains */ -/* the maximum allowed number of keys. The depth of the tree */ -/* has decreased, as well as the number of nodes in the tree. */ - - rpage[4] = 82; - --rpage[3]; - rpage[1] += -2; - -/* Write out the updated root. */ - - zzekpgwi_(handle, &root, rpage); - -/* Free the pages occupied by the deleted children. */ - - for (i__ = 1; i__ <= 2; ++i__) { - zzekpgfr_(handle, &c__3, &child[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("child", i__1, "zzektr31_", (ftnlen)325)]); - } - return 0; -} /* zzektr31_ */ - diff --git a/ext/spice/src/cspice/zzektr32.c b/ext/spice/src/cspice/zzektr32.c deleted file mode 100644 index 3960b0b937..0000000000 --- a/ext/spice/src/cspice/zzektr32.c +++ /dev/null @@ -1,1116 +0,0 @@ -/* zzektr32.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__122 = 122; -static integer c__3 = 3; - -/* $Procedure ZZEKTR32 ( EK tree, 3-2 merge ) */ -/* Subroutine */ int zzektr32_(integer *handle, integer *tree, integer *left, - integer *middle, integer *right, integer *parent, integer *lpkidx, - logical *undrfl) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer lsib, msib, rsib, root; - extern /* Subroutine */ int zzekpgfr_(integer *, integer *, integer *), - zzekpgri_(integer *, integer *, integer *), zzekpgwi_(integer *, - integer *, integer *); - extern integer zzektrbs_(integer *); - integer i__, n, ppage[256], rbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nnode; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - integer lpkey, psize, rpkey, c1page[256], c2page[256], c3page[256], - datbas, kidbas; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - integer keybas, sizbas; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer leftsz, lmidsz, midsiz, nlkeys, nmkeys, npkeys, nrkeys, rmidsz, - rshift; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - integer sum; - -/* $ Abstract */ - -/* Execute a 3-2 merge: merge three neighboring sibling nodes, two */ -/* of which contain the minimum number of keys and one of which */ -/* has an underflow of one key, into two nodes, each one */ -/* approximately full. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* LEFT I Left sibling node. */ -/* MIDDLE I Middle sibling node. */ -/* RIGHT I Right sibling node. */ -/* PARENT I Common parent node. */ -/* LPKIDX I Node-relative index of left parent key of MIDDLE. */ -/* UNDRFL O Underflow flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* LEFT is the node number of the left node of a trio of */ -/* siblings. LEFT either contains the minimum */ -/* allowed number of keys or is underflowing by */ -/* one key. */ - -/* MIDDLE is the node number of the middle node of a trio of */ -/* siblings. MIDDLE either contains the minimum */ -/* allowed number of keys or is underflowing by */ -/* one key. */ - -/* RIGHT is the node number of the right node of a trio of */ -/* siblings. The total number of keys in nodes */ -/* LEFT, MIDDLE and RIGHT amounts to an underflow of 1 */ -/* key. */ - -/* PARENT is the node number of the common parent of LEFT */ -/* and RIGHT. */ - -/* LPKIDX is the node-relative index within PARENT of the */ -/* left parent key of MIDDLE. This key is the */ -/* immediate predecessor of the first key in the */ -/* subtree headed by MIDDLE. */ - -/* $ Detailed_Output */ - -/* UNDRFL is a logical flag indicating whether the parent */ -/* node underflowed as a result of the 3-2 merge. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If LEFT and RIGHT are not neighboring siblings, the error */ -/* SPICE(BUG) is signalled. */ - -/* 4) If either LEFT or RIGHT are not children of PARENT, the error */ -/* SPICE(BUG) is signalled. */ - -/* 5) If the sum of the number of keys in LEFT and RIGHT does not */ -/* correspond to an underflow of exactly 1 key, the error */ -/* SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Deletions from an EK tree start at a leaf node. If the node */ -/* underflows, the EK system attempts to shuffle keys at the leaf */ -/* level to resolve the underflow. That attempt failing, the system */ -/* delegates the problem upward to the next higher level. */ - -/* There are two ways to resolve underflow in a non-root node: */ -/* balance the underflowing node with one of its closest siblings */ -/* (see ZZEKTRBN), or if the closest siblings contain the minimum */ -/* number of keys, execute a 3-2 merge. */ - -/* A 3-2 merge involves deletion of the middle node of a trio of */ -/* neighboring siblings, two of which contain the minimum */ -/* number of keys and one of which has an underflow of one key, */ -/* and redistributing the keys between the two remaining nodes */ -/* and their common parent so that each of the two remaining siblings */ -/* contains the maximum number of keys. The parent loses a key in */ -/* the process. */ - -/* After the 3-2 merge, the tree is balanced and the siblings */ -/* satisfy the key count invariants. However, the parent of the */ -/* siblings may underflow by one key. */ - -/* Below are the gory details concerning the actions of this routine. */ -/* All of the parameters referred to here (in capital letters) are */ -/* defined in the include file ektree.inc. */ - -/* In a 3-2 merge: */ - -/* - The left parent key of the middle child is rotated down */ -/* into the left child and is appended on the right to the key */ -/* set of that child. The left parent key's data pointer moves */ -/* along with the key. The child pointers of this parent key */ -/* do not move along with the key; these pointers point to the */ -/* left and middle child nodes. */ - -/* - The keys of the middle child are divided into three sets: */ -/* a set to be rotated left through the parent node into the */ -/* left child, a singleton set consisting of a key to be moved */ -/* up into the parent, and a set of keys to be rotated right */ -/* through the parent into the right child. The sizes of the */ -/* leftmost and rightmost of these sets differ by at most 1. */ - -/* - The number of keys that are rotated left is picked so that */ -/* after the rotation, the size of the left node will be */ -/* (3*MNKEYC)/2. The data pointers of these keys move along */ -/* with the keys. All of the left and right child pointers */ -/* of these keys move along with the keys into the left child. */ - -/* - The singleton key in the child moves up into the parent */ -/* node. Its data pointer moves with it. After the move into */ -/* the parent node, the left child pointer of this key points */ -/* to the left child; the right child pointer points to the */ -/* right child. */ - -/* - The right parent key of the middle child is rotated right */ -/* into the right child. The data pointer of this key moves */ -/* with the key. The child pointers of this parent key */ -/* do not move along with the key; these pointers point to the */ -/* middle and right child nodes. */ - -/* - The remaining keys in the middle child are rotated right */ -/* into the right child; these become the leftmost keys of */ -/* that child. The data pointers of these keys move along */ -/* with them. The child pointers of these keys also move */ -/* along with them. */ - -/* - The right child ends up with */ - -/* (3*MNKEYC) - (3*MNKEYC)/2 */ - -/* keys. This may be deduced from the facts that the original */ -/* three children had between them an underflow of one key, the */ -/* parent lost a key, and the left child has (3*MNKEYC)/2 keys. */ - -/* Since */ - -/* MNKEYC = MNKIDC - 1 */ -/* = ( ( 2*MXKIDC + 1 ) / 3 ) - 1 */ -/* = ( 2*MXKIDC - 2 ) / 3 */ -/* = ( 2*MXKEYC ) / 3 */ - -/* we have */ - -/* 3*MNKEYC < 2*MXKEYC */ -/* - */ - -/* If 3*MNKEYC is odd, we have strict inequality and also */ - - -/* 3*MNKEYC = 2 * ( (3*MNKEYC)/2 ) + 1 */ - -/* so */ - -/* 3*MNKEYC + 1 = 2 * ( (3*MNKEYC)/2 ) + 2 */ - -/* = 2 * ( (3*MNKEYC)/2 + 1 ) */ - -/* < 2 * MXKEYC */ -/* - */ - -/* So in this case, the larger of the child nodes, which has */ -/* size */ - -/* (3*MNKEYC)/2 + 1 */ - -/* has a key count no greater than MXKEYC. */ - -/* If 3*MNKEYC is even, then the left and right child are the */ -/* same size, and the inequality */ - -/* 3*MNKEYC < 2*MXKEYC */ -/* - */ - -/* implies directly that both nodes have size no greater than */ -/* MXKEYC. */ - -/* Since both child nodes have size approximately 3/2 * MNKEYC, */ -/* and since MNKEYC is approximately 40, the minimum size */ -/* constraints on the child nodes are easily met. */ - - -/* As the above description shows, the parent loses a key as a */ -/* result of a 3-2 merge. This may cause the parent to underflow; */ -/* if it does, the underflow at the parent's level must be resolved. */ - -/* $ Examples */ - -/* See ZZEKTRDL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 16-NOV-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - -/* The plan is to take three sibling nodes, two of which contain */ -/* the minimum number of keys and one of which is underflowing by one */ -/* key, and to merge these nodes into two nodes. This process */ -/* reduces the number of nodes in the parent by one and may cause the */ -/* parent to underflow. */ - -/* After the merge, the sum of the numbers of keys in the two */ -/* children will be exactly (3*MNKEYC). The numbers of keys in the */ -/* left and right nodes will be, respectively: */ - - -/* LSIZE = INT ( (3*MNKEYC)/2 ) */ -/* RSIZE = (3*MNKEYC) - LSIZE */ - -/* We need to be sure that LSIZE and RSIZE are in the range */ - -/* MNKEYC : MXKEYC */ - - -/* The definition of LSIZE implies that */ - -/* LSIZE = MNKEYC + INT ( MNKEYC/2 ) */ - - -/* so */ - -/* MNKEYC + INT ( MNKEYC/2 ) < LSIZE < (3/2)*MNKEYC */ -/* - - */ - -/* and since */ - -/* MNKEYC = MNKIDC - 1 */ -/* = INT ( ( 2*MXKIDC + 1 ) / 3 ) - 1 */ -/* = INT ( ( 2*MXKEYC + 3 ) / 3 ) - 1 */ -/* = INT ( ( 2*MXKEYC ) / 3 ) */ - -/* we have */ - -/* (3/2) * MNKEYC = (3/2) * INT ( (2*MXKEYC) / 3 ) < MXKEYC */ -/* - */ - -/* Thus LSIZE is guaranteed to be in range. */ - -/* When MNKEYC is even, RSIZE is equal to LSIZE and thus is */ -/* within bounds. When MNKEYC is odd, RSIZE exceeds LSIZE by 1, so */ - -/* MNKEYC < RSIZE */ - - -/* It remains to be shown that */ - -/* RSIZE < MXKEYC */ -/* - */ - -/* when MNKEYC is odd. When this is the case, the quantity */ - -/* (3/2) * MNKEYC */ - -/* is not an integer and therefore is strictly less than MXKEYC. */ -/* This quantity is also greater than LSIZE, so we conclude that */ - -/* LSIZE < MXKEYC - 1 */ -/* - */ - -/* Since RSIZE exceeds LSIZE by 1, we have */ - -/* RSIZE < MXKEYC */ -/* - */ - -/* as we claimed. */ - - -/* All right, read in the child and parent pages. */ - - zzekpgri_(handle, left, c1page); - zzekpgri_(handle, middle, c2page); - zzekpgri_(handle, right, c3page); - zzekpgri_(handle, parent, ppage); - -/* The actual addresses in the parent node depend on whether the */ -/* parent is the root. Compute the necessary bases to avoid a lot */ -/* of cases. */ - - root = *tree; - if (*parent == root) { - keybas = 5; - datbas = 172; - kidbas = 88; - sizbas = 5; - } else { - keybas = 1; - datbas = 128; - kidbas = 64; - sizbas = 1; - } - -/* Check the left parent key of the middle child. */ - - psize = ppage[(i__1 = sizbas - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr32_", (ftnlen)439)]; - if (*lpkidx < 1 || *lpkidx > psize - 1) { - chkin_("ZZEKTR32", (ftnlen)8); - setmsg_("Left parent key of MIDDLE is out of range. Value is #; val" - "id range is 1:#", (ftnlen)74); - errint_("#", lpkidx, (ftnlen)1); - i__1 = psize - 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR32", (ftnlen)8); - return 0; - } - -/* Retain the left and right parent key values of the middle child. */ - - lpkey = ppage[(i__1 = keybas + *lpkidx - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("ppage", i__1, "zzektr32_", (ftnlen)457)]; - rpkey = ppage[(i__1 = keybas + *lpkidx) < 256 && 0 <= i__1 ? i__1 : - s_rnge("ppage", i__1, "zzektr32_", (ftnlen)458)]; - -/* Verify that LEFT, MIDDLE, and RIGHT are siblings, and that PARENT */ -/* is their common parent. */ - - lsib = ppage[(i__1 = kidbas + *lpkidx - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("ppage", i__1, "zzektr32_", (ftnlen)464)]; - msib = ppage[(i__1 = kidbas + *lpkidx) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr32_", (ftnlen)465)]; - rsib = ppage[(i__1 = kidbas + *lpkidx + 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("ppage", i__1, "zzektr32_", (ftnlen)466)]; - if (lsib != *left || msib != *middle || rsib != *right) { - chkin_("ZZEKTR32", (ftnlen)8); - setmsg_("LEFT, RIGHT, MIDDLE, PARENT, and PKIDX are inconsistent. LE" - "FT = #; MIDDLE = #; RIGHT = #; PARENT = #; LPKIDX = #; LSIB " - "derived from PARENT = #; MSIB = #; RSIB = #.", (ftnlen)163); - errint_("#", left, (ftnlen)1); - errint_("#", middle, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", parent, (ftnlen)1); - errint_("#", lpkidx, (ftnlen)1); - errint_("#", &lsib, (ftnlen)1); - errint_("#", &msib, (ftnlen)1); - errint_("#", &rsib, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR32", (ftnlen)8); - return 0; - } - -/* Get the number of keys in the parent. */ - - if (*parent == root) { - npkeys = ppage[4]; - } else { - npkeys = ppage[0]; - } - -/* Get the number of keys in each child. */ - - nlkeys = c1page[0]; - nmkeys = c2page[0]; - nrkeys = c3page[0]; - sum = nlkeys + nmkeys + nrkeys; - -/* The sum of the number of keys in the three input nodes must */ -/* sum exactly to value representing an underflow level of 1 key. */ - - if (sum != 122) { - chkin_("ZZEKTR32", (ftnlen)8); - setmsg_("Number of keys in nodes LEFT = #; in MIDDLE = #; in RIGHT =" - " #; counts summing to # were expected.", (ftnlen)97); - errint_("#", &nlkeys, (ftnlen)1); - errint_("#", &nmkeys, (ftnlen)1); - errint_("#", &nrkeys, (ftnlen)1); - errint_("#", &c__122, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTR32", (ftnlen)8); - return 0; - } - -/* We're set to carry out the merge. Here's an overview of what */ -/* gets moved where. */ - -/* The left parent key of the middle node moves into the left */ -/* node, at the end of the node. */ - -/* The first N-1 keys and N child pointers of the middle node get */ -/* moved into the left node, where */ - -/* N = LSIZE - ( 1 + NLKEYS ) + 1 */ - -/* The Nth key of the middle node moves into the parent, */ -/* replacing the left parent key of the middle node. */ - -/* The right parent key of the middle node moves into the right */ -/* node, at the beginning of the node. */ - -/* The keys from position N+1 onward in the middle node, as */ -/* well as all of the remaining child pointers, move into the */ -/* right node, at the beginning. */ - -/* The right parent key's location is filled in by shifting */ -/* the keys, data pointers, and child pointers in the parent */ -/* to the left by one position. The child pointer removed by this */ -/* operation is the pointer to the middle child. */ - -/* The middle child node disappears. */ - -/* Before re-arranging things, we'll need to have on hand the key */ -/* counts for various sets of keys. We'll use the variable LEFTSZ */ -/* for the number of keys in the subtree headed by LEFT. We'll */ -/* use the variable LMIDSZ to refer to the `subtree' headed by */ -/* the set of keys in the middle node that will be shifted into */ -/* the left child. The variable RMSIZE will represent the size of */ -/* the key set moved from the middle child into the right child. */ -/* MIDSIZ will be the key count for the subtree headed by the middle */ -/* child. */ - -/* Consistent with usage above, the variable N will represent */ -/* the index of the key in the middle node that will rapturously */ -/* ascend into the parent. */ - - if (*lpkidx == 1) { - leftsz = lpkey - 1; - } else { - leftsz = lpkey - ppage[(i__1 = keybas + *lpkidx - 2) < 256 && 0 <= - i__1 ? i__1 : s_rnge("ppage", i__1, "zzektr32_", (ftnlen)577)] - - 1; - } - n = 61 - (nlkeys + 1) + 1; - lmidsz = c2page[(i__1 = n) < 256 && 0 <= i__1 ? i__1 : s_rnge("c2page", - i__1, "zzektr32_", (ftnlen)582)] - 1; - midsiz = rpkey - lpkey - 1; - rmidsz = midsiz - lmidsz - 1; - -/* Move the left parent key into the left child. The key itself */ -/* doesn't really move; its value is simply re-assigned. The */ -/* data pointer is copied, however. The child pointer at location */ -/* LSIZE+1 is unaffected by this move. */ - - c1page[(i__1 = nlkeys + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("c1page", - i__1, "zzektr32_", (ftnlen)592)] = leftsz + 1; - c1page[(i__1 = nlkeys + 128) < 256 && 0 <= i__1 ? i__1 : s_rnge("c1page", - i__1, "zzektr32_", (ftnlen)593)] = ppage[(i__2 = datbas + *lpkidx - - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage", i__2, "zzektr32_" - , (ftnlen)593)]; - -/* Move the first N-1 keys and data pointers, and the first N */ -/* child pointers, from the middle child into the left */ -/* child. The moved keys will gain LEFTSZ + 1 predecessors. */ - - i__1 = n - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - c1page[(i__2 = nlkeys + 2 + i__ - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("c1page", i__2, "zzektr32_", (ftnlen)601)] = c2page[( - i__3 = i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", i__3, - "zzektr32_", (ftnlen)601)] + leftsz + 1; - } - i__2 = n - 1; - movei_(&c2page[128], &i__2, &c1page[(i__1 = nlkeys + 129) < 256 && 0 <= - i__1 ? i__1 : s_rnge("c1page", i__1, "zzektr32_", (ftnlen)604)]); - movei_(&c2page[64], &n, &c1page[(i__1 = nlkeys + 65) < 256 && 0 <= i__1 ? - i__1 : s_rnge("c1page", i__1, "zzektr32_", (ftnlen)605)]); - -/* Set the key count in the left child. */ - - c1page[0] = 61; - -/* The left child is complete. Now it's time to set up the right */ -/* child. First off, we'll shift the node's contents to the right */ -/* by the number of new keys we're going to insert. Shift the */ -/* rightmost elements first. The shifted keys will gain RMIDSZ+1 */ -/* predecessors, so we adjust the keys as we shift them. */ - - rshift = nmkeys - n + 1; - for (i__ = nrkeys; i__ >= 1; --i__) { - c3page[(i__1 = rshift + 1 + i__ - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c3page", i__1, "zzektr32_", (ftnlen)622)] = c3page[( - i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("c3page", i__2, - "zzektr32_", (ftnlen)622)] + rmidsz + 1; - } - for (i__ = nrkeys; i__ >= 1; --i__) { - c3page[(i__1 = rshift + 128 + i__ - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c3page", i__1, "zzektr32_", (ftnlen)626)] = c3page[( - i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("c3page", - i__2, "zzektr32_", (ftnlen)626)]; - } - for (i__ = nrkeys + 1; i__ >= 1; --i__) { - c3page[(i__1 = rshift + 64 + i__ - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("c3page", i__1, "zzektr32_", (ftnlen)630)] = c3page[( - i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge("c3page", - i__2, "zzektr32_", (ftnlen)630)]; - } - -/* The key at location RSHIFT receives the former right parent key */ -/* of the middle child. The key value is simply assigned; the */ -/* data pointer is copied. The child pointer at location RSHIFT */ -/* will be set later. */ - - c3page[(i__1 = rshift) < 256 && 0 <= i__1 ? i__1 : s_rnge("c3page", i__1, - "zzektr32_", (ftnlen)639)] = rmidsz + 1; - c3page[(i__1 = rshift + 127) < 256 && 0 <= i__1 ? i__1 : s_rnge("c3page", - i__1, "zzektr32_", (ftnlen)640)] = ppage[(i__2 = datbas + *lpkidx) - < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage", i__2, "zzektr32_", ( - ftnlen)640)]; - -/* The first RSHIFT-1 locations in the right child are filled in */ -/* with data from the middle child. The moved keys lose LMIDSZ+1 */ -/* precedessors. */ - - i__1 = rshift - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - c3page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("c3page", i__2, - "zzektr32_", (ftnlen)648)] = c2page[(i__3 = n + 1 + i__ - 1) - < 256 && 0 <= i__3 ? i__3 : s_rnge("c2page", i__3, "zzektr32_" - , (ftnlen)648)] - lmidsz - 1; - } - i__2 = rshift - 1; - movei_(&c2page[(i__1 = n + 128) < 256 && 0 <= i__1 ? i__1 : s_rnge("c2pa" - "ge", i__1, "zzektr32_", (ftnlen)651)], &i__2, &c3page[128]); - movei_(&c2page[(i__1 = n + 64) < 256 && 0 <= i__1 ? i__1 : s_rnge("c2page" - , i__1, "zzektr32_", (ftnlen)652)], &rshift, &c3page[64]); - -/* Update the key count in the right child. */ - - c3page[0] = 62; - -/* The right child is complete. It's time to update the parent. */ - -/* The key at location N in the middle child replaces the left parent */ -/* key. The key value is actually re-assigned; the data pointer does */ -/* move. The left parent key increases by the number of keys moved */ -/* into the subtree headed by the left child. */ - - ppage[(i__1 = keybas + *lpkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr32_", (ftnlen)667)] = lpkey + lmidsz + 1; - ppage[(i__1 = datbas + *lpkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr32_", (ftnlen)668)] = c2page[(i__2 = n + - 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("c2page", i__2, "zzektr3" - "2_", (ftnlen)668)]; - -/* The parent keys, data pointers, and child pointers at locations */ -/* LPKIDX+2 onward get shifted left by one position. The keys lose */ -/* no predecessors as the result of these re-arrangements. */ - - i__1 = npkeys - 1; - for (i__ = *lpkidx + 1; i__ <= i__1; ++i__) { - ppage[(i__2 = keybas + i__ - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "ppage", i__2, "zzektr32_", (ftnlen)676)] = ppage[(i__3 = - keybas + i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("ppage", - i__3, "zzektr32_", (ftnlen)676)]; - } - i__1 = npkeys - 1; - for (i__ = *lpkidx + 1; i__ <= i__1; ++i__) { - ppage[(i__2 = datbas + i__ - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "ppage", i__2, "zzektr32_", (ftnlen)680)] = ppage[(i__3 = - datbas + i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("ppage", - i__3, "zzektr32_", (ftnlen)680)]; - } - i__1 = npkeys; - for (i__ = *lpkidx + 1; i__ <= i__1; ++i__) { - ppage[(i__2 = kidbas + i__ - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "ppage", i__2, "zzektr32_", (ftnlen)684)] = ppage[(i__3 = - kidbas + i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("ppage", - i__3, "zzektr32_", (ftnlen)684)]; - } - -/* Zero out the freed locations. */ - - ppage[(i__1 = keybas + npkeys - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr32_", (ftnlen)690)] = 0; - ppage[(i__1 = datbas + npkeys - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektr32_", (ftnlen)691)] = 0; - ppage[(i__1 = kidbas + npkeys) < 256 && 0 <= i__1 ? i__1 : s_rnge("ppage", - i__1, "zzektr32_", (ftnlen)692)] = 0; - -/* The only required change to the parent's metadata is */ -/* updating the key count. At this point, we can set the */ -/* underflow flag, depending on the status of the parent. */ - - if (*parent == root) { - --ppage[4]; - *undrfl = ppage[4] == 0; - } else { - --ppage[0]; - *undrfl = ppage[0] == 40; - } - -/* The last change we must make is to update the node count in */ -/* the root. */ - - if (*parent == root) { - --ppage[1]; - } else { - -/* We won't read in the whole root page; we'll just get the */ -/* base address of the root and update the affected location. */ - - rbase = zzektrbs_(&root); - i__1 = rbase + 2; - i__2 = rbase + 2; - dasrdi_(handle, &i__1, &i__2, &nnode); - i__1 = rbase + 2; - i__2 = rbase + 2; - i__3 = nnode - 1; - dasudi_(handle, &i__1, &i__2, &i__3); - } - -/* Write out our updates. */ - - zzekpgwi_(handle, parent, ppage); - zzekpgwi_(handle, left, c1page); - zzekpgwi_(handle, right, c3page); - -/* Free the page used by the middle child. */ - - zzekpgfr_(handle, &c__3, middle); - return 0; -} /* zzektr32_ */ - diff --git a/ext/spice/src/cspice/zzektrap.c b/ext/spice/src/cspice/zzektrap.c deleted file mode 100644 index 6a7db9cef1..0000000000 --- a/ext/spice/src/cspice/zzektrap.c +++ /dev/null @@ -1,150 +0,0 @@ -/* zzektrap.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRAP ( EK tree, append item ) */ -/* Subroutine */ int zzektrap_(integer *handle, integer *tree, integer *value, - integer *key) -{ - extern /* Subroutine */ int zzektrin_(integer *, integer *, integer *, - integer *); - extern integer zzektrsz_(integer *, integer *); - -/* $ Abstract */ - -/* Append an item to a tree. The key indicating the location of */ -/* the new item is returned. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* VALUE I Value to append. */ -/* KEY O Key pointing to new value. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* VALUE is an integer value to be appended to the */ -/* specified tree. */ - -/* $ Detailed_Output */ - -/* KEY is an absolute key indicating the insertion */ -/* location. In EK trees, absolute keys are just */ -/* ordinal positions relative to the leftmost element */ -/* of the tree, with the leftmost element having */ -/* position 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine appends a new value to an EK tree; this action is */ -/* equivalent to inserting the value at position (NKEYS+1), where */ -/* NKEYS is the number of keys in the tree prior to the insertion. */ - -/* The tree is balanced and satisfies all invariants at the */ -/* completion of the appending. */ - -/* $ Examples */ - -/* See EKBSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.2, 22-SEP-2004 (EDW) */ - -/* Edited 1.0.1 Version entry to not include */ -/* the token used to mark the $Procedure section. */ - -/* - Beta Version 1.0.1, 14-OCT-1996 (NJB) */ - -/* $Procedure line was corrected. */ - -/* - Beta Version 1.0.0, 22-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - *key = zzektrsz_(handle, tree) + 1; - zzektrin_(handle, tree, key, value); - return 0; -} /* zzektrap_ */ - diff --git a/ext/spice/src/cspice/zzektrbn.c b/ext/spice/src/cspice/zzektrbn.c deleted file mode 100644 index 19e518e322..0000000000 --- a/ext/spice/src/cspice/zzektrbn.c +++ /dev/null @@ -1,467 +0,0 @@ -/* zzektrbn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__82 = 82; -static integer c__124 = 124; - -/* $Procedure ZZEKTRBN ( EK tree, balance nodes ) */ -/* Subroutine */ int zzektrbn_(integer *handle, integer *tree, integer *left, - integer *right, integer *parent, integer *pkidx) -{ - integer root; - extern integer zzektrnk_(integer *, integer *, integer *); - extern /* Subroutine */ int zzektrrk_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *), chkin_(char *, - ftnlen); - integer schlep; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer lnkeys; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer rnkeys, sum; - -/* $ Abstract */ - -/* Solve overflow in a node by balancing the node */ -/* with one of its sibling nodes. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* LEFT I Left node of pair to be balanced. */ -/* RIGHT I Right node of pair to be balanced. */ -/* PARENT I Parent node of pair to be balanced. */ -/* PKIDX I Parent key index. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* LEFT, */ -/* RIGHT are the node numbers of a pair of nodes to */ -/* be balanced. LEFT and RIGHT must be neighboring */ -/* subnodes of a common parent. */ - -/* PARENT is the node number of the common parent node of */ -/* nodes LEFT, RIGHT. */ - -/* PKIDX is the `parent key index', that is, the */ -/* node-relative index of the key in the parent that */ -/* sits between PARENT's child node pointers to */ -/* nodes LEFT and RIGHT. The key at location PKIDX */ -/* is the immediate successor of the greatest key in */ -/* the subnode headed by LEFT. It is the immediate */ -/* predecessor of the least key in the subnode headed */ -/* by RIGHT. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If either LEFT or RIGHT are actually the root, the error */ -/* SPICE(BUG) is signalled. */ - -/* 4) If LEFT and RIGHT are not neighboring sibling nodes, the */ -/* error will be diagnosed by routines called by this routine. */ - - -/* 5) The sum of the key counts in LEFT and RIGHT must be between */ -/* 2*MNKEYC and 2*MXKEYC; otherwise the key count invariants */ -/* cannot be satisfied by balancing. If the sum fails to meet */ -/* this condition, the error SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Insertions into and deletions from EK trees can result in */ -/* overflows or underflows of keys in nodes affected by these */ -/* operations. Many times key count invariants can be restored by */ -/* moving keys from one node into an adjacent sibling node. This */ -/* maneuver is called `balancing' the nodes. After balancing, the */ -/* key counts of the affected nodes differ by at most 1. */ - -/* The balancing process also affects the parent node of the */ -/* neighboring children because one key of the parent sits between */ -/* the children. This `parent key' gets moved into one of the */ -/* children as keys are shifted. If the shift is to the right, the */ -/* parent key is the largest key of the shifted set; if the shift */ -/* is to the left, the parent key is the least of the shifted set. */ - -/* When keys are shifted, their data values move along with them. */ -/* In general, child pointers move along with keys, but there are */ -/* some tricky points: */ - -/* - The left and right child pointers of the parent key don't */ -/* get updated; they continue to point to the two children */ -/* LEFT and RIGHT. */ - -/* - On a right shift, the right child pointer of the key that */ -/* gets moved into the parent key's original position becomes */ -/* the first left child pointer of the right sibling. The left */ -/* child pointer of this key doesn't get moved at all. */ - -/* - On a left shift, the left child pointer of the key that */ -/* gets moved into the parent key's original position becomes */ -/* the last right child pointer of the left sibling. The right */ -/* child pointer of this key becomes the left child pointer of */ -/* the first key of RIGHT. */ - -/* $ Examples */ - -/* See ZZEKTRIN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - root = *tree; - if (*left == root || *right == root) { - chkin_("ZZEKTRBN", (ftnlen)8); - setmsg_("Input node is root; only children can be balanced.", (ftnlen) - 50); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRBN", (ftnlen)8); - } - -/* Get the key counts for the left and right nodes. */ - - lnkeys = zzektrnk_(handle, tree, left); - rnkeys = zzektrnk_(handle, tree, right); - -/* Balancing the nodes should give each of them a key count in */ -/* the range of */ - -/* MNKEYC : MXKEYC */ - -/* If that's not possible, we have a serious problem. */ - - sum = lnkeys + rnkeys; - if (sum > 124 || sum < 82) { - chkin_("ZZEKTRBN", (ftnlen)8); - setmsg_("Node # and right sibling # contain # and # keys respectivel" - "y; count sum should be in range #:#.", (ftnlen)95); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", &lnkeys, (ftnlen)1); - errint_("#", &rnkeys, (ftnlen)1); - errint_("#", &c__82, (ftnlen)1); - errint_("#", &c__124, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRBN", (ftnlen)8); - return 0; - } - -/* Now, the actions we take depend on whether we must schlep keys */ -/* to the right or left. */ - - if (lnkeys > rnkeys) { - schlep = lnkeys - (sum + 1) / 2; - } else if (lnkeys < rnkeys) { - schlep = -(rnkeys - (sum + 1) / 2); - } else { - schlep = 0; - } - -/* Rotate the requested number of keys. */ - - zzektrrk_(handle, tree, left, right, parent, pkidx, &schlep); - return 0; -} /* zzektrbn_ */ - diff --git a/ext/spice/src/cspice/zzektrbs.c b/ext/spice/src/cspice/zzektrbs.c deleted file mode 100644 index d2d7a1c975..0000000000 --- a/ext/spice/src/cspice/zzektrbs.c +++ /dev/null @@ -1,186 +0,0 @@ -/* zzektrbs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure ZZEKTRBS ( EK tree, base address ) */ -integer zzektrbs_(integer *node) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Map a node in a tree to its DAS base integer address. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NODE I Node number. */ - -/* The function returns the DAS integer base address of the */ -/* specified node. */ - -/* $ Detailed_Input */ - -/* NODE is the number of a node in an EK tree. */ - -/* $ Detailed_Output */ - -/* The function returns the DAS integer base address of the */ -/* specified node. This address is the predecessor of the first */ -/* DAS integer word occupied by the node. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) No error checking is done on the input node number. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility that allows callers to locate a node */ -/* of a tree in the DAS integer address space. Most commonly, this */ -/* routine is used to locate the root of a tree. */ - -/* $ Examples */ - -/* See EKNSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* Just use the mapping supplied by the paging system. */ - - zzekpgbs_(&c__3, node, &ret_val); - return ret_val; -} /* zzektrbs_ */ - diff --git a/ext/spice/src/cspice/zzektrdl.c b/ext/spice/src/cspice/zzektrdl.c deleted file mode 100644 index 6ca7cc3562..0000000000 --- a/ext/spice/src/cspice/zzektrdl.c +++ /dev/null @@ -1,855 +0,0 @@ -/* zzektrdl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c_n1 = -1; - -/* $Procedure ZZEKTRDL ( EK tree, delete value ) */ -/* Subroutine */ int zzektrdl_(integer *handle, integer *tree, integer *key) -{ - integer node, lsib, left, rsib, lkey, pkey, rkey, root; - extern /* Subroutine */ int zzektrbn_(integer *, integer *, integer *, - integer *, integer *, integer *), zzektrki_(integer *, integer *, - integer *, integer *, integer *), zzektrsb_(integer *, integer *, - integer *, integer *, integer *, integer *, integer *), zzektrlk_( - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *); - extern integer zzektrnk_(integer *, integer *, integer *); - extern /* Subroutine */ int zzektrud_(integer *, integer *, integer *, - integer *, logical *), zzektrpi_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *), zzektrrk_(integer *, integer *, - integer *, integer *, integer *, integer *, integer *); - integer lnode, mnode, level, llsib, rnode, lrsib, right, rlsib, llkey, - lnkey, lpidx, lpkey, rrsib, lrkey, rlkey, rpidx, nkeys, rpkey, - state, rrkey, trust; - extern logical failed_(void); - integer parent; - logical undrfl; - integer noffst, poffst, trgkey, idx, ptr; - extern /* Subroutine */ int zzektr31_(integer *, integer *), zzektr32_( - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, logical *); - -/* $ Abstract */ - -/* Delete a value from an EK tree at a specified location. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key at which to delete value. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is an absolute key indicating the deletion */ -/* location. In EK trees, absolute keys are just */ -/* ordinal positions relative to the leftmost element */ -/* of the tree, with the leftmost element having */ -/* position 1. So setting KEY to 10, for example, */ -/* indicates that the input VALUE is the 10th item in */ -/* the tree. */ - -/* KEY must be in the range 1 : NKEYS, where */ -/* NKEYS is the number of keys in the tree prior to */ -/* the deletion. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is out of range, the error is diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine deletes a value from an EK tree at a specified */ -/* location. The successor of the value and all higher-indexed */ -/* values have their indexes decremented. Since keys are stored in */ -/* subtree-relative form, the only keys actually modified by the */ -/* deletion itself are higher-indexed keys in the node from which */ -/* the deletion is done, and higher-indexed keys in the chain of */ -/* ancestors of this node. */ - -/* The deletion is always done from a leaf node. If KEY is not in a */ -/* leaf node, the value corresponding to KEY is swapped with that of */ -/* an immediate neighbor, and the neighbor is deleted. This is */ -/* possible because every key is either in a leaf or has the property */ -/* that its predecessor and successor are both located in leaf nodes. */ - -/* The deletion is not the end of the story, however: it's possible */ -/* that the node from which the deletion is done (the `target node') */ -/* will underflow. If underflow occurs, this routine will restore */ -/* the tree to its normal form as follows: */ - -/* 1) If a neighbor of the target node contains at least one more */ -/* key than the minimum allowed number, data will be `rotated' */ -/* from the neighbor node, through the target's parent, */ -/* and into the target. The deletion is complete at this */ -/* point. */ - -/* 2) If the target node has only one neighbor, but that neighbor */ -/* is neighbor to a sibling that can contribute a key, data */ -/* will be rotated from the second sibling, through the */ -/* siblings' parent, into the first sibling, and then from */ -/* the first sibling through the target's parent, and into */ -/* the target. The deletion is complete at this point. */ - -/* 3) If the target is not a child of the root, and if */ -/* the target has two neighbors, but neither neighbor has a */ -/* key to spare, then the target node and its neighbors will */ -/* be merged into two nodes: this is called a `3-2 merge'. */ -/* The parent node is modified appropriately so that all */ -/* values are in the proper order and all subtree-relative */ -/* keys are correct. This `3-2 merge' decreases the number */ -/* of values in the parent by one. If the decrease does not */ -/* cause an underflow in the parent, the deletion is complete. */ - -/* If the target has only one neighbor, and both the neighbor */ -/* and the neighbor's other neighbor (which always exists) */ -/* contain the minimum number of keys, these three nodes are */ -/* combined into two via a 3-2 merge. */ - -/* 4) If the parent underflows as a result of a 3-2 merge, the */ -/* solution process is repeated at the parent's level. The */ -/* process iterates until the underflow is resolved or a */ -/* child of the root underflows. */ - -/* 5) If a child of the root underflows, the problem is solved */ -/* by balancing keys with a neighbor if possible. Balancing */ -/* cannot be done only if the root has only two children, and */ -/* these contain the minimum number of keys. In this case, */ -/* the contents of the two children of the root are moved */ -/* into the root and the children are eliminated. The */ -/* children of the child nodes become children of the root. */ -/* This is the only case in which the tree grows shorter. */ - -/* The process of collapsing two child nodes into the root is */ -/* called a `3-1 merge'. After a 3-1 merge is performed, the */ -/* number of values in each node is within bounds. */ - - -/* An EK tree is always balanced after a deletion: all leaf nodes */ -/* are at the same level. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - -/* Set the variable ROOT, so we'll have something mnemonic to go */ -/* by when referring to the root node. */ - - root = *tree; - -/* Work with a local copy of the input key. */ - - lkey = *key; - -/* The first step is to delete the key from the tree without */ -/* balancing. This step may cause a node to underflow. We'll */ -/* handle the underflow later. */ - - zzektrud_(handle, tree, &lkey, &trgkey, &undrfl); - if (failed_()) { - return 0; - } - -/* If the deletion didn't result in an underflow, we're done. */ - - if (! undrfl) { - return 0; - } - -/* Handle node underflows, as required. We describe our approach */ -/* below. If any step fails, we try the next step. We proceed */ -/* until we succeed in resolving the underflow. */ - -/* 1) If an immediate sibling can contribute a key, balance NODE */ -/* with that sibling. */ - -/* 2) If both left and right siblings exist, but neither can */ -/* contribute a key, execute a 3-2 merge. */ - -/* 3) If the left sibling has its own left sibling, and if that */ -/* second left sibling can contribute a key, rotate a key */ -/* from that sibling into NODE's left sibling. Then execute */ -/* (1). */ - -/* 4) If the left sibling has its own left sibling, and if that */ -/* second left sibling cannot contribute a key, execute a 3-2 */ -/* merge using NODE as the rightmost child. */ - -/* 5) Same as (3), except on the right side. */ - -/* 6) Same as (4), except on the right side. */ - -/* 7) Arrival at this step implies that NODE is a child of the */ -/* root and has one sibling. Execute a 3-1 merge. */ - - state = 2; - while(state != 1) { - if (state == 2) { - -/* Look up the node containing the target key TRGKEY. This */ -/* is where the underflow occurred; note that this node may */ -/* be different from the one that contained LKEY. */ - - zzektrlk_(handle, tree, &trgkey, &idx, &node, &noffst, &level, & - ptr); - -/* Look up the siblings of NODE. If either sibling exists */ -/* and has a surplus of keys, we can remove the underflow */ -/* by balancing. */ - - zzektrsb_(handle, tree, &trgkey, &lsib, &lkey, &rsib, &rkey); - if (lsib > 0) { - nkeys = zzektrnk_(handle, tree, &lsib); - if (nkeys > 41) { - -/* The left sibling can contribute a key. */ - - lnkey = lkey; - lnode = lsib; - rnode = node; - state = 4; - } else if (rsib > 0) { - -/* The left sibling cannot help with balancing, but */ -/* the right sibling may be able to. */ - - state = 3; - } else { - -/* The right sibling does not exist; the only chance */ -/* of balancing will come from the left sibling of */ -/* LSIB, if such a sibling exists. */ - - state = 7; - } - } else { - -/* There is no left sibling, so there must be a right */ -/* sibling. Examine it. */ - - state = 3; - } - } else if (state == 3) { - -/* See whether there's a node surplus in the right sibling */ -/* The left sibling has already been checked and found wanting, */ -/* or wasn't found at all. */ - - nkeys = zzektrnk_(handle, tree, &rsib); - if (nkeys > 41) { - -/* The right sibling can contribute a key. */ - - lnkey = trgkey; - lnode = node; - rnode = rsib; - state = 4; - } else if (lsib > 0) { - -/* NODE has siblings on both sides, and each one contains */ -/* the minimum number of keys. Execute a 3-2 merge. */ - - lnkey = lkey; - lnode = lsib; - mnode = node; - rnode = rsib; - state = 5; - } else { - -/* Look for the right sibling of the right sibling. */ - - state = 8; - } - } else if (state == 7) { - -/* See whether the left sibling has its own left sibling. */ - - zzektrsb_(handle, tree, &lkey, &llsib, &llkey, &lrsib, &lrkey); - if (llsib > 0) { - nkeys = zzektrnk_(handle, tree, &llsib); - if (nkeys > 41) { - -/* The left**2 sibling can contribute a key. Rotate */ -/* this key into the left sibling. We'll need the */ -/* parent and index of left parent key of LSIB in order */ -/* to do this rotation. */ - - zzektrpi_(handle, tree, &lkey, &parent, &pkey, &poffst, & - lpidx, &lpkey, &llsib, &rpidx, &rpkey, &lrsib); - zzektrrk_(handle, tree, &llsib, &lsib, &parent, &lpidx, & - c__1); - -/* Now LSIB has a one-key surplus, so we can balance */ -/* LSIB and NODE. */ - - lnkey = lkey; - lnode = lsib; - rnode = node; - state = 4; - } else { - -/* The left**2 sibling contains the minimum allowed */ -/* number of keys. Execute a 3-2 merge, with NODE */ -/* as the right node. */ - - lnkey = llkey; - lnode = llsib; - mnode = lsib; - rnode = node; - state = 5; - } - } else { - -/* LSIB and NODE are the only children of their parent. */ -/* The parent must be the root. Also, LSIB and NODE */ -/* together contain the one less than twice the minimum */ -/* allowed number of keys. Execute a 3-1 merge. */ - - lnode = lsib; - rnode = node; - state = 6; - } - } else if (state == 8) { - -/* See whether the right sibling has its own right sibling. */ - - zzektrsb_(handle, tree, &rkey, &rlsib, &rlkey, &rrsib, &rrkey); - if (rrsib > 0) { - nkeys = zzektrnk_(handle, tree, &rrsib); - if (nkeys > 41) { - -/* The right**2 sibling can contribute a key. Rotate */ -/* this key into the right sibling. We'll need the */ -/* parent and index of the right parent key of RSIB in */ -/* order to do this rotation. */ - - zzektrpi_(handle, tree, &rkey, &parent, &pkey, &poffst, & - lpidx, &lpkey, &rlsib, &rpidx, &rpkey, &rrsib); - zzektrrk_(handle, tree, &rsib, &rrsib, &parent, &rpidx, & - c_n1); - -/* Now RSIB has a one-key surplus, so we can balance */ -/* RSIB and NODE. */ - - lnkey = trgkey; - lnode = node; - rnode = rsib; - state = 4; - } else { - -/* The right**2 sibling contains the minimum allowed */ -/* number of keys. Execute a 3-2 merge, with NODE */ -/* as the left node. */ - - lnkey = trgkey; - lnode = node; - mnode = rsib; - rnode = rrsib; - state = 5; - } - } else { - -/* RSIB and NODE are the only children of their parent. */ -/* The parent must be the root. Also, RSIB and NODE */ -/* together contain one less than twice the minimum allowed */ -/* number of keys. Execute a 3-1 merge. */ - - lnode = node; - rnode = rsib; - state = 6; - } - } else if (state == 4) { - -/* LNODE has a right sibling, and between the two nodes, */ -/* there are enough keys to accommodate the underflow. After */ -/* balancing these nodes, we're done. */ - - zzektrpi_(handle, tree, &lnkey, &parent, &pkey, &poffst, &lpidx, & - lpkey, &rlsib, &rpidx, &rpkey, &rrsib); - -/* The common parent of the nodes is PARENT. The right parent */ -/* key of the left node is at location RPIDX. We're ready to */ -/* balance the nodes. */ - - zzektrbn_(handle, tree, &lnode, &rnode, &parent, &rpidx); - state = 1; - } else if (state == 5) { - -/* LNODE, MNODE, and RNODE are siblings, and between the three */ -/* nodes, there's an underflow of one key. Merge these three */ -/* nodes into two. This merging process removes a key from the */ -/* parent; the parent may underflow as a result. */ - -/* After executing the 3-2 merge, to ensure that we reference */ -/* the parent correctly, we'll obtain a fresh key from the */ -/* parent. */ - -/* To start with, we'll get a trusted key from the */ -/* leftmost node LNODE. The first key of LNODE won't be */ -/* touched by the merge. */ - - zzektrki_(handle, tree, &lnkey, &c__1, &trust); - zzektrpi_(handle, tree, &lnkey, &parent, &pkey, &poffst, &lpidx, & - lpkey, &rlsib, &rpidx, &rpkey, &rrsib); - -/* The right parent key of the left node is the left parent */ -/* key of the middle node. The index of this key is required */ -/* by ZZEKTR32. */ - - zzektr32_(handle, tree, &lnode, &mnode, &rnode, &parent, &rpidx, & - undrfl); - if (undrfl) { - -/* We'll need to handle underflow in the parent. */ -/* The parent should be correctly identified by the */ -/* parent of TRUST. */ - -/* Note that a 3-2 merge can't create an underflow in */ -/* the parent if the parent is the root: the parent */ -/* contains at least one key after this merge. */ - - zzektrpi_(handle, tree, &trust, &parent, &pkey, &poffst, & - lpidx, &lpkey, &left, &rpidx, &rpkey, &right); - trgkey = pkey; - state = 2; - } else { - state = 1; - } - } else if (state == 6) { - -/* We've got an underflow in the two children of the root. */ -/* Move all of the keys from these children into the root. */ -/* The root contains the maximum allowed number of keys */ -/* after this merge. */ - - zzektr31_(handle, tree); - state = 1; - } - } - return 0; -} /* zzektrdl_ */ - diff --git a/ext/spice/src/cspice/zzektrdp.c b/ext/spice/src/cspice/zzektrdp.c deleted file mode 100644 index 65b6e825d0..0000000000 --- a/ext/spice/src/cspice/zzektrdp.c +++ /dev/null @@ -1,150 +0,0 @@ -/* zzektrdp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRDP ( EK tree, return data pointer ) */ -/* Subroutine */ int zzektrdp_(integer *handle, integer *tree, integer *key, - integer *ptr) -{ - integer node; - extern /* Subroutine */ int zzektrlk_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *); - integer level, noffst, idx; - -/* $ Abstract */ - -/* Return the data pointer from a specified location in an EK tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key corresponding to pointer. */ -/* PTR O Data pointer. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is an absolute key indicating the location of */ -/* the desired pointer. In EK trees, absolute keys */ -/* are just ordinal positions relative to the leftmost */ -/* element of the tree, with the leftmost element */ -/* having position 1. So setting KEY to 10, for */ -/* example, indicates that the output PTR is the 10th */ -/* item in the tree. */ - -/* KEY must be in the range 1 : NKEYS, where */ -/* NKEYS is the number of keys in the tree. */ - -/* $ Detailed_Output */ - -/* PTR is the integer value associated with the input key. */ -/* Normally, this value is a data pointer. However, */ -/* the EK tree system makes no use of this fact, so */ -/* PTR need not actually be a pointer. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is out of range, the error is diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine obtains the value associated with a key, without */ -/* returning the metadata supplied by the lower-level lookup routine */ -/* ZZEKTRLK. */ - -/* $ Examples */ - -/* See EKDELR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */ - -/* -& */ - -/* Local variables */ - - -/* Use discovery check-in in this puppy. */ - - zzektrlk_(handle, tree, key, &idx, &node, &noffst, &level, ptr); - return 0; -} /* zzektrdp_ */ - diff --git a/ext/spice/src/cspice/zzektres.c b/ext/spice/src/cspice/zzektres.c deleted file mode 100644 index 9f3d10c253..0000000000 --- a/ext/spice/src/cspice/zzektres.c +++ /dev/null @@ -1,1094 +0,0 @@ -/* zzektres.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__6 = 6; -static integer c__1 = 1; - -/* $Procedure ZZEKTRES ( Private: EK, resolve times in encoded query ) */ -/* Subroutine */ int zzektres_(char *query, integer *eqryi, char *eqryc, - doublereal *eqryd, logical *error, char *errmsg, integer *errptr, - ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer base, ntab, ncns; - extern /* Subroutine */ int zzekqtab_(integer *, char *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen), zzekreqi_(integer *, char *, - integer *, ftnlen), zzekinqn_(doublereal *, integer *, integer *, - integer *, integer *, doublereal *, integer *), zzekweqi_(char *, - integer *, integer *, ftnlen), zzektcnv_(char *, doublereal *, - logical *, char *, ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int ekcii_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - char table[64*10], alias[64*10]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer descr[6]; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - integer dtype; - extern logical failed_(void); - integer sb, se; - doublereal et; - char colnam[32], timstr[32], touchc[1]; - integer attdsc[6], cnstyp, colidx, irsolv, opcode, tabidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - integer lxb, lxe; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Resolve time values in an encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Attribute Descriptor Parameters */ - -/* ekattdsc.inc Version 1 23-AUG-1995 (NJB) */ - - -/* This include file declares parameters used in EK column */ -/* attribute descriptors. Column attribute descriptors are */ -/* a simplified version of column descriptors: attribute */ -/* descriptors describe attributes of a column but do not contain */ -/* addresses or pointers. */ - - -/* Size of column attribute descriptor */ - - -/* Indices of various pieces of attribute descriptors: */ - - -/* ATTSIZ is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* ATTTYP is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* ATTLEN is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* ATTSIZ is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* ATTIDX is the location of a flag that indicates whether the column */ -/* is indexed. The flag takes the value ITRUE if the column is */ -/* indexed and otherwise takes the value IFALSE. */ - - -/* ATTNFL is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* End Include Section: EK Column Attribute Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Name Size */ - -/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of column name, in characters. */ - - -/* End Include Section: EK Column Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Table Name Size */ - -/* ektnamsz.inc Version 1 17-JAN-1995 (NJB) */ - - -/* Size of table name, in characters. */ - - -/* End Include Section: EK Table Name Size */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* EQRYI I-O Integer component of query. */ -/* EQRYC I-O Character component of query. */ -/* EQRYD I-O Numeric component of query. */ -/* ERROR O Error flag. */ -/* ERRMSG O Error message. */ -/* ERRPTR O Position in query where error was detected. */ - -/* $ Detailed_Input */ - -/* QUERY is the original query from which EQRYI and EQRYC */ -/* were obtained. QUERY is used only for */ -/* construction of error messages. */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* The query must have been parsed. */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* EQRYD is the numeric portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query. */ -/* On output, all valid time values will have been */ -/* converted from strings to equivalent numeric */ -/* values which represent times as ephemeris */ -/* seconds past J2000 (TDB). */ - -/* EQRYC is the character portion of an encoded EK query. */ - -/* ERROR is a logical flag indicating whether an error was */ -/* detected. Note that a time string might be */ -/* syntactically valid, but incapable of being */ -/* converted to ET if the appropriate time kernels */ -/* (Leapseconds or SCLK) are not loaded. */ - -/* ERRMSG is an error message describing an error in the */ -/* input query, if one was detected. If ERROR is */ -/* returned .FALSE., then ERRPTR is undefined. */ - -/* ERRPTR is the character position in the original query */ -/* at which an error was detected, if an error was */ -/* found. This index refers to the offending lexeme's */ -/* position in the original query represented by the */ -/* input encoded query. If ERROR is returned .FALSE., */ -/* ERRPTR is undefined. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input query is not initialized, the error will be */ -/* diagnosed by routines called by this routine. The outputs */ -/* will not be modified. */ - -/* 2) If names have not been resolved in the input query, the error */ -/* SPICE(NAMESNOTRESOLVED) will be signalled. The outputs */ -/* will not be modified. */ - -/* 3) If any sort of time conversion error occurs, the output flag */ -/* ERROR is set, and an error message is returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Strings representing time values are interpreted as follows: */ - -/* 1) The string is first examined to see whether it's an */ -/* SCLK string for a recognized clock; if it is, the */ -/* string is converted to the equivalent ET. */ - -/* 2) If the string is not a SCLK string, it is expected */ -/* to be some sort of UTC representation. The string is */ -/* checked to see whether it's an ISO format UTC time that */ -/* ISO2UTC can handle. */ - -/* 3) If the string does not conform to an ISO format, the */ -/* last chance is to try to get the string through */ -/* TPARSE. If TPARSE can't deal with it, it's considered */ -/* to be invalid. */ - - -/* This routine assumes that encoded EK query architecture version */ -/* 1 is to be used with the query to be initialized; this routine */ -/* will not work with any other architecture version. */ - -/* $ Examples */ - -/* See EKFIND. */ - -/* $ Restrictions */ - -/* 1) A leapseconds kernel must be loaded at the time this routine */ -/* is called. */ - -/* 2) In order to convert SCLK strings, an appropriate SCLK kernel */ -/* must be loaded at the time this routine is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* No error to start with. */ - - *error = FALSE_; - s_copy(errmsg, " ", errmsg_len, (ftnlen)1); - *errptr = 0; - *(unsigned char *)touchc = *(unsigned char *)query; - -/* The query must have had names resolved at this point, or it's no */ -/* go. */ - - zzekreqi_(eqryi, "NAMES_RESOLVED", &irsolv, (ftnlen)14); - if (failed_()) { - return 0; - } - if (irsolv == -1) { - chkin_("ZZEKTRES", (ftnlen)8); - setmsg_("Names are not resolved in encoded query.", (ftnlen)40); - sigerr_("SPICE(NAMESNOTRESOLVED)", (ftnlen)23); - chkout_("ZZEKTRES", (ftnlen)8); - return 0; - } - -/* Time strings occur only on the right sides of constraints. */ -/* Examine each constraint that compares a column and a value. */ - - zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10); - zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15); - i__1 = ncns; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Calculate the base address of the constraint. */ - - base = ntab * 12 + 19 + (i__ - 1) * 26; - -/* Obtain the constraint type. If the RHS is not a value or if */ -/* the RHS is null (as indicated by the opcode), we can skip it. */ - - cnstyp = eqryi[base + 6]; - opcode = eqryi[base + 19]; - if (cnstyp == 2 && opcode != 9 && opcode != 10) { - -/* Get the index of the table containing the LHS column, and */ -/* get the index of this column within that table. Get the */ -/* table name, then get the column's attributes. */ - - tabidx = eqryi[base + 12]; - colidx = eqryi[base + 18]; - zzekqtab_(eqryi, eqryc, &tabidx, table, alias, eqryc_len, (ftnlen) - 64, (ftnlen)64); - ekcii_(table, &colidx, colnam, attdsc, (ftnlen)64, (ftnlen)32); - dtype = attdsc[1]; - if (dtype == 4) { - -/* The RHS points to a string representing a time */ -/* value. */ - - lxb = eqryi[base + 21]; - lxe = eqryi[base + 21]; - sb = eqryi[base + 23]; - se = eqryi[base + 24]; - s_copy(timstr, eqryc + (sb - 1), (ftnlen)32, se - (sb - 1)); - -/* Convert the time to ET, if possible. */ - - zzektcnv_(timstr, &et, error, errmsg, (ftnlen)32, errmsg_len); - if (*error) { - *errptr = sb; - return 0; - } - -/* Insert the ET value into the query, and replace the */ -/* value descriptor for the time string. */ - - zzekinqn_(&et, &c__4, &lxb, &lxe, eqryi, eqryd, descr); - movei_(descr, &c__6, &eqryi[base + 20]); - } - -/* We've parsed a time string, if the current column's type */ -/* was TIME. */ - - } - -/* We've examined the current constraint, if it compares a */ -/* column with a value. */ - - } - -/* Indicate completion of time resolution. */ - - zzekweqi_("TIMES_RESOLVED", &c__1, eqryi, (ftnlen)14); - return 0; -} /* zzektres_ */ - diff --git a/ext/spice/src/cspice/zzektrfr.c b/ext/spice/src/cspice/zzektrfr.c deleted file mode 100644 index cb97eca030..0000000000 --- a/ext/spice/src/cspice/zzektrfr.c +++ /dev/null @@ -1,693 +0,0 @@ -/* zzektrfr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__3 = 3; - -/* $Procedure ZZEKTRFR ( EK tree, free ) */ -/* Subroutine */ int zzektrfr_(integer *handle, integer *tree) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer page[256], node, unit; - extern /* Subroutine */ int zzekpgfr_(integer *, integer *, integer *), - zzekpgri_(integer *, integer *, integer *), chkin_(char *, ftnlen) - ; - integer depth, level, nkids, stack[30] /* was [3][10] */, first, - nkeys, kidbas, remain; - extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - -/* $ Abstract */ - -/* Free a tree: deallocate all pages belonging to the tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input tree is deeper than the maximum allowed depth */ -/* TRMXDP, the error SPICE(INVALIDFORMAT) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine cleans up the pages occupied by an EK tree; the pages */ -/* are deallocated by the EK paging system. Freeing a tree allows */ -/* the pages previous occupied by the tree to be used for other */ -/* purposes. */ - -/* $ Examples */ - -/* 1) Return the pages occupied by the tree whose root node number */ -/* is TREE. Assume HANDLE is a file handle of the EK to which */ -/* the tree belongs: */ - -/* CALL EKTRFR ( HANDLE, TREE ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 18-JUN-1999 (WLT) */ - -/* Removed a redundant call to CHKIN. */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (NJB) */ - -/* Bug fix: the original version was untested and had numerous */ -/* problems. */ - -/* - SPICELIB Version 1.0.0, 22-OCT-1995 (NJB) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (NJB) */ - -/* Bug fix: the original version was untested and had numerous */ -/* problems. */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKTRFR", (ftnlen)8); - } - -/* Read in the root node. */ - - zzekpgri_(handle, tree, page); - -/* Check the depth of the tree. If the tree is deeper than */ -/* we expected, we've a problem. */ - - depth = page[3]; - if (depth > 10) { - dashlu_(handle, &unit); - setmsg_("Tree has depth #; max supported depth is #.EK = #; TREE = #." - , (ftnlen)60); - errint_("#", &depth, (ftnlen)1); - errint_("#", &c__10, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); - chkout_("ZZEKTRFR", (ftnlen)8); - return 0; - } - -/* We traverse the tree in post-order fashion: at each node, */ -/* we first delete all of the node's children in left-to-right */ -/* order, then we delete the node itself. We use a stack to */ -/* keep track of the ancestors of the node we're currently */ -/* considering. */ - - level = 1; - remain = page[1]; - node = *tree; - -/* Initialize the child count and the location of the first */ -/* child in the current node. The child count of the root is */ -/* one more than the number of keys in the root if the root has */ -/* children; otherwise, the child count is zero. */ - - nkeys = page[4]; - if (depth == 1) { - nkids = 0; - } else { - nkids = nkeys + 1; - } - first = 1; - while(remain > 0) { - -/* At this point, */ - -/* NODE is the current node to consider. */ -/* NKIDS is the number of children of NODE. */ -/* FIRST is the index of the first child in NODE. */ - - if (nkids > 0) { - -/* This node has children, so push the current node, the */ -/* number of children, and the location of the first child on */ -/* the stack. Before incrementing the stack level, determine */ -/* the base address of the child pointers. */ - - if (level == 1) { - kidbas = 88; - } else { - kidbas = 64; - } - stack[(i__1 = level * 3 - 3) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "stack", i__1, "zzektrfr_", (ftnlen)271)] = node; - stack[(i__1 = level * 3 - 2) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "stack", i__1, "zzektrfr_", (ftnlen)272)] = nkids; - stack[(i__1 = level * 3 - 1) < 30 && 0 <= i__1 ? i__1 : s_rnge( - "stack", i__1, "zzektrfr_", (ftnlen)273)] = first; - ++level; - -/* Read in the first child node. */ - - node = page[(i__1 = kidbas + first - 1) < 256 && 0 <= i__1 ? i__1 - : s_rnge("page", i__1, "zzektrfr_", (ftnlen)279)]; - zzekpgri_(handle, &node, page); - -/* We've never visited this node before, so the node's */ -/* metadata is valid, and the first child pointer, if any, */ -/* is at location 1. */ - - nkeys = page[0]; - if (level < depth) { - nkids = nkeys + 1; - } else { - nkids = 0; - } - first = 1; - } else { - -/* This node has no children. We can free this page. */ - - zzekpgfr_(handle, &c__3, &node); - --remain; - -/* Obtain the parent node by popping the stack. */ - - --level; - if (level > 0) { - node = stack[(i__1 = level * 3 - 3) < 30 && 0 <= i__1 ? i__1 : - s_rnge("stack", i__1, "zzektrfr_", (ftnlen)314)]; - first = stack[(i__1 = level * 3 - 1) < 30 && 0 <= i__1 ? i__1 - : s_rnge("stack", i__1, "zzektrfr_", (ftnlen)315)]; - nkids = stack[(i__1 = level * 3 - 2) < 30 && 0 <= i__1 ? i__1 - : s_rnge("stack", i__1, "zzektrfr_", (ftnlen)316)]; - -/* The parent has one less child, and the location of the */ -/* first child is the successor of the stored location. */ - - --nkids; - ++first; - -/* The parent page has been overwritten; read it back in. */ - - zzekpgri_(handle, &node, page); - } - } - -/* On this pass through the loop, we either visited a node */ -/* for the first time, or we deleted a node. Therefore, we */ -/* made progress toward loop termination. */ - - } - chkout_("ZZEKTRFR", (ftnlen)8); - return 0; -} /* zzektrfr_ */ - diff --git a/ext/spice/src/cspice/zzektrin.c b/ext/spice/src/cspice/zzektrin.c deleted file mode 100644 index 786ac68428..0000000000 --- a/ext/spice/src/cspice/zzektrin.c +++ /dev/null @@ -1,694 +0,0 @@ -/* zzektrin.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKTRIN ( EK tree, insert value ) */ -/* Subroutine */ int zzektrin_(integer *handle, integer *tree, integer *key, - integer *value) -{ - integer node, left, lval, lkey, pkey, root; - extern /* Subroutine */ int zzektrbn_(integer *, integer *, integer *, - integer *, integer *, integer *), zzektrki_(integer *, integer *, - integer *, integer *, integer *), zzektrlk_(integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - extern integer zzektrnk_(integer *, integer *, integer *); - extern /* Subroutine */ int zzektrpi_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *), zzektrui_(integer *, integer *, - integer *, integer *, logical *); - integer lnode, level, rnode, right, pkidx, lpidx, state, lpkey, nsize, - nkeys, rpidx, rpkey, trust; - extern logical failed_(void); - integer parent; - logical overfl; - integer noffst, poffst, idx; - extern /* Subroutine */ int zzektr13_(integer *, integer *), zzektr23_( - integer *, integer *, integer *, integer *, integer *, integer *, - logical *); - -/* $ Abstract */ - -/* Insert a value into an EK tree at a specified location. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key at which to insert value. */ -/* VALUE I Value to insert. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is an absolute key indicating the insertion */ -/* location. In EK trees, absolute keys are just */ -/* ordinal positions relative to the leftmost element */ -/* of the tree, with the leftmost element having */ -/* position 1. So setting KEY to 10, for example, */ -/* indicates that the input VALUE is the 10th item in */ -/* the tree. */ - -/* KEY must be in the range 1 : (NKEYS+1), where */ -/* NKEYS is the number of keys in the tree prior to */ -/* the insertion. */ - -/* VALUE is an integer value to be inserted into the */ -/* specified tree at the ordinal position KEY. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is out of range, the error is diagnosed by */ -/* routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine inserts a value into an EK tree at a specified */ -/* location. If the location is occupied, the value previously at */ -/* that location and all higher-indexed values have their indexes */ -/* incremented. Since keys are stored in subtree-relative form, */ -/* the only keys actually modified by the insertion itself are */ -/* higher-indexed keys in the node into which the insertion is done, */ -/* and higher-indexed keys in the chain of ancestors of this node. */ - -/* The insertion is not the end of the story, however: it's possible */ -/* that the node at which the insertion is done (the `target node') */ -/* will overflow. If overflow occurs, this routine will restore the */ -/* tree to its normal form as follows: */ - -/* 1) If a neighbor of the target node has room, data will be */ -/* `rotated' from the target node, through the target's parent, */ -/* and into the neighbor. The insertion is complete at this */ -/* point. */ - -/* 2) If no neighbor has room, then the target node and a */ -/* neighbor are split and recombined into three nodes: this */ -/* is called a `2-3 split'. The parent node is modified */ -/* appropriately so that all values are in the proper order */ -/* and all subtree-relative keys are correct. This 2-3 split */ -/* increases the number of values in the parent by one. If */ -/* the increase does not cause an overflow in the parent, the */ -/* insertion is complete. */ - -/* 3) If the parent overflows as a result of a 2-3 split, the */ -/* solution process is repeated at the parent's level. The */ -/* process iterates until the overflow is resolved or the */ -/* root overflows. */ - -/* 4) If the root overflows, the root is split into two children */ -/* and a new root node; the new root contains a single value. */ -/* The children of the old root become children of the two */ -/* new child nodes of the new root. This is the only */ -/* case in which the tree grows taller. */ - -/* The process of splitting the root is called a `1-3 split'. */ -/* After a 1-3 split is performed, the number of values in */ -/* each node is within bounds. */ - - -/* An EK tree is always balanced after an insertion: all leaf nodes */ -/* are at the same level. */ - -/* $ Examples */ - -/* See EKINSR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 01-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - -/* Set the variable ROOT, so we'll have something mnemonic to go */ -/* by when referring to the root node. */ - - root = *tree; - -/* Work with local copies of the input key and value. */ - - lkey = *key; - lval = *value; - -/* The first step is to insert the key into the tree without */ -/* balancing. This step may cause a node to overflow. We'll */ -/* handle the overflow later. In general, the probability of */ -/* overflow is low: each overflow creates at least one new node, */ -/* but the ratio of nodes to keys is very small. */ - - zzektrui_(handle, tree, &lkey, &lval, &overfl); - if (failed_()) { - return 0; - } - -/* If the insertion didn't result in an overflow, we're done. */ - - if (! overfl) { - return 0; - } - -/* Handle node overflows, as required. */ - - state = 2; - while(state != 1) { - if (state == 2) { - -/* Look up the node containing LKEY. */ - - zzektrlk_(handle, tree, &lkey, &idx, &node, &noffst, &level, & - lval); - if (node == root) { - state = 6; - } else { - -/* See if there's room in the left sibling. Of course, */ -/* there must be a left sibling in order for there to be */ -/* room. */ - - zzektrpi_(handle, tree, &lkey, &parent, &pkey, &poffst, & - lpidx, &lpkey, &left, &rpidx, &rpkey, &right); - if (left > 0) { - nkeys = zzektrnk_(handle, tree, &left); - if (nkeys < 62) { - lnode = left; - rnode = node; - pkidx = lpidx; - state = 4; - } else { - state = 3; - } - } else { - state = 3; - } - } - } else if (state == 3) { - -/* See whether there's room in the right sibling, if there */ -/* is a right sibling. The left sibling has already been */ -/* checked and found wanting. */ - - if (right > 0) { - nkeys = zzektrnk_(handle, tree, &right); - if (nkeys < 62) { - lnode = node; - rnode = right; - pkidx = rpidx; - state = 4; - } else { - lnode = node; - rnode = right; - pkidx = rpidx; - state = 5; - } - } else { - -/* The left sibling is full, but at least it's there. */ - - lnode = left; - rnode = node; - pkidx = lpidx; - state = 5; - } - } else if (state == 4) { - -/* LNODE has a right sibling, and between the two nodes, */ -/* there's enough room to accommodate the overflow. After */ -/* balancing these nodes, we're done. */ - - zzektrbn_(handle, tree, &lnode, &rnode, &parent, &pkidx); - state = 1; - } else if (state == 5) { - -/* LNODE has a right sibling, and between the two nodes, */ -/* there's an overflow of one key. Split these two nodes */ -/* into three. This splitting process adds a key to the */ -/* parent; the parent may overflow as a result. */ - -/* After executing the 2-3 split, to ensure that we reference */ -/* the parent correctly, we'll obtain a fresh key from the */ -/* parent. The old key PKEY may not be in the parent any more; */ -/* this key may have been rotated into the middle node created */ -/* by the 2-3 split. */ - -/* To start with, we'll get a trusted key from the */ -/* original node NODE. If NODE got mapped to LNODE, */ -/* then the first key in NODE will be unchanged by */ -/* the 2-3 split. If NODE got mapped to RNODE, then */ -/* the last key in NODE will be unchanged. */ - - if (node == lnode) { - -/* Save the first key from NODE. */ - - zzektrki_(handle, tree, &lkey, &c__1, &trust); - } else { - -/* Save the last key from NODE. */ - - nsize = zzektrnk_(handle, tree, &node); - zzektrki_(handle, tree, &lkey, &nsize, &trust); - } - zzektr23_(handle, tree, &lnode, &rnode, &parent, &pkidx, &overfl); - if (overfl) { - if (parent == root) { - state = 6; - } else { - -/* We'll need to handle overflow in the parent. */ -/* The parent should be correctly identified by the */ -/* parent of TRUST. */ - - zzektrpi_(handle, tree, &trust, &parent, &pkey, &poffst, & - lpidx, &lpkey, &left, &rpidx, &rpkey, &right); - lkey = pkey; - state = 2; - } - } else { - state = 1; - } - } else if (state == 6) { - -/* We've got an overflow in the root. Split the root, */ -/* creating two new children. The root contains a single */ -/* key after this split. */ - - zzektr13_(handle, tree); - state = 1; - } - } - return 0; -} /* zzektrin_ */ - diff --git a/ext/spice/src/cspice/zzektrit.c b/ext/spice/src/cspice/zzektrit.c deleted file mode 100644 index b71e1e8665..0000000000 --- a/ext/spice/src/cspice/zzektrit.c +++ /dev/null @@ -1,550 +0,0 @@ -/* zzektrit.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__82 = 82; -static integer c__83 = 83; - -/* $Procedure ZZEKTRIT ( EK tree, initialize ) */ -/* Subroutine */ int zzektrit_(integer *handle, integer *tree) -{ - integer base, page[256]; - extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *, - integer *), zzekpgwi_(integer *, integer *, integer *); - integer p; - extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *, - integer *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Initialize an EK tree, returning the root of the tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE O Root of tree. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* $ Detailed_Output */ - -/* TREE is the root node number of the tree created by */ -/* this routine. The root node number is used by the */ -/* EK tree routines to identify the tree. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is used to create a new, empty EK tree. The */ -/* tree has a root node, but no keys are contained in the root. */ -/* The metadata area of the tree is initialized. */ - -/* $ Examples */ - -/* See EKBSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKTRIT", (ftnlen)8); - } - -/* Start out by allocating a DAS integer page. We'll write the root */ -/* node out to this page. */ - - zzekpgal_(handle, &c__3, &p, &base); - page[0] = 1; - page[1] = 1; - page[2] = 0; - page[4] = 0; - page[3] = 1; - -/* Set all keys to zero; set all child and data pointers to null. */ - - cleari_(&c__82, &page[5]); - cleari_(&c__82, &page[172]); - cleari_(&c__83, &page[88]); - -/* Write out the page. */ - - zzekpgwi_(handle, &p, page); - -/* The identifier we return is just the page number of the tree's */ -/* root. */ - - *tree = p; - chkout_("ZZEKTRIT", (ftnlen)8); - return 0; -} /* zzektrit_ */ - diff --git a/ext/spice/src/cspice/zzektrki.c b/ext/spice/src/cspice/zzektrki.c deleted file mode 100644 index e4bb8819b2..0000000000 --- a/ext/spice/src/cspice/zzektrki.c +++ /dev/null @@ -1,393 +0,0 @@ -/* zzektrki.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRKI ( EK tree, look up key by index ) */ -/* Subroutine */ int zzektrki_(integer *handle, integer *tree, integer * - nodkey, integer *n, integer *key) -{ - integer base, node, size; - extern integer zzektrbs_(integer *); - extern /* Subroutine */ int zzektrlk_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *); - extern integer zzektrnk_(integer *, integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer level; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer addrss; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer noffst; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer idx, ptr; - -/* $ Abstract */ - -/* Get a key from a node by index: return the key having a specified */ -/* index in a specified node. The node of interest is identified */ -/* by a key in the node. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* NODKEY I Key identifying node containing key of interest. */ -/* N I Index of key of interest. */ -/* KEY O Key located at index N. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* NODKEY is an absolute key belonging to the node */ -/* containing the key of interest. */ - -/* NODKEY must be in the range 1 : NKEYS, where */ -/* NKEYS is the number of keys in the tree. */ - -/* N is the node-relative index of the key of interest. */ -/* Indices of keys start at 1. */ - -/* $ Detailed_Output */ - -/* KEY is the absolute key located at index N within the */ -/* node containing NODKEY. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is less than 1 or greater than the number */ -/* of keys in the specified tree, the error SPICE(INVALIDINDEX) */ -/* is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine allows lookup of keys by index. It is frequently */ -/* used by other EK private routines to find the first key of a node. */ - -/* $ Examples */ - -/* See ZZEKTRIN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ - -/* Functions */ - - -/* Local variables */ - - zzektrlk_(handle, tree, nodkey, &idx, &node, &noffst, &level, &ptr); - size = zzektrnk_(handle, tree, &node); - -/* Reject bad indices. */ - - if (*n < 0 || *n > size) { - chkin_("ZZEKTRKI", (ftnlen)8); - setmsg_("Key index = #; valid range in node # is 1:#", (ftnlen)43); - errint_("#", n, (ftnlen)1); - errint_("#", &node, (ftnlen)1); - errint_("#", &size, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKTRKI", (ftnlen)8); - return 0; - } - base = zzektrbs_(&node); - if (level == 1) { - addrss = base + 5 + *n; - } else { - addrss = base + 1 + *n; - } - dasrdi_(handle, &addrss, &addrss, key); - -/* Map the key from relative to absolute. */ - - *key += noffst; - return 0; -} /* zzektrki_ */ - diff --git a/ext/spice/src/cspice/zzektrlk.c b/ext/spice/src/cspice/zzektrlk.c deleted file mode 100644 index 2ae0ee879b..0000000000 --- a/ext/spice/src/cspice/zzektrlk.c +++ /dev/null @@ -1,814 +0,0 @@ -/* zzektrlk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRLK ( EK tree, locate key ) */ -/* Subroutine */ int zzektrlk_(integer *handle, integer *tree, integer *key, - integer *idx, integer *node, integer *noffst, integer *level, integer - *value) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - static logical leaf; - static integer page[256], prev, unit, plus; - extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *); - static integer child; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer depth; - static logical found; - static integer minus; - static char access[15]; - static integer datbas, oldhan; - extern /* Subroutine */ int dasham_(integer *, char *, ftnlen); - static integer oldidx, oldmax, oldnod, oldnof, oldtre, oldkey, oldval; - extern integer lstlei_(integer *, integer *, integer *); - static integer oldlvl, newkey, prvkey, totkey; - static logical samkey, samtre, rdonly; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Locate a specified key. Return metadata describing the node */ -/* containing the key. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key corresponding to value. */ -/* IDX O Node-relative index of KEY. */ -/* NODE O Node containing key. */ -/* NOFFST O Offset of NODE. */ -/* LEVEL O Level of NODE. */ -/* VALUE O Value associated with KEY. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is an absolute key. In EK trees, absolute keys are */ -/* just ordinal positions relative to the leftmost */ -/* element of the tree, with the leftmost element */ -/* having position 1. So setting KEY to 10, for */ -/* example, indicates that the output VALUE is the */ -/* 10th item in the tree. */ - -/* KEY must be in the range 1 : NKEYS, where */ -/* NKEYS is the number of keys in the tree. */ - -/* $ Detailed_Output */ - -/* IDX is the node-relative index of KEY: this is the */ -/* ordinal position of KEY relative to other keys */ -/* in the same node. */ - -/* NODE is the number of the node containing KEY. */ - -/* NOFFST is the offset of NODE. This is the count of the */ -/* keys that precede every key in the subtree headed */ -/* by NODE. Adding NOFFST to any relative key stored */ -/* in NODE will convert that key to an absolute key. */ - -/* LEVEL is the level of NODE in the tree. The root is at */ -/* level 1, children of the root are at level 2, and */ -/* so on. */ - -/* VALUE is the integer value associated with the input key. */ -/* Normally, this value is a data pointer. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is out of range, the error */ -/* SPICE(INDEXOUTOFRANGE) is signalled. */ - - -/* 4) If the tree traversal fails to terminate at the leaf node */ -/* level, the error SPICE(BUG) is signalled. */ - -/* 5) If the key is in range, but the key is not found, the error */ -/* SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine obtains the value assocated with a key, and also */ -/* returns metadata describing the node containing the key and the */ -/* key's position in the node. */ - -/* $ Examples */ - -/* See ZZEKTRUI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in in this puppy. */ - -/* Nothing found to begin with. */ - - found = FALSE_; - if (first) { - -/* Find out the access method for the current file. */ - - dasham_(handle, access, (ftnlen)15); - rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0; - samkey = FALSE_; - samtre = FALSE_; - leaf = FALSE_; - first = FALSE_; - } else { - -/* See whether we're looking at the same key, or at least */ -/* the same tree, as last time. Note that for the tree to */ -/* be guaranteed to be the same, it must belong to a file open */ -/* for read access only. */ - - if (*handle != oldhan) { - dasham_(handle, access, (ftnlen)15); - rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0; - samtre = FALSE_; - samkey = FALSE_; - } else { - samtre = *tree == oldtre && rdonly; - samkey = *key == oldkey && samtre; - } - } - -/* If we're lucky enough to be getting a request for the previously */ -/* returned key, we're set. If we've been asked for a key that is */ -/* very close to the previously requested key, we still may make */ -/* out pretty well. */ - - if (samkey) { - -/* It's the same key as last time. */ - - *idx = oldidx; - *node = oldnod; - *noffst = oldnof; - *level = oldlvl; - *value = oldval; - return 0; - } else if (samtre && leaf) { - -/* Compute the margins around the old key. Keys that fall within */ -/* the interval defined by the old key and these margins are on */ -/* the same page as the old key. */ - - plus = oldmax - oldidx; - minus = oldidx - 1; - if (*key <= oldkey + plus && *key >= oldkey - minus) { - -/* The requested key lies on the same page as the old key. */ - - *level = oldlvl; - if (*level == 1) { - datbas = 172; - } else { - datbas = 128; - } - *idx = oldidx + (*key - oldkey); - *node = oldnod; - *noffst = oldnof; - *value = page[(i__1 = datbas + *idx - 1) < 256 && 0 <= i__1 ? - i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)315)]; - oldidx = *idx; - oldkey = *key; - oldval = *value; - return 0; - } - } - -/* If we arrived here, we have some actual work to do. */ -/* Start out by looking at the root page. Save the tree depth; */ -/* we'll use this for error checking. */ - - zzekpgri_(handle, tree, page); - depth = page[3]; - *level = 1; - -/* Find out how many keys are in the tree. If KEY is outside */ -/* this range, we won't find it. */ - - totkey = page[2]; - if (*key < 1 || *key > totkey) { - chkin_("ZZEKTRLK", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Key = #; valid range = 1:#. Tree = #, file = #", (ftnlen)46); - errint_("#", key, (ftnlen)1); - errint_("#", &totkey, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("ZZEKTRLK", (ftnlen)8); - return 0; - } - -/* Find the last key at this level that is less than or equal to */ -/* the requested key. */ - - prev = lstlei_(key, &page[4], &page[5]); - if (prev > 0) { - prvkey = page[(i__1 = prev + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrlk_", (ftnlen)365)]; - } else { - prvkey = 0; - } - -/* If we were lucky enough to get an exact match, set our outputs */ -/* and return. The key offset in the root is zero. */ - - if (prvkey == *key) { - *noffst = 0; - *idx = prev; - *node = *tree; - *value = page[(i__1 = *idx + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrlk_", (ftnlen)379)]; - oldhan = *handle; - oldtre = *tree; - oldkey = *key; - oldnof = *noffst; - oldnod = *node; - oldidx = *idx; - oldlvl = *level; - oldval = *value; - oldmax = page[4]; - leaf = *level == depth; - -/* The root has no parent or siblings, so these values */ -/* remain set to zero. The same is true of the parent keys. */ - - return 0; - } - -/* Still here? Traverse the pointer path until we find the key */ -/* or run out of progeny. */ - - child = page[(i__1 = prev + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", - i__1, "zzektrlk_", (ftnlen)405)]; - *noffst = prvkey; - while(child > 0 && ! found) { - -/* Look up the child node. */ - - zzekpgri_(handle, &child, page); - ++(*level); - if (*level > depth) { - chkin_("ZZEKTRLK", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Runaway node pointer chain. Key = #; valid range = 1:#" - ". Tree = #, file = #", (ftnlen)75); - errint_("#", key, (ftnlen)1); - errint_("#", &totkey, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRLK", (ftnlen)8); - return 0; - } - -/* Find the last key at this level that is less than or equal to */ -/* the requested key. Since the keys we're looking at now are */ -/* ordinal positions relative to the subtree whose root is the */ -/* current node, we must subtract from KEY the position of the */ -/* node preceding the first key of this subtree. */ - - newkey = *key - *noffst; - prev = lstlei_(&newkey, page, &page[1]); - if (prev > 0) { - prvkey = page[(i__1 = prev) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrlk_", (ftnlen)445)]; - } else { - prvkey = 0; - } - -/* If we were lucky enough to get an exact match, set our outputs */ -/* and return. The key offset for the current node is stored */ -/* in NOFFST. */ - - if (prvkey == newkey) { - found = TRUE_; - *idx = prev; - *node = child; - *value = page[(i__1 = *idx + 127) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrlk_", (ftnlen)460)]; - oldhan = *handle; - oldtre = *tree; - oldkey = *key; - oldnof = *noffst; - oldnod = *node; - oldidx = *idx; - oldlvl = *level; - oldval = *value; - oldmax = page[0]; - leaf = *level == depth; - } else { - child = page[(i__1 = prev + 64) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrlk_", (ftnlen)476)]; - *noffst = prvkey + *noffst; - } - } - -/* If we found the key, our outputs are already set. If not, we've */ -/* got trouble. */ - - if (! found) { - chkin_("ZZEKTRLK", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Key #; valid range = 1:#. Tree = #, file = #. Key was not " - "found. This probably indicates a corrupted file or a bug in" - " the EK code.", (ftnlen)132); - errint_("#", key, (ftnlen)1); - errint_("#", &totkey, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRLK", (ftnlen)8); - return 0; - } - return 0; -} /* zzektrlk_ */ - diff --git a/ext/spice/src/cspice/zzektrls.c b/ext/spice/src/cspice/zzektrls.c deleted file mode 100644 index af8cf7f6bd..0000000000 --- a/ext/spice/src/cspice/zzektrls.c +++ /dev/null @@ -1,362 +0,0 @@ -/* zzektrls.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRLS ( EK tree, linear search ) */ -integer zzektrls_(integer *handle, integer *tree, integer *ival) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Local variables */ - extern /* Subroutine */ int zzektrdp_(integer *, integer *, integer *, - integer *); - integer i__, n; - extern integer zzektrsz_(integer *, integer *); - integer value; - -/* $ Abstract */ - -/* Search an EK tree linearly to find a specified data value. The */ -/* function returns the index at which the value is found. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Tree root. */ -/* IVAL I Value to search for. */ - -/* The function returns the lowest index at which the input value */ -/* is found, or zero if the value is not found. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* TREE is the root node of the tree to search. */ - -/* IVAL is the value to search for. */ - -/* $ Detailed_Output */ - -/* The function returns the lowest index at which the input value */ -/* is found, or zero if the value is not found. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If TREE is invalid, strange errors may result. */ - -/* 3) If an I/O error occurs while reading the indicated file, */ -/* the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This searches a tree for a specified value. It is an approximate */ -/* inverse of ZZEKTRLK. However, ZZEKTRLK operates in logarithmic */ -/* time (as a function of the tree's size), while this function */ -/* plods along in linear time. */ - -/* $ Examples */ - -/* See ZZEKRP2N. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - ret_val = 0; - n = zzektrsz_(handle, tree); - i__1 = n; - for (i__ = 1; i__ <= i__1; ++i__) { - zzektrdp_(handle, tree, &i__, &value); - if (*ival == value) { - ret_val = i__; - return ret_val; - } - } - return ret_val; -} /* zzektrls_ */ - diff --git a/ext/spice/src/cspice/zzektrnk.c b/ext/spice/src/cspice/zzektrnk.c deleted file mode 100644 index 6f2c9a42b9..0000000000 --- a/ext/spice/src/cspice/zzektrnk.c +++ /dev/null @@ -1,353 +0,0 @@ -/* zzektrnk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRNK ( EK, node size ) */ -integer zzektrnk_(integer *handle, integer *tree, integer *node) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern integer zzektrbs_(integer *); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer addrss; - -/* $ Abstract */ - -/* Return the number of keys in a node. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* NODE I Node of interest. */ - -/* The function returns the total number of keys in the specified */ -/* node of an EK tree. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* NODE is the node number of interest. */ - -/* $ Detailed_Output */ - -/* The function returns the total number of keys in the specified */ -/* node of the EK tree designated by TREE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine should be used to determine the current size of a */ -/* node in an EK tree; the tree's metadata should not be accessed */ -/* directly to extract this information. */ - -/* $ Examples */ - -/* See ZZEKTRIN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* Other functions */ - - -/* Local variables */ - - -/* Go straight to the address at which the key count for the */ -/* node is stored. */ - - if (*tree == *node) { - addrss = zzektrbs_(node) + 5; - } else { - addrss = zzektrbs_(node) + 1; - } - dasrdi_(handle, &addrss, &addrss, &ret_val); - return ret_val; -} /* zzektrnk_ */ - diff --git a/ext/spice/src/cspice/zzektrpi.c b/ext/spice/src/cspice/zzektrpi.c deleted file mode 100644 index c32aafe903..0000000000 --- a/ext/spice/src/cspice/zzektrpi.c +++ /dev/null @@ -1,769 +0,0 @@ -/* zzektrpi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRPI ( EK tree, parent information ) */ -/* Subroutine */ int zzektrpi_(integer *handle, integer *tree, integer *key, - integer *parent, integer *pkey, integer *poffst, integer *lpidx, - integer *lpkey, integer *lsib, integer *rpidx, integer *rpkey, - integer *rsib) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer page[256], lkey, prev, unit; - extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *); - integer child; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer offset; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - extern integer lstlei_(integer *, integer *, integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer maxkey, newkey, prvkey, totkey; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - -/* $ Abstract */ - -/* Given a key, return general information pertaining to the key's */ -/* parent node. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key belonging to node of interest. */ -/* PARENT O Parent node of the node containing KEY. */ -/* PKEY O A key in the parent node. */ -/* POFFST O Key offset of the parent node. */ -/* LPIDX O Node-relative index of the left parent key. */ -/* LPKEY O Left parent key. */ -/* LSIB O Node number of left sibling. */ -/* RPIDX O Node-relative index of the right parent key. */ -/* RPKEY O Right parent key. */ -/* RSIB O Node number of right sibling. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* NODE is the node number of interest. */ - -/* $ Detailed_Output */ - -/* PARENT is the number of the parent node of the node */ -/* containing KEY. If KEY is in the root, PARENT is */ -/* set to zero. */ - -/* PKEY is a key in PARENT. If PARENT is set to zero, */ -/* PKEY is set to zero as well. PKEY is used to */ -/* traverse a chain of ancestors towards the to root. */ - -/* POFFST is the key offset of PARENT; this is the offset */ -/* that must be added to the node-relative key */ -/* values in PARENT to convert them to absolute keys. */ - -/* LPIDX is the index in PARENT of the key `to the left' */ -/* of the node containing KEY. This key is the */ -/* immediate predecessor of the first key in the */ -/* subtree headed by the node containing KEY. */ - -/* The key indices in PARENT start at 1. If PARENT */ -/* contains no keys that precede the node containing */ -/* KEY, LPIDX is set to zero. */ - -/* LPKEY is the absolute key located in PARENT at index */ -/* LPIDX. If PARENT contains no keys that precede the */ -/* node containing KEY, LPKEY is set to zero. */ - -/* LSIB is the number of the left sibling node of the node */ -/* containing KEY. If PARENT contains no keys that */ -/* precede the node containing KEY, then the node */ -/* containing KEY has no left sibling, and LSIB is */ -/* set to zero. */ - -/* RPIDX is the index in PARENT of the key `to the right' */ -/* of the node containing KEY. This key is the */ -/* immediate successor of the last key in the */ -/* subtree headed by the node containing KEY. */ - -/* If PARENT contains no keys that succeed the node */ -/* containing KEY, RPIDX is set to zero. */ - -/* RPKEY is the absolute key located in PARENT at index */ -/* RPIDX. If PARENT contains no keys that succeed the */ -/* node containing KEY, RPKEY is set to zero. */ - -/* RSIB is the number of the right sibling node of the node */ -/* containing KEY. If PARENT contains no keys that */ -/* succeed the node containing KEY, then the node */ -/* containing KEY has no right sibling, and RSIB is */ -/* set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 3) If the input key is out of range, the error */ -/* SPICE(INDEXOUTOFRANGE) is signalled. */ - -/* 4) If the input key is not found in the tree, the error */ -/* SPICE(ITEMNOTFOUND) is signalled. This error most likely */ -/* indicates the presence of a serious bug in the EK software, */ -/* or that the input EK file has been corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine supports tree operations that involve identifying */ -/* the parent node of a specified node. In particular, this */ -/* routine supports updating ancestors of a node when an insertion */ -/* or deletion occurs. */ - -/* $ Examples */ - -/* See ZZEKTRUD, ZZEKTRUI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 23-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in in this puppy. */ - -/* Nothing found to begin with. */ - - found = FALSE_; - -/* Get a local copy of the input key. We may overwrite the input */ -/* key when we set PKEY. */ - - lkey = *key; - -/* Start out by reading in the root page. The node level starts */ -/* out at 1. */ - - zzekpgri_(handle, tree, page); - *parent = 0; - *pkey = 0; - *poffst = 0; - *lpidx = 0; - *lpkey = 0; - *lsib = 0; - *rpidx = 0; - *rpkey = 0; - *rsib = 0; - -/* Find out how many keys are in the tree. If LKEY is outside */ -/* this range, we won't find it. */ - - totkey = page[2]; - if (lkey < 1 || lkey > totkey) { - chkin_("ZZEKTRPI", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Key = #; valid range = 1:#. Tree = #, file = #", (ftnlen)46); - errint_("#", &lkey, (ftnlen)1); - errint_("#", &totkey, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); - chkout_("ZZEKTRPI", (ftnlen)8); - return 0; - } - -/* Find the last key at this level that is less than or equal to */ -/* the requested key. */ - - prev = lstlei_(&lkey, &page[4], &page[5]); - if (prev > 0) { - prvkey = page[(i__1 = prev + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrpi_", (ftnlen)275)]; - } else { - prvkey = 0; - } - -/* If we were lucky enough to get an exact match, we can quit now. */ -/* The root has no parent so the output values remain set to zero. */ - - if (prvkey == lkey) { - return 0; - } - -/* Still here? Traverse the pointer path until we find the key */ -/* or run out of progeny. */ - - offset = prvkey; - *parent = *tree; - *pkey = page[5]; - maxkey = page[4]; - if (prev > 0) { - *lpidx = prev; - *lpkey = page[(i__1 = *lpidx + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrpi_", (ftnlen)299)]; - *lsib = page[(i__1 = *lpidx + 87) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrpi_", (ftnlen)300)]; - } else { - *lpidx = 0; - *lpkey = 0; - *lsib = 0; - } - if (prev < maxkey) { - *rpidx = prev + 1; - *rpkey = page[(i__1 = *rpidx + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrpi_", (ftnlen)309)]; - *rsib = page[(i__1 = *rpidx + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrpi_", (ftnlen)310)]; - } else { - *rpidx = 0; - *rpkey = 0; - *rsib = 0; - } - child = page[(i__1 = prev + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", - i__1, "zzektrpi_", (ftnlen)318)]; - found = FALSE_; - while(child > 0 && ! found) { - -/* Read in the child page. */ - - zzekpgri_(handle, &child, page); - -/* Find the last key at this level that is less than or equal to */ -/* the requested key. Since the keys we're looking at now are */ -/* ordinal positions relative to the subtree whose root is the */ -/* current node, we must subtract from LKEY the position of the */ -/* node preceding the first key of this subtree. */ - - newkey = lkey - offset; - prev = lstlei_(&newkey, page, &page[1]); - if (prev > 0) { - prvkey = page[(i__1 = prev) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "zzektrpi_", (ftnlen)338)]; - } else { - prvkey = 0; - } - -/* If we were lucky enough to get an exact match, we can quit. */ -/* The outputs are set. */ - - if (prvkey == newkey) { - found = TRUE_; - } else { - -/* Record information from the current node before we read the */ -/* next child page. */ - - *parent = child; - *poffst = offset; - *pkey = page[1] + offset; - maxkey = page[0]; - if (prev > 0) { - *lpidx = prev; - *lpkey = page[(i__1 = *lpidx) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrpi_", (ftnlen)363)]; - *lsib = page[(i__1 = *lpidx + 63) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrpi_", (ftnlen)364)]; - } else { - *lpidx = 0; - *lpkey = 0; - *lsib = 0; - } - if (prev < maxkey) { - *rpidx = prev + 1; - *rpkey = page[(i__1 = *rpidx) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrpi_", (ftnlen)373)]; - *rsib = page[(i__1 = *rpidx + 64) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrpi_", (ftnlen)374)]; - } else { - *rpidx = 0; - *rpkey = 0; - *rsib = 0; - } - -/* Update the offset of the tree headed by CHILD, and set */ -/* the new child node. */ - - offset = prvkey + offset; - child = page[(i__1 = prev + 64) < 256 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "zzektrpi_", (ftnlen)386)]; - } - } - -/* If we found the key, our outputs are already set. If not, we've */ -/* got trouble. */ - - if (! found) { - chkin_("ZZEKTRPI", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Key #; valid range = 1:#. Tree = #, file = #. Key was not " - "found. This probably indicates a corrupted file or a bug in" - " the EK code.", (ftnlen)132); - errint_("#", &lkey, (ftnlen)1); - errint_("#", &totkey, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); - chkout_("ZZEKTRPI", (ftnlen)8); - return 0; - } - return 0; -} /* zzektrpi_ */ - diff --git a/ext/spice/src/cspice/zzektrrk.c b/ext/spice/src/cspice/zzektrrk.c deleted file mode 100644 index 5d45be2ddd..0000000000 --- a/ext/spice/src/cspice/zzektrrk.c +++ /dev/null @@ -1,931 +0,0 @@ -/* zzektrrk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__40 = 40; -static integer c__63 = 63; - -/* $Procedure ZZEKTRRK ( EK tree, rotate keys ) */ -/* Subroutine */ int zzektrrk_(integer *handle, integer *tree, integer *left, - integer *right, integer *parent, integer *pkidx, integer *nrot) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer dpar, lsib, rsib, root; - extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *), - zzekpgwi_(integer *, integer *, integer *); - integer i__, lpage[256], ppage[256], rpage[256]; - extern /* Subroutine */ int chkin_(char *, ftnlen), movei_(integer *, - integer *, integer *); - extern logical failed_(void); - integer datbas, kidbas, remain, keybas, dshift, schlep; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer drotat, futrpk, lnkeys, lnsize, nvopar, rnkeys, subsiz; - extern /* Subroutine */ int setmsg_(char *, ftnlen), chkout_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Rotate a specified number of keys from one node, through */ -/* the parent, into a neighboring sibling node. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* LEFT I Left node of pair to participate in rotation. */ -/* RIGHT I Right node of pair to participate in rotation. */ -/* PARENT I Parent node of pair to participate in rotation. */ -/* PKIDX I Parent key index. */ -/* NROT I Number of keys to rotate. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* LEFT, */ -/* RIGHT are the node numbers of a pair of nodes to */ -/* be balanced. LEFT and RIGHT must be neighboring */ -/* subnodes of a common parent. */ - -/* PARENT is the node number of the common parent node of */ -/* nodes LEFT, RIGHT. */ - -/* PKIDX is the `parent key index', that is, the */ -/* node-relative index of the key in the parent that */ -/* sits between PARENT's child node pointers to */ -/* nodes LEFT and RIGHT. The key at location PKIDX */ -/* is the immediate successor of the greatest key in */ -/* the subnode headed by LEFT. It is the immediate */ -/* predecessor of the least key in the subnode headed */ -/* by RIGHT. */ - -/* NROT is the number of keys to rotate. Positive counts */ -/* indicate that keys are to be rotated from node */ -/* LEFT to node RIGHT; negative counts indicate */ -/* rotation in the reverse direction. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If either LEFT or RIGHT are actually the root, the error */ -/* SPICE(BUG) is signalled. */ - -/* 4) If LEFT and RIGHT are not neighboring sibling nodes, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* 5) The rotation is not allowed to create an overflow of more */ -/* than one key in the destination node, not an underflow of */ -/* more than one key in the source node. If either restriction */ -/* is violated, the error SPICE(BUG) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* Insertions into and deletions from EK trees can result in */ -/* overflows or underflows of keys in nodes affected by these */ -/* operations. Many times key count invariants can be restored by */ -/* moving keys from one node into an adjacent sibling node. This */ -/* maneuver is called `balancing' the nodes. The process of moving */ -/* keys from one node, through the parent, into a neighboring */ -/* sibling node is called `rotating' the keys. */ - -/* Key rotation affects the parent node of the neighboring children */ -/* because one key of the parent sits between the children. This */ -/* `parent key' gets moved into one of the children as keys are */ -/* rotated. If the rotation is to the right, the parent key is the */ -/* largest key of the rotated set; if the rotation is to the left, */ -/* the parent key is the least of the rotated set. */ - -/* When keys are rotated, their data values move along with them. */ -/* In general, child pointers move along with keys, but there are */ -/* some tricky points: */ - -/* - The left and right child pointers of the parent key don't */ -/* get updated; they continue to point to the two children */ -/* LEFT and RIGHT. */ - -/* - On a right rotation, the right child pointer of the key that */ -/* gets moved into the parent key's original position becomes */ -/* the first left child pointer of the right sibling. The left */ -/* child pointer of this key doesn't get moved at all. */ - -/* - On a left rotation, the left child pointer of the key that */ -/* gets moved into the parent key's original position becomes */ -/* the last right child pointer of the left sibling. The right */ -/* child pointer of this key becomes the left child pointer of */ -/* the first key of RIGHT. */ - -/* $ Examples */ - -/* See ZZEKTRBN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 16-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - if (*nrot == 0) { - return 0; - } - root = *tree; - if (*left == root || *right == root) { - chkin_("ZZEKTRRK", (ftnlen)8); - setmsg_("Input node is root; only children are eligible for key rota" - "tion.", (ftnlen)64); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRRK", (ftnlen)8); - } - -/* Read in the input nodes. */ - - zzekpgri_(handle, left, lpage); - zzekpgri_(handle, right, rpage); - zzekpgri_(handle, parent, ppage); - if (failed_()) { - return 0; - } - -/* Set the base index of the parent keys. This value depends on */ -/* whether the parent is the root. Do the same for the pointer */ -/* bases. */ - - if (*parent == *tree) { - keybas = 5; - datbas = 172; - kidbas = 88; - } else { - keybas = 1; - datbas = 128; - kidbas = 64; - } - -/* Verify that LEFT and RIGHT are siblings, and that PARENT is */ -/* their common parent. */ - - lsib = ppage[(i__1 = kidbas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("ppage", i__1, "zzektrrk_", (ftnlen)276)]; - rsib = ppage[(i__1 = kidbas + *pkidx) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektrrk_", (ftnlen)277)]; - if (lsib != *left || rsib != *right) { - chkin_("ZZEKTRRK", (ftnlen)8); - setmsg_("LEFT, RIGHT, PARENT, and PKIDX are inconsistent. LEFT = #; " - "RIGHT = #; PARENT = #; PKIDX = #; LSIB derived from PARENT =" - " #; RSIB = #.", (ftnlen)132); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", parent, (ftnlen)1); - errint_("#", pkidx, (ftnlen)1); - errint_("#", &lsib, (ftnlen)1); - errint_("#", &rsib, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRRK", (ftnlen)8); - return 0; - } - -/* Get the key counts for the left and right nodes. */ - - lnkeys = lpage[0]; - rnkeys = rpage[0]; - -/* The requested rotation will not be permitted to cause an */ -/* underflow of more than one key in the source node, nor an */ -/* overflow of more than one key in the destination node. */ - - if (*nrot > 0) { - if (lnkeys - *nrot < 40 || rnkeys + *nrot > 63) { - chkin_("ZZEKTRRK", (ftnlen)8); - setmsg_("Node # and right sibling # contain # and # keys respect" - "ively; rotation of # keys to the right will violate the " - "key count bounds of #:#.", (ftnlen)135); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", &lnkeys, (ftnlen)1); - errint_("#", &rnkeys, (ftnlen)1); - errint_("#", nrot, (ftnlen)1); - errint_("#", &c__40, (ftnlen)1); - errint_("#", &c__63, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRRK", (ftnlen)8); - return 0; - } - } else if (*nrot < 0) { - if (lnkeys - *nrot > 63 || rnkeys + *nrot < 40) { - chkin_("ZZEKTRRK", (ftnlen)8); - setmsg_("Node # and right sibling # contain # and # keys respect" - "ively; rotation of # keys to the left will violate the k" - "ey count bounds of #:#.", (ftnlen)134); - errint_("#", left, (ftnlen)1); - errint_("#", right, (ftnlen)1); - errint_("#", &lnkeys, (ftnlen)1); - errint_("#", &rnkeys, (ftnlen)1); - i__1 = -(*nrot); - errint_("#", &i__1, (ftnlen)1); - errint_("#", &c__40, (ftnlen)1); - errint_("#", &c__63, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRRK", (ftnlen)8); - return 0; - } - } - -/* Compute the size of the tree headed by the left subnode. We'll */ -/* need this later. The size of this tree is one less than the */ -/* difference of the parent key and its predecessor, if any. */ - - if (*pkidx == 1) { - lnsize = ppage[(i__1 = keybas) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektrrk_", (ftnlen)364)] - 1; - } else { - lnsize = ppage[(i__1 = keybas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 - : s_rnge("ppage", i__1, "zzektrrk_", (ftnlen)366)] - ppage[( - i__2 = keybas + *pkidx - 2) < 256 && 0 <= i__2 ? i__2 : - s_rnge("ppage", i__2, "zzektrrk_", (ftnlen)366)] - 1; - } - -/* Now, the actions we take depend on whether we must schlep keys */ -/* to the right or left. */ - - if (*nrot > 0) { - -/* We'll rotate keys to the right. There are a bunch of numbers */ -/* to compute first: */ - -/* -- The number of keys remaining in the input node: REMAIN */ - -/* -- The size of the subtree headed by the */ -/* rotated keys: SUBSIZ */ - -/* -- The offset delta to be applied to the rotated */ -/* keys: DROTAT */ - -/* -- The offset delta to be applied to the keys shifted */ -/* right in the sibling: DSHIFT */ - -/* -- The new value of the old right parent key, */ -/* which gets rotated into the sibling: NVOPAR */ - -/* -- The offset delta to apply to the new right parent key, */ -/* DPAR. Note that the successors of this key in the */ -/* parent node remain unchanged. */ - - - schlep = *nrot; - remain = lnkeys - schlep; - -/* The size of the rotated subtree is the original size of the */ -/* subtree headed by LEFT, minus the value of the key preceding */ -/* the rotated subtree. That key, which resides at location */ -/* REMAIN + 1, is the future right parent key; this key is also */ -/* the successor of the subtree left behind. */ - - futrpk = lpage[(i__1 = remain + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "lpage", i__1, "zzektrrk_", (ftnlen)407)]; - subsiz = lnsize - futrpk; - -/* The rotated set of keys will no longer be preceded by the */ -/* set of keys of size NEWRPK that they originally followed. */ - - drotat = -futrpk; - -/* The shifted keys in the right sibling get SUBSIZ + 1 new */ -/* predecessors. */ - - dshift = subsiz + 1; - -/* The old right parent key will become the successor of the */ -/* shifted subtree. Its value is just one greater than the */ -/* size of this subtree. */ - - nvopar = dshift; - -/* The new parent key has DSHIFT fewer predecessors after */ -/* the rotation. */ - - dpar = -dshift; - -/* It's time for some action. First of all, shift the keys */ -/* in the sibling to the right. Their data pointers and child */ -/* pointers move along with them. Update all the keys by */ -/* applying the shift delta to them. */ - -/* Move the rightmost elements of each data component first. */ -/* Adjust the keys at the same time. Note that the regions */ -/* allocated to keys, data pointers, and child pointers occupy */ -/* non-overlapping addresses, so the order in which we shift */ -/* these data sets is not important. Within each data set, we */ -/* must be careful not to trash occupied addresses. */ - - for (i__ = rnkeys; i__ >= 1; --i__) { - rpage[(i__1 = i__ + 1 + schlep - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("rpage", i__1, "zzektrrk_", (ftnlen)449)] = rpage[( - i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage", - i__2, "zzektrrk_", (ftnlen)449)] + dshift; - } - for (i__ = rnkeys; i__ >= 1; --i__) { - rpage[(i__1 = i__ + 128 + schlep - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("rpage", i__1, "zzektrrk_", (ftnlen)453)] = rpage[( - i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "rpage", i__2, "zzektrrk_", (ftnlen)453)]; - } - for (i__ = rnkeys + 1; i__ >= 1; --i__) { - rpage[(i__1 = i__ + 64 + schlep - 1) < 256 && 0 <= i__1 ? i__1 : - s_rnge("rpage", i__1, "zzektrrk_", (ftnlen)457)] = rpage[( - i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpa" - "ge", i__2, "zzektrrk_", (ftnlen)457)]; - } - -/* `Move' the old parent key to its target destination in the */ -/* sibling. Actually, only the data pointer is copied; the key */ -/* is simply set to its new value. */ - - rpage[(i__1 = schlep) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrrk_", (ftnlen)465)] = nvopar; - rpage[(i__1 = schlep + 127) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage" - , i__1, "zzektrrk_", (ftnlen)466)] = ppage[(i__2 = datbas + * - pkidx - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage", i__2, - "zzektrrk_", (ftnlen)466)]; - -/* `Move' the future parent key to its target destination in the */ -/* parent. The data pointer is copied; the key is adjusted by */ -/* the offset delta we've computed. */ - - ppage[(i__1 = datbas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektrrk_", (ftnlen)473)] = lpage[(i__2 = - remain + 128) < 256 && 0 <= i__2 ? i__2 : s_rnge("lpage", - i__2, "zzektrrk_", (ftnlen)473)]; - ppage[(i__1 = keybas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektrrk_", (ftnlen)474)] = ppage[(i__2 = - keybas + *pkidx - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppa" - "ge", i__2, "zzektrrk_", (ftnlen)474)] + dpar; - -/* Rotate the subtree following the future parent key to its */ -/* destination in the sibling. Update the keys to account for */ -/* their new offset. */ - - i__1 = schlep - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - rpage[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage", - i__2, "zzektrrk_", (ftnlen)482)] = lpage[(i__3 = remain + - 2 + i__ - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("lpage", - i__3, "zzektrrk_", (ftnlen)482)] + drotat; - } - i__2 = schlep - 1; - movei_(&lpage[(i__1 = remain + 129) < 256 && 0 <= i__1 ? i__1 : - s_rnge("lpage", i__1, "zzektrrk_", (ftnlen)485)], &i__2, & - rpage[128]); - movei_(&lpage[(i__1 = remain + 65) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "lpage", i__1, "zzektrrk_", (ftnlen)486)], &schlep, &rpage[64] - ); - -/* Update the key counts in both the input node and sibling. */ - - lpage[0] -= schlep; - rpage[0] += schlep; - -/* Update the pages in the kernel. */ - - zzekpgwi_(handle, parent, ppage); - zzekpgwi_(handle, left, lpage); - zzekpgwi_(handle, right, rpage); - } else { - -/* Rotation to the left is almost, but not quite, a mirror image */ -/* of rotation to the right. */ - - schlep = -(*nrot); - remain = rnkeys - schlep; - -/* The size of the rotated subtree is one less than the value of */ -/* the future parent key. This key resides at location */ -/* SCHLEP and is also the predecessor of the subtree */ -/* left behind. */ - - futrpk = rpage[(i__1 = schlep) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "rpage", i__1, "zzektrrk_", (ftnlen)517)]; - subsiz = futrpk - 1; - -/* The rotated set of keys will be preceded by the keys already */ -/* present in LEFT, as well as the key moved in from the parent */ -/* node. */ - - drotat = lnsize + 1; - -/* The shifted keys in the right sibling lose SUBSIZ + 1 */ -/* predecessors. */ - - dshift = -(subsiz + 1); - -/* The old parent key will become the successor of the */ -/* keys already in LEFT; it will be the predecessor of the */ -/* rotated subtree. */ - - nvopar = drotat; - -/* The new parent key has (-DSHIFT) more predecessors after */ -/* the rotation. */ - - dpar = -dshift; - -/* It's time for some action. */ - -/* `Move' the old parent key to its target destination in the */ -/* input node. Actually, only the data pointer is copied; the key */ -/* is simply set to its new value. */ - - lpage[(i__1 = lnkeys + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("lpage", - i__1, "zzektrrk_", (ftnlen)553)] = nvopar; - lpage[(i__1 = lnkeys + 128) < 256 && 0 <= i__1 ? i__1 : s_rnge("lpage" - , i__1, "zzektrrk_", (ftnlen)554)] = ppage[(i__2 = datbas + * - pkidx - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppage", i__2, - "zzektrrk_", (ftnlen)554)]; - -/* `Move' the future parent key to its target destination in the */ -/* parent. The data pointer is copied; the key is adjusted by */ -/* the offset delta we've computed. */ - - ppage[(i__1 = datbas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektrrk_", (ftnlen)561)] = rpage[(i__2 = - schlep + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage", - i__2, "zzektrrk_", (ftnlen)561)]; - ppage[(i__1 = keybas + *pkidx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "ppage", i__1, "zzektrrk_", (ftnlen)562)] = ppage[(i__2 = - keybas + *pkidx - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("ppa" - "ge", i__2, "zzektrrk_", (ftnlen)562)] + dpar; - -/* Rotate the subtree following the future parent key to its */ -/* destination in the sibling. Update the keys to account for */ -/* their new offset. */ - - i__2 = schlep - 1; - movei_(&rpage[1], &i__2, &lpage[(i__1 = lnkeys + 2) < 256 && 0 <= - i__1 ? i__1 : s_rnge("lpage", i__1, "zzektrrk_", (ftnlen)569)] - ); - i__2 = schlep - 1; - movei_(&rpage[128], &i__2, &lpage[(i__1 = lnkeys + 129) < 256 && 0 <= - i__1 ? i__1 : s_rnge("lpage", i__1, "zzektrrk_", (ftnlen)570)] - ); - movei_(&rpage[64], &schlep, &lpage[(i__1 = lnkeys + 65) < 256 && 0 <= - i__1 ? i__1 : s_rnge("lpage", i__1, "zzektrrk_", (ftnlen)571)] - ); - i__1 = schlep - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - lpage[(i__2 = lnkeys + 2 + i__ - 1) < 256 && 0 <= i__2 ? i__2 : - s_rnge("lpage", i__2, "zzektrrk_", (ftnlen)574)] = lpage[( - i__3 = lnkeys + 2 + i__ - 1) < 256 && 0 <= i__3 ? i__3 : - s_rnge("lpage", i__3, "zzektrrk_", (ftnlen)574)] + drotat; - } - -/* Shift the remaining elements of the sibling to the left. */ -/* Their data pointers and child pointers move along with them. */ -/* Update all the keys by applying the shift delta to them. */ - -/* Move the leftmost elements of each data component first. */ -/* Adjust the keys at the same time. */ - - i__1 = remain; - for (i__ = 1; i__ <= i__1; ++i__) { - rpage[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage", - i__2, "zzektrrk_", (ftnlen)586)] = rpage[(i__3 = i__ + 1 - + schlep - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", - i__3, "zzektrrk_", (ftnlen)586)] + dshift; - } - i__1 = remain; - for (i__ = 1; i__ <= i__1; ++i__) { - rpage[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpa" - "ge", i__2, "zzektrrk_", (ftnlen)590)] = rpage[(i__3 = i__ - + 128 + schlep - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "rpage", i__3, "zzektrrk_", (ftnlen)590)]; - } - i__1 = remain + 1; - for (i__ = 1; i__ <= i__1; ++i__) { - rpage[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage" - , i__2, "zzektrrk_", (ftnlen)594)] = rpage[(i__3 = i__ + - 64 + schlep - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("rpa" - "ge", i__3, "zzektrrk_", (ftnlen)594)]; - } - -/* Update the key counts in both the input node and sibling. */ - - lpage[0] += schlep; - rpage[0] -= schlep; - -/* Update the pages in the kernel. */ - - zzekpgwi_(handle, parent, ppage); - zzekpgwi_(handle, left, lpage); - zzekpgwi_(handle, right, rpage); - } - return 0; -} /* zzektrrk_ */ - diff --git a/ext/spice/src/cspice/zzektrsb.c b/ext/spice/src/cspice/zzektrsb.c deleted file mode 100644 index 9998cc7b10..0000000000 --- a/ext/spice/src/cspice/zzektrsb.c +++ /dev/null @@ -1,464 +0,0 @@ -/* zzektrsb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRSB ( EK tree, identify siblings ) */ -/* Subroutine */ int zzektrsb_(integer *handle, integer *tree, integer *key, - integer *lsib, integer *lkey, integer *rsib, integer *rkey) -{ - integer base, pkey; - extern integer zzektrbs_(integer *); - extern /* Subroutine */ int zzektrpi_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *); - integer nkbas, lpidx, lpkey, rpidx, rpkey; - extern logical failed_(void); - integer kidbas; - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer keybas, addrss, parent, llpidx, loffst, poffst, roffst; - -/* $ Abstract */ - -/* Identify the immediate siblings of a node: return a key in each */ -/* sibling and the siblings' node numbers. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key of interest. */ -/* LSIB O Left sibling node. */ -/* LKEY O Key in left sibling. */ -/* RSIB O Right sibling node. */ -/* RKEY O Key in right sibling. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is a key belonging to a node whose sibling nodes */ -/* are sought. KEY is expected to be an absolute, */ -/* not node-relative, key. */ - -/* $ Detailed_Output */ - -/* LSIB is the number of the left sibling node of the node */ -/* containing KEY. If the node containing KEY has no */ -/* left sibling, LSIB is set to zero. */ - -/* LKEY is an absolute key in node LSIB. */ - -/* RSIB is the number of the right sibling node of the node */ -/* containing KEY. If the node containing KEY has no */ -/* right sibling, RSIB is set to zero. */ - -/* RKEY is an absolute key in node RSIB. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an error occurs while looking up the parent of the node */ -/* containing KEY, the error will be diagnosed by routines */ -/* called by this routine. It is not an error for the node */ -/* containing KEY to have no parent, as long as KEY belongs to */ -/* the root. */ - -/* 3) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine is a utility intended for use by other routines in */ -/* the EKTRxx set. */ - -/* The output keys LKEY and RKEY may be used to find the siblings */ -/* of the sibling nodes LSIB and RSIB. */ - -/* $ Examples */ - -/* See ZZEKTRDL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local variables */ - - -/* Start out by looking up the parent node. We get LSIB */ -/* and RSIB for free. */ - - zzektrpi_(handle, tree, key, &parent, &pkey, &poffst, &lpidx, &lpkey, - lsib, &rpidx, &rpkey, rsib); - if (failed_()) { - return 0; - } - -/* Set the base addresses for the child pointers and keys, */ -/* based on whether the parent is the root. */ - - if (parent == *tree) { - keybas = 5; - kidbas = 88; - nkbas = 5; - } else { - keybas = 1; - kidbas = 64; - nkbas = 1; - } - -/* We need to find absolute keys in each sibling that exists. */ -/* To do this, we need the node offset of each sibling node. */ -/* That offset is the value of the parent key preceding each node, */ -/* plus the parent's offset. */ - - if (lpidx > 1) { - -/* The left parent key has a predecessor. This predecessor is */ -/* the immediate predecessor of the left sibling node. */ - - llpidx = lpidx - 1; - base = zzektrbs_(&parent); - addrss = base + keybas + llpidx; - dasrdi_(handle, &addrss, &addrss, &loffst); - loffst += poffst; - -/* Get the first key from the left sibling. Convert the key */ -/* to an absolute key. */ - - base = zzektrbs_(lsib); - addrss = base + 2; - dasrdi_(handle, &addrss, &addrss, lkey); - *lkey += loffst; - } else if (lpidx == 1) { - -/* The left parent key is the first key. The left sibling has */ -/* no predecessor. */ - -/* Get the first key from the left sibling. Convert the key */ -/* to an absolute key. */ - - base = zzektrbs_(lsib); - addrss = base + 2; - dasrdi_(handle, &addrss, &addrss, lkey); - *lkey += poffst; - } else { - -/* There's no left sibling. Set the left sibling's key to a */ -/* value that won't be mistaken for a valid one. */ - - *lkey = 0; - } - -/* LKEY is set. It's time to produce an absolute key for the */ -/* right sibling. */ - - if (rpidx > 0) { - -/* The right parent key exists. This key is the */ -/* immediate predecessor of the right sibling node. */ - - roffst = rpkey + poffst; - -/* Get the first key from the right sibling. Convert the key */ -/* to an absolute key. */ - - base = zzektrbs_(rsib); - addrss = base + 2; - dasrdi_(handle, &addrss, &addrss, rkey); - *rkey += roffst; - } else { - -/* There's no right sibling. Set the right sibling's key to a */ -/* value that won't be mistaken for a valid one. */ - - *rkey = 0; - } - -/* All outputs are set. */ - - return 0; -} /* zzektrsb_ */ - diff --git a/ext/spice/src/cspice/zzektrsz.c b/ext/spice/src/cspice/zzektrsz.c deleted file mode 100644 index 5d0e9a4090..0000000000 --- a/ext/spice/src/cspice/zzektrsz.c +++ /dev/null @@ -1,345 +0,0 @@ -/* zzektrsz.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKTRSZ ( EK, tree size ) */ -integer zzektrsz_(integer *handle, integer *tree) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern integer zzektrbs_(integer *); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *); - integer addrss; - -/* $ Abstract */ - -/* Return the number of keys in a tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ - -/* The function returns the total number of keys in the specified */ -/* EK tree. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for read or write */ -/* access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* $ Detailed_Output */ - -/* The function returns the total number of keys in the specified */ -/* EK tree. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading the indicated file, the */ -/* error will be diagnosed by routines called by this routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine should be used to determine the current size of an */ -/* EK tree; the tree's metadata should not be accessed directly to */ -/* extract this information. */ - -/* $ Examples */ - -/* See EKNSEG. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Go straight to the address at which the key count is stored. */ - - addrss = zzektrbs_(tree) + 3; - dasrdi_(handle, &addrss, &addrss, &ret_val); - return ret_val; -} /* zzektrsz_ */ - diff --git a/ext/spice/src/cspice/zzektrud.c b/ext/spice/src/cspice/zzektrud.c deleted file mode 100644 index 7df46381a8..0000000000 --- a/ext/spice/src/cspice/zzektrud.c +++ /dev/null @@ -1,932 +0,0 @@ -/* zzektrud.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__63 = 63; - -/* $Procedure ZZEKTRUD ( EK tree, unbalanced deletion ) */ -/* Subroutine */ int zzektrud_(integer *handle, integer *tree, integer *key, - integer *trgkey, logical *undrfl) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer leaf, lsib, rsib, pkey, prev, unit, root, lsib2, rsib2; - extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *), - zzekpgwi_(integer *, integer *, integer *); - integer pkey2; - extern /* Subroutine */ int zzektrlk_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *), zzektrpi_( - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - integer i__, lpage[256]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer rpage[256], tpage[256], depth, level, nnode, lpidx, lpkey, rpidx, - nkeys, rpkey, paren2, poffs2, lpidx2, lpkey2, rpidx2, rpkey2; - extern logical failed_(void); - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer target, parent; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - integer keyidx, datptr, loffst, nlkeys, poffst, tnkeys, toffst, totkey; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* Delete a value from a tree at a specified location without */ -/* balancing the tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key to delete. */ -/* TRGKEY O Key identifying node from which deletion occurred. */ -/* UNDRFL O Underflow flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is an absolute key indicating the deletion */ -/* location. In EK trees, absolute keys are just */ -/* ordinal positions relative to the leftmost element */ -/* of the tree, with the leftmost element having */ -/* position 1. So setting KEY to 10, for example, */ -/* indicates that the input VALUE is the 10th item in */ -/* the tree. */ - -/* KEY must be in the range 1 : NKEYS, where */ -/* NKEYS is the number of keys in the tree prior to */ -/* the deletion. */ - -/* $ Detailed_Output */ - -/* TRGKEY is an absolute key identifying the node from which */ -/* the deletion occurred. This node may be different */ -/* from the node that contained KEY before the */ -/* deletion; see $Particulars for details. */ - -/* UNDRFL is a logical flag indicating whether the node */ -/* at which VALUE was inserted underflowed as a */ -/* result. Child nodes must contain at least */ -/* MNKEYC keys; this bound is declared in ektree.inc. */ -/* The root node is permitted to become empty. */ - -/* When an underflow condition exists, the tree */ -/* violates an invariant. The underflow must be */ -/* resolved before any other insertions or deletions */ -/* are performed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is out of range, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine deletes a value from an EK tree at the ordinal */ -/* position indicated by KEY. The deletion is always done from a */ -/* leaf node. If KEY is not in a leaf node, the value corresponding */ -/* to KEY is swapped with that of an immediate neighbor, and the */ -/* neighbor is deleted. This is possible because every key is either */ -/* in a leaf or has the property that its predecessor and successor */ -/* are both located in leaf nodes. */ - -/* After the deletion, the successor of location from which the */ -/* deletion actually was done is shifted to the next-lower-indexed */ -/* position. The routine updates all affected key counts and key */ -/* values, both in the target node and all ancestors of the target. */ -/* Here the target node is the leaf from which the deletion was */ -/* actually done. */ - -/* The caller must balance the tree when underflow occurs. */ - -/* Deletion is not quite the opposite of insertion. Note that the */ -/* output TRGKEY has no analog in the unbalanced insertion routine */ -/* ZZEKTRUI. */ - -/* $ Examples */ - -/* See ZZEKTRDL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Fixed calls to CHKIN and CHKOUT so that the same name */ -/* is used throught the routine. */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Set the variable ROOT, so we'll have something mnemonic to go */ -/* by when referring to the root node. */ - - root = *tree; - -/* We always need to update the root page, so read it now. */ - - zzekpgri_(handle, &root, rpage); - -/* The allowed range of keys is 1 to TOTKEY, where TOTKEY is the */ -/* total number of keys already present. */ - - totkey = rpage[2]; - if (*key < 1 || *key > totkey) { - chkin_("ZZEKTRUD", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Key = #. Valid range is 1:#. File = #.", (ftnlen)39); - errint_("#", key, (ftnlen)1); - errint_("#", &totkey, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - chkout_("ZZEKTRUD", (ftnlen)8); - return 0; - } - -/* Get the number of nodes in the tree. Also save the tree's depth. */ - - nnode = rpage[1]; - depth = rpage[3]; - -/* Find the point at which the deletion is to occur. When the */ -/* tree contains only one node, no search is necessary. */ - - if (nnode == 1) { - -/* This is the simplest case; all we need do is delete the */ -/* key from the root node. */ - -/* Set: */ - -/* - The number of keys in the tree */ -/* - The number of keys in the root */ -/* - The last key */ -/* - The data pointer for the last key */ -/* - The child pointer following the last key */ - -/* In the root node, relative keys coincide with absolute keys, */ -/* so the key value need not be adjusted. */ - - nkeys = totkey; - rpage[2] = nkeys - 1; - rpage[4] = nkeys - 1; - -/* Shift the keys, data pointer, and child pointers to the left */ -/* of the deleted key. Update the shifted keys. */ - - i__1 = nkeys - 1; - for (i__ = *key; i__ <= i__1; ++i__) { - rpage[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage", - i__2, "zzektrud_", (ftnlen)293)] = rpage[(i__3 = i__ + 5) - < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", i__3, "zzek" - "trud_", (ftnlen)293)] - 1; - rpage[(i__2 = i__ + 171) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpa" - "ge", i__2, "zzektrud_", (ftnlen)294)] = rpage[(i__3 = i__ - + 172) < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", i__3, - "zzektrud_", (ftnlen)294)]; - } - i__1 = nkeys; - for (i__ = *key; i__ <= i__1; ++i__) { - rpage[(i__2 = i__ + 87) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage" - , i__2, "zzektrud_", (ftnlen)298)] = rpage[(i__3 = i__ + - 88) < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", i__3, - "zzektrud_", (ftnlen)298)]; - } - -/* Zero out the freed entries. */ - - rpage[(i__1 = nkeys + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrud_", (ftnlen)304)] = 0; - rpage[(i__1 = nkeys + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrud_", (ftnlen)305)] = 0; - rpage[(i__1 = nkeys + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrud_", (ftnlen)306)] = 0; - -/* Update the key count. */ - - --nkeys; - -/* Underflow never occurs in the root; the tree simply becomes */ -/* empty if no keys are left. */ - - *undrfl = FALSE_; - -/* The first key in the root will serve as the target key, */ -/* as long as the root isn't empty. */ - - if (nkeys > 0) { - *trgkey = rpage[5]; - } else { - *trgkey = 0; - } - -/* Write the page back out, and we're all set. */ - - zzekpgwi_(handle, &root, rpage); - } else if (*key == totkey) { - -/* The deleted key is the last key in the tree. This case */ -/* is simple, because no remaining keys change as a result of */ -/* this deletion. */ - - zzektrlk_(handle, tree, key, &keyidx, &target, &toffst, &level, & - datptr); - if (failed_()) { - return 0; - } - zzekpgri_(handle, &target, tpage); - nkeys = tpage[0]; - -/* Zero out the freed entries. */ - - tpage[(i__1 = nkeys) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage", i__1, - "zzektrud_", (ftnlen)357)] = 0; - tpage[(i__1 = nkeys + 127) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage", - i__1, "zzektrud_", (ftnlen)358)] = 0; - tpage[(i__1 = nkeys + 64) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage", - i__1, "zzektrud_", (ftnlen)359)] = 0; - -/* Update the key count for this node: */ - - --tpage[0]; - -/* Since the key we deleted has no successors, there's no need */ -/* to adjust any other keys. We must decrement the total */ -/* node count in the root, however. */ - - rpage[2] = totkey - 1; - -/* Underflow occurs when the node started out at the minimum */ -/* key count. */ - - *undrfl = nkeys == 41; - -/* The first key in the target page is the target key. Return */ -/* an absolute key. */ - - *trgkey = tpage[1] + toffst; - -/* Write the affected pages back out. */ - - zzekpgwi_(handle, &root, rpage); - zzekpgwi_(handle, &target, tpage); - } else { - -/* Locate the item we wish to delete. */ - - zzektrlk_(handle, tree, key, &keyidx, &target, &toffst, &level, & - datptr); - if (level == depth) { - -/* The node containing KEY is a leaf node, which is what we */ -/* want. Deletions always take place at leaf nodes. */ - -/* Since we'll have to update the ancestors of TARGET, */ -/* look up a key in the parent node now. The order of */ -/* operations here is delicate; since the deletion */ -/* we're going to do will temporarily screw up our */ -/* addressing method, we want to do this look-up while */ -/* we're sure it will work. */ - - zzektrpi_(handle, tree, key, &parent, &pkey, &poffst, &lpidx, & - lpkey, &lsib, &rpidx, &rpkey, &rsib); - if (failed_()) { - return 0; - } - -/* Read the target page. Get the key count for this node. */ - - zzekpgri_(handle, &target, tpage); - tnkeys = tpage[0]; - -/* Each node is allowed to underflow by 1 element. If there */ -/* is already a deficit, OK, that's it. */ - - if (tnkeys < 41) { - chkin_("ZZEKTRUD", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Node = #. Tree = #. File = #. Key count = #; max al" - "lowed, including overflow, is #.", (ftnlen)83); - errint_("#", &target, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &tnkeys, (ftnlen)1); - errint_("#", &c__63, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKTRUD", (ftnlen)8); - return 0; - } - -/* Shift the keys, data pointers, and child pointers starting */ -/* at KEY to the left by 1 position. Careful, move the */ -/* leftmost elements first. Update the shifted key values */ -/* while we're at it. */ - - i__1 = tnkeys - 1; - for (i__ = keyidx; i__ <= i__1; ++i__) { - tpage[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("tpage", - i__2, "zzektrud_", (ftnlen)455)] = tpage[(i__3 = i__ - + 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("tpage", i__3, - "zzektrud_", (ftnlen)455)] - 1; - } - i__1 = tnkeys - 1; - for (i__ = keyidx; i__ <= i__1; ++i__) { - tpage[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrud_", (ftnlen)459)] = tpage[( - i__3 = i__ + 128) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "tpage", i__3, "zzektrud_", (ftnlen)459)]; - } - i__1 = tnkeys; - for (i__ = keyidx; i__ <= i__1; ++i__) { - tpage[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrud_", (ftnlen)463)] = tpage[( - i__3 = i__ + 64) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "tpage", i__3, "zzektrud_", (ftnlen)463)]; - } - -/* Update the key count for the target node. */ - - tpage[0] = tnkeys - 1; - -/* Underflow occurs when the node started out at the minimum */ -/* count. */ - - *undrfl = tnkeys == 41; - -/* The first key in the target page is the target key. */ - - *trgkey = tpage[1] + toffst; - -/* Write the target page back out. */ - - zzekpgwi_(handle, &target, tpage); - } else { - -/* The node containing KEY is not a leaf node. Therefore, */ -/* KEY > 1 and KEY has a predecessor. This predecessor */ -/* is guaranteed to reside in a leaf node. This is simply */ -/* a property of B*-trees, of which EK trees are a subclass. */ -/* Find this predecessor. */ - - i__1 = *key - 1; - zzektrlk_(handle, tree, &i__1, &prev, &leaf, &loffst, &level, & - datptr); - if (failed_()) { - return 0; - } - -/* Since we'll have to update the ancestors of LEAF, */ -/* look up a key in the parent node now. The order of */ -/* operations here is delicate; since the deletion */ -/* we're going to do will temporarily screw up our */ -/* addressing method, we want to do this look-up while */ -/* we're sure it will work. */ - - i__1 = *key - 1; - zzektrpi_(handle, tree, &i__1, &parent, &pkey, &poffst, &lpidx, & - lpkey, &lsib, &rpidx, &rpkey, &rsib); - if (failed_()) { - return 0; - } - -/* Since deletions are allowed only in leaf nodes, we'll */ -/* perform a little sleight-of-code: We'll move the key's */ -/* predecessor into the key's location, then remove the */ -/* predecessor from its leaf node. The order of the keys */ -/* is not disturbed by this re-arrangement. */ - -/* Moving the key's predecessor into the key's location is */ -/* accomplished simply by transferring the data pointer. */ - - zzekpgri_(handle, &leaf, lpage); - if (target == root) { - -/* The root page has already been read into RPAGE. */ - - rpage[(i__1 = keyidx + 171) < 256 && 0 <= i__1 ? i__1 : - s_rnge("rpage", i__1, "zzektrud_", (ftnlen)536)] = - lpage[(i__2 = prev + 127) < 256 && 0 <= i__2 ? i__2 : - s_rnge("lpage", i__2, "zzektrud_", (ftnlen)536)]; - } else { - zzekpgri_(handle, &target, tpage); - tpage[(i__1 = keyidx + 127) < 256 && 0 <= i__1 ? i__1 : - s_rnge("tpage", i__1, "zzektrud_", (ftnlen)542)] = - lpage[(i__2 = prev + 127) < 256 && 0 <= i__2 ? i__2 : - s_rnge("lpage", i__2, "zzektrud_", (ftnlen)542)]; - } - -/* The keys and data pointers in the leaf must be shifted */ -/* left to account for the deletion. We'll zero out the */ -/* freed elements. All child pointers are NIL and hence need */ -/* not be shifted. */ - - nlkeys = lpage[0]; - i__1 = nlkeys - 1; - for (i__ = prev; i__ <= i__1; ++i__) { - lpage[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge("lpage", - i__2, "zzektrud_", (ftnlen)556)] = lpage[(i__3 = i__ - + 1) < 256 && 0 <= i__3 ? i__3 : s_rnge("lpage", i__3, - "zzektrud_", (ftnlen)556)] - 1; - lpage[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "lpage", i__2, "zzektrud_", (ftnlen)557)] = lpage[( - i__3 = i__ + 128) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "lpage", i__3, "zzektrud_", (ftnlen)557)]; - } - -/* Update the key count for the leaf node. */ - - lpage[0] = nlkeys - 1; - -/* Underflow occurs when the leaf node started out at the */ -/* minimum count. */ - - *undrfl = nlkeys == 41; - -/* The first key in the leaf page is the target key. */ - - *trgkey = lpage[1] + loffst; - -/* Write the leaf, and if necessary, the target page back out. */ - - zzekpgwi_(handle, &leaf, lpage); - if (target != root) { - zzekpgwi_(handle, &target, tpage); - } - -/* The next step will be to update the ancestors of LEAF. */ -/* For the purposes of this operation, LEAF is the target */ -/* node. */ - - target = leaf; - } - -/* We must update the affected keys in every ancestor of TARGET. */ -/* We've already looked up information for the parent of */ -/* TARGET. See the note at the prior call to ZZEKTRPI. */ - - while(parent != root) { - -/* Before going to work on the parent, get *its* parent's info. */ -/* This is the last chance to do so. */ - - zzektrpi_(handle, tree, &pkey, &paren2, &pkey2, &poffs2, &lpidx2, - &lpkey2, &lsib2, &rpidx2, &rpkey2, &rsib2); - -/* Read the parent node. All keys from the right parent key */ -/* onward get decremented. Remember that there may be no */ -/* right parent key. */ - - zzekpgri_(handle, &parent, tpage); - tnkeys = tpage[0]; - if (rpidx > 0) { - i__1 = tnkeys; - for (i__ = rpidx; i__ <= i__1; ++i__) { - tpage[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrud_", (ftnlen)621)] = tpage[ - (i__3 = i__) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "tpage", i__3, "zzektrud_", (ftnlen)621)] - 1; - } - -/* Write the updated page back out. */ - - zzekpgwi_(handle, &parent, tpage); - } - parent = paren2; - pkey = pkey2; - rpidx = rpidx2; - } - -/* Update the keys in the root. Recall that the root page has */ -/* already been read into RPAGE. */ - - tnkeys = rpage[4]; - if (rpidx > 0) { - i__1 = tnkeys; - for (i__ = rpidx; i__ <= i__1; ++i__) { - rpage[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "rpage", i__2, "zzektrud_", (ftnlen)647)] = rpage[( - i__3 = i__ + 4) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "rpage", i__3, "zzektrud_", (ftnlen)647)] - 1; - } - } - -/* Update the total key count for the tree. */ - - rpage[2] = totkey - 1; - -/* Write the updated root page back out. */ - - zzekpgwi_(handle, &root, rpage); - } - return 0; -} /* zzektrud_ */ - diff --git a/ext/spice/src/cspice/zzektrui.c b/ext/spice/src/cspice/zzektrui.c deleted file mode 100644 index 375873a858..0000000000 --- a/ext/spice/src/cspice/zzektrui.c +++ /dev/null @@ -1,943 +0,0 @@ -/* zzektrui.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__63 = 63; - -/* $Procedure ZZEKTRUI ( EK tree, unbalanced insertion ) */ -/* Subroutine */ int zzektrui_(integer *handle, integer *tree, integer *key, - integer *value, logical *overfl) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer lsib, rsib, pkey, prev, next, unit, root, lsib2, rsib2; - extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *), - zzekpgwi_(integer *, integer *, integer *); - integer pkey2; - extern /* Subroutine */ int zzektrlk_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *), zzektrpi_( - integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer rpage[256], tpage[256], depth, level, nnode, lpidx, lpkey, rpidx, - nkeys, rpkey, paren2, poffs2, lpidx2, lpkey2, rpidx2, rpkey2; - extern logical failed_(void); - integer datloc, kidloc; - extern /* Subroutine */ int dashlu_(integer *, integer *); - integer keyloc, target, parent; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - integer datptr, poffst, tnkeys, toffst, totkey; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - integer idx; - -/* $ Abstract */ - -/* Insert a value into a tree at a specified location without */ -/* balancing the tree. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Tree Parameters */ - -/* ektree.inc Version 3 22-OCT-1995 (NJB) */ - - -/* The parameters in this file define the tree structure */ -/* used by the EK system. This structure is a variant of the */ -/* B*-tree structure described in Knuth's book, that is */ - -/* Knuth, Donald E. "The Art of Computer Programming, */ -/* Volume 3/Sorting and Searching" 1973, pp 471-479. */ - -/* The trees used in the EK system differ from generic B*-trees */ -/* primarily in the way keys are treated. Rather than storing */ -/* unique primary key values in each node, EK trees store integer */ -/* counts that represent the ordinal position of each data value, */ -/* counting from the lowest indexed element in the subtree whose */ -/* root is the node in question. Thus the keys are unique within */ -/* a node but not across multiple nodes: in fact the Nth key in */ -/* every leaf node is N. The absolute ordinal position of a data */ -/* item is defined recursively as the sum of the key of the data item */ -/* and the absolute ordinal position of the data item in the parent */ -/* node that immediately precedes all elements of the node in */ -/* question. This data structure allows EK trees to support lookup */ -/* of data items based on their ordinal position in a data set. The */ -/* two prime applications of this capability in the EK system are: */ - -/* 1) Using trees to index the records in a table, allowing */ -/* the Nth record to be located efficiently. */ - -/* 2) Using trees to implement order vectors that can be */ -/* maintained when insertions and deletions are done. */ - - - -/* Root node */ - -/* +--------------------------------------------+ */ -/* | Tree version code | */ -/* +--------------------------------------------+ */ -/* | Number of nodes in tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in tree | */ -/* +--------------------------------------------+ */ -/* | Depth of tree | */ -/* +--------------------------------------------+ */ -/* | Number of keys in root | */ -/* +--------------------------------------------+ */ -/* | Space for n keys, | */ -/* | | */ -/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ -/* | | */ -/* | where m is the max number of children per | */ -/* | node in the child nodes | */ -/* +--------------------------------------------+ */ -/* | Space for n+1 child pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ -/* | Space for n data pointers, | */ -/* | where n is as defined above. | */ -/* +--------------------------------------------+ */ - - -/* Child node */ - -/* +--------------------------------------------+ */ -/* | Number of keys present in node | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 keys | */ -/* +--------------------------------------------+ */ -/* | Space for m child pointers | */ -/* +--------------------------------------------+ */ -/* | Space for m-1 data pointers | */ -/* +--------------------------------------------+ */ - - - - -/* The following parameters give the maximum number of children */ -/* allowed in the root and child nodes. During insertions, the */ -/* number of children may overflow by 1. */ - - -/* Maximum number of children allowed in a child node: */ - - -/* Maximum number of keys allowed in a child node: */ - - -/* Minimum number of children allowed in a child node: */ - - -/* Minimum number of keys allowed in a child node: */ - - -/* Maximum number of children allowed in the root node: */ - - -/* Maximum number of keys allowed in the root node: */ - - -/* Minimum number of children allowed in the root node: */ - - - -/* The following parameters indicate positions of elements in the */ -/* tree node structures shown above. */ - - -/* The following parameters are for the root node only: */ - - -/* Location of version code: */ - - -/* Version code: */ - - -/* Location of node count: */ - - -/* Location of total key count for the tree: */ - - -/* Location of tree depth: */ - - -/* Location of count of keys in root node: */ - - -/* Base address of keys in the root node: */ - - -/* Base address of child pointers in root node: */ - - -/* Base address of data pointers in the root node (allow room for */ -/* overflow): */ - - -/* Size of root node: */ - - -/* The following parameters are for child nodes only: */ - - -/* Location of number of keys in node: */ - - -/* Base address of keys in child nodes: */ - - -/* Base address of child pointers in child nodes: */ - - -/* Base address of data pointers in child nodes (allow room */ -/* for overflow): */ - - -/* Size of child node: */ - - -/* A number of EK tree routines must declare stacks of fixed */ -/* depth; this depth limit imposes a limit on the maximum depth */ -/* that an EK tree can have. Because of the large branching */ -/* factor of EK trees, the depth limit is of no practical */ -/* importance: The number of keys that can be held in an EK */ -/* tree of depth N is */ - -/* N-1 */ -/* MXKIDC - 1 */ -/* MXKIDR * ------------- */ -/* MXKIDC - 1 */ - - -/* This formula yields a capacity of over 1 billion keys for a */ -/* tree of depth 6. */ - - -/* End Include Section: EK Tree Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* TREE I Root of tree. */ -/* KEY I Key to insert. */ -/* VALUE I Value to insert. */ -/* OVERFL O Overflow flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* TREE is the root node number of the tree of interest. */ - -/* KEY is an absolute key indicating the insertion */ -/* location. In EK trees, absolute keys are just */ -/* ordinal positions relative to the leftmost element */ -/* of the tree, with the leftmost element having */ -/* position 1. So setting KEY to 10, for example, */ -/* indicates that the input VALUE is the 10th item in */ -/* the tree. */ - -/* KEY must be in the range 1 : (NKEYS+1), where */ -/* NKEYS is the number of keys in the tree prior to */ -/* the insertion. */ - -/* VALUE is an integer value to be inserted into the */ -/* specified tree at the ordinal position KEY. */ - -/* $ Detailed_Output */ - -/* OVERFL is a logical flag indicating whether the node */ -/* at which VALUE was inserted overflowed as a result. */ -/* Nodes contain extra space to temporarily */ -/* accommodate an overflow of one value. */ - -/* When an overflow condition exists, the tree */ -/* violates an invariant. The overflow must be */ -/* resolved before any other insertions or deletions */ -/* are performed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If the input key is out of range, the error */ -/* SPICE(INVALIDINDEX) is signalled. */ - -/* 4) If the attempted insertion causes overflow in the target node */ -/* by more than 1 key, the error SPICE(NODETOOFULL) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine inserts a new value into an EK tree at the ordinal */ -/* position indicated by KEY. The insertion is always done in a */ -/* leaf node. This is possible because every key is either in a */ -/* leaf or has the property that its predecessor and successor are */ -/* both located in leaf nodes. */ - -/* If the inserted value is not appended to the tree, the value */ -/* previously at location KEY is shifted to the next-higher-indexed */ -/* position. The routine updates all affected key counts and key */ -/* values, both in the target node and all ancestors of the target. */ - -/* The caller must balance the tree when overflow occurs. */ - -/* $ Examples */ - -/* See ZZEKTRIN. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching" 1973, pp 471-479. */ - -/* EK trees are closely related to the B* trees described by */ -/* Knuth. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed redunant calls to CHKIN. */ - -/* - Beta Version 1.0.0, 20-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - -/* Set the variable ROOT, so we'll have something mnemonic to go */ -/* by when referring to the root node. */ - - root = *tree; - -/* We always need to update the root page, so read it now. */ - - zzekpgri_(handle, &root, rpage); - -/* The allowed range of keys is 1 to (TOTKEY+1), where TOTKEY is the */ -/* total number of keys already present. */ - - totkey = rpage[2]; - if (*key < 1 || *key > totkey + 1) { - chkin_("ZZEKTRUI", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Key = #. Valid range is 1:#. File = #.", (ftnlen)39); - errint_("#", key, (ftnlen)1); - i__1 = totkey + 1; - errint_("#", &i__1, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKTRUI", (ftnlen)8); - return 0; - } - -/* Get the number of nodes in the tree. Also save the tree's depth. */ - - nnode = rpage[1]; - depth = rpage[3]; - -/* Find the point at which the insertion is to occur. When the */ -/* tree contains only one node, no search is necessary. */ - - if (nnode == 1) { - -/* This is the simplest case; all we need do is set up the */ -/* key in the root node. */ - -/* Set: */ - -/* - The number of keys in the tree */ -/* - The number of keys in the root */ -/* - The last key */ -/* - The data value for the last key */ -/* - The child pointer following the last key */ - -/* In the root node, relative keys coincide with absolute keys, */ -/* so the key value need not be adjusted. */ - - nkeys = totkey; - rpage[2] = nkeys + 1; - rpage[4] = nkeys + 1; - -/* Shift the keys, data value, and child pointers to the right */ -/* of the new key. Update the shifted keys. */ - - i__1 = *key; - for (i__ = nkeys; i__ >= i__1; --i__) { - rpage[(i__2 = i__ + 5) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage", - i__2, "zzektrui_", (ftnlen)285)] = rpage[(i__3 = i__ + 4) - < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", i__3, "zzek" - "trui_", (ftnlen)285)] + 1; - rpage[(i__2 = i__ + 172) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpa" - "ge", i__2, "zzektrui_", (ftnlen)286)] = rpage[(i__3 = i__ - + 171) < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", i__3, - "zzektrui_", (ftnlen)286)]; - } - i__1 = *key; - for (i__ = nkeys + 1; i__ >= i__1; --i__) { - rpage[(i__2 = i__ + 88) < 256 && 0 <= i__2 ? i__2 : s_rnge("rpage" - , i__2, "zzektrui_", (ftnlen)290)] = rpage[(i__3 = i__ + - 87) < 256 && 0 <= i__3 ? i__3 : s_rnge("rpage", i__3, - "zzektrui_", (ftnlen)290)]; - } - rpage[(i__1 = *key + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrui_", (ftnlen)293)] = *key; - rpage[(i__1 = *key + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrui_", (ftnlen)294)] = *value; - rpage[(i__1 = *key + 87) < 256 && 0 <= i__1 ? i__1 : s_rnge("rpage", - i__1, "zzektrui_", (ftnlen)295)] = 0; - -/* Update the key count. */ - - ++nkeys; - -/* The node into which the key was inserted was the root. */ - - target = root; - -/* Overflow occurs when the root started out full. */ - - *overfl = nkeys == 83; - -/* Write the page back out, and we're all set. */ - - zzekpgwi_(handle, &root, rpage); - } else if (*key == totkey + 1) { - -/* The new key will be the last key in the tree. This case */ -/* is simple: the key goes in the last node of the tree. */ -/* Since every child node contains more than one key, we can */ -/* find the node by looking up the last key already present. */ - - i__1 = *key - 1; - zzektrlk_(handle, tree, &i__1, &idx, &target, &toffst, &level, & - datptr); - if (failed_()) { - return 0; - } - zzekpgri_(handle, &target, tpage); - nkeys = tpage[0]; - keyloc = nkeys + 2; - datloc = nkeys + 129; - kidloc = nkeys + 65; - -/* The last node in the tree is always at the lowest level, */ -/* so the relative value of the new key can be computed from */ -/* that of its predecessor. */ - - tpage[(i__1 = keyloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage", - i__1, "zzektrui_", (ftnlen)346)] = tpage[(i__2 = keyloc - 2) < - 256 && 0 <= i__2 ? i__2 : s_rnge("tpage", i__2, "zzektrui_", - (ftnlen)346)] + 1; - tpage[(i__1 = datloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage", - i__1, "zzektrui_", (ftnlen)347)] = *value; - tpage[(i__1 = kidloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage", - i__1, "zzektrui_", (ftnlen)348)] = 0; - -/* Update the key count for this node: */ - - ++tpage[0]; - -/* Since the key we inserted has no successors, there's no need */ -/* to adjust any other keys. We must increment the total */ -/* node count in the root, however. */ - - rpage[2] = totkey + 1; - -/* Overflow occurs when the node started out full. */ - - *overfl = nkeys == 62; - -/* Write the affected pages back out. */ - - zzekpgwi_(handle, &root, rpage); - zzekpgwi_(handle, &target, tpage); - } else { - -/* The item we wish to insert will displace the item whose */ -/* ordinal position is KEY. Locate this target item. */ - - zzektrlk_(handle, tree, key, &next, &target, &toffst, &level, &datptr) - ; - if (level == depth) { - -/* The node containing KEY is a leaf node, which is what we */ -/* want. Insertions always take place at leaf nodes. */ - -/* Since we'll have to update the ancestors of TARGET, */ -/* look up a key in the parent node now. The order of */ -/* operations here is delicate; since the insertion */ -/* we're going to do will temporarily screw up our */ -/* addressing method, we want to do this look-up while */ -/* we're sure it will work. */ - - zzektrpi_(handle, tree, key, &parent, &pkey, &poffst, &lpidx, & - lpkey, &lsib, &rpidx, &rpkey, &rsib); - if (failed_()) { - return 0; - } - -/* Read the target page. Get the key count for this node. */ - - zzekpgri_(handle, &target, tpage); - tnkeys = tpage[0]; - -/* Each node is allowed to overflow by 1 element. If there's */ -/* no more room, OK, that's it. */ - - if (tnkeys > 62) { - chkin_("ZZEKTRUI", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Node = #. Tree = #. File = #. Key count = #; max al" - "lowed, including overflow, is #.", (ftnlen)83); - errint_("#", &target, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &tnkeys, (ftnlen)1); - errint_("#", &c__63, (ftnlen)1); - sigerr_("SPICE(NODETOOFULL)", (ftnlen)18); - chkout_("ZZEKTRUI", (ftnlen)8); - return 0; - } - -/* Shift the keys, data values, and child pointers starting */ -/* at NEXT over to the right by 1 position. Careful, move the */ -/* rightmost elements first. Update the shifted key values */ -/* while we're at it. */ - - i__1 = next; - for (i__ = tnkeys; i__ >= i__1; --i__) { - tpage[(i__2 = i__ + 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrui_", (ftnlen)438)] = tpage[( - i__3 = i__) < 256 && 0 <= i__3 ? i__3 : s_rnge("tpage" - , i__3, "zzektrui_", (ftnlen)438)] + 1; - } - i__1 = next; - for (i__ = tnkeys; i__ >= i__1; --i__) { - tpage[(i__2 = i__ + 128) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrui_", (ftnlen)442)] = tpage[( - i__3 = i__ + 127) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "tpage", i__3, "zzektrui_", (ftnlen)442)]; - } - i__1 = next; - for (i__ = tnkeys + 1; i__ >= i__1; --i__) { - tpage[(i__2 = i__ + 64) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrui_", (ftnlen)446)] = tpage[( - i__3 = i__ + 63) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "tpage", i__3, "zzektrui_", (ftnlen)446)]; - } - -/* The new key simply takes the value of the old one. The */ -/* corresponding data value must be set, however. */ - - tpage[(i__1 = next + 127) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "tpage", i__1, "zzektrui_", (ftnlen)453)] = *value; - } else { - -/* The node containing KEY is not a leaf node. Therefore, */ -/* KEY > 1 and KEY has a predecessor. This predecessor */ -/* is guaranteed to reside in a leaf node. This is simply */ -/* a property of B*-trees, of which EK trees are a subclass. */ - - i__1 = *key - 1; - zzektrlk_(handle, tree, &i__1, &prev, &target, &toffst, &level, & - datptr); - if (failed_()) { - return 0; - } - -/* Since we'll have to update the ancestors of TARGET, */ -/* look up a key in the parent node now. The order of */ -/* operations here is delicate; since the insertion */ -/* we're going to do will temporarily screw up our */ -/* addressing method, we want to do this look-up while */ -/* we're sure it will work. */ - - i__1 = *key - 1; - zzektrpi_(handle, tree, &i__1, &parent, &pkey, &poffst, &lpidx, & - lpkey, &lsib, &rpidx, &rpkey, &rsib); - if (failed_()) { - return 0; - } - -/* The predecessor of KEY will be the last key present in the */ -/* node TARGET. Make sure there's room in the node. */ - - zzekpgri_(handle, &target, tpage); - tnkeys = tpage[0]; - if (tnkeys > 63) { - chkin_("ZZEKTRUI", (ftnlen)8); - dashlu_(handle, &unit); - setmsg_("Node = #. Tree = #. File = #. Key count = #; max al" - "lowed, including overflow, is #.", (ftnlen)83); - errint_("#", &target, (ftnlen)1); - errint_("#", tree, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &tnkeys, (ftnlen)1); - errint_("#", &c__63, (ftnlen)1); - sigerr_("SPICE(NODETOOFULL)", (ftnlen)18); - chkout_("ZZEKTRUI", (ftnlen)8); - return 0; - } - -/* Set the new key and the corresponding data and child */ -/* pointers. */ - - tpage[(i__1 = prev + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpage" - , i__1, "zzektrui_", (ftnlen)516)] = prev + 1; - tpage[(i__1 = prev + 128) < 256 && 0 <= i__1 ? i__1 : s_rnge( - "tpage", i__1, "zzektrui_", (ftnlen)517)] = *value; - tpage[(i__1 = prev + 65) < 256 && 0 <= i__1 ? i__1 : s_rnge("tpa" - "ge", i__1, "zzektrui_", (ftnlen)518)] = 0; - } - -/* Update the key count for the target node. */ - - tpage[0] = tnkeys + 1; - -/* Overflow occurs when the node started out full. */ - - *overfl = tnkeys == 62; - -/* Write the target page back out. */ - - zzekpgwi_(handle, &target, tpage); - -/* We must update the affected keys in every ancestor of TARGET. */ -/* We've already looked up information for the parent of */ -/* TARGET. See the note at the prior call to ZZEKTRPI. */ - - while(parent != root) { - -/* Before going to work on the parent, get *its* parent's info. */ -/* This is the last chance to do so. */ - - zzektrpi_(handle, tree, &pkey, &paren2, &pkey2, &poffs2, &lpidx2, - &lpkey2, &lsib2, &rpidx2, &rpkey2, &rsib2); - -/* Read the parent node. All keys from the right parent key */ -/* onward get incremented. Remember that there may be no */ -/* right parent key. */ - - zzekpgri_(handle, &parent, tpage); - tnkeys = tpage[0]; - if (rpidx > 0) { - i__1 = tnkeys; - for (i__ = rpidx; i__ <= i__1; ++i__) { - tpage[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "tpage", i__2, "zzektrui_", (ftnlen)564)] = tpage[ - (i__3 = i__) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "tpage", i__3, "zzektrui_", (ftnlen)564)] + 1; - } - -/* Write the updated page back out. */ - - zzekpgwi_(handle, &parent, tpage); - } - parent = paren2; - pkey = pkey2; - rpidx = rpidx2; - } - -/* Update the keys in the root. Recall that the root page has */ -/* already been read into RPAGE. */ - - tnkeys = rpage[4]; - if (rpidx > 0) { - i__1 = tnkeys; - for (i__ = rpidx; i__ <= i__1; ++i__) { - rpage[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "rpage", i__2, "zzektrui_", (ftnlen)590)] = rpage[( - i__3 = i__ + 4) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "rpage", i__3, "zzektrui_", (ftnlen)590)] + 1; - } - } - -/* Update the total key count for the tree. */ - - rpage[2] = totkey + 1; - -/* Write the updated root page back out. */ - - zzekpgwi_(handle, &root, rpage); - } - return 0; -} /* zzektrui_ */ - diff --git a/ext/spice/src/cspice/zzekue01.c b/ext/spice/src/cspice/zzekue01.c deleted file mode 100644 index 4dacae7c58..0000000000 --- a/ext/spice/src/cspice/zzekue01.c +++ /dev/null @@ -1,873 +0,0 @@ -/* zzekue01.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c_n2 = -2; -static integer c_n1 = -1; - -/* $Procedure ZZEKUE01 ( EK, update column entry, class 1 ) */ -/* Subroutine */ int zzekue01_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *ival, logical *isnull) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int zzekiii1_(integer *, integer *, integer *, - integer *, integer *, logical *); - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekglnk_(integer *, integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *), zzekixdl_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, idxtyp, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, - ftnlen), zzekad01_(integer *, integer *, integer *, integer *, - integer *, logical *); - -/* $ Abstract */ - -/* Update a specified class 1 column entry in an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* IVAL I Integer value. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to update. */ - -/* IVAL is the integer value with which to update the */ -/* specified column entry. */ - - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input IVAL is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it updates a column entry */ -/* in an EK segment. This routine does not participate in shadowing */ -/* functions. If the target EK is shadowed, the caller is */ -/* responsible for performing necessary backup operations. If the */ -/* target EK is not shadowed, the target record's status is not */ -/* modified. */ - -/* If the column containing the entry is indexed, the corresponding */ -/* index is updated. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKUCEI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed redundant calls to CHKIN. */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKUE01", (ftnlen)8); - } - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKUE01", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - -/* Compute the data pointer location. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* The column entry is non-null. Determine whether the column is */ -/* indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp == 1) { - -/* The column has a type 1 index. Delete the index entry */ -/* for this column. Create an index entry for the new value. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - zzekiii1_(handle, segdsc, coldsc, ival, recptr, isnull); - } else if (idxtyp != -1) { - setmsg_("Column having index # in segment # has index type #.", ( - ftnlen)52); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &idxtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKUE01", (ftnlen)8); - return 0; - } - -/* If the new value is null, set the data pointer to indicate a */ -/* null value. Otherwise, overwrite the old value with the new */ -/* one. */ - - if (*isnull) { - -/* The data location used by the previous value is no longer */ -/* needed, so we have one less link to this page. */ - - zzekpgpg_(&c__3, &datptr, &p, &pbase); - zzekglnk_(handle, &c__3, &p, &nlinks); - i__1 = nlinks - 1; - zzekslnk_(handle, &c__3, &p, &i__1); - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - -/* No link counts change; we just have a new value. */ - - dasudi_(handle, &datptr, &datptr, ival); - } - } else if (datptr == -2) { - -/* If the new entry is null too, there's nothing to do. */ -/* We don't have to adjust link counts or indexes. */ - -/* If the new entry is non-null, we must add a new column entry, */ -/* since no space was reserved for the old one. The column */ -/* index entry must be cleaned up, if the column is indexed. */ - - if (! (*isnull)) { - idxtyp = coldsc[5]; - if (idxtyp == 1) { - -/* The column has a type 1 index. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } else if (idxtyp != -1) { - setmsg_("Column having index # in segment # has index type #." - , (ftnlen)52); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &idxtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKUE01", (ftnlen)8); - return 0; - } - -/* We don't need to decrement the link count for this page. */ -/* Just add the new value to the column. But first, set the */ -/* data pointer to indicate an uninitialized value, so the */ -/* data addition routine doesn't choke. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - zzekad01_(handle, segdsc, coldsc, recptr, ival, isnull); - } - } else if (datptr == -1 || datptr == -3) { - -/* There is no current column entry. Just add a new entry. */ - - zzekad01_(handle, segdsc, coldsc, recptr, ival, isnull); - } else { - -/* The data pointer is corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKUE01", (ftnlen)8); - return 0; - } - chkout_("ZZEKUE01", (ftnlen)8); - return 0; -} /* zzekue01_ */ - diff --git a/ext/spice/src/cspice/zzekue02.c b/ext/spice/src/cspice/zzekue02.c deleted file mode 100644 index 832829933a..0000000000 --- a/ext/spice/src/cspice/zzekue02.c +++ /dev/null @@ -1,873 +0,0 @@ -/* zzekue02.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c_n2 = -2; -static integer c_n1 = -1; - -/* $Procedure ZZEKUE02 ( EK, update column entry, class 2 ) */ -/* Subroutine */ int zzekue02_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, doublereal *dval, logical *isnull) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int zzekiid1_(integer *, integer *, integer *, - doublereal *, integer *, logical *); - extern integer zzekrp2n_(integer *, integer *, integer *); - integer unit; - extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), - zzekglnk_(integer *, integer *, integer *, integer *), zzekpgpg_( - integer *, integer *, integer *, integer *), zzekixdl_(integer *, - integer *, integer *, integer *), zzekslnk_(integer *, integer *, - integer *, integer *); - integer p, pbase; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, ncols; - extern logical failed_(void); - extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, - integer *), dasudi_(integer *, integer *, integer *, integer *); - extern logical return_(void); - integer datptr, idxtyp, nlinks, ptrloc; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen), dasudd_(integer *, integer *, integer *, doublereal *), - dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen), - zzekad02_(integer *, integer *, integer *, integer *, doublereal - *, logical *); - -/* $ Abstract */ - -/* Update a specified class 2 column entry in an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* DVAL I Double precision value. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to update. */ - -/* DVAL is the double precision value with which to update */ -/* the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input DVAL is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it updates a column entry */ -/* in an EK segment. This routine does not participate in shadowing */ -/* functions. If the target EK is shadowed, the caller is */ -/* responsible for performing necessary backup operations. If the */ -/* target EK is not shadowed, the target record's status is not */ -/* modified. */ - -/* If the column containing the entry is indexed, the corresponding */ -/* index is updated. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKUCED. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Removed redundant calls to CHKIN. */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKUE02", (ftnlen)8); - } - -/* Is this file handle valid--is the file open for paged write */ -/* access? Signal an error if not. */ - - zzekpgch_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("ZZEKUE02", (ftnlen)8); - return 0; - } - -/* We'll need to know how many columns the segment has in order to */ -/* compute the size of the record pointer. The record pointer */ -/* contains DPTBAS items plus two elements for each column. */ - - ncols = segdsc[4]; - -/* Compute the data pointer location. */ - - ptrloc = *recptr + 2 + coldsc[8]; - dasrdi_(handle, &ptrloc, &ptrloc, &datptr); - if (datptr > 0) { - -/* The column entry is non-null. Determine whether the column is */ -/* indexed. */ - - idxtyp = coldsc[5]; - if (idxtyp == 1) { - -/* The column has a type 1 index. Delete the index entry */ -/* for this column. Create an index entry for the new value. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - zzekiid1_(handle, segdsc, coldsc, dval, recptr, isnull); - } else if (idxtyp != -1) { - setmsg_("Column having index # in segment # has index type #.", ( - ftnlen)52); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &idxtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKUE02", (ftnlen)8); - return 0; - } - -/* If the new value is null, set the data pointer to indicate a */ -/* null value. Otherwise, overwrite the old value with the new */ -/* one. */ - - if (*isnull) { - -/* The data location used by the previous value is no longer */ -/* needed, so we have one less link to this page. */ - - zzekpgpg_(&c__2, &datptr, &p, &pbase); - zzekglnk_(handle, &c__2, &p, &nlinks); - i__1 = nlinks - 1; - zzekslnk_(handle, &c__2, &p, &i__1); - dasudi_(handle, &ptrloc, &ptrloc, &c_n2); - } else { - -/* No link counts change; we just have a new value. */ - - dasudd_(handle, &datptr, &datptr, dval); - } - } else if (datptr == -2) { - -/* If the new entry is null too, there's nothing to do. */ -/* We don't have to adjust link counts or indexes. */ - -/* If the new entry is non-null, we must add a new column entry, */ -/* since no space was reserved for the old one. The column */ -/* index entry must be cleaned up, if the column is indexed. */ - - if (! (*isnull)) { - idxtyp = coldsc[5]; - if (idxtyp == 1) { - -/* The column has a type 1 index. Delete the index entry */ -/* for this column. */ - - zzekixdl_(handle, segdsc, coldsc, recptr); - } else if (idxtyp != -1) { - setmsg_("Column having index # in segment # has index type #." - , (ftnlen)52); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &idxtyp, (ftnlen)1); - sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); - chkout_("ZZEKUE02", (ftnlen)8); - return 0; - } - -/* We don't need to decrement the link count for this page. */ -/* Just add the new value to the column. But first, set the */ -/* data pointer to indicate an uninitialized value, so the */ -/* data addition routine doesn't choke. */ - - dasudi_(handle, &ptrloc, &ptrloc, &c_n1); - zzekad02_(handle, segdsc, coldsc, recptr, dval, isnull); - } - } else if (datptr == -1 || datptr == -3) { - -/* There is no current column entry. Just add a new entry. */ - - zzekad02_(handle, segdsc, coldsc, recptr, dval, isnull); - } else { - -/* The data pointer is corrupted. */ - - recno = zzekrp2n_(handle, &segdsc[1], recptr); - dashlu_(handle, &unit); - setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " - "#; EK = #", (ftnlen)68); - errint_("#", &segdsc[1], (ftnlen)1); - errint_("#", &coldsc[8], (ftnlen)1); - errint_("#", &recno, (ftnlen)1); - errfnm_("#", &unit, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKUE02", (ftnlen)8); - return 0; - } - chkout_("ZZEKUE02", (ftnlen)8); - return 0; -} /* zzekue02_ */ - diff --git a/ext/spice/src/cspice/zzekue03.c b/ext/spice/src/cspice/zzekue03.c deleted file mode 100644 index a95eba78b8..0000000000 --- a/ext/spice/src/cspice/zzekue03.c +++ /dev/null @@ -1,730 +0,0 @@ -/* zzekue03.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKUE03 ( EK, update column entry, class 3 ) */ -/* Subroutine */ int zzekue03_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void), return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), zzekad03_(integer *, - integer *, integer *, integer *, char *, logical *, ftnlen), - zzekde03_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Update a specified class 3 column entry in an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* CVAL I Character string value. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to update. */ - -/* CVAL is the character string value with which to update */ -/* the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input CVAL is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If RECNO is out of range, the error SPICE(INVALIDINDEX) */ -/* will be signalled. The file will not be modified. */ - -/* 3) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it updates a column entry */ -/* in an EK segment. This routine does not participate in shadowing */ -/* functions. If the target EK is shadowed, the caller is */ -/* responsible for performing necessary backup operations. If the */ -/* target EK is not shadowed, the target record's status is not */ -/* modified. */ - -/* If the column containing the entry is indexed, the corresponding */ -/* index is updated. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKUCEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKUE03", (ftnlen)8); - } - -/* Get rid of the old column entry first. */ - - zzekde03_(handle, segdsc, coldsc, recptr); - if (failed_()) { - chkout_("ZZEKUE03", (ftnlen)8); - return 0; - } - -/* We've reduced the problem to a solved one: that of adding */ -/* a column entry. */ - - zzekad03_(handle, segdsc, coldsc, recptr, cval, isnull, cval_len); - chkout_("ZZEKUE03", (ftnlen)8); - return 0; -} /* zzekue03_ */ - diff --git a/ext/spice/src/cspice/zzekue04.c b/ext/spice/src/cspice/zzekue04.c deleted file mode 100644 index 8868736da6..0000000000 --- a/ext/spice/src/cspice/zzekue04.c +++ /dev/null @@ -1,449 +0,0 @@ -/* zzekue04.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKUE04 ( EK, update column entry, class 4 ) */ -/* Subroutine */ int zzekue04_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *nvals, integer *ivals, logical * - isnull) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void), return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), zzekad04_(integer *, - integer *, integer *, integer *, integer *, integer *, logical *), - zzekde04_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Update a specified class 4 column entry in an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* NVALS I Number of values. */ -/* IVALS I Integer values. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to update. */ - -/* NVALS is the number of values in the replacement */ -/* column entry. */ - -/* IVALS is an array of integer values with which to update */ -/* the specified column entry. */ - - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input IVALS is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it updates a column entry */ -/* in an EK segment. The status of the record containing the entry */ -/* is set to `updated'. If the column containing the entry is */ -/* indexed, the corresponding index is updated. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKUCEI. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKUE04", (ftnlen)8); - } - -/* Get rid of the old column entry first. */ - - zzekde04_(handle, segdsc, coldsc, recptr); - if (failed_()) { - chkout_("ZZEKUE04", (ftnlen)8); - return 0; - } - -/* We've reduced the problem to a solved one: that of adding */ -/* a column entry. */ - - zzekad04_(handle, segdsc, coldsc, recptr, nvals, ivals, isnull); - chkout_("ZZEKUE04", (ftnlen)8); - return 0; -} /* zzekue04_ */ - diff --git a/ext/spice/src/cspice/zzekue05.c b/ext/spice/src/cspice/zzekue05.c deleted file mode 100644 index 88168918e3..0000000000 --- a/ext/spice/src/cspice/zzekue05.c +++ /dev/null @@ -1,449 +0,0 @@ -/* zzekue05.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKUE05 ( EK, update column entry, class 5 ) */ -/* Subroutine */ int zzekue05_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical * - isnull) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void), return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), zzekad05_(integer *, - integer *, integer *, integer *, integer *, doublereal *, logical - *), zzekde05_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Update a specified class 5 column entry in an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* NVALS I Number of values. */ -/* DVALS I Double precision values. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to update. */ - -/* NVALS is the number of values in the replacement */ -/* column entry. */ - -/* DVALS is an array of double precision values with which */ -/* to update the specified column entry. */ - - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input DVALS is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it updates a column entry */ -/* in an EK segment. The status of the record containing the entry */ -/* is set to `updated'. If the column containing the entry is */ -/* indexed, the corresponding index is updated. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKUCED. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKUE05", (ftnlen)8); - } - -/* Get rid of the old column entry first. */ - - zzekde05_(handle, segdsc, coldsc, recptr); - if (failed_()) { - chkout_("ZZEKUE05", (ftnlen)8); - return 0; - } - -/* We've reduced the problem to a solved one: that of adding */ -/* a column entry. */ - - zzekad05_(handle, segdsc, coldsc, recptr, nvals, dvals, isnull); - chkout_("ZZEKUE05", (ftnlen)8); - return 0; -} /* zzekue05_ */ - diff --git a/ext/spice/src/cspice/zzekue06.c b/ext/spice/src/cspice/zzekue06.c deleted file mode 100644 index cc794010a2..0000000000 --- a/ext/spice/src/cspice/zzekue06.c +++ /dev/null @@ -1,728 +0,0 @@ -/* zzekue06.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZEKUE06 ( EK, update column entry, class 6 ) */ -/* Subroutine */ int zzekue06_(integer *handle, integer *segdsc, integer * - coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, - ftnlen cvals_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical failed_(void), return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen), zzekad06_(integer *, - integer *, integer *, integer *, integer *, char *, logical *, - ftnlen), zzekde06_(integer *, integer *, integer *, integer *); - -/* $ Abstract */ - -/* Update a specified class 6 column entry in an EK record. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Record Pointer Parameters */ - -/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ - - -/* This file declares parameters used in EK record pointers. */ -/* Each segment references data in a given record via two levels */ -/* of indirection: a record number points to a record pointer, */ -/* which is a structured array of metadata and data pointers. */ - -/* Record pointers always occupy contiguous ranges of integer */ -/* addresses. */ - -/* The parameter declarations in this file depend on the assumption */ -/* that integer pages contain 256 DAS integer words and that the */ -/* maximum number of columns in a segment is 100. Record pointers */ -/* are stored in integer data pages, so they must fit within the */ -/* usable data area afforded by these pages. The size of the usable */ -/* data area is given by the parameter IPSIZE which is declared in */ -/* ekdatpag.inc. The assumed value of IPSIZE is 254. */ - - -/* The first element of each record pointer is a status indicator. */ -/* The meanings of status indicators depend on whether the parent EK */ -/* is shadowed or not. For shadowed EKs, allowed status values and */ -/* their meanings are: */ - -/* OLD The record has not been modified since */ -/* the EK containing the record was opened. */ - -/* UPDATE The record is an update of a previously existing */ -/* record. The original record is now on the */ -/* modified record list. */ - -/* NEW The record has been added since the EK containing the */ -/* record was opened. The record is not an update */ -/* of a previously existing record. */ - -/* DELOLD This status applies only to a backup record. */ -/* DELOLD status indicates that the record corresponds */ -/* to a deleted OLD record in the source segment. */ - -/* DELNEW This status applies only to a backup record. */ -/* DELNEW status indicates that the record corresponds */ -/* to a deleted NEW record in the source segment. */ - -/* DELUPD This status applies only to a backup record. */ -/* DELUPD status indicates that the record corresponds */ -/* to a deleted UPDATEd record in the source segment. */ - -/* In EKs that are not shadowed, all records have status OLD. */ - - - -/* The following parameters refer to indices within the record */ -/* pointer structure: */ - -/* Index of status indicator: */ - - -/* Each record pointer contains a pointer to its companion: for a */ -/* record belonging to a shadowed EK, this is the backup counterpart, */ -/* or if the parent EK is itself a backup EK, a pointer to the */ -/* record's source record. The pointer is UNINIT (see below) if the */ -/* record is unmodified. */ - -/* Record companion pointers contain record numbers, not record */ -/* base addresses. */ - -/* Index of record's companion pointer: */ - - -/* Each data item is referenced by an integer. The meaning of */ -/* this integer depends on the representation of data in the */ -/* column to which the data item belongs. Actual lookup of a */ -/* data item must be done by subroutines appropriate to the class of */ -/* the column to which the item belongs. Note that data items don't */ -/* necessarily occupy contiguous ranges of DAS addresses. */ - -/* Base address of data pointers: */ - - -/* Maximum record pointer size: */ - - -/* Data pointers are given the value UNINIT to start with; this */ -/* indicates that the data item is uninitialized. UNINIT is */ -/* distinct from the value NULL. NOBACK indicates an uninitialized */ -/* backup column entry. */ - - -/* End Include Section: EK Record Pointer Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I File handle. */ -/* SEGDSC I Segment descriptor. */ -/* COLDSC I Column descriptor. */ -/* RECPTR I Record pointer. */ -/* NVALS I Number of values. */ -/* CVALS I Character string values. */ -/* ISNULL I Null flag. */ - -/* $ Detailed_Input */ - -/* HANDLE is a file handle of an EK open for write access. */ - -/* SEGDSC is the descriptor of the segment containing */ -/* the specified column entry. */ - -/* COLDSC is the descriptor of the column containing */ -/* the specified column entry. */ - -/* RECPTR is a pointer to the record containing the column */ -/* entry to update. */ - -/* NVALS is the number of values in the replacement */ -/* column entry. */ - -/* CVALS is an array of character string values with which */ -/* to update the specified column entry. */ - -/* ISNULL is a logical flag indicating whether the value */ -/* of the specified column entry is to be set to NULL. */ -/* If so, the input CVALS is ignored. */ - -/* $ Detailed_Output */ - -/* None. See the $Particulars section for a description of the */ -/* effect of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. The file will not be modified. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. The file may be corrupted. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it updates a column entry */ -/* in an EK segment. The status of the record containing the entry */ -/* is set to `updated'. If the column containing the entry is */ -/* indexed, the corresponding index is updated. */ - -/* The changes made by this routine to the target EK file become */ -/* permanent when the file is closed. Failure to close the file */ -/* properly will leave it in an indeterminate state. */ - -/* $ Examples */ - -/* See EKUCEC. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKUE06", (ftnlen)8); - } - -/* Get rid of the old column entry first. */ - - zzekde06_(handle, segdsc, coldsc, recptr); - if (failed_()) { - chkout_("ZZEKUE06", (ftnlen)8); - return 0; - } - -/* We've reduced the problem to a solved one: that of adding */ -/* a column entry. */ - - zzekad06_(handle, segdsc, coldsc, recptr, nvals, cvals, isnull, cvals_len) - ; - chkout_("ZZEKUE06", (ftnlen)8); - return 0; -} /* zzekue06_ */ - diff --git a/ext/spice/src/cspice/zzekvadr.c b/ext/spice/src/cspice/zzekvadr.c deleted file mode 100644 index 2bb8ad396f..0000000000 --- a/ext/spice/src/cspice/zzekvadr.c +++ /dev/null @@ -1,783 +0,0 @@ -/* zzekvadr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__200 = 200; -static integer c__10 = 10; - -/* $Procedure ZZEKVADR ( Compute row vector address ) */ -/* Subroutine */ int zzekvadr_0_(int n__, integer *njrs, integer *bases, - integer *rwvidx, integer *rwvbas, integer *sgvbas) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer rbas[200]; - extern /* Subroutine */ int zzekstop_(integer *); - static integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer ntabs, svbas[200]; - extern /* Subroutine */ int cleari_(integer *, integer *); - static integer begidx[200], reloff, addrss; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - extern integer lstlei_(integer *, integer *, integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - static integer jrsidx; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - static integer maxrwv, svnjrs, top, nsv; - extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Given a union of EK join row sets and a row vector index, */ -/* compute the EK scratch area base address of the row vector having */ -/* the specified index. Also return the base address of the row */ -/* vector's parent segment vector. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* NJRS I ZZEKVSET */ -/* BASES I ZZEKVSET */ -/* RWVIDX I ZZEKVACL */ -/* RWVBAS O ZZEKVACL */ -/* SGVBAS O ZZEKVACL */ -/* MXJOIN P Maximum number of tables that can be joined. */ -/* MXJRS P Maximum number of join row sets allowed in union. */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Parameters */ - -/* MXJOIN is the maximum number of tables that can be joined. */ - -/* MXJRS is the maximum number of join row sets allowed in */ -/* in the input union identified by BASES and NJRS. */ - -/* $ Exceptions */ - -/* 1) This is an umbrella routine which contains declarations */ -/* for its entry points. This routine should never be called */ -/* directly. If it is, the error SPICE(BOGUSENTRY) will be */ -/* signalled. */ - -/* See the entry points for discussions of the exceptions specific */ -/* to those entry points. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* In the course of query resolution, the EK system builds a set of */ -/* data structures called `join row sets' that represent the rows */ -/* that satisfy the query constraints. These rows belong to a table */ -/* formed by taking the Cartesian product of the tables in the FROM */ -/* clause of the query. One join row set is formed for each */ -/* conjunction of join constraints; the total number of join row sets */ -/* is equal to the number of conjunctions of join constraints in */ -/* the query. Join row sets are described below. */ - -/* This group of routines allows the EK system to view the rows */ -/* matching a query as a sequence of vectors, where each vector is an */ -/* n-tuple of row numbers designating rows in segments of the */ -/* Cartesian product of tables specified in the input query. These */ -/* vectors are called `row vectors'. Each row vector also points to */ -/* a vector of segments that contain the rows represented by the row */ -/* vector. */ - -/* These routines centralize the calculations needed to locate the */ -/* nth row vector. */ - -/* Each join row set consists of: */ - -/* - a base address in the scratch area */ -/* - a table count */ -/* - a segment vector count */ -/* - a set of segment vectors */ -/* - a set of segment vector row vector base addresses */ -/* (these are relative to the base of the join row set) */ -/* - a set of segment vector row vector counts */ -/* - a set of row vectors, augmented by offsets of their */ -/* parent segment vectors (these offsets are at the */ -/* end of each row vector) */ - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | TC*(RC_1 + 1 ) */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| TC*(RC_SVC + 1) */ -/* +--------------------------------------------+ elements */ - - -/* $ Examples */ - -/* 1) For a given join row set union, initialize the addressing */ -/* routines, then look up row vectors. */ - - -/* C */ -/* C Tell the addressing routines where the join row set */ -/* C union is. NJRS is the number of join row sets in */ -/* C the union, BASES is an array of EK scratch area base */ -/* C addresses of each join row set. A base address is */ -/* C the predecessor of the first address actually */ -/* C occupied by a join row set. */ -/* C */ -/* CALL ZZEKVSET ( NJRS, BASES ) */ - -/* C */ -/* C Find the base address of the each row vector, as well */ -/* C as the base address of the corresponding segment */ -/* C vector. */ -/* C */ -/* DO I = 1, NJRS */ - -/* CALL EKVCAL ( I, RWVBAS, SGVBAS ) */ - -/* [Do something with the row vector....] */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */ - -/* Filled in Particulars section of header in entry point */ -/* ZZEKVCAL. Changed previous version line's product from "Beta" */ -/* to "SPICELIB" both here and in ZZEKVCAL. */ - -/* - SPICELIB Version 1.0.0, 28-SEP-1994 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* EK row vector address calculation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* JRS$INC Version 1 17-SEP-1994 (NJB) */ - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Standard SPICE error handling. */ - - /* Parameter adjustments */ - if (bases) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzekvset; - case 2: goto L_zzekvcal; - } - - if (return_()) { - return 0; - } else { - chkin_("ZZEKVADR", (ftnlen)8); - } - -/* Never come here. */ - - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZEKVADR", (ftnlen)8); - return 0; -/* $Procedure ZZEKVSET ( Row vector address calculation set-up ) */ - -L_zzekvset: -/* $ Abstract */ - -/* Given a union of EK join row sets, prepare EKVCAL to */ -/* compute addresses of row vectors in that union. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER NJRS */ -/* INTEGER BASES ( * ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NJRS I Number of join row sets in union. */ -/* BASES I EK scratch area base addresses of join row sets. */ - -/* $ Detailed_Input */ - -/* NJRS is the number of join row sets in a join row set */ -/* for which address calculations will be performed. */ - -/* BASES is an array of base addresses of the join row sets */ -/* comprising the union. These addresses are the */ -/* predecessors of the addresses actually occupied by */ -/* the join row sets. There are NJRS base addresses */ -/* in the array. The order in which addresses are */ -/* listed in BASES determines the order of the union */ -/* of the row vectors: the first row vector in the */ -/* join row set whose base address is BASES(1) has */ -/* index 1, and so on. The last row vector in the */ -/* join row set whose base address is BASES(NJRS) has */ -/* the highest index of any row vector in the union. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a discussion of the effect of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the join row set count is less than 1 or greater than */ -/* MXJRS, the error SPICE(INVALIDCOUNT) is signalled. */ - -/* 2) If any base address is less than zero or greater than TOP, */ -/* the EK scratch area stack top, the error */ -/* SPICE(BADADDRESS) is signalled. */ - -/* 3) If the table count for any join row set is less than 1 or */ -/* greater than MXJOIN, the error SPICE(INVALIDCOUNT) is */ -/* signalled. */ - -/* 4) If the table count for any join row set unequal to the count */ -/* for the first join row set, the error SPICE(INVALIDCOUNT) is */ -/* signalled. */ - -/* 5) If any join row set has a row vector count that is less than */ -/* zero or greater than TOP, the EK scratch area stack top, the */ -/* error SPICE(BADADDRESS) is signalled. */ - -/* 6) If any join row set has a segment vector count that is less */ -/* than zero or greater than TOP, the EK scratch area stack top, */ -/* the error SPICE(BADADDRESS) is signalled. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* This routine speeds up EK row vectors address calculations by */ -/* centralizating the activities that need be performed only once */ -/* for a series of address calculations for a given join row set */ -/* union. */ - -/* $ Examples */ - -/* See the $Examples section of ZZEKVADR. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-SEP-1994 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* EK row vector address calculation */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKVSET", (ftnlen)8); - } - -/* Validate join row set count. */ - - if (*njrs < 1 || *njrs > 200) { - setmsg_("Number of join row sets was #; valid range is 1:#", (ftnlen) - 49); - errint_("#", njrs, (ftnlen)1); - errint_("#", &c__200, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKVSET", (ftnlen)8); - return 0; - } - -/* Validate the join row set bases. */ - - zzekstop_(&top); - i__1 = *njrs; - for (i__ = 1; i__ <= i__1; ++i__) { - if (bases[i__ - 1] < 0 || bases[i__ - 1] > top) { - setmsg_("Base address # was #; valid range is 1:#", (ftnlen)40); - errint_("#", &i__, (ftnlen)1); - errint_("#", &bases[i__ - 1], (ftnlen)1); - errint_("#", &top, (ftnlen)1); - sigerr_("SPICE(BADADDRESS)", (ftnlen)17); - chkout_("ZZEKVSET", (ftnlen)8); - return 0; - } - svbas[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("svbas", - i__2, "zzekvadr_", (ftnlen)526)] = bases[i__ - 1]; - } - -/* Validate and save the table count. It's an error for this */ -/* count not to be identical for all of the join row sets in the */ -/* union. */ - - addrss = bases[0] + 3; - zzeksrd_(&addrss, &addrss, &ntabs); - if (ntabs < 1 || ntabs > 10) { - setmsg_("Table count for first join row set was #; valid range is 1:#" - , (ftnlen)60); - errint_("#", &ntabs, (ftnlen)1); - errint_("#", &c__10, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKVSET", (ftnlen)8); - return 0; - } - i__1 = *njrs; - for (i__ = 2; i__ <= i__1; ++i__) { - addrss = bases[i__ - 1] + 3; - zzeksrd_(&addrss, &addrss, &j); - if (j != ntabs) { - setmsg_("Join row set # contains # tables; first join row set co" - "ntains # tables. These counts are supposed to match.", ( - ftnlen)108); - errint_("#", &i__, (ftnlen)1); - errint_("#", &j, (ftnlen)1); - errint_("#", &ntabs, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKVSET", (ftnlen)8); - return 0; - } - } - -/* Validate the row vector counts for each join row set. */ -/* These counts must be in range. Save the start indices of */ -/* the row vectors in each join row set. */ - - cleari_(&c__200, begidx); - begidx[0] = 1; - i__1 = *njrs; - for (i__ = 1; i__ <= i__1; ++i__) { - addrss = bases[i__ - 1] + 2; - zzeksrd_(&addrss, &addrss, &j); - if (j < 0 || j > top) { - setmsg_("Join row set # has row count #; valid range is 0:#", ( - ftnlen)50); - errint_("#", &i__, (ftnlen)1); - errint_("#", &j, (ftnlen)1); - errint_("#", &top, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKVSET", (ftnlen)8); - return 0; - } - if (i__ < *njrs) { - begidx[(i__2 = i__) < 200 && 0 <= i__2 ? i__2 : s_rnge("begidx", - i__2, "zzekvadr_", (ftnlen)598)] = begidx[(i__3 = i__ - 1) - < 200 && 0 <= i__3 ? i__3 : s_rnge("begidx", i__3, "zze" - "kvadr_", (ftnlen)598)] + j; - } - } - -/* Retain the index of the last row vector. */ - - maxrwv = begidx[(i__1 = *njrs - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "begidx", i__1, "zzekvadr_", (ftnlen)608)] + j; - -/* Save the base addresses of the row vectors in each join row set. */ -/* Validate the segment vector counts while we're at it. */ - - i__1 = *njrs; - for (i__ = 1; i__ <= i__1; ++i__) { - addrss = bases[i__ - 1] + 4; - zzeksrd_(&addrss, &addrss, &nsv); - if (nsv < 0) { - setmsg_("Join row set # has segment vector count #; count must b" - "e non-negative.", (ftnlen)70); - errint_("#", &i__, (ftnlen)1); - errint_("#", &nsv, (ftnlen)1); - errint_("#", &top, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKVSET", (ftnlen)8); - return 0; - } - rbas[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("rbas", i__2, - "zzekvadr_", (ftnlen)633)] = addrss + nsv * (ntabs + 2); - } - -/* Retain the count of join row sets in the union. */ - - svnjrs = *njrs; - chkout_("ZZEKVSET", (ftnlen)8); - return 0; -/* $Procedure ZZEKVCAL ( Row vector address calculation ) */ - -L_zzekvcal: -/* $ Abstract */ - -/* Find the EK scratch area base address of a row vector and the */ -/* corresponding segment vector, where the row vector has a */ -/* specified index within a union of join row sets. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER RWVIDX */ -/* INTEGER RWVBAS */ -/* INTEGER SGVBAS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* RWVIDX I Index of row vector. */ -/* RWVBAS O EK scratch area base address of row vector. */ -/* SGVBAS O Base address of parent segment vector. */ - -/* $ Detailed_Input */ - -/* RWVIDX is the index of a row vector in a join row set */ -/* union. The union is presumed to have been */ -/* specified by a call to ZZEKVSET. */ - -/* $ Detailed_Output */ - -/* RWVBAS is the EK scratch area base address of the row */ -/* vector specified by RWVIDX. This address is */ -/* the predecessor of the first address occupied by */ -/* the row vector. The row vector occupies NTAB */ -/* consecutive addresses, where NTAB is the common */ -/* table count for all join row sets in the union */ -/* containing the specified row vector. */ - -/* SGVBAS is the EK scratch area base address of the segment */ -/* vector corresponding to the specified row vector. */ -/* The segment vector also occupies NTAB consecutive */ -/* addresses. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input index is less than 1 or greater than */ -/* the highest index in the join row set union being addressed, */ -/* the error SPICE(INVALIDINDEX) is signalled. */ - -/* $ Files */ - -/* 1) This routine uses the EK scratch area, which employs a scratch */ -/* DAS file. */ - -/* $ Particulars */ - -/* See header of umbrella routine ZZEKVADR. */ - -/* $ Examples */ - -/* See the $Examples section of ZZEKVADR. */ - -/* $ Restrictions */ - -/* 1) ZZEKVSET must be called before this routine is called for the */ -/* first time. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */ - -/* Filled in Particulars section of header. Changed */ -/* previous version line's product from "Beta" to "SPICELIB." */ - -/* - SPICELIB Version 1.0.0, 22-SEP-1994 (NJB) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* EK row vector address calculation */ - -/* -& */ - -/* Use discovery check-in for speed; don't check RETURN. */ - - -/* If the index is out of range, that's an error. */ - - if (*rwvidx < 1 || *rwvidx > maxrwv) { - chkin_("ZZEKVCAL", (ftnlen)8); - setmsg_("Row vector index was #; valid range is 0:#", (ftnlen)42); - errint_("#", rwvidx, (ftnlen)1); - errint_("#", &maxrwv, (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKVCAL", (ftnlen)8); - return 0; - } - -/* Identify the join row set containing the indicated row. Our error */ -/* check guarantees a non-zero result. */ - - jrsidx = lstlei_(rwvidx, &svnjrs, begidx); - -/* Compute the offset of the indicated row vector relative to the */ -/* first row vector in the parent join row set. This offset is one */ -/* less than the relative index of the row vector, multiplied by */ -/* the augmented row vector size. */ - - reloff = (*rwvidx - begidx[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("begidx", i__1, "zzekvadr_", (ftnlen)814)]) * (ntabs + 1); - -/* Find the base address of the row vector. */ - - *rwvbas = rbas[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "rbas", i__1, "zzekvadr_", (ftnlen)819)] + reloff; - -/* Compute the base address of the parent segment vector. The base- */ -/* relative address of the segment vector is stored at the end of the */ -/* row vector. */ - - i__1 = *rwvbas + ntabs + 1; - i__2 = *rwvbas + ntabs + 1; - zzeksrd_(&i__1, &i__2, sgvbas); - *sgvbas = svbas[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge( - "svbas", i__1, "zzekvadr_", (ftnlen)828)] + *sgvbas; - return 0; -} /* zzekvadr_ */ - -/* Subroutine */ int zzekvadr_(integer *njrs, integer *bases, integer *rwvidx, - integer *rwvbas, integer *sgvbas) -{ - return zzekvadr_0_(0, njrs, bases, rwvidx, rwvbas, sgvbas); - } - -/* Subroutine */ int zzekvset_(integer *njrs, integer *bases) -{ - return zzekvadr_0_(1, njrs, bases, (integer *)0, (integer *)0, (integer *) - 0); - } - -/* Subroutine */ int zzekvcal_(integer *rwvidx, integer *rwvbas, integer * - sgvbas) -{ - return zzekvadr_0_(2, (integer *)0, (integer *)0, rwvidx, rwvbas, sgvbas); - } - diff --git a/ext/spice/src/cspice/zzekvcmp.c b/ext/spice/src/cspice/zzekvcmp.c deleted file mode 100644 index 7ad461b11a..0000000000 --- a/ext/spice/src/cspice/zzekvcmp.c +++ /dev/null @@ -1,1219 +0,0 @@ -/* zzekvcmp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__11 = 11; -static integer c__24 = 24; - -/* $Procedure ZZEKVCMP ( EK, row vector comparison ) */ -logical zzekvcmp_(integer *op, integer *ncols, integer *tabs, integer *cols, - integer *elts, integer *senses, integer *sthan, integer *stsdsc, - integer *stdtpt, integer *dtpool, integer *dtdscs, integer *sgvec1, - integer *rwvec1, integer *sgvec2, integer *rwvec2) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer hans[2], segs[2], rows[2]; - extern integer zzekecmp_(integer *, integer *, integer *, integer *, - integer *); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), movei_(integer *, - integer *, integer *); - integer dtype[2]; - extern integer lnknxt_(integer *, integer *); - integer cldscs[22] /* was [11][2] */, col, colidx, colptr[2], elidxs[2], - rel, sgdscs[48] /* was [24][2] */, tabidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - -/* $ Abstract */ - -/* Compare two row vectors, using dictionary ordering on a */ -/* specified list of columns as the order relation. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* OP I Code for relational operator. */ -/* NCOLS I Number of columns used to define order relation. */ -/* TABS I Indices of tables containing order-by columns. */ -/* COLS I Indices of order-by columns within parent tables. */ -/* ELTS I Element indices. */ -/* SENSES I Order senses. */ -/* STHAN I Array of handles of loaded EKs. */ -/* STSDSC I Array of segment descriptors. */ -/* STDTPT I Array of pointers to column descriptors. */ -/* DTPOOL I Column descriptor index pool. */ -/* DTDSCS I Array of column descriptors. */ -/* SGVEC1 I First segment vector. */ -/* RWVEC1 I First row vector. */ -/* SGVEC2 I Second segment vector. */ -/* RWVEC2 I Second row vector. */ - -/* The function returns .TRUE. if and only if the two rows */ -/* satisfy the order relation specified by the input arguments. */ - -/* $ Detailed_Input */ - -/* OP is an integer code representing a binary operator */ -/* that expresses an order relation. The allowed */ -/* values of OP are the parameters */ - -/* EQ */ -/* GE */ -/* GT */ -/* LE */ -/* LT */ -/* NE */ - -/* This routine test whether the input rows satisfy */ -/* the order relation */ - -/* OP */ - - -/* NCOLS is the number of columns used to define a */ -/* dictionary ordering. */ - -/* TABS is an array of indices identifying the parent */ -/* tables of the order-by columns. These indices */ -/* are the ordinal positions of the parent tables */ -/* in the FROM clause of the query to which the */ -/* input joint row set corresponds. */ - -/* COLS is an array of indices identifying the order-by */ -/* columns. These indices are the ordinal positions */ -/* of the columns in their virtual parent tables. */ -/* The order of columns in virtual tables is set */ -/* when EKs are loaded by the routine EKLEF. The */ -/* Nth element of COLS applies to the Nth order-by */ -/* column. */ - -/* ELTS is an array of element indices identifying the */ -/* order-by column entry elements to use when making */ -/* order comparisons. These indices are ignored for */ -/* scalar order-by columns, but must be set properly */ -/* for vector-valued order-by columns. For example, */ -/* if an order-by column has size 5, one could make */ -/* order comparisons using the third elements of */ -/* entries in this column. The Nth element of ELTS */ -/* applies to the Nth order-by column. */ - -/* SENSES is an array of parameters indicating the ordering */ -/* sense for each order-by column. An ordering sense */ -/* can be ascending (the default) or descending. The */ -/* values indicating these senses are EQASND and */ -/* EQDSND respectively. These parameters are defined */ -/* in the include file ekquery.inc. The Nth element */ -/* of SENSES applies to the Nth order-by column. */ - -/* STHAN is an array of EK handles corresponding to loaded */ -/* segments. STHAN is expected to be the array of */ -/* the same name maintained by EKQMGR. */ - -/* STSDSC is an array of descriptors of loaded segments. */ -/* STSDSC is expected to be the array of the same name */ -/* maintained by EKQMGR. */ - -/* STDTPT is an array of pointers that map segments to lists */ -/* of column descriptors in the column descriptor */ -/* pool. The Nth element of STDTPT is the head node */ -/* number for the column descriptor list of the Nth */ -/* loaded segment. The column descriptor list is */ -/* indexed by the linked list pool DTPOOL. STDTPT is */ -/* expected to be the array of the same name */ -/* maintained by EKQMGR. */ - -/* DTPOOL is a linked list pool used to index the column */ -/* descriptor array DTDSCS. DTPOOL is expected to be */ -/* the array of the same name maintained by EKQMGR. */ - -/* DTDSCS is an array of column descriptors for each loaded */ -/* column. There is a separate descriptor for each */ -/* column in each segment. The Nth node of DTPOOL */ -/* is considered to point to the Nth element of */ -/* DTDSCS. DTDSCS is expected to be the array of the */ -/* same name maintained by EKQMGR. */ - -/* SEGVC1, */ -/* ROWVC1 are, respectively, a segment vector and a row */ -/* vector that define the first row to be compared. */ -/* The segment vector qualifies the row vector. */ - -/* SEGVC2, */ -/* ROWVC2 are, respectively, a segment vector and a row */ -/* vector that define the second row to be compared. */ - -/* $ Detailed_Output */ - -/* The function returns .TRUE. if and only if the two row vectors */ -/* satisfy the order relation specified by the input arguments: */ - -/* OP */ - -/* $ Parameters */ - -/* Within the EK system, relational operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. In the character case, the same operators */ -/* may be used; the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - -/* Null values are considered to precede all non-null values. */ - -/* $ Exceptions */ - -/* 1) If the either of input file handles is invalid, the error */ -/* will be diagnosed by routines called by this routine. */ -/* The function value is .FALSE. in this case. */ - -/* 2) If an I/O error occurs while attempting to find the address */ -/* range of the specified column entry element, the error will */ -/* be diagnosed by routines called by this routine. The */ -/* function value is .FALSE. in this case. */ - -/* 3) If any of the input segment descriptors, column descriptors, */ -/* or row numbers are invalid, this routine may fail in */ -/* unpredictable, but possibly spectacular, ways. Except */ -/* as described in this header section, no attempt is made to */ -/* handle these errors. */ - -/* 4) If the data type code in the input column descriptor is not */ -/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* 5) If the relational operator code OP is not recognized, the */ -/* error SPICE(UNNATURALRELATION) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* $ Files */ - -/* This routine indirectly references EK files loaded via EKLEF. */ - -/* $ Particulars */ - -/* This routine is an EK utility intended to centralize a frequently */ -/* performed comparison operation. */ - -/* $ Examples */ - -/* See ZZEKJSRT. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. */ - - -/* The function value defaults to .FALSE. */ - - ret_val = FALSE_; - -/* The input column descriptors identify the columns to be used */ -/* to define an order relation on the input rows. The order */ -/* relation is `dictionary' ordering: if the elements of the */ -/* first n columns of both rows are equal, the corresponding */ -/* elements in the (n+1)st columns are compared to attempt to */ -/* break the tie. */ - -/* The first step is to determine the relation that holds between */ -/* the rows. We start out assuming we have equality. */ - - rel = 1; - col = 1; - while(col <= *ncols && rel == 1) { - -/* Compare the entries in the two rows in the columns indicated */ -/* by the Nth column descriptor pair. */ - - tabidx = tabs[col - 1]; - colidx = cols[col - 1]; - segs[0] = sgvec1[tabidx - 1]; - segs[1] = sgvec2[tabidx - 1]; - rows[0] = rwvec1[tabidx - 1]; - rows[1] = rwvec2[tabidx - 1]; - -/* Identify the handles, segment descriptors, and column */ -/* descriptors we'll use to apply the constraint having index */ -/* COL. */ - - for (i__ = 1; i__ <= 2; ++i__) { - hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("hans", - i__1, "zzekvcmp_", (ftnlen)356)] = sthan[segs[(i__2 = i__ - - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("segs", i__2, "zze" - "kvcmp_", (ftnlen)356)] - 1]; - colptr[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("colptr", - i__1, "zzekvcmp_", (ftnlen)357)] = stdtpt[segs[(i__2 = - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("segs", i__2, - "zzekvcmp_", (ftnlen)357)] - 1]; - i__1 = colidx; - for (j = 2; j <= i__1; ++j) { - colptr[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge( - "colptr", i__2, "zzekvcmp_", (ftnlen)360)] = lnknxt_(& - colptr[(i__3 = i__ - 1) < 2 && 0 <= i__3 ? i__3 : - s_rnge("colptr", i__3, "zzekvcmp_", (ftnlen)360)], - dtpool); - } - movei_(&dtdscs[colptr[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("colptr", i__1, "zzekvcmp_", (ftnlen)363)] * 11 - - 11], &c__11, &cldscs[(i__2 = i__ * 11 - 11) < 22 && 0 <= - i__2 ? i__2 : s_rnge("cldscs", i__2, "zzekvcmp_", (ftnlen) - 363)]); - movei_(&stsdsc[segs[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("segs", i__1, "zzekvcmp_", (ftnlen)364)] * 24 - 24] - , &c__24, &sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= - i__2 ? i__2 : s_rnge("sgdscs", i__2, "zzekvcmp_", (ftnlen) - 364)]); - dtype[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("dtype", - i__1, "zzekvcmp_", (ftnlen)366)] = dtdscs[colptr[(i__2 = - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("colptr", i__2, - "zzekvcmp_", (ftnlen)366)] * 11 - 10]; - elidxs[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("elidxs", - i__1, "zzekvcmp_", (ftnlen)367)] = elts[col - 1]; - } - if (dtype[0] == dtype[1]) { - -/* Find the order of the rows according to the order-by */ -/* column having index COL. If the order sense for this */ -/* column is descending, adjust REL to reflect this. */ - - rel = zzekecmp_(hans, sgdscs, cldscs, rows, elidxs); - if (senses[col - 1] == 1) { - if (rel == 5) { - rel = 3; - } else if (rel == 3) { - rel = 5; - } - } - } else { - chkin_("ZZEKVCMP", (ftnlen)8); - setmsg_("Data type mismatch for order-by column having index #; " - "type for segment # = #; type for segment # is #", (ftnlen) - 102); - errint_("#", &col, (ftnlen)1); - errint_("#", segs, (ftnlen)1); - errint_("#", dtype, (ftnlen)1); - errint_("#", &segs[1], (ftnlen)1); - errint_("#", &dtype[1], (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZEKVCMP", (ftnlen)8); - return ret_val; - } - ++col; - } - -/* Determine the truth of the input relational expression. */ - - if (*op == 1) { - ret_val = rel == 1; - } else if (*op == 5) { - ret_val = rel == 5; - } else if (*op == 4) { - ret_val = rel != 3; - } else if (*op == 3) { - ret_val = rel == 3; - } else if (*op == 2) { - ret_val = rel != 5; - } else if (*op == 6) { - ret_val = rel != 1; - } else { - -/* Sorry, we couldn't resist. */ - - ret_val = FALSE_; - chkin_("ZZEKVCMP", (ftnlen)8); - setmsg_("The relational operator # was not recognized.", (ftnlen)45); - errint_("#", op, (ftnlen)1); - sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24); - chkout_("ZZEKVCMP", (ftnlen)8); - return ret_val; - } - return ret_val; -} /* zzekvcmp_ */ - diff --git a/ext/spice/src/cspice/zzekvmch.c b/ext/spice/src/cspice/zzekvmch.c deleted file mode 100644 index a3cabd0569..0000000000 --- a/ext/spice/src/cspice/zzekvmch.c +++ /dev/null @@ -1,1058 +0,0 @@ -/* zzekvmch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__24 = 24; -static integer c__11 = 11; - -/* $Procedure ZZEKVMCH ( EK, vector match ) */ -logical zzekvmch_(integer *ncnstr, logical *active, integer *lhans, integer * - lsdscs, integer *lcdscs, integer *lrows, integer *lelts, integer *ops, - integer *rhans, integer *rsdscs, integer *rcdscs, integer *rrows, - integer *relts) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char cval[1024*2]; - integer hans[2], elts[2]; - logical null[2]; - integer unit, rows[2]; - extern integer zzekecmp_(integer *, integer *, integer *, integer *, - integer *); - integer i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer cvlen[2]; - logical found; - extern /* Subroutine */ int movei_(integer *, integer *, integer *); - extern logical matchi_(char *, char *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen); - integer cldscs[22] /* was [11][2] */, cmplen[2], sgdscs[48] /* - was [24][2] */; - extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, - ftnlen), errfnm_(char *, integer *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer rel; - extern /* Subroutine */ int zzekrsc_(integer *, integer *, integer *, - integer *, integer *, integer *, char *, logical *, logical *, - ftnlen); - -/* $ Abstract */ - -/* Determine whether a vector of constraints involving comparisons of */ -/* specified EK column elements is satisfied. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Operator Codes */ - -/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ - - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operators */ - -/* LIKE, UNLIKE */ - -/* which are used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - - -/* End Include Section: EK Operator Codes */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ 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. */ - - -/* Include Section: EK Column Descriptor Parameters */ - -/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ - - -/* Note: The column descriptor size parameter CDSCSZ is */ -/* declared separately in the include section CDSIZE$INC.FOR. */ - -/* Offset of column descriptors, relative to start of segment */ -/* integer address range. This number, when added to the last */ -/* integer address preceding the segment, yields the DAS integer */ -/* base address of the first column descriptor. Currently, this */ -/* offset is exactly the size of a segment descriptor. The */ -/* parameter SDSCSZ, which defines the size of a segment descriptor, */ -/* is declared in the include file eksegdsc.inc. */ - - -/* Size of column descriptor */ - - -/* Indices of various pieces of column descriptors: */ - - -/* CLSIDX is the index of the column's class code. (We use the */ -/* word `class' to distinguish this item from the column's data */ -/* type.) */ - - -/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ -/* or TIME). The type is actually implied by the class, but it */ -/* will frequently be convenient to look up the type directly. */ - - - -/* LENIDX is the index of the column's string length value, if the */ -/* column has character type. A value of IFALSE in this element of */ -/* the descriptor indicates that the strings have variable length. */ - - -/* SIZIDX is the index of the column's element size value. This */ -/* descriptor element is meaningful for columns with fixed-size */ -/* entries. For variable-sized columns, this value is IFALSE. */ - - -/* NAMIDX is the index of the base address of the column's name. */ - - -/* IXTIDX is the data type of the column's index. IXTIDX */ -/* contains a type value only if the column is indexed. For columns */ -/* that are not indexed, the location IXTIDX contains the boolean */ -/* value IFALSE. */ - - -/* IXPIDX is a pointer to the column's index. IXTPDX contains a */ -/* meaningful value only if the column is indexed. The */ -/* interpretation of the pointer depends on the data type of the */ -/* index. */ - - -/* NFLIDX is the index of a flag indicating whether nulls are */ -/* permitted in the column. The value at location NFLIDX is */ -/* ITRUE if nulls are permitted and IFALSE otherwise. */ - - -/* ORDIDX is the index of the column's ordinal position in the */ -/* list of columns belonging to the column's parent segment. */ - - -/* METIDX is the index of the column's integer metadata pointer. */ -/* This pointer is a DAS integer address. */ - - -/* The last position in the column descriptor is reserved. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Column Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Template Matching Wild Characters */ - - -/* ekwild.inc Version 1 16-JAN-1995 (NJB) */ - - -/* Within the EK system, templates used for pattern matching */ -/* are those accepted by the SPICELIB routine MATCHW. MATCHW */ -/* accepts two special characters: one representing wild */ -/* strings and one representing wild characters. This include */ -/* file defines those special characters for use within the EK */ -/* system. */ - - -/* Wild string symbol: this character matches any string. */ - - -/* Wild character symbol: this character matches any character. */ - - -/* End Include Section: EK Template Matching Wild Characters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NCNSTR I Number of join constraints. */ -/* ACTIVE I Array of flags indicating applicable constraints. */ -/* LHANS I Handles of EKs for columns on LHS's of constraints. */ -/* LSDSCS I Descriptors of segments on LHS's of constraints. */ -/* LCDSCS I Column descriptors for LHS's of constraints. */ -/* LROWS I Row numbers for LHS's of constraints. */ -/* LCOLS I Column names for LHS's of constraints. */ -/* LELTS I Column element indices for LHS's of constraints. */ -/* OPS I Code for relational operator in constraints. */ -/* RHAN I Handles of EKs for columns on RHS's of constraints. */ -/* RSDSCS I Descriptors of segments on RHS's of constraints. */ -/* RCDSCS I Column descriptors for RHS's of constraints. */ -/* RROWS I Row numbers for RHS's of constraints. */ -/* RCOLS I Column names for RHS's of constraints. */ -/* RELTS I Column element indices for RHS's of constraints. */ - -/* The function returns .TRUE. if and only if all of the relational */ -/* constraints specified by the input arguments are satisfied. */ - -/* $ Detailed_Input */ - -/* NCNSTR is the number of input join constraints. Each */ -/* input constraint relates two EK column entries; */ -/* abstractly, the form of the constraints is: */ - -/* */ - -/* The compared entries are defined by handles, */ -/* segment base addresses, column descriptors, and row */ -/* numbers. */ - -/* ACTIVE is an array of logical flags indicating which */ -/* constraints are currently applicable. The Nth */ -/* element of ACTIVE indicates whether or not to apply */ -/* the Nth constraint: if ACTIVE(N) is .TRUE., the */ -/* constraint is applicable, otherwise it isn't. */ - -/* The elements of the other input arguments that */ -/* define constraints are defined when the */ -/* corresponding element of ACTIVE is .TRUE. For */ -/* example, when the second constraint is not active, */ -/* the second column descriptor in LDSCRS may not be */ -/* defined. */ - -/* LHANS is an array of EK file handles for the left-hand- */ -/* sides of the constraints. */ - -/* LSDSCS is an array of segment descriptors for the */ -/* left-hand-sides of the constraints. */ - -/* LDSCRS is an array of column descriptors for the */ -/* left-hand-sides of the constraints. */ - -/* LROWS is an array of row numbers for the left-hand-sides */ -/* of the constraints. */ - -/* LELTS is an array of column entry element indices for the */ -/* left-hand-sides of the constraints. These */ -/* indices are ignored unless the columns they apply */ -/* to are array-valued. */ - -/* OPS is an array of relational operators used in the */ -/* input constraints. The elements of OPS are any of */ -/* the integer parameters */ - -/* EQ, GE, GT, LE, LT, NE, LIKE, ISNULL, NOTNUL */ - -/* The Ith element of OPS corresponds to the Ith */ -/* constraint. */ - -/* RHANS is an array of EK file handles for the right-hand- */ -/* sides of the constraints. */ - -/* RSDSCS is an array of segment descriptors for the */ -/* right-hand-sides of the constraints. */ - -/* RDSCRS is an array of column descriptors for the */ -/* right-hand-sides of the constraints. */ - -/* RROWS is an array of row numbers for the right-hand-sides */ -/* of the constraints. */ - -/* RELTS is an array of column entry element indices for the */ -/* right-hand-sides of the constraints. These */ -/* indices are ignored unless the columns they apply */ -/* to are array-valued. */ - - -/* $ Detailed_Output */ - -/* The function returns .TRUE. if and only if all of the relational */ -/* constraints specified by the input arguments are satisfied. */ - -/* $ Parameters */ - -/* Within the EK system, operators used in EK queries are */ -/* represented by integer codes. The codes and their meanings are */ -/* listed below. */ - -/* Relational expressions in EK queries have the form */ - -/* */ - -/* For columns containing numeric values, the operators */ - -/* EQ, GE, GT, LE, LT, NE */ - -/* may be used; these operators have the same meanings as their */ -/* Fortran counterparts. For columns containing character values, */ -/* the list of allowed operators includes those in the above list, */ -/* and in addition includes the operator */ - -/* LIKE */ - -/* which is used to compare strings to a template. In the character */ -/* case, the meanings of the parameters */ - -/* GE, GT, LE, LT */ - -/* match those of the Fortran lexical functions */ - -/* LGE, LGT, LLE, LLT */ - - -/* The additional unary operators */ - -/* ISNULL, NOTNUL */ - -/* are used to test whether a value of any type is null. */ - - -/* $ Exceptions */ - -/* 1) If any of the input file handles is invalid, the error */ -/* will be diagnosed by routines called by this routine. */ -/* The function value is .FALSE. in this case. */ - -/* 2) If an I/O error occurs while attempting to find the address */ -/* range of a column entry element, the error will */ -/* be diagnosed by routines called by this routine. The */ -/* function value is .FALSE. in this case. */ - -/* 3) If any of the input segment descriptors, column descriptors, */ -/* or row numbers are invalid, this routine may fail in */ -/* unpredictable, but possibly spectacular, ways. Except */ -/* as described in this header section, no attempt is made to */ -/* handle these errors. */ - -/* 4) If the data type code in an input column descriptor is not */ -/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* 5) If a relational operator code is not recognized, the */ -/* error SPICE(UNNATURALRELATION) is signalled. */ -/* The function value is .FALSE. in this case. */ - -/* $ Files */ - -/* See the descriptions of the arguments LHAN and RHAN in */ -/* $Detailed_Input. */ - -/* $ Particulars */ - -/* This routine is an EK utility intended to centralize a frequently */ -/* performed comparison operation. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* 1) This routine must execute quickly. Therefore, it checks in */ -/* only if it detects an error. If an error is signalled by a */ -/* routine called by this routine, this routine will not appear */ -/* in the SPICELIB traceback display. Also, in the interest */ -/* of speed, this routine does not test the value of the SPICELIB */ -/* function RETURN upon entry. */ - -/* 2) This routine depends on the requested comparison to have */ -/* been semantically checked. Semantically invalid comparisons */ -/* are treated as bugs. */ - -/* 3) Only the first MAXSTR characters of character strings are */ -/* used in comparisons. */ -/* C */ -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 01-JUN-2010 (NJB) */ - -/* Bug fix: subscript out of range error caused by */ -/* column entry strings longer than MAXLEN has been */ -/* corrected. Also updated Restrictions header section. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Non-SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in for speed. Don't check RETURN. */ - -/* The function value defaults to .TRUE. As we test the constraints, */ -/* we may find one that the input row vector doesn't satisfy, at */ -/* which point we can terminate the comparison. */ - - ret_val = TRUE_; - n = 1; - while(n <= *ncnstr && ret_val) { - if (active[n - 1]) { - -/* Apply the Nth join constraint to the input row vector. */ - -/* Compare the entries in the two rows in the columns indicated */ -/* by the Nth column descriptor pair. To do this, find the */ -/* address ranges for each column entry. We don't check the */ -/* found flag because every column entry has at least one */ -/* element. */ - - -/* We'll start out setting REL to EQ. If we find out */ -/* otherwise, we'll change it. */ - - hans[0] = lhans[n - 1]; - hans[1] = rhans[n - 1]; - movei_(&lsdscs[n * 24 - 24], &c__24, sgdscs); - movei_(&rsdscs[n * 24 - 24], &c__24, &sgdscs[24]); - rows[0] = lrows[n - 1]; - rows[1] = rrows[n - 1]; - elts[0] = lelts[n - 1]; - elts[1] = relts[n - 1]; - movei_(&lcdscs[n * 11 - 11], &c__11, cldscs); - movei_(&rcdscs[n * 11 - 11], &c__11, &cldscs[11]); - rel = zzekecmp_(hans, sgdscs, cldscs, rows, elts); - -/* Determine the truth of the Nth input relational expression, */ -/* and set ZZEKVMCH accordingly. */ - - if (ops[n - 1] == 1) { - ret_val = rel == 1; - } else if (ops[n - 1] == 5) { - ret_val = rel == 5; - } else if (ops[n - 1] == 4) { - ret_val = rel != 3; - } else if (ops[n - 1] == 3) { - ret_val = rel == 3; - } else if (ops[n - 1] == 2) { - ret_val = rel != 5; - } else if (ops[n - 1] == 6) { - ret_val = rel != 1; - } else if (ops[n - 1] == 7 && cldscs[1] == 1) { - for (i__ = 1; i__ <= 2; ++i__) { - zzekrsc_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("hans", i__1, "zzekvmch_", (ftnlen)399)], & - sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= i__2 ? - i__2 : s_rnge("sgdscs", i__2, "zzekvmch_", ( - ftnlen)399)], &cldscs[(i__3 = i__ * 11 - 11) < 22 - && 0 <= i__3 ? i__3 : s_rnge("cldscs", i__3, - "zzekvmch_", (ftnlen)399)], &rows[(i__4 = i__ - 1) - < 2 && 0 <= i__4 ? i__4 : s_rnge("rows", i__4, - "zzekvmch_", (ftnlen)399)], &elts[(i__5 = i__ - 1) - < 2 && 0 <= i__5 ? i__5 : s_rnge("elts", i__5, - "zzekvmch_", (ftnlen)399)], &cvlen[(i__6 = i__ - - 1) < 2 && 0 <= i__6 ? i__6 : s_rnge("cvlen", i__6, - "zzekvmch_", (ftnlen)399)], cval + (((i__7 = i__ - - 1) < 2 && 0 <= i__7 ? i__7 : s_rnge("cval", - i__7, "zzekvmch_", (ftnlen)399)) << 10), &null[( - i__8 = i__ - 1) < 2 && 0 <= i__8 ? i__8 : s_rnge( - "null", i__8, "zzekvmch_", (ftnlen)399)], &found, - (ftnlen)1024); - if (! found) { - dashlu_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("hans", i__1, "zzekvmch_", ( - ftnlen)412)], &unit); - chkin_("ZZEKVMCH", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. " - "Column entry element was not found.", ( - ftnlen)79); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[(i__1 = i__ * 11 - 3) < 22 && 0 - <= i__1 ? i__1 : s_rnge("cldscs", i__1, "zze" - "kvmch_", (ftnlen)419)], (ftnlen)1); - errint_("#", &rows[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("rows", i__1, "zzekvmch_", ( - ftnlen)420)], (ftnlen)1); - errint_("#", &elts[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("elts", i__1, "zzekvmch_", ( - ftnlen)421)], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKVMCH", (ftnlen)8); - return ret_val; - } - if (found && ! null[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("null", i__1, "zzekvmch_", (ftnlen) - 428)]) { -/* Computing MIN */ - i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 - : s_rnge("cvlen", i__2, "zzekvmch_", (ftnlen) - 430)]; - cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) - 430)] = min(i__3,1024); - } else { - cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) - 432)] = 0; - } - } - ret_val = matchi_(cval, cval + 1024, "*", "%", cmplen[0], - cmplen[1], (ftnlen)1, (ftnlen)1); - } else if (ops[n - 1] == 8 && cldscs[1] == 1) { - for (i__ = 1; i__ <= 2; ++i__) { - zzekrsc_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("hans", i__1, "zzekvmch_", (ftnlen)450)], & - sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= i__2 ? - i__2 : s_rnge("sgdscs", i__2, "zzekvmch_", ( - ftnlen)450)], &cldscs[(i__3 = i__ * 11 - 11) < 22 - && 0 <= i__3 ? i__3 : s_rnge("cldscs", i__3, - "zzekvmch_", (ftnlen)450)], &rows[(i__4 = i__ - 1) - < 2 && 0 <= i__4 ? i__4 : s_rnge("rows", i__4, - "zzekvmch_", (ftnlen)450)], &elts[(i__5 = i__ - 1) - < 2 && 0 <= i__5 ? i__5 : s_rnge("elts", i__5, - "zzekvmch_", (ftnlen)450)], &cvlen[(i__6 = i__ - - 1) < 2 && 0 <= i__6 ? i__6 : s_rnge("cvlen", i__6, - "zzekvmch_", (ftnlen)450)], cval + (((i__7 = i__ - - 1) < 2 && 0 <= i__7 ? i__7 : s_rnge("cval", - i__7, "zzekvmch_", (ftnlen)450)) << 10), &null[( - i__8 = i__ - 1) < 2 && 0 <= i__8 ? i__8 : s_rnge( - "null", i__8, "zzekvmch_", (ftnlen)450)], &found, - (ftnlen)1024); - if (! found) { - dashlu_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("hans", i__1, "zzekvmch_", ( - ftnlen)463)], &unit); - chkin_("ZZEKVMCH", (ftnlen)8); - setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. " - "Column entry element was not found.", ( - ftnlen)79); - errfnm_("#", &unit, (ftnlen)1); - errint_("#", &cldscs[(i__1 = i__ * 11 - 3) < 22 && 0 - <= i__1 ? i__1 : s_rnge("cldscs", i__1, "zze" - "kvmch_", (ftnlen)470)], (ftnlen)1); - errint_("#", &rows[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("rows", i__1, "zzekvmch_", ( - ftnlen)471)], (ftnlen)1); - errint_("#", &elts[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("elts", i__1, "zzekvmch_", ( - ftnlen)472)], (ftnlen)1); - sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); - chkout_("ZZEKVMCH", (ftnlen)8); - return ret_val; - } - if (found && ! null[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("null", i__1, "zzekvmch_", (ftnlen) - 480)]) { -/* Computing MIN */ - i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 - : s_rnge("cvlen", i__2, "zzekvmch_", (ftnlen) - 482)]; - cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) - 482)] = min(i__3,1024); - } else { - cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) - 484)] = 0; - } - } - ret_val = ! matchi_(cval, cval + 1024, "*", "%", cmplen[0], - cmplen[1], (ftnlen)1, (ftnlen)1); - } else { - -/* Sorry, we couldn't resist. */ - - ret_val = FALSE_; - chkin_("ZZEKVMCH", (ftnlen)8); - setmsg_("The relational operator # was not recognized.", ( - ftnlen)45); - errint_("#", &ops[n - 1], (ftnlen)1); - sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24); - chkout_("ZZEKVMCH", (ftnlen)8); - return ret_val; - } - } - -/* We've completed the test for the Nth constraint, if that */ -/* constraint was active. */ - - ++n; - } - return ret_val; -} /* zzekvmch_ */ - diff --git a/ext/spice/src/cspice/zzekweed.c b/ext/spice/src/cspice/zzekweed.c deleted file mode 100644 index fcb216d412..0000000000 --- a/ext/spice/src/cspice/zzekweed.c +++ /dev/null @@ -1,625 +0,0 @@ -/* zzekweed.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZEKWEED ( Private: EK, weed out redundant row vectors ) */ -/* Subroutine */ int zzekweed_(integer *njrs, integer *bases, integer *nrows) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Local variables */ - integer cand, base, ndel, ntab, pred; - extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *), - zzekvset_(integer *, integer *); - integer i__, j; - extern /* Subroutine */ int zzekjsqz_(integer *), chkin_(char *, ftnlen); - integer nrloc; - extern logical sameai_(integer *, integer *, integer *); - integer nr, csgbas, candsv[10], psgbas, crwbas, crwvec[11], ncndrv, - ncndsv, prwbas; - extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *, - ftnlen); - integer nsvloc, predsv[10], prwvec[11]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), chkout_( - char *, ftnlen); - integer nprdrv, nprdsv, rvsize, svsize, loc; - logical hit; - integer crv, csv, prv, psv; - extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Weed out redundant, fully qualified row vectors from a join row */ -/* set union. */ - -/* $ 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 */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Join Row Set Parameters */ - -/* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ - - -/* Maximum number of join row sets in a join row set union: */ - - -/* The layout of a join row set in the EK scratch area is shown */ -/* below: */ - -/* +--------------------------------------------+ */ -/* | join row set size | 1 element */ -/* +--------------------------------------------+ */ -/* | number of row vectors in join row set | 1 element */ -/* +--------------------------------------------+ */ -/* | table count (TC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector count (SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 | TC elements */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC | TC elements */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector 1 row count (RC_1) | 1 element */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row set base address | 1 element */ -/* +--------------------------------------------+ */ -/* | segment vector SVC row count (RC_SVC) | 1 element */ -/* +--------------------------------------------+ */ -/* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ -/* +--------------------------------------------+ elements */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ -/* +--------------------------------------------+ elements */ - - -/* The following parameters indicate positions of elements in the */ -/* join row set structure: */ - - -/* Base-relative index of join row set size */ - - -/* Index of row vector count */ - - -/* Index of table count */ - - -/* Index of segment vector count */ - - -/* Base address of first segment vector */ - - - -/* End Include Section: EK Join Row Set Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Query Limit Parameters */ - -/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ - -/* Parameter MAXCON increased to 1000. */ - -/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ - -/* Updated to support SELECT clause. */ - - -/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ - - -/* These limits apply to character string queries input to the */ -/* EK scanner. This limits are part of the EK system's user */ -/* interface: the values should be advertised in the EK required */ -/* reading document. */ - - -/* Maximum length of an input query: MAXQRY. This value is */ -/* currently set to twenty-five 80-character lines. */ - - -/* Maximum number of columns that may be listed in the */ -/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ - - -/* Maximum number of tables that may be listed in the `FROM */ -/* clause' of a query: MAXTAB. */ - - -/* Maximum number of relational expressions that may be listed */ -/* in the `constraint clause' of a query: MAXCON. */ - -/* This limit applies to a query when it is represented in */ -/* `normalized form': that is, the constraints have been */ -/* expressed as a disjunction of conjunctions of relational */ -/* expressions. The number of relational expressions in a query */ -/* that has been expanded in this fashion may be greater than */ -/* the number of relations in the query as orginally written. */ -/* For example, the expression */ - -/* ( ( A LT 1 ) OR ( B GT 2 ) ) */ -/* AND */ -/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ - -/* which contains 4 relational expressions, expands to the */ -/* equivalent normalized constraint */ - -/* ( ( A LT 1 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( C NE 3 ) ) */ -/* OR */ -/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ - -/* which contains eight relational expressions. */ - - - -/* MXJOIN is the maximum number of tables that can be joined. */ - - -/* MXJCON is the maximum number of join constraints allowed. */ - - -/* Maximum number of order-by columns that may be used in the */ -/* `order-by clause' of a query: MAXORD. MAXORD = 10. */ - - -/* Maximum number of tokens in a query: 500. Tokens are reserved */ -/* words, column names, parentheses, and values. Literal strings */ -/* and time values count as single tokens. */ - - -/* Maximum number of numeric tokens in a query: */ - - -/* Maximum total length of character tokens in a query: */ - - -/* Maximum length of literal string values allowed in queries: */ -/* MAXSTR. */ - - -/* End Include Section: EK Query Limit Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NJRS I-O Number of join row sets in union. */ -/* BASES I-O Scratch area base addresses of join row sets. */ -/* NROWS O Total number of row vectors in join row set union. */ - -/* $ Detailed_Input */ - -/* NJRS is the number of join row sets in a join row set */ -/* union to be weeded. */ - -/* BASES is an array of base addresses, in the scratch area, */ -/* of a collection of join row sets from which */ -/* redundant row vectors are to be weeded out. A row */ -/* vector is is redundant if and only if it is */ -/* identical to another row vector, and the qualifying */ -/* segment vectors of the two row vectors are */ -/* identical as well. */ - -/* $ Detailed_Output */ - -/* NJRS is the number of join row sets after redundant */ -/* rows have been removed. If any join row sets */ -/* become empty as a result of this weeding-out, */ -/* the count of join row sets is reduced accordingly. */ - -/* BASES is the set of bases of join rows in the join row */ -/* set union after weeding has been completed. */ -/* Bases of empty join row sets are compressed out; */ -/* the valid elements of the array are the first */ -/* NJRS elements of BASES, where NJRS has been */ -/* updated by this routine. */ - -/* NROWS is the total number of rows in the join row set */ -/* union after the weeding process is finished. */ - -/* See $Particulars for a more detailed description of the effect of */ -/* this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If JRSBAS is not the base address of a structurally valid */ -/* join row set union, the results of this routine will be */ -/* unpredictable. */ - -/* 2) If NJRS is non-positive, or if NJRS exceeds the maximum */ -/* allowed number of constraint relations MAXCON, the error */ -/* SPICE(INVALIDCOUNT) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine operates by side effects: it modifies the join row */ -/* set designated by the input argument JRSBAS. Every redundant */ -/* row vector is removed, and join row sets from which row vectors */ -/* are removed are compressed. Empty join row sets are removed */ -/* from the union, as reflected by updates to NJRS and BASES. */ - -/* The principal purpose of this routine is to support execution of */ -/* queries involving OR clauses; such queries may cause row vectors */ -/* satisfying both disjuncts to be included multiple times in the */ -/* set of matching row vectors. */ - -/* The layout of a join row set in the EK scratch area is shown */ -/* in the join row set parameter include file. */ - -/* $ Examples */ - -/* See EKSRCH. */ - -/* $ Restrictions */ - -/* 1) Loading or unloading EK files between name resolution of the */ -/* the input query and passing the query to this routine will */ -/* invalidate the checking done by this routine, and may cause */ -/* the routine to fail. */ - -/* 2) Assumes redundant row vectors never occur in any join row set. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 8-JAN-1996 (WLT) */ - -/* Replaced a call to REPMI with ERRINT in the first */ -/* error check. */ - -/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - if (*njrs < 1 || *njrs > 200) { - chkin_("ZZEKWEED", (ftnlen)8); - setmsg_("The number of join row sets in the union is #", (ftnlen)45); - errint_("#", njrs, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZEKWEED", (ftnlen)8); - return 0; - } - -/* Make sure that the addressing routines are properly initialized. */ - - zzekvset_(njrs, bases); - -/* Get the segment vector and row vector sizes. The sizes that */ -/* apply to the first join row set will suffice throughout. */ - - loc = bases[0] + 3; - zzeksrd_(&loc, &loc, &ntab); - svsize = ntab; - rvsize = ntab + 1; - -/* Mark redundant rows vectors for deletion. One saving grace is */ -/* that redundant rows can never occur in the same join row set, as */ -/* long as that join row set represents a set of rows satisfying */ -/* a conjunction of constraints. */ - - i__1 = *njrs; - for (cand = 2; cand <= i__1; ++cand) { - -/* We'll compare row vectors in the CAND join row set to row */ -/* vectors in the preceeding join row sets. Only row vectors */ -/* corresponding to matching segment vectors need be compared. */ -/* Therefore, we'll loop over the segment vectors in the CAND */ -/* join row set, and for each such segment vector, loop over the */ -/* segment vectors in the preceding join row sets. If a match */ -/* occurs, we'll compare row vectors corresponding to those */ -/* segment vectors. */ - -/* NCNDSV will contain the number of segment vectors in the */ -/* `candidate' join row set. */ - - nsvloc = bases[cand - 1] + 4; - zzeksrd_(&nsvloc, &nsvloc, &ncndsv); - i__2 = ncndsv; - for (csv = 1; csv <= i__2; ++csv) { - -/* Look up the candidate segment vector. */ - - csgbas = bases[cand - 1] + 4 + (csv - 1) * svsize; - i__3 = csgbas + 1; - i__4 = csgbas + svsize; - zzeksrd_(&i__3, &i__4, candsv); - -/* Get the row vector count and base address of the set of */ -/* row vectors for the candidate segment vector, in case */ -/* we need them. (Referring to the diagram of the join */ -/* row set structure in the join row set parameter include */ -/* file may be helpful here.) */ - - base = bases[cand - 1] + 4 + ncndsv * svsize + (csv - 1 << 1); - i__3 = base + 1; - i__4 = base + 1; - zzeksrd_(&i__3, &i__4, &crwbas); - crwbas += bases[cand - 1]; - i__3 = base + 2; - i__4 = base + 2; - zzeksrd_(&i__3, &i__4, &ncndrv); - -/* For the current predecessor join row set, look up the */ -/* segment vectors in that join row set and compare them to the */ -/* candidate. */ - - i__3 = cand - 1; - for (pred = 1; pred <= i__3; ++pred) { - -/* Get the count of segment vectors in the current */ -/* predecessor join row set. */ - - nsvloc = bases[pred - 1] + 4; - zzeksrd_(&nsvloc, &nsvloc, &nprdsv); - i__4 = nprdsv; - for (psv = 1; psv <= i__4; ++psv) { - -/* Look up the predecessor segment vector. */ - - psgbas = bases[pred - 1] + 4 + (psv - 1) * svsize; - i__5 = csgbas + 1; - i__6 = csgbas + svsize; - zzeksrd_(&i__5, &i__6, predsv); - -/* Compare the segment vectors and hope for the best. */ - - if (sameai_(candsv, predsv, &svsize)) { - -/* Unfortunately, the two segment vectors match, so */ -/* there's something to do. We'll have to compare */ -/* every row vector corresponding to the candidate */ -/* segment vector with every row vector corresponding */ -/* to the predecessor. */ - -/* Get the row vector count and base address of the */ -/* set of row vectors for the current predecessor */ -/* segment vector. We already have on hand the */ -/* corresponding quantities for the candidate */ -/* segment vector. */ - - base = bases[pred - 1] + 4 + nprdsv * svsize + (psv - - 1 << 1); - i__5 = base + 1; - i__6 = base + 1; - zzeksrd_(&i__5, &i__6, &prwbas); - prwbas += bases[pred - 1]; - i__5 = base + 2; - i__6 = base + 2; - zzeksrd_(&i__5, &i__6, &nprdrv); - -/* Compare all row vectors. */ - - i__5 = ncndrv; - for (crv = 1; crv <= i__5; ++crv) { - base = crwbas + (crv - 1) * rvsize; - i__6 = base + 1; - i__7 = base + rvsize; - zzeksrd_(&i__6, &i__7, crwvec); - prv = 1; - hit = FALSE_; - while(prv <= nprdrv && ! hit) { - base = prwbas + (prv - 1) * rvsize; - i__6 = base + 1; - i__7 = base + rvsize; - zzeksrd_(&i__6, &i__7, prwvec); - if (sameai_(crwvec, prwvec, &rvsize)) { - -/* The row vectors, together with their */ -/* qualifying segment vectors, match. The */ -/* higher-indexed vector is considered */ -/* redundant. To mark this vector for */ -/* deletion, we simply zero out the first */ -/* element of the row vector. This makes the */ -/* row vector invalid, so it will not match */ -/* any valid row vector we see later. */ - - base = crwbas + (crv - 1) * rvsize; - i__6 = base + 1; - i__7 = base + 1; - zzeksupd_(&i__6, &i__7, &c__0); - hit = TRUE_; - } else { - ++prv; - } - } - } - } - -/* We've finished comparing row vectors for a pair of */ -/* segment vectors, if it was necessary to do so. */ - - } - -/* We've compared all segment vectors in the current */ -/* predecessor join row set with the candidate segment */ -/* vector. */ - - } - -/* We've compared all segment vectors in all predecessor join */ -/* row sets to the current segment vector. */ - - } - -/* We've compared the candidate join row set to its predecessors. */ - - } - -/* We've compared all of the join row sets. */ - - -/* Now, clean up the join row set union by compressing out deleted */ -/* rows, segment vectors, and join row sets. */ - - j = 1; - ndel = 0; - i__1 = *njrs; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compress the current join row set. If it ends up empty, */ -/* expel it from the union. */ - - zzekjsqz_(&bases[i__ - 1]); - nrloc = bases[i__ - 1] + 2; - zzeksrd_(&nrloc, &nrloc, &nr); - if (nr == 0) { - -/* This entire join row set can be deleted from the union. */ -/* Consider the next join row set. */ - - ++ndel; - } else { - bases[j - 1] = bases[i__ - 1]; - ++j; - } - } - *njrs -= ndel; - -/* Count the rows remaining after our clean-up operation. */ - - *nrows = 0; - i__1 = *njrs; - for (i__ = 1; i__ <= i__1; ++i__) { - nrloc = bases[i__ - 1] + 2; - zzeksrd_(&nrloc, &nrloc, &nr); - *nrows += nr; - } - return 0; -} /* zzekweed_ */ - diff --git a/ext/spice/src/cspice/zzekweqi.c b/ext/spice/src/cspice/zzekweqi.c deleted file mode 100644 index bdf669698c..0000000000 --- a/ext/spice/src/cspice/zzekweqi.c +++ /dev/null @@ -1,544 +0,0 @@ -/* zzekweqi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; - -/* $Procedure ZZEKWEQI ( Private: EK, write to encoded query, integer ) */ -/* Subroutine */ int zzekweqi_(char *name__, integer *value, integer *eqryi, - ftnlen name_len) -{ - /* Initialized data */ - - static char namlst[32*15] = "ARCHITECTURE " "INITIALI" - "ZED " "PARSED " - "NAMES_RESOLVED " "TIMES_RESOLVED " - " " "SEM_CHECKED " "NUM_TABLES " - " " "NUM_CONJUNCTIONS " "NUM_CONSTRAINTS " - " " "NUM_SELECT_COLS " "NUM_ORDERB" - "Y_COLS " "NUM_BUF_SIZE " "FREE" - "_NUM " "CHR_BUF_SIZE " - "FREE_CHR "; - static integer namidx[15] = { 2,3,4,5,6,7,8,10,9,12,11,13,14,15,16 }; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), ljust_( - char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char tmpnam[32]; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Write scalar integer value to encoded EK query. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Encoded Query Internal Parameters */ - -/* ekquery.inc Version 3 16-NOV-1995 (NJB) */ - -/* Updated to reflect increased value of MAXCON in */ -/* ekqlimit.inc. */ - -/* ekquery.inc Version 2 03-AUG-1995 (NJB) */ - -/* Updated to support representation of the SELECT clause. */ - - -/* ekquery.inc Version 1 12-JAN-1995 (NJB) */ - - -/* An encoded EK query is an abstract data type implemented */ -/* as an integer cell, along with a double precision cell and */ -/* a character string. The d.p. cell and string contain numeric */ -/* and string values from the query string represented by the */ -/* encoded query. */ - -/* The parameters in this file are intended for use only by the */ -/* EK encoded query access routines. Callers of EK routines should */ -/* not use these parameters. */ - -/* The following parameters are indices of specified elements */ -/* in the integer portion of the encoded query. */ - -/* Encoded query architecture type: */ - - -/* `Name resolution' consists of: */ - -/* - Verifying existence of tables: any table names listed */ -/* in the FROM clause of a query must be loaded. */ - -/* - Validating table aliases used to qualify column names. */ - -/* - Verifying existence of columns and obtaining data types */ -/* for columns. */ - -/* - Setting data type codes for literal values in the encoded */ -/* query. */ - -/* - Checking consistency of operators and operand data types. */ - -/* - Making sure unqualified column names are unambiguous. */ - -/* - For constraints, mapping the table names used to qualify */ -/* column names to the ordinal position in the FROM clause */ -/* of the corresponding table. */ - - -/* Initialization status---this flag indicates whether the encoded */ -/* query has been initialized. Values are ITRUE or IFALSE. See the */ -/* include file ekbool.inc for parameter values. */ - - -/* Parse status---this flag indicates whether the parsing operation */ -/* that produced an encoded query has been completed. Values are */ -/* ITRUE or IFALSE. */ - - -/* Name resolution status---this flag indicates whether names */ -/* have been resolved in an encoded query. Values are ITRUE or */ -/* IFALSE. */ - - -/* Time resolution status---this flag indicates whether time values */ -/* have been resolved in an encoded query. Time resolution */ -/* consists of converting strings representing time values to ET. */ -/* Values of the status are ITRUE or IFALSE. */ - - -/* Semantic check status---this flag indicates whether semantic */ -/* checking of constraints has been performed. */ - - -/* Number of tables specified in FROM clause: */ - - -/* Number of constraints in query: */ - - -/* A special value is used to indicate the `maximal' constraint--- */ -/* one that logically cannot be satisfied. If the constraints */ -/* are equivalent to the maximal constraint, the location EQNCNS */ -/* is assigned the value EQMXML */ - - -/* Number of constraint conjunctions: */ - - -/* Number of order-by columns: */ - - -/* Number of SELECT columns: */ - - -/* Size of double precision buffer: */ - - -/* `Free' pointer into double precision buffer: */ - - -/* Size of character string buffer: */ - - -/* `Free' pointer into character string buffer: */ - - -/* The following four base pointers will be valid after a query */ -/* has been parsed: */ - -/* Base pointer for SELECT column descriptors: */ - - -/* Base pointer for constraint descriptors: */ - - -/* Base pointer for conjunction sizes: */ - - -/* Base pointer for order-by column descriptors: */ - - -/* After the quantities named above, the integer array contains */ -/* series of descriptors for tables, constraints, and order-by */ -/* columns, as well as a list of `conjunction sizes'---that is, */ -/* the sizes of the groups of constraints that form conjunctions, */ -/* after the input query has been re-arranged as a disjunction of */ -/* conjunctions of constraints. */ - - -/* The offsets of specific elements within descriptors are */ -/* parameterized. The base addresses of the descriptors themselves */ -/* must be calculated using the counts and sizes of the items */ -/* preceding them. */ - -/* A diagram of the structure of the variable-size portion of the */ -/* integer array is shown below: */ - - -/* +-------------------------------------+ */ -/* | Fixed-size portion of encoded query | */ -/* +-------------------------------------+ */ -/* | Encoded FROM clause | */ -/* +-------------------------------------+ */ -/* | Encoded constraint clause | */ -/* +-------------------------------------+ */ -/* | Conjunction sizes | */ -/* +-------------------------------------+ */ -/* | Encoded ORDER BY clause | */ -/* +-------------------------------------+ */ -/* | Encoded SELECT clause | */ -/* +-------------------------------------+ */ - - -/* Value Descriptors */ -/* ---------------- */ - -/* In order to discuss the various descriptors below, we'll make use */ -/* of sub-structures called `value descriptors'. These descriptors */ -/* come in two flavors: character and double precision. For */ -/* strings, a descriptor is a set of begin and end pointers that */ -/* indicate the location of the string in the character portion of an */ -/* encoded query, along with the begin and end pointers for the */ -/* corresponding lexeme in the original query. The pointers are set */ -/* to zero when they are not in use, for example if they refer to an */ -/* optional lexeme that did not appear in the input query. */ - -/* All value descriptors start with a data type indicator; values */ -/* are from ektype.inc. Integer and time values are referred to */ -/* by double precision descriptors. */ - -/* Parameters for string value descriptor elements: */ - - -/* Numeric value descriptors are similar to those for string values, */ -/* the difference being that they have only one pointer to the value */ -/* they represent. This pointer is the index of the value in the */ -/* encoded query's numeric buffer. */ - - -/* All value descriptors have the same size. In order to allow */ -/* table descriptors to have the same size as value descriptors, */ -/* we include an extra element in the descriptor. */ - - -/* Column Descriptors */ -/* ----------------- */ - -/* Each column descriptor consists of a character descriptor for the */ -/* name of the column, followed by an index, which gives the ordinal */ -/* position of the column in the logical table to which the column */ -/* belongs. The index element is filled in during name resolution. */ - - -/* Table Descriptors */ -/* ----------------- */ - -/* Each table descriptor consists of a character descriptor for the */ -/* name of the table, followed by an index, which gives the ordinal */ -/* position of the table in the FROM clause in the original query. */ -/* The index element is filled in during name resolution. Aliases */ -/* and table names have identical descriptor structures. */ - - -/* Constraint descriptors */ -/* ------------------ */ - -/* Each constraint is characterized by: */ - -/* - A code indicating whether the constraint compares values */ -/* in two columns or the value in a column and a literal */ -/* value. The values of this element are EQCOL and EQVAL. */ - - - -/* - A descriptor for the table used to qualify the */ -/* column name on the left side of the constraint. */ - - -/* - A character value descriptor for the column name on the left */ -/* side of the query. */ - - -/* - An operator code indicating the relational operator used */ -/* in the constraint. */ - - -/* If the constraint compares values from two columns, the */ -/* next items are table and column name descriptors that apply to */ -/* the column named on the right side of the relational operator. */ - - -/* If the constraint has a literal value on the right side, the */ -/* operator code is followed by... */ - -/* - a value descriptor. */ - - -/* - Size of a constraint descriptor: */ - - -/* Conjunction sizes */ -/* ----------------- */ - -/* The size of each conjunction of constraints occupies a single */ -/* integer. */ - - - - -/* Order-by Column Descriptors */ -/* --------------------------- */ - -/* Each order-by column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself; one additional element is used to indicate the direction */ -/* of the ordering (ascending vs descending). */ - - -/* - The last integer in the descriptor indicates whether the */ -/* order direction is ascending or descending. */ - - -/* - Size of an order-by column descriptor: */ - - -/* Codes indicating sense of ordering (ascending vs descending): */ - - -/* SELECT Column Descriptors */ -/* --------------------------- */ - -/* Each SELECT column descriptor contains descriptors for */ -/* the table containing the column and for the name of the column */ -/* itself. */ - - -/* - Size of a SELECT column descriptor: */ - - -/* Miscellaneous parameters: */ - - -/* EQIMIN is the minimum size of the integer portion of */ -/* an encoded query. EQIMIN depends on the parameters */ - -/* MAXTAB */ -/* MAXCON */ -/* MAXORD */ -/* MAXSEL */ - -/* all of which are declared in the include file ekqlimit.inc. */ -/* The functional definition of EQIMIN is: */ - -/* INTEGER EQIMIN */ -/* PARAMETER ( EQIMIN = EQVBAS */ -/* . + MAXTAB * EQVDSZ * 2 */ -/* . + MAXCON * EQCDSZ */ -/* . + MAXCON */ -/* . + MAXORD * EQODSZ */ -/* . + MAXSEL * EQSDSZ ) */ - - -/* End Include Section: EK Encoded Query Internal Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of scalar item to write. */ -/* VALUE I Value to write. */ -/* EQRYI I-O Integer component of query. */ - -/* $ Detailed_Input */ - -/* NAME is the name of the item whose value is to be set. */ -/* This item is some element of the integer portion */ -/* of an encoded query. The currently supported set */ -/* of names is: */ - -/* ARCHITECTURE */ -/* INITIALIZED */ -/* PARSED */ -/* NAMES_RESOLVED */ -/* TIMES_RESOLVED */ -/* SEM_CHECKED */ -/* NUM_TABLES */ -/* NUM_CONJUNCTIONS */ -/* NUM_CONSTRAINTS */ -/* NUM_SELECT_COLS */ -/* NUM_ORDERBY_COLS */ -/* NUM_BUF_SIZE */ -/* FREE_NUM */ -/* CHR_BUF_SIZE */ -/* FREE_CHR */ - -/* VALUE is an integer value to assign to the quantity */ -/* designated by NAME. */ - -/* EQRYI is the integer portion of an encoded EK query. */ - -/* $ Detailed_Output */ - -/* EQRYI is the integer portion of an encoded EK query, */ -/* updated to reflect the requested assignment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input name is not recognized, the error */ -/* SPICE(INVALIDNAME) is signalled. The encoded query is not */ -/* modified. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is intended to hide from calling routines the */ -/* specifics of the EK encoded query structure. See the include */ -/* file ekquery.inc if details of this structure are desired. */ - -/* $ Examples */ - -/* See ZZEKNRES. */ - -/* $ Restrictions */ - -/* 1) Uses EK encoded query architecture version 2. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 01-AUG-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. */ - - -/* Find the location of the named item. */ - - ljust_(name__, tmpnam, name_len, (ftnlen)32); - ucase_(tmpnam, tmpnam, (ftnlen)32, (ftnlen)32); - i__ = isrchc_(tmpnam, &c__15, namlst, (ftnlen)32, (ftnlen)32); - if (i__ == 0) { - chkin_("ZZEKWEQI", (ftnlen)8); - setmsg_("Item # not found.", (ftnlen)17); - errch_("#", name__, (ftnlen)1, name_len); - sigerr_("SPICE(INVALIDNAME)", (ftnlen)18); - chkout_("ZZEKWEQI", (ftnlen)8); - return 0; - } - -/* Do the deed. */ - - eqryi[namidx[(i__1 = i__ - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("namidx", - i__1, "zzekweqi_", (ftnlen)214)] + 5] = *value; - return 0; -} /* zzekweqi_ */ - diff --git a/ext/spice/src/cspice/zzekwpac.c b/ext/spice/src/cspice/zzekwpac.c deleted file mode 100644 index 953019c95f..0000000000 --- a/ext/spice/src/cspice/zzekwpac.c +++ /dev/null @@ -1,649 +0,0 @@ -/* zzekwpac.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKWPAC ( EK, write paged array, character ) */ -/* Subroutine */ int zzekwpac_(integer *handle, integer *segdsc, integer * - nvals, integer *l, char *cvals, integer *p, integer *base, ftnlen - cvals_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char page[1024]; - integer from; - extern /* Subroutine */ int zzekacps_(integer *, integer *, integer *, - integer *, integer *, integer *), zzekpgwc_(integer *, integer *, - char *, ftnlen), zzekslnk_(integer *, integer *, integer *, - integer *); - integer npage; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer to; - extern logical return_(void); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer spp; - -/* $ Abstract */ - -/* Write a character array out to a contiguous set of EK pages. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Descriptor of segment that owns the array. */ -/* NVALS I Number of values to write. */ -/* L I String length. */ -/* CVALS I Character values. */ -/* P O Number of first page containing array. */ -/* BASE O Base address of first page. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* NVALS is the number of character values to write. */ - -/* L is the length of the input values. The input */ -/* strings are expected to be short compared to the */ -/* size of a character page. */ - -/* CVALS is an array of character values. The first L */ -/* characters of each element of CVALS will be */ -/* written. The strings are not split across pages; */ -/* instead, unused space is left at the end of each */ -/* page if the string length does not divide the */ -/* page size evenly. */ - -/* $ Detailed_Output */ - -/* P is the number of the first page to which the */ -/* input values are written. CVALS(1) is written to */ -/* a range of DAS character words starting with the */ -/* the first word of page P. The values are written */ -/* to a contiguous set of pages in increasing order. */ - -/* BASE is the base address of P. BASE is the predecessor */ -/* of the first DAS address belonging to page P. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* 3) If L is negative or greater than the input string length, */ -/* the error SPICE(INVALIDSIZE) is signalled. */ - -/* 4) If L is greater than the size of the data area of a */ -/* character page, the error SPICE(INVALIDSIZE) is signalled. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine writes an array of character values to a contiguous */ -/* set of new character pages. The first element of the input array */ -/* is written to a range of values starting at the first DAS address */ -/* of the first page of the set. */ - -/* Note that the values do not occupy a contiguous range of DAS */ -/* character words, since each page contains several addresses */ -/* reserved for bookkeeping information, and since there may be */ -/* unused space at the end of a data page. However, since each page */ -/* contains exactly CPSIZE characters and has size PGSIZC, it's easy */ -/* to compute the DAS address of the Ith element in the array: */ - -/* N = IPSIZE / L */ -/* Q = I / N */ -/* R = I - Q * N */ - -/* ADDRSS(I) = BASE + Q * PGSIZC + (R-1) * L + 1 */ - -/* $ Examples */ - -/* See ZZEKAC07. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 07-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKWPAC", (ftnlen)8); - } - -/* Check the input string length. */ - - if (*l < 0 || *l > i_len(cvals, cvals_len) || *l > 1014) { - setmsg_("String length # is just plain wrong.", (ftnlen)36); - errint_("#", l, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("ZZEKWPAC", (ftnlen)8); - return 0; - } - -/* Compute the number of strings we can hold in one page. */ - - spp = 1014 / *l; - -/* Decide how many pages are required to hold the array, and */ -/* allocate that many new, contiguous pages. */ - - npage = (*nvals + spp - 1) / spp; - zzekacps_(handle, segdsc, &c__1, &npage, p, base); - -/* We'll use FROM to indicate the element of CVALS we're */ -/* considering and TO to indicate the element of PAGE to write */ -/* to. */ - - to = 1; - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - i__1 = *nvals; - for (from = 1; from <= i__1; ++from) { - -/* The Assignment. */ - - s_copy(page + (to - 1), cvals + (from - 1) * cvals_len, to + *l - 1 - - (to - 1), cvals_len); - to += *l; - if (to > 1014 - *l + 1 || from == *nvals) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. */ - - zzekpgwc_(handle, p, page, (ftnlen)1024); - -/* Set the link count. */ - - i__2 = (to - *l) / *l; - zzekslnk_(handle, &c__1, p, &i__2); - -/* Next page. */ - - ++(*p); - to = 1; - } - } - chkout_("ZZEKWPAC", (ftnlen)8); - return 0; -} /* zzekwpac_ */ - diff --git a/ext/spice/src/cspice/zzekwpai.c b/ext/spice/src/cspice/zzekwpai.c deleted file mode 100644 index 082d79db9e..0000000000 --- a/ext/spice/src/cspice/zzekwpai.c +++ /dev/null @@ -1,609 +0,0 @@ -/* zzekwpai.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__256 = 256; - -/* $Procedure ZZEKWPAI ( EK, write paged array, integer ) */ -/* Subroutine */ int zzekwpai_(integer *handle, integer *segdsc, integer * - nvals, integer *ivals, integer *p, integer *base) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer page[256], from; - extern /* Subroutine */ int zzekacps_(integer *, integer *, integer *, - integer *, integer *, integer *), zzekpgwi_(integer *, integer *, - integer *); - integer npage; - extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *, - integer *); - integer to; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* Write an integer array out to a contiguous set of EK pages. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Descriptor of segment that owns the array. */ -/* NVALS I Number of values to write. */ -/* IVALS I Integer values. */ -/* P O Number of first page containing array. */ -/* BASE O Base address of first page. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* NVALS is the number of integer values to write. */ - -/* IVALS is an array of integer values. */ - -/* $ Detailed_Output */ - -/* P is the number of the first page to which the */ -/* input values are written. IVALS(1) is written to */ -/* the first word of page P. The values are written */ -/* to a contiguous set of pages in increasing order. */ - -/* BASE is the base address of P. BASE is the predecessor */ -/* of the first DAS address belonging to page P. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine writes an array of integer values to a contiguous */ -/* set of new integer pages. The first element of the input array */ -/* is written to the first DAS address of the first page of the set. */ - -/* Note that the values do not occupy a contiguous range of DAS */ -/* integer words, since each page contains several addresses */ -/* reserved for bookkeeping information. However, since each page */ -/* contains exactly IPSIZE integers and has size PGSIZI, it's easy */ -/* to compute the DAS address of the Ith element in the array: */ - -/* Q = (I-1) / IPSIZE */ -/* R = I - Q * IPSIZE */ - -/* ADDRSS(I) = BASE + Q * PGSIZI + R */ - -/* $ Examples */ - -/* See ZZEKAC07. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKWPAI", (ftnlen)8); - } - -/* Decide how many pages are required to hold the array, and */ -/* allocate that many new, contiguous pages. */ - - npage = (*nvals + 253) / 254; - zzekacps_(handle, segdsc, &c__3, &npage, p, base); - -/* We'll use FROM to indicate the element of IVALS we're */ -/* considering and TO to indicate the element of PAGE to write */ -/* to. */ - - to = 1; - cleari_(&c__256, page); - i__1 = *nvals; - for (from = 1; from <= i__1; ++from) { - -/* The Assignment. */ - - page[(i__2 = to - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("page", i__2, - "zzekwpai_", (ftnlen)192)] = ivals[from - 1]; - ++to; - if (to > 254 || from == *nvals) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. First set the link count. */ - - page[255] = to - 1; - -/* Write out the data page. */ - - zzekpgwi_(handle, p, page); - -/* Next page. */ - - ++(*p); - to = 1; - } - } - chkout_("ZZEKWPAI", (ftnlen)8); - return 0; -} /* zzekwpai_ */ - diff --git a/ext/spice/src/cspice/zzekwpal.c b/ext/spice/src/cspice/zzekwpal.c deleted file mode 100644 index 37fe84c288..0000000000 --- a/ext/spice/src/cspice/zzekwpal.c +++ /dev/null @@ -1,668 +0,0 @@ -/* zzekwpal.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZEKWPAL ( EK, write paged array, logical ) */ -/* Subroutine */ int zzekwpal_(integer *handle, integer *segdsc, integer * - nvals, logical *lvals, integer *p, integer *base) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char page[1024]; - integer from; - extern /* Subroutine */ int zzekacps_(integer *, integer *, integer *, - integer *, integer *, integer *), zzekpgwc_(integer *, integer *, - char *, ftnlen), zzekslnk_(integer *, integer *, integer *, - integer *); - integer npage; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer to; - extern logical return_(void); - extern /* Subroutine */ int chkout_(char *, ftnlen); - -/* $ Abstract */ - -/* Write a logical array out to a contiguous set of EK pages. */ - -/* $ 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 */ - -/* EK */ - -/* $ Keywords */ - -/* EK */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: EK Boolean Enumerated Type */ - - -/* ekbool.inc Version 1 21-DEC-1994 (NJB) */ - - -/* Within the EK system, boolean values sometimes must be */ -/* represented by integer or character codes. The codes and their */ -/* meanings are listed below. */ - -/* Integer code indicating `true': */ - - -/* Integer code indicating `false': */ - - -/* Character code indicating `true': */ - - -/* Character code indicating `false': */ - - -/* End Include Section: EK Boolean Enumerated Type */ - -/* $ 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. */ - - -/* Include Section: EK Data Page Parameters */ - -/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ - -/* These parameters apply to EK files using architecture 4. */ -/* These files use a paged DAS file as their underlying file */ -/* structure. */ - -/* In paged DAS EK files, data pages are structured: they contain */ -/* metadata as well as data. The metadata is located in the last */ -/* few addresses of each page, so as to interfere as little as */ -/* possible with calculation of data addresses. */ - -/* Each data page belongs to exactly one segment. Some bookkeeping */ -/* information, such as record pointers, is also stored in data */ -/* pages. */ - -/* Each page contains a forward pointer that allows rapid lookup */ -/* of data items that span multiple pages. Each page also keeps */ -/* track of the current number of links from its parent segment */ -/* to the page. Link counts enable pages to `know' when they */ -/* are no longer in use by a segment; unused pages are deallocated */ -/* and returned to the free list. */ - -/* The parameters in this include file depend on the parameters */ -/* declared in the include file ekpage.inc. If those parameters */ -/* change, this file must be updated. The specified parameter */ -/* declarations we need from that file are: */ - -/* INTEGER PGSIZC */ -/* PARAMETER ( PGSIZC = 1024 ) */ - -/* INTEGER PGSIZD */ -/* PARAMETER ( PGSIZD = 128 ) */ - -/* INTEGER PGSIZI */ -/* PARAMETER ( PGSIZI = 256 ) */ - - - -/* Character pages use an encoding mechanism to represent integer */ -/* metadata. Each integer is encoded in five consecutive */ -/* characters. */ - - -/* Character data page parameters: */ - - -/* Size of encoded integer: */ - - -/* Usable page size: */ - - -/* Location of character forward pointer: */ - - -/* Location of character link count: */ - - -/* Double precision data page parameters: */ - -/* Usable page size: */ - - -/* Location of d.p. forward pointer: */ - - -/* Location of d.p. link count: */ - - -/* Integer data page parameters: */ - -/* Usable page size: */ - - -/* Location of integer forward pointer: */ - - -/* Location of integer link count: */ - - -/* End Include Section: EK Data Page Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Das Paging Parameters */ - -/* ekpage.inc Version 4 25-AUG-1995 (NJB) */ - - - -/* The EK DAS paging system makes use of the integer portion */ -/* of an EK file's DAS address space to store the few numbers */ -/* required to describe the system's state. The allocation */ -/* of DAS integer addresses is shown below. */ - - -/* DAS integer array */ - -/* +--------------------------------------------+ */ -/* | EK architecture code | Address = 1 */ -/* +--------------------------------------------+ */ -/* | Character page size (in DAS words) | */ -/* +--------------------------------------------+ */ -/* | Character page base address | */ -/* +--------------------------------------------+ */ -/* | Number of character pages in file | */ -/* +--------------------------------------------+ */ -/* | Number of character pages on free list | */ -/* +--------------------------------------------+ */ -/* | Character free list head pointer | Address = 6 */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for d.p. pages | 7--11 */ -/* | | */ -/* +--------------------------------------------+ */ -/* | | Addresses = */ -/* | Metadata for integer pages | 12--16 */ -/* | | */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | End Address = */ -/* | Unused space | integer page */ -/* | | end */ -/* +--------------------------------------------+ */ -/* | | Start Address = */ -/* | First integer page | integer page */ -/* | | base */ -/* +--------------------------------------------+ */ -/* . */ -/* . */ -/* . */ -/* +--------------------------------------------+ */ -/* | | */ -/* | Last integer page | */ -/* | | */ -/* +--------------------------------------------+ */ - -/* The following parameters indicate positions of elements in the */ -/* paging system metadata array: */ - - - -/* Number of metadata items per data type: */ - - -/* Character metadata indices: */ - - -/* Double precision metadata indices: */ - - -/* Integer metadata indices: */ - - -/* Size of metadata area: */ - - -/* Page sizes, in units of DAS words of the appropriate type: */ - - -/* Default page base addresses: */ - - -/* End Include Section: EK Das Paging Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Segment Descriptor Parameters */ - -/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ - - -/* All `base addresses' referred to below are the addresses */ -/* *preceding* the item the base applies to. This convention */ -/* enables simplied address calculations in many cases. */ - -/* Size of segment descriptor. Note: the include file ekcoldsc.inc */ -/* must be updated if this parameter is changed. The parameter */ -/* CDOFF in that file should be kept equal to SDSCSZ. */ - - -/* Index of the segment type code: */ - - -/* Index of the segment's number. This number is the segment's */ -/* index in the list of segments contained in the EK to which */ -/* the segment belongs. */ - - -/* Index of the DAS integer base address of the segment's integer */ -/* meta-data: */ - - -/* Index of the DAS character base address of the table name: */ - - -/* Index of the segment's column count: */ - - -/* Index of the segment's record count: */ - - -/* Index of the root page number of the record tree: */ - - -/* Index of the root page number of the character data page tree: */ - - -/* Index of the root page number of the double precision data page */ -/* tree: */ - - -/* Index of the root page number of the integer data page tree: */ - - -/* Index of the `modified' flag: */ - - -/* Index of the `initialized' flag: */ - - -/* Index of the shadowing flag: */ - - -/* Index of the companion file handle: */ - - -/* Index of the companion segment number: */ - - -/* The next three items are, respectively, the page numbers of the */ -/* last character, d.p., and integer data pages allocated by the */ -/* segment: */ - - -/* The next three items are, respectively, the page-relative */ -/* indices of the last DAS word in use in the segment's */ -/* last character, d.p., and integer data pages: */ - - -/* Index of the DAS character base address of the column name list: */ - - -/* The last descriptor element is reserved for future use. No */ -/* parameter is defined to point to this location. */ - - -/* End Include Section: EK Segment Descriptor Parameters */ - -/* $ 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. */ - - -/* Include Section: EK Data Types */ - -/* ektype.inc Version 1 27-DEC-1994 (NJB) */ - - -/* Within the EK system, data types of EK column contents are */ -/* represented by integer codes. The codes and their meanings */ -/* are listed below. */ - -/* Integer codes are also used within the DAS system to indicate */ -/* data types; the EK system makes no assumptions about compatibility */ -/* between the codes used here and those used in the DAS system. */ - - -/* Character type: */ - - -/* Double precision type: */ - - -/* Integer type: */ - - -/* `Time' type: */ - -/* Within the EK system, time values are represented as ephemeris */ -/* seconds past J2000 (TDB), and double precision numbers are used */ -/* to store these values. However, since time values require special */ -/* treatment both on input and output, and since the `TIME' column */ -/* has a special role in the EK specification and code, time values */ -/* are identified as a type distinct from double precision numbers. */ - - -/* End Include Section: EK Data Types */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle attached to EK file. */ -/* SEGDSC I Descriptor of segment that owns the array. */ -/* NVALS I Number of values to write. */ -/* LVALS I Logical values. */ -/* P O Number of first page containing array. */ -/* BASE O Base address of first page. */ - -/* $ Detailed_Input */ - -/* HANDLE the handle of an EK file that is open for writing. */ - -/* SEGDSC is a descriptor for the segment to which data is */ -/* to be added. The segment descriptor is not */ -/* updated by this routine, but some fields in the */ -/* descriptor will become invalid after this routine */ -/* returns. */ - -/* NVALS is the number of logical values to write. */ - -/* LVALS is an array of logical values. The values will */ -/* be stored as characters, with one character used */ -/* per element of LVALS. */ - -/* $ Detailed_Output */ - -/* P is the number of the first page to which the */ -/* input values are written. The character */ -/* representing LVALS(1) is written to the first DAS */ -/* character of page P. The values are written */ -/* to a contiguous set of pages in increasing order. */ - -/* BASE is the base address of P. BASE is the predecessor */ -/* of the first DAS address belonging to page P. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If HANDLE is invalid, the error will be diagnosed by routines */ -/* called by this routine. */ - -/* 2) If an I/O error occurs while reading or writing the indicated */ -/* file, the error will be diagnosed by routines called by this */ -/* routine. */ - -/* $ Files */ - -/* See the EK Required Reading for a discussion of the EK file */ -/* format. */ - -/* $ Particulars */ - -/* This routine writes an array of logical values to a contiguous */ -/* set of new character pages. The first element of the input array */ -/* is written to a range of values starting at the first DAS address */ -/* of the first page of the set. */ - -/* This routine supports creation of null flag arrays for fixed-count */ -/* column classes. */ - -/* Note that the values do not occupy a contiguous range of DAS */ -/* character words, since each page contains several addresses */ -/* reserved for bookkeeping information, and since there may be */ -/* unused space at the end of a data page. */ - -/* $ Examples */ - -/* See ZZEKAC07. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 08-NOV-1995 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZEKWPAL", (ftnlen)8); - } - -/* Decide how many pages are required to hold the array, and */ -/* allocate that many new, contiguous pages. */ - - npage = (*nvals + 1013) / 1014; - zzekacps_(handle, segdsc, &c__1, &npage, p, base); - -/* Write the input data out to the target file a page at a time. */ - -/* We'll use FROM to indicate the element of LVALS we're */ -/* considering and TO to indicate the element of PAGE to write */ -/* to. */ - - to = 1; - s_copy(page, " ", (ftnlen)1024, (ftnlen)1); - i__1 = *nvals; - for (from = 1; from <= i__1; ++from) { - -/* The Assignment. */ - - if (lvals[from - 1]) { - *(unsigned char *)&page[to - 1] = 'T'; - } else { - *(unsigned char *)&page[to - 1] = 'F'; - } - ++to; - if (to > 1014 || from == *nvals) { - -/* Either the current data page is full, or we've buffered */ -/* the last of the available data. It's time to write out the */ -/* current page. */ - -/* Write out the data page. */ - - zzekpgwc_(handle, p, page, (ftnlen)1024); - -/* Set the link count. */ - - i__2 = to - 1; - zzekslnk_(handle, &c__1, p, &i__2); - -/* Next page. */ - - ++(*p); - to = 1; - } - } - chkout_("ZZEKWPAL", (ftnlen)8); - return 0; -} /* zzekwpal_ */ - diff --git a/ext/spice/src/cspice/zzelvupy.c b/ext/spice/src/cspice/zzelvupy.c deleted file mode 100644 index 90c0cc4503..0000000000 --- a/ext/spice/src/cspice/zzelvupy.c +++ /dev/null @@ -1,959 +0,0 @@ -/* zzelvupy.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10000 = 10000; -static doublereal c_b79 = 2.; -static doublereal c_b90 = .5; - -/* $Procedure ZZELVUPY ( Is ellipse in polygonal field of view? ) */ -/* Subroutine */ int zzelvupy_(doublereal *ellips, doublereal *vertex, - doublereal *axis, integer *n, doublereal *bounds, logical *found) -{ - /* Initialized data */ - - static doublereal origin[3] = { 0.,0.,0. }; - - /* System generated locals */ - integer bounds_dim2, i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double asin(doublereal), pow_dd(doublereal *, doublereal *); - - /* Local variables */ - doublereal asep, apex[3]; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ); - static doublereal work[30000] /* was [3][10000] */; - doublereal edge1[3], edge2[3], a, b, d__; - integer i__, j; - doublereal vxpt1[3], vxpt2[3], scale, x, y; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal plane[4]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vlcom_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - extern doublereal vdist_(doublereal *, doublereal *); - doublereal vtemp[3]; - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *); - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *); - integer nxpts; - extern /* Subroutine */ int el2cgv_(doublereal *, doublereal *, - doublereal *, doublereal *), cgv2el_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal hafedg; - extern /* Subroutine */ int nvp2pl_(doublereal *, doublereal *, - doublereal *); - doublereal cp[3]; - extern /* Subroutine */ int psv2pl_(doublereal *, doublereal *, - doublereal *, doublereal *); - extern doublereal pi_(void); - doublereal hafsec, eplane[4], ellscl[9], center[3], easize, ebsctr[3]; - extern /* Subroutine */ int saelgv_(doublereal *, doublereal *, - doublereal *, doublereal *), inelpl_(doublereal *, doublereal *, - integer *, doublereal *, doublereal *); - doublereal ctrvec[3], consep, offset[3], pasize, smajor[3]; - char errmsg[1840]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *, - ftnlen); - doublereal fovpln[4], vbsctr[3]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal sminor[3]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), repmot_( - char *, char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen); - doublereal gv1[3]; - extern logical return_(void); - doublereal gv2[3]; - extern /* Subroutine */ int inrypl_(doublereal *, doublereal *, - doublereal *, integer *, doublereal *); - extern integer zzwind_(doublereal *, integer *, doublereal *, doublereal * - ); - doublereal xpt[3], xpt1[3], xpt2[3]; - -/* $ Abstract */ - -/* Determine whether a specified ellipse intersects the pyramid */ -/* defined by a polygonal field of view. */ - -/* $ 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 */ - -/* ELLIPSES */ -/* PLANES */ - -/* $ Keywords */ - -/* ELLIPSE */ -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELLIPS I A SPICELIB ellipse. */ -/* VERTEX I Vertex of a pyramid. */ -/* AXIS I Axis of a pyramid. */ -/* N I Number of boundary vectors of the pyramid. */ -/* BOUNDS I Boundary vectors of the pyramid. */ -/* FOUND O Flag indicating whether intersection was found. */ -/* UBEL P Upper bound of SPICELIB ellipse array. */ -/* UBPL P Upper bound of SPICELIB plane array. */ -/* MAXFOV P Maximum number of boundary vectors. */ - -/* $ Detailed_Input */ - -/* ELLIPS is a SPICELIB ellipse having non-zero semi-axes. */ - -/* VERTEX is the single point of intersection of the vectors */ -/* defining the edges of a pyramid. The vectors */ -/* emanate from this point. The pyramid represents */ -/* the spatial region viewed by a polygonal field of */ -/* view (FOV). */ - -/* AXIS is a vector emanating from VERTEX that lies inside */ -/* the pyramid defined by VERTEX, N, and BOUNDS. */ -/* AXIS represents the boresight direction of the FOV. */ - -/* N, */ -/* BOUNDS are, respectively, the number of boundary vectors */ -/* defining the pyramid and the boundary vectors */ -/* themselves. Each pair of consecutive vectors in */ -/* the array BOUNDS, together with VERTEX, defines a */ -/* face of the pyramid. */ - -/* Each boundary vector must have angular separation */ -/* of less than pi/2 radians from AXIS. */ - -/* For any plane that doesn't contain VERTEX and that */ -/* intersects AXIS at right angles, the intersections */ -/* of the boundary vectors with that plane are the */ -/* vertices of a polygon. The polygon need not be */ -/* convex, but it must be non-self-intersecting. */ - - -/* $ Detailed_Output */ - -/* FOUND is set to .TRUE. if the pyramid and ellipse */ -/* intersect; otherwise FOUND is .FALSE. */ - -/* $ Parameters */ - -/* UBEL is the array upper bound for SPICELIB ellipses. */ - -/* UBPL is the array upper bound for SPICELIB planes. */ - -/* MAXFOV is the maximum number of boundary vectors that */ -/* may be supplied in the input array argument */ -/* BOUNDS. */ - -/* $ Exceptions */ - -/* If an error is found, the output argument FOUND will be set to */ -/* .FALSE. */ - - -/* 1) If either of the semi-axes of the input ellipse is the */ -/* zero vector, the error SPICE(ZEROVECTOR) will be signaled. */ - -/* 2) If the norm of the input ellipse's semi-minor axis is */ -/* zero after division by the maximum of the norms of the */ -/* semi-major axis, the ellipse's center, and the vertex of */ -/* the pyramid, the error SPICE(DEGENERATECASE) will be */ -/* signaled. */ - -/* 3) If the vertex of the pyramid lies in the plane containing */ -/* the ellipse, at most the edge of the ellipse can be "seen" */ -/* from the vertex. This case is not considered to be an */ -/* error. */ - -/* 4) If the number of boundary vectors N is not at least 3, */ -/* or if the number exceeds MAXFOV, the error */ -/* SPICE(INVALIDCOUNT) will be signaled. */ - -/* 5) If any boundary vector is the zero vector, the error */ -/* SPICE(ZEROVECTOR) will be signaled. */ - -/* 6) If the axis is the zero vector, the error SPICE(ZEROVECTOR) */ -/* will be signaled. */ - -/* 7) If any boundary vector has angular separation of at least */ -/* pi/2 radians from AXIS, the error SPICE(INVALIDFOV) */ -/* will be signaled. */ - -/* 8) If any boundary vector has angular separation of zero */ -/* radians from one of its neighbors, the error SPICE(INVALIDFOV) */ -/* will be signaled. */ - -/* 9) No test is done to ensure that the input boundary vectors */ -/* define a non-self-intersecting polygon via their intersection */ -/* with a plane normal to AXIS. If the boundary vectors don't */ -/* meet this condition, the results of this routine are */ -/* unreliable. */ - -/* 10) The pyramidal field of view and the input ellipse must not */ -/* differ too radically in scale, or great loss of precision */ -/* will result, making the results of this routine unreliable. */ -/* For example, if the ratio of the norm of the semi-minor axis */ -/* of the ellipse to the distance from VERTEX to the center of */ -/* the ellipse is less than double precision epsilon on the host */ -/* system, a meaningful result can't be computed. */ - -/* This routine does not attempt to judge the minimum */ -/* acceptable level of accuracy. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is useful for determining whether an ellipsoidal */ -/* body is in the field of view of a remote-sensing instrument */ -/* with a field of view having polygonal cross section. */ - -/* $ Examples */ - -/* Test an ellipse for intersection with a square field */ -/* of view. */ - - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* INTEGER MAXN */ -/* PARAMETER ( MAXN = 4 ) */ - -/* INTEGER UBEL */ -/* PARAMETER ( UBEL = 9 ) */ - -/* DOUBLE PRECISION AXIS ( 3 ) */ -/* DOUBLE PRECISION CENTER ( 3 ) */ -/* DOUBLE PRECISION ELLIPS ( UBEL ) */ -/* DOUBLE PRECISION FOV ( 3, MAXN ) */ -/* DOUBLE PRECISION SMAJOR ( 3 ) */ -/* DOUBLE PRECISION SMINOR ( 3 ) */ -/* DOUBLE PRECISION VERTEX ( 3 ) */ - -/* INTEGER N */ - -/* LOGICAL FOUND */ - -/* C */ -/* C The FOV (field of view) "looks" in the -x direction: */ -/* C the axis of the FOV is parallel to the x axis. */ -/* C The FOV intersects the plane of the ellipse in a */ -/* C square having height and width 4 units. The edges */ -/* C of the square are parallel to the y and z axes. */ -/* C */ -/* N = 4 */ - -/* CALL VPACK ( -1.D0, -1.D0, -1.D0, FOV(1,1) ) */ -/* CALL VPACK ( -1.D0, 1.D0, -1.D0, FOV(1,2) ) */ -/* CALL VPACK ( -1.D0, 1.D0, 1.D0, FOV(1,3) ) */ -/* CALL VPACK ( -1.D0, -1.D0, 1.D0, FOV(1,4) ) */ - -/* CALL VPACK ( -1.D0, 0.D0, 0.D0, AXIS ) */ -/* CALL VPACK ( 1.D0, 0.D0, 0.D0, VERTEX ) */ - -/* C */ -/* C The ellipse is oriented with the major axis */ -/* C vertical and is parallel to the x-z plane. The ellipse */ -/* C lies in the plane defined by x = -1. The ellipse */ -/* C ever-so-slightly overlaps the bottom edge of the FOV. */ -/* C */ -/* CALL VPACK ( 0.D0, 0.D0, 1.D0, SMAJOR ) */ -/* CALL VPACK ( 0.D0, 5.D-1, 0.D0, SMINOR ) */ -/* CALL VPACK ( -1.D0, 0.D0, -3.D0 + 1.D-12, CENTER ) */ - -/* C */ -/* C Create a SPICELIB ellipse from the center and semi-axes. */ -/* C */ -/* CALL CGV2EL ( CENTER, SMAJOR, SMINOR, ELLIPS ) */ - -/* C */ -/* C Test for intersection. We expect an intersection to be */ -/* C found. */ -/* C */ -/* CALL ZZELVUPY ( ELLIPS, VERTEX, AXIS, N, FOV, FOUND ) */ - -/* WRITE (*,*) 'Case 1: FOUND = ', FOUND */ - -/* C */ -/* C Shift the ellipse center to move the ellipse outside of */ -/* C the FOV, then repeat the test. We expect FOUND to be */ -/* C .FALSE. */ -/* C */ -/* CALL VPACK ( -1.D0, 0.D0, -3.D0 - 1.D-12, CENTER ) */ - -/* CALL CGV2EL ( CENTER, SMAJOR, SMINOR, ELLIPS ) */ - -/* CALL ZZELVUPY ( ELLIPS, VERTEX, AXIS, N, FOV, FOUND ) */ - -/* WRITE (*,*) 'Case 2: FOUND = ', FOUND */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 28-FEB-2008 (BVS) */ - -/* Corrected the contents of the Required_Reading section. */ - -/* - SPICELIB Version 1.0.0, 10-AUG-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* test whether pyramid intersects ellipse */ -/* test whether ellipse is in pyramidal field of view */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - bounds_dim2 = *n; - - /* Function Body */ - if (return_()) { - return 0; - } - chkin_("ZZELVUPY", (ftnlen)8); - -/* We start out by checking the inputs. */ - -/* The next step will be to look for an intersection of the ellipse */ -/* and pyramid. There are three intersection cases: */ - -/* 1) The ellipse is completely contained in the pyramid. */ - -/* 2) The ellipse "contains" the field of view in the sense */ -/* that the intersection of the pyramid and the plane of the */ -/* ellipse is contained in the region bounded by the ellipse. */ - -/* 3) One or more sides of the pyramid intersect the ellipse. */ - -/* There is also a non-intersection case: this is when cones */ -/* bounding the ellipse and pyramid and having their apexes in */ -/* common with that of the pyramid intersect only in that common */ -/* apex. Before test (1), we perform this non-intersection test, */ -/* since it can be done quickly. */ - -/* No intersection has been found so far. Set the default value */ -/* of the FOUND flag here so it won't have to be set in every error */ -/* checking block below. */ - - *found = FALSE_; - -/* Validate the ellipse. First find the center and the semi-axes */ -/* of the ellipse. */ - - el2cgv_(ellips, center, gv1, gv2); - saelgv_(gv1, gv2, smajor, sminor); - -/* Check the semi-axis lengths. */ - -/* If the semi-major axis is the zero vector, we'd expect */ -/* the semi-minor axis to be the zero vector as well. But */ -/* round-off error could conceivably violate this assumption. */ - - if (vzero_(smajor) || vzero_(sminor)) { - setmsg_("Input ellipse has semi-major axis length # and semi-minor a" - "xis length #. Both vectors are required to be non-zero.", ( - ftnlen)115); - d__1 = vnorm_(smajor); - errdp_("#", &d__1, (ftnlen)1); - d__1 = vnorm_(sminor); - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - -/* Scale the vectors defining the ellipse and the vertex of the */ -/* pyramid so that the largest of these vectors has unit length. */ - -/* Computing MAX */ - d__1 = vnorm_(center), d__2 = vnorm_(smajor), d__1 = max(d__1,d__2), d__2 - = vnorm_(vertex); - scale = 1. / max(d__1,d__2); - for (i__ = 1; i__ <= 3; ++i__) { - center[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("center", - i__1, "zzelvupy_", (ftnlen)452)] = scale * center[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("center", i__2, "zzelv" - "upy_", (ftnlen)452)]; - smajor[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("smajor", - i__1, "zzelvupy_", (ftnlen)453)] = scale * smajor[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("smajor", i__2, "zzelv" - "upy_", (ftnlen)453)]; - sminor[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("sminor", - i__1, "zzelvupy_", (ftnlen)454)] = scale * sminor[(i__2 = i__ - - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("sminor", i__2, "zzelv" - "upy_", (ftnlen)454)]; - apex[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("apex", i__1, - "zzelvupy_", (ftnlen)455)] = scale * vertex[(i__2 = i__ - 1) < - 3 && 0 <= i__2 ? i__2 : s_rnge("vertex", i__2, "zzelvupy_", ( - ftnlen)455)]; - } - -/* Create a scaled ellipse. We'll perform the FOV side-ellipse */ -/* intersection computations using this ellipse. */ - - cgv2el_(center, smajor, sminor, ellscl); - -/* After scaling, make sure the semi-axes have sufficient length to */ -/* prevent numerical problems. Let A and B be the scaled semi-axis */ -/* lengths of the ellipse. */ - - a = vnorm_(smajor); - b = vnorm_(sminor); - if (b == 0.) { - setmsg_("Scaled ellipse's semi-minor axis length = 0.", (ftnlen)44); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - -/* Validate the input pyramid. */ - -/* The axis must not be the zero vector. */ - - if (vzero_(axis)) { - setmsg_("The pyramid's axis the zero vector.", (ftnlen)35); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - -/* There must be at least three boundary vectors. */ - - if (*n < 3) { - setmsg_("The number of boundary vectors was #; this number must be a" - "t least 3.", (ftnlen)69); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - -/* There must be no more than MAXFOV boundary vectors. */ - - if (*n > 10000) { - setmsg_("The number of boundary vectors was #; this number must not " - "exceed #.", (ftnlen)68); - errint_("#", n, (ftnlen)1); - errint_("#", &c__10000, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - -/* We must initialize certain variables before continuing with */ -/* the checks. */ - -/* Let CTRVEC be the vector from the apex to the center of the */ -/* ellipse. This vector will be used in several places later; */ -/* it's convenient to compute it here. */ - - vsub_(center, apex, ctrvec); - -/* Compute PASIZE: an upper bound on the angular radius of a */ -/* circular cone whose axis is the input central axis. While */ -/* we're at it, check the angular separation of the boundary */ -/* vectors from the central axis and from each other. */ - - pasize = 0.; - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Each boundary vector must have angular separation from the */ -/* axis of less than pi/2 radians. Keep track of the maximum */ -/* angular separation PASIZE as we go. We'll use this variable */ -/* later in a non-intersection test. */ - - asep = vsep_(axis, &bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && - 0 <= i__2 ? i__2 : s_rnge("bounds", i__2, "zzelvupy_", ( - ftnlen)550)]); - if (asep >= pi_() / 2) { - setmsg_("The angular separation of boundary vector # from the ax" - "is is #. This number must less than pi/2.", (ftnlen)96); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &asep, (ftnlen)1); - sigerr_("SPICE(INVALIDFOV)", (ftnlen)17); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - pasize = max(pasize,asep); - -/* Each boundary vector must have non-zero angular separation */ -/* from its neighbors. */ - - if (i__ < *n) { - j = i__ + 1; - } else { - j = 1; - } - ucrss_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ? - i__2 : s_rnge("bounds", i__2, "zzelvupy_", (ftnlen)577)], & - bounds[(i__3 = j * 3 - 3) < bounds_dim2 * 3 && 0 <= i__3 ? - i__3 : s_rnge("bounds", i__3, "zzelvupy_", (ftnlen)577)], cp); - if (vzero_(cp)) { - -/* The cross product may be zero because one of the */ -/* boundary vectors is zero. Check this first. */ - - if (vzero_(&bounds[(i__2 = j * 3 - 3) < bounds_dim2 * 3 && 0 <= - i__2 ? i__2 : s_rnge("bounds", i__2, "zzelvupy_", (ftnlen) - 584)]) || vzero_(&bounds[(i__3 = i__ * 3 - 3) < - bounds_dim2 * 3 && 0 <= i__3 ? i__3 : s_rnge("bounds", - i__3, "zzelvupy_", (ftnlen)584)])) { - s_copy(errmsg, "The # boundary vector is the zero vector.", ( - ftnlen)1840, (ftnlen)41); - if (vzero_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && - 0 <= i__2 ? i__2 : s_rnge("bounds", i__2, "zzelvupy_", - (ftnlen)588)])) { - j = i__; - } - repmot_(errmsg, "#", &j, "L", errmsg, (ftnlen)1840, (ftnlen)1, - (ftnlen)1, (ftnlen)1840); - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - } else { - setmsg_("The angular separation of boundary vector # from ve" - "ctor # is 0.This number must be positive.", (ftnlen) - 92); - errint_("#", &i__, (ftnlen)1); - errint_("#", &j, (ftnlen)1); - sigerr_("SPICE(INVALIDFOV)", (ftnlen)17); - } - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - } - -/* That's it for the error checks. We'll now answer the question */ -/* this routine is meant to answer: does the ellipse or the region */ -/* it bounds intersect the pyramid? */ - -/* We'll start out with a simple check to rule out intersection */ -/* when the ellipse and pyramid are contained in disjoint right */ -/* circular cones with a common apex. */ - -/* Find the angular radius (that is, one-half of the angular extent) */ -/* of a bounding cone of the ellipse as seen from the apex. The */ -/* cone circumscribes a sphere of radius A centered at the ellipse's */ -/* center, where A is the length of the semi-major axis. Note that */ -/* the cone does not in general circumscribe the ellipse itself. */ - -/* The test can be performed only if the apex of the FOV is outside */ -/* of the sphere of radius A centered at the ellipse center. */ - - d__ = vdist_(center, apex); - if (a < d__) { - easize = asin(a / d__); - -/* The variable PASIZE already contains the angular radius of a */ -/* bounding cone of the pyramid as seen from the pyramid's apex. */ -/* The angular radius is the maximum of the angular separations */ -/* of each pyramid edge from the pyramid's axis. Check whether */ -/* the bounding cones of ellipse and pyramid are disjoint. Recall */ -/* CTRVEC is the vector from the apex to the center of the */ -/* ellipse. If the angular separation of CTRVEC and AXIS exceeds */ -/* the sum of the angular radii of the ellipse's and pyramid's */ -/* bounding cones, there can be no intersection. */ - - consep = vsep_(ctrvec, axis) - (easize + pasize); - if (consep > 0.) { - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - } - -/* At this point, we have to take a more detailed look at the */ -/* possible intersection of ellipse and pyramid. First check */ -/* whether the center of the ellipse is contained in the pyramid. */ -/* If the ellipse is completely contained in the pyramid, this */ -/* check will yield a positive result. */ - -/* The center of the ellipse is inside the pyramid if a plane */ -/* containing this point and normal to the axis vector */ -/* chops the pyramid in a polygon that has non-zero winding */ -/* number about the center. */ - -/* The center of the ellipse must lie in the correct half-space */ -/* for this test to be applicable. */ - - if (vdot_(axis, ctrvec) > 0.) { - -/* Construct the plane and find the polygon. */ - - nvp2pl_(axis, ctrvec, fovpln); - -/* Create the planar FOV boundary using the intersections */ -/* of the FOV boundary vectors with FOVPLN. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - inrypl_(origin, &bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && - 0 <= i__2 ? i__2 : s_rnge("bounds", i__2, "zzelvupy_", ( - ftnlen)686)], fovpln, &nxpts, &work[(i__3 = i__ * 3 - 3) < - 30000 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "zzelv" - "upy_", (ftnlen)686)]); - -/* We expect to have a single point of intersection for each */ -/* boundary vector. */ - - if (nxpts != 1) { - setmsg_("NXPTS = # for boundary vector #/FOV plane intersect" - "ion.", (ftnlen)55); - errint_("#", &nxpts, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - } - -/* Now WORK contains the polygon representing the intersection of */ -/* the pyramid with the plane FOVPLN. If the winding number of */ -/* the polygon about the ellipse center is non-zero, we conclude */ -/* the center is in the pyramid. */ - - if (zzwind_(fovpln, n, work, ctrvec) != 0) { - -/* The center of the ellipse is inside the pyramid. We're */ -/* done. */ - - *found = TRUE_; - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - } - -/* Check whether the ray defined by APEX and the first boundary */ -/* vector of the pyramid (the "boundary ray") intersects the plane */ -/* region bounded by the ellipse. If the intersection of the */ -/* pyramid and the plane of the ellipse is completely contained in */ -/* the region bounded by the ellipse, this check will yield a */ -/* positive result. */ - -/* First find the intersection of the boundary ray and the plane */ -/* containing the ellipse; represent this plane using the SPICELIB */ -/* plane EPLANE. */ -/* We don't check FAILED() here because the spanning vectors */ -/* are orthogonal, and because PSV2PL (via a call to UCRSS) */ -/* does scaling to prevent underflow. */ - - psv2pl_(center, smajor, sminor, eplane); - inrypl_(apex, &bounds[(i__1 = 0) < bounds_dim2 * 3 ? i__1 : s_rnge("boun" - "ds", i__1, "zzelvupy_", (ftnlen)745)], eplane, &nxpts, xpt); - -/* The routine INRYPL can return the NXPTS values 1, 0, or INF---a */ -/* code indicating an infinite number of intersection points of ray */ -/* and plane. If the value is 1, the boundary ray may intersect */ -/* the region bounded by the ellipse. */ - - if (nxpts == 1) { - -/* The boundary ray intersects the plane of the ellipse in a */ -/* single point. Decide whether this point is inside the ellipse. */ -/* To test for containment, find the "coordinates" of the */ -/* center-to-point vector relative to the two-dimensional basis */ -/* formed by the semi-axes of the ellipse. Call this */ -/* center-to-point vector OFFSET. Recall A and B are the */ -/* semi-axis lengths of the ellipse. Let X and Y be the */ -/* coordinates of OFFSET in the two-dimensional reference frame */ -/* whose basis consists of normalized versions of SMAJOR and */ -/* SMINOR. */ - -/* Note that we could have the special case in which the vertex */ -/* of the pyramid lies in the plane of the ellipse, in which case */ -/* the FOV "sees" the ellipse edge-on. However, since NXPTS is */ -/* not INF, the boundary vector does not lie in the plane of the */ -/* ellipse. So in this special case, APEX would be in the region */ -/* bounded by the ellipse. */ - - vsub_(xpt, center, offset); - x = vdot_(offset, smajor) / a; - y = vdot_(offset, sminor) / b; - d__1 = x / a; - d__2 = y / b; - if (pow_dd(&d__1, &c_b79) + pow_dd(&d__2, &c_b79) <= 1.) { - -/* The boundary-vector-plane intercept lies in the */ -/* topologically closed region bounded by the ellipse. */ - - *found = TRUE_; - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - } - -/* Check whether one of the pyramid's sides intersects the ellipse. */ -/* For each side, we first test whether the plane containing that */ -/* side intersects the ellipse. If it does, the intersection is */ -/* a (possibly degenerate) line segment with endpoints on the */ -/* ellipse. The triangle (or segment) defined by the pyramid's */ -/* apex and this segment (point) is then checked for intersection */ -/* with the currently considered side of the pyramid. */ - - i__ = 1; - while(i__ <= *n && ! (*found)) { - -/* Create a SPICELIB plane containing the Ith side of the */ -/* pyramid. */ - - if (i__ < *n) { - j = i__ + 1; - } else { - j = 1; - } - -/* Although PSV2PL can signal an error if the spanning */ -/* vectors are linearly dependent, it won't do so here */ -/* because we've already ensured the cross product of */ -/* these vectors is non-zero. */ - - psv2pl_(apex, &bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= - i__1 ? i__1 : s_rnge("bounds", i__1, "zzelvupy_", (ftnlen)820) - ], &bounds[(i__2 = j * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ? - i__2 : s_rnge("bounds", i__2, "zzelvupy_", (ftnlen)820)], - plane); - -/* Find the intersection of the plane and the ellipse. */ - - inelpl_(ellscl, plane, &nxpts, xpt1, xpt2); - -/* If the ellipse-plane intersection is non-empty, test it to see */ -/* whether it has non-empty intersection with the current side of */ -/* the pyramid. */ - - if (nxpts > 0) { - -/* Let EDGE1 and EDGE2 be the unit length boundary vectors */ -/* forming the edges of the currently considered side of the */ -/* pyramid. */ - - vhat_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 - ? i__1 : s_rnge("bounds", i__1, "zzelvupy_", (ftnlen)837)] - , edge1); - vhat_(&bounds[(i__1 = j * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? - i__1 : s_rnge("bounds", i__1, "zzelvupy_", (ftnlen)838)], - edge2); - -/* Let EBSCTR ("pyramid edge bisector") be a bisector of the */ -/* sector bounded by EDGE1 and EDGE2. */ - - vlcom_(&c_b90, edge1, &c_b90, edge2, ebsctr); - -/* Let HAFEDG be half of the angular measure of this sector. */ - - hafedg = vsep_(edge1, edge2) / 2.; - -/* Let VXPT1 and VXPT2 be the unit vectors pointing from the */ -/* pyramid's apex to the points of intersection of the ellipse */ -/* and the plane containing the currently considered side of */ -/* the pyramid. */ - - vsub_(xpt1, apex, vtemp); - vhat_(vtemp, vxpt1); - vsub_(xpt2, apex, vtemp); - vhat_(vtemp, vxpt2); - -/* At this point we'll introduce a bit of terminology. We're */ -/* going to work with plane regions defined by pairs of */ -/* vectors with a common endpoint. We'll abuse standard */ -/* terminology a bit and call the region bounded by such a */ -/* vector pair a "sector." Strictly speaking, sectors refer */ -/* only to subsets of a disc. */ - -/* When it's convenient, we'll also identify "sectors" with */ -/* regions of the unit circle. This will make it possible */ -/* to talk about intersections of sectors in terms of */ -/* intersections of the associated arcs on the unit circle. */ -/* By the "endpoints" of a sector we mean the endpoints */ -/* of the arc associated with the sector on the unit circle. */ - -/* Let VBSCTR ("VXPT bisector") be a bisector of the sector */ -/* bounded by VXPT1 and VXPT2. */ - - vlcom_(&c_b90, vxpt1, &c_b90, vxpt2, vbsctr); - -/* Let HAFSEC be half of the angular measure of the sector */ -/* bounded by VXPT1 and VXPT2. */ - - hafsec = vsep_(vxpt1, vxpt2) / 2.; - -/* EDGE1, EDGE2, VXPT1, and VXPT2 are four co-planar vectors */ -/* emanating from APEX. We want to find out whether the */ -/* sector bounded by EDGE1 and EDGE2 intersects the sector */ -/* bounded by VXPT1 and VXPT2. If there's an intersection, at */ -/* least one endpoint of one sector is contained in the other */ -/* sector. */ - -/* Because of potential round-off problems when the sectors */ -/* are nearly coincident, we perform the precautionary check */ -/* (case 3) on the angle bisector of the sector defined by */ -/* VXPT1 and VXPT2. */ - -/* If the sector defined by VXPT1 and VXPT2 has no endpoint */ -/* contained in the other sector, it's possible that the */ -/* former sector contains the latter. In that case the */ -/* angular bisector of the latter sector is contained in the */ -/* former (case 4). */ - -/* We test a vector's containment in a sector by comparing the */ -/* vector's angular separation from the sector's angle */ -/* bisector to one-half of the angular measure of the sector. */ - -/* Case 1: VXPT1 lies between EDGE1 and EDGE2. */ -/* Case 2: VXPT2 lies between EDGE1 and EDGE2. */ -/* Case 3: VBSCTR lies between EDGE1 and EDGE2. */ -/* Case 4: EBSCTR lies between VXPT1 and VXPT2. */ - - if (vsep_(vxpt1, ebsctr) <= hafedg) { - *found = TRUE_; - } else if (vsep_(vxpt2, ebsctr) <= hafedg) { - *found = TRUE_; - } else if (vsep_(vbsctr, ebsctr) <= hafedg) { - *found = TRUE_; - } else if (vsep_(ebsctr, vbsctr) <= hafsec) { - *found = TRUE_; - } - if (*found) { - -/* We've found an intersection. We're done. */ - - chkout_("ZZELVUPY", (ftnlen)8); - return 0; - } - } - -/* If no intersection was found, look at the next side of the */ -/* pyramid. */ - - ++i__; - } - -/* If we got this far, the ellipse is not in view. FOUND has */ -/* already been set to .FALSE. */ - - chkout_("ZZELVUPY", (ftnlen)8); - return 0; -} /* zzelvupy_ */ - diff --git a/ext/spice/src/cspice/zzenut80.c b/ext/spice/src/cspice/zzenut80.c deleted file mode 100644 index a2ba0b9b0e..0000000000 --- a/ext/spice/src/cspice/zzenut80.c +++ /dev/null @@ -1,210 +0,0 @@ -/* zzenut80.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__3 = 3; - -/* $Procedure ZZENUT80 ( Earth nutation transformation, IAU 1980 model ) */ -/* Subroutine */ int zzenut80_(doublereal *et, doublereal *nutxf) -{ - doublereal dmob; - extern /* Subroutine */ int zzmobliq_(doublereal *, doublereal *, - doublereal *), chkin_(char *, ftnlen); - doublereal dvnut[4]; - extern /* Subroutine */ int eul2xf_(doublereal *, integer *, integer *, - integer *, doublereal *); - doublereal eulang[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int zzwahr_(doublereal *, doublereal *); - doublereal mob; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the state transformation matrix implementing the IAU 1980 */ -/* nutation model. */ - -/* $ 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 */ - -/* FRAMES */ -/* MATRIX */ -/* PRIVATE */ -/* TRANSFORMATION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ET I Ephemeris time, seconds past J2000. */ -/* NUTXF O Nutation transformation matrix. */ - -/* $ Detailed_Input */ - -/* ET is an epoch, expressed as seconds past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* NUTXF is a state transformation matrix that maps states */ -/* from the earth mean equator and equinox of date */ -/* frame (based on the 1976 IAU precession model) to */ -/* the earth true equator and equinox frame of date */ -/* (based on the 1980 IAU nutation model). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* See the private SPICELIB routine ZZWAHR for a discussion */ -/* of the implementation of the 1980 IAU nutation model. */ - -/* See the private SPICELIB routine ZZMOBLIQ for a discussion */ -/* of the implementation of the 1980 IAU earth mean obliquity */ -/* of date model. */ - -/* $ Examples */ - -/* See ZZDYNFRM. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* [1] "Explanatory Supplement to the Astronomical Almanac" */ -/* edited by P. Kenneth Seidelmann. University Science */ -/* Books, 20 Edgehill Road, Mill Valley, CA 94941 (1992) */ - -/* [2] "Section 5, Geocentric Space-Fixed Position, Velocity, and */ -/* Acceleration Vectors of Tracking Station" by T. D. Moyer. */ -/* Draft of JPL Publication documenting the JPL navigation */ -/* program "Regres." */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("ZZENUT80", (ftnlen)8); - -/* Get nutation angles and their rates. We're expecting */ - -/* DVNUT(1) = Psi------nutation in longitude (radians) */ -/* DVNUT(2) = Epsilon--nutation in obliquity (radians) */ -/* DVNUT(3) = dPsi/dt (radians/second) */ -/* DVNUT(4) = dEpsilon/dt (radians/second) */ - - zzwahr_(et, dvnut); - -/* Get the mean obliquity of date. */ - -/* We're expecting the outputs to be as follows: */ - -/* MOB is the mean obliquity of the ecliptic at epoch */ -/* ET. The mean obliquity of the ecliptic is the */ -/* inclination of the ecliptic of date to the */ -/* mean Earth equator of date. Output units are */ -/* radians. */ - -/* DMOB is the time derivative of MOB at ET, expressed */ -/* in radians per second. */ - zzmobliq_(et, &mob, &dmob); - -/* The nutation rotation N is defined by */ - - -/* N = [ -MOB - NUOBL ] [ -NULON ] [ MOB ] */ -/* 1 3 1 */ - -/* where MOBLIQ is the mean obliquity of the earth's ecliptic */ -/* at epoch, NUOB is nutation in obliquity at epoch, and */ -/* NULONG is nutation in longitude at epoch. Using our */ -/* variable names, the Euler angle sequence is */ - -/* [ -MOB - DVNUT(2) ] [ -DVNUT(1) ] [ MOB ] */ -/* 1 3 1 */ - -/* The rates corresponding to these angles are: */ - -/* -DMOB - DVNUT(4), -DVNUT(3), DMOB */ - -/* We can use EUL2XF to form the state transformation from */ -/* the nutation base frame to the nutation frame. */ - - eulang[0] = -mob - dvnut[1]; - eulang[1] = -dvnut[0]; - eulang[2] = mob; - eulang[3] = -dmob - dvnut[3]; - eulang[4] = -dvnut[2]; - eulang[5] = dmob; - eul2xf_(eulang, &c__1, &c__3, &c__1, nutxf); - chkout_("ZZENUT80", (ftnlen)8); - return 0; -} /* zzenut80_ */ - diff --git a/ext/spice/src/cspice/zzeprc76.c b/ext/spice/src/cspice/zzeprc76.c deleted file mode 100644 index e4e8068331..0000000000 --- a/ext/spice/src/cspice/zzeprc76.c +++ /dev/null @@ -1,225 +0,0 @@ -/* zzeprc76.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure ZZEPRC76 ( Earth precession, 1976 IAU model ) */ -/* Subroutine */ int zzeprc76_(doublereal *et, doublereal *precxf) -{ - doublereal cent, zeta, t, scale, z__, theta, dzeta; - extern doublereal jyear_(void); - extern /* Subroutine */ int eul2xf_(doublereal *, integer *, integer *, - integer *, doublereal *); - doublereal dz, ts, dtheta, eulang[6]; - extern doublereal rpd_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the state transformation matrix implementing the IAU 1876 */ -/* precession model. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* FRAMES */ -/* GEOMETRY */ -/* MATRIX */ -/* PRIVATE */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris time, in seconds past J2000 TDB. */ -/* PRECXF O Precession state transformation matrix at ET. */ - -/* $ Detailed_Input */ - -/* ET is the epoch at which the precession matrix is */ -/* to be computed. ET is barycentric dynamical time, */ -/* expressed as seconds past J2000. */ - -/* $ Detailed_Output */ - -/* PRECXF is a 6x6 matrix that transforms states from the */ -/* J2000 frame to the mean equator and equinox frame */ -/* of the earth at the epoch ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* According to reference [2], the precession model used in this */ -/* routine is that used in the JPL navigation program "Regres." */ - -/* The precession matrix is defined using the Euler angles */ - -/* zeta , z , and theta */ -/* A A A */ - - -/* Equation (5-147) of [2] gives the matrix determined by these */ -/* angles as */ - -/* A = [ -z ] [ theta ] [ -zeta ] */ -/* A 3 A 2 A 3 */ - - -/* Formulas for the Euler angles are from [2], equation */ -/* (5-143): */ -/* 2 3 */ -/* zeta = 2306".2181*T + 0".30188*T + 0".017998*T */ -/* A */ - - -/* 2 3 */ -/* z = 2306".2181*T + 1".09468*T + 0".018203*T */ -/* A */ - - -/* 2 3 */ -/* theta = 2004".3109*T - 0".42665*T - 0".041833*T */ -/* A */ - -/* $ Examples */ - -/* 1) Convert a state vector S from J2000 to Earth Mean equator and */ -/* equinox of date coordinates at epoch ET. Call the resulting */ -/* vector SMOD. */ - -/* CALL ZZEPRC76 ( ET, PRECXF ) */ -/* CALL MXVG ( PRECXF, S, 6, 6, SMOD ) */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject to */ -/* change without notice. User applications should not call this */ -/* routine. */ - -/* 2) Though reference [1] does not specify limitations on the range */ -/* of valid time inputs for this precession model, the fact that */ -/* the rotation angles used in the model are defined by */ -/* polynomials implies that the model is not valid for all time. */ - -/* $ Literature_References */ - -/* [1] "Explanatory Supplement to the Astronomical Almanac" */ -/* edited by P. Kenneth Seidelmann. University Science */ -/* Books, 20 Edgehill Road, Mill Valley, CA 94941 (1992) */ - -/* [2] "Section 5, Geocentric Space-Fixed Position, Velocity, and */ -/* Acceleration Vectors of Tracking Station" by T. D. Moyer. */ -/* Draft of JPL Publication documenting the JPL navigation */ -/* program "Regres." */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* IAU 1976 earth precession transformation */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* No check-in required; this routine does not participate in */ -/* SPICELIB error handling. */ - - -/* Compute the precession angles first. The time argument has */ -/* units of Julian centuries. The polynomial expressions yield */ -/* angles in units of arcseconds prior to scaling. After scaling, */ -/* the angles are in units of radians. */ - - cent = jyear_() * 100.; - t = *et / cent; - scale = rpd_() / 3600.; - zeta = t * (t * (t * .017998 + .30188) + 2306.2181) * scale; - z__ = t * (t * (t * .018203 + 1.09468) + 2306.2181) * scale; - theta = t * (t * (t * -.041833 - .42665) + 2004.3109) * scale; - ts = 1. / cent; - dzeta = ts * (t * (t * 3 * .017998 + .60375999999999996) + 2306.2181) * - scale; - dz = ts * (t * (t * 3 * .018203 + 2.1893600000000002) + 2306.2181) * - scale; - dtheta = ts * (t * (t * 3 * -.041833 - .85329999999999995) + 2004.3109) * - scale; - -/* Now compute the precession matrix. */ - - eulang[0] = -z__; - eulang[1] = theta; - eulang[2] = -zeta; - eulang[3] = -dz; - eulang[4] = dtheta; - eulang[5] = -dzeta; - eul2xf_(eulang, &c__3, &c__2, &c__3, precxf); - return 0; -} /* zzeprc76_ */ - diff --git a/ext/spice/src/cspice/zzeprcss.c b/ext/spice/src/cspice/zzeprcss.c deleted file mode 100644 index 29508f31fe..0000000000 --- a/ext/spice/src/cspice/zzeprcss.c +++ /dev/null @@ -1,211 +0,0 @@ -/* zzeprcss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__2 = 2; - -/* $Procedure ZZEPRCSS ( Earth precession, 1976 IAU model ) */ -/* Subroutine */ int zzeprcss_(doublereal *et, doublereal *precm) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Local variables */ - doublereal zeta; - extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal - *, integer *, integer *, integer *, doublereal *); - doublereal t, scale, z__, theta; - extern doublereal jyear_(void), rpd_(void); - -/* $ Abstract */ - -/* Return the 1976 IAU Earth precession matrix for a specified time. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* FRAMES */ -/* GEOMETRY */ -/* MATRIX */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris time, in seconds past J2000. */ -/* PRECM O Precession matrix at ET. */ - -/* $ Detailed_Input */ - -/* ET is the epoch at which the precession matrix is */ -/* to be computed. ET is barycentric dynamical time, */ -/* expressed as seconds past J2000. */ - -/* $ Detailed_Output */ - -/* PRECM is a 3x3 matrix representing the precession of */ -/* the Earth from J2000 to the epoch ET. The */ -/* rows of PRECM are the basis vectors for the Earth */ -/* mean equator and equinox frame of date, evaluated */ -/* at ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* According to reference [2], the precession model used in this */ -/* routine is that used in the JPL navigation program "Regres." */ - -/* The precession matrix is defined using the Euler angles */ - -/* zeta , z , and theta */ -/* A A A */ - - -/* Equation (5-147) of [2] gives the matrix determined by these */ -/* angles as */ - -/* A = [ -z ] [ theta ] [ -zeta ] */ -/* A 3 A 2 A 3 */ - - -/* Formulas for the Euler angles are from [2], equation */ -/* (5-143): */ -/* 2 3 */ -/* zeta = 2306".2181*T + 0".30188*T + 0".017998*T */ -/* A */ - - -/* 2 3 */ -/* z = 2306".2181*T + 1".09468*T + 0".018203*T */ -/* A */ - - -/* 2 3 */ -/* theta = 2004".3109*T - 0".42665*T - 0".041833*T */ -/* A */ - -/* $ Examples */ - -/* 1) Convert a vector V from J2000 to Earth Mean equator and equinox */ -/* of date coordinates at epoch ET. Call the resulting vector */ -/* VMOD. */ - -/* CALL ZZEPRCSS ( ET, PRECM ) */ -/* CALL MXV ( PRECM, V, VMOD ) */ - -/* $ Restrictions */ - -/* 1) This is a preliminary version of the routine. */ - -/* 2) Though reference [1] does not specify limitations on the */ -/* range of valid time inputs for this precession model, the */ -/* fact that the rotation angles used in the model are defined */ -/* by polynomials implies that the model is not valid for all */ -/* time. */ - -/* $ Literature_References */ - -/* [1] "Explanatory Supplement to the Astronomical Almanac" */ -/* edited by P. Kenneth Seidelmann. University Science */ -/* Books, 20 Edgehill Road, Mill Valley, CA 94941 (1992) */ - -/* [2] "Section 5, Geocentric Space-Fixed Position, Velocity, and */ -/* Acceleration Vectors of Tracking Station" by T. D. Moyer. */ -/* Draft of JPL Publication documenting the JPL navigation */ -/* program "Regres." */ - - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 24-SEP-1996 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Earth precession matrix based on 1976 IAU model */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* No check-in required; this routine does not participate in */ -/* SPICELIB error handling. */ - - -/* Compute the precession angles first. The time argument has */ -/* units of Julian centuries. The polynomial expressions yield */ -/* angles in units of arcseconds prior to scaling. After scaling, */ -/* the angles are in units of radians. */ - - t = *et / (jyear_() * 100.); - scale = rpd_() / 3600.; - zeta = t * (t * (t * .017998 + .30188) + 2306.2181) * scale; - z__ = t * (t * (t * .018203 + 1.09468) + 2306.2181) * scale; - theta = t * (t * (t * -.041833 - .42665) + 2004.3109) * scale; - -/* Now compute the precession matrix. */ - - d__1 = -z__; - d__2 = -zeta; - eul2m_(&d__1, &theta, &d__2, &c__3, &c__2, &c__3, precm); - return 0; -} /* zzeprcss_ */ - diff --git a/ext/spice/src/cspice/zzerror.c b/ext/spice/src/cspice/zzerror.c deleted file mode 100644 index c4ef404377..0000000000 --- a/ext/spice/src/cspice/zzerror.c +++ /dev/null @@ -1,362 +0,0 @@ -/* - --Procedure zzerror ( Cat and return the long, short, and traceback - error strings) - --Abstract - - The default CSPICE behavior signals an exit on a CSPICE error. - This action often conflicts with the error model used by other - programming languages: IDL, Perl, MATLAB, etc. zzerrorinit - and zzerror implement logic to permit easy use of another - error model. - - zzerror retrieves the long error message, the short error, - message and the call trace back, assembling those components - into a single string for return to the caller. This call also - resets the failed_c() state. - --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 - - error - -*/ - -#include -#include - -#include "SpiceUsr.h" -#include "SpiceZfc.h" -#include "SpiceZst.h" -#include "zzerror.h" - -#define MSG_LEN 2024 -#define TRC_LEN 32 -#define MAXMOD 100 -#define OUT_LEN 2*MSG_LEN - -const char * zzerror( long cnt ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - cnt I Either a flag (less than 0) indicating a scalar or an - array index. - - The function returns a string version of the SPICE error output. - --Detailed_Input - - cnt A long integer defining the index of a vector at which - the error signaled or a negative value indicating the - error occurred during a scalar operation. - --Detailed_Output - - The function returns a pointer to a string (char *), the string - containing the SPICE short and long error messages, plus - the full trace back. If the error signaled during a vectorized - operation, the error string includes the vector index at failure. - --Parameters - - MSG_LEN one half the max length of the return string. The return - string has dimension 2*MSG_LEN. - - TRC_LEN the max length of a string returned from trcnam_. - - MAXMOD is the maximum storage depth for names in the - traceback stack. Value copied from trcpkg.f. - --Exceptions - - 1) If trcdep_ returns a 'depth' value larger than the maximum depth - as assigned to MAXMOD, the routine returns a SPICE(BUG) error - and error message to the caller. - --Files - - None. - --Particulars - - All interface functions immediately check failed_c() after - calling CSPICE. When failed_c() returns SPICETRUE, - the interface performs the appropriate action to return the - error state to the interpreter. - - Call after detecting a failed_c() event. - - The user should call zzerrorinit prior to a zzerror call. - zzerrorinit places the error subsystem in the RETURN/NULL - state. - - This routine makes a call to reset_c to reset the error - system to an non-error state. The call causes the following: - - failed_c returns `false' value until another error signal. - - return_c returns `false' value until another error signal. - - getsms_ and getlms_ return blank strings. - - The traceback routines return a traceback of the current - active call chain, not the active call chain at the time - of the last error. - --Examples - - Expected use, check failed, return the error string: - - /. - Initialize the error system to RETURN/NULL - ./ - zzerrorinit(); - - ... CSPICE calls ... - - /. - Check for a failure, return the error string if - failed_c returns true. - ./ - if( failed_c() ) - { - error_str = zzerror( index ); - - /. - Return the error string traceback to - the calling program. - ./ - error_return( error_str ); - } - - Example of a string returned by zzerror: - - In scalar context- - - SPICE(NOLEAPSECONDS): [str2et_c->STR2ET->TTRANS] The variable - that points to the leapseconds (DELTET/DELTA_AT) could not be - located in the kernel pool. It is likely that the leapseconds - kernel has not been loaded via the routine FURNSH. - - In a vector context- - - cspice_str2et, 'Jan 1, 2049', et - et_vec = dindgen(5)*10000d + et - - cspice_spkezr, 'MOON', et_vec, 'J2000', 'NONE', 'EARTH', starg, ltime - - Creates the string - - SPICE(SPKINSUFFDATA): [spkezr_c->SPKEZR->SPKEZ->SPKGEO] - Insufficient ephemeris data has been loaded to compute the - state of 301 (MOON) relative to 399 (EARTH) at the - ephemeris epoch 2050 JAN 01 01:07:44.183. Failure at input - vector index 3154. - --Restrictions - - Use with the SPICE error system in RETURN mode and the error - device set to NULL. - --Literature_References - - None. - --Author_and_Institution - - E. D. Wright (JPL) - --Version - - CSPICE 1.1.1 08-MAR-2007 (EDW) - - Corrected spelling mistake in error message string. - - CSPICE 1.1.0 24-APR-2006 (EDW) - - Version 1.0.0 contained an extraneous chkin_c call which caused a - cascade of 'zzerror_c' strings prefixed to error strings. This call - bug was removed. - - Replaced LDPOOL reference in header docs with FURNSH. - - CSPICE 1.0.0 17-OCT-2005 (EDW) - - Initial release to CSPICE - --Index_Entries - - error message - --& - -*/ - { - - /* - Local variables. Tag the 'msg_short' as static so the memory - remains after return. - - We append to 'msg_short' hence the reason for it having the - largest size. - - */ - static char msg_short [OUT_LEN]; - char msg_long [MSG_LEN]; - char trname [TRC_LEN]; - - - /* - Define an error message string for the case if the trcdep_ - call returns a value larger than MAXMOD. - */ - char * depth_err = "SPICE(BUG): [zzerror]. An error " - "occurred during the processing of a SPICE " - "error signal. The trcdep_ routine " - "returned a depth, %i, larger than the " - "maximum allowed depth, %i. Please " - "contact NAIF."; - - SpiceInt i; - - SpiceInt depth; - SpiceChar trlist[MAXMOD*TRC_LEN]; - - - /* - Zero out the char arrays, just-in-case. - */ - memset( msg_short, 0, 2 *MSG_LEN ); - memset( msg_long, 0, MSG_LEN ); - memset( trlist, 0, MAXMOD*TRC_LEN ); - - /* - Retrieve the depth of the call traceback stack. - */ - (void) trcdep_( &depth ); - - /* - Check 'depth' as less-than or equal-to MAXMOD. Signal a - SPICE error if not confirmed. - */ - if ( depth > MAXMOD ) - { - reset_c(); - - sprintf(msg_short, depth_err, depth, MAXMOD ); - return(msg_short); - } - - - /* - Loop over the number of items in the trace list. - Index starts at 1 as trcnam_ is an f2c'd routine. - */ - for ( i=1; i<= depth; i++) - { - - /* - Retrieve the name (as a FORTRAN string) of the ith routine's name - from the trace stack. No SPICE call name has a string length longer - than TRC_LEN characters. - */ - (void) trcnam_( (integer *) &i, trname, (ftnlen) TRC_LEN ); - - /* - The f2c code returns a FORTRAN type string, so null terminate - the string for C. - */ - F2C_ConvertStr( TRC_LEN, trname); - - /* - Create the trace list string by concatenation. Add '->' as a - marker between the routine names except on the first pass through - the loop. - */ - if ( i != 1 ) - { - strcat( trlist, "->" ); - } - strcat( trlist, trname ); - - } - - /* - Retrieve the short message from the error subsystem. The string has - form "SPICE(MSGNAME)". - */ - (void) getsms_(msg_short, (SpiceInt) sizeof msg_short); - - /* - Null terminate the FORTRAN 'msg_short' string for use in C routines. - */ - F2C_ConvertStr( 2*MSG_LEN, msg_short); - - /* - Obtain the long message string, a brief description of the error. - */ - (void) getlms_(msg_long, (ftnlen) sizeof(msg_long)); - - /* - Null terminate the FORTRAN 'msg_long' string for use in C routines. - */ - F2C_ConvertStr( MSG_LEN, msg_long); - - /* - Remember to reset the error system, so subsequent calls work. - */ - reset_c(); - - /* - Combine the short, long and trace strings into a single string, then - return the string. - */ - sprintf( msg_short + strlen(msg_short), - ": [%s] %s", trlist, msg_long ); - - /* - Add the index value for errors from vectorized functions. Scalar - functions set 'cnt' to anything less than zero (normally -1 or -2). - */ - if ( cnt >= 0 ) - { - sprintf( msg_short + strlen(msg_short), - " Failure occurred at input vector index %ld.", cnt); - } - - return(msg_short); - } - diff --git a/ext/spice/src/cspice/zzerror.h b/ext/spice/src/cspice/zzerror.h deleted file mode 100644 index 5709c667d5..0000000000 --- a/ext/spice/src/cspice/zzerror.h +++ /dev/null @@ -1,80 +0,0 @@ -/* - --Abstract - - The error control routine prototypes for use in CSPICE. - --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. - --Particulars - - Routines prototyped in this file: - - zzerrorinit - zzerror - --Examples - - See the examples section in zzerror() and zzerrorinit(). - --Restrictions - - None. - --Exceptions - - None. - --Files - - None. - --Author_and_Institution - - E. D. Wright (JPL) - --Literature_References - - None. - --Version - - CSPICE 1.0.0 17-OCT-2005 (EDW) - - Initial release. - -*/ - -#ifndef ZZERROR_H -#define ZZERROR_H - - const char * zzerror( long cnt ); - void zzerrorinit(); - -#endif - - - diff --git a/ext/spice/src/cspice/zzerrorinit.c b/ext/spice/src/cspice/zzerrorinit.c deleted file mode 100644 index 9c2e3141fe..0000000000 --- a/ext/spice/src/cspice/zzerrorinit.c +++ /dev/null @@ -1,153 +0,0 @@ -/* --Procedure zzerrorinit ( Initialize the SPICE error subsytem to RETURN/NULL ) - --Abstract - - Set the CSPICE error subsystem to RETURN mode, and the error - device to NULL. - --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 - - error - -*/ - -#include "SpiceUsr.h" -#include "zzerror.h" - -void zzerrorinit(void) - -/* - --Brief_I/O - - None. - --Detailed_Input - - None. - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - Initializes the error subsystem to the "RETURN" state, sets - the error output device to NULL (no output). - - Call this routine prior to calling zzerror. - --Examples - - Expected use, check failed, return the error string: - - /. - Initialize the error system to RETURN/NULL - ./ - zzerrorinit(); - - ... CSPICE calls ... - - /. - Check for a failure, return the error string if - failed_c returns true. - ./ - if( failed_c() ) - { - error_str = zzerror( index ); - - /. - Return the error string traceback to - the calling program. - ./ - error_return( error_str ); - } - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E. D. Wright (JPL) - --Version - - CSPICE 1.0.0 17-OCT-2005 (EDW) - - Initial release to CSPICE - --Index_Entries - - set error system return mode - --& -*/ - { - - static SpiceBoolean first = SPICETRUE; - - /* - Prevent repeated executions of code with the 'first' flag. - */ - if ( first ) - { - - /* - Explicitly set the error subsystem to return mode, the - error output device to NULL. - */ - - erract_c("SET", (SpiceInt) sizeof("RETURN"), "RETURN"); - errdev_c("SET", (SpiceInt) sizeof("NULL") , "NULL" ); - - } - - } - diff --git a/ext/spice/src/cspice/zzfcstring.c b/ext/spice/src/cspice/zzfcstring.c deleted file mode 100644 index 71e3bb64fc..0000000000 --- a/ext/spice/src/cspice/zzfcstring.c +++ /dev/null @@ -1,1504 +0,0 @@ -/* - --Procedure zzfcstring ( Fortran/C string conversion utilities ) - --Abstract - - CSPICE Fortran/C string conversion utility package. Contains - multiple functions. - --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 - - STRING - --Particulars - - Contains the following functions: - - C2F_CreateStr ( Create a Fortran string from C string ) - - C2F_CreateStr_Sig ( Create a Fortran string from C string, - error signaling version ) - - C2F_MapStrArr ( Create a Fortran string array from 2-d - C string array ) - - C2F_MapFixStrArr ( Create a Fortran string array from 2-d - C string array, string length fixed by - caller ) - - C2F_CreateStrArr ( Create a Fortran string array from array - of C strings ) - - C2F_CreateStrArr_Sig ( Create a Fortran string array from array - of C strings, error signaling version ) - - C2F_CreateFixStrArr ( Create a Fortran string array from C string - array, string length fixed by caller ) - - C2F_StrCpy ( Copy a C string into a Fortran string ) - - F_Alloc ( Allocate a string for Fortran output ) - - F2C_ConvertStr ( Convert a Fortran string to a C string ) - - F2C_ConvertStrArr ( Convert a Fortran string to an array of - C strings ) - - F2C_CreateStr ( Create a C string from a Fortran string ) - - F2C_CreateStr_Sig ( Create a C string from a Fortran string, - error signaling version ) - - F2C_CreateStrArr ( Create an array of C strings from an - array of Fortran strings ) - - F2C_CreateTrStrArr ( Create an array of trimmed C strings from - an array of Fortran strings ) - - F2C_StrCpy ( Copy a Fortran string into a C string ) - - F_StrLen ( Find the number of characters, excluding - trailing blanks, in a Fortran string ) - --Examples - - None. - --Restrictions - - None. - --Exceptions - - See function headers. - --Files - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 5.0.0, 10-JUL-2002 (NJB) - - Renamed file to zzfcstring.c. - - Added routines C2F_MapStrArr and C2F_MapFixStrArr. These are analogs - of C2F_CreateStrArr_Sig and C2F_CreateFixStrArr that operate - on a 2-dimensional character array containing null-terminated strings. - - Fixed an error message in C2F_CreateStrArr_Sig; the long - error message for a malloc failure specified an incorrect - number of bytes which the routine had attempted to allocate. - - -CSPICE Version 4.0.0, 14-FEB-2000 (NJB) - - Added routine C2F_CreateStrArr_Sig. This is an error-signaling - version of C2F_CreateStrArr. - - Corrected various typos and formatting errors. - - -CSPICE Version 3.0.0, 09-JUL-1999 (NJB) - - Added routine F2C_ConvertTrStrArr. - - -CSPICE Version 2.0.1, 09-FEB-1998 (EDW) (NJB) - - Added routine F2C_ConvertStrArr. Modified argument list of - F2C_ConvertStr to be consistent with the new routine. - - -CSPICE Version 2.0.0, 03-JAN-1997 (NJB) - - Added routine F2C_ConvertStr. Adjusted indentation of comment - delimiters. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - None. --& -*/ - - #include - - #include "SpiceUsr.h" - #include "SpiceZst.h" - #include "SpiceZmc.h" - - -SpiceStatus C2F_CreateStr ( ConstSpiceChar *cStr, - SpiceInt *fStrLen, - SpiceChar **fStr ) - -{ - SpiceInt length; - SpiceStatus status; - SpiceChar *tempStr; - - /* - Compute the length of the input C string. - */ - length = strlen ( cStr ); - - /* - Dynamically allocate sufficient memory to hold the string for - use as a Fortran string. If the memory allocation fails, return - a failure status. - */ - tempStr = (SpiceChar *) malloc ( length ); - - if ( tempStr == (SpiceChar *) NULL ) - { - *fStr = (SpiceChar *) NULL; - *fStrLen = 0; - return (SPICEFAILURE); - } /* end if */ - - /* - Copy the C string into the Fortran string. - */ - status = C2F_StrCpy ( cStr, length, tempStr ); - - if ( status == SPICEFAILURE ) - { - free ( tempStr ); - *fStr = (SpiceChar *) NULL; - *fStrLen = 0; - return (SPICEFAILURE); - } /* end if */ - - /* - Set the output values. - */ - *fStr = tempStr; - *fStrLen = length; - - /* - Return success status. - */ - return (SPICESUCCESS); - -} /* end C2F_CreateStr */ - - - - - -void C2F_CreateStr_Sig ( ConstSpiceChar * cStr, - SpiceInt * fStrLen, - SpiceChar ** fStr ) - /* - Error signaling version of C2F_CreateStr - */ -{ - SpiceStatus status; - - status = C2F_CreateStr ( cStr, fStrLen, fStr ); - - if ( status == SPICEFAILURE ) - { - chkin_c ( "C2F_CreateStr_Sig" ); - setmsg_c ( "An attempt to create a temporary string failed." ); - sigerr_c ( "SPICE(STRINGCREATEFAIL)" ); - chkout_c ( "C2F_CreateStr_Sig" ); - return; - } - -} /* end C2F_CreateStr_Sig */ - - - - - -SpiceStatus C2F_CreateStrArr ( SpiceInt nStr, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ) -{ - SpiceInt i; - SpiceInt j; - SpiceInt maxLen; - SpiceInt tempLen; - SpiceStatus status; - SpiceChar *tempStrArr; - - /* - Find the length of the longest C string in the input array. - */ - maxLen = 0; - for (i=0; i maxLen ) - { - maxLen = tempLen; - } /* end if */ - } /* end for */ - - /* - Allocate the memory for the Fortran string array. It must be - maxLen characters wide and long enough to hold nStr Fortran strings. - */ - tempStrArr = (SpiceChar *) malloc ( maxLen * nStr ); - - if ( tempStrArr == (SpiceChar *)NULL ) - { - *fStrArr = (SpiceChar *) NULL; - *fStrLen = 0; - return (SPICEFAILURE); - } /* end if */ - - /* - Copy the C strings into the memory for the Fortran string array. The - Copy function knows to leave the NULL character that terminates each - line behind. - */ - for ( i=0; i fStrLen ) - { - return (SPICEFAILURE); - } /* end if */ - - /* - Blank fill the Fortran string. This must always be done, even if - the number of characters is zero. - */ - for ( i=0; i 0 ) - { - strncpy ( fStr, cStr, nChars ); - } /* end if */ - - /* - Return success status. - */ - return (SPICESUCCESS); - -} /* end C2F_StrCpy */ - - - -void F_Alloc ( SpiceInt fStrLen, - SpiceChar ** fStr ) -{ - /* - Local variables - */ - SpiceInt i; - - /* - Allocate a temporary string of the specified length. The string - is blank filled for safety, since it'll normally be passed to a - Fortran routine. - */ - - *fStr = (SpiceChar *) malloc ( fStrLen ); - - if ( *fStr == (SpiceChar *)NULL ) - { - chkin_c ( "F_Alloc" ); - setmsg_c ( "Attempt to allocate string of length # failed." ); - errint_c ( "#", fStrLen ); - sigerr_c ( "CSPICE(MALLOCFAILURE)" ); - chkout_c ( "F_Alloc" ); - return; - } - - for ( i = 0; i < fStrLen; i++ ) - { - (*fStr)[i] = ' '; - } - - return; -} - - - - - - -SpiceStatus F2C_CreateStr ( SpiceInt fStrLen, - ConstSpiceChar * fStr, - SpiceChar ** cStr ) -{ - SpiceInt nChars; - SpiceStatus status; - SpiceChar *tempStr; - - /* - Find the number of characters, excluding trailing blanks. - */ - nChars = F_StrLen( fStrLen, fStr ); - - /* - Add one for the NULL. - */ - nChars++; - - /* - Now we allocate a string just big enough for all of the characters - we have. If there is an error, then we return a failure status. - */ - tempStr = (SpiceChar *) malloc ( nChars ); - - if ( tempStr == (SpiceChar *)NULL ) - { - *cStr = (SpiceChar *) NULL; - return (SPICEFAILURE); - } /* end if */ - - /* - Copy the Fortran string into the C string, leaving the trailing - blanks behind and putting on the trailing NULL character. - */ - status = F2C_StrCpy ( fStrLen, fStr, nChars, tempStr ); - - if ( status == SPICEFAILURE ) - { - free ( tempStr ); - *cStr = (SpiceChar *) NULL; - return (SPICEFAILURE); - } /* end if */ - - /* - Set the output C string. - */ - *cStr = tempStr; - - /* - Return success status. - */ - return (SPICESUCCESS); - -} /* end F2C_CreateStr */ - - - - - -void F2C_CreateStr_Sig ( SpiceInt fStrLen, - ConstSpiceChar * fStr, - SpiceChar ** cStr ) - - /* - Error signaling version of F2C_CreateStr - */ -{ - SpiceStatus status; - - status = F2C_CreateStr ( fStrLen, fStr, cStr ); - - if ( status == SPICEFAILURE ) - { - chkin_c ( "F2C_CreateStr_Sig" ); - setmsg_c ( "An attempt to create a temporary string failed." ); - sigerr_c ( "SPICE(STRINGCREATEFAIL)" ); - chkout_c ( "F2C_CreateStr_Sig" ); - return; - } - -} /* end C2F_CreateStr_Sig */ - - - - - - -SpiceStatus F2C_CreateStrArr ( SpiceInt nStr, - SpiceInt fStrLen, - ConstSpiceChar * fStrArr, - SpiceChar *** cStrArr ) -{ - SpiceInt i; - SpiceInt j; - SpiceInt length; - SpiceInt nChars; - SpiceStatus status; - SpiceChar *tempStr; - SpiceChar *tempPtr; - SpiceChar **tempStrList; - - /* - Find the number of characters, excluding trailing blanks. - */ - nChars=0; - - for (i=0; i cStrMax ) - { - return (SPICEFAILURE); - } /* end if */ - - /* - Move the Fortran string into the block of memory, leaving the - trailing blanks behind. - */ - if ( nChars > 0 ) - { - strncpy ( cStr, fStr, nChars ); - } /* end if */ - - /* - Put in the NULL character. - */ - *(cStr + nChars) = '\0'; - - /* - Return success status. - */ - return (SPICESUCCESS); - -} /* end F2C_StrCpy */ - - - -void F2C_ConvertStr ( SpiceInt CStrLen, - SpiceChar * fStr ) -{ - /* - This routine converts a Fortran string to a C string in place. - A null terminator is placed after the last non-blank character - in the Fortran string. The input CStrLen indicates the number of - characters avaliable in the array pointing to by fStr. The last - character is assumed not to contain data; it will be overwritten by - a null terminator if the input string contains a non-blank character - at position fStr+CStrLen-2. - */ - - - /* - Local variables - */ - SpiceInt nChars; - - /* - Find the non-blank length of the input String. - */ - nChars = F_StrLen( CStrLen-1, fStr ); - - /* - Place a null at index nChars. - */ - fStr[ nChars ] = NULLCHAR; - - return; - -} /* End F2C_ConvertStr */ - - - -SpiceInt F_StrLen ( SpiceInt fStrLen, - ConstSpiceChar *fStr ) -{ - SpiceInt length; - SpiceInt nBlanks; - SpiceInt nChars; - - /* - We find the number of characters, excluding trailing blanks in - a Fortran string. - */ - nBlanks = 0; - length = fStrLen-1; - - while ( length >= 0 ) - { - if ( *(fStr+length) == ' ' ) - { - length--; - nBlanks++; - } /* end if */ - else - { - break; - } /* end else */ - } /* end while */ - - if ( nBlanks == fStrLen ) - { - nChars = 0; - } /* end if */ - else - { - nChars = fStrLen - nBlanks; - } /* end else */ - - /* - Return the length of the Fortran string. - */ - return (nChars); - -} /* end F_StrLen */ - - - - - - - -/* - --Procedure F2C_ConvertStrArr (String to string array) - --Abstract - - A private routine to convert a single string into an array of n - strings each element having length lenout, including the null - terminator. - --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 - - STRING - STRING ARRAY - -*/ - - void F2C_ConvertStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - n I Number of array values. - lenout I The length of the output string. - cvals I/O Values associated with name. - --Detailed_Input - - n is the number of array elements needed. - - lenout The allowed length of the output string array elements. - This length must large enough to hold the output string - plus the terminator. - - cvals on input, a character array containing n Fortran-style - strings of length lenout-1, packed together contiguously - without null terminators. - --Detailed_Output - - cvals on output, a character array containing n null-terminated - C-style strings of length lenout, including the final - nulls, packed together contiguously. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - This routine is a private routine to the CSPICE library and should - not be called directly by any user. It converts a single string into - an array of strings of equal, specified length, where each element of - the array is a substring of the original string. - - The purpose of this routine is to convert Fortran-style string arrays - to C-style arrays. - --Examples - - None. Don't call this routine. It is private for NAIF. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0 9-FEB-1998 (EDW) - --Index_Entries - - CONVERT a string into an array of strings - --& -*/ - - -{ - SpiceChar * From; - SpiceChar * To; - - SpiceInt i; - - /* - Loop over the number of requested items. Start with the last - string, so we don't overwrite anything as we shift strings towards - the end of the array. - */ - - for ( i = n; i > 0; i-- ) - { - - /* Get the pointer locations for the from and to locations. */ - - To = ( SpiceChar * ) cvals + ( lenout ) * ( i - 1 ); - From = ( SpiceChar * ) cvals + ( lenout-1 ) * ( i - 1 ); - - - memmove ( To, From , lenout - 1); - - - /* - Null-terminate the ith string in the output array. The terminator - goes in the element having ordinal position lenout, equivalent to - index lenout-1. - */ - - To[ lenout - 1 ] = NULLCHAR; - - } - -} - - - - -/* - --Procedure F2C_ConvertTrStrArr (String to trimmed string array) - --Abstract - - A private routine to convert a single string into an array of n - strings each element having length lenout, including the null - terminator. Each element of the output array has a null character - following the last non-blank data 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 - - NONE - --Keywords - - STRING - STRING ARRAY - -*/ - - void F2C_ConvertTrStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ) -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - n I Number of array values. - lenout I The length of the output string. - cvals I/O Values associated with name. - --Detailed_Input - - n is the number of array elements needed. - - lenout The allowed length of the output string array elements. - This length must large enough to hold the output string - plus the terminator. - - cvals on input, a character array containing n Fortran-style - strings of length lenout-1, packed together contiguously - without null terminators. - --Detailed_Output - - cvals on output, a character array containing n null-terminated - C-style strings of length lenout, including the final - nulls, packed together contiguously. The caller should - declare cvals - - SpiceChar cvals [n][lenout] - - Each string in the array cvals is "trimmed": a null - is placed after the last non-blank character in the - corresponding input string. - - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - This routine is a private routine to the CSPICE library and should - not be called directly by any user. It converts a single string into - an array of strings of equal, specified length, where each element of - the array is a substring of the original string. - - The purpose of this routine is to convert Fortran-style string arrays - to C-style arrays. - --Examples - - None. Don't call this routine. It is private for NAIF. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 1.0.0 09-JUL-1999 (NJB) (EDW) - --Index_Entries - - CONVERT a string into a trimmed array of strings - --& -*/ - - -{ - SpiceChar * strPtr; - - SpiceInt i; - SpiceInt npos; - - - /* - Use the traditional converter to obtain a array of C-style strings, - each having a null at index lenout-1. - */ - F2C_ConvertStrArr ( n, lenout, cvals ); - - - /* - Place a null after the last non-blank data character of each - string. - */ - - for ( i = 0; i < n; i++ ) - { - strPtr = cvals + i*lenout; - - npos = F_StrLen ( lenout-1, strPtr ); - - *( strPtr + npos ) = NULLCHAR; - } -} - - diff --git a/ext/spice/src/cspice/zzfdat.c b/ext/spice/src/cspice/zzfdat.c deleted file mode 100644 index 54be3324b2..0000000000 --- a/ext/spice/src/cspice/zzfdat.c +++ /dev/null @@ -1,1061 +0,0 @@ -/* zzfdat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__121 = 121; - -/* $Procedure ZZFDAT ( Initialize frame names and idcodes ) */ -/* Subroutine */ int zzfdat_(integer *ncount, char *name__, integer *idcode, - integer *center, integer *type__, integer *typid, integer *norder, - integer *corder, integer *centrd, ftnlen name_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), irfnam_(integer *, - char *, ftnlen), orderc_(char *, integer *, integer *, ftnlen), - orderi_(integer *, integer *, integer *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine initializes the table of frame names and their */ -/* ID codes. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* This file contains the number of non-inertial reference */ -/* frames that are currently built into the SPICE toolkit */ -/* software. */ - - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of built-in non-inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of built-in non-inertial reference */ -/* frames. This value is needed by both ZZFDAT, and */ -/* FRAMEX. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.4.0, 11-MAY-2010 (BVS) */ - -/* Increased the number of non-inertial frames from 96 to 100 */ -/* in order to accomodate the following PCK based frames: */ - -/* IAU_BORRELLY */ -/* IAU_TEMPEL_1 */ -/* IAU_VESTA */ -/* IAU_ITOKAWA */ - -/* - SPICELIB Version 1.3.0, 12-DEC-2002 (BVS) */ - -/* Increased the number of non-inertial frames from 85 to 96 */ -/* in order to accomodate the following PCK based frames: */ - -/* IAU_CALLIRRHOE */ -/* IAU_THEMISTO */ -/* IAU_MAGACLITE */ -/* IAU_TAYGETE */ -/* IAU_CHALDENE */ -/* IAU_HARPALYKE */ -/* IAU_KALYKE */ -/* IAU_IOCASTE */ -/* IAU_ERINOME */ -/* IAU_ISONOE */ -/* IAU_PRAXIDIKE */ - -/* - SPICELIB Version 1.2.0, 02-AUG-2002 (FST) */ - -/* Increased the number of non-inertial frames from 81 to 85 */ -/* in order to accomodate the following PCK based frames: */ - -/* IAU_PAN */ -/* IAU_GASPRA */ -/* IAU_IDA */ -/* IAU_EROS */ - -/* - SPICELIB Version 1.1.0, 20-FEB-1997 (WLT) */ - -/* Increased the number of non-inertial frames from 79 to 81 */ -/* in order to accomodate the following earth rotation */ -/* models: */ - -/* ITRF93 */ -/* EARTH_FIXED */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NCOUNT I Input checking variable. */ -/* NAME O array containing the names of all known frames */ -/* IDCODE O array containing the ID codes of all known frames */ -/* CENTER O array containing the centers of the known frames */ -/* TYPE O array containing the types of the known frames */ -/* TYPID O array containing the subtype id */ -/* NORDER O an order vector for NAME */ -/* CORDER O an order vector for IDCODE */ - -/* $ Detailed_Input */ - -/* NCOUNT is the number of names that the calling routine */ -/* expects to receive. It should have the value of */ -/* NNAMES which is given below for NNAMES. If this */ -/* is not the case then the error 'SPICE(BUG)' is */ -/* signaled. */ - -/* If everything has been properly called, compiled */ -/* and linked this error should never be signaled. */ -/* If it is signaled, it indicates that either a calling */ -/* sequence, or version mismatch has occurred. */ - -/* $ Detailed_Output */ - -/* All of the arrays described below should be declared with the */ -/* same dimensions---NCOUNT. */ - -/* NAME is an array of the official SPICE names for the */ -/* recognized frames (both inertial and non-inertial) */ - -/* IDCODE is an array parallel to NAME of SPICE ID codes for */ -/* the various frames. */ - -/* CENTER is an array parallel to NAME of body ID codes for */ -/* the centers of frames. */ - -/* TYPE is an array parallel to NAME of inertial frame types */ -/* for the various frames. These include INERTL, PCK, */ -/* CK, etc. */ - -/* TYPID is an array parallel to NAME of the ID code for the */ -/* frame within the TYPE of the frame. Once the class */ -/* of the frame has been identified by TYPE, TYPID is */ -/* used to access the information specific about this */ -/* frame. */ - -/* NORDER is an order vector for the array NAME. */ -/* NAME(NORDER(I)) is the I'th name in the array NAME */ -/* when ordered by the FORTRAN collating sequence. */ - -/* CORDER is an order vector for the array IDCODE. The */ -/* value IDCODE(CORDER(I)) is the I'th IDCODE when */ -/* ordered from smallest to largest. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine establishes the default SPICE */ -/* reference frames and their id-codes. In addition */ -/* it returns order vectors for both the names and the ID codes. */ - -/* This is a private routine intended solely as a support routine */ -/* for the SPICE routine FRCODE. */ - -/* $ Examples */ - -/* This routine should typically be called as part of an */ -/* initialization portion of FRCODE */ - -/* LOGICAL FIRST */ -/* SAVE FIRST */ - -/* DATA FIRST / .TRUE. / */ - - -/* IF ( FIRST ) THEN */ - -/* FIRST = .FALSE. */ -/* CALL ZZFDAT ( NCOUNT, NAME, IDCODE, NORDER, CORDER ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 4.2.0, 11-MAY-2010 (BVS) */ - -/* Added the following PCK frames: */ - -/* IAU_BORRELLY */ -/* IAU_TEMPEL_1 */ -/* IAU_VESTA */ -/* IAU_ITOKAWA */ - -/* - SPICELIB Version 4.1.0, 12-DEC-2002 (BVS) */ - -/* Added PCK frames for new Jovian satellites: */ - -/* IAU_CALLIRRHOE */ -/* IAU_THEMISTO */ -/* IAU_MAGACLITE */ -/* IAU_TAYGETE */ -/* IAU_CHALDENE */ -/* IAU_HARPALYKE */ -/* IAU_KALYKE */ -/* IAU_IOCASTE */ -/* IAU_ERINOME */ -/* IAU_ISONOE */ -/* IAU_PRAXIDIKE */ - -/* - SPICELIB Version 4.0.1, 18-OCT-2002 (EDW) */ - -/* Corrected the erroneous frame values for IAU_PAN. */ -/* Minor edits to the header. */ - -/* - SPICELIB Version 4.0.0, 02-AUG-2002 (FST) */ - -/* The frames IAU_PAN, IAU_GASPRA, IAU_IDA, and IAU_EROS */ -/* were added to the list of recognized frames. */ - -/* - SPICELIB Version 3.1.1, 20-APR-1999 (WLT) */ - -/* Changed the variable name TYPEID to TYPID in the calling */ -/* sequence to avoid having to take special measures in the f2c */ -/* conversion process. */ - -/* - SPICELIB Version 3.1.0, 11-SEP-1997 (WLT) */ - -/* The error condition check early in the routine */ -/* did not use the exception handling subsystem correctly. */ -/* This has been fixed. */ - -/* - SPICELIB Version 3.0.0, 02-JUN-1997 (WLT) */ - -/* The calling sequence changed. ZZFDAT now also returns */ -/* an order vector for the CENTERs of the frames. */ - -/* - SPICELIB Version 2.0.0, 03-APR-1997 (WLT) */ - -/* The frames ITRF93 and EARTH_FIXED were added to the */ -/* list of recognized frames. */ - -/* - SPICELIB Version 1.1.0, 14-OCT-1996 (WLT) */ - -/* Changed declarations so that the variables NINERT and */ -/* NNINRT are included instead of being declared locally. */ - -/* - SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) */ - - -/* -& */ - -/* To add to the list of recognized frames, */ - -/* 1. Determine whether or not the frame is inertial. */ - -/* Inertial Case. */ - -/* A. Be sure that the routine CHGIRF has been modified to */ -/* reflect the new frame and set NINERT (above) equal to */ -/* the number of recognized inertial frames give by CHGIRF. */ - -/* Non Inertial Case. */ - -/* A. Locate the last non-inertial frame in the lengthy list */ -/* below. */ - -/* B. Add the frame name to the array NAME. Add the IDCODE */ -/* to the array IDCODE. (Unless there is a compelling reason */ -/* to do otherwise this should just be the next integer in */ -/* the sequence of ID codes. The mixture of old and new code */ -/* should look something like this: */ - -/* Last bit of old assignments */ - -/* NAME ( NINERT + NON ) = last name in the old routine */ -/* IDCODE ( NINERT + NON ) = 10000 + NON */ - -/* Your new assignment */ - -/* NAME ( NINERT + NEXT ) = your name */ -/* IDCODE ( NINERT + NEXT ) = 10000 + NEXT */ - -/* where */ - -/* NON = the value of the parameter above */ -/* NEXT = NON + 1 */ - -/* C. Modify the value of the parameter NON above to reflect the */ -/* new number of non-inertial frames. */ - -/* 2. Update the version and date routine. */ - -/* 3. Update the routines that call this routine so that they */ -/* will be expecting the correct number of names and ID codes */ -/* to be returned. */ - - -/* Perform the consistency check first. */ - - if (*ncount != 121) { - chkin_("ZZFDAT", (ftnlen)6); - setmsg_("There is an inconsistency between the version of the routin" - "e calling ZZFDAT and the current version of ZZFDAT. Check to" - " make sure that you have the most current versions of ZZFDAT" - " and the routines that make use of it.", (ftnlen)217); - sigerr_("SPICE(VERSIONMISMATCH)", (ftnlen)22); - chkout_("ZZFDAT", (ftnlen)6); - return 0; - } - -/* Inertial Frames Section */ - -/* Fetch the names of the inertial frames from CHGIRF */ - - for (i__ = 1; i__ <= 21; ++i__) { - idcode[i__ - 1] = i__; - center[i__ - 1] = 0; - type__[i__ - 1] = 1; - typid[i__ - 1] = i__; - irfnam_(&i__, name__ + (i__ - 1) * name_len, name_len); - } - -/* Non-Inertial Frames Section. */ - -/* Note that the loop below is appropriate only for the */ -/* first 79 non-inertial frames because by construction they */ -/* are all PCK based. As new frames are added you should */ -/* use the template near the end of this routine to add */ -/* the new information. */ - - for (i__ = 22; i__ <= 100; ++i__) { - type__[i__ - 1] = 2; - } - s_copy(name__ + name_len * 21, "IAU_MERCURY_BARYCENTER", name_len, ( - ftnlen)22); - idcode[21] = 10001; - center[21] = 1; - typid[21] = 1; - s_copy(name__ + name_len * 22, "IAU_VENUS_BARYCENTER", name_len, (ftnlen) - 20); - idcode[22] = 10002; - center[22] = 2; - typid[22] = 2; - s_copy(name__ + name_len * 23, "IAU_EARTH_BARYCENTER", name_len, (ftnlen) - 20); - idcode[23] = 10003; - center[23] = 3; - typid[23] = 3; - s_copy(name__ + name_len * 24, "IAU_MARS_BARYCENTER", name_len, (ftnlen) - 19); - idcode[24] = 10004; - center[24] = 4; - typid[24] = 4; - s_copy(name__ + name_len * 25, "IAU_JUPITER_BARYCENTER", name_len, ( - ftnlen)22); - idcode[25] = 10005; - center[25] = 5; - typid[25] = 5; - s_copy(name__ + name_len * 26, "IAU_SATURN_BARYCENTER", name_len, (ftnlen) - 21); - idcode[26] = 10006; - center[26] = 6; - typid[26] = 6; - s_copy(name__ + name_len * 27, "IAU_URANUS_BARYCENTER", name_len, (ftnlen) - 21); - idcode[27] = 10007; - center[27] = 7; - typid[27] = 7; - s_copy(name__ + name_len * 28, "IAU_NEPTUNE_BARYCENTER", name_len, ( - ftnlen)22); - idcode[28] = 10008; - center[28] = 8; - typid[28] = 8; - s_copy(name__ + name_len * 29, "IAU_PLUTO_BARYCENTER", name_len, (ftnlen) - 20); - idcode[29] = 10009; - center[29] = 9; - typid[29] = 9; - s_copy(name__ + name_len * 30, "IAU_SUN", name_len, (ftnlen)7); - idcode[30] = 10010; - center[30] = 10; - typid[30] = 10; - s_copy(name__ + name_len * 31, "IAU_MERCURY", name_len, (ftnlen)11); - idcode[31] = 10011; - center[31] = 199; - typid[31] = 199; - s_copy(name__ + (name_len << 5), "IAU_VENUS", name_len, (ftnlen)9); - idcode[32] = 10012; - center[32] = 299; - typid[32] = 299; - s_copy(name__ + name_len * 33, "IAU_EARTH", name_len, (ftnlen)9); - idcode[33] = 10013; - center[33] = 399; - typid[33] = 399; - s_copy(name__ + name_len * 34, "IAU_MARS", name_len, (ftnlen)8); - idcode[34] = 10014; - center[34] = 499; - typid[34] = 499; - s_copy(name__ + name_len * 35, "IAU_JUPITER", name_len, (ftnlen)11); - idcode[35] = 10015; - center[35] = 599; - typid[35] = 599; - s_copy(name__ + name_len * 36, "IAU_SATURN", name_len, (ftnlen)10); - idcode[36] = 10016; - center[36] = 699; - typid[36] = 699; - s_copy(name__ + name_len * 37, "IAU_URANUS", name_len, (ftnlen)10); - idcode[37] = 10017; - center[37] = 799; - typid[37] = 799; - s_copy(name__ + name_len * 38, "IAU_NEPTUNE", name_len, (ftnlen)11); - idcode[38] = 10018; - center[38] = 899; - typid[38] = 899; - s_copy(name__ + name_len * 39, "IAU_PLUTO", name_len, (ftnlen)9); - idcode[39] = 10019; - center[39] = 999; - typid[39] = 999; - s_copy(name__ + name_len * 40, "IAU_MOON", name_len, (ftnlen)8); - idcode[40] = 10020; - center[40] = 301; - typid[40] = 301; - s_copy(name__ + name_len * 41, "IAU_PHOBOS", name_len, (ftnlen)10); - idcode[41] = 10021; - center[41] = 401; - typid[41] = 401; - s_copy(name__ + name_len * 42, "IAU_DEIMOS", name_len, (ftnlen)10); - idcode[42] = 10022; - center[42] = 402; - typid[42] = 402; - s_copy(name__ + name_len * 43, "IAU_IO", name_len, (ftnlen)6); - idcode[43] = 10023; - center[43] = 501; - typid[43] = 501; - s_copy(name__ + name_len * 44, "IAU_EUROPA", name_len, (ftnlen)10); - idcode[44] = 10024; - center[44] = 502; - typid[44] = 502; - s_copy(name__ + name_len * 45, "IAU_GANYMEDE", name_len, (ftnlen)12); - idcode[45] = 10025; - center[45] = 503; - typid[45] = 503; - s_copy(name__ + name_len * 46, "IAU_CALLISTO", name_len, (ftnlen)12); - idcode[46] = 10026; - center[46] = 504; - typid[46] = 504; - s_copy(name__ + name_len * 47, "IAU_AMALTHEA", name_len, (ftnlen)12); - idcode[47] = 10027; - center[47] = 505; - typid[47] = 505; - s_copy(name__ + name_len * 48, "IAU_HIMALIA", name_len, (ftnlen)11); - idcode[48] = 10028; - center[48] = 506; - typid[48] = 506; - s_copy(name__ + name_len * 49, "IAU_ELARA", name_len, (ftnlen)9); - idcode[49] = 10029; - center[49] = 507; - typid[49] = 507; - s_copy(name__ + name_len * 50, "IAU_PASIPHAE", name_len, (ftnlen)12); - idcode[50] = 10030; - center[50] = 508; - typid[50] = 508; - s_copy(name__ + name_len * 51, "IAU_SINOPE", name_len, (ftnlen)10); - idcode[51] = 10031; - center[51] = 509; - typid[51] = 509; - s_copy(name__ + name_len * 52, "IAU_LYSITHEA", name_len, (ftnlen)12); - idcode[52] = 10032; - center[52] = 510; - typid[52] = 510; - s_copy(name__ + name_len * 53, "IAU_CARME", name_len, (ftnlen)9); - idcode[53] = 10033; - center[53] = 511; - typid[53] = 511; - s_copy(name__ + name_len * 54, "IAU_ANANKE", name_len, (ftnlen)10); - idcode[54] = 10034; - center[54] = 512; - typid[54] = 512; - s_copy(name__ + name_len * 55, "IAU_LEDA", name_len, (ftnlen)8); - idcode[55] = 10035; - center[55] = 513; - typid[55] = 513; - s_copy(name__ + name_len * 56, "IAU_THEBE", name_len, (ftnlen)9); - idcode[56] = 10036; - center[56] = 514; - typid[56] = 514; - s_copy(name__ + name_len * 57, "IAU_ADRASTEA", name_len, (ftnlen)12); - idcode[57] = 10037; - center[57] = 515; - typid[57] = 515; - s_copy(name__ + name_len * 58, "IAU_METIS", name_len, (ftnlen)9); - idcode[58] = 10038; - center[58] = 516; - typid[58] = 516; - s_copy(name__ + name_len * 59, "IAU_MIMAS", name_len, (ftnlen)9); - idcode[59] = 10039; - center[59] = 601; - typid[59] = 601; - s_copy(name__ + name_len * 60, "IAU_ENCELADUS", name_len, (ftnlen)13); - idcode[60] = 10040; - center[60] = 602; - typid[60] = 602; - s_copy(name__ + name_len * 61, "IAU_TETHYS", name_len, (ftnlen)10); - idcode[61] = 10041; - center[61] = 603; - typid[61] = 603; - s_copy(name__ + name_len * 62, "IAU_DIONE", name_len, (ftnlen)9); - idcode[62] = 10042; - center[62] = 604; - typid[62] = 604; - s_copy(name__ + name_len * 63, "IAU_RHEA", name_len, (ftnlen)8); - idcode[63] = 10043; - center[63] = 605; - typid[63] = 605; - s_copy(name__ + (name_len << 6), "IAU_TITAN", name_len, (ftnlen)9); - idcode[64] = 10044; - center[64] = 606; - typid[64] = 606; - s_copy(name__ + name_len * 65, "IAU_HYPERION", name_len, (ftnlen)12); - idcode[65] = 10045; - center[65] = 607; - typid[65] = 607; - s_copy(name__ + name_len * 66, "IAU_IAPETUS", name_len, (ftnlen)11); - idcode[66] = 10046; - center[66] = 608; - typid[66] = 608; - s_copy(name__ + name_len * 67, "IAU_PHOEBE", name_len, (ftnlen)10); - idcode[67] = 10047; - center[67] = 609; - typid[67] = 609; - s_copy(name__ + name_len * 68, "IAU_JANUS", name_len, (ftnlen)9); - idcode[68] = 10048; - center[68] = 610; - typid[68] = 610; - s_copy(name__ + name_len * 69, "IAU_EPIMETHEUS", name_len, (ftnlen)14); - idcode[69] = 10049; - center[69] = 611; - typid[69] = 611; - s_copy(name__ + name_len * 70, "IAU_HELENE", name_len, (ftnlen)10); - idcode[70] = 10050; - center[70] = 612; - typid[70] = 612; - s_copy(name__ + name_len * 71, "IAU_TELESTO", name_len, (ftnlen)11); - idcode[71] = 10051; - center[71] = 613; - typid[71] = 613; - s_copy(name__ + name_len * 72, "IAU_CALYPSO", name_len, (ftnlen)11); - idcode[72] = 10052; - center[72] = 614; - typid[72] = 614; - s_copy(name__ + name_len * 73, "IAU_ATLAS", name_len, (ftnlen)9); - idcode[73] = 10053; - center[73] = 615; - typid[73] = 615; - s_copy(name__ + name_len * 74, "IAU_PROMETHEUS", name_len, (ftnlen)14); - idcode[74] = 10054; - center[74] = 616; - typid[74] = 616; - s_copy(name__ + name_len * 75, "IAU_PANDORA", name_len, (ftnlen)11); - idcode[75] = 10055; - center[75] = 617; - typid[75] = 617; - s_copy(name__ + name_len * 76, "IAU_ARIEL", name_len, (ftnlen)9); - idcode[76] = 10056; - center[76] = 701; - typid[76] = 701; - s_copy(name__ + name_len * 77, "IAU_UMBRIEL", name_len, (ftnlen)11); - idcode[77] = 10057; - center[77] = 702; - typid[77] = 702; - s_copy(name__ + name_len * 78, "IAU_TITANIA", name_len, (ftnlen)11); - idcode[78] = 10058; - center[78] = 703; - typid[78] = 703; - s_copy(name__ + name_len * 79, "IAU_OBERON", name_len, (ftnlen)10); - idcode[79] = 10059; - center[79] = 704; - typid[79] = 704; - s_copy(name__ + name_len * 80, "IAU_MIRANDA", name_len, (ftnlen)11); - idcode[80] = 10060; - center[80] = 705; - typid[80] = 705; - s_copy(name__ + name_len * 81, "IAU_CORDELIA", name_len, (ftnlen)12); - idcode[81] = 10061; - center[81] = 706; - typid[81] = 706; - s_copy(name__ + name_len * 82, "IAU_OPHELIA", name_len, (ftnlen)11); - idcode[82] = 10062; - center[82] = 707; - typid[82] = 707; - s_copy(name__ + name_len * 83, "IAU_BIANCA", name_len, (ftnlen)10); - idcode[83] = 10063; - center[83] = 708; - typid[83] = 708; - s_copy(name__ + name_len * 84, "IAU_CRESSIDA", name_len, (ftnlen)12); - idcode[84] = 10064; - center[84] = 709; - typid[84] = 709; - s_copy(name__ + name_len * 85, "IAU_DESDEMONA", name_len, (ftnlen)13); - idcode[85] = 10065; - center[85] = 710; - typid[85] = 710; - s_copy(name__ + name_len * 86, "IAU_JULIET", name_len, (ftnlen)10); - idcode[86] = 10066; - center[86] = 711; - typid[86] = 711; - s_copy(name__ + name_len * 87, "IAU_PORTIA", name_len, (ftnlen)10); - idcode[87] = 10067; - center[87] = 712; - typid[87] = 712; - s_copy(name__ + name_len * 88, "IAU_ROSALIND", name_len, (ftnlen)12); - idcode[88] = 10068; - center[88] = 713; - typid[88] = 713; - s_copy(name__ + name_len * 89, "IAU_BELINDA", name_len, (ftnlen)11); - idcode[89] = 10069; - center[89] = 714; - typid[89] = 714; - s_copy(name__ + name_len * 90, "IAU_PUCK", name_len, (ftnlen)8); - idcode[90] = 10070; - center[90] = 715; - typid[90] = 715; - s_copy(name__ + name_len * 91, "IAU_TRITON", name_len, (ftnlen)10); - idcode[91] = 10071; - center[91] = 801; - typid[91] = 801; - s_copy(name__ + name_len * 92, "IAU_NEREID", name_len, (ftnlen)10); - idcode[92] = 10072; - center[92] = 802; - typid[92] = 802; - s_copy(name__ + name_len * 93, "IAU_NAIAD", name_len, (ftnlen)9); - idcode[93] = 10073; - center[93] = 803; - typid[93] = 803; - s_copy(name__ + name_len * 94, "IAU_THALASSA", name_len, (ftnlen)12); - idcode[94] = 10074; - center[94] = 804; - typid[94] = 804; - s_copy(name__ + name_len * 95, "IAU_DESPINA", name_len, (ftnlen)11); - idcode[95] = 10075; - center[95] = 805; - typid[95] = 805; - s_copy(name__ + name_len * 96, "IAU_GALATEA", name_len, (ftnlen)11); - idcode[96] = 10076; - center[96] = 806; - typid[96] = 806; - s_copy(name__ + name_len * 97, "IAU_LARISSA", name_len, (ftnlen)11); - idcode[97] = 10077; - center[97] = 807; - typid[97] = 807; - s_copy(name__ + name_len * 98, "IAU_PROTEUS", name_len, (ftnlen)11); - idcode[98] = 10078; - center[98] = 808; - typid[98] = 808; - s_copy(name__ + name_len * 99, "IAU_CHARON", name_len, (ftnlen)10); - idcode[99] = 10079; - center[99] = 901; - typid[99] = 901; - -/* This is for the first new PCK frame---the high precision earth */ -/* frame ITRF93. */ - - s_copy(name__ + name_len * 100, "ITRF93", name_len, (ftnlen)6); - idcode[100] = 13000; - center[100] = 399; - typid[100] = 3000; - type__[100] = 2; - -/* This if for the alias frame EARTH BODYFIXED. This is a TK */ -/* class frame. To use it a FRAME kernel must be loaded via */ -/* FURNSH. */ - - s_copy(name__ + name_len * 101, "EARTH_FIXED", name_len, (ftnlen)11); - idcode[101] = 10081; - center[101] = 399; - typid[101] = 10081; - type__[101] = 4; - -/* Frames introduced into the generic NAIF PCK */ -/* system as referenced from the 1997 IAU report. */ - - s_copy(name__ + name_len * 102, "IAU_PAN", name_len, (ftnlen)7); - idcode[102] = 10082; - center[102] = 618; - typid[102] = 618; - type__[102] = 2; - s_copy(name__ + name_len * 103, "IAU_GASPRA", name_len, (ftnlen)10); - idcode[103] = 10083; - center[103] = 9511010; - typid[103] = 9511010; - type__[103] = 2; - s_copy(name__ + name_len * 104, "IAU_IDA", name_len, (ftnlen)7); - idcode[104] = 10084; - center[104] = 2431010; - typid[104] = 2431010; - type__[104] = 2; - -/* Frame referenced from the Eros orientation */ -/* model in the 2000 IAU report. */ - - s_copy(name__ + name_len * 105, "IAU_EROS", name_len, (ftnlen)8); - idcode[105] = 10085; - center[105] = 2000433; - typid[105] = 2000433; - type__[105] = 2; - -/* Frames for Jovian satellites approved by IAU in late 2002. */ - - s_copy(name__ + name_len * 106, "IAU_CALLIRRHOE", name_len, (ftnlen)14); - idcode[106] = 10086; - center[106] = 517; - typid[106] = 517; - type__[106] = 2; - s_copy(name__ + name_len * 107, "IAU_THEMISTO", name_len, (ftnlen)12); - idcode[107] = 10087; - center[107] = 518; - typid[107] = 518; - type__[107] = 2; - s_copy(name__ + name_len * 108, "IAU_MAGACLITE", name_len, (ftnlen)13); - idcode[108] = 10088; - center[108] = 519; - typid[108] = 519; - type__[108] = 2; - s_copy(name__ + name_len * 109, "IAU_TAYGETE", name_len, (ftnlen)11); - idcode[109] = 10089; - center[109] = 520; - typid[109] = 520; - type__[109] = 2; - s_copy(name__ + name_len * 110, "IAU_CHALDENE", name_len, (ftnlen)12); - idcode[110] = 10090; - center[110] = 521; - typid[110] = 521; - type__[110] = 2; - s_copy(name__ + name_len * 111, "IAU_HARPALYKE", name_len, (ftnlen)13); - idcode[111] = 10091; - center[111] = 522; - typid[111] = 522; - type__[111] = 2; - s_copy(name__ + name_len * 112, "IAU_KALYKE", name_len, (ftnlen)10); - idcode[112] = 10092; - center[112] = 523; - typid[112] = 523; - type__[112] = 2; - s_copy(name__ + name_len * 113, "IAU_IOCASTE", name_len, (ftnlen)11); - idcode[113] = 10093; - center[113] = 524; - typid[113] = 524; - type__[113] = 2; - s_copy(name__ + name_len * 114, "IAU_ERINOME", name_len, (ftnlen)11); - idcode[114] = 10094; - center[114] = 525; - typid[114] = 525; - type__[114] = 2; - s_copy(name__ + name_len * 115, "IAU_ISONOE", name_len, (ftnlen)10); - idcode[115] = 10095; - center[115] = 526; - typid[115] = 526; - type__[115] = 2; - s_copy(name__ + name_len * 116, "IAU_PRAXIDIKE", name_len, (ftnlen)13); - idcode[116] = 10096; - center[116] = 527; - typid[116] = 527; - type__[116] = 2; - -/* Frames for comets and asteroids, for which rotation constants */ -/* were added in 2006 IAU Report. */ - - s_copy(name__ + name_len * 117, "IAU_BORRELLY", name_len, (ftnlen)12); - idcode[117] = 10097; - center[117] = 1000005; - typid[117] = 1000005; - type__[117] = 2; - s_copy(name__ + name_len * 118, "IAU_TEMPEL_1", name_len, (ftnlen)12); - idcode[118] = 10098; - center[118] = 1000093; - typid[118] = 1000093; - type__[118] = 2; - s_copy(name__ + name_len * 119, "IAU_VESTA", name_len, (ftnlen)9); - idcode[119] = 10099; - center[119] = 2000004; - typid[119] = 2000004; - type__[119] = 2; - s_copy(name__ + name_len * 120, "IAU_ITOKAWA", name_len, (ftnlen)11); - idcode[120] = 10100; - center[120] = 2025143; - typid[120] = 2025143; - type__[120] = 2; - -/* Below is a template to use for adding another non-inertial */ -/* frame. Copy it, fill in the new values and then leave */ -/* a new template for the next person who needs to modify this */ -/* routine. */ - -/* NAME ( NINERT + 101 ) = name */ -/* IDCODE ( NINERT + 101 ) = 10101 */ -/* CENTER ( NINERT + 101 ) = center */ -/* TYPID ( NINERT + 101 ) = type ID code */ -/* TYPE ( NINERT + 101 ) = type (INERTL, PCK, etc. ) */ - - orderc_(name__, &c__121, norder, name_len); - orderi_(idcode, &c__121, corder); - orderi_(center, &c__121, centrd); - return 0; -} /* zzfdat_ */ - diff --git a/ext/spice/src/cspice/zzfovaxi.c b/ext/spice/src/cspice/zzfovaxi.c deleted file mode 100644 index 21de077ab2..0000000000 --- a/ext/spice/src/cspice/zzfovaxi.c +++ /dev/null @@ -1,397 +0,0 @@ -/* zzfovaxi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure ZZFOVAXI ( Generate an axis vector for polygonal FOV ) */ -/* Subroutine */ int zzfovaxi_(char *inst, integer *n, doublereal *bounds, - doublereal *axis, ftnlen inst_len) -{ - /* System generated locals */ - integer bounds_dim2, i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal uvec[3]; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vsep_(doublereal *, doublereal *); - integer next; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), zzhullax_( - char *, integer *, doublereal *, doublereal *, ftnlen); - integer i__; - doublereal v[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal limit; - extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal - *); - extern logical vzero_(doublereal *); - doublereal cp[3]; - extern logical failed_(void); - logical ok; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - extern doublereal halfpi_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *) - , chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - doublereal sep; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Generate an axis of an instrument's polygonal FOV such that all */ -/* of the FOV's boundary vectors have angular separation of strictly */ -/* less than pi/2 radians from this axis. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* GF */ -/* IK */ -/* KERNEL */ - -/* $ Keywords */ - -/* FOV */ -/* GEOMETRY */ -/* INSTRUMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARGIN P Minimum complement of FOV cone angle. */ -/* INST I Instrument name. */ -/* N I Number of FOV boundary vectors. */ -/* BOUNDS I FOV boundary vectors. */ -/* AXIS O Instrument FOV axis vector. */ - -/* $ Detailed_Input */ - -/* INST is the name of an instrument with which the field of */ -/* view (FOV) of interest is associated. This name is */ -/* used only to generate long error messages. */ - -/* N is the number of boundary vectors in the array */ -/* BOUNDS. */ - -/* BOUNDS is an array of N vectors emanating from a common */ -/* vertex and defining the edges of a pyramidal region in */ -/* three-dimensional space: this the region within the */ -/* FOV of the instrument designated by INST. The Ith */ -/* vector of BOUNDS resides in elements (1:3,I) of this */ -/* array. */ - -/* The vectors contained in BOUNDS are called the */ -/* "boundary vectors" of the FOV. */ - -/* The boundary vectors must satisfy the constraints: */ - -/* 1) The boundary vectors must be contained within */ -/* a right circular cone of angular radius less */ -/* than than (pi/2) - MARGIN radians; in other */ -/* words, there must be a vector A such that all */ -/* boundary vectors have angular separation from */ -/* A of less than (pi/2)-MARGIN radians. */ - -/* 2) There must be a pair of vectors U, V in BOUNDS */ -/* such that all other boundary vectors lie in */ -/* the same half space bounded by the plane */ -/* containing U and V. Furthermore, all other */ -/* boundary vectors must have orthogonal */ -/* projections onto a plane normal to this plane */ -/* such that the projections have angular */ -/* separation of at least 2*MARGIN radians from */ -/* the plane spanned by U and V. */ - -/* Given the first constraint above, there is plane PL */ -/* such that each of the set of rays extending the */ -/* boundary vectors intersects PL. (In fact, there is an */ -/* infinite set of such planes.) The boundary vectors */ -/* must be ordered so that the set of line segments */ -/* connecting the intercept on PL of the ray extending */ -/* the Ith vector to that of the (I+1)st, with the Nth */ -/* intercept connected to the first, form a polygon (the */ -/* "FOV polygon") constituting the intersection of the */ -/* FOV pyramid with PL. This polygon may wrap in either */ -/* the positive or negative sense about a ray emanating */ -/* from the FOV vertex and passing through the plane */ -/* region bounded by the FOV polygon. */ - -/* The FOV polygon need not be convex; it may be */ -/* self-intersecting as well. */ - -/* No pair of consecutive vectors in BOUNDS may be */ -/* linearly dependent. */ - -/* The boundary vectors need not have unit length. */ - - -/* $ Detailed_Output */ - -/* AXIS is a unit vector normal to a plane containing the */ -/* FOV polygon. All boundary vectors have angular */ -/* separation from AXIS of not more than */ - -/* ( pi/2 ) - MARGIN */ - -/* radians. */ - -/* This routine signals an error if it cannot find */ -/* a satisfactory value of AXIS. */ - -/* $ Parameters */ - -/* MARGIN is a small positive number used to constrain the */ -/* orientation of the boundary vectors. See the two */ -/* constraints described in the Detailed_Input section */ -/* above for specifics. */ - -/* $ Exceptions */ - -/* 1) In the input vector count N is not at least 3, the error */ -/* SPICE(INVALIDCOUNT) is signaled. */ - -/* 2) If any pair of consecutive boundary vectors has cross */ -/* product zero, the error SPICE(DEGENERATECASE) is signaled. */ -/* For this test, the first vector is considered the successor */ -/* of the Nth. */ - -/* 3) If this routine can't find a face of the convex hull of */ -/* the set of boundary vectors such that this face satisfies */ -/* constraint (2) of the Detailed_Input section above, the */ -/* error SPICE(FACENOTFOUND) is signaled. */ - -/* 4) If any boundary vectors have longitude too close to 0 */ -/* or too close to pi radians in the face frame (see discussion */ -/* of the search algorithm's steps 3 and 4 in Particulars */ -/* below), the respective errors SPICE(NOTSUPPORTED) or */ -/* SPICE(FOVTOOWIDE) are signaled. */ - -/* 5) If any boundary vectors have angular separation of more than */ -/* (pi/2)-MARGIN radians from the candidate FOV axis, the */ -/* error SPICE(FOVTOOWIDE) is signaled. */ - -/* $ Files */ - -/* The boundary vectors input to this routine are typically */ -/* obtained from an IK file. */ - -/* $ Particulars */ - -/* Normally implementation is not discussed in SPICE headers, but we */ -/* make an exception here because this routine's implementation and */ -/* specification are deeply intertwined. */ - -/* This routine first computes the average of the unitized input */ -/* boundary vectors; if this vector satisfies the angular separation */ -/* constraint (1) in Detailed_Input, a unit length copy of this */ -/* vector is returned as the FOV axis. */ - -/* If the procedure above fails, an algorithm based on selection */ -/* of a suitable face of the boundary vector's convex hull is tried. */ -/* See the routine ZZHULLAX for details. */ - -/* If the second approach fails, an error is signaled. */ - -/* Note that it's easy to construct FOVs where the average of the */ -/* boundary vectors doesn't yield a viable axis: a FOV of angular */ -/* width nearly equal to pi radians, with a sufficiently large */ -/* number of boundary vectors on one side and few boundary vectors */ -/* on the other, is one such example. This routine can find an */ -/* axis for many such intractable FOVs---that's why ZZHULLAX */ -/* is called after the simple approach fails. */ - -/* $ Examples */ - -/* See SPICELIB private routine ZZGFFVIN. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine. User applications should not */ -/* call this routine. */ - -/* 2) There may "reasonable" polygonal FOVs that cannot be handled */ -/* by this routine. See the discussions in Detailed_Input, */ -/* Exceptions, and Particulars above for restrictions on the */ -/* input set of FOV boundary vectors. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - /* Parameter adjustments */ - bounds_dim2 = *n; - - /* Function Body */ - if (return_()) { - return 0; - } - chkin_("ZZFOVAXI", (ftnlen)8); - -/* We must have at least 3 boundary vectors. */ - - if (*n < 3) { - setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb" - "er supplied for # was #.", (ftnlen)83); - errch_("#", inst, (ftnlen)1, inst_len); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZFOVAXI", (ftnlen)8); - return 0; - } - -/* Check for linearly dependent consecutive boundary vectors. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Set the index of the next ray. When we get to the */ -/* last boundary vector, the next ray is the first. */ - - if (i__ == *n) { - next = 1; - } else { - next = i__ + 1; - } - -/* Find the cross product of the first ray with the */ -/* second. Depending on the ordering of the boundary */ -/* vectors, this could be an inward or outward normal, */ -/* in the case the current face is is exterior. */ - - vcrss_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ? - i__2 : s_rnge("bounds", i__2, "zzfovaxi_", (ftnlen)313)], & - bounds[(i__3 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__3 ? - i__3 : s_rnge("bounds", i__3, "zzfovaxi_", (ftnlen)313)], cp); - -/* We insist on consecutive boundary vectors being */ -/* linearly independent. */ - - if (vzero_(cp)) { - setmsg_("Polygonal FOV must have linearly independent consecutiv" - "e boundary but vectors at indices # and # have cross pro" - "duct equal to the zero vector. Instrument is #.", (ftnlen) - 158); - errint_("#", &i__, (ftnlen)1); - errint_("#", &next, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZFOVAXI", (ftnlen)8); - return 0; - } - } - -/* First try the average of the FOV unit boundary vectors as */ -/* a candidate axis. In many cases, this simple approach */ -/* does the trick. */ - - cleard_(&c__3, axis); - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - vhat_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ? - i__2 : s_rnge("bounds", i__2, "zzfovaxi_", (ftnlen)346)], - uvec); - vadd_(uvec, axis, v); - vequ_(v, axis); - } - d__1 = 1. / *n; - vsclip_(&d__1, axis); - -/* If each boundary vector has sufficiently small */ -/* angular separation from AXIS, we're done. */ - - limit = halfpi_() - 1e-12; - ok = TRUE_; - i__ = 1; - while(i__ <= *n && ok) { - sep = vsep_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= - i__1 ? i__1 : s_rnge("bounds", i__1, "zzfovaxi_", (ftnlen)365) - ], axis); - if (sep > limit) { - ok = FALSE_; - } else { - ++i__; - } - } - if (! ok) { - -/* See whether we can find an axis using a */ -/* method based on finding a face of the convex */ -/* hull of the FOV. ZZHULLAX signals an error */ -/* if it doesn't succeed. */ - - zzhullax_(inst, n, bounds, axis, inst_len); - if (failed_()) { - chkout_("ZZFOVAXI", (ftnlen)8); - return 0; - } - } - -/* At this point AXIS is valid. Make the axis vector unit length. */ - - vhatip_(axis); - chkout_("ZZFOVAXI", (ftnlen)8); - return 0; -} /* zzfovaxi_ */ - diff --git a/ext/spice/src/cspice/zzfrmch0.c b/ext/spice/src/cspice/zzfrmch0.c deleted file mode 100644 index c7d087a38d..0000000000 --- a/ext/spice/src/cspice/zzfrmch0.c +++ /dev/null @@ -1,878 +0,0 @@ -/* zzfrmch0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ZZFRMCH0 (Frame Change) */ -/* Subroutine */ int zzfrmch0_(integer *frame1, integer *frame2, doublereal * - et, doublereal *xform) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, - i__11, i__12, i__13; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer node; - logical done; - integer cent; - extern /* Subroutine */ int zzfrmgt0_(integer *, doublereal *, doublereal - *, integer *, logical *); - integer this__; - extern /* Subroutine */ int zznofcon_(doublereal *, integer *, integer *, - integer *, integer *, char *, ftnlen); - integer i__, j, k, l, frame[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer class__; - logical found; - integer relto; - doublereal trans[504] /* was [6][6][14] */, trans2[72] /* - was [6][6][2] */; - extern logical failed_(void); - integer cmnode; - extern integer isrchi_(integer *, integer *, integer *); - integer clssid; - extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, - integer *, logical *); - logical gotone; - extern /* Subroutine */ int chkout_(char *, ftnlen); - char errmsg[1840]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *, - ftnlen); - doublereal tempxf[36] /* was [6][6] */; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *), zzmsxf_( - doublereal *, integer *, doublereal *); - integer inc, get, put; - -/* $ Abstract */ - -/* Return the state transformation matrix from one */ -/* frame to another. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRAME1 I the frame id-code for some reference frame */ -/* FRAME2 I the frame id-code for some reference frame */ -/* ET I an epoch in TDB seconds past J2000. */ -/* XFORM O a state transformation matrix */ - -/* $ Detailed_Input */ - -/* FRAME1 is the frame id-code in which some states are known. */ - -/* FRAME2 is the frame id-code for some frame in which you */ -/* would like to represent states. */ - -/* ET is the epoch at which to compute the state */ -/* transformation matrix. This epoch should be */ -/* in TDB seconds past the ephemeris epoch of J2000. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6 x 6 state transformation matrix that can */ -/* be used to transform states relative to the frame */ -/* correspsonding to frame FRAME2 to states relative */ -/* to the frame FRAME2. More explicitely, if STATE */ -/* is the state of some object relative to the reference */ -/* frame of FRAME1 then STATE2 is the state of the */ -/* same object relative to FRAME2 where STATE2 is */ -/* computed via the subroutine call below */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, STATE2 ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the reference frames is unrecognized, the error */ -/* SPICE(UNKNOWNFRAME) will be signalled. */ - -/* 2) If the auxillary information needed to compute a non-inertial */ -/* frame is not available an error will be diagnosed and signalled */ -/* by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to compute the state transformation matrix */ -/* between two reference frames. */ - -/* The currently supported reference frames are IAU bodyfixed frames */ -/* and inertial reference frames. */ - -/* $ Examples */ - -/* Example 1. Suppose that you have a state STATE1 at epoch ET */ -/* relative to FRAME1 and wish to determine its representation */ -/* STATE2 relative to FRAME2. The following subroutine calls */ -/* would suffice to make this transformation. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, XFORM ) */ -/* CALL MXVG ( XFORM, STATE1, 6, 6, STATE2 ) */ - - - -/* Example 2. Suppose that you have the angular velocity, W, of some */ -/* rotation relative to FRAME1 at epoch ET and that you wish to */ -/* express this angular velocity with respect to FRAME2. The */ -/* following subroutines will suffice to perform this computation. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */ - -/* Recall that a state transformation matrix has the following form. */ - - -/* - - */ -/* | | */ -/* | R 0 | */ -/* | | */ -/* | | */ -/* | dR | */ -/* | -- R | */ -/* | dt | */ -/* | | */ -/* - - */ - - -/* The velocity of an arbitrary point P undergoing rotation with the */ -/* angular velocity W is W x P */ - -/* Thus the velocity of P in FRAME2 is: */ - - -/* dR */ -/* -- P + R (W x P ) */ -/* dt */ - -/* dR t */ -/* = ( -- R R P + W x P ) ( 1 ) */ -/* dt */ - - -/* dR t t */ -/* But -- R is skew symmetric (simply differentiate R*R to see */ -/* dt */ -/* dR t */ -/* this ). Hence -- R R P can be written as Ax(R*P) for some fixed */ -/* dt */ - -/* vector A. Moreover the vector A can be read from the upper */ - -/* dR t */ -/* triangular portion of -- R . So that equation (1) above can */ -/* dt */ - -/* be re-written as */ - -/* dR t */ -/* = ( -- R R*P + R*(WxP) ) */ -/* dt */ - -/* = Ax(R*P) + R*W x R*P */ - -/* = ( [A+R*W] x R*P ) */ - - -/* From this final expression it follows that in FRAME2 the angular */ -/* velocity vector is given by [A+R*W]. */ - -/* The code below implements these ideas. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */ - - -/* DO I = 1, 3 */ -/* DO J = 1, 3 */ - -/* RT ( I, J ) = STXFRM ( I, J ) */ -/* DRDT( I, J ) = STXFRM ( I+3, J ) */ - -/* END DO */ -/* END DO */ - -/* CALL MXMT ( DRDT, R, AMATRIX ) */ - -/* Read the angular velocity of R from the skew symmetric matrix */ - -/* dR t */ -/* -- R */ -/* dt */ - -/* Recall that if A has components A1, A2, A3 then the matrix */ -/* cooresponding to the cross product linear mapping is: */ - -/* - - */ -/* | 0 -A3 A2 | */ -/* | | */ -/* | A3 0 -A1 | */ -/* | | */ -/* | -A2 A1 0 | */ -/* - - */ - -/* A(1) = -AMATRIX(2,3) */ -/* A(2) = AMATRIX(1,3) */ -/* A(3) = -AMATRIX(1,2) */ - -/* CALL MXV ( R, W1, W ) */ -/* CALL VADD ( A, W, W2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ - -/* Upgraded long error message associated with frame */ -/* connection failure. */ - -/* - SPICELIB Version 1.1.0, 25-JUL-1996 (WLT) */ - -/* Bug Fix: */ - -/* The previous edition of the routine had a bug in the */ -/* first pass of the DO WHILE that looks for a frame */ -/* in the chain of frames associated with FRAME2 that is */ -/* in common with the chain of frames for FRAME1. */ - -/* On machines where variables are created as static */ -/* variables, this error could lead to finding a frame */ -/* when a legitimate path between FRAME1 and FRAME2 */ -/* did not exist. */ - -/* - SPICELIB Version 1.0.1, 06-MAR-1996 (WLT) */ - -/* An typo was fixed in the Brief I/O section. It used */ -/* to say TDT instead of the correct time system TDB. */ - -/* - SPICELIB Version 1.0.0, 28-SEP-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Transform states from one frame to another */ - -/* -& */ - -/* SPICE functions */ - - -/* Local Parameters */ - - -/* The root of all reference frames is J2000 (Frame ID = 1). */ - - -/* Local Variables */ - - -/* TRANS contains the transformations from FRAME1 to FRAME2 */ -/* TRANS(1...6,1...6,I) has the transfromation from FRAME(I) */ -/* to FRAME(I+1). We make extra room in TRANS because we */ -/* plan to add transformations beyond the obvious chain from */ -/* FRAME1 to a root node. */ - - -/* TRANS2 is used to store intermediate transformations from */ -/* FRAME2 to some node in the chain from FRAME1 to PCK or */ -/* INERTL frames. */ - - -/* FRAME contains the frames we transform from in going from */ -/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ - - -/* NODE counts the number of transformations needed to go */ -/* from FRAME1 to FRAME2. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZFRMCH0", (ftnlen)8); - -/* Do the obvious thing first. If FRAME1 and FRAME2 are the */ -/* same then we simply return the identity matrix. */ - - if (*frame1 == *frame2) { - for (i__ = 1; i__ <= 6; ++i__) { - xform[(i__1 = i__ + i__ * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmch0_", (ftnlen)371)] = 1.; - i__1 = i__ - 1; - for (j = 1; j <= i__1; ++j) { - xform[(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zzfrmch0_", (ftnlen)374)] = 0.; - xform[(i__2 = j + i__ * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zzfrmch0_", (ftnlen)375)] = 0.; - } - } - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; - } - -/* Now perform the obvious check to make sure that both */ -/* frames are recognized. */ - - frinfo_(frame1, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame1, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; - } - frinfo_(frame2, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame2, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; - } - node = 1; - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, - "zzfrmch0_", (ftnlen)418)] = *frame1; - found = TRUE_; - -/* Follow the chain of transformations until we run into */ -/* one that transforms to J2000 (frame id = 1) or we hit FRAME2. */ - - while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch0_", (ftnlen)424)] != 1 && node < 10 && frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzfrmch0_", (ftnlen)424)] != *frame2 && found) { - -/* Find out what transformation is available for this */ -/* frame. */ - - zzfrmgt0_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzfrmch0_", (ftnlen)432)], et, &trans[(i__2 = - (node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "zzfrmch0_", (ftnlen)432)], &frame[(i__3 = - node) < 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "zzfr" - "mch0_", (ftnlen)432)], &found); - if (found) { - -/* We found a transformation matrix. TRANS(1,1,NODE) */ -/* now contains the transformation from FRAME(NODE) */ -/* to FRAME(NODE+1). We need to look up the information */ -/* for the next NODE. */ - - ++node; - } - } - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch0_", (ftnlen)448)] == 1 || frame[(i__2 = node - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "zzfrmch0_", ( - ftnlen)448)] == *frame2 || ! found; - while(! done) { - -/* The only way to get to this point is to have run out of */ -/* room in the array of reference frame transformation */ -/* buffers. We will now build the transformation from */ -/* the previous NODE to whatever the next node in the */ -/* chain is. We'll do this until we get to one of the */ -/* root classes or we run into FRAME2. */ - - zzfrmgt0_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzfrmch0_", (ftnlen)462)], et, &trans[(i__2 = - (node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "zzfrmch0_", (ftnlen)462)], &relto, &found); - if (found) { - -/* Recall that TRANS(1,1,NODE-1) contains the transformation */ -/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ -/* FRAME(NODE) with the frame indicated by RELTO. This means */ -/* that TRANS(1,1,NODE-1) should be replaced with the */ -/* transformation from FRAME(NODE) to RELTO. */ - - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch0_", (ftnlen)473)] = relto; - zzmsxf_(&trans[(i__1 = ((node - 1) * 6 + 1) * 6 - 42) < 504 && 0 - <= i__1 ? i__1 : s_rnge("trans", i__1, "zzfrmch0_", ( - ftnlen)474)], &c__2, tempxf); - for (i__ = 1; i__ <= 6; ++i__) { - for (j = 1; j <= 6; ++j) { - trans[(i__1 = i__ + (j + (node - 1) * 6) * 6 - 43) < 504 - && 0 <= i__1 ? i__1 : s_rnge("trans", i__1, "zzf" - "rmch0_", (ftnlen)478)] = tempxf[(i__2 = i__ + j * - 6 - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("tempxf", - i__2, "zzfrmch0_", (ftnlen)478)]; - } - } - } - -/* We are done if the class of the last frame is J2000 */ -/* or if the last frame is FRAME2 or if we simply couldn't get */ -/* another transformation. */ - - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzfrmch0_", (ftnlen)488)] == 1 || frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzfrmch0_", (ftnlen)488)] == *frame2 || ! found; - } - -/* Right now we have the following situation. We have in hand */ -/* a collection of transformations between frames. (Assuming */ -/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ -/* no transformations computed yet. */ - - -/* TRANS(1...6, 1...6, 1 ) transforms FRAME1 to FRAME(2) */ -/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */ -/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */ -/* . */ -/* . */ -/* . */ -/* TRANS(1...6, 1...6, NODE-1 ) transforms FRAME(NODE-1) */ -/* to FRAME(NODE) */ - - -/* One of the following situations is true. */ - -/* 1) FRAME(NODE) is the root of all frames, J2000. */ - -/* 2) FRAME(NODE) is the same as FRAME2 */ - -/* 3) There is no transformation from FRAME(NODE) to another */ -/* more fundamental frame. The chain of transformations */ -/* from FRAME1 stops at FRAME(NODE). This means that the */ -/* "frame atlas" is incomplete because we can't get to the */ -/* root frame. */ - -/* We now have to do essentially the same thing for FRAME2. */ - - if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch0_", (ftnlen)526)] == *frame2) { - -/* We can handle this one immediately with the private routine */ -/* ZZMSXF which multiplies a series of state transformation */ -/* matrices. */ - - i__1 = node - 1; - zzmsxf_(trans, &i__1, xform); - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; - } - -/* We didn't luck out above. So we follow the chain of */ -/* transformation for FRAME2. Note that at the moment the */ -/* chain of transformations from FRAME2 to other frames */ -/* does not share a node in the chain for FRAME1. */ -/* ( GOTONE = .FALSE. ) . */ - - this__ = *frame2; - gotone = FALSE_; - -/* First see if there is any chain to follow. */ - - done = this__ == 1; - -/* Set up the matrices TRANS2(,,1) and TRANS(,,2) and set up */ -/* PUT and GET pointers so that we know where to GET the partial */ -/* transformation from and where to PUT partial results. */ - - if (! done) { - for (k = 1; k <= 2; ++k) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 4; j <= 6; ++j) { - trans2[(i__1 = i__ + (j + k * 6) * 6 - 43) < 72 && 0 <= - i__1 ? i__1 : s_rnge("trans2", i__1, "zzfrmch0_", - (ftnlen)563)] = 0.; - } - } - } - put = 1; - get = 1; - inc = 1; - } - -/* Follow the chain of transformations until we run into */ -/* one that transforms to the root frame or we land in the */ -/* chain of nodes for FRAME1. */ - -/* Note that this time we will simply keep track of the full */ -/* translation from FRAME2 to the last node. */ - - while(! done) { - -/* Find out what transformation is available for this */ -/* frame. */ - - if (this__ == *frame2) { - -/* This is the first pass, just put the transformation */ -/* directly into TRANS2(,,PUT). */ - - zzfrmgt0_(&this__, et, &trans2[(i__1 = (put * 6 + 1) * 6 - 42) < - 72 && 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, "zzfrmch" - "0_", (ftnlen)592)], &relto, &found); - if (found) { - this__ = relto; - get = put; - put += inc; - inc = -inc; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } else { - -/* Fetch the transformation into a temporary spot TEMPXF */ - - zzfrmgt0_(&this__, et, tempxf, &relto, &found); - if (found) { - -/* Next multiply TEMPXF on the right by the last partial */ -/* product (in TRANS2(,,GET) ). We do this in line because */ -/* we can cut down the number of multiplies to 3/8 of the */ -/* normal result of MXMG. For a discussion of why this */ -/* works see ZZMSXF. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "zzfrmch0_", (ftnlen)621)] = tempxf[(i__2 = - i__ - 1) < 36 && 0 <= i__2 ? i__2 : s_rnge( - "tempxf", i__2, "zzfrmch0_", (ftnlen)621)] * - trans2[(i__3 = (j + get * 6) * 6 - 42) < 72 && - 0 <= i__3 ? i__3 : s_rnge("trans2", i__3, - "zzfrmch0_", (ftnlen)621)] + tempxf[(i__4 = - i__ + 5) < 36 && 0 <= i__4 ? i__4 : s_rnge( - "tempxf", i__4, "zzfrmch0_", (ftnlen)621)] * - trans2[(i__5 = (j + get * 6) * 6 - 41) < 72 && - 0 <= i__5 ? i__5 : s_rnge("trans2", i__5, - "zzfrmch0_", (ftnlen)621)] + tempxf[(i__6 = - i__ + 11) < 36 && 0 <= i__6 ? i__6 : s_rnge( - "tempxf", i__6, "zzfrmch0_", (ftnlen)621)] * - trans2[(i__7 = (j + get * 6) * 6 - 40) < 72 && - 0 <= i__7 ? i__7 : s_rnge("trans2", i__7, - "zzfrmch0_", (ftnlen)621)]; - } - } - for (i__ = 4; i__ <= 6; ++i__) { - for (j = 1; j <= 3; ++j) { - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "zzfrmch0_", (ftnlen)630)] = tempxf[(i__2 = - i__ - 1) < 36 && 0 <= i__2 ? i__2 : s_rnge( - "tempxf", i__2, "zzfrmch0_", (ftnlen)630)] * - trans2[(i__3 = (j + get * 6) * 6 - 42) < 72 && - 0 <= i__3 ? i__3 : s_rnge("trans2", i__3, - "zzfrmch0_", (ftnlen)630)] + tempxf[(i__4 = - i__ + 5) < 36 && 0 <= i__4 ? i__4 : s_rnge( - "tempxf", i__4, "zzfrmch0_", (ftnlen)630)] * - trans2[(i__5 = (j + get * 6) * 6 - 41) < 72 && - 0 <= i__5 ? i__5 : s_rnge("trans2", i__5, - "zzfrmch0_", (ftnlen)630)] + tempxf[(i__6 = - i__ + 11) < 36 && 0 <= i__6 ? i__6 : s_rnge( - "tempxf", i__6, "zzfrmch0_", (ftnlen)630)] * - trans2[(i__7 = (j + get * 6) * 6 - 40) < 72 && - 0 <= i__7 ? i__7 : s_rnge("trans2", i__7, - "zzfrmch0_", (ftnlen)630)] + tempxf[(i__8 = - i__ + 17) < 36 && 0 <= i__8 ? i__8 : s_rnge( - "tempxf", i__8, "zzfrmch0_", (ftnlen)630)] * - trans2[(i__9 = (j + get * 6) * 6 - 39) < 72 && - 0 <= i__9 ? i__9 : s_rnge("trans2", i__9, - "zzfrmch0_", (ftnlen)630)] + tempxf[(i__10 = - i__ + 23) < 36 && 0 <= i__10 ? i__10 : s_rnge( - "tempxf", i__10, "zzfrmch0_", (ftnlen)630)] * - trans2[(i__11 = (j + get * 6) * 6 - 38) < 72 - && 0 <= i__11 ? i__11 : s_rnge("trans2", - i__11, "zzfrmch0_", (ftnlen)630)] + tempxf[( - i__12 = i__ + 29) < 36 && 0 <= i__12 ? i__12 : - s_rnge("tempxf", i__12, "zzfrmch0_", (ftnlen) - 630)] * trans2[(i__13 = (j + get * 6) * 6 - - 37) < 72 && 0 <= i__13 ? i__13 : s_rnge("tra" - "ns2", i__13, "zzfrmch0_", (ftnlen)630)]; - } - } - -/* Note that we don't have to compute the upper right */ -/* hand block. It's already set to zero by construction. */ - -/* Finally we can just copy the lower right hand block */ -/* from the upper left hand block of the matrix. */ - - for (i__ = 4; i__ <= 6; ++i__) { - k = i__ - 3; - for (j = 4; j <= 6; ++j) { - l = j - 3; - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "zzfrmch0_", (ftnlen)649)] = trans2[(i__2 = k - + (l + put * 6) * 6 - 43) < 72 && 0 <= i__2 ? - i__2 : s_rnge("trans2", i__2, "zzfrmch0_", ( - ftnlen)649)]; - } - } - -/* Adjust GET and PUT so that GET points to the slots */ -/* where we just stored the result of our multiply and */ -/* so that PUT points to the next available storage */ -/* locations. */ - - get = put; - put += inc; - inc = -inc; - this__ = relto; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } - -/* See if we have a common node and determine whether or not */ -/* we are done with this loop. */ - - done = this__ == 1 || gotone || ! found; - } - -/* There are two possible scenarios. Either the chain of */ -/* transformations from FRAME2 ran into a node in the chain for */ -/* FRAME1 or it didn't. (The common node might very well be */ -/* the root node.) If we didn't run into a common one, then */ -/* the two chains don't intersect and there is no way to */ -/* get from FRAME1 to FRAME2. */ - - if (! gotone) { - zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("frame", i__1, "zzfrmch0_", (ftnlen)692)], - frame2, &this__, errmsg, (ftnlen)1840); - if (failed_()) { - -/* We were unable to create the error message. This */ -/* unfortunate situation could arise if a frame kernel */ -/* is corrupted. */ - - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; - } - -/* The normal case: signal an error with a descriptive long */ -/* error message. */ - - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; - } - -/* Recall that we have the following. */ - -/* TRANS(1...6, 1...6, 1 ) transforms FRAME(1) to FRAME(2) */ -/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */ -/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */ - -/* TRANS(1...6, 1...6, CMNODE-1) transforms FRAME(CMNODE-1) */ -/* to FRAME(CMNODE) */ - -/* and that TRANS2(1,1,GET) transforms from FRAME2 to CMNODE. */ -/* Hence the inverse of TRANS2(1,1,GET) transforms from CMNODE */ -/* to FRAME2. */ - -/* If we compute the inverse of TRANS2 and store it in */ -/* the next available slot of TRANS (.i.e. TRANS(1,1,CMNODE) */ -/* we can simply apply our custom routine that multiplies a */ -/* sequence of transformation matrices together to get the */ -/* result from FRAME1 to FRAME2. */ - - invstm_(&trans2[(i__1 = (get * 6 + 1) * 6 - 42) < 72 && 0 <= i__1 ? i__1 : - s_rnge("trans2", i__1, "zzfrmch0_", (ftnlen)735)], &trans[(i__2 = - (cmnode * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "zzfrmch0_", (ftnlen)735)]); - zzmsxf_(trans, &cmnode, xform); - chkout_("ZZFRMCH0", (ftnlen)8); - return 0; -} /* zzfrmch0_ */ - diff --git a/ext/spice/src/cspice/zzfrmch1.c b/ext/spice/src/cspice/zzfrmch1.c deleted file mode 100644 index ed4eaf6cfa..0000000000 --- a/ext/spice/src/cspice/zzfrmch1.c +++ /dev/null @@ -1,878 +0,0 @@ -/* zzfrmch1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ZZFRMCH1 (Frame Change) */ -/* Subroutine */ int zzfrmch1_(integer *frame1, integer *frame2, doublereal * - et, doublereal *xform) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, - i__11, i__12, i__13; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer node; - logical done; - integer cent; - extern /* Subroutine */ int zzfrmgt1_(integer *, doublereal *, doublereal - *, integer *, logical *); - integer this__; - extern /* Subroutine */ int zznofcon_(doublereal *, integer *, integer *, - integer *, integer *, char *, ftnlen); - integer i__, j, k, l, frame[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer class__; - logical found; - integer relto; - doublereal trans[504] /* was [6][6][14] */, trans2[72] /* - was [6][6][2] */; - extern logical failed_(void); - integer cmnode; - extern integer isrchi_(integer *, integer *, integer *); - integer clssid; - extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, - integer *, logical *); - logical gotone; - extern /* Subroutine */ int chkout_(char *, ftnlen); - char errmsg[1840]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *, - ftnlen); - doublereal tempxf[36] /* was [6][6] */; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *), zzmsxf_( - doublereal *, integer *, doublereal *); - integer inc, get, put; - -/* $ Abstract */ - -/* Return the state transformation matrix from one */ -/* frame to another. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRAME1 I the frame id-code for some reference frame */ -/* FRAME2 I the frame id-code for some reference frame */ -/* ET I an epoch in TDB seconds past J2000. */ -/* XFORM O a state transformation matrix */ - -/* $ Detailed_Input */ - -/* FRAME1 is the frame id-code in which some states are known. */ - -/* FRAME2 is the frame id-code for some frame in which you */ -/* would like to represent states. */ - -/* ET is the epoch at which to compute the state */ -/* transformation matrix. This epoch should be */ -/* in TDB seconds past the ephemeris epoch of J2000. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6 x 6 state transformation matrix that can */ -/* be used to transform states relative to the frame */ -/* correspsonding to frame FRAME2 to states relative */ -/* to the frame FRAME2. More explicitely, if STATE */ -/* is the state of some object relative to the reference */ -/* frame of FRAME1 then STATE2 is the state of the */ -/* same object relative to FRAME2 where STATE2 is */ -/* computed via the subroutine call below */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, STATE2 ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the reference frames is unrecognized, the error */ -/* SPICE(UNKNOWNFRAME) will be signalled. */ - -/* 2) If the auxillary information needed to compute a non-inertial */ -/* frame is not available an error will be diagnosed and signalled */ -/* by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to compute the state transformation matrix */ -/* between two reference frames. */ - -/* The currently supported reference frames are IAU bodyfixed frames */ -/* and inertial reference frames. */ - -/* $ Examples */ - -/* Example 1. Suppose that you have a state STATE1 at epoch ET */ -/* relative to FRAME1 and wish to determine its representation */ -/* STATE2 relative to FRAME2. The following subroutine calls */ -/* would suffice to make this transformation. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, XFORM ) */ -/* CALL MXVG ( XFORM, STATE1, 6, 6, STATE2 ) */ - - - -/* Example 2. Suppose that you have the angular velocity, W, of some */ -/* rotation relative to FRAME1 at epoch ET and that you wish to */ -/* express this angular velocity with respect to FRAME2. The */ -/* following subroutines will suffice to perform this computation. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */ - -/* Recall that a state transformation matrix has the following form. */ - - -/* - - */ -/* | | */ -/* | R 0 | */ -/* | | */ -/* | | */ -/* | dR | */ -/* | -- R | */ -/* | dt | */ -/* | | */ -/* - - */ - - -/* The velocity of an arbitrary point P undergoing rotation with the */ -/* angular velocity W is W x P */ - -/* Thus the velocity of P in FRAME2 is: */ - - -/* dR */ -/* -- P + R (W x P ) */ -/* dt */ - -/* dR t */ -/* = ( -- R R P + W x P ) ( 1 ) */ -/* dt */ - - -/* dR t t */ -/* But -- R is skew symmetric (simply differentiate R*R to see */ -/* dt */ -/* dR t */ -/* this ). Hence -- R R P can be written as Ax(R*P) for some fixed */ -/* dt */ - -/* vector A. Moreover the vector A can be read from the upper */ - -/* dR t */ -/* triangular portion of -- R . So that equation (1) above can */ -/* dt */ - -/* be re-written as */ - -/* dR t */ -/* = ( -- R R*P + R*(WxP) ) */ -/* dt */ - -/* = Ax(R*P) + R*W x R*P */ - -/* = ( [A+R*W] x R*P ) */ - - -/* From this final expression it follows that in FRAME2 the angular */ -/* velocity vector is given by [A+R*W]. */ - -/* The code below implements these ideas. */ - -/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */ - - -/* DO I = 1, 3 */ -/* DO J = 1, 3 */ - -/* RT ( I, J ) = STXFRM ( I, J ) */ -/* DRDT( I, J ) = STXFRM ( I+3, J ) */ - -/* END DO */ -/* END DO */ - -/* CALL MXMT ( DRDT, R, AMATRIX ) */ - -/* Read the angular velocity of R from the skew symmetric matrix */ - -/* dR t */ -/* -- R */ -/* dt */ - -/* Recall that if A has components A1, A2, A3 then the matrix */ -/* cooresponding to the cross product linear mapping is: */ - -/* - - */ -/* | 0 -A3 A2 | */ -/* | | */ -/* | A3 0 -A1 | */ -/* | | */ -/* | -A2 A1 0 | */ -/* - - */ - -/* A(1) = -AMATRIX(2,3) */ -/* A(2) = AMATRIX(1,3) */ -/* A(3) = -AMATRIX(1,2) */ - -/* CALL MXV ( R, W1, W ) */ -/* CALL VADD ( A, W, W2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ - -/* Upgraded long error message associated with frame */ -/* connection failure. */ - -/* - SPICELIB Version 1.1.0, 25-JUL-1996 (WLT) */ - -/* Bug Fix: */ - -/* The previous edition of the routine had a bug in the */ -/* first pass of the DO WHILE that looks for a frame */ -/* in the chain of frames associated with FRAME2 that is */ -/* in common with the chain of frames for FRAME1. */ - -/* On machines where variables are created as static */ -/* variables, this error could lead to finding a frame */ -/* when a legitimate path between FRAME1 and FRAME2 */ -/* did not exist. */ - -/* - SPICELIB Version 1.0.1, 06-MAR-1996 (WLT) */ - -/* An typo was fixed in the Brief I/O section. It used */ -/* to say TDT instead of the correct time system TDB. */ - -/* - SPICELIB Version 1.0.0, 28-SEP-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Transform states from one frame to another */ - -/* -& */ - -/* SPICE functions */ - - -/* Local Parameters */ - - -/* The root of all reference frames is J2000 (Frame ID = 1). */ - - -/* Local Variables */ - - -/* TRANS contains the transformations from FRAME1 to FRAME2 */ -/* TRANS(1...6,1...6,I) has the transfromation from FRAME(I) */ -/* to FRAME(I+1). We make extra room in TRANS because we */ -/* plan to add transformations beyond the obvious chain from */ -/* FRAME1 to a root node. */ - - -/* TRANS2 is used to store intermediate transformations from */ -/* FRAME2 to some node in the chain from FRAME1 to PCK or */ -/* INERTL frames. */ - - -/* FRAME contains the frames we transform from in going from */ -/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ - - -/* NODE counts the number of transformations needed to go */ -/* from FRAME1 to FRAME2. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZFRMCH1", (ftnlen)8); - -/* Do the obvious thing first. If FRAME1 and FRAME2 are the */ -/* same then we simply return the identity matrix. */ - - if (*frame1 == *frame2) { - for (i__ = 1; i__ <= 6; ++i__) { - xform[(i__1 = i__ + i__ * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmch1_", (ftnlen)371)] = 1.; - i__1 = i__ - 1; - for (j = 1; j <= i__1; ++j) { - xform[(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zzfrmch1_", (ftnlen)374)] = 0.; - xform[(i__2 = j + i__ * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zzfrmch1_", (ftnlen)375)] = 0.; - } - } - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; - } - -/* Now perform the obvious check to make sure that both */ -/* frames are recognized. */ - - frinfo_(frame1, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame1, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; - } - frinfo_(frame2, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame2, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; - } - node = 1; - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, - "zzfrmch1_", (ftnlen)418)] = *frame1; - found = TRUE_; - -/* Follow the chain of transformations until we run into */ -/* one that transforms to J2000 (frame id = 1) or we hit FRAME2. */ - - while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch1_", (ftnlen)424)] != 1 && node < 10 && frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzfrmch1_", (ftnlen)424)] != *frame2 && found) { - -/* Find out what transformation is available for this */ -/* frame. */ - - zzfrmgt1_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzfrmch1_", (ftnlen)432)], et, &trans[(i__2 = - (node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "zzfrmch1_", (ftnlen)432)], &frame[(i__3 = - node) < 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "zzfr" - "mch1_", (ftnlen)432)], &found); - if (found) { - -/* We found a transformation matrix. TRANS(1,1,NODE) */ -/* now contains the transformation from FRAME(NODE) */ -/* to FRAME(NODE+1). We need to look up the information */ -/* for the next NODE. */ - - ++node; - } - } - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch1_", (ftnlen)448)] == 1 || frame[(i__2 = node - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "zzfrmch1_", ( - ftnlen)448)] == *frame2 || ! found; - while(! done) { - -/* The only way to get to this point is to have run out of */ -/* room in the array of reference frame transformation */ -/* buffers. We will now build the transformation from */ -/* the previous NODE to whatever the next node in the */ -/* chain is. We'll do this until we get to one of the */ -/* root classes or we run into FRAME2. */ - - zzfrmgt1_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzfrmch1_", (ftnlen)462)], et, &trans[(i__2 = - (node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "zzfrmch1_", (ftnlen)462)], &relto, &found); - if (found) { - -/* Recall that TRANS(1,1,NODE-1) contains the transformation */ -/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ -/* FRAME(NODE) with the frame indicated by RELTO. This means */ -/* that TRANS(1,1,NODE-1) should be replaced with the */ -/* transformation from FRAME(NODE) to RELTO. */ - - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch1_", (ftnlen)473)] = relto; - zzmsxf_(&trans[(i__1 = ((node - 1) * 6 + 1) * 6 - 42) < 504 && 0 - <= i__1 ? i__1 : s_rnge("trans", i__1, "zzfrmch1_", ( - ftnlen)474)], &c__2, tempxf); - for (i__ = 1; i__ <= 6; ++i__) { - for (j = 1; j <= 6; ++j) { - trans[(i__1 = i__ + (j + (node - 1) * 6) * 6 - 43) < 504 - && 0 <= i__1 ? i__1 : s_rnge("trans", i__1, "zzf" - "rmch1_", (ftnlen)478)] = tempxf[(i__2 = i__ + j * - 6 - 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("tempxf", - i__2, "zzfrmch1_", (ftnlen)478)]; - } - } - } - -/* We are done if the class of the last frame is J2000 */ -/* or if the last frame is FRAME2 or if we simply couldn't get */ -/* another transformation. */ - - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzfrmch1_", (ftnlen)488)] == 1 || frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzfrmch1_", (ftnlen)488)] == *frame2 || ! found; - } - -/* Right now we have the following situation. We have in hand */ -/* a collection of transformations between frames. (Assuming */ -/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ -/* no transformations computed yet. */ - - -/* TRANS(1...6, 1...6, 1 ) transforms FRAME1 to FRAME(2) */ -/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */ -/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */ -/* . */ -/* . */ -/* . */ -/* TRANS(1...6, 1...6, NODE-1 ) transforms FRAME(NODE-1) */ -/* to FRAME(NODE) */ - - -/* One of the following situations is true. */ - -/* 1) FRAME(NODE) is the root of all frames, J2000. */ - -/* 2) FRAME(NODE) is the same as FRAME2 */ - -/* 3) There is no transformation from FRAME(NODE) to another */ -/* more fundamental frame. The chain of transformations */ -/* from FRAME1 stops at FRAME(NODE). This means that the */ -/* "frame atlas" is incomplete because we can't get to the */ -/* root frame. */ - -/* We now have to do essentially the same thing for FRAME2. */ - - if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzfrmch1_", (ftnlen)526)] == *frame2) { - -/* We can handle this one immediately with the private routine */ -/* ZZMSXF which multiplies a series of state transformation */ -/* matrices. */ - - i__1 = node - 1; - zzmsxf_(trans, &i__1, xform); - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; - } - -/* We didn't luck out above. So we follow the chain of */ -/* transformation for FRAME2. Note that at the moment the */ -/* chain of transformations from FRAME2 to other frames */ -/* does not share a node in the chain for FRAME1. */ -/* ( GOTONE = .FALSE. ) . */ - - this__ = *frame2; - gotone = FALSE_; - -/* First see if there is any chain to follow. */ - - done = this__ == 1; - -/* Set up the matrices TRANS2(,,1) and TRANS(,,2) and set up */ -/* PUT and GET pointers so that we know where to GET the partial */ -/* transformation from and where to PUT partial results. */ - - if (! done) { - for (k = 1; k <= 2; ++k) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 4; j <= 6; ++j) { - trans2[(i__1 = i__ + (j + k * 6) * 6 - 43) < 72 && 0 <= - i__1 ? i__1 : s_rnge("trans2", i__1, "zzfrmch1_", - (ftnlen)563)] = 0.; - } - } - } - put = 1; - get = 1; - inc = 1; - } - -/* Follow the chain of transformations until we run into */ -/* one that transforms to the root frame or we land in the */ -/* chain of nodes for FRAME1. */ - -/* Note that this time we will simply keep track of the full */ -/* translation from FRAME2 to the last node. */ - - while(! done) { - -/* Find out what transformation is available for this */ -/* frame. */ - - if (this__ == *frame2) { - -/* This is the first pass, just put the transformation */ -/* directly into TRANS2(,,PUT). */ - - zzfrmgt1_(&this__, et, &trans2[(i__1 = (put * 6 + 1) * 6 - 42) < - 72 && 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, "zzfrmch" - "1_", (ftnlen)592)], &relto, &found); - if (found) { - this__ = relto; - get = put; - put += inc; - inc = -inc; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } else { - -/* Fetch the transformation into a temporary spot TEMPXF */ - - zzfrmgt1_(&this__, et, tempxf, &relto, &found); - if (found) { - -/* Next multiply TEMPXF on the right by the last partial */ -/* product (in TRANS2(,,GET) ). We do this in line because */ -/* we can cut down the number of multiplies to 3/8 of the */ -/* normal result of MXMG. For a discussion of why this */ -/* works see ZZMSXF. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "zzfrmch1_", (ftnlen)621)] = tempxf[(i__2 = - i__ - 1) < 36 && 0 <= i__2 ? i__2 : s_rnge( - "tempxf", i__2, "zzfrmch1_", (ftnlen)621)] * - trans2[(i__3 = (j + get * 6) * 6 - 42) < 72 && - 0 <= i__3 ? i__3 : s_rnge("trans2", i__3, - "zzfrmch1_", (ftnlen)621)] + tempxf[(i__4 = - i__ + 5) < 36 && 0 <= i__4 ? i__4 : s_rnge( - "tempxf", i__4, "zzfrmch1_", (ftnlen)621)] * - trans2[(i__5 = (j + get * 6) * 6 - 41) < 72 && - 0 <= i__5 ? i__5 : s_rnge("trans2", i__5, - "zzfrmch1_", (ftnlen)621)] + tempxf[(i__6 = - i__ + 11) < 36 && 0 <= i__6 ? i__6 : s_rnge( - "tempxf", i__6, "zzfrmch1_", (ftnlen)621)] * - trans2[(i__7 = (j + get * 6) * 6 - 40) < 72 && - 0 <= i__7 ? i__7 : s_rnge("trans2", i__7, - "zzfrmch1_", (ftnlen)621)]; - } - } - for (i__ = 4; i__ <= 6; ++i__) { - for (j = 1; j <= 3; ++j) { - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "zzfrmch1_", (ftnlen)630)] = tempxf[(i__2 = - i__ - 1) < 36 && 0 <= i__2 ? i__2 : s_rnge( - "tempxf", i__2, "zzfrmch1_", (ftnlen)630)] * - trans2[(i__3 = (j + get * 6) * 6 - 42) < 72 && - 0 <= i__3 ? i__3 : s_rnge("trans2", i__3, - "zzfrmch1_", (ftnlen)630)] + tempxf[(i__4 = - i__ + 5) < 36 && 0 <= i__4 ? i__4 : s_rnge( - "tempxf", i__4, "zzfrmch1_", (ftnlen)630)] * - trans2[(i__5 = (j + get * 6) * 6 - 41) < 72 && - 0 <= i__5 ? i__5 : s_rnge("trans2", i__5, - "zzfrmch1_", (ftnlen)630)] + tempxf[(i__6 = - i__ + 11) < 36 && 0 <= i__6 ? i__6 : s_rnge( - "tempxf", i__6, "zzfrmch1_", (ftnlen)630)] * - trans2[(i__7 = (j + get * 6) * 6 - 40) < 72 && - 0 <= i__7 ? i__7 : s_rnge("trans2", i__7, - "zzfrmch1_", (ftnlen)630)] + tempxf[(i__8 = - i__ + 17) < 36 && 0 <= i__8 ? i__8 : s_rnge( - "tempxf", i__8, "zzfrmch1_", (ftnlen)630)] * - trans2[(i__9 = (j + get * 6) * 6 - 39) < 72 && - 0 <= i__9 ? i__9 : s_rnge("trans2", i__9, - "zzfrmch1_", (ftnlen)630)] + tempxf[(i__10 = - i__ + 23) < 36 && 0 <= i__10 ? i__10 : s_rnge( - "tempxf", i__10, "zzfrmch1_", (ftnlen)630)] * - trans2[(i__11 = (j + get * 6) * 6 - 38) < 72 - && 0 <= i__11 ? i__11 : s_rnge("trans2", - i__11, "zzfrmch1_", (ftnlen)630)] + tempxf[( - i__12 = i__ + 29) < 36 && 0 <= i__12 ? i__12 : - s_rnge("tempxf", i__12, "zzfrmch1_", (ftnlen) - 630)] * trans2[(i__13 = (j + get * 6) * 6 - - 37) < 72 && 0 <= i__13 ? i__13 : s_rnge("tra" - "ns2", i__13, "zzfrmch1_", (ftnlen)630)]; - } - } - -/* Note that we don't have to compute the upper right */ -/* hand block. It's already set to zero by construction. */ - -/* Finally we can just copy the lower right hand block */ -/* from the upper left hand block of the matrix. */ - - for (i__ = 4; i__ <= 6; ++i__) { - k = i__ - 3; - for (j = 4; j <= 6; ++j) { - l = j - 3; - trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 && - 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, - "zzfrmch1_", (ftnlen)649)] = trans2[(i__2 = k - + (l + put * 6) * 6 - 43) < 72 && 0 <= i__2 ? - i__2 : s_rnge("trans2", i__2, "zzfrmch1_", ( - ftnlen)649)]; - } - } - -/* Adjust GET and PUT so that GET points to the slots */ -/* where we just stored the result of our multiply and */ -/* so that PUT points to the next available storage */ -/* locations. */ - - get = put; - put += inc; - inc = -inc; - this__ = relto; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } - -/* See if we have a common node and determine whether or not */ -/* we are done with this loop. */ - - done = this__ == 1 || gotone || ! found; - } - -/* There are two possible scenarios. Either the chain of */ -/* transformations from FRAME2 ran into a node in the chain for */ -/* FRAME1 or it didn't. (The common node might very well be */ -/* the root node.) If we didn't run into a common one, then */ -/* the two chains don't intersect and there is no way to */ -/* get from FRAME1 to FRAME2. */ - - if (! gotone) { - zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("frame", i__1, "zzfrmch1_", (ftnlen)692)], - frame2, &this__, errmsg, (ftnlen)1840); - if (failed_()) { - -/* We were unable to create the error message. This */ -/* unfortunate situation could arise if a frame kernel */ -/* is corrupted. */ - - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; - } - -/* The normal case: signal an error with a descriptive long */ -/* error message. */ - - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; - } - -/* Recall that we have the following. */ - -/* TRANS(1...6, 1...6, 1 ) transforms FRAME(1) to FRAME(2) */ -/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */ -/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */ - -/* TRANS(1...6, 1...6, CMNODE-1) transforms FRAME(CMNODE-1) */ -/* to FRAME(CMNODE) */ - -/* and that TRANS2(1,1,GET) transforms from FRAME2 to CMNODE. */ -/* Hence the inverse of TRANS2(1,1,GET) transforms from CMNODE */ -/* to FRAME2. */ - -/* If we compute the inverse of TRANS2 and store it in */ -/* the next available slot of TRANS (.i.e. TRANS(1,1,CMNODE) */ -/* we can simply apply our custom routine that multiplies a */ -/* sequence of transformation matrices together to get the */ -/* result from FRAME1 to FRAME2. */ - - invstm_(&trans2[(i__1 = (get * 6 + 1) * 6 - 42) < 72 && 0 <= i__1 ? i__1 : - s_rnge("trans2", i__1, "zzfrmch1_", (ftnlen)735)], &trans[(i__2 = - (cmnode * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge( - "trans", i__2, "zzfrmch1_", (ftnlen)735)]); - zzmsxf_(trans, &cmnode, xform); - chkout_("ZZFRMCH1", (ftnlen)8); - return 0; -} /* zzfrmch1_ */ - diff --git a/ext/spice/src/cspice/zzfrmgt0.c b/ext/spice/src/cspice/zzfrmgt0.c deleted file mode 100644 index 8a5be2f25a..0000000000 --- a/ext/spice/src/cspice/zzfrmgt0.c +++ /dev/null @@ -1,356 +0,0 @@ -/* zzfrmgt0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZFRMGT0 (Frame get transformation) */ -/* Subroutine */ int zzfrmgt0_(integer *infrm, doublereal *et, doublereal * - xform, integer *outfrm, logical *found) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer cent; - extern /* Subroutine */ int zzdynfr0_(integer *, integer *, doublereal *, - doublereal *, integer *); - integer type__, i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal tsipm[36] /* was [6][6] */; - char versn[6]; - extern logical failed_(void); - extern /* Subroutine */ int ckfxfm_(integer *, doublereal *, doublereal *, - integer *, logical *), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - tisbod_(char *, integer *, doublereal *, doublereal *, ftnlen), - tkfram_(integer *, doublereal *, integer *, logical *), sigerr_( - char *, ftnlen); - integer typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *); - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the transformation from a user specified frame to */ -/* another frame at a user specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRM I The integer code for a SPICE reference frame. */ -/* ET I An epoch in seconds past J2000. */ -/* XFORM O A state transformation matrix. */ -/* OUTFRM O The frame that XFORM transforms INFRM to. */ -/* FOUND O TRUE if a frame transformation can be found. */ - -/* $ Detailed_Input */ - -/* INFRM is the SPICE id-code for some reference frame. */ - -/* ET is an epoch in ephemeris seconds past J2000 at */ -/* which the user wishes to retrieve a state */ -/* transformation matrix. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6x6 matrix that transforms states relative to */ -/* INFRM to states relative to OUTFRM. (Assuming such */ -/* a transformation can be found.) */ - -/* OUTFRM is a reference frame. The 6x6 matrix XFORM transforms */ -/* states relative to INFRM to states relative to OUTFRM. */ -/* The state transformation is achieved by multiplying */ -/* XFORM on the right by a state relative to INFRM. This */ -/* is easily accomplished via the subroutine call */ -/* shown below. */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, OSTATE ) */ - -/* FOUND is a logical flag indicating whether or not a */ -/* transformation matrix could be found from INFRM */ -/* to some other frame. If a transformation matrix */ -/* cannot be found OUTFRM will be set to zero, FOUND */ -/* will be set to FALSE and XFORM will be returned */ -/* as the zero matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a transformation matrix cannot be located, then */ -/* FOUND will be set to FALSE, OUTFRM will be set to zero */ -/* and XFORM will be set to the zero 6x6 matrix. */ - -/* 2) If the class of the requested frame is not recognized the */ -/* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */ - -/* $ Particulars */ - -/* This is a low level routine used for determining a chain */ -/* of state transformation matrices from one frame to another. */ - -/* $ Examples */ - -/* See FRMCHG. */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 3.0.0, 21-JUN-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a frame transformation matrix from a specified frame */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - s_copy(versn, "2.0.0", (ftnlen)6, (ftnlen)5); - *found = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZFRMGT0", (ftnlen)8); - -/* Get all the needed information about this frame. */ - - frinfo_(infrm, ¢, &type__, &typeid, found); - if (! (*found)) { - chkout_("ZZFRMGT0", (ftnlen)8); - return 0; - } - if (type__ == 2) { - tisbod_("J2000", &typeid, et, tsipm, (ftnlen)5); - invstm_(tsipm, xform); - namfrm_("J2000", outfrm, (ftnlen)5); - } else if (type__ == 1) { - irfrot_(infrm, &c__1, rot); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)212)] = - rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "zzfrmgt0_", (ftnlen)212)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)213) - ] = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("rot", i__2, "zzfrmgt0_", (ftnlen)213)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)214)] = 0.; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)215)] = - 0.; - } - } - *outfrm = 1; - } else if (type__ == 3) { - ckfxfm_(&typeid, et, xform, outfrm, found); - } else if (type__ == 4) { - tkfram_(&typeid, rot, outfrm, found); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)232)] = - rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "zzfrmgt0_", (ftnlen)232)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)233) - ] = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("rot", i__2, "zzfrmgt0_", (ftnlen)233)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)234)] = 0.; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "zzfrmgt0_", (ftnlen)235)] = - 0.; - } - } - } else if (type__ == 5) { - -/* Unlike the other frame classes, the dynamic frame evaluation */ -/* routine ZZDYNFR0 requires the input frame ID rather than the */ -/* dynamic frame class ID. ZZDYNFR0 also requires the center ID */ -/* we found via the FRINFO call. */ - zzdynfr0_(infrm, ¢, et, xform, outfrm); - -/* The FOUND flag was set by FRINFO earlier; we don't touch */ -/* it here. If ZZDYNFR0 signaled an error, FOUND will be set */ -/* to .FALSE. at end of this routine. */ - - } else { - setmsg_("The reference frame # has class id-code #. This form of ref" - "erence frame is not supported in version # of ZZFRMGT0. You " - "need to update your version of SPICELIB to the latest versio" - "n in order to support this frame. ", (ftnlen)213); - errint_("#", infrm, (ftnlen)1); - errint_("#", &type__, (ftnlen)1); - errch_("#", versn, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23); - chkout_("ZZFRMGT0", (ftnlen)8); - return 0; - } - if (failed_()) { - *found = FALSE_; - } - chkout_("ZZFRMGT0", (ftnlen)8); - return 0; -} /* zzfrmgt0_ */ - diff --git a/ext/spice/src/cspice/zzfrmgt1.c b/ext/spice/src/cspice/zzfrmgt1.c deleted file mode 100644 index 512d92d8a1..0000000000 --- a/ext/spice/src/cspice/zzfrmgt1.c +++ /dev/null @@ -1,354 +0,0 @@ -/* zzfrmgt1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZFRMGT1 (Frame get transformation) */ -/* Subroutine */ int zzfrmgt1_(integer *infrm, doublereal *et, doublereal * - xform, integer *outfrm, logical *found) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer cent, type__, i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal tsipm[36] /* was [6][6] */; - char versn[6]; - extern logical failed_(void); - extern /* Subroutine */ int ckfxfm_(integer *, doublereal *, doublereal *, - integer *, logical *), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - tisbod_(char *, integer *, doublereal *, doublereal *, ftnlen), - tkfram_(integer *, doublereal *, integer *, logical *), sigerr_( - char *, ftnlen); - integer typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - extern /* Subroutine */ int invstm_(doublereal *, doublereal *); - doublereal rot[9] /* was [3][3] */; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the transformation from a user specified frame to */ -/* another frame at a user specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRM I The integer code for a SPICE reference frame. */ -/* ET I An epoch in seconds past J2000. */ -/* XFORM O A state transformation matrix. */ -/* OUTFRM O The frame that XFORM transforms INFRM to. */ -/* FOUND O TRUE if a frame transformation can be found. */ - -/* $ Detailed_Input */ - -/* INFRM is the SPICE id-code for some reference frame. */ - -/* ET is an epoch in ephemeris seconds past J2000 at */ -/* which the user wishes to retrieve a state */ -/* transformation matrix. */ - -/* $ Detailed_Output */ - -/* XFORM is a 6x6 matrix that transforms states relative to */ -/* INFRM to states relative to OUTFRM. (Assuming such */ -/* a transformation can be found.) */ - -/* OUTFRM is a reference frame. The 6x6 matrix XFORM transforms */ -/* states relative to INFRM to states relative to OUTFRM. */ -/* The state transformation is achieved by multiplying */ -/* XFORM on the right by a state relative to INFRM. This */ -/* is easily accomplished via the subroutine call */ -/* shown below. */ - -/* CALL MXVG ( XFORM, STATE, 6, 6, OSTATE ) */ - -/* FOUND is a logical flag indicating whether or not a */ -/* transformation matrix could be found from INFRM */ -/* to some other frame. If a transformation matrix */ -/* cannot be found OUTFRM will be set to zero, FOUND */ -/* will be set to FALSE and XFORM will be returned */ -/* as the zero matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a transformation matrix cannot be located, then */ -/* FOUND will be set to FALSE, OUTFRM will be set to zero */ -/* and XFORM will be set to the zero 6x6 matrix. */ - -/* 2) If the class of the requested frame is not recognized the */ -/* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */ - -/* of this routine. */ - -/* 3) If the reference frame REF is dynamic, the error */ -/* SPICE(RECURSIONTOODEEP) will be signaled. */ - - -/* $ Particulars */ - -/* This is a low level routine used for determining a chain */ -/* of state transformation matrices from one frame to another. */ - -/* $ Examples */ - -/* See FRMCHG. */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 3.0.0, 21-JUN-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a frame transformation matrix from a specified frame */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - s_copy(versn, "2.0.0", (ftnlen)6, (ftnlen)5); - *found = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZFRMGT1", (ftnlen)8); - -/* Get all the needed information about this frame. */ - - frinfo_(infrm, ¢, &type__, &typeid, found); - if (! (*found)) { - chkout_("ZZFRMGT1", (ftnlen)8); - return 0; - } - if (type__ == 2) { - tisbod_("J2000", &typeid, et, tsipm, (ftnlen)5); - invstm_(tsipm, xform); - namfrm_("J2000", outfrm, (ftnlen)5); - } else if (type__ == 1) { - irfrot_(infrm, &c__1, rot); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)218)] = - rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)218)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)219) - ] = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)219)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)220)] = 0.; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)221)] = - 0.; - } - } - *outfrm = 1; - } else if (type__ == 3) { - ckfxfm_(&typeid, et, xform, outfrm, found); - } else if (type__ == 4) { - tkfram_(&typeid, rot, outfrm, found); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)238)] = - rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : - s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)238)]; - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)239) - ] = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? - i__2 : s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)239)]; - xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)240)] = 0.; - xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)241)] = - 0.; - } - } - } else if (type__ == 5) { - setmsg_("The reference frame # is a dynamic frame. Dynamic frames ma" - "y not be used at recursion level 1.", (ftnlen)94); - errint_("#", infrm, (ftnlen)1); - sigerr_("SPICE(RECURSIONTOODEEP)", (ftnlen)23); - chkout_("ZZFRMGT1", (ftnlen)8); - return 0; - } else { - setmsg_("The reference frame # has class id-code #. This form of ref" - "erence frame is not supported in version # of ZZFRMGT1. You " - "need to update your version of SPICELIB to the latest versio" - "n in order to support this frame. ", (ftnlen)213); - errint_("#", infrm, (ftnlen)1); - errint_("#", &type__, (ftnlen)1); - errch_("#", versn, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23); - chkout_("ZZFRMGT1", (ftnlen)8); - return 0; - } - if (failed_()) { - *found = FALSE_; - } - chkout_("ZZFRMGT1", (ftnlen)8); - return 0; -} /* zzfrmgt1_ */ - diff --git a/ext/spice/src/cspice/zzftpchk.c b/ext/spice/src/cspice/zzftpchk.c deleted file mode 100644 index ab755f7acb..0000000000 --- a/ext/spice/src/cspice/zzftpchk.c +++ /dev/null @@ -1,406 +0,0 @@ -/* zzftpchk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZFTPCHK ( Private --- Check for FTP Errors ) */ -/* Subroutine */ int zzftpchk_(char *string, logical *ftperr, ftnlen - string_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - extern /* Subroutine */ int zzrbrkst_(char *, char *, char *, char *, - integer *, logical *, ftnlen, ftnlen, ftnlen, ftnlen), zzftpstr_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - char delim[1]; - extern integer rtrim_(char *, ftnlen); - integer length; - static char lftbkt[6]; - integer fsmidx, msfidx; - static char rgtbkt[6]; - logical isther; - char filstr[48]; - static char memstr[16]; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Check a character string that may contain the FTP validation */ -/* string for FTP based errors. */ - -/* $ 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 */ - -/* FILE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: Private FTP Validation String Parameters */ - -/* zzftprms.inc Version 1 01-MAR-1999 (FST) */ - -/* This include file centralizes the definition of string sizes */ -/* and other parameters that are necessary to properly implement */ -/* the FTP error detection scheme for binary kernels. */ - -/* Before making any alterations to the contents of this file, */ -/* refer to the header of ZZFTPSTR for a detailed discussion of */ -/* the FTP validation string. */ - -/* Size of FTP Test String Component: */ - - -/* Size of Maximum Expanded FTP Validation String: */ - -/* (This indicates the size of a buffer to hold the test */ -/* string sequence from a possibly corrupt file. Empirical */ -/* evidence strongly indicates that expansion due to FTP */ -/* corruption at worst doubles the number of characters. */ -/* So take 3*SIZSTR to be on the safe side.) */ - - -/* Size of FTP Validation String Brackets: */ - - -/* Size of FTP Validation String: */ - - -/* Size of DELIM. */ - - -/* Number of character clusters present in the validation string. */ - - -/* End Include Section: Private FTP Validation String Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String that may contain the FTP validation string. */ -/* FTPERR O Logical indicating if FTP corruption occurred. */ - -/* $ Detailed_Input */ - -/* STRING is a string read in directly from a binary file. This */ -/* string should, but does not have to, contain the FTP */ -/* validation string. Typically this block of characters */ -/* is read in from the file record of the binary kernel. */ -/* If 'FTPSTR' or 'ENDFTP' occur anywhere in STRING, then */ -/* validation will be attempted. Multiple occurrences of */ -/* these two special strings in STRING is also an issue. */ -/* See Restrictions for details. */ - -/* $ Detailed_Output */ - -/* FTPERR is a logical that indicates whether or not an FTP */ -/* error has occurred. If an error is detected FTPERR */ -/* is set to TRUE, otherwise FTPERR is FALSE. In the */ -/* event that STRING does not contain either of the FTP */ -/* bracketing strings, then the test will not be */ -/* performed. Thus, FTPERR is set to FALSE. */ - -/* $ Parameters */ - -/* See include file zzftprms.inc. */ - -/* $ Files */ - -/* Although this routine validates information from a binary file, */ -/* it does not interact with the file directly, and relies upon */ -/* the caller to pass the appropriate string block. */ - -/* $ Exceptions */ - -/* 1) In the event that both the left and right end markers of the */ -/* FTP validation string are not present in STRING, the routine */ -/* assumes that this information is from a pre-FTP test file. As */ -/* such, the file can not be validated, so FTPERR remains FALSE. */ - -/* 2) If the FTP string brackets 'FTPSTR' and 'ENDFTP' are present in */ -/* multiple places in the text block, then this routine assumes */ -/* the last occurrence of the substring these strings bracket is */ -/* the FTP test sequence that requires validation. So if this */ -/* routine encounters a block of text: */ - -/* ...FTPSTR::ENDFTP...FTPSTR[THISISNOTATEST]ENDFTP... */ - -/* where is the actual test sequence, then it will */ -/* incorrectly compare [THISISNOTATEST] to the test component */ -/* returned from ZZFTPSTR. */ - -/* $ Particulars */ - -/* The purpose of this routine is to examine for FTP errors a */ -/* string brought in from a binary kernel. This text may or may */ -/* not contain the FTP validation string defined in ZZFTPSTR. */ -/* However, if it contains at least one of the two bracketing */ -/* substrings ('FTPSTR' and 'ENDFTP'), then the routine assumes */ -/* that the text is subject to FTP validation. As a result of this, */ -/* the caller should avoid passing in user controlled chunks of */ -/* character data from the file. If the user has decided to place */ -/* one of the FTP string bracket components in this portion of the */ -/* file, then ZZFTPCHK may be confused and incorrectly indicate an */ -/* error condition. */ - -/* $ Examples */ - -/* The following code fragment from DAFOPR reads in the DAF file */ -/* record and attempts to examine the contents for FTP errors. */ -/* (Note: this code fragment is from a 32 bit word length, 1 */ -/* byte character environment.) */ - -/* C */ -/* C Check for FTP transfer errors to prevent the user from */ -/* C inadvertantly using a damaged kernel. First read the file */ -/* C record into a string of 1000 characters. */ -/* C */ -/* READ ( UNIT = LUN, REC = 1, IOSTAT = IOSTAT ) FTPTST */ - -/* IF ( IOSTAT .NE. 0 ) THEN */ - -/* CLOSE ( LUN ) */ -/* CALL SETMSG ( 'Error reading the file record from' // */ -/* . ' the binary DAF file ''#''. IOSTAT' // */ -/* . ' = #.' ) */ -/* CALL ERRCH ( '#', FNAME ) */ -/* CALL ERRINT ( '#', IOSTAT ) */ -/* CALL SIGERR ( 'SPICE(FILEREADFAILED)' ) */ -/* CALL CHKOUT ( 'DAFOPR' ) */ -/* RETURN */ - -/* END IF */ - -/* C */ -/* C Since we are dealing with DAF files, only place the */ -/* C last 500 characters of data from the file record into */ -/* C ZZFTPCHK. This ensures that the internal filename */ -/* C and the ID word do not interfere with the FTP validation */ -/* C process. */ -/* C */ -/* CALL ZZFTPCHK ( FTPTST(501:1000), FTPERR ) */ - -/* IF ( FTPERR ) THEN */ - -/* CLOSE ( LUN ) */ -/* CALL SETMSG ( 'FTP transfer error. This binary DAF, '// */ -/* . '''#'', has most likely been corrupted '// */ -/* . 'by an ASCII mode FTP transfer. ' // */ -/* . 'Re-obtain the file using IMAGE or ' // */ -/* . 'BINARY transfer mode.' ) */ -/* CALL ERRCH ( '#', FNAME ) */ -/* CALL SIGERR ( 'SPICE(FTPXFERERROR)' ) */ -/* CALL CHKOUT ( 'DAFOPR' ) */ -/* RETURN */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) STRING may contain multiple occurrences of the FTP bracketing */ -/* substrings ('FTPSTR' and 'ENDFTP'), but only if the last */ -/* occurrence of both brackets the actual data for validation. */ - -/* 2) This routine assumes the presence of either 'FTPSTR' or */ -/* 'ENDFTP' in STRING indicates that validation is to be */ -/* attempted. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 22-MAR-1999 (FST) */ - - -/* -& */ -/* $ Index_Entries */ - -/* check text block for FTP errors */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.0, 22-MAR-1999 (FST) */ - -/* This routine does not require modification if the FTP */ -/* validation string is updated according to the guidelines */ -/* laid out in ZZFTPSTR. The reason for this is the */ -/* verification algorithm extracts the chunk of text between */ -/* 'FTPSTR' and 'ENDFTP'. It then checks to see whether or */ -/* not this chunk is a subset of the test component stored */ -/* in ZZFTPSTR. Two cases: */ - -/* (1) It is. Then this indicates that at the worst, */ -/* the chunk is from a valid file with an earlier */ -/* version of the FTP validation string. */ - -/* (2) It is not. While this is a fair indication that */ -/* the file may be corrupt, it's not a complete */ -/* treatment, since we may be examining a file */ -/* created with a newer version of the FTP validation */ -/* string. So now check to see whether that test */ -/* component from ZZFTPSTR is a subset of the text */ -/* chunk from STRING. If it is, then the file is */ -/* as valid as far as this version of the toolkit is */ -/* concerned. Otherwise, the file is damaged. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* On the first pass through, fetch a copy of the current FTP */ -/* validation string. */ - - if (first) { - zzftpstr_(memstr, lftbkt, rgtbkt, delim, (ftnlen)16, (ftnlen)6, ( - ftnlen)6, (ftnlen)1); - -/* Don't fetch the string on subsequent calls to this routine. */ - - first = FALSE_; - } - -/* Extract the FTP validation string from the block of text that */ -/* was passed into the routine via the argument STRING. Note, */ -/* if the bracketed substring in the text block STRING is larger */ -/* than the FILSTR string size, ZZRBRKST will truncate the data */ -/* that does not fit. This loss of data is not an issue, since in */ -/* this case we may only validate the part of the substring near */ -/* the head, for which we have enough room in FILSTR. */ - - zzrbrkst_(string, lftbkt, rgtbkt, filstr, &length, &isther, string_len, - rtrim_(lftbkt, (ftnlen)6), rtrim_(rgtbkt, (ftnlen)6), (ftnlen)48); - -/* Now check ISTHER to see if either LFTBKT or RGTBKT was present */ -/* in the block of text from the file. If both are absent, then */ -/* we must assume that this text is from a pre-FTP validation file, */ -/* and as such do not return any indication of an error. */ - - if (! isther) { - *ftperr = FALSE_; - -/* If one of the brackets is present, then we may proceed with */ -/* validation. First check to see if the length is 0. If it is, */ -/* then at least one of the brackets was present, but ZZRBRKST was */ -/* unable to extract a properly bracketed substring. This is an */ -/* error. */ - - } else if (length <= 0) { - *ftperr = TRUE_; - -/* Now we make it to this ELSE statement only if ISTHER is TRUE, and */ -/* LENGTH is a positive number. Compare the contents of FILSTR */ -/* and MEMSTR. */ - - } else { - -/* First determine if the data from the file is a subset of */ -/* what is stored in memory. */ - - fsmidx = pos_(memstr, filstr, &c__1, (ftnlen)16, rtrim_(filstr, ( - ftnlen)48)); - -/* In the event that FSMIDX is non-zero, we know that FILSTR */ -/* is a substring of MEMSTR, and thus we have validated all the */ -/* test clusters from the file. */ - - if (fsmidx != 0) { - *ftperr = FALSE_; - -/* If FSMIDX is 0, then we do not yet know whether or not the */ -/* file is valid. Now it may be the case that this file contains */ -/* a newer FTP validation string than this version of the */ -/* toolkit is aware. Check to see whether what's in memory */ -/* is a substring of what's in FILSTR. */ - - } else { - msfidx = pos_(filstr, memstr, &c__1, (ftnlen)48, rtrim_(memstr, ( - ftnlen)16)); - -/* If this comes back as zero, then we definitely have */ -/* an FTP error. Set FTPERR appropriately. */ - - *ftperr = msfidx == 0; - } - } - return 0; -} /* zzftpchk_ */ - diff --git a/ext/spice/src/cspice/zzftpstr.c b/ext/spice/src/cspice/zzftpstr.c deleted file mode 100644 index 5a1f71cdd9..0000000000 --- a/ext/spice/src/cspice/zzftpstr.c +++ /dev/null @@ -1,468 +0,0 @@ -/* zzftpstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__2 = 2; -static integer c__0 = 0; - -/* $Procedure ZZFTPSTR ( Private --- Fetch FTP Validation String ) */ -/* Subroutine */ int zzftpstr_(char *tstcom, char *lend, char *rend, char * - delim, ftnlen tstcom_len, ftnlen lend_len, ftnlen rend_len, ftnlen - delim_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char locdlm[1] = ":"; - static char loclnd[6] = "FTPSTR"; - static char locrnd[6] = "ENDFTP"; - - /* System generated locals */ - address a__1[3], a__2[2]; - integer i__1[3], i__2[2], i__3; - - /* Builtin functions */ - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char asc000[1], asc010[1], asc013[1], asc016[1], asc206[1], asc129[1]; - integer i__; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static char locstr[16]; - char testsq[5*6]; - -/* $ Abstract */ - -/* Retrieve the components of the FTP validation 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include Section: Private FTP Validation String Parameters */ - -/* zzftprms.inc Version 1 01-MAR-1999 (FST) */ - -/* This include file centralizes the definition of string sizes */ -/* and other parameters that are necessary to properly implement */ -/* the FTP error detection scheme for binary kernels. */ - -/* Before making any alterations to the contents of this file, */ -/* refer to the header of ZZFTPSTR for a detailed discussion of */ -/* the FTP validation string. */ - -/* Size of FTP Test String Component: */ - - -/* Size of Maximum Expanded FTP Validation String: */ - -/* (This indicates the size of a buffer to hold the test */ -/* string sequence from a possibly corrupt file. Empirical */ -/* evidence strongly indicates that expansion due to FTP */ -/* corruption at worst doubles the number of characters. */ -/* So take 3*SIZSTR to be on the safe side.) */ - - -/* Size of FTP Validation String Brackets: */ - - -/* Size of FTP Validation String: */ - - -/* Size of DELIM. */ - - -/* Number of character clusters present in the validation string. */ - - -/* End Include Section: Private FTP Validation String Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TSTCOM O The FTP test component string. */ -/* LEND O String that brackets TSTCOM on the left in a file. */ -/* REND O String that brackets TSTCOM on the right in a file. */ -/* DELIM O Delimiter that separates the pieces of TSTCOM. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* TSTCOM is a string composed of clusters of characters that */ -/* are susceptible to FTP ASCII mode transfer corruption, */ -/* separated by the DELIM character. For example: */ - -/* ::: */ - -/* where is one cluster of characters that */ -/* is subject to improper FTP corruption. The string */ -/* that is to receive this value should be SIZSTR */ -/* characters in length. */ - -/* LEND, are the two sequences of printing characters that */ -/* REND bracket TSTCOM in the binary file. Their purpose is */ -/* to permit proper detection of TSTCOM in the event */ -/* of compression or expansion, due to improper FTP */ -/* transfer. The variables which are to receive these */ -/* values should be SIZEND characters in length. */ - -/* DELIM is the printing character delimiter that separates the */ -/* test character clusters from one another, as well as */ -/* LEND and REND. Since it is often the case that pairs */ -/* or triples of non-printing characters will trigger */ -/* FTP corruption, this delimiter blocks any unintended */ -/* interaction. */ - -/* $ Parameters */ - -/* 1) See include file zzftprms.inc */ - -/* 2) Since inserting non-printing characters into strings is a */ -/* somewhat arduous task requiring extensive use of the intrinsic */ -/* CHAR, integer parameters that map to the needed ASCII codes are */ -/* defined with variable names INT###, where ### is replaced with */ -/* the three digit ASCII integer code. For each such integer */ -/* code, there is a corresponding character parameter whose name */ -/* is of the form ASC###. For example: */ - -/* INT010 = 10 -> ASC010 = <10> or */ -/* INT206 = 206 -> ASC206 = <206> */ - -/* where <#> refers to CHAR(#) or CHAR(ICHAR('#')) in the case of */ -/* LF(line feed). */ - -/* These naming conventions should be preserved when the FTP */ -/* validation string is updated. */ - -/* $ Files */ - -/* While this routine is designed to aid in the detection of */ -/* improper FTP transfers, it simply returns the candidate */ -/* string for validation and does not interact with any */ -/* files directly. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* $ Particulars */ - -/* To minimize code alterations in the event of a string update, */ -/* the calling routine that declares the variables to receive */ -/* the strings stored here should include zzftprms.inc and utilize */ -/* the size parameters defined there as recommended in the Detailed */ -/* I/O sections above. */ - -/* This private SPICELIB routine is designed to centralize the */ -/* definition of the FTP validation string present in binary */ -/* SPICE kernels. If in the process of FTP'ing a binary */ -/* file from one platform to another, the user neglects to */ -/* invoke the IMAGE (BINARY) transfer mode, an ASCII mode */ -/* transfer may occur. As this at the very least may substitute */ -/* one set of line terminators for another, corruption of the */ -/* binary file is likely. By placing a string that encapsulates */ -/* a representative set of these character sequences that are */ -/* susceptible to corruption in the file record, it is possible */ -/* to trap and report any problems to the user when corrupted */ -/* kernels are loaded at run time. */ - -/* To that end, analysis of evidence obtained by moving test binary */ -/* files from one platform to another indicates the following */ -/* clusters of ASCII codes are likely candidates for corruption: */ - -/* Test Clusters: */ - -/* <13> - Text line terminator on Macintosh-based platforms. */ -/* <10> - Text line terminator on UNIX-based platforms. */ -/* <13><10> - Text line terminator on Microsoft platforms. */ -/* <13><0> - Sequence of characters that maps into <13> on some */ -/* UNIX-based systems. (HP, SGI, NEXT) */ -/* <129> - Macintosh based systems permute ASCII values whose */ -/* parity bit is set. Codes in excess of ASCII */ -/* 127 are altered. */ -/* <16><206> - Some ancient FTP servers on PC's convert this */ -/* sequence of ASCII characters to <16><16><206>. */ - -/* The examples above show that substitution of one set of line */ -/* terminators for another can result in expansion or compression of */ -/* certain sequences of bytes. If the clusters were juxtaposed, new */ -/* sequences of adjacent bytes, themselves subject to transformation, */ -/* might be formed. So the FTP test string present in the binary */ -/* file should have some mechanism for preventing interaction between */ -/* the clusters. The test string should also be constructed so that */ -/* it can be easily located in the event compression or expansion, */ -/* either internally or elsewhere in the file record, shifts it away */ -/* from its default location. */ - -/* So by separating these clusters with a printable delimiter, then */ -/* bracketing the entire test string with start and stop identifiers, */ -/* we have a reasonable mechanism for locating and analyzing any */ -/* potential FTP corruption. Then the sequence of characters to be */ -/* inserted into the file will appear as: */ - -/* FTPSTR:<13>:<10>:<13><10>:<13><0>:<129>:<16><206>:ENDFTP */ - -/* where 'FTPSTR' and 'ENDFTP' are the bracketing substrings and */ -/* ':' is the delimiting character. */ - -/* By no means do we claim that these are the complete set of */ -/* clusters that are corruptible through an improper FTP transfer. */ -/* An update procedure is provided in the Revisions section just */ -/* after the routine header. Following this procedure will require */ -/* the least amount of effort to prevent older files from falsely */ -/* indicating corruption under new Toolkits, as well as newer files */ -/* failing on old Toolkits. */ - - -/* $ Examples */ - -/* This routine just fetches the components of the FTP validation */ -/* string. */ - -/* $ Restrictions */ - -/* 1) TSTCOM, LEND, REND, and DELIM must be large enough to hold */ -/* the entire values returned by this routine, otherwise */ -/* truncation will occur. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 21-MAR-1999 (FST) */ - - -/* -& */ -/* $ Index_Entries */ - -/* fetch the ftp validation string components */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.0, 21-MAR-1999 (FST) */ - -/* FTP validation string update procedure: */ - -/* (1) Leave 'FTPSTR', 'ENDFTP', and ':' alone, as */ -/* their alteration will require special */ -/* consideration for older files. */ - -/* (2) Leave the existing test clusters in the */ -/* existing order, and place any new clusters */ -/* between the last ':' and the E in 'ENDFTP'. */ -/* Make certain these are ':' delimited as well. */ - -/* (3) Modify the contents of zzftprms.inc to */ -/* indicate the new sizes of the various string */ -/* components. Routines that include this must */ -/* then be recompiled. */ - -/* -& */ - -/* Local Parameters */ - -/* Maximum size of an individual test cluster component */ -/* including the ':'. */ - - -/* Integer codes of characters appearing in test clusters. */ - - - -/* Local Variables */ - - -/* Non-printing character values. */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Set up the components of the FTP validation string that */ -/* are not supposed to change for forward and backward */ -/* compatibility. */ - - -/* On the first invocation initialize the string values. */ - - if (first) { - -/* Convert the integer parameters to their non-printing ASCII */ -/* equivalents. */ - - *(unsigned char *)asc000 = '\0'; - *(unsigned char *)asc010 = '\n'; - *(unsigned char *)asc013 = '\r'; - *(unsigned char *)asc016 = '\20'; - *(unsigned char *)asc129 = 129; - *(unsigned char *)asc206 = 206; - -/* Now build the individual components of the test clusters. */ -/* Make certain the first component begins and ends with a ':', */ -/* and that the remaining pieces end in ':'. If you intend to */ -/* add some clusters, then append them to the end of the */ -/* sequence so as not to break the existing detection code. */ - - -/* Cluster #1 : - <13> - Macintosh Line Terminator */ - -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = locdlm; - i__1[1] = 1, a__1[1] = asc013; - i__1[2] = 1, a__1[2] = locdlm; - s_cat(testsq, a__1, i__1, &c__3, (ftnlen)5); - -/* Cluster #2 : - <10> - Unix Line Terminator */ - -/* Writing concatenation */ - i__2[0] = 1, a__2[0] = asc010; - i__2[1] = 1, a__2[1] = locdlm; - s_cat(testsq + 5, a__2, i__2, &c__2, (ftnlen)5); - -/* Cluster #3 : - <10><13> - Microsoft Line Terminator */ - -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = asc013; - i__1[1] = 1, a__1[1] = asc010; - i__1[2] = 1, a__1[2] = locdlm; - s_cat(testsq + 10, a__1, i__1, &c__3, (ftnlen)5); - -/* Cluster #4 : <13><0> */ - -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = asc013; - i__1[1] = 1, a__1[1] = asc000; - i__1[2] = 1, a__1[2] = locdlm; - s_cat(testsq + 15, a__1, i__1, &c__3, (ftnlen)5); - -/* Cluster #5 : <129> - Macintosh Permutation of Parity Codes */ - -/* Writing concatenation */ - i__2[0] = 1, a__2[0] = asc129; - i__2[1] = 1, a__2[1] = locdlm; - s_cat(testsq + 20, a__2, i__2, &c__2, (ftnlen)5); - -/* Cluster #6 : <16><206> */ - -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = asc016; - i__1[1] = 1, a__1[1] = asc206; - i__1[2] = 1, a__1[2] = locdlm; - s_cat(testsq + 25, a__1, i__1, &c__3, (ftnlen)5); - -/* Sample cluster addition code follows */ - -/* Cluster #7 : - Description */ - -/* TESTSQ(7) = ASCxxx // ... // LOCDLM */ - - -/* Now build the local copy of TSTCOM, LOCSTR. First clear the */ -/* uninitialized contents. */ - - s_copy(locstr, " ", (ftnlen)16, (ftnlen)1); - for (i__ = 1; i__ <= 6; ++i__) { - -/* Append TESTSQ(I) to LOCSTR to properly construct the */ -/* test component of the FTP validation string. */ - - suffix_(testsq + ((i__3 = i__ - 1) < 6 && 0 <= i__3 ? i__3 : - s_rnge("testsq", i__3, "zzftpstr_", (ftnlen)399)) * 5, & - c__0, locstr, (ftnlen)5, (ftnlen)16); - } - -/* Prevent execution of this initialization code after first pass. */ - - first = FALSE_; - } - -/* Copy the local copies of the FTP string components to the */ -/* arguments passed in from the caller. */ - - s_copy(tstcom, locstr, tstcom_len, (ftnlen)16); - s_copy(lend, loclnd, lend_len, (ftnlen)6); - s_copy(rend, locrnd, rend_len, (ftnlen)6); - s_copy(delim, locdlm, delim_len, (ftnlen)1); - return 0; -} /* zzftpstr_ */ - diff --git a/ext/spice/src/cspice/zzgapool.c b/ext/spice/src/cspice/zzgapool.c deleted file mode 100644 index 632607a675..0000000000 --- a/ext/spice/src/cspice/zzgapool.c +++ /dev/null @@ -1,221 +0,0 @@ -/* zzgapool.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZGAPOOL ( Private: get agent set for watched variable ) */ -/* Subroutine */ int zzgapool_(char *varnam, char *wtvars, integer *wtptrs, - integer *wtpool, char *wtagnt, char *agtset, ftnlen varnam_len, - ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtset_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer node; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), validc_( - integer *, integer *, char *, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - integer nfetch; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern integer lnknxt_(integer *, integer *); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Return a SPICE set containing the names of agents watching */ -/* a specified kernel variable. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VARNAM I Kernel variable name. */ -/* WTVARS I Watched kernel variable set. */ -/* WTPTRS I Pointers from variables into the watch pool. */ -/* WTPOOL I Watch pool used for managing agent names. */ -/* WTAGNT I Array of agent names. */ -/* AGTSET O Set of agents for VARNAM. */ - -/* $ Detailed_Input */ - -/* VARNAM is the name of a kernel variable. */ - -/* WTVARS is a SPICE set containing the contents of the kernel */ -/* pool watcher system's set WTVARS. */ - -/* WTPTRS is an array containing the contents of the kernel */ -/* pool watcher system's array WTPTRS. */ - -/* WTPOOL is a SPICE doubly linked list pool containing the */ -/* contents of the kernel pool watcher system's pool */ -/* WTPOOL. */ - -/* WTAGNT is an array containing the contents of the kernel */ -/* pool watcher system's array WTAGNT. */ - -/* $ Detailed_Output */ - -/* AGTSET is a SPICE set containing the names of the agents */ -/* associated with the kernel variable designated by */ -/* VARNAM. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the output set AGTSET is too small to hold the set of */ -/* agents watching VARNAM, the error will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is not part of the SPICELIB API. This routine */ -/* may be removed in a later version of the SPICE Toolkit, or */ -/* its interface may change. */ - -/* SPICE-based application code should not call this routine. */ - -/* $ Examples */ - -/* See POOL entry point SWPOOL. */ - -/* $ Restrictions */ - -/* 1) This is a private routine. See $Particulars above. */ - -/* 2) Contents of the input arrays are assumed to be valid. */ -/* The output returned by this routine is meaningless */ -/* otherwise. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get agent set for watched kernel variable */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (return_()) { - return 0; - } - chkin_("ZZGAPOOL", (ftnlen)8); - -/* The output agent set is empty until we find any */ -/* agents. */ - - scardc_(&c__0, agtset, agtset_len); - -/* Find the location of VARNAM in the set of watched */ -/* variables. */ - - i__1 = cardc_(wtvars, wtvars_len); - loc = bsrchc_(varnam, &i__1, wtvars + wtvars_len * 6, varnam_len, - wtvars_len); - if (loc == 0) { - -/* This variable is not watched. The agent set is */ -/* empty. */ - - chkout_("ZZGAPOOL", (ftnlen)8); - return 0; - } - -/* Set NODE to the head node of the agent list for VARNAM. */ -/* Traverse the agent list for VARNAM. Collect the agents */ -/* as an unordered list, then turn the list into a set. */ - - node = wtptrs[loc - 1]; - nfetch = 0; - while(node > 0) { - ++nfetch; - s_copy(agtset + (nfetch + 5) * agtset_len, wtagnt + (node - 1) * - wtagnt_len, agtset_len, wtagnt_len); - node = lnknxt_(&node, wtpool); - } - i__1 = sizec_(agtset, agtset_len); - validc_(&i__1, &nfetch, agtset, agtset_len); - chkout_("ZZGAPOOL", (ftnlen)8); - return 0; -} /* zzgapool_ */ - diff --git a/ext/spice/src/cspice/zzgetbff.c b/ext/spice/src/cspice/zzgetbff.c deleted file mode 100644 index b463f32e69..0000000000 --- a/ext/spice/src/cspice/zzgetbff.c +++ /dev/null @@ -1,454 +0,0 @@ -/* zzgetbff.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGETBFF ( Private --- Get Binary File Format ) */ -/* Subroutine */ int zzgetbff_(integer *bffid) -{ - /* Initialized data */ - - static integer int1st[4] = { 1075576832,0,16444,16864 }; - static integer int2nd[4] = { 0,1075576832,0,0 }; - - /* System generated locals */ - integer i__1, i__2; - static doublereal equiv_0[1]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; -#define dequiv (equiv_0) -#define iequiv ((integer *)equiv_0) - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Fetch binary file format. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BFFID O Binary file format code for this system. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* BFFID is an integer code that indicates the binary file */ -/* format that is determined to be native to this */ -/* platform. Possible values are: */ - -/* BIGI3E */ -/* LTLI3E */ -/* VAXGFL */ -/* VAXDFL */ - -/* as defined in the include file 'zzddhman.inc'. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the platform on which this code is compiled does not */ -/* produce results that match any of the known binary file */ -/* formats, this routine sets BFFID to 0. */ - -/* $ Particulars */ - -/* This simple program: */ - -/* PROGRAM DPTEST */ - -/* DOUBLE PRECISION DPNUM */ -/* INTEGER INNUM ( 2 ) */ - -/* EQUIVALENCE ( DPNUM, INNUM ) */ - -/* DPNUM = 7.0D0 */ - -/* WRITE (*,*) DPNUM */ -/* WRITE (*,*) INNUM ( 1 ) */ -/* WRITE (*,*) INNUM ( 2 ) */ - -/* END */ - -/* produces the following results on these representative platforms: */ - -/* Sun-Solaris (BIGI3E): */ - -/* 7.000000000 */ -/* 1075576832 */ -/* 0 */ - -/* PC-Linux (LTLI3E): */ - -/* 7.000000000 */ -/* 0 */ -/* 1075576832 */ - -/* Alpha-Gfloat (VAXGFL): */ - -/* 7.000000000 */ -/* 16444 */ -/* 0 */ - -/* Alpha-Dfloat (VAXDFL): */ - -/* 7.000000000 */ -/* 16864 */ -/* 0 */ - -/* This routine performs exactly the same decomposition of the */ -/* double precision number 7.0D0 into two integers. The results */ -/* are checked against those displayed here, and if a match is */ -/* found, returned. */ - -/* $ Examples */ - -/* See ZZDDHOPN for sample usage. */ - -/* $ Restrictions */ - -/* This routine derives the binary file format ID for a particular */ -/* platform, but for verification purposes only. ZZPLATFM should */ -/* be used to obtain the binary file format for the current platform. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 06-AUG-2002 (FST) */ - - -/* -& */ - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Copy DPVALU into the equivalenced DP, DEQUIV. */ - - *dequiv = 7.; - -/* Examine the integer pairs, to identify the binary */ -/* file format. */ - - *bffid = 0; - for (i__ = 1; i__ <= 4; ++i__) { - if (iequiv[0] == int1st[(i__1 = i__ - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("int1st", i__1, "zzgetbff_", (ftnlen)215)] && iequiv[1] - == int2nd[(i__2 = i__ - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge( - "int2nd", i__2, "zzgetbff_", (ftnlen)215)]) { - *bffid = i__; - } - } - return 0; -} /* zzgetbff_ */ - -#undef iequiv -#undef dequiv - - diff --git a/ext/spice/src/cspice/zzgetcml_c.c b/ext/spice/src/cspice/zzgetcml_c.c deleted file mode 100644 index e1d86ab790..0000000000 --- a/ext/spice/src/cspice/zzgetcml_c.c +++ /dev/null @@ -1,363 +0,0 @@ -/* - --Procedure zzgetcml_c ( Get the command line ) - --Abstract - - Store the contents of argv and argc for later access. - --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 - - UTILITY - -*/ - - #include - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZpl.h" - - #ifdef CSPICE_MACPPC - - #include - - #endif - - void zzgetcml_c ( SpiceInt * argc, - SpiceChar *** argv, - SpiceBoolean init ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - argc I/O The number of command line arguments. - argv I/O The vector of command line arguments. - init I Boolean indicating whether the call should - initialize the internal storage variables. - --Detailed_Input - - argc contains the number of command line arguments. - - argv is the vector of space delimited command line arguments. - Each entry entry contains one argument. argv[0] holds the - command name. - - init contains SPICETRUE if the call is to store the argv and argc - data, and SPICEFALSE if the call is to retrieve the data. - --Detailed_Output - - See above. - --Parameters - - None. - --Exceptions - - 1). The first call to this routine should be from putcml_c. This - stores the data values. If putcml_c does not make the first - call, the error SPICE(PUTCMLNOTCALLED) signals - - 2). Only one putcml_c call should be made in any given program. The error - SPICE(PUTCMLCALLEDTWICE) signals for all subsequent putcml_c calls. - --Files - - None. - --Particulars - - Do not directly call zzgetcml_c! - - This routine allows access to argv and argc from any program module. - The routine must be initialized in the main module prior to any - retrieval. Initialization occurs in putcml_c, access to stored - information occurs via getcml_c. - --Examples - - #include - #include - - #include "SpiceUsr.h" - - SpiceInt i; - - void main( int argc, char *argv[] ) - { - - - /. Store argv and argc for latter access. ./ - - putcml_c ( argc, argv ); - - - ..... other CRA stuff ..... - ..... ..... - - goop1(); - - ..... stuff ..... - - goop2(); - - - return 0; - } - - void goop1 () - { - - SpiceInt argc; - SpiceChar ** argv; - - - /. Retrieve the argc and argv values ./ - - getcml_c ( &argc, &argv ); - - for ( i=0; i 9) { - s_copy(error, "NEXP (exponent) not a single digit. Actual value #1", - error_len, (ftnlen)51); - repmi_(error, "#1", &nexp, error, error_len, (ftnlen)2, error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - if (abs(bexp) > 9) { - s_copy(error, "BEXP (exponent) not a single digit. Actual value #1", - error_len, (ftnlen)51); - repmi_(error, "#1", &bexp, error, error_len, (ftnlen)2, error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - -/* Confirm correct bounds on angular values. */ - -/* NODE0 - right ascension of the ascending node, [0,360) */ - - if (node0 < 0. || node0 >= 360.) { - s_copy(error, "NODE0 (RA acend node) expected bounds [0,360). Actual" - " value #1", error_len, (ftnlen)62); - repmd_(error, "#1", &node0, &c__4, error, error_len, (ftnlen)2, - error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - -/* OMEAGA - argument of the periapsis, [0,360) */ - - if (omega < 0. || omega >= 360.) { - s_copy(error, "OMEGA (arg periap) expected bounds [0,360). Actual va" - "lue #1", error_len, (ftnlen)59); - repmd_(error, "#1", &omega, &c__4, error, error_len, (ftnlen)2, - error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - -/* MO - mean anomoly, [0,360) */ - - if (mo < 0. || mo >= 360.) { - s_copy(error, "MO (mean anomoly) expected bounds [0,360). Actual val" - "ue #1", error_len, (ftnlen)58); - repmd_(error, "#1", &mo, &c__4, error, error_len, (ftnlen)2, - error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - -/* INCL - inclination, [0,180] */ - - if (incl < 0. || incl > 180.) { - s_copy(error, "INCL (inclination) expected bounds [0,180). Actual va" - "lue #1", error_len, (ftnlen)59); - repmd_(error, "#1", &incl, &c__4, error, error_len, (ftnlen)2, - error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - -/* NO - mean motion (0,20) (Earth orbiter). */ - - if (no > 20. || no < 0.) { - s_copy(error, "NO (mean motion) expected bounds (0,20). Actual value" - " #1", error_len, (ftnlen)56); - repmd_(error, "#1", &no, &c__4, error, error_len, (ftnlen)2, - error_len); - *ok = FALSE_; - chkout_("ZZGETELM", (ftnlen)8); - return 0; - } - -/* Finish up the computation of NDD60 and BSTAR */ - - ndd60 *= power[(i__1 = nexp + 37) < 75 && 0 <= i__1 ? i__1 : s_rnge("pow" - "er", i__1, "zzgetelm_", (ftnlen)827)]; - bstar *= power[(i__1 = bexp + 37) < 75 && 0 <= i__1 ? i__1 : s_rnge("pow" - "er", i__1, "zzgetelm_", (ftnlen)828)]; - -/* Convert everything from degrees to radians ... */ - - node0 *= d2r; - omega *= d2r; - mo *= d2r; - incl *= d2r; - -/* ... and from revolutions/day**n to radians/minutes**n */ - - no = no * pi2 / 1440.; - ndt20 = ndt20 * pi2 / 1440. / 1440.; - ndd60 = ndd60 * pi2 / 1440. / 1440. / 1440.; - -/* Finally, we need to convert the input epoch to */ -/* seconds past 2000. First let's adjust the year. */ -/* Add to YR the largest multiple of 100 that is */ -/* less than or equal to FRSTYR */ - - begyr = *frstyr / 100 * 100; - year = begyr + yr; - if (year < *frstyr) { - year += 100; - } - -/* Compute the epoch of the year and date. */ - - tvec[0] = (doublereal) year; - tvec[1] = day; - ttrans_("YD.D", "TDB", tvec, (ftnlen)4, (ftnlen)3); - *epoch = tvec[0]; - -/* That's it. Load ELEMS with the elements and ship them */ -/* back to the calling routine. */ - - elems[0] = ndt20; - elems[1] = ndd60; - elems[2] = bstar; - elems[3] = incl; - elems[4] = node0; - elems[5] = ecc; - elems[6] = omega; - elems[7] = mo; - elems[8] = no; - elems[9] = *epoch; - chkout_("ZZGETELM", (ftnlen)8); - return 0; -} /* zzgetelm_ */ - diff --git a/ext/spice/src/cspice/zzgfcoq.c b/ext/spice/src/cspice/zzgfcoq.c deleted file mode 100644 index 787e4c702c..0000000000 --- a/ext/spice/src/cspice/zzgfcoq.c +++ /dev/null @@ -1,963 +0,0 @@ -/* zzgfcoq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__7 = 7; -static integer c__3 = 3; - -/* $Procedure ZZGFCOQ ( GF, return coordinate quantity ) */ -/* Subroutine */ int zzgfcoq_(char *vecdef, char *method, integer *trgid, - doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, - doublereal *dvec, char *crdsys, integer *ctrid, doublereal *re, - doublereal *f, char *crdnam, doublereal *value, logical *found, - ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen - abcorr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char sysnms[32*7] = "RECTANGULAR " "LATITUDIN" - "AL " "RA/DEC " "SPH" - "ERICAL " "CYLINDRICAL " - "GEODETIC " "PLANETOGRAPHIC " - " "; - static char crdnms[32*3*7] = "X " "Y " - " " "Z " - "RADIUS " "LONGITUDE " - " " "LATITUDE " "RANGE " - " " "RIGHT ASCENSION " "DECLINATION " - " " "RADIUS " "COLATITUDE" - " " "LONGITUDE " "RADI" - "US " "LONGITUDE " - "Z " "LONGITUDE " - " " "LATITUDE " "ALTITUDE " - " " "LONGITUDE " "LATITUDE " - " " "ALTITUDE "; - static integer prvctr = 0; - static integer prvobs = 0; - static integer prvtrg = 0; - static char obsnam[36] = " "; - static char trgnam[36] = " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *), - bodc2s_(integer *, char *, ftnlen); - extern logical failed_(void); - doublereal lt; - extern /* Subroutine */ int recrad_(doublereal *, doublereal *, - doublereal *, doublereal *); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char ctrnam[36]; - extern logical return_(void); - char sysnam[32]; - doublereal coords[3], trgepc, srfvec[3]; - integer crdidx, sysidx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), spkezp_(integer *, doublereal *, - char *, char *, integer *, doublereal *, doublereal *, ftnlen, - ftnlen), subpnt_(char *, char *, doublereal *, char *, char *, - char *, doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen), sincpt_(char *, char *, doublereal *, - char *, char *, char *, char *, doublereal *, doublereal *, - doublereal *, doublereal *, logical *, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen), reclat_(doublereal *, doublereal *, - doublereal *, doublereal *), recsph_(doublereal *, doublereal *, - doublereal *, doublereal *), reccyl_(doublereal *, doublereal *, - doublereal *, doublereal *), recgeo_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), recpgr_( - char *, doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, ftnlen); - doublereal pos[3]; - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Return the value of a specified coordinate of a vector. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VECDEF I Vector definition. */ -/* METHOD I Computation method. */ -/* TRGID I Target ID code. */ -/* ET I Computation epoch. */ -/* REF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSID I Observer ID code. */ -/* DREF I Reference frame of ray's direction vector. */ -/* DVEC I Ray's direction vector. */ -/* CRDSYS I Coordinate system name. */ -/* CTRID I Frame center ID code. */ -/* RE I Equatorial radius of central body. */ -/* F I Flattening coefficient of central body. */ -/* CRDNAM I Coordinate name. */ -/* VALUE O Coordinate value. */ -/* FOUND O Flag indicating if coordinate was computed. */ - -/* $ Detailed_Input */ - - -/* VECDEF Every coordinate computed by this routine is a */ -/* function of an underlying vector. VECDEF is a short */ -/* string describing the means by which the vector of */ -/* interest is defined. Only parameters from the Fortran */ -/* INCLUDE file zzgf.inc should be used. Parameter names */ -/* and meanings are: */ - -/* POSDEF Vector is position of */ -/* target relative to observer. */ - -/* SOBDEF Vector is sub-observer */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* SINDEF Vector is ray-surface intercept */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string VECDEF. */ - - -/* METHOD is a string specifying the computational method */ -/* applicable to the vector of interest. When VECDEF */ -/* is the parameter */ - -/* SOBDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SUBPNT. */ - -/* When VECDEF is the parameter */ - -/* SINDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SINCPT. */ - -/* METHOD is ignored if VECDEF is set to */ - -/* POSDEF */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string METHOD. */ - - -/* TRGID is the NAIF ID code of the target object. */ - - -/* ET is the time, expressed as ephemeris seconds past J2000 */ -/* TDB, at which the specified coordinate is to be */ -/* computed. */ - - -/* REF is the name of the reference frame relative to which */ -/* the vector of interest is specified. The specified */ -/* condition applies to the specified coordinate of */ -/* of this vector in frame REF. */ - -/* When geodetic or planetographic coordinates are used, */ -/* the reference ellipsoid is assumed to be that */ -/* associated with the central body of the frame */ -/* designated by REF. In this case, the central body of */ -/* the frame must be an extended body. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* NONE No correction. */ -/* LT Light time only. */ -/* LT+S Light time and stellar aberration. */ -/* CN Converged Newtonian (CN) light time. */ -/* CN+S CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* XLT Light time only. */ -/* XLT+S Light time and stellar aberration. */ -/* XCN Converged Newtonian (CN) light time. */ -/* XCN+S CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSID is the NAIF ID code of the observer. */ - - -/* DREF is the name of the reference frame relative to which a */ -/* ray's direction vector is expressed. This may be any */ -/* frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and leading */ -/* and trailing blanks in FIXREF are not significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the frame's */ -/* center is located elsewhere, then letting LTCENT be */ -/* the one-way light time between the observer and the */ -/* central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* CRDSYS is the name of the coordinate system to which the */ -/* coordinate of interest belongs. Allowed values are */ -/* those defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string CRDSYS. */ - - -/* CTRID is the NAIF ID code of the input frame REF's center. */ - - -/* RE is the equatorial radius associated with the body */ -/* designated by CTRID. RE is used only when the */ -/* coordinate system is GEOSYS or PGRSYS; otherwise */ -/* RE may be set to 0.D0. */ - -/* F is the flattening coefficient associated with the body */ -/* designated by CTRID. RE is used only when the */ -/* coordinate system is GEOSYS or PGRSYS; otherwise RE */ -/* may be set to 0.D0. */ - - -/* CRDNAM is the name of the coordinate of interest: this is */ -/* the coordinate to which the specified condition */ -/* applies. The set of coordinate names is a function of */ -/* the coordinate system. Allowed values are those */ -/* defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string CRDNAM. */ - - -/* $ Detailed_Output */ - -/* VALUE is the specified coordinate, evaluated at the epoch ET. */ -/* Coordinates having dimensions of length have units of */ -/* km. Coordinates having angular dimensions have units of */ -/* radians. */ - -/* VALUE is defined if and only if the output argument */ -/* FOUND is set to .TRUE. */ - - -/* FOUND is a logical flag indicating whether the requested */ -/* coordinate could be computed. FOUND is set to .FALSE. */ -/* if and only if the vector definition is SINDEF and */ -/* either */ - -/* - no surface intercept is found */ - -/* - the velocity of the surface intercept is not */ -/* computable */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the vector definition VECDEF is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 2) If the vector definition is either SOBDEF or SINDEF */ -/* and the computation method METHOD is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 3) If the aberration correction ABCORR is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 4) If the coordinate system name CRDSYS is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 5) If the coordinate name CRDNAM is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 6) If the frame REF is not recognized by the frames subsystem, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 7) If VECDEF calls for a computation involving a target surface */ -/* point and the radii defining the reference ellipsoid */ -/* associated with the target body are not available in the */ -/* kernel pool, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 8) If VECDEF calls for a computation involving a target surface */ -/* point and the name and ID code of the frame associated with */ -/* the target body is not available from the frame subsystem, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 9) If ephemeris data are required but not available to compute */ -/* the state of the target, the coordinate frame REF's center, */ -/* or the input ray's frame DREF's center relative to the */ -/* observer, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 10) If orientation data for the frame REF are not available, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 11) If orientation data for the frame DREF are required but */ -/* not available, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* $ Files */ - -/* This routine doesn't directly participate in SPICE kernel loading */ -/* or unloading. However, a variety of SPICE kernels must be loaded */ -/* in order for this routine to work: */ - -/* - Since all coordinate computations supported by this routine */ -/* depend on observer-target vectors, at a minimum, SPK files */ -/* providing ephemeris data enabling computation of these */ -/* vectors are required. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* - If the coordinate of interest is defined in terms of a target */ -/* surface point, then (currently) a PCK providing radii for a */ -/* triaxial shape model must be loaded. */ - -/* - If geodetic or planetographic coordinates are used, then a */ -/* PCK providing radii for a triaxial shape model must be */ -/* loaded. */ - -/* See the Files section of GFEVNT's header for further information. */ - -/* $ Particulars */ - -/* This routine is used by the GF coordinate utility routines in */ -/* order to solve for time windows on which specified mathematical */ -/* conditions involving coordinates are satisfied. */ - -/* $ Examples */ - -/* See ZZGFCOU. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */ - -/* Upgraded to support targets and observers having */ -/* no names associated with their ID codes. */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* compute coordinates of a vector */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* The Ith coordinate system in the array SYSNMS has coordinates */ -/* in the Ith row of the array CRDNMS. This association must be */ -/* preserved when this routine is updated. */ - - -/* The order of the coordinate names in the Ith row of this array */ -/* matches the order of the outputs of the corresponding */ -/* SPICELIB routine REC*, which maps a Cartesian vector to */ -/* the Ith coordinate system in the array SYSNMS. Again, this */ -/* order must be preserved. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOQ", (ftnlen)7); - -/* No result was found yet. */ - - *found = FALSE_; - -/* Find the index of the coordinate system name in the list of */ -/* supported names. */ - - sysidx = isrchc_(crdsys, &c__7, sysnms, crdsys_len, (ftnlen)32); - if (sysidx == 0) { - -/* We don't recognize this system name. */ - - setmsg_("The coordinate system # is not supported.", (ftnlen)41); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; - } - s_copy(sysnam, sysnms + (((i__1 = sysidx - 1) < 7 && 0 <= i__1 ? i__1 : - s_rnge("sysnms", i__1, "zzgfcoq_", (ftnlen)560)) << 5), (ftnlen) - 32, (ftnlen)32); - -/* Find the index of the coordinate name in the list of */ -/* supported names. */ - - crdidx = isrchc_(crdnam, &c__3, crdnms + (((i__1 = sysidx * 3 - 3) < 21 && - 0 <= i__1 ? i__1 : s_rnge("crdnms", i__1, "zzgfcoq_", (ftnlen) - 566)) << 5), crdnam_len, (ftnlen)32); - if (crdidx == 0) { - -/* We don't recognize this coordinate name. */ - - setmsg_("The coordinate name # belonging to the coordinate system # " - "is not recognized.", (ftnlen)77); - errch_("#", crdnam, (ftnlen)1, crdnam_len); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; - } - -/* Look up the target and observer names if these will be */ -/* needed. The SUBPNT and SINCPT interfaces require them. */ -/* The RECPGR interface requires the frame center ID code */ -/* as well. */ - - if (s_cmp(vecdef, "SUB-OBSERVER POINT", vecdef_len, (ftnlen)18) == 0 || - s_cmp(vecdef, "SURFACE INTERCEPT POINT", vecdef_len, (ftnlen)23) - == 0 || s_cmp(sysnam, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == - 0) { - if (first || *trgid != prvtrg) { - bodc2s_(trgid, trgnam, (ftnlen)36); - prvtrg = *trgid; - } - if (first || *obsid != prvobs) { - bodc2s_(obsid, obsnam, (ftnlen)36); - prvobs = *obsid; - } - if (first || *ctrid != prvctr) { - bodc2s_(ctrid, ctrnam, (ftnlen)36); - prvctr = *ctrid; - } - first = FALSE_; - } - if (s_cmp(vecdef, "POSITION", vecdef_len, (ftnlen)8) == 0) { - -/* Find the observer-target position vector. */ - - spkezp_(trgid, et, ref, abcorr, obsid, pos, <, ref_len, abcorr_len); - } else if (s_cmp(vecdef, "SUB-OBSERVER POINT", vecdef_len, (ftnlen)18) == - 0) { - -/* The caller has requested a sub-observer point coordinate */ -/* computation. */ - - subpnt_(method, trgnam, et, ref, abcorr, obsnam, pos, &trgepc, srfvec, - method_len, (ftnlen)36, ref_len, abcorr_len, (ftnlen)36); - } else if (s_cmp(vecdef, "SURFACE INTERCEPT POINT", vecdef_len, (ftnlen) - 23) == 0) { - -/* The caller has requested a surface intercept point coordinate */ -/* computation. */ - - sincpt_(method, trgnam, et, ref, abcorr, obsnam, dref, dvec, pos, & - trgepc, srfvec, found, method_len, (ftnlen)36, ref_len, - abcorr_len, (ftnlen)36, dref_len); - -/* Without an intercept, there's nothing left to do here. */ - - if (! (*found)) { - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; - } - } else { - setmsg_("The coordinate quantity # is not recognized.", (ftnlen)44); - errch_("#", vecdef, (ftnlen)1, vecdef_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; - } - -/* If we already encountered an error while trying to compute */ -/* the vector of interest, return now. */ - - if (failed_()) { - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; - } - -/* At this point we assume the vector whose coordinate is */ -/* to be computed resides in POS. Convert POS to the */ -/* specified coordinate system. */ - - if (s_cmp(sysnam, "RECTANGULAR", (ftnlen)32, (ftnlen)11) == 0) { - -/* No conversion needed for rectangular coordinates. */ - - moved_(pos, &c__3, coords); - } else if (s_cmp(sysnam, "LATITUDINAL", (ftnlen)32, (ftnlen)11) == 0) { - reclat_(pos, coords, &coords[1], &coords[2]); - } else if (s_cmp(sysnam, "RA/DEC", (ftnlen)32, (ftnlen)6) == 0) { - recrad_(pos, coords, &coords[1], &coords[2]); - } else if (s_cmp(sysnam, "SPHERICAL", (ftnlen)32, (ftnlen)9) == 0) { - recsph_(pos, coords, &coords[1], &coords[2]); - } else if (s_cmp(sysnam, "CYLINDRICAL", (ftnlen)32, (ftnlen)11) == 0) { - reccyl_(pos, coords, &coords[1], &coords[2]); - } else if (s_cmp(sysnam, "GEODETIC", (ftnlen)32, (ftnlen)8) == 0) { - recgeo_(pos, re, f, coords, &coords[1], &coords[2]); - } else if (s_cmp(sysnam, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - recpgr_(ctrnam, pos, re, f, coords, &coords[1], &coords[2], (ftnlen) - 36); - } else { - -/* We should never arrive here. */ - - setmsg_("The coordinate system # is not supported.", (ftnlen)41); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; - } - -/* Set the return value. */ - -/* CRDIDX indicates the index of the coordinate of interest */ -/* in the list of coordinates for the input coordinate system. */ - - *value = coords[(i__1 = crdidx - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "coords", i__1, "zzgfcoq_", (ftnlen)733)]; - -/* Having made it this far means the result was found. */ - - *found = TRUE_; - chkout_("ZZGFCOQ", (ftnlen)7); - return 0; -} /* zzgfcoq_ */ - diff --git a/ext/spice/src/cspice/zzgfcost.c b/ext/spice/src/cspice/zzgfcost.c deleted file mode 100644 index d7b4897834..0000000000 --- a/ext/spice/src/cspice/zzgfcost.c +++ /dev/null @@ -1,740 +0,0 @@ -/* zzgfcost.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGFCOST ( GF, coordinate definition state ) */ -/* Subroutine */ int zzgfcost_(char *vecdef, char *method, integer *trgid, - doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, - integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, - logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, - ftnlen abcorr_len, ftnlen dref_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzgfssob_(char *, integer *, doublereal *, - char *, char *, integer *, doublereal *, doublereal *, ftnlen, - ftnlen, ftnlen), zzgfssin_(char *, integer *, doublereal *, char * - , char *, integer *, char *, integer *, doublereal *, doublereal * - , doublereal *, logical *, ftnlen, ftnlen, ftnlen, ftnlen), - chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen), - spkez_(integer *, doublereal *, char *, char *, integer *, - doublereal *, doublereal *, ftnlen, ftnlen); - doublereal lt; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Return a state vector used to define coordinates referenced in a */ -/* GF search. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VECDEF I Vector definition. */ -/* METHOD I Computation method. */ -/* TRGID I Target ID code. */ -/* ET I Computation epoch. */ -/* REF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSID I Observer ID code. */ -/* DREF I Reference frame of ray's direction vector. */ -/* DCTR I ID code of ray frame's center. */ -/* DVEC I Ray's direction vector. */ -/* RADII I Radii of reference ellipsoid. */ -/* STATE O State used to define coordinates. */ -/* FOUND O Flag indicating if state was computed. */ - -/* $ Detailed_Input */ - - -/* VECDEF States computed by this routine consist of a an */ -/* underlying vector and the vector's velocity. VECDEF is */ -/* a short string describing the means by which the */ -/* vector of interest is defined. Only parameters from */ -/* the Fortran INCLUDE file zzgf.inc should be used. */ -/* Parameter names and meanings are: */ - -/* POSDEF Vector is position of */ -/* target relative to observer. */ - -/* SOBDEF Vector is sub-observer */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* SINDEF Vector is ray-surface intercept */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string VECDEF. */ - - -/* METHOD is a string specifying the computational method */ -/* applicable to the vector of interest. When VECDEF */ -/* is the parameter */ - -/* SOBDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SUBPNT. */ - -/* When VECDEF is the parameter */ - -/* SINDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SINCPT. */ - -/* METHOD is ignored if VECDEF is set to */ - -/* POSDEF */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string METHOD. */ - - -/* TRGID is the NAIF ID code of the target object. */ - - -/* ET is the time, expressed as ephemeris seconds past J2000 */ -/* TDB, at which the specified state is to be computed. */ - - -/* REF is the name of the reference frame relative to which */ -/* the state of interest is specified. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* NONE No correction. */ -/* LT Light time only. */ -/* LT+S Light time and stellar aberration. */ -/* CN Converged Newtonian (CN) light time. */ -/* CN+S CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* XLT Light time only. */ -/* XLT+S Light time and stellar aberration. */ -/* XCN Converged Newtonian (CN) light time. */ -/* XCN+S CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSID is the NAIF ID code of the observer. */ - - -/* DREF is the name of the reference frame relative to which a */ -/* ray's direction vector is expressed. This may be any */ -/* frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and leading */ -/* and trailing blanks in DREF are not significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DCTR is the ID code of the object at which the frame */ -/* designated by DREF is centered. Although DCTR */ -/* can be derived from DREF, in the interest of */ -/* efficiency, DCTR is obtained by the caller, */ -/* normally during search initialization. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the frame's */ -/* center is located elsewhere, then letting LTCENT be */ -/* the one-way light time between the observer and the */ -/* central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* RADII is a double precision array containing the three */ -/* radii of a reference ellipsoid associated with */ -/* the target body. */ - -/* RADII is ignored if the input vector definition */ -/* is POSDEF; in this case the caller may set the */ -/* elements of RADII to zero. */ - - -/* $ Detailed_Output */ - -/* STATE is the specified state vector, evaluated at the epoch */ -/* ET. The position component of STATE is the vector */ -/* defined by VECDEF and the other inputs. The velocity */ -/* component of STATE is the derivative with respect to */ -/* time of the position component. Units are km and km/s. */ - -/* STATE is defined if and only if the output argument */ -/* FOUND is set to .TRUE. */ - - -/* FOUND is a logical flag indicating whether the requested */ -/* state could be computed. FOUND is set to .FALSE. if */ -/* and only if the vector definition is SINDEF and either */ - -/* - the surface intercept is not found */ - -/* - the surface intercept velocity is not computable */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the vector definition VECDEF is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 2) If the computation method METHOD is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 3) If the aberration correction ABCORR is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 4) If the frame REF is not recognized by the frames subsystem, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 5) If VECDEF calls for a computation involving a target surface */ -/* point and the name and ID code of the frame associated with */ -/* the target body is not available from the frame subsystem, */ -/* the error SPICE(NOFRAME) is signaled. */ - -/* 6) If VECDEF calls for a computation involving a target surface */ -/* point and ID codes of target and observer can't be converted */ -/* to names, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 7) If ephemeris data are required but not available to compute */ -/* the state of the target, the coordinate frame REF's center, */ -/* or the input ray's frame DREF's center relative to the */ -/* observer, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 8) If orientation data for the frame REF are not available, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 9) If orientation data for the frame DREF are required but */ -/* not available, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 10) If the input radii don't define a valid triaxial ellipsoid, */ -/* the error will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* $ Files */ - -/* This routine doesn't directly participate in SPICE kernel loading */ -/* or unloading. However, a variety of SPICE kernels must be loaded */ -/* in order for this routine to work: */ - -/* - SPK files providing ephemeris data enabling computation of */ -/* the specified state vector are required. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* - If the state of interest is defined in terms of a target */ -/* surface point, then (currently) a PCK providing radii for a */ -/* triaxial shape model must be loaded. */ - -/* See the Files section of GFEVNT's header for further information. */ - -/* $ Particulars */ - -/* This routine is used by the GF coordinate utility routines in */ -/* order to solve for time windows on which specified mathematical */ -/* conditions involving coordinates are satisfied. The role of */ -/* this routine is to provide Cartesian state vectors enabling */ -/* the GF coordinate utilities to determine the signs of the */ -/* derivatives with respect to time of coordinates of interest. */ - -/* This routine has a secondary purpose: enabling the GF system */ -/* to determine, via a binary state search, the window over */ -/* which a coordinate of interest is computable. This "computability */ -/* window" must be found before any search involving a constraint */ -/* on a coordinate of a surface intercept point can be performed. */ - -/* $ Examples */ - -/* See ZZGFCOU. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* compute state defining coordinate */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOST", (ftnlen)8); - -/* No result was found yet. */ - - *found = FALSE_; - if (s_cmp(vecdef, "POSITION", vecdef_len, (ftnlen)8) == 0) { - -/* Find the observer-target state vector. */ - - spkez_(trgid, et, ref, abcorr, obsid, state, <, ref_len, abcorr_len) - ; - *found = TRUE_; - } else if (s_cmp(vecdef, "SUB-OBSERVER POINT", vecdef_len, (ftnlen)18) == - 0) { - -/* The caller has requested the state of a sub-observer point. */ - - zzgfssob_(method, trgid, et, ref, abcorr, obsid, radii, state, - method_len, ref_len, abcorr_len); - *found = TRUE_; - } else if (s_cmp(vecdef, "SURFACE INTERCEPT POINT", vecdef_len, (ftnlen) - 23) == 0) { - -/* The caller has requested the state of a surface intercept */ -/* point. */ - - zzgfssin_(method, trgid, et, ref, abcorr, obsid, dref, dctr, dvec, - radii, state, found, method_len, ref_len, abcorr_len, - dref_len); - } else { - setmsg_("The coordinate quantity # is not recognized.", (ftnlen)44); - errch_("#", vecdef, (ftnlen)1, vecdef_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOST", (ftnlen)8); - return 0; - } - -/* At this point, one of the following is true: */ - -/* - the state vector was found and */ -/* FOUND is .TRUE. */ - -/* - FOUND is .FALSE. */ - -/* - a SPICE error occurred */ - - chkout_("ZZGFCOST", (ftnlen)8); - return 0; -} /* zzgfcost_ */ - diff --git a/ext/spice/src/cspice/zzgfcou.c b/ext/spice/src/cspice/zzgfcou.c deleted file mode 100644 index 694a14407f..0000000000 --- a/ext/spice/src/cspice/zzgfcou.c +++ /dev/null @@ -1,3497 +0,0 @@ -/* zzgfcou.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; -static integer c__7 = 7; -static integer c__3 = 3; - -/* $Procedure ZZGFCOU ( GF, coordinate utility package ) */ -/* Subroutine */ int zzgfcou_0_(int n__, char *vecdef, char *method, char * - target, doublereal *et, char *ref, char *abcorr, char *obsrvr, char * - dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal * - refval, logical *decres, logical *lssthn, doublereal *crdval, logical - *crdfnd, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, - ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, - ftnlen crdsys_len, ftnlen crdnam_len) -{ - /* Initialized data */ - - static char sysnms[32*7] = "RECTANGULAR " "LATITUDIN" - "AL " "RA/DEC " "SPH" - "ERICAL " "CYLINDRICAL " - "GEODETIC " "PLANETOGRAPHIC " - " "; - static char crdnms[32*3*7] = "X " "Y " - " " "Z " - "RADIUS " "LONGITUDE " - " " "LATITUDE " "RANGE " - " " "RIGHT ASCENSION " "DECLINATION " - " " "RADIUS " "COLATITUDE" - " " "LONGITUDE " "RADI" - "US " "LONGITUDE " - "Z " "LONGITUDE " - " " "LATITUDE " "ALTITUDE " - " " "LONGITUDE " "LATITUDE " - " " "ALTITUDE "; - static doublereal y[3] = { 0.,1.,0. }; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double cos(doublereal), sin(doublereal); - - /* Local variables */ - static doublereal svre; - extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen), - zzgfcost_(char *, char *, integer *, doublereal *, char *, char *, - integer *, char *, integer *, doublereal *, doublereal *, - doublereal *, logical *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), - zzgfcprx_(doublereal *, char *, doublereal *, doublereal *, - integer *, integer *, ftnlen); - integer n; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen), ucase_(char *, char *, ftnlen, ftnlen), errch_( - char *, char *, ftnlen, ftnlen); - integer class__; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - logical found; - doublereal value; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal state[6]; - static char svcrd[32], svref[32]; - static integer svobs; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen), - bodc2s_(integer *, char *, ftnlen); - extern logical failed_(void); - extern doublereal pi_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *), bodvcd_( - integer *, char *, integer *, integer *, doublereal *, ftnlen); - integer frcode; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - static char svcorr[20], svcsys[32], svdref[32], svmeth[200], svrcnm[36], - svvdef[32]; - char timstr[40]; - doublereal coords[3]; - static doublereal svdvec[3], svradi[3], svrval; - integer cdsign[3], clssid; - static integer svcidx, svdctr, svrctr, svsens, svtarg; - integer sysidx; - logical attblk[6]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - doublereal alt, lat; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - errint_(char *, integer *, ftnlen), recpgr_(char *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, ftnlen); - doublereal lon; - extern /* Subroutine */ int reclat_(doublereal *, doublereal *, - doublereal *, doublereal *), recrad_(doublereal *, doublereal *, - doublereal *, doublereal *), recsph_(doublereal *, doublereal *, - doublereal *, doublereal *); - static doublereal svf; - extern /* Subroutine */ int reccyl_(doublereal *, doublereal *, - doublereal *, doublereal *), recgeo_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *), zzgfcoq_( - char *, char *, integer *, doublereal *, char *, char *, integer * - , char *, doublereal *, char *, integer *, doublereal *, - doublereal *, char *, doublereal *, logical *, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* This is the umbrella routine for the entry points needed by */ -/* GFEVNT (or other GF routines) in order to solve for time windows */ -/* on which specified mathematical conditions involving coordinates */ -/* are satisfied. */ - -/* $ 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 */ - -/* FRAMES */ -/* GF */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* VECDEF I COIN */ -/* METHOD I COIN */ -/* TARGET I COIN */ -/* ET I COIN, CODC, COLT, COG, COCD, COCL, COCG, COSD, */ -/* COSL, COSG, COEX */ -/* REF I COIN */ -/* ABCORR I COIN */ -/* OBSRVR I COIN */ -/* DREF I COIN */ -/* DVEC I COIN */ -/* CRDSYS I COIN */ -/* CRDNAM I COIN */ -/* REFVAL I COIN */ -/* DECRES O CODC, COCD, COSD */ -/* LSSTHN O COLT, COCL, COSL */ -/* CRDVAL O COG, COCG, COSG */ -/* CRDFND O COEX */ - -/* $ Detailed_Input */ - -/* See individual entry points. */ - -/* $ Detailed_Output */ - -/* See individual entry points. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If this routine is called directly, the error */ -/* SPICE(BOGUSENTRY) is signaled. */ - -/* See the entry points for descriptions of exceptions specific */ -/* to those routines. */ - -/* $ Files */ - -/* This suite of routines doesn't directly participate in SPICE */ -/* kernel loading or unloading. However, a variety of SPICE kernels */ -/* must be loaded in order for these utilities to work: */ - -/* - Since all coordinate computations supported by this routine */ -/* depend on observer-target vectors, at a minimum, SPK files */ -/* providing ephemeris data enabling computation of these */ -/* vectors are required. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* - If the coordinate of interest is defined in terms of a target */ -/* surface point, then (currently) a PCK providing radii for a */ -/* triaxial shape model must be loaded. */ - -/* - If geodetic coordinates are used, then a PCK providing radii */ -/* for a triaxial shape model must be loaded. */ - -/* See the Files section of GFEVNT's header for further information. */ - -/* $ Particulars */ - -/* This routine serves as the umbrella routine for entry points */ -/* needed by GFEVNT or other GF routines in order to solve for time */ -/* windows on which specified mathematical conditions involving */ -/* coordinates are satisfied. For brevity, we may refer to such a */ -/* time window as the "solution window" or "coordinate solution */ -/* window." */ - -/* The entry points of this package are */ - -/* ZZGFCOIN an initialization routine that must be called */ -/* to define the coordinate of interest. This */ -/* routine must be called at least once before */ -/* any of the other entry points are called, but */ -/* it may be called as many times as necessary */ -/* to initialize new computations. */ - -/* Below, the phrase "the coordinate" refers */ -/* to the coordinate established by the latest */ -/* call to ZZGFCOIN. For example, the coordinate */ -/* may be the "geodetic latitude of the sub-moon */ -/* point on the earth, relative to the IAU_EARTH */ -/* reference frame, computed using light time and */ -/* stellar aberration corrections." */ - -/* ZZGFCOUR updates the reference value, REFVAL. REFVAL */ -/* serves as the comparison value for equality */ -/* or inequality relations. */ - -/* ZZGFCODC indicates whether the coordinate is strictly */ -/* decreasing as a function of time, at a specified */ -/* time. */ - -/* ZZGFCOG returns the coordinate value at a specified */ -/* time. */ - -/* ZZGFCOLT indicates whether the coordinate is less than */ -/* the reference value REFVAL at a specified time. */ - -/* ZZGFCOEX indicates whether the coordinate is computable */ -/* at a specified time. ZZGFCOEX is used to */ -/* determine the time window over which a specified */ -/* target surface intercept and its time derivative */ -/* is computable. */ - - -/* The following entry points support solution window */ -/* computations for conditions involving longitude or right */ -/* ascension. They may have applications for relations involving */ -/* other angular coordinates. */ - -/* ZZGFCOCD indicates whether the cosine of the coordinate is */ -/* strictly decreasing as a function of time, at a */ -/* specified time. */ - -/* ZZGFCOSD indicates whether the sine of the coordinate is */ -/* strictly decreasing as a function of time, at a */ -/* specified time. */ - -/* ZZGFCOCG returns the cosine of the coordinate at a */ -/* specified time. */ - -/* ZZGFCOSG returns the sine of the coordinate at a */ -/* specified time. */ - -/* ZZGFCOCL indicates whether the cosine of the coordinate is */ -/* less than the reference value REFVAL at a */ -/* specified time. */ - -/* ZZGFCOSL indicates whether the sine of the coordinate is */ -/* less than the reference value REFVAL at a */ -/* specified time. */ - -/* $ Examples */ - -/* See the code of GFEVNT and ZZGFLONG for usage examples. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */ - -/* Upgraded to support targets and observers having */ -/* no names associated with their ID codes. */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* umbrella routine for finding coordinate events */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Length of an aberration correction name string. */ - - -/* Length of a reference frame name. */ - - -/* Length of a body name. */ - - -/* Length of a coordinate system name. */ - - -/* Length of a vector definition name. */ - - -/* Number of recognized coordinate systems. */ - - -/* Maximum length of a coordinate name. */ - - -/* Maximum length of computation method name. */ - - -/* Time string length. */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial values */ - - -/* Names of supported coordinate systems. */ - -/* The Ith coordinate system in the array SYSNMS has coordinates */ -/* in the Ith row of the array CRDNMS. This association must be */ -/* preserved when this routine is updated. */ - - /* Parameter adjustments */ - if (dvec) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzgfcoin; - case 2: goto L_zzgfcour; - case 3: goto L_zzgfcog; - case 4: goto L_zzgfcolt; - case 5: goto L_zzgfcodc; - case 6: goto L_zzgfcoex; - case 7: goto L_zzgfcocg; - case 8: goto L_zzgfcosg; - case 9: goto L_zzgfcocl; - case 10: goto L_zzgfcosl; - case 11: goto L_zzgfcocd; - case 12: goto L_zzgfcosd; - } - - -/* Names of coordinate triples for the supported coordinate */ -/* systems. */ - -/* The order of the coordinate names in the Ith row of this array */ -/* matches the order of the outputs of the corresponding */ -/* SPICELIB routine REC*, which maps a Cartesian vector to */ -/* the Ith coordinate system in the array SYSNMS. Again, this */ -/* order must be preserved. */ - - -/* This routine should never be called. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOU", (ftnlen)7); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZGFCOU", (ftnlen)7); - return 0; -/* $Procedure ZZGFCOIN ( GF, coordinate search initialization ) */ - -L_zzgfcoin: -/* $ Abstract */ - -/* Initialize a coordinate search. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* CHARACTER*(*) VECDEF */ -/* CHARACTER*(*) METHOD */ -/* CHARACTER*(*) TARGET */ -/* CHARACTER*(*) REF */ -/* CHARACTER*(*) ABCORR */ -/* CHARACTER*(*) OBSRVR */ -/* CHARACTER*(*) DREF */ -/* DOUBLE PRECISION DVEC */ -/* CHARACTER*(*) CRDSYS */ -/* CHARACTER*(*) CRDNAM */ -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VECDEF I Vector definition. */ -/* METHOD I Computation method. */ -/* TARGET I Target name. */ -/* REF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Observer name. */ -/* DREF I Ray's direction vector frame. */ -/* DVEC I Ray's direction vector. */ -/* CRDSYS I Coordinate system name. */ -/* CRDNAM I Coordinate name. */ -/* REFVAL I Reference value. */ - -/* $ Detailed_Input */ - - -/* VECDEF Every coordinate computed by this routine is a */ -/* function of an underlying vector. VECDEF is a short */ -/* string describing the means by which the vector of */ -/* interest is defined. Only parameters from the Fortran */ -/* INCLUDE file zzgf.inc should be used. Parameter names */ -/* and meanings are: */ - -/* POSDEF Vector is position of */ -/* target relative to observer. */ - -/* SOBDEF Vector is sub-observer */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* SINDEF Vector is ray-surface intercept */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string VECDEF. */ - - -/* METHOD is a string specifying the computational method */ -/* applicable to the vector of interest. When VECDEF */ -/* is the parameter */ - -/* SOBDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SUBPNT. */ - -/* When VECDEF is the parameter */ - -/* SINDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SINCPT. */ - -/* METHOD is ignored if VECDEF is set to */ - -/* POSDEF */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string METHOD. */ - - -/* TARGET is the name of the target object. */ - - -/* REF is the name of the reference frame relative to which */ -/* the vector of interest is specified. The specified */ -/* condition applies to the specified coordinate of */ -/* of this vector in frame REF. */ - -/* When geodetic coordinates are used, the reference */ -/* ellipsoid is assumed to be that associated with */ -/* the central body of the frame designated by REF. */ -/* In this case, the central body of the frame must */ -/* be an extended body. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only. */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the observer. */ - - -/* DREF is the name of the reference frame relative to which a */ -/* ray's direction vector is expressed. This may be any */ -/* frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and leading */ -/* and trailing blanks in FIXREF are not significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the frame's */ -/* center is located elsewhere, then letting LTCENT be */ -/* the one-way light time between the observer and the */ -/* central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* CRDSYS is the name of the coordinate system to which the */ -/* coordinate of interest belongs. Allowed values are */ -/* those defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* Note that when geodetic or planetograhic coordinates */ -/* are used, the reference ellipsoid is that associated */ -/* with the central body of the reference frame */ -/* designated by REF. The central body must be an */ -/* extended body in this case. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string CRDSYS. */ - - -/* CRDNAM is the name of the coordinate of interest: this is */ -/* the coordinate to which the specified condition */ -/* applies. The set of coordinate names is a function of */ -/* the coordinate system. Allowed values are those */ -/* defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string CRDNAM. */ - - -/* REFVAL is the reference value used to define equality or */ -/* inequality conditions. */ - -/* If the coordinate has the dimension "length," then */ -/* REFVAL has units of kilometers. */ - -/* If the coordinate has the dimension "angle," then */ -/* REFVAL has units of radians. */ - -/* When the coordinate of interest is longitude, REFVAL */ -/* is interpreted as though it were translated, if */ -/* necessary, by an integer multiple of 2*pi to place it */ -/* in the standard range for longitude: (-pi, pi]. */ -/* Similarly, when the coordinate of interest is right */ -/* ascension, REFVAL is interpreted as though it were */ -/* translated, if necessary, by an integer multiple of */ -/* 2*pi into the range [0, 2*pi). */ - -/* Example: suppose REFVAL is set to -4.5. Then the */ -/* condition */ - -/* longitude equals REFVAL */ - -/* is interpreted as */ - -/* longitude equals -0.5 * pi */ - -/* so the solution window for this condition may well */ -/* be non-empty. */ - -/* REFVAL is ignored if OP is not an equality or */ -/* inequality operator. */ - -/* $ Detailed_Output */ - -/* None. This routine operates by side effects. See Particulars */ -/* for a description of the action of this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either the observer or target names cannot be mapped */ -/* to ID codes, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the observer and target have the same ID codes, the */ -/* error SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 3) If the vector definition VECDEF is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the computation method METHOD is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 5) If the aberration correction ABCORR is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 6) If the coordinate system name CRDSYS is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 7) If the coordinate name CRDNAM is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 8) If the frame REF is not recognized by the frames subsystem, */ -/* the error SPICE(NOFRAME) will be signaled. */ - -/* 9) If VECDEF calls for a computation involving a target surface */ -/* intercept point and the name and ID code of the frame DREF */ -/* associated with the target body are not available from the */ -/* frame subsystem, the error SPICE(NOFRAME) is signaled. */ - -/* 10) If VECDEF calls for a computation involving a target surface */ -/* intercept point and the direction vector DVEC is the zero */ -/* vector, the error SPICE(ZEROVECTOR) is signaled. */ - -/* 11) If VECDEF calls for a computation involving a target surface */ -/* point and the radii defining the reference ellipsoid */ -/* associated with the target body are not available in the */ -/* kernel pool, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 12) If VECDEF calls for a computation involving a target surface */ -/* point and the frame REF is not centered on the target body, */ -/* the error SPICE(INVALIDFRAME) will be signaled. */ - -/* 13) If geodetic or planetographic coordinates are used and the */ -/* radii defining the reference ellipsoid associated with the */ -/* center of the frame REF are not available in the kernel pool, */ -/* the error will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* 14) If geodetic or planetographic coordinates are used and the */ -/* first equatorial radius of the reference ellipsoid associated */ -/* with the center of the frame REF is zero, the error */ -/* SPICE(DIVIDEBYZERO) is signaled. */ - -/* 15) If geodetic or planetographic coordinates are used and the */ -/* equatorial radii of the reference ellipsoid associated */ -/* with the center of the frame REF are unequal, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 16) If geodetic or planetographic coordinates are used and the */ -/* reference ellipsoid associated with the center of the frame */ -/* REF is degenerate (one or more radii are non-positive), */ -/* the error SPICE(DEGENERATECASE) is signaled. */ - -/* $ Files */ - -/* See the discussion in the Files section of the header of the */ -/* umbrella subroutine ZZGFCOU. */ - -/* $ Particulars */ - -/* This routine's main purpose is to support GFEVNT. Many of */ -/* the geometric quantities supported by GFEVNT are simply */ -/* coordinates of a vector in some reference frame. */ - -/* The entry points that deal with sines and cosines of coordinates */ -/* support solving problems involving constraints on */ -/* longitude or right ascension. See ZZGFLONG for usage examples. */ - -/* $ Examples */ - -/* See GFEVNT and ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* 3) This routine has the following couplings with other */ -/* SPICE routines: */ - -/* - The set of allowed aberration corrections must */ -/* be kept in sync with the set supported by the */ -/* SPK API routines. */ - -/* - The set of vector definitions must be kept in */ -/* sync with the set supported by GFEVNT. */ - -/* - The set of supported coordinate systems must be kept in */ -/* sync with the set supported by zzgf.inc. */ - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */ - -/* Upgraded to support targets and observers having */ -/* no names associated with their ID codes. */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* coordinate initialization routine */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFCOIN", (ftnlen)8); - -/* Find NAIF IDs for TARGET and OBSRVR. */ - - bods2c_(target, &svtarg, &found, target_len); - if (! found) { - setmsg_("The target object, '#', is not a recognized name for an eph" - "emeris object. The cause of this problem may be that you nee" - "d an updated version of the SPICE Toolkit. ", (ftnlen)162); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - bods2c_(obsrvr, &svobs, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Make sure the observer and target are distinct. */ - - if (svtarg == svobs) { - setmsg_("The observer and target must be distinct objects, but are n" - "ot: OBSRVR = #; TARGET = #.", (ftnlen)86); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Squeeze all blanks out of the aberration correction */ -/* string; ensure the string is in upper case. */ - - cmprss_(" ", &c__0, abcorr, svcorr, (ftnlen)1, abcorr_len, (ftnlen)20); - ucase_(svcorr, svcorr, (ftnlen)20, (ftnlen)20); - -/* Check the aberration correction. If SPKEZR can't handle it, */ -/* neither can we. */ - - zzvalcor_(svcorr, attblk, (ftnlen)20); - if (failed_()) { - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Store a compressed, upper case, left-justified copy of VECDEF. */ - - ljust_(vecdef, svvdef, vecdef_len, (ftnlen)32); - cmprss_(" ", &c__1, svvdef, svvdef, (ftnlen)1, (ftnlen)32, (ftnlen)32); - ucase_(svvdef, svvdef, (ftnlen)32, (ftnlen)32); - -/* Check SVVDEF. */ - - if (s_cmp(svvdef, "POSITION", (ftnlen)32, (ftnlen)8) != 0 && s_cmp(svvdef, - "SUB-OBSERVER POINT", (ftnlen)32, (ftnlen)18) != 0 && s_cmp( - svvdef, "SURFACE INTERCEPT POINT", (ftnlen)32, (ftnlen)23) != 0) { - -/* We don't recognize this vector definition. */ - - setmsg_("The vector definition # is not supported.", (ftnlen)41); - errch_("#", vecdef, (ftnlen)1, vecdef_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Store a compressed, upper case, left-justified copy of CRDSYS. */ - - ljust_(crdsys, svcsys, crdsys_len, (ftnlen)32); - cmprss_(" ", &c__0, svcsys, svcsys, (ftnlen)1, (ftnlen)32, (ftnlen)32); - ucase_(svcsys, svcsys, (ftnlen)32, (ftnlen)32); - sysidx = isrchc_(svcsys, &c__7, sysnms, (ftnlen)32, (ftnlen)32); - if (sysidx == 0) { - -/* We don't recognize this system name. */ - - setmsg_("The coordinate system # is not supported.", (ftnlen)41); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Store a compressed, upper case, left-justified copy of CRDNAM. */ - - ljust_(crdnam, svcrd, crdnam_len, (ftnlen)32); - cmprss_(" ", &c__1, svcrd, svcrd, (ftnlen)1, (ftnlen)32, (ftnlen)32); - ucase_(svcrd, svcrd, (ftnlen)32, (ftnlen)32); - -/* Find and save the index of the coordinate name in the list of */ -/* supported names. */ - - svcidx = isrchc_(svcrd, &c__3, crdnms + (((i__1 = sysidx * 3 - 3) < 21 && - 0 <= i__1 ? i__1 : s_rnge("crdnms", i__1, "zzgfcou_", (ftnlen) - 1020)) << 5), (ftnlen)32, (ftnlen)32); - if (svcidx == 0) { - -/* We don't recognize this coordinate name. */ - - setmsg_("The coordinate name # belonging to the coordinate system # " - "is not recognized.", (ftnlen)77); - errch_("#", crdnam, (ftnlen)1, crdnam_len); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Store an upper case, left-justified copy of REF. */ - - ljust_(ref, svref, ref_len, (ftnlen)32); - ucase_(svref, svref, (ftnlen)32, (ftnlen)32); - -/* Save the reference value. */ - - svrval = *refval; - -/* The remaining work is a function of the vector definition */ -/* and the coordinate system. */ - - if (s_cmp(svvdef, "SUB-OBSERVER POINT", (ftnlen)32, (ftnlen)18) == 0 || - s_cmp(svvdef, "SURFACE INTERCEPT POINT", (ftnlen)32, (ftnlen)23) - == 0 || s_cmp(svcsys, "GEODETIC", (ftnlen)32, (ftnlen)8) == 0 || - s_cmp(svcsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - -/* The coordinate is defined using a sub-observer point or */ -/* a surface intercept point, OR we're using geodetic or */ -/* planetographic coordinates. In any of these cases, we */ -/* need the center of the input reference frame and the */ -/* radii associated with this center. */ - - namfrm_(svref, &frcode, (ftnlen)32); - -/* Save the frame REF's center ID in SVRCTR. */ - - frinfo_(&frcode, &svrctr, &class__, &clssid, &found); - if (! found) { - setmsg_("Frame system did not recognize frame #.", (ftnlen)39); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* For sub-observer point and surface intercept vector */ -/* definitions, make sure the input frame's center is */ -/* the target body. */ - - if (s_cmp(vecdef, "SUB-OBSERVER POINT", vecdef_len, (ftnlen)18) == 0 - || s_cmp(vecdef, "SURFACE INTERCEPT POINT", vecdef_len, ( - ftnlen)23) == 0) { - if (svrctr != svtarg) { - setmsg_("Vector definition method is #, but input reference " - "frame # has center #. For this vector definition, th" - "e frame must be centered on the target body #.", ( - ftnlen)149); - errch_("#", vecdef, (ftnlen)1, vecdef_len); - errch_("#", ref, (ftnlen)1, ref_len); - errint_("#", &svrctr, (ftnlen)1); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - } - -/* At this point, we know the frame REF is centered on the */ -/* target if the computation method is SINDEF or SOBDEF. */ -/* Fetch the radii of the body acting as the frame center. */ - - bodvcd_(&svrctr, "RADII", &c__3, &n, svradi, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Make sure we obtained three radii. */ - - if (n != 3) { - setmsg_("Expected to find three radii defining triaxial ellipsoi" - "dal shape model for body # but instead found #.", (ftnlen) - 102); - errint_("#", &svrctr, (ftnlen)1); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Check the radii. */ - - if (svradi[0] == 0.) { - setmsg_("Cannot compute flattening factor. Radii are # # #.", ( - ftnlen)50); - errdp_("#", svradi, (ftnlen)1); - errdp_("#", &svradi[1], (ftnlen)1); - errdp_("#", &svradi[2], (ftnlen)1); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } else if (svradi[0] < 0. || svradi[1] <= 0. || svradi[2] <= 0.) { - setmsg_("Degenerate ellipsoid: radii are # # #.", (ftnlen)38); - errdp_("#", svradi, (ftnlen)1); - errdp_("#", &svradi[1], (ftnlen)1); - errdp_("#", &svradi[2], (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* For geodetic and planetographic coordinates, we need to save */ -/* the equatorial radius and flattening coefficient. For other */ -/* coordinate systems, these quantities aren't needed. */ - -/* At this point, we also check for unequal equatorial radii, */ -/* which are not allowed with geodetic or planetographic */ -/* coordinates. */ - - if (s_cmp(svcsys, "GEODETIC", (ftnlen)32, (ftnlen)8) == 0 || s_cmp( - svcsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - if (svradi[0] != svradi[1]) { - setmsg_("Central body # of reference frame # has radii # # #" - ". Unequal equatorial ellipsoid radii are not support" - "ed for # coordinates. ", (ftnlen)125); - errint_("#", &svrctr, (ftnlen)1); - errch_("#", ref, (ftnlen)1, ref_len); - errdp_("#", svradi, (ftnlen)1); - errdp_("#", &svradi[1], (ftnlen)1); - errdp_("#", &svradi[2], (ftnlen)1); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - -/* Save the equatorial radius of the central body. */ - - svre = svradi[0]; - -/* Save the flattening coefficient of the central body. Note */ -/* that we've ensured the denominator is non-zero. */ - - svf = (svradi[0] - svradi[2]) / svradi[0]; - } else { - svre = 0.; - svf = 0.; - } - -/* Save the computation method, if required. */ - - if (s_cmp(vecdef, "SUB-OBSERVER POINT", vecdef_len, (ftnlen)18) == 0 - || s_cmp(vecdef, "SURFACE INTERCEPT POINT", vecdef_len, ( - ftnlen)23) == 0) { - -/* The coordinate is defined using a sub-observer point or */ -/* a surface intercept point. */ - -/* Store an upper case, left-justified copy of METHOD. */ - - ljust_(method, svmeth, method_len, (ftnlen)200); - ucase_(svmeth, svmeth, (ftnlen)200, (ftnlen)200); - } else { - -/* Simply initialize SVMETH with a blank string. */ - - s_copy(svmeth, " ", (ftnlen)200, (ftnlen)1); - } - -/* If we're using planetographic coordinates, we'll need the */ -/* longitude sense. Recall that the body with which these */ -/* coordinates are associated is the center of REF. Find the */ -/* longitude of the +Y axis. */ - - if (s_cmp(svcsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - bodc2s_(&svrctr, svrcnm, (ftnlen)36); - recpgr_(svrcnm, y, &svre, &svf, &lon, &lat, &alt, (ftnlen)36); - -/* Planetographic longitude ranges from 0 to 2*pi, so */ -/* longitudes corresponding to positive Y values are */ -/* in the range pi to 2*pi. */ - - if (lon > pi_()) { - svsens = -1; - } else { - svsens = 1; - } - } else { - svsens = 0; - } - } - -/* If we're using a surface intercept vector definition, we'll */ -/* need to check and store the variables associated with the */ -/* ray. */ - - if (s_cmp(svvdef, "SURFACE INTERCEPT POINT", (ftnlen)32, (ftnlen)23) == 0) - { - if (vzero_(dvec)) { - setmsg_("Ray's direction vector is the zero vector. This variabl" - "e might be uninitialized.", (ftnlen)80); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - } - -/* Save DVEC and DREF. */ - - moved_(dvec, &c__3, svdvec); - s_copy(svdref, dref, (ftnlen)32, dref_len); - -/* Save the center of DREF. */ - - namfrm_(svdref, &frcode, (ftnlen)32); - frinfo_(&frcode, &svdctr, &class__, &clssid, &found); - if (! found) { - setmsg_("Frame system did not recognize frame #.", (ftnlen)39); - errch_("#", dref, (ftnlen)1, dref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; - } - } else { - -/* Simply give initial values to SVDREF, SVDCTR, and SVDVEC. */ - - s_copy(svdref, " ", (ftnlen)32, (ftnlen)1); - svdctr = 0; - cleard_(&c__3, svdvec); - } - chkout_("ZZGFCOIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOUR ( GF, update reference value ) */ - -L_zzgfcour: -/* $ Abstract */ - -/* Update the reference value set by the last call to ZZGFCOIN. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* REFVAL I Reference value. */ - -/* $ Detailed_Input */ - -/* REFVAL is the new reference value to be used by */ -/* the entry points */ - -/* ZZGFCODC */ -/* ZZGFCOCD */ -/* ZZGFCOSD */ - -/* in this package. The coordinate, or the cosine or */ -/* sine of the coordinate, is compared to the */ -/* reference value by these entry points. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine supports use of GFREL within ZZGFLONG. This */ -/* routine is used as the actual argument corresponding to */ -/* GFREL's dummy argument GFQREF. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* update reference value */ - -/* -& */ - svrval = *refval; - return 0; -/* $Procedure ZZGFCOG ( GF, get coordinate ) */ - -L_zzgfcog: -/* $ Abstract */ - -/* Compute the coordinate defined by the last call to ZZGFCOIN is at */ -/* the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION CRDVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* CRDVAL O Coordinate at epoch. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* CRDVAL is the coordinate defined by the previous call to */ -/* ZZGFCOIN, evaluated at the epoch ET. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the coordinate cannot be computed at ET, the */ -/* error SPICE(NOTCOMPUTABLE) is signaled. */ - -/* 2) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by routines */ -/* in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get coordinate */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGFCOG", (ftnlen)7); - } - zzgfcoq_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, - svdvec, svcsys, &svrctr, &svre, &svf, svcrd, crdval, &found, ( - ftnlen)32, (ftnlen)200, (ftnlen)32, (ftnlen)20, (ftnlen)32, ( - ftnlen)32, (ftnlen)32); - if (! found) { - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOG", (ftnlen)7); - return 0; - } - chkout_("ZZGFCOG", (ftnlen)7); - return 0; -/* $Procedure ZZGFCOLT ( GF, is coordinate less than reference value? ) */ - -L_zzgfcolt: -/* $ Abstract */ - -/* Indicate whether the coordinate defined by the last call to */ -/* ZZGFCOIN is less than the reference value. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL LSSTHN */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* LSSTHN O Flag indicating if "less than" relation holds. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* LSSTHN is a logical flag indicating whether the cosine of */ -/* the coordinate defined by the previous call to */ -/* ZZGFCOIN is strictly less than the reference value */ -/* at the epoch ET. LSSTHN is .TRUE. if this */ -/* relation holds and .FALSE. otherwise. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* is coordinate less than reference value */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFCOLT", (ftnlen)8); - zzgfcoq_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, - svdvec, svcsys, &svrctr, &svre, &svf, svcrd, &value, &found, ( - ftnlen)32, (ftnlen)200, (ftnlen)32, (ftnlen)20, (ftnlen)32, ( - ftnlen)32, (ftnlen)32); - if (! found) { - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOLT", (ftnlen)8); - return 0; - } - *lssthn = value < svrval; - chkout_("ZZGFCOLT", (ftnlen)8); - return 0; -/* $Procedure ZZGFCODC ( GF, is coordinate decreasing? ) */ - -L_zzgfcodc: -/* $ Abstract */ - -/* Indicate whether the coordinate defined by the last call to */ -/* ZZGFCOIN is decreasing at the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL DECRES */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* DECRES O Flag indicating if coordinate is decreasing. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* DECRES is a logical flag indicating whether */ -/* the coordinate defined by the previous call to */ -/* ZZGFCOIN is strictly decreasing at the epoch ET. */ -/* DECRES is .FALSE. if the coordinate */ -/* is decreasing and .TRUE. otherwise. */ - -/* In cases where the coordinate is undefined */ -/* at ET, DECRES is set to .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) In cases where the any intermediate quantity required by */ -/* this routine is undefined, DECRES is set to .FALSE. This */ -/* situation occurs when the Jacobian of the coordinate system */ -/* with respect to rectangular coordinates is undefined at ET. */ - -/* 2) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 3) If an error occurs while this routine computes the derivative */ -/* with respect to time of the coordinate defined by ZZGFCOIN, the */ -/* error will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* A function f(x) is strictly decreasing at x0 if and only if there */ -/* exists some delta > 0 such that for all dx satisfying */ - -/* 0 < dx < delta */ - -/* we have */ - -/* f(x0) < f(x0 + dx) */ - -/* and */ - -/* f(x0 - dx) < f(x) */ - -/* Note that a strictly decreasing function need not be */ -/* differentiable in a neighborhood of x0; it can have jump */ -/* discontinuities in any neighborhood of x0 and even at x0. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* is coordinate decreasing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCODC", (ftnlen)8); - -/* Fetch the state from which the coordinate is derived. If the */ -/* state can't be computed, we consider the coordinate to be */ -/* "not decreasing." */ - - zzgfcost_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, & - svdctr, svdvec, svradi, state, &found, (ftnlen)32, (ftnlen)200, ( - ftnlen)32, (ftnlen)20, (ftnlen)32); - if (! found) { - *decres = FALSE_; - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCODC", (ftnlen)8); - return 0; - } - -/* Compute the proxy for the derivative with respect to time of the */ -/* coordinate. This proxy gives us the sign of the derivative, which */ -/* is all we need to determine whether the coordinate is decreasing. */ - - zzgfcprx_(state, svcsys, &svre, &svf, &svsens, cdsign, (ftnlen)32); - -/* The quantity is decreasing if and only if the derivative */ -/* is negative. This is indicated by a "sign" of -1. */ - - *decres = cdsign[(i__1 = svcidx - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "cdsign", i__1, "zzgfcou_", (ftnlen)1966)] == -1; - chkout_("ZZGFCODC", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOEX ( GF, does coordinate state exist? ) */ - -L_zzgfcoex: -/* $ Abstract */ - -/* Indicate whether the state of coordinate defined by the last call */ -/* to ZZGFCOIN is computable at the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL CRDFND */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* CRDFND O Flag indicating if coordinate state is computable. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* CRDFND is a logical flag indicating whether the state of */ -/* the coordinate defined by the previous call to */ -/* ZZGFCOIN is computable at the epoch ET. DECRES is */ -/* .TRUE. if the coordinate is computable and .FALSE. */ -/* otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while this routine attempts to compute the */ -/* coordinate defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* This routine is used by the GF system to compute a time window */ -/* over which a specified coordinate state is computable. */ - -/* Coordinates defined by surface intercepts may fail to be */ -/* computable because either */ - -/* - the surface intercept does not exist */ - -/* - the velocity of the intercept is not computable */ - -/* $ Examples */ - -/* See ZZGFCSLV. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* does coordinate state exist */ -/* is coordinate state computable */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOEX", (ftnlen)8); - -/* Simply attempt to compute the state. The returned found flag */ -/* is the result. */ - - zzgfcost_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, & - svdctr, svdvec, svradi, state, crdfnd, (ftnlen)32, (ftnlen)200, ( - ftnlen)32, (ftnlen)20, (ftnlen)32); - chkout_("ZZGFCOEX", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOCG ( GF, get cosine of coordinate ) */ - -L_zzgfcocg: -/* $ Abstract */ - -/* Compute the cosine of the coordinate defined by the last call to */ -/* ZZGFCOIN is at the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION CRDVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* CRDVAL O Cosine of coordinate at epoch. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* CRDVAL is the cosine of the coordinate defined by the */ -/* previous call to ZZGFCOIN, evaluated at the epoch */ -/* ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get cosine of coordinate */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOCG", (ftnlen)8); - zzgfcoq_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, - svdvec, svcsys, &svrctr, &svre, &svf, svcrd, &value, &found, ( - ftnlen)32, (ftnlen)200, (ftnlen)32, (ftnlen)20, (ftnlen)32, ( - ftnlen)32, (ftnlen)32); - if (! found) { - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOCG", (ftnlen)8); - return 0; - } - *crdval = cos(value); - chkout_("ZZGFCOCG", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOSG ( GF, get sine of coordinate ) */ - -L_zzgfcosg: -/* $ Abstract */ - -/* Compute the sine of the coordinate defined by the last call to */ -/* ZZGFCOIN is at the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION CRDVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* CRDVAL O Sine of coordinate at epoch. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* CRDVAL is the sine of the coordinate defined by the */ -/* previous call to ZZGFCOIN, evaluated at the epoch */ -/* ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* get sine of coordinate */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFCOSG", (ftnlen)8); - zzgfcoq_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, - svdvec, svcsys, &svrctr, &svre, &svf, svcrd, &value, &found, ( - ftnlen)32, (ftnlen)200, (ftnlen)32, (ftnlen)20, (ftnlen)32, ( - ftnlen)32, (ftnlen)32); - if (! found) { - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOSG", (ftnlen)8); - return 0; - } - *crdval = sin(value); - chkout_("ZZGFCOSG", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOCL ( GF, is cosine of coordinate < reference value? ) */ - -L_zzgfcocl: -/* $ Abstract */ - -/* Indicate whether the cosine of the coordinate defined by the */ -/* last call to ZZGFCOIN is less than the reference value. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL LSSTHN */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* LSSTHN O Flag indicating if "less than" relation holds. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* LSSTHN is a logical flag indicating whether the cosine of */ -/* the coordinate defined by the previous call to */ -/* ZZGFCOIN is strictly less than the reference value */ -/* at the epoch ET. LSSTHN is .TRUE. if this */ -/* relation holds and .FALSE. otherwise. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* is cosine of coordinate less than reference value */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOCL", (ftnlen)8); - -/* Compute the coordinate; compare the cosine to the reference */ -/* value. */ - - zzgfcoq_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, - svdvec, svcsys, &svrctr, &svre, &svf, svcrd, &value, &found, ( - ftnlen)32, (ftnlen)200, (ftnlen)32, (ftnlen)20, (ftnlen)32, ( - ftnlen)32, (ftnlen)32); - if (! found) { - *lssthn = FALSE_; - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOCL", (ftnlen)8); - return 0; - } - *lssthn = cos(value) < svrval; - chkout_("ZZGFCOCL", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOSL ( GF, is sine of coordinate < reference value? ) */ - -L_zzgfcosl: -/* $ Abstract */ - -/* Indicate whether the sine of the coordinate defined by the */ -/* last call to ZZGFCOIN is less than the reference value. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL LSSTHN */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* LSSTHN O Flag indicating if "less than" relation holds. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* LSSTHN is a logical flag indicating whether the sine of */ -/* the coordinate defined by the previous call to */ -/* ZZGFCOIN is strictly less than the reference value */ -/* at the epoch ET. LSSTHN is .TRUE. if this */ -/* relation holds and .FALSE. otherwise. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* is sine of coordinate less than reference value */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOSL", (ftnlen)8); - zzgfcoq_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, - svdvec, svcsys, &svrctr, &svre, &svf, svcrd, &value, &found, ( - ftnlen)32, (ftnlen)200, (ftnlen)32, (ftnlen)20, (ftnlen)32, ( - ftnlen)32, (ftnlen)32); - if (! found) { - *lssthn = FALSE_; - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOSL", (ftnlen)8); - return 0; - } - *lssthn = sin(value) < svrval; - chkout_("ZZGFCOSL", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOCD ( GF, is cosine of coordinate decreasing? ) */ - -L_zzgfcocd: -/* $ Abstract */ - -/* Indicate whether the cosine of the coordinate defined by the */ -/* last call to ZZGFCOIN is decreasing at the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL DECRES */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* DECRES O Flag indicating if cos of coordinate is decreasing. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* DECRES is a logical flag indicating whether the cosine of */ -/* the coordinate defined by the previous call to */ -/* ZZGFCOIN is strictly decreasing at the epoch ET. */ -/* DECRES is .FALSE. if the cosine of the coordinate */ -/* is decreasing and .TRUE. otherwise. */ - -/* In cases where the coordinate is undefined */ -/* at ET, DECRES is set to .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) In cases where the any intermediate quantity required by */ -/* this routine is undefined, DECRES is set to .FALSE. This */ -/* situation occurs when the Jacobian of the coordinate system */ -/* with respect to rectangular coordinates is undefined at ET. */ - -/* 2) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 3) If an error occurs while this routine computes the derivative */ -/* with respect to time of the coordinate defined by ZZGFCOIN, the */ -/* error will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* A function f(x) is strictly decreasing at x0 if and only if there */ -/* exists some delta > 0 such that for all dx satisfying */ - -/* 0 < dx < delta */ - -/* we have */ - -/* f(x0) < f(x0 + dx) */ - -/* and */ - -/* f(x0 - dx) < f(x) */ - -/* Note that a strictly decreasing function need not be */ -/* differentiable in a neighborhood of x0; it can have jump */ -/* discontinuities in any neighborhood of x0 and even at x0. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* is cosine of coordinate decreasing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOCD", (ftnlen)8); - -/* The derivative of cosine of the coordinate Q is */ - -/* - sin ( Q(ET) ) * d( Q(ET) )/d(ET) */ - -/* Look up the individual terms. Start with the Cartesian */ -/* state vector from whose position component Q is */ -/* derived. */ - - zzgfcost_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, & - svdctr, svdvec, svradi, state, &found, (ftnlen)32, (ftnlen)200, ( - ftnlen)32, (ftnlen)20, (ftnlen)32); - if (! found) { - *decres = FALSE_; - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOCD", (ftnlen)8); - return 0; - } - -/* At this point we assume the state whose coordinate is to be */ -/* computed resides in STATE. Convert the position portion of STATE */ -/* to the specified coordinate system. */ - - if (s_cmp(svcsys, "RECTANGULAR", (ftnlen)32, (ftnlen)11) == 0) { - -/* No conversion needed for rectangular coordinates. */ - - moved_(state, &c__3, coords); - } else if (s_cmp(svcsys, "LATITUDINAL", (ftnlen)32, (ftnlen)11) == 0) { - reclat_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "RA/DEC", (ftnlen)32, (ftnlen)6) == 0) { - recrad_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "SPHERICAL", (ftnlen)32, (ftnlen)9) == 0) { - recsph_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "CYLINDRICAL", (ftnlen)32, (ftnlen)11) == 0) { - reccyl_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "GEODETIC", (ftnlen)32, (ftnlen)8) == 0) { - recgeo_(state, &svre, &svf, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - recpgr_(svrcnm, state, &svre, &svf, coords, &coords[1], &coords[2], ( - ftnlen)36); - } else { - -/* We should never arrive here. */ - - setmsg_("The coordinate system # is not supported.", (ftnlen)41); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFCOCD", (ftnlen)8); - return 0; - } - -/* Pick off the coordinate value. */ - - value = coords[(i__1 = svcidx - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("coo" - "rds", i__1, "zzgfcou_", (ftnlen)3013)]; - -/* Compute the proxy for the derivative with respect to time of the */ -/* coordinate. This proxy gives us the sign of the derivative, which */ -/* is all we need to determine whether the coordinate is decreasing. */ - - zzgfcprx_(state, svcsys, &svre, &svf, &svsens, cdsign, (ftnlen)32); - -/* The derivative of the coordinate is negative if the "sign" is -1. */ - - *decres = -sin(value) * cdsign[(i__1 = svcidx - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("cdsign", i__1, "zzgfcou_", (ftnlen)3025)] < 0.; - chkout_("ZZGFCOCD", (ftnlen)8); - return 0; -/* $Procedure ZZGFCOSD ( GF, is sine of coordinate decreasing? ) */ - -L_zzgfcosd: -/* $ Abstract */ - -/* Indicate whether the sine of the coordinate defined by the */ -/* last call to ZZGFCOIN is decreasing at the specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL DECRES */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Computation epoch. */ -/* DECRES O Flag indicating if sine of coordinate is */ -/* decreasing. */ - -/* $ Detailed_Input */ - -/* ET is the computation epoch, expressed as seconds */ -/* past J2000 TDB. */ - -/* $ Detailed_Output */ - -/* DECRES is a logical flag indicating whether the sine */ -/* of the coordinate defined by the previous call to */ -/* ZZGFCOIN is strictly decreasing at the epoch ET. */ -/* DECRES is .FALSE. if the sine of the coordinate is */ -/* decreasing and .TRUE. otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) In cases where the any intermediate quantity required by */ -/* this routine is undefined, DECRES is set to .FALSE. This */ -/* situation occurs when the Jacobian of the coordinate system */ -/* with respect to rectangular coordinates is undefined at ET. */ - -/* 2) If an error occurs while this routine computes the coordinate */ -/* defined by ZZGFCOIN, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 3) If an error occurs while this routine computes the derivative */ -/* with respect to time of the coordinate defined by ZZGFCOIN, the */ -/* error will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFCOU. */ - -/* $ Particulars */ - -/* A function f(x) is strictly decreasing at x0 if and only if there */ -/* exists some delta > 0 such that for all dx satisfying */ - -/* 0 < dx < delta */ - -/* we have */ - -/* f(x0) < f(x0 + dx) */ - -/* and */ - -/* f(x0 - dx) < f(x) */ - -/* Note that a strictly decreasing function need not be */ -/* differentiable in a neighborhood of x0; it can have jump */ -/* discontinuities in any neighborhood of x0 and even at x0. */ - -/* $ Examples */ - -/* See ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCOIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* is sine of coordinate decreasing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCOSD", (ftnlen)8); - -/* The derivative of the sine of the coordinate Q is */ - -/* cos ( Q(ET) ) * d( Q(ET) )/d(ET) */ - -/* Look up the individual terms. Start with the Cartesian state */ -/* vector from whose position component Q is derived. */ - - zzgfcost_(svvdef, svmeth, &svtarg, et, svref, svcorr, &svobs, svdref, & - svdctr, svdvec, svradi, state, &found, (ftnlen)32, (ftnlen)200, ( - ftnlen)32, (ftnlen)20, (ftnlen)32); - if (! found) { - *decres = FALSE_; - etcal_(et, timstr, (ftnlen)40); - setmsg_("Coordinate # could not be computed at # TDB", (ftnlen)43); - errch_("#", svcrd, (ftnlen)1, (ftnlen)32); - errch_("#", timstr, (ftnlen)1, (ftnlen)40); - sigerr_("SPICE(NOTCOMPUTABLE)", (ftnlen)20); - chkout_("ZZGFCOSD", (ftnlen)8); - return 0; - } - -/* At this point we assume the state whose coordinate is to be */ -/* computed resides in STATE. Convert the position portion of STATE */ -/* to the specified coordinate system. */ - - if (s_cmp(svcsys, "RECTANGULAR", (ftnlen)32, (ftnlen)11) == 0) { - -/* No conversion needed for rectangular coordinates. */ - - moved_(state, &c__3, coords); - } else if (s_cmp(svcsys, "LATITUDINAL", (ftnlen)32, (ftnlen)11) == 0) { - reclat_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "RA/DEC", (ftnlen)32, (ftnlen)6) == 0) { - recrad_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "SPHERICAL", (ftnlen)32, (ftnlen)9) == 0) { - recsph_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "CYLINDRICAL", (ftnlen)32, (ftnlen)11) == 0) { - reccyl_(state, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "GEODETIC", (ftnlen)32, (ftnlen)8) == 0) { - recgeo_(state, &svre, &svf, coords, &coords[1], &coords[2]); - } else if (s_cmp(svcsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - recpgr_(svrcnm, state, &svre, &svf, coords, &coords[1], &coords[2], ( - ftnlen)36); - } else { - -/* We should never arrive here. */ - - setmsg_("The coordinate system # is not supported.", (ftnlen)41); - errch_("#", crdsys, (ftnlen)1, crdsys_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFCOSD", (ftnlen)8); - return 0; - } - -/* Pick off the coordinate value. */ - - value = coords[(i__1 = svcidx - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("coo" - "rds", i__1, "zzgfcou_", (ftnlen)3280)]; - -/* Compute the proxy for the derivative with respect to time of the */ -/* coordinate. This proxy gives us the sign of the derivative, which */ -/* is all we need to determine whether the coordinate is decreasing. */ - - zzgfcprx_(state, svcsys, &svre, &svf, &svsens, cdsign, (ftnlen)32); - -/* The derivative of the coordinate is negative if the "sign" is -1. */ - - *decres = cos(value) * cdsign[(i__1 = svcidx - 1) < 3 && 0 <= i__1 ? i__1 - : s_rnge("cdsign", i__1, "zzgfcou_", (ftnlen)3292)] < 0.; - chkout_("ZZGFCOSD", (ftnlen)8); - return 0; -} /* zzgfcou_ */ - -/* Subroutine */ int zzgfcou_(char *vecdef, char *method, char *target, - doublereal *et, char *ref, char *abcorr, char *obsrvr, char *dref, - doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, - logical *decres, logical *lssthn, doublereal *crdval, logical *crdfnd, - ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen - ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, - ftnlen crdsys_len, ftnlen crdnam_len) -{ - return zzgfcou_0_(0, vecdef, method, target, et, ref, abcorr, obsrvr, - dref, dvec, crdsys, crdnam, refval, decres, lssthn, crdval, - crdfnd, vecdef_len, method_len, target_len, ref_len, abcorr_len, - obsrvr_len, dref_len, crdsys_len, crdnam_len); - } - -/* Subroutine */ int zzgfcoin_(char *vecdef, char *method, char *target, char - *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char * - crdsys, char *crdnam, doublereal *refval, ftnlen vecdef_len, ftnlen - method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, - ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen - crdnam_len) -{ - return zzgfcou_0_(1, vecdef, method, target, (doublereal *)0, ref, abcorr, - obsrvr, dref, dvec, crdsys, crdnam, refval, (logical *)0, ( - logical *)0, (doublereal *)0, (logical *)0, vecdef_len, - method_len, target_len, ref_len, abcorr_len, obsrvr_len, dref_len, - crdsys_len, crdnam_len); - } - -/* Subroutine */ int zzgfcour_(doublereal *refval) -{ - return zzgfcou_0_(2, (char *)0, (char *)0, (char *)0, (doublereal *)0, ( - char *)0, (char *)0, (char *)0, (char *)0, (doublereal *)0, (char - *)0, (char *)0, refval, (logical *)0, (logical *)0, (doublereal *) - 0, (logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcog_(doublereal *et, doublereal *crdval) -{ - return zzgfcou_0_(3, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, (logical *)0, crdval, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcolt_(doublereal *et, logical *lssthn) -{ - return zzgfcou_0_(4, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, lssthn, (doublereal *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcodc_(doublereal *et, logical *decres) -{ - return zzgfcou_0_(5, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, decres, (logical *)0, (doublereal *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcoex_(doublereal *et, logical *crdfnd) -{ - return zzgfcou_0_(6, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, (logical *)0, (doublereal *)0, - crdfnd, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcocg_(doublereal *et, doublereal *crdval) -{ - return zzgfcou_0_(7, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, (logical *)0, crdval, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcosg_(doublereal *et, doublereal *crdval) -{ - return zzgfcou_0_(8, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, (logical *)0, crdval, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcocl_(doublereal *et, logical *lssthn) -{ - return zzgfcou_0_(9, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, lssthn, (doublereal *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcosl_(doublereal *et, logical *lssthn) -{ - return zzgfcou_0_(10, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, (logical *)0, lssthn, (doublereal *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcocd_(doublereal *et, logical *decres) -{ - return zzgfcou_0_(11, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, decres, (logical *)0, (doublereal *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfcosd_(doublereal *et, logical *decres) -{ - return zzgfcou_0_(12, (char *)0, (char *)0, (char *)0, et, (char *)0, ( - char *)0, (char *)0, (char *)0, (doublereal *)0, (char *)0, (char - *)0, (doublereal *)0, decres, (logical *)0, (doublereal *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzgfcprx.c b/ext/spice/src/cspice/zzgfcprx.c deleted file mode 100644 index 01367411eb..0000000000 --- a/ext/spice/src/cspice/zzgfcprx.c +++ /dev/null @@ -1,839 +0,0 @@ -/* zzgfcprx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static doublereal c_b15 = 1.; -static doublereal c_b38 = 0.; - -/* $Procedure ZZGFCPRX ( GF, coordinate derivative proxy ) */ -/* Subroutine */ int zzgfcprx_(doublereal *state, char *corsys, doublereal * - re, doublereal *f, integer *sense, integer *cdsign, ftnlen corsys_len) -{ - /* System generated locals */ - integer i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - double d_sign(doublereal *, doublereal *); - integer i_dnnt(doublereal *); - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal xmat[9] /* was [3][3] */; - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int zzrtnmat_(doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), vpack_(doublereal *, doublereal *, doublereal *, - doublereal *); - extern logical vzero_(doublereal *); - doublereal dp; - extern /* Subroutine */ int cleari_(integer *, integer *), recgeo_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *), latrec_(doublereal *, doublereal *, - doublereal *, doublereal *); - integer dpsign; - doublereal normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *) - , chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char * - , integer *, ftnlen); - doublereal rtnvel[3]; - integer rtnsgn[3]; - extern logical return_(void); - doublereal alt, lat, vel[3], lon; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Return the signs of a Cartesian velocity vector's coordinates */ -/* when the velocity is transformed to a given coordinate system. */ - -/* $ 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 */ - -/* COORDINATE */ -/* GEOMETRY */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STATE I A 6-dimensional Cartesian state vector. */ -/* CORSYS I A coordinate system name parameter. */ -/* RE I Ellipsoid equatorial radius. */ -/* F I Ellipsoid flattening coefficient. */ -/* SENSE I Reference body longitude sense. */ -/* CDSIGN O Velocity sign vector. */ - -/* $ Detailed_Input */ - -/* STATE is any Cartesian state vector. The order of the */ -/* components matches those used by the SPK system. */ - -/* CORSYS is a character string parameter identifying a */ -/* coordinate system. The recognized values of CORSYS */ -/* are declared in the INCLUDE file */ - -/* zzgf.inc */ - -/* RE Equatorial radius of a reference spheroid. This */ -/* spheroid is a volume of revolution: its */ -/* horizontal cross sections are circular. The shape */ -/* of the spheroid is defined by an equatorial radius */ -/* RE and a polar radius RP. */ - -/* F Flattening coefficient = (RE-RP) / RE, where RP */ -/* is the polar radius of the spheroid. */ - -/* SENSE is an integer indicating the sense of longitude */ -/* for planetographic coordinate systems. A value of */ -/* +1 indicates positive East; a value of -1 indicates */ -/* positive West. */ - -/* $ Detailed_Output */ - -/* CDSIGN is an array of three integers indicating signs of */ -/* the derivatives with respect to time of each */ -/* coordinate, where the coordinates are determined */ -/* by the input state and coordinate system. The */ -/* elements of CDSIGN are -1, 0, or 1: these indicate */ -/* negative, zero, or positive derivatives, */ -/* respectively. The relationship between elements of */ -/* CDSIGN and coordinates is given by the coordinate */ -/* orders used in the RECxxx coordinate conversion */ -/* routines. Those orders are shown in the table */ -/* below. */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input argument SENSE has a value other than -1 or 1, */ -/* and the coordinate system is planetographic, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. For other coordinate */ -/* systems, this argument is ignored. */ - -/* 2) If the input coordinate system specifier is not recognized, */ -/* the error SPICE(NOTSUPPORTED) is signaled. */ - -/* 3) If the coordinate system is geodetic or planetographic, */ -/* invalid ellipsoid shape parameters will be diagnosed by */ -/* routines in the call tree of this routine. For other */ -/* coordinate systems, these arguments are ignored. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* In order to conduct searches involving constraints on the */ -/* coordinates of a position vector, the GF system requires the */ -/* signs of the derivatives with respect to time of the coordinates */ -/* referenced in the constraints. The most direct way to obtain */ -/* these signs is to convert the Cartesian velocity to the */ -/* coordinate system of interest using the SPICE Jacobian matrix */ -/* routines; however, that technique has the drawback of being */ -/* unusable at or near singularities of the mapping from rectangular */ -/* coordinates to any non-rectangular coordinate system. */ - -/* This routine avoids problems with singularities by determining */ -/* signs of coordinate derivatives without computing the */ -/* (problematic) derivatives themselves. Instead this routine uses */ -/* proxy functions that have the same signs, for a given set of */ -/* inputs, as the coordinate derivatives of interest, where those */ -/* derivatives are defined. In addition, this routine returns */ -/* derivative signs for any position, including those where Jacobian */ -/* matrices are undefined. This allows the GF system to handle cases */ -/* where the time derivative of one coordinate is defined but */ -/* unavailable from the Jacobian matrix routines because another */ -/* coordinate is undefined or not differentiable at the same */ -/* position. */ - -/* Below, we discuss the proxy functions used by this routine. */ - - -/* Non-singular case */ -/* ================= */ - -/* For positions off the Z-axis, all of the rectangular-to-alternate */ -/* coordinate transformation Jacobian matrices are defined in */ -/* principle. These matrices may not be computable in practice */ -/* because the derivative with respect to time of longitude can */ -/* overflow. */ - -/* Our solution is to transform the input Cartesian velocity to a */ -/* "modified radial, tangential, normal" (MRTN) reference */ -/* frame: the basis vectors of this frame point "up", "East," and */ -/* "North." For geodetic and planetographic coordinate systems, the */ -/* "up" direction points along the outward normal of the reference */ -/* ellipsoid defined by the input parameters RE and F; in other */ -/* words, "up" is the direction of increasing altitude. For */ -/* cylindrical coordinates, "up" is the radial direction and "North" */ -/* is the +Z direction. */ - -/* For the other latitudinal systems, the "up" direction points in */ -/* the direction of increasing radius; the up direction is parallel */ -/* to the position component of the input state. */ - -/* The basis vectors of the MRTN frame lose precision for positions */ -/* very close to the Z-axis, but there are no problems with division */ -/* by zero or arithmetic overflow. */ - -/* The MRTN frame velocity indicates the signs of the coordinate */ -/* derivatives as follows: */ - -/* - Longitude: the sign of the rate of change of positive East */ -/* longitude is equal to the sign of the East component of */ -/* the MRTN velocity. */ - -/* For planetographic coordinate systems, the sign is adjusted */ -/* as needed to account for the sense of positive longitude. */ -/* The caller passes in a "longitude sense" indicator, allowing */ -/* the GF system to determine this sense once per search at */ -/* search initialization time. */ - -/* - Latitude: the sign of the rate of change of planetocentric */ -/* latitude is equal to the sign of the North component of */ -/* the MRTN velocity. */ - -/* - Co-latitude: the sign of the rate of change of */ -/* planetocentric latitude is equal to the negative of the sign */ -/* of the North component of the MRTN velocity. */ - -/* - Radius or altitude: the sign of the rate of change of */ -/* these coordinates is equal to sign of the up component of */ -/* the MRTN velocity. */ - - -/* Singular cases */ -/* ============== */ - -/* When the position lies on the Z-axis, some or all of the */ -/* derivatives of the coordinates with respect to Cartesian */ -/* coordinates may not exist. This routine assigns all such */ -/* derivatives a sign of zero. Other derivatives, such as */ -/* those of radius or altitude, may exist. */ - -/* Below we summarize the treatment of the singular cases. */ -/* We assume the input velocity is non-zero, and we omit */ -/* the case of rectangular coordinates. */ - -/* Coordinate Derivative Sign */ -/* --------------------- ---- */ -/* Longitude (all systems) 0 */ -/* Right ascension 0 */ -/* Latitude (all systems) 0 */ -/* Declination 0 */ -/* Co-latitude 0 */ - -/* Non-cylindrical radius, altitude { 0 if position is at */ -/* origin */ - -/* 1 if dot product of */ -/* velocity and position */ -/* is positive */ - -/* -1 if dot product of */ -/* velocity and position */ -/* is negative } */ - -/* Cylindrical radius 0 */ - -/* Z { 1 if velocity Z-component */ -/* is positive */ - -/* 0 if velocity Z-component */ -/* is zero */ - -/* -1 if velocity Z-component */ -/* is negative } */ - - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] ANSI Fortran 77 Standard, p. 15-23. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-APR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* coordinate derivative proxy */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - -/* Internally, we're going to use the more */ -/* descriptive names EAST for the "tangential" */ -/* direction and NORTH for the "normal" direction. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCPRX", (ftnlen)8); - -/* For planetographic coordinates, check the longitude sense. */ - - if (s_cmp(corsys, "PLANETOGRAPHIC", corsys_len, (ftnlen)14) == 0) { - if (*sense != 1 && *sense != -1) { - setmsg_("Longitude sense # should be 1 or -1.", (ftnlen)36); - errint_("#", sense, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; - } - } - -/* If we have a zero velocity vector, just indicate that each */ -/* velocity coordinate isn't changing and return now. If the */ -/* velocity vector is non-zero, convert it to a unit vector; this */ -/* guarantees that overflow can't occur. */ - if (vzero_(&state[3])) { - -/* The velocity is zero. Indicate that the coordinates are */ -/* not changing and return. Returning now simplifies the */ -/* logic of the rest of the routine, since the case of */ -/* zero-velocity can be ignored. */ - - cleari_(&c__3, cdsign); - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; - } else { - vhat_(&state[3], vel); - } - -/* The rectangular case is trivial; handle it now. */ - - if (s_cmp(corsys, "RECTANGULAR", corsys_len, (ftnlen)11) == 0) { - -/* The output system is rectangular. Just indicate the */ -/* signs of the input velocity. */ - - for (i__ = 1; i__ <= 3; ++i__) { - if (vel[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vel", - i__1, "zzgfcprx_", (ftnlen)398)] == 0.) { - cdsign[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "cdsign", i__1, "zzgfcprx_", (ftnlen)400)] = 0; - } else { - -/* Use the Fortran sign transfer intrinsic function */ -/* to set CDSIGN(I) to 1 or -1, depending */ -/* on whether the corresponding velocity component */ -/* is positive or negative. See reference [1] for a */ -/* discussion of this Fortran intrinsic function. */ - - d__1 = d_sign(&c_b15, &vel[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("vel", i__2, "zzgfcprx_", (ftnlen)410)] - ); - cdsign[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "cdsign", i__1, "zzgfcprx_", (ftnlen)410)] = i_dnnt(& - d__1); - } - } - -/* All done. */ - - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; - } - -/* There's quite a bit of common logic for the "on Z-axis" case; */ -/* take care of it here. */ - - if (state[0] == 0. && state[1] == 0.) { - -/* The position lies on the Z-axis. */ - -/* For all of the coordinate systems having a longitude */ -/* coordinate (this includes right ascension), the derivative of */ -/* longitude with respect to time is undefined; we set the sign */ -/* of the derivative to zero. */ - -/* For all of the coordinate systems having a latitude coordinate */ -/* (this includes declination), if the position is not at the */ -/* origin, the derivative of latitude with respect to time is */ -/* undefined unless the input velocity is zero. At the origin, */ -/* the derivative of latitude with respect to time doesn't exist. */ -/* In both cases, we set the sign of the velocity components */ -/* to zero. */ - -/* For the coordinate systems that have a radius or range */ -/* coordinate, where distance is measured from the origin, when */ -/* the input position is not at the origin, distance is */ -/* increasing, constant, or decreasing depending on whether the */ -/* dot product of velocity and the position's Z-coordinate is */ -/* positive, zero, or negative, respectively. This dot product */ -/* test is valid for the derivative of altitude as well (we */ -/* assert this without proof for the case of positions inside */ -/* prolate spheroids). */ - -/* If the position is at the origin, then since range and */ -/* altitude are not differentiable, their signs are set to */ -/* zero. */ - -/* Cylindrical coordinates are a special case which we treat */ -/* separately. */ - - if (state[2] != 0.) { - -/* The position is on the Z-axis but not at the origin. */ - -/* Compute the dot product used for the range/altitude */ -/* derivative. */ - - dp = vdot_(state, vel); - if (dp == 0.) { - dpsign = 0; - } else { - d__1 = d_sign(&c_b15, &dp); - dpsign = i_dnnt(&d__1); - } - } else { - -/* The position is at the origin. We know the velocity */ -/* is non-zero, and any movement increases radius or */ -/* altitude. However, neither radius nor altitude are */ -/* differentiable here, so we indicate no sign. */ - - dpsign = 0; - } - -/* Set the coordinate derivative signs for all but the */ -/* rectangular system, which was handled already, and */ -/* the cylindrical system. */ - - -/* Recall the coordinate systems and their coordinate orders: */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - - - if (s_cmp(corsys, "LATITUDINAL", corsys_len, (ftnlen)11) == 0) { - -/* The radial derivative sign was computed; the */ -/* other derivative signs are set to zero. */ - - cdsign[0] = dpsign; - cdsign[1] = 0; - cdsign[2] = 0; - } else if (s_cmp(corsys, "SPHERICAL", corsys_len, (ftnlen)9) == 0) { - -/* The radial derivative sign was computed; the */ -/* longitude derivative signs is set to zero. */ - - cdsign[0] = dpsign; - cdsign[2] = 0; - -/* Co-latitude is a special case. Co-latitude is */ -/* not differentiable with respect to Cartesian */ -/* position for positions on the Z-axis, since */ -/* co-latitude is a v-shaped function of distance */ -/* from the Z-axis. We simply set the sign */ -/* of the co-latitude derivative to zero in this */ -/* case. */ - - cdsign[1] = 0; - } else if (s_cmp(corsys, "RA/DEC", corsys_len, (ftnlen)6) == 0) { - -/* RA/Dec derivatives are assigned in the same manner */ -/* as latitudinal ones. */ - - cdsign[0] = dpsign; - cdsign[1] = 0; - cdsign[2] = 0; - } else if (s_cmp(corsys, "GEODETIC", corsys_len, (ftnlen)8) == 0) { - -/* Altitude plays the role of radius for this */ -/* system. */ - - cdsign[0] = 0; - cdsign[1] = 0; - cdsign[2] = dpsign; - } else if (s_cmp(corsys, "PLANETOGRAPHIC", corsys_len, (ftnlen)14) == - 0) { - -/* Altitude plays the role of radius for this */ -/* system. */ - - cdsign[0] = 0; - cdsign[1] = 0; - cdsign[2] = dpsign; - } else if (s_cmp(corsys, "CYLINDRICAL", corsys_len, (ftnlen)11) == 0) - { - cdsign[0] = 0; - cdsign[1] = 0; - -/* For cylindrical coordinates, the derivative of Z with */ -/* respect to time is already present in VEL. */ - - if (vel[2] == 0.) { - cdsign[2] = 0; - } else { - d__1 = d_sign(&c_b15, &vel[2]); - cdsign[2] = i_dnnt(&d__1); - } - } else { - -/* If we end up here, we have an invalid coordinate system. */ - - setmsg_("Coordinate system # is not supported. Verify that the c" - "oordinate system specifier matches a value from zzgf.inc." - , (ftnlen)112); - errch_("#", corsys, (ftnlen)1, corsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; - } - -/* We've handled the on-Z-axis cases. Return now. */ - - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; - } - -/* This is the normal case: the position is not on the Z-axis. */ - -/* The type of MRTN frame we use depends on the coordinate system. */ -/* Planetodetic and planetographic coordinate systems are a special */ -/* case. */ - - if (s_cmp(corsys, "GEODETIC", corsys_len, (ftnlen)8) == 0 || s_cmp(corsys, - "PLANETOGRAPHIC", corsys_len, (ftnlen)14) == 0) { - -/* Instead of defining the MRTN frame using the input */ -/* position vector, we define it using an outward normal vector */ -/* on the reference ellipsoid at the geodetic latitude */ -/* and longitude of the input position. */ - - recgeo_(state, re, f, &lon, &lat, &alt); - latrec_(&c_b15, &lon, &lat, normal); - } else if (s_cmp(corsys, "CYLINDRICAL", corsys_len, (ftnlen)11) == 0) { - -/* The normal vector is aligned with the local radial */ -/* direction; this vector is parallel to the X-Y plane. */ - - vpack_(state, &state[1], &c_b38, normal); - vhatip_(normal); - } else { - -/* The position vector provides the normal direction. */ - - vhat_(state, normal); - } -/* Obtain the matrix required to transform the velocity to the MRTN */ -/* frame; transform the velocity. */ - - zzrtnmat_(normal, xmat); - mxv_(xmat, vel, rtnvel); - -/* We can think of the basis vectors of the MRTN frame as local "up", */ -/* "East," "North" directions. Compute the signs of the up, East, */ -/* and North velocity components. */ - - for (i__ = 1; i__ <= 3; ++i__) { - if (rtnvel[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rtnvel", - i__1, "zzgfcprx_", (ftnlen)649)] == 0.) { - rtnsgn[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rtnsgn", - i__1, "zzgfcprx_", (ftnlen)651)] = 0; - } else { - d__1 = d_sign(&c_b15, &rtnvel[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? - i__2 : s_rnge("rtnvel", i__2, "zzgfcprx_", (ftnlen)653)]); - rtnsgn[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rtnsgn", - i__1, "zzgfcprx_", (ftnlen)653)] = i_dnnt(&d__1); - } - } - -/* Set the signs of the coordinate derivatives from the MRTN */ -/* derivative signs. */ - - -/* Recall the coordinate systems and their coordinate orders: */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - - - if (s_cmp(corsys, "LATITUDINAL", corsys_len, (ftnlen)11) == 0) { - cdsign[0] = rtnsgn[0]; - cdsign[1] = rtnsgn[1]; - cdsign[2] = rtnsgn[2]; - } else if (s_cmp(corsys, "SPHERICAL", corsys_len, (ftnlen)9) == 0) { - -/* For spherical coordinate systems, the sign of the */ -/* derivative of co-latitude is the negative of the */ -/* sign of the North derivative. */ - - cdsign[0] = rtnsgn[0]; - cdsign[1] = -rtnsgn[2]; - cdsign[2] = rtnsgn[1]; - } else if (s_cmp(corsys, "RA/DEC", corsys_len, (ftnlen)6) == 0) { - cdsign[0] = rtnsgn[0]; - cdsign[1] = rtnsgn[1]; - cdsign[2] = rtnsgn[2]; - } else if (s_cmp(corsys, "GEODETIC", corsys_len, (ftnlen)8) == 0) { - cdsign[0] = rtnsgn[1]; - cdsign[1] = rtnsgn[2]; - cdsign[2] = rtnsgn[0]; - } else if (s_cmp(corsys, "PLANETOGRAPHIC", corsys_len, (ftnlen)14) == 0) { - -/* For planetographic coordinates, altitude and latitude */ -/* behave identically to their geodetic counterparts. We */ -/* need to adjust the sign of the longitude derivative */ -/* according to whether longitude is positive East or West. */ - - cdsign[0] = rtnsgn[1] * *sense; - cdsign[1] = rtnsgn[2]; - cdsign[2] = rtnsgn[0]; - } else if (s_cmp(corsys, "CYLINDRICAL", corsys_len, (ftnlen)11) == 0) { - cdsign[0] = rtnsgn[0]; - cdsign[1] = rtnsgn[1]; - cdsign[2] = rtnsgn[2]; - } else { - -/* If we end up here, we have an invalid coordinate system. */ - - setmsg_("Coordinate system # is not supported. Verify that the coord" - "inate system specifier matches a value from zzgf.inc.", ( - ftnlen)112); - errch_("#", corsys, (ftnlen)1, corsys_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; - } - chkout_("ZZGFCPRX", (ftnlen)8); - return 0; -} /* zzgfcprx_ */ - diff --git a/ext/spice/src/cspice/zzgfcslv.c b/ext/spice/src/cspice/zzgfcslv.c deleted file mode 100644 index 6ee6fb8003..0000000000 --- a/ext/spice/src/cspice/zzgfcslv.c +++ /dev/null @@ -1,1400 +0,0 @@ -/* zzgfcslv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__7 = 7; -static integer c__0 = 0; -static integer c__1 = 1; -static logical c_false = FALSE_; -static doublereal c_b36 = 0.; -static doublereal c_b37 = 1e-6; - -/* $Procedure ZZGFCSLV ( GF, coordinate solver ) */ -/* Subroutine */ int zzgfcslv_(char *vecdef, char *method, char *target, char - *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char * - crdsys, char *crdnam, char *relate, doublereal *refval, doublereal * - tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, S_fp - udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, integer - *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal * - result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, - ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, - ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len) -{ - /* Initialized data */ - - static char cnames[6*7] = "> " "= " "< " "ABSMAX" "ABSMIN" - "LOCMAX" "LOCMIN"; - static char rptpre[55*3] = "Coordinate pass 1 of # " - " " "Coordinate pass 2 of # " - " " "Intercept existence pass 1 of 1 "; - static char rptsuf[13*3] = "done. " "done. " "done. " - ; - - /* System generated locals */ - integer work_dim1, work_dim2, work_offset, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzgfcodc_(); - extern /* Subroutine */ int zzgfcoin_(char *, char *, char *, char *, - char *, char *, char *, doublereal *, char *, char *, doublereal * - , ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, - ftnlen); - extern /* Subroutine */ int zzgfcoex_(); - extern /* Subroutine */ int zzgflong_(char *, char *, char *, char *, - char *, char *, char *, doublereal *, char *, char *, char *, - doublereal *, doublereal *, doublereal *, U_fp, U_fp, logical *, - S_fp, U_fp, S_fp, logical *, L_fp, integer *, integer *, - doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int zzgfcolt_(), zzgfcour_(); - extern /* Subroutine */ int zzgfsolv_(U_fp, U_fp, U_fp, logical *, L_fp, - logical *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, doublereal *); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - doublereal excon; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), copyd_( - doublereal *, doublereal *), repmi_(char *, char *, integer *, - char *, ftnlen, ftnlen, ftnlen); - integer npass; - doublereal start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - wncard_(doublereal *); - extern logical return_(void); - char loccrd[80], locvdf[80], prebuf[55*3]; - doublereal finish; - logical localx, noadjx; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssized_(integer *, doublereal *), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen), wnfetd_( - doublereal *, integer *, doublereal *, doublereal *), wncond_( - doublereal *, doublereal *, doublereal *); - integer loc; - char uop[6]; - extern /* Subroutine */ int zzgfcog_(); - extern /* Subroutine */ int zzgfrel_(U_fp, U_fp, U_fp, U_fp, U_fp, U_fp, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - integer *, integer *, doublereal *, logical *, S_fp, U_fp, S_fp, - char *, char *, logical *, L_fp, doublereal *, ftnlen, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Perform a coordinate search. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* ROOT */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P Cell lower bound. */ -/* CNVTOL P Convergence tolerance for existence window. */ -/* CNTRCT P Existence window contraction magnitude. */ -/* VECDEF I Vector definition. */ -/* METHOD I Computation method. */ -/* TARGET I Target name. */ -/* REF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Observer name. */ -/* DREF I Ray's direction vector frame. */ -/* DVEC I Ray's direction vector. */ -/* CRDSYS I Coordinate system name. */ -/* CRDNAM I Coordinate name. */ -/* RELATE I Relational operator. */ -/* REFVAL I Reference value. */ -/* TOL I Convergence tolerance. */ -/* ADJUST I Absolute extremum adjustment value. */ -/* UDSTEP I Step size routine. */ -/* UDREFN I Search refinement routine. */ -/* RPT I Progress report flag. */ -/* UDREPI I Progress report initialization routine. */ -/* UDREPU I Progress report update routine. */ -/* UDREPF I Progress report termination routine. */ -/* BAIL I Bail-out flag. */ -/* UDBAIL I Bail-out status function. */ -/* MW I Workspace window size. */ -/* NW I Workspace window count. */ -/* WORK I-O Workspace window array. */ -/* CNFINE I Confinement window. */ -/* RESULT O Result window. */ - -/* $ Detailed_Input */ - - -/* VECDEF Every coordinate computed by this routine is a */ -/* function of an underlying vector. VECDEF is a short */ -/* string describing the means by which the vector of */ -/* interest is defined. Only parameters from the Fortran */ -/* INCLUDE file zzgf.inc should be used. Parameter names */ -/* and meanings are: */ - -/* POSDEF Vector is position of */ -/* target relative to observer. */ - -/* SOBDEF Vector is sub-observer */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* SINDEF Vector is ray-surface intercept */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string VECDEF. */ - - -/* METHOD is a string specifying the computational method */ -/* applicable to the vector of interest. When VECDEF */ -/* is the parameter */ - -/* SOBDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SUBPNT. */ - -/* When VECDEF is the parameter */ - -/* SINDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SINCPT. */ - -/* METHOD is ignored if VECDEF is set to */ - -/* POSDEF */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string METHOD. */ - - -/* TARGET is the name of the target object. */ - - -/* REF is the name of the reference frame relative to which */ -/* the vector of interest is specified. The specified */ -/* condition applies to the specified coordinate of */ -/* of this vector in frame REF. */ - -/* When geodetic coordinates are used, the reference */ -/* ellipsoid is assumed to be that associated with */ -/* the central body of the frame designated by REF. */ -/* In this case, the central body of the frame must */ -/* be an extended body. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only. */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the observer. */ - - -/* DREF is the name of the reference frame relative to which a */ -/* ray's direction vector is expressed. This may be any */ -/* frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and leading */ -/* and trailing blanks in DREF are not significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the frame's */ -/* center is located elsewhere, then letting LTCENT be */ -/* the one-way light time between the observer and the */ -/* central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* CRDSYS is the name of the coordinate system to which the */ -/* coordinate of interest belongs. Allowed values are */ -/* those defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* Note that when geodetic coordinates are used, the */ -/* reference ellipsoid is that associated with the */ -/* central body of the reference frame designated by REF. */ -/* The central body must be an extended body in this */ -/* case. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string CRDSYS. */ - - -/* CRDNAM is the name of the coordinate of interest: this is */ -/* the coordinate to which the specified condition */ -/* applies. The set of coordinate names is a function of */ -/* the coordinate system. Allowed values are those */ -/* defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string CRDNAM. */ - - -/* RELATE is a relational operator used to define a constraint */ -/* on the specified coordinate. The result window found */ -/* by this routine indicates the time intervals where */ -/* the constraint is satisfied. Supported values of */ -/* RELATE and corresponding meanings are shown below: */ - -/* '>' Coordinate is greater than the reference */ -/* value REFVAL. */ - -/* '=' Coordinate is equal to the reference */ -/* value REFVAL. */ - -/* '<' Coordinate is less than the reference */ -/* value REFVAL. */ - - -/* 'ABSMAX' Coordinate is at an absolute maximum. */ - -/* 'ABSMIN' Coordinate is at an absolute minimum. */ - -/* 'LOCMAX' Coordinate is at a local maximum. */ - -/* 'LOCMIN' Coordinate is at a local minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the coordinate is */ -/* within a specified tolerance of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this tolerance. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* Case is not significant in the string RELATE. */ - - -/* REFVAL is the reference value used to define equality or */ -/* inequality conditions. */ - -/* If the coordinate has the dimension "length," then */ -/* REFVAL has units of kilometers. */ - -/* If the coordinate has the dimension "angle," then */ -/* REFVAL has units of radians. */ - -/* When the coordinate of interest is longitude, REFVAL */ -/* is interpreted as though it were translated, if */ -/* necessary, by an integer multiple of 2*pi to place it */ -/* in the standard range for longitude: (-pi, pi]. */ -/* Similarly, when the coordinate of interest is right */ -/* ascension, REFVAL is interpreted as though it were */ -/* translated, if necessary, by an integer multiple of */ -/* 2*pi into the range [0, 2*pi). */ - -/* Example: suppose REFVAL is set to -4.5. Then the */ -/* condition */ - -/* longitude equals REFVAL */ - -/* is interpreted as */ - -/* longitude equals -0.5 * pi */ - -/* so the solution window for this condition may well */ -/* be non-empty. */ - -/* REFVAL is ignored if RELATE is not an equality or */ -/* inequality operator. */ - - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in TDB */ -/* seconds and is greater than zero. */ - - -/* ADJUST The amount by which the coordinate is allowed to vary */ -/* from an absolute extremum. ADJUST is not used for */ -/* equality or inequality conditions. ADJUST must not be */ -/* negative. */ - -/* If ADJUST is positive and a search for an absolute */ -/* minimum is performed, the resulting schedule contains */ -/* time intervals when the specified coordinate has */ -/* values between ABSMIN and ABSMIN + ADJUST. */ - -/* If the search is for an absolute maximum, the */ -/* corresponding range is between ABSMAX - ADJUST and */ -/* ABSMAX. */ - - -/* UDSTEP is a routine that computes a time step used to search */ -/* for a transition of the state of the specified */ -/* coordinate. In the context of this routine's */ -/* algorithm, a "state transition" occurs where the */ -/* coordinate's time derivative changes from negative to */ -/* non-negative or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. ET is a DOUBLE PRECISION number. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. STEP is a DOUBLE */ -/* PRECISION number. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine GFSTEP */ -/* may be used. GFSTEP returns the step size that was set */ -/* via the most recent call to GFSSTP. */ - - -/* UDREFN is the name of the externally specified routine that */ -/* computes a refinement in the times that bracket a */ -/* transition point. In other words, once a pair of */ -/* times have been detected such that the system is in */ -/* different states at each of the two times, UDREFN */ -/* selects an intermediate time which should be closer to */ -/* the transition state than one of the two known times. */ -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 is a time when the system is in state S1. T1 */ -/* is a DOUBLE PRECISION number. */ - -/* T2 is a time when the system is in state S2. T2 */ -/* is a DOUBLE PRECISION number and is assumed */ -/* to be larger than T1. */ - -/* S1 is the state of the system at time T1. */ -/* S1 is a LOGICAL value. */ - -/* S2 is the state of the system at time T2. */ -/* S2 is a LOGICAL value. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T is next time to check for a state transition. */ -/* T is a DOUBLE PRECISION number between T1 and */ -/* T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. This is the default option. */ - - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is on or off; setting RPT */ -/* to .TRUE. enables progress reporting. */ - - -/* UDREPI is a user-defined subroutine that initializes a */ -/* progress report. When progress reporting is */ -/* enabled, UDREPI is called at the start of a search */ -/* pass (see the implementation of ZZGFREL for details on */ -/* search passes). The calling sequence of UDREPI is */ - -/* UDREPI ( CNFINE, RPTPRE, RPTSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) RPTPRE */ -/* CHARACTER*(*) RPTSUF */ - -/* where */ - -/* CNFINE */ - -/* is the confinement window passed into ZZGFREL, and */ - -/* RPTPRE */ -/* RPTSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. */ - -/* SPICELIB provides the default progress reporting */ -/* initialization routine GFREPI. If GFREPI is used, then */ -/* the progress reporting update and termination routines */ -/* GFREPU and GFREPF must be used as well. */ - - -/* UDREPU is a user-defined subroutine that updates the */ -/* progress report for a search pass. The calling */ -/* sequence of UDREPU is */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the search's */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - - -/* UDREPF is a user-defined subroutine that finalizes a */ -/* progress report. UDREPF has no arguments. */ - - -/* BAIL is a logical flag indicating whether or not interrupt */ -/* signal handling is enabled. Setting BAIL to .TRUE. */ -/* enables interrupt signal handling: the GF system will */ -/* then call UDBAIL to check for interrupt signals. */ - - -/* UDBAIL is the name of a user defined logical function that */ -/* checks to see whether an interrupt signal has been */ -/* issued from, e.g. the keyboard. UDBAIL is used only */ -/* when BAIL is set to .TRUE. If interrupt handling is */ -/* not used, the SPICELIB function GFBAIL should be */ -/* passed in as the actual bail-out function argument. */ - - -/* MW is the cell size of the windows in the workspace array */ -/* WORK. */ - - -/* NW is the number of windows in the workspace array WORK. */ -/* NW must be at least as large as the parameter NWMAX. */ - - -/* WORK is an array used to store workspace windows. This */ -/* array has dimensions ( LBCELL : MW, NW). */ - - -/* CNFINE is a SPICE window that confines the bounds of the */ -/* search. */ - -/* For coordinates defined by ray-target surface */ -/* intercepts, the effective confinement window is */ -/* obtained by searching for times within CNFINE when the */ -/* specified intercept and its derivative with respect to */ -/* time are computable. The window resulting from this */ -/* search is then contracted by CNTRCT+TOL seconds at */ -/* both left and right endpoints; this contracted window */ -/* is called the "existence window," since the surface */ -/* intercept and its time derivative are expected to be */ -/* computable on this contracted window. The user must */ -/* select CNFINE so that this requirement is met. */ - - -/* RESULT is an initialized SPICE window. RESULT must be large */ -/* enough to hold all of the intervals, within the */ -/* confinement window, on which the specified condition */ -/* is met. */ - -/* RESULT must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - - -/* $ Detailed_Output */ - -/* WORK has undefined contents on output. */ - - -/* RESULT is a SPICELIB window containing the intersection of */ -/* the confinement window and the set of time intervals */ -/* when the value of the specified coordinate satisfies */ -/* constraints specified by RELATE and ADJUST. */ - -/* For coordinates defined by ray-target surface */ -/* intercepts, RESULT is further restricted to the window */ -/* over which the intercept and its derivative with */ -/* respect to time are computable. See the description of */ -/* CNFINE above for details. */ - -/* $ Parameters */ - -/* LBCELL is the lower bound for SPICELIB cells. */ - -/* CNVTOL is the convergence tolerance used for determining the */ -/* existence window for surface intercept computations. */ - -/* CNTRCT is the contraction magnitude used to prepare the */ -/* "existence window" for use as a confinement window. */ -/* The existence window is applicable only to coordinates */ -/* of surface intercepts: it is the result of contracting */ -/* the window over which the surface intercept and its */ -/* time derivative are computable by CNTRCT+TOL. Units */ -/* are TDB seconds. */ - -/* $ Exceptions */ - -/* 1) If the workspace window count NW is less than NWMAX, the */ -/* error SPICE(TOOFEWWINDOWS) is signaled. */ - -/* 2) If the workspace window size MW is less than 2, the */ -/* error SPICE(WINDOWSTOOSMALL) is signaled. */ - -/* 3) If a workspace window or the result window is too small */ -/* to accommodate the required number of intervals, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 4) If either the observer or target names cannot be mapped */ -/* to ID codes, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 5) If the observer and target have the same ID codes, the */ -/* error will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* 6) If the vector definition VECDEF is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 7) If the computation method METHOD is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 8) If the aberration correction ABCORR is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 9) If the coordinate system name CRDSYS is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 10) If the coordinate name CRDNAM is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 11) If the frame REF is not recognized by the frames subsystem, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 12) If VECDEF calls for a computation involving a target surface */ -/* intercept point and the name and ID code of the frame DREF */ -/* associated with the target body are not available from the */ -/* frame subsystem, the error will be diagnosed by routines in */ -/* the call tree of this routine. */ - -/* 13) If VECDEF calls for a computation involving a target surface */ -/* intercept point and the direction vector DVEC is the zero */ -/* vector, the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* 14) If VECDEF calls for a computation involving a target surface */ -/* point and the radii defining the reference ellipsoid */ -/* associated with the target body are not available in the */ -/* kernel pool, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 15) If VECDEF calls for a computation involving a target surface */ -/* point and the frame REF is not centered on the target body, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 16) If geodetic or planetographic coordinates are used and the */ -/* radii defining the reference ellipsoid associated with the */ -/* center of the frame REF are not available in the kernel pool, */ -/* the error will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* 17) If geodetic or planetographic coordinates are used and the */ -/* first equatorial radius of the reference ellipsoid associated */ -/* with the center of the frame REF is zero, the error will be */ -/* diagnosed by routines in the call tree of this routine. */ - -/* 18) If geodetic or planetographic coordinates are used and the */ -/* equatorial radii of the reference ellipsoid associated */ -/* with the center of the frame REF are unequal, the error */ -/* SPICE(NOTSUPPORTED) is signaled. */ - -/* 19) If geodetic or planetographic coordinates are used and the */ -/* reference ellipsoid associated with the center of the frame */ -/* REF is degenerate (one or more radii are non-positive), */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 20) If ADJUST is negative, the error SPICE(VALUEOUTOFRANGE) */ -/* is signaled. */ - -/* 21) If TOL is non-positive, the error SPICE(VALUEOUTOFRANGE) */ -/* is signaled. */ - -/* 21) If RELATE is not a supported relational operator */ -/* specification, the error SPICE(NOTRECOGNIZED) is signaled. */ - -/* $ Files */ - -/* See the discussion in the Files section of the header of the */ -/* umbrella subroutine ZZGFCOU. */ - -/* $ Particulars */ - -/* This routine handles coordinate search set-up and execution */ -/* activities for GFEVNT. */ - -/* For a surface intercept coordinate search, this routine finds the */ -/* "existence window," within the input confinement window, for the */ -/* surface intercept and its time derivative. The existence window */ -/* is contracted by CNTRCT seconds; this contracted window is then */ -/* used as the confinement window for the search. */ - -/* $ Examples */ - -/* See GFEVNT and ZZGFLONG. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* 2) ZZGFCSLV must be called prior to use of any of the other */ -/* entry points. */ - -/* 3) This routine has the following couplings with other */ -/* SPICE routines: */ - -/* - The set of allowed aberration corrections must */ -/* be kept in sync with the set supported by the */ -/* SPK API routines. */ - -/* - The set of vector definitions must be kept in */ -/* sync with the set supported by GFEVNT. */ - -/* - The set of supported coordinate systems must be kept in */ -/* sync with the set supported by zzgf.inc. */ - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 06-MAR-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* coordinate search */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Number of supported comparison operators: */ - - -/* MAXOP is the maximum string length for comparison operators. */ -/* MAXOP may grow if new comparisons are added. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Below we initialize the list of comparison operator names. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_dim2 = *nw; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFCSLV", (ftnlen)8); - -/* Check the workspace window count. */ - - if (*nw < 15) { - setmsg_("Workspace window count was # but must be at least #.", ( - ftnlen)52); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(TOOFEWWINDOWS)", (ftnlen)20); - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* Check the workspace window size. The minimum size that */ -/* makes any sense is 2. */ - - if (*mw < 2) { - setmsg_("Workspace window size was # but must be at least 2.", ( - ftnlen)51); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(WINDOWSTOOSMALL)", (ftnlen)22); - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* Make sure ADJUST is non-negative. */ - - if (*adjust < 0.) { - setmsg_("ADJUST was #; must be non-negative.", (ftnlen)35); - errdp_("#", adjust, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* Make sure TOL is positive. */ - - if (*tol <= 0.) { - setmsg_("TOL was #; must be positive.", (ftnlen)28); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* Make sure that the requested comparison operation is one we */ -/* recognize. */ - - ljust_(relate, uop, relate_len, (ftnlen)6); - ucase_(uop, uop, (ftnlen)6, (ftnlen)6); - loc = isrchc_(uop, &c__7, cnames, (ftnlen)6, (ftnlen)6); - if (loc == 0) { - setmsg_("The comparison operator, # is not recognized. Supported op" - "erators are: >,=,<,ABSMAX,ABSMIN,LOCMAX,LOCMIN.", (ftnlen)106) - ; - errch_("#", relate, (ftnlen)1, relate_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* Initialize the workspace windows. */ - - i__1 = *nw; - for (i__ = 1; i__ <= i__1; ++i__) { - ssized_(mw, &work[(i__2 = i__ * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", - i__2, "zzgfcslv_", (ftnlen)963)]); - } - -/* Initialize the result window. */ - - scardd_(&c__0, result); - -/* Create a left-justified, compressed copy of the */ -/* input vector definition method. */ - - ljust_(vecdef, locvdf, vecdef_len, (ftnlen)80); - cmprss_(" ", &c__1, locvdf, locvdf, (ftnlen)1, (ftnlen)80, (ftnlen)80); - ucase_(locvdf, locvdf, (ftnlen)80, (ftnlen)80); - -/* If the vector definition method is "surface intercept," */ -/* find the "existence window": the window over which */ -/* the intercept and its time derivative are computable. */ - - if (s_cmp(locvdf, "SURFACE INTERCEPT POINT", (ftnlen)80, (ftnlen)23) == 0) - { - -/* Initialize the search for the existence window. */ - - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - crdsys, crdnam, refval, vecdef_len, method_len, target_len, - ref_len, abcorr_len, obsrvr_len, dref_len, crdsys_len, - crdnam_len); - if (failed_()) { - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* This routine presumes that UDSTEP has been initialized, so we */ -/* don't attempt to reset the step. */ - -/* If progress reporting is enabled, initialize the progress */ -/* report for the existence window search. */ - - if (*rpt) { - (*udrepi)(cnfine, rptpre + 110, rptsuf + 26, (ftnlen)55, (ftnlen) - 13); - } - -/* ZZGFSOLV will add the result of each search to the workspace */ -/* window */ - -/* WORK(LBCELL,EXWIDX) */ - -/* Initialize this window. */ - - ssized_(mw, &work[(i__1 = work_dim1 * 13 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfcslv_", (ftnlen)1016)]); - -/* Search each interval of the confinement window. */ - - i__1 = wncard_(cnfine); - for (i__ = 1; i__ <= i__1; ++i__) { - wnfetd_(cnfine, &i__, &start, &finish); - zzgfsolv_((U_fp)zzgfcoex_, (U_fp)udstep, (U_fp)udrefn, bail, ( - L_fp)udbail, &c_false, &c_b36, &start, &finish, &c_b37, - rpt, (U_fp)udrepu, &work[(i__2 = work_dim1 * 13 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfcslv_", (ftnlen)1025)]); - if (failed_()) { - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - -/* If interrupt processing is enabled, check to see */ -/* whether an interrupt has occurred. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; - } - } - } - -/* If progress reporting is enabled, terminate the report */ -/* for this pass. */ - - if (*rpt) { - (*udrepf)(); - } - -/* For safety, contract the existence window. Store */ -/* the result in the workspace. */ - - excon = *tol + 1.; - wncond_(&excon, &excon, &work[(i__1 = work_dim1 * 13 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : - s_rnge("work", i__1, "zzgfcslv_", (ftnlen)1063)]); - } else { - -/* Simply copy the confinement window to the workspace. */ - - copyd_(cnfine, &work[(i__1 = work_dim1 * 13 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfcslv_", (ftnlen)1069)]); - } - -/* If progress reporting is enabled, set the report prefix array */ -/* according to the quantity and the relational operator. */ - - if (*rpt) { - -/* We'll use the logical flag LOCALX to indicate a local extremum */ -/* operator and the flag NOADJX to indicate an absolut extremum */ -/* operator with zero adjustment. */ - - localx = s_cmp(uop, "LOCMIN", (ftnlen)6, (ftnlen)6) == 0 || s_cmp(uop, - "LOCMAX", (ftnlen)6, (ftnlen)6) == 0; - noadjx = *adjust == 0. && (s_cmp(uop, "ABSMIN", (ftnlen)6, (ftnlen)6) - == 0 || s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0); - if (localx || noadjx) { - -/* These operators correspond to 1-pass searches. */ - - npass = 1; - } else { - npass = 2; - } - -/* Fill in the prefix strings. */ - - i__1 = npass; - for (i__ = 1; i__ <= i__1; ++i__) { - repmi_(rptpre + ((i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : - s_rnge("rptpre", i__2, "zzgfcslv_", (ftnlen)1103)) * 55, - "#", &npass, prebuf + ((i__3 = i__ - 1) < 3 && 0 <= i__3 ? - i__3 : s_rnge("prebuf", i__3, "zzgfcslv_", (ftnlen)1103)) - * 55, (ftnlen)55, (ftnlen)1, (ftnlen)55); - } - } - -/* Create a left-justified, compressed, upper case copy of the */ -/* input coordinate name. */ - - ljust_(crdnam, loccrd, crdnam_len, (ftnlen)80); - cmprss_(" ", &c__1, loccrd, loccrd, (ftnlen)1, (ftnlen)80, (ftnlen)80); - ucase_(loccrd, loccrd, (ftnlen)80, (ftnlen)80); - -/* If the coordinate of interest is longitude or right ascension, we */ -/* have a special case, since the mapping from Cartesian to */ -/* latitudinal coordinates has a branch discontinuity. */ - - if (s_cmp(loccrd, "LONGITUDE", (ftnlen)80, (ftnlen)9) == 0 || s_cmp( - loccrd, "RIGHT ASCENSION", (ftnlen)80, (ftnlen)15) == 0) { - -/* The coordinate is longitude or right ascension. */ - - zzgflong_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - crdsys, crdnam, relate, refval, tol, adjust, (U_fp)udstep, ( - U_fp)udrefn, rpt, (S_fp)udrepi, (U_fp)udrepu, (S_fp)udrepf, - bail, (L_fp)udbail, mw, nw, work, &work[(i__1 = work_dim1 * - 13 - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 ? - i__1 : s_rnge("work", i__1, "zzgfcslv_", (ftnlen)1125)], - result, vecdef_len, method_len, target_len, ref_len, - abcorr_len, obsrvr_len, dref_len, crdsys_len, crdnam_len, - relate_len); - } else { - -/* This is the normal case. */ - -/* Initialize the coordinate quantity utilities. */ - - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - crdsys, crdnam, refval, vecdef_len, method_len, target_len, - ref_len, abcorr_len, obsrvr_len, dref_len, crdsys_len, - crdnam_len); - -/* Perform the search. */ - - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcodc_, (U_fp)zzgfcolt_, - (U_fp)zzgfcog_, (U_fp)zzgfcour_, relate, refval, tol, adjust, - &work[(i__1 = work_dim1 * 13 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfc" - "slv_", (ftnlen)1146)], mw, nw, work, rpt, (S_fp)udrepi, (U_fp) - udrepu, (S_fp)udrepf, prebuf, rptsuf, bail, (L_fp)udbail, - result, relate_len, (ftnlen)55, (ftnlen)13); - } - chkout_("ZZGFCSLV", (ftnlen)8); - return 0; -} /* zzgfcslv_ */ - diff --git a/ext/spice/src/cspice/zzgfdiq.c b/ext/spice/src/cspice/zzgfdiq.c deleted file mode 100644 index 20349178df..0000000000 --- a/ext/spice/src/cspice/zzgfdiq.c +++ /dev/null @@ -1,202 +0,0 @@ -/* zzgfdiq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGFDIQ ( GF, return distance between objects ) */ -/* Subroutine */ int zzgfdiq_(integer *targid, doublereal *et, char *abcorr, - integer *obsid, doublereal *dist, ftnlen abcorr_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern doublereal vnorm_(doublereal *); - extern logical failed_(void); - doublereal lt; - extern /* Subroutine */ int chkout_(char *, ftnlen), spkezp_(integer *, - doublereal *, char *, char *, integer *, doublereal *, doublereal - *, ftnlen, ftnlen); - extern logical return_(void); - doublereal pos[3]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the distance between two ephemeris objects, optionally */ -/* corrected for light time and stellar aberration. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TARGID I Target body. */ -/* ET I Observer epoch. */ -/* ABCORR I Aberration correction flag. */ -/* OBSID I Observing body. */ -/* DIST O Distance between target and observer. */ - -/* $ Detailed_Input */ - -/* TARGID is the NAIF ID code for a target body. The target and */ -/* observer define a position vector that points from */ -/* the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET refers */ -/* to time at the observer's location. */ - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. Any */ -/* aberration correction accepted by SPKEZR may be used. */ - -/* $ Detailed_Output */ - -/* DIST is the norm (magnitude) of the specified Cartesian */ -/* 3-vector representing the position of the target body */ -/* relative to the specified observer, where the */ -/* position is corrected for the specified aberrations. */ -/* The position vector points from the observer's */ -/* location at ET to the aberration-corrected location */ -/* of the target. */ - -/* Units are km. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer for the */ -/* input epoch must be loaded. If aberration corrections are */ -/* used, the states of target and observer relative to the */ -/* solar system barycenter must be calculable from the */ -/* available ephemeris data. Typically ephemeris data are made */ -/* available by loading one or more SPK files via FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine centralizes distance computations performed by */ -/* entry points in the GF distance utility package ZZGFDIU. */ - -/* $ Examples */ - -/* See the entry point ZZGFDIGQ in ZZGFDIU. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* compute the apparent distance between two objects */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFDIQ", (ftnlen)7); - -/* Get the position of the target relative to the observer. */ - - spkezp_(targid, et, "J2000", abcorr, obsid, pos, <, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("ZZGFDIQ", (ftnlen)7); - return 0; - } - *dist = vnorm_(pos); - chkout_("ZZGFDIQ", (ftnlen)7); - return 0; -} /* zzgfdiq_ */ - diff --git a/ext/spice/src/cspice/zzgfdiu.c b/ext/spice/src/cspice/zzgfdiu.c deleted file mode 100644 index 6b0dfb19da..0000000000 --- a/ext/spice/src/cspice/zzgfdiu.c +++ /dev/null @@ -1,1167 +0,0 @@ -/* zzgfdiu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZGFDIU ( GF, distance utilities ) */ -/* Subroutine */ int zzgfdiu_0_(int n__, char *target, char *abcorr, char * - obsrvr, doublereal *refval, doublereal *et, logical *decres, logical * - lssthn, doublereal *dist, ftnlen target_len, ftnlen abcorr_len, - ftnlen obsrvr_len) -{ - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen); - doublereal r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical found; - doublereal state[6]; - static integer svobs; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen), bods2c_( - char *, integer *, logical *, ftnlen); - extern logical failed_(void); - doublereal lt; - logical attblk[15]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - static integer svtarg; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - static doublereal svrefv; - extern logical return_(void); - static char svcorr[5]; - extern /* Subroutine */ int zzgfdiq_(integer *, doublereal *, char *, - integer *, doublereal *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the umbrella routine for the entry points used by */ -/* GFEVNT in order to find distance events. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* TARGID I ZZGFDIIN */ -/* ABCORR I ZZGFDIIN */ -/* OBSID I ZZGFDIIN */ -/* REFVAL I ZZGFDIIN, ZZGFDIUR */ -/* ET I ZZGFDILT, ZZGFDIGQ */ -/* REF I ZZGFDIIN */ -/* DECRES O ZZGFDIDC */ -/* LSSTHN O ZZGFDILT */ -/* DIST O ZZGFDIGQ */ - -/* $ Detailed_Input */ - -/* See individual entry points. */ - -/* $ Detailed_Output */ - -/* See individual entry points. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* See individual entry points. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer, for the */ -/* times at which state or positions are computed, must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This is an umbrella for routines required by the GF scalar */ -/* quantity search algorithm to support searches involving */ -/* distance constraints. */ - -/* The entry points of this routine are: */ - -/* ZZGFDIIN Saves the user-supplied inputs defining the */ -/* distance computation to be performed. Initializes */ -/* the distance search. */ - -/* ZZGFDIUR Updates the reference value REFVAL. */ - -/* ZZGFDIDC Determines whether or not distance is decreasing */ -/* at a specified epoch. */ - -/* ZZGFDILT Determines whether or not distance is less than */ -/* REFVAL at a specified epoch. */ - -/* ZZGFDIGQ Returns the distance between the observer and target */ -/* at a specified epoch. */ - -/* $ Examples */ - -/* See GFEVNT. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* ZZGFDIIN must be called prior to use of any of the other */ -/* entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* umbrella routine for finding distance events */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* This routine should never be called directly. */ - - switch(n__) { - case 1: goto L_zzgfdiin; - case 2: goto L_zzgfdiur; - case 3: goto L_zzgfdidc; - case 4: goto L_zzgfdigq; - case 5: goto L_zzgfdilt; - } - - chkin_("ZZGFDIU", (ftnlen)7); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZGFDIU", (ftnlen)7); - return 0; -/* $Procedure ZZGFDIIN ( GF, distance utility initialization ) */ - -L_zzgfdiin: -/* $ Abstract */ - -/* Initialize the GF distance constraint search utilities. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* CHARACTER*(*) TARGET */ -/* CHARACTER*(*) ABCORR */ -/* CHARACTER*(*) OBSRVR */ -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TARGET I Target body name. */ -/* ABCORR I Aberration correction specifier. */ -/* OBSRVR I Observer name. */ -/* REFVAL I Reference value. */ - -/* $ Detailed_Input */ - -/* TARGET is the name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as */ -/* an integer string. For example both 'MOON' and */ -/* '301' are legitimate strings that indicate the */ -/* moon is the target body. */ - -/* The target and observer define a position vector */ -/* which points from the observer to the target. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TARGET. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the target's position and orientation. */ -/* Any value accepted by SPKEZR may be used. */ - -/* See the header of the SPICE routine SPKEZR for a */ -/* detailed description of the aberration correction */ -/* options. */ - -/* Case and embedded blanks are not significant in */ -/* ABCORR. */ - - -/* OBSRVR is the name of the body from which the occultation is */ -/* observed. Optionally, you may supply the integer NAIF */ -/* ID code for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* REFVAL is the reference value to be used in searches */ -/* involving equality or inequality conditions. REFVAL is */ -/* stored by this routine and used by the entry point */ -/* ZZGFDILT. */ - -/* REFVAL has units of km. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of the target or the observer cannot be translated */ -/* to a NAIF ID code, the error SPICE(IDCODENOTFOUND) is */ -/* signaled. */ - -/* 2) If target body coincides with the observer body OBSRVR, the */ -/* error SPICE(BODIESNOTDISTINCT) will be signaled. */ - -/* 3) If the aberration correction string is invalid, the error */ -/* will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFDIU. */ - -/* $ Particulars */ - -/* This routine must be called once before each GF search for */ -/* distance events. */ - -/* $ Examples */ - -/* See GFEVNT. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* distance initialization routine */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFDIIN", (ftnlen)8); - -/* Find NAIF IDs for TARGET and OBSRVR. */ - - bods2c_(target, &svtarg, &found, target_len); - if (! found) { - setmsg_("The target object, '#', is not a recognized name for an eph" - "emeris object. The cause of this problem may be that you nee" - "d an updated version of the SPICE Toolkit. ", (ftnlen)162); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFDIIN", (ftnlen)8); - return 0; - } - bods2c_(obsrvr, &svobs, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFDIIN", (ftnlen)8); - return 0; - } - -/* Make sure the observer and target are distinct. */ - - if (svtarg == svobs) { - setmsg_("The observer and target must be distinct objects, but are n" - "ot: OBSRVR = #; TARGET = #.", (ftnlen)86); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ZZGFDIIN", (ftnlen)8); - return 0; - } - -/* Squeeze all blanks out of the aberration correction */ -/* string; ensure the string is in upper case. */ - - cmprss_(" ", &c__0, abcorr, svcorr, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(svcorr, svcorr, (ftnlen)5, (ftnlen)5); - -/* Check the aberration correction. If SPKEZR can't handle it, */ -/* neither can we. */ - - zzvalcor_(svcorr, attblk, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFDIIN", (ftnlen)8); - return 0; - } - -/* Save the reference value. */ - - svrefv = *refval; - chkout_("ZZGFDIIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFDIUR ( GF, update distance reference value ) */ - -L_zzgfdiur: -/* $ Abstract */ - -/* Update the reference value for distance equality or */ -/* inequality searches. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* REFVAL I Value distances will be compared to. */ - -/* $ Detailed_Input */ - -/* REFVAL is a reference value used to define equality or */ -/* inequality relationships. For example, searches for */ -/* equality find time periods when the observer-target */ -/* distance is equal to REFVAL. */ - -/* Units are km. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFDIU. */ - -/* $ Particulars */ - -/* REFVAL is currently used by GFREL to establish reference */ -/* values for absolute extrema searches using non-zero */ -/* adjustment values. Since the reference value for such a */ -/* search is not known until the absolute extrema have */ -/* been found, the reference value cannot be set by a */ -/* call to the initialization entry point ZZGFDIIN. Instead, */ -/* GFREFL sets the value via a call to this entry point. */ - -/* $ Examples */ - -/* See GFREL. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* update distance reference value for gf search */ - -/* -& */ - svrefv = *refval; - return 0; -/* $Procedure ZZGFDIDC ( GF, is distance decreasing? ) */ - -L_zzgfdidc: -/* $ Abstract */ - -/* Indicate whether the observer-target distance is decreasing at a */ -/* specified time. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL DECRES */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* DECRES O Flag indicating whether distance is decreasing. */ - -/* $ Detailed_Input */ - -/* ET is the time, expressed as seconds past J2000 TDB, at */ -/* which to determine whether or not the distance between */ -/* the observer and target is decreasing. */ - -/* $ Detailed_Output */ - -/* DECRES is a logical flag that indicates whether the */ -/* observer-target distance is decreasing at ET. The */ -/* observer, target, and aberration correction used to */ -/* compute the distance are defined by the latest call to */ -/* the initialization entry point ZZGFDIIN. */ - -/* DECRES is .TRUE. if and only if the observer-target */ -/* distance is decreasing at ET. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the state of the target relative to the observer */ -/* at ET can not be found due to an SPK lookup failure, */ -/* the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFDIU. */ - -/* $ Particulars */ - -/* This routine is used by GFREL to determine the time intervals, */ -/* within the confinement window, on which the observer-target */ -/* distance is monotone increasing or monotone decreasing. */ - -/* $ Examples */ - -/* See GFREL. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* indicate whether distance is decreasing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFDIDC", (ftnlen)8); - spkez_(&svtarg, et, "J2000", svcorr, &svobs, state, <, (ftnlen)5, ( - ftnlen)5); - if (failed_()) { - chkout_("ZZGFDIDC", (ftnlen)8); - return 0; - } - -/* The observer-target distance is decreasing if and only */ -/* if the dot product of the velocity and position is */ -/* negative. */ - - *decres = vdot_(state, &state[3]) < 0.; - chkout_("ZZGFDIDC", (ftnlen)8); - return 0; -/* $Procedure ZZGFDIGQ ( GF, get observer-target distance ) */ - -L_zzgfdigq: -/* $ Abstract */ - -/* Return the distance between the target and observer */ -/* at a specified epoch. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION DIST */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* DIST O Distance at time ET. */ - -/* $ Detailed_Input */ - -/* ET is the time, expressed as seconds past J2000 TDB, at */ -/* which the distance between the observer and target is */ -/* to be computed. */ - -/* $ Detailed_Output */ - -/* DIST is the distance between the observer and target as */ -/* seen by the observer at time ET. The observer, target, */ -/* and aberration correction used to compute the distance */ -/* are defined by the latest call to the initialization */ -/* entry point ZZGFDIIN. */ - -/* Units are km. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the position of the target relative to the observer */ -/* at ET can not be found due to an SPK lookup failure, */ -/* the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFDIU. */ - -/* $ Particulars */ - -/* This routine determines the apparent distance between the target */ -/* and observer as seen from the observer at time ET. This */ -/* functionality supports GFREL's comparisons of relative extrema in */ -/* order to determine absolute extrema. */ - -/* $ Examples */ - -/* See GFREL. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* return distance between two bodies */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFDIGQ", (ftnlen)8); - zzgfdiq_(&svtarg, et, svcorr, &svobs, dist, (ftnlen)5); - chkout_("ZZGFDIGQ", (ftnlen)8); - return 0; -/* $Procedure ZZGFDILT ( GF, is distance less than reference value? ) */ - -L_zzgfdilt: -/* $ Abstract */ - -/* Indicate whether the distance between the target and observer at */ -/* a specified epoch is less than the current reference value. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* DISTANCE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL LSSTHN */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* LSSTHN O Flag indicating whether distance is less than */ -/* the reference value. */ - -/* $ Detailed_Input */ - -/* ET is the time, expressed as seconds past J2000 TDB, at */ -/* which to determine whether the distance between the */ -/* observer and target bodies is less than the reference */ -/* value. */ - -/* $ Detailed_Output */ - -/* LSSTHN is a logical flag that indicates whether the */ -/* observer-target distance is less than */ -/* the current reference value at ET. The */ -/* observer, target, and aberration correction used to */ -/* compute the distance are defined by the latest call to */ -/* the initialization entry point ZZGFDIIN. The */ -/* reference value is the latest one stored as */ -/* a result of a call to ZZGFDIIN or ZZGFDIUR. */ - -/* DECRES is .TRUE. if and only if the observer-target */ -/* distance is less than the reference value at ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the position of the target relative to the observer */ -/* at ET can not be found due to an SPK lookup failure, */ -/* the error will be diagnosed by routines in the call */ -/* tree of this routine. */ - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFDIU. */ - -/* $ Particulars */ - -/* This routine supports binary state searches for times when the */ -/* observer-target distance satisfies an equality or inequality */ -/* relationship with the current reference value. */ - -/* $ Examples */ - -/* See GFREL. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* distance less than some value */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFDIGQ", (ftnlen)8); - zzgfdiq_(&svtarg, et, svcorr, &svobs, &r__, (ftnlen)5); - -/* The returned logical flag indicates whether the observer-target */ -/* distance at ET is less than the saved reference value. */ - - *lssthn = r__ < svrefv; - chkout_("ZZGFDIGQ", (ftnlen)8); - return 0; -} /* zzgfdiu_ */ - -/* Subroutine */ int zzgfdiu_(char *target, char *abcorr, char *obsrvr, - doublereal *refval, doublereal *et, logical *decres, logical *lssthn, - doublereal *dist, ftnlen target_len, ftnlen abcorr_len, ftnlen - obsrvr_len) -{ - return zzgfdiu_0_(0, target, abcorr, obsrvr, refval, et, decres, lssthn, - dist, target_len, abcorr_len, obsrvr_len); - } - -/* Subroutine */ int zzgfdiin_(char *target, char *abcorr, char *obsrvr, - doublereal *refval, ftnlen target_len, ftnlen abcorr_len, ftnlen - obsrvr_len) -{ - return zzgfdiu_0_(1, target, abcorr, obsrvr, refval, (doublereal *)0, ( - logical *)0, (logical *)0, (doublereal *)0, target_len, - abcorr_len, obsrvr_len); - } - -/* Subroutine */ int zzgfdiur_(doublereal *refval) -{ - return zzgfdiu_0_(2, (char *)0, (char *)0, (char *)0, refval, (doublereal - *)0, (logical *)0, (logical *)0, (doublereal *)0, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfdidc_(doublereal *et, logical *decres) -{ - return zzgfdiu_0_(3, (char *)0, (char *)0, (char *)0, (doublereal *)0, et, - decres, (logical *)0, (doublereal *)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int zzgfdigq_(doublereal *et, doublereal *dist) -{ - return zzgfdiu_0_(4, (char *)0, (char *)0, (char *)0, (doublereal *)0, et, - (logical *)0, (logical *)0, dist, (ftnint)0, (ftnint)0, (ftnint) - 0); - } - -/* Subroutine */ int zzgfdilt_(doublereal *et, logical *lssthn) -{ - return zzgfdiu_0_(5, (char *)0, (char *)0, (char *)0, (doublereal *)0, et, - (logical *)0, lssthn, (doublereal *)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzgfdsps.c b/ext/spice/src/cspice/zzgfdsps.c deleted file mode 100644 index c8930037be..0000000000 --- a/ext/spice/src/cspice/zzgfdsps.c +++ /dev/null @@ -1,296 +0,0 @@ -/* - --Procedure zzgfdsps_ ( GF, display string ) - --Abstract - - SPICE Private routine intended solely for the support of SPICE - routines. Users should not call this routine directly due - to the volatile nature of this routine. - - Display a character string at a position at the first column on - the previous line on the screen. - - This is an overlay routine for the f2c'd routine zzgfdsps_. - --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 - - GF - --Keywords - - STRING - DISPLAY - CURSOR - POSITION - -*/ - - #include - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZst.h" - - int zzgfdsps_ ( integer * nlead, - char * string, - char * fmt, - integer * ntrail, - ftnlen stringLen, - ftnlen fmtLen ) - -/* - --Brief_I/O - - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - nlead I Number of leading blank lines to write. - string I The string to display. - fmt I Format in which the string is to be written. - ntrail I Number of trailing blank lines to write. - stringLen I Length of input argument `string'. - fmtLen I Length of input argument `fmt'. - --Detailed_Input - - nlead is the number of blank lines to write before - writing the output text string. - - string is a message to be displayed on the standard - output stream. This is a Fortran-style string - without a terminating null character. - - fmt is a Fortran format specification used to write - the output string. This is a Fortran-style string - without a terminating null character. - - FMT may be left to default ("A"), or may be used - to control the length of the string ("A10"). - - **NOTE**: this argument is provided only for - compatibility with the Fortran version of this - routine; the argument is currently ignored. - - ntrail is the number of blank lines to write after - writing the output text string. - - stringLen is the length of the input string `string'. - - fmtLen is the length of the input string `fmt'. - --Detailed_Output - - None. This program has no output arguments but writes to the - standard output stream. - --Parameters - - None. - --Exceptions - - 1) If an error occurs when this routine attempts to - allocate memory dynamically, the error will be - diagnosed by routines in the call tree of this routine. - - 2) If the either of the input arguments `nlead' or `ntrail' - is non-positive, then no leading or trailing blank - lines will be written, respectively. This case is not - considered an error. - --Files - - None. - --Particulars - - This is an overlay routine for the f2c'd routine zzgfdsps_; - as such, this routine has an f2c-style calling sequence. - - CSPICE GF routines should call this routine rather than - zzgfdsps_. - - Since ANSI C supports the cursor control capabilities required - for GF progress reporting, it's not necessary to rely on ANSI - control sequences to effect cursor control. - - This routine supports the default GF progress report display. - Output is written to the standard output stream; normally this - results in output on a terminal window. - - After the output line is written, this routine moves the cursor - up and to the first column, so a subsequent call will overwrite - output from the current call. - --Examples - - See calls made to this routine by the entry points of - zzgfrpwrk. - --Restrictions - - The input Fortran format argument is ignored. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 27-FEB-2009 (NJB) - --Index_Entries - - GF output progress report string - --& -*/ - -{ /* Begin zzgfdsps_ */ - - - /* - Local variables - */ - SpiceChar * CFmtPtr; - SpiceChar * CStringPtr; - - SpiceInt i; - SpiceInt nl; - SpiceInt nt; - SpiceInt outlen; - - - /* - Participate in error tracing. - */ - chkin_c ( "zzgfdsps_" ); - - /* - The input strings are Fortran-style; they're not - null-terminated. Convert these to C-style strings - so we can work with them. We'll need to use dynamic - memory to hold the C-style strings. - */ - F2C_CreateStr_Sig ( stringLen, string, &CStringPtr ); - - if ( failed_c() ) - { - /* - The CSPICE string utilities do their own clean-up of - allocated memory, so we won't attempt to free the - C string. - */ - chkout_c ( "zzgfdsps_" ); - - return (-1); - } - - F2C_CreateStr_Sig ( fmtLen, fmt, &CFmtPtr ); - - if ( failed_c() ) - { - /* - Failure at this point requires that we free the previous, - successfully allocated string. - */ - free ( CStringPtr ); - - chkout_c ( "zzgfdsps_" ); - - return(-1); - } - - /* - Display any blank lines indicated by `nlead'. - */ - - nl = *nlead; - nt = *ntrail; - - - for ( i = 0; i < nl; i++ ) - { - putc ( '\n', stdout ); - } - - /* - Save the length of the output string. - */ - outlen = strlen( CStringPtr ); - - /* - Write the string to standard output without a trailing newline - character. - */ - printf ( "%s", CStringPtr ); - - - /* - Force a write of any buffered, unwritten output data. - - Without this call, progress report updates may not be displayed in a - timely fashion. There can be a long pause, followed by an - announcement that the task is 100% done. This behavior rather - defeats the purpose of the report. - */ - fflush ( stdout ); - - /* - Back up the cursor to the start of the line. - */ - for ( i = 0; i < outlen; i++ ) - { - putc ( '\b', stdout ); - } - - /* - Display any blank lines indicated by `ntrail'. - */ - for ( i = 0; i < nt; i++ ) - { - putc ( '\n', stdout ); - } - - /* - Free the dynamically allocated strings. - */ - free ( CStringPtr ); - free ( CFmtPtr ); - - chkout_c ( "zzgfdsps_" ); - - return ( 0 ); - - -} /* End zzgfdsps_ */ diff --git a/ext/spice/src/cspice/zzgffvu.c b/ext/spice/src/cspice/zzgffvu.c deleted file mode 100644 index b8fb5e2aac..0000000000 --- a/ext/spice/src/cspice/zzgffvu.c +++ /dev/null @@ -1,2270 +0,0 @@ -/* zzgffvu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__30000 = 30000; -static integer c__3 = 3; -static integer c__20000 = 20000; -static integer c__9 = 9; -static integer c__4 = 4; -static integer c__10000 = 10000; -static doublereal c_b98 = 1.; -static doublereal c_b128 = 2.; - -/* $Procedure ZZGFFVU ( GF, instrument FOV utilities ) */ -/* Subroutine */ int zzgffvu_0_(int n__, char *inst, char *tshape, doublereal - *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, - doublereal *time, logical *vistat, ftnlen inst_len, ftnlen tshape_len, - ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen - obsrvr_len) -{ - /* Initialized data */ - - static doublereal svorig[3] = { 0.,0.,0. }; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - double pow_dd(doublereal *, doublereal *), sqrt(doublereal); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal limb[9]; - extern integer zzwind2d_(integer *, doublereal *, doublereal *); - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_( - doublereal *, doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *), mtxv_(doublereal *, - doublereal *, doublereal *), zzcorepc_(char *, doublereal *, - doublereal *, doublereal *, ftnlen); - doublereal pnt2d[3]; - extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen), - zzfovaxi_(char *, integer *, doublereal *, doublereal *, ftnlen); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal l; - integer n, w; - doublereal x[3], y[3], z__[3]; - extern /* Subroutine */ int frame_(doublereal *, doublereal *, doublereal - *), chkin_(char *, ftnlen), zzelvupy_(doublereal *, doublereal *, - doublereal *, integer *, doublereal *, logical *), ucase_(char *, - char *, ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - doublereal bsite[3], coord[2]; - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal stobs[6], vtemp[3], fovpt[3], m1[9] /* was [3][3] */; - extern doublereal vnorm_(doublereal *); - doublereal m2[9] /* was [3][3] */; - static integer svobs; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *); - integer nxpts; - extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen), - vrotv_(doublereal *, doublereal *, doublereal *, doublereal *), - el2cgv_(doublereal *, doublereal *, doublereal *, doublereal *), - cgv2el_(doublereal *, doublereal *, doublereal *, doublereal *), - nvc2pl_(doublereal *, doublereal *, doublereal *); - doublereal vtemp2[3]; - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *), edlimb_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - doublereal lt; - extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer - *, doublereal *, ftnlen); - integer framid; - extern doublereal halfpi_(void); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *); - doublereal fovrad[3], fvlimb[9]; - static char svinam[36]; - extern logical return_(void); - static char svifrm[32], svishp[9], svtfrm[32], svtnam[36], svtshp[9], - svcorr[5]; - doublereal ctrext, ettarg, insmat[9] /* was [3][3] */, obspos[3], - semipt[6] /* was [3][2] */; - static doublereal svarad, svbnds[30000] /* was [3][10000] */, svedct[ - 3], svfaxi[3], svfovm[9] /* was [3][3] */, svfpol[20000] /* - was [2][10000] */, svfsmx[9] /* was [3][3] */, svfvct[3], - svplan[4], svrdir[3], svsemi[6] /* was [3][2] */, svtrad[3], - svxmag[2]; - doublereal trgctr[3], trgsmx[9] /* was [3][3] */; - integer clssid, frcent, frclss, ocstat; - static integer svinst, svnvrt, svtarg; - logical attblk[15]; - static logical svuray, svustl, svxmit, svxtrg; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), namfrm_(char *, integer *, - ftnlen), frinfo_(integer *, integer *, integer *, integer *, - logical *); - doublereal dir[3]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), getfov_( - integer *, integer *, char *, char *, doublereal *, integer *, - doublereal *, ftnlen, ftnlen), inrypl_(doublereal *, doublereal *, - doublereal *, integer *, doublereal *), spkezp_(integer *, - doublereal *, char *, char *, integer *, doublereal *, doublereal - *, ftnlen, ftnlen), pxform_(char *, char *, doublereal *, - doublereal *, ftnlen, ftnlen), vminus_(doublereal *, doublereal *) - ; - extern doublereal dpr_(void); - doublereal sep; - extern /* Subroutine */ int spkssb_(integer *, doublereal *, char *, - doublereal *, ftnlen), stlabx_(doublereal *, doublereal *, - doublereal *); - doublereal pos[3]; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - , mxv_(doublereal *, doublereal *, doublereal *); - doublereal xpt[3]; - extern integer zzocced_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine contains the entry points that produce the */ -/* computations needed for solving for target visibility states */ -/* in the geometry finding routines. */ - -/* $ 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 */ - -/* CK */ -/* GF */ -/* IK */ -/* NAIF_IDS */ -/* PCK */ -/* SCLK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* EVENT */ -/* FOV */ -/* GEOMETRY */ -/* INSTRUMENT */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Abstract */ - -/* Declare ZZOCCED return code parameters, comparison strings */ -/* and other parameters. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* ELLIPSOID */ -/* GEOMETRY */ -/* GF */ -/* OCCULTATION */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-SEP-2005 (NJB) */ - -/* -& */ -/* The function returns an integer code indicating the geometric */ -/* relationship of the three bodies. */ - -/* Codes and meanings are: */ - -/* -3 Total occultation of first target by */ -/* second. */ - - -/* -2 Annular occultation of first target by */ -/* second. The second target does not */ -/* block the limb of the first. */ - - -/* -1 Partial occultation of first target by */ -/* second target. */ - - -/* 0 No occultation or transit: both objects */ -/* are completely visible to the observer. */ - - -/* 1 Partial occultation of second target by */ -/* first target. */ - - -/* 2 Annular occultation of second target by */ -/* first. */ - - -/* 3 Total occultation of second target by */ -/* first. */ - - -/* End include file zzocced.inc */ - -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* UBEL P All */ -/* UBPL P All */ -/* INST I ZZGFFVIN */ -/* TSHAPE I ZZGFFVIN */ -/* RAYDIR I ZZGFFVIN */ -/* TARGET I ZZGFFVIN */ -/* TFRAME I ZZGFFVIN */ -/* ABCORR I ZZGFFVIN */ -/* OBSRVR I ZZGFFVIN */ -/* TIME I ZZGFFVST */ -/* OCSTAT O ZZGFFVST */ - -/* $ Detailed_Input */ - -/* See entry points. */ - -/* $ Detailed_Output */ - -/* See entry points. */ - -/* $ Parameters */ - -/* See INCLUDE files */ - -/* gf.inc */ -/* zzgf.inc */ - -/* $ Exceptions */ - -/* See entry points. */ - -/* $ Files */ - -/* Appropriate SPK and instrument kernels must be loaded by the */ -/* calling program before this routine is called. PCK, CK and SCLK */ -/* kernels may be required as well. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer that */ -/* describes the ephemeris of these objects for the period */ -/* defined by the confinement window, 'CNFINE' must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - Frame data: if a frame definition is required to convert */ -/* the observer and target states to the body-fixed frame of */ -/* the target, that definition must be available in the kernel */ -/* pool. Typically the definitions of frames not already */ -/* built-in to SPICE are supplied by loading a frame kernel. */ - -/* Data defining the reference frame associated with the */ -/* instrument designated by INST must be available in the kernel */ -/* pool. Additionally the name INST must be associated with an */ -/* ID code. Normally these data are made available by loading */ -/* a frame kernel via FURNSH. */ - -/* - IK data: the kernel pool must contain data such that */ -/* the SPICELIB routine GETFOV may be called to obtain */ -/* parameters for INST. Normally such data are provided by */ -/* an IK via FURNSH. */ - -/* The following data may be required: */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* orientation data provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file via FURNSH. */ - -/* Bodies modeled as triaxial ellipsoids must have semi-axis */ -/* lengths provided by variables in the kernel pool. Typically */ -/* these data are made available by loading a text PCK file via */ -/* FURNSH. */ - -/* - CK data: if the instrument frame is fixed to a spacecraft, */ -/* at least one CK file will be needed to permit transformation */ -/* of vectors between that frame and both J2000 and the target */ -/* body-fixed frame. */ - -/* - SCLK data: if a CK file is needed, an associated SCLK */ -/* kernel is required to enable conversion between encoded SCLK */ -/* (used to time-tag CK data) and barycentric dynamical time */ -/* (TDB). */ - -/* Kernel data are normally loaded once per program run, NOT every */ -/* time this routine is called. */ - -/* $ Particulars */ - -/* This routine is designed to determine whether a specified */ -/* target intersects the space bounded by the FOV of a specified */ -/* instrument at a specified epoch. The target may be represented */ -/* by a ray, or the target may be an ephemeris object. */ - -/* This routine contains two entry points that support searches */ -/* for target visibility periods performed using ZZGFSOLV: */ - -/* ZZGFFVIN Saves the user-supplied inputs defining the */ -/* visibility computation to be performed. */ -/* Initializes the visibility search. */ - -/* ZZGFFVST Returns the visibility state for a specified */ -/* time. */ - -/* $ Examples */ - -/* See GFFOVE. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) (LSE) (WLT) (EDW) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* ATOL is a tolerance value for computing FOV angular radius. */ -/* The angular radius must not exceed pi/2 - ATOL radians. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (raydir) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzgffvin; - case 2: goto L_zzgffvst; - } - - -/* Below we initialize the list of visibility types. */ - - -/* This routine should never be called directly. */ - - chkin_("ZZGFFVU", (ftnlen)7); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZGFFVU", (ftnlen)7); - return 0; -/* $Procedure ZZGFFVIN ( GF, visibility initialization ) */ - -L_zzgffvin: -/* $ Abstract */ - -/* Perform initialization functions for visibility state */ -/* determination. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* FRAMES */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* SEARCH */ -/* GEOMETRY */ -/* VISIBILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) INST */ -/* CHARACTER*(*) TSHAPE */ -/* DOUBLE PRECISION RAYDIR ( 3 ) */ -/* CHARACTER*(*) TARGET */ -/* CHARACTER*(*) TFRAME */ -/* CHARACTER*(*) ABCORR */ -/* CHARACTER*(*) OBSRVR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INST I Name of the instrument. */ -/* TSHAPE I Type of shape model used for target body. */ -/* RAYDIR I Ray's direction vector. */ -/* TARGET I Name of the target body. */ -/* TFRAME I Body-fixed, body-centered frame for target body. */ -/* ABCORR I Aberration correction flag. */ -/* OBSRVR I Name of the observing body. */ - -/* $ Detailed_Input */ - - -/* INST indicates the name of the instrument, such as a */ -/* spacecraft-mounted framing camera, the field of view */ -/* (FOV) of which is to be used for a target intersection */ -/* search: times when the specified target intersects the */ -/* region of space corresponding to the FOV are sought. */ - -/* The position of the instrument designated by INST is */ -/* considered to coincide with that of the ephemeris */ -/* object designated by the input argument OBSRVR (see */ -/* description below). */ - -/* INST must have a corresponding NAIF ID and a frame */ -/* defined, as is normally done in a frame kernel. It */ -/* must also have an associated reference frame and a FOV */ -/* shape, boresight and boundary vertices (or reference */ -/* vector and reference angles) defined, as is usually */ -/* done in an instrument kernel. */ - -/* See the header of the SPICELIB routine GETFOV for a */ -/* description of the required parameters associated with */ -/* an instrument. */ - - -/* TSHAPE is a string indicating the geometric model used to */ -/* represent the location and shape of the target body. */ -/* The target body may be represented by either an */ -/* ephemeris object or a ray emanating from the observer. */ - -/* The supported values of TSHAPE are: */ - -/* 'ELLIPSOID' The target is an ephemeris object. */ - -/* The target's shape is represented */ -/* using triaxial ellipsoid model, */ -/* with radius values provided via the */ -/* kernel pool. A kernel variable */ -/* having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF */ -/* integer code associated with the */ -/* body, must be present in the kernel */ -/* pool. This variable must be */ -/* associated with three numeric */ -/* values giving the lengths of the */ -/* ellipsoid's X, Y, and Z semi-axes. */ - -/* 'POINT' The target is an ephemeris object. */ -/* The body is treated as a single */ -/* point. */ - -/* 'RAY' The target is NOT an ephemeris */ -/* object. Instead, the target is */ -/* considered to be represented by the */ -/* ray emanating from the observer's */ -/* location and having direction */ -/* vector RAYDIR. The target is */ -/* considered to be visible if and */ -/* only if the ray is contained within */ -/* the space bounded by the instrument */ -/* FOV. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TSHAPE. */ - - -/* RAYDIR is the direction vector associated with a ray */ -/* representing the target. RAYDIR is used if and only */ -/* if TSHAPE (see description above) indicates the */ -/* target is modeled as a ray. */ - - -/* TARGET is the name of the target body, the appearances of */ -/* which in the specified instrument's field of view are */ -/* sought. The body must be an ephemeris object. */ - -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. For example both 'MOON' and */ -/* '301' are legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string TARGET. */ - -/* The input argument TARGET is used if and only if the */ -/* target is NOT modeled as ray; equivalently, the input */ -/* argument TSHAPE (see description above) does not */ -/* contain a string equivalent---that is, ignoring case */ -/* and leading and trailing blanks---to 'RAY'. */ - -/* TARGET may be set to a blank string if the target is */ -/* modeled as a ray. */ - - -/* TFRAME is the name of the reference frame associated with the */ -/* target. Examples of such names are 'IAU_SATURN' */ -/* (for Saturn) and 'ITRF93' (for the Earth). */ - -/* If the target is an ephemeris object modeled as an */ -/* ellipsoid, TFRAME must designate a body-fixed */ -/* reference frame centered on the target body. */ - -/* If the target is an ephemeris object modeled as a */ -/* point, TFRAME is ignored; TFRAME should be left blank. */ - -/* If the target is modeled as a ray, TFRAME may */ -/* designate any reference frame. Since light time */ -/* corrections are not supported for rays, the */ -/* orientation of the frame is always evaluated at the */ -/* epoch associated with the observer, as opposed to the */ -/* epoch associated with the light-time corrected */ -/* position of the frame center. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* TFRAME. */ - - -/* ABCORR indicates the aberration corrections to be applied */ -/* when computing the target's position and orientation. */ -/* The supported values of ABCORR depend on the target */ -/* representation. */ - -/* If the target is represented by a ray, the aberration */ -/* correction options are */ - -/* 'NONE' No correction. */ -/* 'S' Stellar aberration correction, */ -/* reception case. */ -/* 'XS' Stellar aberration correction, */ -/* transmission case. */ - -/* If the target is an ephemeris object, the aberration */ -/* correction options are those supported by the SPICE */ -/* SPK system. For remote sensing applications, where the */ -/* apparent position and orientation of the target seen */ -/* by the observer are desired, normally either of the */ -/* corrections */ - -/* 'LT+S' */ -/* 'CN+S' */ - -/* should be used. These and the other supported options */ -/* are described below. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the body from which the target is */ -/* observed. The instrument designated by INST is treated */ -/* as if it were co-located with the observer. */ - -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the observer's name cannot be mapped to an ID code, the */ -/* error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the target is an ephemeris object and its name cannot be */ -/* mapped to an ID code, the error SPICE(IDCODENOTFOUND) is */ -/* signaled. If the target is represented by a ray, the input */ -/* target name argument is ignored. */ - -/* 3) If target is an ephemeris object, and the observer and */ -/* target have the same ID codes, the error */ -/* SPICE(BODIESNOTDISTINCT) is signaled. */ - -/* 4) If target is an ephemeris object, and the target shape */ -/* is not equivalent to PTSHAP (point) or EDSHAP (ellipsoid), */ -/* the error SPICE(INVALIDSHAPE) is signaled. */ - -/* 5) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the reference frame */ -/* argument TFRAME is blank, the error SPICE(INVALIDFRAME) is */ -/* signaled. */ - -/* 6) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the reference frame */ -/* argument TFRAME cannot be mapped to a frame ID code, the */ -/* error SPICE(INVALIDFRAME) is signaled. */ - -/* 7) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the reference frame */ -/* argument TFRAME's ID cannot be mapped to a frame description, */ -/* the error SPICE(FRAMEINFONOTFOUND) is signaled. */ - -/* 8) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the reference frame */ -/* specified by TFRAME is not centered on the target body, the */ -/* error SPICE(INVALIDFRAME) is signaled. */ - -/* 9) If the target is represented by a ray and the aberration */ -/* correction flag calls for light time correction, the error */ -/* SPICE(INVALIDOPTION) is signaled. */ - -/* 10) If target is an ephemeris object and the aberration */ -/* correction flag calls for a correction not supported by */ -/* the SPICE SPK system, the error is diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 11) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the kernel pool */ -/* does not contain radii for the target body, */ -/* not target body, the error is diagnosed by a routine */ -/* in the call tree of this routine. */ - -/* 12) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the kernel pool */ -/* contains the wrong number of radii for the target body, the */ -/* error SPICE(INVALIDDIMENSION) is signaled. */ - -/* 13) If target is an ephemeris object, the target shape is */ -/* equivalent to EDSHAP (ellipsoid), and the kernel pool */ -/* contains one or more non-positive radii for the target body, */ -/* the error SPICE(BADAXISLENGTH) is signaled. */ - -/* 14) If the target is represented by a ray and the ray's */ -/* direction vector is zero, the error SPICE(ZEROVECTOR) is */ -/* signaled. */ - -/* 15) If the instrument name INST cannot be mapped to an ID code, */ -/* the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 16) If an error occurs while fetching the instrument parameters */ -/* from the kernel pool, the error will be diagnosed by a */ -/* routine in the call tree of this routine. */ - -/* 17) If any ray defined by the observer's position and one of */ -/* the instrument FOV's boundary vectors fails to intersect */ -/* the "FOV plane"---a plane normal to the instrument FOV axis */ -/* and intersected by the FOV axis at distance 1 km from the */ -/* observer---the error SPICE(DEGENERATECASE) is signaled. */ - -/* 18) If the FOV is circular or elliptical and the FOV's radius */ -/* or one of the FOV's semi-axis lengths is zero, the error */ -/* SPICE(DEGENERATECASE) is signaled. */ - -/* 19) If the maximum angular separation of the instrument */ -/* FOV axis and any FOV boundary vector exceeds the limit */ -/* (which is slightly less than 90 degrees), either the error */ -/* SPICE(FOVTOOWIDE) will be signaled or the error will be */ -/* diagnosed by a routine in the call tree of this routine. */ - - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFFVU. */ - -/* $ Particulars */ - -/* This entry point initializes the parameters needed by the */ -/* occultation state determination entry point ZZGFFVST. */ - -/* $ Examples */ - -/* See implementation of GFFOVE. */ - -/* $ Restrictions */ - -/* 1) The reference frame associated with INST must be */ -/* centered at the observer or must be inertial. No check is done */ -/* to ensure this. */ - -/* 2) This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) (LSE) (WLT) (EDW) */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFFVIN", (ftnlen)8); - -/* To avoid portability problems, initialize all */ -/* saved variables that aren't initialized via DATA */ -/* statements and aren't guaranteed to be initialized */ -/* for all cases. */ - - cleard_(&c__30000, svbnds); - cleard_(&c__3, svedct); - cleard_(&c__3, svfaxi); - cleard_(&c__20000, svfpol); - cleard_(&c__9, svfsmx); - cleard_(&c__4, svplan); - cleard_(&c__3, svrdir); - svtarg = 0; - s_copy(svtfrm, " ", (ftnlen)32, (ftnlen)1); - s_copy(svtnam, " ", (ftnlen)36, (ftnlen)1); - cleard_(&c__3, svtrad); - svustl = FALSE_; - svxmit = FALSE_; - -/* Find the NAIF ID for OBSRVR. */ - - bods2c_(obsrvr, &svobs, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE Toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Process the target shape specifier here. */ - -/* Save a left-justified, upper case version of the target shape */ -/* specifier. */ - - ljust_(tshape, svtshp, tshape_len, (ftnlen)9); - ucase_(svtshp, svtshp, (ftnlen)9, (ftnlen)9); - -/* Note for maintenance programmer: these checks will */ -/* require modification to handle DSK-based shapes. */ - - if (s_cmp(svtshp, "POINT", (ftnlen)9, (ftnlen)5) != 0 && s_cmp(svtshp, - "ELLIPSOID", (ftnlen)9, (ftnlen)9) != 0 && s_cmp(svtshp, "RAY", ( - ftnlen)9, (ftnlen)3) != 0) { - setmsg_("The target shape specification, '#', is not recognized.", ( - ftnlen)55); - errch_("#", tshape, (ftnlen)1, tshape_len); - sigerr_("SPICE(INVALIDSHAPE)", (ftnlen)19); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* We'll use the logical variable USERAY to indicate that the */ -/* target is modeled as ray. */ - - svuray = s_cmp(svtshp, "RAY", (ftnlen)9, (ftnlen)3) == 0; - -/* Indicate whether we have an extended target. SVXTRG is .TRUE. */ -/* if and only we have one. */ - - svxtrg = s_cmp(svtshp, "ELLIPSOID", (ftnlen)9, (ftnlen)9) == 0; - -/* If the target is an ephemeris object, obtain its ID code. */ -/* Save the target object's name, if applicable. */ - - if (! svuray) { - bods2c_(target, &svtarg, &found, target_len); - if (! found) { - setmsg_("The target object, '#', is not a recognized name for an" - " ephemeris object. The cause of this problem may be that" - " you need an updated version of the SPICE Toolkit. ", ( - ftnlen)162); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Save the target's name. */ - - s_copy(svtnam, target, (ftnlen)36, target_len); - -/* Make sure the observer and target are distinct. */ - - if (svtarg == svobs) { - setmsg_("The observer and target must be distinct objects, but a" - "re not: OBSRVR = #; TARGET = #;", (ftnlen)86); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - } - -/* Process the target frame. The target frame is defined except */ -/* when the target is an ephemeris object modeled as a point. */ - - if (svuray || svxtrg) { - -/* We'll use the target frame argument. Look up the target */ -/* frame's ID code. But first, check for a blank frame name, */ -/* since this may be a common problem for the GF FOV system. */ - - if (s_cmp(tframe, " ", tframe_len, (ftnlen)1) == 0) { - setmsg_("The target is not modeled as a point, but the associate" - "d frame name is blank.", (ftnlen)77); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - namfrm_(tframe, &framid, tframe_len); - if (framid == 0) { - setmsg_("The target frame name # is not recognized.", (ftnlen)42); - errch_("#", tframe, (ftnlen)1, tframe_len); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Save the target frame name. */ - - ljust_(tframe, svtfrm, tframe_len, (ftnlen)32); - ucase_(svtfrm, svtfrm, (ftnlen)32, (ftnlen)32); - -/* Obtain the center of the frame. If the target is an ephemeris */ -/* object, we must verify the frame center is the target. */ - - frinfo_(&framid, &frcent, &frclss, &clssid, &found); - if (! found) { - -/* Since we mapped the frame name to an ID code, we expect to */ -/* find the frame info. Getting here may be a sign of an */ -/* invalid frame kernel. */ - - setmsg_("Frame ID found for # body-fixed frame # but FRINFO coul" - "dn't find frame info. This may be due to a frame kernel " - "error.", (ftnlen)117); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(FRAMEINFONOTFOUND)", (ftnlen)24); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - if (svxtrg) { - -/* We have an extended target. Check the target frame's center. */ - - if (frcent != svtarg) { - -/* The supposed body-fixed frame for the target isn't */ -/* actually centered on the target. */ - - setmsg_("Supposed body-fixed frame # for target # is actuall" - "y centered on body #.", (ftnlen)72); - errch_("#", tframe, (ftnlen)1, tframe_len); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", &frcent, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - } - } - -/* Process the aberration correction specifier. */ - - if (svuray) { - -/* The target is represented by a ray. Check and save the */ -/* aberration correction. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Reject aberration correction flags calling for any type of */ -/* light time correction. However, stellar aberration corrections */ -/* are allowed: note this is the reverse of the situation for */ -/* ephemeris objects. The allowed aberration correction flags are */ - -/* 'NONE', 'S', 'XS' */ - - if (attblk[1]) { - setmsg_("Aberration correction flag # calls for light time corre" - "ctions; these are not supported for targets represented " - "by rays.", (ftnlen)119); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Save flags indicating whether to use stellar aberration */ -/* corrections and indicating the sense of radiation travel. */ - - svustl = attblk[2]; - svxmit = attblk[4]; - } else { - -/* The target is an ephemeris object. */ - -/* Check the aberration correction. If SPKEZR can't handle it, */ -/* neither can we. */ - - zzvalcor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - } - -/* Save a left-justified, upper case version of the aberration */ -/* correction specifier. */ - - ljust_(abcorr, svcorr, abcorr_len, (ftnlen)5); - ucase_(svcorr, svcorr, (ftnlen)5, (ftnlen)5); - -/* Process the target body's radii, if applicable. */ - - if (svxtrg) { - -/* Fetch and check the radii. */ - - bodvcd_(&svtarg, "RADII", &c__3, &n, svtrad, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Check the count of the radii. */ - - if (n != 3) { - setmsg_("Target # should have 3 radii but actually has #. This m" - "ay be due to an error in a PCK file used to provide the " - "radii.", (ftnlen)117); - errch_("#", target, (ftnlen)1, target_len); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Check to make sure the current target has 3 positive */ -/* semi-axis lengths. */ - - if (svtrad[0] <= 0. || svtrad[1] <= 0. || svtrad[2] <= 0.) { - setmsg_("One or more semi-axis lengths of the target body # are " - "non-positive: 1 = #, 2 = #, 3 = #. ", (ftnlen)90); - errch_("#", target, (ftnlen)1, target_len); - errdp_("#", svtrad, (ftnlen)1); - errdp_("#", &svtrad[1], (ftnlen)1); - errdp_("#", &svtrad[2], (ftnlen)1); - sigerr_("SPICE(BADAXISLENGTH)", (ftnlen)20); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Checks of radii have been completed. */ - - } else { - -/* We don't have an extended target body: zero out radius values */ -/* for this target. */ - - cleard_(&c__3, svtrad); - } - -/* Check the direction vector, if applicable. */ - - if (svuray) { - -/* Make sure the direction vector is non-zero. Save a unit-length */ -/* copy of the vector. */ - - if (vzero_(raydir)) { - setmsg_("Input ray direction was the zero vector; this vector mu" - "st be non-zero.", (ftnlen)70); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - vhat_(raydir, svrdir); - } - -/* Look up the instrument's ID code. */ - - bods2c_(inst, &svinst, &found, inst_len); - if (! found) { - setmsg_("'#' is not a recognized name for an instrument. The cause o" - "f this problem may be that you have not loaded a required fr" - "ame kernel or instrument kernel.", (ftnlen)151); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Save the instrument's name. */ - - ljust_(inst, svinam, inst_len, (ftnlen)36); - ucase_(svinam, svinam, (ftnlen)36, (ftnlen)36); - -/* Look up the instrument parameters. */ - - getfov_(&svinst, &c__10000, svishp, svifrm, bsite, &svnvrt, svbnds, ( - ftnlen)9, (ftnlen)32); - if (failed_()) { - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Make sure the intrument shape specifier is left-justified */ -/* and in upper case. */ - - ljust_(svishp, svishp, (ftnlen)9, (ftnlen)9); - ucase_(svishp, svishp, (ftnlen)9, (ftnlen)9); - -/* If the instrument's shape is 'RECTANGLE', map it to */ -/* 'POLYGON' */ - - if (s_cmp(svishp, "RECTANGLE", (ftnlen)9, (ftnlen)9) == 0) { - s_copy(svishp, "POLYGON", (ftnlen)9, (ftnlen)7); - } - -/* Save an axis vector for the FOV. For circular and ellipsoidal */ -/* FOVs, the boresight serves as this axis. For polygonal FOVs */ -/* (rectangular FOVs are included), we'll generate an axis vector. */ - - if (s_cmp(svishp, "POLYGON", (ftnlen)9, (ftnlen)7) == 0) { - zzfovaxi_(inst, &svnvrt, svbnds, svfaxi, inst_len); - if (failed_()) { - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - } else { - vequ_(bsite, svfaxi); - } - -/* Check the angular radius of the FOV. */ - -/* Compute the angular radius of the FOV. We'll use this to define a */ -/* "bounding cone" centered on the FOV axis and having its apex at */ -/* the observer. This cone will be used for a preliminary FOV */ -/* exclusion test. */ - - svarad = 0.; - i__1 = svnvrt; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing MAX */ - d__1 = svarad, d__2 = vsep_(&svbnds[(i__2 = i__ * 3 - 3) < 30000 && 0 - <= i__2 ? i__2 : s_rnge("svbnds", i__2, "zzgffvu_", (ftnlen) - 1243)], svfaxi); - svarad = max(d__1,d__2); - } - -/* Our algorithms can't handle FOVs with angular radius of 90 */ -/* degrees. */ - - if (svarad > halfpi_() - 1e-6) { - setmsg_("FOV angular radius of # degrees exceeds limit of # degrees.", - (ftnlen)59); - d__1 = svarad * dpr_(); - errdp_("#", &d__1, (ftnlen)1); - d__1 = (halfpi_() - 1e-6) * dpr_(); - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Convert the FOV shape specifier to a left-justified, upper */ -/* case form. */ - - ljust_(svishp, svishp, (ftnlen)9, (ftnlen)9); - ucase_(svishp, svishp, (ftnlen)9, (ftnlen)9); - -/* We can make the search more efficient by computing any */ -/* required, time-invariant quantities here in the initialization */ -/* routine. */ - -/* Compute the FOV plane SVPLAN, which is represented in the */ -/* instrument frame. The origin will be considered to be located at */ -/* the observer. The plane is normal to the FOV axis, at distance 1 */ -/* unit from the observer. */ - - nvc2pl_(svfaxi, &c_b98, svplan); - -/* Find the point on the plane closest to the origin. This is */ -/* the center of the FOV. */ - - vhat_(svfaxi, svfvct); - -/* If applicable, perform the computations required for an */ -/* elliptical FOV, where the target representation is arbitrary, or */ -/* a circular FOV when the target is an extended object. */ - - if (s_cmp(svishp, "ELLIPSE", (ftnlen)9, (ftnlen)7) == 0 || s_cmp(svishp, - "CIRCLE", (ftnlen)9, (ftnlen)6) == 0 && svxtrg) { - -/* Also compute the center, semi-axis vectors, and semi-axis */ -/* lengths of the FOV. If the FOV is circular, we create an */ -/* artificial, second semi-axis vector. */ - - if (s_cmp(svishp, "CIRCLE", (ftnlen)9, (ftnlen)6) == 0) { - -/* We have a circular FOV. We'll create an artificial, second */ -/* boundary vector, which will give rise to a second */ -/* semi-axis. */ - - d__1 = halfpi_(); - vrotv_(svbnds, svfaxi, &d__1, &svbnds[3]); - } - -/* Now find the endpoints of the semi-axes in this plane. */ - - for (i__ = 1; i__ <= 2; ++i__) { - inrypl_(svorig, &svbnds[(i__1 = i__ * 3 - 3) < 30000 && 0 <= i__1 - ? i__1 : s_rnge("svbnds", i__1, "zzgffvu_", (ftnlen)1315)] - , svplan, &nxpts, &semipt[(i__2 = i__ * 3 - 3) < 6 && 0 <= - i__2 ? i__2 : s_rnge("semipt", i__2, "zzgffvu_", (ftnlen) - 1315)]); - if (nxpts != 1) { - setmsg_("Error creating FOV semi-axis vectors, NXPTS = #. Th" - "is may indicate an error in the IK parameters for #.", - (ftnlen)103); - errint_("#", &nxpts, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - -/* Compute and find the length of each semi-axis vector. */ - - vsub_(&semipt[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("semipt", i__1, "zzgffvu_", (ftnlen)1335)], svfvct, - &svsemi[(i__2 = i__ * 3 - 3) < 6 && 0 <= i__2 ? i__2 : - s_rnge("svsemi", i__2, "zzgffvu_", (ftnlen)1335)]); - svxmag[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("svxmag", - i__1, "zzgffvu_", (ftnlen)1337)] = vnorm_(&svsemi[(i__2 = - i__ * 3 - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge("svsemi", - i__2, "zzgffvu_", (ftnlen)1337)]); - if (svxmag[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "svxmag", i__1, "zzgffvu_", (ftnlen)1339)] == 0.) { - setmsg_("FOV semi-axis #* for @ has zero length.", (ftnlen)39) - ; - errint_("*", &i__, (ftnlen)1); - errch_("@", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - } - } - -/* If we have an ellipsoidal target, and the FOV is circular or */ -/* elliptical, we'll create an ellipsoid whose limb coincides with */ -/* the FOV. This allows use to later use ZZOCCED to determine the */ -/* target's visibility. */ - - if ((s_cmp(svishp, "CIRCLE", (ftnlen)9, (ftnlen)6) == 0 || s_cmp(svishp, - "ELLIPSE", (ftnlen)9, (ftnlen)7) == 0) && svxtrg) { - -/* Create an ellipsoid whose semi-axes are consistent with */ -/* ellipse in SVPLAN defined by SEMIPT. To start out, select the */ -/* center of the ellipsoid. We place the center along the */ -/* direction defined by the FOV axis, at a distance beyond */ -/* SVPLAN (that is, on the side of the plane opposite the */ -/* observer), such that a sphere centered at this point would */ -/* have a limb consisting of a circle of radius SVXMAG(1). If */ -/* CTREXT is the distance of the ellipsoid center from SVFVCT, */ -/* then the limb geometry requires */ - -/* CTREXT / SVXMAG(1) = SVXMAG(1) / 1 */ - - -/* Computing 2nd power */ - d__1 = svxmag[0]; - ctrext = d__1 * d__1; - -/* The ellipsoid's center is SVEDCT. */ - - d__1 = ctrext + 1.; - vscl_(&d__1, svfvct, svedct); - -/* NOTE: in the code and discussion that follow, there are */ -/* references to both the FOV center SVFVCT and the ellipsoid */ -/* center SVEDCT. Note that the directions of the ellipsoid's */ -/* semi-axes point from the FOV center, NOT the ellipsoid center, */ -/* toward the intercepts of the FOV boundary vectors on the */ -/* FOV plane. */ - -/* Compute the radius of the sphere centered at SVEDCT. The */ -/* ellipsoid's semi-axes pointing in the FOV axis direction and */ -/* in the direction from SVFVCT toward SEMIPT(*,1) will have this */ -/* length. */ - - fovrad[2] = svxmag[0] * sqrt(pow_dd(svxmag, &c_b128) + 1.); - fovrad[0] = fovrad[2]; - -/* Compute the corresponding columns of the FOV semi-axis matrix. */ - -/* The ellipsoid's third axis points along the FOV axis: */ - - vscl_(&fovrad[2], svfvct, &svfsmx[6]); - -/* The first ellipsoid semi-axis is associated with SEMIPT(*,1) */ -/* and also has length FOVRAD(3): */ - - vhat_(svsemi, vtemp); - vscl_(fovrad, vtemp, svfsmx); - -/* The ellipsoid's second semi-axis points from SVFVCT toward */ -/* SEMIPT(*,2). The ratio of its length to that of the other */ -/* semi-axis is the ratio of the length of the FOV's second */ -/* semi-axis to that of its first. Note that we've already ruled */ -/* out divide-by-zero errors here. */ - - fovrad[1] = svxmag[1] / svxmag[0] * fovrad[2]; - -/* We define the third axis using a cross product to */ -/* ensure we produce a matrix with positive determinant. */ - - ucrss_(&svfsmx[6], svfsmx, vtemp); - vscl_(&fovrad[1], vtemp, &svfsmx[3]); - } - if (s_cmp(svishp, "CIRCLE", (ftnlen)9, (ftnlen)6) == 0 && ! svxtrg) { - -/* We have a circular FOV and a point or ray target model. */ -/* In this case, our FOV inclusion test is simple as can */ -/* be: we just compare the angular separation of the */ -/* target and FOV axis against the angular radius of the */ -/* FOV. Compute and save this angular radius. */ - - svarad = vsep_(svfaxi, svbnds); - } else if ((s_cmp(svishp, "RECTANGLE", (ftnlen)9, (ftnlen)9) == 0 || - s_cmp(svishp, "POLYGON", (ftnlen)9, (ftnlen)7) == 0) && ! svxtrg) - { - -/* We have a rectangular or polygonal FOV and a ray or point */ -/* target. */ - -/* We're going to represent the FOV boundary by a polygon */ -/* in the FOV plane SVPLAN. We want to be able to use a */ -/* 2-dimensional winding number computation to decide whether */ -/* the target is within the FOV. We'll need a reference */ -/* frame with the Z-axis parallel to the FOV axis vector; */ -/* we'll represent the intersections of the boundary vectors */ -/* with the FOV plane in this frame. Then our 2D polygon */ -/* will have vertices given by the (X,Y) components of each */ -/* intersection. */ - - vequ_(svfaxi, z__); - frame_(z__, x, y); - for (i__ = 1; i__ <= 3; ++i__) { - svfovm[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "svfovm", i__1, "zzgffvu_", (ftnlen)1466)] = x[(i__2 = - i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("x", i__2, - "zzgffvu_", (ftnlen)1466)]; - svfovm[(i__1 = i__ * 3 - 2) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "svfovm", i__1, "zzgffvu_", (ftnlen)1467)] = y[(i__2 = - i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("y", i__2, - "zzgffvu_", (ftnlen)1467)]; - svfovm[(i__1 = i__ * 3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "svfovm", i__1, "zzgffvu_", (ftnlen)1468)] = z__[(i__2 = - i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("z", i__2, - "zzgffvu_", (ftnlen)1468)]; - } - -/* Compute the intersections of the FOV boundary vectors with the */ -/* FOV plane. For each intercept, find the vector pointing from */ -/* the FOV center to that intercept. Transform each such */ -/* difference vector into the FOV frame. Save the projection onto */ -/* the FOV frame's X-Y plane. */ - - i__1 = svnvrt; - for (i__ = 1; i__ <= i__1; ++i__) { - inrypl_(svorig, &svbnds[(i__2 = i__ * 3 - 3) < 30000 && 0 <= i__2 - ? i__2 : s_rnge("svbnds", i__2, "zzgffvu_", (ftnlen)1480)] - , svplan, &nxpts, xpt); - if (nxpts != 1) { - setmsg_("Error finding FOV plane intercept of FOV boundary v" - "ector #, NXPTS = #. This may indicate an error in th" - "e IK parameters for #.", (ftnlen)125); - errint_("#", &i__, (ftnlen)1); - errint_("#", &nxpts, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; - } - vsub_(xpt, svfvct, vtemp); - mxv_(svfovm, vtemp, vtemp2); - svfpol[(i__2 = (i__ << 1) - 2) < 20000 && 0 <= i__2 ? i__2 : - s_rnge("svfpol", i__2, "zzgffvu_", (ftnlen)1501)] = - vtemp2[0]; - svfpol[(i__2 = (i__ << 1) - 1) < 20000 && 0 <= i__2 ? i__2 : - s_rnge("svfpol", i__2, "zzgffvu_", (ftnlen)1502)] = - vtemp2[1]; - } - } - chkout_("ZZGFFVIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFFVST ( GF, "is target in FOV?" ) */ - -L_zzgffvst: -/* $ Abstract */ - -/* Indicate whether the target is currently in the instrument FOV. */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* SEARCH */ -/* GEOMETRY */ - -/* $ Declarations */ - -/* DOUBLE PRECISION TIME */ -/* LOGICAL VISTAT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TIME I TDB epoch (in seconds past J2000) */ -/* VISTAT O .TRUE. if the object is visible, .FALSE. */ -/* otherwise. */ - -/* $ Detailed_Input */ - -/* TIME is the epoch of interest in TDB seconds past the */ -/* J2000 epoch. */ - -/* $ Detailed_Output */ - -/* VISTAT is a logical flag indicating the state of visibility. */ -/* If the target is in the instrument FOV at epoch TIME, */ -/* where target and instrument are those specified by the */ -/* last call to ZZGFFVIN, VISTAT is returned with the */ -/* value .TRUE.; otherwise VISTAT is .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any SPK lookup fails, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 2) If any frame transformation lookup fails, the error will be */ -/* diagnosed by routines in the call tree of this routine. */ - -/* 3) If the FOV is polygonal, the target is an ellipsoid, */ -/* and while testing whether the target is visible, an error */ -/* occurs due to FOV errors not detected in the initialization */ -/* step, the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 4) If the FOV is circular or elliptical, the target is an */ -/* ellipsoid, and while testing whether the target is visible, an */ -/* error occurs due to degenerate geometry of the limb, FOV, or */ -/* both, the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 5) If the target shape is not recognized, the error will be */ -/* diagnosed by routines in the call tree of this routine. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFFVU. */ - -/* $ Particulars */ - -/* This routine determines the visibility state of the */ -/* configuration specified by the last call to ZZGFFVIN and the */ -/* input time value. */ - -/* $ Examples */ - -/* See the umbrella routine ZZGFFVU. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) (LSE) (WLT) (EDW) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFFVST", (ftnlen)8); - -/* Initialize the state output. */ - - *vistat = FALSE_; - -/* The algorithm for the state determination depends on the */ -/* target model and the FOV shape. */ - - if (svxtrg) { - -/* The target is an ephemeris object modeled as an extended */ -/* body. There are two branches here: one for a rectangular/ */ -/* polygonal FOV and one for a circular/elliptical FOV. */ - -/* Start by finding the observer-target position vector in the */ -/* target body-fixed frame. */ - - spkezp_(&svtarg, time, svtfrm, svcorr, &svobs, pos, <, (ftnlen)32, ( - ftnlen)5); - -/* Compute the target epoch. */ - - zzcorepc_(svcorr, time, <, &ettarg, (ftnlen)5); - -/* Find the transformation from the target frame at ETTARG to the */ -/* instrument frame at TIME. We'll need to use J2000 as an */ -/* intermediate frame. */ - - pxform_(svtfrm, "J2000", &ettarg, m1, (ftnlen)32, (ftnlen)5); - pxform_("J2000", svifrm, time, m2, (ftnlen)5, (ftnlen)32); - if (failed_()) { - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - mxm_(m2, m1, insmat); - if (s_cmp(svishp, "RECTANGLE", (ftnlen)9, (ftnlen)9) == 0 || s_cmp( - svishp, "POLYGON", (ftnlen)9, (ftnlen)7) == 0) { - -/* The FOV is a rectangle or other polygon; we treat both */ -/* cases the same way. */ - -/* Negate POS to obtain the position of the observer with */ -/* respect to the target. */ - - vminus_(pos, obspos); - -/* Find the limb in the target body-fixed frame. */ - - edlimb_(svtrad, &svtrad[1], &svtrad[2], obspos, limb); - -/* Transform the limb from the target frame at ETTARG */ -/* to the instrument frame at TIME. The matrix INSMAT */ -/* effects just this transformation. We unpack the center */ -/* and semi-axis vectors of LIMB, transform them, and */ -/* pack the results into FVLIMB. Below, M1 and M2 are */ -/* simply temporary 3x3 matrices. */ - - el2cgv_(limb, m1, &m1[3], &m1[6]); - -/* Before performing the frame transformation on the */ -/* limb's center, translate the center so that the */ -/* observer is at the origin. Since POS is expressed */ -/* in the target body-fixed frame, this is a convenient */ -/* place for the translation. */ - - vadd_(pos, m1, vtemp); - vequ_(vtemp, m1); - for (i__ = 1; i__ <= 3; ++i__) { - mxv_(insmat, &m1[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 - : s_rnge("m1", i__1, "zzgffvu_", (ftnlen)1733)], &m2[( - i__2 = i__ * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge( - "m2", i__2, "zzgffvu_", (ftnlen)1733)]); - } - cgv2el_(m2, &m2[3], &m2[6], fvlimb); - -/* All geometric objects in the following call are expressed */ -/* in the instrument reference frame. */ - -/* The target is in the FOV if and only if ZZELVUPY finds an */ -/* intersection, so we use VISTAT as the "found" flag. */ - - zzelvupy_(fvlimb, svorig, svfaxi, &svnvrt, svbnds, vistat); - } else if (s_cmp(svishp, "CIRCLE", (ftnlen)9, (ftnlen)6) == 0 || - s_cmp(svishp, "ELLIPSE", (ftnlen)9, (ftnlen)7) == 0) { - -/* The FOV is a circle or ellipse. For both FOV shapes, */ -/* we represent the FOV by an ellipsoid in the FOV */ -/* frame. We can then use ZZOCCED to determine whether */ -/* there's any overlap of this ellipsoid and the target. */ - -/* We'll perform the occultation test in the instrument frame, */ -/* so we'll need to represent the observer-target position */ -/* and target semi-axes in that frame. */ - -/* Transform the target position to the instrument frame. */ - - mxv_(insmat, pos, trgctr); - -/* The columns of INSMAT are the target body's semi-axis */ -/* direction vectors; we scale these by the target radii */ -/* to obtain the semi-axis matrix for the target. */ - - for (i__ = 1; i__ <= 3; ++i__) { - vscl_(&svtrad[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : - s_rnge("svtrad", i__1, "zzgffvu_", (ftnlen)1771)], & - insmat[(i__2 = i__ * 3 - 3) < 9 && 0 <= i__2 ? i__2 : - s_rnge("insmat", i__2, "zzgffvu_", (ftnlen)1771)], & - trgsmx[(i__3 = i__ * 3 - 3) < 9 && 0 <= i__3 ? i__3 : - s_rnge("trgsmx", i__3, "zzgffvu_", (ftnlen)1771)]); - } - ocstat = zzocced_(svorig, svedct, svfsmx, trgctr, trgsmx); - -/* A return code of zero indicates no occultation. Any other */ -/* return code indicates a non-empty intersection of the */ -/* target and FOV. */ - - *vistat = ocstat != 0; - } else { - -/* This is an unexpected FOV shape. We should have prevented */ -/* this problem in the initialization step, but we repeat the */ -/* check here for safety. */ - - setmsg_("The target body # has shape #; the only supported shape" - "s are ELLIPSOID, POINT, and RAY.", (ftnlen)87); - errch_("#", svtnam, (ftnlen)1, (ftnlen)36); - errch_("#", svishp, (ftnlen)1, (ftnlen)9); - sigerr_("SPICE(INVALIDSHAPE)", (ftnlen)19); - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - -/* This is the end of the ellipsoidal target case. At this */ -/* point, VISTAT is set. */ - - } else { - -/* The target is a ray or an ephemeris object modeled as a point. */ -/* In either case, we want to obtain the aberration-corrected */ -/* observer-target vector. */ - - if (svuray) { - -/* The target is represented by a ray expressed in the */ -/* frame SVTFRM. */ - -/* Normally we'd need to correct the orientation of SVTFRM */ -/* for light time between the center of that frame and the */ -/* observer. But since light time corrections are not allowed */ -/* for targets represented by rays, we evaluate SVTFRM */ -/* at the current epoch TIME. */ - - pxform_(svtfrm, svifrm, time, insmat, (ftnlen)32, (ftnlen)32); - if (failed_()) { - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - -/* Transform the ray's direction vector to the instrument */ -/* frame. */ - - mxv_(insmat, svrdir, dir); - -/* If we need to correct the ray's direction for stellar */ -/* aberration, do it now. */ - - if (svustl) { - -/* Find the state of the observer relative to the */ -/* solar system barycenter in the J2000 frame. */ - - spkssb_(&svobs, time, "J2000", stobs, (ftnlen)5); - -/* Convert the direction vector to the J2000 frame. */ - - pxform_(svifrm, "J2000", time, m1, (ftnlen)32, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - mxv_(m1, dir, vtemp); - -/* Apply the stellar aberration correction. */ - - if (svxmit) { - -/* Use the transmission correction. */ - - stlabx_(vtemp, &stobs[3], vtemp2); - } else { - stelab_(vtemp, &stobs[3], vtemp2); - } - -/* Map the direction vector back to the instrument */ -/* frame. */ - - mtxv_(m1, vtemp2, dir); - } - -/* The target direction in the instrument frame DIR has */ -/* been computed. */ - - } else { - -/* The target is an ephemeris object. Look up the */ -/* target's position relative to the observer. */ - -/* Note for the maintenance programmer: don't think of */ -/* changing this call to look up the position in the */ -/* instrument frame. :) Since we don't have a guarantee that */ -/* the instrument frame is centered on the observer (the frame */ -/* could be J2000, for example), and since we don't want to */ -/* correct the orientation of the instrument frame for light */ -/* time, we look up the direction vector in the J2000 frame */ -/* and then map it to the instrument frame. */ - - spkezp_(&svtarg, time, "J2000", svcorr, &svobs, vtemp, <, ( - ftnlen)5, (ftnlen)5); - pxform_("J2000", svifrm, time, m1, (ftnlen)5, (ftnlen)32); - if (failed_()) { - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - mxv_(m1, vtemp, dir); - } - if (failed_()) { - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - -/* The observer-target direction vector DIR is set. */ - -/* The determination of whether the ray is in the FOV depends */ -/* on the FOV shape. */ - - sep = vsep_(dir, svfaxi); - if (s_cmp(svishp, "CIRCLE", (ftnlen)9, (ftnlen)6) == 0) { - -/* Just compare the angular separation of POS with the */ -/* FOV axis direction against the FOV angular radius SVARAD. */ - - *vistat = sep <= svarad; - } else if (sep > svarad) { - -/* The FOV is an ellipse or polygon. */ - -/* The angular separation of target and FOV axis is */ -/* greater than the angular radius of the exclusion */ -/* cone. The target can't be seen. */ - - *vistat = FALSE_; - } else { - -/* The FOV is an ellipse or polygon. */ - -/* The angular separation of target and FOV axis is */ -/* less than or equal to than the angular radius of the */ -/* exclusion code, so the target may be visible. */ - -/* Find the intersection of the ray emanating from the */ -/* observer, and having direction vector POS, with the FOV */ -/* plane. */ - - inrypl_(svorig, dir, svplan, &nxpts, xpt); - -/* If there's no intersection, the target isn't visible. */ - - if (nxpts == 0) { - *vistat = FALSE_; - } else if (nxpts != 1) { - -/* "This can't happen." :) */ - - setmsg_("By construction, the vertex of the observer-target " - "ray can't lie in the FOV plane. If somehow it does, " - "we have a serious problem.", (ftnlen)129); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } else { - -/* NXPTS is 1. */ - -/* Find the vector from the center of the FOV to XPT. */ -/* Call this vector FOVPT. */ - - vsub_(xpt, svfvct, fovpt); - if (s_cmp(svishp, "ELLIPSE", (ftnlen)9, (ftnlen)7) == 0) { - -/* The FOV shape is elliptical. To decide whether FOVPT */ -/* is within the FOV, compute the level surface */ -/* parameter */ - -/* 2 2 */ -/* L = ( x / a ) + ( y / b ) */ - -/* and compare L to 1. We'll use the variable COORD */ -/* to represent the coordinates (x,y). */ - -/* We've already eliminated zero divisors in the */ -/* initialization routine. */ - - for (i__ = 1; i__ <= 2; ++i__) { - coord[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("coord", i__1, "zzgffvu_", (ftnlen) - 2000)] = vdot_(fovpt, &svsemi[(i__2 = i__ * 3 - - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge("svsemi" - , i__2, "zzgffvu_", (ftnlen)2000)]) / svxmag[( - i__3 = i__ - 1) < 2 && 0 <= i__3 ? i__3 : - s_rnge("svxmag", i__3, "zzgffvu_", (ftnlen) - 2000)]; - } - d__1 = coord[0] / svxmag[0]; - d__2 = coord[1] / svxmag[1]; - l = pow_dd(&d__1, &c_b128) + pow_dd(&d__2, &c_b128); - -/* The target is visible if FOVPT is inside the FOV */ -/* ellipse; this condition is indicated by L <= 1. */ - - *vistat = l <= 1.; - } else if (s_cmp(svishp, "POLYGON", (ftnlen)9, (ftnlen)7) == - 0) { - -/* The FOV is a polygon. Convert FOVPT to the FOV frame, */ -/* then find the winding number of the FOV about the X-Y */ -/* projection of FOVPT. */ - - mxv_(svfovm, fovpt, vtemp); - pnt2d[0] = vtemp[0]; - pnt2d[1] = vtemp[1]; - w = zzwind2d_(&svnvrt, svfpol, pnt2d); - -/* Any non-zero winding number indicates that the */ -/* FOV polygon wraps around the point representing */ -/* the intercept of the target direction with the */ -/* FOV plane. */ - - *vistat = w != 0; - } else { - -/* This is an unexpected FOV shape. We should have */ -/* prevented this problem in the initialization step, */ -/* but we repeat the check here for safety. */ - - setmsg_("Instrument #'s FOV has shape #; the only suppor" - "ted shapes are ELLIPSE, CIRCLE, and POLYGON.", ( - ftnlen)91); - errch_("#", svinam, (ftnlen)1, (ftnlen)36); - errch_("#", svishp, (ftnlen)1, (ftnlen)9); - sigerr_("SPICE(INVALIDSHAPE)", (ftnlen)19); - chkout_("ZZGFFVST", (ftnlen)8); - return 0; - } - -/* We've performed visibility tests for elliptical or */ -/* polygonal FOVs. VISTAT is set. */ - - } - -/* We've processed the intercept found by the INRYPL call, */ -/* or, if the intercept count was not 1, indicated that the */ -/* target is not visible. VISTAT is set. */ - - } - -/* We've processed both the ray and point ephemeris object */ -/* cases. VISTAT is set. */ - - } - -/* We've processed all target representation/FOV shape cases. */ - - chkout_("ZZGFFVST", (ftnlen)8); - return 0; -} /* zzgffvu_ */ - -/* Subroutine */ int zzgffvu_(char *inst, char *tshape, doublereal *raydir, - char *target, char *tframe, char *abcorr, char *obsrvr, doublereal * - time, logical *vistat, ftnlen inst_len, ftnlen tshape_len, ftnlen - target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len) -{ - return zzgffvu_0_(0, inst, tshape, raydir, target, tframe, abcorr, obsrvr, - time, vistat, inst_len, tshape_len, target_len, tframe_len, - abcorr_len, obsrvr_len); - } - -/* Subroutine */ int zzgffvin_(char *inst, char *tshape, doublereal *raydir, - char *target, char *tframe, char *abcorr, char *obsrvr, ftnlen - inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, - ftnlen abcorr_len, ftnlen obsrvr_len) -{ - return zzgffvu_0_(1, inst, tshape, raydir, target, tframe, abcorr, obsrvr, - (doublereal *)0, (logical *)0, inst_len, tshape_len, target_len, - tframe_len, abcorr_len, obsrvr_len); - } - -/* Subroutine */ int zzgffvst_(doublereal *time, logical *vistat) -{ - return zzgffvu_0_(2, (char *)0, (char *)0, (doublereal *)0, (char *)0, ( - char *)0, (char *)0, (char *)0, time, vistat, (ftnint)0, (ftnint) - 0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzgflong.c b/ext/spice/src/cspice/zzgflong.c deleted file mode 100644 index 45c160f38f..0000000000 --- a/ext/spice/src/cspice/zzgflong.c +++ /dev/null @@ -1,3014 +0,0 @@ -/* zzgflong.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__7 = 7; -static integer c__0 = 0; -static integer c__1 = 1; -static doublereal c_b69 = 1.; -static doublereal c_b70 = 0.; - -/* $Procedure ZZGFLONG ( GF, longitude solver ) */ -/* Subroutine */ int zzgflong_(char *vecdef, char *method, char *target, char - *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char * - crdsys, char *crdnam, char *relate, doublereal *refval, doublereal * - tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, U_fp - udrepi, U_fp udrepu, U_fp udrepf, logical *bail, L_fp udbail, integer - *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal * - result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, - ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, - ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len) -{ - /* Initialized data */ - - static char ops[6*7] = "< " "= " "> " "LOCMIN" "ABSMIN" "LOC" - "MAX" "ABSMAX"; - static doublereal y[3] = { 0.,1.,0. }; - - /* System generated locals */ - integer work_dim1, work_dim2, work_offset, i__1, i__2, i__3, i__4; - doublereal d__1, d__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - double cos(doublereal); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - double sqrt(doublereal), sin(doublereal), atan2(doublereal, doublereal); - - /* Local variables */ - integer head, node, left, quad; - logical flip; - integer next; - extern /* Subroutine */ int zzgfcodc_(), zzgfcocd_(); - extern /* Subroutine */ int zzgfcocg_(doublereal *, doublereal *); - extern /* Subroutine */ int zzgfcocl_(), zzgfcosd_(); - extern /* Subroutine */ int zzgfcoin_(char *, char *, char *, char *, - char *, char *, char *, doublereal *, char *, char *, doublereal * - , ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, - ftnlen), zzgfcosg_(doublereal *, doublereal *); - extern /* Subroutine */ int zzgfcosl_(), zzgfcolt_(), zzgfcour_(); - integer i__; - extern integer cardd_(doublereal *); - integer n, s; - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), lnkan_( - integer *, integer *); - integer class__, compl; - logical found; - doublereal value; - integer right; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), copyd_( - doublereal *, doublereal *), repmi_(char *, char *, integer *, - char *, ftnlen, ftnlen, ftnlen); - integer total, f1, f2; - char rlist[32*7]; - doublereal r2ovr2, start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern doublereal twopi_(void); - integer q1, q2, q3, q4; - extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen); - extern logical failed_(void); - extern doublereal pi_(void); - doublereal cv, et; - integer nl; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - lnknxt_(integer *, integer *), wncard_(doublereal *); - extern logical return_(void), smsgnd_(doublereal *, doublereal *); - char nrmcrd[32], nrmsys[32], prxcrd[32], prxfun[50], prxsys[32], rctrnm[ - 36], rptpre[80*2], rptsuf[80*2], tmplat[80], prxrel[6]; - doublereal cmpval, extval, locref, loctol, prxval, sv, xrfval; - integer clssid, frcode, needwn[13], refctr, region[3]; - doublereal alt, lat; - integer wh, wwpool[26] /* was [2][13] */, bot; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - doublereal lon; - integer res; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssized_(integer *, doublereal *), lnkini_(integer *, - integer *), cmprss_(char *, integer *, char *, char *, ftnlen, - ftnlen, ftnlen); - integer top; - char uop[6]; - extern /* Subroutine */ int scardd_(integer *, doublereal *); - integer wix[7]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *), recpgr_( - char *, doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, ftnlen), wninsd_(doublereal *, - doublereal *, doublereal *), wndifd_(doublereal *, doublereal *, - doublereal *), wnunid_(doublereal *, doublereal *, doublereal *), - lnkila_(integer *, integer *, integer *), wnintd_(doublereal *, - doublereal *, doublereal *), ssizei_(integer *, integer *), - insrti_(integer *, integer *), lnkfsl_(integer *, integer *, - integer *), zzgfcog_(doublereal *, doublereal *), zzgfrel_(U_fp, - U_fp, U_fp, U_fp, S_fp, U_fp, char *, doublereal *, doublereal *, - doublereal *, doublereal *, integer *, integer *, doublereal *, - logical *, U_fp, U_fp, U_fp, char *, char *, logical *, L_fp, - doublereal *, ftnlen, ftnlen, ftnlen); - integer res1, res2; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine determines time windows when the longitude */ -/* or right ascension of a specified vector satisfies a specified */ -/* mathematical condition. */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* GEOMETRY */ -/* PRIVATE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P Cell lower bound. */ -/* VECDEF I Vector definition. */ -/* METHOD I Computation method. */ -/* TARGET I Target name. */ -/* REF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSRVR I Observer name. */ -/* DREF I Ray's direction vector frame. */ -/* DVEC I Ray's direction vector. */ -/* CRDSYS I Coordinate system name. */ -/* CRDNAM I Coordinate name. */ -/* RELATE I Relational operator. */ -/* REFVAL I Reference value. */ -/* TOL I Convergence tolerance. */ -/* ADJUST I Absolute extremum adjustment value. */ -/* UDSTEP I Step size routine. */ -/* UDREFN I Search refinement routine. */ -/* RPT I Progress report flag. */ -/* UDREPI I Progress report initialization routine. */ -/* UDREPU I Progress report update routine. */ -/* UDREPF I Progress report termination routine. */ -/* BAIL I Bail-out flag. */ -/* UDBAIL I Bail-out status function. */ -/* MW I Workspace window size. */ -/* NW I Workspace window count. */ -/* WORK I-O Workspace window array. */ -/* CNFINE I Confinement window. */ -/* RESULT O Result window. */ - -/* $ Detailed_Input */ - - -/* VECDEF Every coordinate computed by this routine is a */ -/* function of an underlying vector. VECDEF is a short */ -/* string describing the means by which the vector of */ -/* interest is defined. Only parameters from the Fortran */ -/* INCLUDE file zzgf.inc should be used. Parameter names */ -/* and meanings are: */ - -/* POSDEF Vector is position of */ -/* target relative to observer. */ - -/* SOBDEF Vector is sub-observer */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* SINDEF Vector is ray-surface intercept */ -/* point on target body. Vector */ -/* points from target body */ -/* center to sub-observer point. */ -/* The target must be an extended */ -/* body modeled as a triaxial */ -/* ellipsoid. */ - -/* Case, leading and trailing blanks ARE significant */ -/* in the string VECDEF. */ - - -/* METHOD is a string specifying the computational method */ -/* applicable to the vector of interest. When VECDEF */ -/* is the parameter */ - -/* SOBDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SUBPNT. */ - -/* When VECDEF is the parameter */ - -/* SINDEF */ - -/* METHOD should be set to one of the values accepted */ -/* by the SPICELIB routine SINCPT. */ - -/* METHOD is ignored if VECDEF is set to */ - -/* POSDEF */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string METHOD. */ - - -/* TARGET is the name of the target object. */ - - -/* REF is the name of the reference frame relative to which */ -/* the vector of interest is specified. The specified */ -/* condition applies to the specified coordinate of */ -/* of this vector in frame REF. */ - -/* When geodetic coordinates are used, the reference */ -/* ellipsoid is assumed to be that associated with */ -/* the central body of the frame designated by REF. */ -/* In this case, the central body of the frame must */ -/* be an extended body. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* 'NONE' No correction. */ -/* 'LT' Light time only. */ -/* 'LT+S' Light time and stellar aberration. */ -/* 'CN' Converged Newtonian (CN) light time. */ -/* 'CN+S' CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* 'XLT' Light time only. */ -/* 'XLT+S' Light time and stellar aberration. */ -/* 'XCN' Converged Newtonian (CN) light time. */ -/* 'XCN+S' CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSRVR is the name of the observer. */ - - -/* DREF is the name of the reference frame relative to which a */ -/* ray's direction vector is expressed. This may be any */ -/* frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and leading */ -/* and trailing blanks in DREF are not significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the frame's */ -/* center is located elsewhere, then letting LTCENT be */ -/* the one-way light time between the observer and the */ -/* central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* CRDSYS is the name of the coordinate system to which the */ -/* coordinate of interest belongs. Allowed values are */ -/* those defined in the GF Fortran INCLUDE file */ - -/* zzgf.inc. */ - -/* CRDSYS must refer to a system in which longitude */ - -/* or right ascension is a coordinate. Note that when */ -/* geodetic coordinates are used, the reference ellipsoid */ -/* is that associated with the central body of the */ -/* reference frame designated by REF. The central body */ -/* must be an extended body in this case. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string CRDSYS. */ - - -/* CRDNAM is the name of the coordinate of interest: this is */ -/* the coordinate to which the specified condition */ -/* applies. Supported coordinates are */ - -/* Planetocentric longitude */ -/* Right ascension */ - -/* which are designated respectively by the parameters */ - -/* LONCRD */ -/* RACRD */ - -/* See the INCLUDE file */ - -/* zzgf.inc */ - -/* for the declarations of these parameters. */ - -/* For the */ - -/* Latitudinal */ -/* Geodetic */ -/* Spherical */ - -/* coordinate systems, longitude lies in the range */ - -/* ( -pi, pi ] */ - -/* For the */ - -/* Cylindrical */ -/* Planetographic */ - -/* coordinate systems, longitude lies in the range */ - -/* [ 0, 2*pi ) */ - -/* Right ascension lies in the range */ - -/* [ 0, 2*pi ) */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string CRDNAM. */ - - -/* RELATE is a relational operator used to define a constraint */ -/* on longitude or right ascension of the specified */ -/* vector. The result window found by this routine */ -/* indicates the time intervals where the constraint is */ -/* satisfied. Supported values of RELATE and */ -/* corresponding meanings are shown below: */ - -/* '>' Longitude or RA is greater than the */ -/* reference value REFVAL. */ - -/* '=' Longitude or RA is equal to the reference */ -/* value REFVAL. */ - -/* '<' Longitude or RA is less than the */ -/* reference value REFVAL. */ - - -/* 'ABSMAX' Longitude or RA is at an absolute maximum. */ - -/* 'ABSMIN' Longitude or RA is at an absolute */ -/* minimum. */ - -/* 'LOCMAX' Longitude or RA is at a local maximum. */ - -/* 'LOCMIN' Longitude or RA is at a local minimum. */ - -/* The caller may indicate that the region of interest */ -/* is the set of time intervals where the quantity is */ -/* within a specified tolerance of an absolute extremum. */ -/* The argument ADJUST (described below) is used to */ -/* specify this tolerance. */ - -/* Local extrema are considered to exist only in the */ -/* interiors of the intervals comprising the confinement */ -/* window: a local extremum cannot exist at a boundary */ -/* point of the confinement window. */ - -/* Case is not significant in the string RELATE. */ - - -/* REFVAL is the reference value used to define equality or */ -/* inequality conditions. */ - -/* REFVAL has units of radians. */ - -/* When the coordinate of interest is longitude, REFVAL */ -/* is interpreted as though it were translated, if */ -/* necessary, by an integer multiple of 2*pi to place it */ -/* in the standard range for longitude: (-pi, pi]. */ -/* Similarly, when the coordinate of interest is right */ -/* ascension, REFVAL is interpreted as though it were */ -/* translated, if necessary, by an integer multiple of */ -/* 2*pi into the range [0, 2*pi). */ - -/* Example: suppose REFVAL is set to -4.5. Then the */ -/* condition */ - -/* longitude equals REFVAL */ - -/* is interpreted as */ - -/* longitude equals -0.5 * pi */ - -/* so the solution window for this condition may well */ -/* be non-empty. */ - -/* REFVAL is ignored if RELATE is not an equality or */ -/* inequality operator. */ - - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in TDB */ -/* seconds and is greater than zero. */ - - -/* ADJUST The amount by which the coordinate is allowed to vary */ -/* from an absolute extremum. ADJUST is not used for */ -/* equality or inequality conditions. ADJUST must not be */ -/* negative. */ - -/* If ADJUST is positive and a search for an absolute */ -/* minimum is performed, the resulting schedule contains */ -/* time intervals when the specified coordinate has */ -/* values between */ - -/* ABSMIN */ -/* and MIN ( ABSMIN + ADJUST, MX ) */ - -/* where MX is the maximum value of the coordinate's */ -/* range. */ - -/* If the search is for an absolute maximum, the */ -/* corresponding range is between */ - -/* MAX ( ABSMAX - ADJUST, MN ) */ -/* and ABSMAX */ - -/* where MN is the minimum value of the coordinate's */ -/* range. */ - - -/* UDSTEP is a routine that computes a time step used to search */ -/* for a transition of the state of the specified */ -/* coordinate. In the context of this routine's */ -/* algorithm, a "state transition" occurs where the */ -/* coordinate's time derivative changes from negative to */ -/* non-negative or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. ET is a DOUBLE PRECISION number. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. STEP is a DOUBLE */ -/* PRECISION number. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine GFSTEP */ -/* may be used. GFSTEP returns the step size that was set */ -/* via the most recent call to GFSSTP. */ - - -/* UDREFN is the name of the externally specified routine that */ -/* computes a refinement in the times that bracket a */ -/* transition point. In other words, once a pair of */ -/* times have been detected such that the system is in */ -/* different states at each of the two times, UDREFN */ -/* selects an intermediate time which should be closer to */ -/* the transition state than one of the two known times. */ -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 is a time when the system is in state S1. T1 */ -/* is a DOUBLE PRECISION number. */ - -/* T2 is a time when the system is in state S2. T2 */ -/* is a DOUBLE PRECISION number and is assumed */ -/* to be larger than T1. */ - -/* S1 is the state of the system at time T1. */ -/* S1 is a LOGICAL value. */ - -/* S2 is the state of the system at time T2. */ -/* S2 is a LOGICAL value. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T is next time to check for a state transition. */ -/* T is a DOUBLE PRECISION number between T1 and */ -/* T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. This is the default option. */ - - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is on or off; setting RPT */ -/* to .TRUE. enables progress reporting. */ - - -/* UDREPI is a user-defined subroutine that initializes a */ -/* progress report. When progress reporting is */ -/* enabled, UDREPI is called at the start of a search */ -/* pass (see the implementation of ZZGFREL for details on */ -/* search passes). The calling sequence of UDREPI is */ - -/* UDREPI ( CNFINE, RPTPRE, RPTSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) RPTPRE */ -/* CHARACTER*(*) RPTSUF */ - -/* where */ - -/* CNFINE */ - -/* is the confinement window passed into ZZGFREL, and */ - -/* RPTPRE */ -/* RPTSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. */ - -/* SPICELIB provides the default progress reporting */ -/* initialization routine GFREPI. If GFREPI is used, then */ -/* the progress reporting update and termination routines */ -/* GFREPU and GFREPF must be used as well. */ - - -/* UDREPU is a user-defined subroutine that updates the */ -/* progress report for a search pass. The calling */ -/* sequence of UDREPU is */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the search's */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - - -/* UDREPF is a user-defined subroutine that finalizes a */ -/* progress report. UDREPF has no arguments. */ - - -/* BAIL is a logical flag indicating whether or not interrupt */ -/* signal handling is enabled. Setting BAIL to .TRUE. */ -/* enables interrupt signal handling: the GF system will */ -/* then call UDBAIL to check for interrupt signals. */ - - -/* UDBAIL is the name of a user defined logical function that */ -/* checks to see whether an interrupt signal has been */ -/* issued from, e.g. the keyboard. UDBAIL is used only */ -/* when BAIL is set to .TRUE. If interrupt handling is */ -/* not used, the SPICELIB function GFBAIL should be */ -/* passed in as the actual bail-out function argument. */ - - -/* MW is the cell size of the windows in the workspace array */ -/* WORK. */ - - -/* NW is the number of windows in the workspace array WORK. */ -/* NW must be at least as large as the parameter NWMAX. */ - - -/* WORK is an array used to store workspace windows. This */ -/* array has dimensions ( LBCELL : MW, NW). */ - -/* The windows contained WORK that used by this routine */ -/* are initialized here to have size MW. The other */ -/* elements of WORK are not modified. */ - - -/* CNFINE is a SPICE window that confines the bounds of the */ -/* search. */ - -/* For coordinates defined by ray-target surface */ -/* intercepts, the intercept and its time derivative are */ -/* expected to be computable on the confinement window. */ - - -/* RESULT is an initialized SPICE window. RESULT must be large */ -/* enough to hold all of the intervals, within the */ -/* confinement window, on which the specified condition */ -/* is met. */ - -/* RESULT must be initialized by the caller via the */ -/* SPICELIB routine SSIZED. */ - -/* $ Detailed_Output */ - - -/* WORK has undefined contents on output, with the exception */ -/* of the windows occupying the range */ - -/* ( LBCELL : NW, EXWIDX : NWMAX ) */ - -/* which are not modified by this routine. */ - -/* RESULT is a SPICELIB window containing the intersection of */ -/* the confinement window and the set of time intervals */ -/* when the value of the specified coordinate satisfies */ -/* constraints specified by RELATE and ADJUST. */ - -/* For coordinates defined by ray-target surface */ -/* intercepts, RESULT is further restricted to the window */ -/* over which the intercept and its derivative with */ -/* respect to time are computable. See the description of */ -/* CNFINE above for details. */ - -/* Due to computational accuracy limitations, the */ -/* coordinate of interest *may not satisfy the */ -/* specified condition* at all points belonging to */ -/* RESULT. For example, if the caller specifies */ -/* a tolerance of 1.E-6 seconds and seeks the */ -/* solution set for the condition */ - -/* The planetocentric longitude of the geometric */ -/* earth-sun vector in the J2000 frame is greater */ -/* than or equal to zero */ - -/* the right endpoints of some intervals in RESULT may be */ -/* times that map to negative longitude values very close */ -/* to -pi radians. */ - -/* The user (of SPICE API routines dependent on this */ -/* routine) may wish to contract RESULT using WNCOND in */ -/* order to guarantee that the specified condition */ -/* is satisfied on RESULT. Selection of a suitable */ -/* contraction value is dependent on the user's */ -/* requirements and the specific problem to be solved. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* $ Exceptions */ - -/* 1) In order for this routine to produce correct results, */ -/* the external step size routine UDGSTP must return step sizes */ -/* appropriate for the problem at hand. Step sizes that */ -/* are too large may cause this routine to miss roots; */ -/* step sizes that are too small may cause this routine to */ -/* run unacceptably slowly and in some cases, find spurious */ -/* roots. */ - -/* This routine does not diagnose invalid step sizes, */ -/* except that if the step size is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 2) In order for this routine to produce correct results, */ -/* the convergence tolerance TOL must be appropriate for the */ -/* problem at hand. The error in any interval endpoint */ -/* contained in RESULT should be expected to be no smaller */ -/* than TOL; depending on the behavior of the coordinate */ -/* and the condition, the error could be much larger. For */ -/* example, for some functions, finding correct, unique */ -/* extrema is notoriously difficult. */ - -/* The user should keep in mind that the minimum separation */ -/* between successive values of ET is about 1.E-7 seconds */ -/* for SPICE platforms and values of ET not extremely close to */ -/* J2000. */ - -/* This routine does not diagnose invalid tolerance values, */ -/* except that if the tolerance is non-positive, the error */ -/* SPICE(VALUEOUTOFRANGE) is signaled. */ - -/* 3) A negative value for ADJUST causes the routine to signal */ -/* the error SPICE(VALUEOUTOFRANGE). A non-zero value for ADJUST */ -/* when RELATE has any value other than "ABSMIN" or "ABSMAX", */ -/* causes the routine to signal the error SPICE(INVALIDVALUE). */ - -/* 4) If the operator string RELATE doesn't contain a recognized */ -/* value, the error SPICE(NOTRECOGNIZED) is signaled. */ - -/* 5) If any error occurs while initializing the coordinate */ -/* utility package, the error will be diagnosed by routines */ -/* in the call tree of ZZGFCOIN. */ - -/* 6) If any error occurs while performing computations */ -/* to determine if a quantity of interest is decreasing */ -/* at a specified time, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 7) If any error occurs while performing computations */ -/* to determine if a quantity of interest is less than a */ -/* specified reference value at a specified time, the error will */ -/* be diagnosed by routines in the call tree of this routine. */ - -/* 8) If an error (typically cell overflow) occurs while performing */ -/* window arithmetic, the error will be diagnosed by */ -/* routines in the call trees of window routines called by */ -/* this routine. */ - -/* 9) Due to numerical errors, in particular, */ - -/* - Truncation error in time values */ -/* - Finite tolerance value */ -/* - Errors in computed geometric quantities */ - -/* it is *normal* that the condition of interest is not */ -/* satisfied on the entire result window. */ - -/* The result window may need to be contracted slightly by the */ -/* caller to achieve desired results, in particular to remove */ -/* times where discontinuities of longitude or right ascension */ -/* are crossed. */ - -/* 10) Most relational conditions involving longitude or */ -/* right ascension make sense only when latitude or declination */ -/* is bounded away from +/- pi/2 radians. Users should */ -/* select the confinement window accordingly. */ - -/* 11) The user must take care when searching for an extremum */ -/* (ABSMAX, ABSMIN, LOCMAX, LOCMIN) of LONGITUDE or */ -/* RIGHT ASCENSION values. Since these quantities are cyclical, */ -/* rather than monotonically increasing or decreasing, an */ -/* extremum may be hard to interpret. In particular, if an */ -/* extremum is found near the cycle boundary (- PI for */ -/* longitude, 2 PI for RIGHT ASCENSION) it may not be */ -/* numerically reasonable. For example, the search for times */ -/* when a longitude coordinate is at its absolute maximum may */ -/* result in a time when the longitude value is - PI, due to */ -/* roundoff error. */ - -/* $ Files */ - -/* This routine doesn't directly participate in SPICE kernel loading */ -/* or unloading. However, a variety of SPICE kernels must be loaded */ -/* in order for this routine to work: */ - -/* - Since all coordinate computations supported by this routine */ -/* depend on observer-target vectors, at a minimum, SPK files */ -/* providing ephemeris data enabling computation of these */ -/* vectors are required. */ - -/* - If non-inertial reference frames are used, then PCK */ -/* files, frame kernels, C-kernels, and SCLK kernels may be */ -/* needed. */ - -/* - If the coordinate of interest is defined in terms of a target */ -/* surface point, then (currently) a PCK providing radii for a */ -/* triaxial shape model must be loaded. */ - -/* - If geodetic coordinates are used, then a PCK providing radii */ -/* for a triaxial shape model must be loaded. */ - -/* See the Files section of GFEVNT's header for further information. */ - - -/* $ Particulars */ - -/* Since this is a private SPICELIB routine, the header comments */ -/* make many references to the routine's implementation. This */ -/* is done to help the maintenance programmer understand the */ -/* routine; however, these comments may themselves need to be */ -/* updated if the GF subsystem implementation changes. */ - -/* This routine determines time windows when the longitude or right */ -/* ascension of a specified vector satisfies a specified */ -/* mathematical condition. This routine can (in some cases, by */ -/* means of multiple calls) answer questions such as */ - -/* When does the moon pass over the earth's prime meridian? */ - -/* Given a time window when the geodetic latitude of the MGS */ -/* spacecraft relative to the IAU_MARS frame is between -30 : +30 */ -/* degrees, when within this window is the planetographic */ -/* longitude of the spacecraft between 15 and 16 degrees? */ - -/* For brevity, throughout this routine, we'll refer to the vector */ -/* whose longitude or right ascension is of interest as "the vector" */ -/* or "the vector of interest." We'll also call the longitude or */ -/* right ascension "the coordinate" or "the coordinate of interest." */ - -/* A note concerning processing speed: the algorithm used by this */ -/* routine takes a "divide and conquer" approach that involves, in */ -/* many cases, multiple calls to the low-level GF root finding */ -/* routines. So the user can expect most longitude or right */ -/* ascension computations to be relatively slow. Using a */ -/* confinement window that is more easily computed, say one */ -/* involving latitude constraints, can be very helpful. */ - -/* $ Examples */ - -/* See usage in GFEVNT. */ - -/* $ Restrictions */ - -/* 1) The interface and functionality of this routine may change */ -/* without notice. This routine should be called only by */ -/* SPICELIB routines. */ - -/* 2) Root-finding problems of the sort solved by this routine are, */ -/* when a computer is involved, replete with mathematical */ -/* complications. We've tried to cover all the angles in the */ -/* Detailed_Input, Detailed_Output, and Exceptions header */ -/* sections. No doubt some issues remain unaddressed. Correct */ -/* usage of this routine depends in good measure on the user */ -/* posing "reasonable" problems to solve. */ - -/* 3) The kernel files to be used by ZZGFLONG must be loaded */ -/* (normally via the SPICELIB routine FURNSH) before ZZGFLONG is */ -/* called. */ - -/* 4) This routine has the side effect of re-initializing the */ -/* coordinate quantity utility package. Callers may themselves */ -/* need to re-initialize the coordinate quantity utility package */ -/* after calling this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */ - -/* Upgraded to support targets and observers having */ -/* no names associated with their ID codes. */ - -/* - SPICELIB Version 1.0.0 23-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Entry points in the coordinate utility package. */ -/* We have the usual GF entry points for the coordinate, plus */ -/* utilities for the cosine and sine of the coordinate. */ - -/* Names and meanings: */ - -/* ZZGFCODC Is coordinate decreasing? */ -/* ZZGFCOLT Is coordinate less than the reference value? */ -/* ZZGFCOG Get coordinate value. */ -/* ZZGFCOUR Reset coordinate reference value. */ -/* ZZGFCOCD Is cosine of the coordinate decreasing? */ -/* ZZGFCOCL Is cosine of the coordinate less than */ -/* the reference value? */ -/* ZZGFCOCG Get cosine of the coordinate value. */ -/* ZZGFCOSD Is sine of the coordinate decreasing? */ -/* ZZGFCOSL Is sine of the coordinate less than */ -/* the reference value? */ -/* ZZGFCOSG Get sine of the coordinate value. */ - - -/* Local parameters */ - - - -/* Margin for branch cut avoidance. Units are radians: */ - - -/* Margin for local extrema search. Units are radians: */ - - -/* Short alias for LBCELL: */ - - -/* Number of supported comparison operators: */ - - -/* Assorted string lengths: */ - -/* Maximum body name length: */ - - -/* NAMLEN is the maximum length of both a frame name and of */ -/* any kernel pool variable name. */ - - -/* OPLEN is the maximum string length for comparison operators. */ -/* OPLEN may grow if new comparisons are added. */ - - -/* FUNLEN is the length of the function name string. */ - - -/* CRDLEN is the maximum length of a coordinate name. */ - - -/* SYSLEN is the maximum length of a coordinate system name. */ - - -/* RPTLEN is the maximum length of a progress reporter message. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_dim2 = *nw; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGFLONG", (ftnlen)8); - } - -/* Overview */ -/* ======== */ - - -/* Terminology */ -/* ----------- */ - -/* - Proxy function */ - -/* In many cases, instead of finding a time window */ -/* where the coordinate of interest satisfies a specified */ -/* condition, we'll find a time window where a second, related */ -/* function satisfies a related condition. We'll call this */ -/* second function the "proxy function." */ - -/* The proxy function will be one that is "better behaved" */ -/* than the original in the domain of interest. For */ -/* example, when searching for times when longitude is */ -/* equal to pi radians, we may instead intersect the */ -/* confinement window with a window on which cosine of */ -/* longitude is negative, and then within that more */ -/* restricted intersection, find the times when the sine */ -/* of longitude is zero. In this example sine(longitude) */ -/* is a proxy function for longitude. */ - -/* - Resolution of a function */ - -/* Below we'll refer to the "resolution" of a proxy function. */ -/* In order to find roots accurately, it's necessary for */ -/* a proxy function to change a by a reasonable amount */ -/* when the function it represents changes. Mathematically, */ -/* the magnitude of the derivative of the proxy function */ -/* with respect to the function it represents should not */ -/* be too much less than 1. An example of a *bad* choice */ -/* of a proxy function would be to use cosine of longitude */ -/* as a proxy function for longitude in a confinement */ -/* window in which longitude is close to zero. This */ -/* choice would lead to considerable loss of accuracy. On */ -/* the other hand, sine of longitude would be a reasonable */ -/* proxy function for this case. */ - -/* - The unit circle */ - -/* In the discussion below, we'll freely associate angular */ -/* coordinates with locations on the unit circle. For example, */ -/* we might say "longitude is in the upper half of the unit */ -/* circle." */ - -/* - Window aliases */ - -/* We're going to make extensive use workspace windows. */ -/* In many cases, we'll need to reuse various windows for */ -/* different purposes at different times. So instead */ -/* of using mnemonic parameter names for window indices, */ -/* we'll use variables we call window aliases. For example, */ -/* when we want to use the 8th workspace window to hold */ -/* the window of times when longitude is in the upper half */ -/* of the unit circle, we'll set the alias UPPER equal to */ -/* 8, so we can refer to the window by */ - -/* WORK( LB, UPPER ) */ - -/* and keep track of what we're using the window for. */ - -/* Some of the aliases aren't wonderful names: we use */ -/* F1, F2, etc. to represent "free" window 1, 2, etc. */ - - -/* Algorithm */ -/* --------- */ - -/* - Equality */ - -/* We use sine or cosine of the coordinate as proxy functions. */ -/* The proxy function having the better resolution is */ -/* selected. For example, to find times when right ascension */ -/* is 2*pi/3, we search for the times when cosine of right */ -/* ascension is equal to -1/2. Since these searches can produce */ -/* spurious roots, we cast out any such roots after completing */ -/* the search. */ - - -/* - Local extrema */ - -/* We first find local extrema in the right and left half */ -/* circles, using longitude as a proxy function on the right */ -/* half and right ascension on the left. */ - - -/* - Absolute extrema */ - -/* We deal with absolute extrema before inequalities because */ -/* this allows us to use the code (later in this routine) for */ -/* inequality relations when the user specifies a non-zero */ -/* ADJUST value. When ADJUST is non-zero, having the actual */ -/* extreme value in hand, we can easily solve for the window */ -/* in which the coordinate is greater than */ - -/* - ADJUST */ - -/* or less than */ - -/* + ADJUST */ - -/* Below, "Searching in a region" means that we find the */ -/* window when the coordinate is in the region (and of course */ -/* in the confinement window), then use this window as the */ -/* confinement window. */ - -/* Finding absolute extrema is a matter of successively */ -/* searching for extrema in different parts of the unit */ -/* circle. For example, when we search for an absolute */ -/* maximum of longitude, we first search in the second */ -/* quadrant, then if we find nothing, the right half circle, */ -/* then if we find nothing, the fourth quadrant. */ - -/* We always use longitude as a proxy function on the right */ -/* half circle and right ascension as a proxy function on */ -/* the left half circle. */ - - -/* - Inequality */ - -/* In general, we use proxy functions and break up the unit */ -/* circle into regions where the proxy functions are single */ -/* valued. The exact solution approach depends on where the */ -/* reference value is. For example, to find the window on */ -/* which longitude is less than 3*pi/4, we first search */ -/* for the solution in the second quadrant. We then */ -/* combine this result window with the window of times */ -/* when longitude is in the right half circle, and with */ -/* the window of times when longitude is in the third */ -/* quadrant. */ - - -/* Code layout */ -/* ----------- */ - -/* We've tried to arrange the code to minimize calls to */ -/* ZZGFREL, primarily because these expensive in terms of */ -/* run time. They also take up a lot of space. */ - -/* The code starts out by re-formulating the constraint, */ -/* if necessary, as one applying to planetocentric longitude */ -/* or right ascension. This simplifies the subsequent logic. */ - -/* Equality searches are handled before the rest. The routine */ -/* exits after processing a search having an equality constraint. */ - -/* Searches for local extrema are handled next. Again, the */ -/* routine exits after processing these types of searches. */ - -/* The next portion of the code is devoted to dealing with */ -/* absolute extrema. If the search is for absolute extrema and */ -/* AJDUST is non-zero, we use the results from this portion of */ -/* the code to set up an inequality search, which is done below. */ - -/* After the portion of the code dealing with absolute extrema */ -/* with ADJUST equal to zero, we perform setup functions to */ -/* prepare to call ZZGFREL. In general, what's happening here is */ -/* that we're deciding what regions of the unit circle we're */ -/* going to use in our solution, and we prepare to find windows */ -/* when the coordinate is in the various regions of interest. */ -/* This setup code includes assignment of window aliases, */ -/* selection of proxy functions, and setting flags indicating */ -/* which windows corresponding to search regions must be */ -/* computed. */ - -/* Next, the windows corresponding to times when the coordinate */ -/* is in the selected regions are found using ZZGFREL. */ - - -/* Check the workspace window count. */ - - if (*nw < 15) { - setmsg_("Workspace window count was # but must be at least #.", ( - ftnlen)52); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__15, (ftnlen)1); - sigerr_("SPICE(TOOFEWWINDOWS)", (ftnlen)20); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* We can't initialize the whole workspace, but we can initialize */ -/* the windows we actually own. Do so. */ - - for (i__ = 1; i__ <= 7; ++i__) { - ssized_(mw, &work[(i__1 = (i__ + 5) * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)1284)]); - } - -/* Initialize the workspace window pool. Set up the parallel */ -/* array of window indices. */ - - lnkini_(&c__7, wwpool); - for (i__ = 1; i__ <= 7; ++i__) { - wix[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", i__1, - "zzgflong_", (ftnlen)1294)] = i__ + 5; - } - -/* Get an upper case, left-justified version of the */ -/* requested comparison operation. */ - - ljust_(relate, uop, relate_len, (ftnlen)6); - ucase_(uop, uop, (ftnlen)6, (ftnlen)6); - -/* Reject bad operators. */ - -/* Use the original operator string in the error message. */ - - i__ = isrchc_(uop, &c__7, ops, (ftnlen)6, (ftnlen)6); - if (i__ == 0) { - setmsg_("The comparison operator, # is not recognized. Supported qu" - "antities are: <, =, >, LOCMIN, ABSMIN, LOCMAX, ABSMAX.", ( - ftnlen)113); - errch_("#", relate, (ftnlen)1, relate_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Make sure TOL is positive. */ - - if (*tol <= 0.) { - setmsg_("TOL was #; must be positive.", (ftnlen)28); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* We'll use a local tolerance equal to 1/5 of the input value. */ -/* This will allow us to keep the total round-off error within */ -/* the desired tolerance. */ - -/* Computing MAX */ - d__1 = 1e-7, d__2 = *tol / 10.; - loctol = max(d__1,d__2); - -/* Make sure ADJUST is non-negative. */ - - if (*adjust < 0.) { - setmsg_("ADJUST was #; must be non-negative.", (ftnlen)35); - errdp_("#", adjust, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Confirm ADJUST equals zero unless UOP (RELATE) has value */ -/* "ABSMAX" or "ABSMIN." */ - - if (s_cmp(uop, "ABSMIN", (ftnlen)6, (ftnlen)6) != 0 && s_cmp(uop, "ABSMAX" - , (ftnlen)6, (ftnlen)6) != 0) { - if (*adjust != 0.) { - setmsg_("ADJUST should have value zero for all comparison operat" - "ors except ABSMAX and ABSMIN", (ftnlen)83); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* Get an upper case, left-justified, compressed versions of the */ -/* coordinate system and coordinate names. */ - - ljust_(crdsys, nrmsys, crdsys_len, (ftnlen)32); - cmprss_(" ", &c__0, nrmsys, nrmsys, (ftnlen)1, (ftnlen)32, (ftnlen)32); - ucase_(nrmsys, nrmsys, (ftnlen)32, (ftnlen)32); - ljust_(crdnam, nrmcrd, crdnam_len, (ftnlen)32); - cmprss_(" ", &c__1, nrmcrd, nrmcrd, (ftnlen)1, (ftnlen)32, (ftnlen)32); - ucase_(nrmcrd, nrmcrd, (ftnlen)32, (ftnlen)32); - -/* Make an initial call to the coordinate utility initialization */ -/* routine to invoke error checking. We don't want to have */ -/* to duplicate the checking here. Later, when necessary, we'll */ -/* re-initialize the utilities. */ - - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, nrmsys, - nrmcrd, refval, vecdef_len, method_len, target_len, ref_len, - abcorr_len, obsrvr_len, dref_len, (ftnlen)32, (ftnlen)32); - if (failed_()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* We've done the basic error checking. Empty the result window and */ -/* return now if the confinement window is empty. */ - - if (wncard_(cnfine) == 0) { - scardd_(&c__0, result); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Initialize the total number of search passes performed. */ - - total = 0; - -/* To eliminate special cases, we'll check for inequality */ -/* constraints that are always met or can't be met. */ - - if (s_cmp(nrmsys, "CYLINDRICAL", (ftnlen)32, (ftnlen)11) == 0 || s_cmp( - nrmsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0 || s_cmp( - nrmsys, "RA/DEC", (ftnlen)32, (ftnlen)6) == 0) { - if (cos(*refval) == 1.) { - -/* The reference value lies on the branch cut at 0. */ - - if (s_cmp(uop, "<", (ftnlen)6, (ftnlen)1) == 0) { - -/* These coordinates can never be less than zero. */ - - scardd_(&c__0, result); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } else if (s_cmp(uop, ">", (ftnlen)6, (ftnlen)1) == 0) { - -/* The solution is the whole confinement window. This */ -/* is because the inequality operators really act like */ -/* '>=' and '<=' operators, and because we assume the */ -/* quantity is increasing or decreasing except on a */ -/* set of measure zero. */ - - copyd_(cnfine, result); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - } else if (s_cmp(nrmsys, "GEODETIC", (ftnlen)32, (ftnlen)8) == 0 || s_cmp( - nrmsys, "LATITUDINAL", (ftnlen)32, (ftnlen)11) == 0 || s_cmp( - nrmsys, "SPHERICAL", (ftnlen)32, (ftnlen)9) == 0) { - if (cos(*refval) == -1.) { - -/* The reference value lies on the branch cut at pi. */ - - if (s_cmp(uop, "<", (ftnlen)6, (ftnlen)1) == 0) { - -/* The solution is the whole confinement window. */ - - copyd_(cnfine, result); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } else if (s_cmp(uop, ">", (ftnlen)6, (ftnlen)1) == 0) { - -/* These coordinates can never be greater */ -/* than pi. */ - - scardd_(&c__0, result); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - } - -/* At this point, we make some adjustments to simplify the */ -/* remaining code. We map the input coordinate system to */ -/* either "latitudinal" or "RA/DEC" and modify the */ -/* constraint if the original system is "planetographic." */ -/* The longitude coordinate is renamed accordingly, if necessary. */ -/* The mapping is as follows: */ - -/* Spherical ( longitude range is (-pi, pi] ) -> Latitudinal */ - -/* Cylindrical ( longitude range is [0, 2*pi] ) -> RA/Dec */ -/* Longitude -> RA */ - -/* Planetographic ( longitude range is [0, 2*pi] ) -> RA/Dec */ -/* Longitude -> RA */ - - -/* For planetographic coordinates, if the longitude is positive */ -/* west, and since REFVAL does not lie on the branch cut, we can */ -/* make the following additional adjustments: */ - -/* Input relational operator Transformed operator */ -/* ------------------------- -------------------- */ -/* ABSMAX ABSMIN */ -/* ABSMAX - ADJUST ABSMIN + ADJUST */ -/* ABSMIN ABSMAX */ -/* ABSMIN + AJDUST ABSMAX - ADJUST */ -/* LOCMAX LOCMIN */ -/* LOCMIN LOCMAX */ -/* < REFVAL > 2*pi - REFVAL */ -/* > REFVAL < 2*pi - REFVAL */ -/* = REFVAL = 2*pi - REFVAL */ - - - xrfval = *refval; - if (s_cmp(nrmsys, "SPHERICAL", (ftnlen)32, (ftnlen)9) == 0) { - s_copy(nrmsys, "LATITUDINAL", (ftnlen)32, (ftnlen)11); - xrfval = *refval; - } else if (s_cmp(nrmsys, "CYLINDRICAL", (ftnlen)32, (ftnlen)11) == 0) { - s_copy(nrmsys, "RA/DEC", (ftnlen)32, (ftnlen)6); - s_copy(nrmcrd, "RIGHT ASCENSION", (ftnlen)32, (ftnlen)15); - xrfval = *refval; - } else if (s_cmp(nrmsys, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) { - s_copy(nrmsys, "RA/DEC", (ftnlen)32, (ftnlen)6); - s_copy(nrmcrd, "RIGHT ASCENSION", (ftnlen)32, (ftnlen)15); - -/* If the planetographic coordinates are positive West, we'll */ -/* need to transform the constraint and reference value. */ - -/* Get the name of the central body of frame REF. */ - -/* NOTE: We omit error checking here because ZZGFCOIN has done */ -/* it already. */ - - namfrm_(ref, &frcode, ref_len); - frinfo_(&frcode, &refctr, &class__, &clssid, &found); - if (failed_()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - if (! found) { - setmsg_("FRINFO didn't find data for frame # which has frame ID " - "code #. This frame should have been validated by ZZGFCOI" - "N.", (ftnlen)113); - errch_("#", ref, (ftnlen)1, ref_len); - errint_("#", &frcode, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - bodc2s_(&refctr, rctrnm, (ftnlen)36); - -/* Find the longitude of the +Y axis. If this longitude */ -/* is greater than pi, the sense is positive West. Note */ -/* that we don't need to use realistic values of the */ -/* equatorial radius and flattening factor: 1 and 0, */ -/* respectively, are just fine. */ - - recpgr_(rctrnm, y, &c_b69, &c_b70, &lon, &lat, &alt, (ftnlen)36); - -/* Planetographic longitude ranges from 0 to 2*pi, so */ -/* longitudes corresponding to positive Y values are */ -/* in the range pi to 2*pi. */ - - if (lon > pi_()) { - -/* Planetographic longitude for the frame center is positive */ -/* West. */ - -/* Note that no action is required to modify non-zero */ -/* extremum adjustment values. */ - - if (s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0) { - s_copy(uop, "ABSMIN", (ftnlen)6, (ftnlen)6); - } else if (s_cmp(uop, "ABSMIN", (ftnlen)6, (ftnlen)6) == 0) { - s_copy(uop, "ABSMAX", (ftnlen)6, (ftnlen)6); - } else if (s_cmp(uop, "LOCMAX", (ftnlen)6, (ftnlen)6) == 0) { - s_copy(uop, "LOCMIN", (ftnlen)6, (ftnlen)6); - } else if (s_cmp(uop, "LOCMIN", (ftnlen)6, (ftnlen)6) == 0) { - s_copy(uop, "LOCMAX", (ftnlen)6, (ftnlen)6); - } else if (s_cmp(uop, "=", (ftnlen)6, (ftnlen)1) == 0) { - xrfval = twopi_() - *refval; - } else if (s_cmp(uop, "<", (ftnlen)6, (ftnlen)1) == 0) { - s_copy(uop, ">", (ftnlen)6, (ftnlen)1); - xrfval = twopi_() - *refval; - } else if (s_cmp(uop, ">", (ftnlen)6, (ftnlen)1) == 0) { - s_copy(uop, "<", (ftnlen)6, (ftnlen)1); - xrfval = twopi_() - *refval; - } else { - -/* We shouldn't get here. */ - - setmsg_("Unexpected UOP value: #", (ftnlen)23); - errch_("#", uop, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } else { - -/* Longitude is positive East, so we treat */ -/* the constraint as though the coordinate were RA. */ - - xrfval = *refval; - } - } - -/* From this point on, we use: */ - -/* Coordinate system: NRMSYS */ -/* Coordinate: NRMCRD */ -/* Operator: UOP */ -/* Reference value: XRFVAL */ - - -/* The result window must be initialized by the caller of the GF */ -/* system (usually a user application). We simply empty the result */ -/* window here. */ - - scardd_(&c__0, result); - -/* We use the constant 0.5 * 2**0.5 quite a bit. Create a */ -/* "macro" variable for it. */ - - r2ovr2 = sqrt(2.) / 2.; - -/* Set the progress report suffix strings. */ - - s_copy(rptsuf, "done.", (ftnlen)80, (ftnlen)5); - s_copy(rptsuf + 80, "done.", (ftnlen)80, (ftnlen)5); - -/* Case: '=' */ - - if (s_cmp(uop, "=", (ftnlen)6, (ftnlen)1) == 0) { - -/* Equality constraints are the simplest to handle, so we'll get */ -/* them out of the way now. Our approach is to use sine or cosine */ -/* as proxy functions; we'll select the proxy function with the */ -/* highest resolution at the reference value. For the proxy */ -/* function f, our proxy constraint is */ - -/* f(x) = f(XRFVAL) */ - -/* This may yield spurious roots; we'll delete these after we've */ -/* done our search. */ - -/* Find the sine and cosine of the reference value. We'll use */ -/* these both to locate the quadrant of the reference value and */ -/* to have continuously differentiable functions to work with. */ -/* Note that if the original reference value is not in the */ -/* standard range, this presents no problem. */ - - cv = cos(xrfval); - sv = sin(xrfval); - -/* Decide which proxy function to use. */ - - if (abs(sv) >= r2ovr2) { - -/* The reference value lies in the top or bottom quarter of */ -/* the unit circle. The "comparison value" CMPVAL will be */ -/* used later to delete solutions with matching sines but */ -/* non-matching cosines. */ - - s_copy(prxfun, "COS", (ftnlen)50, (ftnlen)3); - prxval = cv; - cmpval = sv; - } else { - s_copy(prxfun, "SIN", (ftnlen)50, (ftnlen)3); - prxval = sv; - cmpval = cv; - } - -/* Set up the progress reporting prefix strings. We have one */ -/* ZZGFREL call which performs two passes. */ - - s_copy(rptpre, "Coordinate pass 1 of 2", (ftnlen)80, (ftnlen)22); - s_copy(rptpre + 80, "Coordinate pass 2 of 2", (ftnlen)80, (ftnlen)22); - -/* Allocate a workspace window. */ - - lnkan_(wwpool, &node); - f1 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)1746)]; - -/* Make sure the coordinate utilities have been initialized */ -/* with the actual values we'll use for our search. */ - - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - nrmsys, nrmcrd, &prxval, vecdef_len, method_len, target_len, - ref_len, abcorr_len, obsrvr_len, dref_len, (ftnlen)32, ( - ftnlen)32); - -/* Now we're ready to compute the window in which our proxy */ -/* function satisfies the proxy constraint. */ - - if (s_cmp(prxfun, "SIN", (ftnlen)50, (ftnlen)3) == 0) { - -/* Find the window where the sine of the coordinate satisfies */ -/* the proxy constraint. */ - - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcosd_, (U_fp) - zzgfcosl_, (S_fp)zzgfcosg_, (U_fp)zzgfcour_, "=", &prxval, - &loctol, &c_b70, cnfine, mw, nw, work, rpt, (U_fp)udrepi, - (U_fp)udrepu, (U_fp)udrepf, rptpre, rptsuf, bail, (L_fp) - udbail, &work[(i__1 = f1 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)1765)], (ftnlen)1, (ftnlen)80, - (ftnlen)80); - } else { - -/* Find the window where the cosine of the coordinate */ -/* satisfies the proxy constraint. */ - - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcocd_, (U_fp) - zzgfcocl_, (S_fp)zzgfcocg_, (U_fp)zzgfcour_, "=", &prxval, - &loctol, &c_b70, cnfine, mw, nw, work, rpt, (U_fp)udrepi, - (U_fp)udrepu, (U_fp)udrepf, rptpre, rptsuf, bail, (L_fp) - udbail, &work[(i__1 = f1 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)1778)], (ftnlen)1, (ftnlen)80, - (ftnlen)80); - } - if (failed_()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Handle interrupts if necessary. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* Remove any spurious results. */ - - n = cardd_(&work[(i__1 = f1 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)1806)]); - i__1 = n; - for (i__ = 1; i__ <= i__1; i__ += 2) { - start = work[(i__2 = i__ + f1 * work_dim1 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", - i__2, "zzgflong_", (ftnlen)1810)]; - if (s_cmp(prxfun, "SIN", (ftnlen)50, (ftnlen)3) == 0) { - -/* Get the cosine of the coordinate at the interval start */ -/* time. If this cosine has the same sign as the cosine of */ -/* the reference value, we have a winner. Note that the */ -/* cosines of spurious values won't ever be close to the */ -/* correct values, so round-off isn't an issue. */ - - zzgfcocg_(&start, &value); - } else { - -/* Same deal, but here we're using sines. */ - - zzgfcosg_(&start, &value); - } - if (smsgnd_(&cmpval, &value)) { - -/* This is a winner. */ - - wninsd_(&start, &start, result); - } - } - -/* All done. */ - - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Case: local minimum or local maximum */ - - if (s_cmp(uop, "LOCMAX", (ftnlen)6, (ftnlen)6) == 0 || s_cmp(uop, "LOCMIN" - , (ftnlen)6, (ftnlen)6) == 0) { - -/* This algorithm uses 4 ZZGFREL calls, 2 of which perform */ -/* 2 passes and 2 of which perform 1 pass. */ - - s_copy(rptsuf, "done.", (ftnlen)80, (ftnlen)5); - s_copy(rptsuf + 80, "done.", (ftnlen)80, (ftnlen)5); - -/* Empty the result window. */ - - scardd_(&c__0, result); - -/* We'll first find two windows covering the left and right */ -/* halves of the unit circle, with both halves extended */ -/* slightly to ensure no roots are missed. We start by */ -/* finding the window on which the cosine of the coordinate */ -/* is less than cos(LCXMRG) (which is a small, positive number). */ - - lnkan_(wwpool, &node); - left = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)1873)]; - s_copy(rptpre, "Coordinate pass 1 of 6", (ftnlen)80, (ftnlen)22); - s_copy(rptpre + 80, "Coordinate pass 2 of 6", (ftnlen)80, (ftnlen)22); - s_copy(prxrel, "<", (ftnlen)6, (ftnlen)1); - prxval = cos(1e-12); - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - nrmsys, nrmcrd, &prxval, vecdef_len, method_len, target_len, - ref_len, abcorr_len, obsrvr_len, dref_len, (ftnlen)32, ( - ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcocd_, (U_fp)zzgfcocl_, - (S_fp)zzgfcocg_, (U_fp)zzgfcour_, prxrel, &prxval, &loctol, & - c_b70, cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, - (U_fp)udrepf, rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__1 - = left * work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgflong_", ( - ftnlen)1885)], (ftnlen)6, (ftnlen)80, (ftnlen)80); - -/* Handle interrupts if necessary. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* Now search for the time period when the cosine of the */ -/* coordinate is greater than -cos(LCXMRG). We can save some time */ -/* by searching within the window designated by LEFT for the */ -/* complement of this window and then complementing the result of */ -/* that search. */ - - lnkan_(wwpool, &node); - compl = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)1911)]; - lnkan_(wwpool, &node); - right = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)1914)]; - s_copy(rptpre, "Coordinate pass 3 of 6", (ftnlen)80, (ftnlen)22); - s_copy(rptpre + 80, "Coordinate pass 4 of 6", (ftnlen)80, (ftnlen)22); - s_copy(prxrel, "<", (ftnlen)6, (ftnlen)1); - prxval = -cos(1e-12); - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - nrmsys, nrmcrd, &prxval, vecdef_len, method_len, target_len, - ref_len, abcorr_len, obsrvr_len, dref_len, (ftnlen)32, ( - ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcocd_, (U_fp)zzgfcocl_, - (S_fp)zzgfcocg_, (U_fp)zzgfcour_, prxrel, &prxval, &loctol, & - c_b70, &work[(i__1 = left * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)1927)], mw, nw, work, rpt, (U_fp) - udrepi, (U_fp)udrepu, (U_fp)udrepf, rptpre, rptsuf, bail, ( - L_fp)udbail, &work[(i__2 = compl * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgflong_", (ftnlen)1927)], (ftnlen)6, ( - ftnlen)80, (ftnlen)80); - -/* Handle interrupts if necessary. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* WORK(LB,COMPL) contains the complement of the window */ -/* we want. */ - - wndifd_(cnfine, &work[(i__1 = compl * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)1949)], &work[(i__2 = right * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", (ftnlen)1949)] - ); - -/* We're now going to find local extrema of the coordinate in the */ -/* windows indexed by LEFT and RIGHT. */ - - for (i__ = 1; i__ <= 2; ++i__) { - if (i__ == 1) { - -/* The sector we're searching is indexed by LEFT. */ -/* We'll use RA as a proxy function, since RA has no */ -/* singularity on the left half circle. */ - - s = left; - s_copy(prxsys, "RA/DEC", (ftnlen)32, (ftnlen)6); - s_copy(prxcrd, "RIGHT ASCENSION", (ftnlen)32, (ftnlen)15); - lnkan_(wwpool, &node); - res1 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "wix", i__1, "zzgflong_", (ftnlen)1968)]; - res = res1; - s_copy(rptpre, "Coordinate pass 5 of 6", (ftnlen)80, (ftnlen) - 22); - s_copy(rptpre + 80, " ", (ftnlen)80, (ftnlen)1); - } else { - s = right; - s_copy(prxsys, "LATITUDINAL", (ftnlen)32, (ftnlen)11); - s_copy(prxcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9); - lnkan_(wwpool, &node); - res2 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "wix", i__1, "zzgflong_", (ftnlen)1981)]; - res = res2; - s_copy(rptpre, "Coordinate pass 6 of 6", (ftnlen)80, (ftnlen) - 22); - s_copy(rptpre + 80, " ", (ftnlen)80, (ftnlen)1); - } - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - prxsys, prxcrd, &c_b70, vecdef_len, method_len, - target_len, ref_len, abcorr_len, obsrvr_len, dref_len, ( - ftnlen)32, (ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcodc_, (U_fp) - zzgfcolt_, (S_fp)zzgfcog_, (U_fp)zzgfcour_, uop, &c_b70, & - loctol, &c_b70, &work[(i__1 = s * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : - s_rnge("work", i__1, "zzgflong_", (ftnlen)1994)], mw, nw, - work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp)udrepf, - rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__2 = res * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)1994)], (ftnlen)6, (ftnlen)80, (ftnlen)80); - -/* Handle interrupts if necessary. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - } - -/* Combine the contributions of both searches in RESULT. */ - - wnunid_(&work[(i__1 = res1 * work_dim1 - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgf" - "long_", (ftnlen)2017)], &work[(i__2 = res2 * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgflong_", (ftnlen)2017)], result); - -/* End of the LOCMIN and LOCMAX cases. RESULT is set. */ - - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* The remaining operators are: ABSMAX, ABSMIN, '<', '>'. */ - -/* Initialize the window aliases. A value of zero indicates the */ -/* corresponding region hasn't been computed. */ - - top = 0; - bot = 0; - right = 0; - left = 0; - q1 = 0; - q2 = 0; - q3 = 0; - q4 = 0; - s = 0; - wh = 0; - f1 = 0; - f2 = 0; - -/* If we have an absolute extremum or inequality relation, */ -/* we'll need to find times when the coordinate is in the */ -/* various quadrants. We'll start out by setting up windows */ -/* for the times when the coordinate is in the top and right */ -/* halves of the unit circle. */ - -/* The ZZGFREL call below involves two passes. */ - - if (s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0 || s_cmp(uop, "ABSMIN" - , (ftnlen)6, (ftnlen)6) == 0) { - if (*adjust == 0.) { - s_copy(tmplat, "Coordinate pass # of 7", (ftnlen)80, (ftnlen)22); - } else { - s_copy(tmplat, "Coordinate pass # of 7-9", (ftnlen)80, (ftnlen)24) - ; - } - } else { - -/* Ordinary inequality searches use 8 passes. */ - - s_copy(tmplat, "Coordinate pass # of 8", (ftnlen)80, (ftnlen)22); - } - for (i__ = 1; i__ <= 2; ++i__) { - repmi_(tmplat, "#", &i__, rptpre + ((i__1 = i__ - 1) < 2 && 0 <= i__1 - ? i__1 : s_rnge("rptpre", i__1, "zzgflong_", (ftnlen)2073)) * - 80, (ftnlen)80, (ftnlen)1, (ftnlen)80); - } - -/* Find the window where the sine of the coordinate is greater than */ -/* the sine of the branch cut avoidance tolerance. */ - -/* Make sure the coordinate utilities have been initialized */ -/* with the actual values we'll use for our search. */ - - lnkan_(wwpool, &node); - head = node; - top = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", i__1, - "zzgflong_", (ftnlen)2085)]; - prxval = sin(1e-11); - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, nrmsys, - nrmcrd, &prxval, vecdef_len, method_len, target_len, ref_len, - abcorr_len, obsrvr_len, dref_len, (ftnlen)32, (ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcosd_, (U_fp)zzgfcosl_, ( - S_fp)zzgfcosg_, (U_fp)zzgfcour_, ">", &prxval, &loctol, &c_b70, - cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp) - udrepf, rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__1 = top * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 - ? i__1 : s_rnge("work", i__1, "zzgflong_", (ftnlen)2093)], ( - ftnlen)1, (ftnlen)80, (ftnlen)80); - -/* 2 passes done. */ - - total = 2; - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* Find the window where the sine of the coordinate is less than */ -/* the negative of the sine of the branch cut avoidance tolerance. */ - -/* Make sure the coordinate utilities have been initialized */ -/* with the actual values we'll use for our search. */ - -/* The ZZGFREL call below involves two passes. */ - - for (i__ = 1; i__ <= 2; ++i__) { - i__2 = total + i__; - repmi_(tmplat, "#", &i__2, rptpre + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("rptpre", i__1, "zzgflong_", (ftnlen) - 2123)) * 80, (ftnlen)80, (ftnlen)1, (ftnlen)80); - } - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - bot = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", i__1, - "zzgflong_", (ftnlen)2129)]; - prxval = -sin(1e-11); - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, nrmsys, - nrmcrd, &prxval, vecdef_len, method_len, target_len, ref_len, - abcorr_len, obsrvr_len, dref_len, (ftnlen)32, (ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcosd_, (U_fp)zzgfcosl_, ( - S_fp)zzgfcosg_, (U_fp)zzgfcour_, "<", &prxval, &loctol, &c_b70, - cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp) - udrepf, rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__1 = bot * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 - ? i__1 : s_rnge("work", i__1, "zzgflong_", (ftnlen)2138)], ( - ftnlen)1, (ftnlen)80, (ftnlen)80); - -/* 4 passes done. */ - - total += 2; - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* Find the window where the cosine of the coordinate is */ -/* greater than zero. */ - - -/* The ZZGFREL call below involves two passes. */ - - for (i__ = 1; i__ <= 2; ++i__) { - i__2 = total + i__; - repmi_(tmplat, "#", &i__2, rptpre + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("rptpre", i__1, "zzgflong_", (ftnlen) - 2166)) * 80, (ftnlen)80, (ftnlen)1, (ftnlen)80); - } - -/* We'll keep all of the allocated nodes linked together. */ -/* Since the order of the nodes is unimportant, we insert */ -/* each new node following the head node; this is non-standard */ -/* but ensures the list head doesn't change until we delete */ -/* nodes from the list. */ - - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - right = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2178)]; - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, nrmsys, - nrmcrd, &c_b70, vecdef_len, method_len, target_len, ref_len, - abcorr_len, obsrvr_len, dref_len, (ftnlen)32, (ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcocd_, (U_fp)zzgfcocl_, ( - S_fp)zzgfcocg_, (U_fp)zzgfcour_, ">", &c_b70, &loctol, &c_b70, - cnfine, mw, nw, work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp) - udrepf, rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__1 = right * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 - ? i__1 : s_rnge("work", i__1, "zzgflong_", (ftnlen)2184)], ( - ftnlen)1, (ftnlen)80, (ftnlen)80); - -/* 6 passes done. */ - - total += 2; - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - if (failed_()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Now find the absolute extremum, if this was requested. */ - - if (s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0 || s_cmp(uop, "ABSMIN" - , (ftnlen)6, (ftnlen)6) == 0) { - -/* If we're looking for an absolute extremum and the */ -/* adjustment value is 0, each ZZGFREL call executes */ -/* on search pass; otherwise these calls execute two */ -/* search passes. */ - - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { - -/* We need windows when the coordinate is in quadrants 2 and */ -/* 3. We can derive these from the windows TOP and RIGHT */ -/* without additional searches. */ - - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q2 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2229)]; - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q3 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2233)]; - -/* Compute windows for the second and third quadrants. Note */ -/* that these windows are bounded away from the branch cut */ -/* at pi radians, since windows TOP and BOT have been */ -/* trimmed. */ - - wndifd_(&work[(i__1 = top * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2241)], &work[(i__2 = right * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2241)], &work[(i__3 = q2 * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : - s_rnge("work", i__3, "zzgflong_", (ftnlen)2241)]); - wndifd_(&work[(i__1 = bot * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2242)], &work[(i__2 = right * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2242)], &work[(i__3 = q3 * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : - s_rnge("work", i__3, "zzgflong_", (ftnlen)2242)]); - if (s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0) { - region[0] = q2; - region[1] = right; - region[2] = q3; - } else { - region[0] = q3; - region[1] = right; - region[2] = q2; - } - } else if (s_cmp(nrmcrd, "RIGHT ASCENSION", (ftnlen)32, (ftnlen)15) == - 0) { - -/* We need windows when the coordinate is in quadrants 1 and */ -/* 4, and the window when the coordinate is in the left half */ -/* of the unit circle. We can derive these from the windows */ -/* TOP and RIGHT without additional searches. */ - - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q1 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2265)]; - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - left = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "wix", i__1, "zzgflong_", (ftnlen)2269)]; - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q4 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2273)]; - -/* Compute windows for the first and fourth quadrants. Note */ -/* that these windows are bounded away from the branch cut */ -/* at pi radians, since windows TOP and BOT have been */ -/* trimmed. Also compute the window LEFT, which is the */ -/* complement of window RIGHT. */ - - wnintd_(&work[(i__1 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2282)], &work[(i__2 = top * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2282)], &work[(i__3 = q1 * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : - s_rnge("work", i__3, "zzgflong_", (ftnlen)2282)]); - wnintd_(&work[(i__1 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2283)], &work[(i__2 = bot * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2283)], &work[(i__3 = q4 * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : - s_rnge("work", i__3, "zzgflong_", (ftnlen)2283)]); - wndifd_(cnfine, &work[(i__1 = right * work_dim1 - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2284)], &work[(i__2 = - left * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgflong_", (ftnlen)2284)]); - if (s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0) { - region[0] = q4; - region[1] = left; - region[2] = q1; - } else { - region[0] = q1; - region[1] = left; - region[2] = q4; - } - } else { - -/* We're not expecting to see a coordinate other than */ -/* longitude or RA here. */ - - setmsg_("Unexpected coordinate # (0)", (ftnlen)27); - errch_("#", nrmcrd, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Now search the list of regions for the specified */ -/* extremum. */ - - found = FALSE_; - i__ = 1; - while(i__ <= 3 && ! found) { - -/* Search region I. Set the reference and adjustment */ -/* values to 0 for this search. */ - -/* The ZZGFREL call below executes 1 pass, since it's */ -/* doing an absolute extremum search with 0 adjustment */ -/* value (even if ADJUST is non-zero). */ - - i__1 = total + 1; - repmi_(tmplat, "#", &i__1, rptpre, (ftnlen)80, (ftnlen)1, (ftnlen) - 80); - s_copy(rptpre + 80, " ", (ftnlen)80, (ftnlen)1); - scardd_(&c__0, result); - -/* Perform our searches with functions that have no branch */ -/* cuts near the region boundaries. */ - - if (region[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "region", i__1, "zzgflong_", (ftnlen)2334)] == q1 || - region[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "region", i__2, "zzgflong_", (ftnlen)2334)] == q4 || - region[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge( - "region", i__3, "zzgflong_", (ftnlen)2334)] == right) { - s_copy(prxsys, "LATITUDINAL", (ftnlen)32, (ftnlen)11); - s_copy(prxcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9); - } else { - s_copy(prxsys, "RA/DEC", (ftnlen)32, (ftnlen)6); - s_copy(prxcrd, "RIGHT ASCENSION", (ftnlen)32, (ftnlen)15); - } - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - prxsys, prxcrd, &c_b70, vecdef_len, method_len, - target_len, ref_len, abcorr_len, obsrvr_len, dref_len, ( - ftnlen)32, (ftnlen)32); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcodc_, (U_fp) - zzgfcolt_, (S_fp)zzgfcocg_, (U_fp)zzgfcour_, uop, &c_b70, - &loctol, &c_b70, &work[(i__2 = region[(i__1 = i__ - 1) < - 3 && 0 <= i__1 ? i__1 : s_rnge("region", i__1, "zzgflong_" - , (ftnlen)2350)] * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", - i__2, "zzgflong_", (ftnlen)2350)], mw, nw, work, rpt, ( - U_fp)udrepi, (U_fp)udrepu, (U_fp)udrepf, rptpre, rptsuf, - bail, (L_fp)udbail, result, (ftnlen)6, (ftnlen)80, ( - ftnlen)80); - -/* ZZGFREL will have performed a pass only if the confinement */ -/* window was non-empty. */ - - if (cardd_(&work[(i__2 = region[(i__1 = i__ - 1) < 3 && 0 <= i__1 - ? i__1 : s_rnge("region", i__1, "zzgflong_", (ftnlen)2363) - ] * work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2363)]) > 0) { - -/* Another pass has been completed. */ - - ++total; - } - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - if (wncard_(result) > 0) { - -/* We found an extremum. We don't have to search further. */ - - found = TRUE_; - } else { - ++i__; - } - } - if (*adjust == 0.) { - -/* The result we have is the final result. */ - - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* This is the case of an absolute extremum search with */ -/* non-zero adjustment value. */ - -/* We'll need to obtain the extreme value. */ - - et = result[6]; - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - nrmsys, nrmcrd, &c_b70, vecdef_len, method_len, target_len, - ref_len, abcorr_len, obsrvr_len, dref_len, (ftnlen)32, ( - ftnlen)32); - zzgfcog_(&et, &extval); - -/* Re-set the operator and reference value to enable */ -/* us to conduct an inequality search. */ - - if (s_cmp(uop, "ABSMAX", (ftnlen)6, (ftnlen)6) == 0) { - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { -/* Computing MAX */ - d__1 = extval - *adjust, d__2 = -pi_(); - xrfval = max(d__1,d__2); - } else { -/* Computing MAX */ - d__1 = extval - *adjust; - xrfval = max(d__1,0.); - } - s_copy(uop, ">", (ftnlen)6, (ftnlen)1); - } else { - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { -/* Computing MIN */ - d__1 = extval + *adjust, d__2 = pi_(); - xrfval = min(d__1,d__2); - } else { -/* Computing MIN */ - d__1 = extval + *adjust, d__2 = twopi_(); - xrfval = min(d__1,d__2); - } - s_copy(uop, "<", (ftnlen)6, (ftnlen)1); - } - } - -/* Case: inequality */ - -/* Searches for absolute extrema with non-zero adjustment values */ -/* also use this code block. */ - - if (s_cmp(uop, "<", (ftnlen)6, (ftnlen)1) == 0 || s_cmp(uop, ">", (ftnlen) - 6, (ftnlen)1) == 0) { - -/* We'll find the window when the coordinate is less than */ -/* the reference value. If the relation is '>', we'll */ -/* complement the result. Let FLIP indicate whether */ -/* we need to take the complement of our result at the */ -/* end of the search. */ - - if (s_cmp(uop, ">", (ftnlen)6, (ftnlen)1) == 0) { - s_copy(uop, "<", (ftnlen)6, (ftnlen)1); - flip = TRUE_; - } else { - flip = FALSE_; - } - -/* We'll need the sine and cosine of the reference value. */ - - cv = cos(xrfval); - sv = sin(xrfval); - -/* Determine the quadrant QUAD of the reference value. */ - - locref = atan2(sv, cv); - if (locref < -pi_() / 2) { - quad = 3; - } else if (locref < 0.) { - quad = 4; - } else if (locref < pi_() / 2) { - quad = 1; - } else { - quad = 2; - } - -/* Create a list of region windows to compute. The order */ -/* of list items is significant: the regions will */ -/* be computed in the order in which they're listed. */ - - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { - nl = 2; - s_copy(rlist, "Q2", (ftnlen)32, (ftnlen)2); - s_copy(rlist + 32, "Q3", (ftnlen)32, (ftnlen)2); - } else { - nl = 3; - s_copy(rlist, "LEFT", (ftnlen)32, (ftnlen)4); - s_copy(rlist + 32, "Q1", (ftnlen)32, (ftnlen)2); - s_copy(rlist + 64, "Q4", (ftnlen)32, (ftnlen)2); - } - -/* Compute all of the region windows. */ - -/* We make use of the fact that windows TOP and RIGHT */ -/* have already been computed. */ - - i__1 = nl; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(rlist + (((i__2 = i__ - 1) < 7 && 0 <= i__2 ? i__2 : - s_rnge("rlist", i__2, "zzgflong_", (ftnlen)2516)) << 5), - "LEFT", (ftnlen)32, (ftnlen)4) == 0 && left == 0) { - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - left = wix[(i__2 = node - 1) < 7 && 0 <= i__2 ? i__2 : s_rnge( - "wix", i__2, "zzgflong_", (ftnlen)2520)]; - wndifd_(cnfine, &work[(i__2 = right * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? - i__2 : s_rnge("work", i__2, "zzgflong_", (ftnlen)2522) - ], &work[(i__3 = left * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgflong_", (ftnlen)2522)]); - } else if (s_cmp(rlist + (((i__2 = i__ - 1) < 7 && 0 <= i__2 ? - i__2 : s_rnge("rlist", i__2, "zzgflong_", (ftnlen)2524)) - << 5), "Q1", (ftnlen)32, (ftnlen)2) == 0 && q1 == 0) { - if (q1 == 0) { - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q1 = wix[(i__2 = node - 1) < 7 && 0 <= i__2 ? i__2 : - s_rnge("wix", i__2, "zzgflong_", (ftnlen)2530)]; - } - wnintd_(&work[(i__2 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2534)], &work[( - i__3 = top * work_dim1 - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "zzgflong_", (ftnlen)2534)], &work[(i__4 = q1 * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__4 ? i__4 : s_rnge("work", i__4, "zzgflong_" - , (ftnlen)2534)]); - } else if (s_cmp(rlist + (((i__2 = i__ - 1) < 7 && 0 <= i__2 ? - i__2 : s_rnge("rlist", i__2, "zzgflong_", (ftnlen)2537)) - << 5), "Q2", (ftnlen)32, (ftnlen)2) == 0 && q2 == 0) { - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q2 = wix[(i__2 = node - 1) < 7 && 0 <= i__2 ? i__2 : s_rnge( - "wix", i__2, "zzgflong_", (ftnlen)2541)]; - wndifd_(&work[(i__2 = top * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2543)], &work[( - i__3 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgflong_", (ftnlen)2543)], &work[( - i__4 = q2 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__4 ? i__4 : s_rnge("work", i__4, - "zzgflong_", (ftnlen)2543)]); - } else if (s_cmp(rlist + (((i__2 = i__ - 1) < 7 && 0 <= i__2 ? - i__2 : s_rnge("rlist", i__2, "zzgflong_", (ftnlen)2546)) - << 5), "Q3", (ftnlen)32, (ftnlen)2) == 0 && q3 == 0) { - -/* Note: we need the bottom window in order to compute Q3! */ - - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q3 = wix[(i__2 = node - 1) < 7 && 0 <= i__2 ? i__2 : s_rnge( - "wix", i__2, "zzgflong_", (ftnlen)2552)]; - wndifd_(&work[(i__2 = bot * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2554)], &work[( - i__3 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgflong_", (ftnlen)2554)], &work[( - i__4 = q3 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__4 ? i__4 : s_rnge("work", i__4, - "zzgflong_", (ftnlen)2554)]); - } else if (s_cmp(rlist + (((i__2 = i__ - 1) < 7 && 0 <= i__2 ? - i__2 : s_rnge("rlist", i__2, "zzgflong_", (ftnlen)2557)) - << 5), "Q4", (ftnlen)32, (ftnlen)2) == 0 && q4 == 0) { - -/* NOTE: We need the bottom window in order to compute Q4! */ - - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - q4 = wix[(i__2 = node - 1) < 7 && 0 <= i__2 ? i__2 : s_rnge( - "wix", i__2, "zzgflong_", (ftnlen)2563)]; - wnintd_(&work[(i__2 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2565)], &work[( - i__3 = bot * work_dim1 - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "zzgflong_", (ftnlen)2565)], &work[(i__4 = q4 * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__4 ? i__4 : s_rnge("work", i__4, "zzgflong_" - , (ftnlen)2565)]); - } - } - if (failed_()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Now decide the sector and proxy function we'll use to */ -/* search for the time when the reference value is hit. */ - - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { - if (quad == 1) { - s = right; - s_copy(prxfun, "LONGITUDE", (ftnlen)50, (ftnlen)9); - } else if (quad == 2) { - s = q2; - s_copy(prxfun, "RIGHT ASCENSION", (ftnlen)50, (ftnlen)15); - } else if (quad == 3) { - s = q3; - s_copy(prxfun, "RIGHT ASCENSION", (ftnlen)50, (ftnlen)15); - } else { - s = right; - s_copy(prxfun, "LONGITUDE", (ftnlen)50, (ftnlen)9); - } - } else { - if (quad == 1) { - s = q1; - s_copy(prxfun, "LONGITUDE", (ftnlen)50, (ftnlen)9); - } else if (quad == 2) { - s = left; - s_copy(prxfun, "RIGHT ASCENSION", (ftnlen)50, (ftnlen)15); - } else if (quad == 3) { - s = left; - s_copy(prxfun, "RIGHT ASCENSION", (ftnlen)50, (ftnlen)15); - } else { - s = q4; - s_copy(prxfun, "LONGITUDE", (ftnlen)50, (ftnlen)9); - } - } - -/* Set the proxy reference value based on the input */ -/* reference value and the choice of proxy function. */ - - if (s_cmp(prxfun, "LONGITUDE", (ftnlen)50, (ftnlen)9) == 0) { - prxval = atan2(sv, cv); - } else { - prxval = atan2(sv, cv); - if (prxval < 0.) { - prxval += twopi_(); - } - } - -/* We're going to need additional windows in order to search */ -/* quadrant Q. At this point, we're going to de-allocate all */ -/* windows except those needed for the upcoming searches. */ - -/* Create the set NEEDWN of the windows we need to retain. */ - - ssizei_(&c__7, needwn); - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { - insrti_(&q2, needwn); - insrti_(&q3, needwn); - insrti_(&right, needwn); - } else { - insrti_(&q1, needwn); - insrti_(&q4, needwn); - insrti_(&left, needwn); - } - -/* Now delete all windows not referenced by NEEDWN. */ - - node = head; - while(node > 0) { - -/* Find the next node in the list. */ - - next = lnknxt_(&node, wwpool); - if (! elemi_(&wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : - s_rnge("wix", i__1, "zzgflong_", (ftnlen)2682)], needwn)) - { - -/* Delete NODE; update HEAD if we deleted the head node. */ - - lnkfsl_(&node, &node, wwpool); - if (head == node) { - head = next; - } - } - -/* Prepare to look at the next node. */ - - node = next; - } - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { - -/* This is a longitude search. */ - -/* For each quadrant, identify or compute the window on which */ -/* the constraint is automatically satisfied. Store the result */ -/* in workspace window F1. If this window is empty, set F1 to */ -/* 0. */ - - if (quad == 1) { - f1 = q3; - } else if (quad == 2) { - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - f1 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "wix", i__1, "zzgflong_", (ftnlen)2719)]; - wnunid_(&work[(i__1 = q3 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2721)], &work[( - i__2 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2721)], &work[( - i__3 = f1 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "zzgflong_", (ftnlen)2721)]); - } else if (quad == 3) { - f1 = 0; - } else { - -/* QUAD is 4. */ - - f1 = q3; - } - } else { - -/* We're working with RA. */ - - if (quad == 1) { - f1 = 0; - } else if (quad == 2) { - f1 = q1; - } else if (quad == 3) { - f1 = q1; - } else { - -/* QUAD is 4. */ - - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - f1 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "wix", i__1, "zzgflong_", (ftnlen)2758)]; - wnunid_(&work[(i__1 = left * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2760)], &work[( - i__2 = q1 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgflong_", (ftnlen)2760)], &work[(i__3 = f1 * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "zzgflong_" - , (ftnlen)2760)]); - } - } - if (failed_()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - -/* Search sector S to find times when the relation */ - -/* PRXFUN PRXREL PRXVAL */ - -/* holds. */ - -/* Allocate window F2 to hold the result of the search. */ - - - for (i__ = 1; i__ <= 2; ++i__) { - i__2 = total + i__; - repmi_(tmplat, "#", &i__2, rptpre + ((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("rptpre", i__1, "zzgflong_", (ftnlen) - 2782)) * 80, (ftnlen)80, (ftnlen)1, (ftnlen)80); - } - lnkan_(wwpool, &node); - lnkila_(&head, &node, wwpool); - f2 = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2788)]; - scardd_(&c__0, &work[(i__1 = f2 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2790)]); - if (s_cmp(prxfun, "LONGITUDE", (ftnlen)50, (ftnlen)9) == 0) { - -/* Initialize the proxy search in sector S, then perform the */ -/* search. */ - - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - "LATITUDINAL", "LONGITUDE", &prxval, vecdef_len, - method_len, target_len, ref_len, abcorr_len, obsrvr_len, - dref_len, (ftnlen)11, (ftnlen)9); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcodc_, (U_fp) - zzgfcolt_, (S_fp)zzgfcog_, (U_fp)zzgfcour_, "<", &prxval, - &loctol, &c_b70, &work[(i__1 = s * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : - s_rnge("work", i__1, "zzgflong_", (ftnlen)2801)], mw, nw, - work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp)udrepf, - rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__2 = f2 * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2801)], (ftnlen)1, (ftnlen)80, (ftnlen)80); - } else { - -/* Initialize the proxy search in sector S, then perform the */ -/* search. */ - - zzgfcoin_(vecdef, method, target, ref, abcorr, obsrvr, dref, dvec, - "RA/DEC", "RIGHT ASCENSION", &prxval, vecdef_len, - method_len, target_len, ref_len, abcorr_len, obsrvr_len, - dref_len, (ftnlen)6, (ftnlen)15); - zzgfrel_((U_fp)udstep, (U_fp)udrefn, (U_fp)zzgfcodc_, (U_fp) - zzgfcolt_, (S_fp)zzgfcog_, (U_fp)zzgfcour_, "<", &prxval, - &loctol, &c_b70, &work[(i__1 = s * work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : - s_rnge("work", i__1, "zzgflong_", (ftnlen)2819)], mw, nw, - work, rpt, (U_fp)udrepi, (U_fp)udrepu, (U_fp)udrepf, - rptpre, rptsuf, bail, (L_fp)udbail, &work[(i__2 = f2 * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2819)], (ftnlen)1, (ftnlen)80, (ftnlen)80); - } - -/* 7 + 0:2 passes done for adjusted extrema. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFLONG", (ftnlen)8); - return 0; - } - } - -/* Combine the contents of windows F1 and F2 to obtain */ -/* the result. */ - - if (f1 != 0) { - wnunid_(&work[(i__1 = f1 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2845)], &work[(i__2 = f2 * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2845)], result); - } else { - copyd_(&work[(i__1 = f2 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2847)], result); - } - -/* Last step: complement the result if necessary. */ - - if (flip) { - -/* Create the window relative to which we'll find */ -/* the complement of RESULT. The window we seek */ -/* is not CNFINE, but rather a union of windows */ -/* that avoids the branch cut. */ - - lnkan_(wwpool, &node); - wh = wix[(i__1 = node - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge("wix", - i__1, "zzgflong_", (ftnlen)2861)]; - if (s_cmp(nrmcrd, "LONGITUDE", (ftnlen)32, (ftnlen)9) == 0) { - wnunid_(&work[(i__1 = q2 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2865)], &work[( - i__2 = right * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2865)], &work[( - i__3 = f2 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "zzgflong_", (ftnlen)2865)]); - wnunid_(&work[(i__1 = q3 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2866)], &work[( - i__2 = f2 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgflong_", (ftnlen)2866)], &work[(i__3 = wh * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "zzgflong_" - , (ftnlen)2866)]); - } else { - wnunid_(&work[(i__1 = q1 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2868)], &work[( - i__2 = left * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge( - "work", i__2, "zzgflong_", (ftnlen)2868)], &work[( - i__3 = f2 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, - "zzgflong_", (ftnlen)2868)]); - wnunid_(&work[(i__1 = q4 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge( - "work", i__1, "zzgflong_", (ftnlen)2869)], &work[( - i__2 = f2 * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgflong_", (ftnlen)2869)], &work[(i__3 = wh * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "zzgflong_" - , (ftnlen)2869)]); - } - -/* We use F2 as a temporary window index, since F2 is */ -/* guaranteed to exist at this point and is distinct from WH. */ - - wndifd_(&work[(i__1 = wh * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2876)], result, &work[(i__2 = - f2 * work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 - && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "zzgflong_", ( - ftnlen)2876)]); - copyd_(&work[(i__1 = f2 * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgflong_", (ftnlen)2877)], result); - } - } - chkout_("ZZGFLONG", (ftnlen)8); - return 0; -} /* zzgflong_ */ - diff --git a/ext/spice/src/cspice/zzgfocu.c b/ext/spice/src/cspice/zzgfocu.c deleted file mode 100644 index c7b4da1633..0000000000 --- a/ext/spice/src/cspice/zzgfocu.c +++ /dev/null @@ -1,1912 +0,0 @@ -/* zzgfocu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b171 = 1e-12; - -/* $Procedure ZZGFOCU ( GF, occultation utilities ) */ -/* Subroutine */ int zzgfocu_0_(int n__, char *occtyp, char *front, char * - fshape, char *fframe, char *back, char *bshape, char *bframe, char * - obsrvr, char *abcorr, doublereal *time, logical *ocstat, ftnlen - occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, - ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen - obsrvr_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static doublereal svorig[3] = { 0.,0.,0. }; - static char svtyps[7*4] = "ANNULAR" "ANY " "PARTIAL" "FULL "; - - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - doublereal srad; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - extern doublereal vsep_(doublereal *, doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), zzcorepc_(char *, doublereal *, doublereal *, doublereal *, - ftnlen), zzvalcor_(char *, logical *, ftnlen); - doublereal t2sep; - integer i__, n; - doublereal radii[3]; - extern /* Subroutine */ int minad_(doublereal *, integer *, doublereal *, - integer *), maxad_(doublereal *, integer *, doublereal *, integer - *), chkin_(char *, ftnlen); - char shape[9]; - integer idobs; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - ucase_(char *, char *, ftnlen, ftnlen); - doublereal bdist, fdist; - integer trgid; - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), moved_( - doublereal *, integer *, doublereal *); - doublereal mtemp[9] /* was [3][3] */, tdist; - static integer svobs; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - bods2c_(char *, integer *, logical *, ftnlen); - integer idback; - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer occode; - doublereal ltback; - extern doublereal dasine_(doublereal *, doublereal *), halfpi_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - doublereal bckfrt[3], bckobs[3], bckpos[3], etbcor; - static char svbnam[36]; - extern logical return_(void); - char fixfrm[32], posnam[10]; - static char svbfrm[32], svbshp[9], svcorr[5], svffrm[32], svfnam[36], - svfshp[9], svonam[36], svtype[7]; - doublereal bsmaxs[9] /* was [3][3] */, etfcor, frtbck[3], frtobs[3] - , frtpos[3], fsmaxs[9] /* was [3][3] */, ltfrnt, maxang, - minang, spoint[3], srfvec[3]; - static doublereal svbrad[3], svfrad[3], svmnbr, svmnfr, svmxbr, svmxfr; - doublereal trgepc, trgsep; - integer center, clssid, ffrmid, frclss, idfrnt, occnum; - static integer svback, svfrnt; - logical attblk[15], pntocc; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer loc; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen), bodvcd_(integer *, char *, integer *, integer *, - doublereal *, ftnlen), errint_(char *, integer *, ftnlen), - namfrm_(char *, integer *, ftnlen), frinfo_(integer *, integer *, - integer *, integer *, logical *), spkezp_(integer *, doublereal *, - char *, char *, integer *, doublereal *, doublereal *, ftnlen, - ftnlen), pxform_(char *, char *, doublereal *, doublereal *, - ftnlen, ftnlen), vminus_(doublereal *, doublereal *), sincpt_( - char *, char *, doublereal *, char *, char *, char *, char *, - doublereal *, doublereal *, doublereal *, doublereal *, logical *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern integer zzocced_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine contains the entry points that produce the */ -/* computations needed for solving for occultation states */ -/* in the geometry finding routines. */ - -/* $ 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 */ - -/* GF */ -/* NAIF_IDS */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* SEARCH */ -/* GEOMETRY */ -/* OCCULTATION */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Abstract */ - -/* Declare ZZOCCED return code parameters, comparison strings */ -/* and other parameters. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* ELLIPSOID */ -/* GEOMETRY */ -/* GF */ -/* OCCULTATION */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-SEP-2005 (NJB) */ - -/* -& */ -/* The function returns an integer code indicating the geometric */ -/* relationship of the three bodies. */ - -/* Codes and meanings are: */ - -/* -3 Total occultation of first target by */ -/* second. */ - - -/* -2 Annular occultation of first target by */ -/* second. The second target does not */ -/* block the limb of the first. */ - - -/* -1 Partial occultation of first target by */ -/* second target. */ - - -/* 0 No occultation or transit: both objects */ -/* are completely visible to the observer. */ - - -/* 1 Partial occultation of second target by */ -/* first target. */ - - -/* 2 Annular occultation of second target by */ -/* first. */ - - -/* 3 Total occultation of second target by */ -/* first. */ - - -/* End include file zzocced.inc */ - -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* OCCTYP I ZZGFOCIN */ -/* FRONT I ZZGFOCIN */ -/* FSHAPE I ZZGFOCIN */ -/* FFRAME I ZZGFOCIN */ -/* BACK I ZZGFOCIN */ -/* BSHAPE I ZZGFOCIN */ -/* BFRAME I ZZGFOCIN */ -/* OBSRVR I ZZGFOCIN */ -/* ABCORR I ZZGFOCIN */ -/* TIME I ZZGFOCST */ -/* OCSTAT O ZZGFOCST */ - -/* $ Detailed_Input */ - -/* See entry points. */ - -/* $ Detailed_Output */ - -/* See entry points. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* See entry points. */ - -/* $ Files */ - -/* Appropriate SPK and PCK kernels must be loaded by the calling */ -/* program before the entry points of this routine are called. */ - -/* The following data are required: */ - -/* - SPK data: the calling application must load ephemeris data */ -/* for the target, source and observer that cover the time */ -/* period specified by the window CNFINE. If aberration */ -/* corrections are used, the states of target and observer */ -/* relative to the solar system barycenter must be calculable */ -/* from the available ephemeris data. Typically ephemeris data */ -/* are made available by loading one or more SPK files via */ -/* FURNSH. */ - -/* - PCK data: bodies modeled as triaxial ellipsoids must have */ -/* semi-axis lengths provided by variables in the kernel pool. */ -/* Typically these data are made available by loading a text */ -/* PCK file via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time the entry points of this routine are called. */ - -/* $ Particulars */ - -/* This routine is designed to determine whether a specified */ -/* type of occultation or transit is in progress at a specified */ -/* epoch. Two methods of modeling the shapes of the target */ -/* bodies are supported: */ - -/* 1) Model both target bodies as triaxial ellipsoids. For this */ -/* case, the user may choose between occultations that are */ -/* partial, full or annular. See the entry header for */ -/* ZZGFOCIN for an explanation of these terms. */ - -/* 2) Treat one target body as a point object and the other */ -/* target body is a triaxial ellipsoid. The only supported */ -/* occultation type is "ANY" for this case. */ - -/* This routine contains two entry points that support searches */ -/* for occultations performed using ZZGFSOLV: */ - -/* ZZGFOCIN Saves the user-supplied inputs defining the */ -/* occultation computation to be performed. */ -/* Initializes the occultation search. */ - -/* ZZGFOCST Returns the occultation state for a specified */ -/* time. */ - -/* $ Examples */ - -/* See GFOCCE. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* ALPHA is a bound for the fraction of the speed of light */ -/* at which target body may move, relative to the solar */ -/* system barycenter. */ - - -/* ATOL is a tolerance value for computing arc sine. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_zzgfocin; - case 2: goto L_zzgfocst; - } - - -/* Below we initialize the list of occultation types. */ - - -/* This routine should never be called directly. */ - - chkin_("ZZGFOCU", (ftnlen)7); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZGFOCU", (ftnlen)7); - return 0; -/* $Procedure ZZGFOCIN ( GF, occultation initialization ) */ - -L_zzgfocin: -/* $ Abstract */ - -/* Perform initialization functions for occultation state */ -/* determination. */ - -/* $ 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 */ - -/* NAIF_IDS */ -/* FRAMES */ -/* PCK */ -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* SEARCH */ -/* GEOMETRY */ -/* OCCULTATION */ - -/* $ Declarations */ - -/* CHARACTER*(*) OCCTYP */ -/* CHARACTER*(*) FRONT */ -/* CHARACTER*(*) FSHAPE */ -/* CHARACTER*(*) FFRAME */ -/* CHARACTER*(*) BACK */ -/* CHARACTER*(*) BSHAPE */ -/* CHARACTER*(*) BFRAME */ -/* CHARACTER*(*) OBSRVR */ -/* CHARACTER*(*) ABCORR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OCCTYP I Type of occultation. */ -/* FRONT I Name of body occulting the other. */ -/* FSHAPE I Type of shape model used for front body. */ -/* FFRAME I Body-fixed, body-centered frame for front body. */ -/* BACK I Name of body occulted by the other. */ -/* BSHAPE I Type of shape model used for back body. */ -/* BFRAME I Body-fixed, body-centered frame for back body. */ -/* OBSRVR I Name of the observing body. */ -/* ABCORR I Aberration correction flag. */ - -/* $ Detailed_Input */ - - -/* OCCTYP indicates the type of occultation that is to be found. */ -/* The full set of possible values of OCCTYP may be used */ -/* when both target bodies are modeled as ellipsoids. */ -/* When either target is modeled as a point, OCCTYP must */ -/* be set to 'ANY' (see description below). */ - -/* Supported values of OCCTYP and corresponding */ -/* definitions are: */ - -/* 'FULL' denotes the full occultation */ -/* of the body designated by */ -/* BACK by the body designated */ -/* by FRONT, as seen from */ -/* the location of the observer. */ -/* In other words, the occulted */ -/* body is completely invisible */ -/* as seen from the observer's */ -/* location. */ - -/* 'ANNULAR' denotes an annular */ -/* occultation: the body */ -/* designated by FRONT blocks */ -/* part of, but not the limb of, */ -/* the body designated by BACK, */ -/* as seen from the location of */ -/* the observer. */ - -/* 'PARTIAL' denotes an partial, */ -/* non-annular occultation: the */ -/* body designated by FRONT */ -/* blocks part, but not all, of */ -/* the limb of the body */ -/* designated by BACK, as seen */ -/* from the location of the */ -/* observer. */ - -/* 'ANY' denotes any of the above three */ -/* types of occultations: */ -/* 'PARTIAL', 'ANNULAR', or */ -/* 'FULL'. */ - -/* 'ANY' should be used to search */ -/* for times when the body */ -/* designated by FRONT blocks */ -/* any part of the body designated */ -/* by BACK. */ - -/* The option 'ANY' MUST be used */ -/* if either the front or back */ -/* target body is modeled as */ -/* a point. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OCCTYP. */ - - -/* FRONT is the name of the target body that occults---that is, */ -/* passes in front of---the other. Optionally, you may */ -/* supply the integer NAIF ID code for the body as a */ -/* string. For example both 'MOON' and '301' are */ -/* legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string FRONT. */ - - -/* FSHAPE is a string indicating the geometric model used */ -/* to represent the shape of the front body. The */ -/* supported options are: */ - -/* 'ELLIPSOID' Use a triaxial ellipsoid model, */ -/* with radius values provided via the */ -/* kernel pool. A kernel variable */ -/* having a name of the form */ - -/* 'BODYnnn_RADII' */ - -/* where nnn represents the NAIF */ -/* integer code associated with the */ -/* body, must be present in the kernel */ -/* pool. This variable must be */ -/* associated with three numeric */ -/* values giving the lengths of the */ -/* ellipsoid's X, Y, and Z semi-axes. */ - -/* 'POINT' Treat the body as a single point. */ -/* When a point target is specified, */ -/* the occultation type must be */ -/* set to 'ANY'. */ - -/* At least one of the target bodies FRONT and BACK must */ -/* be modeled as an ellipsoid. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string FSHAPE. */ - - -/* FFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the front target body. Examples */ -/* of such names are 'IAU_SATURN' (for Saturn) and */ -/* 'ITRF93' (for the Earth). */ - -/* If the front target body is modeled as a point, FFRAME */ -/* should be left blank. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* FFRAME. */ - - -/* BACK is the name of the target body that is occulted */ -/* by---that is, passes in back of---the other. */ -/* Optionally, you may supply the integer NAIF ID code */ -/* for the body as a string. For example both 'MOON' and */ -/* '301' are legitimate strings that designate the Moon. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string BACK. */ - - -/* BSHAPE is the shape specification for the body designated */ -/* by BACK. See the description of FSHAPE above for */ -/* details. */ - - -/* BFRAME is the name of the body-fixed, body-centered reference */ -/* frame associated with the ``back'' target body. */ -/* Examples of such names are 'IAU_SATURN' (for Saturn) */ -/* and 'ITRF93' (for the Earth). */ - -/* If the back target body is modeled as a point, BFRAME */ -/* should be left blank. */ - -/* Case and leading or trailing blanks bracketing a */ -/* non-blank frame name are not significant in the string */ -/* BFRAME. */ - - -/* OBSRVR is the name of the body from which the occultation is */ -/* observed. Optionally, you may supply the integer NAIF */ -/* ID code for the body as a string. */ - -/* Case and leading or trailing blanks are not */ -/* significant in the string OBSRVR. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time. Stellar aberration corrections are */ -/* ignored if specified, since these corrections don't */ -/* improve the accuracy of the occultation determination. */ - -/* See the header of the SPICE routine SPKEZR for a */ -/* detailed description of the aberration correction */ -/* options. For convenience, the options supported by */ -/* this routine are listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of either target or the observer cannot be translated */ -/* to a NAIF ID code, the error SPICE(IDCODENOTFOUND) is */ -/* signaled. */ - -/* 2) If either of the target bodies FRONT or BACK coincides with */ -/* the observer body OBSRVR, or if the targets coincide, */ -/* the error SPICE(BODIESNOTDISTINCT) will be signaled. */ - -/* 3) If either of the body model specifiers FSHAPE or BSHAPE */ -/* is not recognized, the error SPICE(INVALIDSHAPE) will be */ -/* signaled. */ - -/* 4) If both of the body model specifiers FSHAPE and BSHAPE */ -/* specify point targets, the error SPICE(INVALIDSHAPECOMBO) */ -/* will be signaled. */ - -/* 5) If an unrecognized value of OCCTYP is seen, the error */ -/* SPICE(INVALIDOCCTYPE) is signaled. */ - -/* 6) If one target body is modeled as a point and OCCTYP is not */ -/* set to 'ANY', the error SPICE(BADTYPESHAPECOMBO) is signaled. */ - -/* 7) If a target indicated to be an ellipsoid by its shape */ -/* specification argument does not have three associated */ -/* positive radii, the error SPICE(DEGENERATECASE) will be */ -/* signaled. */ - -/* 8) If the number of radii associated with a target body is */ -/* not three, the error SPICE(BADRADIUSCOUNT) will be */ -/* signaled. */ - -/* 9) If a target body-fixed reference frame associated with a */ -/* non-point target is not recognized, the error */ -/* SPICE(INVALIDFRAME) will be signaled. */ - -/* 10) If a target body-fixed reference frame is not centered at */ -/* the corresponding target body, the error */ -/* SPICE(INVALIDFRAME) will be signaled. */ - -/* 11) If the aberration correction string is invalid, the error */ -/* will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* See the header of the umbrella routine ZZGFOCU. */ - -/* $ Particulars */ - -/* This entry point initializes the parameters needed by the */ -/* occultation state determination entry point ZZGFOCST. */ - -/* $ Examples */ - -/* See implementation of GFOCCE. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-APR-2009 (LSE) (WLT) (NJB) (EDW) */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFOCIN", (ftnlen)8); - -/* Find NAIF IDs for FRONT, BACK, and OBSRVR. */ - - bods2c_(front, &idfrnt, &found, front_len); - if (! found) { - setmsg_("The front target object, '#', is not a recognized name for " - "an ephemeris object. The cause of this problem may be that y" - "ou need an updated version of the SPICE toolkit. ", (ftnlen) - 168); - errch_("#", front, (ftnlen)1, front_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - bods2c_(back, &idback, &found, back_len); - if (! found) { - setmsg_("The back target object, '#', is not a recognized name for a" - "n ephemeris object. The cause of this problem may be that yo" - "u need an updated version of the SPICE toolkit. ", (ftnlen) - 167); - errch_("#", back, (ftnlen)1, back_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - bods2c_(obsrvr, &idobs, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Make sure the observer and both targets are distinct. */ - - if (idfrnt == idback || idfrnt == idobs || idback == idobs) { - setmsg_("The observer and both targets must be distinct objects, but" - " are not: OBSRVR = #; FRONT = #; BACK = #.", (ftnlen)101); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", front, (ftnlen)1, front_len); - errch_("#", back, (ftnlen)1, back_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Save the objects' names. We'll need these if */ -/* we need to call SINCPT. */ - - s_copy(svfnam, front, (ftnlen)36, front_len); - s_copy(svbnam, back, (ftnlen)36, back_len); - s_copy(svonam, obsrvr, (ftnlen)36, obsrvr_len); - -/* Store the ID codes, shape specifications, and body-fixed, */ -/* body-centered frame names of the objects involved in this event. */ - - svfrnt = idfrnt; - s_copy(svffrm, fframe, (ftnlen)32, fframe_len); - ljust_(fshape, svfshp, fshape_len, (ftnlen)9); - ucase_(svfshp, svfshp, (ftnlen)9, (ftnlen)9); - svback = idback; - s_copy(svbfrm, bframe, (ftnlen)32, bframe_len); - ljust_(bshape, svbshp, bshape_len, (ftnlen)9); - ucase_(svbshp, svbshp, (ftnlen)9, (ftnlen)9); - svobs = idobs; - -/* Note for maintenance programmer: these checks will */ -/* require modification to handle DSK-based shapes. */ - - if (s_cmp(svfshp, "POINT", (ftnlen)9, (ftnlen)5) != 0 && s_cmp(svfshp, - "ELLIPSOID", (ftnlen)9, (ftnlen)9) != 0) { - setmsg_("The front target shape specification, '#', is not a recogni" - "zed.", (ftnlen)63); - errch_("#", fshape, (ftnlen)1, fshape_len); - sigerr_("SPICE(INVALIDSHAPE)", (ftnlen)19); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - if (s_cmp(svbshp, "POINT", (ftnlen)9, (ftnlen)5) != 0 && s_cmp(svbshp, - "ELLIPSOID", (ftnlen)9, (ftnlen)9) != 0) { - setmsg_("The back target shape specification, '#', is not a recogniz" - "ed.", (ftnlen)62); - errch_("#", bshape, (ftnlen)1, bshape_len); - sigerr_("SPICE(INVALIDSHAPE)", (ftnlen)19); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - if (s_cmp(svfshp, "POINT", (ftnlen)9, (ftnlen)5) == 0 && s_cmp(svbshp, - "POINT", (ftnlen)9, (ftnlen)5) == 0) { - setmsg_("The front and back target shape specifications are both PTS" - "HAP; at least one of these targets must be an extended objec" - "t.", (ftnlen)121); - sigerr_("SPICE(INVALIDSHAPECOMBO)", (ftnlen)24); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Save a single upper-case character representing the occultation */ -/* type string. */ - - ljust_(occtyp, svtype, occtyp_len, (ftnlen)7); - ucase_(svtype, svtype, (ftnlen)7, (ftnlen)7); - -/* Check the occultation type. */ - - occnum = isrchc_(svtype, &c__4, svtyps, (ftnlen)7, (ftnlen)7); - if (occnum == 0) { - setmsg_("The occultation type # is not recognized. Supported types " - "are: #, #, #, #.", (ftnlen)76); - errch_("#", occtyp, (ftnlen)1, occtyp_len); - for (i__ = 1; i__ <= 4; ++i__) { - errch_("#", svtyps + ((i__1 = i__ - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("svtyps", i__1, "zzgfocu_", (ftnlen)865)) * 7, ( - ftnlen)1, (ftnlen)7); - } - sigerr_("SPICE(INVALIDOCCTYPE)", (ftnlen)21); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* If we have a point target, the occultation type must */ -/* be 'ANY'. */ - - if (s_cmp(svfshp, "POINT", (ftnlen)9, (ftnlen)5) == 0 || s_cmp(svbshp, - "POINT", (ftnlen)9, (ftnlen)5) == 0) { - if (s_cmp(svtype, "ANY", (ftnlen)7, (ftnlen)3) != 0) { - setmsg_("Occultation type # is not allowed when either target bo" - "dy is modeled as a point. Set OCCTYP to ANY for use with" - " point targets.", (ftnlen)126); - errch_("#", occtyp, (ftnlen)1, occtyp_len); - sigerr_("SPICE(BADTYPESHAPECOMBO)", (ftnlen)24); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - } - -/* Check the aberration correction. If SPKEZR can't handle it, */ -/* neither can we. */ - - zzvalcor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Create a local aberration correction string without */ -/* a stellar aberration correction specifier. */ - - if (attblk[0]) { - s_copy(svcorr, "NONE", (ftnlen)5, (ftnlen)4); - } else { - -/* The correction string specified either Newtonian or converged */ -/* light time correction. */ - - if (attblk[4]) { - s_copy(svcorr, "X", (ftnlen)5, (ftnlen)1); - } else { - s_copy(svcorr, " ", (ftnlen)5, (ftnlen)1); - } - if (attblk[3]) { - suffix_("CN", &c__0, svcorr, (ftnlen)2, (ftnlen)5); - } else { - suffix_("LT", &c__0, svcorr, (ftnlen)2, (ftnlen)5); - } - } - -/* Check the front and back targets' shapes, frames */ -/* and radii. */ - - for (i__ = 1; i__ <= 2; ++i__) { - if (i__ == 1) { - s_copy(posnam, "front", (ftnlen)10, (ftnlen)5); - s_copy(fixfrm, fframe, (ftnlen)32, fframe_len); - trgid = idfrnt; - s_copy(shape, svfshp, (ftnlen)9, (ftnlen)9); - } else { - s_copy(posnam, "back", (ftnlen)10, (ftnlen)4); - s_copy(fixfrm, bframe, (ftnlen)32, bframe_len); - trgid = idback; - s_copy(shape, svbshp, (ftnlen)9, (ftnlen)9); - } - if (s_cmp(shape, "ELLIPSOID", (ftnlen)9, (ftnlen)9) == 0) { - -/* Fetch and check the radii. */ - - bodvcd_(&trgid, "RADII", &c__3, &n, radii, (ftnlen)5); - -/* Check the count of the radii. */ - - if (n != 3) { - setmsg_("Target # should have 3 radii but actually has #. Th" - "is may be due to an error in a PCK file used to prov" - "ide the radii.", (ftnlen)117); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - errint_("#", &n, (ftnlen)1); - sigerr_("SPICE(BADRADIUSCOUNT)", (ftnlen)21); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Check to make sure the current target has 3 positive */ -/* semi-axis lengths. */ - - if (radii[0] <= 0. || radii[1] <= 0. || radii[2] <= 0.) { - setmsg_("One or more semi-axis lengths of the # target body " - "are non-positive: 1 = #, 2 = #, 3 = #. ", (ftnlen)90); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - errdp_("#", radii, (ftnlen)1); - errdp_("#", &radii[1], (ftnlen)1); - errdp_("#", &radii[2], (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Checks of radii have been completed. */ - - if (i__ == 1) { - moved_(radii, &c__3, svfrad); - -/* Select smallest and largest semi-axis lengths of body */ -/* for later tests. */ - - minad_(svfrad, &c__3, &svmnfr, &loc); - maxad_(svfrad, &c__3, &svmxfr, &loc); - } else { - moved_(radii, &c__3, svbrad); - minad_(svbrad, &c__3, &svmnbr, &loc); - maxad_(svbrad, &c__3, &svmxbr, &loc); - } - if (failed_()) { - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* The target is ellipsoidal; there must be */ -/* a target body-fixed frame associated with this */ -/* body. */ - - if (s_cmp(fixfrm, " ", (ftnlen)32, (ftnlen)1) == 0) { - setmsg_("The # target is modeled as an ellipsoid, but the as" - "sociated body-fixed frame name is blank.", (ftnlen)91) - ; - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } else { - -/* Look up the target's body-fixed frame ID code. */ - - namfrm_(fixfrm, &ffrmid, (ftnlen)32); - if (ffrmid == 0) { - setmsg_("The # target's body-fixed frame name # is not r" - "ecognized.", (ftnlen)57); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - errch_("#", fixfrm, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* Obtain the center of the frame and verify it's the */ -/* Ith target. */ - - frinfo_(&ffrmid, ¢er, &frclss, &clssid, &found); - if (! found) { - -/* Since we mapped the frame name to an ID code, we */ -/* expect to find the frame info. So control should */ -/* never reach this point. */ - - setmsg_("Frame ID found for # body-fixed frame # but FRI" - "NFO couldn't find frame info.", (ftnlen)76); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - errch_("#", fixfrm, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - if (center != trgid) { - -/* The body-fixed frame for the current target */ -/* isn't actually centered on the body. */ - - setmsg_("Supposed body-fixed frame # for # target is act" - "ually centered on body #.", (ftnlen)72); - errch_("#", fixfrm, (ftnlen)1, (ftnlen)32); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - errint_("#", &trgid, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - } - -/* We've performed radii and frame checks for an ellipsoidal */ -/* target. */ - - } else if (s_cmp(shape, "POINT", (ftnlen)9, (ftnlen)5) == 0) { - -/* Zero out radius values for this target; set the */ -/* frame to blank. */ - - if (i__ == 1) { - cleard_(&c__3, svfrad); - svmnfr = 0.; - svmxfr = 0.; - s_copy(svffrm, " ", (ftnlen)32, (ftnlen)1); - } else { - cleard_(&c__3, svbrad); - svmnbr = 0.; - svmxbr = 0.; - s_copy(svbfrm, " ", (ftnlen)32, (ftnlen)1); - } - } else { - -/* We have an unsupported target shape. */ - - setmsg_("The # target body has shape #; the only supported shape" - "s are ELLIPSOID and POINT.", (ftnlen)81); - errch_("#", posnam, (ftnlen)1, (ftnlen)10); - errch_("#", shape, (ftnlen)1, (ftnlen)9); - sigerr_("SPICE(INVALIDSHAPE)", (ftnlen)19); - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; - } - -/* We've performed shape, and if applicable, frame and radii */ -/* checks for the Ith target. */ - - } - -/* We've performed shape, and if applicable, frame and radii */ -/* checks for both targets. */ - - chkout_("ZZGFOCIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFOCST ( GF, "in occultation?" ) */ - -L_zzgfocst: -/* $ Abstract */ - -/* See if the object is currently occulted. */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* SEARCH */ -/* GEOMETRY */ -/* OCCULTATION */ - -/* $ Declarations */ - -/* DOUBLE PRECISION TIME */ -/* LOGICAL OCSTAT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TIME I TDB epoch (in seconds past J2000) */ -/* OCSTAT O .TRUE. if the object is occulted, .FALSE. */ -/* otherwise. */ - -/* $ Detailed_Input */ - -/* TIME is the epoch of interest in TDB seconds past the */ -/* J2000 epoch. */ - -/* $ Detailed_Output */ - -/* OCSTAT is a logical flag indicating the state of */ -/* occultation. If the configuration initialized by */ -/* ZZGFOCIN is in occultation at the epoch TIME, OCSTAT is */ -/* returned with the value .TRUE. Otherwise it is */ -/* returned with the value .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If any SPK lookup fails, the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 2) If any frame transformation lookup fails, the error will be */ -/* diagnosed by routines in the call tree of this routine. */ - -/* 3) If any occultation computation is done for ellipsoidal */ -/* targets, and if either semi-axis matrix is invalid, the error */ -/* will be diagnosed by routines in the call tree of this */ -/* routine. */ - -/* 4) If any two of the bodies defining the occultation geometry */ -/* intersect, either error SPICE(NOTDISJOINT) will be */ -/* signaled by this routine, or the error will be diagnosed by */ -/* routines in the call tree of this routine. */ - -/* 5) If the body model specifiers FSHAPE and BSHAPE don't specify */ -/* either two ellipsoidal targets or one ellipsoidal target and */ -/* one point target, the error SPICE(INVALIDSHAPECOMBO) */ -/* will be signaled. */ - -/* $ Files */ - -/* See the Files header section of the umbrella routine ZZGFOCU. */ - -/* $ Particulars */ - -/* This routine determines the occultation state of the */ -/* configuration specified by the last call to ZZGFOCIN and the */ -/* input time value. */ - -/* $ Examples */ - -/* See the umbrella routine ZZGFOCU. */ - -/* $ Restrictions */ - -/* This is a SPICELIB private routine; it should not be called by */ -/* user applications. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 30-DEC-2008 (NJB) (LSE) (WLT) (EDW) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFOCST", (ftnlen)8); - -/* Initialize the state output. */ - - *ocstat = FALSE_; - -/* Get the apparent positions of FRONT and BACK as seen from the */ -/* observer. */ - - spkezp_(&svfrnt, time, "J2000", svcorr, &svobs, frtpos, <frnt, (ftnlen) - 5, (ftnlen)5); - spkezp_(&svback, time, "J2000", svcorr, &svobs, bckpos, <back, (ftnlen) - 5, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - -/* Handle the cases of one and two extended targets */ -/* separately. */ - - if (s_cmp(svbshp, "ELLIPSOID", (ftnlen)9, (ftnlen)9) == 0 && s_cmp(svfshp, - "ELLIPSOID", (ftnlen)9, (ftnlen)9) == 0) { - -/* The caller has selected a test for a partial, annular or full */ -/* occultation using ellipsoidal shape models. */ - -/* Look up the axes of each target body in the J2000 frame at the */ -/* light time corrected epoch for that body. */ - - zzcorepc_(svcorr, time, <back, &etbcor, (ftnlen)5); - pxform_(svbfrm, "J2000", &etbcor, mtemp, (ftnlen)32, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - -/* Scale the columns of MTEMP by the axis lengths of the back */ -/* target. */ - - for (i__ = 1; i__ <= 3; ++i__) { - vscl_(&svbrad[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "svbrad", i__1, "zzgfocu_", (ftnlen)1346)], &mtemp[(i__2 = - i__ * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("mtemp", - i__2, "zzgfocu_", (ftnlen)1346)], &bsmaxs[(i__3 = i__ * 3 - - 3) < 9 && 0 <= i__3 ? i__3 : s_rnge("bsmaxs", i__3, - "zzgfocu_", (ftnlen)1346)]); - } - zzcorepc_(svcorr, time, <frnt, &etfcor, (ftnlen)5); - pxform_(svffrm, "J2000", &etfcor, mtemp, (ftnlen)32, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - -/* Scale the columns of MTEMP by the axis lengths of the second */ -/* target. */ - - for (i__ = 1; i__ <= 3; ++i__) { - vscl_(&svfrad[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "svfrad", i__1, "zzgfocu_", (ftnlen)1362)], &mtemp[(i__2 = - i__ * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("mtemp", - i__2, "zzgfocu_", (ftnlen)1362)], &fsmaxs[(i__3 = i__ * 3 - - 3) < 9 && 0 <= i__3 ? i__3 : s_rnge("fsmaxs", i__3, - "zzgfocu_", (ftnlen)1362)]); - } - -/* Classify the occultation state of BACK by FRONT as seen from */ -/* the observer. */ - - occode = zzocced_(svorig, bckpos, bsmaxs, frtpos, fsmaxs); - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - if (occode == 0) { - -/* Neither body occults the other. */ - - *ocstat = FALSE_; - } else if (s_cmp(svtype, "ANY", (ftnlen)7, (ftnlen)3) == 0 && occode < - 0) { - -/* The "of" body (target 1) is at least partially occulted by */ -/* the BY object. */ - - *ocstat = TRUE_; - } else if (s_cmp(svtype, "FULL", (ftnlen)7, (ftnlen)4) == 0 && occode - == -3) { - -/* The BACK body is in total occultation. */ - - *ocstat = TRUE_; - } else if (s_cmp(svtype, "ANNULAR", (ftnlen)7, (ftnlen)7) == 0 && - occode == -2) { - -/* The BACK body is in annular occultation. */ - - *ocstat = TRUE_; - } else if (s_cmp(svtype, "PARTIAL", (ftnlen)7, (ftnlen)7) == 0 && - occode == -1) { - -/* The BACK body is partially occulted. */ - - *ocstat = TRUE_; - } else { - -/* The occultation state doesn't match the requested state. */ - - *ocstat = FALSE_; - } - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } else if (s_cmp(svfshp, "ELLIPSOID", (ftnlen)9, (ftnlen)9) == 0 && s_cmp( - svbshp, "POINT", (ftnlen)9, (ftnlen)5) == 0 || s_cmp(svfshp, - "POINT", (ftnlen)9, (ftnlen)5) == 0 && s_cmp(svbshp, "ELLIPSOID", - (ftnlen)9, (ftnlen)9) == 0) { - -/* One of the targets is modeled as a point; the other is */ -/* modeled as an ellipsoid. */ - -/* If the front target is an ellipsoid and the back target */ -/* is a point, we'll classify the geometry as a "point */ -/* occultation." Otherwise we have a "point transit" case. */ -/* We'll set the logical flag PNTOCC to .TRUE. to indicate */ -/* a point occultation. */ - - pntocc = s_cmp(svbshp, "POINT", (ftnlen)9, (ftnlen)5) == 0; - -/* We're going to start out by doing some error checking. */ -/* We're looking for intersections of the participating */ -/* objects: these should never occur. */ - -/* Let BDIST, FDIST be the distances from the observer */ -/* to the back and front targets, respectively. */ - - bdist = vnorm_(bckpos); - fdist = vnorm_(frtpos); - -/* Find the vector from BACK to FRONT. We'll use this later, */ -/* but we want it now in order to make sure that BACK doesn't */ -/* intersect FRONT. */ - - vsub_(frtpos, bckpos, bckfrt); - if (pntocc) { - -/* The front target is an ellipsoid. */ - - if (fdist <= svmnfr) { - -/* The observer is INSIDE the front target. We */ -/* treat this as an error. */ - - setmsg_("Observer is inside front target body.", (ftnlen)37); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } else if (bdist == 0.) { - setmsg_("Back target coincides with observer.", (ftnlen)36); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } else if (vnorm_(bckfrt) <= svmnfr) { - setmsg_("BACK target is inside FRONT target.", (ftnlen)35); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - } else { - -/* The back target is an ellipsoid. */ - - if (bdist <= svmnbr) { - -/* The observer is INSIDE the back target. We */ -/* treat this as an error. */ - - setmsg_("Observer is inside back target body.", (ftnlen)36); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } else if (fdist == 0.) { - setmsg_("Front target coincides with observer.", (ftnlen)37); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } else if (vnorm_(bckfrt) <= svmnbr) { - setmsg_("FRONT target is inside BACK target.", (ftnlen)35); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - } - -/* Find angular separation of the target centers as */ -/* seen by the observer. */ - - trgsep = vsep_(bckpos, frtpos); - -/* Find angular radius of the outer bounding sphere of the */ -/* ellipsoid, as seen by the observer. */ - -/* In computing this angular radius, scale up the bounding */ -/* sphere to compensate for the light time error we've made */ -/* by computing light time to the target's center. The */ -/* correct value to use is light time to the limb point having */ -/* minimum angular separation from the point target. */ - -/* Presuming the ellipsoidal target can move no faster than */ -/* alpha*c (where c represents the speed of light in a vacuum), */ -/* and considering the fact that the light time error cannot */ -/* exceed r/c, where r is the radius of the outer bounding sphere */ -/* of the ellipsoid, we find that the magnitude of the position */ -/* error of the ellipsoid cannot exceed alpha*r. Then the */ -/* correctly positioned ellipsoid---that is, located at */ -/* the position corresponding to the correct light time */ -/* correction---must be contained in the outer bounding */ -/* sphere we've found, if we scale the sphere up by 1+alpha. */ - -/* Perform the test only if the observer is outside the */ -/* outer bounding sphere of the ellipsoidal target. */ - - if (pntocc) { - srad = svmxfr * 1.01; - tdist = fdist; - } else { - srad = svmxbr * 1.01; - tdist = bdist; - } - if (srad < tdist) { - d__1 = srad / tdist; - maxang = dasine_(&d__1, &c_b171); - if (trgsep > maxang) { - -/* No occultation is possible. */ - - *ocstat = FALSE_; - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - } - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - -/* We'll need the negatives of the observer-target vectors in */ -/* several places later, so compute them now. */ - - vminus_(frtpos, frtobs); - vminus_(bckpos, bckobs); - -/* Now check for an occulted state assuming a spherical extended */ -/* body with radius equal to the minimum semi-axis. Again, */ -/* adjust the sphere for our light time error. */ - - if (pntocc) { - d__1 = svmnfr * .98999999999999999 / fdist; - minang = dasine_(&d__1, &c_b171); - } else { - d__1 = svmnbr * .98999999999999999 / bdist; - minang = dasine_(&d__1, &c_b171); - } - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - if (trgsep < minang) { - -/* The targets must overlap as seen from the observer. */ - - if (pntocc) { - -/* Examine the angle between the vector from FRONT to the */ -/* observer and the vector from FRONT to BACK. If that */ -/* angle is greater than or equal to the complement of the */ -/* angular radius of FRONT, then FRONT occults BACK. First */ -/* find the position of FRONT and BACK relative to each */ -/* other. */ - - vminus_(bckfrt, frtbck); - t2sep = vsep_(frtobs, frtbck); - if (t2sep > halfpi_() - minang) { - -/* There must be an occultation. */ - - *ocstat = TRUE_; - } else { - -/* There can't be an occultation: the "back" object */ -/* is actually in transit across the "front" object. */ - - *ocstat = FALSE_; - } - } else { - -/* We're looking for a point transit condition. */ - - t2sep = vsep_(bckobs, bckfrt); - if (t2sep < halfpi_() - minang) { - -/* There must be a transit. */ - - *ocstat = TRUE_; - } else { - -/* There can't be a transit: the "back" object */ -/* actually occults the "front" object. */ - - *ocstat = FALSE_; - } - } - -/* OCSTAT has been set. */ - - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - -/* If we've reached this point, we have a situation where we */ -/* can't classify the geometry using bounding spheres. Instead, */ -/* we'll see whether the observer-point target vector intersects */ -/* the ellipsoidal body. */ - - if (pntocc) { - -/* The front body is the ellipsoid. */ - - sincpt_("Ellipsoid", svfnam, time, svffrm, svcorr, svonam, "J2000" - , bckpos, spoint, &trgepc, srfvec, &found, (ftnlen)9, ( - ftnlen)36, (ftnlen)32, (ftnlen)5, (ftnlen)36, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - if (found) { - -/* There's an intercept. If the distance from the observer */ -/* to the intercept is less than the distance from the */ -/* observer to the back target, then the back target is */ -/* occulted; otherwise there's a point transit, which is */ -/* not considered an occultation in this case. */ - - *ocstat = vnorm_(srfvec) < bdist; - } else { - -/* There's no overlap and hence no occultation. */ - - *ocstat = FALSE_; - } - } else { - -/* The back body is the ellipsoid. */ - - sincpt_("Ellipsoid", svbnam, time, svbfrm, svcorr, svonam, "J2000" - , frtpos, spoint, &trgepc, srfvec, &found, (ftnlen)9, ( - ftnlen)36, (ftnlen)32, (ftnlen)5, (ftnlen)36, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - if (found) { - -/* There's an intercept. If the distance from the observer */ -/* to the intercept is greater than the distance from the */ -/* observer to the front target, then the front target is */ -/* in transit across the back target; otherwise there's a */ -/* point occultation, which is not considered a transit in */ -/* this case. */ - - *ocstat = vnorm_(srfvec) > fdist; - } else { - -/* There's no overlap and hence no occultation. */ - - *ocstat = FALSE_; - } - } - } else { - -/* Bad combination of shapes. We expect this situation to have */ -/* been caught at initialization time, but make this check for */ -/* safety. */ - - setmsg_("The combination of shapes of front and back targets is not " - "supported: front shape = #; back shape = #.", (ftnlen)102); - errch_("#", svfshp, (ftnlen)1, (ftnlen)9); - errch_("#", svbshp, (ftnlen)1, (ftnlen)9); - sigerr_("SPICE(INVALIDSHAPECOMBO)", (ftnlen)24); - chkout_("ZZGFOCST", (ftnlen)8); - return 0; - } - chkout_("ZZGFOCST", (ftnlen)8); - return 0; -} /* zzgfocu_ */ - -/* Subroutine */ int zzgfocu_(char *occtyp, char *front, char *fshape, char * - fframe, char *back, char *bshape, char *bframe, char *obsrvr, char * - abcorr, doublereal *time, logical *ocstat, ftnlen occtyp_len, ftnlen - front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, - ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen - abcorr_len) -{ - return zzgfocu_0_(0, occtyp, front, fshape, fframe, back, bshape, bframe, - obsrvr, abcorr, time, ocstat, occtyp_len, front_len, fshape_len, - fframe_len, back_len, bshape_len, bframe_len, obsrvr_len, - abcorr_len); - } - -/* Subroutine */ int zzgfocin_(char *occtyp, char *front, char *fshape, char * - fframe, char *back, char *bshape, char *bframe, char *obsrvr, char * - abcorr, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, - ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen - bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len) -{ - return zzgfocu_0_(1, occtyp, front, fshape, fframe, back, bshape, bframe, - obsrvr, abcorr, (doublereal *)0, (logical *)0, occtyp_len, - front_len, fshape_len, fframe_len, back_len, bshape_len, - bframe_len, obsrvr_len, abcorr_len); - } - -/* Subroutine */ int zzgfocst_(doublereal *time, logical *ocstat) -{ - return zzgfocu_0_(2, (char *)0, (char *)0, (char *)0, (char *)0, (char *) - 0, (char *)0, (char *)0, (char *)0, (char *)0, time, ocstat, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzgfref.c b/ext/spice/src/cspice/zzgfref.c deleted file mode 100644 index 5a639334db..0000000000 --- a/ext/spice/src/cspice/zzgfref.c +++ /dev/null @@ -1,119 +0,0 @@ -/* zzgfref.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGFREF ( Private - GF, update REFVAL ) */ -/* Subroutine */ int zzgfref_(doublereal *refval) -{ - extern /* Subroutine */ int zzholdd_(char *, doublereal *, ftnlen); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Set reference value in the GF sub-system. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* STORE_VALUE */ -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* REFVAL I The value to set as the reference value */ - -/* $ Detailed_Input */ - -/* REFVAL the double precision scalar value to set as the */ -/* reference value for a geometry finder search. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine wraps a 'PUT' call to ZZHOLDD. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 28-NOV-2009 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* store a double precision reference value */ - -/* -& */ - -/* Store the REFVAL value for use in ZZGFUDLT. */ - - zzholdd_("PUT", refval, (ftnlen)3); - return 0; -} /* zzgfref_ */ - diff --git a/ext/spice/src/cspice/zzgfrel.c b/ext/spice/src/cspice/zzgfrel.c deleted file mode 100644 index fe98a41d74..0000000000 --- a/ext/spice/src/cspice/zzgfrel.c +++ /dev/null @@ -1,1358 +0,0 @@ -/* zzgfrel.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__7 = 7; -static integer c__0 = 0; -static logical c_true = TRUE_; - -/* $Procedure ZZGFREL ( Private --- GF, geometric relation finder ) */ -/* Subroutine */ int zzgfrel_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp - udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, - doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, - integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, - S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, - doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen - rptsuf_len) -{ - /* Initialized data */ - - static char cnames[80*7] = "< " - " " "= " - " " "> " - " " - " " "LOCMIN " - " " "ABSMIN " - " " "LOCMAX " - " " - " " "ABSMAX " - " "; - static logical cstep = FALSE_; - - /* System generated locals */ - integer work_dim1, work_dim2, work_offset, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal addl, addr__; - integer case__; - logical need; - integer name__[2], pass, want; - doublereal step; - extern /* Subroutine */ int zzgfsolv_(U_fp, U_fp, U_fp, logical *, L_fp, - logical *, doublereal *, doublereal *, doublereal *, doublereal *, - logical *, U_fp, doublereal *), zzwninsd_(doublereal *, - doublereal *, char *, doublereal *, ftnlen); - integer i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int zzgfwsts_(doublereal *, doublereal *, char *, - doublereal *, ftnlen), chkin_(char *, ftnlen), ucase_(char *, - char *, ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer minat; - doublereal endpt[2]; - integer maxat; - doublereal value; - extern integer sized_(doublereal *); - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), copyd_( - doublereal *, doublereal *); - integer qcnum; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer count; - doublereal start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - doublereal refer2; - extern logical failed_(void); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - wncard_(doublereal *); - extern logical return_(void); - char contxt[500], locrel[80]; - doublereal extrem, finish; - integer winsiz; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssized_(integer *, doublereal *), wnexpd_(doublereal *, - doublereal *, doublereal *), wnfetd_(doublereal *, integer *, - doublereal *, doublereal *), wnextd_(char *, doublereal *, ftnlen) - , wnintd_(doublereal *, doublereal *, doublereal *), wndifd_( - doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* This routine determines time intervals when the value of some */ -/* geometric quantity related to one or more objects and an observer */ -/* satisfies a user specified constraint within time intervals */ -/* specified by the window CNFINE. */ - -/* Sister routine to ZZGFRELX. Copy any edits to ZZGFREL or ZZGFRELX */ -/* to the sister routine. */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICELIB cell lower bound. */ -/* NWREQ P Minimum number of workspace windows. */ -/* UDSTEP I Name of the routine that computes and returns a */ -/* time step. */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* UDQDEC I Name of the routine that computes whether the */ -/* geometric quantity is decreasing. */ -/* UDCOND I Name of the routine that computes the geometric */ -/* condition with-respect-to the constraint. */ -/* UDFUNC I The routine that computes the geometric quantity of */ -/* interest. */ -/* UDQREF I Name of the routine that resets the current value */ -/* of REFVAL. */ -/* RELATE I Operator that either looks for an extreme value */ -/* (max, min, local, absolute) or compares the */ -/* geometric quantity value and a number. */ -/* REFVAL I Value used as reference for geometric quantity */ -/* condition. */ -/* TOL I Convergence tolerance in seconds. */ -/* ADJUST I Allowed variation for absolute extremal */ -/* geometric conditions. */ -/* CNFINE I Confinement schedule */ -/* MW I Size of workspace windows. */ -/* NW I Number of workspace windows. */ -/* WORK I Array containing workspace windows */ -/* RPT I Progress reporter on ( .TRUE.) or off ( .FALSE. ) */ -/* UDREPI I Function that initializes progress reporting. */ -/* UDREPU I Function that updates the progress report. */ -/* UDREPF I Function that finalizes progress reporting. */ -/* RPTPRE I Progress reporter beginning message. */ -/* RPTSUF I Progress reporter ending message. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* RESULT I-O SPICE window containing results. */ - - -/* $ Detailed_Input */ - -/* UDSTEP the routine that computes a time step in an attempt to */ -/* find a transition of the state of the specified */ -/* coordinate. In the context of this routine's algorithm, */ -/* a "state transition" occurs where the coordinate value */ -/* changes from "decreasing" to "not decreasing" or vice */ -/* versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. ET is a DOUBLE PRECISION number. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. STEP is a DOUBLE */ -/* PRECISION number. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine */ -/* GFSTEP may be used. This is the default option. */ - -/* UDREFN the routine that computes a refinement in the times */ -/* that bracket a transition point. In other words, once */ -/* a pair of times have been detected such that the system */ -/* is in different states at each of the two times, UDREFN */ -/* selects an intermediate time which should be closer to */ -/* the transition state than one of the two known times. */ -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 a time when the system is in state S1. */ - -/* T2 a time when the system is in state S2. T2 */ -/* is assumed to be larger than T1. */ - -/* S1 a logical indicating the state of the system */ -/* at time T1. */ - -/* S2 a logical indicating the state of the system */ -/* at time T2. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T a time to check for a state transition */ -/* between T1 and T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. This is the default option. */ - -/* UDQDEC the routine that determines if the geometric quantity */ -/* is decreasing. */ - -/* The calling sequence: */ - -/* CALL UDQDEC ( ET, ISDECR ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine the time */ -/* derivative of the geometric quantity. */ - -/* ISDECR a logical return indicating whether */ -/* or not the geometric quantity */ -/* is decreasing. ISDECR returns true if the */ -/* time derivative of the geometric quantity */ -/* at ET is negative. */ - -/* UDCOND the routine that determines if the geometric quantity */ -/* satisfies some constraint condition at epoch ET. */ - -/* The calling sequence: */ - -/* CALL UDCOND ( ET, IN_CON ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to evaluate the */ -/* geometric quantity. */ - -/* IN_CON a logical value indicating whether or */ -/* not the geometric quantity satisfies the */ -/* constraint at ET (TRUE) or not (FALSE). */ - -/* UDFUNC the routine that returns the value of the geometric */ -/* quantity at the time of interest. The calling sequence */ -/* for UDFUNC is: */ - -/* CALL UDFUNC ( TIME, VALUE ) */ - -/* where: */ - -/* TIME a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine */ -/* the value of the geometric quantity. */ - -/* VALUE is the value of the geometric quantity at */ -/* time TIME. */ - -/* UDQREF the routine that resets the current value of REFVAL. */ -/* The calling sequence for UDQREF is: */ - -/* CALL UDQREF ( REFER2 ) */ - -/* where REFER2 is a new value of REFVAL. */ - -/* RELATE is a comparison operator, indicating the numeric */ -/* constraint of interest. Values are: */ - -/* '>' value of geometric quantity greater than some */ -/* reference (REFVAL). */ - -/* '=' value of geometric quantity equal to some */ -/* reference (REFVAL). */ - -/* '<' value of geometric quantity less than some */ -/* reference (REFVAL). */ - -/* ABSMAX-the geometric quantity is at an absolute */ -/* maximum. */ - -/* ABSMIN-the geometric quantity is at an absolute */ -/* minimum. */ - -/* LOCMAX-the geometric quantity is at an local maximum. */ - -/* LOCMIN-the geometric quantity is at an local minimum. */ - -/* REFVAL Reference value for geometric quantity (in */ -/* radians, radians/sec, km, or km/sec as appropriate). */ - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in seconds */ -/* and is greater than zero. */ - -/* ADJUST The amount by which the numerical quantity is */ -/* allowed to vary from an absolute extremum. If ADJUST */ -/* is non-zero, the resulting schedule contains */ -/* intervals when the geometric quantity has */ -/* values either between ABSMIN and ABSMIN + ADJUST */ -/* or between ABSMAX and ABSMAX - ADJUST. ADJUST must */ -/* not be negative. */ - -/* CNFINE is a SPICE window that confines the bounds of the */ -/* search. Note that like all windows (see windows.req) */ -/* CNFINE can contain multiple time intervals. See the */ -/* Examples section for information on how to create this */ -/* window. */ - -/* MW is the cell size of the windows in the workspace array */ -/* WORK. */ - -/* NW is the number of windows in the workspace array WORK. */ -/* NW must be at least as large as the parameter NWREQ. */ - -/* WORK is an array used to store workspace windows. This */ -/* array has dimensions WORK (-5 : MW, NW). */ - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is on or off. The progress reporter */ -/* writes to the user's terminal. */ - -/* UDREPI the routine that initializes a progress report. */ -/* When progress reporting is enabled, UDREPI */ -/* is called at the start of a search. The calling */ -/* sequence of UDREPI is: */ - -/* UDREPI ( CNFINE, RPTPRE, RPTSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) RPTPRE */ -/* CHARACTER*(*) RPTSUF */ - -/* where */ - -/* CNFINE */ - -/* is the confinement window passed into ZZGFRELX, and */ - -/* RPTPRE */ -/* RPTSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. */ - -/* If the user has no progress reporting initialization */ -/* routine, the SPICELIB routine GFRPIN may be used. This */ -/* is the default option. */ - -/* UDREPU the routine that updates the progress report for a */ -/* search. The calling sequence of UDREPU is: */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the search's */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - -/* If the user has no progress reporting update routine, */ -/* the SPICELIB routine GFRPUD may be used. This is the */ -/* default option. */ - -/* UDREPF the routine that finalizes a progress report. UDREPF */ -/* has no arguments. */ - -/* If the user has no progress reporting finalizing */ -/* routine, the SPICELIB routine GFRPEN may be used. This */ -/* is the default option. */ - -/* RPTPRE is an array of strings containing the prefixes of */ -/* the output messages reported by the progress reporter. */ -/* The Ith element of RPTPRE is the prefix for the */ -/* message corresponding to the Ith traversal of the */ -/* confinement window executed by this routine; such */ -/* traversals are called "passes." The number of passes */ -/* executed depends on the relational operator RELATE. */ -/* Searches for local extrema and unadjusted absolute */ -/* extrema require one pass; searches for adjusted */ -/* absolute extrema, equalities, and inequalities require */ -/* two passes. */ - -/* An example of the contents of RPTPRE for a distance */ -/* equality search: */ - -/* RPTPRE(1) = 'Distance pass 1 of 2' */ -/* RPTPRE(2) = 'Distance pass 2 of 2' */ - -/* RPTSUF is an array of strings containing the suffixes of */ -/* the output messages reported by the progress reporter. */ -/* The Ith element of RPTSUF is the suffix for the */ -/* message corresponding to the Ith pass. */ - -/* An example of the contents of RPTSUF for a distance */ -/* equality search: */ - -/* RPTSUF(1) = 'done.' */ -/* RPTSUF(2) = 'done.' */ - -/* For this search, the complete progress report message */ -/* for the Ith pass has the form */ - -/* 'Distance pass I of 2 xxx.xx% done.' */ - -/* BAIL is a logical indicating whether or not interrupt */ -/* signaling is enabled. */ - -/* UDBAIL the routine that checks to see whether an interrupt */ -/* signal has been issued from, e.g. the keyboard. If */ -/* this capability is not to be used, a dummy function, */ -/* ZZGFBAIL must be supplied. */ - -/* RESULT is an initialized SPICE window. RESULT is large */ -/* enough to hold all of the intervals, within the */ -/* confinement window, on which the specified condition */ -/* is met. */ - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window containing the time intervals within */ -/* the confinement window, over which the specified */ -/* condition is met. */ - -/* RESULT is emptied before new values are assigned to */ -/* it. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* NWREQ is the required number of workspace windows; the */ -/* input argument NW must not be less than NWREQ. */ - -/* $ Exceptions */ - -/* 1) A negative value for ADJUST causes the routine to signal */ -/* the error SPICE(VALUEOUTOFRANGE). A non-zero value for ADJUST */ -/* when RELATE has any value other than "ABSMIN" or "ABSMAX", */ -/* causes the routine to signal the error SPICE(INVALIDVALUE). */ - -/* 2) If an improper comparison operator is specified, the error */ -/* SPICE(NOTRECOGNIZED) is signaled. */ - -/* 3) If TOL is not greater than zero, the error */ -/* SPICE(VALUEOUTOFRANGE) will be signaled by routines called */ -/* from this routine. */ - -/* 4) If the number of workspace windows is less than NWREQ, the */ -/* error SPICE(TOOFEWWINDOWS) is signaled. */ - -/* 5) If the window size MW is less than 2, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 6) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* visibility condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines time intervals when the value of some */ -/* geometric quantity related to one or more objects and an observer */ -/* satisfies a user specified constraint. It puts these times in a */ -/* result window called RESULT. It does this by first finding */ -/* schedules (windows) when the quantity of interest is either */ -/* monotonically increasing or decreasing. These schedules are then */ -/* manipulated to give the final result. Note that the determination */ -/* of "=" involves finding intervals where the quantity is "less */ -/* than" to a tolerance of TOL. This means that the end points of */ -/* these intervals are within TOL of being equal to the value. */ - -/* $ Examples */ - -/* See GFEVNT. */ - -/* $ Restrictions */ - -/* The kernel files to be used by ZZGFREL must be loaded (normally */ -/* via the SPICELIB routine FURNSH) before ZZGFREL is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1 21-DEC-2009 (EDW) */ - -/* Edit to Abstract to document sister routine ZZGFRELX. */ - -/* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* determine when a scalar quantity satisfies a condition */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Workspace window indices: */ - - -/* Number of supported comparison operators. */ - -/* One-letter alias for LBCELL to make references to the workspace */ -/* array tolerable: */ - - -/* Context string length: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Below we initialize the list of comparison operator names. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_dim2 = *nw; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Set constant step parameter to .FALSE.. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFREL", (ftnlen)7); - -/* Make sure we have enough workspace windows. */ - - if (*nw < 5) { - setmsg_("The number of workspace windows (#) is less than the minimu" - "m #.", (ftnlen)63); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__5, (ftnlen)1); - sigerr_("SPICE(TOOFEWWINDOWS)", (ftnlen)20); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Make sure the workspace windows can contain at least one interval. */ - - if (*mw < 2) { - setmsg_("Workspace window size was #; size must be at least 2.", ( - ftnlen)53); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Check the result window size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size was #; size must be at least 2.", (ftnlen) - 50); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Make sure the requested comparison is one we recognize. */ - - ljust_(relate, locrel, relate_len, (ftnlen)80); - ucase_(locrel, locrel, (ftnlen)80, (ftnlen)80); - qcnum = isrchc_(locrel, &c__7, cnames, (ftnlen)80, (ftnlen)80); - if (qcnum == 0) { - setmsg_("The comparison operator, # is not recognized. Supported qu" - "antities are: <, =, >, LOCMIN, ABSMIN, LOCMAX, ABSMAX.", ( - ftnlen)113); - errch_("#", relate, (ftnlen)1, relate_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Confirm ADJUST is non-negative. */ - - if (*adjust < 0.) { - setmsg_("ADJUST was #; must be non-negative.", (ftnlen)35); - errdp_("#", adjust, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Confirm ADJUST equals zero unless LOCREL (RELATE) has value */ -/* "ABSMAX" or "ABSMIN." */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) != 0 && s_cmp(locrel, - "ABSMAX", (ftnlen)80, (ftnlen)6) != 0) { - if (*adjust != 0.) { - setmsg_("ADJUST should have value zero for all comparison operat" - "ors except ABSMAX and ABSMIN", (ftnlen)83); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - } - -/* If the confinement window is empty, the result window must */ -/* be empty as well. In this case, there's not much to do. */ - - if (cardd_(cnfine) == 0) { - scardd_(&c__0, result); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* We need to set up several working windows, one each for */ -/* increasing and decreasing schedules, one for the confining */ -/* schedule and one for copying. */ - - ssized_(mw, &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", - (ftnlen)769)]); - ssized_(mw, &work[(i__1 = work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", ( - ftnlen)770)]); - ssized_(mw, &work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", ( - ftnlen)771)]); - ssized_(mw, &work[(i__1 = (work_dim1 << 2) - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", - (ftnlen)772)]); - ssized_(mw, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", ( - ftnlen)773)]); - name__[0] = 2; - name__[1] = 1; - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* For equality constraints, we work with a somewhat expanded */ -/* version of the confinement window so we can find equality */ -/* solutions that lie on the boundary of the original confinement */ -/* window. The expansion amount is ADDWIN. For other cases the */ -/* expansion amount is set to zero. */ - - if (s_cmp(relate, "=", relate_len, (ftnlen)1) == 0) { - addl = .5; - addr__ = .5; - } else { - addl = 0.; - addr__ = 0.; - } - copyd_(cnfine, &work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", - (ftnlen)799)]); - wnexpd_(&addl, &addr__, &work[(i__1 = work_dim1 * 3 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, - "zzgfrel_", (ftnlen)800)]); - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Make a local copy of the reference value. */ - - refer2 = *refval; - -/* Set the pass number for progress reporting. */ - - pass = 1; - -/* Initialize the work in progress reporter. */ - - if (*rpt) { - (*udrepi)(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "el_", (ftnlen)821)], rptpre + (pass - 1) * rptpre_len, rptsuf - + (pass - 1) * rptsuf_len, rptpre_len, rptsuf_len); - } - -/* Look up the size of the confinement schedule... */ - - count = wncard_(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, - "zzgfrel_", (ftnlen)827)]); - -/* Start the window that contains intervals when the quantity of */ -/* interest is decreasing. The result will contain all intervals in */ -/* (expanded) CNFINE when the selected geometric quantity function */ -/* is decreasing, since this is how ZZGFSOLV is configured. */ - - i__1 = count; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Locate the bounds for the I'th interval of the confinement */ -/* schedule. Results are accumulated in the WORK array. */ - - wnfetd_(&work[(i__2 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "zzgfre" - "l_", (ftnlen)840)], &i__, &start, &finish); - zzgfsolv_((U_fp)udqdec, (U_fp)udstep, (U_fp)udrefn, bail, (L_fp) - udbail, &cstep, &step, &start, &finish, tol, rpt, (U_fp) - udrepu, &work[(i__2 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", - i__2, "zzgfrel_", (ftnlen)842)]); - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - if (*bail) { - if ((*udbail)()) { - if (*rpt) { - (*udrepf)(); - } - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - } - } - if (*rpt) { - (*udrepf)(); - } - -/* Let's think about what we have now. We have the intervals in the */ -/* confinement window when a value of some kind is decreasing. */ - -/* The left endpoints are points at which the quantity begins */ -/* decreasing, thus they are times when the quantity is at a local */ -/* maximum (at least in the interior of the confinement window). */ - -/* The right endpoints are where the quantity stops decreasing. Thus */ -/* those endpoints in the interior of the confinement window are */ -/* local minima of the quantity. */ - -/* The complement relative to the confinement window is the set of */ -/* intervals within the confinement window for which the quantity is */ -/* increasing. At the left endpoints of the complement the */ -/* function is increasing. Thus the interior left endpoints are */ -/* local minima within the confinement window. The interior right */ -/* endpoints are local maxima within the confinement window. */ - -/* Moreover, to within our ability to detect local extrema, there */ -/* are no local extrema within any of the intervals. Thus, the */ -/* function may be regarded as monotone within each of */ -/* the intervals of these windows. Thus for any desired value of the */ -/* quantity, there is at most one time within each of the intervals */ -/* that the desired value is achieved. */ - - if (s_cmp(locrel, "LOCMIN", (ftnlen)80, (ftnlen)6) == 0) { - -/* We are interested in only interior minima of the quantity. */ -/* These occur at right endpoints of the intervals in TEMPW */ -/* that are interior points of CNFINE. First extract the right */ -/* endpoints. Then find those that are contained in the initial */ -/* confinement schedule, excluding endpoints. */ - - wnextd_("R", &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)908)], (ftnlen)1); - zzgfwsts_(&work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)910)], cnfine, "()", result, ( - ftnlen)2); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } else if (s_cmp(locrel, "LOCMAX", (ftnlen)80, (ftnlen)6) == 0) { - -/* We are interested in only interior maxima of the quantity. */ -/* These occur at right endpoints of the intervals in TEMPW */ -/* that are interior points of CNFINE. */ - - wnextd_("L", &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)922)], (ftnlen)1); - zzgfwsts_(&work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)924)], cnfine, "()", result, ( - ftnlen)2); - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* We will need the intervals when the quantity of interest is */ -/* increasing in value. */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0 || s_cmp(locrel, - "ABSMAX", (ftnlen)80, (ftnlen)6) == 0) { - -/* We need an absolute max or min over the schedule CNFINE. */ -/* But we have decreasing values in WORK(B,DECRES). */ -/* Make a copy of WORK(B,DECRES) then compute the schedules */ -/* of decreasing or increasing quantity over the schedule CNFINE. */ - - copyd_(&work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "el_", (ftnlen)942)], &work[(i__2 = (work_dim1 << 2) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrel_", (ftnlen)942)]); - wnintd_(cnfine, &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)944)], &work[(i__2 = work_dim1 * 5 - - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? - i__2 : s_rnge("work", i__2, "zzgfrel_", (ftnlen)944)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "l_", (ftnlen)945)], &work[(i__2 = (work_dim1 << 1) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrel_", (ftnlen)945)]); - wndifd_(cnfine, &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)947)], &work[(i__2 = work_dim1 * 5 - - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? - i__2 : s_rnge("work", i__2, "zzgfrel_", (ftnlen)947)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "l_", (ftnlen)948)], &work[(i__2 = work_dim1 - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", - i__2, "zzgfrel_", (ftnlen)948)]); - -/* Here's what we plan to do, we want to look over two schedules */ -/* DECREASING and INCREASING to search for the absolute max or */ -/* min. We start with DECREASING. In this schedule the max is */ -/* always at the left endpoint, The min is at the right */ -/* endpoint. In the INCREASING schedule the min is at the LEFT */ -/* endpoint of an interval, the max is at the RIGHT endpoint of */ -/* an interval */ - - minat = 2; - maxat = 1; - -/* As yet we still need to compute our first extremum. */ - - need = TRUE_; - -/* The extrema search is logically the same for both */ -/* maximum and minimum. We just need to keep track of */ -/* our extremum and when we find a more extreme value */ -/* replace it. DECREASING is first. */ - - for (case__ = 1; case__ <= 2; ++case__) { - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0) { - want = minat; - } else if (s_cmp(locrel, "ABSMAX", (ftnlen)80, (ftnlen)6) == 0) { - want = maxat; - } - winsiz = wncard_(&work[(i__2 = name__[(i__1 = case__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("name", i__1, "zzgfrel_", ( - ftnlen)986)] * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgfrel_", (ftnlen)986)]); - i__1 = winsiz; - for (i__ = 1; i__ <= i__1; ++i__) { - wnfetd_(&work[(i__3 = name__[(i__2 = case__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("name", i__2, "zzgfrel_", ( - ftnlen)990)] * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgfrel_", (ftnlen)990)], &i__, endpt, - &endpt[1]); - (*udfunc)(&endpt[(i__2 = want - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("endpt", i__2, "zzgfrel_", (ftnlen)993)], & - value); - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* Initialize the extreme value. This step will */ -/* be executed on the first pass through the */ -/* DECREASING interval. */ - - if (need) { - need = FALSE_; - extrem = value; - } - -/* Check to see if current VALUE is more extreme than */ -/* EXTREM. */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0) { - if (*adjust == 0. && value <= extrem) { - -/* Let's save the epoch in case it's that of the */ -/* absolute min. Add this endpoint as a singleton */ -/* interval to the RESULT window. */ - - scardd_(&c__0, result); - s_copy(contxt, "Saving current candidate epoch at wh" - "ich an absolute minimum may occur.", (ftnlen) - 500, (ftnlen)70); - zzwninsd_(&endpt[(i__2 = want - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("endpt", i__2, "zzgfrel_", ( - ftnlen)1030)], &endpt[(i__3 = want - 1) < 2 && - 0 <= i__3 ? i__3 : s_rnge("endpt", i__3, - "zzgfrel_", (ftnlen)1030)], contxt, result, ( - ftnlen)500); - } - extrem = min(extrem,value); - } else { - if (*adjust == 0. && value >= extrem) { - -/* Let's save the epoch in case it's that of the */ -/* absolute max. Add this endpoint as a singleton */ -/* interval to the RESULT window. */ - - scardd_(&c__0, result); - s_copy(contxt, "Saving current candidate epoch at wh" - "ich an absolute maximum may occur.", (ftnlen) - 500, (ftnlen)70); - zzwninsd_(&endpt[(i__2 = want - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("endpt", i__2, "zzgfrel_", ( - ftnlen)1052)], &endpt[(i__3 = want - 1) < 2 && - 0 <= i__3 ? i__3 : s_rnge("endpt", i__3, - "zzgfrel_", (ftnlen)1052)], contxt, result, ( - ftnlen)500); - } - extrem = max(extrem,value); - } - } - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* When we go to the next schedule, the min and max are at */ -/* opposite ends of the intervals. */ - - swapi_(&minat, &maxat); - } - -/* If the adjustment is zero, we're done. */ - - if (*adjust == 0.) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* We have a non-zero adjustment. we have the extreme value. Now */ -/* we need to find the epochs when the extreme value is achieved, */ -/* allowing for adjustment. */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0) { - refer2 = extrem + *adjust; - } else { - -/* The only other possible value of LOCREL within this block */ -/* is 'ABSMAX'. */ - - refer2 = extrem - *adjust; - } - -/* If we reach this point, we need to re-establish the */ -/* original expanded coverage of 'DECREASING' and 'INCREASING'. */ - - copyd_(&work[(i__1 = (work_dim1 << 2) - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "el_", (ftnlen)1107)], &work[(i__2 = (work_dim1 << 1) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrel_", (ftnlen)1107)]); - } - wndifd_(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrel_", ( - ftnlen)1111)], &work[(i__2 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgfrel_", (ftnlen)1111)], &work[(i__3 = work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgfrel_", (ftnlen)1111)]); - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - -/* We have some kind of greater than, less than, or equal to */ -/* relation to solve for. Note that ABSMAX and ABSMIN are for case */ -/* where there is a non-zero adjustment. Reset the reference value, */ -/* which may have been changed in the ABSOLUTE MAX or MIN blocks */ -/* above. */ - - (*udqref)(&refer2); - -/* If progress reporting is enabled, initialize the progress */ -/* reporter for a second pass over the confinement window. */ - - if (*rpt) { - -/* Note that the window passed to UDREPI need not contain the */ -/* same intervals as those passed to UDREPU; the window passed to */ -/* UPREPI need only have the correct measure. From UDREPI's */ -/* perspective, the sole purpose of this window is to convey to */ -/* the progress reporting system the sum of the measures of the */ -/* increasing and decreasing windows. */ - - pass = 2; - (*udrepi)(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "el_", (ftnlen)1143)], rptpre + (pass - 1) * rptpre_len, - rptsuf + (pass - 1) * rptsuf_len, rptpre_len, rptsuf_len); - } - -/* Find those intervals when the geometric quantity is less than */ -/* REFER2. */ - - scardd_(&c__0, result); - for (case__ = 1; case__ <= 2; ++case__) { - winsiz = wncard_(&work[(i__2 = name__[(i__1 = case__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("name", i__1, "zzgfrel_", (ftnlen)1155)] - * work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= - i__2 ? i__2 : s_rnge("work", i__2, "zzgfrel_", (ftnlen)1155)] - ); - -/* Search each interval of the window identified by NAME(CASE) for */ -/* times when the quantity is less than the reference value. */ - - i__1 = winsiz; - for (i__ = 1; i__ <= i__1; ++i__) { - wnfetd_(&work[(i__3 = name__[(i__2 = case__ - 1) < 2 && 0 <= i__2 - ? i__2 : s_rnge("name", i__2, "zzgfrel_", (ftnlen)1163)] * - work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && - 0 <= i__3 ? i__3 : s_rnge("work", i__3, "zzgfrel_", ( - ftnlen)1163)], &i__, &start, &finish); - -/* For each interval, accumulate the result in RESULT. */ - -/* Note we know that the behavior of the quantity is monotonic */ -/* within each window, so the step size can be large. In fact, */ -/* we use the interval length as the step size. */ - - step = finish - start; - zzgfsolv_((U_fp)udcond, (U_fp)udstep, (U_fp)udrefn, bail, (L_fp) - udbail, &c_true, &step, &start, &finish, tol, rpt, (U_fp) - udrepu, result); - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - } - } - } - if (*rpt) { - -/* Finish the progress report for the second pass. */ - - (*udrepf)(); - } - -/* RESULT is the window, within the expanded confinement window, */ -/* over which the function of interest is less than the reference */ -/* value. We can use this window to get whatever was requested. */ - - if (s_cmp(locrel, "<", (ftnlen)80, (ftnlen)1) == 0 || s_cmp(locrel, "ABS" - "MIN", (ftnlen)80, (ftnlen)6) == 0) { - -/* We simply need to restrict our result to the original */ -/* confinement schedule. Note that the ABSMIN search with */ -/* non-zero adjustment is now a search for values less than the */ -/* adjusted absolute minimum. Same for ABSMAX below. */ - - wnintd_(cnfine, result, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)1215)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "l_", (ftnlen)1216)], result); - } else if (s_cmp(locrel, ">", (ftnlen)80, (ftnlen)1) == 0 || s_cmp(locrel, - "ABSMAX", (ftnlen)80, (ftnlen)6) == 0) { - -/* Subtract from the confinement window the window where the */ -/* quantity is less than the reference value: the remainder is */ -/* the portion of the confinement window on which the quantity is */ -/* greater than or equal to the reference value. */ - - wndifd_(cnfine, result, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)1226)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "l_", (ftnlen)1227)], result); - } else { - -/* This is the branch for the relational operator '='. */ - -/* Create a window of singleton intervals from the endpoints */ -/* of RESULT. */ - - scardd_(&c__0, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)1236)]); - i__1 = cardd_(result); - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(contxt, "Inserting endpoints of result window into worksp" - "ace window WORK(B,TEMPW). These points are candidate epo" - "chs that may satisfy an equality constraint.", (ftnlen) - 500, (ftnlen)148); - zzwninsd_(&result[i__ + 5], &result[i__ + 5], contxt, &work[(i__2 - = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgfrel_", (ftnlen)1245)], (ftnlen)500); - if (failed_()) { - chkout_("ZZGFREL", (ftnlen)7); - return 0; - } - } - -/* The window WORK(B,TEMPW) contains singleton intervals where */ -/* either the equality constraint is met, or where a boundary */ -/* point of the expanded confinement window is located. We're not */ -/* interested in the boundary points; these are likely not */ -/* solution points and in any case are outside the original */ -/* confinement window. */ - -/* Keep only the endpoints of RESULT that are contained in the */ -/* original confinement window CNFINE; these are by construction */ -/* interior points of the expanded confinement window. */ - - wnintd_(cnfine, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrel_", (ftnlen)1267)], result); - } - chkout_("ZZGFREL", (ftnlen)7); - return 0; -} /* zzgfrel_ */ - diff --git a/ext/spice/src/cspice/zzgfrelx.c b/ext/spice/src/cspice/zzgfrelx.c deleted file mode 100644 index 9145a3dea4..0000000000 --- a/ext/spice/src/cspice/zzgfrelx.c +++ /dev/null @@ -1,1354 +0,0 @@ -/* zzgfrelx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__7 = 7; -static integer c__0 = 0; -static logical c_true = TRUE_; - -/* $Procedure ZZGFRELX ( Private --- GF, geometric relation finder ) */ -/* Subroutine */ int zzgfrelx_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp - udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, - doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, - integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, - S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, - doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen - rptsuf_len) -{ - /* Initialized data */ - - static char cnames[80*7] = "< " - " " "= " - " " "> " - " " - " " "LOCMIN " - " " "ABSMIN " - " " "LOCMAX " - " " - " " "ABSMAX " - " "; - static logical cstep = FALSE_; - - /* System generated locals */ - integer work_dim1, work_dim2, work_offset, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal addl, addr__; - integer case__; - logical need; - integer name__[2], pass, want; - doublereal step; - extern /* Subroutine */ int zzwninsd_(doublereal *, doublereal *, char *, - doublereal *, ftnlen); - integer i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int zzgfwsts_(doublereal *, doublereal *, char *, - doublereal *, ftnlen), chkin_(char *, ftnlen), ucase_(char *, - char *, ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer minat; - doublereal endpt[2]; - integer maxat; - doublereal value; - extern integer sized_(doublereal *); - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), copyd_( - doublereal *, doublereal *); - integer qcnum; - extern /* Subroutine */ int swapi_(integer *, integer *); - integer count; - doublereal start; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - doublereal refer2; - extern logical failed_(void); - extern /* Subroutine */ int zzgfsolvx_(S_fp, U_fp, U_fp, U_fp, logical *, - L_fp, logical *, doublereal *, doublereal *, doublereal *, - doublereal *, logical *, U_fp, doublereal *), scardd_(integer *, - doublereal *); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - wncard_(doublereal *); - extern logical return_(void); - char contxt[500], locrel[80]; - doublereal extrem, finish; - integer winsiz; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssized_(integer *, doublereal *), wnexpd_(doublereal *, - doublereal *, doublereal *), wnfetd_(doublereal *, integer *, - doublereal *, doublereal *), wnextd_(char *, doublereal *, ftnlen) - , wnintd_(doublereal *, doublereal *, doublereal *), wndifd_( - doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* This routine determines time intervals when the value of some */ -/* geometric quantity related to one or more objects and an observer */ -/* satisfies a user specified constraint within time intervals */ -/* specified by the window CNFINE. */ - -/* Sister routine to ZZGFREL. Copy any edits to ZZGFREL or ZZGFRELX */ -/* to the sister routine. */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P SPICELIB cell lower bound. */ -/* NWREQ P Minimum number of workspace windows. */ -/* UDSTEP I Name of the routine that computes and returns a */ -/* time step. */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* UDQDEC I Name of the routine that computes whether the */ -/* scalar quantity is decreasing. */ -/* UDCOND I Name of the routine that computes the scalar */ -/* quantity condition with-respect-to the constraint. */ -/* UDFUNC I The routine that computes the scalar quantity of */ -/* interest. */ -/* UDQREF I Name of the routine that resets the current value */ -/* of REFVAL. */ -/* RELATE I Operator that either looks for an extreme value */ -/* (max, min, local, absolute) or compares the */ -/* scalar quantity value and a number. */ -/* REFVAL I Value used as reference for scalar quantity */ -/* condition. */ -/* TOL I Convergence tolerance in seconds. */ -/* ADJUST I Allowed variation for absolute extremal */ -/* scalar conditions. */ -/* CNFINE I Confinement schedule */ -/* MW I Size of workspace windows. */ -/* NW I Number of workspace windows. */ -/* WORK I Array containing workspace windows */ -/* RPT I Progress reporter on ( .TRUE.) or off ( .FALSE. ) */ -/* UDREPI I Function that initializes progress reporting. */ -/* UDREPU I Function that updates the progress report. */ -/* UDREPF I Function that finalizes progress reporting. */ -/* RPTPRE I Progress reporter beginning message. */ -/* RPTSUF I Progress reporter ending message. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* RESULT I-O SPICE window containing results. */ - - -/* $ Detailed_Input */ - -/* UDSTEP the routine that computes a time step in an attempt to */ -/* find a transition of the scalar quantity. In the */ -/* context of this routine's algorithm, a "transition" */ -/* occurs where the scalar quantity value changes from */ -/* "decreasing" to "not decreasing" or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET is the input start time from which the */ -/* algorithm is to search forward for a state */ -/* transition. ET is expressed as seconds past */ -/* J2000 TDB. ET is a DOUBLE PRECISION number. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. STEP is a DOUBLE */ -/* PRECISION number. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine */ -/* GFSTEP may be used. This is the default option. */ - -/* UDREFN the routine that computes a refinement in the times */ -/* that bracket a transition point. In other words, once */ -/* a pair of times have been detected such that the system */ -/* is in different states at each of the two times, UDREFN */ -/* selects an intermediate time which should be closer to */ -/* the transition state than one of the two known times. */ -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 a time when the system is in state S1. */ - -/* T2 a time when the system is in state S2. T2 */ -/* is assumed to be larger than T1. */ - -/* S1 a logical indicating the state of the system */ -/* at time T1. */ - -/* S2 a logical indicating the state of the system */ -/* at time T2. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T a time to check for a state transition */ -/* between T1 and T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. This is the default option. */ - -/* UDQDEC the routine that determines if the scalar quantity */ -/* calculated by UDFUNC is decreasing. */ - -/* The calling sequence: */ - -/* CALL UDQDEC ( UDFUNC, ET, ISDECR ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine the time */ -/* derivative of UDFUNC. */ - -/* ISDECR a logical return indicating whether */ -/* or not the scalar value returned by UDFUNC */ -/* is decreasing. ISDECR returns true if the */ -/* time derivative of UDFUNC at ET is */ -/* negative. */ - -/* UDCOND the routine that determines if UDFUNC satisfies */ -/* some constraint condition at epoch ET. */ - -/* The calling sequence: */ - -/* CALL UDCOND ( UDFUNC, ET, IN_CON ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to evaluate UDFUNC. */ - -/* IN_CON a logical value indicating whether */ -/* or not UDFUNC satisfies the constraint */ -/* at ET (TRUE) or not (FALSE). */ - -/* UDFUNC the routine that returns the value of the scalar */ -/* quantity of interest at time ET. The calling sequence */ -/* for UDFUNC is: */ - -/* CALL UDFUNC ( ET, VALUE ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine the scalar */ -/* value. */ - -/* VALUE the double precision value of the scalar */ -/* quantity at ET. */ - -/* UDQREF the routine that resets the current value */ -/* of REFVAL. The calling sequence for UDQREF is: */ - -/* CALL UDQREF ( REFER2 ) */ - -/* where REFER2 is a new value of REFVAL. */ - -/* RELATE is a comparison operator, indicating the numeric */ -/* constraint of interest. Values are: */ - -/* '>' value of scalar quantity greater than REFVAL. */ - -/* '=' value of scalar quantity equal to REFVAL. */ - -/* '<' value of scalar quantity less than REFVAL. */ - -/* ABSMAX-the scalar quantity is at an absolute */ -/* maximum. */ - -/* ABSMIN-the scalar quantity is at an absolute */ -/* minimum. */ - -/* LOCMAX-the scalar quantity is at an local maximum. */ - -/* LOCMIN-the scalar quantity is at an local minimum. */ - -/* REFVAL reference value for scalar quantity (in */ -/* radians, radians/sec, km, or km/sec as appropriate). */ - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in seconds */ -/* and is greater than zero. */ - -/* ADJUST the amount by which the numerical quantity is */ -/* allowed to vary from an absolute extremum. If ADJUST */ -/* is non-zero, the resulting schedule contains */ -/* intervals when the scalar quantity has */ -/* values either between ABSMIN and ABSMIN + ADJUST */ -/* or between ABSMAX and ABSMAX - ADJUST. ADJUST must */ -/* not be negative. */ - -/* CNFINE is a SPICE window that confines the bounds of the */ -/* search. Note that like all windows (see windows.req) */ -/* CNFINE can contain multiple time intervals. See the */ -/* Examples section for information on how to create this */ -/* window. */ - -/* MW is the cell size of the windows in the workspace array */ -/* WORK. */ - -/* NW is the number of windows in the workspace array WORK. */ -/* NW must be at least as large as the parameter NWREQ. */ - -/* WORK is an array used to store workspace windows. This */ -/* array has dimensions WORK (-5 : MW, NW). */ - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is on or off. The progress reporter */ -/* writes to the user's terminal. */ - -/* UDREPI the routine that initializes a progress report. */ -/* When progress reporting is enabled, UDREPI */ -/* is called at the start of a search. The calling */ -/* sequence of UDREPI is: */ - -/* UDREPI ( CNFINE, RPTPRE, RPTSUF ) */ - -/* DOUBLE PRECISION CNFINE ( LBCELL : * ) */ -/* CHARACTER*(*) RPTPRE */ -/* CHARACTER*(*) RPTSUF */ - -/* where */ - -/* CNFINE */ - -/* is the confinement window passed into ZZGFRELX, and */ - -/* RPTPRE */ -/* RPTSUF */ - -/* are prefix and suffix strings used in the progress */ -/* report: these strings are intended to bracket a */ -/* representation of the fraction of work done. */ - -/* If the user has no progress reporting initialization */ -/* routine, the SPICELIB routine GFRPIN may be used. This */ -/* is the default option. */ - -/* UDREPU the routine that updates the progress report for a */ -/* search. The calling sequence of UDREPU is: */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the search's */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - -/* If the user has no progress reporting update routine, */ -/* the SPICELIB routine GFRPUD may be used. This is the */ -/* default option. */ - -/* UDREPF the routine that finalizes a progress report. UDREPF */ -/* has no arguments. */ - -/* If the user has no progress reporting finalizing */ -/* routine, the SPICELIB routine GFRPEN may be used. This */ -/* is the default option. */ - -/* RPTPRE is an array of strings containing the prefixes of */ -/* the output messages reported by the progress reporter. */ -/* The Ith element of RPTPRE is the prefix for the */ -/* message corresponding to the Ith traversal of the */ -/* confinement window executed by this routine; such */ -/* traversals are called "passes." The number of passes */ -/* executed depends on the relational operator RELATE. */ -/* Searches for local extrema and unadjusted absolute */ -/* extrema require one pass; searches for adjusted */ -/* absolute extrema, equalities, and inequalities require */ -/* two passes. */ - -/* An example of the contents of RPTPRE for a distance */ -/* equality search: */ - -/* RPTPRE(1) = 'Distance pass 1 of 2' */ -/* RPTPRE(2) = 'Distance pass 2 of 2' */ - -/* RPTSUF is an array of strings containing the suffixes of */ -/* the output messages reported by the progress reporter. */ -/* The Ith element of RPTSUF is the suffix for the */ -/* message corresponding to the Ith pass. */ - -/* An example of the contents of RPTSUF for a distance */ -/* equality search: */ - -/* RPTSUF(1) = 'done.' */ -/* RPTSUF(2) = 'done.' */ - -/* For this search, the complete progress report message */ -/* for the Ith pass has the form */ - -/* 'Distance pass I of 2 xxx.xx% done.' */ - -/* BAIL is a logical indicating whether or not interrupt */ -/* signaling is enabled. */ - -/* UDBAIL the routine that checks to see whether an interrupt */ -/* signal has been issued from, e.g. the keyboard. If */ -/* this capability is not to be used, a dummy function, */ -/* ZZGFBAIL must be supplied. */ - -/* RESULT is an initialized SPICE window. RESULT is large */ -/* enough to hold all of the intervals, within the */ -/* confinement window, on which the specified condition */ -/* is met. */ - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window containing the time intervals within */ -/* the confinement window, over which the specified */ -/* condition is met. */ - -/* RESULT is emptied before new values are assigned to */ -/* it. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* NWREQ is the required number of workspace windows; the */ -/* input argument NW must not be less than NWREQ. */ - -/* $ Exceptions */ - -/* 1) A negative value for ADJUST causes the routine to signal */ -/* the error SPICE(VALUEOUTOFRANGE). A non-zero value for ADJUST */ -/* when RELATE has any value other than "ABSMIN" or "ABSMAX", */ -/* causes the routine to signal the error SPICE(INVALIDVALUE). */ - -/* 2) If an improper comparison operator is specified, the error */ -/* SPICE(NOTRECOGNIZED) is signaled. */ - -/* 3) If TOL is not greater than zero, the error */ -/* SPICE(VALUEOUTOFRANGE) will be signaled by routines called */ -/* from this routine. */ - -/* 4) If the number of workspace windows is less than NWREQ, the */ -/* error SPICE(TOOFEWWINDOWS) is signaled. */ - -/* 5) If the window size MW is less than 2, the error */ -/* SPICE(INVALIDDIMENSION) will be signaled. */ - -/* 6) If the output SPICE window RESULT has insufficient capacity */ -/* to contain the number of intervals on which the specified */ -/* visibility condition is met, the error will be diagnosed */ -/* by a routine in the call tree of this routine. If the result */ -/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */ -/* will be signaled by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines time intervals when the value of some */ -/* scalar quantity related to one or more objects and an observer */ -/* satisfies a user specified constraint. It puts these times in a */ -/* result window called RESULT. It does this by first finding */ -/* schedules (windows) when the quantity of interest is either */ -/* monotonically increasing or decreasing. These schedules are then */ -/* manipulated to give the final result. Note that the determination */ -/* of "=" involves finding intervals where the quantity is "less */ -/* than" to a tolerance of TOL. This means that the end points of */ -/* these intervals are within TOL of being equal to the value. */ - -/* $ Examples */ - -/* See GFEVNT. */ - -/* $ Restrictions */ - -/* The kernel files to be used by ZZGFRELX must be loaded (normally */ -/* via the SPICELIB routine FURNSH) before ZZGFRELX is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0 16-FEB-2010 (EDW) */ - -/* Modified version of ZZGFREL. This version calls ZZGFSOLVX. */ - -/* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* determine when a scalar quantity satisfies a condition */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Workspace window indices: */ - - -/* Number of supported comparison operators. */ - -/* One-letter alias for LBCELL to make references to the workspace */ -/* array tolerable: */ - - -/* Context string length: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Below we initialize the list of comparison operator names. */ - - /* Parameter adjustments */ - work_dim1 = *mw + 6; - work_dim2 = *nw; - work_offset = work_dim1 - 5; - - /* Function Body */ - -/* Set constant step parameter to .FALSE.. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFRELX", (ftnlen)8); - -/* Make sure we have enough workspace windows. */ - - if (*nw < 5) { - setmsg_("The number of workspace windows (#) is less than the minimu" - "m #.", (ftnlen)63); - errint_("#", nw, (ftnlen)1); - errint_("#", &c__5, (ftnlen)1); - sigerr_("SPICE(TOOFEWWINDOWS)", (ftnlen)20); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Make sure the workspace windows can contain at least one interval. */ - - if (*mw < 2) { - setmsg_("Workspace window size was #; size must be at least 2.", ( - ftnlen)53); - errint_("#", mw, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Check the result window size. */ - - if (sized_(result) < 2) { - setmsg_("Result window size was #; size must be at least 2.", (ftnlen) - 50); - i__1 = sized_(result); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Make sure the requested comparison is one we recognize. */ - - ljust_(relate, locrel, relate_len, (ftnlen)80); - ucase_(locrel, locrel, (ftnlen)80, (ftnlen)80); - qcnum = isrchc_(locrel, &c__7, cnames, (ftnlen)80, (ftnlen)80); - if (qcnum == 0) { - setmsg_("The comparison operator, # is not recognized. Supported qu" - "antities are: <, =, >, LOCMIN, ABSMIN, LOCMAX, ABSMAX.", ( - ftnlen)113); - errch_("#", relate, (ftnlen)1, relate_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Confirm ADJUST is non-negative. */ - - if (*adjust < 0.) { - setmsg_("ADJUST was #; must be non-negative.", (ftnlen)35); - errdp_("#", adjust, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Confirm ADJUST equals zero unless LOCREL (RELATE) has value */ -/* "ABSMAX" or "ABSMIN." */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) != 0 && s_cmp(locrel, - "ABSMAX", (ftnlen)80, (ftnlen)6) != 0) { - if (*adjust != 0.) { - setmsg_("ADJUST should have value zero for all comparison operat" - "ors except ABSMAX and ABSMIN", (ftnlen)83); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - } - -/* If the confinement window is empty, the result window must */ -/* be empty as well. In this case, there's not much to do. */ - - if (cardd_(cnfine) == 0) { - scardd_(&c__0, result); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* We need to set up several working windows, one each for */ -/* increasing and decreasing schedules, one for the confining */ -/* schedule and one for copying. */ - - ssized_(mw, &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_" - , (ftnlen)764)]); - ssized_(mw, &work[(i__1 = work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_", - (ftnlen)765)]); - ssized_(mw, &work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_", - (ftnlen)766)]); - ssized_(mw, &work[(i__1 = (work_dim1 << 2) - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_" - , (ftnlen)767)]); - ssized_(mw, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_", - (ftnlen)768)]); - name__[0] = 2; - name__[1] = 1; - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* For equality constraints, we work with a somewhat expanded */ -/* version of the confinement window so we can find equality */ -/* solutions that lie on the boundary of the original confinement */ -/* window. The expansion amount is ADDWIN. For other cases the */ -/* expansion amount is set to zero. */ - - if (s_cmp(relate, "=", relate_len, (ftnlen)1) == 0) { - addl = .5; - addr__ = .5; - } else { - addl = 0.; - addr__ = 0.; - } - copyd_(cnfine, &work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 - * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_" - , (ftnlen)794)]); - wnexpd_(&addl, &addr__, &work[(i__1 = work_dim1 * 3 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, - "zzgfrelx_", (ftnlen)795)]); - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Make a local copy of the reference value. */ - - refer2 = *refval; - -/* Set the pass number for progress reporting. */ - - pass = 1; - -/* Initialize the work in progress reporter. */ - - if (*rpt) { - (*udrepi)(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "elx_", (ftnlen)816)], rptpre + (pass - 1) * rptpre_len, - rptsuf + (pass - 1) * rptsuf_len, rptpre_len, rptsuf_len); - } - -/* Look up the size of the confinement schedule... */ - - count = wncard_(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, - "zzgfrelx_", (ftnlen)822)]); - -/* Start the window that contains intervals when the quantity of */ -/* interest is decreasing. The result will contain all intervals in */ -/* (expanded) CNFINE when the selected scalar quantity function */ -/* is decreasing, since this is how ZZGFSOLVX is configured. */ - - i__1 = count; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Locate the bounds for the I'th interval of the confinement */ -/* schedule. Results are accumulated in the WORK array. */ - - wnfetd_(&work[(i__2 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "zzgfre" - "lx_", (ftnlen)835)], &i__, &start, &finish); - zzgfsolvx_((S_fp)udfunc, (U_fp)udqdec, (U_fp)udstep, (U_fp)udrefn, - bail, (L_fp)udbail, &cstep, &step, &start, &finish, tol, rpt, - (U_fp)udrepu, &work[(i__2 = (work_dim1 << 1) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrelx_", (ftnlen)837)]); - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - if (*bail) { - if ((*udbail)()) { - if (*rpt) { - (*udrepf)(); - } - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - } - } - if (*rpt) { - (*udrepf)(); - } - -/* Let's think about what we have now. We have the intervals in the */ -/* confinement window when a value of some kind is decreasing. */ - -/* The left endpoints are points at which the quantity begins */ -/* decreasing, thus they are times when the quantity is at a local */ -/* maximum (at least in the interior of the confinement window). */ - -/* The right endpoints are where the quantity stops decreasing. Thus */ -/* those endpoints in the interior of the confinement window are */ -/* local minima of the quantity. */ - -/* The complement relative to the confinement window is the set of */ -/* intervals within the confinement window for which the quantity is */ -/* increasing. At the left endpoints of the complement the */ -/* function is increasing. Thus the interior left endpoints are */ -/* local minima within the confinement window. The interior right */ -/* endpoints are local maxima within the confinement window. */ - -/* Moreover, to within our ability to detect local extrema, there */ -/* are no local extrema within any of the intervals. Thus, the */ -/* function may be regarded as monotone within each of */ -/* the intervals of these windows. Thus for any desired value of the */ -/* quantity, there is at most one time within each of the intervals */ -/* that the desired value is achieved. */ - - if (s_cmp(locrel, "LOCMIN", (ftnlen)80, (ftnlen)6) == 0) { - -/* We are interested in only interior minima of the quantity. */ -/* These occur at right endpoints of the intervals in TEMPW */ -/* that are interior points of CNFINE. First extract the right */ -/* endpoints. Then find those that are contained in the initial */ -/* confinement schedule, excluding endpoints. */ - - wnextd_("R", &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)903)], (ftnlen)1); - zzgfwsts_(&work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)905)], cnfine, "()", result, ( - ftnlen)2); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } else if (s_cmp(locrel, "LOCMAX", (ftnlen)80, (ftnlen)6) == 0) { - -/* We are interested in only interior maxima of the quantity. */ -/* These occur at right endpoints of the intervals in TEMPW */ -/* that are interior points of CNFINE. */ - - wnextd_("L", &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)917)], (ftnlen)1); - zzgfwsts_(&work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)919)], cnfine, "()", result, ( - ftnlen)2); - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* We will need the intervals when the quantity of interest is */ -/* increasing in value. */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0 || s_cmp(locrel, - "ABSMAX", (ftnlen)80, (ftnlen)6) == 0) { - -/* We need an absolute max or min over the schedule CNFINE. */ -/* But we have decreasing values in WORK(B,DECRES). */ -/* Make a copy of WORK(B,DECRES) then compute the schedules */ -/* of decreasing or increasing quantity over the schedule CNFINE. */ - - copyd_(&work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "elx_", (ftnlen)937)], &work[(i__2 = (work_dim1 << 2) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrelx_", (ftnlen)937)]); - wnintd_(cnfine, &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)939)], &work[(i__2 = work_dim1 * 5 - - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? - i__2 : s_rnge("work", i__2, "zzgfrelx_", (ftnlen)939)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "lx_", (ftnlen)940)], &work[(i__2 = (work_dim1 << 1) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrelx_", (ftnlen)940)]); - wndifd_(cnfine, &work[(i__1 = (work_dim1 << 1) - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)942)], &work[(i__2 = work_dim1 * 5 - - 5 - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? - i__2 : s_rnge("work", i__2, "zzgfrelx_", (ftnlen)942)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "lx_", (ftnlen)943)], &work[(i__2 = work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrelx_", (ftnlen)943)]); - -/* Here's what we plan to do, we want to look over two schedules */ -/* DECREASING and INCREASING to search for the absolute max or */ -/* min. We start with DECREASING. In this schedule the max is */ -/* always at the left endpoint, The min is at the right */ -/* endpoint. In the INCREASING schedule the min is at the LEFT */ -/* endpoint of an interval, the max is at the RIGHT endpoint of */ -/* an interval */ - - minat = 2; - maxat = 1; - -/* As yet we still need to compute our first extremum. */ - - need = TRUE_; - -/* The extrema search is logically the same for both */ -/* maximum and minimum. We just need to keep track of */ -/* our extremum and when we find a more extreme value */ -/* replace it. DECREASING is first. */ - - for (case__ = 1; case__ <= 2; ++case__) { - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0) { - want = minat; - } else if (s_cmp(locrel, "ABSMAX", (ftnlen)80, (ftnlen)6) == 0) { - want = maxat; - } - winsiz = wncard_(&work[(i__2 = name__[(i__1 = case__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("name", i__1, "zzgfrelx_", ( - ftnlen)981)] * work_dim1 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgfrelx_", (ftnlen)981)]); - i__1 = winsiz; - for (i__ = 1; i__ <= i__1; ++i__) { - wnfetd_(&work[(i__3 = name__[(i__2 = case__ - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("name", i__2, "zzgfrelx_", ( - ftnlen)985)] * work_dim1 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgfrelx_", (ftnlen)985)], &i__, endpt, - &endpt[1]); - (*udfunc)(&endpt[(i__2 = want - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("endpt", i__2, "zzgfrelx_", (ftnlen)988)], & - value); - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* Initialize the extreme value. This step will */ -/* be executed on the first pass through the */ -/* DECREASING interval. */ - - if (need) { - need = FALSE_; - extrem = value; - } - -/* Check to see if current VALUE is more extreme than */ -/* EXTREM. */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0) { - if (*adjust == 0. && value <= extrem) { - -/* Let's save the epoch in case it's that of the */ -/* absolute min. Add this endpoint as a singleton */ -/* interval to the RESULT window. */ - - scardd_(&c__0, result); - s_copy(contxt, "Saving current candidate epoch at wh" - "ich an absolute minimum may occur.", (ftnlen) - 500, (ftnlen)70); - zzwninsd_(&endpt[(i__2 = want - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("endpt", i__2, "zzgfrelx_", ( - ftnlen)1025)], &endpt[(i__3 = want - 1) < 2 && - 0 <= i__3 ? i__3 : s_rnge("endpt", i__3, - "zzgfrelx_", (ftnlen)1025)], contxt, result, ( - ftnlen)500); - } - extrem = min(extrem,value); - } else { - if (*adjust == 0. && value >= extrem) { - -/* Let's save the epoch in case it's that of the */ -/* absolute max. Add this endpoint as a singleton */ -/* interval to the RESULT window. */ - - scardd_(&c__0, result); - s_copy(contxt, "Saving current candidate epoch at wh" - "ich an absolute maximum may occur.", (ftnlen) - 500, (ftnlen)70); - zzwninsd_(&endpt[(i__2 = want - 1) < 2 && 0 <= i__2 ? - i__2 : s_rnge("endpt", i__2, "zzgfrelx_", ( - ftnlen)1047)], &endpt[(i__3 = want - 1) < 2 && - 0 <= i__3 ? i__3 : s_rnge("endpt", i__3, - "zzgfrelx_", (ftnlen)1047)], contxt, result, ( - ftnlen)500); - } - extrem = max(extrem,value); - } - } - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* When we go to the next schedule, the min and max are at */ -/* opposite ends of the intervals. */ - - swapi_(&minat, &maxat); - } - -/* If the adjustment is zero, we're done. */ - - if (*adjust == 0.) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* We have a non-zero adjustment. we have the extreme value. Now */ -/* we need to find the epochs when the extreme value is achieved, */ -/* allowing for adjustment. */ - - if (s_cmp(locrel, "ABSMIN", (ftnlen)80, (ftnlen)6) == 0) { - refer2 = extrem + *adjust; - } else { - -/* The only other possible value of LOCREL within this block */ -/* is 'ABSMAX'. */ - - refer2 = extrem - *adjust; - } - -/* If we reach this point, we need to re-establish the */ -/* original expanded coverage of 'DECREASING' and 'INCREASING'. */ - - copyd_(&work[(i__1 = (work_dim1 << 2) - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "elx_", (ftnlen)1102)], &work[(i__2 = (work_dim1 << 1) - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : - s_rnge("work", i__2, "zzgfrelx_", (ftnlen)1102)]); - } - wndifd_(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfrelx_", - (ftnlen)1106)], &work[(i__2 = (work_dim1 << 1) - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgfrelx_", (ftnlen)1106)], &work[(i__3 = work_dim1 - 5 - - work_offset) < work_dim1 * work_dim2 && 0 <= i__3 ? i__3 : s_rnge( - "work", i__3, "zzgfrelx_", (ftnlen)1106)]); - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - -/* We have some kind of greater than, less than, or equal to */ -/* relation to solve for. Note that ABSMAX and ABSMIN are for case */ -/* where there is a non-zero adjustment. Reset the reference value, */ -/* which may have been changed in the ABSOLUTE MAX or MIN blocks */ -/* above. */ - - (*udqref)(&refer2); - -/* If progress reporting is enabled, initialize the progress */ -/* reporter for a second pass over the confinement window. */ - - if (*rpt) { - -/* Note that the window passed to UDREPI need not contain the */ -/* same intervals as those passed to UDREPU; the window passed to */ -/* UPREPI need only have the correct measure. From UDREPI's */ -/* perspective, the sole purpose of this window is to convey to */ -/* the progress reporting system the sum of the measures of the */ -/* increasing and decreasing windows. */ - - pass = 2; - (*udrepi)(&work[(i__1 = work_dim1 * 3 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfr" - "elx_", (ftnlen)1138)], rptpre + (pass - 1) * rptpre_len, - rptsuf + (pass - 1) * rptsuf_len, rptpre_len, rptsuf_len); - } - -/* Find those intervals when the scalar quantity is less than */ -/* REFER2. */ - - scardd_(&c__0, result); - for (case__ = 1; case__ <= 2; ++case__) { - winsiz = wncard_(&work[(i__2 = name__[(i__1 = case__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("name", i__1, "zzgfrelx_", (ftnlen)1150)] - * work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && 0 - <= i__2 ? i__2 : s_rnge("work", i__2, "zzgfrelx_", (ftnlen) - 1150)]); - -/* Search each interval of the window identified by NAME(CASE) for */ -/* times when the quantity is less than the reference value. */ - - i__1 = winsiz; - for (i__ = 1; i__ <= i__1; ++i__) { - wnfetd_(&work[(i__3 = name__[(i__2 = case__ - 1) < 2 && 0 <= i__2 - ? i__2 : s_rnge("name", i__2, "zzgfrelx_", (ftnlen)1158)] - * work_dim1 - 5 - work_offset) < work_dim1 * work_dim2 && - 0 <= i__3 ? i__3 : s_rnge("work", i__3, "zzgfrelx_", ( - ftnlen)1158)], &i__, &start, &finish); - -/* For each interval, accumulate the result in RESULT. */ - -/* Note we know that the behavior of the quantity is monotonic */ -/* within each window, so the step size can be large. In fact, */ -/* we use the interval length as the step size. */ - - step = finish - start; - zzgfsolvx_((S_fp)udfunc, (U_fp)udcond, (U_fp)udstep, (U_fp)udrefn, - bail, (L_fp)udbail, &c_true, &step, &start, &finish, tol, - rpt, (U_fp)udrepu, result); - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - } - } - } - if (*rpt) { - -/* Finish the progress report for the second pass. */ - - (*udrepf)(); - } - -/* RESULT is the window, within the expanded confinement window, */ -/* over which the function of interest is less than the reference */ -/* value. We can use this window to get whatever was requested. */ - - if (s_cmp(locrel, "<", (ftnlen)80, (ftnlen)1) == 0 || s_cmp(locrel, "ABS" - "MIN", (ftnlen)80, (ftnlen)6) == 0) { - -/* We simply need to restrict our result to the original */ -/* confinement schedule. Note that the ABSMIN search with */ -/* non-zero adjustment is now a search for values less than the */ -/* adjusted absolute minimum. Same for ABSMAX below. */ - - wnintd_(cnfine, result, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)1210)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "lx_", (ftnlen)1211)], result); - } else if (s_cmp(locrel, ">", (ftnlen)80, (ftnlen)1) == 0 || s_cmp(locrel, - "ABSMAX", (ftnlen)80, (ftnlen)6) == 0) { - -/* Subtract from the confinement window the window where the */ -/* quantity is less than the reference value: the remainder is */ -/* the portion of the confinement window on which the quantity is */ -/* greater than or equal to the reference value. */ - - wndifd_(cnfine, result, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) - < work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)1221)]); - copyd_(&work[(i__1 = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "zzgfre" - "lx_", (ftnlen)1222)], result); - } else { - -/* This is the branch for the relational operator '='. */ - -/* Create a window of singleton intervals from the endpoints */ -/* of RESULT. */ - - scardd_(&c__0, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)1231)]); - i__1 = cardd_(result); - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(contxt, "Inserting endpoints of result window into worksp" - "ace window WORK(B,TEMPW). These points are candidate epo" - "chs that may satisfy an equality constraint.", (ftnlen) - 500, (ftnlen)148); - zzwninsd_(&result[i__ + 5], &result[i__ + 5], contxt, &work[(i__2 - = work_dim1 * 5 - 5 - work_offset) < work_dim1 * - work_dim2 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, - "zzgfrelx_", (ftnlen)1240)], (ftnlen)500); - if (failed_()) { - chkout_("ZZGFRELX", (ftnlen)8); - return 0; - } - } - -/* The window WORK(B,TEMPW) contains singleton intervals where */ -/* either the equality constraint is met, or where a boundary */ -/* point of the expanded confinement window is located. We're not */ -/* interested in the boundary points; these are likely not */ -/* solution points and in any case are outside the original */ -/* confinement window. */ - -/* Keep only the endpoints of RESULT that are contained in the */ -/* original confinement window CNFINE; these are by construction */ -/* interior points of the expanded confinement window. */ - - wnintd_(cnfine, &work[(i__1 = work_dim1 * 5 - 5 - work_offset) < - work_dim1 * work_dim2 && 0 <= i__1 ? i__1 : s_rnge("work", - i__1, "zzgfrelx_", (ftnlen)1262)], result); - } - chkout_("ZZGFRELX", (ftnlen)8); - return 0; -} /* zzgfrelx_ */ - diff --git a/ext/spice/src/cspice/zzgfrpwk.c b/ext/spice/src/cspice/zzgfrpwk.c deleted file mode 100644 index b805a72ff5..0000000000 --- a/ext/spice/src/cspice/zzgfrpwk.c +++ /dev/null @@ -1,1280 +0,0 @@ -/* zzgfrpwk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__1 = 1; -static integer c__0 = 0; -static doublereal c_b19 = 0.; -static doublereal c_b20 = 100.; - -/* $Procedure ZZGFRPWK ( Geometry finder report work done on a task ) */ -/* Subroutine */ int zzgfrpwk_0_(int n__, integer *unit, doublereal *total, - doublereal *freq, integer *tcheck, char *begin, char *end, doublereal - *incr, ftnlen begin_len, ftnlen end_len) -{ - /* Initialized data */ - - static integer calls = 0; - static integer stdout = 6; - static doublereal step = 0.; - static doublereal svincr = 0.; - static integer svunit = 6; - static integer check = 1; - static doublereal done = 0.; - static doublereal entire = 0.; - static char finish[13] = " "; - static logical first = TRUE_; - static integer ls = 1; - static doublereal lstsec = 0.; - static char start[55] = " " - " "; - - /* System generated locals */ - address a__1[5]; - integer i__1[5]; - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - doublereal tvec[6]; - extern /* Subroutine */ int zzgfdsps_(integer *, char *, char *, integer * - , ftnlen, ftnlen), zzcputim_(doublereal *), chkin_(char *, ftnlen) - , dpfmt_(doublereal *, char *, char *, ftnlen, ftnlen), stdio_( - char *, integer *, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - doublereal fractn; - char messge[78]; - doublereal cursec; - char prcent[10]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int writln_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* The entry points under this routine allows one to easily monitor */ -/* the status of job in progress. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* UTILITY */ -/* REPORT */ -/* WORK */ - -/* $ Declarations */ -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry points */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I-O ZZGFWKUN, ZZGFWKMO */ -/* TOTAL I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */ -/* FREQ I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */ -/* TCHECK I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */ -/* BEGIN I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */ -/* END I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */ -/* INCR I-O ZZGFWKIN, ZZGFWKMO */ - -/* $ Detailed_Input */ - -/* See the headers of the entry points. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MXBEGM, */ -/* MXENDM, */ -/* MXMSG are, respectively, the maximum lengths of the progress */ -/* message prefix, progress message suffix, and the */ -/* complete message. */ - -/* $ Exceptions */ - -/* If this routine is called directly, the error SPICE(BOGUSENTRY) */ -/* is signaled. */ - -/* See the entry points for descriptions of exceptions they detect. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The entry points under this routine are designed to allow one to */ -/* easily build into his/her application a monitoring facility */ -/* that reports how work on a particular task is proceeding. */ - -/* There are five entry points: ZZGFTSWK, ZZGFWKIN, ZZGFWKAD, */ -/* ZZGFWKUN, and ZZGFWKMO. */ - -/* The first entry point ZZGFTSWK is used to initialize the reporter. */ -/* It is used to tell the reporter "I have some work to do. This is */ -/* how much, and this is how often I want you to report on the */ -/* progress of the task." */ - -/* The second entry point ZZGFWKIN is used to tell the reporter "I've */ -/* just finished some of the task I told you about with ZZGFTSWK. */ -/* This is how much I've just done." (As in real life, the amount */ -/* of work you've just done can be negative.) The reporter uses */ -/* this information together with the information input in ZZGFTSWK */ -/* to decide whether and how much work to report as finished. The */ -/* reports will be sent to the current output device. */ - -/* The third entry point, ZZGFWKAD, adjusts the frequency with which */ -/* work progress is reported. */ - -/* The fourth entry point ZZGFWKUN also is used for testing. It is */ -/* used to send the output to the file connected to a specified */ -/* logical unit. */ - -/* The fifth entry point ZZGFWKMO is used for testing. It returns */ -/* the saved search parameters. */ - -/* A more detailed description of each entry point is provided in its */ -/* associated header. */ - -/* $ Examples */ - -/* A typical use of ZZGFRPWK might be as follows. */ - - -/* C */ -/* C Compute how much work is to be done and put it in TOTAL */ -/* C */ - -/* code */ -/* computing */ -/* how */ -/* much */ -/* work */ -/* to */ -/* do */ -/* . */ -/* . */ -/* . */ -/* TOTAL = */ - -/* C */ -/* C Tell the work reporter to report work completed every */ -/* C 3 seconds. (The third argument in ZZGFTSWK is explained */ -/* C in the header for ZZGFTSWK.) */ -/* C */ -/* FREQUENCY = 3.0D0 */ -/* BEGIN = 'Current work status: ' */ -/* END = 'completed. ' */ - -/* CALL ZZGFTSWK ( TOTAL, FREQUENCY, 1, BEGIN, END ) */ - -/* DO WHILE ( THERE_IS_MORE_WORK_TO_DO ) */ - -/* code that */ -/* performs */ -/* the work to */ -/* be done */ - -/* AMOUNT = amount of work done in this loop pass */ - -/* CALL ZZGFWKIN ( AMOUNT ) */ - -/* END DO */ - - -/* $ Restrictions */ - -/* You can use this routine to report progress on only one task at */ -/* a time. The work reporter must be initialized using ZZGFTSWK */ -/* before calling ZZGFWKIN. Failure to do this may lead to */ -/* unexpected results. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF low-level progress report umbrella */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_zzgftswk; - case 2: goto L_zzgfwkin; - case 3: goto L_zzgfwkad; - case 4: goto L_zzgfwkun; - case 5: goto L_zzgfwkmo; - } - - chkin_("ZZGFRPWK", (ftnlen)8); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZGFRPWK", (ftnlen)8); - return 0; -/* $Procedure ZZGFTSWK ( Geometry finder total sum of work to be done. ) */ - -L_zzgftswk: -/* $ Abstract */ - -/* Initialize the work progress utility. This is required prior to */ -/* use of the routine that performs the actual reporting. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* UTILITY */ -/* REPORT */ -/* WORK */ - -/* $ Declarations */ - -/* DOUBLE PRECISION TOTAL */ -/* DOUBLE PRECISION FREQ */ -/* INTEGER TCHECK */ -/* CHARACTER*(*) BEGIN */ -/* CHARACTER*(*) END */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TOTAL I A measure of the total amount of work to be done. */ -/* FREQ I How often the work progress should be reported. */ -/* TCHECK I How often to sample the system clock. */ -/* BEGIN I First part of the output message. */ -/* END I Last part of the output message. */ - -/* $ Detailed_Input */ - -/* UNIT is a logical unit connected to the output stream */ -/* to which the progress report should be sent. */ -/* Normally UNIT is set to the standard output unit, */ -/* which can be obtained by calling the SPICELIB */ -/* routine STDIO. Unit can be a logical unit connected */ -/* to a file; this feature supports testing. */ - -/* TOTAL is a measure of the total amount of work to be done */ -/* by the routine(s) that will be using this facility. */ -/* It is expected (but not required) that TOTAL is a */ -/* positive number. */ - -/* FREQ is the how often the work progress should be reported */ -/* in seconds. If FREQ = 5 then a work progress report */ -/* will be sent to the output device approximately every */ -/* 5 seconds. Since writing to the output device takes */ -/* time, the smaller FREQ is set, the greater the overhead */ -/* taken up by the work reporter will be. ( A value of 2 */ -/* or greater should not burden your application */ -/* appreciably ) */ - -/* TCHECK is an integer used to the tell the reporter how often */ -/* to sample the system clock. If TCHECK = 7, then on */ -/* every seventh call to ZZGFWKIN, the system clock will */ -/* be sampled to determine if FREQ seconds have elapsed */ -/* since the last report time. Sampling the system clock */ -/* takes time. Not a lot of time, but it does take time. */ -/* If ZZGFWKIN is being called from a loop that does not */ -/* take a lot of time for each pass, the sampling of */ -/* the system clock can become a significant overhead */ -/* cost in itself. On the VAX the sampling of the */ -/* system clock used here takes about 37 double precision */ -/* multiplies. If thousands of multiplies take place */ -/* between calls to ZZGFWKIN, the sampling time is */ -/* insignificant. On the other hand, if only a hundred or */ -/* so multiplies occur between calls to ZZGFWKIN, the */ -/* sampling of the system clock can become a significant */ -/* fraction of your overhead. TCHECK allows you to */ -/* tailor the work reporter to your application. */ - -/* If a non-positive value for TCHECK is entered, a value */ -/* of 1 will be used instead of the input value. */ - -/* BEGIN Is the first part of the output message that will be */ -/* constructed for shipment to the output device. This */ -/* message will have the form: */ - -/* BEGIN // xx.x% // END */ - -/* where xx.x is the percentage of the job completed when */ -/* the output message is sent to the output device. */ - -/* END is the second part of the output message that will be */ -/* constructed and sent to the output device (see above). */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Standard SPICE error handling. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to initialize parameters that will */ -/* be used by ZZGFWKIN. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* See the header for this module */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF low-level initialize progress report */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFTSWK", (ftnlen)8); - -/* On the first pass, obtain the logical unit for */ -/* standard output. */ - - if (first) { - stdio_("STDOUT", &stdout, (ftnlen)6); - -/* The output unit is STDOUT unless the caller */ -/* sets it to something else. */ - - svunit = stdout; - first = FALSE_; - } - -/* Save the inputs and set the amount of work done to 0 */ - - entire = *total; -/* Computing MIN */ - d__1 = 3600., d__2 = max(0.,*freq); - step = min(d__1,d__2); - check = max(1,*tcheck); - s_copy(start, begin, (ftnlen)55, begin_len); - s_copy(finish, end, (ftnlen)13, end_len); - done = 0.; - -/* Set the timer. */ - - zzcputim_(tvec); - lstsec = tvec[3] * 3600. + tvec[4] * 60. + tvec[5]; - -/* Set the increment counter */ - - calls = 0; - -/* Compose the output message. */ - - ls = rtrim_(start, (ftnlen)55); -/* Writing concatenation */ - i__1[0] = ls, a__1[0] = start; - i__1[1] = 1, a__1[1] = " "; - i__1[2] = 7, a__1[2] = " 0.00%"; - i__1[3] = 1, a__1[3] = " "; - i__1[4] = 13, a__1[4] = finish; - s_cat(messge, a__1, i__1, &c__5, (ftnlen)78); - -/* Display a blank line, make sure we don't overwrite anything */ -/* at the bottom of the screen. The display the message. */ - - if (svunit == stdout) { - zzgfdsps_(&c__1, messge, "A", &c__0, (ftnlen)78, (ftnlen)1); - } else { - -/* Write the message without special carriage control. */ - - writln_(" ", &svunit, (ftnlen)1); - writln_(" ", &svunit, (ftnlen)1); - writln_(messge, &svunit, (ftnlen)78); - } - chkout_("ZZGFTSWK", (ftnlen)8); - return 0; -/* $Procedure ZZGFWKIN ( Geometry finder work finished increment ) */ - -L_zzgfwkin: -/* $ Abstract */ - -/* Let the work reporter know that an increment of work has just */ -/* been completed. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* UTILITY */ -/* REPORT */ -/* WORK */ - -/* $ Declarations */ - -/* DOUBLE PRECISION INCR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INCR I An amount of work just completed. */ - -/* $ Detailed_Input */ - -/* INCR is some amount of work that has been completed since */ -/* the last call to ZZGFWKIN. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Standard SPICE error handling. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to report work that has been done since */ -/* initialization was performed using ZZGFTSWK or since the last */ -/* call to ZZGFWKIN. The work reporter uses this information */ -/* together with samples of the system clock to report how much of */ -/* the total job has been completed. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* See the header for this module */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.S. Elson (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* ZZGF low-level progress report increment */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFWKIN", (ftnlen)8); - svincr = *incr; - done += *incr; - ++calls; - if (entire == 0.) { - chkout_("ZZGFWKIN", (ftnlen)8); - return 0; - } - if (calls >= check) { - calls = 0; - zzcputim_(tvec); - cursec = tvec[3] * 3600. + tvec[4] * 60. + tvec[5]; - if ((d__1 = cursec - lstsec, abs(d__1)) >= step) { - lstsec = cursec; - -/* Report how much work has been done. */ - - d__1 = done / entire * 100.; - fractn = brcktd_(&d__1, &c_b19, &c_b20); - dpfmt_(&fractn, "xxx.xx", prcent, (ftnlen)6, (ftnlen)10); - *(unsigned char *)&prcent[6] = '%'; -/* Writing concatenation */ - i__1[0] = ls, a__1[0] = start; - i__1[1] = 1, a__1[1] = " "; - i__1[2] = 7, a__1[2] = prcent; - i__1[3] = 1, a__1[3] = " "; - i__1[4] = rtrim_(finish, (ftnlen)13), a__1[4] = finish; - s_cat(messge, a__1, i__1, &c__5, (ftnlen)78); - if (svunit == stdout) { - zzgfdsps_(&c__0, messge, "A", &c__0, (ftnlen)78, (ftnlen)1); - } else { - -/* Write the message without special carriage control. */ - - writln_(messge, &svunit, (ftnlen)78); - } - } - } - chkout_("ZZGFWKIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFWKAD ( Geometry finder work reporting adjustment ) */ - -L_zzgfwkad: -/* $ Abstract */ - -/* Adjust the frequency with which work progress is reported. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* UTILITY */ -/* REPORT */ -/* WORK */ - -/* $ Declarations */ - -/* DOUBLE PRECISION FREQ */ -/* INTEGER TCHECK */ -/* CHARACTER*(*) BEGIN */ -/* CHARACTER*(*) END */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TOTAL I A measure of the total amount of work to be done. */ -/* FREQ I How often the work progress should be reported. */ -/* BEGIN I First part of the output message. */ -/* END I Last part of the output message. */ - -/* $ Detailed_Input */ - -/* FREQ is the how often the work progress should be reported */ -/* in seconds. If FREQ = 5 then a work progress report */ -/* will be sent to the output device approximately every */ -/* 5 seconds. Since writing to the output device takes */ -/* time, the smaller FREQ is set, the greater the overhead */ -/* taken up by the work reporter will be. ( A value of 2 */ -/* or greater should not burden your application */ -/* appreciably ) */ - -/* TCHECK is an integer used to the tell the reporter how often */ -/* to sample the system clock. If TCHECK = 7, then on */ -/* every seventh call to ZZGFWKIN, the system clock will */ -/* be sampled to determine if FREQ seconds have elapsed */ -/* since the last report time. Sampling the system clock */ -/* takes time. Not a lot of time, but it does take time. */ -/* If ZZGFWKIN is being called from a loop that does not */ -/* take a lot of time for each pass, the sampling of */ -/* the system clock can become a significant overhead */ -/* cost in itself. On the VAX the sampling of the */ -/* system clock used here takes about 37 double precision */ -/* multiplies. If thousands of multiplies take place */ -/* between calls to ZZGFWKIN, the sampling time is */ -/* insignificant. On the other hand, if only a hundred or */ -/* so multiplies occur between calls to ZZGFWKIN, the */ -/* sampling of the system clock can become a significant */ -/* fraction of your overhead. TCHECK allows you to */ -/* tailor the work reporter to your application. */ - -/* If a non-positive value for TCHECK is entered, a value */ -/* of 1 will be used instead of the input value. */ - - -/* BEGIN Is the first part of the output message that will be */ -/* constructed for shipment to the output device. This */ -/* message will have the form: */ - -/* BEGIN // xx.x% // END */ - -/* where xx.x is the percentage of the job completed when */ -/* the output message is sent to the output device. */ - -/* END is the second part of the output message that will be */ -/* constructed and sent to the output device (see above). */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If TCHECK is less than 1, the value 1 is stored. */ - -/* 2) If FREQ is less than 0.1, the value 0.1 is stored. */ -/* If FREQ is greater than 3600, the value 3600 is stored. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point exists to modify the reporting frequency set */ -/* up by an initial call to ZZGFTSWK. In this way one can override */ -/* how often reporting of work increments is performed, without */ -/* causing the screen to be modified (which happens if a new */ -/* call to ZZGFTSWK is made.) */ - -/* It exists primarily as a back door to existing code */ -/* that calls ZZGFTSWK in a rigid way. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* See the header for this module. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF low-level progress report adjust frequency */ - -/* -& */ -/* Computing MIN */ - d__1 = 3600., d__2 = max(0.,*freq); - step = min(d__1,d__2); - check = max(1,*tcheck); - s_copy(start, begin, (ftnlen)55, begin_len); - s_copy(finish, end, (ftnlen)13, end_len); - return 0; -/* $Procedure ZZGFWUN ( Geometry finder set work report output unit ) */ - -L_zzgfwkun: -/* $ Abstract */ - -/* Set the output unit for the progress report. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* UTILITY */ -/* REPORT */ -/* WORK */ - -/* $ Declarations */ - -/* INTEGER UNIT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT I Output logical unit. */ - -/* $ Detailed_Input */ - -/* UNIT Logical unit of a text file open for write access. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* The file designated by UNIT should be a text file opened by the */ -/* calling application. */ - -/* $ Particulars */ - -/* This routine can be called before ZZGFTSWK to set the output */ -/* logical unit to that of a text file. */ - -/* This entry point exists to support testing of the higher-level */ -/* GF progress reporting routines */ - -/* GFREPI */ -/* GFREPU */ -/* GFREPF */ - -/* This routine enables TSPICE to send the output report to */ -/* a specified file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF low-level progress report output select unit */ - -/* -& */ - -/* On the first pass, obtain the logical unit for */ -/* standard output. */ - - if (first) { - stdio_("STDOUT", &stdout, (ftnlen)6); - first = FALSE_; - } - svunit = *unit; - return 0; -/* $Procedure ZZGFWKMO ( Geometry finder work reporting monitor ) */ - -L_zzgfwkmo: -/* $ Abstract */ - -/* Return saved progress report parameters. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* UTILITY */ -/* REPORT */ -/* WORK */ - -/* $ Declarations */ - -/* INTEGER UNIT */ -/* DOUBLE PRECISION TOTAL */ -/* DOUBLE PRECISION FREQ */ -/* INTEGER TCHECK */ -/* CHARACTER*(*) BEGIN */ -/* CHARACTER*(*) END */ -/* DOUBLE PRECISION INCR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UNIT O Output logical unit. */ -/* TOTAL O A measure of the total amount of work to be done. */ -/* FREQ O How often the work progress should be reported. */ -/* TCHECK O Number of calls between system time check. */ -/* BEGIN O First part of the output message. */ -/* END O Last part of the output message. */ -/* INCR O Last progress increment. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* UNIT, */ -/* TOTAL, */ -/* FREQ, */ -/* TCHECK, */ -/* BEGIN, */ -/* END, */ -/* INCR are the most recent values of these */ -/* variables passed in via calls to ZZGFTSWK, */ -/* ZZGFWKIN, or ZZGFWKAD. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point exists to support testing of the higher-level */ -/* GF progress reporting routines */ - -/* GFREPI */ -/* GFREPU */ -/* GFREPF */ - -/* This routine enables TSPICE to determine the values passed */ -/* in to entry points of this package by those routines. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* GF low-level progress report monitor */ - -/* -& */ - *unit = svunit; - *total = entire; - *freq = step; - *tcheck = check; - s_copy(begin, start, begin_len, (ftnlen)55); - s_copy(end, finish, end_len, (ftnlen)13); - *incr = svincr; - return 0; -} /* zzgfrpwk_ */ - -/* Subroutine */ int zzgfrpwk_(integer *unit, doublereal *total, doublereal * - freq, integer *tcheck, char *begin, char *end, doublereal *incr, - ftnlen begin_len, ftnlen end_len) -{ - return zzgfrpwk_0_(0, unit, total, freq, tcheck, begin, end, incr, - begin_len, end_len); - } - -/* Subroutine */ int zzgftswk_(doublereal *total, doublereal *freq, integer * - tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len) -{ - return zzgfrpwk_0_(1, (integer *)0, total, freq, tcheck, begin, end, ( - doublereal *)0, begin_len, end_len); - } - -/* Subroutine */ int zzgfwkin_(doublereal *incr) -{ - return zzgfrpwk_0_(2, (integer *)0, (doublereal *)0, (doublereal *)0, ( - integer *)0, (char *)0, (char *)0, incr, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfwkad_(doublereal *freq, integer *tcheck, char *begin, - char *end, ftnlen begin_len, ftnlen end_len) -{ - return zzgfrpwk_0_(3, (integer *)0, (doublereal *)0, freq, tcheck, begin, - end, (doublereal *)0, begin_len, end_len); - } - -/* Subroutine */ int zzgfwkun_(integer *unit) -{ - return zzgfrpwk_0_(4, unit, (doublereal *)0, (doublereal *)0, (integer *) - 0, (char *)0, (char *)0, (doublereal *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfwkmo_(integer *unit, doublereal *total, doublereal * - freq, integer *tcheck, char *begin, char *end, doublereal *incr, - ftnlen begin_len, ftnlen end_len) -{ - return zzgfrpwk_0_(5, unit, total, freq, tcheck, begin, end, incr, - begin_len, end_len); - } - diff --git a/ext/spice/src/cspice/zzgfrrq.c b/ext/spice/src/cspice/zzgfrrq.c deleted file mode 100644 index cd922a5c8e..0000000000 --- a/ext/spice/src/cspice/zzgfrrq.c +++ /dev/null @@ -1,224 +0,0 @@ -/* zzgfrrq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGFRRQ ( Private - GF, range rate between objects ) */ -/* Subroutine */ int zzgfrrq_(doublereal *et, integer *targ, integer *obs, - char *abcorr, doublereal *value, ftnlen abcorr_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal state[6]; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen); - extern logical failed_(void); - doublereal lt; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern doublereal dvnorm_(doublereal *); - extern logical return_(void); - char ref[5]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the apparent range rate between two ephemeris objects. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB */ -/* TARG I Target body ID */ -/* OBS I Observer body ID */ -/* ABCORR I Aberration correction flag */ -/* REF I Reference frame of the range rate */ -/* VALUE O Value of range rate between objects */ - -/* $ Detailed_Input */ - -/* ET is the time in ephemeris seconds past J2000 TDB at */ -/* which the range rate is to be measured. */ - -/* TARG the SPICE interger ID for the target body. */ - -/* OBS the SPICE interger ID for the observer. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* $ Detailed_Output */ - -/* VALUE is the optionally light-time corrected range */ -/* rate of TARG observed from OBS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines the apparent range rate of a target, */ -/* TARG, as seen from an observer, OBS, at epoch ET. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-JUN-2009 (NJB)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* compute the range rate between two objects. */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local Variables. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGFRRQ", (ftnlen)7); - } - -/* We just want the range rate of TARG relative to OBS. */ -/* This calculation is invariant with repect to reference */ -/* frame; we use 'J2000'. */ - - s_copy(ref, "J2000", (ftnlen)5, (ftnlen)5); - spkez_(targ, et, ref, abcorr, obs, state, <, (ftnlen)5, abcorr_len); - if (failed_()) { - chkout_("ZZGFRRQ", (ftnlen)7); - return 0; - } - -/* Calculate the derivative from the STATE vector. */ - - *value = dvnorm_(state); - -/* All done. */ - - chkout_("ZZGFRRQ", (ftnlen)7); - return 0; -} /* zzgfrrq_ */ - diff --git a/ext/spice/src/cspice/zzgfrru.c b/ext/spice/src/cspice/zzgfrru.c deleted file mode 100644 index b4f54dec18..0000000000 --- a/ext/spice/src/cspice/zzgfrru.c +++ /dev/null @@ -1,1201 +0,0 @@ -/* zzgfrru.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZGFRRU ( Private - GF, range rate utility routine ) */ -/* Subroutine */ int zzgfrru_0_(int n__, char *target, char *abcorr, char * - obsrvr, doublereal *refval, doublereal *et, doublereal *dt, logical * - decres, logical *lssthn, doublereal *rvl, ftnlen target_len, ftnlen - abcorr_len, ftnlen obsrvr_len) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal dfdt[6]; - static doublereal s_dt__; - doublereal rvel; - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen); - integer n; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char s_ref__[32]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - errch_(char *, char *, ftnlen, ftnlen); - static integer s_obs__; - extern /* Subroutine */ int dvhat_(doublereal *, doublereal *); - logical found; - doublereal drvel, state[6], srhat[6]; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen), bods2c_( - char *, integer *, logical *, ftnlen); - extern logical failed_(void); - static char s_abco__[5]; - doublereal lt; - logical attblk[15]; - static integer s_targ__; - static doublereal s_vref__; - extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_( - char *, ftnlen), setmsg_(char *, ftnlen); - doublereal states[12] /* was [6][2] */; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int zzgfrrq_(doublereal *, integer *, integer *, - char *, doublereal *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the umbrella routine for the entry points needed by */ -/* GFEVNT in order to find range rate events. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TARGET I Name of the target body */ -/* ABCORR I Aberration correction flag */ -/* OBSRVR I Name of the observing body */ -/* REFVAL I Reference value */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* DT I Interval from ET for derivative calculation. */ -/* DECRES O .TRUE. if range rate is decreasing, .FALSE. */ -/* otherwise. */ -/* LSSTHN O .TRUE. if range rate is less than REFVAL, */ -/* .FALSE. otherwise. */ -/* RVL O Range rate at time ET. */ - -/* $ Detailed_Input */ - -/* TARGET the string name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector */ -/* that points from the observer to the target. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* OBSRVR the string name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to indicate the observer as Earth. */ - -/* REFVAL the reference range rate (in km/sec) value against */ -/* which to compare the range rate of the oberrver-target */ -/* vector. */ - -/* ET time in TDB seconds past J2000 at which to calculate */ -/* the value of or characteristic of the range rate of */ -/* the observer-target vector. */ - -/* DT a scalar double precision value representing half the */ -/* interval in TDB seconds separating the evaluation */ -/* epochs; the evaluations occur at epochs */ -/* (ET + DT) and (ET - DT). */ - -/* DT may be negative but must be non-zero. */ - -/* For more information, see individual entry points. */ - -/* $ Detailed_Output */ - -/* LSSTHN is .TRUE. if the range rate between the two bodies is */ -/* less than the reference range rate value REFVAL at */ -/* time ET. Otherwise it is .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as the umbrella routine for 4 entry points */ -/* needed by GFEVNT in solving for range rate conditions. */ - -/* The 4 entry points are */ - -/* ZZGFRRIN --- an initialization routine that must be called */ -/* prior to attempting to solve for any range */ -/* rate event. */ - -/* ZZGFRRUR --- updates reference value, REFVAL. */ - -/* ZZGFRRDC --- determines whether or not range rate is */ -/* decreasing at some time. */ - -/* ZZGFRRGQ --- returns the range rate of the two objects */ -/* of concern as a function of ET. */ - -/* ZZGFRRLT --- determines whether or not range rate is */ -/* less than REFVAL */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* ZZGFRRIN must be called prior to use of any of the other */ -/* entry points (think constructor). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-OCT-2009 (LSE)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* find range rate events */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - switch(n__) { - case 1: goto L_zzgfrrin; - case 2: goto L_zzgfrrur; - case 3: goto L_zzgfrrdc; - case 4: goto L_zzgfrrgq; - case 5: goto L_zzgfrrlt; - } - - return 0; -/* $Procedure ZZGFRRIN ( Private - GF, range rate initialization routine ) */ - -L_zzgfrrin: -/* $ Abstract */ - -/* This is the initialization entry point used for describing */ -/* the event that is to be solved for by ZZGFSOLV. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* CHARACTER*(*) TARGET */ -/* CHARACTER*(*) ABCORR */ -/* CHARACTER*(*) OBSRVR */ -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TARGET I Name of the target body */ -/* ABCORR I Aberration correction flag */ -/* OBSRVR I Name of the observing body */ -/* REFVAL I Reference value */ -/* DT I Interval from ET for derivative calculation. */ - -/* $ Detailed_Input */ - -/* TARGET the string name of a target body. Optionally, you may */ -/* supply the integer ID code for the object as an */ -/* integer string. For example both 'MOON' and '301' */ -/* are legitimate strings that indicate the moon is the */ -/* target body. */ - -/* The target and observer define a position vector */ -/* that points from the observer to the target. */ - -/* ABCORR the string description of the aberration corrections to */ -/* apply to the state evaluations to account for one-way */ -/* light time and stellar aberration. */ - -/* Any aberration correction accepted by the SPICE */ -/* routine SPKEZR is accepted here. See the header */ -/* of SPKEZR for a detailed description of the */ -/* aberration correction options. For convenience, */ -/* the options are listed below: */ - -/* 'NONE' Apply no correction. Returns the "true" */ -/* geometric state. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* OBSRVR the string name of an observing body. Optionally, you */ -/* may supply the ID code of the object as an integer */ -/* string. For example, both 'EARTH' and '399' are */ -/* legitimate strings to indicate the observer as Earth. */ - -/* REFVAL the reference range rate (in km/sec) value against */ -/* which to compare the range rate of the oberrver-target */ -/* vector. */ - -/* DT a scalar double precision value representing half the */ -/* interval in TDB seconds separating the evaluation */ -/* epochs; the evaluations occur at epochs */ -/* (ET + DT) and (ET - DT). */ - -/* DT may be negative but must be non-zero. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-OCT-2009 (LSE)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* range rate initialization routine. */ - -/* -& */ - if (return_()) { - return 0; - } - chkin_("ZZGFRRIN", (ftnlen)8); - -/* Find NAIF IDs for TARGET and OBSRVR. */ - - bods2c_(target, &s_targ__, &found, target_len); - if (! found) { - setmsg_("The target object, '#', is not a recognized name for an eph" - "emeris object. The cause of this problem may be that you nee" - "d an updated version of the SPICE Toolkit. ", (ftnlen)162); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFRRIN", (ftnlen)8); - return 0; - } - bods2c_(obsrvr, &s_obs__, &found, obsrvr_len); - if (! found) { - setmsg_("The observer, '#', is not a recognized name for an ephemeri" - "s object. The cause of this problem may be that you need an " - "updated version of the SPICE toolkit. ", (ftnlen)157); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFRRIN", (ftnlen)8); - return 0; - } - -/* Make sure the observer and target are distinct. */ - - if (s_targ__ == s_obs__) { - setmsg_("The observer and target must be distinct objects, but are n" - "ot: OBSRVR = #; TARGET = #.", (ftnlen)86); - errch_("#", obsrvr, (ftnlen)1, obsrvr_len); - errch_("#", target, (ftnlen)1, target_len); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ZZGFRRIN", (ftnlen)8); - return 0; - } - -/* Squeeze all blanks out of the aberration correction */ -/* string; ensure the string is in upper case. */ - - cmprss_(" ", &c__0, abcorr, s_abco__, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(s_abco__, s_abco__, (ftnlen)5, (ftnlen)5); - -/* Check the aberration correction. If SPKEZR can't handle it, */ -/* neither can we. */ - - zzvalcor_(s_abco__, attblk, (ftnlen)5); - if (failed_()) { - chkout_("ZZGFRRIN", (ftnlen)8); - return 0; - } - -/* Save the reference value. */ - - s_vref__ = *refval; - s_copy(s_ref__, "J2000", (ftnlen)32, (ftnlen)5); - s_dt__ = *dt; - chkout_("ZZGFRRIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFRRUR ( Private - GF, range rate update reference value ) */ - -L_zzgfrrur: -/* $ Abstract */ - -/* This is the entry point used for updating the reference */ -/* value. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* REFVAL I Reference value */ - -/* $ Detailed_Input */ - -/* REFVAL the reference range rate (in km/sec) value against */ -/* which to compare the range rate of the oberrver-target */ -/* vector. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-JUN-2009 (LSE)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* range rate update reference value. */ - -/* -& */ - s_vref__ = *refval; - return 0; -/* $Procedure ZZGFRRDC ( Private - GF, when range rate is decreasing ) */ - -L_zzgfrrdc: -/* $ Abstract */ - -/* Computes whether or not the range rate between the observer */ -/* and the target is decreasing at time ET. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL DECRES */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* DECRES O .TRUE. if range rate is decreasing, .FALSE. */ -/* otherwise. */ - -/* $ Detailed_Input */ - -/* ET time in seconds past J2000 at which to calculate */ -/* whether the range rate of the observer-target vector */ -/* is decreasing. */ - -/* $ Detailed_Output */ - -/* DECRES is .TRUE. if the range rate between the objects */ -/* is decreasing. Otherwise it is .FALSE. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-OCT-2009 (LSE)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* when range rate is decreasing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGFRRDC", (ftnlen)8); - } - n = 6; - -/* The range rate of interest is of S_TARG relative to the S_OBS. */ -/* The function requires the acceleration of S_TARG relative */ -/* to S_OBS. */ - - d__1 = *et - s_dt__; - spkez_(&s_targ__, &d__1, s_ref__, s_abco__, &s_obs__, states, <, ( - ftnlen)32, (ftnlen)5); - d__1 = *et + s_dt__; - spkez_(&s_targ__, &d__1, s_ref__, s_abco__, &s_obs__, &states[6], <, ( - ftnlen)32, (ftnlen)5); - -/* Approximate the derivative of the position and valocity by */ -/* finding the derivative of a quadratic approximating function. */ - -/* DFDT(1) = Vx */ -/* DFDT(2) = Vy */ -/* DFDT(3) = Vz */ -/* DFDT(4) = Ax */ -/* DFDT(5) = Ay */ -/* DFDT(6) = Az */ - - qderiv_(&n, states, &states[6], &s_dt__, dfdt); - spkez_(&s_targ__, et, s_ref__, s_abco__, &s_obs__, state, <, (ftnlen)32, - (ftnlen)5); - if (failed_()) { - chkout_("ZZGFRRDC", (ftnlen)8); - return 0; - } - -/* d ||r|| ^ */ -/* ------- = < r, v > */ -/* dt */ - -/* 2 ^ ^ */ -/* d ||r|| < d r, v > + < r, d v > */ -/* ------- = --- --- */ -/* 2 */ -/* dt dt dt */ - - dvhat_(state, srhat); - drvel = vdot_(&dfdt[3], srhat) + vdot_(&state[3], &srhat[3]); - *decres = drvel < 0.; - chkout_("ZZGFRRDC", (ftnlen)8); - return 0; -/* $Procedure ZZGFRRGQ ( Private - GF, get range rate between two bodies ) */ - -L_zzgfrrgq: -/* $ Abstract */ - -/* Determine the range rate between the centers of the two */ -/* bodies. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION RVL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* RVL O Range rate at time ET. */ - -/* $ Detailed_Input */ - -/* ET time in ephemeris seconds past J2000 when the range */ -/* rate between the two bodies is to be computed. */ - -/* $ Detailed_Output */ - -/* RVL is the range rate of S_TARG as seen from S_OBS at */ -/* time ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-JUN-2009 (LSE)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* get range rate between two bodies */ - -/* -& */ - zzgfrrq_(et, &s_targ__, &s_obs__, s_abco__, rvl, (ftnlen)5); - return 0; -/* $Procedure ZZGFRRLT ( Private - GF, range rate < reference ) */ - -L_zzgfrrlt: -/* $ Abstract */ - -/* Determine whether or not the range rate between the two */ -/* bodies is less than the reference value. */ - -/* $ 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 */ - -/* RANGE RATE */ -/* EPHEMERIS */ -/* GEOMETRY */ -/* SEARCH */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL LSSTHN */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* LSSTHN O .TRUE. if the range rate is less than */ -/* REFVAL, .FALSE. otherwise. */ - -/* $ Detailed_Input */ - -/* ET is the time in second past J2000 at which one wants */ -/* to determine if the range rate between the */ -/* two bodies is less than the reference value. */ - -/* $ Detailed_Output */ - -/* LSSTHN is .TRUE. if the range rate between the two bodies is */ -/* less than the reference range rate value S_VREF at */ -/* time ET. Otherwise it is .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 09-JUN-2009 (LSE)(EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* range rate less than a value */ - -/* -& */ - zzgfrrq_(et, &s_targ__, &s_obs__, s_abco__, &rvel, (ftnlen)5); - if (rvel < s_vref__) { - *lssthn = TRUE_; - } else { - *lssthn = FALSE_; - } - return 0; -} /* zzgfrru_ */ - -/* Subroutine */ int zzgfrru_(char *target, char *abcorr, char *obsrvr, - doublereal *refval, doublereal *et, doublereal *dt, logical *decres, - logical *lssthn, doublereal *rvl, ftnlen target_len, ftnlen - abcorr_len, ftnlen obsrvr_len) -{ - return zzgfrru_0_(0, target, abcorr, obsrvr, refval, et, dt, decres, - lssthn, rvl, target_len, abcorr_len, obsrvr_len); - } - -/* Subroutine */ int zzgfrrin_(char *target, char *abcorr, char *obsrvr, - doublereal *refval, doublereal *dt, ftnlen target_len, ftnlen - abcorr_len, ftnlen obsrvr_len) -{ - return zzgfrru_0_(1, target, abcorr, obsrvr, refval, (doublereal *)0, dt, - (logical *)0, (logical *)0, (doublereal *)0, target_len, - abcorr_len, obsrvr_len); - } - -/* Subroutine */ int zzgfrrur_(doublereal *refval) -{ - return zzgfrru_0_(2, (char *)0, (char *)0, (char *)0, refval, (doublereal - *)0, (doublereal *)0, (logical *)0, (logical *)0, (doublereal *)0, - (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfrrdc_(doublereal *et, logical *decres) -{ - return zzgfrru_0_(3, (char *)0, (char *)0, (char *)0, (doublereal *)0, et, - (doublereal *)0, decres, (logical *)0, (doublereal *)0, (ftnint) - 0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfrrgq_(doublereal *et, doublereal *rvl) -{ - return zzgfrru_0_(4, (char *)0, (char *)0, (char *)0, (doublereal *)0, et, - (doublereal *)0, (logical *)0, (logical *)0, rvl, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfrrlt_(doublereal *et, logical *lssthn) -{ - return zzgfrru_0_(5, (char *)0, (char *)0, (char *)0, (doublereal *)0, et, - (doublereal *)0, (logical *)0, lssthn, (doublereal *)0, (ftnint) - 0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzgfsavh_c.c b/ext/spice/src/cspice/zzgfsavh_c.c deleted file mode 100644 index 136c64ad9b..0000000000 --- a/ext/spice/src/cspice/zzgfsavh_c.c +++ /dev/null @@ -1,281 +0,0 @@ -/* - --Procedure zzgfsavh_c ( GF, save interrupt handler status ) - --Abstract - - CSPICE Private routine intended solely for the support of CSPICE - routines. Users should not call this routine directly due - to the volatile nature of this routine. - - Store the interrupt handler status polled by gfbail_c. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - #include - #include "SpiceUsr.h" - - - static SpiceBoolean signalStatus = SPICEFALSE; - - - void zzgfsavh_c ( SpiceBoolean status ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - status I Interrupt status. - --Detailed_Input - - status is a logical flag indicating whether the most - recent instance of the interrupt signal - SIGINT has processed by the GF subsystem. See - the Particulars section below for details. - - The value of `status' is stored in static memory by this routine. - - --Detailed_Output - - None. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - The static status flag `signalStatus' is initialized by this routine - to SPICEFALSE. If an interrupt signal is raised and the default GF - interrupt polling routine gfbail_c is used, then the interrupt - signal handler gfinth_c will set the interrupt status to SPICETRUE. - The interrupt status must be cleared via a call to gfclrh_c before - interrupt processing can resume. - - This file shares access to the static variable `signalStatus' with - the routine zzgfgeth_c. - --Examples - - See usage in gfinth_c. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 13-APR-2009 (NJB) - --Index_Entries - - GF save interrupt status - --& -*/ - -{ /* Begin zzgfsavh_c */ - - - /* - Simply save the input status value. - */ - - signalStatus = status; - - -} /* End zzgfsavh_c */ - - - - - -/* - --Procedure zzgfgeth_c ( GF, get interrupt handler status ) - --Abstract - - CSPICE Private routine intended solely for the support of CSPICE - routines. Users should not call this routine directly due - to the volatile nature of this routine. - - Return the saved interrupt handler status. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - UTILITY - -*/ - - SpiceBoolean zzgfgeth_c ( void ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - - The function returns the saved interrupt status. - --Detailed_Input - - None. - --Detailed_Output - - This function returns the interrupt signal status stored - by the last call to zzgfsavh_c. If no such call has occurred, - then the value SPICEFALSE is returned. - --Parameters - - None. - --Exceptions - - None. - --Files - - None. - --Particulars - - The static status flag `signalStatus' is initialized by this routine - to SPICEFALSE. If an interrupt signal is raised and the default GF - interrupt polling routine gfbail_c is used, then the interrupt - signal handler gfinth_c will set the interrupt status to SPICETRUE. - The interrupt status must be cleared via a call to gfclrh_c before - interrupt processing can resume. - - This file shares access to the static variable `signalStatus' with - the routine zzgfsavh_c. - --Examples - - See usage in gfbail_c. - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 13-APR-2009 (NJB) - --Index_Entries - - GF get interrupt status - --& -*/ - -{ /* Begin zzgfgeth_c */ - - - /* - Simply return the saved status value. - */ - - return ( signalStatus ); - - -} /* End zzgfgeth_c */ - - diff --git a/ext/spice/src/cspice/zzgfsolv.c b/ext/spice/src/cspice/zzgfsolv.c deleted file mode 100644 index 6f0d67dd77..0000000000 --- a/ext/spice/src/cspice/zzgfsolv.c +++ /dev/null @@ -1,795 +0,0 @@ -/* zzgfsolv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1000 = 1000; - -/* $Procedure ZZGFSOLV ( Private --- GF, event finding routine ) */ -/* Subroutine */ int zzgfsolv_(S_fp udcond, S_fp udstep, S_fp udrefn, logical - *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal * - start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, - doublereal *result) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzwninsd_(doublereal *, doublereal *, char *, - doublereal *, ftnlen); - logical s; - doublereal begin, t; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - integer nloop; - logical l1, l2, savst; - doublereal t1, t2; - logical state1; - extern logical failed_(void); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *), - touchd_(doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - logical instat; - doublereal curtim, svdtim, timest; - logical curste; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - char contxt[256]; - doublereal trnstn; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine is a root finding general purpose event location */ -/* routine. Most of the HARD work has been delegated to other */ -/* routines (In particular, how the dynamic step size is chosen). */ - -/* Sister routine to ZZGFSOLVX. Copy any edits to ZZGFSOLV or */ -/* ZZGFSOLVX to the sister routine. */ - -/* $ 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 */ - -/* ROOT */ -/* SEARCH */ -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UDCOND I Name of the routine that compares the current state */ -/* condition with-respect-to a constraint. */ -/* UDSTEP I Name of the routine that computes a time step */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* CSTEP I Logical indicating constant step size. */ -/* STEP I Constant step size in seconds for finding geometric */ -/* events. */ -/* START I Beginning of the search interval. */ -/* FINISH I End of the search interval. */ -/* TOL I Maximum error in detection of state transitions. */ -/* RPT I Progress reporter on ( .TRUE.) or off ( .FALSE. ) */ -/* UDREPU I Function that updates the progress report. */ -/* RESULT I-O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* The first three inputs to this routine are names of */ -/* subroutines that this routine will call. These routines */ -/* should meet the following specifications. */ - -/* UDCOND the routine that determines if the system state */ -/* satisfies some constraint condition at epoch ET. */ - -/* The calling sequence: */ - -/* CALL UDCOND ( ET, IN_CON ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to evaluate the state. */ - -/* IN_CON a logical value indicating whether */ -/* or not the quantity satisfies the */ -/* constraint at ET (TRUE) or not (FALSE). */ - -/* UDSTEP the routine that computes a time step in an attempt to */ -/* find a transition of the state of the specified */ -/* coordinate. In the context of this routine's algorithm, */ -/* a "state transition" occurs where the geometric state */ -/* changes from being in the desired geometric condition */ -/* event to not, or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, from which the algorithm is to */ -/* search forward for a state transition. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine */ - -/* GFSTEP */ - -/* may be used. This is the default option. If using */ -/* GFSTEP, the step size must be set by calling */ - -/* GFSSTP(STEP) */ - -/* prior to calling this routine. */ - -/* UDREFN the routine that computes a refinement in the times */ -/* that bracket a transition point. In other words, once */ -/* a pair of times have been detected such that the system */ -/* is in different states at each of the two times, UDREFN */ -/* selects an intermediate time which should be closer to */ -/* the transition state than one of the two known times. */ -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 a time when the system is in state S1. */ - -/* T2 a time when the system is in state S2. T2 */ -/* is assumed to be larger than T1. */ - -/* S1 a logical indicating the state of the system */ -/* at time T1. */ - -/* S2 a logical indicating the state of the system */ -/* at time T2. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T a time to check for a state transition */ -/* between T1 and T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. This is the default option. */ - -/* BAIL is a logical indicating whether or not interrupt */ -/* signaling is enabled. When `bail' is set to TRUE, */ -/* the input function UDBAIL (see description below) */ -/* is used to determine whether an interrupt has been */ -/* issued. */ - -/* UDBAIL the routine that indicates whether an interrupt signal */ -/* has been issued (for example, from the keyboard). */ -/* UDBAIL has no arguments and returns a logical. */ -/* The return value is .TRUE. if an interrupt has */ -/* been issued; otherwise the value is .FALSE. */ - -/* ZZGFSOLVX uses UDBAIL only when BAIL (see above) is set */ -/* to .TRUE., indicating that interrupt handling is */ -/* enabled. When interrupt handling is enabled, ZZGFSOLVX */ -/* and will call UDBAIL to determine whether to terminate */ -/* processing and return immediately. */ - -/* If interrupt handing is not enabled, a logical */ -/* function must still be passed as an input argument. */ -/* The function */ - -/* GFBAIL */ - -/* may be used for this purpose. */ - -/* CSTEP is a logical indicating whether or not the step size */ -/* used in searching is constant. If it is, the value */ -/* STEP is used. Note that even if UDSTEP has the value */ -/* GFSTEP, i.e. the public, constant step routine, CSTEP */ -/* should still be .FALSE., in which case STEP is ignored. */ - -/* STEP is the step size to be used in the search. STEP must */ -/* be short enough for a search using this step size */ -/* to locate the time intervals where the geometric */ -/* event function is monotone increasing or decreasing. */ -/* However, STEP must not be *too* short, or the */ -/* search will take an unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; */ -/* precision is controlled by the convergence */ -/* the tolerance, TOL. */ - -/* STEP has units of TDB seconds. */ - -/* START is the beginning of the interval over which the state */ -/* is to be detected. */ - -/* FINISH is the end of the interval over which the state is */ -/* to be detected. */ - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in seconds */ -/* and is greater than zero. */ - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is enabled. When RPT is TRUE, */ -/* progress reporting is enabled and the routine */ -/* UDREPU (see description below) reports progress. */ - -/* UDREPU the routine that updates the progress report for a */ -/* search. The calling sequence of UDREPU is */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the searches */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - -/* If the user doesn't wish to provide a custom set of */ -/* progress reporting functions, the routine */ - -/* GFREPU */ - -/* may be used. */ - -/* RESULT is an initialized SPICE window. RESULT may not be empty */ -/* on entry and must be large enough to hold all of the */ -/* intervals found by the search. */ - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window containing the intersection of the */ -/* results of the search and the contents of RESULT */ -/* on entry. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* $ Exceptions */ - -/* 1) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) */ -/* will signal. */ - -/* 2) If START +/- TOL is indistinguishable from START or */ -/* FINISH +/- TOL is indistinguishable from FINISH, the */ -/* error SPICE(INVALIDVALUE) will signal. */ - -/* 3) If START is greater than FINISH or SVDTIM is greater than */ -/* CURTIM, SPICE(BADTIMECASE) will signal. */ - -/* 4) If the inner convergence loop fails to converge to TOL */ -/* within MXLOOP iterations, the error SPICE(NOCONVERG) */ -/* will signal. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* $ Particulars */ - -/* This routine implements a strategy for searching for geometric */ -/* state events important for planning solar system observations. */ -/* The actual details of selecting time steps while searching for */ -/* a state change as well as the scheme used for zeroing in on the */ -/* actual time of transition are handled by lower level routines. */ - -/* By delegating the work of selecting search time steps and the */ -/* process of refining a transition time estimate to lower level */ -/* routines, the common work of the search can be isolated here. */ -/* The routines that do the decision making, can be modified */ -/* and made smarter as time permits. */ - -/* $ Examples */ - -/* See GFOCCE and ZZGFREL. */ - -/* $ Restrictions */ - -/* It is important that the user understand how the routines */ -/* UDCOND, UDSTEP and UDREFN are to be used and that the */ -/* calling sequences match precisely with the descriptions given */ -/* here. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L. S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1 21-DEC-2009 (EDW) */ - -/* Edit to Abstract to document sister routine ZZGFSOLVX. Added */ -/* N.J. Bachman citation to Author_and_Institution section. */ - -/* - SPICELIB Version 1.0.0, 17-MAR-2009 (EDW)(LSE)(NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find times of an event */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local variables */ - - -/* The maximum number of search loop iterations to execute. */ -/* The default refinement method is bisection, a very slow */ -/* method to convergence. Since 2**1000 ~ 10**301, */ -/* 1000 loop iterations represents enough effort to assume */ -/* either the search will not converge or that the refinement */ -/* function operates slower than would bisection, in which */ -/* case the user should use the default GFREFN function. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFSOLV", (ftnlen)8); - -/* Make sure TOL is positive. */ - - if (*tol <= 0.) { - setmsg_("TOL was #; must be positive.", (ftnlen)28); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* Make sure that START is not greater than FINISH. Signal an */ -/* error for START > FINISH. */ - - if (*start > *finish) { - setmsg_("Bad time interval result, START > FINISH.", (ftnlen)41); - sigerr_("SPICE(BADTIMECASE)", (ftnlen)18); - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* Make sure that TOL is not too small, i.e. that neither */ -/* START + TOL nor START - TOL equals START. */ - - d__1 = *start - *tol; - d__2 = *start + *tol; - if (touchd_(&d__1) == *start || touchd_(&d__2) == *start) { - setmsg_("TOL has value #1. This value is too small to distinguish ST" - "ART - TOL or START + TOL from START, #2.", (ftnlen)99); - errdp_("#1", tol, (ftnlen)2); - errdp_("#2", start, (ftnlen)2); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* Make sure that TOL is not too small, i.e. that neither */ -/* START + TOL nor START - TOL equals START. */ - - d__1 = *finish - *tol; - d__2 = *finish + *tol; - if (touchd_(&d__1) == *finish || touchd_(&d__2) == *finish) { - setmsg_("TOL has value #1. This value is too small to distinguish FI" - "NISH - TOL or FINISH + TOL from FINISH, #2.", (ftnlen)102); - errdp_("#1", tol, (ftnlen)2); - errdp_("#2", finish, (ftnlen)2); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* If active, update the progress reporter. */ - - if (*rpt) { - (*udrepu)(start, finish, start); - } - -/* This algorithm determines those intervals when a given state */ -/* is observed to occur within a specified search interval. */ - -/* Pairs of times are recorded. The first member of each pair */ -/* denotes the time when the system changes to the state of */ -/* interest. The second denotes a transition out of that state. */ - -/* If the system is in the state of interest at the beginning of */ -/* the interval, the beginning of the time interval will be */ -/* recorded. This may or may not be a transition point. */ - -/* Similarly if the system is in the state of interest at the end */ -/* of the interval, the end of the interval will be recorded. */ -/* Again, this may or may not be a transition point. */ - - -/* Initially the current time is the beginning of the search */ -/* interval. */ - - curtim = *start; - -/* Determine if the state at the current time satisfies some */ -/* constraint. This constraint may indicate only existence of */ -/* a state. */ - - (*udcond)(&curtim, &curste); - if (failed_()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* If the system is in the state of interest, record the initial */ -/* time of the search interval. */ - - if (curste) { - instat = TRUE_; - begin = curtim; - } else { - instat = FALSE_; - } - -/* If the step size is constant, use the value supplied. */ - - if (*cstep) { - timest = *step; - } - -/* Save the current time and state somewhere. */ - - svdtim = curtim; - savst = curste; - -/* Once initializations have been performed keep working */ -/* until the search interval has been exhausted. */ - -/* While time remains in the search interval. */ - - while(svdtim < *finish) { - -/* Using the current window and internally stored */ -/* information about the current state, select a new current */ -/* time. */ - - if (! (*cstep)) { - (*udstep)(&curtim, ×t); - if (failed_()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - } - -/* Add the time step to the current time. Make sure that the */ -/* time does not move beyond the end of the search interval. */ - -/* Computing MIN */ - d__1 = curtim + timest; - curtim = min(d__1,*finish); - -/* Compute the state at time CURTIM. */ - - (*udcond)(&curtim, &curste); - if (failed_()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* While the state remains unchanged and the interval is not */ -/* completely searched ... */ - - while(savst == curste && svdtim < *finish) { - -/* First check for an interrupt signal if checking is enabled. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - } - -/* Report the current time to the monitoring utility, if */ -/* appropriate. */ - - if (*rpt) { - (*udrepu)(start, finish, &svdtim); - } - -/* Save the current time and state somewhere. */ - - svdtim = curtim; - savst = curste; - -/* Compute a new current time so that we will not step */ -/* past the end of the interval. This time will be */ -/* based on: */ - -/* 1. The kind of event we are looking for. */ -/* 2. The objects and observer class. */ -/* 3. Transition times already found. */ -/* 4. A minimum time step allowed. */ - - if (! (*cstep)) { - (*udstep)(&curtim, ×t); - if (failed_()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - } -/* Computing MIN */ - d__1 = curtim + timest; - curtim = min(d__1,*finish); - -/* Compute the current state */ - - (*udcond)(&curtim, &curste); - if (failed_()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* Loop back to see if the state has changed. */ - - } - -/* If we have detected a state change and not merely run out */ -/* of the search interval... */ - - if (savst != curste) { - -/* Call the previous state STATE1 */ -/* Call the current state STATE2 */ - -/* Call the time at state STATE1, T1 */ -/* Call the time at state STATE2, T2 */ - -/* Save the current time. */ - - state1 = savst; - t1 = svdtim; - t2 = curtim; - -/* Make sure that T1 is not greater than T2. Signal an */ -/* error for T1 > T2. */ - - if (t1 > t2) { - setmsg_("Bad time interval result, T1 > T2.", (ftnlen)34); - sigerr_("SPICE(BADTIMECASE)", (ftnlen)18); - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - svdtim = curtim; - savst = curste; - -/* T1 and T2 bracket the time of transition. Squeeze this */ -/* interval down until it is less than some tolerance in */ -/* length. Do it as described below... */ - -/* Loop while the difference between the times T1 and T2 */ -/* exceeds a specified tolerance. */ - - nloop = 0; - for(;;) { /* while(complicated condition) */ - d__1 = t2 - t1; - if (!(touchd_(&d__1) > *tol)) - break; - ++nloop; - -/* This loop count error exists to catch pathologies */ -/* in the refinement function. The default bisection */ -/* refinement will converge before 1000 iterations if */ -/* a convergence is numerically possible. Any other */ -/* refinement function should require fewer iterations */ -/* compared to bisection. If not, the user should */ -/* probably use bisection. */ - - if (nloop >= 1000) { - setmsg_("Loop run exceeds maximum loop count. Unable to " - "converge to TOL value #1 within MXLOOP value #2 " - "iterations.", (ftnlen)106); - errdp_("#1", tol, (ftnlen)2); - errint_("#2", &c__1000, (ftnlen)2); - sigerr_("SPICE(NOCONVERG)", (ftnlen)16); - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - } - -/* Select a time T, between T1 and T2 (possibly based on the */ -/* values of L1 and L2). */ - - (*udrefn)(&t1, &t2, &l1, &l2, &t); - -/* Check for an error signal. The default refinement */ -/* routine, GFREFN, does not include error checks. */ - - if (failed_()) { - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; - } - -/* Check whether T is between T1 and T2. If */ -/* not then assume that we have gone as far as */ -/* we can in refining our estimate of the transition */ -/* point. Set T1 and T2 equal to T. */ - - t = brcktd_(&t, &t1, &t2); - if (t == t1) { - t2 = t; - } else if (t == t2) { - t1 = t; - } else { - -/* Compute the state time T. If this state, S, */ -/* equals STATE1, set T1 to T, otherwise set */ -/* T2 to T. */ - - (*udcond)(&t, &s); - if (s == state1) { - t1 = t; - } else { - t2 = t; - } - } - } - -/* Let TRNSTN be the midpoint of [T1, T2]. Record this */ -/* time as marking the transition from STATE1 to STATE2. */ - - d__1 = (t1 + t2) * .5; - trnstn = brcktd_(&d__1, &t1, &t2); - -/* In state-of-interest or not? */ - - if (instat) { - -/* We were in the state of interest, TRNSTN marks the */ -/* point in time when the state changed to "not of */ -/* interest" We need to record the interval from BEGIN to */ -/* FINISH and note that we are no longer in the state of */ -/* interest. */ - - -/* Add an interval starting at BEGIN and ending at TRNSTN */ -/* to the result window. */ - - s_copy(contxt, "Adding interval [BEGIN,TRNSTN] to RESULT. TR" - "NSTN represents time of passage out of the state-of-" - "interest.", (ftnlen)256, (ftnlen)105); - zzwninsd_(&begin, &trnstn, contxt, result, (ftnlen)256); - } else { - -/* We were not in the state of interest. As a result */ -/* TRNSTN marks the point where we are changing to */ -/* the state of interest. Note that we have transitioned */ -/* to the state of interest and record the time at */ -/* which the transition occurred. */ - - begin = trnstn; - } - -/* A transition occurred either from from in-state to */ -/* out-of-state or the inverse. Reverse the value of the */ -/* INSTAT flag to signify the transition event. */ - - instat = ! instat; - -/* That's it for this detection of state change. */ - - } - -/* Continue if there is more time in the search interval. */ - - } - -/* Check if in-state at this time (FINISH). If so record the */ -/* interval. */ - - if (instat) { - -/* Add an interval starting at BEGIN and ending at FINISH to the */ -/* window. */ - - s_copy(contxt, "Adding interval [BEGIN,FINISH] to RESULT. FINISH rep" - "resents end of the search interval.", (ftnlen)256, (ftnlen)87) - ; - zzwninsd_(&begin, finish, contxt, result, (ftnlen)256); - } - -/* If active, update the progress reporter before exiting this */ -/* routine. */ - - if (*rpt) { - (*udrepu)(start, finish, finish); - } - -/* Check-out then return. */ - - chkout_("ZZGFSOLV", (ftnlen)8); - return 0; -} /* zzgfsolv_ */ - diff --git a/ext/spice/src/cspice/zzgfsolvx.c b/ext/spice/src/cspice/zzgfsolvx.c deleted file mode 100644 index 82a12f5f00..0000000000 --- a/ext/spice/src/cspice/zzgfsolvx.c +++ /dev/null @@ -1,808 +0,0 @@ -/* zzgfsolvx.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1000 = 1000; - -/* $Procedure ZZGFSOLVX ( Private --- GF, event finding routine ) */ -/* Subroutine */ int zzgfsolvx_(U_fp udfunc, S_fp udcond, S_fp udstep, S_fp - udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, - doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, - S_fp udrepu, doublereal *result) -{ - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzwninsd_(doublereal *, doublereal *, char *, - doublereal *, ftnlen); - logical s; - doublereal begin, t; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - integer nloop; - logical l1, l2, savst; - doublereal t1, t2; - logical state1; - extern logical failed_(void); - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *), - touchd_(doublereal *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - logical instat; - doublereal curtim, svdtim, timest; - logical curste; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - extern logical return_(void); - char contxt[256]; - doublereal trnstn; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine is a root finding general purpose event location */ -/* routine. Most of the HARD work has been delegated to other */ -/* routines (In particular, how the dynamic step size is chosen). */ - -/* Sister routine to ZZGFSOLV. Copy any edits to ZZGFSOLV or */ -/* ZZGFSOLVX to the sister routine. */ - -/* $ 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 */ - -/* ROOT */ -/* SEARCH */ -/* WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UDFUNC I The routine that computes the scalar quantity of */ -/* interest. */ -/* UDCOND I Name of the routine that compares the current state */ -/* condition with-respect-to a constraint. */ -/* UDSTEP I Name of the routine that computes a time step */ -/* UDREFN I Name of the routine that computes a refined time. */ -/* BAIL I Logical indicating program interrupt monitoring. */ -/* UDBAIL I Name of a routine that signals a program interrupt. */ -/* CSTEP I Logical indicating constant step size. */ -/* STEP I Constant step size in seconds for finding geometric */ -/* events. */ -/* START I Beginning of the search interval. */ -/* FINISH I End of the search interval. */ -/* TOL I Maximum error in detection of state transitions. */ -/* RPT I Progress reporter on ( .TRUE.) or off ( .FALSE. ) */ -/* UDREPU I Function that updates the progress report. */ -/* RESULT I-O SPICE window containing results. */ - -/* $ Detailed_Input */ - -/* UDFUNC the routine that returns the value of the scalar */ -/* quantity of interest at time ET. The calling sequence */ -/* for UDFUNC is: */ - -/* CALL UDFUNC ( ET, VALUE ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB at which to determine the scalar */ -/* value. */ - -/* VALUE is the value of the scalar quantity */ -/* at ET. */ - -/* UDCOND the routine that determines if UDFUNC */ -/* satisfies some constraint condition at epoch ET. */ - -/* The calling sequence: */ - -/* CALL UDCOND ( UDFUNC, ET, IN_CON ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to evaluate UDFUNC. */ - -/* IN_CON a logical value indicating whether */ -/* or not UDFUNC satisfies the constraint */ -/* at ET (TRUE) or not (FALSE). */ - -/* UDSTEP the routine that computes a time step in an attempt to */ -/* find a transition of the state of the specified */ -/* coordinate. In the context of this routine's algorithm, */ -/* a "state transition" occurs where the geometric state */ -/* changes from being in the desired geometric condition */ -/* event to not, or vice versa. */ - -/* This routine relies on UDSTEP returning step sizes */ -/* small enough so that state transitions within the */ -/* confinement window are not overlooked. There must */ -/* never be two roots A and B separated by less than */ -/* STEP, where STEP is the minimum step size returned by */ -/* UDSTEP for any value of ET in the interval [A, B]. */ - -/* The calling sequence for UDSTEP is: */ - -/* CALL UDSTEP ( ET, STEP ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, from which the algorithm is to */ -/* search forward for a state transition. */ - -/* STEP is the output step size. STEP indicates */ -/* how far to advance ET so that ET and */ -/* ET+STEP may bracket a state transition and */ -/* definitely do not bracket more than one */ -/* state transition. Units are TDB seconds. */ - -/* If a constant step size is desired, the routine */ - -/* GFSTEP */ - -/* may be used. This is the default option. If using */ -/* GFSTEP, the step size must be set by calling */ - -/* GFSSTP(STEP) */ - -/* prior to calling this routine. */ - -/* UDREFN the routine that computes a refinement in the times */ -/* that bracket a transition point. In other words, once */ -/* a pair of times have been detected such that the system */ -/* is in different states at each of the two times, UDREFN */ -/* selects an intermediate time which should be closer to */ -/* the transition state than one of the two known times. */ -/* The calling sequence for UDREFN is: */ - -/* CALL UDREFN ( T1, T2, S1, S2, T ) */ - -/* where the inputs are: */ - -/* T1 a time when the system is in state S1. */ - -/* T2 a time when the system is in state S2. T2 */ -/* is assumed to be larger than T1. */ - -/* S1 a logical indicating the state of the system */ -/* at time T1. */ - -/* S2 a logical indicating the state of the system */ -/* at time T2. */ - -/* UDREFN may use or ignore the S1 and S2 values. */ - -/* The output is: */ - -/* T a time to check for a state transition */ -/* between T1 and T2. */ - -/* If a simple bisection method is desired, the routine */ -/* GFREFN may be used. This is the default option. */ - -/* BAIL is a logical indicating whether or not interrupt */ -/* signaling is enabled. When `bail' is set to TRUE, */ -/* the input function UDBAIL (see description below) */ -/* is used to determine whether an interrupt has been */ -/* issued. */ - -/* UDBAIL the routine that indicates whether an interrupt signal */ -/* has been issued (for example, from the keyboard). */ -/* UDBAIL has no arguments and returns a logical. */ -/* The return value is .TRUE. if an interrupt has */ -/* been issued; otherwise the value is .FALSE. */ - -/* ZZGFSOLVX uses UDBAIL only when BAIL (see above) is set */ -/* to .TRUE., indicating that interrupt handling is */ -/* enabled. When interrupt handling is enabled, ZZGFSOLVX */ -/* and will call UDBAIL to determine whether to terminate */ -/* processing and return immediately. */ - -/* If interrupt handing is not enabled, a logical */ -/* function must still be passed as an input argument. */ -/* The function */ - -/* GFBAIL */ - -/* may be used for this purpose. */ - -/* CSTEP is a logical indicating whether or not the step size */ -/* used in searching is constant. If it is, the value */ -/* STEP is used. Note that even if UDSTEP has the value */ -/* GFSTEP, i.e. the public, constant step routine, CSTEP */ -/* should still be .FALSE., in which case STEP is ignored. */ - -/* STEP is the step size to be used in the search. STEP must */ -/* be short enough for a search using this step size */ -/* to locate the time intervals where the geometric */ -/* event function is monotone increasing or decreasing. */ -/* However, STEP must not be *too* short, or the */ -/* search will take an unreasonable amount of time. */ - -/* The choice of STEP affects the completeness but not */ -/* the precision of solutions found by this routine; */ -/* precision is controlled by the convergence */ -/* the tolerance, TOL. */ - -/* STEP has units of TDB seconds. */ - -/* START is the beginning of the interval over which the state */ -/* is to be detected. */ - -/* FINISH is the end of the interval over which the state is */ -/* to be detected. */ - -/* TOL is a tolerance value used to determine convergence of */ -/* root-finding operations. TOL is measured in seconds */ -/* and is greater than zero. */ - -/* RPT is a logical variable which controls whether the */ -/* progress reporter is enabled. When RPT is TRUE, */ -/* progress reporting is enabled and the routine */ -/* UDREPU (see description below) reports progress. */ - -/* UDREPU the routine that updates the progress report for a */ -/* search. The calling sequence of UDREPU is */ - -/* UDREPU (IVBEG, IVEND, ET ) */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION IVBEG */ -/* DOUBLE PRECISION IVEND */ - -/* where ET is an epoch belonging to the confinement */ -/* window, IVBEG and IVEND are the start and stop times, */ -/* respectively of the current confinement window */ -/* interval. The ratio of the measure of the portion */ -/* of CNFINE that precedes ET to the measure of CNFINE */ -/* would be a logical candidate for the searches */ -/* completion percentage; however the method of */ -/* measurement is up to the user. */ - -/* If the user doesn't wish to provide a custom set of */ -/* progress reporting functions, the routine */ - -/* GFREPU */ - -/* may be used. */ - -/* RESULT is an initialized SPICE window. RESULT may not be empty */ -/* on entry and must be large enough to hold all of the */ -/* intervals found by the search. */ - -/* $ Detailed_Output */ - -/* RESULT is a SPICE window containing the intersection of the */ -/* results of the search and the contents of RESULT */ -/* on entry. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* $ Exceptions */ - -/* 1) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) */ -/* will signal. */ - -/* 2) If START +/- TOL is indistinguishable from START or */ -/* FINISH +/- TOL is indistinguishable from FINISH, the */ -/* error SPICE(INVALIDVALUE) will signal. */ - -/* 3) If START is greater than FINISH or SVDTIM is greater than */ -/* CURTIM, SPICE(BADTIMECASE) will signal. */ - -/* 4) If the inner convergence loop fails to converge to TOL */ -/* within MXLOOP iterations, the error SPICE(NOCONVERG) */ -/* will signal. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* $ Particulars */ - -/* This routine implements a strategy for searching for geometric */ -/* state events important for planning solar system observations. */ -/* The actual details of selecting time steps while searching for */ -/* a state change as well as the scheme used for zeroing in on the */ -/* actual time of transition are handled by lower level routines. */ - -/* By delegating the work of selecting search time steps and the */ -/* process of refining a transition time estimate to lower level */ -/* routines, the common work of the search can be isolated here. */ -/* The routines that do the decision making, can be modified */ -/* and made smarter as time permits. */ - -/* $ Examples */ - -/* See GFOCCE and ZZGFRELX. */ - -/* $ Restrictions */ - -/* It is important that the user understand how the routines */ -/* UDCOND, UDSTEP and UDREFN are to be used and that the */ -/* calling sequences match precisely with the descriptions given */ -/* here. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L. S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0 16-FEB-2010 (EDW) */ - -/* Modified version of ZZGFSOLV. */ - -/* - SPICELIB Version 1.0.0, 17-MAR-2009 (EDW)(LSE)(NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find times of an event */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local variables */ - - -/* The maximum number of search loop iterations to execute. */ -/* The default refinement method is bisection, a very slow */ -/* method to convergence. Since 2**1000 ~ 10**301, */ -/* 1000 loop iterations represents enough effort to assume */ -/* either the search will not converge or that the refinement */ -/* function operates slower than would bisection, in which */ -/* case the user should use the default GFREFN function. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFSOLVX", (ftnlen)9); - -/* Make sure TOL is positive. */ - - if (*tol <= 0.) { - setmsg_("TOL was #; must be positive.", (ftnlen)28); - errdp_("#", tol, (ftnlen)1); - sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22); - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* Make sure that START is not greater than FINISH. Signal an */ -/* error for START > FINISH. */ - - if (*start > *finish) { - setmsg_("Bad time interval result, START > FINISH.", (ftnlen)41); - sigerr_("SPICE(BADTIMECASE)", (ftnlen)18); - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* Make sure that TOL is not too small, i.e. that neither */ -/* START + TOL nor START - TOL equals START. */ - - d__1 = *start - *tol; - d__2 = *start + *tol; - if (touchd_(&d__1) == *start || touchd_(&d__2) == *start) { - setmsg_("TOL has value #1. This value is too small to distinguish ST" - "ART - TOL or START + TOL from START, #2.", (ftnlen)99); - errdp_("#1", tol, (ftnlen)2); - errdp_("#2", start, (ftnlen)2); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* Make sure that TOL is not too small, i.e. that neither */ -/* START + TOL nor START - TOL equals START. */ - - d__1 = *finish - *tol; - d__2 = *finish + *tol; - if (touchd_(&d__1) == *finish || touchd_(&d__2) == *finish) { - setmsg_("TOL has value #1. This value is too small to distinguish FI" - "NISH - TOL or FINISH + TOL from FINISH, #2.", (ftnlen)102); - errdp_("#1", tol, (ftnlen)2); - errdp_("#2", finish, (ftnlen)2); - sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* If active, update the progress reporter. */ - - if (*rpt) { - (*udrepu)(start, finish, start); - } - -/* This algorithm determines those intervals when a given state */ -/* is observed to occur within a specified search interval. */ - -/* Pairs of times are recorded. The first member of each pair */ -/* denotes the time when the system changes to the state of */ -/* interest. The second denotes a transition out of that state. */ - -/* If the system is in the state of interest at the beginning of */ -/* the interval, the beginning of the time interval will be */ -/* recorded. This may or may not be a transition point. */ - -/* Similarly if the system is in the state of interest at the end */ -/* of the interval, the end of the interval will be recorded. */ -/* Again, this may or may not be a transition point. */ - - -/* Initially the current time is the beginning of the search */ -/* interval. */ - - curtim = *start; - -/* Determine if the state at the current time satisfies some */ -/* constraint. This constraint may indicate only existence of */ -/* a state. */ - - (*udcond)((U_fp)udfunc, &curtim, &curste); - if (failed_()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* If the system is in the state of interest, record the initial */ -/* time of the search interval. */ - - if (curste) { - instat = TRUE_; - begin = curtim; - } else { - instat = FALSE_; - } - -/* If the step size is constant, use the value supplied. */ - - if (*cstep) { - timest = *step; - } - -/* Save the current time and state somewhere. */ - - svdtim = curtim; - savst = curste; - -/* Once initializations have been performed keep working */ -/* until the search interval has been exhausted. */ - -/* While time remains in the search interval. */ - - while(svdtim < *finish) { - -/* Using the current window and internally stored */ -/* information about the current state, select a new current */ -/* time. */ - - if (! (*cstep)) { - (*udstep)(&curtim, ×t); - if (failed_()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - } - -/* Add the time step to the current time. Make sure that the */ -/* time does not move beyond the end of the search interval. */ - -/* Computing MIN */ - d__1 = curtim + timest; - curtim = min(d__1,*finish); - -/* Compute the state at time CURTIM. */ - - (*udcond)((U_fp)udfunc, &curtim, &curste); - if (failed_()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* While the state remains unchanged and the interval is not */ -/* completely searched ... */ - - while(savst == curste && svdtim < *finish) { - -/* First check for an interrupt signal if checking is enabled. */ - - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - } - -/* Report the current time to the monitoring utility, if */ -/* appropriate. */ - - if (*rpt) { - (*udrepu)(start, finish, &svdtim); - } - -/* Save the current time and state somewhere. */ - - svdtim = curtim; - savst = curste; - -/* Compute a new current time so that we will not step */ -/* past the end of the interval. This time will be */ -/* based on: */ - -/* 1. The kind of event we are looking for. */ -/* 2. The objects and observer class. */ -/* 3. Transition times already found. */ -/* 4. A minimum time step allowed. */ - - if (! (*cstep)) { - (*udstep)(&curtim, ×t); - if (failed_()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - } -/* Computing MIN */ - d__1 = curtim + timest; - curtim = min(d__1,*finish); - -/* Compute the current state */ - - (*udcond)((U_fp)udfunc, &curtim, &curste); - if (failed_()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* Loop back to see if the state has changed. */ - - } - -/* If we have detected a state change and not merely run out */ -/* of the search interval... */ - - if (savst != curste) { - -/* Call the previous state STATE1 */ -/* Call the current state STATE2 */ - -/* Call the time at state STATE1, T1 */ -/* Call the time at state STATE2, T2 */ - -/* Save the current time. */ - - state1 = savst; - t1 = svdtim; - t2 = curtim; - -/* Make sure that T1 is not greater than T2. Signal an */ -/* error for T1 > T2. */ - - if (t1 > t2) { - setmsg_("Bad time interval result, T1 > T2.", (ftnlen)34); - sigerr_("SPICE(BADTIMECASE)", (ftnlen)18); - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - svdtim = curtim; - savst = curste; - -/* T1 and T2 bracket the time of transition. Squeeze this */ -/* interval down until it is less than some tolerance in */ -/* length. Do it as described below... */ - -/* Loop while the difference between the times T1 and T2 */ -/* exceeds a specified tolerance. */ - - nloop = 0; - for(;;) { /* while(complicated condition) */ - d__1 = t2 - t1; - if (!(touchd_(&d__1) > *tol)) - break; - ++nloop; - -/* This loop count error exists to catch pathologies */ -/* in the refinement function. The default bisection */ -/* refinement will converge before 1000 iterations if */ -/* a convergence is numerically possible. Any other */ -/* refinement function should require fewer iterations */ -/* compared to bisection. If not, the user should */ -/* probably use bisection. */ - - if (nloop >= 1000) { - setmsg_("Loop run exceeds maximum loop count. Unable to " - "converge to TOL value #1 within MXLOOP value #2 " - "iterations.", (ftnlen)106); - errdp_("#1", tol, (ftnlen)2); - errint_("#2", &c__1000, (ftnlen)2); - sigerr_("SPICE(NOCONVERG)", (ftnlen)16); - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - if (*bail) { - if ((*udbail)()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - } - -/* Select a time T, between T1 and T2 (possibly based on the */ -/* values of L1 and L2). */ - - (*udrefn)(&t1, &t2, &l1, &l2, &t); - -/* Check for an error signal. The default refinement */ -/* routine, GFREFN, does not include error checks. */ - - if (failed_()) { - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; - } - -/* Check whether T is between T1 and T2. If */ -/* not then assume that we have gone as far as */ -/* we can in refining our estimate of the transition */ -/* point. Set T1 and T2 equal to T. */ - - t = brcktd_(&t, &t1, &t2); - if (t == t1) { - t2 = t; - } else if (t == t2) { - t1 = t; - } else { - -/* Compute the state time T. If this state, S, */ -/* equals STATE1, set T1 to T, otherwise set */ -/* T2 to T. */ - - (*udcond)((U_fp)udfunc, &t, &s); - if (s == state1) { - t1 = t; - } else { - t2 = t; - } - } - } - -/* Let TRNSTN be the midpoint of [T1, T2]. Record this */ -/* time as marking the transition from STATE1 to STATE2. */ - - d__1 = (t1 + t2) * .5; - trnstn = brcktd_(&d__1, &t1, &t2); - -/* In state-of-interest or not? */ - - if (instat) { - -/* We were in the state of interest, TRNSTN marks the */ -/* point in time when the state changed to "not of */ -/* interest" We need to record the interval from BEGIN to */ -/* FINISH and note that we are no longer in the state of */ -/* interest. */ - - -/* Add an interval starting at BEGIN and ending at TRNSTN */ -/* to the result window. */ - - s_copy(contxt, "Adding interval [BEGIN,TRNSTN] to RESULT. TR" - "NSTN represents time of passage out of the state-of-" - "interest.", (ftnlen)256, (ftnlen)105); - zzwninsd_(&begin, &trnstn, contxt, result, (ftnlen)256); - } else { - -/* We were not in the state of interest. As a result */ -/* TRNSTN marks the point where we are changing to */ -/* the state of interest. Note that we have transitioned */ -/* to the state of interest and record the time at */ -/* which the transition occurred. */ - - begin = trnstn; - } - -/* A transition occurred either from from in-state to */ -/* out-of-state or the inverse. Reverse the value of the */ -/* INSTAT flag to signify the transition event. */ - - instat = ! instat; - -/* That's it for this detection of state change. */ - - } - -/* Continue if there is more time in the search interval. */ - - } - -/* Check if in-state at this time (FINISH). If so record the */ -/* interval. */ - - if (instat) { - -/* Add an interval starting at BEGIN and ending at FINISH to the */ -/* window. */ - - s_copy(contxt, "Adding interval [BEGIN,FINISH] to RESULT. FINISH rep" - "resents end of the search interval.", (ftnlen)256, (ftnlen)87) - ; - zzwninsd_(&begin, finish, contxt, result, (ftnlen)256); - } - -/* If active, update the progress reporter before exiting this */ -/* routine. */ - - if (*rpt) { - (*udrepu)(start, finish, finish); - } - -/* Check-out then return. */ - - chkout_("ZZGFSOLVX", (ftnlen)9); - return 0; -} /* zzgfsolvx_ */ - diff --git a/ext/spice/src/cspice/zzgfspq.c b/ext/spice/src/cspice/zzgfspq.c deleted file mode 100644 index bcb99f231b..0000000000 --- a/ext/spice/src/cspice/zzgfspq.c +++ /dev/null @@ -1,306 +0,0 @@ -/* zzgfspq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b12 = 1e-12; - -/* $Procedure ZZGFSPQ ( GF, separation quantity ) */ -/* Subroutine */ int zzgfspq_(doublereal *et, integer *targ1, integer *targ2, - doublereal *r1, doublereal *r2, integer *obs, char *abcorr, char *ref, - doublereal *value, ftnlen abcorr_len, ftnlen ref_len) -{ - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - extern doublereal vsep_(doublereal *, doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal theta; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - extern doublereal vnorm_(doublereal *); - doublereal range1, range2; - extern logical failed_(void); - doublereal lt; - extern doublereal dasine_(doublereal *, doublereal *), halfpi_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), spkezp_(integer *, doublereal *, char *, char *, integer - *, doublereal *, doublereal *, ftnlen, ftnlen); - extern logical return_(void); - doublereal pv1[3], pv2[3], ang1, ang2; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the angular separation between the limbs of two objects. */ - -/* $ 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 */ - -/* GEOMETRY */ -/* ANGLE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB */ -/* TARG1 I NAIF ID for first target */ -/* TARG2 I NAIF ID for second target */ -/* R1 I Radius of a spherical model for TARG1 */ -/* R2 I Radius of a spherical model for TARG2 */ -/* OBS I NAIF ID of observer */ -/* ABCORR I Aberration correction flag */ -/* REF I Reference frame of the angular separation */ -/* VALUE O Value of angular separation between objects */ - -/* $ Detailed_Input */ - -/* ET is the time in ephemeris seconds past J2000 TDB at */ -/* which the separation is to be measured. */ - -/* TARG1 */ -/* TARG2 the NAIF IDs of the two objects for which to */ -/* determine the angular separation. */ - -/* R1 */ -/* R2 are the radii of the two objects TARG1 and TARG2 */ -/* respectively. */ - -/* OBS the NAIF ID identifying the body observing */ -/* TARG1 and TARG2. */ - -/* ABCORR the string description of the aberration corrections */ -/* to apply to the state evaluations to account for */ -/* one-way light time and stellar aberration. */ - -/* This routine accepts the same aberration corrections */ -/* as does the SPICE routine SPKEZR. See the header of */ -/* SPKEZR for a detailed description of the aberration */ -/* correction options. For convenience, the options are */ -/* listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* REF is the name of the reference frame relative to which */ -/* the angular separation should be expressed. This may */ -/* be any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel. */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. */ - -/* $ Detailed_Output */ - -/* VALUE is the light-time (and stellar aberration corrected */ -/* if this feature is enabled) separation of the two */ -/* objects TARG1 and TARG2 as observed from OBS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(BADRADIUS) will signal if either R1 or R2 */ -/* have a nagative value. */ - -/* 2) If the ephemeris data required to perform the needed state */ -/* look-ups are not loaded, routines called by this routine */ -/* will signal the error SPICE(SPKINSUFFDATA). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines the apparent separation between the limbs */ -/* of two objects as observed from a third. The value reported is */ -/* corrected for light time. Moreover, if at the time this routine */ -/* is called, stellar aberration corrections are enabled, this */ -/* correction will also be applied to the apparent positions of the */ -/* centers of the two objects. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-MAR-2009 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* compute the apparent relative angular separation */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local Variables. */ - - -/* ATOL is a tolerance value for computing arc sine. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFSPQ", (ftnlen)7); - -/* First check for bad inputs. */ - - if (*r1 < 0. || *r2 < 0.) { - setmsg_("A negative radius for a body was encountered. The radius fo" - "r body # was given as #, the radius of body # was given as #" - ". ", (ftnlen)121); - errint_("#", targ1, (ftnlen)1); - errdp_("#", r1, (ftnlen)1); - errint_("#", targ1, (ftnlen)1); - errdp_("#", r2, (ftnlen)1); - sigerr_("SPICE(BADRADIUS)", (ftnlen)16); - chkout_("ZZGFSPQ", (ftnlen)7); - return 0; - } - -/* Get the state of the TARG1, TARG2 objects relative to OBS. */ - - spkezp_(targ1, et, ref, abcorr, obs, pv1, <, ref_len, abcorr_len); - if (failed_()) { - chkout_("ZZGFSPQ", (ftnlen)7); - return 0; - } - spkezp_(targ2, et, ref, abcorr, obs, pv2, <, ref_len, abcorr_len); - if (failed_()) { - chkout_("ZZGFSPQ", (ftnlen)7); - return 0; - } - -/* Compute the range to the objects of interest. */ - - range1 = vnorm_(pv1); - range2 = vnorm_(pv2); - -/* Compute the apparent angular radii as seen from OBS. */ - - if (range1 > *r1) { - d__1 = *r1 / range1; - ang1 = dasine_(&d__1, &c_b12); - if (failed_()) { - chkout_("ZZGFSPQ", (ftnlen)7); - return 0; - } - } else { - ang1 = halfpi_(); - } - if (range2 > *r2) { - d__1 = *r2 / range2; - ang2 = dasine_(&d__1, &c_b12); - if (failed_()) { - chkout_("ZZGFSPQ", (ftnlen)7); - return 0; - } - } else { - ang2 = halfpi_(); - } - -/* Finally compute the apparent separation. */ - - theta = vsep_(pv1, pv2); - *value = theta - ang1 - ang2; - chkout_("ZZGFSPQ", (ftnlen)7); - return 0; -} /* zzgfspq_ */ - diff --git a/ext/spice/src/cspice/zzgfspu.c b/ext/spice/src/cspice/zzgfspu.c deleted file mode 100644 index 93a0509d95..0000000000 --- a/ext/spice/src/cspice/zzgfspu.c +++ /dev/null @@ -1,1437 +0,0 @@ -/* zzgfspu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__2 = 2; - -/* $Procedure ZZGFSPU ( Private - GF, angular separation routines ) */ -/* Subroutine */ int zzgfspu_0_(int n__, char *of, char *from, char *shape, - char *frame, doublereal *refval, doublereal *et, char *abcorr, - logical *decres, logical *lssthn, doublereal *sep, ftnlen of_len, - ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen - abcorr_len) -{ - /* Initialized data */ - - static char svshap[32*2] = "POINT " "SPHERE " - " "; - static char ref[5] = "J2000"; - - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern doublereal dhfa_(doublereal *, doublereal *); - extern /* Subroutine */ int zzgftreb_(integer *, doublereal *); - doublereal axes1[3], axes2[3]; - extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen), chkin_( - char *, ftnlen), ucase_(char *, char *, ftnlen, ftnlen), errch_( - char *, char *, ftnlen, ftnlen); - integer class__; - logical found; - static doublereal svang; - extern doublereal dvsep_(doublereal *, doublereal *); - static char svref[32]; - static integer svobs; - extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char * - , integer *, doublereal *, doublereal *, ftnlen, ftnlen); - integer fcode1, fcode2; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - bods2c_(char *, integer *, logical *, ftnlen); - static integer svbod1, svbod2; - static doublereal svrad1, svrad2; - static char svref1[32], svref2[32]; - extern logical failed_(void); - static integer svshp1, svshp2; - doublereal lt, dtheta; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - logical attblk[15]; - integer clssid; - static char svabcr[32]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen), cmprss_(char *, integer *, - char *, char *, ftnlen, ftnlen, ftnlen); - doublereal seprtn; - extern logical return_(void); - doublereal pv1[6], pv2[6]; - integer ctr1, ctr2; - extern /* Subroutine */ int zzgfspq_(doublereal *, integer *, integer *, - doublereal *, doublereal *, integer *, char *, char *, doublereal - *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the umbrella routine for the entry points needed by */ -/* GFEVNT in order to find angular separation events. */ - -/* $ 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 */ - -/* ANGLE */ -/* GEOMETRY */ -/* ROOT */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OF I Names of the two targets */ -/* FROM I Name of the observing body */ -/* SHAPE I Names of the shape descriptions for OF */ -/* REFVAL I Anglular reference value for comparison */ -/* ET I An epoch in ephemeris seconds past J2000 TDB */ -/* ABCORR I Aberration correction flag */ -/* DECRES O .TRUE. if angular separation is decreasing .FALSE. */ -/* otherwise */ -/* LSSTHN O .TRUE. is angular separation is less than REFVAL, */ -/* .FALSE. otherwise */ -/* SEP O Angular separation at time ET */ - -/* $ Detailed_Input */ - -/* OF the string array naming the bodies whose angular */ -/* separation is of interest. */ - -/* FROM the string naming the observer. */ - -/* SHAPE the string array naming the geometric model used to */ -/* represent the shapes of OF. The relation between SHAPE */ -/* and OF is 1-to-1. */ - -/* Models supported by this routine: */ - -/* 'SPHERE' Treat the body as a sphere with */ -/* radius equal to the maximum value of */ -/* BODYnnn_RADII */ - -/* 'POINT' Treat the body as a single point; */ -/* radius has value zero. */ - -/* The SHAPE string lacks sensitivity to case and leading */ -/* or trailing blank. */ - -/* FRAME the string array naming the body-fixed reference frames */ -/* corresponding to OF. The relation between FRAME */ -/* and OF is 1-to-1. */ - -/* REFVAL the double precision value of the angle (in radians) */ -/* against which to compare the angular separation of the */ -/* two bodies. */ - -/* ET is the time in second past J2000 at which one wants */ -/* to determine an event condition. */ - -/* ABCORR the string description of the aberration corrections */ -/* to apply to the state evaluations to account for */ -/* one-way light time and stellar aberration. */ - -/* This routine accepts the same aberration corrections */ -/* as does the SPICE routine SPKEZR. See the header of */ -/* SPKEZR for a detailed description of the aberration */ -/* correction options. For convenience, the options are */ -/* listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* DECRES is .TRUE. if the angular separation between the */ -/* objects is decreasing. Otherwise it is .FALSE. */ - -/* LSSTHN is .TRUE. if the angular separation between the two */ -/* bodies is less than the reference angle at time ET */ -/* and .FALSE. otherwise. */ - -/* SEP is the angular separation between SVBOD1 and SVBOD2 as */ -/* seen from SVOBS at time ET. */ - -/* For more information, see individual entry points. */ - -/* $ Detailed_Output */ - -/* See individual entry points. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as the umbrella routine for 4 entry points */ -/* needed by GFEVNT in solving for angular separation conditions. */ - -/* The five entry points are */ - -/* ZZGFSPIN --- an initialization routine that must be called */ -/* prior to attempting to solve for any angular */ -/* separation event. */ - -/* ZZGFSPUR --- updates reference value REFVAL. */ - -/* ZZGFSPDC --- determines whether or not angular separation is */ -/* decreasing at some time. */ - -/* ZZGFSPLT --- determines whether or not angular separation is */ -/* less than REFVAL */ - -/* ZZGFGSEP --- returns the angular separation of the two */ -/* objects of interest as a function of ET. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* ZZGFSPIN must be called prior to use of any of the */ -/* other entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-DEC-2009 (NJB) (EDW) */ - -/* Edited argument descriptions. Removed mention of "ELLIPSOID" */ -/* shape from SHAPE as that option is not yet implemented. */ - -/* Added an error check on body frame centers to enforce */ -/* a body frame center is the body. This check does not apply */ -/* to "POINT" or "SPHERE" shape targets, and so will not */ -/* execute for this version of the routine. */ - -/* Rename of the ZZDHA call to DHFA. */ - -/* - SPICELIB Version 1.0.0 19-FEB-2009 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* umbrella routine for finding angular separation events */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Below we initialize the list of shape names. */ - - -/* Define integer ID parameters for the shape names in */ -/* SVSHAP. */ - - /* Parameter adjustments */ - if (of) { - } - if (shape) { - } - if (frame) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzgfspin; - case 2: goto L_zzgfspur; - case 3: goto L_zzgfspdc; - case 4: goto L_zzgfgsep; - case 5: goto L_zzgfsplt; - } - - -/* Never directly call this routine. */ - - chkin_("ZZGFSPU", (ftnlen)7); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZGFSPU", (ftnlen)7); - return 0; -/* $Procedure ZZGFSPIN ( Private - GF, angular separation initialization ) */ - -L_zzgfspin: -/* $ Abstract */ - -/* This routine initializes variables that describe an angular */ -/* separation event of interest for solution by ZZGFSOLV. */ - -/* $ 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 */ - -/* ANGLE */ -/* GEOMETRY */ -/* ROOT */ - -/* $ Declarations */ - -/* CHARACTER*(*) OF ( 2 ) */ -/* INTEGER FROM */ -/* CHARACTER*(*) SHAPE( 2 ) */ -/* CHARACTER*(*) FRAME( 2 ) */ -/* DOUBLE PRECISION REFVAL */ -/* CHARACTER*(*) ABCORR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OF I Body id's of the angular separation objects */ -/* FROM I Observer name */ -/* SHAPE I Array of shape IDs corresponding to OF */ -/* FRAME I Array of frame names corresponding to OF */ -/* REFVAL I Value angles will be compared to. */ -/* ABCORR I Aberration correction flag. */ - -/* $ Detailed_Input */ - -/* OF the string array naming the bodies whose angular */ -/* separation is of interest. */ - -/* FROM the string naming the observer. */ - -/* SHAPE the string array naming the geometric model used to */ -/* represent the shapes of OF. The relation between SHAPE */ -/* and OF is 1-to-1. */ - -/* Models supported by this routine: */ - -/* 'SPHERE' Treat the body as a sphere with */ -/* radius equal to the maximum value of */ -/* BODYnnn_RADII */ - -/* 'POINT' Treat the body as a single point; */ -/* radius has value zero. */ - -/* The SHAPE string lacks sensitivity to case and leading */ -/* or trailing blank. */ - -/* FRAME the string array naming the body-fixed reference frames */ -/* corresponding to OF. The relation between FRAME */ -/* and OF is 1-to-1. */ - -/* REFVAL the double precision value of the angle (in radians) */ -/* against which to compare the angular separation of the */ -/* two bodies. */ - -/* ABCORR the string description of the aberration corrections */ -/* to apply to the state evaluations to account for */ -/* one-way light time and stellar aberration. */ - -/* This routine accepts the same aberration corrections */ -/* as does the SPICE routine SPKEZR. See the header of */ -/* SPKEZR for a detailed description of the aberration */ -/* correction options. For convenience, the options are */ -/* listed below: */ - -/* 'NONE' Apply no correction. */ - -/* 'LT' "Reception" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'LT+S' "Reception" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'CN' "Reception" case: converged */ -/* Newtonian light time correction. */ - -/* 'CN+S' "Reception" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* The ABCORR string lacks sensitivity to case, leading */ -/* and trailing blanks. */ - -/* $ Detailed_Output */ - -/* None */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-DEC-2009 (NJB) (EDW) */ - -/* Edited argument descriptions. Removed mention of "ELLIPSOID" */ -/* shape from SHAPE as that option is not yet implemented. */ - -/* Added an error check on body frame centers to enforce */ -/* a body frame center is the body. This check does not apply */ -/* to "POINT" or "SPHERE" shape targets, and so will not */ -/* execute for this version of the routine. */ - -/* - SPICELIB Version 1.0.0 14-APR-2008 (NJB) (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation initialization routine */ - -/* -& */ - if (return_()) { - return 0; - } else { - chkin_("ZZGFSPIN", (ftnlen)8); - } - bods2c_(of, &svbod1, &found, of_len); - if (! found) { - setmsg_("The object name for target 1, '#', is not a recognized name" - " for an ephemeris object. The cause of this problem may be t" - "hat you need an updated version of the SPICE Toolkit.", ( - ftnlen)172); - errch_("#", of, (ftnlen)1, of_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - bods2c_(of + of_len, &svbod2, &found, of_len); - if (! found) { - setmsg_("The object name for target 2, '#', is not a recognized name" - " for an ephemeris object. The cause of this problem may be t" - "hat you need an updated version of the SPICE Toolkit.", ( - ftnlen)172); - errch_("#", of + of_len, (ftnlen)1, of_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - bods2c_(from, &svobs, &found, from_len); - if (! found) { - setmsg_("The object name for the observer, '#', is not a recognized " - "name for an ephemeris object. The cause of this problem may " - "be that you need an updated version of the SPICE Toolkit.", ( - ftnlen)176); - errch_("#", from, (ftnlen)1, from_len); - sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - -/* Confirm the three bodies have unique IDs. */ - - if (svobs == svbod1 || svobs == svbod2 || svbod1 == svbod2) { - setmsg_("All three objects associated with an ANGULAR SEPARATION sea" - "rch must be distinct. The objects whose angular separation i" - "s of interest were # and #. The observer was #.", (ftnlen)166) - ; - errint_("#", &svbod1, (ftnlen)1); - errint_("#", &svbod2, (ftnlen)1); - errint_("#", &svobs, (ftnlen)1); - sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - -/* Squeeze all blanks out of the aberration correction */ -/* string; ensure the string is in upper case. */ - - cmprss_(" ", &c__0, abcorr, svabcr, (ftnlen)1, abcorr_len, (ftnlen)32); - ucase_(svabcr, svabcr, (ftnlen)32, (ftnlen)32); - -/* Check the aberration correction. If SPKEZR can't handle it, */ -/* neither can we. */ - - zzvalcor_(svabcr, attblk, (ftnlen)32); - if (failed_()) { - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - s_copy(svref, ref, (ftnlen)32, (ftnlen)5); - svang = *refval; - s_copy(svref1, frame, (ftnlen)32, frame_len); - s_copy(svref2, frame + frame_len, (ftnlen)32, frame_len); - -/* Check shapes... */ - - ljust_(shape, shape, shape_len, shape_len); - ucase_(shape, shape, shape_len, shape_len); - -/* If we pass the error check, then SHAPE(1) exists in SVSHAP. */ - - svshp1 = isrchc_(shape, &c__2, svshap, shape_len, (ftnlen)32); - if (svshp1 == 0) { - setmsg_("The body shape, # is not recognized. Supported quantities " - "are: POINT, SPHERE.", (ftnlen)78); - errch_("#", shape, (ftnlen)1, shape_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } else if (svshp1 == 1) { - svrad1 = 0.; - } else if (svshp1 == 2) { - zzgftreb_(&svbod1, axes1); - if (failed_()) { - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } -/* Computing MAX */ - d__1 = max(axes1[0],axes1[1]); - svrad1 = max(d__1,axes1[2]); - } else { - -/* This code executes only if someone adds a new shape */ -/* name to SVSHAP then fails to update the SVSHP1 condition */ -/* block to respond to the name. Fortran needs SWITCH...CASE. */ - - setmsg_("Encountered uncoded shape ID for #. This indicates a bog. P" - "lease contact NAIF.", (ftnlen)78); - errch_("#", shape, (ftnlen)1, shape_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - ljust_(shape + shape_len, shape + shape_len, shape_len, shape_len); - ucase_(shape + shape_len, shape + shape_len, shape_len, shape_len); - -/* If we pass the error check, then SHAPE(2) exists in SVSHAP. */ - - svshp2 = isrchc_(shape + shape_len, &c__2, svshap, shape_len, (ftnlen)32); - if (svshp2 == 0) { - setmsg_("The body shape, # is not recognized. Supported quantities " - "are: POINT, SPHERE.", (ftnlen)78); - errch_("#", shape + shape_len, (ftnlen)1, shape_len); - sigerr_("SPICE(NOTRECOGNIZED)", (ftnlen)20); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } else if (svshp2 == 1) { - svrad2 = 0.; - } else if (svshp2 == 2) { - zzgftreb_(&svbod2, axes2); - if (failed_()) { - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } -/* Computing MAX */ - d__1 = max(axes2[0],axes2[1]); - svrad2 = max(d__1,axes2[2]); - } else { - -/* This code executes only if someone adds a new shape */ -/* name to SVSHAP then fails to update the SVSHP2 condition */ -/* block to respond to the name. Fortran needs SWITCH...CASE. */ - - setmsg_("Encountered uncoded shape ID for #. This indicates a bug. P" - "lease contact NAIF.", (ftnlen)78); - errch_("#", shape + shape_len, (ftnlen)1, shape_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - -/* Confirm the center of the input reference frames correspond */ -/* to the target bodies for non-point, non-sperical bodies. */ - -/* FRAME1 centered on TARG1 */ -/* FRAME2 centered on TARG2 */ - -/* This check does not apply to POINT or SPHERE shapes. */ - - if (svshp1 != 1 && svshp1 != 2) { - namfrm_(svref1, &fcode1, (ftnlen)32); - frinfo_(&fcode1, &ctr1, &class__, &clssid, &found); - if (! found) { - setmsg_("Frame system did not recognize frame #.", (ftnlen)39); - errch_("#", svref1, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - if (svbod1 != ctr1) { - setmsg_("The reference frame #1 associated with target body #2 i" - "s not centered on #2. The frame must be centered on the " - "target body.", (ftnlen)123); - errch_("#1", svref1, (ftnlen)2, (ftnlen)32); - errch_("#2", of, (ftnlen)2, of_len); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - } - if (svshp2 != 1 && svshp2 != 2) { - namfrm_(svref2, &fcode2, (ftnlen)32); - frinfo_(&fcode2, &ctr2, &class__, &clssid, &found); - if (! found) { - setmsg_("Frame system did not recognize frame #.", (ftnlen)39); - errch_("#", svref2, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - if (svbod2 != ctr2) { - setmsg_("The reference frame #1 associated with target body #2 i" - "s not centered on #2. The frame must be centered on the " - "target body.", (ftnlen)123); - errch_("#1", svref2, (ftnlen)2, (ftnlen)32); - errch_("#2", of + of_len, (ftnlen)2, of_len); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; - } - } - chkout_("ZZGFSPIN", (ftnlen)8); - return 0; -/* $Procedure ZZGFSPUR ( Private - GF, update angular reference value ) */ - -L_zzgfspur: -/* $ Abstract */ - -/* This is the entry point used for updating the internal reference */ -/* value. */ - -/* $ 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 */ - -/* ANGLE */ -/* GEOMETRY */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION REFVAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* REFVAL I Anglular reference value for comparison */ - -/* $ Detailed_Input */ - -/* REFVAL the double precision value of the angle (in radians) */ -/* against which to compare the angular separation of the */ -/* two bodies. */ - -/* $ Detailed_Output */ - -/* None */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation update reference value routine */ - -/* -& */ - svang = *refval; - return 0; -/* $Procedure ZZGFSPDC ( Private - GF, angular separation decreasing) */ - -L_zzgfspdc: -/* $ Abstract */ - -/* Computes whether or not the angular separation between SVBOD1 and */ -/* SVBOD2 is decreasing at time ET. */ - -/* $ 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 */ - -/* ANGLE */ -/* GEOMETRY */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL DECRES */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* DECRES O .TRUE if angular separation is decreasing .FALSE. */ -/* otherwise. */ - -/* $ Detailed_Input */ - -/* ET time in seconds past J2000 at which one wishes to */ -/* determine whether or not the angular separation of the */ -/* two bodies is decreasing. */ - -/* $ Detailed_Output */ - -/* DECRES is .TRUE. if the angular separation between the objects */ -/* is decreasing. Otherwise it is .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If the observer is inside one of the objects, the object will */ -/* be regarded as having a 90 degree apparent radius. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether or not the angular separation */ -/* between two objects as seen from a third is decreasing. The value */ -/* of DECRES is .TRUE. if it is, otherwise it is returned as */ -/* .FALSE. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1 06-JUL-2009 (NJB) (EDW) */ - -/* Rename of the ZZDHA call to DHFA. */ - -/* - SPICELIB Version 1.0.0 29-APR-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation is decreasing */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGFSPDC", (ftnlen)8); - } - spkez_(&svbod1, et, svref, svabcr, &svobs, pv1, <, (ftnlen)32, (ftnlen) - 32); - if (failed_()) { - chkout_("ZZGFSPDC", (ftnlen)8); - return 0; - } - spkez_(&svbod2, et, svref, svabcr, &svobs, pv2, <, (ftnlen)32, (ftnlen) - 32); - if (failed_()) { - chkout_("ZZGFSPDC", (ftnlen)8); - return 0; - } - -/* The angular separation between the bodies has the value */ - -/* theta = sep - alpha1 - alpha2 */ - -/* With alpha1 the half angle of SVBOD1, alpha2 the half */ -/* angle of SVBOD2, half angle defined as (for spheres): */ - -/* sin(alpha) = body_radius */ -/* ----------- */ -/* range_to_body */ - -/* The corresponding time derivative of theta: */ - -/* d(theta) = d(sep) - d(alpha1) - d(alpha2) */ -/* -------- ------ --------- --------- */ -/* dt dt dt dt */ - -/* Note, alpha1, alpha2 and their derivatives have value zero */ -/* for point objects. */ - - dtheta = dvsep_(pv1, pv2); - -/* Check for a failure caused by a numerical event. */ - - if (failed_()) { - *decres = TRUE_; - chkout_("ZZGFSPDC", (ftnlen)8); - return 0; - } - dtheta = dtheta - dhfa_(pv1, &svrad1) - dhfa_(pv2, &svrad2); - if (dtheta < 0.) { - *decres = TRUE_; - } else { - *decres = FALSE_; - } - chkout_("ZZGFSPDC", (ftnlen)8); - return 0; -/* $Procedure ZZGFGSEP ( Private - GF, calculate angular separation ) */ - -L_zzgfgsep: -/* $ Abstract */ - -/* Determine the angular separation between the limbs of the two */ -/* bodies. */ - -/* $ 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 */ - -/* ANGLE */ -/* GEOMETRY */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION SEP */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* SEP O Separation at time ET. */ - -/* $ Detailed_Input */ - -/* ET time in ephemeris seconds past J2000 when the */ -/* angular separation between the two bodies is */ -/* to be computed. */ - -/* $ Detailed_Output */ - -/* SEP is the angular separation between SVBOD1 and SVBOD2 as */ -/* seen from SVOBS at time ET. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determins the apparent angular separation between the */ -/* limbs of bodies SVBOD1 and SVBOD2 as seen from SVOBS at time ET. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 26-AUG-2003 (LSE) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation between two bodies */ - -/* -& */ - zzgfspq_(et, &svbod1, &svbod2, &svrad1, &svrad2, &svobs, svabcr, svref, - sep, (ftnlen)32, (ftnlen)32); - return 0; -/* $Procedure ZZGFSPLT ( Private - GF, angular separation < reference ) */ - -L_zzgfsplt: -/* $ Abstract */ - -/* Determine whether or not the angular separation between the two */ -/* bodies is less than the reference value. */ - -/* $ 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 */ - -/* ANGLE */ -/* GEOMETRY */ -/* ROOT */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ET */ -/* LOGICAL LSSTHN */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris seconds past J2000 TDB. */ -/* LSSTHN O True if separation is less than REFVAL, */ -/* false otherwise. */ - -/* $ Detailed_Input */ - -/* ET is the time in second past J2000 at which one wants */ -/* to determine if the angular separation between the */ -/* two bodies is less than the reference angle. */ - -/* $ Detailed_Output */ - -/* LSSTHN a scalar boolean indicating if the angle between the */ -/* two bodies is less than the reference angle at */ -/* time ET. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether or not the angle between */ -/* the two objects as seen from SVOBS is less than the reference */ -/* angle at time ET. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) Due to the current logic implemented in ZZGFSPU, a direct */ -/* search for the zero angular separation of two point targets */ -/* will always fails, i.e., */ - -/* OP = '=' */ -/* REFVAL = 0.D0. */ - -/* Use OP values of 'ABSMIN' or 'LOCMIN' to detect such an event. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 19-FEB-2009 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* angular separation less than an angle */ - -/* -& */ - zzgfspq_(et, &svbod1, &svbod2, &svrad1, &svrad2, &svobs, svabcr, svref, & - seprtn, (ftnlen)32, (ftnlen)32); - if (seprtn < svang) { - *lssthn = TRUE_; - } else { - *lssthn = FALSE_; - } - return 0; -} /* zzgfspu_ */ - -/* Subroutine */ int zzgfspu_(char *of, char *from, char *shape, char *frame, - doublereal *refval, doublereal *et, char *abcorr, logical *decres, - logical *lssthn, doublereal *sep, ftnlen of_len, ftnlen from_len, - ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len) -{ - return zzgfspu_0_(0, of, from, shape, frame, refval, et, abcorr, decres, - lssthn, sep, of_len, from_len, shape_len, frame_len, abcorr_len); - } - -/* Subroutine */ int zzgfspin_(char *of, char *from, char *shape, char *frame, - doublereal *refval, char *abcorr, ftnlen of_len, ftnlen from_len, - ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len) -{ - return zzgfspu_0_(1, of, from, shape, frame, refval, (doublereal *)0, - abcorr, (logical *)0, (logical *)0, (doublereal *)0, of_len, - from_len, shape_len, frame_len, abcorr_len); - } - -/* Subroutine */ int zzgfspur_(doublereal *refval) -{ - return zzgfspu_0_(2, (char *)0, (char *)0, (char *)0, (char *)0, refval, ( - doublereal *)0, (char *)0, (logical *)0, (logical *)0, ( - doublereal *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int zzgfspdc_(doublereal *et, logical *decres) -{ - return zzgfspu_0_(3, (char *)0, (char *)0, (char *)0, (char *)0, ( - doublereal *)0, et, (char *)0, decres, (logical *)0, (doublereal * - )0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfgsep_(doublereal *et, doublereal *sep) -{ - return zzgfspu_0_(4, (char *)0, (char *)0, (char *)0, (char *)0, ( - doublereal *)0, et, (char *)0, (logical *)0, (logical *)0, sep, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int zzgfsplt_(doublereal *et, logical *lssthn) -{ - return zzgfspu_0_(5, (char *)0, (char *)0, (char *)0, (char *)0, ( - doublereal *)0, et, (char *)0, (logical *)0, lssthn, (doublereal * - )0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zzgfssin.c b/ext/spice/src/cspice/zzgfssin.c deleted file mode 100644 index d412f4e373..0000000000 --- a/ext/spice/src/cspice/zzgfssin.c +++ /dev/null @@ -1,1286 +0,0 @@ -/* zzgfssin.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__6 = 6; -static doublereal c_b49 = 1.; - -/* $Procedure ZZGFSSIN ( GF, state of surface intercept point ) */ -/* Subroutine */ int zzgfssin_(char *method, integer *trgid, doublereal *et, - char *fixref, char *abcorr, integer *obsid, char *dref, integer *dctr, - doublereal *dvec, doublereal *radii, doublereal *state, logical * - found, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len, - ftnlen dref_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer prvobs = 0; - static integer prvtrg = 0; - static char svobs[36] = " "; - static char svtarg[36] = " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - logical geom; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_( - doublereal *, doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *); - logical xmit; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - doublereal upos[3]; - extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal - *, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *, - doublereal *, doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal t; - extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, - doublereal *); - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal savel[3]; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - vsubg_(doublereal *, doublereal *, integer *, doublereal *); - doublereal ltctr, stemp[6]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal xform[36] /* was [6][6] */; - logical uselt; - extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen); - doublereal j2dsta[6], ssbtg0[6]; - extern logical failed_(void); - doublereal sa[3]; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - doublereal lt, drfepc; - integer frcode; - extern doublereal clight_(void); - extern logical return_(void); - doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6] - */, ctrsta[6], dcorxf[36] /* was [6][6] */, dltctr, drxfrm[36] - /* was [6][6] */, fxdsta[6], fxosta[6], fxpsta[6], fxpvel[3], acc[ - 3], fxtsta[6], ltsign, obspnt[6], obssta[12] /* was [6][2] - */, obstrg[6], pntsta[6], sastat[6], spoint[3], srfvec[3], ssbobs[ - 6], ssbtrg[6], trgepc; - integer center, clssid, frclss; - logical attblk[6], fnd, usestl; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), sxform_(char *, char *, - doublereal *, doublereal *, ftnlen, ftnlen), namfrm_(char *, - integer *, ftnlen), frinfo_(integer *, integer *, integer *, - integer *, logical *), errint_(char *, integer *, ftnlen), - spkgeo_(integer *, doublereal *, char *, integer *, doublereal *, - doublereal *, ftnlen); - doublereal dlt; - extern /* Subroutine */ int vminug_(doublereal *, integer *, doublereal *) - , surfpv_(doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, logical *), spkacs_(integer *, - doublereal *, char *, char *, integer *, doublereal *, doublereal - *, doublereal *, ftnlen, ftnlen), sincpt_(char *, char *, - doublereal *, char *, char *, char *, char *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *, ftnlen, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), spkssb_(integer *, - doublereal *, char *, doublereal *, ftnlen), qderiv_(integer *, - doublereal *, doublereal *, doublereal *, doublereal *), invstm_( - doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Return the state of a ray-target surface intercept point used to */ -/* define coordinates referenced in a GF search. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TRGID I Target ID code. */ -/* ET I Computation epoch. */ -/* FIXREF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSID I Observer ID code. */ -/* DREF I Reference frame of ray's direction vector. */ -/* DCTR I DREF's center ID code. */ -/* DVEC I Ray's direction vector. */ -/* RADII I Target radii. */ -/* STATE O State used to define coordinates. */ -/* FOUND O Flag indicating whether state was found. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. Any value */ -/* supported by SUBPNT may be used. */ - - -/* TRGID is the NAIF ID code of the target object. */ - -/* *This routine assumes that the target is modeled */ -/* as a tri-axial ellipsoid.* */ - - -/* ET is the time, expressed as ephemeris seconds past J2000 */ -/* TDB, at which the specified state is to be computed. */ - - -/* FIXREF is the name of the reference frame relative to which */ -/* the state of interest is specified. */ - -/* FIXREF must be centered on the target body. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string FIXREF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* NONE No correction. */ -/* LT Light time only. */ -/* LT+S Light time and stellar aberration. */ -/* CN Converged Newtonian (CN) light time. */ -/* CN+S CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* XLT Light time only. */ -/* XLT+S Light time and stellar aberration. */ -/* XCN Converged Newtonian (CN) light time. */ -/* XCN+S CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSID is the NAIF ID code of the observer. */ - - -/* DREF is the name of the reference frame relative to which */ -/* a ray's direction vector is expressed. This may be */ -/* any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). The string DREF is case-insensitive, and */ -/* leading and trailing blanks in DREF are not */ -/* significant. */ - -/* When DREF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the frame's center and, if the center is */ -/* not the observer, on the selected aberration */ -/* correction. See the description of the direction */ -/* vector DVEC for details. */ - - -/* DCTR is the NAIF ID code of the body at which the frame */ -/* designated by DREF is centered. While DCTR can */ -/* be obtained from the FRAMEX system, passing in */ -/* the ID code is more efficient. DCTR should be looked */ -/* up by the coordinate search utility initialization */ -/* routine before a search is performed. */ - - -/* DVEC Ray direction vector emanating from the observer. The */ -/* intercept with the target body's surface of the ray */ -/* defined by the observer and DVEC is sought. */ - -/* DVEC is specified relative to the reference frame */ -/* designated by DREF. */ - -/* Non-inertial reference frames are treated as follows: */ -/* if the center of the frame is at the observer's */ -/* location, the frame is evaluated at ET. If the */ -/* frame's center is located elsewhere, then letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - - -/* RADII is an array containing three radii defining */ -/* a reference ellipsoid for the target body. */ - -/* $ Detailed_Output */ - -/* STATE is the state of the surface intercept point at ET. */ -/* The first three components of STATE contain the */ -/* surface intercept point itself; the last three */ -/* components contain the derivative with respect to */ -/* time of the intercept. The state is expressed */ -/* relative to the body-fixed frame designated by */ -/* FIXREF. */ - -/* Units are km and km/s. */ - -/* STATE is defined if and only if the output flag FOUND */ -/* is set to .TRUE. */ - - -/* FOUND is a logical flag indicating whether the requested */ -/* state was found. FOUND is set to .TRUE. if and only */ -/* if */ - -/* - the surface intercept exists */ - -/* - the velocity of the surface intercept */ -/* is computable */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the aberration correction ABCORR is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 2) If the frame FIXREF is not recognized by the frames */ -/* subsystem, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 3) FIXREF must be centered on the target body; if it isn't, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 4) Any error that occurs while look up the state of the target */ -/* or observer will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* 5) Any error that occurs while look up the orientation of */ -/* the target will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* 6) If the input method is not recognized, the error */ -/* SPICE(NOTSUPPORTED) will be signaled. */ - -/* 7) The input ray direction frame center DCTR must be compatible */ -/* with the ray direction frame DREF. This routine *does not */ -/* check* the validity of DCTR. */ - -/* 8) If the input ray's direction vector is the zero vector, the */ -/* error will be diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: if the target body shape is modeled as an */ -/* ellipsoid, triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must be */ -/* loaded. These may be provided in a text or binary PCK file. */ - -/* - Frame data: if a frame definition is required to convert the */ -/* observer and target states to the body-fixed frame of the */ -/* target, that definition must be available in the kernel */ -/* pool. Typically the definition is supplied by loading a */ -/* frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine isolates the computation of the surface intercept */ -/* state (that is, the surface intercept point and its derivative */ -/* with respect to time). */ - -/* This routine is used by the GF coordinate utility routines in */ -/* order to solve for time windows on which specified mathematical */ -/* conditions involving coordinates are satisfied. The role of */ -/* this routine is to provide Cartesian state vectors enabling */ -/* the GF coordinate utilities to determine the signs of the */ -/* derivatives with respect to time of coordinates of interest. */ - -/* $ Examples */ - -/* See ZZGFCOST. */ - -/* $ Restrictions */ - -/* 1) This routine is restricted to use with ellipsoidal target */ -/* shape models. */ - -/* 2) The computations performed by this routine are intended */ -/* to be compatible with those performed by the SPICE */ -/* routine SUBPNT. If that routine changes, this routine */ -/* may need to be updated. */ - -/* 3) This routine presumes that error checking of inputs */ -/* has, where possible, already been performed by the */ -/* GF coordinate utility initialization routine. */ - -/* 4) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */ - -/* Upgraded to support targets and observers having */ -/* no names associated with their ID codes. */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* surface intercept state */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFSSIN", (ftnlen)8); - -/* No result has been found. */ - - *found = FALSE_; - if (first || *trgid != prvtrg) { - bodc2s_(trgid, svtarg, (ftnlen)36); - prvtrg = *trgid; - } - if (first || *obsid != prvobs) { - bodc2s_(obsid, svobs, (ftnlen)36); - prvobs = *obsid; - } - first = FALSE_; - -/* Parse the aberration correction specifier. */ - - zzprscor_(abcorr, attblk, abcorr_len); - geom = attblk[0]; - uselt = attblk[1]; - usestl = attblk[2]; - xmit = attblk[4]; - -/* Set the sign associated with the light time correction. */ - - if (xmit) { - ltsign = 1.; - } else { - ltsign = -1.; - } - -/* Decide whether the surface intercept point is computed using */ -/* the "near point" or "surface intercept" method. Only */ -/* ellipsoids may be used a shape models for this computation. */ - - if (! eqstr_(method, "Ellipsoid", method_len, (ftnlen)9)) { - setmsg_("Surface intercept point computation method # is not support" - "ed by this routine.", (ftnlen)78); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - if (geom) { - -/* This is the geometric case. */ - -/* No light time correction is involved, so all frames are */ -/* evaluated at the observation epoch. */ - -/* Compute the state transformation from DREF to J2000. */ - - sxform_(dref, "J2000", et, dcorxf, dref_len, (ftnlen)5); - -/* Transform the ray's direction vector from DREF to the J2000 */ -/* frame. The velocity of DVEC in frame DREF is zero. */ - - moved_(dvec, &c__3, stemp); - cleard_(&c__3, &stemp[3]); - mxvg_(dcorxf, stemp, &c__6, &c__6, j2dsta); - -/* We need to check the body-fixed reference frame here. */ - - namfrm_(fixref, &frcode, fixref_len); - frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd); - if (failed_()) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - if (! fnd) { - setmsg_("Input reference frame # was not recognized.", (ftnlen)43) - ; - errch_("#", fixref, (ftnlen)1, fixref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - if (center != *trgid) { - setmsg_("Input reference frame # is centered on body # instead o" - "f body #.", (ftnlen)64); - errch_("#", fixref, (ftnlen)1, fixref_len); - errint_("#", ¢er, (ftnlen)1); - errint_("#", trgid, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } -/* Get the state of the target with respect to the observer, */ -/* expressed relative to the target body-fixed frame. We don't */ -/* need to propagate states to the solar system barycenter in */ -/* this case. */ - - spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len); - if (failed_()) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - -/* Compute the state of the observer with respect to the target */ -/* in the body-fixed frame. */ - - vminug_(fxtsta, &c__6, fxosta); - -/* Transform the state of the direction vector from the J2000 */ -/* frame to the target body-fixed frame at TRGEPC. Since no */ -/* light time corrections are involved, the state transformation */ -/* matrix from SXFORM works just fine. */ - - sxform_("J2000", fixref, et, xform, (ftnlen)5, fixref_len); - mxvg_(xform, j2dsta, &c__6, &c__6, fxdsta); - -/* Now we can obtain the surface velocity of the surface intercept */ -/* point. */ - - surfpv_(fxosta, fxdsta, radii, &radii[1], &radii[2], fxpsta, found); - -/* It's not an error for SURFPV to be unable to compute an */ -/* intercept state; return now if the state was not */ -/* computable. */ - - if (! (*found)) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - } else if (uselt) { - -/* Light time and possibly stellar aberration corrections */ -/* are applied. */ - -/* Compute the state transformation from DREF to J2000. */ - - if (*obsid == *dctr) { - -/* DREF is centered on the observer, so there's no light time */ -/* correction. */ - - sxform_(dref, "J2000", et, dcorxf, dref_len, (ftnlen)5); - } else { - -/* Find the epoch DRFEPC associated with the input direction */ -/* vector's reference frame DREF. We use SPK rules for */ -/* determining the epoch, just as in SINCPT. Let DLTCTR be the */ -/* rate of change of light time between the frame center and */ -/* the observer. */ - - -/* Find the light time from the observer to the center of */ -/* frame DREF. */ - - spkacs_(dctr, et, "J2000", abcorr, obsid, ctrsta, <ctr, &dltctr, - (ftnlen)5, abcorr_len); - if (failed_()) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - drfepc = *et + ltsign * ltctr; - -/* Compute the state of the input direction vector in the */ -/* J2000 frame at DRFEPC. Correct the state transformation for */ -/* the rate of change of light time. */ - - sxform_(dref, "J2000", &drfepc, drxfrm, dref_len, (ftnlen)5); - zzcorsxf_(&xmit, &dltctr, drxfrm, dcorxf); - } - -/* The velocity of DVEC in frame DREF is zero. */ - - moved_(dvec, &c__3, stemp); - cleard_(&c__3, &stemp[3]); - mxvg_(dcorxf, stemp, &c__6, &c__6, j2dsta); - -/* We'll transform J2DSTA to the target body-fixed frame at */ -/* the target epoch once we've computed the required */ -/* state transformation matrix. This occurs just before */ -/* we use this state vector in a call to SURFPV. */ - -/* Most our work consists of getting ready to call the SPICELIB */ -/* routine SURFPV. In order to make this call, we'll need the */ -/* velocity of the observer relative to the target body's center */ -/* in the target body-fixed frame. We must evaluate the rotation */ -/* state of the target at the correct epoch, and account for the */ -/* rate of change of light time, if light time corrections are */ -/* used. The algorithm we use depends on the algorithm used in */ -/* SINCPT, since we're computing the derivative with respect to */ -/* time of the solution found by that routine. */ - -/* In this algorithm, we must take into account the fact that */ -/* SINCPT performs light time and stellar aberration corrections */ -/* for the surface intercept point, not for the center of the */ -/* target body. */ - -/* If light time and stellar aberration corrections are used, */ - -/* - Find the aberration corrected surface intercept point and */ -/* the light time-corrected epoch TRGEPC associated */ -/* with the surface intercept point. */ - -/* - Use TRGEPC to find the position of the target relative */ -/* to the solar system barycenter. */ - -/* - Use TRGEPC to find the orientation of the target relative */ -/* to the J2000 reference frame. */ - -/* - Find the light-time corrected position of the */ -/* surface intercept point; use this to compute the */ -/* stellar aberration offset that applies to the */ -/* surface intercept point, as well as the velocity of */ -/* this offset. */ - -/* - Find the corrected state of the target center as seen */ -/* from the observer, where the corrections are those */ -/* applicable to the surface intercept point. */ - -/* - Negate the corrected target center state to obtain */ -/* the state of the observer relative to the target. */ - -/* - Express the state of the observer relative to the */ -/* target in the target body fixed frame at TRGEPC. */ - - -/* Below, we'll use the convention that vectors expressed */ -/* relative to the body-fixed frame have names of the form */ - -/* FX* */ - -/* Note that SINCPT will signal an error if FIXREF is not */ -/* actually centered on the target body. */ - - sincpt_(method, svtarg, et, fixref, abcorr, svobs, dref, dvec, spoint, - &trgepc, srfvec, found, method_len, (ftnlen)36, fixref_len, - abcorr_len, (ftnlen)36, dref_len); - -/* Get J2000-relative states of observer and target with respect */ -/* to the solar system barycenter at their respective epochs of */ -/* participation. */ - - spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5); - spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5); - -/* Get the uncorrected J2000 to body-fixed to state */ -/* transformation at TRGEPC. */ - - sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - -/* Initialize the state of the surface intercept point in the */ -/* body-fixed frame. At this point we don't know the point's */ -/* velocity; set it to zero. */ - - moved_(spoint, &c__3, fxpsta); - cleard_(&c__3, &fxpsta[3]); - if (usestl) { - -/* We're going to need the acceleration of the observer */ -/* relative to the SSB. Compute this now. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* The epoch is ET -/+ TDELTA. */ - - t = *et + ((i__ << 1) - 3) * 1.; - spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12 - && 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss" - "in_", (ftnlen)780)], (ftnlen)5); - } - if (failed_()) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - -/* Compute the observer's acceleration using a quadratic */ -/* approximation. */ - - qderiv_(&c__3, &obssta[3], &obssta[9], &c_b49, acc); - } - -/* The rest of the algorithm is iterative. On the first */ -/* iteration, we don't have a good estimate of the velocity */ -/* of the surface intercept point relative to the body-fixed */ -/* frame. Since we're using this velocity as an input */ -/* to the aberration velocity computations, we */ -/* expect that treating this velocity as zero on the first */ -/* pass yields a reasonable estimate. On the second pass, */ -/* we'll use the velocity derived on the first pass. */ - - cleard_(&c__3, fxpvel); - -/* We'll also estimate the rate of change of light time */ -/* as zero on the first pass. */ - - dlt = 0.; - for (i__ = 1; i__ <= 3; ++i__) { - -/* Correct the target's velocity for the rate of */ -/* change of light time. */ - - if (xmit) { - scale = dlt + 1.; - } else { - scale = 1. - dlt; - } - -/* Scale the velocity portion of the target state to */ -/* correct the velocity for the rate of change of light */ -/* time. */ - - moved_(ssbtg0, &c__3, ssbtrg); - vscl_(&scale, &ssbtg0[3], &ssbtrg[3]); - -/* Get the state of the target with respect to the observer. */ - - vsubg_(ssbtrg, ssbobs, &c__6, obstrg); - -/* Correct the J2000 to body-fixed state transformation matrix */ -/* for the rate of change of light time. */ - - zzcorsxf_(&xmit, &dlt, xform, corxfm); - -/* Invert CORXFM to obtain the corrected */ -/* body-fixed to J2000 state transformation. */ - - invstm_(corxfm, corxfi); - -/* Convert the surface intercept point state to the J2000 */ -/* frame. */ - - mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta); - -/* Find the J2000-relative state of the surface intercept */ -/* point with respect to the target. */ - - vaddg_(obstrg, pntsta, &c__6, obspnt); - if (usestl) { - -/* Now compute the stellar aberration correction */ -/* applicable to OBSPNT. We need the velocity of */ -/* this correction as well. */ - - zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel); - moved_(sa, &c__3, sastat); - moved_(savel, &c__3, &sastat[3]); - -/* Adding the stellar aberration state to the target center */ -/* state gives us the state of the target center with */ -/* respect to the observer, corrected for the aberrations */ -/* applicable to the surface intercept point. */ - - vaddg_(obstrg, sastat, &c__6, stemp); - } else { - moved_(obstrg, &c__6, stemp); - } - -/* Convert STEMP to the body-fixed reference frame. */ - - mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta); - -/* At long last, compute the state of the observer */ -/* with respect to the target in the body-fixed frame. */ - - vminug_(fxtsta, &c__6, fxosta); - -/* Transform the state of the direction vector from the */ -/* J2000 frame to the target body-fixed frame at TRGEPC. */ - - mxvg_(corxfm, j2dsta, &c__6, &c__6, fxdsta); - -/* Now we can obtain the surface velocity of the */ -/* surface intercept point. */ - - surfpv_(fxosta, fxdsta, radii, &radii[1], &radii[2], fxpsta, - found); - -/* It's not an error for SURFPV to be unable to compute an */ -/* intercept state; return now if the state was not */ -/* computable. */ - - if (! (*found)) { - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - -/* At this point we can update the surface point */ -/* velocity and light time derivative estimates. */ - -/* In order to compute the light time rate, we'll */ -/* need the J2000-relative velocity of the surface intercept */ -/* point with respect to the observer. First convert */ -/* the surface intercept state to the J2000 frame, then */ -/* add the result to the state of the target center */ -/* with respect to the observer. */ - - mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta); - vaddg_(obstrg, pntsta, &c__6, obspnt); - -/* Now that we have an improved estimate of the */ -/* surface intercept state, we can estimate the rate of */ -/* change of light time as */ - -/* range rate */ -/* ---------- */ -/* c */ - - -/* If we're correcting for stellar aberration, *ideally* we */ -/* should remove that correction now, since the light time */ -/* rate is based on light time between the observer and the */ -/* light-time corrected surface intercept point. But the error */ -/* made by including stellar aberration is too small to make */ -/* it worthwhile to make this adjustment. */ - - vhat_(obspnt, upos); - dlt = vdot_(&obspnt[3], upos) / clight_(); - -/* With FXPVEL and DLT updated, we'll repeat our */ -/* computations. */ - - } - } else { - -/* We should never get here. */ - - setmsg_("Aberration correction # was not recognized.", (ftnlen)43); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; - } - -/* Copy the computed state to the output argument STATE. */ -/* FOUND has already been set to .TRUE. by SURFPV. */ - - moved_(fxpsta, &c__6, state); - chkout_("ZZGFSSIN", (ftnlen)8); - return 0; -} /* zzgfssin_ */ - diff --git a/ext/spice/src/cspice/zzgfssob.c b/ext/spice/src/cspice/zzgfssob.c deleted file mode 100644 index a9ead5b7eb..0000000000 --- a/ext/spice/src/cspice/zzgfssob.c +++ /dev/null @@ -1,1187 +0,0 @@ -/* zzgfssob.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__3 = 3; -static doublereal c_b40 = 1.; - -/* $Procedure ZZGFSSOB ( GF, state of sub-observer point ) */ -/* Subroutine */ int zzgfssob_(char *method, integer *trgid, doublereal *et, - char *fixref, char *abcorr, integer *obsid, doublereal *radii, - doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen - abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer prvobs = 0; - static integer prvtrg = 0; - static char svobs[36] = " "; - static char svtarg[36] = " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal dalt[2]; - logical near__, geom; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_( - doublereal *, doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *); - logical xmit; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - doublereal upos[3]; - extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal - *, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *, - doublereal *, doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal t; - extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, - doublereal *); - doublereal scale; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal savel[3]; - logical found; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *), - vsubg_(doublereal *, doublereal *, integer *, doublereal *); - doublereal stemp[6]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - doublereal xform[36] /* was [6][6] */; - logical uselt; - extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen); - doublereal ssbtg0[6]; - extern logical failed_(void); - doublereal sa[3]; - extern /* Subroutine */ int cleard_(integer *, doublereal *); - doublereal lt; - integer frcode; - extern doublereal clight_(void); - extern logical return_(void); - doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6] - */, fxosta[6], fxpsta[6], fxpvel[3], fxtsta[6], obspnt[6], obssta[ - 12] /* was [6][2] */, obstrg[6], pntsta[6], acc[3], raysta[6], - sastat[6], spoint[3], srfvec[3], ssbobs[6], ssbtrg[6], trgepc; - integer center, clssid, frclss; - logical attblk[6], usestl; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen); - logical fnd; - extern /* Subroutine */ int chkout_(char *, ftnlen), namfrm_(char *, - integer *, ftnlen), frinfo_(integer *, integer *, integer *, - integer *, logical *), errint_(char *, integer *, ftnlen), - spkgeo_(integer *, doublereal *, char *, integer *, doublereal *, - doublereal *, ftnlen), vminug_(doublereal *, integer *, - doublereal *), dnearp_(doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, logical *), surfpv_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, logical *), subpnt_(char *, char *, - doublereal *, char *, char *, char *, doublereal *, doublereal *, - doublereal *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen), spkssb_( - integer *, doublereal *, char *, doublereal *, ftnlen), sxform_( - char *, char *, doublereal *, doublereal *, ftnlen, ftnlen); - doublereal dlt; - extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *), invstm_(doublereal *, doublereal *); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Return the state of a sub-observer point used to define */ -/* coordinates referenced in a GF search. */ - -/* $ 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 */ - -/* GF */ -/* SPK */ -/* TIME */ -/* NAIF_IDS */ -/* FRAMES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* PRIVATE */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains public, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* L.E. Elson (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */ - -/* Added NWRR parameter. */ -/* Added NWUDS parameter. */ - -/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */ - -/* -& */ - -/* Root finding parameters: */ - -/* CNVTOL is the default convergence tolerance used by the */ -/* high-level GF search API routines. This tolerance is */ -/* used to terminate searches for binary state transitions: */ -/* when the time at which a transition occurs is bracketed */ -/* by two times that differ by no more than CNVTOL, the */ -/* transition time is considered to have been found. */ - -/* Units are TDB seconds. */ - - -/* NWMAX is the maximum number of windows allowed for user-defined */ -/* workspace array. */ - -/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */ - -/* Currently no more than twelve windows are required; the three */ -/* extra windows are spares. */ - -/* Callers of GFEVNT can include this file and use the parameter */ -/* NWMAX to declare the second dimension of the workspace array */ -/* if necessary. */ - - -/* Callers of GFIDST should declare their workspace window */ -/* count using NWDIST. */ - - -/* Callers of GFSEP should declare their workspace window */ -/* count using NWSEP. */ - - -/* Callers of GFRR should declare their workspace window */ -/* count using NWRR. */ - - -/* Callers of GFUDS should declare their workspace window */ -/* count using NWUDS. */ - - -/* ADDWIN is a parameter used to expand each interval of the search */ -/* (confinement) window by a small amount at both ends in order to */ -/* accommodate searches using equality constraints. The loaded */ -/* kernel files must accommodate these expanded time intervals. */ - - -/* FRMNLN is a string length for frame names. */ - - -/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */ - - -/* FOVTLN -- maximum length for FOV string. */ - - -/* Specify the character strings that are allowed in the */ -/* specification of field of view shapes. */ - - -/* Character strings that are allowed in the */ -/* specification of occultation types: */ - - -/* Occultation target shape specifications: */ - - -/* Specify the number of supported occultation types and occultation */ -/* type string length: */ - - -/* Instrument field-of-view (FOV) parameters */ - -/* Maximum number of FOV boundary vectors: */ - - -/* FOV shape parameters: */ - -/* circle */ -/* ellipse */ -/* polygon */ -/* rectangle */ - - -/* End of file gf.inc. */ - -/* $ Abstract */ - -/* SPICE private include file intended solely for the support of */ -/* SPICE routines. Users should not include this routine in their */ -/* source code due to the volatile nature of this file. */ - -/* This file contains private, global parameter declarations */ -/* for the SPICELIB Geometry Finder (GF) subsystem. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* ROOT */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */ - -/* -& */ - -/* The set of supported coordinate systems */ - -/* System Coordinates */ -/* ---------- ----------- */ -/* Rectangular X, Y, Z */ -/* Latitudinal Radius, Longitude, Latitude */ -/* Spherical Radius, Colatitude, Longitude */ -/* RA/Dec Range, Right Ascension, Declination */ -/* Cylindrical Radius, Longitude, Z */ -/* Geodetic Longitude, Latitude, Altitude */ -/* Planetographic Longitude, Latitude, Altitude */ - -/* Below we declare parameters for naming coordinate systems. */ -/* User inputs naming coordinate systems must match these */ -/* when compared using EQSTR. That is, user inputs must */ -/* match after being left justified, converted to upper case, */ -/* and having all embedded blanks removed. */ - - -/* Below we declare names for coordinates. Again, user */ -/* inputs naming coordinates must match these when */ -/* compared using EQSTR. */ - - -/* Note that the RA parameter value below matches */ - -/* 'RIGHT ASCENSION' */ - -/* when extra blanks are compressed out of the above value. */ - - -/* Parameters specifying types of vector definitions */ -/* used for GF coordinate searches: */ - -/* All string parameter values are left justified, upper */ -/* case, with extra blanks compressed out. */ - -/* POSDEF indicates the vector is defined by the */ -/* position of a target relative to an observer. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the sub-observer point on */ -/* that body, for a given observer and target. */ - - -/* SOBDEF indicates the vector points from the center */ -/* of a target body to the surface intercept point on */ -/* that body, for a given observer, ray, and target. */ - - -/* Number of workspace windows used by ZZGFREL: */ - - -/* Number of additional workspace windows used by ZZGFLONG: */ - - -/* Index of "existence window" used by ZZGFCSLV: */ - - -/* Progress report parameters: */ - -/* MXBEGM, */ -/* MXENDM are, respectively, the maximum lengths of the progress */ -/* report message prefix and suffix. */ - -/* Note: the sum of these lengths, plus the length of the */ -/* "percent complete" substring, should not be long enough */ -/* to cause wrap-around on any platform's terminal window. */ - - -/* Total progress report message length upper bound: */ - - -/* End of file zzgf.inc. */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* METHOD I Computation method. */ -/* TRGID I Target ID code. */ -/* ET I Computation epoch. */ -/* FIXREF I Reference frame name. */ -/* ABCORR I Aberration correction. */ -/* OBSID I Observer ID code. */ -/* RADII I Target radii. */ -/* STATE O State used to define coordinates. */ - -/* $ Detailed_Input */ - -/* METHOD is a short string providing parameters defining */ -/* the computation method to be used. Any value */ -/* supported by SUBPNT may be used. */ - - -/* TRGID is the NAIF ID code of the target object. */ - -/* *This routine assumes that the target is modeled */ -/* as a tri-axial ellipsoid.* */ - - -/* ET is the time, expressed as ephemeris seconds past J2000 */ -/* TDB, at which the specified state is to be computed. */ - - -/* FIXREF is the name of the reference frame relative to which */ -/* the state of interest is specified. */ - -/* FIXREF must be centered on the target body. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string FIXREF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time and stellar aberration. The orientation */ -/* of the target body will also be corrected for one-way */ -/* light time when light time corrections are requested. */ - -/* Supported aberration correction options for */ -/* observation (case where radiation is received by */ -/* observer at ET) are: */ - -/* NONE No correction. */ -/* LT Light time only. */ -/* LT+S Light time and stellar aberration. */ -/* CN Converged Newtonian (CN) light time. */ -/* CN+S CN light time and stellar aberration. */ - -/* Supported aberration correction options for */ -/* transmission (case where radiation is emitted from */ -/* observer at ET) are: */ - -/* XLT Light time only. */ -/* XLT+S Light time and stellar aberration. */ -/* XCN Converged Newtonian (CN) light time. */ -/* XCN+S CN light time and stellar aberration. */ - -/* For detailed information, see the geometry finder */ -/* required reading, gf.req. Also see the header of */ -/* SPKEZR, which contains a detailed discussion of */ -/* aberration corrections. */ - -/* Case, leading and trailing blanks are not significant */ -/* in the string ABCORR. */ - - -/* OBSID is the NAIF ID code of the observer. */ - - -/* RADII is an array containing three radii defining */ -/* a reference ellipsoid for the target body. */ - -/* $ Detailed_Output */ - -/* STATE is the state of the sub-observer point at ET. */ -/* The first three components of STATE contain the */ -/* sub-observer point itself; the last three */ -/* components contain the derivative with respect to */ -/* time of the position. The state is expressed */ -/* relative to the body-fixed frame designated by */ -/* FIXREF. */ - -/* Units are km and km/s. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the aberration correction ABCORR is not recognized, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 2) If the frame FIXREF is not recognized by the frames */ -/* subsystem, the error will be diagnosed by routines in the */ -/* call tree of this routine. */ - -/* 3) FIXREF must be centered on the target body; if it isn't, */ -/* the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* 4) Any error that occurs while look up the state of the target */ -/* or observer will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* 5) Any error that occurs while look up the orientation of */ -/* the target will be diagnosed by routines in the call tree of */ -/* this routine. */ - -/* 6) If the input method is not recognized, the error */ -/* SPICE(NOTSUPPORTED) will be signaled. */ - -/* $ Files */ - -/* Appropriate kernels must be loaded by the calling program before */ -/* this routine is called. */ - -/* The following data are required: */ - -/* - SPK data: ephemeris data for target and observer must be */ -/* loaded. If aberration corrections are used, the states of */ -/* target and observer relative to the solar system barycenter */ -/* must be calculable from the available ephemeris data. */ -/* Typically ephemeris data are made available by loading one */ -/* or more SPK files via FURNSH. */ - -/* - PCK data: if the target body shape is modeled as an */ -/* ellipsoid, triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via FURNSH. */ - -/* - Further PCK data: rotation data for the target body must be */ -/* loaded. These may be provided in a text or binary PCK file. */ - -/* - Frame data: if a frame definition is required to convert the */ -/* observer and target states to the body-fixed frame of the */ -/* target, that definition must be available in the kernel */ -/* pool. Typically the definition is supplied by loading a */ -/* frame kernel via FURNSH. */ - -/* In all cases, kernel data are normally loaded once per program */ -/* run, NOT every time this routine is called. */ - -/* $ Particulars */ - -/* This routine isolates the computation of the sub-observer state */ -/* (that is, the sub-observer point and its derivative with respect */ -/* to time). */ - -/* This routine is used by the GF coordinate utility routines in */ -/* order to solve for time windows on which specified mathematical */ -/* conditions involving coordinates are satisfied. The role of */ -/* this routine is to provide Cartesian state vectors enabling */ -/* the GF coordinate utilities to determine the signs of the */ -/* derivatives with respect to time of coordinates of interest. */ - -/* $ Examples */ - -/* See ZZGFCOST. */ - -/* $ Restrictions */ - -/* 1) This routine is restricted to use with ellipsoidal target */ -/* shape models. */ - -/* 2) The computations performed by this routine are intended */ -/* to be compatible with those performed by the SPICE */ -/* routine SUBPNT. If that routine changes, this routine */ -/* may need to be updated. */ - -/* 3) This routine presumes that error checking of inputs */ -/* has, where possible, already been performed by the */ -/* GF coordinate utility initialization routine. */ - -/* 4) The interface and functionality of this set of routines may */ -/* change without notice. These routines should be called only */ -/* by SPICELIB routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */ - -/* Upgraded to support targets and observers having */ -/* no names associated with their ID codes. */ - -/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* sub-observer state */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFSSOB", (ftnlen)8); - if (first || *trgid != prvtrg) { - bodc2s_(trgid, svtarg, (ftnlen)36); - prvtrg = *trgid; - } - if (first || *obsid != prvobs) { - bodc2s_(obsid, svobs, (ftnlen)36); - prvobs = *obsid; - } - first = FALSE_; - -/* Parse the aberration correction specifier. */ - - zzprscor_(abcorr, attblk, abcorr_len); - geom = attblk[0]; - uselt = attblk[1]; - usestl = attblk[2]; - xmit = attblk[4]; - -/* Decide whether the sub-observer point is computed using */ -/* the "near point" or "surface intercept" method. Only */ -/* ellipsoids may be used a shape models for this computation. */ - - if (eqstr_(method, "Near point: ellipsoid", method_len, (ftnlen)21)) { - near__ = TRUE_; - } else if (eqstr_(method, "Intercept: ellipsoid", method_len, (ftnlen)20)) - { - near__ = FALSE_; - } else { - setmsg_("Sub-observer point computation method # is not supported by" - " this routine.", (ftnlen)73); - errch_("#", method, (ftnlen)1, method_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - if (geom) { - -/* This is the geometric case. */ - -/* We need to check the body-fixed reference frame here. */ - - namfrm_(fixref, &frcode, fixref_len); - frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd); - if (failed_()) { - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - if (! fnd) { - setmsg_("Input reference frame # was not recognized.", (ftnlen)43) - ; - errch_("#", fixref, (ftnlen)1, fixref_len); - sigerr_("SPICE(NOFRAME)", (ftnlen)14); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - if (center != *trgid) { - setmsg_("Input reference frame # is centered on body # instead o" - "f body #.", (ftnlen)64); - errch_("#", fixref, (ftnlen)1, fixref_len); - errint_("#", ¢er, (ftnlen)1); - errint_("#", trgid, (ftnlen)1); - sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - -/* Get the state of the target with respect to the observer, */ -/* expressed relative to the target body-fixed frame. We don't */ -/* need to propagate states to the solar system barycenter in */ -/* this case. */ - - spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len); - if (failed_()) { - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - -/* Compute the state of the observer with respect to the target */ -/* in the body-fixed frame. */ - - vminug_(fxtsta, &c__6, fxosta); - -/* Now we can obtain the surface velocity of the sub-observer */ -/* point. */ - - if (near__) { - -/* The sub-observer point method is "near point." */ - - dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &found) - ; - if (! found) { - setmsg_("The sub-observer state could could not be computed " - "because the velocity was not well defined. DNEARP re" - "turned \"not found.\"", (ftnlen)122); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - } else { - -/* The sub-observer point method is "surface */ -/* intercept point." The ray direction is simply */ -/* the negative of the observer's position relative */ -/* to the target center. */ - - vminug_(fxosta, &c__6, raysta); - surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, & - found); - -/* Although in general it's not an error for SURFPV to */ -/* be unable to compute an intercept state, it *is* */ -/* an error in this case, since the ray points toward */ -/* the center of the target. */ - - if (! found) { - setmsg_("The sub-observer state could could not be computed " - "because the velocity was not well defined. SURFPV re" - "turned \"not found.\"", (ftnlen)122); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - } - } else if (uselt) { - -/* Light time and possibly stellar aberration corrections are */ -/* applied. */ - -/* Most our work consists of getting ready to call either of the */ -/* SPICELIB routines DNEARP or SURFPV. In order to make this */ -/* call, we'll need the velocity of the observer relative to the */ -/* target body's center in the target body-fixed frame. We must */ -/* evaluate the rotation state of the target at the correct */ -/* epoch, and account for the rate of change of light time, if */ -/* light time corrections are used. The algorithm we use depends */ -/* on the algorithm used in SUBPNT, since we're computing the */ -/* derivative with respect to time of the solution found by that */ -/* routine. */ - -/* In this algorithm, we must take into account the fact that */ -/* SUBPNT performs light time and stellar aberration corrections */ -/* for the sub-observer point, not for the center of the target */ -/* body. */ - -/* If light time and stellar aberration corrections are used, */ - -/* - Find the aberration corrected sub-observer point and the */ -/* light time-corrected epoch TRGEPC associated with the */ -/* sub-observer point. */ - -/* - Use TRGEPC to find the position of the target relative to */ -/* the solar system barycenter. */ - -/* - Use TRGEPC to find the orientation of the target relative */ -/* to the J2000 reference frame. */ - -/* - Find the light-time corrected position of the */ -/* sub-observer point; use this to compute the stellar */ -/* aberration offset that applies to the sub-observer point, */ -/* as well as the velocity of this offset. */ - -/* - Find the corrected state of the target center as seen */ -/* from the observer, where the corrections are those */ -/* applicable to the sub-observer point. */ - -/* - Negate the corrected target center state to obtain the */ -/* state of the observer relative to the target. */ - -/* - Express the state of the observer relative to the target */ -/* in the target body fixed frame at TRGEPC. */ - - -/* Below, we'll use the convention that vectors expressed */ -/* relative to the body-fixed frame have names of the form */ - -/* FX* */ - -/* Note that SUBPNT will signal an error if FIXREF is not */ -/* actually centered on the target body. */ - - subpnt_(method, svtarg, et, fixref, abcorr, svobs, spoint, &trgepc, - srfvec, method_len, (ftnlen)36, fixref_len, abcorr_len, ( - ftnlen)36); - -/* Get J2000-relative states of observer and target with respect */ -/* to the solar system barycenter at their respective epochs of */ -/* participation. */ - - spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5); - spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5); - -/* Get the uncorrected J2000 to body-fixed to state */ -/* transformation at TRGEPC. */ - - sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len); - if (failed_()) { - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - -/* Initialize the state of the sub-observer point in the */ -/* body-fixed frame. At this point we don't know the */ -/* point's velocity; set it to zero. */ - - moved_(spoint, &c__3, fxpsta); - cleard_(&c__3, &fxpsta[3]); - if (usestl) { - -/* We're going to need the acceleration of the observer */ -/* relative to the SSB. Compute this now. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* The epoch is ET -/+ TDELTA. */ - - t = *et + ((i__ << 1) - 3) * 1.; - spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12 - && 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss" - "ob_", (ftnlen)652)], (ftnlen)5); - } - if (failed_()) { - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - -/* Compute the observer's acceleration using a quadratic */ -/* approximation. */ - - qderiv_(&c__3, &obssta[3], &obssta[9], &c_b40, acc); - } - -/* The rest of the algorithm is iterative. On the first */ -/* iteration, we don't have a good estimate of the velocity */ -/* of the sub-observer point relative to the body-fixed */ -/* frame. Since we're using this velocity as an input */ -/* to the aberration velocity computations, we */ -/* expect that treating this velocity as zero on the first */ -/* pass yields a reasonable estimate. On the second pass, */ -/* we'll use the velocity derived on the first pass. */ - - cleard_(&c__3, fxpvel); - -/* We'll also estimate the rate of change of light time */ -/* as zero on the first pass. */ - - dlt = 0.; - for (i__ = 1; i__ <= 2; ++i__) { - -/* Correct the target's velocity for the rate of */ -/* change of light time. */ - - if (xmit) { - scale = dlt + 1.; - } else { - scale = 1. - dlt; - } - -/* Scale the velocity portion of the target state to */ -/* correct the velocity for the rate of change of light */ -/* time. */ - - moved_(ssbtg0, &c__3, ssbtrg); - vscl_(&scale, &ssbtg0[3], &ssbtrg[3]); - -/* Get the state of the target with respect to the observer. */ - - vsubg_(ssbtrg, ssbobs, &c__6, obstrg); - -/* Correct the J2000 to body-fixed state transformation matrix */ -/* for the rate of change of light time. */ - - zzcorsxf_(&xmit, &dlt, xform, corxfm); - -/* Invert CORXFM to obtain the corrected */ -/* body-fixed to J2000 state transformation. */ - - invstm_(corxfm, corxfi); - -/* Convert the sub-observer point state to the J2000 frame. */ - - mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta); - -/* Find the J2000-relative state of the sub-observer */ -/* point with respect to the target. */ - - vaddg_(obstrg, pntsta, &c__6, obspnt); - if (usestl) { - -/* Now compute the stellar aberration correction */ -/* applicable to OBSPNT. We need the velocity of */ -/* this correction as well. */ - - zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel); - moved_(sa, &c__3, sastat); - moved_(savel, &c__3, &sastat[3]); - -/* Adding the stellar aberration state to the target center */ -/* state gives us the state of the target center with */ -/* respect to the observer, corrected for the aberrations */ -/* applicable to the sub-observer point. */ - vaddg_(obstrg, sastat, &c__6, stemp); - } else { - moved_(obstrg, &c__6, stemp); - } - -/* Convert STEMP to the body-fixed reference frame. */ - - mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta); - -/* At long last, compute the state of the observer */ -/* with respect to the target in the body-fixed frame. */ - - vminug_(fxtsta, &c__6, fxosta); - -/* Now we can obtain the surface velocity of the */ -/* sub-observer point. */ - - if (near__) { - -/* The sub-observer point method is "near point." */ - - dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, & - found); - if (! found) { - setmsg_("The sub-observer state could could not be compu" - "ted because the velocity was not well defined. " - "DNEARP returned \"not found.\"", (ftnlen)123); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - } else { - -/* The sub-observer point method is "surface intercept */ -/* point." The ray direction is simply the negative of the */ -/* observer's position relative to the target center. */ - - vminug_(fxosta, &c__6, raysta); - surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, & - found); - -/* Although in general it's not an error for SURFPV to be */ -/* unable to compute an intercept state, it *is* an error */ -/* in this case, since the ray points toward the center of */ -/* the target. */ - - if (! found) { - setmsg_("The sub-observer state could could not be compu" - "ted because the velocity was not well defined. S" - "URFPV returned \"not found.\"", (ftnlen)122); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - } - -/* At this point we can update the surface point */ -/* velocity and light time derivative estimates. */ - -/* In order to compute the light time rate, we'll */ -/* need the J2000-relative velocity of the sub-observer */ -/* point with respect to the observer. First convert */ -/* the sub-observer state to the J2000 frame, then */ -/* add the result to the state of the target center */ -/* with respect to the observer. */ - - mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta); - vaddg_(obstrg, pntsta, &c__6, obspnt); - -/* Now that we have an improved estimate of the */ -/* sub-observer state, we can estimate the rate of */ -/* change of light time as */ - -/* range rate */ -/* ---------- */ -/* c */ - - -/* If we're correcting for stellar aberration, *ideally* we */ -/* should remove that correction now, since the light time */ -/* rate is based on light time between the observer and the */ -/* light-time corrected sub-observer point. But the error made */ -/* by including stellar aberration is too small to make it */ -/* worthwhile to make this adjustment. */ - - vhat_(obspnt, upos); - dlt = vdot_(&obspnt[3], upos) / clight_(); - -/* With FXPVEL and DLT updated, we'll repeat our */ -/* computations. */ - - } - } else { - -/* We should never get here. */ - - setmsg_("Aberration correction # was not recognized.", (ftnlen)43); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; - } - -/* Copy the computed state to the output argument STATE. */ - - moved_(fxpsta, &c__6, state); - chkout_("ZZGFSSOB", (ftnlen)8); - return 0; -} /* zzgfssob_ */ - diff --git a/ext/spice/src/cspice/zzgftreb.c b/ext/spice/src/cspice/zzgftreb.c deleted file mode 100644 index 1568cd981a..0000000000 --- a/ext/spice/src/cspice/zzgftreb.c +++ /dev/null @@ -1,208 +0,0 @@ -/* zzgftreb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure ZZGFTREB ( Geometry finder: return body axes ) */ -/* Subroutine */ int zzgftreb_(integer *body, doublereal *axes) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, n; - extern /* Subroutine */ int chkin_(char *, ftnlen), bodvcd_(integer *, - char *, integer *, integer *, doublereal *, ftnlen), sigerr_(char - *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the values of the triaxial radii for any body in the */ -/* kernel pool. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* CONSTANTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BODY I NAIF ID code of body. */ -/* AXES O Length of axes of body (1,2,3, as defined below). */ - -/* $ Detailed_Input */ - -/* BODY is the NAIF ID code of the body for which the axes are */ -/* requested. Bodies are numbered according to the */ -/* standard NAIF numbering scheme described in the */ -/* required reading (naif_ids.req) document. */ - -/* $ Detailed_Output */ - -/* AXES are the lengths of the axes of the body, in km. */ - -/* AXES(1) is the longest equatorial radius of */ -/* the body. For satellites, this axis is */ -/* typically pointed toward the primary */ -/* planet. */ - -/* AXES(2) is the shortest equatorial radius of */ -/* the body. */ - -/* AXES(3) is the polar radius of the body. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the body specified does not have 3 axes defined, */ -/* then the error SPICE(ZEROAXISLENGTH) is signaled. */ - -/* $ Files */ - -/* PCK data: triaxial radii for the target body must be loaded */ -/* into the kernel pool. Typically this is done by loading a */ -/* text PCK file via LDPOOL or a general kernel loader */ -/* such as FURNSH. */ - -/* $ Particulars */ - -/* ZZGFTREB returns the lengths of the axes of the target body. */ -/* Appropriate SPK and PCK data must be available to the calling */ -/* program before this routine is called. */ - -/* $ Examples */ - -/* The call */ - -/* CALL ZZGFTREB ( 399, VALUE ) */ - -/* returns the values associated with the variable 'BODY399_RADII', */ -/* for example, */ - -/* VALUE(1) = 6378.140 */ -/* VALUE(2) = 6378.140 */ -/* VALUE(3) = 6356.755 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1) Refer to the SPK required reading file for a complete list of */ -/* the NAIF integer ID codes for bodies. */ - -/* 2) ''Report of the IAU/IAG/COSPAR Working Group on Cartographic */ -/* Coordinates and Rotational Elements of the Planets and */ -/* Satellites: 1991,'' March 3, 1992. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* - SPICELIB version 1.0.0 05-MAR-2003 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* Return the values of the triaxial radii */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGFTREB", (ftnlen)8); - } - -/* Look it up in the kernel pool. */ - - bodvcd_(body, "RADII", &c__3, &n, axes, (ftnlen)5); - if (n != 3) { - setmsg_("Only # axes were found for ID # . Three axes are needed.", ( - ftnlen)57); - errint_("#", &n, (ftnlen)1); - errint_("#", body, (ftnlen)1); - sigerr_("SPICE(ZEROAXISLENGTH)", (ftnlen)21); - chkout_("ZZGFTREB", (ftnlen)8); - return 0; - } else { - for (i__ = 1; i__ <= 3; ++i__) { - if (axes[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("axes", - i__1, "zzgftreb_", (ftnlen)185)] < 0.) { - setmsg_("The # axis of body # is negative. Please check you" - "r text PCK file. You should fix the # component of " - "the kernel pool variable BODY#_RADII. ", (ftnlen)142) - ; - errint_("#", &i__, (ftnlen)1); - errint_("#", body, (ftnlen)1); - errint_("#", &i__, (ftnlen)1); - errint_("#", body, (ftnlen)1); - sigerr_("SPICE(BADAXISNUMBERS)", (ftnlen)21); - chkout_("ZZGFTREB", (ftnlen)8); - return 0; - } - } - } - chkout_("ZZGFTREB", (ftnlen)8); - return 0; -} /* zzgftreb_ */ - diff --git a/ext/spice/src/cspice/zzgfudlt.c b/ext/spice/src/cspice/zzgfudlt.c deleted file mode 100644 index 2a13ab926e..0000000000 --- a/ext/spice/src/cspice/zzgfudlt.c +++ /dev/null @@ -1,174 +0,0 @@ -/* zzgfudlt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGFUDLT ( Private --- GF, scalar function < ref value ) */ -/* Subroutine */ int zzgfudlt_(S_fp udfunc, doublereal *et, logical *isless) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal udval; - extern logical failed_(void); - doublereal refval; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int zzholdd_(char *, doublereal *, ftnlen); - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* This routine determines if the value of the scalar quantity */ -/* function is less than a previously defined reference value. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UDFUNC I Name of the routine that computes the scalar value */ -/* of interest. */ -/* ET I Time in TDB seconds for which to evaluate UDFUNC. */ -/* ISLESS O Boolean indicating if the scalar value is less than */ -/* reference value. */ - -/* $ Detailed_Input */ - -/* UDFUNC the routine that returns the value of the scalar */ -/* quantity of interest at time ET. The calling sequence */ -/* for UDFUNC is: */ - -/* CALL UDFUNC ( ET, VALUE ) */ - -/* where: */ - -/* ET a double precision value representing */ -/* ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which to determine the scalar */ -/* value. */ - -/* VALUE is the value of the geometric quantity */ -/* at ET. */ - -/* ET a double precision value representing ephemeris time, */ -/* expressed as seconds past J2000 TDB at which to */ -/* determine the value of UDFUNC. */ - -/* $ Detailed_Output */ - -/* ISLESS a scalar boolean indicating if the value of UDFUNC at */ -/* ET is less than REFVAL (true) or not (false). */ - -/* Functionally: */ - -/* ISLESS = UDFUNC( ET ) < REFVAL */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) ZZHOLDD will signal the error SPICE(ZZHOLDNOPUT) if this */ -/* routine is called prior to storing a reference value */ -/* using a ZZHOLDD "PUT" operation. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A ZZHOLDD "PUT" stored the reference value used in the logical */ -/* operation. A ZZHOLDD "GET" retrieves the value. */ - -/* $ Examples */ - -/* See GFUDS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-FEB-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* function less than reference value */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - if (return_()) { - return 0; - } - chkin_("ZZGFUDLT", (ftnlen)8); - *isless = FALSE_; - (*udfunc)(et, &udval); - if (failed_()) { - chkout_("ZZGFUDLT", (ftnlen)8); - return 0; - } - -/* Retrieve the reference value. */ - - zzholdd_("GET", &refval, (ftnlen)3); - *isless = udval < refval; - chkout_("ZZGFUDLT", (ftnlen)8); - return 0; -} /* zzgfudlt_ */ - diff --git a/ext/spice/src/cspice/zzgfwsts.c b/ext/spice/src/cspice/zzgfwsts.c deleted file mode 100644 index a706cadfdf..0000000000 --- a/ext/spice/src/cspice/zzgfwsts.c +++ /dev/null @@ -1,330 +0,0 @@ -/* zzgfwsts.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure ZZGFWSTS ( GF window -- Sift the first */ -/* through the second ) */ -/* Subroutine */ int zzgfwsts_(doublereal *wndw1, doublereal *wndw2, char * - inclsn, doublereal *wndw3, ftnlen inclsn_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical keep, left, open; - integer begp1, begp2, begp3, endp1, endp2, endp3, size1, size2; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical right; - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - char locinc[2]; - logical closed; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssized_(integer *, doublereal *), setmsg_(char *, ftnlen) - , errint_(char *, integer *, ftnlen), cmprss_(char *, integer *, - char *, char *, ftnlen, ftnlen, ftnlen); - integer maxpts, ovflow; - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine those intervals of the first window that are */ -/* properly contained in an interval of the second. */ - -/* $ 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 */ - -/* INTERVALS, WINDOWS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* WNDW1 I Input window 1. */ -/* WNDW2 I Input window 2. */ -/* INCLSN I Flag indicating inclusion desired. */ -/* WNDW3 I/O Result of sifting WNDW1 through WNDW2. */ - -/* $ Detailed_Input */ - -/* WNDW1 is an initialized SPICELIB window */ - -/* WNDW2 is an initialized SPICELIB window */ - -/* INCLSN is a string indicating how intervals of WNDW1 must */ -/* be contained in WNDW2. Allowed values are: '[]', '(]', */ -/* '[)', and '()', where a square bracket represents a */ -/* closed interval and a curved bracket an open interval. */ -/* Suppose that [a,b] is an interval of WNDW1 and that */ -/* [c,d] is an interval of WNDW2. Then the table below */ -/* shows the tests used to determine the inclusion of */ -/* [a,b] in the interval from c to d. */ - -/* [] --- [a,b] is contained in [c,d] */ -/* (] --- [a,b] is contained in (c,d] */ -/* [) --- [a,b] is contained in [c,d) */ -/* () --- [a,b] is contained in (c,d) */ - -/* if INCLSN is not one of these four values, the */ -/* error SPICE(UNKNOWNINCLUSION) is signaled. */ - - - -/* WNDW3 is an initialized SPICELIB window, used on input */ -/* only for the purpose of determining the amount */ -/* of space declared for use in WNDW3. */ - -/* $ Detailed_Output */ - -/* WNDW3 is a window consisting those of intervals in WNDW1 */ -/* that are wholly contained in some interval of WNDW2. */ - -/* $ Parameters */ - -/* LBCELL is the SPICELIB cell lower bound. */ - -/* $ Exceptions */ - -/* 1) If the window WNDW3 does not have sufficient space to */ -/* contain the sifting of WNDW1 through WNDW2 the error */ -/* 'SPICE(OUTOFROOM)' is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows the user to specify two closed subsets of the */ -/* real line and to find the intervals of one that are contained */ -/* within the intervals of another. The subsets of the real line */ -/* are assumed to be made up of disjoint unions of closed intervals. */ - -/* $ Examples */ - -/* Suppose that WNDW1 and WNDW2 are described by the tables below. */ - -/* WNDW1 WNDW2 */ -/* 12.3 12.8 11.7 13.5 */ -/* 17.8 20.4 17.2 18.3 */ -/* 21.4 21.7 18.5 22.6 */ -/* 38.2 39.8 40.1 45.6 */ -/* 44.0 59.9 */ - -/* Then WNDW3 will be given by: */ - -/* WNDW3 */ -/* 12.3 12.8 */ -/* 21.4 21.7 */ - -/* $ Restrictions */ - -/* The set WNDW3 must not overwrite WNDW1 or WNDW2. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ -/* L.S. Elson (JPL) */ - -/* $ Version */ - -/* SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) (LSE) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find intervals of a window contained in an interval of another */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGFWSTS", (ftnlen)8); - -/* Store the maximum number of endpoints that can be loaded into */ -/* WNDW3 */ - - maxpts = sized_(wndw3); - ssized_(&maxpts, wndw3); - -/* Find the number of endpoints in each of the input windows. */ - - size1 = cardd_(wndw1); - size2 = cardd_(wndw2); - -/* Initialize the place holders for each of the input windows. */ - - begp1 = 1; - begp2 = 1; - endp1 = 2; - endp2 = 2; - begp3 = -1; - endp3 = 0; - cmprss_(" ", &c__0, inclsn, locinc, (ftnlen)1, inclsn_len, (ftnlen)2); - open = s_cmp(locinc, "()", (ftnlen)2, (ftnlen)2) == 0; - left = s_cmp(locinc, "[)", (ftnlen)2, (ftnlen)2) == 0; - right = s_cmp(locinc, "(]", (ftnlen)2, (ftnlen)2) == 0; - closed = s_cmp(locinc, "[]", (ftnlen)2, (ftnlen)2) == 0; - if (! (open || left || right || closed)) { - setmsg_("The value of the inclusion flag must be one of the followin" - "g: '[]', '[)', '(]', or '()'. However the value supplied wa" - "s '#'. ", (ftnlen)126); - errch_("#", inclsn, (ftnlen)1, inclsn_len); - sigerr_("SPICE(UNKNOWNINCLUSION)", (ftnlen)23); - chkout_("ZZGFWSTS", (ftnlen)8); - return 0; - } - -/* We haven't had a chance to overflow yet. */ - - ovflow = 0; - while(begp1 < size1 && begp2 < size2) { - -/* Using the current interval endpoints determine the overlap of */ -/* the two intervals. */ - - if (wndw1[endp1 + 5] < wndw2[begp2 + 5]) { - -/* the end of the first interval precedes the beginning of the */ -/* second */ - - begp1 += 2; - endp1 += 2; - } else if (wndw2[endp2 + 5] < wndw1[begp1 + 5]) { - -/* the end of the second interval precedes the beginning of the */ -/* first */ - - begp2 += 2; - endp2 += 2; - } else { - -/* the intervals intersect. Is the first contained in the */ -/* second? */ - - if (closed) { - keep = wndw1[begp1 + 5] >= wndw2[begp2 + 5] && wndw1[endp1 + - 5] <= wndw2[endp2 + 5]; - } else if (open) { - keep = wndw1[begp1 + 5] > wndw2[begp2 + 5] && wndw1[endp1 + 5] - < wndw2[endp2 + 5]; - } else if (left) { - keep = wndw1[begp1 + 5] >= wndw2[begp2 + 5] && wndw1[endp1 + - 5] < wndw2[endp2 + 5]; - } else if (right) { - keep = wndw1[begp1 + 5] > wndw2[begp2 + 5] && wndw1[endp1 + 5] - <= wndw2[endp2 + 5]; - } - if (keep) { - begp3 += 2; - endp3 += 2; - if (begp3 < maxpts) { - -/* Adequate room is left in WNDW3 to include this */ -/* interval */ - - wndw3[begp3 + 5] = wndw1[begp1 + 5]; - wndw3[endp3 + 5] = wndw1[endp1 + 5]; - } else { - ovflow += 2; - } - } - -/* Determine which window pointers to increment */ - - if (wndw1[endp1 + 5] < wndw2[endp2 + 5]) { - -/* The first interval lies before the end of the second */ - - begp1 += 2; - endp1 += 2; - } else if (wndw2[endp2 + 5] < wndw1[endp1 + 5]) { - -/* The second interval lies before the end of the first */ - - begp2 += 2; - endp2 += 2; - } else { - -/* The first and second intervals end at the same place */ - - begp1 += 2; - endp1 += 2; - begp2 += 2; - endp2 += 2; - } - } - } - if (ovflow > 0) { - setmsg_("The output schedule does not have sufficient memory to cont" - "ain the result of sifting the two given schedules. The outpu" - "t schedule requires space for # more values than what has be" - "en provided. ", (ftnlen)192); - errint_("#", &ovflow, (ftnlen)1); - sigerr_("SPICE(OUTOFROOM)", (ftnlen)16); - } else { - scardd_(&endp3, wndw3); - } - chkout_("ZZGFWSTS", (ftnlen)8); - return 0; -} /* zzgfwsts_ */ - diff --git a/ext/spice/src/cspice/zzgpnm.c b/ext/spice/src/cspice/zzgpnm.c deleted file mode 100644 index c608353737..0000000000 --- a/ext/spice/src/cspice/zzgpnm.c +++ /dev/null @@ -1,262 +0,0 @@ -/* zzgpnm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGPNM ( Get position of a name ) */ -/* Subroutine */ int zzgpnm_(integer *namlst, integer *nmpool, char *names, - integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, - char *chvals, char *varnam, logical *found, integer *lookat, integer - *nameat, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer head, node, tail; - logical full; - extern /* Subroutine */ int chkin_(char *, ftnlen), lnkan_(integer *, - integer *), lnkila_(integer *, integer *, integer *); - extern integer lnknfn_(integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern integer zzhash_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Locate the node in the array NAMES where a variable is located */ -/* or will be inserted. */ - -/* $ 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 */ - -/* PRIVATE KERNEL */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAMLST I/O array of collision resolution list heads */ -/* NMPOOL I/O linked list pool of collision resolution lists */ -/* NAMES I/O array of names of kernel pool variables */ -/* DATLST I/O array of heads of lists of variable values */ -/* DPPOOL I/O linked list pool of pointer lists to d.p. values */ -/* DPVALS I/O array of d.p. kernel pool values */ -/* CHPOOL I/O linked list pool of pointer lists to string values */ -/* CHVALS I/O array of string kernel pool values */ -/* VARNAM I A name to find/put into the kernel pool name list. */ -/* FOUND O TRUE if VARNAM is already in the list of names */ -/* LOOKAT O The value ZZHASH(VARNAM). */ -/* NAMEAT O The location where VARNAM is to be located. */ - -/* $ Detailed_Input */ - -/* NAMLST this collection of arrays together with the hash */ -/* NMPOOL function ZZHASH provide the mechanism for storing */ -/* NAMES and retrieving kernel pool variables. */ -/* DATLST */ -/* DPPOOL Given a potential variable name NAME the function */ -/* DPVALS ZZHASH(NAME) gives the location in the array in */ -/* CHPOOL NAMLST where one should begin looking for the */ -/* CHVALS kernel pool variable NAME. */ -/* If NAMLST( ZZHASH(NAME) ) is zero, there is no kernel */ -/* pool variable corresponding to NAME. If it is non-zero */ -/* then NAMLST is the head node of a linked list of names */ -/* that evaluate to the same integer under the function */ -/* ZZHASH. Letting NODE = NAMLST( ZZHASH(NAME) ) check */ -/* NAMES(NODE) for equality with NAME. If there is */ -/* no match find the next node ( NMPOOL(NEXT,NODE) ) until */ -/* a match occurs or all nodes of the list have been */ -/* examined. To insert a new NAME allocate a node NEW from */ -/* the free list of NMPOOL and append it to the tail of the */ -/* list pointed to by NAMLST ( ZZHASH(NAME) ). */ - -/* Once a node for NAME is located (call it NAMEAT) */ -/* the values for NAME can be found by examining */ -/* DATLST(NAMEAT). If zero, no values have yet been */ -/* given to NAME. If less than zero, -DATLST(NAMEAT) */ -/* is the head node of a list in CHPOOL that gives the */ -/* indexes of the values of NAME in CHVALS. If greater */ -/* than zero, DATLST(NAMEAT) is the head node of a list */ -/* in DPPOOL that gives the indexes of the values of NAME */ -/* in DPVALS. */ - -/* VARNAM is the name of a variable that is either already present */ -/* or that should be placed in the kernel pool */ -/* $ Detailed_Output */ - -/* NAMLST is the same structure as input but updated to */ -/* NMPOOL include the new variable specified by VARNAM if */ -/* NAMES it is a new name. */ -/* DATLST */ -/* DPPOOL */ -/* DPVALS */ -/* CHPOOL */ -/* CHVALS */ - -/* FOUND is TRUE if VARNAM was already present in the name list. */ - -/* LOOKAT is the location in NAMLST where the head of the */ -/* ZZHASH collision linked list is stored. */ - -/* NAMEAT is the location within the array NAMES where VARNAM */ -/* is located. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the NAMES array cannot accomodate any more kernel variable */ -/* names, the error 'SPICE(KERNELPOOLFULL)' is signalled. */ - -/* $ Particulars */ - -/* This is a utility routine designed to assist the kernel pool */ -/* entry points PDPOOL, PCPOOL and PIPOOL. It handles the task */ -/* of inserting a new variable name into the kernel pool name */ -/* structure and returns information on the location of that */ -/* name. */ - -/* $ Examples */ - -/* See the entry points PDPOOL, PCPOOL or PIPOOL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 29-MAR-1999 (WLT) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZGPNM", (ftnlen)6); - *nameat = 0; - - -/* Locate this variable name in the name pool or insert it */ -/* if it isn't there. The location will be NAMEAT and */ -/* we will use the variable FOUND to indicate whether or */ -/* not it was already present. */ - - *lookat = zzhash_(varnam, varnam_len); - node = namlst[*lookat - 1]; - full = lnknfn_(nmpool) <= 0; - *found = FALSE_; - -/* See if this name (or one colliding with it in the */ -/* hash scheme) has already been stored in the name list. */ - - if (node > 0) { - head = node; - tail = -nmpool[(head << 1) + 11]; - while(node > 0 && ! (*found)) { - *found = s_cmp(names + (node - 1) * names_len, varnam, names_len, - varnam_len) == 0; - *nameat = node; - node = nmpool[(node << 1) + 10]; - } - if (! (*found) && ! full) { - -/* We didn't find this name on the conflict resolution */ -/* list. Allocate a new slot for it. */ - - lnkan_(nmpool, &node); - lnkila_(&tail, &node, nmpool); - s_copy(names + (node - 1) * names_len, varnam, names_len, - varnam_len); - *nameat = node; - } - } else if (! full) { - -/* Nothing like this variable name (in the hashing sense) */ -/* has been loaded so far. We need to allocate */ -/* a name slot for this variable. */ - - lnkan_(nmpool, &node); - namlst[*lookat - 1] = node; - s_copy(names + (node - 1) * names_len, varnam, names_len, varnam_len); - *nameat = node; - } - -/* If the name pool was full and we didn't find this name */ -/* we've got an error. Diagnose it and return. */ - - if (full && ! (*found)) { - setmsg_("The kernel pool does not have room for any more variables.", - (ftnlen)58); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZGPNM", (ftnlen)6); - return 0; - } - chkout_("ZZGPNM", (ftnlen)6); - return 0; -} /* zzgpnm_ */ - diff --git a/ext/spice/src/cspice/zzholdd.c b/ext/spice/src/cspice/zzholdd.c deleted file mode 100644 index 59003cd9ee..0000000000 --- a/ext/spice/src/cspice/zzholdd.c +++ /dev/null @@ -1,242 +0,0 @@ -/* zzholdd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZHOLDD ( Private --- hold a scalar DP ) */ -/* Subroutine */ int zzholdd_(char *op, doublereal *value, ftnlen op_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - static doublereal s_value__; - -/* $ Abstract */ - -/* SPICE private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Persistently store a double precision value or retrieve a */ -/* stored double precision value. */ - -/* $ 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 */ - -/* STORE_VALUE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* OP I String name of operation to execute */ -/* VALUE I-O Double precision value returned or to store */ - -/* $ Detailed_Input */ - -/* OP The scalar string name of the operation to execute. */ -/* Proper values of OP: */ - -/* 'PUT' store a double precision value for later */ -/* use */ - -/* 'GET' retrieve a stored double precision value */ - -/* 'RESET' reset function to require a PUT prior */ -/* to a subsequent GET. */ - -/* VALUE The scalar double precision value to store; */ -/* corresponding to a 'PUT' OP. */ - -/* $ Detailed_Output */ - -/* VALUE The scalar double precision value returned; */ -/* corresponding to a 'GET' OP. The value is that stored */ -/* by the previous 'PUT' operation. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(ZZHOLDNOPUT) signals if a 'GET' operation */ -/* precedes any 'PUT' operation. */ - -/* 2) The error SPICE(UNKNOWNOP) signals if the value of OP is */ -/* neither 'GET', 'PUT', or 'RESET'. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine simply stores a double precision value for */ -/* later retrieval. The value stored persists in memory until */ -/* overwritten by a subsequent 'PUT' operation. */ - -/* $ Examples */ - -/* The numerical results shown for these examples may differ across */ -/* platforms. The results depend on the SPICE kernels used as */ -/* input, the compiler and supporting libraries, and the machine */ -/* specific arithmetic implementation. */ - -/* Store values using ZZHOLDD then attempt to retrieve the values. */ - -/* PROGRAM ZZHOLDD_T */ - -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION VAL */ - -/* C */ -/* C Set a default value for VAL. */ -/* C */ -/* VAL = 0.D0 */ - -/* C */ -/* C Store 941.0 in ZZHOLDD. */ -/* C */ -/* CALL ZZHOLDD ( 'PUT', 941.D0 ) */ - -/* C */ -/* C Retrieve 941.0 to VAL. */ -/* C */ -/* CALL ZZHOLDD ( 'GET', VAL ) */ - -/* C */ -/* C Output VAL. It should have value 941.0. */ -/* C */ -/* WRITE (*,*) VAL */ - - -/* C */ -/* C Another 'PUT' 'GET' cycle. */ -/* C */ -/* CALL ZZHOLDD ( 'PUT', 830.D0 ) */ - -/* C */ -/* C Output VAL. It should have value 830.0. */ -/* C */ -/* CALL ZZHOLDD ( 'GET', VAL ) */ - -/* WRITE (*,*) VAL */ - - -/* END */ - -/* The program outputs (OS X Intel run): */ - -/* 941. */ -/* 830. */ - -/* As expected. */ - -/* $ Restrictions */ - -/* Code logic enforces the requirement at least one 'PUT' operation */ -/* occurs before a 'GET'. You can't 'GET' until at least one 'PUT'. */ -/* 'RESET' returns the routine to the state requiring a 'PUT'. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 16-FEB-2010 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* store a double precision value */ -/* retrieve a stored double precision value */ - -/* -& */ - if (eqstr_(op, "GET", op_len, (ftnlen)3)) { - -/* Retrieve a stored double precision value. Signal */ -/* an error if a "GET" call occurs prior to a "PUT." */ - - if (first) { - chkin_("ZZHOLDD", (ftnlen)7); - setmsg_("ZZHOLDD GET called without PUT initialization. Either t" - "he first GET call of program run or first GET call after" - " RESET.", (ftnlen)118); - sigerr_("SPICE(ZZHOLDNOPUT) ", (ftnlen)19); - chkout_("ZZHOLDD", (ftnlen)7); - return 0; - } - *value = s_value__; - } else if (eqstr_(op, "PUT", op_len, (ftnlen)3)) { - -/* Store a value for later use. Set FIRST to false */ -/* so subsequent "GET" calls will work. */ - - if (first) { - first = FALSE_; - } - s_value__ = *value; - } else if (eqstr_(op, "RESET", op_len, (ftnlen)5)) { - -/* Reset FIRST forcing a PUT before an further GET. */ - - first = TRUE_; - } else { - -/* 'OP' not "PUT," "RESET" or "GET." Signal an error. */ - - chkin_("ZZHOLDD", (ftnlen)7); - setmsg_("Unknown operation '#'. Routine supports only GET, PUT and R" - "ESET.", (ftnlen)64); - errch_("#", op, (ftnlen)1, op_len); - sigerr_("SPICE(UNKNOWNOP)", (ftnlen)16); - chkout_("ZZHOLDD", (ftnlen)7); - return 0; - } - return 0; -} /* zzholdd_ */ - diff --git a/ext/spice/src/cspice/zzhullax.c b/ext/spice/src/cspice/zzhullax.c deleted file mode 100644 index 3df9c30d26..0000000000 --- a/ext/spice/src/cspice/zzhullax.c +++ /dev/null @@ -1,772 +0,0 @@ -/* zzhullax.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b20 = -1.; -static doublereal c_b36 = .5; - -/* $Procedure ZZHULLAX ( Pyramidal FOV convex hull to FOV axis ) */ -/* Subroutine */ int zzhullax_(char *inst, integer *n, doublereal *bounds, - doublereal *axis, ftnlen inst_len) -{ - /* System generated locals */ - integer bounds_dim2, i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal xvec[3], yvec[3], zvec[3]; - integer xidx; - extern doublereal vsep_(doublereal *, doublereal *); - integer next; - logical pass1; - integer i__, m; - doublereal r__, v[3], delta; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vlcom_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - integer minix, maxix; - doublereal trans[9] /* was [3][3] */; - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *), vcrss_(doublereal *, doublereal *, doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal - *, doublereal *); - doublereal cp[3]; - extern doublereal pi_(void); - logical ok; - extern doublereal halfpi_(void); - extern /* Subroutine */ int reclat_(doublereal *, doublereal *, - doublereal *, doublereal *), sigerr_(char *, ftnlen); - doublereal minlon; - extern /* Subroutine */ int chkout_(char *, ftnlen); - doublereal maxlon; - extern /* Subroutine */ int vhatip_(doublereal *), vsclip_(doublereal *, - doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal lat, sep, lon; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - doublereal ray1[3], ray2[3]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Identify a face of the convex hull of an instrument's */ -/* polygonal FOV, and use this face to generate an axis of the */ -/* FOV. */ - -/* $ 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 */ - -/* CK */ -/* FRAMES */ -/* GF */ -/* IK */ -/* KERNEL */ - -/* $ Keywords */ - -/* FOV */ -/* GEOMETRY */ -/* INSTRUMENT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARGIN P Minimum complement of FOV cone angle. */ -/* INST I Instrument name. */ -/* N I Number of FOV boundary vectors. */ -/* BOUNDS I FOV boundary vectors. */ -/* AXIS O Instrument FOV axis vector. */ - -/* $ Detailed_Input */ - -/* INST is the name of an instrument with which the field of */ -/* view (FOV) of interest is associated. This name is */ -/* used only to generate long error messages. */ - -/* N is the number of boundary vectors in the array */ -/* BOUNDS. */ - -/* BOUNDS is an array of N vectors emanating from a common */ -/* vertex and defining the edges of a pyramidal region in */ -/* three-dimensional space: this the region within the */ -/* FOV of the instrument designated by INST. The Ith */ -/* vector of BOUNDS resides in elements (1:3,I) of this */ -/* array. */ - -/* The vectors contained in BOUNDS are called the */ -/* "boundary vectors" of the FOV. */ - -/* The boundary vectors must satisfy the constraints: */ - -/* 1) The boundary vectors must be contained within */ -/* a right circular cone of angular radius less */ -/* than than (pi/2) - MARGIN radians; in other */ -/* words, there must be a vector A such that all */ -/* boundary vectors have angular separation from */ -/* A of less than (pi/2)-MARGIN radians. */ - -/* 2) There must be a pair of vectors U, V in BOUNDS */ -/* such that all other boundary vectors lie in */ -/* the same half space bounded by the plane */ -/* containing U and V. Furthermore, all other */ -/* boundary vectors must have orthogonal */ -/* projections onto a plane normal to this plane */ -/* such that the projections have angular */ -/* separation of at least 2*MARGIN radians from */ -/* the plane spanned by U and V. */ - -/* Given the first constraint above, there is plane PL */ -/* such that each of the set of rays extending the */ -/* boundary vectors intersects PL. (In fact, there is an */ -/* infinite set of such planes.) The boundary vectors */ -/* must be ordered so that the set of line segments */ -/* connecting the intercept on PL of the ray extending */ -/* the Ith vector to that of the (I+1)st, with the Nth */ -/* intercept connected to the first, form a polygon (the */ -/* "FOV polygon") constituting the intersection of the */ -/* FOV pyramid with PL. This polygon may wrap in either */ -/* the positive or negative sense about a ray emanating */ -/* from the FOV vertex and passing through the plane */ -/* region bounded by the FOV polygon. */ - -/* The FOV polygon need not be convex; it may be */ -/* self-intersecting as well. */ - -/* No pair of consecutive vectors in BOUNDS may be */ -/* linearly dependent. */ - -/* The boundary vectors need not have unit length. */ - - -/* $ Detailed_Output */ - -/* AXIS is a unit vector normal to a plane containing the */ -/* FOV polygon. All boundary vectors have angular */ -/* separation from AXIS of not more than */ - -/* ( pi/2 ) - MARGIN */ - -/* radians. */ - -/* This routine signals an error if it cannot find */ -/* a satisfactory value of AXIS. */ - -/* $ Parameters */ - -/* MARGIN is a small positive number used to constrain the */ -/* orientation of the boundary vectors. See the two */ -/* constraints described in the Detailed_Input section */ -/* above for specifics. */ - -/* $ Exceptions */ - -/* 1) In the input vector count N is not at least 3, the error */ -/* SPICE(INVALIDCOUNT) is signaled. */ - -/* 2) If any pair of consecutive boundary vectors has cross */ -/* product zero, the error SPICE(DEGENERATECASE) is signaled. */ -/* For this test, the first vector is considered the successor */ -/* of the Nth. */ - -/* 3) If this routine can't find a face of the convex hull of */ -/* the set of boundary vectors such that this face satisfies */ -/* constraint (2) of the Detailed_Input section above, the */ -/* error SPICE(FACENOTFOUND) is signaled. */ - -/* 4) If any boundary vectors have longitude too close to 0 */ -/* or too close to pi radians in the face frame (see discussion */ -/* of the search algorithm's steps 3 and 4 in Particulars */ -/* below), the respective errors SPICE(NOTSUPPORTED) or */ -/* SPICE(FOVTOOWIDE) are signaled. */ - -/* 5) If any boundary vectors have angular separation of more than */ -/* (pi/2)-MARGIN radians from the candidate FOV axis, the */ -/* error SPICE(FOVTOOWIDE) is signaled. */ - -/* $ Files */ - -/* The boundary vectors input to this routine are typically */ -/* obtained from an IK file. */ - -/* $ Particulars */ - -/* Normally implementation is not discussed in SPICE headers, but we */ -/* make an exception here because this routine's implementation and */ -/* specification are deeply intertwined. */ - -/* This routine produces an "axis" for a polygonal FOV using the */ -/* following approach: */ - -/* 1) Test pairs of consecutive FOV boundary vectors to see */ -/* whether there's a pair such that the plane region bounded */ -/* by these vectors is */ - -/* a) part of the convex hull of the set of boundary vectors */ - -/* b) such that all other boundary vectors have angular */ -/* separation of at least MARGIN from the plane */ -/* containing these vectors */ - -/* This search has O(N**2) run time dependency on N. */ - -/* If this test produces a candidate face of the convex hull, */ -/* proceed to step 3. */ - - -/* 2) If step (1) fails, repeat the search for a candidate */ -/* convex hull face, but this time search over every pair of */ -/* distinct boundary vectors. */ - -/* This search has O(N**3) run time dependency on N. */ - -/* If this search fails, signal an error. */ - - -/* 3) Produce a set of basis vectors for a reference frame, */ -/* which we'll call the "face frame," using as the +X axis */ -/* the angle bisector of the vectors bounding the candidate */ -/* face, the +Y axis the inward normal vector to this face, */ -/* and the +Z axis completing a right-handed basis. */ - - -/* 4) Transform each boundary vector, other than the two vectors */ -/* defining the selected convex hull face, to the face frame */ -/* and compute the vector's longitude in that frame. Find the */ -/* maximum and minimum longitudes of the vectors in the face */ -/* frame. */ - -/* If any vector's longitude is less than 2*MARGIN or greater */ -/* than pi - 2*MARGIN radians, signal an error. */ - - -/* 5) Let DELTA be the difference between pi and the maximum */ -/* longitude found in step (4). Rotate the +Y axis (which */ -/* points in the inward normal direction relative to the */ -/* selected face) by -DELTA/2 radians about the +Z axis of */ -/* the face frame. This rotation aligns the +Y axis with the */ -/* central longitude of the set of boundary vectors. The */ -/* resulting vector is our candidate FOV axis. */ - - -/* 6) Check the angular separation of the candidate FOV axis */ -/* against each boundary vector. If any vector has angular */ -/* separation of more than (pi/2)-MARGIN radians from the */ -/* axis, signal an error. */ - - -/* Note that there are reasonable FOVs that cannot be handled by the */ -/* algorithm described here. For example, any FOV whose cross */ -/* section is a regular convex polygon can be made unusable by */ -/* adding boundary vectors aligned with the angle bisectors of each */ -/* face of the pyramid defined by the FOV's boundary vectors. The */ -/* resulting set of boundary vectors has no face in its convex hull */ -/* such that all other boundary vectors have positive angular */ -/* separation from that face. */ - -/* Because of this limitation, this algorithm should be used only */ -/* after a simple FOV axis-finding approach, such as using as the */ -/* FOV axis the average of the boundary vectors, has been tried */ -/* unsuccessfully. */ - -/* Note that it's easy to construct FOVs where the average of the */ -/* boundary vectors doesn't yield a viable axis: a FOV of angular */ -/* width nearly equal to pi radians, with a sufficiently large */ -/* number of boundary vectors on one side and few boundary vectors */ -/* on the other, is one such example. This routine can find an */ -/* axis for many such intractable FOVs---that's why this routine */ -/* should be called after the simple approach fails. */ - -/* $ Examples */ - -/* See SPICELIB private routine ZZFOVAXI. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine. User applications should not */ -/* call this routine. */ - -/* 2) There are "reasonable" polygonal FOVs that cannot be handled */ -/* by this routine. See the discussion in Particulars above. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.0.0, 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Create axis vector for polygonal FOV */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - /* Parameter adjustments */ - bounds_dim2 = *n; - - /* Function Body */ - if (return_()) { - return 0; - } - chkin_("ZZHULLAX", (ftnlen)8); - -/* Nothing found yet. */ - - found = FALSE_; - xidx = 0; - -/* We must have at least 3 boundary vectors. */ - - if (*n < 3) { - setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb" - "er supplied for # was #.", (ftnlen)83); - errch_("#", inst, (ftnlen)1, inst_len); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); - chkout_("ZZHULLAX", (ftnlen)8); - return 0; - } - -/* Find an exterior face of the pyramid defined by the */ -/* input boundary vectors. Since most polygonal FOVs will have */ -/* an exterior face bounded by two consecutive rays, we'll */ -/* try pairs of consecutive rays first. If this fails, we'll */ -/* try each pair of rays. */ - - i__ = 1; - while(i__ <= *n && ! found) { - -/* Set the index of the next ray. When we get to the */ -/* last boundary vector, the next ray is the first. */ - - if (i__ == *n) { - next = 1; - } else { - next = i__ + 1; - } - -/* Find the cross product of the first ray with the */ -/* second. Depending on the ordering of the boundary */ -/* vectors, this could be an inward or outward normal, */ -/* in the case the current face is exterior. */ - - vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? - i__1 : s_rnge("bounds", i__1, "zzhullax_", (ftnlen)408)], & - bounds[(i__2 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ? - i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)408)], cp); - -/* We insist on consecutive boundary vectors being */ -/* linearly independent. */ - - if (vzero_(cp)) { - setmsg_("Polygonal FOV must have linearly independent consecutiv" - "e boundary but vectors at indices # and # have cross pro" - "duct equal to the zero vector. Instrument is #.", (ftnlen) - 158); - errint_("#", &i__, (ftnlen)1); - errint_("#", &next, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZHULLAX", (ftnlen)8); - return 0; - } - -/* See whether the other boundary vectors have angular */ -/* separation of at least MARGIN from the plane containing */ -/* the current face. */ - - pass1 = TRUE_; - ok = TRUE_; - m = 1; - while(m <= *n && ok) { - -/* Find the angular separation of CP and the Mth vector if the */ -/* latter is not an edge of the current face. */ - - if (m != i__ && m != next) { - sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) < bounds_dim2 * 3 - && 0 <= i__1 ? i__1 : s_rnge("bounds", i__1, "zzhull" - "ax_", (ftnlen)446)]); - if (pass1) { - -/* Adjust CP if necessary so that it points */ -/* toward the interior of the pyramid. */ - - if (sep > halfpi_()) { - -/* Invert the cross product vector and adjust SEP */ -/* accordingly. Within this "M" loop, all other */ -/* angular separations will be computed using the new */ -/* value of CP. */ - - vsclip_(&c_b20, cp); - sep = pi_() - sep; - } - pass1 = FALSE_; - } - ok = sep < halfpi_() - 1e-12; - } - if (ok) { - -/* Consider the next boundary vector. */ - - ++m; - } - } - -/* We've tested each boundary vector against the current face, or */ -/* else the loop terminated early because a vector with */ -/* insufficient angular separation from the plane containing the */ -/* face was found. */ - - if (ok) { - -/* The current face is exterior. It's bounded by rays I and */ -/* NEXT. */ - - xidx = i__; - found = TRUE_; - } else { - -/* Look at the next face of the pyramid. */ - - ++i__; - } - } - -/* If we didn't find an exterior face, we'll have to look at each */ -/* face bounded by a pair of rays, even if those rays are not */ -/* adjacent. (This can be a very slow process is N is large.) */ - - if (! found) { - i__ = 1; - while(i__ <= *n && ! found) { - -/* Consider all ray pairs (I,NEXT) where NEXT > I. */ - - next = i__ + 1; - while(next <= *n && ! found) { - -/* Find the cross product of the first ray with the second. */ -/* If the current face is exterior, CP could be an inward */ -/* or outward normal, depending on the ordering of the */ -/* boundary vectors. */ - - vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= - i__1 ? i__1 : s_rnge("bounds", i__1, "zzhullax_", ( - ftnlen)530)], &bounds[(i__2 = next * 3 - 3) < - bounds_dim2 * 3 && 0 <= i__2 ? i__2 : s_rnge("bounds", - i__2, "zzhullax_", (ftnlen)530)], cp); - -/* It's allowable for non-consecutive boundary vectors to */ -/* be linearly dependent, but if we have such a pair, */ -/* it doesn't define an exterior face. */ - - if (! vzero_(cp)) { - -/* The rays having direction vectors indexed I and NEXT */ -/* define a semi-infinite sector of a plane that might */ -/* be of interest. */ - -/* Check whether all of the boundary vectors that are */ -/* not edges of the current face have angular separation */ -/* of at least MARGIN from the plane containing the */ -/* current face. */ - - pass1 = TRUE_; - ok = TRUE_; - m = 1; - while(m <= *n && ok) { - -/* Find the angular separation of CP and the Mth */ -/* vector if the latter is not an edge of the current */ -/* face. */ - - if (m != i__ && m != next) { - sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) < - bounds_dim2 * 3 && 0 <= i__1 ? i__1 : - s_rnge("bounds", i__1, "zzhullax_", ( - ftnlen)560)]); - if (pass1) { - -/* Adjust CP if necessary so that it points */ -/* toward the interior of the pyramid. */ - - if (sep > halfpi_()) { - -/* Invert the cross product vector and */ -/* adjust SEP accordingly. Within this "M" */ -/* loop, all other angular separations will */ -/* be computed using the new value of CP. */ - - vsclip_(&c_b20, cp); - sep = pi_() - sep; - } - pass1 = FALSE_; - } - ok = sep < halfpi_() - 1e-12; - } - if (ok) { - -/* Consider the next boundary vector. */ - - ++m; - } - } - -/* We've tested each boundary vector against the current */ -/* face, or else the loop terminated early because a */ -/* vector with insufficient angular separation from the */ -/* plane containing the face was found. */ - - if (ok) { - -/* The current face is exterior. It's bounded by rays */ -/* I and NEXT. */ - xidx = i__; - found = TRUE_; - } - -/* End of angular separation test block. */ - - } - -/* End of non-zero cross product block. */ - - if (! found) { - -/* Look at the face bounded by the rays */ -/* at indices I and NEXT+1. */ - - ++next; - } - } - -/* End of NEXT loop. */ - - if (! found) { - -/* Look at the face bounded by the pairs of rays */ -/* including the ray at index I+1. */ - - ++i__; - } - } - -/* End of I loop. */ - - } - -/* End of search for exterior face using each pair of rays. */ - -/* If we still haven't found an exterior face, we can't continue. */ - - if (! found) { - setmsg_("Unable to find face of convex hull of FOV of instrument #.", - (ftnlen)58); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(FACENOTFOUND)", (ftnlen)19); - chkout_("ZZHULLAX", (ftnlen)8); - return 0; - } - -/* Arrival at this point means that the rays at indices */ -/* XIDX and NEXT define a plane such that all boundary */ -/* vectors lie in a half-space bounded by that plane. */ - -/* We're now going to define a set of orthonormal basis vectors: */ - -/* +X points along the angle bisector of the bounding vectors */ -/* of the exterior face. */ - -/* +Y points along CP. */ - -/* +Z is the cross product of +X and +Y. */ - -/* We'll call the reference frame having these basis vectors */ -/* the "face frame." */ - - - vhat_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1 : - s_rnge("bounds", i__1, "zzhullax_", (ftnlen)683)], ray1); - vhat_(&bounds[(i__1 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1 - : s_rnge("bounds", i__1, "zzhullax_", (ftnlen)684)], ray2); - vlcom_(&c_b36, ray1, &c_b36, ray2, xvec); - vhatip_(xvec); - vhat_(cp, yvec); - ucrss_(xvec, yvec, zvec); - -/* Create a transformation matrix to map the input boundary */ -/* vectors into the face frame. */ - - for (i__ = 1; i__ <= 3; ++i__) { - trans[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans", - i__1, "zzhullax_", (ftnlen)698)] = xvec[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("xvec", i__2, "zzhullax_", ( - ftnlen)698)]; - trans[(i__1 = i__ * 3 - 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans", - i__1, "zzhullax_", (ftnlen)699)] = yvec[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("yvec", i__2, "zzhullax_", ( - ftnlen)699)]; - trans[(i__1 = i__ * 3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans", - i__1, "zzhullax_", (ftnlen)700)] = zvec[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("zvec", i__2, "zzhullax_", ( - ftnlen)700)]; - } - -/* Now we're going to compute the longitude of each boundary in the */ -/* face frame. The vectors with indices XIDX and NEXT are excluded. */ -/* We expect all longitudes to be between MARGIN and pi - MARGIN. */ - - minlon = pi_(); - maxlon = 0.; - minix = 1; - maxix = 1; - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ != xidx && i__ != next) { - -/* The current vector is not a boundary of our edge, */ -/* so find its longitude. */ - - mxv_(trans, &bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= - i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", ( - ftnlen)720)], v); - reclat_(v, &r__, &lon, &lat); - -/* Update the longitude bounds. */ - - if (lon < minlon) { - minix = i__; - minlon = lon; - } - if (lon > maxlon) { - maxix = i__; - maxlon = lon; - } - } - } - -/* If the longitude bounds are not as expected, don't try */ -/* to continue. */ - - if (minlon < 2e-12) { - setmsg_("Minimum boundary vector longitude in exterior face frame is" - " # radians. Minimum occurs at index #. This FOV does not con" - "form to the requirements of this routine. Instrument is #.", ( - ftnlen)177); - errdp_("#", &minlon, (ftnlen)1); - errint_("#", &minix, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZHULLAX", (ftnlen)8); - return 0; - } else if (maxlon > pi_() - 2e-12) { - setmsg_("Maximum boundary vector longitude in exterior face frame is" - " # radians. Maximum occurs at index #. This FOV does not con" - "form to the requirements of this routine. Instrument is #.", ( - ftnlen)177); - errdp_("#", &maxlon, (ftnlen)1); - errint_("#", &maxix, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17); - chkout_("ZZHULLAX", (ftnlen)8); - return 0; - } - -/* Let delta represent the amount we can rotate the exterior */ -/* face clockwise about +Z without contacting another boundary */ -/* vector. */ - - delta = pi_() - maxlon; - -/* Rotate +Y by -DELTA/2 about +Z. The result is our candidate */ -/* FOV axis. Make the axis vector unit length. */ - - d__1 = -delta / 2; - vrotv_(yvec, zvec, &d__1, axis); - vhatip_(axis); - -/* If we have a viable result, ALL boundary vectors have */ -/* angular separation less than HALFPI-MARGIN from AXIS. */ - - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sep = vsep_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= - i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)794) - ], axis); - if (sep > halfpi_() - 1e-12) { - setmsg_("Boundary vector at index # has angular separation of # " - "radians from candidate FOV axis. This FOV does not confo" - "rm to the requirements of this routine. Instrument is #.", - (ftnlen)167); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &sep, (ftnlen)1); - errch_("#", inst, (ftnlen)1, inst_len); - sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17); - chkout_("ZZHULLAX", (ftnlen)8); - return 0; - } - } - chkout_("ZZHULLAX", (ftnlen)8); - return 0; -} /* zzhullax_ */ - diff --git a/ext/spice/src/cspice/zzidmap.c b/ext/spice/src/cspice/zzidmap.c deleted file mode 100644 index b045a9caca..0000000000 --- a/ext/spice/src/cspice/zzidmap.c +++ /dev/null @@ -1,1637 +0,0 @@ -/* zzidmap.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZIDMAP ( Private --- SPICE body ID/name assignments ) */ -/* Subroutine */ int zzidmap_(integer *bltcod, char *bltnam, ftnlen - bltnam_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* The default SPICE body/ID mapping assignments available */ -/* to the SPICE library. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This include file lists the parameter collection */ -/* defining the number of SPICE ID -> NAME mappings. */ - -/* $ 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 */ - -/* naif_ids.req */ - -/* $ Keywords */ - -/* Body mappings. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ - - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZBODTRN.INC. */ - - -/* Maximum size of a NAME string */ - - -/* Count of default SPICE mapping assignments. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BLTCOD O List of default integer ID codes */ -/* BLTNAM O List of default names */ -/* NPERM P Number of name/ID mappings */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* BLTCOD The array of NPERM elements listing the body ID codes. */ - -/* BLTNAM The array of NPERM elements listing the body names */ -/* corresponding to the ID entry in BLTCOD */ - -/* $ Parameters */ - -/* NPERM The length of both BLTCOD, BLTNAM */ -/* (read from zzbodtrn.inc). */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Each ith entry of BLTCOD maps to the ith entry of BLTNAM. */ - -/* $ Examples */ - -/* Simple to use, a call the ZZIDMAP returns the arrays defining the */ -/* name/ID mappings. */ - - -/* INCLUDE 'zzbodtrn.inc' */ - -/* INTEGER ID ( NPERM ) */ -/* CHARACTER*(MAXL) NAME( NPERM ) */ - -/* CALL ZZIDMAP( ID, NAME ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright, Thu May 20 07:57:58 2010 (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.0.7 20-MAY-2010 (EDW) */ - -/* Edit to vehicle ID list to correct -76 not in proper */ -/* numerical (descending) order. */ - -/* Added: */ - -/* -5 AKATSUKI */ -/* -5 VCO */ -/* -121 BEPICOLOMBO */ -/* -177 GRAIL-A */ -/* -181 GRAIL-B */ -/* -202 MAVEN */ -/* -205 SOIL MOISTURE ACTIVE AND PASSIVE */ -/* -205 SMAP */ -/* -362 RADIATION BELT STORM PROBE A */ -/* -362 RBSP_A */ -/* -363 RADIATION BELT STORM PROBE B */ -/* -363 RBSP_B */ -/* 550 HERSE */ -/* 653 AEGAEON */ -/* 1000093 TEMPEL_1 */ -/* 2000021 LUTETIA */ -/* 2004179 TOUTATIS */ - -/* - SPICELIB 1.0.6 08-APR-2009 (EDW) */ - -/* Added: */ - -/* -5 PLC */ -/* -5 PLANET-C */ -/* -68 MMO */ -/* -68 MERCURY MAGNETOSPHERIC ORBITER */ -/* -69 MPO */ -/* -69 MERCURY PLANETARY ORBITER */ -/* 2002867 STEINS */ -/* -140 EPOCH */ -/* -140 DIXI */ - -/* - SPICELIB 1.0.5 09-JAN-2008 (EDW) */ - -/* Added: */ - -/* -18 LCROSS */ -/* -29 NEXT */ -/* -86 CH1 */ -/* -86 CHANDRAYAAN-1 */ -/* -131 KAGUYA */ -/* -140 EPOXI */ -/* -151 CHANDRA */ -/* -187 SOLAR PROBE */ -/* 636 AEGIR */ -/* 637 BEBHIONN */ -/* 638 BERGELMIR */ -/* 639 BESTLA */ -/* 640 FARBAUTI */ -/* 641 FENRIR */ -/* 642 FORNJOT */ -/* 643 HATI */ -/* 644 HYROKKIN */ -/* 645 KARI */ -/* 646 LOGE */ -/* 647 SKOLL */ -/* 648 SURTUR */ -/* 649 ANTHE */ -/* 650 JARNSAXA */ -/* 651 GREIP */ -/* 652 TARQEQ */ -/* 809 HALIMEDE */ -/* 810 PSAMATHE */ -/* 811 SAO */ -/* 812 LAOMEDEIA */ -/* 813 NESO */ - -/* NAIF modified the Jovian system listing to conform to the */ -/* current (as of this date) name/body mapping. */ - -/* 540 MNEME */ -/* 541 AOEDE */ -/* 542 THELXINOE */ -/* 543 ARCHE */ -/* 544 KALLICHORE */ -/* 545 HELIKE */ -/* 546 CARPO */ -/* 547 EUKELADE */ -/* 548 CYLLENE */ -/* 549 KORE */ - -/* Removed assignments: */ - -/* -172 SPACETECH-3 COMBINER */ -/* -174 PLUTO-KUIPER EXPRESS */ -/* -175 PLUTO-KUIPER EXPRESS SIMULATION */ -/* -205 SPACETECH-3 COLLECTOR */ -/* 514 1979J2 */ -/* 515 1979J1 */ -/* 516 1979J3 */ -/* 610 1980S1 */ -/* 611 1980S3 */ -/* 612 1980S6 */ -/* 613 1980S13 */ -/* 614 1980S25 */ -/* 615 1980S28 */ -/* 616 1980S27 */ -/* 617 1980S26 */ -/* 706 1986U7 */ -/* 707 1986U8 */ -/* 708 1986U9 */ -/* 709 1986U4 */ -/* 710 1986U6 */ -/* 711 1986U3 */ -/* 712 1986U1 */ -/* 713 1986U2 */ -/* 714 1986U5 */ -/* 715 1985U1 */ -/* 718 1986U10 */ -/* 901 1978P1 */ - -/* Spelling correction: */ - -/* MAGACLITE to MEGACLITE */ - -/* Rename: */ - -/* ERRIAPO to ERRIAPUS */ -/* STV-1 to STV51 */ -/* STV-2 to STV52 */ -/* STV-3 to STV53 */ - - -/* - SPICELIB 1.0.4 01-NOV-2006 (EDW) */ - -/* NAIF removed several provisional name/ID mappings from */ -/* the Jovian system listing: */ - -/* 539 'HEGEMONE' JXXXIX */ -/* 540 'MNEME' JXL */ -/* 541 'AOEDE' JXLI */ -/* 542 'THELXINOE' JXLII */ -/* 543 'ARCHE' JXLIII */ -/* 544 'KALLICHORE' JXLIV */ -/* 545 'HELIKE' JXLV */ -/* 546 'CARPO' JXLVI */ -/* 547 'EUKELADE' JXLVII */ -/* 548 'CYLLENE' JXLVIII */ - -/* The current mapping set for the range 539-561: */ - -/* 540 ARCHE */ -/* 541 EUKELADE */ -/* 546 HELIKE */ -/* 547 AOEDE */ -/* 548 HEGEMONE */ -/* 551 KALLICHORE */ -/* 553 CYLLENE */ -/* 560 CARPO */ -/* 561 MNEME */ - -/* The new mapping leaves the IDs 539, 542-545, 549, 550, 552, */ -/* 554-559 unassigned. */ - -/* Added: */ - -/* 635 DAPHNIS */ -/* 722 FRANCISCO */ -/* 723 MARGARET */ -/* 724 FERDINAND */ -/* 725 PERDITA */ -/* 726 MAB */ -/* 727 CUPID */ -/* -61 JUNO */ -/* -76 MSL */ -/* -76 MARS SCIENCE LABORATORY */ -/* -212 STV-1 */ -/* -213 STV-2 */ -/* -214 STV-3 */ -/* 902 NIX */ -/* 903 HYDRA */ -/* -85 LRO */ -/* -85 LUNAR RECON ORBITER */ -/* -85 LUNAR RECONNAISSANCE ORBITER */ - -/* Spelling correction */ - -/* 632 METHODE to METHONE */ - -/* - SPICELIB 1.0.3 14-NOV-2005 (EDW) */ - -/* Added: */ - -/* 539 HEGEMONE */ -/* 540 MNEME */ -/* 541 AOEDE */ -/* 542 THELXINOE */ -/* 543 ARCHE */ -/* 544 KALLICHORE */ -/* 545 HELIKE */ -/* 546 CARPO */ -/* 547 EUKELADE */ -/* 548 CYLLENE */ -/* 631 NARVI */ -/* 632 METHODE */ -/* 633 PALLENE */ -/* 634 POLYDEUCES */ -/* 2025143 ITOKAWA */ -/* -98 NEW HORIZONS */ -/* -248 VENUS EXPRESS, VEX */ -/* -500 RSAT, SELENE Relay Satellite, SELENE Rstar, Rstar */ -/* -502 VSAT, SELENE VLBI Radio Satellite, */ -/* SELENE VRAD Satellite, SELENE Vstar */ -/* 399064 DSS-64 */ - -/* Change in spelling: */ - -/* 623 SUTTUNG to SUTTUNGR */ -/* 627 SKADI to SKATHI */ -/* 630 THRYM to THRYMR */ - -/* - SPICELIB 1.0.2 20-DEC-2004 (EDW) */ - -/* Added: */ - -/* Due to the previous definition of Parkes with DSS-05, */ -/* the Parkes ID remains 399005. */ - -/* -486 HERSCHEL */ -/* -489 PLANCK */ -/* 399049 DSS-49 */ -/* 399055 DSS-55 */ -/* -203 DAWN */ -/* 1000012 67P/CHURYUMOV-GERASIMENKO (1969 R1) */ -/* 1000012 CHURYUMOV-GERASIMENKO */ -/* 398989 NOTO */ -/* -84 PHOENIX */ -/* -131 SELENE */ -/* -238 SMART-1, S1, SM1, SMART1 */ -/* -130 HAYABUSA */ - -/* - SPICELIB 1.0.1 19-DEC-2003 (EDW) */ - -/* Added: */ -/* -79 SPITZER */ -/* 2000216 KLEOPATRA */ - -/* - SPICELIB 1.0.0 27-JUL-2003 (EDW) */ - -/* Added: */ -/* -47 GNS */ -/* -74 MRO */ -/* -74 MARS RECON ORBITER */ -/* -130 MUSES-C */ -/* -142 TERRA */ -/* -154 AQUA */ -/* -159 EUROPA ORBITER */ -/* -190 SIM */ -/* -198 INTEGRAL */ -/* -227 KEPLER */ -/* -234 STEREO AHEAD */ -/* -235 STEREO BEHIND */ -/* -253 OPPORTUNITY */ -/* -254 SPIRIT */ -/* 528 AUTONOE */ -/* 529 THYONE */ -/* 530 HERMIPPE */ -/* 531 AITNE */ -/* 532 EURYDOME */ -/* 533 EUANTHE */ -/* 534 EUPORIE */ -/* 535 ORTHOSIE */ -/* 536 SPONDE */ -/* 537 KALE */ -/* 538 PASITHEE */ -/* 619 YMIR */ -/* 620 PAALIAQ */ -/* 621 TARVOS */ -/* 622 IJIRAQ */ -/* 623 SUTTUNG */ -/* 624 KIVIUQ */ -/* 625 MUNDILFARI */ -/* 626 ALBIORIX */ -/* 627 SKADI */ -/* 628 ERRIAPO */ -/* 629 SIARNAQ */ -/* 630 THRYM */ -/* 718 PROSPERO */ -/* 719 SETEBOS */ -/* 720 STEPHANO */ -/* 721 TRINCULO */ -/* 398990 NEW NORCIA */ -/* 2431011 DACTYL */ -/* 2000001 CERES */ -/* 2000004 VESTA */ - -/* Renamed: */ - -/* -25 LPM to */ -/* -25 LP */ - -/* -180 MUSES-C to */ -/* -130 MUSES-B */ - -/* -172 STARLIGHT COMBINER to */ -/* -172 SPACETECH-3 COMBINER */ - -/* -205 STARLIGHT COLLECTOR to */ -/* -205 SPACETECH-3 COLLECTOR */ - -/* Removed: */ -/* -172 SLCOMB */ - - -/* -& */ -/* $ Index_Entries */ - -/* body ID mapping */ - -/* -& */ - -/* A script generates this file. Do not edit by hand. */ -/* Edit the creation script to modify the contents of */ -/* ZZIDMAP. */ - - bltcod[0] = 0; - s_copy(bltnam, "SSB", (ftnlen)36, (ftnlen)3); - bltcod[1] = 0; - s_copy(bltnam + 36, "SOLAR SYSTEM BARYCENTER", (ftnlen)36, (ftnlen)23); - bltcod[2] = 1; - s_copy(bltnam + 72, "MERCURY BARYCENTER", (ftnlen)36, (ftnlen)18); - bltcod[3] = 2; - s_copy(bltnam + 108, "VENUS BARYCENTER", (ftnlen)36, (ftnlen)16); - bltcod[4] = 3; - s_copy(bltnam + 144, "EMB", (ftnlen)36, (ftnlen)3); - bltcod[5] = 3; - s_copy(bltnam + 180, "EARTH MOON BARYCENTER", (ftnlen)36, (ftnlen)21); - bltcod[6] = 3; - s_copy(bltnam + 216, "EARTH-MOON BARYCENTER", (ftnlen)36, (ftnlen)21); - bltcod[7] = 3; - s_copy(bltnam + 252, "EARTH BARYCENTER", (ftnlen)36, (ftnlen)16); - bltcod[8] = 4; - s_copy(bltnam + 288, "MARS BARYCENTER", (ftnlen)36, (ftnlen)15); - bltcod[9] = 5; - s_copy(bltnam + 324, "JUPITER BARYCENTER", (ftnlen)36, (ftnlen)18); - bltcod[10] = 6; - s_copy(bltnam + 360, "SATURN BARYCENTER", (ftnlen)36, (ftnlen)17); - bltcod[11] = 7; - s_copy(bltnam + 396, "URANUS BARYCENTER", (ftnlen)36, (ftnlen)17); - bltcod[12] = 8; - s_copy(bltnam + 432, "NEPTUNE BARYCENTER", (ftnlen)36, (ftnlen)18); - bltcod[13] = 9; - s_copy(bltnam + 468, "PLUTO BARYCENTER", (ftnlen)36, (ftnlen)16); - bltcod[14] = 10; - s_copy(bltnam + 504, "SUN", (ftnlen)36, (ftnlen)3); - bltcod[15] = 199; - s_copy(bltnam + 540, "MERCURY", (ftnlen)36, (ftnlen)7); - bltcod[16] = 299; - s_copy(bltnam + 576, "VENUS", (ftnlen)36, (ftnlen)5); - bltcod[17] = 399; - s_copy(bltnam + 612, "EARTH", (ftnlen)36, (ftnlen)5); - bltcod[18] = 301; - s_copy(bltnam + 648, "MOON", (ftnlen)36, (ftnlen)4); - bltcod[19] = 499; - s_copy(bltnam + 684, "MARS", (ftnlen)36, (ftnlen)4); - bltcod[20] = 401; - s_copy(bltnam + 720, "PHOBOS", (ftnlen)36, (ftnlen)6); - bltcod[21] = 402; - s_copy(bltnam + 756, "DEIMOS", (ftnlen)36, (ftnlen)6); - bltcod[22] = 599; - s_copy(bltnam + 792, "JUPITER", (ftnlen)36, (ftnlen)7); - bltcod[23] = 501; - s_copy(bltnam + 828, "IO", (ftnlen)36, (ftnlen)2); - bltcod[24] = 502; - s_copy(bltnam + 864, "EUROPA", (ftnlen)36, (ftnlen)6); - bltcod[25] = 503; - s_copy(bltnam + 900, "GANYMEDE", (ftnlen)36, (ftnlen)8); - bltcod[26] = 504; - s_copy(bltnam + 936, "CALLISTO", (ftnlen)36, (ftnlen)8); - bltcod[27] = 505; - s_copy(bltnam + 972, "AMALTHEA", (ftnlen)36, (ftnlen)8); - bltcod[28] = 506; - s_copy(bltnam + 1008, "HIMALIA", (ftnlen)36, (ftnlen)7); - bltcod[29] = 507; - s_copy(bltnam + 1044, "ELARA", (ftnlen)36, (ftnlen)5); - bltcod[30] = 508; - s_copy(bltnam + 1080, "PASIPHAE", (ftnlen)36, (ftnlen)8); - bltcod[31] = 509; - s_copy(bltnam + 1116, "SINOPE", (ftnlen)36, (ftnlen)6); - bltcod[32] = 510; - s_copy(bltnam + 1152, "LYSITHEA", (ftnlen)36, (ftnlen)8); - bltcod[33] = 511; - s_copy(bltnam + 1188, "CARME", (ftnlen)36, (ftnlen)5); - bltcod[34] = 512; - s_copy(bltnam + 1224, "ANANKE", (ftnlen)36, (ftnlen)6); - bltcod[35] = 513; - s_copy(bltnam + 1260, "LEDA", (ftnlen)36, (ftnlen)4); - bltcod[36] = 514; - s_copy(bltnam + 1296, "THEBE", (ftnlen)36, (ftnlen)5); - bltcod[37] = 515; - s_copy(bltnam + 1332, "ADRASTEA", (ftnlen)36, (ftnlen)8); - bltcod[38] = 516; - s_copy(bltnam + 1368, "METIS", (ftnlen)36, (ftnlen)5); - bltcod[39] = 517; - s_copy(bltnam + 1404, "CALLIRRHOE", (ftnlen)36, (ftnlen)10); - bltcod[40] = 518; - s_copy(bltnam + 1440, "THEMISTO", (ftnlen)36, (ftnlen)8); - bltcod[41] = 519; - s_copy(bltnam + 1476, "MAGACLITE", (ftnlen)36, (ftnlen)9); - bltcod[42] = 520; - s_copy(bltnam + 1512, "TAYGETE", (ftnlen)36, (ftnlen)7); - bltcod[43] = 521; - s_copy(bltnam + 1548, "CHALDENE", (ftnlen)36, (ftnlen)8); - bltcod[44] = 522; - s_copy(bltnam + 1584, "HARPALYKE", (ftnlen)36, (ftnlen)9); - bltcod[45] = 523; - s_copy(bltnam + 1620, "KALYKE", (ftnlen)36, (ftnlen)6); - bltcod[46] = 524; - s_copy(bltnam + 1656, "IOCASTE", (ftnlen)36, (ftnlen)7); - bltcod[47] = 525; - s_copy(bltnam + 1692, "ERINOME", (ftnlen)36, (ftnlen)7); - bltcod[48] = 526; - s_copy(bltnam + 1728, "ISONOE", (ftnlen)36, (ftnlen)6); - bltcod[49] = 527; - s_copy(bltnam + 1764, "PRAXIDIKE", (ftnlen)36, (ftnlen)9); - bltcod[50] = 528; - s_copy(bltnam + 1800, "AUTONOE", (ftnlen)36, (ftnlen)7); - bltcod[51] = 529; - s_copy(bltnam + 1836, "THYONE", (ftnlen)36, (ftnlen)6); - bltcod[52] = 530; - s_copy(bltnam + 1872, "HERMIPPE", (ftnlen)36, (ftnlen)8); - bltcod[53] = 531; - s_copy(bltnam + 1908, "AITNE", (ftnlen)36, (ftnlen)5); - bltcod[54] = 532; - s_copy(bltnam + 1944, "EURYDOME", (ftnlen)36, (ftnlen)8); - bltcod[55] = 533; - s_copy(bltnam + 1980, "EUANTHE", (ftnlen)36, (ftnlen)7); - bltcod[56] = 534; - s_copy(bltnam + 2016, "EUPORIE", (ftnlen)36, (ftnlen)7); - bltcod[57] = 535; - s_copy(bltnam + 2052, "ORTHOSIE", (ftnlen)36, (ftnlen)8); - bltcod[58] = 536; - s_copy(bltnam + 2088, "SPONDE", (ftnlen)36, (ftnlen)6); - bltcod[59] = 537; - s_copy(bltnam + 2124, "KALE", (ftnlen)36, (ftnlen)4); - bltcod[60] = 538; - s_copy(bltnam + 2160, "PASITHEE", (ftnlen)36, (ftnlen)8); - bltcod[61] = 539; - s_copy(bltnam + 2196, "HEGEMONE", (ftnlen)36, (ftnlen)8); - bltcod[62] = 540; - s_copy(bltnam + 2232, "MNEME", (ftnlen)36, (ftnlen)5); - bltcod[63] = 541; - s_copy(bltnam + 2268, "AOEDE", (ftnlen)36, (ftnlen)5); - bltcod[64] = 542; - s_copy(bltnam + 2304, "THELXINOE", (ftnlen)36, (ftnlen)9); - bltcod[65] = 543; - s_copy(bltnam + 2340, "ARCHE", (ftnlen)36, (ftnlen)5); - bltcod[66] = 544; - s_copy(bltnam + 2376, "KALLICHORE", (ftnlen)36, (ftnlen)10); - bltcod[67] = 545; - s_copy(bltnam + 2412, "HELIKE", (ftnlen)36, (ftnlen)6); - bltcod[68] = 546; - s_copy(bltnam + 2448, "CARPO", (ftnlen)36, (ftnlen)5); - bltcod[69] = 547; - s_copy(bltnam + 2484, "EUKELADE", (ftnlen)36, (ftnlen)8); - bltcod[70] = 548; - s_copy(bltnam + 2520, "CYLLENE", (ftnlen)36, (ftnlen)7); - bltcod[71] = 549; - s_copy(bltnam + 2556, "KORE", (ftnlen)36, (ftnlen)4); - bltcod[72] = 550; - s_copy(bltnam + 2592, "HERSE", (ftnlen)36, (ftnlen)5); - bltcod[73] = 699; - s_copy(bltnam + 2628, "SATURN", (ftnlen)36, (ftnlen)6); - bltcod[74] = 601; - s_copy(bltnam + 2664, "MIMAS", (ftnlen)36, (ftnlen)5); - bltcod[75] = 602; - s_copy(bltnam + 2700, "ENCELADUS", (ftnlen)36, (ftnlen)9); - bltcod[76] = 603; - s_copy(bltnam + 2736, "TETHYS", (ftnlen)36, (ftnlen)6); - bltcod[77] = 604; - s_copy(bltnam + 2772, "DIONE", (ftnlen)36, (ftnlen)5); - bltcod[78] = 605; - s_copy(bltnam + 2808, "RHEA", (ftnlen)36, (ftnlen)4); - bltcod[79] = 606; - s_copy(bltnam + 2844, "TITAN", (ftnlen)36, (ftnlen)5); - bltcod[80] = 607; - s_copy(bltnam + 2880, "HYPERION", (ftnlen)36, (ftnlen)8); - bltcod[81] = 608; - s_copy(bltnam + 2916, "IAPETUS", (ftnlen)36, (ftnlen)7); - bltcod[82] = 609; - s_copy(bltnam + 2952, "PHOEBE", (ftnlen)36, (ftnlen)6); - bltcod[83] = 610; - s_copy(bltnam + 2988, "JANUS", (ftnlen)36, (ftnlen)5); - bltcod[84] = 611; - s_copy(bltnam + 3024, "EPIMETHEUS", (ftnlen)36, (ftnlen)10); - bltcod[85] = 612; - s_copy(bltnam + 3060, "HELENE", (ftnlen)36, (ftnlen)6); - bltcod[86] = 613; - s_copy(bltnam + 3096, "TELESTO", (ftnlen)36, (ftnlen)7); - bltcod[87] = 614; - s_copy(bltnam + 3132, "CALYPSO", (ftnlen)36, (ftnlen)7); - bltcod[88] = 615; - s_copy(bltnam + 3168, "ATLAS", (ftnlen)36, (ftnlen)5); - bltcod[89] = 616; - s_copy(bltnam + 3204, "PROMETHEUS", (ftnlen)36, (ftnlen)10); - bltcod[90] = 617; - s_copy(bltnam + 3240, "PANDORA", (ftnlen)36, (ftnlen)7); - bltcod[91] = 618; - s_copy(bltnam + 3276, "PAN", (ftnlen)36, (ftnlen)3); - bltcod[92] = 619; - s_copy(bltnam + 3312, "YMIR", (ftnlen)36, (ftnlen)4); - bltcod[93] = 620; - s_copy(bltnam + 3348, "PAALIAQ", (ftnlen)36, (ftnlen)7); - bltcod[94] = 621; - s_copy(bltnam + 3384, "TARVOS", (ftnlen)36, (ftnlen)6); - bltcod[95] = 622; - s_copy(bltnam + 3420, "IJIRAQ", (ftnlen)36, (ftnlen)6); - bltcod[96] = 623; - s_copy(bltnam + 3456, "SUTTUNGR", (ftnlen)36, (ftnlen)8); - bltcod[97] = 624; - s_copy(bltnam + 3492, "KIVIUQ", (ftnlen)36, (ftnlen)6); - bltcod[98] = 625; - s_copy(bltnam + 3528, "MUNDILFARI", (ftnlen)36, (ftnlen)10); - bltcod[99] = 626; - s_copy(bltnam + 3564, "ALBIORIX", (ftnlen)36, (ftnlen)8); - bltcod[100] = 627; - s_copy(bltnam + 3600, "SKATHI", (ftnlen)36, (ftnlen)6); - bltcod[101] = 628; - s_copy(bltnam + 3636, "ERRIAPUS", (ftnlen)36, (ftnlen)8); - bltcod[102] = 629; - s_copy(bltnam + 3672, "SIARNAQ", (ftnlen)36, (ftnlen)7); - bltcod[103] = 630; - s_copy(bltnam + 3708, "THRYMR", (ftnlen)36, (ftnlen)6); - bltcod[104] = 631; - s_copy(bltnam + 3744, "NARVI", (ftnlen)36, (ftnlen)5); - bltcod[105] = 632; - s_copy(bltnam + 3780, "METHONE", (ftnlen)36, (ftnlen)7); - bltcod[106] = 633; - s_copy(bltnam + 3816, "PALLENE", (ftnlen)36, (ftnlen)7); - bltcod[107] = 634; - s_copy(bltnam + 3852, "POLYDEUCES", (ftnlen)36, (ftnlen)10); - bltcod[108] = 635; - s_copy(bltnam + 3888, "DAPHNIS", (ftnlen)36, (ftnlen)7); - bltcod[109] = 636; - s_copy(bltnam + 3924, "AEGIR", (ftnlen)36, (ftnlen)5); - bltcod[110] = 637; - s_copy(bltnam + 3960, "BEBHIONN", (ftnlen)36, (ftnlen)8); - bltcod[111] = 638; - s_copy(bltnam + 3996, "BERGELMIR", (ftnlen)36, (ftnlen)9); - bltcod[112] = 639; - s_copy(bltnam + 4032, "BESTLA", (ftnlen)36, (ftnlen)6); - bltcod[113] = 640; - s_copy(bltnam + 4068, "FARBAUTI", (ftnlen)36, (ftnlen)8); - bltcod[114] = 641; - s_copy(bltnam + 4104, "FENRIR", (ftnlen)36, (ftnlen)6); - bltcod[115] = 642; - s_copy(bltnam + 4140, "FORNJOT", (ftnlen)36, (ftnlen)7); - bltcod[116] = 643; - s_copy(bltnam + 4176, "HATI", (ftnlen)36, (ftnlen)4); - bltcod[117] = 644; - s_copy(bltnam + 4212, "HYROKKIN", (ftnlen)36, (ftnlen)8); - bltcod[118] = 645; - s_copy(bltnam + 4248, "KARI", (ftnlen)36, (ftnlen)4); - bltcod[119] = 646; - s_copy(bltnam + 4284, "LOGE", (ftnlen)36, (ftnlen)4); - bltcod[120] = 647; - s_copy(bltnam + 4320, "SKOLL", (ftnlen)36, (ftnlen)5); - bltcod[121] = 648; - s_copy(bltnam + 4356, "SURTUR", (ftnlen)36, (ftnlen)6); - bltcod[122] = 649; - s_copy(bltnam + 4392, "ANTHE", (ftnlen)36, (ftnlen)5); - bltcod[123] = 650; - s_copy(bltnam + 4428, "JARNSAXA", (ftnlen)36, (ftnlen)8); - bltcod[124] = 651; - s_copy(bltnam + 4464, "GREIP", (ftnlen)36, (ftnlen)5); - bltcod[125] = 652; - s_copy(bltnam + 4500, "TARQEQ", (ftnlen)36, (ftnlen)6); - bltcod[126] = 653; - s_copy(bltnam + 4536, "AEGAEON", (ftnlen)36, (ftnlen)7); - bltcod[127] = 799; - s_copy(bltnam + 4572, "URANUS", (ftnlen)36, (ftnlen)6); - bltcod[128] = 701; - s_copy(bltnam + 4608, "ARIEL", (ftnlen)36, (ftnlen)5); - bltcod[129] = 702; - s_copy(bltnam + 4644, "UMBRIEL", (ftnlen)36, (ftnlen)7); - bltcod[130] = 703; - s_copy(bltnam + 4680, "TITANIA", (ftnlen)36, (ftnlen)7); - bltcod[131] = 704; - s_copy(bltnam + 4716, "OBERON", (ftnlen)36, (ftnlen)6); - bltcod[132] = 705; - s_copy(bltnam + 4752, "MIRANDA", (ftnlen)36, (ftnlen)7); - bltcod[133] = 706; - s_copy(bltnam + 4788, "CORDELIA", (ftnlen)36, (ftnlen)8); - bltcod[134] = 707; - s_copy(bltnam + 4824, "OPHELIA", (ftnlen)36, (ftnlen)7); - bltcod[135] = 708; - s_copy(bltnam + 4860, "BIANCA", (ftnlen)36, (ftnlen)6); - bltcod[136] = 709; - s_copy(bltnam + 4896, "CRESSIDA", (ftnlen)36, (ftnlen)8); - bltcod[137] = 710; - s_copy(bltnam + 4932, "DESDEMONA", (ftnlen)36, (ftnlen)9); - bltcod[138] = 711; - s_copy(bltnam + 4968, "JULIET", (ftnlen)36, (ftnlen)6); - bltcod[139] = 712; - s_copy(bltnam + 5004, "PORTIA", (ftnlen)36, (ftnlen)6); - bltcod[140] = 713; - s_copy(bltnam + 5040, "ROSALIND", (ftnlen)36, (ftnlen)8); - bltcod[141] = 714; - s_copy(bltnam + 5076, "BELINDA", (ftnlen)36, (ftnlen)7); - bltcod[142] = 715; - s_copy(bltnam + 5112, "PUCK", (ftnlen)36, (ftnlen)4); - bltcod[143] = 716; - s_copy(bltnam + 5148, "CALIBAN", (ftnlen)36, (ftnlen)7); - bltcod[144] = 717; - s_copy(bltnam + 5184, "SYCORAX", (ftnlen)36, (ftnlen)7); - bltcod[145] = 718; - s_copy(bltnam + 5220, "PROSPERO", (ftnlen)36, (ftnlen)8); - bltcod[146] = 719; - s_copy(bltnam + 5256, "SETEBOS", (ftnlen)36, (ftnlen)7); - bltcod[147] = 720; - s_copy(bltnam + 5292, "STEPHANO", (ftnlen)36, (ftnlen)8); - bltcod[148] = 721; - s_copy(bltnam + 5328, "TRINCULO", (ftnlen)36, (ftnlen)8); - bltcod[149] = 722; - s_copy(bltnam + 5364, "FRANCISCO", (ftnlen)36, (ftnlen)9); - bltcod[150] = 723; - s_copy(bltnam + 5400, "MARGARET", (ftnlen)36, (ftnlen)8); - bltcod[151] = 724; - s_copy(bltnam + 5436, "FERDINAND", (ftnlen)36, (ftnlen)9); - bltcod[152] = 725; - s_copy(bltnam + 5472, "PERDITA", (ftnlen)36, (ftnlen)7); - bltcod[153] = 726; - s_copy(bltnam + 5508, "MAB", (ftnlen)36, (ftnlen)3); - bltcod[154] = 727; - s_copy(bltnam + 5544, "CUPID", (ftnlen)36, (ftnlen)5); - bltcod[155] = 899; - s_copy(bltnam + 5580, "NEPTUNE", (ftnlen)36, (ftnlen)7); - bltcod[156] = 801; - s_copy(bltnam + 5616, "TRITON", (ftnlen)36, (ftnlen)6); - bltcod[157] = 802; - s_copy(bltnam + 5652, "NEREID", (ftnlen)36, (ftnlen)6); - bltcod[158] = 803; - s_copy(bltnam + 5688, "NAIAD", (ftnlen)36, (ftnlen)5); - bltcod[159] = 804; - s_copy(bltnam + 5724, "THALASSA", (ftnlen)36, (ftnlen)8); - bltcod[160] = 805; - s_copy(bltnam + 5760, "DESPINA", (ftnlen)36, (ftnlen)7); - bltcod[161] = 806; - s_copy(bltnam + 5796, "GALATEA", (ftnlen)36, (ftnlen)7); - bltcod[162] = 807; - s_copy(bltnam + 5832, "LARISSA", (ftnlen)36, (ftnlen)7); - bltcod[163] = 808; - s_copy(bltnam + 5868, "PROTEUS", (ftnlen)36, (ftnlen)7); - bltcod[164] = 809; - s_copy(bltnam + 5904, "HALIMEDE", (ftnlen)36, (ftnlen)8); - bltcod[165] = 810; - s_copy(bltnam + 5940, "PSAMATHE", (ftnlen)36, (ftnlen)8); - bltcod[166] = 811; - s_copy(bltnam + 5976, "SAO", (ftnlen)36, (ftnlen)3); - bltcod[167] = 812; - s_copy(bltnam + 6012, "LAOMEDEIA", (ftnlen)36, (ftnlen)9); - bltcod[168] = 813; - s_copy(bltnam + 6048, "NESO", (ftnlen)36, (ftnlen)4); - bltcod[169] = 999; - s_copy(bltnam + 6084, "PLUTO", (ftnlen)36, (ftnlen)5); - bltcod[170] = 901; - s_copy(bltnam + 6120, "CHARON", (ftnlen)36, (ftnlen)6); - bltcod[171] = 902; - s_copy(bltnam + 6156, "NIX", (ftnlen)36, (ftnlen)3); - bltcod[172] = 903; - s_copy(bltnam + 6192, "HYDRA", (ftnlen)36, (ftnlen)5); - bltcod[173] = -1; - s_copy(bltnam + 6228, "GEOTAIL", (ftnlen)36, (ftnlen)7); - bltcod[174] = -5; - s_copy(bltnam + 6264, "AKATSUKI", (ftnlen)36, (ftnlen)8); - bltcod[175] = -5; - s_copy(bltnam + 6300, "VCO", (ftnlen)36, (ftnlen)3); - bltcod[176] = -5; - s_copy(bltnam + 6336, "PLC", (ftnlen)36, (ftnlen)3); - bltcod[177] = -5; - s_copy(bltnam + 6372, "PLANET-C", (ftnlen)36, (ftnlen)8); - bltcod[178] = -6; - s_copy(bltnam + 6408, "P6", (ftnlen)36, (ftnlen)2); - bltcod[179] = -6; - s_copy(bltnam + 6444, "PIONEER-6", (ftnlen)36, (ftnlen)9); - bltcod[180] = -7; - s_copy(bltnam + 6480, "P7", (ftnlen)36, (ftnlen)2); - bltcod[181] = -7; - s_copy(bltnam + 6516, "PIONEER-7", (ftnlen)36, (ftnlen)9); - bltcod[182] = -8; - s_copy(bltnam + 6552, "WIND", (ftnlen)36, (ftnlen)4); - bltcod[183] = -12; - s_copy(bltnam + 6588, "VENUS ORBITER", (ftnlen)36, (ftnlen)13); - bltcod[184] = -12; - s_copy(bltnam + 6624, "P12", (ftnlen)36, (ftnlen)3); - bltcod[185] = -12; - s_copy(bltnam + 6660, "PIONEER 12", (ftnlen)36, (ftnlen)10); - bltcod[186] = -13; - s_copy(bltnam + 6696, "POLAR", (ftnlen)36, (ftnlen)5); - bltcod[187] = -18; - s_copy(bltnam + 6732, "MGN", (ftnlen)36, (ftnlen)3); - bltcod[188] = -18; - s_copy(bltnam + 6768, "MAGELLAN", (ftnlen)36, (ftnlen)8); - bltcod[189] = -18; - s_copy(bltnam + 6804, "LCROSS", (ftnlen)36, (ftnlen)6); - bltcod[190] = -20; - s_copy(bltnam + 6840, "P8", (ftnlen)36, (ftnlen)2); - bltcod[191] = -20; - s_copy(bltnam + 6876, "PIONEER-8", (ftnlen)36, (ftnlen)9); - bltcod[192] = -21; - s_copy(bltnam + 6912, "SOHO", (ftnlen)36, (ftnlen)4); - bltcod[193] = -23; - s_copy(bltnam + 6948, "P10", (ftnlen)36, (ftnlen)3); - bltcod[194] = -23; - s_copy(bltnam + 6984, "PIONEER-10", (ftnlen)36, (ftnlen)10); - bltcod[195] = -24; - s_copy(bltnam + 7020, "P11", (ftnlen)36, (ftnlen)3); - bltcod[196] = -24; - s_copy(bltnam + 7056, "PIONEER-11", (ftnlen)36, (ftnlen)10); - bltcod[197] = -25; - s_copy(bltnam + 7092, "LP", (ftnlen)36, (ftnlen)2); - bltcod[198] = -25; - s_copy(bltnam + 7128, "LUNAR PROSPECTOR", (ftnlen)36, (ftnlen)16); - bltcod[199] = -27; - s_copy(bltnam + 7164, "VK1", (ftnlen)36, (ftnlen)3); - bltcod[200] = -27; - s_copy(bltnam + 7200, "VIKING 1 ORBITER", (ftnlen)36, (ftnlen)16); - bltcod[201] = -29; - s_copy(bltnam + 7236, "STARDUST", (ftnlen)36, (ftnlen)8); - bltcod[202] = -29; - s_copy(bltnam + 7272, "SDU", (ftnlen)36, (ftnlen)3); - bltcod[203] = -29; - s_copy(bltnam + 7308, "NEXT", (ftnlen)36, (ftnlen)4); - bltcod[204] = -30; - s_copy(bltnam + 7344, "VK2", (ftnlen)36, (ftnlen)3); - bltcod[205] = -30; - s_copy(bltnam + 7380, "VIKING 2 ORBITER", (ftnlen)36, (ftnlen)16); - bltcod[206] = -30; - s_copy(bltnam + 7416, "DS-1", (ftnlen)36, (ftnlen)4); - bltcod[207] = -31; - s_copy(bltnam + 7452, "VG1", (ftnlen)36, (ftnlen)3); - bltcod[208] = -31; - s_copy(bltnam + 7488, "VOYAGER 1", (ftnlen)36, (ftnlen)9); - bltcod[209] = -32; - s_copy(bltnam + 7524, "VG2", (ftnlen)36, (ftnlen)3); - bltcod[210] = -32; - s_copy(bltnam + 7560, "VOYAGER 2", (ftnlen)36, (ftnlen)9); - bltcod[211] = -40; - s_copy(bltnam + 7596, "CLEMENTINE", (ftnlen)36, (ftnlen)10); - bltcod[212] = -41; - s_copy(bltnam + 7632, "MEX", (ftnlen)36, (ftnlen)3); - bltcod[213] = -41; - s_copy(bltnam + 7668, "MARS EXPRESS", (ftnlen)36, (ftnlen)12); - bltcod[214] = -44; - s_copy(bltnam + 7704, "BEAGLE2", (ftnlen)36, (ftnlen)7); - bltcod[215] = -44; - s_copy(bltnam + 7740, "BEAGLE 2", (ftnlen)36, (ftnlen)8); - bltcod[216] = -46; - s_copy(bltnam + 7776, "MS-T5", (ftnlen)36, (ftnlen)5); - bltcod[217] = -46; - s_copy(bltnam + 7812, "SAKIGAKE", (ftnlen)36, (ftnlen)8); - bltcod[218] = -47; - s_copy(bltnam + 7848, "PLANET-A", (ftnlen)36, (ftnlen)8); - bltcod[219] = -47; - s_copy(bltnam + 7884, "SUISEI", (ftnlen)36, (ftnlen)6); - bltcod[220] = -47; - s_copy(bltnam + 7920, "GNS", (ftnlen)36, (ftnlen)3); - bltcod[221] = -47; - s_copy(bltnam + 7956, "GENESIS", (ftnlen)36, (ftnlen)7); - bltcod[222] = -48; - s_copy(bltnam + 7992, "HUBBLE SPACE TELESCOPE", (ftnlen)36, (ftnlen)22); - bltcod[223] = -48; - s_copy(bltnam + 8028, "HST", (ftnlen)36, (ftnlen)3); - bltcod[224] = -53; - s_copy(bltnam + 8064, "MARS PATHFINDER", (ftnlen)36, (ftnlen)15); - bltcod[225] = -53; - s_copy(bltnam + 8100, "MPF", (ftnlen)36, (ftnlen)3); - bltcod[226] = -53; - s_copy(bltnam + 8136, "MARS ODYSSEY", (ftnlen)36, (ftnlen)12); - bltcod[227] = -53; - s_copy(bltnam + 8172, "MARS SURVEYOR 01 ORBITER", (ftnlen)36, (ftnlen)24); - bltcod[228] = -55; - s_copy(bltnam + 8208, "ULYSSES", (ftnlen)36, (ftnlen)7); - bltcod[229] = -58; - s_copy(bltnam + 8244, "VSOP", (ftnlen)36, (ftnlen)4); - bltcod[230] = -58; - s_copy(bltnam + 8280, "HALCA", (ftnlen)36, (ftnlen)5); - bltcod[231] = -59; - s_copy(bltnam + 8316, "RADIOASTRON", (ftnlen)36, (ftnlen)11); - bltcod[232] = -61; - s_copy(bltnam + 8352, "JUNO", (ftnlen)36, (ftnlen)4); - bltcod[233] = -66; - s_copy(bltnam + 8388, "VEGA 1", (ftnlen)36, (ftnlen)6); - bltcod[234] = -67; - s_copy(bltnam + 8424, "VEGA 2", (ftnlen)36, (ftnlen)6); - bltcod[235] = -68; - s_copy(bltnam + 8460, "MMO", (ftnlen)36, (ftnlen)3); - bltcod[236] = -68; - s_copy(bltnam + 8496, "MERCURY MAGNETOSPHERIC ORBITER", (ftnlen)36, ( - ftnlen)30); - bltcod[237] = -69; - s_copy(bltnam + 8532, "MPO", (ftnlen)36, (ftnlen)3); - bltcod[238] = -69; - s_copy(bltnam + 8568, "MERCURY PLANETARY ORBITER", (ftnlen)36, (ftnlen)25) - ; - bltcod[239] = -70; - s_copy(bltnam + 8604, "DEEP IMPACT IMPACTOR SPACECRAFT", (ftnlen)36, ( - ftnlen)31); - bltcod[240] = -74; - s_copy(bltnam + 8640, "MRO", (ftnlen)36, (ftnlen)3); - bltcod[241] = -74; - s_copy(bltnam + 8676, "MARS RECON ORBITER", (ftnlen)36, (ftnlen)18); - bltcod[242] = -76; - s_copy(bltnam + 8712, "MSL", (ftnlen)36, (ftnlen)3); - bltcod[243] = -76; - s_copy(bltnam + 8748, "MARS SCIENCE LABORATORY", (ftnlen)36, (ftnlen)23); - bltcod[244] = -77; - s_copy(bltnam + 8784, "GLL", (ftnlen)36, (ftnlen)3); - bltcod[245] = -77; - s_copy(bltnam + 8820, "GALILEO ORBITER", (ftnlen)36, (ftnlen)15); - bltcod[246] = -78; - s_copy(bltnam + 8856, "GIOTTO", (ftnlen)36, (ftnlen)6); - bltcod[247] = -79; - s_copy(bltnam + 8892, "SPITZER", (ftnlen)36, (ftnlen)7); - bltcod[248] = -79; - s_copy(bltnam + 8928, "SPACE INFRARED TELESCOPE FACILITY", (ftnlen)36, ( - ftnlen)33); - bltcod[249] = -79; - s_copy(bltnam + 8964, "SIRTF", (ftnlen)36, (ftnlen)5); - bltcod[250] = -81; - s_copy(bltnam + 9000, "CASSINI ITL", (ftnlen)36, (ftnlen)11); - bltcod[251] = -82; - s_copy(bltnam + 9036, "CAS", (ftnlen)36, (ftnlen)3); - bltcod[252] = -82; - s_copy(bltnam + 9072, "CASSINI", (ftnlen)36, (ftnlen)7); - bltcod[253] = -84; - s_copy(bltnam + 9108, "PHOENIX", (ftnlen)36, (ftnlen)7); - bltcod[254] = -85; - s_copy(bltnam + 9144, "LRO", (ftnlen)36, (ftnlen)3); - bltcod[255] = -85; - s_copy(bltnam + 9180, "LUNAR RECON ORBITER", (ftnlen)36, (ftnlen)19); - bltcod[256] = -85; - s_copy(bltnam + 9216, "LUNAR RECONNAISSANCE ORBITER", (ftnlen)36, (ftnlen) - 28); - bltcod[257] = -86; - s_copy(bltnam + 9252, "CH1", (ftnlen)36, (ftnlen)3); - bltcod[258] = -86; - s_copy(bltnam + 9288, "CHANDRAYAAN-1", (ftnlen)36, (ftnlen)13); - bltcod[259] = -90; - s_copy(bltnam + 9324, "CASSINI SIMULATION", (ftnlen)36, (ftnlen)18); - bltcod[260] = -93; - s_copy(bltnam + 9360, "NEAR EARTH ASTEROID RENDEZVOUS", (ftnlen)36, ( - ftnlen)30); - bltcod[261] = -93; - s_copy(bltnam + 9396, "NEAR", (ftnlen)36, (ftnlen)4); - bltcod[262] = -94; - s_copy(bltnam + 9432, "MO", (ftnlen)36, (ftnlen)2); - bltcod[263] = -94; - s_copy(bltnam + 9468, "MARS OBSERVER", (ftnlen)36, (ftnlen)13); - bltcod[264] = -94; - s_copy(bltnam + 9504, "MGS", (ftnlen)36, (ftnlen)3); - bltcod[265] = -94; - s_copy(bltnam + 9540, "MARS GLOBAL SURVEYOR", (ftnlen)36, (ftnlen)20); - bltcod[266] = -95; - s_copy(bltnam + 9576, "MGS SIMULATION", (ftnlen)36, (ftnlen)14); - bltcod[267] = -97; - s_copy(bltnam + 9612, "TOPEX/POSEIDON", (ftnlen)36, (ftnlen)14); - bltcod[268] = -98; - s_copy(bltnam + 9648, "NEW HORIZONS", (ftnlen)36, (ftnlen)12); - bltcod[269] = -107; - s_copy(bltnam + 9684, "TROPICAL RAINFALL MEASURING MISSION", (ftnlen)36, ( - ftnlen)35); - bltcod[270] = -107; - s_copy(bltnam + 9720, "TRMM", (ftnlen)36, (ftnlen)4); - bltcod[271] = -112; - s_copy(bltnam + 9756, "ICE", (ftnlen)36, (ftnlen)3); - bltcod[272] = -116; - s_copy(bltnam + 9792, "MARS POLAR LANDER", (ftnlen)36, (ftnlen)17); - bltcod[273] = -116; - s_copy(bltnam + 9828, "MPL", (ftnlen)36, (ftnlen)3); - bltcod[274] = -121; - s_copy(bltnam + 9864, "BEPICOLOMBO", (ftnlen)36, (ftnlen)11); - bltcod[275] = -127; - s_copy(bltnam + 9900, "MARS CLIMATE ORBITER", (ftnlen)36, (ftnlen)20); - bltcod[276] = -127; - s_copy(bltnam + 9936, "MCO", (ftnlen)36, (ftnlen)3); - bltcod[277] = -130; - s_copy(bltnam + 9972, "MUSES-C", (ftnlen)36, (ftnlen)7); - bltcod[278] = -130; - s_copy(bltnam + 10008, "HAYABUSA", (ftnlen)36, (ftnlen)8); - bltcod[279] = -131; - s_copy(bltnam + 10044, "SELENE", (ftnlen)36, (ftnlen)6); - bltcod[280] = -131; - s_copy(bltnam + 10080, "KAGUYA", (ftnlen)36, (ftnlen)6); - bltcod[281] = -135; - s_copy(bltnam + 10116, "DRTS-W", (ftnlen)36, (ftnlen)6); - bltcod[282] = -140; - s_copy(bltnam + 10152, "EPOCH", (ftnlen)36, (ftnlen)5); - bltcod[283] = -140; - s_copy(bltnam + 10188, "DIXI", (ftnlen)36, (ftnlen)4); - bltcod[284] = -140; - s_copy(bltnam + 10224, "EPOXI", (ftnlen)36, (ftnlen)5); - bltcod[285] = -140; - s_copy(bltnam + 10260, "DEEP IMPACT FLYBY SPACECRAFT", (ftnlen)36, ( - ftnlen)28); - bltcod[286] = -142; - s_copy(bltnam + 10296, "TERRA", (ftnlen)36, (ftnlen)5); - bltcod[287] = -142; - s_copy(bltnam + 10332, "EOS-AM1", (ftnlen)36, (ftnlen)7); - bltcod[288] = -146; - s_copy(bltnam + 10368, "LUNAR-A", (ftnlen)36, (ftnlen)7); - bltcod[289] = -150; - s_copy(bltnam + 10404, "CASSINI PROBE", (ftnlen)36, (ftnlen)13); - bltcod[290] = -150; - s_copy(bltnam + 10440, "HUYGENS PROBE", (ftnlen)36, (ftnlen)13); - bltcod[291] = -150; - s_copy(bltnam + 10476, "CASP", (ftnlen)36, (ftnlen)4); - bltcod[292] = -151; - s_copy(bltnam + 10512, "AXAF", (ftnlen)36, (ftnlen)4); - bltcod[293] = -151; - s_copy(bltnam + 10548, "CHANDRA", (ftnlen)36, (ftnlen)7); - bltcod[294] = -154; - s_copy(bltnam + 10584, "AQUA", (ftnlen)36, (ftnlen)4); - bltcod[295] = -159; - s_copy(bltnam + 10620, "EUROPA ORBITER", (ftnlen)36, (ftnlen)14); - bltcod[296] = -164; - s_copy(bltnam + 10656, "YOHKOH", (ftnlen)36, (ftnlen)6); - bltcod[297] = -164; - s_copy(bltnam + 10692, "SOLAR-A", (ftnlen)36, (ftnlen)7); - bltcod[298] = -165; - s_copy(bltnam + 10728, "MAP", (ftnlen)36, (ftnlen)3); - bltcod[299] = -166; - s_copy(bltnam + 10764, "IMAGE", (ftnlen)36, (ftnlen)5); - bltcod[300] = -177; - s_copy(bltnam + 10800, "GRAIL-A", (ftnlen)36, (ftnlen)7); - bltcod[301] = -178; - s_copy(bltnam + 10836, "PLANET-B", (ftnlen)36, (ftnlen)8); - bltcod[302] = -178; - s_copy(bltnam + 10872, "NOZOMI", (ftnlen)36, (ftnlen)6); - bltcod[303] = -181; - s_copy(bltnam + 10908, "GRAIL-B", (ftnlen)36, (ftnlen)7); - bltcod[304] = -183; - s_copy(bltnam + 10944, "CLUSTER 1", (ftnlen)36, (ftnlen)9); - bltcod[305] = -185; - s_copy(bltnam + 10980, "CLUSTER 2", (ftnlen)36, (ftnlen)9); - bltcod[306] = -187; - s_copy(bltnam + 11016, "SOLAR PROBE", (ftnlen)36, (ftnlen)11); - bltcod[307] = -188; - s_copy(bltnam + 11052, "MUSES-B", (ftnlen)36, (ftnlen)7); - bltcod[308] = -190; - s_copy(bltnam + 11088, "SIM", (ftnlen)36, (ftnlen)3); - bltcod[309] = -194; - s_copy(bltnam + 11124, "CLUSTER 3", (ftnlen)36, (ftnlen)9); - bltcod[310] = -196; - s_copy(bltnam + 11160, "CLUSTER 4", (ftnlen)36, (ftnlen)9); - bltcod[311] = -198; - s_copy(bltnam + 11196, "INTEGRAL", (ftnlen)36, (ftnlen)8); - bltcod[312] = -200; - s_copy(bltnam + 11232, "CONTOUR", (ftnlen)36, (ftnlen)7); - bltcod[313] = -202; - s_copy(bltnam + 11268, "MAVEN", (ftnlen)36, (ftnlen)5); - bltcod[314] = -203; - s_copy(bltnam + 11304, "DAWN", (ftnlen)36, (ftnlen)4); - bltcod[315] = -205; - s_copy(bltnam + 11340, "SOIL MOISTURE ACTIVE AND PASSIVE", (ftnlen)36, ( - ftnlen)32); - bltcod[316] = -205; - s_copy(bltnam + 11376, "SMAP", (ftnlen)36, (ftnlen)4); - bltcod[317] = -212; - s_copy(bltnam + 11412, "STV51", (ftnlen)36, (ftnlen)5); - bltcod[318] = -213; - s_copy(bltnam + 11448, "STV52", (ftnlen)36, (ftnlen)5); - bltcod[319] = -214; - s_copy(bltnam + 11484, "STV53", (ftnlen)36, (ftnlen)5); - bltcod[320] = -226; - s_copy(bltnam + 11520, "ROSETTA", (ftnlen)36, (ftnlen)7); - bltcod[321] = -227; - s_copy(bltnam + 11556, "KEPLER", (ftnlen)36, (ftnlen)6); - bltcod[322] = -228; - s_copy(bltnam + 11592, "GLL PROBE", (ftnlen)36, (ftnlen)9); - bltcod[323] = -228; - s_copy(bltnam + 11628, "GALILEO PROBE", (ftnlen)36, (ftnlen)13); - bltcod[324] = -234; - s_copy(bltnam + 11664, "STEREO AHEAD", (ftnlen)36, (ftnlen)12); - bltcod[325] = -235; - s_copy(bltnam + 11700, "STEREO BEHIND", (ftnlen)36, (ftnlen)13); - bltcod[326] = -236; - s_copy(bltnam + 11736, "MESSENGER", (ftnlen)36, (ftnlen)9); - bltcod[327] = -238; - s_copy(bltnam + 11772, "SMART1", (ftnlen)36, (ftnlen)6); - bltcod[328] = -238; - s_copy(bltnam + 11808, "SM1", (ftnlen)36, (ftnlen)3); - bltcod[329] = -238; - s_copy(bltnam + 11844, "S1", (ftnlen)36, (ftnlen)2); - bltcod[330] = -238; - s_copy(bltnam + 11880, "SMART-1", (ftnlen)36, (ftnlen)7); - bltcod[331] = -248; - s_copy(bltnam + 11916, "VEX", (ftnlen)36, (ftnlen)3); - bltcod[332] = -248; - s_copy(bltnam + 11952, "VENUS EXPRESS", (ftnlen)36, (ftnlen)13); - bltcod[333] = -253; - s_copy(bltnam + 11988, "OPPORTUNITY", (ftnlen)36, (ftnlen)11); - bltcod[334] = -253; - s_copy(bltnam + 12024, "MER-1", (ftnlen)36, (ftnlen)5); - bltcod[335] = -254; - s_copy(bltnam + 12060, "SPIRIT", (ftnlen)36, (ftnlen)6); - bltcod[336] = -254; - s_copy(bltnam + 12096, "MER-2", (ftnlen)36, (ftnlen)5); - bltcod[337] = -362; - s_copy(bltnam + 12132, "RADIATION BELT STORM PROBE A", (ftnlen)36, ( - ftnlen)28); - bltcod[338] = -362; - s_copy(bltnam + 12168, "RBSP_A", (ftnlen)36, (ftnlen)6); - bltcod[339] = -363; - s_copy(bltnam + 12204, "RADIATION BELT STORM PROBE B", (ftnlen)36, ( - ftnlen)28); - bltcod[340] = -363; - s_copy(bltnam + 12240, "RBSP_B", (ftnlen)36, (ftnlen)6); - bltcod[341] = -486; - s_copy(bltnam + 12276, "HERSCHEL", (ftnlen)36, (ftnlen)8); - bltcod[342] = -489; - s_copy(bltnam + 12312, "PLANCK", (ftnlen)36, (ftnlen)6); - bltcod[343] = -500; - s_copy(bltnam + 12348, "RSAT", (ftnlen)36, (ftnlen)4); - bltcod[344] = -500; - s_copy(bltnam + 12384, "SELENE Relay Satellite", (ftnlen)36, (ftnlen)22); - bltcod[345] = -500; - s_copy(bltnam + 12420, "SELENE Rstar", (ftnlen)36, (ftnlen)12); - bltcod[346] = -500; - s_copy(bltnam + 12456, "Rstar", (ftnlen)36, (ftnlen)5); - bltcod[347] = -502; - s_copy(bltnam + 12492, "VSAT", (ftnlen)36, (ftnlen)4); - bltcod[348] = -502; - s_copy(bltnam + 12528, "SELENE VLBI Radio Satellite", (ftnlen)36, (ftnlen) - 27); - bltcod[349] = -502; - s_copy(bltnam + 12564, "SELENE VRAD Satellite", (ftnlen)36, (ftnlen)21); - bltcod[350] = -502; - s_copy(bltnam + 12600, "SELENE Vstar", (ftnlen)36, (ftnlen)12); - bltcod[351] = -502; - s_copy(bltnam + 12636, "Vstar", (ftnlen)36, (ftnlen)5); - bltcod[352] = -550; - s_copy(bltnam + 12672, "MARS-96", (ftnlen)36, (ftnlen)7); - bltcod[353] = -550; - s_copy(bltnam + 12708, "M96", (ftnlen)36, (ftnlen)3); - bltcod[354] = -550; - s_copy(bltnam + 12744, "MARS 96", (ftnlen)36, (ftnlen)7); - bltcod[355] = -550; - s_copy(bltnam + 12780, "MARS96", (ftnlen)36, (ftnlen)6); - bltcod[356] = 50000001; - s_copy(bltnam + 12816, "SHOEMAKER-LEVY 9-W", (ftnlen)36, (ftnlen)18); - bltcod[357] = 50000002; - s_copy(bltnam + 12852, "SHOEMAKER-LEVY 9-V", (ftnlen)36, (ftnlen)18); - bltcod[358] = 50000003; - s_copy(bltnam + 12888, "SHOEMAKER-LEVY 9-U", (ftnlen)36, (ftnlen)18); - bltcod[359] = 50000004; - s_copy(bltnam + 12924, "SHOEMAKER-LEVY 9-T", (ftnlen)36, (ftnlen)18); - bltcod[360] = 50000005; - s_copy(bltnam + 12960, "SHOEMAKER-LEVY 9-S", (ftnlen)36, (ftnlen)18); - bltcod[361] = 50000006; - s_copy(bltnam + 12996, "SHOEMAKER-LEVY 9-R", (ftnlen)36, (ftnlen)18); - bltcod[362] = 50000007; - s_copy(bltnam + 13032, "SHOEMAKER-LEVY 9-Q", (ftnlen)36, (ftnlen)18); - bltcod[363] = 50000008; - s_copy(bltnam + 13068, "SHOEMAKER-LEVY 9-P", (ftnlen)36, (ftnlen)18); - bltcod[364] = 50000009; - s_copy(bltnam + 13104, "SHOEMAKER-LEVY 9-N", (ftnlen)36, (ftnlen)18); - bltcod[365] = 50000010; - s_copy(bltnam + 13140, "SHOEMAKER-LEVY 9-M", (ftnlen)36, (ftnlen)18); - bltcod[366] = 50000011; - s_copy(bltnam + 13176, "SHOEMAKER-LEVY 9-L", (ftnlen)36, (ftnlen)18); - bltcod[367] = 50000012; - s_copy(bltnam + 13212, "SHOEMAKER-LEVY 9-K", (ftnlen)36, (ftnlen)18); - bltcod[368] = 50000013; - s_copy(bltnam + 13248, "SHOEMAKER-LEVY 9-J", (ftnlen)36, (ftnlen)18); - bltcod[369] = 50000014; - s_copy(bltnam + 13284, "SHOEMAKER-LEVY 9-H", (ftnlen)36, (ftnlen)18); - bltcod[370] = 50000015; - s_copy(bltnam + 13320, "SHOEMAKER-LEVY 9-G", (ftnlen)36, (ftnlen)18); - bltcod[371] = 50000016; - s_copy(bltnam + 13356, "SHOEMAKER-LEVY 9-F", (ftnlen)36, (ftnlen)18); - bltcod[372] = 50000017; - s_copy(bltnam + 13392, "SHOEMAKER-LEVY 9-E", (ftnlen)36, (ftnlen)18); - bltcod[373] = 50000018; - s_copy(bltnam + 13428, "SHOEMAKER-LEVY 9-D", (ftnlen)36, (ftnlen)18); - bltcod[374] = 50000019; - s_copy(bltnam + 13464, "SHOEMAKER-LEVY 9-C", (ftnlen)36, (ftnlen)18); - bltcod[375] = 50000020; - s_copy(bltnam + 13500, "SHOEMAKER-LEVY 9-B", (ftnlen)36, (ftnlen)18); - bltcod[376] = 50000021; - s_copy(bltnam + 13536, "SHOEMAKER-LEVY 9-A", (ftnlen)36, (ftnlen)18); - bltcod[377] = 50000022; - s_copy(bltnam + 13572, "SHOEMAKER-LEVY 9-Q1", (ftnlen)36, (ftnlen)19); - bltcod[378] = 50000023; - s_copy(bltnam + 13608, "SHOEMAKER-LEVY 9-P2", (ftnlen)36, (ftnlen)19); - bltcod[379] = 1000001; - s_copy(bltnam + 13644, "AREND", (ftnlen)36, (ftnlen)5); - bltcod[380] = 1000002; - s_copy(bltnam + 13680, "AREND-RIGAUX", (ftnlen)36, (ftnlen)12); - bltcod[381] = 1000003; - s_copy(bltnam + 13716, "ASHBROOK-JACKSON", (ftnlen)36, (ftnlen)16); - bltcod[382] = 1000004; - s_copy(bltnam + 13752, "BOETHIN", (ftnlen)36, (ftnlen)7); - bltcod[383] = 1000005; - s_copy(bltnam + 13788, "BORRELLY", (ftnlen)36, (ftnlen)8); - bltcod[384] = 1000006; - s_copy(bltnam + 13824, "BOWELL-SKIFF", (ftnlen)36, (ftnlen)12); - bltcod[385] = 1000007; - s_copy(bltnam + 13860, "BRADFIELD", (ftnlen)36, (ftnlen)9); - bltcod[386] = 1000008; - s_copy(bltnam + 13896, "BROOKS 2", (ftnlen)36, (ftnlen)8); - bltcod[387] = 1000009; - s_copy(bltnam + 13932, "BRORSEN-METCALF", (ftnlen)36, (ftnlen)15); - bltcod[388] = 1000010; - s_copy(bltnam + 13968, "BUS", (ftnlen)36, (ftnlen)3); - bltcod[389] = 1000011; - s_copy(bltnam + 14004, "CHERNYKH", (ftnlen)36, (ftnlen)8); - bltcod[390] = 1000012; - s_copy(bltnam + 14040, "67P/CHURYUMOV-GERASIMENKO (1969 R1)", (ftnlen)36, - (ftnlen)35); - bltcod[391] = 1000012; - s_copy(bltnam + 14076, "CHURYUMOV-GERASIMENKO", (ftnlen)36, (ftnlen)21); - bltcod[392] = 1000013; - s_copy(bltnam + 14112, "CIFFREO", (ftnlen)36, (ftnlen)7); - bltcod[393] = 1000014; - s_copy(bltnam + 14148, "CLARK", (ftnlen)36, (ftnlen)5); - bltcod[394] = 1000015; - s_copy(bltnam + 14184, "COMAS SOLA", (ftnlen)36, (ftnlen)10); - bltcod[395] = 1000016; - s_copy(bltnam + 14220, "CROMMELIN", (ftnlen)36, (ftnlen)9); - bltcod[396] = 1000017; - s_copy(bltnam + 14256, "D'ARREST", (ftnlen)36, (ftnlen)8); - bltcod[397] = 1000018; - s_copy(bltnam + 14292, "DANIEL", (ftnlen)36, (ftnlen)6); - bltcod[398] = 1000019; - s_copy(bltnam + 14328, "DE VICO-SWIFT", (ftnlen)36, (ftnlen)13); - bltcod[399] = 1000020; - s_copy(bltnam + 14364, "DENNING-FUJIKAWA", (ftnlen)36, (ftnlen)16); - bltcod[400] = 1000021; - s_copy(bltnam + 14400, "DU TOIT 1", (ftnlen)36, (ftnlen)9); - bltcod[401] = 1000022; - s_copy(bltnam + 14436, "DU TOIT-HARTLEY", (ftnlen)36, (ftnlen)15); - bltcod[402] = 1000023; - s_copy(bltnam + 14472, "DUTOIT-NEUJMIN-DELPORTE", (ftnlen)36, (ftnlen)23); - bltcod[403] = 1000024; - s_copy(bltnam + 14508, "DUBIAGO", (ftnlen)36, (ftnlen)7); - bltcod[404] = 1000025; - s_copy(bltnam + 14544, "ENCKE", (ftnlen)36, (ftnlen)5); - bltcod[405] = 1000026; - s_copy(bltnam + 14580, "FAYE", (ftnlen)36, (ftnlen)4); - bltcod[406] = 1000027; - s_copy(bltnam + 14616, "FINLAY", (ftnlen)36, (ftnlen)6); - bltcod[407] = 1000028; - s_copy(bltnam + 14652, "FORBES", (ftnlen)36, (ftnlen)6); - bltcod[408] = 1000029; - s_copy(bltnam + 14688, "GEHRELS 1", (ftnlen)36, (ftnlen)9); - bltcod[409] = 1000030; - s_copy(bltnam + 14724, "GEHRELS 2", (ftnlen)36, (ftnlen)9); - bltcod[410] = 1000031; - s_copy(bltnam + 14760, "GEHRELS 3", (ftnlen)36, (ftnlen)9); - bltcod[411] = 1000032; - s_copy(bltnam + 14796, "GIACOBINI-ZINNER", (ftnlen)36, (ftnlen)16); - bltcod[412] = 1000033; - s_copy(bltnam + 14832, "GICLAS", (ftnlen)36, (ftnlen)6); - bltcod[413] = 1000034; - s_copy(bltnam + 14868, "GRIGG-SKJELLERUP", (ftnlen)36, (ftnlen)16); - bltcod[414] = 1000035; - s_copy(bltnam + 14904, "GUNN", (ftnlen)36, (ftnlen)4); - bltcod[415] = 1000036; - s_copy(bltnam + 14940, "HALLEY", (ftnlen)36, (ftnlen)6); - bltcod[416] = 1000037; - s_copy(bltnam + 14976, "HANEDA-CAMPOS", (ftnlen)36, (ftnlen)13); - bltcod[417] = 1000038; - s_copy(bltnam + 15012, "HARRINGTON", (ftnlen)36, (ftnlen)10); - bltcod[418] = 1000039; - s_copy(bltnam + 15048, "HARRINGTON-ABELL", (ftnlen)36, (ftnlen)16); - bltcod[419] = 1000040; - s_copy(bltnam + 15084, "HARTLEY 1", (ftnlen)36, (ftnlen)9); - bltcod[420] = 1000041; - s_copy(bltnam + 15120, "HARTLEY 2", (ftnlen)36, (ftnlen)9); - bltcod[421] = 1000042; - s_copy(bltnam + 15156, "HARTLEY-IRAS", (ftnlen)36, (ftnlen)12); - bltcod[422] = 1000043; - s_copy(bltnam + 15192, "HERSCHEL-RIGOLLET", (ftnlen)36, (ftnlen)17); - bltcod[423] = 1000044; - s_copy(bltnam + 15228, "HOLMES", (ftnlen)36, (ftnlen)6); - bltcod[424] = 1000045; - s_copy(bltnam + 15264, "HONDA-MRKOS-PAJDUSAKOVA", (ftnlen)36, (ftnlen)23); - bltcod[425] = 1000046; - s_copy(bltnam + 15300, "HOWELL", (ftnlen)36, (ftnlen)6); - bltcod[426] = 1000047; - s_copy(bltnam + 15336, "IRAS", (ftnlen)36, (ftnlen)4); - bltcod[427] = 1000048; - s_copy(bltnam + 15372, "JACKSON-NEUJMIN", (ftnlen)36, (ftnlen)15); - bltcod[428] = 1000049; - s_copy(bltnam + 15408, "JOHNSON", (ftnlen)36, (ftnlen)7); - bltcod[429] = 1000050; - s_copy(bltnam + 15444, "KEARNS-KWEE", (ftnlen)36, (ftnlen)11); - bltcod[430] = 1000051; - s_copy(bltnam + 15480, "KLEMOLA", (ftnlen)36, (ftnlen)7); - bltcod[431] = 1000052; - s_copy(bltnam + 15516, "KOHOUTEK", (ftnlen)36, (ftnlen)8); - bltcod[432] = 1000053; - s_copy(bltnam + 15552, "KOJIMA", (ftnlen)36, (ftnlen)6); - bltcod[433] = 1000054; - s_copy(bltnam + 15588, "KOPFF", (ftnlen)36, (ftnlen)5); - bltcod[434] = 1000055; - s_copy(bltnam + 15624, "KOWAL 1", (ftnlen)36, (ftnlen)7); - bltcod[435] = 1000056; - s_copy(bltnam + 15660, "KOWAL 2", (ftnlen)36, (ftnlen)7); - bltcod[436] = 1000057; - s_copy(bltnam + 15696, "KOWAL-MRKOS", (ftnlen)36, (ftnlen)11); - bltcod[437] = 1000058; - s_copy(bltnam + 15732, "KOWAL-VAVROVA", (ftnlen)36, (ftnlen)13); - bltcod[438] = 1000059; - s_copy(bltnam + 15768, "LONGMORE", (ftnlen)36, (ftnlen)8); - bltcod[439] = 1000060; - s_copy(bltnam + 15804, "LOVAS 1", (ftnlen)36, (ftnlen)7); - bltcod[440] = 1000061; - s_copy(bltnam + 15840, "MACHHOLZ", (ftnlen)36, (ftnlen)8); - bltcod[441] = 1000062; - s_copy(bltnam + 15876, "MAURY", (ftnlen)36, (ftnlen)5); - bltcod[442] = 1000063; - s_copy(bltnam + 15912, "NEUJMIN 1", (ftnlen)36, (ftnlen)9); - bltcod[443] = 1000064; - s_copy(bltnam + 15948, "NEUJMIN 2", (ftnlen)36, (ftnlen)9); - bltcod[444] = 1000065; - s_copy(bltnam + 15984, "NEUJMIN 3", (ftnlen)36, (ftnlen)9); - bltcod[445] = 1000066; - s_copy(bltnam + 16020, "OLBERS", (ftnlen)36, (ftnlen)6); - bltcod[446] = 1000067; - s_copy(bltnam + 16056, "PETERS-HARTLEY", (ftnlen)36, (ftnlen)14); - bltcod[447] = 1000068; - s_copy(bltnam + 16092, "PONS-BROOKS", (ftnlen)36, (ftnlen)11); - bltcod[448] = 1000069; - s_copy(bltnam + 16128, "PONS-WINNECKE", (ftnlen)36, (ftnlen)13); - bltcod[449] = 1000070; - s_copy(bltnam + 16164, "REINMUTH 1", (ftnlen)36, (ftnlen)10); - bltcod[450] = 1000071; - s_copy(bltnam + 16200, "REINMUTH 2", (ftnlen)36, (ftnlen)10); - bltcod[451] = 1000072; - s_copy(bltnam + 16236, "RUSSELL 1", (ftnlen)36, (ftnlen)9); - bltcod[452] = 1000073; - s_copy(bltnam + 16272, "RUSSELL 2", (ftnlen)36, (ftnlen)9); - bltcod[453] = 1000074; - s_copy(bltnam + 16308, "RUSSELL 3", (ftnlen)36, (ftnlen)9); - bltcod[454] = 1000075; - s_copy(bltnam + 16344, "RUSSELL 4", (ftnlen)36, (ftnlen)9); - bltcod[455] = 1000076; - s_copy(bltnam + 16380, "SANGUIN", (ftnlen)36, (ftnlen)7); - bltcod[456] = 1000077; - s_copy(bltnam + 16416, "SCHAUMASSE", (ftnlen)36, (ftnlen)10); - bltcod[457] = 1000078; - s_copy(bltnam + 16452, "SCHUSTER", (ftnlen)36, (ftnlen)8); - bltcod[458] = 1000079; - s_copy(bltnam + 16488, "SCHWASSMANN-WACHMANN 1", (ftnlen)36, (ftnlen)22); - bltcod[459] = 1000080; - s_copy(bltnam + 16524, "SCHWASSMANN-WACHMANN 2", (ftnlen)36, (ftnlen)22); - bltcod[460] = 1000081; - s_copy(bltnam + 16560, "SCHWASSMANN-WACHMANN 3", (ftnlen)36, (ftnlen)22); - bltcod[461] = 1000082; - s_copy(bltnam + 16596, "SHAJN-SCHALDACH", (ftnlen)36, (ftnlen)15); - bltcod[462] = 1000083; - s_copy(bltnam + 16632, "SHOEMAKER 1", (ftnlen)36, (ftnlen)11); - bltcod[463] = 1000084; - s_copy(bltnam + 16668, "SHOEMAKER 2", (ftnlen)36, (ftnlen)11); - bltcod[464] = 1000085; - s_copy(bltnam + 16704, "SHOEMAKER 3", (ftnlen)36, (ftnlen)11); - bltcod[465] = 1000086; - s_copy(bltnam + 16740, "SINGER-BREWSTER", (ftnlen)36, (ftnlen)15); - bltcod[466] = 1000087; - s_copy(bltnam + 16776, "SLAUGHTER-BURNHAM", (ftnlen)36, (ftnlen)17); - bltcod[467] = 1000088; - s_copy(bltnam + 16812, "SMIRNOVA-CHERNYKH", (ftnlen)36, (ftnlen)17); - bltcod[468] = 1000089; - s_copy(bltnam + 16848, "STEPHAN-OTERMA", (ftnlen)36, (ftnlen)14); - bltcod[469] = 1000090; - s_copy(bltnam + 16884, "SWIFT-GEHRELS", (ftnlen)36, (ftnlen)13); - bltcod[470] = 1000091; - s_copy(bltnam + 16920, "TAKAMIZAWA", (ftnlen)36, (ftnlen)10); - bltcod[471] = 1000092; - s_copy(bltnam + 16956, "TAYLOR", (ftnlen)36, (ftnlen)6); - bltcod[472] = 1000093; - s_copy(bltnam + 16992, "TEMPEL_1", (ftnlen)36, (ftnlen)8); - bltcod[473] = 1000093; - s_copy(bltnam + 17028, "TEMPEL 1", (ftnlen)36, (ftnlen)8); - bltcod[474] = 1000094; - s_copy(bltnam + 17064, "TEMPEL 2", (ftnlen)36, (ftnlen)8); - bltcod[475] = 1000095; - s_copy(bltnam + 17100, "TEMPEL-TUTTLE", (ftnlen)36, (ftnlen)13); - bltcod[476] = 1000096; - s_copy(bltnam + 17136, "TRITTON", (ftnlen)36, (ftnlen)7); - bltcod[477] = 1000097; - s_copy(bltnam + 17172, "TSUCHINSHAN 1", (ftnlen)36, (ftnlen)13); - bltcod[478] = 1000098; - s_copy(bltnam + 17208, "TSUCHINSHAN 2", (ftnlen)36, (ftnlen)13); - bltcod[479] = 1000099; - s_copy(bltnam + 17244, "TUTTLE", (ftnlen)36, (ftnlen)6); - bltcod[480] = 1000100; - s_copy(bltnam + 17280, "TUTTLE-GIACOBINI-KRESAK", (ftnlen)36, (ftnlen)23); - bltcod[481] = 1000101; - s_copy(bltnam + 17316, "VAISALA 1", (ftnlen)36, (ftnlen)9); - bltcod[482] = 1000102; - s_copy(bltnam + 17352, "VAN BIESBROECK", (ftnlen)36, (ftnlen)14); - bltcod[483] = 1000103; - s_copy(bltnam + 17388, "VAN HOUTEN", (ftnlen)36, (ftnlen)10); - bltcod[484] = 1000104; - s_copy(bltnam + 17424, "WEST-KOHOUTEK-IKEMURA", (ftnlen)36, (ftnlen)21); - bltcod[485] = 1000105; - s_copy(bltnam + 17460, "WHIPPLE", (ftnlen)36, (ftnlen)7); - bltcod[486] = 1000106; - s_copy(bltnam + 17496, "WILD 1", (ftnlen)36, (ftnlen)6); - bltcod[487] = 1000107; - s_copy(bltnam + 17532, "WILD 2", (ftnlen)36, (ftnlen)6); - bltcod[488] = 1000108; - s_copy(bltnam + 17568, "WILD 3", (ftnlen)36, (ftnlen)6); - bltcod[489] = 1000109; - s_copy(bltnam + 17604, "WIRTANEN", (ftnlen)36, (ftnlen)8); - bltcod[490] = 1000110; - s_copy(bltnam + 17640, "WOLF", (ftnlen)36, (ftnlen)4); - bltcod[491] = 1000111; - s_copy(bltnam + 17676, "WOLF-HARRINGTON", (ftnlen)36, (ftnlen)15); - bltcod[492] = 1000112; - s_copy(bltnam + 17712, "LOVAS 2", (ftnlen)36, (ftnlen)7); - bltcod[493] = 1000113; - s_copy(bltnam + 17748, "URATA-NIIJIMA", (ftnlen)36, (ftnlen)13); - bltcod[494] = 1000114; - s_copy(bltnam + 17784, "WISEMAN-SKIFF", (ftnlen)36, (ftnlen)13); - bltcod[495] = 1000115; - s_copy(bltnam + 17820, "HELIN", (ftnlen)36, (ftnlen)5); - bltcod[496] = 1000116; - s_copy(bltnam + 17856, "MUELLER", (ftnlen)36, (ftnlen)7); - bltcod[497] = 1000117; - s_copy(bltnam + 17892, "SHOEMAKER-HOLT 1", (ftnlen)36, (ftnlen)16); - bltcod[498] = 1000118; - s_copy(bltnam + 17928, "HELIN-ROMAN-CROCKETT", (ftnlen)36, (ftnlen)20); - bltcod[499] = 1000119; - s_copy(bltnam + 17964, "HARTLEY 3", (ftnlen)36, (ftnlen)9); - bltcod[500] = 1000120; - s_copy(bltnam + 18000, "PARKER-HARTLEY", (ftnlen)36, (ftnlen)14); - bltcod[501] = 1000121; - s_copy(bltnam + 18036, "HELIN-ROMAN-ALU 1", (ftnlen)36, (ftnlen)17); - bltcod[502] = 1000122; - s_copy(bltnam + 18072, "WILD 4", (ftnlen)36, (ftnlen)6); - bltcod[503] = 1000123; - s_copy(bltnam + 18108, "MUELLER 2", (ftnlen)36, (ftnlen)9); - bltcod[504] = 1000124; - s_copy(bltnam + 18144, "MUELLER 3", (ftnlen)36, (ftnlen)9); - bltcod[505] = 1000125; - s_copy(bltnam + 18180, "SHOEMAKER-LEVY 1", (ftnlen)36, (ftnlen)16); - bltcod[506] = 1000126; - s_copy(bltnam + 18216, "SHOEMAKER-LEVY 2", (ftnlen)36, (ftnlen)16); - bltcod[507] = 1000127; - s_copy(bltnam + 18252, "HOLT-OLMSTEAD", (ftnlen)36, (ftnlen)13); - bltcod[508] = 1000128; - s_copy(bltnam + 18288, "METCALF-BREWINGTON", (ftnlen)36, (ftnlen)18); - bltcod[509] = 1000129; - s_copy(bltnam + 18324, "LEVY", (ftnlen)36, (ftnlen)4); - bltcod[510] = 1000130; - s_copy(bltnam + 18360, "SHOEMAKER-LEVY 9", (ftnlen)36, (ftnlen)16); - bltcod[511] = 1000131; - s_copy(bltnam + 18396, "HYAKUTAKE", (ftnlen)36, (ftnlen)9); - bltcod[512] = 1000132; - s_copy(bltnam + 18432, "HALE-BOPP", (ftnlen)36, (ftnlen)9); - bltcod[513] = 9511010; - s_copy(bltnam + 18468, "GASPRA", (ftnlen)36, (ftnlen)6); - bltcod[514] = 2431010; - s_copy(bltnam + 18504, "IDA", (ftnlen)36, (ftnlen)3); - bltcod[515] = 2431011; - s_copy(bltnam + 18540, "DACTYL", (ftnlen)36, (ftnlen)6); - bltcod[516] = 2000001; - s_copy(bltnam + 18576, "CERES", (ftnlen)36, (ftnlen)5); - bltcod[517] = 2000004; - s_copy(bltnam + 18612, "VESTA", (ftnlen)36, (ftnlen)5); - bltcod[518] = 2000021; - s_copy(bltnam + 18648, "LUTETIA", (ftnlen)36, (ftnlen)7); - bltcod[519] = 2000216; - s_copy(bltnam + 18684, "KLEOPATRA", (ftnlen)36, (ftnlen)9); - bltcod[520] = 2000433; - s_copy(bltnam + 18720, "EROS", (ftnlen)36, (ftnlen)4); - bltcod[521] = 2000253; - s_copy(bltnam + 18756, "MATHILDE", (ftnlen)36, (ftnlen)8); - bltcod[522] = 2002867; - s_copy(bltnam + 18792, "STEINS", (ftnlen)36, (ftnlen)6); - bltcod[523] = 2009969; - s_copy(bltnam + 18828, "1992KD", (ftnlen)36, (ftnlen)6); - bltcod[524] = 2009969; - s_copy(bltnam + 18864, "BRAILLE", (ftnlen)36, (ftnlen)7); - bltcod[525] = 2004015; - s_copy(bltnam + 18900, "WILSON-HARRINGTON", (ftnlen)36, (ftnlen)17); - bltcod[526] = 2004179; - s_copy(bltnam + 18936, "TOUTATIS", (ftnlen)36, (ftnlen)8); - bltcod[527] = 2025143; - s_copy(bltnam + 18972, "ITOKAWA", (ftnlen)36, (ftnlen)7); - bltcod[528] = 398989; - s_copy(bltnam + 19008, "NOTO", (ftnlen)36, (ftnlen)4); - bltcod[529] = 398990; - s_copy(bltnam + 19044, "NEW NORCIA", (ftnlen)36, (ftnlen)10); - bltcod[530] = 399001; - s_copy(bltnam + 19080, "GOLDSTONE", (ftnlen)36, (ftnlen)9); - bltcod[531] = 399002; - s_copy(bltnam + 19116, "CANBERRA", (ftnlen)36, (ftnlen)8); - bltcod[532] = 399003; - s_copy(bltnam + 19152, "MADRID", (ftnlen)36, (ftnlen)6); - bltcod[533] = 399004; - s_copy(bltnam + 19188, "USUDA", (ftnlen)36, (ftnlen)5); - bltcod[534] = 399005; - s_copy(bltnam + 19224, "DSS-05", (ftnlen)36, (ftnlen)6); - bltcod[535] = 399005; - s_copy(bltnam + 19260, "PARKES", (ftnlen)36, (ftnlen)6); - bltcod[536] = 399012; - s_copy(bltnam + 19296, "DSS-12", (ftnlen)36, (ftnlen)6); - bltcod[537] = 399013; - s_copy(bltnam + 19332, "DSS-13", (ftnlen)36, (ftnlen)6); - bltcod[538] = 399014; - s_copy(bltnam + 19368, "DSS-14", (ftnlen)36, (ftnlen)6); - bltcod[539] = 399015; - s_copy(bltnam + 19404, "DSS-15", (ftnlen)36, (ftnlen)6); - bltcod[540] = 399016; - s_copy(bltnam + 19440, "DSS-16", (ftnlen)36, (ftnlen)6); - bltcod[541] = 399017; - s_copy(bltnam + 19476, "DSS-17", (ftnlen)36, (ftnlen)6); - bltcod[542] = 399023; - s_copy(bltnam + 19512, "DSS-23", (ftnlen)36, (ftnlen)6); - bltcod[543] = 399024; - s_copy(bltnam + 19548, "DSS-24", (ftnlen)36, (ftnlen)6); - bltcod[544] = 399025; - s_copy(bltnam + 19584, "DSS-25", (ftnlen)36, (ftnlen)6); - bltcod[545] = 399026; - s_copy(bltnam + 19620, "DSS-26", (ftnlen)36, (ftnlen)6); - bltcod[546] = 399027; - s_copy(bltnam + 19656, "DSS-27", (ftnlen)36, (ftnlen)6); - bltcod[547] = 399028; - s_copy(bltnam + 19692, "DSS-28", (ftnlen)36, (ftnlen)6); - bltcod[548] = 399033; - s_copy(bltnam + 19728, "DSS-33", (ftnlen)36, (ftnlen)6); - bltcod[549] = 399034; - s_copy(bltnam + 19764, "DSS-34", (ftnlen)36, (ftnlen)6); - bltcod[550] = 399042; - s_copy(bltnam + 19800, "DSS-42", (ftnlen)36, (ftnlen)6); - bltcod[551] = 399043; - s_copy(bltnam + 19836, "DSS-43", (ftnlen)36, (ftnlen)6); - bltcod[552] = 399045; - s_copy(bltnam + 19872, "DSS-45", (ftnlen)36, (ftnlen)6); - bltcod[553] = 399046; - s_copy(bltnam + 19908, "DSS-46", (ftnlen)36, (ftnlen)6); - bltcod[554] = 399049; - s_copy(bltnam + 19944, "DSS-49", (ftnlen)36, (ftnlen)6); - bltcod[555] = 399053; - s_copy(bltnam + 19980, "DSS-53", (ftnlen)36, (ftnlen)6); - bltcod[556] = 399054; - s_copy(bltnam + 20016, "DSS-54", (ftnlen)36, (ftnlen)6); - bltcod[557] = 399055; - s_copy(bltnam + 20052, "DSS-55", (ftnlen)36, (ftnlen)6); - bltcod[558] = 399061; - s_copy(bltnam + 20088, "DSS-61", (ftnlen)36, (ftnlen)6); - bltcod[559] = 399063; - s_copy(bltnam + 20124, "DSS-63", (ftnlen)36, (ftnlen)6); - bltcod[560] = 399064; - s_copy(bltnam + 20160, "DSS-64", (ftnlen)36, (ftnlen)6); - bltcod[561] = 399065; - s_copy(bltnam + 20196, "DSS-65", (ftnlen)36, (ftnlen)6); - bltcod[562] = 399066; - s_copy(bltnam + 20232, "DSS-66", (ftnlen)36, (ftnlen)6); - return 0; -} /* zzidmap_ */ - diff --git a/ext/spice/src/cspice/zzinssub.c b/ext/spice/src/cspice/zzinssub.c deleted file mode 100644 index 8e328f2dd6..0000000000 --- a/ext/spice/src/cspice/zzinssub.c +++ /dev/null @@ -1,291 +0,0 @@ -/* zzinssub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZINSSUB ( Insert a substring ) */ -/* Subroutine */ int zzinssub_(char *in, char *sub, integer *loc, char *out, - ftnlen in_len, ftnlen sub_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical same; - integer from, i__, inlen, myloc, nmove, to, subend, sublen, outlen; - char chr[1]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Insert a substring into a character string at a specified */ -/* location. */ - -/* $ 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 */ - -/* ASSIGNMENT */ -/* CHARACTER */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* SUB I Substring to be inserted. */ -/* LOC I Position at which substring is to be inserted. */ -/* OUT O Output string. */ - -/* $ Detailed_Input */ - -/* IN is an input character string, into which a substring */ -/* is to be inserted. */ - -/* SUB is the substring to be inserted. Leading and trailing */ -/* blanks are significant. */ - -/* LOC is the position in the input string at which the */ -/* substring is to be inserted. To append to the */ -/* string, set LOC equal to LEN(IN) + 1. */ - -/* $ Detailed_Output */ - -/* OUT is the output string. This is equivalent to the */ -/* string that would be created by the concatenation */ - -/* OUT = IN(1:LOC-1) // SUB // IN(LOC: ) */ - -/* If the output string is too long, it is truncated */ -/* on the right. */ - -/* OUT may overwrite IN. OUT may NOT overwrite SUB. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If LOC is less than 1 it is treateds as having value 1. */ - -/* 2) If LOC is greater than LEN(IN) + 1, it is treated as if */ -/* it had value LEN(IN) + 1. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Shift the end of the input string, beginning with LOC, to the */ -/* right, leaving space for the substring. Then insert the substring */ -/* into the vacated space in the middle of the string. This has */ -/* the same effect as the concatenation */ - -/* OUT = IN(1:LOC-1) // SUB // IN(LOC: ) */ - -/* Because this operation is not standard for strings of length (*), */ -/* this routine does not use concatenation. */ - -/* This private routine is just a copy of the SPICE routine INSSUB */ -/* with "reasonable" choices made for out of bounds errors. */ - -/* $ Examples */ - -/* The following examples illustrate the use of ZZINSSUB. */ - -/* IN SUB LOC OUT */ -/* ----------------- ------- --- ------------------------ */ -/* 'ABCDEFGHIJ' ' YXZ ' 3 'AB XYZ CDEFGHIJ' */ -/* 'The rabbit' 'best ' 5 'The best rabbit' */ -/* ' other woman' 'The' 1 'The other woman' */ -/* 'An Apple a day' ' keeps' 15 'An Apple a day keeps' */ -/* 'Apple a day' 'An ' 0 'An Apple a day' */ -/* 'Apple a day' 'An ' -3 'An Apple a day' */ -/* 'An Apple a day' ' keeps' 16 'An Apple a day keeps' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-AUG-1996 (WLT) */ - -/* Adapted from the SPICELIB routine INSSUB to be error free. */ - - -/* -& */ -/* $ Index_Entries */ - -/* insert a substring */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 24-OCT-1994 (NJB) */ - -/* Bug fix: case where insertion location follows end of */ -/* input string is now handled correctly. Formerly, an */ -/* out-of-range substring bound violation was incurred in this */ -/* case. */ - -/* Bug fix: use of SHIFTC routine in old implementation */ -/* resulted in output string being truncated at length */ -/* LEN(IN), which is not consistent with the routine's */ -/* specification. */ - -/* Now does discovery check-in. Header sections re-arranged. */ -/* Some clean-up of header format done. */ - -/* - Beta Version 2.0.0, 4-JAN-1989 (HAN) */ - -/* If the location at which the substring is to be inserted is */ -/* not in the interval [1, LEN(IN)+1], an error is signalled. */ -/* Locations not within that interval refer to non-existent */ -/* characters positions. (To append to the string, set the */ -/* location equal to LEN(IN)+1.) */ - -/* -& */ - -/* Local Variables */ - - -/* Note to the careful reader: in order to scrupulously avoid */ -/* non-standard assignments of characters from a substring of IN to */ -/* an overlapping substring of OUT, in the case where IN and OUT */ -/* refer to the same memory, we'll test whether the output and */ -/* input strings are the same. If they're the same, we can avoid */ -/* various assignments that could cause trouble if IN and OUT */ -/* actually refer to the same memory. This test has little effect on */ -/* performance, and allows the author to sleep more soundly at night. */ - -/* Capture the lengths of the input, output, and substitution */ -/* strings. */ - - inlen = i_len(in, in_len); - outlen = i_len(out, out_len); - sublen = i_len(sub, sub_len); -/* Computing MIN */ - i__1 = inlen + 1, i__2 = max(1,*loc); - myloc = min(i__1,i__2); - -/* If the insertion occurs after the end of the output string, */ -/* just return the original string. Don't do the assignment if */ -/* the output and input strings have equal values; the assignment */ -/* is not needed in this case and could cause a run-time error if */ -/* OUT and IN refer to the same memory. */ - - same = s_cmp(out, in, out_len, in_len) == 0; - if (myloc > outlen) { - if (! same) { - s_copy(out, in, out_len, in_len); - } - return 0; - } - -/* At this point, we're guaranteed that */ - -/* MYLOC < OUTLEN */ -/* - */ - -/* MYLOC < INLEN + 1 */ -/* - */ - -/* MYLOC > 0 */ - - -/* The first part of the input string is copied without change */ -/* to the output string, if this first part is non-empty. */ - - if (myloc > 1) { - -/* Again, do the assignment only if it's required. */ - - if (! same) { - s_copy(out, in, myloc - 1, in_len); - } - } - -/* The part following the new substring is shifted into place, if */ -/* there's both something to move and a place to put it. Move the */ -/* rightmost characters first. */ - - subend = myloc - 1 + sublen; - if (myloc <= inlen && subend < outlen) { -/* Computing MIN */ - i__1 = outlen - subend, i__2 = inlen - myloc + 1; - nmove = min(i__1,i__2); - for (i__ = nmove; i__ >= 1; --i__) { - from = myloc + i__ - 1; - to = subend + i__; - *(unsigned char *)chr = *(unsigned char *)&in[from - 1]; - *(unsigned char *)&out[to - 1] = *(unsigned char *)chr; - } - } - -/* And the new word is dropped into the middle. */ - - s_copy(out + (myloc - 1), sub, min(subend,outlen) - (myloc - 1), sub_len); - -/* Blank-pad the output string if necessary. */ - - if (outlen > inlen + sublen) { - i__1 = inlen + sublen; - s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1); - } - return 0; -} /* zzinssub_ */ - diff --git a/ext/spice/src/cspice/zzldker.c b/ext/spice/src/cspice/zzldker.c deleted file mode 100644 index 4e54ef3efe..0000000000 --- a/ext/spice/src/cspice/zzldker.c +++ /dev/null @@ -1,358 +0,0 @@ -/* zzldker.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZLDKER ( Load a kernel ) */ -/* Subroutine */ int zzldker_(char *file, char *nofile, char *filtyp, integer - *handle, ftnlen file_len, ftnlen nofile_len, ftnlen filtyp_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char arch[32]; - extern /* Subroutine */ int zzbodkik_(void), eklef_(char *, integer *, - ftnlen), chkin_(char *, ftnlen), cklpf_(char *, integer *, ftnlen) - , errch_(char *, char *, ftnlen, ftnlen); - char versn[32]; - extern logical failed_(void); - extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), pcklof_(char *, integer *, ftnlen), spklef_(char - *, integer *, ftnlen), ldpool_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical exists_(char *, ftnlen), return_(void); - char mytype[32]; - extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the architecture and type of a file and load */ -/* the file into the appropriate SPICE subsystem */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I The name of a file to be loaded. */ -/* NOFILE I A message to issue if FILE cannot be located */ -/* FILTYP O The type of kernel. */ -/* HANDLE O The handle associated with the loaded kernel. */ - -/* $ Detailed_Input */ - -/* FILE is the name of a file that is anticipated to */ -/* be a SPICE kernel. */ - -/* NOFILE is a template for the message that should be created */ -/* with SETMSG if a problem is identified with FILE. The */ -/* message should have the form: "[text] '#' [text] #" The */ -/* first octothorpe ('#') will be replaced by the name of */ -/* the file. The second by a descriptive message. */ - -/* $ Detailed_Output */ - -/* FILTYP is the type of the kernel as determined by the */ -/* SPICE file record of the file or by various */ -/* heuristics. Possible return values are: */ - -/* TEXT --- if FILE is interpreted as a text kernel */ -/* suitable for loading via LDPOOL. No */ -/* attempt is made to distinguish between */ -/* different types of text kernels. */ -/* SPK | */ -/* CK | */ -/* PCK |--- if FILE is a binary PCK file. */ -/* EK | */ - -/* If a failure occurs during the attempt to load */ -/* the FILE, FILTYP will be returned as the blank string. */ - -/* HANDLE is the DAF or DAS handle that is associated with the */ -/* file. If the FILTYP of the file is 'TEXT', HANDLE */ -/* will be set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified file does not exist, the error */ -/* SPICE(NOSUCHFILE) will be signaled. */ - -/* 2) If the specified file can be identified as unloadable */ -/* because it is a transfer format file, the error */ -/* SPICE(TRANSFERFILE) will be signaled. */ - -/* 3) If the specified file can be identified as unloadable */ -/* because it is an obsolete text E-kernel, the error */ -/* SPICE(TYPE1TEXTEK) will be signaled. */ - -/* 4) If the specified file can be recognized as a DAF/DAS file */ -/* but is not one of the currently recognized binary kernel */ -/* types, the error SPICE(UNKNOWNKERNELTYPE) will be signaled. */ - -/* 5) FILTYP is not sufficiently long to hold the full text of the */ -/* type of the kernel, the value returned will be the truncation */ -/* of the value. As currently implemented this truncated type is */ -/* sufficient to distinguish between the various types of */ -/* kernels. */ - -/* 6) If the FILE cannot be loaded, HANDLE will be set to zero. */ - -/* 7) All other problems associated with the loading of FILE */ -/* are diagnosed by the routines called by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is intended as a supporting routine for the */ -/* SPICE routine FURNSH. It handles the task of loading */ -/* an arbitrary kernel without the caller having to specify */ -/* the type of the kernel. */ - -/* $ Examples */ - -/* None. (After all it's a private routine) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.9.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.7.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.6.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 03-OCT-2005 (EDW) */ - -/* Source file zzldker.f converted to master file. */ -/* Modification occurred to prevent f2c's versions */ -/* from making the zzascii test. CSPICE now */ -/* includes coed to allow reading of non native text files. */ - -/* - SPICELIB Version 1.2.0, 17-FEB-2004 (EDW) (BVS) */ - -/* Added the ZZASCII terminator test for text files. Used a */ -/* working line length of 132 characters (maximum text kernel */ -/* line size.) */ - -/* - SPICELIB Version 1.1.0, 24-JUN-2002 (EDW) */ - -/* Added a call to ZZBODKIK to run the */ -/* NAIF_BODY_NAME/CODE read/check routine */ -/* whenever a text kernel loads. */ - -/* - SPICELIB Version 1.0.0, 04-JUN-1999 (WLT) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables. */ - - if (return_()) { - return 0; - } - chkin_("ZZLDKER", (ftnlen)7); - if (! exists_(file, file_len)) { - setmsg_(nofile, nofile_len); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", "could not be located.", (ftnlen)1, (ftnlen)21); - sigerr_("SPICE(NOSUCHFILE)", (ftnlen)17); - chkout_("ZZLDKER", (ftnlen)7); - return 0; - } - getfat_(file, arch, mytype, file_len, (ftnlen)32, (ftnlen)32); - -/* Possible values for the architecture are: */ - -/* DAF -- The file is based on the DAF architecture. */ -/* DAS -- The file is based on the DAS architecture. */ -/* XFR -- The file is in a SPICE transfer file format. */ -/* DEC -- The file is an old SPICE decimal text file. */ -/* ASC -- An ASCII text file. */ -/* KPL -- Kernel Pool File (i.e., a text kernel) */ -/* TXT -- An ASCII text file. */ -/* TE1 -- Text E-Kernel type 1. */ -/* ? -- The architecture could not be determined. */ - -/* Some of these are obviously losers. */ - - if (s_cmp(arch, "XFR", (ftnlen)32, (ftnlen)3) == 0 || s_cmp(arch, "DEC", ( - ftnlen)32, (ftnlen)3) == 0) { - setmsg_(nofile, nofile_len); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", "is a transfer format file. Transfer format files cannot" - " be loaded. ", (ftnlen)1, (ftnlen)67); - sigerr_("SPICE(TRANSFERFILE)", (ftnlen)19); - chkout_("ZZLDKER", (ftnlen)7); - return 0; - } else if (s_cmp(arch, "TE1", (ftnlen)32, (ftnlen)3) == 0) { - setmsg_(nofile, nofile_len); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", "is a type 1 text E-kernel. These files are obsolete an" - "d cannot be loaded. ", (ftnlen)1, (ftnlen)75); - sigerr_("SPICE(TYPE1TEXTEK)", (ftnlen)18); - chkout_("ZZLDKER", (ftnlen)7); - return 0; - } - -/* That takes care of the obvious errors. Try loading the */ -/* kernel. */ - - *handle = 0; - s_copy(filtyp, " ", filtyp_len, (ftnlen)1); - if (s_cmp(arch, "DAF", (ftnlen)32, (ftnlen)3) == 0) { - if (s_cmp(mytype, "SPK", (ftnlen)32, (ftnlen)3) == 0) { - spklef_(file, handle, file_len); - } else if (s_cmp(mytype, "CK", (ftnlen)32, (ftnlen)2) == 0) { - cklpf_(file, handle, file_len); - } else if (s_cmp(mytype, "PCK", (ftnlen)32, (ftnlen)3) == 0) { - pcklof_(file, handle, file_len); - } else { - tkvrsn_("TOOLKIT", versn, (ftnlen)7, (ftnlen)32); - setmsg_(nofile, nofile_len); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", "is a \"#\" DAF file. This kind of binary file is no" - "t supported in version # of the SPICE toolkit. Check wit" - "h NAIF to see if your toolkit version is up to date. ", ( - ftnlen)1, (ftnlen)158); - errch_("#", mytype, (ftnlen)1, (ftnlen)32); - errch_("#", versn, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNKNOWNKERNELTYPE)", (ftnlen)24); - chkout_("ZZLDKER", (ftnlen)7); - return 0; - } - s_copy(filtyp, mytype, filtyp_len, (ftnlen)32); - } else if (s_cmp(arch, "DAS", (ftnlen)32, (ftnlen)3) == 0) { - if (s_cmp(mytype, "EK", (ftnlen)32, (ftnlen)2) == 0) { - eklef_(file, handle, file_len); - } else { - tkvrsn_("TOOLKIT", versn, (ftnlen)7, (ftnlen)32); - setmsg_(nofile, nofile_len); - errch_("#", file, (ftnlen)1, file_len); - errch_("#", "is a \"#\" DAS file. This kind of binary file is n" - "ot supported in version # of the SPICE toolkit. Check wi" - "th NAIF to see if your toolkit version is up to date. ", ( - ftnlen)1, (ftnlen)159); - errch_("#", mytype, (ftnlen)1, (ftnlen)32); - errch_("#", versn, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNKNOWNKERNELTYPE)", (ftnlen)24); - chkout_("ZZLDKER", (ftnlen)7); - return 0; - } - s_copy(filtyp, mytype, filtyp_len, (ftnlen)32); - } else { - -/* Load the file using the text file loader. */ - - ldpool_(file, file_len); - if (! failed_()) { - s_copy(filtyp, "TEXT", filtyp_len, (ftnlen)4); - -/* Cause the kernel pool mechanism to perform */ -/* the standard error checks on the pool */ -/* data. */ - - zzbodkik_(); - } - } - chkout_("ZZLDKER", (ftnlen)7); - return 0; -} /* zzldker_ */ - diff --git a/ext/spice/src/cspice/zzmkpc.c b/ext/spice/src/cspice/zzmkpc.c deleted file mode 100644 index 5c13ccd2a9..0000000000 --- a/ext/spice/src/cspice/zzmkpc.c +++ /dev/null @@ -1,188 +0,0 @@ -/* zzmkpc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZMKPC ( Make a time format picture mark ) */ -/* Subroutine */ int zzmkpc_(char *pictur, integer *b, integer *e, char *mark, - char *pattrn, ftnlen pictur_len, ftnlen mark_len, ftnlen pattrn_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer lpat, last, lmrk; - extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen); - integer point; - char places[14]; - extern integer lastnb_(char *, ftnlen); - char mymark[26]; - integer use; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Given a numeric pattern, construct the appropriate time format */ -/* picture component. */ - -/* $ 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 */ - -/* Time --- PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PICTUR I/O A partially constructed time format picture */ -/* B I Beginning of substring to place a mark */ -/* E I End of substring to place a mark */ -/* MARK I Initial portion of a mark */ -/* PATTRN I Decimal pattern */ - -/* $ Detailed_Input */ - -/* PICTUR is a "TIMOUT" format picture that is under construction */ -/* The substring PICTUR(B:E) is supposed to be a sequence */ -/* of digits with possibly a decimal point in it. The */ -/* digits before the decimal will be replaced by MARK. */ -/* The decimal point will be copied and digits after */ -/* the decimal point (up to 14 of them) will be replaced */ -/* by a the octothorpe character '#'. */ - -/* B are the beginning and ends of the substring mentioned */ -/* E in PICTUR. */ - -/* MARK is a numeric time format component (DD, DOY, JULIAND, */ -/* HR, MN, SC ) */ - -/* PATTRN a sequence of digits, possibly a leading minus sign */ -/* and possibly an embedded decimal point. */ - -/* $ Detailed_Output */ - -/* PICTUR is the input string with the appropriate time format */ -/* picture component inserted. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine that assists in the construction of */ -/* a format picture that corresponds to a particular instance */ -/* of a time string. */ - -/* $ Examples */ - -/* See ZZTIME. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-APR-1996 (WLT) */ - - -/* -& */ - s_copy(places, "##############", (ftnlen)14, (ftnlen)14); - -/* Construct the replacement marker. First the unmodified */ -/* portion of the marker. (We use LAST as the pointer to the */ -/* last valid character of the marker). */ - - lmrk = lastnb_(mark, mark_len); - lpat = i_len(pattrn, pattrn_len); - s_copy(mymark, mark, (ftnlen)26, mark_len); - last = lmrk; - -/* Is there a decimal point in the pattern? */ - - point = i_indx(pattrn, ".", pattrn_len, (ftnlen)1); - if (point > 0) { - -/* We've got a decimal point. We have to at least put this */ -/* into the marker. */ - - ++last; - *(unsigned char *)&mymark[last - 1] = '.'; - -/* If the decimal point is not at the end of the pattern, we */ -/* will need to add some #'s to the marker (but not more than */ -/* MAXPLC of them). */ - - if (point < lpat) { -/* Computing MIN */ - i__1 = 14, i__2 = lpat - point; - use = min(i__1,i__2); - i__1 = last; - s_copy(mymark + i__1, places, 26 - i__1, use); - last += use; - } - } - -/* We now let REPSUB do the work of replacing the substring */ -/* PICTUR(B:E) with the marker we've constructed. */ - - zzrepsub_(pictur, b, e, mymark, pictur, pictur_len, last, pictur_len); - return 0; -} /* zzmkpc_ */ - diff --git a/ext/spice/src/cspice/zzmobliq.c b/ext/spice/src/cspice/zzmobliq.c deleted file mode 100644 index 06fc89427c..0000000000 --- a/ext/spice/src/cspice/zzmobliq.c +++ /dev/null @@ -1,185 +0,0 @@ -/* zzmobliq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZMOBLIQ ( Mean obliquity of date ) */ -/* Subroutine */ int zzmobliq_(doublereal *et, doublereal *mob, doublereal * - dmob) -{ - /* Initialized data */ - - static logical first = TRUE_; - - static doublereal year, t; - extern doublereal jyear_(void); - static doublereal persec, rad; - extern doublereal rpd_(void); - -/* $ Abstract */ - -/* Return the mean obliquity of the ecliptic, and its time */ -/* derivative, at a specified epoch. */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* $ 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 */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris time, in seconds past J2000. */ -/* MOB O Mean obliquity of the ecliptic at ET. */ -/* DMOB O Time derivative of the mean obliquity. */ - -/* $ Detailed_Input */ - -/* ET is the epoch at which the obliquity of the ecliptic */ -/* is to be computed. ET is barycentric dynamical */ -/* time, expressed as seconds past J2000. */ - -/* $ Detailed_Output */ - -/* MOB is the mean obliquity of the ecliptic at epoch ET. */ -/* The mean obliquity of the ecliptic is the */ -/* inclination of the ecliptic of date to the mean */ -/* Earth equator of date. Output units are radians. */ - -/* DMOB is the time derivative of MOB at ET, expressed in */ -/* radians per second. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The expression for mean is obliquity is */ - -/* '' '' '' 2 */ -/* MOBLIQ = 84381 .448 - 46 .8150 * T - 0 .00059 * T */ - -/* '' 3 */ -/* + 0 .001813 * T */ - -/* where T indicates Julian centuries past J2000. This is from */ -/* equation 5-153 of reference [2]. */ - -/* $ Examples */ - -/* See the routine ENUTAT for an example of usage. */ - -/* $ Restrictions */ - -/* 1) This is a preliminary version of the routine. */ - -/* $ Literature_References */ - -/* [1] "Explanatory Supplement to the Astronomical Almanac" */ -/* edited by P. Kenneth Seidelmann. University Science */ -/* Books, 20 Edgehill Road, Mill Valley, CA 94941 (1992) */ - -/* [2] "Section 5, Geocentric Space-Fixed Position, Velocity, and */ -/* Acceleration Vectors of Tracking Station" by T. D. Moyer. */ -/* Draft of JPL Publication documenting the JPL navigation */ -/* program "Regres." */ - - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0 18-JUL-1997 (WLT) */ - -/* Adapted Nat'routine to private version making output */ -/* rate be radians/sec. */ - -/* - Beta Version 1.0.0, 29-SEP-1996 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* compute mean obliquity of date of the ecliptic */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Coefficients for the mean obliquity: */ - - -/* Local variables */ - - if (first) { - first = FALSE_; - year = jyear_(); - rad = rpd_(); - persec = 1. / (year * 100.); - } - -/* Convert the input epoch to Julian centuries past J2000: */ - - t = *et / year / 100.; - -/* Compute the obliquity at epoch. The polynomial yields arcseconds; */ -/* convert the units to radians. */ - - *mob = rad / 3600. * (t * (t * (t * .001813 - 5.9e-4) - 46.815) + - 84381.448); - *dmob = rad / 3600. * (t * (t * 3 * .001813 - .0011800000000000001) - - 46.815) * persec; - return 0; -} /* zzmobliq_ */ - diff --git a/ext/spice/src/cspice/zzmsxf.c b/ext/spice/src/cspice/zzmsxf.c deleted file mode 100644 index 836f579f84..0000000000 --- a/ext/spice/src/cspice/zzmsxf.c +++ /dev/null @@ -1,449 +0,0 @@ -/* zzmsxf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZMSXF ( Multiply sequence of state transformations ) */ -/* Subroutine */ int zzmsxf_(doublereal *matrix, integer *n, doublereal * - output) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer incr; - doublereal temp[72] /* was [6][6][2] */; - integer i__, j, k, l, m, get, put; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine multiplies together a sequence of state */ -/* transformation matrices. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I A sequence of state transformation matrices */ -/* N I The number of state transformation matrices */ -/* OUTPUT O The product of the state transformations. */ - -/* $ Detailed_Input */ - -/* MATRIX is an array of 6x6 state transformation matrices. */ -/* It is essential that all these matrices have the form */ - -/* - - */ -/* | | | */ -/* | R | 0 | */ -/* | | | */ -/* | -----+------ | */ -/* | | | */ -/* | D | R | */ -/* | | | */ -/* - - */ - -/* The routine does not compute the product of a sequence */ -/* that does not satisfy this condition. */ - - -/* N is an integer giving the number of matrices in the */ -/* sequence. */ - - -/* $ Detailed_Output */ - -/* OUTPUT is the product of the matrices stored in MATRIX. */ -/* Specifically, it is the result of the product */ - -/* M_N * M_(N-1) * ... * M_2 * M_1 */ - -/* where the K'th matrix M_K is define by the */ -/* relationship */ - -/* M_K( I, J ) = MATRIX ( I, J, K ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If N is 0 or smaller OUTPUT will be returned as the */ -/* 6x6 identity matrix. */ - -/* 2) IF N is 1 OUTPUT will be returned as M_1 where M_1 is */ -/* the matrix defined above in the description of OUTPUT. */ - -/* $ Particulars */ - -/* This is a private SPICE routine that computes the product */ -/* of a sequence of state transformation matrices. */ - -/* This routine takes special advantage of the structure of */ -/* state transformation matrices so that the number of */ -/* actual multiplies and additions is reduced to 3/8 of that */ -/* which would be needed by a general matrix multiplication */ -/* routine. */ - -/* The key to this computation saving is the structure of the */ -/* state transformation matrix. Suppose that M2 and M1 are */ -/* two such matrices. Then the product */ - -/* - - - - */ -/* | | | | | | */ -/* | R2 | 0 | | R1 | 0 | */ -/* | | | | | | */ -/* | -----+------ | | -----+------ | = */ -/* | | | | | | */ -/* | D2 | R2 | | D1 | R1 | */ -/* | | | | | | */ -/* - - - - */ - -/* - - */ -/* | | | */ -/* | R2*R1 | 0 | */ -/* | | | */ -/* | -----------------+------------ | */ -/* | | | */ -/* | D2*R1 + R2*D1 | R2*R1 | */ -/* | | | */ -/* - - */ - -/* As can be seen this can be computed with 3 3x3 matrix multiplies */ -/* and one 3x3 matrix addition. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) */ - - -/* -& */ - -/* If we have more than 2 matrices to deal with we will need to */ -/* set up the PUT location */ - - put = 1; - -/* We perform tests in the order they seem most likely to */ -/* occur. */ - - if (*n == 2) { - -/* If there are exactly two inputs, then the output takes */ -/* only a single matrix multiply. */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)208)] = - matrix[j + 35] * matrix[(k + 6) * 6 - 42] + matrix[j - + 41] * matrix[(k + 6) * 6 - 41] + matrix[j + 47] * - matrix[(k + 6) * 6 - 40]; - } - } - for (j = 4; j <= 6; ++j) { - for (k = 1; k <= 3; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)217)] = - matrix[j + 35] * matrix[(k + 6) * 6 - 42] + matrix[j - + 41] * matrix[(k + 6) * 6 - 41] + matrix[j + 47] * - matrix[(k + 6) * 6 - 40] + matrix[j + 53] * matrix[(k - + 6) * 6 - 39] + matrix[j + 59] * matrix[(k + 6) * 6 - - 38] + matrix[j + 65] * matrix[(k + 6) * 6 - 37]; - } - } - for (j = 1; j <= 3; ++j) { - for (k = 4; k <= 6; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)228)] = 0.; - } - } - for (j = 4; j <= 6; ++j) { - l = j - 3; - for (k = 4; k <= 6; ++k) { - m = k - 3; - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)236)] = - output[(i__2 = l + m * 6 - 7) < 36 && 0 <= i__2 ? - i__2 : s_rnge("output", i__2, "zzmsxf_", (ftnlen)236)] - ; - } - } - } else if (*n > 2) { - -/* We need to compute the product */ - -/* MATRIX( , ,N) * MATRIX( , ,N-1) * ... * MATRIX( , , 1 ) */ - -/* Compute the first product. MATRIX( , ,2) * MATRIX( , ,1) */ - - -/* First compute the upper left hand 3x3 portion of the product... */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - temp[(i__1 = j + (k + put * 6) * 6 - 43) < 72 && 0 <= i__1 ? - i__1 : s_rnge("temp", i__1, "zzmsxf_", (ftnlen)257)] = - matrix[j + 35] * matrix[(k + 6) * 6 - 42] + matrix[j - + 41] * matrix[(k + 6) * 6 - 41] + matrix[j + 47] * - matrix[(k + 6) * 6 - 40]; - } - } - -/* Next compute the lower left hand 3x3 portion of the product. */ - - for (j = 4; j <= 6; ++j) { - for (k = 1; k <= 3; ++k) { - temp[(i__1 = j + (k + put * 6) * 6 - 43) < 72 && 0 <= i__1 ? - i__1 : s_rnge("temp", i__1, "zzmsxf_", (ftnlen)268)] = - matrix[j + 35] * matrix[(k + 6) * 6 - 42] + matrix[j - + 41] * matrix[(k + 6) * 6 - 41] + matrix[j + 47] * - matrix[(k + 6) * 6 - 40] + matrix[j + 53] * matrix[(k - + 6) * 6 - 39] + matrix[j + 59] * matrix[(k + 6) * 6 - - 38] + matrix[j + 65] * matrix[(k + 6) * 6 - 37]; - } - } - -/* We don't bother to comput the upper right hand 3x3 portion */ -/* of the matrix since it is always zero. */ - -/* Finally we could copy the lower right hand 3x3 portion of the */ -/* product from the upper left hand portion. But as you can */ -/* see below we never actually have to reference TEMP(I,K,GET) */ -/* for K = 4 to 6. So we can just skip that part of the */ -/* computation. */ - - -/* Now continue building the product. Note we will toggle */ -/* back and forth from TEMP(,,1) to TEMP(,,2) for storing */ -/* (PUTting) the results of our computations. This way we */ -/* don't have to spend time moving any of the our computation */ -/* results to get ready for the next product. See the end */ -/* of the loop below (keeping mind the next three values) to */ -/* see the little trick that's used to toggle back and forth. */ - - incr = -1; - put = 2; - get = 1; - i__1 = *n - 1; - for (i__ = 3; i__ <= i__1; ++i__) { - -/* First the uppper left hand portion of the product. */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - temp[(i__2 = j + (k + put * 6) * 6 - 43) < 72 && 0 <= - i__2 ? i__2 : s_rnge("temp", i__2, "zzmsxf_", ( - ftnlen)306)] = matrix[j + (i__ * 6 + 1) * 6 - 43] - * temp[(i__3 = (k + get * 6) * 6 - 42) < 72 && 0 - <= i__3 ? i__3 : s_rnge("temp", i__3, "zzmsxf_", ( - ftnlen)306)] + matrix[j + (i__ * 6 + 2) * 6 - 43] - * temp[(i__4 = (k + get * 6) * 6 - 41) < 72 && 0 - <= i__4 ? i__4 : s_rnge("temp", i__4, "zzmsxf_", ( - ftnlen)306)] + matrix[j + (i__ * 6 + 3) * 6 - 43] - * temp[(i__5 = (k + get * 6) * 6 - 40) < 72 && 0 - <= i__5 ? i__5 : s_rnge("temp", i__5, "zzmsxf_", ( - ftnlen)306)]; - } - } - -/* Next the lower left hand portion of the product. */ - - for (j = 4; j <= 6; ++j) { - for (k = 1; k <= 3; ++k) { - temp[(i__2 = j + (k + put * 6) * 6 - 43) < 72 && 0 <= - i__2 ? i__2 : s_rnge("temp", i__2, "zzmsxf_", ( - ftnlen)318)] = matrix[j + (i__ * 6 + 1) * 6 - 43] - * temp[(i__3 = (k + get * 6) * 6 - 42) < 72 && 0 - <= i__3 ? i__3 : s_rnge("temp", i__3, "zzmsxf_", ( - ftnlen)318)] + matrix[j + (i__ * 6 + 2) * 6 - 43] - * temp[(i__4 = (k + get * 6) * 6 - 41) < 72 && 0 - <= i__4 ? i__4 : s_rnge("temp", i__4, "zzmsxf_", ( - ftnlen)318)] + matrix[j + (i__ * 6 + 3) * 6 - 43] - * temp[(i__5 = (k + get * 6) * 6 - 40) < 72 && 0 - <= i__5 ? i__5 : s_rnge("temp", i__5, "zzmsxf_", ( - ftnlen)318)] + matrix[j + (i__ * 6 + 4) * 6 - 43] - * temp[(i__6 = (k + get * 6) * 6 - 39) < 72 && 0 - <= i__6 ? i__6 : s_rnge("temp", i__6, "zzmsxf_", ( - ftnlen)318)] + matrix[j + (i__ * 6 + 5) * 6 - 43] - * temp[(i__7 = (k + get * 6) * 6 - 38) < 72 && 0 - <= i__7 ? i__7 : s_rnge("temp", i__7, "zzmsxf_", ( - ftnlen)318)] + matrix[j + (i__ * 6 + 6) * 6 - 43] - * temp[(i__8 = (k + get * 6) * 6 - 37) < 72 && 0 - <= i__8 ? i__8 : s_rnge("temp", i__8, "zzmsxf_", ( - ftnlen)318)]; - } - } - -/* And as before, we don't need to compute the upper right */ -/* or lower right hand 3x3 portions of the matrix. So */ -/* we just skip them. Toggle GET and PUT so we will */ -/* be ready for the next pass. */ - - get = put; - put += incr; - incr = -incr; - } - -/* Finally compute the last product. First the upper */ -/* left hand portion of the product. */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)347)] = - matrix[j + (*n * 6 + 1) * 6 - 43] * temp[(i__2 = (k + - get * 6) * 6 - 42) < 72 && 0 <= i__2 ? i__2 : s_rnge( - "temp", i__2, "zzmsxf_", (ftnlen)347)] + matrix[j + (* - n * 6 + 2) * 6 - 43] * temp[(i__3 = (k + get * 6) * 6 - - 41) < 72 && 0 <= i__3 ? i__3 : s_rnge("temp", i__3, - "zzmsxf_", (ftnlen)347)] + matrix[j + (*n * 6 + 3) * - 6 - 43] * temp[(i__4 = (k + get * 6) * 6 - 40) < 72 && - 0 <= i__4 ? i__4 : s_rnge("temp", i__4, "zzmsxf_", ( - ftnlen)347)]; - } - } - -/* The lower left hand portion of the product. */ - - for (j = 4; j <= 6; ++j) { - for (k = 1; k <= 3; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)358)] = - matrix[j + (*n * 6 + 1) * 6 - 43] * temp[(i__2 = (k + - get * 6) * 6 - 42) < 72 && 0 <= i__2 ? i__2 : s_rnge( - "temp", i__2, "zzmsxf_", (ftnlen)358)] + matrix[j + (* - n * 6 + 2) * 6 - 43] * temp[(i__3 = (k + get * 6) * 6 - - 41) < 72 && 0 <= i__3 ? i__3 : s_rnge("temp", i__3, - "zzmsxf_", (ftnlen)358)] + matrix[j + (*n * 6 + 3) * - 6 - 43] * temp[(i__4 = (k + get * 6) * 6 - 40) < 72 && - 0 <= i__4 ? i__4 : s_rnge("temp", i__4, "zzmsxf_", ( - ftnlen)358)] + matrix[j + (*n * 6 + 4) * 6 - 43] * - temp[(i__5 = (k + get * 6) * 6 - 39) < 72 && 0 <= - i__5 ? i__5 : s_rnge("temp", i__5, "zzmsxf_", (ftnlen) - 358)] + matrix[j + (*n * 6 + 5) * 6 - 43] * temp[( - i__6 = (k + get * 6) * 6 - 38) < 72 && 0 <= i__6 ? - i__6 : s_rnge("temp", i__6, "zzmsxf_", (ftnlen)358)] - + matrix[j + (*n * 6 + 6) * 6 - 43] * temp[(i__7 = (k - + get * 6) * 6 - 37) < 72 && 0 <= i__7 ? i__7 : - s_rnge("temp", i__7, "zzmsxf_", (ftnlen)358)]; - } - } - -/* The upper right hand portion of the product is zero. */ - - for (j = 1; j <= 3; ++j) { - for (k = 4; k <= 6; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)371)] = 0.; - } - } - -/* The lower right hand portion of the product is a copy of */ -/* the upper left hand portion of the product. */ - - for (j = 4; j <= 6; ++j) { - l = j - 3; - for (k = 4; k <= 6; ++k) { - m = k - 3; - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)384)] = - output[(i__2 = l + m * 6 - 7) < 36 && 0 <= i__2 ? - i__2 : s_rnge("output", i__2, "zzmsxf_", (ftnlen)384)] - ; - } - } - } else if (*n == 1) { - -/* If there is only one matrix in the list the output is */ -/* simply the input. */ - - for (i__ = 1; i__ <= 6; ++i__) { - for (j = 1; j <= 6; ++j) { - output[(i__1 = j + i__ * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)398)] = - matrix[j + (i__ + 6) * 6 - 43]; - } - } - } else if (*n <= 0) { - for (j = 1; j <= 6; ++j) { - output[(i__1 = j + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : s_rnge( - "output", i__1, "zzmsxf_", (ftnlen)407)] = 1.; - for (k = j + 1; k <= 6; ++k) { - output[(i__1 = j + k * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)410)] = 0.; - output[(i__1 = k + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzmsxf_", (ftnlen)411)] = 0.; - } - } - } - return 0; -} /* zzmsxf_ */ - diff --git a/ext/spice/src/cspice/zznofcon.c b/ext/spice/src/cspice/zznofcon.c deleted file mode 100644 index 796f823eab..0000000000 --- a/ext/spice/src/cspice/zznofcon.c +++ /dev/null @@ -1,685 +0,0 @@ -/* zznofcon.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__14 = 14; -static integer c__1 = 1; - -/* $Procedure ZZNOFCON ( Create frame connection long error message ) */ -/* Subroutine */ int zznofcon_(doublereal *et, integer *frame1, integer * - endp1, integer *frame2, integer *endp2, char *errmsg, ftnlen - errmsg_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[32*2]; - integer i__; - char bname[32*2]; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( - char *, ftnlen); - integer class__; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer endps[2]; - extern /* Subroutine */ int repmf_(char *, char *, doublereal *, integer * - , char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen); - integer sclkid; - logical havnam[2]; - integer frames[2], center, clssid; - char phrase[400]; - extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - logical ckmiss; - extern /* Subroutine */ int chkout_(char *, ftnlen); - logical scmiss; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - extern logical return_(void), zzsclk_(integer *, integer *); - char timstr[35]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Create an informative long error message for cases where the */ -/* frame system signals a SPICE(NOFRAMECONNECT) error. */ - -/* $ 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 */ - -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* FRAMES */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ET I Epoch. */ -/* FRAME1 I "From" frame ID code. */ -/* ENDP1 I "From" path endpoint frame ID code. */ -/* FRAME2 I "To" frame ID code. */ -/* ENDP2 I "To" path endpoint frame ID code. */ -/* ERRMSG O Long error message. */ - -/* $ Detailed_Input */ - -/* ET Epoch of frame transformation, expressed as */ -/* seconds past J2000 TDB. */ - -/* FRAME1 Frame ID code of frame at start of first path. */ - -/* ENDP1 Frame ID code of frame at end of first path; */ -/* this frame is the last node that could be */ -/* reached from the frame designated by FRAME1. */ - -/* FRAME2 Frame ID code of frame at start of second path. */ - -/* ENDP2 Frame ID code of frame at end of second path; */ -/* this frame is the last node that could be */ -/* reached from the frame designated by FRAME2. */ - -/* $ Detailed_Output */ - -/* ERRMSG Long error message specifying computable */ -/* frame paths, indications of missing SCLK */ -/* or CK data, and optionally, debugging hints. */ - -/* The rules for formation of this message are: */ - -/* 1) State the epoch. */ - -/* 2) State the names of the frames for which */ -/* a connection was attempted, if these */ -/* names are available. */ - -/* 3) State the names of the frames at the */ -/* endpoints of both paths, if these */ -/* names are available. */ - -/* Omit this portion of the message for any */ -/* path of length one: in other words, if a */ -/* frame and path endpoint coincide, omit the */ -/* clause stating the frame can be connected to */ -/* itself. */ - -/* 4) For any path endpoint frame, if that */ -/* frame is of CK type, indicate that */ -/* CK and SCLK data must be loaded for */ -/* that frame. */ - -/* 5) For any path endpoint frame, if that */ -/* frame is of CK type and SCLK data for the */ -/* SCLK associated with that frame are not */ -/* available, indicate this problem, along with */ -/* the CK and SCLK ID codes associated with */ -/* this frame. */ - -/* 6) If at least one path endpoint frame */ -/* is of CK type, and all required SCLK data */ -/* are present, include a closing message */ -/* explaining how CK coverage may be inadequate */ -/* and recommending use of CKBRIEF. */ - -/* 7) If both path endpoint frames are of CK type, */ -/* and required SCLK data are present for only */ -/* one of these frames, include a closing */ -/* message explaining how CK coverage may be */ -/* inadequate for a frame for which SCLK data */ -/* are available, and recommending use of */ -/* CKBRIEF. */ - -/* 8) Omit the closing message if no path */ -/* endpoint CK frame has associated SCLK */ -/* data. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a call to FRINFO or NAMFRM signals an error, this routine */ -/* will not be able to create a long error message. The */ -/* caller will not be able to diagnose the frame connection */ -/* failure, since an error condition will already exist. */ - -/* $ Files */ - -/* 1) Each input frame ID argument will be mapped, if possible, */ -/* to a frame name. Any input frame ID that's not built in */ -/* must */ - -/* $ Particulars */ - -/* This routine centralizes creation of a long error message for */ -/* frame connection failures. This routine should be called */ -/* from: */ - -/* FRMCHG */ -/* REFCHG */ -/* ZZFRMCH0 */ -/* ZZFRMCH1 */ -/* ZZREFCH0 */ -/* ZZREFCH1 */ - -/* $ Examples */ - -/* Below are some examples of messages created by this routine. */ - - -/* 1) At epoch 2.8149297000000E+08 TDB (2008 DEC 02 12:29:30.000 */ -/* TDB), there is insufficient information available to */ -/* transform from reference frame -82000 (CASSINI_SC_COORD) to */ -/* reference frame -41000 (MEX_SPACECRAFT). CASSINI_SC_COORD is */ -/* a CK frame; a CK file containing data for instrument or */ -/* structure -82000 at the epoch shown above, as well as a */ -/* corresponding SCLK kernel, must be loaded in order to use */ -/* this frame. Frame MEX_SPACECRAFT could be transformed to */ -/* frame -41001 (MEX_SC_REF). The latter is a CK frame; a CK */ -/* file containing data for instrument or structure -41001 at */ -/* the epoch shown above, as well as a corresponding SCLK */ -/* kernel, must be loaded in order to use this frame. Failure to */ -/* find required CK data could be due to one or more CK files */ -/* not having been loaded, or to the epoch shown above lying */ -/* within a coverage gap or beyond the coverage bounds of the */ -/* loaded CK files. You can use CKBRIEF with the -dump option to */ -/* display coverage intervals of a CK file. */ - -/* 2) At epoch 2.8149297000000E+08 TDB (2008 DEC 02 12:29:30.000 */ -/* TDB), there is insufficient information available to */ -/* transform from reference frame -82000 (CASSINI_SC_COORD) to */ -/* reference frame 1 (J2000). CASSINI_SC_COORD is a CK frame; a */ -/* CK file containing data for instrument or structure -82000 at */ -/* the epoch shown above, as well as a corresponding SCLK */ -/* kernel, must be loaded in order to use this frame. Failure to */ -/* find required CK data could be due to one or more CK files */ -/* not having been loaded, or to the epoch shown above lying */ -/* within a coverage gap or beyond the coverage bounds of the */ -/* loaded CK files. You can use CKBRIEF with the -dump option to */ -/* display coverage intervals of a CK file. */ - -/* 3) At epoch 2.8149297000000E+08 TDB (2008 DEC 02 12:29:30.000 */ -/* TDB), there is insufficient information available to */ -/* transform from reference frame -82000 (CASSINI_SC_COORD) to */ -/* reference frame -41000 (MEX_SPACECRAFT). CASSINI_SC_COORD is */ -/* a CK frame; a CK file containing data for instrument or */ -/* structure -82000 at the epoch shown above, as well as a */ -/* corresponding SCLK kernel, must be loaded in order to use */ -/* this frame. No SCLK kernel for instrument or structure */ -/* -82000, with corresponding SCLK ID -82, is currently loaded. */ -/* Frame MEX_SPACECRAFT could be transformed to frame -41001 */ -/* (MEX_SC_REF). The latter is a CK frame; a CK file containing */ -/* data for instrument or structure -41001 at the epoch shown */ -/* above, as well as a corresponding SCLK kernel, must be loaded */ -/* in order to use this frame. No SCLK kernel for instrument or */ -/* structure -41001, with corresponding SCLK ID -41, is */ -/* currently loaded. */ - -/* 4) At epoch 2.8149297000000E+08 TDB (2008 DEC 02 12:29:30.000 */ -/* TDB), there is insufficient information available to */ -/* transform from reference frame -82000 (CASSINI_SC_COORD) to */ -/* reference frame -41000 (MEX_SPACECRAFT). CASSINI_SC_COORD is */ -/* a CK frame; a CK file containing data for instrument or */ -/* structure -82000 at the epoch shown above, as well as a */ -/* corresponding SCLK kernel, must be loaded in order to use */ -/* this frame. No SCLK kernel for instrument or structure */ -/* -82000, with corresponding SCLK ID -82, is currently loaded. */ -/* Frame MEX_SPACECRAFT could be transformed to frame -41001 */ -/* (MEX_SC_REF). The latter is a CK frame; a CK file containing */ -/* data for instrument or structure -41001 at the epoch shown */ -/* above, as well as a corresponding SCLK kernel, must be loaded */ -/* in order to use this frame. For a CK frame for which the */ -/* corresponding SCLK kernel has been loaded, failure to find */ -/* required CK data could be due to one or more CK files not */ -/* having been loaded, or to the epoch shown above lying within */ -/* a coverage gap or beyond the coverage bounds of the loaded CK */ -/* files. You can use CKBRIEF with the -dump option to display */ -/* coverage intervals of a CK file. */ - - -/* $ Restrictions */ - -/* 1) This is a private routine. SPICE user applications should not */ -/* call this routine. */ - -/* 2) See exception (1) above. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 14-DEC-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* create error message for frame connection failure */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Because this routine might cause a SPICE error to be */ -/* signaled, we have to check in. */ - - if (return_()) { - return 0; - } - chkin_("ZZNOFCON", (ftnlen)8); - -/* Capture input IDs in arrays. */ - - frames[0] = *frame1; - frames[1] = *frame2; - endps[0] = *endp1; - endps[1] = *endp2; - -/* The flags CKMISS and SCMISS are used, respectively, to */ -/* record whether any CK lookup failed due to missing CK */ -/* data or missing SCLK data. Each of these flags is turned */ -/* on if at least one lookup failed due to the indicated */ -/* cause. */ - - ckmiss = FALSE_; - scmiss = FALSE_; - -/* Get a string representation of the transformation epoch. */ - - etcal_(et, timstr, (ftnlen)35); - -/* Get the names of the participating frames, if available. */ - - frmnam_(frames, name__, (ftnlen)32); - frmnam_(&frames[1], name__ + 32, (ftnlen)32); - frmnam_(endps, bname, (ftnlen)32); - frmnam_(&endps[1], bname + 32, (ftnlen)32); - if (failed_()) { - chkout_("ZZNOFCON", (ftnlen)8); - return 0; - } - for (i__ = 1; i__ <= 2; ++i__) { - if (s_cmp(name__ + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("name", i__1, "zznofcon_", (ftnlen)366)) << 5), " ", ( - ftnlen)32, (ftnlen)1) == 0) { - s_copy(name__ + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("name", i__1, "zznofcon_", (ftnlen)368)) << 5), - "Name not available", (ftnlen)32, (ftnlen)18); - havnam[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("havnam", - i__1, "zznofcon_", (ftnlen)369)] = FALSE_; - } else { - havnam[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("havnam", - i__1, "zznofcon_", (ftnlen)371)] = TRUE_; - } - if (s_cmp(bname + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "bname", i__1, "zznofcon_", (ftnlen)374)) << 5), " ", (ftnlen) - 32, (ftnlen)1) == 0) { - s_copy(bname + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("bname", i__1, "zznofcon_", (ftnlen)375)) << 5), - "Name not available", (ftnlen)32, (ftnlen)18); - } - } - s_copy(errmsg, "At epoch # TDB (# TDB), there is insufficient informatio" - "n available to transform from reference frame # (@) to reference" - " frame # (@).", errmsg_len, (ftnlen)133); - repmf_(errmsg, "#", et, &c__14, "E", errmsg, errmsg_len, (ftnlen)1, ( - ftnlen)1, errmsg_len); - repmc_(errmsg, "#", timstr, errmsg, errmsg_len, (ftnlen)1, (ftnlen)35, - errmsg_len); - for (i__ = 1; i__ <= 2; ++i__) { - repmi_(errmsg, "#", &frames[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("frames", i__1, "zznofcon_", (ftnlen)391)], errmsg, - errmsg_len, (ftnlen)1, errmsg_len); - repmc_(errmsg, "@", name__ + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("name", i__1, "zznofcon_", (ftnlen)392)) << 5), - errmsg, errmsg_len, (ftnlen)1, (ftnlen)32, errmsg_len); - } - -/* For any frame graph longer than a single point, tell the user */ -/* the endpoint of the frame connection graph originating */ -/* at that frame. */ - - for (i__ = 1; i__ <= 2; ++i__) { - if (frames[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("frames", - i__1, "zznofcon_", (ftnlen)403)] != endps[(i__2 = i__ - 1) < - 2 && 0 <= i__2 ? i__2 : s_rnge("endps", i__2, "zznofcon_", ( - ftnlen)403)]) { - s_copy(phrase, "Frame # could be transformed to frame # (@).", ( - ftnlen)400, (ftnlen)44); - if (havnam[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "havnam", i__1, "zznofcon_", (ftnlen)407)]) { - repmc_(phrase, "#", name__ + (((i__1 = i__ - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("name", i__1, "zznofcon_", ( - ftnlen)408)) << 5), phrase, (ftnlen)400, (ftnlen)1, ( - ftnlen)32, (ftnlen)400); - } else { - repmi_(phrase, "#", &frames[(i__1 = i__ - 1) < 2 && 0 <= i__1 - ? i__1 : s_rnge("frames", i__1, "zznofcon_", (ftnlen) - 410)], phrase, (ftnlen)400, (ftnlen)1, (ftnlen)400); - } - repmi_(phrase, "#", &endps[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("endps", i__1, "zznofcon_", (ftnlen)413)], - phrase, (ftnlen)400, (ftnlen)1, (ftnlen)400); - repmc_(phrase, "@", bname + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? - i__1 : s_rnge("bname", i__1, "zznofcon_", (ftnlen)414)) << - 5), phrase, (ftnlen)400, (ftnlen)1, (ftnlen)32, (ftnlen) - 400); - suffix_(phrase, &c__1, errmsg, (ftnlen)400, errmsg_len); - -/* The error messages below are appended only if they're not */ -/* redundant. */ - - if (i__ == 1 || endps[1] != endps[0]) { - -/* For each endpoint frame, if that frame is of CK type, */ -/* indicate the instrument ID for which CK data are needed. */ - - frinfo_(&endps[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("endps", i__1, "zznofcon_", (ftnlen)427)], & - center, &class__, &clssid, &found); - if (failed_()) { - chkout_("ZZNOFCON", (ftnlen)8); - return 0; - } - if (found) { - if (class__ == 3) { - s_copy(phrase, "The latter is a CK frame; a CK file " - "containing data for instrument or structure " - "# at the epoch shown above, as well as a cor" - "responding SCLK kernel, must be loaded in or" - "der to use this frame.", (ftnlen)400, (ftnlen) - 190); - repmi_(phrase, "#", &clssid, phrase, (ftnlen)400, ( - ftnlen)1, (ftnlen)400); - suffix_(phrase, &c__1, errmsg, (ftnlen)400, - errmsg_len); - -/* Find out whether we have SCLK data for this */ -/* CK ID. */ - - ckmeta_(&clssid, "SCLK", &sclkid, (ftnlen)4); - if (! zzsclk_(&clssid, &sclkid)) { - scmiss = TRUE_; - s_copy(phrase, "No SCLK kernel for instrument or" - " structure #, with corresponding SCLK ID" - " #, is currently loaded.", (ftnlen)400, ( - ftnlen)96); - repmi_(phrase, "#", &clssid, phrase, (ftnlen)400, - (ftnlen)1, (ftnlen)400); - repmi_(phrase, "#", &sclkid, phrase, (ftnlen)400, - (ftnlen)1, (ftnlen)400); - suffix_(phrase, &c__1, errmsg, (ftnlen)400, - errmsg_len); - } else { - -/* If we got here and have the SCLK data, then */ -/* we don't have CK data. */ - - ckmiss = TRUE_; - } - } - -/* End of CK frame case. */ - - } - -/* End of "info found" case. */ - - } - -/* End of distinct frame case. */ - - } else if (i__ == 1 || endps[1] != endps[0]) { - -/* The error messages below are appended only if they're not */ -/* redundant. */ - -/* This graph has length one. If the frame comprising */ -/* this graph is a CK frame, generate a phrase */ -/* indicating the needed CK data. */ - - frinfo_(&frames[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "frames", i__1, "zznofcon_", (ftnlen)503)], ¢er, & - class__, &clssid, &found); - if (failed_()) { - chkout_("ZZNOFCON", (ftnlen)8); - return 0; - } - if (found) { - if (class__ == 3) { - s_copy(phrase, "# is a CK frame; a CK file containing da" - "ta for instrument or structure # at the epoch sh" - "own above, as well as a corresponding SCLK kerne" - "l, must be loaded in order to use this frame.", ( - ftnlen)400, (ftnlen)181); - if (havnam[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("havnam", i__1, "zznofcon_", (ftnlen)522)]) - { - repmc_(phrase, "#", name__ + (((i__1 = i__ - 1) < 2 && - 0 <= i__1 ? i__1 : s_rnge("name", i__1, - "zznofcon_", (ftnlen)523)) << 5), phrase, ( - ftnlen)400, (ftnlen)1, (ftnlen)32, (ftnlen) - 400); - } else { - repmi_(phrase, "#", &frames[(i__1 = i__ - 1) < 2 && 0 - <= i__1 ? i__1 : s_rnge("frames", i__1, "zzn" - "ofcon_", (ftnlen)525)], phrase, (ftnlen)400, ( - ftnlen)1, (ftnlen)400); - } - repmi_(phrase, "#", &clssid, phrase, (ftnlen)400, (ftnlen) - 1, (ftnlen)400); - suffix_(phrase, &c__1, errmsg, (ftnlen)400, errmsg_len); - -/* Find out whether we have SCLK data for this */ -/* CK ID. */ - - ckmeta_(&clssid, "SCLK", &sclkid, (ftnlen)4); - if (! zzsclk_(&clssid, &sclkid)) { - scmiss = TRUE_; - s_copy(phrase, "No SCLK kernel for instrument or str" - "ucture #, with corresponding SCLK ID #, is c" - "urrently loaded.", (ftnlen)400, (ftnlen)96); - repmi_(phrase, "#", &clssid, phrase, (ftnlen)400, ( - ftnlen)1, (ftnlen)400); - repmi_(phrase, "#", &sclkid, phrase, (ftnlen)400, ( - ftnlen)1, (ftnlen)400); - suffix_(phrase, &c__1, errmsg, (ftnlen)400, - errmsg_len); - } else { - -/* If we got here and have the SCLK data, then */ -/* we don't have CK data. */ - - ckmiss = TRUE_; - } - } - -/* End of CK frame case. */ - - } - -/* End of "info found" case. */ - - } - -/* End of path length case. */ - - } - -/* End of path loop. */ - - if (ckmiss) { - -/* At least one lookup failed due to missing CK data. */ - -/* The informational message we include depends on whether we */ -/* also lack SCLK data. */ - - if (scmiss) { - -/* We lack SCLK data for one frame and CK data for another. */ - - s_copy(phrase, "For a CK frame for which the corresponding SCLK " - "kernel has been loaded, failure to find required CK data" - " could be due to one or more CK files not having been lo" - "aded, or to the epoch shown above lying within a coverag" - "e gap or beyond the coverage bounds of the loaded CK fil" - "es. You can use CKBRIEF with the -dump option to display" - " coverage intervals of a CK file.", (ftnlen)400, (ftnlen) - 361); - } else { - -/* We have SCLK data but lack CK data. */ - - s_copy(phrase, "Failure to find required CK data could be due to" - " one or more CK files not having been loaded, or to the " - "epoch shown above lying within a coverage gap or beyond " - "the coverage bounds of the loaded CK files. You can use " - "CKBRIEF with the -dump option to display coverage interv" - "als of a CK file.", (ftnlen)400, (ftnlen)289); - } - suffix_(phrase, &c__1, errmsg, (ftnlen)400, errmsg_len); - } - chkout_("ZZNOFCON", (ftnlen)8); - return 0; -} /* zznofcon_ */ - diff --git a/ext/spice/src/cspice/zznrddp.c b/ext/spice/src/cspice/zznrddp.c deleted file mode 100644 index 5be931b4af..0000000000 --- a/ext/spice/src/cspice/zznrddp.c +++ /dev/null @@ -1,1503 +0,0 @@ -/* zznrddp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZNRDDP ( Shell for deep space entry points ) */ -/* Subroutine */ int zznrddp_0_(int n__, doublereal *ao, doublereal *elems, - doublereal *em, doublereal *omgasm, doublereal *omgdot, doublereal *t, - doublereal *xinc, doublereal *xll, doublereal *xlldot, doublereal * - xn, doublereal *xnodes, doublereal *xnodot, doublereal *xnodp) -{ - /* Initialized data */ - - static logical dopert = TRUE_; - - /* System generated locals */ - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal), sin(doublereal), cos(doublereal), d_mod( - doublereal *, doublereal *), atan2(doublereal, doublereal); - - /* Local variables */ - static doublereal ctem, delt, pinc, sghl; - static logical cont; - static doublereal sghs, aqnv, cosq, temp, stem, eqsq, sinq, thgr, xmao, - xnoi, zmol, zmos, pinc0, ainv2, sini2, temp1, cosq2, c__; - extern /* Subroutine */ int zzsecprt_(integer *, doublereal *, doublereal - *, doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - static integer i__; - static doublereal bfact, alfdp, jdtdb; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static doublereal betdp, atime, theta, xfact, preep, jdut50, xincl, cosiq, - cosok, cosis, xlamo, a1, a2, a3, a4, a5, a6, a7, a8, a9, e3, f2, - f3, siniq, sinis, sinok, sinzf, stepn, s1, s2, s3, s4, s5, s6, s7, - stepp, x1, x2, x3, x4, x5, x6, x7, x8, xldot, xnddt, xndot, - xqncl, z1, z2, z3, zcosg, zcosh, zcosi, zsing, zsinh, zsini; - extern doublereal twopi_(void); - static doublereal a10, cc, dg[10], eo, pe, eq, ph, et, ft, se, pl, sh, si, - sl, z11, z12, z13, z21, xl, z22, omegao, z23, z31, z32, z33, ze, - zf, zm, zn, xnodce; - extern doublereal pi_(void); - static doublereal zx, zy; - static integer iresfl; - static doublereal f220, f221, ee2, f311, f321, cosomo, f322, f330, f441, - f442, f522, f523, f542, f543, g200, g201, g211, g300, g310, g322, - g410, g422, g520, g521, g532, g533, oxnode, pe0, ph0, pl0, rteqsq, - se2, se3, sh2, sh3, si2, si3, sinomo, sl2, sl3, sl4, xh2, xh3, - xi2, xi3, xl2, xl3, xl4, xnodeo, zcosgl, zcoshl, zcosil, zsingl, - zsinhl, zsinil; - static integer isynfl; - static doublereal gam, del[3], eoc; - extern doublereal j1950_(void), j2000_(void); - extern logical return_(void); - static doublereal ds50, day, pgh, sgh, sel, bsq, shl, sil; - extern doublereal spd_(void); - static doublereal ses, sll, xli, shs, sis, xni, sls, xmo, xls, xnq; - extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - static doublereal ssx[5], pgh0, sgh2, sgh3, sgh4, xgh2, xgh3, xgh4, pix1, - pix2, xno2; - -/* $ Abstract */ - -/* This subroutine is a shell for the routines needed by DPSPCE */ -/* for calculating deep space effects on a vehicle. */ - -/* $ 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 */ - -/* TWO LINE ELEMENTS */ -/* SPACETRACK */ -/* DEEP SPACE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* AO I Entry ZZDPINIT, Original semimajor axis */ -/* XLLDOT I Entry ZZDPINIT, Time rate of change of XLL */ -/* OMGDOT I Entry ZZDPINIT, Time rate of change of arg of */ -/* " ZZDPSEC perigee */ -/* XNODOT I Entry ZZDPINIT, Time rate of change of mean motion */ -/* XNODP I Entry ZZDPINIT, Original mean motion */ -/* ELEMS I Entry ZZDPINIT, Array of orbit elements */ -/* " ZZDPSEC */ -/* XLL I Entry ZZDPSEC Long-period periodic term */ -/* OMGASM I Entry ZZDPSEC Perturbed argument of perigee */ -/* " ZZDPPER */ -/* XNODES I Entry ZZDPSEC, Perturbed argument of ascending */ -/* " ZZDPPER node */ -/* EM I Entry ZZDPSEC, Perturbed eccentricity of the orbit */ -/* " ZZDPPER at time T */ -/* XINC I Entry ZZDPSEC, Perturbed inclination of the orbit */ -/* " ZZDPPER plane at time T */ -/* XN I Entry ZZDPSEC Perturbed mean motion of the orbit */ -/* at time T */ -/* T I Entry ZZDPSEC, Time of state evaluation */ -/* " ZZDPPER */ - -/* $ Detailed_Input */ - -/* AO the original semimajor axis of the orbit. */ - -/* XLLDOT the time derivative of the XLL long-period term */ - -/* OMGDOT the time derivative of the argument of perigee */ - -/* XNODOT the time derivative of the mean motion */ - -/* XNODP original mean motion of the orbit. */ - -/* ELEMS is an array containing two-line element data */ -/* as prescribed below. The elements XNDD6O and BSTAR */ -/* must already be scaled by the proper exponent stored */ -/* in the two line elements set. Moreover, the */ -/* various items must be converted to the units shown */ -/* here. */ - -/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */ -/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */ -/* ELEMS ( 3 ) = BSTAR */ -/* ELEMS ( 4 ) = XINCL in radians */ -/* ELEMS ( 5 ) = XNODEO in radians */ -/* ELEMS ( 6 ) = EO */ -/* ELEMS ( 7 ) = OMEGAO in radians */ -/* ELEMS ( 8 ) = XMO in radians */ -/* ELEMS ( 9 ) = XNO in radians/minute */ -/* ELEMS ( 10 ) = EPOCH of the elements in seconds */ -/* past ephemeris epoch J2000. */ - -/* XN is the perturbed mean motion from the 'mean' mean */ -/* motion at epoch at time T. */ - -/* T is the total time from the epoch, in minutes, of the */ -/* element set at which to calculate the state. */ - -/* EM is the perturbed eccentricity from the mean */ -/* eccentricity at epoch at time T. */ - -/* XLL a long-period periodic term dependent on inclination, */ -/* eccentricity and argument of periapsis */ - -/* OMGASM the value of the argument of perigee after the */ -/* perturbations at the time of interest are */ -/* added */ - -/* XNODES is the value of the argument of the ascending node */ -/* after the perturbations at the time of interest are */ -/* added. */ - -/* XINC is the perturbed inclination of the orbit plane from */ -/* the mean inclination at the epoch at time T */ - -/* $ Detailed_Output */ - -/* None */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This subroutine is a shell for the entry points used by the */ -/* propagator for deep space orbits, where a deep space orbit is one */ -/* which has a period greater the 225 minutes. The entry points */ -/* are */ - -/* ZZDPINIT - initialize variables for the deep space regime */ -/* ZZDPSEC - calculates and updates secular perturbation terms */ -/* ZZDPPER - calculates and updates periodic perturbation terms */ -/* particularly as caused by the sun and the moon */ - -/* The names of several constants defined in the Spacetrack 3 report */ -/* have been changed. */ - -/* D2201 to DG( 1 ) */ -/* D2211 to DG( 2 ) */ -/* D3210 to DG( 3 ) */ -/* D3222 to DG( 4 ) */ -/* D4410 to DG( 5 ) */ -/* D4422 to DG( 6 ) */ -/* D5220 to DG( 7 ) */ -/* D5232 to DG( 8 ) */ -/* D5421 to DG( 9 ) */ -/* D5433 to DG( 10 ) */ - -/* The names of variables changed from the Spacetrack 3 report */ - -/* DEL1 to DEL( 1 ) */ -/* DEL2 to DEL( 2 ) */ -/* DEL3 to DEL( 3 ) */ -/* SSL to SSX( 1 ) */ -/* SSG to SSX( 2 ) */ -/* SSH to SSX( 3 ) */ -/* SSE to SSX( 4 ) */ -/* SSI to SSX( 5 ) */ -/* OMGDT to OMGDOT */ - -/* The entry point ZZDPPER was modified to insure that the */ -/* perturbations on the elements are zero at the epoch. This was */ -/* not correctly handled in the Spacetrack 3 report. */ - -/* $ Examples */ - -/* Never call this subroutine directly. EVER! */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Spacetrack 3 report */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.1, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Declarations section */ -/* in ZZDPINIT, ZZDPPER, ZZDPSEC. */ - -/* - SPICELIB Version 1.5.0, 20-JAN-1999 (EDW) (WLT) */ - -/* OMGDOT, named in an ENTRY point argument list */ -/* was not passed via an argument list. Solaris exhibited a */ -/* bus error because of this situation. All ENTRY point */ -/* arguments are passed only by argument lists and are declared */ -/* in the umbrella subroutine's, ZZNRDDP, argument list. */ - -/* Combined the various SSL, SSG, SSH, SSI, SSE variables into */ -/* the vector SSX. */ - -/* Removed the dependency upon the UTC/ET leapsecond kernel. */ - -/* Alphabetized all variable declaration lists. */ - -/* All arguments passed through entry points listed as arguments */ -/* of ZZNRDDP. OMGDT renamed OMGDOT to be consistent with other */ -/* deep space two line element routines. */ - -/* - SPICELIB Version 1.0.0, 1-APR-1997 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* two line element set */ - -/* -& */ - -/* Local variables */ - - -/* SPICELIB functions */ - - -/* Define rather a large number of local parameters. */ - - -/* Save everything just to be sure. */ - - /* Parameter adjustments */ - if (elems) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzdpinit; - case 2: goto L_zzdpsec; - case 3: goto L_zzdpper; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NRDDP", (ftnlen)5); - } - -/* This routine should never be called. If this routine is called, */ -/* an error is signalled. */ - - setmsg_("NRDDP: You called an entry which performs no run-time function." - " This may indicate a bug. Please check the documentation for the" - " subroutine ZZNRDDP.", (ftnlen)147); - sigerr_("SPICE(EVILBOGUSENTRY)", (ftnlen)21); - chkout_("NRDDP", (ftnlen)5); - return 0; -/* $Procedure ZZDPINIT (Initialize deep space algorithm and variables ) */ - -L_zzdpinit: -/* $ Abstract */ - -/* Entrance for deep space initialization. This section is called */ -/* once per element set. */ - -/* $ 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 */ - -/* KEYWORD */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* AO I Original semimajor axis */ -/* XLLDOT I Time rate of change of XLL */ -/* OMGDOT I Time rate of change of argument of perigee */ -/* XNODOT I Time rate of change of mean motion */ -/* XNODP I Original mean motion */ -/* ELEMS I Array of orbit elements */ - -/* $ Detailed_Input */ - -/* AO the original semimajor axis of the orbit. */ - -/* XLLDOT the time derivative of the XLL long-period term */ - -/* OMGDOT the time derivative of the argument of perigee */ - -/* XNODOT the time derivative of the mean motion */ - -/* XNODP original mean motion of the elements */ - -/* ELEMS is an array containing two-line element data */ -/* as prescribed below. The elements XNDD6O and BSTAR */ -/* must already be scaled by the proper exponent stored */ -/* in the two line elements set. Moreover, the */ -/* various items must be converted to the units shown */ -/* here. */ - -/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */ -/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */ -/* ELEMS ( 3 ) = BSTAR */ -/* ELEMS ( 4 ) = XINCL in radians */ -/* ELEMS ( 5 ) = XNODEO in radians */ -/* ELEMS ( 6 ) = EO */ -/* ELEMS ( 7 ) = OMEGAO in radians */ -/* ELEMS ( 8 ) = XMO in radians */ -/* ELEMS ( 9 ) = XNO in radians/minute */ -/* ELEMS ( 10 ) = EPOCH of the elements in seconds */ -/* past ephemeris epoch J2000. */ - -/* $ Detailed_Output */ - -/* No direct output. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine only initializes non-time dependent variables and */ -/* sets flags concerning whether the orbit is synchronous or */ -/* experiences resonance effects. It should be called once per */ -/* element set. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) This routine should only be called by DPSPCE when propagating */ -/* two line element sets. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Spacetrack 3 report */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.1, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Declarations section */ -/* in ZZDPINIT, ZZDPPER, ZZDPSEC. */ - -/* - SPICELIB Version 1.5.0, 20-JAN-1999 (EDW) (WLT) */ - -/* OMGDOT, named in an ENTRY point argument list */ -/* was not passed via an argument list. Solaris exhibited a */ -/* bus error because of this situation. All ENTRY point */ -/* arguments are passed only by argument lists and are declared */ -/* in the umbrella subroutine's, ZZNRDDP, argument list. */ - -/* Combined the various SSL, SSG, SSH, SSI, SSE variables into */ -/* the vector SSX. */ - -/* Removed the dependency upon the UTC/ET leapsecond kernel. */ - -/* Alphabetized all variable declaration lists. */ - -/* All arguments passed through entry points listed as arguments */ -/* of ZZNRDDP. OMGDT renamed OMGDOT to be consistent with other */ -/* deep space two line element routines. */ - -/* - SPICELIB Version 1.0.0, APR-30-1997 (EDW) */ - - -/* -& */ -/* $ Index_Entries */ - -/* two line elements, deep space, initialize */ - -/* -& */ - pix1 = pi_(); - pix2 = twopi_(); - -/* Unpack the elements array. */ - - xincl = elems[3]; - xnodeo = elems[4]; - eo = elems[5]; - omegao = elems[6]; - xmo = elems[7]; - -/* Calculate intermediate values */ - -/* Computing 2nd power */ - d__1 = eo; - eqsq = d__1 * d__1; - bsq = 1. - eqsq; - rteqsq = sqrt(bsq); - siniq = sin(xincl); - cosiq = cos(xincl); -/* Computing 2nd power */ - d__1 = cosiq; - cosq2 = d__1 * d__1; - sinomo = sin(omegao); - cosomo = cos(omegao); - -/* This section of code was previously performed by the THETAG */ -/* function. The epoch of the elements is defined in seconds since */ -/* J2000. It is necessary to calculate the number of days which have */ -/* elapsed since the Jan 0.0 1950 reference date which is */ -/* Dec 31 1949 00:00:00 UTC ( J1950 - 1 ). First extract the epoch */ -/* from the ELEMS array and place it in the first entry of a working */ -/* array. */ - - et = elems[9]; - -/* Convert the ET seconds past 2000 to the Julian date TDB. */ - - jdtdb = j2000_() + et / spd_(); - -/* How many days since the 1950 reference? Using SPICE standard */ -/* leapseconds the difference between TDB and UTC in 1950 is 32.184 */ -/* seconds. So we compute JDTDB corresponding to the UTC 1950 */ -/* epoch. We call this JDTDB epoch ---JDUT50. Then we get the days */ -/* since 1950 by simple arithmetic. */ - - jdut50 = j1950_() - 1. + 32.184 / spd_(); - ds50 = jdtdb - jdut50; - -/* What is the Earth's right ascension of the epoch? We know the */ -/* value at the JD1950-1 reference date, so add the number of radians */ -/* the Earth has rotated through since then. MOD this value with */ -/* 2*PI to get the right ascension for the epoch. This technique may */ -/* not be the best way to get this value. */ - - theta = ds50 * 6.3003880987 + 1.72944494; - thgr = d_mod(&theta, &pix2); - -/* THGR should have a domain between 0 and 2 Pi. */ - - if (thgr < 0.) { - thgr += pix2; - } - -/* Set some operation variables. */ - - eq = eo; - xnq = *xnodp; - aqnv = 1. / *ao; - xqncl = xincl; - xmao = xmo; - sinq = sin(xnodeo); - cosq = cos(xnodeo); - -/* Initialize lunar solar terms */ - - day = ds50 + 18261.5; - if (day != preep) { - preep = day; - xnodce = 4.523602 - day * 9.2422029e-4; - stem = sin(xnodce); - ctem = cos(xnodce); - zcosil = .91375164 - ctem * .03568096; -/* Computing 2nd power */ - d__1 = zcosil; - zsinil = sqrt(1. - d__1 * d__1); - zsinhl = stem * .089683511 / zsinil; -/* Computing 2nd power */ - d__1 = zsinhl; - zcoshl = sqrt(1. - d__1 * d__1); - c__ = day * .2299715 + 4.7199672; - gam = day * .001944368 + 5.8351514; - d__1 = c__ - gam; - zmol = d_mod(&d__1, &pix2); - if (zmol < 0.) { - zmol += pix2; - } - zx = stem * .39785416 / zsinil; - zy = zcoshl * ctem + zsinhl * .91744867 * stem; - -/* Compute the angle from the x-axis of the point */ - - if (zx != 0. || zy != 0.) { - zx = atan2(zx, zy); - if (zx < 0.) { - zx += pix2; - } - } else { - zx = 0.; - } - zx = gam + zx - xnodce; - zcosgl = cos(zx); - zsingl = sin(zx); - zmos = day * .017201977 + 6.2565837; - zmos = d_mod(&zmos, &pix2); - if (zmos < 0.) { - zmos += pix2; - } - } - -/* Do solar terms. Start with the constant values. */ - - zcosg = .1945905; - zsing = -.98088458; - zcosi = .91744867; - zsini = .39785416; - zcosh = cosq; - zsinh = sinq; - cc = 2.9864797e-6; - zn = 1.19459e-5; - ze = .01675; - xnoi = 1. / xnq; - -/* Initialize solar and lunar terms. The procedure will */ -/* first initialize just the solar, then the lunar, then */ -/* reinitialize the solar with the added lunar effect. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Solar. Anyone know what this means? */ - - a1 = zcosg * zcosh + zsing * zcosi * zsinh; - a3 = -zsing * zcosh + zcosg * zcosi * zsinh; - a7 = -zcosg * zsinh + zsing * zcosi * zcosh; - a8 = zsing * zsini; - a9 = zsing * zsinh + zcosg * zcosi * zcosh; - a10 = zcosg * zsini; - a2 = cosiq * a7 + siniq * a8; - a4 = cosiq * a9 + siniq * a10; - a5 = -siniq * a7 + cosiq * a8; - a6 = -siniq * a9 + cosiq * a10; - x1 = a1 * cosomo + a2 * sinomo; - x2 = a3 * cosomo + a4 * sinomo; - x3 = -a1 * sinomo + a2 * cosomo; - x4 = -a3 * sinomo + a4 * cosomo; - x5 = a5 * sinomo; - x6 = a6 * sinomo; - x7 = a5 * cosomo; - x8 = a6 * cosomo; -/* Computing 2nd power */ - d__1 = x1; -/* Computing 2nd power */ - d__2 = x3; - z31 = d__1 * d__1 * 12. - d__2 * d__2 * 3.; - z32 = x1 * 24. * x2 - x3 * 6. * x4; -/* Computing 2nd power */ - d__1 = x2; -/* Computing 2nd power */ - d__2 = x4; - z33 = d__1 * d__1 * 12. - d__2 * d__2 * 3.; -/* Computing 2nd power */ - d__1 = a1; -/* Computing 2nd power */ - d__2 = a2; - z1 = (d__1 * d__1 + d__2 * d__2) * 3. + z31 * eqsq; - z2 = (a1 * a3 + a2 * a4) * 6. + z32 * eqsq; -/* Computing 2nd power */ - d__1 = a3; -/* Computing 2nd power */ - d__2 = a4; - z3 = (d__1 * d__1 + d__2 * d__2) * 3. + z33 * eqsq; - z11 = a1 * -6. * a5 + eqsq * (x1 * -24. * x7 - x3 * 6. * x5); - z12 = (a1 * a6 + a3 * a5) * -6. + eqsq * ((x2 * x7 + x1 * x8) * -24. - - (x3 * x6 + x4 * x5) * 6.); - z13 = a3 * -6. * a6 + eqsq * (x2 * -24. * x8 - x4 * 6. * x6); - z21 = a2 * 6. * a5 + eqsq * (x1 * 24. * x5 - x3 * 6. * x7); - z22 = (a4 * a5 + a2 * a6) * 6. + eqsq * ((x2 * x5 + x1 * x6) * 24. - ( - x4 * x7 + x3 * x8) * 6.); - z23 = a4 * 6. * a6 + eqsq * (x2 * 24. * x6 - x4 * 6. * x8); - z1 = z1 + z1 + bsq * z31; - z2 = z2 + z2 + bsq * z32; - z3 = z3 + z3 + bsq * z33; - s3 = cc * xnoi; - s2 = s3 * -.5 / rteqsq; - s4 = s3 * rteqsq; - s1 = eq * -15. * s4; - s5 = x1 * x3 + x2 * x4; - s6 = x2 * x3 + x1 * x4; - s7 = x2 * x4 - x1 * x3; - se = s1 * zn * s5; - si = s2 * zn * (z11 + z13); - sl = -zn * s3 * (z1 + z3 - 14. - eqsq * 6.); - sgh = s4 * zn * (z31 + z33 - 6.); - sh = -zn * s2 * (z21 + z23); - if (xqncl < .052359877) { - sh = 0.; - } - ee2 = s1 * 2. * s6; - e3 = s1 * 2. * s7; - xi2 = s2 * 2. * z12; - xi3 = s2 * 2. * (z13 - z11); - xl2 = s3 * -2. * z2; - xl3 = s3 * -2. * (z3 - z1); - xl4 = s3 * -2. * (-21. - eqsq * 9.) * ze; - xgh2 = s4 * 2. * z32; - xgh3 = s4 * 2. * (z33 - z31); - xgh4 = s4 * -18. * ze; - xh2 = s2 * -2. * z22; - xh3 = s2 * -2. * (z23 - z21); - if (i__ == 1) { - -/* Do lunar terms after solar terms, but only once. */ - - ssx[0] = sl; - ssx[2] = sh / siniq; - ssx[1] = sgh - cosiq * ssx[2]; - ssx[3] = se; - ssx[4] = si; - se2 = ee2; - si2 = xi2; - sl2 = xl2; - sgh2 = xgh2; - sh2 = xh2; - se3 = e3; - si3 = xi3; - sl3 = xl3; - sgh3 = xgh3; - sh3 = xh3; - sl4 = xl4; - sgh4 = xgh4; - zcosg = zcosgl; - zsing = zsingl; - zcosi = zcosil; - zsini = zsinil; - zcosh = zcoshl * cosq + zsinhl * sinq; - zsinh = sinq * zcoshl - cosq * zsinhl; - zn = 1.5835218e-4; - cc = 4.7968065e-7; - ze = .0549; - } - } - ssx[0] += sl; - ssx[1] = ssx[1] + sgh - cosiq / siniq * sh; - ssx[2] += sh / siniq; - ssx[3] += se; - ssx[4] += si; - -/* Geopotential resonance initialization for 12 hour orbits */ - - iresfl = 0; - isynfl = 0; - if (xnq < .0052359877 && xnq > .0034906585) { - -/* Synchronous resonance terms initialization */ - - iresfl = 1; - isynfl = 1; - g200 = eqsq * (eqsq * .8125 - 2.5) + 1.; - g310 = eqsq * 2. + 1.; - g300 = eqsq * (eqsq * 6.60937 - 6.) + 1.; -/* Computing 2nd power */ - d__1 = cosiq + 1.; - f220 = d__1 * d__1 * .75; - f311 = siniq * .9375 * siniq * (cosiq * 3. + 1.) - (cosiq + 1.) * .75; -/* Computing 3rd power */ - d__1 = cosiq + 1.; - f330 = d__1 * (d__1 * d__1) * 1.875; -/* Computing 2nd power */ - d__1 = xnq; -/* Computing 2nd power */ - d__2 = aqnv; - del[0] = d__1 * d__1 * 3. * (d__2 * d__2); - del[1] = del[0] * 2. * f220 * g200 * 1.7891679e-6; - del[2] = del[0] * 3. * f330 * g300 * 2.2123015e-7 * aqnv; - del[0] = del[0] * f311 * g310 * 2.1460748e-6 * aqnv; - xlamo = xmao + xnodeo + omegao - thgr; - bfact = *xlldot + *omgdot + *xnodot - .0043752691; - bfact = bfact + ssx[0] + ssx[1] + ssx[2]; - } else { - if (xnq < .00826 || xnq > .00924 || eq < .5) { - return 0; - } - iresfl = 1; - eoc = eq * eqsq; - g201 = -.306 - (eq - .64) * .44; - -/* Looks icky doesn't it? */ - - if (eq > .65) { - g211 = eq * 331.819 - 72.099 - eqsq * 508.738 + eoc * 266.724; - g310 = eq * 1582.851 - 346.844 - eqsq * 2415.925 + eoc * 1246.113; - g322 = eq * 1554.908 - 342.585 - eqsq * 2366.899 + eoc * 1215.972; - g410 = eq * 4758.686 - 1052.797 - eqsq * 7193.992 + eoc * - 3651.957; - g422 = eq * 16178.11 - 3581.69 - eqsq * 24462.77 + eoc * 12422.52; - -/* Decide on the G520 coefficient. */ - - if (eq > .715) { - g520 = eq * 29936.92 - 5149.66 - eqsq * 54087.36 + eoc * - 31324.56; - } else { - g520 = 1464.74 - eq * 4664.75 + eqsq * 3763.64; - } - } else { - g211 = 3.616 - eq * 13.247 + eqsq * 16.29; - g310 = eq * 117.39 - 19.302 - eqsq * 228.419 + eoc * 156.591; - g322 = eq * 109.7927 - 18.9068 - eqsq * 214.6334 + eoc * 146.5816; - g410 = eq * 242.694 - 41.122 - eqsq * 471.094 + eoc * 313.953; - g422 = eq * 841.88 - 146.407 - eqsq * 1629.014 + eoc * 1083.435; - g520 = eq * 3017.977 - 532.114 - eqsq * 5740. + eoc * 3708.276; - } - if (eq >= .7) { - g533 = eq * 161616.52 - 37995.78 - eqsq * 229838.2 + eoc * - 109377.94; - g521 = eq * 218913.95 - 51752.104 - eqsq * 309468.16 + eoc * - 146349.42; - g532 = eq * 170470.89 - 40023.88 - eqsq * 242699.48 + eoc * - 115605.82; - } else { - g533 = eq * 4988.61 - 919.2277 - eqsq * 9064.77 + eoc * 5542.21; - g521 = eq * 4568.6173 - 822.71072 - eqsq * 8491.4146 + eoc * - 5337.524; - g532 = eq * 4690.25 - 853.666 - eqsq * 8624.77 + eoc * 5341.4; - } - -/* The tall man walks at night. */ - - sini2 = siniq * siniq; - f220 = (cosiq * 2. + 1. + cosq2) * .75; - f221 = sini2 * 1.5; - f321 = siniq * 1.875 * (1. - cosiq * 2. - cosq2 * 3.); - f322 = siniq * -1.875 * (cosiq * 2. + 1. - cosq2 * 3.); - f441 = sini2 * 35. * f220; - f442 = sini2 * 39.375 * sini2; - f522 = siniq * 9.84375 * (sini2 * (1. - cosiq * 2. - cosq2 * 5.) + ( - cosiq * 4. - 2. + cosq2 * 6.) * .33333333); - f523 = siniq * (sini2 * 4.92187512 * (-2. - cosiq * 4. + cosq2 * 10.) - + (cosiq * 2. + 1. - cosq2 * 3.) * 6.56250012); - f542 = siniq * 29.53125 * (2. - cosiq * 8. + cosq2 * (cosiq * 8. - - 12. + cosq2 * 10.)); - f543 = siniq * 29.53125 * (-2. - cosiq * 8. + cosq2 * (cosiq * 8. + - 12. - cosq2 * 10.)); - xno2 = xnq * xnq; - ainv2 = aqnv * aqnv; - temp1 = xno2 * 3. * ainv2; - temp = temp1 * 1.7891679e-6; - dg[0] = temp * f220 * g201; - dg[1] = temp * f221 * g211; - temp1 *= aqnv; - temp = temp1 * 3.7393792e-7; - dg[2] = temp * f321 * g310; - dg[3] = temp * f322 * g322; - temp1 *= aqnv; - temp = temp1 * 2. * 7.3636953e-9; - dg[4] = temp * f441 * g410; - dg[5] = temp * f442 * g422; - temp1 *= aqnv; - temp = temp1 * 1.1428639e-7; - dg[6] = temp * f522 * g520; - dg[7] = temp * f523 * g532; - temp = temp1 * 2. * 2.1765803e-9; - dg[8] = temp * f542 * g521; - dg[9] = temp * f543 * g533; - xlamo = xmao + xnodeo + xnodeo - thgr - thgr; - bfact = *xlldot + *xnodot + *xnodot - .0043752691 - .0043752691; - bfact = bfact + ssx[0] + ssx[2] + ssx[2]; - } - xfact = bfact - xnq; - -/* Initialize integrator */ - - xli = xlamo; - xni = xnq; - atime = 0.; - return 0; -/* $Procedure ZZDPSEC (Calculate secular perturbations ) */ - -L_zzdpsec: -/* $ Abstract */ - -/* Entrance for deep space secular effects */ - -/* $ 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 */ - -/* SECULAR PERTURBATION */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* XLL I Long-period periodic term */ -/* OMGASM I Perturbed argument of perigee */ -/* XNODES I Perturbed argument of ascending node */ -/* T I Time to calculate perturbation */ -/* ELEMS I The two line elements array */ -/* XN O Perturbed mean motion of the orbit at time T */ -/* EM O Perturbed eccentricity of the orbit at time T */ -/* XINC O Perturbed inclination of the orbit plane at time T */ - -/* $ Detailed_Input */ - -/* XLL a long-period periodic term dependent on inclination, */ -/* eccentricity and argument of periapsis */ - -/* OMGASM the value of the argument of perigee after the */ -/* perturbations at the time of interest are */ -/* added */ - -/* XNODES is the value of the argument of the ascending node */ -/* after the perturbations at the time of interest are */ -/* added. */ - -/* T is the total time from the epoch, in minutes, of the */ -/* element set at which to calculate the perturbation. */ - -/* ELEMS is an array containing two-line element data */ -/* as prescribed below. The elements XNDD6O and BSTAR */ -/* must already be scaled by the proper exponent stored */ -/* in the two line elements set. Moreover, the */ -/* various items must be converted to the units shown */ -/* here. */ - -/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */ -/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */ -/* ELEMS ( 3 ) = BSTAR */ -/* ELEMS ( 4 ) = XINCL in radians */ -/* ELEMS ( 5 ) = XNODEO in radians */ -/* ELEMS ( 6 ) = EO */ -/* ELEMS ( 7 ) = OMEGAO in radians */ -/* ELEMS ( 8 ) = XMO in radians */ -/* ELEMS ( 9 ) = XNO in radians/minute */ -/* ELEMS ( 10 ) = EPOCH of the elements in seconds */ -/* past ephemeris epoch J2000. */ - -/* $ Detailed_Output */ - -/* XN is the perturbed mean motion from the 'mean' mean */ -/* motion at epoch at time T. */ - -/* EM is the perturbed eccentricity from the mean */ -/* eccentricity at epoch at time T. */ - -/* XINC is the perturbed inclination of the orbit plane from */ -/* the mean inclination at the epoch at time T */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* The operation of this routine is to calculate the current secular */ -/* perturbations of the 'mean' orbit elements. The extent of the */ -/* perturbations is determined by the state of the IRESFL flag. This */ -/* flag indicates whether the resonance effects will or will not be */ -/* calculated for the vehicle. Resonance will be calculated when */ -/* mean motion is between 0.8 to 1.2 orbits per day (approximately */ -/* geosynch), or between 1.9 and 2.1 orbits per days. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) This routine should only be called by DPSPCE when propagating */ -/* two line element sets. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Spacetrack 3 report */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.1, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Declarations section */ -/* in ZZDPINIT, ZZDPPER, ZZDPSEC. */ - -/* - SPICELIB Version 1.5.0, 20-JAN-1999 (EDW) (WLT) */ - -/* OMGDOT, named in an ENTRY point argument list */ -/* was not passed via an argument list. Solaris exhibited a */ -/* bus error because of this situation. All ENTRY point */ -/* arguments are passed only by argument lists and are declared */ -/* in the umbrella subroutine's, ZZNRDDP, argument list. */ - -/* Combined the various SSL, SSG, SSH, SSI, SSE variables into */ -/* the vector SSX. */ - -/* Removed the dependency upon the UTC/ET leapsecond kernel. */ - -/* Alphabetized all variable declaration lists. */ - -/* All arguments passed through entry points listed as arguments */ -/* of ZZNRDDP. OMGDT renamed OMGDOT to be consistent with other */ -/* deep space two line element routines. */ - -/* - SPICELIB Version 1.0.0, MAY-2-1997 (EDW) */ - - -/* -& */ -/* $ Index_Entries */ - -/* two line elements, secular perturbation */ - -/* -& */ - stepp = 720.; - stepn = -720.; - xincl = elems[3]; - eo = elems[5]; - *xll += ssx[0] * *t; - *omgasm += ssx[1] * *t; - *xnodes += ssx[2] * *t; - *em = eo + ssx[3] * *t; - *xinc = xincl + ssx[4] * *t; - -/* Check for a positive inclination and the state of the */ -/* resonance flag. */ - - if (*xinc >= 0.f) { - -/* If the resonance flag is not set return. */ - - if (iresfl == 0) { - return 0; - } - } else { - -/* A negative inclination. Fix that and reset XNODES and */ -/* OMGASM then check the resonance flag. */ - - *xinc = -(*xinc); - *xnodes += pix1; - *omgasm -= pix1; - if (iresfl == 0) { - return 0; - } - } - -/* If we got down here then the resonance effects need to be */ -/* calculated. Continue to loop until the CONT flag is set to false. */ - - cont = TRUE_; - while(cont) { - if (atime == 0. || *t >= 0. && atime < 0. || *t < 0. && atime >= 0.) { - -/* Epoch restart */ - - if (*t >= 0.) { - delt = stepp; - } else { - delt = stepn; - } - atime = 0.; - xni = xnq; - xli = xlamo; - cont = FALSE_; - } else if (abs(*t) >= abs(atime)) { - delt = stepn; - if (*t > 0.) { - delt = stepp; - } - cont = FALSE_; - } else { - delt = stepp; - if (*t >= 0.) { - delt = stepn; - } - zzsecprt_(&isynfl, dg, del, &xni, &omegao, &atime, omgdot, &xli, & - xfact, &xldot, &xndot, &xnddt); - xli = xli + xldot * delt + xndot * 259200.; - xni = xni + xndot * delt + xnddt * 259200.; - atime += delt; - cont = TRUE_; - } - } - -/* Do this loop while the time interval is greater than STEPP */ - - while((d__1 = *t - atime, abs(d__1)) >= stepp) { - zzsecprt_(&isynfl, dg, del, &xni, &omegao, &atime, omgdot, &xli, & - xfact, &xldot, &xndot, &xnddt); - xli = xli + xldot * delt + xndot * 259200.; - xni = xni + xndot * delt + xnddt * 259200.; - atime += delt; - } - -/* Calculate the time interval and determine the secular */ -/* perturbations */ - - ft = *t - atime; - zzsecprt_(&isynfl, dg, del, &xni, &omegao, &atime, omgdot, &xli, &xfact, & - xldot, &xndot, &xnddt); - *xn = xni + xndot * ft + xnddt * ft * ft * .5; - xl = xli + xldot * ft + xndot * ft * ft * .5; - temp = -(*xnodes) + thgr + *t * .0043752691; - *xll = xl - *omgasm + temp; - if (isynfl == 0) { - *xll = xl + temp + temp; - } - return 0; -/* $Procedure ZZDPPER ( Calculate periodic perturbations ) */ - -L_zzdpper: -/* $ Abstract */ - -/* Entrances for lunar-solar periodics */ - -/* $ 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 */ - -/* PERIODIC PERTURBATION */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* T I Time to calculate perturbations */ -/* EM O Perturbed eccentricity of the orbit at time T */ -/* XINC O Perturbed inclination of the orbit plane at time T */ -/* OMGASM O Perturbed argument of perigee */ -/* XNODES O Perturbed argument of ascending node */ -/* XLL 0 Long-period periodic term */ - -/* $ Detailed_Input */ - -/* T the time from the epoch in minutes of the element set */ -/* at which to calculate the perturbation. */ - -/* $ Detailed_Output */ - -/* EM is the perturbed eccentricity from the mean */ -/* eccentricity at epoch at time T. */ - -/* XINC is the perturbed inclination of the orbit plane from */ -/* the mean inclination at the epoch at time T. */ - -/* OMGASM the value of the argument of perigee after the */ -/* perturbations at the time of interest are */ -/* added. */ - -/* XNODES is the value of the argument of the ascending node */ -/* after the perturbations at the time of interest are */ -/* added. */ - -/* XLL a long-period periodic term dependent on inclination, */ -/* eccentricity and argument of periapsis. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine calculates the current time dependent periodic */ -/* perturbations values due to the sun and the moon. The original */ -/* version, as taken from the Spacetrack 3 report, had a number of */ -/* bugs. */ - -/* XNODES could be evaluated as being in the wrong quadrant due to */ -/* a failure to insure a domain of 0 to 2 Pi. */ - -/* The SIN and COS of the perturbed inclination, XINCL, were */ -/* calculated before the perturbed value. */ - -/* EM & XINC are input and output values. The input value is updated */ -/* by the addition of a perturbation value. */ - -/* The original report did not recalculate perturbation terms if two */ -/* consecutive epoch times were less than 30 minutes apart. This */ -/* condition has been removed. Perturbation terms are always */ -/* calculated. */ - -/* $ Examples */ - -/* None needed. */ - -/* $ Restrictions */ - -/* 1) This routine should only be called by DPSPCE when propagating */ -/* two line element sets. */ - -/* 2) This routine should be initialized prior to use by making */ -/* a call with the time epoch set to 0. Failure to do so */ -/* invalidates the perturbation calculation. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Spacetrack 3 report */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.1, 19-SEP-2006 (EDW) */ - -/* Added text to previously empty Declarations section */ -/* in ZZDPINIT, ZZDPPER, ZZDPSEC. */ - -/* - SPICELIB Version 1.5.0, 20-JAN-1999 (EDW) (WLT) */ - -/* OMGDOT, named in an ENTRY point argument list */ -/* was not passed via an argument list. Solaris exhibited a */ -/* bus error because of this situation. All ENTRY point */ -/* arguments are passed only by argument lists and are declared */ -/* in the umbrella subroutine's, ZZNRDDP, argument list. */ - -/* Combined the various SSL, SSG, SSH, SSI, SSE variables into */ -/* the vector SSX. */ - -/* Removed the dependency upon the UTC/ET leapsecond kernel. */ - -/* Alphabetized all variable declaration lists. */ - -/* All arguments passed through entry points listed as arguments */ -/* of ZZNRDDP. OMGDT renamed OMGDOT to be consistent with other */ -/* deep space two line element routines. */ - -/* - SPICELIB Version 1.0.0, MAY-17-1997 (EDW) */ - - -/* -& */ -/* $ Index_Entries */ - -/* two line elements, periodic perturbation */ - -/* -& */ - -/* Time varying periodic terms. */ - - -/* Update for solar perts at time T. */ - - zm = zmos + *t * 1.19459e-5; - zf = zm + sin(zm) * .033500000000000002; - sinzf = sin(zf); - f2 = sinzf * .5 * sinzf - .25; - f3 = sinzf * -.5 * cos(zf); - ses = se2 * f2 + se3 * f3; - sis = si2 * f2 + si3 * f3; - sls = sl2 * f2 + sl3 * f3 + sl4 * sinzf; - sghs = sgh2 * f2 + sgh3 * f3 + sgh4 * sinzf; - shs = sh2 * f2 + sh3 * f3; - -/* Update for lunar perts at time T. */ - - zm = zmol + *t * 1.5835218e-4; - zf = zm + sin(zm) * .10979999999999999; - sinzf = sin(zf); - f2 = sinzf * .5 * sinzf - .25; - f3 = sinzf * -.5 * cos(zf); - sel = ee2 * f2 + e3 * f3; - sil = xi2 * f2 + xi3 * f3; - sll = xl2 * f2 + xl3 * f3 + xl4 * sinzf; - sghl = xgh2 * f2 + xgh3 * f3 + xgh4 * sinzf; - shl = xh2 * f2 + xh3 * f3; - -/* Sum of solar and lunar perts */ - - pe = ses + sel; - pinc = sis + sil; - pl = sls + sll; - -/* I'm cold down here. Brrrr. */ - - pgh = sghs + sghl; - ph = shs + shl; - -/* Force the perturbations to be zero at the epoch by setting a */ -/* set of variables to the values of the perturbations at the */ -/* epoch ( T = 0 ). On subsequent calls, these values will be */ -/* subtracted from the perturbations. */ - - if (dopert) { - pe0 = pe; - pinc0 = pinc; - pl0 = pl; - pgh0 = pgh; - ph0 = ph; - pe = 0.; - pinc = 0.; - pl = 0.; - pgh = 0.; - ph = 0.; - dopert = FALSE_; - } else { - -/* Subtract the epoch perturbations off the values just */ -/* calculated. */ - - pe -= pe0; - pinc -= pinc0; - pl -= pl0; - pgh -= pgh0; - ph -= ph0; - } - *xinc += pinc; - *em += pe; - -/* Sin and Cos of the perturbed inclination. The original */ -/* Spacetrack 3 report calculated the values before the */ -/* perturbation. Oops! */ - - sinis = sin(*xinc); - cosis = cos(*xinc); - if (xqncl > .2) { - ph /= siniq; - pgh -= cosiq * ph; - *omgasm += pgh; - *xnodes += ph; - *xll += pl; - } else { - -/* Apply periodics with Lyddane modification */ - - sinok = sin(*xnodes); - cosok = cos(*xnodes); - alfdp = sinis * sinok; - betdp = sinis * cosok; - alfdp = alfdp + ph * cosok + pinc * cosis * sinok; - betdp = betdp - ph * sinok + pinc * cosis * cosok; - -/* Force a 0 - 2Pi domain on XNODES. */ - - if (*xnodes < 0.) { - *xnodes += pix2; - } - xls = *xll + *omgasm + pl + pgh + cosis * *xnodes - sinis * *xnodes * - pinc; - -/* Compute the angle from the x-axis of the point */ - - if (alfdp != 0. || betdp != 0.) { - -/* Save the old value of XNODES, then compute the current value */ -/* From ALFDP and BETDP */ - - oxnode = *xnodes; - *xnodes = atan2(alfdp, betdp); - -/* Force a 0 - 2Pi domain on XNODES */ - - if (*xnodes < 0.) { - *xnodes += pix2; - } - -/* XNODES should be the angular difference between the previous */ -/* value of XNODES and that just calculated. This is a */ -/* correction to the standard SDP4 routine which did not */ -/* calculate this term correctly if XNODES passes from less */ -/* than 2Pi to greater than zero. */ - - if ((d__1 = *xnodes - oxnode, abs(d__1)) > pix1) { - if (*xnodes > oxnode) { - *xnodes -= pix2; - } else { - *xnodes += pix2; - } - } - } else { - *xnodes = 0.; - } - *xll += pl; - *omgasm = xls - *xll - *xnodes * cos(*xinc); - } - return 0; -} /* zznrddp_ */ - -/* Subroutine */ int zznrddp_(doublereal *ao, doublereal *elems, doublereal * - em, doublereal *omgasm, doublereal *omgdot, doublereal *t, doublereal - *xinc, doublereal *xll, doublereal *xlldot, doublereal *xn, - doublereal *xnodes, doublereal *xnodot, doublereal *xnodp) -{ - return zznrddp_0_(0, ao, elems, em, omgasm, omgdot, t, xinc, xll, xlldot, - xn, xnodes, xnodot, xnodp); - } - -/* Subroutine */ int zzdpinit_(doublereal *ao, doublereal *xlldot, doublereal - *omgdot, doublereal *xnodot, doublereal *xnodp, doublereal *elems) -{ - return zznrddp_0_(1, ao, elems, (doublereal *)0, (doublereal *)0, omgdot, - (doublereal *)0, (doublereal *)0, (doublereal *)0, xlldot, ( - doublereal *)0, (doublereal *)0, xnodot, xnodp); - } - -/* Subroutine */ int zzdpsec_(doublereal *xll, doublereal *omgasm, doublereal - *xnodes, doublereal *em, doublereal *xinc, doublereal *xn, doublereal - *t, doublereal *elems, doublereal *omgdot) -{ - return zznrddp_0_(2, (doublereal *)0, elems, em, omgasm, omgdot, t, xinc, - xll, (doublereal *)0, xn, xnodes, (doublereal *)0, (doublereal *) - 0); - } - -/* Subroutine */ int zzdpper_(doublereal *t, doublereal *em, doublereal *xinc, - doublereal *omgasm, doublereal *xnodes, doublereal *xll) -{ - return zznrddp_0_(3, (doublereal *)0, (doublereal *)0, em, omgasm, ( - doublereal *)0, t, xinc, xll, (doublereal *)0, (doublereal *)0, - xnodes, (doublereal *)0, (doublereal *)0); - } - diff --git a/ext/spice/src/cspice/zznwpool.c b/ext/spice/src/cspice/zznwpool.c deleted file mode 100644 index 96eddca434..0000000000 --- a/ext/spice/src/cspice/zznwpool.c +++ /dev/null @@ -1,201 +0,0 @@ -/* zznwpool.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZNWPOOL ( Private: notify watchers of update ) */ -/* Subroutine */ int zznwpool_(char *varnam, char *wtvars, integer *wtptrs, - integer *wtpool, char *wtagnt, char *agtwrk, char *notify, char * - agents, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, - ftnlen agtwrk_len, ftnlen notify_len, ftnlen agents_len) -{ - extern /* Subroutine */ int zzgapool_(char *, char *, integer *, integer * - , char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), chkin_(char *, - ftnlen), copyc_(char *, char *, ftnlen, ftnlen), unionc_(char *, - char *, char *, ftnlen, ftnlen, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due to the */ -/* volatile nature of this routine. */ - -/* Union the set of agents for a specified, watched kernel variable */ -/* with the set of agents on the kernel pool's update notification */ -/* list. */ - -/* $ 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 */ - -/* KERNEL */ - -/* $ Keywords */ - -/* KERNEL */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VARNAM I Kernel variable name. */ -/* WTVARS I Watched kernel variable set. */ -/* WTPTRS I Pointers from variables into the watch pool. */ -/* WTPOOL I Watch pool used for managing agent names. */ -/* WTAGNT I Array of agent names. */ -/* AGTWRK I-O Agent workspace cell. */ -/* NOTIFY I-O Another agent workspace cell. */ -/* AGENTS I-O Set of agents to be notified of updates. */ - -/* $ Detailed_Input */ - -/* VARNAM is the name of a kernel variable. */ - -/* WTVARS is a SPICE set containing the contents of the kernel */ -/* pool watcher system's set WTVARS. */ - -/* WTPTRS is an array containing the contents of the kernel */ -/* pool watcher system's array WTPTRS. */ - -/* WTPOOL is a SPICE doubly linked list pool containing the */ -/* contents of the kernel pool watcher system's pool */ -/* WTPOOL. */ - -/* WTAGNT is an array containing the contents of the kernel */ -/* pool watcher system's array WTAGNT. */ - -/* AGTWRK, */ -/* NOTIFY are two workspace cells used to hold list of agents. */ -/* Both cells must have size at least equal to MXNOTE. */ - -/* $ Detailed_Output */ - -/* AGTWRK, */ -/* NOTIFY are the input workspace cells after use. Contents */ -/* of these cells are undefined. */ - -/* AGTSET is a SPICE set containing the names of the agents */ -/* associated with the kernel variable designated by */ -/* VARNAM. */ - -/* $ Parameters */ - -/* MXNOTE Maximum size of the agent list WTAGNT in POOL. */ -/* See that routine for the parameter's value. */ - - -/* $ Exceptions */ - -/* 1) If the output set AGENTS is too small to hold the result */ -/* of the union performed by this routine, the error will be */ -/* diagnosed by routines in the call tree of this routine. */ - -/* 2) If either workspace cell AGTWRK or NOTIFY has insufficient */ -/* size, the error will be diagnosed by routines in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is not part of the SPICELIB API. This routine */ -/* may be removed in a later version of the SPICE Toolkit, or */ -/* its interface may change. */ - -/* SPICE-based application code should not call this routine. */ - -/* This routine centralizes the work of updating the kernel */ -/* pool's update notification list to account for an update */ -/* of a specified kernel variable. Most kernel pool entry */ -/* points that perform kernel pool updates should call this */ -/* routine to update the notification list. */ - -/* $ Examples */ - -/* See POOL entry point SWPOOL. */ - -/* $ Restrictions */ - -/* 1) This is a private routine. See $Particulars above. */ - -/* 2) Contents of the input arrays are assumed to be valid. */ -/* The output returned by this routine is meaningless */ -/* otherwise. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* add agents to watcher system notification list */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - return 0; - } - chkin_("ZZNWPOOL", (ftnlen)8); - -/* Fetch the agents watching VARNAM into the set NOTIFY. */ - - zzgapool_(varnam, wtvars, wtptrs, wtpool, wtagnt, notify, varnam_len, - wtvars_len, wtagnt_len, notify_len); - -/* Compute the union of NOTIFY and the agent list AGENTS. */ -/* Place the result in the workspace set AGTWRK; then copy */ -/* the result to AGENTS. */ - - unionc_(notify, agents, agtwrk, notify_len, agents_len, agtwrk_len); - copyc_(agtwrk, agents, agtwrk_len, agents_len); - chkout_("ZZNWPOOL", (ftnlen)8); - return 0; -} /* zznwpool_ */ - diff --git a/ext/spice/src/cspice/zzocced.c b/ext/spice/src/cspice/zzocced.c deleted file mode 100644 index 3894e03995..0000000000 --- a/ext/spice/src/cspice/zzocced.c +++ /dev/null @@ -1,1547 +0,0 @@ -/* zzocced.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b50 = 1e-14; -static doublereal c_b51 = 1e-12; -static integer c__9 = 9; - -/* $Procedure ZZOCCED ( Occultation of ellipsoidal bodies ) */ -integer zzocced_(doublereal *viewpt, doublereal *centr1, doublereal *semax1, - doublereal *centr2, doublereal *semax2) -{ - /* System generated locals */ - integer ret_val, i__1, i__2, i__3, i__4, i__5, i__6; - doublereal d__1, d__2, d__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double atan2(doublereal, doublereal), cos(doublereal), sin(doublereal); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal bigr, limb[9], dist[2], rmat[18] /* was [3][3][2] */, view[3], - ctrs[6] /* was [3][2] */; - extern doublereal vsep_(doublereal *, doublereal *); - doublereal tilt; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - doublereal tpos[6] /* was [3][2] */; - extern /* Subroutine */ int mtxv_(doublereal *, doublereal *, doublereal * - ); - doublereal t2sep; - extern /* Subroutine */ int zzasryel_(char *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, ftnlen); - integer i__; - doublereal r__[6] /* was [3][2] */; - integer s; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal level, xlimb[9]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - doublereal xasep, minpt[3], t12pos[3]; - extern doublereal vdist_(doublereal *, doublereal *); - doublereal maxpt[3], xdist[2]; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *), ucrss_( - doublereal *, doublereal *, doublereal *); - extern logical isrot_(doublereal *, doublereal *, doublereal *); - extern doublereal vnorm_(doublereal *); - doublereal xview[3]; - extern /* Subroutine */ int unorm_(doublereal *, doublereal *, doublereal - *), vprjp_(doublereal *, doublereal *, doublereal *); - doublereal smlvu[3], xtpos[6] /* was [3][2] */; - extern /* Subroutine */ int el2cgv_(doublereal *, doublereal *, - doublereal *, doublereal *), cgv2el_(doublereal *, doublereal *, - doublereal *, doublereal *); - extern logical failed_(void); - doublereal t1opos[3]; - extern /* Subroutine */ int psv2pl_(doublereal *, doublereal *, - doublereal *, doublereal *); - extern doublereal pi_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *), edlimb_( - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *); - doublereal lmbmaj[3]; - extern doublereal dasine_(doublereal *, doublereal *), halfpi_(void); - doublereal angcmp, majlen; - integer bigidx; - doublereal minang[2], bigctr[3], lplane[4], maxang[2], maxrad[2], lmbmin[ - 3], minrad[2], xr[9] /* was [3][3] */, minvec[3], minlen, - lmbctr[3], sclmat[9] /* was [3][3] */, smlmaj[3]; - extern /* Subroutine */ int saelgv_(doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal tmpmaj[3], raydir[3], minsep, smldir[3], maxsep, smlmat[9] - /* was [3][3] */, smlmin[3], uasize, ubdist; - integer frtidx; - doublereal lnorml[3], smlctr[3], tmpmin[3], sclrot[9] /* was [3][3] - */, trgsep, invray[3], tmpctr[3]; - integer smlidx; - doublereal ttdist; - logical sfront; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical return_(void); - doublereal vpproj[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), errint_(char *, integer *, ftnlen), vminus_(doublereal *, - doublereal *); - doublereal xsmlvu[3], xvwtrg[3]; - extern doublereal det_(doublereal *); - doublereal vph; - extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) - , mxv_(doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Indicate whether one triaxial ellipsoid is occulted by another as */ -/* seen from a specified viewing location. */ - -/* $ 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 */ - -/* SPK */ -/* TIME */ - -/* $ Keywords */ - -/* GEOMETRY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare ZZOCCED return code parameters, comparison strings */ -/* and other parameters. */ - -/* $ 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 */ - -/* GF */ - -/* $ Keywords */ - -/* ELLIPSOID */ -/* GEOMETRY */ -/* GF */ -/* OCCULTATION */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 01-SEP-2005 (NJB) */ - -/* -& */ -/* The function returns an integer code indicating the geometric */ -/* relationship of the three bodies. */ - -/* Codes and meanings are: */ - -/* -3 Total occultation of first target by */ -/* second. */ - - -/* -2 Annular occultation of first target by */ -/* second. The second target does not */ -/* block the limb of the first. */ - - -/* -1 Partial occultation of first target by */ -/* second target. */ - - -/* 0 No occultation or transit: both objects */ -/* are completely visible to the observer. */ - - -/* 1 Partial occultation of second target by */ -/* first target. */ - - -/* 2 Annular occultation of second target by */ -/* first. */ - - -/* 3 Total occultation of second target by */ -/* first. */ - - -/* End include file zzocced.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UBEL P Upper bound of SPICELIB ellipse data structure. */ -/* UBPL P Upper bound of SPICELIB plane data structure. */ -/* VIEWPT I Observation location. */ -/* CENTR1 I Center of first ellipsoid. */ -/* SEMAX1 I Semi-major axis matrix for first ellipsoid. */ -/* CENTR2 I Center of second ellipsoid. */ -/* SEMAX2 I Semi-major axis matrix for second ellipsoid. */ - -/* The function returns an integer code indicating the geometric */ -/* relationship of the three bodies. Negative codes indicate that */ -/* the first target is partially or fully occulted by the second; */ -/* positive codes indicate that the second target is partially */ -/* or fully occulted by the first; a value of zero indicates no */ -/* occultation. */ - -/* See Detailed_Output for the list of codes and meanings. */ - -/* $ Detailed_Input */ - -/* VIEWPT is a point from which a possible occultation of */ -/* one ellipsoidal "target" body by another is */ -/* observed. VIEWPT must be external to both target */ -/* bodies. */ - -/* CENTR1 is the center of the first ellipsoidal target */ -/* body. */ - -/* SEMAX1 is a 3x3 matrix whose columns are semi-axis */ -/* vectors of the first ellipsoid. The columns of */ -/* SEMAX1 must form a right-handed, orthogonal basis: */ -/* the columns are mutually orthogonal, and the third */ -/* column points in the direction of the cross */ -/* product of the first and second. In other words, */ -/* if the columns were scaled to unit length, the */ -/* matrix would be orthogonal. */ - -/* The lengths of the column vectors are the lengths */ -/* of the ellipsoid's semi-axes. It is not necessary */ -/* that the longest semi-axis appear in the first */ -/* column. */ - -/* An example: if the first ellipsoid is described */ -/* by the equation */ - -/* 2 2 2 */ -/* x y z */ -/* --- + --- + --- = 1 */ -/* 2 2 2 */ -/* a b c */ - -/* then a corresponding semi-axis matrix would */ -/* be */ - -/* +- -+ */ -/* | a 0 0 | */ -/* | 0 b 0 | */ -/* | 0 0 c | */ -/* +- -+ */ - -/* A second example of a valid semi-axis matrix is */ - -/* +- -+ */ -/* | 0 -a 0 | */ -/* | 0 0 -b | */ -/* | c 0 0 | */ -/* +- -+ */ - - -/* CENTR2 is the center of the second ellipsoidal target */ -/* body. */ - - -/* SEMAX2 is a semi-axis matrix for the second ellipsoidal */ -/* target body. See the description of SEMAX1 for */ -/* details. */ - - -/* $ Detailed_Output */ - -/* The function returns an integer code indicating the geometric */ -/* relationship of the three bodies. */ - -/* Codes and meanings are: */ - -/* TOTAL1 Total occultation of first target by */ -/* second. */ - -/* ANNLR1 Annular occultation of first target by */ -/* second. The second target does not */ -/* block the limb of the first. */ - -/* PARTL1 Partial occultation of first target by */ -/* second target. */ - -/* NOOCC No occultation or transit: both objects */ -/* are completely visible to the observer. */ - -/* PARTL2 Partial occultation of second target by */ -/* first target. */ - -/* ANNLR2 Annular occultation of second target by */ -/* first. */ - -/* TOTAL2 Total occultation of second target by */ -/* first. */ - -/* $ Parameters */ - -/* UBEL Upper bound of SPICELIB ellipse data structure. */ - -/* UBPL Upper bound of SPICELIB plane data structure. */ - -/* $ Exceptions */ - -/* 1) If the observer is inside either target ellipsoid, the error */ -/* SPICE(NOTDISJOINT) is signaled. */ - -/* 2) If this routine determines that the target bodies intersect, */ -/* the error SPICE(NOTDISJOINT) is signaled. */ - -/* 3) If any of the semi-axis lengths of either ellipsoid is */ -/* non-positive, the error SPICE(BADAXISLENGTH) is signaled. */ - -/* 4) If either semi-axis matrix does not have a right-handed, */ -/* mutually orthogonal set of columns, the error */ -/* SPICE(NOTAROTATION) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* For many purposes, modeling extended bodies as tri-axial */ -/* ellipsoids is adequate for determining whether one body is */ -/* occulted by another as seen from a specified observer. */ - -/* This routine may be used as a tool to support more higher-level */ -/* occultation tests involving ephemeris objects. */ - -/* $ Examples */ - -/* 1) View a total occultation of one ellipsoid by another */ -/* as seen from a viewing location on the +x axis. */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ - -/* C */ -/* C SPICELIB functions */ -/* C */ -/* INTEGER ZZOCCED */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION CENTR1 ( 3 ) */ -/* DOUBLE PRECISION CENTR2 ( 3 ) */ -/* DOUBLE PRECISION SEMAX1 ( 3, 3 ) */ -/* DOUBLE PRECISION SEMAX2 ( 3, 3 ) */ -/* DOUBLE PRECISION VIEWPT ( 3 ) */ - -/* INTEGER CODE */ - -/* C */ -/* C Initial values */ -/* C */ -/* DATA VIEWPT / 2.D1, 0.D0, 0.D0 / */ - -/* DATA CENTR1 / 1.D1, 0.D0, 0.D0 / */ - -/* DATA SEMAX1 / 1.D0, 0.D0, 0.D0, */ -/* . 0.D0, 5.D0, 0.D0, */ -/* . 0.D0, 0.D0, 1.D1 / */ - -/* DATA CENTR2 / -1.D1, 0.D0, 0.D0 / */ - -/* DATA SEMAX2 / 2.D0, 0.D0, 0.D0, */ -/* . 0.D0, 1.D1, 0.D0, */ -/* . 0.D0, 0.D0, 2.D1 / */ - -/* C */ -/* C Find the occultation state and write out the */ -/* C occultation code. We don't place the ZZOCCED */ -/* C call directly in the WRITE statement because */ -/* C ZZOCCED can signal errors; an error signaled in */ -/* C an I/O statement would cause recursive I/O. */ -/* C */ -/* CODE = ZZOCCED ( VIEWPT, CENTR1, SEMAX1, */ -/* . CENTR2, SEMAX2 ) */ - -/* WRITE (*,*), 'CODE = ', CODE */ -/* END */ - -/* We expect that the smaller ellipsoid, listed first in the call to */ -/* ZZOCCED, completely occults the larger, so the return code should */ -/* be 3. */ - - -/* $ Restrictions */ - -/* 1) The test done by this routine for intersection of target bodies */ -/* may return a false negative result. The test is based on */ -/* finding an intersection of spheres inscribed in each target */ -/* body. */ - -/* Correct application code should never exercise this test. */ - -/* 2) This routine relies on ZZASRYEL to determine the minimum and */ -/* maximum angular separation of a specified ray and ellipse. In */ -/* some unusual cases in which multiple extreme values are very */ -/* close, or in which the extrema occur at points very close */ -/* together on the ellipse, ZZASRYEL may locate the incorrect */ -/* extremum. This can result in erroneous classification of a */ -/* partial occultation as a total occultation or annular transit. */ - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 17-MAR-2006 (NJB) */ - -/* Bug fixes: */ - -/* - Test for intersection of viewpoint with targets */ -/* was corrected. Previous test did not properly account */ -/* for target orientation. */ - -/* - Computation of maximum bounding cones of targets */ -/* failed when viewing point was inside either maximum */ -/* bounding sphere. The algorithm now has a separate */ -/* branch to handle this situation. */ - -/* - Computation of minimum bounding cone for target was */ -/* incorrect for the computation done after transformation */ -/* of the targets. This computation has been corrected. */ - -/* - SPICELIB Version 1.0.0, 17-AUG-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* occultation test using ellipsoidal bodies */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Tolerance value for determinant of a rotation matrix. The */ -/* determinant must differ from 1 by no more than DTOL. */ - - -/* Tolerance value for norms of columns of a rotation matrix. The */ -/* norms must differ from 1 by no more than NTOL. */ - - -/* Tolerance value for argument of arcsine. The argument should */ -/* have absolute value no greater than 1 + ATOL. */ - - -/* Local variables */ - - -/* Overview */ -/* ======================================================= */ - -/* This routine starts out by initializing variables and */ -/* performing some error checks on the inputs. */ - -/* The routine proceeds to classify the type occultation, */ -/* starting with simple approximation techniques, and if those */ -/* fail, following with more computationally expensive techniques. */ - -/* All of the classifications have two elements: */ - -/* - Determining the type of overlap: total occultation */ -/* or annular transit, partial occultation, or no */ -/* occultation. */ - -/* - Determining which object is in front of the other */ -/* if an overlap exists. */ - -/* For each classification, this routine sets the return code to */ -/* indicate the above attributes of the occultation geometry. */ - -/* The first classification step is performed using "bounding */ -/* cones." For each ellipsoid, we define a "minimum bounding cone" */ -/* and a "maximum bounding cone." A minimum bounding cone for an */ -/* ellipsoid has the viewing point as its vertex and is tangent to */ -/* the sphere whose radius is the ellipsoid's minimum semi-axis */ -/* length and whose center coincides with the ellipsoid's center. */ - -/* A maximum bounding cone is defined analogously, with the sphere */ -/* having radius equal to the ellipsoid's maximum semi-axis length. */ - -/* Since all of the bounding cones intersect in the viewing point, */ -/* it's inaccurate to speak of the cones as "not intersecting." */ -/* However, it's very convenient to ignore this intersection, so */ -/* we'll consider a pair of cones to intersect or "overlap" only if */ -/* they intersect in more than just their common vertex. */ - -/* The conditions that can be determined by the initial bounding */ -/* cone tests are as follows: */ - -/* 1) The maximum bounding cones are disjoint. This implies */ -/* there is no occultation. */ - -/* 2) The maximum bounding cone of one ellipsoid is contained */ -/* in the minimum bounding cone of the other. This implies */ -/* there is a total occultation or annular transit. */ - -/* 3) The minimum bounding cones of the ellipsoids overlap, */ -/* and neither of these cones is contained in the maximum */ -/* bounding cone of the other ellipsoid. This implies there */ -/* is a partial occultation. */ - -/* If the occultation cannot be classified by the above tests, the */ -/* next step is to change the problem into an equivalent one in */ -/* which one of the ellipsoids is a sphere. This new problem can be */ -/* attacked by considering the angular separation between the ray */ -/* from the viewing point to the center of the sphere and the limb */ -/* of the other ellipsoid. */ - -/* To obtain this simplified geometric configuration, we apply to */ -/* all participating objects a non-singular linear transformation. */ -/* This transformation maps one of the ellipsoids to the unit sphere. */ -/* The viewing point, the center of the ellipsoid mapped to the */ -/* unit sphere, and the center and generating vectors of the limb */ -/* of the other ellipsoid are all subjected to this transformation. */ -/* The result is a collection of objects that yield the same */ -/* occultation state as the original set. (The reader may want */ -/* to verify that limbs of ellipsoids map to limbs under this */ -/* transformation.) */ - -/* The conditions that can be identified immediately using the */ -/* transformed objects are: */ - -/* 4) The minimum angular separation between the ray from the */ -/* viewing point to the center of the unit sphere ("the ray" */ -/* henceforth) and the limb of the other ellipsoid is greater */ -/* than the angular radius (one half of the apparent angular */ -/* size as seen from the viewing point) of the unit sphere. */ -/* This implies there is no occultation. */ - -/* 5) The minimum angular separation between the ray and the */ -/* limb of the other ellipsoid is negative (meaning the ray */ -/* penetrates the plane region bounded by the limb) and has */ -/* magnitude greater than the angular radius of the unit */ -/* sphere. This implies the unit sphere is in total */ -/* occultation or in annular transit across the other */ -/* ellipsoid. */ - -/* If both of the above tests fail, there is an occultation, but */ -/* it remains to be classified. We do know at this point that the */ -/* unit sphere extends beyond the other ellipsoid, but we don't */ -/* know whether the other ellipsoid also extends beyond the unit */ -/* sphere. If it does, we have a partial occultation; if it */ -/* doesn't, the other ellipsoid is totally occulted by the unit */ -/* sphere or is in annular transit across it. */ - -/* At this point, we perform a second set of bounding cone tests. */ -/* The reason this may be useful is that the linear transformation */ -/* we've performed gives rise to a new set of bounding cones whose */ -/* containment relationships *are not* necessarily the same as those */ -/* of the original ellipsoids. The conditions that can be */ -/* identified at this point by the bounding cone tests are: */ - -/* 6) The bounding cone of the unit sphere (the minimum and */ -/* maximum bounding cones are coincident) contains the maximum */ -/* bounding cone of the other ellipsoid. This implies the */ -/* latter ellipsoid is in total occultation or annular */ -/* transit. */ - -/* 7) The bounding cone of the unit sphere does not contain */ -/* the minimum bounding cone of the other ellipsoid. This */ -/* implies there is a partial occultation. */ - -/* If these tests fail, the final step is to find the maximum */ -/* angular separation of the ray and the limb of the other */ -/* ellipsoid. This separation is signed, with a negative sign */ -/* indicating that the ray penetrates the plane region bounded by */ -/* the limb. The conditions we can determine using this information */ -/* are: */ - -/* 8) The maximum *magnitude* of the angular separation of the */ -/* limb and the ray is less than or equal to the angular size */ -/* of the unit sphere. This implies the other ellipsoid is in */ -/* total occultation or annular transit across the unit sphere. */ - -/* 9) The maximum *magnitude* of the angular separation of the */ -/* limb and the ray is greater than the angular size */ -/* of the unit sphere. This implies there is a partial */ -/* occultation. */ - - - - -/* Executable code */ -/* ======================================================= */ - -/* Set an initial function value. */ - - ret_val = 0; - -/* Standard SPICE error handling. */ - - if (return_()) { - return ret_val; - } - chkin_("ZZOCCED", (ftnlen)7); - -/* Extract the radii of the targets from the semi-axis vectors. */ -/* At the same time, create rotation matrices that map vectors */ -/* from the principal axis frames of the targets to the base frame. */ - - for (i__ = 1; i__ <= 3; ++i__) { - unorm_(&semax1[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "semax1", i__1, "zzocced_", (ftnlen)587)], &rmat[(i__2 = (i__ - + 3) * 3 - 12) < 18 && 0 <= i__2 ? i__2 : s_rnge("rmat", i__2, - "zzocced_", (ftnlen)587)], &r__[(i__3 = i__ - 1) < 6 && 0 <= - i__3 ? i__3 : s_rnge("r", i__3, "zzocced_", (ftnlen)587)]); - unorm_(&semax2[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge( - "semax2", i__1, "zzocced_", (ftnlen)588)], &rmat[(i__2 = (i__ - + 6) * 3 - 12) < 18 && 0 <= i__2 ? i__2 : s_rnge("rmat", i__2, - "zzocced_", (ftnlen)588)], &r__[(i__3 = i__ + 2) < 6 && 0 <= - i__3 ? i__3 : s_rnge("r", i__3, "zzocced_", (ftnlen)588)]); - } - -/* Find the minimum and maximum radii of both targets. */ - - for (i__ = 1; i__ <= 2; ++i__) { -/* Computing MIN */ - d__1 = r__[(i__2 = i__ * 3 - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge( - "r", i__2, "zzocced_", (ftnlen)596)], d__2 = r__[(i__3 = i__ * - 3 - 2) < 6 && 0 <= i__3 ? i__3 : s_rnge("r", i__3, "zzocced_" - , (ftnlen)596)], d__1 = min(d__1,d__2), d__2 = r__[(i__4 = - i__ * 3 - 1) < 6 && 0 <= i__4 ? i__4 : s_rnge("r", i__4, - "zzocced_", (ftnlen)596)]; - minrad[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("minrad", - i__1, "zzocced_", (ftnlen)596)] = min(d__1,d__2); -/* Computing MAX */ - d__1 = r__[(i__2 = i__ * 3 - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge( - "r", i__2, "zzocced_", (ftnlen)597)], d__2 = r__[(i__3 = i__ * - 3 - 2) < 6 && 0 <= i__3 ? i__3 : s_rnge("r", i__3, "zzocced_" - , (ftnlen)597)], d__1 = max(d__1,d__2), d__2 = r__[(i__4 = - i__ * 3 - 1) < 6 && 0 <= i__4 ? i__4 : s_rnge("r", i__4, - "zzocced_", (ftnlen)597)]; - maxrad[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("maxrad", - i__1, "zzocced_", (ftnlen)597)] = max(d__1,d__2); - } - -/* Make sure the input target radii are positive. We'll actually do */ -/* a more stringent test later, but we must prevent divide-by-zero */ -/* errors at this point. */ - - if (minrad[0] <= 0. || minrad[1] <= 0.) { - setmsg_("Minimum radii of bodies 1 and 2 are #, #. Target radii must" - " be positive.", (ftnlen)72); - errdp_("#", minrad, (ftnlen)1); - errdp_("#", &minrad[1], (ftnlen)1); - sigerr_("SPICE(BADAXISLENGTH)", (ftnlen)20); - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* Compute view point-to-target vectors and ranges for both */ -/* target bodies. */ - - vequ_(centr1, ctrs); - vequ_(centr2, &ctrs[3]); - for (i__ = 1; i__ <= 2; ++i__) { - vsub_(&ctrs[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "ctrs", i__1, "zzocced_", (ftnlen)626)], viewpt, &tpos[(i__2 = - i__ * 3 - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge("tpos", i__2, - "zzocced_", (ftnlen)626)]); - dist[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("dist", i__1, - "zzocced_", (ftnlen)628)] = vnorm_(&tpos[(i__2 = i__ * 3 - 3) - < 6 && 0 <= i__2 ? i__2 : s_rnge("tpos", i__2, "zzocced_", ( - ftnlen)628)]); - if (dist[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("dist", - i__1, "zzocced_", (ftnlen)631)] == 0.) { - setmsg_("Center of object # coincides with the viewing point.", ( - ftnlen)52); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - } - -/* Now check the semi-axis matrices. We'll create new matrices */ -/* from these inputs by scaling the columns of each to unit length. */ -/* the resulting matrices are supposed to be rotations. */ - - for (i__ = 1; i__ <= 2; ++i__) { - if (! isrot_(&rmat[(i__1 = (i__ * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? - i__1 : s_rnge("rmat", i__1, "zzocced_", (ftnlen)651)], & - c_b50, &c_b51)) { - setmsg_("Matrix derived by unitizing columns of semi-axis matrix" - " SEMAX# is not a rotation matrix. The determinant of th" - "is matrix is #.", (ftnlen)126); - errint_("#", &i__, (ftnlen)1); - d__1 = det_(&rmat[(i__1 = (i__ * 3 + 1) * 3 - 12) < 18 && 0 <= - i__1 ? i__1 : s_rnge("rmat", i__1, "zzocced_", (ftnlen) - 658)]); - errdp_("#", &d__1, (ftnlen)1); - sigerr_("SPICE(NOTAROTATION)", (ftnlen)19); - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - } - -/* Find the position of the second target relative to the first. */ - - vsub_(&tpos[3], tpos, t12pos); - ttdist = vnorm_(t12pos); - -/* Make sure the targets are non-intersecting. */ - - if (ttdist <= minrad[0] + minrad[1]) { - setmsg_("Targets must be non-intersecting, but spheres inscribed in" - " the targets intersect.", (ftnlen)82); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* Make sure that the viewing point is outside of both target */ -/* ellipsoids. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Transform the Ith target position into the frame of the */ -/* Ith target. */ - - mtxv_(&rmat[(i__1 = (i__ * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : - s_rnge("rmat", i__1, "zzocced_", (ftnlen)696)], &tpos[(i__2 = - i__ * 3 - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge("tpos", i__2, - "zzocced_", (ftnlen)696)], &xtpos[(i__3 = i__ * 3 - 3) < 6 && - 0 <= i__3 ? i__3 : s_rnge("xtpos", i__3, "zzocced_", (ftnlen) - 696)]); - -/* The viewpoint position is the negative of the target position. */ -/* Since we're squaring the terms involving the target position, */ -/* we omit the minus signs. */ - -/* Computing 2nd power */ - d__1 = xtpos[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "xtpos", i__1, "zzocced_", (ftnlen)703)] / r__[(i__2 = i__ * - 3 - 3) < 6 && 0 <= i__2 ? i__2 : s_rnge("r", i__2, "zzocced_", - (ftnlen)703)]; -/* Computing 2nd power */ - d__2 = xtpos[(i__3 = i__ * 3 - 2) < 6 && 0 <= i__3 ? i__3 : s_rnge( - "xtpos", i__3, "zzocced_", (ftnlen)703)] / r__[(i__4 = i__ * - 3 - 2) < 6 && 0 <= i__4 ? i__4 : s_rnge("r", i__4, "zzocced_", - (ftnlen)703)]; -/* Computing 2nd power */ - d__3 = xtpos[(i__5 = i__ * 3 - 1) < 6 && 0 <= i__5 ? i__5 : s_rnge( - "xtpos", i__5, "zzocced_", (ftnlen)703)] / r__[(i__6 = i__ * - 3 - 1) < 6 && 0 <= i__6 ? i__6 : s_rnge("r", i__6, "zzocced_", - (ftnlen)703)]; - level = d__1 * d__1 + d__2 * d__2 + d__3 * d__3; - if (level < 1.) { - setmsg_("Viewpoint is inside target #; level surface parameter =" - " #.", (ftnlen)58); - errint_("#", &i__, (ftnlen)1); - errdp_("#", &level, (ftnlen)1); - sigerr_("SPICE(NOTDISJOINT)", (ftnlen)18); - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - } - -/* Find the minimum and maximum angular radii of both targets. Note */ -/* that the distances used as denominators are guaranteed to be */ -/* positive at this point. */ - - for (i__ = 1; i__ <= 2; ++i__) { - d__1 = minrad[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("min" - "rad", i__2, "zzocced_", (ftnlen)728)] / dist[(i__3 = i__ - 1) - < 2 && 0 <= i__3 ? i__3 : s_rnge("dist", i__3, "zzocced_", ( - ftnlen)728)]; - minang[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("minang", - i__1, "zzocced_", (ftnlen)728)] = dasine_(&d__1, &c_b51); - if (failed_()) { - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* The situation is a bit more complicated for the maximum */ -/* bounding sphere, because the observer can be outside both */ -/* ellipsoids but inside one or both maximum bounding spheres. */ -/* We handle that special case separately. */ - - if (dist[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("dist", - i__1, "zzocced_", (ftnlen)741)] >= maxrad[(i__2 = i__ - 1) < - 2 && 0 <= i__2 ? i__2 : s_rnge("maxrad", i__2, "zzocced_", ( - ftnlen)741)]) { - -/* The viewing point is outside the sphere; we use the sphere */ -/* to define the maximum angular radius. */ - - d__1 = maxrad[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge( - "maxrad", i__2, "zzocced_", (ftnlen)746)] / dist[(i__3 = - i__ - 1) < 2 && 0 <= i__3 ? i__3 : s_rnge("dist", i__3, - "zzocced_", (ftnlen)746)]; - maxang[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("maxang", - i__1, "zzocced_", (ftnlen)746)] = dasine_(&d__1, &c_b51); - if (failed_()) { - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - } else { - -/* The viewing point is outside the Ith ellipsoid but inside */ -/* the nominal bounding sphere. We can't use the sphere to */ -/* define the maximum bounding cone. Instead, we bound the */ -/* angular radius of the ellipsoid as follows: */ - -/* 1) Find the limb of the ellipsoid as seen from the */ -/* viewing point, and construct the limb plane. */ - -/* 2) Find the orthogonal projection of the viewing point */ -/* onto the limb plane; call this project VPPROJ. The */ -/* height of the viewing point above VPPROJ is VPH. */ - -/* 3) Create an upper bound UBDIST on the maximum distance */ -/* between VPPROJ and any limb point. Here's where we */ -/* use a crude but safe estimate: let UBDIST be the */ -/* sum of the distance between VPPROJ and the center of */ -/* the limb and the semi-major axis length of the limb. */ -/* The triangle inequality shows this is a valid upper */ -/* bound. */ - -/* 4) The viewing point and the circle of radius UBDIST */ -/* centered at VPPROJ define a right circular cone */ -/* that contains the limb: this is our choice of */ -/* the maximum bounding cone. The arctangent of */ -/* UBDIST/VPH is the angular radius of this cone. */ - - -/* The vector XTPOS(*,I) contains the position of the Ith */ -/* target relative to the viewing point, represented in the */ -/* principal axis frame of the Ith target. Let XVWTRG contain */ -/* the inverse of this vector, which is the observer position */ -/* relative to the center of the Ith target, in the principal */ -/* axis frame of the Ith target. */ - - vminus_(&xtpos[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("xtpos", i__1, "zzocced_", (ftnlen)789)], xvwtrg); - edlimb_(&r__[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("r", i__1, "zzocced_", (ftnlen)791)], &r__[(i__2 = - i__ * 3 - 2) < 6 && 0 <= i__2 ? i__2 : s_rnge("r", i__2, - "zzocced_", (ftnlen)791)], &r__[(i__3 = i__ * 3 - 1) < 6 - && 0 <= i__3 ? i__3 : s_rnge("r", i__3, "zzocced_", ( - ftnlen)791)], xvwtrg, limb); - -/* Extract the limb's center and semi-axis vectors. */ - - el2cgv_(limb, lmbctr, lmbmaj, lmbmin); - -/* Create the limb plane. */ - - psv2pl_(lmbctr, lmbmaj, lmbmin, lplane); - -/* Project the viewing point onto the limb plane. Find */ -/* the height of the viewing point relative to this plane. */ - - vprjp_(xvwtrg, lplane, vpproj); - vph = vdist_(xvwtrg, vpproj); - -/* Find an upper bound on the distance of any limb point from */ -/* VPPROJ. */ - - ubdist = vdist_(vpproj, lmbctr) + vnorm_(lmbmaj); - -/* Find the angular size of the maximum bounding cone. We */ -/* use the 2-argument arctangent to avoid divide-by-zero */ -/* problems. The worst that can happen is that VPH is */ -/* zero, which gives us a degenerate cone of angular radius */ -/* pi/2. */ - - maxang[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("maxang", - i__1, "zzocced_", (ftnlen)824)] = atan2(ubdist, vph); - } - -/* At this point MAXANG(I) and MINANG(I) are both set for the */ -/* Ith ellipsoid. */ - - } - -/* Find the angular separation of the centers of the targets */ -/* seen by the observer. */ - - trgsep = vsep_(tpos, &tpos[3]); - -/* If bounding cones defined by the maximum radii don't intersect, */ -/* we're done. */ - - if (trgsep > maxang[0] + maxang[1]) { - ret_val = 0; - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* Use the maximum angular sizes to determine which ellipsoid */ -/* appears to the observer to be "biggest." This is merely a */ -/* heuristic: the orientation of the ellipsoids may cause the order */ -/* of the apparent angular sizes to be the opposite. The idea, */ -/* however, is that for "reasonable" cases, we'll correctly identify */ -/* the ellipsoid of larger angular size. This choice is made to */ -/* improve efficiency. */ - - if (maxang[0] > maxang[1]) { - bigidx = 1; - } else { - bigidx = 2; - } - -/* The other index is SMLIDX. */ - - smlidx = 3 - bigidx; - -/* We're ready to see whether an occultation condition exists. */ -/* We can efficiently handle some cases by working with bounding */ -/* cones defined by the viewing point, the centers of the targets, */ -/* and spheres centered at the targets having radii equal to the */ -/* minimum and maximum radii of the targets. */ - -/* If the two minimum bounding cones have non-trivial intersection */ -/* (of course they always intersect at their common vertex), we're */ -/* guaranteed some sort of occultation. Check for this case. */ - - if (minang[0] + minang[1] > trgsep) { - -/* The minimum bounding cones do overlap. Determine which target */ -/* is "in front" of the other. We do this determining which */ -/* minimum sphere is in front of the other. */ - -/* We'll do the test by examining the angle between the vectors */ -/* from the first target to the observer and the from the first */ -/* target to the second. If that angle is less than the */ -/* complement of the angular radius of the first target, then the */ -/* minimum sphere of the second target is in transit across the */ -/* first. Otherwise the minimum sphere of the second target is at */ -/* least partially occulted by the first. */ - -/* Let T1OPOS be the vector from the first target to the observer. */ - - vminus_(tpos, t1opos); - -/* ANGCMP is the angle between a vector from the first target's */ -/* center to its limb and the plane containing the center and */ -/* orthogonal to the vector from the first target's center to the */ -/* observer. */ - - angcmp = halfpi_() - minang[0]; - -/* T2SEP is the angle between the vector from the first target's */ -/* center to the observer and the vector from the first target */ -/* to the second target. */ - - t2sep = vsep_(t1opos, t12pos); - if (t2sep < angcmp) { - -/* The second target is "in front" of the first. */ - - frtidx = 2; - -/* Set the sign of the return code. */ - - s = -1; - } else { - frtidx = 1; - s = 1; - } - -/* Now classify the occultation. If the minimum sphere */ -/* of the front target has angular size greater than the maximum */ -/* angular size of the rear target plus the angular separation */ -/* of the target centers, the occultation is total. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* (The subscript 3-I used below is 2 if I is 1 and vice */ -/* versa.) */ - - if (minang[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "minang", i__1, "zzocced_", (ftnlen)948)] >= maxang[(i__2 - = 3 - i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("maxang", - i__2, "zzocced_", (ftnlen)948)] + trgsep) { - -/* If target I is in front, it totally occults the other */ -/* target. Otherwise, the other target is in annular */ -/* transit across target I. */ - - if (frtidx == i__) { - ret_val = s * 3; - } else { - ret_val = s << 1; - } - -/* We've found the occultation type, so we're done. */ - - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - } - -/* If the angular size of the minimum sphere of *each* target */ -/* plus the angular separation of the centers exceeds the */ -/* maximum angular size of the other target, the occultation */ -/* is partial. In other words, overlap is guaranteed, but it */ -/* is also guaranteed that neither target is totally blocked */ -/* by the other. */ - - if (minang[0] + trgsep > maxang[1] && minang[1] + trgsep > maxang[0]) - { - -/* The occultation code is +/- PARTL2, depending on whether */ -/* the first target is in front. */ - - ret_val = s; - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* If we get to this point, we were unable to classify the */ -/* occultation using bounding cones alone. */ - - } - -/* This is the end of the case of overlapping minimum bounding */ -/* cones. */ - -/* We're going apply a linear transformation to the viewing point */ -/* and both targets so as to convert the larger of the targets into */ -/* a sphere. We'll then find the angular separation from the other */ -/* target of the ray from viewing point to the center of the sphere. */ -/* In practice, we must transform the viewing point, the target */ -/* centers, and the limb of the ellipsoid that doesn't get mapped */ -/* to the unit sphere. */ - -/* Note that this transformation *does not* preserve angular */ -/* separation, but it preserves set containment relationships. */ -/* In particular, the limbs of the targets map to limbs under */ -/* this transformation, since the limbs are the intersection sets */ -/* of the targets and tangent rays emanating from the viewing point. */ - -/* First step: find the limb of the smaller ellipsoid as */ -/* seen from the viewing point. We need to map the viewing point */ -/* into the principal axis frame of the smaller ellipsoid first. */ -/* Let SMLMAT be the rotation matrix that effects this mapping. */ - - xpose_(&rmat[(i__1 = (smlidx * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : - s_rnge("rmat", i__1, "zzocced_", (ftnlen)1019)], smlmat); - -/* Apply SMLMAT to the vector from the center of the smaller */ -/* ellipsoid to the viewing point. */ - - vsub_(viewpt, &ctrs[(i__1 = smlidx * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("ctrs", i__1, "zzocced_", (ftnlen)1025)], smlvu); - mxv_(smlmat, smlvu, view); - -/* Find the limb of the smaller ellipsoid as seen from VIEW. */ - - edlimb_(&r__[(i__1 = smlidx * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "r", i__1, "zzocced_", (ftnlen)1032)], &r__[(i__2 = smlidx * 3 - - 2) < 6 && 0 <= i__2 ? i__2 : s_rnge("r", i__2, "zzocced_", ( - ftnlen)1032)], &r__[(i__3 = smlidx * 3 - 1) < 6 && 0 <= i__3 ? - i__3 : s_rnge("r", i__3, "zzocced_", (ftnlen)1032)], view, limb); - -/* Unpack the limb and map it from the principal axis frame of the */ -/* small ellipsoid back into the original frame. */ - - el2cgv_(limb, tmpctr, tmpmaj, tmpmin); - mtxv_(smlmat, tmpctr, smlctr); - mtxv_(smlmat, tmpmaj, smlmaj); - mtxv_(smlmat, tmpmin, smlmin); - -/* At this point SMLCTR is the position of the center of the limb */ -/* relative to the center of the small ellipsoid. We want to express */ -/* this center relative to the origin; we use the vector SMLCTR for */ -/* this. */ - - vadd_(&ctrs[(i__1 = smlidx * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "ctrs", i__1, "zzocced_", (ftnlen)1050)], smlctr, tmpctr); - vequ_(tmpctr, smlctr); - -/* Create the transformation matrix that maps the larger ellipsoid */ -/* to the unit sphere. */ - -/* First compute the scale matrix SCLMAT that scales vector */ -/* components by the reciprocals of the respective semi-axis */ -/* lengths of the large ellipsoid. */ - - cleard_(&c__9, sclmat); - sclmat[0] = 1. / r__[(i__1 = bigidx * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("r", i__1, "zzocced_", (ftnlen)1063)]; - sclmat[4] = 1. / r__[(i__1 = bigidx * 3 - 2) < 6 && 0 <= i__1 ? i__1 : - s_rnge("r", i__1, "zzocced_", (ftnlen)1064)]; - sclmat[8] = 1. / r__[(i__1 = bigidx * 3 - 1) < 6 && 0 <= i__1 ? i__1 : - s_rnge("r", i__1, "zzocced_", (ftnlen)1065)]; - -/* Compose the row-scaling matrix SCLMAT with the frame */ -/* transformation required to map vectors to the principal axis */ -/* frame of this ellipsoid. The result is the transformation */ -/* that maps the larger ellipsoid to the unit sphere. */ - -/* We use one matrix SCLROT to perform these composed operations. */ - - xpose_(&rmat[(i__1 = (bigidx * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : - s_rnge("rmat", i__1, "zzocced_", (ftnlen)1075)], xr); - mxm_(sclmat, xr, sclrot); - -/* Transform the viewing point, the large ellipsoid's center vector, */ -/* and vectors defining the limb of the smaller ellipsoid using the */ -/* mapping that converts the larger ellipsoid to the unit sphere. */ - -/* Map the viewing point to XVIEW. */ - - mxv_(sclrot, viewpt, xview); - -/* Map the center of the large ellipsoid to BIGCTR. */ - - mxv_(sclrot, &ctrs[(i__1 = bigidx * 3 - 3) < 6 && 0 <= i__1 ? i__1 : - s_rnge("ctrs", i__1, "zzocced_", (ftnlen)1090)], bigctr); - -/* Map the limb vectors of the smaller ellipsoid. */ - - mxv_(sclrot, smlctr, tmpctr); - vequ_(tmpctr, smlctr); - mxv_(sclrot, smlmaj, tmpmaj); - mxv_(sclrot, smlmin, tmpmin); - -/* Find the semi-axes of the transformed limb of the smaller */ -/* ellipsoid. Pack these vectors into the transformed limb data */ -/* structure XLIMB. */ - - saelgv_(tmpmaj, tmpmin, smlmaj, smlmin); - cgv2el_(smlctr, smlmaj, smlmin, xlimb); - -/* Find the direction vector of the ray from the viewing point */ -/* to the transformed center of the large ellipsoid. */ - - vsub_(bigctr, xview, raydir); - -/* Find the angular separation of the ray and the transformed */ -/* limb of the small ellipsoid. The output MINPT is the limb */ -/* point at which the minimum angular separation is attained. */ - - zzasryel_("MIN", xlimb, xview, raydir, &minsep, minpt, (ftnlen)3); - if (failed_()) { - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* Find the angular radius of the unit sphere centered at */ -/* BIGCTR, as seen from XVIEW. */ - - bigr = vnorm_(raydir); - -/* Although previous error checks should ensure that BIGR is */ -/* greater than or equal to 1, we'll use a safe arcsine */ -/* computation. */ - - d__1 = 1. / bigr; - uasize = dasine_(&d__1, &c_b51); - if (failed_()) { - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* At this point, UASIZE is the angular size of the unit sphere */ -/* representing the transformed larger ellipsoid. MINSEP is the */ -/* angular separation of the ray from the viewing point to the */ -/* center of the unit sphere and the transformed limb of the */ -/* smaller ellipsoid. */ - - if (minsep > uasize) { - -/* There's no overlap. */ - - ret_val = 0; - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* There's an overlap; now we must classify it. We know the limb */ -/* point MINPT at which the minimum angular separation occurs lies */ -/* in front of or behind the unit sphere, since the angular */ -/* separation at this point is less than or equal to UASIZE. */ - -/* Find the vector from the center of the sphere to MINPT. */ - - vsub_(minpt, bigctr, minvec); - -/* Get the inverse of the ray's direction vector. */ - - vminus_(raydir, invray); - -/* Now we can apply the criterion from the spherical occultation */ -/* algorithm to determine whether MINPT is in front of or behind */ -/* the sphere. We'll use the logical flag SFRONT to indicate the */ -/* relative position of MINPT. */ - -/* Set the sign S used later to set the return code as well. */ - - if (vsep_(minvec, invray) <= halfpi_() - uasize) { - -/* MINPT is in front. */ - - sfront = TRUE_; - } else { - sfront = FALSE_; - } - if (sfront && smlidx == 1 || ! sfront && smlidx == 2) { - -/* The first target is in front. */ - - s = 1; - } else { - s = -1; - } - if (minsep <= -uasize) { - -/* Arriving here implies that the "smaller" ellipsoid actually */ -/* appears larger than the other. Recall that our determination */ -/* of which ellipsoid had larger apparent extent was fallible. */ -/* This situation is not an error condition. */ - -/* The ray intersects the interior of the plane region bounded by */ -/* the limb of the "smaller" ellipsoid, and the unit sphere is */ -/* either totally occulted by the smaller ellipsoid or is in */ -/* annular transit across it. */ - - if (sfront) { - -/* The point of minimum angular separation on the limb of the */ -/* smaller ellipsoid is in front: we have a total occultation */ -/* of the larger ellipsoid. */ - - ret_val = s * 3; - } else { - -/* We have an annular transit of the larger ellipsoid */ -/* across the smaller one. */ - - ret_val = s << 1; - } - } else { - -/* We know that some type of occultation exists. We know the */ -/* unit sphere is *neither* totally occulted by the other */ -/* ellipsoid nor in annular transit across it. It's possible that */ -/* the other ellipsoid is totally occulted by the unit sphere or */ -/* is in annular transit across it; otherwise we have a partial */ -/* occultation. */ - -/* We try two quick classification tests first: */ - -/* 1) We see whether the maximum bounding cone of the small */ -/* ellipsoid is contained in the cone defined by the */ -/* viewing point and unit sphere. */ - -/* 2) We see whether the minimum bounding cone of the small */ -/* ellipsoid extends beyond the cone defined by the */ -/* viewing point and unit sphere. */ - -/* Note that we need to re-compute the bounding cones for the */ -/* small ellipsoid since we've applied a linear transformation */ -/* to it. */ - -/* Note also that these tests are not duplicates of the tests */ -/* performed earlier, since now the bounding cones of the */ -/* ellipsoids have been changed by the transformation applied */ -/* to both. */ - -/* The linear transformation applied to the small ellipsoid does */ -/* not preserve distances, so we must re-compute the distance */ -/* from the viewing point to the center of the small ellipsoid. */ - - vsub_(xview, smlctr, xsmlvu); - xdist[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("xdist", - i__1, "zzocced_", (ftnlen)1271)] = vnorm_(xsmlvu); - -/* Compute angular radii of bounding cones for the transformed */ -/* limb of the small ellipsoid. First, capture the semi-axis */ -/* lengths of the limb. */ - - majlen = vnorm_(smlmaj); - minlen = vnorm_(smlmin); - if (xdist[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("xdist" - , i__1, "zzocced_", (ftnlen)1281)] >= majlen) { - -/* The viewing point is outside a sphere of radius MAJLEN */ -/* centered at the limb's center. We use this sphere to */ -/* to define the maximum angular radius. Note that this */ -/* sphere may have larger angular extent than the small */ -/* ellipsoid, but it's guaranteed to block the small */ -/* ellipsoid. */ - - d__1 = majlen / xdist[(i__2 = smlidx - 1) < 2 && 0 <= i__2 ? i__2 - : s_rnge("xdist", i__2, "zzocced_", (ftnlen)1290)]; - maxang[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("max" - "ang", i__1, "zzocced_", (ftnlen)1290)] = dasine_(&d__1, & - c_b51); - if (failed_()) { - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - } else { - -/* We create a maximum bounding cone using the same technique */ -/* we used above for the original, untransformed targets. In */ -/* this case we already have the components of the limb of */ -/* the transformed, small target. */ - -/* Create the limb plane. */ - - psv2pl_(smlctr, smlmaj, smlmin, lplane); - -/* Project the viewing point onto the limb plane. Find */ -/* the height of the viewing point relative to this plane. */ - - vprjp_(xview, lplane, vpproj); - vph = vdist_(xview, vpproj); - -/* Find an upper bound on the distance of any limb point from */ -/* VPPROJ. */ - - ubdist = vdist_(vpproj, smlctr) + majlen; - -/* Find the angular size of the maximum bounding cone. We */ -/* use the 2-argument arctangent to avoid divide-by-zero */ -/* problems. The worst that can happen is that VPH is */ -/* zero, which gives us a degenerate cone of angular radius */ -/* pi/2. */ - - maxang[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("max" - "ang", i__1, "zzocced_", (ftnlen)1329)] = atan2(ubdist, - vph); - } - -/* Now find the minimum bounding cone. The situation is slightly */ -/* complicated by the fact that we have the limb of the */ -/* transformed, small ellipsoid rather than the ellipsoid itself. */ -/* We don't want to use ZZASRYEL here because that routine is */ -/* slow: we don't want to call it if a quick test will do. So we */ -/* use a somewhat crude estimate that guarantees that all rays */ -/* contained in the small bounding cone intersect the small */ -/* ellipsoid. The approach is as follows: */ - -/* 1) Determine the angle between the normal to the limb plane */ -/* pointing towards XVIEW and the viewing point-limb center */ -/* vector. Call this angle TILT. */ - -/* 2) For a circle having radius equal to the semi-minor axis */ -/* length of the limb, inscribed in the limb, and coplanar */ -/* with the limb, the minimum angular radius of any point */ -/* on the circle, as seen from XVIEW, is associated with */ -/* the point farthest from XVIEW. The angular separation */ -/* of the vector from the limb center to this point and the */ -/* vector from XVIEW to the limb center is pi/2 + TILT. */ -/* Find the angular radius associated with that point. */ - -/* Start out by constructing a normal to the limb plane. */ - - ucrss_(smlmaj, smlmin, lnorml); - -/* Choose a value of TILT not exceeding pi/2. */ - - tilt = vsep_(lnorml, xsmlvu); - if (tilt > halfpi_()) { - tilt = pi_() - tilt; - } - -/* Now we have a right triangle whose base is the distance from */ -/* XVIEW to the limb's center plus sin(TILT)*MINLEN, and whose */ -/* height is cos(TILT)*MINLEN. */ - -/* Find the angle associated with the corner of the triangle */ -/* associated with the viewing point. This is the angular */ -/* radius of our minimum bounding cone. */ - - minang[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("minang", - i__1, "zzocced_", (ftnlen)1380)] = atan2(cos(tilt) * minlen, - sin(tilt) * minlen + xdist[(i__2 = smlidx - 1) < 2 && 0 <= - i__2 ? i__2 : s_rnge("xdist", i__2, "zzocced_", (ftnlen)1380)] - ); - -/* Compute angular separation of the transformed centers. */ - - vsub_(smlctr, xview, smldir); - xasep = vsep_(raydir, smldir); - -/* Test for inclusion of the maximum bounding cone of the small */ -/* ellipsoid in the circumscribing cone of the sphere. */ - - if (xasep + maxang[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("maxang", i__1, "zzocced_", (ftnlen)1394)] <= uasize) { - -/* The small ellipsoid is either in total occultation or */ -/* in annular transit across the sphere. */ - - if (sfront) { - -/* MINPT is in front of the sphere. We have an annular */ -/* transit of the small ellipsoid across the small one. */ - - ret_val = s << 1; - } else { - -/* MINPT is behind the sphere. We have a total */ -/* occultation of the small ellipsoid. */ - - ret_val = s * 3; - } - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* Test for non-containment of the minimum bounding cone of the */ -/* small ellipsoid by the circumscribing cone of the sphere. */ - - if (xasep + minang[(i__1 = smlidx - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("minang", i__1, "zzocced_", (ftnlen)1424)] > uasize) { - -/* The small ellipsoid is either in partial occultation or */ -/* in partial transit across the sphere. */ - - ret_val = s; - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - -/* Arriving at this point means we've been unable to classify */ -/* the occultation or transit. We're going to need to compute */ -/* the maximum angular separation of the limb from the ray */ -/* emanating from the viewing point and passing through the */ -/* center of the sphere. */ - - zzasryel_("MAX", xlimb, xview, raydir, &maxsep, maxpt, (ftnlen)3); - if (failed_()) { - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; - } - if (abs(maxsep) <= uasize) { - -/* Whether the ray from the viewing point to the center */ -/* of the unit sphere does nor does not penetrate the plane */ -/* region bounded by the limb of the smaller ellipse, no */ -/* point on that limb has greater angular separation than */ -/* UASIZE from the ray. */ - -/* The small ellipsoid is either in total occultation or */ -/* in annular transit across the sphere. */ - - if (sfront) { - -/* MINPT is in front of the sphere. We have an annular */ -/* transit of the small ellipsoid across the smaller. */ - - ret_val = s << 1; - } else { - -/* MINPT is behind the sphere. We have a total */ -/* occultation of the small ellipsoid. */ - - ret_val = s * 3; - } - } else { - -/* Whether the ray from the viewing point to the center */ -/* of the unit sphere does nor does not penetrate the plane */ -/* region bounded by the limb of the smaller ellipse, some */ -/* point on that limb has greater angular separation than */ -/* UASIZE from the ray. */ - -/* The small ellipsoid is either in partial occultation or */ -/* in partial transit across the sphere. */ - - ret_val = s; - } - -/* We've classified the occultation in the case where the */ -/* maximum angular separation of the ray and limb had to be */ -/* computed. */ - -/* This is the end of the code for the case where there is */ -/* overlap, but the unit sphere is *neither* totally occulted by */ -/* the other ellipsoid nor in annular transit across it. */ - - } - -/* ZZOCCED has been set. */ - - chkout_("ZZOCCED", (ftnlen)7); - return ret_val; -} /* zzocced_ */ - diff --git a/ext/spice/src/cspice/zzphsh.c b/ext/spice/src/cspice/zzphsh.c deleted file mode 100644 index e01fc3da6a..0000000000 --- a/ext/spice/src/cspice/zzphsh.c +++ /dev/null @@ -1,816 +0,0 @@ -/* zzphsh.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZPHSH (Private---kernel pool hash function) */ -integer zzphsh_0_(int n__, char *word, integer *m, integer *m2, ftnlen - word_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer ret_val, i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - - /* Local variables */ - static integer base, f, i__, blank; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static integer length; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer divisr; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static integer val[129]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is an umbrella routine for the kernel pool hash function. */ -/* It should never be called directly. */ - -/* $ 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 */ - -/* PRIVATE UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry point */ -/* -------- --- -------------------------------------------------- */ -/* WORD I ZZHASH */ -/* M I ZZSHSH */ - -/* The function returns zero. */ - -/* $ Detailed_Input */ - -/* See individual entry points. */ - -/* $ Detailed_Output */ - -/* The function ZZPHSH should never be called. However, it returns */ -/* the value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine is an umbrella for the kernel pool hash function */ -/* ZZHASH, ZZHASH2 and the set up routine ZZSHSH. */ - -/* $ Examples */ - -/* To make use of the ZZHAS hash function you must first call ZZSHSH */ -/* somewhere in your program. The value returned by ZZSHSH has */ -/* no meaning. You can assign it to any temporary variable you */ -/* happen to have lying around. */ - -/* I = ZZSHSH ( M ) */ - -/* ...any other set up code... */ - -/* LOOKAT = ZZHASH ( WORD ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 21-NOV-2006 (EDW)(BVS) */ - -/* Replaced ICHAR('\\') expression with parameter */ -/* BSLASH, the parameter set to the ASCII value */ -/* of the backslash character, 92. */ - -/* - SPICELIB Version 1.1.0, 14-SEP-2005 (EDW) */ - -/* Added function ZZHASH2. Operation matches */ -/* that of ZZHASH with the exception that ZZHASH2 */ -/* accepts the divisor value, M, as an input. */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ - -/* Entry Points */ - - -/* Local Variables. */ - - switch(n__) { - case 1: goto L_zzshsh; - case 2: goto L_zzhash; - case 3: goto L_zzhash2; - } - - -/* We do not diagnose a bogus call since this is a private routine. */ - - ret_val = 0; - return ret_val; -/* $Procedure ZZSHSH (Private---Set up hash function) */ - -L_zzshsh: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine sets up the kernel pool hash function. Call it */ -/* once per program execution. */ - -/* $ 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 */ - -/* PRIVATE UTILITY */ - -/* $ Declarations */ - -/* INTEGER M */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* M I Modulus used for the hash function */ - -/* The function returns 0. */ - -/* $ Detailed_Input */ - -/* M is the modulus of the hashing function. It is */ -/* recommended that this be a prime number. */ - -/* $ Detailed_Output */ - -/* The function returns the value zero (0). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This entry point sets up the modulus used for hashing input */ -/* strings. It should be called once by an initialization */ -/* branch of the kernel pool. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.1, 21-NOV-2006 (EDW)(BVS) */ - -/* Replaced ICHAR('\\') expression with parameter */ -/* BSLASH, the parameter set to the ASCII value */ -/* of the backslash character, 92. */ - -/* - SPICELIB Version 1.1.0, 06-JUL-2005 (EDW) */ - -/* Added punctuation marks to array of allowed */ -/* characters. The function can process any */ -/* character with ASCII decimal value 33 to 122. */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ - divisr = *m; - if (first) { - first = FALSE_; - base = 68; - blank = ' '; - for (i__ = 0; i__ <= 128; ++i__) { - val[(i__1 = i__) < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)295)] = 0; - } - val[(i__1 = '0') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)298)] = 1; - val[(i__1 = '1') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)299)] = 2; - val[(i__1 = '2') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)300)] = 3; - val[(i__1 = '3') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)301)] = 4; - val[(i__1 = '4') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)302)] = 5; - val[(i__1 = '5') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)303)] = 6; - val[(i__1 = '6') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)304)] = 7; - val[(i__1 = '7') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)305)] = 8; - val[(i__1 = '8') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)306)] = 9; - val[(i__1 = '9') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)307)] = 10; - val[(i__1 = 'A') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)308)] = 11; - val[(i__1 = 'B') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)309)] = 12; - val[(i__1 = 'C') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)310)] = 13; - val[(i__1 = 'D') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)311)] = 14; - val[(i__1 = 'E') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)312)] = 15; - val[(i__1 = 'F') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)313)] = 16; - val[(i__1 = 'G') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)314)] = 17; - val[(i__1 = 'H') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)315)] = 18; - val[(i__1 = 'I') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)316)] = 19; - val[(i__1 = 'J') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)317)] = 20; - val[(i__1 = 'K') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)318)] = 21; - val[(i__1 = 'L') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)319)] = 22; - val[(i__1 = 'M') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)320)] = 23; - val[(i__1 = 'N') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)321)] = 24; - val[(i__1 = 'O') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)322)] = 25; - val[(i__1 = 'P') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)323)] = 26; - val[(i__1 = 'Q') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)324)] = 27; - val[(i__1 = 'R') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)325)] = 28; - val[(i__1 = 'S') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)326)] = 29; - val[(i__1 = 'T') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)327)] = 30; - val[(i__1 = 'U') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)328)] = 31; - val[(i__1 = 'V') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)329)] = 32; - val[(i__1 = 'W') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)330)] = 33; - val[(i__1 = 'X') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)331)] = 34; - val[(i__1 = 'Y') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)332)] = 35; - val[(i__1 = 'Z') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)333)] = 36; - val[(i__1 = '-') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)334)] = 37; - val[(i__1 = '_') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)335)] = 38; - val[(i__1 = '.') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)336)] = 39; - val[(i__1 = '/') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)337)] = 40; - val[(i__1 = '!') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)338)] = 41; - val[(i__1 = '@') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)339)] = 42; - val[(i__1 = '#') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)340)] = 43; - val[(i__1 = '$') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)341)] = 44; - val[(i__1 = '%') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)342)] = 45; - val[(i__1 = '^') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)343)] = 46; - val[(i__1 = '&') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)344)] = 47; - val[(i__1 = '*') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)345)] = 48; - val[(i__1 = '(') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)346)] = 49; - val[(i__1 = ')') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)347)] = 50; - val[(i__1 = '+') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)348)] = 51; - val[(i__1 = '=') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)349)] = 52; - val[(i__1 = '[') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)350)] = 53; - val[(i__1 = '{') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)351)] = 54; - val[(i__1 = ']') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)352)] = 55; - val[(i__1 = '}') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)353)] = 56; - val[(i__1 = '|') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)354)] = 57; - val[92] = 58; - val[(i__1 = ':') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)356)] = 59; - val[(i__1 = ';') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)357)] = 60; - val[(i__1 = '<') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)358)] = 61; - val[(i__1 = ',') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)359)] = 62; - val[(i__1 = '>') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)360)] = 63; - val[(i__1 = '?') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)361)] = 64; - -/* Note, ICHAR('''') returns the ASCII */ -/* value for the single quote -> ' */ - - val[(i__1 = '\'') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)367)] = 65; - val[(i__1 = '"') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)368)] = 66; - val[(i__1 = '`') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)369)] = 67; - val[(i__1 = '~') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)370)] = 68; - val[(i__1 = 'a') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)373)] = val[(i__2 = 'A') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)373)]; - val[(i__1 = 'b') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)374)] = val[(i__2 = 'B') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)374)]; - val[(i__1 = 'c') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)375)] = val[(i__2 = 'C') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)375)]; - val[(i__1 = 'd') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)376)] = val[(i__2 = 'D') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)376)]; - val[(i__1 = 'e') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)377)] = val[(i__2 = 'E') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)377)]; - val[(i__1 = 'f') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)378)] = val[(i__2 = 'F') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)378)]; - val[(i__1 = 'g') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)379)] = val[(i__2 = 'G') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)379)]; - val[(i__1 = 'h') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)380)] = val[(i__2 = 'H') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)380)]; - val[(i__1 = 'i') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)381)] = val[(i__2 = 'I') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)381)]; - val[(i__1 = 'j') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)382)] = val[(i__2 = 'J') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)382)]; - val[(i__1 = 'k') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)383)] = val[(i__2 = 'K') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)383)]; - val[(i__1 = 'l') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)384)] = val[(i__2 = 'L') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)384)]; - val[(i__1 = 'm') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)385)] = val[(i__2 = 'M') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)385)]; - val[(i__1 = 'n') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)386)] = val[(i__2 = 'N') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)386)]; - val[(i__1 = 'o') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)387)] = val[(i__2 = 'O') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)387)]; - val[(i__1 = 'p') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)388)] = val[(i__2 = 'P') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)388)]; - val[(i__1 = 'q') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)389)] = val[(i__2 = 'Q') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)389)]; - val[(i__1 = 'r') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)390)] = val[(i__2 = 'R') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)390)]; - val[(i__1 = 's') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)391)] = val[(i__2 = 'S') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)391)]; - val[(i__1 = 't') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)392)] = val[(i__2 = 'T') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)392)]; - val[(i__1 = 'u') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)393)] = val[(i__2 = 'U') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)393)]; - val[(i__1 = 'v') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)394)] = val[(i__2 = 'V') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)394)]; - val[(i__1 = 'w') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)395)] = val[(i__2 = 'W') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)395)]; - val[(i__1 = 'x') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)396)] = val[(i__2 = 'X') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)396)]; - val[(i__1 = 'y') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)397)] = val[(i__2 = 'Y') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)397)]; - val[(i__1 = 'z') < 129 && 0 <= i__1 ? i__1 : s_rnge("val", i__1, - "zzphsh_", (ftnlen)398)] = val[(i__2 = 'Z') < 129 && 0 <= - i__2 ? i__2 : s_rnge("val", i__2, "zzphsh_", (ftnlen)398)]; - } - ret_val = 0; - return ret_val; -/* $Procedure ZZHASH (Private --- Hash function) */ - -L_zzhash: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine computes the hash value associated with a kernel */ -/* pool variable name. */ - -/* $ 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 */ - -/* PRIVATE UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) WORD */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WORD I A left justified string of characters. */ - -/* The function returns the hash value associated with WORD. */ - -/* $ Detailed_Input */ - -/* WORD is a left justified string of characters. Nominally */ -/* this is the name of some kernel pool variable. */ - -/* $ Detailed_Output */ - -/* The function returns the hash value of WORD */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine computes the hash value of a left justified */ -/* string of characters. It is critical that the string be */ -/* left justified. All non-left justified strings map to the */ -/* same value 0. */ - -/* $ Examples */ - -/* See POOL. */ - -/* $ Restrictions */ - -/* 1) If the has value calculates to a negative value, an error */ -/* signals. Such a signal should never occur. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-JUL-2005 (EDW) */ - -/* Added error test to catch non-positive hash values. */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ - f = 0; - length = i_len(word, word_len); - i__1 = length; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&word[i__ - 1] == blank) { - ret_val = f * base % divisr + 1; - return ret_val; - } -/* Computing MIN */ - i__3 = 128, i__4 = *(unsigned char *)&word[i__ - 1]; - f = val[(i__2 = min(i__3,i__4)) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "val", i__2, "zzphsh_", (ftnlen)530)] + f * base; - f %= divisr; - } - ret_val = f * base % divisr + 1; - -/* A non-positive value for ZZHASH indicates a serious problem. */ - - if (ret_val < 0) { - setmsg_("The ZZHASH function calculated a non-positive value for str" - "ing $1. Contact NAIF", (ftnlen)79); - errch_("$1", word, (ftnlen)2, word_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - return ret_val; - } - return ret_val; -/* $Procedure ZZHASH2 (Private --- Hash function) */ - -L_zzhash2: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine computes the hash value corresponding to an string */ -/* given a particular divisor value (M2). */ - -/* $ 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 */ - -/* PRIVATE UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) WORD */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WORD I A left justified string of characters. */ -/* M2 I Modulus used for the hash function */ - -/* The function returns the hash value associated with WORD. */ - -/* $ Detailed_Input */ - -/* WORD is a left justified string of characters. */ - -/* M2 the modulus of the hashing function. This value */ -/* defines the spread of the hash values, that */ -/* spread covering the interval [0, M2-1]. The larger */ -/* the value, the less the chance of a hash key */ -/* collision. The user should always chose a prime */ -/* for M2. */ - -/* $ Detailed_Output */ - -/* The function returns the hash value of WORD as computed using */ -/* M2 as the M divisor. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine computes the hash value of a left justified */ -/* string of characters. It is critical that the string be */ -/* left justified. All non-left justified strings map to the */ -/* same value 0. */ - -/* $ Examples */ - -/* 1) If the has value calculates to a negative value, an error */ -/* signals. Such a signal should never occur. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ -/* 3/Sorting and Searching 2nd Edition" 1997, pp 513-521. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 14-SEP-2005 (EDW) */ - -/* -& */ - f = 0; - length = i_len(word, word_len); - i__1 = length; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&word[i__ - 1] == blank) { - ret_val = f * base % *m2 + 1; - return ret_val; - } -/* Computing MIN */ - i__3 = 128, i__4 = *(unsigned char *)&word[i__ - 1]; - f = val[(i__2 = min(i__3,i__4)) < 129 && 0 <= i__2 ? i__2 : s_rnge( - "val", i__2, "zzphsh_", (ftnlen)682)] + f * base; - f %= *m2; - } - ret_val = f * base % *m2 + 1; - -/* A non-positive value for ZZHASH2 indicates a serious problem. */ - - if (ret_val < 0) { - setmsg_("The ZZHASH2 function calculated a non-positive value for st" - "ring $1. Contact NAIF", (ftnlen)80); - errch_("$1", word, (ftnlen)2, word_len); - sigerr_("SPICE(BUG)", (ftnlen)10); - return ret_val; - } - return ret_val; -} /* zzphsh_ */ - -integer zzphsh_(char *word, integer *m, integer *m2, ftnlen word_len) -{ - return zzphsh_0_(0, word, m, m2, word_len); - } - -integer zzshsh_(integer *m) -{ - return zzphsh_0_(1, (char *)0, m, (integer *)0, (ftnint)0); - } - -integer zzhash_(char *word, ftnlen word_len) -{ - return zzphsh_0_(2, word, (integer *)0, (integer *)0, word_len); - } - -integer zzhash2_(char *word, integer *m2, ftnlen word_len) -{ - return zzphsh_0_(3, word, (integer *)0, m2, word_len); - } - diff --git a/ext/spice/src/cspice/zzpini.c b/ext/spice/src/cspice/zzpini.c deleted file mode 100644 index 8fa3d7cd78..0000000000 --- a/ext/spice/src/cspice/zzpini.c +++ /dev/null @@ -1,299 +0,0 @@ -/* zzpini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZPINI ( Private --- kernel pool initialization ) */ -/* Subroutine */ int zzpini_(logical *first, integer *maxvar, integer *maxval, - integer *maxlin, char *begdat, char *begtxt, integer *nmpool, - integer *dppool, integer *chpool, integer *namlst, integer *datlst, - integer *maxagt, integer *mxnote, char *wtvars, integer *wtptrs, - integer *wtpool, char *wtagnt, char *agents, char *active, char * - notify, ftnlen begdat_len, ftnlen begtxt_len, ftnlen wtvars_len, - ftnlen wtagnt_len, ftnlen agents_len, ftnlen active_len, ftnlen - notify_len) -{ - /* System generated locals */ - integer namlst_dim1, datlst_dim1, i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer dummy; - extern logical failed_(void); - extern /* Subroutine */ int clearc_(integer *, char *, ftnlen), cleari_( - integer *, integer *), lnkini_(integer *, integer *); - extern integer touchi_(integer *); - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen), chkout_( - char *, ftnlen); - extern integer zzshsh_(integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine initializes the data structures needed for */ -/* maintaining the kernel pool and initializes the hash function */ -/* used for the name list in the kernel pool. */ - -/* $ 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 */ - -/* PRIVATE UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FIRST I/O Used to determine if this is the first pass */ -/* MAXVAR I Maximum number of variables in the pool */ -/* MAXVAL I Maximum number of d.p. values in the pool */ -/* MAXLIN I Maximum number of string values in the pool */ -/* BEGDAT O Marker used to begin data section of a kernel */ -/* BEGTXT O Marker used to begin text section of a kernel */ -/* NMPOOL O Linked list for resolving hash collisions of names */ -/* DPPOOL O Linked list for maintaining d.p. values. */ -/* CHPOOL O Linked list for maintaining string values */ -/* NAMLST O Heads of collision resolution lists */ -/* DATLST O Heads of data values lists */ -/* MAXAGT I Maximum number of agents that can be supported */ -/* MXNOTE I Maximum number of agents that can be notified */ -/* WTPTR O Name array of watcher symbol table */ -/* WATPTR O Pointer array of watcher symbol table */ -/* WATVAL O Values array of watcher symbol table. */ -/* AGENTS O Set of agents */ -/* ACTIVE O Watchers that are active. */ -/* NOTIFY O Agents to notify */ - -/* $ Detailed_Input */ - -/* FIRST is a logical indicating whether or not this is */ -/* the first call to this routine. If FIRST is .TRUE. */ -/* the various items are initialized and FIRST is */ -/* set to .FALSE. If FIRST is .FALSE. no action is */ -/* taken by this routine. */ - -/* MAXVAR is the maximum number of variables that the */ -/* kernel pool may contain at any one time. */ - - -/* MAXVAL is the maximum number of distinct values that */ -/* may belong to the variables in the kernel pool. */ - -/* MAXLIN is the maximum number of character strings that */ -/* can be stored as data for kernel pool variables. */ - -/* MXNOTE is the maximum number of distinct variable-agents */ -/* pairs that can be maintained by the kernel pool. */ -/* (A variable is "paired" with an agent, if that agent */ -/* is to be notified whenever the variable is updated.) */ - -/* MAXAGT is the maximum number of agents that can be kept */ -/* on the distribution list for notification of updates */ -/* to kernel variables. */ - -/* $ Detailed_Output */ - -/* FIRST is set to .FALSE. on output. */ - -/* BEGDAT Marker used to begin data section of a kernel */ - -/* BEGTXT Marker used to begin text section of a kernel */ - -/* NMPOOL Linked list pool for resolving hash collisions */ -/* of names of kernel pool variables. Each list */ -/* other than the free list, is a sequence of pointers */ -/* to names that have the same hash value. On output */ -/* from this routine all nodes of the pool are in the */ -/* free list. */ - -/* DPPOOL Linked list pool for maintaining d.p. values. */ -/* On output all nodes in the pool are in the free list */ -/* of DPPOOL */ - -/* CHPOOL Linked list pool for maintaining string values. */ -/* On output all nodes in the pool are in the free list */ -/* of CHPOOL */ - -/* NAMLST is an array that contains the heads of lists from */ -/* NMPOOL. NAMLST( ZZHASH( NAME ) ) points to the head */ -/* of the first name in the collision resolution list */ -/* for NAME. If there is no head for the collision */ -/* resolution list for NAME (i.e. no name with the */ -/* same hash value as name has been stored) */ -/* NAMLST( ZZHASH(NAME) ) will be zero. On output from */ -/* this routine all values in NAMLST are set to zero. */ - -/* DATLST is an array that contains the "heads" of lists of */ -/* pointers to the values associated with a variable. */ -/* Suppose that NAME has been located in the list of */ -/* variable names at location LOC. Then DATLST(LOC) */ -/* is the head node of the list of pointers to the */ -/* values of NAME. If DATLST(LOC) is positive then */ -/* the values are d.p.'s If the value of DATLST(LOC) */ -/* is negative, the values are strings. The absolute */ -/* value of DATLST(LOC) is the head node to the list */ -/* of values associated with NAME. If DATLST(LOC) is */ -/* zero then no values have been assigned to the variable */ -/* NAME. On output all entries of DATLST are set to */ -/* zero. */ - -/* WTPTR is a symbol table of variables to watch for. WTPTR */ -/* WATPTR contains the names of variables to watch. The */ -/* WATVAL values associated with a name are the names of agents */ -/* that have requested that the variable be watched. */ - -/* AGENTS Agents contains the list of agents that need to be */ -/* notified about updates to their variables. */ - -/* ACTIVE A temporary set. */ -/* NOTIFY A temporary set. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine that centralizes the initialization */ -/* code that is common to all entry points of POOL. */ - -/* $ Examples */ - -/* See POOL. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-MAR-2009 (NJB) */ - -/* Argument list was changed to accommodate re-implementation */ -/* of watcher system. Initialization tasks performed by this */ -/* routine were updated accordingly. */ - -/* - SPICELIB Version 1.1.0, 13-OCT-1995 (WLT) */ - -/* An integer variable was renamed to better indicate */ -/* its role in the routine and to make maintenance a bit */ -/* easier */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 13-OCT-1995 (WLT) */ - -/* An integer variable was renamed to better indicate */ -/* its role in the routine and to make maintenance a bit */ -/* easier. The integer variable was 'DONE' which looks */ -/* a lot like a logical. It's been changed to 'DUMMY'. */ - -/* -& */ - -/* SPICELIB Functions. */ - - -/* Local parameters */ - - -/* Local variables */ - - /* Parameter adjustments */ - datlst_dim1 = *maxvar; - namlst_dim1 = *maxvar; - - /* Function Body */ - if (*first) { - chkin_("ZZPINI", (ftnlen)6); - i__1 = *maxvar; - for (i__ = 1; i__ <= i__1; ++i__) { - namlst[(i__2 = i__ - 1) < namlst_dim1 && 0 <= i__2 ? i__2 : - s_rnge("namlst", i__2, "zzpini_", (ftnlen)293)] = 0; - datlst[(i__2 = i__ - 1) < datlst_dim1 && 0 <= i__2 ? i__2 : - s_rnge("datlst", i__2, "zzpini_", (ftnlen)294)] = 0; - } - -/* Set up hash function. Use TOUCHI to suppress */ -/* compiler warnings. */ - - dummy = zzshsh_(maxvar); - dummy = touchi_(&dummy); - s_copy(begdat, "\\begindata", begdat_len, (ftnlen)10); - s_copy(begtxt, "\\begintext", begtxt_len, (ftnlen)10); - lnkini_(maxvar, nmpool); - lnkini_(maxval, dppool); - lnkini_(maxlin, chpool); - ssizec_(maxvar, wtvars, wtvars_len); - cleari_(maxvar, wtptrs); - lnkini_(mxnote, wtpool); - clearc_(mxnote, wtagnt, wtagnt_len); - ssizec_(mxnote, agents, agents_len); - ssizec_(mxnote, active, active_len); - ssizec_(mxnote, notify, notify_len); - if (! failed_()) { - *first = FALSE_; - } - chkout_("ZZPINI", (ftnlen)6); - return 0; - } - return 0; -} /* zzpini_ */ - diff --git a/ext/spice/src/cspice/zzplatfm.c b/ext/spice/src/cspice/zzplatfm.c deleted file mode 100644 index 61170b3ff0..0000000000 --- a/ext/spice/src/cspice/zzplatfm.c +++ /dev/null @@ -1,366 +0,0 @@ -/* zzplatfm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure ZZPLATFM ( Private --- Get platform attributes ) */ -/* Subroutine */ int zzplatfm_(char *key, char *value, ftnlen key_len, ftnlen - value_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - integer index; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char keyval[64*6]; - char keycpy[64]; - static char attcpy[32*7]; - -/* $ Abstract */ - -/* Return platform ID and various attributes of the intended */ -/* environment */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* KEY I String indicating what information to return. */ -/* VALUE O String containing the requested information. */ - -/* $ Detailed_Input */ - -/* KEY is a string value that indicates which platform */ -/* specific information is desired. Acceptable inputs */ -/* are: */ - -/* 'SYSTEM' - System Identification String */ -/* 'O/S' - Operating System or Environment */ -/* 'COMPILER' - NAIF Supported Compiler */ -/* 'FILE_FORMAT' - Native Binary File Format */ -/* 'TEXT_FORMAT' - Native Text File Format */ -/* 'READS_BFF' - List of supported binary file */ -/* formats. */ - -/* Note: The comparison is case-insensitive, and the */ -/* supplied value must fit into a string buffer */ -/* KYSIZE characters in length. */ - -/* $ Detailed_Output */ - -/* VALUE is the string that holds the information requested */ -/* by the input string KEY. VALUE must be able to */ -/* contain the maximum number of characters returned */ -/* by this routine, WDSIZE, or truncation will occur. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the KEY is invalid, then VALUE is set to the value */ -/* stored in the character string parameter DEFRPY defined */ -/* below. */ - -/* 2) If VALUE is not large enough to contain the requested */ -/* KEY's value, then truncation will occur. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves to identify the platform and compiler */ -/* used in creating SPICELIB. It is provided so that routines */ -/* and programs can make run-time decisions based upon the */ -/* ambient Fortran environment. */ - -/* Operating Systems: */ - -/* This routine is now aware of the operating systems for which */ -/* the code is intended for compilation. In some cases this may */ -/* be more than one operating system, particularly in the case */ -/* of the PC. */ - -/* Binary File Format: */ - -/* This routine now adds the capability to return at run time */ -/* the binary file architecture that is native to the system. */ - -/* Text File Format: */ - -/* This routine now has the capability to return at run time */ -/* the mechanism (or line terminator) used to delimit lines */ -/* in text files. In most cases it will return common labels */ -/* for the special characters FORTRAN considers line break */ -/* indicators. */ - -/* Binary File Formats Read: */ - -/* This returns a space delimited list of all the binary file */ -/* formats this environment can read for DAF/DAS based files. */ - -/* $ Examples */ - -/* This routine could be used so that a single routine */ -/* could be written that translates the meaning of IOSTAT values */ -/* that depend upon the machine and compiler. At run time */ -/* the routine could look up the appropriate message to associate */ -/* with an IOSTAT value. */ - -/* $ Restrictions */ - -/* 1) VALUE must be large enough to contain the requested */ -/* information, otherwise truncation will occur. */ - -/* 2) The string passed in via the KEY input must be capable */ -/* of being properly copied into the KEYCPY buffer internal */ -/* to this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* E.D. Wright (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.9.0, 16-MAR-2010 (EDW) */ - -/* Updated for: */ - -/* - MAC-OSX-64BIT-INTEL_C */ -/* - PC-64BIT-MS_C */ -/* - SUN-SOLARIS-64BIT-NATIVE_C */ -/* MAC-OSX-64BIT-GFORTRAN */ -/* MAC-OSX-64BIT-IFORT */ -/* PC-LINUX-64BIT-GFORTRAN */ -/* PC-WINDOWS-64BIT-IFORT */ -/* SUN-SOLARIS-INTEL-64BIT-CC_C */ -/* SUN-SOLARIS-INTEL-CC_C */ -/* SUN-SOLARIS-INTEL */ - -/* environments. */ - -/* - SPICELIB Version 2.8.0, 12-JAN-2009 (EDW) */ - -/* Added MAC-OSX-GFORTRAN PC-LINUX-GFORTRAN environments. */ - -/* - SPICELIB Version 2.7.0, 19-FEB-2008 (BVS) */ - -/* Added PC-LINUX-IFORT environment. */ - -/* - SPICELIB Version 2.6.0, 15-NOV-2006 (NJB) */ - -/* Added PC-WINDOWS-IFORT, MAC-OSX-IFORT, and MAC-OSX-INTEL_C */ -/* environments. */ - -/* - SPICELIB Version 2.5.0, 21-FEB-2006 (NJB) */ - -/* Added PC-LINUX-64BIT-GCC_C environment. */ - -/* Corrected error in in-line comments: changed keyword */ -/* from FILE_ARCH to FILE_FORMAT. */ - -/* - SPICELIB Version 2.4.0, 14-MAR-2005 (BVS) */ - -/* Added SUN-SOLARIS-64BIT-GCC_C environment. */ - -/* - SPICELIB Version 2.3.0, 31-DEC-2004 (BVS) */ - -/* Added PC CYGWIN environments. Changed OS for PC-LAHEY, */ -/* PC-DIGITAL, and PC-MS_C to 'MICROSOFT WINDOWS'. */ - -/* - SPICELIB Version 2.2.0, 07-JUL-2002 (EDW) */ - -/* Added Mac OS X Unix environment. */ - -/* - SPICELIB Version 2.1.0, 06-FEB-2002 (FST) */ - -/* Updated the 'TEXT_FORMAT' key value for the PC-LINUX_C */ -/* environment. Previous versions incorrectly indicated */ -/* 'CR-LF' as line terminators. */ - -/* - SPICELIB Version 2.0.0, 05-JUN-2001 (FST) */ - -/* Added TEXT_FORMAT and READS_BFF key/value pairs. */ -/* Modified the header slightly to improve word choice; */ -/* specifically binary file format replaces file */ -/* architecture. */ - -/* Updated the compiler entry for the PC-LINUX */ -/* environment to refer to g77 as opposed to f2c. */ - -/* Updated the compiler entry for the MACPPC environment. */ -/* This environment is now officially tied to Absoft */ -/* Fortran. */ - -/* Updated the compiler entry for the PC-LAHEY environment. */ -/* The compiler for this environment is LF95, the latest */ -/* offering from Lahey. */ - -/* - SPICELIB Version 1.0.0, 22-FEB-1999 (FST) */ - -/* -& */ -/* $ Index_Entries */ - -/* fetch platform dependent information */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Array index parameters for each of the key/value pairs. */ - -/* SYSTEM Index. */ - - -/* O/S Index. */ - - -/* Compiler Index. */ - - -/* Binary File Format Index. */ - - -/* Text File Format Index */ - - -/* Reads Binary File Format Index. */ - - -/* Size of the buffer in which KEY is placed. */ - - -/* Maximum Size of local string returned in VALUE */ - - -/* Number of Platform Dependent values stored here. */ - - -/* Default Reply in the event of an invalid KEY. */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Make the initial assignments to the saved character array. */ - - if (first) { - -/* Store the keys in the KEYVAL array. */ - - s_copy(keyval, "SYSTEM", (ftnlen)64, (ftnlen)6); - s_copy(keyval + 64, "O/S", (ftnlen)64, (ftnlen)3); - s_copy(keyval + 128, "COMPILER", (ftnlen)64, (ftnlen)8); - s_copy(keyval + 192, "FILE_FORMAT", (ftnlen)64, (ftnlen)11); - s_copy(keyval + 256, "TEXT_FORMAT", (ftnlen)64, (ftnlen)11); - s_copy(keyval + 320, "READS_BFF", (ftnlen)64, (ftnlen)9); - -/* Set the default reply to be the zero'th component of ATTCPY. */ -/* This obviates IF-THEN-ELSE branching all together. */ - - s_copy(attcpy, " ", (ftnlen)32, ( - ftnlen)32); - -/* Platform/Environment specific assignments follow. */ - - s_copy(attcpy + 32, "PC", (ftnlen)32, (ftnlen)2); - s_copy(attcpy + 64, "LINUX", (ftnlen)32, (ftnlen)5); - s_copy(attcpy + 96, "GCC/64BIT", (ftnlen)32, (ftnlen)9); - s_copy(attcpy + 128, "LTL-IEEE", (ftnlen)32, (ftnlen)8); - s_copy(attcpy + 160, "LF", (ftnlen)32, (ftnlen)2); - s_copy(attcpy + 192, "BIG-IEEE LTL-IEEE", (ftnlen)32, (ftnlen)17); - -/* Don't execute these assignments again. */ - - first = FALSE_; - } - -/* Determine which KEY was passed in; do this by converting KEY */ -/* to the known member of the equivalence class of possible */ -/* values. */ - - ucase_(key, keycpy, key_len, (ftnlen)64); - ljust_(keycpy, keycpy, (ftnlen)64, (ftnlen)64); - -/* Find out which key we were given. In the event that one of the */ -/* KEYVALs (or some equivalent string) was not passed in, ISRCHC */ -/* returns a value of zero. */ - - index = isrchc_(keycpy, &c__6, keyval, (ftnlen)64, (ftnlen)64); - s_copy(value, attcpy + (((i__1 = index) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "attcpy", i__1, "zzplatfm_", (ftnlen)413)) << 5), value_len, ( - ftnlen)32); - return 0; -} /* zzplatfm_ */ - diff --git a/ext/spice/src/cspice/zzpltchk.c b/ext/spice/src/cspice/zzpltchk.c deleted file mode 100644 index abef9cf0bb..0000000000 --- a/ext/spice/src/cspice/zzpltchk.c +++ /dev/null @@ -1,428 +0,0 @@ -/* zzpltchk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZPLTCHK ( Private --- Platform Check ) */ -/* Subroutine */ int zzpltchk_(logical *ok) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzgetbff_(integer *), zzddhgsd_(char *, - integer *, char *, ftnlen, ftnlen), zzplatfm_(char *, char *, - ftnlen, ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - char value[32], rtebff[32], strbff[32]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - integer bff; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Validate the runtime environment against values assumed by the */ -/* current toolkit source package. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* OK O Logical indicating the runtime environment is ok. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* OK is a logical when set to .TRUE. indicates that the */ -/* runtime environment passes any checks implemented */ -/* by this routine against the configured code. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) This routine signals SPICE(BUG) if it determines the runtime */ -/* environment is incompatible with the configured binary file */ -/* format. */ - -/* $ Particulars */ - -/* This routine encapsulates a series of checks to diagnose the */ -/* runtime environment against assumptions configured in the */ -/* source code. Configuration errors are reported via the error */ -/* SPICE(BUG). */ - -/* $ Examples */ - -/* See ZZDDHOPN for sample usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 07-AUG-2002 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } else { - chkin_("ZZPLTCHK", (ftnlen)8); - } - -/* Verify that the runtime environment's binary file format agrees */ -/* with the value listed in ZZPLATFM. */ - - zzplatfm_("FILE_FORMAT", strbff, (ftnlen)11, (ftnlen)32); - -/* Determine what the runtime environment binary file format appears */ -/* to be. */ - - zzgetbff_(&bff); - zzddhgsd_("BFF", &bff, rtebff, (ftnlen)3, (ftnlen)32); - -/* Check results, signal SPICE(BUG) if a discrepancy appears. */ - - if (s_cmp(strbff, rtebff, (ftnlen)32, (ftnlen)32) != 0) { - setmsg_("This version of SPICELIB was originally packaged by NAIF fo" - "r # hardware using # with the # compiler. This environment " - "has a binary file format of #; however the software is runni" - "ng on an environment that has a binary file format of #. Th" - "is is a severe problem and may be because the software packa" - "ge was intended for use on a different computer system. It " - "also may be the result of an improper port; please contact N" - "AIF.", (ftnlen)423); - zzplatfm_("SYSTEM", value, (ftnlen)6, (ftnlen)32); - errch_("#", value, (ftnlen)1, (ftnlen)32); - zzplatfm_("O/S", value, (ftnlen)3, (ftnlen)32); - errch_("#", value, (ftnlen)1, (ftnlen)32); - zzplatfm_("COMPILER", value, (ftnlen)8, (ftnlen)32); - errch_("#", value, (ftnlen)1, (ftnlen)32); - errch_("#", strbff, (ftnlen)1, (ftnlen)32); - if (s_cmp(rtebff, " ", (ftnlen)32, (ftnlen)1) == 0) { - errch_("#", "UNKNOWN", (ftnlen)1, (ftnlen)7); - } else { - errch_("#", rtebff, (ftnlen)1, (ftnlen)32); - } - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZPLTCHK", (ftnlen)8); - return 0; - } - chkout_("ZZPLTCHK", (ftnlen)8); - return 0; -} /* zzpltchk_ */ - diff --git a/ext/spice/src/cspice/zzprscor.c b/ext/spice/src/cspice/zzprscor.c deleted file mode 100644 index da91b6dce1..0000000000 --- a/ext/spice/src/cspice/zzprscor.c +++ /dev/null @@ -1,420 +0,0 @@ -/* zzprscor.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__15 = 15; -static integer c__0 = 0; - -/* $Procedure ZZPRSCOR ( Parse aberration correction ) */ -/* Subroutine */ int zzprscor_(char *abcorr, logical *attblk, ftnlen - abcorr_len) -{ - /* Initialized data */ - - static char corlst[5*15] = "CN " "CN+S " "LT " "LT+S " "NONE " "RL " - "RL+S " "S " "XCN " "XCN+S" "XLT " "XLT+S" "XRL " "XRL+S" - "XS "; - static logical geo[15] = { FALSE_,FALSE_,FALSE_,FALSE_,TRUE_,FALSE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_ }; - static logical lt[15] = { TRUE_,TRUE_,TRUE_,TRUE_,FALSE_,TRUE_,TRUE_, - FALSE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,FALSE_ }; - static logical stl[15] = { FALSE_,TRUE_,FALSE_,TRUE_,FALSE_,FALSE_,TRUE_, - TRUE_,FALSE_,TRUE_,FALSE_,TRUE_,FALSE_,TRUE_,TRUE_ }; - static logical conv[15] = { TRUE_,TRUE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,TRUE_,TRUE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_ }; - static logical xmit[15] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_ }; - static logical rel[15] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,TRUE_,TRUE_, - FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,TRUE_,TRUE_,FALSE_ }; - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen), - reordc_(integer *, integer *, char *, ftnlen); - integer ordvec[15]; - extern /* Subroutine */ int reordl_(integer *, integer *, logical *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - char tmpcor[5]; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - char tc2[5]; - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Parse an aberration correction string; return attributes. */ - -/* $ 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 */ - -/* ABERRATION */ -/* PARSING */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ABCORR I Aberration correction string. */ -/* ATTBLK O Aberration correction attribute block. */ - -/* $ Detailed_Input */ - -/* ABCORR is a string representing a aberration */ -/* correction. The supported values are: */ - -/* 'CN' */ -/* 'CN+S' */ -/* 'LT' */ -/* 'LT+S' */ -/* 'NONE' */ -/* 'RL' */ -/* 'RL+S' */ -/* 'S' */ -/* 'XCN' */ -/* 'XCN+S' */ -/* 'XLT' */ -/* 'XLT+S' */ -/* 'XRL' */ -/* 'XRL+S' */ -/* 'XS' */ - -/* Note that some values not supported by the */ -/* SPICELIB SPK subsystem are supported by */ -/* this routine: */ - -/* - The letter 'R' indicates relativistic */ -/* corrections. */ - -/* - Stellar aberration-only corrections are */ -/* indicated by the strings */ - -/* 'S' */ -/* 'XS' */ - -/* Case and embedded blanks are not significant in */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* ATTBLK is a block of logical flags indicating the */ -/* attributes of the aberration correction */ -/* specified by ABCORR. The attributes are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the */ -/* "converged Newtonian" variety? */ - -/* - Is the correction for the transmission */ -/* case? */ - -/* - Is the correction relativistic? */ - -/* The structure of ATTBLK is defined in the */ -/* include file */ - -/* zzabcorr.inc */ - -/* The size of ATTBLK and the offsets of the */ -/* component flags are defined there. */ - -/* $ Parameters */ - -/* See INCLUDE file zzabcorr.inc. */ - -/* $ Exceptions */ - -/* 1) If the input aberration correction choice is not recognized, */ -/* the error SPICE(INVALIDOPTION) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Many SPICELIB routines have logic branches based on the */ -/* attributes of aberration corrections. Much duplicated */ -/* parsing code can be avoided by using this routine. */ - -/* In particular, the routine ZZCOREPC uses this routine */ -/* to combine an epoch and light time value to compute */ -/* a light-time-adjusted epoch. */ - -/* $ Examples */ - -/* See ZZCOREPC. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) This routine recognizes some aberration corrections not */ -/* handled by most SPICELIB routines. Callers should do */ -/* their own checking to ensure the parsed correction is */ -/* acceptable. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 13-DEC-2004 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* It is recommended that, for maintainability, the correction */ -/* strings be kept in increasing order in this list. However, */ -/* this routine does not rely on the strings being ordered */ -/* in this data statement: the strings and associated values */ -/* are ordered at run time. */ - - if (return_()) { - return 0; - } - chkin_("ZZPRSCOR", (ftnlen)8); - if (first) { - -/* The first time this routine is called, we sort the */ -/* aberration correction strings and the associated flag */ -/* lists. This ensures we have an ordered list suitable */ -/* for a binary search. */ - -/* Find the sorted order of the aberration correction strings. */ - - orderc_(corlst, &c__15, ordvec, (ftnlen)5); - -/* Put the aberration correction strings and the associated */ -/* arrays into increasing order. */ - - reordc_(ordvec, &c__15, corlst, (ftnlen)5); - reordl_(ordvec, &c__15, geo); - reordl_(ordvec, &c__15, lt); - reordl_(ordvec, &c__15, stl); - reordl_(ordvec, &c__15, conv); - reordl_(ordvec, &c__15, xmit); - reordl_(ordvec, &c__15, rel); - first = FALSE_; - } - -/* Obtain a blank-free, upper-case copy of the aberration */ -/* correction string. */ - - cmprss_(" ", &c__0, abcorr, tc2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(tc2, tmpcor, (ftnlen)5, (ftnlen)5); - -/* Search the list for the aberration correction string. */ - - loc = bsrchc_(tmpcor, &c__15, corlst, (ftnlen)5, (ftnlen)5); - if (loc == 0) { - setmsg_("Aberration correction specification # is not recognized.", ( - ftnlen)56); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZPRSCOR", (ftnlen)8); - return 0; - } - -/* Set the output flags. */ - - attblk[0] = geo[(i__1 = loc - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("geo", - i__1, "zzprscor_", (ftnlen)316)]; - attblk[1] = lt[(i__1 = loc - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("lt", - i__1, "zzprscor_", (ftnlen)317)]; - attblk[2] = stl[(i__1 = loc - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("stl", - i__1, "zzprscor_", (ftnlen)318)]; - attblk[3] = conv[(i__1 = loc - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("conv" - , i__1, "zzprscor_", (ftnlen)319)]; - attblk[4] = xmit[(i__1 = loc - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("xmit" - , i__1, "zzprscor_", (ftnlen)320)]; - attblk[5] = rel[(i__1 = loc - 1) < 15 && 0 <= i__1 ? i__1 : s_rnge("rel", - i__1, "zzprscor_", (ftnlen)321)]; - chkout_("ZZPRSCOR", (ftnlen)8); - return 0; -} /* zzprscor_ */ - diff --git a/ext/spice/src/cspice/zzrbrkst.c b/ext/spice/src/cspice/zzrbrkst.c deleted file mode 100644 index 6bc107486f..0000000000 --- a/ext/spice/src/cspice/zzrbrkst.c +++ /dev/null @@ -1,249 +0,0 @@ -/* zzrbrkst.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZRBRKST ( Private --- Reverse Bracketed String Extractor ) */ -/* Subroutine */ int zzrbrkst_(char *string, char *lftend, char *rgtend, char - *substr, integer *length, logical *bkpres, ftnlen string_len, ftnlen - lftend_len, ftnlen rgtend_len, ftnlen substr_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer posr_(char *, char *, integer *, ftnlen, ftnlen); - integer bsize, lsize, rsize, lindex, rindex; - -/* $ Abstract */ - -/* Extract from a string the last instance of a substring bracketed */ -/* by specified left and right strings . */ - -/* $ 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 */ - -/* STRINGS */ -/* UTILITY */ -/* SCANNING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A string from which to extract SUBSTR. */ -/* LFTEND I A string that brackets SUBSTR on the left. */ -/* RGTEND I A string that brackets SUBSTR on the right. */ -/* SUBSTR O The extracted substring. */ -/* LENGTH O The length of the extracted substring. */ -/* BKPRES O Logical indicating if either bracket is present. */ - -/* $ Detailed_Input */ - -/* STRING is a string to be searched for a substring bracketed */ -/* by the strings LFTEND and RGTEND (see below). */ - -/* LFTEND, are respectively the left and right bracketing strings. */ -/* RGTEND Trailing and leading white space is significant. LFTEND */ -/* may equal RGTEND. See the Exceptions section for a */ -/* discussion of the case in which either of these strings */ -/* is absent. */ - -/* $ Detailed_Output */ - -/* SUBSTR is the substring of interest. It consists of the */ -/* substring between the last instances of LFTEND */ -/* and RGTEND in STRING. Note: The argument passed into */ -/* the routine should be large enough to hold the entire */ -/* substring, or else truncation will occur. SUBSTR is */ -/* padded with trailing blanks. */ - -/* LENGTH is the number of characters placed into SUBSTR. This */ -/* value permits any significant trailing whitespace to be */ -/* dealt with appropriately. In the event that no */ -/* substring is assigned to SUBSTR, LENGTH will be 0. */ - -/* BKPRES is a logical that indicates whether or not at least */ -/* one of LFTEND or RGTEND is present in STRING. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If LFTEND or RGTEND are not present in STRING, then the routine */ -/* does not modify the contents of SUBSTR, LENGTH is returned as */ -/* 0, and BKPRES is TRUE only if LFTEND or RGTEND is present. */ - -/* 2) If LFTEND and RGTEND are adjacent, then SUBSTR is not modified, */ -/* LENGTH is returned as 0, and BKPRES is TRUE. */ - -/* $ Particulars */ - -/* The purpose of this routine is to extract the last instance of */ -/* a substring bracketed by two specified strings. The searching */ -/* is case sensitive, and all white space is significant. The */ -/* characters between LFTEND and RGTEND are placed into SUBSTR, */ -/* and LENGTH is set to the number of characters copied into SUBSTR. */ -/* The assignment is not substring assignment, so the resultant */ -/* SUBSTR will be blank padded. The logical BKPRES is a flag that */ -/* indicates whether or not either of the two brackets was found. */ -/* This is diagnostic information of some limited use in the event */ -/* that SUBSTR was not assigned a value. */ - -/* $ Examples */ - -/* The following table demonstrates the behavior of this routine: */ -/* ( If a row in the table has no entry for SUBSTR, then the */ -/* contents of SUBSTR are not modified by calling the routine */ -/* with these inputs. ) */ - -/* STRING LFTEND RGTEND SUBSTR LENGTH */ -/* =================== ======= ======= ================= ====== */ -/* 'abc def ghi jkl' 'a' 'l' 'bc def ghi jk' 13 */ -/* 'abc def ghi jkl' 'abc' 'ghi' ' def ' 5 */ -/* 'abc def ghi jkl' 'abc' '123' 0 */ -/* 'abc def ghi jkl' '123' 'def' 0 */ -/* 'abc def ghi jkl' 'jkl' 'zzz' 0 */ -/* 'abc def abc jkl' 'abc' 'abc' ' def ' 5 */ -/* 'ab cd ab ef ab ' 'ab' 'ab' ' ef ' 4 */ -/* 'ab cd ab ef ab ' 'ef' 'cd' 0 */ -/* 'abc def-fed abc' 'def' '-fed' 0 */ -/* 'aaaaaaaaaaaaaaa' 'aa' 'aaaa' 0 */ -/* 'aaaabbbaabababa' 'ba' 'a' 'b' 1 */ -/* 'aaaabbbaababada' 'ba' 'a' 'd' 1 */ -/* 'abcd efgh ijkl ' ' ' 'l' 'ijk' 3 */ -/* 'abcd efgh ijkl ' ' ' 'l' 0 */ -/* 'ab ef ijklm ' ' ' 'm' 'ijkl' 4 */ -/* 'ab ef ijklm ' ' ' 'm' 'ef ijkl' 8 */ - -/* $ Restrictions */ - -/* 1) The size of SUBSTR must be large enough to contain any */ -/* possible substring bracketed by LFTEND or RGTEND, otherwise */ -/* truncation will occur at assignment. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 22-MAR-1999 (FST) */ - - -/* -& */ -/* $ Index_Entries */ - -/* reverse bracketed string extraction */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Compute the sizes of the bracketing substrings and the text */ -/* block. */ - - lsize = i_len(lftend, lftend_len); - rsize = i_len(rgtend, rgtend_len); - bsize = i_len(string, string_len); - -/* Search from the right for RGTEND. */ - - rindex = posr_(string, rgtend, &bsize, string_len, rgtend_len); - -/* Now continue the search from RINDEX to the right, this time */ -/* looking for LFTEND. If RINDEX comes back as 0, then the right */ -/* bracketing substring is not present, so search the entire string */ -/* for LFTEND. Otherwise, search from where the right bracket */ -/* search left off. */ - - if (rindex == 0) { - lindex = posr_(string, lftend, &bsize, string_len, lftend_len); - } else { - i__1 = rindex - lsize; - lindex = posr_(string, lftend, &i__1, string_len, lftend_len); - } - -/* Interpret the results. If RINDEX and LINDEX are both non-zero, */ -/* then return the substring they bracket, otherwise handle the */ -/* failed case. */ - - if (rindex != 0 && lindex != 0) { - -/* Check to see whether or not the brackets are adjacent, and */ -/* thus have no characters between them. */ - - if (lindex + lsize > rindex - 1) { - *bkpres = TRUE_; - *length = 0; - -/* If they aren't adjacent, then compute the length and prepare */ -/* SUBSTR. */ - - } else { - *length = rindex - (lindex + lsize); - *bkpres = TRUE_; - i__1 = lindex + lsize - 1; - s_copy(substr, string + i__1, substr_len, rindex - 1 - i__1); - } - } else { - -/* Set BKPRES to TRUE only if LINDEX or RINDEX is non-zero, */ -/* indicating one was found by POSR. Set LENGTH to 0, since we */ -/* will not be changing SUBSTR. */ - - *bkpres = lindex + rindex > 0; - *length = 0; - } - return 0; -} /* zzrbrkst_ */ - diff --git a/ext/spice/src/cspice/zzrefch0.c b/ext/spice/src/cspice/zzrefch0.c deleted file mode 100644 index e31f250916..0000000000 --- a/ext/spice/src/cspice/zzrefch0.c +++ /dev/null @@ -1,680 +0,0 @@ -/* zzrefch0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ZZREFCH0 (Reference frame Change) */ -/* Subroutine */ int zzrefch0_(integer *frame1, integer *frame2, doublereal * - et, doublereal *rotate) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer node; - logical done; - integer cent, this__; - extern /* Subroutine */ int zzrotgt0_(integer *, doublereal *, doublereal - *, integer *, logical *), zznofcon_(doublereal *, integer *, - integer *, integer *, integer *, char *, ftnlen); - integer i__, j, frame[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ident_(doublereal *); - integer class__; - logical found; - integer relto; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *), zzrxr_( - doublereal *, integer *, doublereal *); - extern logical failed_(void); - integer cmnode; - extern integer isrchi_(integer *, integer *, integer *); - integer clssid; - extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, - integer *, logical *); - logical gotone; - char errmsg[1840]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen); - extern logical return_(void); - doublereal tmprot[9] /* was [3][3] */; - integer inc, get; - doublereal rot[126] /* was [3][3][14] */; - integer put; - doublereal rot2[18] /* was [3][3][2] */; - -/* $ Abstract */ - -/* Return the transformation matrix from one */ -/* frame to another. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRAME1 I the frame id-code for some reference frame */ -/* FRAME2 I the frame id-code for some reference frame */ -/* ET I an epoch in TDB seconds past J2000. */ -/* ROTATE O a rotation matrix */ - -/* $ Detailed_Input */ - -/* FRAME1 is the frame id-code in which some positions */ -/* are known. */ - -/* FRAME2 is the frame id-code for some frame in which you */ -/* would like to represent positions. */ - -/* ET is the epoch at which to compute the transformation */ -/* matrix. This epoch should be in TDB seconds past */ -/* the ephemeris epoch of J2000. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3 x 3 rotaion matrix that can be used to */ -/* transform positions relative to the frame */ -/* correspsonding to frame FRAME2 to positions relative */ -/* to the frame FRAME2. More explicitely, if POS is */ -/* the position of some object relative to the */ -/* reference frame of FRAME1 then POS2 is the position */ -/* of the same object relative to FRAME2 where POS2 is */ -/* computed via the subroutine call below */ - -/* CALL MXV ( ROTATE, POS, POS2 ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the reference frames is unrecognized, the error */ -/* SPICE(UNKNOWNFRAME) will be signalled. */ - -/* 2) If the auxillary information needed to compute a non-inertial */ -/* frame is not available an error will be diagnosed and signalled */ -/* by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to compute the rotation matrix */ -/* between two reference frames. */ - - -/* $ Examples */ - -/* Suppose that you have a position POS1 at epoch ET */ -/* relative to FRAME1 and wish to determine its representation */ -/* POS2 relative to FRAME2. The following subroutine calls */ -/* would suffice to make this rotation. */ - -/* CALL REFCHG ( FRAME1, FRAME2, ET, ROTATE ) */ -/* CALL MXV ( ROTATE, POS1, POS2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ - -/* Upgraded long error message associated with frame */ -/* connection failure. */ - -/* - SPICELIB Version 1.2.0, 26-APR-2004 (NJB) */ - -/* Another typo was corrected in the long error message, and */ -/* in a comment. */ - -/* - SPICELIB Version 1.1.0, 23-MAY-2000 (WLT) */ - -/* A typo was corrected in the long error message. */ - -/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Rotate positions from one frame to another */ - -/* -& */ - -/* SPICE functions */ - - -/* Local Paramters */ - - -/* The root of all reference frames is J2000 (Frame ID = 1). */ - - -/* Local Variables */ - - -/* ROT contains the rotations from FRAME1 to FRAME2 */ -/* ROT(1...3,1...3,I) has the rotation from FRAME(I) */ -/* to FRAME(I+1). We make extra room in ROT because we */ -/* plan to add rotations beyond the obvious chain from */ -/* FRAME1 to a root node. */ - - -/* ROT2 is used to store intermediate rotation from */ -/* FRAME2 to some node in the chain from FRAME1 to PCK or */ -/* INERTL frames. */ - - -/* FRAME contains the frames we transform from in going from */ -/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ - - -/* NODE counts the number of rotations needed to go */ -/* from FRAME1 to FRAME2. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZREFCH0", (ftnlen)8); - -/* Do the obvious thing first. If FRAME1 and FRAME2 are the */ -/* same then we simply return the identity matrix. */ - - if (*frame1 == *frame2) { - ident_(rotate); - chkout_("ZZREFCH0", (ftnlen)8); - return 0; - } - -/* Now perform the obvious check to make sure that both */ -/* frames are recognized. */ - - frinfo_(frame1, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame1, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZREFCH0", (ftnlen)8); - return 0; - } - frinfo_(frame2, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame2, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZREFCH0", (ftnlen)8); - return 0; - } - node = 1; - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, - "zzrefch0_", (ftnlen)287)] = *frame1; - found = TRUE_; - -/* Follow the chain of rotations until we run into */ -/* one that rotates to J2000 (frame id = 1) or we hit FRAME2. */ - - while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch0_", (ftnlen)293)] != 1 && node < 10 && frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzrefch0_", (ftnlen)293)] != *frame2 && found) { - -/* Find out what rotation is available for this */ -/* frame. */ - - zzrotgt0_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzrefch0_", (ftnlen)301)], et, &rot[(i__2 = ( - node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "zzrefch0_", (ftnlen)301)], &frame[(i__3 = node) - < 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "zzrefch0_", - (ftnlen)301)], &found); - if (found) { - -/* We found a rotation matrix. ROT(1,1,NODE) */ -/* now contains the rotation from FRAME(NODE) */ -/* to FRAME(NODE+1). We need to look up the information */ -/* for the next NODE. */ - - ++node; - } - } - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch0_", (ftnlen)317)] == 1 || frame[(i__2 = node - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "zzrefch0_", ( - ftnlen)317)] == *frame2 || ! found; - while(! done) { - -/* The only way to get to this point is to have run out of */ -/* room in the array of reference frame rotation */ -/* buffers. We will now build the rotation from */ -/* the previous NODE to whatever the next node in the */ -/* chain is. We'll do this until we get to one of the */ -/* root classes or we run into FRAME2. */ - - zzrotgt0_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzrefch0_", (ftnlen)331)], et, &rot[(i__2 = ( - node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "zzrefch0_", (ftnlen)331)], &relto, &found); - if (found) { - -/* Recall that ROT(1,1,NODE-1) contains the rotation */ -/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ -/* FRAME(NODE) with the frame indicated by RELTO. This means */ -/* that ROT(1,1,NODE-1) should be replaced with the */ -/* rotation from FRAME(NODE) to RELTO. */ - - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch0_", (ftnlen)342)] = relto; - zzrxr_(&rot[(i__1 = ((node - 1) * 3 + 1) * 3 - 12) < 126 && 0 <= - i__1 ? i__1 : s_rnge("rot", i__1, "zzrefch0_", (ftnlen) - 343)], &c__2, tmprot); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot[(i__1 = i__ + (j + (node - 1) * 3) * 3 - 13) < 126 && - 0 <= i__1 ? i__1 : s_rnge("rot", i__1, "zzrefch0_" - , (ftnlen)347)] = tmprot[(i__2 = i__ + j * 3 - 4) - < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2, - "zzrefch0_", (ftnlen)347)]; - } - } - } - -/* We are done if the class of the last frame is J2000 */ -/* or if the last frame is FRAME2 or if we simply couldn't get */ -/* another rotation. */ - - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzrefch0_", (ftnlen)357)] == 1 || frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzrefch0_", (ftnlen)357)] == *frame2 || ! found; - } - -/* Right now we have the following situation. We have in hand */ -/* a collection of rotations between frames. (Assuming */ -/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ -/* no rotations computed yet. */ - - -/* ROT(1...3, 1...3, 1 ) rotates FRAME1 to FRAME(2) */ -/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ -/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ -/* . */ -/* . */ -/* . */ -/* ROT(1...3, 1...3, NODE-1 ) rotates FRAME(NODE-1) */ -/* to FRAME(NODE) */ - - -/* One of the following situations is true. */ - -/* 1) FRAME(NODE) is the root of all frames, J2000. */ - -/* 2) FRAME(NODE) is the same as FRAME2 */ - -/* 3) There is no rotation from FRAME(NODE) to another */ -/* more fundamental frame. The chain of rotations */ -/* from FRAME1 stops at FRAME(NODE). This means that the */ -/* "frame atlas" is incomplete because we can't get to the */ -/* root frame. */ - -/* We now have to do essentially the same thing for FRAME2. */ - - if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch0_", (ftnlen)395)] == *frame2) { - -/* We can handle this one immediately with the private routine */ -/* ZZRXR which multiplies a series of matrices. */ - - i__1 = node - 1; - zzrxr_(rot, &i__1, rotate); - chkout_("ZZREFCH0", (ftnlen)8); - return 0; - } - -/* We didn't luck out above. So we follow the chain of */ -/* rotation for FRAME2. Note that at the moment the */ -/* chain of rotations from FRAME2 to other frames */ -/* does not share a node in the chain for FRAME1. */ -/* ( GOTONE = .FALSE. ) . */ - - this__ = *frame2; - gotone = FALSE_; - -/* First see if there is any chain to follow. */ - - done = this__ == 1; - -/* Set up the matrices ROT2(,,1) and ROT(,,2) and set up */ -/* PUT and GET pointers so that we know where to GET the partial */ -/* rotation from and where to PUT partial results. */ - - if (! done) { - put = 1; - get = 1; - inc = 1; - } - -/* Follow the chain of rotations until we run into */ -/* one that rotates to the root frame or we land in the */ -/* chain of nodes for FRAME1. */ - -/* Note that this time we will simply keep track of the full */ -/* rotation from FRAME2 to the last node. */ - - while(! done) { - -/* Find out what rotation is available for this */ -/* frame. */ - - if (this__ == *frame2) { - -/* This is the first pass, just put the rotation */ -/* directly into ROT2(,,PUT). */ - - zzrotgt0_(&this__, et, &rot2[(i__1 = (put * 3 + 1) * 3 - 12) < 18 - && 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "zzrefch0_", ( - ftnlen)452)], &relto, &found); - if (found) { - this__ = relto; - get = put; - put += inc; - inc = -inc; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } else { - -/* Fetch the rotation into a temporary spot TMPROT */ - - zzrotgt0_(&this__, et, tmprot, &relto, &found); - if (found) { - -/* Next multiply TMPROT on the right by the last partial */ -/* product (in ROT2(,,GET) ). We do this in line. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot2[(i__1 = i__ + (j + put * 3) * 3 - 13) < 18 && 0 - <= i__1 ? i__1 : s_rnge("rot2", i__1, "zzref" - "ch0_", (ftnlen)478)] = tmprot[(i__2 = i__ - 1) - < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", - i__2, "zzrefch0_", (ftnlen)478)] * rot2[(i__3 - = (j + get * 3) * 3 - 12) < 18 && 0 <= i__3 ? - i__3 : s_rnge("rot2", i__3, "zzrefch0_", ( - ftnlen)478)] + tmprot[(i__4 = i__ + 2) < 9 && - 0 <= i__4 ? i__4 : s_rnge("tmprot", i__4, - "zzrefch0_", (ftnlen)478)] * rot2[(i__5 = (j - + get * 3) * 3 - 11) < 18 && 0 <= i__5 ? i__5 - : s_rnge("rot2", i__5, "zzrefch0_", (ftnlen) - 478)] + tmprot[(i__6 = i__ + 5) < 9 && 0 <= - i__6 ? i__6 : s_rnge("tmprot", i__6, "zzrefc" - "h0_", (ftnlen)478)] * rot2[(i__7 = (j + get * - 3) * 3 - 10) < 18 && 0 <= i__7 ? i__7 : - s_rnge("rot2", i__7, "zzrefch0_", (ftnlen)478) - ]; - } - } - -/* Adjust GET and PUT so that GET points to the slots */ -/* where we just stored the result of our multiply and */ -/* so that PUT points to the next available storage */ -/* locations. */ - - get = put; - put += inc; - inc = -inc; - this__ = relto; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } - -/* See if we have a common node and determine whether or not */ -/* we are done with this loop. */ - - done = this__ == 1 || gotone || ! found; - } - -/* There are two possible scenarios. Either the chain of */ -/* rotations from FRAME2 ran into a node in the chain for */ -/* FRAME1 or it didn't. (The common node might very well be */ -/* the root node.) If we didn't run into a common one, then */ -/* the two chains don't intersect and there is no way to */ -/* get from FRAME1 to FRAME2. */ - - if (! gotone) { - zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("frame", i__1, "zzrefch0_", (ftnlen)525)], - frame2, &this__, errmsg, (ftnlen)1840); - if (failed_()) { - -/* We were unable to create the error message. This */ -/* unfortunate situation could arise if a frame kernel */ -/* is corrupted. */ - - chkout_("ZZREFCH0", (ftnlen)8); - return 0; - } - -/* The normal case: signal an error with a descriptive long */ -/* error message. */ - - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); - chkout_("ZZREFCH0", (ftnlen)8); - return 0; - } - -/* Recall that we have the following. */ - -/* ROT(1...3, 1...3, 1 ) rotates FRAME(1) to FRAME(2) */ -/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ -/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ - -/* ROT(1...3, 1...3, CMNODE-1) rotates FRAME(CMNODE-1) */ -/* to FRAME(CMNODE) */ - -/* and that ROT2(1,1,GET) rotates from FRAME2 to CMNODE. */ -/* Hence the inverse of ROT2(1,1,GET) rotates from CMNODE */ -/* to FRAME2. */ - -/* If we compute the inverse of ROT2 and store it in */ -/* the next available slot of ROT (.i.e. ROT(1,1,CMNODE) */ -/* we can simply apply our custom routine that multiplies a */ -/* sequence of rotation matrices together to get the */ -/* result from FRAME1 to FRAME2. */ - - xpose_(&rot2[(i__1 = (get * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : - s_rnge("rot2", i__1, "zzrefch0_", (ftnlen)568)], &rot[(i__2 = ( - cmnode * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "zzrefch0_", (ftnlen)568)]); - zzrxr_(rot, &cmnode, rotate); - chkout_("ZZREFCH0", (ftnlen)8); - return 0; -} /* zzrefch0_ */ - diff --git a/ext/spice/src/cspice/zzrefch1.c b/ext/spice/src/cspice/zzrefch1.c deleted file mode 100644 index 26c48ce3f6..0000000000 --- a/ext/spice/src/cspice/zzrefch1.c +++ /dev/null @@ -1,680 +0,0 @@ -/* zzrefch1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ZZREFCH1 (Reference frame Change) */ -/* Subroutine */ int zzrefch1_(integer *frame1, integer *frame2, doublereal * - et, doublereal *rotate) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer node; - logical done; - integer cent, this__; - extern /* Subroutine */ int zzrotgt1_(integer *, doublereal *, doublereal - *, integer *, logical *), zznofcon_(doublereal *, integer *, - integer *, integer *, integer *, char *, ftnlen); - integer i__, j, frame[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ident_(doublereal *); - integer class__; - logical found; - integer relto; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *), zzrxr_( - doublereal *, integer *, doublereal *); - extern logical failed_(void); - integer cmnode; - extern integer isrchi_(integer *, integer *, integer *); - integer clssid; - extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, - integer *, logical *); - logical gotone; - char errmsg[1840]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, - ftnlen); - extern logical return_(void); - doublereal tmprot[9] /* was [3][3] */; - integer inc, get; - doublereal rot[126] /* was [3][3][14] */; - integer put; - doublereal rot2[18] /* was [3][3][2] */; - -/* $ Abstract */ - -/* Return the transformation matrix from one */ -/* frame to another. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FRAME1 I the frame id-code for some reference frame */ -/* FRAME2 I the frame id-code for some reference frame */ -/* ET I an epoch in TDB seconds past J2000. */ -/* ROTATE O a rotation matrix */ - -/* $ Detailed_Input */ - -/* FRAME1 is the frame id-code in which some positions */ -/* are known. */ - -/* FRAME2 is the frame id-code for some frame in which you */ -/* would like to represent positions. */ - -/* ET is the epoch at which to compute the transformation */ -/* matrix. This epoch should be in TDB seconds past */ -/* the ephemeris epoch of J2000. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3 x 3 rotaion matrix that can be used to */ -/* transform positions relative to the frame */ -/* correspsonding to frame FRAME2 to positions relative */ -/* to the frame FRAME2. More explicitely, if POS is */ -/* the position of some object relative to the */ -/* reference frame of FRAME1 then POS2 is the position */ -/* of the same object relative to FRAME2 where POS2 is */ -/* computed via the subroutine call below */ - -/* CALL MXV ( ROTATE, POS, POS2 ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of the reference frames is unrecognized, the error */ -/* SPICE(UNKNOWNFRAME) will be signalled. */ - -/* 2) If the auxillary information needed to compute a non-inertial */ -/* frame is not available an error will be diagnosed and signalled */ -/* by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to compute the rotation matrix */ -/* between two reference frames. */ - - -/* $ Examples */ - -/* Suppose that you have a position POS1 at epoch ET */ -/* relative to FRAME1 and wish to determine its representation */ -/* POS2 relative to FRAME2. The following subroutine calls */ -/* would suffice to make this rotation. */ - -/* CALL REFCHG ( FRAME1, FRAME2, ET, ROTATE ) */ -/* CALL MXV ( ROTATE, POS1, POS2 ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ - -/* Upgraded long error message associated with frame */ -/* connection failure. */ - -/* - SPICELIB Version 1.2.0, 26-APR-2004 (NJB) */ - -/* Another typo was corrected in the long error message, and */ -/* in a comment. */ - -/* - SPICELIB Version 1.1.0, 23-MAY-2000 (WLT) */ - -/* A typo was corrected in the long error message. */ - -/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Rotate positions from one frame to another */ - -/* -& */ - -/* SPICE functions */ - - -/* Local Paramters */ - - -/* The root of all reference frames is J2000 (Frame ID = 1). */ - - -/* Local Variables */ - - -/* ROT contains the rotations from FRAME1 to FRAME2 */ -/* ROT(1...3,1...3,I) has the rotation from FRAME(I) */ -/* to FRAME(I+1). We make extra room in ROT because we */ -/* plan to add rotations beyond the obvious chain from */ -/* FRAME1 to a root node. */ - - -/* ROT2 is used to store intermediate rotation from */ -/* FRAME2 to some node in the chain from FRAME1 to PCK or */ -/* INERTL frames. */ - - -/* FRAME contains the frames we transform from in going from */ -/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ - - -/* NODE counts the number of rotations needed to go */ -/* from FRAME1 to FRAME2. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZREFCH1", (ftnlen)8); - -/* Do the obvious thing first. If FRAME1 and FRAME2 are the */ -/* same then we simply return the identity matrix. */ - - if (*frame1 == *frame2) { - ident_(rotate); - chkout_("ZZREFCH1", (ftnlen)8); - return 0; - } - -/* Now perform the obvious check to make sure that both */ -/* frames are recognized. */ - - frinfo_(frame1, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame1, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZREFCH1", (ftnlen)8); - return 0; - } - frinfo_(frame2, ¢, &class__, &clssid, &found); - if (! found) { - setmsg_("The number # is not a recognized id-code for a reference fr" - "ame. ", (ftnlen)64); - errint_("#", frame2, (ftnlen)1); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZREFCH1", (ftnlen)8); - return 0; - } - node = 1; - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, - "zzrefch1_", (ftnlen)287)] = *frame1; - found = TRUE_; - -/* Follow the chain of rotations until we run into */ -/* one that rotates to J2000 (frame id = 1) or we hit FRAME2. */ - - while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch1_", (ftnlen)293)] != 1 && node < 10 && frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzrefch1_", (ftnlen)293)] != *frame2 && found) { - -/* Find out what rotation is available for this */ -/* frame. */ - - zzrotgt1_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzrefch1_", (ftnlen)301)], et, &rot[(i__2 = ( - node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "zzrefch1_", (ftnlen)301)], &frame[(i__3 = node) - < 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "zzrefch1_", - (ftnlen)301)], &found); - if (found) { - -/* We found a rotation matrix. ROT(1,1,NODE) */ -/* now contains the rotation from FRAME(NODE) */ -/* to FRAME(NODE+1). We need to look up the information */ -/* for the next NODE. */ - - ++node; - } - } - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch1_", (ftnlen)317)] == 1 || frame[(i__2 = node - 1) < - 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "zzrefch1_", ( - ftnlen)317)] == *frame2 || ! found; - while(! done) { - -/* The only way to get to this point is to have run out of */ -/* room in the array of reference frame rotation */ -/* buffers. We will now build the rotation from */ -/* the previous NODE to whatever the next node in the */ -/* chain is. We'll do this until we get to one of the */ -/* root classes or we run into FRAME2. */ - - zzrotgt1_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzrefch1_", (ftnlen)331)], et, &rot[(i__2 = ( - node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "zzrefch1_", (ftnlen)331)], &relto, &found); - if (found) { - -/* Recall that ROT(1,1,NODE-1) contains the rotation */ -/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ -/* FRAME(NODE) with the frame indicated by RELTO. This means */ -/* that ROT(1,1,NODE-1) should be replaced with the */ -/* rotation from FRAME(NODE) to RELTO. */ - - frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch1_", (ftnlen)342)] = relto; - zzrxr_(&rot[(i__1 = ((node - 1) * 3 + 1) * 3 - 12) < 126 && 0 <= - i__1 ? i__1 : s_rnge("rot", i__1, "zzrefch1_", (ftnlen) - 343)], &c__2, tmprot); - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot[(i__1 = i__ + (j + (node - 1) * 3) * 3 - 13) < 126 && - 0 <= i__1 ? i__1 : s_rnge("rot", i__1, "zzrefch1_" - , (ftnlen)347)] = tmprot[(i__2 = i__ + j * 3 - 4) - < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2, - "zzrefch1_", (ftnlen)347)]; - } - } - } - -/* We are done if the class of the last frame is J2000 */ -/* or if the last frame is FRAME2 or if we simply couldn't get */ -/* another rotation. */ - - done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "frame", i__1, "zzrefch1_", (ftnlen)357)] == 1 || frame[(i__2 - = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, - "zzrefch1_", (ftnlen)357)] == *frame2 || ! found; - } - -/* Right now we have the following situation. We have in hand */ -/* a collection of rotations between frames. (Assuming */ -/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ -/* no rotations computed yet. */ - - -/* ROT(1...3, 1...3, 1 ) rotates FRAME1 to FRAME(2) */ -/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ -/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ -/* . */ -/* . */ -/* . */ -/* ROT(1...3, 1...3, NODE-1 ) rotates FRAME(NODE-1) */ -/* to FRAME(NODE) */ - - -/* One of the following situations is true. */ - -/* 1) FRAME(NODE) is the root of all frames, J2000. */ - -/* 2) FRAME(NODE) is the same as FRAME2 */ - -/* 3) There is no rotation from FRAME(NODE) to another */ -/* more fundamental frame. The chain of rotations */ -/* from FRAME1 stops at FRAME(NODE). This means that the */ -/* "frame atlas" is incomplete because we can't get to the */ -/* root frame. */ - -/* We now have to do essentially the same thing for FRAME2. */ - - if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", - i__1, "zzrefch1_", (ftnlen)395)] == *frame2) { - -/* We can handle this one immediately with the private routine */ -/* ZZRXR which multiplies a series of matrices. */ - - i__1 = node - 1; - zzrxr_(rot, &i__1, rotate); - chkout_("ZZREFCH1", (ftnlen)8); - return 0; - } - -/* We didn't luck out above. So we follow the chain of */ -/* rotation for FRAME2. Note that at the moment the */ -/* chain of rotations from FRAME2 to other frames */ -/* does not share a node in the chain for FRAME1. */ -/* ( GOTONE = .FALSE. ) . */ - - this__ = *frame2; - gotone = FALSE_; - -/* First see if there is any chain to follow. */ - - done = this__ == 1; - -/* Set up the matrices ROT2(,,1) and ROT(,,2) and set up */ -/* PUT and GET pointers so that we know where to GET the partial */ -/* rotation from and where to PUT partial results. */ - - if (! done) { - put = 1; - get = 1; - inc = 1; - } - -/* Follow the chain of rotations until we run into */ -/* one that rotates to the root frame or we land in the */ -/* chain of nodes for FRAME1. */ - -/* Note that this time we will simply keep track of the full */ -/* rotation from FRAME2 to the last node. */ - - while(! done) { - -/* Find out what rotation is available for this */ -/* frame. */ - - if (this__ == *frame2) { - -/* This is the first pass, just put the rotation */ -/* directly into ROT2(,,PUT). */ - - zzrotgt1_(&this__, et, &rot2[(i__1 = (put * 3 + 1) * 3 - 12) < 18 - && 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "zzrefch1_", ( - ftnlen)452)], &relto, &found); - if (found) { - this__ = relto; - get = put; - put += inc; - inc = -inc; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } else { - -/* Fetch the rotation into a temporary spot TMPROT */ - - zzrotgt1_(&this__, et, tmprot, &relto, &found); - if (found) { - -/* Next multiply TMPROT on the right by the last partial */ -/* product (in ROT2(,,GET) ). We do this in line. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rot2[(i__1 = i__ + (j + put * 3) * 3 - 13) < 18 && 0 - <= i__1 ? i__1 : s_rnge("rot2", i__1, "zzref" - "ch1_", (ftnlen)478)] = tmprot[(i__2 = i__ - 1) - < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", - i__2, "zzrefch1_", (ftnlen)478)] * rot2[(i__3 - = (j + get * 3) * 3 - 12) < 18 && 0 <= i__3 ? - i__3 : s_rnge("rot2", i__3, "zzrefch1_", ( - ftnlen)478)] + tmprot[(i__4 = i__ + 2) < 9 && - 0 <= i__4 ? i__4 : s_rnge("tmprot", i__4, - "zzrefch1_", (ftnlen)478)] * rot2[(i__5 = (j - + get * 3) * 3 - 11) < 18 && 0 <= i__5 ? i__5 - : s_rnge("rot2", i__5, "zzrefch1_", (ftnlen) - 478)] + tmprot[(i__6 = i__ + 5) < 9 && 0 <= - i__6 ? i__6 : s_rnge("tmprot", i__6, "zzrefc" - "h1_", (ftnlen)478)] * rot2[(i__7 = (j + get * - 3) * 3 - 10) < 18 && 0 <= i__7 ? i__7 : - s_rnge("rot2", i__7, "zzrefch1_", (ftnlen)478) - ]; - } - } - -/* Adjust GET and PUT so that GET points to the slots */ -/* where we just stored the result of our multiply and */ -/* so that PUT points to the next available storage */ -/* locations. */ - - get = put; - put += inc; - inc = -inc; - this__ = relto; - cmnode = isrchi_(&this__, &node, frame); - gotone = cmnode > 0; - } - } - -/* See if we have a common node and determine whether or not */ -/* we are done with this loop. */ - - done = this__ == 1 || gotone || ! found; - } - -/* There are two possible scenarios. Either the chain of */ -/* rotations from FRAME2 ran into a node in the chain for */ -/* FRAME1 or it didn't. (The common node might very well be */ -/* the root node.) If we didn't run into a common one, then */ -/* the two chains don't intersect and there is no way to */ -/* get from FRAME1 to FRAME2. */ - - if (! gotone) { - zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? - i__1 : s_rnge("frame", i__1, "zzrefch1_", (ftnlen)525)], - frame2, &this__, errmsg, (ftnlen)1840); - if (failed_()) { - -/* We were unable to create the error message. This */ -/* unfortunate situation could arise if a frame kernel */ -/* is corrupted. */ - - chkout_("ZZREFCH1", (ftnlen)8); - return 0; - } - -/* The normal case: signal an error with a descriptive long */ -/* error message. */ - - setmsg_(errmsg, (ftnlen)1840); - sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); - chkout_("ZZREFCH1", (ftnlen)8); - return 0; - } - -/* Recall that we have the following. */ - -/* ROT(1...3, 1...3, 1 ) rotates FRAME(1) to FRAME(2) */ -/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ -/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ - -/* ROT(1...3, 1...3, CMNODE-1) rotates FRAME(CMNODE-1) */ -/* to FRAME(CMNODE) */ - -/* and that ROT2(1,1,GET) rotates from FRAME2 to CMNODE. */ -/* Hence the inverse of ROT2(1,1,GET) rotates from CMNODE */ -/* to FRAME2. */ - -/* If we compute the inverse of ROT2 and store it in */ -/* the next available slot of ROT (.i.e. ROT(1,1,CMNODE) */ -/* we can simply apply our custom routine that multiplies a */ -/* sequence of rotation matrices together to get the */ -/* result from FRAME1 to FRAME2. */ - - xpose_(&rot2[(i__1 = (get * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : - s_rnge("rot2", i__1, "zzrefch1_", (ftnlen)568)], &rot[(i__2 = ( - cmnode * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( - "rot", i__2, "zzrefch1_", (ftnlen)568)]); - zzrxr_(rot, &cmnode, rotate); - chkout_("ZZREFCH1", (ftnlen)8); - return 0; -} /* zzrefch1_ */ - diff --git a/ext/spice/src/cspice/zzrepsub.c b/ext/spice/src/cspice/zzrepsub.c deleted file mode 100644 index 2356d28e98..0000000000 --- a/ext/spice/src/cspice/zzrepsub.c +++ /dev/null @@ -1,298 +0,0 @@ -/* zzrepsub.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure ZZREPSUB ( Replace one substring with another ) */ -/* Subroutine */ int zzrepsub_(char *in, integer *left, integer *right, char * - string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer next, i__, inlen; - extern integer sumai_(integer *, integer *); - integer remain, myleft, strlen, outlen, myrght, end, use[3]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Replace the substring (LEFT:RIGHT) with a string of any length. */ - -/* $ 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 */ - -/* ASSIGNMENT */ -/* CHARACTER */ -/* STRING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IN I Input string. */ -/* LEFT, */ -/* RIGHT I Ends of substring to be replaced. */ -/* STRING I Replacement string. */ -/* OUT O Resulting string. */ - -/* $ Detailed_Input */ - -/* IN is an arbitrary character string. */ - -/* LEFT, */ -/* RIGHT are the ends of the substring to be replaced. */ -/* Legitimate substrings satisfy the following */ -/* conditions */ - -/* RIGHT > LEFT - 2 */ -/* LEFT > 1 */ -/* RIGHT < LEN(STRING) + 1 */ - -/* This allows users to refer to zero-length substrings */ -/* (null substrings) of IN. */ - -/* STRING is the replacement string. Essentially, the */ -/* substring (LEFT:RIGHT) is removed from the */ -/* input string, and STRING is inserted at the */ -/* point of removal. */ - -/* $ Detailed_Output */ - -/* OUT is the resulting string. OUT may overwrite IN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If RIGHT is one less than LEFT, the substring to */ -/* replace will be the null substring. In this case, */ -/* STRING will be inserted between IN(:RIGHT) and IN(LEFT:). */ - -/* 2) If LEFT is smaller than one, it's treated as 1. */ - -/* 3) If RIGHT is greater than the length of the input string, */ -/* it is treated as being the length of the string. */ - -/* 4) If RIGHT is less than LEFT-1, no substitution is made. */ - -/* 5) Whenever the output string is too small to hold the result, */ -/* the result is truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Ideally, replacement could be done with simple concatenation, */ - -/* OUT = IN(1:LEFT-1) // STRING // IN(RIGHT+1: ) */ - -/* but the Fortran 77 standard makes this illegal for strings of */ -/* unknown length. */ - -/* This private routine is basically just a copy of the SPICE */ -/* routine REPSUB with all error handling removed and "reasonable" */ -/* interpretations used for exceptional cases. */ - -/* $ Examples */ - -/* A typical use for this routine might be to replace all */ -/* occurrences of one word in a string with another word. */ -/* For example, the following code fragment replaces every */ -/* occurrence of the word 'AND' with the word 'OR' in the */ -/* character string LINE. */ - -/* LEFT = WDINDX ( LINE, 'AND' ) */ - -/* DO WHILE ( LEFT .NE. 0 ) */ -/* CALL REPSUB ( LINE, LEFT, LEFT+2, 'OR', LINE ) */ -/* LEFT = WDINDX ( LINE, 'AND' ) */ -/* END DO */ - -/* This routine can also be used to insert substring between */ -/* two characters. Consider the string: */ - -/* IN = 'The defendant,, was found innocent.' */ - -/* to insert ' Emelda Marcos' between the first and second commas */ -/* determine the location of the pair ',,' */ - -/* RIGHT = POS ( IN, ',,', 1 ) */ -/* LEFT = RIGHT + 1 */ - -/* then */ - -/* CALL REPSUB ( IN, LEFT, RIGHT, ' Emelda Marcos', OUT ) */ - -/* The output (OUT) will have the value: */ - -/* 'The defendant, Emelda Marcos, was found innocent.' */ - -/* $ Restrictions */ - -/* The memory used by STRING and OUT must be disjoint. The memory */ -/* used by IN and OUT must be identical or disjoint. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 27-APR-1996 (WLT) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Get the lengths of all the strings involved in this transaction. */ - - inlen = i_len(in, in_len); - strlen = i_len(string, string_len); - outlen = i_len(out, out_len); -/* Computing MIN */ - i__1 = inlen + 1, i__2 = max(1,*left); - myleft = min(i__1,i__2); -/* Computing MIN */ - i__1 = inlen, i__2 = max(0,*right); - myrght = min(i__1,i__2); - -/* Reject bad inputs. */ - - if (myleft < 1) { - myleft = 1; - } else if (myrght > inlen) { - myrght = inlen; - } else if (*right < *left - 1) { - return 0; - } - -/* Consider three separate sections: */ - -/* 1) The front of the original string. */ - -/* 2) The replacement string. */ - -/* 3) The end of the original string. */ - -/* Determine how much of each section to use in the output string. */ -/* REMAIN is the number of characters that will fit in the output */ -/* string. */ - - remain = outlen; -/* Computing MIN */ - i__1 = remain, i__2 = myleft - 1; - use[0] = min(i__1,i__2); - remain -= use[0]; - use[1] = min(remain,strlen); - remain -= use[1]; -/* Computing MIN */ - i__1 = remain, i__2 = inlen - *right; - use[2] = min(i__1,i__2); - -/* Move the third section first. It gets moved back to front */ -/* or front to back, depending on whether the replacement string */ -/* is longer than the original substring. The main thing is to */ -/* avoid overwriting characters that have yet to be moved. */ - - end = sumai_(use, &c__3); - if (myleft + strlen > *right) { - next = end; - for (i__ = use[2]; i__ >= 1; --i__) { - i__1 = *right + i__ - 1; - s_copy(out + (next - 1), in + i__1, (ftnlen)1, *right + i__ - - i__1); - --next; - } - } else { - next = myleft + strlen; - i__1 = use[2]; - for (i__ = 1; i__ <= i__1; ++i__) { - i__2 = *right + i__ - 1; - s_copy(out + (next - 1), in + i__2, (ftnlen)1, *right + i__ - - i__2); - ++next; - } - } - -/* The first two sections can be moved directly to the front of */ -/* the output string. */ - - next = 1; - i__1 = use[0]; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[next - 1] = *(unsigned char *)&in[i__ - 1]; - ++next; - } - i__1 = use[1]; - for (i__ = 1; i__ <= i__1; ++i__) { - *(unsigned char *)&out[next - 1] = *(unsigned char *)&string[i__ - 1]; - ++next; - } - -/* Pad with blanks, if the output string was not filled. */ - - if (end < outlen) { - i__1 = end; - s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1); - } - return 0; -} /* zzrepsub_ */ - diff --git a/ext/spice/src/cspice/zzrept.c b/ext/spice/src/cspice/zzrept.c deleted file mode 100644 index 1a102c8565..0000000000 --- a/ext/spice/src/cspice/zzrept.c +++ /dev/null @@ -1,137 +0,0 @@ -/* zzrept.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZREPT ( Private --- replace tokens ) */ -logical zzrept_(char *sub, char *replac, logical *l2r, ftnlen sub_len, ftnlen - replac_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - logical ok; - extern logical zzremt_(char *, ftnlen), zzsubt_(char *, char *, logical *, - ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Replace matching tokens and remove the 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 */ - -/* None. */ - -/* $ Keywords */ - -/* TIME --- PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SUB I is the substring to perform replacements on */ -/* REPLAC I is the replacement string */ -/* L2R I use left to right scanning if L2R is TRUE. */ - -/* The function returns TRUE if a replacement is performed */ - -/* $ Detailed_Input */ - -/* SUB is a substring of characters to located in the */ -/* current internal tokenized representation of a */ -/* time string that is maintained by ZZTIME. */ - -/* REPLAC is a string of characters that will replace 1 for 1 */ -/* the characters in SUB. Note that character * is */ -/* a special character in this substitution as it */ -/* will be removed (via ZZREMT) after substitution. */ - -/* L2R is a logical flag. If L2R is TRUE, the search */ -/* for a substring matching SUB will be performed */ -/* in left to right order. If L2R is FALSE the */ -/* search for substring matching SUB will be performed */ -/* from right to left. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if a replacement is performed. Otherwise */ -/* it returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine is simply a macro for the combination of the */ -/* ZZTIME entry points ZZSUBT and ZZREMT */ - -/* $ Examples */ - -/* See TPARTV. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 8-APR-1996 (WLT) */ - - -/* -& */ - ret_val = zzsubt_(sub, replac, l2r, sub_len, replac_len); - ok = zzremt_("*", (ftnlen)1); - return ret_val; -} /* zzrept_ */ - diff --git a/ext/spice/src/cspice/zzrotgt0.c b/ext/spice/src/cspice/zzrotgt0.c deleted file mode 100644 index a1ae42b186..0000000000 --- a/ext/spice/src/cspice/zzrotgt0.c +++ /dev/null @@ -1,347 +0,0 @@ -/* zzrotgt0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZROTGT0 (Frame get transformation) */ -/* Subroutine */ int zzrotgt0_(integer *infrm, doublereal *et, doublereal * - rotate, integer *outfrm, logical *found) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal tipm[9] /* was [3][3] */; - integer type__; - extern /* Subroutine */ int zzdynrt0_(integer *, integer *, doublereal *, - doublereal *, integer *); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - char versn[6]; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *); - extern logical failed_(void); - integer center; - extern /* Subroutine */ int tipbod_(char *, integer *, doublereal *, - doublereal *, ftnlen), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - tkfram_(integer *, doublereal *, integer *, logical *), ckfrot_( - integer *, doublereal *, doublereal *, integer *, logical *), - sigerr_(char *, ftnlen); - integer typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the rotation from a user specified frame to */ -/* another frame at a user specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRM I The integer code for a SPICE reference frame. */ -/* ET I An epoch in seconds past J2000. */ -/* ROTATE O A rotation matrix. */ -/* OUTFRM O The frame that ROTATE transforms INFRM to. */ -/* FOUND O TRUE if a rotation can be found. */ - -/* $ Detailed_Input */ - -/* INFRM is the SPICE id-code for some reference frame. */ - -/* ET is an epoch in ephemeris seconds past J2000 at */ -/* which the user wishes to retrieve a transformation */ -/* matrix. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3x3 matrix that transforms positions relative to */ -/* INFRM to positions relative to OUTFRM. (Assuming such */ -/* a rotation can be found.) */ - -/* OUTFRM is a reference frame. The 3x3 matrix ROTATE rotates */ -/* positions relative to INFRM to positions relative */ -/* to OUTFRM. */ -/* The positions transformation is achieved by */ -/* multiplying */ -/* ROTATE on the right by a position relative to INFRM. */ -/* This */ -/* is easily accomplished via the subroutine call */ -/* shown below. */ - -/* CALL MXV ( ROTATE, INPOS, OUTPOS ) */ - -/* FOUND is a logical flag indicating whether or not a */ -/* rotation matrix could be found from INFRM */ -/* to some other frame. If a rotation matrix */ -/* cannot be found OUTFRM will be set to zero, FOUND */ -/* will be set to FALSE and ROTATE will be returned */ -/* as the zero matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a rotation matrix cannot be located, then */ -/* FOUND will be set to FALSE, OUTFRM will be set to zero */ -/* and ROTATE will be set to the zero 3x3 matrix. */ - -/* 2) If the class of the requested frame is not recognized the */ -/* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a low level routine used for determining a chain of */ -/* position transformation matrices from one frame to another. */ - -/* $ Examples */ - -/* See FRMCHG. */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.1.0, 02-MAR-2010 (NJB) */ - -/* Bug fix: frame ID rather than frame class ID */ -/* is now passed to dynamic frame evaluation */ -/* routine ZZDYNROT. Order of header sections was */ -/* corrected. */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a rotation matrix from a specified frame */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - s_copy(versn, "1.0.0", (ftnlen)6, (ftnlen)5); - *found = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZROTGT0", (ftnlen)8); - -/* Get all the needed information about this frame. */ - - frinfo_(infrm, ¢er, &type__, &typeid, found); - if (! (*found)) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotate[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("rotate", i__1, "zzrotgt0_", (ftnlen)202)] = - 0.; - } - } - chkout_("ZZROTGT0", (ftnlen)8); - return 0; - } - if (type__ == 1) { - irfrot_(infrm, &c__1, rotate); - *found = TRUE_; - *outfrm = 1; - } else if (type__ == 2) { - tipbod_("J2000", &typeid, et, tipm, (ftnlen)5); - xpose_(tipm, rotate); - namfrm_("J2000", outfrm, (ftnlen)5); - *found = ! failed_(); - } else if (type__ == 3) { - ckfrot_(&typeid, et, rotate, outfrm, found); - } else if (type__ == 4) { - tkfram_(&typeid, rotate, outfrm, found); - } else if (type__ == 5) { - -/* Unlike the other frame classes, the dynamic frame evaluation */ -/* routine ZZDYNROT requires the input frame ID rather than the */ -/* dynamic frame class ID. ZZDYNROT also requires the center ID */ -/* we found via the FRINFO call. */ - - zzdynrt0_(infrm, ¢er, et, rotate, outfrm); - -/* The FOUND flag was set by FRINFO earlier; we don't touch */ -/* it here. If ZZDYNROT signaled an error, FOUND will be set */ -/* to .FALSE. at end of this routine. */ - - } else { - setmsg_("The reference frame # has class id-code #. This form of ref" - "erence frame is not supported in version # of ZZROTGT0. You " - "need to update your version of SPICELIB to the latest versio" - "n in order to support this frame. ", (ftnlen)213); - errint_("#", infrm, (ftnlen)1); - errint_("#", &type__, (ftnlen)1); - errch_("#", versn, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23); - chkout_("ZZROTGT0", (ftnlen)8); - return 0; - } - if (failed_() || ! (*found)) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotate[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("rotate", i__1, "zzrotgt0_", (ftnlen)271)] = - 0.; - } - } - *found = FALSE_; - } - chkout_("ZZROTGT0", (ftnlen)8); - return 0; -} /* zzrotgt0_ */ - diff --git a/ext/spice/src/cspice/zzrotgt1.c b/ext/spice/src/cspice/zzrotgt1.c deleted file mode 100644 index 785e99068c..0000000000 --- a/ext/spice/src/cspice/zzrotgt1.c +++ /dev/null @@ -1,340 +0,0 @@ -/* zzrotgt1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZROTGT1 (Frame get transformation) */ -/* Subroutine */ int zzrotgt1_(integer *infrm, doublereal *et, doublereal * - rotate, integer *outfrm, logical *found) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal tipm[9] /* was [3][3] */; - integer type__, i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - char versn[6]; - extern /* Subroutine */ int xpose_(doublereal *, doublereal *); - extern logical failed_(void); - integer center; - extern /* Subroutine */ int tipbod_(char *, integer *, doublereal *, - doublereal *, ftnlen), namfrm_(char *, integer *, ftnlen), - frinfo_(integer *, integer *, integer *, integer *, logical *), - tkfram_(integer *, doublereal *, integer *, logical *), ckfrot_( - integer *, doublereal *, doublereal *, integer *, logical *), - sigerr_(char *, ftnlen); - integer typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *, - integer *, doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the rotation from a user specified frame to */ -/* another frame at a user specified epoch. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INFRM I The integer code for a SPICE reference frame. */ -/* ET I An epoch in seconds past J2000. */ -/* ROTATE O A rotation matrix. */ -/* OUTFRM O The frame that ROTATE transforms INFRM to. */ -/* FOUND O TRUE if a rotation can be found. */ - -/* $ Detailed_Input */ - -/* INFRM is the SPICE id-code for some reference frame. */ - -/* ET is an epoch in ephemeris seconds past J2000 at */ -/* which the user wishes to retrieve a transformation */ -/* matrix. */ - -/* $ Detailed_Output */ - -/* ROTATE is a 3x3 matrix that transforms positions relative to */ -/* INFRM to positions relative to OUTFRM. (Assuming such */ -/* a rotation can be found.) */ - -/* OUTFRM is a reference frame. The 3x3 matrix ROTATE rotates */ -/* positions relative to INFRM to positions relative */ -/* to OUTFRM. */ -/* The positions transformation is achieved by */ -/* multiplying */ -/* ROTATE on the right by a position relative to INFRM. */ -/* This */ -/* is easily accomplished via the subroutine call */ -/* shown below. */ - -/* CALL MXV ( ROTATE, INPOS, OUTPOS ) */ - -/* FOUND is a logical flag indicating whether or not a */ -/* rotation matrix could be found from INFRM */ -/* to some other frame. If a rotation matrix */ -/* cannot be found OUTFRM will be set to zero, FOUND */ -/* will be set to FALSE and ROTATE will be returned */ -/* as the zero matrix. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a rotation matrix cannot be located, then */ -/* FOUND will be set to FALSE, OUTFRM will be set to zero */ -/* and ROTATE will be set to the zero 3x3 matrix. */ - -/* 2) If the class of the requested frame is not recognized the */ -/* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */ - -/* 3) If the reference frame REF is dynamic, the error */ -/* SPICE(RECURSIONTOODEEP) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a low level routine used for determining a chain of */ -/* position transformation matrices from one frame to another. */ - -/* $ Examples */ - -/* See FRMCHG. */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 02-MAR-2010 (NJB) */ - -/* Order of header sections was corrected. */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 2.0.0, 21-JUN-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a rotation matrix from a specified frame */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local Variables */ - - s_copy(versn, "1.0.0", (ftnlen)6, (ftnlen)5); - *found = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZROTGT1", (ftnlen)8); - -/* Get all the needed information about this frame. */ - - frinfo_(infrm, ¢er, &type__, &typeid, found); - if (! (*found)) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotate[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("rotate", i__1, "zzrotgt1_", (ftnlen)204)] = - 0.; - } - } - chkout_("ZZROTGT1", (ftnlen)8); - return 0; - } - if (type__ == 1) { - irfrot_(infrm, &c__1, rotate); - *found = TRUE_; - *outfrm = 1; - } else if (type__ == 2) { - tipbod_("J2000", &typeid, et, tipm, (ftnlen)5); - xpose_(tipm, rotate); - namfrm_("J2000", outfrm, (ftnlen)5); - *found = ! failed_(); - } else if (type__ == 3) { - ckfrot_(&typeid, et, rotate, outfrm, found); - } else if (type__ == 4) { - tkfram_(&typeid, rotate, outfrm, found); - } else if (type__ == 5) { - setmsg_("The reference frame # is a dynamic frame. Dynamic frames ma" - "y not be used at recursion level 1.", (ftnlen)94); - errint_("#", infrm, (ftnlen)1); - sigerr_("SPICE(RECURSIONTOODEEP)", (ftnlen)23); - chkout_("ZZROTGT1", (ftnlen)8); - return 0; - } else { - setmsg_("The reference frame # has class id-code #. This form of ref" - "erence frame is not supported in version # of ZZROTGT1. You " - "need to update your version of SPICELIB to the latest versio" - "n in order to support this frame. ", (ftnlen)213); - errint_("#", infrm, (ftnlen)1); - errint_("#", &type__, (ftnlen)1); - errch_("#", versn, (ftnlen)1, (ftnlen)6); - sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23); - chkout_("ZZROTGT1", (ftnlen)8); - return 0; - } - if (failed_() || ! (*found)) { - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - rotate[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("rotate", i__1, "zzrotgt1_", (ftnlen)268)] = - 0.; - } - } - *found = FALSE_; - } - chkout_("ZZROTGT1", (ftnlen)8); - return 0; -} /* zzrotgt1_ */ - diff --git a/ext/spice/src/cspice/zzrtnmat.c b/ext/spice/src/cspice/zzrtnmat.c deleted file mode 100644 index e461746bc3..0000000000 --- a/ext/spice/src/cspice/zzrtnmat.c +++ /dev/null @@ -1,274 +0,0 @@ -/* zzrtnmat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; - -/* $Procedure ZZRTNMAT ( RTN transformation matrix ) */ -/* Subroutine */ int zzrtnmat_(doublereal *v, doublereal *m) -{ - /* Initialized data */ - - static doublereal z__[3] = { 0.,0.,1. }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - double atan2(doublereal, doublereal), cos(doublereal), sin(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - doublereal east[3]; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - doublereal vlon[3]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal north[3]; - extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal - *), cleard_(integer *, doublereal *), sigerr_(char *, ftnlen), - chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - doublereal rad[3], lon; - -/* $ Abstract */ - -/* Given a vector, return a transformation matrix that maps from the */ -/* vector's base reference frame to the RTN */ -/* (radial-tangential-normal) frame associated with the vector. */ - -/* $ 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 */ - -/* ROTATION */ - -/* $ Keywords */ - -/* FRAMES */ -/* MATRIX */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* V I A 3-dimensional vector. */ -/* M O Base frame to RTN frame rotation matrix. */ - -/* $ Detailed_Input */ - -/* V is any vector that does not lie on the Z-axis */ -/* of the reference frame relative to which the */ -/* vector is expressed: at least one of V's X or */ -/* Y components must be non-zero. */ - -/* $ Detailed_Output */ - -/* M is a rotation matrix that transforms vectors */ -/* from the base frame of V---that is, the reference */ -/* frame relative to which V is expressed---to */ -/* the RTN (radial, tangential, normal) frame */ -/* defined by V. */ - -/* The basis vectors of the RTN frame are defined */ -/* as follows: */ - -/* Axis 1: radial direction R. This axis is */ -/* parallel to V. */ - -/* Axis 2: tangential direction T. This axis */ -/* is parallel to Z x V, where Z is */ -/* the third axis of V's base frame. */ - -/* Axis 3: normal direction N. This axis is */ -/* parallel to R x T. */ - -/* The unit vectors R, T, N are, respectively, the */ -/* first, second and third rows of M. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input vector V has X and Y components equal to zero, */ -/* the error SPICE(DEGENERATECASE) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The RTN frame supported this routine is a generalization of */ -/* the frame defined by a solar system object's spin axis and */ -/* and a position vector (often the position of a spacecraft */ -/* relative to the center of the object). */ - -/* If the base frame of the input vector V is the body-fixed, */ -/* body-centered planetocentric frame associated with a solar system */ -/* object such as a planet or satellite, then the R, T, N directions */ -/* correspond to the "up", "East," and "North" directions at the */ -/* location indicated by V. */ - -/* $ Examples */ - -/* 1) Get the RTN transformation matrix for the vector ( 1, 0, 1 ): */ - - -/* IMPLICIT NONE */ - -/* DOUBLE PRECISION V ( 3 ) */ -/* DOUBLE PRECISION M ( 3, 3 ) */ -/* INTEGER I */ -/* INTEGER J */ - -/* CALL VPACK ( 1.D0, 0.D0, 1.D0, V ) */ - -/* CALL ZZRTNMAT ( V, M ) */ - -/* DO I = 1, 3 */ -/* WRITE(*,'(3E15.7)') ( M(I,J), J = 1, 3 ) */ -/* END DO */ - -/* END */ - -/* When this program was executed on a PC/Linux/g77 system, the */ -/* output was */ - -/* 0.7071068E+00 0.0000000E+00 0.7071068E+00 */ -/* 0.0000000E+00 0.1000000E+01 0.0000000E+00 */ -/* -0.7071068E+00 0.0000000E+00 0.7071068E+00 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* transformation to radial, tangential, normal frame */ -/* transformation to rtn frame */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - -/* Internally, we're going to use the more */ -/* descriptive names EAST for the "tangential" */ -/* direction and NORTH for the "normal" direction. */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Use discovery check-in. Just test the RETURN status. */ - - if (return_()) { - return 0; - } - if (v[0] == 0. && v[1] == 0.) { - cleard_(&c__9, m); - chkin_("ZZRTNMAT", (ftnlen)8); - setmsg_("Input vector (# # #) lies on Z-axis; tangential and normal " - "directions are undefined.", (ftnlen)84); - errdp_("#", v, (ftnlen)1); - errdp_("#", &v[1], (ftnlen)1); - errdp_("#", &v[2], (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZRTNMAT", (ftnlen)8); - return 0; - } else { - -/* The two-argument arctangent function gives us a */ -/* robust way of determining the longitude of V, even */ -/* when the magnitude of V is very small. */ - - lon = atan2(v[1], v[0]); - -/* Let VLON be a unit vector in the x-y plane whose */ -/* longitude is LON. */ - - vlon[0] = cos(lon); - vlon[1] = sin(lon); - vlon[2] = 0.; - -/* We can compute the East and North vectors */ -/* without much loss of precision, since VLON is */ -/* orthogonal to Z and EAST is orthogonal to V. */ - - ucrss_(z__, vlon, east); - ucrss_(v, east, north); - vhat_(v, rad); - -/* The rows of M are the basis vectors of */ -/* the radial/East/North frame: */ - - for (i__ = 1; i__ <= 3; ++i__) { - m[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("m", i__1, - "zzrtnmat_", (ftnlen)258)] = rad[(i__2 = i__ - 1) < 3 && - 0 <= i__2 ? i__2 : s_rnge("rad", i__2, "zzrtnmat_", ( - ftnlen)258)]; - m[(i__1 = i__ * 3 - 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("m", i__1, - "zzrtnmat_", (ftnlen)259)] = east[(i__2 = i__ - 1) < 3 && - 0 <= i__2 ? i__2 : s_rnge("east", i__2, "zzrtnmat_", ( - ftnlen)259)]; - m[(i__1 = i__ * 3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("m", i__1, - "zzrtnmat_", (ftnlen)260)] = north[(i__2 = i__ - 1) < 3 - && 0 <= i__2 ? i__2 : s_rnge("north", i__2, "zzrtnmat_", ( - ftnlen)260)]; - } - } - return 0; -} /* zzrtnmat_ */ - diff --git a/ext/spice/src/cspice/zzrvar.c b/ext/spice/src/cspice/zzrvar.c deleted file mode 100644 index 9bb16d69a6..0000000000 --- a/ext/spice/src/cspice/zzrvar.c +++ /dev/null @@ -1,1158 +0,0 @@ -/* zzrvar.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__132 = 132; - -/* $Procedure ZZRVAR ( Private --- Pool, read the next kernel variable ) */ -/* Subroutine */ int zzrvar_(integer *namlst, integer *nmpool, char *names, - integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, - char *chvals, char *varnam, logical *eof, ftnlen names_len, ftnlen - chvals_len, ftnlen varnam_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer), - s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer head, code, itab; - static char name__[132], file[255]; - static integer free, begs[132], node; - static char line[132]; - static integer tail, ends[132]; - static logical even, full; - static integer type__[132], b, e, i__, j, badat; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), lnkan_(integer *, integer *); - static logical found; - static integer ncomp, lstnb, count; - static char error[255]; - static integer iplus; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int zzcln_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - static integer r1, r2; - extern logical failed_(void); - static integer at, datahd, iblank, chnode, icomma, nameat, dpnode; - extern /* Subroutine */ int rdkdat_(char *, logical *, ftnlen), lnkila_( - integer *, integer *, integer *); - static integer iequal; - extern integer lastnb_(char *, ftnlen), lastpc_(char *, ftnlen), lnknfn_( - integer *); - static integer ilparn, irparn, itmark; - static doublereal dvalue; - static integer dirctv, lookat, iquote; - extern integer zzhash_(char *, ftnlen); - static integer number, varlen; - static logical intokn, insepf; - extern logical return_(void); - static logical inquot; - static integer status, vartyp; - extern /* Subroutine */ int chkout_(char *, ftnlen); - static integer nxttok; - extern /* Subroutine */ int rdklin_(char *, integer *, ftnlen), setmsg_( - char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char - *, ftnlen), lnkfsl_(integer *, integer *, integer *), tparse_( - char *, doublereal *, char *, ftnlen, ftnlen), nparsd_(char *, - doublereal *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read the next variable from a SPICE ASCII kernel file into */ -/* the kernel pool. */ - -/* $ 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 */ - -/* PRIVATE KERNEL */ - -/* $ Keywords */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NAMLST I/O array of collision resolution list heads. */ -/* NMPOOL I/O linked list pool of collision resolution lists. */ -/* NAMES I/O array of names of kernel pool variables. */ -/* DATLST I/O array of heads of lists of variable values. */ -/* DPPOOL I/O linked list pool of pointer lists to d.p. values. */ -/* DPVALS I/O array of d.p. kernel pool values. */ -/* CHPOOL I/O linked list pool of pointer lists to string values. */ -/* CHVALS I/O array of string kernel pool values. */ -/* VARNAM O name of variable parsed. */ -/* EOF O if TRUE end of input file has been reached. */ - -/* $ Detailed_Input */ - - -/* NAMLST this collection of arrays together with the hash */ -/* NMPOOL function ZZHASH provide the mechanism for storing */ -/* NAMES and retrieving kernel pool variables. */ -/* DATLST */ -/* DPPOOL Given a potential variable name NAME the function */ -/* DPVALS ZZHASH(NAME) gives the location in the array in */ -/* CHPOOL NAMLST where one should begin looking for the */ -/* CHVALS kernel pool variable NAME. */ - -/* If NAMLST( ZZHASH(NAME) ) is zero, there is no kernel */ -/* pool variable corresponding to NAME. If it is non-zero */ -/* then NAMLST is the head node of a linked list of names */ -/* that evaluate to the same integer under the function */ -/* ZZHASH. Letting NODE = NAMLST( ZZHASH(NAME) ) check */ -/* NAMES(NODE) for equality with NAME. If there is */ -/* no match find the next node ( NMPOOL(NEXT,NODE) ) until */ -/* a match occurs or all nodes of the list have been */ -/* examined. To insert a new NAME allocate a node NEW from */ -/* the free list of NMPOOL and append it to the tail of the */ -/* list pointed to by NAMLST ( ZZHASH(NAME) ). */ - -/* Once a node for NAME is located (call it NAMEAT) */ -/* the values for NAME can be found by examining */ -/* DATLST(NAMEAT). If zero, no values have yet been */ -/* given to NAME. If less than zero, -DATLST(NAMEAT) */ -/* is the head node of a list in CHPOOL that gives the */ -/* indexes of the values of NAME in CHVALS. If greater */ -/* than zero, DATLST(NAMEAT) is the head node of a list */ -/* in DPPOOL that gives the indexes of the values of NAME */ -/* in DPVALS. */ - -/* $ Detailed_Output */ - - -/* NAMLST is the same structure as input but updated to */ -/* NMPOOL include the next variable read from the current */ -/* NAMES active text kernel in RDKER. */ -/* DATLST */ -/* DPPOOL */ -/* DPVALS */ -/* CHPOOL */ -/* CHVALS */ - -/* VARNAM is the name of the variable. VARNAM is blank if */ -/* no variable is read. */ - -/* EOF is true when the end of the kernel file has been */ -/* reached, and is false otherwise. The kernel file */ -/* is closed automatically when the end of the file */ -/* is reached. */ - -/* $ Parameters */ - -/* LINLEN is the maximum length of a line in the kernel file. */ - -/* MAXLEN is the maximum length of the variable names that */ -/* can be stored in the kernel pool (also set in */ -/* pool.f). */ - -/* $ Exceptions */ - - -/* 1) The error 'SPICE(BADTIMESPEC)' is signaled if a value */ -/* beginning with '@' cannot be parsed as a time. */ - -/* 2) The error 'SPICE(BADVARASSIGN)' is signaled if variable */ -/* assignment does not have the form NAME = [(] value [ value ) ]. */ - -/* 3) The error 'SPICE(KERNELPOOLFULL)' is signaled if there is */ -/* no room left in the kernel pool to store another variable */ -/* or value. */ - -/* 4) The error 'SPICE(NONPRINTINGCHAR)' is signaled if the name */ -/* in a variable assignment contains a non-printing character. */ - -/* 5) The error 'SPICE(NUMBEREXPECTED)' is signaled if a value */ -/* that is unquoted cannot be parsed as time or number. */ - -/* 6) The error 'SPICE(TYPEMISMATCH)' is signalled if a variable */ -/* has a first value of one type (numeric or character) and */ -/* a subsequent component has the other type. */ - -/* 7) The error 'SPICE(BADVARNAME)' signals if a kernel pool */ -/* variable name length exceeds MAXLEN. */ - -/* $ Files */ - -/* ZZRVAR reads from the file most recently opened by RDKNEW. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See POOL (entry point LDPOOL). */ - -/* $ Restrictions */ - -/* The input file must be opened and initialized by RDKNEW prior */ -/* to the first call to ZZRVAR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.7.0, 08-FEB-2010 (EDW) */ - -/* Added an error check on the length of the kernel pool variable */ -/* name read from the kernel file. */ - -/* - SPICELIB Version 1.6.0, 06-AUG-2002 (BVS) */ - -/* Modified to make sure that DO WHILE loop that looks for the */ -/* end of string variable value always exits. */ - -/* - SPICELIB Version 1.5.0, 07-APR-2000 (WLT) */ - -/* Happy Birthday Alex. Added check to the assignment to CHVALS */ -/* so that we cannot store data past the end of the string. */ - -/* - SPICELIB Version 1.4.0, 22-MAR-1999 (WLT) */ - -/* Added code to detect and signal an error for empty */ -/* vector assignment. */ - -/* - SPICELIB Version 1.3.0, 16-JAN-1997 (WLT) */ - -/* The error message regarding the directives allowed */ -/* in a keyword = value directive was updated. */ - -/* - SPICELIB Version 1.1.0, 25-JUN-1996 (WLT) */ - -/* The error message for unparsed numeric components */ -/* was corrected so that it now shows the line and */ -/* line number on which the error occurred. */ - -/* - SPICELIB Version 1.0.0, 20-SEP-1995 (WLT) */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters. */ - -/* Below are a collection of enumerated lists that are used */ -/* to discern what part of the processing we are in and what */ -/* kind of entity we are dealing with. First the overall */ -/* processing flow of a variable assignment. */ - - -/* Next we have the various types of tokens that can be found */ -/* in the parsing of an input line */ - -/* Q --- quoted (or protected tokens) */ -/* NQ --- unquoted tokens */ -/* BV --- beginning of a vector */ -/* EV --- ending of a vector */ -/* EQ --- equal sign */ -/* EQP --- equal sign plus */ - - -/* A variable can have one of three types as we process */ -/* it. It can have an unknown type UNKNWN, STRTYP or NUMTYP. */ - - - -/* The next two parameters indicate which component of a linked */ -/* list node point to the previous node and the next node. */ - - -/* The next collection of variables are set up in first pass */ -/* through this routine. They would be parameters if FORTRAN */ -/* allowed us to do this in a standard way. */ - - -/* The logicals below are used to take apart the tokens in an */ -/* input line. */ - - -/* The following logicals are in-line functions that are used */ -/* when processing the input strings. */ - - -/* Save everything. */ - - -/* Below are a collection of In-line function definitions that are */ -/* intended to make the code a bit easier to write and read. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZRVAR", (ftnlen)6); - } - -/* Initializations. */ - - if (first) { - first = FALSE_; - icomma = ','; - iblank = ' '; - iquote = '\''; - ilparn = '('; - irparn = ')'; - iequal = '='; - iplus = '+'; - itmark = '@'; - itab = 9; - } - -/* No variable yet and no parsing errors so far. */ - - s_copy(name__, " ", (ftnlen)132, (ftnlen)1); - s_copy(error, " ", (ftnlen)255, (ftnlen)1); - ncomp = 0; - -/* Get the next data line. Unless something is terribly wrong, */ -/* this will begin a new variable definition. We have to read */ -/* the whole variable, unless we get an error, in which case */ -/* we can quit. */ - - status = 1; - while(status != 2 && ! failed_()) { - rdkdat_(line, eof, (ftnlen)132); - if (*eof) { - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Find the "tokens" in the input line. As you scan from left */ -/* to right along the line, exactly one of the following */ -/* conditions is true. */ - -/* 1) You are in a separator field */ -/* 4) You are in a quoted substring */ -/* 5) You are in a non-quoted substring that isn't a separator */ -/* field. */ - -/* Stuff between separator fields are regarded as tokens. Note */ -/* this includes quoted strings. */ - -/* In addition we keep track of 3 separators: '=', '(', ')' */ -/* Finally, whenever we encounters the separator '=', we back */ -/* up and see if it is preceded by a '+', if so we attach */ -/* it to the '=' and treat the pair of characters as a single */ -/* separator. */ - - even = TRUE_; - intokn = FALSE_; - inquot = FALSE_; - insepf = TRUE_; - count = 0; - i__ = 0; - while(i__ < i_len(line, (ftnlen)132)) { - -/* The current character is either a separator, quote or */ -/* some other character. */ - - ++i__; - code = *(unsigned char *)&line[i__ - 1]; - if (code == iblank || code == icomma || code == ilparn || code == - irparn || code == iequal || code == itab) { - -/* There are 3 possible states we could be in */ -/* Separation Field */ -/* A quoted substring with the last quote an odd one. */ -/* A quoted substring with the last quote an even one. */ -/* A non-quoted token. */ -/* In the first two cases nothing changes, but in the */ -/* next two cases we transition to a separation field. */ - - if (intokn || inquot && even) { - inquot = FALSE_; - intokn = FALSE_; - insepf = TRUE_; - } - if (insepf) { - -/* We need to see if this is one of the special */ -/* separators */ - - if (code == iequal) { - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvar_", (ftnlen)555)] - = i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)556)] - = 5; - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("ends", i__1, "zzrvar_", (ftnlen)557)] - = i__; - if (i__ > 1) { - -/* Look back at the previous character. */ -/* See if it is a plus character. */ - - i__1 = i__ - 2; - code = *(unsigned char *)&line[i__1]; - if (code == iplus) { - -/* This is the directive '+=' we need */ -/* to set the beginning of this token */ -/* to the one before this and adjust */ -/* the end of the last token. */ - - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? - i__1 : s_rnge("type", i__1, "zzrvar_" - , (ftnlen)573)] = 6; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? - i__1 : s_rnge("begs", i__1, "zzrvar_", - (ftnlen)574)] = i__ - 1; - if (begs[(i__1 = count - 2) < 132 && 0 <= - i__1 ? i__1 : s_rnge("begs", i__1, - "zzrvar_", (ftnlen)576)] == ends[( - i__2 = count - 2) < 132 && 0 <= i__2 ? - i__2 : s_rnge("ends", i__2, "zzrvar_" - , (ftnlen)576)]) { - --count; - begs[(i__1 = count - 1) < 132 && 0 <= - i__1 ? i__1 : s_rnge("begs", i__1, - "zzrvar_", (ftnlen)580)] = i__ - - 1; - ends[(i__1 = count - 1) < 132 && 0 <= - i__1 ? i__1 : s_rnge("ends", i__1, - "zzrvar_", (ftnlen)581)] = i__; - type__[(i__1 = count - 1) < 132 && 0 <= - i__1 ? i__1 : s_rnge("type", i__1, - "zzrvar_", (ftnlen)582)] = 6; - } else { - ends[(i__1 = count - 2) < 132 && 0 <= - i__1 ? i__1 : s_rnge("ends", i__1, - "zzrvar_", (ftnlen)586)] = ends[( - i__2 = count - 2) < 132 && 0 <= - i__2 ? i__2 : s_rnge("ends", i__2, - "zzrvar_", (ftnlen)586)] - 1; - } - } - } - } else if (code == irparn) { - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvar_", (ftnlen)597)] - = i__; - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("ends", i__1, "zzrvar_", (ftnlen)598)] - = i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)599)] - = 4; - } else if (code == ilparn) { - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvar_", (ftnlen)604)] - = i__; - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("ends", i__1, "zzrvar_", (ftnlen)605)] - = i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)606)] - = 3; - } - } - } else if (code == iquote) { - -/* There are 3 cases of interest. */ -/* We are in a quoted substring already */ -/* We are in a separator field */ -/* We are in a non-quoted token. */ -/* In the first case nothing changes. In the second */ -/* two cases we change to being in a quoted substring. */ - - even = ! even; - if (! inquot) { - insepf = FALSE_; - intokn = FALSE_; - inquot = TRUE_; - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvar_", (ftnlen)629)] = - i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)630)] = 1; - } - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zzrvar_", (ftnlen)634)] = i__; - } else { - -/* This is some character other than a quote, or */ -/* separator character. */ - -/* We are in one of four situations. */ - -/* 1) We are in a quoted substring with an odd number of */ -/* quotes. */ -/* 2) We are in a quoted substring with an even number of */ -/* quotes. */ -/* 2) We are in a separator field */ -/* 3) We are in a non-quoted token. */ - -/* In cases 1 and 3 nothing changes. So we won't check */ -/* those cases. */ - - if (insepf || inquot && even) { - inquot = FALSE_; - insepf = FALSE_; - intokn = TRUE_; - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvar_", (ftnlen)659)] = - i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)660)] = 2; - } - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zzrvar_", (ftnlen)663)] = i__; - } - } - -/* The first word on the first line should be the name of a */ -/* variable. The second word should be a directive: = or +=. */ - - if (status == 1) { - -/* There must be at least 3 contributing tokens on this line. */ - - if (count < 3) { - rdklin_(file, &number, (ftnlen)255); - setmsg_("A kernel variable was not properly formed on line #" - " of the file #. Such an assignment should have the f" - "orm: ' [+]= '. This line was " - "'#'. ", (ftnlen)160); - r1 = rtrim_(file, (ftnlen)255); - r2 = rtrim_(line, (ftnlen)132); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - errch_("#", line, (ftnlen)1, r2); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* See if the variable name is legitimate: */ - - i__1 = begs[0] - 1; - badat = lastpc_(line + i__1, ends[0] - i__1); - if (badat <= ends[0] - begs[0]) { - -/* There is a non-printing character in the variable */ -/* name. This isn't allowed. */ - - at = begs[0] + badat; - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("There is a non-printing character embedded in line " - "# of the text kernel file #. Non-printing character" - "s are not allowed in kernel variable assignments. T" - "he non-printing character has ASCII code #. ", ( - ftnlen)199); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - i__1 = *(unsigned char *)&line[at - 1]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(NONPRINTINGCHAR)", (ftnlen)22); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Check the variable name length; signal an error */ -/* if longer than MAXLEN. */ - - i__1 = begs[0] - 1; - varlen = i_len(line + i__1, ends[0] - i__1); - if (varlen > 32) { - setmsg_("A kernel pool variable name read from a kernel file" - " exceeds the maximum allowed length #1. The actual l" - "ength of the variable name is #2, the offending vari" - "able name to #3 characters: '#4'.", (ftnlen)188); - errint_("#1", &c__32, (ftnlen)2); - errint_("#2", &varlen, (ftnlen)2); - errint_("#3", &c__132, (ftnlen)2); - i__1 = begs[0] - 1; - errch_("#4", line + i__1, (ftnlen)2, ends[0] - i__1); - sigerr_("SPICE(BADVARNAME)", (ftnlen)17); - } - -/* The variable name is ok. How about the directive. */ - - i__1 = begs[0] - 1; - s_copy(varnam, line + i__1, varnam_len, ends[0] - i__1); - dirctv = type__[1]; - -/* If this is replacement (=) and not an addition (+=), */ -/* delete the values currently associated with the variable. */ -/* They will be replaced later. */ - - if (dirctv != 5 && dirctv != 6) { - rdklin_(file, &number, (ftnlen)255); - setmsg_("A kernel variable was not properly formed on line #" - " of the file #. Such an assignment should have the f" - "orm: ' [+]= '. More specific" - "ally, the assignment operator did not have one of th" - "e expected forms: '=' or '+='. The line was '#'. ", ( - ftnlen)256); - r1 = rtrim_(file, (ftnlen)255); - r2 = rtrim_(line, (ftnlen)132); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - errch_("#", line, (ftnlen)1, r2); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Locate this variable name in the name pool or insert it */ -/* if it isn't there. The location will be NAMEAT and */ -/* we will use the variable FOUND to indicate whether or */ -/* not it was already present. */ - - lookat = zzhash_(varnam, varnam_len); - node = namlst[lookat - 1]; - full = lnknfn_(nmpool) <= 0; - found = FALSE_; - -/* See if this name (or one colliding with it in the */ -/* hash scheme) has already been stored in the name list. */ - - if (node > 0) { - head = node; - tail = -nmpool[(head << 1) + 11]; - while(node > 0 && ! found) { - found = s_cmp(names + (node - 1) * names_len, varnam, - names_len, varnam_len) == 0; - nameat = node; - node = nmpool[(node << 1) + 10]; - } - if (! found && ! full) { - -/* We didn't find this name on the conflict resolution */ -/* list. Allocate a new slot for it. */ - - lnkan_(nmpool, &node); - lnkila_(&tail, &node, nmpool); - s_copy(names + (node - 1) * names_len, varnam, names_len, - varnam_len); - nameat = node; - } - } else if (! full) { - -/* Nothing like this variable name (in the hashing sense) */ -/* has been loaded so far. We need to allocate */ -/* a name slot for this variable. */ - - lnkan_(nmpool, &node); - namlst[lookat - 1] = node; - s_copy(names + (node - 1) * names_len, varnam, names_len, - varnam_len); - nameat = node; - } - -/* If the name pool was full and we didn't find this name */ -/* we've got an error. Diagnose it and return. */ - - if (full && ! found) { - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("The kernel pool does not have room for any more var" - "iables. It filled up at line # of the kernel file #" - ". ", (ftnlen)105); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Now depending upon the kind of directive, we will need */ -/* to remove data and allocate a new list or simply append */ -/* data to the existing list. */ - - if (dirctv == 5) { - -/* We are going to dump whatever is associated with */ -/* this name and then we will need to allocate a new */ -/* linked list for the data. */ - - vartyp = 3; - if (found) { - -/* We need to free the data associated with this */ -/* variable. */ - - datahd = datlst[nameat - 1]; - datlst[nameat - 1] = 0; - if (datahd < 0) { - -/* This variable was character type we need to */ -/* free a linked list from the character data */ -/* pool. */ - - head = -datahd; - tail = -chpool[(head << 1) + 11]; - lnkfsl_(&head, &tail, chpool); - } else { - -/* This variable was numeric type. We need to */ -/* free a linked list from the numeric pool. */ - - head = datahd; - tail = -dppool[(head << 1) + 11]; - lnkfsl_(&head, &tail, dppool); - } - } - } else if (dirctv == 6) { - -/* We need to append to the current variable. */ - - if (found) { - if (datlst[nameat - 1] > 0) { - vartyp = 2; - } else if (datlst[nameat - 1] < 0) { - vartyp = 1; - } else { - vartyp = 3; - } - } else { - vartyp = 3; - } - } - -/* If this is a vector, the next thing on the line will be a */ -/* left parenthesis. Otherwise, assume that this is a scalar. */ -/* If it's a vector, get the first value. If it's a scalar, */ -/* plant a bogus right parenthesis, to make the following loop */ -/* terminate after one iteration. */ - - if (type__[2] == 3) { - nxttok = 4; - } else { - nxttok = 3; - ++count; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "type", i__1, "zzrvar_", (ftnlen)950)] = 4; - } - -/* For subsequent lines, treat everything as a new value. */ - - } else { - nxttok = 1; - } - -/* We have a value anyway. Store it in the table. */ - -/* Keep going until the other shoe (the right parenthesis) */ -/* drops, or until the end of the line is reached. */ - -/* Dates begin with @; anything else is presumed to be a number. */ - - while(type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "type", i__1, "zzrvar_", (ftnlen)971)] != 4 && nxttok <= - count) { - -/* Get the begin and end of this token. */ - - b = begs[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "begs", i__1, "zzrvar_", (ftnlen)975)]; - e = ends[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zzrvar_", (ftnlen)976)]; - if (vartyp == 3) { - -/* We need to determine which category of variable we */ -/* have by looking at this token and deducing the */ -/* type. */ - - if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)984)] == 1) { - vartyp = 1; - } else if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? - i__1 : s_rnge("type", i__1, "zzrvar_", (ftnlen)988)] - == 2) { - vartyp = 2; - } else { - -/* This is an error. We should have had one of the */ -/* two previous types. */ - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("The first item following the assignment operato" - "r should be the value of a variable or a left pa" - "renthesis '(' followed by a value for a variable" - ". This is not true on line # of the text kernel " - "file '#'. ", (ftnlen)201); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - } - if (vartyp == 1) { - -/* First make sure that this token represents a string. */ - - if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)1029)] != 1) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(varnam, varnam_len); - r2 = rtrim_(file, (ftnlen)255); - setmsg_("The kernel variable # has been set up as a stri" - "ng variable. However, the value that you are at" - "tempting to assign to this variable on line # of" - " the kernel file '#' is not a string value. ", ( - ftnlen)187); - errch_("#", varnam, (ftnlen)1, r1); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r2); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Still going? Make sure there is something between */ -/* the quotes. */ - - if (b + 1 >= e) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("There is a quoted string with no characters on " - "line # of the text kernel file '#'. ", (ftnlen)83) - ; - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* We are ready to go. Allocate a node for this data */ -/* item. First make sure there is room to do so. */ - - free = lnknfn_(chpool); - if (free <= 0) { - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("There is no room available for adding another c" - "haracter value to the kernel pool. The characte" - "r values buffer became full at line # of the tex" - "t kernel file '#'. ", (ftnlen)162); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this string value: */ - - lnkan_(chpool, &chnode); - if (datlst[nameat - 1] == 0) { - -/* There was no data for this name yet. We make */ -/* CHNODE be the head of the data list for this name. */ - - datlst[nameat - 1] = -chnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = -datlst[nameat - 1]; - tail = -chpool[(head << 1) + 11]; - lnkila_(&tail, &chnode, chpool); - } - -/* Finally insert this data item in the data buffer */ -/* at CHNODE. Note any quotes will be doubled so we */ -/* have to undo this affect when we store the data. */ - - s_copy(chvals + (chnode - 1) * chvals_len, " ", chvals_len, ( - ftnlen)1); - ++ncomp; - -/* Adjust end-of-token position (E) if it happens to the */ -/* last, non-quote character of the truncated input line. */ -/* This has to be done to make sure that all meaningful */ -/* characters get moved to the value. */ - - code = *(unsigned char *)&line[e - 1]; - if (! (code == iquote)) { - ++e; - } - i__ = 1; - j = b + 1; - while(j < e) { - code = *(unsigned char *)&line[j - 1]; - if (code == iquote) { - ++j; - } - if (i__ <= i_len(chvals + (chnode - 1) * chvals_len, - chvals_len)) { - *(unsigned char *)&chvals[(chnode - 1) * chvals_len + - (i__ - 1)] = *(unsigned char *)&line[j - 1]; - ++i__; - ++j; - } else { - ++j; - } - } - -/* That's all for this value. It's now time to loop */ -/* back through and get the next value. */ - - } else { - if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvar_", (ftnlen)1175)] != 2) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(varnam, varnam_len); - r2 = rtrim_(file, (ftnlen)255); - setmsg_("The kernel variable # has been set up as a nume" - "ric or time variable. However, the value that y" - "ou are attempting to assign to this variable on " - "line # of the kernel file '#' is not a numeric o" - "r time value. ", (ftnlen)205); - errch_("#", varnam, (ftnlen)1, r1); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r2); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Look at the first character to see if we have a time */ -/* or a number. */ - - code = *(unsigned char *)&line[b - 1]; - if (code == itmark) { - -/* We need to have more than a single character. */ - - if (e == b) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, - chpool, dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(varnam, varnam_len); - r2 = rtrim_(file, (ftnlen)255); - setmsg_("At character # of line # in the text kerne" - "l file '#' the character '@' appears. This " - "character is reserved for identifying time v" - "alues in assignments to kernel pool variable" - "s. However it is not being used in this fas" - "hion for the variable '#'. ", (ftnlen)246); - errint_("#", &b, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r2); - errch_("#", varnam, (ftnlen)1, r1); - sigerr_("SPICE(BADTIMESPEC)", (ftnlen)18); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - i__1 = b; - tparse_(line + i__1, &dvalue, error, e - i__1, (ftnlen) - 255); - if (s_cmp(error, " ", (ftnlen)255, (ftnlen)1) != 0) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, - chpool, dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - lstnb = lastnb_(error, (ftnlen)255); - setmsg_("Encountered '#' while attempting to parse a" - " time on line # of the text kernel file '#'." - " Error message: '#'", (ftnlen)107); - i__1 = b; - errch_("#", line + i__1, (ftnlen)1, e - i__1); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, (ftnlen)255); - errch_("#", error, (ftnlen)1, lstnb); - sigerr_("SPICE(BADTIMESPEC)", (ftnlen)18); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - } else { - nparsd_(line + (b - 1), &dvalue, error, &i__, e - (b - 1), - (ftnlen)255); - if (s_cmp(error, " ", (ftnlen)255, (ftnlen)1) != 0) { - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, - chpool, dppool); - rdklin_(file, &number, (ftnlen)255); - lstnb = lastnb_(error, (ftnlen)255); - setmsg_("Encountered '#' while attempting to parse a" - " number on line # of the text kernel file '#" - "'. Error message: '#'", (ftnlen)109); - errch_("#", line + (b - 1), (ftnlen)1, e - (b - 1)); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, (ftnlen)255); - errch_("#", error, (ftnlen)1, lstnb); - sigerr_("SPICE(NUMBEREXPECTED)", (ftnlen)21); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - } - -/* OK. We have a parsed value. See if there is room in */ -/* the numeric portion of the pool to store this value. */ - - free = lnknfn_(dppool); - if (free <= 0) { - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("There is no room available for adding another n" - "umeric value to the kernel pool. The numeric va" - "lues buffer became full at line # of the text ke" - "rnel file '#'. ", (ftnlen)158); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this numeric value: */ - - lnkan_(dppool, &dpnode); - if (datlst[nameat - 1] == 0) { - -/* There was no data for this name yet. We make */ -/* DPNODE be the head of the data list for this name. */ - - datlst[nameat - 1] = dpnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = datlst[nameat - 1]; - tail = -dppool[(head << 1) + 11]; - lnkila_(&tail, &dpnode, dppool); - } - -/* Finally insert this data item into the numeric buffer. */ - - dpvals[dpnode - 1] = dvalue; - ++ncomp; - } - -/* Now process the next token in the list of tokens. */ - - ++nxttok; - } - -/* We could have ended the above loop in one of two ways. */ - -/* 1) NXTTOK now exceeds count. This means we did not reach */ -/* an end of vector marker. */ -/* 2) We hit an end of vector marker. */ - - if (nxttok > count) { - status = 3; - } else { - status = 2; - } - } - -/* It is possible that we reached this point without actually */ -/* assigning a value to the kernel pool variable. This can */ -/* happen if there is a vector input of the form NAME = ( ) */ - - if (ncomp < 1) { - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - rdklin_(file, &number, (ftnlen)255); - r1 = rtrim_(file, (ftnlen)255); - setmsg_("The first item following the assignment operator should be " - "the value of a variable or a left parenthesis '(' followed b" - "y a value for a variable. This is not true on line # of the " - "text kernel file '#'. ", (ftnlen)201); - errint_("#", &number, (ftnlen)1); - errch_("#", file, (ftnlen)1, r1); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVAR", (ftnlen)6); - return 0; - } - -/* Return the name of the variable. */ - - s_copy(name__, varnam, (ftnlen)132, varnam_len); - chkout_("ZZRVAR", (ftnlen)6); - return 0; -} /* zzrvar_ */ - diff --git a/ext/spice/src/cspice/zzrvbf.c b/ext/spice/src/cspice/zzrvbf.c deleted file mode 100644 index 6b1226e1dc..0000000000 --- a/ext/spice/src/cspice/zzrvbf.c +++ /dev/null @@ -1,1087 +0,0 @@ -/* zzrvbf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; -static integer c__132 = 132; - -/* $Procedure ZZRVBF ( Private --- Pool, read the next buffer variable ) */ -/* Subroutine */ int zzrvbf_(char *buffer, integer *bsize, integer *linnum, - integer *namlst, integer *nmpool, char *names, integer *datlst, - integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, - char *varnam, logical *eof, ftnlen buffer_len, ftnlen names_len, - ftnlen chvals_len, ftnlen varnam_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen), - s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer head, code, itab; - static char name__[132]; - static integer begs[132], free, node; - static char line[132]; - static integer ends[132], tail; - static logical even, full; - static integer type__[132], b, e, i__, j, badat; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), lnkan_(integer *, integer *); - static logical found; - static integer ncomp, count; - static char error[256]; - static integer iplus; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int zzcln_(integer *, integer *, integer *, - integer *, integer *, integer *, integer *); - static integer r1, r2; - extern logical failed_(void); - static integer at, datahd, iblank, chnode, icomma, nameat, dpnode; - extern /* Subroutine */ int lnkila_(integer *, integer *, integer *); - static integer iequal; - static doublereal dvalue; - extern integer lastpc_(char *, ftnlen), lnknfn_(integer *); - static integer ilparn, irparn, itmark, dirctv, lookat, iquote; - extern integer zzhash_(char *, ftnlen); - static integer varlen; - static logical intokn, insepf; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - static logical inquot; - static integer status, vartyp, nxttok; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), sigerr_(char *, ftnlen), lnkfsl_(integer *, - integer *, integer *), tparse_(char *, doublereal *, char *, - ftnlen, ftnlen), nparsd_(char *, doublereal *, char *, integer *, - ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Read the next variable from a text buffer into the kernel pool. */ - -/* $ 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 */ - -/* PRIVATE KERNEL */ - -/* $ Keywords */ - -/* POOL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* BUFFER I Array of text to be read and parsed. */ -/* BSIZE I Number of lines in text buffer. */ -/* LINNUM I/O line number to begin reading buffer */ -/* NAMLST I/O array of collision resolution list heads */ -/* NMPOOL I/O linked list pool of collision resolution lists */ -/* NAMES I/O array of names of kernel pool variables */ -/* DATLST I/O array of heads of lists of variable values */ -/* DPPOOL I/O linked list pool of pointer lists to d.p. values */ -/* DPVALS I/O array of d.p. kernel pool values */ -/* CHPOOL I/O linked list pool of pointer lists to string values */ -/* CHVALS I/O array of string kernel pool values */ -/* VARNAM O name of variable parsed */ -/* EOF O if TRUE end of input file has been reached. */ - -/* $ Detailed_Input */ - -/* BUFFER is a string array that contains the text that should */ -/* be parsed and placed into the kernel pool data */ -/* structure. */ - -/* BSIZE is the number of lines of text in BUFFER. */ - -/* LINNUM the line number (in BUFFER) at which to begin parsing */ -/* text. */ - -/* NAMLST this collection of arrays together with the hash */ -/* NMPOOL function ZZHASH provide the mechanism for storing */ -/* NAMES and retrieving kernel pool variables. */ -/* DATLST */ -/* DPPOOL Given a potential variable name NAME the function */ -/* DPVALS ZZHASH(NAME) gives the location in the array in */ -/* CHPOOL NAMLST where one should begin looking for the */ -/* CHVALS kernel pool variable NAME. */ - -/* If NAMLST( ZZHASH(NAME) ) is zero, there is no kernel */ -/* pool variable corresponding to NAME. If it is non-zero */ -/* then NAMLST is the head node of a linked list of names */ -/* that evaluate to the same integer under the function */ -/* ZZHASH. Letting NODE = NAMLST( ZZHASH(NAME) ) check */ -/* NAMES(NODE) for equality with NAME. If there is */ -/* no match find the next node ( NMPOOL(NEXT,NODE) ) until */ -/* a match occurs or all nodes of the list have been */ -/* examined. To insert a new NAME allocate a node NEW from */ -/* the free list of NMPOOL and append it to the tail of the */ -/* list pointed to by NAMLST ( ZZHASH(NAME) ). */ - -/* Once a node for NAME is located (call it NAMEAT) */ -/* the values for NAME can be found by examining */ -/* DATLST(NAMEAT). If zero, no values have yet been */ -/* given to NAME. If less than zero, -DATLST(NAMEAT) */ -/* is the head node of a list in CHPOOL that gives the */ -/* indexes of the values of NAME in CHVALS. If greater */ -/* than zero, DATLST(NAMEAT) is the head node of a list */ -/* in DPPOOL that gives the indexes of the values of NAME */ -/* in DPVALS. */ - - - - -/* $ Detailed_Output */ - -/* LINNUM is the line number at which the "next" read should */ -/* begin. */ - -/* NAMLST is the same structure as input but updated to */ -/* NMPOOL include the next variable read from the text buffer. */ -/* NAMES */ -/* DATLST */ -/* DPPOOL */ -/* DPVALS */ -/* CHPOOL */ -/* CHVALS */ - -/* VARNAM is the name of the variable. VARNAM is blank if */ -/* no variable is read. */ - -/* EOF is true when the end of the internal buffer has been */ -/* reached, and is false otherwise. */ - -/* $ Parameters */ - -/* LINLEN is the maximum length of a line in the buffer. */ - -/* MAXLEN is the maximum length of the variable names that */ -/* can be stored in the kernel pool (defined in pool.f). */ - -/* $ Exceptions */ - - -/* 1) The error 'SPICE(BADTIMESPEC)' is signalled if a value */ -/* beginning with '@' cannot be parsed as a time. */ - -/* 2) The error 'SPICE(BADVARASSIGN)' is signalled if variable */ -/* assignment does not have the form NAME = [(] value [ value ) ]. */ - -/* 3) The error 'SPICE(KERNELPOOLFULL)' is signalled if there is */ -/* no room left in the kernel pool to store another variable */ -/* or value. */ - -/* 4) The error 'SPICE(NONPRINTINGCHAR)' is signalled if the name */ -/* in a variable assignment contains a non-printing character. */ - -/* 5) The error 'SPICE(NUMBEREXPECTED)' is signalled if a value */ -/* that is unquoted cannot be parsed as time or number. */ - -/* 6) The error 'SPICE(TYPEMISMATCH)' is signalled if a variable */ -/* has a first value of one type (numeric or character) and */ -/* a subsequent component has the other type. */ - -/* 7) The error 'SPICE(BADVARNAME)' signals if a kernel pool */ -/* variable name length exceeds MAXLEN. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See POOL (entry point LMPOOL). */ - -/* $ Restrictions */ - -/* The input buffer should be no more than 132 characters in width. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-FEB-2010 (EDW) */ - -/* Added an error check on the length of the kernel pool variable */ -/* names read from BUFFER. */ - -/* - SPICELIB Version 1.0.0, 29-MAR-1999 (WLT) */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters. */ - -/* Below are a collection of enumerated lists that are used */ -/* to discern what part of the processing we are in and what */ -/* kind of entity we are dealing with. First the overall */ -/* processing flow of a variable assignment. */ - - -/* Next we have the various types of tokens that can be found */ -/* in the parsing of an input line */ - -/* Q --- quoted (or protected tokens) */ -/* NQ --- unquoted tokens */ -/* BV --- beginning of a vector */ -/* EV --- ending of a vector */ -/* EQ --- equal sign */ -/* EQP --- equal sign plus */ - - -/* A variable can have one of three types as we process */ -/* it. It can have an unknown type UNKNWN, STRTYP or NUMTYP. */ - - - -/* The next two parameters indicate which component of a linked */ -/* list node point to the previous node and the next node. */ - - -/* The next collection of variables are set up in first pass */ -/* through this routine. They would be parameters if FORTRAN */ -/* allowed us to do this in a standard way. */ - - -/* The logicals below are used to take apart the tokens in an */ -/* input line. */ - - -/* The following logicals are in-line functions that are used */ -/* when processing the input strings. */ - - -/* Save everything. */ - - -/* Below are a collection of In-line function definitions that are */ -/* intended to make the code a bit easier to write and read. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZRVBF", (ftnlen)6); - } - -/* Initializations. */ - - if (first) { - first = FALSE_; - icomma = ','; - iblank = ' '; - iquote = '\''; - ilparn = '('; - irparn = ')'; - iequal = '='; - iplus = '+'; - itmark = '@'; - itab = 9; - } - -/* No variable yet and no parsing errors so far. */ - - s_copy(name__, " ", (ftnlen)132, (ftnlen)1); - s_copy(error, " ", (ftnlen)256, (ftnlen)1); - ncomp = 0; - -/* Get the next data line. Unless something is terribly wrong, */ -/* this will begin a new variable definition. We have to read */ -/* the whole variable, unless we get an error, in which case */ -/* we can quit. */ - - status = 1; - while(status != 2 && ! failed_()) { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - -/* We need to skip blank lines... */ - - while(s_cmp(line, " ", (ftnlen)132, (ftnlen)1) == 0) { - *eof = *linnum > *bsize; - if (*eof) { - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - s_copy(line, buffer + (*linnum - 1) * buffer_len, (ftnlen)132, - buffer_len); - ++(*linnum); - } - -/* Find the "tokens" in the input line. As you scan from left */ -/* to right along the line, exactly one of the following */ -/* conditions is true. */ - -/* 1) You are in a separator field */ -/* 4) You are in a quoted substring */ -/* 5) You are in a non-quoted substring that isn't a separator */ -/* field. */ - -/* Stuff between separator fields are regarded as tokens. Note */ -/* this includes quoted strings. */ - -/* In addition we keep track of 3 separators: '=', '(', ')' */ -/* Finally, whenever we encounters the separator '=', we back */ -/* up and see if it is preceded by a '+', if so we attach */ -/* it to the '=' and treat the pair of characters as a single */ -/* separator. */ - - even = TRUE_; - intokn = FALSE_; - inquot = FALSE_; - insepf = TRUE_; - count = 0; - i__ = 0; - while(i__ < i_len(line, (ftnlen)132)) { - -/* The current character is either a separator, quote or */ -/* some other character. */ - - ++i__; - code = *(unsigned char *)&line[i__ - 1]; - if (code == iblank || code == icomma || code == ilparn || code == - irparn || code == iequal || code == itab) { - -/* There are 3 possible states we could be in */ -/* Separation Field */ -/* A quoted substring with the last quote an odd one. */ -/* A quoted substring with the last quote an even one. */ -/* A non-quoted token. */ -/* In the first two cases nothing changes, but in the */ -/* next two cases we transition to a separation field. */ - - if (intokn || inquot && even) { - inquot = FALSE_; - intokn = FALSE_; - insepf = TRUE_; - } - if (insepf) { - -/* We need to see if this is one of the special */ -/* separators */ - - if (code == iequal) { - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvbf_", (ftnlen)544)] - = i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)545)] - = 5; - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("ends", i__1, "zzrvbf_", (ftnlen)546)] - = i__; - if (i__ > 1) { - -/* Look back at the previous character. */ -/* See if it is a plus character. */ - - i__1 = i__ - 2; - code = *(unsigned char *)&line[i__1]; - if (code == iplus) { - -/* This is the directive '+=' we need */ -/* to set the beginning of this token */ -/* to the one before this and adjust */ -/* the end of the last token. */ - - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? - i__1 : s_rnge("type", i__1, "zzrvbf_" - , (ftnlen)562)] = 6; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? - i__1 : s_rnge("begs", i__1, "zzrvbf_", - (ftnlen)563)] = i__ - 1; - if (begs[(i__1 = count - 2) < 132 && 0 <= - i__1 ? i__1 : s_rnge("begs", i__1, - "zzrvbf_", (ftnlen)565)] == ends[( - i__2 = count - 2) < 132 && 0 <= i__2 ? - i__2 : s_rnge("ends", i__2, "zzrvbf_" - , (ftnlen)565)]) { - --count; - begs[(i__1 = count - 1) < 132 && 0 <= - i__1 ? i__1 : s_rnge("begs", i__1, - "zzrvbf_", (ftnlen)569)] = i__ - - 1; - ends[(i__1 = count - 1) < 132 && 0 <= - i__1 ? i__1 : s_rnge("ends", i__1, - "zzrvbf_", (ftnlen)570)] = i__; - type__[(i__1 = count - 1) < 132 && 0 <= - i__1 ? i__1 : s_rnge("type", i__1, - "zzrvbf_", (ftnlen)571)] = 6; - } else { - ends[(i__1 = count - 2) < 132 && 0 <= - i__1 ? i__1 : s_rnge("ends", i__1, - "zzrvbf_", (ftnlen)575)] = ends[( - i__2 = count - 2) < 132 && 0 <= - i__2 ? i__2 : s_rnge("ends", i__2, - "zzrvbf_", (ftnlen)575)] - 1; - } - } - } - } else if (code == irparn) { - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvbf_", (ftnlen)586)] - = i__; - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("ends", i__1, "zzrvbf_", (ftnlen)587)] - = i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)588)] - = 4; - } else if (code == ilparn) { - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvbf_", (ftnlen)593)] - = i__; - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("ends", i__1, "zzrvbf_", (ftnlen)594)] - = i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)595)] - = 3; - } - } - } else if (code == iquote) { - -/* There are 3 cases of interest. */ -/* We are in a quoted substring already */ -/* We are in a separator field */ -/* We are in a non-quoted token. */ -/* In the first case nothing changes. In the second */ -/* two cases we change to being in a quoted substring. */ - - even = ! even; - if (! inquot) { - insepf = FALSE_; - intokn = FALSE_; - inquot = TRUE_; - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvbf_", (ftnlen)618)] = - i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)619)] = 1; - } - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zzrvbf_", (ftnlen)623)] = i__; - } else { - -/* This is some character other than a quote, or */ -/* separator character. */ - -/* We are in one of four situations. */ - -/* 1) We are in a quoted substring with an odd number of */ -/* quotes. */ -/* 2) We are in a quoted substring with an even number of */ -/* quotes. */ -/* 2) We are in a separator field */ -/* 3) We are in a non-quoted token. */ - -/* In cases 1 and 3 nothing changes. So we won't check */ -/* those cases. */ - - if (insepf || inquot && even) { - inquot = FALSE_; - insepf = FALSE_; - intokn = TRUE_; - ++count; - begs[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("begs", i__1, "zzrvbf_", (ftnlen)648)] = - i__; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)649)] = 2; - } - ends[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zzrvbf_", (ftnlen)652)] = i__; - } - } - -/* The first word on the first line should be the name of a */ -/* variable. The second word should be a directive: = or +=. */ - - if (status == 1) { - -/* There must be at least 3 contributing tokens on this line. */ - - if (count < 3) { - setmsg_("A kernel variable was not properly formed on line #" - " text buffer.Such an assignment should have the form" - ": ' [+]= '. This line was '#'" - ". ", (ftnlen)157); - r2 = rtrim_(line, (ftnlen)132); - errint_("#", linnum, (ftnlen)1); - errch_("#", line, (ftnlen)1, r2); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* See if the variable name is legitimate: */ - - i__1 = begs[0] - 1; - badat = lastpc_(line + i__1, ends[0] - i__1); - if (badat <= ends[0] - begs[0]) { - -/* There is a non-printing character in the variable */ -/* name. This isn't allowed. */ - - at = begs[0] + badat; - setmsg_("There is a non-printing character embedded in line " - "# of the text buffer. Non-printing characters are n" - "ot allowed in kernel variable assignments. The non-" - "printing character has ASCII code #. ", (ftnlen)192); - errint_("#", linnum, (ftnlen)1); - i__1 = *(unsigned char *)&line[at - 1]; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(NONPRINTINGCHAR)", (ftnlen)22); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Check the variable name length; signal an error */ -/* if longer than MAXLEN. */ - - i__1 = begs[0] - 1; - varlen = i_len(line + i__1, ends[0] - i__1); - if (varlen > 32) { - setmsg_("A kernel pool variable name in the input buffer exc" - "eeds the maximum allowed length #1. The actual lengt" - "h of the variable name is #2, the offending variable" - " name to #3 characters: '#4'.", (ftnlen)184); - errint_("#1", &c__32, (ftnlen)2); - errint_("#2", &varlen, (ftnlen)2); - errint_("#3", &c__132, (ftnlen)2); - i__1 = begs[0] - 1; - errch_("#4", line + i__1, (ftnlen)2, ends[0] - i__1); - sigerr_("SPICE(BADVARNAME)", (ftnlen)17); - } - -/* The variable name is ok. How about the directive. */ - - i__1 = begs[0] - 1; - s_copy(varnam, line + i__1, varnam_len, ends[0] - i__1); - dirctv = type__[1]; - -/* If this is replacement (=) and not an addition (+=), */ -/* delete the values currently associated with the variable. */ -/* They will be replaced later. */ - - if (dirctv != 5 && dirctv != 6) { - setmsg_("A kernel variable was not properly formed on line #" - " of the text buffer. Such an assignment should have " - "the form: ' [+]= '. More spe" - "cifically, the assignment operator did not have one " - "of the expected forms: '=' or '+='. The line was '#'" - ". ", (ftnlen)261); - r2 = rtrim_(line, (ftnlen)132); - errint_("#", linnum, (ftnlen)1); - errch_("#", line, (ftnlen)1, r2); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Locate this variable name in the name pool or insert it */ -/* if it isn't there. The location will be NAMEAT and */ -/* we will use the variable FOUND to indicate whether or */ -/* not it was already present. */ - - lookat = zzhash_(varnam, varnam_len); - node = namlst[lookat - 1]; - full = lnknfn_(nmpool) <= 0; - found = FALSE_; - -/* See if this name (or one colliding with it in the */ -/* hash scheme) has already been stored in the name list. */ - - if (node > 0) { - head = node; - tail = -nmpool[(head << 1) + 11]; - while(node > 0 && ! found) { - found = s_cmp(names + (node - 1) * names_len, varnam, - names_len, varnam_len) == 0; - nameat = node; - node = nmpool[(node << 1) + 10]; - } - if (! found && ! full) { - -/* We didn't find this name on the conflict resolution */ -/* list. Allocate a new slot for it. */ - - lnkan_(nmpool, &node); - lnkila_(&tail, &node, nmpool); - s_copy(names + (node - 1) * names_len, varnam, names_len, - varnam_len); - nameat = node; - } - } else if (! full) { - -/* Nothing like this variable name (in the hashing sense) */ -/* has been loaded so far. We need to allocate */ -/* a name slot for this variable. */ - - lnkan_(nmpool, &node); - namlst[lookat - 1] = node; - s_copy(names + (node - 1) * names_len, varnam, names_len, - varnam_len); - nameat = node; - } - -/* If the name pool was full and we didn't find this name */ -/* we've got an error. Diagnose it and return. */ - - if (full && ! found) { - setmsg_("The kernel pool does not have room for any more var" - "iables. It filled up at line # of the text buffer. ", - (ftnlen)103); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Now depending upon the kind of directive, we will need */ -/* to remove data and allocate a new list or simply append */ -/* data to the existing list. */ - - if (dirctv == 5) { - -/* We are going to dump whatever is associated with */ -/* this name and then we will need to allocate a new */ -/* linked list for the data. */ - - vartyp = 3; - if (found) { - -/* We need to free the data associated with this */ -/* variable. */ - - datahd = datlst[nameat - 1]; - datlst[nameat - 1] = 0; - if (datahd < 0) { - -/* This variable was character type we need to */ -/* free a linked list from the character data */ -/* pool. */ - - head = -datahd; - tail = -chpool[(head << 1) + 11]; - lnkfsl_(&head, &tail, chpool); - } else { - -/* This variable was numeric type. We need to */ -/* free a linked list from the numeric pool. */ - - head = datahd; - tail = -dppool[(head << 1) + 11]; - lnkfsl_(&head, &tail, dppool); - } - } - } else if (dirctv == 6) { - -/* We need to append to the current variable. */ - - if (found) { - if (datlst[nameat - 1] > 0) { - vartyp = 2; - } else if (datlst[nameat - 1] < 0) { - vartyp = 1; - } else { - vartyp = 3; - } - } else { - vartyp = 3; - } - } - -/* If this is a vector, the next thing on the line will be a */ -/* left parenthesis. Otherwise, assume that this is a scalar. */ -/* If it's a vector, get the first value. If it's a scalar, */ -/* plant a bogus right parenthesis, to make the following loop */ -/* terminate after one iteration. */ - - if (type__[2] == 3) { - nxttok = 4; - } else { - nxttok = 3; - ++count; - type__[(i__1 = count - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "type", i__1, "zzrvbf_", (ftnlen)921)] = 4; - } - -/* For subsequent lines, treat everything as a new value. */ - - } else { - nxttok = 1; - } - -/* We have a value anyway. Store it in the table. */ - -/* Keep going until the other shoe (the right parenthesis) */ -/* drops, or until the end of the line is reached. */ - -/* Dates begin with @; anything else is presumed to be a number. */ - - while(type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "type", i__1, "zzrvbf_", (ftnlen)941)] != 4 && nxttok <= - count) { - -/* Get the begin and end of this token. */ - - b = begs[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "begs", i__1, "zzrvbf_", (ftnlen)945)]; - e = ends[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zzrvbf_", (ftnlen)946)]; - if (vartyp == 3) { - -/* We need to determine which category of variable we */ -/* have by looking at this token and deducing the */ -/* type. */ - - if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)954)] == 1) { - vartyp = 1; - } else if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? - i__1 : s_rnge("type", i__1, "zzrvbf_", (ftnlen)958)] - == 2) { - vartyp = 2; - } else { - -/* This is an error. We should have had one of the */ -/* two previous types. */ - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - setmsg_("The first item following the assignment operato" - "r should be the value of a variable or a left pa" - "renthesis '(' followed by a value for a variable" - ". This is not true on line # of the text buffer. " - , (ftnlen)192); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - } - if (vartyp == 1) { - -/* First make sure that this token represents a string. */ - - if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)996)] != 1) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - r1 = rtrim_(varnam, varnam_len); - setmsg_("The kernel variable # has been set up as a stri" - "ng variable. However, the value that you are at" - "tempting to assign to this variable on line # of" - " the text buffer is not a string value. ", ( - ftnlen)183); - errch_("#", varnam, (ftnlen)1, r1); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Still going? Make sure there is something between */ -/* the quotes. */ - - if (b + 1 >= e) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - setmsg_("There is a quoted string with no characters on " - "line # of the text buffer. ", (ftnlen)74); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* We are ready to go. Allocate a node for this data */ -/* item. First make sure there is room to do so. */ - - free = lnknfn_(chpool); - if (free <= 0) { - setmsg_("There is no room available for adding another c" - "haracter value to the kernel pool. The characte" - "r values buffer became full at line # of the tex" - "t buffer. ", (ftnlen)153); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this string value: */ - - lnkan_(chpool, &chnode); - if (datlst[nameat - 1] == 0) { - -/* There was no data for this name yet. We make */ -/* CHNODE be the head of the data list for this name. */ - - datlst[nameat - 1] = -chnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = -datlst[nameat - 1]; - tail = -chpool[(head << 1) + 11]; - lnkila_(&tail, &chnode, chpool); - } - -/* Finally insert this data item in the data buffer */ -/* at CHNODE. Note any quotes will be doubled so we */ -/* have to undo this affect when we store the data. */ - - s_copy(chvals + (chnode - 1) * chvals_len, " ", chvals_len, ( - ftnlen)1); - ++ncomp; - i__ = 1; - j = b + 1; - while(j < e) { - code = *(unsigned char *)&line[j - 1]; - if (code == iquote) { - ++j; - } - *(unsigned char *)&chvals[(chnode - 1) * chvals_len + ( - i__ - 1)] = *(unsigned char *)&line[j - 1]; - ++i__; - ++j; - } - -/* That's all for this value. It's now time to loop */ -/* back through and get the next value. */ - - } else { - if (type__[(i__1 = nxttok - 1) < 132 && 0 <= i__1 ? i__1 : - s_rnge("type", i__1, "zzrvbf_", (ftnlen)1117)] != 2) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, - dppool); - r1 = rtrim_(varnam, varnam_len); - setmsg_("The kernel variable # has been set up as a nume" - "ric or time variable. However, the value that y" - "ou are attempting to assign to this variable on " - "line # of the kernel buffer is not a numeric or " - "time value. ", (ftnlen)203); - errch_("#", varnam, (ftnlen)1, r1); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Look at the first character to see if we have a time */ -/* or a number. */ - - code = *(unsigned char *)&line[b - 1]; - if (code == itmark) { - -/* We need to have more than a single character. */ - - if (e == b) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, - chpool, dppool); - r1 = rtrim_(varnam, varnam_len); - setmsg_("At character # of line # in the text buffe" - "r the character '@' appears. This character" - " is reserved for identifying time values in " - "assignments to kernel pool variables. Howev" - "er it is not being used in this fashion for " - "the variable '#'. ", (ftnlen)237); - errint_("#", &b, (ftnlen)1); - errint_("#", linnum, (ftnlen)1); - errch_("#", varnam, (ftnlen)1, r1); - sigerr_("SPICE(BADTIMESPEC)", (ftnlen)18); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - i__1 = b; - tparse_(line + i__1, &dvalue, error, e - i__1, (ftnlen) - 256); - if (s_cmp(error, " ", (ftnlen)256, (ftnlen)1) != 0) { - -/* First perform the clean up function. */ - - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, - chpool, dppool); - setmsg_("Encountered '#' while attempting to parse a" - " time on line # of the text buffer. ", ( - ftnlen)79); - i__1 = b; - errch_("#", line + i__1, (ftnlen)1, e - i__1); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(BADTIMESPEC)", (ftnlen)18); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - } else { - nparsd_(line + (b - 1), &dvalue, error, &i__, e - (b - 1), - (ftnlen)256); - if (s_cmp(error, " ", (ftnlen)256, (ftnlen)1) != 0) { - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, - chpool, dppool); - setmsg_("Encountered '#' while attempting to parse a" - " number on line # of the text buffer", ( - ftnlen)79); - errch_("#", line + (b - 1), (ftnlen)1, e - (b - 1)); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(NUMBEREXPECTED)", (ftnlen)21); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - } - -/* OK. We have a parsed value. See if there is room in */ -/* the numeric portion of the pool to store this value. */ - - free = lnknfn_(dppool); - if (free <= 0) { - setmsg_("There is no room available for adding another n" - "umeric value to the kernel pool. The numeric va" - "lues buffer became full at line # of the text bu" - "ffer.", (ftnlen)148); - errint_("#", linnum, (ftnlen)1); - sigerr_("SPICE(KERNELPOOLFULL)", (ftnlen)21); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Allocate a node for storing this numeric value: */ - - lnkan_(dppool, &dpnode); - if (datlst[nameat - 1] == 0) { - -/* There was no data for this name yet. We make */ -/* DPNODE be the head of the data list for this name. */ - - datlst[nameat - 1] = dpnode; - } else { - -/* Put this node after the tail of the current list. */ - - head = datlst[nameat - 1]; - tail = -dppool[(head << 1) + 11]; - lnkila_(&tail, &dpnode, dppool); - } - -/* Finally insert this data item into the numeric buffer. */ - - dpvals[dpnode - 1] = dvalue; - ++ncomp; - } - -/* Now process the next token in the list of tokens. */ - - ++nxttok; - } - -/* We could have ended the above loop in one of two ways. */ - -/* 1) NXTTOK now exceeds count. This means we did not reach */ -/* an end of vector marker. */ -/* 2) We hit an end of vector marker. */ - - if (nxttok > count) { - status = 3; - } else { - status = 2; - } - } - -/* It is possible that we reached this point without actually */ -/* assigning a value to the kernel pool variable. This can */ -/* happen if there is a vector input of the form NAME = ( ) */ - - if (ncomp < 1) { - zzcln_(&lookat, &nameat, namlst, datlst, nmpool, chpool, dppool); - setmsg_("The first item following the assignment operator should be " - "the value of a variable or a left parenthesis '(' followed b" - "y a value for a variable. This is not true on line # of the " - "text buffer. ", (ftnlen)192); - i__1 = *linnum - 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(BADVARASSIGN)", (ftnlen)19); - chkout_("ZZRVBF", (ftnlen)6); - return 0; - } - -/* Return the name of the variable. */ - - s_copy(name__, varnam, (ftnlen)132, varnam_len); - chkout_("ZZRVBF", (ftnlen)6); - return 0; -} /* zzrvbf_ */ - diff --git a/ext/spice/src/cspice/zzrxr.c b/ext/spice/src/cspice/zzrxr.c deleted file mode 100644 index 231627eb88..0000000000 --- a/ext/spice/src/cspice/zzrxr.c +++ /dev/null @@ -1,264 +0,0 @@ -/* zzrxr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZRXR ( Multiply sequence of 3x3 matrices ) */ -/* Subroutine */ int zzrxr_(doublereal *matrix, integer *n, doublereal * - output) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer incr; - doublereal temp[18] /* was [3][3][2] */; - integer i__, j, k; - extern /* Subroutine */ int ident_(doublereal *); - integer get, put; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine multiplies together a sequence of state */ -/* transformation matrices. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MATRIX I A sequence of state transformation matrices */ -/* N I The number of 3x3 matrices */ -/* OUTPUT O The product of the 3x3 matrices. */ - -/* $ Detailed_Input */ - -/* MATRIX is an array of 3x3 matrices. */ - -/* N is an integer giving the number of matrices in the */ -/* sequence. */ - - -/* $ Detailed_Output */ - -/* OUTPUT is the product of the matrices stored in MATRIX. */ -/* Specifically, it is the result of the product */ - -/* M_N * M_(N-1) * ... * M_2 * M_1 */ - -/* where the K'th matrix M_K is define by the */ -/* relationship */ - -/* M_K( I, J ) = MATRIX ( I, J, K ) */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If N is 0 or smaller OUTPUT will be returned as the */ -/* 3x36 identity matrix. */ - -/* 2) IF N is 1 OUTPUT will be returned as M_1 where M_1 is */ -/* the matrix defined above in the description of OUTPUT. */ - -/* $ Particulars */ - -/* This is a private SPICE routine that computes the product */ -/* of a sequence of 3x3 matrices. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ - - -/* -& */ - -/* If we have more than 2 matrices to deal with we will need to */ -/* set up the PUT location */ - - put = 1; - -/* We perform tests in the order they seem most likely to */ -/* occur. */ - - if (*n == 2) { - -/* If there are exactly two inputs, then the output takes */ -/* only a single matrix multiply. */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - output[(i__1 = j + k * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzrxr_", (ftnlen)158)] = - matrix[j + 8] * matrix[(k + 3) * 3 - 12] + matrix[j + - 11] * matrix[(k + 3) * 3 - 11] + matrix[j + 14] * - matrix[(k + 3) * 3 - 10]; - } - } - } else if (*n > 2) { - -/* We need to compute the product */ - -/* MATRIX( , ,N) * MATRIX( , ,N-1) * ... * MATRIX( , , 1 ) */ - -/* Compute the first product. MATRIX( , ,2) * MATRIX( , ,1) */ - - -/* First compute the upper left hand 3x3 portion of the product... */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - temp[(i__1 = j + (k + put * 3) * 3 - 13) < 18 && 0 <= i__1 ? - i__1 : s_rnge("temp", i__1, "zzrxr_", (ftnlen)180)] = - matrix[j + 8] * matrix[(k + 3) * 3 - 12] + matrix[j + - 11] * matrix[(k + 3) * 3 - 11] + matrix[j + 14] * - matrix[(k + 3) * 3 - 10]; - } - } - -/* Now continue building the product. Note we will toggle */ -/* back and forth from TEMP(,,1) to TEMP(,,2) for storing */ -/* (PUTting) the results of our computations. This way we */ -/* don't have to spend time moving any of the our computation */ -/* results to get ready for the next product. See the end */ -/* of the loop below (keeping mind the next three values) to */ -/* see the little trick that's used to toggle back and forth. */ - - incr = -1; - put = 2; - get = 1; - i__1 = *n - 1; - for (i__ = 3; i__ <= i__1; ++i__) { - -/* First the uppper left hand portion of the product. */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - temp[(i__2 = j + (k + put * 3) * 3 - 13) < 18 && 0 <= - i__2 ? i__2 : s_rnge("temp", i__2, "zzrxr_", ( - ftnlen)207)] = matrix[j + (i__ * 3 + 1) * 3 - 13] - * temp[(i__3 = (k + get * 3) * 3 - 12) < 18 && 0 - <= i__3 ? i__3 : s_rnge("temp", i__3, "zzrxr_", ( - ftnlen)207)] + matrix[j + (i__ * 3 + 2) * 3 - 13] - * temp[(i__4 = (k + get * 3) * 3 - 11) < 18 && 0 - <= i__4 ? i__4 : s_rnge("temp", i__4, "zzrxr_", ( - ftnlen)207)] + matrix[j + (i__ * 3 + 3) * 3 - 13] - * temp[(i__5 = (k + get * 3) * 3 - 10) < 18 && 0 - <= i__5 ? i__5 : s_rnge("temp", i__5, "zzrxr_", ( - ftnlen)207)]; - } - } - -/* And as before, we don't need to compute the upper right */ -/* or lower right hand 3x3 portions of the matrix. So */ -/* we just skip them. Toggle GET and PUT so we will */ -/* be ready for the next pass. */ - - get = put; - put += incr; - incr = -incr; - } - -/* Finally compute the last product. First the upper */ -/* left hand portion of the product. */ - - for (j = 1; j <= 3; ++j) { - for (k = 1; k <= 3; ++k) { - output[(i__1 = j + k * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzrxr_", (ftnlen)234)] = - matrix[j + (*n * 3 + 1) * 3 - 13] * temp[(i__2 = (k + - get * 3) * 3 - 12) < 18 && 0 <= i__2 ? i__2 : s_rnge( - "temp", i__2, "zzrxr_", (ftnlen)234)] + matrix[j + (* - n * 3 + 2) * 3 - 13] * temp[(i__3 = (k + get * 3) * 3 - - 11) < 18 && 0 <= i__3 ? i__3 : s_rnge("temp", i__3, - "zzrxr_", (ftnlen)234)] + matrix[j + (*n * 3 + 3) * 3 - - 13] * temp[(i__4 = (k + get * 3) * 3 - 10) < 18 && - 0 <= i__4 ? i__4 : s_rnge("temp", i__4, "zzrxr_", ( - ftnlen)234)]; - } - } - } else if (*n == 1) { - -/* If there is only one matrix in the list the output is */ -/* simply the input. */ - - for (i__ = 1; i__ <= 3; ++i__) { - for (j = 1; j <= 3; ++j) { - output[(i__1 = j + i__ * 3 - 4) < 9 && 0 <= i__1 ? i__1 : - s_rnge("output", i__1, "zzrxr_", (ftnlen)248)] = - matrix[j + (i__ + 3) * 3 - 13]; - } - } - } else if (*n <= 0) { - ident_(output); - } - return 0; -} /* zzrxr_ */ - diff --git a/ext/spice/src/cspice/zzsclk.c b/ext/spice/src/cspice/zzsclk.c deleted file mode 100644 index 605e0395ec..0000000000 --- a/ext/spice/src/cspice/zzsclk.c +++ /dev/null @@ -1,321 +0,0 @@ -/* zzsclk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__2 = 2; -static integer c__7 = 7; - -/* $Procedure ZZSCLK ( Is there and SCLK for a CKID ) */ -logical zzsclk_(integer *ckid, integer *sclkid) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2], i__3; - logical ret_val; - - /* Builtin functions */ - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - char sclk[32], type__[32]; - integer i__, n; - extern integer cardi_(integer *); - extern logical elemi_(integer *, integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - char agent[32]; - logical watch, found; - extern integer sizei_(integer *); - static integer known[16]; - logical keepid; - static integer passed[16]; - logical update; - extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *, - logical *, integer *, char *, ftnlen, ftnlen); - static integer dtsize[7]; - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen); - char sclkvr[32*7]; - extern /* Subroutine */ int ssizei_(integer *, integer *), removi_( - integer *, integer *), insrti_(integer *, integer *); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), swpool_( - char *, integer *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine whether or not an SCLK kernel is available for mapping */ -/* ET to Ticks and back again for a particular C-kernel ID. */ - -/* $ 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 */ - -/* UTITILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* CKID I CK ID-code for the object of interest. */ -/* SCLKID I Idcode to pass to the SCLOCK routines for CKID */ - -/* The function returns TRUE is SCLK information is available. */ - -/* $ Detailed_Input */ - -/* CKID is the C-kernel ID-code for some object for which */ -/* and SCLK is required. */ - -/* SCLKID is the ID-code to pass to SCE2C to convert ET times */ -/* to ticks. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if an SCLK specification is present */ -/* in the kernel pool that is suitable for mapping ticks to ET and */ -/* back for the C-kernel object specified by CKID. If such */ -/* information is not available, or is deemed to be corrupt or */ -/* incomplete, the function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility for checking that sufficient SCLK information */ -/* is available for mapping between ET and SCLK for the object */ -/* specified by CKID */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 15-AUG-2000 (WLT) */ - -/* Removed the check fo the SCLK Time system as it is not */ -/* formally required for an SCLK specification to be complete. */ - -/* - SPICELIB Version 1.0.0, 17-FEB-2000 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Determine whether a file specifies and SCLK */ - -/* -& */ -/* SPICELIB Functions */ - - -/* Local Variables */ - - ret_val = FALSE_; - -/* Standard SPICE error handling. */ - - if (return_()) { - return ret_val; - } - chkin_("ZZSCLK", (ftnlen)6); - if (first) { - first = FALSE_; - dtsize[0] = 1; - dtsize[1] = 1; - dtsize[2] = 1; - dtsize[3] = 1; - dtsize[4] = 3; - dtsize[5] = 1; - dtsize[6] = 1; - ssizei_(&c__10, known); - ssizei_(&c__10, passed); - } - -/* We've got a text kernel (or meta kernel). See if there is an */ -/* SCLK kernel loaded for the CKID provided in the calling inputs. */ -/* If not, we'll use the default -CKID/1000 for the SCLK ID. */ - - i__1 = -(*sclkid); - intstr_(&i__1, sclk, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 6, a__1[0] = "ZZSCLK"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(agent, a__1, i__2, &c__2, (ftnlen)32); - -/* See if this is an ID-code we've encountered before. If it */ -/* is we can make use of stored knowledge about this ID-code. */ - - if (elemi_(sclkid, known)) { - watch = FALSE_; - keepid = TRUE_; - cvpool_(agent, &update, (ftnlen)32); - } else if (cardi_(known) < sizei_(known)) { - -/* The SCLKID specified is not in the list of SCLKIDs for */ -/* this routine and there is room left in the pool of */ -/* SCLKIDs to keep track of one more. Put this ID into */ -/* the list of known IDS */ - - insrti_(sclkid, known); - update = TRUE_; - watch = TRUE_; - keepid = TRUE_; - } else { - update = TRUE_; - keepid = FALSE_; - watch = FALSE_; - } - if (! update) { - -/* Nothing has changed in the kernel pool w.r.t this agent. */ -/* The test for an SCLK will not have changed either. */ - - ret_val = elemi_(sclkid, passed); - chkout_("ZZSCLK", (ftnlen)6); - return ret_val; - } - -/* If we are still here, we need to look in the kernel pool */ -/* to see if we have an SCLK for this object. */ - -/* Construct all of the expected SCLK variables are */ -/* available for this SCLK. */ - -/* Writing concatenation */ - i__2[0] = 15, a__1[0] = "SCLK_DATA_TYPE_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 16, a__1[0] = "SCLK01_N_FIELDS_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr + 32, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 14, a__1[0] = "SCLK01_MODULI_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr + 64, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 15, a__1[0] = "SCLK01_OFFSETS_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr + 96, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 20, a__1[0] = "SCLK01_COEFFICIENTS_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr + 128, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 21, a__1[0] = "SCLK_PARTITION_START_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr + 160, a__1, i__2, &c__2, (ftnlen)32); -/* Writing concatenation */ - i__2[0] = 19, a__1[0] = "SCLK_PARTITION_END_"; - i__2[1] = 32, a__1[1] = sclk; - s_cat(sclkvr + 192, a__1, i__2, &c__2, (ftnlen)32); - -/* If we are supposed to watch for this agent, we add him to */ -/* the list of kernel pool agents. */ - - if (watch) { - swpool_(agent, &c__7, sclkvr, (ftnlen)32, (ftnlen)32); - cvpool_(agent, &update, (ftnlen)32); - } - -/* Check for all of the required variables and structure in */ -/* the kernel pool. */ - - for (i__ = 1; i__ <= 7; ++i__) { - dtpool_(sclkvr + (((i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "sclkvr", i__1, "zzsclk_", (ftnlen)276)) << 5), &found, &n, - type__, (ftnlen)32, (ftnlen)32); - if (! found || s_cmp(type__, "N", (ftnlen)32, (ftnlen)1) != 0 || n / - dtsize[(i__1 = i__ - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge( - "dtsize", i__1, "zzsclk_", (ftnlen)278)] * dtsize[(i__3 = i__ - - 1) < 7 && 0 <= i__3 ? i__3 : s_rnge("dtsize", i__3, "zzscl" - "k_", (ftnlen)278)] != n) { - -/* We don't have adequate SCLK data for the specified */ -/* object. Remove this AGENT from the list of agents */ -/* that have passed the test. */ - - removi_(sclkid, passed); - chkout_("ZZSCLK", (ftnlen)6); - return ret_val; - } - } - -/* Once we get to this point, we know we have SCLK data. If */ -/* there is room to WATCH for this agent, */ - - if (keepid) { - insrti_(sclkid, passed); - } - -/* As far as we can tell, everything looks ok. */ - - ret_val = TRUE_; - chkout_("ZZSCLK", (ftnlen)6); - return ret_val; -} /* zzsclk_ */ - diff --git a/ext/spice/src/cspice/zzsecprt.c b/ext/spice/src/cspice/zzsecprt.c deleted file mode 100644 index c224096e49..0000000000 --- a/ext/spice/src/cspice/zzsecprt.c +++ /dev/null @@ -1,211 +0,0 @@ -/* zzsecprt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSECPRT ( Calculate dot terms for DPSPCE perturbation ) */ -/* Subroutine */ int zzsecprt_(integer *isynfl, doublereal *dg, doublereal * - del, doublereal *xni, doublereal *omegao, doublereal *atime, - doublereal *omgdot, doublereal *xli, doublereal *xfact, doublereal * - xldot, doublereal *xndot, doublereal *xnddt) -{ - /* Builtin functions */ - double sin(doublereal), cos(doublereal); - - /* Local variables */ - doublereal xomi, x2omi, x2li; - -/* $ Abstract */ - -/* Routine to calculate the dot terms for the secular perturbation */ -/* of a vehicle. */ - -/* $ 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 */ - -/* SECULAR PERTURBATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ISYNFL I Resonance flag */ -/* DG I Parameter array */ -/* DEL I Parameter array of delta values */ -/* XNI I An intermediate linear term passed from the */ -/* calling routine */ -/* OMEGAO I Original argument of perigee */ -/* ATIME I An intermediate time term passed from the calling */ -/* routine */ -/* OMGDOT I Time rate of change of argument of perigee */ -/* XLI I An intermediate angular term passed from the */ -/* calling routine */ -/* XFACT I The value BFACT - XNQ */ -/* XLDOT O Time rate of change of XL */ -/* XNDOT O Time rate of change of XN */ -/* XNDDT O Time rate of change of XNDOT */ - -/* $ Detailed_Input */ - -/* ISYNFL is the flag used to indicate the need for resonance */ -/* calculations. */ - -/* DG is the parameter array replacing the Dxxxx values. */ - -/* DEL is the parameter array replacing DEL1, DEL2 and DEL3. */ - -/* XNI is an intermediate linear term passed from the main */ -/* term for the calculation of XLDOT = XNI + XFACT */ - -/* OMEGAO is the original value for the argument of perigee. */ - -/* ATIME is an intermediate time term passed from the main */ -/* routine used to calculate the time dependent */ -/* argument of perigee term XOMI */ - -/* OMGDOT is the time derivative of the argument of the perigee. */ - -/* XLI is an intermediate angular term */ - -/* XFACT is the value BFACT - XNQ calculated in ZZDPINIT */ - -/* $ Detailed_Output */ - -/* XLDOT time derivative of the XL term. */ - -/* XNDOT time derivative of the XN term. */ - -/* XNDDT second time derivative of XN, time derivative of the */ -/* time derivative. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This subroutine was constructed from a section of code in ZZDPSEC */ -/* in the original Spacetrack 3 report. The code block was called */ -/* using a set of conditional GO TO's. The block has been written as */ -/* this subroutine to improve clarity and maintainability and to */ -/* conform to the NAIF style standard. */ - -/* $ Examples */ - -/* None needed. */ - -/* $ Restrictions */ - -/* 1) This routine should be called only by ZZDPSEC as part of the */ -/* DPSPCE subroutine package. It has no other use. */ - -/* $ Author_and_Institution */ - -/* E.D. Wright (JPL) */ - -/* $ Literature_References */ - -/* Spacetrack 3 report. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 24-MAR-1999 (EDW) */ - -/* Correction made to format of Version descriptions. */ -/* Name of variable OMGDT changed to OMGDOT to be consistent */ -/* with name useage in other deep space two line elements */ -/* routines. */ - -/* - SPICELIB Version 1.0.0, MAY-19-1997 (EDW) */ - - -/* -& */ -/* $ Index_Entries */ - -/* perturbed dot terms */ - -/* -& */ - -/* Local variables. */ - - -/* Calculate the dot terms with respect to the state of the */ -/* resonance flag. */ - - if (*isynfl == 0) { - -/* Resonance flag set. */ - - xomi = *omegao + *omgdot * *atime; - x2omi = xomi + xomi; - x2li = *xli + *xli; - *xndot = dg[0] * sin(x2omi + *xli - 5.7686396) + dg[1] * sin(*xli - - 5.7686396) + dg[2] * sin(xomi + *xli - .95240898) + dg[3] * - sin(-xomi + *xli - .95240898) + dg[4] * sin(x2omi + x2li - - 1.8014998) + dg[5] * sin(x2li - 1.8014998) + dg[6] * sin(xomi - + *xli - 1.050833) + dg[7] * sin(-xomi + *xli - 1.050833) + - dg[8] * sin(xomi + x2li - 4.4108898) + dg[9] * sin(-xomi + - x2li - 4.4108898); - *xnddt = dg[0] * cos(x2omi + *xli - 5.7686396) + dg[1] * cos(*xli - - 5.7686396) + dg[2] * cos(xomi + *xli - .95240898) + dg[3] * - cos(-xomi + *xli - .95240898) + dg[6] * cos(xomi + *xli - - 1.050833) + dg[7] * cos(-xomi + *xli - 1.050833) + (dg[4] * - cos(x2omi + x2li - 1.8014998) + dg[5] * cos(x2li - 1.8014998) - + dg[8] * cos(xomi + x2li - 4.4108898) + dg[9] * cos(xomi + - x2li - 4.4108898)) * 2.; - } else { - -/* Resonance flag not set */ - - *xndot = del[0] * sin(*xli - .13130908) + del[1] * sin((*xli - - 2.8843198) * 2.) + del[2] * sin((*xli - .37448087) * 3.); - *xnddt = del[0] * cos(*xli - .13130908) + del[1] * 2. * cos((*xli - - 2.8843198) * 2.) + del[2] * 3. * cos((*xli - .37448087) * 3.); - } - *xldot = *xni + *xfact; - *xnddt *= *xldot; - -/* Hi! What are you doing way down here? Did you bring pizza? */ - - return 0; -} /* zzsecprt_ */ - diff --git a/ext/spice/src/cspice/zzsizeok.c b/ext/spice/src/cspice/zzsizeok.c deleted file mode 100644 index 0fe5ffc069..0000000000 --- a/ext/spice/src/cspice/zzsizeok.c +++ /dev/null @@ -1,218 +0,0 @@ -/* zzsizeok.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSIZEOK ( Determine if the size of a segment is ok ) */ -/* Subroutine */ int zzsizeok_(integer *size, integer *psize, integer *dsize, - integer *offset, logical *ok, integer *n) -{ - integer a, q, r__; - extern /* Subroutine */ int rmaini_(integer *, integer *, integer *, - integer *); - integer pd1; - -/* $ Abstract */ - - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This routine exists to determine whether or not the type of */ -/* a DAF segment is compatible with the sizes allowed for SPK */ -/* type 01 segments or CK type 02 segments. However, more generally */ -/* it determines whether or not the integer equation: */ - -/* SIZE = PSIZE*N + (N-OFFSET)/DSIZE */ - -/* can be satisfied for some value of N. Moreover, if such */ -/* an N exists (there can be only one) it returns that value. */ - -/* $ 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 */ - -/* PRIVATE */ -/* NUMERIC */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SIZE I Left hand side of the equation in the abstract */ -/* PSIZE I Coefficient of N (packet size). */ -/* DSIZE I Divisor of N-OFFSET (directory size). */ -/* OFFSET I Offset used in computation of number of directories */ -/* OK O TRUE if a solution for N exists. */ -/* N O Value of N if there is a solution, 0 otherwise. */ - -/* $ Detailed_Input */ - -/* SIZE Constant terms in the equation given in the abstract. */ -/* PSIZE */ -/* DSIZE */ - -/* OFFSET Constant term in the equation above. It should be */ -/* 1 or 0. */ - -/* $ Detailed_Output */ - -/* OK is TRUE if an integer solution for N exists. Otherwise */ -/* it is returned FALSE. */ - -/* N is the solution to the equation in the abstract */ -/* if such a solution exists. Otherwise it is returned */ -/* with the value zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If SIZE, PSIZE, or DSIZE is less than 1, OK is set to FALSE */ -/* N is set to zero and no attempt is made at finding a */ -/* solution. */ - -/* $ Particulars */ - -/* This routine determines whether or not the integer arithmetic */ -/* equation */ - -/* SIZE = PSIZE*N + (N-1)/DSIZE */ - -/* has a solution for N and if so returns the value of N. */ - -/* The routine is intended for checking the sizes of segments */ -/* for SPK type 01 and CK type 02. For SPK type 01, */ - -/* SIZE = segment size - 1 */ -/* PSIZE = 72 */ -/* DSIZE = 100 */ -/* OFFSET = 0 */ - - -/* for CK type 02, */ - -/* SIZE = segment size */ -/* PSIZE = 10 */ -/* DSIZE = 100 */ -/* OFFSET = 1 */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 02-DEC-1999 (WLT) */ - - -/* -& */ - -/* Here's the scoop. */ - -/* Suppose N is a solution to SIZE = PSIZE*N + (N-OFFSET)/DSIZE */ -/* N can be represented uniquely as */ - -/* N = q*DSIZE + r */ - -/* where OFFSET <= r <= DSIZE+OFFSET-1. Therefore there must */ -/* be values q and r such that */ - -/* SIZE = PSIZE*(q*DSIZE + r ) + ( q*DSIZE + r - 1 ) / DSIZE */ - -/* = PSIZE*DSIZE*q + q + PSIZE*r */ - -/* = (PSIZE*DSIZE+1)*q + PSIZE*r */ - -/* But SIZE can be represented uniquely as */ - -/* SIZE = (PSIZE*DSIZE+1)*k + a */ - -/* where 0 <= a < (PSIZE*DSIZE+1). */ - -/* But PSIZE*OFFSET < PSIZE*r < (PSIZE*DSIZE+OFFSET-1), */ -/* therefore it must be that */ - -/* SIZE mod(PSIZE*DSIZE+1) = PSIZE*r */ -/* and q = k */ - -/* Hence, there is a solution to our equation if and only if */ - -/* PSIZE divides SIZE mod(PSIZE*DSIZE+1) */ -/* and OFFSET*PSIZE <= SIZE mod(PSIZE*DSIZE+1) */ - - -/* Handle the exceptional case first. */ - - if (*size <= 0 || *dsize <= 0 || *psize <= 0) { - *n = 0; - *ok = FALSE_; - return 0; - } - pd1 = *psize * *dsize + 1; - rmaini_(size, &pd1, &q, &a); - if (*offset * *psize > a) { - *n = 0; - *ok = FALSE_; - return 0; - } - if (a == a / *psize * *psize) { - r__ = a / *psize; - *n = *dsize * q + r__; - *ok = TRUE_; - } else { - *ok = FALSE_; - *n = 0; - } - return 0; -} /* zzsizeok_ */ - diff --git a/ext/spice/src/cspice/zzspkac0.c b/ext/spice/src/cspice/zzspkac0.c deleted file mode 100644 index dce700af7e..0000000000 --- a/ext/spice/src/cspice/zzspkac0.c +++ /dev/null @@ -1,734 +0,0 @@ -/* zzspkac0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b13 = 1.; - -/* $Procedure ZZSPKAC0 ( S/P Kernel, aberration corrected state ) */ -/* Subroutine */ int zzspkac0_(integer *targ, doublereal *et, char *ref, char - *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal * - dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzspkas0_(integer *, doublereal *, char *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, ftnlen, ftnlen), zzspkgo0_(integer *, doublereal *, - char *, integer *, doublereal *, doublereal *, ftnlen); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal t; - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal ltssb, ssblt, stobs[12] /* was [6][2] */; - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - logical attblk[15]; - extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal ssbobs[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen), sigerr_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - static logical usestl; - doublereal acc[3]; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time */ -/* and stellar aberration, expressed relative to an inertial */ -/* reference frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observer. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the output state STARG is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* OBS is the NAIF ID code for the observer body. The */ -/* target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 3) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 4) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ -/* User applications normally will not need to call this routine */ -/* directly. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time and stellar aberration corrections. */ -/* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ -/* compute subsequent states at intervals of 1 hour. For each */ -/* epoch, display the states, the one way light time between */ -/* target and observer, and the rate of change of the one way */ -/* light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time and stellar */ -/* C aberration ('LT+S') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ - -/* CALL SPKACS ( 301, ET, 'J2000', 'LT+S', */ -/* . 399, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux g77/platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291584.614 */ -/* J2000 y-position (km): -266693.406 */ -/* J2000 z-position (km): -76095.6532 */ -/* J2000 x-velocity (km/s): 0.643439157 */ -/* J2000 y-velocity (km/s): -0.666065874 */ -/* J2000 z-velocity (km/s): -0.301310063 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289256.459 */ -/* J2000 y-position (km): -269080.605 */ -/* J2000 z-position (km): -77177.3528 */ -/* J2000 x-velocity (km/s): 0.64997032 */ -/* J2000 y-velocity (km/s): -0.660148253 */ -/* J2000 z-velocity (km/s): -0.299630418 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286904.897 */ -/* J2000 y-position (km): -271446.417 */ -/* J2000 z-position (km): -78252.9655 */ -/* J2000 x-velocity (km/s): 0.656443883 */ -/* J2000 y-velocity (km/s): -0.654183552 */ -/* J2000 z-velocity (km/s): -0.297928533 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284530.133 */ -/* J2000 y-position (km): -273790.671 */ -/* J2000 z-position (km): -79322.4117 */ -/* J2000 x-velocity (km/s): 0.662859505 */ -/* J2000 y-velocity (km/s): -0.648172247 */ -/* J2000 z-velocity (km/s): -0.296204558 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282132.378 */ -/* J2000 y-position (km): -276113.202 */ -/* J2000 z-position (km): -80385.612 */ -/* J2000 x-velocity (km/s): 0.669216846 */ -/* J2000 y-velocity (km/s): -0.642114815 */ -/* J2000 z-velocity (km/s): -0.294458645 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) The kernel files to be used by SPKACS must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 2) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration correction */ -/* aberration-corrected state from spk file */ -/* get light time and stellar aberration-corrected state */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKAC0", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKAC0", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* USESTL is .TRUE. when stellar aberration correction is */ -/* specified. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - usestl = attblk[2]; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKAC0", (ftnlen)8); - return 0; - } - -/* Prepare to look up the apparent state of the target */ -/* as seen by the observer. We'll need the geometric */ -/* state of the observer relative to the solar system */ -/* barycenter. If we're using stellar aberration */ -/* corrections, we'll need the observer's acceleration */ -/* as well. */ - -/* Get the geometric state of the observer relative to the SSB, */ -/* which we'll call SSBOBS. */ - - zzspkgo0_(obs, et, ref, &c__0, ssbobs, &ssblt, ref_len); - if (usestl) { - -/* Numerically differentiate the observer velocity relative to */ -/* the SSB to obtain acceleration. We first evaluate the */ -/* geometric state of the observer relative to the solar system */ -/* barycenter at ET +/- DELTA. */ - for (i__ = 1; i__ <= 2; ++i__) { - t = *et + ((i__ << 1) - 3) * 1.; - zzspkgo0_(obs, &t, ref, &c__0, &stobs[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("stobs", i__1, "zzspkac0_", ( - ftnlen)626)], <ssb, ref_len); - } - qderiv_(&c__3, &stobs[3], &stobs[9], &c_b13, acc); - } else { - cleard_(&c__3, acc); - } - -/* Look up the apparent state. The light time and light */ -/* rate are returned as well. */ - - zzspkas0_(targ, et, ref, abcorr, ssbobs, acc, starg, lt, dlt, ref_len, - abcorr_len); - chkout_("ZZSPKAC0", (ftnlen)8); - return 0; -} /* zzspkac0_ */ - diff --git a/ext/spice/src/cspice/zzspkac1.c b/ext/spice/src/cspice/zzspkac1.c deleted file mode 100644 index 8ac4037009..0000000000 --- a/ext/spice/src/cspice/zzspkac1.c +++ /dev/null @@ -1,734 +0,0 @@ -/* zzspkac1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__3 = 3; -static doublereal c_b13 = 1.; - -/* $Procedure ZZSPKAC1 ( S/P Kernel, aberration corrected state ) */ -/* Subroutine */ int zzspkac1_(integer *targ, doublereal *et, char *ref, char - *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal * - dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzspkas1_(integer *, doublereal *, char *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *, ftnlen, ftnlen), zzspkgo1_(integer *, doublereal *, - char *, integer *, doublereal *, doublereal *, ftnlen); - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - doublereal t; - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal ltssb, ssblt, stobs[12] /* was [6][2] */; - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - logical attblk[15]; - extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal ssbobs[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen), sigerr_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - static logical usestl; - doublereal acc[3]; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time */ -/* and stellar aberration, expressed relative to an inertial */ -/* reference frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observer. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the output state STARG is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* OBS is the NAIF ID code for the observer body. The */ -/* target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 3) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 4) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ -/* User applications normally will not need to call this routine */ -/* directly. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time and stellar aberration corrections. */ -/* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ -/* compute subsequent states at intervals of 1 hour. For each */ -/* epoch, display the states, the one way light time between */ -/* target and observer, and the rate of change of the one way */ -/* light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time and stellar */ -/* C aberration ('LT+S') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ - -/* CALL SPKACS ( 301, ET, 'J2000', 'LT+S', */ -/* . 399, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291584.614 */ -/* J2000 y-position (km): -266693.406 */ -/* J2000 z-position (km): -76095.6532 */ -/* J2000 x-velocity (km/s): 0.643439157 */ -/* J2000 y-velocity (km/s): -0.666065874 */ -/* J2000 z-velocity (km/s): -0.301310063 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289256.459 */ -/* J2000 y-position (km): -269080.605 */ -/* J2000 z-position (km): -77177.3528 */ -/* J2000 x-velocity (km/s): 0.64997032 */ -/* J2000 y-velocity (km/s): -0.660148253 */ -/* J2000 z-velocity (km/s): -0.299630418 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286904.897 */ -/* J2000 y-position (km): -271446.417 */ -/* J2000 z-position (km): -78252.9655 */ -/* J2000 x-velocity (km/s): 0.656443883 */ -/* J2000 y-velocity (km/s): -0.654183552 */ -/* J2000 z-velocity (km/s): -0.297928533 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284530.133 */ -/* J2000 y-position (km): -273790.671 */ -/* J2000 z-position (km): -79322.4117 */ -/* J2000 x-velocity (km/s): 0.662859505 */ -/* J2000 y-velocity (km/s): -0.648172247 */ -/* J2000 z-velocity (km/s): -0.296204558 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282132.378 */ -/* J2000 y-position (km): -276113.202 */ -/* J2000 z-position (km): -80385.612 */ -/* J2000 x-velocity (km/s): 0.669216846 */ -/* J2000 y-velocity (km/s): -0.642114815 */ -/* J2000 z-velocity (km/s): -0.294458645 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) The kernel files to be used by SPKACS must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 2) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration correction */ -/* aberration-corrected state from spk file */ -/* get light time and stellar aberration-corrected state */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKAC1", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKAC1", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* USESTL is .TRUE. when stellar aberration correction is */ -/* specified. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - usestl = attblk[2]; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKAC1", (ftnlen)8); - return 0; - } - -/* Prepare to look up the apparent state of the target */ -/* as seen by the observer. We'll need the geometric */ -/* state of the observer relative to the solar system */ -/* barycenter. If we're using stellar aberration */ -/* corrections, we'll need the observer's acceleration */ -/* as well. */ - -/* Get the geometric state of the observer relative to the SSB, */ -/* which we'll call SSBOBS. */ - - zzspkgo1_(obs, et, ref, &c__0, ssbobs, &ssblt, ref_len); - if (usestl) { - -/* Numerically differentiate the observer velocity relative to */ -/* the SSB to obtain acceleration. We first evaluate the */ -/* geometric state of the observer relative to the solar system */ -/* barycenter at ET +/- DELTA. */ - for (i__ = 1; i__ <= 2; ++i__) { - t = *et + ((i__ << 1) - 3) * 1.; - zzspkgo1_(obs, &t, ref, &c__0, &stobs[(i__1 = i__ * 6 - 6) < 12 && - 0 <= i__1 ? i__1 : s_rnge("stobs", i__1, "zzspkac1_", ( - ftnlen)626)], <ssb, ref_len); - } - qderiv_(&c__3, &stobs[3], &stobs[9], &c_b13, acc); - } else { - cleard_(&c__3, acc); - } - -/* Look up the apparent state. The light time and light */ -/* rate are returned as well. */ - - zzspkas1_(targ, et, ref, abcorr, ssbobs, acc, starg, lt, dlt, ref_len, - abcorr_len); - chkout_("ZZSPKAC1", (ftnlen)8); - return 0; -} /* zzspkac1_ */ - diff --git a/ext/spice/src/cspice/zzspkap0.c b/ext/spice/src/cspice/zzspkap0.c deleted file mode 100644 index 027d1bce89..0000000000 --- a/ext/spice/src/cspice/zzspkap0.c +++ /dev/null @@ -1,867 +0,0 @@ -/* zzspkap0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__9 = 9; -static integer c__6 = 6; - -/* $Procedure ZZSPKAP0 ( S/P Kernel, apparent state ) */ -/* Subroutine */ int zzspkap0_(integer *targ, doublereal *et, char *ref, - doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, - ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT " - "XLT+S" "XCN " "XCN+S"; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char corr[5]; - extern /* Subroutine */ int zzspksb0_(integer *, doublereal *, char *, - doublereal *, ftnlen); - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - char corr2[5]; - integer i__, refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), moved_( - doublereal *, integer *, doublereal *); - static logical usecn; - doublereal sapos[3]; - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - static logical uselt; - extern doublereal vnorm_(doublereal *), clight_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - stlabx_(doublereal *, doublereal *, doublereal *); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - doublereal tstate[6]; - integer maxitr; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - static logical usestl; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time and */ -/* stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of observer's state. */ -/* SOBS I State of observer wrt. solar system barycenter. */ -/* ABCORR I Aberration correction flag. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the observer's state SOBS is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string REF. */ - -/* SOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* SOBS is a 6-vector: the first three components of */ -/* SOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. SOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* The velocity component of STARG is obtained by */ -/* evaluating the target's geometric state at the light */ -/* time corrected epoch, so for aberration-corrected */ -/* states, the velocity is not precisely equal to the */ -/* time derivative of the position. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* 'SPICE(SPKINVALIDOPTION)' is signaled. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error 'SPICE(BADFRAME)' */ -/* is signaled. */ - -/* 3) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." */ - -/* The SPICE Toolkit can correct for two phenomena affecting the */ -/* apparent location of an object: one-way light time (also called */ -/* "planetary aberration") and stellar aberration. Correcting for */ -/* one-way light time is done by computing, given an observer and */ -/* observation epoch, where a target was when the observed photons */ -/* departed the target's location. The vector from the observer to */ -/* this computed target location is called a "light time corrected" */ -/* vector. The light time correction depends on the motion of the */ -/* target, but it is independent of the velocity of the observer */ -/* relative to the solar system barycenter. Relativistic effects */ -/* such as light bending and gravitational delay are not accounted */ -/* for in the light time correction performed by this routine. */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine is non-relativistic. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This requires correction */ -/* of the geometric target position for the effects of light time and */ -/* stellar aberration, but in this case the corrections are computed */ -/* for radiation traveling from the observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* The traditional aberration corrections applicable to observation */ -/* and those applicable to transmission are related in a simple way: */ -/* one may picture the geometry of the "transmission" case by */ -/* imagining the "observation" case running in reverse time order, */ -/* and vice versa. */ - -/* One may reasonably object to using the term "observer" in the */ -/* transmission case, in which radiation is emitted from the */ -/* observer's location. The terminology was retained for */ -/* consistency with earlier documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation: */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target: */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file: */ - -/* Use 'NONE'. */ - - -/* 4) Compute the apparent position of a target body relative */ -/* to a star or other distant object: */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical: */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations: */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - - -/* Geometric case */ -/* ============== */ - -/* ZZSPKAP0 begins by computing the geometric position T(ET) of */ -/* the target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */ -/* selected, ZZSPKAP0 computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* RHS of the light-time equation (1) yields the "one-iteration" */ -/* estimate of the one-way light time. Repeating the process */ -/* until the estimates of LT converge yields the "converged */ -/* Newtonian" light time estimate. */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of */ -/* the target and observer relative to the solar system */ -/* barycenter at the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* The velocity component of the output state STARG is */ -/* not corrected for stellar aberration. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */ -/* selected, ZZSPKAP0 computes the position of the target body T */ -/* at epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* is the difference */ - -/* T_vel(ET+LT) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of */ -/* the target and observer relative to the solar system */ -/* barycenter at the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - -/* The velocity component of the output state STARG is */ -/* not corrected for stellar aberration. */ - -/* Neither special nor general relativistic effects are accounted */ -/* for in the aberration corrections performed by this routine. */ - -/* $ Examples */ - -/* In the following code fragment, ZZSPKSB0 and ZZSPKAP0 are used */ -/* to display the position of Io (body 501) as seen from the */ -/* Voyager 2 spacecraft (Body -32) at a series of epochs. */ - -/* Normally, one would call the high-level reader SPKEZR to obtain */ -/* state vectors. The example below illustrates the interface */ -/* of this routine but is not intended as a recommendation on */ -/* how to use the SPICE SPK subsystem. */ - -/* The use of integer ID codes is necessitated by the low-level */ -/* interface of this routine. */ - -/* IO = 501 */ -/* VGR2 = -32 */ - -/* DO WHILE ( EPOCH .LE. END ) */ - -/* CALL ZZSPKSB0 ( VGR2, EPOCH, 'J2000', STVGR2 ) */ -/* CALL ZZSPKAP0 ( IO, EPOCH, 'J2000', STVGR2, */ -/* . 'LT+S', STIO, LT ) */ - -/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */ -/* WRITE (*,*) RA * DPR(), DEC * DPR() */ - -/* EPOCH = EPOCH + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The kernel files to be used by ZZSPKAP0 must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the input state be relative to an */ -/* inertial reference frame. Non-inertial frames are not */ -/* supported by this routine. */ - -/* 4) In a future version of this routine, the implementation */ -/* of the aberration corrections may be enhanced to improve */ -/* accuracy. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration correction */ -/* apparent state from spk file */ -/* get apparent state */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */ - -/* The routine was modified to support the options 'CN' and */ -/* 'CN+S' aberration corrections. Moreover, diagnostics were */ -/* added to check for reference frames that are not recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */ - -/* In the example program, the calling sequence of ZZSPKAP0 */ -/* was corrected. */ - -/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */ - -/* The local variable CORR was added to eliminate a run-time */ -/* error that occurred when ZZSPKAP0 was determining what */ -/* corrections to apply to the state. If the literal string */ -/* 'LT' was assigned to ABCORR, ZZSPKAP0 attempted to look at */ -/* ABCORR(3:4). Because ABCORR is a passed length argument, its */ -/* length is not guaranteed, and those positions may not exist. */ -/* Searching beyond the bounds of a string resulted in a */ -/* run-time error at NAIF because NAIF compiles SPICELIB using the */ -/* CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */ -/* Also, without the local variable CORR, ZZSPKAP0 would have to */ -/* modify the value of a passed argument, ABCORR. That's a no no. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of flags in the FLAGS array: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKAP0", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - -/* Remove leading and embedded white space from the aberration */ -/* correction flag, then convert to upper case. */ - - cmprss_(" ", &c__0, abcorr, corr2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(corr2, corr, (ftnlen)5, (ftnlen)5); - -/* Locate the flag in our list of flags. */ - - i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5); - if (i__ == 0) { - setmsg_("Requested aberration correction # is not supported.", ( - ftnlen)51); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23); - chkout_("ZZSPKAP0", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction. */ - - xmit = i__ > 5; - uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7; - usestl = i__ > 1 && odd_(&i__); - usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKAP0", (ftnlen)8); - return 0; - } - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Find the geometric state of the target body with respect to the */ -/* solar system barycenter. Subtract the state of the observer */ -/* to get the relative state. Use this to compute the one-way */ -/* light time. */ - - zzspksb0_(targ, et, ref, starg, ref_len); - vsubg_(starg, sobs, &c__6, tstate); - moved_(tstate, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - -/* To correct for light time, find the state of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where he is. */ - - if (uselt) { - maxitr = 1; - } else if (usecn) { - maxitr = 3; - } else { - maxitr = 0; - } - i__1 = maxitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - zzspksb0_(targ, &d__1, ref, starg, ref_len); - vsubg_(starg, sobs, &c__6, tstate); - moved_(tstate, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - } - -/* At this point, STARG contains the light time corrected */ -/* state of the target relative to the observer. */ - -/* If stellar aberration correction is requested, perform it now. */ - -/* Stellar aberration corrections are not applied to the target's */ -/* velocity. */ - - if (usestl) { - if (xmit) { - -/* This is the transmission case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to STARG. */ - - stlabx_(starg, &sobs[3], sapos); - vequ_(sapos, starg); - } else { - -/* This is the reception case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to STARG. */ - - stelab_(starg, &sobs[3], sapos); - vequ_(sapos, starg); - } - } - chkout_("ZZSPKAP0", (ftnlen)8); - return 0; -} /* zzspkap0_ */ - diff --git a/ext/spice/src/cspice/zzspkap1.c b/ext/spice/src/cspice/zzspkap1.c deleted file mode 100644 index a71ecc24f2..0000000000 --- a/ext/spice/src/cspice/zzspkap1.c +++ /dev/null @@ -1,867 +0,0 @@ -/* zzspkap1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__9 = 9; -static integer c__6 = 6; - -/* $Procedure ZZSPKAP1 ( S/P Kernel, apparent state ) */ -/* Subroutine */ int zzspkap1_(integer *targ, doublereal *et, char *ref, - doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, - ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT " - "XLT+S" "XCN " "XCN+S"; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char corr[5]; - extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *, - doublereal *, ftnlen); - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - char corr2[5]; - integer i__, refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), moved_( - doublereal *, integer *, doublereal *); - static logical usecn; - doublereal sapos[3]; - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - static logical uselt; - extern doublereal vnorm_(doublereal *), clight_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - stlabx_(doublereal *, doublereal *, doublereal *); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - doublereal tstate[6]; - integer maxitr; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - static logical usestl; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time and */ -/* stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of observer's state. */ -/* SOBS I State of observer wrt. solar system barycenter. */ -/* ABCORR I Aberration correction flag. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the observer's state SOBS is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string REF. */ - -/* SOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* SOBS is a 6-vector: the first three components of */ -/* SOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. SOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* The velocity component of STARG is obtained by */ -/* evaluating the target's geometric state at the light */ -/* time corrected epoch, so for aberration-corrected */ -/* states, the velocity is not precisely equal to the */ -/* time derivative of the position. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* 'SPICE(SPKINVALIDOPTION)' is signaled. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error 'SPICE(BADFRAME)' */ -/* is signaled. */ - -/* 3) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." */ - -/* The SPICE Toolkit can correct for two phenomena affecting the */ -/* apparent location of an object: one-way light time (also called */ -/* "planetary aberration") and stellar aberration. Correcting for */ -/* one-way light time is done by computing, given an observer and */ -/* observation epoch, where a target was when the observed photons */ -/* departed the target's location. The vector from the observer to */ -/* this computed target location is called a "light time corrected" */ -/* vector. The light time correction depends on the motion of the */ -/* target, but it is independent of the velocity of the observer */ -/* relative to the solar system barycenter. Relativistic effects */ -/* such as light bending and gravitational delay are not accounted */ -/* for in the light time correction performed by this routine. */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine is non-relativistic. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This requires correction */ -/* of the geometric target position for the effects of light time and */ -/* stellar aberration, but in this case the corrections are computed */ -/* for radiation traveling from the observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* The traditional aberration corrections applicable to observation */ -/* and those applicable to transmission are related in a simple way: */ -/* one may picture the geometry of the "transmission" case by */ -/* imagining the "observation" case running in reverse time order, */ -/* and vice versa. */ - -/* One may reasonably object to using the term "observer" in the */ -/* transmission case, in which radiation is emitted from the */ -/* observer's location. The terminology was retained for */ -/* consistency with earlier documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation: */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target: */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file: */ - -/* Use 'NONE'. */ - - -/* 4) Compute the apparent position of a target body relative */ -/* to a star or other distant object: */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical: */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations: */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - - -/* Geometric case */ -/* ============== */ - -/* ZZSPKAP1 begins by computing the geometric position T(ET) of */ -/* the target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */ -/* selected, ZZSPKAP1 computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* RHS of the light-time equation (1) yields the "one-iteration" */ -/* estimate of the one-way light time. Repeating the process */ -/* until the estimates of LT converge yields the "converged */ -/* Newtonian" light time estimate. */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of */ -/* the target and observer relative to the solar system */ -/* barycenter at the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* The velocity component of the output state STARG is */ -/* not corrected for stellar aberration. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */ -/* selected, ZZSPKAP1 computes the position of the target body T */ -/* at epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* is the difference */ - -/* T_vel(ET+LT) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of */ -/* the target and observer relative to the solar system */ -/* barycenter at the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - -/* The velocity component of the output state STARG is */ -/* not corrected for stellar aberration. */ - -/* Neither special nor general relativistic effects are accounted */ -/* for in the aberration corrections performed by this routine. */ - -/* $ Examples */ - -/* In the following code fragment, ZZSPKSB1 and ZZSPKAP1 are used */ -/* to display the position of Io (body 501) as seen from the */ -/* Voyager 2 spacecraft (Body -32) at a series of epochs. */ - -/* Normally, one would call the high-level reader SPKEZR to obtain */ -/* state vectors. The example below illustrates the interface */ -/* of this routine but is not intended as a recommendation on */ -/* how to use the SPICE SPK subsystem. */ - -/* The use of integer ID codes is necessitated by the low-level */ -/* interface of this routine. */ - -/* IO = 501 */ -/* VGR2 = -32 */ - -/* DO WHILE ( EPOCH .LE. END ) */ - -/* CALL ZZSPKSB1 ( VGR2, EPOCH, 'J2000', STVGR2 ) */ -/* CALL ZZSPKAP1 ( IO, EPOCH, 'J2000', STVGR2, */ -/* . 'LT+S', STIO, LT ) */ - -/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */ -/* WRITE (*,*) RA * DPR(), DEC * DPR() */ - -/* EPOCH = EPOCH + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The kernel files to be used by ZZSPKAP1 must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the input state be relative to an */ -/* inertial reference frame. Non-inertial frames are not */ -/* supported by this routine. */ - -/* 4) In a future version of this routine, the implementation */ -/* of the aberration corrections may be enhanced to improve */ -/* accuracy. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration correction */ -/* apparent state from spk file */ -/* get apparent state */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */ - -/* The routine was modified to support the options 'CN' and */ -/* 'CN+S' aberration corrections. Moreover, diagnostics were */ -/* added to check for reference frames that are not recognized */ -/* inertial frames. */ - -/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */ - -/* In the example program, the calling sequence of ZZSPKAP1 */ -/* was corrected. */ - -/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */ - -/* The local variable CORR was added to eliminate a run-time */ -/* error that occurred when ZZSPKAP1 was determining what */ -/* corrections to apply to the state. If the literal string */ -/* 'LT' was assigned to ABCORR, ZZSPKAP1 attempted to look at */ -/* ABCORR(3:4). Because ABCORR is a passed length argument, its */ -/* length is not guaranteed, and those positions may not exist. */ -/* Searching beyond the bounds of a string resulted in a */ -/* run-time error at NAIF because NAIF compiles SPICELIB using the */ -/* CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */ -/* Also, without the local variable CORR, ZZSPKAP1 would have to */ -/* modify the value of a passed argument, ABCORR. That's a no no. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of flags in the FLAGS array: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKAP1", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - -/* Remove leading and embedded white space from the aberration */ -/* correction flag, then convert to upper case. */ - - cmprss_(" ", &c__0, abcorr, corr2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(corr2, corr, (ftnlen)5, (ftnlen)5); - -/* Locate the flag in our list of flags. */ - - i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5); - if (i__ == 0) { - setmsg_("Requested aberration correction # is not supported.", ( - ftnlen)51); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23); - chkout_("ZZSPKAP1", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction. */ - - xmit = i__ > 5; - uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7; - usestl = i__ > 1 && odd_(&i__); - usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKAP1", (ftnlen)8); - return 0; - } - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Find the geometric state of the target body with respect to the */ -/* solar system barycenter. Subtract the state of the observer */ -/* to get the relative state. Use this to compute the one-way */ -/* light time. */ - - zzspksb1_(targ, et, ref, starg, ref_len); - vsubg_(starg, sobs, &c__6, tstate); - moved_(tstate, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - -/* To correct for light time, find the state of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where he is. */ - - if (uselt) { - maxitr = 1; - } else if (usecn) { - maxitr = 3; - } else { - maxitr = 0; - } - i__1 = maxitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - zzspksb1_(targ, &d__1, ref, starg, ref_len); - vsubg_(starg, sobs, &c__6, tstate); - moved_(tstate, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - } - -/* At this point, STARG contains the light time corrected */ -/* state of the target relative to the observer. */ - -/* If stellar aberration correction is requested, perform it now. */ - -/* Stellar aberration corrections are not applied to the target's */ -/* velocity. */ - - if (usestl) { - if (xmit) { - -/* This is the transmission case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to STARG. */ - - stlabx_(starg, &sobs[3], sapos); - vequ_(sapos, starg); - } else { - -/* This is the reception case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to STARG. */ - - stelab_(starg, &sobs[3], sapos); - vequ_(sapos, starg); - } - } - chkout_("ZZSPKAP1", (ftnlen)8); - return 0; -} /* zzspkap1_ */ - diff --git a/ext/spice/src/cspice/zzspkas0.c b/ext/spice/src/cspice/zzspkas0.c deleted file mode 100644 index aebbae1c6b..0000000000 --- a/ext/spice/src/cspice/zzspkas0.c +++ /dev/null @@ -1,827 +0,0 @@ -/* zzspkas0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSPKAS0 ( SPK, apparent state ) */ -/* Subroutine */ int zzspkas0_(integer *targ, doublereal *et, char *ref, char - *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, - doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ), zzspklt0_(integer *, doublereal *, char *, char *, doublereal * - , doublereal *, doublereal *, doublereal *, ftnlen, ftnlen); - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *), zzstelab_( - logical *, doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), zzprscor_(char *, logical *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal pcorr[3]; - static logical uselt; - extern logical failed_(void); - logical attblk[15]; - doublereal dpcorr[3], corvel[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen); - doublereal corpos[3]; - extern logical return_(void); - static logical usestl; - -/* $ Abstract */ - -/* Given the state and acceleration of an observer relative to the */ -/* solar system barycenter, return the state (position and velocity) */ -/* of a target body relative to the observer, optionally corrected */ -/* for light time and stellar aberration. All input and output */ -/* vectors are expressed relative to an inertial reference frame. */ - -/* This routine supersedes SPKAPP. */ - -/* SPICE users normally should call the high-level API routines */ -/* SPKEZR or SPKEZ rather than this routine. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* STOBS I State of the observer relative to the SSB. */ -/* ACCOBS I Acceleration of the observer relative to the SSB. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the input state STOBS, the input acceleration ACCOBS, */ -/* and the output state STARG are expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the header of SPKEZR for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* STOBS is the geometric state of the observer relative to */ -/* the solar system barycenter at ET. STOBS is expressed */ -/* relative to the reference frame designated by REF. */ -/* The target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* ACCOBS is the geometric acceleration of the observer */ -/* relative to the solar system barycenter at ET. This */ -/* is the derivative with respect to time of the */ -/* velocity portion of STOBS. ACCOBS is expressed */ -/* relative to the reference frame designated by REF. */ - -/* ACCOBS is used for computing stellar aberration */ -/* corrected velocity. If stellar aberration corrections */ -/* are not specified by ABCORR, ACCOBS is ignored; the */ -/* caller need not provide a valid input value in this */ -/* case. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the inertial reference frame designated by REF. */ -/* The first three components of STARG represent the x-, */ -/* y- and z-components of the target's position; last */ -/* three components form the corresponding velocity */ -/* vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for light time, then LT is the one-way light time */ -/* between the observer and the light time-corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If ABCORR calls for stellar aberration but not light */ -/* time corrections, the error SPICE(NOTSUPPORTED) is */ -/* signaled. */ - -/* 3) If ABCORR calls for relativistic light time corrections, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 5) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 6) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any such */ -/* kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ - -/* User applications normally will not need to call this routine */ -/* directly. However, this routine can improve run-time efficiency */ -/* in situations where many targets are observed from the same */ -/* location at the same time. In such cases, the state and */ -/* acceleration of the observer relative to the solar system */ -/* barycenter need be computed only once per look-up epoch. */ - -/* When apparent positions, rather than apparent states, are */ -/* required, consider using the high-level position-only API */ -/* routines */ - -/* SPKPOS */ -/* SPKEZP */ - -/* or the low-level, position-only analog of this routine */ - -/* SPKAPO */ - -/* In general, the position-only routines are more efficient. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time and stellar aberration corrections. */ -/* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ -/* compute subsequent states at intervals of 1 hour. For each */ -/* epoch, display the states, the one way light time between */ -/* target and observer, and the rate of change of the one way */ -/* light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ACC ( 3 ) */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STATE0 ( 6 ) */ -/* DOUBLE PRECISION STATE2 ( 6 ) */ -/* DOUBLE PRECISION STOBS ( 6 ) */ -/* DOUBLE PRECISION TDELTA */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time and stellar */ -/* C aberration ('LT+S') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ -/* C Before we can execute this computation, we'll need the */ -/* C geometric state and accleration of the observer relative */ -/* C to the solar system barycenter at ET, expressed */ -/* C relative to the J2000 reference frame. First find */ -/* C the state: */ -/* C */ -/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ -/* C */ -/* C Next compute the acceleration. We numerically */ -/* C differentiate the velocity using a quadratic */ -/* C approximation: */ -/* C */ -/* TDELTA = 1.D0 */ - -/* CALL SPKSSB ( 399, ET-TDELTA, 'J2000', STATE0 ) */ -/* CALL SPKSSB ( 399, ET+TDELTA, 'J2000', STATE2 ) */ - -/* CALL QDERIV ( 3, STATE0(4), STATE2(4), TDELTA, ACC ) */ -/* C */ -/* C Now compute the desired state vector: */ -/* C */ -/* CALL SPKAPS ( 301, ET, 'J2000', 'LT+S', */ -/* . STOBS, ACC, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291584.614 */ -/* J2000 y-position (km): -266693.406 */ -/* J2000 z-position (km): -76095.6532 */ -/* J2000 x-velocity (km/s): 0.643439157 */ -/* J2000 y-velocity (km/s): -0.666065874 */ -/* J2000 z-velocity (km/s): -0.301310063 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289256.459 */ -/* J2000 y-position (km): -269080.605 */ -/* J2000 z-position (km): -77177.3528 */ -/* J2000 x-velocity (km/s): 0.64997032 */ -/* J2000 y-velocity (km/s): -0.660148253 */ -/* J2000 z-velocity (km/s): -0.299630418 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286904.897 */ -/* J2000 y-position (km): -271446.417 */ -/* J2000 z-position (km): -78252.9655 */ -/* J2000 x-velocity (km/s): 0.656443883 */ -/* J2000 y-velocity (km/s): -0.654183552 */ -/* J2000 z-velocity (km/s): -0.297928533 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284530.133 */ -/* J2000 y-position (km): -273790.671 */ -/* J2000 z-position (km): -79322.4117 */ -/* J2000 x-velocity (km/s): 0.662859505 */ -/* J2000 y-velocity (km/s): -0.648172247 */ -/* J2000 z-velocity (km/s): -0.296204558 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282132.378 */ -/* J2000 y-position (km): -276113.202 */ -/* J2000 z-position (km): -80385.612 */ -/* J2000 x-velocity (km/s): 0.669216846 */ -/* J2000 y-velocity (km/s): -0.642114815 */ -/* J2000 z-velocity (km/s): -0.294458645 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) This routine should not be used to compute geometric states. */ -/* Instead, use SPKEZR, SPKEZ, or SPKGEO. SPKGEO, which is called */ -/* by SPKEZR and SPKEZ, introduces less round-off error when the */ -/* observer and target have a common center that is closer to */ -/* both objects than is the solar system barycenter. */ - -/* 2) The kernel files to be used by SPKAPS must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration-corrected state computation */ -/* low-level light time and stellar aberration correction */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKAS0", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKAS0", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usestl = attblk[2]; - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKAS0", (ftnlen)8); - return 0; - } else if (attblk[5]) { - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKAS0", (ftnlen)8); - return 0; - } - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKAS0", (ftnlen)8); - return 0; - } - -/* Get the state of the target relative to the observer, */ -/* optionally corrected for light time. */ - - zzspklt0_(targ, et, ref, abcorr, stobs, starg, lt, dlt, ref_len, - abcorr_len); - -/* If stellar aberration corrections are not needed, we're */ -/* already done. */ - - if (! usestl) { - chkout_("ZZSPKAS0", (ftnlen)8); - return 0; - } - -/* Get the stellar aberration correction and its time derivative. */ - - zzstelab_(&xmit, accobs, &stobs[3], starg, pcorr, dpcorr); - -/* Adding the stellar aberration correction to the light */ -/* time-corrected target position yields the position corrected for */ -/* both light time and stellar aberration. */ - - vadd_(pcorr, starg, corpos); - vequ_(corpos, starg); - -/* Velocity is treated in an analogous manner. */ - - vadd_(dpcorr, &starg[3], corvel); - vequ_(corvel, &starg[3]); - chkout_("ZZSPKAS0", (ftnlen)8); - return 0; -} /* zzspkas0_ */ - diff --git a/ext/spice/src/cspice/zzspkas1.c b/ext/spice/src/cspice/zzspkas1.c deleted file mode 100644 index 94ac29061c..0000000000 --- a/ext/spice/src/cspice/zzspkas1.c +++ /dev/null @@ -1,828 +0,0 @@ -/* zzspkas1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSPKAS1 ( SPK, apparent state ) */ -/* Subroutine */ int zzspkas1_(integer *targ, doublereal *et, char *ref, char - *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, - doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - static logical xmit; - extern /* Subroutine */ int zzspklt1_(integer *, doublereal *, char *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - ftnlen, ftnlen), zzstelab_(logical *, doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *), zzprscor_(char *, - logical *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - doublereal pcorr[3]; - static logical uselt; - extern logical failed_(void); - logical attblk[15]; - doublereal dpcorr[3], corvel[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, - ftnlen); - doublereal corpos[3]; - extern logical return_(void); - static logical usestl; - -/* $ Abstract */ - -/* Given the state and acceleration of an observer relative to the */ -/* solar system barycenter, return the state (position and velocity) */ -/* of a target body relative to the observer, optionally corrected */ -/* for light time and stellar aberration. All input and output */ -/* vectors are expressed relative to an inertial reference frame. */ - -/* This routine supersedes SPKAPP. */ - -/* SPICE users normally should call the high-level API routines */ -/* SPKEZR or SPKEZ rather than this routine. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* STOBS I State of the observer relative to the SSB. */ -/* ACCOBS I Acceleration of the observer relative to the SSB. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the input state STOBS, the input acceleration ACCOBS, */ -/* and the output state STARG are expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the header of SPKEZR for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* STOBS is the geometric state of the observer relative to */ -/* the solar system barycenter at ET. STOBS is expressed */ -/* relative to the reference frame designated by REF. */ -/* The target and observer define a state vector whose */ -/* position component points from the observer to the */ -/* target. */ - -/* ACCOBS is the geometric acceleration of the observer */ -/* relative to the solar system barycenter at ET. This */ -/* is the derivative with respect to time of the */ -/* velocity portion of STOBS. ACCOBS is expressed */ -/* relative to the reference frame designated by REF. */ - -/* ACCOBS is used for computing stellar aberration */ -/* corrected velocity. If stellar aberration corrections */ -/* are not specified by ABCORR, ACCOBS is ignored; the */ -/* caller need not provide a valid input value in this */ -/* case. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the inertial reference frame designated by REF. */ -/* The first three components of STARG represent the x-, */ -/* y- and z-components of the target's position; last */ -/* three components form the corresponding velocity */ -/* vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for light time, then LT is the one-way light time */ -/* between the observer and the light time-corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 2) If ABCORR calls for stellar aberration but not light */ -/* time corrections, the error SPICE(NOTSUPPORTED) is */ -/* signaled. */ - -/* 3) If ABCORR calls for relativistic light time corrections, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 5) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 6) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any such */ -/* kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ - -/* User applications normally will not need to call this routine */ -/* directly. However, this routine can improve run-time efficiency */ -/* in situations where many targets are observed from the same */ -/* location at the same time. In such cases, the state and */ -/* acceleration of the observer relative to the solar system */ -/* barycenter need be computed only once per look-up epoch. */ - -/* When apparent positions, rather than apparent states, are */ -/* required, consider using the high-level position-only API */ -/* routines */ - -/* SPKPOS */ -/* SPKEZP */ - -/* or the low-level, position-only analog of this routine */ - -/* SPKAPO */ - -/* In general, the position-only routines are more efficient. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time and stellar aberration corrections. */ -/* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ -/* compute subsequent states at intervals of 1 hour. For each */ -/* epoch, display the states, the one way light time between */ -/* target and observer, and the rate of change of the one way */ -/* light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ACC ( 3 ) */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STATE0 ( 6 ) */ -/* DOUBLE PRECISION STATE2 ( 6 ) */ -/* DOUBLE PRECISION STOBS ( 6 ) */ -/* DOUBLE PRECISION TDELTA */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time and stellar */ -/* C aberration ('LT+S') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ -/* C Before we can execute this computation, we'll need the */ -/* C geometric state and accleration of the observer relative */ -/* C to the solar system barycenter at ET, expressed */ -/* C relative to the J2000 reference frame. First find */ -/* C the state: */ -/* C */ -/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ -/* C */ -/* C Next compute the acceleration. We numerically */ -/* C differentiate the velocity using a quadratic */ -/* C approximation: */ -/* C */ -/* TDELTA = 1.D0 */ - -/* CALL SPKSSB ( 399, ET-TDELTA, 'J2000', STATE0 ) */ -/* CALL SPKSSB ( 399, ET+TDELTA, 'J2000', STATE2 ) */ - -/* CALL QDERIV ( 3, STATE0(4), STATE2(4), TDELTA, ACC ) */ -/* C */ -/* C Now compute the desired state vector: */ -/* C */ -/* CALL SPKAPS ( 301, ET, 'J2000', 'LT+S', */ -/* . STOBS, ACC, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291584.614 */ -/* J2000 y-position (km): -266693.406 */ -/* J2000 z-position (km): -76095.6532 */ -/* J2000 x-velocity (km/s): 0.643439157 */ -/* J2000 y-velocity (km/s): -0.666065874 */ -/* J2000 z-velocity (km/s): -0.301310063 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289256.459 */ -/* J2000 y-position (km): -269080.605 */ -/* J2000 z-position (km): -77177.3528 */ -/* J2000 x-velocity (km/s): 0.64997032 */ -/* J2000 y-velocity (km/s): -0.660148253 */ -/* J2000 z-velocity (km/s): -0.299630418 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286904.897 */ -/* J2000 y-position (km): -271446.417 */ -/* J2000 z-position (km): -78252.9655 */ -/* J2000 x-velocity (km/s): 0.656443883 */ -/* J2000 y-velocity (km/s): -0.654183552 */ -/* J2000 z-velocity (km/s): -0.297928533 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284530.133 */ -/* J2000 y-position (km): -273790.671 */ -/* J2000 z-position (km): -79322.4117 */ -/* J2000 x-velocity (km/s): 0.662859505 */ -/* J2000 y-velocity (km/s): -0.648172247 */ -/* J2000 z-velocity (km/s): -0.296204558 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282132.378 */ -/* J2000 y-position (km): -276113.202 */ -/* J2000 z-position (km): -80385.612 */ -/* J2000 x-velocity (km/s): 0.669216846 */ -/* J2000 y-velocity (km/s): -0.642114815 */ -/* J2000 z-velocity (km/s): -0.294458645 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) This routine should not be used to compute geometric states. */ -/* Instead, use SPKEZR, SPKEZ, or SPKGEO. SPKGEO, which is called */ -/* by SPKEZR and SPKEZ, introduces less round-off error when the */ -/* observer and target have a common center that is closer to */ -/* both objects than is the solar system barycenter. */ - -/* 2) The kernel files to be used by SPKAPS must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level aberration-corrected state computation */ -/* low-level light time and stellar aberration correction */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKAS1", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKAS1", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usestl = attblk[2]; - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKAS1", (ftnlen)8); - return 0; - } else if (attblk[5]) { - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKAS1", (ftnlen)8); - return 0; - } - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKAS1", (ftnlen)8); - return 0; - } - -/* Get the state of the target relative to the observer, */ -/* optionally corrected for light time. */ - - zzspklt1_(targ, et, ref, abcorr, stobs, starg, lt, dlt, ref_len, - abcorr_len); - -/* If stellar aberration corrections are not needed, we're */ -/* already done. */ - - if (! usestl) { - chkout_("ZZSPKAS1", (ftnlen)8); - return 0; - } - -/* Get the stellar aberration correction and its time derivative. */ - - zzstelab_(&xmit, accobs, &stobs[3], starg, pcorr, dpcorr); - -/* Adding the stellar aberration correction to the light */ -/* time-corrected target position yields the position corrected for */ -/* both light time and stellar aberration. */ - - vadd_(pcorr, starg, corpos); - vequ_(corpos, starg); - -/* Velocity is treated in an analogous manner. */ - - vadd_(dpcorr, &starg[3], corvel); - vequ_(corvel, &starg[3]); - chkout_("ZZSPKAS1", (ftnlen)8); - return 0; -} /* zzspkas1_ */ - diff --git a/ext/spice/src/cspice/zzspkez0.c b/ext/spice/src/cspice/zzspkez0.c deleted file mode 100644 index 19d4b6575e..0000000000 --- a/ext/spice/src/cspice/zzspkez0.c +++ /dev/null @@ -1,1416 +0,0 @@ -/* zzspkez0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure ZZSPKEZ0 ( S/P Kernel, easy reader ) */ -/* Subroutine */ int zzspkez0_(integer *targ, doublereal *et, char *ref, char - *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen - ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer fj2000; - extern /* Subroutine */ int zzfrmch0_(integer *, integer *, doublereal *, - doublereal *), zzspkac0_(integer *, doublereal *, char *, char *, - integer *, doublereal *, doublereal *, doublereal *, ftnlen, - ftnlen); - static doublereal temp[6]; - extern /* Subroutine */ int zzspkgo0_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), zzspksb0_(integer - *, doublereal *, char *, doublereal *, ftnlen), zzspklt0_(integer - *, doublereal *, char *, char *, doublereal *, doublereal *, - doublereal *, doublereal *, ftnlen, ftnlen); - static integer type__; - static logical xmit; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - static integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical found; - static doublereal state[6], stobs[6], xform[36] /* was [6][6] */; - extern logical failed_(void); - static integer center; - static logical attblk[15]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - static logical usegeo; - static doublereal ltcent, dltctr; - static integer reqfrm, typeid, ltsign; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), sigerr_(char *, ftnlen), vsclip_(doublereal *, - doublereal *); - extern logical return_(void); - static doublereal dlt; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observing body, optionally corrected for light */ -/* time (planetary aberration) and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output state vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output state vector should be expressed. This may */ -/* be any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. */ -/* See the description of the output state vector STARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the NAIF ID code for an observing body. */ - - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the reference frame specified by REF. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; the last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* The velocity component of STARG is the derivative */ -/* with respect to time of the position component of */ -/* STARG. */ - -/* Units are always km and km/sec. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 2) If the loaded kernels provide insufficient data to */ -/* compute the requested state vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 3) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output state STARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute STARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the state. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve state information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations. */ - -/* Use 'NONE', then apply relativistic aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* SPKEZ begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, SPKEZ computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT)*(1-dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* When stellar aberration corrections are used, the rate of */ -/* change of the stellar aberration correction is accounted for */ -/* in the computation of the output velocity. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, SPKEZ computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* consists of the difference */ - -/* T_vel(ET+LT)*(1+dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. Velocities are adjusted to account */ -/* for the rate of change of the stellar aberration correction. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK; then look up a series of */ -/* geometric states of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* C */ -/* C The NAIF IDs of the earth and moon are 399 and 301 */ -/* C respectively. */ -/* C */ -/* INTEGER OBSRVR */ -/* PARAMETER ( OBSRVR = 399 ) */ - -/* INTEGER TARGET */ -/* PARAMETER ( TARGET = 301 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL SPKEZ ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . STATE, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.0.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" markers from text blocks in the header. */ - -/* - SPICELIB Version 5.0.0, 27-DEC-2007 (NJB) */ - -/* This routine was upgraded to more accurately compute */ -/* aberration-corrected velocity, and in particular, make it */ -/* more consistent with observer-target positions. */ - -/* When light time corrections are used, the derivative of light */ -/* time with respect to time is now accounted for in the */ -/* computation of observer-target velocities. When the reference */ -/* frame associated with the output state is time-dependent, the */ -/* derivative of light time with respect to time is now accounted */ -/* for in the computation of the rate of change of orientation of */ -/* the reference frame. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ -/* Minor header error was corrected. */ - -/* - SPICELIB Version 4.0.2, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 4.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 3.0.0, 26-MAY-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial frames. */ - -/* - SPICELIB Version 2.1.1, 5-AUG-1994 (HAN) (MJS) */ - -/* Added code so that routine accepts lower case, mixed case */ -/* and upper case versions of the string ABCORR. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 18-JUL-1991 (JEM) (NJB) */ - -/* The old SPKEZ did not compute the geometric state of one body */ -/* with respect to another unless data existed for each body with */ -/* respect to the solar system barycenter. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* easy reader for spk file */ -/* get state relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.0.0, 22-JUL-2007 (NJB) */ - -/* Routine was upgraded to more accurately compute aberration- */ -/* corrected velocity, and in particular, make it more consistent */ -/* with observer-target positions. When light time corrections */ -/* are used: */ - -/* 1) The derivative of light time with respect */ -/* to time is now accounted for in the computation */ -/* of observer-target velocities, for all types */ -/* of reference frames. */ - -/* 2) The derivative of light time with respect */ -/* to time is now accounted for in the computation of the */ -/* rate of change of orientation of time-dependent */ -/* reference frames for the output state. This rate of */ -/* change affects observer-target velocities. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - -/* This routine was modified as follows: */ - -/* - SPKAPP is no longer called; it has been superseded */ -/* by SPKACS. Aberration-corrected states relative to */ -/* inertial frames are computed by SPKACS. */ - -/* - The effect of the rate of change of light time on the */ -/* rate of change of orientation of non-inertial output */ -/* frames is accounted for in this routine. See the code */ -/* near the end of this source file. */ - -/* The header of this routine has been updated to reflect the */ -/* upgrades described here. */ - -/* As a separate upgrade, the method by which the aberration */ -/* correction flag is parsed has been made more robust: parsing */ -/* is now done by the routine ZZZPRSCOR. The new parsing */ -/* technique calls for parsing the input string only when it */ -/* differs from the previous value. */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. The new checks */ -/* are intended to prevent arithmetic operations from */ -/* being performed with uninitialized or invalid data. */ - -/* Minor header error was corrected. */ - -/* - SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 3.0.0, 26-MAY-1995 (WLT) */ - -/* The routine was upgraded so that it can now support */ -/* non-inertial reference frames. In additions some */ -/* of the error messages were slightly enhanced. */ - -/* - SPICELIB Version 2.1.1, 5-AUG-1994 (HAN) (MJS) */ - -/* Added code so that routine accepts lower case, mixed case */ -/* and upper case versions of the string ABCORR. */ - -/* - SPICELIB Version 2.0.0, 18-JUL-1991 (JEM) (NJB) */ - -/* The previous version of SPKEZ could not */ -/* compute the geometric state (no aberration */ -/* correction) of one body with respect to */ -/* another if the ephemeris data for each */ -/* body relative to the Solar System Barycenter */ -/* (body 0) had not been loaded. Now, if */ -/* sufficient data is loaded, SPKEZ can always */ -/* compute the state. */ - -/* For example, suppose the file GLL.BSP contains */ -/* segments of SPK data for the Galileo spacecraft */ -/* (body -77) relative to the Jupiter Barycenter */ -/* (body 5) over a period of time. If SPKEZ Version */ -/* 1.0.0 was called to compute the geometric state of */ -/* -77 relative to 5 (or vice versa), a routine that */ -/* SPKEZ calls, SPKSSB, would signal an error stating */ -/* that there is insufficient data for computing the */ -/* state of body 5 (relative to 0). Version 1.0.0 */ -/* of SPKEZ could not compute the requested state even */ -/* though sufficient data had been loaded. */ - -/* It is necessary to compute the states of each */ -/* of the target and observing bodies relative to */ -/* the solar system barycenter when aberration */ -/* corrections are being applied. However, when */ -/* computing geometric states, it is only necessary */ -/* to trace back to the first common node. Positive */ -/* side effects include the maintenance of precision */ -/* and reduction in number of look ups. */ - -/* The changes to the code in SPKEZ involved calling a new */ -/* routine, SPKGEO, which computes the geometric state if */ -/* no aberration corrections are requested. */ - -/* The other cosmetic changes include the removal of a reference */ -/* to the SPK User's Guide in Literature_References because */ -/* the User's Guide is the same as SPK Required Reading. */ - -/* Also, the item in Restrictions previously said */ - -/* 1) The ephemeris files to be used by SPKEZ must be loaded */ -/* by SPKLEF before SPKSSB is called. */ - -/* SPKSSB was replaced with SPKEZ. */ - -/* The location of the position and velocity information in the */ -/* output state vector argument STARG is now spelled out. */ - -/* Finally, the Particulars section was updated. In Version */ -/* 1.0.0 it said that calling SPKEZ was equivalent to calling */ -/* SPKSSB and SPKAPP. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKEZ0", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - usegeo = attblk[0]; - -/* Get the frame ID for J2000 on the first call to this routine. */ - - if (first) { - namfrm_("J2000", &fj2000, (ftnlen)5); - first = FALSE_; - } - } - -/* If we only want a geometric state, then use SPKGEO to compute */ -/* just that. */ - -/* Otherwise, if REF is inertial, compute the state of the target */ -/* relative to the observer via SPKACS. If REF is non-inertial, */ -/* compute the requested state in the J2000 frame, then transform it */ -/* to the frame designated by REF. */ - - if (usegeo) { - zzspkgo0_(targ, et, ref, obs, starg, lt, ref_len); - } else { - -/* Get the auxiliary information about the requested output */ -/* frame. */ - - namfrm_(ref, &reqfrm, ref_len); - if (reqfrm == 0) { - setmsg_("The requested output frame '#' is not recognized by the" - " reference frame subsystem. Please check that the approp" - "riate kernels have been loaded and that you have correct" - "ly entered the name of the output frame. ", (ftnlen)208); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; - } - frinfo_(&reqfrm, ¢er, &type__, &typeid, &found); - -/* If we are dealing with an inertial frame, we can simply */ -/* call SPKACS and return. */ - - if (type__ == 1) { - zzspkac0_(targ, et, ref, abcorr, obs, starg, lt, &dlt, ref_len, - abcorr_len); - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; - } - -/* Still here? */ - -/* We are dealing with a non-inertial frame. But we need to do */ -/* light time and stellar aberration corrections in an inertial */ -/* frame. Get the "apparent" state of TARG in the intermediary */ -/* inertial reference frame J2000. */ - -/* We also need the light time to the center of the frame. */ -/* We compute that first so that we can re-use the temporary */ -/* variable STATE when we compute the inertial apparent state */ -/* of the target relative to the observer. */ - - zzspkac0_(targ, et, "J2000", abcorr, obs, state, lt, &dlt, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; - } - if (center == *obs) { - ltcent = 0.; - dltctr = 0.; - } else if (center == *targ) { - ltcent = *lt; - dltctr = dlt; - } else { - zzspksb0_(obs, et, "J2000", stobs, (ftnlen)5); - zzspklt0_(¢er, et, "J2000", abcorr, stobs, temp, <cent, & - dltctr, (ftnlen)5, abcorr_len); - } - -/* If something went wrong (like we couldn't get the state of */ -/* the center relative to the observer) now it is time to quit. */ - - if (failed_()) { - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; - } - -/* If the aberration corrections are for transmission, make the */ -/* sign of the light time positive, since we wish to compute the */ -/* orientation of the non-inertial frame at an epoch later than */ -/* ET by the one-way light time. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Get the state transformation from J2000 to the requested frame */ -/* and convert the state. */ - - d__1 = *et + ltsign * ltcent; - zzfrmch0_(&fj2000, &reqfrm, &d__1, xform); - if (failed_()) { - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; - } - -/* There's a tricky bit here: since XFORM is evaluated */ -/* at time */ - -/* ET + LTSIGN*LTCENT */ - -/* XFORM is actually dependent on LTCENT. We need to account for */ -/* this dependency in our velocity transformation. */ - -/* Let P and V be the target position and velocity respectively, */ -/* and R, DR be the rotation and rotation derivative */ -/* corresponding to XFORM. */ - -/* The state transformation we need to perform is not */ - -/* R * V + DR * P */ - -/* but rather */ - -/* R * V + ( (1 + LTSIGN*DLTCTR) * DR ) * P */ - -/* So we'll scale the derivative block of XFORM accordingly. */ - - for (i__ = 1; i__ <= 3; ++i__) { - d__1 = ltsign * dltctr + 1.; - vsclip_(&d__1, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzspkez0_", (ftnlen)1242)]); - } - -/* Now apply the frame transformation XFORM to produce the */ -/* state expressed relative to the request frame REQFRM. */ - - mxvg_(xform, state, &c__6, &c__6, starg); - } - chkout_("ZZSPKEZ0", (ftnlen)8); - return 0; -} /* zzspkez0_ */ - diff --git a/ext/spice/src/cspice/zzspkez1.c b/ext/spice/src/cspice/zzspkez1.c deleted file mode 100644 index ce7034cd12..0000000000 --- a/ext/spice/src/cspice/zzspkez1.c +++ /dev/null @@ -1,1432 +0,0 @@ -/* zzspkez1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure ZZSPKEZ1 ( S/P Kernel, easy reader ) */ -/* Subroutine */ int zzspkez1_(integer *targ, doublereal *et, char *ref, char - *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen - ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer fj2000; - extern /* Subroutine */ int zzfrmch1_(integer *, integer *, doublereal *, - doublereal *), zzspkac1_(integer *, doublereal *, char *, char *, - integer *, doublereal *, doublereal *, doublereal *, ftnlen, - ftnlen); - static doublereal temp[6]; - extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *, - doublereal *, ftnlen), zzspkgo1_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen); - static integer type__; - static logical xmit; - extern /* Subroutine */ int zzspklt1_(integer *, doublereal *, char *, - char *, doublereal *, doublereal *, doublereal *, doublereal *, - ftnlen, ftnlen), mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - static integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical found; - static doublereal state[6], stobs[6], xform[36] /* was [6][6] */; - extern logical failed_(void); - static integer center; - static logical attblk[15]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - static logical usegeo; - static doublereal ltcent, dltctr; - static integer reqfrm, typeid, ltsign; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), sigerr_(char *, ftnlen), vsclip_(doublereal *, - doublereal *); - extern logical return_(void); - static doublereal dlt; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observing body, optionally corrected for light */ -/* time (planetary aberration) and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output state vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past J2000 */ -/* TDB, at which the state of the target body relative to */ -/* the observer is to be computed. ET refers to time at */ -/* the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output state vector should be expressed. This may */ -/* be any frame supported by the SPICE system, including */ -/* built-in frames (documented in the Frames Required */ -/* Reading) and frames defined by a loaded frame kernel */ -/* (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. */ -/* See the description of the output state vector STARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied */ -/* to the state of the target body to account for one-way */ -/* light time and stellar aberration. See the discussion */ -/* in the Particulars section for recommendations on */ -/* how to choose aberration corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* state obtained with the 'LT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* state of the target---the position and */ -/* velocity of the target as seen by the */ -/* observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* state obtained with the 'XLT' option to */ -/* account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target state indicates the */ -/* direction that photons emitted from the */ -/* observer's location must be "aimed" to */ -/* hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the NAIF ID code for an observing body. */ - - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberrations, and is expressed with respect */ -/* to the reference frame specified by REF. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; the last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for aberrations, then LT is the one-way light time */ -/* between the observer and the light time corrected */ -/* target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 2) If the loaded kernels provide insufficient data to */ -/* compute the requested state vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 3) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 4) If the reference frame REF is dynamic, the error */ -/* SPICE(RECURSIONTOODEEP) will be signaled. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output state STARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute STARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the state. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve state information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected state vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - - -/* 5) Use a geometric state vector as a low-accuracy estimate */ -/* of the apparent state for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute states */ -/* with the highest possible accuracy, it can supply the */ -/* geometric states required as inputs to these computations. */ - -/* Use 'NONE', then apply relativistic aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* SPKEZ begins by computing the geometric position T(ET) of the */ -/* target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned state consists of the position vector */ - -/* T(ET) - O(ET) */ - -/* and a velocity obtained by taking the difference of the */ -/* corresponding velocities. In the geometric case, the */ -/* returned velocity is actually the time derivative of the */ -/* position. */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, SPKEZ computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */ -/* O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The position component of the light time corrected state */ -/* is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* The velocity component of the light time corrected state */ -/* is the difference */ - -/* T_vel(ET-LT)*(1-dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET-LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - -/* When stellar aberration corrections are used, the rate of */ -/* change of the stellar aberration correction is accounted for */ -/* in the computation of the output velocity. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, SPKEZ computes the position of the target body T at */ -/* epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The position component of the light-time corrected state */ -/* is the vector */ - -/* T(ET+LT) - O(ET) */ - -/* The velocity component of the light-time corrected state */ -/* consists of the difference */ - -/* T_vel(ET+LT)*(1+dLT/dET) - O_vel(ET) */ - -/* where T_vel and O_vel are, respectively, the velocities of the */ -/* target and observer relative to the solar system barycenter at */ -/* the epochs ET+LT and ET. */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. Velocities are adjusted to account */ -/* for the rate of change of the stellar aberration correction. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK; then look up a series of */ -/* geometric states of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* C */ -/* C The NAIF IDs of the earth and moon are 399 and 301 */ -/* C respectively. */ -/* C */ -/* INTEGER OBSRVR */ -/* PARAMETER ( OBSRVR = 399 ) */ - -/* INTEGER TARGET */ -/* PARAMETER ( TARGET = 301 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL SPKEZ ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . STATE, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* W.L. Taber (JPL) */ -/* N.J. Bachman (JPL) */ -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 5.0.1, 18-MAY-2010 (BVS) */ - -/* Removed "C$" markers from text blocks in the header. */ - -/* - SPICELIB Version 5.0.0, 23-JUL-2007 (NJB) */ - -/* Routine was upgraded to more accurately compute aberration- */ -/* corrected velocity, and in particular, make it more consistent */ -/* with observer-target positions. When light time corrections */ -/* are used: */ - -/* 1) The derivative of light time with respect */ -/* to time is now accounted for in the computation */ -/* of observer-target velocities, for all types */ -/* of reference frames. */ - -/* 2) The derivative of light time with respect */ -/* to time is now accounted for in the computation of the */ -/* rate of change of orientation of time-dependent */ -/* reference frames for the output state. This rate of */ -/* change affects observer-target velocities. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. */ -/* Minor header error was corrected. */ - -/* - SPICELIB Version 4.0.2, 20-OCT-2003 (EDW) */ - -/* Added mention that LT returns in seconds. */ - -/* - SPICELIB Version 4.0.1, 29-JUL-2003 (NJB) (CHA) */ - -/* Various minor header changes were made to improve clarity. */ - -/* - SPICELIB Version 4.0.0, 28-DEC-2001 (NJB) */ - -/* Updated to handle aberration corrections for transmission */ -/* of radiation. Formerly, only the reception case was */ -/* supported. The header was revised and expanded to explain */ -/* the functionality of this routine in more detail. */ - -/* - SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 3.0.0, 26-MAY-1995 (WLT) */ - -/* The routine was upgraded to support non-inertial frames. */ - -/* - SPICELIB Version 2.1.1, 5-AUG-1994 (HAN) (MJS) */ - -/* Added code so that routine accepts lower case, mixed case */ -/* and upper case versions of the string ABCORR. */ - -/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - SPICELIB Version 2.0.0, 18-JUL-1991 (JEM) (NJB) */ - -/* The old SPKEZ did not compute the geometric state of one body */ -/* with respect to another unless data existed for each body with */ -/* respect to the solar system barycenter. */ - -/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ - -/* Literature references added to the header. */ - -/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* easy reader for spk file */ -/* get state relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 5.0.0, 22-JUL-2007 (NJB) */ - -/* Routine was upgraded to more accurately compute aberration- */ -/* corrected velocity, and in particular, make it more consistent */ -/* with observer-target positions. When light time corrections */ -/* are used: */ - -/* 1) The derivative of light time with respect */ -/* to time is now accounted for in the computation */ -/* of observer-target velocities, for all types */ -/* of reference frames. */ - -/* 2) The derivative of light time with respect */ -/* to time is now accounted for in the computation of the */ -/* rate of change of orientation of time-dependent */ -/* reference frames for the output state. This rate of */ -/* change affects observer-target velocities. */ - -/* When stellar aberration corrections are used, velocities */ -/* now reflect the rate of range of the stellar aberration */ -/* correction. */ - -/* This routine was modified as follows: */ - -/* - SPKAPP is no longer called; it has been superseded */ -/* by SPKACS. Aberration-corrected states relative to */ -/* inertial frames are computed by SPKACS. */ - -/* - The effect of the rate of change of light time on the */ -/* rate of change of orientation of non-inertial output */ -/* frames is accounted for in this routine. See the code */ -/* near the end of this source file. */ - -/* The header of this routine has been updated to reflect the */ -/* upgrades described here. */ - -/* As a separate upgrade, the method by which the aberration */ -/* correction flag is parsed has been made more robust: parsing */ -/* is now done by the routine ZZZPRSCOR. The new parsing */ -/* technique calls for parsing the input string only when it */ -/* differs from the previous value. */ - -/* - SPICELIB Version 4.1.0, 05-JAN-2005 (NJB) */ - -/* Tests of routine FAILED() were added. The new checks */ -/* are intended to prevent arithmetic operations from */ -/* being performed with uninitialized or invalid data. */ - -/* Minor header error was corrected. */ - -/* - SPICELIB Version 3.1.0, 09-JUL-1996 (WLT) */ - -/* Corrected the description of LT in the Detailed Output */ -/* section of the header. */ - -/* - SPICELIB Version 3.0.0, 26-MAY-1995 (WLT) */ - -/* The routine was upgraded so that it can now support */ -/* non-inertial reference frames. In additions some */ -/* of the error messages were slightly enhanced. */ - -/* - SPICELIB Version 2.1.1, 5-AUG-1994 (HAN) (MJS) */ - -/* Added code so that routine accepts lower case, mixed case */ -/* and upper case versions of the string ABCORR. */ - -/* - SPICELIB Version 2.0.0, 18-JUL-1991 (JEM) (NJB) */ - -/* The previous version of SPKEZ could not */ -/* compute the geometric state (no aberration */ -/* correction) of one body with respect to */ -/* another if the ephemeris data for each */ -/* body relative to the Solar System Barycenter */ -/* (body 0) had not been loaded. Now, if */ -/* sufficient data is loaded, SPKEZ can always */ -/* compute the state. */ - -/* For example, suppose the file GLL.BSP contains */ -/* segments of SPK data for the Galileo spacecraft */ -/* (body -77) relative to the Jupiter Barycenter */ -/* (body 5) over a period of time. If SPKEZ Version */ -/* 1.0.0 was called to compute the geometric state of */ -/* -77 relative to 5 (or vice versa), a routine that */ -/* SPKEZ calls, SPKSSB, would signal an error stating */ -/* that there is insufficient data for computing the */ -/* state of body 5 (relative to 0). Version 1.0.0 */ -/* of SPKEZ could not compute the requested state even */ -/* though sufficient data had been loaded. */ - -/* It is necessary to compute the states of each */ -/* of the target and observing bodies relative to */ -/* the solar system barycenter when aberration */ -/* corrections are being applied. However, when */ -/* computing geometric states, it is only necessary */ -/* to trace back to the first common node. Positive */ -/* side effects include the maintenance of precision */ -/* and reduction in number of look ups. */ - -/* The changes to the code in SPKEZ involved calling a new */ -/* routine, SPKGEO, which computes the geometric state if */ -/* no aberration corrections are requested. */ - -/* The other cosmetic changes include the removal of a reference */ -/* to the SPK User's Guide in Literature_References because */ -/* the User's Guide is the same as SPK Required Reading. */ - -/* Also, the item in Restrictions previously said */ - -/* 1) The ephemeris files to be used by SPKEZ must be loaded */ -/* by SPKLEF before SPKSSB is called. */ - -/* SPKSSB was replaced with SPKEZ. */ - -/* The location of the position and velocity information in the */ -/* output state vector argument STARG is now spelled out. */ - -/* Finally, the Particulars section was updated. In Version */ -/* 1.0.0 it said that calling SPKEZ was equivalent to calling */ -/* SPKSSB and SPKAPP. */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKEZ1", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - usegeo = attblk[0]; - -/* Get the frame ID for J2000 on the first call to this routine. */ - - if (first) { - namfrm_("J2000", &fj2000, (ftnlen)5); - first = FALSE_; - } - } - -/* Get the auxiliary information about the requested output frame. */ - - namfrm_(ref, &reqfrm, ref_len); - if (reqfrm == 0) { - setmsg_("The requested output frame '#' is not recognized by the ref" - "erence frame subsystem. Please check that the appropriate k" - "ernels have been loaded and that you have correctly entered " - "the name of the output frame. ", (ftnlen)209); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - frinfo_(&reqfrm, ¢er, &type__, &typeid, &found); - -/* At this recursion level, dynamic frames are not supported. */ - - if (type__ == 5) { - setmsg_("Frame # belongs to the class \"dynamic.\" Conversions invol" - "ving dynamic frames are not supported at the second recursio" - "n level. The requested frame transformation would require t" - "hree or more levels of recursion.", (ftnlen)210); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(RECURSIONTOODEEP)", (ftnlen)23); - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - -/* If we only want a geometric state, then use SPKGEO to compute */ -/* just that. */ - -/* Otherwise, if REF is inertial, compute the state of the target */ -/* relative to the observer via SPKACS. If REF is non-inertial, */ -/* compute the requested state in the J2000 frame, then transform it */ -/* to the frame designated by REF. */ - - if (usegeo) { - zzspkgo1_(targ, et, ref, obs, starg, lt, ref_len); - } else { - -/* If we are dealing with an inertial frame, we can simply */ -/* call SPKACS and return. */ - - if (type__ == 1) { - zzspkac1_(targ, et, ref, abcorr, obs, starg, lt, &dlt, ref_len, - abcorr_len); - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - -/* Still here? */ - -/* We are dealing with a non-inertial frame. But we need to do */ -/* light time and stellar aberration corrections in an inertial */ -/* frame. Get the "apparent" state of TARG in the intermediary */ -/* inertial reference frame J2000. */ - -/* We also need the light time to the center of the frame. */ -/* We compute that first so that we can re-use the temporary */ -/* variable STATE when we compute the inertial apparent state */ -/* of the target relative to the observer. */ - - zzspkac1_(targ, et, "J2000", abcorr, obs, state, lt, &dlt, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - if (center == *obs) { - ltcent = 0.; - dltctr = 0.; - } else if (center == *targ) { - ltcent = *lt; - dltctr = dlt; - } else { - zzspksb1_(obs, et, "J2000", stobs, (ftnlen)5); - zzspklt1_(¢er, et, "J2000", abcorr, stobs, temp, <cent, & - dltctr, (ftnlen)5, abcorr_len); - } - -/* If something went wrong (like we couldn't get the state of */ -/* the center relative to the observer) now it is time to quit. */ - - if (failed_()) { - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - -/* If the aberration corrections are for transmission, make the */ -/* sign of the light time positive, since we wish to compute the */ -/* orientation of the non-inertial frame at an epoch later than */ -/* ET by the one-way light time. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Get the state transformation from J2000 to the requested frame */ -/* and convert the state. */ - - d__1 = *et + ltsign * ltcent; - zzfrmch1_(&fj2000, &reqfrm, &d__1, xform); - if (failed_()) { - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; - } - -/* There's a tricky bit here: since XFORM is evaluated */ -/* at time */ - -/* ET + LTSIGN*LTCENT */ - -/* XFORM is actually dependent on LTCENT. We need to account for */ -/* this dependency in our velocity transformation. */ - -/* Let P and V be the target position and velocity respectively, */ -/* and R, DR be the rotation and rotation derivative */ -/* corresponding to XFORM. */ - -/* The state transformation we need to perform is not */ - -/* R * V + DR * P */ - -/* but rather */ - -/* R * V + ( (1 + LTSIGN*DLTCTR) * DR ) * P */ - -/* So we'll scale the derivative block of XFORM accordingly. */ - - for (i__ = 1; i__ <= 3; ++i__) { - d__1 = ltsign * dltctr + 1.; - vsclip_(&d__1, &xform[(i__1 = i__ * 6 - 3) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zzspkez1_", (ftnlen)1264)]); - } - -/* Now apply the frame transformation XFORM to produce the */ -/* state expressed relative to the request frame REQFRM. */ - - mxvg_(xform, state, &c__6, &c__6, starg); - } - chkout_("ZZSPKEZ1", (ftnlen)8); - return 0; -} /* zzspkez1_ */ - diff --git a/ext/spice/src/cspice/zzspkgo0.c b/ext/spice/src/cspice/zzspkgo0.c deleted file mode 100644 index f3906babb1..0000000000 --- a/ext/spice/src/cspice/zzspkgo0.c +++ /dev/null @@ -1,1040 +0,0 @@ -/* zzspkgo0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure ZZSPKGO0 ( S/P Kernel, geometric state ) */ -/* Subroutine */ int zzspkgo0_(integer *targ, doublereal *et, char *ref, - integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzfrmch0_(integer *, integer *, doublereal *, - doublereal *); - integer cobs, legs; - doublereal sobs[6]; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - integer i__; - extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, - doublereal *), etcal_(doublereal *, char *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char oname[40]; - doublereal descr[5]; - integer ctarg[20]; - char ident[40], tname[40]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal starg[120] /* was [6][20] */; - logical nofrm; - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - doublereal stemp[6]; - integer ctpos; - doublereal vtemp[6]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer handle, cframe; - extern doublereal clight_(void); - integer tframe[20]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - integer tmpfrm; - extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), - spksfs_(integer *, doublereal *, integer *, doublereal *, char *, - logical *, ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *); - doublereal stxfrm[36] /* was [6][6] */; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - integer nct; - doublereal rot[9] /* was [3][3] */; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - char tstring[80]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the geometric state (position and velocity) of a target */ -/* body relative to an observing body. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* OBS I Observing body. */ -/* STATE O State of target. */ -/* LT O Light time. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine ZZFRMCH0. */ - -/* OBS is the standard NAIF ID code for an observing body. */ - -/* $ Detailed_Output */ - -/* STATE contains the position and velocity of the target */ -/* body, relative to the observing body, corrected */ -/* for the specified aberrations, at epoch ET. STATE */ -/* has six elements: the first three contain the */ -/* target's position; the last three contain the target's */ -/* velocity. These vectors are rotated into the */ -/* specified reference frame. Units are always */ -/* km and km/sec. */ - -/* LT is the one-way light time in seconds from the */ -/* observing body to the geometric position of the */ -/* target body at the specified epoch. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient ephemeris data has been loaded to compute */ -/* the necessary states, the error SPICE(SPKINSUFFDATA) is */ -/* signaled. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* ZZSPKGO0 computes the geometric state, T(t), of the target */ -/* body and the geometric state, O(t), of the observing body */ -/* relative to the first common center of motion. Subtracting */ -/* O(t) from T(t) gives the geometric state of the target */ -/* body relative to the observer. */ - - -/* CENTER ----- O(t) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(t) - O(t) */ -/* | / */ -/* T(t) */ - - -/* The one-way light time, tau, is given by */ - - -/* | T(t) - O(t) | */ -/* tau = ----------------- */ -/* c */ - - -/* For example, if the observing body is -94, the Mars Observer */ -/* spacecraft, and the target body is 401, Phobos, then the */ -/* first common center is probably 4, the Mars Barycenter. */ -/* O(t) is the state of -94 relative to 4 and T(t) is the */ -/* state of 401 relative to 4. */ - -/* The center could also be the Solar System Barycenter, body 0. */ -/* For example, if the observer is 399, Earth, and the target */ -/* is 299, Venus, then O(t) would be the state of 399 relative */ -/* to 0 and T(t) would be the state of 299 relative to 0. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the states of the target body and observer */ -/* relative to a common center. ZZSPKGO0 reads as many segments */ -/* as necessary, from as many files as necessary, using files */ -/* that have been loaded by previous calls to SPKLEF (load */ -/* ephemeris file). */ - -/* ZZSPKGO0 is similar to SPKEZ but returns geometric states */ -/* only, with no option to make planetary (light-time) nor */ -/* stellar aberration corrections. The geometric states */ -/* returned by SPKEZ and ZZSPKGO0 are the same. */ - -/* $ Examples */ - -/* The following code example computes the geometric */ -/* state of the moon with respect to the earth and */ -/* then prints the distance of the moon from the */ -/* the earth at a number of epochs. */ - -/* Assume the SPK file SAMPLE.BSP contains ephemeris data */ -/* for the moon relative to earth over the time interval */ -/* from BEGIN to END. */ - -/* INTEGER EARTH */ -/* PARAMETER ( EARTH = 399 ) */ - -/* INTEGER MOON */ -/* PARAMETER ( MOON = 301 ) */ - -/* INTEGER N */ -/* PARAMETER ( N = 100 ) */ - -/* INTEGER HANDLE */ -/* CHARACTER*(20) UTC */ -/* DOUBLE PRECISION BEGIN */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* C */ -/* C Load the binary SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Divide the interval of coverage [BEGIN,END] into */ -/* C N steps. At each step, compute the state, and */ -/* C print out the epoch in UTC time and position norm. */ -/* C */ -/* DELTA = ( END - BEGIN ) / N */ - -/* DO I = 0, N */ - -/* ET = BEGIN + I*DELTA */ - -/* CALL ZZSPKGO0 ( MOON, ET, 'J2000', EARTH, STATE, LT ) */ - -/* CALL ET2UTC ( ET, 'C', 0, UTC ) */ - -/* WRITE (*,*) UTC, VNORM ( STATE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKGO0 must be loaded */ -/* by SPKLEF before ZZSPKGO0 is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADDG calls. */ - -/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ - -/* Based on SPICELIB Version 2.3.0, 05-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* geometric state of one body relative to another */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADDG calls. */ - -/* -& */ - -/* This is the idea: */ - -/* Every body moves with respect to some center. The center */ -/* is itself a body, which in turn moves about some other */ -/* center. If we begin at the target body (T), follow */ -/* the chain, */ - -/* T */ -/* \ */ -/* SSB \ */ -/* \ C[1] */ -/* \ / */ -/* \ / */ -/* \ / */ -/* \ / */ -/* C[3]-----------C[2] */ - -/* and avoid circular definitions (A moves about B, and B moves */ -/* about A), eventually we get the state relative to the solar */ -/* system barycenter (which, for our purposes, doesn't move). */ -/* Thus, */ - -/* T = T + C[1] + C[2] + ... + C[n] */ -/* SSB C[1] C[2] [C3] SSB */ - -/* where */ - -/* X */ -/* Y */ - -/* is the state of body X relative to body Y. */ - -/* However, we don't want to follow each chain back to the SSB */ -/* if it isn't necessary. Instead we will just follow the chain */ -/* of the target body and follow the chain of the observing body */ -/* until we find a common node in the tree. */ - -/* In the example below, C is the first common node. We compute */ -/* the state of TARG relative to C and the state of OBS relative */ -/* to C, then subtract the two states. */ - -/* TARG */ -/* \ */ -/* SSB \ */ -/* \ A */ -/* \ / OBS */ -/* \ / | */ -/* \ / | */ -/* \ / | */ -/* B-------------C-----------------D */ - - - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* CHLEN is the maximum length of a chain. That is, */ -/* it is the maximum number of bodies in the chain from */ -/* the target or observer to the SSB. */ - - -/* Local variables */ - - -/* In-line Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKGO0", (ftnlen)8); - } - -/* We take care of the obvious case first. It TARG and OBS are the */ -/* same we can just fill in zero. */ - - if (*targ == *obs) { - *lt = 0.; - cleard_(&c__6, state); - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - -/* CTARG contains the integer codes of the bodies in the */ -/* target body chain, beginning with TARG itself and then */ -/* the successive centers of motion. */ - -/* STARG(1,I) is the state of the target body relative */ -/* to CTARG(I). The id-code of the frame of this state is */ -/* stored in TFRAME(I). */ - -/* COBS and SOBS will contain the centers and states of the */ -/* observing body. (They are single elements instead of arrays */ -/* because we only need the current center and state of the */ -/* observer relative to it.) */ - -/* First, we construct CTARG and STARG. CTARG(1) is */ -/* just the target itself, and STARG(1,1) is just a zero */ -/* vector, that is, the state of the target relative */ -/* to itself. */ - -/* Then we follow the chain, filling up CTARG and STARG */ -/* as we go. We use SPKSFS to search through loaded */ -/* files to find the first segment applicable to CTARG(1) */ -/* and time ET. Then we use SPKPVN to compute the state */ -/* of the body CTARG(1) at ET in the segment that was found */ -/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ - -/* We repeat the process for CTARG(2) and so on, until */ -/* there is no data found for some CTARG(I) or until we */ -/* reach the SSB. */ - -/* Next, we find centers and states in a similar manner */ -/* for the observer. It's a similar construction as */ -/* described above, but I is always 1. COBS and SOBS */ -/* are overwritten with each new center and state, */ -/* beginning at OBS. However, we stop when we encounter */ -/* a common center of motion, that is when COBS is equal */ -/* to CTARG(I) for some I. */ - -/* Finally, we compute the desired state of the target */ -/* relative to the observer by subtracting the state of */ -/* the observing body relative to the common node from */ -/* the state of the target body relative to the common */ -/* node. */ - -/* CTPOS is the position in CTARG of the common node. */ - - -/* Since Inertial frames are the most extensively used frames */ -/* we use the more restrictive routine IRFNUM to attempt to */ -/* look up the id-code for REF. If IRFNUM comes up empty handed */ -/* we then call the more general routine NAMFRM. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - namfrm_(ref, &refid, ref_len); - } - if (refid == 0) { - if (frstnp_(ref, ref_len) > 0) { - setmsg_("The string supplied to specify the reference frame, ('#" - "') contains non-printing characters. The two most commo" - "n causes for this kind of error are: 1. an error in the " - "call to ZZSPKGO0; 2. an uninitialized variable. ", ( - ftnlen)215); - errch_("#", ref, (ftnlen)1, ref_len); - } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { - setmsg_("The string supplied to specify the reference frame is b" - "lank. The most common cause for this kind of error is a" - "n uninitialized variable. ", (ftnlen)137); - } else { - setmsg_("The string supplied to specify the reference frame was " - "'#'. This frame is not recognized. Possible causes for " - "this error are: 1. failure to load the frame definition " - "into the kernel pool; 2. An out-of-date edition of the t" - "oolkit. ", (ftnlen)231); - errch_("#", ref, (ftnlen)1, ref_len); - } - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - } - -/* Fill in CTARG and STARG until no more data is found */ -/* or until we reach the SSB. If the chain gets too */ -/* long to fit in CTARG, that is if I equals CHLEN, */ -/* then overwrite the last elements of CTARG and STARG. */ - -/* Note the check for FAILED in the loop. If SPKSFS */ -/* or SPKPVN happens to fail during execution, and the */ -/* current error handling action is to NOT abort, then */ -/* FOUND may be stuck at TRUE, CTARG(I) will never */ -/* become zero, and the loop will execute indefinitely. */ - - -/* Construct CTARG and STARG. Begin by assigning the */ -/* first elements: TARG and the state of TARG relative */ -/* to itself. */ - - i__ = 1; - ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, - "zzspkgo0_", (ftnlen)532)] = *targ; - found = TRUE_; - cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)535)]); - while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ctarg", i__1, "zzspkgo0_", (ftnlen)537)] != *obs && - ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", - i__2, "zzspkgo0_", (ftnlen)537)] != 0) { - -/* Find a file and segment that has state */ -/* data for CTARG(I). */ - - spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ctarg", i__1, "zzspkgo0_", (ftnlen)546)], et, &handle, descr, - ident, &found, (ftnlen)40); - if (found) { - -/* Get the state of CTARG(I) relative to some */ -/* center of motion. This new center goes in */ -/* CTARG(I+1) and the state is called STEMP. */ - - ++i__; - spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen) - 556)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)556)], & - ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "ctarg", i__3, "zzspkgo0_", (ftnlen)556)]); - -/* Here's what we have. STARG is the state of CTARG(I-1) */ -/* relative to CTARG(I) in reference frame TFRAME(I) */ - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - } - } - tframe[0] = tframe[1]; - -/* If the loop above ended because we ran out of */ -/* room in the arrays CTARG and STARG, then we */ -/* continue finding states but we overwrite the */ -/* last elements of CTARG and STARG. */ - -/* If, as a result, the first common node is */ -/* overwritten, we'll just have to settle for */ -/* the last common node. This will cause a small */ -/* loss of precision, but it's better than other */ -/* alternatives. */ - - if (i__ == 20) { - while(found && ctarg[19] != 0 && ctarg[19] != *obs) { - -/* Find a file and segment that has state */ -/* data for CTARG(CHLEN). */ - - spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) - ; - if (found) { - -/* Get the state of CTARG(CHLEN) relative to */ -/* some center of motion. The new center */ -/* overwrites the old. The state is called */ -/* STEMP. */ - - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); - -/* Add STEMP to the state of TARG relative to */ -/* the old center to get the state of TARG */ -/* relative to the new center. Overwrite */ -/* the last element of STARG. */ - - if (tframe[19] == tmpfrm) { - moved_(&starg[114], &c__6, vtemp); - } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && - tframe[19] <= 21) { - irfrot_(&tframe[19], &tmpfrm, rot); - mxv_(rot, &starg[114], vtemp); - mxv_(rot, &starg[117], &vtemp[3]); - } else { - zzfrmch0_(&tframe[19], &tmpfrm, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, &starg[114], &c__6, &c__6, vtemp); - } - vaddg_(vtemp, stemp, &c__6, &starg[114]); - tframe[19] = tmpfrm; - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - } - } - } - nct = i__; - -/* NCT is the number of elements in CTARG, */ -/* the chain length. We have in hand the following information */ - -/* STARG(1...6,K) state of body */ -/* CTARG(K-1) relative to body CTARG(K) in the frame */ -/* TFRAME(K) */ - - -/* For K = 2,..., NCT. */ - -/* CTARG(1) = TARG */ -/* STARG(1...6,1) = ( 0, 0, 0, 0, 0, 0 ) */ -/* TFRAME(1) = TFRAME(2) */ - - -/* Now follow the observer's chain. Assign */ -/* the first values for COBS and SOBS. */ - - cobs = *obs; - cleard_(&c__6, sobs); - -/* Perhaps we have a common node already. */ -/* If so it will be the last node on the */ -/* list CTARG. */ - -/* We let CTPOS will be the position of the common */ -/* node in CTARG if one is found. It will */ -/* be zero if COBS is not found in CTARG. */ - - if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", - i__1, "zzspkgo0_", (ftnlen)692)] == cobs) { - ctpos = nct; - cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgo0_", (ftnlen)694)]; - } else { - ctpos = 0; - } - -/* Repeat the same loop as above, but each time */ -/* we encounter a new center of motion, check to */ -/* see if it is a common node. (When CTPOS is */ -/* not zero, CTARG(CTPOS) is the first common node.) */ - -/* Note that we don't need a centers array nor a */ -/* states array, just a single center and state */ -/* is sufficient --- we just keep overwriting them. */ -/* When the common node is found, we have everything */ -/* we need in that one center (COBS) and state */ -/* (SOBS-state of the target relative to COBS). */ - - found = TRUE_; - nofrm = TRUE_; - legs = 0; - while(found && cobs != 0 && ctpos == 0) { - -/* Find a file and segment that has state */ -/* data for COBS. */ - - spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); - if (found) { - -/* Get the state of COBS; call it STEMP. */ -/* The center of motion of COBS becomes the */ -/* new COBS. */ - - if (legs == 0) { - spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); - } else { - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); - } - if (nofrm) { - nofrm = FALSE_; - cframe = tmpfrm; - } - -/* Add STEMP to the state of OBS relative to */ -/* the old COBS to get the state of OBS */ -/* relative to the new COBS. */ - - if (cframe == tmpfrm) { - -/* On the first leg of the state of the observer, we */ -/* don't have to add anything, the state of the observer */ -/* is already in SOBS. We only have to add when the */ -/* number of legs in the observer state is one or greater. */ - - if (legs > 0) { - vaddg_(sobs, stemp, &c__6, vtemp); - moved_(vtemp, &c__6, sobs); - } - } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= - 21) { - irfrot_(&cframe, &tmpfrm, rot); - mxv_(rot, sobs, vtemp); - mxv_(rot, &sobs[3], &vtemp[3]); - vaddg_(vtemp, stemp, &c__6, sobs); - cframe = tmpfrm; - } else { - zzfrmch0_(&cframe, &tmpfrm, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, sobs, &c__6, &c__6, vtemp); - vaddg_(vtemp, stemp, &c__6, sobs); - cframe = tmpfrm; - } - -/* Check failed. We don't want to loop */ -/* indefinitely. */ - - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - -/* We now have one more leg of the path for OBS. Set */ -/* LEGS to reflect this. Then see if the new center */ -/* is a common node. If not, repeat the loop. */ - - ++legs; - ctpos = isrchi_(&cobs, &nct, ctarg); - } - } - -/* If CTPOS is zero at this point, it means we */ -/* have not found a common node though we have */ -/* searched through all the available data. */ - - if (ctpos == 0) { - bodc2n_(targ, tname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); - repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) - ; - } else { - intstr_(targ, tname, (ftnlen)40); - } - bodc2n_(obs, oname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); - repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); - } else { - intstr_(obs, oname, (ftnlen)40); - } - setmsg_("Insufficient ephemeris data has been loaded to compute the " - "state of TARG relative to OBS at the ephemeris epoch #. ", ( - ftnlen)115); - etcal_(et, tstring, (ftnlen)80); - errch_("TARG", tname, (ftnlen)4, (ftnlen)40); - errch_("OBS", oname, (ftnlen)3, (ftnlen)40); - errch_("#", tstring, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - -/* If CTPOS is not zero, then we have reached a */ -/* common node, specifically, */ - -/* CTARG(CTPOS) = COBS = CENTER */ - -/* (in diagram below). The STATE of the target */ -/* (TARG) relative to the observer (OBS) is just */ - -/* STARG(1,CTPOS) - SOBS. */ - - - -/* SOBS */ -/* CENTER ---------------->OBS */ -/* | . */ -/* | . */ -/* S | . E */ -/* T | . T */ -/* A | . A */ -/* R | . T */ -/* G | . S */ -/* | . */ -/* | . */ -/* V L */ -/* TARG */ - - -/* And the light-time between them is just */ - -/* | STATE | */ -/* LT = --------- */ -/* c */ - - -/* Compute the state of the target relative to CTARG(CTPOS) */ - - if (ctpos == 1) { - tframe[0] = cframe; - } - i__1 = ctpos - 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" - , i__2, "zzspkgo0_", (ftnlen)890)] == tframe[(i__3 = i__) < - 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgo0_", ( - ftnlen)890)]) { - vaddg_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)892)], &starg[( - i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : - s_rnge("starg", i__3, "zzspkgo0_", (ftnlen)892)], &c__6, - vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", ( - ftnlen)893)]); - } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgo0_", (ftnlen)895)] > 0 && tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, - "zzspkgo0_", (ftnlen)895)] <= 21 && tframe[(i__2 = i__ - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo0_", ( - ftnlen)895)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("tframe", i__2, "zzspkgo0_", (ftnlen)895)] <= - 21) { - irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgo0_", (ftnlen)897)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgo0_", (ftnlen)897)], rot); - mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)898)], stemp); - mxv_(rot, &starg[(i__2 = i__ * 6 - 3) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)899)], &stemp[ - 3]); - vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= - i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen) - 900)], &c__6, vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", ( - ftnlen)901)]); - } else { - zzfrmch0_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgo0_", (ftnlen)905)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgo0_", (ftnlen)905)], et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)912)], & - c__6, &c__6, stemp); - vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= - i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen) - 913)], &c__6, vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", ( - ftnlen)914)]); - } - } - -/* To avoid unnecessary frame transformations we'll do */ -/* a bit of extra decision making here. It's a lot */ -/* faster to make logical checks than it is to compute */ -/* frame transformations. */ - - if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", - i__1, "zzspkgo0_", (ftnlen)927)] == cframe) { - vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)929)], sobs, &c__6, - state); - } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgo0_", (ftnlen)931)] == refid) { - -/* If the last frame associated with the target is already */ -/* in the requested output frame, we convert the state of */ -/* the observer to that frame and then subtract the state */ -/* of the observer from the state of the target. */ - - if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - irfrot_(&cframe, &refid, rot); - mxv_(rot, sobs, stemp); - mxv_(rot, &sobs[3], &stemp[3]); - } else { - zzfrmch0_(&cframe, &refid, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, sobs, &c__6, &c__6, stemp); - } - -/* We've now transformed SOBS into the requested reference frame. */ -/* Set CFRAME to reflect this. */ - - cframe = refid; - vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)963)], stemp, & - c__6, state); - } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen) - 966)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen)966)] <= 21) { - -/* If both frames are inertial we use IRFROT instead of */ -/* ZZFRMCH0 to get things into a common frame. */ - - irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgo0_", (ftnlen)972)], &cframe, rot); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)973)], stemp); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 3) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)974)], &stemp[3]); - vsubg_(stemp, sobs, &c__6, state); - } else { - -/* Use the more general routine ZZFRMCH0 to make the */ -/* transformation. */ - - zzfrmch0_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen)982)], &cframe, - et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 - : s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)989)], &c__6, & - c__6, stemp); - vsubg_(stemp, sobs, &c__6, state); - } - -/* Finally, rotate as needed into the requested frame. */ - - if (cframe == refid) { - -/* We don't have to do anything in this case. */ - - } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - -/* Since both frames are inertial, we use the more direct */ -/* routine IRFROT to get the transformation to REFID. */ - - irfrot_(&cframe, &refid, rot); - mxv_(rot, state, stemp); - mxv_(rot, &state[3], &stemp[3]); - moved_(stemp, &c__6, state); - } else { - zzfrmch0_(&cframe, &refid, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, state, &c__6, &c__6, stemp); - moved_(stemp, &c__6, state); - } - *lt = vnorm_(state) / clight_(); - chkout_("ZZSPKGO0", (ftnlen)8); - return 0; -} /* zzspkgo0_ */ - diff --git a/ext/spice/src/cspice/zzspkgo1.c b/ext/spice/src/cspice/zzspkgo1.c deleted file mode 100644 index df6f812862..0000000000 --- a/ext/spice/src/cspice/zzspkgo1.c +++ /dev/null @@ -1,1042 +0,0 @@ -/* zzspkgo1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure ZZSPKGO1 ( S/P Kernel, geometric state ) */ -/* Subroutine */ int zzspkgo1_(integer *targ, doublereal *et, char *ref, - integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzfrmch1_(integer *, integer *, doublereal *, - doublereal *); - integer cobs, legs; - doublereal sobs[6]; - extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, - integer *, doublereal *); - integer i__; - extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, - doublereal *), etcal_(doublereal *, char *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char oname[40]; - doublereal descr[5]; - integer ctarg[20]; - char ident[40], tname[40]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal starg[120] /* was [6][20] */; - logical nofrm; - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - doublereal stemp[6]; - integer ctpos; - doublereal vtemp[6]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer handle, cframe; - extern doublereal clight_(void); - integer tframe[20]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - integer tmpfrm; - extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), - spksfs_(integer *, doublereal *, integer *, doublereal *, char *, - logical *, ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *); - doublereal stxfrm[36] /* was [6][6] */; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - integer nct; - doublereal rot[9] /* was [3][3] */; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - char tstring[80]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the geometric state (position and velocity) of a target */ -/* body relative to an observing body. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* OBS I Observing body. */ -/* STATE O State of target. */ -/* LT O Light time. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine ZZFRMCH1. */ - -/* OBS is the standard NAIF ID code for an observing body. */ - -/* $ Detailed_Output */ - -/* STATE contains the position and velocity of the target */ -/* body, relative to the observing body, corrected */ -/* for the specified aberrations, at epoch ET. STATE */ -/* has six elements: the first three contain the */ -/* target's position; the last three contain the target's */ -/* velocity. These vectors are rotated into the */ -/* specified reference frame. Units are always */ -/* km and km/sec. */ - -/* LT is the one-way light time in seconds from the */ -/* observing body to the geometric position of the */ -/* target body at the specified epoch. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient ephemeris data has been loaded to compute */ -/* the necessary states, the error SPICE(SPKINSUFFDATA) is */ -/* signaled. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* ZZSPKGO1 computes the geometric state, T(t), of the target */ -/* body and the geometric state, O(t), of the observing body */ -/* relative to the first common center of motion. Subtracting */ -/* O(t) from T(t) gives the geometric state of the target */ -/* body relative to the observer. */ - - -/* CENTER ----- O(t) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(t) - O(t) */ -/* | / */ -/* T(t) */ - - -/* The one-way light time, tau, is given by */ - - -/* | T(t) - O(t) | */ -/* tau = ----------------- */ -/* c */ - - -/* For example, if the observing body is -94, the Mars Observer */ -/* spacecraft, and the target body is 401, Phobos, then the */ -/* first common center is probably 4, the Mars Barycenter. */ -/* O(t) is the state of -94 relative to 4 and T(t) is the */ -/* state of 401 relative to 4. */ - -/* The center could also be the Solar System Barycenter, body 0. */ -/* For example, if the observer is 399, Earth, and the target */ -/* is 299, Venus, then O(t) would be the state of 399 relative */ -/* to 0 and T(t) would be the state of 299 relative to 0. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the states of the target body and observer */ -/* relative to a common center. ZZSPKGO1 reads as many segments */ -/* as necessary, from as many files as necessary, using files */ -/* that have been loaded by previous calls to SPKLEF (load */ -/* ephemeris file). */ - -/* ZZSPKGO1 is similar to SPKEZ but returns geometric states */ -/* only, with no option to make planetary (light-time) nor */ -/* stellar aberration corrections. The geometric states */ -/* returned by SPKEZ and ZZSPKGO1 are the same. */ - -/* $ Examples */ - -/* The following code example computes the geometric */ -/* state of the moon with respect to the earth and */ -/* then prints the distance of the moon from the */ -/* the earth at a number of epochs. */ - -/* Assume the SPK file SAMPLE.BSP contains ephemeris data */ -/* for the moon relative to earth over the time interval */ -/* from BEGIN to END. */ - -/* INTEGER EARTH */ -/* PARAMETER ( EARTH = 399 ) */ - -/* INTEGER MOON */ -/* PARAMETER ( MOON = 301 ) */ - -/* INTEGER N */ -/* PARAMETER ( N = 100 ) */ - -/* INTEGER HANDLE */ -/* CHARACTER*(20) UTC */ -/* DOUBLE PRECISION BEGIN */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION STATE ( 6 ) */ - -/* C */ -/* C Load the binary SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Divide the interval of coverage [BEGIN,END] into */ -/* C N steps. At each step, compute the state, and */ -/* C print out the epoch in UTC time and position norm. */ -/* C */ -/* DELTA = ( END - BEGIN ) / N */ - -/* DO I = 0, N */ - -/* ET = BEGIN + I*DELTA */ - -/* CALL ZZSPKGO1 ( MOON, ET, 'J2000', EARTH, STATE, LT ) */ - -/* CALL ET2UTC ( ET, 'C', 0, UTC ) */ - -/* WRITE (*,*) UTC, VNORM ( STATE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKGO1 must be loaded */ -/* by SPKLEF before ZZSPKGO1 is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADDG calls. */ - -/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ - -/* Based on SPICELIB Version 2.3.0, 05-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* geometric state of one body relative to another */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADDG calls. */ - -/* -& */ - -/* This is the idea: */ - -/* Every body moves with respect to some center. The center */ -/* is itself a body, which in turn moves about some other */ -/* center. If we begin at the target body (T), follow */ -/* the chain, */ - -/* T */ -/* \ */ -/* SSB \ */ -/* \ C[1] */ -/* \ / */ -/* \ / */ -/* \ / */ -/* \ / */ -/* C[3]-----------C[2] */ - -/* and avoid circular definitions (A moves about B, and B moves */ -/* about A), eventually we get the state relative to the solar */ -/* system barycenter (which, for our purposes, doesn't move). */ -/* Thus, */ - -/* T = T + C[1] + C[2] + ... + C[n] */ -/* SSB C[1] C[2] [C3] SSB */ - -/* where */ - -/* X */ -/* Y */ - -/* is the state of body X relative to body Y. */ - -/* However, we don't want to follow each chain back to the SSB */ -/* if it isn't necessary. Instead we will just follow the chain */ -/* of the target body and follow the chain of the observing body */ -/* until we find a common node in the tree. */ - -/* In the example below, C is the first common node. We compute */ -/* the state of TARG relative to C and the state of OBS relative */ -/* to C, then subtract the two states. */ - -/* TARG */ -/* \ */ -/* SSB \ */ -/* \ A */ -/* \ / OBS */ -/* \ / | */ -/* \ / | */ -/* \ / | */ -/* B-------------C-----------------D */ - - - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local parameters */ - -/* CHLEN is the maximum length of a chain. That is, */ -/* it is the maximum number of bodies in the chain from */ -/* the target or observer to the SSB. */ - - -/* Local variables */ - - -/* In-line Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKGO1", (ftnlen)8); - } - -/* We take care of the obvious case first. It TARG and OBS are the */ -/* same we can just fill in zero. */ - - if (*targ == *obs) { - *lt = 0.; - cleard_(&c__6, state); - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - -/* CTARG contains the integer codes of the bodies in the */ -/* target body chain, beginning with TARG itself and then */ -/* the successive centers of motion. */ - -/* STARG(1,I) is the state of the target body relative */ -/* to CTARG(I). The id-code of the frame of this state is */ -/* stored in TFRAME(I). */ - -/* COBS and SOBS will contain the centers and states of the */ -/* observing body. (They are single elements instead of arrays */ -/* because we only need the current center and state of the */ -/* observer relative to it.) */ - -/* First, we construct CTARG and STARG. CTARG(1) is */ -/* just the target itself, and STARG(1,1) is just a zero */ -/* vector, that is, the state of the target relative */ -/* to itself. */ - -/* Then we follow the chain, filling up CTARG and STARG */ -/* as we go. We use SPKSFS to search through loaded */ -/* files to find the first segment applicable to CTARG(1) */ -/* and time ET. Then we use SPKPVN to compute the state */ -/* of the body CTARG(1) at ET in the segment that was found */ -/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ - -/* We repeat the process for CTARG(2) and so on, until */ -/* there is no data found for some CTARG(I) or until we */ -/* reach the SSB. */ - -/* Next, we find centers and states in a similar manner */ -/* for the observer. It's a similar construction as */ -/* described above, but I is always 1. COBS and SOBS */ -/* are overwritten with each new center and state, */ -/* beginning at OBS. However, we stop when we encounter */ -/* a common center of motion, that is when COBS is equal */ -/* to CTARG(I) for some I. */ - -/* Finally, we compute the desired state of the target */ -/* relative to the observer by subtracting the state of */ -/* the observing body relative to the common node from */ -/* the state of the target body relative to the common */ -/* node. */ - -/* CTPOS is the position in CTARG of the common node. */ - - -/* Since Inertial frames are the most extensively used frames */ -/* we use the more restrictive routine IRFNUM to attempt to */ -/* look up the id-code for REF. If IRFNUM comes up empty handed */ -/* we then call the more general routine NAMFRM. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - namfrm_(ref, &refid, ref_len); - } - if (refid == 0) { - if (frstnp_(ref, ref_len) > 0) { - setmsg_("The string supplied to specify the reference frame, ('#" - "') contains non-printing characters. The two most commo" - "n causes for this kind of error are: 1. an error in the " - "call to ZZSPKGO1; 2. an uninitialized variable. ", ( - ftnlen)215); - errch_("#", ref, (ftnlen)1, ref_len); - } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { - setmsg_("The string supplied to specify the reference frame is b" - "lank. The most common cause for this kind of error is a" - "n uninitialized variable. ", (ftnlen)137); - } else { - setmsg_("The string supplied to specify the reference frame was " - "'#'. This frame is not recognized. Possible causes for " - "this error are: 1. failure to load the frame definition " - "into the kernel pool; 2. An out-of-date edition of the t" - "oolkit. ", (ftnlen)231); - errch_("#", ref, (ftnlen)1, ref_len); - } - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - } - -/* Fill in CTARG and STARG until no more data is found */ -/* or until we reach the SSB. If the chain gets too */ -/* long to fit in CTARG, that is if I equals CHLEN, */ -/* then overwrite the last elements of CTARG and STARG. */ - -/* Note the check for FAILED in the loop. If SPKSFS */ -/* or SPKPVN happens to fail during execution, and the */ -/* current error handling action is to NOT abort, then */ -/* FOUND may be stuck at TRUE, CTARG(I) will never */ -/* become zero, and the loop will execute indefinitely. */ - - -/* Construct CTARG and STARG. Begin by assigning the */ -/* first elements: TARG and the state of TARG relative */ -/* to itself. */ - - i__ = 1; - ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, - "zzspkgo1_", (ftnlen)534)] = *targ; - found = TRUE_; - cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)537)]); - while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ctarg", i__1, "zzspkgo1_", (ftnlen)539)] != *obs && - ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", - i__2, "zzspkgo1_", (ftnlen)539)] != 0) { - -/* Find a file and segment that has state */ -/* data for CTARG(I). */ - - spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ctarg", i__1, "zzspkgo1_", (ftnlen)548)], et, &handle, descr, - ident, &found, (ftnlen)40); - if (found) { - -/* Get the state of CTARG(I) relative to some */ -/* center of motion. This new center goes in */ -/* CTARG(I+1) and the state is called STEMP. */ - - ++i__; - spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen) - 558)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)558)], & - ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "ctarg", i__3, "zzspkgo1_", (ftnlen)558)]); - -/* Here's what we have. STARG is the state of CTARG(I-1) */ -/* relative to CTARG(I) in reference frame TFRAME(I) */ - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - } - } - tframe[0] = tframe[1]; - -/* If the loop above ended because we ran out of */ -/* room in the arrays CTARG and STARG, then we */ -/* continue finding states but we overwrite the */ -/* last elements of CTARG and STARG. */ - -/* If, as a result, the first common node is */ -/* overwritten, we'll just have to settle for */ -/* the last common node. This will cause a small */ -/* loss of precision, but it's better than other */ -/* alternatives. */ - - if (i__ == 20) { - while(found && ctarg[19] != 0 && ctarg[19] != *obs) { - -/* Find a file and segment that has state */ -/* data for CTARG(CHLEN). */ - - spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) - ; - if (found) { - -/* Get the state of CTARG(CHLEN) relative to */ -/* some center of motion. The new center */ -/* overwrites the old. The state is called */ -/* STEMP. */ - - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); - -/* Add STEMP to the state of TARG relative to */ -/* the old center to get the state of TARG */ -/* relative to the new center. Overwrite */ -/* the last element of STARG. */ - - if (tframe[19] == tmpfrm) { - moved_(&starg[114], &c__6, vtemp); - } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && - tframe[19] <= 21) { - irfrot_(&tframe[19], &tmpfrm, rot); - mxv_(rot, &starg[114], vtemp); - mxv_(rot, &starg[117], &vtemp[3]); - } else { - zzfrmch1_(&tframe[19], &tmpfrm, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, &starg[114], &c__6, &c__6, vtemp); - } - vaddg_(vtemp, stemp, &c__6, &starg[114]); - tframe[19] = tmpfrm; - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - } - } - } - nct = i__; - -/* NCT is the number of elements in CTARG, */ -/* the chain length. We have in hand the following information */ - -/* STARG(1...6,K) state of body */ -/* CTARG(K-1) relative to body CTARG(K) in the frame */ -/* TFRAME(K) */ - - -/* For K = 2,..., NCT. */ - -/* CTARG(1) = TARG */ -/* STARG(1...6,1) = ( 0, 0, 0, 0, 0, 0 ) */ -/* TFRAME(1) = TFRAME(2) */ - - -/* Now follow the observer's chain. Assign */ -/* the first values for COBS and SOBS. */ - - cobs = *obs; - cleard_(&c__6, sobs); - -/* Perhaps we have a common node already. */ -/* If so it will be the last node on the */ -/* list CTARG. */ - -/* We let CTPOS will be the position of the common */ -/* node in CTARG if one is found. It will */ -/* be zero if COBS is not found in CTARG. */ - - if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", - i__1, "zzspkgo1_", (ftnlen)694)] == cobs) { - ctpos = nct; - cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgo1_", (ftnlen)696)]; - } else { - ctpos = 0; - } - -/* Repeat the same loop as above, but each time */ -/* we encounter a new center of motion, check to */ -/* see if it is a common node. (When CTPOS is */ -/* not zero, CTARG(CTPOS) is the first common node.) */ - -/* Note that we don't need a centers array nor a */ -/* states array, just a single center and state */ -/* is sufficient --- we just keep overwriting them. */ -/* When the common node is found, we have everything */ -/* we need in that one center (COBS) and state */ -/* (SOBS-state of the target relative to COBS). */ - - found = TRUE_; - nofrm = TRUE_; - legs = 0; - while(found && cobs != 0 && ctpos == 0) { - -/* Find a file and segment that has state */ -/* data for COBS. */ - - spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); - if (found) { - -/* Get the state of COBS; call it STEMP. */ -/* The center of motion of COBS becomes the */ -/* new COBS. */ - - if (legs == 0) { - spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); - } else { - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); - } - if (nofrm) { - nofrm = FALSE_; - cframe = tmpfrm; - } - -/* Add STEMP to the state of OBS relative to */ -/* the old COBS to get the state of OBS */ -/* relative to the new COBS. */ - - if (cframe == tmpfrm) { - -/* On the first leg of the state of the observer, we */ -/* don't have to add anything, the state of the observer */ -/* is already in SOBS. We only have to add when the */ -/* number of legs in the observer state is one or greater. */ - - if (legs > 0) { - vaddg_(sobs, stemp, &c__6, vtemp); - moved_(vtemp, &c__6, sobs); - } - } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= - 21) { - irfrot_(&cframe, &tmpfrm, rot); - mxv_(rot, sobs, vtemp); - mxv_(rot, &sobs[3], &vtemp[3]); - vaddg_(vtemp, stemp, &c__6, sobs); - cframe = tmpfrm; - } else { - zzfrmch1_(&cframe, &tmpfrm, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, sobs, &c__6, &c__6, vtemp); - vaddg_(vtemp, stemp, &c__6, sobs); - cframe = tmpfrm; - } - -/* Check failed. We don't want to loop */ -/* indefinitely. */ - - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - -/* We now have one more leg of the path for OBS. Set */ -/* LEGS to reflect this. Then see if the new center */ -/* is a common node. If not, repeat the loop. */ - - ++legs; - ctpos = isrchi_(&cobs, &nct, ctarg); - } - } - -/* If CTPOS is zero at this point, it means we */ -/* have not found a common node though we have */ -/* searched through all the available data. */ - - if (ctpos == 0) { - bodc2n_(targ, tname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); - repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) - ; - } else { - intstr_(targ, tname, (ftnlen)40); - } - bodc2n_(obs, oname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); - repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); - } else { - intstr_(obs, oname, (ftnlen)40); - } - setmsg_("Insufficient ephemeris data has been loaded to compute the " - "state of TARG relative to OBS at the ephemeris epoch #. ", ( - ftnlen)115); - etcal_(et, tstring, (ftnlen)80); - errch_("TARG", tname, (ftnlen)4, (ftnlen)40); - errch_("OBS", oname, (ftnlen)3, (ftnlen)40); - errch_("#", tstring, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - -/* If CTPOS is not zero, then we have reached a */ -/* common node, specifically, */ - -/* CTARG(CTPOS) = COBS = CENTER */ - -/* (in diagram below). The STATE of the target */ -/* (TARG) relative to the observer (OBS) is just */ - -/* STARG(1,CTPOS) - SOBS. */ - - - -/* SOBS */ -/* CENTER ---------------->OBS */ -/* | . */ -/* | . */ -/* S | . E */ -/* T | . T */ -/* A | . A */ -/* R | . T */ -/* G | . S */ -/* | . */ -/* | . */ -/* V L */ -/* TARG */ - - -/* And the light-time between them is just */ - -/* | STATE | */ -/* LT = --------- */ -/* c */ - - -/* Compute the state of the target relative to CTARG(CTPOS) */ - - if (ctpos == 1) { - tframe[0] = cframe; - } - i__1 = ctpos - 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" - , i__2, "zzspkgo1_", (ftnlen)892)] == tframe[(i__3 = i__) < - 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgo1_", ( - ftnlen)892)]) { - vaddg_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)894)], &starg[( - i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : - s_rnge("starg", i__3, "zzspkgo1_", (ftnlen)894)], &c__6, - vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", ( - ftnlen)895)]); - } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgo1_", (ftnlen)897)] > 0 && tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, - "zzspkgo1_", (ftnlen)897)] <= 21 && tframe[(i__2 = i__ - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo1_", ( - ftnlen)897)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("tframe", i__2, "zzspkgo1_", (ftnlen)897)] <= - 21) { - irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgo1_", (ftnlen)899)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgo1_", (ftnlen)899)], rot); - mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)900)], stemp); - mxv_(rot, &starg[(i__2 = i__ * 6 - 3) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)901)], &stemp[ - 3]); - vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= - i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen) - 902)], &c__6, vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", ( - ftnlen)903)]); - } else { - zzfrmch1_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgo1_", (ftnlen)907)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgo1_", (ftnlen)907)], et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)914)], & - c__6, &c__6, stemp); - vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= - i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen) - 915)], &c__6, vtemp); - moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", ( - ftnlen)916)]); - } - } - -/* To avoid unnecessary frame transformations we'll do */ -/* a bit of extra decision making here. It's a lot */ -/* faster to make logical checks than it is to compute */ -/* frame transformations. */ - - if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", - i__1, "zzspkgo1_", (ftnlen)929)] == cframe) { - vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)931)], sobs, &c__6, - state); - } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgo1_", (ftnlen)933)] == refid) { - -/* If the last frame associated with the target is already */ -/* in the requested output frame, we convert the state of */ -/* the observer to that frame and then subtract the state */ -/* of the observer from the state of the target. */ - - if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - irfrot_(&cframe, &refid, rot); - mxv_(rot, sobs, stemp); - mxv_(rot, &sobs[3], &stemp[3]); - } else { - zzfrmch1_(&cframe, &refid, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, sobs, &c__6, &c__6, stemp); - } - -/* We've now transformed SOBS into the requested reference frame. */ -/* Set CFRAME to reflect this. */ - - cframe = refid; - vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)965)], stemp, & - c__6, state); - } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen) - 968)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen)968)] <= 21) { - -/* If both frames are inertial we use IRFROT instead of */ -/* ZZFRMCH1 to get things into a common frame. */ - - irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgo1_", (ftnlen)974)], &cframe, rot); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)975)], stemp); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 3) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)976)], &stemp[3]); - vsubg_(stemp, sobs, &c__6, state); - } else { - -/* Use the more general routine ZZFRMCH1 to make the */ -/* transformation. */ - - zzfrmch1_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen)984)], &cframe, - et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 - : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)991)], &c__6, & - c__6, stemp); - vsubg_(stemp, sobs, &c__6, state); - } - -/* Finally, rotate as needed into the requested frame. */ - - if (cframe == refid) { - -/* We don't have to do anything in this case. */ - - } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - -/* Since both frames are inertial, we use the more direct */ -/* routine IRFROT to get the transformation to REFID. */ - - irfrot_(&cframe, &refid, rot); - mxv_(rot, state, stemp); - mxv_(rot, &state[3], &stemp[3]); - moved_(stemp, &c__6, state); - } else { - zzfrmch1_(&cframe, &refid, et, stxfrm); - if (failed_()) { - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; - } - mxvg_(stxfrm, state, &c__6, &c__6, stemp); - moved_(stemp, &c__6, state); - } - *lt = vnorm_(state) / clight_(); - chkout_("ZZSPKGO1", (ftnlen)8); - return 0; -} /* zzspkgo1_ */ - diff --git a/ext/spice/src/cspice/zzspkgp0.c b/ext/spice/src/cspice/zzspkgp0.c deleted file mode 100644 index 034a365650..0000000000 --- a/ext/spice/src/cspice/zzspkgp0.c +++ /dev/null @@ -1,1022 +0,0 @@ -/* zzspkgp0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure ZZSPKGP0 ( S/P Kernel, geometric position ) */ -/* Subroutine */ int zzspkgp0_(integer *targ, doublereal *et, char *ref, - integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzrefch0_(integer *, integer *, doublereal *, - doublereal *), vadd_(doublereal *, doublereal *, doublereal *); - integer cobs, legs; - doublereal sobs[6]; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char oname[40]; - doublereal descr[5]; - integer ctarg[20]; - char ident[40], tname[40]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal starg[120] /* was [6][20] */; - logical nofrm; - doublereal stemp[6]; - integer ctpos; - doublereal vtemp[6]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer handle, cframe; - extern doublereal clight_(void); - integer tframe[20]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - integer tmpfrm; - extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), - spksfs_(integer *, doublereal *, integer *, doublereal *, char *, - logical *, ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - doublereal psxfrm[9] /* was [3][3] */; - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *), intstr_(integer *, char *, - ftnlen); - integer nct; - doublereal rot[9] /* was [3][3] */; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - char tstring[80]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the geometric position of a target body relative to an */ -/* observing body. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* OBS I Observing body. */ -/* POS O Position of target. */ -/* LT O Light time. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the position */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine ZZREFCH0. */ - -/* OBS is the standard NAIF ID code for an observing body. */ - -/* $ Detailed_Output */ - -/* POS contains the position of the target */ -/* body, relative to the observing body. This vector is */ -/* rotated into the specified reference frame. Units */ -/* are always km. */ - -/* LT is the one-way light time from the observing body */ -/* to the geometric position of the target body at the */ -/* specified epoch. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient ephemeris data has been loaded to compute */ -/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */ -/* signalled. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* ZZSPKGP0 computes the geometric position, T(t), of the target */ -/* body and the geometric position, O(t), of the observing body */ -/* relative to the first common center of motion. Subtracting */ -/* O(t) from T(t) gives the geometric position of the target */ -/* body relative to the observer. */ - - -/* CENTER ----- O(t) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(t) - O(t) */ -/* | / */ -/* T(t) */ - - -/* The one-way light time, tau, is given by */ - - -/* | T(t) - O(t) | */ -/* tau = ----------------- */ -/* c */ - - -/* For example, if the observing body is -94, the Mars Observer */ -/* spacecraft, and the target body is 401, Phobos, then the */ -/* first common center is probably 4, the Mars Barycenter. */ -/* O(t) is the position of -94 relative to 4 and T(t) is the */ -/* position of 401 relative to 4. */ - -/* The center could also be the Solar System Barycenter, body 0. */ -/* For example, if the observer is 399, Earth, and the target */ -/* is 299, Venus, then O(t) would be the position of 399 relative */ -/* to 0 and T(t) would be the position of 299 relative to 0. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the positions of the target body and observer */ -/* relative to a common center. ZZSPKGP0 reads as many segments */ -/* as necessary, from as many files as necessary, using files */ -/* that have been loaded by previous calls to SPKLEF (load */ -/* ephemeris file). */ - -/* ZZSPKGP0 is similar to SPKGEO but returns geometric positions */ -/* only. */ - -/* $ Examples */ - -/* The following code example computes the geometric */ -/* position of the moon with respect to the earth and */ -/* then prints the distance of the moon from the */ -/* the earth at a number of epochs. */ - -/* Assume the SPK file SAMPLE.BSP contains ephemeris data */ -/* for the moon relative to earth over the time interval */ -/* from BEGIN to END. */ - -/* INTEGER EARTH */ -/* PARAMETER ( EARTH = 399 ) */ - -/* INTEGER MOON */ -/* PARAMETER ( MOON = 301 ) */ - -/* INTEGER N */ -/* PARAMETER ( N = 100 ) */ - -/* INTEGER HANDLE */ -/* CHARACTER*(20) UTC */ -/* DOUBLE PRECISION BEGIN */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* C */ -/* C Load the binary SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Divide the interval of coverage [BEGIN,END] into */ -/* C N steps. At each step, compute the position, and */ -/* C print out the epoch in UTC time and position norm. */ -/* C */ -/* DELTA = ( END - BEGIN ) / N */ - -/* DO I = 0, N */ - -/* ET = BEGIN + I*DELTA */ - -/* CALL ZZSPKGP0 ( MOON, ET, 'J2000', EARTH, POS, LT ) */ - -/* CALL ET2UTC ( ET, 'C', 0, UTC ) */ - -/* WRITE (*,*) UTC, VNORM ( POS ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKGP0 must be loaded */ -/* by SPKLEF before ZZSPKGP0 is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD calls. */ - -/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ - -/* Based on SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* geometric position of one body relative to another */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD calls. */ - -/* -& */ - -/* This is the idea: */ - -/* Every body moves with respect to some center. The center */ -/* is itself a body, which in turn moves about some other */ -/* center. If we begin at the target body (T), follow */ -/* the chain, */ - -/* T */ -/* \ */ -/* SSB \ */ -/* \ C[1] */ -/* \ / */ -/* \ / */ -/* \ / */ -/* \ / */ -/* C[3]-----------C[2] */ - -/* and avoid circular definitions (A moves about B, and B moves */ -/* about A), eventually we get the position relative to the solar */ -/* system barycenter (which, for our purposes, doesn't move). */ -/* Thus, */ - -/* T = T + C[1] + C[2] + ... + C[n] */ -/* SSB C[1] C[2] [C3] SSB */ - -/* where */ - -/* X */ -/* Y */ - -/* is the position of body X relative to body Y. */ - -/* However, we don't want to follow each chain back to the SSB */ -/* if it isn't necessary. Instead we will just follow the chain */ -/* of the target body and follow the chain of the observing body */ -/* until we find a common node in the tree. */ - -/* In the example below, C is the first common node. We compute */ -/* the position of TARG relative to C and the position of OBS */ -/* relative to C, then subtract the two positions. */ - -/* TARG */ -/* \ */ -/* SSB \ */ -/* \ A */ -/* \ / OBS */ -/* \ / | */ -/* \ / | */ -/* \ / | */ -/* B-------------C-----------------D */ - - - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local parameters */ - -/* CHLEN is the maximum length of a chain. That is, */ -/* it is the maximum number of bodies in the chain from */ -/* the target or observer to the SSB. */ - - -/* Local variables */ - - -/* In-line Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKGP0", (ftnlen)8); - } - -/* We take care of the obvious case first. It TARG and OBS are the */ -/* same we can just fill in zero. */ - - if (*targ == *obs) { - *lt = 0.; - cleard_(&c__3, pos); - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - -/* CTARG contains the integer codes of the bodies in the */ -/* target body chain, beginning with TARG itself and then */ -/* the successive centers of motion. */ - -/* STARG(1,I) is the position of the target body relative */ -/* to CTARG(I). The id-code of the frame of this position is */ -/* stored in TFRAME(I). */ - -/* COBS and SOBS will contain the centers and positions of the */ -/* observing body. (They are single elements instead of arrays */ -/* because we only need the current center and position of the */ -/* observer relative to it.) */ - -/* First, we construct CTARG and STARG. CTARG(1) is */ -/* just the target itself, and STARG(1,1) is just a zero */ -/* vector, that is, the position of the target relative */ -/* to itself. */ - -/* Then we follow the chain, filling up CTARG and STARG */ -/* as we go. We use SPKSFS to search through loaded */ -/* files to find the first segment applicable to CTARG(1) */ -/* and time ET. Then we use SPKPVN to compute the position */ -/* of the body CTARG(1) at ET in the segment that was found */ -/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ - -/* We repeat the process for CTARG(2) and so on, until */ -/* there is no data found for some CTARG(I) or until we */ -/* reach the SSB. */ - -/* Next, we find centers and positions in a similar manner */ -/* for the observer. It's a similar construction as */ -/* described above, but I is always 1. COBS and SOBS */ -/* are overwritten with each new center and position, */ -/* beginning at OBS. However, we stop when we encounter */ -/* a common center of motion, that is when COBS is equal */ -/* to CTARG(I) for some I. */ - -/* Finally, we compute the desired position of the target */ -/* relative to the observer by subtracting the position of */ -/* the observing body relative to the common node from */ -/* the position of the target body relative to the common */ -/* node. */ - -/* CTPOS is the position in CTARG of the common node. */ - - -/* Since Inertial frames are the most extensively used frames */ -/* we use the more restrictive routine IRFNUM to attempt to */ -/* look up the id-code for REF. If IRFNUM comes up empty handed */ -/* we then call the more general routine NAMFRM. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - namfrm_(ref, &refid, ref_len); - } - if (refid == 0) { - if (frstnp_(ref, ref_len) > 0) { - setmsg_("The string supplied to specify the reference frame, ('#" - "') contains non-printing characters. The two most commo" - "n causes for this kind of error are: 1. an error in the " - "call to ZZSPKGP0; 2. an uninitialized variable. ", ( - ftnlen)215); - errch_("#", ref, (ftnlen)1, ref_len); - } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { - setmsg_("The string supplied to specify the reference frame is b" - "lank. The most common cause for this kind of error is a" - "n uninitialized variable. ", (ftnlen)137); - } else { - setmsg_("The string supplied to specify the reference frame was " - "'#'. This frame is not recognized. Possible causes for " - "this error are: 1. failure to load the frame definition " - "into the kernel pool; 2. An out-of-date edition of the t" - "oolkit. ", (ftnlen)231); - errch_("#", ref, (ftnlen)1, ref_len); - } - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - } - -/* Fill in CTARG and STARG until no more data is found */ -/* or until we reach the SSB. If the chain gets too */ -/* long to fit in CTARG, that is if I equals CHLEN, */ -/* then overwrite the last elements of CTARG and STARG. */ - -/* Note the check for FAILED in the loop. If SPKSFS */ -/* or SPKPVN happens to fail during execution, and the */ -/* current error handling action is to NOT abort, then */ -/* FOUND may be stuck at TRUE, CTARG(I) will never */ -/* become zero, and the loop will execute indefinitely. */ - - -/* Construct CTARG and STARG. Begin by assigning the */ -/* first elements: TARG and the position of TARG relative */ -/* to itself. */ - - i__ = 1; - ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, - "zzspkgp0_", (ftnlen)528)] = *targ; - found = TRUE_; - cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp0_", (ftnlen)531)]); - while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ctarg", i__1, "zzspkgp0_", (ftnlen)533)] != *obs && - ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", - i__2, "zzspkgp0_", (ftnlen)533)] != 0) { - -/* Find a file and segment that has position */ -/* data for CTARG(I). */ - - spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ctarg", i__1, "zzspkgp0_", (ftnlen)542)], et, &handle, descr, - ident, &found, (ftnlen)40); - if (found) { - -/* Get the position of CTARG(I) relative to some */ -/* center of motion. This new center goes in */ -/* CTARG(I+1) and the position is called STEMP. */ - - ++i__; - spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgp0_", (ftnlen) - 552)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgp0_", (ftnlen)552)], & - ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "ctarg", i__3, "zzspkgp0_", (ftnlen)552)]); - -/* Here's what we have. STARG is the position of CTARG(I-1) */ -/* relative to CTARG(I) in reference frame TFRAME(I) */ - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - } - } - tframe[0] = tframe[1]; - -/* If the loop above ended because we ran out of */ -/* room in the arrays CTARG and STARG, then we */ -/* continue finding positions but we overwrite the */ -/* last elements of CTARG and STARG. */ - -/* If, as a result, the first common node is */ -/* overwritten, we'll just have to settle for */ -/* the last common node. This will cause a small */ -/* loss of precision, but it's better than other */ -/* alternatives. */ - - if (i__ == 20) { - while(found && ctarg[19] != 0 && ctarg[19] != *obs) { - -/* Find a file and segment that has position */ -/* data for CTARG(CHLEN). */ - - spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) - ; - if (found) { - -/* Get the position of CTARG(CHLEN) relative to */ -/* some center of motion. The new center */ -/* overwrites the old. The position is called */ -/* STEMP. */ - - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); - -/* Add STEMP to the position of TARG relative to */ -/* the old center to get the position of TARG */ -/* relative to the new center. Overwrite */ -/* the last element of STARG. */ - - if (tframe[19] == tmpfrm) { - moved_(&starg[114], &c__3, vtemp); - } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && - tframe[19] <= 21) { - irfrot_(&tframe[19], &tmpfrm, rot); - mxv_(rot, &starg[114], vtemp); - } else { - zzrefch0_(&tframe[19], &tmpfrm, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - mxv_(psxfrm, &starg[114], vtemp); - } - vadd_(vtemp, stemp, &starg[114]); - tframe[19] = tmpfrm; - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - } - } - } - nct = i__; - -/* NCT is the number of elements in CTARG, */ -/* the chain length. We have in hand the following information */ - -/* STARG(1...3,K) position of body */ -/* CTARG(K-1) relative to body CTARG(K) in the frame */ -/* TFRAME(K) */ - - -/* For K = 2,..., NCT. */ - -/* CTARG(1) = TARG */ -/* STARG(1...3,1) = ( 0, 0, 0 ) */ -/* TFRAME(1) = TFRAME(2) */ - - -/* Now follow the observer's chain. Assign */ -/* the first values for COBS and SOBS. */ - - cobs = *obs; - cleard_(&c__6, sobs); - -/* Perhaps we have a common node already. */ -/* If so it will be the last node on the */ -/* list CTARG. */ - -/* We let CTPOS will be the position of the common */ -/* node in CTARG if one is found. It will */ -/* be zero if COBS is not found in CTARG. */ - - if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", - i__1, "zzspkgp0_", (ftnlen)687)] == cobs) { - ctpos = nct; - cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgp0_", (ftnlen)689)]; - } else { - ctpos = 0; - } - -/* Repeat the same loop as above, but each time */ -/* we encounter a new center of motion, check to */ -/* see if it is a common node. (When CTPOS is */ -/* not zero, CTARG(CTPOS) is the first common node.) */ - -/* Note that we don't need a centers array nor a */ -/* positions array, just a single center and position */ -/* is sufficient --- we just keep overwriting them. */ -/* When the common node is found, we have everything */ -/* we need in that one center (COBS) and position */ -/* (SOBS-position of the target relative to COBS). */ - - found = TRUE_; - nofrm = TRUE_; - legs = 0; - while(found && cobs != 0 && ctpos == 0) { - -/* Find a file and segment that has position */ -/* data for COBS. */ - - spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); - if (found) { - -/* Get the position of COBS; call it STEMP. */ -/* The center of motion of COBS becomes the */ -/* new COBS. */ - - if (legs == 0) { - spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); - } else { - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); - } - if (nofrm) { - nofrm = FALSE_; - cframe = tmpfrm; - } - -/* Add STEMP to the position of OBS relative to */ -/* the old COBS to get the position of OBS */ -/* relative to the new COBS. */ - - if (cframe == tmpfrm) { - -/* On the first leg of the position of the observer, we */ -/* don't have to add anything, the position of the */ -/* observer is already in SOBS. We only have to add when */ -/* the number of legs in the observer position is one or */ -/* greater. */ - - if (legs > 0) { - vadd_(sobs, stemp, vtemp); - vequ_(vtemp, sobs); - } - } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= - 21) { - irfrot_(&cframe, &tmpfrm, rot); - mxv_(rot, sobs, vtemp); - vadd_(vtemp, stemp, sobs); - cframe = tmpfrm; - } else { - zzrefch0_(&cframe, &tmpfrm, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - mxv_(psxfrm, sobs, vtemp); - vadd_(vtemp, stemp, sobs); - cframe = tmpfrm; - } - -/* Check failed. We don't want to loop */ -/* indefinitely. */ - - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - -/* We now have one more leg of the path for OBS. Set */ -/* LEGS to reflect this. Then see if the new center */ -/* is a common node. If not, repeat the loop. */ - - ++legs; - ctpos = isrchi_(&cobs, &nct, ctarg); - } - } - -/* If CTPOS is zero at this point, it means we */ -/* have not found a common node though we have */ -/* searched through all the available data. */ - - if (ctpos == 0) { - bodc2n_(targ, tname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); - repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) - ; - } else { - intstr_(targ, tname, (ftnlen)40); - } - bodc2n_(obs, oname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); - repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); - } else { - intstr_(obs, oname, (ftnlen)40); - } - setmsg_("Insufficient ephemeris data has been loaded to compute the " - "position of TARG relative to OBS at the ephemeris epoch #. ", - (ftnlen)118); - etcal_(et, tstring, (ftnlen)80); - errch_("TARG", tname, (ftnlen)4, (ftnlen)40); - errch_("OBS", oname, (ftnlen)3, (ftnlen)40); - errch_("#", tstring, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - -/* If CTPOS is not zero, then we have reached a */ -/* common node, specifically, */ - -/* CTARG(CTPOS) = COBS = CENTER */ - -/* (in diagram below). The POSITION of the target */ -/* (TARG) relative to the observer (OBS) is just */ - -/* STARG(1,CTPOS) - SOBS. */ - - - -/* SOBS */ -/* CENTER ---------------->OBS */ -/* | . */ -/* | . N */ -/* S | . O */ -/* T | . I */ -/* A | . T */ -/* R | . I */ -/* G | . S */ -/* | . O */ -/* | . P */ -/* V L */ -/* TARG */ - - -/* And the light-time between them is just */ - -/* | POSITION | */ -/* LT = --------- */ -/* c */ - - -/* Compute the position of the target relative to CTARG(CTPOS) */ - - if (ctpos == 1) { - tframe[0] = cframe; - } - i__1 = ctpos - 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" - , i__2, "zzspkgp0_", (ftnlen)885)] == tframe[(i__3 = i__) < - 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgp0_", ( - ftnlen)885)]) { - vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgp0_", (ftnlen)887)], &starg[( - i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : - s_rnge("starg", i__3, "zzspkgp0_", (ftnlen)887)], stemp); - moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp0_", ( - ftnlen)888)]); - } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgp0_", (ftnlen)890)] > 0 && tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, - "zzspkgp0_", (ftnlen)890)] <= 21 && tframe[(i__2 = i__ - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgp0_", ( - ftnlen)890)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("tframe", i__2, "zzspkgp0_", (ftnlen)890)] <= - 21) { - irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgp0_", (ftnlen)892)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgp0_", (ftnlen)892)], rot); - mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgp0_", (ftnlen)893)], stemp); - vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 - ? i__2 : s_rnge("starg", i__2, "zzspkgp0_", (ftnlen)894)], - vtemp); - moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp0_", ( - ftnlen)895)]); - } else { - zzrefch0_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgp0_", (ftnlen)899)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgp0_", (ftnlen)899)], et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgp0_", (ftnlen)906)], - stemp); - vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 - ? i__2 : s_rnge("starg", i__2, "zzspkgp0_", (ftnlen)907)], - vtemp); - moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp0_", ( - ftnlen)908)]); - } - } - -/* To avoid unnecessary frame transformations we'll do */ -/* a bit of extra decision making here. It's a lot */ -/* faster to make logical checks than it is to compute */ -/* frame transformations. */ - - if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", - i__1, "zzspkgp0_", (ftnlen)921)] == cframe) { - vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp0_", (ftnlen)923)], sobs, pos); - } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgp0_", (ftnlen)925)] == refid) { - -/* If the last frame associated with the target is already */ -/* in the requested output frame, we convert the position of */ -/* the observer to that frame and then subtract the position */ -/* of the observer from the position of the target. */ - - if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - irfrot_(&cframe, &refid, rot); - mxv_(rot, sobs, stemp); - } else { - zzrefch0_(&cframe, &refid, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - mxv_(psxfrm, sobs, stemp); - } - -/* We've now transformed SOBS into the requested reference frame. */ -/* Set CFRAME to reflect this. */ - - cframe = refid; - vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp0_", (ftnlen)956)], stemp, pos); - } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgp0_", (ftnlen) - 959)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgp0_", (ftnlen)959)] <= 21) { - -/* If both frames are inertial we use IRFROT instead of */ -/* ZZREFCH0 to get things into a common frame. */ - - irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgp0_", (ftnlen)965)], &cframe, rot); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp0_", (ftnlen)966)], stemp); - vsub_(stemp, sobs, pos); - } else { - -/* Use the more general routine ZZREFCH0 to make the */ -/* transformation. */ - - zzrefch0_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgp0_", (ftnlen)974)], &cframe, - et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp0_", (ftnlen)981)], stemp); - vsub_(stemp, sobs, pos); - } - -/* Finally, rotate as needed into the requested frame. */ - - if (cframe == refid) { - -/* We don't have to do anything in this case. */ - - } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - -/* Since both frames are inertial, we use the more direct */ -/* routine IRFROT to get the transformation to REFID. */ - - irfrot_(&cframe, &refid, rot); - mxv_(rot, pos, stemp); - moved_(stemp, &c__3, pos); - } else { - zzrefch0_(&cframe, &refid, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; - } - mxv_(psxfrm, pos, stemp); - moved_(stemp, &c__3, pos); - } - *lt = vnorm_(pos) / clight_(); - chkout_("ZZSPKGP0", (ftnlen)8); - return 0; -} /* zzspkgp0_ */ - diff --git a/ext/spice/src/cspice/zzspkgp1.c b/ext/spice/src/cspice/zzspkgp1.c deleted file mode 100644 index de400254ff..0000000000 --- a/ext/spice/src/cspice/zzspkgp1.c +++ /dev/null @@ -1,1019 +0,0 @@ -/* zzspkgp1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__6 = 6; -static integer c__0 = 0; - -/* $Procedure ZZSPKGP1 ( S/P Kernel, geometric position ) */ -/* Subroutine */ int zzspkgp1_(integer *targ, doublereal *et, char *ref, - integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - extern /* Subroutine */ int zzrefch1_(integer *, integer *, doublereal *, - doublereal *), vadd_(doublereal *, doublereal *, doublereal *); - integer cobs, legs; - doublereal sobs[6]; - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer i__; - extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen); - char oname[40]; - doublereal descr[5]; - integer ctarg[20]; - char ident[40], tname[40]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - moved_(doublereal *, integer *, doublereal *); - logical found; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - doublereal starg[120] /* was [6][20] */; - logical nofrm; - doublereal stemp[6]; - integer ctpos; - doublereal vtemp[6]; - extern doublereal vnorm_(doublereal *); - extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - integer handle, cframe; - extern doublereal clight_(void); - integer tframe[20]; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); - extern integer isrchi_(integer *, integer *, integer *); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen), - irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - integer tmpfrm; - extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), - spksfs_(integer *, doublereal *, integer *, doublereal *, char *, - logical *, ftnlen); - extern integer frstnp_(char *, ftnlen); - extern logical return_(void); - doublereal psxfrm[9] /* was [3][3] */; - extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, - integer *, doublereal *, integer *), intstr_(integer *, char *, - ftnlen); - integer nct; - doublereal rot[9] /* was [3][3] */; - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - char tstring[80]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Compute the geometric position of a target body relative to an */ -/* observing body. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* This file contains the number of inertial reference */ -/* frames that are currently known by the SPICE toolkit */ -/* software. */ - -/* $ 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 */ - -/* FRAMES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NINERT P Number of known inertial reference frames. */ - -/* $ Parameters */ - -/* NINERT is the number of recognized inertial reference */ -/* frames. This value is needed by both CHGIRF */ -/* ZZFDAT, and FRAMEX. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* OBS I Observing body. */ -/* POS O Position of target. */ -/* LT O Light time. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the position */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to */ -/* which the vectors returned by the routine should */ -/* be rotated. This may be any frame supported by */ -/* the SPICELIB subroutine ZZREFCH1. */ - -/* OBS is the standard NAIF ID code for an observing body. */ - -/* $ Detailed_Output */ - -/* POS contains the position of the target */ -/* body, relative to the observing body. This vector is */ -/* rotated into the specified reference frame. Units */ -/* are always km. */ - -/* LT is the one-way light time from the observing body */ -/* to the geometric position of the target body at the */ -/* specified epoch. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient ephemeris data has been loaded to compute */ -/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */ -/* signalled. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* ZZSPKGP1 computes the geometric position, T(t), of the target */ -/* body and the geometric position, O(t), of the observing body */ -/* relative to the first common center of motion. Subtracting */ -/* O(t) from T(t) gives the geometric position of the target */ -/* body relative to the observer. */ - - -/* CENTER ----- O(t) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(t) - O(t) */ -/* | / */ -/* T(t) */ - - -/* The one-way light time, tau, is given by */ - - -/* | T(t) - O(t) | */ -/* tau = ----------------- */ -/* c */ - - -/* For example, if the observing body is -94, the Mars Observer */ -/* spacecraft, and the target body is 401, Phobos, then the */ -/* first common center is probably 4, the Mars Barycenter. */ -/* O(t) is the position of -94 relative to 4 and T(t) is the */ -/* position of 401 relative to 4. */ - -/* The center could also be the Solar System Barycenter, body 0. */ -/* For example, if the observer is 399, Earth, and the target */ -/* is 299, Venus, then O(t) would be the position of 399 relative */ -/* to 0 and T(t) would be the position of 299 relative to 0. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the positions of the target body and observer */ -/* relative to a common center. ZZSPKGP1 reads as many segments */ -/* as necessary, from as many files as necessary, using files */ -/* that have been loaded by previous calls to SPKLEF (load */ -/* ephemeris file). */ - -/* ZZSPKGP1 is similar to SPKGEO but returns geometric positions */ -/* only. */ - -/* $ Examples */ - -/* The following code example computes the geometric */ -/* position of the moon with respect to the earth and */ -/* then prints the distance of the moon from the */ -/* the earth at a number of epochs. */ - -/* Assume the SPK file SAMPLE.BSP contains ephemeris data */ -/* for the moon relative to earth over the time interval */ -/* from BEGIN to END. */ - -/* INTEGER EARTH */ -/* PARAMETER ( EARTH = 399 ) */ - -/* INTEGER MOON */ -/* PARAMETER ( MOON = 301 ) */ - -/* INTEGER N */ -/* PARAMETER ( N = 100 ) */ - -/* INTEGER HANDLE */ -/* CHARACTER*(20) UTC */ -/* DOUBLE PRECISION BEGIN */ -/* DOUBLE PRECISION DELTA */ -/* DOUBLE PRECISION END */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* C */ -/* C Load the binary SPK ephemeris file. */ -/* C */ -/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */ - -/* . */ -/* . */ -/* . */ - -/* C */ -/* C Divide the interval of coverage [BEGIN,END] into */ -/* C N steps. At each step, compute the position, and */ -/* C print out the epoch in UTC time and position norm. */ -/* C */ -/* DELTA = ( END - BEGIN ) / N */ - -/* DO I = 0, N */ - -/* ET = BEGIN + I*DELTA */ - -/* CALL ZZSPKGP1 ( MOON, ET, 'J2000', EARTH, POS, LT ) */ - -/* CALL ET2UTC ( ET, 'C', 0, UTC ) */ - -/* WRITE (*,*) UTC, VNORM ( POS ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKGP1 must be loaded */ -/* by SPKLEF before ZZSPKGP1 is called. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 09-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD calls. */ - -/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ - -/* Based on SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* geometric position of one body relative to another */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 09-NOV-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VADD calls. */ - -/* -& */ - -/* This is the idea: */ - -/* Every body moves with respect to some center. The center */ -/* is itself a body, which in turn moves about some other */ -/* center. If we begin at the target body (T), follow */ -/* the chain, */ - -/* T */ -/* \ */ -/* SSB \ */ -/* \ C[1] */ -/* \ / */ -/* \ / */ -/* \ / */ -/* \ / */ -/* C[3]-----------C[2] */ - -/* and avoid circular definitions (A moves about B, and B moves */ -/* about A), eventually we get the position relative to the solar */ -/* system barycenter (which, for our purposes, doesn't move). */ -/* Thus, */ - -/* T = T + C[1] + C[2] + ... + C[n] */ -/* SSB C[1] C[2] [C3] SSB */ - -/* where */ - -/* X */ -/* Y */ - -/* is the position of body X relative to body Y. */ - -/* However, we don't want to follow each chain back to the SSB */ -/* if it isn't necessary. Instead we will just follow the chain */ -/* of the target body and follow the chain of the observing body */ -/* until we find a common node in the tree. */ - -/* In the example below, C is the first common node. We compute */ -/* the position of TARG relative to C and the position of OBS */ -/* relative to C, then subtract the two positions. */ - -/* TARG */ -/* \ */ -/* SSB \ */ -/* \ A */ -/* \ / OBS */ -/* \ / | */ -/* \ / | */ -/* \ / | */ -/* B-------------C-----------------D */ - - - - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* CHLEN is the maximum length of a chain. That is, */ -/* it is the maximum number of bodies in the chain from */ -/* the target or observer to the SSB. */ - - -/* Local variables */ - - -/* In-line Function Definitions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKGP1", (ftnlen)8); - } - -/* We take care of the obvious case first. It TARG and OBS are the */ -/* same we can just fill in zero. */ - - if (*targ == *obs) { - *lt = 0.; - cleard_(&c__3, pos); - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - -/* CTARG contains the integer codes of the bodies in the */ -/* target body chain, beginning with TARG itself and then */ -/* the successive centers of motion. */ - -/* STARG(1,I) is the position of the target body relative */ -/* to CTARG(I). The id-code of the frame of this position is */ -/* stored in TFRAME(I). */ - -/* COBS and SOBS will contain the centers and positions of the */ -/* observing body. (They are single elements instead of arrays */ -/* because we only need the current center and position of the */ -/* observer relative to it.) */ - -/* First, we construct CTARG and STARG. CTARG(1) is */ -/* just the target itself, and STARG(1,1) is just a zero */ -/* vector, that is, the position of the target relative */ -/* to itself. */ - -/* Then we follow the chain, filling up CTARG and STARG */ -/* as we go. We use SPKSFS to search through loaded */ -/* files to find the first segment applicable to CTARG(1) */ -/* and time ET. Then we use SPKPVN to compute the position */ -/* of the body CTARG(1) at ET in the segment that was found */ -/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ - -/* We repeat the process for CTARG(2) and so on, until */ -/* there is no data found for some CTARG(I) or until we */ -/* reach the SSB. */ - -/* Next, we find centers and positions in a similar manner */ -/* for the observer. It's a similar construction as */ -/* described above, but I is always 1. COBS and SOBS */ -/* are overwritten with each new center and position, */ -/* beginning at OBS. However, we stop when we encounter */ -/* a common center of motion, that is when COBS is equal */ -/* to CTARG(I) for some I. */ - -/* Finally, we compute the desired position of the target */ -/* relative to the observer by subtracting the position of */ -/* the observing body relative to the common node from */ -/* the position of the target body relative to the common */ -/* node. */ - -/* CTPOS is the position in CTARG of the common node. */ - - -/* Since Inertial frames are the most extensively used frames */ -/* we use the more restrictive routine IRFNUM to attempt to */ -/* look up the id-code for REF. If IRFNUM comes up empty handed */ -/* we then call the more general routine NAMFRM. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - namfrm_(ref, &refid, ref_len); - } - if (refid == 0) { - if (frstnp_(ref, ref_len) > 0) { - setmsg_("The string supplied to specify the reference frame, ('#" - "') contains non-printing characters. The two most commo" - "n causes for this kind of error are: 1. an error in the " - "call to ZZSPKGP1; 2. an uninitialized variable. ", ( - ftnlen)215); - errch_("#", ref, (ftnlen)1, ref_len); - } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { - setmsg_("The string supplied to specify the reference frame is b" - "lank. The most common cause for this kind of error is a" - "n uninitialized variable. ", (ftnlen)137); - } else { - setmsg_("The string supplied to specify the reference frame was " - "'#'. This frame is not recognized. Possible causes for " - "this error are: 1. failure to load the frame definition " - "into the kernel pool; 2. An out-of-date edition of the t" - "oolkit. ", (ftnlen)231); - errch_("#", ref, (ftnlen)1, ref_len); - } - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - } - -/* Fill in CTARG and STARG until no more data is found */ -/* or until we reach the SSB. If the chain gets too */ -/* long to fit in CTARG, that is if I equals CHLEN, */ -/* then overwrite the last elements of CTARG and STARG. */ - -/* Note the check for FAILED in the loop. If SPKSFS */ -/* or SPKPVN happens to fail during execution, and the */ -/* current error handling action is to NOT abort, then */ -/* FOUND may be stuck at TRUE, CTARG(I) will never */ -/* become zero, and the loop will execute indefinitely. */ - - -/* Construct CTARG and STARG. Begin by assigning the */ -/* first elements: TARG and the position of TARG relative */ -/* to itself. */ - - i__ = 1; - ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, - "zzspkgp1_", (ftnlen)527)] = *targ; - found = TRUE_; - cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)530)]); - while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("ctarg", i__1, "zzspkgp1_", (ftnlen)532)] != *obs && - ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", - i__2, "zzspkgp1_", (ftnlen)532)] != 0) { - -/* Find a file and segment that has position */ -/* data for CTARG(I). */ - - spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "ctarg", i__1, "zzspkgp1_", (ftnlen)541)], et, &handle, descr, - ident, &found, (ftnlen)40); - if (found) { - -/* Get the position of CTARG(I) relative to some */ -/* center of motion. This new center goes in */ -/* CTARG(I+1) and the position is called STEMP. */ - - ++i__; - spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= - i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen) - 551)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)551)], & - ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "ctarg", i__3, "zzspkgp1_", (ftnlen)551)]); - -/* Here's what we have. STARG is the position of CTARG(I-1) */ -/* relative to CTARG(I) in reference frame TFRAME(I) */ - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - } - } - tframe[0] = tframe[1]; - -/* If the loop above ended because we ran out of */ -/* room in the arrays CTARG and STARG, then we */ -/* continue finding positions but we overwrite the */ -/* last elements of CTARG and STARG. */ - -/* If, as a result, the first common node is */ -/* overwritten, we'll just have to settle for */ -/* the last common node. This will cause a small */ -/* loss of precision, but it's better than other */ -/* alternatives. */ - - if (i__ == 20) { - while(found && ctarg[19] != 0 && ctarg[19] != *obs) { - -/* Find a file and segment that has position */ -/* data for CTARG(CHLEN). */ - - spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) - ; - if (found) { - -/* Get the position of CTARG(CHLEN) relative to */ -/* some center of motion. The new center */ -/* overwrites the old. The position is called */ -/* STEMP. */ - - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); - -/* Add STEMP to the position of TARG relative to */ -/* the old center to get the position of TARG */ -/* relative to the new center. Overwrite */ -/* the last element of STARG. */ - - if (tframe[19] == tmpfrm) { - moved_(&starg[114], &c__3, vtemp); - } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && - tframe[19] <= 21) { - irfrot_(&tframe[19], &tmpfrm, rot); - mxv_(rot, &starg[114], vtemp); - } else { - zzrefch1_(&tframe[19], &tmpfrm, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - mxv_(psxfrm, &starg[114], vtemp); - } - vadd_(vtemp, stemp, &starg[114]); - tframe[19] = tmpfrm; - -/* If one of the routines above failed during */ -/* execution, we just give up and check out. */ - - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - } - } - } - nct = i__; - -/* NCT is the number of elements in CTARG, */ -/* the chain length. We have in hand the following information */ - -/* STARG(1...3,K) position of body */ -/* CTARG(K-1) relative to body CTARG(K) in the frame */ -/* TFRAME(K) */ - - -/* For K = 2,..., NCT. */ - -/* CTARG(1) = TARG */ -/* STARG(1...3,1) = ( 0, 0, 0 ) */ -/* TFRAME(1) = TFRAME(2) */ - - -/* Now follow the observer's chain. Assign */ -/* the first values for COBS and SOBS. */ - - cobs = *obs; - cleard_(&c__6, sobs); - -/* Perhaps we have a common node already. */ -/* If so it will be the last node on the */ -/* list CTARG. */ - -/* We let CTPOS will be the position of the common */ -/* node in CTARG if one is found. It will */ -/* be zero if COBS is not found in CTARG. */ - - if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", - i__1, "zzspkgp1_", (ftnlen)686)] == cobs) { - ctpos = nct; - cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgp1_", (ftnlen)688)]; - } else { - ctpos = 0; - } - -/* Repeat the same loop as above, but each time */ -/* we encounter a new center of motion, check to */ -/* see if it is a common node. (When CTPOS is */ -/* not zero, CTARG(CTPOS) is the first common node.) */ - -/* Note that we don't need a centers array nor a */ -/* positions array, just a single center and position */ -/* is sufficient --- we just keep overwriting them. */ -/* When the common node is found, we have everything */ -/* we need in that one center (COBS) and position */ -/* (SOBS-position of the target relative to COBS). */ - - found = TRUE_; - nofrm = TRUE_; - legs = 0; - while(found && cobs != 0 && ctpos == 0) { - -/* Find a file and segment that has position */ -/* data for COBS. */ - - spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); - if (found) { - -/* Get the position of COBS; call it STEMP. */ -/* The center of motion of COBS becomes the */ -/* new COBS. */ - - if (legs == 0) { - spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); - } else { - spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); - } - if (nofrm) { - nofrm = FALSE_; - cframe = tmpfrm; - } - -/* Add STEMP to the position of OBS relative to */ -/* the old COBS to get the position of OBS */ -/* relative to the new COBS. */ - - if (cframe == tmpfrm) { - -/* On the first leg of the position of the observer, we */ -/* don't have to add anything, the position of the */ -/* observer is already in SOBS. We only have to add when */ -/* the number of legs in the observer position is one or */ -/* greater. */ - - if (legs > 0) { - vadd_(sobs, stemp, vtemp); - vequ_(vtemp, sobs); - } - } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= - 21) { - irfrot_(&cframe, &tmpfrm, rot); - mxv_(rot, sobs, vtemp); - vadd_(vtemp, stemp, sobs); - cframe = tmpfrm; - } else { - zzrefch1_(&cframe, &tmpfrm, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - mxv_(psxfrm, sobs, vtemp); - vadd_(vtemp, stemp, sobs); - cframe = tmpfrm; - } - -/* Check failed. We don't want to loop */ -/* indefinitely. */ - - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - -/* We now have one more leg of the path for OBS. Set */ -/* LEGS to reflect this. Then see if the new center */ -/* is a common node. If not, repeat the loop. */ - - ++legs; - ctpos = isrchi_(&cobs, &nct, ctarg); - } - } - -/* If CTPOS is zero at this point, it means we */ -/* have not found a common node though we have */ -/* searched through all the available data. */ - - if (ctpos == 0) { - bodc2n_(targ, tname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); - repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) - ; - } else { - intstr_(targ, tname, (ftnlen)40); - } - bodc2n_(obs, oname, &found, (ftnlen)40); - if (found) { - prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); - suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); - repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); - } else { - intstr_(obs, oname, (ftnlen)40); - } - setmsg_("Insufficient ephemeris data has been loaded to compute the " - "position of TARG relative to OBS at the ephemeris epoch #. ", - (ftnlen)118); - etcal_(et, tstring, (ftnlen)80); - errch_("TARG", tname, (ftnlen)4, (ftnlen)40); - errch_("OBS", oname, (ftnlen)3, (ftnlen)40); - errch_("#", tstring, (ftnlen)1, (ftnlen)80); - sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - -/* If CTPOS is not zero, then we have reached a */ -/* common node, specifically, */ - -/* CTARG(CTPOS) = COBS = CENTER */ - -/* (in diagram below). The POSITION of the target */ -/* (TARG) relative to the observer (OBS) is just */ - -/* STARG(1,CTPOS) - SOBS. */ - - - -/* SOBS */ -/* CENTER ---------------->OBS */ -/* | . */ -/* | . N */ -/* S | . O */ -/* T | . I */ -/* A | . T */ -/* R | . I */ -/* G | . S */ -/* | . O */ -/* | . P */ -/* V L */ -/* TARG */ - - -/* And the light-time between them is just */ - -/* | POSITION | */ -/* LT = --------- */ -/* c */ - - -/* Compute the position of the target relative to CTARG(CTPOS) */ - - if (ctpos == 1) { - tframe[0] = cframe; - } - i__1 = ctpos - 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" - , i__2, "zzspkgp1_", (ftnlen)884)] == tframe[(i__3 = i__) < - 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgp1_", ( - ftnlen)884)]) { - vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)886)], &starg[( - i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : - s_rnge("starg", i__3, "zzspkgp1_", (ftnlen)886)], stemp); - moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", ( - ftnlen)887)]); - } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgp1_", (ftnlen)889)] > 0 && tframe[( - i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, - "zzspkgp1_", (ftnlen)889)] <= 21 && tframe[(i__2 = i__ - 1) < - 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgp1_", ( - ftnlen)889)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 - ? i__2 : s_rnge("tframe", i__2, "zzspkgp1_", (ftnlen)889)] <= - 21) { - irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgp1_", (ftnlen)891)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgp1_", (ftnlen)891)], rot); - mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : - s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)892)], stemp); - vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 - ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)893)], - vtemp); - moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", ( - ftnlen)894)]); - } else { - zzrefch1_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : - s_rnge("tframe", i__2, "zzspkgp1_", (ftnlen)898)], & - tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( - "tframe", i__3, "zzspkgp1_", (ftnlen)898)], et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? - i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)905)], - stemp); - vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 - ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)906)], - vtemp); - moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 - <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", ( - ftnlen)907)]); - } - } - -/* To avoid unnecessary frame transformations we'll do */ -/* a bit of extra decision making here. It's a lot */ -/* faster to make logical checks than it is to compute */ -/* frame transformations. */ - - if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", - i__1, "zzspkgp1_", (ftnlen)920)] == cframe) { - vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)922)], sobs, pos); - } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgp1_", (ftnlen)924)] == refid) { - -/* If the last frame associated with the target is already */ -/* in the requested output frame, we convert the position of */ -/* the observer to that frame and then subtract the position */ -/* of the observer from the position of the target. */ - - if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - irfrot_(&cframe, &refid, rot); - mxv_(rot, sobs, stemp); - } else { - zzrefch1_(&cframe, &refid, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - mxv_(psxfrm, sobs, stemp); - } - -/* We've now transformed SOBS into the requested reference frame. */ -/* Set CFRAME to reflect this. */ - - cframe = refid; - vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)955)], stemp, pos); - } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && - 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen) - 958)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen)958)] <= 21) { - -/* If both frames are inertial we use IRFROT instead of */ -/* ZZREFCH1 to get things into a common frame. */ - - irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "tframe", i__1, "zzspkgp1_", (ftnlen)964)], &cframe, rot); - mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)965)], stemp); - vsub_(stemp, sobs, pos); - } else { - -/* Use the more general routine ZZREFCH1 to make the */ -/* transformation. */ - - zzrefch1_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen)973)], &cframe, - et, psxfrm); - mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : - s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)974)], stemp); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - vsub_(stemp, sobs, pos); - } - -/* Finally, rotate as needed into the requested frame. */ - - if (cframe == refid) { - -/* We don't have to do anything in this case. */ - - } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { - -/* Since both frames are inertial, we use the more direct */ -/* routine IRFROT to get the transformation to REFID. */ - - irfrot_(&cframe, &refid, rot); - mxv_(rot, pos, stemp); - moved_(stemp, &c__3, pos); - } else { - zzrefch1_(&cframe, &refid, et, psxfrm); - if (failed_()) { - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; - } - mxv_(psxfrm, pos, stemp); - moved_(stemp, &c__3, pos); - } - *lt = vnorm_(pos) / clight_(); - chkout_("ZZSPKGP1", (ftnlen)8); - return 0; -} /* zzspkgp1_ */ - diff --git a/ext/spice/src/cspice/zzspklt0.c b/ext/spice/src/cspice/zzspklt0.c deleted file mode 100644 index db2e8c83b2..0000000000 --- a/ext/spice/src/cspice/zzspklt0.c +++ /dev/null @@ -1,920 +0,0 @@ -/* zzspklt0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__6 = 6; -static doublereal c_b25 = -1.; - -/* $Procedure ZZSPKLT0 ( S/P Kernel, light time corrected state ) */ -/* Subroutine */ int zzspklt0_(integer *targ, doublereal *et, char *ref, char - *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, - doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal dist; - extern /* Subroutine */ int zzspkgo0_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen); - extern doublereal vdot_(doublereal *, doublereal *); - static logical xmit; - doublereal a, b, c__; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - static logical usecn; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *, - integer *, doublereal *); - doublereal ssblt; - static logical uselt; - extern doublereal vnorm_(doublereal *); - extern logical failed_(void); - extern doublereal clight_(void); - logical attblk[15]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer ltsign; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_( - char *, ftnlen); - doublereal ssbtrg[6]; - integer numitr; - extern logical return_(void); - logical usestl; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time, */ -/* expressed relative to an inertial reference frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* STOBS I State of the observer relative to the SSB. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the input state STOBS and the output state STARG are */ -/* expressed. REF must be recognized by the SPICE */ -/* Toolkit. The acceptable frames are listed in the */ -/* Frames Required Reading, as well as in the SPICELIB */ -/* routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time. See the discussion in the Particulars */ -/* section for recommendations on how to choose */ -/* aberration corrections. */ - -/* If ABCORR includes the stellar aberration correction */ -/* symbol '+S', this flag is simply ignored. Aside from */ -/* the possible presence of this symbol, ABCORR may be */ -/* any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* STOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* STOBS is a 6-vector: the first three components of */ -/* STOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. STOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberration, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for light time, then LT is the one-way light time */ -/* between the observer and the light time-corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) For the convenience of the caller, the input aberration */ -/* correction flag can call for stellar aberration correction via */ -/* inclusion of the '+S' suffix. This portion of the aberration */ -/* correction flag is ignored if present. */ - -/* 2) If ABCORR calls for stellar aberration but not light */ -/* time corrections, the error SPICE(NOTSUPPORTED) is */ -/* signaled. */ - -/* 3) If ABCORR calls for relativistic light time corrections, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 5) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 6) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 7) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* 8) If a division by zero error would occur in the computation */ -/* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ -/* User applications normally will not need to call this routine */ -/* directly. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time corrections. Compute the first state for */ -/* the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */ -/* intervals of 1 hour. For each epoch, display the states, the */ -/* one way light time between target and observer, and the rate of */ -/* change of the one way light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STOBS ( 6 ) */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time ('LT') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ -/* C Before we can execute this computation, we'll need the */ -/* C geometric state of the observer relative to the solar */ -/* C system barycenter at ET, expressed relative to the */ -/* C J2000 reference frame: */ -/* C */ -/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ -/* C */ -/* C Now compute the desired state vector: */ -/* C */ -/* CALL SPKLTC ( 301, ET, 'J2000', 'LT', */ -/* . STOBS, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291569.265 */ -/* J2000 y-position (km): -266709.186 */ -/* J2000 z-position (km): -76099.1551 */ -/* J2000 x-velocity (km/s): 0.643530613 */ -/* J2000 y-velocity (km/s): -0.666081817 */ -/* J2000 z-velocity (km/s): -0.301322832 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289240.781 */ -/* J2000 y-position (km): -269096.441 */ -/* J2000 z-position (km): -77180.8997 */ -/* J2000 x-velocity (km/s): 0.650062115 */ -/* J2000 y-velocity (km/s): -0.660162739 */ -/* J2000 z-velocity (km/s): -0.299642674 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286888.887 */ -/* J2000 y-position (km): -271462.302 */ -/* J2000 z-position (km): -78256.5557 */ -/* J2000 x-velocity (km/s): 0.656535992 */ -/* J2000 y-velocity (km/s): -0.654196577 */ -/* J2000 z-velocity (km/s): -0.297940273 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284513.792 */ -/* J2000 y-position (km): -273806.6 */ -/* J2000 z-position (km): -79326.0432 */ -/* J2000 x-velocity (km/s): 0.662951901 */ -/* J2000 y-velocity (km/s): -0.648183807 */ -/* J2000 z-velocity (km/s): -0.296215779 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282115.704 */ -/* J2000 y-position (km): -276129.17 */ -/* J2000 z-position (km): -80389.283 */ -/* J2000 x-velocity (km/s): 0.669309504 */ -/* J2000 y-velocity (km/s): -0.642124908 */ -/* J2000 z-velocity (km/s): -0.294469343 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) The routine SPKGEO should be used instead of this routine */ -/* to compute geometric states. SPKGEO introduces less */ -/* round-off error when the observer and target have common */ -/* center that is closer to both objects than is the solar */ -/* system barycenter. */ - -/* 2) The kernel files to be used by SPKLTC must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level light time correction */ -/* light-time corrected state from spk file */ -/* get light-time corrected state */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* TOL is the tolerance used for a division-by-zero test */ -/* performed prior to computation of DLT. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKLT0", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } else if (attblk[5]) { - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } - -/* Find the geometric state of the target body with respect to */ -/* the solar system barycenter. Subtract the state of the */ -/* observer to get the relative state. Use this to compute the */ -/* one-way light time. */ - - zzspkgo0_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len); - vsubg_(ssbtrg, stobs, &c__6, starg); - dist = vnorm_(starg); - *lt = dist / clight_(); - if (*lt == 0.) { - -/* This can happen only if the observer and target are at the */ -/* same position. We don't consider this an error, but we're not */ -/* going to compute the light time derivative. */ - - *dlt = 0.; - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } - if (! uselt) { - -/* This is a special case: we're not using light time */ -/* corrections, so the derivative */ -/* of light time is just */ - -/* (1/c) * d(VNORM(STARG))/dt */ - - *dlt = vdot_(starg, &starg[3]) / (dist * clight_()); - -/* LT and DLT are both set, so we can return. */ - - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } - -/* To correct for light time, find the state of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where it is. */ - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Let NUMITR be the number of iterations we'll perform to */ -/* compute the light time. */ - - if (usecn) { - numitr = 3; - } else { - numitr = 1; - } - i__1 = numitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - zzspkgo0_(targ, &d__1, ref, &c__0, ssbtrg, &ssblt, ref_len); - vsubg_(ssbtrg, stobs, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - } - -/* At this point, STARG contains the light time corrected */ -/* state of the target relative to the observer. */ - -/* Compute the derivative of light time with respect */ -/* to time: dLT/dt. Below we derive the formula for */ -/* this quantity for the reception case. Let */ - -/* POBS be the position of the observer relative to the */ -/* solar system barycenter. */ - -/* VOBS be the velocity of the observer relative to the */ -/* solar system barycenter. */ - -/* PTARG be the position of the target relative to the */ -/* solar system barycenter. */ - -/* VTARG be the velocity of the target relative to the */ -/* solar system barycenter. */ - -/* S be the sign of the light time correction. S is */ -/* negative for the reception case. */ - -/* The light-time corrected position of the target relative to */ -/* the observer at observation time ET, given the one-way */ -/* light time LT is: */ - -/* PTARG(ET+S*LT) - POBS(ET) */ - -/* The light-time corrected velocity of the target relative to */ -/* the observer at observation time ET is */ - -/* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */ - -/* We need to compute dLT/dt. Below, we use the facts that, */ -/* for a time-dependent vector X(t), */ - -/* ||X|| = ** (1/2) */ - -/* d(||X||)/dt = (1/2)**(-1/2) * 2 * */ - -/* = **(-1/2) * */ - -/* = / ||X|| */ - -/* Newtonian light time equation: */ - -/* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */ - -/* Differentiate both sides: */ - -/* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* * < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */ - - -/* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* * ( < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT) - VOBS(ET) > */ - -/* + < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */ - -/* Let */ - -/* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */ - -/* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */ - -/* Then */ - -/* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */ - -/* which implies */ - -/* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */ - - - - a = 1. / (clight_() * vnorm_(starg)); - b = vdot_(starg, &starg[3]); - c__ = vdot_(starg, &ssbtrg[3]); - -/* For physically realistic target velocities, S*C*A cannot equal 1. */ -/* We'll check for this case anyway. */ - - if (ltsign * c__ * a > .99999999989999999) { - setmsg_("Target range rate magnitude is approximately the speed of l" - "ight. The light time derivative cannot be computed.", (ftnlen) - 110); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; - } - -/* Compute DLT: the rate of change of light time. */ - - *dlt = a * b / (1. - ltsign * c__ * a); - -/* Overwrite the velocity portion of the output state */ -/* with the light-time corrected velocity. */ - - d__1 = ltsign * *dlt + 1.; - vlcom_(&d__1, &ssbtrg[3], &c_b25, &stobs[3], &starg[3]); - chkout_("ZZSPKLT0", (ftnlen)8); - return 0; -} /* zzspklt0_ */ - diff --git a/ext/spice/src/cspice/zzspklt1.c b/ext/spice/src/cspice/zzspklt1.c deleted file mode 100644 index 91ee66e1bf..0000000000 --- a/ext/spice/src/cspice/zzspklt1.c +++ /dev/null @@ -1,920 +0,0 @@ -/* zzspklt1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__6 = 6; -static doublereal c_b25 = -1.; - -/* $Procedure ZZSPKLT1 ( S/P Kernel, light time corrected state ) */ -/* Subroutine */ int zzspklt1_(integer *targ, doublereal *et, char *ref, char - *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, - doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal dist; - extern /* Subroutine */ int zzspkgo1_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen); - extern doublereal vdot_(doublereal *, doublereal *); - static logical xmit; - doublereal a, b, c__; - integer i__; - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen); - integer refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - static logical usecn; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *, - integer *, doublereal *); - doublereal ssblt; - static logical uselt; - extern doublereal vnorm_(doublereal *); - extern logical failed_(void); - extern doublereal clight_(void); - logical attblk[15]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer ltsign; - extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_( - char *, ftnlen); - doublereal ssbtrg[6]; - integer numitr; - extern logical return_(void); - logical usestl; - -/* $ Abstract */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observer, optionally corrected for light time, */ -/* expressed relative to an inertial reference frame. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of output state. */ -/* ABCORR I Aberration correction flag. */ -/* STOBS I State of the observer relative to the SSB. */ -/* STARG O State of target. */ -/* LT O One way light time between observer and target. */ -/* DLT O Derivative of light time with respect to time. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a state vector whose position */ -/* component points from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the state of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the input state STOBS and the output state STARG are */ -/* expressed. REF must be recognized by the SPICE */ -/* Toolkit. The acceptable frames are listed in the */ -/* Frames Required Reading, as well as in the SPICELIB */ -/* routine CHGIRF. */ - -/* Case and blanks are not significant in the string */ -/* REF. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the state of the target body to account for one-way */ -/* light time. See the discussion in the Particulars */ -/* section for recommendations on how to choose */ -/* aberration corrections. */ - -/* If ABCORR includes the stellar aberration correction */ -/* symbol '+S', this flag is simply ignored. Aside from */ -/* the possible presence of this symbol, ABCORR may be */ -/* any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric state of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the state of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* state of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - - -/* STOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* STOBS is a 6-vector: the first three components of */ -/* STOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. STOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - -/* $ Detailed_Output */ - -/* STARG is a Cartesian state vector representing the position */ -/* and velocity of the target body relative to the */ -/* specified observer. STARG is corrected for the */ -/* specified aberration, and is expressed with respect */ -/* to the specified inertial reference frame. The first */ -/* three components of STARG represent the x-, y- and */ -/* z-components of the target's position; last three */ -/* components form the corresponding velocity vector. */ - -/* The position component of STARG points from the */ -/* observer's location at ET to the aberration-corrected */ -/* location of the target. Note that the sense of the */ -/* position vector is independent of the direction of */ -/* radiation travel implied by the aberration */ -/* correction. */ - -/* Units are always km and km/sec. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target state is corrected */ -/* for light time, then LT is the one-way light time */ -/* between the observer and the light time-corrected */ -/* target location. */ - -/* DLT is the derivative with respect to barycentric */ -/* dynamical time of the one way light time between */ -/* target and observer: */ - -/* DLT = d(LT)/d(ET) */ - -/* DLT can also be described as the rate of change of */ -/* one way light time. DLT is unitless, since LT and */ -/* ET both have units of TDB seconds. */ - -/* If the observer and target are at the same position, */ -/* then DLT is set to zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) For the convenience of the caller, the input aberration */ -/* correction flag can call for stellar aberration correction via */ -/* inclusion of the '+S' suffix. This portion of the aberration */ -/* correction flag is ignored if present. */ - -/* 2) If ABCORR calls for stellar aberration but not light */ -/* time corrections, the error SPICE(NOTSUPPORTED) is */ -/* signaled. */ - -/* 3) If ABCORR calls for relativistic light time corrections, the */ -/* error SPICE(NOTSUPPORTED) is signaled. */ - -/* 4) If the value of ABCORR is not recognized, the error */ -/* is diagnosed by a routine in the call tree of this */ -/* routine. */ - -/* 5) If the reference frame requested is not a recognized */ -/* inertial reference frame, the error SPICE(BADFRAME) */ -/* is signaled. */ - -/* 6) If the state of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* 7) If the observer and target are at the same position, */ -/* then DLT is set to zero. This situation could arise, */ -/* for example, when the observer is Mars and the target */ -/* is the Mars barycenter. */ - -/* 8) If a division by zero error would occur in the computation */ -/* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */ - -/* $ Files */ - -/* This routine computes states using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute STARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute the state. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* This routine supports higher-level SPK API routines that can */ -/* perform both light time and stellar aberration corrections. */ -/* User applications normally will not need to call this routine */ -/* directly. */ - -/* See the header of the routine SPKEZR for a detailed discussion */ -/* of aberration corrections. */ - -/* $ Examples */ - - -/* 1) Look up a sequence of states of the Moon as seen from the */ -/* Earth. Use light time corrections. Compute the first state for */ -/* the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */ -/* intervals of 1 hour. For each epoch, display the states, the */ -/* one way light time between target and observer, and the rate of */ -/* change of the one way light time. */ - -/* Use the following meta-kernel to specify the kernels to */ -/* load: */ - -/* KPL/MK */ - -/* This meta-kernel is intended to support operation of SPICE */ -/* example programs. The kernels shown here should not be */ -/* assumed to contain adequate or correct versions of data */ -/* required by SPICE-based user applications. */ - -/* In order for an application to use this meta-kernel, the */ -/* kernels referenced here must be present in the user's */ -/* current working directory. */ - - -/* \begindata */ - -/* KERNELS_TO_LOAD = ( 'de418.bsp', */ -/* 'pck00008.tpc', */ -/* 'naif0008.tls' ) */ - -/* \begintext */ - - -/* The code example follows: */ - -/* PROGRAM EX1 */ -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* C The meta-kernel name shown here refers to a file whose */ -/* C contents are those shown above. This file and the kernels */ -/* C it references must exist in your current working directory. */ -/* C */ -/* CHARACTER*(*) META */ -/* PARAMETER ( META = 'example.mk' ) */ -/* C */ -/* C Use a time step of 1 hour; look up 5 states. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 5 ) */ -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION DLT */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION ET0 */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION STATE ( 6 ) */ -/* DOUBLE PRECISION STOBS ( 6 ) */ -/* INTEGER I */ - -/* C */ -/* C Load the SPK and LSK kernels via the meta-kernel. */ -/* C */ -/* CALL FURNSH ( META ) */ -/* C */ -/* C Convert the start time to seconds past J2000 TDB. */ -/* C */ -/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C state vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* C */ -/* C Look up a state vector at epoch ET using the */ -/* C following inputs: */ -/* C */ -/* C Target: Moon (NAIF ID code 301) */ -/* C Reference frame: J2000 */ -/* C Aberration correction: Light time ('LT') */ -/* C Observer: Earth (NAIF ID code 399) */ -/* C */ -/* C Before we can execute this computation, we'll need the */ -/* C geometric state of the observer relative to the solar */ -/* C system barycenter at ET, expressed relative to the */ -/* C J2000 reference frame: */ -/* C */ -/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ -/* C */ -/* C Now compute the desired state vector: */ -/* C */ -/* CALL SPKLTC ( 301, ET, 'J2000', 'LT', */ -/* . STOBS, STATE, LT, DLT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ -/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ -/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ -/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ -/* WRITE (*,*) 'One-way light time (s): ', LT */ -/* WRITE (*,*) 'Light time rate: ', DLT */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* The output produced by this program will vary somewhat as */ -/* a function of the platform on which the program is built and */ -/* executed. On a PC/Linux/g77 platform, the following output */ -/* was produced: */ - -/* ET = 0. */ -/* J2000 x-position (km): -291569.265 */ -/* J2000 y-position (km): -266709.186 */ -/* J2000 z-position (km): -76099.1551 */ -/* J2000 x-velocity (km/s): 0.643530613 */ -/* J2000 y-velocity (km/s): -0.666081817 */ -/* J2000 z-velocity (km/s): -0.301322832 */ -/* One-way light time (s): 1.34231061 */ -/* Light time rate: 1.07316909E-07 */ - -/* ET = 3600. */ -/* J2000 x-position (km): -289240.781 */ -/* J2000 y-position (km): -269096.441 */ -/* J2000 z-position (km): -77180.8997 */ -/* J2000 x-velocity (km/s): 0.650062115 */ -/* J2000 y-velocity (km/s): -0.660162739 */ -/* J2000 z-velocity (km/s): -0.299642674 */ -/* One-way light time (s): 1.34269395 */ -/* Light time rate: 1.05652599E-07 */ - -/* ET = 7200. */ -/* J2000 x-position (km): -286888.887 */ -/* J2000 y-position (km): -271462.302 */ -/* J2000 z-position (km): -78256.5557 */ -/* J2000 x-velocity (km/s): 0.656535992 */ -/* J2000 y-velocity (km/s): -0.654196577 */ -/* J2000 z-velocity (km/s): -0.297940273 */ -/* One-way light time (s): 1.34307131 */ -/* Light time rate: 1.03990457E-07 */ - -/* ET = 10800. */ -/* J2000 x-position (km): -284513.792 */ -/* J2000 y-position (km): -273806.6 */ -/* J2000 z-position (km): -79326.0432 */ -/* J2000 x-velocity (km/s): 0.662951901 */ -/* J2000 y-velocity (km/s): -0.648183807 */ -/* J2000 z-velocity (km/s): -0.296215779 */ -/* One-way light time (s): 1.34344269 */ -/* Light time rate: 1.02330665E-07 */ - -/* ET = 14400. */ -/* J2000 x-position (km): -282115.704 */ -/* J2000 y-position (km): -276129.17 */ -/* J2000 z-position (km): -80389.283 */ -/* J2000 x-velocity (km/s): 0.669309504 */ -/* J2000 y-velocity (km/s): -0.642124908 */ -/* J2000 z-velocity (km/s): -0.294469343 */ -/* One-way light time (s): 1.3438081 */ -/* Light time rate: 1.00673404E-07 */ - - -/* $ Restrictions */ - -/* 1) The routine SPKGEO should be used instead of this routine */ -/* to compute geometric states. SPKGEO introduces less */ -/* round-off error when the observer and target have common */ -/* center that is closer to both objects than is the solar */ -/* system barycenter. */ - -/* 2) The kernel files to be used by SPKLTC must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK state computation routines, this */ -/* routine requires that the output state be relative to an */ -/* inertial reference frame. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* low-level light time correction */ -/* light-time corrected state from spk file */ -/* get light-time corrected state */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* TOL is the tolerance used for a division-by-zero test */ -/* performed prior to computation of DLT. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKLT1", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction: */ - -/* XMIT is .TRUE. when the correction is for transmitted */ -/* radiation. */ - -/* USELT is .TRUE. when any type of light time correction */ -/* (normal or converged Newtonian) is specified. */ - -/* USECN indicates converged Newtonian light time correction. */ - -/* The above definitions are consistent with those used by */ -/* ZZPRSCOR. */ - - xmit = attblk[4]; - uselt = attblk[1]; - usecn = attblk[3]; - usestl = attblk[2]; - if (usestl && ! uselt) { - setmsg_("Aberration correction flag # calls for stellar aberrati" - "on but not light time corrections. This combination is n" - "ot expected.", (ftnlen)123); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } else if (attblk[5]) { - setmsg_("Aberration correction flag # calls for relativistic lig" - "ht time correction.", (ftnlen)74); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } - -/* Find the geometric state of the target body with respect to */ -/* the solar system barycenter. Subtract the state of the */ -/* observer to get the relative state. Use this to compute the */ -/* one-way light time. */ - - zzspkgo1_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len); - vsubg_(ssbtrg, stobs, &c__6, starg); - dist = vnorm_(starg); - *lt = dist / clight_(); - if (*lt == 0.) { - -/* This can happen only if the observer and target are at the */ -/* same position. We don't consider this an error, but we're not */ -/* going to compute the light time derivative. */ - - *dlt = 0.; - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } - if (! uselt) { - -/* This is a special case: we're not using light time */ -/* corrections, so the derivative */ -/* of light time is just */ - -/* (1/c) * d(VNORM(STARG))/dt */ - - *dlt = vdot_(starg, &starg[3]) / (dist * clight_()); - -/* LT and DLT are both set, so we can return. */ - - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } - -/* To correct for light time, find the state of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where it is. */ - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Let NUMITR be the number of iterations we'll perform to */ -/* compute the light time. */ - - if (usecn) { - numitr = 3; - } else { - numitr = 1; - } - i__1 = numitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - zzspkgo1_(targ, &d__1, ref, &c__0, ssbtrg, &ssblt, ref_len); - vsubg_(ssbtrg, stobs, &c__6, starg); - *lt = vnorm_(starg) / clight_(); - } - -/* At this point, STARG contains the light time corrected */ -/* state of the target relative to the observer. */ - -/* Compute the derivative of light time with respect */ -/* to time: dLT/dt. Below we derive the formula for */ -/* this quantity for the reception case. Let */ - -/* POBS be the position of the observer relative to the */ -/* solar system barycenter. */ - -/* VOBS be the velocity of the observer relative to the */ -/* solar system barycenter. */ - -/* PTARG be the position of the target relative to the */ -/* solar system barycenter. */ - -/* VTARG be the velocity of the target relative to the */ -/* solar system barycenter. */ - -/* S be the sign of the light time correction. S is */ -/* negative for the reception case. */ - -/* The light-time corrected position of the target relative to */ -/* the observer at observation time ET, given the one-way */ -/* light time LT is: */ - -/* PTARG(ET+S*LT) - POBS(ET) */ - -/* The light-time corrected velocity of the target relative to */ -/* the observer at observation time ET is */ - -/* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */ - -/* We need to compute dLT/dt. Below, we use the facts that, */ -/* for a time-dependent vector X(t), */ - -/* ||X|| = ** (1/2) */ - -/* d(||X||)/dt = (1/2)**(-1/2) * 2 * */ - -/* = **(-1/2) * */ - -/* = / ||X|| */ - -/* Newtonian light time equation: */ - -/* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */ - -/* Differentiate both sides: */ - -/* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* * < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */ - - -/* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* * ( < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT) - VOBS(ET) > */ - -/* + < PTARG(ET+S*LT) - POBS(ET), */ -/* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */ - -/* Let */ - -/* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ - -/* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */ - -/* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */ - -/* Then */ - -/* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */ - -/* which implies */ - -/* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */ - - - - a = 1. / (clight_() * vnorm_(starg)); - b = vdot_(starg, &starg[3]); - c__ = vdot_(starg, &ssbtrg[3]); - -/* For physically realistic target velocities, S*C*A cannot equal 1. */ -/* We'll check for this case anyway. */ - - if (ltsign * c__ * a > .99999999989999999) { - setmsg_("Target range rate magnitude is approximately the speed of l" - "ight. The light time derivative cannot be computed.", (ftnlen) - 110); - sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; - } - -/* Compute DLT: the rate of change of light time. */ - - *dlt = a * b / (1. - ltsign * c__ * a); - -/* Overwrite the velocity portion of the output state */ -/* with the light-time corrected velocity. */ - - d__1 = ltsign * *dlt + 1.; - vlcom_(&d__1, &ssbtrg[3], &c_b25, &stobs[3], &starg[3]); - chkout_("ZZSPKLT1", (ftnlen)8); - return 0; -} /* zzspklt1_ */ - diff --git a/ext/spice/src/cspice/zzspkpa0.c b/ext/spice/src/cspice/zzspkpa0.c deleted file mode 100644 index e54ab085e1..0000000000 --- a/ext/spice/src/cspice/zzspkpa0.c +++ /dev/null @@ -1,814 +0,0 @@ -/* zzspkpa0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__9 = 9; - -/* $Procedure ZZSPKPA0 ( S/P Kernel, apparent position only ) */ -/* Subroutine */ int zzspkpa0_(integer *targ, doublereal *et, char *ref, - doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, - ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT " - "XLT+S" "XCN " "XCN+S"; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char corr[5]; - extern /* Subroutine */ int zzspkgp0_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), vsub_(doublereal * - , doublereal *, doublereal *); - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal tpos[3]; - char corr2[5]; - integer i__, refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical usecn, uselt; - extern doublereal vnorm_(doublereal *), clight_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - stlabx_(doublereal *, doublereal *, doublereal *); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - integer maxitr; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - static logical usestl; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the position of a target body relative to an observer, */ -/* optionally corrected for light time and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of observer's state. */ -/* SOBS I State of observer wrt. solar system barycenter. */ -/* ABCORR I Aberration correction flag. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a position vector which points */ -/* from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the observer's state SOBS is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string REF. */ - -/* SOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* SOBS is a 6-vector: the first three components of */ -/* SOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. SOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* of the target as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The target position */ -/* indicates the direction that photons */ -/* emitted from the observer's location */ -/* must be "aimed" to hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the specified inertial */ -/* reference frame. The components of PTARG represent */ -/* the x-, y- and z-components of the target's position. */ - -/* The vector PTARG points from the observer's position */ -/* at ET to the aberration-corrected location of the */ -/* target. Note that the sense of the position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* 'SPICE(SPKINVALIDOPTION)' is signaled. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame the error 'SPICE(BADFRAME)' is */ -/* signaled. */ - -/* 3) If the position of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute PTARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute PTARG. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." */ - -/* The SPICE Toolkit can correct for two phenomena affecting the */ -/* apparent location of an object: one-way light time (also called */ -/* "planetary aberration") and stellar aberration. Correcting for */ -/* one-way light time is done by computing, given an observer and */ -/* observation epoch, where a target was when the observed photons */ -/* departed the target's location. The vector from the observer to */ -/* this computed target location is called a "light time corrected" */ -/* vector. The light time correction depends on the motion of the */ -/* target, but it is independent of the velocity of the observer */ -/* relative to the solar system barycenter. Relativistic effects */ -/* such as light bending and gravitational delay are not accounted */ -/* for in the light time correction performed by this routine. */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the motion of the target. The stellar aberration formula used */ -/* by this routine is non- relativistic. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This requires correction */ -/* of the geometric target position for the effects of light time and */ -/* stellar aberration, but in this case the corrections are computed */ -/* for radiation traveling from the observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* The traditional aberration corrections applicable to observation */ -/* and those applicable to transmission are related in a simple way: */ -/* one may picture the geometry of the "transmission" case by */ -/* imagining the "observation" case running in reverse time order, */ -/* and vice versa. */ - -/* One may reasonably object to using the term "observer" in the */ -/* transmission case, in which radiation is emitted from the */ -/* observer's location. The terminology was retained for */ -/* consistency with earlier documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation: */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target: */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file: */ - -/* Use 'NONE'. */ - - -/* 4) Compute the apparent position of a target body relative */ -/* to a star or other distant object: */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical: */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations: */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - - -/* Geometric case */ -/* ============== */ - -/* ZZSPKPA0 begins by computing the geometric position T(ET) of */ -/* the target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' are */ -/* selected, ZZSPKPA0 computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) */ -/* and O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT */ -/* is the solution of the */ -/* light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* RHS of the light-time equation (1) yields the "one-iteration" */ -/* estimate of the one-way light time. Repeating the process */ -/* until the estimates of LT converge yields the "converged */ -/* Newtonian" light time estimate. */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - - -/* The light-time corrected position is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter-relative */ -/* velocity vector of the observer. The magnitude of the rotation */ -/* depends on the magnitude of the observer's velocity relative */ -/* to the solar system barycenter and the angle between */ -/* this velocity and the observer-target vector. The rotation */ -/* is computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */ -/* selected, ZZSPKPA0 computes the position of the target body T */ -/* at epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - - -/* The light-time corrected position is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The magnitude of the */ -/* rotation depends on the magnitude of the velocity and the */ -/* angle between the velocity and the observer-target vector. */ -/* The rotation is computed as in the reception case, but the */ -/* sign of the rotation angle is negated. */ - -/* Neither special nor general relativistic effects are accounted */ -/* for in the aberration corrections performed by this routine. */ - -/* $ Examples */ - -/* In the following code fragment, SPKSSB and ZZSPKPA0 are used */ -/* to display the position of Io (body 501) as seen from the */ -/* Voyager 2 spacecraft (Body -32) at a series of epochs. */ - -/* Normally, one would call the high-level reader SPKPOS to obtain */ -/* position vectors. The example below illustrates the interface */ -/* of this routine, but is not intended as a recommendation on */ -/* how to use the SPICE SPK subsystem. */ - -/* The use of integer ID codes is necessitated by the low-level */ -/* interface of this routine. */ - -/* IO = 501 */ -/* VGR2 = -32 */ - -/* DO WHILE ( EPOCH .LE. END ) */ - -/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */ -/* CALL ZZSPKPA0 ( IO, EPOCH, 'J2000', STVGR2, */ -/* . 'LT+S', STIO, LT ) */ - -/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */ -/* WRITE (*,*) RA * DPR(), DEC * DPR() */ - -/* EPOCH = EPOCH + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKPA0 must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK position computation routines, this */ -/* routine requires that the input state be relative to an */ -/* inertial reference frame. Non-inertial frames are not */ -/* supported by this routine. */ - -/* 4) In a future version of this routine, the implementation */ -/* of the aberration corrections may be enhanced to improve */ -/* accuracy. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 2.0.1, 20-OCT-2003 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* apparent position from spk file */ -/* get apparent position */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of flags in the FLAGS array: */ - - -/* NAIF ID code for the solar system barycenter: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKPA0", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - -/* Remove leading and embedded white space from the aberration */ -/* correction flag, then convert to upper case. */ - - cmprss_(" ", &c__0, abcorr, corr2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(corr2, corr, (ftnlen)5, (ftnlen)5); - -/* Locate the flag in our list of flags. */ - - i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5); - if (i__ == 0) { - setmsg_("Requested aberration correction was #.", (ftnlen)38); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23); - chkout_("ZZSPKPA0", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction. */ - - xmit = i__ > 5; - uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7; - usestl = i__ > 1 && odd_(&i__); - usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKPA0", (ftnlen)8); - return 0; - } - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Find the geometric position of the target body with respect to the */ -/* solar system barycenter. Subtract the position of the observer */ -/* to get the relative position. Use this to compute the one-way */ -/* light time. */ - - zzspkgp0_(targ, et, ref, &c__0, ptarg, lt, ref_len); - vsub_(ptarg, sobs, tpos); - vequ_(tpos, ptarg); - *lt = vnorm_(ptarg) / clight_(); - -/* To correct for light time, find the position of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where he is. */ - - if (uselt) { - maxitr = 1; - } else if (usecn) { - maxitr = 3; - } else { - maxitr = 0; - } - i__1 = maxitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - zzspkgp0_(targ, &d__1, ref, &c__0, ptarg, lt, ref_len); - vsub_(ptarg, sobs, tpos); - vequ_(tpos, ptarg); - *lt = vnorm_(ptarg) / clight_(); - } - -/* At this point, PTARG contains the geometric or light-time */ -/* corrected position of the target relative to the observer, */ -/* depending on the specified correction. */ - -/* If stellar aberration correction is requested, perform it now. */ - - if (usestl) { - if (xmit) { - -/* This is the transmission case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to PTARG. */ - - stlabx_(ptarg, &sobs[3], tpos); - vequ_(tpos, ptarg); - } else { - -/* This is the reception case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to PTARG. */ - - stelab_(ptarg, &sobs[3], tpos); - vequ_(tpos, ptarg); - } - } - chkout_("ZZSPKPA0", (ftnlen)8); - return 0; -} /* zzspkpa0_ */ - diff --git a/ext/spice/src/cspice/zzspkpa1.c b/ext/spice/src/cspice/zzspkpa1.c deleted file mode 100644 index 2af7209807..0000000000 --- a/ext/spice/src/cspice/zzspkpa1.c +++ /dev/null @@ -1,815 +0,0 @@ -/* zzspkpa1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__9 = 9; - -/* $Procedure ZZSPKPA1 ( S/P Kernel, apparent position only ) */ -/* Subroutine */ int zzspkpa1_(integer *targ, doublereal *et, char *ref, - doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, - ftnlen ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT " - "XLT+S" "XCN " "XCN+S"; - static char prvcor[5] = " "; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char corr[5]; - extern /* Subroutine */ int zzspkgp1_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), vsub_(doublereal * - , doublereal *, doublereal *); - static logical xmit; - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal tpos[3]; - char corr2[5]; - integer i__, refid; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - static logical usecn, uselt; - extern doublereal vnorm_(doublereal *), clight_(void); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int stelab_(doublereal *, doublereal *, - doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - stlabx_(doublereal *, doublereal *, doublereal *); - integer ltsign; - extern /* Subroutine */ int setmsg_(char *, ftnlen), irfnum_(char *, - integer *, ftnlen); - integer maxitr; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern logical return_(void); - static logical usestl; - extern logical odd_(integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the position of a target body relative to an observer, */ -/* optionally corrected for light time and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Observer epoch. */ -/* REF I Inertial reference frame of observer's state. */ -/* SOBS I State of observer wrt. solar system barycenter. */ -/* ABCORR I Aberration correction flag. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a position vector which points */ -/* from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the inertial reference frame with respect to which */ -/* the observer's state SOBS is expressed. REF must be */ -/* recognized by the SPICE Toolkit. The acceptable */ -/* frames are listed in the Frames Required Reading, as */ -/* well as in the SPICELIB routine CHGIRF. */ - -/* Case and blanks are not significant in the string REF. */ - -/* SOBS is the geometric (uncorrected) state of the observer */ -/* relative to the solar system barycenter at epoch ET. */ -/* SOBS is a 6-vector: the first three components of */ -/* SOBS represent a Cartesian position vector; the last */ -/* three components represent the corresponding velocity */ -/* vector. SOBS is expressed relative to the inertial */ -/* reference frame designated by REF. */ - -/* Units are always km and km/sec. */ - - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at the */ -/* moment it emitted photons arriving at */ -/* the observer at ET. */ - -/* The light time correction involves */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* of the target as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The target position */ -/* indicates the direction that photons */ -/* emitted from the observer's location */ -/* must be "aimed" to hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the specified inertial */ -/* reference frame. The components of PTARG represent */ -/* the x-, y- and z-components of the target's position. */ - -/* The vector PTARG points from the observer's position */ -/* at ET to the aberration-corrected location of the */ -/* target. Note that the sense of the position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the value of ABCORR is not recognized, the error */ -/* 'SPICE(SPKINVALIDOPTION)' is signaled. */ - -/* 2) If the reference frame requested is not a recognized */ -/* inertial reference frame the error 'SPICE(BADFRAME)' is */ -/* signaled. */ - -/* 3) If the position of the target relative to the solar system */ -/* barycenter cannot be computed, the error will be diagnosed */ -/* by routines in the call tree of this routine. */ - -/* $ Files */ - - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. Application programs typically load */ -/* kernels once before this routine is called, for example during */ -/* program initialization; kernels need not be loaded repeatedly. */ -/* See the routine FURNSH and the SPK and KERNEL Required Reading */ -/* for further information on loading (and unloading) kernels. */ - -/* If any of the ephemeris data used to compute PTARG are expressed */ -/* relative to a non-inertial frame in the SPK files providing those */ -/* data, additional kernels may be needed to enable the reference */ -/* frame transformations required to compute PTARG. Normally */ -/* these additional kernels are PCK files or frame kernels. Any */ -/* such kernels must already be loaded at the time this routine is */ -/* called. */ - -/* $ Particulars */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." */ - -/* The SPICE Toolkit can correct for two phenomena affecting the */ -/* apparent location of an object: one-way light time (also called */ -/* "planetary aberration") and stellar aberration. Correcting for */ -/* one-way light time is done by computing, given an observer and */ -/* observation epoch, where a target was when the observed photons */ -/* departed the target's location. The vector from the observer to */ -/* this computed target location is called a "light time corrected" */ -/* vector. The light time correction depends on the motion of the */ -/* target, but it is independent of the velocity of the observer */ -/* relative to the solar system barycenter. Relativistic effects */ -/* such as light bending and gravitational delay are not accounted */ -/* for in the light time correction performed by this routine. */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the motion of the target. The stellar aberration formula used */ -/* by this routine is non- relativistic. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This requires correction */ -/* of the geometric target position for the effects of light time and */ -/* stellar aberration, but in this case the corrections are computed */ -/* for radiation traveling from the observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* The traditional aberration corrections applicable to observation */ -/* and those applicable to transmission are related in a simple way: */ -/* one may picture the geometry of the "transmission" case by */ -/* imagining the "observation" case running in reverse time order, */ -/* and vice versa. */ - -/* One may reasonably object to using the term "observer" in the */ -/* transmission case, in which radiation is emitted from the */ -/* observer's location. The terminology was retained for */ -/* consistency with earlier documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation: */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target: */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file: */ - -/* Use 'NONE'. */ - - -/* 4) Compute the apparent position of a target body relative */ -/* to a star or other distant object: */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical: */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations: */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - - -/* Geometric case */ -/* ============== */ - -/* ZZSPKPA1 begins by computing the geometric position T(ET) of */ -/* the target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' are */ -/* selected, ZZSPKPA1 computes the position of the target body at */ -/* epoch ET-LT, where LT is the one-way light time. Let T(t) */ -/* and O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT */ -/* is the solution of the */ -/* light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* RHS of the light-time equation (1) yields the "one-iteration" */ -/* estimate of the one-way light time. Repeating the process */ -/* until the estimates of LT converge yields the "converged */ -/* Newtonian" light time estimate. */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - - -/* The light-time corrected position is the vector */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter-relative */ -/* velocity vector of the observer. The magnitude of the rotation */ -/* depends on the magnitude of the observer's velocity relative */ -/* to the solar system barycenter and the angle between */ -/* this velocity and the observer-target vector. The rotation */ -/* is computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */ -/* selected, ZZSPKPA1 computes the position of the target body T */ -/* at epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - - -/* The light-time corrected position is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The magnitude of the */ -/* rotation depends on the magnitude of the velocity and the */ -/* angle between the velocity and the observer-target vector. */ -/* The rotation is computed as in the reception case, but the */ -/* sign of the rotation angle is negated. */ - -/* Neither special nor general relativistic effects are accounted */ -/* for in the aberration corrections performed by this routine. */ - -/* $ Examples */ - -/* In the following code fragment, SPKSSB and ZZSPKPA1 are used */ -/* to display the position of Io (body 501) as seen from the */ -/* Voyager 2 spacecraft (Body -32) at a series of epochs. */ - -/* Normally, one would call the high-level reader SPKPOS to obtain */ -/* position vectors. The example below illustrates the interface */ -/* of this routine, but is not intended as a recommendation on */ -/* how to use the SPICE SPK subsystem. */ - -/* The use of integer ID codes is necessitated by the low-level */ -/* interface of this routine. */ - -/* IO = 501 */ -/* VGR2 = -32 */ - -/* DO WHILE ( EPOCH .LE. END ) */ - -/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */ -/* CALL ZZSPKPA1 ( IO, EPOCH, 'J2000', STVGR2, */ -/* . 'LT+S', STIO, LT ) */ - -/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */ -/* WRITE (*,*) RA * DPR(), DEC * DPR() */ - -/* EPOCH = EPOCH + DELTA */ - -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKPA1 must be loaded */ -/* (normally by the SPICELIB kernel loader FURNSH) before */ -/* this routine is called. */ - -/* 3) Unlike most other SPK position computation routines, this */ -/* routine requires that the input state be relative to an */ -/* inertial reference frame. Non-inertial frames are not */ -/* supported by this routine. */ - -/* 4) In a future version of this routine, the implementation */ -/* of the aberration corrections may be enhanced to improve */ -/* accuracy. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 2.0.1, 20-OCT-2003 (EDW) */ - -/* -& */ -/* $ Index_Entries */ - -/* apparent position from spk file */ -/* get apparent position */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in VSUB call. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Indices of flags in the FLAGS array: */ - - -/* NAIF ID code for the solar system barycenter: */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKPA1", (ftnlen)8); - } - if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { - -/* The aberration correction flag differs from the value it */ -/* had on the previous call, if any. Analyze the new flag. */ - -/* Remove leading and embedded white space from the aberration */ -/* correction flag, then convert to upper case. */ - - cmprss_(" ", &c__0, abcorr, corr2, (ftnlen)1, abcorr_len, (ftnlen)5); - ucase_(corr2, corr, (ftnlen)5, (ftnlen)5); - -/* Locate the flag in our list of flags. */ - - i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5); - if (i__ == 0) { - setmsg_("Requested aberration correction was #.", (ftnlen)38); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23); - chkout_("ZZSPKPA1", (ftnlen)8); - return 0; - } - -/* The aberration correction flag is recognized; save it. */ - - s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); - -/* Set logical flags indicating the attributes of the requested */ -/* correction. */ - - xmit = i__ > 5; - uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7; - usestl = i__ > 1 && odd_(&i__); - usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9; - first = FALSE_; - } - -/* See if the reference frame is a recognized inertial frame. */ - - irfnum_(ref, &refid, ref_len); - if (refid == 0) { - setmsg_("The requested frame '#' is not a recognized inertial frame. " - , (ftnlen)60); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(BADFRAME)", (ftnlen)15); - chkout_("ZZSPKPA1", (ftnlen)8); - return 0; - } - -/* Determine the sign of the light time offset. */ - - if (xmit) { - ltsign = 1; - } else { - ltsign = -1; - } - -/* Find the geometric position of the target body with respect to the */ -/* solar system barycenter. Subtract the position of the observer */ -/* to get the relative position. Use this to compute the one-way */ -/* light time. */ - - zzspkgp1_(targ, et, ref, &c__0, ptarg, lt, ref_len); - vsub_(ptarg, sobs, tpos); - vequ_(tpos, ptarg); - *lt = vnorm_(ptarg) / clight_(); - -/* To correct for light time, find the position of the target body */ -/* at the current epoch minus the one-way light time. Note that */ -/* the observer remains where he is. */ - - if (uselt) { - maxitr = 1; - } else if (usecn) { - maxitr = 3; - } else { - maxitr = 0; - } - i__1 = maxitr; - for (i__ = 1; i__ <= i__1; ++i__) { - d__1 = *et + ltsign * *lt; - zzspkgp1_(targ, &d__1, ref, &c__0, ptarg, lt, ref_len); - vsub_(ptarg, sobs, tpos); - vequ_(tpos, ptarg); - *lt = vnorm_(ptarg) / clight_(); - } - -/* At this point, PTARG contains the geometric or light-time */ -/* corrected position of the target relative to the observer, */ -/* depending on the specified correction. */ - -/* If stellar aberration correction is requested, perform it now. */ - - if (usestl) { - if (xmit) { - -/* This is the transmission case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to PTARG. */ - - stlabx_(ptarg, &sobs[3], tpos); - vequ_(tpos, ptarg); - } else { - -/* This is the reception case. */ - -/* Compute the position vector obtained by applying */ -/* "reception" stellar aberration to PTARG. */ - - stelab_(ptarg, &sobs[3], tpos); - vequ_(tpos, ptarg); - } - } - chkout_("ZZSPKPA1", (ftnlen)8); - return 0; -} /* zzspkpa1_ */ - diff --git a/ext/spice/src/cspice/zzspksb0.c b/ext/spice/src/cspice/zzspksb0.c deleted file mode 100644 index 97f4b232d9..0000000000 --- a/ext/spice/src/cspice/zzspksb0.c +++ /dev/null @@ -1,200 +0,0 @@ -/* zzspksb0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSPKSB0 ( S/P Kernel, solar system barycenter ) */ -/* Subroutine */ int zzspksb0_(integer *targ, doublereal *et, char *ref, - doublereal *starg, ftnlen ref_len) -{ - integer bary; - extern /* Subroutine */ int zzspkgo0_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), chkin_(char *, - ftnlen); - doublereal lt; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the state (position and velocity) of a target body */ -/* relative to the solar system barycenter. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* STARG O State of target. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to which the */ -/* vectors returned by the routine should be rotated. */ -/* This may be any frame supported by the SPICELIB frame */ -/* system, including dynamic and other non-inertial */ -/* frames. */ - -/* $ Detailed_Output */ - -/* STARG contains the position and velocity of the target */ -/* body, relative to the solar system barycenter, */ -/* at epoch ET. These vectors are rotated into the */ -/* specified reference frame. Units are always */ -/* km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient information has not bee "loaded" via the */ -/* routine SPKLEF or the PCK kernel loaders, the problem will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* In order to compute the state of one body relative to another, */ -/* the states of the two bodies must be known relative to a third */ -/* body. One simple solution is to use the solar system barycenter */ -/* as the third body. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the state of a body relative to the barycenter. */ -/* ZZSPKSB0 reads as many segments as necessary, from as many */ -/* files as necessary, using files that have been loaded by */ -/* previous calls to SPKLEF (load ephemeris file). */ - -/* $ Examples */ - -/* In the following code fragment, ZZSPKSB0 is used to display */ -/* the distance from Earth (Body 399) to Mars (body 499) at */ -/* a series of epochs. */ - -/* CALL SPKLEF ( 'DE125.SPK', HANDLE ) */ -/* . */ -/* . */ - -/* EARTH = 399 */ -/* MARS = 499 */ - -/* DO WHILE ( EPOCH .LE. END ) */ -/* CALL ZZSPKSB0 ( EARTH, EPOCH, 'J2000', SEARTH ) */ -/* CALL ZZSPKSB0 ( MARS, EPOCH, 'J2000', SMARS ) */ - -/* CALL VSUB ( SMARS, SEARTH, SMARS ) */ -/* WRITE (*,*) EPOCH, VNORM ( SMARS ) */ - -/* EPOCH = EPOCH + DELTA */ -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKSB0 must be loaded */ -/* by SPKLEF before ZZSPKSB0 is called. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 2.0.2, 20-NOV-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* state relative to solar system barycenter */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was simplified by replacing all of the */ -/* main body of code with a call to SPKGEO. By making */ -/* this change the routine now supports non-inertial frames. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKSB0", (ftnlen)8); - } - bary = 0; - zzspkgo0_(targ, et, ref, &bary, starg, <, ref_len); - chkout_("ZZSPKSB0", (ftnlen)8); - return 0; -} /* zzspksb0_ */ - diff --git a/ext/spice/src/cspice/zzspksb1.c b/ext/spice/src/cspice/zzspksb1.c deleted file mode 100644 index b5b7ecaa49..0000000000 --- a/ext/spice/src/cspice/zzspksb1.c +++ /dev/null @@ -1,200 +0,0 @@ -/* zzspksb1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSPKSB1 ( S/P Kernel, solar system barycenter ) */ -/* Subroutine */ int zzspksb1_(integer *targ, doublereal *et, char *ref, - doublereal *starg, ftnlen ref_len) -{ - integer bary; - extern /* Subroutine */ int zzspkgo1_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), chkin_(char *, - ftnlen); - doublereal lt; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the state (position and velocity) of a target body */ -/* relative to the solar system barycenter. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body. */ -/* ET I Target epoch. */ -/* REF I Target reference frame. */ -/* STARG O State of target. */ - -/* $ Detailed_Input */ - -/* TARG is the standard NAIF ID code for a target body. */ - -/* ET is the epoch (ephemeris time) at which the state */ -/* of the target body is to be computed. */ - -/* REF is the name of the reference frame to which the */ -/* vectors returned by the routine should be rotated. */ -/* This may be any frame supported by the SPICELIB frame */ -/* system, including dynamic and other non-inertial */ -/* frames. */ - -/* $ Detailed_Output */ - -/* STARG contains the position and velocity of the target */ -/* body, relative to the solar system barycenter, */ -/* at epoch ET. These vectors are rotated into the */ -/* specified reference frame. Units are always */ -/* km and km/sec. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If insufficient information has not bee "loaded" via the */ -/* routine SPKLEF or the PCK kernel loaders, the problem will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* $ Files */ - -/* See: $Restrictions. */ - -/* $ Particulars */ - -/* In order to compute the state of one body relative to another, */ -/* the states of the two bodies must be known relative to a third */ -/* body. One simple solution is to use the solar system barycenter */ -/* as the third body. */ - -/* Ephemeris data from more than one segment may be required */ -/* to determine the state of a body relative to the barycenter. */ -/* ZZSPKSB1 reads as many segments as necessary, from as many */ -/* files as necessary, using files that have been loaded by */ -/* previous calls to SPKLEF (load ephemeris file). */ - -/* $ Examples */ - -/* In the following code fragment, ZZSPKSB1 is used to display */ -/* the distance from Earth (Body 399) to Mars (body 499) at */ -/* a series of epochs. */ - -/* CALL SPKLEF ( 'DE125.SPK', HANDLE ) */ -/* . */ -/* . */ - -/* EARTH = 399 */ -/* MARS = 499 */ - -/* DO WHILE ( EPOCH .LE. END ) */ -/* CALL ZZSPKSB1 ( EARTH, EPOCH, 'J2000', SEARTH ) */ -/* CALL ZZSPKSB1 ( MARS, EPOCH, 'J2000', SMARS ) */ - -/* CALL VSUB ( SMARS, SEARTH, SMARS ) */ -/* WRITE (*,*) EPOCH, VNORM ( SMARS ) */ - -/* EPOCH = EPOCH + DELTA */ -/* END DO */ - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* 2) The ephemeris files to be used by ZZSPKSB1 must be loaded */ -/* by SPKLEF before ZZSPKSB1 is called. */ - -/* $ Literature_References */ - -/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ -/* User's Guide" */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */ - -/* Based on SPICELIB Version 2.0.2, 20-NOV-2004 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* state relative to solar system barycenter */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 2.0.0, 19-SEP-1995 (WLT) */ - -/* The routine was simplified by replacing all of the */ -/* main body of code with a call to SPKGEO. By making */ -/* this change the routine now supports non-inertial frames. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKSB1", (ftnlen)8); - } - bary = 0; - zzspkgo1_(targ, et, ref, &bary, starg, <, ref_len); - chkout_("ZZSPKSB1", (ftnlen)8); - return 0; -} /* zzspksb1_ */ - diff --git a/ext/spice/src/cspice/zzspkzp0.c b/ext/spice/src/cspice/zzspkzp0.c deleted file mode 100644 index 69c641c1c4..0000000000 --- a/ext/spice/src/cspice/zzspkzp0.c +++ /dev/null @@ -1,1004 +0,0 @@ -/* zzspkzp0.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSPKZP0 ( S/P Kernel, easy position ) */ -/* Subroutine */ int zzspkzp0_(integer *targ, doublereal *et, char *ref, char - *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen - ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - static integer fj2000; - extern /* Subroutine */ int zzrefch0_(integer *, integer *, doublereal *, - doublereal *), zzspkpa0_(integer *, doublereal *, char *, - doublereal *, char *, doublereal *, doublereal *, ftnlen, ftnlen); - static doublereal temp[3], sobs[6]; - extern /* Subroutine */ int zzspkgp0_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen), zzspksb0_(integer - *, doublereal *, char *, doublereal *, ftnlen); - static integer type__; - static logical xmit; - static integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical eqchr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static logical found; - extern integer ltrim_(char *, ftnlen); - static doublereal xform[9] /* was [3][3] */; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static doublereal postn[3]; - extern logical failed_(void); - static integer center; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - static doublereal ltcent; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer reqfrm, typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the position of a target body relative to an observing */ -/* body, optionally corrected for light time (planetary aberration) */ -/* and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body NAIF ID code. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output position vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body NAIF ID code. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a position vector which points */ -/* from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output position vector should be expressed. This */ -/* may be any frame supported by the SPICE system, */ -/* including built-in frames (documented in the Frames */ -/* Required Reading) and frames defined by a loaded */ -/* frame kernel (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. See */ -/* the description of the output position vector PTARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at */ -/* the moment it emitted photons arriving */ -/* at the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target position indicates */ -/* the direction that photons emitted from */ -/* the observer's location must be "aimed" */ -/* to hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the NAIF ID code for the observing body. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the reference frame */ -/* specified by REF. The three components of PTARG */ -/* represent the x-, y- and z-components of the target's */ -/* position. */ - -/* PTARG points from the observer's location at ET to */ -/* the aberration-corrected location of the target. */ -/* Note that the sense of this position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of target or observer cannot be translated to its */ -/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 3) If the loaded kernels provide insufficient data to */ -/* compute the requested position vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 4) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* $ Files */ - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output position PTARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute PTARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the position. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve position information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations. */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* ZZSPKZP0 begins by computing the geometric position T(ET) of */ -/* the target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, ZZSPKZP0 computes the position of the target body */ -/* at epoch ET-LT, where LT is the one-way light time. Let T(t) */ -/* and O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The light time corrected position vector is */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, ZZSPKZP0 computes the position of the target body T */ -/* at epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The light-time corrected position vector is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK, then look up a series of */ -/* geometric positions of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 positions. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* C */ -/* C The NAIF IDs of the earth and moon are 399 and 301 */ -/* C respectively. */ -/* C */ -/* INTEGER OBSRVR */ -/* PARAMETER ( OBSRVR = 399 ) */ - -/* INTEGER TARGET */ -/* PARAMETER ( TARGET = 301 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C position vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL ZZSPKZP0 ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . POS, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', POS(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', POS(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', POS(3) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* B.V. Semenov (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ - -/* Based on SPICELIB Version 3.1.0, 05-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* using body names get position relative to an observer */ -/* get position relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKZP0", (ftnlen)8); - } - -/* Get the frame id for J2000 on the first call to this routine. */ - - if (first) { - first = FALSE_; - namfrm_("J2000", &fj2000, (ftnlen)5); - } - -/* Decide whether the aberration correction is for received or */ -/* transmitted radiation. */ - - i__ = ltrim_(abcorr, abcorr_len); - xmit = eqchr_(abcorr + (i__ - 1), "X", (ftnlen)1, (ftnlen)1); - -/* If we only want geometric positions, then compute just that. */ - -/* Otherwise, compute the state of the observer relative to */ -/* the SSB. Then feed that position into ZZSPKPA0 to compute the */ -/* apparent position of the target body relative to the observer */ -/* with the requested aberration corrections. */ - - if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) { - zzspkgp0_(targ, et, ref, obs, ptarg, lt, ref_len); - } else { - -/* Get the auxiliary information about the requested output */ -/* frame. */ - - namfrm_(ref, &reqfrm, ref_len); - if (reqfrm == 0) { - setmsg_("The requested output frame '#' is not recognized by the" - " reference frame subsystem. Please check that the appro" - "priate kernels have been loaded and that you have correc" - "tly entered the name of the output frame. ", (ftnlen)209); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZSPKZP0", (ftnlen)8); - return 0; - } - frinfo_(&reqfrm, ¢er, &type__, &typeid, &found); - -/* If we are dealing with an inertial frame, we can simply */ -/* call ZZSPKSB0, ZZSPKPA0 and return. */ - - if (type__ == 1) { - zzspksb0_(obs, et, ref, sobs, ref_len); - zzspkpa0_(targ, et, ref, sobs, abcorr, ptarg, lt, ref_len, - abcorr_len); - chkout_("ZZSPKZP0", (ftnlen)8); - return 0; - } - -/* Still here? */ - -/* We are dealing with a non-inertial frame. But we need to */ -/* do light time and stellar aberration in an inertial frame. */ -/* Get the "apparent" position of TARG in the intermediary */ -/* inertial reference frame J2000. */ - -/* We also need the light time to the center of the frame. */ - - zzspksb0_(obs, et, "J2000", sobs, (ftnlen)5); - zzspkpa0_(targ, et, "J2000", sobs, abcorr, postn, lt, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("ZZSPKZP0", (ftnlen)8); - return 0; - } - if (center == *obs) { - ltcent = 0.; - } else if (center == *targ) { - ltcent = *lt; - } else { - zzspkpa0_(¢er, et, "J2000", sobs, abcorr, temp, <cent, ( - ftnlen)5, abcorr_len); - } - -/* If something went wrong (like we couldn't get the position of */ -/* the center relative to the observer) now it is time to quit. */ - - if (failed_()) { - chkout_("ZZSPKZP0", (ftnlen)8); - return 0; - } - -/* If the aberration corrections are for transmission, negate */ -/* the light time, since we wish to compute the orientation */ -/* of the non-inertial frame at an epoch later than ET by */ -/* the one-way light time. */ - - if (xmit) { - ltcent = -ltcent; - } - -/* Get the rotation from J2000 to the requested frame */ -/* and convert the position. */ - - d__1 = *et - ltcent; - zzrefch0_(&fj2000, &reqfrm, &d__1, xform); - if (failed_()) { - chkout_("ZZSPKZP0", (ftnlen)8); - return 0; - } - mxv_(xform, postn, ptarg); - } - chkout_("ZZSPKZP0", (ftnlen)8); - return 0; -} /* zzspkzp0_ */ - diff --git a/ext/spice/src/cspice/zzspkzp1.c b/ext/spice/src/cspice/zzspkzp1.c deleted file mode 100644 index ed9a15d179..0000000000 --- a/ext/spice/src/cspice/zzspkzp1.c +++ /dev/null @@ -1,1019 +0,0 @@ -/* zzspkzp1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZSPKZP1 ( S/P Kernel, easy position ) */ -/* Subroutine */ int zzspkzp1_(integer *targ, doublereal *et, char *ref, char - *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen - ref_len, ftnlen abcorr_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - doublereal d__1; - - /* Local variables */ - static integer fj2000; - extern /* Subroutine */ int zzrefch1_(integer *, integer *, doublereal *, - doublereal *), zzspkpa1_(integer *, doublereal *, char *, - doublereal *, char *, doublereal *, doublereal *, ftnlen, ftnlen); - static doublereal temp[3], sobs[6]; - extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *, - doublereal *, ftnlen), zzspkgp1_(integer *, doublereal *, char *, - integer *, doublereal *, doublereal *, ftnlen); - static integer type__; - static logical xmit; - static integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical eqchr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static logical found; - extern integer ltrim_(char *, ftnlen); - static doublereal xform[9] /* was [3][3] */; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static doublereal postn[3]; - extern logical failed_(void); - static integer center; - extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_( - integer *, integer *, integer *, integer *, logical *); - static doublereal ltcent; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer reqfrm, typeid; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) - ; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the position of a target body relative to an observing */ -/* body, optionally corrected for light time (planetary aberration) */ -/* and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ -/* NAIF_IDS */ -/* FRAMES */ -/* TIME */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Abstract */ - -/* The parameters below form an enumerated list of the recognized */ -/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ -/* are outlined below. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* INERTL an inertial frame that is listed in the routine */ -/* CHGIRF and that requires no external file to */ -/* compute the transformation from or to any other */ -/* inertial frame. */ - -/* PCK is a frame that is specified relative to some */ -/* INERTL frame and that has an IAU model that */ -/* may be retrieved from the PCK system via a call */ -/* to the routine TISBOD. */ - -/* CK is a frame defined by a C-kernel. */ - -/* TK is a "text kernel" frame. These frames are offset */ -/* from their associated "relative" frames by a */ -/* constant rotation. */ - -/* DYN is a "dynamic" frame. These currently are */ -/* parameterized, built-in frames where the full frame */ -/* definition depends on parameters supplied via a */ -/* frame kernel. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ - -/* The parameter DYN was added to support the dynamic frame class. */ - -/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ - -/* Various unused frames types were removed and the */ -/* frame time TK was added. */ - -/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ - -/* -& */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TARG I Target body NAIF ID code. */ -/* ET I Observer epoch. */ -/* REF I Reference frame of output position vector. */ -/* ABCORR I Aberration correction flag. */ -/* OBS I Observing body NAIF ID code. */ -/* PTARG O Position of target. */ -/* LT O One way light time between observer and target. */ - -/* $ Detailed_Input */ - -/* TARG is the NAIF ID code for a target body. The target */ -/* and observer define a position vector which points */ -/* from the observer to the target. */ - -/* ET is the ephemeris time, expressed as seconds past */ -/* J2000 TDB, at which the position of the target body */ -/* relative to the observer is to be computed. ET */ -/* refers to time at the observer's location. */ - -/* REF is the name of the reference frame relative to which */ -/* the output position vector should be expressed. This */ -/* may be any frame supported by the SPICE system, */ -/* including built-in frames (documented in the Frames */ -/* Required Reading) and frames defined by a loaded */ -/* frame kernel (FK). */ - -/* When REF designates a non-inertial frame, the */ -/* orientation of the frame is evaluated at an epoch */ -/* dependent on the selected aberration correction. See */ -/* the description of the output position vector PTARG */ -/* for details. */ - -/* ABCORR indicates the aberration corrections to be applied to */ -/* the position of the target body to account for */ -/* one-way light time and stellar aberration. See the */ -/* discussion in the Particulars section for */ -/* recommendations on how to choose aberration */ -/* corrections. */ - -/* ABCORR may be any of the following: */ - -/* 'NONE' Apply no correction. Return the */ -/* geometric position of the target body */ -/* relative to the observer. */ - -/* The following values of ABCORR apply to the */ -/* "reception" case in which photons depart from the */ -/* target's location at the light-time corrected epoch */ -/* ET-LT and *arrive* at the observer's location at ET: */ - -/* 'LT' Correct for one-way light time (also */ -/* called "planetary aberration") using a */ -/* Newtonian formulation. This correction */ -/* yields the position of the target at */ -/* the moment it emitted photons arriving */ -/* at the observer at ET. */ - -/* The light time correction uses an */ -/* iterative solution of the light time */ -/* equation (see Particulars for details). */ -/* The solution invoked by the 'LT' option */ -/* uses one iteration. */ - -/* 'LT+S' Correct for one-way light time and */ -/* stellar aberration using a Newtonian */ -/* formulation. This option modifies the */ -/* position obtained with the 'LT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The result is the apparent */ -/* position of the target---the position */ -/* as seen by the observer. */ - -/* 'CN' Converged Newtonian light time */ -/* correction. In solving the light time */ -/* equation, the 'CN' correction iterates */ -/* until the solution converges (three */ -/* iterations on all supported platforms). */ - -/* The 'CN' correction typically does not */ -/* substantially improve accuracy because */ -/* the errors made by ignoring */ -/* relativistic effects may be larger than */ -/* the improvement afforded by obtaining */ -/* convergence of the light time solution. */ -/* The 'CN' correction computation also */ -/* requires a significantly greater number */ -/* of CPU cycles than does the */ -/* one-iteration light time correction. */ - -/* 'CN+S' Converged Newtonian light time */ -/* and stellar aberration corrections. */ - - -/* The following values of ABCORR apply to the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at ET and arrive at the */ -/* target's location at the light-time corrected epoch */ -/* ET+LT: */ - -/* 'XLT' "Transmission" case: correct for */ -/* one-way light time using a Newtonian */ -/* formulation. This correction yields the */ -/* position of the target at the moment it */ -/* receives photons emitted from the */ -/* observer's location at ET. */ - -/* 'XLT+S' "Transmission" case: correct for */ -/* one-way light time and stellar */ -/* aberration using a Newtonian */ -/* formulation This option modifies the */ -/* position obtained with the 'XLT' option */ -/* to account for the observer's velocity */ -/* relative to the solar system */ -/* barycenter. The position component of */ -/* the computed target position indicates */ -/* the direction that photons emitted from */ -/* the observer's location must be "aimed" */ -/* to hit the target. */ - -/* 'XCN' "Transmission" case: converged */ -/* Newtonian light time correction. */ - -/* 'XCN+S' "Transmission" case: converged */ -/* Newtonian light time and stellar */ -/* aberration corrections. */ - - -/* Neither special nor general relativistic effects are */ -/* accounted for in the aberration corrections applied */ -/* by this routine. */ - -/* Case and blanks are not significant in the string */ -/* ABCORR. */ - -/* OBS is the NAIF ID code for the observing body. */ - -/* $ Detailed_Output */ - -/* PTARG is a Cartesian 3-vector representing the position of */ -/* the target body relative to the specified observer. */ -/* PTARG is corrected for the specified aberrations, and */ -/* is expressed with respect to the reference frame */ -/* specified by REF. The three components of PTARG */ -/* represent the x-, y- and z-components of the target's */ -/* position. */ - -/* PTARG points from the observer's location at ET to */ -/* the aberration-corrected location of the target. */ -/* Note that the sense of this position vector is */ -/* independent of the direction of radiation travel */ -/* implied by the aberration correction. */ - -/* Units are always km. */ - -/* Non-inertial frames are treated as follows: letting */ -/* LTCENT be the one-way light time between the observer */ -/* and the central body associated with the frame, the */ -/* orientation of the frame is evaluated at ET-LTCENT, */ -/* ET+LTCENT, or ET depending on whether the requested */ -/* aberration correction is, respectively, for received */ -/* radiation, transmitted radiation, or is omitted. */ -/* LTCENT is computed using the method indicated by */ -/* ABCORR. */ - -/* LT is the one-way light time between the observer and */ -/* target in seconds. If the target position is */ -/* corrected for aberrations, then LT is the one-way */ -/* light time between the observer and the light time */ -/* corrected target location. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If name of target or observer cannot be translated to its */ -/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */ - -/* 2) If the reference frame REF is not a recognized reference */ -/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */ - -/* 3) If the loaded kernels provide insufficient data to */ -/* compute the requested position vector, the deficiency will */ -/* be diagnosed by a routine in the call tree of this routine. */ - -/* 4) If an error occurs while reading an SPK or other kernel file, */ -/* the error will be diagnosed by a routine in the call tree */ -/* of this routine. */ - -/* 5) If the reference frame REF is dynamic, the error */ -/* SPICE(RECURSIONTOODEEP) will be signaled. */ - -/* $ Files */ - -/* This routine computes positions using SPK files that have been */ -/* loaded into the SPICE system, normally via the kernel loading */ -/* interface routine FURNSH. See the routine FURNSH and the SPK */ -/* and KERNEL Required Reading for further information on loading */ -/* (and unloading) kernels. */ - -/* If the output position PTARG is to be expressed relative to a */ -/* non-inertial frame, or if any of the ephemeris data used to */ -/* compute PTARG are expressed relative to a non-inertial frame in */ -/* the SPK files providing those data, additional kernels may be */ -/* needed to enable the reference frame transformations required to */ -/* compute the position. Normally these additional kernels are PCK */ -/* files or frame kernels. Any such kernels must already be loaded */ -/* at the time this routine is called. */ - -/* $ Particulars */ - -/* This routine is part of the user interface to the SPICE ephemeris */ -/* system. It allows you to retrieve position information for any */ -/* ephemeris object relative to any other in a reference frame that */ -/* is convenient for further computations. */ - - -/* Aberration corrections */ -/* ====================== */ - -/* In space science or engineering applications one frequently */ -/* wishes to know where to point a remote sensing instrument, such */ -/* as an optical camera or radio antenna, in order to observe or */ -/* otherwise receive radiation from a target. This pointing problem */ -/* is complicated by the finite speed of light: one needs to point */ -/* to where the target appears to be as opposed to where it actually */ -/* is at the epoch of observation. We use the adjectives */ -/* "geometric," "uncorrected," or "true" to refer to an actual */ -/* position or state of a target at a specified epoch. When a */ -/* geometric position or state vector is modified to reflect how it */ -/* appears to an observer, we describe that vector by any of the */ -/* terms "apparent," "corrected," "aberration corrected," or "light */ -/* time and stellar aberration corrected." The SPICE Toolkit can */ -/* correct for two phenomena affecting the apparent location of an */ -/* object: one-way light time (also called "planetary aberration") */ -/* and stellar aberration. */ - -/* One-way light time */ -/* ------------------ */ - -/* Correcting for one-way light time is done by computing, given an */ -/* observer and observation epoch, where a target was when the */ -/* observed photons departed the target's location. The vector from */ -/* the observer to this computed target location is called a "light */ -/* time corrected" vector. The light time correction depends on the */ -/* motion of the target relative to the solar system barycenter, but */ -/* it is independent of the velocity of the observer relative to the */ -/* solar system barycenter. Relativistic effects such as light */ -/* bending and gravitational delay are not accounted for in the */ -/* light time correction performed by this routine. */ - -/* Stellar aberration */ -/* ------------------ */ - -/* The velocity of the observer also affects the apparent location */ -/* of a target: photons arriving at the observer are subject to a */ -/* "raindrop effect" whereby their velocity relative to the observer */ -/* is, using a Newtonian approximation, the photons' velocity */ -/* relative to the solar system barycenter minus the velocity of the */ -/* observer relative to the solar system barycenter. This effect is */ -/* called "stellar aberration." Stellar aberration is independent */ -/* of the velocity of the target. The stellar aberration formula */ -/* used by this routine does not include (the much smaller) */ -/* relativistic effects. */ - -/* Stellar aberration corrections are applied after light time */ -/* corrections: the light time corrected target position vector is */ -/* used as an input to the stellar aberration correction. */ - -/* When light time and stellar aberration corrections are both */ -/* applied to a geometric position vector, the resulting position */ -/* vector indicates where the target "appears to be" from the */ -/* observer's location. */ - -/* As opposed to computing the apparent position of a target, one */ -/* may wish to compute the pointing direction required for */ -/* transmission of photons to the target. This also requires */ -/* correction of the geometric target position for the effects of */ -/* light time and stellar aberration, but in this case the */ -/* corrections are computed for radiation traveling *from* the */ -/* observer to the target. */ - -/* The "transmission" light time correction yields the target's */ -/* location as it will be when photons emitted from the observer's */ -/* location at ET arrive at the target. The transmission stellar */ -/* aberration correction is the inverse of the traditional stellar */ -/* aberration correction: it indicates the direction in which */ -/* radiation should be emitted so that, using a Newtonian */ -/* approximation, the sum of the velocity of the radiation relative */ -/* to the observer and of the observer's velocity, relative to the */ -/* solar system barycenter, yields a velocity vector that points in */ -/* the direction of the light time corrected position of the target. */ - -/* One may object to using the term "observer" in the transmission */ -/* case, in which radiation is emitted from the observer's location. */ -/* The terminology was retained for consistency with earlier */ -/* documentation. */ - -/* Below, we indicate the aberration corrections to use for some */ -/* common applications: */ - -/* 1) Find the apparent direction of a target for a remote-sensing */ -/* observation. */ - -/* Use 'LT+S': apply both light time and stellar */ -/* aberration corrections. */ - -/* Note that using light time corrections alone ('LT') is */ -/* generally not a good way to obtain an approximation to an */ -/* apparent target vector: since light time and stellar */ -/* aberration corrections often partially cancel each other, */ -/* it may be more accurate to use no correction at all than to */ -/* use light time alone. */ - - -/* 2) Find the corrected pointing direction to radiate a signal */ -/* to a target. This computation is often applicable for */ -/* implementing communications sessions. */ - -/* Use 'XLT+S': apply both light time and stellar */ -/* aberration corrections for transmission. */ - - -/* 3) Compute the apparent position of a target body relative */ -/* to a star or other distant object. */ - -/* Use 'LT' or 'LT+S' as needed to match the correction */ -/* applied to the position of the distant object. For */ -/* example, if a star position is obtained from a catalog, */ -/* the position vector may not be corrected for stellar */ -/* aberration. In this case, to find the angular */ -/* separation of the star and the limb of a planet, the */ -/* vector from the observer to the planet should be */ -/* corrected for light time but not stellar aberration. */ - - -/* 4) Obtain an uncorrected position vector derived directly from */ -/* data in an SPK file. */ - -/* Use 'NONE'. */ - - -/* 5) Use a geometric position vector as a low-accuracy estimate */ -/* of the apparent position for an application where execution */ -/* speed is critical. */ - -/* Use 'NONE'. */ - - -/* 6) While this routine cannot perform the relativistic */ -/* aberration corrections required to compute positions */ -/* with the highest possible accuracy, it can supply the */ -/* geometric positions required as inputs to these */ -/* computations. */ - -/* Use 'NONE', then apply high-accuracy aberration */ -/* corrections (not available in the SPICE Toolkit). */ - - -/* Below, we discuss in more detail how the aberration corrections */ -/* applied by this routine are computed. */ - -/* Geometric case */ -/* ============== */ - -/* ZZSPKZP1 begins by computing the geometric position T(ET) of */ -/* the target body relative to the solar system barycenter (SSB). */ -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the geometric position of the target body relative to the */ -/* observer. The one-way light time, LT, is given by */ - -/* | T(ET) - O(ET) | */ -/* LT = ------------------- */ -/* c */ - -/* The geometric relationship between the observer, target, and */ -/* solar system barycenter is as shown: */ - - -/* SSB ---> O(ET) */ -/* | / */ -/* | / */ -/* | / */ -/* | / T(ET) - O(ET) */ -/* V V */ -/* T(ET) */ - - -/* The returned position vector is */ - -/* T(ET) - O(ET) */ - - - -/* Reception case */ -/* ============== */ - -/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */ -/* for ABCORR, ZZSPKZP1 computes the position of the target body */ -/* at epoch ET-LT, where LT is the one-way light time. Let T(t) */ -/* and O(t) represent the positions of the target and observer */ -/* relative to the solar system barycenter at time t; then LT is */ -/* the solution of the light-time equation */ - -/* | T(ET-LT) - O(ET) | */ -/* LT = ------------------------ (1) */ -/* c */ - -/* The ratio */ - -/* | T(ET) - O(ET) | */ -/* --------------------- (2) */ -/* c */ - -/* is used as a first approximation to LT; inserting (2) into the */ -/* right hand side of the light-time equation (1) yields the */ -/* "one-iteration" estimate of the one-way light time ("LT"). */ -/* Repeating the process until the estimates of LT converge */ -/* yields the "converged Newtonian" light time estimate ("CN"). */ - -/* Subtracting the geometric position of the observer O(ET) gives */ -/* the position of the target body relative to the observer: */ -/* T(ET-LT) - O(ET). */ - -/* SSB ---> O(ET) */ -/* | \ | */ -/* | \ | */ -/* | \ | T(ET-LT) - O(ET) */ -/* | \ | */ -/* V V V */ -/* T(ET) T(ET-LT) */ - -/* The light time corrected position vector is */ - -/* T(ET-LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated toward the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as follows: */ - -/* Let r be the light time corrected vector from the observer */ -/* to the object, and v be the velocity of the observer with */ -/* respect to the solar system barycenter. Let w be the angle */ -/* between them. The aberration angle phi is given by */ - -/* sin(phi) = v sin(w) / c */ - -/* Let h be the vector given by the cross product */ - -/* h = r X v */ - -/* Rotate r by phi radians about h to obtain the apparent */ -/* position of the object. */ - - -/* Transmission case */ -/* ================== */ - -/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */ -/* selected, ZZSPKZP1 computes the position of the target body T */ -/* at epoch ET+LT, where LT is the one-way light time. LT is the */ -/* solution of the light-time equation */ - -/* | T(ET+LT) - O(ET) | */ -/* LT = ------------------------ (3) */ -/* c */ - -/* Subtracting the geometric position of the observer, O(ET), */ -/* gives the position of the target body relative to the */ -/* observer: T(ET-LT) - O(ET). */ - -/* SSB --> O(ET) */ -/* / | * */ -/* / | * T(ET+LT) - O(ET) */ -/* / |* */ -/* / *| */ -/* V V V */ -/* T(ET+LT) T(ET) */ - -/* The light-time corrected position vector is */ - -/* T(ET+LT) - O(ET) */ - -/* If correction for stellar aberration is requested, the target */ -/* position is rotated away from the solar system barycenter- */ -/* relative velocity vector of the observer. The rotation is */ -/* computed as in the reception case, but the sign of the */ -/* rotation angle is negated. */ - - -/* Precision of light time corrections */ -/* =================================== */ - -/* Corrections using one iteration of the light time solution */ -/* ---------------------------------------------------------- */ - -/* When the requested aberration correction is 'LT', 'LT+S', */ -/* 'XLT', or 'XLT+S', only one iteration is performed in the */ -/* algorithm used to compute LT. */ - -/* The relative error in this computation */ - -/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */ - -/* is at most */ - -/* (V/C)**2 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**2, where V is the */ -/* velocity of the target relative to an inertial frame and C is */ -/* the speed of light. */ - -/* For nearly all objects in the solar system V is less than 60 */ -/* km/sec. The value of C is 300000 km/sec. Thus the one */ -/* iteration solution for LT has a potential relative error of */ -/* not more than 4*10**-8. This is a potential light time error */ -/* of approximately 2*10**-5 seconds per astronomical unit of */ -/* distance separating the observer and target. Given the bound */ -/* on V cited above: */ - -/* As long as the observer and target are */ -/* separated by less than 50 astronomical units, */ -/* the error in the light time returned using */ -/* the one-iteration light time corrections */ -/* is less than 1 millisecond. */ - - -/* Converged corrections */ -/* --------------------- */ - -/* When the requested aberration correction is 'CN', 'CN+S', */ -/* 'XCN', or 'XCN+S', three iterations are performed in the */ -/* computation of LT. The relative error present in this */ -/* solution is at most */ - -/* (V/C)**4 */ -/* ---------- */ -/* 1 - (V/C) */ - -/* which is well approximated by (V/C)**4. Mathematically the */ -/* precision of this computation is better than a nanosecond for */ -/* any pair of objects in the solar system. */ - -/* However, to model the actual light time between target and */ -/* observer one must take into account effects due to general */ -/* relativity. These may be as high as a few hundredths of a */ -/* millisecond for some objects. */ - -/* When one considers the extra time required to compute the */ -/* converged Newtonian light time (the state of the target */ -/* relative to the solar system barycenter is looked up three */ -/* times instead of once) together with the real gain in */ -/* accuracy, it seems unlikely that you will want to request */ -/* either the "CN" or "CN+S" light time corrections. However, */ -/* these corrections can be useful for testing situations where */ -/* high precision (as opposed to accuracy) is required. */ - - -/* Relativistic Corrections */ -/* ========================= */ - -/* This routine does not attempt to perform either general or */ -/* special relativistic corrections in computing the various */ -/* aberration corrections. For many applications relativistic */ -/* corrections are not worth the expense of added computation */ -/* cycles. If however, your application requires these additional */ -/* corrections we suggest you consult the astronomical almanac (page */ -/* B36) for a discussion of how to carry out these corrections. */ - - -/* $ Examples */ - -/* 1) Load a planetary ephemeris SPK, then look up a series of */ -/* geometric positions of the moon relative to the earth, */ -/* referenced to the J2000 frame. */ - - -/* IMPLICIT NONE */ -/* C */ -/* C Local constants */ -/* C */ -/* CHARACTER*(*) FRAME */ -/* PARAMETER ( FRAME = 'J2000' ) */ - -/* CHARACTER*(*) ABCORR */ -/* PARAMETER ( ABCORR = 'NONE' ) */ - -/* C */ -/* C The name of the SPK file shown here is fictitious; */ -/* C you must supply the name of an SPK file available */ -/* C on your own computer system. */ -/* C */ -/* CHARACTER*(*) SPK */ -/* PARAMETER ( SPK = 'planet.bsp' ) */ - -/* C */ -/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */ -/* C */ -/* DOUBLE PRECISION ET0 */ -/* PARAMETER ( ET0 = 0.0D0 ) */ - -/* C */ -/* C Use a time step of 1 hour; look up 100 positions. */ -/* C */ -/* DOUBLE PRECISION STEP */ -/* PARAMETER ( STEP = 3600.0D0 ) */ - -/* INTEGER MAXITR */ -/* PARAMETER ( MAXITR = 100 ) */ - -/* C */ -/* C The NAIF IDs of the earth and moon are 399 and 301 */ -/* C respectively. */ -/* C */ -/* INTEGER OBSRVR */ -/* PARAMETER ( OBSRVR = 399 ) */ - -/* INTEGER TARGET */ -/* PARAMETER ( TARGET = 301 ) */ - -/* C */ -/* C Local variables */ -/* C */ -/* DOUBLE PRECISION ET */ -/* DOUBLE PRECISION LT */ -/* DOUBLE PRECISION POS ( 3 ) */ - -/* INTEGER I */ - -/* C */ -/* C Load the SPK file. */ -/* C */ -/* CALL FURNSH ( SPK ) */ - -/* C */ -/* C Step through a series of epochs, looking up a */ -/* C position vector at each one. */ -/* C */ -/* DO I = 1, MAXITR */ - -/* ET = ET0 + (I-1)*STEP */ - -/* CALL ZZSPKZP1 ( TARGET, ET, FRAME, ABCORR, OBSRVR, */ -/* . POS, LT ) */ - -/* WRITE (*,*) 'ET = ', ET */ -/* WRITE (*,*) 'J2000 x-position (km): ', POS(1) */ -/* WRITE (*,*) 'J2000 y-position (km): ', POS(2) */ -/* WRITE (*,*) 'J2000 z-position (km): ', POS(3) */ -/* WRITE (*,*) ' ' */ - -/* END DO */ - -/* END */ - - -/* $ Restrictions */ - -/* 1) SPICE Private routine. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* C.H. Acton (JPL) */ -/* B.V. Semenov (JPL) */ -/* N.J. Bachman (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ - -/* Based on SPICELIB Version 3.1.0, 05-JAN-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* using body names get position relative to an observer */ -/* get position relative observer corrected for aberrations */ -/* read ephemeris data */ -/* read trajectory data */ - -/* -& */ -/* $ Revisions */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZSPKZP1", (ftnlen)8); - } - -/* Get the frame id for J2000 on the first call to this routine. */ - - if (first) { - first = FALSE_; - namfrm_("J2000", &fj2000, (ftnlen)5); - } - -/* Get the auxiliary information about the requested output frame. */ - - namfrm_(ref, &reqfrm, ref_len); - if (reqfrm == 0) { - setmsg_("The requested output frame '#' is not recognized by the ref" - "erence frame subsystem. Please check that the appropriate k" - "ernels have been loaded and that you have correctly entered " - "the name of the output frame. ", (ftnlen)209); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; - } - frinfo_(&reqfrm, ¢er, &type__, &typeid, &found); - -/* At this recursion level, dynamic frames are not supported. */ - - if (type__ == 5) { - setmsg_("Frame # belongs to the class \"dynamic.\" Conversions invol" - "ving dynamic frames are not supported at the second recursio" - "n level. The requested frame transformation would require t" - "hree or more levels of recursion.", (ftnlen)210); - errch_("#", ref, (ftnlen)1, ref_len); - sigerr_("SPICE(RECURSIONTOODEEP)", (ftnlen)23); - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; - } - -/* Decide whether the aberration correction is for received or */ -/* transmitted radiation. */ - - i__ = ltrim_(abcorr, abcorr_len); - xmit = eqchr_(abcorr + (i__ - 1), "X", (ftnlen)1, (ftnlen)1); - -/* If we only want geometric positions, then compute just that. */ - -/* Otherwise, compute the state of the observer relative to */ -/* the SSB. Then feed that position into ZZSPKPA1 to compute the */ -/* apparent position of the target body relative to the observer */ -/* with the requested aberration corrections. */ - - if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) { - zzspkgp1_(targ, et, ref, obs, ptarg, lt, ref_len); - } else { - -/* If we are dealing with an inertial frame, we can simply */ -/* call ZZSPKSB0, ZZSPKPA1 and return. */ - - if (type__ == 1) { - zzspksb1_(obs, et, ref, sobs, ref_len); - zzspkpa1_(targ, et, ref, sobs, abcorr, ptarg, lt, ref_len, - abcorr_len); - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; - } - -/* Still here? */ - -/* We are dealing with a non-inertial frame. But we need to */ -/* do light time and stellar aberration in an inertial frame. */ -/* Get the "apparent" position of TARG in the intermediary */ -/* inertial reference frame J2000. */ - -/* We also need the light time to the center of the frame. */ - - zzspksb1_(obs, et, "J2000", sobs, (ftnlen)5); - zzspkpa1_(targ, et, "J2000", sobs, abcorr, postn, lt, (ftnlen)5, - abcorr_len); - if (failed_()) { - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; - } - if (center == *obs) { - ltcent = 0.; - } else if (center == *targ) { - ltcent = *lt; - } else { - zzspkpa1_(¢er, et, "J2000", sobs, abcorr, temp, <cent, ( - ftnlen)5, abcorr_len); - } - -/* If something went wrong (like we couldn't get the position of */ -/* the center relative to the observer) now it is time to quit. */ - - if (failed_()) { - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; - } - -/* If the aberration corrections are for transmission, negate */ -/* the light time, since we wish to compute the orientation */ -/* of the non-inertial frame at an epoch later than ET by */ -/* the one-way light time. */ - - if (xmit) { - ltcent = -ltcent; - } - -/* Get the rotation from J2000 to the requested frame */ -/* and convert the position. */ - - d__1 = *et - ltcent; - zzrefch1_(&fj2000, &reqfrm, &d__1, xform); - if (failed_()) { - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; - } - mxv_(xform, postn, ptarg); - } - chkout_("ZZSPKZP1", (ftnlen)8); - return 0; -} /* zzspkzp1_ */ - diff --git a/ext/spice/src/cspice/zzstelab.c b/ext/spice/src/cspice/zzstelab.c deleted file mode 100644 index df0c54f09e..0000000000 --- a/ext/spice/src/cspice/zzstelab.c +++ /dev/null @@ -1,552 +0,0 @@ -/* zzstelab.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static doublereal c_b3 = 1.; - -/* $Procedure ZZSTELAB ( Private --- stellar aberration correction ) */ -/* Subroutine */ int zzstelab_(logical *xmit, doublereal *accobs, doublereal * - vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr) -{ - /* System generated locals */ - integer i__1; - doublereal d__1, d__2; - - /* Builtin functions */ - double sqrt(doublereal); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * - ); - doublereal dphi, rhat[3]; - extern /* Subroutine */ int vhat_(doublereal *, doublereal *); - extern doublereal vdot_(doublereal *, doublereal *); - extern /* Subroutine */ int vequ_(doublereal *, doublereal *); - doublereal term1[3], term2[3], term3[3], c__, lcacc[3]; - integer i__; - doublereal s, saoff[6] /* was [3][2] */, drhat[3]; - extern /* Subroutine */ int dvhat_(doublereal *, doublereal *); - doublereal ptarg[3], evobs[3], srhat[6], vphat[3], vtarg[3]; - extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal - *, doublereal *, doublereal *), vperp_(doublereal *, doublereal *, - doublereal *); - extern doublereal vnorm_(doublereal *); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *, - doublereal *, doublereal *, doublereal *, doublereal *, - doublereal *), cleard_(integer *, doublereal *); - doublereal vp[3]; - extern doublereal clight_(void); - doublereal dptmag, ptgmag, eptarg[3], dvphat[3], lcvobs[3]; - extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, - doublereal *, doublereal *); - doublereal svphat[6]; - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - doublereal sgn, dvp[3], svp[6]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the state (position and velocity) of a target body */ -/* relative to an observing body, optionally corrected for light */ -/* time (planetary aberration) and stellar aberration. */ - -/* $ 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 */ - -/* SPK */ - -/* $ Keywords */ - -/* EPHEMERIS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* XMIT I Reception/transmission flag. */ -/* ACCOBS I Observer acceleration relative to SSB. */ -/* VOBS I Observer velocity relative to to SSB. */ -/* STARG I State of target relative to observer. */ -/* SCORR O Stellar aberration correction for position. */ -/* DSCORR O Stellar aberration correction for velocity. */ - -/* $ Detailed_Input */ - -/* XMIT is a logical flag which is set to .TRUE. for the */ -/* "transmission" case in which photons *depart* from */ -/* the observer's location at an observation epoch ET */ -/* and arrive at the target's location at the light-time */ -/* corrected epoch ET+LT, where LT is the one-way light */ -/* time between observer and target; XMIT is set to */ -/* .FALSE. for "reception" case in which photons depart */ -/* from the target's location at the light-time */ -/* corrected epoch ET-LT and *arrive* at the observer's */ -/* location at ET. */ - -/* Note that the observation epoch is not used in this */ -/* routine. */ - -/* XMIT must be consistent with any light time */ -/* corrections used for the input state STARG: if that */ -/* state has been corrected for "reception" light time; */ -/* XMIT must be .FALSE.; otherwise XMIT must be .TRUE. */ - -/* ACCOBS is the geometric acceleration of the observer */ -/* relative to the solar system barycenter. Units are */ -/* km/sec**2. ACCOBS must be expressed relative to */ -/* an inertial reference frame. */ - -/* VOBS is the geometric velocity of the observer relative to */ -/* the solar system barycenter. VOBS must be expressed */ -/* relative to the same inertial reference frame as */ -/* ACCOBS. Units are km/sec. */ - -/* STARG is the Cartesian state of the target relative to the */ -/* observer. Normally STARG has been corrected for */ -/* one-way light time, but this is not required. STARG */ -/* must be expressed relative to the same inertial */ -/* reference frame as ACCOBS. Components are */ -/* (x, y, z, dx, dy, dz). Units are km and km/sec. */ - -/* $ Detailed_Output */ - -/* SCORR is the stellar aberration correction for the position */ -/* component of STARG. Adding SCORR to this position */ -/* vector produces the input observer-target position, */ -/* corrected for stellar aberration. */ - -/* The reference frame of SCORR is the common frame */ -/* relative to which the inputs ACCOBS, VOBS, and STARG */ -/* are expressed. Units are km. */ - -/* DSCORR is the stellar aberration correction for the velocity */ -/* component of STARG. Adding DSCORR to this velocity */ -/* vector produces the input observer-target velocity, */ -/* corrected for stellar aberration. */ - -/* The reference frame of DSCORR is the common frame */ -/* relative to which the inputs ACCOBS, VOBS, and STARG */ -/* are expressed. Units are km/s. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) Loss of precision will occur for geometric cases in which */ -/* VOBS is nearly parallel to the position component of STARG. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine computes a Newtonian estimate of the stellar */ -/* aberration correction of an input state. Normally the input state */ -/* has already been corrected for one-way light time. */ - -/* Since stellar aberration corrections are typically "small" */ -/* relative to the magnitude of the input observer-target position */ -/* and velocity, this routine avoids loss of precision by returning */ -/* the corrections themselves rather than the corrected state */ -/* vector. This allows the caller to manipulate (for example, */ -/* interpolate) the corrections with greater accuracy. */ - -/* $ Examples */ - -/* See SPICELIB routine SPKACS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* SPK Required Reading. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 12-FEB-2009 (NJB) */ - -/* Minor updates were made to the inline documentation. */ - -/* - SPICELIB Version 1.0.0, 17-JAN-2008 (NJB) */ - -/* -& */ - -/* Note for the maintenance programmer */ -/* =================================== */ - -/* The source code of the test utility T_ZZSTLABN must be */ -/* kept in sync with the source code of this routine. That */ -/* routine uses a value of SEPLIM that forces the numeric */ -/* branch of the velocity computation to be taken in all */ -/* cases. See the documentation of that routine for details. */ - - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Let PHI be the (non-negative) rotation angle of the stellar */ -/* aberration correction; then SEPLIM is a limit on how close PHI */ -/* may be to zero radians while stellar aberration velocity is */ -/* computed analytically. When sin(PHI) is less than SEPLIM, the */ -/* velocity must be computed numerically. */ - - -/* Let TDELTA be the time interval, measured in seconds, */ -/* used for numerical differentiation of the stellar */ -/* aberration correction, when this is necessary. */ - - -/* Local variables */ - - -/* In the discussion below, the dot product of vectors X and Y */ -/* is denoted by */ - -/* */ - -/* The speed of light is denoted by the lower case letter "c." BTW, */ -/* variable names used here are case-sensitive: upper case "C" */ -/* represents a different quantity which is unrelated to the speed */ -/* of light. */ - -/* Variable names ending in "HAT" denote unit vectors. Variable */ -/* names starting with "D" denote derivatives with respect to time. */ - -/* We'll compute the correction SCORR and its derivative with */ -/* respect to time DSCORR for the reception case. In the */ -/* transmission case, we perform the same computation with the */ -/* negatives of the observer velocity and acceleration. */ - -/* In the code below, we'll store the position and velocity portions */ -/* of the input observer-target state STARG in the variables PTARG */ -/* and VTARG, respectively. */ - -/* Let VP be the component of VOBS orthogonal to PTARG. VP */ -/* is defined as */ - -/* VOBS - < VOBS, RHAT > RHAT (1) */ - -/* where RHAT is the unit vector */ - -/* PTARG/||PTARG|| */ - -/* Then */ - -/* ||VP||/c (2) */ - -/* is the magnitude of */ - -/* s = sin( phi ) (3) */ - -/* where phi is the stellar aberration correction angle. We'll */ -/* need the derivative with respect to time of (2). */ - -/* Differentiating (1) with respect to time yields the */ -/* velocity DVP, where, letting */ - -/* DRHAT = d(RHAT) / dt */ -/* VPHAT = VP / ||VP|| */ -/* DVPMAG = d( ||VP|| ) / dt */ - -/* we have */ - -/* DVP = d(VP)/dt */ - -/* = ACCOBS - ( ( + )*RHAT */ -/* + * DRHAT ) (4) */ - -/* and */ - -/* DVPMAG = < DVP, VPHAT > (5) */ - -/* Now we can find the derivative with respect to time of */ -/* the stellar aberration angle phi: */ - -/* ds/dt = d(sin(phi))/dt = d(phi)/dt * cos(phi) (6) */ - -/* Using (2) and (5), we have for positive phi, */ - -/* ds/dt = (1/c)*DVPMAG = (1/c)* (7) */ - -/* Then for positive phi */ - -/* d(phi)/dt = (1/cos(phi)) * (1/c) * (8) */ - -/* Equation (8) is well-defined as along as VP is non-zero: */ -/* if VP is the zero vector, VPHAT is undefined. We'll treat */ -/* the singular and near-singular cases separately. */ - -/* The aberration correction itself is a rotation by angle phi */ -/* from RHAT towards VP, so the corrected vector is */ - -/* ( sin(phi)*VPHAT + cos(phi)*RHAT ) * ||PTARG|| */ - -/* and we can express the offset of the corrected vector from */ -/* PTARG, which is the output SCORR, as */ - -/* SCORR = */ - -/* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| (9) */ - -/* Let DPTMAG be defined as */ - -/* DPTMAG = d ( ||PTARG|| ) / dt (10) */ - -/* Then the derivative with respect to time of SCORR is */ - -/* DSCORR = */ - -/* ( sin(phi)*DVPHAT */ - -/* + cos(phi)*d(phi)/dt * VPHAT */ - -/* + (cos(phi) - 1) * DRHAT */ - -/* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */ - -/* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG (11) */ - - -/* Computations begin here: */ - -/* Split STARG into position and velocity components. Compute */ - -/* RHAT */ -/* DRHAT */ -/* VP */ -/* DPTMAG */ - - if (*xmit) { - vminus_(vobs, lcvobs); - vminus_(accobs, lcacc); - } else { - vequ_(vobs, lcvobs); - vequ_(accobs, lcacc); - } - vequ_(starg, ptarg); - vequ_(&starg[3], vtarg); - dvhat_(starg, srhat); - vequ_(srhat, rhat); - vequ_(&srhat[3], drhat); - vperp_(lcvobs, rhat, vp); - dptmag = vdot_(vtarg, rhat); - -/* Compute sin(phi) and cos(phi), which we'll call S and C */ -/* respectively. Note that phi is always close to zero for */ -/* realistic inputs (for which ||VOBS|| << CLIGHT), so the */ -/* cosine term is positive. */ - - s = vnorm_(vp) / clight_(); -/* Computing MAX */ - d__1 = 0., d__2 = 1 - s * s; - c__ = sqrt((max(d__1,d__2))); - -/* Compute the unit vector VPHAT and the stellar */ -/* aberration correction. We avoid relying on */ -/* VHAT's exception handling for the zero vector. */ - - if (vzero_(vp)) { - cleard_(&c__3, vphat); - } else { - vhat_(vp, vphat); - } - -/* Now we can use equation (9) to obtain the stellar */ -/* aberration correction SCORR: */ - -/* SCORR = */ - -/* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| */ - - - ptgmag = vnorm_(ptarg); - d__1 = ptgmag * s; - d__2 = ptgmag * (c__ - 1.); - vlcom_(&d__1, vphat, &d__2, rhat, scorr); - -/* Now we use S as an estimate of PHI to decide if we're */ -/* going to differentiate the stellar aberration correction */ -/* analytically or numerically. */ - -/* Note that S is non-negative by construction, so we don't */ -/* need to use the absolute value of S here. */ - - if (s >= 1e-6) { - -/* This is the analytic case. */ - -/* Compute DVP---the derivative of VP with respect to time. */ -/* Recall equation (4): */ - -/* DVP = d(VP)/dt */ - -/* = ACCOBS - ( ( + )*RHAT */ -/* + * DRHAT ) */ - - d__1 = -vdot_(lcvobs, drhat) - vdot_(lcacc, rhat); - d__2 = -vdot_(lcvobs, rhat); - vlcom3_(&c_b3, lcacc, &d__1, rhat, &d__2, drhat, dvp); - vhat_(vp, vphat); - -/* Now we can compute DVPHAT, the derivative of VPHAT: */ - - vequ_(vp, svp); - vequ_(dvp, &svp[3]); - dvhat_(svp, svphat); - vequ_(&svphat[3], dvphat); - -/* Compute the DPHI, the time derivative of PHI, using equation 8: */ - -/* d(phi)/dt = (1/cos(phi)) * (1/c) * */ - - - dphi = 1. / (c__ * clight_()) * vdot_(dvp, vphat); - -/* At long last we've assembled all of the "ingredients" required */ -/* to compute DSCORR: */ - -/* DSCORR = */ - -/* ( sin(phi)*DVPHAT */ - -/* + cos(phi)*d(phi)/dt * VPHAT */ - -/* + (cos(phi) - 1) * DRHAT */ - -/* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */ - -/* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG */ - - - d__1 = c__ * dphi; - vlcom_(&s, dvphat, &d__1, vphat, term1); - d__1 = c__ - 1.; - d__2 = -s * dphi; - vlcom_(&d__1, drhat, &d__2, rhat, term2); - vadd_(term1, term2, term3); - d__1 = dptmag * s; - d__2 = dptmag * (c__ - 1.); - vlcom3_(&ptgmag, term3, &d__1, vphat, &d__2, rhat, dscorr); - } else { - -/* This is the numeric case. We're going to differentiate */ -/* the stellar aberration correction offset vector using */ -/* a quadratic estimate. */ - - for (i__ = 1; i__ <= 2; ++i__) { - -/* Set the sign of the time offset. */ - - if (i__ == 1) { - sgn = -1.; - } else { - sgn = 1.; - } - -/* Estimate the observer's velocity relative to the */ -/* solar system barycenter at the current epoch. We use */ -/* the local copies of the input velocity and acceleration */ -/* to make a linear estimate. */ - - d__1 = sgn * 1.; - vlcom_(&c_b3, lcvobs, &d__1, lcacc, evobs); - -/* Estimate the observer-target vector. We use the */ -/* observer-target state velocity to make a linear estimate. */ - - d__1 = sgn * 1.; - vlcom_(&c_b3, starg, &d__1, &starg[3], eptarg); - -/* Let RHAT be the unit observer-target position. */ -/* Compute the component of the observer's velocity */ -/* that is perpendicular to the target position; call */ -/* this vector VP. Also compute the unit vector in */ -/* the direction of VP. */ - - vhat_(eptarg, rhat); - vperp_(evobs, rhat, vp); - if (vzero_(vp)) { - cleard_(&c__3, vphat); - } else { - vhat_(vp, vphat); - } - -/* Compute the sine and cosine of the correction */ -/* angle. */ - - s = vnorm_(vp) / clight_(); -/* Computing MAX */ - d__1 = 0., d__2 = 1 - s * s; - c__ = sqrt((max(d__1,d__2))); - -/* Compute the vector offset of the correction. */ - - ptgmag = vnorm_(eptarg); - d__1 = ptgmag * s; - d__2 = ptgmag * (c__ - 1.); - vlcom_(&d__1, vphat, &d__2, rhat, &saoff[(i__1 = i__ * 3 - 3) < 6 - && 0 <= i__1 ? i__1 : s_rnge("saoff", i__1, "zzstelab_", ( - ftnlen)562)]); - } - -/* Now compute the derivative. */ - - qderiv_(&c__3, saoff, &saoff[3], &c_b3, dscorr); - } - -/* At this point the correction offset SCORR and its derivative */ -/* with respect to time DSCORR are both set. */ - - return 0; -} /* zzstelab_ */ - diff --git a/ext/spice/src/cspice/zzsynccl_c.c b/ext/spice/src/cspice/zzsynccl_c.c deleted file mode 100644 index 13a99a8738..0000000000 --- a/ext/spice/src/cspice/zzsynccl_c.c +++ /dev/null @@ -1,263 +0,0 @@ -/* - --Procedure zzsynccl_c ( Sync a CSPICE cell ) - --Abstract - - CSPICE Private routine intended solely for the support of CSPICE - routines. Users should not call this routine directly due - to the volatile nature of this routine. - - Sync a CSPICE cell. - --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 - - CELLS - --Keywords - - CELLS - -*/ - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceCel.h" - #include "SpiceZmc.h" - - void zzsynccl_c ( SpiceTransDir xdir, - SpiceCell * cell ) - -/* - --Brief_I/O - - VARIABLE I/O DESCRIPTION - -------- --- -------------------------------------------------- - xdir I Translation direction. - cell I/O Cell to be synced. - --Detailed_Input - - xdir indicates the translation direction. Values and - meanings are: - - - C2F Support C to Fortran translation. - - Set the size and cardinality - represented by the control area of the - cell's data array. The size and - cardinality will be set to the values - indicated by the corresponding members - of the SpiceCell structure. - - This operation is meaningful only for - numeric SpiceCell types. For - character SpiceCells, this option - results in a no-op. - - F2C Support Fortran to C translation. - - Set the size and cardinality members - of the SpiceCell structure to the - values represented by the control area - of the cell's data array. - - - cell The cell to be synced. The cell's size and cardinality - values in the SpiceCell structure and in the data array - are to be synced---set to identical values. - --Detailed_Output - - cell The cell to be synced. The cell's size and cardinality - values in the SpiceCell structure and in the data array - are synced---set to identical values---with the direction - of synchronization controlled by the argument xdir. - --Parameters - - None. - --Exceptions - - 1) If the input cell does not have a recognized data type, - the error SPICE(NOTSUPPORTED) is signaled. - - 2) It's a no-op, but not an error, to have this routine perform an - C2F sync on a character cell. The reason this operational - capability is omitted is that the control area of a character - cell's data array is not used: when a character cell is to - be operated on by an f2c'd routine, the cell's contents are mapped - to a dynamically allocated array, and the control area of that - array is set up on the fly via calls to ssizec_ and scardc_. - --Files - - None. - --Particulars - - This utility performs a commonly required cell operation, simplifying - the coding of CSPICE wrappers for functions that have SpiceCell - inputs or outputs. - --Examples - - See wninsd_c and the CELLINIT macro defined in SpiceZmc.h. - --Restrictions - - 1) This is a CSPICE private routine. The interface may be changed - without notice, so this routine should not be called except by - other CSPICE routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Version - - -CSPICE Version 1.0.0, 29-JUL-2002 (NJB) - --Index_Entries - - sync a CSPICE cell - --& -*/ - - -{ - /* - Local variables - */ - SpiceCellDataType dtype; - - SpiceInt ccard; - SpiceInt csize; - SpiceInt cstrlen; - - void * fcell; - - /* - Discovery check-in here. - */ - - - /* - Define some abbreviations first. - */ - csize = cell->size; - ccard = cell->card; - dtype = cell->dtype; - fcell = cell->base; - - if ( xdir == C2F ) - { - /* - Sync the Fortran array with the size and cardinality values - stored in the associated C structure. - - Setting a Fortran cell's size automatically sets the cardinality - to zero, so scard* must be called to set the cardinality. - */ - if ( dtype == SPICE_DP ) - { - ssized_ ( ( integer * ) &csize, - ( doublereal * ) fcell ); - - scardd_ ( ( integer * ) &ccard, - ( doublereal * ) fcell ); - } - - else if ( dtype == SPICE_INT ) - { - ssizei_ ( ( integer * ) &csize, - ( integer * ) fcell ); - - scardi_ ( ( integer * ) &ccard, - ( integer * ) fcell ); - } - - else if ( dtype != SPICE_CHR ) - { - chkin_c ( "zzsynccl_c" ); - setmsg_c ( "Invalid data type code # seen" ); - errint_c ( "#", (SpiceInt) dtype ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "zzsynccl_c" ); - return; - } - } - - - else - { - /* - Sync the C structure size and cardinality values with those - in the Fortran array. - */ - if ( dtype == SPICE_CHR ) - { - cstrlen = cell->length; - - cell->size = sizec_ ( ( char * ) fcell, - ( ftnlen ) cstrlen-1 ); - cell->card = cardc_ ( ( char * ) fcell, - ( ftnlen ) cstrlen-1 ); - } - - else if ( dtype == SPICE_DP ) - { - cell->size = sized_ ( ( doublereal * ) fcell ); - cell->card = cardd_ ( ( doublereal * ) fcell ); - } - - else if ( dtype == SPICE_INT ) - { - cell->size = sizei_ ( ( integer * ) fcell ); - cell->card = cardi_ ( ( integer * ) fcell ); - } - - else - { - chkin_c ( "zzsynccl_c" ); - setmsg_c ( "Invalid data type code # seen" ); - errint_c ( "#", (SpiceInt) dtype ); - sigerr_c ( "SPICE(NOTSUPPORTED)" ); - chkout_c ( "zzsynccl_c" ); - return; - } - } -} diff --git a/ext/spice/src/cspice/zztime.c b/ext/spice/src/cspice/zztime.c deleted file mode 100644 index 5ab189f013..0000000000 --- a/ext/spice/src/cspice/zztime.c +++ /dev/null @@ -1,3737 +0,0 @@ -/* zztime.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__12 = 12; - -/* $Procedure ZZTIME ( Private --- time parsing utilities ) */ -logical zztime_0_(int n__, char *string, char *transl, char *letter, char * - error, char *pic, doublereal *tvec, integer *b, integer *e, logical * - l2r, logical *yabbrv, ftnlen string_len, ftnlen transl_len, ftnlen - letter_len, ftnlen error_len, ftnlen pic_len) -{ - /* Initialized data */ - - static integer size = 0; - static logical first = TRUE_; - static char months[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" - "AUG" "SEP" "OCT" "NOV" "DEC"; - - /* System generated locals */ - integer i__1, i__2, i__3; - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - static integer case__, begs[32], kind, nsec, ends[32]; - static logical ampm; - static integer nday, item, from; - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - static integer last, nmin, nmon; - static char this__[1]; - static integer ndoy, next; - extern integer posr_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char * - , char *, ftnlen, ftnlen, ftnlen); - static integer f[95]; - extern /* Subroutine */ int zzinssub_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer i__, j, k, l[95]; - static logical check; - static integer r__, blank, w, nchar; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char recog[12*70]; - static integer pbegs[32]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static char names[32*95], class__[1*70]; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - static integer pends[32], value; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer nyear, width[70]; - static char wkday[12*3*2]; - static integer pfrom; - static char mnmrk[12*3*2], month[3]; - static integer nhour; - extern integer rtrim_(char *, ftnlen); - static char myerr[160]; - static integer pnext, p1, p2; - extern /* Subroutine */ int lx4uns_(char *, integer *, integer *, integer - *, ftnlen); - static integer to; - extern logical samchi_(char *, integer *, char *, integer *, ftnlen, - ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char spcial[12]; - extern logical samsbi_(char *, integer *, integer *, char *, integer *, - integer *, ftnlen, ftnlen); - static char messge[160]; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen), sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen); - static char pictur[160]; - static integer mnsize[2]; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static integer wksize[2]; - extern /* Subroutine */ int zzmkpc_(char *, integer *, integer *, char *, - char *, ftnlen, ftnlen, ftnlen); - static logical did; - static integer njd, get; - static char rep[32]; - static doublereal hms[3]; - static logical got; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - static integer pto, ptr, put; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is an umbrella routine for a collection of entry points */ -/* to the time parsing utility functions. */ - -/* $ 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 */ - -/* TIME --- Private */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry Points */ -/* -------- --- -------------------------------------------------- */ -/* STRING I/O ZZUNPCK ZZCMBT ZZGREP ZZISPT ZZSUBT ZZTOKNS ZZVALT */ -/* TRANSL I ZZUNPCK ZZSUBT */ -/* LETTER I ZZCMBT ZZIST ZZNOTE ZZREMT ZZVALT */ -/* ERROR O ZZUNPCK ZZTOKNS */ -/* TVEC O ZZUNPCK */ -/* B O ZZISPT ZZNOTE ZZVALT */ -/* E O ZZISPT ZZNOTE ZZUNPCK ZZVALT */ -/* L2R I ZZCMBT ZZSUBT */ -/* YABBRV I ZZUNPCK */ - -/* $ Detailed_Input */ - -/* See Individual Entry Points. */ - -/* $ Detailed_Output */ - -/* See Individual Entry Points. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If ZZTIME is called directly the error 'SPICE(BOGUSENTRY)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as an umbrella for a collection of */ -/* related entry points that are used to parse time strings. */ - -/* Normal usage is to first call ZZTOKNS to create an internal */ -/* representation for a time string. This internal representations */ -/* maintains a list of identified substrings from the original */ -/* input time string. For example the call to ZZTOKNS using */ -/* the string */ - -/* '1996 JAN 25 12:18:19.199' */ -/* 123456789012345678901234 */ - -/* yields the following internal representation: */ - -/* 'ibmbibi:i:i.i' */ - -/* where the individual tokens correspond to the substrings */ -/* indicated in the following table: */ - -/* Identifier Substring meaning */ -/* ---------- ------------- ---------------- */ -/* i from 01 to 04 unsigned integer */ -/* b from 05 to 05 blanks or tab */ -/* m from 06 to 08 month */ -/* b from 09 to 09 blanks or tab */ -/* i from 10 to 11 unsigned integer */ -/* b from 12 to 12 blank or tab */ -/* i from 13 to 14 unsigned integer */ -/* : from 15 to 15 colon */ -/* i from 16 to 17 unsigned integer */ -/* : from 18 to 18 colon */ -/* i from 19 to 20 unsigned integer */ -/* . from 21 to 21 decimal point */ -/* i from 22 to 24 unsigned integer */ - -/* These substrings may be combined and reidentified, removed */ -/* or re-identified using the various entry points listed here: */ - -/* ZZCMBT combine several tokens into a single token */ -/* for example you might scan right to left and replace */ -/* the token sequence i.i by n (for number). In this */ -/* case the substring boundaries of n would be from 19 */ -/* to 24. */ - -/* ZZGREP returns the current internal representation */ -/* in the case above 'ibmbibi:i:i.i' */ - - -/* ZZISPT returns TRUE if a pair of letters from a list are */ -/* present in the internal representation. This is */ -/* used primarily to detect erroneous substrings such */ -/* as ',,' or ':,' */ - -/* ZZIST Return TRUE if a particular letter is present in the */ -/* string. */ - -/* ZZNOTE Returns the substring boundaries associated with */ -/* a letter and removes the letter from the internal */ -/* representation. This is used primarily for calendar */ -/* string modifiers such as 'B.C.', 'A.D.' etc. */ - -/* ZZREMT remove a letter from the internal representation. */ -/* In the input example you might remove all white space */ -/* markers. */ - -/* ZZSUBT substitute a different letter for one listed in the */ -/* input one for one. For example after removing blanks */ -/* you might substitute YmD for imi. */ - - -/* ZZVALT replace an integer by a new marker if the integer */ -/* lies withing a particular range. For example */ -/* you might replace any integer between 1000 and 10000 */ -/* by Y (for year). */ - -/* Once all substitutions and removals have been performed that */ -/* can be made, the entry point ZZUNPCK allows you to extract */ -/* year(Y), month(m), day or month(D), day of year (y), hours(H), */ -/* minutes(M) and seconds(S) from the input string */ - -/* $ Examples */ - -/* See TPARTV. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.0, 08-MAR-2009 (NJB) */ - -/* Bug fix: in entry point ZZTOKNS, changed upper */ -/* bound used to detect non-printing characters from 128 */ -/* to 126. */ - -/* Bug fix: added error handling to this routine. Header */ -/* already referred to SPICE(BOGUSENTRY) error, but no */ -/* such error was signaled. */ - -/* Changed upper bound of arrays NAMES, F, and L from 128 */ -/* to 126. */ - -/* Re-ordered header sections in various entry points. */ - -/* - SPICELIB Version 1.4.0, 27-OCT-2006 (BVS) */ - -/* Fixed the bug in the ZZTOKNS entry that in the case of a one */ -/* character long blank input time string caused the TO variable */ -/* be set to the value greater than the string length, triggering */ -/* an OUT OF BOUNDS runtime error on HP. Added to ZZTOKNS a */ -/* separate check for the blank input strings. */ - -/* - SPICELIB Version 1.3.0, 13-Nov-2000 (WLT) */ - -/* Changed the call to EQSTR to a call to SAMSBI so as to */ -/* guard against overflowing strings. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 8-APR-1996 (WLT) */ - - -/* -& */ - -/* Entry points */ - - -/* Spicelib Functions */ - - -/* Standard Parameters */ - - -/* LOWER */ -/* UPPER */ -/* MIXED */ - - -/* FULL */ -/* SHORT */ - - -/* Representation Variables. */ - - -/* Token Recognition Variables. */ - -/* At the moment there are 53 recognized substrings, we */ -/* make room for 70 just so we won't have to increase */ -/* the parameter NRECOG soon. */ - - /* Parameter adjustments */ - if (tvec) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_zzcmbt; - case 2: goto L_zzgrep; - case 3: goto L_zzispt; - case 4: goto L_zzist; - case 5: goto L_zznote; - case 6: goto L_zzremt; - case 7: goto L_zzsubt; - case 8: goto L_zztokns; - case 9: goto L_zzunpck; - case 10: goto L_zzvalt; - } - - ret_val = FALSE_; - chkin_("ZZTIME", (ftnlen)6); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("ZZTIME", (ftnlen)6); - return ret_val; -/* $Procedure ZZCMBT ( Private --- combine tokens ) */ - -L_zzcmbt: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Combine several token representatives into a single token. */ - -/* $ 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 */ - -/* TIME --- PRIVATE */ - - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ -/* CHARACTER*(1) LETTER */ -/* LOGICAL L2R */ - -/* $ Brief_I/O */ -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A sequence of tokens to be combined. */ -/* LETTER I The replacement token for the combination */ -/* L2R I If TRUE scan left to right, else scan right to left */ - -/* The function returns TRUE is a combination was performed. */ - -/* $ Detailed_Input */ - -/* STRING is a sequence of tokens to look for in the */ -/* stored internal representation. */ - -/* LETTER is the replacement token to insert for STRING. */ - -/* If letter is a blank, the combination is simply */ -/* replaced by a blank. */ - -/* L2R is a logical. If TRUE, the internal representation */ -/* is scanned left to right. If FALSE, the internal */ -/* representation is scanned right to left. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if a combination is performed. */ -/* Otherwise it returns FALSE. */ - -/* Note that the most important action of this function is a */ -/* side-effect. The internal representation of a time string */ -/* is modified to reflect the requested token combination. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function allows you to alter the internal representation */ -/* of a time string by combining two or more tokens into a single */ -/* token. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - -/* So far we haven't combined anything. */ - - did = FALSE_; - -/* Look for the substring either looking from the */ -/* left (L2R is YES) or from the right (L2R is NO). */ - - if (*l2r) { - from = pos_(rep, string, &c__1, size, string_len); - } else { - from = posr_(rep, string, &size, size, string_len); - } - to = from + i_len(string, string_len) - 1; - if (from > 0) { - did = TRUE_; - ends[(i__1 = from - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", i__1, - "zztime_", (ftnlen)582)] = ends[(i__2 = to - 1) < 32 && 0 <= - i__2 ? i__2 : s_rnge("ends", i__2, "zztime_", (ftnlen)582)]; - pends[(i__1 = from - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pends", - i__1, "zztime_", (ftnlen)583)] = pends[(i__2 = to - 1) < 32 && - 0 <= i__2 ? i__2 : s_rnge("pends", i__2, "zztime_", (ftnlen) - 583)]; - put = from + 1; - next = to + 1; - -/* Perform the substitution in the representation */ - - zzrepsub_(rep, &from, &to, letter, rep, (ftnlen)32, (ftnlen)1, ( - ftnlen)32); - -/* Now update the begins and ends of tokens in the original */ -/* string. */ - - i__1 = size; - for (get = next; get <= i__1; ++get) { - begs[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("begs", - i__2, "zztime_", (ftnlen)597)] = begs[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("begs", i__3, "zztime_", ( - ftnlen)597)]; - ends[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("ends", - i__2, "zztime_", (ftnlen)598)] = ends[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("ends", i__3, "zztime_", ( - ftnlen)598)]; - pbegs[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pbegs", - i__2, "zztime_", (ftnlen)599)] = pbegs[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("pbegs", i__3, "zztime_", - (ftnlen)599)]; - pends[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)600)] = pends[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("pends", i__3, "zztime_", - (ftnlen)600)]; - ++put; - } - size = size - i_len(string, string_len) + 1; - } - ret_val = did; - return ret_val; -/* $Procedure ZZGREP ( Private --- get representation ) */ - -L_zzgrep: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the internal representation of the time 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 */ - -/* TIME --- PRIVATE */ - - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING O The current representation of tokenized time */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* STRING is the current internal tokenized representation of */ -/* the time string that was last supplied to ZZTIME */ -/* via the entry point ZZTOKNS. */ - -/* The function returns TRUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This returns the current internal representation of the */ -/* tokenized time string. The function always returns the */ -/* value TRUE. */ - -/* $ Examples */ - -/* See TPARTV. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - s_copy(string, rep, string_len, (max(1,size))); - ret_val = TRUE_; - return ret_val; -/* $Procedure ZZISPT ( Private --- is pair of tokens ) */ - -L_zzispt: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine if there is a pair of consecutive tokens from */ -/* a user specified list of tokens. */ - -/* $ 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 */ - -/* TIME --- PRIVATE */ - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ -/* INTEGER B */ -/* INTEGER E */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I a list of tokens to search for. */ -/* B O the beginning of the first matching token */ -/* E O the ending of the last matching token. */ - -/* The function returns TRUE if a pair is found. */ - -/* $ Detailed_Input */ - -/* STRING is a character string that gives a list of tokens */ -/* to search for in a string. */ - -/* $ Detailed_Output */ - -/* B is the location in the original time string supplied */ -/* to ZZTOKNS of the beginning a pair of consecutive */ -/* tokens from the list specified by STRING. */ - -/* E is the location in the original time string supplied */ -/* to ZZTOKENS of the end a pair of consecutive */ -/* tokens from the list specified by STRING. */ - -/* The function returns the TRUE is a consecutive pair of tokens */ -/* from STRING is located. Otherwise it returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine exists primarily to assist in the diagnosis */ -/* of consecutive delimiters in a time string. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - did = FALSE_; - from = cpos_(rep, string, &c__1, (ftnlen)32, string_len); - while(from > 0) { - if (from < size) { - to = from + 1; - did = i_indx(string, rep + (to - 1), string_len, (ftnlen)1) > 0; - } else { - *b = 0; - *e = 0; - ret_val = FALSE_; - return ret_val; - } - if (did) { - *b = begs[(i__1 = from - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "begs", i__1, "zztime_", (ftnlen)896)]; - *e = ends[(i__1 = to - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends" - , i__1, "zztime_", (ftnlen)897)]; - ret_val = TRUE_; - return ret_val; - } - from = cpos_(rep, string, &to, (ftnlen)32, string_len); - } - *b = 0; - *e = 0; - ret_val = FALSE_; - return ret_val; -/* $Procedure ZZIST ( Private --- is there a token ) */ - -L_zzist: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine if a token is present in the internal representation */ -/* of a tokenized time 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 */ - -/* TIME --- PRIVATE */ - - -/* $ Declarations */ - -/* CHARACTER*(1) LETTER */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LETTER I */ - -/* The function returns */ - -/* $ Detailed_Input */ - -/* LETTER is a token to look for in the tokenized representation */ -/* of a time string. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE is LETTER is present in the internal */ -/* representation of the last time string passed to ZZTOKNS. */ -/* Otherwise it returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine determines whether or not a particular token */ -/* is present in a tokenized representation of a time. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - ret_val = i_indx(rep, letter, size, (ftnlen)1) > 0; - return ret_val; -/* $Procedure ZZNOTE ( Private --- note the existence and remove ) */ - -L_zznote: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the beginning and ending of a token in a time string */ -/* and remove the token from the internal representation. */ - -/* $ 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 */ - -/* TIME --- PRIVATE */ - -/* $ Declarations */ - -/* CHARACTER*(1) LETTER */ -/* INTEGER B */ -/* INTEGER E */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LETTER I a token to look for in the internal representation */ -/* B O is the beginning of the token */ -/* E O is the end of the token. */ - -/* The function returns TRUE if the token is located. */ - -/* $ Detailed_Input */ - -/* LETTER is a token to look for and remove from the */ -/* current tokenization of a time string. */ - -/* If located the token is removed from the string. */ - -/* Note that this simply finds the first matching */ -/* token. If others are present they are not */ -/* affected. */ - -/* $ Detailed_Output */ - -/* B is the beginning of the requested token if it */ -/* was found. Otherwise B is zero. */ - -/* E is the ending of the requested token if it was */ -/* found. Otherwise E is zero. */ - -/* The function returns the value TRUE if the token is located. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Look up and remove a token from the internal representation */ -/* of a time string. This is useful in removing modifiers */ -/* from a string (such as the ERA of an epoch, AM/PM of a time */ -/* etc.) */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - put = i_indx(rep, letter, (ftnlen)32, (ftnlen)1); - if (put > 0) { - *b = begs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)1185)]; - *e = ends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)1186)]; - next = put + 1; - i__1 = size; - for (get = next; get <= i__1; ++get) { - begs[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("begs", - i__2, "zztime_", (ftnlen)1192)] = begs[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("begs", i__3, "zztime_", ( - ftnlen)1192)]; - ends[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("ends", - i__2, "zztime_", (ftnlen)1193)] = ends[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("ends", i__3, "zztime_", ( - ftnlen)1193)]; - pbegs[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pbegs", - i__2, "zztime_", (ftnlen)1194)] = pbegs[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("pbegs", i__3, "zztime_", - (ftnlen)1194)]; - pends[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)1195)] = pends[(i__3 = get - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("pends", i__3, "zztime_", - (ftnlen)1195)]; - *(unsigned char *)&rep[put - 1] = *(unsigned char *)&rep[get - 1]; - ++put; - } - s_copy(rep + (size - 1), " ", 32 - (size - 1), (ftnlen)1); - --size; - did = TRUE_; - } else { - *b = 0; - *e = 0; - did = FALSE_; - } - ret_val = did; - return ret_val; -/* $Procedure ZZREMT ( Private --- remove token ) */ - -L_zzremt: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Remove a specified token from the internal representation */ - -/* $ 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 */ - -/* TIME --- Private */ - - -/* $ Declarations */ - -/* CHARACTER*(1) LETTER */ - -/* $ Brief_I/O */ -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LETTER I token to remove from the internal representation. */ - -/* The function returns TRUE if any tokens are removed. */ - -/* $ Detailed_Input */ - -/* LETTER is a token to be removed from the internal */ -/* representation of a tokenized time string. */ -/* All instances of LETTER will be removed from */ -/* the internal representation. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if any instance of LETTER is removed */ -/* from the internal representation of a tokenized time string. */ -/* If no instances are removed the function returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is used to remove various delimiters that */ -/* appear in a tokenized time string (although it could be */ -/* used to remove any token from a tokenized time string). */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - put = 0; - did = FALSE_; - i__1 = size; - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&rep[i__ - 1] != *(unsigned char *)letter) { - ++put; - *(unsigned char *)&rep[put - 1] = *(unsigned char *)&rep[i__ - 1]; - begs[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("begs", - i__2, "zztime_", (ftnlen)1350)] = begs[(i__3 = i__ - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("begs", i__3, "zztime_", ( - ftnlen)1350)]; - ends[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("ends", - i__2, "zztime_", (ftnlen)1351)] = ends[(i__3 = i__ - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("ends", i__3, "zztime_", ( - ftnlen)1351)]; - pbegs[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pbegs", - i__2, "zztime_", (ftnlen)1352)] = pbegs[(i__3 = i__ - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("pbegs", i__3, "zztime_", - (ftnlen)1352)]; - pends[(i__2 = put - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)1353)] = pends[(i__3 = i__ - 1) < - 32 && 0 <= i__3 ? i__3 : s_rnge("pends", i__3, "zztime_", - (ftnlen)1353)]; - } else { - did = TRUE_; - } - } - size = put; - if (put == 0) { - s_copy(rep, " ", (ftnlen)32, (ftnlen)1); - } else if (put < i_len(rep, (ftnlen)32)) { - i__1 = put; - s_copy(rep + i__1, " ", 32 - i__1, (ftnlen)1); - } - ret_val = did; - return ret_val; -/* $Procedure ZZSUBT ( Private --- substitute tokens ) */ - -L_zzsubt: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Substitute one token for another in the internal representation */ -/* of a tokenized time 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 */ - -/* TIME --- Private */ - - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) STRING */ -/* CHARACTER*(*) TRANSL */ -/* LOGICAL L2R */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I token pattern to look for. */ -/* TRANSL I token replacement pattern. */ -/* L2R I direction to scan internal representation. */ - -/* The function returns TRUE is a substitution is performed. */ - -/* $ Detailed_Input */ - -/* STRING is a string of tokens to look for in the internal */ -/* representation of a tokenized time string. */ - -/* Only the first occurrence of STRING will be modified. */ - -/* If the first character in STRING is '<', (and string */ -/* is more than 1 character in length) substitutions */ -/* will be performed in the4 tokenized string only if */ -/* STRING exactly matches the tokenized string */ -/* starting at the left most character. */ - -/* If the last character in STRING is '>' (and string */ -/* is more than 1 character in length) substitutions */ -/* will be performed in the4 tokenized string only if */ -/* STRING exactly matches the tokenized string */ -/* ending at the right most character. */ - -/* If first and last character of STRING are '<' and '>' */ -/* respectively, the first case above is applied and the */ -/* greater than character ('>') is regarded as just */ -/* another character. */ - -/* TRANSL is a sequence of replacement tokens to substitute */ -/* in place of STRING. */ - -/* L2R is a logical flag. If L2R is TRUE, the internal */ -/* representation is scanned from left to right. If */ -/* L2R is FALSE, the internal representation is scanned */ -/* from right to left. */ - -/* $ Detailed_Output */ - -/* The function returns TRUE if a substitution is performed. */ -/* Otherwise it returns FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine searchs for the first instance of a specified */ -/* pattern in the internal representation of a tokenized */ -/* time string. If the pattern is found, it is replaced */ -/* by that value of TRANSL. Only one pattern substitution */ -/* is performed per call to this function. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - -/* So far we haven't combined anything. */ - - did = FALSE_; - k = i_len(string, string_len); - -/* We have two special cases to deal with. */ - - if (*(unsigned char *)string == '<' && k > 1) { -/* Computing MIN */ - i__1 = k - 1; - to = min(i__1,size); - from = 1; - if (s_cmp(string + 1, rep + (from - 1), k - 1, to - (from - 1)) == 0) - { - s_copy(rep + (from - 1), transl, to - (from - 1), transl_len); - ret_val = TRUE_; - } else { - ret_val = FALSE_; - } - return ret_val; - } else if (*(unsigned char *)&string[k - 1] == '>' && k > 1) { -/* Computing MAX */ - i__1 = 1, i__2 = size - k + 2; - from = max(i__1,i__2); - to = size; - if (s_cmp(string, rep + (from - 1), k - 1, to - (from - 1)) == 0) { - s_copy(rep + (from - 1), transl, to - (from - 1), transl_len); - ret_val = TRUE_; - } else { - ret_val = FALSE_; - } - return ret_val; - } - -/* Look for the substring either looking from the */ -/* left (L2R is YES) or from the right (L2R is NO). */ - - if (*l2r) { - from = pos_(rep, string, &c__1, (ftnlen)32, string_len); - } else { - from = posr_(rep, string, &size, (ftnlen)32, string_len); - } - to = from + i_len(transl, transl_len) - 1; - if (from > 0) { - did = TRUE_; - s_copy(rep + (from - 1), transl, to - (from - 1), transl_len); - } - ret_val = did; - return ret_val; -/* $Procedure ZZTOKNS ( Private --- Time Tokens ) */ - -L_zztokns: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Construct an internal tokenized representation of 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 */ - -/* TIME --- PRIVATE */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) STRING */ -/* CHARACTER*(*) ERROR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A time string to be tokenized and internalized. */ -/* ERROR O A diagnostic message */ - -/* The function returns TRUE is STRING can be tokenized. */ - -/* $ Detailed_Input */ - -/* STRING is a string that is intended to represent some */ -/* epoch and that needs parsing. */ - -/* $ Detailed_Output */ - -/* ERROR is a diagnostic message that is returned if a */ -/* problem occurs while trying to tokenize the */ -/* input time string. If no problems arise, ERROR */ -/* will be returned as a blank. */ - -/* The function returns TRUE if the input string can be successfully */ -/* tokenized. If a problem arises, the function returns FALSE */ -/* and diagnostic is returned in ERROR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is the first step in parsing a time string. The */ -/* string is examined for integers, month, weekdays, time systems */ -/* time zones, eras, am/pm and various separators. This */ -/* representation is maintained and manipulated by the */ -/* companion entry points in ZZTIME. */ - -/* The various recognized tokens represented by this routine */ -/* are: */ - -/* ' --- the quote character (year abbreviation) */ -/* , --- a comma (delimiter) */ -/* - --- a dash (delimiter) */ -/* . --- a period (delimiter) */ -/* / --- a slash (delimiter) */ -/* : --- a colon (delimiter) */ -/* N --- AM/PM marker */ -/* O --- UTC+ marker */ -/* Z --- US Time Zone Marker */ -/* [ --- left parenthesis marker */ -/* ] --- right parenthesis marker */ -/* b --- stands for blanks, or tabs (delimiter) */ -/* d --- day of year marker (delimiter) */ -/* e --- era marker */ -/* j --- julian date system marker */ -/* m --- month marker */ -/* o --- UTC- marker */ -/* s --- time system marker */ -/* t --- the "T" marker used in ISO formats. */ -/* w --- the weekday marker */ -/* i --- unsigned integer marker */ - -/* Using the other entry points in ZZTIME, these markers are */ -/* gradually removed and transformed to more meaningful markers. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.5.0, 08-MAR-2009 (NJB) */ - -/* Bug fix: changed upper bound used to detect */ -/* non-printing characters from 128 to 126. */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.3.0, 27-OCT-2006 (BVS) */ - -/* Fixed the bug that in the case of a one character long blank */ -/* input time string caused the TO variable be set to the value */ -/* greater than the string length, triggering an OUT OF BOUNDS */ -/* runtime error on HP. Added a separate up-front check for the */ -/* blank input string. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - -/* The first time in this routine we initialize our "tokenizing" */ -/* table. */ - - if (first) { - first = FALSE_; - blank = ' '; - -/* Below is the list of recognized substrings. The basic */ -/* pattern here is to find the block of special tokens */ -/* that begin with a particular character. Insert into */ -/* that block the lines of code below */ - -/* I = I + 1 */ -/* F( ICHAR('letter')) = I */ -/* RECOG(I) = 'the full substring that's recognized ' */ -/* WIDTH(I) = number of characters required to match */ -/* CLASS(I) = 'the classification of this substring' */ -/* L( ICHAR('b')) = I */ - -/* Note matching is performed from the first string in the */ -/* group to the last. */ - - - for (i__ = 32; i__ <= 126; ++i__) { - f[(i__1 = i__ - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1800)] = 0; - l[(i__1 = i__ - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1801)] = -1; - s_copy(names + (((i__1 = i__ - 32) < 95 && 0 <= i__1 ? i__1 : - s_rnge("names", i__1, "zztime_", (ftnlen)1802)) << 5), - "substring", (ftnlen)32, (ftnlen)9); - } - s_copy(names + (((i__1 = '\'' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1806)) << 5), "\"Year Abbr" - "eviation Mark\"", (ftnlen)32, (ftnlen)24); - s_copy(names + (((i__1 = ',' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1807)) << 5), "comma", ( - ftnlen)32, (ftnlen)5); - s_copy(names + (((i__1 = '-' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1808)) << 5), "dash", ( - ftnlen)32, (ftnlen)4); - s_copy(names + (((i__1 = '.' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1809)) << 5), "period", ( - ftnlen)32, (ftnlen)6); - s_copy(names + (((i__1 = '/' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1810)) << 5), "slash", ( - ftnlen)32, (ftnlen)5); - s_copy(names + (((i__1 = ':' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1811)) << 5), "colon", ( - ftnlen)32, (ftnlen)5); - s_copy(names + (((i__1 = 'D' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1812)) << 5), "Day of Month" - , (ftnlen)32, (ftnlen)12); - s_copy(names + (((i__1 = 'H' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1813)) << 5), "Hour", ( - ftnlen)32, (ftnlen)4); - s_copy(names + (((i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1814)) << 5), "Minute", ( - ftnlen)32, (ftnlen)6); - s_copy(names + (((i__1 = 'N' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1815)) << 5), "AM/PM indic" - "ator", (ftnlen)32, (ftnlen)15); - s_copy(names + (((i__1 = 'O' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1816)) << 5), "UTC-Offset " - "indicator", (ftnlen)32, (ftnlen)20); - s_copy(names + (((i__1 = 'S' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1817)) << 5), "Second", ( - ftnlen)32, (ftnlen)6); - s_copy(names + (((i__1 = 'Y' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1818)) << 5), "Year", ( - ftnlen)32, (ftnlen)4); - s_copy(names + (((i__1 = 'Z' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1819)) << 5), "Time-Zone i" - "ndicator", (ftnlen)32, (ftnlen)19); - s_copy(names + (((i__1 = '[' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1820)) << 5), "Left Parent" - "hesis", (ftnlen)32, (ftnlen)16); - s_copy(names + (((i__1 = ']' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1821)) << 5), "Right Paren" - "thesis", (ftnlen)32, (ftnlen)17); - s_copy(names + (((i__1 = 'b' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1822)) << 5), "White Space", - (ftnlen)32, (ftnlen)11); - s_copy(names + (((i__1 = 'd' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1823)) << 5), "Day-of-Year" - " indicator", (ftnlen)32, (ftnlen)21); - s_copy(names + (((i__1 = 'e' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1824)) << 5), "Era", ( - ftnlen)32, (ftnlen)3); - s_copy(names + (((i__1 = 'i' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1825)) << 5), "Integer", ( - ftnlen)32, (ftnlen)7); - s_copy(names + (((i__1 = 'j' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1826)) << 5), "Julian Date" - " indicator", (ftnlen)32, (ftnlen)21); - s_copy(names + (((i__1 = 'm' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1827)) << 5), "Month", ( - ftnlen)32, (ftnlen)5); - s_copy(names + (((i__1 = 'n' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1828)) << 5), "Decimal Num" - "ber", (ftnlen)32, (ftnlen)14); - s_copy(names + (((i__1 = 'o' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1829)) << 5), "UTC-Offset " - "indicator", (ftnlen)32, (ftnlen)20); - s_copy(names + (((i__1 = 's' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1830)) << 5), "Time System" - " specification", (ftnlen)32, (ftnlen)25); - s_copy(names + (((i__1 = 't' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1831)) << 5), "ISO Time Se" - "parator", (ftnlen)32, (ftnlen)18); - s_copy(names + (((i__1 = 'w' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1832)) << 5), "Weekday", ( - ftnlen)32, (ftnlen)7); - s_copy(names + (((i__1 = 'y' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "zztime_", (ftnlen)1833)) << 5), "Day of Year", - (ftnlen)32, (ftnlen)11); - s_copy(mnmrk, "month", (ftnlen)12, (ftnlen)5); - s_copy(mnmrk + 12, "MONTH", (ftnlen)12, (ftnlen)5); - s_copy(mnmrk + 24, "Month", (ftnlen)12, (ftnlen)5); - s_copy(mnmrk + 36, "mon", (ftnlen)12, (ftnlen)3); - s_copy(mnmrk + 48, "MON", (ftnlen)12, (ftnlen)3); - s_copy(mnmrk + 60, "Mon", (ftnlen)12, (ftnlen)3); - s_copy(wkday, "weekday", (ftnlen)12, (ftnlen)7); - s_copy(wkday + 12, "WEEKDAY", (ftnlen)12, (ftnlen)7); - s_copy(wkday + 24, "Weekday", (ftnlen)12, (ftnlen)7); - s_copy(wkday + 36, "wkd", (ftnlen)12, (ftnlen)3); - s_copy(wkday + 48, "WKD", (ftnlen)12, (ftnlen)3); - s_copy(wkday + 60, "Wkd", (ftnlen)12, (ftnlen)3); - -/* Length of the items Month, Mon, weekday, wkd */ - - wksize[0] = 7; - wksize[1] = 3; - mnsize[0] = 5; - mnsize[1] = 3; - i__ = 0; - -/* Tokens beginning with ' ' */ - - ++i__; - f[(i__1 = ' ' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1861)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1862)) * 12, " ", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1863)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1864)] = 'b'; - l[(i__1 = ' ' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1865)] = i__; - -/* Tokens beginning with '(' */ - - ++i__; - f[(i__1 = '(' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1871)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1872)) * 12, "(", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1873)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1874)] = '['; - l[(i__1 = '(' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1875)] = i__; - -/* Tokens beginning with ')' */ - - ++i__; - f[(i__1 = ')' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1880)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1881)) * 12, ")", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1882)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1883)] = ']'; - l[(i__1 = ')' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1884)] = i__; - -/* Tokens beginning with ',' */ - - ++i__; - f[(i__1 = ',' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1889)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1890)) * 12, ",", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1891)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1892)] = ','; - l[(i__1 = ',' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1893)] = i__; - -/* Tokens beginning with '-' */ - - ++i__; - f[(i__1 = '-' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1899)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1900)) * 12, "-", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1901)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1902)] = '-'; - l[(i__1 = '-' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1903)] = i__; - -/* Tokens beginning with '.' */ - - ++i__; - f[(i__1 = '.' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1909)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1910)) * 12, ".", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1911)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1912)] = '.'; - l[(i__1 = '.' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1913)] = i__; - -/* Tokens beginning with '/' */ - - ++i__; - f[(i__1 = '/' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1919)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1920)) * 12, "//", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1921)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1922)] = 'd'; - l[(i__1 = '/' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1923)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1926)) * 12, "/", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1927)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1928)] = '/'; - l[(i__1 = '/' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1929)] = i__; - -/* Tokens beginning with ':' */ - - ++i__; - f[(i__1 = ':' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1934)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1935)) * 12, "::", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1936)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1937)] = 'd'; - l[(i__1 = ':' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1938)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1941)) * 12, ":", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1942)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1943)] = ':'; - l[(i__1 = ':' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1944)] = i__; - -/* Tokens beginning with 'A' */ - - ++i__; - f[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1950)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1951)) * 12, "A.D.", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1952)] = 4; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1953)] = 'e'; - l[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1954)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1957)) * 12, "AD", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1958)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1959)] = 'e'; - l[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1960)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1963)) * 12, "A.M.", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1964)] = 4; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1965)] = 'N'; - l[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1966)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1969)) * 12, "AM", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1970)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1971)] = 'N'; - l[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1972)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1975)) * 12, "APRIL", ( - ftnlen)12, (ftnlen)5); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1976)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1977)] = 'm'; - l[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1978)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1981)) * 12, "AUGUST", ( - ftnlen)12, (ftnlen)6); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1982)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1983)] = 'm'; - l[(i__1 = 'A' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1984)] = i__; - -/* Tokens beginning with 'B' */ - - ++i__; - f[(i__1 = 'B' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)1990)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1991)) * 12, "B.C.", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1992)] = 4; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1993)] = 'e'; - l[(i__1 = 'B' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)1994)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)1997)) * 12, "BC", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)1998)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)1999)] = 'e'; - l[(i__1 = 'B' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2000)] = i__; - -/* Tokens beginning with 'C' */ - - ++i__; - f[(i__1 = 'C' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2006)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2007)) * 12, "CDT", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2008)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2009)] = 'Z'; - l[(i__1 = 'C' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2010)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2013)) * 12, "CST", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2014)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2015)] = 'Z'; - l[(i__1 = 'C' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2016)] = i__; - -/* Tokens beginning with 'D' */ - - ++i__; - f[(i__1 = 'D' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2022)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2023)) * 12, "DECEMBER", ( - ftnlen)12, (ftnlen)8); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2024)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2025)] = 'm'; - l[(i__1 = 'D' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2026)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2029)) * 12, "D+", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2030)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2031)] = 'E'; - l[(i__1 = 'D' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2032)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2035)) * 12, "D-", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2036)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2037)] = 'E'; - l[(i__1 = 'D' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2038)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2041)) * 12, "D", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2042)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2043)] = 'E'; - l[(i__1 = 'D' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2044)] = i__; - -/* Tokens beginning with 'E' */ - - ++i__; - f[(i__1 = 'E' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2053)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2054)) * 12, "EDT", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2055)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2056)] = 'Z'; - l[(i__1 = 'E' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2057)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2060)) * 12, "EST", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2061)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2062)] = 'Z'; - l[(i__1 = 'E' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2063)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2066)) * 12, "E+", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2067)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2068)] = 'E'; - l[(i__1 = 'E' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2069)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2072)) * 12, "E-", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2073)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2074)] = 'E'; - l[(i__1 = 'E' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2075)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2078)) * 12, "E", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2079)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2080)] = 'E'; - l[(i__1 = 'E' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2081)] = i__; - -/* Tokens beginning with 'F' */ - - ++i__; - f[(i__1 = 'F' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2088)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2089)) * 12, "FEBRUARY", ( - ftnlen)12, (ftnlen)8); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2090)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2091)] = 'm'; - l[(i__1 = 'F' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2092)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2095)) * 12, "FRIDAY", ( - ftnlen)12, (ftnlen)6); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2096)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2097)] = 'w'; - l[(i__1 = 'F' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2098)] = i__; - -/* Tokens beginning with 'J' */ - - ++i__; - f[(i__1 = 'J' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2104)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2105)) * 12, "JANUARY", ( - ftnlen)12, (ftnlen)7); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2106)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2107)] = 'm'; - l[(i__1 = 'J' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2108)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2111)) * 12, "JD", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2112)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2113)] = 'j'; - l[(i__1 = 'J' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2114)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2117)) * 12, "JULY", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2118)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2119)] = 'm'; - l[(i__1 = 'J' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2120)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2123)) * 12, "JUNE", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2124)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2125)] = 'm'; - l[(i__1 = 'J' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2126)] = i__; - -/* Tokens beginning with 'M' */ - - ++i__; - f[(i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2132)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2133)) * 12, "MARCH", ( - ftnlen)12, (ftnlen)5); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2134)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2135)] = 'm'; - l[(i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2136)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2139)) * 12, "MAY", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2140)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2141)] = 'm'; - l[(i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2142)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2145)) * 12, "MDT", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2146)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2147)] = 'Z'; - l[(i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2148)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2151)) * 12, "MONDAY", ( - ftnlen)12, (ftnlen)6); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2152)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2153)] = 'w'; - l[(i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2154)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2157)) * 12, "MST", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2158)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2159)] = 'Z'; - l[(i__1 = 'M' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2160)] = i__; - -/* Tokens beginning with 'N' */ - - ++i__; - f[(i__1 = 'N' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2166)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2167)) * 12, "NOVEMBER", ( - ftnlen)12, (ftnlen)8); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2168)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2169)] = 'm'; - l[(i__1 = 'N' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2170)] = i__; - -/* Tokens beginning with 'O' */ - - ++i__; - f[(i__1 = 'O' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2176)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2177)) * 12, "OCTOBER", ( - ftnlen)12, (ftnlen)7); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2178)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2179)] = 'm'; - l[(i__1 = 'O' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2180)] = i__; - -/* Tokens beginning with 'P' */ - - ++i__; - f[(i__1 = 'P' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2186)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2187)) * 12, "P.M.", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2188)] = 4; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2189)] = 'N'; - l[(i__1 = 'P' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2190)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2193)) * 12, "PDT", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2194)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2195)] = 'Z'; - l[(i__1 = 'P' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2196)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2199)) * 12, "PM", (ftnlen) - 12, (ftnlen)2); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2200)] = 2; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2201)] = 'N'; - l[(i__1 = 'P' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2202)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2205)) * 12, "PST", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2206)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2207)] = 'Z'; - l[(i__1 = 'P' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2208)] = i__; - -/* Tokens beginning with 'S' */ - - ++i__; - f[(i__1 = 'S' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2214)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2215)) * 12, "SATURDAY", ( - ftnlen)12, (ftnlen)8); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2216)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2217)] = 'w'; - l[(i__1 = 'S' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2218)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2221)) * 12, "SEPTEMBER", ( - ftnlen)12, (ftnlen)9); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2222)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2223)] = 'm'; - l[(i__1 = 'S' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2224)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2227)) * 12, "SUNDAY", ( - ftnlen)12, (ftnlen)6); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2228)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2229)] = 'w'; - l[(i__1 = 'S' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2230)] = i__; - -/* Tokens beginning with 'T' */ - - ++i__; - f[(i__1 = 'T' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2236)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2237)) * 12, "TDB", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2238)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2239)] = 's'; - l[(i__1 = 'T' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2240)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2243)) * 12, "TDT", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2244)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2245)] = 's'; - l[(i__1 = 'T' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2246)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2249)) * 12, "THURSDAY", ( - ftnlen)12, (ftnlen)8); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2250)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2251)] = 'w'; - l[(i__1 = 'T' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2252)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2255)) * 12, "TUESDAY", ( - ftnlen)12, (ftnlen)7); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2256)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2257)] = 'w'; - l[(i__1 = 'T' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2258)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2261)) * 12, "T", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2262)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2263)] = 't'; - l[(i__1 = 'T' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2264)] = i__; - -/* Tokens beginning with 'U' */ - - ++i__; - f[(i__1 = 'U' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2270)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2271)) * 12, "UTC+", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2272)] = 4; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2273)] = 'O'; - l[(i__1 = 'U' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2274)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2277)) * 12, "UTC-", ( - ftnlen)12, (ftnlen)4); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2278)] = 4; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2279)] = 'o'; - l[(i__1 = 'U' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2280)] = i__; - ++i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2283)) * 12, "UTC", (ftnlen) - 12, (ftnlen)3); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2284)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2285)] = 's'; - l[(i__1 = 'U' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2286)] = i__; - -/* Tokens beginning with '''' */ - - ++i__; - f[(i__1 = '\'' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2291)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2292)) * 12, "'", (ftnlen) - 12, (ftnlen)1); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2293)] = 1; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2294)] = '\''; - l[(i__1 = '\'' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2295)] = i__; - -/* Tokens beginning with 'W' */ - - ++i__; - f[(i__1 = 'W' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("f", i__1, - "zztime_", (ftnlen)2300)] = i__; - s_copy(recog + ((i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "recog", i__1, "zztime_", (ftnlen)2301)) * 12, "WEDNESDAY", ( - ftnlen)12, (ftnlen)9); - width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge("width", - i__1, "zztime_", (ftnlen)2302)] = 3; - *(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : - s_rnge("class", i__1, "zztime_", (ftnlen)2303)] = 'w'; - l[(i__1 = 'W' - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge("l", i__1, - "zztime_", (ftnlen)2304)] = i__; - } - -/* If the input string is blank, return with an error message. */ - - if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) { - s_copy(error, "The input time string is blank.", error_len, (ftnlen) - 31); - ret_val = FALSE_; - return ret_val; - } - -/* OK. Initializations are out of the way. We now take */ -/* apart the string. */ - - did = FALSE_; - s_copy(error, " ", error_len, (ftnlen)1); - s_copy(rep, " ", (ftnlen)32, (ftnlen)1); - s_copy(pictur, " ", (ftnlen)160, (ftnlen)1); - size = 0; - next = 1; - pnext = 1; - put = 0; - ampm = FALSE_; - last = rtrim_(string, string_len); - while(next <= last) { - -/* FROM and NEXT point to parts of the string, PFROM and PNEXT */ -/* point to parts of the picture we will construct. */ - - from = next; - pfrom = pnext; - item = *(unsigned char *)&string[next - 1]; - -/* First we try to find an unsigned integer in the string. */ - - lx4uns_(string, &from, &to, &nchar, last); - if (nchar > 0) { - -/* We found an unsigned integer, add a letter to the */ -/* internal representation, note the begin and end */ -/* of the token and set NEXT to the first character */ -/* beyond this token. */ - - ++put; - *(unsigned char *)&rep[put - 1] = 'i'; - begs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)2354)] = from; - ends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)2355)] = to; - next = to + 1; - pto = pfrom + nchar - 1; - pnext = pto + 1; - s_copy(pictur + (pfrom - 1), string + (from - 1), pto - (pfrom - - 1), to - (from - 1)); - pbegs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pbegs", - i__1, "zztime_", (ftnlen)2360)] = pfrom; - pends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pends", - i__1, "zztime_", (ftnlen)2361)] = pto; - } else if (item == blank) { - -/* We have a blank. We lump all consecutive */ -/* blanks together as one big fat blank. */ - - ++put; - to = from; - begs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)2370)] = from; - *(unsigned char *)&rep[put - 1] = 'b'; - while(item == blank && to <= last) { - ++to; - if (to <= last) { - item = *(unsigned char *)&string[to - 1]; - } - } - next = to; - --to; - ends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)2384)] = to; - pto = pfrom + to - from; - pnext = pto + 1; - s_copy(pictur + (pfrom - 1), string + (from - 1), pto - (pfrom - - 1), to - (from - 1)); - pbegs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pbegs", - i__1, "zztime_", (ftnlen)2389)] = pfrom; - pends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pends", - i__1, "zztime_", (ftnlen)2390)] = pto; - } else if (item == 9) { - -/* We've got a tab character, we treat tabs as */ -/* blanks. */ - - ++put; - *(unsigned char *)&rep[put - 1] = 'b'; - begs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)2399)] = from; - ends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)2400)] = from; - ++next; - pto = pfrom; - pnext = pto + 1; - s_copy(pictur + (pfrom - 1), " ", pto - (pfrom - 1), (ftnlen)1); - pbegs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pbegs", - i__1, "zztime_", (ftnlen)2406)] = pfrom; - pends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("pends", - i__1, "zztime_", (ftnlen)2407)] = pfrom; - } else if (item < 32 || item > 126) { - -/* This is a non-printing character. This is */ -/* regarded as an error. */ - - s_copy(error, string, error_len, string_len); - zzinssub_(error, "<", &next, error, error_len, (ftnlen)1, - error_len); - -/* Overwrite the non-printing character with a */ -/* closing angle bracket. */ - - if (next < i_len(error, error_len)) { - i__1 = next; - s_copy(error + i__1, ">", next + 1 - i__1, (ftnlen)1); - } - prefix_("There is a non-printing, non-tab character (ASCII #) at" - " position # of the time string: ", &c__1, error, (ftnlen) - 87, error_len); - repmi_(error, "#", &item, error, error_len, (ftnlen)1, error_len); - repmi_(error, "#", &next, error, error_len, (ftnlen)1, error_len); - ret_val = FALSE_; - return ret_val; - } else { - -/* This has to be one of the known types or we */ -/* have an unknown component in the string. We've constructed */ -/* a "parsing" table for handling these special cases. */ -/* This table uses the first letter of the string */ -/* to begin a search. We get that code and force it */ -/* into a suitable range. */ - - ucase_(string + (next - 1), this__, (ftnlen)1, (ftnlen)1); - item = *(unsigned char *)this__; - from = next; - check = TRUE_; - i__ = f[(i__1 = item - 32) < 95 && 0 <= i__1 ? i__1 : s_rnge( - "f", i__1, "zztime_", (ftnlen)2451)]; - while(check && i__ <= l[(i__1 = item - 32) < 95 && 0 <= i__1 ? - i__1 : s_rnge("l", i__1, "zztime_", (ftnlen)2453)]) { - w = width[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 : s_rnge( - "width", i__1, "zztime_", (ftnlen)2455)]; - to = from + w - 1; - got = samsbi_(string, &from, &to, recog + ((i__1 = i__ - 1) < - 70 && 0 <= i__1 ? i__1 : s_rnge("recog", i__1, "zzti" - "me_", (ftnlen)2458)) * 12, &c__1, &w, string_len, ( - ftnlen)12); - if (got) { - -/* We have a match. If it is the match of a month */ -/* or day of the week, we keep looking for the */ -/* end of the match. */ - - if (*(unsigned char *)&class__[(i__1 = i__ - 1) < 70 && 0 - <= i__1 ? i__1 : s_rnge("class", i__1, "zztime_", - (ftnlen)2466)] == 'm' || *(unsigned char *)& - class__[(i__2 = i__ - 1) < 70 && 0 <= i__2 ? i__2 - : s_rnge("class", i__2, "zztime_", (ftnlen)2466)] - == 'w') { - s_copy(spcial, recog + ((i__1 = i__ - 1) < 70 && 0 <= - i__1 ? i__1 : s_rnge("recog", i__1, "zztime_", - (ftnlen)2470)) * 12, (ftnlen)12, (ftnlen)12); - r__ = rtrim_(spcial, (ftnlen)12); - ++w; - ++to; - while(samchi_(string, &to, spcial, &w, string_len, - r__)) { - ++w; - ++to; - } - --to; - if (w > r__) { - kind = 1; - } else { - kind = 2; - } - if (*(unsigned char *)this__ != *(unsigned char *)& - string[next - 1]) { - case__ = 1; - } else if (s_cmp(string + (next - 1), spcial, (ftnlen) - 3, (ftnlen)3) == 0) { - case__ = 2; - } else { - case__ = 3; - } - if (*(unsigned char *)&class__[(i__1 = i__ - 1) < 70 - && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "zztime_", (ftnlen)2497)] == 'm') { - pto = pfrom + mnsize[(i__1 = kind - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("mnsize", i__1, - "zztime_", (ftnlen)2499)] - 1; - pnext = pto + 1; - s_copy(pictur + (pfrom - 1), mnmrk + ((i__1 = - case__ + kind * 3 - 4) < 6 && 0 <= i__1 ? - i__1 : s_rnge("mnmrk", i__1, "zztime_", ( - ftnlen)2501)) * 12, pto - (pfrom - 1), ( - ftnlen)12); - } else { - pto = pfrom + wksize[(i__1 = kind - 1) < 2 && 0 <= - i__1 ? i__1 : s_rnge("wksize", i__1, - "zztime_", (ftnlen)2505)] - 1; - pnext = pto + 1; - s_copy(pictur + (pfrom - 1), wkday + ((i__1 = - case__ + kind * 3 - 4) < 6 && 0 <= i__1 ? - i__1 : s_rnge("wkday", i__1, "zztime_", ( - ftnlen)2507)) * 12, pto - (pfrom - 1), ( - ftnlen)12); - } - } else if (*(unsigned char *)&class__[(i__1 = i__ - 1) < - 70 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "zztime_", (ftnlen)2511)] == 'e') { - pto = pfrom + 2; - pnext = pto + 1; - if (*(unsigned char *)&string[from - 1] == *(unsigned - char *)this__) { - s_copy(pictur + (pfrom - 1), "ERA", pto - (pfrom - - 1), (ftnlen)3); - } else { - s_copy(pictur + (pfrom - 1), "era", pto - (pfrom - - 1), (ftnlen)3); - } - } else if (*(unsigned char *)&class__[(i__1 = i__ - 1) < - 70 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "zztime_", (ftnlen)2522)] == 'N') { - pto = pfrom + 3; - pnext = pto + 1; - if (*(unsigned char *)&string[from - 1] == *(unsigned - char *)this__) { - s_copy(pictur + (pfrom - 1), "AMPM", pto - (pfrom - - 1), (ftnlen)4); - } else { - s_copy(pictur + (pfrom - 1), "ampm", pto - (pfrom - - 1), (ftnlen)4); - } - ampm = TRUE_; - } else { - pto = pfrom + to - from; - pnext = pto + 1; - s_copy(pictur + (pfrom - 1), string + (from - 1), pto - - (pfrom - 1), to - (from - 1)); - } - ++put; - *(unsigned char *)&rep[put - 1] = *(unsigned char *)& - class__[(i__1 = i__ - 1) < 70 && 0 <= i__1 ? i__1 - : s_rnge("class", i__1, "zztime_", (ftnlen)2543)]; - begs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "begs", i__1, "zztime_", (ftnlen)2544)] = from; - ends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "ends", i__1, "zztime_", (ftnlen)2545)] = to; - pbegs[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "pbegs", i__1, "zztime_", (ftnlen)2546)] = pfrom; - pends[(i__1 = put - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "pends", i__1, "zztime_", (ftnlen)2547)] = pto; - check = FALSE_; - next = to + 1; - } - ++i__; - } - -/* If we reach the end of the loop and CHECK is still */ -/* set to TRUE, we have a bit of unrecognizable string. */ - - if (check) { - s_copy(error, string, error_len, string_len); - i__1 = from + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, - error_len); - zzinssub_(error, "<", &from, error, error_len, (ftnlen)1, - error_len); - prefix_("The input string contains an unrecognizable substri" - "ng beginning at the character marked by <#>: \"", & - c__0, error, (ftnlen)97, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - repmc_(error, "#", string + (from - 1), error, error_len, ( - ftnlen)1, (ftnlen)1, error_len); - ret_val = FALSE_; - return ret_val; - } - } - } - size = put; - ret_val = TRUE_; - return ret_val; -/* $Procedure ZZUNPCK ( Private --- Unpack a time string ) */ - -L_zzunpck: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Unpack the time string and parse its components using the */ -/* stored internal representation. */ - -/* $ 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 */ - -/* TIME --- PRIVATE */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) STRING */ -/* LOGICAL YABBRV */ -/* DOUBLE PRECISION TVEC ( * ) */ -/* INTEGER E */ -/* CHARACTER*(*) TRANSL */ -/* CHARACTER*(*) ERROR */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I is a time string that has been tokenized. */ -/* YABBRV I has the year been abbreviated. */ -/* TVEC O is a vector of time components */ -/* E O is the actual number of components present */ -/* TRANSL O is the type TVEC ( YMD or YD ) */ -/* PIC O is a picture of the format used for the time string */ -/* ERROR O a diagnostic of any problems */ - -/* The function returns TRUE if the string was unpacked completely. */ - -/* $ Detailed_Input */ - -/* STRING is the original string from which the current */ -/* internal representation was derived. */ - -/* YABBRV is a logical that indicates whether or not an */ -/* abbreviated year was encountered in the string. */ -/* YABBRV is TRUE if such an abbreviation was present */ -/* otherwise it is FALSE. */ - -/* $ Detailed_Output */ - -/* TVEC is a double precision array of the parsed time */ -/* components. TVEC will have either 5 or 6 values */ -/* depending upon whether the string is Year, Month, */ -/* and Day of Month, or Year and Day of Year. */ - -/* E is the actual number of components that were */ -/* present in the internal representation. */ - -/* If STRING cannot be fully resolved, E is returned */ -/* as a zero. */ - -/* TRANSL is the type of time vector. The value will be */ -/* 'YD' (day of year) or 'YMD' (Year, Month, Day). */ - -/* If STRING cannot be fully resolved, TRANSL is */ -/* returned as a blank. */ - -/* PIC is a picture of the time format corresponding the */ -/* the time string in the last call to ZZTOKNS. */ - -/* If some part of the input string can't be identified */ -/* PIC is returned as a blank. Note that there is a */ -/* distinction between recognizable and parsable. */ -/* The input string must be unambiguous to be parsable, */ -/* However, even if a string is ambiguous it may */ -/* correspond to a legitimate format picture. Since */ -/* occasionally, that's what you want (an ambiguous */ -/* format), we allow it in PIC. */ - -/* ERROR is a diagnostic that indicates some problem in */ -/* resolving STRING. If no problems occur ERROR */ -/* is returned as a blank. */ - -/* The function returns TRUE if STRING was successfully unpacked. */ -/* That is the string is parsed and is unambiguously recognized. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is the last routine that will normally be */ -/* called by a time parsing routine. This call should be */ -/* made after all combinations, replacements and removals */ -/* that make sense to perform have been made. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - nyear = 0; - nmon = 0; - nday = 0; - nhour = 0; - nmin = 0; - nsec = 0; - ndoy = 0; - njd = 0; - *e = 0; - s_copy(transl, " ", transl_len, (ftnlen)1); - hms[0] = 0.; - hms[1] = 0.; - hms[2] = 0.; - for (i__ = size; i__ >= 1; --i__) { - item = *(unsigned char *)&rep[i__ - 1]; - j = begs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)2783)]; - k = ends[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)2784)]; - if (item == 'Y') { - ++nyear; - ++(*e); - nparsd_(string + (j - 1), tvec, error, &ptr, k - (j - 1), - error_len); - if (*yabbrv) { - zzrepsub_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? - i__1 : s_rnge("pbegs", i__1, "zztime_", (ftnlen)2793)] - , &pends[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("pends", i__2, "zztime_", (ftnlen)2793)], - "YR", pictur, (ftnlen)160, (ftnlen)2, (ftnlen)160); - } else { - zzrepsub_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? - i__1 : s_rnge("pbegs", i__1, "zztime_", (ftnlen)2796)] - , &pends[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("pends", i__2, "zztime_", (ftnlen)2796)], - "YYYY", pictur, (ftnlen)160, (ftnlen)4, (ftnlen)160); - } - } else if (item == 'm') { - ++nmon; - ++(*e); - ucase_(string + (j - 1), month, k - (j - 1), (ftnlen)3); - value = isrchc_(month, &c__12, months, (ftnlen)3, (ftnlen)3); - if (value == 0) { - nparsd_(string + (j - 1), &tvec[1], error, &ptr, k - (j - 1), - error_len); - zzrepsub_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? - i__1 : s_rnge("pbegs", i__1, "zztime_", (ftnlen)2810)] - , &pends[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("pends", i__2, "zztime_", (ftnlen)2810)], - "MM", pictur, (ftnlen)160, (ftnlen)2, (ftnlen)160); - } else { - tvec[1] = (doublereal) value; - } - } else if (item == 'D') { - ++nday; - ++(*e); - nparsd_(string + (j - 1), &tvec[2], error, &ptr, k - (j - 1), - error_len); - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pbegs", i__1, "zztime_", (ftnlen)2823)], &pends[( - i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)2823)], "DD", string + (j - 1), - (ftnlen)160, (ftnlen)2, k - (j - 1)); - } else if (item == 'y') { - ++ndoy; - ++(*e); - nparsd_(string + (j - 1), &tvec[1], error, &ptr, k - (j - 1), - error_len); - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pbegs", i__1, "zztime_", (ftnlen)2833)], &pends[( - i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)2833)], "DOY", string + (j - 1), - (ftnlen)160, (ftnlen)3, k - (j - 1)); - } else if (item == 'H') { - ++nhour; - ++(*e); - nparsd_(string + (j - 1), hms, error, &ptr, k - (j - 1), - error_len); - -/* We have to handle the hour component based on the */ -/* presence of the AM/PM mark in the picture. We earlier */ -/* set up the logical AMPM to indicate its presence. */ - - if (ampm) { - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? - i__1 : s_rnge("pbegs", i__1, "zztime_", (ftnlen)2849)] - , &pends[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("pends", i__2, "zztime_", (ftnlen)2849)], - "AP", string + (j - 1), (ftnlen)160, (ftnlen)2, k - ( - j - 1)); - } else { - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? - i__1 : s_rnge("pbegs", i__1, "zztime_", (ftnlen)2854)] - , &pends[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("pends", i__2, "zztime_", (ftnlen)2854)], - "HR", string + (j - 1), (ftnlen)160, (ftnlen)2, k - ( - j - 1)); - } - } else if (item == 'M') { - ++nmin; - ++(*e); - nparsd_(string + (j - 1), &hms[1], error, &ptr, k - (j - 1), - error_len); - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pbegs", i__1, "zztime_", (ftnlen)2866)], &pends[( - i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)2866)], "MN", string + (j - 1), - (ftnlen)160, (ftnlen)2, k - (j - 1)); - } else if (item == 'S') { - ++nsec; - ++(*e); - nparsd_(string + (j - 1), &hms[2], error, &ptr, k - (j - 1), - error_len); - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pbegs", i__1, "zztime_", (ftnlen)2876)], &pends[( - i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)2876)], "SC", string + (j - 1), - (ftnlen)160, (ftnlen)2, k - (j - 1)); - } else if (item == 'J') { - ++njd; - ++(*e); - nparsd_(string + (j - 1), tvec, error, &ptr, k - (j - 1), - error_len); - zzmkpc_(pictur, &pbegs[(i__1 = i__ - 1) < 32 && 0 <= i__1 ? i__1 : - s_rnge("pbegs", i__1, "zztime_", (ftnlen)2886)], &pends[( - i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("pends", - i__2, "zztime_", (ftnlen)2886)], "JULIAND", string + (j - - 1), (ftnlen)160, (ftnlen)7, k - (j - 1)); - } else if (item == 'i') { - s_copy(error, string, error_len, string_len); - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, - error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - prefix_("The meaning of the integer <#> could not be determined:" - " '", &c__1, error, (ftnlen)57, error_len); - suffix_("'", &c__0, error, (ftnlen)1, error_len); - repmc_(error, "#", string + (j - 1), error, error_len, (ftnlen)1, - k - (j - 1), error_len); - *e = 0; - s_copy(pic, " ", pic_len, (ftnlen)1); - ret_val = FALSE_; - return ret_val; - } else if (item == 'n') { - s_copy(error, string, error_len, string_len); - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, - error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - prefix_("The meaning of the decimal number <#> could not be dete" - "rmined: ", &c__1, error, (ftnlen)63, error_len); - repmc_(error, "#", string + (j - 1), error, error_len, (ftnlen)1, - k - (j - 1), error_len); - *e = 0; - s_copy(pic, " ", pic_len, (ftnlen)1); - ret_val = FALSE_; - return ret_val; - } else { - s_copy(error, string, error_len, string_len); - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, - error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - prefix_("An unexpected # (\"#\") was encountered in the time str" - "ing: ", &c__1, error, (ftnlen)58, error_len); - repmc_(error, "#", names + (((i__1 = item - 32) < 95 && 0 <= i__1 - ? i__1 : s_rnge("names", i__1, "zztime_", (ftnlen)2934)) - << 5), error, error_len, (ftnlen)1, (ftnlen)32, error_len) - ; - repmc_(error, "#", string + (j - 1), error, error_len, (ftnlen)1, - k - (j - 1), error_len); - s_copy(pic, " ", pic_len, (ftnlen)1); - *e = 0; - ret_val = FALSE_; - return ret_val; - } - } - -/* Ok. Check the counts of substrings to make sure everything */ -/* looks ok. If so move the HMS into the appropriate slots */ -/* in TVEC, set the kind of TVEC, set the function value to YES, */ -/* and RETURN. Note regardless of the correctness of the parsing */ -/* we have a legitimate format picture at this point so we keep it. */ - - s_copy(pic, pictur, pic_len, (ftnlen)160); - if (nyear == 1 && nmon == 1 && nday == 1 && ndoy == 0 && njd == 0 && - nhour <= 1 && nmin <= nhour && nsec <= nmin) { - tvec[3] = hms[0]; - tvec[4] = hms[1]; - tvec[5] = hms[2]; - s_copy(transl, "YMD", transl_len, (ftnlen)3); - ret_val = TRUE_; - return ret_val; - } else if (nyear == 1 && nmon == 0 && nday == 0 && njd == 0 && ndoy == 1 - && nhour <= 1 && nmin <= nhour && nsec <= nmin) { - tvec[2] = hms[0]; - tvec[3] = hms[1]; - tvec[4] = hms[2]; - s_copy(transl, "YD", transl_len, (ftnlen)2); - ret_val = TRUE_; - return ret_val; - } else if (nyear == 0 && nmon == 0 && nday == 0 && njd == 1 && ndoy == 0 - && nhour <= 0 && nmin <= 0 && nsec <= 0) { - s_copy(transl, "JD", transl_len, (ftnlen)2); - ret_val = TRUE_; - return ret_val; - } - -/* If we're still here, there is some kind of an error */ -/* in the input string. There are a lot of possible */ -/* problems. */ - - *e = 0; - if (nyear == 0 && nday == 0 && njd == 0 && ndoy == 0 && nhour == 0 && - nmin == 0 && nsec == 0) { - s_copy(error, "No numeric components were supplied in the time strin" - "g. ", error_len, (ftnlen)56); - } else if (njd == 1) { - s_copy(error, "The string possesses calendar components in addition " - "to Julian Date specifier. ", error_len, (ftnlen)79); - } else if (njd > 1) { - s_copy(error, "There is more than one Julian Date specified in the e" - "poch string. ", error_len, (ftnlen)66); - } else if (nyear == 0) { - s_copy(error, "The year associated with the calendar string \"#\" co" - "uld not be identified. ", error_len, (ftnlen)74); - repmc_(error, "#", string, error, error_len, (ftnlen)1, string_len, - error_len); - } else if (nyear > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings indicating a calendar year were ident" - "ified in the input time string <#> and <#>: \"", (ftnlen)160, - (ftnlen)97); - p1 = pos_(rep, "Y", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "Y", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3053)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3054)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3060)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3061)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (nmon > 0 && ndoy > 0) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Both a day of year and month were identified in the " - "input string. \"", (ftnlen)160, (ftnlen)67); -/* Computing MAX */ - i__1 = pos_(rep, "m", &c__1, (ftnlen)32, (ftnlen)1), i__2 = pos_(rep, - "y", &c__1, (ftnlen)32, (ftnlen)1); - p2 = max(i__1,i__2); -/* Computing MIN */ - i__1 = pos_(rep, "m", &c__1, (ftnlen)32, (ftnlen)1), i__2 = pos_(rep, - "y", &c__1, (ftnlen)32, (ftnlen)1); - p1 = min(i__1,i__2); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3083)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3084)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3089)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3090)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (nmon > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings indicating a calendar month were iden" - "tified in the input time string <#> and <#>: \"", (ftnlen)160, - (ftnlen)98); - p1 = pos_(rep, "m", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "m", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3109)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3110)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3116)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3117)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (ndoy > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings indicating a day of year were identif" - "ied in the input time string <#> and <#>: \"", (ftnlen)160, ( - ftnlen)95); - p1 = pos_(rep, "y", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "y", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3137)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3138)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3144)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3145)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (nday > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings indicating a day of month were identi" - "fied in the input time string <#> and <#>: \"", (ftnlen)160, ( - ftnlen)96); - p1 = pos_(rep, "D", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "D", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3165)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3166)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3172)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3173)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (nhour > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings representing an hour of the day were " - "identified in the input time string <#> and <#>: \"", (ftnlen) - 160, (ftnlen)102); - p1 = pos_(rep, "H", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "H", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3193)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3194)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3200)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3201)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (nmin > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings representing minutes of the hour were" - " identified in the input time string <#> and <#>: \"", ( - ftnlen)160, (ftnlen)103); - p1 = pos_(rep, "M", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "M", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3221)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3222)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3228)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3229)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (nsec > 1) { - s_copy(error, string, error_len, string_len); - s_copy(messge, "Two substrings representing seconds were identified " - "in the input time string <#> and <#>: \"", (ftnlen)160, ( - ftnlen)91); - p1 = pos_(rep, "S", &c__1, (ftnlen)32, (ftnlen)1); - i__1 = p1 + 1; - p2 = pos_(rep, "S", &i__1, (ftnlen)32, (ftnlen)1); - j = begs[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3249)]; - k = ends[(i__1 = p2 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3250)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - j = begs[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("begs", - i__1, "zztime_", (ftnlen)3256)]; - k = ends[(i__1 = p1 - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("ends", - i__1, "zztime_", (ftnlen)3257)]; - i__1 = k + 1; - zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len); - zzinssub_(error, "<", &j, error, error_len, (ftnlen)1, error_len); - repmc_(messge, "#", string + (j - 1), messge, (ftnlen)160, (ftnlen)1, - k - (j - 1), (ftnlen)160); - prefix_(messge, &c__1, error, (ftnlen)160, error_len); - suffix_("\"", &c__0, error, (ftnlen)1, error_len); - } else if (ndoy == 0 && nmon == 0) { - s_copy(error, "Neither a month nor day of year could be identified i" - "n the input time string: \"#\" ", error_len, (ftnlen)82); - repmc_(error, "#", string, error, error_len, (ftnlen)1, string_len, - error_len); - } else if (nmon == 1 && nday == 0) { - s_copy(error, "A month was identified in the time string \"#\", but " - "a day of month could not be identified. ", error_len, (ftnlen) - 91); - repmc_(error, "#", string, error, error_len, (ftnlen)1, string_len, - error_len); - } else if (nmon == 0 && nday == 1) { - s_copy(error, "A day of month was identified in the time string \"" - "#\", but the month it belongs to could not be identified. ", - error_len, (ftnlen)107); - repmc_(error, "#", string, error, error_len, (ftnlen)1, string_len, - error_len); - } else if (nmin > nhour) { - s_copy(error, "A minutes components of the time was identified in t" - "he time string \"#\", but the hours component could not be i" - "dentified. ", error_len, (ftnlen)122); - repmc_(error, "#", string, error, error_len, (ftnlen)1, string_len, - error_len); - } else if (nsec > nmin) { - s_copy(error, "A seconds components of the time was identified in th" - "e time string \"#\", but the minutes component could not be " - "identified. ", error_len, (ftnlen)123); - repmc_(error, "#", string, error, error_len, (ftnlen)1, string_len, - error_len); - } - ret_val = FALSE_; - return ret_val; -/* $Procedure ZZVALT ( Private --- Value Based Tokens ) */ - -L_zzvalt: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Examine the value of an integer token and if it is within the */ -/* range from B to E replace the token with the new token */ -/* specified by LETTER. */ - -/* $ 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 */ - -/* TIME --- PRIVATE */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) STRING */ -/* INTEGER B */ -/* INTEGER E */ -/* CHARACTER*(1) LETTER */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Original time string. */ -/* B I Lower bound of value range */ -/* E I Upper bound of value range */ -/* LETTER I New token if integer is within range. */ - -/* The function returns TRUE if any substitutions are performed. */ - -/* $ Detailed_Input */ - -/* STRING is an original time string as last supplied to ZZTOKNS. */ - -/* B is the lower bound of some test range of integers */ - -/* E is the upper bound of some test range of integers */ - -/* LETTER is the new token value to put in place of 'i' if */ -/* the value of the integer is between B and E */ -/* (inclusive). */ -/* $ Detailed_Output */ - -/* The function returns TRUE if any substitutions are performed.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This function replaces every occurrence of 'i' in the internal */ -/* representation by the value LETTER if the numerical value */ -/* of the token corresponding to 'i' is between B and E. */ - -/* This is used primarily to identify YEAR tokens in a time */ -/* string. */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.2.1, 08-MAR-2009 (NJB) */ - -/* Re-ordered header sections. */ - -/* - SPICELIB Version 1.2.0, 09-DEC-1999 (WLT) */ - -/* The main routine (which should never be called) now returns */ -/* the value .FALSE. */ - -/* - SPICELIB Version 1.1.0, 30-JUN-1999 (WLT) */ - -/* Added a RETURN statement at the end of the main routine. */ -/* Enhanced error message for the case when the input string */ -/* to ZZTOKNS has a non-printing character. */ - -/* - SPICELIB Version 1.0.0, 4-APR-1996 (WLT) */ - - -/* -& */ - -/* So far no translations have been performed. */ - - did = FALSE_; - -/* Examine each token to see if it is an integer. */ - - i__1 = size; - for (i__ = 1; i__ <= i__1; ++i__) { - item = *(unsigned char *)&rep[i__ - 1]; - if (item == 'i') { - -/* We've got an integer. Parse it to see if it */ -/* is in the specified range. */ - - j = begs[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("begs" - , i__2, "zztime_", (ftnlen)3469)]; - k = ends[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("ends" - , i__2, "zztime_", (ftnlen)3470)]; - nparsi_(string + (j - 1), &value, myerr, &ptr, k - (j - 1), ( - ftnlen)160); - if (ptr == 0 && value >= *b && value <= *e) { - *(unsigned char *)&rep[i__ - 1] = *(unsigned char *)letter; - did = TRUE_; - } - } - } - ret_val = did; - return ret_val; -} /* zztime_ */ - -logical zztime_(char *string, char *transl, char *letter, char *error, char * - pic, doublereal *tvec, integer *b, integer *e, logical *l2r, logical * - yabbrv, ftnlen string_len, ftnlen transl_len, ftnlen letter_len, - ftnlen error_len, ftnlen pic_len) -{ - return zztime_0_(0, string, transl, letter, error, pic, tvec, b, e, l2r, - yabbrv, string_len, transl_len, letter_len, error_len, pic_len); - } - -logical zzcmbt_(char *string, char *letter, logical *l2r, ftnlen string_len, - ftnlen letter_len) -{ - return zztime_0_(1, string, (char *)0, letter, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (integer *)0, l2r, (logical *)0, - string_len, (ftnint)0, letter_len, (ftnint)0, (ftnint)0); - } - -logical zzgrep_(char *string, ftnlen string_len) -{ - return zztime_0_(2, string, (char *)0, (char *)0, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (integer *)0, (logical *)0, ( - logical *)0, string_len, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint) - 0); - } - -logical zzispt_(char *string, integer *b, integer *e, ftnlen string_len) -{ - return zztime_0_(3, string, (char *)0, (char *)0, (char *)0, (char *)0, ( - doublereal *)0, b, e, (logical *)0, (logical *)0, string_len, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -logical zzist_(char *letter, ftnlen letter_len) -{ - return zztime_0_(4, (char *)0, (char *)0, letter, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (integer *)0, (logical *)0, ( - logical *)0, (ftnint)0, (ftnint)0, letter_len, (ftnint)0, (ftnint) - 0); - } - -logical zznote_(char *letter, integer *b, integer *e, ftnlen letter_len) -{ - return zztime_0_(5, (char *)0, (char *)0, letter, (char *)0, (char *)0, ( - doublereal *)0, b, e, (logical *)0, (logical *)0, (ftnint)0, ( - ftnint)0, letter_len, (ftnint)0, (ftnint)0); - } - -logical zzremt_(char *letter, ftnlen letter_len) -{ - return zztime_0_(6, (char *)0, (char *)0, letter, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (integer *)0, (logical *)0, ( - logical *)0, (ftnint)0, (ftnint)0, letter_len, (ftnint)0, (ftnint) - 0); - } - -logical zzsubt_(char *string, char *transl, logical *l2r, ftnlen string_len, - ftnlen transl_len) -{ - return zztime_0_(7, string, transl, (char *)0, (char *)0, (char *)0, ( - doublereal *)0, (integer *)0, (integer *)0, l2r, (logical *)0, - string_len, transl_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -logical zztokns_(char *string, char *error, ftnlen string_len, ftnlen - error_len) -{ - return zztime_0_(8, string, (char *)0, (char *)0, error, (char *)0, ( - doublereal *)0, (integer *)0, (integer *)0, (logical *)0, ( - logical *)0, string_len, (ftnint)0, (ftnint)0, error_len, (ftnint) - 0); - } - -logical zzunpck_(char *string, logical *yabbrv, doublereal *tvec, integer *e, - char *transl, char *pic, char *error, ftnlen string_len, ftnlen - transl_len, ftnlen pic_len, ftnlen error_len) -{ - return zztime_0_(9, string, transl, (char *)0, error, pic, tvec, (integer - *)0, e, (logical *)0, yabbrv, string_len, transl_len, (ftnint)0, - error_len, pic_len); - } - -logical zzvalt_(char *string, integer *b, integer *e, char *letter, ftnlen - string_len, ftnlen letter_len) -{ - return zztime_0_(10, string, (char *)0, letter, (char *)0, (char *)0, ( - doublereal *)0, b, e, (logical *)0, (logical *)0, string_len, ( - ftnint)0, letter_len, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/cspice/zztpats.c b/ext/spice/src/cspice/zztpats.c deleted file mode 100644 index 7be7587adb..0000000000 --- a/ext/spice/src/cspice/zztpats.c +++ /dev/null @@ -1,597 +0,0 @@ -/* zztpats.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZTPATS (Private---Time Patterns) */ -logical zztpats_(integer *room, integer *nknown, char *known, char *meanng, - ftnlen known_len, ftnlen meanng_len) -{ - /* System generated locals */ - integer i__1, i__2; - logical ret_val; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen), - reordc_(integer *, integer *, char *, ftnlen); - integer ordvec[203]; - char mymnng[32*203], myknwn[32*203]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Initialize the built-in time patterns. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ROOM I The declared space available for patterns */ -/* KNOWN O The patterns that are automatically recognized */ -/* MEANNG O The meaning associated with the patterns. */ -/* COUNT P The number of patterns built in to this routine. */ -/* The function returns .TRUE. if the initialization is successful. */ - -/* $ Detailed_Input */ - -/* ROOM an integer giving the room available for known patterns */ -/* and their meanings. */ - -/* If ROOM does not equal the number of built-in patterns */ -/* the function returns only those patterns that will fit */ -/* and returns the value FALSE. */ - -/* $ Detailed_Output */ - -/* NKNOWN is the number of patterns/meanings returned in the */ -/* arrays KNOWN and MEANNG */ - -/* KNOWN is the array of automatically recognized calendar */ -/* date patterns. KNOWN will be sorted according to */ -/* the FORTRAN collating sequence. */ - -/* MEANNG is the array of "meanings" associated with the built-in */ -/* patterns returned in the array KNOWN. MEANNG(I) is */ -/* the "meaning" associated with known pattern KNOWN(I). */ - -/* The function returns TRUE if the arrays, KNOWN and MEANNG are */ -/* successfully initialized. Otherwise it returns FALSE. */ - -/* $ Parameters */ - -/* COUNT is the number of patterns/meanings that are */ -/* returned by this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error Free. */ - -/* 1) If ROOM is less than count, the function returns FALSE. */ - -/* $ Particulars */ - -/* This is a utility routine that supports the SPICE routine */ -/* TPARTV that parses time strings. This routine initializes */ -/* the set of built-in time patterns for use by TPARTV */ - -/* $ Examples */ - -/* See TPARTV */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 3.0.0, 16-AUG-2002 (WLT) */ - -/* The interface of the routine was changed from */ -/* ZZTPATS( ROOM, KNOWN, MEANNG ) */ -/* to */ -/* ZZTPATS( ROOM, NKNOWN, KNOWN, MEANNG ) */ -/* and made error free. */ - -/* - SPICELIB Version 2.0.0, 16-APR-1997 (WLT) */ - -/* The collection of recognized built in patterns was */ -/* increased from 185 to 203 patterns. The new patterns */ -/* begin at KNOWN(186) below. */ - -/* - SPICELIB Version 1.0.0, 02-APR-1996 (WLT) */ - - -/* -& */ - s_copy(myknwn, "Y-i-it", (ftnlen)32, (ftnlen)6); - s_copy(mymnng, "Y*m*D*", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 32, "Y-i-iti:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 32, "Y*m*D*H*M", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 64, "Y-i-iti:i:i", (ftnlen)32, (ftnlen)11); - s_copy(mymnng + 64, "Y*m*D*H*M*S", (ftnlen)32, (ftnlen)11); - s_copy(myknwn + 96, "Y-i-iti:i:n", (ftnlen)32, (ftnlen)11); - s_copy(mymnng + 96, "Y*m*D*H*M*S", (ftnlen)32, (ftnlen)11); - s_copy(myknwn + 128, "Y-i-iti:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 128, "Y*m*D*H*M", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 160, "Y-i/", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 160, "Y*y*", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 192, "Y-i/i:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 192, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 224, "Y-i/i:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 224, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 256, "Y-i/i:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 256, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 288, "Y-i/i:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 288, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 320, "Y-id", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 320, "Y*y*", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 352, "Y-idi:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 352, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 384, "Y-idi:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 384, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 416, "Y-idi:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 416, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 448, "Y-idi:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 448, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 480, "Y-it", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 480, "Y*y*", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 512, "Y-iti:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 512, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 544, "Y-iti:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 544, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 576, "Y-iti:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 576, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 608, "Y-iti:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 608, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 640, "Yid", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 640, "Yy*", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 672, "Yidi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 672, "Yy*H*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 704, "Yidi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 704, "Yy*H*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 736, "Yidi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 736, "Yy*H*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 768, "Yidi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 768, "Yy*H*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 800, "Yii", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 800, "YmD", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 832, "Yiii", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 832, "YmDH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 864, "Yiii:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 864, "YmDH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 896, "Yiii:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 896, "YmDH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 928, "Yiii:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 928, "YmDH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 960, "Yiii:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 960, "YmDH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 992, "Yiiii", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 992, "YmDHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 1024, "Yiiiii", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 1024, "YmDHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 1056, "Yiiiin", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 1056, "YmDHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 1088, "Yiiin", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 1088, "YmDHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 1120, "Yiin", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1120, "YmDH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1152, "Yim", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 1152, "YDm", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 1184, "Yimi", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1184, "YDmH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1216, "Yimi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 1216, "YDmH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 1248, "Yimi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 1248, "YDmH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 1280, "Yimi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 1280, "YDmH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 1312, "Yimi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 1312, "YDmH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 1344, "Yimn", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1344, "YDmH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1376, "Yin", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 1376, "YmD", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 1408, "Ymi", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 1408, "YmD", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 1440, "Ymii", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1440, "YmDH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1472, "Ymii:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 1472, "YmDH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 1504, "Ymii:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 1504, "YmDH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 1536, "Ymii:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 1536, "YmDH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 1568, "Ymii:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 1568, "YmDH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 1600, "Ymin", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1600, "YmDH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1632, "Ymn", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 1632, "YmD", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 1664, "Ynm", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 1664, "YDm", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 1696, "i-Y/", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1696, "y*Y*", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1728, "i-Y/i:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 1728, "y*Y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 1760, "i-Y/i:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 1760, "y*Y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 1792, "i-Y/i:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 1792, "y*Y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 1824, "i-Y/i:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 1824, "y*Y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 1856, "i-Yd", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 1856, "y*Y*", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 1888, "i-Ydi:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 1888, "y*Y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 1920, "i-Ydi:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 1920, "y*Y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 1952, "i-Ydi:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 1952, "y*Y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 1984, "i-Ydi:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 1984, "y*Y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2016, "i-i-it", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2016, "Y*m*D*", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 2048, "i-i-iti:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2048, "Y*m*D*H*M", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2080, "i-i-iti:i:i", (ftnlen)32, (ftnlen)11); - s_copy(mymnng + 2080, "Y*m*D*H*M*S", (ftnlen)32, (ftnlen)11); - s_copy(myknwn + 2112, "i-i-iti:i:n", (ftnlen)32, (ftnlen)11); - s_copy(mymnng + 2112, "Y*m*D*H*M*S", (ftnlen)32, (ftnlen)11); - s_copy(myknwn + 2144, "i-i-iti:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2144, "Y*m*D*H*M", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2176, "i-i/i:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 2176, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2208, "i-i/i:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2208, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2240, "i-i/i:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2240, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2272, "i-i/i:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 2272, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2304, "i-idi:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 2304, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2336, "i-idi:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2336, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2368, "i-idi:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2368, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2400, "i-idi:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 2400, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2432, "i-it", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 2432, "Y*y*", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 2464, "i-iti:i", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 2464, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2496, "i-iti:i:i", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2496, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2528, "i-iti:i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 2528, "Y*y*H*M*S", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 2560, "i-iti:n", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 2560, "Y*y*H*M", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 2592, "i:i:iimY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 2592, "H*M*SDmY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 2624, "i:i:imiY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 2624, "H*M*SmDY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 2656, "i:i:nimY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 2656, "H*M*SDmY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 2688, "i:i:nmiY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 2688, "H*M*SmDY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 2720, "i:iimY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2720, "H*MDmY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 2752, "i:imiY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2752, "H*MmDY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 2784, "i:nimY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2784, "H*MDmY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 2816, "i:nmiY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2816, "H*MmDY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 2848, "iYd", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 2848, "yY*", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 2880, "iYdi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2880, "yY*H*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 2912, "iYdi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 2912, "yY*H*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 2944, "iYdi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 2944, "yY*H*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 2976, "iYdi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 2976, "yY*H*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3008, "iiY", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 3008, "mDY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 3040, "iiYi", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 3040, "mDYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 3072, "iiYi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3072, "mDYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3104, "iiYi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3104, "mDYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3136, "iiYi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3136, "mDYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3168, "iiYi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3168, "mDYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3200, "iiYn", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 3200, "mDYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 3232, "iid", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 3232, "Yy*", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 3264, "iidi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3264, "Yy*H*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3296, "iidi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3296, "Yy*H*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3328, "iidi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3328, "Yy*H*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3360, "iidi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3360, "Yy*H*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3392, "iim", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 3392, "YDm", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 3424, "iimi", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 3424, "YDmH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 3456, "iimi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3456, "YDmH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3488, "iimi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3488, "YDmH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3520, "iimi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3520, "YDmH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3552, "iimi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3552, "YDmH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3584, "iimii", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 3584, "YDmHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 3616, "iimiii", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3616, "YDmHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3648, "iimiin", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3648, "YDmHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3680, "iimin", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 3680, "YDmHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 3712, "iimn", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 3712, "YDmH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 3744, "imY", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 3744, "DmY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 3776, "imYi", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 3776, "DmYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 3808, "imYi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3808, "DmYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3840, "imYi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3840, "DmYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3872, "imYi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 3872, "DmYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 3904, "imYi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 3904, "DmYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 3936, "imYn", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 3936, "DmYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 3968, "imi", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 3968, "YmD", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 4000, "imi:i:iY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4000, "DmH*M*SY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4032, "imi:i:nY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4032, "DmH*M*SY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4064, "imi:iY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4064, "DmH*MY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4096, "imi:nY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4096, "DmH*MY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4128, "imii", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 4128, "YmDH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 4160, "imii:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4160, "YmDH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4192, "imii:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4192, "YmDH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4224, "imii:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4224, "YmDH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4256, "imii:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4256, "YmDH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4288, "imiii", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 4288, "YmDHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 4320, "imiiii", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4320, "YmDHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4352, "imiiin", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4352, "YmDHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4384, "imiin", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 4384, "YmDHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 4416, "imin", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 4416, "YmDH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 4448, "imn", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 4448, "YmD", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 4480, "inY", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 4480, "mDY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 4512, "inm", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 4512, "YDm", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 4544, "miY", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 4544, "mDY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 4576, "miYi", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 4576, "mDYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 4608, "miYi:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4608, "mDYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4640, "miYi:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4640, "mDYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4672, "miYi:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4672, "mDYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4704, "miYi:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4704, "mDYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4736, "miYn", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 4736, "mDYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 4768, "mii", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 4768, "mDY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 4800, "mii:i:iY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4800, "mDH*M*SY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4832, "mii:i:nY", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4832, "mDH*M*SY", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 4864, "mii:iY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4864, "mDH*MY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4896, "mii:nY", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4896, "mDH*MY", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4928, "miii", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 4928, "mDYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 4960, "miii:i", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 4960, "mDYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 4992, "miii:i:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 4992, "mDYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5024, "miii:i:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5024, "mDYH*M*S", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5056, "miii:n", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 5056, "mDYH*M", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 5088, "miiii", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5088, "mDYHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5120, "miiiii", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 5120, "mDYHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 5152, "miiiin", (ftnlen)32, (ftnlen)6); - s_copy(mymnng + 5152, "mDYHMS", (ftnlen)32, (ftnlen)6); - s_copy(myknwn + 5184, "miiin", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5184, "mDYHM", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5216, "miin", (ftnlen)32, (ftnlen)4); - s_copy(mymnng + 5216, "mDYH", (ftnlen)32, (ftnlen)4); - s_copy(myknwn + 5248, "mnY", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 5248, "mDY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 5280, "mni", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 5280, "mDY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 5312, "nmY", (ftnlen)32, (ftnlen)3); - s_copy(mymnng + 5312, "DmY", (ftnlen)32, (ftnlen)3); - s_copy(myknwn + 5344, "i/i/i", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5344, "m*D*Y", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5376, "i/i/ii:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5376, "m*D*YH*M", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5408, "i/i/ii:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5408, "m*D*YH*M", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5440, "i/i/ii:i:n", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 5440, "m*D*YH*M*S", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 5472, "i/i/ii:i:i", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 5472, "m*D*YH*M*S", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 5504, "i/i/Y", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5504, "m*D*Y", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5536, "i/i/Yi:i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5536, "m*D*YH*M", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5568, "i/i/ii:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5568, "m*D*YH*M", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5600, "i/i/Yi:i:n", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 5600, "m*D*YH*M*S", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 5632, "i/i/Yi:i:i", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 5632, "m*D*YH*M*S", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 5664, "Y-i-iti", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 5664, "Y*m*D*H", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 5696, "Y-iti", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5696, "Y*y*H", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5728, "Y-i-itn", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 5728, "Y*m*D*H", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 5760, "Y-itn", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5760, "Y*y*H", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5792, "i-i-iti", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 5792, "Y*m*D*H", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 5824, "i-i-itn", (ftnlen)32, (ftnlen)7); - s_copy(mymnng + 5824, "Y*m*D*H", (ftnlen)32, (ftnlen)7); - s_copy(myknwn + 5856, "i-iti", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5856, "Y*y*H", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5888, "i-itn", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 5888, "Y*y*H", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 5920, "i:ii/i/i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5920, "H*Mm*D*Y", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5952, "i:ni/i/i", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 5952, "H*Mm*D*Y", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 5984, "i:i:ii/i/i", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 5984, "H*M*Sm*D*Y", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6016, "i:i:ni/i/i", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6016, "H*M*Sm*D*Y", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6048, "i:ii/i/Y", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 6048, "H*Mm*D*Y", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 6080, "i:ni/i/Y", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 6080, "H*Mm*D*Y", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 6112, "i:i:ii/i/Y", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6112, "H*M*Sm*D*Y", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6144, "i:i:ni/i/Y", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6144, "H*M*Sm*D*Y", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6176, "i:ii-i-Y", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 6176, "H*Mm*D*Y", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 6208, "i:ni-i-Y", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 6208, "H*Mm*D*Y", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 6240, "i:i:ii-i-Y", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6240, "H*M*Sm*D*Y", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6272, "i:i:ni-i-Y", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6272, "H*M*Sm*D*Y", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6304, "i/i/Y/i:n", (ftnlen)32, (ftnlen)9); - s_copy(mymnng + 6304, "m*D*Y*H*M", (ftnlen)32, (ftnlen)9); - s_copy(myknwn + 6336, "i-i-Y", (ftnlen)32, (ftnlen)5); - s_copy(mymnng + 6336, "m*D*Y", (ftnlen)32, (ftnlen)5); - s_copy(myknwn + 6368, "i-i-Yi:n", (ftnlen)32, (ftnlen)8); - s_copy(mymnng + 6368, "m*D*YH*M", (ftnlen)32, (ftnlen)8); - s_copy(myknwn + 6400, "i-i-Yi:i:n", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6400, "m*D*YH*M*S", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6432, "i-i-Yi:i:i", (ftnlen)32, (ftnlen)10); - s_copy(mymnng + 6432, "m*D*YH*M*S", (ftnlen)32, (ftnlen)10); - s_copy(myknwn + 6464, "i-i-Yi:i", (ftnlen)32, (ftnlen)8); - s_copy(meanng + meanng_len * 202, "m*D*YH*M", meanng_len, (ftnlen)8); - -/* Copy as many patterns and meanings as the input arrays allow. */ - - *nknown = min(203,*room); - i__1 = *nknown; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(known + (i__ - 1) * known_len, myknwn + (((i__2 = i__ - 1) < - 203 && 0 <= i__2 ? i__2 : s_rnge("myknwn", i__2, "zztpats_", ( - ftnlen)948)) << 5), known_len, (ftnlen)32); - s_copy(meanng + (i__ - 1) * meanng_len, mymnng + (((i__2 = i__ - 1) < - 203 && 0 <= i__2 ? i__2 : s_rnge("mymnng", i__2, "zztpats_", ( - ftnlen)949)) << 5), meanng_len, (ftnlen)32); - } - -/* Make sure everything is in the proper order. */ - - orderc_(known, nknown, ordvec, known_len); - reordc_(ordvec, nknown, known, known_len); - reordc_(ordvec, nknown, meanng, meanng_len); - -/* If there wasn't sufficient room to get all of the patterns */ -/* and meanings, return FALSE. */ - - if (203 > *room) { - ret_val = FALSE_; - return ret_val; - } - ret_val = TRUE_; - return ret_val; -} /* zztpats_ */ - diff --git a/ext/spice/src/cspice/zztwovxf.c b/ext/spice/src/cspice/zztwovxf.c deleted file mode 100644 index fb31c576bf..0000000000 --- a/ext/spice/src/cspice/zztwovxf.c +++ /dev/null @@ -1,459 +0,0 @@ -/* zztwovxf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; -static integer c__3 = 3; - -/* $Procedure ZZTWOVXF ( Two states defining a frame transformation ) */ -/* Subroutine */ int zztwovxf_(doublereal *axdef, integer *indexa, doublereal - *plndef, integer *indexp, doublereal *xform) -{ - /* Initialized data */ - - static integer seqnce[5] = { 1,2,3,1,2 }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), dvhat_(doublereal *, - doublereal *), moved_(doublereal *, integer *, doublereal *); - integer i1, i2, i3; - extern logical vzero_(doublereal *); - extern /* Subroutine */ int cleard_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen), ducrss_(doublereal *, - doublereal *, doublereal *); - doublereal tmpsta[6]; - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the state transformation to a base frame from the */ -/* right-handed frame defined by two state vectors: one state */ -/* vector defining a specified axis and a second state vector */ -/* defining a specified coordinate plane. */ - -/* $ 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 */ - -/* AXES */ -/* FRAMES */ -/* MATRIX */ -/* TRANSFORMATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* AXDEF I State defining a principal axis. */ -/* INDEXA I Principal axis number of AXDEF (X=1, Y=2, Z=3). */ -/* PLNDEF I State defining (with AXDEF) a principal plane. */ -/* INDEXP I Second axis number (with INDEXA) of principal */ -/* plane. */ -/* XFORM O Output state transformation matrix. */ - -/* $ Detailed_Input */ - -/* AXDEF is a "generalized" state vector defining one of the */ -/* principal axes of a reference frame. This vector */ -/* consists of three components of a vector-valued */ -/* function of one independent variable t followed by */ -/* the derivatives of the components with respect to that */ -/* variable: */ - -/* ( a, b, c, da/dt, db/dt, dc/dt ) */ - -/* This routine treats the input states as unitless, but */ -/* in most applications the input states represent */ -/* quantities that have associated units. The first three */ -/* components must have the same units, and the units of */ -/* the last three components must be compatible with */ -/* those of the first three: if the first three */ -/* components of AXDEF */ - -/* ( a, b, c ) */ - -/* have units U and t has units T, then the units of */ -/* AXDEF normally would be */ - -/* ( U, U, U, U/T, U/T, U/T ) */ - -/* Note that the direction and angular velocity defined */ -/* by AXDEF are actually independent of U, so scaling */ -/* AXDEF doesn't affect the output of this routine. */ - -/* AXDEF could represent position and velocity; it could */ -/* also represent velocity and acceleration. AXDEF could */ -/* for example represent the velocity and acceleration of */ -/* a time-dependent position vector ( x(t), y(t), z(t) ), */ -/* in which case AXDEF would be defined by */ - -/* a = dx/dt */ -/* b = dy/dt */ -/* c = dz/dt */ - -/* 2 2 */ -/* da/dt = d x / dt */ - -/* 2 2 */ -/* db/dt = d y / dt */ - -/* 2 2 */ -/* dc/dt = d z / dt */ - -/* Below, we'll call the normalized (unit length) version */ -/* of */ - -/* ( a, b, c ) */ - -/* the "direction" of AXDEF. */ - -/* We call the frame relative to which AXDEF is specified */ -/* the "base frame." The input state PLNDEF must be */ -/* specified relative to the same base frame. */ - - -/* INDEXA is the index of the reference frame axis that is */ -/* parallel to the direction of AXDEF. */ - -/* Value of INDEXA Axis */ - -/* 1 X */ -/* 2 Y */ -/* 3 Z */ - - -/* PLNDEF is a state vector defining (with AXDEF) a principal */ -/* plane of the reference frame. This vector consists */ -/* of three components followed by their derivatives with */ -/* respect to the independent variable t associated with */ -/* AXDEF, so PLNDEF is */ - -/* ( e, f, g, de/dt, df/dt, dg/dt ) */ - -/* Below, we'll call the unitized version of */ - -/* ( e, f, g ) */ - -/* the "direction" of PLNDEF. */ - -/* The second axis of the principal plane containing the */ -/* direction vectors of AXDEF and PLNDEF is perpendicular */ -/* to the first axis and has positive dot product with */ -/* the direction vector of PLNDEF. */ - -/* The first three components of PLNDEF must have the */ -/* same units, and the units of the last three components */ -/* must be compatible with those of the first three: if */ -/* the first three components of PLNDEF */ - -/* ( e, f, g ) */ - -/* have units U2 and t has units T, then the units of */ -/* PLNDEF normally would be */ - -/* ( U2, U2, U2, U2/T, U2/T, U2/T ) */ - -/* ***For meaningful results, the angular velocities */ -/* defined by AXDEF and PLNDEF must both have units of */ -/* 1/T.*** */ - -/* As with AXDEF, scaling PLNDEF doesn't affect the */ -/* output of this routine. */ - -/* AXDEF and PLNDEF must be specified relative to a */ -/* common reference frame, which we call the "base */ -/* frame." */ - - -/* INDEXP is the index of second axis of the principal frame */ -/* determined by AXDEF and PLNDEF. The association of */ -/* integer values and axes is the same as for INDEXA. */ - -/* $ Detailed_Output */ - -/* XFORM is the 6x6 matrix that transforms states to the frame */ -/* relative to which AXDEF and PLNDEF are specified (the */ -/* "base frame") from the frame whose axes and derivative */ -/* are determined by AXDEF, PLNDEF, INDEXA and INDEXP. */ - -/* The matrix XFORM has the structure shown below: */ - -/* - - */ -/* | : | */ -/* | R : 0 | */ -/* | ......:......| */ -/* | : | */ -/* | dR_dt : R | */ -/* | : | */ -/* - - */ - -/* where R is a rotation matrix that is a function of */ -/* the independent variable associated with AXDEF and */ -/* PLNDEF, and where dR_dt is the derivative of R */ -/* with respect to that independent variable. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If INDEXA or INDEXP is not in the set {1,2,3} the error */ -/* SPICE(BADINDEX) will be signaled. */ - -/* 2) If INDEXA and INDEXP are the same the error */ -/* SPICE(UNDEFINEDFRAME) will be signaled. */ - -/* 3) If the cross product of the vectors AXDEF and PLNDEF is zero, */ -/* the error SPICE(DEPENDENTVECTORS) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine exists to support the public routine TWOVXF: */ -/* TWOVXF does its job by calling this routine, inverting the */ -/* matrix returned by this routine, and returning the result. */ - -/* The SPICELIB frame subsystem typically requires this routine */ -/* rather than TWOVXF, since the frame subsystem produces */ -/* transformations from frames defined in frame kernels to their */ -/* base frames. Calling this routine rather than TWOVXF allows */ -/* the frame subsystem to eliminate two unnecessary calls to */ -/* INVSTM. */ - -/* Given two linearly independent state vectors AXDEF and PLNDEF, */ -/* define vectors DIR1 and DIR2 by */ - -/* DIR1 = ( AXDEF(1), AXDEF(2), AXDEF(3) ) */ -/* DIR2 = ( PLNDEF(1), PLNDEF(2), PLNDEF(3) ) */ - -/* Then there is a unique right-handed reference frame F having: */ - -/* DIR1 lying along the INDEXA axis. */ - -/* DIR2 lying in the INDEXA-INDEXP coordinate plane, such that */ -/* the dot product of DIR2 with the positive INDEXP axis is */ -/* positive. */ - -/* This routine determines the 6x6 matrix that transforms states */ -/* to the base frame used to represent the input vectors from the */ -/* the frame F determined by AXDEF and PLNDEF. Thus a state vector */ - -/* S = ( x, y, z, dx/dt, dy/dt, dz/dt ) */ -/* F */ - -/* in the reference frame F will be transformed to */ - -/* S = XFORM * S */ -/* base F */ - -/* in the base frame relative to which AXDEF and PLNDEF are */ -/* specified. */ - -/* $ Examples */ - -/* See TWOVXF. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* W.M. Owen (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in DUCRSS and MOVED calls. */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) (WMO) (WLT) */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in DUCRSS and MOVED calls. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } - chkin_("ZZTWOVXF", (ftnlen)8); - -/* Check for obvious bad inputs. */ - - if (max(*indexp,*indexa) > 3 || min(*indexp,*indexa) < 1) { - setmsg_("The definition indices must lie in the range from 1 to 3. " - "The value of INDEXA was #. The value of INDEXP was #. ", ( - ftnlen)113); - errint_("#", indexa, (ftnlen)1); - errint_("#", indexp, (ftnlen)1); - sigerr_("SPICE(BADINDEX)", (ftnlen)15); - chkout_("ZZTWOVXF", (ftnlen)8); - return 0; - } else if (*indexa == *indexp) { - setmsg_("The values of INDEXA and INDEXP were the same, namely #. T" - "hey are required to be different.", (ftnlen)92); - errint_("#", indexa, (ftnlen)1); - sigerr_("SPICE(UNDEFINEDFRAME)", (ftnlen)21); - chkout_("ZZTWOVXF", (ftnlen)8); - return 0; - } - -/* Get indices for right-handed axes: */ - -/* First AXDEF ... */ - - i1 = *indexa; - -/* ... then the other two. */ - - i2 = seqnce[(i__1 = *indexa) < 5 && 0 <= i__1 ? i__1 : s_rnge("seqnce", - i__1, "zztwovxf_", (ftnlen)387)]; - i3 = seqnce[(i__1 = *indexa + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("seqnce" - , i__1, "zztwovxf_", (ftnlen)388)]; - -/* Column I1 of XFORM contains a unit vector parallel to AXDEF and */ -/* the derivative of the unit vector. */ - - dvhat_(axdef, &xform[(i__1 = i1 * 6 - 6) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zztwovxf_", (ftnlen)394)]); - -/* Obtain columns I2 and I3 of XFORM using cross products. */ -/* Which order to use depends on whether INDEXP = I2 (next axis in */ -/* right-handed order) or INDEXP = I3 (previous axis in right-handed */ -/* order). */ - -/* Select column indices... */ - - if (*indexp == i2) { - -/* We compute the third axis in the sequence, then the second. */ - - ducrss_(axdef, plndef, &xform[(i__1 = i3 * 6 - 6) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zztwovxf_", (ftnlen)408)]); - ducrss_(&xform[(i__1 = i3 * 6 - 6) < 36 && 0 <= i__1 ? i__1 : s_rnge( - "xform", i__1, "zztwovxf_", (ftnlen)409)], axdef, tmpsta); - moved_(tmpsta, &c__6, &xform[(i__1 = i2 * 6 - 6) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zztwovxf_", (ftnlen)410)]); - } else { - ducrss_(plndef, axdef, &xform[(i__1 = i2 * 6 - 6) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zztwovxf_", (ftnlen)412)]); - ducrss_(axdef, &xform[(i__1 = i2 * 6 - 6) < 36 && 0 <= i__1 ? i__1 : - s_rnge("xform", i__1, "zztwovxf_", (ftnlen)413)], tmpsta); - moved_(tmpsta, &c__6, &xform[(i__1 = i3 * 6 - 6) < 36 && 0 <= i__1 ? - i__1 : s_rnge("xform", i__1, "zztwovxf_", (ftnlen)414)]); - } - -/* ...and compute the output frame's non-principal unit basis */ -/* vectors and the derivatives of these vectors. */ - - -/* At this point, we've filled in the left half of XFORM. */ - -/* The upper right block is the 3x3 zero matrix. */ -/* The lower right block matches the upper left block. */ - - cleard_(&c__3, &xform[18]); - cleard_(&c__3, &xform[24]); - cleard_(&c__3, &xform[30]); - for (j = 1; j <= 3; ++j) { - for (i__ = 1; i__ <= 3; ++i__) { - xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1 - : s_rnge("xform", i__1, "zztwovxf_", (ftnlen)436)] = - xform[(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 : - s_rnge("xform", i__2, "zztwovxf_", (ftnlen)436)]; - } - } - -/* Finally, check to see that we actually got something non-zero in */ -/* the first three components of at least one of the columns */ -/* XFORM(1,I2) and XFORM(1,I3) (we need only check one of them since */ -/* they are related by a cross product). */ - - if (vzero_(&xform[(i__1 = i2 * 6 - 6) < 36 && 0 <= i__1 ? i__1 : s_rnge( - "xform", i__1, "zztwovxf_", (ftnlen)448)])) { - setmsg_("The direction vectors associated with states AXDEF and PLND" - "EF are linearly dependent.", (ftnlen)85); - sigerr_("SPICE(DEPENDENTVECTORS)", (ftnlen)23); - chkout_("ZZTWOVXF", (ftnlen)8); - return 0; - } - chkout_("ZZTWOVXF", (ftnlen)8); - return 0; -} /* zztwovxf_ */ - diff --git a/ext/spice/src/cspice/zzutcpm.c b/ext/spice/src/cspice/zzutcpm.c deleted file mode 100644 index 7864931de6..0000000000 --- a/ext/spice/src/cspice/zzutcpm.c +++ /dev/null @@ -1,237 +0,0 @@ -/* zzutcpm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZUTCPM ( UTC Plus or Minus Parse ) */ -/* Subroutine */ int zzutcpm_(char *string, integer *start, doublereal *hoff, - doublereal *moff, integer *last, logical *succes, ftnlen string_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer need; - doublereal sign, x; - extern logical samch_(char *, integer *, char *, integer *, ftnlen, - ftnlen); - integer nchar; - char error[80]; - integer unsat, unsto; - extern /* Subroutine */ int lx4uns_(char *, integer *, integer *, integer - *, ftnlen); - integer length, signat; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - integer ptr; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Parse a substring of the form ::UTC[+/-]1-12:0-59 */ - -/* $ 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 */ - -/* Time --- PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I is a string containing a substring ::UTC+HR:MN */ -/* START I is the location in the string to start parsing */ -/* HOFF O is the d.p. value associated with HR. */ -/* MOFF O is the d.p. value associated with MN */ -/* LAST O is the end of the time zone substring. */ -/* SUCCES O indicates that a time zone was parsed. */ - -/* $ Detailed_Input */ - -/* STRING is a string that has an embedded substring of the */ -/* form ::UTC+HR[:MN] ( or ::UTC-HR[:MN] starting at */ -/* character start. */ - -/* START is the location in STRING where a time zone */ -/* specification is believed to begin. */ - -/* $ Detailed_Output */ - -/* HOFF is the double precision value associated with */ -/* HR in the picture above. This value will be */ -/* between -12 and 12 inclusive. */ - -/* MOFF is the double precision value associated with MN */ -/* in the picture above. This value will be between */ -/* 0 and 59 inclusive (or -59 and 0 inclusive) depending */ -/* on the sign present in the UTC+/- substring. The */ -/* sign of MOFF is the same as the sign present in the */ -/* string. */ - -/* LAST is the last character of the time zone specification. */ -/* If the string doesn't have a correct format and */ -/* range of values, LAST is returns as START - 1. */ - -/* SUCCES is a logical which if true, indicates that a time */ -/* zone was successfully parsed. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) There are no exceptions. Either the string matches */ -/* the template or it doesn't. No case is regarded */ -/* as an error. */ - -/* $ Particulars */ - -/* This is a private routine for parsing time zones specified */ -/* as UTC+/-HR:MN where HR is an unsigned integer between 0 and */ -/* 11. HR must have no more than 2 digits. MN is expected */ -/* to be an unsigned integer between 0 and 59 inclusive. It must */ -/* have no more than 2 digits. */ - -/* $ Examples */ - -/* See TIMOUT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 27-SEP-1996 (WLT) */ - - -/* -& */ - -/* Spicelib functions */ - - -/* Local Variables */ - - -/* This is a special purpose routine. The input string must have */ -/* exactly the right format to be a time zone substring. If anything */ -/* goes wrong, we just bail out and leave HOFF and MOFF right at */ -/* zero. */ - - *hoff = 0.; - *moff = 0.; - *last = *start - 1; - *succes = FALSE_; - -/* Note that NEED = START + LEN('::UTC+x') - 1 */ -/* SIGNAT = START + LEN('::UTC+' ) - 1 */ - - length = i_len(string, string_len); - need = *start + 6; - signat = *start + 5; - unsat = need; - if (length < need) { - return 0; - } - if (*(unsigned char *)&string[signat - 1] == '+') { - sign = 1.; - } else if (*(unsigned char *)&string[signat - 1] == '-') { - sign = -1.; - } else { - return 0; - } - -/* So far everything looks fine, "lex" the string starting at */ -/* SIGNAT + 1 for an unsigned integer. */ - - lx4uns_(string, &unsat, &unsto, &nchar, string_len); - if (nchar > 0 && nchar < 3) { - nparsd_(string + (unsat - 1), &x, error, &ptr, unsto - (unsat - 1), ( - ftnlen)80); - if (x >= 13.) { - return 0; - } - *last = unsto; - *hoff = sign * x; - } else { - return 0; - } - -/* If we're still in the game at this point, we have at least */ -/* an hour offset, see if there is a minutes portion to the */ -/* time zone. */ - - *succes = TRUE_; - i__1 = unsto + 1; - if (samch_(string, &i__1, ":", &c__1, string_len, (ftnlen)1)) { - unsat = unsto + 2; - } else { - return 0; - } - lx4uns_(string, &unsat, &unsto, &nchar, string_len); - if (nchar > 0 && nchar < 3) { - nparsd_(string + (unsat - 1), &x, error, &ptr, unsto - (unsat - 1), ( - ftnlen)80); - if (x > 59.) { - return 0; - } - *last = unsto; - *moff = sign * x; - } - return 0; -} /* zzutcpm_ */ - diff --git a/ext/spice/src/cspice/zzvalcor.c b/ext/spice/src/cspice/zzvalcor.c deleted file mode 100644 index 3fc0ccf59f..0000000000 --- a/ext/spice/src/cspice/zzvalcor.c +++ /dev/null @@ -1,343 +0,0 @@ -/* zzvalcor.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZVALCOR ( Validate aberration correction ) */ -/* Subroutine */ int zzvalcor_(char *abcorr, logical *attblk, ftnlen - abcorr_len) -{ - extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen), chkin_( - char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Validate an aberration correction string suitable for use by */ -/* the SPK system; return attributes. */ - -/* $ 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 */ - -/* ABERRATION */ -/* PARSING */ -/* PRIVATE */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Include file zzabcorr.inc */ - -/* SPICE private file intended solely for the support of SPICE */ -/* routines. Users should not include this file directly due */ -/* to the volatile nature of this file */ - -/* The parameters below define the structure of an aberration */ -/* correction attribute block. */ - -/* $ 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. */ - -/* $ Parameters */ - -/* An aberration correction attribute block is an array of logical */ -/* flags indicating the attributes of the aberration correction */ -/* specified by an aberration correction string. The attributes */ -/* are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the "converged */ -/* Newtonian" variety? */ - -/* - Is the correction for the transmission case? */ - -/* - Is the correction relativistic? */ - -/* The parameters defining the structure of the block are as */ -/* follows: */ - -/* NABCOR Number of aberration correction choices. */ - -/* ABATSZ Number of elements in the aberration correction */ -/* block. */ - -/* GEOIDX Index in block of geometric correction flag. */ - -/* LTIDX Index of light time flag. */ - -/* STLIDX Index of stellar aberration flag. */ - -/* CNVIDX Index of converged Newtonian flag. */ - -/* XMTIDX Index of transmission flag. */ - -/* RELIDX Index of relativistic flag. */ - -/* The following parameter is not required to define the block */ -/* structure, but it is convenient to include it here: */ - -/* CORLEN The maximum string length required by any aberration */ -/* correction string */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ - -/* -& */ -/* Number of aberration correction choices: */ - - -/* Aberration correction attribute block size */ -/* (number of aberration correction attributes): */ - - -/* Indices of attributes within an aberration correction */ -/* attribute block: */ - - -/* Maximum length of an aberration correction string: */ - - -/* End of include file zzabcorr.inc */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- ------------------------------------------------- */ -/* ABCORR I Aberration correction string. */ -/* ATTBLK O Aberration correction attribute block. */ - -/* $ Detailed_Input */ - -/* ABCORR is a string representing a aberration */ -/* correction. The supported values are: */ - -/* 'CN' */ -/* 'CN+S' */ -/* 'LT' */ -/* 'LT+S' */ -/* 'NONE' */ -/* 'XCN' */ -/* 'XCN+S' */ -/* 'XLT' */ -/* 'XLT+S' */ - -/* Note that some values not supported by the */ -/* SPICELIB SPK subsystem are supported by */ -/* the underlying routine ZZPRSCOR: */ - -/* - The letter 'R' indicates relativistic */ -/* corrections. */ - -/* - Stellar aberration-only corrections are */ -/* indicated by the strings */ - -/* 'S' */ -/* 'XS' */ - -/* This routine *does not* permit values that */ -/* the SPK system doesn't handle. */ - -/* Case and embedded blanks are not significant in */ -/* ABCORR. */ - -/* If ABCORR contains an unsupported value, this */ -/* routine will signal an error. */ - -/* $ Detailed_Output */ - -/* ATTBLK is a block of logical flags indicating the */ -/* attributes of the aberration correction */ -/* specified by ABCORR. The attributes are: */ - -/* - Is the correction "geometric"? */ - -/* - Is light time correction indicated? */ - -/* - Is stellar aberration correction indicated? */ - -/* - Is the light time correction of the */ -/* "converged Newtonian" variety? */ - -/* - Is the correction for the transmission */ -/* case? */ - -/* - Is the correction relativistic? (This */ -/* value is always .FALSE. for aberration */ -/* corrrection specifications allowed by */ -/* this routine.) */ - -/* The structure of ATTBLK is defined in the */ -/* include file */ - -/* zzabcorr.inc */ - -/* The size of ATTBLK and the offsets of the */ -/* component flags are defined there. */ - -/* $ Parameters */ - -/* See INCLUDE file zzabcorr.inc. */ - -/* $ Exceptions */ - -/* 1) If the input aberration correction choice is not allowed, */ -/* the error SPICE(INVALIDOPTION) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is similar to ZZPRSCOR, but stellar aberration-only */ -/* and relativistic corrections specifications are not allowed */ -/* by this routine. The allowed values are precisely those allowed */ -/* by SPKEZR. */ - -/* $ Examples */ - -/* See ZZGFOCIN. */ - -/* $ Restrictions */ - -/* 1) This is a SPICE private routine; the routine is subject */ -/* to change without notice. User applications should not */ -/* call this routine. */ - -/* 2) This routine recognizes some aberration corrections not */ -/* handled by most SPICELIB routines. Callers should do */ -/* their own checking to ensure the parsed correction is */ -/* acceptable. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-APR-2008 (NJB) */ - -/* -& */ - -/* SPICELIB functions */ - - if (return_()) { - return 0; - } - chkin_("ZZVALCOR", (ftnlen)8); - -/* Parse the aberration correction string and obtain */ -/* an attribute block. */ - - zzprscor_(abcorr, attblk, abcorr_len); - if (failed_()) { - chkout_("ZZVALCOR", (ftnlen)8); - return 0; - } - -/* Check the attribute block. We don't allow relativistic */ -/* corrections. */ - - if (attblk[5]) { - setmsg_("Aberration correction specification # calls for relativisti" - "c corrections, which are not supported.", (ftnlen)98); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZVALCOR", (ftnlen)8); - return 0; - } - -/* Stellar aberration corrections are allowed only if light */ -/* time corrections are specified as well. */ - - if (attblk[2] && ! attblk[1]) { - setmsg_("Aberration correction specification # calls for stellar abe" - "rration correction without light time correction; this combi" - "nation is not supported.", (ftnlen)143); - errch_("#", abcorr, (ftnlen)1, abcorr_len); - sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20); - chkout_("ZZVALCOR", (ftnlen)8); - return 0; - } - chkout_("ZZVALCOR", (ftnlen)8); - return 0; -} /* zzvalcor_ */ - diff --git a/ext/spice/src/cspice/zzvstrng.c b/ext/spice/src/cspice/zzvstrng.c deleted file mode 100644 index 5303e9cc6a..0000000000 --- a/ext/spice/src/cspice/zzvstrng.c +++ /dev/null @@ -1,748 +0,0 @@ -/* zzvstrng.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__14 = 14; - -/* $Procedure ZZVSTRNG ( Virtual String ) */ -/* Subroutine */ int zzvstrng_0_(int n__, doublereal *x, char *fill, integer * - from, integer *to, logical *rnd, integer *expont, char *substr, - logical *did, ftnlen fill_len, ftnlen substr_len) -{ - /* Initialized data */ - - static char string[30] = " 0.0000000000000E+00 "; - static integer exp__ = 0; - static char myfill[1] = " "; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - logical l_ge(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer code; - static logical incr; - static integer lsub, slot, code0, i__, j, blank, value; - static logical minus; - extern /* Subroutine */ int dpstr_(doublereal *, integer *, char *, - ftnlen); - static char letter[1]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Maintain a virtual decimal string associated with a d.p. number X. */ - -/* $ 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 */ - -/* ALPHANUMERIC, PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* X I ZZVSTSTR */ -/* FILL I ZZVSTSTR */ -/* FROM I ZZVSBSTR */ -/* TO I ZZVSBSTR */ -/* EXPONT O ZZVSTSTR */ -/* SUBSTR O ZZVSBSTR */ - -/* $ Detailed_Input */ - -/* X is a double precision number for which we want to */ -/* create a virtual decimal string. This is supplied */ -/* to the routine ZZVSTSTR which sets up the internal */ -/* representation of the virtual decimal string. */ - -/* X is assumed to be positive. */ - -/* FILL is the character to use for digits that precede the */ -/* first significant digit in the virtual decimal string. */ -/* Usually this will be a blank or zero ('0') */ - -/* FROM is the index in the virtual decimal string of the */ -/* first character that will be returned by ZZVSBSTR. */ - -/* TO is the index in the virtual decimal string of the */ -/* last character that will be returned by ZZVSBSTR. */ - -/* RND is a logical flag used to indicate that the output */ -/* string should represent the virtual decimal string */ -/* that results from rounding to the TO'th decimal */ -/* location. */ - -/* $ Detailed_Output */ - -/* EXPONT is the exponent associated with X when represented */ -/* in scientific notation. It is returned by ZZVSTSTR. */ - -/* SUBSTR is the substring of the virtual decimal string from */ -/* index FROM to TO returned by ZZVSBSTR */ - -/* DID is a logical flag that is used to indicate that */ -/* the left most character returned by ZZVSBSTR became */ -/* a zero as a result of rounding up from 9. (i.e. there */ -/* are significant digits to the left of the first */ -/* character returned in SUBSTR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* Given a character representation of a number such as */ -/* '1.234567890123E+3' there is a corresponding "infinite" */ -/* representation. In this case */ - -/* ...0000001234.56789012300000.... */ - -/* If we let the "index" of the decimal point be zero and number */ -/* the other characters from left to right in sequence we can */ -/* speak of the J'th character in the infinite representation. */ - -/* We call the combination of the infinite representation and */ -/* indexing scheme the virtual decimal string associated with the */ -/* input string. */ - -/* The internal representation of the virtual decimal string is */ -/* set using the entry point ZZVSTSTR. This entry point returns */ -/* the exponent associated with the string when it is written */ -/* in scientific notation. */ - -/* For any J the entry point ZZVSBSTR returns the J'th character */ -/* of the virtual decimal string. */ - -/* You may request that ZZVSBSTR return a string that is rounded */ -/* to the right most digit returned. If return to the example */ -/* above */ - -/* ...0000001234.56789012300000.... */ - -/* and the substring from -5 to 3 is requested with rounding, */ -/* the virtual decimal string will be treated as virtual string */ -/* rounded to the 3rd decimal point. */ - -/* ...0000001234.56800000000000.... */ - -/* As a special convenience, you may specify any character to */ -/* be used in place of the extra leading zeros in the representation. */ -/* This leading character is specified via the input FILL in */ -/* ZZVSTSTR. */ - -/* $ Examples */ - -/* Suppose you would like to create an output string associated */ -/* with X and you would like to present it in decimal format. */ - -/* Moreover, suppose you know that X is positive and less than */ -/* 100000. The following would create the string and set the */ -/* leading character to be a blank. */ - -/* CALL ZZVSTSTR ( X, ' ', EXP ) */ - -/* Check the exponent returned. If it's greater than 5, our basic */ -/* assumptions were violated. */ - -/* IF ( EXP .GT. 5 ) THEN */ -/* WRITE (*,*) 'The exponent is too big. It is: ', EXP */ -/* END IF */ - -/* Now fill in the string. */ - -/* CALL ZZVSBSTR ( -6, 5, RND, SUBSTR, DID ) */ - -/* WRITE (*,*) 'The value of X was: ', SUBSTR */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-SEP-1996 (WLT) */ - -/* -& */ - -/* Local Variables */ - - -/* Although we don't anticipate ever needing these values */ -/* we set some initial values for EXP and STRING. */ - - switch(n__) { - case 1: goto L_zzvststr; - case 2: goto L_zzvsbstr; - } - - -/* This routine doesn't do anything. */ - - return 0; -/* $Procedure ZZVSTSTR ( Set Virtual String) */ - -L_zzvststr: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Set up the virtual string associated with X and return the */ -/* exponent associated with X when represented in scientific */ -/* notation. */ - -/* $ 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 */ - -/* ALPHANUMERIC, PRIVATE */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* DOUBLE PRECISION X */ -/* CHARACTER*(1) FILL */ -/* INTEGER EXPONT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* X I double precision number to needing a virtual string */ -/* FILL I leading character for virtual string. */ -/* EXPONT O The exponent associated with X. */ - -/* The function returns the exponent associated with X. */ - -/* $ Detailed_Input */ - -/* X is a double precision number that from which */ -/* a virtual decimal string should be created. */ - -/* FILL is the character to use for the leading character */ -/* in the virtual decimal string. */ - -/* $ Detailed_Output */ - -/* EXPONT is the value of the scientific notation */ -/* exponent associated with X. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This entry point is used to establish a virtual decimal string. */ -/* The companion entry point ZZVSBSTR is used to retrieve the */ -/* characters in the virtual string. */ - -/* $ Examples */ - -/* See the main entry point or the routine DPFMT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-SEP-1996 (WLT) */ - - -/* -& */ - *(unsigned char *)&myfill[0] = *(unsigned char *)fill; - dpstr_(x, &c__14, string, (ftnlen)30); - -/* Parse the exponent, string looks like the pattern presented */ -/* below: */ - -/* MAXSIG + 2 */ -/* | */ -/* v */ -/* by.xxxxxxxxxxxxxEsxxx */ -/* 1234567890123456789 */ -/* ^^ */ -/* || */ -/* |EFST = ESGN + 1 */ -/* | */ -/* ESGN = MAXSIG + 4 */ - - code0 = '0'; - blank = ' '; - minus = *(unsigned char *)&string[17] == '-'; - code = *(unsigned char *)&string[18]; - exp__ = code - code0; - i__ = 20; - code = *(unsigned char *)&string[i__ - 1]; - while(code != blank) { - exp__ = exp__ * 10 + (code - code0); - ++i__; - code = *(unsigned char *)&string[i__ - 1]; - } - if (minus) { - exp__ = -exp__; - } - *expont = exp__; - return 0; -/* $Procedure ZZVSBSTR ( Virtual String Character ) */ - -L_zzvsbstr: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Return the character from the specified SLOT of a virtual */ -/* decimal 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 */ - -/* ALPHANUMERIC, PRIVATE */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* INTEGER FROM */ -/* INTEGER TO */ -/* LOGICAL RND */ -/* CHARACTER*(*) SUBSTR */ -/* LOGICAL DID */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FROM I the index of the first character to retrieve */ -/* TO I the index of the last character to retrieve */ -/* RND I treat the virtual string as rounded string. */ -/* SUBSTR O Contents of virtual string from FROM to TO. */ -/* DID O is a leading zero a result of rounding. */ - -/* $ Detailed_Input */ - -/* FROM is the index in the virtual decimal string of the */ -/* first character that will be returned in SUBSTR. */ - -/* TO is the index in the virtual decimal string of the */ -/* last character that will be returned in SUBSTR. */ - -/* RND is a logical flag used to indicate that the output */ -/* string should represent the virtual decimal string */ -/* that results from rounding to the TO'th decimal */ -/* location. */ - - -/* $ Detailed_Output */ - -/* SUBSTR is we regard the virtual string as VIRTUL. Then */ -/* in FORTRAN notation SUBSTR = VIRTUL(FROM:TO) */ - -/* DID is a logical flag that is used to indicate that */ -/* the left most character returned by ZZVSBSTR became */ -/* a zero as a result of rounding up from 9. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This entry point retrieves a specified character from the */ -/* virtual decimal string that was established by the last */ -/* call to the entry point ZZVSTSTR. */ - -/* $ Examples */ - -/* See the main entry point or the routine DPFMT. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 12-SEP-1996 (WLT) */ - - -/* -& */ - -/* The buffered numeric string has the form: */ - -/* by.xxxxxxxxxxxxxEseee... */ -/* 123456789012345678901234 */ -/* 1 2 */ - -/* Ignoring the exponent we can regard this as being the */ -/* decimal equivalent of the number with the decimal point */ -/* in the wrong position. We'll need to remedy this. */ - -/* by.xxxxxxxxxxxxx */ -/* 1234567890123456 */ -/* 1 */ - -/* We can think of this decimal representation as being a */ -/* simplification of the "infinite string" representation */ -/* below. */ - -/* b y . x x x */ -/* d-4 d-3 d-2 d-1 d00 p d01 d02 ... d13 0 0 0 0 */ -/* -2 -1 0 1 2 3 4 5 16 */ - - -/* From this its clear that i'th digit can be easily computed */ -/* via following decision block. */ - - -/* if ( i .lt. 0 ) then */ -/* digit = '0' */ -/* else if ( i .eq. 0 ) then */ -/* digit = string(2:2) */ -/* else if ( i .lt. maxsig ) then */ -/* digit = string(i+3:i+3) */ -/* else */ -/* digit = '0' */ -/* end if */ - -/* To have an accurate representation of the number (one that */ -/* accounts for the exponent) we shift the decimal point ('p') */ -/* "right" by EXP slots. (If EXP is negative we shift right a */ -/* negative number of slots). In the sequence of characters the */ -/* decimal point will follow d_EXP. */ - -/* IF we renumber the slots so that the decimal point is in */ -/* slot 0 then for S < 0 slot S contains digit d_EXP+1+S */ - -/* For S > 0 slot S contains digit d_EXP+S */ - -/* Combining these observations we can compute the SLOT'th character */ -/* of the virtual string as follows. */ - - -/* If the character requested is character zero of the virtual */ -/* string, we just get the decimal point. */ - -/* If the character requested is in a slot whose index is */ -/* greater than zero it is to the */ -/* right of the decimal point so it must be D_exp+slot. */ - -/* If the character requested is in a slot whose index is negative */ -/* it is to the left of the decimal point. Since the slot */ -/* just to the left of the decimal point contains D_exp it follows */ -/* by induction that for any negative slot, the decimal is */ -/* D_exp+slot+1 */ - - -/* Since we may need to round the output, we will work from right */ -/* to left. First thing we do is get the index of the right most */ -/* significant portion of SUBSTR that we will manipulate. */ - - j = *to - *from + 1; - lsub = i_len(substr, substr_len); - -/* Blank pad to the right of J (if there's anything to pad). */ - - if (j < lsub) { - i__1 = j; - s_copy(substr + i__1, " ", substr_len - i__1, (ftnlen)1); - } - -/* If we need to round the output string, locate the first numeric */ -/* slot after TO. */ - - if (*rnd) { - slot = *to + 1; - -/* If this points to the decimal point, move one more to the */ -/* right. */ - - if (slot == 0) { - ++slot; - } - -/* Determine which digit D_i corresponds to SLOT. */ - - if (slot < 0) { - i__ = exp__ + slot + 1; - } else { - i__ = exp__ + slot; - } - -/* We will need to round in D_i is 5 or more. */ - - if (i__ < 0) { - *(unsigned char *)letter = '0'; - } else if (i__ == 0) { - *(unsigned char *)letter = *(unsigned char *)&string[1]; - } else if (i__ < 14) { - i__1 = i__ + 2; - s_copy(letter, string + i__1, (ftnlen)1, i__ + 3 - i__1); - } else { - *(unsigned char *)letter = '0'; - } - incr = l_ge(letter, "5", (ftnlen)1, (ftnlen)1); - } else { - incr = FALSE_; - } - -/* Starting at the right most slot, we work left incrementing */ -/* digits as required. Note that once we don't round up */ -/* some value, we are done incrementing. */ - - i__1 = *from; - for (slot = *to; slot >= i__1; --slot) { - if (slot == 0) { - *(unsigned char *)letter = '.'; - } else { - -/* Otherwise we need to first see which digit, d_I, is being */ -/* requested. */ - - if (slot < 0) { - i__ = exp__ + slot + 1; - } else { - i__ = exp__ + slot; - } - -/* Now just look up d_I according to the rule we established */ -/* earlier. */ - - if (i__ < 0) { - -/* If the SLOT is prior to the first significant character */ -/* or the virtual string, we use the fill character. */ -/* Otherwise we use a zero. */ - - if (incr) { - *(unsigned char *)letter = '1'; - incr = FALSE_; - } else { - if (slot < -1) { - *(unsigned char *)letter = *(unsigned char *)&myfill[ - 0]; - } else { - *(unsigned char *)letter = '0'; - } - } - } else if (i__ == 0) { - *(unsigned char *)letter = *(unsigned char *)&string[1]; - -/* If necessary, increment LETTER. */ - - if (incr) { - value = *(unsigned char *)letter - code0 + 1; - -/* If value is 10 or more we will need to */ -/* increment the next character too. If VALUE */ -/* is less than 10, we are done incrementing set */ -/* INCR to NO. */ - - if (value == 10) { - *(unsigned char *)letter = '0'; - } else { - *(unsigned char *)letter = (char) (value + code0); - incr = FALSE_; - } - } - } else if (i__ < 14) { - -/* This case is virtually identical to the previous */ -/* case, except that we need to pick off a different */ -/* letter from STRING. */ - - i__2 = i__ + 2; - s_copy(letter, string + i__2, (ftnlen)1, i__ + 3 - i__2); - if (incr) { - value = *(unsigned char *)letter - code0 + 1; - if (value == 10) { - *(unsigned char *)letter = '0'; - } else { - *(unsigned char *)letter = (char) (value + code0); - incr = FALSE_; - } - } - } else { - *(unsigned char *)letter = '0'; - incr = FALSE_; - } - } - if (j <= lsub) { - *(unsigned char *)&substr[j - 1] = *(unsigned char *)letter; - } - --j; - } - *did = incr; - return 0; -} /* zzvstrng_ */ - -/* Subroutine */ int zzvstrng_(doublereal *x, char *fill, integer *from, - integer *to, logical *rnd, integer *expont, char *substr, logical * - did, ftnlen fill_len, ftnlen substr_len) -{ - return zzvstrng_0_(0, x, fill, from, to, rnd, expont, substr, did, - fill_len, substr_len); - } - -/* Subroutine */ int zzvststr_(doublereal *x, char *fill, integer *expont, - ftnlen fill_len) -{ - return zzvstrng_0_(1, x, fill, (integer *)0, (integer *)0, (logical *)0, - expont, (char *)0, (logical *)0, fill_len, (ftnint)0); - } - -/* Subroutine */ int zzvsbstr_(integer *from, integer *to, logical *rnd, char - *substr, logical *did, ftnlen substr_len) -{ - return zzvstrng_0_(2, (doublereal *)0, (char *)0, from, to, rnd, (integer - *)0, substr, did, (ftnint)0, substr_len); - } - diff --git a/ext/spice/src/cspice/zzwahr.c b/ext/spice/src/cspice/zzwahr.c deleted file mode 100644 index 28c11ebc82..0000000000 --- a/ext/spice/src/cspice/zzwahr.c +++ /dev/null @@ -1,470 +0,0 @@ -/* zzwahr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b2 = 360.; - -/* $Procedure ZZWAHR ( SPICELIB private version of Newhalls' WAHR ) */ -/* Subroutine */ int zzwahr_(doublereal *et, doublereal *dvnut) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer matrix[954] /* was [9][106] */ = { 0,0,0,0,1,-171996, - -1742,92025,89,0,0,0,0,2,2062,2,-895,5,-2,0,2,0,1,46,0,-24,0,2,0, - -2,0,0,11,0,0,0,-2,0,2,0,2,-3,0,1,0,1,-1,0,-1,0,-3,0,0,0,0,-2,2, - -2,1,-2,0,1,0,2,0,-2,0,1,1,0,0,0,0,0,2,-2,2,-13187,-16,5736,-31,0, - 1,0,0,0,1426,-34,54,-1,0,1,2,-2,2,-517,12,224,-6,0,-1,2,-2,2,217, - -5,-95,3,0,0,2,-2,1,129,1,-70,0,2,0,0,-2,0,48,0,1,0,0,0,2,-2,0, - -22,0,0,0,0,2,0,0,0,17,-1,0,0,0,1,0,0,1,-15,0,9,0,0,2,2,-2,2,-16, - 1,7,0,0,-1,0,0,1,-12,0,6,0,-2,0,0,2,1,-6,0,3,0,0,-1,2,-2,1,-5,0,3, - 0,2,0,0,-2,1,4,0,-2,0,0,1,2,-2,1,4,0,-2,0,1,0,0,-1,0,-4,0,0,0,2,1, - 0,-2,0,1,0,0,0,0,0,-2,2,1,1,0,0,0,0,1,-2,2,0,-1,0,0,0,0,1,0,0,2,1, - 0,0,0,-1,0,0,1,1,1,0,0,0,0,1,2,-2,0,-1,0,0,0,0,0,2,0,2,-2274,-2, - 977,-5,1,0,0,0,0,712,1,-7,0,0,0,2,0,1,-386,-4,200,0,1,0,2,0,2, - -301,0,129,-1,1,0,0,-2,0,-158,0,-1,0,-1,0,2,0,2,123,0,-53,0,0,0,0, - 2,0,63,0,-2,0,1,0,0,0,1,63,1,-33,0,-1,0,0,0,1,-58,-1,32,0,-1,0,2, - 2,2,-59,0,26,0,1,0,2,0,1,-51,0,27,0,0,0,2,2,2,-38,0,16,0,2,0,0,0, - 0,29,0,-1,0,1,0,2,-2,2,29,0,-12,0,2,0,2,0,2,-31,0,13,0,0,0,2,0,0, - 26,0,-1,0,-1,0,2,0,1,21,0,-10,0,-1,0,0,2,1,16,0,-8,0,1,0,0,-2,1, - -13,0,7,0,-1,0,2,2,1,-10,0,5,0,1,1,0,-2,0,-7,0,0,0,0,1,2,0,2,7,0, - -3,0,0,-1,2,0,2,-7,0,3,0,1,0,2,2,2,-8,0,3,0,1,0,0,2,0,6,0,0,0,2,0, - 2,-2,2,6,0,-3,0,0,0,0,2,1,-6,0,3,0,0,0,2,2,1,-7,0,3,0,1,0,2,-2,1, - 6,0,-3,0,0,0,0,-2,1,-5,0,3,0,1,-1,0,0,0,5,0,0,0,2,0,2,0,1,-5,0,3, - 0,0,1,0,-2,0,-4,0,0,0,1,0,-2,0,0,4,0,0,0,0,0,0,1,0,-4,0,0,0,1,1,0, - 0,0,-3,0,0,0,1,0,2,0,0,3,0,0,0,1,-1,2,0,2,-3,0,1,0,-1,-1,2,2,2,-3, - 0,1,0,-2,0,0,0,1,-2,0,1,0,3,0,2,0,2,-3,0,1,0,0,-1,2,2,2,-3,0,1,0, - 1,1,2,0,2,2,0,-1,0,-1,0,2,-2,1,-2,0,1,0,2,0,0,0,1,2,0,-1,0,1,0,0, - 0,2,-2,0,1,0,3,0,0,0,0,2,0,0,0,0,0,2,1,2,2,0,-1,0,-1,0,0,0,2,1,0, - -1,0,1,0,0,-4,0,-1,0,0,0,-2,0,2,2,2,1,0,-1,0,-1,0,2,4,2,-2,0,1,0, - 2,0,0,-4,0,-1,0,0,0,1,1,2,-2,2,1,0,-1,0,1,0,2,2,1,-1,0,1,0,-2,0,2, - 4,2,-1,0,1,0,-1,0,4,0,2,1,0,0,0,1,-1,0,-2,0,1,0,0,0,2,0,2,-2,1,1, - 0,-1,0,2,0,2,2,2,-1,0,0,0,1,0,0,2,1,-1,0,0,0,0,0,4,-2,2,1,0,0,0,3, - 0,2,-2,2,1,0,0,0,1,0,2,-2,0,-1,0,0,0,0,1,2,0,1,1,0,0,0,-1,-1,0,2, - 1,1,0,0,0,0,0,-2,0,1,-1,0,0,0,0,0,2,-1,2,-1,0,0,0,0,1,0,2,0,-1,0, - 0,0,1,0,-2,-2,0,-1,0,0,0,0,-1,2,0,1,-1,0,0,0,1,1,0,-2,1,-1,0,0,0, - 1,0,-2,2,0,-1,0,0,0,2,0,0,2,0,1,0,0,0,0,0,2,4,2,-1,0,0,0,0,1,0,1, - 0,1,0,0,0 }; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double d_mod(doublereal *, doublereal *), cos(doublereal), sin(doublereal) - ; - - /* Local variables */ - static doublereal dddj; - static integer i__, j; - static doublereal t, angle[5], rasec, factr, angrt[5], argrt, d0, d1, d2, - d3, f0, f1, f2, f3, l0, l1, l2, l3; - extern doublereal twopi_(void); - static doublereal ce, dd, dj, cl; - extern doublereal pi_(void); - static doublereal radian, cosang, oneday, sinang, dd2, mg0, mg1, dtwopi, - mg2, mg3, lp0, lp1, lp2, lp3, arg, dpi; - extern doublereal spd_(void); - -/* $ Abstract */ - -/* Calculates nutation angles delta psi and delta epsilon, and */ -/* their rates of change, referred to the ecliptic of date, from */ -/* the wahr series (Table 1,'Proposal to the IAU Working Group */ -/* on Nutation', John M. Wahr and Martin L. Smith 1979) */ - -/* $ 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 */ - -/* NUTATIONS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ET I Ephemeris Time for which nutations are sought */ -/* DVNUT O Nutation angles and their rates. */ - -/* $ Detailed_Input */ - -/* ET is the epoch for which nutation angles are being */ -/* requested expressed in TDB seconds past the epoch */ -/* of J2000. */ - -/* $ Detailed_Output */ - -/* DVNUT are the nutation angles and their derivatives. */ -/* Following the notation on page 112 of the */ -/* Explanatory Supplement to the Astronomical */ -/* Almanac we have */ - -/* DVNUT(1) = Psi------nutation in longitude (radians) */ -/* DVNUT(2) = Epsilon--nutation in obliquity (radians) */ -/* DVNUT(3) = dPsi/dt (radians/second) */ -/* DVNUT(4) = dEpsilon/dt (radians/second) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine computes the angles required for computing the */ -/* transformation from the mean of date frame for the earth */ -/* to the true of date frame of the earth. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* Explanatory Supplement to the Astronomical Almanac edited */ -/* by P. Kenneth Siedelmann. (1992) (University Science */ -/* Books, Mill Valley CA) pp. 111-116 */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 15-JUL-1997 (WLT) */ - -/* This routine was adapted from a routine provided by */ -/* Skip Newhall. Skip's notes indicate that he obtained this */ -/* from Jay Lieske and Mylse Standish. The actual notes */ -/* from the original routine WAHR are given here. */ - -/* Lieske 3/91. NUTATION in the IAU J2000 system. Univac */ -/* version obtained from Myles Standish, (subroutine WAHR) */ -/* who had obtained it from USNO. Re-ordered terms to match */ -/* Astronomical Almanac 1984 table S23-S25 and corrected */ -/* the rate for dPsi in the 0 0 2 -2 2 term. Eliminated */ -/* the equivalences, common block and added necessary SAVEs. */ -/* Corrected the fundamental angles (L, L', F, D, Node) to */ -/* match Almanac. */ - -/* In the current routine the various angles L, L', F, D, and */ -/* Node (MG) are computed using the actual values given */ -/* in the Explanatory Supplement. */ - -/* Note that there is an error in the Explanatory supplement */ -/* for the Node term. The Explanatory Supplement (page 114) has */ - -/* OMEGA = 135 degrees 2 minutes 40.280 seconds */ -/* + etc. */ - -/* The correct formulation should be: */ - -/* OMEGA = 125 degrees 2 minutes 40.280 seconds */ -/* + etc. */ - -/* This is the value used in this routine. The verification of */ -/* this error is courtesy of Myles Standish. */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Parameters */ - -/* NTERM is the number of SIN and COSINE terms used in the */ -/* computation of Delta Psi and Delta epsilon */ - - -/* The parameters below stand for */ - -/* revolutions */ -/* degrees */ -/* minutes */ -/* seconds */ -/* julian century */ -/* julian century ** 2 */ -/* julian century ** 3 */ - -/* These parameters are needed for converting the quantities */ -/* on page 114 of the Explanatory supplement from revolutions, */ -/* degrees, minutes and seconds / century, century**2 and century**3 */ -/* to degrees, degrees/day, degrees/(0.0001 days)**2 and */ -/* degress/(0.0001 days)**3. */ - - -/* The next set of parameters is an enumeration of the various */ -/* angles needed in the computation of nutations. */ - - -/* Local Variables. */ - - -/* Below are the coefficients for the various periods of the */ -/* nutation model. There does not appear to be any particular reason */ -/* for the ordering selected. The n'th row corresponds to the n'th */ -/* period listed above each data statement. */ - -/* >> Periods: 6798.4, 3399.2, 1305.5, 1095.2, 1615.7, 3232.9, 6786.3, */ -/* 943.2, 182.6, 365.3, 121.7, 365.2, 177.8, 205.9, */ -/* 173.3, 182.6, 386.0, 91.3, 346.6 */ - - -/* Periods: 199.8, 346.6, 212.3, 119.6, 411.8, 131.7, 169.0, 329.8, */ -/* 409.2, 388.3, 117.5, 13.7, 27.6, 13.6, 9.1, 31.8, */ -/* 27.1, 14.8, 27.7 */ - - -/* Periods: 27.4, 9.6, 9.1, 7.1, 13.8, 23.9, 6.9, 13.6, 27.0, 32.0, */ -/* 31.7, 9.5, 34.8, 13.2, 14.2, 5.6, 9.6, 12.8, 14.8 */ - - -/* Periods: 7.1, 23.9, 14.7, 29.8, 6.9, 15.4, 26.9, 29.5, 25.6, 9.1, */ -/* 9.4, 9.8, 13.7, 5.5, 7.2, 8.9, 32.6, 13.8, 27.8 */ - -/* Periods: 9.2, 9.3, 27.3, 10.1, 14.6, 5.8, 15.9, 22.5, 5.6, */ -/* 7.3, 9.1, 29.3, 12.8, 4.7, 9.6, 12.7, 8.7, 23.8, */ -/* 13.1 */ - -/* Periods: 35.0, 13.6, 25.4, 14.2, 9.5, 14.2, 34.7, 32.8, 7.1, 4.8, */ -/* 27.3 */ - if (first) { - first = FALSE_; - dpi = pi_(); - dtwopi = twopi_(); - radian = 180. / dpi; - rasec = radian * 3600.; - factr = rasec * 1e4; - oneday = spd_(); - -/* The following values are direct conversions to degrees from */ -/* page 114 of the Explanatory Supplement to the Astronomical */ -/* Almanac. */ - -/* L0 through L3 are the coefficients for l---the mean longitude */ -/* of the Moon minus the mean longitude of the Moon's perigee. */ -/* Units for the various terms: */ - -/* L0 degrees */ -/* L1 degrees/day */ -/* L2 degrees/(0.0001 days)**2 */ -/* L3 degrees/(0.0001 days)**3 */ - - l0 = 134.96298138888886; - l1 = 13.064992947243136; - l2 = 6.5192872572139397e-4; - l3 = 3.6484365631332527e-7; - -/* LP0 through LP3 are the coefficients for l'---the mean */ -/* longitude of the Sun minus the mean longitude of the Sun's */ -/* perigee. Units for the various terms: */ - -/* LP0 degrees */ -/* LP1 degrees/day */ -/* LP2 degrees/(0.0001 days)**2 */ -/* LP3 degrees/(0.0001 days)**3 */ - - lp0 = 357.52772333333331; - lp1 = .98560028309377146; - lp2 = -1.201414483363923e-5; - lp3 = -6.8408185558748495e-8; - -/* F0 through F3 are the coefficients for F---the mean longitude */ -/* of the Moon minus the mean longitude of the Moon's node. Units */ -/* for the various terms: */ - -/* F0 degrees */ -/* F1 degrees/day */ -/* F2 degrees/(0.0001 days)**2 */ -/* F3 degrees/(0.0001 days)**3 */ - - f0 = 93.271910277777778; - f1 = 13.229350240603848; - f2 = -2.760338267929901e-4; - f3 = 6.2707503428852773e-8; - -/* D0 through D3 are the coefficients for D---the mean longitude */ -/* of the Moon minus the mean longitude of the Sun. Units */ -/* for the various terms: */ - -/* D0 degrees */ -/* D1 degrees/day */ -/* D2 degrees/(0.0001 days)**2 */ -/* D3 degrees/(0.0001 days)**3 */ - - d0 = 297.85036305555559; - d1 = 12.190749116495549; - d2 = -1.4348262053484912e-4; - d3 = 1.0831296046801845e-7; - -/* MG0 through MG3 are the coefficients for Omega---the longitude */ -/* of the mean ascending node of the lunar orbit on the ecliptic */ -/* measured from the mean equinox of date. NOTE: The constant */ -/* term MG0 is correct. The value */ -/* o */ -/* 135 02' 40".280 */ - -/* given in the Explanatory Supplement page 114 has a typo. The */ -/* correct value is the one used here: */ - -/* o */ -/* 125 02' 40".280 */ - -/* MG0 degrees */ -/* MG1 degrees/day */ -/* MG2 degrees/(0.0001 days)**2 */ -/* MG3 degrees/(0.0001 days)**3 */ - - mg0 = 125.04452222222223; - mg1 = -.052953764841432813; - mg2 = 1.5522608272925558e-4; - mg3 = 4.5605457039165659e-8; - } - -/* Compute all of the various time components. DJ is the delta */ -/* in the Julian date from the J2000 epoch. */ - - dj = *et / oneday; - dd = dj / 1e4; - dddj = dd / 1e4; - dd2 = dd * dd; - t = dj / 365250.; - -/* Now compute all of the various angles and their rates */ -/* at the current epoch */ - - angle[0] = l0 + dj * l1 + (l2 + dd * l3) * dd2; - angle[1] = lp0 + dj * lp1 + (lp2 + dd * lp3) * dd2; - angle[2] = f0 + dj * f1 + (f2 + dd * f3) * dd2; - angle[3] = d0 + dj * d1 + (d2 + dd * d3) * dd2; - angle[4] = mg0 + dj * mg1 + (mg2 + dd * mg3) * dd2; - angrt[0] = l1 + dddj * (l2 * 2. + dd * 3. * l3); - angrt[1] = lp1 + dddj * (lp2 * 2. + dd * 3. * lp3); - angrt[2] = f1 + dddj * (f2 * 2. + dd * 3. * f3); - angrt[3] = d1 + dddj * (d2 * 2. + dd * 3. * d3); - angrt[4] = mg1 + dddj * (mg2 * 2. + dd * 3. * mg3); - -/* Wrap all of the angles and rates to range from 0 to 360, then */ -/* convert to radians. */ - - for (j = 1; j <= 5; ++j) { - angle[(i__1 = j - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("angle", i__1, - "zzwahr_", (ftnlen)570)] = d_mod(&angle[(i__2 = j - 1) < 5 && - 0 <= i__2 ? i__2 : s_rnge("angle", i__2, "zzwahr_", (ftnlen) - 570)], &c_b2); - angrt[(i__1 = j - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("angrt", i__1, - "zzwahr_", (ftnlen)571)] = d_mod(&angrt[(i__2 = j - 1) < 5 && - 0 <= i__2 ? i__2 : s_rnge("angrt", i__2, "zzwahr_", (ftnlen) - 571)], &c_b2); - angle[(i__1 = j - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("angle", i__1, - "zzwahr_", (ftnlen)573)] = angle[(i__2 = j - 1) < 5 && 0 <= - i__2 ? i__2 : s_rnge("angle", i__2, "zzwahr_", (ftnlen)573)] / - radian; - angrt[(i__1 = j - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("angrt", i__1, - "zzwahr_", (ftnlen)574)] = angrt[(i__2 = j - 1) < 5 && 0 <= - i__2 ? i__2 : s_rnge("angrt", i__2, "zzwahr_", (ftnlen)574)] / - radian; - } - -/* Zero out the components of the nutation array */ - - for (j = 1; j <= 4; ++j) { - dvnut[(i__1 = j - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("dvnut", i__1, - "zzwahr_", (ftnlen)580)] = 0.; - } - -/* Now we accumulate the various terms of Delta Psi and Delta */ -/* epsilon as expressed on page 115 of the Green Book */ -/* (Explanatory Supplement to the Astronomical Almanac). */ - - for (i__ = 1; i__ <= 106; ++i__) { - arg = 0.; - argrt = 0.; - for (j = 1; j <= 5; ++j) { - if (matrix[(i__1 = j + i__ * 9 - 10) < 954 && 0 <= i__1 ? i__1 : - s_rnge("matrix", i__1, "zzwahr_", (ftnlen)593)] != 0) { - arg += matrix[(i__1 = j + i__ * 9 - 10) < 954 && 0 <= i__1 ? - i__1 : s_rnge("matrix", i__1, "zzwahr_", (ftnlen)594)] - * angle[(i__2 = j - 1) < 5 && 0 <= i__2 ? i__2 : - s_rnge("angle", i__2, "zzwahr_", (ftnlen)594)]; - argrt += matrix[(i__1 = j + i__ * 9 - 10) < 954 && 0 <= i__1 ? - i__1 : s_rnge("matrix", i__1, "zzwahr_", (ftnlen)595) - ] * angrt[(i__2 = j - 1) < 5 && 0 <= i__2 ? i__2 : - s_rnge("angrt", i__2, "zzwahr_", (ftnlen)595)]; - arg = d_mod(&arg, &dtwopi); - } - } - cl = (doublereal) matrix[(i__1 = i__ * 9 - 4) < 954 && 0 <= i__1 ? - i__1 : s_rnge("matrix", i__1, "zzwahr_", (ftnlen)600)]; - if (matrix[(i__1 = i__ * 9 - 3) < 954 && 0 <= i__1 ? i__1 : s_rnge( - "matrix", i__1, "zzwahr_", (ftnlen)602)] != 0) { - cl += matrix[(i__1 = i__ * 9 - 3) < 954 && 0 <= i__1 ? i__1 : - s_rnge("matrix", i__1, "zzwahr_", (ftnlen)603)] * t; - } - ce = (doublereal) matrix[(i__1 = i__ * 9 - 2) < 954 && 0 <= i__1 ? - i__1 : s_rnge("matrix", i__1, "zzwahr_", (ftnlen)606)]; - if (matrix[(i__1 = i__ * 9 - 1) < 954 && 0 <= i__1 ? i__1 : s_rnge( - "matrix", i__1, "zzwahr_", (ftnlen)608)] != 0) { - ce += matrix[(i__1 = i__ * 9 - 1) < 954 && 0 <= i__1 ? i__1 : - s_rnge("matrix", i__1, "zzwahr_", (ftnlen)609)] * t; - } - cosang = cos(arg); - sinang = sin(arg); - dvnut[0] += cl * sinang / factr; - dvnut[1] += ce * cosang / factr; - dvnut[2] += cl * cosang * argrt / factr; - dvnut[3] -= ce * sinang * argrt / factr; - } - -/* Finally convert DVNUT(3) and DVNUT(4) to radians/second */ - - dvnut[2] /= oneday; - dvnut[3] /= oneday; - return 0; -} /* zzwahr_ */ - diff --git a/ext/spice/src/cspice/zzwind.c b/ext/spice/src/cspice/zzwind.c deleted file mode 100644 index 672673c723..0000000000 --- a/ext/spice/src/cspice/zzwind.c +++ /dev/null @@ -1,394 +0,0 @@ -/* zzwind.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZWIND ( Find winding number of polygon about point ) */ -integer zzwind_(doublereal *plane, integer *n, doublereal *vertcs, doublereal - *point) -{ - /* System generated locals */ - integer ret_val, i__1; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - doublereal rvec[3], cons; - extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, - doublereal *); - extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * - ), vequ_(doublereal *, doublereal *); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal rperp[3], vtemp[3]; - extern /* Subroutine */ int vperp_(doublereal *, doublereal *, doublereal - *), ucrss_(doublereal *, doublereal *, doublereal *); - doublereal rnext[3]; - extern doublereal twopi_(void); - extern logical vzero_(doublereal *); - extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, - doublereal *); - doublereal atotal, normal[3]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int vminus_(doublereal *, doublereal *); - doublereal sep; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the winding number of a planar polygon, embedded in */ -/* 3-dimensional space, about a specified point. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PLANE I A SPICELIB plane. */ -/* N I Number of vertices of polygon. */ -/* VERTCS I Vertices of polygon. */ -/* POINT I Point in PLANE. */ -/* UBPL P Upper bound of SPICELIB plane array. */ - -/* The function returns the winding number of the input polygon */ -/* about the input point. */ - -/* $ Detailed_Input */ - -/* PLANE is a SPICELIB plane containing a polygon and */ -/* a point. */ - -/* N, */ -/* VERTCS are, respectively, the number vertices defining */ -/* the polygon and the vertices themselves. Each */ -/* pair of consecutive vectors in the array VERTCS */ -/* defines an edge of the polygon. */ - -/* POINT is a point lying in PLANE; the winding number */ -/* of the polygon about POINT is sought. */ - -/* $ Detailed_Output */ - -/* The function returns the winding number of the input polygon */ -/* about the input point. The winding number measures the "net" */ -/* number of times the polygon wraps around POINT: this is */ -/* the number of times the polygon wraps around POINT in the */ -/* counterclockwise sense minus the number of times the polygon */ -/* wraps around POINT in the clockwise sense. */ - -/* The possible values and meanings of the winding number are: */ - -/* ZZWIND > 0: The polygon winds about POINT a total */ -/* of ZZWIND times in the counterclockwise */ -/* direction. */ - -/* POINT is inside the polygon. */ - - -/* ZZWIND < 0: The polygon winds about POINT a total */ -/* of ZZWIND times in the clockwise */ -/* direction. */ - -/* POINT is inside the polygon. */ - - -/* ZZWIND = 0: The number of times the polygon wraps around */ -/* POINT in the counterclockwise sense is equal */ -/* to the number of times the polygon wraps around */ -/* POINT in the clockwise sense. */ - -/* POINT is outside the polygon. */ - -/* $ Parameters */ - -/* UBPL is the array upper bound for SPICELIB planes. */ - -/* $ Exceptions */ - - -/* 1) If the number of boundary vectors N is not at least 3, */ -/* or if the number exceeds MAXFOV, the error */ -/* SPICE(INVALIDCOUNT) will be signaled. */ - -/* 2) The input point and vertices are expected to lie in */ -/* the input plane. To avoid problems introduced by */ -/* round-off errors, all of these vectors are projected */ -/* orthogonally onto the plane before the winding number */ -/* is computed. If the input point or vertices are "far" */ -/* from the input plane, no error will be signaled. */ - -/* 3) If the input plane as a zero normal vector, the error */ -/* SPICE(ZEROVECTOR) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Find the winding number of a 3-D polygon about a specified */ -/* point. Although in principle the polygon is two-dimensional, */ -/* it is embedded in 3-space. */ - -/* This routine supports determination of whether an ellipsoidal */ -/* body is in the field of view of a remote-sensing instrument */ -/* with a field of view having polygonal cross section. */ - -/* The winding number is actually defined for closed, piecewise */ -/* differentiable curves in the complex plane. If z(t), t in */ -/* [0, 2*Pi], is a parameterization of such a curve, then if the */ -/* symbol I is used to represent the integration operator, z0 is the */ -/* complex point of interest, and w is the winding number, we have */ - -/* w = ( argument of z(2*pi) - argument of z(0) ) / (2*pi) */ - -/* = (1/i) * ( log( z(2*pi)-z0 ) - log( z(0)-z0 ) ) / (2*pi) */ - -/* Note the above is true because the curve is closed, so the real */ -/* parts of the logarithms cancel. Then */ - -/* 1 */ -/* w = ------- * I ( d ( log(z-z0) ) ) */ -/* 2*Pi*i z(t) */ - - -/* 1 */ -/* = ------- * I ( ( 1 / (z-z0) ) dz ) */ -/* 2*Pi*i z(t) */ - - -/* Because of Cauchy's theorem, we can transform the problem, */ -/* without loss of generality (leaving out *many* steps here), to */ -/* one for which the curve has the simple form */ - -/* i n*(t-t0) */ -/* z(t) = z0 + r e */ - -/* for some real values r, n, and t0. So */ - - -/* 1 */ -/* w = ------- * I ( 1 / (z-z0) ) */ -/* 2*Pi*i z(t) */ - - -/* 1 t=2*pi i n*(t-t0) i n*(t-t0) */ -/* = ------- * I ( (1/r e ) * ( r i n e )dt ) */ -/* 2*Pi*i t=0 */ - - -/* 1 t=2*pi */ -/* = ------- * I ( i n dt ) */ -/* 2*Pi*i t=0 */ - -/* 1 */ -/* = ------ * ( 2 * Pi * i * n ) */ -/* 2*Pi*i */ - - -/* = n */ - - -/* Given the simplified form of z(t) we've chosen, it's now clear */ -/* that n is the winding number. */ - -/* In the simple case of a polygonal curve, the integral can */ -/* be computed from the original definition of the winding number: */ - -/* w = ( argument of z(2*pi) - argument of z(0) ) / (2*pi) */ - -/* The difference of arguments */ - -/* argument of z(2*pi) - argument of z(0) */ - -/* can be expressed as the telescoping sum */ - -/* N */ -/* ___ */ -/* \ */ -/* / ( argument of vertex(i+1) - argument of vertex(i) ) */ -/* --- */ -/* i=1 */ - -/* where vertex N+1 is considered identical to vertex 1. */ - - -/* $ Examples */ - -/* See usage in ZZELVUPY. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 11-AUG-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find winding number of polygon about point */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Initialize the function return value. */ - - ret_val = 0; - if (return_()) { - return ret_val; - } - chkin_("ZZWIND", (ftnlen)6); - -/* Check the number of sides of the polygon. */ - - if (*n < 3) { - setmsg_("Polygon must have at least 3 sides; N = #.", (ftnlen)42); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZWIND", (ftnlen)6); - return ret_val; - } - -/* Unpack the plane's normal and constant. */ - - pl2nvc_(plane, normal, &cons); - -/* Check the normal vector. */ - - if (vzero_(normal)) { - setmsg_("Plane's normal vector is zero.", (ftnlen)30); - sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); - chkout_("ZZWIND", (ftnlen)6); - return ret_val; - } - -/* We want the normal vector to point on the same side of the */ -/* plane as the boundary vectors. Negate the normal */ -/* if necessary to make this true. We don't touch CONS because */ -/* it's not used later, but in principle it should be negated. */ - - if (vdot_(normal, vertcs) < 0.) { - vminus_(normal, vtemp); - vequ_(vtemp, normal); - } - -/* Find the angular argument of each point; find the difference */ -/* of this angle from the preceding angle; add the difference to */ -/* the total. */ - - vsub_(vertcs, point, vtemp); - -/* Get the component RVEC of the difference vector orthogonal to */ -/* the plane's normal vector. */ - - vperp_(vtemp, normal, rvec); - -/* The total "wrap angle" starts at zero. */ - - atotal = 0.; - i__1 = *n + 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (i__ <= *n) { - j = i__; - } else { - j = 1; - } - -/* Find the angular separation of RVEC and the next vector */ -/* RNEXT. */ - - vsub_(&vertcs[j * 3 - 3], point, vtemp); - vperp_(vtemp, normal, rnext); - sep = vsep_(rnext, rvec); - -/* Create a normal vector to RVEC by rotating RVEC pi/2 radians */ -/* counterclockwise. We'll use this vector RPERP to determine */ -/* whether the next point is reached by clockwise or */ -/* counterclockwise rotation from RVEC. */ - - ucrss_(normal, rvec, rperp); - if (vdot_(rnext, rperp) >= 0.) { - -/* RNEXT is reached by counterclockwise rotation from */ -/* RVEC. Note that in the case of zero rotation, the */ -/* sign doesn't matter because the contribution is zero. */ - - atotal += sep; - } else { - atotal -= sep; - } - -/* Update RVEC. */ - - vequ_(rnext, rvec); - } - -/* The above sum is 2 * pi * . Let ZZWIND be the wrap count. */ - - d__1 = atotal / twopi_(); - ret_val = i_dnnt(&d__1); - chkout_("ZZWIND", (ftnlen)6); - return ret_val; -} /* zzwind_ */ - diff --git a/ext/spice/src/cspice/zzwind2d.c b/ext/spice/src/cspice/zzwind2d.c deleted file mode 100644 index 288e485d75..0000000000 --- a/ext/spice/src/cspice/zzwind2d.c +++ /dev/null @@ -1,343 +0,0 @@ -/* zzwind2d.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure ZZWIND2D ( Find winding number of polygon about point ) */ -integer zzwind2d_(integer *n, doublereal *vertcs, doublereal *point) -{ - /* System generated locals */ - integer vertcs_dim2, ret_val, i__1, i__2; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *); - - /* Local variables */ - doublereal rvec[2]; - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, - integer *, doublereal *); - extern doublereal vdotg_(doublereal *, doublereal *, integer *), vsepg_( - doublereal *, doublereal *, integer *); - extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, - doublereal *); - doublereal rperp[2], rnext[2]; - extern doublereal twopi_(void); - doublereal atotal; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal sep; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Find the winding number of a planar polygon about a specified */ -/* point in 2-dimensional space. */ - -/* $ 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 */ - -/* PLANES */ - -/* $ Keywords */ - -/* GEOMETRY */ -/* MATH */ -/* PLANE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of vertices of polygon. */ -/* VERTCS I Vertices of polygon. */ -/* POINT I Point in PLANE. */ - -/* The function returns the winding number of the input polygon */ -/* about the input point. */ - -/* $ Detailed_Input */ - -/* N, */ -/* VERTCS are, respectively, the number vertices defining */ -/* the polygon and the vertices themselves. Each */ -/* pair of consecutive vectors in the array VERTCS */ -/* defines an edge of the polygon. */ - -/* $ Detailed_Output */ - -/* The function returns the winding number of the input polygon */ -/* about the input point. The winding number measures the "net" */ -/* number of times the polygon wraps around POINT: this is */ -/* the number of times the polygon wraps around POINT in the */ -/* counterclockwise sense minus the number of times the polygon */ -/* wraps around POINT in the clockwise sense. */ - -/* The possible values and meanings of the winding number are: */ - -/* ZZWIND2D > 0: The polygon winds about POINT a total */ -/* of ZZWIND2D times in the counterclockwise */ -/* direction. */ - -/* POINT is inside the polygon. */ - - -/* ZZWIND2D < 0: The polygon winds about POINT a total */ -/* of ZZWIND2D times in the clockwise */ -/* direction. */ - -/* POINT is inside the polygon. */ - - -/* ZZWIND2D = 0: The number of times the polygon wraps around */ -/* POINT in the counterclockwise sense is equal */ -/* to the number of times the polygon wraps around */ -/* POINT in the clockwise sense. */ - -/* POINT is outside the polygon. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of boundary vectors N is not at least 3, */ -/* or if the number exceeds MAXFOV, the error */ -/* SPICE(INVALIDCOUNT) will be signaled. */ - -/* 2) The input point and vertices are expected to lie in */ -/* the input plane. To avoid problems introduced by */ -/* round-off errors, all of these vectors are projected */ -/* orthogonally onto the plane before the winding number */ -/* is computed. If the input point or vertices are "far" */ -/* from the input plane, no error will be signaled. */ - -/* 3) If the input plane as a zero normal vector, the error */ -/* SPICE(ZEROVECTOR) will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Find the winding number of a 2-D polygon about a specified */ -/* point. */ - -/* This routine supports determination of whether an ellipsoidal */ -/* body is in the field of view of a remote-sensing instrument */ -/* with a field of view having polygonal cross section. */ - -/* The winding number is actually defined for closed, piecewise */ -/* differentiable curves in the complex plane. If z(t), t in */ -/* [0, 2*Pi], is a parameterization of such a curve, then if the */ -/* symbol I is used to represent the integration operator, z0 is the */ -/* complex point of interest, and w is the winding number, we have */ - -/* 1 */ -/* w = ------- * I ( d ( log(z-z0) ) ) */ -/* 2*Pi*i z(t) */ - - -/* 1 */ -/* = ------- * I ( ( 1 / (z-z0) ) dz ) */ -/* 2*Pi*i z(t) */ - - -/* Because of Cauchy's theorem, we can transform the problem, */ -/* without loss of generality (leaving out *many* steps here), to */ -/* one for which the curve has the simple form */ - -/* i n*(t-t0) */ -/* z(t) = z0 + r e */ - -/* for some real values r, n, and t0. So */ - - -/* 1 */ -/* w = ------- * I ( 1 / (z-z0) ) */ -/* 2*Pi*i z(t) */ - - -/* 1 t=2*pi i n*(t-t0) i n*(t-t0) */ -/* = ------- * I ( (1/r e ) * ( r i n e )dt ) */ -/* 2*Pi*i t=0 */ - - -/* 1 t=2*pi */ -/* = ------- * I ( i n dt ) */ -/* 2*Pi*i t=0 */ - -/* 1 */ -/* = ------ * ( 2 * Pi * i * n ) */ -/* 2*Pi*i */ - - -/* = n */ - - -/* Given the simplified form of z(t) we've chosen, it's now clear */ -/* that n is the winding number. */ - -/* In the simple case of a polygonal curve, the integral can be */ -/* computed for a corresponding polygon whose vertices have been */ -/* scaled to have equal magnitude; the integral can be expressed as */ -/* the telescoping sum */ - -/* N */ -/* ___ */ -/* \ */ -/* / ( argument of vertex(i+1) - argument of vertex(i) ) */ -/* --- */ -/* i=1 */ - -/* where vertex N+1 is considered have length identical to that of */ -/* vertex 1 and argument differing from that of vertex 1 by w*2*pi. */ - - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 08-JUL-2008 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* find winding number of polygon about point */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Initialize the function return value. */ - - /* Parameter adjustments */ - vertcs_dim2 = *n; - - /* Function Body */ - ret_val = 0; - if (return_()) { - return ret_val; - } - chkin_("ZZWIND2D", (ftnlen)8); - -/* Check the number of sides of the polygon. */ - - if (*n < 3) { - setmsg_("Polygon must have at least 3 sides; N = #.", (ftnlen)42); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21); - chkout_("ZZWIND2D", (ftnlen)8); - return ret_val; - } - -/* The total "wrap angle" starts at zero. */ - - atotal = 0.; - vsubg_(&vertcs[(i__1 = 0) < vertcs_dim2 << 1 ? i__1 : s_rnge("vertcs", - i__1, "zzwind2d_", (ftnlen)285)], point, &c__2, rvec); - i__1 = *n + 1; - for (i__ = 2; i__ <= i__1; ++i__) { - if (i__ <= *n) { - j = i__; - } else { - j = 1; - } - -/* Find the angular separation of RVEC and the next vector */ -/* RNEXT. */ - - vsubg_(&vertcs[(i__2 = (j << 1) - 2) < vertcs_dim2 << 1 && 0 <= i__2 ? - i__2 : s_rnge("vertcs", i__2, "zzwind2d_", (ftnlen)299)], - point, &c__2, rnext); - sep = vsepg_(rnext, rvec, &c__2); - -/* Create a normal vector to RVEC by rotating RVEC pi/2 radians */ -/* counterclockwise. We'll use this vector RPERP to determine */ -/* whether the next point is reached by clockwise or */ -/* counterclockwise rotation from RVEC. */ - - rperp[0] = -rvec[1]; - rperp[1] = rvec[0]; - if (vdotg_(rnext, rperp, &c__2) >= 0.) { - -/* RNEXT is reached by counterclockwise rotation from */ -/* RVEC. Note that in the case of zero rotation, the */ -/* sign doesn't matter because the contribution is zero. */ - - atotal += sep; - } else { - atotal -= sep; - } - -/* Update RVEC. */ - - moved_(rnext, &c__2, rvec); - } - -/* The above sum is 2 * pi * . Let ZZWIND2D be the wrap count. */ - - d__1 = atotal / twopi_(); - ret_val = i_dnnt(&d__1); - chkout_("ZZWIND2D", (ftnlen)8); - return ret_val; -} /* zzwind2d_ */ - diff --git a/ext/spice/src/cspice/zzwninsd.c b/ext/spice/src/cspice/zzwninsd.c deleted file mode 100644 index fbefe898de..0000000000 --- a/ext/spice/src/cspice/zzwninsd.c +++ /dev/null @@ -1,402 +0,0 @@ -/* zzwninsd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure ZZWNINSD ( Insert an interval into a DP window ) */ -/* Subroutine */ int zzwninsd_(doublereal *left, doublereal *right, char * - context, doublereal *window, ftnlen context_len) -{ - /* System generated locals */ - address a__1[3]; - integer i__1[3], i__2; - doublereal d__1, d__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - integer card, size, i__, j; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - char msg[1840]; - -/* $ Abstract */ - -/* Insert an interval into a double precision window. */ - -/* $ 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 */ - -/* WINDOWS */ - -/* $ Keywords */ - -/* WINDOWS */ - -/* $ Declarations */ -/* $ 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. */ - - -/* Include File: SPICELIB Error Handling Parameters */ - -/* errhnd.inc Version 2 18-JUN-1997 (WLT) */ - -/* The size of the long error message was */ -/* reduced from 25*80 to 23*80 so that it */ -/* will be accepted by the Microsoft Power Station */ -/* FORTRAN compiler which has an upper bound */ -/* of 1900 for the length of a character string. */ - -/* errhnd.inc Version 1 29-JUL-1997 (NJB) */ - - - -/* Maximum length of the long error message: */ - - -/* Maximum length of the short error message: */ - - -/* End Include File: SPICELIB Error Handling Parameters */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LEFT, */ -/* RIGHT I Left, right endpoints of new interval. */ -/* CONTEXT I A call explanation string. */ -/* WINDOW I,O Input, output window. */ - -/* $ Detailed_Input */ - -/* LEFT, */ -/* RIGHT are the left and right endpoints of the interval */ -/* to be inserted. */ - -/* CONTEXT a context/explaination string to append to the */ -/* long error message if an error signals. The caller */ -/* need not include a message. A single blank, ' ', */ -/* represents no message. */ - -/* WINDOW on input, is a window containing zero or more */ -/* intervals. */ - -/* $ Detailed_Output */ - -/* WINDOW on output, is the original window following the */ -/* insertion of the interval from LEFT to RIGHT. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If LEFT is greater than RIGHT, the error SPICE(BADENDPOINTS) is */ -/* signalled. */ - -/* 2) If the insertion of the interval causes an excess of elements, */ -/* the error SPICE(WINDOWEXCESS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine inserts the interval from LEFT to RIGHT into the */ -/* input window. If the new interval overlaps any of the intervals */ -/* in the window, the intervals are merged. Thus, the cardinality */ -/* of the input window can actually decrease as the result of an */ -/* insertion. However, because inserting an interval that is */ -/* disjoint from the other intervals in the window can increase the */ -/* cardinality of the window, the routine signals an error. */ - -/* This is the only unary routine to signal an error. No */ -/* other unary routine can increase the number of intervals in */ -/* the input window. */ - -/* If a non-blank CONTEXT string passes from the caller, any error */ -/* signal will return the long error message with the CONTEXT */ -/* string appended to that message. */ - -/* $ Examples */ - -/* Let WINDOW contain the intervals */ - -/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ - -/* Then the following series of calls */ - -/* CALL ZZWNINSD ( 5, 5, CONTEXT, WINDOW) (1) */ -/* CALL ZZWNINSD ( 4, 8, CONTEXT, WINDOW) (2) */ -/* CALL ZZWNINSD ( 0, 30, CONTEXT, WINDOW) (3) */ - -/* produces the following series of windows */ - -/* [ 1, 3 ] [ 5, 5 ] [ 7, 11 ] [ 23, 27 ] (1) */ -/* [ 1, 3 ] [ 4, 11 ] [ 23, 27 ] (2) */ -/* [ 0, 30 ] (3) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* N.J. Bachman (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 03-MAR-2009 (EDW) */ - -/* This routine is a copy of the SPICELIB WNINSD routine */ -/* changed only by the addition of the CONTEXT string. */ - -/* -& */ -/* $ Index_Entries */ - -/* insert an interval into a d.p. window, optional context string */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Local paramters */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZWNINSD", (ftnlen)8); - } - -/* Get the size and cardinality of the window. */ - - size = sized_(window); - card = cardd_(window); - -/* Let's try the easy cases first. No input interval? No change. */ -/* Signal that an error has occurred and set the error message. */ - - if (*left > *right) { - s_copy(msg, "Left endpoint greather-than right. Left endpoint was #1" - ". Right endpoint was #2.", (ftnlen)1840, (ftnlen)79); -/* Writing concatenation */ - i__1[0] = lastnb_(msg, (ftnlen)1840), a__1[0] = msg; - i__1[1] = 1, a__1[1] = " "; - i__1[2] = lastnb_(context, context_len), a__1[2] = context; - s_cat(msg, a__1, i__1, &c__3, (ftnlen)1840); - setmsg_(msg, (ftnlen)1840); - errdp_("#1", left, (ftnlen)2); - errdp_("#2", right, (ftnlen)2); - sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19); - chkout_("ZZWNINSD", (ftnlen)8); - return 0; - } else if (card == 0 || *left > window[card + 5]) { - -/* Empty window? Input interval later than the end of the window? */ -/* Just insert the interval, if there's room. */ - - if (size >= card + 2) { - i__2 = card + 2; - scardd_(&i__2, window); - window[card + 6] = *left; - window[card + 7] = *right; - } else { - s_copy(msg, "Window has size, #1, cardinality #2. Cannot insert " - "an additional interval into the window.", (ftnlen)1840, ( - ftnlen)90); -/* Writing concatenation */ - i__1[0] = lastnb_(msg, (ftnlen)1840), a__1[0] = msg; - i__1[1] = 1, a__1[1] = " "; - i__1[2] = lastnb_(context, context_len), a__1[2] = context; - s_cat(msg, a__1, i__1, &c__3, (ftnlen)1840); - setmsg_(msg, (ftnlen)1840); - errint_("#1", &size, (ftnlen)2); - errint_("#2", &card, (ftnlen)2); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - } - chkout_("ZZWNINSD", (ftnlen)8); - return 0; - } - -/* Now on to the tougher cases. */ - -/* Skip intervals which lie completely to the left of the input */ -/* interval. (The index I will always point to the right endpoint */ -/* of an interval). */ - - i__ = 2; - while(i__ <= card && window[i__ + 5] < *left) { - i__ += 2; - } - -/* There are three ways this can go. The new interval can: */ - -/* 1) lie entirely between the previous interval and the next. */ - -/* 2) overlap the next interval, but no others. */ - -/* 3) overlap more than one interval. */ - -/* Only the first case can possibly cause an overflow, since the */ -/* other two cases require existing intervals to be merged. */ - - -/* Case (1). If there's room, move succeeding intervals back and */ -/* insert the new one. If there isn't room, signal an error. */ - - if (*right < window[i__ + 4]) { - if (size >= card + 2) { - i__2 = i__ - 1; - for (j = card; j >= i__2; --j) { - window[j + 7] = window[j + 5]; - } - i__2 = card + 2; - scardd_(&i__2, window); - window[i__ + 4] = *left; - window[i__ + 5] = *right; - } else { - s_copy(msg, "Window has size, #1, cardinality #2. Cannot insert " - "an additional interval into the window. The new interval" - " lies entirely between the previous interval and thenext." - , (ftnlen)1840, (ftnlen)164); -/* Writing concatenation */ - i__1[0] = lastnb_(msg, (ftnlen)1840), a__1[0] = msg; - i__1[1] = 1, a__1[1] = " "; - i__1[2] = lastnb_(context, context_len), a__1[2] = context; - s_cat(msg, a__1, i__1, &c__3, (ftnlen)1840); - setmsg_(msg, (ftnlen)1840); - errint_("#1", &size, (ftnlen)2); - errint_("#2", &card, (ftnlen)2); - sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19); - chkout_("ZZWNINSD", (ftnlen)8); - return 0; - } - -/* Cases (2) and (3). */ - - } else { - -/* The left and right endpoints of the new interval may or */ -/* may not replace the left and right endpoints of the existing */ -/* interval. */ - -/* Computing MIN */ - d__1 = *left, d__2 = window[i__ + 4]; - window[i__ + 4] = min(d__1,d__2); -/* Computing MAX */ - d__1 = *right, d__2 = window[i__ + 5]; - window[i__ + 5] = max(d__1,d__2); - -/* Skip any intervals contained in the one we modified. */ -/* (Like I, J always points to the right endpoint of an */ -/* interval.) */ - - j = i__ + 2; - while(j <= card && window[j + 5] <= window[i__ + 5]) { - j += 2; - } - -/* If the modified interval extends into the next interval, */ -/* merge the two. (The modified interval grows to the right.) */ - - if (j <= card && window[i__ + 5] >= window[j + 4]) { - window[i__ + 5] = window[j + 5]; - j += 2; - } - -/* Move the rest of the intervals forward to take up the */ -/* spaces left by the absorbed intervals. */ - - while(j <= card) { - i__ += 2; - window[i__ + 4] = window[j + 4]; - window[i__ + 5] = window[j + 5]; - j += 2; - } - scardd_(&i__, window); - } - chkout_("ZZWNINSD", (ftnlen)8); - return 0; -} /* zzwninsd_ */ - diff --git a/ext/spice/src/cspice/zzxlated.c b/ext/spice/src/cspice/zzxlated.c deleted file mode 100644 index 2cc17b71f4..0000000000 --- a/ext/spice/src/cspice/zzxlated.c +++ /dev/null @@ -1,1085 +0,0 @@ -/* zzxlated.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; -static integer c__128 = 128; - -/* $Procedure ZZXLATED ( Private --- Translate Double Precision Numbers ) */ -/* Subroutine */ int zzxlated_(integer *inbff, char *input, integer *space, - doublereal *output, ftnlen input_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer natbff = 0; - - /* System generated locals */ - integer i__1, i__2, i__3; - char ch__1[1]; - static doublereal equiv_0[128]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzplatfm_(char *, char *, ftnlen, ftnlen); - integer i__, j, k; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer value; - extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); - integer numdp; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer bigint; -#define dpbufr (equiv_0) - static char strbff[8*4]; -#define inbufr ((integer *)equiv_0) - integer lenipt; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer intmin_(void); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - static integer smlint; - extern logical return_(void); - char tmpstr[8]; - integer outpos; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Convert double precision values from one binary file format */ -/* to another. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INBFF I Binary file format of d.p. values in INPUT. */ -/* INPUT I String containing d.p. values read as characters. */ -/* SPACE I Number of d.p. values that can be placed in OUTPUT. */ -/* OUTPUT O Translated d.p. values. */ - -/* $ Detailed_Input */ - -/* INBFF is an integer code that indicates the binary file */ -/* format of INPUT. Acceptable values are the */ -/* parameters: */ - -/* BIGI3E */ -/* LTLI3E */ -/* VAXGFL */ -/* VAXDFL */ - -/* as defined in the include file 'zzddhman.inc'. */ - -/* INPUT is a string containing a group of d.p. values read */ -/* from a file as a character string. The length of */ -/* this string must be a multiple of the number of */ -/* bytes used to store a d.p. value in a file utilizing */ -/* INBFF. */ - -/* SPACE is the number of d.p. values that OUTPUT has room to */ -/* store. */ - -/* $ Detailed_Output */ - -/* OUTPUT is an array of double precision values containing */ -/* the translated values from INPUT into the native */ -/* binary format. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* This routine signals several SPICE(BUG) exceptions. They are */ -/* signaled when improperly specified inputs are passed into the */ -/* routine or if the module or modules in its calling tree are */ -/* improperly configured to run on this platform. Callers that */ -/* prevent invalid inputs from being passed into this routine */ -/* need not check in. See the $Restrictions section for a */ -/* discussion of input argument restrictions. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine translates double precision values from a non-native */ -/* binary format read from a file as a sequence of characters to the */ -/* native format. */ - -/* $ Examples */ - -/* See ZZDAFGSR or ZZDAFGDR. */ - -/* $ Restrictions */ - -/* 1) Numeric data when read as characters from a file preserves */ -/* the bit patterns present in the file in memory. */ - -/* 2) The intrinsic ICHAR preserves the bit pattern of the character */ -/* byte read from a file. Namely if one examines the integer */ -/* created the 8 least significant bits will be precisely those */ -/* found in the character. */ - -/* 3) The size of double precision values on the target environment */ -/* are a multiple of some number of bytes. */ - -/* 4) The length of the INPUT string is a multiple of the number */ -/* of bytes for a double precision value in the INBFF format. */ - -/* 5) INBFF is supported for reading on this platform, and not */ -/* equivalent to NATBFF on this platform. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Length of the double precision and integer buffers that */ -/* are equivalenced. */ - - -/* These parameters are used for arithmetic shifting. */ - - -/* Local Variables */ - - -/* Equivalence DPBUFR to INBUFR. */ - - -/* Statement Functions */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Statement Function Definitions */ - -/* This function controls the conversion of characters to integers. */ -/* On some supported environments, ICHAR is not sufficient to */ -/* produce the desired results. This, however, is not the case */ -/* with this particular environment. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZXLATED", (ftnlen)8); - } - -/* Perform some initialization tasks. */ - - if (first) { - -/* Populate STRBFF. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 354)) << 3), (ftnlen)3, (ftnlen)8); - } - -/* Fetch the native binary file format. */ - - zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8); - if (natbff == 0) { - setmsg_("The binary file format, '#', is not supported by this v" - "ersion of the toolkit. This is a serious problem, contac" - "t NAIF.", (ftnlen)118); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* Store the largest value a 32-bit integer can actually */ -/* hold. */ - - bigint = 2147483647; - -/* Prepare the smallest value a 32-bit integer can actually */ -/* store, regardless of what INTMIN returns. */ - - smlint = intmin_(); - -/* Set SMLINT to the appropriate value if INTMIN is too large. */ - - if (smlint == -2147483647) { - --smlint; - } - -/* Do not perform initialization tasks again. */ - - first = FALSE_; - } - -/* Check to see if INBFF makes sense. */ - - if (*inbff < 1 || *inbff > 4) { - setmsg_("The integer code used to indicate the binary file format of" - " the input integers, #, is out of range. This error should " - "never occur.", (ftnlen)131); - errint_("#", inbff, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* Retrieve the length of the input string, and set the position */ -/* into the output buffer to the beginning. */ - - lenipt = i_len(input, input_len); - outpos = 1; - -/* Now branch based on NATBFF. */ - - if (natbff == 1) { - if (*inbff == 2) { - -/* Check to see that the length of the input string is */ -/* appropriate. Since this is a string containing LTL-IEEE */ -/* d.p. values, and this is a BIG-IEEE machine characters */ -/* are 1-byte and d.p. values are 8-bytes. So the length */ -/* of INPUT must be a multiple of 8. */ - - numdp = lenipt / 8; - if (lenipt - (numdp << 3) != 0) { - setmsg_("The input string that is to be translated from the " - "binary format # to format # has a length that is not" - " a multiple of 4 bytes. This error should never occ" - "ur.", (ftnlen)158); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 450)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 451)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* Verify there is enough room to store the results of */ -/* the translation. */ - - if (numdp > *space) { - setmsg_("The caller specified that # double precision number" - "s are to be translated from binary format # to #. H" - "owever there is only room to hold # integers in the " - "output array. This error should never occur.", ( - ftnlen)200); - errint_("#", &numdp, (ftnlen)1); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 471)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 472)) << 3), (ftnlen)1, (ftnlen)8); - errint_("#", space, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* The remainder of this branch is devoted to translating */ -/* and copying blocks of DPBLEN double precision numbers */ -/* into OUTPUT. Initialize K, the integer index into the */ -/* buffer equivalenced to DPBUFR. */ - - k = 1; - -/* Start looping over each 8 character package in INPUT and */ -/* converting it to double precision numbers. */ - - i__1 = numdp; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute the substring index of the first character */ -/* in INPUT for this integer. */ - - j = (i__ - 1 << 3) + 1; - -/* Now arrange the bytes properly. Since these characters */ -/* were read from a file utilizing LTL-IEEE: */ - -/* . */ -/* . */ -/* . */ -/* ------- */ -/* | J | - Least Significant Byte of Mantissa */ -/* ------- */ -/* | J+1 | - Sixth Most Significant Mantissa Byte */ -/* ------- */ -/* | J+2 | - Fifth Most Significant Mantissa Byte */ -/* ------- */ -/* | J+3 | - Fourth Most Significant Mantissa Byte */ -/* ------- */ -/* | J+4 | - Third Most Significant Mantissa Byte */ -/* ------- */ -/* | J+5 | - Second Most Significant Mantissa Byte */ -/* ------- */ -/* | J+6 | - Tail of Exponent, Most Significant */ -/* ------- Bits of the Mantissa */ -/* | J+7 | - Sign Bit, Head of Exponent */ -/* ------- */ -/* . */ -/* . */ -/* . */ - -/* Now rearrange the bytes to place them in the */ -/* proper order for d.p. values on BIG-IEEE machines. */ -/* This is accomplished in the following manner: */ - -/* INPUT(J+4:J+4) */ -/* INPUT(J+5:J+5)*SHFT8 */ -/* INPUT(J+6:J+6)*SHFT16 */ -/* + INPUT(J+7:J+7)*SHFT24 */ -/* ------------------------- */ -/* INBUFR(K) */ - -/* INPUT(J:J) */ -/* INPUT(J+1:J+1)*SHFT8 */ -/* INPUT(J+2:J+2)*SHFT16 */ -/* + INPUT(J+3:J+3)*SHFT24 */ -/* ------------------------- */ -/* INBUFR(K+1) */ - - -/* Utilize the military extension bit manipulation */ -/* intrinsics to perform the necessary computations. */ -/* It has been determined empirically that on these */ -/* environments this is faster than arithmetic. */ - - i__2 = j + 3; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 4 - i__2); - value = *(unsigned char *)&ch__1[0]; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)553)] = value; - i__2 = j + 4; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 5 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 8; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)557)] = inbufr[( - i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "inbufr", i__3, "zzxlated_", (ftnlen)557)] | value; - i__2 = j + 5; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 6 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 16; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)561)] = inbufr[( - i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "inbufr", i__3, "zzxlated_", (ftnlen)561)] | value; - i__2 = j + 6; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 7 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 24; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)565)] = inbufr[( - i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "inbufr", i__3, "zzxlated_", (ftnlen)565)] | value; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1]; - value = *(unsigned char *)&ch__1[0]; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)569)] = value; - i__2 = j; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 8; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)573)] = inbufr[(i__3 = k) - < 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3, - "zzxlated_", (ftnlen)573)] | value; - i__2 = j + 1; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 16; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)577)] = inbufr[(i__3 = k) - < 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3, - "zzxlated_", (ftnlen)577)] | value; - i__2 = j + 2; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 24; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)581)] = inbufr[(i__3 = k) - < 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3, - "zzxlated_", (ftnlen)581)] | value; - -/* Check to see if the local buffer is full and the */ -/* double precision numbers need to be moved into the */ -/* next block of OUTPUT. */ - - if (k == 255) { - moved_(dpbufr, &c__128, &output[outpos - 1]); - outpos += 128; - k = 1; - -/* Otherwise, increment K. */ - - } else { - k += 2; - } - } - -/* Copy any remaining double precision numbers from DPBUFR */ -/* into OUTPUT. */ - - if (k != 1) { - i__1 = k / 2; - moved_(dpbufr, &i__1, &output[outpos - 1]); - } - } else { - setmsg_("Unable to translate double precision values from binary" - " file format # to #. This error should never occur and i" - "s indicative of a bug. Contact NAIF.", (ftnlen)148); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)618)) - << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)619)) - << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - } else if (natbff == 2) { - if (*inbff == 1) { - -/* Check to see that the length of the input string is */ -/* appropriate. Since this is a string containing BIG-IEEE */ -/* d.p. values, and this is a LTL-IEEE machine characters */ -/* are 1-byte and d.p. values are 8-bytes. So the length */ -/* of INPUT must be a multiple of 8. */ - - numdp = lenipt / 8; - if (lenipt - (numdp << 3) != 0) { - setmsg_("The input string that is to be translated from the " - "binary format # to format # has a length that is not" - " a multiple of 4 bytes. This error should never occ" - "ur.", (ftnlen)158); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 646)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 647)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* Verify there is enough room to store the results of */ -/* the translation. */ - - if (numdp > *space) { - setmsg_("The caller specified that # double precision number" - "s are to be translated from binary format # to #. H" - "owever there is only room to hold # integers in the " - "output array. This error should never occur.", ( - ftnlen)200); - errint_("#", &numdp, (ftnlen)1); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 667)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen) - 668)) << 3), (ftnlen)1, (ftnlen)8); - errint_("#", space, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* The remainder of this branch is devoted to translating */ -/* and copying blocks of DPBLEN double precision numbers */ -/* into OUTPUT. Initialize K, the integer index into the */ -/* buffer equivalenced to DPBUFR. */ - - k = 1; - -/* Start looping over each 8 character package in INPUT and */ -/* converting them to double precision numbers. */ - - i__1 = numdp; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute the substring index of the first character */ -/* in INPUT for this integer. */ - - j = (i__ - 1 << 3) + 1; - -/* Now arrange the bytes properly. Since these characters */ -/* were read from a file utilizing BIG-IEEE: */ - -/* . */ -/* . */ -/* . */ -/* ------- */ -/* | J | - Sign Bit, Head of Exponent */ -/* ------- */ -/* | J+1 | - Tail of Exponent, Most Significant */ -/* ------- Bits of the Mantissa */ -/* | J+2 | - Second Most Significant Mantissa Byte */ -/* ------- */ -/* | J+3 | - Third Most Significant Mantissa Byte */ -/* ------- */ -/* | J+4 | - Fourth Most Significant Mantissa Byte */ -/* ------- */ -/* | J+5 | - Fifth Most Significant Mantissa Byte */ -/* ------- */ -/* | J+6 | - Sixth Most Significant Mantissa Byte */ -/* ------- */ -/* | J+7 | - Least Significant Byte of Mantissa */ -/* ------- */ -/* . */ -/* . */ -/* . */ - -/* Now rearrange the bytes to place them in the */ -/* proper order for d.p. values on LTL-IEEE machines. */ -/* This is accomplished in the following manner: */ - -/* INPUT(J+7:J+7) */ -/* INPUT(J+6:J+6)*SHFT8 */ -/* INPUT(J+5:J+5)*SHFT16 */ -/* + INPUT(J+4:J+4)*SHFT24 */ -/* ------------------------- */ -/* INBUFR(K) */ - -/* INPUT(J+3:J+3) */ -/* INPUT(J+2:J+2)*SHFT8 */ -/* INPUT(J+1:J+1)*SHFT16 */ -/* + INPUT(J:J)*SHFT24 */ -/* ------------------------- */ -/* INBUFR(K+1) */ - - -/* Utilize the military extension bit manipulation */ -/* intrinsics to perform the necessary computations. */ -/* It has been determined empirically that on these */ -/* environments this is faster than arithmetic. */ - - i__2 = j + 6; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 7 - i__2); - value = *(unsigned char *)&ch__1[0]; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)749)] = value; - i__2 = j + 5; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 6 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 8; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)753)] = inbufr[( - i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "inbufr", i__3, "zzxlated_", (ftnlen)753)] | value; - i__2 = j + 4; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 5 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 16; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)757)] = inbufr[( - i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "inbufr", i__3, "zzxlated_", (ftnlen)757)] | value; - i__2 = j + 3; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 4 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 24; - inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge( - "inbufr", i__2, "zzxlated_", (ftnlen)761)] = inbufr[( - i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge( - "inbufr", i__3, "zzxlated_", (ftnlen)761)] | value; - i__2 = j + 2; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2); - value = *(unsigned char *)&ch__1[0]; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)765)] = value; - i__2 = j + 1; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 8; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)769)] = inbufr[(i__3 = k) - < 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3, - "zzxlated_", (ftnlen)769)] | value; - i__2 = j; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 16; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)773)] = inbufr[(i__3 = k) - < 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3, - "zzxlated_", (ftnlen)773)] | value; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1]; - value = *(unsigned char *)&ch__1[0]; - value <<= 24; - inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr", - i__2, "zzxlated_", (ftnlen)777)] = inbufr[(i__3 = k) - < 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3, - "zzxlated_", (ftnlen)777)] | value; - -/* Check to see if the local buffer is full and the */ -/* double precision numbers need to be moved into the */ -/* next block of OUTPUT. */ - - if (k == 255) { - moved_(dpbufr, &c__128, &output[outpos - 1]); - outpos += 128; - k = 1; - -/* Otherwise, increment K. */ - - } else { - k += 2; - } - } - -/* Copy any remaining double precision numbers from DPBUFR */ -/* into OUTPUT. */ - - if (k != 1) { - i__1 = k / 2; - moved_(dpbufr, &i__1, &output[outpos - 1]); - } - } else { - setmsg_("Unable to translate double precision values from binary" - " file format # to #. This error should never occur and i" - "s indicative of a bug. Contact NAIF.", (ftnlen)148); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)814)) - << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)815)) - << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - -/* The native binary file format on this platform is not supported */ -/* for the conversion of integers. This is a bug, as this branch */ -/* of code should never be reached in normal operation. */ - - } else { - setmsg_("The native binary file format of this toolkit build, #, is " - "not currently supported for translation of double precision " - "numbers from non-native formats.", (ftnlen)151); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("strbff", i__1, "zzxlated_", (ftnlen)833)) << 3), ( - ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATED", (ftnlen)8); - return 0; - } - chkout_("ZZXLATED", (ftnlen)8); - return 0; -} /* zzxlated_ */ - -#undef inbufr -#undef dpbufr - - diff --git a/ext/spice/src/cspice/zzxlatei.c b/ext/spice/src/cspice/zzxlatei.c deleted file mode 100644 index 0aef7734b6..0000000000 --- a/ext/spice/src/cspice/zzxlatei.c +++ /dev/null @@ -1,887 +0,0 @@ -/* zzxlatei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure ZZXLATEI ( Private --- Translate Integers ) */ -/* Subroutine */ int zzxlatei_(integer *inbff, char *input, integer *space, - integer *output, ftnlen input_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer natbff = 0; - - /* System generated locals */ - integer i__1, i__2; - char ch__1[1]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen, - ftnlen), zzplatfm_(char *, char *, ftnlen, ftnlen); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - integer value; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer bigint; - static char strbff[8*4]; - integer lenipt; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer intmin_(void); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - static integer smlint; - integer numint; - extern logical return_(void); - char tmpstr[8]; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Convert integers from one binary file format to another. */ - -/* $ 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 */ - -/* PRIVATE */ - -/* $ Declarations */ - -/* $ Abstract */ - -/* Parameter declarations for the DAF/DAS handle manager. */ - -/* $ 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 */ - -/* DAF, DAS */ - -/* $ Keywords */ - -/* PRIVATE */ - -/* $ Particulars */ - -/* This include file contains parameters defining limits and */ -/* integer codes that are utilized in the DAF/DAS handle manager */ -/* routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 07-NOV-2001 */ - -/* -& */ - -/* Unit and file table size parameters. */ - -/* FTSIZE is the maximum number of files (DAS and DAF) that a */ -/* user may have open simultaneously. */ - - -/* RSVUNT is the number of units protected from being locked */ -/* to a particular handle by ZZDDHHLU. */ - - -/* SCRUNT is the number of units protected for use by scratch */ -/* files. */ - - -/* UTSIZE is the maximum number of logical units this manager */ -/* will utilize at one time. */ - - -/* Access method enumeration. These parameters are used to */ -/* identify which access method is associated with a particular */ -/* handle. They need to be synchronized with the STRAMH array */ -/* defined in ZZDDHGSD in the following fashion: */ - -/* STRAMH ( READ ) = 'READ' */ -/* STRAMH ( WRITE ) = 'WRITE' */ -/* STRAMH ( SCRTCH ) = 'SCRATCH' */ -/* STRAMH ( NEW ) = 'NEW' */ - -/* These values are used in the file table variable FTAMH. */ - - -/* Binary file format enumeration. These parameters are used to */ -/* identify which binary file format is associated with a */ -/* particular handle. They need to be synchronized with the STRBFF */ -/* array defined in ZZDDHGSD in the following fashion: */ - -/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ -/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ -/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ -/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ - -/* These values are used in the file table variable FTBFF. */ - - -/* Some random string lengths... more documentation required. */ -/* For now this will have to suffice. */ - - -/* Architecture enumeration. These parameters are used to identify */ -/* which file architecture is associated with a particular handle. */ -/* They need to be synchronized with the STRARC array defined in */ -/* ZZDDHGSD in the following fashion: */ - -/* STRARC ( DAF ) = 'DAF' */ -/* STRARC ( DAS ) = 'DAS' */ - -/* These values will be used in the file table variable FTARC. */ - - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC/Linux, g77 */ -/* Source: Determined by experiment. */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT Mach OS (Black Hardware), */ -/* Absoft Fortran Version 3.2 */ -/* Source: NAIF Program */ - - -/* The following parameter defines the size of a string used */ -/* to store a filenames on this target platform. */ - - -/* The following parameter controls the size of the character record */ -/* buffer used to read data from non-native files. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INBFF I Binary file format code for integers in INPUT. */ -/* INPUT I String containing integers read as characters. */ -/* SPACE I Number of integers that can be placed in OUTPUT. */ -/* OUTPUT O Translated integer values. */ - -/* $ Detailed_Input */ - -/* INBFF is an integer code that indicates the binary file */ -/* format of INPUT. Acceptable values are the */ -/* parameters: */ - -/* BIGI3E */ -/* LTLI3E */ -/* VAXGFL */ -/* VAXDFL */ - -/* as defined in the include file 'zzddhman.inc'. */ - -/* INPUT is a string containing a group of integers read */ -/* from a file as a character string. The length of */ -/* this string must be a multiple of the number of */ -/* bytes used to store an integer in a file utilizing */ -/* INBFF. */ - -/* SPACE is the number of integers that OUTPUT has room to */ -/* store. */ - -/* $ Detailed_Output */ - -/* OUTPUT is an array of integers containing the translated */ -/* values from INPUT into the native binary format. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* This routine signals several SPICE(BUG) exceptions. They are */ -/* signaled when improperly specified inputs are passed into the */ -/* routine or if the module or modules in its calling tree are */ -/* improperly configured to run on this platform. Callers that */ -/* prevent invalid inputs from being passed into this routine */ -/* need not check in. See the $Restrictions section for a */ -/* discussion of input argument restrictions. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine translates integers from a non-native integer format */ -/* read from a file as a sequence of characters to the native format. */ - -/* $ Examples */ - -/* See ZZDAFGFR, ZZDAFGSR. */ - -/* $ Restrictions */ - -/* 1) Numeric data when read as characters from a file preserve */ -/* the bit patterns present in the file in memory. */ - -/* 2) A byte is 8 bits, and a character is some multiple of */ -/* bytes. */ - -/* 3) The intrinsic ICHAR preserves the bit pattern of the character */ -/* byte read from a file. Namely if one examines the integer */ -/* created the 8 least significant bits will be precisely those */ -/* found in the character. */ - -/* 4) The size of integers on the target environment are a multiple */ -/* of some number of bytes. */ - -/* 5) The length of the INPUT string is a multiple of the number */ -/* of bytes for an integer in the INBFF format. */ - -/* 6) INBFF is supported for reading on this platform, and not */ -/* equivalent to NATBFF on this platform. */ - -/* 7) This routine must support all of the non-native translations */ -/* required by the 'READS_BFF' key in ZZPLATFM. */ - -/* 8) The character label corresponding to INBFF must be one of the */ -/* non-native entries in the value of 'READS_BFF' returned by */ -/* ZZPLATFM for this environment. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* These parameters are used for arithmetic shifting. */ - - -/* Local Variables */ - - -/* Statement Functions */ - - -/* Saved Variables */ - - -/* Data Statements */ - - -/* Statement Function Definitions */ - -/* This function controls the conversion of characters to integers. */ -/* On some supported environments, ICHAR is not sufficient to */ -/* produce the desired results. This however, is not the case */ -/* with this particular environment. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZXLATEI", (ftnlen)8); - } - -/* Perform some initialization tasks. */ - - if (first) { - -/* Populate STRBFF with the appropriate binary file */ -/* format labels. */ - - for (i__ = 1; i__ <= 4; ++i__) { - zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <= - i__1 ? i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 341)) << 3), (ftnlen)3, (ftnlen)8); - } - -/* Fetch the native binary file format. */ - - zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8); - ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8); - natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8); - if (natbff == 0) { - setmsg_("The binary file format, '#', is not supported by this v" - "ersion of the toolkit. This is a serious problem, contac" - "t NAIF.", (ftnlen)118); - errch_("#", tmpstr, (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* Store the largest value a 32-bit integer can actually */ -/* hold. */ - - bigint = 2147483647; - -/* Prepare the smallest value a 32-bit integer can actually */ -/* store, regardless of what INTMIN returns. */ - - smlint = intmin_(); - -/* Set SMLINT to the appropriate value if INTMIN is too large. */ - - if (smlint == -2147483647) { - --smlint; - } - -/* Do not perform initialization tasks again. */ - - first = FALSE_; - } - -/* Check to see if INBFF is valid. This should never occur if this */ -/* routine is called properly. */ - - if (*inbff < 1 || *inbff > 4) { - setmsg_("The integer code used to indicate the binary file format of" - " the input integers, #, is out of range. This error should " - "never occur.", (ftnlen)131); - errint_("#", inbff, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* Retrieve the length of the input string. */ - - lenipt = i_len(input, input_len); - -/* Now branch based on the value of NATBFF. */ - - if (natbff == 1) { - if (*inbff == 2) { - -/* Check to see that the length of the input string is */ -/* appropriate. Since this is a string containing LTL-IEEE */ -/* integers and this is a BIG-IEEE machine, characters are */ -/* 1-byte and integers are 4-bytes. So the length of INPUT */ -/* must be a multiple of 4. */ - - numint = lenipt / 4; - if (lenipt - (numint << 2) != 0) { - setmsg_("The input string that is to be translated from the " - "binary format # to format # has a length that is not" - " a multiple of 4 bytes. This error should never occ" - "ur.", (ftnlen)158); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 436)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 437)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* Verify there is enough room to store the results of */ -/* the translation. */ - - if (numint > *space) { - setmsg_("The caller specified that # integers are to be tran" - "slated from binary format # to #. However there is " - "only room to hold # integers in the output array. T" - "his error should never occur.", (ftnlen)184); - errint_("#", &numint, (ftnlen)1); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 456)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 457)) << 3), (ftnlen)1, (ftnlen)8); - errint_("#", space, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* Start looping over each 4 character package in INPUT and */ -/* converting them to integers. */ - - i__1 = numint; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute the substring index of the first character */ -/* in INPUT for this integer. */ - - j = (i__ - 1 << 2) + 1; - -/* Now arrange the bytes properly. Since these characters */ -/* were read from a file utilizing LTL-IEEE, we know that */ -/* J is the least significant byte and that (J+3) is the */ -/* most significant. */ - -/* INPUT: */ - -/* ------------------------------------- */ -/* . . .| | J | J+1 | J+2 | J+3 | |. . . */ -/* ------------------------------------- */ - -/* From this we construct OUTPUT(I) using the following */ -/* relation: */ - -/* INPUT(J:J) */ -/* INPUT(J+1:J+1) shifted 8 bits to the MSb */ -/* INPUT(J+2:J+2) shifted 16 bits to the MSb */ -/* + INPUT(J+3:J+3) shifted 24 bits to the MSb */ -/* ------------------------- */ -/* OUTPUT(I) */ - - -/* Utilize the military extension bit manipulation */ -/* intrinsics to perform the necessary computations. */ -/* It has been determined empirically that on this */ -/* environment it is faster than arithmetic. */ - - *(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1]; - value = *(unsigned char *)&ch__1[0]; - output[i__ - 1] = value; - i__2 = j; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 8; - output[i__ - 1] |= value; - i__2 = j + 1; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 16; - output[i__ - 1] |= value; - i__2 = j + 2; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 24; - output[i__ - 1] |= value; - } - } else { - setmsg_("Unable to translate integers from binary file format # " - "to #. This error should never occur and is indicative o" - "f a bug. Contact NAIF.", (ftnlen)134); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen)527)) - << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen)528)) - << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - } else if (natbff == 2) { - if (*inbff == 1) { - -/* Check to see that the length of the input string is */ -/* appropriate. Since this is a string containing BIG-IEEE */ -/* integers and this is a LTL-IEEE machine, characters are */ -/* 1-byte and integers are 4-bytes. So the length of INPUT */ -/* must be a multiple of 4. */ - - numint = lenipt / 4; - if (lenipt - (numint << 2) != 0) { - setmsg_("The input string that is to be translated from the " - "binary format # to format # has a length that is not" - " a multiple of 4 bytes. This error should never occ" - "ur.", (ftnlen)158); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 555)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 556)) << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* Verify there is enough room to store the results of */ -/* the translation. */ - - if (numint > *space) { - setmsg_("The caller specified that # integers are to be tran" - "slated from binary format # to #. However there is " - "only room to hold # integers in the output array. T" - "his error should never occur.", (ftnlen)184); - errint_("#", &numint, (ftnlen)1); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 575)) << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen) - 576)) << 3), (ftnlen)1, (ftnlen)8); - errint_("#", space, (ftnlen)1); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* Start looping over each 4 character package in INPUT and */ -/* converting them to integers. */ - - i__1 = numint; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute the substring index of the first character */ -/* in INPUT for this integer. */ - - j = (i__ - 1 << 2) + 1; - -/* Now arrange the bytes properly. Since these characters */ -/* were read from a file utilizing BIG-IEEE, we know that */ -/* J is the most significant byte and that (J+3) is the */ -/* least significant. */ - -/* INPUT: */ - -/* ------------------------------------- */ -/* . . .| | J | J+1 | J+2 | J+3 | |. . . */ -/* ------------------------------------- */ - -/* From this we construct OUTPUT(I) using the following */ -/* relation: */ - -/* INPUT(J+3:J+3) */ -/* INPUT(J+2:J+2)*SHFT8 */ -/* INPUT(J+1:J+1)*SHFT16 */ -/* + INPUT(J:J)*SHFT24 */ -/* ------------------------- */ -/* OUTPUT(I) */ - - -/* Utilize the military extension bit manipulation */ -/* intrinsics to perform the necessary computations. */ -/* It has been determined empirically that on this */ -/* environment it is faster than arithmetic. */ - - i__2 = j + 2; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2); - value = *(unsigned char *)&ch__1[0]; - output[i__ - 1] = value; - i__2 = j + 1; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 8; - output[i__ - 1] |= value; - i__2 = j; - s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2); - value = *(unsigned char *)&ch__1[0]; - value <<= 16; - output[i__ - 1] |= value; - *(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1]; - value = *(unsigned char *)&ch__1[0]; - value <<= 24; - output[i__ - 1] |= value; - } - } else { - setmsg_("Unable to translate integers from binary file format # " - "to #. This error should never occur and is indicative o" - "f a bug. Contact NAIF.", (ftnlen)134); - errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen)646)) - << 3), (ftnlen)1, (ftnlen)8); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? - i__1 : s_rnge("strbff", i__1, "zzxlatei_", (ftnlen)647)) - << 3), (ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - -/* The native binary file format on this platform is not supported */ -/* for the conversion of integers. This is a bug, as this branch */ -/* of code should never be reached in normal operation. */ - - } else { - setmsg_("The native binary file format of this toolkit build, #, is " - "not currently supported for translation of integers from non" - "-native formats.", (ftnlen)135); - errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("strbff", i__1, "zzxlatei_", (ftnlen)665)) << 3), ( - ftnlen)1, (ftnlen)8); - sigerr_("SPICE(BUG)", (ftnlen)10); - chkout_("ZZXLATEI", (ftnlen)8); - return 0; - } - chkout_("ZZXLATEI", (ftnlen)8); - return 0; -} /* zzxlatei_ */ - diff --git a/ext/spice/src/csupport/SpiceCK.h b/ext/spice/src/csupport/SpiceCK.h deleted file mode 100644 index 894d4e9a6c..0000000000 --- a/ext/spice/src/csupport/SpiceCK.h +++ /dev/null @@ -1,155 +0,0 @@ -/* - --Header_File SpiceCK.h ( CSPICE CK definitions ) - --Abstract - - Perform CSPICE definitions to support CK wrapper interfaces. - --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. - --Particulars - - This header defines types that may be referenced in - application code that calls CSPICE CK functions. - - Typedef - ======= - - Name Description - ---- ---------- - - SpiceCK05Subtype Typedef for enum indicating the - mathematical representation used - in an CK type 05 segment. Possible - values and meanings are: - - C05TP0: - - Hermite interpolation, 8- - element packets containing - - q0, q1, q2, q3, - dq0/dt, dq1/dt, dq2/dt dq3/dt - - where q0, q1, q2, q3 represent - quaternion components and dq0/dt, - dq1/dt, dq2/dt, dq3/dt represent - quaternion time derivative components. - - Quaternions are unitless. Quaternion - time derivatives have units of - 1/second. - - - C05TP1: - - Lagrange interpolation, 4- - element packets containing - - q0, q1, q2, q3, - - where q0, q1, q2, q3 represent - quaternion components. Quaternion - derivatives are obtained by - differentiating interpolating - polynomials. - - - C05TP2: - - Hermite interpolation, 14- - element packets containing - - q0, q1, q2, q3, - dq0/dt, dq1/dt, dq2/dt dq3/dt, - av0, av1, av2, - dav0/dt, dav1/dt, dav2/dt - - where q0, q1, q2, q3 represent - quaternion components and dq0/dt, - dq1/dt, dq2/dt, dq3/dt represent - quaternion time derivative components, - av0, av1, av2 represent angular - velocity components, and - dav0/dt, dav1/dt, dav2/dt represent - angular acceleration components. - - - C05TP3: - - Lagrange interpolation, 7- - element packets containing - - q0, q1, q2, q3, - av0, av1, av2 - - where q0, q1, q2, q3 represent - quaternion components and - av0, av1, av2 represent angular - velocity components. - - - -Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 20-AUG-2002 (NJB) - -*/ - -#ifndef HAVE_SPICE_CK_H - - #define HAVE_SPICE_CK_H - - - - /* - CK type 05 subtype codes: - */ - - enum _SpiceCK05Subtype { C05TP0, C05TP1, C05TP2, C05TP3 }; - - - typedef enum _SpiceCK05Subtype SpiceCK05Subtype; - -#endif - diff --git a/ext/spice/src/csupport/SpiceCel.h b/ext/spice/src/csupport/SpiceCel.h deleted file mode 100644 index 7b0537e9ee..0000000000 --- a/ext/spice/src/csupport/SpiceCel.h +++ /dev/null @@ -1,441 +0,0 @@ -/* - --Header_File SpiceCel.h ( CSPICE Cell definitions ) - --Abstract - - Perform CSPICE definitions for the SpiceCell data type. - --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 - - CELLS - --Particulars - - This header defines structures, macros, and enumerated types that - may be referenced in application code that calls CSPICE cell - functions. - - CSPICE cells are data structures that implement functionality - parallel to that of the cell abstract data type in SPICELIB. In - CSPICE, a cell is a C structure containing bookkeeping information, - including a pointer to an associated data array. - - For numeric data types, the data array is simply a SPICELIB-style - cell, including a valid control area. For character cells, the data - array has the same number of elements as the corresponding - SPICELIB-style cell, but the contents of the control area are not - maintained, and the data elements are null-terminated C-style - strings. - - CSPICE cells should be declared using the declaration macros - provided in this header file. See the table of macros below. - - - Structures - ========== - - Name Description - ---- ---------- - - SpiceCell Structure containing CSPICE cell metadata. - - The members are: - - dtype: Data type of cell: character, - integer, or double precision. - - dtype has type - SpiceCellDataType. - - length: For character cells, the - declared length of the - cell's string array. - - size: The maximum number of data - items that can be stored in - the cell's data array. - - card: The cell's "cardinality": the - number of data items currently - present in the cell. - - isSet: Boolean flag indicating whether - the cell is a CSPICE set. - Sets have no duplicate data - items, and their data items are - stored in increasing order. - - adjust: Boolean flag indicating whether - the cell's data area has - adjustable size. Adjustable - size cell data areas are not - currently implemented. - - init: Boolean flag indicating whether - the cell has been initialized. - - base: is a void pointer to the - associated data array. base - points to the start of the - control area of this array. - - data: is a void pointer to the - first data slot in the - associated data array. This - slot is the element following - the control area. - - - ConstSpiceCell A const SpiceCell. - - - - - Declaration Macros - ================== - - Name Description - ---- ---------- - - SPICECHAR_CELL ( name, size, length ) Declare a - character CSPICE - cell having cell - name name, - maximum cell - cardinality size, - and string length - length. The - macro declares - both the cell and - the associated - data array. The - name of the data - array begins with - "SPICE_". - - - SPICEDOUBLE_CELL ( name, size ) Like SPICECHAR_CELL, - but declares a - double precision - cell. - - - SPICEINT_CELL ( name, size ) Like - SPICECHAR_CELL, - but declares an - integer cell. - - Assignment Macros - ================= - - Name Description - ---- ---------- - SPICE_CELL_SET_C( item, i, cell ) Assign the ith - element of a - character cell. - Arguments cell - and item are - pointers. - - SPICE_CELL_SET_D( item, i, cell ) Assign the ith - element of a - double precision - cell. Argument - cell is a - pointer. - - SPICE_CELL_SET_I( item, i, cell ) Assign the ith - element of an - integer cell. - Argument cell is - a pointer. - - - Fetch Macros - ============== - - Name Description - ---- ---------- - SPICE_CELL_GET_C( cell, i, lenout, item ) Fetch the ith - element from a - character cell. - Arguments cell - and item are - pointers. - Argument lenout - is the available - space in item. - - SPICE_CELL_GET_D( cell, i, item ) Fetch the ith - element from a - double precision - cell. Arguments - cell and item are - pointers. - - SPICE_CELL_GET_I( cell, i, item ) Fetch the ith - element from an - integer cell. - Arguments cell - and item are - pointers. - Element Pointer Macros - ====================== - - Name Description - ---- ---------- - SPICE_CELL_ELEM_C( cell, i ) Macro evaluates - to a SpiceChar - pointer to the - ith data element - of a character - cell. Argument - cell is a - pointer. - - SPICE_CELL_ELEM_D( cell, i ) Macro evaluates - to a SpiceDouble - pointer to the - ith data element - of a double - precision cell. - Argument cell is - a pointer. - - SPICE_CELL_ELEM_I( cell, i ) Macro evaluates - to a SpiceInt - pointer to the - ith data element - of an integer - cell. Argument - cell is a - pointer. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 22-AUG-2002 (NJB) - -*/ -#ifndef HAVE_SPICE_CELLS_H - - #define HAVE_SPICE_CELLS_H - - - /* - Data type codes: - */ - typedef enum _SpiceDataType SpiceCellDataType; - - - /* - Cell structure: - */ - struct _SpiceCell - - { SpiceCellDataType dtype; - SpiceInt length; - SpiceInt size; - SpiceInt card; - SpiceBoolean isSet; - SpiceBoolean adjust; - SpiceBoolean init; - void * base; - void * data; }; - - typedef struct _SpiceCell SpiceCell; - - typedef const SpiceCell ConstSpiceCell; - - - /* - SpiceCell control area size: - */ - #define SPICE_CELL_CTRLSZ 6 - - - /* - Declaration macros: - */ - - #define SPICECHAR_CELL( name, size, length ) \ - \ - static SpiceChar SPICE_CELL_##name[SPICE_CELL_CTRLSZ + size][length]; \ - \ - static SpiceCell name = \ - \ - { SPICE_CHR, \ - length, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - #define SPICEDOUBLE_CELL( name, size ) \ - \ - static SpiceDouble SPICE_CELL_##name [SPICE_CELL_CTRLSZ + size]; \ - \ - static SpiceCell name = \ - \ - { SPICE_DP, \ - 0, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - #define SPICEINT_CELL( name, size ) \ - \ - static SpiceInt SPICE_CELL_##name [SPICE_CELL_CTRLSZ + size]; \ - \ - static SpiceCell name = \ - \ - { SPICE_INT, \ - 0, \ - size, \ - 0, \ - SPICETRUE, \ - SPICEFALSE, \ - SPICEFALSE, \ - (void *) &(SPICE_CELL_##name), \ - (void *) &(SPICE_CELL_##name[SPICE_CELL_CTRLSZ]) } - - - /* - Access macros for individual elements: - */ - - /* - Data element pointer macros: - */ - - #define SPICE_CELL_ELEM_C( cell, i ) \ - \ - ( ( (SpiceChar *) (cell)->data ) + (i)*( (cell)->length ) ) - - - #define SPICE_CELL_ELEM_D( cell, i ) \ - \ - ( ( (SpiceDouble *) (cell)->data )[(i)] ) - - - #define SPICE_CELL_ELEM_I( cell, i ) \ - \ - ( ( (SpiceInt *) (cell)->data )[(i)] ) - - - /* - "Fetch" macros: - */ - - #define SPICE_CELL_GET_C( cell, i, lenout, item ) \ - \ - { \ - SpiceInt nBytes; \ - \ - nBytes = brckti_c ( (cell)->length, 0, (lenout-1) ) \ - * sizeof ( SpiceChar ); \ - \ - memmove ( (item), SPICE_CELL_ELEM_C((cell), (i)), nBytes ); \ - \ - item[nBytes] = NULLCHAR; \ - } - - - #define SPICE_CELL_GET_D( cell, i, item ) \ - \ - ( (*item) = ( (SpiceDouble *) (cell)->data)[i] ) - - - #define SPICE_CELL_GET_I( cell, i, item ) \ - \ - ( (*item) = ( (SpiceInt *) (cell)->data)[i] ) - - - /* - Assignment macros: - */ - - #define SPICE_CELL_SET_C( item, i, cell ) \ - \ - { \ - SpiceChar * sPtr; \ - SpiceInt nBytes; \ - \ - nBytes = brckti_c ( strlen(item), 0, (cell)->length - 1 ) \ - * sizeof ( SpiceChar ); \ - \ - sPtr = SPICE_CELL_ELEM_C((cell), (i)); \ - \ - memmove ( sPtr, (item), nBytes ); \ - \ - sPtr[nBytes] = NULLCHAR; \ - } - - - #define SPICE_CELL_SET_D( item, i, cell ) \ - \ - ( ( (SpiceDouble *) (cell)->data)[i] = (item) ) - - - #define SPICE_CELL_SET_I( item, i, cell ) \ - \ - ( ( (SpiceInt *) (cell)->data)[i] = (item) ) - - - /* - The enum SpiceTransDir is used to indicate language translation - direction: C to Fortran or vice versa. - */ - enum _SpiceTransDir { C2F = 0, F2C = 1 }; - - typedef enum _SpiceTransDir SpiceTransDir; - - -#endif - diff --git a/ext/spice/src/csupport/SpiceEK.h b/ext/spice/src/csupport/SpiceEK.h deleted file mode 100644 index cbe213fb01..0000000000 --- a/ext/spice/src/csupport/SpiceEK.h +++ /dev/null @@ -1,448 +0,0 @@ -/* - --Header_File SpiceEK.h ( CSPICE EK-specific definitions ) - --Abstract - - Perform CSPICE EK-specific definitions, including macros and user- - defined types. - --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. - --Particulars - - This header defines macros, enumerated types, structures, and - typedefs that may be referenced in application code that calls CSPICE - EK functions. - - - Macros - ====== - - General limits - -------------- - - Name Description - ---- ---------- - SPICE_EK_MXCLSG Maximum number of columns per segment. - - SPICE_EK_TYPLEN Maximum length of a short string - indicating a data type (one of - {"CHR", "DP", "INT", "TIME"}). Such - strings are returned by some of the - Fortran SPICELIB EK routines, hence also - by their f2c'd counterparts. - - Sizes of EK objects - ------------------- - - Name Description - ---- ---------- - - SPICE_EK_CNAMSZ Maximum length of column name. - SPICE_EK_CSTRLN Length of string required to hold column - name. - SPICE_EK_TNAMSZ Maximum length of table name. - SPICE_EK_TSTRLN Length of string required to hold table - name. - - - Query-related limits - -------------------- - - Name Description - ---- ---------- - - SPICE_EK_MAXQRY Maximum length of an input query. This - value is currently equivalent to - twenty-five 80-character lines. - - SPICE_EK_MAXQSEL Maximum number of columns that may be - listed in the `SELECT clause' of a query. - - SPICE_EK_MAXQTAB Maximum number of tables that may be - listed in the `FROM clause' of a query. - - SPICE_EK_MAXQCON Maximum number of relational expressions - that may be listed in the `constraint - clause' of a query. - - This limit applies to a query when it is - represented in `normalized form': that - is, the constraints have been expressed - as a disjunction of conjunctions of - relational expressions. The number of - relational expressions in a query that - has been expanded in this fashion may be - greater than the number of relations in - the query as orginally written. For - example, the expression - - ( ( A LT 1 ) OR ( B GT 2 ) ) - AND - ( ( C NE 3 ) OR ( D EQ 4 ) ) - - which contains 4 relational expressions, - expands to the equivalent normalized - constraint - - ( ( A LT 1 ) AND ( C NE 3 ) ) - OR - ( ( A LT 1 ) AND ( D EQ 4 ) ) - OR - ( ( B GT 2 ) AND ( C NE 3 ) ) - OR - ( ( B GT 2 ) AND ( D EQ 4 ) ) - - which contains eight relational - expressions. - - - - SPICE_EK_MAXQJOIN Maximum number of tables that can be - joined. - - SPICE_EK_MAXQJCON Maximum number of join constraints - allowed. - - SPICE_EK_MAXQORD Maximum number of columns that may be - used in the `order-by clause' of a query. - - SPICE_EK_MAXQTOK Maximum number of tokens in a query. - Tokens - are reserved words, column names, - parentheses, and values. Literal strings - and time values count as single tokens. - - SPICE_EK_MAXQNUM Maximum number of numeric tokens in a - query. - - SPICE_EK_MAXQCLN Maximum total length of character tokens - in a query. - - SPICE_EK_MAXQSTR Maximum length of literal string values - allowed in queries. - - - Codes - ----- - - Name Description - ---- ---------- - - SPICE_EK_VARSIZ Code used to indicate variable-size - objects. Usually this is used in a - context where a non-negative integer - indicates the size of a fixed-size object - and the presence of this code indicates a - variable-size object. - - The value of this constant must match the - parameter IFALSE used in the Fortran - library SPICELIB. - - - Enumerated Types - ================ - - Enumerated code values - ---------------------- - - Name Description - ---- ---------- - SpiceEKDataType Codes for data types used in the EK - interface: character, double precision, - integer, and "time." - - The values are: - - { SPICE_CHR = 0, - SPICE_DP = 1, - SPICE_INT = 2, - SPICE_TIME = 3 } - - - - SpiceEKExprClass Codes for types of expressions that may - appear in the SELECT clause of EK - queries. Values and meanings are: - - - SPICE_EK_EXP_COL Selected item was a - column. The column - may qualified by a - table name. - - SPICE_EK_EXP_FUNC Selected item was - a simple function - invocation of the - form - - F ( ) - - or else was - - COUNT(*) - - SPICE_EK_EXP_EXPR Selected item was a - more general - expression than - those shown above. - - - Numeric values are: - - { SPICE_EK_EXP_COL = 0, - SPICE_EK_EXP_FUNC = 1, - SPICE_EK_EXP_EXPR = 2 } - - - Structures - ========== - - EK API structures - ----------------- - - Name Description - ---- ---------- - - SpiceEKAttDsc EK column attribute descriptor. Note - that this object is distinct from the EK - column descriptors used internally in - the EK routines; those descriptors - contain pointers as well as attribute - information. - - The members are: - - cclass: Column class code. - - dtype: Data type code: has type - SpiceEKDataType. - - strlen: String length. Applies to - SPICE_CHR type. Value is - SPICE_EK_VARSIZ for - variable-length strings. - - size: Column entry size; this is - the number of array - elements in a column - entry. The value is - SPICE_EK_VARSIZ for - variable-size columns. - - indexd: Index flag; value is - SPICETRUE if the column is - indexed, SPICEFALSE - otherwise. - - nullok: Null flag; value is - SPICETRUE if the column - may contain null values, - SPICEFALSE otherwise. - - - - SpiceEKSegSum EK segment summary. This structure - contains user interface level descriptive - information. The structure contains the - following members: - - tabnam The name of the table to - which the segment belongs. - - nrows The number of rows in the - segment. - - ncols The number of columns in - the segment. - - cnames An array of names of - columns in the segment. - Column names may contain - as many as SPICE_EK_CNAMSZ - characters. The array - contains room for - SPICE_EK_MXCLSG column - names. - - cdescrs An array of column - attribute descriptors of - type SpiceEKAttDsc. - The array contains room - for SPICE_EK_MXCLSG - descriptors. The Ith - descriptor corresponds to - the column whose name is - the Ith element of the - array cnames. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 2.0.0 27-JUL-2002 (NJB) - - Defined SpiceEKDataType using SpiceDataType. Removed declaration - of enum _SpiceEKDataType. - - -CSPICE Version 1.0.0, 05-JUL-1999 (NJB) - - Renamed _SpiceEKAttDsc member "class" to "cclass." The - former name is a reserved word in C++. - - - -CSPICE Version 1.0.0, 24-FEB-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_EK_H - - #define HAVE_SPICE_EK_H - - - - /* - Constants - */ - - /* - Sizes of EK objects: - */ - - #define SPICE_EK_CNAMSZ 32 - #define SPICE_EK_CSTRLN ( SPICE_EK_CNAMSZ + 1 ) - #define SPICE_EK_TNAMSZ 64 - #define SPICE_EK_TSTRLN ( SPICE_EK_TNAMSZ + 1 ) - - - - /* - Maximum number of columns per segment: - */ - - #define SPICE_EK_MXCLSG 100 - - - /* - Maximum length of string indicating data type: - */ - - #define SPICE_EK_TYPLEN 4 - - - /* - Query-related limits (see header for details): - */ - - #define SPICE_EK_MAXQRY 2000 - #define SPICE_EK_MAXQSEL 50 - #define SPICE_EK_MAXQTAB 10 - #define SPICE_EK_MAXQCON 1000 - #define SPICE_EK_MAXQJOIN 10 - #define SPICE_EK_MAXQJCON 100 - #define SPICE_EK_MAXQORD 10 - #define SPICE_EK_MAXQTOK 500 - #define SPICE_EK_MAXQNUM 100 - #define SPICE_EK_MAXQCLN SPICE_EK_MAXQRY - #define SPICE_EK_MAXQSTR 1024 - - - - /* - Code indicating "variable size": - */ - #define SPICE_EK_VARSIZ (-1) - - - - /* - Data type codes: - */ - typedef SpiceDataType SpiceEKDataType; - - - - /* - SELECT clause expression type codes: - */ - enum _SpiceEKExprClass{ SPICE_EK_EXP_COL = 0, - SPICE_EK_EXP_FUNC = 1, - SPICE_EK_EXP_EXPR = 2 }; - - typedef enum _SpiceEKExprClass SpiceEKExprClass; - - - - /* - EK column attribute descriptor: - */ - - struct _SpiceEKAttDsc - - { SpiceInt cclass; - SpiceEKDataType dtype; - SpiceInt strlen; - SpiceInt size; - SpiceBoolean indexd; - SpiceBoolean nullok; }; - - typedef struct _SpiceEKAttDsc SpiceEKAttDsc; - - - - /* - EK segment summary: - */ - - struct _SpiceEKSegSum - - { SpiceChar tabnam [SPICE_EK_TSTRLN]; - SpiceInt nrows; - SpiceInt ncols; - SpiceChar cnames [SPICE_EK_MXCLSG][SPICE_EK_CSTRLN]; - SpiceEKAttDsc cdescrs[SPICE_EK_MXCLSG]; }; - - typedef struct _SpiceEKSegSum SpiceEKSegSum; - - -#endif - diff --git a/ext/spice/src/csupport/SpiceEll.h b/ext/spice/src/csupport/SpiceEll.h deleted file mode 100644 index d0c123ab06..0000000000 --- a/ext/spice/src/csupport/SpiceEll.h +++ /dev/null @@ -1,115 +0,0 @@ -/* - --Header_File SpiceEll.h ( CSPICE Ellipse definitions ) - --Abstract - - Perform CSPICE definitions for the SpiceEllipse data type. - --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. - --Particulars - - This header defines structures and typedefs that may be referenced in - application code that calls CSPICE Ellipse functions. - - - Structures - ========== - - Name Description - ---- ---------- - - SpiceEllipse Structure representing an ellipse in 3- - dimensional space. - - The members are: - - center: Vector defining ellipse's - center. - - semiMajor: Vector defining ellipse's - semi-major axis. - - semiMinor: Vector defining ellipse's - semi-minor axis. - - The ellipse is the set of points - - {X: X = center - + cos(theta) * semiMajor - + sin(theta) * semiMinor, - - theta in [0, 2*Pi) } - - - ConstSpiceEllipse A const SpiceEllipse. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 04-MAR-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_ELLIPSES - - #define HAVE_SPICE_ELLIPSES - - - - /* - Ellipse structure: - */ - - struct _SpiceEllipse - - { SpiceDouble center [3]; - SpiceDouble semiMajor [3]; - SpiceDouble semiMinor [3]; }; - - typedef struct _SpiceEllipse SpiceEllipse; - - typedef const SpiceEllipse ConstSpiceEllipse; - -#endif - diff --git a/ext/spice/src/csupport/SpiceGF.h b/ext/spice/src/csupport/SpiceGF.h deleted file mode 100644 index 14d10de2fd..0000000000 --- a/ext/spice/src/csupport/SpiceGF.h +++ /dev/null @@ -1,319 +0,0 @@ -/* - --Header_File SpiceGF.h ( CSPICE GF-specific definitions ) - --Abstract - - Perform CSPICE GF-specific definitions. - --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 - - GF - --Keywords - - GEOMETRY - SEARCH - --Exceptions - - None - --Files - - None - --Particulars - - This header defines macros that may be referenced in application - code that calls CSPICE GF functions. - - - Macros - ====== - - Workspace parameters - -------------------- - - CSPICE applications normally don't declare workspace arguments - and therefore don't directly reference workspace size parameters. - However, CSPICE GF APIs dealing with numeric constraints - dynamically allocate workspace memory; the amount allocated - depends on the number of intervals the workspace windows can - hold. This amount is an input argument to the GF numeric quantity - APIs. - - The parameters below are used to calculate the amount of memory - required. Each workspace window contains 6 double precision - numbers in its control area and 2 double precision numbers for - each interval it can hold. - - - Name Description - ---- ---------- - SPICE_GF_NWMAX Maximum number of windows required for - a user-defined workspace array. - - SPICE_GF_NWDIST Number of workspace windows used by - gfdist_c and the underlying SPICELIB - routine GFDIST. - - SPICE_GF_NWSEP Number of workspace windows used by - gfsep_c and the underlying SPICELIB - routine GFSEP. - - - - Field of view (FOV) parameters - ------------------------------ - - Name Description - ---- ---------- - SPICE_GF_MAXVRT Maximum allowed number of boundary - vectors for a polygonal FOV. - - SPICE_GF_CIRFOV Parameter identifying a circular FOV. - - SPICE_GF_ELLFOV Parameter identifying a elliptical FOV. - - SPICE_GF_POLFOV Parameter identifying a polygonal FOV. - - SPICE_GF_RECFOV Parameter identifying a rectangular FOV. - - SPICE_GF_SHPLEN Parameter specifying maximum length of - a FOV shape name. - - SPICE_GF_MARGIN is a small positive number used to - constrain the orientation of the - boundary vectors of polygonal FOVs. Such - FOVs must satisfy the following - constraints: - - 1) The boundary vectors must be - contained within a right circular - cone of angular radius less than - than (pi/2) - MARGIN radians; in - other words, there must be a vector - A such that all boundary vectors - have angular separation from A of - less than (pi/2)-MARGIN radians. - - 2) There must be a pair of boundary - vectors U, V such that all other - boundary vectors lie in the same - half space bounded by the plane - containing U and V. Furthermore, all - other boundary vectors must have - orthogonal projections onto a plane - normal to this plane such that the - projections have angular separation - of at least 2*MARGIN radians from - the plane spanned by U and V. - - MARGIN is currently set to 1.D-12. - - - Occultation parameters - ---------------------- - - SPICE_GF_ANNULR Parameter identifying an "annular - occultation." This geometric condition - is more commonly known as a "transit." - The limb of the background object must - not be blocked by the foreground object - in order for an occultation to be - "annular." - - SPICE_GF_ANY Parameter identifying any type of - occultation or transit. - - SPICE_GF_FULL Parameter identifying a full - occultation: the foreground body - entirely blocks the background body. - - SPICE_GF_PARTL Parameter identifying an "partial - occultation." This is an occultation in - which the foreground body blocks part, - but not all, of the limb of the - background body. - - - - Target shape parameters - ----------------------- - - SPICE_GF_EDSHAP Parameter indicating a target object's - shape is modeled as an ellipsoid. - - SPICE_GF_PTSHAP Parameter indicating a target object's - shape is modeled as a point. - - SPICE_GF_RYSHAP Parameter indicating a target object's - "shape" is modeled as a ray emanating - from an observer's location. This model - may be used in visibility computations - for targets whose direction, but not - position, relative to an observer is - known. - - SPICE_GF_SPSHAP Parameter indicating a target object's - shape is modeled as a point. - - - - Search parameters - ----------------- - - These parameters affect the manner in which GF searches are - performed. - - SPICE_GF_ADDWIN is a parameter used in numeric quantity - searches that use an equality - constraint. This parameter is used to - expand the confinement window (the - window over which the search is - performed) by a small amount at both - ends. This expansion accommodates the - case where a geometric quantity is equal - to a reference value at a boundary point - of the original confinement window. - - SPICE_GF_CNVTOL is the default convergence tolerance - used by GF routines that don't support a - user-supplied tolerance value. GF - searches for roots will terminate when a - root is bracketed by times separated by - no more than this tolerance. Units are - seconds. - - Configuration parameter - ----------------------- - - SPICE_GFEVNT_MAXPAR Parameter indicating the maximum number of - elements needed for the 'qnames' and 'q*pars' - arrays used in gfevnt_c. - - SpiceChar qcpars[SPICE_GFEVNT_MAXPAR][LNSIZE]; - SpiceDouble qdpars[SPICE_GFEVNT_MAXPAR]; - SpiceInt qipars[SPICE_GFEVNT_MAXPAR]; - SpiceBoolean qlpars[SPICE_GFEVNT_MAXPAR]; - --Examples - - None - --Restrictions - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - L.S. Elson (JPL) - --Version - - -CSPICE Version 2.0.0, 23-JUN-2009 (NJB) - - Added parameter for maximum length of FOV shape string. - - -CSPICE Version 1.0.0, 11-MAR-2009 (NJB) - -*/ - - -#ifndef HAVE_SPICE_GF_H - - #define HAVE_SPICE_GF_H - - - /* - See the Particulars section above for parameter descriptions. - */ - - /* - Workspace parameters - */ - #define SPICE_GF_NWMAX 15 - #define SPICE_GF_NWDIST 5 - #define SPICE_GF_NWSEP 5 - - - /* - Field of view (FOV) parameters - */ - #define SPICE_GF_MAXVRT 10000 - #define SPICE_GF_CIRFOV "CIRCLE" - #define SPICE_GF_ELLFOV "ELLIPSE" - #define SPICE_GF_POLFOV "POLYGON" - #define SPICE_GF_RECFOV "RECTANGLE" - #define SPICE_GF_SHPLEN 10 - #define SPICE_GF_MARGIN ( 1.e-12 ) - - - /* - Occultation parameters - */ - #define SPICE_GF_ANNULR "ANNULAR" - #define SPICE_GF_ANY "ANY" - #define SPICE_GF_FULL "FULL" - #define SPICE_GF_PARTL "PARTIAL" - - - /* - Target shape parameters - */ - #define SPICE_GF_EDSHAP "ELLIPSOID" - #define SPICE_GF_PTSHAP "POINT" - #define SPICE_GF_RYSHAP "RAY" - #define SPICE_GF_SPSHAP "SPHERE" - - - /* - Search parameters - */ - #define SPICE_GF_ADDWIN 1.0 - #define SPICE_GF_CNVTOL 1.e-6 - - - /* - Configuration parameters. - */ - #define SPICE_GFEVNT_MAXPAR 10 - - -#endif - - -/* - End of header file SpiceGF.h -*/ diff --git a/ext/spice/src/csupport/SpicePln.h b/ext/spice/src/csupport/SpicePln.h deleted file mode 100644 index 839fb15606..0000000000 --- a/ext/spice/src/csupport/SpicePln.h +++ /dev/null @@ -1,106 +0,0 @@ -/* - --Header_File SpicePln.h ( CSPICE Plane definitions ) - --Abstract - - Perform CSPICE definitions for the SpicePlane data type. - --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. - --Particulars - - This header defines structures and typedefs that may be referenced in - application code that calls CSPICE Plane functions. - - - Structures - ========== - - Name Description - ---- ---------- - - SpicePlane Structure representing a plane in 3- - dimensional space. - - The members are: - - normal: Vector normal to plane. - - constant: Constant of plane equation - - Plane = - - {X: = constant} - - - - ConstSpicePlane A const SpicePlane. - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 04-MAR-1999 (NJB) - -*/ - -#ifndef HAVE_SPICE_PLANES - - #define HAVE_SPICE_PLANES - - - - /* - Plane structure: - */ - - struct _SpicePlane - - { SpiceDouble normal [3]; - SpiceDouble constant; }; - - typedef struct _SpicePlane SpicePlane; - - typedef const SpicePlane ConstSpicePlane; - -#endif - diff --git a/ext/spice/src/csupport/SpiceSPK.h b/ext/spice/src/csupport/SpiceSPK.h deleted file mode 100644 index a4c8eac5f7..0000000000 --- a/ext/spice/src/csupport/SpiceSPK.h +++ /dev/null @@ -1,128 +0,0 @@ -/* - --Header_File SpiceSPK.h ( CSPICE SPK definitions ) - --Abstract - - Perform CSPICE definitions to support SPK wrapper interfaces. - --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. - --Particulars - - This header defines types that may be referenced in - application code that calls CSPICE SPK functions. - - Typedef - ======= - - Name Description - ---- ---------- - - SpiceSPK18Subtype Typedef for enum indicating the - mathematical representation used - in an SPK type 18 segment. Possible - values and meanings are: - - S18TP0: - - Hermite interpolation, 12- - element packets containing - - x, y, z, dx/dt, dy/dt, dz/dt, - vx, vy, vz, dvx/dt, dvy/dt, dvz/dt - - where x, y, z represent Cartesian - position components and vx, vy, vz - represent Cartesian velocity - components. Note well: vx, vy, and - vz *are not necessarily equal* to the - time derivatives of x, y, and z. - This packet structure mimics that of - the Rosetta/MEX orbit file from which - the data are taken. - - Position units are kilometers, - velocity units are kilometers per - second, and acceleration units are - kilometers per second per second. - - - S18TP1: - - Lagrange interpolation, 6- - element packets containing - - x, y, z, dx/dt, dy/dt, dz/dt - - where x, y, z represent Cartesian - position components and vx, vy, vz - represent Cartesian velocity - components. - - Position units are kilometers; - velocity units are kilometers per - second. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 1.0.0, 16-AUG-2002 (NJB) - -*/ - -#ifndef HAVE_SPICE_SPK_H - - #define HAVE_SPICE_SPK_H - - - - /* - SPK type 18 subtype codes: - */ - - enum _SpiceSPK18Subtype { S18TP0, S18TP1 }; - - - typedef enum _SpiceSPK18Subtype SpiceSPK18Subtype; - -#endif - diff --git a/ext/spice/src/csupport/SpiceUsr.h b/ext/spice/src/csupport/SpiceUsr.h deleted file mode 100644 index 83038e32a3..0000000000 --- a/ext/spice/src/csupport/SpiceUsr.h +++ /dev/null @@ -1,217 +0,0 @@ -/* - --Header_File SpiceUsr.h ( CSPICE user interface definitions ) - --Abstract - - Perform CSPICE user interface declarations, including type - definitions and function prototype declarations. - --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. - --Particulars - - This file is an umbrella header that includes all header files - required to support the CSPICE application programming interface - (API). Users' application code that calls CSPICE need include only - this single header file. This file includes function prototypes for - the entire set of CSPICE routines. Typedef statements used to create - SPICE data types are also included. - - - About SPICE data types - ====================== - - To assist with long-term maintainability of CSPICE, NAIF has elected - to use typedefs to represent data types occurring in argument lists - and as return values of CSPICE functions. These are: - - SpiceBoolean - SpiceChar - SpiceDouble - SpiceInt - ConstSpiceBoolean - ConstSpiceChar - ConstSpiceDouble - ConstSpiceInt - - The SPICE typedefs map in an arguably natural way to ANSI C types: - - SpiceBoolean -> enum { SPICEFALSE = 0, SPICETRUE = 1 } - SpiceChar -> char - SpiceDouble -> double - SpiceInt -> int or long - ConstX -> const X (X = any of the above types) - - The type SpiceInt is a special case: the corresponding type is picked - so as to be half the size of a double. On all currently supported - platforms, type double occupies 8 bytes and type int occupies 4 - bytes. Other platforms may require a SpiceInt to map to type long. - - While other data types may be used internally in CSPICE, no other - types appear in the API. - - - About CSPICE function prototypes - ================================ - - Because CSPICE function prototypes enable substantial - compile-time error checking, we recommend that user - applications always reference them. Including the header - file SpiceUsr.h in any module that calls CSPICE will - automatically make the prototypes available. - - - About CSPICE C style - ==================== - - CSPICE is written in ANSI C. No attempt has been made to support K&R - conventions or restrictions. - - - About C++ compatibility - ======================= - - The preprocessor directive -D__cplusplus should be used when - compiling C++ source code that includes this header file. This - directive will suppress mangling of CSPICE names, permitting linkage - to a CSPICE object library built from object modules produced by - an ANSI C compiler. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Restrictions - - The #include statements contained in this file are not part of - the CSPICE API. The set of files included may change without notice. - Users should not include these files directly in their own - application code. - --Version - - -CSPICE Version 4.0.0, 30-SEP-2008 (NJB) - - Updated to include header file - - SpiceGF.h - - -CSPICE Version 3.0.0, 19-AUG-2002 (NJB) - - Updated to include header files - - SpiceCel.h - SpiceCK.h - SpiceSPK.h - - -CSPICE Version 3.0.0, 17-FEB-1999 (NJB) - - Updated to support suppression of name mangling when included in - C++ source code. Also now interface macros to intercept function - calls and perform automatic type casting. - - Now includes platform macro definition header file. - - References to types SpiceVoid and ConstSpiceVoid were removed. - - -CSPICE Version 2.0.0, 06-MAY-1998 (NJB) (EDW) - -*/ - -#ifdef __cplusplus - extern "C" { -#endif - - -#ifndef HAVE_SPICE_USER - - #define HAVE_SPICE_USER - - - /* - Include CSPICE platform macro definitions. - */ - #include "SpiceZpl.h" - - /* - Include CSPICE data type definitions. - */ - #include "SpiceZdf.h" - - /* - Include the CSPICE EK interface definitions. - */ - #include "SpiceEK.h" - - /* - Include the CSPICE Cell interface definitions. - */ - #include "SpiceCel.h" - - /* - Include the CSPICE CK interface definitions. - */ - #include "SpiceCK.h" - - /* - Include the CSPICE SPK interface definitions. - */ - #include "SpiceSPK.h" - - /* - Include the CSPICE GF interface definitions. - */ - #include "SpiceGF.h" - - /* - Include CSPICE prototypes. - */ - #include "SpiceZpr.h" - - /* - Define the CSPICE function interface macros. - */ - #include "SpiceZim.h" - - - -#endif - - -#ifdef __cplusplus - } -#endif - diff --git a/ext/spice/src/csupport/SpiceZad.h b/ext/spice/src/csupport/SpiceZad.h deleted file mode 100644 index f838e7f31c..0000000000 --- a/ext/spice/src/csupport/SpiceZad.h +++ /dev/null @@ -1,205 +0,0 @@ -/* - --Header_File SpiceZad.h ( CSPICE adapter definitions ) - --Abstract - - Perform CSPICE declarations to support passed-in function - adapters used in wrapper interfaces. - --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. - --Particulars - - This header file contains declarations used by the CSPICE - passed-in function adapter ("PFA") system. This system enables - CSPICE wrapper functions to support passed-in function - arguments whose prototypes are C-style, even when these - functions are to be called from f2c'd Fortran routines - expecting f2c-style interfaces. - - This header declares: - - - The prototype for the passed-in function argument - pointer storage and fetch routines - - zzadsave_c - zzadget_c - - - Prototypes for CSPICE adapter functions. Each passed-in - function argument in a CSPICE wrapper has a corresponding - adapter function. The adapter functions have interfaces - that match those of their f2c'd counterparts; this allows - the adapters to be called by f2c'd SPICELIB code. The - adapters look up saved function pointers for routines - passed in by the wrapper's caller and call these functions. - - - Values for the enumerated type SpicePassedInFunc. These - values are used to map function pointers to the - functions they represent, enabling adapters to call - the correct passed-in functions. - -Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 2.1.0, 21-DEC-2009 (EDW) - - Updated to support the user defined scalar function capability. - - -CSPICE Version 2.0.0, 29-JAN-2009 (NJB) - - Now conditionally includes SpiceZfc.h. - - Updated to reflect new calling sequence of f2c'd - routine gfrefn_. Some header updates were made - as well. - - -CSPICE Version 1.0.0, 29-MAR-2008 (NJB) - -*/ - - -/* - This file has dependencies defined in SpiceZfc.h. Include that - file if it hasn't already been included. -*/ -#ifndef HAVE_SPICEF2C_H - #include "SpiceZfc.h" -#endif - - - -#ifndef HAVE_SPICE_ZAD_H - - #define HAVE_SPICE_ZAD_H - - - - /* - Prototypes for GF adapters: - */ - - logical zzadbail_c ( void ); - - - int zzadstep_c ( doublereal * et, - doublereal * step ); - - - int zzadrefn_c ( doublereal * t1, - doublereal * t2, - logical * s1, - logical * s2, - doublereal * t ); - - - int zzadrepf_c ( void ); - - - int zzadrepi_c ( doublereal * cnfine, - char * srcpre, - char * srcsuf, - ftnlen srcprelen, - ftnlen srcsuflen ); - - - int zzadrepu_c ( doublereal * ivbeg, - doublereal * ivend, - doublereal * et ); - - - int zzadfunc_c ( doublereal * et, - doublereal * value ); - - - int zzadqdec_c ( U_fp udfunc, - doublereal * et, - logical * xbool ); - - /* - Define the enumerated type - - SpicePassedInFunc - - for names of passed-in functions. Using this type gives - us compile-time checking and avoids string comparisons. - */ - enum _SpicePassedInFunc { - UDBAIL, - UDREFN, - UDREPF, - UDREPI, - UDREPU, - UDSTEP, - UDFUNC, - UDQDEC, - }; - - typedef enum _SpicePassedInFunc SpicePassedInFunc; - - /* - SPICE_N_PASSED_IN_FUNC is the count of SpicePassedInFunc values. - */ - #define SPICE_N_PASSED_IN_FUNC 8 - - - /* - CSPICE wrappers supporting passed-in function arguments call - the adapter setup interface function once per each such argument; - these calls save the function pointers for later use within the - f2c'd code that calls passed-in functions. The saved pointers - will be used in calls by the adapter functions whose prototypes - are declared above. - - Prototypes for adapter setup interface: - */ - void zzadsave_c ( SpicePassedInFunc functionID, - void * functionPtr ); - - void * zzadget_c ( SpicePassedInFunc functionID ); - - -#endif - -/* -End of header file SpiceZad.h -*/ - diff --git a/ext/spice/src/csupport/SpiceZdf.h b/ext/spice/src/csupport/SpiceZdf.h deleted file mode 100644 index 36276051d6..0000000000 --- a/ext/spice/src/csupport/SpiceZdf.h +++ /dev/null @@ -1,246 +0,0 @@ -/* - --Header_File SpiceZdf.h ( CSPICE definitions ) - --Abstract - - Define CSPICE data types via typedefs; also define some user-visible - enumerated types. - --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. - --Particulars - - CSPICE data types - ================= - - To assist with long-term maintainability of CSPICE, NAIF has elected - to use typedefs to represent data types occurring in argument lists - and as return values of CSPICE functions. These are: - - SpiceBoolean - SpiceChar - SpiceDouble - SpiceInt - ConstSpiceBoolean - ConstSpiceChar - ConstSpiceDouble - ConstSpiceInt - - The SPICE typedefs map in an arguably natural way to ANSI C types: - - SpiceBoolean -> int - SpiceChar -> char - SpiceDouble -> double - SpiceInt -> int or long - ConstX -> const X (X = any of the above types) - - The type SpiceInt is a special case: the corresponding type is picked - so as to be half the size of a double. On most currently supported - platforms, type double occupies 8 bytes and type long occupies 4 - bytes. Other platforms may require a SpiceInt to map to type int. - The Alpha/Digital Unix platform is an example of the latter case. - - While other data types may be used internally in CSPICE, no other - types appear in the API. - - - CSPICE enumerated types - ======================= - - These are provided to enhance readability of the code. - - Type name Value set - --------- --------- - - _Spicestatus { SPICEFAILURE = -1, SPICESUCCESS = 0 } - - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Restrictions - - None. - --Version - - -CSPICE Version 6.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 6.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 5.0.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 4.0.0 27-JUL-2002 (NJB) - - Added definition of SpiceDataType. - - -CSPICE Version 3.0.0 18-SEP-1999 (NJB) - - SpiceBoolean implementation changed from enumerated type to - typedef mapping to int. - - -CSPICE Version 2.0.0 29-JAN-1999 (NJB) - - Made definition of SpiceInt and ConstSpiceInt platform - dependent to accommodate the Alpha/Digital Unix platform. - - Removed definitions of SpiceVoid and ConstSpiceVoid. - - -CSPICE Version 1.0.0 25-OCT-1997 (KRG) (NJB) (EDW) -*/ - - #ifndef HAVE_SPICEDEFS_H - #define HAVE_SPICEDEFS_H - - /* - Include platform definitions, if they haven't been executed already. - */ - #ifndef HAVE_PLATFORM_MACROS_H - #include "SpiceZpl.h" - #endif - - /* - Basic data types. These are defined to be compatible with the - types used by f2c, and so they follow the Fortran notion of what - these things are. See the f2c documentation for the details - about the choices for the sizes of these types. - */ - typedef char SpiceChar; - typedef double SpiceDouble; - typedef float SpiceFloat; - - - - #if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - typedef int SpiceInt; - #else - typedef long SpiceInt; - #endif - - - typedef const char ConstSpiceChar; - typedef const double ConstSpiceDouble; - typedef const float ConstSpiceFloat; - - - #if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - typedef const int ConstSpiceInt; - #else - typedef const long ConstSpiceInt; - #endif - - - /* - More basic data types. These give mnemonics for some other data - types in C that are not used in Fortran written by NAIF or - supported by ANSI Fortran 77. These are for use in C functions - but should not be passed to any C SPICE wrappers, ``*_c.c'' - since they are not Fortran compatible. - */ - typedef long SpiceLong; - typedef short SpiceShort; - - /* - Unsigned data types - */ - typedef unsigned char SpiceUChar; - typedef unsigned int SpiceUInt; - typedef unsigned long SpiceULong; - typedef unsigned short SpiceUShort; - - /* - Signed data types - */ - typedef signed char SpiceSChar; - - /* - Other basic types - */ - typedef int SpiceBoolean; - typedef const int ConstSpiceBoolean; - - #define SPICETRUE 1 - #define SPICEFALSE 0 - - - enum _Spicestatus { SPICEFAILURE = -1, SPICESUCCESS = 0 }; - - typedef enum _Spicestatus SpiceStatus; - - - enum _SpiceDataType { SPICE_CHR = 0, - SPICE_DP = 1, - SPICE_INT = 2, - SPICE_TIME = 3, - SPICE_BOOL = 4 }; - - - typedef enum _SpiceDataType SpiceDataType; - - -#endif diff --git a/ext/spice/src/csupport/SpiceZfc.h b/ext/spice/src/csupport/SpiceZfc.h deleted file mode 100644 index 33f541770b..0000000000 --- a/ext/spice/src/csupport/SpiceZfc.h +++ /dev/null @@ -1,13228 +0,0 @@ -/* - --Header_File SpiceZfc.h ( f2c'd SPICELIB prototypes ) - --Abstract - - Define prototypes for functions produced by converting Fortran - SPICELIB routines to C using f2c. - --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. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - - CSPICE Version 6.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - - CSPICE Version 6.0.0, 21-FEB-2006 (NJB) - - Added typedefs for the PC-LINUX-64BIT-GCC_C - environment (these are identical to those for the - ALPHA-DIGITAL-UNIX_C environment). - - - C-SPICELIB Version 5.0.0, 06-MAR-2005 (NJB) - - Added typedefs for pointers to functions. This change was - made to support CSPICE wrappers for geometry finder routines. - - Added typedefs for the SUN-SOLARIS-64BIT-GCC_C - environment (these are identical to those for the - ALPHA-DIGITAL-UNIX_C environment). - - - C-SPICELIB Version 4.1.0, 24-MAY-2001 (WLT) - - Moved the #ifdef __cplusplus so that it appears after the - typedefs. This allows us to more easily wrap CSPICE in a - namespace for C++. - - - C-SPICELIB Version 4.0.0, 09-FEB-1999 (NJB) - - Updated to accommodate the Alpha/Digital Unix platform. - Also updated to support inclusion in C++ code. - - - C-SPICELIB Version 3.0.0, 02-NOV-1998 (NJB) - - Updated for SPICELIB version N0049. - - - C-SPICELIB Version 2.0.0, 15-SEP-1997 (NJB) - - Changed variable name "typid" to "typid" in prototype - for zzfdat_. This was done to enable compilation under - Borland C++. - - - C-SPICELIB Version 1.0.0, 15-SEP-1997 (NJB) (KRG) - --Index_Entries - - prototypes of f2c'd SPICELIB functions - -*/ - - -#ifndef HAVE_SPICEF2C_H -#define HAVE_SPICEF2C_H - - - -/* - Include Files: - - Many of the prototypes below use data types defined by f2c. We - copy here the f2c definitions that occur in prototypes of functions - produced by running f2c on Fortran SPICELIB routines. - - The reason we don't simply conditionally include f2c.h itself here - is that f2c.h defines macros that conflict with stdlib.h on some - systems. It's simpler to just replicate the few typedefs we need. -*/ - -#if ( defined( CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined( CSPICE_PC_LINUX_64BIT_GCC ) \ - || defined( CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined( CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined( CSPICE_SUN_SOLARIS_64BIT_NATIVE) \ - || defined( CSPICE_SUN_SOLARIS_64BIT_GCC ) ) - - #define VOID void - - typedef VOID H_f; - typedef int integer; - typedef double doublereal; - typedef int logical; - typedef int ftnlen; - - - /* - Type H_fp is used for character return type. - Type S_fp is used for subroutines. - Type U_fp is used for functions of unknown type. - */ - typedef VOID (*H_fp)(); - typedef doublereal (*D_fp)(); - typedef doublereal (*E_fp)(); - typedef int (*S_fp)(); - typedef int (*U_fp)(); - typedef integer (*I_fp)(); - typedef logical (*L_fp)(); - -#else - - #define VOID void - - typedef VOID H_f; - typedef long integer; - typedef double doublereal; - typedef long logical; - typedef long ftnlen; - - /* - Type H_fp is used for character return type. - Type S_fp is used for subroutines. - Type U_fp is used for functions of unknown type. - */ - typedef VOID (*H_fp)(); - typedef doublereal (*D_fp)(); - typedef doublereal (*E_fp)(); - typedef int (*S_fp)(); - typedef int (*U_fp)(); - typedef integer (*I_fp)(); - typedef logical (*L_fp)(); - -#endif - - -#ifdef __cplusplus - extern "C" { -#endif - - -/* - Function prototypes for functions created by f2c are listed below. - See the headers of the Fortran routines for descriptions of the - routines' interfaces. - - The functions listed below are those expected to be called by - C-SPICELIB wrappers. Prototypes are not currently provided for other - f2c'd functions. - -*/ - -/* --Prototypes -*/ - -extern logical accept_(logical *ok); -extern logical allowd_(void); - -extern logical alltru_(logical *logcls, integer *n); - -extern H_f ana_(char *ret_val, ftnlen ret_val_len, char *word, char *case__, ftnlen word_len, ftnlen case_len); -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: replch_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int appndc_(char *item, char *cell, ftnlen item_len, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int appndd_(doublereal *item, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int appndi_(integer *item, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical approx_(doublereal *x, doublereal *y, doublereal *tol); - -extern int astrip_(char *instr, char *asciib, char *asciie, char *outstr, ftnlen instr_len, ftnlen asciib_len, ftnlen asciie_len, ftnlen outstr_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern int axisar_(doublereal *axis, doublereal *angle, doublereal *r__); -/*:ref: ident_ 14 1 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern doublereal b1900_(void); - -extern doublereal b1950_(void); - -extern logical badkpv_(char *caller, char *name__, char *comp, integer *size, integer *divby, char *type__, ftnlen caller_len, ftnlen name_len, ftnlen comp_len, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ - -extern logical bedec_(char *string, ftnlen string_len); -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: beuns_ 12 2 13 124 */ - -extern logical beint_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: beuns_ 12 2 13 124 */ - -extern logical benum_(char *string, ftnlen string_len); -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: bedec_ 12 2 13 124 */ -/*:ref: beint_ 12 2 13 124 */ - -extern logical beuns_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ - -extern int bodc2n_(integer *code, char *name__, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodc2n_ 14 4 4 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodc2s_(integer *code, char *name__, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodc2n_ 14 4 4 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int boddef_(char *name__, integer *code, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzboddef_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodeul_(integer *body, doublereal *et, doublereal *ra, doublereal *dec, doublereal *w, doublereal *lambda); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckeul_ 14 6 4 7 12 13 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: m2eul_ 14 7 7 4 4 4 7 7 7 */ - -extern logical bodfnd_(integer *body, char *item, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodmat_(integer *body, doublereal *et, doublereal *tipm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckmat_ 14 5 4 7 4 7 12 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: ccifrm_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int bodn2c_(char *name__, integer *code, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bods2c_(char *name__, integer *code, logical *found, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodvar_(integer *body, char *item, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: rtpool_ 14 5 13 4 7 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int bodvcd_(integer *bodyid, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int bodvrd_(char *bodynm, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen bodynm_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern doublereal brcktd_(doublereal *number, doublereal *end1, doublereal *end2); - -extern integer brckti_(integer *number, integer *end1, integer *end2); - -extern integer bschoc_(char *value, integer *ndim, char *array, integer *order, ftnlen value_len, ftnlen array_len); - -extern integer bschoi_(integer *value, integer *ndim, integer *array, integer *order); - -extern integer bsrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern integer bsrchd_(doublereal *value, integer *ndim, doublereal *array); - -extern integer bsrchi_(integer *value, integer *ndim, integer *array); - -extern integer cardc_(char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer cardd_(doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer cardi_(integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cgv2el_(doublereal *center, doublereal *vec1, doublereal *vec2, doublereal *ellips); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer chbase_(void); - -extern int chbder_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, integer *nderiv, doublereal *partdp, doublereal *dpdxs); - -extern int chbint_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, doublereal *p, doublereal *dpdx); - -extern int chbval_(doublereal *cp, integer *degp, doublereal *x2s, doublereal *x, doublereal *p); - -extern int chckid_(char *class__, integer *maxlen, char *id, ftnlen class_len, ftnlen id_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int chgirf_(integer *refa, integer *refb, doublereal *rotab, char *name__, integer *index, ftnlen name_len); -extern int irfrot_(integer *refa, integer *refb, doublereal *rotab); -extern int irfnum_(char *name__, integer *index, ftnlen name_len); -extern int irfnam_(integer *index, char *name__, ftnlen name_len); -extern int irfdef_(integer *index); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rotate_ 14 3 7 4 7 */ -/*:ref: wdcnt_ 4 2 13 124 */ -/*:ref: nthwd_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: rotmat_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: esrchc_ 4 5 13 4 13 124 124 */ - -extern int ckbsr_(char *fname, integer *handle, integer *inst, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *descr, char *segid, logical *found, ftnlen fname_len, ftnlen segid_len); -extern int cklpf_(char *fname, integer *handle, ftnlen fname_len); -extern int ckupf_(integer *handle); -extern int ckbss_(integer *inst, doublereal *sclkdp, doublereal *tol, logical *needav); -extern int cksns_(integer *handle, doublereal *descr, char *segid, logical *found, ftnlen segid_len); -extern int ckhave_(logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ - -extern int ckcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int ckcov_(char *ck, integer *idcode, logical *needav, char *level, doublereal *tol, char *timsys, doublereal *cover, ftnlen ck_len, ftnlen level_len, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: zzckcv01_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv02_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv03_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv04_ 14 8 4 4 4 4 7 13 7 124 */ -/*:ref: zzckcv05_ 14 9 4 4 4 4 7 7 13 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int cke01_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cke02_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequg_ 14 3 7 4 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: axisar_ 14 3 7 7 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cke03_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mtxm_ 14 3 7 7 7 */ -/*:ref: raxisa_ 14 3 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: axisar_ 14 3 7 7 7 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int cke04_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ - -extern int cke05_(logical *needav, doublereal *record, doublereal *cmat, doublereal *av, doublereal *clkout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: vdistg_ 7 3 7 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpsgip_ 14 3 4 4 7 */ -/*:ref: lgrind_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: qdq2av_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: q2m_ 14 2 7 7 */ - -extern int ckfrot_(integer *inst, doublereal *et, doublereal *rotate, integer *ref, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ckhave_ 14 1 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ -/*:ref: sce2c_ 14 3 4 7 7 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int ckfxfm_(integer *inst, doublereal *et, doublereal *xform, integer *ref, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: ckhave_ 14 1 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ -/*:ref: sce2c_ 14 3 4 7 7 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: rav2xf_ 14 3 7 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol, char *ref, doublereal *cmat, doublereal *clkout, logical *found, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckgpav_(integer *inst, doublereal *sclkdp, doublereal *tol, char *ref, doublereal *cmat, doublereal *av, doublereal *clkout, logical *found, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ckbss_ 14 4 4 7 7 12 */ -/*:ref: cksns_ 14 5 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckpfs_ 14 9 4 7 7 7 12 7 7 7 12 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: xf2rav_ 14 3 7 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int ckgr01_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckgr02_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr02_ 14 3 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckgr03_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckgr04_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: zzck4d2i_ 14 4 7 4 7 4 */ - -extern int ckgr05_(integer *handle, doublereal *descr, integer *recno, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckmeta_(integer *ckid, char *meta, integer *idcode, ftnlen meta_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int cknr01_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int cknr02_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int cknr03_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int cknr04_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ - -extern int cknr05_(integer *handle, doublereal *descr, integer *nrec); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int ckobj_(char *ck, integer *ids, ftnlen ck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int ckopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ckpfs_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *cmat, doublereal *av, doublereal *clkout, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: ckr01_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke01_ 14 5 12 7 7 7 7 */ -/*:ref: ckr02_ 14 6 4 7 7 7 7 12 */ -/*:ref: cke02_ 14 5 12 7 7 7 7 */ -/*:ref: ckr03_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke03_ 14 5 12 7 7 7 7 */ -/*:ref: ckr04_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke04_ 14 5 12 7 7 7 7 */ -/*:ref: ckr05_ 14 7 4 7 7 7 12 7 12 */ -/*:ref: cke05_ 14 5 12 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ckr01_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: lstcld_ 4 3 7 4 7 */ - -extern int ckr02_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: vequg_ 14 3 7 4 7 */ - -extern int ckr03_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dpmax_ 7 0 */ - -extern int ckr04_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: zzck4d2i_ 14 4 7 4 7 4 */ - -extern int ckr05_(integer *handle, doublereal *descr, doublereal *sclkdp, doublereal *tol, logical *needav, doublereal *record, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int ckw01_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw02_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, char *segid, integer *nrec, doublereal *start, doublereal *stop, doublereal *quats, doublereal *avvs, doublereal *rates, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw03_(integer *handle, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int ckw04a_(integer *handle, integer *npkts, integer *pktsiz, doublereal *pktdat, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzck4i2d_ 14 4 4 4 7 7 */ -/*:ref: sgwvpk_ 14 6 4 4 4 7 4 7 */ - -extern int ckw04b_(integer *handle, doublereal *begtim, integer *inst, char *ref, logical *avflag, char *segid, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: sgbwvs_ 14 7 4 7 13 4 7 4 124 */ - -extern int ckw04e_(integer *handle, doublereal *endtim); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafrs_ 14 1 7 */ - -extern int ckw05_(integer *handle, integer *subtyp, integer *degree, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *n, doublereal *sclkdp, doublereal *packts, doublereal *rate, integer *nints, doublereal *starts, ftnlen ref_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int clearc_(integer *ndim, char *array, ftnlen array_len); - -extern int cleard_(integer *ndim, doublereal *array); - -extern int cleari_(integer *ndim, integer *array); - -extern doublereal clight_(void); - -extern int cmprss_(char *delim, integer *n, char *input, char *output, ftnlen delim_len, ftnlen input_len, ftnlen output_len); - -extern int conics_(doublereal *elts, doublereal *et, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ - -extern int convrt_(doublereal *x, char *in, char *out, doublereal *y, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpr_ 7 0 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int copyc_(char *cell, char *copy, ftnlen cell_len, ftnlen copy_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int copyd_(doublereal *cell, doublereal *copy); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int copyi_(integer *cell, integer *copy); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer countc_(integer *unit, integer *bline, integer *eline, char *line, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: astrip_ 14 8 13 13 13 13 124 124 124 124 */ - -extern integer cpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern integer cposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern int cyacip_(integer *nelt, char *dir, integer *ncycle, char *array, ftnlen dir_len, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: nbwid_ 4 3 13 4 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyadip_(integer *nelt, char *dir, integer *ncycle, doublereal *array, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyaiip_(integer *nelt, char *dir, integer *ncycle, integer *array, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclac_(char *array, integer *nelt, char *dir, integer *ncycle, char *out, ftnlen array_len, ftnlen dir_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: nbwid_ 4 3 13 4 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclad_(doublereal *array, integer *nelt, char *dir, integer *ncycle, doublereal *out, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclai_(integer *array, integer *nelt, char *dir, integer *ncycle, integer *out, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyclec_(char *instr, char *dir, integer *ncycle, char *outstr, ftnlen instr_len, ftnlen dir_len, ftnlen outstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: gcd_ 4 2 4 4 */ - -extern int cyllat_(doublereal *r__, doublereal *longc, doublereal *z__, doublereal *radius, doublereal *long__, doublereal *lat); - -extern int cylrec_(doublereal *r__, doublereal *long__, doublereal *z__, doublereal *rectan); - -extern int cylsph_(doublereal *r__, doublereal *longc, doublereal *z__, doublereal *radius, doublereal *colat, doublereal *long__); - -extern doublereal dacosh_(doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal dacosn_(doublereal *arg, doublereal *tol); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafa2b_(char *ascii, char *binary, integer *resv, ftnlen ascii_len, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daft2b_ 14 4 4 13 4 124 */ - -extern int dafac_(integer *handle, integer *n, char *buffer, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ -/*:ref: dafarr_ 14 2 4 4 */ - -extern int dafah_(char *fname, char *ftype, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, integer *unit, integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len); -extern int dafopr_(char *fname, integer *handle, ftnlen fname_len); -extern int dafopw_(char *fname, integer *handle, ftnlen fname_len); -extern int dafonw_(char *fname, char *ftype, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len); -extern int dafopn_(char *fname, integer *nd, integer *ni, char *ifname, integer *resv, integer *handle, ftnlen fname_len, ftnlen ifname_len); -extern int dafcls_(integer *handle); -extern int dafhsf_(integer *handle, integer *nd, integer *ni); -extern int dafhlu_(integer *handle, integer *unit); -extern int dafluh_(integer *unit, integer *handle); -extern int dafhfn_(integer *handle, char *fname, ftnlen fname_len); -extern int daffnh_(char *fname, integer *handle, ftnlen fname_len); -extern int dafhof_(integer *fhset); -extern int dafsih_(integer *handle, char *access, ftnlen access_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: zzddhopn_ 14 7 13 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzdafgfr_ 14 11 4 13 4 4 13 4 4 4 12 124 124 */ -/*:ref: zzddhcls_ 14 4 4 13 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafrwa_ 14 3 4 4 4 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: zzdafnfr_ 14 12 4 13 4 4 13 4 4 4 13 124 124 124 */ -/*:ref: removi_ 14 2 4 4 */ -/*:ref: zzddhluh_ 14 3 4 4 12 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzddhfnh_ 14 4 13 4 12 124 */ -/*:ref: copyi_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: elemi_ 12 2 4 4 */ - -extern int dafana_(integer *handle, doublereal *sum, char *name__, doublereal *data, integer *n, ftnlen name_len); -extern int dafbna_(integer *handle, doublereal *sum, char *name__, ftnlen name_len); -extern int dafada_(doublereal *data, integer *n); -extern int dafena_(void); -extern int dafcad_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafhof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafhfn_ 14 3 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafwda_ 14 4 4 4 4 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafrwa_ 14 3 4 4 4 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ - -extern int dafarr_(integer *handle, integer *resv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafws_ 14 1 7 */ - -extern int dafb2a_(char *binary, char *ascii, ftnlen binary_len, ftnlen ascii_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopn_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafb2t_ 14 3 13 4 124 */ - -extern int dafb2t_(char *binary, integer *text, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int dafbt_(char *binfil, integer *xfrlun, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: wrenci_ 14 3 4 4 4 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: wrencd_ 14 3 4 4 7 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int dafdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrrr_ 14 2 4 4 */ - -extern int dafec_(integer *handle, integer *bufsiz, integer *n, char *buffer, logical *done, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int daffa_(integer *handle, doublereal *sum, char *name__, logical *found, ftnlen name_len); -extern int dafbfs_(integer *handle); -extern int daffna_(logical *found); -extern int dafbbs_(integer *handle); -extern int daffpa_(logical *found); -extern int dafgs_(doublereal *sum); -extern int dafgn_(char *name__, ftnlen name_len); -extern int dafgh_(integer *handle); -extern int dafrs_(doublereal *sum); -extern int dafrn_(char *name__, ftnlen name_len); -extern int dafws_(doublereal *sum); -extern int dafcs_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dafhof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafgsr_ 14 6 4 4 4 4 7 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: dafhfn_ 14 3 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ - -extern int dafgda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafgdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ - -extern int dafps_(integer *nd, integer *ni, doublereal *dc, integer *ic, doublereal *sum); -extern int dafus_(doublereal *sum, integer *nd, integer *ni, doublereal *dc, integer *ic); -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: movei_ 14 3 4 4 4 */ - -extern int dafra_(integer *handle, integer *iorder, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isordv_ 12 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: dafws_ 14 1 7 */ -/*:ref: dafrn_ 14 2 13 124 */ - -extern int dafrcr_(integer *handle, integer *recno, char *crec, ftnlen crec_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ - -extern int dafrda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: zzddhisn_ 14 3 4 12 12 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ - -extern int dafrfr_(integer *handle, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzdafgfr_ 14 11 4 13 4 4 13 4 4 4 12 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dafrrr_(integer *handle, integer *resv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ -/*:ref: dafrcr_ 14 4 4 4 13 124 */ -/*:ref: dafwcr_ 14 4 4 4 13 124 */ -/*:ref: dafwfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafws_ 14 1 7 */ - -extern int dafrwa_(integer *recno, integer *wordno, integer *addr__); -extern int dafarw_(integer *addr__, integer *recno, integer *wordno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafrwd_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *drec, doublereal *data, logical *found, integer *reads, integer *reqs); -extern int dafgdr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafgsr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafrdr_(integer *handle, integer *recno, integer *begin, integer *end, doublereal *data, logical *found); -extern int dafwdr_(integer *handle, integer *recno, doublereal *drec); -extern int dafnrr_(integer *reads, integer *reqs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: minai_ 14 4 4 4 4 4 */ -/*:ref: zzdafgdr_ 14 4 4 4 7 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: zzddhrcm_ 14 3 4 4 4 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: zzdafgsr_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzddhisn_ 14 3 4 12 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int daft2b_(integer *text, char *binary, integer *resv, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafena_ 14 0 */ - -extern int daftb_(integer *xfrlun, char *binfil, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: rdenci_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rdencd_ 14 3 4 4 7 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int dafwcr_(integer *handle, integer *recno, char *crec, ftnlen crec_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dafwda_(integer *handle, integer *begin, integer *end, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafarw_ 14 3 4 4 4 */ -/*:ref: dafrdr_ 14 6 4 4 4 4 7 12 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: dafwdr_ 14 3 4 4 7 */ - -extern int dafwfr_(integer *handle, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dasa2l_(integer *handle, integer *type__, integer *addrss, integer *clbase, integer *clsize, integer *recno, integer *wordno); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ - -extern int dasac_(integer *handle, integer *n, char *buffer, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasacr_ 14 2 4 4 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ - -extern int dasacr_(integer *handle, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern int dasacu_(integer *comlun, char *begmrk, char *endmrk, logical *insbln, integer *handle, ftnlen begmrk_len, ftnlen endmrk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: readln_ 14 4 4 13 12 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: readla_ 14 6 4 4 4 13 12 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: writla_ 14 4 4 13 4 124 */ -/*:ref: dasac_ 14 4 4 4 13 124 */ - -extern int dasadc_(integer *handle, integer *n, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: daswrc_ 14 4 4 4 13 124 */ -/*:ref: dasurc_ 14 6 4 4 4 4 13 124 */ -/*:ref: dascud_ 14 3 4 4 4 */ - -extern int dasadd_(integer *handle, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: daswrd_ 14 3 4 4 7 */ -/*:ref: dasurd_ 14 5 4 4 4 4 7 */ -/*:ref: dascud_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasadi_(integer *handle, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: daswri_ 14 3 4 4 4 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ -/*:ref: dascud_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasbt_(char *binfil, integer *xfrlun, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: wrenci_ 14 3 4 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: wrencc_ 14 4 4 4 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: wrencd_ 14 3 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int dascls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dashof_ 14 1 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dassdr_ 14 1 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int dascud_(integer *handle, integer *type__, integer *nwords); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: daswri_ 14 3 4 4 4 */ - -extern int dasdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasrcr_ 14 2 4 4 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ - -extern int dasec_(integer *handle, integer *bufsiz, integer *n, char *buffer, logical *done, ftnlen buffer_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dasrfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int dasecu_(integer *handle, integer *comlun, logical *comnts); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasec_ 14 6 4 4 4 13 12 124 */ -/*:ref: writla_ 14 4 4 13 4 124 */ - -extern int dasfm_(char *fname, char *ftype, char *ifname, integer *handle, integer *unit, integer *free, integer *lastla, integer *lastrc, integer *lastwd, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *fhset, char *access, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len, ftnlen access_len); -extern int dasopr_(char *fname, integer *handle, ftnlen fname_len); -extern int dasopw_(char *fname, integer *handle, ftnlen fname_len); -extern int dasonw_(char *fname, char *ftype, char *ifname, integer *ncomr, integer *handle, ftnlen fname_len, ftnlen ftype_len, ftnlen ifname_len); -extern int dasopn_(char *fname, char *ifname, integer *handle, ftnlen fname_len, ftnlen ifname_len); -extern int dasops_(integer *handle); -extern int dasllc_(integer *handle); -extern int dashfs_(integer *handle, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *free, integer *lastla, integer *lastrc, integer *lastwd); -extern int dasufs_(integer *handle, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, integer *free, integer *lastla, integer *lastrc, integer *lastwd); -extern int dashlu_(integer *handle, integer *unit); -extern int dasluh_(integer *unit, integer *handle); -extern int dashfn_(integer *handle, char *fname, ftnlen fname_len); -extern int dasfnh_(char *fname, integer *handle, ftnlen fname_len); -extern int dashof_(integer *fhset); -extern int dassih_(integer *handle, char *access, ftnlen access_len); -extern int dasham_(integer *handle, char *access, ftnlen access_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzddhppf_ 14 3 4 4 4 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: zzdasnfr_ 14 11 4 13 13 4 4 4 4 13 124 124 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: removi_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: copyi_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: elemi_ 12 2 4 4 */ - -extern doublereal dasine_(doublereal *arg, doublereal *tol); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasioc_(char *action, integer *unit, integer *recno, char *record, ftnlen action_len, ftnlen record_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int dasiod_(char *action, integer *unit, integer *recno, doublereal *record, ftnlen action_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int dasioi_(char *action, integer *unit, integer *recno, integer *record, ftnlen action_len); -/*:ref: return_ 12 0 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int daslla_(integer *handle, integer *lastc, integer *lastd, integer *lasti); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dasrcr_(integer *handle, integer *n); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern int dasrdc_(integer *handle, integer *first, integer *last, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrrc_ 14 6 4 4 4 4 13 124 */ - -extern int dasrdd_(integer *handle, integer *first, integer *last, doublereal *data); -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: dasrrd_ 14 5 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ - -extern int dasrdi_(integer *handle, integer *first, integer *last, integer *data); -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ - -extern int dasrfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dasrwr_(integer *handle, integer *recno, char *recc, doublereal *recd, integer *reci, integer *first, integer *last, doublereal *datad, integer *datai, char *datac, ftnlen recc_len, ftnlen datac_len); -extern int dasrrd_(integer *handle, integer *recno, integer *first, integer *last, doublereal *datad); -extern int dasrri_(integer *handle, integer *recno, integer *first, integer *last, integer *datai); -extern int dasrrc_(integer *handle, integer *recno, integer *first, integer *last, char *datac, ftnlen datac_len); -extern int daswrd_(integer *handle, integer *recno, doublereal *recd); -extern int daswri_(integer *handle, integer *recno, integer *reci); -extern int daswrc_(integer *handle, integer *recno, char *recc, ftnlen recc_len); -extern int dasurd_(integer *handle, integer *recno, integer *first, integer *last, doublereal *datad); -extern int dasuri_(integer *handle, integer *recno, integer *first, integer *last, integer *datai); -extern int dasurc_(integer *handle, integer *recno, integer *first, integer *last, char *datac, ftnlen datac_len); -extern int daswbr_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: lnkxsl_ 14 3 4 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ - -extern int dassdr_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: maxai_ 14 4 4 4 4 4 */ -/*:ref: dasrri_ 14 5 4 4 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasiod_ 14 5 13 4 4 7 124 */ -/*:ref: dasioi_ 14 5 13 4 4 4 124 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int dastb_(integer *xfrlun, char *binfil, ftnlen binfil_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dasonw_ 14 8 13 13 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: daswfr_ 14 9 4 13 13 4 4 4 4 124 124 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: rdenci_ 14 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: dasacr_ 14 2 4 4 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rdencc_ 14 4 4 4 13 124 */ -/*:ref: dasioc_ 14 6 13 4 4 13 124 124 */ -/*:ref: dasadc_ 14 6 4 4 4 4 13 124 */ -/*:ref: rdencd_ 14 3 4 4 7 */ -/*:ref: dasadd_ 14 3 4 4 7 */ -/*:ref: dasadi_ 14 3 4 4 4 */ - -extern int dasudc_(integer *handle, integer *first, integer *last, integer *bpos, integer *epos, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasurc_ 14 6 4 4 4 4 13 124 */ - -extern int dasudd_(integer *handle, integer *first, integer *last, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasurd_ 14 5 4 4 4 4 7 */ - -extern int dasudi_(integer *handle, integer *first, integer *last, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasa2l_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasuri_ 14 5 4 4 4 4 4 */ - -extern int daswfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dashfs_ 14 9 4 4 4 4 4 4 4 4 4 */ -/*:ref: dasufs_ 14 9 4 4 4 4 4 4 4 4 4 */ - -extern doublereal datanh_(doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal dcbrt_(doublereal *x); - -extern int dcyldr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: drdcyl_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int delfil_(char *filnam, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: getlun_ 14 1 4 */ - -extern int deltet_(doublereal *epoch, char *eptype, doublereal *delta, ftnlen eptype_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern doublereal det_(doublereal *m1); - -extern int dgeodr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: drdgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern doublereal dhfa_(doublereal *state, doublereal *bodyr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int diags2_(doublereal *symmat, doublereal *diag, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rquad_ 14 5 7 7 7 7 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ - -extern int diffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int diffd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int diffi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dlatdr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: drdlat_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int dnearp_(doublereal *state, doublereal *a, doublereal *b, doublereal *c__, doublereal *dnear, doublereal *dalt, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vtmv_ 7 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int dp2hx_(doublereal *number, char *string, integer *length, ftnlen string_len); -/*:ref: int2hx_ 14 4 4 13 4 124 */ - -extern int dpfmt_(doublereal *x, char *pictur, char *str, ftnlen pictur_len, ftnlen str_len); -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzvststr_ 14 4 7 13 4 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rjust_ 14 4 13 13 124 124 */ -/*:ref: zzvsbstr_ 14 6 4 4 12 13 12 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int dpgrdr_(char *body, doublereal *x, doublereal *y, doublereal *z__, doublereal *re, doublereal *f, doublereal *jacobi, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: dgeodr_ 14 6 7 7 7 7 7 7 */ - -extern doublereal dpr_(void); - -extern int dpspce_(doublereal *time, doublereal *geophs, doublereal *elems, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: zzdpinit_ 14 6 7 7 7 7 7 7 */ -/*:ref: zzdpper_ 14 6 7 7 7 7 7 7 */ -/*:ref: zzdpsec_ 14 9 7 7 7 7 7 7 7 7 7 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dpstr_(doublereal *x, integer *sigdig, char *string, ftnlen string_len); -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int dpstrf_(doublereal *x, integer *sigdig, char *format, char *string, ftnlen format_len, ftnlen string_len); -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: zzvststr_ 14 4 7 13 4 124 */ -/*:ref: zzvsbstr_ 14 6 4 4 12 13 12 124 */ - -extern int drdcyl_(doublereal *r__, doublereal *long__, doublereal *z__, doublereal *jacobi); - -extern int drdgeo_(doublereal *long__, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int drdlat_(doublereal *r__, doublereal *long__, doublereal *lat, doublereal *jacobi); - -extern int drdpgr_(char *body, doublereal *lon, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: drdgeo_ 14 6 7 7 7 7 7 7 */ - -extern int drdsph_(doublereal *r__, doublereal *colat, doublereal *long__, doublereal *jacobi); - -extern int drotat_(doublereal *angle, integer *iaxis, doublereal *dmout); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int dsphdr_(doublereal *x, doublereal *y, doublereal *z__, doublereal *jacobi); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: drdsph_ 14 4 7 7 7 7 */ -/*:ref: invort_ 14 2 7 7 */ - -extern int ducrss_(doublereal *s1, doublereal *s2, doublereal *sout); -/*:ref: dvcrss_ 14 3 7 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ - -extern int dvcrss_(doublereal *s1, doublereal *s2, doublereal *sout); -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern doublereal dvdot_(doublereal *s1, doublereal *s2); - -extern int dvhat_(doublereal *s1, doublereal *sout); -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern doublereal dvnorm_(doublereal *state); -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ - -extern doublereal dvsep_(doublereal *s1, doublereal *s2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int dxtrct_(char *keywd, integer *maxwds, char *string, integer *nfound, integer *parsed, doublereal *values, ftnlen keywd_len, ftnlen string_len); -/*:ref: wdindx_ 4 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int edlimb_(doublereal *a, doublereal *b, doublereal *c__, doublereal *viewpt, doublereal *limb); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: inedpl_ 14 6 7 7 7 7 7 12 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int edterm_(char *trmtyp, char *source, char *target, doublereal *et, char *fixfrm, char *abcorr, char *obsrvr, integer *npts, doublereal *trgepc, doublereal *obspos, doublereal *trmpts, ftnlen trmtyp_len, ftnlen source_len, ftnlen target_len, ftnlen fixfrm_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: bodvrd_ 14 7 13 13 4 4 7 124 124 */ -/*:ref: spkpos_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: zzedterm_ 14 9 13 7 7 7 7 7 4 7 124 */ - -extern int ekacec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad03_ 14 7 4 4 4 4 13 12 124 */ -/*:ref: zzekad06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekaced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekad05_ 14 7 4 4 4 4 4 7 12 */ - -extern int ekacei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekad01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekad04_ 14 7 4 4 4 4 4 4 12 */ - -extern int ekaclc_(integer *handle, integer *segno, char *column, char *cvals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac03_ 14 8 4 4 4 13 12 4 4 124 */ -/*:ref: zzekac06_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: zzekac09_ 14 7 4 4 4 13 12 4 124 */ - -extern int ekacld_(integer *handle, integer *segno, char *column, doublereal *dvals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac02_ 14 7 4 4 4 7 12 4 4 */ -/*:ref: zzekac05_ 14 6 4 4 4 7 4 12 */ -/*:ref: zzekac08_ 14 6 4 4 4 7 12 4 */ - -extern int ekacli_(integer *handle, integer *segno, char *column, integer *ivals, integer *entszs, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen column_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekac01_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: zzekac04_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekac07_ 14 6 4 4 4 4 12 4 */ - -extern int ekappr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: ekinsr_ 14 3 4 4 4 */ - -extern int ekbseg_(integer *handle, char *tabnam, integer *ncols, char *cnames, char *decls, integer *segno, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: lxdfid_ 14 1 4 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: lxidnt_ 14 6 4 13 4 4 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekpdec_ 14 3 13 4 124 */ -/*:ref: zzekstyp_ 4 2 4 4 */ -/*:ref: zzekbs01_ 14 8 4 13 4 13 4 4 124 124 */ -/*:ref: zzekbs02_ 14 8 4 13 4 13 4 4 124 124 */ - -extern int ekcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekdelr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekde01_ 14 4 4 4 4 4 */ -/*:ref: zzekde02_ 14 4 4 4 4 4 */ -/*:ref: zzekde03_ 14 4 4 4 4 4 */ -/*:ref: zzekde04_ 14 4 4 4 4 4 */ -/*:ref: zzekde05_ 14 4 4 4 4 4 */ -/*:ref: zzekde06_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekffld_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekff01_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekfind_(char *query, integer *nmrows, logical *error, char *errmsg, ftnlen query_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpars_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: zzeknres_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: zzektres_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: zzeksemc_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: eksrch_ 14 8 4 13 7 4 12 13 124 124 */ - -extern int ekifld_(integer *handle, char *tabnam, integer *ncols, integer *nrows, char *cnames, char *decls, integer *segno, integer *rcptrs, ftnlen tabnam_len, ftnlen cnames_len, ftnlen decls_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekbseg_ 14 9 4 13 4 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekif01_ 14 3 4 4 4 */ -/*:ref: zzekif02_ 14 2 4 4 */ - -extern int ekinsr_(integer *handle, integer *segno, integer *recno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: filli_ 14 3 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ - -extern integer eknseg_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrsz_ 4 2 4 4 */ - -extern int ekopn_(char *fname, char *ifname, integer *ncomch, integer *handle, ftnlen fname_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasonw_ 14 8 13 13 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekpgin_ 14 1 4 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekopr_(char *fname, integer *handle, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ - -extern int ekops_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgin_ 14 1 4 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int ekopw_(char *fname, integer *handle, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dasopw_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ - -extern int ekpsel_(char *query, integer *n, integer *xbegs, integer *xends, char *xtypes, char *xclass, char *tabs, char *cols, logical *error, char *errmsg, ftnlen query_len, ftnlen xtypes_len, ftnlen xclass_len, ftnlen tabs_len, ftnlen cols_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekencd_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: zzekqsel_ 14 12 4 13 4 4 4 13 4 13 4 124 124 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ - -extern int ekqmgr_(integer *cindex, integer *elment, char *eqryc, doublereal *eqryd, integer *eqryi, char *fname, integer *row, integer *selidx, char *column, integer *handle, integer *n, char *table, integer *attdsc, integer *ccount, logical *found, integer *nelt, integer *nmrows, logical *semerr, char *errmsg, char *cdata, doublereal *ddata, integer *idata, logical *null, ftnlen eqryc_len, ftnlen fname_len, ftnlen column_len, ftnlen table_len, ftnlen errmsg_len, ftnlen cdata_len); -extern int eklef_(char *fname, integer *handle, ftnlen fname_len); -extern int ekuef_(integer *handle); -extern int ekntab_(integer *n); -extern int ektnam_(integer *n, char *table, ftnlen table_len); -extern int ekccnt_(char *table, integer *ccount, ftnlen table_len); -extern int ekcii_(char *table, integer *cindex, char *column, integer *attdsc, ftnlen table_len, ftnlen column_len); -extern int eksrch_(integer *eqryi, char *eqryc, doublereal *eqryd, integer *nmrows, logical *semerr, char *errmsg, ftnlen eqryc_len, ftnlen errmsg_len); -extern int eknelt_(integer *selidx, integer *row, integer *nelt); -extern int ekgc_(integer *selidx, integer *row, integer *elment, char *cdata, logical *null, logical *found, ftnlen cdata_len); -extern int ekgd_(integer *selidx, integer *row, integer *elment, doublereal *ddata, logical *null, logical *found); -extern int ekgi_(integer *selidx, integer *row, integer *elment, integer *idata, logical *null, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ekopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dascls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: ekcls_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: zzeksinf_ 14 8 4 4 13 4 13 4 124 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: appndc_ 14 4 13 13 124 124 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksdec_ 14 1 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekqcnj_ 14 3 4 4 4 */ -/*:ref: zzekqcon_ 14 24 4 13 7 4 4 13 4 13 4 4 13 4 13 4 4 4 4 7 4 124 124 124 124 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekkey_ 14 20 4 4 4 4 4 4 4 4 13 4 4 7 4 12 4 4 4 4 12 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekrplk_ 14 4 4 4 4 4 */ -/*:ref: zzekrmch_ 12 15 4 12 4 4 4 4 4 4 4 13 4 4 7 4 124 */ -/*:ref: zzekvmch_ 12 13 4 12 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekjsqz_ 14 1 4 */ -/*:ref: zzekjoin_ 14 18 4 4 4 12 4 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekweed_ 14 3 4 4 4 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzekqsel_ 14 12 4 13 4 4 4 13 4 13 4 124 124 124 */ -/*:ref: zzekqord_ 14 11 4 13 4 13 4 13 4 4 124 124 124 */ -/*:ref: zzekjsrt_ 14 13 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekvcal_ 14 3 4 4 4 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ - -extern int ekrcec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd03_ 14 8 4 4 4 4 4 13 12 124 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd06_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrd09_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekrced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd05_ 14 9 4 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrd08_ 14 6 4 4 4 4 7 12 */ - -extern int ekrcei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekrd01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekesiz_ 4 4 4 4 4 4 */ -/*:ref: zzekrd04_ 14 9 4 4 4 4 4 4 4 12 12 */ -/*:ref: zzekrd07_ 14 6 4 4 4 4 4 12 */ - -extern int ekshdw_(integer *handle, logical *isshad); - -extern int ekssum_(integer *handle, integer *segno, char *tabnam, integer *nrows, integer *ncols, char *cnames, char *dtypes, integer *sizes, integer *strlns, logical *indexd, logical *nullok, ftnlen tabnam_len, ftnlen cnames_len, ftnlen dtypes_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksinf_ 14 8 4 4 13 4 13 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ekucec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue03_ 14 7 4 4 4 4 13 12 124 */ -/*:ref: zzekue06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int ekuced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekue05_ 14 7 4 4 4 4 4 7 12 */ - -extern int ekucei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekcdsc_ 14 5 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: ekshdw_ 14 2 4 12 */ -/*:ref: zzekrbck_ 14 6 13 4 4 4 4 124 */ -/*:ref: zzekue01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekue04_ 14 7 4 4 4 4 4 4 12 */ - -extern int el2cgv_(doublereal *ellips, doublereal *center, doublereal *smajor, doublereal *sminor); -/*:ref: vequ_ 14 2 7 7 */ - -extern logical elemc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical elemd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical elemi_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int elltof_(doublereal *ma, doublereal *ecc, doublereal *e); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int enchar_(integer *number, char *string, ftnlen string_len); -extern int dechar_(char *string, integer *number, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: chbase_ 4 0 */ - -extern logical eqchr_(char *a, char *b, ftnlen a_len, ftnlen b_len); -extern logical nechr_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int eqncpv_(doublereal *et, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *decpol, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: twopi_ 7 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: kepleq_ 7 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern logical eqstr_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int erract_(char *op, char *action, ftnlen op_len, ftnlen action_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getact_ 14 1 4 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: putact_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int errch_(char *marker, char *string, ftnlen marker_len, ftnlen string_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errdev_(char *op, char *device, ftnlen op_len, ftnlen device_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: putdev_ 14 2 13 124 */ - -extern int errdp_(char *marker, doublereal *dpnum, ftnlen marker_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errfnm_(char *marker, integer *unit, ftnlen marker_len); -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int errhan_(char *marker, integer *handle, ftnlen marker_len); -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int errint_(char *marker, integer *integr, ftnlen marker_len); -/*:ref: allowd_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int errprt_(char *op, char *list, ftnlen op_len, ftnlen list_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: msgsel_ 12 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: setprt_ 12 5 12 12 12 12 12 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer esrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int et2lst_(doublereal *et, integer *body, doublereal *long__, char *type__, integer *hr, integer *mn, integer *sc, char *time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: pgrrec_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: pi_ 7 0 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ - -extern int et2utc_(doublereal *et, char *format, integer *prec, char *utcstr, ftnlen format_len, ftnlen utcstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int etcal_(doublereal *et, char *string, ftnlen string_len); -/*:ref: spd_ 7 0 */ -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: lstlti_ 4 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ - -extern int eul2m_(doublereal *angle3, doublereal *angle2, doublereal *angle1, integer *axis3, integer *axis2, integer *axis1, doublereal *r__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rotate_ 14 3 7 4 7 */ -/*:ref: rotmat_ 14 4 7 7 4 7 */ - -extern int ev2lin_(doublereal *et, doublereal *geophs, doublereal *elems, doublereal *state); -/*:ref: twopi_ 7 0 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern logical even_(integer *i__); - -extern doublereal exact_(doublereal *number, doublereal *value, doublereal *tol); - -extern int excess_(integer *number, char *struct__, ftnlen struct_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical exists_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int expln_(char *msg, char *expl, ftnlen msg_len, ftnlen expl_len); - -extern integer fetchc_(integer *nth, char *set, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer fetchd_(integer *nth, doublereal *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer fetchi_(integer *nth, integer *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int fillc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern int filld_(doublereal *value, integer *ndim, doublereal *array); - -extern int filli_(integer *value, integer *ndim, integer *array); - -extern int fn2lun_(char *filnam, integer *lunit, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int fndlun_(integer *unit); -extern int reslun_(integer *unit); -extern int frelun_(integer *unit); - -extern int fndnwd_(char *string, integer *start, integer *b, integer *e, ftnlen string_len); - -extern int frame_(doublereal *x, doublereal *y, doublereal *z__); -/*:ref: vhatip_ 14 1 7 */ - -extern int framex_(char *cname, char *frname, integer *frcode, integer *cent, integer *class__, integer *clssid, logical *found, ftnlen cname_len, ftnlen frname_len); -extern int namfrm_(char *frname, integer *frcode, ftnlen frname_len); -extern int frmnam_(integer *frcode, char *frname, ftnlen frname_len); -extern int frinfo_(integer *frcode, integer *cent, integer *class__, integer *clssid, logical *found); -extern int cidfrm_(integer *cent, integer *frcode, char *frname, logical *found, ftnlen frname_len); -extern int cnmfrm_(char *cname, integer *frcode, char *frname, logical *found, ftnlen cname_len, ftnlen frname_len); -extern int ccifrm_(integer *class__, integer *clssid, integer *frcode, char *frname, integer *cent, logical *found, ftnlen frname_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: zzfdat_ 14 10 4 13 4 4 4 4 4 4 4 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bschoc_ 4 6 13 4 13 4 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: gnpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int frmchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frmget_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int frmget_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynfrm_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ - -extern integer frstnb_(char *string, ftnlen string_len); - -extern integer frstnp_(char *string, ftnlen string_len); - -extern integer frstpc_(char *string, ftnlen string_len); - -extern integer gcd_(integer *a, integer *b); - -extern int georec_(doublereal *long__, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int getelm_(integer *frstyr, char *lines, doublereal *epoch, doublereal *elems, ftnlen lines_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzgetelm_ 14 8 4 13 7 7 12 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int getfat_(char *file, char *arch, char *kertyp, ftnlen file_len, ftnlen arch_len, ftnlen kertyp_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhfnh_ 14 4 13 4 12 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: dashof_ 14 1 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: zzckspk_ 14 3 4 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int getfov_(integer *instid, integer *room, char *shape, char *frame, doublereal *bsight, integer *n, doublereal *bounds, ftnlen shape_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int getlun_(integer *unit); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: fndlun_ 14 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int getmsg_(char *option, char *msg, ftnlen option_len, ftnlen msg_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getsms_ 14 2 13 124 */ -/*:ref: expln_ 14 4 13 13 124 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical gfbail_(void); - -extern int gfdist_(char *target, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfevnt_(U_fp udstep, U_fp udrefn, char *gquant, integer *qnpars, char *qpnams, char *qcpars, doublereal *qdpars, integer *qipars, logical *qlpars, char *op, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, logical *rpt, U_fp udrepi, U_fp udrepu, U_fp udrepf, integer *mw, integer *nw, doublereal *work, logical *bail, L_fp udbail, doublereal *result, ftnlen gquant_len, ftnlen qpnams_len, ftnlen qcpars_len, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzgfspin_ 14 11 13 13 13 13 7 13 124 124 124 124 124 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 200 200 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: zzgfdiin_ 14 7 13 13 13 7 124 124 124 */ -/*:ref: zzgfcslv_ 14 37 13 13 13 13 13 13 13 7 13 13 13 7 7 7 200 200 12 200 200 200 12 212 4 4 7 7 7 124 124 124 124 124 124 124 124 124 124 */ -/*:ref: zzgfrrin_ 14 8 13 13 13 7 7 124 124 124 */ - -extern int gffove_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zzgffvin_ 14 13 13 13 7 13 13 13 13 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ - -extern int gfocce_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *abcorr, char *obsrvr, doublereal *tol, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzgfocin_ 14 18 13 13 13 13 13 13 13 13 13 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ - -extern int gfoclt_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gfocce_ 14 29 13 13 13 13 13 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfposc_(char *target, char *frame, char *abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen frame_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfrefn_(doublereal *t1, doublereal *t2, logical *s1, logical *s2, doublereal *t); -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int gfrfov_(char *inst, doublereal *raydir, char *rframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen rframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gffove_ 14 24 13 13 7 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfrprt_(doublereal *window, char *begmss, char *endmss, doublereal *ivbeg, doublereal *ivend, doublereal *time, ftnlen begmss_len, ftnlen endmss_len); -extern int gfrepi_(doublereal *window, char *begmss, char *endmss, ftnlen begmss_len, ftnlen endmss_len); -extern int gfrepu_(doublereal *ivbeg, doublereal *ivend, doublereal *time); -extern int gfrepf_(void); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: wnsumd_ 14 6 7 7 7 7 4 4 */ -/*:ref: zzgftswk_ 14 7 7 7 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zzgfwkin_ 14 1 7 */ -/*:ref: zzgfwkad_ 14 6 7 4 13 13 124 124 */ -/*:ref: zzgfwkmo_ 14 9 4 7 7 4 13 13 7 124 124 */ -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: zzgfdsps_ 14 6 4 13 13 4 124 124 */ - -extern int gfrr_(char *target, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfsep_(char *targ1, char *shape1, char *frame1, char *targ2, char *shape2, char *frame2, char *abcorr, char *obsrvr, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen targ1_len, ftnlen shape1_len, ftnlen frame1_len, ftnlen targ2_len, ftnlen shape2_len, ftnlen frame2_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfsntc_(char *target, char *fixref, char *method, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfstep_(doublereal *time, doublereal *step); -extern int gfsstp_(doublereal *step); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int gfsubc_(char *target, char *fixref, char *method, char *abcorr, char *obsrvr, char *crdsys, char *coord, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen target_len, ftnlen fixref_len, ftnlen method_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen crdsys_len, ftnlen coord_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: gfevnt_ 14 28 200 200 13 4 13 13 7 4 12 13 7 7 7 7 12 200 200 200 4 4 7 12 212 7 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gftfov_(char *inst, char *target, char *tshape, char *tframe, char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine, doublereal *result, ftnlen inst_len, ftnlen target_len, ftnlen tshape_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: gffove_ 14 24 13 13 7 13 13 13 13 7 200 200 12 200 200 200 12 212 7 7 124 124 124 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern int gfuds_(U_fp udfunc, U_fp udqdec, char *relate, doublereal *refval, doublereal *adjust, doublereal *step, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, doublereal *result, ftnlen relate_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: gfsstp_ 14 1 7 */ -/*:ref: zzgfref_ 14 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: zzgfrelx_ 14 26 200 200 200 200 200 214 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: gfbail_ 12 :*/ - -extern doublereal halfpi_(void); - -extern int hrmesp_(integer *n, doublereal *first, doublereal *step, doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, doublereal *df); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int hrmint_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *x, doublereal *work, doublereal *f, doublereal *df); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int hx2dp_(char *string, doublereal *number, logical *error, char *errmsg, ftnlen string_len, ftnlen errmsg_len); -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ - -extern int hx2int_(char *string, integer *number, logical *error, char *errmsg, ftnlen string_len, ftnlen errmsg_len); -/*:ref: intmin_ 4 0 */ -/*:ref: intmax_ 4 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ - -extern int hyptof_(doublereal *ma, doublereal *ecc, doublereal *f); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int ident_(doublereal *matrix); - -extern int idw2at_(char *idword, char *arch, char *type__, ftnlen idword_len, ftnlen arch_len, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int illum_(char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar, doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int ilumin_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, doublereal *phase, doublereal *solar, doublereal *emissn, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int inedpl_(doublereal *a, doublereal *b, doublereal *c__, doublereal *plane, doublereal *ellips, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: pl2psv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ - -extern int inelpl_(doublereal *ellips, doublereal *plane, integer *nxpts, doublereal *xpt1, doublereal *xpt2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: pl2nvp_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: vzerog_ 12 2 7 4 */ -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int inrypl_(doublereal *vertex, doublereal *dir, doublereal *plane, integer *nxpts, doublereal *xpt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: smsgnd_ 12 2 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int inslac_(char *elts, integer *ne, integer *loc, char *array, integer *na, ftnlen elts_len, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inslad_(doublereal *elts, integer *ne, integer *loc, doublereal *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inslai_(integer *elts, integer *ne, integer *loc, integer *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrtc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrtd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int insrti_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int inssub_(char *in, char *sub, integer *loc, char *out, ftnlen in_len, ftnlen sub_len, ftnlen out_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int int2hx_(integer *number, char *string, integer *length, ftnlen string_len); - -extern int interc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int interd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int interi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int intord_(integer *n, char *string, ftnlen string_len); -/*:ref: inttxt_ 14 3 4 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int intstr_(integer *number, char *string, ftnlen string_len); - -extern int inttxt_(integer *n, char *string, ftnlen string_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int invert_(doublereal *m1, doublereal *mout); -/*:ref: det_ 7 1 7 */ -/*:ref: filld_ 14 3 7 4 7 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ - -extern int invort_(doublereal *m, doublereal *mit); -/*:ref: dpmax_ 7 0 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int invstm_(doublereal *mat, doublereal *invmat); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: xposbl_ 14 5 7 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ioerr_(char *action, char *file, integer *iostat, ftnlen action_len, ftnlen file_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ - -extern int irftrn_(char *refa, char *refb, doublereal *rotab, ftnlen refa_len, ftnlen refb_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int iso2utc_(char *tstrng, char *utcstr, char *error, ftnlen tstrng_len, ftnlen utcstr_len, ftnlen error_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical isopen_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern logical isordv_(integer *array, integer *n); - -extern integer isrchc_(char *value, integer *ndim, char *array, ftnlen value_len, ftnlen array_len); - -extern integer isrchd_(doublereal *value, integer *ndim, doublereal *array); - -extern integer isrchi_(integer *value, integer *ndim, integer *array); - -extern logical isrot_(doublereal *m, doublereal *ntol, doublereal *dtol); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: det_ 7 1 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern doublereal j1900_(void); - -extern doublereal j1950_(void); - -extern doublereal j2000_(void); - -extern doublereal j2100_(void); - -extern int jul2gr_(integer *year, integer *month, integer *day, integer *doy); -extern int gr2jul_(integer *year, integer *month, integer *day, integer *doy); -/*:ref: rmaini_ 14 4 4 4 4 4 */ -/*:ref: lstlti_ 4 3 4 4 4 */ - -extern doublereal jyear_(void); - -extern int keeper_(integer *which, char *kind, char *file, integer *count, char *filtyp, integer *handle, char *source, logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int furnsh_(char *file, ftnlen file_len); -extern int ktotal_(char *kind, integer *count, ftnlen kind_len); -extern int kdata_(integer *which, char *kind, char *file, char *filtyp, char *source, integer *handle, logical *found, ftnlen kind_len, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int kinfo_(char *file, char *filtyp, char *source, integer *handle, logical *found, ftnlen file_len, ftnlen filtyp_len, ftnlen source_len); -extern int kclear_(void); -extern int unload_(char *file, ftnlen file_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzldker_ 14 7 13 13 13 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: stpool_ 14 9 13 4 13 13 4 12 124 124 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: samsub_ 12 8 13 4 4 13 4 4 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: repmot_ 14 9 13 13 4 13 13 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dvpool_ 14 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: spkuef_ 14 1 4 */ -/*:ref: ckupf_ 14 1 4 */ -/*:ref: pckuof_ 14 1 4 */ -/*:ref: ekuef_ 14 1 4 */ -/*:ref: clpool_ 14 0 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: ldpool_ 14 2 13 124 */ -/*:ref: spklef_ 14 3 13 4 124 */ -/*:ref: cklpf_ 14 3 13 4 124 */ -/*:ref: pcklof_ 14 3 13 4 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ - -extern doublereal kepleq_(doublereal *ml, doublereal *h__, doublereal *k); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: kpsolv_ 7 1 7 */ - -extern doublereal kpsolv_(doublereal *evec); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int kxtrct_(char *keywd, char *terms, integer *nterms, char *string, logical *found, char *substr, ftnlen keywd_len, ftnlen terms_len, ftnlen string_len, ftnlen substr_len); -/*:ref: wdindx_ 4 4 13 13 124 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: shiftl_ 14 7 13 4 13 13 124 124 124 */ - -extern integer lastnb_(char *string, ftnlen string_len); - -extern integer lastpc_(char *string, ftnlen string_len); - -extern int latcyl_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *r__, doublereal *longc, doublereal *z__); - -extern int latrec_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *rectan); - -extern int latsph_(doublereal *radius, doublereal *long__, doublereal *lat, doublereal *rho, doublereal *colat, doublereal *longs); -/*:ref: halfpi_ 7 0 */ - -extern int lbuild_(char *items, integer *n, char *delim, char *list, ftnlen items_len, ftnlen delim_len, ftnlen list_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int lcase_(char *in, char *out, ftnlen in_len, ftnlen out_len); - -extern doublereal lgresp_(integer *n, doublereal *first, doublereal *step, doublereal *yvals, doublereal *work, doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lgrind_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *work, doublereal *x, doublereal *p, doublereal *dp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern doublereal lgrint_(integer *n, doublereal *xvals, doublereal *yvals, doublereal *work, doublereal *x); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int ljust_(char *input, char *output, ftnlen input_len, ftnlen output_len); - -extern int lnkan_(integer *pool, integer *new__); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkfsl_(integer *head, integer *tail, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnkhl_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkila_(integer *prev, integer *list, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkilb_(integer *list, integer *next, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkini_(integer *size, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnknfn_(integer *pool); - -extern integer lnknxt_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnkprv_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer lnksiz_(integer *pool); - -extern integer lnktl_(integer *node, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lnkxsl_(integer *head, integer *tail, integer *pool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int locati_(integer *id, integer *idsz, integer *list, integer *pool, integer *at, logical *presnt); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnksiz_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lnkxsl_ 14 3 4 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ - -extern int locln_(integer *unit, char *bmark, char *emark, char *line, integer *bline, integer *eline, logical *found, ftnlen bmark_len, ftnlen emark_len, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ltrim_ 4 2 13 124 */ - -extern int lparse_(char *list, char *delim, integer *nmax, integer *n, char *items, ftnlen list_len, ftnlen delim_len, ftnlen items_len); - -extern int lparsm_(char *list, char *delims, integer *nmax, integer *n, char *items, ftnlen list_len, ftnlen delims_len, ftnlen items_len); - -extern int lparss_(char *list, char *delims, char *set, ftnlen list_len, ftnlen delims_len, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal lspcn_(char *body, doublereal *et, char *abcorr, ftnlen body_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkezr_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ - -extern integer lstcld_(doublereal *x, integer *n, doublereal *array); - -extern integer lstcli_(integer *x, integer *n, integer *array); - -extern integer lstlec_(char *string, integer *n, char *array, ftnlen string_len, ftnlen array_len); - -extern integer lstled_(doublereal *x, integer *n, doublereal *array); - -extern integer lstlei_(integer *x, integer *n, integer *array); - -extern integer lstltc_(char *string, integer *n, char *array, ftnlen string_len, ftnlen array_len); - -extern integer lstltd_(doublereal *x, integer *n, doublereal *array); - -extern integer lstlti_(integer *x, integer *n, integer *array); - -extern int ltime_(doublereal *etobs, integer *obs, char *dir, integer *targ, doublereal *ettarg, doublereal *elapsd, ftnlen dir_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: clight_ 7 0 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: failed_ 12 0 */ - -extern integer ltrim_(char *string, ftnlen string_len); -/*:ref: frstnb_ 4 2 13 124 */ - -extern int lun2fn_(integer *lunit, char *filnam, ftnlen filnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int lx4dec_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: lx4sgn_ 14 5 13 4 4 4 124 */ - -extern int lx4num_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4dec_ 14 5 13 4 4 4 124 */ -/*:ref: lx4sgn_ 14 5 13 4 4 4 124 */ - -extern int lx4sgn_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ - -extern int lx4uns_(char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); - -extern int lxname_(char *hdchrs, char *tlchrs, char *string, integer *first, integer *last, integer *idspec, integer *nchar, ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len); -extern int lxidnt_(integer *idspec, char *string, integer *first, integer *last, integer *nchar, ftnlen string_len); -extern int lxdfid_(integer *idspec); -extern int lxcsid_(char *hdchrs, char *tlchrs, integer *idspec, ftnlen hdchrs_len, ftnlen tlchrs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: validi_ 14 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ - -extern int lxqstr_(char *string, char *qchar, integer *first, integer *last, integer *nchar, ftnlen string_len, ftnlen qchar_len); - -extern int m2eul_(doublereal *r__, integer *axis3, integer *axis2, integer *axis1, doublereal *angle3, doublereal *angle2, doublereal *angle1); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: mtxm_ 14 3 7 7 7 */ - -extern int m2q_(doublereal *r__, doublereal *q); -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical matchi_(char *string, char *templ, char *wstr, char *wchr, ftnlen string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ -/*:ref: nechr_ 12 4 13 13 124 124 */ -/*:ref: samchi_ 12 6 13 4 13 4 124 124 */ - -extern logical matchw_(char *string, char *templ, char *wstr, char *wchr, ftnlen string_len, ftnlen templ_len, ftnlen wstr_len, ftnlen wchr_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ - -extern int maxac_(char *array, integer *ndim, char *maxval, integer *loc, ftnlen array_len, ftnlen maxval_len); - -extern int maxad_(doublereal *array, integer *ndim, doublereal *maxval, integer *loc); - -extern int maxai_(integer *array, integer *ndim, integer *maxval, integer *loc); - -extern int mequ_(doublereal *m1, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mequg_(doublereal *m1, integer *nr, integer *nc, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int minac_(char *array, integer *ndim, char *minval, integer *loc, ftnlen array_len, ftnlen minval_len); - -extern int minad_(doublereal *array, integer *ndim, doublereal *minval, integer *loc); - -extern int minai_(integer *array, integer *ndim, integer *minval, integer *loc); - -extern int movec_(char *arrfrm, integer *ndim, char *arrto, ftnlen arrfrm_len, ftnlen arrto_len); - -extern int movei_(integer *arrfrm, integer *ndim, integer *arrto); - -extern int mtxm_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mtxmg_(doublereal *m1, doublereal *m2, integer *nc1, integer *nr1r2, integer *nc2, doublereal *mout); - -extern int mtxv_(doublereal *matrix, doublereal *vin, doublereal *vout); - -extern int mtxvg_(doublereal *m1, doublereal *v2, integer *nc1, integer *nr1r2, doublereal *vout); - -extern int mxm_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mxmg_(doublereal *m1, doublereal *m2, integer *row1, integer *col1, integer *col2, doublereal *mout); - -extern int mxmt_(doublereal *m1, doublereal *m2, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int mxmtg_(doublereal *m1, doublereal *m2, integer *nr1, integer *nc1c2, integer *nr2, doublereal *mout); - -extern int mxv_(doublereal *matrix, doublereal *vin, doublereal *vout); - -extern int mxvg_(doublereal *m1, doublereal *v2, integer *nr1, integer *nc1r2, doublereal *vout); - -extern integer nblen_(char *string, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ - -extern integer nbwid_(char *array, integer *nelt, ftnlen array_len); - -extern integer ncpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern integer ncposr_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen chars_len); - -extern int nearpt_(doublereal *positn, doublereal *a, doublereal *b, doublereal *c__, doublereal *npoint, doublereal *alt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: orderd_ 14 3 7 4 4 */ -/*:ref: reordd_ 14 3 4 4 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: approx_ 12 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int nextwd_(char *string, char *next, char *rest, ftnlen string_len, ftnlen next_len, ftnlen rest_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ - -extern logical notru_(logical *logcls, integer *n); - -extern int nparsd_(char *string, doublereal *x, char *error, integer *ptr, ftnlen string_len, ftnlen error_len); -/*:ref: dpmax_ 7 0 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: pi_ 7 0 */ - -extern int nparsi_(char *string, integer *n, char *error, integer *pnter, ftnlen string_len, ftnlen error_len); -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int npedln_(doublereal *a, doublereal *b, doublereal *c__, doublereal *linept, doublereal *linedr, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: inedpl_ 14 6 7 7 7 7 7 12 */ -/*:ref: pjelpl_ 14 3 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: npelpt_ 14 4 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vprjpi_ 14 5 7 7 7 7 12 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int npelpt_(doublereal *point, doublereal *ellips, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int nplnpt_(doublereal *linpt, doublereal *lindir, doublereal *point, doublereal *pnear, doublereal *dist); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int nthwd_(char *string, integer *nth, char *word, integer *loc, ftnlen string_len, ftnlen word_len); - -extern int nvc2pl_(doublereal *normal, doublereal *const__, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int nvp2pl_(doublereal *normal, doublereal *point, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern logical odd_(integer *i__); - -extern logical opsgnd_(doublereal *x, doublereal *y); - -extern logical opsgni_(integer *x, integer *y); - -extern integer ordc_(char *item, char *set, ftnlen item_len, ftnlen set_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer ordd_(doublereal *item, doublereal *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int orderc_(char *array, integer *ndim, integer *iorder, ftnlen array_len); -/*:ref: swapi_ 14 2 4 4 */ - -extern int orderd_(doublereal *array, integer *ndim, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int orderi_(integer *array, integer *ndim, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern integer ordi_(integer *item, integer *set); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int oscelt_(doublereal *state, doublereal *et, doublereal *mu, doublereal *elts); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: exact_ 7 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: dacosh_ 7 1 7 */ - -extern int outmsg_(char *list, ftnlen list_len); -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: msgsel_ 12 2 13 124 */ -/*:ref: tkvrsn_ 14 4 13 13 124 124 */ -/*:ref: getsms_ 14 2 13 124 */ -/*:ref: expln_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: getlms_ 14 2 13 124 */ -/*:ref: wdcnt_ 4 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: trcdep_ 14 1 4 */ -/*:ref: trcnam_ 14 3 4 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int packac_(char *in, integer *pack, integer *npack, integer *maxout, integer *nout, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int packad_(doublereal *in, integer *pack, integer *npack, integer *maxout, integer *nout, doublereal *out); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int packai_(integer *in, integer *pack, integer *npack, integer *maxout, integer *nout, integer *out); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int parsqs_(char *string, char *qchar, char *value, integer *length, logical *error, char *errmsg, integer *ptr, ftnlen string_len, ftnlen qchar_len, ftnlen value_len, ftnlen errmsg_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int partof_(doublereal *ma, doublereal *d__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dcbrt_ 7 1 7 */ - -extern int pck03a_(integer *handle, integer *ncsets, doublereal *coeffs, doublereal *epochs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ - -extern int pck03b_(integer *handle, char *segid, integer *body, char *frame, doublereal *first, doublereal *last, integer *chbdeg, ftnlen segid_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pckpds_ 14 7 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ - -extern int pck03e_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckbsr_(char *fname, integer *handle, integer *body, doublereal *et, doublereal *descr, char *ident, logical *found, ftnlen fname_len, ftnlen ident_len); -extern int pcklof_(char *fname, integer *handle, ftnlen fname_len); -extern int pckuof_(integer *handle); -extern int pcksfs_(integer *body, doublereal *et, integer *handle, doublereal *descr, char *ident, logical *found, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ - -extern int pckcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pckcov_(char *pck, integer *idcode, doublereal *cover, ftnlen pck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pcke02_(doublereal *et, doublereal *record, doublereal *eulang); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spke02_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pcke03_(doublereal *et, doublereal *record, doublereal *rotmat); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: rpd_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckeul_(integer *body, doublereal *et, logical *found, char *ref, doublereal *eulang, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pcksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: pckr02_ 14 4 4 7 7 7 */ -/*:ref: pcke02_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckfrm_(char *pck, integer *ids, ftnlen pck_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int pckmat_(integer *body, doublereal *et, integer *ref, doublereal *tsipm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pcksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: pckr02_ 14 4 4 7 7 7 */ -/*:ref: pcke02_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: pckr03_ 14 4 4 7 7 7 */ -/*:ref: pcke03_ 14 3 7 7 7 */ - -extern int pckopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckpds_(integer *body, char *frame, integer *type__, doublereal *first, doublereal *last, doublereal *descr, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ - -extern int pckr02_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckr03_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ - -extern int pckuds_(doublereal *descr, integer *body, integer *frame, integer *type__, doublereal *first, doublereal *last, integer *begin, integer *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pckw02_(integer *handle, integer *body, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern integer pcwid_(char *array, integer *nelt, ftnlen array_len); - -extern int pgrrec_(char *body, doublereal *lon, doublereal *lat, doublereal *alt, doublereal *re, doublereal *f, doublereal *rectan, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: georec_ 14 6 7 7 7 7 7 7 */ - -extern doublereal pi_(void); - -extern int pjelpl_(doublereal *elin, doublereal *plane, doublereal *elout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int pl2nvc_(doublereal *plane, doublereal *normal, doublereal *const__); -/*:ref: vequ_ 14 2 7 7 */ - -extern int pl2nvp_(doublereal *plane, doublereal *normal, doublereal *point); -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int pl2psv_(doublereal *plane, doublereal *point, doublereal *span1, doublereal *span2); -/*:ref: pl2nvp_ 14 3 7 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ - -extern integer plnsns_(integer *bodid); -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int polyds_(doublereal *coeffs, integer *deg, integer *nderiv, doublereal *t, doublereal *p); - -extern int pool_(char *kernel, integer *unit, char *name__, char *names, integer *nnames, char *agent, integer *n, doublereal *values, logical *found, logical *update, integer *start, integer *room, char *cvals, integer *ivals, char *type__, char *uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen kernel_len, ftnlen name_len, ftnlen names_len, ftnlen agent_len, ftnlen cvals_len, ftnlen type_len, ftnlen uwvars_len, ftnlen uwagnt_len); -extern int clpool_(void); -extern int ldpool_(char *kernel, ftnlen kernel_len); -extern int rtpool_(char *name__, integer *n, doublereal *values, logical *found, ftnlen name_len); -extern int expool_(char *name__, logical *found, ftnlen name_len); -extern int wrpool_(integer *unit); -extern int swpool_(char *agent, integer *nnames, char *names, ftnlen agent_len, ftnlen names_len); -extern int cvpool_(char *agent, logical *update, ftnlen agent_len); -extern int gcpool_(char *name__, integer *start, integer *room, integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen cvals_len); -extern int gdpool_(char *name__, integer *start, integer *room, integer *n, doublereal *values, logical *found, ftnlen name_len); -extern int gipool_(char *name__, integer *start, integer *room, integer *n, integer *ivals, logical *found, ftnlen name_len); -extern int dtpool_(char *name__, logical *found, integer *n, char *type__, ftnlen name_len, ftnlen type_len); -extern int pcpool_(char *name__, integer *n, char *cvals, ftnlen name_len, ftnlen cvals_len); -extern int pdpool_(char *name__, integer *n, doublereal *values, ftnlen name_len); -extern int pipool_(char *name__, integer *n, integer *ivals, ftnlen name_len); -extern int lmpool_(char *cvals, integer *n, ftnlen cvals_len); -extern int szpool_(char *name__, integer *n, logical *found, ftnlen name_len); -extern int dvpool_(char *name__, ftnlen name_len); -extern int gnpool_(char *name__, integer *start, integer *room, integer *n, char *cvals, logical *found, ftnlen name_len, ftnlen cvals_len); -extern int dwpool_(char *agent, ftnlen agent_len); -extern int zzvupool_(char *uwvars, integer *uwptrs, integer *uwpool, char *uwagnt, ftnlen uwvars_len, ftnlen uwagnt_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzpini_ 14 27 12 4 4 4 13 13 4 4 4 4 4 4 4 13 4 4 13 13 13 13 124 124 124 124 124 124 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: zznwpool_ 14 14 13 13 4 4 13 13 13 13 124 124 124 124 124 124 */ -/*:ref: rdknew_ 14 2 13 124 */ -/*:ref: zzrvar_ 14 13 4 4 13 4 4 7 4 13 13 12 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ -/*:ref: cltext_ 14 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: ioerr_ 14 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzgapool_ 14 10 13 13 4 4 13 13 124 124 124 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lstltc_ 4 5 13 4 13 124 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: removc_ 14 4 13 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzgpnm_ 14 15 4 4 13 4 4 7 4 13 13 12 4 4 124 124 124 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzrvbf_ 14 17 13 4 4 4 4 13 4 4 7 4 13 13 12 124 124 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: copyc_ 14 4 13 13 124 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ - -extern integer pos_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen substr_len); - -extern integer posr_(char *str, char *substr, integer *start, ftnlen str_len, ftnlen substr_len); - -extern int prefix_(char *pref, integer *spaces, char *string, ftnlen pref_len, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: shiftr_ 14 7 13 4 13 13 124 124 124 */ - -extern doublereal prodad_(doublereal *array, integer *n); - -extern integer prodai_(integer *array, integer *n); - -extern int prompt_(char *prmpt, char *string, ftnlen prmpt_len, ftnlen string_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int prop2b_(doublereal *gm, doublereal *pvinit, doublereal *dt, doublereal *pvprop); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: brckti_ 4 3 4 4 4 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: stmp03_ 14 5 7 7 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vequg_ 14 3 7 4 7 */ - -extern int prsdp_(char *string, doublereal *dpval, ftnlen string_len); -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int prsint_(char *string, integer *intval, ftnlen string_len); -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int prtenc_(integer *number, char *string, ftnlen string_len); -extern int prtdec_(char *string, integer *number, ftnlen string_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical prtpkg_(logical *short__, logical *long__, logical *expl, logical *trace, logical *dfault, char *type__, ftnlen type_len); -extern logical setprt_(logical *short__, logical *expl, logical *long__, logical *trace, logical *dfault); -extern logical msgsel_(char *type__, ftnlen type_len); -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ - -extern int psv2pl_(doublereal *point, doublereal *span1, doublereal *span2, doublereal *plane); -/*:ref: return_ 12 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int putact_(integer *action); -extern int getact_(integer *action); - -extern int putdev_(char *device, ftnlen device_len); -extern int getdev_(char *device, ftnlen device_len); - -extern int putlms_(char *msg, ftnlen msg_len); -extern int getlms_(char *msg, ftnlen msg_len); - -extern int putsms_(char *msg, ftnlen msg_len); -extern int getsms_(char *msg, ftnlen msg_len); - -extern int pxform_(char *from, char *to, doublereal *et, doublereal *rotate, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int q2m_(doublereal *q, doublereal *r__); - -extern int qderiv_(integer *n, doublereal *f0, doublereal *f2, doublereal *delta, doublereal *dfdt); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ - -extern int qdq2av_(doublereal *q, doublereal *dq, doublereal *av); -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: qxq_ 14 3 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int quote_(char *in, char *left, char *right, char *out, ftnlen in_len, ftnlen left_len, ftnlen right_len, ftnlen out_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ - -extern int qxq_(doublereal *q1, doublereal *q2, doublereal *qout); -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int radrec_(doublereal *range, doublereal *ra, doublereal *dec, doublereal *rectan); -/*:ref: latrec_ 14 4 7 7 7 7 */ - -extern int rav2xf_(doublereal *rot, doublereal *av, doublereal *xform); -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int raxisa_(doublereal *matrix, doublereal *axis, doublereal *angle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: m2q_ 14 2 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern int rdencc_(integer *unit, integer *n, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdencd_(integer *unit, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2dp_ 14 6 13 7 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdenci_(integer *unit, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: hx2int_ 14 6 13 4 12 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int rdker_(char *kernel, char *line, integer *number, logical *eof, ftnlen kernel_len, ftnlen line_len); -extern int rdknew_(char *kernel, ftnlen kernel_len); -extern int rdkdat_(char *line, logical *eof, ftnlen line_len); -extern int rdklin_(char *kernel, integer *number, ftnlen kernel_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cltext_ 14 2 13 124 */ -/*:ref: zzsetnnread_ 14 1 12 */ -/*:ref: rdtext_ 14 5 13 13 12 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ - -extern int rdkvar_(char *tabsym, integer *tabptr, doublereal *tabval, char *name__, logical *eof, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: rdkdat_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: replch_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: sydeld_ 14 6 13 13 4 7 124 124 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: syenqd_ 14 7 13 7 13 4 7 124 124 */ - -extern int rdnbl_(char *file, char *line, logical *eof, ftnlen file_len, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rdtext_ 14 5 13 13 12 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rdtext_(char *file, char *line, logical *eof, ftnlen file_len, ftnlen line_len); -extern int cltext_(char *file, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: getlun_ 14 1 4 */ - -extern int readla_(integer *unit, integer *maxlin, integer *numlin, char *array, logical *eof, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: readln_ 14 4 4 13 12 124 */ -/*:ref: failed_ 12 0 */ - -extern int readln_(integer *unit, char *line, logical *eof, ftnlen line_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int reccyl_(doublereal *rectan, doublereal *r__, doublereal *long__, doublereal *z__); -/*:ref: twopi_ 7 0 */ - -extern int recgeo_(doublereal *rectan, doublereal *re, doublereal *f, doublereal *long__, doublereal *lat, doublereal *alt); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ - -extern int reclat_(doublereal *rectan, doublereal *radius, doublereal *long__, doublereal *lat); - -extern int recpgr_(char *body, doublereal *rectan, doublereal *re, doublereal *f, doublereal *lon, doublereal *lat, doublereal *alt, ftnlen body_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: plnsns_ 4 1 4 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int recrad_(doublereal *rectan, doublereal *range, doublereal *ra, doublereal *dec); -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ - -extern int recsph_(doublereal *rectan, doublereal *r__, doublereal *colat, doublereal *long__); - -extern int refchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: rotget_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int remlac_(integer *ne, integer *loc, char *array, integer *na, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remlad_(integer *ne, integer *loc, doublereal *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remlai_(integer *ne, integer *loc, integer *array, integer *na); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removc_(char *item, char *a, ftnlen item_len, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removd_(doublereal *item, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchd_ 4 3 7 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int removi_(integer *item, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int remsub_(char *in, integer *left, integer *right, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int reordc_(integer *iorder, integer *ndim, char *array, ftnlen array_len); - -extern int reordd_(integer *iorder, integer *ndim, doublereal *array); - -extern int reordi_(integer *iorder, integer *ndim, integer *array); - -extern int reordl_(integer *iorder, integer *ndim, logical *array); - -extern int replch_(char *instr, char *old, char *new__, char *outstr, ftnlen instr_len, ftnlen old_len, ftnlen new_len, ftnlen outstr_len); - -extern int replwd_(char *instr, integer *nth, char *new__, char *outstr, ftnlen instr_len, ftnlen new_len, ftnlen outstr_len); -/*:ref: nthwd_ 14 6 13 4 13 4 124 124 */ -/*:ref: fndnwd_ 14 5 13 4 4 4 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int repmc_(char *in, char *marker, char *value, char *out, ftnlen in_len, ftnlen marker_len, ftnlen value_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmct_(char *in, char *marker, integer *value, char *case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: inttxt_ 14 3 4 13 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmd_(char *in, char *marker, doublereal *value, integer *sigdig, char *out, ftnlen in_len, ftnlen marker_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dpstr_ 14 4 7 4 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmf_(char *in, char *marker, doublereal *value, integer *sigdig, char *format, char *out, ftnlen in_len, ftnlen marker_len, ftnlen format_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmi_(char *in, char *marker, integer *value, char *out, ftnlen in_len, ftnlen marker_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repmot_(char *in, char *marker, integer *value, char *case__, char *out, ftnlen in_len, ftnlen marker_len, ftnlen case_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: intord_ 14 3 4 13 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: repsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int repsub_(char *in, integer *left, integer *right, char *string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ - -extern int reset_(void); -/*:ref: seterr_ 12 1 12 */ -/*:ref: putsms_ 14 2 13 124 */ -/*:ref: putlms_ 14 2 13 124 */ -/*:ref: accept_ 12 1 12 */ - -extern logical return_(void); -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ - -extern int rjust_(char *input, char *output, ftnlen input_len, ftnlen output_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int rmaind_(doublereal *num, doublereal *denom, doublereal *q, doublereal *rem); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rmaini_(integer *num, integer *denom, integer *q, integer *rem); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int rmdupc_(integer *nelt, char *array, ftnlen array_len); -/*:ref: shellc_ 14 3 4 13 124 */ - -extern int rmdupd_(integer *nelt, doublereal *array); -/*:ref: shelld_ 14 2 4 7 */ - -extern int rmdupi_(integer *nelt, integer *array); -/*:ref: shelli_ 14 2 4 4 */ - -extern int rotate_(doublereal *angle, integer *iaxis, doublereal *mout); - -extern int rotget_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynrot_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int rotmat_(doublereal *m1, doublereal *angle, integer *iaxis, doublereal *mout); -/*:ref: moved_ 14 3 7 4 7 */ - -extern int rotvec_(doublereal *v1, doublereal *angle, integer *iaxis, doublereal *vout); - -extern doublereal rpd_(void); - -extern int rquad_(doublereal *a, doublereal *b, doublereal *c__, doublereal *root1, doublereal *root2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern integer rtrim_(char *string, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern int saelgv_(doublereal *vec1, doublereal *vec2, doublereal *smajor, doublereal *sminor); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: diags2_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern logical samch_(char *str1, integer *l1, char *str2, integer *l2, ftnlen str1_len, ftnlen str2_len); - -extern logical samchi_(char *str1, integer *l1, char *str2, integer *l2, ftnlen str1_len, ftnlen str2_len); -/*:ref: eqchr_ 12 4 13 13 124 124 */ - -extern logical sameai_(integer *a1, integer *a2, integer *ndim); - -extern logical samsbi_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, integer *e2, ftnlen str1_len, ftnlen str2_len); -/*:ref: nechr_ 12 4 13 13 124 124 */ - -extern logical samsub_(char *str1, integer *b1, integer *e1, char *str2, integer *b2, integer *e2, ftnlen str1_len, ftnlen str2_len); - -extern int sc01_(integer *sc, char *clkstr, doublereal *ticks, doublereal *sclkdp, doublereal *et, ftnlen clkstr_len); -extern int sctk01_(integer *sc, char *clkstr, doublereal *ticks, ftnlen clkstr_len); -extern int scfm01_(integer *sc, doublereal *ticks, char *clkstr, ftnlen clkstr_len); -extern int scte01_(integer *sc, doublereal *sclkdp, doublereal *et); -extern int scet01_(integer *sc, doublereal *et, doublereal *sclkdp); -extern int scec01_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dpstrf_ 14 6 7 4 13 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ - -extern int scanit_(char *string, integer *start, integer *room, integer *nmarks, char *marks, integer *mrklen, integer *pnters, integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen marks_len); -extern int scanpr_(integer *nmarks, char *marks, integer *mrklen, integer *pnters, ftnlen marks_len); -extern int scan_(char *string, char *marks, integer *mrklen, integer *pnters, integer *room, integer *start, integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen marks_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rmdupc_ 14 3 4 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ncpos_ 4 5 13 13 4 124 124 */ - -extern int scanrj_(integer *ids, integer *n, integer *ntokns, integer *ident, integer *beg, integer *end); -/*:ref: isrchi_ 4 3 4 4 4 */ - -extern int scardc_(integer *card, char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: enchar_ 14 3 4 13 124 */ - -extern int scardd_(integer *card, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scardi_(integer *card, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scdecd_(integer *sc, doublereal *sclkdp, char *sclkch, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: scfmt_ 14 4 4 7 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ - -extern int sce2c_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scec01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sce2s_(integer *sc, doublereal *et, char *sclkch, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sce2t_ 14 3 4 7 7 */ -/*:ref: scdecd_ 14 4 4 7 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sce2t_(integer *sc, doublereal *et, doublereal *sclkdp); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scet01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int scencd_(integer *sc, char *sclkch, doublereal *sclkdp, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: sctiks_ 14 4 4 13 7 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern int scfmt_(integer *sc, doublereal *ticks, char *clkstr, ftnlen clkstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scfm01_ 14 4 4 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sclu01_(char *name__, integer *sc, integer *maxnv, integer *n, integer *ival, doublereal *dval, ftnlen name_len); -extern int scli01_(char *name__, integer *sc, integer *maxnv, integer *n, integer *ival, ftnlen name_len); -extern int scld01_(char *name__, integer *sc, integer *maxnv, integer *n, doublereal *dval, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ - -extern int scpars_(integer *sc, char *sclkch, logical *error, char *msg, doublereal *sclkdp, ftnlen sclkch_len, ftnlen msg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: scps01_ 14 7 4 13 12 13 7 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: scpart_ 14 4 4 4 7 7 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ - -extern int scpart_(integer *sc, integer *nparts, doublereal *pstart, doublereal *pstop); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int scps01_(integer *sc, char *clkstr, logical *error, char *msg, doublereal *ticks, ftnlen clkstr_len, ftnlen msg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: scld01_ 14 6 13 4 4 4 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int scs2e_(integer *sc, char *sclkch, doublereal *et, ftnlen sclkch_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scencd_ 14 4 4 13 7 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sct2e_(integer *sc, doublereal *sclkdp, doublereal *et); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: scte01_ 14 3 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sctiks_(integer *sc, char *clkstr, doublereal *ticks, ftnlen clkstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sctype_ 4 1 4 */ -/*:ref: sctk01_ 14 4 4 13 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sctran_(char *clknam, integer *clkid, logical *found, ftnlen clknam_len); -extern int scn2id_(char *clknam, integer *clkid, logical *found, ftnlen clknam_len); -extern int scid2n_(integer *clkid, char *clknam, logical *found, ftnlen clknam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern integer sctype_(integer *sc); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: scli01_ 14 6 13 4 4 4 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sdiffc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int sdiffd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sdiffi_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical setc_(char *a, char *op, char *b, ftnlen a_len, ftnlen op_len, ftnlen b_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical setd_(doublereal *a, char *op, doublereal *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical seterr_(logical *status); -extern logical failed_(void); - -extern logical seti_(integer *a, char *op, integer *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int setmsg_(char *msg, ftnlen msg_len); -/*:ref: allowd_ 12 0 */ -/*:ref: putlms_ 14 2 13 124 */ - -extern int sgfcon_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfpkt_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values, integer *ends); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfref_(integer *handle, doublereal *descr, integer *first, integer *last, doublereal *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgfrvi_(integer *handle, doublereal *descr, doublereal *x, doublereal *value, integer *indx, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ - -extern int sgmeta_(integer *handle, doublereal *descr, integer *mnemon, integer *value); -/*:ref: return_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int sgseqw_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *npkts, integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal *refdat, integer *idxtyp, ftnlen segid_len); -extern int sgbwfs_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *pktsiz, integer *idxtyp, ftnlen segid_len); -extern int sgbwvs_(integer *handle, doublereal *descr, char *segid, integer *nconst, doublereal *const__, integer *idxtyp, ftnlen segid_len); -extern int sgwfpk_(integer *handle, integer *npkts, doublereal *pktdat, integer *nrefs, doublereal *refdat); -extern int sgwvpk_(integer *handle, integer *npkts, integer *pktsiz, doublereal *pktdat, integer *nrefs, doublereal *refdat); -extern int sgwes_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafcad_ 14 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafena_ 14 0 */ - -extern int sharpr_(doublereal *rot); -/*:ref: vhatip_ 14 1 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ - -extern int shellc_(integer *ndim, char *array, ftnlen array_len); -/*:ref: swapc_ 14 4 13 13 124 124 */ - -extern int shelld_(integer *ndim, doublereal *array); -/*:ref: swapd_ 14 2 7 7 */ - -extern int shelli_(integer *ndim, integer *array); -/*:ref: swapi_ 14 2 4 4 */ - -extern int shiftc_(char *in, char *dir, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen dir_len, ftnlen fillc_len, ftnlen out_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: shiftl_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: shiftr_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int shiftl_(char *in, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len); - -extern int shiftr_(char *in, integer *nshift, char *fillc, char *out, ftnlen in_len, ftnlen fillc_len, ftnlen out_len); - -extern int sigdgt_(char *in, char *out, ftnlen in_len, ftnlen out_len); -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ - -extern int sigerr_(char *msg, ftnlen msg_len); -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: seterr_ 12 1 12 */ -/*:ref: putsms_ 14 2 13 124 */ -/*:ref: freeze_ 14 0 */ -/*:ref: outmsg_ 14 2 13 124 */ -/*:ref: accept_ 12 1 12 */ -/*:ref: byebye_ 14 2 13 124 */ - -extern int sincpt_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, logical *found, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: npedln_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern integer sizec_(char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dechar_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sized_(doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sizei_(integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical smsgnd_(doublereal *x, doublereal *y); - -extern logical smsgni_(integer *x, integer *y); - -extern logical somfls_(logical *logcls, integer *n); - -extern logical somtru_(logical *logcls, integer *n); - -extern int spca2b_(char *text, char *binary, ftnlen text_len, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopr_ 14 3 13 4 124 */ -/*:ref: spct2b_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcac_(integer *handle, integer *unit, char *bmark, char *emark, ftnlen bmark_len, ftnlen emark_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: locln_ 14 10 4 13 13 13 4 4 12 124 124 124 */ -/*:ref: countc_ 4 5 4 4 4 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafarr_ 14 2 4 4 */ -/*:ref: lastnb_ 4 2 13 124 */ - -extern int spcb2a_(char *binary, char *text, ftnlen binary_len, ftnlen text_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: txtopn_ 14 3 13 4 124 */ -/*:ref: spcb2t_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcb2t_(char *binary, integer *unit, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafb2t_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: spcec_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spcdc_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: dafrrr_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcec_(integer *handle, integer *unit); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafsih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int spcopn_(char *spc, char *ifname, integer *handle, ftnlen spc_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafopn_ 14 8 13 4 4 13 4 4 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spcrfl_(integer *handle, char *line, logical *eoc, ftnlen line_len); -extern int spcrnl_(char *line, logical *eoc, ftnlen line_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafrfr_ 14 8 4 4 4 13 4 4 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int spct2b_(integer *unit, char *binary, ftnlen binary_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: daft2b_ 14 4 4 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dafopw_ 14 3 13 4 124 */ -/*:ref: spcac_ 14 6 4 4 13 13 124 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern doublereal spd_(void); - -extern int sphcyl_(doublereal *radius, doublereal *colat, doublereal *slong, doublereal *r__, doublereal *long__, doublereal *z__); - -extern int sphlat_(doublereal *r__, doublereal *colat, doublereal *longs, doublereal *radius, doublereal *long__, doublereal *lat); -/*:ref: halfpi_ 7 0 */ - -extern int sphrec_(doublereal *r__, doublereal *colat, doublereal *long__, doublereal *rectan); - -extern doublereal sphsd_(doublereal *radius, doublereal *long1, doublereal *lat1, doublereal *long2, doublereal *lat2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ - -extern int spk14a_(integer *handle, integer *ncsets, doublereal *coeffs, doublereal *epochs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ - -extern int spk14b_(integer *handle, char *segid, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, integer *chbdeg, ftnlen segid_len, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ - -extern int spk14e_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgwes_ 14 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkacs_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: spkaps_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int spkapo_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkgps_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int spkapp_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int spkaps_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkltc_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int spkbsr_(char *fname, integer *handle, integer *body, doublereal *et, doublereal *descr, char *ident, logical *found, ftnlen fname_len, ftnlen ident_len); -extern int spklef_(char *fname, integer *handle, ftnlen fname_len); -extern int spkuef_(integer *handle); -extern int spksfs_(integer *body, doublereal *et, integer *handle, doublereal *descr, char *ident, logical *found, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: dafcls_ 14 1 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: dpmin_ 7 0 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafbbs_ 14 1 4 */ -/*:ref: daffpa_ 14 1 12 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: dafgn_ 14 2 13 124 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnktl_ 4 2 4 4 */ - -extern int spkcls_(integer *handle); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spkcov_(char *spk, integer *idcode, doublereal *cover, ftnlen spk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spke01_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spke02_(doublereal *et, doublereal *record, doublereal *xyzdot); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbint_ 14 6 7 4 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke03_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke05_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke08_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: xposeg_ 14 4 7 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lgresp_ 7 6 4 7 7 7 7 7 */ - -extern int spke09_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: xposeg_ 14 4 7 4 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ - -extern int spke10_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: ev2lin_ 14 4 7 7 7 7 */ -/*:ref: dpspce_ 14 4 7 7 7 7 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vlcomg_ 14 6 4 7 7 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzeprcss_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke12_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: hrmesp_ 14 8 4 7 7 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke13_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke14_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chbval_ 14 5 7 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spke15_(doublereal *et, doublereal *recin, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dpr_ 7 0 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: prop2b_ 14 4 7 7 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: pi_ 7 0 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spke17_(doublereal *et, doublereal *recin, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqncpv_ 14 6 7 7 7 7 7 7 */ - -extern int spke18_(doublereal *et, doublereal *record, doublereal *state); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: xpsgip_ 14 3 4 4 7 */ -/*:ref: lgrint_ 7 5 4 7 7 7 7 */ -/*:ref: hrmint_ 14 7 4 7 7 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int spkez_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkacs_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: spkltc_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int spkezp_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: spkgps_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: spkapo_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int spkezr_(char *targ, doublereal *et, char *ref, char *abcorr, char *obs, doublereal *starg, doublereal *lt, ftnlen targ_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ - -extern int spkgeo_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int spkgps_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: refchg_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int spkltc_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int spkobj_(char *spk, integer *ids, ftnlen spk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafopr_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: dafcls_ 14 1 4 */ - -extern int spkopa_(char *file, integer *handle, ftnlen file_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafopw_ 14 3 13 4 124 */ - -extern int spkopn_(char *name__, char *ifname, integer *ncomch, integer *handle, ftnlen name_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafonw_ 14 10 13 13 4 4 13 4 4 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkpds_(integer *body, integer *center, char *frame, integer *type__, doublereal *first, doublereal *last, doublereal *descr, ftnlen frame_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ - -extern int spkpos_(char *targ, doublereal *et, char *ref, char *abcorr, char *obs, doublereal *ptarg, doublereal *lt, ftnlen targ_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzbodn2c_ 14 4 13 4 12 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ - -extern int spkpv_(integer *handle, doublereal *descr, doublereal *et, char *ref, doublereal *state, integer *center, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkpvn_(integer *handle, doublereal *descr, doublereal *et, integer *ref, doublereal *state, integer *center); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: spkr01_ 14 4 4 7 7 7 */ -/*:ref: spke01_ 14 3 7 7 7 */ -/*:ref: spkr02_ 14 4 4 7 7 7 */ -/*:ref: spke02_ 14 3 7 7 7 */ -/*:ref: spkr03_ 14 4 4 7 7 7 */ -/*:ref: spke03_ 14 3 7 7 7 */ -/*:ref: spkr05_ 14 4 4 7 7 7 */ -/*:ref: spke05_ 14 3 7 7 7 */ -/*:ref: spkr08_ 14 4 4 7 7 7 */ -/*:ref: spke08_ 14 3 7 7 7 */ -/*:ref: spkr09_ 14 4 4 7 7 7 */ -/*:ref: spke09_ 14 3 7 7 7 */ -/*:ref: spkr10_ 14 4 4 7 7 7 */ -/*:ref: spke10_ 14 3 7 7 7 */ -/*:ref: spkr12_ 14 4 4 7 7 7 */ -/*:ref: spke12_ 14 3 7 7 7 */ -/*:ref: spkr13_ 14 4 4 7 7 7 */ -/*:ref: spke13_ 14 3 7 7 7 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: spkr14_ 14 4 4 7 7 7 */ -/*:ref: spke14_ 14 3 7 7 7 */ -/*:ref: spkr15_ 14 4 4 7 7 7 */ -/*:ref: spke15_ 14 3 7 7 7 */ -/*:ref: spkr17_ 14 4 4 7 7 7 */ -/*:ref: spke17_ 14 3 7 7 7 */ -/*:ref: spkr18_ 14 4 4 7 7 7 */ -/*:ref: spke18_ 14 3 7 7 7 */ - -extern int spkr01_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr02_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr03_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr05_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int spkr08_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: odd_ 12 1 4 */ - -extern int spkr09_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: lstltd_ 4 3 7 4 7 */ -/*:ref: odd_ 12 1 4 */ - -extern int spkr10_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr12_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkr08_ 14 4 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr13_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkr09_ 14 4 4 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkr14_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ - -extern int spkr15_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int spkr17_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int spkr18_(integer *handle, doublereal *descr, doublereal *et, doublereal *record); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: lstltd_ 4 3 7 4 7 */ - -extern int spks01_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks02_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks03_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks05_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks08_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks09_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks10_(integer *srchan, doublereal *srcdsc, integer *dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sgmeta_ 14 4 4 7 4 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sgfref_ 14 5 4 7 4 4 7 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ -/*:ref: sgwes_ 14 1 4 */ - -extern int spks12_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spks08_ 14 5 4 4 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks13_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spks09_ 14 5 4 4 4 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spks14_(integer *srchan, doublereal *srcdsc, integer *dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgfcon_ 14 5 4 7 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sgfrvi_ 14 6 4 7 7 7 4 12 */ -/*:ref: spk14b_ 14 10 4 13 4 4 13 7 7 4 124 124 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sgfref_ 14 5 4 7 4 4 7 */ -/*:ref: spk14a_ 14 4 4 4 7 7 */ -/*:ref: spk14e_ 14 1 4 */ - -extern int spks15_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks17_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spks18_(integer *handle, integer *baddr, integer *eaddr, doublereal *begin, doublereal *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ - -extern int spkssb_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spksub_(integer *handle, doublereal *descr, char *ident, doublereal *begin, doublereal *end, integer *newh, ftnlen ident_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: spks01_ 14 5 4 4 4 7 7 */ -/*:ref: dafena_ 14 0 */ -/*:ref: spks02_ 14 5 4 4 4 7 7 */ -/*:ref: spks03_ 14 5 4 4 4 7 7 */ -/*:ref: spks05_ 14 5 4 4 4 7 7 */ -/*:ref: spks08_ 14 5 4 4 4 7 7 */ -/*:ref: spks09_ 14 5 4 4 4 7 7 */ -/*:ref: spks10_ 14 6 4 7 4 7 13 124 */ -/*:ref: spks12_ 14 5 4 4 4 7 7 */ -/*:ref: spks13_ 14 5 4 4 4 7 7 */ -/*:ref: spks14_ 14 6 4 7 4 7 13 124 */ -/*:ref: spks15_ 14 5 4 4 4 7 7 */ -/*:ref: spks17_ 14 5 4 4 4 7 7 */ -/*:ref: spks18_ 14 5 4 4 4 7 7 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int spkuds_(doublereal *descr, integer *body, integer *center, integer *frame, integer *type__, doublereal *first, doublereal *last, integer *begin, integer *end); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int spkw01_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *n, doublereal *dlines, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw02_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw03_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: chckid_ 14 5 13 4 13 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw05_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *gm, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw08_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epoch1, doublereal *step, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw09_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw10_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *consts, integer *n, doublereal *elems, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sgbwfs_ 14 8 4 7 13 4 7 4 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: zzwahr_ 14 2 7 7 */ -/*:ref: sgwfpk_ 14 5 4 4 7 4 7 */ -/*:ref: sgwes_ 14 1 4 */ - -extern int spkw12_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epoch1, doublereal *step, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw13_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *states, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: even_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw15_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dpr_ 7 0 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw17_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *decpol, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkpds_ 14 8 4 4 13 4 7 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int spkw18_(integer *handle, integer *subtyp, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *degree, integer *n, doublereal *packts, doublereal *epochs, ftnlen frame_len, ftnlen segid_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: dafbna_ 14 4 4 7 13 124 */ -/*:ref: dafada_ 14 2 7 4 */ -/*:ref: dafena_ 14 0 */ - -extern int srfrec_(integer *body, doublereal *long__, doublereal *lat, doublereal *rectan); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int srfxpt_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, doublereal *spoint, doublereal *dist, doublereal *trgepc, doublereal *obspos, logical *found, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: npedln_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ - -extern int ssizec_(integer *size, char *cell, ftnlen cell_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: enchar_ 14 3 4 13 124 */ - -extern int ssized_(integer *size, doublereal *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int ssizei_(integer *size, integer *cell); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stcc01_(char *catfnm, char *tabnam, logical *istyp1, char *errmsg, ftnlen catfnm_len, ftnlen tabnam_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ekopr_ 14 3 13 4 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekssum_ 14 14 4 4 13 4 4 13 13 4 4 12 12 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: nblen_ 4 2 13 124 */ -/*:ref: ekcls_ 14 1 4 */ - -extern int stcf01_(char *catnam, doublereal *westra, doublereal *eastra, doublereal *sthdec, doublereal *nthdec, integer *nstars, ftnlen catnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dpr_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: ekfind_ 14 6 13 4 12 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stcg01_(integer *index, doublereal *ra, doublereal *dec, doublereal *rasig, doublereal *decsig, integer *catnum, char *sptype, doublereal *vmag, ftnlen sptype_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ekgd_ 14 6 4 4 4 7 12 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ekgi_ 14 6 4 4 4 4 12 12 */ -/*:ref: ekgc_ 14 7 4 4 4 13 12 12 124 */ -/*:ref: rpd_ 7 0 */ - -extern int stcl01_(char *catfnm, char *tabnam, integer *handle, ftnlen catfnm_len, ftnlen tabnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: stcc01_ 14 7 13 13 12 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ - -extern int stdio_(char *name__, integer *unit, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stelab_(doublereal *pobj, doublereal *vobs, doublereal *appobj); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int stlabx_(doublereal *pobj, doublereal *vobs, doublereal *corpos); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stmp03_(doublereal *x, doublereal *c0, doublereal *c1, doublereal *c2, doublereal *c3); -/*:ref: dpmax_ 7 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int stpool_(char *item, integer *nth, char *contin, char *string, integer *size, logical *found, ftnlen item_len, ftnlen contin_len, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int str2et_(char *string, doublereal *et, ftnlen string_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: timdef_ 14 6 13 13 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: tchckd_ 14 2 13 124 */ -/*:ref: tparch_ 14 2 13 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: jul2gr_ 14 4 4 4 4 4 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ -/*:ref: gr2jul_ 14 4 4 4 4 4 */ - -extern int subpnt_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ - -extern int subpt_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ - -extern int subslr_(char *method, char *target, doublereal *et, char *fixref, char *abcorr, char *obsrvr, doublereal *spoint, doublereal *trgepc, doublereal *srfvec, ftnlen method_len, ftnlen target_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lparse_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: touchd_ 7 1 7 */ - -extern int subsol_(char *method, char *target, doublereal *et, char *abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: ltime_ 14 7 7 4 13 4 7 7 124 */ -/*:ref: spkpos_ 14 11 13 7 13 13 13 7 7 124 124 124 124 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ - -extern int suffix_(char *suff, integer *spaces, char *string, ftnlen suff_len, ftnlen string_len); -/*:ref: lastnb_ 4 2 13 124 */ - -extern doublereal sumad_(doublereal *array, integer *n); - -extern integer sumai_(integer *array, integer *n); - -extern int surfnm_(doublereal *a, doublereal *b, doublereal *c__, doublereal *point, doublereal *normal); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhatip_ 14 1 7 */ - -extern int surfpt_(doublereal *positn, doublereal *u, doublereal *a, doublereal *b, doublereal *c__, doublereal *point, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int surfpv_(doublereal *stvrtx, doublereal *stdir, doublereal *a, doublereal *b, doublereal *c__, doublereal *stx, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: surfpt_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: surfnm_ 14 5 7 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ - -extern int swapac_(integer *n, integer *locn, integer *m, integer *locm, char *array, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapc_ 14 4 13 13 124 124 */ -/*:ref: cyacip_ 14 6 4 13 4 13 124 124 */ - -extern int swapad_(integer *n, integer *locn, integer *m, integer *locm, doublereal *array); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: cyadip_ 14 5 4 13 4 7 124 */ - -extern int swapai_(integer *n, integer *locn, integer *m, integer *locm, integer *array); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: cyaiip_ 14 5 4 13 4 4 124 */ - -extern int swapc_(char *a, char *b, ftnlen a_len, ftnlen b_len); - -extern int swapd_(doublereal *a, doublereal *b); - -extern int swapi_(integer *a, integer *b); - -extern int sxform_(char *from, char *to, doublereal *et, doublereal *xform, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frmchg_ 14 4 4 4 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydelc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydeld_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydeli_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer sydimi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupc_(char *name__, char *copy, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupd_(char *name__, char *copy, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sydupi_(char *name__, char *copy, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen copy_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetc_ 14 9 13 13 13 4 13 124 124 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetd_ 14 7 13 7 13 4 7 124 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syenqi_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: syseti_ 14 7 13 4 13 4 4 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfetc_(integer *nth, char *tabsym, integer *tabptr, char *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen tabval_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfetd_(integer *nth, char *tabsym, integer *tabptr, doublereal *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syfeti_(integer *nth, char *tabsym, integer *tabptr, integer *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen name_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygetc_(char *name__, char *tabsym, integer *tabptr, char *tabval, integer *n, char *values, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygetd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, integer *n, doublereal *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sygeti_(char *name__, char *tabsym, integer *tabptr, integer *tabval, integer *n, integer *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthc_(char *name__, integer *nth, char *tabsym, integer *tabptr, char *tabval, char *value, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthd_(char *name__, integer *nth, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int synthi_(char *name__, integer *nth, char *tabsym, integer *tabptr, integer *tabval, integer *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordc_(char *name__, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shellc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shelld_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syordi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: shelli_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopc_(char *name__, char *tabsym, integer *tabptr, char *tabval, char *value, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopd_(char *name__, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypopi_(char *name__, char *tabsym, integer *tabptr, integer *tabval, integer *value, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetc_ 14 9 13 13 13 4 13 124 124 124 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sysetd_ 14 7 13 7 13 4 7 124 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sypshi_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: syseti_ 14 7 13 4 13 4 4 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syputc_(char *name__, char *values, integer *n, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen values_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ - -extern int syputd_(char *name__, doublereal *values, integer *n, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ - -extern int syputi_(char *name__, integer *values, integer *n, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ - -extern int syrenc_(char *old, char *new__, char *tabsym, integer *tabptr, char *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydelc_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syrend_(char *old, char *new__, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydeld_ 14 6 13 13 4 7 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapad_ 14 5 4 4 4 4 7 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syreni_(char *old, char *new__, char *tabsym, integer *tabptr, integer *tabval, ftnlen old_len, ftnlen new_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sydeli_ 14 6 13 13 4 4 124 124 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapai_ 14 5 4 4 4 4 4 */ -/*:ref: swapac_ 14 6 4 4 4 4 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syselc_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, char *tabval, char *values, logical *found, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseld_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, doublereal *tabval, doublereal *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseli_(char *name__, integer *begin, integer *end, char *tabsym, integer *tabptr, integer *tabval, integer *values, logical *found, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sysetc_(char *name__, char *value, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen value_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlac_ 14 5 4 4 13 4 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sysetd_(char *name__, doublereal *value, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlad_ 14 4 4 4 7 4 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: inslad_ 14 5 7 4 4 7 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int syseti_(char *name__, integer *value, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: lstlec_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: remlai_ 14 4 4 4 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: inslac_ 14 7 13 4 4 13 4 124 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: inslai_ 14 5 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrnc_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, char *tabval, ftnlen name_len, ftnlen tabsym_len, ftnlen tabval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapc_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrnd_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int sytrni_(char *name__, integer *i__, integer *j, char *tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: sumai_ 4 2 4 4 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int tcheck_(doublereal *tvec, char *type__, logical *mods, char *modify, logical *ok, char *error, ftnlen type_len, ftnlen modify_len, ftnlen error_len); -extern int tparch_(char *type__, ftnlen type_len); -extern int tchckd_(char *type__, ftnlen type_len); -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int texpyr_(integer *year); -extern int tsetyr_(integer *year); - -extern int timdef_(char *action, char *item, char *value, ftnlen action_len, ftnlen item_len, ftnlen value_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ - -extern int timout_(doublereal *et, char *pictur, char *output, ftnlen pictur_len, ftnlen output_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scanpr_ 14 5 4 13 4 4 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: scan_ 14 12 13 13 4 4 4 4 4 4 4 4 124 124 */ -/*:ref: timdef_ 14 6 13 13 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: zzutcpm_ 14 7 13 4 7 7 4 12 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: scanrj_ 14 6 4 4 4 4 4 4 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: j1950_ 7 0 */ -/*:ref: brckti_ 4 3 4 4 4 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: gr2jul_ 14 4 4 4 4 4 */ -/*:ref: jul2gr_ 14 4 4 4 4 4 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: lcase_ 14 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int tipbod_(char *ref, integer *body, doublereal *et, doublereal *tipm, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irftrn_ 14 5 13 13 7 124 124 */ -/*:ref: bodmat_ 14 3 4 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int tisbod_(char *ref, integer *body, doublereal *et, doublereal *tsipm, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: pckmat_ 14 5 4 7 4 7 12 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: ccifrm_ 14 7 4 4 4 13 4 12 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodbry_ 4 1 4 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: bodfnd_ 12 3 4 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: twopi_ 7 0 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: failed_ 12 0 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int tkfram_(integer *id, doublereal *rot, integer *frame, logical *found); -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: locati_ 14 6 4 4 4 4 4 12 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: dwpool_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: badkpv_ 12 10 13 13 13 4 4 13 124 124 124 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: sharpr_ 14 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: vhatg_ 14 3 7 4 7 */ -/*:ref: q2m_ 14 2 7 7 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ - -extern int tkvrsn_(char *item, char *verstr, ftnlen item_len, ftnlen verstr_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ - -extern int tostdo_(char *line, ftnlen line_len); -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: writln_ 14 3 13 4 124 */ - -extern H_f touchc_(char *ret_val, ftnlen ret_val_len, char *string, ftnlen string_len); - -extern doublereal touchd_(doublereal *dp); - -extern integer touchi_(integer *int__); - -extern logical touchl_(logical *log__); - -extern int tparse_(char *string, doublereal *sp2000, char *error, ftnlen string_len, ftnlen error_len); -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: j2000_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: rmaini_ 14 4 4 4 4 4 */ - -extern int tpartv_(char *string, doublereal *tvec, integer *ntvec, char *type__, char *modify, logical *mods, logical *yabbrv, logical *succes, char *pictur, char *error, ftnlen string_len, ftnlen type_len, ftnlen modify_len, ftnlen pictur_len, ftnlen error_len); -/*:ref: zztpats_ 12 6 4 4 13 13 124 124 */ -/*:ref: zztokns_ 12 4 13 13 124 124 */ -/*:ref: zzcmbt_ 12 5 13 13 12 124 124 */ -/*:ref: zzsubt_ 12 5 13 13 12 124 124 */ -/*:ref: zzrept_ 12 5 13 13 12 124 124 */ -/*:ref: zzremt_ 12 2 13 124 */ -/*:ref: zzist_ 12 2 13 124 */ -/*:ref: zznote_ 12 4 13 4 4 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzunpck_ 12 11 13 12 7 4 13 13 13 124 124 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: zzvalt_ 12 6 13 4 4 13 124 124 */ -/*:ref: zzgrep_ 12 2 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzispt_ 12 4 13 4 4 124 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ - -extern int tpictr_(char *sample, char *pictur, logical *ok, char *error, ftnlen sample_len, ftnlen pictur_len, ftnlen error_len); -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ - -extern doublereal trace_(doublereal *matrix); - -extern doublereal traceg_(doublereal *matrix, integer *ndim); - -extern int trcpkg_(integer *depth, integer *index, char *module, char *trace, char *name__, ftnlen module_len, ftnlen trace_len, ftnlen name_len); -extern int chkin_(char *module, ftnlen module_len); -extern int chkout_(char *module, ftnlen module_len); -extern int trcdep_(integer *depth); -extern int trcmxd_(integer *depth); -extern int trcnam_(integer *index, char *name__, ftnlen name_len); -extern int qcktrc_(char *trace, ftnlen trace_len); -extern int freeze_(void); -extern int trcoff_(void); -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: frstnb_ 4 2 13 124 */ -/*:ref: getdev_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: getact_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int ttrans_(char *from, char *to, doublereal *tvec, ftnlen from_len, ftnlen to_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ -/*:ref: reordi_ 14 3 4 4 4 */ -/*:ref: reordl_ 14 3 4 4 12 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: rmaini_ 14 4 4 4 4 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: rmaind_ 14 4 7 7 7 7 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ -/*:ref: unitim_ 7 5 7 13 13 124 124 */ -/*:ref: lstled_ 4 3 7 4 7 */ -/*:ref: lstlti_ 4 3 4 4 4 */ - -extern doublereal twopi_(void); - -extern int twovec_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *mout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int twovxf_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int txtopn_(char *fname, integer *unit, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int txtopr_(char *fname, integer *unit, ftnlen fname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern doublereal tyear_(void); - -extern int ucase_(char *in, char *out, ftnlen in_len, ftnlen out_len); - -extern int ucrss_(doublereal *v1, doublereal *v2, doublereal *vout); -/*:ref: vnorm_ 7 1 7 */ - -extern int uddc_(U_fp udfunc, doublereal *x, doublereal *dx, logical *isdecr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: uddf_ 14 4 200 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int uddf_(S_fp udfunc, doublereal *x, doublereal *dx, doublereal *deriv); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ - -extern int unionc_(char *a, char *b, char *c__, ftnlen a_len, ftnlen b_len, ftnlen c_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int uniond_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int unioni_(integer *a, integer *b, integer *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: scardi_ 14 2 4 4 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern doublereal unitim_(doublereal *epoch, char *insys, char *outsys, ftnlen insys_len, ftnlen outsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spd_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: unionc_ 14 6 13 13 13 124 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: somfls_ 12 2 12 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: insrtc_ 14 4 13 13 124 124 */ -/*:ref: setc_ 12 6 13 13 13 124 124 124 */ -/*:ref: elemc_ 12 4 13 13 124 124 */ - -extern int unorm_(doublereal *v1, doublereal *vout, doublereal *vmag); -/*:ref: vnorm_ 7 1 7 */ - -extern int unormg_(doublereal *v1, integer *ndim, doublereal *vout, doublereal *vmag); -/*:ref: vnormg_ 7 2 7 4 */ - -extern int utc2et_(char *utcstr, doublereal *et, ftnlen utcstr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: tcheck_ 14 9 7 13 12 13 12 13 124 124 124 */ -/*:ref: texpyr_ 14 1 4 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int vadd_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern int vaddg_(doublereal *v1, doublereal *v2, integer *ndim, doublereal *vout); - -extern int validc_(integer *size, integer *n, char *a, ftnlen a_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupc_ 14 3 4 13 124 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ - -extern int validd_(integer *size, integer *n, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ - -extern int validi_(integer *size, integer *n, integer *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rmdupi_ 14 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: scardi_ 14 2 4 4 */ - -extern int vcrss_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern doublereal vdist_(doublereal *v1, doublereal *v2); -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern doublereal vdistg_(doublereal *v1, doublereal *v2, integer *ndim); - -extern doublereal vdot_(doublereal *v1, doublereal *v2); - -extern doublereal vdotg_(doublereal *v1, doublereal *v2, integer *ndim); - -extern int vequ_(doublereal *vin, doublereal *vout); - -extern int vequg_(doublereal *vin, integer *ndim, doublereal *vout); - -extern int vhat_(doublereal *v1, doublereal *vout); -/*:ref: vnorm_ 7 1 7 */ - -extern int vhatg_(doublereal *v1, integer *ndim, doublereal *vout); -/*:ref: vnormg_ 7 2 7 4 */ - -extern int vhatip_(doublereal *v); -/*:ref: vnorm_ 7 1 7 */ - -extern int vlcom_(doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *sum); - -extern int vlcom3_(doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *c__, doublereal *v3, doublereal *sum); - -extern int vlcomg_(integer *n, doublereal *a, doublereal *v1, doublereal *b, doublereal *v2, doublereal *sum); - -extern int vminug_(doublereal *vin, integer *ndim, doublereal *vout); - -extern int vminus_(doublereal *v1, doublereal *vout); - -extern doublereal vnorm_(doublereal *v1); - -extern doublereal vnormg_(doublereal *v1, integer *ndim); - -extern int vpack_(doublereal *x, doublereal *y, doublereal *z__, doublereal *v); - -extern int vperp_(doublereal *a, doublereal *b, doublereal *p); -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int vprjp_(doublereal *vin, doublereal *plane, doublereal *vout); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int vprjpi_(doublereal *vin, doublereal *projpl, doublereal *invpl, doublereal *vout, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: dpmax_ 7 0 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int vproj_(doublereal *a, doublereal *b, doublereal *p); -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ - -extern int vprojg_(doublereal *a, doublereal *b, integer *ndim, doublereal *p); -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: vsclg_ 14 4 7 7 4 7 */ - -extern doublereal vrel_(doublereal *v1, doublereal *v2); -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ - -extern doublereal vrelg_(doublereal *v1, doublereal *v2, integer *ndim); -/*:ref: vdistg_ 7 3 7 7 4 */ -/*:ref: vnormg_ 7 2 7 4 */ - -extern int vrotv_(doublereal *v, doublereal *axis, doublereal *theta, doublereal *r__); -/*:ref: vnorm_ 7 1 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vproj_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ - -extern int vscl_(doublereal *s, doublereal *v1, doublereal *vout); - -extern int vsclg_(doublereal *s, doublereal *v1, integer *ndim, doublereal *vout); - -extern int vsclip_(doublereal *s, doublereal *v); - -extern doublereal vsep_(doublereal *v1, doublereal *v2); -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: pi_ 7 0 */ - -extern doublereal vsepg_(doublereal *v1, doublereal *v2, integer *ndim); -/*:ref: vnormg_ 7 2 7 4 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: pi_ 7 0 */ - -extern int vsub_(doublereal *v1, doublereal *v2, doublereal *vout); - -extern int vsubg_(doublereal *v1, doublereal *v2, integer *ndim, doublereal *vout); - -extern doublereal vtmv_(doublereal *v1, doublereal *matrix, doublereal *v2); - -extern doublereal vtmvg_(doublereal *v1, doublereal *matrix, doublereal *v2, integer *nrow, integer *ncol); - -extern int vupack_(doublereal *v, doublereal *x, doublereal *y, doublereal *z__); - -extern logical vzero_(doublereal *v); - -extern logical vzerog_(doublereal *v, integer *ndim); - -extern integer wdcnt_(char *string, ftnlen string_len); - -extern integer wdindx_(char *string, char *word, ftnlen string_len, ftnlen word_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: frstnb_ 4 2 13 124 */ - -extern integer wncard_(doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: even_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wncomd_(doublereal *left, doublereal *right, doublereal *window, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: failed_ 12 0 */ - -extern int wncond_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wndifd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern logical wnelmd_(doublereal *point, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnexpd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnextd_(char *side, doublereal *window, ftnlen side_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfetd_(doublereal *window, integer *n, doublereal *left, doublereal *right); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfild_(doublereal *small, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnfltd_(doublereal *small, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical wnincd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wninsd_(doublereal *left, doublereal *right, doublereal *window); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ - -extern int wnintd_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical wnreld_(doublereal *a, char *op, doublereal *b, ftnlen op_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: wnincd_ 12 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnsumd_(doublereal *window, doublereal *meas, doublereal *avg, doublereal *stddev, integer *short__, integer *long__); -/*:ref: return_ 12 0 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: even_ 12 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnunid_(doublereal *a, doublereal *b, doublereal *c__); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: excess_ 14 3 4 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wnvald_(integer *size, integer *n, doublereal *a); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int wrencc_(integer *unit, integer *n, char *data, ftnlen data_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrencd_(integer *unit, integer *n, doublereal *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dp2hx_ 14 4 7 13 4 124 */ - -extern int wrenci_(integer *unit, integer *n, integer *data); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: int2hx_ 14 4 4 13 4 124 */ - -extern int writla_(integer *numlin, char *array, integer *unit, ftnlen array_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: writln_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ - -extern int writln_(char *line, integer *unit, ftnlen line_len); -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrkvar_(integer *unit, char *name__, char *dirctv, char *tabsym, integer *tabptr, doublereal *tabval, ftnlen name_len, ftnlen dirctv_len, ftnlen tabsym_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sydimd_ 4 6 13 13 4 7 124 124 */ -/*:ref: synthd_ 14 9 13 4 13 4 7 7 12 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: rjust_ 14 4 13 13 124 124 */ -/*:ref: ioerr_ 14 5 13 13 4 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int wrline_(char *device, char *line, ftnlen device_len, ftnlen line_len); -extern int clline_(char *device, ftnlen device_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: fndlun_ 14 1 4 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ - -extern int xf2eul_(doublereal *xform, integer *axisa, integer *axisb, integer *axisc, doublereal *eulang, logical *unique); -extern int eul2xf_(doublereal *eulang, integer *axisa, integer *axisb, integer *axisc, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: m2eul_ 14 7 7 4 4 4 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: mxmt_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ - -extern int xf2rav_(doublereal *xform, doublereal *rot, doublereal *av); -/*:ref: mtxm_ 14 3 7 7 7 */ - -extern int xposbl_(doublereal *bmat, integer *nrow, integer *ncol, integer *bsize, doublereal *btmat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int xpose_(doublereal *m1, doublereal *mout); - -extern int xposeg_(doublereal *matrix, integer *nrow, integer *ncol, doublereal *xposem); - -extern int xpsgip_(integer *nrow, integer *ncol, doublereal *matrix); - -extern int zzascii_(char *file, char *line, logical *check, char *termin, ftnlen file_len, ftnlen line_len, ftnlen termin_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzasryel_(char *extrem, doublereal *ellips, doublereal *vertex, doublereal *dir, doublereal *angle, doublereal *extpt, ftnlen extrem_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: swapd_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int zzbodblt_(integer *room, char *names, char *nornam, integer *codes, integer *nvals, char *device, char *reqst, ftnlen names_len, ftnlen nornam_len, ftnlen device_len, ftnlen reqst_len); -extern int zzbodget_(integer *room, char *names, char *nornam, integer *codes, integer *nvals, ftnlen names_len, ftnlen nornam_len); -extern int zzbodlst_(char *device, char *reqst, ftnlen device_len, ftnlen reqst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzidmap_ 14 3 4 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: movec_ 14 5 13 4 13 124 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: wrline_ 14 4 13 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ - -extern integer zzbodbry_(integer *body); - -extern int zzbodini_(char *names, char *nornam, integer *codes, integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, ftnlen names_len, ftnlen nornam_len); -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ - -extern int zzbodker_(char *names, char *nornam, integer *codes, integer *nvals, integer *ordnom, integer *ordcod, integer *nocds, logical *extker, ftnlen names_len, ftnlen nornam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: zzbodini_ 14 9 13 13 4 4 4 4 4 124 124 */ - -extern int zzbodtrn_(char *name__, integer *code, logical *found, ftnlen name_len); -extern int zzbodn2c_(char *name__, integer *code, logical *found, ftnlen name_len); -extern int zzbodc2n_(integer *code, char *name__, logical *found, ftnlen name_len); -extern int zzboddef_(char *name__, integer *code, ftnlen name_len); -extern int zzbodkik_(void); -extern int zzbodrst_(void); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzbodget_ 14 7 4 13 13 4 4 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzbodini_ 14 9 13 13 4 4 4 4 4 124 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: zzbodker_ 14 10 13 13 4 4 4 4 4 12 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: bschoc_ 4 6 13 4 13 4 124 124 */ -/*:ref: bschoi_ 4 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzbodvcd_(integer *bodyid, char *item, integer *maxn, integer *dim, doublereal *values, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzck4d2i_(doublereal *dpcoef, integer *nsets, doublereal *parcod, integer *i__); - -extern int zzck4i2d_(integer *i__, integer *nsets, doublereal *parcod, doublereal *dpcoef); - -extern int zzckcv01_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv02_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv03_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errhan_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv04_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: intmax_ 4 0 */ -/*:ref: dafps_ 14 5 4 4 7 4 7 */ -/*:ref: cknr04_ 14 3 4 7 4 */ -/*:ref: sgfpkt_ 14 6 4 7 4 4 7 4 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckcv05_(integer *handle, integer *arrbeg, integer *arrend, integer *sclkid, doublereal *dc, doublereal *tol, char *timsys, doublereal *schedl, ftnlen timsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ -/*:ref: errint_ 14 3 13 7 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ - -extern int zzckspk_(integer *handle, char *ckspk, ftnlen ckspk_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dafhsf_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dafbfs_ 14 1 4 */ -/*:ref: daffna_ 14 1 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: dafgs_ 14 1 7 */ -/*:ref: dafus_ 14 5 7 4 4 7 4 */ -/*:ref: zzsizeok_ 14 6 4 4 4 4 12 4 */ -/*:ref: dafgda_ 14 4 4 4 4 7 */ - -extern int zzcln_(integer *lookat, integer *nameat, integer *namlst, integer *datlst, integer *nmpool, integer *chpool, integer *dppool); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzcorepc_(char *abcorr, doublereal *et, doublereal *lt, doublereal *etcorr, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzcorsxf_(logical *xmit, doublereal *dlt, doublereal *xform, doublereal *corxfm); -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vsclip_ 14 2 7 7 */ - -extern int zzcputim_(doublereal *tvec); -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzdafgdr_(integer *handle, integer *recno, doublereal *dprec, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlated_ 14 5 4 13 4 7 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzdafgfr_(integer *handle, char *idword, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, logical *found, ftnlen idword_len, ftnlen ifname_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlatei_ 14 5 4 13 4 4 124 */ - -extern int zzdafgsr_(integer *handle, integer *recno, integer *nd, integer *ni, doublereal *dprec, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhnfo_ 14 7 4 13 4 4 4 12 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzddhhlu_ 14 5 4 13 12 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzxlated_ 14 5 4 13 4 7 124 */ -/*:ref: zzxlatei_ 14 5 4 13 4 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzdafnfr_(integer *lun, char *idword, integer *nd, integer *ni, char *ifname, integer *fward, integer *bward, integer *free, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzdasnfr_(integer *lun, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, char *format, ftnlen idword_len, ftnlen ifname_len, ftnlen format_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzddhclu_(logical *utlck, integer *nut); - -extern int zzddhf2h_(char *fname, integer *ftabs, integer *ftamh, integer *ftarc, integer *ftbff, integer *fthan, char *ftnam, integer *ftrtm, integer *nft, integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut, logical *exists, logical *opened, integer *handle, logical *found, ftnlen fname_len, ftnlen ftnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzddhgtu_ 14 6 4 4 12 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzddhrmu_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzddhgsd_(char *class__, integer *id, char *label, ftnlen class_len, ftnlen label_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzddhgtu_(integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut, integer *uindex); -/*:ref: return_ 12 0 */ -/*:ref: getlun_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: orderi_ 14 3 4 4 4 */ -/*:ref: frelun_ 14 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzddhini_(integer *natbff, integer *supbff, integer *numsup, char *stramh, char *strarc, char *strbff, ftnlen stramh_len, ftnlen strarc_len, ftnlen strbff_len); -/*:ref: return_ 12 0 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: nextwd_ 14 6 13 13 13 124 124 124 */ - -extern int zzddhivf_(char *nsum, integer *bff, logical *found, ftnlen nsum_len); - -extern int zzddhman_(logical *lock, char *arch, char *fname, char *method, integer *handle, integer *unit, integer *intamh, integer *intarc, integer *intbff, logical *native, logical *found, logical *kill, ftnlen arch_len, ftnlen fname_len, ftnlen method_len); -extern int zzddhopn_(char *fname, char *method, char *arch, integer *handle, ftnlen fname_len, ftnlen method_len, ftnlen arch_len); -extern int zzddhcls_(integer *handle, char *arch, logical *kill, ftnlen arch_len); -extern int zzddhhlu_(integer *handle, char *arch, logical *lock, integer *unit, ftnlen arch_len); -extern int zzddhunl_(integer *handle, char *arch, ftnlen arch_len); -extern int zzddhnfo_(integer *handle, char *fname, integer *intarc, integer *intbff, integer *intamh, logical *found, ftnlen fname_len); -extern int zzddhisn_(integer *handle, logical *native, logical *found); -extern int zzddhfnh_(char *fname, integer *handle, logical *found, ftnlen fname_len); -extern int zzddhluh_(integer *unit, integer *handle, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzddhini_ 14 9 4 4 4 13 13 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzpltchk_ 14 1 12 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzddhclu_ 4 2 12 4 */ -/*:ref: zzddhf2h_ 14 20 13 4 4 4 4 4 13 4 4 4 4 12 4 4 12 12 4 12 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bsrchi_ 4 3 4 4 4 */ -/*:ref: zzddhrcm_ 14 3 4 4 4 */ -/*:ref: zzddhgtu_ 14 6 4 4 12 4 4 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: zzddhppf_ 14 3 4 4 4 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zzddhrmu_ 14 7 4 4 4 4 12 4 4 */ -/*:ref: frelun_ 14 1 4 */ - -extern int zzddhppf_(integer *unit, integer *arch, integer *bff); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: idw2at_ 14 6 13 13 13 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: zzftpchk_ 14 3 13 12 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzddhivf_ 14 4 13 4 12 124 */ - -extern int zzddhrcm_(integer *nut, integer *utcst, integer *reqcnt); -/*:ref: intmax_ 4 0 */ - -extern int zzddhrmu_(integer *uindex, integer *nft, integer *utcst, integer *uthan, logical *utlck, integer *utlun, integer *nut); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: reslun_ 14 1 4 */ - -extern int zzdynbid_(char *frname, integer *frcode, char *item, integer *idcode, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzdynfid_(char *frname, integer *frcode, char *item, integer *idcode, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: prsint_ 14 3 13 4 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzdynfr0_(integer *infram, integer *center, doublereal *et, doublereal *xform, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxmg_ 14 6 7 7 4 4 4 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkez1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkzp1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynfrm_(integer *infram, integer *center, doublereal *et, doublereal *xform, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxmg_ 14 6 7 7 4 4 4 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkez0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkzp0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: zztwovxf_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynoac_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, char *values, logical *found, ftnlen frname_len, ftnlen item_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ - -extern int zzdynoad_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, doublereal *values, logical *found, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzdynrot_(integer *infram, integer *center, doublereal *et, doublereal *rotate, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkzp0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzspkez0_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynrt0_(integer *infram, integer *center, doublereal *et, doublereal *rotate, integer *basfrm); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: bodn2c_ 14 4 13 4 12 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: zzdynfid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzdynvac_ 14 9 13 4 13 4 4 13 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzdynoad_ 14 9 13 4 13 4 4 7 12 124 124 */ -/*:ref: zzdynoac_ 14 10 13 4 13 4 4 13 12 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: zzeprc76_ 14 2 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: zzenut80_ 14 2 7 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzdynbid_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzspkzp1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzspkez1_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: cidfrm_ 14 5 4 4 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: nearpt_ 14 6 7 7 7 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzdynvad_ 14 8 13 4 13 4 4 7 124 124 */ -/*:ref: convrt_ 14 6 7 13 13 7 124 124 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: twovec_ 14 5 7 4 7 4 7 */ -/*:ref: zzdynvai_ 14 8 13 4 13 4 4 4 124 124 */ -/*:ref: polyds_ 14 5 7 4 4 7 7 */ - -extern int zzdynvac_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, char *values, ftnlen frname_len, ftnlen item_len, ftnlen values_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gcpool_ 14 8 13 4 4 4 13 12 124 124 */ - -extern int zzdynvad_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, doublereal *values, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gdpool_ 14 7 13 4 4 4 7 12 124 */ - -extern int zzdynvai_(char *frname, integer *frcode, char *item, integer *maxn, integer *n, integer *values, ftnlen frname_len, ftnlen item_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: gipool_ 14 7 13 4 4 4 4 12 124 */ - -extern int zzedterm_(char *type__, doublereal *a, doublereal *b, doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer *npts, doublereal *trmpts, ftnlen type_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: twopi_ 7 0 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ - -extern int zzekac01_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, logical *nlflgs, integer *rcptrs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekordi_ 14 5 4 12 12 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac02_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, logical *nlflgs, integer *rcptrs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: zzekordd_ 14 5 7 12 12 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac03_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, logical *nlflgs, integer *rcptrs, integer *wkindx, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekordc_ 14 6 13 12 12 4 4 124 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekac04_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, integer *entszs, logical *nlflgs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac05_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, integer *entszs, logical *nlflgs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac06_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, integer *entszs, logical *nlflgs, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekac07_(integer *handle, integer *segdsc, integer *coldsc, integer *ivals, logical *nlflgs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordi_ 14 5 4 12 12 4 4 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekac08_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dvals, logical *nlflgs, integer *wkindx); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzekpgwd_ 14 3 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordd_ 14 5 7 12 12 4 4 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekac09_(integer *handle, integer *segdsc, integer *coldsc, char *cvals, logical *nlflgs, integer *wkindx, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekordc_ 14 6 13 12 12 4 4 124 */ -/*:ref: zzekwpai_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekwpal_ 14 6 4 4 4 12 4 4 */ - -extern int zzekacps_(integer *handle, integer *segdsc, integer *type__, integer *n, integer *p, integer *base); -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekad01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzekiii1_ 14 6 4 4 4 4 4 12 */ - -extern int zzekad02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzekiid1_ 14 6 4 4 4 7 4 12 */ - -extern int zzekad03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekiic1_ 14 7 4 4 4 13 4 12 124 */ - -extern int zzekad04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, integer *ivals, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekad05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical *isnull); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekad06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, ftnlen cvals_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ - -extern int zzekaps_(integer *handle, integer *segdsc, integer *type__, logical *new__, integer *p, integer *base); -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzeksfwd_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekbs01_(integer *handle, char *tabnam, integer *ncols, char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekcix1_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekbs02_(integer *handle, char *tabnam, integer *ncols, char *cnames, integer *cdscrs, integer *segno, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgan_ 14 4 4 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrap_ 14 4 4 4 4 4 */ - -extern int zzekcchk_(char *query, integer *eqryi, char *eqryc, integer *ntab, char *tablst, char *alslst, integer *base, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen tablst_len, ftnlen alslst_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzekcdsc_(integer *handle, integer *segdsc, char *column, integer *coldsc, ftnlen column_len); -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekcix1_(integer *handle, integer *coldsc); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrit_ 14 2 4 4 */ - -extern int zzekcnam_(integer *handle, integer *coldsc, char *column, ftnlen column_len); -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekde01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekde06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: zzekdps_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzekdps_(integer *handle, integer *segdsc, integer *type__, integer *p); -/*:ref: zzekpgfr_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzektrls_ 4 3 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ - -extern integer zzekecmp_(integer *hans, integer *sgdscs, integer *cldscs, integer *rows, integer *elts); -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ - -extern int zzekencd_(char *query, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpars_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: zzeknres_ 14 9 13 4 13 12 13 4 124 124 124 */ -/*:ref: zzektres_ 14 10 13 4 13 7 12 13 4 124 124 124 */ -/*:ref: zzeksemc_ 14 9 13 4 13 12 13 4 124 124 124 */ - -extern int zzekerc1_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, integer *prvptr, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekerd1_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekeri1_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern integer zzekesiz_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: zzeksz04_ 4 4 4 4 4 4 */ -/*:ref: zzeksz05_ 4 4 4 4 4 4 */ -/*:ref: zzeksz06_ 4 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekff01_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrit_ 14 2 4 4 */ -/*:ref: zzektr1s_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzekfrx_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *pos); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: zzeklerc_ 14 9 4 4 4 13 4 12 4 4 124 */ -/*:ref: zzeklerd_ 14 8 4 4 4 7 4 12 4 4 */ -/*:ref: zzekleri_ 14 8 4 4 4 4 4 12 4 4 */ - -extern int zzekgcdp_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *datptr); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgei_(integer *handle, integer *addrss, integer *ival); -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ - -extern int zzekgfwd_(integer *handle, integer *type__, integer *p, integer *fward); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekglnk_(integer *handle, integer *type__, integer *p, integer *nlinks); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgrcp_(integer *handle, integer *recptr, integer *ptr); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekgrs_(integer *handle, integer *recptr, integer *status); -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekif01_(integer *handle, integer *segno, integer *rcptrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksdec_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekif02_(integer *handle, integer *segno); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekaps_ 14 6 4 4 4 12 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekiic1_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzeklerc_ 14 9 4 4 4 13 4 12 4 4 124 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzekiid1_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzeklerd_ 14 8 4 4 4 7 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzekiii1_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekleri_ 14 8 4 4 4 4 4 12 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern integer zzekille_(integer *handle, integer *segdsc, integer *coldsc, integer *nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekllec_ 14 7 4 4 4 13 4 4 124 */ -/*:ref: zzeklled_ 14 6 4 4 4 7 4 4 */ -/*:ref: zzekllei_ 14 6 4 4 4 4 4 4 */ - -extern integer zzekillt_(integer *handle, integer *segdsc, integer *coldsc, integer *nrows, integer *dtype, char *cval, doublereal *dval, integer *ival, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeklltc_ 14 7 4 4 4 13 4 4 124 */ -/*:ref: zzeklltd_ 14 6 4 4 4 7 4 4 */ -/*:ref: zzekllti_ 14 6 4 4 4 4 4 4 */ - -extern int zzekinqc_(char *value, integer *length, integer *lexbeg, integer *lexend, integer *eqryi, char *eqryc, integer *descr, ftnlen value_len, ftnlen eqryc_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekinqn_(doublereal *value, integer *type__, integer *lexbeg, integer *lexend, integer *eqryi, doublereal *eqryd, integer *descr); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekixdl_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekfrx_ 14 5 4 4 4 4 4 */ -/*:ref: zzektrdl_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekixlk_(integer *handle, integer *coldsc, integer *key, integer *recptr); -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekjoin_(integer *jbase1, integer *jbase2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *jbase3, integer *nrows); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjprp_ 14 23 4 4 4 4 4 4 4 4 4 4 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekjnxt_ 14 2 12 4 */ - -extern int zzekjsqz_(integer *jrsbas); -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ - -extern int zzekjsrt_(integer *njrs, integer *ubases, integer *norder, integer *otabs, integer *ocols, integer *oelts, integer *senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *ordbas); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzekvcal_ 14 3 4 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: zzekvcmp_ 12 15 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: swapi_ 14 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ - -extern int zzekjtst_(integer *segvec, integer *jbase1, integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, logical *found, integer *rowvec); -extern int zzekjprp_(integer *segvec, integer *jbase1, integer *nt1, integer *rb1, integer *nr1, integer *jbase2, integer *nt2, integer *rb2, integer *nr2, integer *njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs); -extern int zzekjnxt_(logical *found, integer *rowvec); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzekspsh_ 14 2 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjsrt_ 14 13 4 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekrcmp_ 12 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzekvmch_ 12 13 4 12 4 4 4 4 4 4 4 4 4 4 4 */ - -extern int zzekkey_(integer *handle, integer *segdsc, integer *nrows, integer *ncnstr, integer *clidxs, integer *dsclst, integer *ops, integer *dtypes, char *chrbuf, integer *cbegs, integer *cends, doublereal *dvals, integer *ivals, logical *active, integer *key, integer *keydsc, integer *begidx, integer *endidx, logical *found, ftnlen chrbuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: zzekillt_ 4 9 4 4 4 4 4 13 7 4 124 */ -/*:ref: zzekille_ 4 9 4 4 4 4 4 13 7 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ordi_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ - -extern int zzeklerc_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *recptr, logical *null, integer *prvidx, integer *prvptr, ftnlen ckey_len); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekerc1_ 14 9 4 4 4 13 4 12 4 4 124 */ - -extern int zzeklerd_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekerd1_ 14 8 4 4 4 7 4 12 4 4 */ - -extern int zzekleri_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *recptr, logical *null, integer *prvidx, integer *prvptr); -/*:ref: failed_ 12 0 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekeri1_ 14 8 4 4 4 4 4 12 4 4 */ - -extern int zzekllec_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklled_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekllei_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklltc_(integer *handle, integer *segdsc, integer *coldsc, char *ckey, integer *prvloc, integer *prvptr, ftnlen ckey_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzeklltd_(integer *handle, integer *segdsc, integer *coldsc, doublereal *dkey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekllti_(integer *handle, integer *segdsc, integer *coldsc, integer *ikey, integer *prvloc, integer *prvptr); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekixlk_ 14 4 4 4 4 4 */ -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern int zzekmloc_(integer *handle, integer *segno, integer *page, integer *base); -/*:ref: eknseg_ 4 1 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ - -extern int zzeknres_(char *query, integer *eqryi, char *eqryc, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: ekntab_ 14 1 4 */ -/*:ref: ektnam_ 14 3 4 13 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: zzekcchk_ 14 15 13 4 13 4 13 13 4 12 13 4 124 124 124 124 124 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzeknrml_(char *query, integer *ntoken, integer *lxbegs, integer *lxends, integer *tokens, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektloc_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: zzekinqn_ 14 7 7 4 4 4 4 7 4 */ -/*:ref: zzekinqc_ 14 9 13 4 4 4 4 13 4 124 124 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: lnkhl_ 4 2 4 4 */ -/*:ref: lnkprv_ 4 2 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lnkilb_ 14 3 4 4 4 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnktl_ 4 2 4 4 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzekordc_(char *cvals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder, ftnlen cvals_len); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekordd_(doublereal *dvals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekordi_(integer *ivals, logical *nullok, logical *nlflgs, integer *nvals, integer *iorder); -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzekpage_(integer *handle, integer *type__, integer *addrss, char *stat, integer *p, char *pagec, doublereal *paged, integer *pagei, integer *base, integer *value, ftnlen stat_len, ftnlen pagec_len); -extern int zzekpgin_(integer *handle); -extern int zzekpgan_(integer *handle, integer *type__, integer *p, integer *base); -extern int zzekpgal_(integer *handle, integer *type__, integer *p, integer *base); -extern int zzekpgfr_(integer *handle, integer *type__, integer *p); -extern int zzekpgrc_(integer *handle, integer *p, char *pagec, ftnlen pagec_len); -extern int zzekpgrd_(integer *handle, integer *p, doublereal *paged); -extern int zzekpgri_(integer *handle, integer *p, integer *pagei); -extern int zzekpgwc_(integer *handle, integer *p, char *pagec, ftnlen pagec_len); -extern int zzekpgwd_(integer *handle, integer *p, doublereal *paged); -extern int zzekpgwi_(integer *handle, integer *p, integer *pagei); -extern int zzekpgbs_(integer *type__, integer *p, integer *base); -extern int zzekpgpg_(integer *type__, integer *addrss, integer *p, integer *base); -extern int zzekpgst_(integer *handle, char *stat, integer *value, ftnlen stat_len); -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: fillc_ 14 5 13 4 13 124 124 */ -/*:ref: filld_ 14 3 7 4 7 */ -/*:ref: filli_ 14 3 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: dasadc_ 14 6 4 4 4 4 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasadd_ 14 3 4 4 7 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: prtdec_ 14 3 13 4 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzekpars_(char *query, integer *ntoken, integer *lxbegs, integer *lxends, integer *tokens, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *prserr, ftnlen query_len, ftnlen chrbuf_len, ftnlen eqryc_len, ftnlen prserr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekqini_ 14 6 4 4 4 13 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektloc_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: zzekinqc_ 14 9 13 4 4 4 4 13 4 124 124 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: zzeknrml_ 14 19 13 4 4 4 4 4 7 13 4 4 4 13 7 12 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ - -extern int zzekpcol_(char *qcol, integer *eqryi, char *eqryc, char *table, char *alias, integer *tabidx, char *column, integer *colidx, logical *error, char *errmsg, ftnlen qcol_len, ftnlen eqryc_len, ftnlen table_len, ftnlen alias_len, ftnlen column_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekscan_ 14 17 13 4 4 4 4 4 4 4 7 13 4 4 12 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: ekccnt_ 14 3 13 4 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ - -extern int zzekpdec_(char *decl, integer *pardsc, ftnlen decl_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lparsm_ 14 8 13 13 4 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern int zzekpgch_(integer *handle, char *access, ftnlen access_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dassih_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ - -extern int zzekqcnj_(integer *eqryi, integer *n, integer *size); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqcon_(integer *eqryi, char *eqryc, doublereal *eqryd, integer *n, integer *cnstyp, char *ltname, integer *ltidx, char *lcname, integer *lcidx, integer *opcode, char *rtname, integer *rtidx, char *rcname, integer *rcidx, integer *dtype, integer *cbeg, integer *cend, doublereal *dval, integer *ival, ftnlen eqryc_len, ftnlen ltname_len, ftnlen lcname_len, ftnlen rtname_len, ftnlen rcname_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqini_(integer *isize, integer *dsize, integer *eqryi, char *eqryc, doublereal *eqryd, ftnlen eqryc_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: appndi_ 14 2 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ - -extern int zzekqord_(integer *eqryi, char *eqryc, integer *n, char *table, integer *tabidx, char *column, integer *colidx, integer *sense, ftnlen eqryc_len, ftnlen table_len, ftnlen column_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqsel_(integer *eqryi, char *eqryc, integer *n, integer *lxbeg, integer *lxend, char *table, integer *tabidx, char *column, integer *colidx, ftnlen eqryc_len, ftnlen table_len, ftnlen column_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekqtab_(integer *eqryi, char *eqryc, integer *n, char *table, char *alias, ftnlen eqryc_len, ftnlen table_len, ftnlen alias_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzekrbck_(char *action, integer *handle, integer *segdsc, integer *coldsc, integer *recno, ftnlen action_len); - -extern logical zzekrcmp_(integer *op, integer *ncols, integer *han1, integer *sgdsc1, integer *cdlst1, integer *row1, integer *elts1, integer *han2, integer *sgdsc2, integer *cdlst2, integer *row2, integer *elts2); -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrd01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzekrd02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzekrd04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, integer *ivals, logical *isnull, logical *found); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, doublereal *dvals, logical *isnull, logical *found); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekgfwd_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekrd06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *beg, integer *end, char *cvals, logical *isnull, logical *found, ftnlen cvals_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekrd07_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekrd08_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ - -extern int zzekrd09_(integer *handle, integer *segdsc, integer *coldsc, integer *recno, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekreqi_(integer *eqryi, char *name__, integer *value, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical zzekrmch_(integer *ncnstr, logical *active, integer *handle, integer *segdsc, integer *cdscrs, integer *row, integer *elts, integer *ops, integer *vtypes, char *chrbuf, integer *cbegs, integer *cends, doublereal *dvals, integer *ivals, ftnlen chrbuf_len); -/*:ref: zzekscmp_ 12 12 4 4 4 4 4 4 4 13 7 4 12 124 */ - -extern integer zzekrp2n_(integer *handle, integer *segno, integer *recptr); -/*:ref: zzeksdsc_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrls_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrplk_(integer *handle, integer *segdsc, integer *n, integer *recptr); -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekrsc_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, integer *cvlen, char *cval, logical *isnull, logical *found, ftnlen cval_len); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd03_ 14 8 4 4 4 4 4 13 12 124 */ -/*:ref: zzekrd06_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: zzekrd09_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int zzekrsd_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, doublereal *dval, logical *isnull, logical *found); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekrd05_ 14 9 4 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrd08_ 14 6 4 4 4 4 7 12 */ - -extern int zzekrsi_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *eltidx, integer *ival, logical *isnull, logical *found); -/*:ref: zzekcnam_ 14 4 4 4 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekrd01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekrd04_ 14 9 4 4 4 4 4 4 4 12 12 */ -/*:ref: zzekrd07_ 14 6 4 4 4 4 4 12 */ - -extern int zzeksca_(integer *n, integer *beg, integer *end, integer *idata, integer *top); -extern int zzekstop_(integer *top); -extern int zzekspsh_(integer *n, integer *idata); -extern int zzekspop_(integer *n, integer *idata); -extern int zzeksdec_(integer *n); -extern int zzeksupd_(integer *beg, integer *end, integer *idata); -extern int zzeksrd_(integer *beg, integer *end, integer *idata); -extern int zzekscln_(void); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasops_ 14 1 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: daslla_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasadi_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: daswbr_ 14 1 4 */ -/*:ref: dasllc_ 14 1 4 */ - -extern int zzekscan_(char *query, integer *maxntk, integer *maxnum, integer *ntoken, integer *tokens, integer *lxbegs, integer *lxends, integer *values, doublereal *numvls, char *chrbuf, integer *chbegs, integer *chends, logical *scnerr, char *errmsg, ftnlen query_len, ftnlen chrbuf_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: lxcsid_ 14 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lxqstr_ 14 7 13 13 4 4 4 124 124 */ -/*:ref: parsqs_ 14 11 13 13 13 4 12 13 4 124 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: lx4num_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: beint_ 12 2 13 124 */ -/*:ref: lxidnt_ 14 6 4 13 4 4 4 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: frstpc_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int zzekscdp_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *datptr); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern logical zzekscmp_(integer *op, integer *handle, integer *segdsc, integer *coldsc, integer *row, integer *eltidx, integer *dtype, char *cval, doublereal *dval, integer *ival, logical *null, ftnlen cval_len); -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzekrsd_ 14 8 4 4 4 4 4 7 12 12 */ -/*:ref: zzekrsi_ 14 8 4 4 4 4 4 4 12 12 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ - -extern int zzeksdsc_(integer *handle, integer *segno, integer *segdsc); -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzeksei_(integer *handle, integer *addrss, integer *ival); -/*:ref: prtenc_ 14 3 4 13 124 */ -/*:ref: dasudc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzeksemc_(char *query, integer *eqryi, char *eqryc, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzeksfwd_(integer *handle, integer *type__, integer *p, integer *fward); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksinf_(integer *handle, integer *segno, char *tabnam, integer *segdsc, char *cnames, integer *cdscrs, ftnlen tabnam_len, ftnlen cnames_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: eknseg_ 4 1 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekmloc_ 14 4 4 4 4 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdc_ 14 7 4 4 4 4 4 13 124 */ - -extern int zzekslnk_(integer *handle, integer *type__, integer *p, integer *nlinks); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzeksei_ 14 3 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksrcp_(integer *handle, integer *recptr, integer *recno); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzeksrs_(integer *handle, integer *recptr, integer *status); -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern integer zzekstyp_(integer *ncols, integer *cdscrs); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzeksz04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern integer zzeksz05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasrdd_ 14 4 4 4 4 7 */ - -extern integer zzeksz06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekgei_ 14 3 4 4 4 */ - -extern int zzektcnv_(char *timstr, doublereal *et, logical *error, char *errmsg, ftnlen timstr_len, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: scn2id_ 14 4 13 4 12 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scpars_ 14 7 4 13 12 13 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: sct2e_ 14 3 4 7 7 */ -/*:ref: tpartv_ 14 15 13 7 4 13 13 12 12 12 13 13 124 124 124 124 124 */ -/*:ref: str2et_ 14 3 13 7 124 */ - -extern int zzektloc_(integer *tokid, integer *kwcode, integer *ntoken, integer *tokens, integer *values, integer *loc, logical *found); - -extern int zzektr13_(integer *handle, integer *tree); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektr1s_(integer *handle, integer *tree, integer *size, integer *values); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ - -extern int zzektr23_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx, logical *overfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektr31_(integer *handle, integer *tree); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektr32_(integer *handle, integer *tree, integer *left, integer *middle, integer *right, integer *parent, integer *lpkidx, logical *undrfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektrap_(integer *handle, integer *tree, integer *value, integer *key); -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: zzektrin_ 14 4 4 4 4 4 */ - -extern int zzektrbn_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzektrrk_ 14 7 4 4 4 4 4 4 4 */ - -extern integer zzektrbs_(integer *node); -/*:ref: zzekpgbs_ 14 3 4 4 4 */ - -extern int zzektrdl_(integer *handle, integer *tree, integer *key); -/*:ref: zzektrud_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrsb_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrrk_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: zzektrbn_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzektrki_ 14 5 4 4 4 4 4 */ -/*:ref: zzektr32_ 14 8 4 4 4 4 4 4 4 12 */ -/*:ref: zzektr31_ 14 2 4 4 */ - -extern int zzektrdp_(integer *handle, integer *tree, integer *key, integer *ptr); -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ - -extern int zzektres_(char *query, integer *eqryi, char *eqryc, doublereal *eqryd, logical *error, char *errmsg, integer *errptr, ftnlen query_len, ftnlen eqryc_len, ftnlen errmsg_len); -/*:ref: zzekreqi_ 14 4 4 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekqtab_ 14 8 4 13 4 13 13 124 124 124 */ -/*:ref: ekcii_ 14 6 13 4 13 4 124 124 */ -/*:ref: zzektcnv_ 14 6 13 7 12 13 124 124 */ -/*:ref: zzekinqn_ 14 7 7 4 4 4 4 7 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekweqi_ 14 4 13 4 4 124 */ - -extern int zzektrfr_(integer *handle, integer *tree); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgfr_ 14 3 4 4 4 */ - -extern int zzektrin_(integer *handle, integer *tree, integer *key, integer *value); -/*:ref: zzektrui_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: zzektrbn_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzektrki_ 14 5 4 4 4 4 4 */ -/*:ref: zzektr23_ 14 7 4 4 4 4 4 4 12 */ -/*:ref: zzektr13_ 14 2 4 4 */ - -extern int zzektrit_(integer *handle, integer *tree); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgal_ 14 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzektrki_(integer *handle, integer *tree, integer *nodkey, integer *n, integer *key); -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: zzektrnk_ 4 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrlk_(integer *handle, integer *tree, integer *key, integer *idx, integer *node, integer *noffst, integer *level, integer *value); -/*:ref: dasham_ 14 3 4 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern integer zzektrls_(integer *handle, integer *tree, integer *ival); -/*:ref: zzektrsz_ 4 2 4 4 */ -/*:ref: zzektrdp_ 14 4 4 4 4 4 */ - -extern integer zzektrnk_(integer *handle, integer *tree, integer *node); -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrpi_(integer *handle, integer *tree, integer *key, integer *parent, integer *pkey, integer *poffst, integer *lpidx, integer *lpkey, integer *lsib, integer *rpidx, integer *rpkey, integer *rsib); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern int zzektrrk_(integer *handle, integer *tree, integer *left, integer *right, integer *parent, integer *pkidx, integer *nrot); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ - -extern int zzektrsb_(integer *handle, integer *tree, integer *key, integer *lsib, integer *lkey, integer *rsib, integer *rkey); -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern integer zzektrsz_(integer *handle, integer *tree); -/*:ref: zzektrbs_ 4 1 4 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ - -extern int zzektrud_(integer *handle, integer *tree, integer *key, integer *trgkey, logical *undrfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzektrui_(integer *handle, integer *tree, integer *key, integer *value, logical *overfl); -/*:ref: zzekpgri_ 14 3 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: zzektrlk_ 14 8 4 4 4 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzektrpi_ 14 12 4 4 4 4 4 4 4 4 4 4 4 4 */ - -extern int zzekue01_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *ival, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekiii1_ 14 6 4 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: zzekad01_ 14 6 4 4 4 4 4 12 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekue02_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, doublereal *dval, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekpgch_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dasrdi_ 14 4 4 4 4 4 */ -/*:ref: zzekixdl_ 14 4 4 4 4 4 */ -/*:ref: zzekiid1_ 14 6 4 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzekpgpg_ 14 4 4 4 4 4 */ -/*:ref: zzekglnk_ 14 4 4 4 4 4 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: dasudi_ 14 4 4 4 4 4 */ -/*:ref: dasudd_ 14 4 4 4 4 7 */ -/*:ref: zzekad02_ 14 6 4 4 4 4 7 12 */ -/*:ref: zzekrp2n_ 4 3 4 4 4 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: errfnm_ 14 3 13 4 124 */ - -extern int zzekue03_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, char *cval, logical *isnull, ftnlen cval_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde03_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad03_ 14 7 4 4 4 4 13 12 124 */ - -extern int zzekue04_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, integer *ivals, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde04_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad04_ 14 7 4 4 4 4 4 4 12 */ - -extern int zzekue05_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, doublereal *dvals, logical *isnull); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde05_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad05_ 14 7 4 4 4 4 4 7 12 */ - -extern int zzekue06_(integer *handle, integer *segdsc, integer *coldsc, integer *recptr, integer *nvals, char *cvals, logical *isnull, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekde06_ 14 4 4 4 4 4 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekad06_ 14 8 4 4 4 4 4 13 12 124 */ - -extern int zzekvadr_(integer *njrs, integer *bases, integer *rwvidx, integer *rwvbas, integer *sgvbas); -extern int zzekvset_(integer *njrs, integer *bases); -extern int zzekvcal_(integer *rwvidx, integer *rwvbas, integer *sgvbas); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzekstop_ 14 1 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: lstlei_ 4 3 4 4 4 */ - -extern logical zzekvcmp_(integer *op, integer *ncols, integer *tabs, integer *cols, integer *elts, integer *senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool, integer *dtdscs, integer *sgvec1, integer *rwvec1, integer *sgvec2, integer *rwvec2); -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern logical zzekvmch_(integer *ncnstr, logical *active, integer *lhans, integer *lsdscs, integer *lcdscs, integer *lrows, integer *lelts, integer *ops, integer *rhans, integer *rsdscs, integer *rcdscs, integer *rrows, integer *relts); -/*:ref: movei_ 14 3 4 4 4 */ -/*:ref: zzekecmp_ 4 5 4 4 4 4 4 */ -/*:ref: zzekrsc_ 14 10 4 4 4 4 4 4 13 12 12 124 */ -/*:ref: dashlu_ 14 2 4 4 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errfnm_ 14 3 13 4 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: matchi_ 12 8 13 13 13 13 124 124 124 124 */ - -extern int zzekweed_(integer *njrs, integer *bases, integer *nrows); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekvset_ 14 2 4 4 */ -/*:ref: zzeksrd_ 14 3 4 4 4 */ -/*:ref: sameai_ 12 3 4 4 4 */ -/*:ref: zzeksupd_ 14 3 4 4 4 */ -/*:ref: zzekjsqz_ 14 1 4 */ - -extern int zzekweqi_(char *name__, integer *value, integer *eqryi, ftnlen name_len); -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekwpac_(integer *handle, integer *segdsc, integer *nvals, integer *l, char *cvals, integer *p, integer *base, ftnlen cvals_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ - -extern int zzekwpai_(integer *handle, integer *segdsc, integer *nvals, integer *ivals, integer *p, integer *base); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: zzekpgwi_ 14 3 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzekwpal_(integer *handle, integer *segdsc, integer *nvals, logical *lvals, integer *p, integer *base); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzekacps_ 14 6 4 4 4 4 4 4 */ -/*:ref: zzekpgwc_ 14 4 4 4 13 124 */ -/*:ref: zzekslnk_ 14 4 4 4 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzelvupy_(doublereal *ellips, doublereal *vertex, doublereal *axis, integer *n, doublereal *bounds, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: repmot_ 14 9 13 13 4 13 13 124 124 124 124 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: nvp2pl_ 14 3 7 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: zzwind_ 4 4 7 4 7 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: inelpl_ 14 5 7 7 4 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzenut80_(doublereal *et, doublereal *nutxf); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzwahr_ 14 2 7 7 */ -/*:ref: zzmobliq_ 14 3 7 7 7 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzeprc76_(doublereal *et, doublereal *precxf); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ -/*:ref: eul2xf_ 14 5 7 4 4 4 7 */ - -extern int zzeprcss_(doublereal *et, doublereal *precm); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ -/*:ref: eul2m_ 14 7 7 7 7 4 4 4 7 */ - -extern int zzfdat_(integer *ncount, char *name__, integer *idcode, integer *center, integer *type__, integer *typid, integer *norder, integer *corder, integer *centrd, ftnlen name_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnam_ 14 3 4 13 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: orderi_ 14 3 4 4 4 */ - -extern int zzfovaxi_(char *inst, integer *n, doublereal *bounds, doublereal *axis, ftnlen inst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: zzhullax_ 14 5 13 4 7 7 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vhatip_ 14 1 7 */ - -extern int zzfrmch0_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzfrmgt0_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int zzfrmch1_(integer *frame1, integer *frame2, doublereal *et, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzfrmgt1_ 14 5 4 7 7 4 12 */ -/*:ref: zzmsxf_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: invstm_ 14 2 7 7 */ - -extern int zzfrmgt0_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynfr0_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ - -extern int zzfrmgt1_(integer *infrm, doublereal *et, doublereal *xform, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: tisbod_ 14 5 13 4 7 7 124 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: ckfxfm_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: failed_ 12 0 */ - -extern int zzftpchk_(char *string, logical *ftperr, ftnlen string_len); -/*:ref: zzftpstr_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: zzrbrkst_ 14 10 13 13 13 13 4 12 124 124 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ - -extern int zzftpstr_(char *tstcom, char *lend, char *rend, char *delim, ftnlen tstcom_len, ftnlen lend_len, ftnlen rend_len, ftnlen delim_len); -/*:ref: suffix_ 14 5 13 4 13 124 124 */ - -extern int zzgapool_(char *varnam, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agtset, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtset_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: scardc_ 14 3 4 13 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: cardc_ 4 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: validc_ 14 4 4 4 13 124 */ -/*:ref: sizec_ 4 2 13 124 */ - -extern int zzgetbff_(integer *bffid); - -extern int zzgetelm_(integer *frstyr, char *lines, doublereal *epoch, doublereal *elems, logical *ok, char *error, ftnlen lines_len, ftnlen error_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: rpd_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: repmd_ 14 8 13 13 7 4 13 124 124 124 */ -/*:ref: ttrans_ 14 5 13 13 7 124 124 */ - -extern int zzgfcoq_(char *vecdef, char *method, integer *trgid, doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, doublereal *dvec, char *crdsys, integer *ctrid, doublereal *re, doublereal *f, char *crdnam, doublereal *value, logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: subpnt_ 14 14 13 13 7 13 13 13 7 7 7 124 124 124 124 124 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ - -extern int zzgfcost_(char *vecdef, char *method, integer *trgid, doublereal *et, char *ref, char *abcorr, integer *obsid, char *dref, integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, logical *found, ftnlen vecdef_len, ftnlen method_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzgfssob_ 14 11 13 4 7 13 13 4 7 7 124 124 124 */ -/*:ref: zzgfssin_ 14 16 13 4 7 13 13 4 13 4 7 7 7 12 124 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgfcou_(char *vecdef, char *method, char *target, doublereal *et, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, logical *decres, logical *lssthn, doublereal *crdval, logical *crdfnd, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -extern int zzgfcoin_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, doublereal *refval, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len); -extern int zzgfcour_(doublereal *refval); -extern int zzgfcog_(doublereal *et, doublereal *crdval); -extern int zzgfcolt_(doublereal *et, logical *lssthn); -extern int zzgfcodc_(doublereal *et, logical *decres); -extern int zzgfcoex_(doublereal *et, logical *crdfnd); -extern int zzgfcocg_(doublereal *et, doublereal *crdval); -extern int zzgfcosg_(doublereal *et, doublereal *crdval); -extern int zzgfcocl_(doublereal *et, logical *lssthn); -extern int zzgfcosl_(doublereal *et, logical *lssthn); -extern int zzgfcocd_(doublereal *et, logical *decres); -extern int zzgfcosd_(doublereal *et, logical *decres); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzgfcoq_ 14 23 13 13 4 7 13 13 4 13 7 13 4 7 7 13 7 12 124 124 124 124 124 124 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: zzgfcost_ 14 18 13 13 4 7 13 13 4 13 4 7 7 7 12 124 124 124 124 124 */ -/*:ref: zzgfcprx_ 14 7 7 13 7 7 4 4 124 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: recrad_ 14 4 7 7 7 7 */ -/*:ref: recsph_ 14 4 7 7 7 7 */ -/*:ref: reccyl_ 14 4 7 7 7 7 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ - -extern int zzgfcprx_(doublereal *state, char *corsys, doublereal *re, doublereal *f, integer *sense, integer *cdsign, ftnlen corsys_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: recgeo_ 14 6 7 7 7 7 7 7 */ -/*:ref: latrec_ 14 4 7 7 7 7 */ -/*:ref: vpack_ 14 4 7 7 7 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: zzrtnmat_ 14 2 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzgfcslv_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, logical *bail, L_fp udbail, integer *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal *result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: zzgfcoin_ 14 20 13 13 13 13 13 13 13 7 13 13 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wncond_ 14 3 7 7 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: zzgflong_ 14 37 13 13 13 13 13 13 13 7 13 13 13 7 7 7 200 200 12 214 200 214 12 212 4 4 7 7 7 124 124 124 124 124 124 124 124 124 124 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 200 200 13 7 7 7 7 4 4 7 12 214 200 214 13 13 12 212 7 124 124 124 */ - -extern int zzgfdiq_(integer *targid, doublereal *et, char *abcorr, integer *obsid, doublereal *dist, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vnorm_ 7 1 7 */ - -extern int zzgfdiu_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *et, logical *decres, logical *lssthn, doublereal *dist, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfdiin_(char *target, char *abcorr, char *obsrvr, doublereal *refval, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfdiur_(doublereal *refval); -extern int zzgfdidc_(doublereal *et, logical *decres); -extern int zzgfdigq_(doublereal *et, doublereal *dist); -extern int zzgfdilt_(doublereal *et, logical *lssthn); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzgfdiq_ 14 6 4 7 13 4 7 124 */ - -extern int zzgfdsps_(integer *nlead, char *string, char *fmt, integer *ntrail, ftnlen string_len, ftnlen fmt_len); -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgffvu_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, doublereal *time, logical *vistat, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgffvin_(char *inst, char *tshape, doublereal *raydir, char *target, char *tframe, char *abcorr, char *obsrvr, ftnlen inst_len, ftnlen tshape_len, ftnlen target_len, ftnlen tframe_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgffvst_(doublereal *time, logical *vistat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: getfov_ 14 9 4 4 13 13 7 4 7 124 124 */ -/*:ref: zzfovaxi_ 14 5 13 4 7 7 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: dpr_ 7 0 */ -/*:ref: nvc2pl_ 14 3 7 7 7 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ -/*:ref: inrypl_ 14 5 7 7 7 4 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: frame_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: edlimb_ 14 5 7 7 7 7 7 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: zzelvupy_ 14 6 7 7 7 4 7 12 */ -/*:ref: zzocced_ 4 5 7 7 7 7 7 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzwind2d_ 4 3 4 7 7 */ - -extern int zzgflong_(char *vecdef, char *method, char *target, char *ref, char *abcorr, char *obsrvr, char *dref, doublereal *dvec, char *crdsys, char *crdnam, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, U_fp udstep, U_fp udrefn, logical *rpt, U_fp udrepi, U_fp udrepu, U_fp udrepf, logical *bail, L_fp udbail, integer *mw, integer *nw, doublereal *work, doublereal *cnfine, doublereal *result, ftnlen vecdef_len, ftnlen method_len, ftnlen target_len, ftnlen ref_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen dref_len, ftnlen crdsys_len, ftnlen crdnam_len, ftnlen relate_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: zzgfcoin_ 14 20 13 13 13 13 13 13 13 7 13 13 7 124 124 124 124 124 124 124 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: recpgr_ 14 8 13 7 7 7 7 7 7 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: zzgfrel_ 14 26 200 200 200 200 214 200 13 7 7 7 7 4 4 7 12 200 200 200 13 13 12 212 7 124 124 124 */ -/*:ref: zzgfcosg_ 14 2 7 7 */ -/*:ref: zzgfcocg_ 14 2 7 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: smsgnd_ 12 2 7 7 */ -/*:ref: wninsd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzgfcog_ 14 2 7 7 */ -/*:ref: wnunid_ 14 3 7 7 7 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: lnknxt_ 4 2 4 4 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ - -extern int zzgfocu_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *obsrvr, char *abcorr, doublereal *time, logical *ocstat, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len); -extern int zzgfocin_(char *occtyp, char *front, char *fshape, char *fframe, char *back, char *bshape, char *bframe, char *obsrvr, char *abcorr, ftnlen occtyp_len, ftnlen front_len, ftnlen fshape_len, ftnlen fframe_len, ftnlen back_len, ftnlen bshape_len, ftnlen bframe_len, ftnlen obsrvr_len, ftnlen abcorr_len); -extern int zzgfocst_(doublereal *time, logical *ocstat); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: minad_ 14 4 7 4 7 4 */ -/*:ref: maxad_ 14 4 7 4 7 4 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: zzcorepc_ 14 5 13 7 7 7 124 */ -/*:ref: pxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: zzocced_ 4 5 7 7 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ - -extern int zzgfref_(doublereal *refval); -/*:ref: zzholdd_ 14 3 13 7 124 */ - -extern int zzgfrel_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen rptsuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolv_ 14 13 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wnextd_ 14 3 13 7 124 */ -/*:ref: zzgfwsts_ 14 5 7 7 13 7 124 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzgfrelx_(U_fp udstep, U_fp udrefn, U_fp udqdec, U_fp udcond, S_fp udfunc, S_fp udqref, char *relate, doublereal *refval, doublereal *tol, doublereal *adjust, doublereal *cnfine, integer *mw, integer *nw, doublereal *work, logical *rpt, S_fp udrepi, U_fp udrepu, S_fp udrepf, char *rptpre, char *rptsuf, logical *bail, L_fp udbail, doublereal *result, ftnlen relate_len, ftnlen rptpre_len, ftnlen rptsuf_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: copyd_ 14 2 7 7 */ -/*:ref: wnexpd_ 14 3 7 7 7 */ -/*:ref: wncard_ 4 1 7 */ -/*:ref: wnfetd_ 14 4 7 4 7 7 */ -/*:ref: zzgfsolvx_ 14 14 214 200 200 200 12 212 12 7 7 7 7 12 200 7 */ -/*:ref: wnextd_ 14 3 13 7 124 */ -/*:ref: zzgfwsts_ 14 5 7 7 13 7 124 */ -/*:ref: wnintd_ 14 3 7 7 7 */ -/*:ref: wndifd_ 14 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ -/*:ref: swapi_ 14 2 4 4 */ - -extern int zzgfrpwk_(integer *unit, doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, doublereal *incr, ftnlen begin_len, ftnlen end_len); -extern int zzgftswk_(doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len); -extern int zzgfwkin_(doublereal *incr); -extern int zzgfwkad_(doublereal *freq, integer *tcheck, char *begin, char *end, ftnlen begin_len, ftnlen end_len); -extern int zzgfwkun_(integer *unit); -extern int zzgfwkmo_(integer *unit, doublereal *total, doublereal *freq, integer *tcheck, char *begin, char *end, doublereal *incr, ftnlen begin_len, ftnlen end_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: stdio_ 14 3 13 4 124 */ -/*:ref: zzcputim_ 14 1 7 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: zzgfdsps_ 14 6 4 13 13 4 124 124 */ -/*:ref: writln_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: dpfmt_ 14 5 7 13 13 124 124 */ - -extern int zzgfrrq_(doublereal *et, integer *targ, integer *obs, char *abcorr, doublereal *value, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvnorm_ 7 1 7 */ - -extern int zzgfrru_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *et, doublereal *dt, logical *decres, logical *lssthn, doublereal *rvl, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfrrin_(char *target, char *abcorr, char *obsrvr, doublereal *refval, doublereal *dt, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len); -extern int zzgfrrur_(doublereal *refval); -extern int zzgfrrdc_(doublereal *et, logical *decres); -extern int zzgfrrgq_(doublereal *et, doublereal *rvl); -extern int zzgfrrlt_(doublereal *et, logical *lssthn); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: zzgfrrq_ 14 6 7 4 4 13 7 124 */ - -extern int zzgfsolv_(S_fp udcond, S_fp udstep, S_fp udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ - -extern int zzgfsolvx_(U_fp udfunc, S_fp udcond, S_fp udstep, S_fp udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step, doublereal *start, doublereal *finish, doublereal *tol, logical *rpt, S_fp udrepu, doublereal *result); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: touchd_ 7 1 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: brcktd_ 7 3 7 7 7 */ -/*:ref: zzwninsd_ 14 5 7 7 13 7 124 */ - -extern int zzgfspq_(doublereal *et, integer *targ1, integer *targ2, doublereal *r1, doublereal *r2, integer *obs, char *abcorr, char *ref, doublereal *value, ftnlen abcorr_len, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: spkezp_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsep_ 7 2 7 7 */ - -extern int zzgfspu_(char *of, char *from, char *shape, char *frame, doublereal *refval, doublereal *et, char *abcorr, logical *decres, logical *lssthn, doublereal *sep, ftnlen of_len, ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len); -extern int zzgfspin_(char *of, char *from, char *shape, char *frame, doublereal *refval, char *abcorr, ftnlen of_len, ftnlen from_len, ftnlen shape_len, ftnlen frame_len, ftnlen abcorr_len); -extern int zzgfspur_(doublereal *refval); -extern int zzgfspdc_(doublereal *et, logical *decres); -extern int zzgfgsep_(doublereal *et, doublereal *sep); -extern int zzgfsplt_(doublereal *et, logical *lssthn); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: return_ 12 0 */ -/*:ref: bods2c_ 14 4 13 4 12 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: zzvalcor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzgftreb_ 14 2 4 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: spkez_ 14 9 4 7 13 13 4 7 7 124 124 */ -/*:ref: dvsep_ 7 2 7 7 */ -/*:ref: dhfa_ 7 2 7 7 */ -/*:ref: zzgfspq_ 14 11 7 4 4 7 7 4 13 13 7 124 124 */ - -extern int zzgfssin_(char *method, integer *trgid, doublereal *et, char *fixref, char *abcorr, integer *obsid, char *dref, integer *dctr, doublereal *dvec, doublereal *radii, doublereal *state, logical *found, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len, ftnlen dref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: sxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: surfpv_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: spkacs_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzcorsxf_ 14 4 12 7 7 7 */ -/*:ref: sincpt_ 14 18 13 13 7 13 13 13 13 7 7 7 7 12 124 124 124 124 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzgfssob_(char *method, integer *trgid, doublereal *et, char *fixref, char *abcorr, integer *obsid, doublereal *radii, doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodc2s_ 14 3 4 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: failed_ 12 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: spkgeo_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vminug_ 14 3 7 4 7 */ -/*:ref: dnearp_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: surfpv_ 14 7 7 7 7 7 7 7 12 */ -/*:ref: subpnt_ 14 14 13 13 7 13 13 13 7 7 7 124 124 124 124 124 */ -/*:ref: spkssb_ 14 5 4 7 13 7 124 */ -/*:ref: sxform_ 14 6 13 13 7 7 124 124 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: vscl_ 14 3 7 7 7 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: zzcorsxf_ 14 4 12 7 7 7 */ -/*:ref: invstm_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzgftreb_(integer *body, doublereal *axes); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: bodvcd_ 14 6 4 13 4 4 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzgfudlt_(S_fp udfunc, doublereal *et, logical *isless); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: zzholdd_ 14 3 13 7 124 */ - -extern int zzgfwsts_(doublereal *wndw1, doublereal *wndw2, char *inclsn, doublereal *wndw3, ftnlen inclsn_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: ssized_ 14 2 4 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: scardd_ 14 2 4 7 */ - -extern int zzgpnm_(integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *found, integer *lookat, integer *nameat, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzholdd_(char *op, doublereal *value, ftnlen op_len); -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzhullax_(char *inst, integer *n, doublereal *bounds, doublereal *axis, ftnlen inst_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vcrss_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: pi_ 7 0 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vhatip_ 14 1 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: reclat_ 14 4 7 7 7 7 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: vrotv_ 14 4 7 7 7 7 */ - -extern int zzidmap_(integer *bltcod, char *bltnam, ftnlen bltnam_len); - -extern int zzinssub_(char *in, char *sub, integer *loc, char *out, ftnlen in_len, ftnlen sub_len, ftnlen out_len); - -extern int zzldker_(char *file, char *nofile, char *filtyp, integer *handle, ftnlen file_len, ftnlen nofile_len, ftnlen filtyp_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: exists_ 12 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: getfat_ 14 6 13 13 13 124 124 124 */ -/*:ref: spklef_ 14 3 13 4 124 */ -/*:ref: cklpf_ 14 3 13 4 124 */ -/*:ref: pcklof_ 14 3 13 4 124 */ -/*:ref: tkvrsn_ 14 4 13 13 124 124 */ -/*:ref: eklef_ 14 3 13 4 124 */ -/*:ref: ldpool_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzbodkik_ 14 0 */ - -extern int zzmkpc_(char *pictur, integer *b, integer *e, char *mark, char *pattrn, ftnlen pictur_len, ftnlen mark_len, ftnlen pattrn_len); -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ - -extern int zzmobliq_(doublereal *et, doublereal *mob, doublereal *dmob); -/*:ref: jyear_ 7 0 */ -/*:ref: rpd_ 7 0 */ - -extern int zzmsxf_(doublereal *matrix, integer *n, doublereal *output); - -extern int zznofcon_(doublereal *et, integer *frame1, integer *endp1, integer *frame2, integer *endp2, char *errmsg, ftnlen errmsg_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: frmnam_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: repmf_ 14 10 13 13 7 4 13 13 124 124 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ckmeta_ 14 4 4 13 4 124 */ -/*:ref: zzsclk_ 12 2 4 4 */ - -extern int zznrddp_(doublereal *ao, doublereal *elems, doublereal *em, doublereal *omgasm, doublereal *omgdot, doublereal *t, doublereal *xinc, doublereal *xll, doublereal *xlldot, doublereal *xn, doublereal *xnodes, doublereal *xnodot, doublereal *xnodp); -extern int zzdpinit_(doublereal *ao, doublereal *xlldot, doublereal *omgdot, doublereal *xnodot, doublereal *xnodp, doublereal *elems); -extern int zzdpsec_(doublereal *xll, doublereal *omgasm, doublereal *xnodes, doublereal *em, doublereal *xinc, doublereal *xn, doublereal *t, doublereal *elems, doublereal *omgdot); -extern int zzdpper_(doublereal *t, doublereal *em, doublereal *xinc, doublereal *omgasm, doublereal *xnodes, doublereal *xll); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: j2000_ 7 0 */ -/*:ref: spd_ 7 0 */ -/*:ref: j1950_ 7 0 */ -/*:ref: zzsecprt_ 14 12 4 7 7 7 7 7 7 7 7 7 7 7 */ - -extern int zznwpool_(char *varnam, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agtwrk, char *notify, char *agents, ftnlen varnam_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtwrk_len, ftnlen notify_len, ftnlen agents_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzgapool_ 14 10 13 13 4 4 13 13 124 124 124 124 */ -/*:ref: unionc_ 14 6 13 13 13 124 124 124 */ -/*:ref: copyc_ 14 4 13 13 124 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern integer zzocced_(doublereal *viewpt, doublereal *centr1, doublereal *semax1, doublereal *centr2, doublereal *semax2); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: unorm_ 14 3 7 7 7 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: isrot_ 12 3 7 7 7 */ -/*:ref: det_ 7 1 7 */ -/*:ref: mtxv_ 14 3 7 7 7 */ -/*:ref: dasine_ 7 2 7 7 */ -/*:ref: failed_ 12 0 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: edlimb_ 14 5 7 7 7 7 7 */ -/*:ref: el2cgv_ 14 4 7 7 7 7 */ -/*:ref: psv2pl_ 14 4 7 7 7 7 */ -/*:ref: vprjp_ 14 3 7 7 7 */ -/*:ref: vdist_ 7 2 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: halfpi_ 7 0 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: mxm_ 14 3 7 7 7 */ -/*:ref: saelgv_ 14 4 7 7 7 7 */ -/*:ref: cgv2el_ 14 4 7 7 7 7 */ -/*:ref: zzasryel_ 14 7 13 7 7 7 7 7 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: pi_ 7 0 */ - -extern integer zzphsh_(char *word, integer *m, integer *m2, ftnlen word_len); -extern integer zzshsh_(integer *m); -extern integer zzhash_(char *word, ftnlen word_len); -extern integer zzhash2_(char *word, integer *m2, ftnlen word_len); -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzpini_(logical *first, integer *maxvar, integer *maxval, integer *maxlin, char *begdat, char *begtxt, integer *nmpool, integer *dppool, integer *chpool, integer *namlst, integer *datlst, integer *maxagt, integer *mxnote, char *wtvars, integer *wtptrs, integer *wtpool, char *wtagnt, char *agents, char *active, char *notify, ftnlen begdat_len, ftnlen begtxt_len, ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agents_len, ftnlen active_len, ftnlen notify_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzshsh_ 4 1 4 */ -/*:ref: touchi_ 4 1 4 */ -/*:ref: lnkini_ 14 2 4 4 */ -/*:ref: ssizec_ 14 3 4 13 124 */ -/*:ref: cleari_ 14 2 4 4 */ -/*:ref: clearc_ 14 3 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzplatfm_(char *key, char *value, ftnlen key_len, ftnlen value_len); -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: ljust_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ - -extern int zzpltchk_(logical *ok); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: zzgetbff_ 14 1 4 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzprscor_(char *abcorr, logical *attblk, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ -/*:ref: reordl_ 14 3 4 4 12 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: bsrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzrbrkst_(char *string, char *lftend, char *rgtend, char *substr, integer *length, logical *bkpres, ftnlen string_len, ftnlen lftend_len, ftnlen rgtend_len, ftnlen substr_len); -/*:ref: posr_ 4 5 13 13 4 124 124 */ - -extern int zzrefch0_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzrotgt0_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int zzrefch1_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ident_ 14 1 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzrotgt1_ 14 5 4 7 7 4 12 */ -/*:ref: zzrxr_ 14 3 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: zznofcon_ 14 7 7 4 4 4 4 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: xpose_ 14 2 7 7 */ - -extern int zzrepsub_(char *in, integer *left, integer *right, char *string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len); -/*:ref: sumai_ 4 2 4 4 */ - -extern logical zzrept_(char *sub, char *replac, logical *l2r, ftnlen sub_len, ftnlen replac_len); -/*:ref: zzsubt_ 12 5 13 13 12 124 124 */ -/*:ref: zzremt_ 12 2 13 124 */ - -extern int zzrotgt0_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: zzdynrt0_ 14 5 4 4 7 7 4 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzrotgt1_(integer *infrm, doublereal *et, doublereal *rotate, integer *outfrm, logical *found); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: tipbod_ 14 5 13 4 7 7 124 */ -/*:ref: xpose_ 14 2 7 7 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: ckfrot_ 14 5 4 7 7 4 12 */ -/*:ref: tkfram_ 14 4 4 7 4 12 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ - -extern int zzrtnmat_(doublereal *v, doublereal *m); -/*:ref: return_ 12 0 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: vhat_ 14 2 7 7 */ - -extern int zzrvar_(integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *eof, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: rdkdat_ 14 3 13 12 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: rdklin_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int zzrvbf_(char *buffer, integer *bsize, integer *linnum, integer *namlst, integer *nmpool, char *names, integer *datlst, integer *dppool, doublereal *dpvals, integer *chpool, char *chvals, char *varnam, logical *eof, ftnlen buffer_len, ftnlen names_len, ftnlen chvals_len, ftnlen varnam_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: lastpc_ 4 2 13 124 */ -/*:ref: zzhash_ 4 2 13 124 */ -/*:ref: lnknfn_ 4 1 4 */ -/*:ref: lnkan_ 14 2 4 4 */ -/*:ref: lnkila_ 14 3 4 4 4 */ -/*:ref: lnkfsl_ 14 3 4 4 4 */ -/*:ref: zzcln_ 14 7 4 4 4 4 4 4 4 */ -/*:ref: tparse_ 14 5 13 7 13 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ - -extern int zzrxr_(doublereal *matrix, integer *n, doublereal *output); -/*:ref: ident_ 14 1 7 */ - -extern logical zzsclk_(integer *ckid, integer *sclkid); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: ssizei_ 14 2 4 4 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: elemi_ 12 2 4 4 */ -/*:ref: cvpool_ 14 3 13 12 124 */ -/*:ref: cardi_ 4 1 4 */ -/*:ref: sizei_ 4 1 4 */ -/*:ref: insrti_ 14 2 4 4 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: swpool_ 14 5 13 4 13 124 124 */ -/*:ref: dtpool_ 14 6 13 12 4 13 124 124 */ -/*:ref: removi_ 14 2 4 4 */ - -extern int zzsecprt_(integer *isynfl, doublereal *dg, doublereal *del, doublereal *xni, doublereal *omegao, doublereal *atime, doublereal *omgdot, doublereal *xli, doublereal *xfact, doublereal *xldot, doublereal *xndot, doublereal *xnddt); - -extern int zzsizeok_(integer *size, integer *psize, integer *dsize, integer *offset, logical *ok, integer *n); -/*:ref: rmaini_ 14 4 4 4 4 4 */ - -extern int zzspkac0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzspkas0_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int zzspkac1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: zzspkas1_ 14 11 4 7 13 13 7 7 7 7 7 124 124 */ - -extern int zzspkap0_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkap1_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkas0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspklt0_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int zzspkas1_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspklt1_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzstelab_ 14 6 12 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ - -extern int zzspkez0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkac0_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzspklt0_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int zzspkez1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *starg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: zzspkac1_ 14 10 4 7 13 13 4 7 7 7 124 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzspklt1_ 14 10 4 7 13 13 7 7 7 7 124 124 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: vsclip_ 14 2 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ - -extern int zzspkgo0_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzfrmch0_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgo1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzfrmch1_ 14 4 4 4 7 7 */ -/*:ref: mxvg_ 14 5 7 7 4 4 7 */ -/*:ref: vaddg_ 14 4 7 7 4 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgp0_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspkgp1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: frstnp_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: spksfs_ 14 7 4 7 4 7 13 12 124 */ -/*:ref: spkpvn_ 14 6 4 7 7 4 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: irfrot_ 14 3 4 4 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: isrchi_ 4 3 4 4 4 */ -/*:ref: bodc2n_ 14 4 4 13 12 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: intstr_ 14 3 4 13 124 */ -/*:ref: etcal_ 14 3 7 13 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ - -extern int zzspklt0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzspklt1_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ - -extern int zzspkpa0_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgp0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspkpa1_(integer *targ, doublereal *et, char *ref, doublereal *sobs, char *abcorr, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: cmprss_ 14 7 13 4 13 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: odd_ 12 1 4 */ -/*:ref: irfnum_ 14 3 13 4 124 */ -/*:ref: zzspkgp1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: stlabx_ 14 3 7 7 7 */ -/*:ref: stelab_ 14 3 7 7 7 */ - -extern int zzspksb0_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzspkgo0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzspksb1_(integer *targ, doublereal *et, char *ref, doublereal *starg, ftnlen ref_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzspkgo1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: chkout_ 14 2 13 124 */ - -extern int zzspkzp0_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzspkgp0_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: zzspksb0_ 14 5 4 7 13 7 124 */ -/*:ref: zzspkpa0_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzrefch0_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzspkzp1_(integer *targ, doublereal *et, char *ref, char *abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen ref_len, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: namfrm_ 14 3 13 4 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: frinfo_ 14 5 4 4 4 4 12 */ -/*:ref: ltrim_ 4 2 13 124 */ -/*:ref: eqchr_ 12 4 13 13 124 124 */ -/*:ref: eqstr_ 12 4 13 13 124 124 */ -/*:ref: zzspkgp1_ 14 7 4 7 13 4 7 7 124 */ -/*:ref: zzspksb1_ 14 5 4 7 13 7 124 */ -/*:ref: zzspkpa1_ 14 9 4 7 13 7 13 7 7 124 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: zzrefch1_ 14 4 4 4 7 7 */ -/*:ref: mxv_ 14 3 7 7 7 */ - -extern int zzstelab_(logical *xmit, doublereal *accobs, doublereal *vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr); -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vnorm_ 7 1 7 */ -/*:ref: clight_ 7 0 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vhat_ 14 2 7 7 */ -/*:ref: vlcom_ 14 5 7 7 7 7 7 */ -/*:ref: vlcom3_ 14 7 7 7 7 7 7 7 7 */ -/*:ref: vadd_ 14 3 7 7 7 */ -/*:ref: qderiv_ 14 5 4 7 7 7 7 */ - -extern logical zztime_(char *string, char *transl, char *letter, char *error, char *pic, doublereal *tvec, integer *b, integer *e, logical *l2r, logical *yabbrv, ftnlen string_len, ftnlen transl_len, ftnlen letter_len, ftnlen error_len, ftnlen pic_len); -extern logical zzcmbt_(char *string, char *letter, logical *l2r, ftnlen string_len, ftnlen letter_len); -extern logical zzgrep_(char *string, ftnlen string_len); -extern logical zzispt_(char *string, integer *b, integer *e, ftnlen string_len); -extern logical zzist_(char *letter, ftnlen letter_len); -extern logical zznote_(char *letter, integer *b, integer *e, ftnlen letter_len); -extern logical zzremt_(char *letter, ftnlen letter_len); -extern logical zzsubt_(char *string, char *transl, logical *l2r, ftnlen string_len, ftnlen transl_len); -extern logical zztokns_(char *string, char *error, ftnlen string_len, ftnlen error_len); -extern logical zzunpck_(char *string, logical *yabbrv, doublereal *tvec, integer *e, char *transl, char *pic, char *error, ftnlen string_len, ftnlen transl_len, ftnlen pic_len, ftnlen error_len); -extern logical zzvalt_(char *string, integer *b, integer *e, char *letter, ftnlen string_len, ftnlen letter_len); -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pos_ 4 5 13 13 4 124 124 */ -/*:ref: posr_ 4 5 13 13 4 124 124 */ -/*:ref: zzrepsub_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: cpos_ 4 5 13 13 4 124 124 */ -/*:ref: rtrim_ 4 2 13 124 */ -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: zzinssub_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: prefix_ 14 5 13 4 13 124 124 */ -/*:ref: repmi_ 14 7 13 13 4 13 124 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: samsbi_ 12 8 13 4 4 13 4 4 124 124 */ -/*:ref: samchi_ 12 6 13 4 13 4 124 124 */ -/*:ref: suffix_ 14 5 13 4 13 124 124 */ -/*:ref: repmc_ 14 8 13 13 13 13 124 124 124 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: zzmkpc_ 14 8 13 4 4 13 13 124 124 124 */ -/*:ref: nparsi_ 14 6 13 4 13 4 124 124 */ - -extern logical zztpats_(integer *room, integer *nknown, char *known, char *meanng, ftnlen known_len, ftnlen meanng_len); -/*:ref: orderc_ 14 4 13 4 4 124 */ -/*:ref: reordc_ 14 4 4 4 13 124 */ - -extern int zztwovxf_(doublereal *axdef, integer *indexa, doublereal *plndef, integer *indexp, doublereal *xform); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: dvhat_ 14 2 7 7 */ -/*:ref: ducrss_ 14 3 7 7 7 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: cleard_ 14 2 4 7 */ -/*:ref: vzero_ 12 1 7 */ - -extern int zzutcpm_(char *string, integer *start, doublereal *hoff, doublereal *moff, integer *last, logical *succes, ftnlen string_len); -/*:ref: lx4uns_ 14 5 13 4 4 4 124 */ -/*:ref: nparsd_ 14 6 13 7 13 4 124 124 */ -/*:ref: samch_ 12 6 13 4 13 4 124 124 */ - -extern int zzvalcor_(char *abcorr, logical *attblk, ftnlen abcorr_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzprscor_ 14 3 13 12 124 */ -/*:ref: failed_ 12 0 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ - -extern int zzvstrng_(doublereal *x, char *fill, integer *from, integer *to, logical *rnd, integer *expont, char *substr, logical *did, ftnlen fill_len, ftnlen substr_len); -extern int zzvststr_(doublereal *x, char *fill, integer *expont, ftnlen fill_len); -extern int zzvsbstr_(integer *from, integer *to, logical *rnd, char *substr, logical *did, ftnlen substr_len); -/*:ref: dpstr_ 14 4 7 4 13 124 */ - -extern int zzwahr_(doublereal *et, doublereal *dvnut); -/*:ref: pi_ 7 0 */ -/*:ref: twopi_ 7 0 */ -/*:ref: spd_ 7 0 */ - -extern integer zzwind_(doublereal *plane, integer *n, doublereal *vertcs, doublereal *point); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: pl2nvc_ 14 3 7 7 7 */ -/*:ref: vzero_ 12 1 7 */ -/*:ref: vdot_ 7 2 7 7 */ -/*:ref: vminus_ 14 2 7 7 */ -/*:ref: vequ_ 14 2 7 7 */ -/*:ref: vsub_ 14 3 7 7 7 */ -/*:ref: vperp_ 14 3 7 7 7 */ -/*:ref: vsep_ 7 2 7 7 */ -/*:ref: ucrss_ 14 3 7 7 7 */ -/*:ref: twopi_ 7 0 */ - -extern integer zzwind2d_(integer *n, doublereal *vertcs, doublereal *point); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: vsubg_ 14 4 7 7 4 7 */ -/*:ref: vsepg_ 7 3 7 7 4 */ -/*:ref: vdotg_ 7 3 7 7 4 */ -/*:ref: moved_ 14 3 7 4 7 */ -/*:ref: twopi_ 7 0 */ - -extern int zzwninsd_(doublereal *left, doublereal *right, char *context, doublereal *window, ftnlen context_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: sized_ 4 1 7 */ -/*:ref: cardd_ 4 1 7 */ -/*:ref: lastnb_ 4 2 13 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errdp_ 14 3 13 7 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: scardd_ 14 2 4 7 */ -/*:ref: errint_ 14 3 13 4 124 */ - -extern int zzxlated_(integer *inbff, char *input, integer *space, doublereal *output, ftnlen input_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errint_ 14 3 13 4 124 */ -/*:ref: moved_ 14 3 7 4 7 */ - -extern int zzxlatei_(integer *inbff, char *input, integer *space, integer *output, ftnlen input_len); -/*:ref: return_ 12 0 */ -/*:ref: chkin_ 14 2 13 124 */ -/*:ref: zzddhgsd_ 14 5 13 4 13 124 124 */ -/*:ref: zzplatfm_ 14 4 13 13 124 124 */ -/*:ref: ucase_ 14 4 13 13 124 124 */ -/*:ref: isrchc_ 4 5 13 4 13 124 124 */ -/*:ref: setmsg_ 14 2 13 124 */ -/*:ref: errch_ 14 4 13 13 124 124 */ -/*:ref: sigerr_ 14 2 13 124 */ -/*:ref: chkout_ 14 2 13 124 */ -/*:ref: intmin_ 4 0 */ -/*:ref: errint_ 14 3 13 4 124 */ - - -#ifdef __cplusplus - } -#endif - -#endif - diff --git a/ext/spice/src/csupport/SpiceZim.h b/ext/spice/src/csupport/SpiceZim.h deleted file mode 100644 index ee8d96ebc6..0000000000 --- a/ext/spice/src/csupport/SpiceZim.h +++ /dev/null @@ -1,1358 +0,0 @@ -/* - --Header_File SpiceZim.h ( CSPICE interface macros ) - --Abstract - - Define interface macros to be called in place of CSPICE - user-interface-level functions. These macros are generally used - to compensate for compiler deficiencies. - --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. - --Literature_References - - None. - --Particulars - - This header file defines interface macros to be called in place of - CSPICE user-interface-level functions. Currently, the sole purpose - of these macros is to implement automatic type casting under some - environments that generate compile-time warnings without the casts. - The typical case that causes a problem is a function argument list - containing an input formal argument of type - - const double [3][3] - - Under some compilers, a non-const actual argument supplied in a call - to such a function will generate a spurious warning due to the - "mismatched" type. These macros generate type casts that will - make such compilers happy. - - Examples of compilers that generate warnings of this type are - - gcc version 2.2.2, hosted on NeXT workstations running - NeXTStep 3.3 - - Sun C compiler, version 4.2, running under Solaris. - - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 11.0.0, 09-MAR-2009 (NJB) (EDW) - - Added macros for - - dvsep_c - gfevnt_c - gffove_c - gfrfov_c - gfsntc_c - surfpv_c - - - -CSPICE Version 10.0.0, 19-FEB-2008 (NJB) (EDW) - - Added macros for - - ilumin_c - spkaps_c - spkltc_c - - -CSPICE Version 9.0.0, 31-OCT-2005 (NJB) - - Added macros for - - qdq2av_c - qxq_c - - -CSPICE Version 8.0.0, 23-FEB-2004 (NJB) - - Added macro for - - dafrs_c - - - -CSPICE Version 7.0.0, 23-FEB-2004 (EDW) - - Added macro for - - srfxpt_c - - -CSPICE Version 6.0.1, 25-FEB-2003 (EDW) (NJB) - - Remove duplicate macro definitions for ekaced_c and - ekacei_c. Visual Studio errored out when compiling - code that included SpiceZim.h. - - Added macro for - - dasac_c - - -CSPICE Version 6.0.0, 17-AUG-2002 (NJB) - - Added macros for - - bschoc_c - bschoi_c - bsrchc_c - bsrchd_c - bsrchi_c - esrchc_c - isordv_c - isrchc_c - isrchd_c - isrchi_c - lstltc_c - lstltd_c - lstlti_c - lstlec_c - lstled_c - lstlei_c - orderc_c - orderd_c - orderi_c - reordc_c - reordd_c - reordi_c - reordl_c - spkw18_c - - -CSPICE Version 5.0.0, 28-AUG-2001 (NJB) - - Added macros for - - conics_c - illum_c - invort_c - pdpool_c - prop2b_c - q2m_c - spkuds_c - xposeg_c - - -CSPICE Version 4.0.0, 22-MAR-2000 (NJB) - - Added macros for - - spkw12_c - spkw13_c - - -CSPICE Version 3.0.0, 27-AUG-1999 (NJB) (EDW) - - Fixed cut & paste error in macro nvp2pl_c. - - Added macros for - - axisar_c - cgv2el_c - dafps_c - dafus_c - diags2_c - dvdot_c - dvhat_c - edlimb_c - ekacli_c - ekacld_c - ekacli_c - eul2xf_c - el2cgv_c - getelm_c - inedpl_c - isrot_c - mequ_c - npedln_c - nplnpt_c - rav2xf_c - raxisa_c - saelgv_c - spk14a_c - spkapo_c - spkapp_c - spkw02_c - spkw03_c - spkw05_c - spkw08_c - spkw09_c - spkw10_c - spkw15_c - spkw17_c - sumai_c - trace_c - vadd_g - vhatg_c - vlcomg_c - vminug_c - vrel_c - vrelg_c - vsepg_c - vtmv_c - vtmvg_c - vupack_c - vzerog_c - xf2eul_c - xf2rav_c - - -CSPICE Version 2.0.0, 07-MAR-1999 (NJB) - - Added macros for - - inrypl_c - nvc2pl_c - nvp2pl_c - pl2nvc_c - pl2nvp_c - pl2psv_c - psv2pl_c - vprjp_c - vprjpi_c - - -CSPICE Version 1.0.0, 24-JAN-1999 (NJB) (EDW) - - --Index_Entries - - interface macros for CSPICE functions - -*/ - - -/* -Include Files: -*/ - - -#ifndef HAVE_SPICEDEFS_H -#include "SpiceZdf.h" -#endif - -#ifndef HAVE_SPICEIFMACROS_H -#define HAVE_SPICEIFMACROS_H - - -/* -Macros used to abbreviate type casts: -*/ - - #define CONST_BOOL ( ConstSpiceBoolean * ) - #define CONST_ELLIPSE ( ConstSpiceEllipse * ) - #define CONST_IVEC ( ConstSpiceInt * ) - #define CONST_MAT ( ConstSpiceDouble (*) [3] ) - #define CONST_MAT2 ( ConstSpiceDouble (*) [2] ) - #define CONST_MAT6 ( ConstSpiceDouble (*) [6] ) - #define CONST_PLANE ( ConstSpicePlane * ) - #define CONST_VEC3 ( ConstSpiceDouble (*) [3] ) - #define CONST_VEC4 ( ConstSpiceDouble (*) [4] ) - #define CONST_STR ( ConstSpiceChar * ) - #define CONST_VEC ( ConstSpiceDouble * ) - #define CONST_VOID ( const void * ) - -/* -Macros that substitute for function calls: -*/ - - #define axisar_c( axis, angle, r ) \ - \ - ( axisar_c( CONST_VEC(axis), (angle), (r) ) ) - - - #define bschoc_c( value, ndim, lenvals, array, order ) \ - \ - ( bschoc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array), CONST_IVEC(order) ) ) - - - #define bschoi_c( value, ndim, array, order ) \ - \ - ( bschoi_c ( (value) , (ndim), \ - CONST_IVEC(array), CONST_IVEC(order) ) ) - - - #define bsrchc_c( value, ndim, lenvals, array ) \ - \ - ( bsrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define bsrchd_c( value, ndim, array ) \ - \ - ( bsrchd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define bsrchi_c( value, ndim, array ) \ - \ - ( bsrchi_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define ckw01_c( handle, begtim, endtim, inst, ref, avflag, \ - segid, nrec, sclkdp, quats, avvs ) \ - \ - ( ckw01_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(sclkdp), CONST_VEC4(quats), \ - CONST_VEC3(avvs) ) ) - - - #define ckw02_c( handle, begtim, endtim, inst, ref, segid, \ - nrec, start, stop, quats, avvs, rates ) \ - \ - ( ckw02_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(start), CONST_VEC(stop), \ - CONST_VEC4(quats), CONST_VEC3(avvs), \ - CONST_VEC(rates) ) ) - - - #define ckw03_c( handle, begtim, endtim, inst, ref, avflag, \ - segid, nrec, sclkdp, quats, avvs, nints, \ - starts ) \ - \ - ( ckw03_c ( (handle), (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (nrec), \ - CONST_VEC(sclkdp), CONST_VEC4(quats), \ - CONST_VEC3(avvs), (nints), \ - CONST_VEC(starts) ) ) - - - #define ckw05_c( handle, subtyp, degree, begtim, endtim, inst, \ - ref, avflag, segid, n, sclkdp, packts, \ - rate, nints, starts ) \ - \ - ( ckw05_c ( (handle), (subtyp), (degree), \ - (begtim), (endtim), \ - (inst), CONST_STR(ref), (avflag), \ - CONST_STR(segid), (n), \ - CONST_VEC(sclkdp), CONST_VOID(packts), \ - (rate), (nints), \ - CONST_VEC(starts) ) ) - - - #define cgv2el_c( center, vec1, vec2, ellipse ) \ - \ - ( cgv2el_c( CONST_VEC(center), CONST_VEC(vec1), \ - CONST_VEC(vec2), (ellipse) ) ) - - - #define conics_c( elts, et, state ) \ - \ - ( conics_c( CONST_VEC(elts), (et), (state) ) ) - - - #define dafps_c( nd, ni, dc, ic, sum ) \ - \ - ( dafps_c ( (nd), (ni), CONST_VEC(dc), CONST_IVEC(ic), \ - (sum) ) ) - - - #define dafrs_c( sum ) \ - \ - ( dafrs_c ( CONST_VEC( sum ) ) ) - - - #define dafus_c( sum, nd, ni, dc, ic ) \ - \ - ( dafus_c ( CONST_VEC(sum), (nd), (ni), (dc), (ic) ) ) - - - #define dasac_c( handle, n, buflen, buffer ) \ - \ - ( dasac_c ( (handle), (n), (buflen), CONST_VOID(buffer) ) ) - - - #define det_c( m1 ) \ - \ - ( det_c ( CONST_MAT(m1) ) ) - - - #define diags2_c( symmat, diag, rotate ) \ - \ - ( diags2_c ( CONST_MAT2(symmat), (diag), (rotate) ) ) - - - - #define dvdot_c( s1, s2 ) \ - \ - ( dvdot_c ( CONST_VEC(s1), CONST_VEC(s2) ) ) - - - #define dvhat_c( v1, v2 ) \ - \ - ( dvhat_c ( CONST_VEC(v1), (v2) ) ) - - - #define dvsep_c( s1, s2 ) \ - \ - ( dvsep_c ( CONST_VEC(s1), CONST_VEC(s2) ) ) - - - #define edlimb_c( a, b, c, viewpt, limb ) \ - \ - ( edlimb_c( (a), (b), (c), CONST_VEC(viewpt), (limb) ) ) - - - #define ekacec_c( handle, segno, recno, column, nvals, vallen, \ - cvals, isnull ) \ - \ - ( ekacec_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), (vallen), CONST_VOID(cvals), \ - (isnull) ) ) - - - #define ekaced_c( handle, segno, recno, column, nvals, \ - dvals, isnull ) \ - \ - ( ekaced_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VEC(dvals), (isnull) ) ) - - - #define ekacei_c( handle, segno, recno, column, nvals, \ - ivals, isnull ) \ - \ - ( ekacei_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_IVEC(ivals), (isnull) ) ) - - - #define ekaclc_c( handle, segno, column, vallen, cvals, entszs, \ - nlflgs, rcptrs, wkindx ) \ - \ - ( ekaclc_c( (handle), (segno), (column), (vallen), \ - CONST_VOID(cvals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekacld_c( handle, segno, column, dvals, entszs, nlflgs, \ - rcptrs, wkindx ) \ - \ - ( ekacld_c( (handle), (segno), (column), \ - CONST_VEC(dvals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekacli_c( handle, segno, column, ivals, entszs, nlflgs, \ - rcptrs, wkindx ) \ - \ - ( ekacli_c( (handle), (segno), (column), \ - CONST_IVEC(ivals), CONST_IVEC(entszs), \ - CONST_BOOL(nlflgs), CONST_IVEC(rcptrs), \ - (wkindx) ) ) - - - #define ekbseg_c( handle, tabnam, ncols, cnmlen, cnames, declen, \ - decls, segno ) \ - \ - ( ekbseg_c( (handle), (tabnam), (ncols), (cnmlen), \ - CONST_VOID(cnames), (declen), \ - CONST_VOID(decls), (segno) ) ) - - - #define ekifld_c( handle, tabnam, ncols, nrows, cnmlen, cnames, \ - declen, decls, segno, rcptrs ) \ - \ - ( ekifld_c( (handle), (tabnam), (ncols), (nrows), (cnmlen), \ - CONST_VOID(cnames), (declen), \ - CONST_VOID(decls), (segno), (rcptrs) ) ) - - - #define ekucec_c( handle, segno, recno, column, nvals, vallen, \ - cvals, isnull ) \ - \ - ( ekucec_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), (vallen), CONST_VOID(cvals), \ - (isnull) ) ) - - #define ekuced_c( handle, segno, recno, column, nvals, \ - dvals, isnull ) \ - \ - ( ekuced_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VOID(dvals), (isnull) ) ) - - - #define ekucei_c( handle, segno, recno, column, nvals, \ - ivals, isnull ) \ - \ - ( ekucei_c( (handle), (segno), (recno), CONST_STR(column), \ - (nvals), CONST_VOID(ivals), (isnull) ) ) - - - #define el2cgv_c( ellipse, center, smajor, sminor ) \ - \ - ( el2cgv_c( CONST_ELLIPSE(ellipse), (center), \ - (smajor), (sminor) ) ) - - - #define esrchc_c( value, ndim, lenvals, array ) \ - \ - ( esrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define eul2xf_c( eulang, axisa, axisb, axisc, xform ) \ - \ - ( eul2xf_c ( CONST_VEC(eulang), (axisa), (axisb), (axisc), \ - (xform) ) ) - - - #define getelm_c( frstyr, lineln, lines, epoch, elems ) \ - \ - ( getelm_c ( (frstyr), (lineln), CONST_VOID(lines), \ - (epoch), (elems) ) ) - - - #define gfevnt_c( udstep, udrefn, gquant, qnpars, lenvals, \ - qpnams, qcpars, qdpars, qipars, qlpars, \ - op, refval, tol, adjust, rpt, \ - udrepi, udrepu, udrepf, nintvls, \ - bail, udbail, cnfine, result ) \ - \ - ( gfevnt_c( (udstep), (udrefn), (gquant), \ - (qnpars), (lenvals), CONST_VOID(qpnams),\ - CONST_VOID(qcpars), (qdpars), (qipars), \ - (qlpars), (op), (refval), \ - (tol), (adjust), (rpt), \ - (udrepi), (udrepu), (udrepf), \ - (nintvls), (bail), \ - (udbail), (cnfine), (result) ) ) - - - #define gffove_c( inst, tshape, raydir, target, tframe, \ - abcorr, obsrvr, tol, udstep, udrefn, \ - rpt, udrepi, udrepu, udrepf, bail, \ - udbail, cnfine, result ) \ - \ - ( gffove_c( (inst), (tshape), CONST_VEC(raydir), \ - (target), (tframe), (abcorr), \ - (obsrvr), (tol), (udstep), \ - (udrefn), (rpt), (udrepi), \ - (udrepu), (udrepf), (bail), \ - (udbail), (cnfine), (result) ) ) - - - #define gfrfov_c( inst, raydir, rframe, abcorr, obsrvr, \ - step, cnfine, result ) \ - \ - ( gfrfov_c( (inst), CONST_VEC(raydir), (rframe), \ - (abcorr), (obsrvr), (step), \ - (cnfine), (result) ) ) - - - #define gfsntc_c( target, fixref, method, abcorr, obsrvr, \ - dref, dvec, crdsys, coord, relate, \ - refval, adjust, step, nintvls, cnfine, \ - result ) \ - \ - ( gfsntc_c( (target), (fixref), (method), \ - (abcorr), (obsrvr), (dref), \ - CONST_VEC(dvec), (crdsys), (coord), \ - (relate), (refval), (adjust), \ - (step), (nintvls), (cnfine), (result) ) ) - - - #define illum_c( target, et, abcorr, obsrvr, \ - spoint, phase, solar, emissn ) \ - \ - ( illum_c ( (target), (et), (abcorr), (obsrvr), \ - CONST_VEC(spoint), (phase), (solar), (emissn) ) ) - - - #define ilumin_c( method, target, et, fixref, \ - abcorr, obsrvr, spoint, trgepc, \ - srfvec, phase, solar, emissn ) \ - \ - ( ilumin_c ( (method), (target), (et), (fixref), \ - (abcorr), (obsrvr), CONST_VEC(spoint), (trgepc), \ - (srfvec), (phase), (solar), (emissn) ) ) - - - #define inedpl_c( a, b, c, plane, ellipse, found ) \ - \ - ( inedpl_c ( (a), (b), (c), \ - CONST_PLANE(plane), (ellipse), (found) ) ) - - - #define inrypl_c( vertex, dir, plane, nxpts, xpt ) \ - \ - ( inrypl_c ( CONST_VEC(vertex), CONST_VEC(dir), \ - CONST_PLANE(plane), (nxpts), (xpt) ) ) - - - #define invert_c( m1, m2 ) \ - \ - ( invert_c ( CONST_MAT(m1), (m2) ) ) - - - #define invort_c( m, mit ) \ - \ - ( invort_c ( CONST_MAT(m), (mit) ) ) - - - #define isordv_c( array, n ) \ - \ - ( isordv_c ( CONST_IVEC(array), (n) ) ) - - - #define isrchc_c( value, ndim, lenvals, array ) \ - \ - ( isrchc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - #define isrchd_c( value, ndim, array ) \ - \ - ( isrchd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define isrchi_c( value, ndim, array ) \ - \ - ( isrchi_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define isrot_c( m, ntol, dtol ) \ - \ - ( isrot_c ( CONST_MAT(m), (ntol), (dtol) ) ) - - - #define lmpool_c( cvals, lenvals, n ) \ - \ - ( lmpool_c( CONST_VOID(cvals), (lenvals), (n) ) ) - - - #define lstltc_c( value, ndim, lenvals, array ) \ - \ - ( lstltc_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define lstled_c( value, ndim, array ) \ - \ - ( lstled_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define lstlei_c( value, ndim, array ) \ - \ - ( lstlei_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define lstlec_c( value, ndim, lenvals, array ) \ - \ - ( lstlec_c ( CONST_STR(value), (ndim), (lenvals), \ - CONST_VOID(array) ) ) - - - #define lstltd_c( value, ndim, array ) \ - \ - ( lstltd_c( (value), (ndim), CONST_VEC(array) ) ) - - - #define lstlti_c( value, ndim, array ) \ - \ - ( lstlti_c( (value), (ndim), CONST_IVEC(array) ) ) - - - #define m2eul_c( r, axis3, axis2, axis1, \ - angle3, angle2, angle1 ) \ - \ - ( m2eul_c ( CONST_MAT(r), (axis3), (axis2), (axis1), \ - (angle3), (angle2), (angle1) ) ) - - #define m2q_c( r, q ) \ - \ - ( m2q_c ( CONST_MAT(r), (q) ) ) - - - #define mequ_c( m1, m2 ) \ - \ - ( mequ_c ( CONST_MAT(m1), m2 ) ) - - - #define mequg_c( m1, nr, nc, mout ) \ - \ - ( mequg_c ( CONST_MAT(m1), (nr), (nc), mout ) ) - - - #define mtxm_c( m1, m2, mout ) \ - \ - ( mtxm_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mtxmg_c( m1, m2, ncol1, nr1r2, ncol2, mout ) \ - \ - ( mtxmg_c ( CONST_MAT(m1), CONST_MAT(m2), \ - (ncol1), (nr1r2), (ncol2), (mout) ) ) - - - #define mtxv_c( m1, vin, vout ) \ - \ - ( mtxv_c ( CONST_MAT(m1), CONST_VEC(vin), (vout) ) ) - - - #define mtxvg_c( m1, v2, nrow1, nc1r2, vout ) \ - \ - ( mtxvg_c( CONST_VOID(m1), CONST_VOID(v2), \ - (nrow1), (nc1r2), (vout) ) ) - - #define mxm_c( m1, m2, mout ) \ - \ - ( mxm_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mxmg_c( m1, m2, row1, col1, col2, mout ) \ - \ - ( mxmg_c ( CONST_VOID(m1), CONST_VOID(m2), \ - (row1), (col1), (col2), (mout) ) ) - - - #define mxmt_c( m1, m2, mout ) \ - \ - ( mxmt_c ( CONST_MAT(m1), CONST_MAT(m2), (mout) ) ) - - - #define mxmtg_c( m1, m2, nrow1, nc1c2, nrow2, mout ) \ - \ - ( mxmtg_c ( CONST_VOID(m1), CONST_VOID(m2), \ - (nrow1), (nc1c2), \ - (nrow2), (mout) ) ) - - - #define mxv_c( m1, vin, vout ) \ - \ - ( mxv_c ( CONST_MAT(m1), CONST_VEC(vin), (vout) ) ) - - - #define mxvg_c( m1, v2, nrow1, nc1r2, vout ) \ - \ - ( mxvg_c( CONST_VOID(m1), CONST_VOID(v2), \ - (nrow1), (nc1r2), (vout) ) ) - - #define nearpt_c( positn, a, b, c, npoint, alt ) \ - \ - ( nearpt_c ( CONST_VEC(positn), (a), (b), (c), \ - (npoint), (alt) ) ) - - - #define npedln_c( a, b, c, linept, linedr, pnear, dist ) \ - \ - ( npedln_c ( (a), (b), (c), \ - CONST_VEC(linept), CONST_VEC(linedr), \ - (pnear), (dist) ) ) - - - #define nplnpt_c( linpt, lindir, point, pnear, dist ) \ - \ - ( nplnpt_c ( CONST_VEC(linpt), CONST_VEC(lindir), \ - CONST_VEC(point), (pnear), (dist ) ) ) - - - #define nvc2pl_c( normal, constant, plane ) \ - \ - ( nvc2pl_c ( CONST_VEC(normal), (constant), (plane) ) ) - - - #define nvp2pl_c( normal, point, plane ) \ - \ - ( nvp2pl_c( CONST_VEC(normal), CONST_VEC(point), (plane) ) ) - - - #define orderc_c( lenvals, array, ndim, iorder ) \ - \ - ( orderc_c ( (lenvals), CONST_VOID(array), (ndim), (iorder)) ) - - - #define orderd_c( array, ndim, iorder ) \ - \ - ( orderd_c ( CONST_VEC(array), (ndim), (iorder) ) ) - - - #define orderi_c( array, ndim, iorder ) \ - \ - ( orderi_c ( CONST_IVEC(array), (ndim), (iorder) ) ) - - - #define oscelt_c( state, et, mu, elts ) \ - \ - ( oscelt_c ( CONST_VEC(state), (et), (mu), (elts) ) ) - - - #define pcpool_c( name, n, lenvals, cvals ) \ - \ - ( pcpool_c ( (name), (n), (lenvals), CONST_VOID(cvals) ) ) - - - #define pdpool_c( name, n, dvals ) \ - \ - ( pdpool_c ( (name), (n), CONST_VEC(dvals) ) ) - - - #define pipool_c( name, n, ivals ) \ - \ - ( pipool_c ( (name), (n), CONST_IVEC(ivals) ) ) - - - #define pl2nvc_c( plane, normal, constant ) \ - \ - ( pl2nvc_c ( CONST_PLANE(plane), (normal), (constant) ) ) - - - #define pl2nvp_c( plane, normal, point ) \ - \ - ( pl2nvp_c ( CONST_PLANE(plane), (normal), (point) ) ) - - - #define pl2psv_c( plane, point, span1, span2 ) \ - \ - ( pl2psv_c( CONST_PLANE(plane), (point), (span1), (span2) ) ) - - - #define prop2b_c( gm, pvinit, dt, pvprop ) \ - \ - ( prop2b_c ( (gm), CONST_VEC(pvinit), (dt), (pvprop) ) ) - - - #define psv2pl_c( point, span1, span2, plane ) \ - \ - ( psv2pl_c ( CONST_VEC(point), CONST_VEC(span1), \ - CONST_VEC(span2), (plane) ) ) - - - #define qdq2av_c( q, dq, av ) \ - \ - ( qdq2av_c ( CONST_VEC(q), CONST_VEC(dq), (av) ) ) - - - #define q2m_c( q, r ) \ - \ - ( q2m_c ( CONST_VEC(q), (r) ) ) - - - #define qxq_c( q1, q2, qout ) \ - \ - ( qxq_c ( CONST_VEC(q1), CONST_VEC(q2), (qout) ) ) - - - #define rav2xf_c( rot, av, xform ) \ - \ - ( rav2xf_c ( CONST_MAT(rot), CONST_VEC(av), (xform) ) ) - - - #define raxisa_c( matrix, axis, angle ) \ - \ - ( raxisa_c ( CONST_MAT(matrix), (axis), (angle) ) ); - - - #define reccyl_c( rectan, r, lon, z ) \ - \ - ( reccyl_c ( CONST_VEC(rectan), (r), (lon), (z) ) ) - - - #define recgeo_c( rectan, re, f, lon, lat, alt ) \ - \ - ( recgeo_c ( CONST_VEC(rectan), (re), (f), \ - (lon), (lat), (alt) ) ) - - #define reclat_c( rectan, r, lon, lat ) \ - \ - ( reclat_c ( CONST_VEC(rectan), (r), (lon), (lat) ) ) - - - #define recrad_c( rectan, radius, ra, dec ) \ - \ - ( recrad_c ( CONST_VEC(rectan), (radius), (ra), (dec) ) ) - - - #define recsph_c( rectan, r, colat, lon ) \ - \ - ( recsph_c ( CONST_VEC(rectan), (r), (colat), (lon) ) ) - - - #define reordd_c( iorder, ndim, array ) \ - \ - ( reordd_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define reordi_c( iorder, ndim, array ) \ - \ - ( reordi_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define reordl_c( iorder, ndim, array ) \ - \ - ( reordl_c ( CONST_IVEC(iorder), (ndim), (array) ) ) - - - #define rotmat_c( m1, angle, iaxis, mout ) \ - \ - ( rotmat_c ( CONST_MAT(m1), (angle), (iaxis), (mout) ) ) - - - #define rotvec_c( v1, angle, iaxis, vout ) \ - \ - ( rotvec_c ( CONST_VEC(v1), (angle), (iaxis), (vout) ) ) - - - #define saelgv_c( vec1, vec2, smajor, sminor ) \ - \ - ( saelgv_c ( CONST_VEC(vec1), CONST_VEC(vec2), \ - (smajor), (sminor) ) ) - - - #define spk14a_c( handle, ncsets, coeffs, epochs ) \ - \ - ( spk14a_c ( (handle), (ncsets), \ - CONST_VEC(coeffs), CONST_VEC(epochs) ) ) - - - #define spkapo_c( targ, et, ref, sobs, abcorr, ptarg, lt ) \ - \ - ( spkapo_c ( (targ), (et), (ref), CONST_VEC(sobs), \ - (abcorr), (ptarg), (lt) ) ) - - - #define spkapp_c( targ, et, ref, sobs, abcorr, starg, lt ) \ - \ - ( spkapp_c ( (targ), (et), (ref), CONST_VEC(sobs), \ - (abcorr), (starg), (lt) ) ) - - - #define spkaps_c( targ, et, ref, abcorr, sobs, \ - accobs, starg, lt, dlt ) \ - \ - ( spkaps_c ( (targ), (et), (ref), (abcorr), \ - CONST_VEC(sobs), CONST_VEC(accobs), \ - (starg), (lt), (dlt) ) ) - - - #define spkltc_c( targ, et, ref, abcorr, sobs, starg, lt, dlt ) \ - \ - ( spkltc_c ( (targ), (et), (ref), (abcorr), \ - CONST_VEC(sobs), (starg), (lt), (dlt) ) ) - - - #define spkuds_c( descr, body, center, frame, type, \ - first, last, begin, end ) \ - \ - ( spkuds_c ( CONST_VEC(descr), (body), (center), (frame), \ - (type), (first), (last), (begin), (end) ) ) - - - #define spkw02_c( handle, body, center, frame, first, last, \ - segid, intlen, n, polydg, cdata, btime ) \ - \ - ( spkw02_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (intlen), \ - (n), (polydg), CONST_VEC(cdata), (btime) ) ) - - - #define spkw03_c( handle, body, center, frame, first, last, \ - segid, intlen, n, polydg, cdata, btime ) \ - \ - ( spkw03_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (intlen), \ - (n), (polydg), CONST_VEC(cdata), (btime) ) ) - - - - #define spkw05_c( handle, body, center, frame, first, last, \ - segid, gm, n, states, epochs ) \ - \ - ( spkw05_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (gm), \ - (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - #define spkw08_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epoch1, step ) \ - \ - ( spkw08_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), \ - (n), CONST_MAT6(states), (epoch1), \ - (step) ) ) - - - #define spkw09_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epochs ) \ - \ - ( spkw09_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - #define spkw10_c( handle, body, center, frame, first, last, \ - segid, consts, n, elems, epochs ) \ - \ - ( spkw10_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), CONST_VEC(consts), \ - (n), CONST_VEC(elems), CONST_VEC(epochs)) ) - - - #define spkw12_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epoch0, step ) \ - \ - ( spkw12_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), \ - (n), CONST_MAT6(states), (epoch0), \ - (step) ) ) - - - #define spkw13_c( handle, body, center, frame, first, last, \ - segid, degree, n, states, epochs ) \ - \ - ( spkw13_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_MAT6(states), CONST_VEC(epochs) ) ) - - - - - - #define spkw15_c( handle, body, center, frame, first, last, \ - segid, epoch, tp, pa, p, ecc, \ - j2flg, pv, gm, j2, radius ) \ - \ - ( spkw15_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (epoch), \ - CONST_VEC(tp), CONST_VEC(pa), \ - (p), (ecc), (j2flg), CONST_VEC(pv), \ - (gm), (j2), (radius) ) ) - - - #define spkw17_c( handle, body, center, frame, first, last, \ - segid, epoch, eqel, rapol, decpol ) \ - \ - ( spkw17_c ( (handle), (body), (center), (frame), \ - (first), (last), (segid), (epoch), \ - CONST_VEC(eqel), (rapol), (decpol) ) ) - - - - #define spkw18_c( handle, subtyp, body, center, frame, first, \ - last, segid, degree, n, packts, epochs ) \ - \ - ( spkw18_c ( (handle), (subtyp), (body), (center), (frame), \ - (first), (last), (segid), (degree), (n), \ - CONST_VOID(packts), CONST_VEC(epochs) ) ) - - - #define srfxpt_c( method, target, et, abcorr, obsrvr, dref, \ - dvec, spoint, dist, trgepc, obspos, found ) \ - \ - ( srfxpt_c ( (method), (target), (et), (abcorr), (obsrvr), \ - (dref), CONST_VEC(dvec), (spoint), (dist), \ - (trgepc), (obspos), (found) ) ) - - - #define stelab_c( pobj, vobj, appobj ) \ - \ - ( stelab_c ( CONST_VEC(pobj), CONST_VEC(vobj), (appobj) ) ) - - - #define sumad_c( array, n ) \ - \ - ( sumad_c ( CONST_VEC(array), (n) ) ) - - - #define sumai_c( array, n ) \ - \ - ( sumai_c ( CONST_IVEC(array), (n) ) ) - - - #define surfnm_c( a, b, c, point, normal ) \ - \ - ( surfnm_c ( (a), (b), (c), CONST_VEC(point), (normal) ) ) - - - #define surfpt_c( positn, u, a, b, c, point, found ) \ - \ - ( surfpt_c ( CONST_VEC(positn), CONST_VEC(u), \ - (a), (b), (c), \ - (point), (found) ) ) - - - #define surfpv_c( stvrtx, stdir, a, b, c, stx, found ) \ - \ - ( surfpv_c ( CONST_VEC(stvrtx), CONST_VEC(stdir), \ - (a), (b), (c), \ - (stx), (found) ) ) - - - #define swpool_c( agent, nnames, lenvals, names ) \ - \ - ( swpool_c( CONST_STR(agent), (nnames), \ - (lenvals), CONST_VOID(names) ) ) - - - #define trace_c( m1 ) \ - \ - ( trace_c ( CONST_MAT(m1) ) ) - - - #define twovec_c( axdef, indexa, plndef, indexp, mout ) \ - \ - ( twovec_c ( CONST_VEC(axdef), (indexa), \ - CONST_VEC(plndef), (indexp), (mout) ) ) - - - #define ucrss_c( v1, v2, vout ) \ - \ - ( ucrss_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define unorm_c( v1, vout, vmag ) \ - \ - ( unorm_c ( CONST_VEC(v1), (vout), (vmag) ) ) - - - #define unormg_c( v1, ndim, vout, vmag ) \ - \ - ( unormg_c ( CONST_VEC(v1), (ndim), (vout), (vmag) ) ) - - - #define vadd_c( v1, v2, vout ) \ - \ - ( vadd_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vaddg_c( v1, v2, ndim,vout ) \ - \ - ( vaddg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim), (vout) ) ) - - - #define vcrss_c( v1, v2, vout ) \ - \ - ( vcrss_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vdist_c( v1, v2 ) \ - \ - ( vdist_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vdistg_c( v1, v2, ndim ) \ - \ - ( vdistg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vdot_c( v1, v2 ) \ - \ - ( vdot_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vdotg_c( v1, v2, ndim ) \ - \ - ( vdotg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vequ_c( vin, vout ) \ - \ - ( vequ_c ( CONST_VEC(vin), (vout) ) ) - - - #define vequg_c( vin, ndim, vout ) \ - \ - ( vequg_c ( CONST_VEC(vin), (ndim), (vout) ) ) - - - #define vhat_c( v1, vout ) \ - \ - ( vhat_c ( CONST_VEC(v1), (vout) ) ) - - - #define vhatg_c( v1, ndim, vout ) \ - \ - ( vhatg_c ( CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vlcom3_c( a, v1, b, v2, c, v3, sum ) \ - \ - ( vlcom3_c ( (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), \ - (c), CONST_VEC(v3), (sum) ) ) - - - #define vlcom_c( a, v1, b, v2, sum ) \ - \ - ( vlcom_c ( (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), (sum) ) ) - - - #define vlcomg_c( n, a, v1, b, v2, sum ) \ - \ - ( vlcomg_c ( (n), (a), CONST_VEC(v1), \ - (b), CONST_VEC(v2), (sum) ) ) - - - #define vminug_c( v1, ndim, vout ) \ - \ - ( vminug_c ( CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vminus_c( v1, vout ) \ - \ - ( vminus_c ( CONST_VEC(v1), (vout) ) ) - - - #define vnorm_c( v1 ) \ - \ - ( vnorm_c ( CONST_VEC(v1) ) ) - - - #define vnormg_c( v1, ndim ) \ - \ - ( vnormg_c ( CONST_VEC(v1), (ndim) ) ) - - - #define vperp_c( a, b, p ) \ - \ - ( vperp_c ( CONST_VEC(a), CONST_VEC(b), (p) ) ) - - - #define vprjp_c( vin, plane, vout ) \ - \ - ( vprjp_c ( CONST_VEC(vin), CONST_PLANE(plane), (vout) ) ) - - - #define vprjpi_c( vin, projpl, invpl, vout, found ) \ - \ - ( vprjpi_c( CONST_VEC(vin), CONST_PLANE(projpl), \ - CONST_PLANE(invpl), (vout), (found) ) ) - - - #define vproj_c( a, b, p ) \ - \ - ( vproj_c ( CONST_VEC(a), CONST_VEC(b), (p) ) ) - - - #define vrel_c( v1, v2 ) \ - \ - ( vrel_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vrelg_c( v1, v2, ndim ) \ - \ - ( vrelg_c ( CONST_VEC(v1), CONST_VEC(v2), (ndim) ) ) - - - #define vrotv_c( v, axis, theta, r ) \ - \ - ( vrotv_c ( CONST_VEC(v), CONST_VEC(axis), (theta), (r) ) ) - - - #define vscl_c( s, v1, vout ) \ - \ - ( vscl_c ( (s), CONST_VEC(v1), (vout) ) ) - - - #define vsclg_c( s, v1, ndim, vout ) \ - \ - ( vsclg_c ( (s), CONST_VEC(v1), (ndim), (vout) ) ) - - - #define vsep_c( v1, v2 ) \ - \ - ( vsep_c ( CONST_VEC(v1), CONST_VEC(v2) ) ) - - - #define vsepg_c( v1, v2, ndim) \ - \ - ( vsepg_c ( CONST_VEC(v1), CONST_VEC(v2), ndim ) ) - - - #define vsub_c( v1, v2, vout ) \ - \ - ( vsub_c ( CONST_VEC(v1), CONST_VEC(v2), (vout) ) ) - - - #define vsubg_c( v1, v2, ndim, vout ) \ - \ - ( vsubg_c ( CONST_VEC(v1), CONST_VEC(v2), \ - (ndim), (vout) ) ) - - #define vtmv_c( v1, mat, v2 ) \ - \ - ( vtmv_c ( CONST_VEC(v1), CONST_MAT(mat), CONST_VEC(v2) ) ) - - - #define vtmvg_c( v1, mat, v2, nrow, ncol ) \ - \ - ( vtmvg_c ( CONST_VOID(v1), CONST_VOID(mat), CONST_VOID(v2), \ - (nrow), (ncol) ) ) - - - #define vupack_c( v, x, y, z ) \ - \ - ( vupack_c ( CONST_VEC(v), (x), (y), (z) ) ) - - - #define vzero_c( v1 ) \ - \ - ( vzero_c ( CONST_VEC(v1) ) ) - - - #define vzerog_c( v1, ndim ) \ - \ - ( vzerog_c ( CONST_VEC(v1), (ndim) ) ) - - - #define xf2eul_c( xform, axisa, axisb, axisc, eulang, unique ) \ - \ - ( xf2eul_c( CONST_MAT6(xform), (axisa), (axisb), (axisc), \ - (eulang), (unique) ) ) - - - #define xf2rav_c( xform, rot, av ) \ - \ - ( xf2rav_c( CONST_MAT6(xform), (rot), (av) ) ) - - - #define xpose6_c( m1, mout ) \ - \ - ( xpose6_c ( CONST_MAT6(m1), (mout) ) ) - - - #define xpose_c( m1, mout ) \ - \ - ( xpose_c ( CONST_MAT(m1), (mout) ) ) - - - #define xposeg_c( matrix, nrow, ncol, mout ) \ - \ - ( xposeg_c ( CONST_VOID(matrix), (nrow), (ncol), (mout) ) ) - - -#endif diff --git a/ext/spice/src/csupport/SpiceZmc.h b/ext/spice/src/csupport/SpiceZmc.h deleted file mode 100644 index df694a602e..0000000000 --- a/ext/spice/src/csupport/SpiceZmc.h +++ /dev/null @@ -1,975 +0,0 @@ -/* - --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. - -*/ - -/* - CSPICE private macro file. - --Particulars - - Current list of macros (spelling counts) - - BLANK - C2F_MAP_CELL - C2F_MAP_CELL2 - C2F_MAP_CELL3 - CELLINIT - CELLINIT2 - CELLINIT3 - CELLISSETCHK - CELLISSETCHK2 - CELLISSETCHK2_VAL - CELLISSETCHK3 - CELLISSETCHK3_VAL - CELLISSETCHK_VAL - CELLMATCH2 - CELLMATCH2_VAL - CELLMATCH3 - CELLMATCH3_VAL - CELLTYPECHK - CELLTYPECHK2 - CELLTYPECHK2_VAL - CELLTYPECHK3 - CELLTYPECHK3_VAL - CELLTYPECHK_VAL - CHKFSTR - CHKFSTR_VAL - CHKOSTR - CHKOSTR_VAL - CHKPTR - Constants - Even - F2C_MAP_CELL - Index values - MOVED - MOVEI - MaxAbs - MaxVal - MinAbs - MinVal - Odd - SpiceError - TolOrFail - --Restrictions - - This is a private macro file for use within CSPICE. - Do not use or alter any entry. Or else! - --Author_and_Institution - - N.J. Bachman (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 4.2.0, 16-FEB-2005 (NJB) - - Bug fix: in the macro C2F_MAP_CELL, error checking has been - added after the sequence of calls to ssizec_ and scardc_. - If either of these routines signals an error, the dynamically - allocated memory for the "Fortran cell" is freed. - - -CSPICE Version 4.1.0, 06-DEC-2002 (NJB) - - Bug fix: added previous missing, bracketing parentheses to - references to input cell pointer argument in macro - CELLINIT. - - Changed CELLINIT macro so it no longer initializes to zero - length all strings in data array of a character cell. Instead, - strings are terminated with a null in their final element. - - -CSPICE Version 4.0.0, 22-AUG-2002 (NJB) - - Added macro definitions to support CSPICE cells and sets: - - C2F_MAP_CELL - C2F_MAP_CELL2 - C2F_MAP_CELL3 - CELLINIT - CELLINIT2 - CELLINIT3 - CELLISSETCHK - CELLISSETCHK2 - CELLISSETCHK2_VAL - CELLISSETCHK3 - CELLISSETCHK3_VAL - CELLISSETCHK_VAL - CELLMATCH2 - CELLMATCH2_VAL - CELLMATCH3 - CELLMATCH3_VAL - CELLTYPECHK - CELLTYPECHK2 - CELLTYPECHK2_VAL - CELLTYPECHK3 - CELLTYPECHK3_VAL - CELLTYPECHK_VAL - F2C_MAP_CELL - - -CSPICE Version 3.0.0, 09-JAN-1998 (NJB) - - Added output string check macros CHKOSTR and CHKOSTR_VAL. - Removed variable name arguments from macros - - CHKPTR - CHKPTR_VAL - CHKFSTR - CHKRSTR_VAL - - The strings containing names of the checked variables are now - generated from the variables themselves via the # operator. - - -CSPICE Version 2.0.0, 03-DEC-1997 (NJB) - - Added pointer check macro CHKPTR and Fortran string check macro - CHKFSTR. - - -CSPICE Version 1.0.0, 25-OCT-1997 (EDW) -*/ - - - -#include -#include -#include "SpiceZdf.h" - - -#define MOVED( arrfrm, ndim, arrto ) \ - \ - ( memmove ( (void*) (arrto) , \ - (void*) (arrfrm), \ - sizeof (SpiceDouble) * (ndim) ) ) - - - - - -#define MOVEI( arrfrm, ndim, arrto ) \ - \ - ( memmove ( (void*) (arrto) , \ - (void*) (arrfrm), \ - sizeof (SpiceInt) * (ndim) ) ) - - - - - -/* -Define a tolerance test for those pesky double precision reals. -True if the difference is less than the tolerance, false otherwise. -The tolerance refers to a percentage. x, y and tol should be declared -double. All values are assumed to be non-zero. Okay? -*/ - -#define TolOrFail( x, y, tol ) \ - \ - ( fabs( x-y ) < ( tol * fabs(x) ) ) - - - - - -/* -Simple error output through standard SPICE error system . Set the error -message and the type -*/ - -#define SpiceError( errmsg, errtype ) \ - \ - { \ - setmsg_c ( errmsg ); \ - sigerr_c ( errtype ); \ - } - - - - - - -/* -Return a value which is the maximum/minimum of the absolute values of -two values. -*/ - -#define MaxAbs(a,b) ( fabs(a) >= fabs(b) ? fabs(a) : fabs(b) ) -#define MinAbs(a,b) ( fabs(a) < fabs(b) ? fabs(a) : fabs(b) ) - - - - - -/* -Return a value which is the maximum/minimum value of two values. -*/ - -#define MaxVal(A,B) ( (A) >= (B) ? (A) : (B) ) -#define MinVal(A,B) ( (A) < (B) ? (A) : (B) ) - - - - - -/* -Determine whether a value is even or odd -*/ -#define Even( x ) ( ( (x) & 1 ) == 0 ) -#define Odd ( x ) ( ( (x) & 1 ) != 0 ) - - - - - -/* -Array indexes for vectors. -*/ - -#define SpiceX 0 -#define SpiceY 1 -#define SpiceZ 2 -#define SpiceVx 3 -#define SpiceVy 4 -#define SpiceVz 5 - - - - -/* -Physical constants and dates. -*/ - -#define B1900 2415020.31352 -#define J1900 2415020.0 -#define JYEAR 31557600.0 -#define TYEAR 31556925.9747 -#define J1950 2433282.5 -#define SPD 86400.0 -#define B1950 2433282.42345905 -#define J2100 2488070.0 -#define CLIGHT 299792.458 -#define J2000 2451545.0 - - - - - -/* -Common literal values. -*/ - -#define NULLCHAR ( (SpiceChar ) 0 ) -#define NULLCPTR ( (SpiceChar * ) 0 ) -#define BLANK ( (SpiceChar ) ' ' ) - - - -/* -Macro CHKPTR is used for checking for a null pointer. CHKPTR uses -the constants - - CHK_STANDARD - CHK_DISCOVER - CHK_REMAIN - -to control tracing behavior. Values and meanings are: - - CHK_STANDARD Standard tracing. If an error - is found, signal it, check out - and return. - - CHK_DISCOVER Discovery check-in. If an - error is found, check in, signal - the error, check out, and return. - - CHK_REMAIN If an error is found, signal it. - Do not check out or return. This - would allow the caller to clean up - before returning, if necessary. - In such cases the caller must test - failed_c() after the macro call. - -CHKPTR should be used in void functions. In non-void functions, -use CHKPTR_VAL, which is defined below. - -*/ - -#define CHK_STANDARD 1 -#define CHK_DISCOVER 2 -#define CHK_REMAIN 3 - -#define CHKPTR( errHandling, modname, pointer ) \ - \ - if ( (void *)(pointer) == (void *)0 ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Pointer \"#\" is null; a non-null " \ - "pointer is required." ); \ - errch_c ( "#", (#pointer) ); \ - sigerr_c ( "SPICE(NULLPOINTER)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - -#define CHKPTR_VAL( errHandling, modname, pointer, retval ) \ - \ - if ( (void *)(pointer) == (void *)0 ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Pointer \"#\" is null; a non-null " \ - "pointer is required." ); \ - errch_c ( "#", (#pointer) ); \ - sigerr_c ( "SPICE(NULLPOINTER)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - -/* -Macro CHKFSTR checks strings that are to be passed to Fortran or -f2c'd Fortran routines. Such strings must have non-zero length, -and their pointers must be non-null. - -CHKFSTR should be used in void functions. In non-void functions, -use CHKFSTR_VAL, which is defined below. -*/ - -#define CHKFSTR( errHandling, modname, string ) \ - \ - CHKPTR ( errHandling, modname, string ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( strlen(string) == 0 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length zero." ); \ - errch_c ( "#", (#string) ); \ - sigerr_c ( "SPICE(EMPTYSTRING)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - -#define CHKFSTR_VAL( errHandling, modname, string, retval ) \ - \ - CHKPTR_VAL( errHandling, modname, string, retval); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( strlen(string) == 0 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length zero." ); \ - errch_c ( "#", (#string) ); \ - sigerr_c ( "SPICE(EMPTYSTRING)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - -/* -Macro CHKOSTR checks output string pointers and the associated -string length values supplied as input arguments. Output string -pointers must be non-null, and the string lengths must be at -least 2, so Fortran routine can write at least one character to -the output string, and so a null terminator can be appended. -CHKOSTR should be used in void functions. In non-void functions, -use CHKOSTR_VAL, which is defined below. -*/ - -#define CHKOSTR( errHandling, modname, string, length ) \ - \ - CHKPTR ( errHandling, modname, string ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( length < 2 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length #; must be >= 2." ); \ - errch_c ( "#", (#string) ); \ - errint_c ( "#", (length) ); \ - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - -#define CHKOSTR_VAL( errHandling, modname, string, length, retval ) \ - \ - CHKPTR_VAL( errHandling, modname, string, retval ); \ - \ - if ( ( (void *)string != (void *)0 ) \ - && ( length < 2 ) ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "String \"#\" has length #; must be >= 2." ); \ - errch_c ( "#", (#string) ); \ - errint_c ( "#", (length) ); \ - sigerr_c ( "SPICE(STRINGTOOSHORT)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - - /* - Definitions for Cells and Sets - */ - - - /* - Cell initialization macros - */ - #define CELLINIT( cellPtr ) \ - \ - if ( !( (cellPtr)->init ) ) \ - { \ - if ( (cellPtr)->dtype == SPICE_CHR ) \ - { \ - /* \ - Make sure all elements of the data array, including \ - the control area, start off null-terminated. We place \ - the null character in the final element of each string, \ - so as to avoid wiping out data that may have been \ - assigned to the data array prior to initialization. \ - */ \ - SpiceChar * sPtr; \ - SpiceInt i; \ - SpiceInt nmax; \ - \ - nmax = SPICE_CELL_CTRLSZ + (cellPtr)->size; \ - \ - for ( i = 1; i <= nmax; i++ ) \ - { \ - sPtr = (SpiceChar *)((cellPtr)->base) \ - + i * (cellPtr)->length \ - - 1; \ - \ - *sPtr = NULLCHAR; \ - } \ - } \ - else \ - { \ - zzsynccl_c ( C2F, (cellPtr) ); \ - } \ - \ - (cellPtr)->init = SPICETRUE; \ - } - - - #define CELLINIT2( cellPtr1, cellPtr2 ) \ - \ - CELLINIT ( cellPtr1 ); \ - CELLINIT ( cellPtr2 ); - - - #define CELLINIT3( cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLINIT ( cellPtr1 ); \ - CELLINIT ( cellPtr2 ); \ - CELLINIT ( cellPtr3 ); - - - /* - Data type checking macros: - */ - #define CELLTYPECHK( errHandling, modname, dType, cellPtr1 ) \ - \ - if ( (cellPtr1)->dtype != (dType) ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; expected type " \ - "is #." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", typstr[ dType ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - - #define CELLTYPECHK_VAL( errHandling, modname, \ - dType, cellPtr1, retval ) \ - \ - if ( (cellPtr1)->dtype != (dType) ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; expected type " \ - "is #." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", typstr[ dType ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return (retval); \ - } \ - } - - - #define CELLTYPECHK2( errHandling, modname, dtype, \ - cellPtr1, cellPtr2 ) \ - \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr1 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr2 ); - - - - #define CELLTYPECHK2_VAL( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, retval ) \ - \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr1, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr2, \ - retval ); - - - - #define CELLTYPECHK3( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr1 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr2 ); \ - CELLTYPECHK( errHandling, modname, dtype, cellPtr3 ); - - - #define CELLTYPECHK3_VAL( errHandling, modname, dtype, \ - cellPtr1, cellPtr2, cellPtr3, \ - retval ) \ - \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr1, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr2, \ - retval ); \ - CELLTYPECHK_VAL( errHandling, modname, dtype, cellPtr3 \ - retval ); - - - - #define CELLMATCH2( errHandling, modname, cellPtr1, cellPtr2 ) \ - \ - if ( (cellPtr1)->dtype != (cellPtr2)->dtype ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; data type of # " \ - "is #, but types must match." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr[ (cellPtr1)->dtype ] ); \ - errch_c ( "#", (#cellPtr2) ); \ - errch_c ( "#", typstr[ (cellPtr2)->dtype ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - #define CELLMATCH2_VAL( errHandling, modname, \ - cellPtr1, cellPtr2, retval ) \ - \ - if ( (cellPtr1)->dtype != (cellPtr2)->dtype ) \ - { \ - SpiceChar * typstr[3] = \ - { \ - "character", "double precision", "integer" \ - }; \ - \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Data type of # is #; data type of # " \ - "is #, but types must match." ); \ - errch_c ( "#", (#cellPtr1) ); \ - errch_c ( "#", typstr [ (cellPtr1)->dtype ] ); \ - errch_c ( "#", (#cellPtr2) ); \ - errch_c ( "#", typstr [ (cellPtr2)->dtype ] ); \ - sigerr_c ( "SPICE(TYPEMISMATCH)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return ( retval ); \ - } \ - } - - - #define CELLMATCH3( errHandling, modname, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLMATCH2 ( errHandling, modname, cellPtr1, cellPtr2 ); \ - CELLMATCH2 ( errHandling, modname, cellPtr2, cellPtr3 ); - - - - - #define CELLMATCH3_VAL( errHandling, modname, cellPtr1, \ - cellPtr2, cellPtr3, retval ) \ - \ - CELLMATCH2_VAL ( errHandling, modname, \ - cellPtr1, cellPtr2, retval ); \ - \ - CELLMATCH2_VAL ( errHandling, modname, \ - cellPtr2, cellPtr3, retval ); - - /* - Set checking macros: - */ - #define CELLISSETCHK( errHandling, modname, cellPtr1 ) \ - \ - if ( !(cellPtr1)->isSet ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Cell # must be sorted and have unique " \ - "values in order to be a CSPICE set. " \ - "The isSet flag in this cell is SPICEFALSE, " \ - "indicating the cell may have been modified " \ - "by a routine that doesn't preserve these " \ - "properties." ); \ - errch_c ( "#", (#cellPtr1) ); \ - sigerr_c ( "SPICE(NOTASET)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return; \ - } \ - } - - - #define CELLISSETCHK_VAL( errHandling, modname, \ - cellPtr1, retval ) \ - \ - if ( !(cellPtr1)->isSet ) \ - { \ - if ( (errHandling) == CHK_DISCOVER ) \ - { \ - chkin_c ( modname ); \ - } \ - \ - setmsg_c ( "Cell # must be sorted and have unique " \ - "values in order to be a CSPICE set. " \ - "The isSet flag in this cell is SPICEFALSE, " \ - "indicating the cell may have been modified " \ - "by a routine that doesn't preserve these " \ - "properties." ); \ - errch_c ( "#", (#cellPtr1) ); \ - sigerr_c ( "SPICE(NOTASET)" ); \ - \ - if ( ( (errHandling) == CHK_DISCOVER ) \ - || ( (errHandling) == CHK_STANDARD ) ) \ - { \ - chkout_c ( modname ); \ - return (retval); \ - } \ - } - - - #define CELLISSETCHK2( errHandling, modname, \ - cellPtr1, cellPtr2 ) \ - \ - CELLISSETCHK( errHandling, modname, cellPtr1 ); \ - CELLISSETCHK( errHandling, modname, cellPtr2 ); - - - - #define CELLISSETCHK2_VAL( errHandling, modname, \ - cellPtr1, cellPtr2, retval ) \ - \ - CELLISSETCHK_VAL( errHandling, modname, cellPtr1, retval ); \ - CELLISSETCHK_VAL( errHandling, modname, cellPtr2, retval ); \ - - - - #define CELLISSETCHK3( errHandling, modname, \ - cellPtr1, cellPtr2, cellPtr3 ) \ - \ - CELLISSETCHK ( errHandling, modname, cellPtr1 ); \ - CELLISSETCHK ( errHandling, modname, cellPtr2 ); \ - CELLISSETCHK ( errHandling, modname, cellPtr3 ); - - - #define CELLISSETCHK3_VAL( errHandling, modname, cellPtr1, \ - cellPtr2, cellPtr3, retval ) \ - \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr1, retval ); \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr2, retval ); \ - CELLISSETCHK_VAL ( errHandling, modname, cellPtr3, retval ); - - - /* - C-to-Fortran and Fortran-to-C character cell translation macros: - */ - - /* - Macros that map one or more character C cells to dynamically - allocated Fortran-style character cells: - */ - #define C2F_MAP_CELL( caller, CCell, fCell, fLen ) \ - \ - { \ - /* \ - fCell and fLen are to be passed by reference, as if this \ - macro were a function. \ - \ - \ - Caution: dynamically allocates array fCell, which is to be \ - freed by caller! \ - */ \ - SpiceInt ndim; \ - SpiceInt lenvals; \ - \ - \ - ndim = (CCell)->size + SPICE_CELL_CTRLSZ; \ - lenvals = (CCell)->length; \ - \ - C2F_MapFixStrArr ( (caller), ndim, lenvals, \ - (CCell)->base, (fLen), (fCell) ); \ - \ - if ( !failed_c() ) \ - { \ - /* \ - Explicitly set the control area info in the Fortran cell.\ - */ \ - ssizec_ ( ( integer * ) &((CCell)->size), \ - ( char * ) *(fCell), \ - ( ftnlen ) *(fLen) ); \ - \ - scardc_ ( ( integer * ) &((CCell)->card), \ - ( char * ) *(fCell), \ - ( ftnlen ) *(fLen) ); \ - \ - if ( failed_c() ) \ - { \ - /* \ - Setting size or cardinality of the Fortran cell \ - can fail, for example if the cell's string length \ - is too short. \ - */ \ - free ( *(fCell) ); \ - } \ - } \ - } - - - #define C2F_MAP_CELL2( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2 ) \ - \ - { \ - C2F_MAP_CELL( caller, CCell1, fCell1, fLen1 ); \ - \ - if ( !failed_c() ) \ - { \ - C2F_MAP_CELL( caller, CCell2, fCell2, fLen2 ); \ - \ - if ( failed_c() ) \ - { \ - free ( *(fCell1) ); \ - } \ - } \ - } - - - #define C2F_MAP_CELL3( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2, \ - CCell3, fCell3, fLen3 ) \ - \ - { \ - C2F_MAP_CELL2( caller, CCell1, fCell1, fLen1, \ - CCell2, fCell2, fLen2 ); \ - \ - if ( !failed_c() ) \ - { \ - C2F_MAP_CELL( caller, CCell3, fCell3, fLen3 ); \ - \ - if ( failed_c() ) \ - { \ - free ( *(fCell1) ); \ - free ( *(fCell2) ); \ - } \ - } \ - } - - - - /* - Macro that maps a Fortran-style character cell to a C cell - (Note: this macro frees the Fortran cell): - */ - - #define F2C_MAP_CELL( fCell, fLen, CCell ) \ - \ - { \ - SpiceInt card; \ - SpiceInt lenvals; \ - SpiceInt ndim; \ - SpiceInt nBytes; \ - SpiceInt size; \ - void * array; \ - \ - ndim = (CCell)->size + SPICE_CELL_CTRLSZ; \ - lenvals = (CCell)->length; \ - array = (CCell)->base; \ - \ - /* \ - Capture the size and cardinality of the Fortran cell. \ - */ \ - if ( !failed_c() ) \ - { \ - size = sizec_ ( ( char * ) (fCell), \ - ( ftnlen ) fLen ); \ - \ - card = cardc_ ( ( char * ) (fCell), \ - ( ftnlen ) fLen ); \ - } \ - \ - \ - /* \ - Copy the Fortran array into the output array. \ - */ \ - \ - nBytes = ndim * fLen * sizeof(SpiceChar); \ - memmove ( array, fCell, nBytes ); \ - /* \ - Convert the output array from Fortran to C style. \ - */ \ - F2C_ConvertTrStrArr ( ndim, lenvals, (SpiceChar *)array ); \ - \ - /* \ - Sync the size and cardinality of the C cell. \ - */ \ - if ( !failed_c() ) \ - { \ - (CCell)->size = size; \ - (CCell)->card = card; \ - } \ - } - - - -/* - End of header SpiceZmc.h -*/ diff --git a/ext/spice/src/csupport/SpiceZpl.h b/ext/spice/src/csupport/SpiceZpl.h deleted file mode 100644 index 1413202b69..0000000000 --- a/ext/spice/src/csupport/SpiceZpl.h +++ /dev/null @@ -1,109 +0,0 @@ -/* - --Header_File SpiceZpl.h ( CSPICE platform macros ) - --Abstract - - Define macros identifying the host platform for which this - version of CSPICE is targeted. - --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. - --Literature_References - - None. - --Particulars - - This header file defines macros that enable CSPICE code to be - compiled conditionally based on the identity of the host platform. - - The macros defined here ARE visible in the macro name space of - any file that includes SpiceUsr.h. The names are prefixed with - the string CSPICE_ to help prevent conflicts with macros defined - by users' applications. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 2.2.0, 14-MAY-2010 (EDW)(BVS) - - Updated for the: - - MAC-OSX-64BIT-INTEL_C - PC-64BIT-MS_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - SUN-SOLARIS-INTEL-CC_C - - environments. - - -CSPICE Version 2.1.0, 15-NOV-2006 (BVS) - - Updated for MAC-OSX-INTEL_C environment. - - -CSPICE Version 2.0.0, 21-FEB-2006 (NJB) - - Updated for PC-LINUX-64BIT-GCC_C environment. - - -CSPICE Version 1.3.0, 06-MAR-2005 (NJB) - - Updated for SUN-SOLARIS-64BIT-GCC_C environment. - - -CSPICE Version 1.2.0, 03-JAN-2005 (BVS) - - Updated for PC-CYGWIN_C environment. - - -CSPICE Version 1.1.0, 27-JUL-2002 (BVS) - - Updated for MAC-OSX-NATIVE_C environment. - - -CSPICE Version 1.0.0, 26-FEB-1999 (NJB) (EDW) - --Index_Entries - - platform ID defines for CSPICE - -*/ - - -#ifndef HAVE_PLATFORM_MACROS_H -#define HAVE_PLATFORM_MACROS_H - - - #define CSPICE_PC_LINUX_64BIT_GCC - -#endif - diff --git a/ext/spice/src/csupport/SpiceZpr.h b/ext/spice/src/csupport/SpiceZpr.h deleted file mode 100644 index b4d672e98c..0000000000 --- a/ext/spice/src/csupport/SpiceZpr.h +++ /dev/null @@ -1,3853 +0,0 @@ -/* - --Header_File SpiceZpr.h ( CSPICE prototypes ) - --Abstract - - Define prototypes for CSPICE user-interface-level functions. - --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. - --Literature_References - - None. - --Particulars - - This is the header file containing prototypes for CSPICE user-level - C routines. Prototypes for the underlying f2c'd SPICELIB routines - are contained in the separate header file SpiceZfc. However, those - routines are not part of the official CSPICE API. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - W.L. Taber (JPL) - F.S. Turner (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 12.12.0, 19-FEB-2010 (EDW) (NJB) - - Added prototypes for - - bodc2s_c - dafgsr_c - dafrfr_c - dp2hx_c - ducrss_c - dvcrss_c - dvnorm_c - gfrr_c - gfuds_c - hx2dp_c - uddc_c - uddf_c - - -CSPICE Version 12.11.0, 29-MAR-2009 (EDW) (NJB) - - Added prototypes for - - dvsep_c - gfbail_c - gfclrh_c - gfdist_c - gfevnt_c - gffove_c - gfinth_c - gfocce_c - gfoclt_c - gfposc_c - gfrefn_c - gfrepf_c - gfrepi_c - gfrepu_c - gfrfov_c - gfsep_c - gfseth_c - gfsntc_c - gfsstp_c - gfstep_c - gfsubc_c - gftfov_c - surfpv_c - zzgfgeth_c - zzgfsavh_c - - -CSPICE Version 12.10.0, 30-JAN-2008 (EDW) (NJB) - - Added prototypes for: - - ilumin_c - pckcov_c - pckfrm_c - sincpt_c - spkacs_c - spkaps_c - spkltc_c - subpnt_c - subslr_c - wncard_c - - -CSPICE Version 12.9.0, 16-NOV-2006 (NJB) - - Bug fix: corrected prototype for vhatg_c. - - Renamed wnfild_c and wnfltd_c arguments `small' to 'smal' for - compatibility with MS Visual C++. - - Added prototypes for - - dafac_c - dafdc_c - dafec_c - dafgda_c - dascls_c - dasopr_c - kclear_c - - -CSPICE Version 12.8.0, 07-NOV-2005 (NJB) - - Added prototypes for - - bodvcd_c - qdq2av_c - qxq_c - srfrec_c - - -CSPICE Version 12.7.0, 06-JAN-2004 (NJB) - - Added prototypes for - - bods2c_c - ckcov_c - ckobj_c - dafopw_c - dafrs_c - dpgrdr_c - drdpgr_c - lspcn_c - pgrrec_c - recpgr_c - spkcov_c - spkobj_c - - -CSPICE Version 12.6.0, 24-FEB-2003 (NJB) - - Added prototype for - - bodvrd_c - deltet_c - srfxpt_c - - -CSPICE Version 12.5.0, 14-MAY-2003 (NJB) - - Removed prototype for getcml_. - - - -CSPICE Version 12.4.0, 25-FEB-2003 (NJB) - - Added prototypes for - - dasac_c - dasec_c - et2lst_c - - -CSPICE Version 12.3.0, 03-SEP-2002 (NJB) - - Added prototypes for - - appndc_c - appndd_c - appndi_c - bschoc_c - bschoi_c - bsrchc_c - bsrchd_c - bsrchi_c - card_c - ckw05_c - copy_c - cpos_c - cposr_c - diff_c - elemc_c - elemd_c - elemi_c - esrchc_c - insrtc_c - insrtd_c - insrti_c - inter_c - isordv_c - isrchc_c - isrchd_c - isrchi_c - lparss_c - lstlec_c - lstled_c - lstlei_c - lstltc_c - lstltd_c - lstlti_c - lx4dec_c - lx4num_c - lx4sgn_c - lx4uns_c - lxqstr_c - ncpos_c - ncposr_c - ordc_c - ordd_c - ordi_c - orderc_c - orderd_c - orderi_c - pos_c - posr_c - prefix_c - remove_c - reordc_c - reordd_c - reordi_c - reordl_c - removc_c - removd_c - removi_c - repmc_c - repmct_c - repmd_c - repmf_c - repmi_c - repmot_c - scard_c - sdiff_c - set_c - shellc_c - shelld_c - shelli_c - size_c - scard_c - spkw18_c - ssize_c - union_c - valid_c - wncomd_c - wncond_c - wndifd_c - wnelmd_c - wnexpd_c - wnextd_c - wnfetd_c - wnfild_c - wnfltd_c - wnincd_c - wninsd_c - wnintd_c - wnreld_c - wnsumd_c - wnunid_c - wnvald_c - zzsynccl_c - - - -CSPICE Version 12.2.0, 23-OCT-2001 (NJB) - - Added prototypes for - - badkpv_c - dcyldr_c - dgeodr_c - dlatdr_c - drdcyl_c - drdgeo_c - drdlat_c - drdsph_c - dsphdr_c - ekacec_c - ekaced_c - ekacei_c - ekappr_c - ekbseg_c - ekccnt_c - ekcii_c - ekdelr_c - ekinsr_c - ekntab_c - ekrcec_c - ekrced_c - ekrcei_c - ektnam_c - ekucec_c - ekuced_c - ekucei_c - inelpl_c - invort_c - kxtrct_c - - Added const qualifier to input array arguments of - - conics_c - illum_c - pdpool_c - prop2b_c - q2m_c - spkuds_c - xposeg_c - - Added const qualifier to the return value of - - tkvrsn_c - - -CSPICE Version 12.1.0, 12-APR-2000 (FST) - - Added prototype for - - getfov_c - - -CSPICE Version 12.0.0, 22-MAR-2000 (NJB) - - Added prototypes for - - lparse_c - lparsm_c - spkw12_c - spkw13_c - - - -CSPICE Version 11.1.0, 17-DEC-1999 (WLT) - - Added prototype for - - dafrda_c - - -CSPICE Version 11.0.0, 07-OCT-1999 (NJB) (EDW) - - Changed ekaclc_c, ekacld_c, ekacli_c prototypes to make input - pointers const-qualified where appropriate. - - Changed prompt_c prototype to accommodate memory leak bug fix. - - Changed ekpsel_c prototype to be consistent with other interfaces - having string array outputs. - - Added prototypes for - - axisar_c - brcktd_c - brckti_c - cidfrm_c - cgv2el_c - clpool_c - cmprss_c - cnmfrm_c - convrt_c - cvpool_c - dafbbs_c - dafbfs_c - dafcls_c - dafcs_c - daffna_c - daffpa_c - dafgh_c - dafgn_c - dafgs_c - dafopr_c - dafps_c - dafus_c - diags2_c - dtpool_c - dvdot_c - dvhat_c - dvpool_c - edlimb_c - ekops_c - ekopw_c - eul2xf_c - ftncls_c - furnsh_c - getmsg_c - getelm_c - gnpool_c - ident_c - illum_c - inedpl_c - kdata_c - kinfo_c - ktotal_c - lmpool_c - matchi_c - matchw_c - maxd_c - maxi_c - mequ_c - mind_c - mini_c - moved_ - npedln_c - npelpt_c - nplnpt_c - pcpool_c - pdpool_c - pipool_c - pjelpl_c - pxform_c - rav2xf_c - raxisa_c - rquad_c - saelgv_c - spk14a_c - spk14b_c - spk14e_c - spkapp_c - spkapo_c - spkcls_c - spkezp_c - spkgps_c - spkopn_c - spkpds_c - spkpos_c - spkssb_c - spksub_c - spkuds_c - spkw02_c - spkw03_c - spkw05_c - spkw08_c - spkw09_c - spkw10_c - spkw15_c - spkw17_c - stpool_c - subpt_c - subsol_c - swpool_c - szpool_c - tparse_c - trace_c - unload_c - vaddg_c - vhatg_c - vlcomg_c - vminug_c - vrel_c - vrelg_c - vsepg_c - vtmv_c - vtmvg_c - vzerog_c - xf2eul_c - xf2rav_c - xposeg_c - - - -CSPICE Version 10.0.0, 09-MAR-1999 (NJB) - - Added prototypes for - - frame_c - inrypl_c - nvc2pl_c - nvp2pl_c - pl2nvc_c - pl2nvp_c - pl2psv_c - psv2pl_c - sce2c_c - vprjp_c - vprjpi_c - - Now conditionally includes SpiceEll.h and SpicePln.h. - - - -CSPICE Version 9.0.0, 25-FEB-1999 (NJB) - - Added prototypes for - - eknseg_c - eknelt_c - ekpsel_c - ekssum_c - - Now conditionally includes SpiceEK.h. - - - -CSPICE Version 8.0.0, 20-OCT-1998 (NJB) - - Added const qualifier to all input matrix and vector arguments. - - Added prototypes for - - det_c - dpmax_c - dpmax_ - dpmin_c - dpmin_ - frinfo_c - frmnam_c - getfat_c - intmax_c - intmax_ - intmin_c - intmin_ - invert_c - namfrm_c - vrotv_c - vsclg_c - - - -CSPICE Version 7.0.0, 02-APR-1998 (EDW) - - Added prototypes for - - mequg_c - unormg_g - vdistg_c - vdotg_c - vequg_c - vnormg_c - - -CSPICE Version 6.0.0, 31-MAR-1998 (NJB) - - Added prototypes for - - ekaclc_c - ekacld_c - ekacli_c - ekcls_c - ekffld_c - ekfind_c - ekgc_c - ekgd_c - ekgi_c - ekifld_c - eklef_c - ekopr_c - ekopn_c - ekuef_c - - -CSPICE Version 5.0.1, 05-MAR-1998 (EDW) - - Remove some non printing characters. - - -CSPICE Version 5.0.0, 03-MAR-1998 (NJB) - - Added prototypes for - - etcal_c - ltime_c - stelab_c - tpictr_c - twovec_c - vsubg_c - - -CSPICE Version 4.0.0, 11-FEB-1998 (EDW) - - Added prototypes for - - timdef_c - tsetyr_c - - - -CSPICE Version 3.0.0, 02-FEB-1998 (NJB) - - Added prototypes for - - pckuof_c - tipbod_c - - Type SpiceVoid was replaced with void. - - -CSPICE Version 2.0.0, 06-JAN-1998 (NJB) - - Changed all input-only character pointers to type ConstSpiceChar. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - prototypes of CSPICE functions - -*/ - - -/* -Include Files: -*/ - - -#ifndef HAVE_SPICEDEFS_H -#include "SpiceZdf.h" -#endif - -#ifndef HAVE_SPICE_EK_H -#include "SpiceEK.h" -#endif - -#ifndef HAVE_SPICE_PLANES_H -#include "SpicePln.h" -#endif - -#ifndef HAVE_SPICE_ELLIPSES_H -#include "SpiceEll.h" -#endif - -#ifndef HAVE_SPICE_CELLS_H -#include "SpiceCel.h" -#endif - -#ifndef HAVE_SPICE_SPK_H -#include "SpiceSPK.h" -#endif - -#ifndef HAVE_SPICEWRAPPERS_H -#define HAVE_SPICEWRAPPERS_H - - - - -/* - Function prototypes for CSPICE functions are listed below. - Each prototype is accompanied by a function abstract and brief I/O - description. - - See the headers of the C wrappers for detailed descriptions of the - routines' interfaces. - - The list below should be maintained in alphabetical order. -*/ - - void appndc_c ( ConstSpiceChar * item, - SpiceCell * cell ); - - - void appndd_c ( SpiceDouble item, - SpiceCell * cell ); - - - void appndi_c ( SpiceInt item, - SpiceCell * cell ); - - - void axisar_c ( ConstSpiceDouble axis [3], - SpiceDouble angle, - SpiceDouble r [3][3] ); - - - SpiceBoolean badkpv_c ( ConstSpiceChar *caller, - ConstSpiceChar *name, - ConstSpiceChar *comp, - SpiceInt size, - SpiceInt divby, - SpiceChar type ); - - - void bodc2n_c ( SpiceInt code, - SpiceInt namelen, - SpiceChar * name, - SpiceBoolean * found ); - - - void bodc2s_c ( SpiceInt code, - SpiceInt lenout, - SpiceChar * name ); - - void boddef_c ( ConstSpiceChar * name, - SpiceInt code ); - - - SpiceBoolean bodfnd_c ( SpiceInt body, - ConstSpiceChar * item ); - - - void bodn2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ); - - - void bods2c_c ( ConstSpiceChar * name, - SpiceInt * code, - SpiceBoolean * found ); - - - void bodvar_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt * dim , - SpiceDouble * values ); - - - void bodvcd_c ( SpiceInt body, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim , - SpiceDouble * values ); - - - void bodvrd_c ( ConstSpiceChar * body, - ConstSpiceChar * item, - SpiceInt maxn, - SpiceInt * dim , - SpiceDouble * values ); - - - SpiceDouble brcktd_c ( SpiceDouble number, - SpiceDouble end1, - SpiceDouble end2 ); - - - SpiceInt brckti_c ( SpiceInt number, - SpiceInt end1, - SpiceInt end2 ); - - - SpiceInt bschoc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array, - ConstSpiceInt * order ); - - - SpiceInt bschoi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array, - ConstSpiceInt * order ); - - - SpiceInt bsrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - SpiceInt bsrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ); - - - SpiceInt bsrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ); - - - SpiceDouble b1900_c ( void ); - - - SpiceDouble b1950_c ( void ); - - - SpiceInt card_c ( SpiceCell * cell ); - - - void cgv2el_c ( ConstSpiceDouble center[3], - ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceEllipse * ellipse ); - - - void chkin_c ( ConstSpiceChar * module ); - - - void chkout_c ( ConstSpiceChar * module ); - - - void cidfrm_c ( SpiceInt cent, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ); - - - void ckcls_c ( SpiceInt handle ); - - - void ckcov_c ( ConstSpiceChar * ck, - SpiceInt idcode, - SpiceBoolean needav, - ConstSpiceChar * level, - SpiceDouble tol, - ConstSpiceChar * timsys, - SpiceCell * cover ); - - - void ckobj_c ( ConstSpiceChar * ck, - SpiceCell * ids ); - - - void ckgp_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble * clkout, - SpiceBoolean * found ); - - - void ckgpav_c ( SpiceInt inst, - SpiceDouble sclkdp, - SpiceDouble tol, - ConstSpiceChar * ref, - SpiceDouble cmat[3][3], - SpiceDouble av[3], - SpiceDouble * clkout, - SpiceBoolean * found ); - - - void cklpf_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ckopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void ckupf_c ( SpiceInt handle ); - - - void ckw01_c ( SpiceInt handle, - SpiceDouble begtime, - SpiceDouble endtime, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3] ); - - - void ckw02_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble start [], - ConstSpiceDouble stop [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - ConstSpiceDouble rates [] ); - - - void ckw03_c ( SpiceInt handle, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt nrec, - ConstSpiceDouble sclkdp [], - ConstSpiceDouble quats [][4], - ConstSpiceDouble avvs [][3], - SpiceInt nints, - ConstSpiceDouble starts [] ); - - - void ckw05_c ( SpiceInt handle, - SpiceCK05Subtype subtyp, - SpiceInt degree, - SpiceDouble begtim, - SpiceDouble endtim, - SpiceInt inst, - ConstSpiceChar * ref, - SpiceBoolean avflag, - ConstSpiceChar * segid, - SpiceInt n, - ConstSpiceDouble sclkdp[], - const void * packets, - SpiceDouble rate, - SpiceInt nints, - ConstSpiceDouble starts[] ); - - - SpiceDouble clight_c ( void ); - - - void clpool_c ( void ); - - - void cmprss_c ( SpiceChar delim, - SpiceInt n, - ConstSpiceChar * input, - SpiceInt lenout, - SpiceChar * output ); - - - void cnmfrm_c ( ConstSpiceChar * cname, - SpiceInt lenout, - SpiceInt * frcode, - SpiceChar * frname, - SpiceBoolean * found ); - - - void conics_c ( ConstSpiceDouble elts[8], - SpiceDouble et, - SpiceDouble state[6] ); - - - void convrt_c ( SpiceDouble x, - ConstSpiceChar * in, - ConstSpiceChar * out, - SpiceDouble * y ); - - - void copy_c ( SpiceCell * a, - SpiceCell * b ); - - - - SpiceInt cpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - SpiceInt cposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - void cvpool_c ( ConstSpiceChar * agent, - SpiceBoolean * update ); - - - void cyllat_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ); - - - void cylrec_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble rectan[3] ); - - - void cylsph_c ( SpiceDouble r, - SpiceDouble lonc, - SpiceDouble z, - SpiceDouble * radius, - SpiceDouble * colat, - SpiceDouble * lon ); - - - void dafac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt lenvals, - const void * buffer ); - - - void dafbbs_c ( SpiceInt handle ); - - - void dafbfs_c ( SpiceInt handle ); - - - void dafcls_c ( SpiceInt handle ); - - - void dafcs_c ( SpiceInt handle ); - - - void dafdc_c ( SpiceInt handle ); - - - void dafec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt lenout, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ); - - - void daffna_c ( SpiceBoolean * found ); - - - void daffpa_c ( SpiceBoolean * found ); - - - void dafgda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ); - - - void dafgh_c ( SpiceInt * handle ); - - - void dafgn_c ( SpiceInt lenout, - SpiceChar * name ); - - - void dafgs_c ( SpiceDouble sum[] ); - - - void dafgsr_c ( SpiceInt handle, - SpiceInt recno, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data, - SpiceBoolean * found ); - - - void dafopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dafopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dafps_c ( SpiceInt nd, - SpiceInt ni, - ConstSpiceDouble dc [], - ConstSpiceInt ic [], - SpiceDouble sum [] ); - - - void dafrda_c ( SpiceInt handle, - SpiceInt begin, - SpiceInt end, - SpiceDouble * data ); - - - - void dafrfr_c ( SpiceInt handle, - SpiceInt lenout, - SpiceInt * nd, - SpiceInt * ni, - SpiceChar * ifname, - SpiceInt * fward, - SpiceInt * bward, - SpiceInt * free ); - - - - void dafrs_c ( ConstSpiceDouble * sum ); - - - void dafus_c ( ConstSpiceDouble sum [], - SpiceInt nd, - SpiceInt ni, - SpiceDouble dc [], - SpiceInt ic [] ); - - - void dasac_c ( SpiceInt handle, - SpiceInt n, - SpiceInt buflen, - const void * buffer ); - - - void dascls_c ( SpiceInt handle ); - - - void dasec_c ( SpiceInt handle, - SpiceInt bufsiz, - SpiceInt buflen, - SpiceInt * n, - void * buffer, - SpiceBoolean * done ); - - - void dasopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void dcyldr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void deltet_c ( SpiceDouble epoch, - ConstSpiceChar * eptype, - SpiceDouble * delta ); - - - SpiceDouble det_c ( ConstSpiceDouble m1[3][3] ); - - - void diags2_c ( ConstSpiceDouble symmat [2][2], - SpiceDouble diag [2][2], - SpiceDouble rotate [2][2] ); - - - void diff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void dgeodr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void dlatdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - void dp2hx_c ( SpiceDouble number, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * length - ); - - void dpgrdr_c ( ConstSpiceChar * body, - SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - SpiceDouble dpmax_c ( void ); - - - SpiceDouble dpmax_ ( void ); - - - SpiceDouble dpmin_c ( void ); - - - SpiceDouble dpmin_ ( void ); - - - SpiceDouble dpr_c ( void ); - - - void drdcyl_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void drdgeo_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void drdlat_c ( SpiceDouble r, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble jacobi[3][3] ); - - - void drdpgr_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble jacobi[3][3] ); - - - void drdsph_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble jacobi[3][3] ); - - - void dsphdr_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble jacobi[3][3] ); - - - void dtpool_c ( ConstSpiceChar * name, - SpiceBoolean * found, - SpiceInt * n, - SpiceChar type [1] ); - - - void ducrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ); - - - void dvcrss_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6], - SpiceDouble sout[6] ); - - - SpiceDouble dvdot_c ( ConstSpiceDouble s1 [6], - ConstSpiceDouble s2 [6] ); - - - void dvhat_c ( ConstSpiceDouble s1 [6], - SpiceDouble sout[6] ); - - SpiceDouble dvnorm_c ( ConstSpiceDouble state[6] ); - - void dvpool_c ( ConstSpiceChar * name ); - - - SpiceDouble dvsep_c ( ConstSpiceDouble * s1, - ConstSpiceDouble * s2 ); - - - void edlimb_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble viewpt[3], - SpiceEllipse * limb ); - - - void ekacec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ); - - - void ekaced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ); - - - void ekacei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ); - - - void ekaclc_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - SpiceInt vallen, - const void * cvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekacld_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceDouble * dvals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekacli_c ( SpiceInt handle, - SpiceInt segno, - ConstSpiceChar * column, - ConstSpiceInt * ivals, - ConstSpiceInt * entszs, - ConstSpiceBoolean * nlflgs, - ConstSpiceInt * rcptrs, - SpiceInt * wkindx ); - - - void ekappr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * recno ); - - - void ekbseg_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno ); - - - void ekccnt_c ( ConstSpiceChar * table, - SpiceInt * ccount ); - - - void ekcii_c ( ConstSpiceChar * table, - SpiceInt cindex, - SpiceInt lenout, - SpiceChar * column, - SpiceEKAttDsc * attdsc ); - - - void ekcls_c ( SpiceInt handle ); - - - void ekdelr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ); - - - void ekffld_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt * rcptrs ); - - - void ekfind_c ( ConstSpiceChar * query, - SpiceInt lenout, - SpiceInt * nmrows, - SpiceBoolean * error, - SpiceChar * errmsg ); - - - void ekgc_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt lenout, - SpiceChar * cdata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekgd_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceDouble * ddata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekgi_c ( SpiceInt selidx, - SpiceInt row, - SpiceInt elment, - SpiceInt * idata, - SpiceBoolean * null, - SpiceBoolean * found ); - - - void ekifld_c ( SpiceInt handle, - ConstSpiceChar * tabnam, - SpiceInt ncols, - SpiceInt nrows, - SpiceInt cnmlen, - const void * cnames, - SpiceInt declen, - const void * decls, - SpiceInt * segno, - SpiceInt * rcptrs ); - - - void ekinsr_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno ); - - - void eklef_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - SpiceInt eknelt_c ( SpiceInt selidx, - SpiceInt row ); - - - SpiceInt eknseg_c ( SpiceInt handle ); - - - void ekntab_c ( SpiceInt * n ); - - - void ekopn_c ( ConstSpiceChar * fname, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void ekopr_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ekops_c ( SpiceInt * handle ); - - - void ekopw_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void ekpsel_c ( ConstSpiceChar * query, - SpiceInt msglen, - SpiceInt tablen, - SpiceInt collen, - SpiceInt * n, - SpiceInt * xbegs, - SpiceInt * xends, - SpiceEKDataType * xtypes, - SpiceEKExprClass * xclass, - void * tabs, - void * cols, - SpiceBoolean * error, - SpiceChar * errmsg ); - - - void ekrcec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt lenout, - SpiceInt * nvals, - void * cvals, - SpiceBoolean * isnull ); - - - void ekrced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceDouble * dvals, - SpiceBoolean * isnull ); - - - void ekrcei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt * nvals, - SpiceInt * ivals, - SpiceBoolean * isnull ); - - - void ekssum_c ( SpiceInt handle, - SpiceInt segno, - SpiceEKSegSum * segsum ); - - - void ektnam_c ( SpiceInt n, - SpiceInt lenout, - SpiceChar * table ); - - - void ekucec_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - SpiceInt vallen, - const void * cvals, - SpiceBoolean isnull ); - - - void ekuced_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceDouble * dvals, - SpiceBoolean isnull ); - - - void ekucei_c ( SpiceInt handle, - SpiceInt segno, - SpiceInt recno, - ConstSpiceChar * column, - SpiceInt nvals, - ConstSpiceInt * ivals, - SpiceBoolean isnull ); - - - void ekuef_c ( SpiceInt handle ); - - - SpiceBoolean elemc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - SpiceBoolean elemd_c ( SpiceDouble item, - SpiceCell * set ); - - - SpiceBoolean elemi_c ( SpiceInt item, - SpiceCell * set ); - - - SpiceBoolean eqstr_c ( ConstSpiceChar * a, - ConstSpiceChar * b ); - - - void el2cgv_c ( ConstSpiceEllipse * ellipse, - SpiceDouble center[3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ); - - - void erract_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * action ); - - - void errch_c ( ConstSpiceChar * marker, - ConstSpiceChar * string ); - - - void errdev_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * device ); - - - void errdp_c ( ConstSpiceChar * marker, - SpiceDouble number ); - - - void errint_c ( ConstSpiceChar * marker, - SpiceInt number ); - - - void errprt_c ( ConstSpiceChar * operation, - SpiceInt lenout, - SpiceChar * list ); - - - SpiceInt esrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - void etcal_c ( SpiceDouble et, - SpiceInt lenout, - SpiceChar * string ); - - - void et2lst_c ( SpiceDouble et, - SpiceInt body, - SpiceDouble lon, - ConstSpiceChar * type, - SpiceInt timlen, - SpiceInt ampmlen, - SpiceInt * hr, - SpiceInt * mn, - SpiceInt * sc, - SpiceChar * time, - SpiceChar * ampm ); - - - void et2utc_c ( SpiceDouble et , - ConstSpiceChar * format, - SpiceInt prec, - SpiceInt lenout, - SpiceChar * utcstr ); - - - void eul2m_c ( SpiceDouble angle3, - SpiceDouble angle2, - SpiceDouble angle1, - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble r [3][3] ); - - - void eul2xf_c ( ConstSpiceDouble eulang[6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble xform [6][6] ); - - - SpiceBoolean exists_c ( ConstSpiceChar * name ); - - - void expool_c ( ConstSpiceChar * name, - SpiceBoolean * found ); - - - SpiceBoolean failed_c ( void ); - - - void frame_c ( SpiceDouble x[3], - SpiceDouble y[3], - SpiceDouble z[3] ); - - - void frinfo_c ( SpiceInt frcode, - SpiceInt * cent, - SpiceInt * clss, - SpiceInt * clssid, - SpiceBoolean * found ); - - - void frmnam_c ( SpiceInt frcode, - SpiceInt lenout, - SpiceChar * frname ); - - - void ftncls_c ( SpiceInt unit ); - - - void furnsh_c ( ConstSpiceChar * file ); - - - void gcpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * cvals, - SpiceBoolean * found ); - - - void gdpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceDouble * values, - SpiceBoolean * found ); - - - void georec_c ( SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ); - - - void getcml_c ( SpiceInt * argc, - SpiceChar *** argv ); - - - void getelm_c ( SpiceInt frstyr, - SpiceInt lineln, - const void * lines, - SpiceDouble * epoch, - SpiceDouble * elems ); - - - void getfat_c ( ConstSpiceChar * file, - SpiceInt arclen, - SpiceInt typlen, - SpiceChar * arch, - SpiceChar * type ); - - - void getfov_c ( SpiceInt instid, - SpiceInt room, - SpiceInt shapelen, - SpiceInt framelen, - SpiceChar * shape, - SpiceChar * frame, - SpiceDouble bsight [3], - SpiceInt * n, - SpiceDouble bounds [][3] ); - - - void getmsg_c ( ConstSpiceChar * option, - SpiceInt lenout, - SpiceChar * msg ); - - - SpiceBoolean gfbail_c ( void ); - - - void gfclrh_c ( void ); - - - void gfdist_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gfevnt_c ( void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - ConstSpiceChar * gquant, - SpiceInt qnpars, - SpiceInt lenvals, - const void * qpnams, - const void * qcpars, - ConstSpiceDouble * qdpars, - ConstSpiceInt * qipars, - ConstSpiceBoolean * qlpars, - ConstSpiceChar * op, - SpiceDouble refval, - SpiceDouble tol, - SpiceDouble adjust, - SpiceBoolean rpt, - - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - - void ( * udrepf ) ( void ), - SpiceInt nintvls, - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gffove_c ( ConstSpiceChar * inst, - ConstSpiceChar * tshape, - ConstSpiceDouble raydir [3], - ConstSpiceChar * target, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfinth_c ( int sigcode ); - - - void gfocce_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * obsrvr, - ConstSpiceChar * abcorr, - SpiceDouble tol, - void ( * udstep ) ( SpiceDouble et, - SpiceDouble * step ), - void ( * udrefn ) ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ), - SpiceBoolean rpt, - void ( * udrepi ) ( SpiceCell * cnfine, - ConstSpiceChar * srcpre, - ConstSpiceChar * srcsuf ), - void ( * udrepu ) ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble et ), - void ( * udrepf ) ( void ), - SpiceBoolean bail, - SpiceBoolean ( * udbail ) ( void ), - SpiceCell * cnfine, - SpiceCell * result ); - - - - void gfoclt_c ( ConstSpiceChar * occtyp, - ConstSpiceChar * front, - ConstSpiceChar * fshape, - ConstSpiceChar * fframe, - ConstSpiceChar * back, - ConstSpiceChar * bshape, - ConstSpiceChar * bframe, - ConstSpiceChar * obsrvr, - ConstSpiceChar * abcorr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfposc_c ( ConstSpiceChar * target, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfrefn_c ( SpiceDouble t1, - SpiceDouble t2, - SpiceBoolean s1, - SpiceBoolean s2, - SpiceDouble * t ); - - - void gfrepf_c ( void ); - - - void gfrepi_c ( SpiceCell * window, - ConstSpiceChar * begmss, - ConstSpiceChar * endmss ); - - - void gfrepu_c ( SpiceDouble ivbeg, - SpiceDouble ivend, - SpiceDouble time ); - - - void gfrfov_c ( ConstSpiceChar * inst, - ConstSpiceDouble raydir [3], - ConstSpiceChar * rframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfrr_c ( ConstSpiceChar * target, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsep_c ( ConstSpiceChar * targ1, - ConstSpiceChar * frame1, - ConstSpiceChar * shape1, - ConstSpiceChar * targ2, - ConstSpiceChar * frame2, - ConstSpiceChar * shape2, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsntc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfsstp_c ( SpiceDouble step ); - - - void gfstep_c ( SpiceDouble time, - SpiceDouble * step ); - - - void gfsubc_c ( ConstSpiceChar * target, - ConstSpiceChar * fixref, - ConstSpiceChar * method, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * crdsys, - ConstSpiceChar * coord, - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gftfov_c ( ConstSpiceChar * inst, - ConstSpiceChar * target, - ConstSpiceChar * tshape, - ConstSpiceChar * tframe, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble step, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gfuds_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - - void ( * udqdec ) ( void ( * udfunc ) - ( SpiceDouble x, - SpiceDouble * value ), - - SpiceDouble x, - SpiceBoolean * isdecr ), - - ConstSpiceChar * relate, - SpiceDouble refval, - SpiceDouble adjust, - SpiceDouble step, - SpiceInt nintvls, - SpiceCell * cnfine, - SpiceCell * result ); - - - void gipool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt * n, - SpiceInt * ivals, - SpiceBoolean * found ); - - - void gnpool_c ( ConstSpiceChar * name, - SpiceInt start, - SpiceInt room, - SpiceInt lenout, - SpiceInt * n, - void * kvars, - SpiceBoolean * found ); - - - SpiceDouble halfpi_c ( void ); - - void hx2dp_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * number, - SpiceBoolean * error, - SpiceChar * errmsg - ); - - - void ident_c ( SpiceDouble matrix[3][3] ); - - - void ilumin_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ); - - - void illum_c ( ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceDouble spoint [3], - SpiceDouble * phase, - SpiceDouble * solar, - SpiceDouble * emissn ); - - - void inedpl_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpicePlane * plane, - SpiceEllipse * ellipse, - SpiceBoolean * found ); - - - void inelpl_c ( ConstSpiceEllipse * ellips, - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt1[3], - SpiceDouble xpt2[3] ); - - - void insrtc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - void insrtd_c ( SpiceDouble item, - SpiceCell * set ); - - - void insrti_c ( SpiceInt item, - SpiceCell * set ); - - - void inter_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void inrypl_c ( ConstSpiceDouble vertex [3], - ConstSpiceDouble dir [3], - ConstSpicePlane * plane, - SpiceInt * nxpts, - SpiceDouble xpt [3] ); - - - SpiceInt intmax_c ( void ); - - - SpiceInt intmax_ ( void ); - - - SpiceInt intmin_c ( void ); - - - SpiceInt intmin_ ( void ); - - - void invert_c ( ConstSpiceDouble m1[3][3], - SpiceDouble m2[3][3] ); - - - void invort_c ( ConstSpiceDouble m [3][3], - SpiceDouble mit[3][3] ); - - - SpiceBoolean isordv_c ( ConstSpiceInt * array, - SpiceInt n ); - - - SpiceBoolean isrot_c ( ConstSpiceDouble m [3][3], - SpiceDouble ntol, - SpiceDouble dtol ); - - - - SpiceInt isrchc_c ( ConstSpiceChar * value, - SpiceInt ndim, - SpiceInt lenvals, - const void * array ); - - - SpiceInt isrchd_c ( SpiceDouble value, - SpiceInt ndim, - ConstSpiceDouble * array ); - - - SpiceInt isrchi_c ( SpiceInt value, - SpiceInt ndim, - ConstSpiceInt * array ); - - - SpiceBoolean iswhsp_c ( ConstSpiceChar * string ); - - - SpiceDouble j1900_c ( void ); - - - SpiceDouble j1950_c ( void ); - - - SpiceDouble j2000_c ( void ); - - - SpiceDouble j2100_c ( void ); - - - SpiceDouble jyear_c ( void ); - - - void kclear_c ( void ); - - - void kdata_c ( SpiceInt which, - ConstSpiceChar * kind, - SpiceInt fillen, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * file, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ); - - - void kinfo_c ( ConstSpiceChar * file, - SpiceInt typlen, - SpiceInt srclen, - SpiceChar * filtyp, - SpiceChar * source, - SpiceInt * handle, - SpiceBoolean * found ); - - - void ktotal_c ( ConstSpiceChar * kind, - SpiceInt * count ); - - - void kxtrct_c ( ConstSpiceChar * keywd, - SpiceInt termlen, - const void * terms, - SpiceInt nterms, - SpiceInt stringlen, - SpiceInt substrlen, - SpiceChar * string, - SpiceBoolean * found, - SpiceChar * substr ); - - - SpiceInt lastnb_c ( ConstSpiceChar * string ); - - - void latcyl_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * r, - SpiceDouble * lonc, - SpiceDouble * z ); - - - void latrec_c ( SpiceDouble radius, - SpiceDouble longitude, - SpiceDouble latitude, - SpiceDouble rectan [3] ); - - - void latsph_c ( SpiceDouble radius, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble * rho, - SpiceDouble * colat, - SpiceDouble * lons ); - - - void lcase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ); - - - void ldpool_c ( ConstSpiceChar * filename ); - - - void lmpool_c ( const void * cvals, - SpiceInt lenvals, - SpiceInt n ); - - - void lparse_c ( ConstSpiceChar * list, - ConstSpiceChar * delim, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ); - - - void lparsm_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceInt nmax, - SpiceInt lenout, - SpiceInt * n, - void * items ); - - - void lparss_c ( ConstSpiceChar * list, - ConstSpiceChar * delims, - SpiceCell * set ); - - - SpiceDouble lspcn_c ( ConstSpiceChar * body, - SpiceDouble et, - ConstSpiceChar * abcorr ); - - - SpiceInt lstlec_c ( ConstSpiceChar * string, - SpiceInt n, - SpiceInt lenvals, - const void * array ); - - - SpiceInt lstled_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ); - - - SpiceInt lstlei_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ); - - - SpiceInt lstltc_c ( ConstSpiceChar * string, - SpiceInt n, - SpiceInt lenvals, - const void * array ); - - - SpiceInt lstltd_c ( SpiceDouble x, - SpiceInt n, - ConstSpiceDouble * array ); - - - SpiceInt lstlti_c ( SpiceInt x, - SpiceInt n, - ConstSpiceInt * array ); - - - void ltime_c ( SpiceDouble etobs, - SpiceInt obs, - ConstSpiceChar * dir, - SpiceInt targ, - SpiceDouble * ettarg, - SpiceDouble * elapsd ); - - - void lx4dec_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4num_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4sgn_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lx4uns_c ( ConstSpiceChar * string, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void lxqstr_c ( ConstSpiceChar * string, - SpiceChar qchar, - SpiceInt first, - SpiceInt * last, - SpiceInt * nchar ); - - - void m2eul_c ( ConstSpiceDouble r[3][3], - SpiceInt axis3, - SpiceInt axis2, - SpiceInt axis1, - SpiceDouble * angle3, - SpiceDouble * angle2, - SpiceDouble * angle1 ); - - - void m2q_c ( ConstSpiceDouble r[3][3], - SpiceDouble q[4] ); - - - - SpiceBoolean matchi_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ); - - - SpiceBoolean matchw_c ( ConstSpiceChar * string, - ConstSpiceChar * templ, - SpiceChar wstr, - SpiceChar wchr ); - - - SpiceDouble maxd_c ( SpiceInt n, - ... ); - - - SpiceInt maxi_c ( SpiceInt n, - ... ); - - - void mequ_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ); - - - void mequg_c ( const void * m1, - SpiceInt nr, - SpiceInt nc, - void * mout ); - - - SpiceDouble mind_c ( SpiceInt n, - ... ); - - - SpiceInt mini_c ( SpiceInt n, - ... ); - - - int moved_ ( SpiceDouble * arrfrm, - SpiceInt * ndim, - SpiceDouble * arrto ); - - - void mtxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mtxmg_c ( const void * m1, - const void * m2, - SpiceInt row1, - SpiceInt col1, - SpiceInt col2, - void * mout ); - - - void mtxv_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble vin [3], - SpiceDouble vout[3] ); - - - void mtxvg_c ( const void * m1, - const void * v2, - SpiceInt ncol1, - SpiceInt nr1r2, - void * vout ); - - - void mxm_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mxmg_c ( const void * m1, - const void * m2, - SpiceInt row1, - SpiceInt col1, - SpiceInt col2, - void * mout ); - - - void mxmt_c ( ConstSpiceDouble m1 [3][3], - ConstSpiceDouble m2 [3][3], - SpiceDouble mout[3][3] ); - - - void mxmtg_c ( const void * m1, - const void * m2, - SpiceInt nrow1, - SpiceInt nc1c2, - SpiceInt nrow2, - void * mout ); - - - void mxv_c ( ConstSpiceDouble m1[3][3], - ConstSpiceDouble vin[3], - SpiceDouble vout[3] ); - - - void mxvg_c ( const void * m1, - const void * v2, - SpiceInt nrow1, - SpiceInt nc1r2, - void * vout ); - - - void namfrm_c ( ConstSpiceChar * frname, - SpiceInt * frcode ); - - - SpiceInt ncpos_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - SpiceInt ncposr_c ( ConstSpiceChar * str, - ConstSpiceChar * chars, - SpiceInt start ); - - - void nearpt_c ( ConstSpiceDouble positn[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble npoint[3], - SpiceDouble * alt ); - - - void npedln_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble linept[3], - ConstSpiceDouble linedr[3], - SpiceDouble pnear[3], - SpiceDouble * dist ); - - - void npelpt_c ( ConstSpiceDouble point[3], - ConstSpiceEllipse * ellips, - SpiceDouble pnear[3], - SpiceDouble * dist ); - - - void nplnpt_c ( ConstSpiceDouble linpt [3], - ConstSpiceDouble lindir [3], - ConstSpiceDouble point [3], - SpiceDouble pnear [3], - SpiceDouble * dist ); - - - void nvc2pl_c ( ConstSpiceDouble normal[3], - SpiceDouble constant, - SpicePlane * plane ); - - - void nvp2pl_c ( ConstSpiceDouble normal[3], - ConstSpiceDouble point[3], - SpicePlane * plane ); - - - SpiceInt ordc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - SpiceInt ordd_c ( SpiceDouble item, - SpiceCell * set ); - - - SpiceInt ordi_c ( SpiceInt item, - SpiceCell * set ); - - - void orderc_c ( SpiceInt lenvals, - const void * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void orderd_c ( ConstSpiceDouble * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void orderi_c ( ConstSpiceInt * array, - SpiceInt ndim, - SpiceInt * iorder ); - - - void oscelt_c ( ConstSpiceDouble state[6], - SpiceDouble et , - SpiceDouble mu , - SpiceDouble elts[8] ); - - - void pckcov_c ( ConstSpiceChar * pck, - SpiceInt idcode, - SpiceCell * cover ); - - - void pckfrm_c ( ConstSpiceChar * pck, - SpiceCell * ids ); - - - void pcklof_c ( ConstSpiceChar * fname, - SpiceInt * handle ); - - - void pckuof_c ( SpiceInt handle ); - - - void pcpool_c ( ConstSpiceChar * name, - SpiceInt n, - SpiceInt lenvals, - const void * cvals ); - - - void pdpool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceDouble * dvals ); - - - void pgrrec_c ( ConstSpiceChar * body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble alt, - SpiceDouble re, - SpiceDouble f, - SpiceDouble rectan[3] ); - - - SpiceDouble pi_c ( void ); - - - void pipool_c ( ConstSpiceChar * name, - SpiceInt n, - ConstSpiceInt * ivals ); - - - void pjelpl_c ( ConstSpiceEllipse * elin, - ConstSpicePlane * plane, - SpiceEllipse * elout ); - - - void pl2nvc_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble * constant ); - - - void pl2nvp_c ( ConstSpicePlane * plane, - SpiceDouble normal[3], - SpiceDouble point[3] ); - - - void pl2psv_c ( ConstSpicePlane * plane, - SpiceDouble point[3], - SpiceDouble span1[3], - SpiceDouble span2[3] ); - - - SpiceInt pos_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ); - - - SpiceInt posr_c ( ConstSpiceChar * str, - ConstSpiceChar * substr, - SpiceInt start ); - - - void prefix_c ( ConstSpiceChar * pref, - SpiceInt spaces, - SpiceInt lenout, - SpiceChar * string ); - - - SpiceChar * prompt_c ( ConstSpiceChar * prmptStr, - SpiceInt lenout, - SpiceChar * buffer ); - - - void prop2b_c ( SpiceDouble gm, - ConstSpiceDouble pvinit[6], - SpiceDouble dt, - SpiceDouble pvprop[6] ); - - - void prsdp_c ( ConstSpiceChar * string, - SpiceDouble * dpval ); - - - void prsint_c ( ConstSpiceChar * string, - SpiceInt * intval ); - - - void psv2pl_c ( ConstSpiceDouble point[3], - ConstSpiceDouble span1[3], - ConstSpiceDouble span2[3], - SpicePlane * plane ); - - - void putcml_c ( SpiceInt argc , - SpiceChar ** argv ); - - - void pxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble rotate[3][3] ); - - - void q2m_c ( ConstSpiceDouble q[4], - SpiceDouble r[3][3] ); - - - void qdq2av_c ( ConstSpiceDouble q[4], - ConstSpiceDouble dq[4], - SpiceDouble av[3] ); - - - void qxq_c ( ConstSpiceDouble q1[4], - ConstSpiceDouble q2[4], - SpiceDouble qout[4] ); - - - - void radrec_c ( SpiceDouble range, - SpiceDouble ra, - SpiceDouble dec, - SpiceDouble rectan[3] ); - - - void rav2xf_c ( ConstSpiceDouble rot [3][3], - ConstSpiceDouble av [3], - SpiceDouble xform [6][6] ); - - - void raxisa_c ( ConstSpiceDouble matrix[3][3], - SpiceDouble axis [3], - SpiceDouble * angle ); - - - void rdtext_c ( ConstSpiceChar * file, - SpiceInt lenout, - SpiceChar * line, - SpiceBoolean * eof ); - - - void reccyl_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ); - - - void recgeo_c ( ConstSpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ); - - - void reclat_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * longitude, - SpiceDouble * latitude ); - - - void recpgr_c ( ConstSpiceChar * body, - SpiceDouble rectan[3], - SpiceDouble re, - SpiceDouble f, - SpiceDouble * lon, - SpiceDouble * lat, - SpiceDouble * alt ); - - - void recrad_c ( ConstSpiceDouble rectan[3], - SpiceDouble * radius, - SpiceDouble * ra, - SpiceDouble * dec ); - - - - void reordc_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt lenvals, - void * array ); - - - void reordd_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceDouble * array ); - - - void reordi_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceInt * array ); - - - void reordl_c ( ConstSpiceInt * iorder, - SpiceInt ndim, - SpiceBoolean * array ); - - - void removc_c ( ConstSpiceChar * item, - SpiceCell * set ); - - - void removd_c ( SpiceDouble item, - SpiceCell * set ); - - - void removi_c ( SpiceInt item, - SpiceCell * set ); - - - void repmc_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - ConstSpiceChar * value, - SpiceInt lenout, - SpiceChar * out ); - - - void repmct_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar strCase, - SpiceInt lenout, - SpiceChar * out ); - - - void repmd_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceInt lenout, - SpiceChar * out ); - - - void repmf_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceDouble value, - SpiceInt sigdig, - SpiceChar format, - SpiceInt lenout, - SpiceChar * out ); - - - void repmi_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceInt lenout, - SpiceChar * out ); - - - void repmot_c ( ConstSpiceChar * in, - ConstSpiceChar * marker, - SpiceInt value, - SpiceChar strCase, - SpiceInt lenout, - SpiceChar * out ); - - - void reset_c ( void ); - - - SpiceBoolean return_c ( void ); - - - void recsph_c ( ConstSpiceDouble rectan[3], - SpiceDouble * r, - SpiceDouble * colat, - SpiceDouble * lon ); - - - void rotate_c ( SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ); - - - void rotmat_c ( ConstSpiceDouble m1[3][3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble mout[3][3] ); - - - void rotvec_c ( ConstSpiceDouble v1[3], - SpiceDouble angle, - SpiceInt iaxis, - SpiceDouble vout[3] ); - - - SpiceDouble rpd_c ( void ); - - - void rquad_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble root1[2], - SpiceDouble root2[2] ); - - - void saelgv_c ( ConstSpiceDouble vec1 [3], - ConstSpiceDouble vec2 [3], - SpiceDouble smajor[3], - SpiceDouble sminor[3] ); - - - void scard_c ( SpiceInt card, - SpiceCell * cell ); - - - void scdecd_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceInt sclklen, - SpiceChar * sclkch ); - - - void sce2s_c ( SpiceInt sc, - SpiceDouble et, - SpiceInt sclklen, - SpiceChar * sclkch ); - - - void sce2c_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ); - - - void sce2t_c ( SpiceInt sc, - SpiceDouble et, - SpiceDouble * sclkdp ); - - - void scencd_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * sclkdp ); - - - void scfmt_c ( SpiceInt sc, - SpiceDouble ticks, - SpiceInt clkstrlen, - SpiceChar * clkstr ); - - - void scpart_c ( SpiceInt sc, - SpiceInt * nparts, - SpiceDouble * pstart, - SpiceDouble * pstop ); - - - void scs2e_c ( SpiceInt sc, - ConstSpiceChar * sclkch, - SpiceDouble * et ); - - - void sct2e_c ( SpiceInt sc, - SpiceDouble sclkdp, - SpiceDouble * et ); - - - void sctiks_c ( SpiceInt sc, - ConstSpiceChar * clkstr, - SpiceDouble * ticks ); - - - void sdiff_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean set_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ); - - - void setmsg_c ( ConstSpiceChar * msg ); - - - void shellc_c ( SpiceInt ndim, - SpiceInt lenvals, - void * array ); - - - void shelld_c ( SpiceInt ndim, - SpiceDouble * array ); - - - void shelli_c ( SpiceInt ndim, - SpiceInt * array ); - - - void sigerr_c ( ConstSpiceChar * message ); - - - void sincpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3], - SpiceBoolean * found ); - - - SpiceInt size_c ( SpiceCell * size ); - - - SpiceDouble spd_c ( void ); - - - void sphcyl_c ( SpiceDouble radius, - SpiceDouble colat, - SpiceDouble slon, - SpiceDouble * r, - SpiceDouble * lon, - SpiceDouble * z ); - - - void sphlat_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lons, - SpiceDouble * radius, - SpiceDouble * lon, - SpiceDouble * lat ); - - - void sphrec_c ( SpiceDouble r, - SpiceDouble colat, - SpiceDouble lon, - SpiceDouble rectan[3] ); - - - void spk14a_c ( SpiceInt handle, - SpiceInt ncsets, - ConstSpiceDouble coeffs [], - ConstSpiceDouble epochs [] ); - - - void spk14b_c ( SpiceInt handle, - ConstSpiceChar * segid, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - SpiceInt chbdeg ); - - - void spk14e_c ( SpiceInt handle ); - - - void spkapo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs[6], - ConstSpiceChar * abcorr, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkapp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceDouble sobs [6], - ConstSpiceChar * abcorr, - SpiceDouble starg [6], - SpiceDouble * lt ); - - - void spkcls_c ( SpiceInt handle ); - - - void spkcov_c ( ConstSpiceChar * spk, - SpiceInt idcode, - SpiceCell * cover ); - - - void spkacs_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkaps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - ConstSpiceDouble accobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkez_c ( SpiceInt target, - SpiceDouble epoch, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - SpiceInt observer, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkezp_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - SpiceInt obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkezr_c ( ConstSpiceChar * target, - SpiceDouble epoch, - ConstSpiceChar * frame, - ConstSpiceChar * abcorr, - ConstSpiceChar * observer, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkgeo_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble state[6], - SpiceDouble * lt ); - - - void spkgps_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceInt obs, - SpiceDouble pos[3], - SpiceDouble * lt ); - - - void spklef_c ( ConstSpiceChar * filename, - SpiceInt * handle ); - - - void spkltc_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceDouble stobs[6], - SpiceDouble starg[6], - SpiceDouble * lt, - SpiceDouble * dlt ); - - - void spkobj_c ( ConstSpiceChar * spk, - SpiceCell * ids ); - - - void spkopa_c ( ConstSpiceChar * file, - SpiceInt * handle ); - - - void spkopn_c ( ConstSpiceChar * name, - ConstSpiceChar * ifname, - SpiceInt ncomch, - SpiceInt * handle ); - - - void spkpds_c ( SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceInt type, - SpiceDouble first, - SpiceDouble last, - SpiceDouble descr[5] ); - - - void spkpos_c ( ConstSpiceChar * targ, - SpiceDouble et, - ConstSpiceChar * ref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obs, - SpiceDouble ptarg[3], - SpiceDouble * lt ); - - - void spkssb_c ( SpiceInt targ, - SpiceDouble et, - ConstSpiceChar * ref, - SpiceDouble starg[6] ); - - - void spksub_c ( SpiceInt handle, - SpiceDouble descr[5], - ConstSpiceChar * ident, - SpiceDouble begin, - SpiceDouble end, - SpiceInt newh ); - - - void spkuds_c ( ConstSpiceDouble descr [5], - SpiceInt * body, - SpiceInt * center, - SpiceInt * frame, - SpiceInt * type, - SpiceDouble * first, - SpiceDouble * last, - SpiceInt * begin, - SpiceInt * end ); - - - void spkuef_c ( SpiceInt handle ); - - - void spkw02_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ); - - - void spkw03_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble intlen, - SpiceInt n, - SpiceInt polydg, - ConstSpiceDouble cdata [], - SpiceDouble btime ); - - - void spkw05_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble gm, - SpiceInt n, - ConstSpiceDouble states [][6], - ConstSpiceDouble epochs [] ); - - - void spkw08_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch1, - SpiceDouble step ); - - - void spkw09_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ); - - - void spkw10_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - ConstSpiceDouble consts [8], - SpiceInt n, - ConstSpiceDouble elems [], - ConstSpiceDouble epochs [] ); - - - void spkw12_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - SpiceDouble epoch0, - SpiceDouble step ); - - - void spkw13_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - ConstSpiceDouble states[][6], - ConstSpiceDouble epochs[] ); - - - void spkw15_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble tp [3], - ConstSpiceDouble pa [3], - SpiceDouble p, - SpiceDouble ecc, - SpiceDouble j2flg, - ConstSpiceDouble pv [3], - SpiceDouble gm, - SpiceDouble j2, - SpiceDouble radius ); - - - void spkw17_c ( SpiceInt handle, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceDouble epoch, - ConstSpiceDouble eqel [9], - SpiceDouble rapol, - SpiceDouble decpol ); - - - void spkw18_c ( SpiceInt handle, - SpiceSPK18Subtype subtyp, - SpiceInt body, - SpiceInt center, - ConstSpiceChar * frame, - SpiceDouble first, - SpiceDouble last, - ConstSpiceChar * segid, - SpiceInt degree, - SpiceInt n, - const void * packts, - ConstSpiceDouble epochs[] ); - - - void srfrec_c ( SpiceInt body, - SpiceDouble lon, - SpiceDouble lat, - SpiceDouble rectan[3] ); - - - void srfxpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - ConstSpiceChar * dref, - ConstSpiceDouble dvec [3], - SpiceDouble spoint [3], - SpiceDouble * dist, - SpiceDouble * trgepc, - SpiceDouble obspos [3], - SpiceBoolean * found ); - - - void ssize_c ( SpiceInt size, - SpiceCell * cell ); - - - void stelab_c ( ConstSpiceDouble pobj[3], - ConstSpiceDouble vobs[3], - SpiceDouble appobj[3] ); - - - void stpool_c ( ConstSpiceChar * item, - SpiceInt nth, - ConstSpiceChar * contin, - SpiceInt lenout, - SpiceChar * string, - SpiceInt * size, - SpiceBoolean * found ); - - - void str2et_c ( ConstSpiceChar * date, - SpiceDouble * et ); - - - void subpnt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ); - - - void subpt_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * alt ); - - - void subslr_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * fixref, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint [3], - SpiceDouble * trgepc, - SpiceDouble srfvec [3] ); - - - void subsol_c ( ConstSpiceChar * method, - ConstSpiceChar * target, - SpiceDouble et, - ConstSpiceChar * abcorr, - ConstSpiceChar * obsrvr, - SpiceDouble spoint[3] ); - - - SpiceDouble sumad_c ( ConstSpiceDouble array[], - SpiceInt n ); - - - SpiceInt sumai_c ( ConstSpiceInt array[], - SpiceInt n ); - - - void surfnm_c ( SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - ConstSpiceDouble point[3], - SpiceDouble normal[3] ); - - - void surfpt_c ( ConstSpiceDouble positn[3], - ConstSpiceDouble u[3], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble point[3], - SpiceBoolean * found ); - - - void surfpv_c ( ConstSpiceDouble stvrtx[6], - ConstSpiceDouble stdir [6], - SpiceDouble a, - SpiceDouble b, - SpiceDouble c, - SpiceDouble stx [6], - SpiceBoolean * found ); - - - void swpool_c ( ConstSpiceChar * agent, - SpiceInt nnames, - SpiceInt lenvals, - const void * names ); - - - void sxform_c ( ConstSpiceChar * from, - ConstSpiceChar * to, - SpiceDouble et, - SpiceDouble xform[6][6] ); - - - void szpool_c ( ConstSpiceChar * name, - SpiceInt * n, - SpiceBoolean * found ); - - - void timdef_c ( ConstSpiceChar * action, - ConstSpiceChar * item, - SpiceInt lenout, - SpiceChar * value ); - - - void timout_c ( SpiceDouble et, - ConstSpiceChar * pictur, - SpiceInt lenout, - SpiceChar * output ); - - - void tipbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tipm[3][3] ); - - - void tisbod_c ( ConstSpiceChar * ref, - SpiceInt body, - SpiceDouble et, - SpiceDouble tsipm[6][6] ); - - - ConstSpiceChar * tkvrsn_c ( ConstSpiceChar * item ); - - - void tparse_c ( ConstSpiceChar * string, - SpiceInt lenout, - SpiceDouble * sp2000, - SpiceChar * errmsg ); - - - void tpictr_c ( ConstSpiceChar * sample, - SpiceInt lenpictur, - SpiceInt lenerror, - SpiceChar * pictur, - SpiceBoolean * ok, - SpiceChar * error ); - - - SpiceDouble trace_c ( ConstSpiceDouble matrix[3][3] ); - - - void trcoff_c ( void ); - - - void tsetyr_c ( SpiceInt year ); - - - SpiceDouble twopi_c ( void ); - - - void twovec_c ( ConstSpiceDouble axdef [3], - SpiceInt indexa, - ConstSpiceDouble plndef [3], - SpiceInt indexp, - SpiceDouble mout [3][3] ); - - - SpiceDouble tyear_c ( void ); - - - void ucase_c ( SpiceChar * in, - SpiceInt lenout, - SpiceChar * out ); - - - void ucrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - void uddc_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - - SpiceDouble x, - SpiceDouble dx, - SpiceBoolean * isdecr ); - - - void uddf_c ( void ( * udfunc ) ( SpiceDouble x, - SpiceDouble * value ), - SpiceDouble x, - SpiceDouble dx, - SpiceDouble * deriv ); - - - void union_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceDouble unitim_c ( SpiceDouble epoch, - ConstSpiceChar * insys, - ConstSpiceChar * outsys ); - - - void unload_c ( ConstSpiceChar * file ); - - - void unorm_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3], - SpiceDouble * vmag ); - - - void unormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout, - SpiceDouble * vmag ); - - - void utc2et_c ( ConstSpiceChar * utcstr, - SpiceDouble * et ); - - - void vadd_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ) ; - - - void vaddg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ); - - - void valid_c ( SpiceInt size, - SpiceInt n, - SpiceCell * a ); - - - void vcrss_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - SpiceDouble vdist_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - SpiceDouble vdistg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - SpiceDouble vdot_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - SpiceDouble vdotg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - void vequ_c ( ConstSpiceDouble vin[3], - SpiceDouble vout[3] ); - - - void vequg_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vhat_c ( ConstSpiceDouble v1 [3], - SpiceDouble vout[3] ); - - - void vhatg_c ( ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vlcom_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble sum[3] ); - - - void vlcom3_c ( SpiceDouble a, - ConstSpiceDouble v1[3], - SpiceDouble b, - ConstSpiceDouble v2[3], - SpiceDouble c, - ConstSpiceDouble v3[3], - SpiceDouble sum[3] ); - - - void vlcomg_c ( SpiceInt n, - SpiceDouble a, - ConstSpiceDouble * v1, - SpiceDouble b, - ConstSpiceDouble * v2, - SpiceDouble * sum ); - - - void vminug_c ( ConstSpiceDouble * vin, - SpiceInt ndim, - SpiceDouble * vout ); - - - void vminus_c ( ConstSpiceDouble v1[3], - SpiceDouble vout[3] ); - - - SpiceDouble vnorm_c ( ConstSpiceDouble v1[3] ); - - - SpiceDouble vnormg_c ( ConstSpiceDouble * v1, - SpiceInt ndim ); - - - void vpack_c ( SpiceDouble x, - SpiceDouble y, - SpiceDouble z, - SpiceDouble v[3] ); - - - void vperp_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ); - - - void vprjp_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * plane, - SpiceDouble vout [3] ); - - - void vprjpi_c ( ConstSpiceDouble vin [3], - ConstSpicePlane * projpl, - ConstSpicePlane * invpl, - SpiceDouble vout [3], - SpiceBoolean * found ); - - - void vproj_c ( ConstSpiceDouble a[3], - ConstSpiceDouble b[3], - SpiceDouble p[3] ); - - - SpiceDouble vrel_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - SpiceDouble vrelg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - void vrotv_c ( ConstSpiceDouble v[3], - ConstSpiceDouble axis[3], - SpiceDouble theta, - SpiceDouble r[3] ); - - - void vscl_c ( SpiceDouble s, - ConstSpiceDouble v1[3], - SpiceDouble vout[3] ); - - - void vsclg_c ( SpiceDouble s, - ConstSpiceDouble * v1, - SpiceInt ndim, - SpiceDouble * vout ); - - - SpiceDouble vsep_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3] ); - - - void vsub_c ( ConstSpiceDouble v1[3], - ConstSpiceDouble v2[3], - SpiceDouble vout[3] ); - - - void vsubg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim, - SpiceDouble * vout ); - - - SpiceDouble vsepg_c ( ConstSpiceDouble * v1, - ConstSpiceDouble * v2, - SpiceInt ndim ); - - - SpiceDouble vtmv_c ( ConstSpiceDouble v1 [3], - ConstSpiceDouble matrix [3][3], - ConstSpiceDouble v2 [3] ); - - - SpiceDouble vtmvg_c ( const void * v1, - const void * matrix, - const void * v2, - SpiceInt nrow, - SpiceInt ncol ); - - - void vupack_c ( ConstSpiceDouble v[3], - SpiceDouble * x, - SpiceDouble * y, - SpiceDouble * z ); - - SpiceBoolean vzero_c ( ConstSpiceDouble v[3] ); - - - SpiceBoolean vzerog_c ( ConstSpiceDouble * v, - SpiceInt ndim ); - - SpiceInt wncard_c ( SpiceCell * window ); - - void wncomd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window, - SpiceCell * result ); - - - void wncond_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wndifd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean wnelmd_c ( SpiceDouble point, - SpiceCell * window ); - - - void wnexpd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wnextd_c ( SpiceChar side, - SpiceCell * window ); - - - void wnfetd_c ( SpiceCell * window, - SpiceInt n, - SpiceDouble * left, - SpiceDouble * right ); - - - void wnfild_c ( SpiceDouble sml, - SpiceCell * window ); - - - void wnfltd_c ( SpiceDouble sml, - SpiceCell * window ); - - - SpiceBoolean wnincd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wninsd_c ( SpiceDouble left, - SpiceDouble right, - SpiceCell * window ); - - - void wnintd_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - SpiceBoolean wnreld_c ( SpiceCell * a, - ConstSpiceChar * op, - SpiceCell * b ); - - - void wnsumd_c ( SpiceCell * window, - SpiceDouble * meas, - SpiceDouble * avg, - SpiceDouble * stddev, - SpiceInt * shortest, - SpiceInt * longest ); - - - void wnunid_c ( SpiceCell * a, - SpiceCell * b, - SpiceCell * c ); - - - void wnvald_c ( SpiceInt size, - SpiceInt n, - SpiceCell * window ); - - - - void xf2eul_c ( ConstSpiceDouble xform [6][6], - SpiceInt axisa, - SpiceInt axisb, - SpiceInt axisc, - SpiceDouble eulang [6], - SpiceBoolean * unique ); - - - void xf2rav_c ( ConstSpiceDouble xform [6][6], - SpiceDouble rot [3][3], - SpiceDouble av [3] ); - - - void xpose_c ( ConstSpiceDouble m1 [3][3], - SpiceDouble mout[3][3] ); - - - void xpose6_c ( ConstSpiceDouble m1 [6][6], - SpiceDouble mout[6][6] ); - - - void xposeg_c ( const void * matrix, - SpiceInt nrow, - SpiceInt ncol, - void * xposem ); - - - void zzgetcml_c( SpiceInt * argc, - SpiceChar *** argv, - SpiceBoolean init ); - - - SpiceBoolean zzgfgeth_c ( void ); - - - void zzgfsavh_c( SpiceBoolean status ); - - - void zzsynccl_c( SpiceTransDir xdir, - SpiceCell * cell ); - - -#endif diff --git a/ext/spice/src/csupport/SpiceZst.h b/ext/spice/src/csupport/SpiceZst.h deleted file mode 100644 index ba48b16c1c..0000000000 --- a/ext/spice/src/csupport/SpiceZst.h +++ /dev/null @@ -1,199 +0,0 @@ -/* - --Header_File SpiceZst.h ( Fortran/C string conversion utilities ) - --Abstract - - Define prototypes for CSPICE Fortran/C string conversion utilities. - - Caution: these prototypes are subject to revision without notice. - - These are private routines and are not part of the official CSPICE - user interface. - --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. - --Particulars - - None. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 6.0.0, 10-JUL-2002 (NJB) - - Added prototype for new functions C2F_MapStrArr and - C2F_MapFixStrArr. - - -CSPICE Version 5.0.0, 18-MAY-2001 (WLT) - - Added #ifdef's to add namespace specification for C++ compilation. - - -CSPICE Version 4.0.0, 14-FEB-2000 (NJB) - - Added prototype for new function C2F_CreateStrArr_Sig. - - -CSPICE Version 3.0.0, 12-JUL-1999 (NJB) - - Added prototype for function C2F_CreateFixStrArr. - Added prototype for function F2C_ConvertTrStrArr. - Removed reference in comments to C2F_CreateStrArr_Sig, which - does not exist. - - -CSPICE Version 2.0.1, 06-MAR-1998 (NJB) - - Type SpiceVoid was changed to void. - - -CSPICE Version 2.0.1, 09-FEB-1998 (EDW) - - Added prototype for F2C_ConvertStrArr. - - -CSPICE Version 2.0.0, 04-JAN-1998 (NJB) - - Added prototype for F2C_ConvertStr. - - -CSPICE Version 1.0.0, 25-OCT-1997 (NJB) (KRG) (EDW) - --Index_Entries - - protoypes of CSPICE Fortran/C string conversion utilities - -*/ - -#include -#include -#include "SpiceZdf.h" - -#ifndef HAVE_FCSTRINGS_H -#define HAVE_FCSTRINGS_H - -#ifdef __cplusplus -namespace Jpl_NAIF_CSpice { -#endif - - SpiceStatus C2F_CreateStr ( ConstSpiceChar *, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateStr_Sig ( ConstSpiceChar *, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateFixStrArr ( SpiceInt nStr, - SpiceInt cStrDim, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - SpiceStatus C2F_CreateStrArr ( SpiceInt, - ConstSpiceChar **, - SpiceInt *, - SpiceChar ** ); - - void C2F_CreateStrArr_Sig ( SpiceInt nStr, - ConstSpiceChar ** cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - void C2F_MapFixStrArr ( ConstSpiceChar * caller, - SpiceInt nStr, - SpiceInt cStrLen, - const void * cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - void C2F_MapStrArr ( ConstSpiceChar * caller, - SpiceInt nStr, - SpiceInt cStrLen, - const void * cStrArr, - SpiceInt * fStrLen, - SpiceChar ** fStrArr ); - - SpiceStatus C2F_StrCpy ( ConstSpiceChar *, - SpiceInt, - SpiceChar * ); - - void F_Alloc ( SpiceInt, - SpiceChar** ); - - void F2C_ConvertStr ( SpiceInt, - SpiceChar * ); - - void F2C_ConvertStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ); - - void F2C_ConvertTrStrArr ( SpiceInt n, - SpiceInt lenout, - SpiceChar * cvals ); - - SpiceStatus F2C_CreateStr ( SpiceInt, - ConstSpiceChar *, - SpiceChar ** ); - - void F2C_CreateStr_Sig ( SpiceInt, - ConstSpiceChar *, - SpiceChar ** ); - - SpiceStatus F2C_CreateStrArr ( SpiceInt, - SpiceInt, - ConstSpiceChar *, - SpiceChar *** ); - - void F2C_CreateStrArr_Sig ( SpiceInt, - SpiceInt, - ConstSpiceChar *, - SpiceChar *** ); - - void F2C_FreeStrArr ( SpiceChar **cStrArr ); - - - SpiceStatus F2C_StrCpy ( SpiceInt, - ConstSpiceChar *, - SpiceInt, - SpiceChar * ); - - SpiceInt F_StrLen ( SpiceInt, - ConstSpiceChar * ); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/ext/spice/src/csupport/batch.c b/ext/spice/src/csupport/batch.c deleted file mode 100644 index a542721805..0000000000 --- a/ext/spice/src/csupport/batch.c +++ /dev/null @@ -1,120 +0,0 @@ -/* batch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure BATCH (Tell whether or not a program is in batch mode) */ -logical batch_0_(int n__) -{ - /* Initialized data */ - - static logical inbtch = FALSE_; - - /* System generated locals */ - logical ret_val; - -/* $ Abstract */ - -/* This function returns information regarding the interactive */ -/* status of a program. If BATCH is TRUE the function is considered */ -/* to be in background mode. If BATCH is FALSE the function is */ -/* considered to be in interactive mode. */ - -/* To set a program in batch mode call the entry point SETBAT. */ -/* To set a program in interactive mode call SETMOD */ - -/* $ 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. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 20-NOV-1995 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* Entry points. */ - - -/* Local Variable */ - - switch(n__) { - case 1: goto L_setmod; - case 2: goto L_setbat; - } - - ret_val = inbtch; - return ret_val; -/* $Procedure SETMOD (Set the reader to interative mode.) */ - -L_setmod: -/* $ Abstact */ -/* Set NXTCOM to interactive mode. In puts that are expected to */ -/* come from the keyboard generate an result in a prompt for input */ -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - inbtch = FALSE_; - ret_val = TRUE_; - return ret_val; -/* $Procedure SETBAT (Set the reader to interative mode.) */ - -L_setbat: -/* $ Abstact */ -/* Set NXTCOM to interactive mode. In puts that are expected to */ -/* come from the keyboard generate an result in a prompt for input */ -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - inbtch = TRUE_; - ret_val = TRUE_; - return ret_val; -} /* batch_ */ - -logical batch_(void) -{ - return batch_0_(0); - } - -logical setmod_(void) -{ - return batch_0_(1); - } - -logical setbat_(void) -{ - return batch_0_(2); - } - diff --git a/ext/spice/src/csupport/bboard_1.c b/ext/spice/src/csupport/bboard_1.c deleted file mode 100644 index 7177a57ff6..0000000000 --- a/ext/spice/src/csupport/bboard_1.c +++ /dev/null @@ -1,3130 +0,0 @@ -/* bboard_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__100 = 100; -static integer c__5000 = 5000; -static integer c__300 = 300; -static integer c__404 = 404; -static integer c__50 = 50; - -/* $Procedure BBOARD ( Bulletin board ) */ -/* Subroutine */ int bboard_0_(int n__, char *action, char *item, integer *n, - integer *ivals, doublereal *dvals, char *cvals, char *sval, ftnlen - action_len, ftnlen item_len, ftnlen cvals_len, ftnlen sval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char nbuf[32*106]; - static integer pbuf[410]; - static char vbuf[100*51], what[32]; - static integer i__; - static char cntab[32*106], dntab[32*106]; - static integer cptab[106], dptab[106]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char intab[32*106]; - static integer iptab[106]; - static doublereal dvtab[5006]; - static char cvtab[255*306], which[32]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static integer ivtab[5006]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - sydelc_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen) - , sydeld_(char *, char *, integer *, doublereal *, ftnlen, ftnlen) - ; - extern integer sydimc_(char *, char *, integer *, char *, ftnlen, ftnlen, - ftnlen), sydimd_(char *, char *, integer *, doublereal *, ftnlen, - ftnlen); - extern /* Subroutine */ int sydeli_(char *, char *, integer *, integer *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - extern integer sydimi_(char *, char *, integer *, integer *, ftnlen, - ftnlen); - extern /* Subroutine */ int sygetd_(char *, char *, integer *, doublereal - *, integer *, doublereal *, logical *, ftnlen, ftnlen), sygetc_( - char *, char *, integer *, char *, integer *, char *, logical *, - ftnlen, ftnlen, ftnlen, ftnlen), ssizec_(integer *, char *, - ftnlen), setmsg_(char *, ftnlen), syenqd_(char *, doublereal *, - char *, integer *, doublereal *, ftnlen, ftnlen), syenqc_(char *, - char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen) - , sygeti_(char *, char *, integer *, integer *, integer *, - integer *, logical *, ftnlen, ftnlen), cmprss_(char *, integer *, - char *, char *, ftnlen, ftnlen, ftnlen), syenqi_(char *, integer * - , char *, integer *, integer *, ftnlen, ftnlen), sypshc_(char *, - char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen) - , sypshd_(char *, doublereal *, char *, integer *, doublereal *, - ftnlen, ftnlen), ssizei_(integer *, integer *), ssized_(integer *, - doublereal *), sypopc_(char *, char *, integer *, char *, char *, - logical *, ftnlen, ftnlen, ftnlen, ftnlen), sypopd_(char *, char - *, integer *, doublereal *, doublereal *, logical *, ftnlen, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int sypshi_(char *, integer *, char *, integer *, - integer *, ftnlen, ftnlen), sypopi_(char *, char *, integer *, - integer *, integer *, logical *, ftnlen, ftnlen), sbget_1__(char * - , char *, integer *, char *, char *, integer *, ftnlen, ftnlen, - ftnlen, ftnlen), syputc_(char *, char *, integer *, char *, - integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen), syputd_(char * - , doublereal *, integer *, char *, integer *, doublereal *, - ftnlen, ftnlen), sbrem_1__(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen), syputi_(char *, integer *, integer *, - char *, integer *, integer *, ftnlen, ftnlen), sbset_1__(char *, - char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen) - ; - static logical fnd; - static integer pos; - extern /* Subroutine */ int sbinit_1__(integer *, integer *, integer *, - char *, integer *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Maintain a global bulletin board for use by application */ -/* programs. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action to be taken. */ -/* ITEM I Item to be posted or retrieved. */ -/* N I,O Number of values posted or retrieved. */ -/* IVALS I,O Integer values. */ -/* DVALS I,O Double precision values */ -/* CVALS I,O Character values. */ -/* SVAL I,O String value. */ -/* MAXNL P Maximum name length. */ -/* MAXCL P Maximum character length. */ -/* MAXI P Maximum number of integer items. */ -/* MAXD P Maximum number of double precision items. */ -/* MAXC P Maximum number of character items. */ -/* MAXS P Maximum number of string items. */ -/* MAXIV P Maximum number of integer values. */ -/* MAXDV P Maximum number of double precision values. */ -/* MAXCV P Maximum number of character values. */ -/* MAXCHR P Maximum number of string characters. */ - -/* $ Detailed_Input */ - -/* ACTION is used by entry points BBPUT and BBGET to indicate */ -/* a specific action to be taken. Possible actions */ -/* are 'POST', 'COPY', 'TAKE', 'PUSH', 'APPEND', and */ -/* 'POP'. */ - -/* ITEM is the name of an item to be posted, retrieved, */ -/* removed, and so on. Names are case-sensitive, but */ -/* leading and embedded blanks are ignored. */ - -/* N on input is the number of values to be posted. */ - -/* IVALS, */ -/* DVALS, */ -/* CVALS, on input are values to be associated with a specific */ -/* integer, DP, or character item on the board. */ - -/* SVAL on input is a string value to be associated with a */ -/* specific string item on the board. */ - -/* $ Detailed_Output */ - -/* N on output is the number of values being returned, */ -/* or the number of values associated with an item. */ - -/* IVALS, */ -/* DVALS, */ -/* CVALS, on output are values associated with a specific */ -/* integer, DP, or character item on the board. */ - -/* SVAL on output is a string value associated with a */ -/* specific string item on the board. */ - -/* $ Parameters */ - -/* MAXNL is the maximum number of characters that can make */ -/* up an item name. */ - -/* MAXCL is the declared length of the individual values */ -/* of character items. That is, each multi-valued */ -/* character item is equivalent to a CHARACTER*(MAXCL) */ -/* array. */ - -/* MAXI, */ -/* MAXD, */ -/* MAXC, */ -/* MAXS, are the maximum numbers of items of each type */ -/* (integer, DP, character, and string) that can be */ -/* stored simultaneously. */ - -/* MAXIV, */ -/* MAXDV, */ -/* MAXCV are the maximum numbers of values of each type */ -/* (integer, DP, and character) that can be stored */ -/* simultaneously. MAXIV, MAXDV, and MAXCV must be */ -/* at least as large as MAXI, MAXD, and MAXC, */ -/* respectively. (Note that string items are are */ -/* not multi-valued.) */ - -/* MAXCHR is the maximum number characters that can be used */ -/* to store string items at any one time. MAXCHR must */ -/* be an integer multiple of 100. */ - -/* $ Exceptions */ - -/* 1) If BBOARD is called directly, the error 'SPICE(BOGUSENTRY)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BBOARD implements a global storage area, which may be */ -/* used by the individual modules of an application program */ -/* communicate with each other. The metaphor for this area */ -/* is a bulletin board: modules may leave messages (called */ -/* `items') on this board, to be copied, modified, or removed */ -/* by other modules. */ - -/* Types */ - -/* The board can contain four types of items: integer, double */ -/* precision (DP), character, and string. The first three types */ -/* may be multi-valued: for example, a single integer item may */ -/* be associated with more than one integer value. Thus, the */ -/* board may be used to store arrays as well as scalar values. */ - -/* Each string item may contain only one value: however, */ -/* the number of characters in this value may be anywhere */ -/* between one and the total size of the string buffer */ -/* (parameter MAXCHR). */ - -/* Posting items */ - -/* An item may be posted on the board by calling BBPUTx */ -/* (where x indicates the type of the item: I, D, C, or S). */ -/* For example, the call */ - -/* IMAGES(1) = '22421.36' */ -/* IMAGES(2) = '22421.39' */ -/* IMAGES(3) = '22421.45' */ - -/* CALL BBPUTC ( 'POST', 'IMAGE QUEUE', 3, IMAGES ) */ - -/* creates an item with the name 'IMAGE QUEUE', which contains */ -/* the three character values in the array IMAGES. If an item */ -/* with that name already exists, it is replaced. */ - -/* Item names */ - -/* Item names are case-sensitive, but blanks are ignored. */ -/* The item 'IMAGE QUEUE' may be accessed under any of the */ -/* following names. */ - -/* 'IMAGE QUEUE' */ -/* 'IMAGEQUEUE' */ -/* ' IMAGE QUEUE ' */ - -/* On the other hand, the names */ - -/* 'Image queue' */ -/* 'image queue' */ -/* 'Image Queue' */ - -/* all refer to distinct items. */ - -/* The same item name may be applied to one item of each */ -/* type. This allows you to associate values of different */ -/* types under a single name, as in the following example. */ - -/* IMAGES( 1) = '22421.36' */ -/* BODIES( 1) = 801 */ -/* RADII (1,1) = 1600.D0 */ -/* RADII (2,1) = 1600.D0 */ -/* RADII (3,1) = 1600.D0 */ - -/* IMAGES( 2) = '22427.19' */ -/* BODIES( 2) = 899 */ -/* RADII (1,2) = 25295.D0 */ -/* RADII (2,2) = 25295.D0 */ -/* RADII (3,2) = 24738.D0 */ - -/* DESCR = 'Preliminary NINA testing, 4/12/89' */ - -/* CALL BBPUTC ( 'POST', 'IMAGE QUEUE', 2, IMAGES ) */ -/* CALL BBPUTI ( 'POST', 'IMAGE QUEUE', 2, BODIES ) */ -/* CALL BBPUTD ( 'POST', 'IMAGE QUEUE', 6, RADII ) */ -/* CALL BBPUTS ( 'POST', 'IMAGE QUEUE', DESCR ) */ - -/* Copying items */ - -/* Once an item has been posted, its values may be copied */ -/* by calling BBGETx. For example, the call */ - -/* CALL BBGETC ( 'COPY', 'IMAGE QUEUE', N, IMAGES ) */ - -/* copies the values associated with the character item */ -/* 'IMAGE QUEUE' into the character array IMAGES. All of */ -/* the values associated with the item are returned. */ - -/* Taking items */ - -/* When an item is copied, its values remain intact, ready */ -/* to be copied by other modules. Posted items may also be */ -/* taken by calling BBGETx. For example, the call */ - -/* CALL BBGETD ( 'TAKE', 'IMAGE QUEUE', N, IMAGES ) */ - -/* returns the values just as the previous call did; however, */ -/* following this call, the item is no longer on the board. */ - -/* Removing items */ - -/* It is possible to remove an item without copying its values, */ -/* by calling BBREMx. For example, the calls */ - -/* CALL BBREMC ( 'IMAGE QUEUE' ) */ -/* CALL BBREMI ( 'IMAGE QUEUE' ) */ -/* CALL BBREMD ( 'IMAGE QUEUE' ) */ -/* CALL BBREMS ( 'IMAGE QUEUE' ) */ - -/* removes these items from the board without allocating space */ -/* for the return of any values. Removing an item that is not */ -/* on the board does not cause an error. */ - -/* Stacks and Queues */ - -/* The list of values associated with a multi-valued item */ -/* may be thought of as a stack or queue. The values can be */ -/* popped (copied and removed) from this list in pieces, */ -/* instead of all at once. Thus, the images in 'IMAGE QUEUE' */ -/* can be processed as shown below. */ - -/* DO I = 1, 2 */ -/* CALL BBGETC ( 'POP', 'IMAGE QUEUE', 1, IMAGE ) */ -/* CALL BBGETI ( 'POP', 'IMAGE QUEUE', 1, BODY ) */ -/* CALL BBGETD ( 'POP', 'IMAGE QUEUE', 3, RADII ) */ -/* . */ -/* . */ - -/* END DO */ - -/* Values may be added to the beginning of the value list */ -/* (treating it as a push-down stack), or to the end of the */ -/* list (treating it as a queue). The following sequence */ - -/* CALL BBPUTI ( 'POST', 'SEQUENCE', 1, 5 ) */ - -/* DATA(1) = 1 */ -/* DATA(2) = 2 */ -/* DATA(3) = 3 */ -/* DATA(4) = 4 */ -/* CALL BBPUTI ( 'PUSH', 'SEQUENCE', 4, DATA ) */ - -/* DATA(1) = 6 */ -/* DATA(2) = 7 */ -/* DATA(3) = 8 */ -/* DATA(4) = 9 */ -/* CALL BBPUTI ( 'APPEND', 'SEQUENCE', 4, DATA ) */ - -/* creates an integer item 'SEQUENCE' containing the numbers */ -/* 1-9 in order. */ - -/* Pushing or appending values onto an item that doesn't exist */ -/* causes the item to be created. */ - -/* Finding items */ - -/* Attempting to copy, take, or pop values from an item not on */ -/* the board results in an error (which is reported through the */ -/* normal SPICELIB error handling mechanism). The presence of */ -/* an item may be confirmed by calling BBFNDx. For example, */ -/* the call */ - -/* CALL BBFNDI ( 'SEQUENCE', N ) */ - -/* returns a value of 9 in N, because 'SEQUENCE' contains nine */ -/* values. Items not on the board contain zero values. (Note */ -/* that BBFNDS, which finds string items, can only return one */ -/* or zero.) */ - -/* Clearing the board */ - -/* The entire board may be cleared at any time by calling */ -/* BBCLR, */ - -/* CALL BBCLR */ - -/* The board MUST be cleared at least once (usually by the */ -/* main module of the calling program) before any items can */ -/* be posted. */ - -/* Storage */ - -/* Because standard Fortran-77 does not allow storage to be */ -/* allocated dynamically, the storage used by the bulletin */ -/* board must be allocated when BBOARD is compiled, by */ -/* setting the values of the parameters MAXNL, MAXCL, MAXI, */ -/* MAXD, MAXS, MAXIV, MAXDV, MAXCV, and MAXCHR. */ - -/* $ Examples */ - -/* Consider the following program, */ - -/* PROGRAM SIMPLE */ - -/* CALL BBCLR */ - -/* CALL READ */ -/* CALL BBFNDS ( 'NAME', N ) */ - -/* DO WHILE ( N .GT. 0 ) */ -/* CALL LOOK_UP */ -/* CALL COMPUTE */ -/* CALL PRINT */ - -/* CALL READ */ -/* CALL BBFNDS ( 'NAME', N ) */ -/* END DO */ - -/* END */ - -/* which calls four modules: */ - -/* READ which reads the name of a picture file from the */ -/* standard input file, and places it on the bulletin */ -/* board as string item 'NAME'. */ - -/* LOOK_UP which looks up the spacecraft event time, filter */ -/* number, exposure time, and pointing angles for the */ -/* picture in the picture file. */ - -/* COMPUTE which computes the equivalent pointing in two */ -/* auxiliary coordinate systems. */ - -/* PRINT which prints everything to the standard output file. */ - -/* The program begins by clearing the bulletin board. This prepares */ -/* the board for use by the rest of the program. */ - -/* READ begins by removing item NAME from the board. It then attempts */ -/* to read the name of the next picture file. If successful, it posts */ -/* the name. (If not the board will not contain the item, and the */ -/* program will terminate.) */ - -/* SUBROUTINE READ */ - -/* CHARACTER*128 FILE */ -/* INTEGER IOSTAT */ - -/* CALL BBREMS ( 'NAME' ) */ -/* READ (*,*,IOSTAT=IOSTAT) FILE */ - -/* IF ( IOSTAT .EQ. 0 ) THEN */ -/* CALL BBPUTS ( 'POST', 'NAME', FILE ) */ -/* END IF */ - -/* RETURN */ -/* END */ - -/* LOOK_UP uses the name of the file as an index into a database */ -/* (the details of which are not important). It retrieves the items */ -/* of interest from the database, and posts them on the board. */ -/* (Note that the spacecraft event time is posted in UTC and ET.) */ - - -/* SUBROUTINE LOOK_UP */ - -/* CALL BBGETS ( 'COPY', 'NAME', INDEX ) */ -/* . */ -/* . */ - -/* CALL BBPUTS ( 'POST', 'S/C EVENT (UTC)', UTC ) */ -/* CALL BBPUTD ( 'POST', 'S/C EVENT (ET)', 1, ET ) */ -/* CALL BBPUTI ( 'POST', 'FILTER NUMBER', 1, FNUM ) */ -/* CALL BBPUTD ( 'POST', 'EXPOSURE', 1, EXP ) */ -/* CALL BBPUTD ( 'POST', 'POINTING (CCT)', 3, CCT ) */ - -/* RETURN */ -/* END */ - -/* COMPUTE begins with the nominal (Clock, Cone, Twist) pointing */ -/* and the spacecraft event time, and computes the equivalent */ -/* pointing in two other systems: Azimuth, Elevation, Twist; and */ -/* Right ascension, Declination, Twist. (Again, the details are not */ -/* important.) These are stored on the board. */ - -/* The conversion depends on an optional bias angle, which may */ -/* or may not be posted. If not found, it defaults to zero. */ - -/* SUBROUTINE COMPUTE */ -/* . */ -/* . */ - -/* CALL BBGETD ( 'COPY', 'POINTING (CCT)', N, CCT ) */ -/* CALL BBGETD ( 'COPY', 'S/C EVENT (ET)', N, ET ) */ - -/* CALL BBFNDD ( 'BIAS', N ) */ -/* IF ( N .EQ. 1 ) THEN */ -/* CALL BBGETD ( 'COPY', 'BIAS', N, BIAS ) */ -/* ELSE */ -/* BIAS = 0.D0 */ -/* END IF */ -/* . */ -/* . */ - -/* CALL BBPUTD ( 'POST', 'POINTING (AET)', 3, AET ) */ -/* CALL BBPUTD ( 'POST', 'POINTING (RDT)', 3, RDT ) */ - -/* RETURN */ -/* END */ - -/* PRINT simply retrieves the items from the board and writes */ -/* them to the standard output file. The items are removed from */ -/* the board as their values are printed, freeing space for use */ -/* by other parts of the program. (This is largely a preventative */ -/* measure: it is not necessary for the program as it stands, */ -/* but it could become important as the program undergoes further */ -/* development.) */ - -/* SUBROUTINE PRINT */ -/* . */ -/* . */ - -/* CALL BBGETS ( 'TAKE', 'NAME', STRING ) */ -/* WRITE (*,*) */ -/* WRITE (*,*) STRING */ - -/* . */ -/* . */ - -/* CALL BBGETS ( 'TAKE', 'POINTING (RDT)', N, NUMBERS ) */ -/* WRITE (*,*) ( NUMBERS(I), I = 1, N ) */ - -/* RETURN */ -/* END */ - -/* $ Restrictions */ - -/* 1) The values of parameters MAXNL and MAXCL must not be smaller */ -/* than the value of parameter MINLEN in subroutine ENCHAR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - -/* Integer, DP, and character items are stored in symbol tables. */ -/* Later, they should be stored in card catalogs, when the necessary */ -/* routines have been completed. */ - -/* Strings are stored in a string buffer. */ - -/* Actions, where input, are compressed and converted to uppercase */ -/* (WHAT). Item names are compressed (WHICH). */ - - -/* Save everything between calls. */ - - -/* Standard SPICE error handling. */ - - /* Parameter adjustments */ - if (ivals) { - } - if (dvals) { - } - if (cvals) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_bbputi_1; - case 2: goto L_bbputd_1; - case 3: goto L_bbputc_1; - case 4: goto L_bbputs_1; - case 5: goto L_bbgeti_1; - case 6: goto L_bbgetd_1; - case 7: goto L_bbgetc_1; - case 8: goto L_bbgets_1; - case 9: goto L_bbremi_1; - case 10: goto L_bbremd_1; - case 11: goto L_bbremc_1; - case 12: goto L_bbrems_1; - case 13: goto L_bbfndi_1; - case 14: goto L_bbfndd_1; - case 15: goto L_bbfndc_1; - case 16: goto L_bbfnds_1; - case 17: goto L_bbclr_1; - } - - if (return_()) { - return 0; - } else { - chkin_("BBOARD", (ftnlen)6); - } - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("BBOARD", (ftnlen)6); - return 0; -/* $Procedure BBPUTI ( Bulletin board, put, integer ) */ - -L_bbputi_1: -/* $ Abstract */ - -/* Put one or more values on the board, associated with */ -/* an integer item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* INTEGER IVALS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'POST', 'PUSH', or 'APPEND'. */ -/* ITEM I Item name. */ -/* N I Number of values to be posted. */ -/* IVALS I Values to be posted. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'POST', 'PUSH', and 'APPEND'. */ - -/* ITEM is the name of an integer item, which may or */ -/* may not be on the board already. */ - -/* N is the number of values to be associated with the */ -/* specified item. */ - -/* IVALS are the values. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'POST' creates a new item, containing the specified values. */ -/* (If an item of the same type with the same name already exists, */ -/* it is replaced.) */ - -/* 'PUSH' modifies the list of values associated with an existing */ -/* item by placing items at the beginning of the list (treating the */ -/* list as a push-down stack). */ - -/* 'APPEND' modifies the list of values associated with an existing */ -/* item by placing items at the end of the list (treating the list */ -/* as a queue). */ - -/* Both 'PUSH' and 'APPEND' will create a new item if the specified */ -/* item does not exist. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBPUTI_1", (ftnlen)8); - } - -/* Compress spaces, change cases, as needed. */ - - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by the symbol table routines. (Later, */ -/* it will be done by the card catalog routines.) Note that */ -/* items must be pushed and appended one at a time. */ - - if (s_cmp(what, "POST", (ftnlen)32, (ftnlen)4) == 0) { - syputi_(which, ivals, n, intab, iptab, ivtab, (ftnlen)32, (ftnlen)32); - } else if (s_cmp(what, "PUSH", (ftnlen)32, (ftnlen)4) == 0) { - for (i__ = *n; i__ >= 1; --i__) { - sypshi_(which, &ivals[i__ - 1], intab, iptab, ivtab, (ftnlen)32, ( - ftnlen)32); - } - } else if (s_cmp(what, "APPEND", (ftnlen)32, (ftnlen)6) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - syenqi_(which, &ivals[i__ - 1], intab, iptab, ivtab, (ftnlen)32, ( - ftnlen)32); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBPUTI_1", (ftnlen)8); - return 0; -/* $Procedure BBPUTD ( Bulletin board, put, DP ) */ - -L_bbputd_1: -/* $ Abstract */ - -/* Put one or more values on the board, associated with */ -/* a DP item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* DOUBLE PRECISION DVALS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'POST', 'PUSH', or 'APPEND'. */ -/* ITEM I Item name. */ -/* N I Number of values to be posted. */ -/* DVALS I Values to be posted. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'POST', 'PUSH', and 'APPEND'. */ - -/* ITEM is the name of a DP item, which may or */ -/* may not be on the board already. */ - -/* N is the number of values to be associated with the */ -/* specified item. */ - -/* DVALS are the values. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'POST' creates a new item, containing the specified values. */ -/* (If an item of the same type with the same name already exists, */ -/* it is replaced.) */ - -/* 'PUSH' modifies the list of values associated with an existing */ -/* item by placing items at the beginning of the list (treating the */ -/* list as a push-down stack). */ - -/* 'APPEND' modifies the list of values associated with an existing */ -/* item by placing items at the end of the list (treating the list */ -/* as a queue). */ - -/* Both 'PUSH' and 'APPEND' will create a new item if the specified */ -/* item does not exist. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBPUTD_1", (ftnlen)8); - } - -/* Compress spaces, change cases, as needed. */ - - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by the symbol table routines. (Later, */ -/* it will be done by the card catalog routines.) Note that */ -/* items must be pushed and appended one at a time. */ - - if (s_cmp(what, "POST", (ftnlen)32, (ftnlen)4) == 0) { - syputd_(which, dvals, n, dntab, dptab, dvtab, (ftnlen)32, (ftnlen)32); - } else if (s_cmp(what, "PUSH", (ftnlen)32, (ftnlen)4) == 0) { - for (i__ = *n; i__ >= 1; --i__) { - sypshd_(which, &dvals[i__ - 1], dntab, dptab, dvtab, (ftnlen)32, ( - ftnlen)32); - } - } else if (s_cmp(what, "APPEND", (ftnlen)32, (ftnlen)6) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - syenqd_(which, &dvals[i__ - 1], dntab, dptab, dvtab, (ftnlen)32, ( - ftnlen)32); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBPUTD_1", (ftnlen)8); - return 0; -/* $Procedure BBPUTC ( Bulletin board, put, character ) */ - -L_bbputc_1: -/* $ Abstract */ - -/* Put one or more values on the board, associated with */ -/* a character item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* CHARACTER*(*) CVALS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'POST', 'PUSH', or 'APPEND'. */ -/* ITEM I Item name. */ -/* N I Number of values to be posted. */ -/* CVALS I Values to be posted. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'POST', 'PUSH', and 'APPEND'. */ - -/* ITEM is the name of a character item, which may or */ -/* may not be on the board already. */ - -/* N is the number of values to be associated with the */ -/* specified item. */ - -/* CVALS are the values. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'POST' creates a new item, containing the specified values. */ -/* (If an item of the same type with the same name already exists, */ -/* it is replaced.) */ - -/* 'PUSH' modifies the list of values associated with an existing */ -/* item by placing items at the beginning of the list (treating the */ -/* list as a push-down stack). */ - -/* 'APPEND' modifies the list of values associated with an existing */ -/* item by placing items at the end of the list (treating the list */ -/* as a queue). */ - -/* Both 'PUSH' and 'APPEND' will create a new item if the specified */ -/* item does not exist. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBPUTC_1", (ftnlen)8); - } - -/* Compress spaces, change cases, as needed. */ - - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by the symbol table routines. (Later, */ -/* it will be done by the card catalog routines.) Note that */ -/* items must be pushed and appended one at a time. */ - - if (s_cmp(what, "POST", (ftnlen)32, (ftnlen)4) == 0) { - syputc_(which, cvals, n, cntab, cptab, cvtab, (ftnlen)32, cvals_len, ( - ftnlen)32, (ftnlen)255); - } else if (s_cmp(what, "PUSH", (ftnlen)32, (ftnlen)4) == 0) { - for (i__ = *n; i__ >= 1; --i__) { - sypshc_(which, cvals + (i__ - 1) * cvals_len, cntab, cptab, cvtab, - (ftnlen)32, cvals_len, (ftnlen)32, (ftnlen)255); - } - } else if (s_cmp(what, "APPEND", (ftnlen)32, (ftnlen)6) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - syenqc_(which, cvals + (i__ - 1) * cvals_len, cntab, cptab, cvtab, - (ftnlen)32, cvals_len, (ftnlen)32, (ftnlen)255); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBPUTC_1", (ftnlen)8); - return 0; -/* $Procedure BBPUTS ( Bulletin board, put, string ) */ - -L_bbputs_1: -/* $ Abstract */ - -/* Put a value on the board, associated with a string item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* CHARACTER*(*) SVAL */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'POST'. */ -/* ITEM I Item name. */ -/* SVAL I Value to be posted. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Currently, the */ -/* only possible action is 'POST'. */ - -/* ITEM is the name of a string item, which may or */ -/* may not be on the board already. */ - -/* SVAL is the value to be associated with the specified */ -/* item. Trailing blanks are ignored. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'POST' creates a new item, containing the specified value. */ -/* (If an item of the same type with the same name already exists, */ -/* it is replaced.) */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBPUTS_1", (ftnlen)8); - } - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - if (s_cmp(what, "POST", (ftnlen)32, (ftnlen)4) == 0) { - sbset_1__(which, sval, nbuf, pbuf, vbuf, (ftnlen)32, sval_len, ( - ftnlen)32, (ftnlen)100); - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBPUTS_1", (ftnlen)8); - return 0; -/* $Procedure BBGETI ( Bulletin board, get, integer ) */ - -L_bbgeti_1: -/* $ Abstract */ - -/* Get one or more values from the board, associated with */ -/* an integer item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* INTEGER IVALS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'COPY', 'TAKE', or 'POP'. */ -/* ITEM I Item name. */ -/* N I,O Number of values returned. */ -/* IVALS O Values. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'COPY', 'TAKE', and 'POP'. */ - -/* ITEM is the name of an integer item, which must be */ -/* on the board. */ - -/* N on input is the number of values to be popped. */ - - -/* $ Detailed_Output */ - -/* N on output is the number of values returned. */ - -/* IVALS are some or all of the values associated with the */ -/* specified item. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* 2) If ITEM is not found, or if the number of values to be popped */ -/* is smaller than the number of values associated with the item, */ -/* the error 'SPICE(ALLGONE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'COPY' returns all of the values associated with the specified */ -/* item. The number of values is returned in N. Copying an item */ -/* leaves the item intact. */ - -/* 'TAKE' returns all of the values associated with the specified */ -/* item. The number of values is returned in N. Unlike copying, */ -/* taking an item removes the item from the board. */ - -/* 'POP' takes some of the values associated with the specified */ -/* item. Items are taken from the front of the list; the remaining */ -/* values are left intact. The number of values to be popped is */ -/* specified in N. Popping the final value of an item removes the */ -/* item from the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBGETI_1", (ftnlen)8); - } - -/* Compress spaces, change cases, as needed. */ - - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by the symbol table routines. (Later, */ -/* it will be done by the card catalog routines.) Note that */ -/* items must be popped one at a time. */ - - if (s_cmp(what, "COPY", (ftnlen)32, (ftnlen)4) == 0 || s_cmp(what, "TAKE", - (ftnlen)32, (ftnlen)4) == 0) { - sygeti_(which, intab, iptab, ivtab, n, ivals, &fnd, (ftnlen)32, ( - ftnlen)32); - if (! fnd) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } else if (s_cmp(what, "TAKE", (ftnlen)32, (ftnlen)4) == 0) { - sydeli_(which, intab, iptab, ivtab, (ftnlen)32, (ftnlen)32); - } - } else if (s_cmp(what, "POP", (ftnlen)32, (ftnlen)3) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sypopi_(which, intab, iptab, ivtab, &ivals[i__ - 1], &fnd, ( - ftnlen)32, (ftnlen)32); - } - if (! fnd) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBGETI_1", (ftnlen)8); - return 0; -/* $Procedure BBGETD ( Bulletin board, get, DP ) */ - -L_bbgetd_1: -/* $ Abstract */ - -/* Get one or more values from the board, associated with */ -/* a DP item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* DOUBLE PRECISION DVALS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'COPY', 'TAKE', or 'POP'. */ -/* ITEM I Item name. */ -/* N I,O Number of values returned. */ -/* DVALS O Values. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'COPY', 'TAKE', and 'POP'. */ - -/* ITEM is the name of a DP item, which must be */ -/* on the board. */ - -/* N on input is the number of values to be popped. */ - - -/* $ Detailed_Output */ - -/* N on output is the number of values returned. */ - -/* DVALS are some or all of the values associated with the */ -/* specified item. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* 2) If ITEM is not found, or if the number of values to be popped */ -/* is smaller than the number of values associated with the item, */ -/* the error 'SPICE(ALLGONE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'COPY' returns all of the values associated with the specified */ -/* item. The number of values is returned in N. Copying an item */ -/* leaves the item intact. */ - -/* 'TAKE' returns all of the values associated with the specified */ -/* item. The number of values is returned in N. Unlike copying, */ -/* taking an item removes the item from the board. */ - -/* 'POP' takes some of the values associated with the specified */ -/* item. Items are taken from the front of the list; the remaining */ -/* values are left intact. The number of values to be popped is */ -/* specified in N. Popping the final value of an item removes the */ -/* item from the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBGETD_1", (ftnlen)8); - } - -/* Compress spaces, change cases, as needed. */ - - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by the symbol table routines. (Later, */ -/* it will be done by the card catalog routines.) Note that */ -/* items must be popped one at a time. */ - - if (s_cmp(what, "COPY", (ftnlen)32, (ftnlen)4) == 0 || s_cmp(what, "TAKE", - (ftnlen)32, (ftnlen)4) == 0) { - sygetd_(which, dntab, dptab, dvtab, n, dvals, &fnd, (ftnlen)32, ( - ftnlen)32); - if (! fnd) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } else if (s_cmp(what, "TAKE", (ftnlen)32, (ftnlen)4) == 0) { - sydeld_(which, dntab, dptab, dvtab, (ftnlen)32, (ftnlen)32); - } - } else if (s_cmp(what, "POP", (ftnlen)32, (ftnlen)3) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sypopd_(which, dntab, dptab, dvtab, &dvals[i__ - 1], &fnd, ( - ftnlen)32, (ftnlen)32); - } - if (! fnd) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBGETD_1", (ftnlen)8); - return 0; -/* $Procedure BBGETC ( Bulletin board, get, character ) */ - -L_bbgetc_1: -/* $ Abstract */ - -/* Get one or more values from the board, associated with */ -/* a character item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ -/* CHARACTER*(*) CVALS */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'COPY', 'TAKE', or 'POP'. */ -/* ITEM I Item name. */ -/* N I,O Number of values returned. */ -/* CVALS O Values. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'COPY', 'TAKE', and 'POP'. */ - -/* ITEM is the name of a character item, which must be */ -/* on the board. */ - -/* N on input is the number of values to be popped. */ - - -/* $ Detailed_Output */ - -/* N on output is the number of values returned. */ - -/* CVALS are some or all of the values associated with the */ -/* specified item. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* 2) If ITEM is not found, or if the number of values to be popped */ -/* is smaller than the number of values associated with the item, */ -/* the error 'SPICE(ALLGONE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'COPY' returns all of the values associated with the specified */ -/* item. The number of values is returned in N. Copying an item */ -/* leaves the item intact. */ - -/* 'TAKE' returns all of the values associated with the specified */ -/* item. The number of values is returned in N. Unlike copying, */ -/* taking an item removes the item from the board. */ - -/* 'POP' takes some of the values associated with the specified */ -/* item. Items are taken from the front of the list; the remaining */ -/* values are left intact. The number of values to be popped is */ -/* specified in N. Popping the final value of an item removes the */ -/* item from the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBGETC_1", (ftnlen)8); - } - -/* Compress spaces, change cases, as needed. */ - - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by the symbol table routines. (Later, */ -/* it will be done by the card catalog routines.) Note that */ -/* items must be popped one at a time. */ - - if (s_cmp(what, "COPY", (ftnlen)32, (ftnlen)4) == 0 || s_cmp(what, "TAKE", - (ftnlen)32, (ftnlen)4) == 0) { - sygetc_(which, cntab, cptab, cvtab, n, cvals, &fnd, (ftnlen)32, ( - ftnlen)32, (ftnlen)255, cvals_len); - if (! fnd) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } else if (s_cmp(what, "TAKE", (ftnlen)32, (ftnlen)4) == 0) { - sydelc_(which, cntab, cptab, cvtab, (ftnlen)32, (ftnlen)32, ( - ftnlen)255); - } - } else if (s_cmp(what, "POP", (ftnlen)32, (ftnlen)3) == 0) { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - sypopc_(which, cntab, cptab, cvtab, cvals + (i__ - 1) * cvals_len, - &fnd, (ftnlen)32, (ftnlen)32, (ftnlen)255, cvals_len); - } - if (! fnd) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBGETC_1", (ftnlen)8); - return 0; -/* $Procedure BBGETS ( Bulletin board, get, string ) */ - -L_bbgets_1: -/* $ Abstract */ - -/* Get a value from the board, associated with a string item. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ACTION */ -/* CHARACTER*(*) ITEM */ -/* CHARACTER*(*) SVAL */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ACTION I Action: 'COPY' or 'TAKE'. */ -/* ITEM I Item name. */ -/* SVAL O Value. */ - -/* $ Detailed_Input */ - -/* ACTION specifies an action to be taken. Possible actions */ -/* are 'COPY' and 'TAKE'. */ - -/* ITEM is the name of a string item, which must be */ -/* on the board. */ - -/* $ Detailed_Output */ - -/* SVAL is the value associated with the specified item. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ACTION is not recognized, the error 'SPICE(UNNATURALACT)' */ -/* is signalled. */ - -/* 2) If ITEM is not found, the error 'SPICE(ALLGONE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* 'COPY' returns the value associated with the specified item. */ -/* Copying an item leaves the item intact. */ - -/* 'TAKE' returns the value associated with the specified item. */ -/* Unlike copying, taking an item removes the item from the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBGETS_1", (ftnlen)8); - } - cmprss_(" ", &c__0, action, what, (ftnlen)1, action_len, (ftnlen)32); - ucase_(what, what, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - if (s_cmp(what, "COPY", (ftnlen)32, (ftnlen)4) == 0 || s_cmp(what, "TAKE", - (ftnlen)32, (ftnlen)4) == 0) { - sbget_1__(which, nbuf, pbuf, vbuf, sval, &pos, (ftnlen)32, (ftnlen)32, - (ftnlen)100, sval_len); - if (pos == 0) { - setmsg_("Could not find item #.", (ftnlen)22); - errch_("#", which, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(ALLGONE)", (ftnlen)14); - } else if (s_cmp(what, "TAKE", (ftnlen)32, (ftnlen)4) == 0) { - sbrem_1__(which, nbuf, pbuf, vbuf, (ftnlen)32, (ftnlen)32, ( - ftnlen)100); - } - } else { - setmsg_("Sorry, # is not a legal action.", (ftnlen)31); - errch_("#", what, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(UNNATURALACT)", (ftnlen)19); - } - chkout_("BBGETS_1", (ftnlen)8); - return 0; -/* $Procedure BBREMI ( Bulletin board, remove, integer ) */ - -L_bbremi_1: -/* $ Abstract */ - -/* Remove an integer item from the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of an integer item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ITEM is not recognized, the board is not changed. */ -/* No error occurs. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Items may also be removed by calling BBGETI, using 'TAKE' */ -/* or 'POP'. However, BBREMI allows you to remove an item without */ -/* providing space for its values. Also, it does not cause an */ -/* error if the item is not on the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBREMI_1", (ftnlen)8); - } - -/* Compress spaces as needed. */ - - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by a symbol table routine. (Later, */ -/* it will be done by a card catalog routine.) */ - - sydeli_(which, intab, iptab, ivtab, (ftnlen)32, (ftnlen)32); - chkout_("BBREMI_1", (ftnlen)8); - return 0; -/* $Procedure BBREMD ( Bulletin board, remove, DP ) */ - -L_bbremd_1: -/* $ Abstract */ - -/* Remove a DP item from the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a DP item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ITEM is not recognized, the board is not changed. */ -/* No error occurs. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Items may also be removed by calling BBGETD, using 'TAKE' */ -/* or 'POP'. However, BBREMD allows you to remove an item without */ -/* providing space for its values. Also, it does not cause an */ -/* error if the item is not on the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBREMD_1", (ftnlen)8); - } - -/* Compress spaces as needed. */ - - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by a symbol table routine. (Later, */ -/* it will be done by a card catalog routine.) */ - - sydeld_(which, dntab, dptab, dvtab, (ftnlen)32, (ftnlen)32); - chkout_("BBREMD_1", (ftnlen)8); - return 0; -/* $Procedure BBREMC ( Bulletin board, remove, character ) */ - -L_bbremc_1: -/* $ Abstract */ - -/* Remove a character item from the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a character item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ITEM is not recognized, the board is not changed. */ -/* No error occurs. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Items may also be removed by calling BBGETC, using 'TAKE' */ -/* or 'POP'. However, BBREMC allows you to remove an item without */ -/* providing space for its values. Also, it does not cause an */ -/* error if the item is not on the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBREMC_1", (ftnlen)8); - } - -/* Compress spaces as needed. */ - - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by a symbol table routine. (Later, */ -/* it will be done by a card catalog routine.) */ - - sydelc_(which, cntab, cptab, cvtab, (ftnlen)32, (ftnlen)32, (ftnlen)255); - chkout_("BBREMC_1", (ftnlen)8); - return 0; -/* $Procedure BBREMS ( Bulletin board, remove, string ) */ - -L_bbrems_1: -/* $ Abstract */ - -/* Remove a string item from the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a string item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* 1) If ITEM is not recognized, the board is not changed. */ -/* No error occurs. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Items may also be removed by calling BBGETS, using 'TAKE'. */ -/* However, BBREMS allows you to remove an item without */ -/* providing space for its value. Also, it does not cause an */ -/* error if the item is not on the board. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBREMS_1", (ftnlen)8); - } - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - sbrem_1__(which, nbuf, pbuf, vbuf, (ftnlen)32, (ftnlen)32, (ftnlen)100); - chkout_("BBREMS_1", (ftnlen)8); - return 0; -/* $Procedure BBFNDI ( Bulletin board, find, integer ) */ - -L_bbfndi_1: -/* $ Abstract */ - -/* Find an integer item on the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ -/* N O Number of values. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of an integer item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with the item. */ -/* If the item is not on the board, N is zero. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BBFNDI has two main uses: */ - -/* 1) To confirm that an item exists before attempting to */ -/* copy or take its values (anticipating a possible error). */ - -/* 2) To determine the number of values associated with an */ -/* item, so that the right number of values can be popped */ -/* from the value list. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBFNDI_1", (ftnlen)8); - } - -/* Compress spaces as needed. */ - - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by a symbol table routine. (Later, */ -/* it will be done by a card catalog routine.) */ - - *n = sydimi_(which, intab, iptab, ivtab, (ftnlen)32, (ftnlen)32); - chkout_("BBFNDI_1", (ftnlen)8); - return 0; -/* $Procedure BBFNDD ( Bulletin board, find, DP ) */ - -L_bbfndd_1: -/* $ Abstract */ - -/* Find a DP item on the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ -/* N O Number of values. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a DP item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with the item. */ -/* If the item is not on the board, N is zero. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BBFNDD has two main uses: */ - -/* 1) To confirm that an item exists before attempting to */ -/* copy or take its values (anticipating a possible error). */ - -/* 2) To determine the number of values associated with an */ -/* item, so that the right number of values can be popped */ -/* from the value list. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBFNDD_1", (ftnlen)8); - } - -/* Compress spaces as needed. */ - - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by a symbol table routine. (Later, */ -/* it will be done by a card catalog routine.) */ - - *n = sydimd_(which, dntab, dptab, dvtab, (ftnlen)32, (ftnlen)32); - chkout_("BBFNDD_1", (ftnlen)8); - return 0; -/* $Procedure BBFNDC ( Bulletin board, find, character ) */ - -L_bbfndc_1: -/* $ Abstract */ - -/* Find a character item on the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ -/* N O Number of values. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a character item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with the item. */ -/* If the item is not on the board, N is zero. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BBFNDC has two main uses: */ - -/* 1) To confirm that an item exists before attempting to */ -/* copy or take its values (anticipating a possible error). */ - -/* 2) To determine the number of values associated with an */ -/* item, so that the right number of values can be popped */ -/* from the value list. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBFNDC_1", (ftnlen)8); - } - -/* Compress spaces as needed. */ - - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - -/* The real work is done by a symbol table routine. (Later, */ -/* it will be done by a card catalog routine.) */ - - *n = sydimc_(which, cntab, cptab, cvtab, (ftnlen)32, (ftnlen)32, (ftnlen) - 255); - chkout_("BBFNDC_1", (ftnlen)8); - return 0; -/* $Procedure BBFNDS ( Bulletin board, find, string ) */ - -L_bbfnds_1: -/* $ Abstract */ - -/* Find a string item on the board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ -/* INTEGER N */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item name. */ -/* N O Number of values. */ - -/* $ Detailed_Input */ - -/* ITEM is the name of a string item, which may or */ -/* may not be on the board. */ - -/* $ Detailed_Output */ - -/* N is the number of values associated with the item. */ -/* If the item is on the board, N is one. Otherwise */ -/* N is zero. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BBFNDS is used mainly to confirm that an item exists before */ -/* attempting to copy or take its value (anticipating a possible */ -/* error). */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBFNDS_1", (ftnlen)8); - } - cmprss_(" ", &c__0, item, which, (ftnlen)1, item_len, (ftnlen)32); - sbget_1__(which, nbuf, pbuf, vbuf, what, &pos, (ftnlen)32, (ftnlen)32, ( - ftnlen)100, (ftnlen)32); - if (pos > 0) { - *n = 1; - } else { - *n = 0; - } - chkout_("BBFNDS_1", (ftnlen)8); - return 0; -/* $Procedure BBCLR ( Bulletin board, clear ) */ - -L_bbclr_1: -/* $ Abstract */ - -/* Clear the entire board. */ - -/* $ 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 */ - -/* BBOARD */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See BBOARD. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* BBCLR clears the entire bulletin board. The board MUST be */ -/* cleared at least once before any items can be posted. */ -/* This is usually done by the main module of the calling */ -/* program, during program initialization. */ - -/* $ Examples */ - -/* See BBOARD. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 5-APR-1989 (DMT) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("BBCLR_1", (ftnlen)7); - } - -/* Wipe out all three symbol tables. */ - - ssizec_(&c__100, intab, (ftnlen)32); - ssizei_(&c__100, iptab); - ssizei_(&c__5000, ivtab); - ssizec_(&c__100, dntab, (ftnlen)32); - ssizei_(&c__100, dptab); - ssized_(&c__5000, dvtab); - ssizec_(&c__100, cntab, (ftnlen)32); - ssizei_(&c__100, cptab); - ssizec_(&c__300, cvtab, (ftnlen)255); - -/* Re-initialize the string buffer. */ - - sbinit_1__(&c__100, &c__404, &c__50, nbuf, pbuf, vbuf, (ftnlen)32, ( - ftnlen)100); - chkout_("BBCLR_1", (ftnlen)7); - return 0; -} /* bboard_ */ - -/* Subroutine */ int bboard_(char *action, char *item, integer *n, integer * - ivals, doublereal *dvals, char *cvals, char *sval, ftnlen action_len, - ftnlen item_len, ftnlen cvals_len, ftnlen sval_len) -{ - return bboard_0_(0, action, item, n, ivals, dvals, cvals, sval, - action_len, item_len, cvals_len, sval_len); - } - -/* Subroutine */ int bbputi_1__(char *action, char *item, integer *n, integer - *ivals, ftnlen action_len, ftnlen item_len) -{ - return bboard_0_(1, action, item, n, ivals, (doublereal *)0, (char *)0, ( - char *)0, action_len, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbputd_1__(char *action, char *item, integer *n, - doublereal *dvals, ftnlen action_len, ftnlen item_len) -{ - return bboard_0_(2, action, item, n, (integer *)0, dvals, (char *)0, ( - char *)0, action_len, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbputc_1__(char *action, char *item, integer *n, char * - cvals, ftnlen action_len, ftnlen item_len, ftnlen cvals_len) -{ - return bboard_0_(3, action, item, n, (integer *)0, (doublereal *)0, cvals, - (char *)0, action_len, item_len, cvals_len, (ftnint)0); - } - -/* Subroutine */ int bbputs_1__(char *action, char *item, char *sval, ftnlen - action_len, ftnlen item_len, ftnlen sval_len) -{ - return bboard_0_(4, action, item, (integer *)0, (integer *)0, (doublereal - *)0, (char *)0, sval, action_len, item_len, (ftnint)0, sval_len); - } - -/* Subroutine */ int bbgeti_1__(char *action, char *item, integer *n, integer - *ivals, ftnlen action_len, ftnlen item_len) -{ - return bboard_0_(5, action, item, n, ivals, (doublereal *)0, (char *)0, ( - char *)0, action_len, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbgetd_1__(char *action, char *item, integer *n, - doublereal *dvals, ftnlen action_len, ftnlen item_len) -{ - return bboard_0_(6, action, item, n, (integer *)0, dvals, (char *)0, ( - char *)0, action_len, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbgetc_1__(char *action, char *item, integer *n, char * - cvals, ftnlen action_len, ftnlen item_len, ftnlen cvals_len) -{ - return bboard_0_(7, action, item, n, (integer *)0, (doublereal *)0, cvals, - (char *)0, action_len, item_len, cvals_len, (ftnint)0); - } - -/* Subroutine */ int bbgets_1__(char *action, char *item, char *sval, ftnlen - action_len, ftnlen item_len, ftnlen sval_len) -{ - return bboard_0_(8, action, item, (integer *)0, (integer *)0, (doublereal - *)0, (char *)0, sval, action_len, item_len, (ftnint)0, sval_len); - } - -/* Subroutine */ int bbremi_1__(char *item, ftnlen item_len) -{ - return bboard_0_(9, (char *)0, item, (integer *)0, (integer *)0, ( - doublereal *)0, (char *)0, (char *)0, (ftnint)0, item_len, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbremd_1__(char *item, ftnlen item_len) -{ - return bboard_0_(10, (char *)0, item, (integer *)0, (integer *)0, ( - doublereal *)0, (char *)0, (char *)0, (ftnint)0, item_len, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbremc_1__(char *item, ftnlen item_len) -{ - return bboard_0_(11, (char *)0, item, (integer *)0, (integer *)0, ( - doublereal *)0, (char *)0, (char *)0, (ftnint)0, item_len, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbrems_1__(char *item, ftnlen item_len) -{ - return bboard_0_(12, (char *)0, item, (integer *)0, (integer *)0, ( - doublereal *)0, (char *)0, (char *)0, (ftnint)0, item_len, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbfndi_1__(char *item, integer *n, ftnlen item_len) -{ - return bboard_0_(13, (char *)0, item, n, (integer *)0, (doublereal *)0, ( - char *)0, (char *)0, (ftnint)0, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbfndd_1__(char *item, integer *n, ftnlen item_len) -{ - return bboard_0_(14, (char *)0, item, n, (integer *)0, (doublereal *)0, ( - char *)0, (char *)0, (ftnint)0, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbfndc_1__(char *item, integer *n, ftnlen item_len) -{ - return bboard_0_(15, (char *)0, item, n, (integer *)0, (doublereal *)0, ( - char *)0, (char *)0, (ftnint)0, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbfnds_1__(char *item, integer *n, ftnlen item_len) -{ - return bboard_0_(16, (char *)0, item, n, (integer *)0, (doublereal *)0, ( - char *)0, (char *)0, (ftnint)0, item_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int bbclr_1__(void) -{ - return bboard_0_(17, (char *)0, (char *)0, (integer *)0, (integer *)0, ( - doublereal *)0, (char *)0, (char *)0, (ftnint)0, (ftnint)0, ( - ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/bestwd.c b/ext/spice/src/csupport/bestwd.c deleted file mode 100644 index d5ac6567f4..0000000000 --- a/ext/spice/src/csupport/bestwd.c +++ /dev/null @@ -1,730 +0,0 @@ -/* bestwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__2 = 2; - -/* $Procedure BESTWD ( Perform a spell match against a set of words ) */ -/* Subroutine */ int bestwd_(char *word, char *known, integer *cutoff, - integer *best, integer *scores, char *mssg, ftnlen word_len, ftnlen - known_len, ftnlen mssg_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - char case__[32]; - integer help[10], item[10], hits; - char mywd[32]; - integer i__, j, k; - extern integer cardc_(char *, ftnlen); - integer l; - extern integer cardi_(integer *); - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen); - integer nbest, maxsc; - extern integer sizei_(integer *); - integer tries; - char trans[16]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - integer usize; - extern integer matchc_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int matche_(char *, char *, char *, integer *, - ftnlen, ftnlen, ftnlen), scardi_(integer *, integer *); - extern integer matcho_(char *, char *, ftnlen, ftnlen); - integer bscore[10], cscore, length; - extern /* Subroutine */ int mspeld_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - integer oscore; - extern /* Subroutine */ int intord_(integer *, char *, ftnlen), suffix_( - char *, integer *, char *, ftnlen, ftnlen); - integer nknown; - extern integer lstlti_(integer *, integer *, integer *), qrtrim_(char *, - ftnlen); - integer loc; - logical hit; - char nth[80]; - -/* $ Abstract */ - -/* Given a word and a list of known words, return those of the list */ -/* closest to the word along with a diagnostic message. */ - -/* $ 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 */ - -/* COMPARE */ -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WORD I Word to compare against a list of known words. */ -/* KNOWN I List of known words. */ -/* CUTOFF I Fine tuning value. A "good" value is 70. */ -/* BEST O Indices of the best matches. */ -/* SCORES O Scores of the best matches. */ -/* MSSG O Explanatory message. */ - -/* $ Detailed_Input */ - -/* WORD is any word. Typically it will be a word that was not */ -/* equal to some "known" word and for which one wants to */ -/* find the "closest" known word. ONLY the first 32 */ -/* characters of WORD are regarded as being significant. */ - -/* KNOWN is a cell containing "known" words. These might be */ -/* keywords from a command, filenames, directories, etc. */ -/* From these a collection are found that most closely */ -/* match WORD. */ - -/* CUTOFF is an integer used to "fine tune" the matching */ -/* between WORD and the words in KNOWN. */ - -/* CUTOFF should be between 0 and 100. Values of */ -/* CUTOFF greater than 100 will effectively disable */ -/* the more detailed error diagnostics. Values */ -/* less than 0 will simply cause the routine to work */ -/* harder with no gain in information. */ - -/* A "good" value for CUTOFF is 70. You will probably */ -/* want your input value to be close to this. */ - -/* $ Detailed_Output */ - -/* BEST BEST is a cell. On output BEST contains the indices of */ -/* the items in KNOWN that yielded the maximum comparison */ -/* score when compared to word. BEST will never contain */ -/* more than 10 indices. (It will rarely contain more */ -/* than two.) */ - -/* SCORE SCORE is a cell. SCORE is assumed to be declared the */ -/* same size as BEST. On output SCORE(I) contains the */ -/* score that measures the similarity between between */ -/* KNOWN(BEST(I)) and WORD. */ - -/* If WORD should happen to equal one of the KNOWN words */ -/* SCORE will be returned with a value of 1000. Otherwise */ -/* it will be returned with a value between 0 and 100. */ -/* The higher the value of SCORE(I) the greater the */ -/* similarity between WORD and KNOWN(BEST(I)). */ - -/* By comparing the values in SCORE with CUTOFF you can */ -/* determine how good a particular match is. */ -/* If SCORE is at least as big as CUTOFF the match is */ -/* regarded as a good one. An attempt will have been */ -/* made at giving detailed diagnostics on the difference */ -/* between WORD and the best matching KNOWNs. */ - -/* MSSG is a message that identifies those KNOWN words that */ -/* best match WORD. Moreover, if detailed diagnostics */ -/* are available, they will be reported in MSSG. */ - -/* $ Error_Handling */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine can be used to help a program recover from common */ -/* typing and spelling mistakes. When a word is not recognized, it */ -/* is possible (perhaps likely) that a keystroke or two went awry in */ -/* the typing of the word. If the list of legitimate words is */ -/* available, the unrecognized word can be compared with the */ -/* recognized words. In this way, the one or ones that most nearly */ -/* resemble the unrecognized word can be identified. From there the */ -/* program may point out the likely problem, offer to fix it, fix it */ -/* and continue (or any subset of these). Thus to some extent the */ -/* program can do what you meant, not what you typed. */ - -/* To measure the similarity between two words several techniques */ -/* are employed. The first of these just compares the letter */ -/* sets of the two words. For example the letter sets for the */ -/* words 'SIMILARITY' and 'SIMILITUDE' are */ - -/* {A1, I1, I2, I3, L1, M1, R1, S1, T1, Y1 } */ - -/* and */ - -/* {E1, I1, I2, I3, L1, M1, S1, T1, U1 } */ - -/* (Note that repeated letters are regardeds as distinct.) */ - -/* By examining the symmetric difference between these two sets */ -/* one can get a measure of the how close the two words are. */ -/* The method used to compute the score will yield a value of */ -/* 75 or higher for pairs of words whose letter sets have */ -/* a symmetric difference of 2 or fewer letters. */ - -/* This does a good job of separating words such as */ -/* 'CANADA' and 'ILLINOIS'. However, it fails completely to */ -/* separate the words 'TRIANGLE', 'INTEGRAL', 'RELATING' and */ -/* 'ALTERING'. These four words all have the same letter sets. */ - -/* Thus for words that compare well on the basis of letter sets */ -/* a second (more time consuming) comparison is made to see if */ -/* the words preserve the relative letter order. In this step */ -/* each word is used to construct a sequence of templates */ -/* that are then matched against the other. A tally of the */ -/* hits to misses is kept. The roles of the two words are then */ -/* reversed and another tally computed. The average of these */ -/* two scores is given to the word pair. */ -/* This is best illustrated with a simple example. */ - -/* Consider the words ANGER and RANGE. */ - -/* ANGER will be used to construct the 10 templates: */ - -/* *A*N*, *A*G*, *A*E*, *A*R*, *N*G*, */ -/* *N*E*, *N*R*, *G*E*, *G*R*, *E*R* */ - -/* Six of these match RANGE, namely */ - -/* *A*N*, *A*G*, *A*E*, *N*G*, *N*E*, *G*E*, *E*R* */ - -/* Next the 4 templates */ - -/* *AN*, *NG*, *GE*, *ER* */ - -/* will be compared with RANGE, The first three match. Each */ -/* of these matches are "extra matches" that are added on to */ -/* the first 6 matches. The score for ANGER to RANGE is */ - -/* 100 * MIN{1,(total matches / numer of templates of form *x*y*)} */ -/* = 100 * MIN{1, 9/10 } */ -/* = 90 */ - -/* The method extends in the obvious way to longer and shorter */ -/* words than ANGER and RANGE. As can be seen, this method of */ -/* comparing one word against another, requires not only the */ -/* correct letters to be present but they must also be in the */ -/* correct relative order. Note that a perfect score of 100 */ -/* does not mean the words are the same. For example */ - -/* AEAE and EAEA */ - -/* yield an identical set of templates and hence have a matching */ -/* score of 100. However, if both words have no letters repeated, */ -/* a score of 100 implies that the words are in fact the same. */ - -/* If both methods of scoring exceed the value of CUTOFF, an */ -/* attempt is made to determine the exact difference between the */ -/* two words. The recognizable differences are: transposition of */ -/* two letters, a letter missing, a letter mistyped, an extra */ -/* letter. Thus CUTOFF allows the user to tune the circumstances */ -/* underwhich a attempts will be made to perform detailed */ -/* diagnosis of the the difference between a pair of words. */ - -/* Empirically, it has been found that two words match up well if */ -/* both methods of scoring yield values of at least 70. This */ -/* is the recommended value for CUTOFF. */ - -/* If both methods of scoring above yield values that exceed CUTOFF, */ -/* the two scores are averaged to give the score reported in SCORE. */ -/* If they do not both exceed CUTOFF but the average does, then */ -/* the score returned is CUTOFF-1. */ - -/* CUTOFF can also be used as your means of determining how good */ -/* a match was. Words with matching scores at least CUTOFF are */ -/* regarded as "good" matches, otherwise the match is viewed as */ -/* "poor." */ - -/* $ Examples */ - -/* Suppose that */ - -/* CUTOFF = 70 */ -/* KNOWN = 'ALTITUDE', 'CONTRACT', */ -/* 'APPLE', 'INTEGRATE', */ -/* 'LONGITUDE', 'EXTRACT', */ -/* 'JUPITER', 'LATITUDE', */ -/* 'EXPAND', 'SATURN', */ -/* 'MERIDIAN', 'SHIFT', */ -/* 'URANUS', 'ELEVATION', */ -/* 'EPOCH', 'NEPTUNE', */ -/* 'ASCENSION', 'DELTA', */ -/* 'PLUTO', 'DECLINATION', */ -/* 'COMPLEMENT' */ - -/* If WORD = 'APPLY' then BEST(0) = 1 */ -/* KNOWN(BEST(1)) = 'APPLE' */ -/* SCORE( 1 ) = 89 */ - - -/* If WORD = 'X' then BEST(0) = 2 */ -/* KNOWN(BEST(1)) = 'EXTRACT' */ -/* SCORE( 1 ) = 7 */ - -/* KNOWN(BEST(2)) = 'EXPAND' */ -/* SCORE( 2 ) = 8 */ - - -/* If WORD = 'NEMPTUNE' then BEST(0) = 1 */ -/* KNOWN(BEST(1)) = 'NEPTUNE' */ -/* SCORE( 1 ) = 95 */ - - -/* If WORD = 'ELATION' then BEST(0) = 1 */ -/* KNOWN(BEST(1)) = 'ELEVATION' */ -/* SCORE( 1 ) = 94 */ - - -/* If WORD = 'QQQ' then BEST(0) = 0 */ - - -/* If WORD = 'COEMPLMENT' then BEST(1) = 1 */ -/* KNOWN(BEST(1)) = 'COMPLEMENT' */ -/* SCORE( 1 ) = 100 */ - - -/* $ Restrictions */ - -/* SCORES must be declared to be at least as large as BEST. */ - -/* At most 10 best indices will be returned in BEST. */ - -/* $ 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, 12-APR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* First determine how many words we have to compare with */ -/* and the amount of room for reporting indices of "good" */ -/* matches. */ - - nknown = cardc_(known, known_len); - nbest = sizei_(best); - -/* This routine only works on words of 32 or fewer characters */ - - s_copy(mywd, " ", (ftnlen)32, (ftnlen)1); - s_copy(mywd, word, (ftnlen)32, word_len); - -/* USIZE refers to the amount of space we will actually */ -/* use in the buffers that store the best MATCHC scores and */ -/* the associated KNOWN word. */ - -/* Computing MIN */ - i__1 = min(10,nknown); - usize = min(i__1,nbest); - i__1 = usize; - for (i__ = 1; i__ <= i__1; ++i__) { - bscore[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("bscore", - i__2, "bestwd_", (ftnlen)394)] = 0; - item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("item", i__2, - "bestwd_", (ftnlen)395)] = 0; - help[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("help", i__2, - "bestwd_", (ftnlen)396)] = 0; - scores[i__ + 5] = 0; - } - -/* First apply MATCHC against each of the KNOWNs and keep the */ -/* top USIZE words that match. */ - - i__1 = nknown; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Just in case, see if we have an exact match. */ - - if (eqstr_(mywd, known + (i__ + 5) * known_len, (ftnlen)32, known_len) - ) { - scardi_(&c__1, best); - scardi_(&c__1, scores); - best[6] = i__; - scores[6] = 1000; - intord_(&i__, nth, (ftnlen)80); - lcase_(nth, nth, (ftnlen)80, (ftnlen)80); - s_copy(mssg, mywd, mssg_len, (ftnlen)32); - suffix_("is equal to the ", &c__1, mssg, (ftnlen)16, mssg_len); - suffix_(nth, &c__1, mssg, (ftnlen)80, mssg_len); - suffix_(" known word.", &c__1, mssg, (ftnlen)12, mssg_len); - return 0; - } - cscore = matchc_(mywd, known + (i__ + 5) * known_len, (ftnlen)32, - known_len); - j = lstlti_(&cscore, &usize, bscore); - i__2 = j - 1; - for (k = 1; k <= i__2; ++k) { - bscore[(i__3 = k - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("bscore", - i__3, "bestwd_", (ftnlen)437)] = bscore[(i__4 = k) < 10 && - 0 <= i__4 ? i__4 : s_rnge("bscore", i__4, "bestwd_", ( - ftnlen)437)]; - item[(i__3 = k - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge("item", - i__3, "bestwd_", (ftnlen)438)] = item[(i__4 = k) < 10 && - 0 <= i__4 ? i__4 : s_rnge("item", i__4, "bestwd_", ( - ftnlen)438)]; - } - if (j > 0) { - bscore[(i__2 = j - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("bscore", - i__2, "bestwd_", (ftnlen)442)] = cscore; - item[(i__2 = j - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("item", - i__2, "bestwd_", (ftnlen)443)] = i__; - } - } - -/* Now for the top USIZE matches, perform a MATCHO comparison. */ -/* If we get a match of CUTOFF or higher. Run MATCHE against it */ -/* to see if we can guess at what went wrong. */ - -/* So far our best score is 0 and we haven't HIT any good matches. */ - - maxsc = 0; - hits = 0; - i__1 = usize; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Only examine items that have legitimate indices. */ - - if (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("item", - i__2, "bestwd_", (ftnlen)463)] != 0) { - bscore[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("bscore" - , i__2, "bestwd_", (ftnlen)465)] = matcho_(mywd, known + ( - item[(i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : s_rnge( - "item", i__3, "bestwd_", (ftnlen)465)] + 5) * known_len, ( - ftnlen)32, known_len); - cscore = matchc_(mywd, known + (item[(i__2 = i__ - 1) < 10 && 0 <= - i__2 ? i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen) - 466)] + 5) * known_len, (ftnlen)32, known_len); -/* Computing MAX */ - i__3 = bscore[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "bscore", i__2, "bestwd_", (ftnlen)467)]; - maxsc = max(i__3,maxsc); - if (bscore[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "bscore", i__2, "bestwd_", (ftnlen)469)] >= *cutoff && - cscore >= *cutoff) { - -/* We've HIT a good match. */ - - ++hits; - -/* See if the problem with this word can be diagnosed */ -/* with MATCHE. */ - - matche_(mywd, known + (item[(i__2 = i__ - 1) < 10 && 0 <= - i__2 ? i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen) - 481)] + 5) * known_len, trans, &loc, (ftnlen)32, - known_len, (ftnlen)16); - -/* If a diagnosis can be performed on this item, we */ -/* say that HELP is available at level 2. Otherwise */ -/* since we have a good match anyway we say HELP is */ -/* available at level 1. */ - - if (s_cmp(trans, "NONE", (ftnlen)16, (ftnlen)4) != 0) { - help[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "help", i__2, "bestwd_", (ftnlen)491)] = 2; - } else { - help[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "help", i__2, "bestwd_", (ftnlen)493)] = 1; - } - } - } - } - -/* If none of the words had a sufficiently high score, just */ -/* report those that had the maximum score. */ - - if (hits == 0) { - -/* Just report the item(s) that had the biggest score. */ - -/* First see how many had the maximum score. */ - - i__1 = usize; - for (i__ = 1; i__ <= i__1; ++i__) { - if (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("item" - , i__2, "bestwd_", (ftnlen)513)] != 0) { - if (bscore[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "bscore", i__2, "bestwd_", (ftnlen)515)] == maxsc) { - ++hits; - } - } - } - -/* If there were no KNOWN words that had letters in common */ -/* with MYWD, all of the elements of the array ITEM will be */ -/* zero and we will not have made any HITS against MAXSC. */ -/* There is nothing at all we can do in this case. */ - - if (hits == 0) { - s_copy(mssg, "The word", mssg_len, (ftnlen)8); - suffix_(mywd, &c__1, mssg, (ftnlen)32, mssg_len); - suffix_("has nothing in common with any of", &c__1, mssg, (ftnlen) - 33, mssg_len); - suffix_("the words I can recognize. If ", &c__1, mssg, (ftnlen) - 31, mssg_len); - suffix_("this word was typed interactively,", &c__1, mssg, ( - ftnlen)34, mssg_len); - suffix_("you may want to see if your ", &c__1, mssg, (ftnlen)28, - mssg_len); - suffix_("fingers are over the correct keys.", &c__1, mssg, ( - ftnlen)34, mssg_len); - scardi_(&c__0, best); - scardi_(&c__0, scores); - return 0; - } - -/* Still here. Then we have at least some item that has */ -/* something in common with MYWD. Set up a closing string so */ -/* that grammar will be correct. */ - - if (hits > 1) { - s_copy(case__, "my closest matches are: ", (ftnlen)32, (ftnlen)24) - ; - } else { - s_copy(case__, "my closest match is: ", (ftnlen)32, (ftnlen)21); - } - s_copy(mssg, "The word '", mssg_len, (ftnlen)10); - suffix_(mywd, &c__1, mssg, (ftnlen)32, mssg_len); - suffix_("' did not match up well with any of", &c__1, mssg, (ftnlen) - 35, mssg_len); - suffix_("the words I was comparing against.", &c__1, mssg, (ftnlen)34, - mssg_len); - suffix_("However,", &c__1, mssg, (ftnlen)8, mssg_len); - suffix_(case__, &c__1, mssg, (ftnlen)32, mssg_len); - -/* Now append the list of KNOWN words that matched MYWD with */ -/* the highest score. */ - - hit = FALSE_; - j = 0; - i__1 = usize; - for (i__ = 1; i__ <= i__1; ++i__) { - if (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("item" - , i__2, "bestwd_", (ftnlen)576)] == 0) { - -/* don't do anything */ - - } else if (bscore[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("bscore", i__2, "bestwd_", (ftnlen)582)] == maxsc) - { - ++j; - best[j + 5] = item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("item", i__2, "bestwd_", (ftnlen)586)]; - l = qrtrim_(known + (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen)587)] - + 5) * known_len, known_len); - if (hit) { - suffix_(", '", &c__0, mssg, (ftnlen)4, mssg_len); - suffix_(known + (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen) - 592)] + 5) * known_len, &c__0, mssg, l, mssg_len); - suffix_("'", &c__0, mssg, (ftnlen)1, mssg_len); - } else { - hit = TRUE_; - suffix_("'", &c__1, mssg, (ftnlen)1, mssg_len); - suffix_(known + (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen) - 600)] + 5) * known_len, &c__0, mssg, l, mssg_len); - suffix_("'", &c__0, mssg, (ftnlen)1, mssg_len); - } - suffix_(".", &c__0, mssg, (ftnlen)1, mssg_len); - } - } - -/* Set the cardinality of the window of BEST indices. */ - - scardi_(&j, best); - } else if (hits == 1) { - -/* There was just one KNOWN word for which there was a good */ -/* match. Call MSPELD to produce a diagnosis of the problem */ -/* and record the index of the item. */ - - i__ = 1; - while(help[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("help", - i__1, "bestwd_", (ftnlen)625)] == 0) { - ++i__; - } - mspeld_(mywd, known + (item[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 - : s_rnge("item", i__1, "bestwd_", (ftnlen)629)] + 5) * - known_len, mssg, (ftnlen)32, known_len, mssg_len); - best[6] = item[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "item", i__1, "bestwd_", (ftnlen)631)]; - scardi_(&c__1, best); - } else { - -/* There were at least two "good" words. If any of them */ -/* could be diagnosed, then report them. Otherwise */ -/* report only those that had a maximum MATCHO score. */ - - tries = 0; - for (i__ = 1; i__ <= 5; ++i__) { - if (help[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("help" - , i__1, "bestwd_", (ftnlen)645)] == 2) { - ++tries; - } - } - if (tries == 0) { - -/* None of the KNOWN words had diagnostics available. */ - - s_copy(mssg, "Although a the spelling error can't be described i" - "n a simple way, I have found the following words that m" - "ay be what you were trying to say. ", mssg_len, (ftnlen) - 142); - j = 0; - i__1 = usize; - for (i__ = 1; i__ <= i__1; ++i__) { - if (help[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "help", i__2, "bestwd_", (ftnlen)665)] != 0) { - suffix_("'", &c__2, mssg, (ftnlen)1, mssg_len); - suffix_(known + (item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen) - 668)] + 5) * known_len, &c__0, mssg, known_len, - mssg_len); - suffix_("',", &c__0, mssg, (ftnlen)2, mssg_len); - ++j; - best[j + 5] = item[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("item", i__2, "bestwd_", (ftnlen) - 672)]; - } - } - scardi_(&j, best); - i__1 = qrtrim_(mssg, mssg_len) - 1; - s_copy(mssg + i__1, " ", qrtrim_(mssg, mssg_len) - i__1, (ftnlen) - 1); - } else if (tries == 1) { - -/* Only one of the KNOWN words had diagnostics available. */ - - for (i__ = 1; i__ <= 5; ++i__) { - if (help[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( - "help", i__1, "bestwd_", (ftnlen)689)] == 2) { - mspeld_(mywd, known + (item[(i__1 = i__ - 1) < 10 && 0 <= - i__1 ? i__1 : s_rnge("item", i__1, "bestwd_", ( - ftnlen)690)] + 5) * known_len, mssg, (ftnlen)32, - known_len, mssg_len); - best[6] = item[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("item", i__1, "bestwd_", (ftnlen)691)]; - } - } - scardi_(&c__1, best); - } else { - -/* At least two of the KNOWN words had diagnostics available. */ -/* Report all of them. */ - - s_copy(mssg, "The following common spelling mistakes may be the " - "reason I did not recognize ", mssg_len, (ftnlen)77); - suffix_(mywd, &c__1, mssg, (ftnlen)32, mssg_len); - suffix_(".", &c__1, mssg, (ftnlen)1, mssg_len); - length = i_len(mssg, mssg_len); - j = 0; - i__1 = usize; - for (i__ = 1; i__ <= i__1; ++i__) { - if (help[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge( - "help", i__2, "bestwd_", (ftnlen)716)] == 2) { - if (qrtrim_(mssg, mssg_len) < length - 3) { - i__3 = qrtrim_(mssg, mssg_len) + 2; - mspeld_(mywd, known + (item[(i__2 = i__ - 1) < 10 && - 0 <= i__2 ? i__2 : s_rnge("item", i__2, "bes" - "twd_", (ftnlen)719)] + 5) * known_len, mssg + - i__3, (ftnlen)32, known_len, mssg_len - i__3); - ++j; - best[j + 5] = item[(i__2 = i__ - 1) < 10 && 0 <= i__2 - ? i__2 : s_rnge("item", i__2, "bestwd_", ( - ftnlen)723)]; - } - } - } - scardi_(&j, best); - } - } - -/* As for the scores, we will report the average of the MATCHO and */ -/* MATCHC scores for the best matches. */ - - i__1 = cardi_(best); - for (i__ = 1; i__ <= i__1; ++i__) { - oscore = matcho_(mywd, known + (best[i__ + 5] + 5) * known_len, ( - ftnlen)32, known_len); - cscore = matchc_(mywd, known + (best[i__ + 5] + 5) * known_len, ( - ftnlen)32, known_len); - scores[i__ + 5] = (oscore + cscore) / 2; - if (oscore < *cutoff || cscore < *cutoff) { -/* Computing MIN */ - i__2 = scores[i__ + 5], i__3 = *cutoff - 1; - scores[i__ + 5] = min(i__2,i__3); - } - } - i__1 = cardi_(best); - scardi_(&i__1, scores); - return 0; -} /* bestwd_ */ - diff --git a/ext/spice/src/csupport/builtn.c b/ext/spice/src/csupport/builtn.c deleted file mode 100644 index dec0c1d214..0000000000 --- a/ext/spice/src/csupport/builtn.c +++ /dev/null @@ -1,423 +0,0 @@ -/* builtn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__5 = 5; -static integer c__2 = 2; -static integer c__1 = 1; - -/* $Procedure BUILTN ( Built in Commands ) */ -/* Subroutine */ int builtn_0_(int n__, char *commnd, logical *hit, char * - error, ftnlen commnd_len, ftnlen error_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static logical dosav = TRUE_; - static logical dodisc = TRUE_; - static logical doedit = TRUE_; - static logical dosym = TRUE_; - static logical doenv = TRUE_; - static struct { - char fill_1[480]; - char e_2[400]; - } equiv_22 = { {0}, "SET[set] EDITOR[editor] (1:)@word[rest] " - " SHOW[show] SYMBOL[symbol] @" - "word[def] SHOW[sh" - "ow] ENVIRONMENT[env] " - " SAVE[save] TO @word[rest] " - " DISCARD[discard] " - " " }; - -#define synval ((char *)&equiv_22) - - static char spcial[8*2] = " " "? "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - extern logical have_(char *, ftnlen); - static integer rest, e, i__, l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char names[32*3]; - static logical found; - extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen); - static char myerr[512*2]; - extern /* Subroutine */ int m2chck_(char *, char *, integer *, char *, - char *, ftnlen, ftnlen, ftnlen, ftnlen), m2getc_(char *, char *, - logical *, char *, ftnlen, ftnlen, ftnlen), m2vget_(char *, - integer *, logical *, integer *, integer *, ftnlen), m2ints_( - integer *, char *, integer *, char *, ftnlen, ftnlen); - extern logical m2xist_(char *, ftnlen); - extern /* Subroutine */ int gtecho_(char *, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int getedt_(char *, ftnlen), setedt_(char *, - ftnlen); - extern integer touchi_(integer *); - extern /* Subroutine */ int nspioc_(char *, ftnlen), chkout_(char *, - ftnlen); - static char values[512*3]; - static integer nitems; - extern /* Subroutine */ int flgrpt_(integer *, char *, char *, S_fp, - ftnlen, ftnlen), nsppfl_(char *, char *, ftnlen, ftnlen); - static char templt[80]; - extern /* Subroutine */ int nspsav_(char *, char *, ftnlen, ftnlen), - nspgst_(char *, logical *, ftnlen), nspwln_(char *, ftnlen); - static char synkey[32*11]; - static logical status[3]; - extern /* Subroutine */ int shosym_(char *, ftnlen); - static integer synptr[11]; - -/* $ Abstract */ - -/* This routine handles the normal commands that every */ -/* command line based program will support if you */ -/* use the command loop software. */ - -/* $ Required_Reading */ - -/* None. */ - -/* $ Keywords */ - -/* Command Loop */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COMMND I A command */ -/* HIT O Indicates if the command was a built in command */ -/* ERROR O Indicates any problems that occurred. */ - -/* $ Detailed_Input */ - -/* COMMND is a command that is to be processed to see if it */ -/* is one of the command loop built in commands. */ - -/* $ Detailed_Output */ - -/* HIT is a logical variable. If the input command is */ -/* recognized and acted on, HIT is returned as .TRUE. */ -/* Otherwise it is returned as .FALSE. */ - -/* ERROR is blank unless a built in command is recognized */ -/* and causes an error to be triggered. In the later */ -/* case ERROR will contain the diagnostics associated */ -/* with the error. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If a problem is detected, it is diagnosed and returned */ -/* in the variable ERROR */ - -/* $ Particulars */ - -/* This routine handles the "built in" commands that are */ -/* automatically available with every command loop routine these */ -/* are: */ - -/* SET EDITOR (1:)@word */ -/* SHOW SYMBOL @word */ -/* SHOW ENVIRONMENT */ -/* SAVE TO @word */ -/* DISCARD */ - -/* These built in functions can be overridden (turned off) through */ -/* the companion entry point BUILTO */ - -/* $ Examples */ - -/* See the routine CMLOOP */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-APR-1997 (WLT) */ - -/* Declares NSPWLN as external */ - -/* - SPICELIB Version 1.0.0, 5-DEC-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Command Loop Built in Commands. */ - -/* -& */ - -/* Spicelib functions */ - - -/* Error handling interface routines. */ - - -/* META/2 Functions */ - - -/* Inspekt External Routines */ - - -/* Variables needed for syntax declarations. */ - - -/* The following are for special commands that will not be */ -/* processed by BUILTN. */ - - -/* Other Local Variables */ - - -/* Save everything */ - - /* Parameter adjustments */ - if (error) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_builto; - } - - chkin_("BUILTN", (ftnlen)6); - if (first) { - first = FALSE_; - i__ = 0; - i__ = touchi_(&i__); - m2ints_(&c__5, synkey, synptr, synval, (ftnlen)32, (ftnlen)80); - } - l = ltrim_(commnd, commnd_len); - rest = rtrim_(commnd, commnd_len) + 1; - if (isrchc_(commnd + (l - 1), &c__2, spcial, rest - (l - 1), (ftnlen)8) > - 0) { - chkout_("BUILTN", (ftnlen)6); - return 0; - } - -/* There are no errors yet. */ - - s_copy(error, " ", error_len, (ftnlen)1); - s_copy(error + error_len, " ", error_len, (ftnlen)1); - *hit = FALSE_; - -/* Check the input command to see if it is recognizable */ - - m2chck_(commnd, synkey, synptr, synval, myerr, commnd_len, (ftnlen)32, ( - ftnlen)80, (ftnlen)512); - if (s_cmp(myerr, " ", (ftnlen)512, (ftnlen)1) != 0) { - chkout_("BUILTN", (ftnlen)6); - return 0; - } - if (m2xist_("set", (ftnlen)3) && doedit) { - m2vget_("rest", &c__1, &found, &rest, &e, (ftnlen)4); - setedt_(commnd + (rest - 1), commnd_len - (rest - 1)); - *hit = TRUE_; - } else if (m2xist_("symbol", (ftnlen)6) && dosym) { - m2getc_("def", commnd, &found, templt, (ftnlen)3, commnd_len, (ftnlen) - 80); - shosym_(templt, (ftnlen)80); - *hit = TRUE_; - } else if (m2xist_("env", (ftnlen)3) && doenv) { - nitems = 3; - s_copy(names, "Editor", (ftnlen)32, (ftnlen)6); - s_copy(names + 32, "Echoing Commands", (ftnlen)32, (ftnlen)16); - s_copy(names + 64, "Screen Output File", (ftnlen)32, (ftnlen)18); - getedt_(values, (ftnlen)512); - gtecho_(values + 512, (ftnlen)512); - nspgst_("SAVE", status, (ftnlen)4); - if (status[0] && status[1] && ! status[2]) { - nsppfl_("SAVE", values + 1024, (ftnlen)4, (ftnlen)512); - } else { - s_copy(values + 1024, "No Current Screen Save File", (ftnlen)512, - (ftnlen)27); - } - nspwln_(" ", (ftnlen)1); - nspwln_("Current Environment", (ftnlen)19); - nspwln_(" ", (ftnlen)1); - flgrpt_(&nitems, names, values, (S_fp)nspwln_, (ftnlen)32, (ftnlen) - 512); - nspwln_(" ", (ftnlen)1); - *hit = TRUE_; - } else if (m2xist_("save", (ftnlen)4) && dosav) { - m2vget_("rest", &c__1, &found, &rest, &e, (ftnlen)4); - nspsav_(commnd + (rest - 1), error, commnd_len - (rest - 1), - error_len); - *hit = TRUE_; - } else if (m2xist_("discard", (ftnlen)7) && dodisc) { - nspioc_("SAVE", (ftnlen)4); - *hit = TRUE_; - } - found = have_(error, error_len); - chkout_("BUILTN", (ftnlen)6); - return 0; -/* $Procedure BUILTO ( Built in commands off ) */ - -L_builto: -/* $ Abstract */ - -/* Turn off built-in command loop commands. */ - -/* $ 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 */ - -/* COMMAND LOOP */ - - -/* $ Declarations */ - -/* CHARACTER*(*) COMMND */ - -/* $ Brief_I/O */ -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COMMND I A list of commands to turn off. */ - -/* $ Detailed_Input */ - -/* COMMND is a list of words that describes which built-in */ -/* commands to disable. The words and commands */ -/* they turn off are: */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) No errors are detected. */ - -/* $ Particulars */ - -/* This routine allows you to turn off selected built in commands */ -/* commands available through command loop programs. */ - -/* $ Examples */ - -/* Suppose you want to turn off the SHOW ENVIRONMENT and */ -/* SET EDITOR commands. */ - -/* Do this: */ - -/* COMMAND = 'EDITOR ENVIRONMENT' */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 5-DEC-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Disable built in command loop commmands */ - - -/* -& */ - -/* We just look at command to see which of the built in */ -/* command should be disabled. */ - - dosav = i_indx(commnd, "SAVE", commnd_len, (ftnlen)4) == 0; - doenv = i_indx(commnd, "ENVIRONMENT", commnd_len, (ftnlen)11) == 0; - doedit = i_indx(commnd, "EDITOR", commnd_len, (ftnlen)6) == 0; - dosym = i_indx(commnd, "SYMBOL", commnd_len, (ftnlen)6) == 0; - dodisc = i_indx(commnd, "DISCARD", commnd_len, (ftnlen)7) == 0; - return 0; -} /* builtn_ */ - -#undef synval - - -/* Subroutine */ int builtn_(char *commnd, logical *hit, char *error, ftnlen - commnd_len, ftnlen error_len) -{ - return builtn_0_(0, commnd, hit, error, commnd_len, error_len); - } - -/* Subroutine */ int builto_(char *commnd, ftnlen commnd_len) -{ - return builtn_0_(1, commnd, (logical *)0, (char *)0, commnd_len, (ftnint) - 0); - } - diff --git a/ext/spice/src/csupport/cbget_1.c b/ext/spice/src/csupport/cbget_1.c deleted file mode 100644 index 4d270e525e..0000000000 --- a/ext/spice/src/csupport/cbget_1.c +++ /dev/null @@ -1,214 +0,0 @@ -/* cbget_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CBGET ( Character buffer, get ) */ -/* Subroutine */ int cbget_1__(integer *begin, integer *end, char *buffer, - char *string, ftnlen buffer_len, ftnlen string_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, next, b, i__, l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer buflen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern integer sizecb_1__(char *, ftnlen); - -/* $ Abstract */ - -/* Get (return) a substring of a character buffer. */ - -/* $ 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 */ - -/* CB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BEGIN, */ -/* END I Initial, final buffer locations. */ -/* BUFFER I Character buffer. */ -/* STRING O String. */ - -/* $ Detailed_Input */ - -/* BEGIN, */ -/* END are the initial and final buffer locations of */ -/* the string to be returned. */ - -/* BUFFER is a character buffer. */ - -/* $ Detailed_Output */ - -/* STRING is the string contained between locations BEGIN and */ -/* END of BUFFER. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(CBNOSUCHSTR)' is signalled whenever any of */ -/* the following conditions is detected: */ - -/* -- BEGIN is less than one. */ - -/* -- END is greater than the size of BUFFER. */ - -/* -- BEGIN is greater than END. */ - -/* $ Particulars */ - -/* If you think of the character buffer as a single character string, */ -/* this is exactly equivalent to the operation */ - -/* STRING = BUFFER(BEGIN:END) */ - -/* If shorter than the substring, STRING is truncated. If longer, */ -/* it is padded with blanks. */ - -/* $ Examples */ - -/* The code fragment */ - -/* STR = '..........................' */ - -/* CALL CBPUT ( 1, 13, 'ABCDEFGHIJKLM', BUFFER ) */ -/* CALL CBPUT ( 14, 26, 'NOPQRSTUVWXYZ', BUFFER ) */ -/* CALL CBGET ( 1, 3, BUFFER, STR( 1:10) ) */ -/* CALL CBGET ( 1, 26, BUFFER, STR(11:13) ) */ - -/* WRITE (*,*) '+--------------------------+' */ -/* WRITE (*,*) '|' // STR(1:26) // '|' */ -/* WRITE (*,*) '+--------------------------+' */ - -/* produces the following output. */ - -/* +--------------------------+ */ -/* |ABC ABC.............| */ -/* +--------------------------+ */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CBGET_1", (ftnlen)7); - if (*begin < 1 || *end > sizecb_1__(buffer, buffer_len) || *begin > * - end) { - setmsg_("Tried to access locations #:#.", (ftnlen)30); - errint_("#", begin, (ftnlen)1); - errint_("#", end, (ftnlen)1); - sigerr_("SPICE(CBNOSUCHSTR)", (ftnlen)18); - chkout_("CBGET_1", (ftnlen)7); - return 0; - } - } - -/* Storage begins at location B in line L. */ - - buflen = i_len(buffer + buffer_len, buffer_len); - l = (*begin - 1) / buflen + 1; - b = (*begin - 1) % buflen + 1; - -/* Assign one character at a time, changing input lines when */ -/* necessary. Do not assign any characters beyond the end of */ -/* the output string. */ - - next = 1; - last = i_len(string, string_len); - i__1 = *end; - for (i__ = *begin; i__ <= i__1; ++i__) { - if (next <= last) { - *(unsigned char *)&string[next - 1] = *(unsigned char *)&buffer[l - * buffer_len + (b - 1)]; - ++next; - } - if (b < buflen) { - ++b; - } else { - ++l; - b = 1; - } - } - -/* Pad the output string with blanks, if necessary. */ - - if (next <= last) { - s_copy(string + (next - 1), " ", string_len - (next - 1), (ftnlen)1); - } - chkout_("CBGET_1", (ftnlen)7); - return 0; -} /* cbget_1__ */ - diff --git a/ext/spice/src/csupport/cbinit_1.c b/ext/spice/src/csupport/cbinit_1.c deleted file mode 100644 index 39d4a0d4f2..0000000000 --- a/ext/spice/src/csupport/cbinit_1.c +++ /dev/null @@ -1,184 +0,0 @@ -/* cbinit_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CBINIT ( Character buffer, initialize ) */ -/* Subroutine */ int cbinit_1__(integer *dim, char *buffer, ftnlen buffer_len) -{ - /* System generated locals */ - integer buffer_dim1, i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), enchar_(integer *, - char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Initialize a character buffer. */ - -/* $ 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 */ - -/* CB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* DIM I Dimension of the character buffer array. */ -/* BUFFER I,O Character buffer. */ - -/* $ Detailed_Input */ - -/* DIM is the dimension of the array containing the */ -/* character buffer to be initialized. */ - -/* BUFFER is the array. */ - -/* $ Detailed_Output */ - -/* BUFFER is an initialized character buffer. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(NOTLEGALCB)' is signalled whenever any of */ -/* the following conditions is detected. */ - -/* -- The length of the individual array elements is less */ -/* than eight. */ - -/* -- DIM is less than one. */ - -/* $ Particulars */ - -/* A character buffer must be initialized to allow subsequent */ -/* operations on the buffer to detect possible overflows. */ - -/* $ Examples */ - -/* The following code fragment illustrates the initialization */ -/* of a character buffer. */ - -/* INTEGER LBCBUF */ -/* PARAMETER ( LBCBUF = 0 ) */ - -/* INTEGER BUFDIM */ -/* PARAMETER ( BUFDIM = 256 ) */ - -/* INTEGER BUFLEN */ -/* PARAMETER ( BUFLEN = 1024 ) */ - -/* CHARACTER*(BUFLEN) BUFFER ( LBCBUF:BUFDIM ) */ -/* . */ -/* . */ - -/* CALL CBINIT ( BUFDIM, BUFFER ) */ - -/* In this example, the buffer contains 256K characters of available */ -/* storage (256 array elements of 1024 characters each). Note that */ -/* it is only necessary to supply the dimension of the array (256), */ -/* and not the length of the individual elements (1024). */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling. */ - - /* Parameter adjustments */ - buffer_dim1 = *dim + 1; - - /* Function Body */ - if (return_()) { - return 0; - } else { - chkin_("CBINIT_1", (ftnlen)8); - if (i_len(buffer + ((i__1 = 0) < buffer_dim1 ? i__1 : s_rnge("buffer", - i__1, "cbinit_1__", (ftnlen)149)) * buffer_len, buffer_len) < - 8) { - setmsg_("Length is #.", (ftnlen)12); - i__2 = i_len(buffer + ((i__1 = 0) < buffer_dim1 ? i__1 : s_rnge( - "buffer", i__1, "cbinit_1__", (ftnlen)151)) * buffer_len, - buffer_len); - errint_("#", &i__2, (ftnlen)1); - sigerr_("SPICE(NOTLEGALCB)", (ftnlen)17); - chkout_("CBINIT_1", (ftnlen)8); - return 0; - } else if (*dim < 1) { - setmsg_("Dimension is #.", (ftnlen)15); - errint_("#", dim, (ftnlen)1); - sigerr_("SPICE(NOTLEGALCB)", (ftnlen)17); - chkout_("CBINIT_1", (ftnlen)8); - return 0; - } - } - -/* Store only the dimension. */ - - enchar_(dim, buffer + ((i__1 = 0) < buffer_dim1 ? i__1 : s_rnge("buffer", - i__1, "cbinit_1__", (ftnlen)170)) * buffer_len, (ftnlen)8); - chkout_("CBINIT_1", (ftnlen)8); - return 0; -} /* cbinit_1__ */ - diff --git a/ext/spice/src/csupport/cbput_1.c b/ext/spice/src/csupport/cbput_1.c deleted file mode 100644 index fef699d656..0000000000 --- a/ext/spice/src/csupport/cbput_1.c +++ /dev/null @@ -1,210 +0,0 @@ -/* cbput_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CBPUT ( Character buffer, put ) */ -/* Subroutine */ int cbput_1__(integer *begin, integer *end, char *string, - char *buffer, ftnlen string_len, ftnlen buffer_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer last, next, b, i__, l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer buflen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern integer sizecb_1__(char *, ftnlen); - -/* $ Abstract */ - -/* Put (overwrite) a substring of a character buffer. */ - -/* $ 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 */ - -/* CB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BEGIN, */ -/* END I Initial, final buffer locations. */ -/* STRING I String. */ -/* BUFFER I,O Character buffer. */ - -/* $ Detailed_Input */ - -/* BEGIN, */ -/* END are the initial and final buffer locations of the */ -/* part of the buffer to be overwritten. */ - -/* STRING is a character string. */ - -/* BUFFER is a character buffer. */ - -/* $ Detailed_Output */ - -/* BUFFER is the same character buffer, in which locations */ -/* BEGIN through END have been replaced with the */ -/* contents of STRING. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(CBNOSUCHSTR)' is signalled whenever any of */ -/* the following conditions is detected: */ - -/* -- BEGIN is less than one. */ - -/* -- END is greater than the size of BUFFER. */ - -/* -- BEGIN is greater than END. */ - -/* $ Particulars */ - -/* If you think of the character buffer as a single character string, */ -/* this is exactly equivalent to the operation */ - -/* BUFFER(BEGIN:END) = STRING */ - -/* If shorter than STRING, the substring is truncated. If longer, */ -/* it is padded with blanks. */ - -/* $ Examples */ - -/* The code fragment */ - -/* CALL CBPUT ( 1, 26, ' ', BUFFER ) */ -/* CALL CBPUT ( 1, 10, 'ABC', BUFFER ) */ -/* CALL CBPUT ( 11, 20, 'KLMNOPQRSTUVWXYZ', BUFFER ) */ -/* CALL CBGET ( 1, 26, BUFFER, STR ) */ - -/* WRITE (*,*) '+--------------------------+' */ -/* WRITE (*,*) '|' // STR(1:26) // '|' */ -/* WRITE (*,*) '+--------------------------+' */ - -/* produces the following output. */ - -/* +--------------------------+ */ -/* |ABC KLMNOPQRST | */ -/* +--------------------------+ */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CBPUT_1", (ftnlen)7); - if (*begin < 1 || *end > sizecb_1__(buffer, buffer_len) || *begin > * - end) { - setmsg_("Tried to access locations #:#.", (ftnlen)30); - errint_("#", begin, (ftnlen)1); - errint_("#", end, (ftnlen)1); - sigerr_("SPICE(CBNOSUCHSTR)", (ftnlen)18); - chkout_("CBPUT_1", (ftnlen)7); - return 0; - } - } - -/* Storage begins at location B in line L. */ - - buflen = i_len(buffer + buffer_len, buffer_len); - l = (*begin - 1) / buflen + 1; - b = (*begin - 1) % buflen + 1; - -/* Assign one character at a time, changing output lines when */ -/* necessary, and assigning blanks if the input string should */ -/* come to an early end. */ - - next = 1; - last = i_len(string, string_len); - i__1 = *end; - for (i__ = *begin; i__ <= i__1; ++i__) { - if (next <= last) { - *(unsigned char *)&buffer[l * buffer_len + (b - 1)] = *(unsigned - char *)&string[next - 1]; - ++next; - } else { - *(unsigned char *)&buffer[l * buffer_len + (b - 1)] = ' '; - } - if (b < buflen) { - ++b; - } else { - ++l; - b = 1; - } - } - chkout_("CBPUT_1", (ftnlen)7); - return 0; -} /* cbput_1__ */ - diff --git a/ext/spice/src/csupport/cbrem_1.c b/ext/spice/src/csupport/cbrem_1.c deleted file mode 100644 index 4ba8e5eb67..0000000000 --- a/ext/spice/src/csupport/cbrem_1.c +++ /dev/null @@ -1,215 +0,0 @@ -/* cbrem_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CBREM ( Character buffer, remove ) */ -/* Subroutine */ int cbrem_1__(integer *begin, integer *end, char *buffer, - ftnlen buffer_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - integer b, i__, l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nb, nl, endbuf, buflen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int cbput_1__(integer *, integer *, char *, char * - , ftnlen, ftnlen); - extern integer sizecb_1__(char *, ftnlen); - -/* $ Abstract */ - -/* Remove a string from a character buffer. */ - -/* $ 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 */ - -/* CB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BEGIN, */ -/* END I Initial, final buffer locations. */ -/* BUFFER I,O Character buffer. */ - -/* $ Detailed_Input */ - -/* BEGIN, */ -/* END are the initial and final locations within the */ -/* character buffer bounding the part of the buffer */ -/* to be removed. */ - -/* BUFFER is a character buffer. */ - -/* $ Detailed_Output */ - -/* BUFFER is the same character buffer, with the original */ -/* contents of locations BEGIN through END removed. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(CBNOSUCHSTR)' is signalled whenever any of */ -/* the following conditions is detected: */ - -/* -- BEGIN is less than one. */ - -/* -- END is greater than the size of BUFFER. */ - -/* -- BEGIN is greater than END. */ - -/* $ Particulars */ - -/* If you think of the character buffer as a single character string, */ -/* this is exactly equivalent to the sequence */ - -/* TEMP = BUFFER(END+1: ) */ -/* BUFFER(BEGIN: ) = TEMP */ - -/* where TEMP is a string of infinite length. */ - -/* $ Examples */ - -/* The code fragment */ - -/* CALL CBPUT ( 1, 26, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', BUFFER ) */ -/* CALL CBPUT ( 27, 52, '..........................', BUFFER ) */ -/* CALL CBREM ( 2, 25, BUFFER ) */ -/* CALL CBGET ( 1, 26, BUFFER, STR ) */ - -/* WRITE (*,*) '+--------------------------+' */ -/* WRITE (*,*) '|' // STR(1:26) // '|' */ -/* WRITE (*,*) '+--------------------------+' */ - -/* produces the following output. */ - -/* +--------------------------+ */ -/* |AZ........................| */ -/* +--------------------------+ */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CBREM_1", (ftnlen)7); - if (*begin < 1 || *end > sizecb_1__(buffer, buffer_len) || *begin > * - end) { - setmsg_("Tried to access locations #:#.", (ftnlen)30); - errint_("#", begin, (ftnlen)1); - errint_("#", end, (ftnlen)1); - sigerr_("SPICE(CBNOSUCHSTR)", (ftnlen)18); - chkout_("CBREM_1", (ftnlen)7); - return 0; - } - } - -/* Essential limits. */ - - buflen = i_len(buffer + buffer_len, buffer_len); - endbuf = sizecb_1__(buffer, buffer_len); - -/* Each guy gets moved from location B in line L to location NB */ -/* in line NL. (N stands for New.) */ - - l = *end / buflen + 1; - b = *end % buflen + 1; - nl = (*begin - 1) / buflen + 1; - nb = (*begin - 1) % buflen + 1; - i__1 = endbuf; - for (i__ = *end + 1; i__ <= i__1; ++i__) { - *(unsigned char *)&buffer[nl * buffer_len + (nb - 1)] = *(unsigned - char *)&buffer[l * buffer_len + (b - 1)]; - if (b < buflen) { - ++b; - } else { - ++l; - b = 1; - } - if (nb < buflen) { - ++nb; - } else { - ++nl; - nb = 1; - } - } - -/* Now we can just overwrite the vacated space at the end. */ - - i__1 = endbuf - (*end - *begin); - cbput_1__(&i__1, &endbuf, " ", buffer, (ftnlen)1, buffer_len); - chkout_("CBREM_1", (ftnlen)7); - return 0; -} /* cbrem_1__ */ - diff --git a/ext/spice/src/csupport/changu.c b/ext/spice/src/csupport/changu.c deleted file mode 100644 index 0b2227732c..0000000000 --- a/ext/spice/src/csupport/changu.c +++ /dev/null @@ -1,512 +0,0 @@ -/* changu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__128 = 128; - -/* $Procedure CHANGU ( Change units ) */ -/* Subroutine */ int changu_0_(int n__, char *angle, char *length, char *time, - char *mass, char *charge, char *in, char *out, char *error, ftnlen - angle_len, ftnlen length_len, ftnlen time_len, ftnlen mass_len, - ftnlen charge_len, ftnlen in_len, ftnlen out_len, ftnlen error_len) -{ - /* Initialized data */ - - static char tclass[8*5] = "ANGLE " "LENGTH " "TIME " "MASS " - "CHARGE "; - static logical first = TRUE_; - static integer nop = 6; - static char op[2*6] = " " "( " ") " "* " "**" "/ "; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2], i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int scan_(char *, char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - ftnlen, ftnlen); - static integer pass, nest, size[6]; - static char type__[32*6]; - static integer mult, b, e, f, i__; - static char o[256]; - static integer s, blank, ident[128], class__; - static logical found; - static doublereal value; - static integer oplen[6], start, opptr[20]; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer lparen; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int fnducv_(char *, logical *, integer *, - doublereal *, ftnlen), scanpr_(integer *, char *, integer *, - integer *, ftnlen); - static integer rparen; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static char string[256]; - static integer ntokns, beg[128], end[128], div, exp__; - -/* $ Abstract */ - -/* Determine units having the same dimensions of angle, length, */ -/* time, mass and charge as some set of input units, but with */ -/* respect to a "standard" set of units of the user's choosing. */ - -/* $ 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 */ - -/* CONSTANTS */ -/* CONVERSION */ -/* PARSING */ -/* UNITS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ANGLE I Default unit to use for angles (see OUNITS). */ -/* LENGTH I Default unit to use for lengths (see OUNITS). */ -/* TIME I Default unit to use for time (see OUNITS). */ -/* MASS I Default unit to use for mass (see OUNITS). */ -/* CHARGE I Default unit to use for charge (see OUNITS). */ -/* IN I Units to be transformed to the "standard". */ -/* OUT O Units that the input will be transformed to. */ -/* ERROR O Contains a description of a problem if one occurs. */ -/* ROOM P Maximum number of components in a compound unit. */ - -/* $ Detailed_Input */ - -/* See individual entry points */ - -/* ANGLE is a string indicating which angle unit should be */ -/* used for outputs. */ - -/* LENGTH is a string indicating which distance unit should */ -/* be used for outputs. */ - -/* TIME is a string indicating which time unit should be */ -/* used for outputs. */ - -/* MASS is a string indicating which mass unit should be */ -/* used for outputs. */ - -/* CHARGE is a string indicating which charge unit should be */ -/* used for outputs. */ - -/* IN is the set of units associated with some measurment. */ -/* The dimensionally equivalent "standard" units are */ -/* returned in OUT. */ - -/* $ Detailed_Output */ - -/* See individual entry points. */ - -/* OUT is the set of "standard" units that are dimensionally */ -/* equivalent to the input units given by IN. */ - -/* ERROR Contains a descriptive error message if the */ -/* subroutine call can not be executed successfully. */ - -/* $ Parameters */ - -/* ROOM This routine uses internal storage to construct */ -/* the output for TRANSU. ROOM is the parameter that */ -/* describes the maximum number of components that */ -/* are expected for any compound unit. The components */ -/* of a compound unit are */ - -/* Left parenthesis --- '(' */ -/* Right parenthesis --- ')' */ -/* Exponentiation --- '**' */ -/* Multiplication --- '*' */ -/* Division --- '/' */ -/* Numbers */ -/* Reconized units of angle, distance, time, mass or */ -/* charge. */ - -/* Thus ((10**12*KG)*(10**9*KM)**3)/((2/3)*SEC**2) */ -/* ^^ ^ ^ ^^ ^^^^ ^ ^^^ ^^ ^^^^^^^^^^^ ^ ^^^ */ - -/* Has 31 components. (Each '^' points to the end of a */ -/* component). */ - -/* At the time this routine was written, it was assumed */ -/* that compound units would have fewer than 128 */ -/* components. */ - -/* $ Exceptions */ - -/* 1) The units used as the "standard" set must be recognized. */ -/* If they are not the error 'SPICE(UNKNOWNUNITS)' is signalled */ -/* by the entry point OUNITS. */ - -/* 2) If the input string IN can not be parsed as a unit, the error */ -/* 'SPICE(INVALIDUNITS)' is signalled by the entry point TRANSU. */ -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine (and its entry points) are utilities that work */ -/* in conjunction with the general units conversion routine */ -/* CONVRT_2. */ - -/* Here's why it is needed. */ - -/* For many applications it is convenient to have command */ -/* driven programs. Such commands might look like */ - -/* SET FIELD OF VIEW [units] */ - -/* Where "" is some number that represents the size of */ -/* the field of view and must be supplied for the command to */ -/* mean anything. The field "[units]" is an optional argument */ -/* that specifies the units to associate with the numeric */ -/* part of the command. For example you might type any of the */ -/* following: */ - -/* SET FIELD OF VIEW 12 DEGREES */ - -/* SET FIELD OF VIEW 5 10E-3*RADIANS */ - -/* SET FIELD OF VIEW 12 NANORADIANS */ - -/* SET FIELD OF VIEW 6 ARCSECONDS */ - -/* Allowing this kind of flexibility for inputs, gives user's */ -/* a friendlier interface to the program. Instead of spending */ -/* time converting to some standard set of inputs, the program */ -/* "understands" many different units. */ - -/* Ultimately, the measurements written in these expressions */ -/* must be converted to a set of units that the program */ -/* "understands." If the above command were the only one */ -/* recognized by the program, the problem of converting to */ -/* internal units would be relatively simple. You could just */ -/* list the collection of recognized units and translate them. */ -/* For this command such a would probably not contain more than */ -/* 30 different units. However, when compound units are */ -/* allowed such as: */ - -/* KM/SEC**2, MILES/HOUR/DAY, AU/(100*DAYS)**2, etc. */ - -/* it is no longer practical to simply list all of the possible */ -/* compound expressions. Instead it is much simpler to select a */ -/* set of primitive units in which all compound units will be */ -/* expressed and used internally. For example you might decide */ -/* that the fundamental units best suited to your application are: */ - -/* For angles --- Degrees */ -/* For distance --- Astronomical Units (AU) */ -/* For time --- DAYS */ -/* For mass --- KG */ -/* For Charge --- ELECTRON_CHARGES */ - -/* When a measurment is encountered, your program would convert */ -/* it to this set of standard units automatically. For example */ -/* If an input had the form */ - -/* 3 KM/SEC */ - -/* the program would automatically convert it to the appropriate */ -/* number of */ - -/* AU/DAYS. */ - -/* In terms of the primitive units of angle, length, time, mass */ -/* and charge. These two quantities are dimensionally equivalent. */ - - -/* This routine serves as the umbrella for two functions: */ - -/* 1) Establishing what units to use as "standard" for the */ -/* fundamental quanities of angle, distance, time, mass and */ -/* charge. (OUNITS) */ - -/* 2) Computing the standard units that are dimensionally */ -/* equivalent to any given input units. */ - -/* With the dimensionally equivalent standard units in hand, */ -/* it is an easy matter (as the example below illustrates) */ -/* to convert inputs measurments to the standard units your */ -/* program needs. */ - -/* $ Examples */ - -/* To set up your default units as above: */ - -/* IF ( FIRST ) THEN */ - -/* CALL OUNITS ( 'DEGREES', 'AU', 'DAYS', 'KG', */ -/* . 'ELECTRON_CHARGES' ) */ - -/* FIRST = .FALSE. */ - -/* END IF */ - -/* To translate a measurement X UNITS to the default units. */ - -/* CALL TRANSU ( UNITS, MINE ) */ -/* CALL CONVRT_2 ( X, UNITS, MINE, MY_X ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 29-MAY-1991 (WLT) */ - -/* -& */ - -/* SPICELIB functions. */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Here is the range of Character ASCII code */ -/* initial characters that --------- ---------- */ -/* will be used by the ' ' 32 */ -/* "known" marks. '(' 40 */ -/* ')' 41 */ -/* '*' 42 */ -/* '/' 47 */ - -/* So the required number of pointers is 47 - 32 + 5 = 20. */ - - -/* Saved variables */ - - -/* Initial Values */ - - switch(n__) { - case 1: goto L_ounits; - case 2: goto L_transu; - } - - return 0; - -L_ounits: - -/* On the first pass through this routine, set up the stuff */ -/* required for scanning the input string. */ - - if (first) { - first = FALSE_; - scanpr_(&nop, op, oplen, opptr, (ftnlen)2); - blank = bsrchc_(" ", &nop, op, (ftnlen)1, (ftnlen)2); - lparen = bsrchc_("(", &nop, op, (ftnlen)1, (ftnlen)2); - rparen = bsrchc_(")", &nop, op, (ftnlen)1, (ftnlen)2); - mult = bsrchc_("*", &nop, op, (ftnlen)1, (ftnlen)2); - exp__ = bsrchc_("**", &nop, op, (ftnlen)2, (ftnlen)2); - div = bsrchc_("/", &nop, op, (ftnlen)1, (ftnlen)2); - } - s_copy(type__, "1", (ftnlen)32, (ftnlen)1); - s_copy(type__ + 32, angle, (ftnlen)32, angle_len); - s_copy(type__ + 64, length, (ftnlen)32, length_len); - s_copy(type__ + 96, time, (ftnlen)32, time_len); - s_copy(type__ + 128, mass, (ftnlen)32, mass_len); - s_copy(type__ + 160, charge, (ftnlen)32, charge_len); - i__ = 1; - s_copy(error, " ", error_len, (ftnlen)1); - while(i__ <= 5) { - fnducv_(type__ + (((i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "type", i__1, "changu_", (ftnlen)391)) << 5), &found, & - class__, &value, (ftnlen)32); - if (! found) { -/* Writing concatenation */ - i__2[0] = 19, a__1[0] = "Unrecognized unit: "; - i__2[1] = 32, a__1[1] = type__ + (((i__1 = i__) < 6 && 0 <= i__1 ? - i__1 : s_rnge("type", i__1, "changu_", (ftnlen)394)) << - 5); - s_cat(error, a__1, i__2, &c__2, error_len); - } else if (class__ != i__) { - suffix_("The", &c__1, error, (ftnlen)3, error_len); - suffix_(tclass + (((i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : - s_rnge("tclass", i__1, "changu_", (ftnlen)398)) << 3), & - c__1, error, (ftnlen)8, error_len); - suffix_("argument is '", &c__1, error, (ftnlen)13, error_len); - suffix_(type__ + (((i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge( - "type", i__1, "changu_", (ftnlen)400)) << 5), &c__1, - error, (ftnlen)32, error_len); - suffix_("'. This is not a unit ", &c__0, error, (ftnlen)22, - error_len); - suffix_("of type", &c__1, error, (ftnlen)7, error_len); - suffix_(tclass + (((i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : - s_rnge("tclass", i__1, "changu_", (ftnlen)403)) << 3), & - c__1, error, (ftnlen)8, error_len); - suffix_(".", &c__0, error, (ftnlen)1, error_len); - } - ++i__; - } - for (i__ = 0; i__ <= 5; ++i__) { - size[(i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge("size", i__1, - "changu_", (ftnlen)413)] = lastnb_(type__ + (((i__3 = i__) < - 6 && 0 <= i__3 ? i__3 : s_rnge("type", i__3, "changu_", ( - ftnlen)413)) << 5), (ftnlen)32); - } - return 0; - -/* Construct the units having the same dimensions as the input */ -/* but that have fundamentals (angle, length, time, ... ) in the */ -/* form that are expected by the calling program. */ - - -L_transu: - s_copy(string, in, (ftnlen)256, in_len); - s_copy(o, " ", (ftnlen)256, (ftnlen)1); - nest = 0; - start = 1; - f = 0; - scan_(string, op, oplen, opptr, &c__128, &start, &ntokns, ident, beg, end, - (ftnlen)256, (ftnlen)2); - i__ = 1; - while(i__ <= ntokns) { - b = beg[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("beg", - i__1, "changu_", (ftnlen)440)]; - e = end[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("end", - i__1, "changu_", (ftnlen)441)]; - if (ident[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge("ident", - i__1, "changu_", (ftnlen)443)] == blank) { - -/* Don't do anything.... */ - - } else if (ident[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge( - "ident", i__1, "changu_", (ftnlen)448)] != 0) { - s = f + 1; - f = s + e - b; - s_copy(o + (s - 1), string + (b - 1), f - (s - 1), e - (b - 1)); - -/* We have to excercise a bit of caution. If this */ -/* is an exponentiation operation, we need to just copy */ -/* the exponent to the output string. */ - - if (ident[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : s_rnge( - "ident", i__1, "changu_", (ftnlen)458)] == exp__) { - nest = 0; - pass = 0; - while(pass < 1 || nest > 0) { - ++i__; - ++pass; - b = beg[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : - s_rnge("beg", i__1, "changu_", (ftnlen)469)]; - e = end[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : - s_rnge("end", i__1, "changu_", (ftnlen)470)]; - s = f + 1; - f = s + b - e; - s_copy(o + (s - 1), string + (b - 1), f - (s - 1), e - (b - - 1)); - if (ident[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? i__1 : - s_rnge("ident", i__1, "changu_", (ftnlen)476)] == - rparen) { - --nest; - } else if (ident[(i__1 = i__ - 1) < 128 && 0 <= i__1 ? - i__1 : s_rnge("ident", i__1, "changu_", (ftnlen) - 480)] == lparen) { - ++nest; - } - } - } - } else { - -/* If you get to this point, just copy the units */ -/* associated with the class of this token. */ - - fnducv_(string + (b - 1), &found, &class__, &value, e - (b - 1)); - s = f + 1; - f = size[(i__1 = class__) < 6 && 0 <= i__1 ? i__1 : s_rnge("size", - i__1, "changu_", (ftnlen)499)] - 1 + s; - s_copy(o + (s - 1), type__ + (((i__1 = class__) < 6 && 0 <= i__1 ? - i__1 : s_rnge("type", i__1, "changu_", (ftnlen)500)) << - 5), f - (s - 1), (ftnlen)32); - } - ++i__; - } - s_copy(out, o, out_len, (ftnlen)256); - return 0; -} /* changu_ */ - -/* Subroutine */ int changu_(char *angle, char *length, char *time, char * - mass, char *charge, char *in, char *out, char *error, ftnlen - angle_len, ftnlen length_len, ftnlen time_len, ftnlen mass_len, - ftnlen charge_len, ftnlen in_len, ftnlen out_len, ftnlen error_len) -{ - return changu_0_(0, angle, length, time, mass, charge, in, out, error, - angle_len, length_len, time_len, mass_len, charge_len, in_len, - out_len, error_len); - } - -/* Subroutine */ int ounits_(char *angle, char *length, char *time, char * - mass, char *charge, char *error, ftnlen angle_len, ftnlen length_len, - ftnlen time_len, ftnlen mass_len, ftnlen charge_len, ftnlen error_len) -{ - return changu_0_(1, angle, length, time, mass, charge, (char *)0, (char *) - 0, error, angle_len, length_len, time_len, mass_len, charge_len, ( - ftnint)0, (ftnint)0, error_len); - } - -/* Subroutine */ int transu_(char *in, char *out, ftnlen in_len, ftnlen - out_len) -{ - return changu_0_(2, (char *)0, (char *)0, (char *)0, (char *)0, (char *)0, - in, out, (char *)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, ( - ftnint)0, in_len, out_len, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/chbfit.c b/ext/spice/src/csupport/chbfit.c deleted file mode 100644 index fda52017aa..0000000000 --- a/ext/spice/src/csupport/chbfit.c +++ /dev/null @@ -1,545 +0,0 @@ -/* chbfit.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__25 = 25; -static integer c__625 = 625; -static integer c__15625 = 15625; - -/* $Procedure CHBFIT ( Chebyshev fit ) */ -/* Subroutine */ int chbfit_(D_fp func, doublereal *left, doublereal *right, - integer *n, doublereal *work, doublereal *coeffs) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double cos(doublereal); - - /* Local variables */ - static doublereal rtab[625] /* was [25][25] */, ttab[15625] /* was [25][ - 25][25] */; - integer i__, j, k; - doublereal x; - extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *, - doublereal *, ftnlen); - doublereal midpt; - extern doublereal pi_(void); - extern /* Subroutine */ int cleard_(integer *, doublereal *); - doublereal radius; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - doublereal arg; - -/* $ Abstract */ - -/* Return the Chebyshev coefficients for a Chebyshev expansion */ -/* of a specified function. */ - -/* $ 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 */ - -/* INTERPOLATION */ -/* MATH */ -/* POLYNOMIAL */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* MAXSIZ P Maximum number of terms in expansion. */ -/* FUNC I Function to be approximated. */ -/* LEFT I Left endpoint of approximation interval. */ -/* RIGHT I Right endpoint of approximation interval. */ -/* N I Number of terms in Chebyshev expansion. */ -/* WORK I Work space array of dimension N. */ -/* COEFFS O Coefficients of Chebyshev expansion. */ - -/* $ Detailed_Input */ - -/* FUNC is the function to be approximated. FUNC must */ -/* accept a single, double precision input argument */ -/* and must return a double precision value. FUNC */ -/* should be declared EXTERNAL in the caller of this */ -/* routine. */ - -/* LEFT, */ -/* RIGHT are, respectively, the left and right endpoints */ -/* of the interval on which the input function is */ -/* to be approximated. */ - -/* N is the number of terms in the desired Chebyshev */ -/* expansion. The degree of the highest-order */ -/* Chebyshev polynomial in the expansion is N-1. */ - -/* WORK is a work space array of dimension N. */ - - -/* $ Detailed_Output */ - -/* COEFFS is an array containing the coefficients of */ -/* the N-term Chebyshev expansion of the input */ -/* function. */ - -/* Let */ - -/* T (x) = cos ( j arccos(x) ) */ -/* j */ - -/* be the Chebyshev polynomial of degree j; then */ -/* COEFFS are computed such that the expansion */ - -/* N */ -/* ___ */ -/* \ COEFFS(j) T (x) */ -/* /__ j-1 */ - -/* j=1 */ - -/* is the Chebyshev expansion of F(Y) on the */ -/* interval [-1,1], where */ - -/* F(Y) = FUNC(X) */ - -/* and */ - -/* X - (LEFT+RIGHT)/2 */ -/* Y = --------------------- */ -/* (LEFT-RIGHT) / 2 */ - -/* The coefficients computed by this routine are */ -/* compatible with the SPICELIB routines CHBINT, */ -/* CHBVAL, and CHBDER. */ - -/* See the $Particulars section for further details */ -/* on the specification of this routine. */ - -/* $ Parameters */ - -/* MAXSIZ is the maximum number of terms in the Chebyshev */ -/* expansion. This is the maximum allowed value of */ -/* N. */ - -/* $ Exceptions */ - -/* 1) If N is less than 1, the error SPICE(INVALIDSIZE) is */ -/* signaled. The function will return the value 0.D0. */ - -/* 2) If N is greater than MAXSIZ, the error SPICE(INVALIDSIZE) is */ -/* signaled. The function will return the value 0.D0. */ - -/* 3) This routine does not attempt to ward off or diagnose */ -/* arithmetic overflows. */ - -/* 4) If the endpoints LEFT and RIGHT are not in strictly */ -/* increasing order, the error SPICE(INVALIDENDPTS) */ -/* is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The coefficient set produced by this routine is described below: */ - -/* Let */ - -/* x , k = 1, ... , N */ -/* k */ - -/* be the roots of the Chebyshev polynomial */ - -/* T (x) = cos ( N arccos(x) ) */ -/* N */ - -/* These roots are */ - -/* cos ( (k-1/2)*PI/N ), k = 1, ..., N. */ - - -/* For a function f(x) defined on the closed */ -/* interval [-1,1], the N-term Chebyshev expansion */ -/* is */ - -/* N */ -/* ___ */ -/* \ C T (x) */ -/* /__ j j-1 */ - -/* j=1 */ - -/* where */ -/* N */ -/* ___ */ -/* C = (2/N) \ f(x ) T (x ), j = 2, ...,N, */ -/* j /__ k j-1 k */ - -/* k=1 */ - -/* N */ -/* ___ */ -/* C = (1/N) \ f(x ) */ -/* 1 /__ k */ - -/* k=1 */ - - -/* The definition of */ - -/* C */ -/* 1 */ - -/* used differs from that used in reference [1]; */ -/* our value is half theirs, and yields the simpler */ -/* expression for the expansion of f(x) shown above. */ - -/* When the function f(x) to be approximated is */ -/* defined on the interval [LEFT,RIGHT], the mapping */ - -/* x - (LEFT+RIGHT)/2 */ -/* y(x) = --------------------- */ -/* (LEFT-RIGHT) / 2 */ - -/* can be used to define a new function F such that */ -/* F(y) = f(x). F has domain [-1,1] and hence admits */ -/* a Chebyshev expansion. */ - -/* In this routine, the above mapping is used to */ -/* transform the domain of the input function to the */ -/* interval [-1,1]. */ - - -/* $ Examples */ - -/* 1) Recover coefficients from a function whose Chebyshev */ -/* expansion is known. Suppose */ - -/* f(x) = 1*T (x) + 2*T (x) + 3*T (x) + 4*T (x). */ -/* 0 1 2 3 */ - -/* The following small program produces the Chebyshev */ -/* coefficients of f: */ - - -/* PROGRAM TSTCHB */ -/* IMPLICIT NONE */ -/* C */ -/* C Test Chebyshev fitting for a simple function. */ -/* C */ -/* INTEGER NCOEFF */ -/* PARAMETER ( NCOEFF = 4 ) */ - -/* DOUBLE PRECISION FUNC */ -/* EXTERNAL FUNC */ - -/* DOUBLE PRECISION COEFFS ( NCOEFF ) */ -/* DOUBLE PRECISION WORK ( NCOEFF ) */ -/* INTEGER I */ - - -/* CALL CHBFIT ( FUNC, -1.D0, 1.D0, */ -/* . NCOEFF, WORK, COEFFS ) */ - -/* WRITE (*,*) 'Coefficients follow:' */ - -/* DO I = 1, NCOEFF */ -/* WRITE (*,*) 'DEGREE: ', I-1, ' = ', COEFFS(I) */ -/* END DO */ - -/* END */ - - -/* DOUBLE PRECISION FUNCTION FUNC ( X ) */ -/* IMPLICIT NONE */ -/* C */ -/* C Return */ -/* C */ -/* C f(x) = 1*T (x) + 2*T (x) + 3*T (x) + 4*T (x). */ -/* C 0 1 2 3 */ -/* C */ -/* DOUBLE PRECISION X */ - -/* INTEGER NCOEFF */ -/* PARAMETER ( NCOEFF = 4 ) */ - -/* DOUBLE PRECISION CP ( NCOEFF ) */ -/* DOUBLE PRECISION X2S ( 2 ) */ -/* INTEGER I */ - -/* DO I = 1, NCOEFF */ -/* CP(I) = DBLE(I) */ -/* END DO */ - -/* X2S(1) = 0.D0 */ -/* X2S(2) = 1.D0 */ - -/* CALL CHBVAL ( CP, NCOEFF-1, X2S, X, FUNC ) */ -/* END */ - -/* $ Restrictions */ - -/* 1) Maximum number of terms in the expansion is limited by the */ -/* parameter MAXSIZ. */ - -/* $ Literature_References */ - -/* [1] "Numerical Recipes---The Art of Scientific Computing" by */ -/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */ -/* William T. Vetterling (see section 5.6). */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SUPPORT Version 2.0.0, 14-SEP-2007 (NJB) */ - -/* Now pre-computes Chebyvshev polynomial values. Maximum */ -/* number of terms in the expansion is limited by the */ -/* parameter MAXSIZ. */ - -/* - SUPPORT Version 1.0.0, 16-JUN-1996 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* fit Chebyshev expansion to a function */ -/* determine Chebyshev coefficients of a function */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* Check in only if an error is detected. */ - - if (return_()) { - return 0; - } - -/* Make sure the requested expansion order is not too large. */ - - if (*n > 25) { - chkin_("CHBFIT", (ftnlen)6); - setmsg_("The requested expansion order # exceeds the maximum support" - "ed order #.", (ftnlen)70); - errint_("#", n, (ftnlen)1); - errint_("#", &c__25, (ftnlen)1); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("CHBFIT", (ftnlen)6); - return 0; - } - -/* No data, no interpolation. */ - - if (*n < 1) { - chkin_("CHBFIT", (ftnlen)6); - setmsg_("Array size must be positive; was #.", (ftnlen)35); - errint_("#", n, (ftnlen)1); - sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); - chkout_("CHBFIT", (ftnlen)6); - return 0; - } - -/* Make sure the input interval is OK. */ - - if (*left >= *right) { - chkin_("CHBFIT", (ftnlen)6); - setmsg_("Left endpoint = #; right endpoint = #.", (ftnlen)38); - errdp_("#", left, (ftnlen)1); - errdp_("#", right, (ftnlen)1); - sigerr_("SPICE(INVALIDENDPTS)", (ftnlen)20); - chkout_("CHBFIT", (ftnlen)6); - return 0; - } - if (pass1) { - -/* On the first pass, compute a table of roots of all */ -/* Cheby polynomials from degree 1 to degree N. The Ith */ -/* column of the table contains roots of the Ith polynomial. */ - - cleard_(&c__625, rtab); - for (i__ = 1; i__ <= 25; ++i__) { - i__1 = i__; - for (k = 1; k <= i__1; ++k) { - rtab[(i__2 = k + i__ * 25 - 26) < 625 && 0 <= i__2 ? i__2 : - s_rnge("rtab", i__2, "chbfit_", (ftnlen)439)] = cos( - pi_() * (k - .5) / i__); - } - } - -/* Also compute a table of Chebyshev function values. For */ -/* each expansion size J from 1 to N, we compute the values */ -/* of */ - -/* T (x ) ... T ( x ) */ -/* 0 1 0 J */ - -/* . */ -/* . */ -/* . */ - -/* T (x ) ... T ( x ) */ -/* J-1 1 J-1 J */ - -/* where */ - -/* x */ -/* K */ - -/* is the Kth root of */ - -/* T */ -/* J */ - -/* In our 3-dimensional table, the (K,I,J) entry is the value */ -/* of */ - -/* T ( x ) */ -/* I-1 K */ - -/* where */ - -/* x */ -/* K */ - -/* is the Kth root of */ - -/* T */ -/* J */ - - cleard_(&c__15625, ttab); - for (j = 1; j <= 25; ++j) { - -/* Compute Cheby values needed to implement an expansion */ -/* of size J. */ - - i__1 = j; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Compute values of */ - -/* T */ -/* I-1 */ - -/* on the roots of */ - -/* T */ -/* J */ - - - i__2 = j; - for (k = 1; k <= i__2; ++k) { - -/* Evaluate */ - -/* T */ -/* I-1 */ - -/* at the Kth root of */ - -/* T */ -/* J */ - - arg = pi_() * (k - .5) / j; - ttab[(i__3 = k + (i__ + j * 25) * 25 - 651) < 15625 && 0 - <= i__3 ? i__3 : s_rnge("ttab", i__3, "chbfit_", ( - ftnlen)522)] = cos((i__ - 1) * arg); - } - } - } - pass1 = FALSE_; - } - -/* Find the transformation parameters. */ - - midpt = (*right + *left) / 2.; - radius = (*right - *left) / 2.; - -/* Compute the input function values at the transformed Chebyshev */ -/* roots. */ - - i__1 = *n; - for (k = 1; k <= i__1; ++k) { - x = radius * rtab[(i__2 = k + *n * 25 - 26) < 625 && 0 <= i__2 ? i__2 - : s_rnge("rtab", i__2, "chbfit_", (ftnlen)550)] + midpt; - work[k - 1] = (*func)(&x); - } - -/* Compute the coefficients. */ - - i__1 = *n; - for (j = 1; j <= i__1; ++j) { - coeffs[j - 1] = 0.; - i__2 = *n; - for (k = 1; k <= i__2; ++k) { - coeffs[j - 1] = work[k - 1] * ttab[(i__3 = k + (j + *n * 25) * 25 - - 651) < 15625 && 0 <= i__3 ? i__3 : s_rnge("ttab", i__3, - "chbfit_", (ftnlen)565)] + coeffs[j - 1]; - } - coeffs[j - 1] = coeffs[j - 1] * 2. / *n; - } - -/* Scale the zero-order coefficient to simplify the form of the */ -/* Chebyshev expansion. */ - - coeffs[0] *= .5; - return 0; -} /* chbfit_ */ - diff --git a/ext/spice/src/csupport/ck3sdn.c b/ext/spice/src/csupport/ck3sdn.c deleted file mode 100644 index 0c2ca153ff..0000000000 --- a/ext/spice/src/csupport/ck3sdn.c +++ /dev/null @@ -1,599 +0,0 @@ -/* ck3sdn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__4 = 4; - -/* $Procedure CK3SDN( Down sample type 3 CK data prepared for writing ) */ -/* Subroutine */ int ck3sdn_(doublereal *sdntol, logical *avflag, integer * - nrec, doublereal *sclkdp, doublereal *quats, doublereal *avvs, - integer *nints, doublereal *starts, doublereal *dparr, integer * - intarr) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - double sqrt(doublereal), asin(doublereal); - - /* Local variables */ - doublereal frac, dneg; - integer left; - doublereal dpos, dist2; - integer i__, j; - doublereal angle; - integer keepf; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer keepl; - doublereal qlneg[4]; - extern doublereal dpmax_(void); - extern /* Subroutine */ int vhatg_(doublereal *, integer *, doublereal *), - moved_(doublereal *, integer *, doublereal *); - logical fitok; - integer right; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), qmini_( - doublereal *, doublereal *, doublereal *, doublereal *); - doublereal dist2a, dist2b; - extern integer bsrchd_(doublereal *, integer *, doublereal *); - doublereal qkeepf[4]; - extern /* Subroutine */ int orderd_(doublereal *, integer *, integer *); - doublereal qkeepl[4]; - extern /* Subroutine */ int reordd_(integer *, integer *, doublereal *); - integer intcrf, ndropd, intcrl; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer intnrf; - extern doublereal vdistg_(doublereal *, doublereal *, integer *); - extern /* Subroutine */ int setmsg_(char *, ftnlen); - logical skipit; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), vminug_( - doublereal *, integer *, doublereal *); - doublereal qlinpt[4], qintrp[4]; - extern logical return_(void); - -/* $ Abstract */ - -/* Down sample type 3 CK data prepared for writing. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ -/* ROTATIONS */ -/* SCLK */ - -/* $ Keywords */ - -/* POINTING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* SDNTOL I Tolerance used for sampling down. */ -/* AVFLAG I True if angular velocity data is set. */ -/* NREC I/O Number of pointing records. */ -/* SCLKDP I/O Encoded SCLK times. */ -/* QUATS I/O Quaternions representing instrument pointing. */ -/* AVVS I/O Angular velocity vectors. */ -/* NINTS I Number of intervals. */ -/* STARTS I Encoded SCLK interval start times. */ -/* DPARR I Double precision work array. */ -/* INTARR I Integer work array. */ - -/* $ Detailed_Input */ - -/* SDNTOL is the angular tolerance, in radians, to be used to */ -/* down sample the input CK type 3 pointing data. */ -/* SDNTOL must be a non-negative number. */ - -/* AVFLAG is a logical flag indicating whether or not */ -/* the angular velocity data should be processed. */ - -/* NREC is the number of pointing instances in the input */ -/* buffer. */ - -/* SCLKDP are the encoded spacecraft clock times associated with */ -/* each pointing instance. These times must be strictly */ -/* increasing. */ - -/* QUATS is the quaternion buffer. */ - -/* AVVS is the angular velocity vector buffer. */ - -/* If AVFLAG is FALSE then this array is ignored by the */ -/* routine; however it still must be supplied as part of */ -/* the calling sequence. */ - -/* NINTS is the number of intervals that the pointing instances */ -/* are partitioned into. */ - -/* STARTS are the start times of each of the interpolation */ -/* intervals. These times must be strictly increasing */ -/* and must coincide with times for which the input */ -/* quaternion buffer contains pointing. */ - -/* DPARR is a double precision work array. */ - -/* INTARR is an integer work array. */ - -/* $ Detailed_Output */ - -/* NREC is the number of pointing instances in the buffer */ -/* after down sampling. */ - -/* SCLKDP is the encoded spacecraft clock time buffer after */ -/* down sampling. */ - -/* QUATS is the quaternion buffer after down sampling. */ - -/* AVVS is the angular velocity vector buffer after down */ -/* sampling. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of pointing records is not greater than zero, */ -/* the error SPICE(INVALIDNUMBEROFRECORDS) is signaled. */ - -/* 2) If the number of interval starts is not greater than zero, */ -/* the error SPICE(INVALIDNUMBEROFINTERVALS) is signaled. */ - -/* 3) If the number of interval starts is not is not less than */ -/* or equal to the number of records, the error */ -/* SPICE(BUFFERSIZESMISMATCH) is signaled. */ - -/* 4) If the first interval start time is not the same as the */ -/* first record time, the error SPICE(FIRSTRECORDMISMATCH) */ -/* is signaled. */ - -/* 5) If the down sampling tolerance is not a non-negative number, */ -/* the error SPICE(BADDOWNSAMPLINGTOL) is signaled. */ - -/* 6) If record times buffer does not contain any of the times */ -/* from interval start times buffers, the error */ -/* SPICE(INTERVALSTARTNOTFOUND) is signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine eliminates from the input quaternion and angular */ -/* rate buffers all data points for which type 3 CK interpolation */ -/* between bounding points that are not eliminated would produce */ -/* result that is within specified tolerance of the input attitude. */ -/* The elimination, refered to in these comments as "down sampling", */ -/* is done within each individual interpolation interval (as */ -/* specified in the input interval starts buffer), with intervals */ -/* boundaries unchanged. */ - -/* $ Examples */ - -/* Normally this routine would be called immediately before the */ -/* CKW03 is called and be supplied with the input time, quaternion, */ -/* angular rate, and interval start buffers that were fully and */ -/* properly prepared for the CKW03 input, like this: */ - -/* CALL CK3SDN ( SDNTOL, ARFLAG, */ -/* . NREC, SCLKDP, QUATS, AVVS, NINTS, STARTS, */ -/* . DPARR, INTARR ) */ - -/* CALL CKW03 ( HANDLE, SCLKDP(1), SCLKDP(NREC), */ -/* . INSTID, FRMNAM, ARFLAG, SEGID, */ -/* . NREC, SCLKDP, QUATS, AVVS, NINTS, STARTS ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 19-SEP-2005 (BVS)(FST) */ - -/* Incorporated Scott's shrinking window search algorithm to */ -/* speed up down sampling. */ - -/* - Beta Version 1.0.0, 29-JUL-2005 (BVS)(NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* sample down ck type_3 pointing data prepared for writing */ - -/* -& */ - -/* Local variables. */ - - -/* SPICELIB functions. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CK3SDN", (ftnlen)6); - } - -/* Let's do some sanity checks that needed to make sure that future */ -/* loops and comparisons don't blow up. First, verify that the */ -/* number pointing records is greater that zero. */ - - if (*nrec <= 0) { - setmsg_("The number of pointing records must be greater than zero. I" - "t was #.", (ftnlen)67); - errint_("#", nrec, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMBEROFRECORDS)", (ftnlen)29); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - -/* Then, verify that the number intervals is greater that zero. */ - - if (*nints <= 0) { - setmsg_("The number of interval starts must be greater than zero. It" - " was #.", (ftnlen)66); - errint_("#", nints, (ftnlen)1); - sigerr_("SPICE(INVALIDNUMBEROFINTERVALS)", (ftnlen)31); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - -/* Then, verify that the number intervals is less than or equal to */ -/* the number of records. */ - - if (*nints > *nrec) { - setmsg_("The number of interval starts, #, is not less than or equal" - " to the number of records, #.", (ftnlen)88); - errint_("#", nints, (ftnlen)1); - errint_("#", nrec, (ftnlen)1); - sigerr_("SPICE(BUFFERSIZESMISMATCH)", (ftnlen)26); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - -/* Then verify that the first time in the intervals array is the same */ -/* as the first time in the records array. */ - - if (sclkdp[0] != starts[0]) { - setmsg_("The first interval start time, #, is not the same as the fi" - "rst record time, #.", (ftnlen)78); - errdp_("#", sclkdp, (ftnlen)1); - errdp_("#", starts, (ftnlen)1); - sigerr_("SPICE(FIRSTRECORDMISMATCH)", (ftnlen)26); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - -/* Finally verify that input down sampling tolerance is not positive */ -/* number. */ - - if (*sdntol < 0.) { - setmsg_("The down sampling tolerance must be a non-negative number. " - "It was #.", (ftnlen)68); - errdp_("#", sdntol, (ftnlen)1); - sigerr_("SPICE(BADDOWNSAMPLINGTOL)", (ftnlen)25); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - -/* This variable will hold to the index of the pointing record that */ -/* matches the start of the next interval. For the first interval */ -/* it is set to one. */ - - intnrf = 1; - -/* We will count the number of points that were dropped. */ - - ndropd = 0; - -/* Loop through interpolation intervals. */ - - i__1 = *nints; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Assign the index of the pointing record that matches the */ -/* begin time of this interval. */ - - intcrf = intnrf; - -/* Find the index of the pointing record that ends this interval. */ -/* If this the last interval, it is the last pointing record in */ -/* pointing buffer. */ - - if (i__ == *nints) { - intcrl = *nrec; - } else { - -/* This is not the last interval. To get its end time we need */ -/* to find the pointing record that matches the start of the */ -/* next interval and pick the record before it. */ - -/* First we find index of the pointing record that corresponds */ -/* to the start of the next interval. */ - - i__2 = *nrec - intcrf + 1; - intnrf = bsrchd_(&starts[i__], &i__2, &sclkdp[intcrf - 1]); - if (intnrf != 0) { - -/* Found index must be adjusted to be relative to the */ -/* beginning of the buffer. Currently it is relative to the */ -/* start of the current interval. */ - - intnrf = intnrf + intcrf - 1; - -/* The index of the last record belonging to this interval */ -/* in the found index minus 1. */ - - intcrl = intnrf - 1; - } else { - -/* We did not find such record. The input buffer must have */ -/* been formed improperly for this to happen. Signal an */ -/* error. */ - - setmsg_("Cannot find pointing record with time that matches " - "the start time # (encoded SCLK ticks) of the interpo" - "lation interval number #.", (ftnlen)128); - errdp_("#", &starts[i__], (ftnlen)1); - i__2 = i__ + 1; - errint_("#", &i__2, (ftnlen)1); - sigerr_("SPICE(INTERVALSTARTNOTFOUND)", (ftnlen)28); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - } - -/* Let's look at the indexes of the pointing records */ -/* corresponding to the begin and end of this interval. If they */ -/* are the same (meaning it's a singleton interval) or if they */ -/* are next to each other (meaning that the whole set of */ -/* interval's pointing data is comprised of only its begin */ -/* and end points) there is no down sampling to do. */ - - skipit = intcrf == intcrl || intcrf == intcrl - 1; - -/* Set initial values for a binary search. */ - - keepf = intcrf; - left = intcrf; - right = intcrl; - while(! skipit && keepf < intcrl) { - -/* Set the right endpoint of the interval by dividing the */ -/* binary search region in half. */ - - keepl = (left + right) / 2; - -/* Unitize bracketing quaternions as QMINI seems to be */ -/* very sensitive to that. :) */ - - vhatg_(&quats[(keepf << 2) - 4], &c__4, qkeepf); - vhatg_(&quats[(keepl << 2) - 4], &c__4, qkeepl); - -/* Pick the closer of the right quaternion or its negative to */ -/* QKEEPF for input into QMINI to ensure that QMINI does */ -/* interpolation in the "shortest arc" direction. */ - - vminug_(qkeepl, &c__4, qlneg); - dpos = vdistg_(qkeepl, qkeepf, &c__4); - dneg = vdistg_(qlneg, qkeepf, &c__4); - if (dneg < dpos) { - moved_(qlneg, &c__4, qlinpt); - } else { - moved_(qkeepl, &c__4, qlinpt); - } - -/* Check all records between the currently picked window ends */ -/* to see if interpolated pointing is within tolerance of the */ -/* actual pointing. */ - - fitok = TRUE_; - j = keepf + 1; - while(j <= keepl - 1 && fitok) { - -/* Compute interpolation fraction for this pointing record. */ - - if (sclkdp[keepl - 1] - sclkdp[keepf - 1] != 0.) { - frac = (sclkdp[j - 1] - sclkdp[keepf - 1]) / (sclkdp[ - keepl - 1] - sclkdp[keepf - 1]); - } else { - sigerr_("SPICE(CK3SDNBUG)", (ftnlen)16); - chkout_("CK3SDN", (ftnlen)6); - return 0; - } - -/* Call Nat's fast quaternion interpolation routine to */ -/* compute interpolated rotation for this point. */ - - qmini_(qkeepf, qlinpt, &frac, qintrp); - -/* Find the squared distance between the interpolated */ -/* and input quaternions. */ - - dist2a = (quats[(j << 2) - 4] - qintrp[0]) * (quats[(j << 2) - - 4] - qintrp[0]) + (quats[(j << 2) - 3] - qintrp[1]) - * (quats[(j << 2) - 3] - qintrp[1]) + (quats[(j << 2) - - 2] - qintrp[2]) * (quats[(j << 2) - 2] - qintrp[2]) - + (quats[(j << 2) - 1] - qintrp[3]) * (quats[(j << 2) - - 1] - qintrp[3]); - dist2b = (quats[(j << 2) - 4] + qintrp[0]) * (quats[(j << 2) - - 4] + qintrp[0]) + (quats[(j << 2) - 3] + qintrp[1]) - * (quats[(j << 2) - 3] + qintrp[1]) + (quats[(j << 2) - - 2] + qintrp[2]) * (quats[(j << 2) - 2] + qintrp[2]) - + (quats[(j << 2) - 1] + qintrp[3]) * (quats[(j << 2) - - 1] + qintrp[3]); - dist2 = min(dist2a,dist2b); - -/* The rotation angle theta is related to the distance by */ -/* the formula */ - -/* || Q1 - Q2 || = 2 * | sin(theta/4) | */ - - angle = asin(sqrt(dist2) / 2.) * 4.; - -/* Compare the angle with specified threshold. */ - - fitok = fitok && abs(angle) <= *sdntol; - -/* Increment index to move to the next record. */ - - ++j; - } - -/* Was the fit OK? */ - - if (fitok) { - -/* Fit was OK. Check if left and right are equal; if so we */ -/* found the point that were were looking for. */ - - if (left == right) { - -/* Mark all records between fist and last with DPMAX. */ - - i__2 = keepl - 1; - for (j = keepf + 1; j <= i__2; ++j) { - sclkdp[j - 1] = dpmax_(); - ++ndropd; - } - -/* Set first point for the next search to be equal to */ -/* the to the found point. */ - - keepf = keepl; - -/* Reset window boundaries for binary search. */ - - left = keepl; - right = intcrl; - } else { - -/* Left and right sides haven't converged yet; shift */ -/* left side of the binary search window forward. */ - - left = keepl + 1; - } - } else { - -/* No fit; shift right side of the binary search window */ -/* backwards. */ - - right = keepl - 1; - -/* If right side when "over" the left side, set left side */ -/* to be equal to the right side. */ - - if (right < left) { - left = right; - } - } - } - } - -/* At this point all records that are to be removed, if any, have */ -/* been "tagged" with DPMAX in the times buffer. We need to re-sort */ -/* the buffers to push these records to the bottom and re-set the */ -/* number of records to indicate that only the top portion should be */ -/* used. */ - - if (ndropd != 0) { - -/* Since SCLKs were the ones "marked" by DPMAX, we will use them */ -/* to get the order vector. */ - - orderd_(sclkdp, nrec, intarr); - -/* Now, with the order vector in hand, sort the SCLKs ... */ - - reordd_(intarr, nrec, sclkdp); - -/* ... then sort quaternions (element by element) ... */ - - for (i__ = 0; i__ <= 3; ++i__) { - i__1 = *nrec; - for (j = 1; j <= i__1; ++j) { - dparr[j - 1] = quats[i__ + (j << 2) - 4]; - } - reordd_(intarr, nrec, dparr); - i__1 = *nrec; - for (j = 1; j <= i__1; ++j) { - quats[i__ + (j << 2) - 4] = dparr[j - 1]; - } - } - -/* ... and, finally, if requested, sort AVs (also element by */ -/* element) ... */ - - if (*avflag) { - for (i__ = 1; i__ <= 3; ++i__) { - i__1 = *nrec; - for (j = 1; j <= i__1; ++j) { - dparr[j - 1] = avvs[i__ + j * 3 - 4]; - } - reordd_(intarr, nrec, dparr); - i__1 = *nrec; - for (j = 1; j <= i__1; ++j) { - avvs[i__ + j * 3 - 4] = dparr[j - 1]; - } - } - } - -/* Reset the number of points. */ - - *nrec -= ndropd; - } - -/* All done. Check out. */ - - chkout_("CK3SDN", (ftnlen)6); - return 0; -} /* ck3sdn_ */ - diff --git a/ext/spice/src/csupport/cmloop.c b/ext/spice/src/csupport/cmloop.c deleted file mode 100644 index dc7a131a52..0000000000 --- a/ext/spice/src/csupport/cmloop.c +++ /dev/null @@ -1,563 +0,0 @@ -/* cmloop.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__7 = 7; -static integer c__3 = 3; -static integer c__1 = 1; -static integer c__78 = 78; -static logical c_false = FALSE_; - -/* $Proceedure CMLOOP ( Command line loop ) */ - -/* Subroutine */ int cmloop_(char *delim, char *prompt, char *lognam, char * - versn, S_fp greet, S_fp preprc, S_fp action, ftnlen delim_len, ftnlen - prompt_len, ftnlen lognam_len, ftnlen versn_len) -{ - /* Initialized data */ - - static char spcial[8*2] = " " "? "; - - /* System generated locals */ - address a__1[2], a__2[7], a__3[3]; - integer i__1[2], i__2[7], i__3[3], i__4; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int echo_(char *, char *, ftnlen, ftnlen); - extern logical have_(char *, ftnlen); - static integer from; - static logical trap; - static integer rest, l; - static logical dolog; - extern integer ltrim_(char *, ftnlen); - static char error[1760*2], com2do[1024]; - extern logical no_(char *, ftnlen); - extern /* Subroutine */ int logchk_(char *, char *, logical *, ftnlen, - ftnlen), cmredo_(char *, integer *, logical *, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char commnd[1024], errflg[32]; - extern logical cmmore_(char *, ftnlen); - extern /* Subroutine */ int setdel_(char *, ftnlen), erract_(char *, char - *, ftnlen, ftnlen); - static char usenam[255]; - extern /* Subroutine */ int errdev_(char *, char *, ftnlen, ftnlen); - static logical problm; - extern /* Subroutine */ int setdap_(char *, char *, ftnlen, ftnlen), - getcom_(char *, integer *, ftnlen), edtcom_(char *, char *, char * - , integer *, ftnlen, ftnlen, ftnlen), builtn_(char *, logical *, - char *, ftnlen, ftnlen), nsplog_(char *, logical *, ftnlen), - nspend_(void), trnlat_(char *, char *, ftnlen, ftnlen), nsplgs_( - char *, char *, char *, ftnlen, ftnlen, ftnlen); - static char hstyle[120]; - extern /* Subroutine */ int nsperr_(char *, char *, ftnlen, ftnlen), - nspopl_(char *, char *, ftnlen, ftnlen); - static char lstyle[120]; - extern /* Subroutine */ int cmstup_(void); - extern integer qrtrim_(char *, ftnlen); - extern /* Subroutine */ int nspslr_(integer *, integer *); - static char sstyle[120]; - extern /* Subroutine */ int ressym_(char *, char *, ftnlen, ftnlen); - static char vstyle[120]; - extern /* Subroutine */ int nspsty_(char *, char *, ftnlen, ftnlen); - static logical log__[4], hit; - - -/* $ Abstract */ - -/* This routine handles the main processing loop of a */ -/* command driven program. */ - -/* $ 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 */ - -/* INTERFACE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* DELIM I Non-blank character used to delimit commands */ -/* PROMPT I Prompt to let the user know input is expected */ -/* LOGNAM I Name pattern of file where commands will be logged */ -/* VERSN I Program name and version */ -/* INTIZE S Subroutine that initializes I/O facilities */ -/* GREET S Displays a banner at program startup */ -/* ACTION S The command parser and processor. */ - -/* $ Detailed_Input */ - -/* DELIM is a character that will be used to tell the */ -/* program that a command has ended. Commands may */ -/* extend over as many lines as allowed by the */ -/* configuration include file. They end on the */ -/* first line on which the delimiter character is */ -/* encountered. THIS CHARACTER MUST NOT BE "?" */ - -/* PROMPT is a string used to prompt the user for commands. */ -/* Typically, this is the name of the program that */ -/* calles CMLOOP. */ - -/* LOGNAM is a pattern to use when creating the name of */ -/* a file to which all commands will be written. */ -/* This can be hard coded in the calling */ -/* program, or may be determined by a file naming */ -/* convention such as is provided by Christen */ -/* and NOMEN. */ - -/* VERSN is a string that may contain anything you would */ -/* like to appear as descriptive text in the first */ -/* line of the log file (and possibly in the greeting */ -/* presented by the program) Something like */ -/* ' --- Version X.Y' would be appropriate. */ -/* For example if your programs name is KINDLE and you */ -/* are at version 4.2.3 of your program a good value for */ -/* VERSN would be */ - -/* 'KINDLE --- Version 4.2.3' */ - -/* Your greeting routine can make use of this when */ -/* displaying your program's greeting. In this way */ -/* you can centralize the name and version number of */ -/* your program at a high level or in a subroutine and */ -/* simply make the information available to CMLOOP so */ -/* that the automatic aspects of presenting this */ -/* information can be handled for you. */ - - -/* GREET is a routine that displays a message at program */ -/* startup. This should contain the version number */ -/* of the program, any general instructions such */ -/* as how to get help and who the author or organization */ -/* is that is responsible for this program. GREET */ -/* takes a single argument VERSN which you supply in */ -/* your call to CMLOOP. It may also have */ -/* initializations that override various items set */ -/* up prior to the call to GREET such as the style */ -/* used for displaying error messages. GREET */ -/* is the action taken by CMLOOP before commencing the */ -/* loop of fetching and processing commands. */ - -/* PREPRC is a command preprocessor. It might remove */ -/* non-printing characters such as TABS, resolve */ -/* symbols and convert units to expected ranges. */ - -/* ACTION is a routine responsible for action upon the commands */ -/* entered by a user at the keyboard. ACTION has two */ -/* arguments COMMAND a string input and ERROR a two */ -/* dimensional array for error and diagnostic output. */ -/* The first message should point to the the problem */ -/* assuming the user is aware of the context in which */ -/* the problem occurred. The second message will */ -/* have more detailed information including trace */ -/* and other technical information. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* The parameters COMSIZ and ERRSIZ are given in the include */ -/* file commdpar.inc. */ - -/* COMSIZ is maximum number of characters that can be present */ -/* in a command. */ - -/* ERRSIZ is the maximum number of characters that can be used */ -/* when creating a diagnostic message. */ - -/* $ Exceptions */ - -/* None. This routine cannot detect any errors in its inputs */ -/* and all commands are regarded as legal input at this level. */ -/* Some can be acted on while others cannot. Commands that */ -/* can not be exercised are expected to return diagnostics */ -/* in the array ERROR. These are then reported by the */ -/* program to the user via his/her terminal. */ - -/* $ Files */ - -/* The file specified by LOGFIL will be opened if possible */ -/* and all user commands and messages will be written to this */ -/* file. */ - -/* Other files may be used a run time by "STARTing" a command */ -/* sequence file. Or by some result of the activity of the */ -/* user supplied routines ACTION, GREET, PREPRC. */ - -/* $ Particulars */ - -/* This routine organizes the main loop of a command line */ -/* program so that the calling program can automatically */ -/* log files that a user enters, report errors in a uniform */ -/* manner and make use of sequences of commands stored in */ -/* files. The calling program supplies routines that handle */ -/* the chores of greeting the user and performing special */ -/* program initializations and performing actions based upon */ -/* the commands supplied by the user. By making use of this */ -/* routine and its subordinates, the user inherits a flexible */ -/* I/O system and command interface freeing him/her to concentrate */ -/* on the actions of the program. */ - -/* However, there is a minor price incurred by making use of */ -/* this routine. Several commands have specific meanings that */ -/* the user cannot override. They are commands that start with: */ - -/* start */ -/* exit */ -/* stop */ -/* quit */ -/* echo */ -/* no echo */ -/* demo on */ -/* demo off */ -/* wait on */ -/* wait off */ -/* pause */ -/* ? */ -/* These commands are case insensitive with respect to the */ -/* words presented above. */ - - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 6.0.0, 20-JUN-2000 (WLT) */ - -/* Added the ability to run the loop without logging */ -/* of inputs. */ - -/* - Command Loop Configured Version 5.0.0, 23-MAR-2000 (WLT) */ - -/* Modified the routine to call NSPEND instead of FINISH */ -/* now that NSPIO has been redone. */ - -/* - Command Loop Configured Version 4.0.0, 20-NOV-1995 (WLT) */ - -/* Added ability to run programs in batch mode and to */ -/* start procedures at program startup. */ - -/* - Command Loop Configured Version 3.0.0, 1-AUG-1995 (WLT) */ - -/* The routine was modified to better support command */ -/* pre-processing. In particular symbol definition */ -/* and resolution is now supported. */ - -/* - Command Loop Configured Version 2.0.0, 19-JUL-1995 (WLT) */ - -/* A slight change was made so that the command delimiter */ -/* is now stored in the routine GETDEL. Also errors */ -/* are now checked after command pre-processing has */ -/* been performed. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Beta Version 1.0.0, 8-OCT-1993 (WLT) */ - -/* -& */ - -/* Language Sensitive Strings */ - -/* $ 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. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* The following parameters are the system parameters required */ -/* by PERCY. Be sure to read any notes before adjusting these */ - - -/* The maximum number of commands that can be buffered is */ -/* determined by the value of MAXCOM. This parameter is */ -/* used primarily by NXTCOM. */ - - -/* The parameter FILEN is the maximum length of a file name */ -/* on a particular system. */ - - -/* The parameter COMSIZ is the maximum length allowed for a */ -/* command. */ - - -/* The parameter ERRSIZ is the maximum length allowed for */ -/* error messages. */ - - -/* The parameter STYSIZ is the maximum length expected for */ -/* a NICEPR style string. */ - - -/* The following are for special commands that will not be */ -/* processed by ACTION. */ - - -/* Store the delimiter used by the program incase someone */ -/* else needs to know later on. */ - - setdel_(delim, delim_len); - -/* First, set up the SPICELIB error handling. */ - - s_copy(error, " ", (ftnlen)1760, (ftnlen)1); - s_copy(error + 1760, " ", (ftnlen)1760, (ftnlen)1); - s_copy(commnd, " ", (ftnlen)1024, (ftnlen)1); - log__[0] = FALSE_; - log__[1] = FALSE_; - log__[2] = TRUE_; - log__[3] = TRUE_; - erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6); - errdev_("SET", "NULL", (ftnlen)3, (ftnlen)4); - -/* Set the prompt for the program. */ - - setdap_(delim, prompt, delim_len, prompt_len); - -/* The following styles are for reporting errors to the */ -/* screen and log file respectively. */ - - trnlat_("ERRFLAG", errflg, (ftnlen)7, (ftnlen)32); -/* Writing concatenation */ - i__1[0] = 38, a__1[0] = "HARDSPACE ^ NEWLINE /cr VTAB /vt FLAG "; - i__1[1] = 32, a__1[1] = errflg; - s_cat(sstyle, a__1, i__1, &c__2, (ftnlen)120); -/* Writing concatenation */ - i__2[0] = 38, a__2[0] = "HARDSPACE ^ NEWLINE /cr VTAB /vt FLAG "; - i__2[1] = 1, a__2[1] = delim; - i__2[2] = qrtrim_(errflg, (ftnlen)32), a__2[2] = errflg; - i__2[3] = 8, a__2[3] = " LEADER "; - i__2[4] = 1, a__2[4] = delim; - i__2[5] = 3, a__2[5] = "-- "; - i__2[6] = 16, a__2[6] = "LEFT 1 RIGHT 72 "; - s_cat(lstyle, a__2, i__2, &c__7, (ftnlen)120); - -/* The following styles will be used for logging of */ -/* commands and for commenting them out. */ - - s_copy(vstyle, "LEFT 1 RIGHT 78 ", (ftnlen)120, (ftnlen)16); -/* Writing concatenation */ - i__3[0] = 23, a__3[0] = "LEFT 1 RIGHT 78 LEADER "; - i__3[1] = 1, a__3[1] = delim; - i__3[2] = 3, a__3[2] = "-- "; - s_cat(hstyle, a__3, i__3, &c__3, (ftnlen)120); - nspsty_(sstyle, lstyle, (ftnlen)120, (ftnlen)120); - nsplgs_(vstyle, hstyle, delim, (ftnlen)120, (ftnlen)120, delim_len); - nspslr_(&c__1, &c__78); - -/* See whether or not a log file should be used and if so */ -/* what it's name should be. */ - - logchk_(lognam, usenam, &dolog, lognam_len, (ftnlen)255); - -/* Open a log file. */ - - if (dolog) { - nspopl_(usenam, versn, (ftnlen)255, versn_len); - } - if (have_(error, (ftnlen)1760)) { - nsperr_(commnd, error, (ftnlen)1024, (ftnlen)1760); - } - -/* Present a greeting to the user and perform any override */ -/* or special initializations that need to be local to this */ -/* routine. */ - - (*greet)(versn, versn_len); - -/* Get the input command line. This may have */ -/* several useful bits of information to tell us how */ -/* to run the program. */ - -/* -b means run the program in batch mode. In this case */ -/* we should never prompt the user for information. */ - -/* -start means we have a startup file to use and we want to */ -/* use the name of that file to determine how to */ -/* proceed. */ - - cmstup_(); - -/* Fetch and log the first command. */ - - trap = TRUE_; - -/* Get the next command and resolve any symbols or */ -/* queries that might show up in it, */ - - while(trap) { - getcom_(com2do, &from, (ftnlen)1024); - edtcom_(delim, prompt, com2do, &from, delim_len, prompt_len, (ftnlen) - 1024); - if (no_(error, (ftnlen)1760) && log__[(i__4 = from) < 4 && 0 <= i__4 ? - i__4 : s_rnge("log", i__4, "cmloop_", (ftnlen)430)]) { - nsplog_(com2do, &c_false, (ftnlen)1024); - } - if (no_(error, (ftnlen)1760)) { - ressym_(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - echo_(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - } - if (no_(error, (ftnlen)1760)) { - cmredo_(commnd, &from, &trap, (ftnlen)1024); - } - if (have_(error, (ftnlen)1760)) { - trap = FALSE_; - } - } - -/* Now apply the user's preprocessing software */ -/* to the comman. */ - - s_copy(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - (*preprc)(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - -/* Now process commands until we get an EXIT command. */ - - while(cmmore_(commnd, (ftnlen)1024)) { - -/* Perform any preprocessing that can be performed easily */ -/* on this command. */ - - if (no_(error, (ftnlen)1760)) { - builtn_(commnd, &hit, error, (ftnlen)1024, (ftnlen)1760); - } - if (no_(error, (ftnlen)1760) && ! hit) { - l = ltrim_(commnd, (ftnlen)1024); - rest = qrtrim_(commnd, (ftnlen)1024) + 1; - if (isrchc_(commnd + (l - 1), &c__2, spcial, rest - (l - 1), ( - ftnlen)8) == 0) { - (*action)(commnd, error, (ftnlen)1024, (ftnlen)1760); - } - } - problm = have_(error, (ftnlen)1760); - -/* Process any errors that were diagnosed. */ - - nsperr_(commnd, error, (ftnlen)1024, (ftnlen)1760); - -/* Fetch and log the next command. */ - - trap = TRUE_; - while(trap) { - getcom_(com2do, &from, (ftnlen)1024); - edtcom_(delim, prompt, com2do, &from, delim_len, prompt_len, ( - ftnlen)1024); - if (no_(error, (ftnlen)1760) && log__[(i__4 = from) < 4 && 0 <= - i__4 ? i__4 : s_rnge("log", i__4, "cmloop_", (ftnlen)496)] - ) { - nsplog_(com2do, &c_false, (ftnlen)1024); - } - if (no_(error, (ftnlen)1760)) { - ressym_(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - echo_(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - } - if (no_(error, (ftnlen)1760)) { - cmredo_(commnd, &from, &trap, (ftnlen)1024); - } - if (have_(error, (ftnlen)1760)) { - trap = FALSE_; - } - } - -/* Now apply the user's preprocessing software */ -/* to the comman. */ - - s_copy(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - (*preprc)(com2do, commnd, (ftnlen)1024, (ftnlen)1024); - } - -/* Take care of closing files and so on. */ - - if (log__[(i__4 = from) < 4 && 0 <= i__4 ? i__4 : s_rnge("log", i__4, - "cmloop_", (ftnlen)526)]) { - nspend_(); - } - return 0; -} /* cmloop_ */ - diff --git a/ext/spice/src/csupport/cmmore.c b/ext/spice/src/csupport/cmmore.c deleted file mode 100644 index 53fa8c1d54..0000000000 --- a/ext/spice/src/csupport/cmmore.c +++ /dev/null @@ -1,214 +0,0 @@ -/* cmmore.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure CMMORE ( Command Loop---More Commands) */ -logical cmmore_(char *commnd, ftnlen commnd_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char exit[32]; - static integer i__, r__; - extern logical nechr_(char *, char *, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static integer lc; - extern /* Subroutine */ int trnlat_(char *, char *, ftnlen, ftnlen), - cmprss_(char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen) - ; - -/* $ Abstract */ - -/* Determine whether or not more command loop processing */ -/* should be performed. */ - -/* $ 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 */ - -/* Command Loop */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COMMND I A command to be processed by CMLOOP */ - -/* The function returns .TRUE. if the command is not the "exit" */ -/* command. If it is the exit command it returns .FALSE. */ - -/* $ Detailed_Input */ - -/* COMMND A commmand that should be acted on by CMLOOP */ - - -/* $ Detailed_Output */ - -/* The function returns .TRUE. if this is not the exit command. */ -/* The meaning being "there is still more to do in CMLOOP." */ - -/* If the input command is equivalent to the exit command */ -/* (Same words when converted to uppercase) The function */ -/* returns .FALSE. The intended meaning is "there is nothing */ -/* left for CMLOOP to do but cleanup and return." */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is utility function for use by CMLOOP. It is the */ -/* function tested each pass through the loop to see if the */ -/* loop has finished its work */ - -/* $ Examples */ - -/* See CMLOOP. There is no other use for this function. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Command Loop Version 1.0.0, 4-AUG-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* More command processing required */ - -/* -& */ -/* SPICELIB Functions */ - - -/* Local Variables. */ - - -/* On the first pass we fetch the "exit" command and */ -/* spruce it up a bit for use when comparing with */ -/* the input command. */ - - if (first) { - first = FALSE_; - trnlat_("EXIT", exit, (ftnlen)4, (ftnlen)32); - cmprss_(" ", &c__1, exit, exit, (ftnlen)1, (ftnlen)32, (ftnlen)32); - ljust_(exit, exit, (ftnlen)32, (ftnlen)32); - r__ = rtrim_(exit, (ftnlen)32); - } - -/* If the input command is shorter than the non-blank */ -/* length of EXIT, then this cannot be the exit command. */ -/* There is more to do. */ - -/* Note we assign a value to CMMORE so that the compiler */ -/* won't have a fit about having a function unassigned. */ -/* The if conditions below ensure that we assign a value */ -/* but most compilers aren't smart enough to figure that */ -/* out. */ - - ret_val = TRUE_; - lc = i_len(commnd, commnd_len); - if (lc < r__) { - ret_val = TRUE_; - return ret_val; - } - -/* Check to see if the input command matches the exit command. */ -/* We do this a character at a time. We search from the */ -/* left to right, because most commands are not EXIT and this */ -/* allows us to quit early in the process. */ - - i__1 = r__; - for (i__ = 1; i__ <= i__1; ++i__) { - if (nechr_(commnd + (i__ - 1), exit + (i__ - 1), (ftnlen)1, (ftnlen)1) - ) { - ret_val = TRUE_; - return ret_val; - } - } - -/* It's looking like this might be it. See if the rest of */ -/* the input command is blank. */ - - if (lc == r__) { - -/* We've got an exact match. There are no more commands */ -/* to look at. */ - - ret_val = FALSE_; - } else if (lc > r__) { - -/* There will be more commands only if the rest of the input */ -/* command is non-blank. */ - - i__1 = r__; - ret_val = s_cmp(commnd + i__1, " ", commnd_len - i__1, (ftnlen)1) != - 0; - } - return ret_val; -} /* cmmore_ */ - diff --git a/ext/spice/src/csupport/cmredo.c b/ext/spice/src/csupport/cmredo.c deleted file mode 100644 index 46609b305f..0000000000 --- a/ext/spice/src/csupport/cmredo.c +++ /dev/null @@ -1,226 +0,0 @@ -/* cmredo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CMREDO ( COMMND loop trap ) */ -/* Subroutine */ int cmredo_(char *commnd, integer *from, logical *trap, - ftnlen commnd_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char exit[32], rest[300], stop[32]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static integer b1, b2, e1, e2; - extern integer rtrim_(char *, ftnlen); - static char start[32]; - extern logical m2wmch_(char *, integer *, integer *, char *, ftnlen, - ftnlen); - static char scndwd[32]; - extern /* Subroutine */ int trnlat_(char *, char *, ftnlen, ftnlen), - putcom_(char *, integer *, ftnlen); - static char frstwd[32]; - extern /* Subroutine */ int nextwd_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine examines COMMND and checks to see if it */ -/* should be sent to the COMMND loop stuff so that it */ -/* can be re-evaluated. */ - -/* $ 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 */ - -/* COMMAND LOOP */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COMMND I A COMMND string to be checked for special syntax */ -/* TRAP O Indicates whether the string has special form */ - -/* $ Detailed_Input */ - -/* COMMND is a string that represents some COMMND. */ - - -/* $ Detailed_Output */ - -/* TRAP is a logical idicating whether the string was special */ -/* and was put on the COMMND buffer. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine examines the input COMMND to see if it is one */ -/* of the following. */ - -/* EDIT number */ -/* RECALL ALL */ -/* RECALL number */ -/* START word */ -/* STOP */ -/* EXIT */ - - -/* $ Examples */ - -/* Later, */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 23-AUG-1995 (WLT) */ - -/* Updated the routine so that EDIT *, DO * and RECALL * */ -/* are trapped. */ - - -/* -& */ -/* $ Index_Entries */ - -/* «We need a permuted index entry */ - -/* -& */ - - if (first) { - trnlat_("STOP", stop, (ftnlen)4, (ftnlen)32); - trnlat_("EXIT", exit, (ftnlen)4, (ftnlen)32); - trnlat_("START", start, (ftnlen)5, (ftnlen)32); - first = FALSE_; - } - nextwd_(commnd, frstwd, rest, commnd_len, (ftnlen)32, (ftnlen)300); - nextwd_(rest, scndwd, rest, (ftnlen)300, (ftnlen)32, (ftnlen)300); - ucase_(frstwd, frstwd, (ftnlen)32, (ftnlen)32); - ucase_(scndwd, scndwd, (ftnlen)32, (ftnlen)32); - b1 = 1; - b2 = 1; - e1 = rtrim_(frstwd, (ftnlen)32); - e2 = rtrim_(scndwd, (ftnlen)32); - if (s_cmp(rest, " ", (ftnlen)300, (ftnlen)1) != 0) { - *trap = FALSE_; - return 0; - } - if (s_cmp(frstwd, " ", (ftnlen)32, (ftnlen)1) == 0) { - *trap = FALSE_; - return 0; - } - if (s_cmp(frstwd, start, (ftnlen)32, (ftnlen)32) == 0) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - return 0; - } else if (s_cmp(frstwd, exit, (ftnlen)32, (ftnlen)32) == 0 && s_cmp( - scndwd, " ", (ftnlen)32, (ftnlen)1) == 0 && *from != 2) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - return 0; - } else if (s_cmp(frstwd, stop, (ftnlen)32, (ftnlen)32) == 0 && s_cmp( - scndwd, " ", (ftnlen)32, (ftnlen)1) == 0 && *from != 2) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - return 0; - } else if (*from != 2) { - *trap = FALSE_; - return 0; - } else if (s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) == 0 && ! m2wmch_( - frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6)) { - *trap = FALSE_; - return 0; - } else if (m2wmch_(frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6) && - m2wmch_(scndwd, &b2, &e2, "@int(1:20)", (ftnlen)32, (ftnlen)10)) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else if (m2wmch_(frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6) && - m2wmch_(scndwd, &b2, &e2, "ALL", (ftnlen)32, (ftnlen)3)) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else if (m2wmch_(frstwd, &b1, &e1, "EDIT", (ftnlen)32, (ftnlen)4) && - m2wmch_(scndwd, &b2, &e2, "@int(1:20)", (ftnlen)32, (ftnlen)10)) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else if (m2wmch_(frstwd, &b1, &e1, "DO", (ftnlen)32, (ftnlen)2) && - m2wmch_(scndwd, &b2, &e2, "@int(1:20)", (ftnlen)32, (ftnlen)10)) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else if (m2wmch_(frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6) && - s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) != 0 && s_cmp(rest, - " ", (ftnlen)300, (ftnlen)1) == 0) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else if (m2wmch_(frstwd, &b1, &e1, "EDIT", (ftnlen)32, (ftnlen)4) && - s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) != 0 && s_cmp(rest, - " ", (ftnlen)300, (ftnlen)1) == 0) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else if (m2wmch_(frstwd, &b1, &e1, "DO", (ftnlen)32, (ftnlen)2) && - s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) != 0 && s_cmp(rest, - " ", (ftnlen)300, (ftnlen)1) == 0) { - *trap = TRUE_; - putcom_(commnd, from, commnd_len); - } else { - *trap = FALSE_; - } - return 0; -} /* cmredo_ */ - diff --git a/ext/spice/src/csupport/cmstup.c b/ext/spice/src/csupport/cmstup.c deleted file mode 100644 index 9c2152e912..0000000000 --- a/ext/spice/src/csupport/cmstup.c +++ /dev/null @@ -1,187 +0,0 @@ -/* cmstup.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure CMSTUP ( Command Loop Startup ) */ -/* Subroutine */ int cmstup_(void) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char file[255]; - integer b, e; - logical havgo; - integer start; - logical dobtch, havfil; - extern /* Subroutine */ int getcml_(char *, ftnlen); - char commnd[255]; - extern logical setbat_(void); - char comlin[255]; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen), trnlat_(char *, char *, ftnlen, ftnlen), suffix_(char - *, integer *, char *, ftnlen, ftnlen), putcom_(char *, integer *, - ftnlen); - -/* $ Abstract */ - -/* This routine performs command loop start ups associated */ -/* with information on the command line when the user */ -/* activated the program. */ - -/* $ 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 */ - -/* Command Loop */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine examines the information supplied on the command */ -/* line when a program was started and sets the symbols indicating */ -/* whether or not the program is in batch mode and if appropriate */ -/* sets up to start a command procedure. */ - -/* This routine works entirely by side effect. */ - -/* Recognized flags are: */ - -/* -b for batch mode */ -/* -start filename for starting a startup file. */ - -/* Unrecognized options are ignored. */ - -/* $ Examples */ - -/* See the command loop documentation */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-NOV-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Command loop set up. */ - -/* -& */ - -/* Command loop fucntions */ - - -/* Below are the various sources from which */ -/* commands might come. */ - -/* NONE */ -/* COMBUF */ -/* KEYBRD */ -/* INPFIL */ - - getcml_(comlin, (ftnlen)255); - start = 1; - havgo = FALSE_; - dobtch = FALSE_; - havfil = FALSE_; - fndnwd_(comlin, &start, &b, &e, (ftnlen)255); - while(b > 0) { - if (s_cmp(comlin + (b - 1), "-b", e - (b - 1), (ftnlen)2) == 0) { - dobtch = TRUE_; - } else if (s_cmp(comlin + (b - 1), "-start", e - (b - 1), (ftnlen)6) - == 0) { - havgo = TRUE_; - } else if (havgo && ! havfil) { - s_copy(file, comlin + (b - 1), (ftnlen)255, e - (b - 1)); - havfil = TRUE_; - } - start = e + 1; - fndnwd_(comlin, &start, &b, &e, (ftnlen)255); - } - -/* If we have a batch flag, notify NXTCOM */ - - if (dobtch) { - dobtch = setbat_(); - } - if (havgo && havfil) { - trnlat_("START", commnd, (ftnlen)5, (ftnlen)255); - suffix_(file, &c__1, commnd, (ftnlen)255, (ftnlen)255); - putcom_(commnd, &c__1, (ftnlen)255); - } - return 0; -} /* cmstup_ */ - diff --git a/ext/spice/src/csupport/cnfirm.c b/ext/spice/src/csupport/cnfirm.c deleted file mode 100644 index 24f72fdb50..0000000000 --- a/ext/spice/src/csupport/cnfirm.c +++ /dev/null @@ -1,192 +0,0 @@ -/* cnfirm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CNFIRM ( Return status of a yes/no query ) */ -/* Subroutine */ int cnfirm_(char *prmpt, logical *torf, ftnlen prmpt_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - logical yesno; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char respns[256]; - extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Return the .TRUE./.FALSE. status of a query which has a yes/no */ -/* response. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PRMPT I The prompt used to elicit a yes/no response. */ -/* TORF O The truth value of a yes/no response. */ - -/* $ Detailed_Input */ - -/* PRMPT The prompt which is used to elicit a yes/no response. */ - -/* $ Detailed_Output */ - -/* TORF A logical flag which indicates the truth value of a */ -/* yes/no response to a continue/try again prompt. If the */ -/* response was equivalent to yes, TORF = .TRUE.. If the */ -/* response was equivalent to no, TORF = .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) Any input value that is not equivalent to 'Y', 'YES', 'N' */ -/* or 'NO' (or lower case equivalents), will cause the routine */ -/* to redisplay the prompt. A yes/no response MUST be given, */ -/* there are no implicit values for any other response. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Often a program needs to ask whether or not a user wishes */ -/* to exercise some option. This routine simplifies the task */ -/* of converting the answer to a logical value. */ - -/* If the response to a yes/no question is logically equivalent */ -/* to 'YES' the variable TORF will be set to a value of .TRUE. */ -/* If the response to a yes/no question is logically equivalent */ -/* to 'NO' the variable TORF will be set to a value of .FALSE. */ -/* Any other response will cause the routine to redisplay the */ -/* prompt. */ - -/* $ Examples */ - -/* Suppose you need to ask a user whether or not diagnostic */ -/* information about the behaviour of a program should be */ -/* written to a file. Using this routine, you can easily */ -/* take the action desired and avoid the details of parsing */ -/* the user's answer. */ - -/* PRMPT = 'Log information to a file? (Yes/No) ' */ -/* OK = .FALSE. */ -/* CALL CONFRM( PRMPT, OK ) */ - -/* IF ( OK ) THEN */ - -/* ...enable recording diagnostics in the log file. */ - -/* ELSE */ - -/* ...disable recording of diagnostics. */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 09-SEP-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* prompt with a yes/no query and return logical response */ - -/* -& */ - -/* SPICELIB functions */ - -/* None. */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Do while we have not gotten a yes/no response */ - - yesno = FALSE_; - while(! yesno) { - -/* Prompt for a response */ - - prompt_(prmpt, respns, prmpt_len, (ftnlen)256); - -/* Left justify the response string, RESPNS, and convert it to */ -/* uppercase. */ - - ljust_(respns, respns, (ftnlen)256, (ftnlen)256); - ucase_(respns, respns, (ftnlen)256, (ftnlen)256); - if (s_cmp(respns, "Y", (ftnlen)256, (ftnlen)1) == 0 || s_cmp(respns, - "YES", (ftnlen)256, (ftnlen)3) == 0) { - *torf = TRUE_; - yesno = TRUE_; - } else if (s_cmp(respns, "N", (ftnlen)256, (ftnlen)1) == 0 || s_cmp( - respns, "NO", (ftnlen)256, (ftnlen)2) == 0) { - *torf = FALSE_; - yesno = TRUE_; - } - } - return 0; -} /* cnfirm_ */ - diff --git a/ext/spice/src/csupport/cnfirm_1.c b/ext/spice/src/csupport/cnfirm_1.c deleted file mode 100644 index 1a594fef2b..0000000000 --- a/ext/spice/src/csupport/cnfirm_1.c +++ /dev/null @@ -1,204 +0,0 @@ -/* cnfirm_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CNFIRM_1 ( Return status of a yes/no query ) */ -/* Subroutine */ int cnfirm_1__(char *prmpt, logical *torf, ftnlen prmpt_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - logical yesno; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char respns[256]; - extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Return the .TRUE./.FALSE. status of a query which has a yes/no */ -/* response. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PRMPT I The prompt used to elicit a yes/no response. */ -/* TORF O The truth value of a yes/no response. */ - -/* $ Detailed_Input */ - -/* PRMPT The prompt which is used to elicit a yes/no response. */ - -/* $ Detailed_Output */ - -/* TORF A logical flag which indicates the truth value of a */ -/* yes/no response to a continue/try again prompt. If the */ -/* response was equivalent to yes, TORF = .TRUE.. If the */ -/* response was equivalent to no, TORF = .FALSE.. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) Any input value that is not equivalent to 'Y', 'YES', 'N' */ -/* or 'NO' (or lower case equivalents), will cause the routine */ -/* to redisplay the prompt. A yes/no response MUST be given, */ -/* there are no implicit values for any other response. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Often a program needs to ask whether or not a user wishes */ -/* to exercise some option. This routine simplifies the task */ -/* of converting the answer to a logical value. */ - -/* If the response to a yes/no question is logically equivalent */ -/* to 'YES' the variable TORF will be set to a value of .TRUE. */ -/* If the response to a yes/no question is logically equivalent */ -/* to 'NO' the variable TORF will be set to a value of .FALSE. */ -/* Any other response will cause the routine to redisplay the */ -/* prompt. */ - -/* $ Examples */ - -/* Suppose you need to ask a user whether or not diagnostic */ -/* information about the behaviour of a program should be */ -/* written to a file. Using this routine, you can easily */ -/* take the action desired and avoid the details of parsing */ -/* the user's answer. */ - -/* PRMPT = 'Log information to a file? (Yes/No) ' */ -/* OK = .FALSE. */ -/* CALL CONFRM( PRMPT, OK ) */ - -/* IF ( OK ) THEN */ - -/* ...enable recording diagnostics in the log file. */ - -/* ELSE */ - -/* ...disable recording of diagnostics. */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 09-SEP-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* prompt with a yes/no query and return logical response */ - -/* -& */ - -/* SPICELIB functions */ - -/* None. */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Do while we have not gotten a yes/no response */ - - yesno = FALSE_; - while(! yesno) { - -/* Prompt for a response */ - - prompt_(prmpt, respns, prmpt_len, (ftnlen)256); - -/* Left justify the response string, RESPNS, and convert it to */ -/* uppercase. */ - - ljust_(respns, respns, (ftnlen)256, (ftnlen)256); - ucase_(respns, respns, (ftnlen)256, (ftnlen)256); - if (s_cmp(respns, "Y", (ftnlen)256, (ftnlen)1) == 0 || s_cmp(respns, - "YES", (ftnlen)256, (ftnlen)3) == 0) { - *torf = TRUE_; - yesno = TRUE_; - } else if (s_cmp(respns, "N", (ftnlen)256, (ftnlen)1) == 0 || s_cmp( - respns, "NO", (ftnlen)256, (ftnlen)2) == 0) { - *torf = FALSE_; - yesno = TRUE_; - } - } - return 0; -} /* cnfirm_1__ */ - diff --git a/ext/spice/src/csupport/convbt.c b/ext/spice/src/csupport/convbt.c deleted file mode 100644 index 40d70a41e6..0000000000 --- a/ext/spice/src/csupport/convbt.c +++ /dev/null @@ -1,477 +0,0 @@ -/* convbt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__9 = 9; -static integer c__1 = 1; - -/* $ Procedure CONVBT ( Convert Kernel file from binary to text ) */ -/* Subroutine */ int convbt_(char *binfil, char *txtfil, ftnlen binfil_len, - ftnlen txtfil_len) -{ - /* System generated locals */ - cllist cl__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *), s_wsle( - cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle( - void); - - /* Local variables */ - extern /* Subroutine */ int dafbt_(char *, integer *, ftnlen); - char farch[3]; - extern /* Subroutine */ int chkin_(char *, ftnlen), spcec_(integer *, - integer *), dasbt_(char *, integer *, ftnlen), errch_(char *, - char *, ftnlen, ftnlen); - char ftype[4]; - extern logical failed_(void); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, - ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - setmsg_(char *, ftnlen); - integer iostat; - logical comnts; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen); - integer txtlun; - - /* Fortran I/O blocks */ - static cilist io___7 = { 1, 0, 0, 0, 0 }; - static cilist io___8 = { 1, 0, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Convert a SPICE binary file to an equivalent text file format. */ - -/* NOTE: This routine is currently for use ONLY with the SPACIT */ -/* utility program. Use it at your own risk. */ - -/* $ 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 */ - -/* CONVERSION */ -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BINFIL I Name of an existing SPICE binary file. */ -/* TXTFIL I Name of the text file to be created. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) */ - -/* $ Particulars */ - -/* This routine accepts as inputs the name of a binary file to be */ -/* converted to text and the name of the text file to be created. */ -/* The binary file must already exist and the text file must not */ -/* exist for this routine to work correctly. The architecture and the */ -/* file type are determined and then an appropriate file conversion */ -/* is performed. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* 1) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 3.2.0, 30-AUG-1994 (KRG) */ - -/* Improved the error diagnostics when incorrect inputs are */ -/* provided, e.g., a transfer filename instead of a binary kernel */ -/* filename. */ - -/* - Beta Version 3.1.0, 12-AUG-1994 (KRG) */ - -/* Fixed a minor bug that would occur when formatting a long error */ -/* message. ERRFNM was called with a logical unit that had already */ -/* been closed. */ - -/* - Beta Version 3.0.0, 22-APR-1994 (KRG) */ - -/* Made updates to the routine to make use of the new SPICE */ -/* capability of determining binary kernel file types at run time. */ - -/* Removed the arguments for the file architecture and file type */ -/* from the calling list. This information was no longer */ -/* necessary. */ - -/* Rearranged some of the code to make it easier to understand. */ - -/* Added a new error: if the architecture or type are not */ -/* recognized, we can't process the file. */ - -/* - Beta Version 2.0.0, 28-JAN-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert binary SPICE files to text */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Begin and end markers in the file for the comment area. */ - - -/* File types that are recognized. */ - - -/* Length of a file architecture. */ - - -/* Maximum length for a file type. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CONVBT", (ftnlen)6); - } - -/* Initialize the file architecture and the file type. */ - - s_copy(farch, " ", (ftnlen)3, (ftnlen)1); - s_copy(ftype, " ", (ftnlen)4, (ftnlen)1); - -/* Get the architecture and type of the binary file. */ - - getfat_(binfil, farch, ftype, binfil_len, (ftnlen)3, (ftnlen)4); - if (failed_()) { - -/* If there was an error getting the file architecture, just */ -/* return. An appropriate error message should have been set. */ -/* So, all we need to do here is return to the caller. */ - - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Check to see that we got back a valid architecture and type. */ - - -/* Open the text file for output, obtaining a Fortran logical */ -/* unit. */ - - txtopn_(txtfil, &txtlun, txtfil_len); - if (failed_()) { - -/* If there was an error opening the text file, just return. */ -/* An appropriate error message should have been set by TXTOPN. */ -/* So, all we need to do here is return to the caller. */ - - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Process the files based on their binary architectures */ - - if (s_cmp(farch, "DAF", (ftnlen)3, (ftnlen)3) == 0) { - -/* If the file is a NAIF SPK, CK, or PCK binary file, it may have */ -/* a comment area. So set the COMNTS flag appropriately. */ - - comnts = s_cmp(ftype, "SPK", (ftnlen)4, (ftnlen)3) == 0; - comnts = comnts || s_cmp(ftype, "CK", (ftnlen)4, (ftnlen)2) == 0; - comnts = comnts || s_cmp(ftype, "PCK", (ftnlen)4, (ftnlen)3) == 0; - -/* First, convert the data portion of the binary file to text. */ -/* We only support the latest and greatest text file format for */ -/* conversion of the binary files to text. */ - - dafbt_(binfil, &txtlun, binfil_len); - if (failed_()) { - -/* If an error occurred while attempting to convert the */ -/* data portion of the DAF file to text, we need to close */ -/* the text file and return to the caller. We will delete */ -/* the text file when we close it. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* The DAF file may or may not have a comment area. If it is a */ -/* NAIF SPICE kernel file, then it does and we need to deal with */ -/* it. Otherwise we do nothing. */ - - if (comnts) { - -/* We need to open the binary DAF file so that we can extract */ -/* the comments from its comment area and place them in the */ -/* text file. */ - - dafopr_(binfil, &handle, binfil_len); - if (failed_()) { - -/* If an error occurred, we need to close the text file and */ -/* return to the caller. We will delete the text file when */ -/* we close it. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Write the begin comments marker to the text file. */ - - io___7.ciunit = txtlun; - iostat = s_wsle(&io___7); - if (iostat != 0) { - goto L100001; - } - iostat = do_lio(&c__9, &c__1, "~NAIF/SPC BEGIN COMMENTS~", ( - ftnlen)25); - if (iostat != 0) { - goto L100001; - } - iostat = e_wsle(); -L100001: - if (iostat != 0) { - -/* An error occurred, so close both the text and binary */ -/* files, set an appropriate error message, and return to */ -/* the caller. The text file is deleted when it is closed. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - dafcls_(&handle); - setmsg_("Error writing the begin comments marker to the text" - " file: #. IOSTAT = #.", (ftnlen)72); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Extract the comment area of the binary file to the text */ -/* file. */ - - spcec_(&handle, &txtlun); - if (failed_()) { - -/* If the comment extraction failed, then an appropriate */ -/* error message should have already been set, so close */ -/* the text and binary files and return to the caller. The */ -/* text file is deleted when it is closed. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Write the end comments marker. */ - - io___8.ciunit = txtlun; - iostat = s_wsle(&io___8); - if (iostat != 0) { - goto L100002; - } - iostat = do_lio(&c__9, &c__1, "~NAIF/SPC END COMMENTS~", (ftnlen) - 23); - if (iostat != 0) { - goto L100002; - } - iostat = e_wsle(); -L100002: - if (iostat != 0) { - -/* An error occurred, so close both the text and binary */ -/* files, set an appropriate error message, and return to */ -/* the caller. The text file is deleted when it is closed. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - dafcls_(&handle); - setmsg_("Error writing the end comments marker to the text f" - "ile: #. IOSTAT = #.", (ftnlen)70); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Close the binary DAF file that we opened to extract the */ -/* comments. */ - - dafcls_(&handle); - } - } else if (s_cmp(farch, "DAS", (ftnlen)3, (ftnlen)3) == 0) { - -/* DAS files are easy. Everything is integrated into the files */ -/* so we do not need to worry about comments or reserved records */ -/* or anything. We just convert it. */ - -/* Convert the data portion of the binary file to text. We */ -/* only support the latest and greatest text file format for */ -/* conversion of the binary files to text. */ - - dasbt_(binfil, &txtlun, binfil_len); - if (failed_()) { - -/* If an error occurred while attempting to convert the */ -/* DAS file to text, we need to close the text file and */ -/* return to the caller. We will delete the text file */ -/* when we close it. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - } else if (s_cmp(farch, "XFR", (ftnlen)3, (ftnlen)3) == 0) { - -/* This is an error case, most likely caused by reading a transfer */ -/* file by accident. So signal an appropriate error. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - setmsg_("The file '#' appears to be a transfer file and not a binary" - " kernel file.", (ftnlen)72); - errch_("#", binfil, (ftnlen)1, binfil_len); - sigerr_("SPICE(NOTABINARYKERNEL)", (ftnlen)23); - chkout_("CONVBT", (ftnlen)6); - return 0; - } else if (s_cmp(farch, "DEC", (ftnlen)3, (ftnlen)3) == 0) { - -/* This is an error case, most likely caused by reading a transfer */ -/* file by accident. So signal an appropriate error. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - setmsg_("The file '#' appears to be a decimal transfer file and not " - "a binary kernel file.", (ftnlen)80); - errch_("#", binfil, (ftnlen)1, binfil_len); - sigerr_("SPICE(NOTABINARYKERNEL)", (ftnlen)23); - chkout_("CONVBT", (ftnlen)6); - return 0; - } else { - -/* This is the catch all error case. At this point, we didn't */ -/* match any of the files whose architecture and types are */ -/* recognized. So, we toss our hands in the air and signal an */ -/* error. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = "DELETE"; - f_clos(&cl__1); - setmsg_("The architecture and type of the file '#' were not recogniz" - "ed.", (ftnlen)62); - errch_("#", binfil, (ftnlen)1, binfil_len); - sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20); - chkout_("CONVBT", (ftnlen)6); - return 0; - } - -/* Close the text file that was created. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("CONVBT", (ftnlen)6); - return 0; -} /* convbt_ */ - diff --git a/ext/spice/src/csupport/convrt_2.c b/ext/spice/src/csupport/convrt_2.c deleted file mode 100644 index 6a52c61a36..0000000000 --- a/ext/spice/src/csupport/convrt_2.c +++ /dev/null @@ -1,722 +0,0 @@ -/* convrt_2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__128 = 128; -static doublereal c_b32 = 1.; -static integer c__0 = 0; -static doublereal c_b34 = 0.; -static integer c_n1 = -1; - -/* $Procedure CONVRT_2 ( Convert Units ) */ -/* Subroutine */ int convrt_2__(doublereal *xin, char *unin, char *unout, - doublereal *xout, ftnlen unin_len, ftnlen unout_len) -{ - /* Initialized data */ - - static doublereal dim[6] = { 0.,1.,1.,1.,1.,1. }; - static logical first = TRUE_; - static char name__[8*5] = "angle " "length " "time " "mass " - "charge "; - static integer nop = 6; - static char op[2*6] = " " "( " ") " "* " "**" "/ "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double pow_dd(doublereal *, doublereal *); - - /* Local variables */ - static doublereal diff; - extern /* Subroutine */ int scan_(char *, char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - ftnlen, ftnlen); - static doublereal keep; - static logical done, move; - static integer mult, b, e, i__, j, l, o, r__, blank; - static doublereal dimen[6]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer ident[128]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - static integer class__; - static doublereal inval, value; - static integer oplen[6]; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - static doublereal opval[6]; - static logical known; - static integer start, inout; - extern logical unitp_(char *, ftnlen); - static integer opptr[20]; - extern /* Subroutine */ int podbed_(doublereal *, integer *, integer *), - podbgd_(doublereal *), podegd_(doublereal *); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static doublereal dimeni[6]; - extern /* Subroutine */ int appndd_(doublereal *, doublereal *), podbgi_( - integer *), podegi_(integer *); - static doublereal dimeno[6]; - static integer active; - extern /* Subroutine */ int appndi_(integer *, integer *); - static doublereal parsed[134]; - static integer lparen; - extern /* Subroutine */ int fnducv_(char *, logical *, integer *, - doublereal *, ftnlen), scanpr_(integer *, char *, integer *, - integer *, ftnlen); - static integer rparen, classs[134]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssized_(integer *, doublereal *), setmsg_(char *, ftnlen) - , ssizei_(integer *, integer *); - static doublereal outval; - static integer ntokns; - static doublereal expont[134]; - extern logical return_(void); - static integer beg[128], end[128], div, exp__; - -/* $ Abstract */ - -/* Convert a quantity in one system of units to another system. */ - -/* $ 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 */ - -/* CONVERSION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* XIN I A quantity measured in UNIN units. */ -/* UNIN I The units of the input quantity. */ -/* UNOUT I The units desired for output. */ -/* XOUT O The value of XIN in the UNOUT units. */ - -/* $ Detailed_Input */ - -/* XIN is the measurement of a physical quantity in the */ -/* units given by UNIN. */ - -/* UNIN are the units associated with the input quantity */ -/* XIN. These units should be expressed in terms */ -/* of units of angle, length, time, mass and charge */ -/* (no compound units such as newtons or joules.) */ - - -/* UNOUT are the units that will be associated with the */ -/* output quantity XOUT. UNOUT must be dimensionally */ -/* equivalent to UNIN and, like UNIN, must be expressed */ -/* in terms of units of angle, length, time, mass and */ -/* charge. */ - -/* $ Detailed_Output */ - -/* XOUT is the number of UNOUT units that are equal to */ -/* XIN units of UNIN. XOUT may overwrite XIN. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either UNIN or UNOUT is not a recognized physical unit, */ -/* the error 'SPICE(BADUNITS)' will be signalled. */ - -/* 2) If UNIN and UNOUT are not dimensionally equivalent, the */ -/* error 'SPICE(INCOMPATIBLEUNITS)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a simple means of converting between */ -/* a quantity expressed in terms of one system of units to */ -/* another system of units. The fundamental units recognized */ -/* are those recognized by FNDUCV. The units recognized by */ -/* version 1.0.0 of FNDUCV are: */ - - - - -/* If the singular form a unit is not listed, but it is obtained */ -/* from the plural form by dropping a final 'S', you may use the */ -/* singular form. For example, */ - -/* instead of SECONDS you may use SECOND; */ -/* instead of MILES you may use MILE; */ -/* instead of DEGREES you may use DEGREE. */ - -/* Thus the strings 'SECONDS/DEGREE', 'SECOND/DEGREES', */ -/* 'SECOND/DEGREE', and 'SECONDS/DEGREES' are all recognized */ -/* and hav have the same meaning. */ - -/* $ Examples */ - -/* Suppose you needed to convert a state, PV, from KM and KM/SEC to */ -/* AU and AU/365 days. The following loop will do the job. */ - -/* DO I = 1, 3 */ -/* CALL CONVRT_2 ( PV(I), 'KM', 'AU', PV(I) ) */ -/* CALL CONVRT_2 ( PV(I+3), 'KM/SEC', 'AU/(365*DAYS)' PV(I+3) ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 31-MAY-1991 (WLT) */ - -/* -& */ - -/* These are the class id's for each of the various entities */ -/* that make up the variables of a unit. */ - - -/* These are the codes will will use for the various */ -/* operations. */ - - -/* Scanning Parameters */ - - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Here is the range of Character ASCII code */ -/* initial characters that --------- ---------- */ -/* will be used by the ' ' 32 */ -/* "known" marks. '(' 40 */ -/* ')' 41 */ -/* '*' 42 */ -/* '/' 47 */ - -/* So the required number of pointers is 47 - 32 + 5 = 20. */ - - -/* Saved Variables */ - - -/* Initial Values */ - - -/* The game is afoot! */ - - if (return_()) { - return 0; - } else { - chkin_("CONVRT_2", (ftnlen)8); - } - if (first) { - first = FALSE_; - scanpr_(&nop, op, oplen, opptr, (ftnlen)2); - blank = bsrchc_(" ", &nop, op, (ftnlen)1, (ftnlen)2); - lparen = bsrchc_("(", &nop, op, (ftnlen)1, (ftnlen)2); - rparen = bsrchc_(")", &nop, op, (ftnlen)1, (ftnlen)2); - mult = bsrchc_("*", &nop, op, (ftnlen)1, (ftnlen)2); - exp__ = bsrchc_("**", &nop, op, (ftnlen)2, (ftnlen)2); - div = bsrchc_("/", &nop, op, (ftnlen)1, (ftnlen)2); - opval[(i__1 = blank - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_2__", (ftnlen)323)] = 0.f; - opval[(i__1 = lparen - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_2__", (ftnlen)324)] = 0.f; - opval[(i__1 = rparen - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_2__", (ftnlen)325)] = 0.f; - opval[(i__1 = mult - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_2__", (ftnlen)326)] = 1.; - opval[(i__1 = exp__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_2__", (ftnlen)327)] = 3.; - opval[(i__1 = div - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", i__1, - "convrt_2__", (ftnlen)328)] = 2.; - } - -/* First make sure that both UNIN and UNOUT are recognized */ -/* units. */ - - if (! unitp_(unin, unin_len)) { - setmsg_("The input unit, #, was not recognized as a valid unit speci" - "fication.", (ftnlen)68); - errch_("#", unin, (ftnlen)1, unin_len); - sigerr_("SPICE(UNKNOWNUNITS)", (ftnlen)19); - chkout_("CONVRT_2", (ftnlen)8); - return 0; - } - if (! unitp_(unout, unout_len)) { - setmsg_("The output unit, #, was not recognized as a valid unit spec" - "ification.", (ftnlen)69); - errch_("#", unin, (ftnlen)1, unin_len); - sigerr_("SPICE(UNKNOWNUNITS)", (ftnlen)19); - chkout_("CONVRT_2", (ftnlen)8); - return 0; - } - -/* We will need to keep track of the dimensions associated */ -/* with both input and output units. */ - - dimeni[1] = 0.; - dimeni[2] = 0.; - dimeni[3] = 0.; - dimeni[4] = 0.; - dimeni[5] = 0.; - dimeno[1] = 0.; - dimeno[2] = 0.; - dimeno[3] = 0.; - dimeno[4] = 0.; - dimeno[5] = 0.; - -/* We need to parse both the input and output units, we */ -/* do that in the loop that ranges from INPUT to OUTPUT. */ - - for (inout = 1; inout <= 2; ++inout) { - -/* Initialize the various pods we will need to use to */ -/* parse this set of units. */ - - ssized_(&c__128, parsed); - ssizei_(&c__128, classs); - ssized_(&c__128, expont); - -/* Zero out the dimension vector. */ - - dimen[1] = 0.; - dimen[2] = 0.; - dimen[3] = 0.; - dimen[4] = 0.; - dimen[5] = 0.; - -/* We haven't finished scanning this unit yet. */ - - done = FALSE_; - -/* We are beginnin a group now. After beginning a group we ALWAYS */ -/* append 1,0,0 and MULTPLY, -1, 0 to the PARSED, CLASSS, and */ -/* EXPONT pod. Why ask why? Well in this case we do it because */ -/* it makes the processing MUCH simpler (you'll see). */ - - appndd_(&c_b32, parsed); - appndi_(&c__0, classs); - appndd_(&c_b34, expont); - appndd_(&c_b32, parsed); - appndi_(&c_n1, classs); - appndd_(&c_b34, expont); - -/* We'll start scanning this string from the first character. */ - - start = 1; - if (inout == 1) { - scan_(unin, op, oplen, opptr, &c__128, &start, &ntokns, ident, - beg, end, unin_len, (ftnlen)2); - } else if (inout == 2) { - scan_(unout, op, oplen, opptr, &c__128, &start, &ntokns, ident, - beg, end, unout_len, (ftnlen)2); - } - -/* For as long as there are tokens to look at... */ - - while(ntokns > 0) { - -/* ... examine each in turn, classify it and take */ -/* an appropriate action. */ - - i__1 = ntokns; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* If we have a left parenthesis ... */ - - if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "convrt_2__", (ftnlen)453)] == lparen) - { - -/* We are beginnin a group now. After beginning a */ -/* group we ALWAYS append 1,0,0 and MULTPLY, -1, 0 to */ -/* the PARSED, CLASSS, and EXPONT pod. */ - - podbgd_(parsed); - podbgi_(classs); - podbgd_(expont); - appndd_(&c_b32, parsed); - appndi_(&c__0, classs); - appndd_(&c_b34, expont); - appndd_(&c_b32, parsed); - appndi_(&c_n1, classs); - appndd_(&c_b34, expont); - -/* ... or if we have an arithmetic operations */ - - } else if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "convrt_2__", (ftnlen)475)] == - mult || ident[(i__3 = i__ - 1) < 128 && 0 <= i__3 ? - i__3 : s_rnge("ident", i__3, "convrt_2__", (ftnlen) - 475)] == div || ident[(i__4 = i__ - 1) < 128 && 0 <= - i__4 ? i__4 : s_rnge("ident", i__4, "convrt_2__", ( - ftnlen)475)] == exp__) { - -/* Append the operation to the current group. */ - - appndd_(&opval[(i__3 = ident[(i__2 = i__ - 1) < 128 && 0 - <= i__2 ? i__2 : s_rnge("ident", i__2, "convrt_2" - "__", (ftnlen)482)] - 1) < 6 && 0 <= i__3 ? i__3 : - s_rnge("opval", i__3, "convrt_2__", (ftnlen)482)], - parsed); - appndi_(&c_n1, classs); - appndd_(&c_b34, expont); - -/* ...or if we have a unit or number ... */ - - } else if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "convrt_2__", (ftnlen)489)] == - 0) { - -/* Look up the class and value for this token, */ -/* append them to the current group. */ - - b = beg[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "convrt_2__", (ftnlen)495)]; - e = end[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("end", i__2, "convrt_2__", (ftnlen)496)]; - if (inout == 1) { - fnducv_(unin + (b - 1), &known, &class__, &value, e - - (b - 1)); - } else if (inout == 2) { - fnducv_(unout + (b - 1), &known, &class__, &value, e - - (b - 1)); - } - appndd_(&value, parsed); - appndi_(&class__, classs); - appndd_(&dim[(i__2 = class__) < 6 && 0 <= i__2 ? i__2 : - s_rnge("dim", i__2, "convrt_2__", (ftnlen)510)], - expont); - -/* ...or if we have a right parenthesis, close off */ -/* this group by evaluating it, then close the group */ -/* and append the last value computed onto its list */ -/* of value/operation pairs. */ - - } else if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "convrt_2__", (ftnlen)519)] == - rparen) { - -/* We are ending a group. It's time to perform all */ -/* indicated operations in this group. Note the */ -/* structure of a completed group is: */ - -/* Value OP Value OP Value ... OP Value */ - -/* Thus all operations are at even slots in the */ -/* group. The scheme for evaluating this expression */ -/* is: identify the next operation to perform (more on */ -/* how to locate the operation in a minute); */ - -/* Do this one */ -/* _____^______ */ -/* ' ` */ -/* Value OP Value OP Value OP Value OP Value OP ... */ - -/* replace the three entries by the result. */ - -/* Value OP Value OP result OP Value OP ... */ - -/* The hierarchy of operations is */ - -/* 1.) exponentiation in left to right order. */ - -/* 2.) multiplication and division in left */ -/* to right order. */ - -/* Since the parsing is from left to right, as we */ -/* simplify subexpression, we can shift items left */ -/* to fill in the gaps left by the operator and */ -/* second value of the expression that was simplified. */ - -/* To do all this we must fist identify the beginning */ -/* and ends of this group. */ - - podbed_(parsed, &b, &e); - -/* First handle exponentiation. So far we haven't */ -/* moved anything, the ACTIVE left operand is at B; */ -/* the first operator is located at B+1. We will let */ -/* ATOP (at operator) be the logical flag that indicates */ -/* whether J points to an operator or an operand. */ - - move = FALSE_; - active = b; - j = b + 1; - while(j <= e) { - if (parsed[(i__2 = j + 5) < 134 && 0 <= i__2 ? i__2 : - s_rnge("parsed", i__2, "convrt_2__", (ftnlen) - 572)] == 3.) { - -/* We are going to simplify an expression */ -/* of the form X ** Y to its computed value. */ -/* This means we will be freeing up room to */ -/* move items to the left. */ - - - move = TRUE_; - parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_2__" - , (ftnlen)583)] = pow_dd(&parsed[(i__3 = - active + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("parsed", i__3, "convrt_2__", ( - ftnlen)583)], &parsed[(i__4 = j + 6) < - 134 && 0 <= i__4 ? i__4 : s_rnge("parsed", - i__4, "convrt_2__", (ftnlen)583)]); - expont[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("expont", i__2, "convrt_2__" - , (ftnlen)584)] = expont[(i__3 = active + - 5) < 134 && 0 <= i__3 ? i__3 : s_rnge( - "expont", i__3, "convrt_2__", (ftnlen)584) - ] * parsed[(i__4 = j + 6) < 134 && 0 <= - i__4 ? i__4 : s_rnge("parsed", i__4, - "convrt_2__", (ftnlen)584)]; - } else { - -/* If we are moving operators and right */ -/* operands to the left, now is the time */ -/* to do it. */ - - if (move) { - o = active + 1; - l = active + 2; - r__ = j + 1; - parsed[(i__2 = o + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convr" - "t_2__", (ftnlen)600)] = parsed[(i__3 = - j + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("parsed", i__3, "convrt_2__", ( - ftnlen)600)]; - classs[(i__2 = o + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("classs", i__2, "convr" - "t_2__", (ftnlen)601)] = classs[(i__3 = - j + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("classs", i__3, "convrt_2__", ( - ftnlen)601)]; - expont[(i__2 = o + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("expont", i__2, "convr" - "t_2__", (ftnlen)602)] = expont[(i__3 = - j + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("expont", i__3, "convrt_2__", ( - ftnlen)602)]; - parsed[(i__2 = l + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convr" - "t_2__", (ftnlen)604)] = parsed[(i__3 = - r__ + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("parsed", i__3, "convrt_2__", ( - ftnlen)604)]; - classs[(i__2 = l + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("classs", i__2, "convr" - "t_2__", (ftnlen)605)] = classs[(i__3 = - r__ + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("classs", i__3, "convrt_2__", ( - ftnlen)605)]; - expont[(i__2 = l + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("expont", i__2, "convr" - "t_2__", (ftnlen)606)] = expont[(i__3 = - r__ + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("expont", i__3, "convrt_2__", ( - ftnlen)606)]; - } - active += 2; - } - -/* Make J point to the next operator. */ - - j += 2; - } - -/* Next handle multiplication and division. */ - - e = active; - active = b; - j = b + 1; - while(j <= e) { - r__ = j + 1; - class__ = classs[(i__2 = r__ + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("classs", i__2, "convrt_2__", ( - ftnlen)631)]; - if (parsed[(i__2 = j + 5) < 134 && 0 <= i__2 ? i__2 : - s_rnge("parsed", i__2, "convrt_2__", (ftnlen) - 633)] == 1.) { - parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_2__" - , (ftnlen)635)] = parsed[(i__3 = active + - 5) < 134 && 0 <= i__3 ? i__3 : s_rnge( - "parsed", i__3, "convrt_2__", (ftnlen)635) - ] * parsed[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("parsed", i__4, - "convrt_2__", (ftnlen)635)]; - dimen[(i__2 = class__) < 6 && 0 <= i__2 ? i__2 : - s_rnge("dimen", i__2, "convrt_2__", ( - ftnlen)636)] = dimen[(i__3 = class__) < 6 - && 0 <= i__3 ? i__3 : s_rnge("dimen", - i__3, "convrt_2__", (ftnlen)636)] + - expont[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("expont", i__4, - "convrt_2__", (ftnlen)636)]; - } else if (parsed[(i__2 = j + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_2__", ( - ftnlen)638)] == 2.) { - parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_2__" - , (ftnlen)640)] = parsed[(i__3 = active + - 5) < 134 && 0 <= i__3 ? i__3 : s_rnge( - "parsed", i__3, "convrt_2__", (ftnlen)640) - ] / parsed[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("parsed", i__4, - "convrt_2__", (ftnlen)640)]; - dimen[(i__2 = class__) < 6 && 0 <= i__2 ? i__2 : - s_rnge("dimen", i__2, "convrt_2__", ( - ftnlen)641)] = dimen[(i__3 = class__) < 6 - && 0 <= i__3 ? i__3 : s_rnge("dimen", - i__3, "convrt_2__", (ftnlen)641)] - - expont[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("expont", i__4, - "convrt_2__", (ftnlen)641)]; - } - j += 2; - } - -/* Finally, save the first value of the group, end the */ -/* group, and append the saved value to the previous */ -/* group. */ - - keep = parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_2__", ( - ftnlen)654)]; - podegd_(parsed); - podegi_(classs); - podegd_(expont); - appndd_(&keep, parsed); - appndi_(&c__0, classs); - appndd_(&c_b34, expont); - } - } - -/* Just in case there are any left-overs, scan the */ -/* string for more tokens */ - - if (inout == 1) { - scan_(unin, op, oplen, opptr, &c__128, &start, &ntokns, ident, - beg, end, unin_len, (ftnlen)2); - } else if (inout == 2) { - scan_(unout, op, oplen, opptr, &c__128, &start, &ntokns, - ident, beg, end, unout_len, (ftnlen)2); - } - -/* If there are no more tokens left, we need to be sure */ -/* to close the last group (the one we opened before we */ -/* had even begun to scan UNIN or UNOUT. */ - - if (ntokns == 0 && ! done) { - done = TRUE_; - ntokns = 1; - ident[0] = rparen; - } - } - -/* Put the result of the parse into the input or output storage */ -/* area as appropriate. */ - - if (inout == 1) { - dimeni[1] = dimen[1]; - dimeni[2] = dimen[2]; - dimeni[3] = dimen[3]; - dimeni[4] = dimen[4]; - dimeni[5] = dimen[5]; - inval = parsed[6]; - } else if (inout == 2) { - dimeno[1] = dimen[1]; - dimeno[2] = dimen[2]; - dimeno[3] = dimen[3]; - dimeno[4] = dimen[4]; - dimeno[5] = dimen[5]; - outval = parsed[6]; - } - -/* Finally, if this is only the first of the units that needs to */ -/* be parsed, loop back through the code above a second time. */ - - } - -/* One final check must be performed. The input and output */ -/* units must be dimensionally equivalent. */ - - for (i__ = 1; i__ <= 5; ++i__) { - if (dimeni[(i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge("dimeni", - i__1, "convrt_2__", (ftnlen)744)] != dimeno[(i__2 = i__) < 6 - && 0 <= i__2 ? i__2 : s_rnge("dimeno", i__2, "convrt_2__", ( - ftnlen)744)]) { - diff = dimeni[(i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge("dim" - "eni", i__1, "convrt_2__", (ftnlen)746)] - dimeno[(i__2 = - i__) < 6 && 0 <= i__2 ? i__2 : s_rnge("dimeno", i__2, - "convrt_2__", (ftnlen)746)]; - setmsg_("The input and output units are not dimensionally equiva" - "lent. The difference between the input and output dimen" - "sion for # is #.", (ftnlen)127); - errch_("#", name__ + (((i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : - s_rnge("name", i__1, "convrt_2__", (ftnlen)753)) << 3), ( - ftnlen)1, (ftnlen)8); - errdp_("#", &diff, (ftnlen)1); - sigerr_("SPICE(NOTDIMENSIONALLYEQUIV)", (ftnlen)28); - chkout_("CONVRT_2", (ftnlen)8); - return 0; - } - } - -/* That was the last hurdle, now we can just comput the output. */ - - *xout = inval / outval * *xin; - chkout_("CONVRT_2", (ftnlen)8); - return 0; -} /* convrt_2__ */ - diff --git a/ext/spice/src/csupport/convrt_3.c b/ext/spice/src/csupport/convrt_3.c deleted file mode 100644 index 407bc50a6a..0000000000 --- a/ext/spice/src/csupport/convrt_3.c +++ /dev/null @@ -1,723 +0,0 @@ -/* convrt_3.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__128 = 128; -static doublereal c_b26 = 1.; -static integer c__0 = 0; -static doublereal c_b28 = 0.; -static integer c_n1 = -1; - -/* $Procedure CONVRT_3 ( Convert Units ) */ -/* Subroutine */ int convrt_3__(doublereal *xin, char *unin, char *unout, - doublereal *xout, integer *status, ftnlen unin_len, ftnlen unout_len) -{ - /* Initialized data */ - - static doublereal dim[6] = { 0.,1.,1.,1.,1.,1. }; - static logical first = TRUE_; - static integer nop = 6; - static char op[2*6] = " " "( " ") " "* " "**" "/ "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - double pow_dd(doublereal *, doublereal *); - - /* Local variables */ - static doublereal diff; - extern /* Subroutine */ int scan_(char *, char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - ftnlen, ftnlen); - static doublereal keep; - static logical done, move; - static integer mult, b, e, i__, j, l, o, r__, blank; - static doublereal dimen[6]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer ident[128], class__; - static doublereal inval, value; - static integer oplen[6]; - static doublereal opval[6]; - static logical known; - static integer start, inout; - extern logical unitp_(char *, ftnlen); - static integer opptr[20]; - extern /* Subroutine */ int podbed_(doublereal *, integer *, integer *), - podbgd_(doublereal *), podegd_(doublereal *); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static doublereal dimeni[6]; - extern /* Subroutine */ int appndd_(doublereal *, doublereal *), podbgi_( - integer *), podegi_(integer *); - static doublereal dimeno[6]; - static integer active; - extern /* Subroutine */ int appndi_(integer *, integer *); - static doublereal parsed[134]; - static integer lparen; - extern /* Subroutine */ int fnducv_(char *, logical *, integer *, - doublereal *, ftnlen), scanpr_(integer *, char *, integer *, - integer *, ftnlen); - static integer rparen, classs[134]; - extern /* Subroutine */ int chkout_(char *, ftnlen), ssized_(integer *, - doublereal *), ssizei_(integer *, integer *); - static doublereal outval; - static integer ntokns; - static doublereal expont[134]; - extern logical return_(void); - static integer beg[128], end[128], div, exp__; - -/* $ Abstract */ - -/* Convert a quantity in one system of units to another system. */ - -/* $ 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 */ - -/* CONVERSION */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* XIN I A quantity measured in UNIN units. */ -/* UNIN I The units of the input quantity. */ -/* UNOUT I The units desired for output. */ -/* XOUT O The value of XIN in the UNOUT units. */ -/* STATUS O Indicates the success of the operation */ - -/* $ Detailed_Input */ - -/* XIN is the measurement of a physical quantity in the */ -/* units given by UNIN. */ - -/* UNIN are the units associated with the input quantity */ -/* XIN. These units should be expressed in terms */ -/* of units of angle, length, time, mass and charge */ -/* (no compound units such as newtons or joules.) */ - - -/* UNOUT are the units that will be associated with the */ -/* output quantity XOUT. UNOUT must be dimensionally */ -/* equivalent to UNIN and, like UNIN, must be expressed */ -/* in terms of units of angle, length, time, mass and */ -/* charge. */ - -/* $ Detailed_Output */ - -/* XOUT is the number of UNOUT units that are equal to */ -/* XIN units of UNIN. XOUT may overwrite XIN. */ - -/* STATUS if no problems are encountered in the attempt */ -/* to perform the translation of units STATUS will */ -/* be returned with the value 0. */ - -/* If the units input are not recognized STATUS */ -/* will be returned with the value 1. */ - -/* If the units for output are not recognized, STATUS */ -/* will be returned with the value 2. */ - -/* If units on input are not compatible with output, */ -/* STATUS will be returned with the value 3. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either UNIN or UNOUT is not a recognized physical unit, */ -/* the error 'SPICE(BADUNITS)' will be signaled. */ - -/* 2) If UNIN and UNOUT are not dimensionally equivalent, the */ -/* error 'SPICE(INCOMPATIBLEUNITS)' will be signaled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides a simple means of converting between */ -/* a quantity expressed in terms of one system of units to */ -/* another system of units. The fundamental units recognized */ -/* are those recognized by FNDUCV. The units recognized by */ -/* version 1.0.0 of FNDUCV are: */ - - - - -/* If the singular form a unit is not listed, but it is obtained */ -/* from the plural form by dropping a final 'S', you may use the */ -/* singular form. For example, */ - -/* instead of SECONDS you may use SECOND; */ -/* instead of MILES you may use MILE; */ -/* instead of DEGREES you may use DEGREE. */ - -/* Thus the strings 'SECONDS/DEGREE', 'SECOND/DEGREES', */ -/* 'SECOND/DEGREE', and 'SECONDS/DEGREES' are all recognized */ -/* and have have the same meaning. */ - -/* $ Examples */ - -/* Suppose you needed to convert a state, PV, from KM and KM/SEC to */ -/* AU and AU/365 days. The following loop will do the job. */ - -/* DO I = 1, 3 */ -/* CALL CONVRT_3 ( PV(I), 'KM', 'AU', PV(I) ) */ -/* CALL CONVRT_3 ( PV(I+3), 'KM/SEC', 'AU/(365*DAYS)' PV(I+3) ) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB 1.1.0, 28-MAY-2010 (EDW) */ - -/* Minor edit to eliminate unused variable NAME. */ - -/* - Beta Version 1.0.0, 31-MAY-1991 (WLT) */ - -/* -& */ - -/* These are the class id's for each of the various entities */ -/* that make up the variables of a unit. */ - - -/* These are the codes will will use for the various */ -/* operations. */ - - -/* Scanning Parameters */ - - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Here is the range of Character ASCII code */ -/* initial characters that --------- ---------- */ -/* will be used by the ' ' 32 */ -/* "known" marks. '(' 40 */ -/* ')' 41 */ -/* '*' 42 */ -/* '/' 47 */ - -/* So the required number of pointers is 47 - 32 + 5 = 20. */ - - -/* Saved Variables */ - - -/* Initial Values */ - - -/* The game is afoot! */ - - if (return_()) { - return 0; - } else { - chkin_("CONVRT_3", (ftnlen)8); - } - if (first) { - first = FALSE_; - scanpr_(&nop, op, oplen, opptr, (ftnlen)2); - blank = bsrchc_(" ", &nop, op, (ftnlen)1, (ftnlen)2); - lparen = bsrchc_("(", &nop, op, (ftnlen)1, (ftnlen)2); - rparen = bsrchc_(")", &nop, op, (ftnlen)1, (ftnlen)2); - mult = bsrchc_("*", &nop, op, (ftnlen)1, (ftnlen)2); - exp__ = bsrchc_("**", &nop, op, (ftnlen)2, (ftnlen)2); - div = bsrchc_("/", &nop, op, (ftnlen)1, (ftnlen)2); - opval[(i__1 = blank - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_3__", (ftnlen)338)] = 0.f; - opval[(i__1 = lparen - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_3__", (ftnlen)339)] = 0.f; - opval[(i__1 = rparen - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_3__", (ftnlen)340)] = 0.f; - opval[(i__1 = mult - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_3__", (ftnlen)341)] = 1.; - opval[(i__1 = exp__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", - i__1, "convrt_3__", (ftnlen)342)] = 3.; - opval[(i__1 = div - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("opval", i__1, - "convrt_3__", (ftnlen)343)] = 2.; - } - -/* First make sure that both UNIN and UNOUT are recognized */ -/* units. */ - - if (! unitp_(unin, unin_len)) { - *status = 1; - chkout_("CONVRT_3", (ftnlen)8); - return 0; - } - if (! unitp_(unout, unout_len)) { - *status = 2; - chkout_("CONVRT_3", (ftnlen)8); - return 0; - } - -/* We will need to keep track of the dimensions associated */ -/* with both input and output units. */ - - dimeni[1] = 0.; - dimeni[2] = 0.; - dimeni[3] = 0.; - dimeni[4] = 0.; - dimeni[5] = 0.; - dimeno[1] = 0.; - dimeno[2] = 0.; - dimeno[3] = 0.; - dimeno[4] = 0.; - dimeno[5] = 0.; - -/* We need to parse both the input and output units, we */ -/* do that in the loop that ranges from INPUT to OUTPUT. */ - - for (inout = 1; inout <= 2; ++inout) { - -/* Initialize the various pods we will need to use to */ -/* parse this set of units. */ - - ssized_(&c__128, parsed); - ssizei_(&c__128, classs); - ssized_(&c__128, expont); - -/* Zero out the dimension vector. */ - - dimen[1] = 0.; - dimen[2] = 0.; - dimen[3] = 0.; - dimen[4] = 0.; - dimen[5] = 0.; - -/* We haven't finished scanning this unit yet. */ - - done = FALSE_; - -/* We are beginning a group now. After beginning a group we */ -/* ALWAYS append 1,0,0 and MULTPLY, -1, 0 to the PARSED, */ -/* CLASSS, and EXPONT pod. Why ask why? Well in this case */ -/* we do it because it makes the processing MUCH simpler */ -/* (you'll see). */ - - appndd_(&c_b26, parsed); - appndi_(&c__0, classs); - appndd_(&c_b28, expont); - appndd_(&c_b26, parsed); - appndi_(&c_n1, classs); - appndd_(&c_b28, expont); - -/* We'll start scanning this string from the first character. */ - - start = 1; - if (inout == 1) { - scan_(unin, op, oplen, opptr, &c__128, &start, &ntokns, ident, - beg, end, unin_len, (ftnlen)2); - } else if (inout == 2) { - scan_(unout, op, oplen, opptr, &c__128, &start, &ntokns, ident, - beg, end, unout_len, (ftnlen)2); - } - -/* For as long as there are tokens to look at... */ - - while(ntokns > 0) { - -/* ... examine each in turn, classify it and take */ -/* an appropriate action. */ - - i__1 = ntokns; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* If we have a left parenthesis ... */ - - if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "convrt_3__", (ftnlen)463)] == lparen) - { - -/* We are beginning a group now. After beginning a */ -/* group we ALWAYS append 1,0,0 and MULTPLY, -1, 0 to */ -/* the PARSED, CLASSS, and EXPONT pod. */ - - podbgd_(parsed); - podbgi_(classs); - podbgd_(expont); - appndd_(&c_b26, parsed); - appndi_(&c__0, classs); - appndd_(&c_b28, expont); - appndd_(&c_b26, parsed); - appndi_(&c_n1, classs); - appndd_(&c_b28, expont); - -/* ... or if we have an arithmetic operations */ - - } else if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "convrt_3__", (ftnlen)485)] == - mult || ident[(i__3 = i__ - 1) < 128 && 0 <= i__3 ? - i__3 : s_rnge("ident", i__3, "convrt_3__", (ftnlen) - 485)] == div || ident[(i__4 = i__ - 1) < 128 && 0 <= - i__4 ? i__4 : s_rnge("ident", i__4, "convrt_3__", ( - ftnlen)485)] == exp__) { - -/* Append the operation to the current group. */ - - appndd_(&opval[(i__3 = ident[(i__2 = i__ - 1) < 128 && 0 - <= i__2 ? i__2 : s_rnge("ident", i__2, "convrt_3" - "__", (ftnlen)492)] - 1) < 6 && 0 <= i__3 ? i__3 : - s_rnge("opval", i__3, "convrt_3__", (ftnlen)492)], - parsed); - appndi_(&c_n1, classs); - appndd_(&c_b28, expont); - -/* ...or if we have a unit or number ... */ - - } else if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "convrt_3__", (ftnlen)499)] == - 0) { - -/* Look up the class and value for this token, */ -/* append them to the current group. */ - - b = beg[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("beg", i__2, "convrt_3__", (ftnlen)505)]; - e = end[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("end", i__2, "convrt_3__", (ftnlen)506)]; - if (inout == 1) { - fnducv_(unin + (b - 1), &known, &class__, &value, e - - (b - 1)); - } else if (inout == 2) { - fnducv_(unout + (b - 1), &known, &class__, &value, e - - (b - 1)); - } - appndd_(&value, parsed); - appndi_(&class__, classs); - appndd_(&dim[(i__2 = class__) < 6 && 0 <= i__2 ? i__2 : - s_rnge("dim", i__2, "convrt_3__", (ftnlen)520)], - expont); - -/* ...or if we have a right parenthesis, close off */ -/* this group by evaluating it, then close the group */ -/* and append the last value computed onto its list */ -/* of value/operation pairs. */ - - } else if (ident[(i__2 = i__ - 1) < 128 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "convrt_3__", (ftnlen)529)] == - rparen) { - -/* We are ending a group. It's time to perform all */ -/* indicated operations in this group. Note the */ -/* structure of a completed group is: */ - -/* Value OP Value OP Value ... OP Value */ - -/* Thus all operations are at even slots in the */ -/* group. The scheme for evaluating this expression */ -/* is: identify the next operation to perform (more on */ -/* how to locate the operation in a minute); */ - -/* Do this one */ -/* _____^______ */ -/* ' ` */ -/* Value OP Value OP Value OP Value OP Value OP ... */ - -/* replace the three entries by the result. */ - -/* Value OP Value OP result OP Value OP ... */ - -/* The hierarchy of operations is */ - -/* 1.) exponentiation in left to right order. */ - -/* 2.) multiplication and division in left */ -/* to right order. */ - -/* Since the parsing is from left to right, as we */ -/* simplify subexpression, we can shift items left */ -/* to fill in the gaps left by the operator and */ -/* second value of the expression that was simplified. */ - -/* To do all this we must fist identify the beginning */ -/* and ends of this group. */ - - podbed_(parsed, &b, &e); - -/* First handle exponentiation. So far we haven't */ -/* moved anything, the ACTIVE left operand is at B; */ -/* the first operator is located at B+1. We will let */ -/* ATOP (at operator) be the logical flag that indicates */ -/* whether J points to an operator or an operand. */ - - move = FALSE_; - active = b; - j = b + 1; - while(j <= e) { - if (parsed[(i__2 = j + 5) < 134 && 0 <= i__2 ? i__2 : - s_rnge("parsed", i__2, "convrt_3__", (ftnlen) - 582)] == 3.) { - -/* We are going to simplify an expression */ -/* of the form X ** Y to its computed value. */ -/* This means we will be freeing up room to */ -/* move items to the left. */ - - - move = TRUE_; - parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_3__" - , (ftnlen)593)] = pow_dd(&parsed[(i__3 = - active + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("parsed", i__3, "convrt_3__", ( - ftnlen)593)], &parsed[(i__4 = j + 6) < - 134 && 0 <= i__4 ? i__4 : s_rnge("parsed", - i__4, "convrt_3__", (ftnlen)593)]); - expont[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("expont", i__2, "convrt_3__" - , (ftnlen)594)] = expont[(i__3 = active + - 5) < 134 && 0 <= i__3 ? i__3 : s_rnge( - "expont", i__3, "convrt_3__", (ftnlen)594) - ] * parsed[(i__4 = j + 6) < 134 && 0 <= - i__4 ? i__4 : s_rnge("parsed", i__4, - "convrt_3__", (ftnlen)594)]; - } else { - -/* If we are moving operators and right */ -/* operands to the left, now is the time */ -/* to do it. */ - - if (move) { - o = active + 1; - l = active + 2; - r__ = j + 1; - parsed[(i__2 = o + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convr" - "t_3__", (ftnlen)610)] = parsed[(i__3 = - j + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("parsed", i__3, "convrt_3__", ( - ftnlen)610)]; - classs[(i__2 = o + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("classs", i__2, "convr" - "t_3__", (ftnlen)611)] = classs[(i__3 = - j + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("classs", i__3, "convrt_3__", ( - ftnlen)611)]; - expont[(i__2 = o + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("expont", i__2, "convr" - "t_3__", (ftnlen)612)] = expont[(i__3 = - j + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("expont", i__3, "convrt_3__", ( - ftnlen)612)]; - parsed[(i__2 = l + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convr" - "t_3__", (ftnlen)614)] = parsed[(i__3 = - r__ + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("parsed", i__3, "convrt_3__", ( - ftnlen)614)]; - classs[(i__2 = l + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("classs", i__2, "convr" - "t_3__", (ftnlen)615)] = classs[(i__3 = - r__ + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("classs", i__3, "convrt_3__", ( - ftnlen)615)]; - expont[(i__2 = l + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("expont", i__2, "convr" - "t_3__", (ftnlen)616)] = expont[(i__3 = - r__ + 5) < 134 && 0 <= i__3 ? i__3 : - s_rnge("expont", i__3, "convrt_3__", ( - ftnlen)616)]; - } - active += 2; - } - -/* Make J point to the next operator. */ - - j += 2; - } - -/* Next handle multiplication and division. */ - - e = active; - active = b; - j = b + 1; - while(j <= e) { - r__ = j + 1; - class__ = classs[(i__2 = r__ + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("classs", i__2, "convrt_3__", ( - ftnlen)641)]; - if (parsed[(i__2 = j + 5) < 134 && 0 <= i__2 ? i__2 : - s_rnge("parsed", i__2, "convrt_3__", (ftnlen) - 643)] == 1.) { - parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_3__" - , (ftnlen)645)] = parsed[(i__3 = active + - 5) < 134 && 0 <= i__3 ? i__3 : s_rnge( - "parsed", i__3, "convrt_3__", (ftnlen)645) - ] * parsed[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("parsed", i__4, - "convrt_3__", (ftnlen)645)]; - dimen[(i__2 = class__) < 6 && 0 <= i__2 ? i__2 : - s_rnge("dimen", i__2, "convrt_3__", ( - ftnlen)646)] = dimen[(i__3 = class__) < 6 - && 0 <= i__3 ? i__3 : s_rnge("dimen", - i__3, "convrt_3__", (ftnlen)646)] + - expont[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("expont", i__4, - "convrt_3__", (ftnlen)646)]; - } else if (parsed[(i__2 = j + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_3__", ( - ftnlen)648)] == 2.) { - parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_3__" - , (ftnlen)650)] = parsed[(i__3 = active + - 5) < 134 && 0 <= i__3 ? i__3 : s_rnge( - "parsed", i__3, "convrt_3__", (ftnlen)650) - ] / parsed[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("parsed", i__4, - "convrt_3__", (ftnlen)650)]; - dimen[(i__2 = class__) < 6 && 0 <= i__2 ? i__2 : - s_rnge("dimen", i__2, "convrt_3__", ( - ftnlen)651)] = dimen[(i__3 = class__) < 6 - && 0 <= i__3 ? i__3 : s_rnge("dimen", - i__3, "convrt_3__", (ftnlen)651)] - - expont[(i__4 = r__ + 5) < 134 && 0 <= - i__4 ? i__4 : s_rnge("expont", i__4, - "convrt_3__", (ftnlen)651)]; - } - j += 2; - } - -/* Finally, save the first value of the group, end the */ -/* group, and append the saved value to the previous */ -/* group. */ - - keep = parsed[(i__2 = active + 5) < 134 && 0 <= i__2 ? - i__2 : s_rnge("parsed", i__2, "convrt_3__", ( - ftnlen)664)]; - podegd_(parsed); - podegi_(classs); - podegd_(expont); - appndd_(&keep, parsed); - appndi_(&c__0, classs); - appndd_(&c_b28, expont); - } - } - -/* Just in case there are any left-overs, scan the */ -/* string for more tokens */ - - if (inout == 1) { - scan_(unin, op, oplen, opptr, &c__128, &start, &ntokns, ident, - beg, end, unin_len, (ftnlen)2); - } else if (inout == 2) { - scan_(unout, op, oplen, opptr, &c__128, &start, &ntokns, - ident, beg, end, unout_len, (ftnlen)2); - } - -/* If there are no more tokens left, we need to be sure */ -/* to close the last group (the one we opened before we */ -/* had even begun to scan UNIN or UNOUT. */ - - if (ntokns == 0 && ! done) { - done = TRUE_; - ntokns = 1; - ident[0] = rparen; - } - } - -/* Put the result of the parse into the input or output storage */ -/* area as appropriate. */ - - if (inout == 1) { - dimeni[1] = dimen[1]; - dimeni[2] = dimen[2]; - dimeni[3] = dimen[3]; - dimeni[4] = dimen[4]; - dimeni[5] = dimen[5]; - inval = parsed[6]; - } else if (inout == 2) { - dimeno[1] = dimen[1]; - dimeno[2] = dimen[2]; - dimeno[3] = dimen[3]; - dimeno[4] = dimen[4]; - dimeno[5] = dimen[5]; - outval = parsed[6]; - } - -/* Finally, if this is only the first of the units that needs to */ -/* be parsed, loop back through the code above a second time. */ - - } - -/* One final check must be performed. The input and output */ -/* units must be dimensionally equivalent. */ - - for (i__ = 1; i__ <= 5; ++i__) { - if (dimeni[(i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge("dimeni", - i__1, "convrt_3__", (ftnlen)754)] != dimeno[(i__2 = i__) < 6 - && 0 <= i__2 ? i__2 : s_rnge("dimeno", i__2, "convrt_3__", ( - ftnlen)754)]) { - diff = dimeni[(i__1 = i__) < 6 && 0 <= i__1 ? i__1 : s_rnge("dim" - "eni", i__1, "convrt_3__", (ftnlen)756)] - dimeno[(i__2 = - i__) < 6 && 0 <= i__2 ? i__2 : s_rnge("dimeno", i__2, - "convrt_3__", (ftnlen)756)]; - *status = 3; - chkout_("CONVRT_3", (ftnlen)8); - return 0; - } - } - -/* That was the last hurdle, now we can just compute the output. */ - - *xout = inval / outval * *xin; - *status = 0; - chkout_("CONVRT_3", (ftnlen)8); - return 0; -} /* convrt_3__ */ - diff --git a/ext/spice/src/csupport/convtb.c b/ext/spice/src/csupport/convtb.c deleted file mode 100644 index 65b3c556c8..0000000000 --- a/ext/spice/src/csupport/convtb.c +++ /dev/null @@ -1,727 +0,0 @@ -/* convtb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $ Procedure CONVTB ( Convert kernel file from text to binary ) */ -/* Subroutine */ int convtb_(char *txtfil, char *binfil, ftnlen txtfil_len, - ftnlen binfil_len) -{ - /* System generated locals */ - integer i__1; - cilist ci__1; - olist o__1; - cllist cl__1; - alist al__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rsfe(cilist *), do_fio( - integer *, char *, ftnlen), e_rsfe(void), f_clos(cllist *), - f_back(alist *), f_open(olist *), s_wsfe(cilist *), e_wsfe(void); - - /* Local variables */ - char arch[3], line[255], type__[4]; - extern /* Subroutine */ int daftb_(integer *, char *, ftnlen), spcac_( - integer *, integer *, char *, char *, ftnlen, ftnlen), chkin_( - char *, ftnlen), dastb_(integer *, char *, ftnlen), errch_(char *, - char *, ftnlen, ftnlen); - extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen); - extern /* Subroutine */ int daft2b_(integer *, char *, integer *, ftnlen); - extern logical failed_(void); - integer handle; - extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, - char *, ftnlen, ftnlen, ftnlen); - logical havcom; - extern /* Subroutine */ int dafopw_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), getlun_(integer *), - setmsg_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - integer scrlun; - extern logical return_(void); - integer txtlun; - extern /* Subroutine */ int txtopr_(char *, integer *, ftnlen); - logical eoc; - -/* $ Abstract */ - -/* Convert a SPICE text file into its equivalent binary format. */ - -/* NOTE: This routine is currently for use ONLY with the SPACIT */ -/* utility program. Use it at your own risk. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TXTFIL I Name of text file to be converted. */ -/* BINARY I Name of a binary file to be created. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* 1) This routine uses a Fortran scratch file to temporarily */ -/* store the lines of comments if there are any. */ - -/* $ Exceptions */ - -/* 1) If there is a problem opening or writing to the binary */ -/* file, a routine that CONVTB calls diagnoses and signals */ -/* an error. */ - -/* 2) If there is a problem reading from the text file, the */ -/* error SPICE(FILEREADFAILED) is signalled. */ - -/* 3) If there is a problem opening the scratch file, the error */ -/* SPICE(FILEOPENERROR) is signalled. */ - -/* 4) If there is a problem writing to the scratch file, the */ -/* error SPICE(FILEWRITEFAILED) is signalled. */ - -/* 5) If the binary file archictecture is not recognized, the error */ -/* SPICE(UNSUPPBINARYARCH) will be signalled. */ - -/* 7) If the transfer file format is not recognized, the error */ -/* SPICE(NOTATRANSFERFILE) will be signalled. */ - -/* 8) If the input file format cannot be identified, the error */ -/* SPICE(UNRECOGNIZABLEFILE) will be signalled.. */ - -/* $ Particulars */ - -/* This routine is currently only for use with the SPACIT program. */ - -/* $ Examples */ - - - -/* $ Restrictions */ - -/* 1) This routine assumes that the data and comments in the */ -/* text format SPK, PCK or CK file come from a binary file */ -/* and were written by one of the SPICELIB binary to text */ -/* conversion routines. Data and/or comments written any */ -/* other way may not be in the correct format and, therefore, */ -/* may not be handled properly. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 3.2.0, 12-AUG-1994 (KRG) */ - -/* Added a new exception SPICE(UNRECOGNIZABLEFILE). This occurs */ -/* when the file that is to be converted cannot be adequately */ -/* identified to give a meaningful error message or proceed with */ -/* the conversion. */ - -/* Fixed (I hope) a bug when dealing with LARGE binary files that */ -/* were accidentally passed to this reoutine as the text/transfer */ -/* file to be converted. The routine would hang in a formatted */ -/* READ while searching for the next "record" inthe binary file. */ -/* Not Good. */ - -/* - Beta Version 3.1.0, 12-AUG-1994 (KRG) */ - -/* Added a few more tests for incorrect files on input. */ - -/* Fixed a minor bug that would occur when formatting a long error */ -/* message. ERRFNM was called with a logical unit that had already */ -/* been closed. */ - -/* ERRFNM was also called with the logical unit of a SCRATCH file. */ -/* Fortran 77 does not allow names to be associated with SCRATCH */ -/* files, so this was removed. */ - -/* Replaced the exception SPICE(UNSUPPTEXTFORMAT) with the */ -/* exception: SPICE(NOTATRANSFERFILE). */ - -/* - Beta Version 3.0.0, 22-APR-1994 (KRG) */ - -/* Made updates to the routine to make use of the new SPICE */ -/* capability of determining binary kernel file types at run time. */ - -/* Removed the arguments for the file architecture and file type */ -/* from the calling list. This information was no longer */ -/* necessary. */ - -/* Rearranged some of the code to make it easier to understand. */ - -/* When checking for comments in a DAF text file the program now */ -/* backspaces if the forst record read after the data portion of */ -/* the file has been converted does not indicate the existence */ -/* of comments in the text file. This repositions the input */ -/* pointer so that the next read will return the record that we */ -/* read to test for the existence of comments. THIS ACTION IS */ -/* DIFFERENT FROM THE BEHAVIOR OF PREVIOUS VERSIONS OF THIS */ -/* ROUTINE WHICH DID NOT PERFORM THE BACKSPACE. See the comments */ -/* in the code near the end of this file for the details. */ - -/* - Beta Version 2.0.0, 28-JAN-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* convert text SPICE files to binary */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Begin and end markers in the file for the comment area. */ - - -/* Maximum length of an input text line. */ - - -/* Maximum length of a file architecture. */ - - -/* Maximum length of a file type. */ - - -/* Number of reserved records to use when creating a binar DAF file. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CONVTB", (ftnlen)6); - } - -/* Get the architecture and type of the file to be converted. */ - - getfat_(txtfil, arch, type__, txtfil_len, (ftnlen)3, (ftnlen)4); - if (failed_()) { - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* Verify the architecture and type of the file, and perform any */ -/* processing necessary.. */ - - if (s_cmp(arch, "XFR", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(arch, "DEC", ( - ftnlen)3, (ftnlen)3) == 0) { - -/* Open the text file that is to be converted to binary. */ - - txtopr_(txtfil, &txtlun, txtfil_len); - if (failed_()) { - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* Read the information line to skip it. We already know the */ -/* architecture and type of the file. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = txtlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - if (iostat != 0) { - -/* If there was an error then we need to close the text */ -/* file, and then check out and return to the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Error reading the text file: #. IOSTAT = #.", (ftnlen) - 44); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - } - -/* Process the file based on the derived architecture and type. */ - - if (s_cmp(arch, "XFR", (ftnlen)3, (ftnlen)3) == 0 && s_cmp(type__, "DAF", - (ftnlen)4, (ftnlen)3) == 0) { - -/* We got a DAF file. */ - -/* Convert the data portion of the text file to binary. At this */ -/* point, we know that we have a current DAF text file format. */ - -/* We expect to have comments. */ - - havcom = TRUE_; - -/* Convert it. */ - - daftb_(&txtlun, binfil, binfil_len); - if (failed_()) { - -/* If there was an error then we need to close the */ -/* text file, and then check out and return to the */ -/* caller. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - } else if (s_cmp(arch, "XFR", (ftnlen)3, (ftnlen)3) == 0 && s_cmp(type__, - "DAS", (ftnlen)4, (ftnlen)3) == 0) { - -/* We got a DAS file. So we should begin converting it to binary. */ -/* DAS files are easier: all we do is call one routine. */ - -/* We do not have comments. Actually, we might but they are */ -/* included as part of the DAS file conversion process. */ - - havcom = FALSE_; - -/* Convert it. */ - - dastb_(&txtlun, binfil, binfil_len); - if (failed_()) { - -/* If there was an error then we need to close the */ -/* text file, and then check out and return to the */ -/* caller. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - } else if (s_cmp(arch, "DAS", (ftnlen)3, (ftnlen)3) == 0) { - -/* This is an error case, most likely caused by reading a binary */ -/* DAS file by accident. So signal an appropriate error. */ - - setmsg_("The file '#' appears to be a binary DAS file and not a tran" - "sfer file.", (ftnlen)69); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - sigerr_("SPICE(NOTATRANSFERFILE)", (ftnlen)23); - chkout_("CONVTB", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DAS", (ftnlen)3, (ftnlen)3) == 0 && s_cmp(type__, - "PRE", (ftnlen)4, (ftnlen)3) == 0) { - -/* This is an error case, most likely caused by reading a binary */ -/* DAS file by accident. So signal an appropriate error. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("The file '#' appears to be a pre-release binary DAS file an" - "d not a transfer file.", (ftnlen)81); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - sigerr_("SPICE(NOTATRANSFERFILE)", (ftnlen)23); - chkout_("CONVTB", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DAF", (ftnlen)3, (ftnlen)3) == 0) { - -/* This is an error case, most likely caused by reading a binary */ -/* DAF file by accident. So signal an appropriate error. */ - - setmsg_("The file '#' appears to be a binary DAF file and not a tran" - "sfer file.", (ftnlen)69); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - sigerr_("SPICE(NOTATRANSFERFILE)", (ftnlen)23); - chkout_("CONVTB", (ftnlen)6); - return 0; - } else if (s_cmp(arch, "DEC", (ftnlen)3, (ftnlen)3) == 0 && s_cmp(type__, - "DAF", (ftnlen)4, (ftnlen)3) == 0) { - -/* This is the case for the old text file format. It has no */ -/* identifying marks whatsoever, so we simply have to try and */ -/* convert it. */ - -/* We expect to have comments. */ - - havcom = TRUE_; - -/* Back up one record so that we are positioned in the file where */ -/* we were when this routine was entered. */ - - al__1.aerr = 0; - al__1.aunit = txtlun; - f_back(&al__1); - -/* Convert it. */ - - daft2b_(&txtlun, binfil, &c__0, binfil_len); - if (failed_()) { - -/* If there was an error then we need to close the text */ -/* file, and then check out and return to the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - } else { - -/* This is the catch all error case. At this point, we didn't */ -/* match any of the files whose architecture and types are */ -/* recognized. So, we toss our hands in the air and signal an */ -/* error. */ - - setmsg_("The architecture and type of the file '#'could not be deter" - "mined.", (ftnlen)65); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - sigerr_("SPICE(UNRECOGNIZABLEFILE)", (ftnlen)25); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* If we have comments to process, then process them. */ - - if (havcom) { - -/* There are three situations that we need to consider here: */ - -/* 1) We have a SPICE text file with comments. This implies */ -/* that we have a bunch of comments to be put into the */ -/* comment area that are surrounded by the begin comments */ -/* marker, BCMARK, and the end comemnts marker, ECMARK. */ - -/* 2) We are at the end of the file. This means that we have */ -/* an old SPICE kernel file, from the good old days before */ -/* the comment area was implemented, or we ahve a plain old */ -/* ordinary DAF file. */ - -/* 3) We are not at the end of the file, but there are no */ -/* comments. This means that a text DAF file may be embedded */ -/* in a larger text file or something. PDS does things like */ -/* this: SFDUs and such. */ - -/* So, we need to look out for and deal with each of these */ -/* possibilities. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = txtlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - if (iostat > 0) { - -/* If there was an error then we need to close the text */ -/* file, and then check out and return to the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Error reading the text file: #. IOSTAT = #.", (ftnlen)43) - ; - errch_("#", txtfil, (ftnlen)1, txtfil_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* If we encountered the end of the file, just check out and */ -/* return. This is not an error. */ - - if (iostat < 0) { - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* We got a line, so left justify it and see if it matches the */ -/* begin comments marker. If not, then use the Fortran BACKSPACE */ -/* command to reposition the file pointer to be ready to read the */ -/* line we just read. */ - - i__1 = ltrim_(line, (ftnlen)255) - 1; - if (s_cmp(line + i__1, "~NAIF/SPC BEGIN COMMENTS~", 255 - i__1, ( - ftnlen)25) != 0) { - al__1.aerr = 0; - al__1.aunit = txtlun; - f_back(&al__1); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* We're not at the end of the file, and the line we read */ -/* is BCMARK, so we write the comments to a scratch file. */ -/* We do this because we have to use SPCAC to add the comments */ -/* to the comment area of the binary file, and SPCAC rewinds */ -/* the file. It's okay for SPCAC to rewind a scratch file, because */ -/* it will probably not be very big, but it's not okay to rewind */ -/* the file connected to TXTLUN -- we don't know the initial */ -/* location of the file pointer or how big the file is. */ - - getlun_(&scrlun); - o__1.oerr = 1; - o__1.ounit = scrlun; - o__1.ofnm = 0; - o__1.orl = 0; - o__1.osta = "SCRATCH"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = "FORMATTED"; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - -/* If there was an error then we need to close the text */ -/* file, and then check out and return to the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Error opening temporary file. IOSTAT = #.", (ftnlen)41); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENERROR)", (ftnlen)20); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* Continue reading lines from the text file and storing them */ -/* in the scratch file until we get to the end marker. We do not */ -/* write the begin and end markers to the scratch file. We do not */ -/* need them. */ - - eoc = FALSE_; - while(! eoc) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = txtlun; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, line, (ftnlen)255); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - if (iostat != 0) { - -/* If there was an error then we need to close the */ -/* scratch file, the text file, and then check out */ -/* and return to the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Error reading the text file: #. IOSTAT = #.", ( - ftnlen)43); - errch_("#", txtfil, (ftnlen)1, txtfil_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* If we are not at the end of the comments, then write the */ -/* line ot the scratch file. Otherwise set the end of comments */ -/* flag to .TRUE.. */ - - i__1 = ltrim_(line, (ftnlen)255) - 1; - if (s_cmp(line + i__1, "~NAIF/SPC END COMMENTS~", 255 - i__1, ( - ftnlen)23) != 0) { - ci__1.cierr = 1; - ci__1.ciunit = scrlun; - ci__1.cifmt = "(A)"; - iostat = s_wsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)255)); - if (iostat != 0) { - goto L100004; - } - iostat = e_wsfe(); -L100004: - if (iostat != 0) { - -/* If there was an error then we need to close the */ -/* scratch file, the text file, and then check out */ -/* and return to the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Error writing to temporary file. IOSTAT = #.", ( - ftnlen)44); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - } else { - eoc = TRUE_; - } - } - -/* Open the new binary file and add the comments that have been */ -/* stored temporarily in a scratch file. */ - - dafopw_(binfil, &handle, binfil_len); - if (failed_()) { - -/* If there was an error then we need to close the scratch */ -/* file and the text file, and then check out and return to */ -/* the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - spcac_(&handle, &scrlun, " ", " ", (ftnlen)1, (ftnlen)1); - if (failed_()) { - -/* If there was an error then we need to close the scratch */ -/* file and the text file, and then check out and return to */ -/* the caller. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - dafcls_(&handle); - chkout_("CONVTB", (ftnlen)6); - return 0; - } - -/* We succeeded, so close the files we opened to deal with the */ -/* comments. The scratch file is automatically deleted. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - dafcls_(&handle); - } - -/* Close the transfer file. We know it is open, because we got here. */ - - cl__1.cerr = 0; - cl__1.cunit = txtlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("CONVTB", (ftnlen)6); - return 0; -} /* convtb_ */ - diff --git a/ext/spice/src/csupport/cputim.c b/ext/spice/src/csupport/cputim.c deleted file mode 100644 index a5aca0aac5..0000000000 --- a/ext/spice/src/csupport/cputim.c +++ /dev/null @@ -1,279 +0,0 @@ -/* cputim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CPUTIM ( CPU Time ) */ -/* Subroutine */ int cputim_(doublereal *tvec) -{ - extern /* Subroutine */ int zzcputim_(doublereal *), chkin_(char *, - ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Fetch the current CPU date and time and store the result */ -/* as a double precision 6-vector. */ - -/* $ 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 */ - -/* TIME */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TVEC O contains year, month, day, hours, minutes, seconds */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* TVEC is a 6-vector containing the current system time. */ -/* The various components have the following meaning */ - -/* TVEC(1) --- current calendar year */ -/* TVEC(2) --- current month */ -/* TVEC(3) --- current day of month */ -/* TVEC(4) --- current hour. Hours have a range from */ -/* 0 to 23. 0 corresponds to system */ -/* midnight. */ -/* TVEC(5) --- current minutes */ -/* TVEC(6) --- current seconds and fraction of a */ -/* second (provided the system clock */ -/* has sufficiently fine granularity */ -/* to provide greater precision). */ - -/* The first 5 components will be double precision */ -/* integers. (They truncate without change.) */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the components of the current date and */ -/* time as determined by the system clock. */ - - -/* $ Examples */ - -/* Example 1. */ - -/* The following routine illustrates how you might use CPUTIM */ -/* to generate a "time stamp" that might be used to tag data */ -/* you plan to write to a file. */ - -/* SUBROUTINE TSTAMP ( STAMP ) */ - -/* CHARACTER*(15) STAMP */ - -/* DOUBLE PRECISION TVEC ( 6 ) */ - -/* C */ -/* C First fetch the current system time. */ -/* C */ -/* CALL CPUTIM ( TVEC ) */ - -/* C */ -/* C now form a time stamp of the form YYYYYMMDDhhmmss */ -/* C */ -/* CALL DPFMT ( TVEC(1), '0YYYY', STAMP(1:5) ) */ -/* CALL DPFMT ( TVEC(2), '0M', STAMP(6:7) ) */ -/* CALL DPFMT ( TVEC(3), '0D', STAMP(8:9) ) */ -/* CALL DPFMT ( TVEC(4), '0h', STAMP(10:11) ) */ -/* CALL DPFMT ( TVEC(5), '0m', STAMP(12:13) ) */ -/* CALL DPFMT ( TVEC(6), '0s', STAMP(14:15) ) */ - -/* RETURN */ - -/* Example 2. */ - -/* The following code illustrates how you might use this routine */ -/* to perform a crude estimate of the running time of the */ -/* SPICELIB routine VDOT. (This assumes that the program runs */ -/* during a single calendar day and that there is no competition */ -/* between users for system resources.) */ - -/* DOUBLE PRECISION VDOT */ - -/* DOUBLE PRECISION AVE */ -/* DOUBLE PRECISION SINCE0( 2 ) */ -/* DOUBLE PRECISION TVEC ( 6, 3 ) */ -/* DOUBLE PRECISION V1 ( 3 ) */ -/* DOUBLE PRECISION V2 ( 3 ) */ -/* DOUBLE PRECISION X */ - -/* INTEGER I */ -/* INTEGER TRIALS */ -/* PARAMETER ( TRIALS = 100000 ) */ - -/* C */ -/* C Give the vectors some values (these seem as good as */ -/* C anything else that comes to mind). */ -/* C */ -/* V1(1) = 1.0D0 */ -/* V1(2) = 2.0D0 */ -/* V1(3) = 3.0D0 */ - -/* V2(1) = 10.0D0 */ -/* V2(2) = 20.0D0 */ -/* V3(3) = 30.0D0 */ - -/* C */ -/* C Perform the loop twice, once with one call to VDOT, the */ -/* C second with two calls to VDOT. */ -/* C The first will require */ -/* C */ -/* C LOOP_OVERHEAD + TRIALS*TIME_FOR_VDOT */ -/* C */ -/* C The second will require */ -/* C */ -/* C LOOP_OVERHEAD + 2*TRIALS*TIME_FOR_VDOT */ -/* C */ -/* C The difference of the two, will give us */ -/* C */ -/* C TRIALS*TIME_FOR_VDOT */ -/* C */ - -/* C */ -/* C get the current system time. */ -/* C */ -/* CALL CPUTIM ( TVEC(1,1) ) */ - -/* DO I = 1, TRIALS */ -/* X = VDOT( V1, V2 ) */ -/* END DO */ - -/* C */ -/* C Get the time after the first pass. */ -/* C */ -/* CALL CPUTIM ( TVEC(1,2) */ - -/* DO I = 1, TRIALS */ -/* X = VDOT( V1, V2 ) */ -/* X = VDOT( V1, V2 ) */ -/* END DO */ - -/* C */ -/* C Get the time after the second pass. */ -/* C */ -/* CALL CPUTIM ( TVEC(1,3) */ - - -/* C */ -/* C Now compute seconds past midnight at each clock reading. */ -/* C */ -/* DO I = 1, 3 */ - -/* SINCE0(I) = TVEC(4,I) * 3600.0D0 */ -/* . + TVEC(5,I) * 60.0D0 */ -/* . + TVEC(6,I) */ -/* END DO */ - -/* C */ -/* C The time for the first pass is SINCE0(2) - SINCE0(1) */ -/* C The time for the second pass is SINCE0(3) - SINCE0(2) */ -/* C */ -/* C The difference between these divided by the number of */ -/* C trials is the average running time. */ -/* C */ -/* AVE = (SINCE0(3) - 2*SINCE0(2) - SINCE0(1)) / DBLE(TRIALS) */ - -/* WRITE (*,*) 'The average running time for VDOT is ', AVE */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 13-FEB-2008 (EDW) */ - -/* This routine calls the ZZCPUTIM routine in SPICELIB, */ -/* performing no other operation. */ - -/* -& */ -/* $ Index_Entries */ - -/* get system date and time */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("CPUTIM", (ftnlen)6); - } - -/* Get the date and time. */ - - zzcputim_(tvec); - -/* That's it. */ - - chkout_("CPUTIM", (ftnlen)6); - return 0; -} /* cputim_ */ - diff --git a/ext/spice/src/csupport/crtptr.c b/ext/spice/src/csupport/crtptr.c deleted file mode 100644 index aa11a89064..0000000000 --- a/ext/spice/src/csupport/crtptr.c +++ /dev/null @@ -1,211 +0,0 @@ -/* crtptr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1024 = 1024; -static integer c__5 = 5; - -/* $Procedure CRTPTR (Create pointer) */ -/* Character */ VOID crtptr_(char *ret_val, ftnlen ret_val_len, char *base, - integer *index, char *pnter, ftnlen base_len, ftnlen pnter_len) -{ - /* System generated locals */ - address a__1[5]; - integer i__1[5]; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - integer blen, clen, plen; - char cnum[10]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer total; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - char sym[1024]; - -/* $ Abstract */ - -/* Returns the symbol 'BASE~INDEX~PNTER'. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BASE, */ -/* INDEX, */ -/* PNTER I Components of the symbol 'BASE~INDEX~PNTER'. */ - -/* SYMLEN P Maximum length of the symbol. */ - -/* $ Detailed_Input */ - -/* BASE, */ -/* INDEX, */ -/* PNTER are components of the symbol 'BASE~INDEX~PNTER'. */ - -/* $ Detailed_Output */ - -/* CRTPTR is the symbol 'BASE~INDEX~PNTER'. */ - -/* $ Parameters */ - -/* SYMLEN is the maximum length of the symbol 'BASE~INDEX~PNTER'. */ - -/* $ Exceptions */ - -/* 1) If the length of the symbol 'BASE~INDEX~PNTER' exceeds SYMLEN, */ -/* the error SPICE(BUFFERTOOSMALL) is signalled. */ - -/* 2) If the length of the symbol 'BASE~INDEX~PNTER' exceeds */ -/* LEN(CRTPTR), the error SPICE(DIMENSIONTOOSMALL) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine creates a symbol that may be used to look up */ -/* nodes in the symbol table created by CPARSE. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* M.J. Spencer (JPL) */ - -/* $ Version */ - -/* - Version 1.1.1, 13-JAN-2007, (EDW) */ - -/* Corrected typo in the previous version string; */ -/* from: */ - -/* 09-DEC-203 */ - -/* to */ - -/* 09-DEC-2003 */ - -/* - Version 1.1.0, 09-DEC-2003, (EDW) */ - -/* Set the SYMLEN value to 1024 to match the same */ -/* value in niospk. */ - -/* - Beta Version 1.0.0, 11-AUG-1992 (MJS) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* This routine will use discovery check-in. */ - - if (return_()) { - return ; - } - -/* Compute the lengths of the strings involved. */ - - intstr_(index, cnum, (ftnlen)10); - clen = rtrim_(cnum, (ftnlen)10); - blen = rtrim_(base, base_len); - plen = rtrim_(pnter, pnter_len); - total = clen + blen + plen + 2; - -/* TOTAL must be SYMLEN characters, or fewer. */ - - if (total > 1024) { - chkin_("CRTPTR", (ftnlen)6); - setmsg_("Symbol exceeds # characters. Increase the value of SYMLEN.", - (ftnlen)58); - errint_("#", &c__1024, (ftnlen)1); - sigerr_("SPICE(BUFFERTOOSMALL)", (ftnlen)21); - chkout_("CRTPTR", (ftnlen)6); - return ; - } - -/* And TOTAL must be LEN(CRTPTR) characters, or fewer. */ - - if (total > i_len(ret_val, ret_val_len)) { - chkin_("CRTPTR", (ftnlen)6); - setmsg_("Symbol exceeds the dimension of CRTPTR.", (ftnlen)39); - sigerr_("SPICE(DIMENSIONTOOSMALL)", (ftnlen)24); - chkout_("CRTPTR", (ftnlen)6); - return ; - } - -/* Form the symbol 'BASE~INDEX~PNTER'. */ - - s_copy(sym, " ", (ftnlen)1024, (ftnlen)1); -/* Writing concatenation */ - i__1[0] = blen, a__1[0] = base; - i__1[1] = 1, a__1[1] = "~"; - i__1[2] = clen, a__1[2] = cnum; - i__1[3] = 1, a__1[3] = "~"; - i__1[4] = plen, a__1[4] = pnter; - s_cat(sym, a__1, i__1, &c__5, (ftnlen)1024); - s_copy(ret_val, sym, ret_val_len, (ftnlen)1024); - return ; -} /* crtptr_ */ - diff --git a/ext/spice/src/csupport/curtim.c b/ext/spice/src/csupport/curtim.c deleted file mode 100644 index f2bdbb4a4b..0000000000 --- a/ext/spice/src/csupport/curtim.c +++ /dev/null @@ -1,190 +0,0 @@ -/* curtim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__11 = 11; - -/* $Procedure CURTIM (Current Time) */ -/* Subroutine */ int curtim_(char *time, ftnlen time_len) -{ - /* Initialized data */ - - static char month[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" "AUG" - "SEP" "OCT" "NOV" "DEC"; - - /* System generated locals */ - address a__1[11]; - integer i__1, i__2, i__3[11]; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - static integer ivec[6]; - static char year[4]; - static doublereal tvec[6]; - static char hour[2]; - extern /* Subroutine */ int zzcputim_(doublereal *); - static integer i__; - extern /* Subroutine */ int rjust_(char *, char *, ftnlen, ftnlen), - replch_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen), intstr_(integer *, char *, ftnlen); - static char sec[2], day[2], min__[2]; - -/* $ Abstract */ - -/* Return a string giving the current date and time */ - -/* $ 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 */ - -/* TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TIME O A string containing the current date and time. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* TIME is a string that contains the current date and */ -/* time in the format YEAR-MON-DY HR:MN:SC */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a utility for creating time-stamps for inserting */ -/* into data products. It is not intended to provide accurate */ -/* measurment of local time since local time is not necessarily */ -/* in step with the processor clock. If you need the numeric */ -/* components, see the routine ZZCPUTIM. */ - - -/* $ Examples */ - -/* Suppose that you wish to insert into a data product the */ -/* system time at the time of creation of the product. You */ -/* could call this routine to get the current time (in a string) */ -/* and then simply write that string into the data product. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SUPPORT Version 1.1.0, 11-SEP-2007 (EDW) */ - -/* Replaced CPUTIM call with ZZCPUTIM call. Edited previous */ -/* Version entries to clarify CURTIM pedigree. */ - -/* - SUPPORT Version 1.0.1, 03-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - SUPPORT Version 1.0.0, 20-APR-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Get a string giving the current system time */ - -/* -& */ - zzcputim_(tvec); - for (i__ = 1; i__ <= 6; ++i__) { - ivec[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("ivec", i__1, - "curtim_", (ftnlen)146)] = (integer) tvec[(i__2 = i__ - 1) < - 6 && 0 <= i__2 ? i__2 : s_rnge("tvec", i__2, "curtim_", ( - ftnlen)146)]; - } - intstr_(ivec, year, (ftnlen)4); - intstr_(&ivec[2], day, (ftnlen)2); - intstr_(&ivec[3], hour, (ftnlen)2); - intstr_(&ivec[4], min__, (ftnlen)2); - intstr_(&ivec[5], sec, (ftnlen)2); - rjust_(day, day, (ftnlen)2, (ftnlen)2); - rjust_(hour, hour, (ftnlen)2, (ftnlen)2); - rjust_(min__, min__, (ftnlen)2, (ftnlen)2); - rjust_(sec, sec, (ftnlen)2, (ftnlen)2); - replch_(day, " ", "0", day, (ftnlen)2, (ftnlen)1, (ftnlen)1, (ftnlen)2); - replch_(hour, " ", "0", hour, (ftnlen)2, (ftnlen)1, (ftnlen)1, (ftnlen)2); - replch_(min__, " ", "0", min__, (ftnlen)2, (ftnlen)1, (ftnlen)1, (ftnlen) - 2); - replch_(sec, " ", "0", sec, (ftnlen)2, (ftnlen)1, (ftnlen)1, (ftnlen)2); -/* Writing concatenation */ - i__3[0] = 4, a__1[0] = year; - i__3[1] = 1, a__1[1] = "-"; - i__3[2] = 3, a__1[2] = month + ((i__1 = ivec[1] - 1) < 12 && 0 <= i__1 ? - i__1 : s_rnge("month", i__1, "curtim_", (ftnlen)165)) * 3; - i__3[3] = 1, a__1[3] = "-"; - i__3[4] = 2, a__1[4] = day; - i__3[5] = 1, a__1[5] = " "; - i__3[6] = 2, a__1[6] = hour; - i__3[7] = 1, a__1[7] = ":"; - i__3[8] = 2, a__1[8] = min__; - i__3[9] = 1, a__1[9] = ":"; - i__3[10] = 2, a__1[10] = sec; - s_cat(time, a__1, i__3, &c__11, time_len); - return 0; -} /* curtim_ */ - diff --git a/ext/spice/src/csupport/cutstr.c b/ext/spice/src/csupport/cutstr.c deleted file mode 100644 index 93be2678c1..0000000000 --- a/ext/spice/src/csupport/cutstr.c +++ /dev/null @@ -1,491 +0,0 @@ -/* cutstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure CUTSTR ( Cut a long string into substrings ) */ -/* Subroutine */ int cutstr_(char *string, integer *start, integer *width, - char *breaks, integer *beg, integer *end, ftnlen string_len, ftnlen - breaks_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer here; - extern logical even_(integer *); - integer long__, pass; - char this__[1], next[1]; - integer a, b, p, blank; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer there; - char other[15], dtype[15], punct[15], quote[15], otype[15], ptype[15], - qtype[15]; - integer length; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer occurs_(char *, char *, ftnlen, ftnlen); - extern logical return_(void); - char def[15]; - -/* $ Abstract */ - -/* Cut a long string into substrings, breaking at "good" points */ -/* whenever possible. */ - -/* $ 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 */ - -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Long string. */ -/* START I Nominal beginning of substring. */ -/* WIDTH I Maximum width of substrings. */ -/* BREAKS I Characters indicating good break points. */ -/* BEG I Beginning of substring. */ -/* END O End of substring. */ - -/* $ Detailed_Input */ - -/* STRING is an arbitrary character string. Typically, this */ -/* is too wide to fit into an area of limited width: */ -/* an element of a character array, for instance, or */ -/* an area on a terminal screen. */ - -/* START is the nominal beginning of the next substring. */ -/* (STRING(START:START) is the first character that */ -/* can appear in the substring.) It is used to skip */ -/* past substrings returned by previous calls. */ - -/* WIDTH is the width (in characters) of the limited area. */ -/* Thus, it is the maximum width of the substrings */ -/* to be returned. */ - -/* BREAKS is a collection of characters indicating preferred */ -/* places to break the string into substrings: commas, */ -/* colons, and periods, for instance. BREAKS is always */ -/* treated as though it contains a space, whether it */ -/* does or not. (That is, '+-=' is treated as ' +-='.) */ - -/* $ Detailed_Output */ - -/* BEG, */ -/* END are the endpoints of a substring no wider than */ -/* WIDTH. Substrings always begin and end with non-blank */ -/* characters. BEG is zero if no non-blank substring */ -/* was found. */ - -/* $ Exceptions. */ - -/* 1) If STRING(START:) is blank or BEG is greater than the declared */ -/* length of STRING, both BEG and END are zero. */ - -/* 2) If START is less than one, the error 'SPICE(BEFOREBEGSTR)' */ -/* is signalled. */ - -/* 4) If WIDTH is less than one, the error 'SPICE(WIDTHTOOSMALL)' */ -/* is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is useful primarily for displaying messages on */ -/* terminal screens or within log files. Since messages can run */ -/* to hundreds of characters, while most output devices cannot */ -/* handle more than 80 or 132 characters at a time, it is necessary */ -/* to break the strings. The friendliness of a message is enhanced */ -/* if these breaks occur at "natural" places within the message, */ -/* rather than at rigid intervals. */ - -/* The most natural breaks occur before spaces. Slightly less */ -/* natural breaks occur at the characters */ - -/* Comma , */ -/* Period . */ -/* Semicolon ; */ -/* Colon : */ -/* Question ? */ -/* Exclamation ! */ -/* End parenthesis ) */ -/* End bracket ] */ -/* End brace } */ -/* End angle > */ - -/* or before the characters */ - -/* Begin parenthesis ( */ -/* Begin bracket [ */ -/* Begin brace { */ -/* Begin angle < */ - -/* At any rate, breaks should occur between adjacent letters or */ -/* numeric characters only as a last resort. */ - -/* In the absence of other instructions, CUTSTR tries to break: */ - -/* 1) before space */ - -/* 2) at , . ; : - ) ] } > */ -/* or before ( [ { < */ - -/* 3) at ' " (even occurrence) */ -/* or before ' " (odd occurrence) */ - -/* 4) at ? ! = _ % */ -/* or before \ ~ $ @ ^ * / | & + */ - -/* before forcing a break at an aribitrary location. */ - -/* You may override these rules by supplying a set of preferred */ -/* characters in BREAKS. Before applying the rules shown above, */ -/* CUTSTR will try to break AT these characters. (However, breaks */ -/* always occur BEFORE spaces.) */ - -/* $ Examples */ - -/* CUTSTR might typically be used to display a long diagnostic */ -/* messages on a terminal screen. For example, suppose that the */ -/* following message has been returned by a subroutine. */ - -/* 'I believe you have made an significant error by requesting */ -/* that I send to the printer a file containing 250 megabytes */ -/* of text information. The system manager is likely to be */ -/* very unhappy with such a request. I suggest you reconsider */ -/* your intended action.' */ - -/* and that this needs to be displayed on a 40-character monitor. */ -/* The following code fragment */ - -/* WIDTH = 40 */ -/* BREAKS = ' ,.' */ - -/* CALL CUTSTR ( MSSG, 1, WIDTH, BREAKS, BEG, END ) */ - -/* DO WHILE ( BEG .NE. 0 ) */ -/* WRITE (6,*) MSSG (BEG:END) */ - -/* START = END + 1 */ -/* CALL CUTSTR ( MSSG, START, WIDTH, BREAKS, BEG, END ) */ -/* END DO */ - -/* would display something like */ - -/* I believe you have made an significant */ -/* error by requesting that I send to the */ -/* printer a file containing 250 megabytes */ -/* of text information. The system manager */ -/* is likely to be very unhappy with such a */ -/* request. I suggest you reconsider your */ -/* intended action. */ - -/* On a more whimsical note, you could indent each successive lines */ -/* by three characters: the code fragment */ - -/* WIDTH = 40 */ -/* BREAKS = ' ,.' */ -/* INDENT = 1 */ - -/* CALL CUTSTR ( MSSG, 1, WIDTH, BREAKS, BEG, END ) */ - -/* DO WHILE ( BEG .NE. 0 ) */ -/* TEMP = ' ' */ -/* TEMP(INDENT: ) = MSSG(BEG:END) */ -/* WRITE (6,*) TEMP */ - -/* INDENT = INDENT + 3 */ -/* WIDTH = MAX ( WIDTH-3, 9 ) */ - -/* START = END + 1 */ -/* CALL CUTSTR ( MSSG, START, WIDTH, BREAKS, BEG, END ) */ -/* END DO */ - -/* would display something like */ - -/* I believe you have made an significant */ -/* error by requesting that I send to */ -/* the printer a file containing 250 */ -/* megabytes of text information. */ -/* The system manager is likely */ -/* to be very unhappy with */ -/* such a request. I */ -/* suggest you */ -/* reconsider your */ -/* intended */ -/* action. */ - -/* Note that both loops terminate when BEG is zero. This indicates */ -/* that no substring was found (and that none will be returned by */ -/* subsequent calls). If the string is full, the loop will terminate */ -/* normally when START becomes greater than the length of the string. */ - -/* $ 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, 29-APR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Parameters used to simulate an enumerated type for */ -/* the various passes required to break the string at */ -/* good places. Note that the order is important. */ -/* This forces the routine to try spaces first, user */ -/* supplied preferences next, etc. It is also */ -/* critical that these be defined to be a sequence */ -/* of consecutive integers. */ - - -/* The ASCII character value for the backslash is needed for */ -/* uniformity of porting this routine (Some platforms treat the */ -/* backslah as a special character and so we can't just use */ -/* the character in strings.) */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } - -/* Exceptions first. Is START outside the bounds of the string? */ - - length = i_len(string, string_len); - if (*start > length) { - *beg = 0; - *end = 0; - return 0; - } else if (*start < 1) { - chkin_("CUTSTR", (ftnlen)6); - sigerr_("SPICE(BEFOREBEGSTR)", (ftnlen)19); - chkout_("CUTSTR", (ftnlen)6); - return 0; - } - -/* Is the width reasonable? */ - - if (*width < 1) { - chkin_("CUTSTR", (ftnlen)6); - sigerr_("SPICE(WIDTHTOOSMALL)", (ftnlen)20); - chkout_("CUTSTR", (ftnlen)6); - return 0; - } - -/* Does the remainder of the string contain anything besides blanks? */ - - if (s_cmp(string + (*start - 1), " ", string_len - (*start - 1), (ftnlen) - 1) == 0) { - *beg = 0; - *end = 0; - return 0; - } - -/* Obviously, we should try to get the longest possible substring. */ - - - *beg = *start; - blank = ' '; - while(*(unsigned char *)&string[*beg - 1] == blank) { - ++(*beg); - } - long__ = *beg + *width - 1; - -/* The remainder of the substring may fit without a trim. */ -/* But drop trailing blanks anyway. */ - - if (length <= long__) { - *end = length; - while(*(unsigned char *)&string[*end - 1] == blank) { - --(*end); - } - return 0; - } - -/* Assign the default break characters. Each character in PUNCT, */ -/* QUOTE, or OTHER indicates a good place to break. The associated */ -/* type indicates whether the break should occur at or before the */ -/* the character: */ - -/* Type Break occurs */ -/* ---- ------------------------------------------------ */ -/* A At the character. */ -/* B Before the character. */ -/* P At an EVEN occurrence, or */ -/* Before an ODD occurrence. */ - - - s_copy(punct, ",.;:-)]}>([{<", (ftnlen)15, (ftnlen)13); - s_copy(ptype, "AAAAAAAAABBBB", (ftnlen)15, (ftnlen)13); - s_copy(quote, "\"'", (ftnlen)15, (ftnlen)2); - s_copy(qtype, "PP", (ftnlen)15, (ftnlen)2); - s_copy(other, "?!~$@^=_%*/|&+\\", (ftnlen)15, (ftnlen)15); - s_copy(otype, "AABBBBAAABBBBBB", (ftnlen)15, (ftnlen)15); - -/* We will do this in five passes. During the first pass, we will */ -/* try to break before a space. During the second pass, we will try */ -/* to break at one of the preferred characters. During the third, */ -/* fourth, and fifth passes, we will try to break at or before one */ -/* of the quotation, punctuation, or other default characters. */ - - pass = 1; - a = 'A'; - p = 'P'; - b = 'B'; - while(pass != 6) { - *end = long__; - while(*end >= *beg) { - *(unsigned char *)this__ = *(unsigned char *)&string[*end - 1]; - i__1 = *end; - s_copy(next, string + i__1, (ftnlen)1, *end + 1 - i__1); - -/* Always break BEFORE a space. */ - - if (pass == 1) { - if (*(unsigned char *)next == blank) { - pass = 7; - } - -/* Always break AT a preferred character. */ - - } else if (pass == 2) { - if (i_indx(breaks, this__, breaks_len, (ftnlen)1) > 0) { - pass = 7; - } - -/* But with default characters, some break at, some */ -/* before, and some depend on the parity of strangers. */ - - } else { - here = i_indx(def, this__, (ftnlen)15, (ftnlen)1); - there = i_indx(def, next, (ftnlen)15, (ftnlen)1); - if (here > 0) { - if (*(unsigned char *)&dtype[here - 1] == a) { - pass = 7; - } else if (*(unsigned char *)&dtype[here - 1] == p) { - i__1 = occurs_(string, this__, (*end), (ftnlen)1); - if (even_(&i__1)) { - pass = 7; - } - } - } - if (there > 0 && pass != 7) { - if (*(unsigned char *)&dtype[there - 1] == b) { - pass = 7; - } else if (*(unsigned char *)&dtype[there - 1] == p) { - i__1 = occurs_(string, next, (*end), (ftnlen)1); - if (even_(&i__1)) { - pass = 7; - } - } - } - } - -/* If we've found a break point, remove any trailing blanks */ -/* before returning. */ - - if (pass == 7) { - while(*(unsigned char *)&string[*end - 1] == blank) { - --(*end); - } - return 0; - } else { - --(*end); - } - } - -/* We may have to try another pass. */ - - ++pass; - -/* In the final passes, only the character set changes. */ - - if (pass == 3) { - s_copy(def, punct, (ftnlen)15, (ftnlen)15); - s_copy(dtype, ptype, (ftnlen)15, (ftnlen)15); - } else if (pass == 4) { - s_copy(def, quote, (ftnlen)15, (ftnlen)15); - s_copy(dtype, qtype, (ftnlen)15, (ftnlen)15); - } else if (pass == 5) { - s_copy(def, other, (ftnlen)15, (ftnlen)15); - s_copy(dtype, otype, (ftnlen)15, (ftnlen)15); - } - } - -/* Looks like we'll have to do this the hard way. */ - - *end = long__; - return 0; -} /* cutstr_ */ - diff --git a/ext/spice/src/csupport/dafacu.c b/ext/spice/src/csupport/dafacu.c deleted file mode 100644 index 1e434be391..0000000000 --- a/ext/spice/src/csupport/dafacu.c +++ /dev/null @@ -1,860 +0,0 @@ -/* dafacu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2000 = 2000; -static integer c__1 = 1; - -/* $Procedure DAFACU ( DAF add comments from a logical unit ) */ -/* Subroutine */ int dafacu_(integer *comlun, char *begmrk, char *endmrk, - logical *insbln, integer *handle, ftnlen begmrk_len, ftnlen - endmrk_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - olist o__1; - cllist cl__1; - alist al__1; - inlist ioin__1; - - /* Builtin functions */ - integer f_inqu(inlist *), f_open(olist *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *), s_rnge( - char *, integer, char *, integer), f_rew(alist *); - - /* Local variables */ - integer free; - char line[1000]; - logical more; - extern /* Subroutine */ int dafac_(integer *, integer *, char *, ftnlen); - integer i__, j; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer bward, fward; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); - integer ncomr; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer nd; - extern logical failed_(void); - integer ni; - extern /* Subroutine */ int readla_(integer *, integer *, integer *, char - *, logical *, ftnlen), dafsih_(integer *, char *, ftnlen); - char ifname[60]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen), readln_(integer *, - char *, logical *, ftnlen); - logical opened; - static char combuf[1000*2000]; - extern integer lastnb_(char *, ftnlen); - integer length, intchr; - extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen); - integer numcom; - extern /* Subroutine */ int chkout_(char *, ftnlen), getlun_(integer *); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer scrlun; - extern /* Subroutine */ int writla_(integer *, char *, integer *, ftnlen); - extern logical return_(void); - logical eof; - -/* $ Abstract */ - -/* Add comments to an open binary DAF from an opened text file */ -/* attached to a Fortran logical unit. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* COMLUN I Logical unit of the open comment text file. */ -/* BEGMRK I The begin comments marker to be used. */ -/* ENDMRK I The end comments marker to be used. */ -/* INSBLN I A flag indicating whether to insert a blank line. */ -/* HANDLE I Handle of a DAF opened with write access. */ - -/* $ Detailed_Input */ - -/* COMLUN The Fortran logical unit of a previously opened text */ -/* file which contains comments that are to be added to */ -/* the comment area of a binary DAF. */ - -/* BEGMRK A marker which identifies the beginning of the comments */ -/* in the comment text file. This marker must appear on a */ -/* line by itself and leading and trailing blanks are not */ -/* significant. The marker is case sensitive. */ - -/* The line immediately following this marker is the first */ -/* comment line to be placed into the comment area of the */ -/* binary DAF. */ - -/* If the begin marker is blank, BEGMRK .EQ. ' ', then the */ -/* comments are assumed to start at the current location */ -/* in the comment text file. */ - -/* ENDMRK A marker which identifies the end of the comments in the */ -/* comment text file. This marker must appear on a line by */ -/* itself and leading and trailing blanks are not */ -/* significant. The marker is case sensitive. */ - -/* The line immediately preceeding this marker is the last */ -/* comment line to be placed into the comment area of the */ -/* binary DAF file. */ - -/* If the end marker is blank, ENDMRK .EQ. ' ', then the */ -/* comments are assumed to stop at the end of the comment */ -/* text file. */ - -/* INSBLN A logical flag which indicates whether a blank line is */ -/* to be inserted into the comment area of the binary DAF */ -/* attached to HANDLE before any comments are added to the */ -/* comment area of the file. This is to provide a simple */ -/* mechanism for separating any comments already contained */ -/* in the comment area of a DAF from those comments that */ -/* are being added. */ - -/* If the comment area of a binary DAF is empty, the value */ -/* of this flag is not significant, the comments are simply */ -/* be placed into the comment area. */ - -/* HANDLE The file handle for a binary DAF file that has been */ -/* opened with write access. The comments from the text */ -/* file are placed into the comment area of this file. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input logical unit COMLUN is not positive or there */ -/* is not an opened file attached to it, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If the INQUIRE on the logical unit to see if there is a */ -/* file attached fails, the error SPICE(INQUIREFAILED) will */ -/* be signalled. */ - -/* 3) If the scratch file for temporarily holding the comments */ -/* culled from the text file cannot be opened, then the */ -/* error SPICE(FILEOPENFAILED) will be signalled. */ - -/* 4) If a nonprinting ASCII character is encountered in the */ -/* comments, the error SPICE(ILLEGALCHARACTER) will be */ -/* signalled. */ - -/* 5) If the begin marker cannot be found in the text file, the */ -/* error SPICE(MARKERNOTFOUND) will be signalled. */ - -/* 6) If the end marker cannot be found in the text file, the */ -/* error SPICE(MARKERNOTFOUND) will be signalled. */ - -/* $ Files */ - -/* 1) See parameters COMLUN and HANDLE in the $ Detailed_Inputs */ -/* section. */ - -/* 2) A scratch file is used to temporarily hold the comments */ -/* culled from the comment text file. This is so we do not */ -/* have to find the place where we started searching for */ -/* comments in the text file. */ - -/* $ Particulars */ - -/* This routine will place all lines between two specified markers, */ -/* a `begin comments marker' and an `end comments marker,' in a */ -/* text file into the comment area of a binary DAF attached to */ -/* HANDLE. If the `begin comments marker' is blank, then the */ -/* comments are asumed to start at the current location in the */ -/* comment text file attached to COMLUN. If the `end comments */ -/* marker' is blank, then the comments are assumed to stop at the */ -/* end of the comment text file attached to COMLUN. */ - -/* $ Examples */ - -/* We will be using the files `jabber.txt', 'batty.txt', and */ -/* `wndrland.daf' in the examples which follow. */ - -/* `wndrland.daf' is a binary DAF file with an empty comment area */ -/* into which we are going to place the entire file */ -/* `jabber.txt' and a selected portion of the file */ -/* `batty.txt'. */ - -/* `jabber.txt' is a text file that is to be placed into the */ -/* comment area of the binary DAF file `wndrland.daf'. */ - -/* `batty.txt' is a text file from which will have a selected */ -/* portion of its text placed into the comment area */ -/* of the binary DAF file `wndrland.daf'. */ - -/* Let -BOF- and -EOF- denote the beginning and end of a file, */ -/* respectively. */ - -/* The file `jabber.txt' contains: */ - -/* -BOF- */ -/* The Jabberwock */ - -/* 'Twas brillig, and the slithy toves */ -/* Did gyre and gimble in the wabe; */ -/* All mimsy were the borogoves, */ -/* And the mome raths outgrabe. */ - -/* ``Beware the Jabberwock, my son! */ -/* The jaws that bite, the claws that catch!'' */ - -/* And as in uffish thought he stood, */ -/* The Jabberwock, with eyes of flame, */ -/* Came whiffling through the tulgey wood, */ -/* And burbled as it came! */ - -/* One, two! One, two! And through and through */ -/* The vorpal blade went snicker-snack! */ -/* He left it dead, and with its head */ -/* He went galumphing back. */ - -/* ``And hast thou slain the Jabberwock? */ -/* Come to my arms, my beamish boy! */ -/* O frabjous day! Callooh! Callay!'' */ -/* He chortled in his joy. */ - -/* Through the Looking-Glass */ -/* Lewis Carroll */ -/* -EOF- */ - -/* The file `batty.txt' contains: */ - -/* -BOF- */ -/* This file contains a brief poem about bats. */ - -/* BEGIN bat poem */ -/* Twinkle, twinkle, little bat! */ -/* How I wonder what you're at! */ -/* Up above the world you fly! */ -/* Like a teatray in the sky. */ - -/* Alice's Adventures in Wonderland */ -/* Lewis Carroll */ -/* END bat poem */ - -/* And that's that for bats. */ -/* -EOF- */ - -/* Let */ - -/* JABLUN be the logical unit for the file `jabber.txt' */ -/* BATLUN be the logical unit for the file `batty.txt' */ -/* and */ -/* HANDLE be the DAF handle for the file `wndrland.daf' */ - -/* The code fragment */ - -/* C */ -/* C Open the files. */ -/* C */ -/* CALL DAFOPW ( `wndrland.daf', HANDLE ) */ -/* CALL TXTOPR ( `jabber.txt' , JABLUN ) */ -/* CALL TXTOPR ( `batty.txt' , BATLUN ) */ -/* C */ -/* C Initialize the markers for the file `jabber.txt'. We want */ -/* C to include the entire file, so both markers are blank. */ -/* C */ -/* BEGMRK = ' ' */ -/* ENDMRK = ' ' */ -/* INSBLN = .TRUE. */ -/* C */ -/* C Add the comments from the file 'jabber.txt' */ -/* C */ -/* CALL DAFACU ( JABLUN, BEGMRK, ENDMRK, INSBLN, HANDLE ) */ -/* C */ -/* C Initialize the markers for the file `batty.txt'. We want */ -/* C to include the bat poem only, so we define the begin and */ -/* C end markere accordingly. */ -/* C */ -/* BEGMRK = 'BEGIN bat poem' */ -/* ENDMRK = 'END bat poem' */ -/* INSBLN = .TRUE. */ -/* C */ -/* C Add the comments from the file 'batty.txt' */ -/* C */ -/* CALL DAFACU ( BATLUN, BEGMRK, ENDMRK, INSBLN, HANDLE ) */ -/* C */ -/* C Close the files. */ - -/* CLOSE ( JABLUN ) */ -/* CLOSE ( BATLUN ) */ -/* CALL DAFCLS ( HANDLE ) */ - -/* will create a comment area in `wndrland.daf' which contains: */ - -/* -BOC- */ -/* The Jabberwock */ - -/* 'Twas brillig, and the slithy toves */ -/* Did gyre and gimble in the wabe; */ -/* All mimsy were the borogoves, */ -/* And the mome raths outgrabe. */ - -/* ``Beware the Jabberwock, my son! */ -/* The jaws that bite, the claws that catch!'' */ - -/* And as in uffish thought he stood, */ -/* The Jabberwock, with eyes of flame, */ -/* Came whiffling through the tulgey wood, */ -/* And burbled as it came! */ - -/* One, two! One, two! And through and through */ -/* The vorpal blade went snicker-snack! */ -/* He left it dead, and with its head */ -/* He went galumphing back. */ - -/* ``And hast thou slain the Jabberwock? */ -/* Come to my arms, my beamish boy! */ -/* O frabjous day! Callooh! Callay!'' */ -/* He chortled in his joy. */ - -/* Through the Looking-Glass */ -/* Lewis Carroll */ - -/* Twinkle, twinkle, little bat! */ -/* How I wonder what you're at! */ -/* Up above the world you fly! */ -/* Like a teatray in the sky. */ - -/* Alice's Adventures in Wonderland */ -/* Lewis Carroll */ -/* -EOC- */ - -/* where -BOC- and -EOC- represent the beginning and end of the */ -/* comments, respectively. */ - -/* $ Restrictions */ - -/* 1) The begin comments marker, BEGMRK, and the end comments marker, */ -/* ENDMRK, must each appear alone on a line in the comment text */ -/* file, if they are not blank. */ - -/* 2) The maximum length of a text line in a comment file is */ -/* specified by the LINLEN parameter defined below. Currently */ -/* this values is 1000 characters. */ - -/* 3) The maximum length of a single line comment in the comment */ -/* area is specified by the parameter LINLEN defined below. */ -/* Currently this value is 1000 characters. */ - -/* 4) This routine uses constants that are specific to the ASCII */ -/* character sequence. The results of using this routine with */ -/* a different character sequence are unpredictable. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Support Version 1.3.0, 01-NOV-2006 (NJB) (EDW) */ - -/* Changed storage duration of array COMBUF to "saved" to */ -/* prevent memory problems on the PC/Windows/Visual C platform. */ - -/* - Support Version 1.2.0, 16-NOV-2001 (BVS) (FST) */ - -/* Buffer line size (LINLEN) was increased from 255 to 1000 */ -/* characters to make it consistent the line size in SPC */ -/* routines. */ - -/* Removed an unnecesary call to DAFHLU, as this routine */ -/* does not interact with the DAF attached to HANDLE at */ -/* the unit level. */ - -/* - Beta Version 1.1.1, 23-JAN-1999 (BVS) */ - -/* Buffer size (BUFSIZ) was increases from 22 to 2000 lines. */ - -/* - Beta Version 1.1.0, 18-JAN-1996 (KRG) */ - -/* Added a test and errors for checking to see whether COMLUN */ -/* was actually attached to an ASCII text file when this routine */ -/* was called. */ - -/* - Beta Version 1.0.0, 4-JAN-1993 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* add comments from a logical unit to a daf file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Set the value for the maximum length of a text line. */ - - -/* Set the length of a DAF file internal filename. */ - - -/* Set the size of the comment buffer. */ - - -/* Maximum and minimum decimal values for the printable ASCII */ -/* characters. */ - - -/* Local variables */ - - -/* Saved variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFACU", (ftnlen)6); - } - -/* Verify that the DAF file attached to HANDLE is opened with write */ -/* access. */ - - dafsih_(handle, "WRITE", (ftnlen)5); - if (failed_()) { - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Logical units must be positive. If it is not, signal an error. */ - - if (*comlun <= 0) { - setmsg_("# is not a valid logical unit. Logical units must be positi" - "ve.", (ftnlen)62); - errint_("#", comlun, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Verify that there is an open ASCII text file attached to COMLUN. */ - - ioin__1.inerr = 1; - ioin__1.inunit = *comlun; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - setmsg_("The INQUIRE on logical unit # failed. The value of IOSTAT w" - "as #.", (ftnlen)64); - errint_("#", comlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - if (! opened) { - setmsg_("There is no open file attached to logical unit #, so no com" - "ments could be read.", (ftnlen)79); - errint_("#", comlun, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Read the file record of the DAF attached to HANDLE. We get back */ -/* some stuff that we do not use. */ - - dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); - if (failed_()) { - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Compute the number of comment records. */ - - ncomr = fward - 2; - -/* Get an available logical unit for the comment scratch file. */ - - getlun_(&scrlun); - if (failed_()) { - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Attempt to open the comment scratch file. */ - - o__1.oerr = 1; - o__1.ounit = scrlun; - o__1.ofnm = 0; - o__1.orl = 0; - o__1.osta = "SCRATCH"; - o__1.oacc = 0; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Attempt to open a temporary file failed. IOSTAT = #.", ( - ftnlen)52); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Start looking for the begin comment marker. If the begin marker */ -/* is a blank line, then the comments begin on the first line of the */ -/* comment file. Otherwise, the comments begin on the line */ -/* immediately following the line which contains the begin comments */ -/* marker. */ - - s_copy(line, " ", (ftnlen)1000, (ftnlen)1); - eof = FALSE_; - while(s_cmp(line, begmrk, (ftnlen)1000, begmrk_len) != 0) { - readln_(comlun, line, &eof, (ftnlen)1000); - ljust_(line, line, (ftnlen)1000, (ftnlen)1000); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* If we have encountered the end of file here, we have a */ -/* problem: We did not find the begin comments marker in the */ -/* text file. So, set an appropriate error message and signal */ -/* the error. don't forget to close the scratch file. */ - - if (eof) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("The begin comments marker '#' was not found in the comm" - "ent file '#'.", (ftnlen)68); - errch_("#", begmrk, (ftnlen)1, begmrk_len); - errfnm_("#", comlun, (ftnlen)1); - sigerr_("SPICE(MARKERNOTFOUND)", (ftnlen)21); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - -/* Begin reading in the comment lines from the comment file, */ -/* placing them a buffer at a time into the temporary file. */ -/* We also scan each line for non printing characters. */ - - s_copy(line, " ", (ftnlen)1000, (ftnlen)1); - if (s_cmp(endmrk, " ", endmrk_len, (ftnlen)1) == 0) { - -/* If the end mark is blank, then we want to go until we hit the */ -/* end of the comment file. */ - - while(! eof) { - numcom = 0; - readla_(comlun, &c__2000, &numcom, combuf, &eof, (ftnlen)1000); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* If we got some comments, we need to scan them for non- */ -/* printing characters. */ - - if (numcom > 0) { - i__1 = numcom; - for (i__ = 1; i__ <= i__1; ++i__) { - length = lastnb_(combuf + ((i__2 = i__ - 1) < 2000 && 0 <= - i__2 ? i__2 : s_rnge("combuf", i__2, "dafacu_", ( - ftnlen)622)) * 1000, (ftnlen)1000); - -/* Scan the comment line for non printinig characters. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* Check to see that the characters in the buffer */ -/* are all printing ASCII characters. The bounds */ -/* for printing ASCII characters are given by */ -/* MAXPCH and MINPCH, which are defined in the */ -/* $ Local Parameters section of the header. */ - - intchr = *(unsigned char *)&combuf[((i__3 = i__ - 1) < - 2000 && 0 <= i__3 ? i__3 : s_rnge("combuf", - i__3, "dafacu_", (ftnlen)634)) * 1000 + (j - - 1)]; - if (intchr > 126 || intchr < 32) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("A nonprinting character was encountered" - " in the comments. Value: #", (ftnlen)65); - errint_("#", &intchr, (ftnlen)1); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - } - -/* Write the comments to the temporary file. */ - - writla_(&numcom, combuf, &scrlun, (ftnlen)1000); - } - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - } else { - -/* The endmark is non blank, then we want to go until we find a */ -/* line in the comment file that matches the end mark that was */ -/* entered. */ - - more = TRUE_; - while(more) { - numcom = 0; - readla_(comlun, &c__2000, &numcom, combuf, &eof, (ftnlen)1000); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* Look for ENDMRK in the current buffer, if we got some */ -/* comments. */ - - if (numcom > 0) { - i__ = 1; - while(more && i__ <= numcom) { - s_copy(line, combuf + ((i__1 = i__ - 1) < 2000 && 0 <= - i__1 ? i__1 : s_rnge("combuf", i__1, "dafacu_", ( - ftnlen)697)) * 1000, (ftnlen)1000, (ftnlen)1000); - ljust_(line, line, (ftnlen)1000, (ftnlen)1000); - if (s_cmp(line, endmrk, (ftnlen)1000, endmrk_len) == 0) { - more = FALSE_; - numcom = i__ - 1; - } else { - ++i__; - } - } - } - -/* If we still have some comments, we need to scan them for */ -/* non printing characters. */ - - if (numcom > 0) { - i__1 = numcom; - for (i__ = 1; i__ <= i__1; ++i__) { - length = lastnb_(combuf + ((i__2 = i__ - 1) < 2000 && 0 <= - i__2 ? i__2 : s_rnge("combuf", i__2, "dafacu_", ( - ftnlen)722)) * 1000, (ftnlen)1000); - -/* Scan the comment line for non printinig characters. */ - - i__2 = length; - for (j = 1; j <= i__2; ++j) { - -/* Check to see that the characters in the buffer */ -/* are all printing ASCII characters. The bounds */ -/* for printing ASCII characters are given by */ -/* MAXPCH and MINPCH, which are defined in the */ -/* $ Local Parameters section of the header. */ - - intchr = *(unsigned char *)&combuf[((i__3 = i__ - 1) < - 2000 && 0 <= i__3 ? i__3 : s_rnge("combuf", - i__3, "dafacu_", (ftnlen)734)) * 1000 + (j - - 1)]; - if (intchr > 126 || intchr < 32) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("A nonprinting character was encountered" - " in the comment buffer. Value: #", ( - ftnlen)71); - errint_("#", &intchr, (ftnlen)1); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - } - -/* Write the comments to the temporary file. */ - - writla_(&numcom, combuf, &scrlun, (ftnlen)1000); - } - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - -/* If we have encountered the end of file here, we have a */ -/* problem: We did not find the end comments marker in the */ -/* text file. So, set an appropriate error message and */ -/* signal the error. */ - - if (more && eof) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("The end comments marker '#' was not found in the co" - "mment file '#'.", (ftnlen)66); - errch_("#", endmrk, (ftnlen)1, endmrk_len); - errfnm_("#", comlun, (ftnlen)1); - sigerr_("SPICE(MARKERNOTFOUND)", (ftnlen)21); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - } - -/* If we made it to here, we have culled all of the comments out of */ -/* the text file and they were all OK. So we need to add all of the */ -/* comments to the DAF comment area now. */ - -/* If we are supposed to insert a blank line to separate the current */ -/* addition from any previously stored comments, and there are */ -/* comments already in the comment area, indicated by NCOMR > 0, then */ -/* we insert the blank line. Otherwise, just add the comments. */ - - if (*insbln && ncomr > 0) { - dafac_(handle, &c__1, " ", (ftnlen)1); - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - -/* Rewind the scratch file to get ready to put the comments into the */ -/* comment area. */ - - al__1.aerr = 0; - al__1.aunit = scrlun; - f_rew(&al__1); - -/* Begin reading through the scratch file, placing the comment lines */ -/* into the comment area of the DAF file a buffer at a time */ - - eof = FALSE_; - while(! eof) { - numcom = 0; - -/* Read in a buffer of comment lines. */ - - readla_(&scrlun, &c__2000, &numcom, combuf, &eof, (ftnlen)1000); - -/* If we got some, add them to the comment area of the DAF file. */ - - if (numcom > 0) { - dafac_(handle, &numcom, combuf, (ftnlen)1000); - } - if (failed_()) { - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; - } - } - -/* Close the scratch file before exiting, it's the only one we */ -/* opened. */ - - cl__1.cerr = 0; - cl__1.cunit = scrlun; - cl__1.csta = 0; - f_clos(&cl__1); - chkout_("DAFACU", (ftnlen)6); - return 0; -} /* dafacu_ */ - diff --git a/ext/spice/src/csupport/dafecu.c b/ext/spice/src/csupport/dafecu.c deleted file mode 100644 index c2e73ce7a6..0000000000 --- a/ext/spice/src/csupport/dafecu.c +++ /dev/null @@ -1,316 +0,0 @@ -/* dafecu.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__22 = 22; - -/* $Procedure DAFECU( DAF extract comments to a logical unit ) */ -/* Subroutine */ int dafecu_(integer *handle, integer *comlun, logical * - comnts) -{ - /* System generated locals */ - inlist ioin__1; - - /* Builtin functions */ - integer f_inqu(inlist *); - - /* Local variables */ - extern /* Subroutine */ int dafec_(integer *, integer *, integer *, char * - , logical *, ftnlen), chkin_(char *, ftnlen); - extern logical failed_(void); - extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); - logical opened; - char combuf[1000*22]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - integer numcom; - extern /* Subroutine */ int chkout_(char *, ftnlen); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), writla_(integer *, char *, integer *, ftnlen); - logical gotsom; - extern logical return_(void); - logical eoc; - -/* $ Abstract */ - -/* Extract comments from a previously opened binary DAF file to a */ -/* previously opened text file attached to a Fortran logical unit. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a DAF file opened with read access. */ -/* COMLUN I Logical unit of an opened text file. */ -/* COMNTS O Logical flag, indicating comments were found. */ - -/* $ Detailed_Input */ - -/* HANDLE The file handle for a binary DAF file that has been */ -/* opened with read access. */ - -/* COMLUN The Fortran logical unit of a previously opened text */ -/* file to which the comments from a binary DAF file are */ -/* to be written. */ - -/* The comments will be placed into the text file beginning */ -/* at the current location in the file and continuing */ -/* until all of the comments from the comment area of the */ -/* DAF file have been written. */ - -/* $ Detailed_Output */ - -/* COMNTS A logical flag indicating whether or not any comments */ -/* were found in the comment area of a DAF file. COMNTS will */ -/* have the value .TRUE. if there were some comments, and */ -/* the value .FALSE. otherwise. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input logical unit COMLUN is not positive or there */ -/* is not an opened file attached to it, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If the INQUIRE on the logical unit to see if there is a */ -/* file attached fails, the error SPICE(INQUIREFAILED) will */ -/* be signalled. */ - -/* 3) If an error occurs while reading from the binary DAF file */ -/* attached to HANDLE, a routine called by this routine will */ -/* signal an error. */ - -/* 4) If an error occurs while writing to the text file attached */ -/* to COMLUN, a routine called by this routine will signal an */ -/* error. */ - -/* $ Files */ - -/* See parameters COMLUN and HANDLE in the $ Detailed_Inputs section. */ - -/* $ Particulars */ - -/* This routine will extract all of the comments from the comment */ -/* area of a binary DAF file, placing them into a text file */ -/* attached to COMLUN beginning at the current position in the */ -/* text file. If there are no comments in the DAF file, nothing is */ -/* written to the text file attached to COMLUN. */ - -/* $ Examples */ - -/* Let */ - -/* HANDLE be the DAF file handle of a previously opened binary */ -/* DAF file. */ - -/* COMLUN be the Fortran logical unit of a previously opened */ -/* text file that is to accept the comments from the */ -/* DAF comment area. */ - -/* The subroutine call */ - -/* CALL DAFECU ( HANDLE, COMLUN, COMNTS ) */ - -/* will extract the comments from the comment area of the binary */ -/* DAF file attached to HANDLE, if there are any, and write them */ -/* to the logical unit COMLUN. Upon successful completion, the */ -/* value of COMNTS will be .TRUE. if there were some comments */ -/* in the comment area of the DAF file and .FALSE. otherwise. */ - -/* $ Restrictions */ - -/* The maximum length of a single comment line in the comment area is */ -/* specified by the parameter LINLEN defined below. Currently this */ -/* value is 1000 characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.1, 08-MAY-2001 (BVS) */ - -/* Buffer line size (LINLEN) was increased from 255 to 1000 */ -/* characters to make it consistent the line size in SPC */ -/* routines. */ - -/* - Beta Version 1.1.0, 18-JAN-1996 (KRG) */ - -/* Added a test and errors for checking to see whether COMLUN */ -/* was actually attached to an ASCII text file when this routine */ -/* was called. */ - -/* - Beta Version 1.0.0, 23-SEP-1994 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* extract comments from a DAF to a logical unit */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - -/* Set the value for the maximum length of a text line. */ - - -/* Set the size of the comment buffer. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DAFECU", (ftnlen)6); - } - -/* Verify that the DAF file attached to HANDLE is opened for reading. */ - - dafsih_(handle, "READ", (ftnlen)4); - if (failed_()) { - chkout_("DAFECU", (ftnlen)6); - return 0; - } - -/* Logical units must be positive. If it is not, signal an error. */ - - if (*comlun <= 0) { - setmsg_("# is not a valid logical unit. Logical units must be positi" - "ve.", (ftnlen)62); - errint_("#", comlun, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DAFECU", (ftnlen)6); - return 0; - } - -/* Verify that there is an open ASCII text file attached to COMLUN. */ - - ioin__1.inerr = 1; - ioin__1.inunit = *comlun; - ioin__1.infile = 0; - ioin__1.inex = 0; - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - if (iostat != 0) { - setmsg_("The INQUIRE on logical unit # failed. The value of IOSTAT w" - "as #.", (ftnlen)64); - errint_("#", comlun, (ftnlen)1); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); - chkout_("DAFECU", (ftnlen)6); - return 0; - } - if (! opened) { - setmsg_("There is no open file attached to logical unit #, so no com" - "ments could be written.", (ftnlen)82); - errint_("#", comlun, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("DAFECU", (ftnlen)6); - return 0; - } - -/* Initialize some things before the loop. */ - - numcom = 0; - eoc = FALSE_; - gotsom = FALSE_; - while(! eoc) { - -/* While we have not reached the end of the comments, get some */ -/* more. */ - - dafec_(handle, &c__22, &numcom, combuf, &eoc, (ftnlen)1000); - if (failed_()) { - chkout_("DAFECU", (ftnlen)6); - return 0; - } - if (numcom > 0) { - -/* If NUMCOM .GT. 0 then we did get some comments, and we need */ -/* to write them out, but first, set the flag indicating that */ -/* we got some comments. */ - - if (! gotsom) { - gotsom = TRUE_; - } - writla_(&numcom, combuf, comlun, (ftnlen)1000); - if (failed_()) { - chkout_("DAFECU", (ftnlen)6); - return 0; - } - } - } - -/* Set the output flag indicating whether or not we got any comments. */ - - *comnts = gotsom; - chkout_("DAFECU", (ftnlen)6); - return 0; -} /* dafecu_ */ - diff --git a/ext/spice/src/csupport/dcyphr.c b/ext/spice/src/csupport/dcyphr.c deleted file mode 100644 index 876861d243..0000000000 --- a/ext/spice/src/csupport/dcyphr.c +++ /dev/null @@ -1,1019 +0,0 @@ -/* dcyphr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure DCYPHR ( Decypher the meaning of an IOSTAT code) */ -/* Subroutine */ int dcyphr_(integer *iostat, logical *found, char *diagns, - ftnlen diagns_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer lbnd, ubnd; - static char attr[32*2]; - static logical next; - static integer n; - static logical alpha; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static logical pc, hp; - static char messge[800*90]; - extern /* Subroutine */ int pltfrm_(integer *, integer *, char *, ftnlen); - static logical sgi, vax, sun; - -/* $ Abstract */ - -/* Given an IOSTAT code returned by a read, write, open, */ -/* inquire, or close statement, this routine returns a */ -/* brief text description of the problem. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* IOSTAT I The value of IOSTAT returned by a FORTRAN function */ -/* FOUND O TRUE if the value of IOSTAT was found */ -/* DIAGNS O A string describing the meaning of IOSTAT */ - -/* $ Detailed_Input */ - -/* IOSTAT is the non-zero value of IOSTAT returned by */ -/* some intrinsic FORTRAN I/O facility such as */ -/* OPEN, INQUIRE, READ, WRITE, or CLOSE. */ - -/* $ Detailed_Output */ - -/* FOUND is set to TRUE if the value of IOSTAT was found, */ -/* otherwise it is returned as false. */ - -/* DIAGNS is a string that describes the meaning of IOSTAT. */ -/* you should declare DIAGNS to be at least */ -/* CHARACTER*(800) to ensure that the message will */ -/* fit into DIAGNS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the meaning of IOSTAT is not available within this */ -/* routine, DIAGNS will be returned with a string of the */ -/* form: */ - -/* The value of IOSTAT was #. The meaning of this */ -/* value is not available via the SPICE system. */ -/* Please consult your FORTRAN manual for the */ -/* meaning of this code. */ - -/* where the character '#' will be replaced by a string */ -/* giving the input value of IOSTAT. */ - -/* $ Particulars */ - -/* This routine is a utility for aiding in the construction */ -/* of messages relating to the failure of FORTRAN I/O. */ - -/* $ Examples */ - -/* Suppose that you get a positive value of IOSTAT as the */ -/* result of a FORTRAN I/O statement and that you'd like to */ -/* present a descriptive diagnostic. */ - -/* CALL DCYPHR ( IOSTAT, DIAGNS ) */ -/* WRITE (*,*) DIAGNS */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 21-APR-1994 (HAN) (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the meaning of an IOSTAT value. */ - -/* -& */ - if (first) { - pltfrm_(&c__2, &n, attr, (ftnlen)32); - next = first && s_cmp(attr, "NEXT ", (ftnlen)32, (ftnlen)5) == 0; - hp = first && s_cmp(attr, "HP ", (ftnlen)32, (ftnlen)5) == 0; - sun = first && s_cmp(attr, "SUN ", (ftnlen)32, (ftnlen)5) == 0; - sgi = first && s_cmp(attr, "SGI ", (ftnlen)32, (ftnlen)5) == 0; - vax = first && s_cmp(attr, "VAX ", (ftnlen)32, (ftnlen)5) == 0; - pc = first && s_cmp(attr, "PC ", (ftnlen)32, (ftnlen)5) == 0; - alpha = first && s_cmp(attr, "ALPHA", (ftnlen)32, (ftnlen)5) == 0; - first = FALSE_; - } - if (next) { - lbnd = 9999; - ubnd = 10032; - s_copy(messge, "The file is not open for reading.", (ftnlen)800, ( - ftnlen)33); - s_copy(messge + 800, "The file is not open for writing.", (ftnlen)800, - (ftnlen)33); - s_copy(messge + 1600, "The file was not found.", (ftnlen)800, (ftnlen) - 23); - s_copy(messge + 2400, "The record length specified was negative or 0." - , (ftnlen)800, (ftnlen)46); - s_copy(messge + 3200, "I/O buffer allocation failed.", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 4000, "The iolist specifier was bad.", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 4800, "The format string is in error.", (ftnlen)800, ( - ftnlen)30); - s_copy(messge + 5600, "The repeat count is illegal.", (ftnlen)800, ( - ftnlen)28); - s_copy(messge + 6400, "The hollerith count exceeds remaining format " - "string.", (ftnlen)800, (ftnlen)52); - s_copy(messge + 7200, "The format string is missing an opening \"(\"." - , (ftnlen)800, (ftnlen)44); - s_copy(messge + 8000, "The format string has unmatched parentheses.", - (ftnlen)800, (ftnlen)44); - s_copy(messge + 8800, "The format string has unmatched quotes.", ( - ftnlen)800, (ftnlen)39); - s_copy(messge + 9600, "A format descriptor is non-repeatable.", ( - ftnlen)800, (ftnlen)38); - s_copy(messge + 10400, "The program attempted to read past end of th" - "e file.", (ftnlen)800, (ftnlen)51); - s_copy(messge + 11200, "The file specification was bad.", (ftnlen)800, - (ftnlen)31); - s_copy(messge + 12000, "The format group table overflowed.", (ftnlen) - 800, (ftnlen)34); - s_copy(messge + 12800, "An illegal character was present in numeric " - "input.", (ftnlen)800, (ftnlen)50); - s_copy(messge + 13600, "No record was specified while using direct a" - "ccess I/O.", (ftnlen)800, (ftnlen)54); - s_copy(messge + 14400, "The maximum record number was exceeded.", ( - ftnlen)800, (ftnlen)39); - s_copy(messge + 15200, "An illegal file type was supplied for use wi" - "th namelist directed I/O", (ftnlen)800, (ftnlen)68); - s_copy(messge + 16000, "An illegal input for namelist directed I/O w" - "as encountered.", (ftnlen)800, (ftnlen)59); - s_copy(messge + 16800, "A variable is not present in the current nam" - "elist.", (ftnlen)800, (ftnlen)50); - s_copy(messge + 17600, "A variable type or size does not match edit " - "descriptor.", (ftnlen)800, (ftnlen)55); - s_copy(messge + 18400, "An llegal direct access record number was us" - "ed.", (ftnlen)800, (ftnlen)47); - s_copy(messge + 19200, "An internal file was used illegally.", ( - ftnlen)800, (ftnlen)36); - s_copy(messge + 20000, "The OPEN specifiere \"RECL=\" is only valid " - "for direct access files", (ftnlen)800, (ftnlen)65); - s_copy(messge + 20800, "The Open specifiere \"BLOCK=\" is only valid" - " for unformatted sequential files.", (ftnlen)800, (ftnlen)76); - s_copy(messge + 21600, "The program was unable to truncate the file " - "after rewind, backspace,or endfile.", (ftnlen)800, (ftnlen)79) - ; - s_copy(messge + 22400, "It's illegal to use formatted I/O on an enti" - "re structure.", (ftnlen)800, (ftnlen)57); - s_copy(messge + 23200, "An illegal (negative) unit was specified.", ( - ftnlen)800, (ftnlen)41); - s_copy(messge + 24000, "The specifications in a RE-OPEN do not match" - " aprevious OPEN.", (ftnlen)800, (ftnlen)60); - s_copy(messge + 24800, "An implicit OPEN can not be used for direct " - "access files.", (ftnlen)800, (ftnlen)57); - s_copy(messge + 25600, "The file already exists. It cannot be opened" - " as a new file.", (ftnlen)800, (ftnlen)59); - } else if (sun) { - lbnd = 99; - ubnd = 126; - s_copy(messge, "The format string is in error.", (ftnlen)800, (ftnlen) - 30); - s_copy(messge + 800, "The unit number is illegal.", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 1600, "The logical unit was opened for unformatted I" - "/O, not formatted.", (ftnlen)800, (ftnlen)63); - s_copy(messge + 2400, "The logical unit was opened for formatted I/O" - ", not unformatted.", (ftnlen)800, (ftnlen)63); - s_copy(messge + 3200, "The logical unit was opened for sequential ac" - "cess, or the logical record length was specified as zero.", ( - ftnlen)800, (ftnlen)102); - s_copy(messge + 4000, "The logical unit was opened for direct I/O, n" - "ot sequential.", (ftnlen)800, (ftnlen)59); - s_copy(messge + 4800, "The program was unable to backspace the file.", - (ftnlen)800, (ftnlen)45); - s_copy(messge + 5600, "The format specified a left tab beyond the be" - "ginning of an internal input record.", (ftnlen)800, (ftnlen) - 81); - s_copy(messge + 6400, "The system cannot return status information a" - "bout the file. Perhaps the directory is unreadable.", (ftnlen) - 800, (ftnlen)96); - s_copy(messge + 7200, "Repeat counts in list-directed I/O must be fo" - "llowed by an asterisk with no blank spaces.", (ftnlen)800, ( - ftnlen)88); - s_copy(messge + 8000, "The program attempted to read past the end of" - " a record.", (ftnlen)800, (ftnlen)55); - s_copy(messge + 8800, "The program was unable to truncate an externa" - "l sequential file on close, backspace, or rewind.", (ftnlen) - 800, (ftnlen)94); - s_copy(messge + 9600, "The list input is incomprehensible.", (ftnlen) - 800, (ftnlen)35); - s_copy(messge + 10400, "The library dynamically creates buffers for " - "internal use. The program is too big, and thus ran out of fr" - "ee space.", (ftnlen)800, (ftnlen)113); - s_copy(messge + 11200, "The logical unit was not open.", (ftnlen)800, - (ftnlen)30); - s_copy(messge + 12000, "An unexpected character was encountered. Som" - "e format conversions cannot tolerate nonnumeric data.", ( - ftnlen)800, (ftnlen)97); - s_copy(messge + 12800, "Logical data must be true or false.", (ftnlen) - 800, (ftnlen)35); - s_copy(messge + 13600, "The program tried to open an existing file w" - "ith \"STATUS = NEW\".", (ftnlen)800, (ftnlen)63); - s_copy(messge + 14400, "The program tried to open a nonexistent file" - " with \"STATUS=OLD\".", (ftnlen)800, (ftnlen)63); - s_copy(messge + 15200, "The program caused an unknown system error. " - "Contact your system administrator!", (ftnlen)800, (ftnlen)78); - s_copy(messge + 16000, "Direct access of a file requires seek abilit" - "y. Sequential unformatted I/O and tabbing left also require " - "seek ability.", (ftnlen)800, (ftnlen)117); - s_copy(messge + 16800, "An illegal argument was specified in the sta" - "tement.", (ftnlen)800, (ftnlen)51); - s_copy(messge + 17600, "The repeat count for list-directed input mus" - "t be a positive integer.", (ftnlen)800, (ftnlen)68); - s_copy(messge + 18400, "An illegal operation was attempted on the de" - "vice associated with the unit.", (ftnlen)800, (ftnlen)74); - s_copy(messge + 19200, "The program tried to open too many files. Th" - "e limit is 64.", (ftnlen)800, (ftnlen)58); - s_copy(messge + 20000, "The logical unit was not open.", (ftnlen)800, - (ftnlen)30); - s_copy(messge + 20800, "A namelist read encountered an invalid data " - "item.", (ftnlen)800, (ftnlen)49); - } else if (hp) { - lbnd = 899; - ubnd = 989; - s_copy(messge, "Error in format. Format specification does not start" - " with a left parenthesis or end with a right parenthesis, or" - " contains unrecognizable code or string; format specificatio" - "n is too long for library internal buffer. Change the format" - " specification to proper syntax; split the format specificat" - "ions into several statements. ", (ftnlen)800, (ftnlen)322); - s_copy(messge + 800, "I/O with illegal unit number attempted. Negati" - "ve unit number was used in an I/O statement. Use integers gr" - "eater than or equal to 0 for an I/O number. ", (ftnlen)800, ( - ftnlen)150); - s_copy(messge + 1600, "Formatted I/O attempted on unformatted file. " - "Formatted I/O was attempted on a file opened for unformatted" - " I/O. Open the file for formatted I/O; do unformatted I/O on" - " this file. ", (ftnlen)800, (ftnlen)177); - s_copy(messge + 2400, "Unformatted I/O attempted on formatted file. " - "Unformatted I/O was attempted on a file opened for formatted" - " I/O. Open the file for unformatted I/O; do formatted I/O on" - " this file. ", (ftnlen)800, (ftnlen)177); - s_copy(messge + 3200, "Direct I/O attempted on sequential file. Dire" - "ct operation attempted on sequential file; direct operation " - "attempted on opened file connected to a terminal. Use sequen" - "tial operations on this file; open file for direct access; d" - "o not do direct I/O on a file connected to a terminal. ", ( - ftnlen)800, (ftnlen)280); - s_copy(messge + 4000, "Error in list- or name-directed read of logic" - "al data. Found repeat value, but no asterisk; first characte" - "r after optional decimal point was not \"T\" or \"F\". Chang" - "e input data to correspond to syntax expected by list-direct" - "ed input of logicals; use input statement that corresponds t" - "o syntax of input data. ", (ftnlen)800, (ftnlen)305); - s_copy(messge + 4800, "Illegal sequential I/O to tty attempted1. Exe" - "cuted a BACKSPACE, REWIND, formatted READ, or formatted WRIT" - "E, on this sequential file or device. Use a file or device t" - "hat is considered blocked in HP-UX. ", (ftnlen)800, (ftnlen) - 201); - s_copy(messge + 5600, "List- or name-directed read of character data" - " attempted. Found repeat value, but no asterisk; character n" - "ot delimited by quotation marks. Change input data to corres" - "pond to syntax expected by list-directed input of characters" - "; use input statement that corresponds to syntax of input da" - "ta. ", (ftnlen)800, (ftnlen)289); - s_copy(messge + 6400, "Open of file with bad path-name attempted. Tr" - "ied to open a file that the system would not allow for one o" - "f the following reasons: 1. A component of the path prefix " - "is not a directory. 2. The named file does not exist. 3. S" - "earch permission is denied for a component of the path prefi" - "x. Correct the path-name to invoke the file intended; check " - "that the file is not corrupt; be sure that search permission" - "s are set properly. ", (ftnlen)800, (ftnlen)425); - s_copy(messge + 7200, "Sequential I/O attempted on direct file. Atte" - "mpted a BACKSPACE, REWIND, or ENDFILE on a direct file. Open" - " the file for sequential access; do not use BACKSPACE, REWIN" - "D, or ENDFILE. ", (ftnlen)800, (ftnlen)180); - s_copy(messge + 8000, "Access past end of record attempted. Tried to" - " do I/O on record of a file past beginning or end of record." - " Perform I/O operation within bounds of the record; increase" - " record length. ", (ftnlen)800, (ftnlen)181); - s_copy(messge + 8800, "Recursive I/O attempted1. An I/O specifier or" - " item in an I/O list attempted to do I/O (that is, calls to " - "functions that do I/O). Remove calls to functions that do I/" - "O from the specifier/list item; remove I/O statements from t" - "he function called by the specifier/list item. ", (ftnlen)800, - (ftnlen)272); - s_copy(messge + 9600, "Error in list- or name-directed read of compl" - "ex data. While reading complex data, one of the following pr" - "oblems has occurred: 1. No left parenthesis or no repeat va" - "lue. 2. Found repeat value, but no asterisk. 3. No comma a" - "fter real part. 4. No closing right parenthesis. Change inp" - "ut data to correspond to syntax expected by list-directed in" - "put of complex numbers; use input statement corresponding to" - " syntax of input data. ", (ftnlen)800, (ftnlen)428); - s_copy(messge + 10400, "Out of free space. Library cannot store file" - " name (from OPEN statement) or characters read (from list-di" - "rected read). Use shorter file name or read fewer characters" - "; use fewer file names or read fewer character strings. ", ( - ftnlen)800, (ftnlen)220); - s_copy(messge + 11200, "Access of unconnected unit attempted. Unit s" - "pecified in I/O statement has not previously been connected " - "to anything. Connect unit (that is, OPEN it) before attempti" - "ng I/O on it; perform I/O on another, already connected, uni" - "t. ", (ftnlen)800, (ftnlen)227); - s_copy(messge + 12000, "Read unexpected character. While reading an " - "integer, read a character that was not a digit, \"+\", \"-\"" - ", comma, end-of-line or blank; while reading a real number, " - "read a character that was not a digit, \"+\", \"-\", comma, " - "end-of-line, blank, \"d\", \"D\", \"e\", \"E\", or period. R" - "emove from input data any characters that are illegal in int" - "egers or real numbers. ", (ftnlen)800, (ftnlen)351); - s_copy(messge + 12800, "Error in read of logical data. A blank was r" - "ead when logical data was expected. Change input data to cor" - "respond to syntax expected when reading logical data; use in" - "put statement corresponding to syntax of input data. ", ( - ftnlen)800, (ftnlen)217); - s_copy(messge + 13600, "Open with named scratch file attempted. Exec" - "uted OPEN statement with STATUS='SCRATCH', but also named th" - "e file (FILE= filename). Either open file with STATUS='SCRAT" - "CH', or name the file in an OPEN statement, but not both. ", ( - ftnlen)800, (ftnlen)222); - s_copy(messge + 14400, "Open of existing file with STATUS='NEW' atte" - "mpted. Executed OPEN statement with STATUS='NEW', but file a" - "lready exists. Use OPEN without STATUS specifier, or with ST" - "ATUS='OLD', or STATUS='UNKNOWN'. ", (ftnlen)800, (ftnlen)197); - s_copy(messge + 15200, "The value of IOSTAT was 919. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. . ", (ftnlen)800, (ftnlen)109); - s_copy(messge + 16000, "Open of file connected to different unit att" - "empted. Executed OPEN statement with file name that is alrea" - "dy associated with a UNIT specifier. Use an OPEN statement w" - "ith a file name that is not connected to a unit name; open t" - "he connected file to the same unit name. ", (ftnlen)800, ( - ftnlen)265); - s_copy(messge + 16800, "Unformatted open with BLANK specifier attemp" - "ted. OPEN statement specified FORM='UNFORMATTED' and BLANK= " - "xx. Use either FORM='FORMATTED' or BLANK= xx, but not both, " - "when opening files. ", (ftnlen)800, (ftnlen)184); - s_copy(messge + 17600, "I/O on illegal record attempted. Attempted t" - "o read a record of a formatted or unformatted direct file th" - "at is beyond the current end-of-file. Read records that are " - "within the bounds of the file. ", (ftnlen)800, (ftnlen)195); - s_copy(messge + 18400, "Open with illegal FORM specifier attempted. " - "FORM specifier did not begin with \"F\", \"f\", \"U\", or \"u" - "\". Use either 'FORMATTED' or 'UNFORMATTED' for the FORM spe" - "cifier in an OPEN statement. ", (ftnlen)800, (ftnlen)186); - s_copy(messge + 19200, "Close of scratch file with STATUS='KEEP' att" - "empted. The file specified in the CLOSE statement was previo" - "usly opened with 'SCRATCH' specified in the STATUS specifier" - ". Open the file with a STATUS other than 'SCRATCH'; do not s" - "pecify STATUS='KEEP' in the CLOSE statement for this scratch" - " file. ", (ftnlen)800, (ftnlen)291); - s_copy(messge + 20000, "Open with illegal STATUS specifier attempted" - ". STATUS specifier did not begin with \"O\", \"o\", \"N\"," - " \"n\", \"S\", \"s\", \"U\", or \"u\". Use 'OLD', 'NEW', 'SC" - "RATCH', or 'UNKNOWN' for the STATUS specifier in OPEN statem" - "ent. ", (ftnlen)800, (ftnlen)211); - s_copy(messge + 20800, "Close with illegal STATUS specifier attempte" - "d. STATUS specifier did not begin with \"K\", \"k\", \"D\", " - "or \"d\". statement. ", (ftnlen)800, (ftnlen)117); - s_copy(messge + 21600, "Open with illegal ACCESS specifier attempted" - ". ACCESS specifier did not begin with \"S\", \"s\", \"D\", o" - "r \"d\". Use 'SEQUENTIAL' or 'DIRECT' for the ACCESS specifi" - "er in an OPEN statement. ", (ftnlen)800, (ftnlen)181); - s_copy(messge + 22400, "Open of sequential file with RECL specifier " - "attempted. OPEN statement had both ACCESS='SEQUENTIAL' and R" - "ECL= xx specified. Omit RECL specifier; specify ACCESS='DIRE" - "CT'. ", (ftnlen)800, (ftnlen)169); - s_copy(messge + 23200, "Open of direct file with no RECL specifier a" - "ttempted. OPEN statement has ACCESS='DIRECT', but no RECL sp" - "ecifier. Add RECL specifier; specify ACCESS='SEQUENTIAL'. or" - " Open of direct file with no RECL or RECL=0 attempted1 OPEN " - "statement has ACCESS='DIRECT', but no RECL specifier. Add RE" - "CL specifier; specify ACCESS='SEQUENTIAL'. ", (ftnlen)800, ( - ftnlen)327); - s_copy(messge + 24000, "Open with RECL less than 1 attempted. RECL s" - "pecifier in OPEN statement was less than or equal to zero. U" - "se a positive number for RECL specifier in OPEN statement. o" - "r Open with RECL less than zero attempted. RECL specifier in" - " OPEN statement was less than or equal to zero. Use a positi" - "ve number for RECL specifier in OPEN statement. ", (ftnlen) - 800, (ftnlen)332); - s_copy(messge + 24800, "Open with illegal BLANK specifier attempted." - " BLANK specifier did not begin with \"N\", \"n\", \"Z\", or" - " \"z\". Use 'NULL' or 'ZERO' for BLANK specifier in OPEN sta" - "tement. ", (ftnlen)800, (ftnlen)163); - s_copy(messge + 25600, "Too many units open at once. The program att" - "empted to have greater than 60 files open at once. Close a p" - "resently open file before opening another. ", (ftnlen)800, ( - ftnlen)147); - s_copy(messge + 26400, "End of file encountered. Attempted to read b" - "eyond the end of a sequential file. Read records that are wi" - "thin bounds of the file. ", (ftnlen)800, (ftnlen)129); - s_copy(messge + 27200, "The value of IOSTAT was 934. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 28000, "Internal library error. A rare software erro" - "r has occurred. Report the error. ", (ftnlen)800, (ftnlen)78); - s_copy(messge + 28800, "The value of IOSTAT was 936. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 29600, "Access of record <=0 attempted. Access of di" - "rect file specifier REC= negative number or 0. Use an intege" - "r greater than 0 in the REC= specifier. ", (ftnlen)800, ( - ftnlen)144); - s_copy(messge + 30400, "List I/O of unknown type attempted. An inter" - "nal error has occurred. Report the error. ", (ftnlen)800, ( - ftnlen)86); - s_copy(messge + 31200, "Open of inaccessible file attempted. When op" - "ening a file with STATUS='OLD', component of the path is not" - " a directory, the named file does not exist, or the path poi" - "nts outside a process or allocated address space. Use legal " - "pathname; insure existence of file; or open with STATUS='NEW" - "'. ", (ftnlen)800, (ftnlen)287); - s_copy(messge + 32000, "Open attempted. Too many files open; file pe" - "rmissions do not allow access. Close some files before openi" - "ng more; change read/write access of file to allow open. ", ( - ftnlen)800, (ftnlen)161); - s_copy(messge + 32800, "Error in sequential unformatted read. Attemp" - "t to prepare file for sequential unformatted read failed. Us" - "e existing, non-corrupt file and be sure the system is not c" - "orrupt. ", (ftnlen)800, (ftnlen)172); - s_copy(messge + 33600, "Error in list- or name-directed read. System" - " detected error while trying to do list read. Be sure system" - " and file are not corrupt. ", (ftnlen)800, (ftnlen)131); - s_copy(messge + 34400, "Error in direct formatted read. System encou" - "ntered problem while reading a character from specified exte" - "rnal file. Be sure file and system are not corrupt. ", ( - ftnlen)800, (ftnlen)156); - s_copy(messge + 35200, "Error in direct unformatted I/O. System foun" - "d error while concluding direct unformatted I/O call. Be sur" - "e file and system are not corrupt. ", (ftnlen)800, (ftnlen) - 139); - s_copy(messge + 36000, "Error in formatted I/O. System found error w" - "hile reading or writing formatted data; usually means more c" - "haracters were requested than exist in a record. Be sure for" - "mat matches data. Be sure file and system are not corrupt. ", - (ftnlen)800, (ftnlen)224); - s_copy(messge + 36800, "Error in list I/O. List I/O was attempted on" - " an unformatted file. Do list I/O on formatted file. ", ( - ftnlen)800, (ftnlen)97); - s_copy(messge + 37600, "Edit descriptor not compatible with type of " - "item. Use an edit descriptor that is compatible with the dat" - "a item; use a data item that is compatible with the edit des" - "criptor. ", (ftnlen)800, (ftnlen)173); - s_copy(messge + 38400, "Write to write-protected file attempted. Cha" - "nge write protection bit to allow write; do not write to thi" - "s file. ", (ftnlen)800, (ftnlen)112); - s_copy(messge + 39200, "Read from read-protected file attempted. Cha" - "nge read protection bit to allow read; do not read from this" - " file. ", (ftnlen)800, (ftnlen)111); - s_copy(messge + 40000, "Value out of range. An index to an array or " - "substring reference was outside of the declared limits. Chec" - "k all indexes to arrays and substrings. ", (ftnlen)800, ( - ftnlen)144); - s_copy(messge + 40800, "Label out of bounds in assigned GOTO. The va" - "lue of the variable did not correspond to any of the labels " - "in the list in an assigned GOTO statement. Check for a possi" - "ble logic error in the program or an incorrect list in the a" - "ssigned GOTO statement. ", (ftnlen)800, (ftnlen)248); - s_copy(messge + 41600, "Zero increment value in DO loop. A DO loop w" - "ith a zero increment has produced an infinite loop. Check fo" - "r a logic error in the program. ", (ftnlen)800, (ftnlen)136); - s_copy(messge + 42400, "No repeatable edit descriptor in format stat" - "ement. A repeat count was given for an edit descriptor that " - "does not allow repetition. Add at least one repeatable edit " - "descriptor to the format statement. ", (ftnlen)800, (ftnlen) - 200); - s_copy(messge + 43200, "Illegal use of empty format attempted. An em" - "pty format specification, (), was used with the list items s" - "pecified. Remove the items from I/O list; fill in the format" - " specifications with the appropriate format descriptors. ", ( - ftnlen)800, (ftnlen)221); - s_copy(messge + 44000, "Open with no FILE= and STATUS 'OLD' or 'NEW'" - " attempted. Status 'NEW' or 'OLD' was attempted and FILE= wa" - "s not specified. Change the STATUS specifier to 'SCRATCH' or" - " 'UNKNOWN'; add the file specifier. ", (ftnlen)800, (ftnlen) - 200); - s_copy(messge + 44800, "The value of IOSTAT was 956. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 45600, "Format descriptor incompatible with numeric " - "item in I/O list. A numeric item in the I/O list was matched" - " with a nonnumeric format descriptor. Match format descripto" - "rs to I/O list. or File could not be truncated. Physical len" - "gth of file could not be forced to match the logical length. " - , (ftnlen)800, (ftnlen)285); - s_copy(messge + 46400, "Format descriptor incompatible with characte" - "r item in I/O list. A character item in the I/O list was mat" - "ched with a format descriptor other than \"A\" or \"R\". Mat" - "ch format descriptors to I/O list. or Unexpected character i" - "n NAMELIST read. An illegal character was found in NAMELIST-" - "directed input. Be sure input data conforms to the syntax ru" - "les for NAMELIST-directed input. ", (ftnlen)800, (ftnlen)373); - s_copy(messge + 47200, "Format descriptor incompatible with logical " - "item in I/O list. A logical item in the I/O list was matched" - " with a format descriptor other than \"L\". Match format des" - "criptors to I/O list. or Illegal subscript/substring in NAME" - "LIST read. An invalid subscript or substring specifier was f" - "ound in NAMELIST-directed input. Possible causes: bad synta" - "x, subscript/substring component out-of-bounds, wrong number" - " of subscripts, substring on non-CHARACTER variable. Check i" - "nput data for syntax errors. Be sure subscript/substring sp" - "ecifiers are correct for data type. ", (ftnlen)800, (ftnlen) - 558); - s_copy(messge + 48000, "Format error: Missing starting left parenthe" - "sis. Format did not begin with a left parenthesis. Begin for" - "mat with a left parenthesis. or Too many values in NAMELIST " - "read. Too many input values were found during a NAMELIST-dir" - "ected READ. This message will be generated by attempts to fi" - "ll variables beyond their memory limits. Remove excess value" - "s from input data. ", (ftnlen)800, (ftnlen)363); - s_copy(messge + 48800, "Variable not in NAMELIST group. A variable n" - "ame was encountered in the input stream which was not declar" - "ed as part of the current NAMELIST group. Check input data w" - "ith NAMELIST group declaration for differences. Format error" - ": Invalid format descriptor. Format descriptor did not begin" - " with a character that can start a legal format descriptor. " - "Specify correct format descriptor. ", (ftnlen)800, (ftnlen) - 379); - s_copy(messge + 49600, "Unexpected character found following a numbe" - "r in the format string. Format error: Character in the set " - "IFEDGMNK@OLAR(PHX expected and not found. Specify correct fo" - "rmat descriptor to follow number. or NAMELIST I/O attempted " - "on unformatted file1 An illegal NAMELIST I/O operation was a" - "ttempted on an unformatted file. OPEN file with FORM='FORMAT" - "TED'. ", (ftnlen)800, (ftnlen)350); - s_copy(messge + 50400, "Format error: Trying to scale unscalable for" - "mat specifier. The specifier being scaled is not \"F\", \"" - "E\", \"D\", \"M\", \"N\", or \"G\". Scale only specifiers fo" - "r floating-point I/O. or COUNT exceeds buffer length in ENCO" - "DE/DECODE1 The count of characters to be transferred exceeds" - " the internal buffer length. Either transfer fewer character" - "s or use a larger buffer. ", (ftnlen)800, (ftnlen)356); - s_copy(messge + 51200, "Format error: Parentheses too deeply nested." - " Too many left parentheses for the format processor to stack" - ". Nest parentheses less deeply. ", (ftnlen)800, (ftnlen)136); - s_copy(messge + 52000, "Format error: Invalid tab specifier. A speci" - "fier beginning with \"T\" is not a correct tab specifier. Co" - "rrect the specifier beginning with \"T\". ", (ftnlen)800, ( - ftnlen)142); - s_copy(messge + 52800, "Format error: Invalid blank specifier. A spe" - "cifier beginning with \"B\" did not have \"N\" or \"Z\" as t" - "he next character. Correct the specifier beginning with \"" - "B\". ", (ftnlen)800, (ftnlen)159); - s_copy(messge + 53600, "Format error: Specifier expected but end of " - "format found. The end of the format was reached when another" - " specifier was expected. Check the end of the format for a c" - "ondition that would lead the processor to look for another s" - "pecifier (possibly a missing right parenthesis). ", (ftnlen) - 800, (ftnlen)273); - s_copy(messge + 54400, "Format error: Missing separator. Other speci" - "fier found when /, :, or ) expected. Insert separator where " - "needed. ", (ftnlen)800, (ftnlen)112); - s_copy(messge + 55200, "Format error: Digit expected. Number not fou" - "nd following format descriptor requiring a field width. Spec" - "ify field width where required. ", (ftnlen)800, (ftnlen)136); - s_copy(messge + 56000, "Format error: Period expected in floating po" - "int format descriptor. No period was found to specify the nu" - "mber of decimal places in an \"F\", \"G\", \"E\", or \"D\" f" - "ormat descriptor. Specify the number of decimal places for t" - "he field. ", (ftnlen)800, (ftnlen)226); - s_copy(messge + 56800, "Format error: Unbalanced parentheses. More r" - "ight parentheses than left parentheses were found. Correct f" - "ormat so parentheses balance. ", (ftnlen)800, (ftnlen)134); - s_copy(messge + 57600, "Format error: Invalid string in format. Stri" - "ng extends past the end of the format or is too long for buf" - "fer. Check for unbalanced quotation mark or for \"H\" format" - " count too large; or break up long string. ", (ftnlen)800, ( - ftnlen)205); - s_copy(messge + 58400, "Record length different in subsequent OPEN. " - "Record length specified in redundant OPEN conflicted with th" - "e value as opened. Only BLANK= specifier may be changed by a" - " redundant OPEN. ", (ftnlen)800, (ftnlen)181); - s_copy(messge + 59200, "Record accessed past end of internal file re" - "cord (variable). An attempt was made to transfer more charac" - "ters than internal file length. Match READ or WRITE with int" - "ernal file size. ", (ftnlen)800, (ftnlen)181); - s_copy(messge + 60000, "Illegal new file number requested in fset fu" - "nction. The file number requested to be set was not a legal " - "file system file number. Check that the OPEN succeeded and t" - "he file number is correct. ", (ftnlen)800, (ftnlen)191); - s_copy(messge + 60800, "Unexpected character in \"NAMELIST\" read. A" - "n illegal character was found in NAMELIST-directed input. Be" - " sure input data conforms to the syntax rules for \"NAMELIS" - "T\"-directed input; remove illegal character from data. ", ( - ftnlen)800, (ftnlen)215); - s_copy(messge + 61600, "Illegal subscript or substring in \"NAMELIS" - "T\" read. An invalid subscript or substring specifier was fo" - "und in NAMELIST-directed input. Possible causes: bad synta" - "x, subscript/substring component out-of-bounds, wrong number" - " of subscripts, substring on non-CHARACTER variable. Check i" - "nput data for syntax errors. Be sure subscript/substring sp" - "ecifiers are correct for data type; specify only array eleme" - "nts within the bounds of the array being read. ", (ftnlen)800, - (ftnlen)448); - s_copy(messge + 62400, "Too many values in \"NAMELIST\" read. Too ma" - "ny input values were found during a NAMELIST-directed READ. " - "This message will be generated by attempts to fill variables" - " beyond their memory limits. Supply only as many values as t" - "he length of the array. ", (ftnlen)800, (ftnlen)246); - s_copy(messge + 63200, "Variable not in \"NAMELIST\" group. A variab" - "le name was encountered in the input stream which was not de" - "clared as part of the current NAMELIST group. Read only the " - "variables in this NAMELIST. ", (ftnlen)800, (ftnlen)190); - s_copy(messge + 64000, "\"NAMELIST\" I/O attempted on unformatted fi" - "le. An illegal NAMELIST I/O operation was attempted on an un" - "formatted (binary) file. OPEN file with FORM='FORMATTED'; us" - "e NAMELIST I/O only on formatted files. ", (ftnlen)800, ( - ftnlen)202); - s_copy(messge + 64800, "Value out of range in numeric read. Value re" - "ad for the numeric item is too big or too small. Read only t" - "he values that fit in the range of the numeric type being re" - "ad. ", (ftnlen)800, (ftnlen)168); - s_copy(messge + 65600, "The value of IOSTAT was 982. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 66400, "The value of IOSTAT was 983. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 67200, "The value of IOSTAT was 984. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 68000, "The value of IOSTAT was 985. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 68800, "The value of IOSTAT was 986. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 69600, "The value of IOSTAT was 987. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 70400, "The value of IOSTAT was 988. No explanation" - " is provided in the HP documentation for this value of IOSTA" - "T. ", (ftnlen)800, (ftnlen)107); - s_copy(messge + 71200, "`Illegal FORTRAN NLS call: FORTRAN source co" - "de must be compiled with -Y. The FORTRAN source file was not" - " compiled with the -Y option and NLS features were used. The" - " problem is critical enough that program execution cannot co" - "ntinue. ", (ftnlen)800, (ftnlen)232); - } else if (sgi) { - lbnd = 99; - ubnd = 169; - s_copy(messge, "error in format ", (ftnlen)800, (ftnlen)16); - s_copy(messge + 800, "out of space for unit table ", (ftnlen)800, ( - ftnlen)28); - s_copy(messge + 1600, "formatted i/o not allowed ", (ftnlen)800, ( - ftnlen)26); - s_copy(messge + 2400, "unformatted i/o not allowed ", (ftnlen)800, ( - ftnlen)28); - s_copy(messge + 3200, "direct i/o not allowed ", (ftnlen)800, (ftnlen) - 23); - s_copy(messge + 4000, "sequential i/o not allowed ", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 4800, "can't backspace file ", (ftnlen)800, (ftnlen) - 21); - s_copy(messge + 5600, "null file name ", (ftnlen)800, (ftnlen)15); - s_copy(messge + 6400, "can't stat file ", (ftnlen)800, (ftnlen)16); - s_copy(messge + 7200, "unit not connected ", (ftnlen)800, (ftnlen)19); - s_copy(messge + 8000, "off end of record ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 8800, "truncation failed in end file ", (ftnlen)800, ( - ftnlen)30); - s_copy(messge + 9600, "incomprehensible list input ", (ftnlen)800, ( - ftnlen)28); - s_copy(messge + 10400, "out of free space ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 11200, "unit not connected ", (ftnlen)800, (ftnlen)19) - ; - s_copy(messge + 12000, "read unexpected character ", (ftnlen)800, ( - ftnlen)26); - s_copy(messge + 12800, "blank logical input field ", (ftnlen)800, ( - ftnlen)26); - s_copy(messge + 13600, "bad variable type ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 14400, "bad namelist name ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 15200, "variable not in namelist ", (ftnlen)800, ( - ftnlen)25); - s_copy(messge + 16000, "no end record ", (ftnlen)800, (ftnlen)14); - s_copy(messge + 16800, "namelist subscript out of range ", (ftnlen) - 800, (ftnlen)32); - s_copy(messge + 17600, "negative repeat count ", (ftnlen)800, (ftnlen) - 22); - s_copy(messge + 18400, "illegal operation for unit ", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 19200, "off beginning of record ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 20000, "no * after repeat count ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 20800, "'new' file exists ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 21600, "can't find 'old' file ", (ftnlen)800, (ftnlen) - 22); - s_copy(messge + 22400, "unknown system error ", (ftnlen)800, (ftnlen) - 21); - s_copy(messge + 23200, "requires seek ability ", (ftnlen)800, (ftnlen) - 22); - s_copy(messge + 24000, "illegal argument ", (ftnlen)800, (ftnlen)17); - s_copy(messge + 24800, "duplicate key value on write ", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 25600, "indexed file not open ", (ftnlen)800, (ftnlen) - 22); - s_copy(messge + 26400, "bad isam argument ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 27200, "bad key description ", (ftnlen)800, (ftnlen) - 20); - s_copy(messge + 28000, "too many open indexed files ", (ftnlen)800, ( - ftnlen)28); - s_copy(messge + 28800, "corrupted isam file ", (ftnlen)800, (ftnlen) - 20); - s_copy(messge + 29600, "isam file not opened for exclusive access ", ( - ftnlen)800, (ftnlen)42); - s_copy(messge + 30400, "record locked ", (ftnlen)800, (ftnlen)14); - s_copy(messge + 31200, "key already exists ", (ftnlen)800, (ftnlen)19) - ; - s_copy(messge + 32000, "cannot delete primary key ", (ftnlen)800, ( - ftnlen)26); - s_copy(messge + 32800, "beginning or end of file reached ", (ftnlen) - 800, (ftnlen)33); - s_copy(messge + 33600, "cannot find requested record ", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 34400, "current record not defined ", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 35200, "isam file is exclusively locked ", (ftnlen) - 800, (ftnlen)32); - s_copy(messge + 36000, "filename too long ", (ftnlen)800, (ftnlen)18); - s_copy(messge + 36800, "cannot create lock file ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 37600, "record too long ", (ftnlen)800, (ftnlen)16); - s_copy(messge + 38400, "key structure does not match file structure ", - (ftnlen)800, (ftnlen)44); - s_copy(messge + 39200, "direct access on an indexed file not allowed " - , (ftnlen)800, (ftnlen)45); - s_copy(messge + 40000, "keyed access on a sequential file not allowe" - "d ", (ftnlen)800, (ftnlen)46); - s_copy(messge + 40800, "keyed access on a relative file not allowed ", - (ftnlen)800, (ftnlen)44); - s_copy(messge + 41600, "append access on an indexed file not allowed " - , (ftnlen)800, (ftnlen)45); - s_copy(messge + 42400, "must specify record length ", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 43200, "key field value type does not match key type " - , (ftnlen)800, (ftnlen)45); - s_copy(messge + 44000, "character key field value length too long ", ( - ftnlen)800, (ftnlen)42); - s_copy(messge + 44800, "fixed record on sequential file not allowed ", - (ftnlen)800, (ftnlen)44); - s_copy(messge + 45600, "variable records allowed only on unformatted" - " sequential file ", (ftnlen)800, (ftnlen)61); - s_copy(messge + 46400, "stream records allowed only on formatted seq" - "uential file ", (ftnlen)800, (ftnlen)57); - s_copy(messge + 47200, "maximum number of records in direct access f" - "ile exceeded ", (ftnlen)800, (ftnlen)57); - s_copy(messge + 48000, "attempt to write to a readonly file ", ( - ftnlen)800, (ftnlen)36); - s_copy(messge + 48800, "must specify key descriptions ", (ftnlen)800, - (ftnlen)30); - s_copy(messge + 49600, "carriage control not allowed for unformatted" - " units ", (ftnlen)800, (ftnlen)51); - s_copy(messge + 50400, "indexed files only ", (ftnlen)800, (ftnlen)19) - ; - s_copy(messge + 51200, "cannot use on indexed file ", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 52000, "cannot use on indexed or append file ", ( - ftnlen)800, (ftnlen)37); - s_copy(messge + 52800, "error in closing file ", (ftnlen)800, (ftnlen) - 22); - s_copy(messge + 53600, "invalid code in format specification ", ( - ftnlen)800, (ftnlen)37); - s_copy(messge + 54400, "invalid record number in direct access file ", - (ftnlen)800, (ftnlen)44); - s_copy(messge + 55200, "cannot have endfile record on non-sequential" - " file ", (ftnlen)800, (ftnlen)50); - } else if (vax) { - lbnd = 0; - ubnd = 68; - s_copy(messge, "Not a Fortran-specific error. ", (ftnlen)800, (ftnlen) - 30); - s_copy(messge + 800, "No diagnostics are available other than the va" - "lue of IOSTAT is 2 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 1600, "No diagnostics are available other than the v" - "alue of IOSTAT is 3 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 2400, "No diagnostics are available other than the v" - "alue of IOSTAT is 4 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 3200, "No diagnostics are available other than the v" - "alue of IOSTAT is 5 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 4000, "No diagnostics are available other than the v" - "alue of IOSTAT is 6 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 4800, "No diagnostics are available other than the v" - "alue of IOSTAT is 7 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 5600, "No diagnostics are available other than the v" - "alue of IOSTAT is 8 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 6400, "No diagnostics are available other than the v" - "alue of IOSTAT is 9 ", (ftnlen)800, (ftnlen)65); - s_copy(messge + 7200, "No diagnostics are available other than the v" - "alue of IOSTAT is 10 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 8000, "No diagnostics are available other than the v" - "alue of IOSTAT is 11 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 8800, "No diagnostics are available other than the v" - "alue of IOSTAT is 12 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 9600, "No diagnostics are available other than the v" - "alue of IOSTAT is 13 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 10400, "No diagnostics are available other than the " - "value of IOSTAT is 14 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 11200, "No diagnostics are available other than the " - "value of IOSTAT is 15 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 12000, "No diagnostics are available other than the " - "value of IOSTAT is 16 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 12800, "Syntax error in NAMELIST input. ", (ftnlen) - 800, (ftnlen)32); - s_copy(messge + 13600, "Too many values for NAMELIST variable. ", ( - ftnlen)800, (ftnlen)39); - s_copy(messge + 14400, "Invalid reference to variable in NAMELIST in" - "put. ", (ftnlen)800, (ftnlen)49); - s_copy(messge + 15200, "REWIND error. ", (ftnlen)800, (ftnlen)14); - s_copy(messge + 16000, "Duplicate file specifications. ", (ftnlen)800, - (ftnlen)31); - s_copy(messge + 16800, "Input record too long. ", (ftnlen)800, ( - ftnlen)23); - s_copy(messge + 17600, "BACKSPACE error ", (ftnlen)800, (ftnlen)16); - s_copy(messge + 18400, "End-of-file during read. ", (ftnlen)800, ( - ftnlen)25); - s_copy(messge + 19200, "Record number outside range. ", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 20000, "OPEN or DEFINE FILE required. ", (ftnlen)800, - (ftnlen)30); - s_copy(messge + 20800, "Too many records in IO statement. ", (ftnlen) - 800, (ftnlen)34); - s_copy(messge + 21600, "CLOSE error. ", (ftnlen)800, (ftnlen)13); - s_copy(messge + 22400, "File not found. ", (ftnlen)800, (ftnlen)16); - s_copy(messge + 23200, "Open failure. ", (ftnlen)800, (ftnlen)14); - s_copy(messge + 24000, "Mixed file access modes. ", (ftnlen)800, ( - ftnlen)25); - s_copy(messge + 24800, "Invalid logical unit number. ", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 25600, "ENDFILE error. ", (ftnlen)800, (ftnlen)15); - s_copy(messge + 26400, "Unit already open. ", (ftnlen)800, (ftnlen)19) - ; - s_copy(messge + 27200, "Segmented record format error. ", (ftnlen)800, - (ftnlen)31); - s_copy(messge + 28000, "Attempt to access non-existent record. ", ( - ftnlen)800, (ftnlen)39); - s_copy(messge + 28800, "Inconsistent record length. ", (ftnlen)800, ( - ftnlen)28); - s_copy(messge + 29600, "Error during write. ", (ftnlen)800, (ftnlen) - 20); - s_copy(messge + 30400, "Error during read. ", (ftnlen)800, (ftnlen)19) - ; - s_copy(messge + 31200, "Recursive IO operation. ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 32000, "Insufficient virtual memory. ", (ftnlen)800, ( - ftnlen)29); - s_copy(messge + 32800, "No such device. ", (ftnlen)800, (ftnlen)16); - s_copy(messge + 33600, "File name specification error. ", (ftnlen)800, - (ftnlen)31); - s_copy(messge + 34400, "Inconsistent record type. ", (ftnlen)800, ( - ftnlen)26); - s_copy(messge + 35200, "Keyword value error in OPEN statement. ", ( - ftnlen)800, (ftnlen)39); - s_copy(messge + 36000, "Inconsistent OPENCLOSE parameters. ", (ftnlen) - 800, (ftnlen)35); - s_copy(messge + 36800, "Write to READONLY file. ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 37600, "Invalid argument to Fortran Run-Time Library" - ". ", (ftnlen)800, (ftnlen)46); - s_copy(messge + 38400, "Invalid key specification. ", (ftnlen)800, ( - ftnlen)27); - s_copy(messge + 39200, "Inconsistent key change or duplicate key. ", ( - ftnlen)800, (ftnlen)42); - s_copy(messge + 40000, "Inconsistent file organization. ", (ftnlen) - 800, (ftnlen)32); - s_copy(messge + 40800, "Specified record locked. ", (ftnlen)800, ( - ftnlen)25); - s_copy(messge + 41600, "No current record. ", (ftnlen)800, (ftnlen)19) - ; - s_copy(messge + 42400, "REWRITE error. ", (ftnlen)800, (ftnlen)15); - s_copy(messge + 43200, "DELETE error. ", (ftnlen)800, (ftnlen)14); - s_copy(messge + 44000, "UNLOCK error. ", (ftnlen)800, (ftnlen)14); - s_copy(messge + 44800, "FIND error. ", (ftnlen)800, (ftnlen)12); - s_copy(messge + 45600, "No diagnostics are available other than the " - "value of IOSTAT is 58 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 46400, "List-directed IO syntax error. ", (ftnlen)800, - (ftnlen)31); - s_copy(messge + 47200, "Infinite format loop. ", (ftnlen)800, (ftnlen) - 22); - s_copy(messge + 48000, "Formatvariable-type mismatch. ", (ftnlen)800, - (ftnlen)30); - s_copy(messge + 48800, "Syntax error in format. ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 49600, "Output conversion error. ", (ftnlen)800, ( - ftnlen)25); - s_copy(messge + 50400, "Input conversion error. ", (ftnlen)800, ( - ftnlen)24); - s_copy(messge + 51200, "No diagnostics are available other than the " - "value of IOSTAT is 65 ", (ftnlen)800, (ftnlen)66); - s_copy(messge + 52000, "Output statement overflows record. ", (ftnlen) - 800, (ftnlen)35); - s_copy(messge + 52800, "Input statement requires too much data. ", ( - ftnlen)800, (ftnlen)40); - s_copy(messge + 53600, "Variable format expression value error. ", ( - ftnlen)800, (ftnlen)40); - } else if (pc) { - lbnd = 2; - ubnd = 1; - } else { - lbnd = 2; - ubnd = 1; - } - if (*iostat > lbnd && *iostat <= ubnd) { - s_copy(diagns, messge + ((i__1 = *iostat - lbnd - 1) < 90 && 0 <= - i__1 ? i__1 : s_rnge("messge", i__1, "dcyphr_", (ftnlen)1120)) - * 800, diagns_len, (ftnlen)800); - *found = TRUE_; - } else { - s_copy(diagns, "The value of IOSTAT was #. The meaning of this valu" - "e is not available via the SPICE system. Please consult your" - " FORTRAN manual for the meaning of this code.", diagns_len, ( - ftnlen)157); - repmi_(diagns, "#", iostat, diagns, diagns_len, (ftnlen)1, diagns_len) - ; - *found = FALSE_; - } - return 0; -} /* dcyphr_ */ - diff --git a/ext/spice/src/csupport/dimcb_1.c b/ext/spice/src/csupport/dimcb_1.c deleted file mode 100644 index 926657635c..0000000000 --- a/ext/spice/src/csupport/dimcb_1.c +++ /dev/null @@ -1,163 +0,0 @@ -/* dimcb_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure DIMCB ( Dimension of character buffer ) */ -integer dimcb_1__(char *buffer, ftnlen buffer_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), dechar_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - integer dim; - -/* $ Abstract */ - -/* Return the dimension of a character buffer. */ - -/* $ 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 */ - -/* CB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BUFFER I Character buffer. */ - -/* $ Detailed_Input */ - -/* BUFFER is a character buffer. */ - -/* $ Detailed_Output */ - -/* The function returns the dimension of the character buffer */ -/* (as established by a previous call to CBINIT). */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* The dimension of a character buffer is multiplied by the */ -/* length of the individual elements in the buffer array to */ -/* give the total size of the buffer. */ - -/* $ Examples */ - -/* The code fragment */ - -/* INTEGER LBCBUF */ -/* PARAMETER ( LBCBUF = 0 ) */ - -/* INTEGER DIMCB */ -/* INTEGER SIZECB */ -/* CHARACTER*100 BUFFER ( LBCBUF:200 ) */ - -/* CALL CBINIT ( 200, BUFFER ) */ - -/* WRITE (*,*) DIMCB ( BUFFER ), ' elements at ' */ -/* WRITE (*,*) LEN ( BUFFER(1) ), ' characters each totals ' */ -/* WRITE (*,*) SIZECB ( BUFFER ), ' characters of storage.' */ - -/* produces the following output. */ - -/* 200 elements at */ -/* 100 characters each totals */ -/* 200000 characters of storage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* Beta Version 1.1.0, 28-Dec-1994 (WLT) */ - -/* Gave DIMCB_1 an initial value of zero so that the function */ -/* will have a value when it returns even if an error is */ -/* signalled. */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Give the function an initial value even if it is bogus in the */ -/* event that we are in RETURN mode. */ - - ret_val = 0; - -/* Standard error handling. */ - - if (return_()) { - return ret_val; - } else { - chkin_("DIMCB_1", (ftnlen)7); - } - -/* Only the first eight bytes are used. */ - - dechar_(buffer, &dim, (ftnlen)8); - ret_val = dim; - chkout_("DIMCB_1", (ftnlen)7); - return ret_val; -} /* dimcb_1__ */ - diff --git a/ext/spice/src/csupport/dspvrs.c b/ext/spice/src/csupport/dspvrs.c deleted file mode 100644 index b9dfa6e00e..0000000000 --- a/ext/spice/src/csupport/dspvrs.c +++ /dev/null @@ -1,151 +0,0 @@ -/* dspvrs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure DSPVRS ( Display Version ) */ -/* Subroutine */ int dspvrs_(char *pname, char *vrsn, ftnlen pname_len, - ftnlen vrsn_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char line[80]; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen), tostdo_(char *, ftnlen), tkvrsn_(char *, char *, ftnlen, - ftnlen); - char tkv[8]; - -/* $ Abstract */ - -/* This routine displays the name of a program as well as its */ -/* version and the version of SPICELIB that the calling */ -/* program has been linked with. */ - -/* $ 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 */ - -/* UTITITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PNAME I The name of the calling program */ -/* VRSN I The version number of the calling program */ - -/* $ Detailed_Input */ - -/* PNAME is the name of the calling program */ - -/* VRSN is the version number of the calling program */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a utility routine for printing the name and */ -/* version number of a program as well as the identifier */ -/* of the SPICELIB library that was used in linking */ -/* the program. */ - -/* The following template is filled out and then displayed */ -/* at standard output. */ - -/* --- Version , SPICE Toolkit */ - -/* $ Examples */ - -/* Suppose you are creating an program called "DoIt" */ -/* and you would like to have the name and current version */ -/* of the program displayed along with the linked version */ -/* of SPICELIB at some point in the execution of the program, */ -/* Here is how you can use this routine to perform the */ -/* version display function. */ - -/* CALL DSPVRS ( 'DoIt', '1.0.0' ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 26-SEP-1997 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Print a version line */ - -/* -& */ - tkvrsn_("toolkit", tkv, (ftnlen)7, (ftnlen)8); - s_copy(line, pname, (ftnlen)80, pname_len); - suffix_("Version", &c__1, line, (ftnlen)7, (ftnlen)80); - suffix_(vrsn, &c__1, line, vrsn_len, (ftnlen)80); - suffix_(", SPICE Toolkit", &c__0, line, (ftnlen)15, (ftnlen)80); - suffix_(tkv, &c__1, line, (ftnlen)8, (ftnlen)80); - tostdo_(line, (ftnlen)80); - return 0; -} /* dspvrs_ */ - diff --git a/ext/spice/src/csupport/echo.c b/ext/spice/src/csupport/echo.c deleted file mode 100644 index 153187be1e..0000000000 --- a/ext/spice/src/csupport/echo.c +++ /dev/null @@ -1,335 +0,0 @@ -/* echo.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__3 = 3; -static logical c_true = TRUE_; - -/* $Procedure ECHO ( Echo the translation of a string ) */ -/* Subroutine */ int echo_0_(int n__, char *string, char *transl, ftnlen - string_len, ftnlen transl_len) -{ - /* Initialized data */ - - static logical doit = FALSE_; - static logical first = TRUE_; - - /* System generated locals */ - address a__1[3], a__2[2]; - integer i__1[3], i__2[2]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char lead[3], hide[80], flag__[3], seen[80], dont[32]; - static logical wipe, stat[3]; - static char delim[1]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - nthwd_(char *, integer *, char *, integer *, ftnlen, ftnlen); - static char style[80], cdelim[1]; - extern /* Subroutine */ int getdel_(char *, ftnlen); - static char repeat[32], scndwd[32], thrdwd[32]; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen), nspioh_(char *, ftnlen), nsplog_(char *, logical *, - ftnlen), trnlat_(char *, char *, ftnlen, ftnlen); - static char hstyle[80], frstwd[32]; - extern /* Subroutine */ int nspmrg_(char *, ftnlen), nspgls_(char *, char - *, char *, ftnlen, ftnlen, ftnlen), nsplgs_(char *, char *, char * - , ftnlen, ftnlen, ftnlen), nspgst_(char *, logical *, ftnlen); - extern /* Subroutine */ int nspwln_(); - extern /* Subroutine */ int nsppst_(char *, logical *, ftnlen); - static integer loc; - extern /* Subroutine */ int nicepr_1__(char *, char *, U_fp, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* Echo a string if echoing is enabled and a string has been */ -/* translated from its original value. */ - -/* $ 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 */ - -/* Command Loop */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I is a string */ -/* TRANSL I is string after some kind of processing */ - -/* $ Detailed_Input */ - -/* STRING is a string. The intent is that this is some string */ -/* that the user has specified as a command to a program */ -/* and that may be subject to some kind of preprocessing */ -/* such as symbol resolution. */ - -/* TRANSL is the string that results from some user's action on */ -/* the input STRING. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a utility routine for the command loop system. */ - -/* If as the result of preprocessing a command, some modificactions */ -/* are created it is sometimes helpful to see the result */ -/* of these translations. */ - -/* If the echoing is enabled (via the entry point DOECHO) and */ -/* TRANSL is not the same as STRING. The translation will */ -/* be echoed to the user's output device and to the user's log */ -/* file. */ - -/* This routine has 3 companion entry points. */ - -/* DOECHO --- enables echoing of commands. */ -/* NOECHO --- disables echoing of commands. */ -/* GTECHO --- returns 'YES' if echoing is enabled 'NO' */ -/* otherwise. */ - -/* By default echoing is disabled. */ - -/* $ Examples */ - -/* Suppose that as a result of symbol resolution the */ -/* command */ - -/* "DOIT" */ - -/* becomes */ - -/* SELECT A, B, C, FROM TABLE WHERE A < B AND B < C */ -/* AND C < A ORDER BY A B C */ - - -/* If echoing has been enabled the text below will be sent */ -/* to the user's screen and log file: */ - -/* ;;; SELECT A, B, C, FROM TABLE WHERE A < B AND B < C AND */ -/* ; C < A ORDER BY A B C ' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 28-JUL-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Echo translated commands. */ - -/* -& */ - switch(n__) { - case 1: goto L_doecho; - case 2: goto L_noecho; - case 3: goto L_gtecho; - } - - if (first) { - -/* Find out what the words for NO and ECHO are */ -/* in the current language. */ - - first = FALSE_; - trnlat_("DONT", dont, (ftnlen)4, (ftnlen)32); - trnlat_("ECHO", repeat, (ftnlen)4, (ftnlen)32); - } - nthwd_(transl, &c__1, frstwd, &loc, transl_len, (ftnlen)32); - nthwd_(transl, &c__2, scndwd, &loc, transl_len, (ftnlen)32); - nthwd_(transl, &c__3, thrdwd, &loc, transl_len, (ftnlen)32); - ucase_(frstwd, frstwd, (ftnlen)32, (ftnlen)32); - ucase_(scndwd, scndwd, (ftnlen)32, (ftnlen)32); - ucase_(thrdwd, thrdwd, (ftnlen)32, (ftnlen)32); - if (s_cmp(frstwd, repeat, (ftnlen)32, (ftnlen)32) == 0 && s_cmp(scndwd, - " ", (ftnlen)32, (ftnlen)1) == 0) { - wipe = TRUE_; - doit = TRUE_; - } else if (s_cmp(frstwd, dont, (ftnlen)32, (ftnlen)32) == 0 && s_cmp( - scndwd, repeat, (ftnlen)32, (ftnlen)32) == 0 && s_cmp(thrdwd, - " ", (ftnlen)32, (ftnlen)1) == 0) { - wipe = TRUE_; - doit = FALSE_; - } else { - wipe = FALSE_; - } - if (doit) { - if (s_cmp(string, transl, string_len, transl_len) != 0) { - -/* Get the current margins and the delimiter. */ - - nspmrg_(style, (ftnlen)80); - getdel_(delim, (ftnlen)1); - -/* Create the NICEIO style string it will be of the form */ - -/* LEFT 1 RIGHT margin FLAG ;;; LEADER ; */ - -/* (provided of course that ';' is the command */ - -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = delim; - i__1[1] = 1, a__1[1] = delim; - i__1[2] = 1, a__1[2] = delim; - s_cat(flag__, a__1, i__1, &c__3, (ftnlen)3); -/* Writing concatenation */ - i__2[0] = 1, a__2[0] = delim; - i__2[1] = 2, a__2[1] = "++"; - s_cat(lead, a__2, i__2, &c__2, (ftnlen)3); - prefix_(lead, &c__1, style, (ftnlen)3, (ftnlen)80); - prefix_("LEADER ", &c__1, style, (ftnlen)7, (ftnlen)80); - prefix_(flag__, &c__1, style, (ftnlen)3, (ftnlen)80); - prefix_("FLAG", &c__1, style, (ftnlen)4, (ftnlen)80); - -/* Get the current status of the "log" port and */ -/* for the moment inhibit writing to that port. */ - - nspgst_("LOG", stat, (ftnlen)3); - nspioh_("LOG", (ftnlen)3); - -/* Display the translated string. */ - - nicepr_1__(transl, style, (U_fp)nspwln_, transl_len, (ftnlen)80); - -/* Now re-establish the status of the log port. */ - - nsppst_("LOG", stat, (ftnlen)3); - -/* Send the translated string to the log file and */ -/* do it so that it is a comment in the log file. */ -/* Note that we use a special logging style for */ -/* echoing the symbol translation. */ - - s_copy(hstyle, "LEFT 1 RIGHT 78 ", (ftnlen)80, (ftnlen)16); - prefix_(lead, &c__1, hstyle, (ftnlen)3, (ftnlen)80); - prefix_("LEADER ", &c__1, hstyle, (ftnlen)7, (ftnlen)80); - prefix_(flag__, &c__1, hstyle, (ftnlen)3, (ftnlen)80); - prefix_("FLAG", &c__1, hstyle, (ftnlen)4, (ftnlen)80); - nspgls_(seen, hide, cdelim, (ftnlen)80, (ftnlen)80, (ftnlen)1); - nsplgs_(seen, hstyle, cdelim, (ftnlen)80, (ftnlen)80, (ftnlen)1); - nsplog_(transl, &c_true, transl_len); - nsplgs_(seen, hide, cdelim, (ftnlen)80, (ftnlen)80, (ftnlen)1); - } - } - if (wipe) { - s_copy(transl, " ", transl_len, (ftnlen)1); - } - return 0; - -/* The following entry points allow you to */ - -/* 1) Enable echoing of translations */ -/* 2) Disable echoing of translations */ -/* 3) Find out the current status of echoing. */ - -/* Since the code in each case is trivial, we aren't */ -/* going to set up those big old nasty NAIF headers. */ -/* (What a rebel!) */ - - -L_doecho: - doit = TRUE_; - return 0; - -L_noecho: - doit = FALSE_; - return 0; - -L_gtecho: - if (doit) { - s_copy(string, "ENABLED", string_len, (ftnlen)7); - } else { - s_copy(string, "DISABLED", string_len, (ftnlen)8); - } - return 0; -} /* echo_ */ - -/* Subroutine */ int echo_(char *string, char *transl, ftnlen string_len, - ftnlen transl_len) -{ - return echo_0_(0, string, transl, string_len, transl_len); - } - -/* Subroutine */ int doecho_(void) -{ - return echo_0_(1, (char *)0, (char *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int noecho_(void) -{ - return echo_0_(2, (char *)0, (char *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int gtecho_(char *string, ftnlen string_len) -{ - return echo_0_(3, string, (char *)0, string_len, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/edtcmd.c b/ext/spice/src/csupport/edtcmd.c deleted file mode 100644 index 282530c1d5..0000000000 --- a/ext/spice/src/csupport/edtcmd.c +++ /dev/null @@ -1,352 +0,0 @@ -/* edtcmd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure EDTCMD ( Edit a file using a specified text editor ) */ -/* Subroutine */ int edtcmd_(char *cmd, char *file, ftnlen cmd_len, ftnlen - file_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - char loccmd[255]; - extern /* Subroutine */ int chkout_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int exesys_(char *, ftnlen); - -/* $ Abstract */ - -/* Edit a file using a specified editor. */ - -/* $ 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 */ - -/* SYSTEM */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CMD I Command string used to invoke editor. */ -/* FILE I Name of file to edit. */ - -/* $ Detailed_Input */ - -/* CMD is a character string containing the command */ -/* used to invoke a text editor available on the */ -/* system under which the calling program is running. */ -/* This routine will invoke the specified editor */ -/* using FILE as the target file to edit. The name */ -/* of the file to be edited is not included in the */ -/* command; this name is input as a separate argument. */ - -/* Case sensitivity of CMD varies with the system on */ -/* which the calling program is run. */ - -/* Trailing white space in CMD is not significant. */ - - -/* FILE is the name of a file that is to be edited. FILE */ -/* need not exist at the time this routine is called. */ - -/* Case sensitivity of FILE varies with the system on */ -/* which the calling program is run. */ - -/* Trailing white space in FILE is not significant. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for further information on the action of */ -/* this routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified edit command fails, the error will be */ -/* diagnosed by routines called by this routine. */ - -/* 2) If the editing session started by this routine is terminated */ -/* abnormally, the effect on the operation of the calling program */ -/* is unspecified. */ - -/* $ Files */ - -/* See $Particulars. */ - -/* $ Particulars */ - -/* This routine should be used with caution; calls to this routine */ -/* may have unintended side effects on the operation of the calling */ -/* program. A solid understanding of the global operation of the */ -/* calling program is a prerequisite for programmers wishing to */ -/* use this routine. */ - -/* The input argument FILE should unambiguously designate a file */ -/* that can be edited by the specified editor on the system under */ -/* which the calling program is being run. The calling program */ -/* should have read or write privileges consistent with the intended */ -/* mode of access to FILE. */ - -/* This routine may fail to recover in a predictable fashion from */ -/* abnormal termination of an editing session. */ - -/* $ Examples */ - -/* 1) On a VAX/VMS system, the EDT editor could be invoked by */ -/* the calls */ - -/* CALL EDTCMD ( 'EDIT/EDT', FILE ) */ - -/* or */ - -/* CALL EDTCMD ( 'EDIT/EDT/COMMAND = ', FILE ) */ - - -/* 2) On a Unix system, the emacs editor could be invoked */ -/* (normally) by the calls */ - -/* CALL EDTCMD ( 'emacs', FILE ) */ - -/* or */ - -/* CALL EDTCMD ( '/usr/bin/emacs', FILE ) */ - - -/* $ Restrictions */ - -/* 1) The means by which this routine invokes an editor are system- */ -/* dependent; invoking the editor may have side effects that */ -/* affect the operation of the calling program. For example, */ -/* on Unix systems, this routine may start a new shell in which */ -/* to run the editor; starting a new shell may interfere with */ -/* any sequential file I/O in progress at the time the shell is */ -/* started. */ - -/* See the code for implementation details. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 2.22.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - Beta Version 2.21.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - Beta Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - Beta Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - Beta Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - Beta Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - Beta Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - Beta Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - Beta Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - Beta Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - Beta Version 2.12.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - Beta Version 2.11.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - Beta Version 2.10.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - Beta Version 2.9.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - Beta Version 2.8.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - Beta Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - Beta Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - Beta Version 2.5.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - Beta Version 2.4.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - Beta Version 2.3.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - Beta Version 2.2.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - Beta Version 2.2.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - Beta Version 2.2.3, 20-SEP-1999 (NJB) */ - -/* CSPICE and PC-LINUX environment lines were added. Some */ -/* typos were corrected. */ - -/* - Beta Version 2.2.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - Beta Version 2.2.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - Beta Version 2.2.0, 12-AUG-1996 (WLT) */ - -/* Added DEC-OSF1 to the list of supported environments */ - -/* - Beta Version 2.1.0, 10-JAN-1996 (WLT) */ - -/* Added PC-LAHEY to the list of supported environments. */ - -/* - Beta Version 2.0.0, 16-JUN-1995 (WLT)(HAN) */ - -/* Created master file from collection of machine dependent */ -/* routines. Copyright notice added. */ - -/* - Beta Version 1.0.0, 16-AUG-1994 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* invoke a text editor within a program */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EDTCMD", (ftnlen)6); - } -/* VAX: */ - -/* Computer: VAX 11/780 */ -/* Operating System: VAX VMS 5.3 */ -/* Fortran: VAX FORTRAN 5.5 */ - - -/* PC-MS: */ - -/* Computer: PC */ -/* Operating System: Microsoft DOS 5.00 */ -/* Fortran: Microsoft Powerstation Fortran V1.0 */ - - -/* Build the edit command to be passed to the system. */ - - s_copy(loccmd, cmd, (ftnlen)255, cmd_len); - suffix_(file, &c__1, loccmd, file_len, (ftnlen)255); - -/* Invoke the editor. */ - - exesys_(loccmd, rtrim_(loccmd, (ftnlen)255)); - chkout_("EDTCMD", (ftnlen)6); - return 0; -} /* edtcmd_ */ - diff --git a/ext/spice/src/csupport/edtcom.c b/ext/spice/src/csupport/edtcom.c deleted file mode 100644 index a6630cc2ce..0000000000 --- a/ext/spice/src/csupport/edtcom.c +++ /dev/null @@ -1,1022 +0,0 @@ -/* edtcom.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__80 = 80; -static integer c__2 = 2; -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure EDTCOM (Edit a command) */ -/* Subroutine */ int edtcom_0_(int n__, char *delim, char *prompt, char * - commnd, integer *source, ftnlen delim_len, ftnlen prompt_len, ftnlen - commnd_len) -{ - /* Initialized data */ - - static char editor[132] = "emacs " - " " - " "; - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1[2], i__2, i__3; - cllist cl__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer f_clos(cllist *), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char name__[132]; - extern logical have_(char *, ftnlen); - static char line[132], rest[1760]; - static integer unit, i__; - extern integer cardc_(char *, ftnlen); - static integer r__; - static char space[1]; - extern logical match_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer depth; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), reset_(void); - static integer b1, b2, e1, e2; - static char error[132*2]; - static logical lstat[3]; - extern integer rtrim_(char *, ftnlen); - static logical sstat[3]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern logical m2wmch_(char *, integer *, integer *, char *, ftnlen, - ftnlen), failed_(void); - extern /* Subroutine */ int edtcmd_(char *, char *, ftnlen, ftnlen); - static char buffer[132*86]; - extern /* Subroutine */ int dmpbuf_(void), getbuf_(integer *, char *, - ftnlen); - static char scndwd[32]; - extern /* Subroutine */ int prread_(char *, char *, ftnlen, ftnlen), - newfil_(char *, char *, char *, ftnlen, ftnlen, ftnlen), nspioa_( - char *, ftnlen); - static logical gotone; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen), sigerr_(char *, ftnlen); - static integer comnum; - extern /* Subroutine */ int getbsz_(integer *); - static char dstrng[3]; - extern /* Subroutine */ int nspioh_(char *, ftnlen); - static integer iostat; - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen), suffix_( - char *, integer *, char *, ftnlen, ftnlen); - static char pattrn[132], frstwd[32]; - extern /* Subroutine */ int nextwd_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), setmsg_(char *, ftnlen), chkout_(char *, ftnlen), - nspioc_(char *, ftnlen), nspgst_(char *, logical *, ftnlen), - prexit_(void), putcom_(char *, integer *, ftnlen); - static char errstr[132]; - static logical status[3], svstat[3]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), nspwln_( - char *, ftnlen), nsppst_(char *, logical *, ftnlen), rstbuf_(void) - , putbuf_(char *, ftnlen), prstrt_(char *, char *, ftnlen, ftnlen) - , txtopr_(char *, integer *, ftnlen); - static char tab[1]; - static integer ptr; - -/* $ Abstract */ - -/* This entry point allows the user of a program to fetch */ -/* previously entered commands, review them, re-execute the commands */ -/* or edit and re-execute the command. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DELIM I is the character used to delimit the command ends */ -/* COMMND I/O is a command to process */ -/* SOURCE I/O indicates the source of the command */ - -/* $ Detailed_Input */ - -/* DELIM is the character used to delimit input commands. */ -/* A command begins at the first non-blank character */ -/* of COMMND and continues until the last non-blank */ -/* character or the first occurrence of DELIM which */ -/* ever is first. */ - - -/* COMMND is a string that indicates some action the program */ -/* should take. The only commands that have meaning */ -/* to this routine are those of the form: */ - -/* RECALL @int(1:20) */ - -/* RECALL ALL */ - -/* DO @int(1:20) */ - -/* EDIT @int(1:20) */ - -/* all other commands are ignored by this routine. */ -/* (See the META/2 language specification language */ -/* for a more detailed description of the meaning */ -/* of the syntax specifications given above.) */ - -/* SOURCE is an integer indicating where the input command */ -/* came from. Unless SOURCE has a value of 2 meaning */ -/* the command was typed interactively, no action */ -/* is taken by this routine. */ - -/* $ Detailed_Output */ - -/* COMMND if the input command is recognized by this routine */ -/* COMMND will be set to all blank characters. */ -/* Otherwise, COMMND will remain unchanged. */ - -/* SOURCE if the input command is recognized by this routine */ -/* SOURCE will be set to zero indicating that there */ -/* is no longer a potential command in the string */ -/* COMMND. SOURCE will remain unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* In the case of a command of the form EDIT @int(1:20) this routine */ -/* must be able to create a file that the editor can edit. */ - -/* If this cannot be done one of the following errors will be */ -/* signalled. */ - -/* 1) If the program cannot create a new file name that */ -/* could hold the command to be edited, the error */ -/* COMLOOP(NOFILECREATION) will be signalled. */ - -/* 2) If a new file name could be created but the file could */ -/* not be opened, the error COMLOOP(COMMANDEDITFAILED) */ -/* will be signalled. */ - - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is provided so that command line programs */ -/* may obtain a history of commands that have been entered */ -/* into the program and possible re-execute or edit and execute */ -/* the previous commands. This is meant to be integrated */ -/* with the basic command loop software available for */ -/* constructing command driven programs. See the routine */ -/* CMLOOP to see how this fits into the general sequence of */ -/* command processing. */ - -/* $ Examples */ - -/* See CMLOOP for the intended use of this routine. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.24.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.23.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.22.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.21.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.14.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.13.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.12.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 1.11.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.10.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 1.9.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 1.8.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 1.7.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 1.6.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 1.5.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 1.4.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 1.4.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 1.4.3, 20-SEP-1999 (NJB) */ - -/* CSPICE and PC-LINUX environment lines were added. Some */ -/* typos were corrected. */ - -/* - SPICELIB Version 1.4.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 1.4.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.4.0, 9-JAN-1997 (WLT) */ - -/* Added minimal support for the MAC version. When the user */ -/* requests EDIT, the routine displays the matching item */ -/* that should be editted. This is the only option available */ -/* at the moment on the MAC. When something better comes along */ -/* we'll do something more creative. */ - -/* - SPICELIB Version 1.3.0, 5-Dec-1995 (WLT) */ - -/* Fixed the bug that occured if you typed RECALL x and */ -/* there was no matching command (probably should have done */ -/* thins in version 1.2.0) EDTCOM now pronounces that this */ -/* is an error. */ - -/* - SPICELIB Version 1.2.0, 11-SEP-1995 ( WLT ) */ - -/* Fixed the bug that occurred if you type EDIT x or */ -/* DO x and there was no matching command in the history */ -/* list. EDTCOM no pronounces that this is an error. */ - -/* - SPICELIB Version 1.1.0, 1-JUN-1995 (HAN) */ - -/* Created the master source file for VAX/VMS, Alpha/OpenVMS, */ -/* Sun (Sun OS 4.1.x and Solaris), PC(Microsoft Fortran), HP, */ -/* and NeXT. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - SPICELIB Version 1.0.0, 18-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Recall Re-execute or edit and re-execute a command */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.1.0, 1-JUN-1995 (HAN) */ - -/* Created the master source file for VAX/VMS, Alpha/OpenVMS, */ -/* Sun (Sun OS 4.1.x and Solaris), PC(Microsoft Fortran), HP, */ -/* and NeXT. */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Meta/2 functions */ - - -/* Below are the various sources from which */ -/* commands might come. */ - -/* NONE */ -/* COMBUF */ -/* KEYBRD */ -/* INPFIL */ - - -/* Local parameters used for allocating space and controlling loop */ -/* execution. */ - - -/* Local Variables. */ - - switch(n__) { - case 1: goto L_setedt; - case 2: goto L_getedt; - } - - -/* The only time an EDIT/RECALL/DO command can have any meaning */ -/* is when it comes from the keyboard. */ - - if (*source != 2) { - return 0; - } - -/* Initialize the syntax for the preprocessing commands */ - - if (first) { - first = FALSE_; - *(unsigned char *)tab = '\t'; - *(unsigned char *)space = ' '; - } - -/* Next we take apart the command and see if it is one of the */ -/* preprocessing commands. */ - - nextwd_(commnd, frstwd, rest, commnd_len, (ftnlen)32, (ftnlen)1760); - nextwd_(rest, scndwd, rest, (ftnlen)1760, (ftnlen)32, (ftnlen)1760); - -/* We probably don't have any of the pathologies below, but they */ -/* are easy to check so we handle them here. */ - - if (s_cmp(rest, " ", (ftnlen)1760, (ftnlen)1) != 0) { - return 0; - } - if (s_cmp(frstwd, " ", (ftnlen)32, (ftnlen)1) == 0) { - return 0; - } - b1 = 1; - b2 = 1; - e1 = rtrim_(frstwd, (ftnlen)32); - e2 = rtrim_(scndwd, (ftnlen)32); - if (s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) == 0 && ! m2wmch_(frstwd, & - b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6)) { - return 0; - } - -/* We need the beginning and endings of the words we've extracted. */ - - b1 = 1; - b2 = 1; - e1 = rtrim_(frstwd, (ftnlen)32); - e2 = rtrim_(scndwd, (ftnlen)32); - if (m2wmch_(frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6) && s_cmp( - scndwd, " ", (ftnlen)32, (ftnlen)1) == 0) { - -/* We don't want the RECALL command to show up in the */ -/* output. */ - - dmpbuf_(); - -/* We don't write the output of a RECALL command to the */ -/* log file. */ - - nspgst_("LOG", status, (ftnlen)3); - nspioh_("LOG", (ftnlen)3); - -/* Determine the depth of the command line buffer. */ - - getbsz_(&depth); - -/* Fetch each paragraph and display it. */ - - while(depth > 0) { - ssizec_(&c__80, buffer, (ftnlen)132); - intstr_(&depth, dstrng, (ftnlen)3); - ljust_(dstrng, dstrng, (ftnlen)3, (ftnlen)3); - getbuf_(&depth, buffer, (ftnlen)132); -/* Writing concatenation */ - i__1[0] = 3, a__1[0] = dstrng; - i__1[1] = 132, a__1[1] = buffer + 792; - s_cat(line, a__1, i__1, &c__2, (ftnlen)132); - nspwln_(line, (ftnlen)132); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 2; i__ <= i__2; ++i__) { -/* Writing concatenation */ - i__1[0] = 3, a__1[0] = " "; - i__1[1] = 132, a__1[1] = buffer + ((i__3 = i__ + 5) < 86 && 0 - <= i__3 ? i__3 : s_rnge("buffer", i__3, "edtcom_", ( - ftnlen)508)) * 132; - s_cat(line, a__1, i__1, &c__2, (ftnlen)132); - nspwln_(line, (ftnlen)132); - } - --depth; - } - -/* Reset the status of the LOG file back to whatever it */ -/* was before we started dumping old commands. Finally */ -/* set the command to a blank. */ - - nsppst_("LOG", status, (ftnlen)3); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - return 0; - } else if (m2wmch_(frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6) && - m2wmch_(scndwd, &b2, &e2, "@int(1:20)", (ftnlen)32, (ftnlen)10)) { - -/* We don't write the output of a RECALL command to the */ -/* log file. */ - - nspgst_("LOG", status, (ftnlen)3); - nspioh_("LOG", (ftnlen)3); - -/* Find out the depth of the command to fetch. */ - - nparsi_(scndwd, &depth, errstr, &ptr, (ftnlen)32, (ftnlen)132); - -/* Get rid of the top command (it's the RECALL command). */ - - dmpbuf_(); - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&depth, buffer, (ftnlen)132); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { -/* Writing concatenation */ - i__1[0] = 3, a__1[0] = " "; - i__1[1] = 132, a__1[1] = buffer + ((i__3 = i__ + 5) < 86 && 0 <= - i__3 ? i__3 : s_rnge("buffer", i__3, "edtcom_", (ftnlen) - 547)) * 132; - s_cat(line, a__1, i__1, &c__2, (ftnlen)132); - nspwln_(line, (ftnlen)132); - } - -/* Reset the status of the LOG file back to whatever it */ -/* was before we started dumping old commands. Finally */ -/* set the command to a blank. */ - - nsppst_("LOG", status, (ftnlen)3); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - return 0; - } else if (m2wmch_(frstwd, &b1, &e1, "RECALL", (ftnlen)32, (ftnlen)6)) { - -/* Find out the depth of the command to fetch. */ - - getbsz_(&depth); - suffix_("*", &c__0, scndwd, (ftnlen)1, (ftnlen)32); - comnum = 2; - gotone = FALSE_; - while(comnum <= depth) { - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&comnum, buffer, (ftnlen)132); - if (cardc_(buffer, (ftnlen)132) > 0 && match_(buffer + 792, - scndwd, (ftnlen)132, (ftnlen)32)) { - -/* We don't write the output of a RECALL command to the */ -/* log file. */ - - nspgst_("LOG", status, (ftnlen)3); - nspioh_("LOG", (ftnlen)3); - -/* Dump the top command as it is just the recall command. */ - - dmpbuf_(); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { -/* Writing concatenation */ - i__1[0] = 3, a__1[0] = " "; - i__1[1] = 132, a__1[1] = buffer + ((i__3 = i__ + 5) < 86 - && 0 <= i__3 ? i__3 : s_rnge("buffer", i__3, - "edtcom_", (ftnlen)591)) * 132; - s_cat(line, a__1, i__1, &c__2, (ftnlen)132); - nspwln_(line, (ftnlen)132); - } - comnum = depth; - gotone = TRUE_; - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - nsppst_("LOG", status, (ftnlen)3); - } - ++comnum; - } - -/* Reset the status of the LOG file back to whatever it */ -/* was before we started dumping old commands. */ - - if (! gotone) { - s_copy(error, "There is no command in the command history list t" - "hat matches '#'. ", (ftnlen)132, (ftnlen)66); - repmc_(error, "#", scndwd, error, (ftnlen)132, (ftnlen)1, (ftnlen) - 32, (ftnlen)132); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - setmsg_(error, (ftnlen)132); - sigerr_("EDTCOM(NOMATCH)", (ftnlen)15); - return 0; - } - return 0; - } else if (m2wmch_(frstwd, &b1, &e1, "EDIT", (ftnlen)32, (ftnlen)4) && - m2wmch_(scndwd, &b2, &e2, "@int(1:20)", (ftnlen)32, (ftnlen)10)) { - nparsi_(scndwd, &depth, errstr, &ptr, (ftnlen)32, (ftnlen)132); - dmpbuf_(); - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&depth, buffer, (ftnlen)132); - -/* Open the utility port to receive the contents of BUFFER. */ - - s_copy(pattrn, "edt{0-z}{0-z}{0-z}{0-z}{0-z}.tmp", (ftnlen)132, ( - ftnlen)32); - newfil_(pattrn, "UTILITY", name__, (ftnlen)132, (ftnlen)7, (ftnlen) - 132); - if (failed_()) { - reset_(); - chkin_("EDTCOM", (ftnlen)6); - setmsg_("The program was unable to open a file that could be use" - "d with the editor. Command editing cannot be performed a" - "t this time. ", (ftnlen)124); - sigerr_("CMLOOP(COMMANDEDITFAILED)", (ftnlen)25); - chkout_("EDTCOM", (ftnlen)6); - return 0; - } - -/* We have at this point succeeded in opening a file */ -/* into which we can write the last command. But we */ -/* don't want to write to the screen, log file or save */ -/* file if there is one. Inhibit writing to any port */ -/* but the utility port. */ - - nspgst_("LOG", lstat, (ftnlen)3); - nspgst_("SCREEN", sstat, (ftnlen)6); - nspgst_("SAVE", svstat, (ftnlen)4); - nspioh_("LOG", (ftnlen)3); - nspioh_("SCREEN", (ftnlen)6); - nspioh_("SAVE", (ftnlen)4); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { - nspwln_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? i__3 : - s_rnge("buffer", i__3, "edtcom_", (ftnlen)674)) * 132, ( - ftnlen)132); - } - nspioc_("UTILITY", (ftnlen)7); - -/* Activate the editor */ - - edtcmd_(editor, name__, rtrim_(editor, (ftnlen)132), rtrim_(name__, ( - ftnlen)132)); - s_copy(error, " ", (ftnlen)132, (ftnlen)1); - s_copy(error + 132, " ", (ftnlen)132, (ftnlen)1); - if (have_(error, (ftnlen)132)) { - nsppst_("LOG", lstat, (ftnlen)3); - nsppst_("SCREEN", sstat, (ftnlen)6); - nsppst_("SAVE", svstat, (ftnlen)4); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - setmsg_(error, (ftnlen)132); - sigerr_("SPICE(FILEREADERROR)", (ftnlen)20); - return 0; - } - -/* Read the first command from the edited file. */ - - prstrt_(name__, error, (ftnlen)132, (ftnlen)132); - if (have_(error, (ftnlen)132)) { - nsppst_("LOG", lstat, (ftnlen)3); - nsppst_("SCREEN", sstat, (ftnlen)6); - nsppst_("SAVE", svstat, (ftnlen)4); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - prexit_(); - setmsg_(error, (ftnlen)132); - sigerr_("SPICE(FILEREADERROR)", (ftnlen)20); - return 0; - } - prread_(delim, commnd, (ftnlen)1, commnd_len); - putcom_(commnd, &c__2, commnd_len); - prexit_(); - -/* Finally, delete the file we used with the editor. */ - - txtopr_(name__, &unit, (ftnlen)132); - cl__1.cerr = 1; - cl__1.cunit = unit; - cl__1.csta = "DELETE"; - iostat = f_clos(&cl__1); - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&c__1, buffer, (ftnlen)132); - nspioa_("SCREEN", (ftnlen)6); - r__ = rtrim_(prompt, prompt_len) + 2; - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { - if (i__ == 1) { - s_copy(line, prompt, (ftnlen)132, prompt_len); - suffix_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? i__3 : - s_rnge("buffer", i__3, "edtcom_", (ftnlen)738)) * 132, - &c__1, line, (ftnlen)132, (ftnlen)132); - } else { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - s_copy(line + (r__ - 1), buffer + ((i__3 = i__ + 5) < 86 && 0 - <= i__3 ? i__3 : s_rnge("buffer", i__3, "edtcom_", ( - ftnlen)741)) * 132, 132 - (r__ - 1), (ftnlen)132); - } - nspwln_(line, rtrim_(line, (ftnlen)132)); - } - -/* Reset the writing to all other ports. */ - - nsppst_("LOG", lstat, (ftnlen)3); - nsppst_("SCREEN", sstat, (ftnlen)6); - nsppst_("SAVE", svstat, (ftnlen)4); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - } else if (m2wmch_(frstwd, &b1, &e1, "EDIT", (ftnlen)32, (ftnlen)4) && - s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) != 0) { - gotone = FALSE_; - comnum = 2; - getbsz_(&depth); - suffix_("*", &c__0, scndwd, (ftnlen)1, (ftnlen)32); - while(comnum <= depth) { - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&comnum, buffer, (ftnlen)132); - if (cardc_(buffer, (ftnlen)132) > 0 && match_(buffer + 792, - scndwd, (ftnlen)132, (ftnlen)32)) { - gotone = TRUE_; - dmpbuf_(); - -/* Open the utility port to receive the contents of BUFFER. */ - - s_copy(pattrn, "edt{0-z}{0-z}{0-z}{0-z}{0-z}.tmp", (ftnlen) - 132, (ftnlen)32); - newfil_(pattrn, "UTILITY", name__, (ftnlen)132, (ftnlen)7, ( - ftnlen)132); - if (failed_()) { - reset_(); - chkin_("EDTCOM", (ftnlen)6); - setmsg_("The program was unable to open a file that coul" - "d be used with the editor. Command editing canno" - "t be performed at this time. ", (ftnlen)124); - sigerr_("CMLOOP(COMMANDEDITFAILED)", (ftnlen)25); - chkout_("EDTCOM", (ftnlen)6); - return 0; - } - -/* We have at this point succeeded in opening a file */ -/* into which we can write the last command. But we */ -/* don't want to write to the screen, log file or save */ -/* file if there is one. Inhibit writing to any port */ -/* but the utility port. */ - - nspgst_("LOG", lstat, (ftnlen)3); - nspgst_("SCREEN", sstat, (ftnlen)6); - nspgst_("SAVE", svstat, (ftnlen)4); - nspioh_("LOG", (ftnlen)3); - nspioh_("SCREEN", (ftnlen)6); - nspioh_("SAVE", (ftnlen)4); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { - nspwln_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? - i__3 : s_rnge("buffer", i__3, "edtcom_", (ftnlen) - 814)) * 132, (ftnlen)132); - } - nspioc_("UTILITY", (ftnlen)7); - -/* Activate the editor */ - - edtcmd_(editor, name__, rtrim_(editor, (ftnlen)132), rtrim_( - name__, (ftnlen)132)); - s_copy(error, " ", (ftnlen)132, (ftnlen)1); - s_copy(error + 132, " ", (ftnlen)132, (ftnlen)1); - if (have_(error, (ftnlen)132)) { - nsppst_("LOG", lstat, (ftnlen)3); - nsppst_("SCREEN", sstat, (ftnlen)6); - nsppst_("SAVE", svstat, (ftnlen)4); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - setmsg_(error, (ftnlen)132); - sigerr_("SPICE(FILEREADERROR)", (ftnlen)20); - return 0; - } - -/* Read the first command from the edited file. */ - - prstrt_(name__, error, (ftnlen)132, (ftnlen)132); - if (have_(error, (ftnlen)132)) { - nsppst_("LOG", lstat, (ftnlen)3); - nsppst_("SCREEN", sstat, (ftnlen)6); - nsppst_("SAVE", svstat, (ftnlen)4); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - prexit_(); - setmsg_(error, (ftnlen)132); - sigerr_("SPICE(FILEREADERROR)", (ftnlen)20); - return 0; - } - prread_(delim, commnd, (ftnlen)1, commnd_len); - putcom_(commnd, &c__2, commnd_len); - prexit_(); - -/* Finally, delete the file we used with the editor. */ - - txtopr_(name__, &unit, (ftnlen)132); - cl__1.cerr = 1; - cl__1.cunit = unit; - cl__1.csta = "DELETE"; - iostat = f_clos(&cl__1); - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&c__1, buffer, (ftnlen)132); - nspioa_("SCREEN", (ftnlen)6); - r__ = rtrim_(prompt, prompt_len) + 2; - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { - if (i__ == 1) { - s_copy(line, prompt, (ftnlen)132, prompt_len); - suffix_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? - i__3 : s_rnge("buffer", i__3, "edtcom_", ( - ftnlen)880)) * 132, &c__1, line, (ftnlen)132, - (ftnlen)132); - } else { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - s_copy(line + (r__ - 1), buffer + ((i__3 = i__ + 5) < - 86 && 0 <= i__3 ? i__3 : s_rnge("buffer", - i__3, "edtcom_", (ftnlen)883)) * 132, 132 - ( - r__ - 1), (ftnlen)132); - } - nspwln_(line, rtrim_(line, (ftnlen)132)); - } - -/* Reset the writing to all other ports. */ - - nsppst_("LOG", lstat, (ftnlen)3); - nsppst_("SCREEN", sstat, (ftnlen)6); - nsppst_("SAVE", svstat, (ftnlen)4); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - comnum = depth; - } - ++comnum; - } - if (! gotone) { - s_copy(error, "There is no command in the command history list t" - "hat matches '#'. ", (ftnlen)132, (ftnlen)66); - repmc_(error, "#", scndwd, error, (ftnlen)132, (ftnlen)1, (ftnlen) - 32, (ftnlen)132); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - setmsg_(error, (ftnlen)132); - sigerr_("EDTCOM(NOMATCH)", (ftnlen)15); - return 0; - } - } else if (m2wmch_(frstwd, &b1, &e1, "DO", (ftnlen)32, (ftnlen)2) && - m2wmch_(scndwd, &b2, &e2, "@int(1:20)", (ftnlen)32, (ftnlen)10)) { - nparsi_(scndwd, &depth, errstr, &ptr, (ftnlen)32, (ftnlen)132); - dmpbuf_(); - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&depth, buffer, (ftnlen)132); - nspgst_("SCREEN", sstat, (ftnlen)6); - nspioa_("SCREEN", (ftnlen)6); - r__ = rtrim_(prompt, prompt_len) + 2; - -/* Reset the paragraph buffer so it can receive another */ -/* paragraph. (This is where we buffer commands and we */ -/* need to buffer this one.) */ - - rstbuf_(); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { - putbuf_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? i__3 : - s_rnge("buffer", i__3, "edtcom_", (ftnlen)943)) * 132, ( - ftnlen)132); - if (i__ == 1) { - s_copy(line, prompt, (ftnlen)132, prompt_len); - suffix_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? i__3 : - s_rnge("buffer", i__3, "edtcom_", (ftnlen)947)) * 132, - &c__1, line, (ftnlen)132, (ftnlen)132); - } else { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - s_copy(line + (r__ - 1), buffer + ((i__3 = i__ + 5) < 86 && 0 - <= i__3 ? i__3 : s_rnge("buffer", i__3, "edtcom_", ( - ftnlen)950)) * 132, 132 - (r__ - 1), (ftnlen)132); - } - nspwln_(line, rtrim_(line, (ftnlen)132)); - } - nsppst_("SCREEN", sstat, (ftnlen)6); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - s_copy(commnd, buffer + 792, commnd_len, (ftnlen)132); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 2; i__ <= i__2; ++i__) { - suffix_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? i__3 : - s_rnge("buffer", i__3, "edtcom_", (ftnlen)963)) * 132, & - c__1, commnd, (ftnlen)132, commnd_len); - } - i__ = i_indx(commnd, delim, commnd_len, (ftnlen)1); - if (i__ > 0) { - putcom_(commnd, &c__2, i__ - 1); - } else { - putcom_(commnd, &c__1, commnd_len); - } - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - } else if (m2wmch_(frstwd, &b1, &e1, "DO", (ftnlen)32, (ftnlen)2) && - s_cmp(scndwd, " ", (ftnlen)32, (ftnlen)1) != 0) { - -/* This is basically the same as the last case, but */ -/* we look for a pattern match before doing anything. */ - - gotone = FALSE_; - getbsz_(&depth); - suffix_("*", &c__0, scndwd, (ftnlen)1, (ftnlen)32); - comnum = 2; - while(comnum <= depth) { - ssizec_(&c__80, buffer, (ftnlen)132); - getbuf_(&comnum, buffer, (ftnlen)132); - if (cardc_(buffer, (ftnlen)132) > 0 && match_(buffer + 792, - scndwd, (ftnlen)132, (ftnlen)32)) { - gotone = TRUE_; - dmpbuf_(); - nspgst_("SCREEN", sstat, (ftnlen)6); - nspioa_("SCREEN", (ftnlen)6); - r__ = rtrim_(prompt, prompt_len) + 2; - -/* Reset the paragraph buffer so it can receive another */ -/* paragraph. (This is where we buffer commands and we */ -/* need to buffer this one.) */ - - rstbuf_(); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 1; i__ <= i__2; ++i__) { - putbuf_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? - i__3 : s_rnge("buffer", i__3, "edtcom_", (ftnlen) - 1012)) * 132, (ftnlen)132); - if (i__ == 1) { - s_copy(line, prompt, (ftnlen)132, prompt_len); - suffix_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? - i__3 : s_rnge("buffer", i__3, "edtcom_", ( - ftnlen)1015)) * 132, &c__1, line, (ftnlen)132, - (ftnlen)132); - } else { - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - s_copy(line + (r__ - 1), buffer + ((i__3 = i__ + 5) < - 86 && 0 <= i__3 ? i__3 : s_rnge("buffer", - i__3, "edtcom_", (ftnlen)1018)) * 132, 132 - ( - r__ - 1), (ftnlen)132); - } - nspwln_(line, rtrim_(line, (ftnlen)132)); - } - nsppst_("SCREEN", sstat, (ftnlen)6); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - s_copy(commnd, buffer + 792, commnd_len, (ftnlen)132); - i__2 = cardc_(buffer, (ftnlen)132); - for (i__ = 2; i__ <= i__2; ++i__) { - suffix_(buffer + ((i__3 = i__ + 5) < 86 && 0 <= i__3 ? - i__3 : s_rnge("buffer", i__3, "edtcom_", (ftnlen) - 1031)) * 132, &c__1, commnd, (ftnlen)132, - commnd_len); - } - i__ = i_indx(commnd, delim, commnd_len, (ftnlen)1); - if (i__ > 0) { - putcom_(commnd, &c__2, i__ - 1); - } else { - putcom_(commnd, &c__1, commnd_len); - } - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - comnum = depth; - } - ++comnum; - } - if (! gotone) { - s_copy(error, "There is no command in the command history list t" - "hat matches '#'. ", (ftnlen)132, (ftnlen)66); - repmc_(error, "#", scndwd, error, (ftnlen)132, (ftnlen)1, (ftnlen) - 32, (ftnlen)132); - s_copy(commnd, " ", commnd_len, (ftnlen)1); - *source = 0; - setmsg_(error, (ftnlen)132); - sigerr_("EDTCOM(NOMATCH)", (ftnlen)15); - return 0; - } - } - return 0; - -L_setedt: - s_copy(editor, commnd, (ftnlen)132, commnd_len); - return 0; - -L_getedt: - s_copy(commnd, editor, commnd_len, (ftnlen)132); - return 0; -} /* edtcom_ */ - -/* Subroutine */ int edtcom_(char *delim, char *prompt, char *commnd, integer - *source, ftnlen delim_len, ftnlen prompt_len, ftnlen commnd_len) -{ - return edtcom_0_(0, delim, prompt, commnd, source, delim_len, prompt_len, - commnd_len); - } - -/* Subroutine */ int setedt_(char *commnd, ftnlen commnd_len) -{ - return edtcom_0_(1, (char *)0, (char *)0, commnd, (integer *)0, (ftnint)0, - (ftnint)0, commnd_len); - } - -/* Subroutine */ int getedt_(char *commnd, ftnlen commnd_len) -{ - return edtcom_0_(2, (char *)0, (char *)0, commnd, (integer *)0, (ftnint)0, - (ftnint)0, commnd_len); - } - diff --git a/ext/spice/src/csupport/exesys.c b/ext/spice/src/csupport/exesys.c deleted file mode 100644 index db395b31fe..0000000000 --- a/ext/spice/src/csupport/exesys.c +++ /dev/null @@ -1,323 +0,0 @@ -/* exesys.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure EXESYS ( Execute system command ) */ -/* Subroutine */ int exesys_(char *cmd, ftnlen cmd_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer status; - extern integer system_(char *, ftnlen); - -/* $ Abstract */ - -/* Execute an operating system command. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CMD I Command to be executed. */ - -/* $ Detailed_Input */ - -/* CMD is a character string containing a command */ -/* recognized by the command line interpreter of */ -/* the operating system. The significance of case */ -/* in CMD is system-dependent. Trailing white space */ -/* is not significant. */ - -/* $ Detailed_Output */ - -/* None. See $Particulars for a description of the action of this */ -/* routine. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input command is not executed successfully, and if */ -/* this routine is able to detect the failure, the error */ -/* SPICE(SYSTEMCALLFAILED) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Most popular operating systems provide a Fortran-callable */ -/* interface that allows a program to execute an operating system */ -/* command by passing the command, in the form of a string, to the */ -/* operating system's command interpreter. This routine encapulates */ -/* most of the system-dependent code required to execute operating */ -/* system commands in this manner. The input commands are of course */ -/* system-dependent. */ - -/* Side effects of this routine vary from system to system. */ -/* See $Restrictions for more information. */ - -/* Error checking capabilities also vary from system to system; this */ -/* routine does the best it can to diagnose errors resulting from */ -/* the attempt to execute the input command. */ - -/* $ Examples */ - -/* 1) Unix: copy the file spud.dat to the file spam.dat. Test */ -/* whether the copy command was executed successfully. */ - -/* For safety, we recommend appending a null character to the */ -/* command. */ - -/* CALL EXESYS ( 'cp spud.dat spam.dat'//CHAR(O) ) */ - -/* IF ( FAILED() ) THEN */ - -/* [process error condition] */ - -/* END IF */ - - -/* 2) VMS: same action as in example (1): */ - -/* CALL EXESYS ( 'COPY SPUD.DAT; SPAM.DAT;' ) */ - -/* IF ( FAILED() ) THEN */ - -/* [process error condition] */ - -/* END IF */ - -/* $ Restrictions */ - -/* 1) This routine should be used with caution; executing a system */ -/* command from within your program may have surprising side */ -/* effects. For example, the Sun Fortran Reference Manual [1] */ -/* gives this warning: */ - -/* *System* flushes all open files. For output files, */ -/* the buffer is flushed to the actual file. For input */ -/* files, the position of the pointer is unpredictable. */ - -/* 2) Under Sun Fortran */ - -/* -- The shell used to execute the command is determined by */ -/* the environment variable SHELL. */ - -/* -- The command string cannot exceed 1024 characters in */ -/* length. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - Beta Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - Beta Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - Beta Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - Beta Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - Beta Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - Beta Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - Beta Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - Beta Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - Beta Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - Beta Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - Beta Version 2.10.0, 06-APR-2009 (EDW) */ - -/* Updated for PC-LINUX-GFORTRAN MAC-OSX-GFORTRAN. Eliminated */ -/* environment descriptions. Most were out-of-date or wrong. */ -/* IMPLICIT NONE now included in all environments. */ - -/* - Beta Version 2.9.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - Beta Version 2.8.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - Beta Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - Beta Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - Beta Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - Beta Version 2.4.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - Beta Version 2.3.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - Beta Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - Beta Version 2.1.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - Beta Version 2.1.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - Beta Version 2.1.3, 22-SEP-1999 (NJB) */ - -/* CSPICE and PC-LINUX environment lines were added. Some */ -/* typos were corrected. */ - -/* - Beta Version 2.1.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - Beta Version 2.1.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - Beta Version 2.1.0, 12-AUG-1996 (WLT) */ - -/* Added the DEC-OSF1 environment. */ - -/* - Beta Version 2.0.0, 16-JUN-1995 (WLT)(HAN) */ - -/* Master version of machine dependent collections. */ -/* Copyright notice added. */ - -/* - Beta Version 1.0.0, 16-AUG-1994 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* execute an operating system command */ - -/* -& */ - -/* SPICELIB functions */ - - -/* System functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EXESYS", (ftnlen)6); - } - - - status = system_(cmd, rtrim_(cmd, cmd_len)); - if (status != 0) { - -/* Uh, we've got a problem. */ - - setmsg_("The \"system\" call returned code # in response to command " - "#.", (ftnlen)59); - errint_("#", &status, (ftnlen)1); - errch_("#", cmd, (ftnlen)1, cmd_len); - sigerr_("SPICE(SYSTEMCALLFAILED)", (ftnlen)23); - chkout_("EXESYS", (ftnlen)6); - return 0; - } - chkout_("EXESYS", (ftnlen)6); - return 0; -} /* exesys_ */ - diff --git a/ext/spice/src/csupport/expfnm_1.c b/ext/spice/src/csupport/expfnm_1.c deleted file mode 100644 index b8a05490e5..0000000000 --- a/ext/spice/src/csupport/expfnm_1.c +++ /dev/null @@ -1,399 +0,0 @@ -/* expfnm_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure EXPFNM_1 ( Expand a filename ) */ -/* Subroutine */ int expfnm_1__(char *infil, char *outfil, ftnlen infil_len, - ftnlen outfil_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer need, keep; - char word[255]; - integer blank; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer inlen, slash; - extern integer rtrim_(char *, ftnlen); - integer dirlen; - extern /* Subroutine */ int getenv_(char *, char *, ftnlen, ftnlen); - integer wrdlen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), repsub_(char *, integer *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer outlen; - extern logical return_(void); - char dir[255]; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Given a filename, expand it to be a full filename. */ - -/* $ 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 */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INFIL I The filename to be expanded. */ -/* OUTFIL O The expanded filename. */ - -/* $ Detailed_Input */ - -/* INFIL is the filename to be expanded. */ - -/* $ Detailed_Output */ - -/* OUTFIL is the expanded filename. If no expansion could be */ -/* done, the value of OUTFIL is equal to the value of */ -/* INFIL. OUTFIL may not overwrite INFIL. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the input filename is blank, begins with blank characters, */ -/* or has embedded blanks in it, the error SPICE(BADFILENAME) */ -/* is signalled. */ - -/* 2) If the expanded filename is too long to fit into the */ -/* output string, the error SPICE(STRINGTOOSMALL) is signalled. */ - -/* 3) The output string may not overwrite the input string. */ - -/* 4) If no expansion of the input filename can be done, the */ -/* output filename is assigned the value of the input filename. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The input filename may not be blank, begin with blank characters, */ -/* nor may it it contain embedded blanks. As a general rule, */ -/* SPICELIB routines do not allow blank characters as part of a */ -/* filename. */ - -/* Unix platforms: */ - -/* On the Unix platforms, a filename containing an environment */ -/* variable must be expanded completely before FORTRAN can do */ -/* anything with it. FORTRAN interacts directly with the kernel, and */ -/* as a result does not pass input filenames through the shell */ -/* for expansion of environment variables. */ - -/* VAX/VMS, Alpha/OpenVMS platforms: */ - -/* The operating system does filname expansion itself, so this */ -/* routine currently does not expand the name. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* Unix platforms: */ - -/* This routine cannot be used to expand a file name whose form */ -/* is '~xxx', where xxx is an account name. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - Beta Version 3.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - Beta Version 3.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - Beta Version 3.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - Beta Version 3.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - Beta Version 3.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - Beta Version 3.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - Beta Version 3.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - Beta Version 3.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - Beta Version 3.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - Beta Version 3.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - Beta Version 3.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - Beta Version 3.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - Beta Version 3.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - Beta Version 3.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - Beta Version 3.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - Beta Version 3.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - Beta Version 3.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - Beta Version 3.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - Beta Version 3.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - Beta Version 3.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - Beta Version 3.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - Beta Version 3.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are WIN-NT */ - -/* - Beta Version 3.0.3, 21-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - Beta Version 3.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - Beta Version 3.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - Beta Version 3.0.0, 05-APR-1998 (NJB) */ - -/* Added references to the PC-LINUX environment. */ - -/* - Beta Version 2.1.0, 5-JAN-1995 (HAN) */ - -/* Removed Sun Solaris environment since it is now the same */ -/* as the Sun OS 4.1.x environment. */ -/* Removed DEC Alpha/OpenVMS environment since it is now the */ -/* same as the VAX environment. */ - -/* - Beta Version 2.0.0, 08-JUL-1994 (HAN) */ - -/* The capability of resolving a Unix filename that contains */ -/* an environment variable directory specificiation plus a */ -/* filename has been added. */ - -/* - Beta Version 1.0.0, 06-APR-1992 (HAN) */ - -/* -& */ -/* $ Index_Entries */ - -/* expand a filename */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EXPFNM_1", (ftnlen)8); - } - -/* If the input filename is blank, that's an error. */ - - if (s_cmp(infil, " ", infil_len, (ftnlen)1) == 0) { - setmsg_("The input filename '#' was blank.", (ftnlen)33); - errch_("#", infil, (ftnlen)1, infil_len); - sigerr_("SPICE(BADFILENAME)", (ftnlen)18); - chkout_("EXPFNM_1", (ftnlen)8); - return 0; - } - -/* If there are blanks anywhere in the filename, SPICELIB */ -/* considers the filename to be invalid. */ - - blank = pos_(infil, " ", &c__1, rtrim_(infil, infil_len), (ftnlen)1); - if (blank != 0) { - setmsg_("The input filename '#' had blank characters in it.", (ftnlen) - 50); - errch_("#", infil, (ftnlen)1, infil_len); - sigerr_("SPICE(BADFILENAME)", (ftnlen)18); - chkout_("EXPFNM_1", (ftnlen)8); - return 0; - } - -/* Look for a slash in the filename. */ - - slash = pos_(infil, "/", &c__1, infil_len, (ftnlen)1); - -/* If we found a slash in a position other than the first */ -/* character position, we want to examine the word that */ -/* comes before it just in case it is an environment */ -/* variable. */ - - if (slash > 1) { - s_copy(word, infil, (ftnlen)255, slash - 1); - getenv_(word, dir, (ftnlen)255, (ftnlen)255); - -/* If the word was an environment variable, then construct */ -/* the expanded filename. If it wasn't, just return the original */ -/* input filename. */ - - if (s_cmp(dir, " ", (ftnlen)255, (ftnlen)1) != 0) { - s_copy(outfil, infil, outfil_len, infil_len); - inlen = rtrim_(infil, infil_len); - wrdlen = rtrim_(word, (ftnlen)255); - dirlen = rtrim_(dir, (ftnlen)255); - outlen = i_len(outfil, outfil_len); - keep = inlen - wrdlen; - need = keep + dirlen; - -/* If the output filename length is not long enough for */ -/* the substitution, signal an error. Otherwise, substitute */ -/* in the new value. */ - - if (need > outlen) { - setmsg_("The expanded filename for the input filename '#' ex" - "ceeded the length of the output filename. The expand" - "ed name was # characters too long.", (ftnlen)137); - errch_("#", infil, (ftnlen)1, infil_len); - i__1 = need - outlen; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(STRINGTOOSMALL)", (ftnlen)21); - chkout_("EXPFNM_1", (ftnlen)8); - return 0; - } else { - i__1 = slash - 1; - repsub_(infil, &c__1, &i__1, dir, outfil, infil_len, rtrim_( - dir, (ftnlen)255), outfil_len); - } - } else { - s_copy(outfil, infil, outfil_len, infil_len); - } - } else { - -/* No slashes are in the filename, so it's just an easy case. */ - -/* It's possible that the entire filename is an environment */ -/* variable. If it's not, then just return the input filename. */ - - getenv_(infil, outfil, infil_len, outfil_len); - if (s_cmp(outfil, " ", outfil_len, (ftnlen)1) == 0) { - s_copy(outfil, infil, outfil_len, infil_len); - } - } - chkout_("EXPFNM_1", (ftnlen)8); - return 0; -} /* expfnm_1__ */ - diff --git a/ext/spice/src/csupport/expfnm_2.c b/ext/spice/src/csupport/expfnm_2.c deleted file mode 100644 index c3b0b9e8ef..0000000000 --- a/ext/spice/src/csupport/expfnm_2.c +++ /dev/null @@ -1,407 +0,0 @@ -/* expfnm_2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__32 = 32; - -/* $Procedure EXPFNM_2 ( Expand a filename ) */ -/* Subroutine */ int expfnm_2__(char *instr, char *outfil, ftnlen instr_len, - ftnlen outfil_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - integer need; - extern /* Subroutine */ int zzgetenv_(char *, char *, ftnlen, ftnlen); - integer blank; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer inlen, slash; - char myfil[255], myval[255]; - extern integer rtrim_(char *, ftnlen); - char myenv[32]; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer dollar, vallen, varlen; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), repsub_(char *, integer *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer outlen; - extern logical return_(void); - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Given a character string that represents a filename, expand it */ -/* using a predefined environment variable or DCL symbol to a */ -/* complete path or to prepend path components to a partial filename. */ - -/* $ 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 */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ -/* Length of an environment variable or DCL symbol name. */ -/* Length of a filename. */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INSTR I The character string to expand into a filename. */ -/* OUTFIL O The expanded filename. */ -/* ENVLEN P Maximum length of an environemt variable or symbol. */ -/* FNMLEN P Maximum length of a filename. */ - -/* $ Detailed_Input */ - -/* INSTR is the character string to be expanded. */ - -/* The input character string must be either */ - -/* 1) A defined environment variable having a value */ -/* that is a complete path to a file. */ - -/* 2) A defined environment variable, representing the */ -/* leading directories in a complete path to a file, */ -/* followed by a slash, '/', followed by the */ -/* remainder of the complete path to a file, e.g., */ - -/* /mydir1/mydir2/file.dat */ - -/* where the environment variable must begin with a */ -/* dollar sign ($). */ - -/* 3) A complete filename, which will not be modified. */ - -/* $ Detailed_Output */ - -/* OUTFIL is the expanded filename. If no expansion could be */ -/* done, OUTFIL will be blank. OUTFIL may not overwrite */ -/* INSTR. */ - -/* $ Parameters */ - -/* ENVLEN The maximum allowed length of an environment variable */ -/* or DCL symbol name. */ - -/* FNMLEN The maximum length for a filename. */ - -/* $ Exceptions */ - -/* 1) If the input string is blank, or has embedded blanks in it, */ -/* the error SPICE(BADFILENAME) is signalled. */ - -/* 2) If the expanded filename is too long to fit into the */ -/* output string, the error SPICE(STRINGTOOSMALL) is signalled. */ - -/* 3) The output string may not overwrite the input string. */ - -/* 4) If no expansion of the input string can be done, the */ -/* output filename is will be blank. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This subroutine takes as input a character string, possibly */ -/* containing an environment variable or DCL symbol name, that */ -/* represents a filename. If the character string contains an */ -/* environment variable or DCL symbol name, indicated by a dollar */ -/* sign ($) immediately preceeding the environment variable or DCL */ -/* symbol name, an attempt is made to obtain a value for the */ -/* specified environment variable or DCL symbol from the operating */ -/* system. If there is no dollar sign in the input character string, */ -/* the output filename will be assigned the value of the input */ -/* character string. */ - -/* If successful, the original environment variable or DCL symbol */ -/* name, including the dollar sign, will be replaced with the value */ -/* that was obtained, and the resulting character string will be */ -/* returned as the output filename. If unsuccesful, the the output */ -/* filename will be blank. */ - -/* Environment variable and DCL symbol names may only be used to */ -/* represent either a complete path to a file or the leading path */ -/* elements of a complete path to a file. Thus, they must appear */ -/* first in the input character string. See the examples. */ - -/* $ Examples */ - -/* We provide examples using a UNIX style filename and path. For */ -/* other environments, the appropriate syntax for filenames and */ -/* paths must be used. */ - -/* Example 1: Passing in a complete path to a filename. */ - -/* INSTR = 'datafile.dat' */ -/* OUTFIL = 'datafile.dat' */ - -/* Example 2: Using an environment variable to specify the complete */ -/* path to a filename. */ - -/* Assume that we have already defined the environment variable */ -/* or DCL symbol 'DATAFILE' to be 'datafile.dat'. Then we would */ -/* get the following: */ - -/* INSTR = '$DATAFILE' */ -/* OUTFIL = 'datafile.dat' */ - -/* Example 3: Using an environment variable to specify the leading */ -/* path elements of a complete path to a filename. */ - -/* Assume that we have already defined the environment variable */ -/* or DCL symbol 'DATAPATH' to be '/home/project/data'. Then we */ -/* would get the following: */ - -/* INSTR = '$DATAFILE/datafila.dat' */ -/* OUTFIL = '/home/project/data/datafile.dat' */ - -/* Example 4: An incorrect usage of an environment variable. */ - -/* Using '/home/$DATAPATH/datafile.dat' as the input string */ -/* would produce an error because the dollar sign is not the */ -/* first nonblank character in the input string. in this case, */ -/* OUTFIL would be blank. */ - -/* $ Restrictions */ - -/* 1) This subroutine expects environment variable and DCL symbol */ -/* names to begin with a dollar sign ($). Failure to do this */ -/* could lead to unexpected results. */ - -/* 2) The environment variable or DCL sumbol name must be the first */ -/* part of the input character string. */ - -/* 3) Environment variable and DCL symbol names may be at most 32 */ -/* characters in length. Your Mileage may vary depending on the */ -/* particular environment. See the private subroutine ZZGETENV */ -/* for details. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - Beta Version 2.0.0, 20-JAN-1999 (NJB) */ - -/* No longer converts environment variables to upper case. */ - -/* - Beta Version 1.0.0, 30-MAY-1996 (HAN) */ - -/* This version fixes some inconsistencies in the original */ -/* EXPFNM_1 subroutine. */ - -/* -& */ - -/* $ Index_Entry */ - -/* expand a filename */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("EXPFNM_2", (ftnlen)8); - } - -/* If the input filename is blank, that's an error. */ - - if (s_cmp(instr, " ", instr_len, (ftnlen)1) == 0) { - s_copy(outfil, " ", outfil_len, (ftnlen)1); - setmsg_("The input filename '#' was blank.", (ftnlen)33); - errch_("#", instr, (ftnlen)1, instr_len); - sigerr_("SPICE(BADFILENAME)", (ftnlen)18); - chkout_("EXPFNM_2", (ftnlen)8); - return 0; - } - -/* We know the input was not blank, so left justify it and */ -/* check for embedded blanks. */ - - ljust_(instr, myfil, instr_len, (ftnlen)255); - blank = pos_(myfil, " ", &c__1, rtrim_(myfil, (ftnlen)255), (ftnlen)1); - if (blank != 0) { - s_copy(outfil, " ", outfil_len, (ftnlen)1); - setmsg_("The input filename '#' contained embedded blanks.", (ftnlen) - 49); - errch_("#", myfil, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(BADFILENAME)", (ftnlen)18); - chkout_("EXPFNM_2", (ftnlen)8); - return 0; - } - -/* We have two cases that we need to consider: */ - -/* 1) The input file does not contain a dollar sign. This */ -/* indicates that it is a complete filename; */ - -/* 2) The input file has a dollar sign as the first character. */ -/* This indicates that the input filename has its full name, */ -/* or leading path components, specified by the value of an */ -/* environment variable. In this case, we get the environment */ -/* variable's value and replace the environment variable in */ -/* the input filename. */ - -/* We deal with each of these cases, in order, below. */ - - dollar = pos_(myfil, "$", &c__1, (ftnlen)255, (ftnlen)1); - if (dollar == 0) { - -/* The input is assumed to be an actual filename, so set the */ -/* output to be the input. */ - - s_copy(outfil, instr, outfil_len, instr_len); - } else if (dollar == 1) { - -/* The input is assumed to contain the name of an environment */ -/* variable whose value contains a complete path name to a */ -/* file or the leading path elements that will create a complete */ -/* path name to a file. To find out which, we look for a forward */ -/* slash. If there is one, everything between the dollar sign and */ -/* the first forward slash, noninclusive, is the name of the */ -/* environment variable. If there are no slashes, the entire */ -/* input name is the name of the environment variable. */ - - slash = pos_(myfil, "/", &c__2, (ftnlen)255, (ftnlen)1); - if (slash == 0) { - varlen = rtrim_(myfil, (ftnlen)255); - } else { - varlen = slash - 1; - } - if (varlen > 32) { - s_copy(outfil, " ", outfil_len, (ftnlen)1); - setmsg_("The environment variable name '#' is too long. The maxi" - "mum length for an environment variable name is #.", ( - ftnlen)104); - errch_("#", myfil + 1, (ftnlen)1, slash - 2); - errint_("#", &c__32, (ftnlen)1); - sigerr_("SPICE(STRINGTOOSMALL)", (ftnlen)21); - chkout_("EXPFNM_2", (ftnlen)8); - return 0; - } - -/* Remember to skip the dollar sign. */ - - s_copy(myenv, myfil + 1, (ftnlen)32, varlen - 1); - -/* Try to get the value of the environment variable. If the */ -/* environment variable does not exist, a blank string is */ -/* returned. */ - - zzgetenv_(myenv, myval, (ftnlen)32, (ftnlen)255); - -/* If we got something, use it. We don't make any value */ -/* judgements. */ - - if (s_cmp(myval, " ", (ftnlen)255, (ftnlen)1) == 0) { - s_copy(outfil, " ", outfil_len, (ftnlen)1); - setmsg_("The environment variable '#' was not defined.", (ftnlen) - 45); - errch_("#", myenv, (ftnlen)1, (ftnlen)32); - sigerr_("SPICE(NOENVVARIABLE)", (ftnlen)20); - chkout_("EXPFNM_2", (ftnlen)8); - return 0; - } - inlen = rtrim_(myfil + 1, (ftnlen)254); - vallen = rtrim_(myval, (ftnlen)255); - outlen = i_len(outfil, outfil_len); - need = inlen - varlen + vallen; - -/* If the output filename length is not long enough for */ -/* the substitution, signal an error. Otherwise, substitute */ -/* in the new value. */ - - if (need > outlen) { - s_copy(outfil, " ", outfil_len, (ftnlen)1); - setmsg_("The expanded filename for the input filename '#' exceed" - "ed the length of the output filename. The expanded name " - "was # characters too long.", (ftnlen)137); - errch_("#", myfil, (ftnlen)1, (ftnlen)255); - i__1 = need - outlen; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(STRINGTOOSMALL)", (ftnlen)21); - chkout_("EXPFNM_2", (ftnlen)8); - return 0; - } - repsub_(myfil, &c__1, &varlen, myval, outfil, (ftnlen)255, vallen, - outfil_len); - } else { - -/* There was a dollar sign in a position other than the first */ -/* nonblank position of the input filename. We do not allow */ -/* this. If an input filename contains a dollar sign, it must */ -/* be in the first nonblank position. */ - - s_copy(outfil, " ", outfil_len, (ftnlen)1); - setmsg_("The input filename '#' contained a dollar sign ($) that was" - " not in the first nonblank position; this is not allowed. Se" - "e the subroutine EXPFNM_2 for details.", (ftnlen)157); - errch_("#", myfil, (ftnlen)1, (ftnlen)255); - sigerr_("SPICE(BADFILENAME)", (ftnlen)18); - chkout_("EXPFNM_2", (ftnlen)8); - return 0; - } - chkout_("EXPFNM_2", (ftnlen)8); - return 0; -} /* expfnm_2__ */ - diff --git a/ext/spice/src/csupport/f2c.h b/ext/spice/src/csupport/f2c.h deleted file mode 100644 index 079fdaf490..0000000000 --- a/ext/spice/src/csupport/f2c.h +++ /dev/null @@ -1,654 +0,0 @@ -/* - --Header_File f2c.h ( CSPICE version of the f2c standard header file ) - --Abstract - - Perform standard f2c declarations, customized for the host - environment. - --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. - --Particulars - - The standard f2c header file f2c.h must be included by every function - generated by running f2c on Fortran source code. The header f2c.h - includes typedefs used to provide a level of indirection in mapping - Fortran data types to native C data types. For example, Fortran - INTEGER variables are mapped to variables of type integer, where - integer is a C typedef. In the standard f2c.h header, the typedef - integer translates to the C type long. - - Because the standard version of f2c.h does not work on all platforms, - this header file contains two platform-dependent versions of it, - meant to be selected at build time via precompiler switches. The - precompiler switches reference macros defined in SpiceZpl.h to - determine for which host platform the code is targeted. The first - version of f2c.h, which works on most platforms, is copied directly - from the standard version of f2c.h. The second version is intended - for use on the DEC Alpha running Digital Unix and the Sun/Solaris - platform using 64 bit mode and running gcc. On those systems, longs - occupy 8 bytes, as do doubles. Because the Fortran standard requires - that INTEGERS occupy half the storage of DOUBLE PRECISION numbers, - INTEGERS should be mapped to 4-byte ints rather than 8-byte longs - on the platforms having 8-byte longs. In order to achieve this, the - header f2c.h was transformed using the sed command - - sed 's/long //' f2c.h - - The high-level structure of this file is then: - - # if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) ) - - - [ Alpha/Digital Unix and Sun Solaris 64 bit mode/gcc - version of f2c.h source code ] - - # else - - [ Standard version of f2c.h source code ] - - # endif - - --Restrictions - - 1) This header file must be updated whenever the f2c processor - or the f2c libraries libI77 and libF77 are updated. - - 2) This header may need to be updated to support new platforms. - The supported platforms at the time of the 31-JAN-1999 release - are: - - ALPHA-DIGITAL-UNIX - HP - NEXT - PC-LINUX - PC-MS - SGI-IRIX-N32 - SGI-IRIX-NO2 - SUN-SOLARIS - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - B.V. Semenov (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 4.1.0, 14-MAY-2010 (EDW)(BVS) - - Updated for: - - MAC-OSX-64BIT-INTEL_C - SUN-SOLARIS-64BIT-NATIVE_C - SUN-SOLARIS-INTEL-64BIT-CC_C - - environments. Added the corresponding tags: - - CSPICE_MAC_OSX_INTEL_64BIT_GCC - CSPICE_SUN_SOLARIS_64BIT_NATIVE - CSPICE_SUN_SOLARIS_INTEL_64BIT_CC - - tag to the #ifdefs set. - - -CSPICE Version 4.0.0, 21-FEB-2006 (NJB) - - Updated to support the PC Linux 64 bit mode/gcc platform. - - -CSPICE Version 3.0.0, 27-JAN-2003 (NJB) - - Updated to support the Sun Solaris 64 bit mode/gcc platform. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - - Updated to support linking CSPICE into executables that - also link in objects compiled from Fortran, in particular - ones that perform Fortran I/O. To enable this odd mix, - one defines the preprocessor flag - - MIX_C_AND_FORTRAN - - This macro is undefined by default, since the action it invokes - is usually not desirable. See the header - - f2cMang.h - - for further information. - - -CSPICE Version 1.0.0, 07-FEB-1999 (NJB) - -*/ - - - /* - Optionally include name-mangling macros for f2c external symbols. - */ - #ifdef MIX_C_AND_FORTRAN - #include "f2cMang.h" - #endif - - - /* - Include CSPICE platform macro definitions. - */ - #include "SpiceZpl.h" - - -#if ( defined(CSPICE_ALPHA_DIGITAL_UNIX ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_64BIT_NATIVE ) \ - || defined(CSPICE_MAC_OSX_INTEL_64BIT_GCC ) \ - || defined(CSPICE_SUN_SOLARIS_INTEL_64BIT_CC ) \ - || defined(CSPICE_PC_LINUX_64BIT_GCC ) ) - - - /* - MODIFICATION - - The following code is intended to be used on the platforms where - a long is the size of a double and an int is half the - size of a double. - - Note that the comment line below indicating that the header is - "Standard" has been retained from the original, but is no longer - true. - */ - - - - - -/* f2c.h -- Standard Fortran to C header file */ - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef int integer; -typedef unsigned uinteger; -typedef char *address; -typedef short int shortint; -typedef float real; -typedef double doublereal; -typedef struct { real r, i; } complex; -typedef struct { doublereal r, i; } doublecomplex; -typedef int logical; -typedef short int shortlogical; -typedef char logical1; -typedef char integer1; -#if 0 /* Adjust for integer*8. */ -typedef long longint; /* system-dependent */ -typedef unsigned long ulongint; /* system-dependent */ -#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) -#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) -#endif - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef int flag; -typedef int ftnlen; -typedef int ftnint; -#endif - -/*external read, write*/ -typedef struct -{ flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} cilist; - -/*internal read, write*/ -typedef struct -{ flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} icilist; - -/*open*/ -typedef struct -{ flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} olist; - -/*close*/ -typedef struct -{ flag cerr; - ftnint cunit; - char *csta; -} cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ flag aerr; - ftnint aunit; -} alist; - -/* inquire */ -typedef struct -{ flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - integer1 g; - shortint h; - integer i; - /* longint j; */ - real r; - doublereal d; - complex c; - doublecomplex z; - }; - -typedef union Multitype Multitype; - -/*typedef int Long;*/ /* No longer used; formerly in Namelist */ - -struct Vardesc { /* for Namelist */ - char *name; - char *addr; - ftnlen *dims; - int type; - }; -typedef struct Vardesc Vardesc; - -struct Namelist { - char *name; - Vardesc **vars; - int nvars; - }; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) -#define bit_test(a,b) ((a) >> (b) & 1) -#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) -#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint (*J_fp)(...); -typedef integer (*I_fp)(...); -typedef real (*R_fp)(...); -typedef doublereal (*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID (*C_fp)(...); -typedef /* Double Complex */ VOID (*Z_fp)(...); -typedef logical (*L_fp)(...); -typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); -typedef /* Subroutine */ int (*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint (*J_fp)(); -typedef integer (*I_fp)(); -typedef real (*R_fp)(); -typedef doublereal (*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID (*C_fp)(); -typedef /* Double Complex */ VOID (*Z_fp)(); -typedef logical (*L_fp)(); -typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_fp)(); -typedef /* Subroutine */ int (*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - /* - This marks the end of the MODIFICATION section version of f2c.h. - */ - -#else - - /* - The following code is the standard f2c.h header. In this - header, an "integer" is defined to be of type long. - - Because the code is copied verbatim, it does not follow the usual - CSPICE indentation pattern. - */ - - -/* f2c.h -- Standard Fortran to C header file */ - - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - -typedef long int integer; -typedef unsigned long uinteger; -typedef char *address; -typedef short int shortint; -typedef float real; -typedef double doublereal; -typedef struct { real r, i; } complex; -typedef struct { doublereal r, i; } doublecomplex; -typedef long int logical; -typedef short int shortlogical; -typedef char logical1; -typedef char integer1; -#if 0 /* Adjust for integer*8. */ -typedef long long longint; /* system-dependent */ -typedef unsigned long long ulongint; /* system-dependent */ -#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) -#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) -#endif - -#define TRUE_ (1) -#define FALSE_ (0) - -/* Extern is for use with -E */ -#ifndef Extern -#define Extern extern -#endif - -/* I/O stuff */ - -#ifdef f2c_i2 -/* for -i2 */ -typedef short flag; -typedef short ftnlen; -typedef short ftnint; -#else -typedef long int flag; -typedef long int ftnlen; -typedef long int ftnint; -#endif - -/*external read, write*/ -typedef struct -{ flag cierr; - ftnint ciunit; - flag ciend; - char *cifmt; - ftnint cirec; -} cilist; - -/*internal read, write*/ -typedef struct -{ flag icierr; - char *iciunit; - flag iciend; - char *icifmt; - ftnint icirlen; - ftnint icirnum; -} icilist; - -/*open*/ -typedef struct -{ flag oerr; - ftnint ounit; - char *ofnm; - ftnlen ofnmlen; - char *osta; - char *oacc; - char *ofm; - ftnint orl; - char *oblnk; -} olist; - -/*close*/ -typedef struct -{ flag cerr; - ftnint cunit; - char *csta; -} cllist; - -/*rewind, backspace, endfile*/ -typedef struct -{ flag aerr; - ftnint aunit; -} alist; - -/* inquire */ -typedef struct -{ flag inerr; - ftnint inunit; - char *infile; - ftnlen infilen; - ftnint *inex; /*parameters in standard's order*/ - ftnint *inopen; - ftnint *innum; - ftnint *innamed; - char *inname; - ftnlen innamlen; - char *inacc; - ftnlen inacclen; - char *inseq; - ftnlen inseqlen; - char *indir; - ftnlen indirlen; - char *infmt; - ftnlen infmtlen; - char *inform; - ftnint informlen; - char *inunf; - ftnlen inunflen; - ftnint *inrecl; - ftnint *innrec; - char *inblank; - ftnlen inblanklen; -} inlist; - -#define VOID void - -union Multitype { /* for multiple entry points */ - integer1 g; - shortint h; - integer i; - /* longint j; */ - real r; - doublereal d; - complex c; - doublecomplex z; - }; - -typedef union Multitype Multitype; - -/*typedef long int Long;*/ /* No longer used; formerly in Namelist */ - -struct Vardesc { /* for Namelist */ - char *name; - char *addr; - ftnlen *dims; - int type; - }; -typedef struct Vardesc Vardesc; - -struct Namelist { - char *name; - Vardesc **vars; - int nvars; - }; -typedef struct Namelist Namelist; - -#define abs(x) ((x) >= 0 ? (x) : -(x)) -#define dabs(x) (doublereal)abs(x) -#define min(a,b) ((a) <= (b) ? (a) : (b)) -#define max(a,b) ((a) >= (b) ? (a) : (b)) -#define dmin(a,b) (doublereal)min(a,b) -#define dmax(a,b) (doublereal)max(a,b) -#define bit_test(a,b) ((a) >> (b) & 1) -#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) -#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef int /* Unknown procedure type */ (*U_fp)(...); -typedef shortint (*J_fp)(...); -typedef integer (*I_fp)(...); -typedef real (*R_fp)(...); -typedef doublereal (*D_fp)(...), (*E_fp)(...); -typedef /* Complex */ VOID (*C_fp)(...); -typedef /* Double Complex */ VOID (*Z_fp)(...); -typedef logical (*L_fp)(...); -typedef shortlogical (*K_fp)(...); -typedef /* Character */ VOID (*H_fp)(...); -typedef /* Subroutine */ int (*S_fp)(...); -#else -typedef int /* Unknown procedure type */ (*U_fp)(); -typedef shortint (*J_fp)(); -typedef integer (*I_fp)(); -typedef real (*R_fp)(); -typedef doublereal (*D_fp)(), (*E_fp)(); -typedef /* Complex */ VOID (*C_fp)(); -typedef /* Double Complex */ VOID (*Z_fp)(); -typedef logical (*L_fp)(); -typedef shortlogical (*K_fp)(); -typedef /* Character */ VOID (*H_fp)(); -typedef /* Subroutine */ int (*S_fp)(); -#endif -/* E_fp is for real functions when -R is not specified */ -typedef VOID C_f; /* complex function */ -typedef VOID H_f; /* character function */ -typedef VOID Z_f; /* double complex function */ -typedef doublereal E_f; /* real function with -R not specified */ - -/* undef any lower-case symbols that your C compiler predefines, e.g.: */ - -#ifndef Skip_f2c_Undefs -#undef cray -#undef gcos -#undef mc68010 -#undef mc68020 -#undef mips -#undef pdp11 -#undef sgi -#undef sparc -#undef sun -#undef sun2 -#undef sun3 -#undef sun4 -#undef u370 -#undef u3b -#undef u3b2 -#undef u3b5 -#undef unix -#undef vax -#endif -#endif - - - #endif - diff --git a/ext/spice/src/csupport/f2cMang.h b/ext/spice/src/csupport/f2cMang.h deleted file mode 100644 index f18fded688..0000000000 --- a/ext/spice/src/csupport/f2cMang.h +++ /dev/null @@ -1,390 +0,0 @@ -/* - --Header_File f2cMang.h ( f2c external symbol mangling ) - --Abstract - - Define macros that mangle the external symbols in the f2c F77 and I77 - libraries. - --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. - --Particulars - - This header supports linking CSPICE into executables that - also link in objects compiled from Fortran, in particular - ones that perform Fortran I/O. To enable this odd mix, - one defines the preprocessor flag - - MIX_C_AND_FORTRAN - - This macro is undefined by default, since the action it invokes - is usually not desirable. When the flag is defined, this header - defines macros that mangle the f2c library external symbols: - the symbol - - xxx - - gets mapped to - - xxx_f2c - - This mangling prevents name collisions between the f2c - implementations of the F77 and I77 library routines and those - in the corresponding Fortran libraries on a host system. - - The set of external symbols defined in the f2c libraries can - be determined by combining objects from both F77 and I77 into - a single Unix archive libarary, then running the Unix utility - nm on the that archive. If available, an nm option that selects - only external symbols should be invoked. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - 1) It is recommended that use of the features implemented by this - header be avoided if at all possible. There are robustness and - portability problems associated with linking Fortran and C objects - together in one executable. - - 2) When f2c external symbol name mangling is invoked, objects - derived from C code translated from Fortran by f2c won't - link against CSPICE any longer, if these objects reference - the standard f2c external symbols. - - 3) The features implemented by this header have been tested only - under the Sun Solaris GCC, Sun Solaris native ANSI C, and - PC/Linux/gcc environments. - --Version - - -CSPICE Version 2.0.1, 07-MAR-2009 (NJB) - - Restrictions header section was updated to note successful - testing on the PC/Linux/gcc platform. - - -CSPICE Version 2.0.0, 19-DEC-2001 (NJB) - -*/ - - - /* - Define masking macros for f2c external symbols. - */ - #ifdef MIX_C_AND_FORTRAN - - /* - Define the macros only once, if they need to be defined. - */ - #ifndef F2C_MANGLING_DONE - - #define F77_aloc F77_aloc_f2c - #define F_err F_err_f2c - #define L_len L_len_f2c - #define abort_ abort__f2c - #define b_char b_char_f2c - #define c_abs c_abs_f2c - #define c_cos c_cos_f2c - #define c_dfe c_dfe_f2c - #define c_div c_div_f2c - #define c_due c_due_f2c - #define c_exp c_exp_f2c - #define c_le c_le_f2c - #define c_log c_log_f2c - #define c_sfe c_sfe_f2c - #define c_si c_si_f2c - #define c_sin c_sin_f2c - #define c_sqrt c_sqrt_f2c - #define c_sue c_sue_f2c - #define d_abs d_abs_f2c - #define d_acos d_acos_f2c - #define d_asin d_asin_f2c - #define d_atan d_atan_f2c - #define d_atn2 d_atn2_f2c - #define d_cnjg d_cnjg_f2c - #define d_cos d_cos_f2c - #define d_cosh d_cosh_f2c - #define d_dim d_dim_f2c - #define d_exp d_exp_f2c - #define d_imag d_imag_f2c - #define d_int d_int_f2c - #define d_lg10 d_lg10_f2c - #define d_log d_log_f2c - #define d_mod d_mod_f2c - #define d_nint d_nint_f2c - #define d_prod d_prod_f2c - #define d_sign d_sign_f2c - #define d_sin d_sin_f2c - #define d_sinh d_sinh_f2c - #define d_sqrt d_sqrt_f2c - #define d_tan d_tan_f2c - #define d_tanh d_tanh_f2c - #define derf_ derf__f2c - #define derfc_ derfc__f2c - #define do_fio do_fio_f2c - #define do_lio do_lio_f2c - #define do_ud do_ud_f2c - #define do_uio do_uio_f2c - #define do_us do_us_f2c - #define dtime_ dtime__f2c - #define e_rdfe e_rdfe_f2c - #define e_rdue e_rdue_f2c - #define e_rsfe e_rsfe_f2c - #define e_rsfi e_rsfi_f2c - #define e_rsle e_rsle_f2c - #define e_rsli e_rsli_f2c - #define e_rsue e_rsue_f2c - #define e_wdfe e_wdfe_f2c - #define e_wdue e_wdue_f2c - #define e_wsfe e_wsfe_f2c - #define e_wsfi e_wsfi_f2c - #define e_wsle e_wsle_f2c - #define e_wsli e_wsli_f2c - #define e_wsue e_wsue_f2c - #define ef1asc_ ef1asc__f2c - #define ef1cmc_ ef1cmc__f2c - #define en_fio en_fio_f2c - #define erf_ erf__f2c - #define erfc_ erfc__f2c - #define err__fl err__fl_f2c - #define etime_ etime__f2c - #define exit_ exit__f2c - #define f__Aquote f__Aquote_f2c - #define f__buflen f__buflen_f2c - #define f__cabs f__cabs_f2c - #define f__canseek f__canseek_f2c - #define f__cblank f__cblank_f2c - #define f__cf f__cf_f2c - #define f__cnt f__cnt_f2c - #define f__cp f__cp_f2c - #define f__cplus f__cplus_f2c - #define f__cursor f__cursor_f2c - #define f__curunit f__curunit_f2c - #define f__doed f__doed_f2c - #define f__doend f__doend_f2c - #define f__doned f__doned_f2c - #define f__donewrec f__donewrec_f2c - #define f__dorevert f__dorevert_f2c - #define f__elist f__elist_f2c - #define f__external f__external_f2c - #define f__fatal f__fatal_f2c - #define f__fmtbuf f__fmtbuf_f2c - #define f__formatted f__formatted_f2c - #define f__getn f__getn_f2c - #define f__hiwater f__hiwater_f2c - #define f__icend f__icend_f2c - #define f__icnum f__icnum_f2c - #define f__icptr f__icptr_f2c - #define f__icvt f__icvt_f2c - #define f__init f__init_f2c - #define f__inode f__inode_f2c - #define f__lchar f__lchar_f2c - #define f__lcount f__lcount_f2c - #define f__lioproc f__lioproc_f2c - #define f__lquit f__lquit_f2c - #define f__ltab f__ltab_f2c - #define f__ltype f__ltype_f2c - #define f__lx f__lx_f2c - #define f__ly f__ly_f2c - #define f__nonl f__nonl_f2c - #define f__nowreading f__nowreading_f2c - #define f__nowwriting f__nowwriting_f2c - #define f__parenlvl f__parenlvl_f2c - #define f__pc f__pc_f2c - #define f__putbuf f__putbuf_f2c - #define f__putn f__putn_f2c - #define f__r_mode f__r_mode_f2c - #define f__reading f__reading_f2c - #define f__reclen f__reclen_f2c - #define f__recloc f__recloc_f2c - #define f__recpos f__recpos_f2c - #define f__ret f__ret_f2c - #define f__revloc f__revloc_f2c - #define f__rp f__rp_f2c - #define f__scale f__scale_f2c - #define f__sequential f__sequential_f2c - #define f__svic f__svic_f2c - #define f__typesize f__typesize_f2c - #define f__units f__units_f2c - #define f__w_mode f__w_mode_f2c - #define f__workdone f__workdone_f2c - #define f_back f_back_f2c - #define f_clos f_clos_f2c - #define f_end f_end_f2c - #define f_exit f_exit_f2c - #define f_init f_init_f2c - #define f_inqu f_inqu_f2c - #define f_open f_open_f2c - #define f_rew f_rew_f2c - #define fk_open fk_open_f2c - #define flush_ flush__f2c - #define fmt_bg fmt_bg_f2c - #define fseek_ fseek__f2c - #define ftell_ ftell__f2c - #define g_char g_char_f2c - #define getenv_ getenv__f2c - #define h_abs h_abs_f2c - #define h_dim h_dim_f2c - #define h_dnnt h_dnnt_f2c - #define h_indx h_indx_f2c - #define h_len h_len_f2c - #define h_mod h_mod_f2c - #define h_nint h_nint_f2c - #define h_sign h_sign_f2c - #define hl_ge hl_ge_f2c - #define hl_gt hl_gt_f2c - #define hl_le hl_le_f2c - #define hl_lt hl_lt_f2c - #define i_abs i_abs_f2c - #define i_dim i_dim_f2c - #define i_dnnt i_dnnt_f2c - #define i_indx i_indx_f2c - #define i_len i_len_f2c - #define i_mod i_mod_f2c - #define i_nint i_nint_f2c - #define i_sign i_sign_f2c - #define iw_rev iw_rev_f2c - #define l_eof l_eof_f2c - #define l_ge l_ge_f2c - #define l_getc l_getc_f2c - #define l_gt l_gt_f2c - #define l_le l_le_f2c - #define l_lt l_lt_f2c - #define l_read l_read_f2c - #define l_ungetc l_ungetc_f2c - #define l_write l_write_f2c - #define lbit_bits lbit_bits_f2c - #define lbit_cshift lbit_cshift_f2c - #define lbit_shift lbit_shift_f2c - #define mk_hashtab mk_hashtab_f2c - #define nml_read nml_read_f2c - #define pars_f pars_f_f2c - #define pow_ci pow_ci_f2c - #define pow_dd pow_dd_f2c - #define pow_di pow_di_f2c - #define pow_hh pow_hh_f2c - #define pow_ii pow_ii_f2c - #define pow_ri pow_ri_f2c - #define pow_zi pow_zi_f2c - #define pow_zz pow_zz_f2c - #define r_abs r_abs_f2c - #define r_acos r_acos_f2c - #define r_asin r_asin_f2c - #define r_atan r_atan_f2c - #define r_atn2 r_atn2_f2c - #define r_cnjg r_cnjg_f2c - #define r_cos r_cos_f2c - #define r_cosh r_cosh_f2c - #define r_dim r_dim_f2c - #define r_exp r_exp_f2c - #define r_imag r_imag_f2c - #define r_int r_int_f2c - #define r_lg10 r_lg10_f2c - #define r_log r_log_f2c - #define r_mod r_mod_f2c - #define r_nint r_nint_f2c - #define r_sign r_sign_f2c - #define r_sin r_sin_f2c - #define r_sinh r_sinh_f2c - #define r_sqrt r_sqrt_f2c - #define r_tan r_tan_f2c - #define r_tanh r_tanh_f2c - #define rd_ed rd_ed_f2c - #define rd_ned rd_ned_f2c - #define s_cat s_cat_f2c - #define s_cmp s_cmp_f2c - #define s_copy s_copy_f2c - #define s_paus s_paus_f2c - #define s_rdfe s_rdfe_f2c - #define s_rdue s_rdue_f2c - #define s_rnge s_rnge_f2c - #define s_rsfe s_rsfe_f2c - #define s_rsfi s_rsfi_f2c - #define s_rsle s_rsle_f2c - #define s_rsli s_rsli_f2c - #define s_rsne s_rsne_f2c - #define s_rsni s_rsni_f2c - #define s_rsue s_rsue_f2c - #define s_stop s_stop_f2c - #define s_wdfe s_wdfe_f2c - #define s_wdue s_wdue_f2c - #define s_wsfe s_wsfe_f2c - #define s_wsfi s_wsfi_f2c - #define s_wsle s_wsle_f2c - #define s_wsli s_wsli_f2c - #define s_wsne s_wsne_f2c - #define s_wsni s_wsni_f2c - #define s_wsue s_wsue_f2c - #define sig_die sig_die_f2c - #define signal_ signal__f2c - #define system_ system__f2c - #define t_getc t_getc_f2c - #define t_runc t_runc_f2c - #define w_ed w_ed_f2c - #define w_ned w_ned_f2c - #define wrt_E wrt_E_f2c - #define wrt_F wrt_F_f2c - #define wrt_L wrt_L_f2c - #define x_endp x_endp_f2c - #define x_getc x_getc_f2c - #define x_putc x_putc_f2c - #define x_rev x_rev_f2c - #define x_rsne x_rsne_f2c - #define x_wSL x_wSL_f2c - #define x_wsne x_wsne_f2c - #define xrd_SL xrd_SL_f2c - #define y_getc y_getc_f2c - #define y_rsk y_rsk_f2c - #define z_abs z_abs_f2c - #define z_cos z_cos_f2c - #define z_div z_div_f2c - #define z_exp z_exp_f2c - #define z_getc z_getc_f2c - #define z_log z_log_f2c - #define z_putc z_putc_f2c - #define z_rnew z_rnew_f2c - #define z_sin z_sin_f2c - #define z_sqrt z_sqrt_f2c - #define z_wnew z_wnew_f2c - - #define F2C_MANGLING_DONE - - #endif - - - #endif - diff --git a/ext/spice/src/csupport/flgrpt.c b/ext/spice/src/csupport/flgrpt.c deleted file mode 100644 index ae2b82bbf4..0000000000 --- a/ext/spice/src/csupport/flgrpt.c +++ /dev/null @@ -1,175 +0,0 @@ -/* flgrpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ 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. */ - -/* Subroutine */ int flgrpt_(integer *nitems, char *names, char *values, U_fp - myio, ftnlen names_len, ftnlen values_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen), - s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char hard[1]; - logical free[129]; - integer i__, j, k, l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer width; - extern integer rtrim_(char *, ftnlen); - char style[200]; - extern /* Subroutine */ int chkout_(char *, ftnlen); - char letter[1]; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen), nspmrg_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int nicepr_1__(char *, char *, U_fp, ftnlen, - ftnlen); - - -/* This routine takes an array of names and an array of associated */ -/* value strings and produces a flagged set of outputs. This */ -/* routine signals no errors. */ - - -/* The routine MYIO is a routine that is supplied by the user */ -/* that can handle io of text lines without any action by the */ -/* routine that calls it. */ - -/* $ Version */ - -/* Inspekt Routine version 2.0.0, 7-APR-1995 (WLT) */ - -/* Unused variables LEFT and RIGHT were removed. */ - - -/* Spicelib functions */ - - if (return_()) { - return 0; - } - chkin_("FLGRPT", (ftnlen)6); - -/* First find the widest of the names: */ - - width = 0; - i__1 = *nitems; - for (i__ = 1; i__ <= i__1; ++i__) { - if (rtrim_(names + (i__ - 1) * names_len, names_len) > width) { - width = rtrim_(names + (i__ - 1) * names_len, names_len); - } - } - -/* Now for each of the NAME/VALUE pairs construct a style */ -/* string using NAMES and run the VALUES through NICEPR_1. */ - - i__1 = *nitems; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* First we need to find a character that is not used */ -/* in the NAMES(I)/VALUES(I) pair. We will use this as */ -/* a hardspace in our style string. */ - - for (j = 33; j <= 127; ++j) { - free[(i__2 = j) < 129 && 0 <= i__2 ? i__2 : s_rnge("free", i__2, - "flgrpt_", (ftnlen)102)] = TRUE_; - } - i__2 = width; - for (j = 1; j <= i__2; ++j) { - free[(i__3 = *(unsigned char *)&names[(i__ - 1) * names_len + (j - - 1)]) < 129 && 0 <= i__3 ? i__3 : s_rnge("free", i__3, - "flgrpt_", (ftnlen)106)] = FALSE_; - } - i__2 = i_len(values, values_len); - for (j = 1; j <= i__2; ++j) { - free[(i__3 = *(unsigned char *)&values[(i__ - 1) * values_len + ( - j - 1)]) < 129 && 0 <= i__3 ? i__3 : s_rnge("free", i__3, - "flgrpt_", (ftnlen)110)] = FALSE_; - } - j = 33; - while(! free[(i__2 = j) < 129 && 0 <= i__2 ? i__2 : s_rnge("free", - i__2, "flgrpt_", (ftnlen)114)] && j < 127) { - ++j; - } - *(unsigned char *)hard = (char) j; - -/* Set up the style we are going to use for this */ -/* value */ - - nspmrg_(style, (ftnlen)200); - suffix_("HARDSPACE", &c__1, style, (ftnlen)9, (ftnlen)200); - suffix_(hard, &c__1, style, (ftnlen)1, (ftnlen)200); - suffix_("FLAG", &c__1, style, (ftnlen)4, (ftnlen)200); - l = rtrim_(style, (ftnlen)200) + 2; - i__2 = width; - for (k = 1; k <= i__2; ++k) { - *(unsigned char *)letter = *(unsigned char *)&names[(i__ - 1) * - names_len + (k - 1)]; - if (*(unsigned char *)letter == ' ') { - *(unsigned char *)&style[l - 1] = *(unsigned char *)hard; - } else { - *(unsigned char *)&style[l - 1] = *(unsigned char *)letter; - } - ++l; - } - *(unsigned char *)&style[l - 1] = ':'; - ++l; - *(unsigned char *)&style[l - 1] = *(unsigned char *)hard; - -/* Ok. Now just ship the stuff to the output routines. */ - - if (s_cmp(names + (i__ - 1) * names_len, " ", names_len, (ftnlen)1) == - 0 && s_cmp(values + (i__ - 1) * values_len, " ", values_len, - (ftnlen)1) == 0) { - i__2 = l - 2; - s_copy(style + i__2, hard, l - 1 - i__2, (ftnlen)1); - nicepr_1__(hard, style, (U_fp)myio, (ftnlen)1, l); - } else if (s_cmp(values + (i__ - 1) * values_len, " ", values_len, ( - ftnlen)1) == 0) { - i__2 = l - 2; - s_copy(style + i__2, hard, l - 1 - i__2, (ftnlen)1); - nicepr_1__(hard, style, (U_fp)myio, (ftnlen)1, l); - } else { - nicepr_1__(values + (i__ - 1) * values_len, style, (U_fp)myio, - values_len, l); - } - } - chkout_("FLGRPT", (ftnlen)6); - return 0; -} /* flgrpt_ */ - diff --git a/ext/spice/src/csupport/fndntk.c b/ext/spice/src/csupport/fndntk.c deleted file mode 100644 index dacc9c87d2..0000000000 --- a/ext/spice/src/csupport/fndntk.c +++ /dev/null @@ -1,482 +0,0 @@ -/* fndntk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FNDNTK ( Find the next token in a string ) */ -/* Subroutine */ int fndntk_(char *string, char *delims, integer *start, - integer *beg, integer *end, ftnlen string_len, ftnlen delims_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_indx(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - integer last, b; - logical blank, space, deliml, delimr, nodelm; - integer nbl, eol, nbr; - -/* $ Abstract */ - -/* Find the next token in a string delimited by multiple delimiters. */ - -/* $ 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 */ - -/* CHARACTER, STRING, PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String of items delimited by DELIMS. */ -/* DELIMS I Single characters which delimit items. */ -/* START I Point to start looking for a token in the string. */ -/* BEG O Beginning index of the token. */ -/* END O End index of the token. */ - -/* $ Detailed_Input */ - -/* STRING is a character string containing tokens delimited */ -/* by any one of the characters in the string DELIMS. */ -/* Consecutive delimiters, and delimiters at the */ -/* beginning and end of the string, are considered to */ -/* delimit null items. A blank string is considered to */ -/* contain a single (blank) item. */ - -/* DELIMS contains the individual characters which delimit */ -/* the items in the string. These may be any ASCII */ -/* characters, including blanks. */ - -/* However, by definition, consecutive blanks are NOT */ -/* considered to be consecutive delimiters. Nor is */ -/* a blank and any other delimiter considered to be */ -/* consecutive delimiters. In addition, leading and */ -/* trailing blanks are ignored. (See "Particulars" */ -/* for a discussion of blanks and how they are treated.) */ - -/* START is the point in the string to begin looking for the */ -/* next token in the string. To search for tokens in */ -/* a string begin with START = 1, and for subsequent */ -/* calls set START to END + 2, where END was returned */ -/* by the previous call. */ - -/* $ Detailed_Output */ - -/* BEG is the beginning of the substring containing the */ -/* token. */ - -/* END is the end of the substring containing the token. */ - -/* $ Exceptions */ - -/* 1. If START is less than 1 it will be treated as though it were */ -/* 1. */ - -/* 2. If START is the declared length of the string plus 1 and the */ -/* last non-blank character is a delimiter (or the string is */ -/* blank) START will be regarded as pointing at a null token. */ -/* BEG = LEN(STRING) + 1, END = LEN(STRING). */ - -/* 3. If START is at least two greater than the declared length of */ -/* the string, BEG and END will be returned as zero. */ - - -/* $ Particulars */ - - -/* For the purposes of discussion, we regard STRING to be a */ -/* substring of the string that begins with a meta-delimiter */ -/* followed by STRING and ends with a meta-delimiter. The */ -/* meta-delimiters have indexes 0 and LEN(STRING)+1. */ -/* Meta-delimiters are non-blank delimiters. */ - -/* A token is a substring that */ - -/* 1. begins with a non-blank character, */ -/* 2. ends with a non-blank character, */ -/* 3. contains no delimiters */ -/* 4. cannot be extended on either end without violating */ -/* on of the first 3 conditions. */ - -/* A good question to ask at this point is: */ - -/* "Suppose that ',' is a delimiter and the string contains */ -/* the substring ', ,' . Is there a token between */ -/* the two commas? */ - -/* Our answer to this question is "Yes". But from the rules */ -/* 1 through 4 above, whatever it is can contain no characters. */ -/* We call such a token a null token. Another question: */ - -/* "Ok. There's a token. Where does it begin and end?" */ - -/* Now we have to adopt some convention. The only consistent */ -/* one we could think of was this: The null token begins at */ -/* the second delimiter and ends at the previous character. */ - -/* Beginning at the second delimiter seems reasonable. The */ -/* only consistent way to define the end is to give an index */ -/* such that the length computation END - BEG + 1 yields 0. */ -/* So whatever, we do for the beginning, end must be BEG - 1. */ - -/* Choosing the beginning to be the second of the two delimiters */ -/* makes it possible to easily move on to the next delimiter. */ -/* If the assignment START = END + 2 is made after a call to */ -/* the routine, then START will always point beyond the end */ -/* of the token just found and will always point no further */ -/* than the beginning of the next token ( if there is one). */ -/* If we keep in mind that there are meta-delimiters at the ends */ -/* of the string then a string that begins with ', ...' */ -/* begins with a null token. A string that ends with ... , ' */ -/* ends with a null token. In the first case the beginning */ -/* of the null token is at character 1 of the string. In the second */ -/* case the null token begins at LEN(STRING) + 1, i.e. at the */ -/* meta-delimiter past the end of the string. */ - -/* Using these conventions, this routine finds the beginning and */ -/* end of the first token that begins at or following the input */ -/* START position in the string. If no tokens follow the input */ -/* index, then both BEG and END will be returned as zero. This is */ -/* the only case in which BEG will be returned as non-positive. */ - -/* $ Examples */ - -/* STRING = */ - -/* 'A FEW OF US, THE BAD-BOYS, WENT TO TOWN IN 8//1984-' */ - -/* 1 2 3 4 5 */ -/* 123456789012345678901234567890123456789012345678901 */ - -/* If DELIMS = ' ,-/' */ - -/* Tokens BEG END */ -/* ------ --- --- */ -/* 'A' 1 1 */ -/* 'FEW' 3 5 */ -/* 'OF' 7 8 */ -/* 'US' 10 11 */ -/* 'THE' 14 16 */ -/* 'BAD' 18 20 */ -/* 'BOYS' 22 24 */ -/* 'WENT' 28 31 */ -/* 'TO' 33 34 */ -/* 'TOWN' 36 39 */ -/* 'IN' 41 42 */ -/* '8' 44 44 */ -/* null 46 45 */ -/* '1984' 47 50 */ -/* null 52 51 */ - - -/* If DELIMS = ',/' */ - -/* Tokens BEG END */ -/* ------ --- --- */ -/* 'A FEW OF US' 1 11 */ -/* 'THE BAD-BOYS' 18 25 */ -/* 'WENT TO TOWN IN 8' 28 44 */ -/* null 46 45 */ -/* '1984-' 47 51 */ - - -/* To get all of the tokens in a string the following loop of code */ -/* will suffice */ - - -/* BEG = 1 */ -/* START = 1 */ - -/* DO WHILE ( BEG .NE. 0 ) */ - -/* CALL FNDNTK ( STRING, DELIMS, START, BEG, END ) */ - -/* do something with the token STRING(BEG:END) taking */ -/* appropriate care of the null tokens. */ - -/* START = END + 2 */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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, 3-MAY-1988 (WLT) (IMU) */ - -/* -& */ - -/* Local variables */ - -/* %&END_DECLARATIONS */ - -/* First we gather some data regarding the input string and */ -/* delimiters */ - - space = i_indx(delims, " ", delims_len, (ftnlen)1) != 0; - last = i_len(string, string_len); - eol = last + 1; - b = max(1,*start); - -/* We don't have to do anything if we are starting past the end of */ -/* the string. */ - - if (b > eol) { - *beg = 0; - *end = 0; - return 0; - } - -/* Find the first non-blank character at or to the right of where */ -/* we are starting. */ - - blank = TRUE_; - nbr = b; - while(blank) { - if (nbr >= eol) { - blank = FALSE_; - } else if (*(unsigned char *)&string[nbr - 1] != ' ') { - blank = FALSE_; - } else { - ++nbr; - } - } - -/* Find the first non-blank character and first non-blank delimiter */ -/* to the left of the starting point. */ - - blank = TRUE_; - nbl = b - 1; - while(blank) { - if (nbl <= 0) { - blank = FALSE_; - } else if (*(unsigned char *)&string[nbl - 1] != ' ') { - blank = FALSE_; - } else { - --nbl; - } - } - -/* If both the preceeding non-blank character and the following */ -/* non-blank character are delimiters, we have a null item. */ - - if (nbr >= eol) { - delimr = TRUE_; - } else { - delimr = i_indx(delims, string + (nbr - 1), delims_len, (ftnlen)1) != - 0; - } - if (nbl <= 0) { - deliml = TRUE_; - } else { - deliml = i_indx(delims, string + (nbl - 1), delims_len, (ftnlen)1) != - 0; - } - if (delimr && deliml) { - *beg = nbr; - *end = *beg - 1; - return 0; - } - -/* Still here? See if we were past the last delimiter. */ - - if (nbr >= eol && ! deliml) { - *beg = 0; - *end = 0; - return 0; - } - -/* If the left most non-blank is a delimiter OR a blank is a */ -/* delimiter and the non-blank character to the left is at least */ -/* two characters away from the right non-blank character, then */ -/* we have a token beginning at the right non-blank. We just need */ -/* to find the right boundary. */ - - if (deliml || nbr - nbl >= 2 && space && ! delimr) { - *beg = nbr; - *end = *beg; - -/* Note: DELIMR is already .FALSE. or else we couldn't get to */ -/* this point. */ - - while(! delimr) { - if (*end + 1 >= eol) { - delimr = TRUE_; - } else /* if(complicated condition) */ { - i__1 = *end; - if (i_indx(delims, string + i__1, delims_len, *end + 1 - i__1) - != 0) { - delimr = TRUE_; - } else { - ++(*end); - } - } - } - -/* Back up END to the first non-blank that precedes it. */ - - while(*(unsigned char *)&string[*end - 1] == ' ') { - --(*end); - } - return 0; - } - -/* Still here? In that case we were in the middle of something */ -/* to start with. Move the pointer forward until we reach a */ -/* delimiter. */ - -/* Keep in mind that DELIMR still has the information as to whether */ -/* or not NBR points to a non-blank delimiter. We are going to use */ -/* this information to determine whether to look for a delimiter */ -/* first or not. */ - - if (! delimr) { - nodelm = TRUE_; - b = nbr; - while(nodelm) { - ++nbr; - if (nbr >= eol) { - nodelm = FALSE_; - } else { - nodelm = i_indx(delims, string + (nbr - 1), delims_len, ( - ftnlen)1) == 0; - } - } - -/* If a space is a delimiter and we happen to have landed on one, */ -/* we want to continue until we hit a non-blank delimiter or just */ -/* before a non-blank character. */ - - if (space && nbr < eol) { - nodelm = *(unsigned char *)&string[nbr - 1] == ' '; - while(nodelm) { - ++nbr; - if (nbr == eol) { - nodelm = FALSE_; - } else if (i_indx(delims, string + (nbr - 1), delims_len, ( - ftnlen)1) != 0) { - nodelm = *(unsigned char *)&string[nbr - 1] == ' '; - } else if (*(unsigned char *)&string[nbr - 1] != ' ') { - nodelm = FALSE_; - -/* Back up one, to just before the non-blank character */ - - --nbr; - } - } - } - -/* Since we did not start on a delimiter if we reached the end of */ -/* the string before hitting one, then there is no token to find */ -/* here. */ - - if (nbr >= eol) { - *beg = 0; - *end = 0; - return 0; - } - } - -/* Still here? Then starting at the first character to the right of */ -/* the delimiter, find the next non-blank character, and the next */ -/* right delimiter after that. */ - - nbl = nbr; - blank = TRUE_; - while(blank) { - ++nbl; - if (nbl >= eol) { - blank = FALSE_; - } else { - blank = *(unsigned char *)&string[nbl - 1] == ' '; - } - } - -/* Now locate the next delimiter. */ - - nbr = nbl - 1; - delimr = FALSE_; - while(! delimr) { - ++nbr; - if (nbr >= eol) { - delimr = TRUE_; - } else { - delimr = i_indx(delims, string + (nbr - 1), delims_len, (ftnlen)1) - != 0; - } - } - *beg = nbl; - *end = nbr - 1; - if (*end > *beg) { - -/* Backup until we are at a non-space. */ - - while(*(unsigned char *)&string[*end - 1] == ' ' && *end > *beg) { - --(*end); - } - } - return 0; -} /* fndntk_ */ - diff --git a/ext/spice/src/csupport/fndptk.c b/ext/spice/src/csupport/fndptk.c deleted file mode 100644 index 3b82a5756b..0000000000 --- a/ext/spice/src/csupport/fndptk.c +++ /dev/null @@ -1,480 +0,0 @@ -/* fndptk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure FNDPTK ( Find the previous token in a string ) */ -/* Subroutine */ int fndptk_(char *string, char *delims, integer *start, - integer *beg, integer *end, ftnlen string_len, ftnlen delims_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen), - s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, b; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen), cposr_( - char *, char *, integer *, ftnlen, ftnlen); - logical atdelm; - extern /* Subroutine */ int fndntk_(char *, char *, integer *, integer *, - integer *, ftnlen, ftnlen); - logical onspce; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern integer ncposr_(char *, char *, integer *, ftnlen, ftnlen); - extern logical return_(void); - integer eol; - -/* $ Abstract */ - -/* Find the previous token in a string delimited by multiple */ -/* delimiters. */ - -/* $ 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 */ - -/* CHARACTER, STRING, PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String of items delimited by DELIMS. */ -/* DELIMS I Single characters which delimit items. */ -/* START I Point to start looking for a token in the string. */ -/* BEG O Beginning index of the token. */ -/* END O End index of the token. */ - -/* $ Detailed_Input */ - -/* STRING is a character string containing tokens delimited */ -/* by any one of the characters in the string DELIMS. */ -/* Consecutive delimiters, and delimiters at the */ -/* beginning and end of the string, are considered to */ -/* delimit null items. A blank string is considered to */ -/* contain a single (blank) item. */ - -/* DELIMS contains the individual characters which delimit */ -/* the items in the string. These may be any ASCII */ -/* characters, including blanks. */ - -/* However, by definition, consecutive blanks are NOT */ -/* considered to be consecutive delimiters. Nor is */ -/* a blank and any other delimiter considered to be */ -/* consecutive delimiters. In addition, leading and */ -/* trailing blanks are ignored. (See "Particulars" */ -/* for a discussion of blanks and how they are treated.) */ - -/* START is the point in the string to begin looking for the */ -/* previous token in the string. To search for tokens */ -/* in a string begin with START = LEN(STRING) + 2 and */ -/* for subsequent calls set START to BEG, where BEG */ -/* was returned by the previous call. */ - -/* $ Detailed_Output */ - -/* BEG is the beginning of the substring containing the */ -/* token. */ - -/* END is the end of the substring containing the token. */ - -/* $ Parameters */ - -/* None. */ - - -/* $ Exceptions */ - -/* 1. If START is more than two greater than the length of the */ -/* string it will be treated as though its length is two more */ -/* than the length of the string. Then if there is a null */ -/* string at the end of the string BEG will point to */ -/* LEN(STRING) + 1, otherwise it will point to the beginning */ -/* of the last token in the string. */ - -/* 2. If START is LEN(STRING) + 1, BEG will point to the beginning */ -/* of the last token that preceeds the end of the string. */ - -/* 2. If START is at less than or equal to 1, BEG and END will be */ -/* returned as zero. */ - - -/* $ Particulars */ - - -/* For the purposes of discussion, we regard STRING to be a */ -/* substring of the string that begins with a meta-delimiter */ -/* followed by STRING and ends with a meta-delimiter. The */ -/* meta-delimiters have indexes 0 and LEN(STRING)+1. */ -/* Meta-delimiters are non-blank delimiters. */ - -/* A token is a substring that */ - -/* 1. begins with a non-blank character, */ -/* 2. ends with a non-blank character, */ -/* 3. contains no delimiters */ -/* 4. cannot be extended on either end without violating */ -/* on of the first 3 conditions. */ - -/* A good question to ask at this point is: */ - -/* "Suppose that ',' is a delimiter and the string contains */ -/* the substring ', ,' . Is there a delimiter between */ -/* the two commas? */ - -/* Our answer to this question is "Yes". But from the rules */ -/* 1 through 4 above, whatever it is can contain no characters. */ -/* We call such a token a null token. Another question: */ - -/* "Ok. There's a token. Where does it begin and end?" */ - -/* Now we have to adopt some convention. The only consistent */ -/* one we could think of was this: The null token begins at */ -/* the second delimiter and ends at the previous character. */ - -/* Beginning at the second delimiter seems reasonable. The */ -/* only consistent way to define the end is to give an index */ -/* such that the length computation END - BEG + 1 yields 0. */ -/* So whatever, we do for the beginning, end must be BEG - 1. */ - -/* Choosing the beginning to be the second of the two delimiters */ -/* makes it possible to easily move on to the next delimiter. */ -/* If the assignment START = END + 2 is made after a call to */ -/* the routine, then START will always point beyond the end */ -/* of the token just found and will always point no further */ -/* than the beginning of the next token ( if there is one). */ -/* If we keep in mind that there are meta-delimiters at the ends */ -/* of the string then a string that begins with ', ...' */ -/* begins with a null token. A string that ends with ... , ' */ -/* ends with a null token. In the first case the beginning */ -/* of the null token is at character 1 of the string. In the second */ -/* case the null token begins at LEN(STRING) + 1, i.e. at the */ -/* meta-delimiter past the end of the string. */ - -/* Using these conventions, this routine finds the beginning and */ -/* end of the last token that ends strictly before the input */ -/* START position in the string. If no tokens preceeded the input */ -/* index, then both BEG and END will be returned as zero. This is */ -/* the only case in which BEG will be returned as non-positive. */ - -/* $ Examples */ - -/* STRING = */ - -/* 'A FEW OF US, THE BAD-BOYS, WENT TO TOWN IN 8//1984-' */ - -/* 1 2 3 4 5 */ -/* 123456789012345678901234567890123456789012345678901 */ - -/* If DELIMS = ' ,-/' */ - -/* Tokens BEG END */ -/* ------ --- --- */ -/* 'A' 1 1 */ -/* 'FEW' 3 5 */ -/* 'OF' 7 8 */ -/* 'US' 10 11 */ -/* 'THE' 14 16 */ -/* 'BAD' 18 20 */ -/* 'BOYS' 22 24 */ -/* 'WENT' 28 31 */ -/* 'TO' 33 34 */ -/* 'TOWN' 36 39 */ -/* 'IN' 41 42 */ -/* '8' 44 44 */ -/* null 46 45 */ -/* '1984' 47 50 */ -/* null 52 51 */ - - -/* If DELIMS = ',/' */ - -/* Tokens BEG END */ -/* ------ --- --- */ -/* 'A FEW OF US' 1 11 */ -/* 'THE BAD-BOYS' 18 25 */ -/* 'WENT TO TOWN IN 8' 28 44 */ -/* null 46 45 */ -/* '1984-' 47 51 */ - - -/* To get all of the tokens in a string the following loop of code */ -/* will suffice */ - - -/* BEG = 1 */ -/* START = LEN ( STRING ) + 2 */ - -/* DO WHILE ( BEG .NE. 0 ) */ - -/* CALL FNDPTK ( STRING, DELIMS, START, BEG, END ) */ - -/* do something with the token STRING(BEG:END) taking */ -/* appropriate care of the null tokens. */ - -/* START = BEG */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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, 3-MAY-1988 (WLT) (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find a token preceding a location in a string */ - -/* -& */ - -/* SPICE funtions. */ - - -/* Local variables */ - -/* %&END_DECLARATIONS */ - -/* Standard SPICE error handling */ - - if (return_()) { - return 0; - } else { - chkin_("FNDPTK", (ftnlen)6); - } - -/* First we gather some data regarding the input string and */ -/* delimiters */ - - last = i_len(string, string_len); - eol = last + 1; -/* Computing MIN */ - i__1 = eol + 1; - b = min(i__1,*start); - -/* We don't have to do anything if we are starting past the end of */ -/* the string. */ - - if (b < 1) { - *beg = 0; - *end = 0; - chkout_("FNDPTK", (ftnlen)6); - return 0; - } - if (b < eol) { - onspce = *(unsigned char *)&string[b - 1] == ' '; - } else { - onspce = FALSE_; - } - -/* Are we currently pointing at a delimiter? */ - - if (b > eol) { - atdelm = FALSE_; - } else if (b == eol) { - atdelm = TRUE_; - } else if (i_indx(delims, string + (b - 1), delims_len, (ftnlen)1) != 0) { - atdelm = TRUE_; - } else { - atdelm = FALSE_; - } - if (atdelm) { - -/* Yes. Move left to a non-blank character */ - - i__1 = b - 1; - b = ncposr_(string, " ", &i__1, string_len, (ftnlen)1); - -/* If we didn't find a non-blank, then there is not a previous */ -/* token. */ - - if (b == 0) { - *beg = 0; - *end = 0; - chkout_("FNDPTK", (ftnlen)6); - return 0; - } - -/* Still here? Are we currently pointing at a delimiter? */ - - if (i_indx(delims, string + (b - 1), delims_len, (ftnlen)1) != 0) { - -/* Yes. Move left to a non-blank. */ - - i__1 = b - 1; - b = ncposr_(string, " ", &i__1, string_len, (ftnlen)1); - } - -/* Move left to a delimiter, then Move right 1 */ - - b = cposr_(string, delims, &b, string_len, delims_len) + 1; - -/* Are we on a space? */ - - } else if (onspce) { - -/* Yes. (note: space is not a delimiter ) Find the next */ -/* non-blank to the right. */ - - b = ncpos_(string, " ", &b, string_len, (ftnlen)1); - -/* Is this a delimiter? */ - - if (b == 0) { - -/* it was all blanks to the end of the string. Make the */ -/* B point to the end + 1, that is a delimiter */ - - b = eol; - b = cposr_(string, delims, &b, string_len, delims_len); - } else if (i_indx(delims, string + (b - 1), delims_len, (ftnlen)1) == - 0) { - -/* No. Move left to the first delimiter. */ - - b = cposr_(string, delims, &b, string_len, delims_len); - -/* If we ran off the front of the string without hitting a */ -/* delimiter, there isn't a previous token. Checkout and */ -/* head for home. */ - - if (b == 0) { - *beg = 0; - *end = 0; - chkout_("FNDPTK", (ftnlen)6); - return 0; - } - } - -/* Move left to the first delimiter. */ -/* Move right 1 */ - - i__1 = b - 1; - b = cposr_(string, delims, &i__1, string_len, delims_len) + 1; - } else { - -/* Otherwise */ - -/* Move left to the first delimiter. */ - - if (b > eol) { - b = eol; - } else { - b = cposr_(string, delims, &b, string_len, delims_len); - -/* B is now pointing at a delimiter. */ - - } -/* ---------- */ - if (b == 0) { - *beg = 0; - *end = 0; - chkout_("FNDPTK", (ftnlen)6); - return 0; - } - -/* Move left to the first non-blank (here or to the left) */ - - if (b < eol) { - b = ncposr_(string, " ", &b, string_len, (ftnlen)1); - -/* B is now pointing to the first non-blank character to the */ -/* left of the token we started in. */ - - i__1 = b - 2; - if (i_indx(delims, string + (b - 1), delims_len, (ftnlen)1) != 0 - && i_indx(delims, " ", delims_len, (ftnlen)1) != 0 && - s_cmp(string + i__1, " ", b - 1 - i__1, (ftnlen)1) == 0) { - -/* Move backwards to the true delimiter for the token */ -/* that ends here. */ - - i__1 = b - 1; - b = ncposr_(string, " ", &i__1, string_len, (ftnlen)1) + 1; - } - } else { - -/* If we were at or beyond the EOL position, we need to */ -/* know if backing up to a non-blank puts us on a delimiter */ -/* or not. If it does reset B to EOL. */ - - b = ncposr_(string, " ", &b, string_len, (ftnlen)1); - if (i_indx(delims, string + (b - 1), delims_len, (ftnlen)1) != 0) - { - b = eol; - } - } - -/* Move left to the first deliter, and then move right 1. */ - - i__1 = b - 1; - b = cposr_(string, delims, &i__1, string_len, delims_len) + 1; - } - fndntk_(string, delims, &b, beg, end, string_len, delims_len); - chkout_("FNDPTK", (ftnlen)6); - return 0; -} /* fndptk_ */ - diff --git a/ext/spice/src/csupport/fnducv.c b/ext/spice/src/csupport/fnducv.c deleted file mode 100644 index 20a731e788..0000000000 --- a/ext/spice/src/csupport/fnducv.c +++ /dev/null @@ -1,957 +0,0 @@ -/* fnducv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure FNDUCV ( Find unit, class and value. ) */ -/* Subroutine */ int fnducv_(char *unin, logical *known, integer *class__, - doublereal *value, ftnlen unin_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - doublereal d__1; - - /* Builtin functions */ - double sin(doublereal); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - static doublereal lsec, lday, lmin; - static integer iaus, i__, j; - static char candp[33]; - static doublereal scale; - static char cands[32]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static doublereal hrang; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static char names[8*1]; - extern logical benum_(char *, ftnlen); - static doublereal light; - static logical found; - static doublereal lyear; - extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); - static integer count; - static char error[32]; - static doublereal lhour; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern doublereal twopi_(void); - static char units[32*84]; - static doublereal au; - extern doublereal pi_(void); - static doublereal degree, arcsec, secang; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static doublereal arcmin; - extern doublereal clight_(void); - static doublereal minang, parsec; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen), - reordc_(integer *, integer *, char *, ftnlen), reordd_(integer *, - integer *, doublereal *); - static logical update; - static integer iparsc, nnames, ordvec[84]; - extern /* Subroutine */ int reordi_(integer *, integer *, integer *); - static integer uclass[84]; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - static doublereal uvalue[84]; - extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), suffix_( - char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *, - ftnlen), rtpool_(char *, integer *, doublereal *, logical *, - ftnlen), swpool_(char *, integer *, char *, ftnlen, ftnlen); - static integer iau; - static doublereal rev; - static integer ptr; - -/* $ Abstract */ - -/* Find the class (length, time, angle, mass, charge) and value of */ -/* 1 unit relative to the reference set of units ( radian, km, sec, */ -/* kg, coulomb). */ - -/* $ 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 */ - -/* CONSTANTS */ -/* CONVERSION */ -/* PARSING */ -/* UNITS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIN I string that may be a primitive unit. */ -/* KNOWN O indicates whether UNIN was recognized. */ -/* CLASS O type of unit (angle, time, length, mass, charge). */ -/* VALUE O the number of these units in 1 reference unit. */ - -/* $ Detailed_Input */ - -/* UNIN is a string that may be a number or one of the */ -/* primitive units of angle, time, length, mass or */ -/* charge. A list of recognized units are given below. */ -/* The case of UNIN (upper or lower) is insignificant. */ - -/* $ Detailed_Output */ - -/* KNOWN is true if UNIN is recognized as a primitive unit, */ -/* or number. Otherwise it is .FALSE. */ - -/* CLASS is the type of UNIN if it is recognized. The class */ -/* values are: */ - -/* 0 for a number */ -/* 1 for an angle */ -/* 2 for length */ -/* 3 for time */ -/* 4 for mass */ -/* 5 for charge */ - -/* if UNIN is not recognized as belonging to any of these */ -/* classes, CLASS is assigned the value of -1. */ - -/* VALUE is the value of 1 UNIN in reference units. */ -/* The reference units are: */ - -/* Number 1 */ -/* Angle radians */ -/* length kilometers */ -/* time second */ -/* mass kilogram */ -/* charge coulomb */ - -/* if UNIN is not recognized as belonging to any of these */ -/* classes, VALUE is set to 0.0d0. */ -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) This routine is NOT case sensitive. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine examines UNIN and determines if it is a number or */ -/* recognized unit of angle, length, time, mass or charge. If */ -/* it is recognized it sets a logical variable to .TRUE. to */ -/* indicate the recognition. In addition, it returns the type of */ -/* object as an integer code: 0 for number, 1 for angle, */ -/* 2 for length, 3 for time and 5 for charge. Finally it returns */ -/* the number of fundamental units 1 UNIN is equal to. The */ -/* fundamental units for each class of object are: */ - -/* number --- 1 */ -/* angle --- radians */ -/* length --- kilometers */ -/* time --- seconds */ -/* mass --- kilograms */ -/* charge --- coulombs */ - -/* The routine does not recognize any compound units such as */ -/* newtons or joules. */ - -/* $ Examples */ - -/* This routine is intended primarily as a utility routine for */ -/* a more general units conversion routine. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 24-MAY-1991 (WLT) */ - -/* -& */ - -/* SPICELIB Functions */ - - - -/* Local parameters */ - - -/* These are the various classes of recognized objects. */ - - -/* The reference values for length will be kilometers */ -/* for time will be seconds */ -/* for angles will be radians */ -/* for mass will be kilograms */ -/* for charge will be coulombs */ - - -/* This value will be computed at run time or default to the */ -/* value given here. */ - - -/* Some of the units are not "defined" quantities. In such a case */ -/* a best estimate is provided as of the date of the current version */ -/* of this routine. Those estimated quantities are: */ - -/* 1 AU --- the astronomical unit is taken from the JPL */ -/* ephemeris DE200. It is believed to be accurate to */ -/* about 40 meters. */ - -/* The tropical year is the time from equinox to equinox. This */ -/* varies slightly with time. */ - -/* 1 PARSEC --- is dependent upon the value of the astronomical */ -/* unit. */ - - -/* 1.0d0 divided by the sin of 1 arc second */ - - -/* Local variables */ - - -/* Conversion values. */ - - -/* Initial values */ - - -/* This next block of code sets up the constants, names, values */ -/* and classes for all the recognized strings. We do this here */ -/* because FORTRAN just doesn't do this kind of stuff in a */ -/* convenient manner. */ - - if (first) { - first = FALSE_; - degree = pi_() / 180.; - arcmin = degree / 60.; - arcsec = arcmin / 60.; - scale = 1. / sin(arcsec); - secang = arcsec * 15.; - minang = arcmin * 15.; - hrang = degree * 15.; - rev = twopi_(); - light = clight_(); - lsec = light * 1.; - lmin = light * 60.; - lhour = light * 3600.; - lday = light * 86400.; - lyear = light * 31557600.; - nnames = 1; - s_copy(names, "AU", (ftnlen)8, (ftnlen)2); - -/* If available and the value of the AU is reasonable, we fetch */ -/* it from the kernel pool. Otherwise we use the value in */ -/* DE200. */ - - swpool_("FNDUCV", &nnames, names, (ftnlen)6, (ftnlen)8); - cvpool_("FNDUCV", &update, (ftnlen)6); - rtpool_("AU", &i__, &au, &found, (ftnlen)2); - if (! found) { - au = 149597870.66; - } else if ((d__1 = au - 149597870.66, abs(d__1)) > 10.) { - au = 149597870.66; - } - parsec = scale * au; - i__ = 0; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)433)) << 5), "METERS", ( - ftnlen)32, (ftnlen)6); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)434)] = .001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)435)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)438)) << 5), "CM", (ftnlen) - 32, (ftnlen)2); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)439)] = 1.0000000000000001e-5; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)440)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)443)) << 5), "KM", (ftnlen) - 32, (ftnlen)2); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)444)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)445)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)448)) << 5), "KMS", (ftnlen) - 32, (ftnlen)3); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)449)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)450)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)453)) << 5), "CENTIMETERS", - (ftnlen)32, (ftnlen)11); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)454)] = 1.0000000000000001e-5; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)455)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)458)) << 5), "KILOMETERS", ( - ftnlen)32, (ftnlen)10); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)459)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)460)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)463)) << 5), "INCH", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)464)] = 2.5400000000000001e-5; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)465)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)468)) << 5), "INCHES", ( - ftnlen)32, (ftnlen)6); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)469)] = 2.5400000000000001e-5; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)470)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)473)) << 5), "FOOT", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)474)] = 3.0480000000000004e-4; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)475)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)478)) << 5), "FEET", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)479)] = 3.0480000000000004e-4; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)480)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)483)) << 5), "YARDS", ( - ftnlen)32, (ftnlen)5); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)484)] = 9.1440000000000011e-4; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)485)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)488)) << 5), "AU", (ftnlen) - 32, (ftnlen)2); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)489)] = au; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)490)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)493)) << 5), "AUS", (ftnlen) - 32, (ftnlen)3); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)494)] = au; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)495)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)498)) << 5), "MILES", ( - ftnlen)32, (ftnlen)5); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)499)] = 1.6093440000000001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)500)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)503)) << 5), "STATUTE_MILES" - , (ftnlen)32, (ftnlen)13); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)504)] = 1.6093440000000001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)505)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)508)) << 5), "LIGHTSECONDS", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)509)] = lsec; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)510)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)513)) << 5), "LIGHTYEAR", ( - ftnlen)32, (ftnlen)9); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)514)] = lyear; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)515)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)518)) << 5), "SECS", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)519)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)520)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)523)) << 5), "SECONDS", ( - ftnlen)32, (ftnlen)7); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)524)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)525)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)528)) << 5), "MINS", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)529)] = 60.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)530)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)533)) << 5), "MINUTES", ( - ftnlen)32, (ftnlen)7); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)534)] = 60.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)535)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)538)) << 5), "HRS", (ftnlen) - 32, (ftnlen)3); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)539)] = 3600.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)540)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)543)) << 5), "HOURS", ( - ftnlen)32, (ftnlen)5); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)544)] = 3600.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)545)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)548)) << 5), "DAYS", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)549)] = 86400.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)550)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)553)) << 5), "WEEKS", ( - ftnlen)32, (ftnlen)5); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)554)] = 604800.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)555)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)558)) << 5), "JYEARS", ( - ftnlen)32, (ftnlen)6); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)559)] = 31557600.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)560)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)563)) << 5), "JULIAN_YEARS", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)564)] = 31557600.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)565)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)568)) << 5), "CENTURY", ( - ftnlen)32, (ftnlen)7); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)569)] = 3.15576e9; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)570)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)573)) << 5), "CENTURIES", ( - ftnlen)32, (ftnlen)9); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)574)] = 3.15576e9; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)575)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)578)) << 5), "JULIAN_CENTU" - "RIES", (ftnlen)32, (ftnlen)16); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)579)] = 3.15576e9; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)580)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)583)) << 5), "JULIAN_CENTU" - "RY", (ftnlen)32, (ftnlen)14); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)584)] = 3.15576e9; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)585)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)588)) << 5), "LIGHTDAYS", ( - ftnlen)32, (ftnlen)9); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)589)] = lday; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)590)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)593)) << 5), "LIGHTYEARS", ( - ftnlen)32, (ftnlen)10); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)594)] = lyear; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)595)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)598)) << 5), "RADIANS", ( - ftnlen)32, (ftnlen)7); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)599)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)600)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)603)) << 5), "MILLIRADIANS", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)604)] = .001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)605)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)608)) << 5), "MICRORADIANS", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)609)] = 9.9999999999999995e-7; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)610)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)613)) << 5), "NANORADIANS", - (ftnlen)32, (ftnlen)11); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)614)] = 1.0000000000000001e-9; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)615)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)618)) << 5), "DEGREES", ( - ftnlen)32, (ftnlen)7); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)619)] = degree; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)620)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)623)) << 5), "DEGS", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)624)] = degree; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)625)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)628)) << 5), "ARCSECONDS", ( - ftnlen)32, (ftnlen)10); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)629)] = arcsec; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)630)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)633)) << 5), "ARCMINUTES", ( - ftnlen)32, (ftnlen)10); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)634)] = arcmin; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)635)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)638)) << 5), "SECONDANGLES", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)639)] = secang; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)640)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)643)) << 5), "MINUTEANGLES", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)644)] = minang; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)645)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)648)) << 5), "HOURANGLES", ( - ftnlen)32, (ftnlen)10); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)649)] = hrang; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)650)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)653)) << 5), "KILOGRAMS", ( - ftnlen)32, (ftnlen)9); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)654)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)655)] = 4; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)658)) << 5), "KGS", (ftnlen) - 32, (ftnlen)3); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)659)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)660)] = 4; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)663)) << 5), "GRAMS", ( - ftnlen)32, (ftnlen)5); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)664)] = .001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)665)] = 4; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)668)) << 5), "POUNDS", ( - ftnlen)32, (ftnlen)6); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)669)] = .45359237000000002; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)670)] = 4; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)673)) << 5), "OUNCES", ( - ftnlen)32, (ftnlen)6); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)674)] = .028349523125000001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)675)] = 4; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)678)) << 5), "PARSECS", ( - ftnlen)32, (ftnlen)7); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)679)] = parsec; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)680)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)683)) << 5), "YEARS", ( - ftnlen)32, (ftnlen)5); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)684)] = 31557600.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)685)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)688)) << 5), "JULIANYEARS", - (ftnlen)32, (ftnlen)11); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)689)] = 31557600.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)690)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)693)) << 5), "TROPICALYEARS" - , (ftnlen)32, (ftnlen)13); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)694)] = 31556925.976319999; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)695)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)698)) << 5), "TROPICAL_YEA" - "RS", (ftnlen)32, (ftnlen)14); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)699)] = 31556925.976319999; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)700)] = 3; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)703)) << 5), "STATUTEMILES", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)704)] = 1.6093440000000001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)705)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)708)) << 5), "NAUTICALMILES" - , (ftnlen)32, (ftnlen)13); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)709)] = 1.8520000000000001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)710)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)713)) << 5), "NAUTICAL_MIL" - "ES", (ftnlen)32, (ftnlen)14); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)714)] = 1.8520000000000001; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)715)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)718)) << 5), "MMS", (ftnlen) - 32, (ftnlen)3); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)719)] = 1.0000000000000002e-6; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)720)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)723)) << 5), "MILLIMETERS", - (ftnlen)32, (ftnlen)11); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)724)] = 1.0000000000000002e-6; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)725)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)728)) << 5), "REVOLUTIONS", - (ftnlen)32, (ftnlen)11); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)729)] = rev; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)730)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)733)) << 5), "REVS", ( - ftnlen)32, (ftnlen)4); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)734)] = rev; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)735)] = 1; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)738)) << 5), "LIGHTHOURS", ( - ftnlen)32, (ftnlen)10); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)739)] = lhour; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)740)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)743)) << 5), "LIGHTMINUTES", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)744)] = lmin; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)745)] = 2; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)748)) << 5), "COULOMBS", ( - ftnlen)32, (ftnlen)8); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)749)] = 1.; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)750)] = 5; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)753)) << 5), "ELECTRON_CHA" - "RGES", (ftnlen)32, (ftnlen)16); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)754)] = 1.6020608911303502e-19; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)755)] = 5; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)758)) << 5), "STATCOULOMBS", - (ftnlen)32, (ftnlen)12); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)759)] = 2.99793e9; - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)760)] = 5; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)763)) << 5), "PI", (ftnlen) - 32, (ftnlen)2); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)764)] = pi_(); - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)765)] = 0; - ++i__; - s_copy(units + (((i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "fnducv_", (ftnlen)768)) << 5), "-PI", (ftnlen) - 32, (ftnlen)3); - uvalue[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue", - i__1, "fnducv_", (ftnlen)769)] = -pi_(); - uclass[(i__1 = i__ - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uclass", - i__1, "fnducv_", (ftnlen)770)] = 0; - -/* I = I + 1 */ -/* UNITS(I) = */ -/* UVALUE(I) = */ -/* UCLASS(I) = */ - - count = i__; - -/* Sort everything for quick lookup. */ - - orderc_(units, &count, ordvec, (ftnlen)32); - reordc_(ordvec, &count, units, (ftnlen)32); - reordd_(ordvec, &count, uvalue); - reordi_(ordvec, &count, uclass); - } - cvpool_("FNDUCV", &update, (ftnlen)6); - if (update) { - iau = bsrchc_("AU", &count, units, (ftnlen)2, (ftnlen)32); - iaus = bsrchc_("AUS", &count, units, (ftnlen)3, (ftnlen)32); - iparsc = bsrchc_("PARSECS", &count, units, (ftnlen)7, (ftnlen)32); - rtpool_("AU", &i__, &au, &found, (ftnlen)2); - if ((d__1 = au - 149597870.66, abs(d__1)) < 10.) { - uvalue[(i__1 = iau - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uvalue" - , i__1, "fnducv_", (ftnlen)802)] = au; - uvalue[(i__1 = iaus - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge("uval" - "ue", i__1, "fnducv_", (ftnlen)803)] = au; - uvalue[(i__1 = iparsc - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "uvalue", i__1, "fnducv_", (ftnlen)804)] = scale * au; - } - } - -/* Left justify, convert to upper case and form a "plural" version */ -/* of UNIN */ - - ljust_(unin, cands, unin_len, (ftnlen)32); - ucase_(cands, cands, (ftnlen)32, (ftnlen)32); - s_copy(candp, cands, (ftnlen)33, (ftnlen)32); - suffix_("S", &c__0, candp, (ftnlen)1, (ftnlen)33); - -/* Look for the "singular" version first. */ - - j = bsrchc_(cands, &count, units, (ftnlen)32, (ftnlen)32); - -/* If we didn't have any luck with the singular version, */ -/* look for the plural form. */ - - if (j == 0) { - j = bsrchc_(candp, &count, units, (ftnlen)33, (ftnlen)32); - } - -/* If we got something, just copy the class and value. */ - - if (j > 0) { - *known = TRUE_; - *class__ = uclass[(i__1 = j - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "uclass", i__1, "fnducv_", (ftnlen)840)]; - *value = uvalue[(i__1 = j - 1) < 84 && 0 <= i__1 ? i__1 : s_rnge( - "uvalue", i__1, "fnducv_", (ftnlen)841)]; - } else { - -/* We don't have a unit. Get ready to return... */ - - *known = FALSE_; - *class__ = -1; - *value = 0.; - -/* ... but before we do, see if we've got a number. */ - - if (benum_(cands, (ftnlen)32)) { - nparsd_(cands, value, error, &ptr, (ftnlen)32, (ftnlen)32); - if (s_cmp(error, " ", (ftnlen)32, (ftnlen)1) == 0) { - *known = TRUE_; - *class__ = 0; - } - } - } - -/* Since the user can potentially enter a bad value for the AU */ -/* via the kernel pool, we will signal an error. However we */ -/* wait until this point so that routines that need to have */ -/* an AU value in order to continue functioning, */ - - if ((d__1 = au - 149597870.66, abs(d__1)) > 10.) { - chkin_("FNDUCV", (ftnlen)6); - setmsg_("The value of the astronomical unit extracted from the kerne" - "l pool varies from the well trusted value used in DE200 (149" - ",597,870.660 km) by more than 10 km. The value in DE200 is b" - "elieved to be good to 60 meters or so. The value in the ker" - "nel pool was #. ", (ftnlen)255); - errdp_("#", &au, (ftnlen)1); - sigerr_("SPICE(BADAUVALUE)", (ftnlen)17); - chkout_("FNDUCV", (ftnlen)6); - -/* Reset the value of the AU back to the DE200 value so that */ -/* the next time we hit this without doing a kernel pool read */ -/* we will not get this error message again. */ - - au = 149597870.66; - return 0; - } - return 0; -} /* fnducv_ */ - diff --git a/ext/spice/src/csupport/getcml.c b/ext/spice/src/csupport/getcml.c deleted file mode 100644 index cab0d37612..0000000000 --- a/ext/spice/src/csupport/getcml.c +++ /dev/null @@ -1,332 +0,0 @@ -/* - --Procedure getcml_ ( Get the command line as a string ) - --Abstract - - Get the command line arguments and return them in a single 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 - - UTILITY - -*/ - - #include - #include - - #include "SpiceUsr.h" - #include "SpiceZfc.h" - #include "SpiceZmc.h" - - SpiceInt getcml_ ( char * outline, - ftnlen line_len ) - -/* - --Brief_I/O - - Variable I/O Description - -------- --- -------------------------------------------------- - outline O The command line arguments string. - line_len I Length for the output string. - --Detailed_Input - - line_len is the length for the output string. - --Detailed_Output - - outline is a one-dimensional character array containing the - command line arguments. The command (pointed to by - argv[0] in a traditional C program) is not part of the - output. - - The output array contains a "Fortran style" string: it's - padded with trailing blanks and does not contain a null - terminator. - --Parameters - - None. - --Exceptions - - 1) The output string is checked to make sure the pointer is non-null. - If the pointer is null, the error SPICE(NULLPOINTER) is signalled. - - 2) The output string is checked to make sure the string length is - at least 2. If not, the error SPICE(STRINGTOOSHORT) is signalled. - --Files - - None. - --Particulars - - This routine is for the f2c'd C code that requires a call to getcml_. - The routine may be called from any program module. It is necessary - to call putcml_c from the main module to initialize the storage - of argv and argc. - - The routine copies the entire command line to a single string, then - returns line_len of the string to the caller. If line_len is greater - than the length of the command string, the complete string is - returned. If less than, the command string is truncted to line_len - characters. - --Examples - - Given the following command line - - % inputs this is the command line input - - getcml_ will return the string: - - this is the command line input - - - Example: - - - #include "SpiceUsr.h" - #include "SpiceZmc.h" - - #define LINE_LEN 20 - - void main( int argc, char *argv[] ) - { - - /. - Local variables - ./ - - SpiceChar outline[LINE_LEN]; - - - /. - Store argv and argc for later access. - ./ - - putcml_c ( argc, argv ); - - - /. - Now get the blank-padded, Fortran-style string. - ./ - - getcml_ ( outline, LINE_LEN ); - - - /. - Null-terminate the string so it can be passed to printf. - ./ - - outline[LINE_LEN-1] = NULLCHAR; - - - printf ( "Argument line is '%s'\n", outline ); - - exit(0); - } - - - --Restrictions - - 1) This routine should not be called by users' applications. - It should be called only from C routines produced by running - f2c on Fortran routines. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - K.R. Gehringer (JPL) - H.A. Neilan (JPL) - M.J. Spencer (JPL) - E.D. Wright (JPL) - --Version - - -CSPICE Version 3.2.0, 09-JUN-2010 (EDW) - - A return on failure check added after the getcml_c call. - A memory error can occur if program flow continues after a - getcml_c error. - - -CSPICE Version 3.1.0, 14-MAY-2003 (NJB) - - Prototype declaration was changed to match that created - by running f2c on getcml.f. This change was made to - suppress potential compiler warnings; the effective - data types of the arguments have not changed. - - -CSPICE Version 3.0.0, 06-NOV-1998 (NJB) - - Modified to output a blank-padded, Fortran style string - rather than a C string. - - -CSPICE Version 2.0.1, 08-FEB-1998 (EDW) - - Argument list modified so that it conforms to expected f2c - output format. - - - -CSPICE Version 2.0.0, 6-JAN-1997 (EDW) - - This version is a complete rewrite of the routine using getcml_c - to access the stored values of argc and argv. - --Index_Entries - - get command line arguments as a string - --& -*/ - -{ - /* - Local variables - */ - - SpiceChar ** argv; - - SpiceInt argc; - SpiceInt avail; - SpiceInt chrpos; - SpiceInt endpos; - SpiceInt i; - SpiceInt nmove; - SpiceInt required; - - - - /* - Participate in error tracing. - */ - chkin_c ( "getcml_" ); - - - /* - Validate the output string. - */ - CHKOSTR_VAL ( CHK_STANDARD, "getcml_", outline, line_len, 0 ); - - - /* - Retrieve the argv and argc values. - */ - getcml_c ( &argc, &argv ); - - /* - If a SPICE error signaled in getcml_c, return to the calling routine. - This check prevents a memory error if an error in getcml_c signals - when the SPICE error subsystem is in RETURN mode. - */ - if ( failed_c() ) - { - return EXIT_FAILURE; - } - - /* - Initialize the string end pointer and available space counter. - */ - endpos = 0; - avail = line_len; - - - /* - Append all arguments after the first to the output string. - Separate the arguments by blanks. Stop when we run out of room. - */ - for( i = 1; ( i < argc ) && ( avail > 0 ); i++ ) - { - required = strlen( argv[i] ); - - /* - If this is not the first argument, append a leading blank to the - output string. - */ - - if ( i > 1 ) - { - outline[endpos] = BLANK; - - endpos ++; - avail --; - } - - - /* - Move as much as possible of the current argument into the - output line. - */ - nmove = MinVal ( required, avail ); - - for ( chrpos = 0; chrpos < nmove; chrpos++ ) - { - outline[endpos+chrpos] = *( argv[i] + chrpos ); - } - - - /* - Advance the end pointer by however many characters we moved. - That number could be zero. The available space decreased by - the same amount. - */ - endpos += nmove; - avail -= nmove; - - } - - /* - Since the output is a Fortran style string, any remaining space - must be filled with blanks. - */ - - if ( avail > 0 ) - { - memset ( (outline+endpos), BLANK, avail ); - } - - - chkout_c ( "getcml_" ); - - return 0; - - } - - diff --git a/ext/spice/src/csupport/getdel.c b/ext/spice/src/csupport/getdel.c deleted file mode 100644 index 4724325035..0000000000 --- a/ext/spice/src/csupport/getdel.c +++ /dev/null @@ -1,67 +0,0 @@ -/* getdel.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -/* Subroutine */ int getdel_0_(int n__, char *letter, ftnlen letter_len) -{ - /* Initialized data */ - - static char delim[1] = ";"; - - -/* This is simply a utility routine that sets the special */ -/* character that is used by the a command loop program to */ -/* terminate command inputs. It has a get and set entry */ -/* points. The functions should be obvious. If not you */ -/* should consider another career. */ - - switch(n__) { - case 1: goto L_setdel; - } - - *(unsigned char *)letter = *(unsigned char *)&delim[0]; - return 0; - -L_setdel: - *(unsigned char *)&delim[0] = *(unsigned char *)letter; - return 0; -} /* getdel_ */ - -/* Subroutine */ int getdel_(char *letter, ftnlen letter_len) -{ - return getdel_0_(0, letter, letter_len); - } - -/* Subroutine */ int setdel_(char *letter, ftnlen letter_len) -{ - return getdel_0_(1, letter, letter_len); - } - diff --git a/ext/spice/src/csupport/geteq.c b/ext/spice/src/csupport/geteq.c deleted file mode 100644 index f799e3248e..0000000000 --- a/ext/spice/src/csupport/geteq.c +++ /dev/null @@ -1,68 +0,0 @@ -/* geteq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -/* Subroutine */ int geteq_0_(int n__, char *letter, ftnlen letter_len) -{ - /* Initialized data */ - - static char equote[1] = "@"; - - -/* This is simply a utility routine that sets the special */ -/* protection character that is used by the symbol and */ -/* query resolution software so that protected strings are */ -/* not translated. There are two entry points GETEQ and SETEQ */ -/* Their functions should be obvious. The default value of */ -/* the special marker is '@'. */ - - switch(n__) { - case 1: goto L_seteq; - } - - *(unsigned char *)letter = *(unsigned char *)&equote[0]; - return 0; - -L_seteq: - *(unsigned char *)&equote[0] = *(unsigned char *)letter; - return 0; -} /* geteq_ */ - -/* Subroutine */ int geteq_(char *letter, ftnlen letter_len) -{ - return geteq_0_(0, letter, letter_len); - } - -/* Subroutine */ int seteq_(char *letter, ftnlen letter_len) -{ - return geteq_0_(1, letter, letter_len); - } - diff --git a/ext/spice/src/csupport/getfnm.c b/ext/spice/src/csupport/getfnm.c deleted file mode 100644 index 556d29ec3b..0000000000 --- a/ext/spice/src/csupport/getfnm.c +++ /dev/null @@ -1,441 +0,0 @@ -/* getfnm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; -static integer c__1 = 1; - -/* $Procedure GETFNM ( Get a filename from standard input ) */ -/* Subroutine */ int getfnm_(char *prmpt, char *fstat, char *fname, logical * - valid, char *messg, ftnlen prmpt_len, ftnlen fstat_len, ftnlen - fname_len, ftnlen messg_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[3]; - integer i__1, i__2[3]; - char ch__1[1]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static char badchr[162]; - integer length; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical exists_(char *, ftnlen), return_(void); - extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen); - char status[3]; - -/* $ Abstract */ - -/* This routine prompts the user for a valid filename. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PRMPT I The prompt to use when asking for the filename. */ -/* FSTAT I Status of the file: 'OLD' or 'NEW'. */ -/* FNAME O A valid filename typed in by the user. */ -/* VALID O A logical flag indicating a valid filename. */ -/* MESSG O A descriptive message for an invalid filename. */ - -/* $ Detailed_Input */ - -/* PRMPT is a character string that will be displayed from the */ -/* active position of the cursor to the end of string */ -/* that lets a user know that input is expected. */ - -/* FSTAT This is the status of the filename entered. It should */ -/* be 'OLD' when prompting for the filename of a file which */ -/* already exists, and 'NEW' when prompting for the filename */ -/* of a file which does not already exist or is to be over */ -/* written. */ - -/* $ Detailed_Output */ - -/* FNAME is a character string that contains a valid filename */ -/* typed in by the user. A valid filename is defined */ -/* simply to be a nonblank character string with no */ -/* embedded blanks, nonprinting characters, or characters */ -/* having decimal values > 126. */ - -/* VALID A logical flag which indicates whether or not the */ -/* filename entered is valid, i.e., a nonblank character */ -/* string with no leading or embedded blanks, which */ -/* satisfies the constraints for validity imposed. */ - -/* MESSG A brief descriptive message which describes why a */ -/* particular filename was not valid. Blank if a valid */ -/* filename is entered. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility that allows you to "easily" request a valid, */ -/* filename from a program user. At a high level, it frees you */ -/* from the peculiarities of a particular FORTRAN's implementation */ -/* of cursor control. */ - -/* A valid filename is defined as a nonblank character string with */ -/* no embedded blanks, nonprinting characters, or characters with */ -/* decimal values > 126. Leading blanks are removed, and trailing */ -/* blanks are ignored. */ - -/* If an invalid filename is entered, this routine provides a */ -/* descriptive error message and halts the execution of the */ -/* process which called it by using a Fortran STOP. */ - -/* $ Examples */ - -/* EXAMPLE 1: */ - -/* FNAME = ' ' */ -/* PRMPT = 'Filename? ' */ -/* FSTAT = 'OLD' */ - -/* CALL GETFNM( PRMPT, FSTAT, FNAME, VALID, MESSG ) */ - -/* The user sees the following displayed on his screen: */ - -/* Filename? _ */ - -/* where the underbar, '_', represents the cursor position. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 5.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - Beta Version 5.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - Beta Version 5.10.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - Beta Version 5.9.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - Beta Version 5.8.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - Beta Version 5.7.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - Beta Version 5.6.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - Beta Version 5.5.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - Beta Version 5.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - Beta Version 5.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - Beta Version 5.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - Beta Version 5.1.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - Beta Version 5.1.0, 16-AUG-2000 (WLT) */ - -/* Added the PC-LINUX environment */ - -/* - Beta Version 5.0.0, 20-JAN-1998 (NJB) */ - -/* Now calls EXPFNM_2 to attempt to expand environment variables. */ - -/* Fixed a typo or two at various places in the header. */ - -/* - Beta Version 4.0.1, 25-APR-1994 (KRG) */ - -/* Removed some incorrect comments from the $ Particulars section */ -/* of the header. Something about a looping structure that is not */ -/* a part of the code now, if it ever was. */ - -/* Fixed a typo or two at various places in the header. */ - -/* - Beta Version 4.0.0, 29-SEP-1993 (KRG) */ - -/* Added the character reperesnted by decimal 127 to the BADCHR. */ -/* It should have been there, but it wasn't. */ - -/* - Beta Version 3.0.0, 10-SEP-1993 (KRG) */ - -/* Made the file status variable FSTAT case insensitive. */ - -/* Added code to the file status .EQ. 'NEW' case to set the */ -/* valid flag to .FALSE. and set an appropriate error message */ -/* about the file already existing. */ - -/* - Beta Version 2.0.0, 02-APR-1993 (KRG) */ - -/* The variable BADCHR was not saved which caused problems on some */ -/* computers. This variable is now saved. */ - -/* - Beta Version 1.0.0, 01-JUN-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* prompt for a filename with error handling */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 7.0.0, 09-DEC-1999 (WLT) */ - -/* This routine now calls EXPFNM_2 only in UNIX environments */ - -/* - Beta Version 5.0.0, 20-JAN-1998 (NJB) */ - -/* Now calls EXPFNM_2 to attempt to expand environment variables. */ - -/* Fixed a typo or two at various places in the header. */ - -/* - Beta Version 4.0.1, 25-APR-1994 (KRG) */ - -/* Removed some incorrect comments from the $ Particulars section */ -/* of the header. Something about a looping structure that is not */ -/* a part of the code now, if it ever was. */ - -/* Fixed a typo or two at various places int the header. */ - -/* - Beta Version 4.0.0, 29-SEP-1993 (KRG) */ - -/* Added the character reperesnted by decimal 127 to the BADCHR. */ -/* It should have been there, but it wasn't. */ - -/* - Beta Version 3.0.0, 10-SEP-1993 (KRG) */ - -/* Made the file status variable FSTAT case insensitive. */ - -/* Added code to the file status .EQ. 'NEW' case to set the */ -/* valid flag to .FALSE. and set an appropriate error message */ -/* about the file already existing. */ - -/* - Beta Version 2.0.0, 02-APR-1993 (KRG) */ - -/* The variable BADCHR was not saved which caused problems on some */ -/* computers. This variable is now saved. */ - -/* - Beta Version 1.0.0, 01-JUN-1992 (KRG) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial Values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETFNM", (ftnlen)6); - } - -/* If this is the first time this routine has been called, initialize */ -/* the ``bad character'' string. */ - - if (first) { - first = FALSE_; - for (i__ = 0; i__ <= 32; ++i__) { - i__1 = i__; - *(unsigned char *)&ch__1[0] = i__; - s_copy(badchr + i__1, ch__1, i__ + 1 - i__1, (ftnlen)1); - } - for (i__ = 1; i__ <= 129; ++i__) { - i__1 = i__ + 32; - *(unsigned char *)&ch__1[0] = i__ + 126; - s_copy(badchr + i__1, ch__1, i__ + 33 - i__1, (ftnlen)1); - } - } - -/* Set the value of the valid flag to .TRUE.. We might as well assume */ -/* that the name entered will be a valid one. */ - - *valid = TRUE_; - -/* Left justify and convert the file status to upper case for */ -/* comparisons. */ - - ljust_(fstat, status, fstat_len, (ftnlen)3); - ucase_(status, status, (ftnlen)3, (ftnlen)3); - -/* Check to see if we have a valid status for the filename. */ - - if (s_cmp(status, "OLD", (ftnlen)3, (ftnlen)3) != 0 && s_cmp(status, - "NEW", (ftnlen)3, (ftnlen)3) != 0) { - *valid = FALSE_; -/* Writing concatenation */ - i__2[0] = 12, a__1[0] = "The status '"; - i__2[1] = 3, a__1[1] = status; - i__2[2] = 21, a__1[2] = "' was not recognized."; - s_cat(messg, a__1, i__2, &c__3, messg_len); - chkout_("GETFNM", (ftnlen)6); - return 0; - } - -/* Read in a potential filename, and test it for validity. */ - - if (s_cmp(prmpt, " ", prmpt_len, (ftnlen)1) == 0) { - prompt_("Filename? ", fname, (ftnlen)10, fname_len); - } else { - prompt_(prmpt, fname, prmpt_len, fname_len); - } - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - *valid = FALSE_; - s_copy(messg, "A blank filename is not valid.", messg_len, (ftnlen)30) - ; - chkout_("GETFNM", (ftnlen)6); - return 0; - } - -/* Left justify the filename. */ - - ljust_(fname, fname, fname_len, fname_len); - -/* Check for bad characters in the filename. */ - - length = lastnb_(fname, fname_len); - i__ = cpos_(fname, badchr, &c__1, length, (ftnlen)162); - if (i__ > 0) { - *valid = FALSE_; - s_copy(messg, "Invalid filename. Illegal character encountered: deci" - "mal value: #", messg_len, (ftnlen)65); - i__1 = *(unsigned char *)&fname[i__ - 1]; - repmi_(messg, "#", &i__1, messg, messg_len, (ftnlen)1, messg_len); - chkout_("GETFNM", (ftnlen)6); - return 0; - } - -/* We know that the filename that was entered was nonblank and had */ -/* no bad characters. So, now we take care of the status question. */ - - if (s_cmp(status, "OLD", (ftnlen)3, (ftnlen)3) == 0) { - if (! exists_(fname, rtrim_(fname, fname_len))) { - *valid = FALSE_; - s_copy(messg, "The file does not exist.", messg_len, (ftnlen)24); - chkout_("GETFNM", (ftnlen)6); - return 0; - } - } else if (s_cmp(status, "NEW", (ftnlen)3, (ftnlen)3) == 0) { - if (exists_(fname, rtrim_(fname, fname_len))) { - *valid = FALSE_; - s_copy(messg, "The file already exists.", messg_len, (ftnlen)24); - chkout_("GETFNM", (ftnlen)6); - return 0; - } - } - -/* At this point, we have done the best we can. If the status */ -/* was new, we might still have an invalid filename, but the */ -/* exact reasons for its invalidity are system dependent. */ - - chkout_("GETFNM", (ftnlen)6); - return 0; -} /* getfnm_ */ - diff --git a/ext/spice/src/csupport/getfnm_1.c b/ext/spice/src/csupport/getfnm_1.c deleted file mode 100644 index 8cd69e712b..0000000000 --- a/ext/spice/src/csupport/getfnm_1.c +++ /dev/null @@ -1,562 +0,0 @@ -/* getfnm_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__6 = 6; - -/* $Procedure GETFNM_1 ( Get a filename from standard input ) */ -/* Subroutine */ int getfnm_1__(char *prmpt, char *fstat, char *fname, - logical *valid, ftnlen prmpt_len, ftnlen fstat_len, ftnlen fname_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2]; - char ch__1[1], ch__2[81]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), reset_( - void); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - static char badchr[162]; - extern logical failed_(void); - char oldact[10]; - extern /* Subroutine */ int cnfirm_(char *, logical *, ftnlen), erract_( - char *, char *, ftnlen, ftnlen); - integer length; - extern integer lastnb_(char *, ftnlen); - char myfnam[1000]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - logical tryagn, myvlid; - extern logical exists_(char *, ftnlen), return_(void); - extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen), - writln_(char *, integer *, ftnlen); - char status[3], myprmt[80]; - -/* $ Abstract */ - -/* This routine prompts the user for a valid filename. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PRMPT I The prompt to use when asking for the filename. */ -/* FSTAT I Status of the file: 'OLD' or 'NEW'. */ -/* FNAME O A valid filename typed in by the user. */ -/* VALID O A logical flag indicating a valid filename. */ -/* PRMLEN P Maximum length allowed for a prompt before */ -/* truncation. */ - -/* $ Detailed_Input */ - -/* PRMPT is a character string that will be displayed from the */ -/* current cursor position that informs a user that input */ -/* is expected. Prompts should be fairly short, since we */ -/* need to declare some local storage. The current maximum */ -/* length of a prompt is given by the parameter PRMLEN. */ - -/* FSTAT This is the status of the filename entered. It should */ -/* be 'OLD' when prompting for the filename of a file which */ -/* already exists, and 'NEW' when prompting for the */ -/* filename of a file which does not already exist or is to */ -/* be over written. */ - -/* $ Detailed_Output */ - -/* FNAME is a character string that contains a valid filename */ -/* typed in by the user. A valid filename is defined */ -/* simply to be a nonblank character string with no */ -/* embedded blanks, nonprinting characters, or characters */ -/* having decimal values > 126. */ - -/* VALID A logical flag which indicates whether or not the */ -/* filename entered is valid, i.e., a nonblank character */ -/* string with no leading or embedded blanks, which */ -/* satisfies the constraints for validity imposed. */ - -/* $ Parameters */ - -/* PRMLEN The maximum length for an input prompt string. */ - -/* $ Exceptions */ - -/* 1) If the input file status is not equal to 'NEW' or 'OLD' after */ -/* being left justified and converted to upper case, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. The error handling */ -/* is then reset. */ - -/* 2) If the filename entered at the prompt is blank, the error */ -/* SPICE(BLANKFILENAME) will be signalled. The error handling is */ -/* then reset. */ - -/* 3) If the filename contains an illegal character, a nonprinting */ -/* character or embedded blanks, the error */ -/* SPICE(ILLEGALCHARACTER) will be signalled. */ - -/* 4) If the file status is equal to 'OLD' after being left */ -/* justified and converted to upper case and the file specified */ -/* by the filename entered at the prompt does not exist, the */ -/* error SPICE(FILEDOESNOTEXIST) will be signalled. */ - -/* 5) If the file status is equal to 'NEW' after being left */ -/* justified and converted to upper case and the file specified */ -/* by the filename entered at the prompt already exists, the */ -/* error SPICE(FILEALREADYEXISTS) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility that allows you to "easily" request a valid, */ -/* filename from a program user. At a high level, it frees you */ -/* from the peculiarities of a particular FORTRAN's implementation */ -/* of cursor control. */ - -/* A valid filename is defined as a nonblank character string with */ -/* no embedded blanks, nonprinting characters, or characters with */ -/* decimal values > 126. Leading blanks are removed, and trailing */ -/* blanks are ignored. */ - -/* If an invalid filename is entered, this routine provides a */ -/* descriptive error message and halts the execution of the */ -/* process which called it by using a Fortran STOP. */ - -/* $ Examples */ - -/* EXAMPLE 1: */ - -/* FNAME = ' ' */ -/* PRMPT = 'Filename? ' */ -/* FSTAT = 'OLD' */ - -/* CALL GETFNM_1( PRMPT, FSTAT, FNAME, VALID ) */ - -/* The user sees the following displayed on the screen: */ - -/* Filename? _ */ - -/* where the underbar, '_', represents the cursor position. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 6.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - Beta Version 6.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - Beta Version 6.10.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - Beta Version 6.9.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - Beta Version 6.8.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - Beta Version 6.7.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - Beta Version 6.6.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - Beta Version 6.5.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - Beta Version 6.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - Beta Version 6.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - Beta Version 6.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - Beta Version 6.1.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - Beta Version 6.1.0, 16-AUG-2000 (WLT) */ - -/* Added PC-LINUX environment */ - -/* - Beta Version 6.0.0, 20-JAN-1998 (NJB) */ - -/* Now calls EXPFNM_2 to attempt to expand environment variables. */ - -/* Fixed a typo or two at various places in the header. */ - -/* - Beta Version 5.1.0, 31-JAN-1996 (KRG) */ - -/* Fixed a pedantic Fortran syntax error dealing with input */ -/* strings that are dimensioned CHARACTER*(*). */ - -/* - Beta Version 5.0.0, 05-JUL-1995 (KRG) */ - -/* Modified the routine to handle all of its own error messages */ -/* and error conditions. The routine now signals an error */ -/* immediately resetting the error handling when an exceptional */ -/* condition is encountered. This is done so that input attempts */ -/* may continue until a user decides to stop trying. */ - -/* Added several exceptions to the $ Exceptions section of the */ -/* header. */ - -/* - Beta Version 4.0.1, 25-APR-1994 (KRG) */ - -/* Removed some incorrect comments from the $ Particulars section */ -/* of the header. Something about a looping structure that is not */ -/* a part of the code now, if it ever was. */ - -/* Fixed a typo or two at various places in the header. */ - -/* - Beta Version 4.0.0, 29-SEP-1993 (KRG) */ - -/* Added the character reperesnted by decimal 127 to the BADCHR. */ -/* It should have been there, but it wasn't. */ - -/* - Beta Version 3.0.0, 10-SEP-1993 (KRG) */ - -/* Made the file status variable FSTAT case insensitive. */ - -/* Added code to the file status .EQ. 'NEW' case to set the */ -/* valid flag to .FALSE. and set an appropriate error message */ -/* about the file already existing. */ - -/* - Beta Version 2.0.0, 02-APR-1993 (KRG) */ - -/* The variable BADCHR was not saved which caused problems on */ -/* some computers. This variable is now saved. */ - -/* - Beta Version 1.0.0, 01-JUN-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* prompt for a filename with error handling */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 7.0.0, 09-DEC-1999 (WLT) */ - -/* This routine now calls EXPFNM_2 only UNIX environments */ - -/* - Beta Version 6.0.0, 20-JAN-1998 (NJB) */ - -/* Now calls EXPFNM_2 to attempt to expand environment variables. */ - -/* Fixed a typo or two at various places in the header. */ - -/* - Beta Version 5.1.0, 31-JAN-1996 (KRG) */ - -/* Fixed a pedantic Fortran syntax error dealing with input */ -/* strings that are dimensioned CHARACTER*(*). */ - -/* A local character string is now declared, and a parameter, */ -/* PRMLEN, has been added to the interface description for this */ -/* subroutine. PRMLEN defines the maximum length allowed for a */ -/* prompt before it is truncated. */ - -/* - Beta Version 5.0.0, 05-JUL-1995 (KRG) */ - -/* Modified the routine to handle all of its own error messages */ -/* and error conditions. The routine now signals an error */ -/* immediately resetting the error handling when an exceptional */ -/* condition is encountered. This is done so that input attempts */ -/* may continue until a user decides to stop trying. */ - -/* Added several exceptions to the $ Exceptions section of the */ -/* header. */ - -/* - Beta Version 4.0.1, 25-APR-1994 (KRG) */ - -/* Removed some incorrect comments from the $ Particulars section */ -/* of the header. Something about a looping structure that is not */ -/* a part of the code now, if it ever was. */ - -/* Fixed a typo or two at various places int the header. */ - -/* - Beta Version 4.0.0, 29-SEP-1993 (KRG) */ - -/* Added the character reperesnted by decimal 127 to the BADCHR. */ -/* It should have been there, but it wasn't. */ - -/* - Beta Version 3.0.0, 10-SEP-1993 (KRG) */ - -/* Made the file status variable FSTAT case insensitive. */ - -/* Added code to the file status .EQ. 'NEW' case to set the */ -/* valid flag to .FALSE. and set an appropriate error message */ -/* about the file already existing. */ - -/* - Beta Version 2.0.0, 02-APR-1993 (KRG) */ - -/* The variable BADCHR was not saved which caused problems on */ -/* some computers. This variable is now saved. */ - -/* - Beta Version 1.0.0, 01-JUN-1992 (KRG) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Maximum length of a filename. */ - - -/* Length of an error action */ - - -/* Local Variables */ - - -/* Saved Variables */ - - -/* Initial Values */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETFNM_1", (ftnlen)8); - } - -/* We are going to be signalling errors and resetting the error */ -/* handling, so we need to be in RETURN mode. First we get the */ -/* current mode and save it, then we set the mode to return. Upon */ -/* leaving the subroutine, we will restore the error handling mode */ -/* that was in effect when we entered. */ - - erract_("GET", oldact, (ftnlen)3, (ftnlen)10); - erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6); - -/* If this is the first time this routine has been called, */ -/* initialize the ``bad character'' string. */ - - if (first) { - first = FALSE_; - for (i__ = 0; i__ <= 32; ++i__) { - i__1 = i__; - *(unsigned char *)&ch__1[0] = i__; - s_copy(badchr + i__1, ch__1, i__ + 1 - i__1, (ftnlen)1); - } - for (i__ = 1; i__ <= 129; ++i__) { - i__1 = i__ + 32; - *(unsigned char *)&ch__1[0] = i__ + 126; - s_copy(badchr + i__1, ch__1, i__ + 33 - i__1, (ftnlen)1); - } - } - -/* Left justify and convert the file status to upper case for */ -/* comparisons. */ - - ljust_(fstat, status, fstat_len, (ftnlen)3); - ucase_(status, status, (ftnlen)3, (ftnlen)3); - -/* Check to see if we have a valid status for the filename. */ - - if (s_cmp(status, "OLD", (ftnlen)3, (ftnlen)3) != 0 && s_cmp(status, - "NEW", (ftnlen)3, (ftnlen)3) != 0) { - setmsg_("The file status '#' was not valid. The file status must hav" - "e a value of 'NEW' or 'OLD'.", (ftnlen)87); - errch_("#", status, (ftnlen)1, (ftnlen)3); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("GETFNM_1", (ftnlen)8); - return 0; - } - -/* Store the input value for the prompt into our local value. We do */ -/* this for pedantic Fortran compilers that issue warnings for */ -/* CHARACTER*(*) variables used with concatenation. */ - - s_copy(myprmt, prmpt, (ftnlen)80, prmpt_len); - -/* Read in a potential filename, and test it for validity. */ - - tryagn = TRUE_; - while(tryagn) { - -/* Set the value of the valid flag to .TRUE.. We assume that the */ -/* name entered will be a valid one. */ - - myvlid = TRUE_; - -/* Get the filename. */ - - if (s_cmp(myprmt, " ", (ftnlen)80, (ftnlen)1) == 0) { - prompt_("Filename? ", myfnam, (ftnlen)10, (ftnlen)1000); - } else { -/* Writing concatenation */ - i__2[0] = lastnb_(myprmt, (ftnlen)80), a__1[0] = myprmt; - i__2[1] = 1, a__1[1] = " "; - s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)81); - prompt_(ch__2, myfnam, lastnb_(myprmt, (ftnlen)80) + 1, (ftnlen) - 1000); - } - if (failed_()) { - myvlid = FALSE_; - } - if (myvlid) { - if (s_cmp(myfnam, " ", (ftnlen)1000, (ftnlen)1) == 0) { - myvlid = FALSE_; - setmsg_("The filename entered was blank.", (ftnlen)31); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - } - } - if (myvlid) { - -/* Left justify the filename. */ - - ljust_(myfnam, myfnam, (ftnlen)1000, (ftnlen)1000); - -/* Check for bad characters in the filename. */ - - length = lastnb_(myfnam, (ftnlen)1000); - i__ = cpos_(myfnam, badchr, &c__1, length, (ftnlen)162); - if (i__ > 0) { - myvlid = FALSE_; - setmsg_("The filename entered contains non printing characte" - "rs or embedded blanks.", (ftnlen)73); - sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); - } - } - if (myvlid) { - -/* We know that the filename that was entered was nonblank and */ -/* had no bad characters. So, now we take care of the status */ -/* question. */ - - if (s_cmp(status, "OLD", (ftnlen)3, (ftnlen)3) == 0) { - if (! exists_(myfnam, rtrim_(myfnam, (ftnlen)1000))) { - myvlid = FALSE_; - setmsg_("A file with the name '#' does not exist.", ( - ftnlen)40); - errch_("#", myfnam, (ftnlen)1, (ftnlen)1000); - sigerr_("SPICE(FILEDOESNOTEXIST)", (ftnlen)23); - } - } else if (s_cmp(status, "NEW", (ftnlen)3, (ftnlen)3) == 0) { - if (exists_(myfnam, rtrim_(myfnam, (ftnlen)1000))) { - myvlid = FALSE_; - setmsg_("A file with the name '#' already exists.", ( - ftnlen)40); - errch_("#", myfnam, (ftnlen)1, (ftnlen)1000); - sigerr_("SPICE(FILEALREADYEXISTS)", (ftnlen)24); - } - } - } - if (myvlid) { - tryagn = FALSE_; - } else { - writln_(" ", &c__6, (ftnlen)1); - cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20); - writln_(" ", &c__6, (ftnlen)1); - if (tryagn) { - reset_(); - } - } - } - -/* At this point, we have done the best we can. If the status */ -/* was new, we might still have an invalid filename, but the */ -/* exact reasons for its invalidity are system dependent, and */ -/* therefore hard to test. */ - - *valid = myvlid; - if (*valid) { - s_copy(fname, myfnam, fname_len, rtrim_(myfnam, (ftnlen)1000)); - } - -/* Restore the error action. */ - - erract_("SET", oldact, (ftnlen)3, (ftnlen)10); - chkout_("GETFNM_1", (ftnlen)8); - return 0; -} /* getfnm_1__ */ - diff --git a/ext/spice/src/csupport/getopt.c b/ext/spice/src/csupport/getopt.c deleted file mode 100644 index 4b66b5da4e..0000000000 --- a/ext/spice/src/csupport/getopt.c +++ /dev/null @@ -1,376 +0,0 @@ -/* getopt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__6 = 6; - -/* $Procedure GETOPT ( Get an option from a menu ) */ -/* Subroutine */ int getopt_(char *title, integer *nopt, char *optnam, char * - opttxt, integer *option, ftnlen title_len, ftnlen optnam_len, ftnlen - opttxt_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical done; - char line[80]; - integer iopt, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - logical okequ; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char prmpt[80]; - extern logical failed_(void); - logical ok, okdigi; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - logical okalph; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int writln_(char *, integer *, ftnlen), prompt_( - char *, char *, ftnlen, ftnlen); - char msg[80]; - -/* $ Abstract */ - -/* Display a list of options in a standard menu format and get */ -/* an option from a user returning the corresponding index of */ -/* the option selected. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TITLE I Title for the menu. */ -/* NOPT I Number of options available. */ -/* OPTNAM I Names for the options. */ -/* OPTTXT I Brief text describing an option. */ -/* OPTVAL I The value returned when its option is selected. */ -/* OPTION O The number of the option selected. */ - -/* $ Detailed_Input */ - -/* TITLE Title for the option menu. */ - -/* NOPT The number of menu options to be displayed. */ - -/* OPTNAM A list of single character names for the menu options. */ -/* These are the names used to select an option. The names */ -/* must each be a single alphanumeric character. All names */ -/* must be upper case if they are characters. */ - -/* If the option names is a period, '.', then a blank line */ -/* is to be displayed at that position in the menu list. */ - -/* OPTTXT A list of character strings which contain brief */ -/* descriptions for each of the menu options. These */ -/* character strings should be kept relatively short. */ - -/* Please note that the lengths of the option names, OPTNAM, and */ -/* the descriptive text for each option, OPTTXT, should be kept */ -/* reasonable, they both need to fit on the same output line with */ -/* a width of 80 characters. 13 characters out of the 80 available */ -/* are used for spacing and menu presentation, so there are 67 */ -/* characters available for the option name and the descriptive text */ -/* combined. */ - -/* $ Detailed_Output */ - -/* OPTION The index of the option selected from the menu. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of options, NOPT, is not > 0, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If the option names are not all upper case alphanumeric */ -/* characters, the error SPICE(BADOPTIONNAME) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will display a menu of options in a standardized */ -/* format, promting for the selection of one of the listed options. */ -/* This routine will not return to the caller until one of the */ -/* supplied options has been selected or an error occurs. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* This routine makes explicit use fo the ASCII character sequence. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 4.1.0, 05-JUL-1995 (KRG) */ - -/* Removed the initial blank line that was printed before the */ -/* title of the menu. The calling program should determine the */ -/* whitespace requirements for the appearance of the menu */ -/* displayed by this routine. */ - -/* - Beta Version 4.0.0, 25-APR-1994 (KRG) */ - -/* Modified the routine to output the index into the list of menu */ -/* options rather than a character string representing the option */ -/* selected. Also removed several calling arguments that were not */ -/* needed anymore. */ - -/* Added the capability of inserting a blank line into the menu. */ -/* This is done by placing a period, '.', into the option name */ -/* location where the blank line lshould occur. */ - -/* Added the missing $ Index_Entries section to the header. */ - -/* Clarified a few of the comments in the header. */ - -/* - Beta Version 3.0.0, 03-SEP-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* display a menu and get a user's selection */ - -/* -& */ -/* $ Revisions */ - -/* - Beta Version 4.1.0, 05-JUL-1995 (KRG) */ - -/* Removed the initial blank line that was printed before the */ -/* title of the menu. The calling program should determine the */ -/* whitespace requirements for the appearance of the menu */ -/* displayed by this routine. */ - -/* - Beta Version 4.0.0, 25-APR-1994 (KRG) */ - -/* Modified the routine to output the index into the list of menu */ -/* options rather than a character string representing the option */ -/* selected. Also removed several calling arguments that were not */ -/* needed anymore. */ - -/* Added the capability of inserting a blank line into the menu. */ -/* This is done by placing a period, '.', into the option name */ -/* location where the blank line lshould occur. */ - -/* Added the missing $ Index_Entries section to the header. */ - -/* Clarified a few of the comments in the header. */ - -/* - Beta Version 3.0.0, 03-SEP-1992 (KRG) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Mnemonic for the standard output. */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETOPT", (ftnlen)6); - } - -/* Check to make sure that the number of menu options is positive. */ -/* if it is not, then signal an error with an appropriate error */ -/* message. */ - - if (*nopt < 1) { - setmsg_("The number of options was not positive: #.", (ftnlen)42); - errint_("#", nopt, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("GETOPT", (ftnlen)6); - return 0; - } - -/* Initialize the option prompt. */ - - s_copy(prmpt, " ", (ftnlen)80, (ftnlen)1); - s_copy(prmpt + 3, "Option: ", (ftnlen)77, (ftnlen)8); - -/* Check to make sure that all of the option names are alphanumeric */ -/* and uppercase. The only exception is the period, which signals a */ -/* blank line. */ - - ok = TRUE_; - i__1 = *nopt; - for (i__ = 1; i__ <= i__1; ++i__) { - okdigi = *(unsigned char *)&optnam[(i__ - 1) * optnam_len] >= '0' && * - (unsigned char *)&optnam[(i__ - 1) * optnam_len] <= '9'; - okalph = *(unsigned char *)&optnam[(i__ - 1) * optnam_len] >= 'A' && * - (unsigned char *)&optnam[(i__ - 1) * optnam_len] <= 'Z'; - okequ = *(unsigned char *)&optnam[(i__ - 1) * optnam_len] == '.'; - ok = ok && (okdigi || okalph || okequ); - if (! ok) { - setmsg_("An illegal option name was found: option #, name '#'. ", - (ftnlen)54); - errint_("#", &i__, (ftnlen)1); - sigerr_("SPICE(ILLEGALOPTIONNAME)", (ftnlen)24); - chkout_("GETOPT", (ftnlen)6); - return 0; - } - } - -/* Do until we get a valid option. */ - - done = FALSE_; - while(! done) { - -/* Display the menu title if it is non blank */ - - if (s_cmp(title, " ", title_len, (ftnlen)1) != 0) { - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - s_copy(line + 9, "#", (ftnlen)71, (ftnlen)1); - repmc_(line, "#", title, line, (ftnlen)80, (ftnlen)1, title_len, ( - ftnlen)80); - writln_(line, &c__6, (ftnlen)80); - } - -/* Display the menu and read in an option. */ - - writln_(" ", &c__6, (ftnlen)1); - i__1 = *nopt; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - if (s_cmp(optnam + (i__ - 1) * optnam_len, ".", optnam_len, ( - ftnlen)1) != 0) { - s_copy(line + 3, "( # ) #", (ftnlen)77, (ftnlen)7); - repmc_(line, "#", optnam + (i__ - 1) * optnam_len, line, ( - ftnlen)80, (ftnlen)1, optnam_len, (ftnlen)80); - repmc_(line, "#", opttxt + (i__ - 1) * opttxt_len, line, ( - ftnlen)80, (ftnlen)1, opttxt_len, (ftnlen)80); - } - writln_(line, &c__6, (ftnlen)80); - } - writln_(" ", &c__6, (ftnlen)1); - i__ = rtrim_(prmpt, (ftnlen)80) + 1; - prompt_(prmpt, line, i__, (ftnlen)80); - if (failed_()) { - chkout_("GETOPT", (ftnlen)6); - return 0; - } - -/* Initialize the option value to zero, invalid option. */ - - iopt = 0; - if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) == 0) { - writln_(" ", &c__6, (ftnlen)1); - } else { - ljust_(line, line, (ftnlen)80, (ftnlen)80); - ucase_(line, line, (ftnlen)80, (ftnlen)80); - -/* Check to make sure that the option we got is a valid */ -/* candidate: It must be alpha numeric. */ - - okdigi = *(unsigned char *)line >= '0' && *(unsigned char *)line - <= '9'; - okalph = *(unsigned char *)line >= 'A' && *(unsigned char *)line - <= 'Z'; - ok = okdigi || okalph; - -/* If we got a valid candidate for an option, see if it is one */ -/* of the options that we are supplying. */ - - if (ok) { - iopt = isrchc_(line, nopt, optnam, (ftnlen)1, optnam_len); - ok = iopt != 0; - } - if (! ok) { - s_copy(msg, "'#' was not a valid option. Please try again.", ( - ftnlen)80, (ftnlen)45); - repmc_(msg, "#", line, msg, (ftnlen)80, (ftnlen)1, (ftnlen)1, - (ftnlen)80); - writln_(" ", &c__6, (ftnlen)1); - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - s_copy(line + 3, "***", (ftnlen)77, (ftnlen)3); - writln_(line, &c__6, (ftnlen)80); - s_copy(line + 3, "*** #", (ftnlen)77, (ftnlen)5); - repmc_(line, "#", msg, line, (ftnlen)80, (ftnlen)1, (ftnlen) - 80, (ftnlen)80); - writln_(line, &c__6, (ftnlen)80); - s_copy(line + 3, "***", (ftnlen)77, (ftnlen)3); - writln_(line, &c__6, (ftnlen)80); - writln_(" ", &c__6, (ftnlen)1); - } else { - *option = iopt; - done = TRUE_; - } - } - } - chkout_("GETOPT", (ftnlen)6); - return 0; -} /* getopt_ */ - diff --git a/ext/spice/src/csupport/getopt_1.c b/ext/spice/src/csupport/getopt_1.c deleted file mode 100644 index e64e108334..0000000000 --- a/ext/spice/src/csupport/getopt_1.c +++ /dev/null @@ -1,361 +0,0 @@ -/* getopt_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__9 = 9; -static integer c__1 = 1; -static integer c__4 = 4; - -/* $ Procedure GETOPT_1 ( Get option string from a specified list ) */ - -/* Subroutine */ int getopt_1__(char *title, integer *nopt, char *optnam, - integer *namlen, char *opttxt, integer *txtlen, char *optval, char * - option, ftnlen title_len, ftnlen optnam_len, ftnlen opttxt_len, - ftnlen optval_len, ftnlen option_len) -{ - /* System generated locals */ - address a__1[2], a__2[4]; - integer i__1[2], i__2, i__3[4]; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char - *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical done; - char line[80]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer itask; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen); - char msg[80]; - - /* Fortran I/O blocks */ - static cilist io___3 = { 0, 6, 0, 0, 0 }; - static cilist io___4 = { 0, 6, 0, 0, 0 }; - static cilist io___5 = { 0, 6, 0, 0, 0 }; - static cilist io___7 = { 0, 6, 0, 0, 0 }; - static cilist io___8 = { 0, 6, 0, 0, 0 }; - static cilist io___10 = { 0, 6, 0, 0, 0 }; - static cilist io___11 = { 0, 6, 0, 0, 0 }; - static cilist io___12 = { 0, 6, 0, 0, 0 }; - static cilist io___13 = { 0, 6, 0, 0, 0 }; - - - -/* $ Abstract */ - -/* Display a list of options in a standard menu format, and get */ -/* an option from a user returning the corresponding value from */ -/* a specified list of option values. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TITLE I Title for the option menu. */ -/* NOPT I Number of options available. */ -/* OPTNAM I Names for the options (the selection names). */ -/* NAMLEN I Length of all of the option names. */ -/* OPTTXT I Brief text describing an option. */ -/* TXTLEN I Length of the descriptive text for all options. */ -/* OPTVAL I The value returned when its option is selected. */ -/* OPTION O The value of the option selected. */ - -/* $ Detailed_Input */ - -/* TITLE Title for the option menu. */ - -/* NOPT The number of menu options to be displayed. */ - -/* OPTNAM A list of short (mnemonic) names for the menu options. */ -/* These are the names used to selectan option. */ - -/* NAMLEN The maximum length of the short names for the menu */ -/* options. This number should probably be kept small, */ -/* say 6 characters or less. */ - -/* OPTTXT A list of character strings which contain brief */ -/* descriptions for each of the menu options. These */ -/* character strings should be kept relatively short. */ - -/* TXTLEN The maximum length of the brief descriptions of the */ -/* menu options. This number should probably be relatively */ -/* small small, say 50 characters or less. */ - -/* OPTVAL A list of textual values one of which will be returned */ -/* when a menu option is selected. */ - -/* $ Detailed_Output */ - -/* OPTION The value of the option selected from the menu, as */ -/* specified by the appropriate value of OPTVAL. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of options, NOPT, is not > 0, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If the length of the option names, NAMLEN, is not > 0, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 3) If the length of the option text, TXTLEN, is not > 0, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will display a menu of options in a standardized */ -/* format, promting for an option to be selected. This routine */ -/* will not return to the caller until one of the supplied options */ -/* has been selected. */ - -/* Please note that the lengths of the option names, OPTNAM, and */ -/* the descriptive text for each option, OPTTXT, should be kept */ -/* reasonable, they both need to fit on the same output line with */ -/* a width of 80 characters. 13 characters out of the 80 available */ -/* are used for spacing and menu presentation, so there are 67 */ -/* characters available for the option name and the descriptive text */ -/* combined. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (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 */ - - -/* - Beta Version 3.0.0, 03-SEP-1992 (KRG) */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Local variables */ - - -/* Saved variables */ - -/* None. */ - - -/* Initial values */ - -/* None. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETOPT_1", (ftnlen)8); - } - -/* Check to make sure that the number of menu options is positive. */ -/* if it is not, then signal an error with an appropriate error */ -/* message. */ - - if (*nopt < 1) { - setmsg_("The number of options was not positive: #.", (ftnlen)42); - errint_("#", nopt, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("GETOPT_1", (ftnlen)8); - return 0; - } - -/* Check to make sure that the length of the option names is at */ -/* least 1. If not, then signal an error with an appropriate error */ -/* message. */ - - if (*namlen < 1) { - setmsg_("The length of the option names was not positive: #.", ( - ftnlen)51); - errint_("#", namlen, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("GETOPT_1", (ftnlen)8); - return 0; - } - -/* Check to make sure that the length of the descriptive text for */ -/* each option is at least 1. If not, then signal an error with an */ -/* appropriate error message. */ - - if (*txtlen < 1) { - setmsg_("The length of the option descriptions was not positive: #.", - (ftnlen)58); - errint_("#", txtlen, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("GETOPT_1", (ftnlen)8); - return 0; - } - -/* Do until we get an option */ - - done = FALSE_; - while(! done) { - -/* Display the menu title if it is non blank */ - - if (s_cmp(title, " ", title_len, (ftnlen)1) != 0) { -/* Writing concatenation */ - i__1[0] = 16, a__1[0] = " "; - i__1[1] = title_len, a__1[1] = title; - s_cat(line, a__1, i__1, &c__2, (ftnlen)80); - s_wsle(&io___3); - e_wsle(); - s_wsle(&io___4); - do_lio(&c__9, &c__1, line, rtrim_(line, (ftnlen)80)); - e_wsle(); - } - -/* Display the menu and read in an option. */ - - s_wsle(&io___5); - e_wsle(); - i__2 = *nopt; - for (itask = 1; itask <= i__2; ++itask) { -/* Writing concatenation */ - i__3[0] = 10, a__2[0] = " ( "; - i__3[1] = *namlen, a__2[1] = optnam + (itask - 1) * optnam_len; - i__3[2] = 3, a__2[2] = " ) "; - i__3[3] = *txtlen, a__2[3] = opttxt + (itask - 1) * opttxt_len; - s_cat(line, a__2, i__3, &c__4, (ftnlen)80); - s_wsle(&io___7); - do_lio(&c__9, &c__1, line, rtrim_(line, (ftnlen)80)); - e_wsle(); - } - -/* Initialize the task indicator to zero, invalid task. */ - - itask = 0; - s_wsle(&io___8); - e_wsle(); - prompt_(" Option: ", line, (ftnlen)12, (ftnlen)80); - if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) != 0) { - ljust_(line, line, (ftnlen)80, (ftnlen)80); - ucase_(line, line, (ftnlen)80, (ftnlen)80); - itask = isrchc_(line, nopt, optnam, (*namlen), optnam_len); - if (itask == 0) { - s_copy(msg, "'#' was not a valid option. Please try again.", ( - ftnlen)80, (ftnlen)45); - repmc_(msg, "#", line, msg, (ftnlen)80, (ftnlen)1, (ftnlen)80, - (ftnlen)80); - s_wsle(&io___10); - e_wsle(); - s_copy(line, " *****", (ftnlen)80, (ftnlen)9); - s_wsle(&io___11); - do_lio(&c__9, &c__1, line, rtrim_(line, (ftnlen)80)); - e_wsle(); -/* Writing concatenation */ - i__1[0] = 10, a__1[0] = " ***** "; - i__1[1] = rtrim_(msg, (ftnlen)80), a__1[1] = msg; - s_cat(line, a__1, i__1, &c__2, (ftnlen)80); - s_wsle(&io___12); - do_lio(&c__9, &c__1, line, rtrim_(line, (ftnlen)80)); - e_wsle(); - s_copy(line, " *****", (ftnlen)80, (ftnlen)9); - s_wsle(&io___13); - do_lio(&c__9, &c__1, line, rtrim_(line, (ftnlen)80)); - e_wsle(); - } else { - s_copy(option, optval + (itask - 1) * optval_len, option_len, - optval_len); - done = TRUE_; - } - } - } - chkout_("GETOPT_1", (ftnlen)8); - return 0; -} /* getopt_1__ */ - diff --git a/ext/spice/src/csupport/getopt_2.c b/ext/spice/src/csupport/getopt_2.c deleted file mode 100644 index 09d9eb1a9a..0000000000 --- a/ext/spice/src/csupport/getopt_2.c +++ /dev/null @@ -1,348 +0,0 @@ -/* getopt_2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__9 = 9; -static integer c__1 = 1; -static integer c__4 = 4; - - -/* $ Procedure GETOPT_2 ( Get option string from a specified list ) */ - -/* Subroutine */ int getopt_2__(char *title, integer *tindnt, integer *nopt, - char *optnam, char *opttxt, integer *oindnt, integer *option, ftnlen - title_len, ftnlen optnam_len, ftnlen opttxt_len) -{ - /* System generated locals */ - address a__1[2], a__2[4]; - integer i__1[2], i__2, i__3[4]; - char ch__1[88]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char - *, ftnlen); - - /* Local variables */ - logical done; - char line[80], space[80]; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - extern integer nbwid_(char *, integer *, ftnlen); - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - integer itask; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - char myopt[80]; - integer namlen; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen); - char msg[80]; - - /* Fortran I/O blocks */ - static cilist io___5 = { 0, 6, 0, 0, 0 }; - static cilist io___6 = { 0, 6, 0, 0, 0 }; - static cilist io___7 = { 0, 6, 0, 0, 0 }; - static cilist io___10 = { 0, 6, 0, 0, 0 }; - static cilist io___11 = { 0, 6, 0, 0, 0 }; - static cilist io___13 = { 0, 6, 0, 0, 0 }; - static cilist io___14 = { 0, 6, 0, 0, 0 }; - static cilist io___15 = { 0, 6, 0, 0, 0 }; - static cilist io___16 = { 0, 6, 0, 0, 0 }; - - - -/* $ Abstract */ - -/* Display a list of options in a standard menu format, and get */ -/* an option from a user returning the corresponding value from */ -/* a specified list of option values. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* TITLE I Title for the option menu. */ -/* NOPT I Number of options available. */ -/* OPTNAM I Names for the options (the selection names). */ -/* NAMLEN I Length of all of the option names. */ -/* OPTTXT I Brief text describing an option. */ -/* TXTLEN I Length of the descriptive text for all options. */ -/* OPTVAL I The value returned when its option is selected. */ -/* OPTION O The value of the option selected. */ - -/* $ Detailed_Input */ - -/* TITLE Title for the option menu. */ - -/* NOPT The number of menu options to be displayed. */ - -/* OPTNAM A list of short (mnemonic) names for the menu options. */ -/* These are the names used to selectan option. */ - -/* NAMLEN The maximum length of the short names for the menu */ -/* options. This number should probably be kept small, */ -/* say 6 characters or less. */ - -/* OPTTXT A list of character strings which contain brief */ -/* descriptions for each of the menu options. These */ -/* character strings should be kept relatively short. */ - -/* TXTLEN The maximum length of the brief descriptions of the */ -/* menu options. This number should probably be relatively */ -/* small small, say 50 characters or less. */ - -/* OPTVAL A list of textual values one of which will be returned */ -/* when a menu option is selected. */ - -/* $ Detailed_Output */ - -/* OPTION The value of the option selected from the menu, as */ -/* specified by the appropriate value of OPTVAL. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of options, NOPT, is not > 0, the error */ -/* SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 2) If the length of the option names, NAMLEN, is not > 0, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* 3) If the length of the option text, TXTLEN, is not > 0, */ -/* the error SPICE(INVALIDARGUMENT) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will display a menu of options in a standardized */ -/* format, promting for an option to be selected. This routine */ -/* will not return to the caller until one of the supplied options */ -/* has been selected. */ - -/* Please note that the lengths of the option names, OPTNAM, and */ -/* the descriptive text for each option, OPTTXT, should be kept */ -/* reasonable, they both need to fit on the same output line with */ -/* a width of 80 characters. 13 characters out of the 80 available */ -/* are used for spacing and menu presentation, so there are 67 */ -/* characters available for the option name and the descriptive text */ -/* combined. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - Beta Version 3.0.0, 03-SEP-1992 (KRG) */ - -/* -& */ -/* $ Revisions */ - -/* None. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Local variables */ - - -/* Saved variables */ - -/* None. */ - - -/* Initial values */ - -/* None. */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETOPT_2", (ftnlen)8); - } - -/* Check to make sure that the number of menu options is positive. */ -/* if it is not, then signal an error with an appropriate error */ -/* message. */ - - if (*nopt < 1) { - setmsg_("The number of options was not positive: #.", (ftnlen)42); - errint_("#", nopt, (ftnlen)1); - sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); - chkout_("GETOPT_2", (ftnlen)8); - return 0; - } - -/* Do until we get an option */ - - namlen = nbwid_(optnam, nopt, optnam_len); - done = FALSE_; - s_copy(space, " ", (ftnlen)80, (ftnlen)1); - while(! done) { - -/* Display the menu title if it is non blank */ - - if (s_cmp(title, " ", title_len, (ftnlen)1) != 0) { - if (*tindnt > 0) { -/* Writing concatenation */ - i__1[0] = *tindnt, a__1[0] = space; - i__1[1] = title_len, a__1[1] = title; - s_cat(line, a__1, i__1, &c__2, (ftnlen)80); - } else { - s_copy(line, title, (ftnlen)80, title_len); - } - s_wsle(&io___5); - e_wsle(); - s_wsle(&io___6); - do_lio(&c__9, &c__1, line, (ftnlen)80); - e_wsle(); - } - s_copy(line, " ", (ftnlen)80, (ftnlen)1); - s_wsle(&io___7); - do_lio(&c__9, &c__1, line, (ftnlen)1); - e_wsle(); - i__2 = *nopt; - for (itask = 1; itask <= i__2; ++itask) { - if (s_cmp(optnam + (itask - 1) * optnam_len, " ", optnam_len, ( - ftnlen)1) != 0) { -/* Writing concatenation */ - i__3[0] = 2, a__2[0] = "( "; - i__3[1] = namlen, a__2[1] = optnam + (itask - 1) * optnam_len; - i__3[2] = 3, a__2[2] = " ) "; - i__3[3] = opttxt_len, a__2[3] = opttxt + (itask - 1) * - opttxt_len; - s_cat(myopt, a__2, i__3, &c__4, (ftnlen)80); - } else { -/* Writing concatenation */ - i__1[0] = namlen + 5, a__1[0] = space; - i__1[1] = opttxt_len, a__1[1] = opttxt + (itask - 1) * - opttxt_len; - s_cat(myopt, a__1, i__1, &c__2, (ftnlen)80); - } - if (*oindnt > 0) { -/* Writing concatenation */ - i__1[0] = *oindnt, a__1[0] = space; - i__1[1] = 80, a__1[1] = myopt; - s_cat(line, a__1, i__1, &c__2, (ftnlen)80); - } else { - s_copy(line, myopt, (ftnlen)80, (ftnlen)80); - } - s_wsle(&io___10); - do_lio(&c__9, &c__1, line, rtrim_(line, (ftnlen)80)); - e_wsle(); - } - -/* Initialize the task indicator to zero, invalid task. */ - - itask = 0; - s_wsle(&io___11); - e_wsle(); -/* Writing concatenation */ - i__1[0] = *oindnt, a__1[0] = space; - i__1[1] = 8, a__1[1] = "Option: "; - s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)88); - prompt_(ch__1, line, *oindnt + 8, (ftnlen)80); - if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) != 0) { - ljust_(line, line, (ftnlen)80, (ftnlen)80); - ucase_(line, line, (ftnlen)80, (ftnlen)80); - itask = isrchc_(line, nopt, optnam, (ftnlen)80, optnam_len); - if (itask == 0) { - s_copy(msg, "***** '#' was not a valid option. Please try ag" - "ain.", (ftnlen)80, (ftnlen)51); - repmc_(msg, "#", line, msg, (ftnlen)80, (ftnlen)1, (ftnlen)80, - (ftnlen)80); - s_wsle(&io___13); - e_wsle(); - s_wsle(&io___14); - do_lio(&c__9, &c__1, "*****", (ftnlen)5); - e_wsle(); - s_wsle(&io___15); - do_lio(&c__9, &c__1, msg, rtrim_(msg, (ftnlen)80)); - e_wsle(); - s_wsle(&io___16); - do_lio(&c__9, &c__1, "*****", (ftnlen)5); - e_wsle(); - } else { - *option = itask; - done = TRUE_; - } - } - } - chkout_("GETOPT_2", (ftnlen)8); - return 0; -} /* getopt_2__ */ - diff --git a/ext/spice/src/csupport/have.c b/ext/spice/src/csupport/have.c deleted file mode 100644 index 63e070794f..0000000000 --- a/ext/spice/src/csupport/have.c +++ /dev/null @@ -1,190 +0,0 @@ -/* have.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure HAVE ( Do we have an error? ) */ -logical have_(char *error, ftnlen error_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[32]; - integer i__, depth; - extern /* Subroutine */ int reset_(void); - extern logical failed_(void); - extern /* Subroutine */ int trcdep_(integer *), trcnam_(integer *, char *, - ftnlen), getlms_(char *, ftnlen), prefix_(char *, integer *, - char *, ftnlen, ftnlen), getsms_(char *, ftnlen), suffix_(char *, - integer *, char *, ftnlen, ftnlen); - char sms[80]; - -/* $ Abstract */ - -/* Determine if an error has occurred. */ - -/* $ 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 */ - -/* ERROR */ - -/* $ Keywords */ - -/* ERROR */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ERROR I/O Error message array. */ - -/* The function returns .TRUE. if an error occurred. */ - -/* $ Detailed_Input */ - -/* ERROR is the character string array containing an error */ -/* message. */ - -/* $ Detailed_Output */ - -/* ERROR is the character string containing an error message. */ -/* If ERROR was blank on input and an error was detected */ -/* by the SPICELIB error handling mechanism, ERROR contains */ -/* the SPICELIB long error message on output. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Beta Version 1.0.0, 14-MAY-1992 (HAN) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Check to see if an error occurred. */ - - if (*(unsigned char *)&error[0] != ' ' || failed_()) { - ret_val = TRUE_; - } else { - ret_val = FALSE_; - return ret_val; - } - -/* If an error was detected by the SPICELIB error handling and */ -/* the ERROR message is blank, we need to get the SPICELIB error */ -/* message. After that, reset the error handling. */ - - if (failed_() && s_cmp(error, " ", error_len, (ftnlen)1) == 0) { - getsms_(sms, (ftnlen)80); - getlms_(error, error_len); - prefix_("--", &c__0, error, (ftnlen)2, error_len); - prefix_(sms, &c__0, error, (ftnlen)80, error_len); - s_copy(error + error_len, "SPICELIB Trace>", error_len, (ftnlen)15); - trcdep_(&depth); - i__1 = depth; - for (i__ = 1; i__ <= i__1; ++i__) { - trcnam_(&i__, name__, (ftnlen)32); - if (i__ == 1) { - suffix_(name__, &c__1, error + error_len, (ftnlen)32, - error_len); - } else { - suffix_(name__, &c__0, error + error_len, (ftnlen)32, - error_len); - } - if (i__ != depth) { - suffix_(":", &c__0, error + error_len, (ftnlen)1, error_len); - } - } - reset_(); - -/* It is possible that FAILED() is true, even though we already */ -/* had a recorded error. To avoid having this show up in a later */ -/* command, we reset the SPICELIB error handling now. This isn't */ -/* really a good solution, but a better one doesn't come to mind */ -/* at the moment. */ - - } else if (failed_()) { - reset_(); - } - return ret_val; -} /* have_ */ - diff --git a/ext/spice/src/csupport/header.c b/ext/spice/src/csupport/header.c deleted file mode 100644 index 5186c06c7c..0000000000 --- a/ext/spice/src/csupport/header.c +++ /dev/null @@ -1,273 +0,0 @@ -/* header.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure HEADER (HEADER for a report) */ -/* Subroutine */ int header_0_(int n__, integer *n, integer *comp, char * - value, integer *wdth, ftnlen value_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer i__, j; - extern integer rtrim_(char *, ftnlen); - static char buffer[1600*40*10]; - -/* $ Abstract */ - -/* This is an umbrella routine for setting up headers */ -/* on tabular reports. */ - -/* $ 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 */ - -/* REPORTS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* N I/O Column number */ -/* COMP I/O Component number */ -/* VALUE I/O String Value. */ -/* WDTH O Non-blank width of VALUE */ - -/* $ Detailed_Input */ - -/* N specifies which column is being defined. */ -/* Legitimate values are 1 to 40. */ - -/* COMP specifies which column component is being */ -/* specified. Legitimate values are 1 to 10. */ - -/* VALUE specifies the column component value. It should */ -/* be 800 or fewer characters in length. */ - -/* $ Detailed_Output */ - -/* N specifies which column to fetch information from. */ -/* Legitimate values are 1 to 40. */ - -/* COMP specifies which column component is to obtain */ -/* information for. Legitimate values are 1 to 10. */ - -/* VALUE Value of requested column component. */ - -/* WDTH is the non-blank width of VALUE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* If N or NCOMP is out of range: */ - -/* SCOLMN simply returns. No data is buffered. No warning */ -/* or error is issued. */ - -/* GCOLMN returns a blank. WDTH will be set to 1. */ - - -/* $ Particulars */ - -/* This is a routine designed to work with the routine */ -/* TABRPT when creating tabular outputs. It is primarily */ -/* intended for creating the header portion of a report. */ - -/* For example, the area marked with the arrow below. */ - -/* Name Phone Address <<============= */ -/* ================================= */ -/* Bill 555-1212 Pasadena, CA */ -/* Bob 555-2121 Flint, Michigan */ -/* Ian 555-1234 San Jose, CA */ - -/* You could use this to fill out the contents of the report */ -/* if you don't have something already that fetches */ -/* string values. */ - -/* $ Examples */ - -/* Suppose you wanted to create the header above and have */ -/* it appear on your reports. Here's all you need to do. */ - -/* CALL SCOLMN ( 1, 1, 'Name' ) */ -/* CALL SCOLMN ( 2, 1, 'Phone' ) */ -/* CALL SCOLMN ( 3, 1, 'Address' ) */ - -/* Then simply pass the entry point GCOLMN to TABRPT to construct */ -/* the header portion of the report. */ - -/* CALL TABRPT ( 3, item, size, */ -/* . width, justr, */ -/* . presrv, spcial, */ -/* . lmarge, space, */ -/* . GCOLMN ) */ - -/* filling out the various items as is appropriate for the */ -/* table you plan to create. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 3-AUG-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Setting and getting values for reports */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Buffer declarations */ - - switch(n__) { - case 1: goto L_scolmn; - case 2: goto L_gcolmn; - case 3: goto L_ccolmn; - } - - return 0; - -/* Set a column component value. */ - - -L_scolmn: - if (first) { - for (i__ = 1; i__ <= 40; ++i__) { - for (j = 1; j <= 10; ++j) { - s_copy(buffer + ((i__1 = i__ + j * 40 - 41) < 400 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, "header_", ( - ftnlen)206)) * 1600, " ", (ftnlen)1600, (ftnlen)1); - } - } - first = FALSE_; - } - if (*n >= 1 && *n <= 40 && *comp >= 1 && *comp <= 10) { - s_copy(buffer + ((i__1 = *n + *comp * 40 - 41) < 400 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "header_", (ftnlen)219)) * 1600, - value, (ftnlen)1600, value_len); - } - return 0; - -/* Get a column component value. */ - - -L_gcolmn: - if (first) { - for (i__ = 1; i__ <= 40; ++i__) { - for (j = 1; j <= 10; ++j) { - s_copy(buffer + ((i__1 = i__ + j * 40 - 41) < 400 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, "header_", ( - ftnlen)234)) * 1600, " ", (ftnlen)1600, (ftnlen)1); - } - } - first = FALSE_; - } - if (*n >= 1 && *n <= 40 && *comp >= 1 && *comp <= 10) { - s_copy(value, buffer + ((i__1 = *n + *comp * 40 - 41) < 400 && 0 <= - i__1 ? i__1 : s_rnge("buffer", i__1, "header_", (ftnlen)247)) - * 1600, value_len, (ftnlen)1600); - *wdth = rtrim_(value, value_len); - } else { - s_copy(value, " ", value_len, (ftnlen)1); - *wdth = 1; - } - return 0; - -L_ccolmn: - for (i__ = 1; i__ <= 40; ++i__) { - for (j = 1; j <= 10; ++j) { - s_copy(buffer + ((i__1 = i__ + j * 40 - 41) < 400 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "header_", (ftnlen)263)) * - 1600, " ", (ftnlen)1600, (ftnlen)1); - } - } - return 0; -} /* header_ */ - -/* Subroutine */ int header_(integer *n, integer *comp, char *value, integer * - wdth, ftnlen value_len) -{ - return header_0_(0, n, comp, value, wdth, value_len); - } - -/* Subroutine */ int scolmn_(integer *n, integer *comp, char *value, ftnlen - value_len) -{ - return header_0_(1, n, comp, value, (integer *)0, value_len); - } - -/* Subroutine */ int gcolmn_(integer *n, integer *comp, char *value, integer * - wdth, ftnlen value_len) -{ - return header_0_(2, n, comp, value, wdth, value_len); - } - -/* Subroutine */ int ccolmn_(void) -{ - return header_0_(3, (integer *)0, (integer *)0, (char *)0, (integer *)0, ( - ftnint)0); - } - diff --git a/ext/spice/src/csupport/langua.c b/ext/spice/src/csupport/langua.c deleted file mode 100644 index 93abeb02a8..0000000000 --- a/ext/spice/src/csupport/langua.c +++ /dev/null @@ -1,98 +0,0 @@ -/* langua.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -/* Subroutine */ int langua_0_(int n__, char *string, ftnlen string_len) -{ - /* Initialized data */ - - static char lang[32] = "ENGLISH "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - ljust_(char *, char *, ftnlen, ftnlen); - - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* This subroutine is used by CMLOOP to store the language that */ -/* is currently used by the user's program. You may freely use */ -/* it throughout the rest of your program if you make your */ -/* program language sensitive. */ - - switch(n__) { - case 1: goto L_setlan; - case 2: goto L_getlan; - } - - s_copy(string, " ", string_len, (ftnlen)1); - return 0; - -/* The SETLAN entry point is used for setting the language. */ - - -L_setlan: - ljust_(string, lang, string_len, (ftnlen)32); - ucase_(lang, lang, (ftnlen)32, (ftnlen)32); - return 0; - -/* Use the GETLAN entry point to get the language. */ - - -L_getlan: - s_copy(string, lang, string_len, (ftnlen)32); - return 0; -} /* langua_ */ - -/* Subroutine */ int langua_(char *string, ftnlen string_len) -{ - return langua_0_(0, string, string_len); - } - -/* Subroutine */ int setlan_(char *string, ftnlen string_len) -{ - return langua_0_(1, string, string_len); - } - -/* Subroutine */ int getlan_(char *string, ftnlen string_len) -{ - return langua_0_(2, string, string_len); - } - diff --git a/ext/spice/src/csupport/lbdes_1.c b/ext/spice/src/csupport/lbdes_1.c deleted file mode 100644 index b9b5e1d9cb..0000000000 --- a/ext/spice/src/csupport/lbdes_1.c +++ /dev/null @@ -1,163 +0,0 @@ -/* lbdes_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LBDES ( Line buffer, describe ) */ -/* Subroutine */ int lbdes_1__(integer *ptrs, integer *maxln, integer *nline, - integer *ncom, integer *pcard) -{ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - integer psize; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Describe the current internal status of a line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PTRS I Pointer component of the buffer. */ -/* MAXLN O Maximum number of lines. */ -/* NLINE O Current number of lines. */ -/* NCOM O Current number of complement intervals. */ -/* PCARD O Current cardinality of PTRS. */ - -/* $ Detailed_Input */ - -/* PTRS is the pointer component of a line buffer. */ - -/* $ Detailed_Output */ - -/* MAXLN is the maximum number of lines that can be stored in */ -/* the buffer at any one time. */ - -/* NLINE is the number of lines currently stored in the buffer. */ - -/* NCOM is the number of complement intervals (contiguous */ -/* spaces in which new lines can be stored) currently */ -/* available in the buffer. */ - -/* PCARD is the current cardinality of PTRS. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is intended primarily for internal use by the */ -/* line buffer routines. However, the information that it returns */ -/* can be useful for error checking and debugging purposes. */ - -/* $ Examples */ - -/* In the following code fragment, a check is performed before */ -/* attempting to use the routine LBAPP. */ - -/* CALL LBDES ( PTRS, MAXLN, NLINE, NCOM, PCARD ) */ - -/* IF ( NLINE .LT. MAXLN ) THEN */ -/* CALL LBAPP ( LINE, PTRS, BUFFER ) */ - -/* ELSE */ -/* WRITE (6,*) 'Sorry, there isn't room for another line.' */ -/* WRITE (6,*) 'Please delete something and try again.' */ -/* END IF */ - -/* For more examples, see the source code of the other LB routines. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LBDES_1", (ftnlen)7); - } - -/* Recover some information directly. */ - - psize = sizei_(ptrs); - *pcard = cardi_(ptrs); - *nline = ptrs[3]; - -/* Infer the rest. */ - - *maxln = psize / 4 - 1; - *ncom = *pcard / 2 - *nline; - chkout_("LBDES_1", (ftnlen)7); - return 0; -} /* lbdes_1__ */ - diff --git a/ext/spice/src/csupport/lbget_1.c b/ext/spice/src/csupport/lbget_1.c deleted file mode 100644 index 1377ba601a..0000000000 --- a/ext/spice/src/csupport/lbget_1.c +++ /dev/null @@ -1,187 +0,0 @@ -/* lbget_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LBGET ( Line buffer, get ) */ -/* Subroutine */ int lbget_1__(integer *pos, integer *ptrs, char *buffer, - char *line, logical *found, ftnlen buffer_len, ftnlen line_len) -{ - integer ncom, pcard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nline, maxln; - extern /* Subroutine */ int chkout_(char *, ftnlen), cbget_1__(integer *, - integer *, char *, char *, ftnlen, ftnlen), lbdes_1__(integer *, - integer *, integer *, integer *, integer *); - extern logical return_(void); - integer posptr; - -/* $ Abstract */ - -/* Get (return) the line at a particular position within a */ -/* line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POS I Position of line. */ -/* PTRS, */ -/* BUFFER I Line buffer. */ -/* LINE O Line. */ -/* FOUND O True if the line was found. */ - -/* $ Detailed_Input */ - -/* POS is the position of an existing line within a line */ -/* buffer. */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of a line */ -/* buffer. */ - -/* $ Detailed_Output */ - -/* LINE is a copy of the specified line. If LINE is shorter */ -/* than the stored line, it is truncated. If longer, it */ -/* is padded with spaces. */ - -/* FOUND is true whenever the specified line exists, and is */ -/* false otherwise. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If FOUND is false, LINE is not changed. */ - -/* $ Particulars */ - -/* LBGET is the only way to retrieve lines from a line buffer. */ - -/* $ Examples */ - -/* Let the line buffer (P,B) contain the following lines. */ - -/* If you can keep your head when all about you */ -/* Are losing theirs and blaming it on you; */ -/* If you can trust yourself when all men doubt you, */ -/* But make allowance for their doubting too: */ -/* If you can wait and not be tired by waiting, */ -/* Or, being lied about, don't deal in lies, */ -/* Or being hated don't give way to hating, */ -/* And yet don't look too good, nor talk too wise; */ - -/* The code fragment */ - -/* N = 1 */ -/* CALL LBGET ( N, P, B, LINE, FOUND ) */ - -/* DO WHILE ( FOUND ) */ -/* WRITE (*,*) '(', N, ') ', LINE */ - -/* N = N + 1 */ -/* CALL LBGET ( N, P, B, LINE, FOUND ) */ -/* END DO */ - -/* produces the following output: */ - -/* ( 1) If you can keep your head when all about you */ -/* ( 2) Are losing theirs and blaming it on you; */ -/* ( 3) If you can trust yourself when all men doubt you, */ -/* ( 4) But make allowance for their doubting too: */ -/* ( 5) If you can wait and not be tired by waiting, */ -/* ( 6) Or, being lied about, don't deal in lies, */ -/* ( 7) Or being hated don't give way to hating, */ -/* ( 8) And yet don't look too good, nor talk too wise; */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LBGET_1", (ftnlen)7); - } - -/* Recover all the essential control information. */ - - lbdes_1__(ptrs, &maxln, &nline, &ncom, &pcard); - -/* What are the endpoints of the stored line? Once we have */ -/* them, we can return the line directly. */ - - *found = *pos >= 1 && *pos <= nline; - if (*found) { - posptr = (*pos << 1) - 1; - cbget_1__(&ptrs[posptr + 5], &ptrs[posptr + 6], buffer, line, - buffer_len, line_len); - } - chkout_("LBGET_1", (ftnlen)7); - return 0; -} /* lbget_1__ */ - diff --git a/ext/spice/src/csupport/lbinit_1.c b/ext/spice/src/csupport/lbinit_1.c deleted file mode 100644 index 006a590673..0000000000 --- a/ext/spice/src/csupport/lbinit_1.c +++ /dev/null @@ -1,212 +0,0 @@ -/* lbinit_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; -static integer c__1 = 1; - -/* $Procedure LBINIT ( Line buffer, initialize ) */ -/* Subroutine */ int lbinit_1__(integer *psize, integer *vdim, integer *ptrs, - char *buffer, ftnlen buffer_len) -{ - /* System generated locals */ - integer ptrs_dim1, i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer maxln; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), ssizei_(integer *, integer *); - extern logical return_(void); - extern /* Subroutine */ int lbupd_1__(integer *, integer *, integer *), - cbinit_1__(integer *, char *, ftnlen); - extern integer sizecb_1__(char *, ftnlen); - -/* $ Abstract */ - -/* Initialize a line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PSIZE I Pointer size. */ -/* VDIM I Value dimension. */ -/* PTRS, */ -/* BUFFER I,O Line buffer. */ - -/* $ Detailed_Input */ - -/* PTRS is an integer cell array to be used as the pointer */ -/* component of a line buffer. */ - -/* PSIZE is the declared dimension of PTRS. */ - -/* BUFFER is a character buffer array to be used as the */ -/* character compnent of a line buffer. */ - -/* VDIM is the declared dimension of BUFFER. */ - -/* $ Detailed_Output */ - -/* PTRS, */ -/* BUFFER together are an initialized line buffer. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the line buffer cannot hold even a single line, the error */ -/* 'SPICE(LBINSUFPTRSIZE)' is signalled. */ - -/* $ Particulars */ - -/* A line buffer must be initialized to allow subsequent */ -/* operations on the buffer to detect possible overflows. */ -/* Both components of the buffer are initialized by a single */ -/* call to LBINIT. */ - -/* In order to store N lines, PSIZE should be at least 4N+4. */ - -/* $ Examples */ - -/* The following code fragment illustrates the initialization */ -/* of a typical line buffer. */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER LBCBUF */ -/* PARAMETER ( LBCBUF = 0 ) */ - -/* INTEGER MAXLN */ -/* PARAMETER ( MAXLN = 1000 ) */ - -/* INTEGER PSIZE */ -/* PARAMETER ( PSIZE = 4 * MAXLN + 4 ) */ - -/* INTEGER BUFDIM */ -/* PARAMETER ( BUFDIM = 25 ) */ - -/* INTEGER PTRS ( LBCELL:PSIZE ) */ -/* CHARACTER*(MAXLN) BUFFER ( LBCBUF:BUFDIM ) */ -/* . */ -/* . */ - -/* CALL LBINIT ( PSIZE, BUFDIM, PTRS, BUFFER ) */ - -/* In this example, the buffer may be used to store up to 1000 lines */ -/* averaging 25 characters per line, or 25,000 total characters. The */ -/* length of any particular line may range from a single character */ -/* to the entire 25,000 characters. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - /* Parameter adjustments */ - ptrs_dim1 = *psize + 6; - - /* Function Body */ - if (return_()) { - return 0; - } else { - chkin_("LBINIT_1", (ftnlen)8); - } - -/* Initialize the character buffer first. */ - - cbinit_1__(vdim, buffer, buffer_len); - -/* The size must be 4(n+1), where n is the maximum number of */ -/* lines that can be stored. (The line buffer must be able to */ -/* store at least one line!) */ - -/* Every line buffer starts out with zero lines and one complement */ -/* interval, which covers the entire CB. */ - - maxln = *psize / 4 - 1; - if (maxln < 1) { - sigerr_("SPICE(INSUFPTRSIZE)", (ftnlen)19); - } else { - i__1 = maxln + 1 << 2; - ssizei_(&i__1, ptrs); - ptrs[(i__1 = 6) < ptrs_dim1 ? i__1 : s_rnge("ptrs", i__1, "lbinit_1__" - , (ftnlen)197)] = 1; - ptrs[(i__1 = 7) < ptrs_dim1 ? i__1 : s_rnge("ptrs", i__1, "lbinit_1__" - , (ftnlen)198)] = sizecb_1__(buffer, buffer_len); - lbupd_1__(&c__0, &c__1, ptrs); - } - chkout_("LBINIT_1", (ftnlen)8); - return 0; -} /* lbinit_1__ */ - diff --git a/ext/spice/src/csupport/lbins_1.c b/ext/spice/src/csupport/lbins_1.c deleted file mode 100644 index 00cb94c50e..0000000000 --- a/ext/spice/src/csupport/lbins_1.c +++ /dev/null @@ -1,261 +0,0 @@ -/* lbins_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure LBINS ( Line buffer, insert ) */ -/* Subroutine */ int lbins_1__(integer *pos, char *line, integer *ptrs, char * - buffer, ftnlen line_len, ftnlen buffer_len) -{ - /* System generated locals */ - integer i__1, i__2; - static integer equiv_1[2]; - - /* Local variables */ - integer ncom, f, l; -#define begin (equiv_1) - integer pcard, avail; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nline, lnlen, maxln; - extern /* Subroutine */ int inslai_(integer *, integer *, integer *, - integer *, integer *); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen), lbdes_1__(integer *, integer *, integer *, integer *, - integer *); - extern logical return_(void); - extern /* Subroutine */ int lbupd_1__(integer *, integer *, integer *); - integer posptr; - extern /* Subroutine */ int cbput_1__(integer *, integer *, char *, char * - , ftnlen, ftnlen); -#define end (equiv_1 + 1) -#define ptr (equiv_1) - extern /* Subroutine */ int lbpack_1__(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Insert a line into a line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POS I Position of new line. */ -/* LINE I Line to be inserted. */ -/* PTRS, */ -/* BUFFER I,O Line buffer. */ - -/* $ Detailed_Input */ - -/* POS is the position (line number) at which the new line is */ -/* to be inserted. */ - -/* LINE is the line to be inserted. */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of a line */ -/* buffer. */ - -/* $ Detailed_Output */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of the */ -/* same line buffer, after the new line has been */ -/* inserted. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POS exceeds by exactly one the number of lines currently */ -/* stored in the buffer, then LINE is appended to the end of */ -/* the buffer, and no other lines are affected. */ - -/* 2) If POS is less than one, or if POS exceeds by more than one */ -/* the number of lines currently stored in the buffer, the error */ -/* 'SPICE(LBNOSUCHLINE)' is signalled. */ - -/* 3) If the maximum number of lines is currently stored, the */ -/* error 'SPICE(LBTOOMANYLINES)' is signalled. */ - -/* 4) If the line buffer contains insufficient free space to store */ -/* the new line, the error 'SPICE(LBLINETOOLONG)' is signalled. */ - -/* $ Particulars */ - -/* New lines may be inserted at any position within a line buffer. */ -/* The line currently at the specified position and all subsequent */ -/* lines are moved back to make room for the new line. */ - -/* $ Examples */ - -/* Let the line buffer (P,B) contain the following lines */ - -/* If neither foes nor loving friends can hurt you, */ -/* If all men count with you, but none too much: */ - -/* Following the calls */ - -/* CALL LBINS ( 1, */ -/* . 'If you can talk with crowds and keep your virtue,', */ -/* . P, B ) */ - -/* CALL LBINS ( 2, */ -/* . 'Or walk with Kings---nor lose the common touch,', */ -/* . P, B ) */ - -/* it contains the lines */ - -/* If you can talk with crowds and keep your virtue, */ -/* Or walk with Kings---nor lose the common touch, */ -/* If neither foes nor loving friends can hurt you, */ -/* If all men count with you, but none too much: */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Equivalences */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LBINS_1", (ftnlen)7); - } - -/* Recover all the essential control information. */ - - lbdes_1__(ptrs, &maxln, &nline, &ncom, &pcard); - -/* Where should this line be inserted, if at all? */ - - if (nline == maxln) { - setmsg_("Current line limit is #.", (ftnlen)24); - errint_("#", &maxln, (ftnlen)1); - sigerr_("SPICE(LBTOOMANYLINES)", (ftnlen)21); - } else if (*pos < 1 || *pos - nline > 1) { - setmsg_("Tried to access line # of #.", (ftnlen)28); - errint_("#", pos, (ftnlen)1); - errint_("#", &nline, (ftnlen)1); - sigerr_("SPICE(LBNOSUCHLINE)", (ftnlen)19); - } else { - posptr = (*pos << 1) - 1; - -/* Leading blanks are significant; trailing blanks are history. */ -/* (Store a blank string as a single blank character.) */ - - f = 1; -/* Computing MAX */ - i__1 = 1, i__2 = lastnb_(line, line_len); - l = max(i__1,i__2); - lnlen = l - f + 1; - -/* Store each new string at the end of the end of the CB. */ -/* If the final interval in the complement isn't large enough */ -/* to hold the new string, pack the CB and try again. */ - - avail = ptrs[pcard + 5] - ptrs[pcard + 4] + 1; - if (avail < lnlen) { - lbpack_1__(ptrs, buffer, buffer_len); - lbdes_1__(ptrs, &maxln, &nline, &ncom, &pcard); - avail = ptrs[pcard + 5] - ptrs[pcard + 4] + 1; - } - -/* If there still isn't enough room? Well, those are the breaks. */ - - if (avail < lnlen) { - sigerr_("SPICE(LBLINETOOLONG)", (ftnlen)20); - -/* If there is room, allocate just enough of the final interval */ -/* in the complement to contain the new string; store the string; */ -/* and insert the name and pointers at their proper locations. */ - - } else { - *begin = ptrs[pcard + 4]; - *end = *begin + lnlen - 1; - ptrs[pcard + 4] = *end + 1; - cbput_1__(begin, end, line + (f - 1), buffer, l - (f - 1), - buffer_len); - inslai_(ptr, &c__2, &posptr, &ptrs[6], &pcard); - i__1 = nline + 1; - lbupd_1__(&i__1, &ncom, ptrs); - } - } - chkout_("LBINS_1", (ftnlen)7); - return 0; -} /* lbins_1__ */ - -#undef ptr -#undef end -#undef begin - - diff --git a/ext/spice/src/csupport/lbpack_1.c b/ext/spice/src/csupport/lbpack_1.c deleted file mode 100644 index c09fb4a249..0000000000 --- a/ext/spice/src/csupport/lbpack_1.c +++ /dev/null @@ -1,190 +0,0 @@ -/* lbpack_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure LBPACK ( Line buffer, pack ) */ -/* Subroutine */ int lbpack_1__(integer *ptrs, char *buffer, ftnlen - buffer_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer ncom, i__, j, begin, pcard; - extern /* Subroutine */ int chkin_(char *, ftnlen), maxai_(integer *, - integer *, integer *, integer *); - integer nline, maxln, offset, intlen; - extern /* Subroutine */ int chkout_(char *, ftnlen), cbrem_1__(integer *, - integer *, char *, ftnlen), lbdes_1__(integer *, integer *, - integer *, integer *, integer *); - extern logical return_(void); - extern /* Subroutine */ int lbupd_1__(integer *, integer *, integer *); - integer end; - extern integer sizecb_1__(char *, ftnlen); - -/* $ Abstract */ - -/* Pack the contents of a line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* PTRS, */ -/* BUFFER I,O Line buffer. */ - -/* $ Detailed_Input */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of a line */ -/* buffer. */ - -/* $ Detailed_Output */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of the */ -/* same line buffer after packing. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* As lines are added to and removed from a line buffer, the */ -/* buffer becomes fragmented, with free space spread throughout. */ -/* Occasionally, the LB routines will pull all the current lines */ -/* toward the front of the buffer, accumulating all the free */ -/* space in one contiguous chunk. */ - -/* LBPACK is provided mainly for internal use by the LB routines, */ -/* but you may pack a line buffer any time you want. Packing a */ -/* buffer will typically speed up operations that change the contents */ -/* of a buffer, but will have no effect on retrieval operations. */ - -/* $ Examples */ - -/* LBPACK is used by LBINS. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LBPACK_1", (ftnlen)8); - } - -/* Recover the essential control information. */ - - lbdes_1__(ptrs, &maxln, &nline, &ncom, &pcard); - -/* For each interval in the complement... */ - - offset = nline << 1; - i__1 = pcard; - for (i__ = offset + 1; i__ <= i__1; i__ += 2) { - -/* Remove the contents of the interval from the CB, pulling */ -/* the remaining contents forward. */ - - begin = ptrs[i__ + 5]; - end = ptrs[i__ + 6]; - intlen = end - begin + 1; - if (begin <= end) { - cbrem_1__(&begin, &end, buffer, buffer_len); - -/* Adjust the pointers for both the lines and the complement */ -/* intervals that followed the purged interval. */ - - i__2 = pcard; - for (j = 1; j <= i__2; ++j) { - if (ptrs[j + 5] > end) { - ptrs[j + 5] -= intlen; - } - } - } - } - -/* There is only one interval in the complement now. It begins */ -/* just after the last line, and runs to the end of the buffer. */ - - maxai_(&ptrs[6], &offset, &end, &j); - ptrs[offset + 6] = end + 1; - ptrs[offset + 7] = sizecb_1__(buffer, buffer_len); - lbupd_1__(&nline, &c__1, ptrs); - chkout_("LBPACK_1", (ftnlen)8); - return 0; -} /* lbpack_1__ */ - diff --git a/ext/spice/src/csupport/lbrem_1.c b/ext/spice/src/csupport/lbrem_1.c deleted file mode 100644 index a49e0fbd62..0000000000 --- a/ext/spice/src/csupport/lbrem_1.c +++ /dev/null @@ -1,254 +0,0 @@ -/* lbrem_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure LBREM ( Line buffer, remove ) */ -/* Subroutine */ int lbrem_1__(integer *pos, integer *ptrs, char *buffer, - ftnlen buffer_len) -{ - /* System generated locals */ - integer i__1; - char ch__1[1]; - static integer equiv_1[2]; - - /* Local variables */ - integer ncom, i__; -#define begin (equiv_1) - integer pcard; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer nline, maxln; - extern /* Subroutine */ int remlai_(integer *, integer *, integer *, - integer *), inslai_(integer *, integer *, integer *, integer *, - integer *); - extern /* Character */ VOID touchc_(char *, ftnlen, char *, ftnlen); - integer offset; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - integer poscom; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), lbdes_1__(integer *, integer *, integer *, - integer *, integer *); - extern logical return_(void); - extern /* Subroutine */ int lbupd_1__(integer *, integer *, integer *); - integer posptr; -#define end (equiv_1 + 1) -#define ptr (equiv_1) - -/* $ Abstract */ - -/* Remove a line from a line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POS I Position of line to be removed. */ -/* PTRS, */ -/* BUFFER I,O Line buffer. */ - -/* $ Detailed_Input */ - -/* POS is the position of an existing line within a line */ -/* buffer. */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of a line */ -/* buffer. */ - -/* $ Detailed_Output */ - -/* PTRS, */ -/* BUFFER are the pointer and character components of the */ -/* same line buffer, after the specified line has been */ -/* removed. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POS is less than one, or if POS is greater than the */ -/* number of lines currently stored in the buffer, the error */ -/* 'SPICE(LBNOSUCHLINE)' is signalled. */ - -/* $ Particulars */ - -/* Existing lines may be removed from at any position within a line */ -/* buffer. All subsequent lines are moved forward to take up the */ -/* slack. */ - -/* $ Examples */ - -/* Let the line buffer (P,B) contain the following lines */ - -/* If you can make one heap of all your winnings */ -/* And risk it on one turn of pitch-and-toss, */ -/* And lose, and start again at your beginnings, */ -/* And never breathe a word about your loss: */ -/* If you can force your heart and nerve and sinew */ -/* To serve your turn long after they are gone, */ - -/* Following the calls */ - -/* CALL LBREM ( 3, P, B ) */ -/* CALL LBREP ( 3, P, B ) */ - -/* it contains the lines */ - -/* If you can make one heap of all your winnings */ -/* And risk it on one turn of pitch-and-toss, */ -/* If you can force your heart and nerve and sinew */ -/* To serve your turn long after they are gone, */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Inspekt Version 3.0.0 9-May-1994 (WLT) */ - -/* Added a "TOUCHC" to the input buffer so that compilers */ -/* won't complain about input arguments not being used. */ - -/* And fixed the addition of "TOUCHC" to refere to LBCBUF */ -/* instead of LBCELL */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other Functions */ - - -/* Local variables */ - - -/* Equivalences */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LBREM_1", (ftnlen)7); - } - -/* We touch the input buffer so that compilers will not complain */ -/* that BUFFER is an unused argument. It really is unused, but */ -/* it's in the calling sequence for the sake of uniformity of */ -/* the calling sequences for the line buffer routines. */ - - touchc_(ch__1, (ftnlen)1, buffer, buffer_len); - *(unsigned char *)&buffer[0] = *(unsigned char *)&ch__1[0]; - -/* Recover the essential control information. */ - - lbdes_1__(ptrs, &maxln, &nline, &ncom, &pcard); - -/* No way to remove a line that's not in the table. */ - - if (*pos < 1 || *pos > nline) { - setmsg_("Tried to access line # of #.", (ftnlen)28); - errint_("#", pos, (ftnlen)1); - errint_("#", &nline, (ftnlen)1); - sigerr_("SPICE(LBNOSUCHLINE)", (ftnlen)19); - chkout_("LBREM_1", (ftnlen)7); - return 0; - } - -/* Save the bounds of the stored line before removing the name */ -/* and pointers from their respective tables. */ - - posptr = (*pos << 1) - 1; - *begin = ptrs[posptr + 5]; - *end = ptrs[posptr + 6]; - --nline; - remlai_(&c__2, &posptr, &ptrs[6], &pcard); - -/* Add the interval to the complement. Insert it directly, then */ -/* do any merges required. */ - - offset = nline << 1; - poscom = offset + 1; - i__1 = pcard; - for (i__ = offset + 2; i__ <= i__1; i__ += 2) { - if (*begin > ptrs[i__ + 5]) { - poscom = i__ + 1; - } - } - inslai_(ptr, &c__2, &poscom, &ptrs[6], &pcard); - i__1 = offset + 2; - for (i__ = pcard - 2; i__ >= i__1; i__ += -2) { - if (ptrs[i__ + 6] == ptrs[i__ + 5] + 1) { - remlai_(&c__2, &i__, &ptrs[6], &pcard); - } - } - ncom = pcard / 2 - nline; - lbupd_1__(&nline, &ncom, ptrs); - chkout_("LBREM_1", (ftnlen)7); - return 0; -} /* lbrem_1__ */ - -#undef ptr -#undef end -#undef begin - - diff --git a/ext/spice/src/csupport/lbupd_1.c b/ext/spice/src/csupport/lbupd_1.c deleted file mode 100644 index 7ffe0eab70..0000000000 --- a/ext/spice/src/csupport/lbupd_1.c +++ /dev/null @@ -1,156 +0,0 @@ -/* lbupd_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LBUPD ( Line buffer, update ) */ -/* Subroutine */ int lbupd_1__(integer *nline, integer *ncom, integer *ptrs) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Update internal information in a line buffer. */ - -/* $ 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 */ - -/* CB, LB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NLINE I Number of lines stored in the buffer. */ -/* NCOM I Number of complement intervals in the buffer. */ -/* PTRS I,O Pointer compnent of the buffer. */ - -/* $ Detailed_Input */ - -/* NLINE is the number of lines stored in the buffer, as */ -/* the result of some change. */ - -/* NCOM is the number of complement intervals in the buffer, */ -/* as the result of the same change. */ - -/* PTRS is the pointer component of a line buffer. */ - -/* $ Detailed_Output */ - -/* PTRS is the updated pointer component of a line buffer. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) The error 'SPICE(LBCORRUPTED)' is signalled whenever any */ -/* of the following conditions is detected. */ - -/* -- NLINE is less than zero. */ - -/* -- NCOM is less than one. */ - -/* -- The sum of NLINE and NCOM is greater than the maximum */ -/* number of lines that can be stored in the buffer. */ - -/* $ Particulars */ - -/* LBUPD is are provided for use by the LB routines in SPICELIB, and */ -/* should not be called directly except by those routines. */ - -/* $ Examples */ - -/* LBUPD is used by LBINS and LBREM. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("LBUPD_1", (ftnlen)7); - if (*nline < 0 || *ncom < 1 || *nline + *ncom << 1 > sizei_(ptrs)) { - setmsg_("Tried to store # lines, # holes.", (ftnlen)32); - errint_("#", nline, (ftnlen)1); - errint_("#", ncom, (ftnlen)1); - sigerr_("SPICE(LBCORRUPTED)", (ftnlen)18); - chkout_("LBUPD_1", (ftnlen)7); - return 0; - } - } - -/* Save the current number of lines in element -2. We can infer the */ -/* cardinality of the cell from the total number of intervals. */ - - ptrs[3] = *nline; - i__1 = *nline + *ncom << 1; - scardi_(&i__1, ptrs); - chkout_("LBUPD_1", (ftnlen)7); - return 0; -} /* lbupd_1__ */ - diff --git a/ext/spice/src/csupport/logchk.c b/ext/spice/src/csupport/logchk.c deleted file mode 100644 index 98fd05e5f2..0000000000 --- a/ext/spice/src/csupport/logchk.c +++ /dev/null @@ -1,160 +0,0 @@ -/* logchk.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure LOGCHK ( Log file check ) */ -/* Subroutine */ int logchk_(char *defalt, char *usenam, logical *dolog, - ftnlen defalt_len, ftnlen usenam_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char line[900]; - integer b, e, start; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int getcml_(char *, ftnlen), fndnwd_(char *, - integer *, integer *, integer *, ftnlen); - -/* $ Abstract */ - -/* Determine whether to use a log file, and if so what name */ -/* pattern to use. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DEFALT I Default logfile name pattern */ -/* USENAM O Acutal logfile name pattern that will be used. */ -/* DOLOG O Flag indicating whether or not to use a log file. */ - -/* $ Detailed_Input */ - -/* DEFALT is a default pattern to use if nothing is specified */ -/* on the command line. */ - -/* $ Detailed_Output */ - -/* USENAM is the name to use for the log file or blank */ -/* if the -nolog flag is supplied on the command line. */ - -/* DOLOG is a logical flag that indicates whether or not */ -/* to create a log file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a utility routine for use by the "Command Loop" routines */ -/* so that one can specify a custom name for a log file (or */ -/* specify that no log file be used at all. */ - -/* The options examined from the command line are: */ - -/* -nolog */ -/* -log */ - -/* This routine does not judge the "fitness" of the name of */ -/* the logfile, if one is specified on the command line. Checking */ -/* for suitability is left to other portions of the system. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 28-DEC-2001 (WLT) */ - - -/* -& */ - -/* Spicelib Functions. */ - - -/* Until we know otherwise, we set the logname to the default */ -/* value and set action to "use a log file". */ - - s_copy(usenam, defalt, usenam_len, defalt_len); - *dolog = TRUE_; - start = 1; - getcml_(line, (ftnlen)900); - fndnwd_(line, &start, &b, &e, (ftnlen)900); - while(b > 0) { - start = e + 1; - if (eqstr_(line + (b - 1), "-nolog", e - (b - 1), (ftnlen)6)) { - s_copy(usenam, " ", usenam_len, (ftnlen)1); - *dolog = FALSE_; - return 0; - } else if (eqstr_(line + (b - 1), "-log", e - (b - 1), (ftnlen)4)) { - fndnwd_(line, &start, &b, &e, (ftnlen)900); - if (e > b) { - s_copy(usenam, line + (b - 1), usenam_len, e - (b - 1)); - } - return 0; - } - fndnwd_(line, &start, &b, &e, (ftnlen)900); - } - return 0; -} /* logchk_ */ - diff --git a/ext/spice/src/csupport/m2alph.c b/ext/spice/src/csupport/m2alph.c deleted file mode 100644 index ef7c70fbc6..0000000000 --- a/ext/spice/src/csupport/m2alph.c +++ /dev/null @@ -1,159 +0,0 @@ -/* m2alph.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $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_ */ - diff --git a/ext/spice/src/csupport/m2begr.c b/ext/spice/src/csupport/m2begr.c deleted file mode 100644 index 050d501fcb..0000000000 --- a/ext/spice/src/csupport/m2begr.c +++ /dev/null @@ -1,336 +0,0 @@ -/* m2begr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2BEGR ( See if a word begins with a range template ) */ -/* Subroutine */ int m2begr_(char *string, integer *beg, integer *end, - integer *a, integer *b, ftnlen string_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__; - static logical digit[256]; - static integer colon; - static char error[80]; - static integer start, lparen, rparen; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - extern integer intmax_(void); - static integer pointr; - -/* $ Abstract */ - -/* Determine whether or not the substring STRING(BEG:END) begins */ -/* with a substring of the form (A:B) where A and B are integers. */ -/* If it does, et BEG is set to the index of the first character */ -/* following this substring and the integer values of A and B are */ -/* returned. Otherwise no action is taken. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A META/2 language statement specification. */ -/* BEG I/0 The beginning of the substring on input and output */ -/* END I/0 The end of the substring on input and output */ -/* A O Lower value of the range template */ -/* B O Upper value of the range template */ - -/* $ Detailed_Input */ - -/* STRING(BEG:END) is a word in the META/2 language. It potentially */ -/* begins with a substring of the form (A:B) where */ -/* A and B are both chracter strings representing */ -/* integers. */ - - -/* $ Detailed_Output */ - -/* BEG On ouput BEG points to the beginning of the portion of */ -/* the input word that follows the range template (if */ -/* one was present) Otherwise it remains unchanged. */ - -/* END points to the end of the input META/2 word. */ - -/* A is the value represented by the first numeric string */ -/* of the range template. If a range template is not */ -/* present, A is not assigned a value. */ - -/* B is the value represented by the second numeric string */ -/* of the range template (if there is a second numeric */ -/* string) If a range template is present, but no numeric */ -/* string is present B is assigned the value INTMAX(). */ - - -/* $ Error_Handling */ - -/* None. A range template is present or it isn't. */ - - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* The range template is part of the META/2 language and is */ -/* described in the required reading section. Briefly it is */ -/* a string at the beginning of a word that has the form */ - -/* (A:B) */ - -/* where A is a string representing a positive integer, and */ -/* B the null string or a string representing a positive integer */ -/* greater than A. */ - -/* This routine determines if a range template is present and if so */ -/* what the values of A and B are. If B is the null string it */ -/* is assumed to represent the largest positive integer. */ - -/* $ Examples */ - -/* Consider the following */ - -/* inputs outputs */ - -/* STRING(BEG:END) BEG END BEG END A B */ -/* --------------- --- --- --- --- --- --- --- */ -/* (1:2)@number 5 16 10 16 1 2 */ -/* 1:2@number 7 16 7 16 x x */ -/* (-1:23)@word 3 14 3 14 x x */ -/* @frank 6 11 6 11 x x */ -/* (4:)@spam(1:2) 54 67 58 67 4 INTMAX() */ -/* @spud(1:12) 10 20 10 20 x x */ - -/* $ 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, 23-MAR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - if (first) { - first = FALSE_; - for (i__ = 0; i__ <= 255; ++i__) { - digit[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", - i__1, "m2begr_", (ftnlen)202)] = FALSE_; - } - digit[(i__1 = '0') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)205)] = TRUE_; - digit[(i__1 = '1') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)206)] = TRUE_; - digit[(i__1 = '2') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)207)] = TRUE_; - digit[(i__1 = '3') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)208)] = TRUE_; - digit[(i__1 = '4') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)209)] = TRUE_; - digit[(i__1 = '5') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)210)] = TRUE_; - digit[(i__1 = '6') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)211)] = TRUE_; - digit[(i__1 = '7') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)212)] = TRUE_; - digit[(i__1 = '8') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)213)] = TRUE_; - digit[(i__1 = '9') < 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, - "m2begr_", (ftnlen)214)] = TRUE_; - lparen = '('; - rparen = ')'; - colon = ':'; - } - -/* We need at least (x:) in order to have a range template, that */ -/* means at least 4 characters. */ - - if (*end - *beg < 3) { - return 0; - } - i__ = *beg; - -/* Range templates must begin with '(' */ - - if (*(unsigned char *)&string[i__ - 1] != lparen) { - return 0; - } - ++i__; - -/* We must have at least 1 digit */ - - if (! digit[(i__1 = *(unsigned char *)&string[i__ - 1]) < 256 && 0 <= - i__1 ? i__1 : s_rnge("digit", i__1, "m2begr_", (ftnlen)247)]) { - return 0; - } else { - ++i__; - } - -/* Now examin characters until we reach a non-digit */ -/* or run out of characters in the string. */ - - while(i__ <= *end && digit[(i__1 = *(unsigned char *)&string[i__ - 1]) < - 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, "m2begr_", ( - ftnlen)262)]) { - ++i__; - } - -/* If the last character encountered was a number or if it was */ -/* not a colon, we don't have a range template. */ - - if (digit[(i__1 = *(unsigned char *)&string[i__ - 1]) < 256 && 0 <= i__1 ? - i__1 : s_rnge("digit", i__1, "m2begr_", (ftnlen)273)]) { - return 0; - } else if (*(unsigned char *)&string[i__ - 1] != colon) { - return 0; - } - -/* Ok. we've got an integer. Parse it and put the result */ -/* into A. */ - - i__1 = *beg; - nparsi_(string + i__1, a, error, &pointr, i__ - 1 - i__1, (ftnlen)80); - -/* Just in case, make sure the number didn't cause an NPARSI error */ -/* (the only thing can go wrong is the number is too big) */ - - if (pointr != 0) { - return 0; - } - -/* Look at the next letter ( if there is one ) and see if it */ -/* is a digit. */ - - ++i__; - start = i__; - if (i__ > *end) { - return 0; - } - -/* Examine letters until we reach a non-digit or run out of */ -/* characters to examine. */ - - while(i__ < *end && digit[(i__1 = *(unsigned char *)&string[i__ - 1]) < - 256 && 0 <= i__1 ? i__1 : s_rnge("digit", i__1, "m2begr_", ( - ftnlen)314)]) { - ++i__; - } - -/* If the last character is a digit (we ran out of letters) */ -/* or was not */ - - if (digit[(i__1 = *(unsigned char *)&string[i__ - 1]) < 256 && 0 <= i__1 ? - i__1 : s_rnge("digit", i__1, "m2begr_", (ftnlen)322)]) { - return 0; - } else if (*(unsigned char *)&string[i__ - 1] != rparen) { - return 0; - } - -/* If the last character read is beyond the first character */ -/* after the ':', then we've got an integer. */ - - if (i__ > start) { - nparsi_(string + (start - 1), b, error, &pointr, i__ - 1 - (start - 1) - , (ftnlen)80); - -/* Make sure everythin parsed ok. */ - - if (pointr != 0) { - return 0; - } else if (*b < *a) { - return 0; - } else { - *beg = i__ + 1; - return 0; - } - -/* If the first character after the colon was the right parenthesis */ -/* put INTMAX into B */ - - } else { - *b = intmax_(); - *beg = i__ + 1; - return 0; - } - return 0; -} /* m2begr_ */ - diff --git a/ext/spice/src/csupport/m2bodini.c b/ext/spice/src/csupport/m2bodini.c deleted file mode 100644 index 1a1f4adc11..0000000000 --- a/ext/spice/src/csupport/m2bodini.c +++ /dev/null @@ -1,198 +0,0 @@ -/* m2bodini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2BODINI () */ -/* Subroutine */ int m2bodini_(char *names, integer *nnam, integer *codes, - integer *ncod, integer *ordnam, integer *ordcod, ftnlen names_len) -{ - integer i__, n; - extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen), - orderi_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Initialize the two order vectors. This routine should be called */ -/* by M2BODTRN only. */ - -/* This routine can not graduate as it is without modifying the */ -/* specification of BSCHOI and BSCHOC. (WLT) */ - -/* $ 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 */ - - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAMES I/O Array of recognized names */ -/* CODES I/O Id-codes to associated with NAMES */ -/* NNAM I/O Number of names */ -/* NCOD I/O Number if id-codes */ -/* ORDNAM O An order vector for NAMES */ -/* ORDCOD O An ordered vector for CODES */ - -/* $ Detailed_Input */ - -/* NAMES is an array of names for whick there is an */ -/* id-code. */ - -/* CODES is an array of id-codes for the items in NAMES. The */ -/* correspondence is: CODES(I) is the id-code of the body */ -/* named in NAMES(I) */ - -/* NNAM Number of names */ - -/* $ Detailed_Output */ - -/* NCOD is the number pointers in the ordered pointer array */ -/* ORDCOD */ - -/* ORDNAM is an order vector of integers for NAMES. The set of */ -/* values NAMES(ORDNAM(1)), NAMES(ORDNAM(2), ... forms */ -/* an increasing list of names. */ - -/* ORDCOD is an ordering array of integers (as opposed to an */ -/* order vector). The list CODES(ORDNAM(1)), */ -/* CODES(ORDNAM(2)), ... CODES(ORDNAM(NCOD)) forms an */ -/* increasing non-repeating list of integers. Moreover, */ -/* every value in CODES is listed exactly once in this */ -/* sequence. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utitility routine used for initializing the ordering */ -/* vectors that point to the recognized names and codes usde by */ -/* the private routine M2BODTRN */ - -/* $ Examples */ - -/* See the routine M2BODTRN. */ - -/* $ Restrictions */ - -/* This routine is intended only for use by M2BODTRN. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) (WLT) */ - -/* Renamed to M2BODINI and filled out the comments on what this */ -/* routine does and how it works. */ - -/* -& */ -/* $ Index_Entries */ - - -/* -& */ - -/* Local variables */ - - -/* Create order vectors ORDNAM and ORDCOD */ - - orderc_(names, nnam, ordnam, names_len); - orderi_(codes, nnam, ordcod); - -/* Remove duplicate entries in the code order table. The entry that */ -/* points to the highest entry in CODES should remain. */ - - n = 1; - i__ = 2; - -/* Now for some very funky manuevering. We are going to take our */ -/* order vector for the id-codes and modify it! */ - -/* Here's what is true now. */ - -/* CODES(ORDCOD(1)) <= CODES(ORDCOD(2)) <=...<= CODES(ORDCOD(NNAM) */ - -/* For each element such that CODES(ORDCOD(I)) = CODES(ORDCOD(I+1)) */ -/* we are going to "shift" the items ORDCOD(I+1), ORDCOD(I+2), ... */ -/* left by one. We will then repeat the test and shift as needed. */ -/* When we get done we will have a possibly shorter array ORDCOD */ -/* and the array will satisfy */ - -/* CODES(ORDCOD(1)) < CODES(ORDCOD(2)) < ... < CODES(ORDCOD(NNAM) */ - -/* We can still use the resulting "ordered vector" (as opposed to */ -/* order vector) in the BSCHOI routine because it only relies */ -/* upon the indexes to ORDCOD and not to CODES itself. This is */ -/* making very heavy use of the implementation of BSCHOI but we */ -/* are going to let it go for the momemt because this is a private */ -/* routine. */ - - while(i__ <= *nnam) { - if (codes[ordcod[i__ - 1] - 1] == codes[ordcod[n - 1] - 1]) { - if (ordcod[i__ - 1] > ordcod[n - 1]) { - ordcod[n - 1] = ordcod[i__ - 1]; - } - } else { - ++n; - ordcod[n - 1] = ordcod[i__ - 1]; - } - ++i__; - } - *ncod = n; - return 0; -} /* m2bodini_ */ - diff --git a/ext/spice/src/csupport/m2bodtrn.c b/ext/spice/src/csupport/m2bodtrn.c deleted file mode 100644 index f1dc15e745..0000000000 --- a/ext/spice/src/csupport/m2bodtrn.c +++ /dev/null @@ -1,1486 +0,0 @@ -/* m2bodtrn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2BODTRN ( Body name and code translation ) */ -/* Subroutine */ int m2bodtrn_0_(int n__, char *name__, integer *code, - logical *found, ftnlen name_len) -{ - /* Initialized data */ - - static integer codes[415] = { 199,299,399,499,599,699,799,899,999,301,401, - 402,501,502,503,504,505,506,507,508,509,510,511,512,513,514,514, - 515,515,516,516,601,602,603,604,605,606,607,608,609,610,610,611, - 611,612,612,613,613,614,614,615,615,616,616,617,617,701,702,703, - 704,705,706,706,707,707,708,708,709,709,710,710,711,711,712,712, - 713,713,714,714,715,715,801,802,803,804,805,806,807,808,901,901, - -12,-12,-12,-18,-18,-27,-27,-30,-30,-31,-31,-32,-32,-46,-46,-47, - -47,-58,-66,-67,-77,-77,-78,-94,-94,-112,0,0,1,2,3,3,3,3,4,5,6,7, - 8,9,10,9511010,2431010,1000001,1000002,1000003,1000004,1000005, - 1000006,1000007,1000008,1000009,1000010,1000011,1000012,1000013, - 1000014,1000015,1000016,1000017,1000018,1000019,1000020,1000021, - 1000022,1000023,1000024,1000025,1000026,1000027,1000028,1000029, - 1000030,1000031,1000032,1000033,1000034,1000035,1000036,1000037, - 1000038,1000039,1000040,1000041,1000042,1000043,1000044,1000045, - 1000046,1000047,1000048,1000049,1000050,1000051,1000052,1000053, - 1000054,1000055,1000056,1000057,1000058,1000059,1000060,1000061, - 1000062,1000063,1000064,1000065,1000066,1000067,1000068,1000069, - 1000070,1000071,1000072,1000073,1000074,1000075,1000076,1000077, - 1000078,1000079,1000080,1000081,1000082,1000083,1000084,1000085, - 1000086,1000087,1000088,1000089,1000090,1000091,1000092,1000093, - 1000094,1000095,1000096,1000097,1000098,1000099,1000100,1000101, - 1000102,1000103,1000104,1000105,1000106,1000107,1000108,1000109, - 1000110,1000111,1000112,1000113,1000114,1000115,1000116,1000117, - 1000118,1000119,1000120,1000121,1000122,1000123,1000124,1000125, - 1000126,1000127,1000128,1000129,1000130,50000001,50000002, - 50000003,50000004,50000005,50000006,50000007,50000008,50000009, - 50000010,50000011,50000012,50000013,50000014,50000015,50000016, - 50000017,50000018,50000019,50000020,50000021,50000022,50000023, - -40,-344,-344,2000433,2000253,618,-59,-53,-53,-93,-93,-82,-82, - -150,-55,399001,399002,399003,399004,1000131,1000132,-550,-550, - -550,-550,-90,-95,-81 }; - static char names[32*415] = "MERCURY " "VENUS " - " " "EARTH " - "MARS " "JUPITER " - " " "SATURN " "URANUS " - " " "NEPTUNE " "PLUTO " - " " "MOON " "PHOBOS " - " " "DEIMOS " "IO " - " " "EUROPA " - "GANYMEDE " "CALLISTO " - " " "AMALTHEA " "HIMALIA " - " " "ELARA " "PASIPHAE " - " " "SINOPE " "LYSITHEA " - " " "CARME " "ANAN" - "KE " "LEDA " - "1979J2 " "THEBE " - " " "1979J1 " "ADRASTEA " - " " "1979J3 " "METIS " - " " "MIMAS " "ENCELADUS " - " " "TETHYS " "DION" - "E " "RHEA " - "TITAN " "HYPERION " - " " "IAPETUS " "PHOEBE " - " " "1980S1 " "JANUS " - " " "1980S3 " "EPIMETHEUS" - " " "1980S6 " "HELE" - "NE " "1980S13 " - "TELESTO " "1980S25 " - " " "CALYPSO " "1980S28 " - " " "ATLAS " "1980S27 " - " " "PROMETHEUS " "1980S26 " - " " "PANDORA " "ARIE" - "L " "UMBRIEL " - "TITANIA " "OBERON " - " " "MIRANDA " "1986U7 " - " " "CORDELIA " "1986U8 " - " " "OPHELIA " "1986U9 " - " " "BIANCA " "1986" - "U4 " "CRESSIDA " - "1986U6 " "DESDEMONA " - " " "1986U3 " "JULIET " - " " "1986U1 " "PORTIA " - " " "1986U2 " "ROSALIND " - " " "1986U5 " "BELI" - "NDA " "1985U1 " - "PUCK " "TRITON " - " " "NEREID " "NAIAD " - " " "THALASSA " "DESPINA " - " " "GALATEA " "LARISSA " - " " "PROTEUS " "1978" - "P1 " "CHARON " - "VENUS ORBITER " "P12 " - " " "PIONEER 12 " "MGN " - " " "MAGELLAN " "VK1 " - " " "VIKING 1 ORBITER " "VK2 " - " " "VIKING 2 ORBITER " "VG1 " - " " "VOYAGER 1 " - "VG2 " "VOYAGER 2 " - " " "MS-T5 " "SAKIGAKE " - " " "PLANET-A " "SUISEI " - " " "VSOP " "VEGA 1 " - " " "VEGA 2 " "GLL " - " " "GALILEO ORBITER " - "GIOTTO " "MGS " - " " "MARS GLOBAL SURVEYOR " "ICE " - " " "SSB " "SOLAR SYSTEM BAR" - "YCENTER " "MERCURY BARYCENTER " "VENUS BARY" - "CENTER " "EMB " "EART" - "H MOON BARYCENTER " "EARTH-MOON BARYCENTER " - "EARTH BARYCENTER " "MARS BARYCENTER " - " " "JUPITER BARYCENTER " "SATURN BARYCENTER " - " " "URANUS BARYCENTER " "NEPTUNE BARYCENT" - "ER " "PLUTO BARYCENTER " "SUN " - " " "GASPRA " "IDA " - " " "AREND " - "AREND-RIGAUX " "ASHBROOK-JACKSON " - " " "BOETHIN " "BORRELLY " - " " "BOWELL-SKIFF " "BRADFIELD " - " " "BROOKS 2 " "BRORSEN-ME" - "TCALF " "BUS " "CHER" - "NYKH " "CHURYUMOV-GERASIMENKO " - "CIFFREO " "CLARK " - " " "COMAS SOLA " "CROMMELIN " - " " "D'ARREST " "DANIEL " - " " "DE VICO-SWIFT " "DENNING-FU" - "JIKAWA " "DU TOIT 1 " "DU T" - "OIT-HARTLEY " "DUTOIT-NEUJMIN-DELPORTE " - "DUBIAGO " "ENCKE " - " " "FAYE " "FINLAY " - " " "FORBES " "GEHRELS 1 " - " " "GEHRELS 2 " "GEHRELS 3 " - " " "GIACOBINI-ZINNER " "GICL" - "AS " "GRIGG-SKJELLERUP " - "GUNN " "HALLEY " - " " "HANEDA-CAMPOS " "HARRINGTON " - " " "HARRINGTON-ABELL " "HARTLEY 1 " - " " "HARTLEY 2 " "HARTLEY-IR" - "AS " "HERSCHEL-RIGOLLET " "HOLM" - "ES " "HONDA-MRKOS-PAJDUSAKOVA " - "HOWELL " "IRAS " - " " "JACKSON-NEUJMIN " "JOHNSON " - " " "KEARNS-KWEE " "KLEMOLA " - " " "KOHOUTEK " "KOJIMA " - " " "KOPFF " "KOWA" - "L 1 " "KOWAL 2 " - "KOWAL-MRKOS " "KOWAL-VAVROVA " - " " "LONGMORE " "LOVAS 1 " - " " "MACHHOLZ " "MAURY " - " " "NEUJMIN 1 " "NEUJMIN 2 " - " " "NEUJMIN 3 " "OLBE" - "RS " "PETERS-HARTLEY " - "PONS-BROOKS " "PONS-WINNECKE " - " " "REINMUTH 1 " "REINMUTH 2 " - " " "RUSSELL 1 " "RUSSELL 2 " - " " "RUSSELL 3 " "RUSSELL 4 " - " " "SANGUIN " "SCHA" - "UMASSE " "SCHUSTER " - "SCHWASSMANN-WACHMANN 1 " "SCHWASSMANN-WACHMANN 2 " - " " "SCHWASSMANN-WACHMANN 3 " "SHAJN-SCHALDACH " - " " "SHOEMAKER 1 " "SHOEMAKER 2 " - " " "SHOEMAKER 3 " "SINGER-BRE" - "WSTER " "SLAUGHTER-BURNHAM " "SMIR" - "NOVA-CHERNYKH " "STEPHAN-OTERMA " - "SWIFT-GEHRELS " "TAKAMIZAWA " - " " "TAYLOR " "TEMPEL 1 " - " " "TEMPEL 2 " "TEMPEL-TUTTLE " - " " "TRITTON " "TSUCHINSHA" - "N 1 " "TSUCHINSHAN 2 " "TUTT" - "LE " "TUTTLE-GIACOBINI-KRESAK " - "VAISALA 1 " "VAN BIESBROECK " - " " "VAN HOUTEN " "WEST-KOHOUTEK-IKEMURA " - " " "WHIPPLE " "WILD 1 " - " " "WILD 2 " "WILD 3 " - " " "WIRTANEN " "WOLF" - " " "WOLF-HARRINGTON " - "LOVAS 2 " "URATA-NIIJIMA " - " " "WISEMAN-SKIFF " "HELIN " - " " "MUELLER " "SHOEMAKER-HOLT 1" - " " "HELIN-ROMAN-CROCKETT " "HARTLEY 3 " - " " "PARKER-HARTLEY " "HELI" - "N-ROMAN-ALU 1 " "WILD 4 " - "MUELLER 2 " "MUELLER 3 " - " " "SHOEMAKER-LEVY 1 " "SHOEMAKER-LEVY 2 " - " " "HOLT-OLMSTEAD " "METCALF-BREWINGT" - "ON " "LEVY " "SHOEMAKER-" - "LEVY 9 " "SHOEMAKER-LEVY 9-W " "SHOE" - "MAKER-LEVY 9-V " "SHOEMAKER-LEVY 9-U " - "SHOEMAKER-LEVY 9-T " "SHOEMAKER-LEVY 9-S " - " " "SHOEMAKER-LEVY 9-R " "SHOEMAKER-LEVY 9-Q " - " " "SHOEMAKER-LEVY 9-P " "SHOEMAKER-LEVY 9" - "-N " "SHOEMAKER-LEVY 9-M " "SHOEMAKER-" - "LEVY 9-L " "SHOEMAKER-LEVY 9-K " "SHOE" - "MAKER-LEVY 9-J " "SHOEMAKER-LEVY 9-H " - "SHOEMAKER-LEVY 9-G " "SHOEMAKER-LEVY 9-F " - " " "SHOEMAKER-LEVY 9-E " "SHOEMAKER-LEVY 9-D " - " " "SHOEMAKER-LEVY 9-C " "SHOEMAKER-LEVY 9" - "-B " "SHOEMAKER-LEVY 9-A " "SHOEMAKER-" - "LEVY 9-Q1 " "SHOEMAKER-LEVY 9-P2 " "CLEM" - "ENTINE " "GLL PROBE " - "GALILEO PROBE " "EROS " - " " "MATHILDE " "PAN " - " " "RADIOASTRON " "MARS PATHFINDER " - " " "MPF " "NEAR " - " " "NEAR EARTH ASTEROID RENDEZVOUS " "CASS" - "INI " "CAS " - "CASSINI HUYGENS PROBE " "ULYSSES " - " " "GOLDSTONE " "CANBERRA " - " " "MADRID " "USUDA " - " " "HYAKUTAKE " "HALE-BOPP " - " " "MARS-96 " "M96 " - " " "MARS 96 " - "MARS96 " "CASSINI SIMULATION " - " " "MGS SIMULATION " "CASSINI ITL " - " "; - static logical init = TRUE_; - static integer nnam = 315; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer ncod, i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - bodn2c_(char *, integer *, logical *, ftnlen); - extern integer bschoc_(char *, integer *, char *, integer *, ftnlen, - ftnlen), bschoi_(integer *, integer *, integer *, integer *); - static integer ordcod[415], ordnam[415]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static char tmpnam[32]; - extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int m2bodini_(char *, integer *, integer *, - integer *, integer *, integer *, ftnlen); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* This is the umbrella routine that contains entry points for */ -/* translating between body names and NAIF integer codes and */ -/* for defining new name/code pairs. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I M2BODN2C and M2BODDEF */ -/* O M2BODC2N */ -/* CODE I M2BODC2N and M2BODDEF */ -/* O M2BODN2C */ -/* FOUND O M2BODN2C and M2BODC2N */ -/* MAXL P (All) */ -/* MAXP P M2BODDEF */ - -/* $ Detailed_Input */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the entry points for a discussion of their arguments. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a name. MAXL should only */ -/* be increased if names longer than the current value */ -/* need to be supported. If MAXL is decreased the */ -/* default names may be truncated. */ - -/* MAXP is the maximum number of name/code pairs that can */ -/* be defined via M2BODDEF. It is the limit */ -/* on the number of definitions over and above the */ -/* number of default definitions. The user may alter */ -/* the the value of MAXP, however, it must remain a */ -/* positive integer. */ - -/* $ Exceptions */ - -/* 1) If M2BODTRN is called directly, the error SPICE(BOGUSENTRY) is */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* M2BODTRN should never be called directly, but should instead be */ -/* accessed through its entry points: */ - -/* M2BODN2C Body name to code */ - -/* M2BODC2N Body code to name */ - -/* M2BODDEF Body name/code definition */ - -/* M2BODN2C and M2BODC2N perform translations between body names */ -/* and their corresponding integer codes which are used */ -/* in SPK and PCK files and routines. A set of name/code */ -/* pairs are automatically defined during the first call to */ -/* one of these entry points. Additional name/code pairs may */ -/* be defined via M2BODDEF for two purposes: */ - -/* 1. to associate another, perhaps more familiar or */ -/* abbreviated, name with a particular body integer */ -/* code that has already been defined, or */ - -/* 2. to define a new body integer code and name, */ - -/* Each body has a unique integer code, but may have several */ -/* names. Thus you may associate more than one name with */ -/* a particular integer code. However, associating more */ -/* than one integer code with a particular name creates ambiguity. */ -/* Therefore, once a name has been defined, it may not be redefined */ -/* with a different integer code. */ - -/* For example, Europa is the name of the second satellite of */ -/* Jupiter, and has the NAIF integer code 502. Thus (EUROPA, 502) */ -/* is one of the default definitions. Europa is also the name */ -/* of an asteroid. Suppose you were able to associate the asteroid */ -/* integer code with the name EUROPA. Then when you call M2BODN2C to */ -/* translate the name EUROPA, which code should be returned? That */ -/* of the asteroid or 502? */ - -/* M2BODDEF prevents this ambiguity by signalling an error if the */ -/* specified name has already been defined with a different code. */ -/* In the case of EUROPA, you may want to use the name ASTEROID */ -/* EUROPA. The set of default definitions are listed in DATA */ -/* statements in the umbrella routine M2BODTRN for easy reference. */ - -/* $ Examples */ - -/* 1. In the following code fragment, SPKEZ computes the state */ -/* (position and velocity) of Jupiter as seen from the Galileo */ -/* Orbiter. It requires the NAIF integer codes of the target and */ -/* observer, so we use M2BODN2C to convert names to integer codes */ -/* for those bodies. */ - -/* CALL M2BODN2C( 'JUPITER', TARGET, FOUND ) */ - -/* CALL M2BODN2C( 'GALILEO ORBITER', OBSRVR, FOUND ) */ - -/* CALL SPKEZ ( TARGET, EPOCH, FRAME, ABCORR, OBSRVR, STATE, LT) */ - - -/* 2. In this example, we assume that M2BODDEF has not been called. */ -/* Thus, only the set of default name/code pairs has been */ -/* defined. */ - -/* Given these names, M2BODN2C will return the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - - -/* and, given these codes, M2BODC2N will return the following names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ -/* -1 - No */ - - -/* 3. This example shows how to define a name/code pair. */ -/* You may associate a new name with a particular code that */ -/* has already been defined: */ - -/* CALL M2BODDEF ( 'JB', 5 ) */ - -/* You may also define the name and integer code for a new body: */ - -/* CALL M2BODDEF ( 'Asteroid Frank', 20103456 ) */ - -/* After these calls to M2BODDEF, M2BODN2C would return the following */ -/* translations: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'JB' 5 Yes */ -/* 'Jupiter Barycenter' 5 Yes */ -/* 'ASTEROID FRANK' 20103456 Yes */ -/* 'ASTEROIDFRANK' - No */ -/* 'Frank' - No */ - -/* and M2BODC2N will return these translations: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 5 'JB' Yes */ -/* 20103456 'Asteroid Frank' Yes */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ -/* K.S. Zukor (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 22-MAY-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp, */ -/* Mars 96, Cassini Simulation, MGS Simulation. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed umbrella subroutine and entry points to */ -/* correspond private routine convention (M2...). Added IDs for */ -/* tracking stations Goldstone (399001), Canberra (399002), */ -/* Madrid (399003), Usuda (399004). */ - -/* - Beta Version 2.2.0, 01-AUG-1995 (HAN) */ - -/* Added the IDs for Near Earth Asteroid Rendezvous (-93), */ -/* Mars Pathfinder (-53), Ulysses (-55), VSOP (-58), */ -/* Radioastron (-59), Cassini spacecraft (-82), and Cassini */ -/* Huygens probe (-150). */ -/* Mars Observer (-94) was replaced with Mars Global */ -/* Surveyor (-94). */ - -/* - Beta Version 2.1.0, 15-MAR-1995 (KSZ) (HAN) */ - -/* Two Shoemaker Levy 9 fragments were added, Q1 and P2 */ -/* (IDs 50000022 and 50000023). Two asteroids were added, */ -/* Eros and Mathilde (IDs 2000433 and 2000253). The */ -/* Saturnian satellite Pan (ID 618) was added. */ - -/* - Beta Version 2.0.0, 03-FEB-1995 (NJB) */ - -/* The Galileo probe (ID -344) has been added to the permanent */ -/* collection. */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. Also, */ -/* this version does not support reading body name ID pairs from a */ -/* file. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Some items that were previously considered errors were removed */ -/* and some minor modifications were made to improve the */ -/* robustness of the routines. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Functions */ - - -/* The parameters here are for ease in maintaining the */ -/* large collection of automatic names that are stored */ -/* in data statements. To insert a name/code pair in the */ -/* block from BEGx to ENDx, redefine ENDx to be */ -/* one larger than its current definition. Recompiling */ -/* will automatically modify all the other parameters. */ - - -/* Local variables */ - - -/* Introducing the permanent collection. */ - - switch(n__) { - case 1: goto L_m2bodn2c; - case 2: goto L_m2bodc2n; - case 3: goto L_m2boddef; - } - - -/* The 851, 852, ... codes are temporary codes for the newly- */ -/* discovered satellites of Neptune. These will go away when */ -/* the official codes are assigned. The codes listed above */ -/* do not include these temporary assignments. */ - -/* The proposed names are the following: */ - -/* 1989N1 = Proteus */ -/* 1989N2 = Larissa */ -/* 1989N3 = Despina */ -/* 1989N4 = Galatea */ -/* 1989N5 = Thalassa */ -/* 1989N6 = Naiad */ - - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("M2BODTRN", (ftnlen)8); - } - -/* This routine should never be called. If it is called, */ -/* an error is signalled. */ - - setmsg_("M2BODTRN: You have called an entry which performs no run-time f" - "unction. This may indicate a bug. Please check the documentation" - " for the subroutine M2BODTRN.", (ftnlen)156); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("M2BODTRN", (ftnlen)8); - return 0; -/* $Procedure M2BODN2C ( Body name to code ) */ - -L_m2bodn2c: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Translate the name of a body into the integer code for */ -/* that body. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER CODE */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Body name to be translated. */ -/* CODE O Integer code for that body. */ -/* FOUND O True if translated, otherwise false. */ -/* MAXL P Max name length. */ - -/* $ Detailed_Input */ - -/* NAME is an arbitrary name of a body which could be */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* Case and leading and trailing blanks in a name */ -/* are not significant. However when a name is made */ -/* up of more than one word, they must be separated by */ -/* at least one blank. That is, all of the following */ -/* strings are equivalent names: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is not equivalent to */ -/* the names above. */ - -/* When ignoring trailing blanks, NAME must have fewer */ -/* than MAXL characters. */ - -/* $ Detailed_Output */ - -/* CODE is the NAIF or user-defined integer code for the */ -/* named body. CODE will have at most MAXL digits */ -/* including a minus sign if CODE is negative. */ - -/* FOUND is true if NAME has a translation. Otherwise, FOUND */ -/* is false. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a name. MAXL should only */ -/* be increased if names longer than the current value */ -/* need to be supported. If MAXL is decreased the */ -/* default names may be truncated. */ - -/* $ Exceptions */ - -/* NONE */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* M2BODN2C is one of three related entry points, */ - -/* M2BODN2C Body name to code */ - -/* M2BODC2N Body code to name */ - -/* M2BODDEF Body name/code definition */ - -/* M2BODN2C and M2BODC2N perform translations between body names */ -/* and their corresponding integer codes which are used */ -/* in SPK and PCK files and routines. A set of name/code */ -/* pairs are automatically defined during the first call to */ -/* one of these entry points. Additional name/code pairs may */ -/* be defined via M2BODDEF. */ - -/* $ Examples */ - -/* 1. In the following code fragment, SPKEZ computes the state */ -/* (position and velocity) of Jupiter as seen from the Galileo */ -/* Orbiter. It requires the NAIF integer codes of the target and */ -/* observer, so we use M2BODN2C to convert names to integer codes */ -/* for those bodies. */ - -/* CALL M2BODN2C( 'JUPITER', TARGET, FOUND ) */ - -/* CALL M2BODN2C( 'GALILEO ORBITER', OBSRVR, FOUND ) */ - -/* CALL SPKEZ ( TARGET, EPOCH, FRAME, ABCORR, OBSRVR, STATE, LT ) */ - - -/* 2. In this example, we assume that neither M2BODDEF has not been */ -/* called. Thus, only the set of default name/code pairs has */ -/* been defined. */ - -/* Given these names, M2BODN2C will return the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - -/* and, given these codes, M2BODC2N will return the following names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ -/* -1 - No */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed to M2BODN2C (BVS) */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Items that were previously considered errors were downgraded */ -/* to simply be exceptions. Any NAME is a legitimate input now. */ -/* If its not in the table, the FOUND flag is just set to .FALSE. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - - -/* -& */ -/* $ Index_Entries */ - -/* body name to code */ - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("M2BODN2C", (ftnlen)8); - } - *found = FALSE_; - bodn2c_(name__, code, found, name_len); - if (*found) { - chkout_("M2BODN2C", (ftnlen)8); - return 0; - } - -/* Get the order vectors for the names and codes. */ - - if (init) { - init = FALSE_; - m2bodini_(names, &nnam, codes, &ncod, ordnam, ordcod, (ftnlen)32); - } - -/* Return the CODE associated with the name. */ - - ljust_(name__, tmpnam, name_len, (ftnlen)32); - ucase_(tmpnam, tmpnam, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__1, tmpnam, tmpnam, (ftnlen)1, (ftnlen)32, (ftnlen)32); - i__ = bschoc_(tmpnam, &nnam, names, ordnam, (ftnlen)32, (ftnlen)32); - if (i__ != 0) { - *code = codes[(i__1 = i__ - 1) < 415 && 0 <= i__1 ? i__1 : s_rnge( - "codes", i__1, "m2bodtrn_", (ftnlen)1264)]; - *found = TRUE_; - } else { - i__1 = nnam; - for (i__ = 1; i__ <= i__1; ++i__) { - if (eqstr_(tmpnam, names + (((i__2 = i__ - 1) < 415 && 0 <= i__2 ? - i__2 : s_rnge("names", i__2, "m2bodtrn_", (ftnlen)1271)) - << 5), (ftnlen)32, (ftnlen)32)) { - *code = codes[(i__2 = i__ - 1) < 415 && 0 <= i__2 ? i__2 : - s_rnge("codes", i__2, "m2bodtrn_", (ftnlen)1272)]; - *found = TRUE_; - chkout_("M2BODN2C", (ftnlen)8); - return 0; - } - } - } - chkout_("M2BODN2C", (ftnlen)8); - return 0; -/* $Procedure M2BODC2N ( Body code to name ) */ - -L_m2bodc2n: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Translate the integer code of a body into a common name for */ -/* that body. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ - -/* INTEGER CODE */ -/* CHARACTER*(*) NAME */ -/* LOGICAL FOUND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* CODE I Integer code to be translated. */ -/* NAME O Common name for the body identified by CODE. */ -/* FOUND O True if translated, otherwise false. */ -/* MAXL P Max name length. */ - -/* $ Detailed_Input */ - -/* CODE is an integer code for a body --- */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* $ Detailed_Output */ - -/* NAME is the common name of the body identified by CODE. */ -/* If CODE has more than one translation, then the */ -/* most recently defined NAME corresponding to CODE */ -/* is returned. NAME will have the exact format (case */ -/* and blanks) as when the name/code pair was defined. */ - -/* FOUND is true if CODE has a translation. Otherwise, FOUND */ -/* is false. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a name. MAXL should only */ -/* be increased if names longer than the current value */ -/* need to be supported. If MAXL is decreased the */ -/* default names may be truncated. */ - -/* $ Exceptions */ - -/* NONE */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* M2BODC2N is one of three related entry points, */ - -/* M2BODN2C Body name to code */ - -/* M2BODC2N Body code to name */ - -/* M2BODDEF Body name/code definition */ - -/* M2BODN2C and M2BODC2N perform translations between body names */ -/* and their corresponding integer codes which are used */ -/* in SPK and PCK files and routines. A set of name/code */ -/* pairs are automatically defined during the first call to */ -/* one of these entry points. Additional name/code pairs may */ -/* be defined via M2BODDEF. */ - -/* $ Examples */ - -/* 1. Suppose you ran the utility program SPACIT to summarize */ -/* an SPK ephemeris file and the following data was output */ -/* to the terminal screen. */ - -/* ---------------------------------------------------------- */ -/* Segment identifier: JPL archive 21354 */ -/* Body : -77 Center : 399 */ -/* From : 1990 DEC 08 18:00:00.000 */ -/* To : 1990 DEC 10 21:10:00.000 */ -/* Reference : DE-200 SPK Type :1 */ -/* ---------------------------------------------------------- */ - -/* You could write a program to translate the body codes */ -/* shown in the SPACIT output: */ - -/* CALL M2BODC2N ( -77, BODY, FOUND ) */ -/* CALL M2BODC2N ( 399, CENTER, FOUND ) */ - -/* IF ( FOUND ) THEN */ - -/* WRITE ( *,* ) 'BODY: -77 = ', BODY */ -/* WRITE ( *,* ) 'CENTER: 399 = ', CENTER */ - -/* END IF */ - -/* You could also read the body and center codes directly from */ -/* the SPK files, using the appropriate DAF routines, and then */ -/* translate them, as above. */ - - -/* 2. In this example, we assume that neither M2BODDEF has not been */ -/* called. Thus, only the set of default name/code pairs has */ -/* been defined. */ - -/* Given these names, M2BODN2C will return the following codes: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'EARTH' 399 Yes */ -/* ' Earth ' 399 Yes */ -/* 'EMB' 3 Yes */ -/* 'Solar System Barycenter' 0 Yes */ -/* 'SolarSystemBarycenter' - No */ -/* 'SSB' 0 Yes */ -/* 'Voyager 2' -32 Yes */ -/* 'U.S.S. Enterprise' - No */ -/* ' ' - No */ -/* 'Halley's Comet' - No */ - - -/* and, given these codes, M2BODC2N will return the following names: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 399 'EARTH' Yes */ -/* 0 'SOLAR SYSTEM BARYCENTER' Yes */ -/* 3 'EARTH BARYCENTER' Yes */ -/* -77 'GALILEO ORBITER' Yes */ -/* 11 - No */ -/* -1 - No */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* M.J. Spencer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed to M2BODC2N (BVS) */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Checks to see that the input integer code can be represented */ -/* as a character string were removed along with the exceptions */ -/* associated with these checks. It is now the responsibility */ -/* of a maintenance programmer to make sure that MAXL is large */ -/* enough to allow any integer to be converted to a string */ -/* representation. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - - -/* -& */ -/* $ Index_Entries */ - -/* body code to name */ - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("M2BODC2N", (ftnlen)8); - } - *found = FALSE_; - -/* Get the order vectors for the names and codes. */ - - if (init) { - init = FALSE_; - m2bodini_(names, &nnam, codes, &ncod, ordnam, ordcod, (ftnlen)32); - } - -/* Return the name associated with the CODE. */ - - i__ = bschoi_(code, &ncod, codes, ordcod); - if (i__ != 0) { - s_copy(name__, names + (((i__1 = i__ - 1) < 415 && 0 <= i__1 ? i__1 : - s_rnge("names", i__1, "m2bodtrn_", (ftnlen)1551)) << 5), - name_len, (ftnlen)32); - *found = TRUE_; - } - chkout_("M2BODC2N", (ftnlen)8); - return 0; -/* $Procedure M2BODDEF ( Body name/code definition ) */ - -L_m2boddef: -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Define a body name/code pair for later translation by */ -/* M2BODN2C or M2BODC2N. */ - -/* $ 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 */ - -/* NAIF_IDS */ - -/* $ Keywords */ - -/* BODY */ -/* CONVERSION */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER CODE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Common name of some body. */ -/* CODE I Integer code for that body. */ -/* MAXL P Max name length and max number of digits in code. */ -/* MAXP P Maximum number of name/code pair definitions. */ - -/* $ Detailed_Input */ - -/* NAME is an arbitrary name of a body which could be */ -/* a planet, satellite, barycenter, spacecraft, */ -/* asteroid, comet, or other ephemeris object. */ - -/* NAME must uniquely identify a body, so NAME must */ -/* be distinct from all other names that have been */ -/* defined. (The list of default definitions are */ -/* in DATA statements in M2BODTRN for easy reference.) */ - -/* Case and leading and trailing blanks in a name */ -/* are not significant. However when a name is made */ -/* up of more than one word, they must be separated by */ -/* at least one blank. That is, all of the following */ -/* strings are equivalent names: */ - -/* 'JUPITER BARYCENTER' */ -/* 'Jupiter Barycenter' */ -/* 'JUPITER BARYCENTER ' */ -/* 'JUPITER BARYCENTER' */ -/* ' JUPITER BARYCENTER' */ - -/* However, 'JUPITERBARYCENTER' is distinct from */ -/* the names above. */ - -/* When ignoring trailing blanks, NAME must have fewer */ -/* than MAXL characters. */ - -/* CODE is the integer code for the named body. */ - -/* CODE may already have a name as defined by a */ -/* previous call to M2BODDEF or as part of the set of */ -/* default definitions. That previous definition will */ -/* remain, and a translation of that name will still */ -/* give the same CODE. However, future translations */ -/* of CODE will give the new NAME instead of the */ -/* previous one. This feature is useful for assigning */ -/* a more familiar or abbreviated name to a body. */ -/* For example, in addition to the default name for */ -/* body 5, 'JUPITER BARYCENTER', you could define the */ -/* abbreviation 'JB' to mean 5. */ - -/* CODE must have at most MAXL digits, where the */ -/* minus sign is counted as a digit if CODE is negative. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MAXL is the maximum length of a name. MAXL should only */ -/* be increased if names longer than the current value */ -/* need to be supported. If MAXL is decreased the */ -/* default names may be truncated. */ - -/* MAXP is the maximum number of name/code pairs that can */ -/* be defined via M2BODDEF. It is the limit */ -/* on the number of definitions over and above the */ -/* number of default definitions. The user may alter */ -/* the the value of MAXP, however, it must remain a */ -/* positive integer. */ - -/* $ Exceptions */ - -/* 1) If NAME has already been associated with a different CODE, */ -/* the error SPICE(NAMENOTUNIQUE) is signalled. */ - -/* 2) If the maximum number of definitions is exceeded, a the */ -/* error SPICE(TOOMANYPAIRS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* M2BODDEF is one of three related entry points, */ - -/* M2BODN2C Body name to code */ - -/* M2BODC2N Body code to name */ - -/* M2BODDEF Body name/code definition */ - -/* M2BODN2C and M2BODC2N perform translations between body names */ -/* and their corresponding integer codes which are used */ -/* in SPK and PCK files and routines. A set of name/code */ -/* pairs are automatically defined during the first call to */ -/* one of these entry points. Additional name/code pairs may */ -/* be defined via M2BODDEF for two purposes: */ - -/* 1. to associate another, perhaps more familiar or */ -/* abbreviated, name with a particular body integer */ -/* code that has already been defined, or */ - -/* 2. to define a new body integer code and name, */ - -/* Each body has a unique integer code, but may have several */ -/* names. Thus you may associate more than one name with */ -/* a particular integer code. However, associating more */ -/* than one integer code with a particular name creates ambiguity. */ -/* Therefore, once a name has been defined, it may not be redefined */ -/* with a different integer code. */ - -/* For example, Europa is the name of the second satellite of */ -/* Jupiter, and has the NAIF integer code 502. Thus (EUROPA, 502) */ -/* is one of the default definitions. Europa is also the name */ -/* of an asteroid. Suppose you were able to associate the asteroid */ -/* integer code with the name EUROPA. Then when you call M2BODN2C to */ -/* translate the name EUROPA, which code should be returned? That */ -/* of the asteroid or 502? */ - -/* M2BODDEF prevent this ambiguity by signalling an error */ -/* if the specified name has already been defined with a */ -/* different code. In the case of EUROPA, you may want to use the */ -/* name ASTEROID EUROPA. The set of default definitions are listed */ -/* in DATA statements in the umbrella routine M2BODTRN for easy */ -/* reference. */ - -/* $ Examples */ - -/* You may associate a new name with a particular code that */ -/* has already been defined: */ - -/* CALL M2BODDEF ( 'JB', 5 ) */ - -/* You may also define the name and integer code for a new body: */ - -/* CALL M2BODDEF ( 'Asteroid Frank', 20103456 ) */ - -/* After these calls to M2BODDEF, M2BODN2C would return the following */ -/* translations: */ - -/* Name Code Found? */ -/* ------------------------ ------ ------ */ -/* 'JB' 5 Yes */ -/* 'Jupiter Barycenter' 5 Yes */ -/* 'ASTEROID FRANK' 20103456 Yes */ -/* 'ASTEROIDFRANK' - No */ -/* 'Frank' - No */ - -/* and M2BODC2N will return these translations: */ - -/* Code Name Found? */ -/* ------- ------------------- ------ */ -/* 5 'JB' Yes */ -/* 20103456 'Asteroid Frank' Yes */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* B.V. Semenov (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.1.0, 29-FEB-1996 (WLT) */ - -/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp. */ - -/* - SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */ - -/* Renamed to M2BODDEF (BVS). More careful checking for overflow */ -/* of the recognized names is now performed. */ - -/* - Beta Version 1.0.0, 29-APR-1994 (MJS) */ - -/* SPICELIB symbol tables are no longer used. Instead, two order */ -/* vectors are used to index the NAMES and CODES arrays. */ - -/* - MOSPICE Version 2.0.1, 10-MAR-1992 (WLT) */ - -/* Comment section for permuted index source lines was added */ -/* following the header. */ - -/* - MOSPICE Version 2.0.0, 15-JUL-1991 (WLT) */ - -/* The body id's for the Uranian satellites discovered by Voyager */ -/* were modified to conform to those established by the IAU */ -/* nomenclature committee. In addition the id's for Gaspra and */ -/* Ida were added. */ - -/* - MOSPICE Version 1.0.0, 7-MAR-1991 (WLT) */ - -/* Checks to see that an integer code can be represented */ -/* as a character string were removed along with the exceptions */ -/* associated with these checks. It is now the responsibility */ -/* of a maintenance programmer to make sure that MAXL is large */ -/* enough to allow any integer to be converted to a string */ -/* representation. */ - -/* - GLLSPICE Version 1.0.0, 28-JUN-1990 (JEM) */ - -/* -& */ -/* $ Index_Entries */ - -/* body name/code definition */ - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("M2BODDEF", (ftnlen)8); - } - -/* Initialize the order vectors if we haven't already. */ - - if (init) { - init = FALSE_; - m2bodini_(names, &nnam, codes, &ncod, ordnam, ordcod, (ftnlen)32); - } - -/* Make sure the name has not already been used. */ - - ljust_(name__, tmpnam, name_len, (ftnlen)32); - ucase_(tmpnam, tmpnam, (ftnlen)32, (ftnlen)32); - cmprss_(" ", &c__1, tmpnam, tmpnam, (ftnlen)1, (ftnlen)32, (ftnlen)32); - i__ = bschoc_(tmpnam, &nnam, names, ordnam, (ftnlen)32, (ftnlen)32); - if (i__ != 0) { - setmsg_("The name, '#', has already been used for body having id-cod" - "e #.", (ftnlen)63); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &codes[(i__1 = i__ - 1) < 415 && 0 <= i__1 ? i__1 : - s_rnge("codes", i__1, "m2bodtrn_", (ftnlen)1866)], (ftnlen)1); - sigerr_("SPICE(NAMENOTUNIQUE)", (ftnlen)20); - chkout_("M2BODDEF", (ftnlen)8); - return 0; - } - -/* Do we have room for another name/code pair? */ - - if (nnam < 415) { - ++nnam; - } else { - setmsg_("There is no room available for adding '#' to the list of n" - "ame/code pairs. The number of names that can be supported is" - " #. This number has been reached. ", (ftnlen)154); - errch_("#", name__, (ftnlen)1, name_len); - errint_("#", &nnam, (ftnlen)1); - sigerr_("SPICE(TOOMANYPAIRS)", (ftnlen)19); - chkout_("M2BODDEF", (ftnlen)8); - return 0; - } - -/* Add NAME and CODE and reorder the vectors. */ - - s_copy(names + (((i__1 = nnam - 1) < 415 && 0 <= i__1 ? i__1 : s_rnge( - "names", i__1, "m2bodtrn_", (ftnlen)1900)) << 5), tmpnam, (ftnlen) - 32, (ftnlen)32); - codes[(i__1 = nnam - 1) < 415 && 0 <= i__1 ? i__1 : s_rnge("codes", i__1, - "m2bodtrn_", (ftnlen)1901)] = *code; - m2bodini_(names, &nnam, codes, &ncod, ordnam, ordcod, (ftnlen)32); - chkout_("M2BODDEF", (ftnlen)8); - return 0; -} /* m2bodtrn_ */ - -/* Subroutine */ int m2bodtrn_(char *name__, integer *code, logical *found, - ftnlen name_len) -{ - return m2bodtrn_0_(0, name__, code, found, name_len); - } - -/* Subroutine */ int m2bodn2c_(char *name__, integer *code, logical *found, - ftnlen name_len) -{ - return m2bodtrn_0_(1, name__, code, found, name_len); - } - -/* Subroutine */ int m2bodc2n_(integer *code, char *name__, logical *found, - ftnlen name_len) -{ - return m2bodtrn_0_(2, name__, code, found, name_len); - } - -/* Subroutine */ int m2boddef_(char *name__, integer *code, ftnlen name_len) -{ - return m2bodtrn_0_(3, name__, code, (logical *)0, name_len); - } - diff --git a/ext/spice/src/csupport/m2body.c b/ext/spice/src/csupport/m2body.c deleted file mode 100644 index 8a6bdadcbc..0000000000 --- a/ext/spice/src/csupport/m2body.c +++ /dev/null @@ -1,165 +0,0 @@ -/* m2body.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2BODY ( Determine whether or not a word is a body ) */ -logical m2body_(char *word, ftnlen word_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - char copy[32]; - extern logical m2int_(char *, ftnlen); - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - logical found; - integer idcode; - extern /* Subroutine */ int m2bodn2c_(char *, integer *, logical *, - ftnlen); - -/* $ Abstract */ - -/* This function is true if the input string is a known body 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 a META/2 body. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2INT returns as .TRUE. if WORD is a META/2 body. */ -/* 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 body in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2BODY */ -/* ------- ------ */ -/* JUPITER .TRUE. */ -/* 1 .TRUE. */ -/* 0.289E19 .FALSE. */ -/* 0.2728D12 .FALSE. */ -/* -12.1892e-5 .FALSE. */ -/* 12.E29 .FALSE. */ -/* 12.E291 .FALSE. */ -/* 1.2E10 .TRUE. */ -/* .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) */ - -/* -& */ - -/* Library functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - if (m2int_(word, word_len)) { - ret_val = TRUE_; - return ret_val; - } - ucase_(word, copy, word_len, (ftnlen)32); - m2bodn2c_(copy, &idcode, &found, (ftnlen)32); - ret_val = found; - return ret_val; -} /* m2body_ */ - diff --git a/ext/spice/src/csupport/m2cal.c b/ext/spice/src/csupport/m2cal.c deleted file mode 100644 index 38453f7491..0000000000 --- a/ext/spice/src/csupport/m2cal.c +++ /dev/null @@ -1,262 +0,0 @@ -/* m2cal.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2CAL ( Parse a UTC time string ) */ -/* Subroutine */ int m2cal_(char *utcstr, char *mssg, integer *tcode, ftnlen - utcstr_len, ftnlen mssg_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal tvec[8]; - logical mods; - char type__[8]; - integer ntvec; - extern /* Subroutine */ int tcheck_(doublereal *, char *, logical *, char - *, logical *, char *, ftnlen, ftnlen, ftnlen); - logical succes, yabbrv; - char modify[16*5], pictur[80]; - extern logical return_(void); - extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char - *, char *, logical *, logical *, logical *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* See is a string is a legitimate time 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. */ - -/* $ Keywords */ - -/* PARSING, TIME */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* UTCSTR I Input time string, UTC. */ -/* MSSG O A diagnostic indicating why parsing failed. */ -/* TCODE O A short parsing error flag. */ - -/* $ Detailed_Input */ - -/* UTCSTR is an input time string, containing a Calendar or */ -/* Julian Date, UTC. */ - -/* Calendar dates consist of up to seven tokens: */ -/* one each for System, Year, Month, Day, Hours, */ -/* Minutes, and Seconds. */ - -/* Valid token delimiters are: */ - -/* ' ' space */ -/* ',' comma */ -/* '/' slash */ -/* '-' dash */ -/* ':' colon */ - -/* The month may be an integer or a name. (At least */ -/* three characters are required in a name.) The last */ -/* three tokens always represent Hours, Minutes, and */ -/* Seconds respectively. The first three tokens always */ -/* represent Year, Month, and Day, with the order */ -/* determined according to the following rules: */ - -/* 1. If a month name is present, then the year is */ -/* taken to be an integer greater than 1000 and */ -/* less than 3000. The day of the month is taken */ -/* to be the non-negative integer less than 32. */ - -/* 2. If no month name is present, the token greater */ -/* than 1000 and less than 3000 is taken to be */ -/* the year this must be the first token or the */ -/* third. In either case the other two tokens */ -/* in order are then taken to be the month and */ -/* day of month. */ - -/* Missing tokens are assigned the following defaults: */ - -/* - Month January */ -/* - Day 1 */ -/* - Hours 0 */ -/* - Minutes 0 */ -/* - Seconds 0.0000000 */ - -/* Note that Day of Year may be substituted for Month */ -/* and Day in either of the following ways: */ - -/* 1. By setting the month to January and the day to */ -/* Day of Year, e.g., */ - -/* '1986 JAN 247 12:00:01.184' */ - -/* 2. By eliminating the month token altogether. */ -/* (It defaults to January anyway.) The most */ -/* popular form for DOY entry is: */ - -/* '1986//247 12:00:01.184' */ - -/* Julian Dates consist of two tokens. */ -/* The first contains the letters 'JD', in any */ -/* combinations of upper- or lower-case. The */ -/* second token is a Julian Date. For convenience, */ -/* the two tokens may be concatenated, as shown */ -/* in the examples below. Valid token delimiters */ -/* are the same as for Calendar format. */ - -/* If the token 'JD' is entered by itself, the */ -/* input string is rejected as ambiguous. */ - -/* The length of UTC should not exceed 80 characters. */ - -/* $ Detailed_Output */ - -/* MSSG is a descriptive message indicating what went wrong */ -/* if the string could not be parsed. It is blank when */ -/* the string parses successfully as a time. */ - -/* TCODE is a short string that indicates why the date did not */ -/* parse. */ -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Common_Variables */ - -/* None. */ - -/* $ Detailed_Description */ - -/* The input string is parsed for six tokens, delimited by any */ -/* of the valid delimiters (space, comma, slash, hyphen, colon). */ - -/* If the first token is (or begins with) 'JD', the input is */ -/* taken to be a Julian Date. Extra tokens are ignored. */ - -/* Otherwise, the last three tokens are assigned to hours, */ -/* minutes, and seconds respectively. The first three are */ -/* assigned to year, month, and day, according to magnitude and */ -/* the presence (or lack) of a month name, according to the rules */ -/* described under Detailed_Inputs above. The Muller-Wimberly */ -/* formula is used to compute the number of days past 2000 JAN 1, */ -/* which is then converted to UTC seconds past J2000. */ - -/* $ Examples */ - -/* The following are examples of valid inputs to M2CAL: */ - -/* '29 February 1975 3:00' ( 1 MAR 1975 03:00:00 ) */ -/* 'JD 2451545.' ( 1 JAN 2000 12:00:00 ) */ -/* 'JD-2451545.' ( 1 JAN 2000 12:00:00 ) */ -/* 'jd 2451545.' ( 1 JAN 2000 12:00:00 ) */ -/* 'JD2451545.' ( 1 JAN 2000 12:00:00 ) */ - -/* The following examples would be rejected as ambiguous. */ - -/* '32 jan 32' */ -/* '85 86 january' */ -/* '86 3 january' */ -/* 'January 80 81' */ -/* 'JD,,,2451545' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Required_Reading */ - -/* TIME */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W. M. Owen, Jr. (JPL) */ -/* I. M. Underwood (JPL) */ -/* W. L. Taber (JPL) */ - -/* $ Version */ - -/* - META/2 Version 3.0.0, 3-SEP-1998 (WLT) */ - -/* Replaced everything with foundation Time routine calls. */ - -/* - 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 1, 22-APR-1987 */ - -/* -& */ - -/* NAIFLIB functions */ - - if (return_()) { - return 0; - } - s_copy(mssg, " ", mssg_len, (ftnlen)1); - *tcode = 0; - tpartv_(utcstr, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes, - pictur, mssg, utcstr_len, (ftnlen)8, (ftnlen)16, (ftnlen)80, - mssg_len); - if (! succes) { - *tcode = 1; - } else if (s_cmp(type__, "JD", (ftnlen)8, (ftnlen)2) == 0) { - -/* Don't do anything. */ - - } else { - tcheck_(tvec, type__, &mods, modify, &succes, mssg, (ftnlen)8, ( - ftnlen)16, mssg_len); - if (! succes) { - *tcode = 2; - } - } - return 0; -} /* m2cal_ */ - diff --git a/ext/spice/src/csupport/m2chck.c b/ext/spice/src/csupport/m2chck.c deleted file mode 100644 index bc0a027f61..0000000000 --- a/ext/spice/src/csupport/m2chck.c +++ /dev/null @@ -1,288 +0,0 @@ -/* m2chck.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__1 = 1; - -/* $Procedure M2CHCK ( Meta-2, check a table of syntax definitions ) */ -/* Subroutine */ int m2chck_(char *statmn, char *synkey, integer *synptr, - char *synval, char *error, ftnlen statmn_len, ftnlen synkey_len, - ftnlen synval_len, ftnlen error_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - integer best[16]; - char mssg[160]; - integer b, e, i__, n; - extern integer cardi_(integer *); - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - logical found; - extern /* Subroutine */ int meta_2__(char *, char *, integer *, char *, - integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen), fndnwd_(char * - , integer *, integer *, integer *, ftnlen); - integer cutoff; - extern /* Subroutine */ int bestwd_(char *, char *, integer *, integer *, - integer *, char *, ftnlen, ftnlen, ftnlen); - integer lookat; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen); - integer scores[16]; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - char keywrd[32]; - extern /* Subroutine */ int ssizei_(integer *, integer *); - integer mxscor; - extern logical return_(void); - logical unknwn; - extern /* Subroutine */ int syptrc_(char *, char *, integer *, char *, - integer *, integer *, logical *, ftnlen, ftnlen, ftnlen); - integer bst, ptr; - -/* $ Abstract */ - -/* Using a symbol table of syntax definition statement indexed by */ -/* initial keyword, determine if the input statement is syntactically */ -/* correct. */ - -/* $ 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 command definition language and parser. */ - -/* $ Keywords */ - -/* META-2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STATMN I A statement to check for syntactic correctness. */ -/* SYNKEY I A symbol table of syntax definitions. */ -/* SYNPTR */ -/* SYNVAL */ -/* ERROR O Blank if STATMN correct, diagnosis otherwise. */ - -/* $ Detailed_Input */ - -/* STATMN is a string that is a candidate for a syntactically */ -/* correct statement. */ - -/* SYNKEY is a symbol table. It is indexed by the initial */ -/* SYNPTR keywords of META-2 syntax definition statements. */ -/* SYNVAL This table is best prepared using the routine */ -/* M2INTS. */ - -/* $ Detailed_Output */ - -/* ERROR is an array of character strings that are used to */ -/* diagnose how well a STATMN matches one of the */ -/* syntax specificiations in the input symbol table. */ -/* If the STATMN is syntactically correct ERROR(1) */ -/* is returned as a blank. Otherwise it is returned */ -/* with a diagnosis of why STATMN failed to be */ -/* syntactically correct. */ - -/* Parsing of STATMN is usually accomplished by using */ -/* the various M2GET routines. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine can be used to compare a statement with a large */ -/* collection of syntax definitions provided all of the definitions */ -/* begin with a keyword. To make use of this routine, you must first */ -/* prepare the symbol table. The easiest way to to this is to use */ -/* the routine M2INTS. */ - -/* To parse the input statement once it has been determine that it */ -/* is syntactically correct, one can use the M2GET routines to locate */ -/* the various substring corresponding to the meaning of STATMN. */ - -/* $ Examples */ - -/* Typical useage looks like this: */ - -/* IF ( FIRST ) THEN */ - -/* CALL M2INTS ( NSYN, SYNKEY, SYNPTR, SYNVAL ) */ -/* FIRST = .FALSE. */ - -/* END IF */ - -/* CALL M2CHCK ( STATMN, SYNKEY, SYNPTR, SYNVAL, ERROR ) */ - -/* IF ( ERROR(1) .NE. ' ' ) THEN */ -/* CALL PREFIX ( 'MYNAME:', 1, ERROR(1) ) */ -/* RETURN */ -/* END IF */ - -/* Still here? Determine what the string actually meant. */ - -/* $ Restrictions */ - -/* To make use of STATMN for parsing with the M2GET routines, you */ -/* should not alter it after the call to M2CHCK until you have */ -/* finished parsing it. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 4-MAY-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Check a statement against a set of syntax definitions */ - -/* -& */ - -/* Spicelib functions */ - - -/* Local Variables */ - - if (return_()) { - s_copy(error, "M2CHCK: The function RETURN was set to .TRUE. This si" - "tuation is not supposed to happen.", error_len, (ftnlen)87); - return 0; - } - -/* Initialize the cell BEST and SCORES. */ - - ssizei_(&c__10, best); - ssizei_(&c__10, scores); - -/* Get the first word of the input string. */ - - fndnwd_(statmn, &c__1, &b, &e, statmn_len); - ucase_(statmn + (b - 1), keywrd, e - (b - 1), (ftnlen)32); - -/* Find the syntax templates that match the first word of the */ -/* command. */ - - syptrc_(keywrd, synkey, synptr, synval, &ptr, &n, &found, (ftnlen)32, - synkey_len, synval_len); - -/* If we didn't find our word, then we look for a word that */ -/* comes close spelling-wise */ - - if (! found) { - cutoff = 70; - bestwd_(keywrd, synkey, &cutoff, best, scores, mssg, (ftnlen)32, - synkey_len, (ftnlen)160); - if (cardi_(best) == 0) { - unknwn = TRUE_; - } else if (scores[6] < 50) { - unknwn = TRUE_; - } else { - unknwn = FALSE_; - } - if (unknwn) { - s_copy(error, "Sorry but I didn't recognize the word", error_len, - (ftnlen)37); - suffix_(keywrd, &c__1, error, (ftnlen)32, error_len); - suffix_("as the beginning of any valid statement. ", &c__1, error, - (ftnlen)41, error_len); - return 0; - } - -/* Still here? fetch the set of likely syntax statements to check. */ - - mxscor = 0; - i__1 = cardi_(best); - for (i__ = 1; i__ <= i__1; ++i__) { - if (scores[(i__2 = i__ + 5) < 16 && 0 <= i__2 ? i__2 : s_rnge( - "scores", i__2, "m2chck_", (ftnlen)269)] > mxscor) { - mxscor = scores[(i__2 = i__ + 5) < 16 && 0 <= i__2 ? i__2 : - s_rnge("scores", i__2, "m2chck_", (ftnlen)270)]; - lookat = i__; - } - } - s_copy(keywrd, synkey + (best[(i__1 = lookat + 5) < 16 && 0 <= i__1 ? - i__1 : s_rnge("best", i__1, "m2chck_", (ftnlen)275)] + 5) * - synkey_len, (ftnlen)32, synkey_len); - syptrc_(keywrd, synkey, synptr, synval, &ptr, &n, &found, (ftnlen)32, - synkey_len, synval_len); - } - -/* Until we find out otherwise, we shall assume that we have */ -/* a syntactically correct input statement. */ - - meta_2__(statmn, synval + (ptr + 5) * synval_len, &n, synval, &bst, error, - statmn_len, synval_len, synval_len, error_len); - if (s_cmp(error, " ", error_len, (ftnlen)1) != 0) { - prefix_("M2CHCK:", &c__1, error + error_len, (ftnlen)7, error_len); - } - return 0; -} /* m2chck_ */ - diff --git a/ext/spice/src/csupport/m2clss.c b/ext/spice/src/csupport/m2clss.c deleted file mode 100644 index 1b06eea57e..0000000000 --- a/ext/spice/src/csupport/m2clss.c +++ /dev/null @@ -1,376 +0,0 @@ -/* m2clss.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure M2CLSS (Meta 2 --- meta 2 word classification ) */ -/* Subroutine */ int m2clss_(char *word, integer *num, char *phrase, ftnlen - word_len, ftnlen phrase_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - address a__1[2]; - integer i__1[2], i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - static char base[32], name__[80*2], body[80*2], time[80*2], year[80*2]; - static integer b, c__, e; - static char alpha[80*2], epoch[80*2]; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen); - static char other[80*2], gword[80*2], month[80*2]; - static logical rtemp; - extern integer rtrim_(char *, ftnlen); - static char units[80*2]; - extern /* Subroutine */ int m2tran_(char *, integer *, integer *, char *, - logical *, logical *, ftnlen, ftnlen); - static char dp[80*2], englsh[80*2]; - static integer number; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static char day[80*2]; - static logical key; - static char int__[80*2]; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine creates a phrase of the appropiate number */ -/* that describes the meta2 syntax word WORD. */ - -/* $ 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 */ - -/* META2 */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WORD I A meta-2 keyword. */ -/* NUM I The number of meta-2 keywords */ -/* PHRASE O A description of NUM WORDs. */ - -/* $ Detailed_Input */ - -/* WORD is a meta-2 keyword such as @int or @number(1:20) */ - -/* NUM is used to indicate if how many of the WORDS we */ -/* want to talk about. For example when describing */ -/* @int(1:10) do you want to say */ - -/* integer between 1 and 10 */ -/* or */ -/* integers between 1 and 10 */ - -/* If NUM is 1 you get the first phrase. Otherwise */ -/* you get the second one. */ - -/* $ Detailed_Output */ - -/* PHRASE is a character string that describes WORD and NUM. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) Although it has not changed in a long time. META/2 might */ -/* have some other word classifiers added. In that case this */ -/* routine will have to be updated. But it will make a reasonable */ -/* phrase even if the new META/2 keyword isn't recognized yet. */ -/* Something like */ - -/* word(s) of the class WORD */ - -/* will be used. */ - -/* $ Particulars */ - -/* This */ - -/* $ Examples */ - -/* Suppose that a message needs to be created that says */ -/* a word in a string does not match an expected @int(1:10) */ - -/* You could use this routine together with the utility function */ -/* ANA to construct a reasonable message. */ - -/* CALL M2CLSS ( '@int(1:10), 1, PHRASE ) */ -/* ARTCLE = ANA ( PHRASE, 'C' ) */ - -/* MESSGE = '# # was expected in the string.' */ - -/* CALL REPMC ( MESSGE, '#', ARTCLE, MESSGE ) */ -/* CALL REPMC ( MESSGE, '#', PHRASE, MESSGE ) */ - -/* The resulting string in MESSGE would be */ - -/* 'An integer between 1 and 10 was expected.' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - META/2 Version 2.0.0, 23-MAY-2000 (WLT) */ - -/* Updated the routine to support the additional Meta/2 keyword */ -/* @unit. */ - -/* - META/2 Version 1.0.0, 12-AUG-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* META/2 diagnostic message creation tool */ - -/* -& */ - -/* SPICELIB functions */ - - if (first) { - first = FALSE_; - s_copy(alpha, "word beginning with a letter", (ftnlen)80, (ftnlen)28); - s_copy(alpha + 80, "words beginning with a letter", (ftnlen)80, ( - ftnlen)29); - s_copy(body, "body name or id-code", (ftnlen)80, (ftnlen)20); - s_copy(body + 80, "body names or id-codes", (ftnlen)80, (ftnlen)22); - s_copy(day, "day of the year", (ftnlen)80, (ftnlen)15); - s_copy(day + 80, "days of the year", (ftnlen)80, (ftnlen)16); - s_copy(englsh, "word containing only letters", (ftnlen)80, (ftnlen)28) - ; - s_copy(englsh + 80, "words containing only letters", (ftnlen)80, ( - ftnlen)29); - s_copy(epoch, "epoch", (ftnlen)80, (ftnlen)5); - s_copy(epoch + 80, "epochs", (ftnlen)80, (ftnlen)6); - s_copy(month, "month of the year", (ftnlen)80, (ftnlen)17); - s_copy(month + 80, "months of the year", (ftnlen)80, (ftnlen)18); - s_copy(name__, "word of letters and digits starting with a letter", ( - ftnlen)80, (ftnlen)49); - s_copy(name__ + 80, "words of letters and digits each starting with " - "a letter ", (ftnlen)80, (ftnlen)56); - s_copy(time, "time of day", (ftnlen)80, (ftnlen)11); - s_copy(time + 80, "times of the day", (ftnlen)80, (ftnlen)16); - s_copy(year, "calendar year (1000 to 3000) ", (ftnlen)80, (ftnlen)29); - s_copy(year + 80, "calendar years (1000 to 3000) ", (ftnlen)80, ( - ftnlen)30); - s_copy(gword, "generic word", (ftnlen)80, (ftnlen)12); - s_copy(gword + 80, "generic words", (ftnlen)80, (ftnlen)13); -/* Writing concatenation */ - i__1[0] = 14, a__1[0] = "word of class "; - i__1[1] = word_len, a__1[1] = word; - s_cat(other, a__1, i__1, &c__2, (ftnlen)80); -/* Writing concatenation */ - i__1[0] = 15, a__1[0] = "words of class "; - i__1[1] = word_len, a__1[1] = word; - s_cat(other + 80, a__1, i__1, &c__2, (ftnlen)80); - s_copy(int__, "integer", (ftnlen)80, (ftnlen)7); - s_copy(int__ + 80, "integers", (ftnlen)80, (ftnlen)8); - s_copy(dp, "number", (ftnlen)80, (ftnlen)6); - s_copy(dp + 80, "numbers", (ftnlen)80, (ftnlen)7); - s_copy(units, "unit specification", (ftnlen)80, (ftnlen)18); - s_copy(units + 80, "unit specifications", (ftnlen)80, (ftnlen)19); - } - if (*num == 1) { - number = 1; - } else { - number = 2; - } - b = 1; - e = rtrim_(word, word_len); - m2tran_(word, &b, &e, base, &key, &rtemp, word_len, (ftnlen)32); - if (s_cmp(base, "@int", (ftnlen)32, (ftnlen)4) == 0) { - s_copy(phrase, int__ + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("int", i__2, "m2clss_", (ftnlen)257)) * 80, phrase_len, - (ftnlen)80); - if (rtemp) { - c__ = pos_(word, ":", &b, word_len, (ftnlen)1); - if (c__ == b + 1) { - suffix_("less than or equal to #", &c__1, phrase, (ftnlen)23, - phrase_len); - i__2 = b + 1; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, e - 1 - i__2, phrase_len); - } else if (c__ == e - 1) { - suffix_("greater than or equal to #", &c__1, phrase, (ftnlen) - 26, phrase_len); - i__2 = b; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, e - 2 - i__2, phrase_len); - } else { - suffix_("between # and # (inclusive)", &c__1, phrase, (ftnlen) - 27, phrase_len); - i__2 = b; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, c__ - 1 - i__2, phrase_len); - i__2 = c__; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, e - 1 - i__2, phrase_len); - } - } - return 0; - } - if (s_cmp(base, "@number", (ftnlen)32, (ftnlen)7) == 0) { - s_copy(phrase, dp + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("dp", i__2, "m2clss_", (ftnlen)283)) * 80, phrase_len, - (ftnlen)80); - if (rtemp) { - i__2 = b + 1; - c__ = pos_(word, ":", &i__2, word_len, (ftnlen)1); - if (c__ == b + 1) { - suffix_("less than or equal to #", &c__1, phrase, (ftnlen)23, - phrase_len); - i__2 = b + 1; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, e - 1 - i__2, phrase_len); - } else if (c__ == e - 1) { - suffix_("greater than or equal to #", &c__1, phrase, (ftnlen) - 26, phrase_len); - i__2 = b; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, e - 2 - i__2, phrase_len); - } else { - suffix_("between # and # (inclusive)", &c__1, phrase, (ftnlen) - 27, phrase_len); - i__2 = b; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, c__ - 1 - i__2, phrase_len); - i__2 = c__; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen) - 1, e - 1 - i__2, phrase_len); - } - } - return 0; - } - if (s_cmp(base, "@unit", (ftnlen)32, (ftnlen)5) == 0) { - s_copy(phrase, units + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("units", i__2, "m2clss_", (ftnlen)309)) * 80, - phrase_len, (ftnlen)80); - if (rtemp) { - suffix_("with dimensions compatible with #", &c__1, phrase, ( - ftnlen)33, phrase_len); - i__2 = b; - repmc_(phrase, "#", word + i__2, phrase, phrase_len, (ftnlen)1, e - - 1 - i__2, phrase_len); - } - return 0; - } - if (s_cmp(base, "@alpha", (ftnlen)32, (ftnlen)6) == 0) { - s_copy(phrase, alpha + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("alpha", i__2, "m2clss_", (ftnlen)325)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@body", (ftnlen)32, (ftnlen)5) == 0) { - s_copy(phrase, body + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("body", i__2, "m2clss_", (ftnlen)329)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@day", (ftnlen)32, (ftnlen)4) == 0) { - s_copy(phrase, day + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("day", i__2, "m2clss_", (ftnlen)333)) * 80, phrase_len, - (ftnlen)80); - } else if (s_cmp(base, "@english", (ftnlen)32, (ftnlen)8) == 0) { - s_copy(phrase, englsh + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("englsh", i__2, "m2clss_", (ftnlen)337)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@epoch", (ftnlen)32, (ftnlen)6) == 0) { - s_copy(phrase, epoch + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("epoch", i__2, "m2clss_", (ftnlen)341)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@month", (ftnlen)32, (ftnlen)6) == 0) { - s_copy(phrase, month + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("month", i__2, "m2clss_", (ftnlen)345)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@name", (ftnlen)32, (ftnlen)5) == 0) { - s_copy(phrase, name__ + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("name", i__2, "m2clss_", (ftnlen)349)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@time", (ftnlen)32, (ftnlen)5) == 0) { - s_copy(phrase, time + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("time", i__2, "m2clss_", (ftnlen)353)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@year", (ftnlen)32, (ftnlen)5) == 0) { - s_copy(phrase, year + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("year", i__2, "m2clss_", (ftnlen)357)) * 80, - phrase_len, (ftnlen)80); - } else if (s_cmp(base, "@word", (ftnlen)32, (ftnlen)5) == 0) { - s_copy(phrase, gword + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("gword", i__2, "m2clss_", (ftnlen)361)) * 80, - phrase_len, (ftnlen)80); - } else { - s_copy(phrase, other + ((i__2 = number - 1) < 2 && 0 <= i__2 ? i__2 : - s_rnge("other", i__2, "m2clss_", (ftnlen)365)) * 80, - phrase_len, (ftnlen)80); - } - if (rtemp) { - suffix_("that matches the pattern '", &c__1, phrase, (ftnlen)26, - phrase_len); - i__2 = b; - suffix_(word + i__2, &c__0, phrase, e - 1 - i__2, phrase_len); - suffix_("'", &c__0, phrase, (ftnlen)1, phrase_len); - } - return 0; -} /* m2clss_ */ - diff --git a/ext/spice/src/csupport/m2core.c b/ext/spice/src/csupport/m2core.c deleted file mode 100644 index f89a2187bd..0000000000 --- a/ext/spice/src/csupport/m2core.c +++ /dev/null @@ -1,2017 +0,0 @@ -/* m2core.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__10 = 10; -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__2 = 2; - -/* $Procedure M2CORE ( META/2 core syntax checking routines. ) */ -/* Subroutine */ int m2core_0_(int n__, char *temp, integer *tbeg, char * - keywds, char *string, integer *sbeg, logical *reason, integer *cutoff, - integer *m2code, integer *score, char *cause, integer *send, ftnlen - temp_len, ftnlen keywds_len, ftnlen string_len, ftnlen cause_len) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - char ch__1[2]; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - static integer pbeg, pend, best[16], slen, nkey; - static char mssg[420], root[32]; - extern /* Subroutine */ int m2cal_(char *, char *, integer *, ftnlen, - ftnlen); - static integer i__; - extern integer cardc_(char *, ftnlen), cardi_(integer *); - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen), - chkin_(char *, ftnlen); - static integer tcode; - static logical endok; - static integer timeb; - static logical endit; - extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, - ftnlen, ftnlen, ftnlen), copyc_(char *, char *, ftnlen, ftnlen); - static integer lower; - static logical error; - static integer count, upper; - static char known[32*16]; - extern /* Subroutine */ int m2begr_(char *, integer *, integer *, integer - *, integer *, ftnlen), m2mark_(char *, integer *, integer *, char - *, ftnlen, ftnlen); - extern logical m2wmch_(char *, integer *, integer *, char *, ftnlen, - ftnlen); - extern /* Subroutine */ int m2clss_(char *, integer *, char *, ftnlen, - ftnlen); - static integer db, de; - extern /* Subroutine */ int m2trim_(char *, char *, ftnlen, ftnlen); - static integer kb; - extern logical m2keyw_(char *, ftnlen); - static integer ke, sb, tb, tc, se, te, endchk; - static logical cmatch; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - extern integer esrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer tbegin, sbegin; - static char artcle[2]; - static logical calwrd; - static integer bscore; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - static char phrase[120]; - static logical keytbe, useend; - static integer begout, lastsb, suffsb, orignl, lastse, mspell, dcount, - suffse; - static char lowerc[64]; - static integer oversb; - static char upperc[64], countc[64]; - extern integer qlstnb_(char *, ftnlen); - static logical usekey; - static integer mcount, overse; - static logical keywrd; - static integer scores[16]; - extern /* Subroutine */ int ssizei_(integer *, integer *); - extern integer qrtrim_(char *, ftnlen); - static logical uselst; - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen), setmsg_( - char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen), bestwd_(char - *, char *, integer *, integer *, integer *, char *, ftnlen, - ftnlen, ftnlen), inttxt_(integer *, char *, ftnlen); - extern /* Character */ VOID ana_(char *, ftnlen, char *, char *, ftnlen, - ftnlen); - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine is the header routine for use by M2MTCH and its */ -/* associated entry point M2RCVR. As it takes no action, it should */ -/* not be called directly. */ - -/* $ 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 */ - -/* The META/2 book. */ - -/* $ Keywords */ - -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* See the entry point headers for description of each of the */ -/* input/output arguements. */ - -/* $ Detailed_Input */ - -/* See individual entry points. */ - -/* $ Detailed_Output */ - -/* See individual entry points. */ - -/* $ Error_Handling */ - -/* See individual entry points. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as the header routine for entry point M2MTCH */ -/* and its associated entry M2RCVR. M2MTCH is the essential syntax */ -/* checking portion of the META/2 syntax comparison routine. */ - -/* $ Examples */ - -/* To compare two templates call M2MTCH */ - -/* To find the position of a mispelled keyword in the input string */ -/* and the possible spelling corrections call M2RCVR */ - -/* $ 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, 7-APR-1988 (WLT) (IMU) */ - -/* -& */ - - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* KNOWN, PBEG, and PEND are storage for the recovery entry point. */ - -/* Should a spelling error be detected, the best matching words will */ -/* be stored in KNOWN and the index of the beginning and ending */ -/* of the problem word in STRING will be stored in PBEG and PEND */ -/* respectively. */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (cause) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_m2mtch; - case 2: goto L_m2rcvr; - } - - return 0; -/* $Procedure M2MTCH ( Match a string with a simple META/2 template ) */ - -L_m2mtch: -/* $ Abstract */ - -/* This entry points compares simple templates with strings and */ -/* produces scores reflecting the extent of agreement between */ -/* the template and string. If requested diagnostics are produced. */ - -/* $ 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 */ - -/* The META/2 book. */ - -/* $ Keywords */ - -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* CHARACTER*(*) TEMP */ -/* INTEGER TBEG */ -/* CHARACTER*(*) KEYWDS ( LBCELL: * ) */ -/* CHARACTER*(*) STRING */ -/* INTEGER SBEG */ -/* LOGICAL REASON */ -/* INTEGER CUTOFF */ -/* INTEGER M2CODE */ -/* INTEGER SCORE */ -/* CHARACTER*(*) CAUSE ( 2 ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TEMP I A simple language specification sentence . */ -/* TBEG I Position in the template to start match attempt. */ -/* KEYWDS I A cell of possible terminators of a META-KEY string */ -/* STRING I A potential language sentence */ -/* SBEG I/O Marker of the current start of the string */ -/* REASON I Set to .TRUE. to request production of diagnostics */ -/* CUTOFF I Spelling error threshold */ -/* M2CODE O Indicates type of mismatch between TEMP and STRING */ -/* SCORE O Number giving a measure of how closeness of match. */ -/* CAUSE O If requested, a diagnostic of mismatch. */ - -/* $ Detailed_Input */ - -/* TEMP A simple language specification sentence. Such a */ -/* statement consists of only keyword and META/2 class */ -/* specifiers. No groups or @then directives are allowed. */ - -/* TBEG Position in the template to start match attempt. */ - -/* KEYWDS A cell of possible terminators of a META-KEY string. */ -/* This is primarily usefull for higher level routines */ -/* that pick simple templates out of more complex META/2 */ -/* specification sentences. */ - -/* STRING A is a collection of words that might make up a valid */ -/* sentence in a META/2 language. A substring of STRING */ -/* beginning with SBEG will be matched against TEMP to */ -/* see if we have a valid phrase in a META/2 language. */ - -/* SBEG Marker of the current start of the string */ - -/* REASON Set to .TRUE. to request production of diagnostics */ - -/* CUTOFF is a parameter used to determine how close words */ -/* of STRING must match up with keywords in TEMP */ -/* in order to be diagnosed as spelling errors. */ -/* Ranges from 0 to 100 are acceptable. A "good" range */ -/* of values is from from 65 to 75. */ - -/* $ Detailed_Output */ - -/* SBEG if the match is successful, SBEG will be set to the */ -/* first word of the input string that follows the */ -/* matched substring. ( Note that words in KEYWDS do */ -/* not qualify as part of the template, but merely */ -/* serve to delimit the ends of variable length */ -/* templates. Thus if one of these words was actually */ -/* used to delimit the end of TEMP, SBEG will point to */ -/* the beginning of that word in STRING.) */ - - -/* M2CODE Indicates type of mismatch between TEMP and STRING */ - -/* M2CODE = 0 Indicates that the template supplied matched the */ -/* input string as far as it went. */ - -/* M2CODE = 10 Indicates that the keyword that was supposed to */ -/* terminate a variable length template was probably */ -/* mispelled. */ - -/* M2CODE = 11 We were expecting a specific keyword and failed */ -/* in our match attempt. It is likely that the */ -/* keyword was simply misspelled. */ - -/* M2CODE = 101 Indicates that a variable length template had too */ -/* few entries before the keyword was encountered. */ - -/* M2CODE = 102 Indicates that a variable length template had too */ -/* many entries before the keyword was encountered. */ - -/* M2CODE = 103 Indicates that the correct number of entries */ -/* for a variable length template were encountered */ -/* but the input string terminated without finding */ -/* the correct keyword. */ - -/* M2CODE = 104 Indicates that the string should have terminated */ -/* but instead contained extra characters. */ - -/* M2CODE = 105 Indicates that correct number if items were */ -/* present in the variable length template but that */ -/* it did not end with an expected keyword. */ -/* Moreover, it is not thought that the problem is */ -/* likely to be a simple spelling error. */ - -/* M2CODE = 106 The number of items found in a variable length */ -/* template was too small and we did not get */ -/* an expected keyword. A possible explanation */ -/* is a mistyping one or more of the letters in */ -/* one of the META class words. */ - -/* M2CODE = 107 The number of items found in a variable length */ -/* template was too large and we did not get */ -/* an expected keyword. A possible explanation */ -/* is a a forgotten keyword. */ - -/* M2CODE = 108 We ran out of string while in a fixed length */ -/* template. */ - -/* M2CODE = 109 We failed to match a META class word while within */ -/* a fixed length template. */ - -/* M2CODE = 110 We were expecting to see a specific keyword and */ -/* got something else. This is not thought to be */ -/* the result of a spelling error. */ - -/* M2CODE = 111 We were expecting to see a META class word and */ -/* failed in our matching attempt. */ - -/* M2CODE values from 1001 to 1014 indicate problems that can occur */ -/* when attempting to match a substring with the @calendar specifier. */ - -/* M2CODE = 1001 Too many tokens in a @calendar string. */ - -/* M2CODE = 1002 Time indicated is JD but no numeric portion */ -/* supplied. */ - -/* M2CODE = 1003 The date portion of the Julian date didn't make */ -/* it through the number parsing. */ - -/* M2CODE = 1004 No date was supplied */ - -/* M2CODE = 1005 A year was not supplied in a calendar date */ - -/* M2CODE = 1006 Ambiguous date specification. */ - -/* M2CODE = 1007 Ambiguous month specification */ - -/* M2CODE = 1008 Invalid day specification in a calendar date. */ - -/* M2CODE = 1009 Year appears as the second item without a */ -/* spelled month. */ - -/* M2CODE = 1010 Month is not spelled and is not an integer */ -/* between 1 and 12. */ - -/* M2CODE = 1011 Month not spelled and day is not between 1 and */ -/* 366. */ - -/* M2CODE = 1012 Hour portion of time is not an integer from 0 */ -/* to 23. */ - -/* M2CODE = 1013 Minutes portio of time is not an integer from */ -/* 0 to 59. */ - -/* M2CODE = 1014 Seconds must be a positive number less than 61 */ - -/* SCORE Number giving a measure of how closeness of match, 100 */ -/* points are awarded for matched keywords, 15 points */ -/* for matched classes, 100 points for matched calendar */ -/* strings. Fractions of 100 awarded for words that */ -/* look like they might be misspelled keyword. The */ -/* score is used primarily in thos cases when a substring */ -/* does not match any of a collection of templates */ -/* exactly. In this case the one that has the highest */ -/* score is regarded as being what the user probably */ -/* meant. */ - -/* CAUSE If requested, a diagnostic of mismatch. */ - -/* $ Exceptions */ - -/* The following errors are detected by this routine. */ - -/* 'SPICE(KEYWORDNOTFOUND)' */ - -/* Additional errors may be detected by SPICELIB routines called */ -/* by this routine. */ - - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is the central utility used in META/2 when attempting */ -/* to match potential sentences with language templates. It compares */ -/* simple templates with substrings of a command and produces a score */ -/* indicating the degree of match. Moreover, if requested, */ -/* diagnostics are available that indicate why a string did not */ -/* match a given template. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* It is assumed that all templates are simple META/2 templates. */ - -/* $ 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, 7-APR-1988 (WLT) (IMU) */ - -/* -& */ - - -/* Take care of the SPICE error handling first. */ - - if (pass1) { - pass1 = FALSE_; - ssizei_(&c__10, best); - ssizei_(&c__10, scores); - ssizec_(&c__10, known, (ftnlen)32); - scardc_(&c__1, known, (ftnlen)32); - } - slen = i_len(string, string_len); - s_copy(cause, " ", cause_len, (ftnlen)1); - *score = 0; - tbegin = *tbeg; - sbegin = *sbeg; - error = FALSE_; - *m2code = 0; - mspell = 0; - kb = 0; - ke = 0; - nkey = cardc_(keywds, keywds_len); - -/* Locate the next word of the template. */ - - fndnwd_(temp, &tbegin, &tb, &te, temp_len); - while(tb != 0 && ! error) { - -/* Zero out the keyword pointers. */ - - kb = 0; - ke = 0; - endok = FALSE_; - -/* Examine the current template word. Is there a range template */ -/* attatched? */ - - orignl = tb; - m2begr_(temp, &tb, &te, &lower, &upper, temp_len); - -/* Locate the boundaries of the root of this template word. */ - - m2trim_(temp + (tb - 1), root, te - (tb - 1), (ftnlen)32); - tc = qrtrim_(root, (ftnlen)32) - 1 + tb; - -/* If TB changed from its original value there is a range template */ -/* attached to the word TEMP(TB:TE). The associated values are in */ -/* LOWER and UPPER. */ - - keytbe = m2keyw_(temp + (tb - 1), te - (tb - 1)); - calwrd = s_cmp(temp + (tb - 1), "@calendar", tc - (tb - 1), (ftnlen)9) - == 0 && ! keytbe; - if (orignl < tb || calwrd) { - -/* Yes. There is a range template attatched. Is it of */ -/* variable length? */ - - if (calwrd) { - lower = 1; - upper = 40; - timeb = sbegin; - } - if (lower != upper) { - -/* Yes. The template has a variable length. Determine */ -/* what delimiters might signal the end of a matching */ -/* substring of word from string. */ - -/* Possibilities are: The end of the string (USEEND) */ -/* One of the listed KEYWDS (USELST) */ -/* A keyword listed in TEMP. (USEKEY) */ - -/* Right now we don't know which of the three cases to use. */ - - useend = FALSE_; - uselst = FALSE_; - usekey = FALSE_; - endok = FALSE_; - endchk = te + 1; - -/* If the end of the current template word, was not */ -/* at the end of the template, then there might be */ -/* a keyword next. Look for the next word to find out. */ - - fndnwd_(temp, &endchk, &kb, &ke, temp_len); - if (ke > 0) { - -/* There is a word in the template that follows */ -/* our current template word. See if it is a keyword. */ - - if (m2keyw_(temp + (kb - 1), ke - (kb - 1))) { - -/* If it is a keyword, it will be used as the */ -/* delimiter for a sequence of words in STRING. */ -/* ( Note we only want to work with the root of this */ -/* template word. ) */ - - usekey = TRUE_; - m2trim_(temp + (kb - 1), root, ke - (kb - 1), (ftnlen) - 32); - ke = qrtrim_(root, (ftnlen)32) + kb - 1; - } else { - -/* Its not a keyword. Bad, Bad. The user was not */ -/* using META/2 properly. */ - - chkin_("M2MTCH", (ftnlen)6); - setmsg_("M2MTCH: Any META-KEY that is preceded by a " - "variable length range template in a specific" - "ation statement must be followed by a keywor" - "d. ", (ftnlen)134); - sigerr_("SPICE(KEYWORDNOTFOUND)", (ftnlen)22); - chkout_("M2MTCH", (ftnlen)6); - return 0; - } - } else if (ke <= 0) { - -/* We got to this point because there was nothing */ -/* to look at beyond where we were in TEMP. So we */ -/* either use one of the listed keywords or the end */ -/* of the string will be our delimiter. */ - - if (nkey > 0) { - uselst = TRUE_; - endok = esrchc_("@end", &nkey, keywds + keywds_len * - 6, (ftnlen)4, keywds_len) != 0; - } else { - useend = TRUE_; - } - } - -/* Until we have detected one of the keywords */ -/* or we have not matched the current class */ -/* or we run out of words in the sentence */ - -/* Grab the next word of the sentence */ -/* Check it for keyword . */ -/* Check it for class . */ - - endit = FALSE_; - keywrd = FALSE_; - mcount = 0; - suffsb = 0; - oversb = 0; - overse = 0; - lastsb = sbegin; - lastse = pos_(string, " ", &sbegin, string_len, (ftnlen)1) - - 1; - while(! endit) { - -/* Fetch the next word of the sentence. */ - - fndnwd_(string, &sbegin, &sb, &se, string_len); - -/* If there WAS a next word SE will not be zero. */ - - if (se == 0) { - keywrd = useend || endok; - endit = TRUE_; - -/* BEGOUT will point past the matched portion of the */ -/* string. If no errors occur, it will be used to */ -/* set SBEG on output. */ - - begout = slen + 1; - } else { - -/* is this a delimiting word for a variable length */ -/* list? */ - - if (uselst) { - keywrd = esrchc_(string + (sb - 1), &nkey, keywds - + keywds_len * 6, se - (sb - 1), - keywds_len) != 0; - endit = keywrd; - if (keywrd) { - -/* Mark the position just before the beginning */ -/* of this word in STRING so that SBEG will */ -/* point to the first word past the end of */ -/* the matched portion of STRING. */ - - begout = sb - 1; - } - } else if (usekey) { - keywrd = m2wmch_(string, &sb, &se, temp + (kb - 1) - , string_len, ke - (kb - 1)) && m2keyw_( - temp + (kb - 1), ke - (kb - 1)); - endit = keywrd; - -/* Mark the position of the "next" character */ -/* in the string beyond the end of the current */ -/* STRING word. */ - - begout = se + 1; - } - -/* If we didn't bump into a keyword this must */ -/* be (or should be) another of the words specified */ -/* by the META-KEY TEMP(TB:TE) */ - - if (! keywrd) { - cmatch = m2wmch_(string, &sb, &se, temp + (tb - 1) - , string_len, te - (tb - 1)); - if (cmatch) { - ++mcount; - -/* Mark the position of the first character */ -/* beyond the end of the current STRING */ -/* word. */ - - begout = se + 1; - -/* If MCOUNT has gotten too big, record the */ -/* begin and end of the "bad" portion of the */ -/* substring. */ - - if (mcount == lower + 1) { - -/* Mark the location of the beginning */ -/* and end of this word in case we need to */ -/* backtrack to here. */ - - suffsb = sb; - suffse = se; - } else if (mcount <= upper) { - -/* Mark the end of this word in case */ -/* we need it later. */ - - suffse = se; - } else if (mcount == upper + 1) { - oversb = sb; - overse = se; - } else if (mcount > upper) { - overse = se; - } - } else { - endit = TRUE_; - } - } - lastsb = sb; - lastse = se; - } - -/* Set the pointer to the input string to the first */ -/* character past the end of the current word. */ - - sbegin = se + 1; - } - -/* We're now at the end of the loop matching words of STRING */ -/* with the class of object that had a variable length */ -/* template. */ - -/* The question now is: 'Did we get out of the loop in */ -/* a healthy or unhealthy way?' */ - - -/* Did we have the required range of items in the class? */ -/* Did we hit the keyword? */ - -/* If both questions were answered YES, */ - - if (keywrd && mcount >= lower && mcount <= upper) { - -/* Increment the score by METASC times the number of */ -/* words found in the variable length template plus */ -/* KEYSC for getting the keyword right. */ - - if (! calwrd) { - *score = *score + mcount * 15 + 100; - if (usekey) { - -/* set the end of the last template word used to */ -/* be the end of the keyword that we just hit. */ - - te = ke; - } - } else { - s_copy(mssg, " ", (ftnlen)420, (ftnlen)1); - m2cal_(string + (timeb - 1), mssg, &tcode, suffse - ( - timeb - 1), (ftnlen)420); - if (tcode == 0) { - *score += 200; - } else { - *score += 100; - error = TRUE_; - if (*m2code == 0) { - *m2code = tcode + 1000; - } - if (*reason) { - s_copy(cause, "I was not able to parse the c" - "alendar string \"", cause_len, ( - ftnlen)45); - suffix_(string + (timeb - 1), &c__0, cause, - suffse - (timeb - 1), cause_len); - suffix_("\". ", &c__0, cause, (ftnlen)3, - cause_len); - suffix_(mssg, &c__1, cause, (ftnlen)420, - cause_len); - m2mark_(string, &timeb, &suffse, cause, - string_len, cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - } - } - -/* If less than the required range but a keyword was found */ -/* the error was: " not enough values loaded. " */ - - } else if (keywrd && mcount < lower) { - inttxt_(&lower, lowerc, (ftnlen)64); - inttxt_(&mcount, countc, (ftnlen)64); - lcase_(lowerc, lowerc, (ftnlen)64, (ftnlen)64); - lcase_(countc, countc, (ftnlen)64, (ftnlen)64); - error = TRUE_; - if (*m2code == 0) { - *m2code = 101; - } - -/* We grant METASC points for every word of the current */ -/* class that was found, but we subtract METASC points */ -/* for each item we were short. That is: */ - -/* MCOUNT + ( LOWER - MCOUNT ) = 2*MCOUNT - LOWER */ - -/* Computing MAX */ - i__1 = 0, i__2 = (mcount << 1) - lower; - *score += max(i__1,i__2) * 15; - -/* Add on KEYSC points for getting the correct keyword. */ - - *score += 100; - if (*reason) { - s_copy(cause, "I was expecting to see at least # # a" - "t this point in the command string. I counte" - "d #. ", cause_len, (ftnlen)86); - m2clss_(temp + (tb - 1), &lower, phrase, tc - (tb - 1) - , (ftnlen)120); - repmc_(cause, "#", lowerc, cause, cause_len, (ftnlen) - 1, (ftnlen)64, cause_len); - repmc_(cause, "#", phrase, cause, cause_len, (ftnlen) - 1, (ftnlen)120, cause_len); - repmc_(cause, "#", countc, cause, cause_len, (ftnlen) - 1, (ftnlen)64, cause_len); - -/* OK. now we want to tack on the string and keep */ -/* track of where the current word STRING(SB:SE) */ -/* will get put. */ - - m2mark_(string, &lastsb, &lastse, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len) - ; - } - -/* If more than the required range but a keyword was found */ -/* the error was too many values loaded. */ - - } else if (keywrd && mcount > upper) { - inttxt_(&upper, upperc, (ftnlen)64); - inttxt_(&mcount, countc, (ftnlen)64); - lcase_(upperc, upperc, (ftnlen)64, (ftnlen)64); - lcase_(countc, countc, (ftnlen)64, (ftnlen)64); - error = TRUE_; - if (*m2code == 0) { - *m2code = 102; - } - -/* We grant METASC points for every word of the current */ -/* class that was found prior to the cutoff limit. */ -/* But we subtract METASC points for each extra item. */ -/* That is: */ - -/* UPPER + ( MCOUNT - UPPER ) = 2*UPPER - MCOUNT */ - -/* Computing MAX */ - i__1 = 0, i__2 = (upper << 1) - mcount; - *score += max(i__1,i__2) * 15; - -/* Add on KEYSC points for getting the correct keyword. */ - - *score += 100; - if (*reason) { - s_copy(cause, "I was expecting to see at most # #. I" - " counted #. I've marked the location of the " - "problem for you. ", cause_len, (ftnlen)98); - m2clss_(temp + (tb - 1), &upper, phrase, tc - (tb - 1) - , (ftnlen)120); - repmc_(cause, "#", upperc, cause, cause_len, (ftnlen) - 1, (ftnlen)64, cause_len); - repmc_(cause, "#", phrase, cause, cause_len, (ftnlen) - 1, (ftnlen)120, cause_len); - repmc_(cause, "#", countc, cause, cause_len, (ftnlen) - 1, (ftnlen)64, cause_len); - m2mark_(string, &oversb, &overse, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len) - ; - } - -/* If required range but no keyword, error could be */ -/* misspelled keyword ( we estimate this ) or keyword */ -/* was missing. */ - - } else if (mcount >= lower && mcount <= upper) { - -/* Add METASC points to the score for each of the */ -/* words encountered. */ - - if (se == 0) { - -/* We are going to try to see if we had a spelling */ -/* error that caused us to run out of string */ - - fndnwd_(string, &suffsb, &db, &de, string_len); - orignl = suffsb; - count = lower + 1; - bscore = 0; - dcount = 0; - while(count <= mcount) { - if (usekey) { - s_copy(known + 192, temp + (kb - 1), (ftnlen) - 32, ke - (kb - 1)); - -/* Compare the last word encountered in the */ -/* string with the KEYWORD we were expecting. */ - - bestwd_(string + (db - 1), known, cutoff, - best, scores, mssg, de - (db - 1), ( - ftnlen)32, (ftnlen)420); - } else if (uselst) { - -/* Compare the last word that we hit with one */ -/* of the keywords from the list of possible */ -/* closing keywords. */ - - bestwd_(string + (db - 1), keywds, cutoff, - best, scores, mssg, de - (db - 1), - keywds_len, (ftnlen)420); - } - if (cardi_(scores) > 0 && scores[6] >= *cutoff) { - -/* We are going to treat this as a spelling */ -/* error. */ - - if (*m2code == 0) { - *m2code = 13; - } - -/* Save the beginning and ending of the */ -/* problem word for use in the recovery */ -/* entry point. */ - - if (scores[6] > bscore) { - bscore = scores[6]; - pbeg = db; - pend = de; - -/* Everything up to this is now regarded */ -/* as simply matching the META-KEY. Store */ -/* this number of META-KEYs for use by */ -/* diagnostics generation. */ - - dcount = count - 1; - } - } - suffsb = de + 1; - -/* Look at the next word until we have gone */ -/* past UPPER even if we already have a */ -/* candidate for misspelling, there might be */ -/* a better one. */ - - fndnwd_(string, &suffsb, &db, &de, string_len); - ++count; - } - -/* Save the misspelling information associated */ -/* with the best match (if there was one). */ - - if (bscore > 0) { - if (usekey) { - s_copy(known + 192, temp + (kb - 1), (ftnlen) - 32, ke - (kb - 1)); - -/* Compare the last word encountered in the */ -/* string with the KEYWORD we were expecting. */ - - bestwd_(string + (pbeg - 1), known, cutoff, - best, scores, mssg, pend - (pbeg - 1), - (ftnlen)32, (ftnlen)420); - } else if (uselst) { - -/* Compare the last word that we hit with one */ -/* of the keywords from the list of possible */ -/* closing keywords. */ - - bestwd_(string + (pbeg - 1), keywds, cutoff, - best, scores, mssg, pend - (pbeg - 1), - keywds_len, (ftnlen)420); - -/* Save the best matches for use in the */ -/* recovery entry point. */ - - i__1 = cardi_(best); - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(known + (((i__2 = i__ + 5) < 16 && - 0 <= i__2 ? i__2 : s_rnge("known", - i__2, "m2core_", (ftnlen)1202)) - << 5), keywds + (best[(i__3 = i__ - + 5) < 16 && 0 <= i__3 ? i__3 : - s_rnge("best", i__3, "m2core_", ( - ftnlen)1202)] + 5) * keywds_len, ( - ftnlen)32, keywds_len); - } - i__1 = cardi_(best); - scardc_(&i__1, known, (ftnlen)32); - } - -/* This is not regarded as an error worth */ -/* stopping for unless our */ -/* misspelling total has runs over 100. */ - - mspell += 100 - bscore; - if (mspell < 100) { - *score = *score + dcount * 15 + bscore; - -/* Back the value of SBEGIN back up to the */ -/* point of failure, so that we can continue */ -/* processing as if nothing had gone wrong. */ - - sbegin = pend + 1; - } else { - *score += dcount * 15; - error = TRUE_; - } - } else { - -/* Restore the initial value of SUFFSB */ - - suffsb = orignl; - *score += mcount * 15; - if (*m2code == 0) { - *m2code = 103; - } - -/* This occurs if we ran out of stuff in STRING */ -/* and we were looking to find a keyword instead. */ - - error = TRUE_; - } - if (usekey && *reason) { - s_copy(cause, "I was looking for the keyword \"", - cause_len, (ftnlen)31); - suffix_(temp + (kb - 1), &c__1, cause, ke - (kb - - 1), cause_len); - suffix_("\" when I reached the", &c__1, cause, ( - ftnlen)20, cause_len); - suffix_("end of the input ", &c__1, cause, ( - ftnlen)17, cause_len); - suffix_("command. ", &c__1, cause, (ftnlen)9, - cause_len); - } else if (uselst && *reason) { - s_copy(cause, "I was looking for one of the keyw" - "ords that follow when I reached the end " - "of the input command. Keywords: {", - cause_len, (ftnlen)107); - i__1 = nkey; - for (i__ = 1; i__ <= i__1; ++i__) { - suffix_(keywds + (i__ + 5) * keywds_len, & - c__2, cause, keywds_len, cause_len); - suffix_(",", &c__0, cause, (ftnlen)1, - cause_len); - } - i__1 = qlstnb_(cause, cause_len) - 1; - s_copy(cause + i__1, " }.", cause_len - i__1, ( - ftnlen)3); - } - if (*reason && bscore != 0) { - s_copy(cause + cause_len, cause, cause_len, - cause_len); - s_copy(cause, " ", cause_len, (ftnlen)1); - suffix_(mssg, &c__1, cause, (ftnlen)420, - cause_len); - m2mark_(string, &pbeg, &pend, cause, string_len, - cause_len); - suffix_(mssg, &c__1, cause + cause_len, (ftnlen) - 420, cause_len); - m2mark_(string, &pbeg, &pend, cause + cause_len, - string_len, cause_len); - } else if (*reason) { - m2mark_(string, &lastsb, &lastse, cause, - string_len, cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - -/* Recall that we are examining the case when the number */ -/* of word matches is within the expected range, but */ -/* no keyword was present. We have already looked at */ -/* what to do if we ran out of string prematurely. */ - - } else if (se > 0) { - *score += mcount * 15; - -/* We ran into something unexepected. Possibly */ -/* a misspelled keyword. See if any of the */ -/* expected keywords are close to what we got. */ - - if (useend) { - error = TRUE_; - if (*m2code == 0) { - *m2code = 104; - } - if (*reason) { - s_copy(cause, "The input command contains ex" - "tra characters that are not part of " - "a valid command. ", cause_len, ( - ftnlen)83); - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - } else if (usekey || uselst) { - if (usekey) { - s_copy(known + 192, temp + (kb - 1), (ftnlen) - 32, ke - (kb - 1)); - -/* Compare the last word encountered in the */ -/* string with the KEYWORD we were expecting. */ - - bestwd_(string + (sb - 1), known, cutoff, - best, scores, mssg, se - (sb - 1), ( - ftnlen)32, (ftnlen)420); - } else if (uselst) { - -/* Compare the last word that we hit with one */ -/* of the keywords from the list of possible */ -/* closing keywords. */ - - bestwd_(string + (sb - 1), keywds, cutoff, - best, scores, mssg, se - (sb - 1), - keywds_len, (ftnlen)420); - -/* Save the best matches for use in the recovery */ -/* entry point. */ - - i__1 = cardi_(best); - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(known + (((i__2 = i__ + 5) < 16 && - 0 <= i__2 ? i__2 : s_rnge("known", - i__2, "m2core_", (ftnlen)1362)) - << 5), keywds + (best[(i__3 = i__ - + 5) < 16 && 0 <= i__3 ? i__3 : - s_rnge("best", i__3, "m2core_", ( - ftnlen)1362)] + 5) * keywds_len, ( - ftnlen)32, keywds_len); - } - i__1 = cardi_(best); - scardc_(&i__1, known, (ftnlen)32); - } - -/* We are still checking out the case in which we */ -/* had a correct range of words for a variable */ -/* length template, but ran into */ -/* something that was not a terminating keyword */ -/* that we were expecting. Possibly we hit a */ -/* mispelled keyword. */ - -/* Well? Was there anything to the rumor of a */ -/* spelling error? */ - - if (cardi_(scores) > 0 && scores[6] >= *cutoff) { - if (*m2code == 0) { - *m2code = 10; - -/* Save the beginning and ending of the */ -/* problem word for use in the recovery */ -/* entry point. */ - - pbeg = sb; - pend = se; - } - -/* This is probably a spelling error. */ -/* Point out the error. */ - - mspell += 100 - scores[6]; - if (mspell < 100) { - *score += scores[6]; - } else { - error = TRUE_; - } - if (*reason) { - -/* Construct an error message indicating */ -/* the spelling diagnostic. */ - - error = TRUE_; - } - } else if (cardi_(scores) == 0 || scores[6] < * - cutoff) { - -/* This is not a misspelling. */ -/* Set the error flag */ - - error = TRUE_; - if (*m2code == 0) { - *m2code = 105; - } - s_copy(mssg, " ", (ftnlen)420, (ftnlen)1); - } - if (*reason && usekey) { - s_copy(cause, "I was looking for the ", - cause_len, (ftnlen)22); - suffix_("keyword \"", &c__1, cause, (ftnlen)9, - cause_len); - suffix_(temp + (kb - 1), &c__0, cause, ke - ( - kb - 1), cause_len); - suffix_("\" when I ", &c__0, cause, (ftnlen)9, - cause_len); - suffix_("encountered ", &c__1, cause, (ftnlen) - 12, cause_len); - suffix_("the word \"", &c__1, cause, (ftnlen) - 10, cause_len); - suffix_(string + (sb - 1), &c__0, cause, se - - (sb - 1), cause_len); - suffix_("\". ", &c__0, cause, (ftnlen)5, - cause_len); - suffix_(mssg, &c__1, cause, (ftnlen)420, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - s_copy(cause, mssg, cause_len, (ftnlen)420); - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - m2mark_(string, &sb, &se, cause + cause_len, - string_len, cause_len); - } else if (*reason && uselst) { - s_copy(cause, "I was looking for one of the " - "keywords in the list: { ", cause_len, - (ftnlen)53); - i__1 = nkey; - for (i__ = 1; i__ <= i__1; ++i__) { - suffix_(keywds + (i__ + 5) * keywds_len, & - c__1, cause, keywds_len, - cause_len); - if (i__ != nkey) { - suffix_(",", &c__0, cause, (ftnlen)1, - cause_len); - } - } - suffix_("} when I ", &c__1, cause, (ftnlen) - 10, cause_len); - suffix_("encountered ", &c__1, cause, (ftnlen) - 12, cause_len); - suffix_("the word \"", &c__1, cause, (ftnlen) - 10, cause_len); - suffix_(string + (sb - 1), &c__0, cause, se - - (sb - 1), cause_len); - suffix_("\". ", &c__0, cause, (ftnlen)5, - cause_len); - suffix_(mssg, &c__1, cause, (ftnlen)420, - cause_len); - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - } - } - -/* If out of range and no keyword then we don't have */ -/* a good guess as to what went wrong. */ - - } else if (! keywrd && (mcount < lower || mcount > upper)) { - if (mcount < lower) { - if (*m2code == 0) { - *m2code = 106; - } -/* Computing MAX */ - i__1 = 0, i__2 = (mcount << 1) - lower; - *score += max(i__1,i__2) * 15; - error = TRUE_; - } else if (mcount > upper) { - if (usekey || uselst) { - -/* We are going to try to see if we had a spelling */ -/* error that caused us to get too many words. */ - - fndnwd_(string, &suffsb, &db, &de, string_len); - count = lower + 1; - bscore = 0; - dcount = 0; - while(count <= upper + 1) { - if (usekey) { - s_copy(known + 192, temp + (kb - 1), ( - ftnlen)32, ke - (kb - 1)); - -/* Compare the last word encountered in the */ -/* string with the KEYWORD we were expecting. */ - - bestwd_(string + (db - 1), known, cutoff, - best, scores, mssg, de - (db - 1), - (ftnlen)32, (ftnlen)420); - } else if (uselst) { - -/* Compare the last word that we hit with one */ -/* of the keywords from the list of possible */ -/* closing keywords. */ - - bestwd_(string + (db - 1), keywds, cutoff, - best, scores, mssg, de - (db - 1) - , keywds_len, (ftnlen)420); - } - if (cardi_(scores) > 0 && scores[6] >= * - cutoff) { - -/* We are going to treat this as a spelling */ -/* error. */ - - if (*m2code == 0) { - *m2code = 12; - } - -/* Save the beginning and ending of the */ -/* problem word for use in the recovery */ -/* entry point. */ - - if (scores[6] > bscore) { - bscore = scores[6]; - pbeg = db; - pend = de; - -/* Everything up to this is now regarded */ -/* as simply matching the META-KEY. Store */ -/* this number of META-KEYs for use by */ -/* diagnostics generation. */ - - dcount = count - 1; - } - } - suffsb = de + 1; - -/* Look at the next word until we have gone */ -/* past UPPER even if we already have a */ -/* candidate for misspelling, there might be */ -/* a better one. */ - - fndnwd_(string, &suffsb, &db, &de, string_len) - ; - ++count; - } - -/* Save the misspelling information associated */ -/* with the best match (if there was one). */ - - if (bscore > 0) { - if (usekey) { - s_copy(known + 192, temp + (kb - 1), ( - ftnlen)32, ke - (kb - 1)); - -/* Compare the last word encountered in the */ -/* string with the KEYWORD we were expecting. */ - - bestwd_(string + (pbeg - 1), known, - cutoff, best, scores, mssg, pend - - (pbeg - 1), (ftnlen)32, (ftnlen) - 420); - } else if (uselst) { - -/* Compare the last word that we hit with one */ -/* of the keywords from the list of possible */ -/* closing keywords. */ - - bestwd_(string + (pbeg - 1), keywds, - cutoff, best, scores, mssg, pend - - (pbeg - 1), keywds_len, (ftnlen) - 420); - -/* Save the best matches for use in the */ -/* recovery entry point. */ - - i__1 = cardi_(best); - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(known + (((i__2 = i__ + 5) < - 16 && 0 <= i__2 ? i__2 : - s_rnge("known", i__2, "m2cor" - "e_", (ftnlen)1625)) << 5), - keywds + (best[(i__3 = i__ + - 5) < 16 && 0 <= i__3 ? i__3 : - s_rnge("best", i__3, "m2core_" - , (ftnlen)1625)] + 5) * - keywds_len, (ftnlen)32, - keywds_len); - } - i__1 = cardi_(best); - scardc_(&i__1, known, (ftnlen)32); - } - -/* This is not regarded as an error worth */ -/* stopping for unless our */ -/* misspelling total has runs over 100. */ - - mspell += 100 - bscore; - if (mspell < 100) { - *score = *score + dcount * 15 + bscore; - -/* Back the value of SBEGIN back up to the */ -/* point of failure, so that we can continue */ -/* processing as if nothing had gone wrong. */ - - sbegin = pend + 1; - } else { - *score += dcount * 15; - error = TRUE_; - } - } - } - -/* We might not have had a good candidate for a */ -/* misspelling, if not we don't have a good clue */ -/* as to what went wrong. */ - - if (*m2code == 0) { - *m2code = 107; -/* Computing MAX */ - i__1 = 0, i__2 = (upper << 1) - mcount; - *score += max(i__1,i__2) * 15; - error = TRUE_; - } - } - -/* If there is to be a diagnostic generated, set up */ -/* the beginning of it so that everyone else can */ -/* share in the same work. */ - - if (*reason) { - error = TRUE_; - s_copy(cause, "I was expecting to see between # and " - "# # ", cause_len, (ftnlen)41); - m2clss_(temp + (tb - 1), &upper, phrase, tc - (tb - 1) - , (ftnlen)120); - repmc_(cause, "#", lowerc, cause, cause_len, (ftnlen) - 1, (ftnlen)64, cause_len); - repmc_(cause, "#", upperc, cause, cause_len, (ftnlen) - 1, (ftnlen)64, cause_len); - repmc_(cause, "#", phrase, cause, cause_len, (ftnlen) - 1, (ftnlen)120, cause_len); - if (usekey) { - suffix_("followed by ", &c__1, cause, (ftnlen)12, - cause_len); - suffix_("the keyword, ", &c__1, cause, (ftnlen)13, - cause_len); - suffix_(temp + (kb - 1), &c__1, cause, ke - (kb - - 1), cause_len); - suffix_(".", &c__0, cause, (ftnlen)1, cause_len); - } else if (uselst) { - suffix_("followed by ", &c__1, cause, (ftnlen)12, - cause_len); - suffix_("one of the ", &c__1, cause, (ftnlen)11, - cause_len); - suffix_("keywords from the", &c__1, cause, ( - ftnlen)17, cause_len); - suffix_("list {", &c__1, cause, (ftnlen)6, - cause_len); - i__1 = nkey; - for (i__ = 1; i__ <= i__1; ++i__) { - suffix_(keywds + (i__ + 5) * keywds_len, & - c__1, cause, keywds_len, cause_len); - if (i__ != nkey) { - suffix_(",", &c__1, cause, (ftnlen)1, - cause_len); - } - } - suffix_("}.", &c__1, cause, (ftnlen)2, cause_len); - } else if (useend) { - suffix_("filling out the ", &c__1, cause, ( - ftnlen)18, cause_len); - suffix_("end of the string.", &c__1, cause, ( - ftnlen)18, cause_len); - } - -/* Use the information stored in M2CODE to determine */ -/* how many words we encountered before we figured */ -/* out we had an error. */ - - if (*m2code >= 100) { - inttxt_(&mcount, countc, (ftnlen)64); - lcase_(countc, countc, (ftnlen)64, (ftnlen)64); - } else { - inttxt_(&dcount, countc, (ftnlen)64); - lcase_(countc, countc, (ftnlen)64, (ftnlen)64); - } - suffix_("I had counted ", &c__1, cause, (ftnlen)14, - cause_len); - suffix_(countc, &c__1, cause, (ftnlen)64, cause_len); - if (mcount == 1) { - suffix_("such word", &c__1, cause, (ftnlen)9, - cause_len); - } else { - suffix_("such words", &c__1, cause, (ftnlen)10, - cause_len); - } - suffix_("when I encountered", &c__1, cause, (ftnlen) - 18, cause_len); - } - -/* We are still in the case of a variable length template */ -/* for which we did not hit a keyword and did not have */ -/* the expected range of items for the current META-KEY. */ - -/* OK. Now tailor the end of the message to reflect */ -/* what went wrong in particular. */ - - if (*reason && *m2code < 100) { - suffix_("the word \"", &c__1, cause, (ftnlen)10, - cause_len); - suffix_(string + (pbeg - 1), &c__0, cause, pend - ( - pbeg - 1), cause_len); - suffix_("\" .", &c__0, cause, (ftnlen)3, cause_len); - suffix_(mssg, &c__1, cause, (ftnlen)420, cause_len); - m2mark_(string, &pbeg, &pend, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len) - ; - } else if (*reason && se == 0) { - suffix_("the end of the input", &c__1, cause, (ftnlen) - 20, cause_len); - suffix_("string. ", &c__1, cause, (ftnlen)11, - cause_len); - i__1 = qlstnb_(string, string_len) + 1; - i__2 = qlstnb_(string, string_len) + 1; - m2mark_(string, &i__1, &i__2, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len) - ; - -/* check for a misspell. */ - - } else if (*reason && se != 0) { - suffix_("the word \"", &c__1, cause, (ftnlen)10, - cause_len); - suffix_(string + (sb - 1), &c__0, cause, se - (sb - 1) - , cause_len); - suffix_("\" .", &c__0, cause, (ftnlen)3, cause_len); - -/* If misspell likely mention that too. */ - - if (usekey) { - s_copy(known + 192, temp + (kb - 1), (ftnlen)32, - ke - (kb - 1)); - bestwd_(string + (sb - 1), known, cutoff, best, - scores, mssg, se - (sb - 1), (ftnlen)32, ( - ftnlen)420); - } else if (uselst) { - bestwd_(string + (sb - 1), keywds, cutoff, best, - scores, mssg, se - (sb - 1), keywds_len, ( - ftnlen)420); - } - if (cardi_(scores) > 0 && scores[6] > *cutoff) { - suffix_(mssg, &c__1, cause, (ftnlen)420, - cause_len); - } - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len) - ; - } - } - } else { - -/* This "ELSE" is the "NO" response to the question: "Ok. */ -/* we have a range template. Is it of variable length?" */ - - endit = lower == 0; - mcount = 0; - while(! endit) { - fndnwd_(string, &sbegin, &sb, &se, string_len); - if (se == 0) { - endit = TRUE_; - error = TRUE_; - if (*m2code == 0) { - *m2code = 108; - } - if (*reason) { - s_copy(cause, "I was expecting to see # # when I" - " ran out of words in the command string. " - , cause_len, (ftnlen)74); - m2clss_(temp + (tb - 1), &c__1, phrase, tc - (tb - - 1), (ftnlen)120); - ana_(ch__1, (ftnlen)2, phrase, "L", (ftnlen)120, ( - ftnlen)1); - s_copy(artcle, ch__1, (ftnlen)2, (ftnlen)2); - repmc_(cause, "#", artcle, cause, cause_len, ( - ftnlen)1, (ftnlen)2, cause_len); - repmc_(cause, "#", phrase, cause, cause_len, ( - ftnlen)1, (ftnlen)120, cause_len); - i__1 = qlstnb_(string, string_len) + 1; - i__2 = qlstnb_(string, string_len) + 1; - m2mark_(string, &i__1, &i__2, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - } else if (m2wmch_(string, &sb, &se, temp + (tb - 1), - string_len, te - (tb - 1))) { - ++mcount; - *score += 15; - sbegin = se + 1; - -/* Mark the position of the first character beyond the */ -/* current STRING word. */ - - begout = sbegin; - endit = mcount >= lower; - } else { - if (*m2code == 0) { - *m2code = 109; - } - error = TRUE_; - endit = TRUE_; - if (*reason) { - s_copy(cause, "I was expecting to see # # when I" - " encounterd the word \"#\" in the comman" - "d. ", cause_len, (ftnlen)74); - m2clss_(temp + (tb - 1), &c__1, phrase, tc - (tb - - 1), (ftnlen)120); - ana_(ch__1, (ftnlen)2, phrase, "L", (ftnlen)120, ( - ftnlen)1); - s_copy(artcle, ch__1, (ftnlen)2, (ftnlen)2); - repmc_(cause, "#", artcle, cause, cause_len, ( - ftnlen)1, (ftnlen)2, cause_len); - repmc_(cause, "#", phrase, cause, cause_len, ( - ftnlen)1, (ftnlen)120, cause_len); - repmc_(cause, "#", string + (sb - 1), cause, - cause_len, (ftnlen)1, se - (sb - 1), - cause_len); - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - } - } - } - } else { - fndnwd_(string, &sbegin, &sb, &se, string_len); - -/* This "ELSE" is the "NO" response to the question: "Is a */ -/* range template present?" that was asked a very long, long */ -/* time ago. */ - - cmatch = m2wmch_(string, &sb, &se, temp + (tb - 1), string_len, - te - (tb - 1)); - -/* Set the string pointer to the first character following */ -/* the current string word. */ - - sbegin = se + 1; - -/* Record SBEGIN in case we have run out of teplate and */ -/* haven't produced any errors. */ - - begout = sbegin; - if (cmatch) { - keywrd = m2keyw_(temp + (tb - 1), te - (tb - 1)); - if (keywrd) { - *score += 100; - } else { - *score += 15; - } - } else if (! cmatch) { - keywrd = m2keyw_(temp + (tb - 1), te - (tb - 1)); - -/* See if we were supposed to get a keyword and if */ -/* so see if this is just some simple spelling error. */ - - if (keywrd) { - s_copy(known + 192, temp + (tb - 1), (ftnlen)32, tc - (tb - - 1)); - scardc_(&c__1, known, (ftnlen)32); - if (se > 0) { - bestwd_(string + (sb - 1), known, cutoff, best, - scores, mssg, se - (sb - 1), (ftnlen)32, ( - ftnlen)420); - } - if (cardi_(scores) > 0 && scores[6] >= *cutoff) { - if (*m2code == 0) { - *m2code = 11; - -/* Save the beginning and ending of the */ -/* problem word for use in the recovery */ -/* entry point. */ - - pbeg = sb; - pend = se; - } - -/* We regard this to be a spelling error of the */ -/* keyword. This will be a signal to stop looking at */ -/* this keyword if we are asking for diagnostics. */ - - if (mspell > 100) { - error = TRUE_; - } else { - *score += scores[6]; - mspell += 100 - scores[6]; - } - if (*reason) { - error = TRUE_; - s_copy(cause, "I was expecting to see the keywor" - "d \"", cause_len, (ftnlen)36); - suffix_(temp + (tb - 1), &c__0, cause, tc - (tb - - 1), cause_len); - suffix_("\" when I encountered", &c__0, cause, ( - ftnlen)20, cause_len); - suffix_("the word \"", &c__1, cause, (ftnlen)10, - cause_len); - suffix_(string + (sb - 1), &c__0, cause, se - (sb - - 1), cause_len); - suffix_("\" in the input ", &c__0, cause, (ftnlen) - 15, cause_len); - suffix_("string. ", &c__1, cause, (ftnlen)12, - cause_len); - suffix_(mssg, &c__1, cause, (ftnlen)420, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - s_copy(cause, mssg, cause_len, (ftnlen)420); - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - m2mark_(string, &sb, &se, cause + cause_len, - string_len, cause_len); - } - } else if (cardi_(scores) == 0 || scores[6] < *cutoff) { - error = TRUE_; - if (*m2code == 0) { - *m2code = 110; - if (se > 0) { - bestwd_(string + (sb - 1), known, &c__1, best, - scores, mssg, se - (sb - 1), (ftnlen) - 32, (ftnlen)420); - } - if (sb != 0 && cardi_(scores) > 0) { - *score += scores[6]; - } - } - if (*reason) { - s_copy(cause, "I was expecting to see the keywor" - "d \"", cause_len, (ftnlen)36); - suffix_(temp + (tb - 1), &c__0, cause, tc - (tb - - 1), cause_len); - suffix_("\" when I ", &c__0, cause, (ftnlen)9, - cause_len); - if (sb == 0) { - suffix_("ran out of ", &c__1, cause, (ftnlen) - 11, cause_len); - suffix_("characters in the", &c__1, cause, ( - ftnlen)17, cause_len); - suffix_("input string. ", &c__1, cause, ( - ftnlen)14, cause_len); - sb = qlstnb_(string, string_len) + 1; - se = sb; - } else { - suffix_("encountered", &c__1, cause, (ftnlen) - 11, cause_len); - suffix_("the word \"", &c__1, cause, (ftnlen) - 10, cause_len); - suffix_(string + (sb - 1), &c__0, cause, se - - (sb - 1), cause_len); - suffix_("\" in the input ", &c__0, cause, ( - ftnlen)15, cause_len); - suffix_("string. ", &c__1, cause, (ftnlen) - 12, cause_len); - } - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, - cause_len); - } - } - } else if (! m2keyw_(temp + (tb - 1), te - (tb - 1))) { - error = TRUE_; - if (*m2code == 0) { - *m2code = 111; - } - if (*reason) { - s_copy(cause, "I was expecting to see # # when I ", - cause_len, (ftnlen)34); - m2clss_(temp + (tb - 1), &c__1, phrase, tc - (tb - 1), - (ftnlen)120); - ana_(ch__1, (ftnlen)2, phrase, "L", (ftnlen)120, ( - ftnlen)1); - s_copy(artcle, ch__1, (ftnlen)2, (ftnlen)2); - repmc_(cause, "#", artcle, cause, cause_len, (ftnlen) - 1, (ftnlen)2, cause_len); - repmc_(cause, "#", phrase, cause, cause_len, (ftnlen) - 1, (ftnlen)120, cause_len); - if (sb == 0) { - suffix_("ran out of characters", &c__1, cause, ( - ftnlen)21, cause_len); - suffix_("in the input string. ", &c__1, cause, ( - ftnlen)21, cause_len); - sb = qlstnb_(string, string_len) + 1; - se = sb; - } else { - suffix_("encountered the word \"", &c__1, cause, ( - ftnlen)22, cause_len); - suffix_(string + (sb - 1), &c__0, cause, se - (sb - - 1), cause_len); - suffix_("\" in the input string.", &c__0, cause, ( - ftnlen)22, cause_len); - } - m2mark_(string, &sb, &se, cause, string_len, - cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len) - ; - } - } - } - } - tbegin = max(ke,te) + 1; - -/* Locate the next word of the template and continue unless */ -/* we get a second error detected. */ - - fndnwd_(temp, &tbegin, &tb, &te, temp_len); - } - -/* If we got out of the template without an error, set SBEG to */ -/* BEGOUT---the first character after the matched portion of the */ -/* STRING and before the first word of whatever is left. */ - - if (*m2code == 0) { - *sbeg = begout; - } - return 0; - -/* $Prodedure M2RCVR ( Recover from a spelling error ) */ - - -L_m2rcvr: - -/* $ Abstract */ - -/* Fetch the indices of the beginning and end of a "misspelled" */ -/* keyword along with the list of corrections. */ - -/* $ 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 */ - -/* The META/2 book. */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* INTEGER SBEG */ -/* INTEGER SEND */ -/* CHARACTER*(*) KEYWDS ( LBCELL: * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SBEG O Beginning of "misspelled" word in STRING */ -/* SEND O Ending of "misspelled" word in STRING */ -/* KEYWDS O Cell of possible correct spellings of keyword. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* SBEG Beginning of "misspelled" word in STRING */ - -/* SEND Ending of "misspelled" word in STRING */ - -/* KEYWDS Cell of possible correct spellings of keyword. */ - -/* $ Error_Handling */ - -/* No errors are detected by this entry point. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - - -/* $ Examples */ - - -/* $ Restrictions */ - -/* One must call M2MTCH before calling this routine if correct */ -/* results are desired. */ - -/* $ 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, 7-APR-1988 (WLT) (IMU) */ - -/* -& */ - - *sbeg = pbeg; - *send = pend; - copyc_(known, keywds, (ftnlen)32, keywds_len); - return 0; -} /* m2core_ */ - -/* Subroutine */ int m2core_(char *temp, integer *tbeg, char *keywds, char * - string, integer *sbeg, logical *reason, integer *cutoff, integer * - m2code, integer *score, char *cause, integer *send, ftnlen temp_len, - ftnlen keywds_len, ftnlen string_len, ftnlen cause_len) -{ - return m2core_0_(0, temp, tbeg, keywds, string, sbeg, reason, cutoff, - m2code, score, cause, send, temp_len, keywds_len, string_len, - cause_len); - } - -/* Subroutine */ int m2mtch_(char *temp, integer *tbeg, char *keywds, char * - string, integer *sbeg, logical *reason, integer *cutoff, integer * - m2code, integer *score, char *cause, ftnlen temp_len, ftnlen - keywds_len, ftnlen string_len, ftnlen cause_len) -{ - return m2core_0_(1, temp, tbeg, keywds, string, sbeg, reason, cutoff, - m2code, score, cause, (integer *)0, temp_len, keywds_len, - string_len, cause_len); - } - -/* Subroutine */ int m2rcvr_(integer *sbeg, integer *send, char *keywds, - ftnlen keywds_len) -{ - return m2core_0_(2, (char *)0, (integer *)0, keywds, (char *)0, sbeg, ( - logical *)0, (integer *)0, (integer *)0, (integer *)0, (char *)0, - send, (ftnint)0, keywds_len, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/m2day.c b/ext/spice/src/csupport/m2day.c deleted file mode 100644 index 3718786d99..0000000000 --- a/ext/spice/src/csupport/m2day.c +++ /dev/null @@ -1,230 +0,0 @@ -/* m2day.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2DAY ( Determine whether or not a word is a day ) */ -logical m2day_(char *word, ftnlen word_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__, value; - extern integer ltrim_(char *, ftnlen); - static integer i1, i2, i3, length, values[256]; - extern integer qrtrim_(char *, ftnlen); - -/* $ Abstract */ - -/* This function is true if the input string is a day 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 a META/2 day. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2DAY returns as .TRUE. if WORD is a META/2 day. */ -/* 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 day in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2DAY */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* 1 .TRUE. */ -/* 0.289E19 .FALSE. */ -/* 0.2728D12 .FALSE. */ -/* -12.1892e-5 .FALSE. */ -/* 12 .TRUE. */ -/* 12.E291 .FALSE. */ -/* 1.2E10 .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 */ - - if (first) { - first = FALSE_; - -/* We will construct a value for the string by taking */ -/* the non-blank portion and computing the value assuming */ -/* that the first non-blank is a digit with the appropriate */ -/* power of 10 attached. Since all non-digit characters */ -/* will have values of 1000, we will get a value greater */ -/* than 1000 if any non-digit characters are present. */ - - for (i__ = 0; i__ <= 255; ++i__) { - values[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "m2day_", (ftnlen)169)] = 1000; - } - values[(i__1 = '0') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)172)] = 0; - values[(i__1 = '1') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)173)] = 1; - values[(i__1 = '2') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)174)] = 2; - values[(i__1 = '3') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)175)] = 3; - values[(i__1 = '4') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)176)] = 4; - values[(i__1 = '5') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)177)] = 5; - values[(i__1 = '6') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)178)] = 6; - values[(i__1 = '7') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)179)] = 7; - values[(i__1 = '8') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)180)] = 8; - values[(i__1 = '9') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2day_", (ftnlen)181)] = 9; - } - -/* Make sure the string has the right length. */ - - i1 = ltrim_(word, word_len); - i3 = qrtrim_(word, word_len); - length = i3 - i1 + 1; - -/* Rule out the goofy cases that NPARSD will allow. */ - - if (length > 3) { - value = 1000; - } else if (length == 3) { - i2 = i1 + 1; - value = values[(i__1 = *(unsigned char *)&word[i1 - 1]) < 256 && 0 <= - i__1 ? i__1 : s_rnge("values", i__1, "m2day_", (ftnlen)204)] * - 100 + values[(i__2 = *(unsigned char *)&word[i2 - 1]) < 256 - && 0 <= i__2 ? i__2 : s_rnge("values", i__2, "m2day_", ( - ftnlen)204)] * 10 + values[(i__3 = *(unsigned char *)&word[i3 - - 1]) < 256 && 0 <= i__3 ? i__3 : s_rnge("values", i__3, - "m2day_", (ftnlen)204)]; - } else if (length == 2) { - value = values[(i__1 = *(unsigned char *)&word[i1 - 1]) < 256 && 0 <= - i__1 ? i__1 : s_rnge("values", i__1, "m2day_", (ftnlen)211)] * - 10 + values[(i__2 = *(unsigned char *)&word[i3 - 1]) < 256 && - 0 <= i__2 ? i__2 : s_rnge("values", i__2, "m2day_", (ftnlen) - 211)]; - } else { - value = values[(i__1 = *(unsigned char *)&word[i1 - 1]) < 256 && 0 <= - i__1 ? i__1 : s_rnge("values", i__1, "m2day_", (ftnlen)215)]; - } - -/* That's all just make sure that the value is within the */ -/* bound required of a day of month or year. */ - - ret_val = value >= 1 && value <= 366; - return ret_val; -} /* m2day_ */ - diff --git a/ext/spice/src/csupport/m2diag.c b/ext/spice/src/csupport/m2diag.c deleted file mode 100644 index f7c16d8d2f..0000000000 --- a/ext/spice/src/csupport/m2diag.c +++ /dev/null @@ -1,570 +0,0 @@ -/* m2diag.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2DIAG ( META/2 diagnostics formatting utility. ) */ -/* Subroutine */ int m2diag_0_(int n__, char *filler, char *begmrk, char * - endmrk, char *string, integer *sb, integer *se, char *messge, ftnlen - filler_len, ftnlen begmrk_len, ftnlen endmrk_len, ftnlen string_len, - ftnlen messge_len) -{ - /* Initialized data */ - - static char fill[80] = " " - " "; - static integer pad = 1; - static char bmark[16] = ".....< "; - static char emark[16] = ">..... "; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer bpad, b, e; - extern /* Subroutine */ int zzinssub_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer place; - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - -/* $ Abstract */ - -/* This routine contains the two entry points M2SERR and M2MARK that */ -/* are used by META/2 template matching routines. It serves as */ -/* a diagnostic formatting utility. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* See the entry point headers for description of each of the */ -/* input/output arguements. */ -/* $ Detailed_Input */ - -/* See individual entry points. */ - -/* $ Detailed_Output */ - -/* See individual entry points. */ - -/* $ Exceptions */ - -/* See individual entry points. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine is a dummy that serves as an home for the entry */ -/* points M2SERR and M2MARK that are utility formatting routines */ -/* used by the template matching routines of META/2. */ - -/* $ Examples */ - -/* To set the markers and filler used to offset the marked portion */ -/* of a command that fails syntax checking, call the routine */ - -/* M2SERR */ - -/* To append a marked command to a diagnostic message call M2MARK. */ - -/* $ Restrictions */ - -/* See the entry points for appropriate restrictions. */ - -/* $ 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 */ - - -/* Beta Version 1.0.0, 1-JUN-1988 (WLT) (IMU) */ - -/* -& */ - -/* Entry points */ - -/* M2MARK */ -/* M2SERR */ - - -/* SPICELIB functions */ - - -/* Local variables */ - - switch(n__) { - case 1: goto L_m2serr; - case 2: goto L_m2mark; - } - - return 0; -/* $Procedure M2SERR ( Set the META/2 error markers ) */ - -L_m2serr: -/* $ Abstract */ - -/* Set the error markers and padding between the end of the error */ -/* message and the beginning of the marked copy of the input string */ -/* in diagnostic messages. */ - -/* $ 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 */ - -/* The META/2 book. */ - -/* $ Keywords */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) FILLER */ -/* CHARACTER*(*) BEGMRK */ -/* CHARACTER*(*) ENDMRK */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILLER I string to leave between message and marked string */ -/* BEGMRK I String to put at beginning of marked part of string */ -/* ENDMRK I String to put at end of marked part of string */ - -/* $ Detailed_Input */ - -/* FILLER substring to leave between message and marked string */ - -/* BEGMRK String to put at beginning of marked part of string */ - -/* ENDMRK String to put at end of marked part of string */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Error_Handling */ - -/* No errors are detected by this entry point. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to set the space padding between the */ -/* diagnostic message produced by a META/2 routine and to */ -/* select what strings that will be used to mark the location */ -/* of a problem that occured in in the input string when */ -/* attempting to match a template. */ - -/* Since diagnostic messages can be quite long, it is important */ -/* to be able to set a space between the end of the diagnostic */ -/* and the start of the marked string. If the messages are to */ -/* be output through use of some kind of string breaking routine */ -/* such as the NAIF routine CUTSTR. By selecting the padding */ -/* sufficiently large you can insure that the message will break */ -/* before printing the marked string. */ - -/* $ Examples */ - -/* When printing error messages it is handy to have the marked */ -/* portion of the string appear highlighted. For a machine that */ -/* interprets VT100 escape sequences the following markers */ -/* might prove very effective. */ - -/* BEGMRK = '[7m' ! Turn on reverse video. */ -/* ENDMRK = '[0m' ! Turn off reverse video. */ - -/* SPACE = ' ' */ - -/* CALL M2SERR ( SPACE, BEGMRK, ENDMRK ) */ - - -/* When an diagnostic message comes back, the following will */ -/* code will ensure that the message is broken nicely and that */ -/* the marked string begins on a new line. */ - -/* BEG = 1 */ -/* MORE = .TRUE. */ - -/* DO WHILE ( MORE ) */ - -/* CALL CUTSTR ( CAUSE, 80, ' ,', BEG, END, MORE ) */ -/* WRITE (6,*) CAUSE(BEG:END) */ - -/* BEG = END + 1 */ - -/* END DO */ - -/* Non-printing beginning and ending markers can also be useful */ -/* in the event that you want to do your own processing of the */ -/* diagnostic message for display. */ - - -/* $ Restrictions */ - -/* The marking strings will be truncated to the first 16 characters. */ - -/* $ 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, 7-APR-1988 (WLT) (IMU) */ - -/* -& */ -/* Computing MIN */ - i__1 = 80, i__2 = i_len(filler, filler_len); - pad = min(i__1,i__2); - s_copy(bmark, begmrk, (ftnlen)16, begmrk_len); - s_copy(emark, endmrk, (ftnlen)16, endmrk_len); - s_copy(fill, filler, (ftnlen)80, filler_len); - return 0; -/* $Procedure M2MARK (META/2 Error Marking Utility) */ - -L_m2mark: -/* $ Abstract */ - -/* This is a utility routine used for constructing diagnostic */ -/* message for META2. It is not intended for genereal consumption. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) STRING */ -/* INTEGER SB */ -/* INTEGER SE */ -/* CHARACTER*(*) MESSGE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to concatenate to end of a partial message */ -/* SB I Position of first string character to mark. */ -/* SE I Position of last string character to mark. */ -/* MESSGE I/O String to append marked string to and return. */ - -/* $ Detailed_Input */ - -/* STRING is a string that contains some sequence of characters */ -/* that should be marked and then appended to a partially */ -/* constructed message string. */ - -/* SB is the index of the first character in STRING that */ -/* should be marked for output with some character string. */ - -/* SE is the index of the last character in STRING that */ -/* should be marked for output with some character string. */ - -/* MESSGE Is a partially constructed string to which the marked */ -/* string should be appended. */ - -/* $ Detailed_Output */ - -/* MESSGE is the original string concatenated with the marked */ -/* string. */ - -/* $ Exceptions. */ - -/* If MESSGE is not long enough to contain everything that should */ -/* go into it it will be truncated. */ - - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine for use in constructing messages */ -/* of the form: */ - -/* "The input string contained an unrecognized word SPIM. || */ -/* >>SPIM<< THE WHEEL." */ - -/* The inputs to the routine are */ - -/* The first part of the message */ -/* The string that was recognized to have some problem */ -/* The index of the first character of the problem. */ -/* The index of the last character of the problem. */ - -/* The actual effect of this routine is to put the string */ - -/* MESSGE(1: LASTNB(MESSGE) + 1 ) // STRING(1 :SB-1 ) */ -/* // BMARK (1 :LASTNB(BMARK)) */ -/* // STRING(SB :SE ) */ -/* // EMARK (1 :LASTNB(EMARK)) */ -/* // STRING(SB+1: ) */ - -/* Into the string MESSGE. */ - -/* In fact this is what you would probably do if standard Fortran */ -/* allowed you to perform these operations with passed length */ -/* character strings. Since you cant't this routine does it for */ -/* you cleaning up the appearance of your code and handling all of */ -/* the pathologies for you. */ - -/* $ Examples */ - -/* Inputs */ - -/* MESSGE = 'I believe the word "FILW" should have been */ -/* "FILE" in the input string. || " */ - -/* STRING = 'SEND EPHEMERIS TO FILW OUTPUT.DAT' */ -/* 123456789012345678901234567890123 */ - -/* SB = 19 */ -/* SE = 22 */ - -/* BMARK = '>>>' */ -/* EMARK = '<<<' */ - -/* Output */ - -/* MESSGE = 'I believe the word "FILW" should have been */ -/* "FILE" in the input string. || SEND EPHEMERIS */ -/* TO >>>FILW<<< OUTPUT.DAT' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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, 17-APR-1988 (WLT) */ - -/* -& */ - -/* The end of MESSGE looks like */ - -/* . . . xxx xxxxxx */ -/* ^ */ -/* | */ -/* PLACE = LASTNB(CAUSE)+PAD */ - - -/* After suffixing STRING to CAUSE with one space */ -/* it will look like: */ - - -/* . . . xx x xxxxxx string beginning */ -/* ^ */ -/* | */ -/* PLACE + 1 */ - -/* and the beginning and end of the marked string */ -/* will be at PLACE + SB and PLACE+SE respectively. */ - - b = lastnb_(bmark, (ftnlen)16); - e = lastnb_(emark, (ftnlen)16); - bpad = lastnb_(messge, messge_len) + 1; - if (pad < 1) { - place = lastnb_(messge, messge_len); - } else { - place = lastnb_(messge, messge_len) + pad; - suffix_(string, &pad, messge, string_len, messge_len); - s_copy(messge + (bpad - 1), fill, place - (bpad - 1), pad); - } - if (e > 0) { - i__1 = place + *se + 1; - zzinssub_(messge, emark, &i__1, messge, messge_len, e, messge_len); - } - if (b > 0) { - i__1 = place + *sb; - zzinssub_(messge, bmark, &i__1, messge, messge_len, b, messge_len); - } - return 0; -} /* m2diag_ */ - -/* Subroutine */ int m2diag_(char *filler, char *begmrk, char *endmrk, char * - string, integer *sb, integer *se, char *messge, ftnlen filler_len, - ftnlen begmrk_len, ftnlen endmrk_len, ftnlen string_len, ftnlen - messge_len) -{ - return m2diag_0_(0, filler, begmrk, endmrk, string, sb, se, messge, - filler_len, begmrk_len, endmrk_len, string_len, messge_len); - } - -/* Subroutine */ int m2serr_(char *filler, char *begmrk, char *endmrk, ftnlen - filler_len, ftnlen begmrk_len, ftnlen endmrk_len) -{ - return m2diag_0_(1, filler, begmrk, endmrk, (char *)0, (integer *)0, ( - integer *)0, (char *)0, filler_len, begmrk_len, endmrk_len, ( - ftnint)0, (ftnint)0); - } - -/* Subroutine */ int m2mark_(char *string, integer *sb, integer *se, char * - messge, ftnlen string_len, ftnlen messge_len) -{ - return m2diag_0_(2, (char *)0, (char *)0, (char *)0, string, sb, se, - messge, (ftnint)0, (ftnint)0, (ftnint)0, string_len, messge_len); - } - diff --git a/ext/spice/src/csupport/m2engl.c b/ext/spice/src/csupport/m2engl.c deleted file mode 100644 index 9629576643..0000000000 --- a/ext/spice/src/csupport/m2engl.c +++ /dev/null @@ -1,169 +0,0 @@ -/* m2engl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2ENGL ( Determine if a word contains all letters) */ -logical m2engl_(char *word, ftnlen word_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - static integer i__; - extern integer ltrim_(char *, ftnlen); - static integer start, length; - extern integer qrtrim_(char *, ftnlen); - static integer end; - -/* $ Abstract */ - -/* This function is true if the input string is an english word 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 english */ -/* 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 */ - -/* M2ENGL returns as .TRUE. if WORD is less than 32 characters */ -/* in length, and contains only letters. 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 english word name */ -/* in the sense of the language META/2. */ - -/* $ Examples */ - -/* WORD M2ENGL */ -/* ------- ------ */ -/* SPAM .TRUE. */ -/* _SPUD .FALSE. */ -/* THE_QUICK_BROWN_FOX .FALSE. */ -/* THE_FIRST_TIME_EVERY_I_SAW_YOUR_FACE .FALSE. */ -/* WHO?_ME? .FALSE. */ -/* D!#@!@#! .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 */ - - -/* WRDLEN is the parameter that gives the maximum allowed length */ -/* of a name. */ - - -/* Make sure the string has the right length. */ - - start = ltrim_(word, word_len); - end = qrtrim_(word, word_len); - length = end - start + 1; - ret_val = length <= 32 && length >= 1; - i__ = start; - while(ret_val && i__ <= end) { - ret_val = 'A' <= *(unsigned char *)&word[i__ - 1] && 'Z' >= *( - unsigned char *)&word[i__ - 1] || 'a' <= *(unsigned char *)& - word[i__ - 1] && 'z' >= *(unsigned char *)&word[i__ - 1]; - ++i__; - } - return ret_val; -} /* m2engl_ */ - diff --git a/ext/spice/src/csupport/m2epoc.c b/ext/spice/src/csupport/m2epoc.c deleted file mode 100644 index 16bdec090e..0000000000 --- a/ext/spice/src/csupport/m2epoc.c +++ /dev/null @@ -1,165 +0,0 @@ -/* m2epoc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2EPOC ( Determine whether or not a word is an epoch ) */ -logical m2epoc_(char *word, ftnlen word_len) -{ - /* System generated locals */ - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int m2cal_(char *, char *, integer *, ftnlen, - ftnlen); - extern logical m2mon_(char *, ftnlen); - static integer tcode; - static char error[80]; - extern logical m2time_(char *, ftnlen), m2year_(char *, ftnlen); - -/* $ Abstract */ - -/* This function is true if the input string is an epoch 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 a META/2 epoch. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2EPOC returns as .TRUE. if WORD passes throught TPARSE without */ -/* error. Otherwise M2EPOC 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 epoch in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2EPOC */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* _SPUD .FALSE. */ -/* 1:23:1927 .TRUE. */ -/* jan/1/1988 .TRUE. */ -/* 4-1-1988/24:13:48.28 .TRUE. */ -/* 1988-MAR-8/23:59:60.281 .TRUE. */ -/* 19:3:1 .FALSE. */ -/* 88-JAN-89 .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) */ - -/* -& */ - -/* SPICE functions */ - - -/* Local variables */ - - if (m2time_(word, word_len)) { - ret_val = FALSE_; - } else if (m2year_(word, word_len)) { - ret_val = TRUE_; - } else if (m2mon_(word, word_len)) { - ret_val = FALSE_; - } else { - m2cal_(word, error, &tcode, word_len, (ftnlen)80); - ret_val = s_cmp(error, " ", (ftnlen)80, (ftnlen)1) == 0; - } - return ret_val; -} /* m2epoc_ */ - diff --git a/ext/spice/src/csupport/m2geta.c b/ext/spice/src/csupport/m2geta.c deleted file mode 100644 index 87d6664330..0000000000 --- a/ext/spice/src/csupport/m2geta.c +++ /dev/null @@ -1,392 +0,0 @@ -/* m2geta.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2GETA ( META/2 --- get all of a named word ) */ -/* Subroutine */ int m2geta_(char *name__, char *string, logical *found, char - *word, ftnlen name_len, ftnlen string_len, ftnlen word_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3, i__4, i__5, i__6; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer), - s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, b[2], e[2], f, i__, l, p, w; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer m2have_(char *, ftnlen); - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Get all substrings associated with a matched, named META/2 */ -/* template word and put it into the specified WORD. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* WORD O the matching word extracted from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME and STRING could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* WORD is the full substring in STRING that corresponds to */ -/* the request specified by NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If WORD is not sufficiently large to hold all of the characters */ -/* the error 'META/2(INSUFFICIENTSPACE)' will be signalled. */ - -/* 2) If the portion of STRING extracted does not begin and end */ -/* with a word, the error 'META/2(CORRUPTEDINPUTSTRING)' will */ -/* be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract all words matching a named template word */ - -/* -& */ - -/* META/2 functions */ - - -/* Local variables */ - - -/* First look up the beginning and endings of the requested */ -/* substring. */ - - m2vget_(name__, &c__1, found, b, e, name_len); - if (! (*found)) { - return 0; - } - -/* First find out how many substrings are associated with this name. */ - - last = m2have_(name__, name_len); - if (last == 0) { - *found = FALSE_; - return 0; - } - -/* Now get the beginning and ending of all the stuff associated */ -/* with this word. */ - - m2vget_(name__, &c__1, found, b, e, name_len); - m2vget_(name__, &last, found, &b[1], &e[1], name_len); - -/* First make sure there are no obvious pathologies about the string */ -/* we are dealing with. */ - - l = i_len(string, string_len); - for (i__ = 1; i__ <= 2; ++i__) { - p = b[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("b", i__1, - "m2geta_", (ftnlen)339)] - 1; - f = e[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("e", i__1, - "m2geta_", (ftnlen)340)] + 1; - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2GETA", (ftnlen)6); - setmsg_("The input string has been modified since it passed " - "syntax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETA", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2GETA", (ftnlen)6); - setmsg_("The input string has been modified since it passed " - "syntax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETA", (ftnlen)6); - return 0; - } - } - i__1 = b[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("b", i__2, - "m2geta_", (ftnlen)367)] - 1; - i__4 = e[(i__5 = i__ - 1) < 2 && 0 <= i__5 ? i__5 : s_rnge("e", i__5, - "m2geta_", (ftnlen)367)] - 1; - if (s_cmp(string + i__1, " ", b[(i__3 = i__ - 1) < 2 && 0 <= i__3 ? - i__3 : s_rnge("b", i__3, "m2geta_", (ftnlen)367)] - i__1, ( - ftnlen)1) == 0 || s_cmp(string + i__4, " ", e[(i__6 = i__ - 1) - < 2 && 0 <= i__6 ? i__6 : s_rnge("e", i__6, "m2geta_", ( - ftnlen)367)] - i__4, (ftnlen)1) == 0) { - chkin_("M2GETA", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETA", (ftnlen)6); - return 0; - } - } - -/* Next make sure there is room to hold everything. */ - - w = i_len(word, word_len); - if (w < e[1] - b[0] + 1) { - chkin_("M2GETA", (ftnlen)6); - setmsg_("There is not sufficient space in the output string to hold " - "the requested word. ", (ftnlen)79); - sigerr_("META/2(INSUFFICIENTSPACE)", (ftnlen)25); - chkout_("M2GETA", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - i__1 = b[0] - 1; - s_copy(word, string + i__1, word_len, e[1] - i__1); - return 0; -} /* m2geta_ */ - diff --git a/ext/spice/src/csupport/m2getb.c b/ext/spice/src/csupport/m2getb.c deleted file mode 100644 index 1baeda5279..0000000000 --- a/ext/spice/src/csupport/m2getb.c +++ /dev/null @@ -1,374 +0,0 @@ -/* m2getb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2GETB ( META/2 --- get a named integer) */ -/* Subroutine */ int m2getb_(char *name__, char *string, logical *found, - integer *int__, ftnlen name_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, e, f, l, p; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer pnter; - char error[80]; - integer myint; - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), m2bodn2c_(char *, integer *, - logical *, ftnlen); - -/* $ Abstract */ - -/* Select the first substring associated with a matched, named META/2 */ -/* template word and put it parse it as an integer. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* INT O matching integer extracted and parsed from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME and STRING and NTH could be */ -/* retrieved. Otherwise it will be returned with a value */ -/* of .FALSE. */ - -/* INT is the ID-code represented by the word of STRING that */ -/* was the first matched with the NAMEd META/2 template */ -/* word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* 2) If the portion of STRING extracted cannot be parsed as an */ -/* body, the error 'META/2(CORRUPTEDBODYSPEC)' will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETB --- get and parse a body name */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETB ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETB ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETB ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract first integer matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, &c__1, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2GETB", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETB", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2GETB", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETB", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2GETB", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETB", (ftnlen)6); - return 0; - } - -/* First see if we've got a recognized name. */ - - m2bodn2c_(string + (b - 1), &myint, found, e - (b - 1)); - if (! (*found)) { - -/* Try an integer. */ - - nparsi_(string + (b - 1), &myint, error, &pnter, e - (b - 1), (ftnlen) - 80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - chkin_("M2GETB", (ftnlen)6); - setmsg_("The item requested, '#', was not a recognized body and" - " could not be parsed as an integer. ", (ftnlen)91); - errch_("#", string + (b - 1), (ftnlen)1, e - (b - 1)); - sigerr_("META/2(CORRUPTEDBODYNAME)", (ftnlen)25); - chkout_("M2GETB", (ftnlen)6); - return 0; - } - } - -/* Now do the actual assignment */ - - *found = TRUE_; - *int__ = myint; - return 0; -} /* m2getb_ */ - diff --git a/ext/spice/src/csupport/m2getc.c b/ext/spice/src/csupport/m2getc.c deleted file mode 100644 index 2e32f50734..0000000000 --- a/ext/spice/src/csupport/m2getc.c +++ /dev/null @@ -1,352 +0,0 @@ -/* m2getc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2GETC ( META/2 --- get a named word---character ) */ -/* Subroutine */ int m2getc_(char *name__, char *string, logical *found, char - *word, ftnlen name_len, ftnlen string_len, ftnlen word_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, e, f, l, p, w; - extern /* Subroutine */ int chkin_(char *, ftnlen), m2vget_(char *, - integer *, logical *, integer *, integer *, ftnlen), sigerr_(char - *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Select the first substring associated with a matched, named META/2 */ -/* template word and put it into the specified WORD. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* WORD O the matching word extracted from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME and STRING could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* WORD is the word in STRING that corresponds to the request */ -/* specified by NAME. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If WORD is not sufficiently large to hold all of the characters */ -/* the error 'META/2(INSUFFICIENTSPACE)' will be signalled. */ - -/* 2) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract first word matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, &c__1, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - w = i_len(word, word_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2GETC", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETC", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2GETC", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETC", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2GETC", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETC", (ftnlen)6); - return 0; - } - if (w < e - b + 1) { - chkin_("M2GETC", (ftnlen)6); - setmsg_("There is not sufficient space in the output string to hold " - "the requested word. ", (ftnlen)79); - sigerr_("META/2(INSUFFICIENTSPACE)", (ftnlen)25); - chkout_("M2GETC", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - s_copy(word, string + (b - 1), word_len, e - (b - 1)); - return 0; -} /* m2getc_ */ - diff --git a/ext/spice/src/csupport/m2getd.c b/ext/spice/src/csupport/m2getd.c deleted file mode 100644 index 53cf2e1fbd..0000000000 --- a/ext/spice/src/csupport/m2getd.c +++ /dev/null @@ -1,362 +0,0 @@ -/* m2getd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2GETD (META/2 --- select a named word, double precision ) */ -/* Subroutine */ int m2getd_(char *name__, char *string, logical *found, - doublereal *dp, ftnlen name_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - doublereal mydp; - integer b, e, f, l, p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer pnter; - char error[80]; - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), nparsd_(char *, doublereal *, char *, - integer *, ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Select the Nth substring associated with a matched, named META/2 */ -/* template word and parse it as a double precision number. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* DP O matching d.p. extracted and parsed from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME and STRING could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* DP is the double precision number represented by the word */ -/* of STRING that was the first match with the NAMEd */ -/* META/2 template word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* 2) If the portion of STRING extracted cannot be parsed as a */ -/* a double precision number, the error 'META/2(CORRUPTEDNUMBER)' */ -/* will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract first number matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, &c__1, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2GETD", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETD", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2GETD", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETD", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2GETD", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETD", (ftnlen)6); - return 0; - } - -/* This is supposed to be an integer double precision number. */ -/* Parse it. */ - - nparsd_(string + (b - 1), &mydp, error, &pnter, e - (b - 1), (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - chkin_("M2GETD", (ftnlen)6); - setmsg_("The item requested could not be parsed as an integer. a num" - "ber.", (ftnlen)63); - sigerr_("META/2(CORRUPTEDNUMBER)", (ftnlen)23); - chkout_("M2GETD", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - *dp = mydp; - return 0; -} /* m2getd_ */ - diff --git a/ext/spice/src/csupport/m2geti.c b/ext/spice/src/csupport/m2geti.c deleted file mode 100644 index 581fcfdc45..0000000000 --- a/ext/spice/src/csupport/m2geti.c +++ /dev/null @@ -1,363 +0,0 @@ -/* m2geti.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2GETI ( META/2 --- get a named integer) */ -/* Subroutine */ int m2geti_(char *name__, char *string, logical *found, - integer *int__, ftnlen name_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, e, f, l, p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer pnter; - char error[80]; - integer myint; - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Select the first substring associated with a matched, named META/2 */ -/* template word and put it parse it as an integer. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* INT O matching integer extracted and parsed from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME and STRING and NTH could be */ -/* retrieved. Otherwise it will be returned with a value */ -/* of .FALSE. */ - -/* INT is the integer represented by the word of STRING that */ -/* was the first matched with the NAMEd META/2 template */ -/* word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* 2) If the portion of STRING extracted cannot be parsed as an */ -/* integer, the error 'META/2(CORRUPTEDINTEGER)' will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract first integer matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, &c__1, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2GETI", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETI", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2GETI", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETI", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2GETI", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2GETI", (ftnlen)6); - return 0; - } - -/* This is supposed to be an integer double precision number. */ -/* Parse it. */ - - nparsi_(string + (b - 1), &myint, error, &pnter, e - (b - 1), (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - chkin_("M2GETI", (ftnlen)6); - setmsg_("The item requested could not be parsed as an integer.", ( - ftnlen)53); - sigerr_("META/2(CORRUPTEDINTEGER)", (ftnlen)24); - chkout_("M2GETI", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - *int__ = myint; - return 0; -} /* m2geti_ */ - diff --git a/ext/spice/src/csupport/m2gmch.c b/ext/spice/src/csupport/m2gmch.c deleted file mode 100644 index b4d121ee44..0000000000 --- a/ext/spice/src/csupport/m2gmch.c +++ /dev/null @@ -1,1080 +0,0 @@ -/* m2gmch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__64 = 64; -static integer c__1 = 1; -static integer c__0 = 0; -static logical c_false = FALSE_; -static integer c__5 = 5; - -/* $Procedure M2GMCH ( Match a META/2 template including groups ) */ -/* Subroutine */ int m2gmch_(char *temp, char *thnwds, char *string, integer * - sbeg, logical *reason, integer *cutoff, logical *pssthn, integer * - m2code, integer *score, char *cause, ftnlen temp_len, ftnlen - thnwds_len, ftnlen string_len, ftnlen cause_len) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - - /* System generated locals */ - address a__1[5]; - integer i__1, i__2, i__3[5]; - char ch__1[1184], ch__2[1265]; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - static integer tbeg, tend, tlen; - static logical more; - static char last[8]; - static integer size, tmpj, most; - extern integer upto_(char *, char *, integer *, ftnlen, ftnlen); - static integer a, b, e, i__, j, k; - extern integer cardc_(char *, ftnlen); - static integer bcode; - static char label[32]; - extern integer cardi_(integer *); - extern logical match_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int copyc_(char *, char *, ftnlen, ftnlen); - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - static char terms[32*70]; - static logical group; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int m2begr_(char *, integer *, integer *, integer - *, integer *, ftnlen); - static integer t1code; - extern /* Subroutine */ int m2keep_(void), m2mark_(char *, integer *, - integer *, char *, ftnlen, ftnlen), m2mtch_(char *, integer *, - char *, char *, integer *, logical *, integer *, integer *, - integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen), m2pclr_(void), - m2tclr_(void), m2term_(char *, char *, integer *, ftnlen, ftnlen) - , m2thnq_(char *, integer *, char *, ftnlen, ftnlen), m2trim_( - char *, char *, ftnlen, ftnlen); - extern logical m2keyw_(char *, ftnlen); - static integer bo, eo, bs, es, bw, begofg, bdiags, ew, ediags; - static logical rediag; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - static integer endofg, gmatch; - extern /* Subroutine */ int remlac_(integer *, integer *, char *, integer - *, ftnlen), scardi_(integer *, integer *); - static integer afterg; - extern /* Subroutine */ int remlai_(integer *, integer *, integer *, - integer *); - extern integer bsrchi_(integer *, integer *, integer *); - static integer bscore; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen), fndptk_(char *, char *, integer *, integer *, integer - *, ftnlen, ftnlen); - static logical simple; - static integer indxes[70]; - extern /* Subroutine */ int sigerr_(char *, ftnlen); - static integer fewest; - extern /* Subroutine */ int chkout_(char *, ftnlen); - static integer blstwd, clstwd; - static logical optdir; - static integer elstwd; - extern integer qlstnb_(char *, ftnlen); - static integer tscore; - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen); - static char keywds[32*70]; - static logical vtempl; - static char subtmp[1024]; - extern integer lstlti_(integer *, integer *, integer *); - static integer positn; - extern /* Subroutine */ int ssizei_(integer *, integer *), cmprss_(char *, - integer *, char *, char *, ftnlen, ftnlen, ftnlen), suffix_(char - *, integer *, char *, ftnlen, ftnlen); - static char swords[32*70]; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen); - static integer loc; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine will match a META/2 template that contains no */ -/* qualified @then directives. */ - -/* $ 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 */ - -/* The META/2 book. */ - -/* $ Keywords */ - -/* PARSING */ -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TEMP I A META/2 template */ -/* THNWDS I A cell of initial keywords for a following @then */ -/* STRING I A candidate META/2 sentence. */ -/* SBEG I Where to start processing this sentence */ -/* REASON I Flag indicating diagnostics should be produced. */ -/* CUTOFF I Threshold used for spelling error diagnostics. */ -/* PSSTHN O Flag to indicate we made it past a @then */ -/* M2CODE O META/2 code indicating how a match failed. */ -/* SCORE O a measure of how well STRING matched TEMP. */ -/* CAUSE O Diagnostic message if requested for non-matches. */ - -/* $ Detailed_Input */ - -/* TEMP is a META/2 template to be compared with a portion */ -/* of the candidate input sentence. */ - -/* THNWDS is a cell containing KEYWORDS that may be used as */ -/* terminators for the entire template. Typically */ -/* this cell will contain the initial keywords of */ -/* a class of templates that can be branched to from */ -/* this template. */ - -/* STRING A string, a substring of which ( STRING(SBEG:) ) */ -/* should be compared with the input META/2 template. */ - -/* SBEG is the beginning of the substring that should be */ -/* compared with TEMP. */ - -/* REASON Is a logical flag, that should be set to .TRUE. */ -/* if the user wishes to have error mismatch diagnostics */ -/* to be returned by this routine. */ - -/* CUTOFF is a parameter used to determine how close words */ -/* of STRING must match up with keywords in TEMP */ -/* in order to be diagnosed as spelling errors. */ -/* Ranges from 0 to 100 are acceptable. A "good" range */ -/* of values is from from 65 to 75. */ - -/* $ Detailed_Output */ - -/* SBEG if the match is successful, SBEG will be set to the */ -/* first word of the input string that follows the */ -/* matched substring. ( Note that words in THNWDS do */ -/* not qualify as part of the template, but merely */ -/* serve to delimit the ends of variable length */ -/* templates. Thus if one of these words was actually */ -/* used to delimit the end of TEMP, SBEG will point to */ -/* the beginning of that word in STRING.) */ - -/* PSSTHN is set only if the template matches up to an */ -/* an unqualified @then directive. In such a case */ -/* PSSTHN will be set to .TRUE. Otherwise it will not */ -/* be changed from its input value. */ - -/* M2CODE is an integer META/2 code that indicates how an attempt */ -/* to match the input failed. If the match was successful */ -/* M2CODE will be returned as zero. Otherwise it will */ -/* be returned with a positive value. Possible values */ -/* and meanings are: */ - - - -/* SCORE is a measure of how well STRING matched TEMP. This */ -/* is useful primarily when looking through several */ -/* templates, none of which yield an M2CODE of zero. In */ -/* this case, the template with the highest SCORE is */ -/* likely to be the template the input string was */ -/* "intended" to match. */ - -/* CAUSE If REASON is set to .TRUE. and the match fails */ -/* (M2CODE .NE. 0 ), this string will contain a */ -/* description of the suspected cause of the match */ -/* failure. Moreover, the input string will be "marked" */ -/* at the location of the match failure. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number of delimiting keywords is greater than 64 a */ -/* SPICE TOOLKIT error will be SIGERRled. */ - -/* SPICE(TOOMANYKEYWORDS) */ - -/* Delimiting keywords are: */ - -/* a) Keywords that immediately follow group templates. */ -/* b) Keywords that are the initial keywords of a simple template */ -/* contained within a group template. */ -/* c) The keywords passed to the routine in the cell THNWDS. */ - -/* $ Particulars */ - -/* This routine allows one to compare strings with those META/2 */ -/* language templates that do not end with a qualified-'@then'. */ -/* Moreover, it serves as the principle tool for matching the */ -/* various pieces of full META/2 templates. If a match occurs */ -/* the remainder of the string can be compared with the templates */ -/* pointed to by the @then directive. */ - - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* The maximum number of delimiting keywords is 64. */ - -/* No checks are made to see if the template supplied is in fact */ -/* a valid META/2 template. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - META/2 Configured Version 2.1.0, 08-NOV-2005 (BVS) */ - -/* Updated to remove non-standard use of duplicate arguments */ -/* in FNDNWD calls. */ - -/* - 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 2.0.0, 9-MAY-1994 (WLT) */ - -/* Added an extra blank after a carriage return "/cr" */ -/* substring in */ - -/* DIAGNS = 'I was trying to match part of the input ' ... */ -/* // 'string with one of the expresions listed ' ... */ -/* // 'here: /cr/cr ' ... */ -/* // SUBTMP(1:RTRIM(SUBTMP)) ... */ -/* // './cr/cr The expression that came closest ' ... */ -/* // 'was: /cr/cr, ' */ - -/* - 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 */ - - -/* Beta Version 1.0.0, 19-MAY-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* If this is the first pass through this routine, set the size of */ -/* the cells TERMS and INDXES */ - - if (pass1) { - pass1 = FALSE_; - ssizec_(&c__64, terms, (ftnlen)32); - ssizei_(&c__64, indxes); - ssizec_(&c__64, keywds, (ftnlen)32); - ssizec_(&c__64, swords, (ftnlen)32); - } - -/* Clear out the parse table. */ - - m2pclr_(); - -/* Collect the list of potential terminating keywords. */ - - m2term_(temp, terms, indxes, temp_len, (ftnlen)32); - -/* Append all of the '@then(*)'-keywords to the list of terminators. */ - - if (cardc_(terms, (ftnlen)32) + cardc_(thnwds, thnwds_len) >= sizec_( - terms, (ftnlen)32) - 2) { - chkin_("M2GMCH", (ftnlen)6); - sigerr_("SPICE(TOOMANYKEYWORDS)", (ftnlen)22); - chkout_("M2GMCH", (ftnlen)6); - return 0; - } - tlen = i_len(temp, temp_len) + 1; - j = cardc_(terms, (ftnlen)32) + 1; - i__1 = cardc_(thnwds, thnwds_len); - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(terms + (((i__2 = j + 5) < 70 && 0 <= i__2 ? i__2 : s_rnge( - "terms", i__2, "m2gmch_", (ftnlen)364)) << 5), thnwds + (i__ - + 5) * thnwds_len, (ftnlen)32, thnwds_len); - indxes[(i__2 = j + 5) < 70 && 0 <= i__2 ? i__2 : s_rnge("indxes", - i__2, "m2gmch_", (ftnlen)365)] = tlen; - ++j; - } - -/* Append a '@end' and a '}' to the end of the terminators, and */ -/* adjust the cardinality of the TERMS cell */ - - s_copy(terms + (((i__1 = j + 5) < 70 && 0 <= i__1 ? i__1 : s_rnge("terms", - i__1, "m2gmch_", (ftnlen)373)) << 5), "@end", (ftnlen)32, ( - ftnlen)4); - indxes[(i__1 = j + 5) < 70 && 0 <= i__1 ? i__1 : s_rnge("indxes", i__1, - "m2gmch_", (ftnlen)374)] = tlen; - ++j; - s_copy(terms + (((i__1 = j + 5) < 70 && 0 <= i__1 ? i__1 : s_rnge("terms", - i__1, "m2gmch_", (ftnlen)377)) << 5), "}", (ftnlen)32, (ftnlen)1) - ; - indxes[(i__1 = j + 5) < 70 && 0 <= i__1 ? i__1 : s_rnge("indxes", i__1, - "m2gmch_", (ftnlen)378)] = tlen; - size = cardc_(terms, (ftnlen)32) + cardc_(thnwds, thnwds_len) + 2; - scardc_(&size, terms, (ftnlen)32); - scardi_(&size, indxes); - -/* This routine will only use the portion of the template up */ -/* to a qualified @then. */ - - m2thnq_(temp, &positn, label, temp_len, (ftnlen)32); - if (positn <= i_len(temp, temp_len)) { - s_copy(temp + (positn - 1), " ", temp_len - (positn - 1), (ftnlen)1); - } - -/* Now initialize pointers and the loop control variable MORE so */ -/* that we can start the loop. */ - - tbeg = 1; - tend = 1; - more = TRUE_; - while(more) { - -/* As long as we are not told to exit */ - -/* Look at the next word, */ - - fndnwd_(temp, &tbeg, &bw, &ew, temp_len); - if (bw == 0) { - -/* There wasn't a next word. There is nothing left to do. */ -/* We set MORE to .FALSE. so that we can exit the loop. */ - - more = FALSE_; - group = FALSE_; - simple = FALSE_; - } else if (s_cmp(temp + (bw - 1), "@then", ew - (bw - 1), (ftnlen)5) - == 0) { - -/* We have an unqualified @then directive. This means that */ -/* we are on the right track as far as determining what */ -/* command we are working on. Set the PASSED-A-@then flag */ -/* (PSSTHN) to .TRUE. and the other candidates to .FALSE. */ - - *pssthn = TRUE_; - group = FALSE_; - simple = FALSE_; - tbeg = ew + 1; - tend = tbeg; - } else if (match_(temp + (bw - 1), "(%*:%*){", ew - (bw - 1), (ftnlen) - 8)) { - -/* We are about to enter a group template. Determine */ -/* the FEWEST number of simple templates in the group */ -/* that must match and the MOST that we will check. */ - - m2begr_(temp, &bw, &ew, &fewest, &most, temp_len); - group = TRUE_; - simple = FALSE_; - s_copy(last, "GROUP", (ftnlen)8, (ftnlen)5); - -/* Set up the pointers for looking for the simple */ -/* templates within this group. */ - - tbeg = ew + 1; - tend = tbeg; - } else { - -/* The only possible candidate is a simple template. */ - - group = FALSE_; - simple = TRUE_; - tbeg = bw; - s_copy(last, "SIMPLE", (ftnlen)8, (ftnlen)6); - } - if (group) { - -/* Set up the initial values for this group. We need */ - -/* 1) The number of simple template matches so far for */ -/* this group. */ - - gmatch = 0; - -/* 2) A best score of the simple templates checked so far. */ - - bscore = -1; - -/* 3) A temporary place to store the M2CODE returned for */ -/* a simple template of this group. */ - - t1code = 0; - -/* 4) The position in the full template to jump to when we are */ -/* done with this template, the beginning and the end of */ -/* the group */ - - begofg = tbeg; - endofg = upto_(temp, " }", &tbeg, temp_len, (ftnlen)2); - afterg = endofg + 3; - -/* Make sure there is a viable simple template within this */ -/* group. */ - - bs = ncpos_(temp, " ", &begofg, temp_len, (ftnlen)1); -/* Computing MIN */ - i__1 = upto_(temp, " | ", &begofg, temp_len, (ftnlen)3), i__2 = - upto_(temp, " } ", &begofg, temp_len, (ftnlen)3); - es = min(i__1,i__2); - if (bs == 0 || bs >= es || *(unsigned char *)&temp[bs - 1] == '}' - || es > endofg) { - group = FALSE_; - } - -/* Finally, if FEWEST is 1 or 0, */ -/* remove the '}' that has index equal to the index */ -/* of the '}' that is the terminator of this group. */ - - if (fewest <= 1) { - i__1 = endofg + 2; - i__2 = cardi_(indxes); - loc = bsrchi_(&i__1, &i__2, &indxes[6]); - if (loc != 0) { - i__1 = cardi_(indxes); - remlai_(&c__1, &loc, &indxes[6], &i__1); - i__1 = cardc_(terms, (ftnlen)32); - remlac_(&c__1, &loc, terms + 192, &i__1, (ftnlen)32); - i__1 = cardc_(terms, (ftnlen)32) - 1; - scardc_(&i__1, terms, (ftnlen)32); - i__1 = cardi_(indxes) - 1; - scardi_(&i__1, indxes); - } - } - while(group) { - -/* We've got a viable simple template for this group. */ - -/* If it ends with a variable template find out what the */ -/* possible terminating words are. */ - - a = 0; - b = 0; - i__1 = es + 1; - fndptk_(temp, " ", &i__1, &blstwd, &elstwd, temp_len, (ftnlen) - 1); - m2begr_(temp, &blstwd, &elstwd, &a, &b, temp_len); -/* Computing MIN */ - i__1 = elstwd, i__2 = blstwd + 8; - clstwd = min(i__1,i__2); - vtempl = a != b || ! m2keyw_(temp + (blstwd - 1), elstwd - ( - blstwd - 1)) && s_cmp("@calendar", temp + (blstwd - 1) - , (ftnlen)9, clstwd - (blstwd - 1)) == 0; - if (vtempl) { - -/* There is a variable length template, the keywords */ -/* that might terminate this template are given */ -/* in TERMS up to the first occurance of a '}'. */ - - if (gmatch < most - 1) { - i__1 = cardi_(indxes); - i__ = lstlti_(&begofg, &i__1, &indxes[6]) + 1; - } else { - i__1 = cardi_(indxes); - i__ = lstlti_(&afterg, &i__1, &indxes[6]) + 1; - } - j = 0; - while(s_cmp(terms + (((i__1 = i__ + 5) < 70 && 0 <= i__1 ? - i__1 : s_rnge("terms", i__1, "m2gmch_", (ftnlen) - 566)) << 5), "}", (ftnlen)32, (ftnlen)1) != 0) { - -/* Keep only those keywords that are not the initial */ -/* keyword of this template. */ - - if (indxes[(i__1 = i__ + 5) < 70 && 0 <= i__1 ? i__1 : - s_rnge("indxes", i__1, "m2gmch_", (ftnlen) - 573)] != bs) { - ++j; - m2trim_(terms + (((i__1 = i__ + 5) < 70 && 0 <= - i__1 ? i__1 : s_rnge("terms", i__1, "m2g" - "mch_", (ftnlen)575)) << 5), keywds + ((( - i__2 = j + 5) < 70 && 0 <= i__2 ? i__2 : - s_rnge("keywds", i__2, "m2gmch_", (ftnlen) - 575)) << 5), (ftnlen)32, (ftnlen)32); - } - ++i__; - } - scardc_(&j, keywds, (ftnlen)32); - } else { - scardc_(&c__0, keywds, (ftnlen)32); - } - -/* Check the current template with M2MTCH. */ - - if (s_cmp(temp + (bs - 1), "@options", es - (bs - 1), (ftnlen) - 8) == 0) { - t1code = -1; - tscore = -1; - } else { - -/* Dump the temporary parse table. */ - - m2tclr_(); - m2mtch_(temp + (bs - 1), &c__1, keywds, string, sbeg, & - c_false, cutoff, &t1code, &tscore, cause, es - ( - bs - 1), (ftnlen)32, string_len, cause_len); - } - -/* If the attempt at a match succeeded ... */ - - if (t1code == 0) { - -/* Increment the number of group matches by 1. */ -/* Increment the score for this template. */ -/* Set the best score obtained thus far to zero */ -/* in preparation for the next pass through the */ -/* group. */ - - ++gmatch; - *score += tscore; - bscore = -1; - -/* Move the temporary parse table to the keepers */ -/* parse table. */ - - m2keep_(); - -/* The current template should be taken off the viable */ -/* list. */ - - if (es < endofg) { - s_copy(temp + (bs - 1), " ", es + 2 - (bs - 1), ( - ftnlen)1); - } else { - fndptk_(temp, " ", &bs, &a, &b, temp_len, (ftnlen)1); - if (s_cmp(temp + (a - 1), "|", b - (a - 1), (ftnlen)1) - == 0) { - s_copy(temp + (a - 1), " ", es - (a - 1), (ftnlen) - 1); - } else { - s_copy(temp + (bs - 1), " ", es - (bs - 1), ( - ftnlen)1); - } - } - -/* Reset ES to be the one before the beginning of */ -/* the group template (BS will be set to ES + 1 */ -/* at the end of the group loop). */ - - es = begofg - 1; - -/* Adjust the possible terminating keyword set. */ -/* (remove the initial keyword of the simple template */ -/* just matched from the collection). */ - - i__1 = cardi_(indxes); - loc = bsrchi_(&bs, &i__1, &indxes[6]); - i__1 = cardi_(indxes); - remlai_(&c__1, &loc, &indxes[6], &i__1); - i__1 = cardc_(terms, (ftnlen)32); - remlac_(&c__1, &loc, terms + 192, &i__1, (ftnlen)32); - i__1 = cardc_(terms, (ftnlen)32) - 1; - scardc_(&i__1, terms, (ftnlen)32); - i__1 = cardi_(indxes) - 1; - scardi_(&i__1, indxes); - -/* Finally, if we have now exactly matched FEWEST-1, */ -/* remove the '}' that has index equal to the index */ -/* of the '}' that is the terminator of this group. */ - - if (gmatch == fewest - 1) { - i__1 = endofg + 2; - i__2 = cardi_(indxes); - loc = bsrchi_(&i__1, &i__2, &indxes[6]); - if (loc != 0) { - i__1 = cardi_(indxes); - remlai_(&c__1, &loc, &indxes[6], &i__1); - i__1 = cardc_(terms, (ftnlen)32); - remlac_(&c__1, &loc, terms + 192, &i__1, (ftnlen) - 32); - i__1 = cardc_(terms, (ftnlen)32) - 1; - scardc_(&i__1, terms, (ftnlen)32); - i__1 = cardi_(indxes) - 1; - scardi_(&i__1, indxes); - } - } - } else { - -/* Record the score if this is higher than a previous */ -/* value. */ - - if (tscore > bscore) { - bscore = tscore; - bdiags = bs; - ediags = es; - bcode = t1code; - copyc_(keywds, swords, (ftnlen)32, (ftnlen)32); - } - } - -/* Remove all introductory '@options' directives. */ - - optdir = TRUE_; - while(optdir) { - bo = ncpos_(temp, " ", &begofg, temp_len, (ftnlen)1); -/* Computing MIN */ - i__1 = upto_(temp, " | ", &begofg, temp_len, (ftnlen)3), - i__2 = upto_(temp, " } ", &begofg, temp_len, ( - ftnlen)3); - eo = min(i__1,i__2); - if (bo < eo) { - optdir = s_cmp(temp + (bo - 1), "@options", eo - (bo - - 1), (ftnlen)8) == 0; - if (optdir) { - s_copy(temp + (bo - 1), " ", eo - (bo - 1), ( - ftnlen)1); - eo += 2; - if (*(unsigned char *)&temp[eo - 1] == '|') { - *(unsigned char *)&temp[eo - 1] = ' '; - } - } - } else { - optdir = FALSE_; - } - } - -/* Should we stay in this group? Only if you can answer yes */ -/* to all of the following: */ - -/* 1.) Are more matches allowed for this group. */ - -/* 2.) Is there another template in this group that */ -/* hasn't been checked. */ - - if (gmatch >= most) { - group = FALSE_; - } else { - -/* Make sure there is a viable simple template within */ -/* this group. */ - - i__1 = es + 1; - bs = ncpos_(temp, " |", &i__1, temp_len, (ftnlen)2); -/* Computing MIN */ - i__1 = upto_(temp, " | ", &bs, temp_len, (ftnlen)3), i__2 - = upto_(temp, " } ", &bs, temp_len, (ftnlen)3); - es = min(i__1,i__2); - if (bs == 0 || bs >= es || *(unsigned char *)&temp[bs - 1] - == '}' || es > endofg) { - group = FALSE_; - } - } - } - -/* When we leave the group, see if we had a sufficient number */ -/* of matches. If we did, jump past the end of the group. */ -/* If we didn't, this is an error---head for home. */ - - optdir = i_indx(temp + (begofg - 1), " @options ", endofg - ( - begofg - 1), (ftnlen)10) != 0; - if (! optdir && gmatch >= fewest) { - tbeg = afterg; - } else if (optdir && gmatch >= most) { - if (*reason) { - cmprss_(" ", &c__1, temp + (begofg - 1), temp + (begofg - - 1), (ftnlen)1, endofg - (begofg - 1), endofg - ( - begofg - 1)); - b = begofg - 1; - e = i_indx(temp + (begofg - 1), " @options ", endofg - ( - begofg - 1), (ftnlen)10) + 1; - s_copy(cause, "I had already matched the maximum number " - "of allowed simple templates in a group without m" - "atching the following REQUIRED templates./cr/cr" - "(3:3)", cause_len, (ftnlen)142); - suffix_(temp + (b - 1), &c__1, cause, e - (b - 1), - cause_len); - suffix_("} /cr/cr(-3:-3)", &c__1, cause, (ftnlen)15, - cause_len); - *m2code = 11000; - more = FALSE_; - } - } else if (optdir && gmatch >= fewest) { - *score += bscore; - -/* If diagnostics are requested then see what went wrong */ -/* with the best fitting simple template. */ - - if (*reason) { - bs = bdiags; - es = ediags; - m2mtch_(temp + (bs - 1), &c__1, swords, string, sbeg, - reason, cutoff, &t1code, &tscore, cause, es - (bs - - 1), (ftnlen)32, string_len, cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len); - b = begofg - 1; - e = endofg + 2; - cmprss_(" ", &c__1, temp + (b - 1), subtmp, (ftnlen)1, e - - (b - 1), (ftnlen)1024); - if (i_indx(subtmp, " | ", (ftnlen)1024, (ftnlen)3) == - i_indx(subtmp, " @options ", (ftnlen)1024, ( - ftnlen)10) - 2) { - prefix_("/cr/cr(-3:)", &c__1, cause + cause_len, ( - ftnlen)11, cause_len); - prefix_(subtmp, &c__1, cause + cause_len, (ftnlen) - 1024, cause_len); - prefix_("Although I had matched a required number of" - " expressions in the group below, I had not y" - "et matched the explicitely required expressi" - "on that appears prior to the META/2 \"@optio" - "ns\" directive in the group shown here./cr(3" - ":) ", &c__1, cause + cause_len, (ftnlen)220, - cause_len); - i__1 = i_indx(subtmp, " @options ", (ftnlen)1024, ( - ftnlen)10); - k = pos_(subtmp, " | ", &i__1, (ftnlen)1024, (ftnlen) - 3); - if (k > 0 && ncpos_(string, " ", sbeg, string_len, ( - ftnlen)1) != 0) { - suffix_("/cr/cr Of the remaining simple template" - "s (including the optional ones) the one " - "that comes closest to matching is: /cr/c" - "r(3:) ", &c__1, cause + cause_len, ( - ftnlen)125, cause_len); - suffix_(temp + (bdiags - 1), &c__1, cause + - cause_len, ediags - (bdiags - 1), - cause_len); - suffix_("/cr/cr(-3:)", &c__0, cause + cause_len, ( - ftnlen)11, cause_len); - } - } else { - prefix_("/cr/cr(-3:)", &c__1, cause + cause_len, ( - ftnlen)11, cause_len); - prefix_(subtmp, &c__0, cause + cause_len, (ftnlen) - 1024, cause_len); - prefix_("Although I had matched a required number of" - " expressions in the group below, I had not y" - "et matched the explicitely required expressi" - "ons that appear prior to the META/2 \"@optio" - "ns\" directive in the group shown here. ./cr" - "/cr(3:) ", &c__1, cause + cause_len, (ftnlen) - 225, cause_len); - if (ncpos_(string, " ", sbeg, string_len, (ftnlen)1) - != 0) { - suffix_("/cr/crOf the remaining simple templates" - ", the one that comes closest to matching" - " is: /cr/cr(3:) ", &c__1, cause + - cause_len, (ftnlen)95, cause_len); - suffix_(temp + (bdiags - 1), &c__1, cause + - cause_len, ediags - (bdiags - 1), - cause_len); - suffix_("/cr/cr(-3:)", &c__0, cause + cause_len, ( - ftnlen)11, cause_len); - } - } - } - *m2code = bcode; - more = FALSE_; - } else if (gmatch < fewest) { - *score += bscore; - -/* If diagnostics are requested then see what went wrong */ -/* with the best fitting simple template. */ - - if (*reason) { - bs = bdiags; - es = ediags; - m2mtch_(temp + (bs - 1), &c__1, swords, string, sbeg, - reason, cutoff, &t1code, &tscore, cause, es - (bs - - 1), (ftnlen)32, string_len, cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len); - b = begofg - 1; - e = endofg + 2; - cmprss_(" ", &c__1, temp + (b - 1), subtmp, (ftnlen)1, e - - (b - 1), (ftnlen)1024); - if (i_indx(subtmp, " | ", (ftnlen)1024, (ftnlen)3) != 0) { - prefix_("'./cr/cr(-3:)", &c__1, cause + cause_len, ( - ftnlen)13, cause_len); - prefix_(temp + (bdiags - 1), &c__0, cause + cause_len, - ediags - (bdiags - 1), cause_len); -/* Writing concatenation */ - i__3[0] = 98, a__1[0] = "I was trying to match part " - "of the input string with one of the expressi" - "ons listed here:/cr/cr(3:) "; - i__3[1] = rtrim_(subtmp, (ftnlen)1024), a__1[1] = - subtmp; - i__3[2] = 28, a__1[2] = "./cr/cr(-3:) The expression " - ; - i__3[3] = 10, a__1[3] = "that came "; - i__3[4] = 24, a__1[4] = "closest was: /cr/cr(3:)'"; - s_cat(ch__1, a__1, i__3, &c__5, (ftnlen)1184); - prefix_(ch__1, &c__0, cause + cause_len, rtrim_( - subtmp, (ftnlen)1024) + 160, cause_len); - } else { - prefix_("'./cr/cr(-3:)", &c__1, cause + cause_len, ( - ftnlen)13, cause_len); - prefix_(temp + (bdiags - 1), &c__0, cause + cause_len, - ediags - (bdiags - 1), cause_len); - prefix_("I was trying to match part of the input str" - "ing with the expression: /cr/cr(3:) '", &c__0, - cause + cause_len, (ftnlen)80, cause_len); - } - } - *m2code = bcode; - more = FALSE_; - } - - } else if (simple) { -/* Computing MIN */ - i__1 = upto_(temp, " @then", &tbeg, temp_len, (ftnlen)6), i__2 = - upto_(temp, "){ ", &tbeg, temp_len, (ftnlen)3); - tend = min(i__1,i__2) + 1; - fndptk_(temp, " ", &tend, &blstwd, &elstwd, temp_len, (ftnlen)1); - tend = elstwd; - -/* See if the simple template ends with a variable template. */ -/* If it does, find out what the possible terminating words */ -/* are. */ - - a = 0; - b = 0; - m2begr_(temp, &blstwd, &elstwd, &a, &b, temp_len); -/* Computing MIN */ - i__1 = elstwd, i__2 = blstwd + 8; - clstwd = min(i__1,i__2); - vtempl = a != b || ! m2keyw_(temp + (blstwd - 1), elstwd - ( - blstwd - 1)) && s_cmp("@calendar", temp + (blstwd - 1), ( - ftnlen)9, clstwd - (blstwd - 1)) == 0; - if (vtempl) { - -/* There is a variable length template, the keywords */ -/* that might terminate this template are given */ -/* in TERMS up to the first occurance of a '}'. */ - - i__1 = cardi_(indxes); - i__ = lstlti_(&elstwd, &i__1, &indxes[6]) + 1; - j = 0; - -/* Just load keywords onto the list until we hit a '}' */ -/* (We are guarenteed that this will happen, because */ -/* we put a '}' on the end of the list at the beginning */ -/* of this routine.) */ - - while(s_cmp(terms + (((i__1 = i__ + 5) < 70 && 0 <= i__1 ? - i__1 : s_rnge("terms", i__1, "m2gmch_", (ftnlen)993)) - << 5), "}", (ftnlen)32, (ftnlen)1) != 0) { - ++j; - m2trim_(terms + (((i__1 = i__ + 5) < 70 && 0 <= i__1 ? - i__1 : s_rnge("terms", i__1, "m2gmch_", (ftnlen) - 996)) << 5), keywds + (((i__2 = j + 5) < 70 && 0 - <= i__2 ? i__2 : s_rnge("keywds", i__2, "m2gmch_", - (ftnlen)996)) << 5), (ftnlen)32, (ftnlen)32); - ++i__; - } - scardc_(&j, keywds, (ftnlen)32); - } else { - scardc_(&c__0, keywds, (ftnlen)32); - } - -/* Check the current template with M2MTCH. */ - - m2tclr_(); - m2mtch_(temp + (tbeg - 1), &c__1, keywds, string, sbeg, &c_false, - cutoff, &t1code, &tscore, cause, tend - (tbeg - 1), ( - ftnlen)32, string_len, cause_len); - -/* If the attempt at a match succeeded ... */ - - if (t1code == 0) { - *score += tscore; - tbeg = tend + 1; - m2keep_(); - } else { - m2mtch_(temp + (tbeg - 1), &c__1, keywds, string, sbeg, - reason, cutoff, &t1code, &tscore, cause, tend - (tbeg - - 1), (ftnlen)32, string_len, cause_len); - *score += tscore; - *m2code = t1code; - more = FALSE_; - } - } - } - -/* If there were no THNWDS and there is stuff left in the string and */ -/* we haven't already noticed, we've got an error dude. */ - - if (cardc_(thnwds, thnwds_len) == 0 && *sbeg < qlstnb_(string, string_len) - && *m2code == 0) { - -/* Until we have evidence to justify looking for probable causes */ -/* of the current overage of input string, we assume that we */ -/* are not interested in offering conjectures about what the */ -/* problem is. We'll just say there is extra stuff. */ - - rediag = FALSE_; - -/* Now look for justification of fancier diagnostics. */ - -/* Was the last thing we attempted to match part of a group */ -/* template? */ - - if (s_cmp(last, "GROUP", (ftnlen)8, (ftnlen)5) == 0 && gmatch < most) - { - -/* We are going to see if one of the options of an ending group */ -/* template looks like it was the intention of the user. */ - - if (bcode < 100) { - -/* We had a probable spelling error, set the flag to */ -/* diagnose the problem. */ - - rediag = TRUE_; - } else { - -/* Look at what the score could have been for the */ -/* simple template that was the closest match. */ - - i__ = 1; - j = bdiags; - tscore = 0; - fndnwd_(temp, &j, &i__, &tmpj, temp_len); - j = tmpj; - while(i__ != 0 && i__ < ediags) { - a = 1; - b = 1; - m2begr_(temp, &i__, &j, &a, &b, temp_len); - if (m2keyw_(temp + (i__ - 1), j - (i__ - 1))) { - tscore += 100; - } else { - tscore += a * 15; - } - fndnwd_(temp, &j, &i__, &tmpj, temp_len); - j = tmpj; - } - -/* If the score actually recorded made it at least a quarter */ -/* of the way, we will guess that this may have been the */ -/* root of the problem. */ - -/* Computing MAX */ - i__1 = *cutoff, i__2 = tscore / 4; - rediag = bscore > max(i__1,i__2); - } - } - -/* If there was sufficient grounds to warrant second guessing, */ -/* run the best guess template through M2MTCH to get a diagnostic. */ - - if (rediag) { - if (*reason) { - bs = bdiags; - es = ediags; - m2mtch_(temp + (bs - 1), &c__1, keywds, string, sbeg, reason, - cutoff, &t1code, &tscore, cause, es - (bs - 1), ( - ftnlen)32, string_len, cause_len); - s_copy(cause + cause_len, cause, cause_len, cause_len); - b = begofg - 1; - e = endofg + 2; - cmprss_(" ", &c__1, temp + (b - 1), subtmp, (ftnlen)1, e - (b - - 1), (ftnlen)1024); - if (i_indx(subtmp, " | ", (ftnlen)1024, (ftnlen)3) != 0) { - prefix_("'./cr/cr(-3:)", &c__1, cause + cause_len, ( - ftnlen)13, cause_len); - prefix_(temp + (bdiags - 1), &c__0, cause + cause_len, - ediags - (bdiags - 1), cause_len); -/* Writing concatenation */ - i__3[0] = 178, a__1[0] = "Extra words appear in the inpu" - "t string that are not part of a valid expression" - ". I think you may have been trying to supply one" - " of the optional expressions listed here:/cr/cr(" - "3:) "; - i__3[1] = rtrim_(subtmp, (ftnlen)1024), a__1[1] = subtmp; - i__3[2] = 13, a__1[2] = "/cr/cr(-3:). "; - i__3[3] = 25, a__1[3] = "The expression that came "; - i__3[4] = 25, a__1[4] = "closest was: /cr/cr(3:) '"; - s_cat(ch__2, a__1, i__3, &c__5, (ftnlen)1265); - prefix_(ch__2, &c__0, cause + cause_len, rtrim_(subtmp, ( - ftnlen)1024) + 241, cause_len); - } else { - prefix_("'./cr/cr(-3:)", &c__1, cause + cause_len, ( - ftnlen)13, cause_len); - prefix_(temp + (bdiags - 1), &c__0, cause + cause_len, - ediags - (bdiags - 1), cause_len); - prefix_("Extra words appear in the input string that are" - " not part of a valid expression. I think you may" - " have been trying to supply the optional express" - "ion:/cr/cr(3:)'", &c__0, cause + cause_len, ( - ftnlen)158, cause_len); - } - } - -/* Whatever error code we got back, add 10000 so that this */ -/* routine will have its stamp on it to indicate we are second */ -/* level guessing at what went wrong. */ - - *m2code = t1code + 10000; - } else { - -/* Sorry, we couldn't guess why there was extra stuff in the */ -/* command. Maybe just happy fingers. Anyway, just say there */ -/* was extra stuff and hit the road. */ - - if (*reason) { - s_copy(cause, "The input string contains extra words that ar" - "e not recognized as part of a valid command.", - cause_len, (ftnlen)89); - i__1 = qlstnb_(string, string_len); - m2mark_(string, sbeg, &i__1, cause, string_len, cause_len); - } - *m2code = 10200; - } - } - return 0; -} /* m2gmch_ */ - diff --git a/ext/spice/src/csupport/m2have.c b/ext/spice/src/csupport/m2have.c deleted file mode 100644 index e239ee79e1..0000000000 --- a/ext/spice/src/csupport/m2have.c +++ /dev/null @@ -1,174 +0,0 @@ -/* m2have.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2HAVE ( META/2 --- How many matches do we have ) */ -integer m2have_(char *name__, ftnlen name_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - static integer size; - extern /* Subroutine */ int m2vsiz_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Find the number of matches there were for a particular named */ -/* META/2 template word. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of a META/2 template word. */ - -/* M2HAVE is returned with the number of words that matched the */ -/* template word specified by NAME. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a META/2 template word that may have */ -/* been matched by a call to M2GMCH. The case of NAME */ -/* is significant. 'BOB', 'Bob', and 'bob' will be */ -/* regarded as different names. */ - -/* $ Detailed_Output */ - -/* M2HAVE is the number of matches that were made agains */ -/* the named META/2 template word specified by NAME. */ -/* If there were no matches, M2HAVE is returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Once a string has matched some META/2 template, one normally */ -/* needs to retrieve the information in the string. In some cases */ -/* the META/2 template will allow for a variable number of */ -/* matches with a particular template word. To extract the */ -/* information in the string, it is necessary to determine how many */ -/* words matched the template word in question. */ - -/* This routine exists so that you can easily find out how many */ -/* matches there were for a particular named template word. */ - -/* $ Examples */ - -/* Suppose that a string is known to have matched the following */ -/* META/2 template. */ - -/* FIND UNION OF (2:)@name[sets] */ - -/* To accurately carry out the task specified by this string, */ -/* you will need to find the "names" of the sets specified. */ - -/* NSETS = M2HAVE('sets') */ - -/* CALL M2GETC ( 'sets', STRING, 1, FOUND, NAME ) */ - -/* copy the named set into the set UNION. */ - -/* DO I = 2, NSETS */ - -/* CALL M2GETC ( 'sets', STRING, I, FOUND, NAME ) */ - -/* form the union of UNION with the set specified by NAME */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Check for the presence of a named match in the META/2 tables. */ - -/* -& */ - -/* Local variables */ - - -/* Find out how many endpoints were matched, and put the answer into */ -/* M2HAVE. */ - - m2vsiz_(name__, &size, name_len); - ret_val = size; - return ret_val; -} /* m2have_ */ - diff --git a/ext/spice/src/csupport/m2int.c b/ext/spice/src/csupport/m2int.c deleted file mode 100644 index 0c4d1c52c8..0000000000 --- a/ext/spice/src/csupport/m2int.c +++ /dev/null @@ -1,284 +0,0 @@ -/* m2int.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2INT ( Determine whether or not a word is an integer ) */ -logical m2int_(char *word, ftnlen word_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer zero, plus, i__, value; - extern integer ltrim_(char *, ftnlen); - static integer minus, start, factor, length; - extern integer intmin_(void), intmax_(void); - static logical usemin; - static integer subseq; - extern integer qrtrim_(char *, ftnlen); - static logical bad[256]; - static integer end; - -/* $ Abstract */ - -/* This function is true if the input string is an integer 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 a META/2 integer. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2INT returns as .TRUE. if WORD is a META/2 integer. */ -/* 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 integer in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2INT */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* 1 .TRUE. */ -/* 0.289E19 .FALSE. */ -/* 0.2728D12 .FALSE. */ -/* -12.1892e-5 .FALSE. */ -/* 12.E29 .FALSE. */ -/* 12.E291 .FALSE. */ -/* 1.2E10 .TRUE. */ -/* .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 */ - - if (first) { - first = FALSE_; - for (i__ = 0; i__ <= 255; ++i__) { - bad[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)168)] = TRUE_; - } - minus = '-'; - plus = '+'; - zero = '0'; - bad[(i__1 = '0') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)175)] = FALSE_; - bad[(i__1 = '1') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)176)] = FALSE_; - bad[(i__1 = '2') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)177)] = FALSE_; - bad[(i__1 = '3') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)178)] = FALSE_; - bad[(i__1 = '4') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)179)] = FALSE_; - bad[(i__1 = '5') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)180)] = FALSE_; - bad[(i__1 = '6') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)181)] = FALSE_; - bad[(i__1 = '7') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)182)] = FALSE_; - bad[(i__1 = '8') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)183)] = FALSE_; - bad[(i__1 = '9') < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)184)] = FALSE_; - } - start = ltrim_(word, word_len); - end = qrtrim_(word, word_len); - length = end - start + 1; - subseq = start + 1; - if (length == 1) { - bad[(i__1 = minus) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)196)] = TRUE_; - bad[(i__1 = plus) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)197)] = TRUE_; - ret_val = ! bad[(i__1 = *(unsigned char *)&word[start - 1]) < 256 && - 0 <= i__1 ? i__1 : s_rnge("bad", i__1, "m2int_", (ftnlen)199)] - ; - return ret_val; - } else if (length > 10) { - ret_val = FALSE_; - } else { - bad[(i__1 = minus) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)208)] = FALSE_; - bad[(i__1 = plus) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, - "m2int_", (ftnlen)209)] = FALSE_; - } - if (bad[(i__1 = *(unsigned char *)&word[start - 1]) < 256 && 0 <= i__1 ? - i__1 : s_rnge("bad", i__1, "m2int_", (ftnlen)213)]) { - ret_val = FALSE_; - return ret_val; - } - bad[(i__1 = minus) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, "m2in" - "t_", (ftnlen)218)] = TRUE_; - bad[(i__1 = plus) < 256 && 0 <= i__1 ? i__1 : s_rnge("bad", i__1, "m2int_" - , (ftnlen)219)] = TRUE_; - i__1 = end; - for (i__ = subseq; i__ <= i__1; ++i__) { - if (bad[(i__2 = *(unsigned char *)&word[i__ - 1]) < 256 && 0 <= i__2 ? - i__2 : s_rnge("bad", i__2, "m2int_", (ftnlen)222)]) { - ret_val = FALSE_; - return ret_val; - } - } - -/* We allow 10 digit numbers only if the first character */ -/* is a '+' or '-' So if we have 10 digits the first must */ -/* now be a "bad" character. */ - - usemin = *(unsigned char *)&word[start - 1] == minus; - if (bad[(i__1 = *(unsigned char *)&word[start - 1]) < 256 && 0 <= i__1 ? - i__1 : s_rnge("bad", i__1, "m2int_", (ftnlen)234)]) { - if (length < 11) { - ret_val = TRUE_; - return ret_val; - } - start = subseq; - } else if (length == 11) { - ret_val = FALSE_; - return ret_val; - } else if (length < 10) { - ret_val = TRUE_; - return ret_val; - } - if (usemin) { - value = intmin_(); - factor = 1; - i__1 = start + 1; - for (i__ = end; i__ >= i__1; --i__) { - value += (*(unsigned char *)&word[i__ - 1] - zero) * factor; - factor *= 10; - } - if (*(unsigned char *)&word[start - 1] > '2') { - ret_val = FALSE_; - } else { - i__ = start; - value += (*(unsigned char *)&word[i__ - 1] - zero) * factor; - ret_val = value <= 0; - } - } else { - value = intmax_(); - factor = 1; - i__1 = start + 1; - for (i__ = end; i__ >= i__1; --i__) { - value -= (*(unsigned char *)&word[i__ - 1] - zero) * factor; - factor *= 10; - } - if (*(unsigned char *)&word[start - 1] > '2') { - ret_val = FALSE_; - } else { - i__ = start; - value -= (*(unsigned char *)&word[i__ - 1] - zero) * factor; - ret_val = value >= 0; - } - } - return ret_val; -} /* m2int_ */ - diff --git a/ext/spice/src/csupport/m2ints.c b/ext/spice/src/csupport/m2ints.c deleted file mode 100644 index e6694e65fe..0000000000 --- a/ext/spice/src/csupport/m2ints.c +++ /dev/null @@ -1,268 +0,0 @@ -/* m2ints.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2INTS (Meta 2 --- initialize syntax table) */ -/* Subroutine */ int m2ints_(integer *nsyn, char *synkey, integer *synptr, - char *synval, ftnlen synkey_len, ftnlen synval_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, e, i__; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - ljust_(char *, char *, ftnlen, ftnlen), m2shll_(integer *, char *, - ftnlen), m2trim_(char *, char *, ftnlen, ftnlen), scardc_( - integer *, char *, ftnlen), scardi_(integer *, integer *), - fndnwd_(char *, integer *, integer *, integer *, ftnlen), ssizec_( - integer *, char *, ftnlen); - char keywrd[32]; - extern /* Subroutine */ int ssizei_(integer *, integer *); - char lstkey[32]; - integer put; - -/* $ Abstract */ - -/* Construct a symbol table that uses the initial keywords of */ -/* META-2 syntax definitions as the keys to the same a set of */ -/* META-2 syntax definitions. */ - -/* $ 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 definition language and parser. */ - -/* $ Keywords */ - -/* INITIALIZATION */ -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NSYN I The number of syntax definition statements. */ -/* SYNKEY O The key (names) portion of a symbol table. */ -/* SYNPTR O The pointer portion of a symbol table. */ -/* SYNVAL I/O The Meta-2 syntax statements. */ - -/* $ Detailed_Input */ - -/* NSYN is the number of syntax statements that will be */ -/* organized into an initial keyword based symbol table */ - -/* SYNVAL is a cell containing syntax definintion statements. */ -/* The defitions should be located at indices 1 through */ -/* NSYN. */ - -/* $ Detailed_Output */ - -/* SYNKEY is the names portion of a symbol table. The names */ -/* in this array will be the initial keywords of the */ -/* syntax definition statments stored in SYNVAL. Each */ -/* initial keyword will be associated with those */ -/* collection of definitions that begin with that keyword. */ - -/* SYNPTR is the pointer cell of the symbol table */ -/* SYNKEY, SYNPTR, SYNVAL */ - -/* SYNVAL is the input cell organized now as the values cell */ -/* of the symbol table SYNKEY, SYNPTR, SYNVAL. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves to initialize a syntax cell and list of */ -/* initial known keywords. This is useful primarily for META2 */ -/* languages that have all syntax definitions beginning with a */ -/* diverse set of keywords. It is anticipated that users will */ -/* use this once in a module that accepts language statements. */ - -/* if ( first ) then */ - -/* first = .false. */ -/* call m2intp ( nsyn, synkey, synptr, synval ) */ -/* end if */ - - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* This routine is intended only for use with META-2 derived */ -/* languages whose syntax statements all begin with keywords. */ -/* It is assumed that all keywords are 32 or fewer characters */ -/* in length. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 4-MAY-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - - -/* Initialize an intial keyword based META-2 syntax table */ -/* -& */ - -/* Spicelib functions. */ - - -/* Local variables. */ - - -/* Initialize the symbol table size attributes. */ - - ssizec_(nsyn, synkey, synkey_len); - ssizei_(nsyn, synptr); - ssizec_(nsyn, synval, synval_len); - -/* Just in case, left justify everything in the values cell */ -/* and set all of the pointer values to 0. */ - - i__1 = *nsyn; - for (i__ = 1; i__ <= i__1; ++i__) { - ljust_(synval + (i__ + 5) * synval_len, synval + (i__ + 5) * - synval_len, synval_len, synval_len); - synptr[i__ + 5] = 0; - } - -/* Turn the collection of syntax definitions into an array ordered */ -/* by initial keyword (minus any labels). */ - - m2shll_(nsyn, synval + synval_len * 6, synval_len); - -/* Remove any duplicates including a blank at the beginning if */ -/* there is one. */ - - put = 0; - s_copy(synval + synval_len * 5, " ", synval_len, (ftnlen)1); - i__1 = *nsyn; - for (i__ = 1; i__ <= i__1; ++i__) { - if (s_cmp(synval + (i__ + 5) * synval_len, synval + (i__ + 4) * - synval_len, synval_len, synval_len) != 0) { - ++put; - s_copy(synval + (put + 5) * synval_len, synval + (i__ + 5) * - synval_len, synval_len, synval_len); - } - } - ssizec_(nsyn, synval, synval_len); - scardc_(&put, synval, synval_len); - -/* Now we will construct the symbol table to go with this collection */ -/* of syntax definitions. */ - - s_copy(lstkey, " ", (ftnlen)32, (ftnlen)1); - put = 0; - i__1 = cardc_(synval, synval_len); - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the first word, and trim off any attached label. Note that */ -/* since this is supposed to be a keyword, there are no range */ -/* templates or qualifiers attached. */ - - fndnwd_(synval + (i__ + 5) * synval_len, &c__1, &b, &e, synval_len); - m2trim_(synval + ((i__ + 5) * synval_len + (b - 1)), keywrd, e - (b - - 1), (ftnlen)32); - ucase_(keywrd, keywrd, (ftnlen)32, (ftnlen)32); - -/* If this is a new keyword, put it into the list of keywords and */ -/* change the last keyword. */ - - if (s_cmp(keywrd, lstkey, (ftnlen)32, (ftnlen)32) != 0) { - ++put; - s_copy(synkey + (put + 5) * synkey_len, keywrd, synkey_len, ( - ftnlen)32); - s_copy(lstkey, keywrd, (ftnlen)32, (ftnlen)32); - } - -/* Increment the value in the pointer array. */ - - ++synptr[put + 5]; - } - -/* Set the cardinality of the name and pointer cells. */ - - scardc_(&put, synkey, synkey_len); - scardi_(&put, synptr); - -/* Finally, blank out all of the non-used parts of the values cell. */ - - for (i__ = -5; i__ <= -2; ++i__) { - s_copy(synval + (i__ + 5) * synval_len, " ", synval_len, (ftnlen)1); - } - return 0; -} /* m2ints_ */ - diff --git a/ext/spice/src/csupport/m2keyw.c b/ext/spice/src/csupport/m2keyw.c deleted file mode 100644 index f2200bd364..0000000000 --- a/ext/spice/src/csupport/m2keyw.c +++ /dev/null @@ -1,263 +0,0 @@ -/* m2keyw.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__20 = 20; - -/* $Procedure M2KEYW ( Determine whether or not a word is a keyword ) */ -logical m2keyw_(char *word, ftnlen word_len) -{ - /* Initialized data */ - - static char quick[4*20] = ") " "@alp" "@bod" "@cal" "@day" "@end" "@eng" - "@epo" "@int" "@mon" "@nam" "@num" "@the" "@tim" "@uni" "@wor" - "@yea" "{ " "| " "} "; - static integer checks[20] = { 0,2,1,1,1,1,2,1,2,2,2,2,2,1,2,2,1,0,0,0 }; - static integer pntrs[20] = { 0,1,3,4,5,6,7,9,10,12,14,16,18,20,21,23,25, - 25,25,25 }; - static char slow[16*25] = "@alpha " "@alpha(%*) " "@body " - " " "@calendar " "@day " "@end " - " " "@english " "@english(%*) " "@epoch " - "@int " "@int(*:*) " "@month " "@month" - "(%*) " "@name " "@name(%*) " "@number " - " " "@number(*:*) " "@then " "@then(%*) " - "@time " "@unit " "@unit(%*) " "@word " - " " "@word(%*) " "@year "; - - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__, j, k, l, blank; - static logical match; - static char cword[4]; - static integer lbrace, rbrace; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical matchw_(char *, char *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen); - static integer end; - -/* $ Abstract */ - -/* This function is true if the input string is a keyword 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 keyword. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2KEYW returns as .TRUE. if WORD is not one of the following: */ - -/* '@alpha', '@alpha(%*)', '@calendar', '@body', */ -/* '@day', */ -/* '@end' '@english', '@english(%*)', '@epoch', */ -/* '@int', '@int(*:*)' '@month', '@month(%*)', */ -/* '@name', '@name(%*)', '@number' '@number(*:*)', */ -/* '@then' '@then(%*)', '@time', '@year', */ -/* '{', '|', '}' '@unit' */ - -/* $ 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 keyword in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2KEYW */ -/* ------- ------ */ -/* @english(A*) .FALSE. */ -/* SPAM .TRUE. */ -/* | .FALSE. */ -/* 19 .TRUE. */ -/* @bug .TRUE. */ -/* @number .FALSE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - META/2 Version 3.0.0, 23-MAR-2000 (WLT) */ - -/* Extended the routine to handle the new meta-keyword @unit */ - -/* - 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 */ - - -/* We are going to look at the first four characters of the input */ -/* word. If it doesn't match one of the following, then it isn't */ -/* a meta-2 specification word, it's a keyword. The data in */ -/* this array should always be in increasing order. */ - - -/* If after checking against the previous list we have a match, */ -/* then we need to do further checks to see if we have a */ -/* legitimate meta-2 specification word. If we have a bracket or */ -/* vertical bar, we are done ( zero more checks are required ). */ -/* In other cases 1 or two more checks may be required. The */ -/* data below tells how many further checks may be required. */ - - -/* The PNTRS array points to the slot in the SLOW check array */ -/* where our matching pattern templates reside for checking */ -/* the current input word. */ - - s_copy(cword, word, (ftnlen)4, word_len); - i__ = bsrchc_(cword, &c__20, quick, (ftnlen)4, (ftnlen)4); - if (i__ == 0) { - ret_val = TRUE_; - return ret_val; - } - -/* We only want to examine the portion of the word that preceeds */ -/* a parsing qualifier. First locate the last non-blank character */ -/* of the word. */ - - lbrace = '['; - rbrace = ']'; - blank = ' '; - end = i_len(word, word_len); - while(end > 1 && *(unsigned char *)&word[end - 1] == blank) { - --end; - } - -/* If the length is not at least 4 or the last character is not */ -/* a right brace, there is no name associated with this word. */ - - if (*(unsigned char *)&word[end - 1] == rbrace && end >= 4) { - -/* Ok. We have a chance at getting a name. Look for */ -/* a left brace and if found set the name and class end. */ - - l = 2; - while(l < end - 1) { - if (*(unsigned char *)&word[l - 1] == lbrace) { - -/* We've found the beginning of the name portion */ -/* of the word. Record the end of the meta-2 */ -/* word and then reset L so that we exit this loop. */ - - end = l - 1; - l = end; - } - ++l; - } - } - ret_val = FALSE_; - k = pntrs[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("pntrs", - i__1, "m2keyw_", (ftnlen)295)]; - j = 1; - match = FALSE_; - while(j <= checks[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( - "checks", i__1, "m2keyw_", (ftnlen)299)] && ! match) { - match = matchw_(word, slow + (((i__1 = k - 1) < 25 && 0 <= i__1 ? - i__1 : s_rnge("slow", i__1, "m2keyw_", (ftnlen)302)) << 4), - "*", "%", end, (ftnlen)16, (ftnlen)1, (ftnlen)1); - ret_val = ! match; - ++k; - ++j; - } - return ret_val; -} /* m2keyw_ */ - diff --git a/ext/spice/src/csupport/m2mon.c b/ext/spice/src/csupport/m2mon.c deleted file mode 100644 index f5160c7ed8..0000000000 --- a/ext/spice/src/csupport/m2mon.c +++ /dev/null @@ -1,207 +0,0 @@ -/* m2mon.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__12 = 12; - -/* $Procedure M2MON ( Determine whether or not a word is a month ) */ -logical m2mon_(char *word, ftnlen word_len) -{ - /* Initialized data */ - - static char short__[3*12] = "APR" "AUG" "DEC" "FEB" "JAN" "JUL" "JUN" - "MAR" "MAY" "NOV" "OCT" "SEP"; - static char months[9*12] = "APRIL " "AUGUST " "DECEMBER " "FEBRUARY " - "JANUARY " "JULY " "JUNE " "MARCH " "MAY " - "NOVEMBER " "OCTOBER " "SEPTEMBER"; - - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static char copy[9]; - static integer i__; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static integer month; - extern integer ltrim_(char *, ftnlen); - static integer start; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer length; - extern integer qrtrim_(char *, ftnlen); - static integer end; - -/* $ Abstract */ - -/* This function is true if the input string is a month 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 month. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2MON returns as .TRUE. if WORD is less than 32 characters */ -/* in length, starts with an alphabetic character and */ -/* contains only letters, digits, underscores and hyphens. */ -/* 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 month in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2MON */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* JAN .TRUE. */ -/* FEBR .TRUE. */ -/* OCTA .FALSE. */ -/* AUGU .TRUE. */ -/* JU .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; - if (length < 3) { - ret_val = FALSE_; - return ret_val; - } - if (length > 9) { - ret_val = FALSE_; - return ret_val; - } - ucase_(word, copy, word_len, (ftnlen)9); - -/* See if the first three letters match anything we've got so far. */ - - month = bsrchc_(copy + (start - 1), &c__12, short__, (ftnlen)3, (ftnlen)3) - ; - if (month == 0) { - ret_val = FALSE_; - return ret_val; - } - -/* Now make sure that any remaining letters match up exactly. */ - - i__ = start + 3; - ret_val = TRUE_; - while(i__ <= end && ret_val) { - ret_val = *(unsigned char *)©[i__ - 1] == *(unsigned char *)& - months[((i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 : s_rnge( - "months", i__1, "m2mon_", (ftnlen)207)) * 9 + (i__ - 1)]; - ++i__; - } - return ret_val; -} /* m2mon_ */ - diff --git a/ext/spice/src/csupport/m2name.c b/ext/spice/src/csupport/m2name.c deleted file mode 100644 index fc5f71403c..0000000000 --- a/ext/spice/src/csupport/m2name.c +++ /dev/null @@ -1,178 +0,0 @@ -/* m2name.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2NAME ( Determine whether or not a word is a name ) */ -logical m2name_(char *word, ftnlen word_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - static integer i__; - extern integer ltrim_(char *, ftnlen); - static integer start, length; - extern integer qrtrim_(char *, ftnlen); - static integer end; - -/* $ Abstract */ - -/* This function is true if the input string is a name 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 name. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2NAME returns as .TRUE. if WORD is less than 32 characters */ -/* in length, starts with an alphabetic character and */ -/* contains only letters, digits, underscores and hyphens. */ -/* 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 name in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2NAME */ -/* ------- ------ */ -/* SPAM .TRUE. */ -/* _SPUD .FALSE. */ -/* THE_QUICK_BROWN_FOX .TRUE. */ -/* THE_FIRST_TIME_EVERY_I_SAW_YOUR_FACE .FALSE. */ -/* WHO?_ME? .FALSE. */ -/* D!#@!@#! .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 */ - - -/* WRDLEN is the parameter that gives the maximum allowed length */ -/* of a name. */ - - -/* Make sure the string has the right length. */ - - start = ltrim_(word, word_len); - end = qrtrim_(word, word_len); - length = end - start + 1; - ret_val = length <= 32 && length >= 1; - if (ret_val) { - i__ = start; - ret_val = 'A' <= *(unsigned char *)&word[i__ - 1] && 'Z' >= *( - unsigned char *)&word[i__ - 1] || 'a' <= *(unsigned char *)& - word[i__ - 1] && 'z' >= *(unsigned char *)&word[i__ - 1]; - ++i__; - } - while(ret_val && i__ <= end) { - ret_val = 'A' <= *(unsigned char *)&word[i__ - 1] && 'Z' >= *( - unsigned char *)&word[i__ - 1] || 'a' <= *(unsigned char *)& - word[i__ - 1] && 'z' >= *(unsigned char *)&word[i__ - 1] || - '0' <= *(unsigned char *)&word[i__ - 1] && '9' >= *(unsigned - char *)&word[i__ - 1] || '_' == *(unsigned char *)&word[i__ - - 1] || '-' == *(unsigned char *)&word[i__ - 1]; - ++i__; - } - return ret_val; -} /* m2name_ */ - diff --git a/ext/spice/src/csupport/m2ntem.c b/ext/spice/src/csupport/m2ntem.c deleted file mode 100644 index ba8dbbc2f1..0000000000 --- a/ext/spice/src/csupport/m2ntem.c +++ /dev/null @@ -1,224 +0,0 @@ -/* m2ntem.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2NTEM ( Parse the numeric template of a @number ) */ -/* Subroutine */ int m2ntem_(char *string, char *base, integer *beg, integer * - end, doublereal *a, doublereal *b, ftnlen string_len, ftnlen base_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - static integer last, j, k, begin; - extern doublereal dpmin_(void), dpmax_(void); - static char error[80]; - static doublereal minval; - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - static doublereal maxval; - extern integer intmin_(void), intmax_(void); - -/* $ Abstract */ - -/* Parse the numeric template of a META/2 @numeric META-KEY. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A META/2 language statement specification. */ -/* BASE I Type of META-KEY associated with this template. */ -/* BEG I/0 The beginning of the substring on input and output */ -/* END I/0 The end of the substring on input and output */ -/* A O Lower value of the numeric restriction template */ -/* B O Upper value of the numeric restriction template */ - -/* $ Detailed_Input */ - -/* STRING(BEG:END) is a word in the META/2 language. Is a META/2 */ -/* range restriction template. It has the form */ -/* (A:B) where A and B are both chracter strings */ -/* representing numbers. */ - -/* BASE is a character string and should be '@int' or */ -/* '@number'. */ - -/* $ Detailed_Output */ - -/* BEG On ouput BEG points to the first character following */ -/* the input value of END. */ - -/* END is returned unchanged. */ - -/* A is the value represented by the first numeric string */ -/* of the restriction template. If a numeric string */ -/* is not present, A is not assigned the minimum possible */ -/* value associated with the data type given in BASE. */ - -/* B is the value represented by the second numeric string */ -/* of the restriction template (if there is a second */ -/* numeric string) If no numeric string is present B is */ -/* assigned the maximum possible value associated with */ -/* the data type given in BASE. */ - - -/* $ Error_Handling */ - -/* None. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* The range restriction template is part of the META/2 language */ -/* and is described in the required reading section. Briefly it */ -/* is a string at the beginning of a word that has the form */ - -/* (A:B) */ - -/* where A is a string representing a positive integer, and */ -/* B the null string or a string representing a positive integer */ -/* greater than A. */ - -/* This routine determines if a range template is present and if so */ -/* what the values of A and B are. If A (or B )is the null string */ -/* it is assumed to represent the smallest possible (largest */ -/* possible ) number of the type indicated by BASE. */ - -/* $ Examples */ - -/* None. */ - -/* $ 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, 23-MAR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - last = *end - 1; - begin = *beg + 1; - -/* First get the min and max's for this kind of word. */ - - if (s_cmp(base, "@int", base_len, (ftnlen)4) == 0) { - minval = (doublereal) intmin_(); - maxval = (doublereal) intmax_(); - } else { - minval = dpmin_(); - maxval = dpmax_(); - } - -/* parse the restriction template */ - - if (*(unsigned char *)&string[begin - 1] == ':') { - *a = minval; - i__1 = begin; - nparsd_(string + i__1, b, error, &j, last - i__1, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - *b = maxval; - } - } else if (*(unsigned char *)&string[last - 1] == ':') { - nparsd_(string + (begin - 1), a, error, &j, last - 1 - (begin - 1), ( - ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - *a = minval; - } - *b = maxval; - } else { - j = i_indx(string + (begin - 1), ":", last - (begin - 1), (ftnlen)1) - + *beg; - nparsd_(string + (begin - 1), a, error, &k, j - 1 - (begin - 1), ( - ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - *a = minval; - } - i__1 = j; - nparsd_(string + i__1, b, error, &k, last - i__1, (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - *b = maxval; - } - } - *beg = *end + 1; - return 0; -} /* m2ntem_ */ - diff --git a/ext/spice/src/csupport/m2numb.c b/ext/spice/src/csupport/m2numb.c deleted file mode 100644 index 1ddd1a037e..0000000000 --- a/ext/spice/src/csupport/m2numb.c +++ /dev/null @@ -1,222 +0,0 @@ -/* m2numb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $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_ */ - diff --git a/ext/spice/src/csupport/m2pars.c b/ext/spice/src/csupport/m2pars.c deleted file mode 100644 index 19ec04d85b..0000000000 --- a/ext/spice/src/csupport/m2pars.c +++ /dev/null @@ -1,1254 +0,0 @@ -/* m2pars.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__100 = 100; -static integer c__400 = 400; - -/* $Procedure M2PARS ( META/2 --- Parsing utility. ) */ -/* Subroutine */ int m2pars_0_(int n__, char *name__, integer *b, integer *e, - integer *nth, logical *found, integer *size, ftnlen name_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Local variables */ - static integer vals[406], temp[400], ptrs[106], i__, j, k; - extern integer cardc_(char *, ftnlen); - static char names[32*106]; - static integer avals[406], total; - static logical gotit; - static integer aptrs[106], begend[2]; - static char anames[32*106], myname[32]; - extern integer sydimi_(char *, char *, integer *, integer *, ftnlen, - ftnlen); - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen), syfeti_( - integer *, char *, integer *, integer *, char *, logical *, - ftnlen, ftnlen), sygeti_(char *, char *, integer *, integer *, - integer *, integer *, logical *, ftnlen, ftnlen), ssizei_(integer - *, integer *), syenqi_(char *, integer *, char *, integer *, - integer *, ftnlen, ftnlen), syseli_(char *, integer *, integer *, - char *, integer *, integer *, integer *, logical *, ftnlen, - ftnlen), syputi_(char *, integer *, integer *, char *, integer *, - integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* M2PARS serves as an umbrella subroutine for a series of entry */ -/* points that serve as a storage utility for parsed words of */ -/* a string that matches a META/2 language statement template. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry Points */ -/* -------- --- -------------------------------------------------- */ -/* NAME I M2SAVE, M2VGET */ -/* B I/O M2SAVE, M2VGET */ -/* E I/O M2SAVE, M2VGET */ -/* NTH O M2VGET */ -/* FOUND O M2VGET */ -/* SIZE O M2VSIZ */ - -/* MXNAME P Maximum number of named variables that can be saved */ -/* MXVALS P Maximum number of variable values that can be saved */ - -/* $ Detailed_Input */ - -/* NAME is the variable name associated with some META/2 */ -/* template word. */ - -/* B is the index of the beginning of a word in a string */ -/* that matches the template word associated with NAME. */ - -/* E is the index of the ending of a word in a string */ -/* that matches the template word associated with NAME. */ - -/* NTH is the number of the matching substring to to locate */ -/* in the table of parsed matches. */ - -/* $ Detailed_Output */ - -/* B is the index of the beginning of a word in a string */ -/* that matches the template word associated with NAME. */ - -/* E is the index of the ending of a word in a string */ -/* that matches the template word associated with NAME. */ - -/* FOUND is a logical flag that is returned .TRUE. if */ -/* a specified named template word matched a word */ -/* in string. Otherwise it returns .FALSE. */ - -/* SIZE is the size of the set of words that matched */ -/* a particular named META/2 template word. */ - -/* $ Parameters */ - -/* MXNAME is the maximum number of named template variables that */ -/* can be saved at any time. */ - -/* MXVALS is the maximum number of name template variable values */ -/* that can be saved at any time. */ - -/* $ Exceptions */ - -/* 1) If the number of named template variables or the total number */ -/* of values exceeds the space allotted for these items, an error */ -/* will be diagnosed and signalled by a routine in the call */ -/* tree of this routine. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as an umbrella subroutine for a collection */ -/* of related entry points that are used to manage storage of */ -/* parsed words in strings that match a META/2 language template. */ - -/* These entry points cooperate to allow simple parsing of statements */ -/* that match META/2 templates. To understand how this cooperation */ -/* takes place, you need to understand how strings are matched */ -/* against META/2 templates. General META/2 templates are composed */ -/* of collections of simple templates organized via the placement */ -/* of grouping symbols. These groups are called switches. See the */ -/* META/2 required reading from a more complete description of */ -/* switches. */ - -/* Attempts to match a string with a META/2 template proceed from */ -/* left to right in both the string and template. When a switch */ -/* is encountered, an attempt is made to match the remaining */ -/* portion of the string with each simple template until a match */ -/* attempt succeeds or all attempts fail. */ - -/* The parsing portion of META/2 lies in the simple template */ -/* matching module. As words in the input string are matched with */ -/* words in the simple template, their boundaries in the string */ -/* are saved in tables located in this routine. These boundaries */ -/* can then be retrieved by the name attached to the META/2 template */ -/* word they matched. */ - -/* Since a string can match any of several templates within a switch, */ -/* several match attempts in a switch may fail before the matching */ -/* simple template is encountered. As a result, there needs to be */ -/* a mechanism for accumulating parsed matches until a full simple */ -/* template is matched. At that point the accumulated matches need */ -/* to be moved to a more stable storage area. In this way the */ -/* string can be parsed as it is matched. */ - - -/* The entry points and the functions they serve are listed here: */ - -/* M2SAVE this entry point is used to store the beginning and */ -/* ending indexes of a word in a string that matches */ -/* a named variable/word in a META/2 language template. */ - -/* M2PCLR this entry point is used to clear all stored information */ -/* in the tables containing substring indexes for matched */ -/* META/2 template words. */ - -/* M2TCLR this entry point is used to clear information stored */ -/* in the temporary accumulation tables that store */ -/* indexes for the beginning and ending of matched */ -/* META/2 template words from simple templates. */ - -/* M2KEEP is the routine that transfers the accumulated matches to */ -/* the finished set of parsed matches. */ - -/* M2VGET retrieves the N'th substring boundaries (of a string */ -/* that matches a META/2 template) that correspond to a */ -/* specific named word of the matching META/2 template. */ - -/* M2VSIZ retrieve the number of pair of indices marking beginnings */ -/* and endings of string words that matched a particular */ -/* named template word. */ - -/* Related routines exist. For use in logical expressions: */ - -/* M2XIST(NAME) will be .TRUE. if there is a marked substring */ -/* that matches a META/2 template word having name NAME. */ - -/* To determine the number of substrings associated with a given */ -/* named template word use the function: */ - -/* M2HAVE ( NAME ) */ - -/* To extract the n'th word or first word associated with a */ -/* named template word */ - -/* CALL M2SELC ( NAME, STRING, NTH, FOUND, WORD ) */ -/* CALL M2GETC ( NAME, STRING, FOUND, WORD ) */ - -/* To extract and parse the n'th integer or the first integer */ -/* associated with a named template word */ - -/* CALL M2SELI ( NAME, STRING, NTH, FOUND, INT ) */ -/* CALL M2GETI ( NAME, STRING, FOUND, INT ) */ - -/* To extract and parse the n'th number or first number associated */ -/* with a named template word */ - -/* CALL M2SELD ( NAME, STRING, NTH, FOUND, DP ) */ -/* CALL M2GETD ( NAME, STRING, FOUND, DP ) */ - -/* $ Examples */ - -/* The average user will never need to call any of the entry points */ -/* to this routine. However, it may be desirable to design a routine */ -/* that makes use of the entry points to this routine. Example */ -/* routines are outlined in each of the individual entry points. */ - -/* $ Restrictions */ - -/* See individual entry points. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 22-NOV-1991 (WLT) */ - -/* -& */ - -/* Spicelib Functions. */ - - -/* Private Parameters */ - - -/* Local Variables. */ - - switch(n__) { - case 1: goto L_m2save; - case 2: goto L_m2pclr; - case 3: goto L_m2tclr; - case 4: goto L_m2keep; - case 5: goto L_m2vget; - case 6: goto L_m2vsiz; - } - - return 0; -/* $Procedure M2SAVE ( META/2 --- save substring boundaries ) */ - -L_m2save: -/* $ Abstract */ - -/* Store the substring boundaries of a word that matches a META/2 */ -/* template word. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER B */ -/* INTEGER E */ - - -/* INTEGER MXNAME */ -/* PARAMETER ( MXNAME = 100 ) */ - -/* INTEGER MXVALS */ -/* PARAMETER ( MXVALS = 400 ) */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of a template word that was matched. */ -/* B I The beginning of the matching substring. */ -/* E I The ending of the matching substring. */ - -/* MXNAME P Maximum number of named variables that can be saved */ -/* MXVALS P Maximum number of variable values that can be saved */ - -/* $ Detailed_Input */ - -/* NAME is the name associated with a particular META/2 */ -/* template word that has been matched against some */ -/* word in a string. */ - -/* B is the beginning index of a word in a string that */ -/* matched the META/2 template word associated with */ -/* NAME. */ - -/* E is the ending index of a word in a string that */ -/* matched the META/2 template word associated with */ -/* NAME. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MXNAME is the maximum number of named template variables that */ -/* can be saved at any time. */ - -/* MXVALS is the maximum number of named template variable values */ -/* that can be saved at any time. */ - -/* $ Exceptions */ - -/* 1) If the table for storing string endpoints is unable to store */ -/* the input endpoints, the error will be diagnosed and signalled */ -/* by a routine in this routine's call-tree. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine provides the META/2 matching routines a place to */ -/* deposit the boundaries of words that match named META/2 template */ -/* words. It is not intendend for direct use by general users. */ - -/* $ Examples */ - -/* See the routine M2WMCH for an example of the use of this routine. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 25-NOV-1991 (WLT) */ - -/* -& */ -/* $ Index_Entry */ - -/* Save the boundaries of words matching META/2 template words */ - -/* -& */ - if (first) { - first = FALSE_; - -/* Initialize the keepers table. */ - - ssizec_(&c__100, names, (ftnlen)32); - ssizei_(&c__100, ptrs); - ssizei_(&c__400, vals); - -/* Initialize the accumulation table */ - - ssizec_(&c__100, anames, (ftnlen)32); - ssizei_(&c__100, aptrs); - ssizei_(&c__400, avals); - } - -/* Enque the new string boundaries in the accumulation table. */ - - syenqi_(name__, b, anames, aptrs, avals, name_len, (ftnlen)32); - syenqi_(name__, e, anames, aptrs, avals, name_len, (ftnlen)32); - return 0; -/* $Procedure M2PCLR ( META/2 --- Parse table clear ) */ - -L_m2pclr: -/* $ Abstract */ - -/* Clear both the accumulation and parse tables. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine clears all tables used by M2PARS that store beginning */ -/* and ends of words that match names META/2 template words. */ -/* It should never be called directly by users. */ - -/* $ Examples */ - -/* None. See the routine M2GMCH for the only instance of use of this */ -/* routine. */ - -/* $ Restrictions */ - -/* User's should not call this routine directly. It is intended */ -/* only for use as utility for META/2 software. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 25-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Clear the parse META/2 parse tables */ - -/* -& */ - first = FALSE_; - -/* Initialize the keepers table. */ - - ssizec_(&c__100, names, (ftnlen)32); - ssizei_(&c__100, ptrs); - ssizei_(&c__400, vals); - -/* Initialize the accumulation table */ - - ssizec_(&c__100, anames, (ftnlen)32); - ssizei_(&c__100, aptrs); - ssizei_(&c__400, avals); - return 0; -/* $Procedure M2TCLR ( META/2 --- Temporary parse table clear ) */ - -L_m2tclr: -/* $ Abstract */ - -/* Clear both the accumulation (temporary) parse table. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine clears the temporary (accumulation) table used */ -/* by M2PARS that stores beginning and ends of words that match */ -/* names META/2 template words. It should never be called directly */ -/* by users. */ - -/* $ Examples */ - -/* None. See the routine M2GMCH for the only instance of use of this */ -/* routine. */ - -/* $ Restrictions */ - -/* User's should not call this routine directly. It is intended */ -/* only for use as utility for META/2 software. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 25-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Clear the parse META/2 temporary parse tables */ - -/* -& */ - -/* Just in case, we initialize the keepers table if it hasn't been */ -/* initialized already. */ - - if (first) { - first = FALSE_; - -/* Initialize the keepers table. */ - - ssizec_(&c__100, names, (ftnlen)32); - ssizei_(&c__100, ptrs); - ssizei_(&c__400, vals); - } - -/* Initialize the accumulation table */ - - ssizec_(&c__100, anames, (ftnlen)32); - ssizei_(&c__100, aptrs); - ssizei_(&c__400, avals); - return 0; -/* $Procedure M2KEEP ( META/2 --- Keep temporary parse table values ) */ - -L_m2keep: -/* $ Abstract */ - -/* Copy names/value associations from the temporary (accumulation) */ -/* parse table to the long-term parse table. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine copies values from the temporary (accumulation) */ -/* parse tables into the long-term parse tables used by M2GMCH. */ -/* It should never be called directly by users. */ - -/* $ Examples */ - -/* None. See the routine M2GMCH for the only instance of use of this */ -/* routine. */ - -/* $ Restrictions */ - -/* User's should not call this routine directly. It is intended */ -/* only for use as utility for META/2 software. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 25-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Keep values in the META/2 temporary parse tables */ - -/* -& */ - -/* For each entry in the accumulation table... */ - - i__1 = cardc_(anames, (ftnlen)32); - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Find out its name, */ - - syfeti_(&i__, anames, aptrs, avals, myname, &gotit, (ftnlen)32, ( - ftnlen)32); - if (gotit) { - -/* ...extract the values. */ - - sygeti_(myname, anames, aptrs, avals, &total, temp, &gotit, ( - ftnlen)32, (ftnlen)32); - -/* and put them in the keepers table. */ - - syputi_(myname, temp, &total, names, ptrs, vals, (ftnlen)32, ( - ftnlen)32); - } - } - return 0; -/* $Procedure M2VGET ( META/2 --- Get variable ) */ - -L_m2vget: -/* $ Abstract */ - -/* Retrieve the boundaries of the Nth substring word that matches a */ -/* named META/2 template word. */ - -/* $ 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 */ - -/* PARSING */ -/* RETRIEVAL */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER NTH */ -/* LOGICAL FOUND */ -/* INTEGER B */ -/* INTEGER E */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I is the name of some variable in the parse table. */ -/* NTH I is the number of the substring boundary to get. */ -/* FOUND O is returned .TRUE. if requested data can be found. */ -/* B O is the beginning index of the matched word. */ -/* E O is the ending index of the matched word. */ - -/* $ Detailed_Input */ - -/* NAME is the name attached to some META/2 template word */ -/* that may have successfully matched a word in a */ -/* string. */ - -/* NTH is the number (in sequence) of the word substring to */ -/* locate that matched the names META/2 template word. */ - -/* $ Detailed_Output */ - -/* FOUND is .TRUE. if the requested information was available */ -/* in the parse table. Otherwise it is returned .FALSE. */ - -/* B is the beginning of the word in the string */ -/* corresponding to the requested information. */ - -/* E is the ending of the word in the string corresponding */ -/* to the requested information. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the requested variable is not present in the table or */ -/* the requested substring bounds are not available (for example */ -/* you ask for the 4th word boundaries and there are only */ -/* 3 word boundaries) then FOUND will be returned as .FALSE. */ -/* and the values of B and E will be returned unchanged. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Once a string has been matched against a META/2 template, it */ -/* usually must be parsed to determine the information content of */ -/* the string. By designing the META/2 language so that the needed */ -/* information corresponds to named words of the META/2 template, */ -/* this routine can be used to aid in the parsing of the matched */ -/* string. */ - -/* It is intended that this routine not be called very often */ -/* by programmers who make use of the META/2 interface. More */ -/* convenient high level routines exist that perform the most */ -/* frequently needed parsing functions. Nevertheless, it may */ -/* sometimes be more convenient to make direct use of this routine. */ - -/* META/2 templates allow for "variable length" words such as */ -/* (3:5)@int. A template that matches a template with such a */ -/* META/2 word will have several words that match the (3:5)@int */ -/* template word. If the template word is named as in */ - -/* (3:5)@int[COEFFICIENTS] */ - -/* you can ask for the first, second, third, etc word of the */ -/* string that matched this particular word. The call below */ -/* will locate the word index boundaries for you. */ - -/* CALL M2VGET ( 'COEFFICIENTS', NTH, FOUND, B, E ) */ - -/* You will then need to process as needed the string STRING(B:E) to */ -/* determine the actual information present in the matching string. */ - -/* $ Examples */ - -/* Suppose you wished to collect all of the string words that matched */ -/* the named META/2 template word MYWORDS. The code below would */ -/* do the job. (This assumes that you have declared the array */ -/* WORDS to be sufficiently large to hold all of the matching words.) */ - -/* C */ -/* C Start with the first word... */ -/* C */ -/* I = 1 */ -/* CALL M2VGET ( 'MYWORDS', I, FOUND, B, E ) */ - -/* DO WHILE ( FOUND ) */ - -/* WORDS(I) = STRING(B:E) */ - -/* C */ -/* C ... and continue collecting words until no more are found. */ -/* C */ -/* I = I + 1 */ -/* CALL M2VGET ( 'MYWORDS', I, FOUND, B, E ) */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 25-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Get word boundaries for words matching META/2 templates */ - -/* -& */ - -/* Look up any parsed values. */ - - *found = FALSE_; - j = (*nth << 1) - 1; - k = *nth << 1; - syseli_(name__, &j, &k, names, ptrs, vals, begend, found, name_len, ( - ftnlen)32); - if (*found) { - *b = begend[0]; - *e = begend[1]; - } - -/* That's all folks.... */ - - return 0; -/* $Procedure M2VSIZ ( META/2 --- matched variable template size ) */ - -L_m2vsiz: -/* $ Abstract */ - -/* Determine the size of the collection of words from a string that */ -/* matched a named META/2 template word. */ - -/* $ 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 */ - -/* PARSING */ - -/* $ Declarations */ - -/* CHARACTER*(*) NAME */ -/* INTEGER SIZE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of some META/2 template word. */ -/* SIZE O The number of string words that matched the word. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that a */ -/* string has been matched against. */ - -/* $ Detailed_Output */ - -/* SIZE is the size (number of members) of the collection of */ -/* words that matched the named META/2 template word */ -/* specified by NAME. If NAME does not appear in the */ -/* parse table, SIZE will be returned as zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point returns the number of words in a string that */ -/* matched a named META/2 template word. A function, M2HAVE, */ -/* also exists that returns this number and may be more convenient */ -/* in some cases. */ - -/* $ Examples */ - -/* Suppose you wished to collect all of the words that matched */ -/* a META/2 template word with name 'MYWORD'. You might use */ -/* this entry point to help determine loop boundaries. */ - -/* CALL M2VSIZ ( 'MYWORD', SIZE ) */ - -/* DO I = 1, SIZE */ -/* CALL M2VGET ( 'MYWORD', I, FOUND, B, E, ) */ -/* WORDS(I) = STRING(B:E) */ -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 26-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Find the number of words matching a META/2 template word */ - -/* -& */ - -/* Just look up the number of word boundaries and divide by two. */ - - total = sydimi_(name__, names, ptrs, vals, name_len, (ftnlen)32); - *size = total / 2; - return 0; -} /* m2pars_ */ - -/* Subroutine */ int m2pars_(char *name__, integer *b, integer *e, integer * - nth, logical *found, integer *size, ftnlen name_len) -{ - return m2pars_0_(0, name__, b, e, nth, found, size, name_len); - } - -/* Subroutine */ int m2save_(char *name__, integer *b, integer *e, ftnlen - name_len) -{ - return m2pars_0_(1, name__, b, e, (integer *)0, (logical *)0, (integer *) - 0, name_len); - } - -/* Subroutine */ int m2pclr_(void) -{ - return m2pars_0_(2, (char *)0, (integer *)0, (integer *)0, (integer *)0, ( - logical *)0, (integer *)0, (ftnint)0); - } - -/* Subroutine */ int m2tclr_(void) -{ - return m2pars_0_(3, (char *)0, (integer *)0, (integer *)0, (integer *)0, ( - logical *)0, (integer *)0, (ftnint)0); - } - -/* Subroutine */ int m2keep_(void) -{ - return m2pars_0_(4, (char *)0, (integer *)0, (integer *)0, (integer *)0, ( - logical *)0, (integer *)0, (ftnint)0); - } - -/* Subroutine */ int m2vget_(char *name__, integer *nth, logical *found, - integer *b, integer *e, ftnlen name_len) -{ - return m2pars_0_(5, name__, b, e, nth, found, (integer *)0, name_len); - } - -/* Subroutine */ int m2vsiz_(char *name__, integer *size, ftnlen name_len) -{ - return m2pars_0_(6, name__, (integer *)0, (integer *)0, (integer *)0, ( - logical *)0, size, name_len); - } - diff --git a/ext/spice/src/csupport/m2selb.c b/ext/spice/src/csupport/m2selb.c deleted file mode 100644 index 8fc1706425..0000000000 --- a/ext/spice/src/csupport/m2selb.c +++ /dev/null @@ -1,359 +0,0 @@ -/* m2selb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2SELB ( META/2 --- select a named integer ) */ -/* Subroutine */ int m2selb_(char *name__, char *string, integer *nth, - logical *found, integer *int__, ftnlen name_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer b, e, f, l, p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer pnter; - static char error[80]; - static integer myint; - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), m2bodn2c_(char *, integer *, - logical *, ftnlen); - -/* $ Abstract */ - -/* Select the Nth substring associated with a matched, named META/2 */ -/* template word and parse it as a body ID code. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* NTH I the number(ordinal) of the word that matched. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* INT O ID-code extracted and parsed from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* NTH is an ordinal number that specifies which of the */ -/* possible words in STRING that matched the named */ -/* template word is the one desired to extract */ -/* and parse. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME, STRING and NTH could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* INT is the ID-code associated with the word of STRING that */ -/* was the NTH match with the NAMEd META/2 template word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* 2) If the portion of STRING extracted cannot be parsed as an */ -/* integer, the error 'META/2(CORRUPTEDINTEGER)' will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - META/2 Version 1.0.0, 18-AUG-1998 (WLT) */ -/* -& */ - -/* $ Index_Entry */ - -/* Extract n'th integer matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, nth, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2SELB", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELB", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2SELB", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELB", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2SELB", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELB", (ftnlen)6); - return 0; - } - -/* First see if this is a recognized body... */ - - m2bodn2c_(string + (b - 1), &myint, found, e - (b - 1)); - if (! (*found)) { - -/* This should be an integer double precision number. */ -/* Parse it. */ - - nparsi_(string + (b - 1), &myint, error, &pnter, e - (b - 1), (ftnlen) - 80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - chkin_("M2SELB", (ftnlen)6); - setmsg_("The item requested could not be parsed as a body or bod" - "y ID.", (ftnlen)60); - sigerr_("META/2(CORRUPTEDBODY)", (ftnlen)21); - chkout_("M2SELB", (ftnlen)6); - return 0; - } - } - -/* Now do the actual assignment */ - - *int__ = myint; - *found = TRUE_; - return 0; -} /* m2selb_ */ - diff --git a/ext/spice/src/csupport/m2selc.c b/ext/spice/src/csupport/m2selc.c deleted file mode 100644 index 81046a883d..0000000000 --- a/ext/spice/src/csupport/m2selc.c +++ /dev/null @@ -1,355 +0,0 @@ -/* m2selc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2SELC ( META/2 --- select a named word ) */ -/* Subroutine */ int m2selc_(char *name__, char *string, integer *nth, - logical *found, char *word, ftnlen name_len, ftnlen string_len, - ftnlen word_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer b, e, f, l, p, w; - extern /* Subroutine */ int chkin_(char *, ftnlen), m2vget_(char *, - integer *, logical *, integer *, integer *, ftnlen), sigerr_(char - *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Select the Nth substring associated with a matched, named META/2 */ -/* template word and put it into the specified WORD. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* NTH I the number(ordinal) of the word that matched. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* WORD O the matching word extracted from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* NTH is an ordinal number that specifies which of the */ -/* possible words in STRING that matched the named */ -/* template word is the one desired to extract */ -/* and parse. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME, STRING and NTH could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* WORD is the word in STRING that corresponds to the request */ -/* specified by NAME and NTH. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If WORD is not sufficiently large to hold all of the characters */ -/* the error 'META/2(INSUFFICIENTSPACE)' will be signalled. */ - -/* 2) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract n'th word matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, nth, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - w = i_len(word, word_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2SELC", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELC", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2SELC", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELC", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2SELC", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELC", (ftnlen)6); - return 0; - } - if (w < e - b + 1) { - chkin_("M2SELC", (ftnlen)6); - setmsg_("There is not sufficient space in the output string to hold " - "the requested word. ", (ftnlen)79); - sigerr_("META/2(INSUFFICIENTSPACE)", (ftnlen)25); - chkout_("M2SELC", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - s_copy(word, string + (b - 1), word_len, e - (b - 1)); - return 0; -} /* m2selc_ */ - diff --git a/ext/spice/src/csupport/m2seld.c b/ext/spice/src/csupport/m2seld.c deleted file mode 100644 index 05bc45b0c8..0000000000 --- a/ext/spice/src/csupport/m2seld.c +++ /dev/null @@ -1,364 +0,0 @@ -/* m2seld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2SELD ( META/2 --- select a named double precision number ) */ -/* Subroutine */ int m2seld_(char *name__, char *string, integer *nth, - logical *found, doublereal *dp, ftnlen name_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static doublereal mydp; - static integer b, e, f, l, p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer pnter; - static char error[80]; - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), nparsd_(char *, doublereal *, char *, - integer *, ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char - *, ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Select the Nth substring associated with a matched, named META/2 */ -/* template word and parse it as a double precision number. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* NTH I the number(ordinal) of the word that matched. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* DP O matching d.p. extracted and parsed from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* NTH is an ordinal number that specifies which of the */ -/* possible words in STRING that matched the named */ -/* template word is the one desired to extract */ -/* and parse. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME, STRING and NTH could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* DP is the double precision number represented by the word */ -/* of STRING that was the NTH match with the NAMEd META/2 */ -/* template word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* 2) If the portion of STRING extracted cannot be parsed as a */ -/* a double precision number, the error 'META/2(CORRUPTEDNUMBER)' */ -/* will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract n'th number matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, nth, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2SELD", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELD", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2SELD", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELD", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2SELD", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELD", (ftnlen)6); - return 0; - } - -/* This is supposed to be an integer double precision number. */ -/* Parse it. */ - - nparsd_(string + (b - 1), &mydp, error, &pnter, e - (b - 1), (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - chkin_("M2SELD", (ftnlen)6); - setmsg_("The item requested could not be parsed as an integer. a num" - "ber.", (ftnlen)63); - sigerr_("META/2(CORRUPTEDNUMBER)", (ftnlen)23); - chkout_("M2SELD", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - *dp = mydp; - return 0; -} /* m2seld_ */ - diff --git a/ext/spice/src/csupport/m2seli.c b/ext/spice/src/csupport/m2seli.c deleted file mode 100644 index a4341395b8..0000000000 --- a/ext/spice/src/csupport/m2seli.c +++ /dev/null @@ -1,363 +0,0 @@ -/* m2seli.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2SELI ( META/2 --- select a named integer ) */ -/* Subroutine */ int m2seli_(char *name__, char *string, integer *nth, - logical *found, integer *int__, ftnlen name_len, ftnlen string_len) -{ - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer b, e, f, l, p; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer pnter; - static char error[80]; - static integer myint; - extern /* Subroutine */ int m2vget_(char *, integer *, logical *, integer - *, integer *, ftnlen), sigerr_(char *, ftnlen), nparsi_(char *, - integer *, char *, integer *, ftnlen, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Select the Nth substring associated with a matched, named META/2 */ -/* template word and parse it as an integer. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I the name of some matched META/2 template word. */ -/* STRING I the string that matched the META/2 template. */ -/* NTH I the number(ordinal) of the word that matched. */ -/* FOUND O returned TRUE if the request could be fulfilled. */ -/* INT O matching integer extracted and parsed from STRING. */ - -/* $ Detailed_Input */ - -/* NAME is the name of some named META/2 template word that */ -/* may have matched some portion of STRING. */ - -/* STRING is a string that successfully matched a META/2 template */ -/* containing the template word specified by NAME. */ - -/* NTH is an ordinal number that specifies which of the */ -/* possible words in STRING that matched the named */ -/* template word is the one desired to extract */ -/* and parse. */ - -/* $ Detailed_Output */ - -/* FOUND will be returned .TRUE. if the requested information */ -/* specified by NAME, STRING and NTH could be retrieved. */ -/* Otherwise it will be returned with a value of .FALSE. */ - -/* INT is the integer represented by the word of STRING that */ -/* was the NTH match with the NAMEd META/2 template word. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the portion of STRING extracted is NOT a word, the error */ -/* 'META/2(CORRUPTEDINPUTSTRING)' will be signalled. */ - -/* 2) If the portion of STRING extracted cannot be parsed as an */ -/* integer, the error 'META/2(CORRUPTEDINTEGER)' will be */ -/* signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Users of META/2 need not only to be sure that strings match */ -/* anticipated syntax of the language they design, but they also */ -/* need to be able to extract the meaning of syntactically correct */ -/* commands or statements. The routines */ - -/* M2GETC --- get a character string word */ -/* M2GETI --- get and parse an integer */ -/* M2GETD --- get and parse a double precision number */ -/* M2GETA --- get all that matched */ -/* M2SELC --- select the n'th character string word */ -/* M2SELI --- select and parse the n'th integer */ -/* M2SELD --- select and parse the n'th double precision number */ - -/* exist to aid in the extraction of meaning from syntactically */ -/* correct strings. */ - -/* To make use of this feature, you must add parsing information */ -/* to the language you design. To do this you simply "name" template */ -/* words by appending to the syntax portion of the word a name */ -/* of your choosing surrounded by the square brackets '[' and ']'. */ -/* For example you might have a language template of the form: */ - -/* OPEN @word */ - -/* That would open the contents of a text file. This statement */ -/* my itself can be used to make sure that a statement has */ -/* a recognizable form. However, if the program is to take any */ -/* action corresponding in an expected way to such a statement */ -/* entered into a program, you must eventually find out what */ -/* "@word" matched. To do this simply append a name to @word, */ -/* in this case a good name might be: */ - -/* OPEN @word[textfile] */ - -/* (Note that case is significant for named template words). */ -/* The template word "@word" in this syntax specification now */ -/* has a name: "textfile". Once it is recognized that a string */ -/* has matched a template, you can now easily find the name */ -/* of the text file that a user specified by making the call */ - -/* CALL M2GETC ( 'textfile', STRING, FOUND, FILE ) */ - -/* where STRING is the original, unaltered string that matched */ -/* the template "OPEN @word[textfile]". */ - -/* FOUND will indicate whether or not a match for a template */ -/* word having name "textfile" was recorded (in this case it */ -/* will return with a value of .TRUE) and FILE will contain */ -/* the word of string that matched "@word[textfile]". */ - -/* For many uses of META/2 you can ignore the FOUND flag. Often */ -/* you know from the fact that the string matched the template */ -/* FOUND must be .TRUE. However, in some cases the syntax will */ -/* not force a match to exist. For example a statement that */ -/* matches the template below my not have values for "to" */ -/* or "from". One will be present, but one might be absent. */ - -/* SET LIMITS (1:2){ FROM @calendar[from] */ -/* | TO @calendar[to] } */ - -/* In such cases, may want to assign default values to the strings */ -/* you use to retrieve the calendar strings corresponding to */ -/* "to" and "from". Or you may wish to examine the FOUND flag */ -/* after making the calls below. */ - -/* CALL M2GETT ( 'from', STRING, FOUNDF, FROM ) */ -/* CALL M2GETT ( 'to', STRING, FOUNDT, TO ) */ - -/* Note that if the logical flag returned is false, the value of */ -/* the output (in these examples FROM and TO) will not change from */ -/* the values they had upon input. In this way you may assign */ -/* defaults to items that might be missing from a matched */ -/* string. However, you should probably note that you are */ -/* assigning the defaults with a comment. Without doing this */ -/* your intent will likely be unclear to another person who might */ -/* eventually need to read and understand your code. */ - -/* $ Examples */ - -/* Suppose that a string matched the META/2 template */ - -/* FIND @name[window] SEPARATION */ - -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] } */ - -/* (1:1){ LESS[less] THAN @number[bound] */ -/* | GREATER[greater THAN @number[bound] } */ - -/* (0:1){ WITHIN INTERVAL[restricted] */ -/* FROM @calendar[from] TO @calendar[to] } */ - - -/* Then to extract the information in the string the following */ -/* sequence of calls will suffice. */ - -/* CALL M2GETC ( 'window', STRING, FOUND, WINDOW ) */ -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* CALL M2GETD ( 'bound', STRING, FOUND, BOUND ) */ -/* CALL M2GETA ( 'from', STRING, FOUND, FROM ) */ -/* CALL M2GETA ( 'to', STRING, FOUND, TO ) */ - -/* LESS = M2XIST ( 'less' ) */ -/* GREATR = M2XIST ( 'greater' ) */ -/* RSTRCT = M2XIST ( 'restriction' ) */ - -/* C */ -/* C If they were supplied parse the bounds of the search */ -/* C interval, otherwise just use the next decade. */ -/* C */ -/* IF ( RSTRCT ) THEN */ - -/* CALL UTC2ET ( FROM, LOWER ) */ -/* CALL UTC2ET ( TO, UPPER ) */ - -/* ELSE */ - -/* CALL UTC2ET ( '1 JAN 1990', LOWER ) */ -/* CALL UTC2ET ( '1 JAN 2000', UPPER ) */ - -/* END IF */ - -/* C */ -/* C If we want the separation to be less than BOUND use */ -/* C the next block. Otherwise we will look for separation */ -/* C greater than BOUND */ -/* C */ -/* IF ( LESS ) THEN */ - -/* search for "less than" separation */ - -/* ELSE */ - -/* search for "greater than" separation */ - -/* END IF */ - -/* C */ -/* C Finally, store the result of our computation in the */ -/* C specified window. */ -/* C */ -/* CALL STORE_WINDOW ( RESULTS, WINDOW ) */ - -/* $ Restrictions */ - -/* It is vital that the string that matched a META/2 template */ -/* not be altered prior to calling any of the extraction routines. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract n'th integer matching a named template word */ - -/* -& */ - -/* Local variables */ - - -/* First look up the beginning and endings of the requested word. */ - - m2vget_(name__, nth, found, &b, &e, name_len); - if (! (*found)) { - return 0; - } - -/* First make sure there is nothing pathological about the string */ -/* we are dealing with. */ - - p = b - 1; - f = e + 1; - l = i_len(string, string_len); - if (p > 0) { - if (*(unsigned char *)&string[p - 1] != ' ') { - chkin_("M2SELI", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELI", (ftnlen)6); - return 0; - } - } - if (f < l) { - if (*(unsigned char *)&string[f - 1] != ' ') { - chkin_("M2SELI", (ftnlen)6); - setmsg_("The input string has been modified since it passed synt" - "ax validation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELI", (ftnlen)6); - return 0; - } - } - if (*(unsigned char *)&string[b - 1] == ' ' || *(unsigned char *)&string[ - e - 1] == ' ') { - chkin_("M2SELI", (ftnlen)6); - setmsg_("The input string has been modified since it passed syntax v" - "alidation in META/2. ", (ftnlen)80); - sigerr_("META/2(CORRUPTEDINPUTSTRING)", (ftnlen)28); - chkout_("M2SELI", (ftnlen)6); - return 0; - } - -/* This is supposed to be an integer double precision number. */ -/* Parse it. */ - - nparsi_(string + (b - 1), &myint, error, &pnter, e - (b - 1), (ftnlen)80); - if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) { - chkin_("M2SELI", (ftnlen)6); - setmsg_("The item requested could not be parsed as an integer. a num" - "ber.", (ftnlen)63); - sigerr_("META/2(CORRUPTEDINTEGER)", (ftnlen)24); - chkout_("M2SELI", (ftnlen)6); - return 0; - } - -/* Now do the actual assignment */ - - *int__ = myint; - return 0; -} /* m2seli_ */ - diff --git a/ext/spice/src/csupport/m2shll.c b/ext/spice/src/csupport/m2shll.c deleted file mode 100644 index 33fc91f8cf..0000000000 --- a/ext/spice/src/csupport/m2shll.c +++ /dev/null @@ -1,211 +0,0 @@ -/* m2shll.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2SHLL ( Shell sort an array of Meta/2 syntaxs ) */ -/* Subroutine */ int m2shll_(integer *ndim, char *array, ftnlen array_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - logical l_le(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - logical swap; - integer i__, j, k; - extern /* Subroutine */ int swapc_(char *, char *, ftnlen, ftnlen); - integer ej, jg, kg, ejg, gap; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Sort an array of character strings according suitable for */ -/* use with 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 */ - -/* None. */ - -/* $ Keywords */ - -/* ARRAY, SORT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NDIM I Dimension of the array. */ -/* ARRAY I/O The array of syntax statements */ - -/* $ Detailed_Input */ - -/* NDIM is the number of elements in the array to be sorted. */ - -/* ARRAY on input, is the array of syntax statements */ -/* to be sorted. */ - -/* $ Detailed_Output */ - -/* ARRAY on output, contains the same elements, sorted */ -/* by initial keyword minus any keyword labels. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* The Shell Sort Algorithm is well known. */ - -/* $ Examples */ - -/* Let ARRAY contain the following elements: */ - -/* 'FEYNMAN' */ -/* 'NEWTON' */ -/* 'EINSTEIN' */ -/* 'GALILEO' */ -/* 'EUCLID' */ -/* 'Galileo' */ - -/* Then after a call to M2SHLL, the array would be ordered as */ -/* follows: */ - -/* 'EINSTEIN' */ -/* 'EUCLID' */ -/* 'FEYNMAN' */ -/* 'GALILEO' */ -/* 'Galileo' */ -/* 'NEWTON' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Meta/2 Version 1.0.0, 4-SEP-1998 (WLT) */ - -/* Modified SHELLC to produce an initial keyword sort. */ - -/* - 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 (IMU) */ - -/* -& */ -/* $ Index_Entries */ - -/* shell sort a character array */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local variables */ - - -/* This is a straightforward implementation of the Shell Sort */ -/* algorithm. */ - - gap = *ndim / 2; - while(gap > 0) { - i__1 = *ndim; - for (i__ = gap + 1; i__ <= i__1; ++i__) { - j = i__ - gap; - while(j > 0) { - jg = j + gap; - k = j; - kg = jg; - ej = pos_(array + (j - 1) * array_len, "[", &c__1, array_len, - (ftnlen)1); - ejg = pos_(array + (jg - 1) * array_len, "[", &c__1, - array_len, (ftnlen)1); - if (ej > 1) { - *(unsigned char *)&array[(j - 1) * array_len + (ej - 1)] = - ' '; - } - if (ejg > 1) { - *(unsigned char *)&array[(jg - 1) * array_len + (ejg - 1)] - = ' '; - } - if (l_le(array + (j - 1) * array_len, array + (jg - 1) * - array_len, array_len, array_len)) { - j = 0; - swap = FALSE_; - } else { - swap = TRUE_; - } - if (ej > 1) { - *(unsigned char *)&array[(k - 1) * array_len + (ej - 1)] = - '['; - } - if (ejg > 1) { - *(unsigned char *)&array[(kg - 1) * array_len + (ejg - 1)] - = '['; - } - if (swap) { - swapc_(array + (j - 1) * array_len, array + (jg - 1) * - array_len, array_len, array_len); - } - j -= gap; - } - } - gap /= 2; - } - return 0; -} /* m2shll_ */ - diff --git a/ext/spice/src/csupport/m2term.c b/ext/spice/src/csupport/m2term.c deleted file mode 100644 index 2bda60838d..0000000000 --- a/ext/spice/src/csupport/m2term.c +++ /dev/null @@ -1,423 +0,0 @@ -/* m2term.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure M2TERM (Find possible terminators of variable template) */ -/* Subroutine */ int m2term_(char *temp, char *terms, integer *indxes, ftnlen - temp_len, ftnlen terms_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer mark; - static logical more; - static integer room, next; - extern integer posr_(char *, char *, integer *, ftnlen, ftnlen), upto_( - char *, char *, integer *, ftnlen, ftnlen); - static integer b, e; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen), ncpos_(char *, char *, integer *, - ftnlen, ftnlen), sizei_(integer *); - static integer nextg, d1, d2, count; - static logical group; - static integer nextt; - extern /* Subroutine */ int m2begr_(char *, integer *, integer *, integer - *, integer *, ftnlen); - extern logical m2keyw_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardi_( - integer *, integer *); - static logical mrkend, dothen; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - extern logical matchw_(char *, char *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - static integer beg; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Find those keywords that are initial keywords of group templates */ -/* or immediately follow such a template. */ - -/* $ 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 */ - -/* The META/2 Book. */ - -/* $ Keywords */ - -/* PARSING */ -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* TEMP I A META/2 template. */ -/* TERMS O Possible terminating keywords. */ -/* INDXES O Indices of the beginnings of TERMS within TEMP. */ - -/* $ Detailed_Input */ - -/* TEMP A META/2 template. */ - -/* $ Detailed_Output */ - -/* TERMS These are those keywords that begin the simple */ -/* templates of the groups templates of TEMP, as well */ -/* as the keywords that immediately follow group */ -/* templates. */ - -/* INDXES Contains the indexes of the first characters of */ -/* each of the words in TERMS within TEMP. Specifically, */ -/* if we let L = LASTNB(TERMS(I)) then */ -/* TERMS(I)( 1 : L ) = TEMP( INDXES(I) : INDXES(I) + L ) */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine to aid the general M2 pattern matching */ -/* routine ( M2CHCK ). It determines */ - -/* 1.) initial keywords of simple templates of group templates; */ -/* 2.) the keywords that immediately follow groups; */ -/* 3.) the keywords that immediately follow unqualified @then */ -/* directives. */ - -/* These keywords together with their indexes are loaded in the */ -/* order they appear in the template into the cells TERMS and */ -/* INDXES. Additionally, the marker '}' is inserted in the */ -/* cell of keywords immediately following */ - -/* 1.) the last initial keyword of a group, provided the */ -/* group has a range template that is NOT of the form */ -/* (0:n) (where n is any integer). The index associated */ -/* with such a marker is the index in the template of the */ -/* '}' that ends the group associated with the marker. */ - -/* 2.) any keyword that immediately follows a group. It */ -/* is assigned the index of the first blank that follows */ -/* the keyword. */ - -/* 3.) any keyword that immediatly follows an unqualified @then */ -/* directive. It is given the index of the first blank */ -/* following the keyword. */ - -/* 4.) after all keywords provided that the template does not */ -/* end with a qualified @then directive. The marker is */ -/* assigned an index equal to the length of the template */ -/* plus 1. */ - - -/* The marker can be used to determine what keywords might end */ -/* a variable length template. */ - - -/* $ Examples */ - -/* Suppose that the template was */ - -/* (0:1){ PLEASE } */ -/* SEND (1:7)@english (0:1){ AND @english } */ - -/* (1:1){ A @english(MESSAGE|CHECK|LETTER) */ -/* | MEMO (0:1)@english(NUMBER) @int(1:) */ -/* | THE @english(SCHEDULE|PROPOSAL) */ -/* | HOME */ -/* | FLOWERS } */ - -/* Then the cells TERMS and INDXES (assuming that spaces have been */ -/* compressed down to 1 between words) would be returned as: */ - -/* TERMS INDXES */ -/* ------- ------- */ -/* PLEASE 8 */ -/* SEND 17 */ -/* } 21 */ -/* AND 43 */ -/* A 65 */ -/* MEMO 101 */ -/* THE 139 */ -/* HOME 173 */ -/* FLOWERS 180 */ -/* } 188 */ -/* } 189 */ - -/* $ Restrictions */ - -/* It is expected that any template input to this routine satisfies */ -/* the rules required of META/2 templates. */ - -/* $ 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 */ - - -/* Beta Version 1.0.0, 10-MAY-1987 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - -/* Computing MIN */ - i__1 = sizec_(terms, terms_len), i__2 = sizei_(indxes); - room = min(i__1,i__2); - scardc_(&c__0, terms, terms_len); - scardi_(&c__0, indxes); - -/* Just look through the string and located the appropriate keywords. */ -/* First see if there are any group templates. */ - - beg = 1; - count = 0; - more = TRUE_; - -/* NEXT will point to the next group template so long as there are */ -/* more to find. */ - - while(more) { - nextg = upto_(temp, "){ ", &beg, temp_len, (ftnlen)3); - nextt = upto_(temp, " @then ", &beg, temp_len, (ftnlen)7); - if (nextg < nextt) { - group = TRUE_; - dothen = FALSE_; - next = nextg; - } else if (nextt < nextg) { - dothen = TRUE_; - group = FALSE_; - next = nextt; - } else { - dothen = FALSE_; - group = FALSE_; - more = FALSE_; - } - if (group) { - -/* Find the beginning of the range template and see if */ -/* it has the form (0:*). If it has that form we will */ -/* not want to mark the end of the group when we finish */ -/* with it. */ - - b = posr_(temp, "(", &nextg, temp_len, (ftnlen)1) + 1; - mrkend = ncpos_(temp, "0", &b, temp_len, (ftnlen)1) != pos_(temp, - ":", &b, temp_len, (ftnlen)1); - -/* Find the end of the next group template and set BEG */ - - beg = pos_(temp, "}", &nextg, temp_len, (ftnlen)1) + 1; - mark = beg - 1; - if (beg == 1) { - chkin_("M2TERM", (ftnlen)6); - setmsg_("A switch was begun, but never ended.", (ftnlen)36); - sigerr_("SPICE(META2DEFERR)", (ftnlen)18); - chkout_("M2TERM", (ftnlen)6); - return 0; - } - -/* Locate the first keyword of the group template. */ - - fndnwd_(temp, &nextg, &b, &e, temp_len); - if (count > room) { - chkin_("M2TERM", (ftnlen)6); - setmsg_("There are too many possible terminating keywords. ", - (ftnlen)50); - sigerr_("SPICE(META2TOOMANYKEYS)", (ftnlen)23); - chkout_("M2TERM", (ftnlen)6); - return 0; - } - ++count; - s_copy(terms + (count + 5) * terms_len, temp + (b - 1), terms_len, - e - (b - 1)); - indxes[count + 5] = b; - -/* See if there are anymore simple templates in the this */ -/* group template ( they will all be preceeded by ' | '. */ - - nextg = e; - nextg = pos_(temp, " | ", &next, beg, (ftnlen)3) + 2; - while(nextg >= 3) { - -/* Locate the next keyword. */ - - fndnwd_(temp, &nextg, &b, &e, temp_len); - -/* Take care of any errors that might occur. */ - - if (b == 0) { - chkin_("M2TERM", (ftnlen)6); - setmsg_("An improperly composed META/2 switch was encoun" - "tered.", (ftnlen)53); - sigerr_("SPICE(META2DEFERR)", (ftnlen)18); - chkout_("M2TERM", (ftnlen)6); - return 0; - } - if (count >= room) { - chkin_("M2TERM", (ftnlen)6); - setmsg_("There are too many possible terminating keyword" - "s. ", (ftnlen)50); - sigerr_("SPICE(META2TOOMANYKEYS)", (ftnlen)23); - chkout_("M2TERM", (ftnlen)6); - return 0; - } - -/* Put the keyword on the list and note its string position. */ - - ++count; - s_copy(terms + (count + 5) * terms_len, temp + (b - 1), - terms_len, e - (b - 1)); - indxes[count + 5] = b; - nextg = e; - nextg = pos_(temp, " | ", &nextg, beg, (ftnlen)3) + 2; - } - -/* If the group template just processed DID NOT have a range */ -/* template of the form (0:*%), put the marker '}' into the */ -/* list of keywords. */ - - if (mrkend) { - ++count; - s_copy(terms + (count + 5) * terms_len, "}", terms_len, ( - ftnlen)1); - indxes[count + 5] = mark; - } - -/* We are out of initial keywords in the group. Get the next */ -/* word and see if it is a keyword or the beginning of */ -/* another group template. */ - - fndnwd_(temp, &beg, &b, &e, temp_len); - } else if (dothen) { - beg = next + 6; - fndnwd_(temp, &beg, &b, &e, temp_len); - } - if (! more) { - -/* Don't do anything, just get ready to drop through the loop. */ - - } else if (b == 0) { - -/* We are out of template */ - - more = FALSE_; - scardc_(&count, terms, terms_len); - scardi_(&count, indxes); - } else if (matchw_(temp + (b - 1), "(%*:%*){", "*", "%", e - (b - 1), - (ftnlen)8, (ftnlen)1, (ftnlen)1)) { - -/* Do nothing, this will all be taken care of later. */ - - } else if (s_cmp(temp + (b - 1), "@then", e - (b - 1), (ftnlen)5) == - 0) { - -/* Don't do anything, we'll get back to this in a moment. */ - - } else if (matchw_(temp + (b - 1), "@then(%*)", "*", "%", e - (b - 1), - (ftnlen)9, (ftnlen)1, (ftnlen)1)) { - -/* That's it. I quit. */ - - scardc_(&count, terms, terms_len); - scardi_(&count, indxes); - more = FALSE_; - } else { - -/* Get rid of any beginning range template. (If there is a */ -/* range template we just dump the values into D1 and D2 */ -/* and never use them.) */ - - m2begr_(temp, &b, &e, &d1, &d2, temp_len); - if (b > e) { - -/* do nothing */ - - } else if (m2keyw_(temp + (b - 1), e - (b - 1))) { - ++count; - s_copy(terms + (count + 5) * terms_len, temp + (b - 1), - terms_len, e - (b - 1)); - indxes[count + 5] = b; - beg = e + 1; - ++count; - s_copy(terms + (count + 5) * terms_len, "}", terms_len, ( - ftnlen)1); - indxes[count + 5] = beg; - } - } - group = FALSE_; - dothen = FALSE_; - } - -/* Set the cardinality and return */ - - scardc_(&count, terms, terms_len); - scardi_(&count, indxes); - return 0; -} /* m2term_ */ - diff --git a/ext/spice/src/csupport/m2thnq.c b/ext/spice/src/csupport/m2thnq.c deleted file mode 100644 index 63dcdca661..0000000000 --- a/ext/spice/src/csupport/m2thnq.c +++ /dev/null @@ -1,170 +0,0 @@ -/* m2thnq.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure M2THNQ ( Find a META/2 qualified @then directive ) */ -/* Subroutine */ int m2thnq_(char *string, integer *positn, char *label, - ftnlen string_len, ftnlen label_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer upto_(char *, char *, integer *, ftnlen, ftnlen); - static integer i__, j; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - static integer length; - -/* $ Abstract */ - -/* This utility routine locates a META/2 qualified @then directive */ -/* and returns the position in the string immediately preceeding */ -/* the directive as well as the label portion of the directive. */ - -/* $ 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 */ - -/* The META/2 book. */ - -/* $ Keywords */ - -/* PARSING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A META/2 language specication string. */ -/* POSITN O The position of the last character before @then(%*) */ -/* LABEL O The label portion of the @then directive. */ - -/* $ Detailed_Input */ - -/* STRING A META/2 language specication string. */ - -/* $ Detailed_Output */ - -/* POSITN The index of the last character before a word */ -/* that begins with '@then('. If there is no such word */ -/* POSITN is assigned the index of the last character */ -/* of the string. */ - -/* LABEL The label portion of the @then directive. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If there is no qualified @then, POSITN is set to the index of */ -/* the last character of the string and LABEL is set to ' '. */ - -/* $ Particulars */ - -/* This is a utility routine that locates the first character */ -/* before the first occurance of a substring of the form '@then(%*)'. */ - -/* It is intended for use only by META/2. */ - -/* $ Examples */ - -/* None. */ - -/* $ 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 */ - - -/* Beta Version 1.0.0, 18-MAY-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Get the lengtH of the string. */ - - length = i_len(string, string_len); - -/* See if there is a qualified @then. */ - - *positn = upto_(string, "@then(", &c__1, string_len, (ftnlen)6); - if (*positn == length) { - s_copy(label, " ", label_len, (ftnlen)1); - } else { - fndnwd_(string, positn, &i__, &j, string_len); - if (j <= i__ + 6) { - *positn = length; - s_copy(label, " ", label_len, (ftnlen)1); - } else { - i__1 = i__ + 5; - s_copy(label, string + i__1, label_len, j - 1 - i__1); - } - } - return 0; -} /* m2thnq_ */ - diff --git a/ext/spice/src/csupport/m2time.c b/ext/spice/src/csupport/m2time.c deleted file mode 100644 index bafab22201..0000000000 --- a/ext/spice/src/csupport/m2time.c +++ /dev/null @@ -1,319 +0,0 @@ -/* m2time.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2TIME ( Determine whether or not a word is a time ) */ -logical m2time_(char *word, ftnlen word_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer ubnd[4], comp, zero, i__, n, class__[256]; - static logical colok[4]; - static integer limit[4]; - extern integer ltrim_(char *, ftnlen); - static integer count; - static logical pntok[4]; - static integer start, factor[4]; - extern integer qrtrim_(char *, ftnlen); - static integer end; - -/* $ Abstract */ - -/* This function is true if the input string is a time 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 time. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2TIME returns as .TRUE. if WORD has the form */ - -/* hh:mm:ss.ssssss */ - -/* where */ - -/* hh stands for one or two digits and the number */ -/* they represent is less than 24. */ - -/* mm stands for one or two digits and the number */ -/* they represent is less than 60 */ - -/* ss.ss stands for a decimal number less than 61. */ - -/* Otherwise M2TIME 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 time in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2TIME */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* _SPUD .FALSE. */ -/* 1:23:27 .TRUE. */ -/* 21.23.28 .FALSE. */ -/* 24:13:48.28 .FALSE. */ -/* 23:59:60.281 .TRUE. */ -/* 19:3:1 .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 */ - - if (first) { - first = FALSE_; - for (i__ = 0; i__ <= 255; ++i__) { - class__[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("class", - i__1, "m2time_", (ftnlen)190)] = 4; - } - class__[(i__1 = '0') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)193)] = 1; - class__[(i__1 = '1') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)194)] = 1; - class__[(i__1 = '2') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)195)] = 1; - class__[(i__1 = '3') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)196)] = 1; - class__[(i__1 = '4') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)197)] = 1; - class__[(i__1 = '5') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)198)] = 1; - class__[(i__1 = '6') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)199)] = 1; - class__[(i__1 = '7') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)200)] = 1; - class__[(i__1 = '8') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)201)] = 1; - class__[(i__1 = '9') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)202)] = 1; - class__[(i__1 = ':') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)203)] = 2; - class__[(i__1 = '.') < 256 && 0 <= i__1 ? i__1 : s_rnge("class", i__1, - "m2time_", (ftnlen)204)] = 3; - -/* The following are the maximum values that are allowed */ -/* for each of the various components of the time string */ - - ubnd[0] = 23; - ubnd[1] = 59; - ubnd[2] = 60; - ubnd[3] = 10; - -/* The following are the maximum number of digits that */ -/* are allowed for each of the components of the time */ - - limit[0] = 2; - limit[1] = 2; - limit[2] = 2; - limit[3] = 100; - -/* The following logicals indicate whether or not it is */ -/* ok to end the N'th component of time with a colon. */ - - colok[0] = TRUE_; - colok[1] = TRUE_; - colok[2] = FALSE_; - colok[3] = FALSE_; - -/* The following logicals indicate whether or not it is */ -/* ok to end the N'th component of time with a decimal point. */ - - pntok[0] = FALSE_; - pntok[1] = FALSE_; - pntok[2] = TRUE_; - pntok[3] = FALSE_; - -/* The following are the factors used to construct the */ -/* integer value of a component COMP = FACTOR*COMP + Next digit. */ -/* Note that for the decimal portion of seconds we don't */ -/* really compute the value of the decimal part. The */ -/* factor term just ensures that the loop below doesn't */ -/* have any special cases. */ - - factor[0] = 10; - factor[1] = 10; - factor[2] = 10; - factor[3] = 0; - zero = '0'; - } - start = ltrim_(word, word_len); - end = qrtrim_(word, word_len); - comp = 0; - n = 1; - count = 0; - i__ = start; - ret_val = TRUE_; - if (end - start < 4) { - ret_val = FALSE_; - return ret_val; - } - while(i__ <= end && ret_val) { - -/* If the next character is a digit, compute the accumulated */ -/* value of this component of the time. Then check to */ -/* make sure that we don't have too many digits so far */ -/* in this component and that the value of this component */ -/* does not exceed the limits for this component. */ - - if (class__[(i__1 = *(unsigned char *)&word[i__ - 1]) < 256 && 0 <= - i__1 ? i__1 : s_rnge("class", i__1, "m2time_", (ftnlen)277)] - == 1) { - ++count; - comp = factor[(i__1 = n - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge( - "factor", i__1, "m2time_", (ftnlen)280)] * comp + *( - unsigned char *)&word[i__ - 1] - zero; - ret_val = count <= limit[(i__1 = n - 1) < 4 && 0 <= i__1 ? i__1 : - s_rnge("limit", i__1, "m2time_", (ftnlen)282)] && comp <= - ubnd[(i__2 = n - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge( - "ubnd", i__2, "m2time_", (ftnlen)282)]; - -/* If the next character is a colon ':' then we are starting */ -/* a new component. Make sure this is ok and that we actually */ -/* had a digit or two for the last component. Increment the */ -/* component counter, set the number of characters found in */ -/* the next component to 0 and set the value of the next */ -/* component to zero. */ - - } else if (class__[(i__1 = *(unsigned char *)&word[i__ - 1]) < 256 && - 0 <= i__1 ? i__1 : s_rnge("class", i__1, "m2time_", (ftnlen) - 293)] == 2) { - ret_val = colok[(i__1 = n - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge( - "colok", i__1, "m2time_", (ftnlen)295)] && count > 0; - count = 0; - comp = 0; - ++n; - -/* If the next character is decimal point, we are ending a */ -/* component and starting it's decimal portion. Make sure */ -/* that a decimal point is allowed for this component and */ -/* that we had at least one digit in the component we were */ -/* examining up to this point. */ - - } else if (class__[(i__1 = *(unsigned char *)&word[i__ - 1]) < 256 && - 0 <= i__1 ? i__1 : s_rnge("class", i__1, "m2time_", (ftnlen) - 306)] == 3) { - ret_val = pntok[(i__1 = n - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge( - "pntok", i__1, "m2time_", (ftnlen)308)] && count > 0; - count = 0; - comp = 0; - ++n; - -/* If we hit some other character we don't have a time */ -/* word. */ - - } else { - ret_val = FALSE_; - } - ++i__; - } - ret_val = ret_val && n >= 3; - return ret_val; -} /* m2time_ */ - diff --git a/ext/spice/src/csupport/m2tran.c b/ext/spice/src/csupport/m2tran.c deleted file mode 100644 index 0ebf80da78..0000000000 --- a/ext/spice/src/csupport/m2tran.c +++ /dev/null @@ -1,323 +0,0 @@ -/* m2tran.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__19 = 19; - -/* $Procedure M2TRAN ( See if a word has a restriction template ) */ -/* Subroutine */ int m2tran_(char *string, integer *beg, integer *end, char * - base, logical *key, logical *temp, ftnlen string_len, ftnlen base_len) -{ - /* Initialized data */ - - static char quick[4*19] = "@alp" "@bod" "@cal" "@day" "@end" "@eng" "@epo" - "@int" "@mon" "@nam" "@num" "@the" "@tim" "@uni" "@wor" "@yea" - "{ " "| " "} "; - static integer temps[19] = { 6,5,0,0,0,8,0,4,6,5,7,5,0,5,5,0,0,0,0 }; - static integer checks[19] = { 2,2,1,1,1,2,1,2,2,2,2,2,1,2,2,1,0,0,0 }; - static integer pntrs[19] = { 1,3,5,6,7,8,10,11,13,15,17,19,21,22,24,26,26, - 26,26 }; - static char full[16*26] = "@alpha " "@alpha(%*) " "@body " - " " "@body(%*) " "@calendar " "@day " - " " "@end " "@english " "@english(%*) " - "@epoch " "@int " "@int(*:*) " "@month" - " " "@month(%*) " "@name " "@name(%*) " - " " "@number " "@number(*:*) " "@then " - "@then(%*) " "@time " "@unit " "@unit(" - "%*) " "@word " "@word(%*) " "@year " - " "; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - static integer i__, j, k; - static logical match; - static char cword[4]; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern logical matchw_(char *, char *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen); - -/* $ Abstract */ - -/* Determine a META-WORD class and whether or not a word ends */ -/* with a substring of the (%*). If it ends with such a substring */ -/* return pointers to the left and right parentheses. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A META/2 language statement specification. */ -/* BEG I/O The beginning of a word in STRING */ -/* END I/O The end of a word in STRING */ -/* BASE O Portion of the word preceeding the template. */ -/* KEY O .TRUE. if the the substring is a keyword. */ -/* TEMP O .TRUE. if a restriction template is present. */ - -/* $ Detailed_Input */ - -/* STRING(BEG:END) is a META/2 word that potentially ends with a */ -/* substring of the form (%*) where '%' and '*' */ -/* stand for the wildstring and wildcharacter */ -/* symbols. */ - -/* $ Detailed_Output */ - -/* BEG is the index of the first character of the restriction */ -/* template ( the left parenthesis ) */ -/* first parenthesis '(' if a restriction template */ -/* is present. If no restriction template is present */ -/* it is returned as END + 1. */ - -/* END is the index of the last character in the string. */ - -/* BASE is the portion of the string that precedes the */ -/* restriction template. If no template is present */ -/* BASE is assigned the value of word (with truncation */ -/* if BASE has shorter than END - BEG + 1 . */ - -/* KEY is returned as true if STRING(BEG:END) is a keyword */ -/* in the language that is being specified. Otherwise */ -/* it is false. */ - -/* TEMP is returned as true if STRING(BEG:END) is a META-KEY */ -/* and ends with a restriction template. Otherwise it is */ -/* false. */ - -/* $ Error_Handling */ - -/* None. A restriction template is present or it isn't. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* The list of META/2 keywords is given below. A word of a */ -/* statement template is viewed as a language keyword if it is */ -/* not on this list. */ - -/* '@alpha', '@alpha(%*)', '@body', '@day', */ -/* '@end' '@english', '@english(%*)', '@epoch', */ -/* '@int', '@int(*:*)' '@month', '@month(%*)', */ -/* '@name', '@name(%*)', '@number' '@number(*:*)', */ -/* '@then' '@then(%*)', '@time', '@unit', */ -/* '@year', '}' */ - -/* If the word is not a keyword, then it is examined and any */ -/* restriction templates are returned. */ - -/* The restriction template is part of the META/2 language and is */ -/* described in the required reading section. Briefly it is */ -/* a string at the end of a word that has the form */ - -/* (x) */ - -/* where x is any string of length at least 1. The interpretation */ -/* of this string is handled in META2. */ - -/* This is purely a utility for META2 and is not a general purpose */ -/* routine. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - META/2 Version 4.0.0, 23-MAR-2000 (WLT) */ - -/* Extended the routine to add the keyword @unit to the */ -/* list of Meta/2 keywords. */ - -/* - META/2 Configured Version 3.0.0, 14-AUG-1995 (WLT) */ - -/* The keyword @body was out of order in the quick */ -/* check list below. Who knows what other terrible */ -/* bugs this was causing. */ - -/* - 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, 23-MAR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* The array QUICK contains abbreviations of all of the know META-KEY */ -/* words in alphabetical order. */ - - -/* The array TEMPS gives the character position within a word where */ -/* a template will be attached to a META-KEY word. */ -/* If the first portion of a word equals QUICK(I), TEMP(I) will be */ -/* the character immediately before the template (if one is present). */ - -/* If a template is not allowed for a META-KEY word, TEMP will be 0. */ - - -/* The array CHECKS tells how many different ways a META-KEY word */ -/* can be represented. For example @alpha or @alpha(template). */ -/* If a word matches up in the beginning with QUICK(I) then there */ -/* are at most CHECKS(I) checks that we must perform to see if it */ -/* is in fact a legitimate META-KEY word. */ - - -/* PNTRS(I) points to the first position in the array FULL where */ -/* one should look to find the actual patterns that should be */ -/* checked to see if a word that matches the initial portion */ -/* in QUICK(I) is in fact a META-KEY */ - - -/* First do a binary search on the abreviations of the META-KEYS */ -/* to see if this is a key word. */ - - s_copy(cword, string + (*beg - 1), (ftnlen)4, *end - (*beg - 1)); - i__ = bsrchc_(cword, &c__19, quick, (ftnlen)4, (ftnlen)4); - if (i__ == 0) { - -/* We didn't even match up with one of the abbreviations, this */ -/* can't be a META-KEY and so must be a language specification */ -/* keyword. */ - - *key = TRUE_; - *temp = FALSE_; - s_copy(base, string + (*beg - 1), base_len, *end - (*beg - 1)); - *beg = *end + 1; - return 0; - } else { - -/* We at least match an abbreviation. See if we match the */ -/* full expansion of the abbreviation. */ - - *key = FALSE_; - k = pntrs[(i__1 = i__ - 1) < 19 && 0 <= i__1 ? i__1 : s_rnge("pntrs", - i__1, "m2tran_", (ftnlen)324)]; - j = 1; - match = FALSE_; - while(j <= checks[(i__1 = i__ - 1) < 19 && 0 <= i__1 ? i__1 : s_rnge( - "checks", i__1, "m2tran_", (ftnlen)328)] && ! match) { - match = matchw_(string + (*beg - 1), full + (((i__1 = k - 1) < 26 - && 0 <= i__1 ? i__1 : s_rnge("full", i__1, "m2tran_", ( - ftnlen)332)) << 4), "*", "%", *end - (*beg - 1), (ftnlen) - 16, (ftnlen)1, (ftnlen)1); - *key = ! match; - ++k; - ++j; - } - if (*key) { - *temp = FALSE_; - s_copy(base, string + (*beg - 1), base_len, *end - (*beg - 1)); - *beg = *end + 1; - return 0; - } - -/* If we get this far we must have a META-KEY. See if there */ -/* is a restriction template. */ - - if (s_cmp(string + (*beg - 1), full + (((i__2 = pntrs[(i__1 = i__ - 1) - < 19 && 0 <= i__1 ? i__1 : s_rnge("pntrs", i__1, "m2tran_", ( - ftnlen)355)] - 1) < 26 && 0 <= i__2 ? i__2 : s_rnge("full", - i__2, "m2tran_", (ftnlen)355)) << 4), *end - (*beg - 1), ( - ftnlen)16) == 0) { - -/* There is no restriction template. */ - - s_copy(base, string + (*beg - 1), base_len, *end - (*beg - 1)); - *beg = *end + 1; - *temp = FALSE_; - } else { - -/* We have a restriction template. */ - - s_copy(base, full + (((i__2 = pntrs[(i__1 = i__ - 1) < 19 && 0 <= - i__1 ? i__1 : s_rnge("pntrs", i__1, "m2tran_", (ftnlen) - 370)] - 1) < 26 && 0 <= i__2 ? i__2 : s_rnge("full", i__2, - "m2tran_", (ftnlen)370)) << 4), base_len, (ftnlen)16); - *beg += temps[(i__1 = i__ - 1) < 19 && 0 <= i__1 ? i__1 : s_rnge( - "temps", i__1, "m2tran_", (ftnlen)371)]; - *temp = TRUE_; - } - } - return 0; -} /* m2tran_ */ - diff --git a/ext/spice/src/csupport/m2trim.c b/ext/spice/src/csupport/m2trim.c deleted file mode 100644 index d51b5fdc09..0000000000 --- a/ext/spice/src/csupport/m2trim.c +++ /dev/null @@ -1,200 +0,0 @@ -/* m2trim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2TRIM ( META/2 trim the name portion from a word ) */ -/* Subroutine */ int m2trim_(char *word, char *root, ftnlen word_len, ftnlen - root_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - static integer b, e, blank, lbrace, rbrace; - extern integer qrtrim_(char *, ftnlen); - -/* $ Abstract */ - -/* Extract the "root" of a META/2 template word. That is trim off */ -/* the name portion of a template word. */ - -/* $ 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 */ - -/* $ Keywords */ - -/* META1 */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WORD I A word from a META/2 template. */ -/* ROOT O The input word trimmed of any name specification. */ - -/* $ Detailed_Input */ - -/* WORD is a word from a META/2 template. It may or may not */ -/* looklike ROOT // '[name]' */ - -/* $ Detailed_Output */ - -/* ROOT is the portion of the input word that precedes the */ -/* name portion of the input WORD. ROOT may overwrite */ -/* WORD. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* If ROOT is not sufficiently large to contain all of the output, */ -/* it will be truncated on the right. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* META/2 template words can have appended to them "variable" names */ -/* that will be used to store substring boundaries of STRINGS matched */ -/* against META/2 templates. For example */ - -/* FIND @name[WINDOW] */ -/* SEPARATION (2:2){ OF @int[BODY1] @int[BODY2] */ -/* | FROM @int[OBSERVER] } */ - -/* the words */ - -/* @name[WINDOW], @int[BODY1], @int[BODY2], @int[OBSERVER] */ - -/* all have "varialbe" name substrings. They are: */ - -/* WINDOW, BODY1, BODY2, and OBSERVER respectively. */ - -/* The routine removes variable names and associated brackets in WORD */ -/* if they exist. */ - -/* $ Examples */ - -/* Below is a table descibing sample inputs and outputs. */ - -/* WORD ROOT */ -/* --------------- ------------------ */ -/* @int[SPUD] @int */ -/* @name[WINDOW] @name */ -/* SEARCH[GET] SEARCH */ -/* @name @name */ -/* @body(2:4)[LIST] @body(2:4) */ - -/* $ Restrictions */ - -/* None. */ - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 21-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Extract the root of a META/2 template word. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - s_copy(root, word, root_len, word_len); - lbrace = '['; - rbrace = ']'; - blank = ' '; - e = i_len(word, word_len); - -/* This loop is the same as RTRIM only faster. */ - - e = qrtrim_(word, word_len); - -/* If the length is not at least 4 or the last character is not */ -/* a right brace, there is no name associated with this word. */ - - if (*(unsigned char *)&word[e - 1] == rbrace && e >= 4) { - -/* Ok. We have a chance at getting a name. Look for */ -/* a left brace and if found blank out the end portion of */ -/* ROOT. */ - - b = 2; - while(b < e - 1) { - if (*(unsigned char *)&word[b - 1] == lbrace) { - -/* We've found the beginning of the name portion */ -/* of the word. Record the end of the meta-2 */ -/* word and then reset L so that we exit this loop. */ - - s_copy(root + (b - 1), " ", root_len - (b - 1), (ftnlen)1); - b = e; - } - ++b; - } - } - return 0; -} /* m2trim_ */ - diff --git a/ext/spice/src/csupport/m2unit.c b/ext/spice/src/csupport/m2unit.c deleted file mode 100644 index 04d8f99b21..0000000000 --- a/ext/spice/src/csupport/m2unit.c +++ /dev/null @@ -1,142 +0,0 @@ -/* m2unit.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2UNIT ( Determine whether a word is a unit spec ) */ -logical m2unit_(char *word, ftnlen word_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen); - static integer start; - extern logical unitp_(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 unit. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2UNIT returns as .TRUE. if WORD is a parsable unit. */ -/* 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 unit spec in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2UNIT */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* KM .TRUE. */ -/* KM/SEC .TRUE. */ -/* 100*AU/YEAR .TRUE. */ -/* 12.E2 .FALSE. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - META/2 Version 1.0.0, 23-MAR-2000 (WLT) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Make sure the string has the right length. */ - - start = ltrim_(word, word_len); - end = rtrim_(word, word_len); - ret_val = unitp_(word + (start - 1), end - (start - 1)); - return ret_val; -} /* m2unit_ */ - diff --git a/ext/spice/src/csupport/m2wmch.c b/ext/spice/src/csupport/m2wmch.c deleted file mode 100644 index 44dc69f6c4..0000000000 --- a/ext/spice/src/csupport/m2wmch.c +++ /dev/null @@ -1,375 +0,0 @@ -/* m2wmch.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2WMCH ( Match a word against a META/2 class ) */ -logical m2wmch_(char *string, integer *wordb, integer *worde, char *class__, - ftnlen string_len, ftnlen class_len) -{ - /* System generated locals */ - integer i__1, i__2; - logical ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical zztokns_(char *, char *, ftnlen, ftnlen); - static char base[32]; - extern /* Subroutine */ int convrt_3__(doublereal *, char *, char *, - doublereal *, integer *, ftnlen, ftnlen); - static logical temp; - static integer pntr; - static doublereal xout; - extern logical m2day_(char *, ftnlen), m2mon_(char *, ftnlen), m2int_( - char *, ftnlen); - static integer i__, l; - static doublereal v, x, y; - static char error[160]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen), m2name_(char *, - ftnlen), m2alph_(char *, ftnlen), m2engl_(char *, ftnlen), - m2epoc_(char *, ftnlen), m2body_(char *, ftnlen), m2time_(char *, - ftnlen), m2year_(char *, ftnlen), m2numb_(char *, ftnlen); - extern /* Subroutine */ int m2save_(char *, integer *, integer *, ftnlen), - m2ntem_(char *, char *, integer *, integer *, doublereal *, - doublereal *, ftnlen, ftnlen), m2tran_(char *, integer *, integer - *, char *, logical *, logical *, ftnlen, ftnlen); - extern logical m2unit_(char *, ftnlen); - static integer nb, ne, lbrace, wb, we, rbrace; - static logical namfnd; - extern logical matchm_(char *, char *, char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer - *, ftnlen, ftnlen); - static logical tmplog; - static integer status, beg, end; - static logical key; - static doublereal xin; - -/* $ Abstract */ - -/* Determine whether or not the WORD is a member of a META/2 */ -/* class. */ - -/* $ 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 */ - -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I A string containing words. */ -/* WORDB I The beginning of a word. */ -/* WORDE I The ending of the same word. */ -/* CLASS I A META/2 specification keyword or META-KEY */ - -/* The function is returned as .TRUE. if WORD is a member of CLASS. */ - -/* $ Detailed_Input */ - -/* STRING is any character string. It is expected to be composed */ -/* of words. */ - -/* WORDB is the beginning of some word in STRING. */ - -/* WORDE is the ending of the same word of STRING. */ - -/* The word of interest is STRING(WORDB:WORDE). */ - -/* CLASS is one of the recognized classes of words in META/2 or */ -/* a META-KEY. CLASS is expected to be right justified. */ -/* This class may be modified by a restriction template. */ -/* The possible classes are: */ - -/* @word @number */ -/* @alpha @int */ -/* @name @body */ -/* @english @unit */ -/* @epoc */ -/* @day */ -/* @time */ -/* @month */ -/* @year */ -/* @calendar */ - -/* Of these, the following can be modified by a */ -/* restriction template. */ - -/* @word @number */ -/* @alpha @int */ -/* @name @unit */ -/* @english */ -/* @month */ - -/* If CLASS is not one of these words ( possibly qualified */ -/* by a restriction template ) it is assumed to be a */ -/* specification keyword. */ - -/* $ Detailed_Output */ - -/* M2WMCH is returned as .TRUE. if */ - -/* 1.) CLASS is a META-KEY and STRINB(WORDB:WORDE) falls into */ -/* the category specified by this META-KEY */ - -/* or */ - -/* 2.) CLASS is determined to be a specification keyword and */ -/* STRING(WORDB:WORDE) is equal to this keyword. */ - -/* Otherwise, it is returned as .FALSE. */ - -/* $ Error_Handling */ - -/* None. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine for use by META/2. It determines */ -/* whether or not a word from a candidate sentence matches */ -/* a desired class. */ - -/* $ Examples */ - -/* The following table gives a sample of the results that */ -/* are returned by this function. */ - -/* WORD CLASS M2WMCH */ -/* --------- --------- ------ */ -/* SEPARATION OBJECT F */ -/* SEPARATION @english T */ -/* SEPARATION @english(T*) F */ -/* SEPARATION @english(T*|S*) T */ -/* 12:15:15 @number F */ -/* 12:15:15 @time T */ -/* 44:12:18 @time F */ -/* PIG @english T */ -/* PIG @int T */ -/* 12.182 NUMBER F */ -/* 12.182 @number T */ -/* 12.182 @int F */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - META/2 Configured Version 3.1.0, 07-NOV-2005 (BVS) */ - -/* Fixed the way ZZTOKNS is called. */ - -/* - META/2 Configured Version 3.0.0, 23-MAR-2000 (WLT) */ - -/* Extended the routine so that it can now check the keyword */ -/* @unit and @unit(unitspec). */ - -/* - 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, 31-MAR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* There are some obvious things we can handle right now. */ -/* Note that if we input a substring that is completely outside */ -/* the range (1, LEN(STRING)), then WB will be greater than WE. */ -/* Otherwize we will have trimmed the substring to lie within */ -/* the bounds of the string. */ - - wb = max(*wordb,1); -/* Computing MIN */ - i__1 = *worde, i__2 = i_len(string, string_len); - we = min(i__1,i__2); - if (wb > we) { - ret_val = FALSE_; - return ret_val; - } - -/* Get the first and last characters of CLASS */ -/* These are EXPECTED to be the first and last characters of */ -/* CLASS. */ - - beg = 1; - l = i_len(class__, class_len); - lbrace = '['; - rbrace = ']'; - -/* Next see if there is a name attached to which we will write the */ -/* results of successful matches. */ - - namfnd = FALSE_; - end = l; - -/* If the length is not at least 4 or the last character is not */ -/* a right brace, there is no name associated with this word. */ - - if (*(unsigned char *)&class__[l - 1] == rbrace && l >= 4) { - -/* Ok. We have a chance at getting a name. Look for */ -/* a left brace and if found set the name and class end. */ - - i__ = 2; - while(i__ < l - 1) { - if (*(unsigned char *)&class__[i__ - 1] == lbrace) { - nb = i__ + 1; - ne = l - 1; - end = i__ - 1; - i__ = l; - namfnd = TRUE_; - } - ++i__; - } - } - -/* See if CLASS represents a specification keyword or a META-KEY. */ - - m2tran_(class__, &beg, &end, base, &key, &temp, class_len, (ftnlen)32); - -/* If we have a specification keyword, the input WORD must match */ -/* exactly. */ - - if (key) { - ret_val = eqstr_(class__, string + (wb - 1), end, we - (wb - 1)); - -/* See if we are trying to match a numeric string. */ - - } else if (s_cmp(base, "@int", (ftnlen)32, (ftnlen)4) == 0 || s_cmp(base, - "@number", (ftnlen)32, (ftnlen)7) == 0) { - if (s_cmp(base, "@int", (ftnlen)32, (ftnlen)4) == 0) { - ret_val = m2int_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@number", (ftnlen)32, (ftnlen)7) == 0) { - ret_val = m2numb_(string + (wb - 1), we - (wb - 1)); - } - if (ret_val && temp) { - -/* Parse the number and see if it is in bounds. */ - - m2ntem_(class__, base, &beg, &end, &x, &y, class_len, (ftnlen)32); - nparsd_(string + (wb - 1), &v, error, &pntr, we - (wb - 1), ( - ftnlen)160); - ret_val = v <= y && v >= x; - } - if (ret_val && namfnd) { - m2save_(class__ + (nb - 1), &wb, &we, ne - (nb - 1)); - } - return ret_val; - } else if (s_cmp(base, "@unit", (ftnlen)32, (ftnlen)5) == 0) { - ret_val = m2unit_(string + (wb - 1), we - (wb - 1)); - if (ret_val && temp) { - xin = 1.; - i__1 = beg; - convrt_3__(&xin, string + (wb - 1), class__ + i__1, &xout, & - status, we - (wb - 1), end - 1 - i__1); - ret_val = status == 0; - } - if (ret_val && namfnd) { - m2save_(class__ + (nb - 1), &wb, &we, ne - (nb - 1)); - } - return ret_val; - } else if (s_cmp(base, "@name", (ftnlen)32, (ftnlen)5) == 0) { - ret_val = m2name_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@body", (ftnlen)32, (ftnlen)5) == 0) { - ret_val = m2body_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@english", (ftnlen)32, (ftnlen)8) == 0) { - ret_val = m2engl_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@alpha", (ftnlen)32, (ftnlen)6) == 0) { - ret_val = m2alph_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@time", (ftnlen)32, (ftnlen)5) == 0) { - ret_val = m2time_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@epoch", (ftnlen)32, (ftnlen)6) == 0) { - ret_val = m2epoc_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@day", (ftnlen)32, (ftnlen)4) == 0) { - ret_val = m2day_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@year", (ftnlen)32, (ftnlen)5) == 0) { - ret_val = m2year_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@month", (ftnlen)32, (ftnlen)6) == 0) { - ret_val = m2mon_(string + (wb - 1), we - (wb - 1)); - } else if (s_cmp(base, "@calendar", (ftnlen)32, (ftnlen)9) == 0) { - tmplog = zztokns_(string + (wb - 1), error, we - (wb - 1), (ftnlen) - 160); - ret_val = s_cmp(error, " ", (ftnlen)160, (ftnlen)1) == 0; - } else if (s_cmp(base, "@word", (ftnlen)32, (ftnlen)5) == 0) { - ret_val = TRUE_; - } - if (ret_val && temp) { - i__1 = beg; - ret_val = matchm_(string + (wb - 1), class__ + i__1, "*", "%", "~", - "|", we - (wb - 1), end - 1 - i__1, (ftnlen)1, (ftnlen)1, ( - ftnlen)1, (ftnlen)1); - } - if (ret_val && namfnd) { - m2save_(class__ + (nb - 1), &wb, &we, ne - (nb - 1)); - } - return ret_val; -} /* m2wmch_ */ - diff --git a/ext/spice/src/csupport/m2xist.c b/ext/spice/src/csupport/m2xist.c deleted file mode 100644 index 05eb324ffe..0000000000 --- a/ext/spice/src/csupport/m2xist.c +++ /dev/null @@ -1,190 +0,0 @@ -/* m2xist.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2XIST ( META/2 --- does a named template word exist ) */ -logical m2xist_(char *name__, ftnlen name_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - static integer size; - extern /* Subroutine */ int m2vsiz_(char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Determine whether or not a named template word has been matched */ -/* and had the corresponding matching word boundaries stored in */ -/* the META/2 parse tables. */ - -/* $ 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 */ - -/* META/2 */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of a META/2 template word. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a META/2 template word that may have */ -/* been matched by a call to M2GMCH. The case of NAME */ -/* is significant. 'BOB', 'Bob', and 'bob' will be */ -/* regarded as different names. */ - -/* $ Detailed_Output */ - -/* M2XIST is returned .TRUE. if the named template word has */ -/* been stored in the META/2 parse table. Otherwise */ -/* it is returned .FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Once a string has matched some META/2 template, it is often */ -/* necessary to determine which template has been matched or which */ -/* sub-template has been matched before a program can respond */ -/* appropriately. In some cases, the mere existance of a match */ -/* is sufficient to determine the action a routine should take. */ - -/* This routine exists so that you can easily find out whether a */ -/* match for a particular named template word occurred. */ - -/* $ Examples */ - -/* Suppose that a string command was expected to match one of the */ -/* following two templates. */ - -/* 'FIND SEPARATION[separation] */ -/* (2:2){ OF @int[body1] @int[body2] */ -/* | FROM @int[observer] }' */ - -/* 'FIND DISTANCE[distance] */ -/* (2:2){ BETWEEN @int[body1] @int[body2] */ -/* | FROM @int[observer] }' */ - -/* The action a routine will take will depend upon which template */ -/* was actually matched. But since we know that we have a match */ -/* of one of these templates, the work of extracting the bodies */ -/* and observer can be common to both types of strings. */ - - -/* CALL M2GETI ( 'body1', STRING, FOUND, BODY1 ) */ -/* CALL M2GETI ( 'body2', STRING, FOUND, BODY2 ) */ -/* CALL M2GETI ( 'observer', STRING, FOUND, OBS ) */ -/* C */ -/* C Look up the apparent states of the bodies relative */ -/* C to the specified observer. */ -/* C */ -/* CALL SPKEZ ( BODY1, ET, 'J2000', 'LT+S', OBS, STATE1, LT ) */ -/* CALL SPKEZ ( BODY2, ET, 'J2000', 'LT+S', OBS, STATE2, LT ) */ - -/* C */ -/* C Now compute the ANSWER based upon whether separation or */ -/* C distance was specified. */ -/* C */ -/* IF ( M2XIST('separation') ) THEN */ - -/* ANSWER = VSEP ( STATE1, STATE2 ) */ - -/* ELSE IF ( M2XIST('distance') ) THEN */ - -/* ANSWER = VDIST ( STATE1, STATE2 ) */ - -/* END IF */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 27-NOV-1991 (WLT) */ - -/* -& */ - -/* $ Index_Entry */ - -/* Check for the presence of a named match in the META/2 tables. */ - -/* -& */ - -/* Local variables */ - - -/* Find out how many endpoints were matched. The NAME is there */ -/* if SIZE is greater than 0. */ - - m2vsiz_(name__, &size, name_len); - ret_val = size > 0; - return ret_val; -} /* m2xist_ */ - diff --git a/ext/spice/src/csupport/m2year.c b/ext/spice/src/csupport/m2year.c deleted file mode 100644 index a1476c1d1f..0000000000 --- a/ext/spice/src/csupport/m2year.c +++ /dev/null @@ -1,237 +0,0 @@ -/* m2year.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure M2YEAR ( Determine whether or not a word is a year ) */ -logical m2year_(char *word, ftnlen word_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer i__, value; - extern integer ltrim_(char *, ftnlen); - static integer i1, i2, i3, i4, length, values[256]; - extern integer qrtrim_(char *, ftnlen); - -/* $ Abstract */ - -/* This function is true if the input string is a year 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 a META/2 year. */ - -/* $ Detailed_Input */ - -/* WORD is a character string that is assumed to have no */ -/* spaces between the first and last non-blank characters. */ - -/* $ Detailed_Output */ - -/* M2YEAR returns as .TRUE. if WORD is a META/2 year. */ -/* 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 year in the sense */ -/* of the language META/2. */ - -/* $ Examples */ - -/* WORD M2YEAR */ -/* ------- ------ */ -/* SPAM .FALSE. */ -/* 1 .TRUE. */ -/* 0.289E19 .FALSE. */ -/* 0.2728D12 .FALSE. */ -/* -12.1892e-5 .FALSE. */ -/* 12.E29 .FALSE. */ -/* 12.E291 .FALSE. */ -/* 1.2E10 .TRUE. */ -/* .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.1.0, 29-DEC-1994 (WLT) */ - -/* The computation of the length of the input string */ -/* was incorrect. It has been fixed. It used to be */ - -/* LENGTH = I3 - I1 + 1 */ - -/* Now it is */ - -/* LENGTH = I4 - I1 + 1 */ - - - -/* - 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 */ - - if (first) { - first = FALSE_; - -/* We will construct a value for the string by taking */ -/* the non-blank portion and computing the value assuming */ -/* that the first non-blank is a digit with the appropriate */ -/* power of 10 attached. Since all non-digit characters */ -/* will have values of 1000, we will get a value greater */ -/* than 1000 if any non-digit characters are present. */ - - for (i__ = 0; i__ <= 255; ++i__) { - values[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("values", - i__1, "m2year_", (ftnlen)182)] = 10000; - } - values[(i__1 = '0') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)185)] = 0; - values[(i__1 = '1') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)186)] = 1; - values[(i__1 = '2') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)187)] = 2; - values[(i__1 = '3') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)188)] = 3; - values[(i__1 = '4') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)189)] = 4; - values[(i__1 = '5') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)190)] = 5; - values[(i__1 = '6') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)191)] = 6; - values[(i__1 = '7') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)192)] = 7; - values[(i__1 = '8') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)193)] = 8; - values[(i__1 = '9') < 256 && 0 <= i__1 ? i__1 : s_rnge("values", i__1, - "m2year_", (ftnlen)194)] = 9; - } - -/* Make sure the string has the right length. */ - - i1 = ltrim_(word, word_len); - i4 = qrtrim_(word, word_len); - length = i4 - i1 + 1; - -/* Rule out the goofy cases that NPARSD will allow. */ - - if (length != 4) { - value = 10000; - } else { - i2 = i1 + 1; - i3 = i2 + 1; - value = values[(i__1 = *(unsigned char *)&word[i1 - 1]) < 256 && 0 <= - i__1 ? i__1 : s_rnge("values", i__1, "m2year_", (ftnlen)218)] - * 1000 + values[(i__2 = *(unsigned char *)&word[i2 - 1]) < - 256 && 0 <= i__2 ? i__2 : s_rnge("values", i__2, "m2year_", ( - ftnlen)218)] * 100 + values[(i__3 = *(unsigned char *)&word[ - i3 - 1]) < 256 && 0 <= i__3 ? i__3 : s_rnge("values", i__3, - "m2year_", (ftnlen)218)] * 10 + values[(i__4 = *(unsigned - char *)&word[i4 - 1]) < 256 && 0 <= i__4 ? i__4 : s_rnge( - "values", i__4, "m2year_", (ftnlen)218)]; - } - -/* That's all just make sure that the value is within the */ -/* bound required of a year. */ - - ret_val = value >= 1000 && value <= 3000; - return ret_val; -} /* m2year_ */ - diff --git a/ext/spice/src/csupport/makstr.c b/ext/spice/src/csupport/makstr.c deleted file mode 100644 index 8f15392ce9..0000000000 --- a/ext/spice/src/csupport/makstr.c +++ /dev/null @@ -1,860 +0,0 @@ -/* makstr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MAKSTR (Make String ) */ -/* Subroutine */ int makstr_0_(int n__, char *pattrn, char *this__, char * - next, ftnlen pattrn_len, ftnlen this_len, ftnlen next_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - logical keep; - integer i__, j, k; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer min__, max__; - -/* $ Abstract */ - -/* Make a string matching a pattern. This routine serves as an */ -/* umbrella routine for the two entry points FSTSTR and NXTSTR. */ - -/* $ 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 */ - -/* Utility */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PATTRN I FSTSTR, NXTSTR */ -/* THIS I NXTSTR */ -/* NEXT O FSTSTR, NXSTR */ - -/* $ Detailed_Input */ - -/* PATTRN is a string that specifies a pattern that all strings */ -/* in a sequence must match. There are several special */ -/* substrings in PATTRN that must be recognized. */ - -/* 1) A substring of the form '<*>' (where * is used */ -/* as a variable length wildcard character) is called */ -/* an expansion. The substring that occurs between */ -/* the angle brackets < > is called the invisible */ -/* portion of the expansion. When the tokens of */ -/* PATTRN are counted the invisible portion of the */ -/* expansion is not counted. Thus an expansion has */ -/* exactly two tokens '<' and '>' The invisible */ -/* portion of the expansion must not contain */ -/* any of the characters '<', '>', '{', or '}'. */ - -/* 2) A substring of the form '{#-$}' where # and $ */ -/* stand for any chacter from the set */ -/* '0', ... , '9', 'a', ... , 'z' is called a */ -/* restriction. */ - -/* A pattern may consist of any collection of */ -/* characters. However, the characters '<' and */ -/* '>' must always occur in balanced pairs with '<' */ -/* on the left and '>' on the right. Moreover, they */ -/* cannot be nested even if they are balanced. Similary */ -/* '{' and '}' must always appear as a balanced pair */ -/* and have exactly 3 characters between them. The */ -/* first is a lower case letter or a digit. The second */ -/* letter may be anything (usually a hyphen, colon or */ -/* comma). The third character must */ -/* also be a letter between 0, ... ,9, a, b, ... , z */ -/* and must occur later in the collating sequence than */ -/* the first letter in the triple that occurs between */ -/* '{' and '}'. */ - -/* For example the following are valid patterns */ - -/* PAT__{0-9}{a-z}{a-d} */ -/* COUNTER{0-9}{0-9}{0-9}{0-9} */ -/* COUNTER{0:9}{0,9}{a;b} */ - -/* but the following are not */ - -/* PAT_<<>>_{0-9}{a-z}{a-d} --- Nested < > */ -/* COUNTER{9-0} --- 9 before 0 */ -/* PAT_{0to0} --- 4 characters between{} */ -/* PAT_{A-Z} --- uppercase letters in{} */ -/* PAT_{+-$} --- bad characters in {} */ - -/* Pattern should be viewed as consisting of a sequence */ -/* of tokens. The tokens consist of characters that */ -/* are not part of an expansion or restriction */ -/* restrictions and the '<' and '>' characters of */ -/* any expansion. */ - -/* THIS is a string that should be incremented to get the */ -/* NEXT string that matches the pattern. */ - -/* Note THIS must match the input pattern. */ - -/* The tokens of THIS are the characters upto and */ -/* including the last non-blank character of THIS. */ - -/* This should have the same number of tokens as does */ -/* PATTRN. */ - -/* Suppose that TOKTHS (I) is the I'th token of THIS */ -/* and that TOKPAT(I) is the I'th token of PATTRN. */ - -/* If TOKPAT(I) is a restriction then TOKTHS(I) must */ -/* be one of the characters belonging to the range */ -/* of the restriction. */ - -/* Otherwise TOKPAT(I) and TOKTHS(I) match. */ - -/* Thus the pattern */ - -/* 'XXX{0-9}{0-z}' */ - -/* Matches */ - -/* 'THIS_5a' */ - -/* This kind of matching is of course a bit */ -/* confusing. It is probably more useful to */ -/* have THIS take all of its tokens to be identical */ -/* to the character tokens of of PATTRN and match */ -/* the restriction tokens in all other cases. */ - -/* In particular, the routine FSTSTR, will take */ -/* PATTRN as an input and produce the a first */ -/* string in the sequence of strings that matches */ -/* PATTRN by simply copying the character tokens */ -/* of PATTRN to the output string and taking the */ -/* lower bound of the restrictions of PATTRN */ -/* to get the matching tokens for each restriction. */ - -/* See FSTSTR for a more complete discussion. */ - -/* $ Detailed_Output */ - -/* NEXT See the entry points FSTSTR and NXTSTR */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a rather immature routine that can assist with the */ -/* problem of constructing a sequence of character strings. */ - -/* This routine was written as a support routine for the */ -/* SPICE program CHRISTEN and the routine NOMEN. As such */ -/* it was possible to ensure that all of the detailed conditions */ -/* of PATTRN and THIS were met by the routines that call this. */ - -/* However, this routine can prove useful in other contexts and */ -/* is provided so that you can easily produce a large sequence of */ -/* non-repeating character strings. But YOU MUST BE CAREFUL */ -/* WITH YOUR USE OF THIS ROUTINE. Unlike most SPICE routines */ -/* there is no exception handling done. If you pass in a bad PATTRN */ -/* or value for THIS that does not match PATTRN the result are */ -/* of this routine are unpredictable. The routine will certainly */ -/* not diagnose the problem and can possibly cause your program */ -/* to crash with no diagnostics to help with finding the problem. */ - -/* If you simply need to produce a sequence of strings, you */ -/* should probably avoid putting expansions ( substrings like */ -/* ) in your input pattern. These are special */ -/* strings that support the tasks needed by NOMEN and CHRISTEN. */ - -/* Stick to simple patterns such as the one shown here: */ - -/* PATTRN = 'base{0-z}{0-z}{0-z}{0-z}.tmp' */ - -/* THIS = 'base0000.tmp' */ - -/* For creating file names or unique non-frequently repeating */ -/* strings, this will probably do the job. */ - -/* Note that upper case letters are not supported in PATTRNs, this */ -/* is a UNIX-ish restriction (most file names are written in */ -/* lower case in UNIX). This routine could be easily modified */ -/* to support a wider range of characters. Or if you want all */ -/* uppercase characters, apply the SPICE routine UPPER to NEXT */ -/* when you get back from your call to NXTSTR. */ - -/* Still even with all the restrictions and lack of exception */ -/* handling this does solve a basic problem of creating an */ -/* increasing sequence of character strings and saves you */ -/* from the task of figuring out the details (in particular */ -/* how to cascade up the string when you have many letters */ -/* to change to get to the next string). */ - -/* The most common useage is to use FSTSTR to get a first string */ -/* in a sequence that matches PATTRN and then to call NXTSTR */ -/* to produce subsequent matching strings. */ - -/* $ Examples */ - -/* See the inividiual entry points. */ - -/* $ Restrictions */ - -/* There are lots of restrictions. See the detailed input */ -/* and particulars for all the warnings. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Support Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Placed a RETURN statement before the first entry point */ -/* to protect against the coding error of calling the */ -/* subroutine MAKSTR directly. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Prototype Version 1.0.0, 16-APR-1994 (WLT) */ - - -/* -& */ - -/* Spicelib functions */ - - -/* Local Varialbes */ - - switch(n__) { - case 1: goto L_fststr; - case 2: goto L_nxtstr; - } - - return 0; -/* $Procedure FSTSTR ( First string matching a pattern ) */ - -L_fststr: -/* $ Abstract */ - -/* Given a naming pattern, this routine produces the first */ -/* legal name implied by the pattern. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* CHARACTER*(*) PATTRN */ -/* CHARACTER*(*) NEXT */ - -/* $ Brief_I/O */ -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PATTRN I A pattern to use when constructing strings */ -/* NEXT O The first pattern that fits the input pattern */ - -/* $ Detailed_Input */ - -/* PATTRN is a pattern from which NEXT will be constructed. */ -/* See the discussion of PATTRN in the umbrella routine */ -/* for more details. */ - -/* $ Detailed_Output */ - -/* NEXT is the first string in the ASCII collating sequence */ -/* that matches pattern. The tokens of NEXT are the */ -/* characters up to the last non-blank character. The */ -/* number of tokens in NEXT and PATTRN are the same. */ -/* Moreover, the tokens of NEXT are constructed from */ -/* PATTRN from the following rule: */ - -/* If TOKEN(I) is the I'th token of PATTRN and */ -/* it is not a restriction (i.e. it's a single letter) */ -/* then the I'th token of NEXT is TOKEN(I). */ - -/* If TOKEN(I) is the I'th token of PATTRN and it */ -/* is a restriction then the I'th token of NEXT is */ -/* the character of the restriction that follows */ -/* the left brace '{' of the restriction. */ - -/* In particular this means that expansions are copied */ -/* into NEXT as simply '<>'. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the output string is not long enough to hold the */ -/* first string that matches PATTRN the error */ -/* SPICE(OUTPUTTOOLONG) will be signalled. */ - -/* $ Particulars */ - -/* This is a rather immature routine that is used by Christen for */ -/* generating the first string in a sequence of strings specified */ -/* by a naming convention. There are plenty of things that could */ -/* go wrong if the input PATTRN is not well formed or if there */ -/* is not room in NEXT to hold the string that should be */ -/* constructed by this routine. However, none of these problems */ -/* are checked for or diagnosed. */ - -/* Nevertheless, this routine may prove useful in many contexts */ -/* where you need to create a sequence of names and simply want */ -/* to start with a pattern and let software handle the rest for */ -/* you. */ - -/* Normal usage would be to use FSTSTR to get the first string */ -/* of a set specified by a string pattern and to then generate */ -/* the rest using the routine NXTSTR. This can be useful in those */ -/* situations where you need to create a new file and don't want */ -/* to overwrite any existing file. */ - -/* If you plan to make use of this routine in conjuction with */ -/* NXTSTR you should be sure to read the discussion of NXTSTR */ -/* that appears in the header to that routine. */ - -/* $ Examples */ - -/* Suppose that you want to be able to create a file name */ -/* that can be used as a scratch area for some aspect of your */ -/* program. You can use this routine in conjuction with NXTSTR */ -/* to generate a name of a NEW file for this purpose. */ - -/* PATTRN = 'file{0-z}{0-z}{0-z}{0-z}.tmp' */ - -/* CALL FSTSTR ( PATTRN, NAME ) */ - -/* DO WHILE ( EXISTS(NAME) ) */ - -/* THIS = NAME */ -/* CALL NXTSTR ( PATTRN, THIS, NAME ) */ - -/* END DO */ - -/* CALL TXTOPN ( NAME, UNIT ) */ - - -/* $ Restrictions */ - -/* There are lots of restrictions associated with PATTRN and */ -/* NEXT that are discussed above. This routine doesn't perform */ -/* any error checking so you need to be sure that the inputs */ -/* are properly specified before you call this routine. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Support Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Placed a RETURN statement before the first entry point */ -/* to protect against the coding error of calling the */ -/* subroutine MAKSTR directly. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Prototype Version 1.0.0, 17-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the first name in a sequence that matches a pattern */ - -/* -& */ - -/* There are two things to handle: */ - -/* balanced brackets: <> */ -/* balanced braces: {} */ - -/* We do this in one pass. */ - - s_copy(next, " ", next_len, (ftnlen)1); - keep = TRUE_; - j = 1; - i__1 = rtrim_(pattrn, pattrn_len); - for (i__ = 1; i__ <= i__1; ++i__) { - if (*(unsigned char *)&pattrn[i__ - 1] == '>') { - keep = TRUE_; - } - if (*(unsigned char *)&pattrn[i__ - 1] == '{') { - i__2 = i__; - s_copy(next + (j - 1), pattrn + i__2, (ftnlen)1, i__ + 1 - i__2); - ++j; - keep = FALSE_; - } - if (keep) { - *(unsigned char *)&next[j - 1] = *(unsigned char *)&pattrn[i__ - - 1]; - ++j; - } - if (*(unsigned char *)&pattrn[i__ - 1] == '<') { - keep = FALSE_; - } - if (*(unsigned char *)&pattrn[i__ - 1] == '}') { - keep = TRUE_; - } - if (j > i_len(next, next_len)) { - chkin_("FSTSTR", (ftnlen)6); - setmsg_("The string provided for the first name is too short for" - " the input pattern. ", (ftnlen)75); - sigerr_("SPICE(OUTPUTTOOLONG)", (ftnlen)20); - chkout_("FSTSTR", (ftnlen)6); - } - } - return 0; -/* $Procedure NXTSTR (Next String) */ - -L_nxtstr: -/* $ Abstract */ - -/* Given a pattern for incrementing a string and a current */ -/* string value (that fits the pattern) produce the next */ -/* string in the sequence. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ - -/* CHARACTER*(*) PATTRN */ -/* CHARACTER*(*) THIS */ -/* CHARACTER*(*) NEXT */ - -/* $ Brief_I/O */ -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PATTRN I a pattern to use to get NEXT from THIS */ -/* THIS I is a string that matches PATTRN */ -/* NEXT O is the first string after THIS to match PATTRN */ - -/* $ Detailed_Input */ - -/* PATTRN is a string that specifies a pattern that all strings */ -/* in a sequence must match. See the discussion of */ -/* PATTRN in the umbrella routine for more details. */ - -/* THIS is a string that should be incremented to get the */ -/* NEXT string that matches the pattern. */ - -/* Note THIS must match the input pattern. */ - -/* The tokens of THIS are the characters upto and */ -/* including the last non-blank character of THIS. */ - -/* This should have the same number of tokens as does */ -/* PATTRN. */ - -/* Suppose that TOKTHS (I) is the I'th token of THIS */ -/* and that TOKPAT(I) is the I'th token of PATTRN. */ - -/* If TOKPAT(I) is a restriction then TOKTHS(I) must */ -/* be one of the characters belonging to the range */ -/* of the restriction. */ - -/* Otherwise TOKPAT(I) and TOKTHS(I) match. */ - -/* Thus the pattern */ - -/* 'XXX{0-9}{0-z}' */ - -/* Matches */ - -/* 'THIS_5a' */ - -/* This kind of matching is of course a bit */ -/* confusing. It is probably more useful to */ -/* have THIS take all of its tokens to be identical */ -/* to the character tokens of of PATTRN and match */ -/* the restriction tokens in all other cases. */ - -/* In particular, the routine FSTSTR, will take */ -/* PATTRN as an input and produce the a first */ -/* string in the sequence of strings that matches */ -/* PATTRN by simply copying the character tokens */ -/* of PATTRN to the output string and taking the */ -/* lower bound of the restrictions of PATTRN */ -/* to get the matching tokens for each restriction. */ - -/* See FSTSTR for a more complete discussion. */ - -/* $ Detailed_Output */ - -/* NEXT is the next string in the ascii collating */ -/* sequence that matches PATTRN and is equal to */ -/* THIS on the non-restriction matching letters */ -/* of THIS. There is one exception to this rule. */ -/* If there is no such string, (i.e. THIS is the */ -/* last string that can be produced that matches */ -/* PATTRN) then NEXT will be the first string */ -/* that matches PATTRN and is equal to THIS on the */ -/* non-restriction matching letters of THIS. */ - -/* If PATTRN contains no restrictions, then NEXT */ -/* will equal THIS. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This is a rather immature routine that can assist with the */ -/* problem of constructing a sequence of character strings. */ - -/* This routine was written as a support routine for the */ -/* SPICE program CHRISTEN and the routine NOMEN. As such */ -/* it was possible to ensure that all of the detailed conditions */ -/* of PATTRN and THIS were met by the routines that call this. */ - -/* However, this routine can prove useful in other contexts and */ -/* is provided so that you can easily produce a large sequence of */ -/* non-repeating character strings. But YOU MUST BE CAREFUL */ -/* WITH YOUR USE OF THIS ROUTINE. Unlike most SPICE routines */ -/* there is no exception handling done. If you pass in a bad PATTRN */ -/* or value for THIS that does not match PATTRN the result are */ -/* of this routine are unpredictable. The routine will certainly */ -/* not diagnose the problem and can possibly cause your program */ -/* to crash with no diagnostics to help with finding the problem. */ - -/* If you simply need to produce a sequence of strings, you */ -/* should probably avoid putting expansions ( substrings like */ -/* ) in your input pattern. These are special */ -/* strings that support the tasks needed by NOMEN and CHRISTEN. */ - -/* Stick to simple patterns such as the one shown here: */ - -/* PATTRN = 'base{0-z}{0-z}{0-z}{0-z}.tmp' */ - -/* THIS = 'base0000.tmp' */ - -/* For creating file names or unique non-frequently repeating */ -/* strings, this will probably do the job. */ - -/* Note that upper case letters are not supported in PATTRNs, this */ -/* is a UNIX-ish restriction (most file names are written in */ -/* lower case in UNIX). This routine could be easily modified */ -/* to support a wider range of characters. Or if you want all */ -/* uppercase characters, apply the SPICE routine UPPER to NEXT */ -/* when you get back from your call to NXTSTR. */ - -/* Still even with all the restrictions and lack of exception */ -/* handling this does solve a basic problem of creating an */ -/* increasing sequence of character strings and saves you */ -/* from the task of figuring out the details (in particular */ -/* how to cascade up the string when you have many letters */ -/* to change to get to the next string). */ - -/* $ Examples */ - -/* Suppose you wanted to create the sequence of strings that */ -/* give the times on a 24 hour clock. I.e 00:00:00, 00:00:01, ... */ -/* 23:59:59. This routine is ideally suited to this task. */ - -/* PATTRN = {0-2}{0-9}:{0-5}{0-9}:{0-5}{0-9} */ -/* START = '29:59:59' */ -/* LAST = '23:59:59' */ - -/* THIS = START */ - -/* DO WHILE ( NEXT .NE. LAST ) */ - -/* CALL NXTSTR ( PATTRN, THIS, NEXT ) */ -/* WRITE (*,*) NEXT */ - -/* THIS = NEXT */ - -/* END DO */ - - -/* The output of the routine would be: */ - -/* 00:00:00 */ -/* 00:00:01 */ -/* 00:00:02 */ - -/* . */ -/* . */ -/* . */ - -/* 23:59:57 */ -/* 23:59:58 */ -/* 23:59:59 */ - - -/* $ Restrictions */ - -/* There are lots of restrictions. See the detailed input */ -/* and particulars for all the warnings. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Support Version 1.1.0, 18-JUN-1999 (WLT) */ - -/* Placed a RETURN statement before the first entry point */ -/* to protect against the coding error of calling the */ -/* subroutine MAKSTR directly. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Prototype Version 1.0.0, 16-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Construct a non-repeating increasing sequence of strings */ - -/* -& */ - -/* First copy THIS into NEXT and find the ends of PATTRN and NEXT. */ - - s_copy(next, this__, next_len, this_len); - j = rtrim_(pattrn, pattrn_len); - i__ = rtrim_(next, next_len); - -/* We work backwards from the right end of the string. */ - - while(j > 0) { - -/* If the current character is a right brace we are going */ -/* to assume we are at the end of a restriction token. Use */ -/* the range of the restriction and the current character */ -/* of NEXT to determine the "next" character and whether or */ -/* not we can quit now. */ - - if (*(unsigned char *)&pattrn[j - 1] == '}') { - i__1 = j - 2; - max__ = *(unsigned char *)&pattrn[i__1]; - i__1 = j - 4; - min__ = *(unsigned char *)&pattrn[i__1]; - k = *(unsigned char *)&next[i__ - 1] + 1; - if (k > max__) { - -/* Roll over the characters, We aren't done we */ -/* need to keep stepping back through the string */ - - *(unsigned char *)&next[i__ - 1] = (char) min__; - } else if (k > '9' && k < 'a') { - -/* By convention, the first character following '9' is 'a'. */ -/* Since we don't need to "roll over" this character we */ -/* are done at this point. */ - - *(unsigned char *)&next[i__ - 1] = 'a'; - return 0; - } else { - -/* We didn't need to roll over the character so we just */ -/* put in the new one and we can quit now. */ - - *(unsigned char *)&next[i__ - 1] = (char) k; - return 0; - } - -/* perform the arithmetic needed if we had to roll over the */ -/* character. */ - - j += -5; - --i__; - -/* If the character is '>' we assume we are at the right end */ -/* of an expansion. */ - - } else if (*(unsigned char *)&pattrn[j - 1] == '>') { - -/* Skip over the invisible portion of the expansion. */ - - while(*(unsigned char *)&pattrn[j - 1] != '<') { - --j; - } - --i__; - } else { - -/* Nothing to do, just back up to the character to the */ -/* left of the current character. */ - - --j; - --i__; - } - } - return 0; -} /* makstr_ */ - -/* Subroutine */ int makstr_(char *pattrn, char *this__, char *next, ftnlen - pattrn_len, ftnlen this_len, ftnlen next_len) -{ - return makstr_0_(0, pattrn, this__, next, pattrn_len, this_len, next_len); - } - -/* Subroutine */ int fststr_(char *pattrn, char *next, ftnlen pattrn_len, - ftnlen next_len) -{ - return makstr_0_(1, pattrn, (char *)0, next, pattrn_len, (ftnint)0, - next_len); - } - -/* Subroutine */ int nxtstr_(char *pattrn, char *this__, char *next, ftnlen - pattrn_len, ftnlen this_len, ftnlen next_len) -{ - return makstr_0_(2, pattrn, this__, next, pattrn_len, this_len, next_len); - } - diff --git a/ext/spice/src/csupport/match.c b/ext/spice/src/csupport/match.c deleted file mode 100644 index 1de8bba3e7..0000000000 --- a/ext/spice/src/csupport/match.c +++ /dev/null @@ -1,239 +0,0 @@ -/* match.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MATCH ( Match string against multiple wildcard templates ) */ -logical match_(char *string, char *templ, ftnlen string_len, ftnlen templ_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern logical matchm_(char *, char *, char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Determines whether or not a string matches any of a */ -/* collection of templates containing wildcard characters. */ - -/* $ 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. */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to be matched against templates. */ -/* TEMPL I Collection of templates. */ - -/* $ Detailed_Input */ - -/* STRING is a character string to be checked for a match */ -/* against the specified collection of templates. */ -/* Leading and trailing blanks are ignored. */ - -/* TEMPL is a collection of individual templates to be */ -/* compared against the specified string. Leading */ -/* and trailing blanks are ignored. An empty (blank) */ -/* template collection matches only an empty (blank) */ -/* string. */ - -/* $ Detailed_Output */ - -/* The function is TRUE whenever the string matches the collection */ -/* of templates, and is FALSE otherwise. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* MATCH is exactly equivalent to MATCHM with the special characters */ -/* defined as follows. */ - -/* WCHR = '%' */ -/* WSTR = '*' */ -/* NOTCHR = '~' */ -/* ORCHR = '|' */ - -/* $ Examples */ - -/* 1. Normal Templates */ -/* ------------------- */ - -/* Consider the following string */ - -/* ' ABCDEFGHIJKLMNOPQRSTUVWXYZ ' */ - -/* and the following templates. */ - -/* Template Matches STRING? */ -/* --------------- --------------- */ -/* '*A*' Yes */ -/* 'A%D*' No */ -/* 'A%C*' Yes */ -/* '%A*' No */ -/* ' A* ' Yes */ - -/* '%%CD*Z' Yes */ -/* '%%CD' No */ -/* 'A*MN*Y*Z' Yes */ -/* 'A*MN*Y%Z' No */ -/* '*BCD*Z*' Yes */ -/* '*bcd*z*' No */ - - -/* 2. Negated Templates */ -/* -------------------- */ - -/* Consider the same string, and the following templates. */ - -/* Template Matches STRING? */ -/* --------------- --------------- */ -/* '~%B*D' Yes */ -/* '~%B*D*' No */ -/* '~ABC' Yes */ -/* '~ABC*' No */ -/* '~~B*' Yes */ - -/* Note that in the final example, the second '~' is treated not as */ -/* a second negation but as an ordinary character. */ - - -/* 3. Combining Templates */ -/* ---------------------- */ - -/* Consider the following strings and templates. */ - -/* String Template Matches? */ -/* -------------- ------------------- -------- */ -/* AKRON *A*|*B* Yes */ -/* BELOIT *B*|*I* Yes */ -/* CHAMPAGNE *B*|*I* No */ - - -/* 4. Combining Negated Templates */ -/* ------------------------------ */ - -/* Consider the following strings and templates. */ - -/* String Template Matches? */ -/* -------------- ------------------- -------- */ -/* SEQUIOA ~*A*|~*E*|~*I* No */ -/* SAINT PAUL ~*A*|~*E*|~*I* Yes */ -/* HOUSTON ~*A*|~*E*|~*I* Yes */ - - -/* 5. Negating Combined Templates */ -/* ------------------------------ */ - -/* Consider the following strings and templates. */ - -/* String Template Matches? */ -/* -------------- ------------------- -------- */ -/* DETROIT ~|B*|D* No */ -/* EUGENE ~|B*|D* Yes */ -/* FAIRBANKS ~|*A*|*I*|*O*|*U* No */ -/* GREENBELT ~|*A*|*I*|*O*|*U* Yes */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Common_Variables */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - - -/* META/2 Configured Version 2.1.0, 28-DEC-1994 (WLT) */ - -/* An initial value of FALSE is assigned to MATCH so */ -/* that if we are running in RETURN mode the function */ -/* will have a value. */ - -/* - 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 B 1.0.0, 15-MAY-1988 */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Give the function an intial value of FALSE */ - - ret_val = FALSE_; - -/* Standard SPICE error handling */ - - if (return_()) { - return ret_val; - } else { - chkin_("MATCH", (ftnlen)5); - } - ret_val = matchm_(string, templ, "*", "%", "~", "|", string_len, - templ_len, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1); - chkout_("MATCH", (ftnlen)5); - return ret_val; -} /* match_ */ - diff --git a/ext/spice/src/csupport/matchc.c b/ext/spice/src/csupport/matchc.c deleted file mode 100644 index eced248f03..0000000000 --- a/ext/spice/src/csupport/matchc.c +++ /dev/null @@ -1,389 +0,0 @@ -/* matchc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MATCHC ( Match the characters in two words ) */ -integer matchc_(char *word, char *guess, ftnlen word_len, ftnlen guess_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer uvalue[256] = { 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, - 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38, - 39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60, - 61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82, - 83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102, - 103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118, - 119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, - 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150, - 151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166, - 167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182, - 183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198, - 199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214, - 215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230, - 231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246, - 247,248,249,250,251,252,253,254,255 }; - static integer gcount[94] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0 }; - static integer wcount[94] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0 }; - - /* System generated locals */ - integer ret_val, i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen); - - /* Local variables */ - static integer nsig, c__, i__, j; - static doublereal scard, ucard; - static integer total, mn, mx, scardi, ucardi, hit[94]; - -/* $ Abstract */ - -/* Assign a score to a pair of words which reflects the closeness */ -/* of the words in terms of the characters they contain. Disregard */ -/* the case of letters */ - -/* $ 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. */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WORD I Word to be matched against initial guess. */ -/* GUESS I Initial guess. */ - -/* $ Detailed_Input */ - -/* WORD is a character string to be checked for a match */ -/* against an initial guess. Non-printing characters */ -/* (including blanks) are ignored. Typically, WORD will */ -/* contain a single word. In any case, the significant */ -/* part of WORD may not exceed 64 characters. */ - -/* GUESS is an initial guess at the value of the input */ -/* word. Non-printing characters (including blanks) */ -/* are ignored. Like WORD, this will typically be a */ -/* single word. In any case, the significant part of */ -/* GUESS may not exceed 64 characters. */ - -/* $ Detailed_Output */ - -/* The function returns a score between 0 (indicating that WORD */ -/* and GUESS have no characters in common) and 100 (indicating */ -/* that WORD and GUESS have all their characters in common). */ - -/* $ Exceptions */ - -/* 1) If neither WORD nor GUESS contains any printing characters, */ -/* the function returns 0. */ - -/* $ Particulars */ - -/* In order to determine whether a word (usually typed by a user) */ -/* matches any of a series of known words (keywords, for example), */ -/* it is necessary to be able to judge the "closeness" of an */ -/* arbitrary pair of words. Several algorithms exist which make */ -/* such a comparison, the best-known of which is probably the */ -/* Soundex algorithm. */ - -/* The score assigned by MATCHC differs from most other algorithms */ -/* in that multiple occurrences of letters are counted as distinct */ -/* characters. This allows the lengths of characters to enter into */ -/* the computation. */ - -/* Another difference is that MATCHC does not assign higher */ -/* weights to more "exotic" characters, like Q and Z, since these */ -/* are as likely to appear in mistyped words as are any other */ -/* characters. (Both Q and Z, for instance, are adjacent to A */ -/* on a standard keyboard.) */ - -/* The score assigned by MATCHC is computed in this way. */ - -/* 1) The characters in each word are sorted, assigned */ -/* ordinal numbers, and placed in a set. Thus, the word */ -/* 'APPEAL' gives rise to the set */ - -/* 'A1', 'A2', 'E1', 'L1', 'P1', 'P2' */ - -/* 2) The union and the symmetric difference of the sets */ -/* formed from WORD and GUESS are computed. */ - -/* 3) Letting #(U) and #(S) be the cardinalities of the */ -/* union and symmetric differences respectively, the */ -/* score assigned to the pair (WORD, GUESS) is */ - -/* #(S) */ -/* 100 * ( 1 - ---- ) */ -/* #(U) */ - -/* When WORD and GUESS have no characters in common, the symmetric */ -/* difference and the union are equivalent, and the score is zero. */ -/* When they share the same characters (including multiply occurring */ -/* characters), the symmetric difference is empty, and the score */ -/* is 100. */ - -/* $ Examples */ - - -/* $ Restrictions */ - -/* 1) MATCHC is case-sensitive. Lowercase characters do not match */ -/* uppercase characters, and vice versa. */ - -/* $ Common_Variables */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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 B 1.0.0, 5-APR-1988 */ - -/* -& */ - -/* SPICELIB functions */ - - -/* The printable character set is bounded below by ASCII character */ -/* 32 (SP) and above by ASCII character 127 (DEL). */ - - -/* Only the first 64 characters of WORD and GUESS are significant. */ - - -/* Local variables */ - - -/* Initialize the character mapping "function" (array). */ - - if (first) { - first = FALSE_; - uvalue[(i__1 = 'a') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)261)] = 'A'; - uvalue[(i__1 = 'b') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)262)] = 'B'; - uvalue[(i__1 = 'c') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)263)] = 'C'; - uvalue[(i__1 = 'd') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)264)] = 'D'; - uvalue[(i__1 = 'e') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)265)] = 'E'; - uvalue[(i__1 = 'f') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)266)] = 'F'; - uvalue[(i__1 = 'g') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)267)] = 'G'; - uvalue[(i__1 = 'h') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)268)] = 'H'; - uvalue[(i__1 = 'i') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)269)] = 'I'; - uvalue[(i__1 = 'j') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)270)] = 'J'; - uvalue[(i__1 = 'k') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)271)] = 'K'; - uvalue[(i__1 = 'l') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)272)] = 'L'; - uvalue[(i__1 = 'm') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)273)] = 'M'; - uvalue[(i__1 = 'n') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)274)] = 'N'; - uvalue[(i__1 = 'o') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)275)] = 'O'; - uvalue[(i__1 = 'p') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)276)] = 'P'; - uvalue[(i__1 = 'q') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)277)] = 'Q'; - uvalue[(i__1 = 'r') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)278)] = 'R'; - uvalue[(i__1 = 's') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)279)] = 'S'; - uvalue[(i__1 = 't') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)280)] = 'T'; - uvalue[(i__1 = 'u') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)281)] = 'U'; - uvalue[(i__1 = 'v') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)282)] = 'V'; - uvalue[(i__1 = 'w') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)283)] = 'W'; - uvalue[(i__1 = 'x') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)284)] = 'X'; - uvalue[(i__1 = 'y') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)285)] = 'Y'; - uvalue[(i__1 = 'z') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matchc_", (ftnlen)286)] = 'Z'; - } - -/* Tally up the characters in WORD. Also, everytime a new */ -/* character is encountered, increment the number of characters */ -/* that have been observed and record which new character has */ -/* just been observed. */ - - nsig = 0; - total = 0; - i__1 = i_len(word, word_len); - for (i__ = 1; i__ <= i__1; ++i__) { - c__ = uvalue[(i__2 = *(unsigned char *)&word[i__ - 1]) < 256 && 0 <= - i__2 ? i__2 : s_rnge("uvalue", i__2, "matchc_", (ftnlen)301)]; - if (c__ >= 33 && c__ <= 126) { - ++nsig; - if (nsig <= 64) { - if (wcount[(i__2 = c__ - 33) < 94 && 0 <= i__2 ? i__2 : - s_rnge("wcount", i__2, "matchc_", (ftnlen)309)] == 0) - { - ++total; - hit[(i__2 = total - 1) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "hit", i__2, "matchc_", (ftnlen)311)] = c__; - } - wcount[(i__2 = c__ - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "wcount", i__2, "matchc_", (ftnlen)314)] = wcount[( - i__3 = c__ - 33) < 94 && 0 <= i__3 ? i__3 : s_rnge( - "wcount", i__3, "matchc_", (ftnlen)314)] + 1; - } - } - } - -/* Tally up the characters in GUESS. Also, everytime a new */ -/* character is encountered, increment the number of characters */ -/* that have been observed and record which new character has */ -/* just been observed. */ - - nsig = 0; - i__1 = i_len(guess, guess_len); - for (i__ = 1; i__ <= i__1; ++i__) { - c__ = uvalue[(i__2 = *(unsigned char *)&guess[i__ - 1]) < 256 && 0 <= - i__2 ? i__2 : s_rnge("uvalue", i__2, "matchc_", (ftnlen)332)]; - if (c__ >= 33 && c__ <= 126) { - ++nsig; - if (nsig <= 64) { - if (wcount[(i__2 = c__ - 33) < 94 && 0 <= i__2 ? i__2 : - s_rnge("wcount", i__2, "matchc_", (ftnlen)340)] == 0) - { - if (gcount[(i__2 = c__ - 33) < 94 && 0 <= i__2 ? i__2 : - s_rnge("gcount", i__2, "matchc_", (ftnlen)341)] == - 0) { - ++total; - hit[(i__2 = total - 1) < 94 && 0 <= i__2 ? i__2 : - s_rnge("hit", i__2, "matchc_", (ftnlen)343)] = - c__; - } - } - gcount[(i__2 = c__ - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "gcount", i__2, "matchc_", (ftnlen)347)] = gcount[( - i__3 = c__ - 33) < 94 && 0 <= i__3 ? i__3 : s_rnge( - "gcount", i__3, "matchc_", (ftnlen)347)] + 1; - } - } - } - -/* Now look through the list of characters that were hit */ -/* and compute their contributions to the cardinality */ -/* of the symmetric difference and unions of the letter sets. */ - - scardi = 0; - ucardi = 0; - i__1 = total; - for (i__ = 1; i__ <= i__1; ++i__) { - j = hit[(i__2 = i__ - 1) < 94 && 0 <= i__2 ? i__2 : s_rnge("hit", - i__2, "matchc_", (ftnlen)369)]; - if (wcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge("wcount", - i__2, "matchc_", (ftnlen)371)] > gcount[(i__3 = j - 33) < 94 - && 0 <= i__3 ? i__3 : s_rnge("gcount", i__3, "matchc_", ( - ftnlen)371)]) { - mx = wcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "wcount", i__2, "matchc_", (ftnlen)372)]; - mn = gcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "gcount", i__2, "matchc_", (ftnlen)373)]; - } else { - mx = gcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "gcount", i__2, "matchc_", (ftnlen)375)]; - mn = wcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge( - "wcount", i__2, "matchc_", (ftnlen)376)]; - } - scardi = scardi + mx - mn; - ucardi += mx; - -/* While we're here, set the counts back to zero in preparation */ -/* for the next time this routine gets called. */ - - wcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge("wcount", - i__2, "matchc_", (ftnlen)386)] = 0; - gcount[(i__2 = j - 33) < 94 && 0 <= i__2 ? i__2 : s_rnge("gcount", - i__2, "matchc_", (ftnlen)387)] = 0; - } - scard = (doublereal) scardi; - ucard = (doublereal) ucardi; - - - -/* And assign the score. */ - - if (ucard == 0.) { - ret_val = 0; - } else if (scard <= 2.) { -/* Computing 2nd power */ - d__1 = scard / ucard; - ret_val = (integer) ((1. - d__1 * d__1) * 100.); - } else { - ret_val = (integer) ((1. - scard / ucard) * 100.); - } - return ret_val; -} /* matchc_ */ - diff --git a/ext/spice/src/csupport/matche.c b/ext/spice/src/csupport/matche.c deleted file mode 100644 index 0c5e561b59..0000000000 --- a/ext/spice/src/csupport/matche.c +++ /dev/null @@ -1,320 +0,0 @@ -/* matche.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MATCHE ( Match two words, allowing for common errors ) */ -/* Subroutine */ int matche_(char *word, char *guess, char *transf, integer * - loc, ftnlen word_len, ftnlen guess_len, ftnlen transf_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer clen; - char copy[65]; - integer i__; - char templ[65]; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - remsub_(char *, integer *, integer *, char *, ftnlen, ftnlen); - char mygues[65]; - extern integer qrtrim_(char *, ftnlen); - -/* $ Abstract */ - -/* Determines whether or not two words may be the same, */ -/* allowing for common typing errors. */ - -/* $ 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. */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WORD I Word to be matched against initial guess. */ -/* GUESS I Initial guess. */ -/* TRANSF O Transformation that makes WORD match GUESS. */ -/* LOC O Location at which to apply transformation. */ - -/* $ Detailed_Input */ - -/* WORD is a character string to be checked for a match */ -/* against an initial guess. Leading and trailing */ -/* blanks are ignored. Typically, WORD will contain */ -/* a single word. In any case, the significant part */ -/* of WORD may not exceed 64 characters. */ - -/* GUESS is an initial guess at the value of the input word. */ -/* Leading and trailing blanks are ignored. Like WORD, */ -/* this will typically be a single word. */ - -/* $ Detailed_Output */ - -/* TRANSF is the name of a transformation which, when applied */ -/* to WORD, makes WORD match with GUESS. The possible */ -/* transformations are: */ - -/* 'TRANSPOSE' Transpose two characters. */ - -/* 'REPLACE' Replace a single character. */ - -/* 'INSERT' Insert an extra character. */ - -/* 'REMOVE' Remove a character. */ - -/* 'IDENTITY' Do nothing. */ - -/* These reflect some of the most common typing mistakes. */ -/* If none if these transformations will do the trick, */ -/* TRANSF is 'NONE'. */ - -/* LOC is the location at which the indicated transformation */ -/* should be applied. */ - -/* When TRANSF is LOC is */ -/* -------------- ------ */ -/* 'TRANSPOSE' Location of the first character */ -/* to be transposed. */ - -/* 'REPLACE' Location of the character to be */ -/* replaced. */ - -/* 'INSERT' Location at which the character */ -/* should be inserted. */ - -/* 'REMOVE' Location of the character to be */ -/* removed. */ - -/* 'IDENTITY' Zero. */ - -/* 'NONE' Zero. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* Some typing mistakes should be relatively easy to catch, since */ -/* the difference between the intended word and the typed word may */ -/* involve a single transformation. MATCHE applies the most common */ -/* transformations to an input word, and attempt to match the */ -/* resulting word to a an initial guess. */ - -/* $ Examples */ - -/* Let */ - -/* GUESS = 'APPLE' */ - -/* Then */ - -/* If WORD is TRANSF is LOC is */ -/* ----------- ------------- ------ */ -/* 'APPEL' 'TRANSPOSE' 4 */ -/* 'APPLY' 'REPLACE' 5 */ -/* 'DAPPLE' 'REMOVE' 1 */ -/* 'APPLES' 'REMOVE' 5 */ -/* 'PPLE' 'INSERT' 1 */ -/* 'APPE' 'INSERT' 4 */ -/* 'APPL' 'INSERT' 5 */ -/* 'APPLE' 'IDENTITY' 0 */ -/* 'APPEAL' 'NONE' 0 */ - -/* $ Restrictions */ - -/* 1) MATCHE is case-sensitive. Lowercase characters do not match */ -/* uppercase characters, and vice versa. */ - -/* 2) ASCII characters 1 and 2 are used internally as wildcard */ -/* characters, and should not appear in either WORD or GUESS. */ - -/* $ Common_Variables */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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 B 1.0.0, 5-APR-1988 */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Save a copy of the first 64 significant characters in a buffer, */ -/* from which we may construct templates. */ - - s_copy(copy, " ", (ftnlen)65, (ftnlen)1); - ljust_(word, copy, word_len, (ftnlen)64); - ljust_(guess, mygues, guess_len, (ftnlen)65); - clen = qrtrim_(copy, (ftnlen)65); - -/* Apply the transformations one at a time, in the order most */ -/* likely to succeed: */ - -/* Removal */ -/* Transposition */ -/* Replacement */ -/* Insertion */ - -/* Quit as soon as a possible match is found. */ - -/* Actually, we need to check for identity first. Otherwise, */ -/* we're likely to find a transposition that yields the same */ -/* word: for example, transposing the second and third letters */ -/* of APPLE yields APPLE. */ - - if (eqstr_(word, mygues, word_len, (ftnlen)65)) { - s_copy(transf, "IDENTITY", transf_len, (ftnlen)8); - *loc = 0; - return 0; - } - -/* Removal */ -/* ------- */ - -/* Remove the character at each location, and check against MYGUES. */ - - i__1 = clen; - for (i__ = 1; i__ <= i__1; ++i__) { - remsub_(copy, &i__, &i__, templ, (ftnlen)65, (ftnlen)65); - if (eqstr_(templ, mygues, (ftnlen)65, (ftnlen)65)) { - s_copy(transf, "REMOVE", transf_len, (ftnlen)6); - *loc = i__; - return 0; - } - } - -/* Transposition */ -/* ------------- */ - -/* Transpose each pair of characters, and check against MYGUES. */ - - i__1 = clen - 1; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(templ, copy, (ftnlen)65, (ftnlen)65); - i__2 = i__; - s_copy(templ + (i__ - 1), copy + i__2, (ftnlen)1, i__ + 1 - i__2); - i__2 = i__; - s_copy(templ + i__2, copy + (i__ - 1), i__ + 1 - i__2, (ftnlen)1); - if (eqstr_(templ, mygues, (ftnlen)65, (ftnlen)65)) { - s_copy(transf, "TRANSPOSE", transf_len, (ftnlen)9); - *loc = i__; - return 0; - } - } - -/* Replacement */ -/* ----------- */ - -/* Replace each character with a wild character, and check */ -/* against MYGUES. */ - - i__1 = clen; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(templ, copy, (ftnlen)65, (ftnlen)65); - *(unsigned char *)&templ[i__ - 1] = *(unsigned char *)&mygues[i__ - 1] - ; - if (eqstr_(templ, mygues, (ftnlen)65, (ftnlen)65)) { - s_copy(transf, "REPLACE", transf_len, (ftnlen)7); - *loc = i__; - return 0; - } - } - -/* Insertion */ -/* --------- */ - -/* Insert a wild character at each location, and check against */ -/* MYGUES. */ - - i__1 = clen + 1; - for (i__ = 1; i__ <= i__1; ++i__) { - if (i__ == 1) { - *(unsigned char *)templ = *(unsigned char *)mygues; - s_copy(templ + 1, copy, (ftnlen)64, (ftnlen)65); - } else if (i__ == clen + 1) { - s_copy(templ, copy, (ftnlen)65, (ftnlen)65); - *(unsigned char *)&templ[i__ - 1] = *(unsigned char *)&mygues[i__ - - 1]; - } else { - s_copy(templ, copy, i__ - 1, i__ - 1); - *(unsigned char *)&templ[i__ - 1] = *(unsigned char *)&mygues[i__ - - 1]; - i__2 = i__; - s_copy(templ + i__2, copy + (i__ - 1), 65 - i__2, 65 - (i__ - 1)); - } - if (eqstr_(templ, mygues, (ftnlen)65, (ftnlen)65)) { - s_copy(transf, "INSERT", transf_len, (ftnlen)6); - *loc = i__; - return 0; - } - } - -/* None of these transformations work. */ - - s_copy(transf, "NONE", transf_len, (ftnlen)4); - *loc = 0; - return 0; -} /* matche_ */ - diff --git a/ext/spice/src/csupport/matchm.c b/ext/spice/src/csupport/matchm.c deleted file mode 100644 index fb2888ca7c..0000000000 --- a/ext/spice/src/csupport/matchm.c +++ /dev/null @@ -1,636 +0,0 @@ -/* matchm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MATCHM ( Match string against multiple wildcard templates ) */ -logical matchm_(char *string, char *templ, char *wstr, char *wchr, char * - notchr, char *orchr, ftnlen string_len, ftnlen templ_len, ftnlen - wstr_len, ftnlen wchr_len, ftnlen notchr_len, ftnlen orchr_len) -{ - /* System generated locals */ - integer i__1; - logical ret_val; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_len(char *, ftnlen); - - /* Local variables */ - logical loop; - extern integer upto_(char *, char *, integer *, ftnlen, ftnlen); - integer b, e; - logical match; - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical negate; - extern logical matchi_(char *, char *, char *, char *, ftnlen, ftnlen, - ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen); - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern integer qlstnb_(char *, ftnlen); - extern logical return_(void); - integer beg, end; - -/* $ Abstract */ - -/* Determines whether or not a string matches any of a */ -/* collection of templates containing wildcard characters. */ - -/* $ 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 */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I String to be matched against templates. */ -/* TEMPL I Collection of templates. */ -/* WSTR I Wild string: represents any number of characters. */ -/* WCHR I Wild character: represents exactly one character. */ -/* NOTCHR I NOT character: negates one or more templates. */ -/* ORCHR I OR character: separates individual templates. */ - -/* $ Detailed_Input */ - -/* STRING is a character string to be checked for a match */ -/* against the specified collection of templates. */ -/* Leading and trailing blanks are ignored. */ - -/* TEMPL is a collection of individual templates to be */ -/* compared against the specified string. Leading */ -/* and trailing blanks are ignored. An empty (blank) */ -/* template collection matches only an empty (blank) */ -/* string. */ - -/* WSTR is the wild string token used in the templates. */ -/* It represents from zero to any number of characters. */ -/* Spaces may not be used as wild strings. */ - -/* WCHR is the wild character token used in the templates. */ -/* It represents exactly one character. Spaces may not */ -/* be used as wild characters. */ - -/* NOTCHR is the NOT character used in the templates. */ -/* When it appears at the beginning of a template, */ -/* it negates the template: that is, a string matches */ -/* the negated template if it does not match the */ -/* template itself. When it appears after the first */ -/* character in a template, it is treated as an */ -/* ordinary character. Spaces between a not character */ -/* and the rest of a template are ignored. */ - -/* In addition, the NOT character may be used to negate */ -/* the entire collection of templates by placing it by */ -/* itself at the head of the collection. */ - -/* Spaces may not be used as NOT characters. */ - -/* ORCHR is the OR character used to separate individual */ -/* templates in the collection. Spaces adjacent to */ -/* the OR character are ignored. Consecutive OR */ -/* characters separated only by zero or more spaces */ -/* are considered to delimit a single blank template. */ - -/* Spaces may not be used as OR characters. */ - -/* $ Detailed_Output */ - -/* The function is TRUE whenever the string matches the collection */ -/* of templates, and is FALSE otherwise. */ - -/* $ Exceptions */ - -/* 1) If the four special characters are not distinct, the error */ -/* SPICE(AMBIGTEMPL) is signalled. */ - -/* 2) If any of the four special characters is a space, the error */ -/* SPICE(ILLEGTEMPL) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* MATCHM is an extension of MATCHI, which matches a string against */ -/* a single template. The major differences are the addition of the */ -/* NOT character, and the ability to match against combinations of */ -/* individual templates. */ - -/* Like MATCHI, MATCHM is case-insensitive. Uppercase templates */ -/* match lowercase strings, and vice versa. */ - -/* In the following discussion, we will assume that the four */ -/* special characters are defined as follows. */ - -/* WCHR = '%' */ -/* WSTR = '*' */ -/* NOTCHR = '~' */ -/* ORCHR = '|' */ - - -/* 1. Normal Templates */ -/* ------------------- */ - -/* A normal individual template contains some combination of */ -/* ordinary characters, wild characters, and wild strings. */ -/* The rules governing these templates are identical to those */ -/* used by MATCHI. */ - - -/* 2. Negated Templates */ -/* -------------------- */ - -/* Any normal individual template may be negated by prefixing */ -/* it with the NOT character. The NOT character, when embedded */ -/* within either a normal or a negated template, is treated as */ -/* an ordinary character. For example, the template */ - -/* '~*WN%.FOR' */ - -/* is negated, and matches any string that does NOT match the */ -/* normal template */ - -/* '*WN%.FOR' */ - -/* while the template */ - -/* 'Dr.~Sm%th*' */ - -/* is not negated. In particular, double negations are not */ -/* recognized. That is, the template */ - -/* '~~X*' */ - -/* means "not like ~X*". */ - -/* The NOT character, when it appears by itself, */ - -/* '~' */ - -/* is equivalent to the template */ - -/* '~*' */ - -/* which does not match any string. */ - - -/* 3. Combining Templates */ -/* ---------------------- */ - -/* Frequently, you will wish to determine whether a string matches */ -/* any of a number of individual templates: for example, whether a */ -/* file name matches any of the templates */ - -/* '*.FOR' */ -/* '*.F77' */ -/* '*.INC' */ - -/* The individual templates can be collected together into a */ -/* single string, separated by the OR character, */ - -/* '*.FOR | *.F77 | *.INC' */ - -/* (Spaces adjacent to the separators are ignored. That is, the */ -/* collection */ - -/* '*.FOR|*.F77|*.INC' */ - -/* is messier than, but equivalent to, the previous collection.) */ - -/* Note that conssecutive OR characters separated by zero or */ -/* more blanks are considered to delimit a blank template. */ -/* Thus, the following, which match a blank string, are all */ -/* equivalent */ - -/* '*.FOR || *.F77' */ -/* '*.FOR | | *.F77' */ -/* '*.FOR || | *.F77' */ -/* '*.FOR |||||| *.F77' */ - - -/* 4. Combining Negated Templates */ -/* ------------------------------ */ - -/* Both normal and negated templates may be combined using the */ -/* OR character. However, negated templates should be combined */ -/* with great care. Recalling that the logical expression */ - -/* ( ~A | ~B | ~C ) */ - -/* is equivalent to the expression */ - -/* ~ ( A & B & C ) */ - -/* convince yourself that the collection */ - -/* '~X* | ~Y*' */ - -/* meaning "not like X* or not like Y*", really means "not like */ -/* both X* and Y*", and matches EVERY string. This is not to say */ -/* that such collections do not have their uses. Combinations */ -/* of negated templates are used to find strings for which */ -/* combinations of constraints are not met simultaneously. */ -/* For example, the collection */ - -/* '~[* | ~*]' */ - -/* ("does not begin with a left bracket, or does not end with */ -/* a right bracket", or "does not both begin with a left bracket */ -/* and end with a right bracket") may be used to detect strings */ -/* which cannot be VMS directory specifications. */ - - -/* 5. Negating Combined Templates */ -/* ------------------------------ */ - -/* It is easy to mistakenly expect a combination of negated */ -/* templates to act like the negation of a combination of */ -/* templates, but they are very different things. Continuing */ -/* our example of Section 3, we may wish to know which file */ -/* names do NOT match any of our templates. Clearly */ - -/* '~*.FOR | ~*.F77 | ~*.INC' */ - -/* will not do the trick, as it matches every possible file name. */ -/* We need instead to group the individual templates under a single */ -/* negation: */ - -/* '~( *.FOR | *.F77 | *.INC )' */ - -/* However, this grouping is not indicated with parentheses, */ -/* but rather by placing a lone NOT character at the head of */ -/* the collection, */ - -/* '~ | *.FOR | *.F77 | *.INC' */ - -/* This syntax, while not immediately obvious, has at least */ -/* two advantages. First, it does not require any new special */ -/* characters. Second, it makes adding new individual templates */ -/* to the end of the list a trivial operation. */ - - -/* 6. Advanced Topics */ -/* ------------------ */ - -/* The final level in the construction of template collections */ -/* involves the combination of normal and negated templates. */ -/* Consider the templates 'A*' and '*.FOR'. The set of strings */ -/* matching the collection */ - -/* 'A* | ~*.FOR' */ - -/* ("begins with A or is not like *.FOR") is just the UNION */ -/* of the sets of the strings matching the individual templates. */ -/* This is true for any set of templates, negated or normal. */ - -/* But there's more. De Morgan's Laws tell us that the complement */ -/* (negation) of a union of sets (templates) is the same as the */ -/* intersection of the complements of the sets. Thus, by negating */ -/* the original templates, and by negating the collection of the */ -/* negated templates, we end up with */ - -/* '~ | ~A* | *.FOR' */ - -/* meaning "not (does not begin with A or is like *.FOR)". */ -/* But this means "both begins with A and is not like *.FOR". */ -/* So the set of strings matching the collection is just the */ -/* INTERSECTION of the sets of strings matching the original */ -/* templates. */ - -/* $ Examples */ - -/* The following examples are grouped according to the discussion */ -/* of the Particulars section. The nominal values of the special */ -/* characters are the same, namely */ - -/* WCHR = '%' */ -/* WSTR = '*' */ -/* NOTCHR = '~' */ -/* ORCHR = '|' */ - - -/* 1. Normal Templates */ -/* ------------------- */ - -/* Consider the following string */ - -/* ' ABCDEFGHIJKLMNOPQRSTUVWXYZ ' */ - -/* and the following templates. */ - -/* Template Matches STRING? */ -/* --------------- --------------- */ -/* '*A*' Yes */ -/* 'A%D*' No */ -/* 'A%C*' Yes */ -/* '%A*' No */ -/* ' A* ' Yes */ - -/* '%%CD*Z' Yes */ -/* '%%CD' No */ -/* 'A*MN*Y*Z' Yes */ -/* 'A*MN*Y%Z' No */ -/* '*BCD*Z*' Yes */ -/* '*bcd*z*' Yes */ - - -/* 2. Negated Templates */ -/* -------------------- */ - -/* Consider the same string, and the following templates. */ - -/* Template Matches STRING? */ -/* --------------- --------------- */ -/* '~%B*D' Yes */ -/* '~%B*D*' No */ -/* '~ABC' Yes */ -/* '~ABC*' No */ -/* '~~B*' Yes */ - -/* Note that in the final example, the second '~' is treated not as */ -/* a second negation but as an ordinary character. */ - - -/* 3. Combining Templates */ -/* ---------------------- */ - -/* Consider the following strings and templates. */ - -/* String Template Matches? */ -/* -------------- ------------------- -------- */ -/* AKRON *A*|*B* Yes */ -/* BELOIT *B*|*I* Yes */ -/* CHAMPAGNE *B*|*I* No */ - - -/* 4. Combining Negated Templates */ -/* ------------------------------ */ - -/* Consider the following strings and templates. */ - -/* String Template Matches? */ -/* -------------- ------------------- -------- */ -/* SEQUIOA ~*A*|~*E*|~*I* No */ -/* SAINT PAUL ~*A*|~*E*|~*I* Yes */ -/* HOUSTON ~*A*|~*E*|~*I* Yes */ - - -/* 5. Negating Combined Templates */ -/* ------------------------------ */ - -/* Consider the following strings and templates. */ - -/* String Template Matches? */ -/* -------------- ------------------- -------- */ -/* DETROIT ~|B*|D* No */ -/* EUGENE ~|B*|D* Yes */ -/* FAIRBANKS ~|*A*|*I*|*O*|*U* No */ -/* GREENBELT ~|*A*|*I*|*O*|*U* Yes */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SUPPORT Version 2.3.0, 10-MAY-2006 (EDW) */ - -/* Added logic to prevent the evaluation of TEMPL(BEG:BEG) */ -/* if BEG exceeds the length of TEMPL. Functionally, the */ -/* evaluation had no effect on MATCHM's output, but the ifort */ -/* F95 compiler flagged the evaluation as an array */ -/* overrun error. This occurred because given: */ - -/* A .AND. B */ - -/* ifort evaluates A then B then performs the logical */ -/* comparison. */ - -/* Edited header to match expected SPICE format. */ - -/* - META/2 Configured Version 2.2.0, 28-DEC-1994 (WLT) */ - -/* An initial value is given to MATCHM so that it will */ -/* have a value even if return mode is in effect. */ - -/* - 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 B 1.0.0, 31-MAR-1988 */ - -/* -& */ -/* $ Index_Entries */ - -/* string match to templates */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Give the function an initial value. */ - - ret_val = FALSE_; - -/* Standard SPICE error handling */ - - if (return_()) { - return ret_val; - } else { - chkin_("MATCHM", (ftnlen)6); - } - -/* Reject bad inputs. */ - - if (*(unsigned char *)wstr == ' ' || *(unsigned char *)wchr == ' ' || *( - unsigned char *)notchr == ' ' || *(unsigned char *)orchr == ' ') { - sigerr_("SPICE(ILLEGTEMPL)", (ftnlen)17); - chkout_("MATCHM", (ftnlen)6); - return ret_val; - } else if (*(unsigned char *)wstr == *(unsigned char *)wchr || *(unsigned - char *)wstr == *(unsigned char *)notchr || *(unsigned char *)wstr - == *(unsigned char *)orchr || *(unsigned char *)wchr == *( - unsigned char *)notchr || *(unsigned char *)wchr == *(unsigned - char *)orchr || *(unsigned char *)notchr == *(unsigned char *) - orchr) { - sigerr_("SPICE(AMBIGTEMPL)", (ftnlen)17); - chkout_("MATCHM", (ftnlen)6); - return ret_val; - } - -/* Ignore leading and trailing spaces in the collection. */ - - beg = frstnb_(templ, templ_len); - end = qlstnb_(templ, templ_len); - -/* A blank collection matches ONLY a blank string. */ - - if (beg == 0) { - ret_val = s_cmp(string, " ", string_len, (ftnlen)1) == 0; - chkout_("MATCHM", (ftnlen)6); - return ret_val; - } - -/* If the first template is the NOT character, the entire collection */ -/* is negated, and we can begin with the next template. Otherwise, */ -/* just start at the beginning again. */ - - b = beg; - e = upto_(templ, orchr, &b, end, (ftnlen)1); - if (e >= i_len(templ, templ_len)) { - negate = FALSE_; - beg = b; - } else /* if(complicated condition) */ { - i__1 = e; - if (s_cmp(templ + (b - 1), notchr, e - (b - 1), (ftnlen)1) == 0 && - s_cmp(templ + i__1, orchr, e + 1 - i__1, (ftnlen)1) == 0) { - negate = TRUE_; - beg = e + 2; - } else { - negate = FALSE_; - beg = b; - } - } - -/* Grab one template at a time, comparing them against the string */ -/* until a match has occured or until no templates remain. */ - - match = FALSE_; - while(beg <= end && ! match) { - b = beg; - e = upto_(templ, orchr, &b, end, (ftnlen)1); - -/* If we started on an OR character, then either we are */ -/* at the beginning of a string that starts with one, */ -/* or we just passed one and found another either next to */ -/* it, or separated by nothing but spaces. By convention, */ -/* either case is interpreted as a blank template. */ - - if (*(unsigned char *)&templ[b - 1] == *(unsigned char *)orchr) { - match = s_cmp(string, " ", string_len, (ftnlen)1) == 0; - ++beg; - -/* If this is a negated template, negate the results. */ -/* Remember that a NOT character by itself does not */ -/* matches anything. */ - - } else if (*(unsigned char *)&templ[b - 1] == *(unsigned char *) - notchr) { - if (s_cmp(templ + (b - 1), notchr, e - (b - 1), (ftnlen)1) == 0) { - match = FALSE_; - } else { - i__1 = b; - match = ! matchi_(string, templ + i__1, wstr, wchr, - string_len, e - i__1, (ftnlen)1, (ftnlen)1); - } - beg = e + 2; - -/* Or a normal one? */ - - } else { - match = matchi_(string, templ + (b - 1), wstr, wchr, string_len, - e - (b - 1), (ftnlen)1, (ftnlen)1); - beg = e + 2; - } - -/* Skip any blanks before the next template. */ -/* The logic ensures no evaluation of TEMPL(BEG:BEG) */ -/* if BEG > LEN(TEMPL). */ - - loop = beg < end; - if (loop) { - loop = loop && *(unsigned char *)&templ[beg - 1] == ' '; - } - while(loop) { - ++beg; - if (beg >= end) { - loop = FALSE_; - } else if (*(unsigned char *)&templ[beg - 1] != ' ') { - loop = FALSE_; - } else { - loop = TRUE_; - } - } - } - -/* It doesn't happen often, but occasionally a template ends with */ -/* the OR character. This implies a blank template at the end of */ -/* the collection. */ - - if (*(unsigned char *)&templ[end - 1] == *(unsigned char *)orchr) { - if (! match) { - match = s_cmp(string, " ", string_len, (ftnlen)1) == 0; - } - } - -/* Negate the results, if appropriate. */ - - if (negate) { - ret_val = ! match; - } else { - ret_val = match; - } - chkout_("MATCHM", (ftnlen)6); - return ret_val; -} /* matchm_ */ - diff --git a/ext/spice/src/csupport/matcho.c b/ext/spice/src/csupport/matcho.c deleted file mode 100644 index 96fdeb5299..0000000000 --- a/ext/spice/src/csupport/matcho.c +++ /dev/null @@ -1,459 +0,0 @@ -/* matcho.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure MATCHO ( Match the characters in two words ) */ -integer matcho_(char *word, char *guess, ftnlen word_len, ftnlen guess_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer uvalue[256] = { 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, - 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38, - 39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60, - 61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82, - 83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102, - 103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118, - 119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, - 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150, - 151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166, - 167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182, - 183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198, - 199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214, - 215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230, - 231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246, - 247,248,249,250,251,252,253,254,255 }; - - /* System generated locals */ - integer ret_val, i__1, i__2, i__3; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - static integer glen, wlen, g2seq[32], w2seq[32], i__, j, value, c1, c2; - extern integer ltrim_(char *, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static integer gf, gl, gp, wf, wl, wp; - extern /* Subroutine */ int shelli_(integer *, integer *); - static integer gscore, gpairs[512], gmscor, g2c, gtally, gcount, wscore, - wpairs[512], wmscor, w2c, wtally; - extern integer qrtrim_(char *, ftnlen); - static integer wcount; - -/* $ Abstract */ - -/* Assign a score to a pair of words which reflects the closeness */ -/* of the words in terms of the characters they contain and the */ -/* order in which the characters appear. */ - -/* $ 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. */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WORD I Word to be matched against initial guess. */ -/* GUESS I Initial guess. */ - -/* $ Detailed_Input */ - -/* WORD is a character string to be checked for a match */ -/* against an initial guess. The (non-printing) ASCII */ -/* characters 1 and 2 are ignored. Typically, WORD will */ -/* contain a single word. */ - -/* GUESS is an initial guess at the value of the input */ -/* word. The (non-printing) ASCII characters 1 and 2 */ -/* are ignored. Like WORD, this will typically be a */ -/* single word. */ - -/* $ Detailed_Output */ - -/* The function returns a score between 0 (indicating that WORD */ -/* and GUESS have no common character patterns) and 100 (indicating */ -/* that WORD and GUESS match very closely). */ - -/* $ Exceptions */ - -/* 1) If neither WORD nor GUESS contains any printing characters, */ -/* the function returns 0. */ - -/* $ Particulars */ - -/* In order to determine whether a word (usually typed by a user) */ -/* matches any of a series of known words (keywords, for example), */ -/* it is necessary to be able to judge the "closeness" of an */ -/* arbitrary pair of words. Several algorithms exist which make */ -/* such a comparison, the best-known of which is probably the */ -/* Soundex algorithm. */ - -/* The score assigned by MATCHO indicates not only how many of the */ -/* letters two words have in common, but also the relative */ -/* difference between the order in which these letters appear. */ - -/* MATCHO does not assign higher weights to more exotic characters, */ -/* like Q and Z, since these are as likely to appear in mistyped */ -/* words as are any other characters. (Both Q and Z, for instance, */ -/* are adjacent to A on a standard keyboard.) */ - -/* The score assigned by MATCHO is computed in this way. */ - -/* Suppose WORD is the string */ - -/* w_1 w_2 ... w_n */ - -/* and GUESS is the string */ - -/* g_1 g_2 ... g_m */ - -/* Each of the MATCHW templates */ - -/* * w_i * w_j * (where i < j) */ - -/* is matched against GUESS and the total number of */ -/* matches tallied. (There are n(n-1)/2 such templates) */ - -/* Additionally 1 extra point is awarded for each match of GUESS */ -/* with a template of the form */ - -/* * w_i w_i+1 * . */ - -/* The total tally is multiplied by 200/n(n-1) and truncated to */ -/* 100 if necessary to yield a GUESS to WORD tally. */ - -/* Then the roles of WORD and GUESS are reversed and an */ -/* identical proceedure is followed to obtain a WORD to GUESS */ -/* tally. The average of the two tallies is returned in */ -/* MATCHO. */ - -/* Empirically it has been found that WORD and GUESS are in */ -/* close agreement if MATCHO is returned with a value of 75 */ -/* or more. Users may wish to use higher or lower score when */ -/* determining when a match between two words is close. */ - -/* $ Examples */ - - -/* $ Restrictions */ - -/* 1) MATCHO is case-insensitive. Lowercase characters match */ -/* uppercase characters, and vice versa. */ - -/* $ Common_Variables */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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 B 1.0.0, 7-APR-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Parameters */ - - -/* Local variables */ - - -/* Set up the case insensitive mapping. */ - - if (first) { - first = FALSE_; - uvalue[(i__1 = 'a') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)274)] = 'A'; - uvalue[(i__1 = 'b') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)275)] = 'B'; - uvalue[(i__1 = 'c') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)276)] = 'C'; - uvalue[(i__1 = 'd') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)277)] = 'D'; - uvalue[(i__1 = 'e') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)278)] = 'E'; - uvalue[(i__1 = 'f') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)279)] = 'F'; - uvalue[(i__1 = 'g') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)280)] = 'G'; - uvalue[(i__1 = 'h') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)281)] = 'H'; - uvalue[(i__1 = 'i') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)282)] = 'I'; - uvalue[(i__1 = 'j') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)283)] = 'J'; - uvalue[(i__1 = 'k') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)284)] = 'K'; - uvalue[(i__1 = 'l') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)285)] = 'L'; - uvalue[(i__1 = 'm') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)286)] = 'M'; - uvalue[(i__1 = 'n') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)287)] = 'N'; - uvalue[(i__1 = 'o') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)288)] = 'O'; - uvalue[(i__1 = 'p') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)289)] = 'P'; - uvalue[(i__1 = 'q') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)290)] = 'Q'; - uvalue[(i__1 = 'r') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)291)] = 'R'; - uvalue[(i__1 = 's') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)292)] = 'S'; - uvalue[(i__1 = 't') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)293)] = 'T'; - uvalue[(i__1 = 'u') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)294)] = 'U'; - uvalue[(i__1 = 'v') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)295)] = 'V'; - uvalue[(i__1 = 'w') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)296)] = 'W'; - uvalue[(i__1 = 'x') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)297)] = 'X'; - uvalue[(i__1 = 'y') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)298)] = 'Y'; - uvalue[(i__1 = 'z') < 256 && 0 <= i__1 ? i__1 : s_rnge("uvalue", i__1, - "matcho_", (ftnlen)299)] = 'Z'; - } - -/* First get the ``dimensions'' of our two words (first non-blank, */ -/* last non-blank, and non-blank length). */ - - gf = ltrim_(guess, guess_len); - gl = qrtrim_(guess, guess_len); - wf = ltrim_(word, word_len); - wl = qrtrim_(word, word_len); - glen = gl - gf + 1; - wlen = wl - wf + 1; - -/* Perform some of the obvious checks first. */ - - if (eqstr_(word + (wf - 1), guess + (gf - 1), wl - (wf - 1), gl - (gf - 1) - )) { - ret_val = 100; - return ret_val; - } else if (wlen <= 1 || glen <= 1) { - ret_val = 0; - return ret_val; - } - -/* Initialize the score keeper and compute the length of GUESS. */ - - wmscor = (wlen - 1) * wlen / 2; - gmscor = (glen - 1) * glen / 2; - -/* We will encode ordered letter pairs as */ - -/* BASE * ICHAR(first) + ICHAR(second) */ - -/* Where BASE is chosen large enough so that we will never have */ -/* different pairs mapping to the same integer. */ - -/* Compute the encoded collection of ordered pairs for */ -/* the GUESS (GCOUNT is the number of general pairs */ -/* G2C is the number of 2 character substrings) ... */ - - gcount = 0; - g2c = 0; - i__1 = gl - 1; - for (i__ = gf; i__ <= i__1; ++i__) { - c1 = uvalue[(i__2 = *(unsigned char *)&guess[i__ - 1]) < 256 && 0 <= - i__2 ? i__2 : s_rnge("uvalue", i__2, "matcho_", (ftnlen)355)]; - i__2 = i__; - c2 = uvalue[(i__3 = *(unsigned char *)&guess[i__2]) < 256 && 0 <= - i__3 ? i__3 : s_rnge("uvalue", i__3, "matcho_", (ftnlen)356)]; - ++g2c; - g2seq[(i__2 = g2c - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("g2seq", - i__2, "matcho_", (ftnlen)359)] = (c1 << 10) + c2; - i__2 = gl; - for (j = i__ + 1; j <= i__2; ++j) { - c1 = uvalue[(i__3 = *(unsigned char *)&guess[i__ - 1]) < 256 && 0 - <= i__3 ? i__3 : s_rnge("uvalue", i__3, "matcho_", ( - ftnlen)363)]; - c2 = uvalue[(i__3 = *(unsigned char *)&guess[j - 1]) < 256 && 0 <= - i__3 ? i__3 : s_rnge("uvalue", i__3, "matcho_", (ftnlen) - 364)]; - ++gcount; - gpairs[(i__3 = gcount - 1) < 512 && 0 <= i__3 ? i__3 : s_rnge( - "gpairs", i__3, "matcho_", (ftnlen)367)] = (c1 << 10) + - c2; - } - } - -/* ... then construct the encoded ordered letter pairs for WORD. */ - - wcount = 0; - w2c = 0; - i__1 = wl - 1; - for (i__ = wf; i__ <= i__1; ++i__) { - c1 = uvalue[(i__2 = *(unsigned char *)&word[i__ - 1]) < 256 && 0 <= - i__2 ? i__2 : s_rnge("uvalue", i__2, "matcho_", (ftnlen)381)]; - i__2 = i__; - c2 = uvalue[(i__3 = *(unsigned char *)&word[i__2]) < 256 && 0 <= i__3 - ? i__3 : s_rnge("uvalue", i__3, "matcho_", (ftnlen)382)]; - ++w2c; - w2seq[(i__2 = w2c - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("w2seq", - i__2, "matcho_", (ftnlen)385)] = (c1 << 10) + c2; - i__2 = wl; - for (j = i__ + 1; j <= i__2; ++j) { - c1 = uvalue[(i__3 = *(unsigned char *)&word[i__ - 1]) < 256 && 0 - <= i__3 ? i__3 : s_rnge("uvalue", i__3, "matcho_", ( - ftnlen)389)]; - c2 = uvalue[(i__3 = *(unsigned char *)&word[j - 1]) < 256 && 0 <= - i__3 ? i__3 : s_rnge("uvalue", i__3, "matcho_", (ftnlen) - 390)]; - ++wcount; - wpairs[(i__3 = wcount - 1) < 512 && 0 <= i__3 ? i__3 : s_rnge( - "wpairs", i__3, "matcho_", (ftnlen)393)] = (c1 << 10) + - c2; - } - } - -/* Now sort the various arrays of encoded letter pairs */ - - shelli_(&g2c, g2seq); - shelli_(&gcount, gpairs); - shelli_(&w2c, w2seq); - shelli_(&wcount, wpairs); - g2seq[(i__1 = g2c) < 32 && 0 <= i__1 ? i__1 : s_rnge("g2seq", i__1, "mat" - "cho_", (ftnlen)407)] = 0; - gpairs[(i__1 = gcount) < 512 && 0 <= i__1 ? i__1 : s_rnge("gpairs", i__1, - "matcho_", (ftnlen)408)] = 0; - w2seq[(i__1 = w2c) < 32 && 0 <= i__1 ? i__1 : s_rnge("w2seq", i__1, "mat" - "cho_", (ftnlen)409)] = 0; - wpairs[(i__1 = wcount) < 512 && 0 <= i__1 ? i__1 : s_rnge("wpairs", i__1, - "matcho_", (ftnlen)410)] = 0; - -/* First tally up the matches of the form *L1*L2*. This is */ -/* virtually the same algorithm used for computing set */ -/* intersections. */ - - wp = 1; - gp = 1; - wtally = 0; - gtally = 0; - while(wp <= wcount && gp <= gcount) { - if (wpairs[(i__1 = wp - 1) < 512 && 0 <= i__1 ? i__1 : s_rnge("wpairs" - , i__1, "matcho_", (ftnlen)426)] < gpairs[(i__2 = gp - 1) < - 512 && 0 <= i__2 ? i__2 : s_rnge("gpairs", i__2, "matcho_", ( - ftnlen)426)]) { - ++wp; - } else if (wpairs[(i__1 = wp - 1) < 512 && 0 <= i__1 ? i__1 : s_rnge( - "wpairs", i__1, "matcho_", (ftnlen)430)] > gpairs[(i__2 = gp - - 1) < 512 && 0 <= i__2 ? i__2 : s_rnge("gpairs", i__2, "mat" - "cho_", (ftnlen)430)]) { - ++gp; - } else { - value = wpairs[(i__1 = wp - 1) < 512 && 0 <= i__1 ? i__1 : s_rnge( - "wpairs", i__1, "matcho_", (ftnlen)436)]; - while(wpairs[(i__1 = wp - 1) < 512 && 0 <= i__1 ? i__1 : s_rnge( - "wpairs", i__1, "matcho_", (ftnlen)438)] == value && wp <= - wcount) { - ++wtally; - ++wp; - } - while(gpairs[(i__1 = gp - 1) < 512 && 0 <= i__1 ? i__1 : s_rnge( - "gpairs", i__1, "matcho_", (ftnlen)446)] == value && gp <= - gcount) { - ++gtally; - ++gp; - } - } - } - -/* Next tally up the various matches of the form *L1L2* */ - - wp = 1; - gp = 1; - while(wp <= w2c && gp <= g2c) { - if (w2seq[(i__1 = wp - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge("w2seq", - i__1, "matcho_", (ftnlen)468)] < g2seq[(i__2 = gp - 1) < 32 && - 0 <= i__2 ? i__2 : s_rnge("g2seq", i__2, "matcho_", (ftnlen) - 468)]) { - ++wp; - } else if (w2seq[(i__1 = wp - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "w2seq", i__1, "matcho_", (ftnlen)472)] > g2seq[(i__2 = gp - - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge("g2seq", i__2, "matcho_", - (ftnlen)472)]) { - ++gp; - } else { - value = w2seq[(i__1 = wp - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "w2seq", i__1, "matcho_", (ftnlen)478)]; - while(w2seq[(i__1 = wp - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "w2seq", i__1, "matcho_", (ftnlen)480)] == value && wp <= - w2c) { - ++wtally; - ++wp; - } - while(g2seq[(i__1 = gp - 1) < 32 && 0 <= i__1 ? i__1 : s_rnge( - "g2seq", i__1, "matcho_", (ftnlen)488)] == value && gp <= - g2c) { - ++gtally; - ++gp; - } - } - } - gtally = min(gtally,gmscor); - wtally = min(wtally,wmscor); - wscore = wtally * 100 / wmscor; - gscore = gtally * 100 / gmscor; -/* Computing MIN */ - i__1 = (wscore + gscore) / 2; - ret_val = min(i__1,100); - return ret_val; -} /* matcho_ */ - diff --git a/ext/spice/src/csupport/meta_2.c b/ext/spice/src/csupport/meta_2.c deleted file mode 100644 index 02526c3a17..0000000000 --- a/ext/spice/src/csupport/meta_2.c +++ /dev/null @@ -1,504 +0,0 @@ -/* meta_2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; -static integer c__10 = 10; -static logical c_true = TRUE_; -static integer c__6 = 6; -static integer c__5 = 5; -static integer c__32 = 32; -static integer c__9 = 9; -static integer c__3 = 3; - -/* $Procedure META_2 ( Percy's interface to META_0 ) */ -/* Subroutine */ int meta_2__0_(int n__, char *command, char *temps, integer * - ntemps, char *temp, integer *btemp, char *error, ftnlen command_len, - ftnlen temps_len, ftnlen temp_len, ftnlen error_len) -{ - /* Initialized data */ - - static logical pass1 = TRUE_; - static char margns[128] = "LEFT 1 RIGHT 75 " - " " - " "; - static char keynam[6*10] = "1 " "2 " "3 " "4 " "5 " - "6 " "7 " "8 " "9 " "10 "; - - /* System generated locals */ - address a__1[5]; - integer i__1, i__2[5]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), e_wsle( - void); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer do_lio(integer *, integer *, char *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int getopt_1__(char *, integer *, char *, integer - *, char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen, ftnlen); - static integer sbeg; - static char mode[16], pick[32]; - static integer b, e, i__, j; - extern integer cardc_(char *, ftnlen); - extern logical batch_(void); - static integer score; - static logical fixit; - extern integer rtrim_(char *, ftnlen); - static char style[128]; - static integer m2code; - static char tryit[600]; - extern /* Subroutine */ int m2gmch_(char *, char *, char *, integer *, - logical *, integer *, logical *, integer *, integer *, char *, - ftnlen, ftnlen, ftnlen, ftnlen), m2rcvr_(integer *, integer *, - char *, ftnlen), scardc_(integer *, char *, ftnlen); - static integer bscore, cutoff; - static logical reason; - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen), ssizec_(integer *, char *, ftnlen), repsub_(char *, - integer *, integer *, char *, char *, ftnlen, ftnlen, ftnlen); - static logical intrct; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static char thnwds[32*7], kwords[32*16]; - extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen), prepsn_(char *, ftnlen); - static logical pssthn; - static char questn[80]; - extern /* Subroutine */ int niceio_3__(char *, integer *, char *, ftnlen, - ftnlen), cnfirm_1__(char *, logical *, ftnlen); - - /* Fortran I/O blocks */ - static cilist io___19 = { 0, 6, 0, 0, 0 }; - static cilist io___20 = { 0, 6, 0, 0, 0 }; - static cilist io___21 = { 0, 6, 0, 0, 0 }; - static cilist io___22 = { 0, 6, 0, 0, 0 }; - static cilist io___23 = { 0, 6, 0, 0, 0 }; - static cilist io___27 = { 0, 6, 0, 0, 0 }; - static cilist io___29 = { 0, 6, 0, 0, 0 }; - static cilist io___30 = { 0, 6, 0, 0, 0 }; - static cilist io___31 = { 0, 6, 0, 0, 0 }; - - -/* $ Abstract */ - -/* Given a collection of acceptable syntax's and a statement */ -/* (COMMAND) this routine determines if the statement is */ -/* syntactically correct. */ - -/* $ 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 */ - -/* The META/2 Book. */ - -/* $ Keywords */ - -/* COMPARE */ -/* PARSING */ -/* SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COMMAND I A candidate PERCY command. */ -/* TEMPS I A collection of language definition statements */ -/* NTEMPS I The number of definition statements */ -/* TEMP - Work space required for comparison of statements. */ -/* BTEMP O The first of the def statements that best matches. */ -/* ERROR O Non-blank if none of the def's match. */ - -/* $ Detailed_Input */ - -/* COMMAND A candidate PERCY command. */ -/* TEMPS A collection of language definition statements */ -/* NTEMPS The number of definition statements */ -/* TEMP Work space required for comparison of statements. */ -/* TEMP should be declared to have the same length */ -/* as the character strings that make up TEMPS. */ - -/* $ Detailed_Output */ - -/* BTEMP The first of the def statements that best matches. */ -/* ERROR Non-blank if none of the def's match. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* Later. */ - -/* $ Examples */ - -/* Later. */ - -/* $ Restrictions */ - - - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - META/2 Configured Version 3.0.0, 11-AUG-1995 (WLT) */ - -/* The control flow through this routine was modified */ -/* so that it will now re-try all templates (starting */ -/* with the best previous match) if a spelling error */ -/* is encountered. This should fix the confused */ -/* responses that META/2 gave occassionally before. */ - -/* - 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 2.0.0, 9-MAY-1994 */ - -/* Added a pretty print formatting capability to the */ -/* error diagnostics. */ - -/* - 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 */ - - -/* - Beta Version 2.0.0, 14-JAN-1993 (HAN) */ - -/* Assigned the value 'INTERACTIVE' to the variable MODE, and */ -/* replaced calls to VTLIB routines with calls to more */ -/* portable routines. */ - -/* - Beta Version 1.0.0, 13-JUL-1988 (WLT) (IMU) */ - -/* -& */ - -/* Spice Functions */ - - -/* Local variables. */ - - -/* Saved variables */ - - -/* Initial values */ - - /* Parameter adjustments */ - if (temps) { - } - if (error) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_m2marg; - } - -/* %&END_DECLARATIONS */ - -/* Take care of first pass initializations. */ - - if (pass1) { - pass1 = FALSE_; - ssizec_(&c__1, thnwds, (ftnlen)32); - scardc_(&c__0, thnwds, (ftnlen)32); - ssizec_(&c__10, kwords, (ftnlen)32); - scardc_(&c__0, kwords, (ftnlen)32); - -/* Determine if were in batch or interactive mode. */ - - if (batch_()) { - s_copy(mode, "BATCH", (ftnlen)16, (ftnlen)5); - } else { - s_copy(mode, "INTERACTIVE", (ftnlen)16, (ftnlen)11); - } - } - intrct = s_cmp(mode, "BATCH", (ftnlen)16, (ftnlen)5) != 0; - s_copy(style, margns, (ftnlen)128, (ftnlen)128); - suffix_("NEWLINE /cr VTAB /vt HARDSPACE , ", &c__1, style, (ftnlen)33, ( - ftnlen)128); - i__ = 0; - bscore = -1; - m2code = -1; - cutoff = 72; - reason = TRUE_; - -/* Look through the templates until we get a match or we */ -/* run out of templates to try. */ - - i__1 = *ntemps; - for (i__ = 1; i__ <= i__1; ++i__) { - score = 0; - s_copy(temp, temps + (i__ - 1) * temps_len, temp_len, temps_len); - sbeg = 1; - m2code = 0; - m2gmch_(temp, thnwds, command, &sbeg, &reason, &cutoff, &pssthn, & - m2code, &score, error, temp_len, (ftnlen)32, command_len, - error_len); - -/* If M2CODE comes back zero, we are done with the work */ -/* of this routine. */ - - if (m2code == 0) { - *btemp = i__; - return 0; - } - if (score > bscore) { - bscore = score; - *btemp = i__; - } - } - -/* If we get here, we know we didn't have a match. Examine the */ -/* highest scoring template to get available diagnostics */ -/* about the mismatch. */ - - s_copy(temp, temps + (*btemp - 1) * temps_len, temp_len, temps_len); - sbeg = 1; - fixit = TRUE_; - m2code = 0; - m2gmch_(temp, thnwds, command, &sbeg, &c_true, &cutoff, &pssthn, &m2code, - &score, error, temp_len, (ftnlen)32, command_len, error_len); - -/* If we are in interactiive mode and we have a spelling error, we */ -/* can attempt to fix it. Note this occurs only if the M2CODE */ -/* is less than 100 mod 10000. */ - - while(m2code % 10000 < 100 && intrct && fixit) { - -/* Construct a friendly message; display it; and */ -/* get the user's response as to whether or not the */ -/* command should be modified. */ - - s_copy(tryit, error, (ftnlen)600, error_len); - prefix_("Hmmmm.,,,", &c__1, tryit, (ftnlen)9, (ftnlen)600); - suffix_("/cr/cr I can repair this if you like.", &c__0, tryit, ( - ftnlen)37, (ftnlen)600); - s_wsle(&io___19); - e_wsle(); - niceio_3__(tryit, &c__6, style, (ftnlen)600, (ftnlen)128); - s_wsle(&io___20); - e_wsle(); - s_wsle(&io___21); - e_wsle(); - s_wsle(&io___22); - e_wsle(); - s_wsle(&io___23); - e_wsle(); - m2rcvr_(&b, &e, kwords, (ftnlen)32); - if (cardc_(kwords, (ftnlen)32) == 1) { -/* Writing concatenation */ - i__2[0] = 17, a__1[0] = "Should I change \""; - i__2[1] = e - (b - 1), a__1[1] = command + (b - 1); - i__2[2] = 6, a__1[2] = "\" to \""; - i__2[3] = rtrim_(kwords + 192, (ftnlen)32), a__1[3] = kwords + - 192; - i__2[4] = 3, a__1[4] = "\" ?"; - s_cat(questn, a__1, i__2, &c__5, (ftnlen)80); - cnfirm_1__(questn, &fixit, rtrim_(questn, (ftnlen)80)); - } else { - cnfirm_1__("Should I fix it?", &fixit, (ftnlen)16); - } - -/* If the user has elected to have us fix the command */ -/* we have a few things to do... */ - - if (fixit) { - -/* Look up the suggested fixes. If there is more than */ -/* one possibility, see which one the user thinks is */ -/* best. Otherwise, no more questions for now. */ - - m2rcvr_(&b, &e, kwords, (ftnlen)32); - if (cardc_(kwords, (ftnlen)32) > 1) { - i__1 = cardc_(kwords, (ftnlen)32) - 4; - for (i__ = 1; i__ <= i__1; ++i__) { - s_wsle(&io___27); - e_wsle(); - } - i__1 = cardc_(kwords, (ftnlen)32); - getopt_1__("Which word did you mean?", &i__1, keynam, &c__6, - kwords + 192, &c__32, kwords + 192, pick, (ftnlen)24, - (ftnlen)6, (ftnlen)32, (ftnlen)32, (ftnlen)32); - } else { - s_copy(pick, kwords + 192, (ftnlen)32, (ftnlen)32); - } - -/* Make the requested repairs on the command, and */ -/* redisplay the command. */ - - repsub_(command, &b, &e, pick, command, command_len, (ftnlen)32, - command_len); - cmprss_(" ", &c__1, command, command, (ftnlen)1, command_len, - command_len); - s_wsle(&io___29); - do_lio(&c__9, &c__1, " ", (ftnlen)1); - e_wsle(); - s_wsle(&io___30); - do_lio(&c__9, &c__1, " ", (ftnlen)1); - e_wsle(); - niceio_3__(command, &c__6, style, command_len, (ftnlen)128); - s_wsle(&io___31); - e_wsle(); - -/* Look through the templates again until we get a match or we */ -/* run out of templates to try. Note however, that this time */ -/* we will start in a different spot. We already have a best */ -/* matching template. We'll start our search for a match */ -/* there and simulate a circular list of templates so that */ -/* we can examine all of them if necessary. */ - - s_copy(error, " ", error_len, (ftnlen)1); - s_copy(error + error_len, " ", error_len, (ftnlen)1); - bscore = -1; - m2code = -1; - cutoff = 72; - reason = TRUE_; - j = *btemp - 1; - i__1 = *ntemps; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the index of the next template to examine. */ - - ++j; - while(j > *ntemps) { - j -= *ntemps; - } - -/* Set the template, score for this template, spot to */ -/* begin examining it and the M2CODE so far. */ - - s_copy(temp, temps + (j - 1) * temps_len, temp_len, temps_len) - ; - sbeg = 1; - score = 0; - m2code = 0; - m2gmch_(temp, thnwds, command, &sbeg, &reason, &cutoff, & - pssthn, &m2code, &score, error, temp_len, (ftnlen)32, - command_len, error_len); - -/* If we get back a zero M2CODE we've got a match */ -/* This routine's work is done. */ - - if (m2code == 0) { - *btemp = i__; - return 0; - } - -/* Hmmph. No match. See if we've got a better */ -/* matching score so far and then go on to the next */ -/* template if any are left. */ - - if (score > bscore) { - bscore = score; - *btemp = i__; - } - } - -/* If we made it to this point the command doesn't properly */ -/* match any of the templates. Get the best match and */ -/* determine the diagnostics for this template. */ - - s_copy(temp, temps + (*btemp - 1) * temps_len, temp_len, - temps_len); - sbeg = 1; - m2code = 0; - score = 0; - m2gmch_(temp, thnwds, command, &sbeg, &reason, &cutoff, &pssthn, & - m2code, &score, error, temp_len, (ftnlen)32, command_len, - error_len); - } - } - -/* If you get to this point. We didn't have a match set up */ -/* the second level of mismatch diagnostics using the best */ -/* matching template. (BTEMP already points to it.) */ - - s_copy(temp, temps + (*btemp - 1) * temps_len, temp_len, temps_len); - cmprss_(" ", &c__1, temp, temp, (ftnlen)1, temp_len, temp_len); - prepsn_(temp, temp_len); - prepsn_(error + error_len, error_len); - prefix_("/cr/cr(-3:-3) ", &c__1, error + error_len, (ftnlen)14, error_len) - ; - prefix_(temp, &c__1, error + error_len, temp_len, error_len); - prefix_("/cr/cr(3:3) ", &c__1, error + error_len, (ftnlen)12, error_len); - prefix_("a command with the following syntax:", &c__3, error + error_len, - (ftnlen)36, error_len); - prefix_("I Believe you were trying to enter", &c__1, error + error_len, ( - ftnlen)34, error_len); - prefix_("META/2:", &c__1, error + error_len, (ftnlen)7, error_len); - return 0; - -/* The following entry point allows user's to adjust the margins */ -/* of the META/2 error messages. */ - - -L_m2marg: - s_copy(margns, temp, (ftnlen)128, temp_len); - return 0; -} /* meta_2__ */ - -/* Subroutine */ int meta_2__(char *command, char *temps, integer *ntemps, - char *temp, integer *btemp, char *error, ftnlen command_len, ftnlen - temps_len, ftnlen temp_len, ftnlen error_len) -{ - return meta_2__0_(0, command, temps, ntemps, temp, btemp, error, - command_len, temps_len, temp_len, error_len); - } - -/* Subroutine */ int m2marg_(char *temp, ftnlen temp_len) -{ - return meta_2__0_(1, (char *)0, (char *)0, (integer *)0, temp, (integer *) - 0, (char *)0, (ftnint)0, (ftnint)0, temp_len, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/mkprodct.csh b/ext/spice/src/csupport/mkprodct.csh deleted file mode 100644 index 2244d9acc5..0000000000 --- a/ext/spice/src/csupport/mkprodct.csh +++ /dev/null @@ -1,314 +0,0 @@ -#! /bin/csh -# -# PC-LINUX 64bit version. -# -# This script is a more or less generic library/executable -# builder for CSPICE products. It assumes that it is executed -# from one of the "product" directories in a tree that looks like -# the one displayed below: -# -# package -# | -# | -# +------+------+------+------+------+ -# | | | | | | -# data doc etc exe lib src -# | -# | -# +----------+----------+------- ... ------+ -# | | | | -# product_1 product_2 product_3 ... product_n -# -# Here's the basic strategy: -# -# 1) Compile all of the .c files in the current directory -# -# 2) If there are no .pgm files in the current directory this -# is assumed to be a library source directory. The name -# of the library is the same as the name of the product. -# The library is placed in the "lib" directory in the tree -# above. The script is then done. -# -# If there are .pgm files and there were some .c -# files compiled the objects are gathered together in the -# current directory into a library called locallib.a. -# -# 3) If any *.pgm files exist in the current directory, compile -# them and add their objects to locallib.a. Create a C main -# program file from the uniform CSPICE main program main.x. -# Compile this main program and link its object with locallib.a, -# ../../cspice.a and ../../csupport.a. The output -# executables have an empty extension. The executables are -# placed in the "exe" directory in the tree above. -# -# The environment variable TKCOMPILEOPTIONS containing compile options -# is optionally set. If it is set prior to executing this script, -# those options are used. It it is not set, it is set within this -# script as a local variable. -# -# References: -# =========== -# -# "Unix Power Tools", page 11.02 -# Use the "\" character to unalias a command temporarily. -# -# "A Practical Guide to the Unix System" -# -# "The Unix C Shell Field Guide" -# -# Change History: -# =============== -# -# Version 6.2.0 Feb. 14, 2008 Boris Semenov -# -# Added -fPIC option. -# -# Version 6.1.0 November 13, 2006 Boris Semenov -# -# Updated for 64bit. Put -O2 back in. -# -# Version 6.0.0 April 20, 2000 Bill Taber -# -# Removed O2 optimization as it caused some loops to -# not terminate. -# -# Version 5.0.0 Feb. 09, 1999 Nat Bachman -# -# Now uses O2 optimization. -# -# Version 4.0.0 Nov. 02, 1998 Nat Bachman -# -# Updated to use an environment variable to designate the C -# compiler to use. -# -# Version 3.0.0 Oct. 31, 1998 Nat Bachman -# -# Updated to make use of uniform C main routine main.x. -# -# Version 2.0.0 Feb. 04, 1998 Nat Bachman -# -# Modified to handle C code. Sun/Solaris/Native cc Version. -# -# Version 1.0.0 Dec 8, 1995 Bill Taber -# - - -# -# If there are any main programs in the directory, prepare them -# for use together with the "uniform" main.x routine. We copy -# each main program to a file whose name terminates in _main.c. -# We then make a copy of main.x having its name made of the tail of -# the original .pgm file and an extension of .px. When we compile -# the main programs, we'll look for this .px extension rather than -# the orginal .pgm. -# -\ls *.pgm >& /dev/null - -if ( $status == 0 ) then - - echo " " - - foreach MAIN ( *.pgm ) - -# -# Copy the orginal source file for the main program into a regular -# source file which will be included in the local library. -# -# Create a "main" source file having the name .px -# from the generic main program source file main.x. -# - set STEM = $MAIN:r - set TARGET = $STEM.px - - \cp $MAIN "$STEM"_main.c - \cp main.x $TARGET - -endif - - -# -# Choose your compiler. -# -if ( $?TKCOMPILER ) then - - echo " " - echo " Using compiler: " - echo " $TKCOMPILER" - -else - - set TKCOMPILER = "gcc" - echo " " - echo " Setting default compiler:" - echo $TKCOMPILER - -endif - - -# -# What compile options do we want to use? If they were -# set somewhere else, use those values. The same goes -# for link options. -# -if ( $?TKCOMPILEOPTIONS ) then - echo " " - echo " Using compile options: " - echo " $TKCOMPILEOPTIONS" -else -# -# Options: -# -# -ansi Compile source as ANSI C -# -# -DNON_UNIX_STDIO Don't assume standard Unix stdio.h -# implementation -# -# -fPIC position-independent code -# - set TKCOMPILEOPTIONS = "-c -ansi -m64 -O2 -fPIC -DNON_UNIX_STDIO" - echo " " - echo " Setting default compile options:" - echo " $TKCOMPILEOPTIONS" -endif - -if ( $?TKLINKOPTIONS ) then - echo " " - echo " Using link options: " - echo " $TKLINKOPTIONS" -else - set TKLINKOPTIONS = "-lm -m64" - echo " " - echo " Setting default link options:" - echo " $TKLINKOPTIONS" -endif - -echo " " - -# -# Determine a provisional LIBRARY name. -# - foreach item ( `pwd` ) - set LIBRARY = "../../lib/"$item:t - end - -# -# Are there any *.c files that need to be compiled? -# -\ls *.c >& /dev/null - -if ( $status == 0 ) then - - foreach SRCFILE ( *.c ) - echo " Compiling: " $SRCFILE - $TKCOMPILER $TKCOMPILEOPTIONS $SRCFILE - end - -endif - - -echo " " - -# -# If object files exist, we need to create an object library. -# - -\ls *.pgm >& /dev/null - -if ( $status == 0 ) then - set LIBRARY = "locallib" -endif - -\ls *.o >& /dev/null - -if ( $status == 0 ) then - - echo " Inserting objects in the library $LIBRARY ..." - ar crv $LIBRARY.a *.o - ranlib $LIBRARY.a - \rm *.o - echo " " - -endif - -# -# If there are any main programs in the directory, compile -# them. If they have their own locallib.a link with it in addition -# to the default libraries. -# - -\ls *.pgm >& /dev/null - -if ( $status == 0 ) then - - echo " " - - foreach MAIN ( *.px ) - - set STEM = $MAIN:r - set TARGET = $STEM.c - set MAINOBJ = $STEM.o - set EXECUT = ../../exe/$STEM - - cp $MAIN $TARGET - - echo " Compiling and linking: " $MAIN - - if ( -e locallib.a ) then - - $TKCOMPILER $TKCOMPILEOPTIONS $TARGET - $TKCOMPILER -o $EXECUT $MAINOBJ \ - locallib.a \ - ../../lib/csupport.a \ - ../../lib/cspice.a \ - $TKLINKOPTIONS - - \rm $TARGET - \rm $MAINOBJ - \rm locallib.a - - else - - echo "Compiling and linking: " $MAIN - $TKCOMPILER $TKCOMPILEOPTIONS $TARGET - $TKCOMPILER -o $EXECUT $MAINOBJ \ - ../../lib/csupport.a \ - ../../lib/cspice.a \ - $TKLINKOPTIONS - - \rm $TARGET - \rm $MAINOBJ - - endif - - end - -endif - -# -# Cleanup. -# - -echo " " - -\ls *.o >& /dev/null - -if ( $status == 0 ) then - \rm *.o -endif - -\ls *.px >& /dev/null - -if ( $status == 0 ) then - \rm *.px -endif - -\ls *_main.c >& /dev/null - -if ( $status == 0 ) then - \rm *_main.c -endif - - -exit 0 - - diff --git a/ext/spice/src/csupport/mspeld.c b/ext/spice/src/csupport/mspeld.c deleted file mode 100644 index d50dba6ce5..0000000000 --- a/ext/spice/src/csupport/mspeld.c +++ /dev/null @@ -1,266 +0,0 @@ -/* mspeld.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__0 = 0; - -/* $Procedure MSPELD ( Misspelling diagnosis ) */ -/* Subroutine */ int mspeld_(char *word, char *guess, char *cause, ftnlen - word_len, ftnlen guess_len, ftnlen cause_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char last[16]; - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen); - char first[16]; - extern /* Subroutine */ int matche_(char *, char *, char *, integer *, - ftnlen, ftnlen, ftnlen); - char diagns[12]; - extern /* Subroutine */ int intord_(integer *, char *, ftnlen), suffix_( - char *, integer *, char *, ftnlen, ftnlen); - integer loc; - -/* $ Abstract */ - -/* Diagnose possible spelling errors that might cause a word */ -/* to differ from another (known) word. */ - -/* $ 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 */ - -/* COMPARE */ -/* ERROR */ -/* PARSING */ -/* UTILITY */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* WORD I A word that is thought to be misspelled. */ -/* GUESS I A word that is thought to be "close" to WORD. */ -/* CAUSE O A message indicating the difference between them. */ - -/* $ Detailed_Input */ - -/* WORD A word that is thought to be misspelled. */ - -/* GUESS A word that is thought to be "close" to WORD. */ - -/* $ Detailed_Output */ - -/* CAUSE A message that indicates the difference between WORD */ -/* and GUESS. */ - -/* $ Exceptions */ - -/* 1) CAUSE is blank whenever WORD and GUESS are the same. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* A number of spelling errors are due to the lack of cooperation */ -/* between the hands that do the typing and the brain that knows */ -/* how something should be spelled. Four common errors are: */ - -/* 1) Leaving out a necessary character. */ -/* 2) Adding an extra character. */ -/* 3) Mistyping a single character. */ -/* 4) Transposing two characters. */ - -/* This routine creates "friendly" diagnostic messages indicating */ -/* whether or not the difference between WORD and GUESS could have */ -/* been caused by one of these simple errors. */ - -/* This routine will typically be used only after the list of */ -/* guesses has been narrowed down to words that are "close" to */ -/* the unrecognized word. */ - -/* $ Examples */ -/* $ */ - -/* WORD : LENGHT */ -/* GUESS : LENGTH */ -/* CAUSE : 'It appears that you have transposed the fifth and */ -/* sixth letters of LENGTH (the letters T and H).' */ - - -/* WORD : EPHEMRIS */ -/* GUESS : EPHEMERIS */ -/* CAUSE : 'It appears that you have left out the sixth letter of */ -/* EPHEMERIS. (The sixth letter should be E.)' */ - -/* WORD : INTWGRATE */ -/* WORD : INTEGRATE */ -/* CAUSE : 'It appears that you have mistyped the fourth letter */ -/* of INTEGRATE. (The fourth letter should be E. You */ -/* have W instead.)' */ - -/* WORD : INTERGER */ -/* GUESS: INTEGER */ -/* CAUSE 'It appears that you have an extra letter at the fifth */ -/* letter of INTERGER. (The fifth letter R should be */ -/* removed.)' */ - -/* WORD : URUNAS */ -/* GUESS: URANUS */ -/* CAUSE: 'I believe you meant URANUS. However, the actual */ -/* spelling error is not a simple one.' */ - -/* WORD : INTERDENOMINATIONAL */ -/* GUESS: INTERDENOMINATIONAL */ -/* CAUSE: ' ' */ - -/* $ Restrictions */ - -/* Any restrictions that apply to the words compared by MATCHE */ -/* apply as well to WORD and GUESS. */ - -/* $ 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, 13-APR-1988 (WLT) (IMU) */ - -/* -& */ - -/* Local variables */ - - matche_(word, guess, diagns, &loc, word_len, guess_len, (ftnlen)12); - if (s_cmp(diagns, "IDENTITY", (ftnlen)12, (ftnlen)8) == 0) { - s_copy(cause, " ", cause_len, (ftnlen)1); - } else if (s_cmp(diagns, "TRANSPOSE", (ftnlen)12, (ftnlen)9) == 0) { - intord_(&loc, first, (ftnlen)16); - i__1 = loc + 1; - intord_(&i__1, last, (ftnlen)16); - lcase_(first, first, (ftnlen)16, (ftnlen)16); - lcase_(last, last, (ftnlen)16, (ftnlen)16); - s_copy(cause, "It appears that you have transposed the ", cause_len, ( - ftnlen)40); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("and", &c__1, cause, (ftnlen)3, cause_len); - suffix_(last, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letters of", &c__1, cause, (ftnlen)10, cause_len); - suffix_(guess, &c__1, cause, guess_len, cause_len); - suffix_("(the letters", &c__1, cause, (ftnlen)12, cause_len); - suffix_(guess + (loc - 1), &c__1, cause, (ftnlen)1, cause_len); - suffix_("and", &c__1, cause, (ftnlen)3, cause_len); - i__1 = loc; - suffix_(guess + i__1, &c__1, cause, loc + 1 - i__1, cause_len); - suffix_(").", &c__0, cause, (ftnlen)2, cause_len); - } else if (s_cmp(diagns, "INSERT", (ftnlen)12, (ftnlen)6) == 0) { - intord_(&loc, first, (ftnlen)16); - lcase_(first, first, (ftnlen)16, (ftnlen)16); - s_copy(cause, "It appears that you have left out the ", cause_len, ( - ftnlen)38); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letter of ", &c__1, cause, (ftnlen)10, cause_len); - suffix_(guess, &c__1, cause, guess_len, cause_len); - suffix_(". (The ", &c__0, cause, (ftnlen)7, cause_len); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letter should be ", &c__1, cause, (ftnlen)17, cause_len); - suffix_(guess + (loc - 1), &c__1, cause, (ftnlen)1, cause_len); - suffix_(".)", &c__0, cause, (ftnlen)2, cause_len); - } else if (s_cmp(diagns, "REPLACE", (ftnlen)12, (ftnlen)7) == 0) { - intord_(&loc, first, (ftnlen)16); - lcase_(first, first, (ftnlen)16, (ftnlen)16); - s_copy(cause, "It appears that you have mistyped the ", cause_len, ( - ftnlen)38); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letter of ", &c__1, cause, (ftnlen)10, cause_len); - suffix_(guess, &c__1, cause, guess_len, cause_len); - suffix_(". (The ", &c__0, cause, (ftnlen)7, cause_len); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letter should be ", &c__1, cause, (ftnlen)17, cause_len); - suffix_(guess + (loc - 1), &c__1, cause, (ftnlen)1, cause_len); - suffix_(". You have ", &c__0, cause, (ftnlen)11, cause_len); - suffix_(word + (loc - 1), &c__1, cause, (ftnlen)1, cause_len); - suffix_("instead.)", &c__1, cause, (ftnlen)9, cause_len); - } else if (s_cmp(diagns, "REMOVE", (ftnlen)12, (ftnlen)6) == 0) { - intord_(&loc, first, (ftnlen)16); - lcase_(first, first, (ftnlen)16, (ftnlen)16); - s_copy(cause, "It appears that you have an extra letter at the ", - cause_len, (ftnlen)48); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letter of ", &c__1, cause, (ftnlen)10, cause_len); - suffix_(word, &c__1, cause, word_len, cause_len); - suffix_(". (The ", &c__0, cause, (ftnlen)7, cause_len); - suffix_(first, &c__1, cause, (ftnlen)16, cause_len); - suffix_("letter ", &c__1, cause, (ftnlen)7, cause_len); - suffix_(word + (loc - 1), &c__1, cause, (ftnlen)1, cause_len); - suffix_("should be removed.)", &c__1, cause, (ftnlen)19, cause_len); - } else { - s_copy(cause, "I believe you meant ", cause_len, (ftnlen)20); - suffix_(guess, &c__1, cause, guess_len, cause_len); - suffix_(". However, the actual spelling ", &c__1, cause, (ftnlen)32, - cause_len); - suffix_("error is not a simple one. ", &c__1, cause, (ftnlen)32, - cause_len); - } - return 0; -} /* mspeld_ */ - diff --git a/ext/spice/src/csupport/ncodec.c b/ext/spice/src/csupport/ncodec.c deleted file mode 100644 index 411cba302a..0000000000 --- a/ext/spice/src/csupport/ncodec.c +++ /dev/null @@ -1,285 +0,0 @@ -/* ncodec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NCODEC ( Encode integer value into character item ) */ -/* Subroutine */ int ncodec_0_(int n__, integer *value, char *item, ftnlen - item_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), dechar_(char *, - integer *, ftnlen), enchar_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Encode an integer value into a character item. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Arbitrary integer value. */ -/* ITEM O Item into which VALUE has been encoded. */ - -/* $ Detailed_Input */ - -/* VALUE is an arbitrary integer value. */ - -/* $ Detailed_Output */ - -/* ITEM is a character item, into which the value has */ -/* been encoded. The value can be recovered by calling */ -/* subroutine DCODE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number to be encoded is negative, the error */ -/* 'SPICE(OUTOFRANGE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCODE (and its inverse, DCODE) provide a uniform way to store */ -/* and retrieve values from the control areas of cells and cell- */ -/* based data types. This makes it possible to write templates */ -/* for a generic data type, suitable for instantiation by a */ -/* pre-compiler. */ - -/* $ Examples */ - -/* The following code fragment illustrates how NCODE and DCODE */ -/* can be used to create instantiable subroutine templates. */ - -/* C */ -/* C Check the bolzat counter, to see if the elements */ -/* C have been freebished; if not, do it now, and set */ -/* C the counter to zero. */ -/* C */ -/* CALL DCODE@ ( STRUCT(-4), BCOUNT ) */ - -/* IF ( BCOUNT .GT. 0 ) THEN */ -/* CALL FREEB@ ( CARD@ ( STRUCT ), STRUCT(1) ) */ -/* CALL NCODE@ ( 0, STRUCT(-4) ) */ -/* END IF */ - -/* By replacing all occurrences of `@' with the appropriate */ -/* type ending (C, D, or I), this single template can give */ -/* rise to three separate pieces of type-dependent code. */ - -/* The alternative to using NCODE and DCODE is to use simple */ -/* assignments for numeric cells, and calls to ENCHAR and */ -/* DECHAR for character cells, destroying the symmetry inherent */ -/* in the rest of the code. */ - -/* $ Restrictions */ - -/* See ENCHAR, DECHAR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_dcodec; - } - - if (return_()) { - return 0; - } else { - chkin_("NCODEC", (ftnlen)6); - } - if (*value >= 0) { - enchar_(value, item, item_len); - } else { - setmsg_("Cannot encode #; must be non-negative.", (ftnlen)38); - errint_("#", value, (ftnlen)1); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - } - chkout_("NCODEC", (ftnlen)6); - return 0; -/* $Procedure DCODEC ( Decode integer value from character item ) */ - -L_dcodec: -/* $ Abstract */ - -/* Decode the integer value stored in a character item by a */ -/* previous call to NCODEC. */ - -/* $ Required_Reading */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ - -/* CHARACTER*(*) ITEM */ -/* INTEGER VALUE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item into which an integer value has been encoded. */ -/* VALUE O Encoded value. */ - -/* $ Detailed_Input */ - -/* ITEM is a character item, into which an integer value has */ -/* been encoded by a previous call to NCODEC. */ - -/* $ Detailed_Output */ - -/* VALUE is the encoded value. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCODE (and its inverse, DCODE) provide a uniform way to store */ -/* and retrieve values from the control areas of cells and cell- */ -/* based data types. This makes it possible to write templates */ -/* for a generic data type, suitable for instantiation by a */ -/* pre-compiler. */ - -/* $ Examples */ - -/* The following code fragment illustrates how NCODE and DCODE */ -/* can be used to create instantiable subroutine templates. */ - -/* C */ -/* C Check the bolzat counter, to see if the elements */ -/* C have been freebished; if not, do it now, and set */ -/* C the counter to zero. */ -/* C */ -/* CALL DCODE@ ( STRUCT(-4), BCOUNT ) */ - -/* IF ( BCOUNT .GT. 0 ) THEN */ -/* CALL FREEB@ ( CARD@ ( STRUCT ), STRUCT(1) ) */ -/* CALL NCODE@ ( 0, STRUCT(-4) ) */ -/* END IF */ - -/* By replacing all occurrences of `@' with the appropriate */ -/* type ending (C, D, or I), this single template can give */ -/* rise to three separate pieces of type-dependent code. */ - -/* The alternative to using NCODE and DCODE is to use simple */ -/* assignments for numeric cells, and calls to ENCHAR and */ -/* DECHAR for character cells, destroying the symmetry inherent */ -/* in the rest of the code. */ - -/* $ Restrictions */ - -/* See ENCHAR, DECHAR. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DCODEC", (ftnlen)6); - } - dechar_(item, value, item_len); - chkout_("DCODEC", (ftnlen)6); - return 0; -} /* ncodec_ */ - -/* Subroutine */ int ncodec_(integer *value, char *item, ftnlen item_len) -{ - return ncodec_0_(0, value, item, item_len); - } - -/* Subroutine */ int dcodec_(char *item, integer *value, ftnlen item_len) -{ - return ncodec_0_(1, value, item, item_len); - } - diff --git a/ext/spice/src/csupport/ncoded.c b/ext/spice/src/csupport/ncoded.c deleted file mode 100644 index 10c8d68d76..0000000000 --- a/ext/spice/src/csupport/ncoded.c +++ /dev/null @@ -1,283 +0,0 @@ -/* ncoded.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NCODED ( Encode integer value into DP item ) */ -/* Subroutine */ int ncoded_0_(int n__, integer *value, doublereal *item) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Encode an integer value into a double precision item. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Non-negative integer value. */ -/* ITEM O Item into which VALUE has been encoded. */ - -/* $ Detailed_Input */ - -/* VALUE is an arbitrary non-negative integer value. */ - -/* $ Detailed_Output */ - -/* ITEM is a double precision item, into which the value has */ -/* been encoded. The value can be recovered by calling */ -/* subroutine DCODE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number to be encoded is negative, the error */ -/* 'SPICE(OUTOFRANGE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCODE (and its inverse, DCODE) provide a uniform way to store */ -/* and retrieve values from the control areas of cells and cell- */ -/* based data types. This makes it possible to write templates */ -/* for a generic data type, suitable for instantiation by a */ -/* pre-compiler. */ - -/* $ Examples */ - -/* The following code fragment illustrates how NCODE and DCODE */ -/* can be used to create instantiable subroutine templates. */ - -/* C */ -/* C Check the bolzat counter, to see if the elements */ -/* C have been freebished; if not, do it now, and set */ -/* C the counter to zero. */ -/* C */ -/* CALL DCODE@ ( STRUCT(-4), BCOUNT ) */ - -/* IF ( BCOUNT .GT. 0 ) THEN */ -/* CALL FREEB@ ( CARD@ ( STRUCT ), STRUCT(1) ) */ -/* CALL NCODE@ ( 0, STRUCT(-4) ) */ -/* END IF */ - -/* By replacing all occurrences of `@' with the appropriate */ -/* type ending (C, D, or I), this single template can give */ -/* rise to three separate pieces of type-dependent code. */ - -/* The alternative to using NCODE and DCODE is to use simple */ -/* assignments for numeric cells, and calls to ENCHAR and */ -/* DECHAR for character cells, destroying the symmetry inherent */ -/* in the rest of the code. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_dcoded; - } - - if (return_()) { - return 0; - } else { - chkin_("NCODED", (ftnlen)6); - } - if (*value >= 0) { - *item = (doublereal) (*value); - } else { - setmsg_("Cannot encode #; must be non-negative.", (ftnlen)38); - errint_("#", value, (ftnlen)1); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - } - chkout_("NCODED", (ftnlen)6); - return 0; -/* $Procedure DCODED ( Decode integer value from DP item ) */ - -L_dcoded: -/* $ Abstract */ - -/* Decode the integer value stored in a double precision item by a */ -/* previous call to NCODED. */ - -/* $ Required_Reading */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ - -/* DOUBLE PRECISION ITEM */ -/* INTEGER VALUE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item into which an integer value has been encoded. */ -/* VALUE O Encoded value. */ - -/* $ Detailed_Input */ - -/* ITEM is a double precision item, into which an integer */ -/* value has been encoded by a previous call to NCODED. */ - -/* $ Detailed_Output */ - -/* VALUE is the encoded value. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCODE (and its inverse, DCODE) provide a uniform way to store */ -/* and retrieve values from the control areas of cells and cell- */ -/* based data types. This makes it possible to write templates */ -/* for a generic data type, suitable for instantiation by a */ -/* pre-compiler. */ - -/* $ Examples */ - -/* The following code fragment illustrates how NCODE and DCODE */ -/* can be used to create instantiable subroutine templates. */ - -/* C */ -/* C Check the bolzat counter, to see if the elements */ -/* C have been freebished; if not, do it now, and set */ -/* C the counter to zero. */ -/* C */ -/* CALL DCODE@ ( STRUCT(-4), BCOUNT ) */ - -/* IF ( BCOUNT .GT. 0 ) THEN */ -/* CALL FREEB@ ( CARD@ ( STRUCT ), STRUCT(1) ) */ -/* CALL NCODE@ ( 0, STRUCT(-4) ) */ -/* END IF */ - -/* By replacing all occurrences of `@' with the appropriate */ -/* type ending (C, D, or I), this single template can give */ -/* rise to three separate pieces of type-dependent code. */ - -/* The alternative to using NCODE and DCODE is to use simple */ -/* assignments for numeric cells, and calls to ENCHAR and */ -/* DECHAR for character cells, destroying the symmetry inherent */ -/* in the rest of the code. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DCODED", (ftnlen)6); - } - *value = (integer) (*item); - chkout_("DCODED", (ftnlen)6); - return 0; -} /* ncoded_ */ - -/* Subroutine */ int ncoded_(integer *value, doublereal *item) -{ - return ncoded_0_(0, value, item); - } - -/* Subroutine */ int dcoded_(doublereal *item, integer *value) -{ - return ncoded_0_(1, value, item); - } - diff --git a/ext/spice/src/csupport/ncodei.c b/ext/spice/src/csupport/ncodei.c deleted file mode 100644 index c7e24857b8..0000000000 --- a/ext/spice/src/csupport/ncodei.c +++ /dev/null @@ -1,283 +0,0 @@ -/* ncodei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NCODEI ( Encode integer value into integer item ) */ -/* Subroutine */ int ncodei_0_(int n__, integer *value, integer *item) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Encode an integer value into an integer item. */ - -/* $ 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 */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* VALUE I Non-negative integer value. */ -/* ITEM O Item into which VALUE has been encoded. */ - -/* $ Detailed_Input */ - -/* VALUE is an arbitrary non-negative integer value. */ - -/* $ Detailed_Output */ - -/* ITEM is an integer item, into which the value has been */ -/* been encoded. The value can be recovered by calling */ -/* subroutine DCODE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the number to be encoded is negative, the error */ -/* 'SPICE(OUTOFRANGE)' is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCODE (and its inverse, DCODE) provide a uniform way to store */ -/* and retrieve values from the control areas of cells and cell- */ -/* based data types. This makes it possible to write templates */ -/* for a generic data type, suitable for instantiation by a */ -/* pre-compiler. */ - -/* $ Examples */ - -/* The following code fragment illustrates how NCODE and DCODE */ -/* can be used to create instantiable subroutine templates. */ - -/* C */ -/* C Check the bolzat counter, to see if the elements */ -/* C have been freebished; if not, do it now, and set */ -/* C the counter to zero. */ -/* C */ -/* CALL DCODE@ ( STRUCT(-4), BCOUNT ) */ - -/* IF ( BCOUNT .GT. 0 ) THEN */ -/* CALL FREEB@ ( CARD@ ( STRUCT ), STRUCT(1) ) */ -/* CALL NCODE@ ( 0, STRUCT(-4) ) */ -/* END IF */ - -/* By replacing all occurrences of `@' with the appropriate */ -/* type ending (C, D, or I), this single template can give */ -/* rise to three separate pieces of type-dependent code. */ - -/* The alternative to using NCODE and DCODE is to use simple */ -/* assignments for numeric cells, and calls to ENCHAR and */ -/* DECHAR for character cells, destroying the symmetry inherent */ -/* in the rest of the code. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Standard SPICE error handling. */ - - switch(n__) { - case 1: goto L_dcodei; - } - - if (return_()) { - return 0; - } else { - chkin_("NCODEI", (ftnlen)6); - } - if (*value >= 0) { - *item = *value; - } else { - setmsg_("Cannot encode #; must be non-negative.", (ftnlen)38); - errint_("#", value, (ftnlen)1); - sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17); - } - chkout_("NCODEI", (ftnlen)6); - return 0; -/* $Procedure DCODEI ( Decode integer value from integer item ) */ - -L_dcodei: -/* $ Abstract */ - -/* Decode the integer value stored in an integer item by a */ -/* previous call to NCODEI. */ - -/* $ Required_Reading */ - -/* CELLS */ - -/* $ Keywords */ - -/* CELLS */ - -/* $ Declarations */ - -/* INTEGER ITEM */ -/* INTEGER VALUE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ITEM I Item into which an integer value has been encoded. */ -/* VALUE O Encoded value. */ - -/* $ Detailed_Input */ - -/* ITEM is an integer item, into which an integer value */ -/* has been encoded by a previous call to NCODEI. */ - -/* $ Detailed_Output */ - -/* VALUE is the encoded value. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* NCODE (and its inverse, DCODE) provide a uniform way to store */ -/* and retrieve values from the control areas of cells and cell- */ -/* based data types. This makes it possible to write templates */ -/* for a generic data type, suitable for instantiation by a */ -/* pre-compiler. */ - -/* $ Examples */ - -/* The following code fragment illustrates how NCODE and DCODE */ -/* can be used to create instantiable subroutine templates. */ - -/* C */ -/* C Check the bolzat counter, to see if the elements */ -/* C have been freebished; if not, do it now, and set */ -/* C the counter to zero. */ -/* C */ -/* CALL DCODE@ ( STRUCT(-4), BCOUNT ) */ - -/* IF ( BCOUNT .GT. 0 ) THEN */ -/* CALL FREEB@ ( CARD@ ( STRUCT ), STRUCT(1) ) */ -/* CALL NCODE@ ( 0, STRUCT(-4) ) */ -/* END IF */ - -/* By replacing all occurrences of `@' with the appropriate */ -/* type ending (C, D, or I), this single template can give */ -/* rise to three separate pieces of type-dependent code. */ - -/* The alternative to using NCODE and DCODE is to use simple */ -/* assignments for numeric cells, and calls to ENCHAR and */ -/* DECHAR for character cells, destroying the symmetry inherent */ -/* in the rest of the code. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("DCODEI", (ftnlen)6); - } - *value = *item; - chkout_("DCODEI", (ftnlen)6); - return 0; -} /* ncodei_ */ - -/* Subroutine */ int ncodei_(integer *value, integer *item) -{ - return ncodei_0_(0, value, item); - } - -/* Subroutine */ int dcodei_(integer *item, integer *value) -{ - return ncodei_0_(1, value, item); - } - diff --git a/ext/spice/src/csupport/newfil.c b/ext/spice/src/csupport/newfil.c deleted file mode 100644 index aa379c960f..0000000000 --- a/ext/spice/src/csupport/newfil.c +++ /dev/null @@ -1,351 +0,0 @@ -/* newfil.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NEWFIL ( Open a new file on the specified port ) */ -/* Subroutine */ int newfil_(char *pattrn, char *port, char *file, ftnlen - pattrn_len, ftnlen port_len, ftnlen file_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[128]; - logical more; - char this__[128], fname[128]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), reset_(void); - extern logical failed_(void); - integer badopn; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), nspopn_(char *, char *, ftnlen, - ftnlen); - extern logical exists_(char *, ftnlen); - extern /* Subroutine */ int fststr_(char *, char *, ftnlen, ftnlen), - nxtstr_(char *, char *, char *, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine opens a port with a file that is created from */ -/* the input PATTRN and returns the name of the FILE attached */ -/* to the port. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PATTRN I is a name pattern following the rules of MAKSTR */ -/* PORT I the port to which the FILE should be attached. */ -/* FILE O the name of the file attached to the port. */ - -/* $ Detailed_Input */ - -/* PATTRN The description below is lifted without change */ -/* from the routine MAKSTR. */ - -/* PATTRN is a string that specifies a pattern that */ -/* all strings in a sequence must match. There are */ -/* several special substrings in PATTRN that must */ -/* be recognized. */ - -/* 1) A substring of the form '<*>' (where * is used */ -/* as a variable length wildcard character) is called */ -/* an expansion. The substring that occurs between */ -/* the angle brackets < > is called the invisible */ -/* portion of the expansion. When the tokens of */ -/* PATTRN are counted the invisible portion of the */ -/* expansion is not counted. Thus an expansion has */ -/* exactly two tokens '<' and '>' The invisible */ -/* portion of the expansion must not contain */ -/* any of the characters '<', '>', '{', or '}'. */ - -/* 2) A substring of the form '{#-$}' where # and $ */ -/* stand for any chacter from the set */ -/* '0', ... , '9', 'a', ... , 'z' is called a */ -/* restriction. */ - -/* A pattern may consist of any collection of */ -/* characters. However, the characters '<' and */ -/* '>' must always occur in balanced pairs with '<' */ -/* on the left and '>' on the right. Moreover, they */ -/* cannot be nested even if they are balanced. Similary */ -/* '{' and '}' must always appear as a balanced pair */ -/* and have exactly 3 characters between them. The */ -/* first is a lower case letter or a digit. The second */ -/* letter may be anything (usually a hyphen, colon or */ -/* comma). The third character must */ -/* also be a letter between 0, ... ,9, a, b, ... , z */ -/* and must occur later in the collating sequence than */ -/* the first letter in the triple that occurs between */ -/* '{' and '}'. */ - -/* For example the following are valid patterns */ - -/* PAT__{0-9}{a-z}{a-d} */ -/* COUNTER{0-9}{0-9}{0-9}{0-9} */ -/* COUNTER{0:9}{0,9}{a;b} */ - -/* but the following are not */ - -/* PAT_<<>>_{0-9}{a-z}{a-d} --- Nested < > */ -/* COUNTER{9-0} --- 9 before 0 */ -/* PAT_{0to0} --- 4 characters between{} */ -/* PAT_{A-Z} --- uppercase letters in{} */ -/* PAT_{+-$} --- bad characters in {} */ - -/* Pattern should be viewed as consisting of a sequence */ -/* of tokens. The tokens consist of characters that */ -/* are not part of an expansion or restriction */ -/* restrictions and the '<' and '>' characters of */ -/* any expansion. */ - -/* $ Detailed_Output */ - -/* PORT is the name of an NSPIO port that will be opened */ -/* with the file name generated from PATTRN. */ - -/* FILE is a string that is the name of the file that is */ -/* open and attached to the specified PORT. The */ -/* name of the file will match the input PATTRN */ -/* and will be the first name generated from PATTRN */ -/* that can be opened. See the routine MAKSTR for */ -/* a more detailed explanation of the names */ -/* that are generated using FSTSTR and NXTSTR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file cannot be opened, the error */ -/* CMLOOP(CANNOTMAKEFILE) will be signalled. */ - -/* $ Particulars */ - -/* This is a utility routine for creating a file name that */ -/* can be opened without fear of name collisions and attached */ -/* to one of the file ports supported by NSPIO. In this way */ -/* you have a high likelyhood of success in opening a log file */ -/* or utility file for use by your program (this assumes that */ -/* you have adequate privelege to open a file in the directory */ -/* implied or specified by PATTRN). */ - -/* $ Examples */ - -/* Suppose that you need a utility file for holding some */ -/* temporary data structure in a program that makes use */ -/* of NSPIO for its IO. Then you could make the following */ -/* call */ - -/* PATTRN = 'util{0-9}{0-9}{0-9}{0-9}.tmp' */ - -/* CALL NEWFIL ( PATTRN, 'UTILITY', FILE ) */ - -/* If successful, FILE will hold the name of the file that */ -/* was opened and is attached to the UTILITY port of NSPIO. */ -/* Otherwise FILE will be returned as a blank and the */ -/* FAILED flag will have been set by the call to SIGERR */ -/* made in this routine. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 21-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Create a file name and attach it to an I/O port */ - -/* -& */ - -/* Spicelib routines. */ - -/* $ 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. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* The following parameters are the system parameters required */ -/* by PERCY. Be sure to read any notes before adjusting these */ - - -/* The maximum number of commands that can be buffered is */ -/* determined by the value of MAXCOM. This parameter is */ -/* used primarily by NXTCOM. */ - - -/* The parameter FILEN is the maximum length of a file name */ -/* on a particular system. */ - - -/* The parameter COMSIZ is the maximum length allowed for a */ -/* command. */ - - -/* The parameter ERRSIZ is the maximum length allowed for */ -/* error messages. */ - - -/* The parameter STYSIZ is the maximum length expected for */ -/* a NICEPR style string. */ - - -/* Local Parameters */ - - chkin_("NEWFIL", (ftnlen)6); - s_copy(fname, " ", (ftnlen)128, (ftnlen)1); - s_copy(name__, " ", (ftnlen)128, (ftnlen)1); - s_copy(this__, " ", (ftnlen)128, (ftnlen)1); - fststr_(pattrn, fname, pattrn_len, (ftnlen)128); - s_copy(name__, fname, (ftnlen)128, (ftnlen)128); - more = TRUE_; - badopn = 0; - while(badopn < 20) { - -/* Look for a file name that does not already exist. */ - - while(exists_(name__, (ftnlen)128) && more) { - s_copy(this__, name__, (ftnlen)128, (ftnlen)128); - s_copy(name__, " ", (ftnlen)128, (ftnlen)1); - nxtstr_(pattrn, this__, name__, pattrn_len, (ftnlen)128, (ftnlen) - 128); - more = s_cmp(name__, fname, (ftnlen)128, (ftnlen)128) != 0; - } - if (! more) { - s_copy(file, " ", file_len, (ftnlen)1); - setmsg_("It was not possible to create a # file as specified. Al" - "l appropriately named files already exist.", (ftnlen)97); - errch_("#", port, (ftnlen)1, port_len); - sigerr_("CMLOOP(CANNOTMAKEFILE)", (ftnlen)22); - chkout_("NEWFIL", (ftnlen)6); - return 0; - } else { - s_copy(file, name__, file_len, (ftnlen)128); - } - -/* Ok. We've got a good candidate, try to attach it to the */ -/* specified port. */ - - nspopn_(port, file, port_len, file_len); - if (failed_()) { - ++badopn; - -/* We will try a few more times on the off chance that */ -/* some other program used the same name first. This */ -/* is not likely, file protection problems or PATTRN */ -/* specifications are a more probable cause of the trouble, */ -/* but we try anyway. */ - - if (badopn < 20) { - reset_(); - } - } else { - -/* We were successful in opening the port with the */ -/* specified name. We can quit now. */ - - chkout_("NEWFIL", (ftnlen)6); - return 0; - } - } - -/* If you get to this point, a file was not succesfully */ -/* attached to PORT. But NSPIO has already diagnosed */ -/* the problem as much as we're going to. Just set FILE */ -/* to a blank and return. */ - - s_copy(file, " ", file_len, (ftnlen)1); - chkout_("NEWFIL", (ftnlen)6); - return 0; -} /* newfil_ */ - diff --git a/ext/spice/src/csupport/newfil_1.c b/ext/spice/src/csupport/newfil_1.c deleted file mode 100644 index 2779666502..0000000000 --- a/ext/spice/src/csupport/newfil_1.c +++ /dev/null @@ -1,255 +0,0 @@ -/* newfil_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NEWFIL_1 ( Generate a filename that does not exist ) */ -/* Subroutine */ int newfil_1__(char *pattrn, char *file, ftnlen pattrn_len, - ftnlen file_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char name__[255]; - logical done; - char this__[255], fname[255]; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen) - ; - logical nomore; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - extern logical exists_(char *, ftnlen), return_(void); - extern /* Subroutine */ int fststr_(char *, char *, ftnlen, ftnlen), - nxtstr_(char *, char *, char *, ftnlen, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine generates a filename that is derived from */ -/* the input PATTRN and returns the name that was generated */ -/* in FILE. */ - -/* $ 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 */ - -/* FILES */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PATTRN I is a name pattern following the rules of MAKSTR */ -/* FILE O the name of the file generated. */ - -/* $ Detailed_Input */ - -/* PATTRN The description below is lifted without change */ -/* from the routine MAKSTR. */ - -/* PATTRN is a string that specifies a pattern that */ -/* all strings in a sequence must match. There are */ -/* several special substrings in PATTRN that must */ -/* be recognized. */ - -/* 1) A substring of the form '<*>' (where * is used */ -/* as a variable length wildcard character) is called */ -/* an expansion. The substring that occurs between */ -/* the angle brackets < > is called the invisible */ -/* portion of the expansion. When the tokens of */ -/* PATTRN are counted the invisible portion of the */ -/* expansion is not counted. Thus an expansion has */ -/* exactly two tokens '<' and '>' The invisible */ -/* portion of the expansion must not contain */ -/* any of the characters '<', '>', '{', or '}'. */ - -/* 2) A substring of the form '{#-$}' where # and $ */ -/* stand for any chacter from the set */ -/* '0', ... , '9', 'a', ... , 'z' is called a */ -/* restriction. */ - -/* A pattern may consist of any collection of */ -/* characters. However, the characters '<' and */ -/* '>' must always occur in balanced pairs with '<' */ -/* on the left and '>' on the right. Moreover, they */ -/* cannot be nested even if they are balanced. Similary */ -/* '{' and '}' must always appear as a balanced pair */ -/* and have exactly 3 characters between them. The */ -/* first is a lower case letter or a digit. The second */ -/* letter may be anything (usually a hyphen, colon or */ -/* comma). The third character must */ -/* also be a letter between 0, ... ,9, a, b, ... , z */ -/* and must occur later in the collating sequence than */ -/* the first letter in the triple that occurs between */ -/* '{' and '}'. */ - -/* For example the following are valid patterns */ - -/* PAT__{0-9}{a-z}{a-d} */ -/* COUNTER{0-9}{0-9}{0-9}{0-9} */ -/* COUNTER{0:9}{0,9}{a;b} */ - -/* but the following are not */ - -/* PAT_<<>>_{0-9}{a-z}{a-d} --- Nested < > */ -/* COUNTER{9-0} --- 9 before 0 */ -/* PAT_{0to0} --- 4 characters between{} */ -/* PAT_{A-Z} --- uppercase letters in{} */ -/* PAT_{+-$} --- bad characters in {} */ - -/* Pattern should be viewed as consisting of a sequence */ -/* of tokens. The tokens consist of characters that */ -/* are not part of an expansion or restriction */ -/* restrictions and the '<' and '>' characters of */ -/* any expansion. */ - -/* $ Detailed_Output */ - -/* FILE is a string that is the name of the file that was */ -/* generated. The name of the file will match the */ -/* input PATTRN and will be the first name generated */ -/* from PATTRN that does not exist. See the routine */ -/* MAKSTR for a more detailed explanation of the names */ -/* that are generated using FSTSTR and NXTSTR. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This is a utility routine for creating a file name that */ -/* can be opened without fear of name collisions, i.e., it */ -/* creates tha name of a file that does not exist, thus */ -/* guaranteeing that you can open the file. */ - -/* $ Examples */ - -/* Suppose that you need a utility file for holding some */ -/* temporary data structure in a program that makes use */ -/* of NSPIO for its IO. Then you could make the following */ -/* call */ - -/* PATTRN = 'util{0-9}{0-9}{0-9}{0-9}.tmp' */ - -/* CALL NEWFIL ( PATTRN, FILE ) */ - -/* If successful, FILE will hold the name of the new file. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 30-MAY-1996 (KRG) (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Create a new file name from a pattern */ - -/* -& */ - -/* Spicelib routines. */ - - -/* Local Parameters */ - -/* Length of a filename. */ - - -/* Local Variables */ - - if (return_()) { - return 0; - } else { - chkin_("NEWFIL_1", (ftnlen)8); - } - s_copy(fname, " ", (ftnlen)255, (ftnlen)1); - -/* Get the first filename in the pattern space. */ - - fststr_(pattrn, fname, pattrn_len, (ftnlen)255); - s_copy(name__, fname, (ftnlen)255, (ftnlen)255); - nomore = FALSE_; - done = FALSE_; - -/* Look for a file name that does not already exist. */ - - while(! done) { - s_copy(this__, name__, (ftnlen)255, (ftnlen)255); - s_copy(name__, " ", (ftnlen)255, (ftnlen)1); - nxtstr_(pattrn, this__, name__, pattrn_len, (ftnlen)255, (ftnlen)255); - done = s_cmp(name__, fname, (ftnlen)255, (ftnlen)255) == 0; - if (! done) { - if (! exists_(name__, (ftnlen)255)) { - done = TRUE_; - } - } else { - nomore = TRUE_; - } - } - if (nomore) { - s_copy(file, " ", file_len, (ftnlen)1); - setmsg_("It was not possible to create a file name using '#' as the " - "pattern. All of the file names that can be generated from th" - "is pattern already exist.", (ftnlen)144); - errch_("#", pattrn, (ftnlen)1, pattrn_len); - sigerr_("SPICE(CANNOTMAKEFILE)", (ftnlen)21); - chkout_("NEWFIL_1", (ftnlen)8); - return 0; - } - s_copy(file, name__, file_len, (ftnlen)255); - chkout_("NEWFIL_1", (ftnlen)8); - return 0; -} /* newfil_1__ */ - diff --git a/ext/spice/src/csupport/nicebt_1.c b/ext/spice/src/csupport/nicebt_1.c deleted file mode 100644 index e7524774c9..0000000000 --- a/ext/spice/src/csupport/nicebt_1.c +++ /dev/null @@ -1,1107 +0,0 @@ -/* nicebt_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure NICEBT_1 ( Nicely buffered text ) */ -/* Subroutine */ int nicebt_1__(char *string, char *style, char *buffer, - ftnlen string_len, ftnlen style_len, ftnlen buffer_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer vbeg; - char line[512]; - integer left, last; - extern integer upto_(char *, char *, integer *, ftnlen, ftnlen); - integer b, e, flagb, k, flage, w; - extern logical match_(char *, char *, ftnlen, ftnlen); - integer leftb, vtabb, lefte, flagw, vtabe, nlinb; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer nline, nleft, rmarg, origl, right, width; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - integer vtabw, origr, start; - logical trltk; - integer vb, leadrb, ve, leadre; - logical leadtk; - extern /* Subroutine */ int appndc_(char *, char *, ftnlen, ftnlen); - char breaks[1]; - logical flagtk, mrgchg; - integer trailb, leadrw, rightb, traile; - logical hardsp; - integer righte, vtabat, indent; - logical looped; - integer pstamb; - char hspchr[1]; - integer prambw, lright; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - logical vtabtk; - integer nlinew, nright; - extern integer frstnb_(char *, ftnlen); - logical nlintk, newlin; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - integer trailw; - extern integer qlstnb_(char *, ftnlen); - extern /* Subroutine */ int setmsg_(char *, ftnlen); - char errorl[160]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen), - fndntk_(char *, char *, integer *, integer *, integer *, ftnlen, - ftnlen); - char errorr[160]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), replch_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int cutstr_(char *, integer *, integer *, char *, - integer *, integer *, ftnlen, ftnlen); - integer beg, end; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Output a string to a unit using one of a set of available styles. */ -/* Format and output a string so that it has a pleasing appearance */ -/* (breaks for newlines occurring at natural places, margins set at */ -/* desired levels, etc.) */ - -/* $ 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. */ - -/* $ Keywords */ - -/* STRING */ -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* STRING I Message to be printed. */ -/* STYLE I Format specification string. */ -/* BUFFER O Buffer to which formatted lines should be appended. */ - -/* $ Detailed_Input */ - -/* STRING A long string to be broken into columns and output. */ -/* If desired, the user can force various changes to the */ -/* format of the output by inserting control substrings */ -/* into the desired text, and specifying these control */ -/* strings in the character string STYLE. */ - -/* Three control functions are possible. They are: */ - -/* 1) Force a newline. */ -/* 2) Force a newline and alter the margins for output. */ -/* 3) Insert a vertical tab in the output. */ - -/* To force a new line at some location of the string */ -/* during output you must put the KEYWORD 'NEWLINE' */ -/* into the string STYLE followed by a word that will */ -/* be used to signal a linebreak. For example you */ -/* might use ' NEWLINE \cr '. At any point of the */ -/* string that a newline is desired, insert the string */ -/* associated with the NEWLINE keyword ( in this case */ -/* '\cr' ). Spaces are not required around the NEWLINE */ -/* control string (or any other control string). */ - -/* To modify the margins after a line break, you insert */ -/* the line break control string into STRING and insert */ -/* immediately after it a string of the form (x:y) where */ -/* x and y are numeric strings. The number x indicates */ -/* that the left margin should be moved x to the right. */ -/* The number y indicates the right margin should be */ -/* moved y to the left. Both negative and positive */ -/* values are allowed. Spaces are allowed within the */ -/* spaces between parentheses. In keeping with our */ -/* previous example both */ - -/* '\cr(5:-2)' and '\cr( 5 : -2 )' */ - -/* directs the routine to force an line break; move the */ -/* left margin 5 to the right; move the right margin */ -/* -2 to the left (.i.e. 2 to the right). */ - -/* \cr (5: -2) */ - -/* would be treated as simply a new line directive, the */ -/* remainder (5: -2) is treated as part of the string */ -/* to output. */ - -/* To force a vertical tab at any point of the string */ -/* you must specify a vertical tab control string in */ -/* the style string. Then at the point in string */ -/* where you want a vertical tab to appear, simply insert */ -/* the vertical tab string, spaces are NOT required */ -/* around the vertical tab string. */ - -/* All control substrings in STRING are treated as having */ -/* zero width and invisible to output. */ - -/* STYLE is a character string that controls how the string */ -/* should be formatted on output and what substrings */ -/* of STRING will be treated as control characters */ -/* for display of STRING. STYLE should consist of */ -/* a sequence of keyword/value word pairs. That is, */ -/* it should consist of a sequence of words ( according */ -/* to the SPICE definition of a word ) in a pattern */ -/* as illustrated here: */ - -/* Keyword_1 Value_1 Keyword_2 Value_2 ... Keyword_n Value_n */ - -/* Acceptable keywords, their meanings, and expectations */ -/* regarding their associate values are spelled at below. */ - -/* 'FLAG' is a keyword used to indicate that a string */ -/* will prefix the output of STRING. Moreover */ -/* STRING will be printed in a block that is */ -/* indented by one more than the nonblank length */ -/* of the FLAG. (The appearance will parallel what */ -/* you see here in this description, where 'FLAG' */ -/* is the flag associated with this block of text.) */ - -/* If a flag is specified, the resulting output */ -/* will consist of a flag, 1 space and formatted */ -/* output text. */ - -/* Unless the FLAG keyword appears, no flag is */ -/* used with the output. */ - -/* 'LEADER' is the keyword used to indicate that the left */ -/* margin of the output will always begin with */ -/* the word that follows LEADER. The leader */ -/* string will not appear on the FLAG line */ -/* if a FLAG is specified. The leader can */ -/* be placed on the FLAG line by simply making */ -/* it part of the flag. */ - -/* Unless the LEADER keyword appears, no leader is */ -/* used with the output. */ - -/* 'TRAILER' is the keyword used to indicate that the right */ -/* margin of the output will always end with */ -/* the word that follows TRAILER. The trailer */ -/* will appear in every line. */ - -/* The effect of using the keywords LEADER, TRAILER and FLAG */ -/* is to change the margins specified (or implied) through */ -/* the use of LEFT and RIGHT. The effective value of LEFT */ -/* will become LEFT + MAX ( LEN(LEADER), LEN(FLAG)+1 ). */ -/* The right margin becomes RIGHT - LEN(TRAILER). */ - - -/* 'LEFT' is the keyword used to indicate where the */ -/* left margin of the output text should appear */ -/* (either on the output screen or in a file). */ -/* Note if a FLAG is present, when displayed the */ -/* flag will start in this column of the output. */ -/* The remaining text will be indented one */ -/* more than the width of the nonblank portion of */ -/* the flag. If no flag is present, output will */ -/* begin in the specified LEFT column. */ - -/* The word that immediately follows LEFT must */ -/* successfully parse as an integer. */ - -/* If the LEFT keyword does not appear the left */ -/* margin is set to 1. */ - -/* 'RIGHT' is the keyword used to indicate where the */ -/* right margin of the output text should appear */ -/* (either on the output screen or in a file). */ - -/* The word that immediately follows RIGHT must */ -/* successfully parse as an integer. */ - -/* If the RIGHT keyword does not appear the right */ -/* margin is set to 80. */ - -/* 'NEWLINE' is the keyword used to indicate what substring */ -/* if any within the text string will be */ -/* intrepreted as meaning "start a new line" and */ -/* optionally "reset the margins." (See STRING */ -/* for details concerning the use of the newline */ -/* substring.) */ - -/* If the keyword NEWLINE is not present, no */ -/* substring of STRING will be interpreted as */ -/* directing a newline to be started. */ - -/* 'VTAB' is the keyword used to indicate what substring */ -/* within the text string will be interpreted */ -/* as meaning "start a new line, but indent it */ -/* to the current position within this line." */ -/* This is refered to as a vertical tab. */ - -/* If the keyword VTAB is not present no substring */ -/* of STRING will be interpreted as a vertical */ -/* tab. */ - -/* 'HARDSPACE' is the keyword used to indicate what character */ -/* within the text string will be processed as a */ -/* normal text character, but will be written out */ -/* as a space upon output. Note HARDSPACES in both */ -/* the FLAG and LEADER will converted into spaces */ -/* upon output. */ - -/* If the keyword HARDSPACE is not present, no */ -/* character will be interpreted as a hard space. */ - -/* $ Detailed_Output */ - -/* BUFFER is an initialized cell to which formatted lines */ -/* of text should be appended. */ - -/* $ Exceptions */ - -/* 1) If a keyword/value pair is entered more than once in */ -/* the style string, the last pair takes precedence. */ - -/* 2) If a keyword appears without a following value in the */ -/* style string the SPICE error 'SPICE(UNBALACEDPAIR)' is */ -/* signaled. */ - -/* 3) If a keyword is not recognized, the error 'SPICE(UNKNOWNKEY)' */ -/* is signaled */ - -/* 4) If one of the margin keywords (LEFT RIGHT) is not followed */ -/* by a numeric string, the error 'SPICE(NONNUMERICSTRING)' */ -/* is signaled. */ - -/* 5) If the left column becomes less than zero, or the right column */ -/* becomes less than the left column the error */ -/* 'SPICE(INVALIDCOLUMN)' is signaled. */ - -/* 6) If the number of columns from the left to the right margin */ -/* becomes less than or equal to the number of characters in the */ -/* flag (assuming one is specified) the error */ -/* 'SPICE(SPACETOONARROW)' is signaled. */ - -/* 7) If output cannot be performed, the error 'SPICE(OUTPUTERROR)' */ -/* will be signaled and a descriptive long message set to */ -/* aid in determining the cause of the output failure. */ - -/* 8) If the right margin exceeds 512, the output will be truncated */ -/* at column 512. */ - -/* $ Particulars */ - -/* This routine is designed to aid in the problem of creating */ -/* nice looking messages that must extend over 1 line. It */ -/* allows the user to construct messages by simply appending, */ -/* prefixing or inserting text into an existing string until */ -/* the message is finished. The user need not be concerned */ -/* about breaking up the message in good spots for output. */ -/* This routine searches the message in STRING for "good" places */ -/* at which to break STRING. */ - -/* The user may specify a "flag" that will be used to prefix the */ -/* first output line, left and right margins for the output, */ -/* and special strings for forcing creation of newlines, changing */ -/* margins, and inserting vertical tabs. */ - -/* This routine always sends to output a blank line prior to */ -/* the start of the output formatted string. */ - -/* Since strings are often built by concatenation, the user may */ -/* want to compress out extra spaces in string before calling */ -/* this routine. This routine breaks the input string at gaps */ -/* in the string, but does not get rid of large gaps within */ -/* a successfully broken output line. (See the examples below.) */ - -/* For a discussion of the string breaking algorithm see the */ -/* particulars section of the SPICE routine CUTSTR. */ - -/* $ Files */ - -/* None. */ - -/* $ Examples */ - -/* Suppose */ - -/* STYLE = 'LEFT 10 RIGHT 50 ' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Now is the time for all good men to come */ -/* the aid of their party. Out with the */ -/* bad air and in with the good. Health and */ -/* purity preserve our essence. */ - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 ' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: Now is the time for all good men */ -/* to come to the aid of their */ -/* party. Out with the bad air and */ -/* in with the good. Health and */ -/* purity preserve our essence. */ - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 NEWLINE .' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: Now is the time for all good men */ -/* to come to the aid of their */ -/* party */ -/* Out with the bad air and in with */ -/* the good */ -/* Health and purity preserve our */ -/* essence */ - - - - - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 VTAB . HARDSPACE _' */ -/* and */ - -/* STRING = '___ is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: is the time for all good men */ -/* to come to the aid of their */ -/* party */ -/* Out with the bad air and */ -/* in with the good */ -/* Health and */ -/* purity preserve our essence */ - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Error: LEFT 1 RIGHT 60 NEWLINE \cr VTAB \vt' */ - -/* and */ - -/* STRING = 'I believe the command you were attempting to enter'// */ -/* . 'was \cr\cr(5:5)FIND TIMES OF GREATEST ELONGATION ' // */ -/* . 'FOR VENUS \cr\cr(-5:-5) I was expecting to the ' // */ -/* . 'word GREATEST when I encountered the word GRETEST '// */ -/* . 'in your input command. \cr\cr(5:5) FIND TIMES OF ' // */ -/* . '\vt\vt GRETEST \vt\vt ELONGATION FOR VENUS ' // */ -/* . '\cr\cr(-5:-5) I think you left out the fourth ' // */ -/* . 'letter --- "A" . */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Error: I believe the command you were attempting to enter */ -/* was */ - -/* FIND TIMES OF GREATEST ELONGATION FOR VENUS */ - -/* I was expecting to see the word GREATEST when I */ -/* encountered the word GRETEST in your input command. */ - -/* FIND TIMES OF */ - -/* GRETEST */ - -/* ELONGATION FOR VENUS */ - -/* I think you left out the fourth letter --- "A" . */ - - -/* Some care should be taken when choosing substrings to indidicate */ -/* newline and vertical tab control. For example, suppose */ - -/* STYLE = ' FLAG NAIF: LEFT 6 RIGHT 56 NEWLINE xx VTAB AA ' */ - -/* and */ - -/* STRING = 'Officials at Exxon today reported a deal with the ' // */ -/* . 'Automobile Association of America (AAA) that would ' // */ -/* . 'provide club memebers with discount prices on ' // */ -/* . 'gasoline. xxxx( 3:3) Spokesmen said AA "Get your ' // */ -/* . 'AAA membership cards now." AA xx(-3:-3)xx Texeco ' // */ -/* . 'officials had no comment.' */ - - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* NAIF: Officials at E */ -/* on today reported a deal with the Automobile */ -/* Assosiation of America ( */ -/* A) that would provide */ -/* club members with discount prices on */ -/* gasoline. */ - -/* Spokesmen said */ -/* "Get your */ -/* A membership */ -/* cards now." */ - -/* Texeco officials had no comment. */ - - -/* $ Restrictions */ - -/* It is the responsibility of the calling program to properly */ -/* prepare the buffer to receive the output from this routine. */ - -/* The RIGHT margin must be less than or equal to 512. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* Beta Version 2.1.0, 22-APR-1997 (WLT) */ - -/* SETMSG calls modified so that as needed ERRCH is used */ -/* to fill in values instead of concatenating the value */ -/* in the error message. */ - -/* Beta Version 2.0.0, 10-APR-1995 (WLT) */ - -/* This routine was updated to avoid out of range violations */ -/* in the do-while loops used to examine the input string. */ - -/* Beta Version 1.0.0, 12-AUG-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB Functions. */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NICEBT_1", (ftnlen)8); - } - -/* Set the defaults and initial values. */ - - -/* Set the defaults and initial values. */ - - left = 1; - right = 80; - flagtk = FALSE_; - leadtk = FALSE_; - hardsp = FALSE_; - nlintk = FALSE_; - trltk = FALSE_; - vtabtk = FALSE_; - *(unsigned char *)hspchr = ' '; - flagw = 0; - leadrw = 0; - trailw = 0; - prambw = 0; - vtabw = 0; - beg = 1; - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - *(unsigned char *)breaks = ' '; - -/* Parse the style string. */ - - fndnwd_(style, &beg, &b, &e, style_len); - while(b != 0) { - vbeg = e + 1; - fndnwd_(style, &vbeg, &vb, &ve, style_len); - if (vb != 0) { - if (s_cmp(style + (b - 1), "FLAG", e - (b - 1), (ftnlen)4) == 0) { - flagb = vb; - flage = ve; - flagw = ve - vb + 2; - flagtk = TRUE_; - } else if (s_cmp(style + (b - 1), "LEADER", e - (b - 1), (ftnlen) - 6) == 0) { - leadrb = vb; - leadre = ve; - leadrw = ve - vb + 1; - leadtk = TRUE_; - } else if (s_cmp(style + (b - 1), "TRAILER", e - (b - 1), (ftnlen) - 7) == 0) { - trailb = vb; - traile = ve; - trailw = ve - vb + 1; - trltk = TRUE_; - } else if (s_cmp(style + (b - 1), "VTAB", e - (b - 1), (ftnlen)4) - == 0) { - vtabb = vb; - vtabe = ve; - vtabw = ve - vb + 1; - vtabtk = TRUE_; - } else if (s_cmp(style + (b - 1), "NEWLINE", e - (b - 1), (ftnlen) - 7) == 0) { - nlinb = vb; - nline = ve; - nlinew = ve - vb + 1; - nlintk = TRUE_; - } else if (s_cmp(style + (b - 1), "LEFT", e - (b - 1), (ftnlen)4) - == 0) { - nparsi_(style + (vb - 1), &left, errorl, &k, ve - (vb - 1), ( - ftnlen)160); - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) != 0) { - setmsg_("The word following the keyword 'LEFT' must pars" - "e as an integer. # ", (ftnlen)66); - errch_("#", errorl, (ftnlen)1, (ftnlen)160); - sigerr_("SPICE(NONNUMERICSTRING)", (ftnlen)23); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - } else if (s_cmp(style + (b - 1), "RIGHT", e - (b - 1), (ftnlen)5) - == 0) { - nparsi_(style + (vb - 1), &right, errorr, &k, ve - (vb - 1), ( - ftnlen)160); - if (s_cmp(errorr, " ", (ftnlen)160, (ftnlen)1) != 0) { - setmsg_("The word following the keyword 'RIGHT' must par" - "se as an integer. #", (ftnlen)66); - errch_("#", errorl, (ftnlen)1, (ftnlen)160); - sigerr_("SPICE(NONNUMERICSTRING)", (ftnlen)23); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - } else if (s_cmp(style + (b - 1), "HARDSPACE", e - (b - 1), ( - ftnlen)9) == 0) { - hardsp = TRUE_; - if (vb != ve) { - setmsg_("Hardspaces must be a single character. You hav" - "e \"#\".", (ftnlen)53); - errch_("#", style + (vb - 1), (ftnlen)1, ve - (vb - 1)); - sigerr_("SPICE(BADHARDSPACE)", (ftnlen)19); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } else { - *(unsigned char *)hspchr = *(unsigned char *)&style[vb - - 1]; - } - } else { - s_copy(line, style + (b - 1), (ftnlen)512, e - (b - 1)); - suffix_("is not a recognized keyword for the SPICELIB routin" - "e NICEIO. ", &c__1, line, (ftnlen)61, (ftnlen)512); - setmsg_(line, (ftnlen)512); - sigerr_("SPICE(UNKNOWNKEY)", (ftnlen)17); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - beg = ve + 1; - fndnwd_(style, &beg, &b, &e, style_len); - } else { - setmsg_("# did not have an associated value", (ftnlen)34); - errch_("#", style + (b - 1), (ftnlen)1, e - (b - 1)); - sigerr_("SPICE(UNBALANCEDPAIR)", (ftnlen)21); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - } - -/* So ends the parsing of the style string. Now do the actual work. */ - - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - -/* Determine how much space needs to be allocated for the */ -/* flag and leaders. */ - - origr = right; - origl = left; - rmarg = right; - prambw = max(flagw,leadrw); - pstamb = right - trailw + 1; - right -= trailw; - if (flagw > 0) { - s_copy(line + (origl - 1), style + (flagb - 1), 512 - (origl - 1), - flage - (flagb - 1)); - } else if (leadrw > 0) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - 1), - leadre - (leadrb - 1)); - } - if (trailw > 0) { - s_copy(line + (pstamb - 1), style + (trailb - 1), origr - (pstamb - 1) - , traile - (trailb - 1)); - } -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(string, string_len); - b = max(i__1,i__2); - last = qlstnb_(string, string_len); - -/* If there is a newline token, we have to write out empty lines */ -/* and modify the margins as we encounter newline tokens and */ -/* newline tokens with margin modifiers. Typically the loop */ -/* in the if block below will never be exercised. */ - - if (nlintk) { - e = b + nlinew - 1; - if (e < last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - 1), - nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - while(newlin) { - -/* See if the new line token is qualified so as to change */ -/* the margins of the output. */ - - if (e + 1 < last) { - i__1 = e; - mrgchg = match_(string + i__1, "(*:*)*", string_len - i__1, ( - ftnlen)6); - } else { - mrgchg = FALSE_; - } - if (mrgchg) { - -/* Looks like we should change the columns. Locate the */ -/* tokens of the newline marker. */ - - i__1 = e + 1; - fndntk_(string, "(:", &i__1, &leftb, &lefte, string_len, ( - ftnlen)2); - fndntk_(string, ":)", &lefte, &rightb, &righte, string_len, ( - ftnlen)2); - -/* Parse the strings representing the increments to left */ -/* and right column positions. */ - - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - if (leftb <= lefte) { - nparsi_(string + (leftb - 1), &nleft, errorl, &k, lefte - - (leftb - 1), (ftnlen)160); - } else { - nleft = 0; - } - if (rightb <= righte) { - nparsi_(string + (rightb - 1), &nright, errorr, &k, - righte - (rightb - 1), (ftnlen)160); - } else { - nright = 0; - } - -/* Only if no errors were encountered during parsing do we */ -/* change the columns. */ - - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) == 0 && s_cmp( - errorr, " ", (ftnlen)160, (ftnlen)1) == 0) { - b = righte + 2; - left += nleft; - right -= nright; - rmarg = max(origr,right); - } else { - b += nlinew; - } - } else { - b += nlinew; - } - -/* Check for goofy margins. */ - - if (left < 1) { - setmsg_("The current value for the left column is #. This is" - " less than 1 and thus not a valid value. ", (ftnlen) - 92); - errint_("#", &left, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } else if (left > right) { - setmsg_("The current value for the left column is greater th" - "an the value for the right column. The value for the" - " left column is #. The value for the right column i" - "s #. ", (ftnlen)160); - errint_("#", &left, (ftnlen)1); - errint_("#", &right, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - -/* Output something, but first replace hard spaces by spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, (ftnlen)1, - rmarg); - } - appndc_(line, buffer, rmarg, buffer_len); - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - ( - pstamb - 1), traile - (trailb - 1)); - } - -/* Adjust the beginning and ending of the next portion */ -/* of the string to examine. */ - -/* Computing MAX */ - i__1 = b, i__2 = ncpos_(string, " ", &b, string_len, (ftnlen)1); - b = max(i__1,i__2); - e = b + nlinew - 1; - if (e < last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - } - -/* Find the next portion of the string to examine (it's up to */ -/* the next new line token or end of string whichever */ -/* comes first. */ - - e = upto_(string, style + (nlinb - 1), &b, string_len, nline - (nlinb - - 1)); - } else { - e = last; - } - -/* Now we have are to the point of processing legitimate text. */ -/* Process the current substring STRING(B:E). It contains */ -/* no newline tokens. */ - - while(e != 0) { - width = right - left + 1 - prambw; - if (width < 1) { - sigerr_("SPICE(SPACETOONARROW)", (ftnlen)21); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - w = width; - start = b; - indent = 0; - -/* Grab the biggest piece of the substring that can be output */ -/* within the allowed space. */ - - cutstr_(string, &start, &w, breaks, &beg, &end, e, (ftnlen)1); - while(beg != 0) { - -/* See if there are any vertical tab marks */ - - if (! vtabtk) { - i__1 = left + prambw - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, end - ( - beg - 1)); - } else { - vtabat = pos_(string, style + (vtabb - 1), &start, e, vtabe - - (vtabb - 1)); - if (vtabat > 0 && vtabat <= end) { - -/* If there is a vertical tab at the beginning of the */ -/* string, we don't need to modify LINE. */ - - if (vtabat > beg) { - end = vtabat - 1; - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, - end - (beg - 1)); - indent = indent + end - beg + 1; - end = end + vtabe - vtabb + 1; - } else if (vtabat == beg) { - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, " ", right - i__1, (ftnlen)1); - end = beg + vtabe - vtabb; - } - } else { - -/* We just fill out the rest of this line. There will */ -/* be no need to indent the next one. */ - - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, end - - (beg - 1)); - indent = 0; - } - } - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, (ftnlen)1, - rmarg); - } - appndc_(line, buffer, rmarg, buffer_len); - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - ( - pstamb - 1), traile - (trailb - 1)); - } - start = end + 1; - w = width - indent; - if (w < 3) { - w = width; - } - cutstr_(string, &start, &w, breaks, &beg, &end, e, (ftnlen)1); - } - -/* Check to see if we should be looking for a newline token. */ - - if (nlintk) { - -/* Ok. Get ready to jump through hoops again. We have to */ -/* look for newline tokens, for all those in excess of one */ -/* in a row, we have to output a blank line. */ - - b = e + 1; - e += nlinew; - looped = FALSE_; - if (e <= last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - while(newlin) { - lright = right; - -/* See if the new line token is qualified so as to change */ -/* the margins of the output. */ - - if (e >= last) { - -/* In this case we can't possibly match as in the case */ -/* below */ - - b += nlinew; - } else /* if(complicated condition) */ { - i__1 = e; - if (match_(string + i__1, "(*:*)*", string_len - i__1, ( - ftnlen)6)) { - -/* Looks like we should change the columns. Locate the */ -/* tokens of the newline marker. */ - - fndntk_(string, "(:", &e, &leftb, &lefte, string_len, - (ftnlen)2); - fndntk_(string, ":)", &lefte, &rightb, &righte, - string_len, (ftnlen)2); - -/* Parse the strings representing the increments to left */ -/* and right column positions. */ - - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - if (leftb <= lefte) { - nparsi_(string + (leftb - 1), &nleft, errorl, &k, - lefte - (leftb - 1), (ftnlen)160); - } else { - nleft = 0; - } - if (rightb <= righte) { - nparsi_(string + (rightb - 1), &nright, errorr, & - k, righte - (rightb - 1), (ftnlen)160); - } else { - nright = 0; - } - -/* Only if no errors were encountered during parsing do */ -/* we change the columns. */ - - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) == 0 && - s_cmp(errorr, " ", (ftnlen)160, (ftnlen)1) == - 0) { - b = righte + 2; - left += nleft; - right -= nright; - rmarg = max(origr,right); - } else { - b += nlinew; - } - } else { - b += nlinew; - } - } - -/* Take care of the case when outdenting or indenting has */ -/* forced us into absurd margins. */ - - if (left < 1) { - setmsg_("The current value for the left column is #. Thi" - "s is less than 1 and thus not a valid value. ", ( - ftnlen)92); - errint_("#", &left, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } else if (left > right) { - setmsg_("The current value for the left column is greate" - "r than the value for the right column. The value" - " for the left column is #. The value for the ri" - "ght column is #. ", (ftnlen)160); - errint_("#", &left, (ftnlen)1); - errint_("#", &right, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEBT_1", (ftnlen)8); - return 0; - } - -/* Output something if this is not the first pass through */ -/* the loop. */ - - if (! looped) { - looped = TRUE_; - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - - (origl - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - - (pstamb - 1), traile - (trailb - 1)); - } - } else { - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, ( - ftnlen)1, rmarg); - } - appndc_(line, buffer, rmarg, buffer_len); - } -/* Computing MAX */ - i__1 = b, i__2 = ncpos_(string, " ", &b, string_len, (ftnlen) - 1); - b = max(i__1,i__2); - e = b + nlinew - 1; - if (e <= last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - - (b - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - } - e = upto_(string, style + (nlinb - 1), &b, string_len, nline - ( - nlinb - 1)); - -/* Just in case we went through the loop, and didn't */ -/* output a line, and we've reached the end of the */ -/* string. We check and write a blank line if necessary */ - - if (looped && e == 0) { - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, ( - ftnlen)1, rmarg); - } - appndc_(line, buffer, rmarg, buffer_len); - } - } else { - e = 0; - } - } - chkout_("NICEBT_1", (ftnlen)8); - return 0; -} /* nicebt_1__ */ - diff --git a/ext/spice/src/csupport/niceio_3.c b/ext/spice/src/csupport/niceio_3.c deleted file mode 100644 index bc04a1998a..0000000000 --- a/ext/spice/src/csupport/niceio_3.c +++ /dev/null @@ -1,1136 +0,0 @@ -/* niceio_3.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure NICEIO_3 ( Nicely formatted output -- test version ) */ -/* Subroutine */ int niceio_3__(char *string, integer *unit, char *style, - ftnlen string_len, ftnlen style_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer vbeg; - char line[512]; - integer left, last; - extern integer upto_(char *, char *, integer *, ftnlen, ftnlen); - integer b, e, flagb, k, flage, w; - extern logical match_(char *, char *, ftnlen, ftnlen); - integer leftb, vtabb, lefte, flagw, vtabe, nlinb; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer nline, nleft, rmarg, origl, right, width; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - integer vtabw, origr, start; - logical trltk; - extern logical failed_(void); - integer vb, leadrb, ve, leadre; - logical leadtk; - char breaks[1]; - logical flagtk, mrgchg; - integer trailb, leadrw, rightb, traile; - logical hardsp; - integer righte, vtabat, indent; - logical looped; - integer pstamb; - char hspchr[1]; - integer prambw, lright; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - logical vtabtk; - integer nlinew, nright; - extern integer frstnb_(char *, ftnlen); - logical nlintk, newlin; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - integer trailw; - extern integer qlstnb_(char *, ftnlen); - extern /* Subroutine */ int setmsg_(char *, ftnlen); - char errorl[160]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen), - fndntk_(char *, char *, integer *, integer *, integer *, ftnlen, - ftnlen); - char errorr[160]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), replch_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int writln_(char *, integer *, ftnlen), cutstr_( - char *, integer *, integer *, char *, integer *, integer *, - ftnlen, ftnlen); - integer beg, end; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Output a string to a unit using one of a set of available styles. */ -/* Format and output a string so that it has a pleasing appearance */ -/* (breaks for newlines occurring at natural places, margins set at */ -/* desired levels, etc.) */ - -/* $ 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. */ - -/* $ Keywords */ - -/* STRING */ -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* STRING I Message to be printed. */ -/* UNIT I Logical unit connected to output. */ -/* STYLE I Format specification string. */ - -/* $ Detailed_Input */ - -/* STRING A long string to be broken into columns and output. */ -/* If desired, the user can force various changes to the */ -/* format of the output by inserting control substrings */ -/* into the desired text, and specifying these control */ -/* strings in the character string STYLE. */ - -/* Three control functions are possible. They are: */ - -/* 1) Force a newline. */ -/* 2) Force a newline and alter the margins for output. */ -/* 3) Insert a vertical tab in the output. */ - -/* To force a new line at some location of the string */ -/* during output you must put the KEYWORD 'NEWLINE' */ -/* into the string STYLE followed by a word that will */ -/* be used to signal a linebreak. For example you */ -/* might use ' NEWLINE /cr '. At any point of the */ -/* string that a newline is desired, insert the string */ -/* associated with the NEWLINE keyword ( in this case */ -/* '/cr' ). Spaces are not required around the NEWLINE */ -/* control string (or any other control string). */ - -/* To modify the margins after a line break, you insert */ -/* the line break control string into STRING and insert */ -/* immediately after it a string of the form (x:y) where */ -/* x and y are numeric strings. The number x indicates */ -/* that the left margin should be moved x to the right. */ -/* The number y indicates the right margin should be */ -/* moved y to the left. Both negative and positive */ -/* values are allowed. Spaces are allowed within the */ -/* spaces between parentheses. In keeping with our */ -/* previous example both */ - -/* '/cr(5:-2)' and '/cr( 5 : -2 )' */ - -/* directs the routine to force an line break; move the */ -/* left margin 5 to the right; move the right margin */ -/* -2 to the left (.i.e. 2 to the right). */ - -/* /cr (5: -2) */ - -/* would be treated as simply a new line directive, the */ -/* remainder (5: -2) is treated as part of the string */ -/* to output. */ - -/* To force a vertical tab at any point of the string */ -/* you must specify a vertical tab control string in */ -/* the style string. Then at the point in string */ -/* where you want a vertical tab to appear, simply insert */ -/* the vertical tab string, spaces are NOT required */ -/* around the vertical tab string. */ - -/* All control substrings in STRING are treated as having */ -/* zero width and invisible to output. */ - -/* UNIT is the logical unit to which the output will be */ -/* directed. */ - -/* STYLE is a character string that controls how the string */ -/* should be formatted on output and what substrings */ -/* of STRING will be treated as control characters */ -/* for display of STRING. STYLE should consist of */ -/* a sequence of keyword/value word pairs. That is, */ -/* it should consist of a sequence of words ( according */ -/* to the SPICE definition of a word ) in a pattern */ -/* as illustrated here: */ - -/* Keyword_1 Value_1 Keyword_2 Value_2 ... Keyword_n Value_n */ - -/* Acceptable keywords, their meanings, and expectations */ -/* regarding their associate values are spelled at below. */ - -/* 'FLAG' is a keyword used to indicate that a string */ -/* will prefix the output of STRING. Moreover */ -/* STRING will be printed in a block that is */ -/* indented by one more than the nonblank length */ -/* of the FLAG. (The appearance will parallel what */ -/* you see here in this description, where 'FLAG' */ -/* is the flag associated with this block of text.) */ - -/* If a flag is specified, the resulting output */ -/* will consist of a flag, 1 space and formatted */ -/* output text. */ - -/* Unless the FLAG keyword appears, no flag is */ -/* used with the output. */ - -/* 'LEADER' is the keyword used to indicate that the left */ -/* margin of the output will always begin with */ -/* the word that follows LEADER. The leader */ -/* string will not appear on the FLAG line */ -/* if a FLAG is specified. The leader can */ -/* be placed on the FLAG line by simply making */ -/* it part of the flag. */ - -/* Unless the LEADER keyword appears, no leader is */ -/* used with the output. */ - -/* 'TRAILER' is the keyword used to indicate that the right */ -/* margin of the output will always end with */ -/* the word that follows TRAILER. The trailer */ -/* will appear in every line. */ - -/* The effect of using the keywords LEADER, TRAILER and FLAG */ -/* is to change the margins specified (or implied) through */ -/* the use of LEFT and RIGHT. The effective value of LEFT */ -/* will become LEFT + MAX ( LEN(LEADER), LEN(FLAG)+1 ). */ -/* The right margin becomes RIGHT - LEN(TRAILER). */ - - -/* 'LEFT' is the keyword used to indicate where the */ -/* left margin of the output text should appear */ -/* (either on the output screen or in a file). */ -/* Note if a FLAG is present, when displayed the */ -/* flag will start in this column of the output. */ -/* The remaining text will be indented one */ -/* more than the width of the nonblank portion of */ -/* the flag. If no flag is present, output will */ -/* begin in the specified LEFT column. */ - -/* The word that immediately follows LEFT must */ -/* successfully parse as an integer. */ - -/* If the LEFT keyword does not appear the left */ -/* margin is set to 1. */ - -/* 'RIGHT' is the keyword used to indicate where the */ -/* right margin of the output text should appear */ -/* (either on the output screen or in a file). */ - -/* The word that immediately follows RIGHT must */ -/* successfully parse as an integer. */ - -/* If the RIGHT keyword does not appear the right */ -/* margin is set to 80. */ - -/* 'NEWLINE' is the keyword used to indicate what substring */ -/* if any within the text string will be */ -/* intrepreted as meaning "start a new line" and */ -/* optionally "reset the margins." (See STRING */ -/* for details concerning the use of the newline */ -/* substring.) */ - -/* If the keyword NEWLINE is not present, no */ -/* substring of STRING will be interpreted as */ -/* directing a newline to be started. */ - -/* 'VTAB' is the keyword used to indicate what substring */ -/* within the text string will be interpreted */ -/* as meaning "start a new line, but indent it */ -/* to the current position within this line." */ -/* This is refered to as a vertical tab. */ - -/* If the keyword VTAB is not present no substring */ -/* of STRING will be interpreted as a vertical */ -/* tab. */ - -/* 'HARDSPACE' is the keyword used to indicate what character */ -/* within the text string will be processed as a */ -/* normal text character, but will be written out */ -/* as a space upon output. Note HARDSPACES in both */ -/* the FLAG and LEADER will converted into spaces */ -/* upon output. */ - -/* If the keyword HARDSPACE is not present, no */ -/* character will be interpreted as a hard space. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a keyword/value pair is entered more than once in */ -/* the style string, the last pair takes precedence. */ - -/* 2) If a keyword appears without a following value in the */ -/* style string the SPICE error 'SPICE(UNBALACEDPAIR)' is */ -/* signaled. */ - -/* 3) If a keyword is not recognized, the error 'SPICE(UNKNOWNKEY)' */ -/* is signaled */ - -/* 4) If one of the margin keywords (LEFT RIGHT) is not followed */ -/* by a numeric string, the error 'SPICE(NONNUMERICSTRING)' */ -/* is signaled. */ - -/* 5) If the left column becomes less than zero, or the right column */ -/* becomes less than the left column the error */ -/* 'SPICE(INVALIDCOLUMN)' is signaled. */ - -/* 6) If the number of columns from the left to the right margin */ -/* becomes less than or equal to the number of characters in the */ -/* flag (assuming one is specified) the error */ -/* 'SPICE(SPACETOONARROW)' is signaled. */ - -/* 7) If output cannot be performed, the error 'SPICE(OUTPUTERROR)' */ -/* will be signaled and a descriptive long message set to */ -/* aid in determining the cause of the output failure. */ - -/* 8) If the right margin exceeds 512, the output will be truncated */ -/* at column 512. */ - -/* $ Particulars */ - -/* This routine is designed to aid in the problem of creating */ -/* nice looking messages that must extend over 1 line. It */ -/* allows the user to construct messages by simply appending, */ -/* prefixing or inserting text into an existing string until */ -/* the message is finished. The user need not be concerned */ -/* about breaking up the message in good spots for output. */ -/* This routine searches the message in STRING for "good" places */ -/* at which to break STRING. */ - -/* The user may specify a "flag" that will be used to prefix the */ -/* first output line, left and right margins for the output, */ -/* and special strings for forcing creation of newlines, changing */ -/* margins, and inserting vertical tabs. */ - -/* This routine always sends to output a blank line prior to */ -/* the start of the output formatted string. */ - -/* Since strings are often built by concatenation, the user may */ -/* want to compress out extra spaces in string before calling */ -/* this routine. This routine breaks the input string at gaps */ -/* in the string, but does not get rid of large gaps within */ -/* a successfully broken output line. (See the examples below.) */ - -/* For a discussion of the string breaking algorithm see the */ -/* particulars section of the SPICE routine CUTSTR. */ - -/* $ Files */ - -/* The output is sent to the file or device connected to the logical */ -/* unit UNIT that has been appropriately prepared by the calling */ -/* program. */ - -/* $ Examples */ - -/* Suppose */ - -/* STYLE = 'LEFT 10 RIGHT 50 ' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Now is the time for all good men to come */ -/* the aid of their party. Out with the */ -/* bad air and in with the good. Health and */ -/* purity preserve our essence. */ - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 ' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: Now is the time for all good men */ -/* to come to the aid of their */ -/* party. Out with the bad air and */ -/* in with the good. Health and */ -/* purity preserve our essence. */ - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 NEWLINE .' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: Now is the time for all good men */ -/* to come to the aid of their */ -/* party */ -/* Out with the bad air and in with */ -/* the good */ -/* Health and purity preserve our */ -/* essence */ - - - - - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 VTAB . HARDSPACE _' */ -/* and */ - -/* STRING = '___ is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: is the time for all good men */ -/* to come to the aid of their */ -/* party */ -/* Out with the bad air and */ -/* in with the good */ -/* Health and */ -/* purity preserve our essence */ - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Error: LEFT 1 RIGHT 60 NEWLINE /cr VTAB /vt' */ - -/* and */ - -/* STRING = 'I believe the command you were attempting to enter'// */ -/* . 'was /cr/cr(5:5)FIND TIMES OF GREATEST ELONGATION ' // */ -/* . 'FOR VENUS /cr/cr(-5:-5) I was expecting to the ' // */ -/* . 'word GREATEST when I encountered the word GRETEST '// */ -/* . 'in your input command. /cr/cr(5:5) FIND TIMES OF ' // */ -/* . '/vt/vt GRETEST /vt/vt ELONGATION FOR VENUS ' // */ -/* . '/cr/cr(-5:-5) I think you left out the fourth ' // */ -/* . 'letter --- "A" . */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Error: I believe the command you were attempting to enter */ -/* was */ - -/* FIND TIMES OF GREATEST ELONGATION FOR VENUS */ - -/* I was expecting to see the word GREATEST when I */ -/* encountered the word GRETEST in your input command. */ - -/* FIND TIMES OF */ - -/* GRETEST */ - -/* ELONGATION FOR VENUS */ - -/* I think you left out the fourth letter --- "A" . */ - - -/* Some care should be taken when choosing substrings to indidicate */ -/* newline and vertical tab control. For example, suppose */ - -/* STYLE = ' FLAG NAIF: LEFT 6 RIGHT 56 NEWLINE xx VTAB AA ' */ - -/* and */ - -/* STRING = 'Officials at Exxon today reported a deal with the ' // */ -/* . 'Automobile Association of America (AAA) that would ' // */ -/* . 'provide club memebers with discount prices on ' // */ -/* . 'gasoline. xxxx( 3:3) Spokesmen said AA "Get your ' // */ -/* . 'AAA membership cards now." AA xx(-3:-3)xx Texeco ' // */ -/* . 'officials had no comment.' */ - - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* NAIF: Officials at E */ -/* on today reported a deal with the Automobile */ -/* Assosiation of America ( */ -/* A) that would provide */ -/* club members with discount prices on */ -/* gasoline. */ - -/* Spokesmen said */ -/* "Get your */ -/* A membership */ -/* cards now." */ - -/* Texeco officials had no comment. */ - - -/* $ Restrictions */ - -/* It is the responsibility of the calling program to properly */ -/* prepare the device/file associated with the logical unit UNIT */ -/* to receive the output from this routine. */ - -/* The RIGHT margin must be less than or equal to 512. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Support Version 1.1.0, 22-APR-1997 (WLT) */ - -/* Modified calls to SETMSG to use a marker and then replace */ -/* marker using ERRCH. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 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 */ - - -/* Beta Version 1.0.0, 12-AUG-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB Functions. */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NICEIO_3", (ftnlen)8); - } - -/* Set the defaults and initial values. */ - - -/* Set the defaults and initial values. */ - - left = 1; - right = 80; - flagtk = FALSE_; - leadtk = FALSE_; - hardsp = FALSE_; - nlintk = FALSE_; - trltk = FALSE_; - vtabtk = FALSE_; - *(unsigned char *)hspchr = ' '; - flagw = 0; - leadrw = 0; - trailw = 0; - prambw = 0; - vtabw = 0; - beg = 1; - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - *(unsigned char *)breaks = ' '; - -/* Parse the style string. */ - - fndnwd_(style, &beg, &b, &e, style_len); - while(b != 0) { - vbeg = e + 1; - fndnwd_(style, &vbeg, &vb, &ve, style_len); - if (vb != 0) { - if (s_cmp(style + (b - 1), "FLAG", e - (b - 1), (ftnlen)4) == 0) { - flagb = vb; - flage = ve; - flagw = ve - vb + 2; - flagtk = TRUE_; - } else if (s_cmp(style + (b - 1), "LEADER", e - (b - 1), (ftnlen) - 6) == 0) { - leadrb = vb; - leadre = ve; - leadrw = ve - vb + 1; - leadtk = TRUE_; - } else if (s_cmp(style + (b - 1), "TRAILER", e - (b - 1), (ftnlen) - 7) == 0) { - trailb = vb; - traile = ve; - trailw = ve - vb + 1; - trltk = TRUE_; - } else if (s_cmp(style + (b - 1), "VTAB", e - (b - 1), (ftnlen)4) - == 0) { - vtabb = vb; - vtabe = ve; - vtabw = ve - vb + 1; - vtabtk = TRUE_; - } else if (s_cmp(style + (b - 1), "NEWLINE", e - (b - 1), (ftnlen) - 7) == 0) { - nlinb = vb; - nline = ve; - nlinew = ve - vb + 1; - nlintk = TRUE_; - } else if (s_cmp(style + (b - 1), "LEFT", e - (b - 1), (ftnlen)4) - == 0) { - nparsi_(style + (vb - 1), &left, errorl, &k, ve - (vb - 1), ( - ftnlen)160); - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) != 0) { - setmsg_("The word following the keyword 'LEFT' must pars" - "e as an integer. # ", (ftnlen)66); - errch_("#", errorl, (ftnlen)1, (ftnlen)160); - sigerr_("SPICE(NONNUMERICSTRING)", (ftnlen)23); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - } else if (s_cmp(style + (b - 1), "RIGHT", e - (b - 1), (ftnlen)5) - == 0) { - nparsi_(style + (vb - 1), &right, errorr, &k, ve - (vb - 1), ( - ftnlen)160); - if (s_cmp(errorr, " ", (ftnlen)160, (ftnlen)1) != 0) { - setmsg_("The word following the keyword 'RIGHT' must par" - "se as an integer. #", (ftnlen)66); - errch_("#", errorl, (ftnlen)1, (ftnlen)160); - sigerr_("SPICE(NONNUMERICSTRING)", (ftnlen)23); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - } else if (s_cmp(style + (b - 1), "HARDSPACE", e - (b - 1), ( - ftnlen)9) == 0) { - hardsp = TRUE_; - if (vb != ve) { - setmsg_("Hardspaces must be a single character. You hav" - "e \"#\".", (ftnlen)53); - errch_("#", style + (vb - 1), (ftnlen)1, ve - (vb - 1)); - sigerr_("SPICE(BADHARDSPACE)", (ftnlen)19); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } else { - *(unsigned char *)hspchr = *(unsigned char *)&style[vb - - 1]; - } - } else { - s_copy(line, style + (b - 1), (ftnlen)512, e - (b - 1)); - suffix_("is not a recognized keyword for the SPICELIB routin" - "e NICEIO. ", &c__1, line, (ftnlen)61, (ftnlen)512); - setmsg_(line, (ftnlen)512); - sigerr_("SPICE(UNKNOWNKEY)", (ftnlen)17); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - beg = ve + 1; - fndnwd_(style, &beg, &b, &e, style_len); - } else { - setmsg_("# did not have an associated value", (ftnlen)34); - errch_("#", style + (b - 1), (ftnlen)1, e - (b - 1)); - sigerr_("SPICE(UNBALANCEDPAIR)", (ftnlen)21); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - } - -/* So ends the parsing of the style string. Now do the actual work. */ - - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - -/* Determine how much space needs to be allocated for the */ -/* flag and leaders. */ - - origr = right; - origl = left; - rmarg = right; - prambw = max(flagw,leadrw); - pstamb = right - trailw + 1; - right -= trailw; - if (flagw > 0) { - s_copy(line + (origl - 1), style + (flagb - 1), 512 - (origl - 1), - flage - (flagb - 1)); - } else if (leadrw > 0) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - 1), - leadre - (leadrb - 1)); - } - if (trailw > 0) { - s_copy(line + (pstamb - 1), style + (trailb - 1), origr - (pstamb - 1) - , traile - (trailb - 1)); - } -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(string, string_len); - b = max(i__1,i__2); - last = qlstnb_(string, string_len); - -/* If there is a newline token, we have to write out empty lines */ -/* and modify the margins as we encounter newline tokens and */ -/* newline tokens with margin modifiers. Typically the loop */ -/* in the if block below will never be exercised. */ - - if (nlintk) { - e = b + nlinew - 1; - if (e < last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - 1), - nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - while(newlin) { - -/* See if the new line token is qualified so as to change */ -/* the margins of the output. */ - - if (e + 1 < last) { - i__1 = e; - mrgchg = match_(string + i__1, "(*:*)*", string_len - i__1, ( - ftnlen)6); - } else { - mrgchg = FALSE_; - } - if (mrgchg) { - -/* Looks like we should change the columns. Locate the */ -/* tokens of the newline marker. */ - - i__1 = e + 1; - fndntk_(string, "(:", &i__1, &leftb, &lefte, string_len, ( - ftnlen)2); - fndntk_(string, ":)", &lefte, &rightb, &righte, string_len, ( - ftnlen)2); - -/* Parse the strings representing the increments to left */ -/* and right column positions. */ - - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - if (leftb <= lefte) { - nparsi_(string + (leftb - 1), &nleft, errorl, &k, lefte - - (leftb - 1), (ftnlen)160); - } else { - nleft = 0; - } - if (rightb <= righte) { - nparsi_(string + (rightb - 1), &nright, errorr, &k, - righte - (rightb - 1), (ftnlen)160); - } else { - nright = 0; - } - -/* Only if no errors were encountered during parsing do we */ -/* change the columns. */ - - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) == 0 && s_cmp( - errorr, " ", (ftnlen)160, (ftnlen)1) == 0) { - b = righte + 2; - left += nleft; - right -= nright; - rmarg = max(origr,right); - } else { - b += nlinew; - } - } else { - b += nlinew; - } - -/* Check for goofy margins. */ - - if (left < 1) { - setmsg_("The current value for the left column is #. This is" - " less than 1 and thus not a valid value. ", (ftnlen) - 92); - errint_("#", &left, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } else if (left > right) { - setmsg_("The current value for the left column is greater th" - "an the value for the right column. The value for the" - " left column is #. The value for the right column i" - "s #. ", (ftnlen)160); - errint_("#", &left, (ftnlen)1); - errint_("#", &right, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - -/* Output something, but first replace hard spaces by spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, (ftnlen)1, - rmarg); - } - writln_(line, unit, rmarg); - if (failed_()) { - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - ( - pstamb - 1), traile - (trailb - 1)); - } - -/* Adjust the beginning and ending of the next portion */ -/* of the string to examine. */ - -/* Computing MAX */ - i__1 = b, i__2 = ncpos_(string, " ", &b, string_len, (ftnlen)1); - b = max(i__1,i__2); - e = b + nlinew - 1; - if (e < last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - } - -/* Find the next portion of the string to examine (it's up to */ -/* the next new line token or end of string whichever */ -/* comes first. */ - - e = upto_(string, style + (nlinb - 1), &b, string_len, nline - (nlinb - - 1)); - } else { - e = last; - } - -/* Now we have are to the point of processing legitimate text. */ -/* Process the current substring STRING(B:E). It contains */ -/* no newline tokens. */ - - while(e != 0) { - width = right - left + 1 - prambw; - if (width < 1) { - sigerr_("SPICE(SPACETOONARROW)", (ftnlen)21); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - w = width; - start = b; - indent = 0; - -/* Grab the biggest piece of the substring that can be output */ -/* within the allowed space. */ - - cutstr_(string, &start, &w, breaks, &beg, &end, e, (ftnlen)1); - while(beg != 0) { - -/* See if there are any vertical tab marks */ - - if (! vtabtk) { - i__1 = left + prambw - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, end - ( - beg - 1)); - } else { - vtabat = pos_(string, style + (vtabb - 1), &start, e, vtabe - - (vtabb - 1)); - if (vtabat > 0 && vtabat <= end) { - -/* If there is a vertical tab at the beginning of the */ -/* string, we don't need to modify LINE. */ - - if (vtabat > beg) { - end = vtabat - 1; - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, - end - (beg - 1)); - indent = indent + end - beg + 1; - end = end + vtabe - vtabb + 1; - } else if (vtabat == beg) { - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, " ", right - i__1, (ftnlen)1); - end = beg + vtabe - vtabb; - } - } else { - -/* We just fill out the rest of this line. There will */ -/* be no need to indent the next one. */ - - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, end - - (beg - 1)); - indent = 0; - } - } - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, (ftnlen)1, - rmarg); - } - writln_(line, unit, rmarg); - if (failed_()) { - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - ( - pstamb - 1), traile - (trailb - 1)); - } - start = end + 1; - w = width - indent; - if (w < 3) { - w = width; - indent = 0; - } - cutstr_(string, &start, &w, breaks, &beg, &end, e, (ftnlen)1); - } - -/* Check to see if we should be looking for a newline token. */ - - if (nlintk) { - -/* Ok. Get ready to jump through hoops again. We have to */ -/* look for newline tokens, for all those in excess of one */ -/* in a row, we have to output a blank line. */ - - b = e + 1; - e += nlinew; - looped = FALSE_; - if (e <= last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - while(newlin) { - lright = right; - -/* See if the new line token is qualified so as to change */ -/* the margins of the output. */ - - if (e >= last) { - -/* In this case we can't possibly match as in the case */ -/* below */ - - b += nlinew; - } else /* if(complicated condition) */ { - i__1 = e; - if (match_(string + i__1, "(*:*)*", string_len - i__1, ( - ftnlen)6)) { - -/* Looks like we should change the columns. Locate the */ -/* tokens of the newline marker. */ - - fndntk_(string, "(:", &e, &leftb, &lefte, string_len, - (ftnlen)2); - fndntk_(string, ":)", &lefte, &rightb, &righte, - string_len, (ftnlen)2); - -/* Parse the strings representing the increments to left */ -/* and right column positions. */ - - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - if (leftb <= lefte) { - nparsi_(string + (leftb - 1), &nleft, errorl, &k, - lefte - (leftb - 1), (ftnlen)160); - } else { - nleft = 0; - } - if (rightb <= righte) { - nparsi_(string + (rightb - 1), &nright, errorr, & - k, righte - (rightb - 1), (ftnlen)160); - } else { - nright = 0; - } - -/* Only if no errors were encountered during parsing */ -/* do we change the columns. */ - - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) == 0 && - s_cmp(errorr, " ", (ftnlen)160, (ftnlen)1) == - 0) { - b = righte + 2; - left += nleft; - right -= nright; - rmarg = max(origr,right); - } else { - b += nlinew; - } - } else { - b += nlinew; - } - } - -/* Take care of the case when outdenting or indenting has */ -/* forced us into absurd margins. */ - - if (left < 1) { - setmsg_("The current value for the left column is #. Thi" - "s is less than 1 and thus not a valid value. ", ( - ftnlen)92); - errint_("#", &left, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } else if (left > right) { - setmsg_("The current value for the left column is greate" - "r than the value for the right column. The value" - " for the left column is #. The value for the ri" - "ght column is #. ", (ftnlen)160); - errint_("#", &left, (ftnlen)1); - errint_("#", &right, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - -/* Output something if this is not the first pass through */ -/* the loop. */ - - if (! looped) { - looped = TRUE_; - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - - (origl - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - - (pstamb - 1), traile - (trailb - 1)); - } - } else { - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, ( - ftnlen)1, rmarg); - } - writln_(line, unit, rmarg); - if (failed_()) { - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - } -/* Computing MAX */ - i__1 = b, i__2 = ncpos_(string, " ", &b, string_len, (ftnlen) - 1); - b = max(i__1,i__2); - e = b + nlinew - 1; - if (e <= last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - - (b - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - } - e = upto_(string, style + (nlinb - 1), &b, string_len, nline - ( - nlinb - 1)); - -/* Just in case we went through the loop, and didn't */ -/* output a line, and we've reached the end of the */ -/* string. We check and write a blank line if necessary */ - - if (looped && e == 0) { - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, ( - ftnlen)1, rmarg); - } - writln_(line, unit, rmarg); - if (failed_()) { - chkout_("NICEIO_3", (ftnlen)8); - return 0; - } - } - } else { - e = 0; - } - } - chkout_("NICEIO_3", (ftnlen)8); - return 0; -} /* niceio_3__ */ - diff --git a/ext/spice/src/csupport/nicepr_1.c b/ext/spice/src/csupport/nicepr_1.c deleted file mode 100644 index 67a136730c..0000000000 --- a/ext/spice/src/csupport/nicepr_1.c +++ /dev/null @@ -1,1121 +0,0 @@ -/* nicepr_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure NICEPR_1 ( Nicely printed output -- test version ) */ -/* Subroutine */ int nicepr_1__(char *string, char *style, S_fp myio, ftnlen - string_len, ftnlen style_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer vbeg; - char line[512]; - integer left, last; - extern integer upto_(char *, char *, integer *, ftnlen, ftnlen); - integer b, e, flagb, k, flage, w; - extern logical match_(char *, char *, ftnlen, ftnlen); - integer leftb, vtabb, lefte, flagw, vtabe, nlinb; - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer nline, nleft, rmarg, origl, right, width; - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - integer vtabw, origr, start; - logical trltk; - integer vb, leadrb, ve, leadre; - logical leadtk; - char breaks[1]; - logical flagtk, mrgchg; - integer trailb, leadrw, rightb, traile; - logical hardsp; - integer righte, vtabat, indent; - logical looped; - integer pstamb; - char hspchr[1]; - integer prambw, lright; - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - logical vtabtk; - integer nlinew, nright; - extern integer frstnb_(char *, ftnlen); - logical nlintk, newlin; - extern /* Subroutine */ int nparsi_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - integer trailw; - extern integer qlstnb_(char *, ftnlen); - extern /* Subroutine */ int setmsg_(char *, ftnlen); - char errorl[160]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen), - fndntk_(char *, char *, integer *, integer *, integer *, ftnlen, - ftnlen); - char errorr[160]; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), replch_( - char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int cutstr_(char *, integer *, integer *, char *, - integer *, integer *, ftnlen, ftnlen); - integer beg, end; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Output a string to a unit using one of a set of available styles. */ -/* Format and output a string so that it has a pleasing appearance */ -/* (breaks for newlines occurring at natural places, margins set at */ -/* desired levels, etc.) */ - -/* $ 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. */ - -/* $ Keywords */ - -/* STRING */ -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* STRING I Message to be printed. */ -/* STYLE I Format specification string. */ -/* MYIO I A routine that handles output */ - -/* $ Detailed_Input */ - -/* STRING A long string to be broken into columns and output. */ -/* If desired, the user can force various changes to the */ -/* format of the output by inserting control substrings */ -/* into the desired text, and specifying these control */ -/* strings in the character string STYLE. */ - -/* Three control functions are possible. They are: */ - -/* 1) Force a newline. */ -/* 2) Force a newline and alter the margins for output. */ -/* 3) Insert a vertical tab in the output. */ - -/* To force a new line at some location of the string */ -/* during output you must put the KEYWORD 'NEWLINE' */ -/* into the string STYLE followed by a word that will */ -/* be used to signal a linebreak. For example you */ -/* might use ' NEWLINE /cr '. At any point of the */ -/* string that a newline is desired, insert the string */ -/* associated with the NEWLINE keyword ( in this case */ -/* '/cr' ). Spaces are not required around the NEWLINE */ -/* control string (or any other control string). */ - -/* To modify the margins after a line break, you insert */ -/* the line break control string into STRING and insert */ -/* immediately after it a string of the form (x:y) where */ -/* x and y are numeric strings. The number x indicates */ -/* that the left margin should be moved x to the right. */ -/* The number y indicates the right margin should be */ -/* moved y to the left. Both negative and positive */ -/* values are allowed. Spaces are allowed within the */ -/* spaces between parentheses. In keeping with our */ -/* previous example both */ - -/* '/cr(5:-2)' and '/cr( 5 : -2 )' */ - -/* directs the routine to force an line break; move the */ -/* left margin 5 to the right; move the right margin */ -/* -2 to the left (.i.e. 2 to the right). */ - -/* /cr (5: -2) */ - -/* would be treated as simply a new line directive, the */ -/* remainder (5: -2) is treated as part of the string */ -/* to output. */ - -/* To force a vertical tab at any point of the string */ -/* you must specify a vertical tab control string in */ -/* the style string. Then at the point in string */ -/* where you want a vertical tab to appear, simply insert */ -/* the vertical tab string, spaces are NOT required */ -/* around the vertical tab string. */ - -/* All control substrings in STRING are treated as having */ -/* zero width and invisible to output. */ - -/* MYIO Is a routine that takes a single string as input and */ -/* appropriately outputs the string. It should be declared */ -/* external in the calling routine. */ - -/* STYLE is a character string that controls how the string */ -/* should be formatted on output and what substrings */ -/* of STRING will be treated as control characters */ -/* for display of STRING. STYLE should consist of */ -/* a sequence of keyword/value word pairs. That is, */ -/* it should consist of a sequence of words ( according */ -/* to the SPICE definition of a word ) in a pattern */ -/* as illustrated here: */ - -/* Keyword_1 Value_1 Keyword_2 Value_2 ... Keyword_n Value_n */ - -/* Acceptable keywords, their meanings, and expectations */ -/* regarding their associate values are spelled at below. */ - -/* 'FLAG' is a keyword used to indicate that a string */ -/* will prefix the output of STRING. Moreover */ -/* STRING will be printed in a block that is */ -/* indented by one more than the nonblank length */ -/* of the FLAG. (The appearance will parallel what */ -/* you see here in this description, where 'FLAG' */ -/* is the flag associated with this block of text.) */ - -/* If a flag is specified, the resulting output */ -/* will consist of a flag, 1 space and formatted */ -/* output text. */ - -/* Unless the FLAG keyword appears, no flag is */ -/* used with the output. */ - -/* 'LEADER' is the keyword used to indicate that the left */ -/* margin of the output will always begin with */ -/* the word that follows LEADER. The leader */ -/* string will not appear on the FLAG line */ -/* if a FLAG is specified. The leader can */ -/* be placed on the FLAG line by simply making */ -/* it part of the flag. */ - -/* Unless the LEADER keyword appears, no leader is */ -/* used with the output. */ - -/* 'TRAILER' is the keyword used to indicate that the right */ -/* margin of the output will always end with */ -/* the word that follows TRAILER. The trailer */ -/* will appear in every line. */ - -/* The effect of using the keywords LEADER, TRAILER and FLAG */ -/* is to change the margins specified (or implied) through */ -/* the use of LEFT and RIGHT. The effective value of LEFT */ -/* will become LEFT + MAX ( LEN(LEADER), LEN(FLAG)+1 ). */ -/* The right margin becomes RIGHT - LEN(TRAILER). */ - - -/* 'LEFT' is the keyword used to indicate where the */ -/* left margin of the output text should appear */ -/* (either on the output screen or in a file). */ -/* Note if a FLAG is present, when displayed the */ -/* flag will start in this column of the output. */ -/* The remaining text will be indented one */ -/* more than the width of the nonblank portion of */ -/* the flag. If no flag is present, output will */ -/* begin in the specified LEFT column. */ - -/* The word that immediately follows LEFT must */ -/* successfully parse as an integer. */ - -/* If the LEFT keyword does not appear the left */ -/* margin is set to 1. */ - -/* 'RIGHT' is the keyword used to indicate where the */ -/* right margin of the output text should appear */ -/* (either on the output screen or in a file). */ - -/* The word that immediately follows RIGHT must */ -/* successfully parse as an integer. */ - -/* If the RIGHT keyword does not appear the right */ -/* margin is set to 80. */ - -/* 'NEWLINE' is the keyword used to indicate what substring */ -/* if any within the text string will be */ -/* intrepreted as meaning "start a new line" and */ -/* optionally "reset the margins." (See STRING */ -/* for details concerning the use of the newline */ -/* substring.) */ - -/* If the keyword NEWLINE is not present, no */ -/* substring of STRING will be interpreted as */ -/* directing a newline to be started. */ - -/* 'VTAB' is the keyword used to indicate what substring */ -/* within the text string will be interpreted */ -/* as meaning "start a new line, but indent it */ -/* to the current position within this line." */ -/* This is refered to as a vertical tab. */ - -/* If the keyword VTAB is not present no substring */ -/* of STRING will be interpreted as a vertical */ -/* tab. */ - -/* 'HARDSPACE' is the keyword used to indicate what character */ -/* within the text string will be processed as a */ -/* normal text character, but will be written out */ -/* as a space upon output. Note HARDSPACES in both */ -/* the FLAG and LEADER will converted into spaces */ -/* upon output. */ - -/* If the keyword HARDSPACE is not present, no */ -/* character will be interpreted as a hard space. */ - -/* MYIO Is a routine that takes a single string as input and */ -/* appropriately outputs the string. It should be declared */ -/* external in the calling routine. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If a keyword/value pair is entered more than once in */ -/* the style string, the last pair takes precedence. */ - -/* 2) If a keyword appears without a following value in the */ -/* style string the SPICE error 'SPICE(UNBALACEDPAIR)' is */ -/* signaled. */ - -/* 3) If a keyword is not recognized, the error 'SPICE(UNKNOWNKEY)' */ -/* is signaled */ - -/* 4) If one of the margin keywords (LEFT RIGHT) is not followed */ -/* by a numeric string, the error 'SPICE(NONNUMERICSTRING)' */ -/* is signaled. */ - -/* 5) If the left column becomes less than zero, or the right column */ -/* becomes less than the left column the error */ -/* 'SPICE(INVALIDCOLUMN)' is signaled. */ - -/* 6) If the number of columns from the left to the right margin */ -/* becomes less than or equal to the number of characters in the */ -/* flag (assuming one is specified) the error */ -/* 'SPICE(SPACETOONARROW)' is signaled. */ - -/* 7) If output cannot be performed, the error 'SPICE(OUTPUTERROR)' */ -/* will be signaled and a descriptive long message set to */ -/* aid in determining the cause of the output failure. */ - -/* 8) If the right margin exceeds 512, the output will be truncated */ -/* at column 512. */ - -/* $ Particulars */ - -/* This routine is designed to aid in the problem of creating */ -/* nice looking messages that must extend over 1 line. It */ -/* allows the user to construct messages by simply appending, */ -/* prefixing or inserting text into an existing string until */ -/* the message is finished. The user need not be concerned */ -/* about breaking up the message in good spots for output. */ -/* This routine searches the message in STRING for "good" places */ -/* at which to break STRING. */ - -/* The user may specify a "flag" that will be used to prefix the */ -/* first output line, left and right margins for the output, */ -/* and special strings for forcing creation of newlines, changing */ -/* margins, and inserting vertical tabs. */ - -/* This routine always sends to output a blank line prior to */ -/* the start of the output formatted string. */ - -/* Since strings are often built by concatenation, the user may */ -/* want to compress out extra spaces in string before calling */ -/* this routine. This routine breaks the input string at gaps */ -/* in the string, but does not get rid of large gaps within */ -/* a successfully broken output line. (See the examples below.) */ - -/* For a discussion of the string breaking algorithm see the */ -/* particulars section of the SPICE routine CUTSTR. */ - -/* $ Files */ - -/* The output is sent to the file or device connected to the logical */ -/* unit UNIT that has been appropriately prepared by the calling */ -/* program. */ - -/* $ Examples */ - -/* Suppose */ - -/* STYLE = 'LEFT 10 RIGHT 50 ' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Now is the time for all good men to come */ -/* the aid of their party. Out with the */ -/* bad air and in with the good. Health and */ -/* purity preserve our essence. */ - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 ' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: Now is the time for all good men */ -/* to come to the aid of their */ -/* party. Out with the bad air and */ -/* in with the good. Health and */ -/* purity preserve our essence. */ - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 NEWLINE .' */ -/* and */ - -/* STRING = 'Now is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: Now is the time for all good men */ -/* to come to the aid of their */ -/* party */ -/* Out with the bad air and in with */ -/* the good */ -/* Health and purity preserve our */ -/* essence */ - - - - - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Example: LEFT 10 RIGHT 50 VTAB . HARDSPACE _' */ -/* and */ - -/* STRING = '___ is the time for all good men to come to ' // */ -/* . 'the aid of their party. Out with the bad ' // */ -/* . 'air and in with the good. Health and purity '// */ -/* . 'preserve our essence. ' */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Example: is the time for all good men */ -/* to come to the aid of their */ -/* party */ -/* Out with the bad air and */ -/* in with the good */ -/* Health and */ -/* purity preserve our essence */ - - - - - -/* Suppose */ - -/* STYLE = 'FLAG Error: LEFT 1 RIGHT 60 NEWLINE /cr VTAB /vt' */ - -/* and */ - -/* STRING = 'I believe the command you were attempting to enter'// */ -/* . 'was /cr/cr(5:5)FIND TIMES OF GREATEST ELONGATION ' // */ -/* . 'FOR VENUS /cr/cr(-5:-5) I was expecting to the ' // */ -/* . 'word GREATEST when I encountered the word GRETEST '// */ -/* . 'in your input command. /cr/cr(5:5) FIND TIMES OF ' // */ -/* . '/vt/vt GRETEST /vt/vt ELONGATION FOR VENUS ' // */ -/* . '/cr/cr(-5:-5) I think you left out the fourth ' // */ -/* . 'letter --- "A" . */ - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* Error: I believe the command you were attempting to enter */ -/* was */ - -/* FIND TIMES OF GREATEST ELONGATION FOR VENUS */ - -/* I was expecting to see the word GREATEST when I */ -/* encountered the word GRETEST in your input command. */ - -/* FIND TIMES OF */ - -/* GRETEST */ - -/* ELONGATION FOR VENUS */ - -/* I think you left out the fourth letter --- "A" . */ - - -/* Some care should be taken when choosing substrings to indidicate */ -/* newline and vertical tab control. For example, suppose */ - -/* STYLE = ' FLAG NAIF: LEFT 6 RIGHT 56 NEWLINE xx VTAB AA ' */ - -/* and */ - -/* STRING = 'Officials at Exxon today reported a deal with the ' // */ -/* . 'Automobile Association of America (AAA) that would ' // */ -/* . 'provide club memebers with discount prices on ' // */ -/* . 'gasoline. xxxx( 3:3) Spokesmen said AA "Get your ' // */ -/* . 'AAA membership cards now." AA xx(-3:-3)xx Texeco ' // */ -/* . 'officials had no comment.' */ - - -/* The the output would look like: */ - -/* Column */ -/* 1........10........20........30........40........50........60 */ - -/* NAIF: Officials at E */ -/* on today reported a deal with the Automobile */ -/* Assosiation of America ( */ -/* A) that would provide */ -/* club members with discount prices on */ -/* gasoline. */ - -/* Spokesmen said */ -/* "Get your */ -/* A membership */ -/* cards now." */ - -/* Texeco officials had no comment. */ - - -/* $ Restrictions */ - -/* It is the responsibility of the calling program to properly */ -/* prepare the device/file associated with the logical unit UNIT */ -/* to receive the output from this routine. */ - -/* The RIGHT margin must be less than or equal to 512. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Support Version 1.1.0, 22-APR-1997 (WLT) */ - -/* Modified calls to SETMSG to use a marker and then replace */ -/* marker using ERRCH. */ - -/* - Test Utility Version 2.0.0, 7-APR-1995 (WLT) */ - -/* The routine was updated to fixed DO WHILE loop problems */ -/* caused by accessing characters past the end of the string. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* Beta Version 1.0.0, 12-AUG-1988 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB Functions. */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NICEPR_1", (ftnlen)8); - } - -/* Set the defaults and initial values. */ - - -/* Set the defaults and initial values. */ - - left = 1; - right = 80; - flagtk = FALSE_; - leadtk = FALSE_; - hardsp = FALSE_; - nlintk = FALSE_; - trltk = FALSE_; - vtabtk = FALSE_; - *(unsigned char *)hspchr = ' '; - flagw = 0; - leadrw = 0; - trailw = 0; - prambw = 0; - vtabw = 0; - beg = 1; - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - *(unsigned char *)breaks = ' '; - -/* Parse the style string. */ - - fndnwd_(style, &beg, &b, &e, style_len); - while(b != 0) { - vbeg = e + 1; - fndnwd_(style, &vbeg, &vb, &ve, style_len); - if (vb != 0) { - if (s_cmp(style + (b - 1), "FLAG", e - (b - 1), (ftnlen)4) == 0) { - flagb = vb; - flage = ve; - flagw = ve - vb + 2; - flagtk = TRUE_; - } else if (s_cmp(style + (b - 1), "LEADER", e - (b - 1), (ftnlen) - 6) == 0) { - leadrb = vb; - leadre = ve; - leadrw = ve - vb + 1; - leadtk = TRUE_; - } else if (s_cmp(style + (b - 1), "TRAILER", e - (b - 1), (ftnlen) - 7) == 0) { - trailb = vb; - traile = ve; - trailw = ve - vb + 1; - trltk = TRUE_; - } else if (s_cmp(style + (b - 1), "VTAB", e - (b - 1), (ftnlen)4) - == 0) { - vtabb = vb; - vtabe = ve; - vtabw = ve - vb + 1; - vtabtk = TRUE_; - } else if (s_cmp(style + (b - 1), "NEWLINE", e - (b - 1), (ftnlen) - 7) == 0) { - nlinb = vb; - nline = ve; - nlinew = ve - vb + 1; - nlintk = TRUE_; - } else if (s_cmp(style + (b - 1), "LEFT", e - (b - 1), (ftnlen)4) - == 0) { - nparsi_(style + (vb - 1), &left, errorl, &k, ve - (vb - 1), ( - ftnlen)160); - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) != 0) { - setmsg_("The word following the keyword 'LEFT' must pars" - "e as an integer. #", (ftnlen)65); - errch_("#", errorl, (ftnlen)1, (ftnlen)160); - sigerr_("SPICE(NONNUMERICSTRING)", (ftnlen)23); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - } else if (s_cmp(style + (b - 1), "RIGHT", e - (b - 1), (ftnlen)5) - == 0) { - nparsi_(style + (vb - 1), &right, errorr, &k, ve - (vb - 1), ( - ftnlen)160); - if (s_cmp(errorr, " ", (ftnlen)160, (ftnlen)1) != 0) { - setmsg_("The word following the keyword 'RIGHT' must par" - "se as an integer. #", (ftnlen)66); - errch_("#", errorr, (ftnlen)1, (ftnlen)160); - sigerr_("SPICE(NONNUMERICSTRING)", (ftnlen)23); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - } else if (s_cmp(style + (b - 1), "HARDSPACE", e - (b - 1), ( - ftnlen)9) == 0) { - hardsp = TRUE_; - if (vb != ve) { - setmsg_("Hardspaces must be a single character. You hav" - "e \"#\".", (ftnlen)53); - errch_("#", style + (vb - 1), (ftnlen)1, ve - (vb - 1)); - sigerr_("SPICE(BADHARDSPACE)", (ftnlen)19); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } else { - *(unsigned char *)hspchr = *(unsigned char *)&style[vb - - 1]; - } - } else { - s_copy(line, style + (b - 1), (ftnlen)512, e - (b - 1)); - suffix_("is not a recognized keyword for the SPICELIB routin" - "e NICEIO. ", &c__1, line, (ftnlen)61, (ftnlen)512); - setmsg_(line, (ftnlen)512); - sigerr_("SPICE(UNKNOWNKEY)", (ftnlen)17); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - beg = ve + 1; - fndnwd_(style, &beg, &b, &e, style_len); - } else { - setmsg_("# did not have an associated value", (ftnlen)34); - errch_("#", style + (b - 1), (ftnlen)1, e - (b - 1)); - sigerr_("SPICE(UNBALANCEDPAIR)", (ftnlen)21); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - } - -/* So ends the parsing of the style string. Now do the actual work. */ - - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - -/* Determine how much space needs to be allocated for the */ -/* flag and leaders. */ - - origr = right; - origl = left; - rmarg = right; - prambw = max(flagw,leadrw); - pstamb = right - trailw + 1; - right -= trailw; - if (flagw > 0) { - s_copy(line + (origl - 1), style + (flagb - 1), 512 - (origl - 1), - flage - (flagb - 1)); - } else if (leadrw > 0) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - 1), - leadre - (leadrb - 1)); - } - if (trailw > 0) { - s_copy(line + (pstamb - 1), style + (trailb - 1), origr - (pstamb - 1) - , traile - (trailb - 1)); - } -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(string, string_len); - b = max(i__1,i__2); - last = qlstnb_(string, string_len); - -/* If there is a newline token, we have to write out empty lines */ -/* and modify the margins as we encounter newline tokens and */ -/* newline tokens with margin modifiers. Typically the loop */ -/* in the if block below will never be exercised. */ - - if (nlintk) { - e = b + nlinew - 1; - if (e < last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - 1), - nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - while(newlin) { - -/* See if the new line token is qualified so as to change */ -/* the margins of the output. */ - - if (e + 1 < last) { - i__1 = e; - mrgchg = match_(string + i__1, "(*:*)*", string_len - i__1, ( - ftnlen)6); - } else { - mrgchg = FALSE_; - } - if (mrgchg) { - -/* Looks like we should change the columns. Locate the */ -/* tokens of the newline marker. */ - - i__1 = e + 1; - fndntk_(string, "(:", &i__1, &leftb, &lefte, string_len, ( - ftnlen)2); - fndntk_(string, ":)", &lefte, &rightb, &righte, string_len, ( - ftnlen)2); - -/* Parse the strings representing the increments to left */ -/* and right column positions. */ - - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - if (leftb <= lefte) { - nparsi_(string + (leftb - 1), &nleft, errorl, &k, lefte - - (leftb - 1), (ftnlen)160); - } else { - nleft = 0; - } - if (rightb <= righte) { - nparsi_(string + (rightb - 1), &nright, errorr, &k, - righte - (rightb - 1), (ftnlen)160); - } else { - nright = 0; - } - -/* Only if no errors were encountered during parsing do we */ -/* change the columns. */ - - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) == 0 && s_cmp( - errorr, " ", (ftnlen)160, (ftnlen)1) == 0) { - b = righte + 2; - left += nleft; - right -= nright; - rmarg = max(origr,right); - } else { - b += nlinew; - } - } else { - b += nlinew; - } - -/* Check for goofy margins. */ - - if (left < 1) { - setmsg_("The current value for the left column is #. This is" - " less than 1 and thus not a valid value. ", (ftnlen) - 92); - errint_("#", &left, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } else if (left > right) { - setmsg_("The current value for the left column is greater th" - "an the value for the right column. The value for the" - " left column is #. The value for the right column i" - "s #. ", (ftnlen)160); - errint_("#", &left, (ftnlen)1); - errint_("#", &right, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - -/* Output something, but first replace hard spaces by spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, (ftnlen)1, - rmarg); - } - (*myio)(line, rmarg); - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - ( - pstamb - 1), traile - (trailb - 1)); - } - -/* Adjust the beginning and ending of the next portion */ -/* of the string to examine. */ - -/* Computing MAX */ - i__1 = b, i__2 = ncpos_(string, " ", &b, string_len, (ftnlen)1); - b = max(i__1,i__2); - e = b + nlinew - 1; - if (e < last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - } - -/* Find the next portion of the string to examine (it's up to */ -/* the next new line token or end of string whichever */ -/* comes first. */ - - e = upto_(string, style + (nlinb - 1), &b, string_len, nline - (nlinb - - 1)); - } else { - e = last; - } - -/* Now we have are to the point of processing legitimate text. */ -/* Process the current substring STRING(B:E). It contains */ -/* no newline tokens. */ - - while(e != 0) { - width = right - left + 1 - prambw; - if (width < 1) { - sigerr_("SPICE(SPACETOONARROW)", (ftnlen)21); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - w = width; - start = b; - indent = 0; - -/* Grab the biggest piece of the substring that can be output */ -/* within the allowed space. */ - - cutstr_(string, &start, &w, breaks, &beg, &end, e, (ftnlen)1); - while(beg != 0) { - -/* See if there are any vertical tab marks */ - - if (! vtabtk) { - i__1 = left + prambw - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, end - ( - beg - 1)); - } else { - vtabat = pos_(string, style + (vtabb - 1), &start, e, vtabe - - (vtabb - 1)); - if (vtabat > 0 && vtabat <= end) { - -/* If there is a vertical tab at the beginning of the */ -/* string, we don't need to modify LINE. */ - - if (vtabat > beg) { - end = vtabat - 1; - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, - end - (beg - 1)); - indent = indent + end - beg + 1; - end = end + vtabe - vtabb + 1; - } else if (vtabat == beg) { - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, " ", right - i__1, (ftnlen)1); - end = beg + vtabe - vtabb; - } - } else { - -/* We just fill out the rest of this line. There will */ -/* be no need to indent the next one. */ - - i__1 = left + prambw + indent - 1; - s_copy(line + i__1, string + (beg - 1), right - i__1, end - - (beg - 1)); - indent = 0; - } - } - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, (ftnlen)1, - rmarg); - } - (*myio)(line, rmarg); - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - (origl - - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - ( - pstamb - 1), traile - (trailb - 1)); - } - start = end + 1; - w = width - indent; - if (w < 3) { - w = width; - } - cutstr_(string, &start, &w, breaks, &beg, &end, e, (ftnlen)1); - } - -/* Check to see if we should be looking for a newline token. */ - - if (nlintk) { - -/* Ok. Get ready to jump through hoops again. We have to */ -/* look for newline tokens, for all those in excess of one */ -/* in a row, we have to output a blank line. */ - - b = e + 1; - e += nlinew; - looped = FALSE_; - if (e <= last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - (b - - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - while(newlin) { - lright = right; - -/* See if the new line token is qualified so as to change */ -/* the margins of the output. */ - - if (e >= last) { - -/* In this case we can't possibly match as in the case */ -/* below */ - - b += nlinew; - } else /* if(complicated condition) */ { - i__1 = e; - if (match_(string + i__1, "(*:*)*", string_len - i__1, ( - ftnlen)6)) { - -/* Looks like we should change the columns. Locate the */ -/* tokens of the newline marker. */ - - fndntk_(string, "(:", &e, &leftb, &lefte, string_len, - (ftnlen)2); - fndntk_(string, ":)", &lefte, &rightb, &righte, - string_len, (ftnlen)2); - -/* Parse the strings representing the increments to left */ -/* and right column positions. */ - - s_copy(errorl, " ", (ftnlen)160, (ftnlen)1); - s_copy(errorr, " ", (ftnlen)160, (ftnlen)1); - if (leftb <= lefte) { - nparsi_(string + (leftb - 1), &nleft, errorl, &k, - lefte - (leftb - 1), (ftnlen)160); - } else { - nleft = 0; - } - if (rightb <= righte) { - nparsi_(string + (rightb - 1), &nright, errorr, & - k, righte - (rightb - 1), (ftnlen)160); - } else { - nright = 0; - } - -/* Only if no errors were encountered during parsing */ -/* do we change the columns. */ - - if (s_cmp(errorl, " ", (ftnlen)160, (ftnlen)1) == 0 && - s_cmp(errorr, " ", (ftnlen)160, (ftnlen)1) == - 0) { - b = righte + 2; - left += nleft; - right -= nright; - rmarg = max(origr,right); - } else { - b += nlinew; - } - } else { - b += nlinew; - } - } - -/* Take care of the case when outdenting or indenting has */ -/* forced us into absurd margins. */ - - if (left < 1) { - setmsg_("The current value for the left column is #. Thi" - "s is less than 1 and thus not a valid value. ", ( - ftnlen)92); - errint_("#", &left, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } else if (left > right) { - setmsg_("The current value for the left column is greate" - "r than the value for the right column. The value" - " for the left column is #. The value for the ri" - "ght column is #. ", (ftnlen)160); - errint_("#", &left, (ftnlen)1); - errint_("#", &right, (ftnlen)1); - sigerr_("SPICE(INVALIDCOLUMN)", (ftnlen)20); - chkout_("NICEPR_1", (ftnlen)8); - return 0; - } - -/* Output something if this is not the first pass through */ -/* the loop. */ - - if (! looped) { - looped = TRUE_; - s_copy(line, " ", (ftnlen)512, (ftnlen)1); - if (leadtk) { - s_copy(line + (origl - 1), style + (leadrb - 1), 512 - - (origl - 1), leadre - (leadrb - 1)); - } - if (trltk) { - s_copy(line + (pstamb - 1), style + (trailb - 1), 512 - - (pstamb - 1), traile - (trailb - 1)); - } - } else { - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, ( - ftnlen)1, rmarg); - } - (*myio)(line, rmarg); - } -/* Computing MAX */ - i__1 = b, i__2 = ncpos_(string, " ", &b, string_len, (ftnlen) - 1); - b = max(i__1,i__2); - e = b + nlinew - 1; - if (e <= last) { - newlin = s_cmp(string + (b - 1), style + (nlinb - 1), e - - (b - 1), nline - (nlinb - 1)) == 0; - } else { - newlin = FALSE_; - } - } - e = upto_(string, style + (nlinb - 1), &b, string_len, nline - ( - nlinb - 1)); - -/* Just in case we went through the loop, and didn't */ -/* output a line, and we've reached the end of the */ -/* string. We check and write a blank line if necessary */ - - if (looped && e == 0) { - -/* Handle any hard spaces */ - - if (hardsp) { - replch_(line, hspchr, " ", line, rmarg, (ftnlen)1, ( - ftnlen)1, rmarg); - } - (*myio)(line, rmarg); - } - } else { - e = 0; - } - } - chkout_("NICEPR_1", (ftnlen)8); - return 0; -} /* nicepr_1__ */ - diff --git a/ext/spice/src/csupport/no.c b/ext/spice/src/csupport/no.c deleted file mode 100644 index b30d15edcd..0000000000 --- a/ext/spice/src/csupport/no.c +++ /dev/null @@ -1,51 +0,0 @@ -/* no.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -logical no_(char *error, ftnlen error_len) -{ - /* System generated locals */ - logical ret_val; - - /* Local variables */ - extern logical have_(char *, ftnlen); - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - ret_val = ! have_(error, error_len); - return ret_val; -} /* no_ */ - diff --git a/ext/spice/src/csupport/nspio.c b/ext/spice/src/csupport/nspio.c deleted file mode 100644 index f87a953113..0000000000 --- a/ext/spice/src/csupport/nspio.c +++ /dev/null @@ -1,2331 +0,0 @@ -/* nspio.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__8 = 8; -static integer c__6 = 6; - -/* $Procedure NSPIO (Inspekt I/O Manager) */ -/* Subroutine */ int nspio_0_(int n__, char *line, char *port, char *name__, - logical *status, logical *ok, ftnlen line_len, ftnlen port_len, - ftnlen name_len) -{ - /* Initialized data */ - - static char ports[32*8] = "SCREEN " "LOG " - " " "SAVE " "UTIL" - "ITY " "ERROR " - "AUX1 " "AUX2 " - " " "AUX3 "; - static char files[255*8] = " " - " " - " " - " " - " " " " - " " - " " - " " - " " " " - " " - " " - " " - " " " " - " " - " " - " " - " " " " - " " - " " - " " - " " " " - " " - " " - " " - " " " " - " " - " " - " " - " " " " - " " - " " - " " - " "; - static integer units[8] = { 6,0,0,0,0,0,0,0 }; - static logical active[8] = { TRUE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_ }; - static logical open[8] = { TRUE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_ }; - static logical suspnd[8] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, - FALSE_,FALSE_ }; - static logical erropf = FALSE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - cllist cl__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), f_clos(cllist *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer zznsppok_(char *, integer *, char *, ftnlen, ftnlen); - static integer r__; - extern /* Subroutine */ int chkin_(char *, ftnlen), zztxtopn_(char *, - integer *, logical *, ftnlen); - extern integer rtrim_(char *, ftnlen); - static integer id; - extern logical failed_(void); - static integer to; - static char messge[400]; - static logical openok; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), trnlat_(char *, char *, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int writln_(char *, integer *, ftnlen), txtopn_( - char *, integer *, ftnlen); - -/* $ Abstract */ - -/* Manage file and screen logging information for Inspekt. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LINE I NSPWLN */ -/* PORT I NSPOPN, NSPIOH, NSPIOA, NSPGST, NSPPST, NSPIOC */ -/* NSPIOS, NSPIOR, NSPPFL */ -/* NAME I/O NSPOPN, NSPPFL */ -/* STATUS I/O NSPGST, NSPPST */ -/* OK O NSPIOR */ - -/* $ Detailed_Input */ - -/* LINE is a string of text that is to be written to all the */ -/* open, active, non-suspended ports. */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* NAME The name of a file to create and attach to a file */ -/* based port. */ - -/* STATUS An array of logicals that configures the status of */ -/* a port. Acceptable values are as follows: */ - -/* STATUS(1) - Activity Status: */ -/* .TRUE. - the port is active */ -/* .FALSE. - the port is inactive */ - -/* STATUS(2) - Open Status: */ -/* .TRUE. - the port is open */ -/* .FALSE. - the port is closed */ - -/* STATUS(3) - Suspend Status: */ -/* .TRUE. - I/O on this port is suspended */ -/* .FALSE. - I/O can proceed on this port */ - -/* $ Detailed_Output */ - -/* NAME The name of a file attached to a file based port. */ - -/* STATUS An array of logicals that describes the status of */ -/* a port. A description of the values follows: */ - -/* STATUS(1) - Activity Status: */ -/* .TRUE. - the port is active */ -/* .FALSE. - the port is inactive */ - -/* STATUS(2) - Open Status: */ -/* .TRUE. - the port is open */ -/* .FALSE. - the port is closed */ - -/* STATUS(3) - Suspend Status: */ -/* .TRUE. - I/O on this port is suspended */ -/* .FALSE. - I/O can proceed on this port */ - -/* OK is a logical that indicates whether the attempt to */ -/* reopen a suspended port succeeded. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* 1) This umbrella may be configured to simultaneously access */ -/* NPORTS number of files. They are all opened using the */ -/* SPICELIB routine TXTOPN. */ - -/* $ Exceptions */ - -/* 1) If the bogus entry point NSPIO is called directly, then the */ -/* error NSPIO(BOGUSENTRY) is signalled. */ - -/* 2) See entry points «Entry Points» for exceptions specific to */ -/* them. */ - -/* $ Particulars */ - -/* NSPIO is an umbrella that functions as an I/O manager. It */ -/* is capable of interfacing with STDOUT as well as several */ -/* files at once. To accomplish these management tasks, the */ -/* following entry points are provided: */ - -/* NSPOPN - Open a port. */ - -/* NSPIOH - Inhibit access to a port. */ -/* NSPIOA - Activate an inhibited port. */ - -/* NSPGST - Get the status of a port. */ -/* NSPPST - Put the status of a port. */ - -/* NSPIOS - Suspend access to a port. */ -/* NSPIOR - Reopen a suspended port. */ - -/* NSPWLN - Write a line of text to all accessible ports. */ - -/* NSPEND - Close all ports and reset the state of the I/O */ -/* manager to the default. */ - -/* NSPPFL - Retrieve the name of the file associated with a port. */ - -/* NSPIOC - Close a port. */ - -/* The following ports are provided for usage: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* By default the SCREEN port is open and ready to receive lines */ -/* of text. All of the file based ports are closed until opened */ -/* with NSPOPN. */ - -/* NSPEND is provided to close all open ports and reset the I/O */ -/* manager back to its default state. If the SCREEN port is */ -/* accessible for writing, then when the LOG, SAVE, and ERROR ports */ -/* are closed a message indicating where they may be found is */ -/* written to the screen port. The ERROR port is a special case, */ -/* since if it was unsuccessfully opened, when NSPEND attempts to */ -/* close this port it writes a brief diagnostic indicating the */ -/* open failure. */ - -/* The suspend and reopen entry points are provided for backwards */ -/* compatibility and should not be used in developing new code. */ - -/* $ Examples */ - -/* See INSPEKT for examples. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 01-FEB-2000 (FST) */ - -/* Added headers and ports ERROR, AUX1, AUX2, and AUX3. */ - -/* - NSPIO Version 1.0.0, 15-ARP-1996 (WLT) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Other Functions */ - - -/* Local Parameters */ - - -/* Error File Port Integer Code. */ - - -/* Log File Port Integer Code. */ - - -/* The number of total ports supported by this version of NSPIO. */ - - -/* The logical unit that is associated with STDOUT. */ - - -/* The maximum filename string length. */ - - -/* The maximum length of a message. */ - - -/* The maximum length of a word. */ - - -/* Spool Port Integer Code. */ - - -/* Screen Port Integer Code. */ - - -/* Local Variables */ - - -/* Save all local variables. */ - - -/* Initialize the PORT configuration arrays. */ - - /* Parameter adjustments */ - if (status) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_nspopn; - case 2: goto L_nspioh; - case 3: goto L_nspioa; - case 4: goto L_nspgst; - case 5: goto L_nsppst; - case 6: goto L_nspioc; - case 7: goto L_nspios; - case 8: goto L_nspior; - case 9: goto L_nspwln; - case 10: goto L_nspend; - case 11: goto L_nsppfl; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPIO", (ftnlen)5); - sigerr_("NSPIO(BOGUSENTRY)", (ftnlen)17); - chkout_("NSPIO", (ftnlen)5); - } - return 0; -/* $Procedure NSPOPN ( Inspekt I/O Manager -- Open Port ) */ - -L_nspopn: -/* $ Abstract */ - -/* Open a new port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to open. */ -/* NAME I The name of the file to open and attach to PORT. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* NAME The name of a file to create and attach to a file */ -/* based port. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* 1) If PORT is a file-based port then this routine will open */ -/* a file with the SPICE routine TXTOPN. */ - -/* 2) If PORT is already attached to a file, then this file */ -/* is closed before PORT is attached to a new file. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. Note, in this case, the status of */ -/* all ports remains the same. */ - -/* 2) If PORT is file based and already open, then NSPOPN closes */ -/* the file attached to PORT and opens the requested new one. */ - -/* 3) If PORT is 'SCREEN', then this entry point does nothing. */ - -/* 4) If PORT is 'ERROR', then if an error occurs opening the */ -/* file, this routine simply leaves the port unopen and */ -/* returns. */ - -/* 4) Any errors that occur in opening the files not associated with */ -/* the 'SCREEN' and 'ERROR' ports are processed by TXTOPN. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* 1) NAME should point to a non-existant file that can be opened */ -/* for write access. */ - -/* 2) NAME should be a string of less than SIZFIL characters in */ -/* length. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 01-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPOPN", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* See if an error has been signaled. If so, do nothing */ -/* further and return. */ - - if (failed_()) { - chkout_("NSPOPN", (ftnlen)6); - return 0; - } - -/* First check to see whether we are dealing with the SCREEN */ -/* port. If we are return, do nothing and return. */ - - if (id == 1) { - chkout_("NSPOPN", (ftnlen)6); - return 0; - } - -/* Now at this point we have a request to open a file based */ -/* port. Check first to see if it is already open. */ - - if (open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, - "nspio_", (ftnlen)540)]) { - -/* If the file attached to PORT is already open, close it */ -/* before attaching this new file to it. */ - - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "nspio_", (ftnlen)546)]; - cl__1.csta = 0; - f_clos(&cl__1); - -/* Now reset PORT's status. */ - - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)551)] = FALSE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, - "nspio_", (ftnlen)552)] = FALSE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)553)] = FALSE_; - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "files", i__1, "nspio_", (ftnlen)554)) * 255, " ", (ftnlen) - 255, (ftnlen)1); - } - -/* Check to see if we are opening the ERROR port. We treat */ -/* this port differently from the other file based ports, since */ -/* if an error occurs opening the file, no error is signaled. */ -/* The port is simply not opened. */ - - if (id == 5) { - -/* Assume there is will be no error opening the file. */ - - erropf = FALSE_; - -/* Attempt to open the file. */ - - r__ = rtrim_(name__, name_len); - zztxtopn_(name__, &units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "nspio_", (ftnlen)575)], &openok, r__); - -/* If the OPEN process failed, then clear the status of the */ -/* port and return. */ - - if (! openok) { - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)583)] = FALSE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", - i__1, "nspio_", (ftnlen)584)] = FALSE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)585)] = FALSE_; - -/* Leave FILES(ID) set, so that the name of the file can */ -/* be reported. */ - - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "files", i__1, "nspio_", (ftnlen)592)) * 255, name__, ( - ftnlen)255, name_len); - -/* Before returning, set ERROPF to .TRUE., since */ -/* this will facilitate the creation of the warning */ -/* message when NSPEND is invoked. */ - - erropf = TRUE_; - chkout_("NSPOPN", (ftnlen)6); - return 0; - } - -/* Consider all other file based ports. For these ports we will */ -/* signal errors if TXTOPN is incapable of opening the file. */ - - } else { - -/* Open the new file. */ - - r__ = rtrim_(name__, name_len); - txtopn_(name__, &units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "nspio_", (ftnlen)615)], r__); - -/* Check FAILED(). If an error has occurred, clear PORT status, */ -/* check out and return. */ - - if (failed_()) { - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)623)] = FALSE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", - i__1, "nspio_", (ftnlen)624)] = FALSE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)625)] = FALSE_; - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "files", i__1, "nspio_", (ftnlen)626)) * 255, " ", ( - ftnlen)255, (ftnlen)1); - chkout_("NSPOPN", (ftnlen)6); - return 0; - } - } - -/* If we made it this far, then the file was opened successfully. */ -/* Set PORT status to reflect successful open. */ - - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", i__1, - "nspio_", (ftnlen)638)] = TRUE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, "nsp" - "io_", (ftnlen)639)] = TRUE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", i__1, - "nspio_", (ftnlen)640)] = FALSE_; - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("files", - i__1, "nspio_", (ftnlen)641)) * 255, name__, (ftnlen)255, - name_len); - chkout_("NSPOPN", (ftnlen)6); - return 0; -/* $Procedure NSPIOH ( Inspekt I/O Manager -- Inhibit Port ) */ - -L_nspioh: -/* $ Abstract */ - -/* Inhibit output to a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to inhibit. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. */ - -/* 2) If PORT is already inhibited, then it remains inhibited. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 01-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPIOH", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* Inhibit I/O to the port, if no error was signaled. Note - if */ -/* the port is already inhibited, then this does not change it's */ -/* state. */ - - if (! failed_()) { - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)787)] = FALSE_; - } - chkout_("NSPIOH", (ftnlen)6); - return 0; -/* $Procedure NSPIOA ( Inspekt I/O Manager -- Activate Port ) */ - -L_nspioa: -/* $ Abstract */ - -/* Activate a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to activate. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. */ - -/* 2) If PORT is already active, then PORT remains active. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 02-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPIOA", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* Activate the port, if no error was signaled. Note - if PORT was */ -/* already activated, then it will remain activated. */ - - if (! failed_()) { - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)934)] = TRUE_; - } - chkout_("NSPIOA", (ftnlen)6); - return 0; -/* $Procedure NSPGST ( Inspekt I/O Manager -- Get Port Status ) */ - -L_nspgst: -/* $ Abstract */ - -/* Get the current status of a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ -/* LOGICAL STATUS ( 3 ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to fetch status. */ -/* STATUS O An array of logicals that indicates port status. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* STATUS An array of logicals that describes the status of */ -/* a port. A description of the values follows: */ - -/* STATUS(1) - Activity Status: */ -/* .TRUE. - the port is active */ -/* .FALSE. - the port is inactive */ - -/* STATUS(2) - Open Status: */ -/* .TRUE. - the port is open */ -/* .FALSE. - the port is closed */ - -/* STATUS(3) - Suspend Status: */ -/* .TRUE. - I/O on this port is suspended */ -/* .FALSE. - I/O can proceed on this port */ - - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. In the event this happens */ -/* the routine does not alter the contents of STATUS. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* 1) STATUS must be an array with space for 3 logicals. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 03-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPGST", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* Return the status of the port if no error was signaled. */ - - if (! failed_()) { - status[0] = active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "active", i__1, "nspio_", (ftnlen)1094)]; - status[1] = open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "open", i__1, "nspio_", (ftnlen)1095)]; - status[2] = suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "suspnd", i__1, "nspio_", (ftnlen)1096)]; - } - chkout_("NSPGST", (ftnlen)6); - return 0; -/* $Procedure NSPPST ( Inspekt I/O Manager -- Put Port Status ) */ - -L_nsppst: -/* $ Abstract */ - -/* Put the status of a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ -/* LOGICAL STATUS ( 3 ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to receive status. */ -/* STATUS O An array of logicals that indicates port status. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* STATUS An array of logicals that describes the status of */ -/* a port. A description of the values follows: */ - -/* STATUS(1) - Activity Status: */ -/* .TRUE. - the port is active */ -/* .FALSE. - the port is inactive */ - -/* STATUS(2) - Open Status: */ -/* .TRUE. - the port is open */ -/* .FALSE. - the port is closed */ - -/* STATUS(3) - Suspend Status: */ -/* .TRUE. - I/O on this port is suspended */ -/* .FALSE. - I/O can proceed on this port */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. In the event this happens */ -/* the routine does not alter the status of any PORT. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* 1) The STATUS array must provide at least 3 logicals. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 03-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPPST", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* Set the status of the port if no error was signaled. */ - - if (! failed_()) { - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)1258)] = status[0]; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, - "nspio_", (ftnlen)1259)] = status[1]; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)1260)] = status[2]; - } - chkout_("NSPPST", (ftnlen)6); - return 0; -/* $Procedure NSPIOC ( Inspekt I/O Manager -- Close Port ) */ - -L_nspioc: -/* $ Abstract */ - -/* Close a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to close. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. In the event this happens */ -/* the routine does not alter the contents of STATUS. */ - -/* 2) If PORT is already closed, then this routine does nothing, */ -/* and simply returns. */ - -/* 3) Attempting to "close" the screen port will have no effect. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* 1) PORT must refer to a file based port. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 03-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPIOC", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* Check FAILED() to see if an error was signaled, or if */ -/* ID refers to the SCREEN port. In either case, return without */ -/* doing anything. */ - - if (failed_() || id == 1) { - chkout_("NSPIOC", (ftnlen)6); - return 0; - } - -/* Now check to see if the port is currently closed or if the */ -/* requested port to close is the SCREEN port. */ - - if (! open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, - "nspio_", (ftnlen)1420)] || id == 1) { - chkout_("NSPIOC", (ftnlen)6); - return 0; - } - -/* If we make it this far, then we were given an open file */ -/* based port. Close the port and reset its status. */ - - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "nspio_", (ftnlen)1431)]; - cl__1.csta = 0; - f_clos(&cl__1); - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", i__1, - "nspio_", (ftnlen)1432)] = FALSE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, "nsp" - "io_", (ftnlen)1433)] = FALSE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", i__1, - "nspio_", (ftnlen)1434)] = FALSE_; - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("files", - i__1, "nspio_", (ftnlen)1435)) * 255, " ", (ftnlen)255, (ftnlen)1) - ; - -/* If we have closed the error file, then clear ERROPF. */ - - if (id == 5) { - erropf = FALSE_; - } - chkout_("NSPIOC", (ftnlen)6); - return 0; -/* $Procedure NSPIOS ( Inspekt I/O Manager -- Suspend Port ) */ - -L_nspios: -/* $ Abstract */ - -/* Suspend a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to suspend. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. In the event this happens */ -/* the routine does not alter the contents of STATUS. */ - -/* 2) If PORT is already has it's I/O suspended, then it will */ -/* remain suspended. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 08-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPIOS", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* Suspend I/O on the port, if no error was signaled. Note - if */ -/* PORT was already suspended, then it will remain suspended. */ - - if (! failed_()) { - -/* Suspend I/O on PORT. */ - - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)1594)] = TRUE_; - } - chkout_("NSPIOS", (ftnlen)6); - return 0; -/* $Procedure NSPIOR ( Inspekt I/O Manager -- Reopen Port ) */ - -L_nspior: -/* $ Abstract */ - -/* Reopen a suspended port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) PORT */ -/* LOGICAL OK */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String specifying which port to re-open. */ -/* OK O logical that indicates a successful re-open. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* OK is a logical that indicates whether the attempt to */ -/* reopen a suspended port succeeded. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK. */ - -/* 2) If PORT is already not suspended, then PORT remains so and */ -/* OK is returned as .FALSE. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 08-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPIOR", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* See if an error has been signaled. If so, do nothing */ -/* further and return. */ - - if (failed_()) { - chkout_("NSPIOR", (ftnlen)6); - return 0; - } - -/* Check to see if PORT is currently suspended. */ - - if (! suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)1753)]) { - -/* If it's not, then set OK to .FALSE. and return */ - - *ok = FALSE_; - chkout_("NSPIOR", (ftnlen)6); - return 0; - } - -/* Suspend I/O to this port. */ - - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", i__1, - "nspio_", (ftnlen)1767)] = FALSE_; - chkout_("NSPIOR", (ftnlen)6); - return 0; -/* $Procedure NSPWLN ( Inspekt I/O Manager -- Write Line ) */ - -L_nspwln: -/* $ Abstract */ - -/* Write a line to all open and active ports. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* CHARACTER*(*) LINE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LINE I is a line of text to be written to available ports. */ - -/* $ Detailed_Input */ - -/* LINE is a string of text that is to be written to all the */ -/* open, active, non-suspended ports. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* 1) This routine will write to any files associated with ports */ -/* that are open, active, and not suspended when NSPWLN is */ -/* called. */ - -/* $ Exceptions */ - -/* 1) If an error occurs writing the line to a particular port, */ -/* then this routine closes that port, resets its status, and */ -/* continues writing LINE to the other ports. */ - -/* 2) Any errors are signaled by routines in the call tree of */ -/* NSPWLN. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 08-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPWLN", (ftnlen)6); - } - -/* Write to all the open, active, and non-suspended ports. */ - - for (id = 1; id <= 8; ++id) { - if (! suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd" - , i__1, "nspio_", (ftnlen)1896)] && active[(i__2 = id - 1) < - 8 && 0 <= i__2 ? i__2 : s_rnge("active", i__2, "nspio_", ( - ftnlen)1896)] && open[(i__3 = id - 1) < 8 && 0 <= i__3 ? i__3 - : s_rnge("open", i__3, "nspio_", (ftnlen)1896)]) { - -/* Write the line to this port. */ - - to = units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("uni" - "ts", i__1, "nspio_", (ftnlen)1903)]; - writln_(line, &to, line_len); - -/* Check for and process any errors. */ - - if (id != 1 && failed_()) { - -/* If we have encountered an error then close the */ -/* file and reset the port status. Note we do not */ -/* need to reset error status to continue, since */ -/* WRITLN does not check RETURN(). */ - - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "nspio_", (ftnlen)1918)]; - cl__1.csta = 0; - f_clos(&cl__1); - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("act" - "ive", i__1, "nspio_", (ftnlen)1919)] = FALSE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", - i__1, "nspio_", (ftnlen)1920)] = FALSE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("sus" - "pnd", i__1, "nspio_", (ftnlen)1921)] = FALSE_; - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("files", i__1, "nspio_", (ftnlen)1922)) * 255, - " ", (ftnlen)255, (ftnlen)1); - } - } - } - chkout_("NSPWLN", (ftnlen)6); - return 0; -/* $Procedure NSPEND ( Inspekt I/O Manager -- Finished with I/O ) */ - -L_nspend: -/* $ Abstract */ - -/* The final entry point handles closing files and informing */ -/* the user of the location of these files. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* 1) This routine closes the files attached to all open ports. */ - -/* $ Exceptions */ - -/* 1) If the SCREEN port is not open, it simply closes the port */ -/* and does not write any notifications. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 09-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPEND", (ftnlen)6); - } - -/* If the LOG port is open, then notify the user about it's */ -/* location, and close it. */ - - if (open[1]) { - trnlat_("LOGFILWRITTENTO", messge, (ftnlen)15, (ftnlen)400); - if (! suspnd[0] && active[0] && open[0]) { - -/* Write the message. */ - - writln_(" ", &c__6, (ftnlen)1); - r__ = rtrim_(messge, (ftnlen)400); - writln_(messge, &c__6, r__); - r__ = rtrim_(files + 255, (ftnlen)255); - writln_(files + 255, &c__6, r__); - } - } - -/* If the SAVE port is open, then notify the user about it's */ -/* location, and close it. */ - - if (open[3]) { - trnlat_("SAVFILWRITTENTO", messge, (ftnlen)15, (ftnlen)400); - if (! suspnd[0] && active[0] && open[0]) { - -/* Write the message. */ - - writln_(" ", &c__6, (ftnlen)1); - r__ = rtrim_(messge, (ftnlen)400); - writln_(messge, &c__6, r__); - r__ = rtrim_(files + 765, (ftnlen)255); - writln_(files + 765, &c__6, r__); - } - } - -/* If the ERROR port is open, then notify the user about it's */ -/* location, and close it. */ - - if (open[4]) { - trnlat_("ERRFILWRITTENTO", messge, (ftnlen)15, (ftnlen)400); - if (! suspnd[0] && active[0] && open[0]) { - -/* Write the message. */ - - writln_(" ", &c__6, (ftnlen)1); - r__ = rtrim_(messge, (ftnlen)400); - writln_(messge, &c__6, r__); - r__ = rtrim_(files + 1020, (ftnlen)255); - writln_(files + 1020, &c__6, r__); - } - } else if (erropf) { - trnlat_("ERRFILWRITEFAIL", messge, (ftnlen)15, (ftnlen)400); - if (! suspnd[0] && active[0] && open[0]) { - -/* Write the message. */ - - writln_(" ", &c__6, (ftnlen)1); - r__ = rtrim_(messge, (ftnlen)400); - writln_(messge, &c__6, r__); - r__ = rtrim_(files + 1020, (ftnlen)255); - writln_(files + 1020, &c__6, r__); - } - } - -/* Close all ports and restore NSPIO status to it's uninitialized */ -/* state. First handle the screen port, since it's an exception. */ - - active[0] = TRUE_; - open[0] = TRUE_; - suspnd[0] = FALSE_; - -/* Now reset the file based ports. */ - - for (id = 2; id <= 8; ++id) { - -/* Close the file associated with the port if it's open. */ - - if (open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", - i__1, "nspio_", (ftnlen)2163)]) { - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "nspio_", (ftnlen)2165)]; - cl__1.csta = 0; - f_clos(&cl__1); - } - -/* Restore original port status. */ - - units[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("units", i__1, - "nspio_", (ftnlen)2171)] = 0; - s_copy(files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "files", i__1, "nspio_", (ftnlen)2172)) * 255, " ", (ftnlen) - 255, (ftnlen)1); - active[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("active", - i__1, "nspio_", (ftnlen)2173)] = FALSE_; - open[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("open", i__1, - "nspio_", (ftnlen)2174)] = FALSE_; - suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("suspnd", - i__1, "nspio_", (ftnlen)2175)] = FALSE_; - } - chkout_("NSPEND", (ftnlen)6); - return 0; -/* $Procedure NSPPFL ( Inspekt I/O Manager -- Fetch file name ) */ - -L_nsppfl: -/* $ Abstract */ - -/* Get the name of the file associated with a port. */ - -/* $ 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ - - -/* CHARACTER*(*) PORT */ -/* CHARACTER*(*) NAME */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I String that indicates the name of the port. */ -/* NAME O String holding the filename associated with PORT. */ - -/* $ Detailed_Input */ - -/* PORT is a string that indicates the name of a port on which */ -/* to perform an operation. Acceptable values are: */ - -/* Standard Output Port: */ - -/* 'SCREEN' */ - -/* File Based Ports: */ - -/* 'LOG' */ -/* 'SAVE' */ -/* 'UTILITY' */ -/* 'ERROR' */ -/* 'AUX1' */ -/* 'AUX2' */ -/* 'AUX3' */ - -/* $ Detailed_Output */ - -/* NAME The name of a file attached to a file based port. */ - -/* $ Parameters */ - -/* See NSPIO. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is improperly specified, the error NSPIO(UNKNOWNPORT) */ -/* is signaled by ZZNSPPOK and NAME is set to ' '. */ - -/* 2) If PORT is 'SCREEN' then NSPPFL sets NAME to ' '. */ - -/* 3) If PORT is INACTIVE, SUSPENDED, or CLOSED, then NAME is */ -/* returned as ' '. */ - -/* $ Particulars */ - -/* See NSPIO. */ - -/* $ Examples */ - -/* See NSPIO. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 09-FEB-2000 (FST) */ - - -/* -& */ - -/* Standard SPICELIB error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NSPPFL", (ftnlen)6); - } - -/* Find the integer associated with PORT. */ - - id = zznsppok_(port, &c__8, ports, port_len, (ftnlen)32); - -/* See if an error has been signaled. If so, clear NAME */ -/* and return. */ - - if (failed_()) { - s_copy(name__, " ", name_len, (ftnlen)1); - chkout_("NSPPFL", (ftnlen)6); - return 0; - -/* If the ID refers to an active, open, non-suspended port, then */ -/* set NAME to the name of the file. Note: in the case when PORT */ -/* is 'SCREEN', the corresponding entry in the FILES array is ' '. */ - - } else if (! suspnd[(i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "suspnd", i__1, "nspio_", (ftnlen)2338)] && active[(i__2 = id - 1) - < 8 && 0 <= i__2 ? i__2 : s_rnge("active", i__2, "nspio_", ( - ftnlen)2338)] && open[(i__3 = id - 1) < 8 && 0 <= i__3 ? i__3 : - s_rnge("open", i__3, "nspio_", (ftnlen)2338)]) { - s_copy(name__, files + ((i__1 = id - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("files", i__1, "nspio_", (ftnlen)2342)) * 255, - name_len, (ftnlen)255); - -/* If PORT is inactive, suspended or closed, set NAME to ' '. */ - - } else { - s_copy(name__, " ", name_len, (ftnlen)1); - } - chkout_("NSPPFL", (ftnlen)6); - return 0; -} /* nspio_ */ - -/* Subroutine */ int nspio_(char *line, char *port, char *name__, logical * - status, logical *ok, ftnlen line_len, ftnlen port_len, ftnlen - name_len) -{ - return nspio_0_(0, line, port, name__, status, ok, line_len, port_len, - name_len); - } - -/* Subroutine */ int nspopn_(char *port, char *name__, ftnlen port_len, - ftnlen name_len) -{ - return nspio_0_(1, (char *)0, port, name__, (logical *)0, (logical *)0, ( - ftnint)0, port_len, name_len); - } - -/* Subroutine */ int nspioh_(char *port, ftnlen port_len) -{ - return nspio_0_(2, (char *)0, port, (char *)0, (logical *)0, (logical *)0, - (ftnint)0, port_len, (ftnint)0); - } - -/* Subroutine */ int nspioa_(char *port, ftnlen port_len) -{ - return nspio_0_(3, (char *)0, port, (char *)0, (logical *)0, (logical *)0, - (ftnint)0, port_len, (ftnint)0); - } - -/* Subroutine */ int nspgst_(char *port, logical *status, ftnlen port_len) -{ - return nspio_0_(4, (char *)0, port, (char *)0, status, (logical *)0, ( - ftnint)0, port_len, (ftnint)0); - } - -/* Subroutine */ int nsppst_(char *port, logical *status, ftnlen port_len) -{ - return nspio_0_(5, (char *)0, port, (char *)0, status, (logical *)0, ( - ftnint)0, port_len, (ftnint)0); - } - -/* Subroutine */ int nspioc_(char *port, ftnlen port_len) -{ - return nspio_0_(6, (char *)0, port, (char *)0, (logical *)0, (logical *)0, - (ftnint)0, port_len, (ftnint)0); - } - -/* Subroutine */ int nspios_(char *port, ftnlen port_len) -{ - return nspio_0_(7, (char *)0, port, (char *)0, (logical *)0, (logical *)0, - (ftnint)0, port_len, (ftnint)0); - } - -/* Subroutine */ int nspior_(char *port, logical *ok, ftnlen port_len) -{ - return nspio_0_(8, (char *)0, port, (char *)0, (logical *)0, ok, (ftnint) - 0, port_len, (ftnint)0); - } - -/* Subroutine */ int nspwln_(char *line, ftnlen line_len) -{ - return nspio_0_(9, line, (char *)0, (char *)0, (logical *)0, (logical *)0, - line_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int nspend_(void) -{ - return nspio_0_(10, (char *)0, (char *)0, (char *)0, (logical *)0, ( - logical *)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int nsppfl_(char *port, char *name__, ftnlen port_len, - ftnlen name_len) -{ - return nspio_0_(11, (char *)0, port, name__, (logical *)0, (logical *)0, ( - ftnint)0, port_len, name_len); - } - diff --git a/ext/spice/src/csupport/nsplgr.c b/ext/spice/src/csupport/nsplgr.c deleted file mode 100644 index ae25f357fd..0000000000 --- a/ext/spice/src/csupport/nsplgr.c +++ /dev/null @@ -1,247 +0,0 @@ -/* nsplgr.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $ 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. */ - -/* Subroutine */ int nsplg_0_(int n__, char *commnd, logical *hidden, char * - vstyle, char *hstyle, char *cdelim, ftnlen commnd_len, ftnlen - vstyle_len, ftnlen hstyle_len, ftnlen cdelim_len) -{ - /* Initialized data */ - - static char mystr[1025] = " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " " - " "; - static char seen[120] = "LEFT 1 RIGHT 78 " - " " - " "; - static char hide[120] = "LEADER ;^ LEFT 1 RIGHT 78 HARDSPACE ^ " - " " - " "; - static char delim[1] = ";"; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int nspioa_(char *, ftnlen), nspioh_(char *, - ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int nspwln_(); - extern /* Subroutine */ int nicepr_1__(char *, char *, U_fp, ftnlen, - ftnlen); - - -/* $ Version */ - -/* - Command Loop Configured Version 1.1.0, 21-JUN-1999 (WLT) */ - -/* Placed RETURN before first entry point. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* Save the contents of the command to a log file and any save */ -/* file that might be open and active. */ - -/* $ 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. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* The following parameters are the system parameters required */ -/* by PERCY. Be sure to read any notes before adjusting these */ - - -/* The maximum number of commands that can be buffered is */ -/* determined by the value of MAXCOM. This parameter is */ -/* used primarily by NXTCOM. */ - - -/* The parameter FILEN is the maximum length of a file name */ -/* on a particular system. */ - - -/* The parameter COMSIZ is the maximum length allowed for a */ -/* command. */ - - -/* The parameter ERRSIZ is the maximum length allowed for */ -/* error messages. */ - - -/* The parameter STYSIZ is the maximum length expected for */ -/* a NICEPR style string. */ - - switch(n__) { - case 1: goto L_nsplog; - case 2: goto L_nsplgs; - case 3: goto L_nspgls; - } - - return 0; - -/* This entry point handles the logging of commands. */ - - -L_nsplog: - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - s_copy(mystr, commnd, (ftnlen)1025, commnd_len); - -/* Inhibit writing to the screen. */ - - nspioh_("SCREEN", (ftnlen)6); - nspioa_("LOG", (ftnlen)3); - if (*hidden) { - nicepr_1__(commnd, hide, (U_fp)nspwln_, commnd_len, (ftnlen)120); - } else { - s_copy(mystr, commnd, (ftnlen)1025, commnd_len); - suffix_(delim, &c__0, mystr, (ftnlen)1, (ftnlen)1025); - nicepr_1__(mystr, seen, (U_fp)nspwln_, (ftnlen)1025, (ftnlen)120); - } - -/* Re-activate the screen for writing output. */ - - nspioa_("SCREEN", (ftnlen)6); - nspioh_("LOG", (ftnlen)3); - return 0; - -/* This entry point allows users to set the style used for */ -/* logging hidden and visible commands. */ - - -L_nsplgs: - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - s_copy(seen, vstyle, (ftnlen)120, vstyle_len); - s_copy(hide, hstyle, (ftnlen)120, hstyle_len); - s_copy(delim, cdelim, (ftnlen)1, cdelim_len); - return 0; - -/* This entry point allows users to get the style used for */ -/* logging hidden and visible commands. */ - - -L_nspgls: - s_copy(vstyle, seen, vstyle_len, (ftnlen)120); - s_copy(hstyle, hide, hstyle_len, (ftnlen)120); - s_copy(cdelim, delim, cdelim_len, (ftnlen)1); - return 0; -} /* nsplg_ */ - -/* Subroutine */ int nsplg_(char *commnd, logical *hidden, char *vstyle, char - *hstyle, char *cdelim, ftnlen commnd_len, ftnlen vstyle_len, ftnlen - hstyle_len, ftnlen cdelim_len) -{ - return nsplg_0_(0, commnd, hidden, vstyle, hstyle, cdelim, commnd_len, - vstyle_len, hstyle_len, cdelim_len); - } - -/* Subroutine */ int nsplog_(char *commnd, logical *hidden, ftnlen commnd_len) -{ - return nsplg_0_(1, commnd, hidden, (char *)0, (char *)0, (char *)0, - commnd_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int nsplgs_(char *vstyle, char *hstyle, char *cdelim, ftnlen - vstyle_len, ftnlen hstyle_len, ftnlen cdelim_len) -{ - return nsplg_0_(2, (char *)0, (logical *)0, vstyle, hstyle, cdelim, ( - ftnint)0, vstyle_len, hstyle_len, cdelim_len); - } - -/* Subroutine */ int nspgls_(char *vstyle, char *hstyle, char *cdelim, ftnlen - vstyle_len, ftnlen hstyle_len, ftnlen cdelim_len) -{ - return nsplg_0_(3, (char *)0, (logical *)0, vstyle, hstyle, cdelim, ( - ftnint)0, vstyle_len, hstyle_len, cdelim_len); - } - diff --git a/ext/spice/src/csupport/nspopl.c b/ext/spice/src/csupport/nspopl.c deleted file mode 100644 index 50d73367ef..0000000000 --- a/ext/spice/src/csupport/nspopl.c +++ /dev/null @@ -1,219 +0,0 @@ -/* nspopl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static logical c_true = TRUE_; - -/* $ 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. */ - -/* Subroutine */ int nspopl_(char *lognam, char *versn, ftnlen lognam_len, - ftnlen versn_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1, i__2[2]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - - /* Local variables */ - extern logical have_(char *, ftnlen); - char time[32], warn[32], attr[32*2], rest[800]; - integer i__, n; - logical found; - char value[32]; - extern integer rtrim_(char *, ftnlen); - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - char myerr[800*2], style[80]; - integer start; - char io[32], logfil[128]; - extern /* Subroutine */ int newfil_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), dcyphr_(integer *, logical *, char *, ftnlen), - nparsi_(char *, integer *, char *, integer *, ftnlen, ftnlen), - prefix_(char *, integer *, char *, ftnlen, ftnlen), nsplog_(char * - , logical *, ftnlen), curtim_(char *, ftnlen), trnlat_(char *, - char *, ftnlen, ftnlen), nextwd_(char *, char *, char *, ftnlen, - ftnlen, ftnlen), pltfrm_(integer *, integer *, char *, ftnlen), - suffix_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int nspwln_(); - extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen); - char env[80], err[80], was[32]; - extern integer pos_(char *, char *, integer *, ftnlen, ftnlen); - char tkv[80]; - integer ptr; - extern /* Subroutine */ int nicepr_1__(char *, char *, U_fp, ftnlen, - ftnlen); - - -/* $ Version */ - -/* - Command Loop Configured Version 2.0.0, 10-SEP-1998 (WLT) */ - -/* The routine now logs the version of SPICELIB that the */ -/* program was linked against. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* This routine opens the log file that will be used for loging */ -/* commands. It should only be called once. If a log file */ -/* cannot be opened, the routine will issue a warning message */ -/* to the default output device. */ - -/* $ 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. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* The following parameters are the system parameters required */ -/* by PERCY. Be sure to read any notes before adjusting these */ - - -/* The maximum number of commands that can be buffered is */ -/* determined by the value of MAXCOM. This parameter is */ -/* used primarily by NXTCOM. */ - - -/* The parameter FILEN is the maximum length of a file name */ -/* on a particular system. */ - - -/* The parameter COMSIZ is the maximum length allowed for a */ -/* command. */ - - -/* The parameter ERRSIZ is the maximum length allowed for */ -/* error messages. */ - - -/* The parameter STYSIZ is the maximum length expected for */ -/* a NICEPR style string. */ - - -/* Empty out the internal error buffers. */ - - s_copy(myerr, " ", (ftnlen)800, (ftnlen)1); - s_copy(myerr + 800, " ", (ftnlen)800, (ftnlen)1); - for (i__ = 1; i__ <= 2; ++i__) { - s_copy(attr + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge( - "attr", i__1, "nspopl_", (ftnlen)101)) << 5), " ", (ftnlen)32, - (ftnlen)1); - } - newfil_(lognam, "LOG", logfil, lognam_len, (ftnlen)3, (ftnlen)128); - if (have_(myerr, (ftnlen)800)) { - -/* See if we can parse the error message as having the */ -/* string IOSTAT was value imbedded in it. This isn't */ -/* pretty, but we can possibly get a better idea of */ -/* what went wrong this way. */ - - start = pos_(myerr, "IOSTAT", &c__1, (ftnlen)800, (ftnlen)6); - if (start > 0) { - s_copy(rest, myerr + (start - 1), (ftnlen)800, 800 - (start - 1)); - nextwd_(rest, io, rest, (ftnlen)800, (ftnlen)32, (ftnlen)800); - nextwd_(rest, was, rest, (ftnlen)800, (ftnlen)32, (ftnlen)800); - nextwd_(rest, value, rest, (ftnlen)800, (ftnlen)32, (ftnlen)800); - if (eqstr_(was, "was", (ftnlen)32, (ftnlen)3) && s_cmp(value, - " ", (ftnlen)32, (ftnlen)1) != 0) { - s_copy(err, " ", (ftnlen)80, (ftnlen)1); - nparsi_(value, &i__, err, &ptr, (ftnlen)32, (ftnlen)80); - if (s_cmp(err, " ", (ftnlen)80, (ftnlen)1) == 0) { - dcyphr_(&i__, &found, rest, (ftnlen)800); - if (found) { - s_copy(myerr + (start - 1), rest, 800 - (start - 1), ( - ftnlen)800); - } - } - } - } - s_copy(rest, myerr, (ftnlen)800, (ftnlen)800); - s_copy(warn, " ", (ftnlen)32, (ftnlen)1); - trnlat_("WARNING", warn, (ftnlen)7, (ftnlen)32); - trnlat_("CANNOTOPENLOG", myerr + 800, (ftnlen)13, (ftnlen)800); - start = rtrim_(myerr + 800, (ftnlen)800); - prefix_(myerr + 800, &c__1, rest, start, (ftnlen)800); -/* Writing concatenation */ - i__2[0] = 33, a__1[0] = "LEFT 1 RIGHT 78 NEWLINE /cr FLAG "; - i__2[1] = 32, a__1[1] = warn; - s_cat(style, a__1, i__2, &c__2, (ftnlen)80); - nicepr_1__(rest, style, (U_fp)nspwln_, (ftnlen)800, (ftnlen)80); - } else { - curtim_(time, (ftnlen)32); - pltfrm_(&c__2, &n, attr, (ftnlen)32); - tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)80); - s_copy(env, attr, (ftnlen)80, (ftnlen)32); - suffix_("---", &c__1, env, (ftnlen)3, (ftnlen)80); - suffix_(attr + 32, &c__1, env, (ftnlen)32, (ftnlen)80); - prefix_("SPICE Toolkit ", &c__1, tkv, (ftnlen)14, (ftnlen)80); - nsplog_(env, &c_true, (ftnlen)80); - nsplog_(versn, &c_true, versn_len); - nsplog_(tkv, &c_true, (ftnlen)80); - nsplog_(time, &c_true, (ftnlen)32); - } - return 0; -} /* nspopl_ */ - diff --git a/ext/spice/src/csupport/nsppwd.c b/ext/spice/src/csupport/nsppwd.c deleted file mode 100644 index d6513f6ef7..0000000000 --- a/ext/spice/src/csupport/nsppwd.c +++ /dev/null @@ -1,242 +0,0 @@ -/* nsppwd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure NSPPWD ( NSP --- Page width) */ -/* Subroutine */ int nsppwd_0_(int n__, char *margin, integer *left, integer * - right, ftnlen margin_len) -{ - /* Initialized data */ - - static integer myleft = 1; - static integer myrght = 80; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static char strlft[16]; - extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); - static char strrht[16]; - -/* $ Abstract */ - -/* This routine is an umbrella routine used to cover the */ -/* three entry points used for setting and retrieving */ -/* page width settings. */ - -/* $ 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 */ - -/* PAGE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* MARGIN O A "NICEIO" style string for left and right margins */ -/* LEFT I/O The column to be used for the left margin. */ -/* RIGHT I/O The column to be used for the right margin. */ -/* MXPGWD P Maximum allowed page width. */ - -/* The function returns */ - -/* $ Detailed_Input */ - -/* LEFT is an integer that sets the left margin. */ - -/* RIGHT is an integer that sets the right margin. */ - - -/* $ Detailed_Output */ - -/* LEFT is the current left margin. */ - -/* RIGHT is the current right margin. */ - -/* $ Parameters */ - -/* MXPGWD is the maximum allowed page width. This is here */ -/* so that this routine can be error free. It is */ -/* possible that on some systems this could be made */ -/* substantially larger. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine is an umbrella for the three entry points */ - -/* NSPMRG --- returns a NICEIO/NICEBT/NICEPR style string */ -/* of the form 'LEFT number1 RIGHT number2 ' */ -/* where number1 and number2 give the left and */ -/* right margins to use when creating NICEIO */ -/* style output. */ - -/* Other style items may be added to this string */ -/* for use in creating output. */ - -/* NSPSLR --- sets the left and right margins to be used */ -/* when creating a style string. Note there are */ -/* no erroneous inputs. Values are forced into */ -/* a "reasonable" range. */ - -/* NSPGLR --- get the current left and right margins. */ - -/* $ Examples */ - -/* To set the margins to 1 to 72 make the following call: */ - -/* CALL NSPSLR ( 1, 72 ) */ - -/* To get back a NICEPR string that will be used for setting */ -/* the style of page output. */ - -/* CALL NSPMRG ( MARGIN ) */ - -/* To get the numeric values (so you don't have to parse MARGIN) */ -/* make the following call: */ - -/* CALL NSPGLR ( LEFT, RIGHT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Command Loop Version 1.0.0, 1-AUG-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Set or get command loop page margins. */ - -/* -& */ - switch(n__) { - case 1: goto L_nspmrg; - case 2: goto L_nspslr; - case 3: goto L_nspglr; - } - - return 0; - -L_nspmrg: - -/* Return the current margins to be used by the NICEIO and NICEPR */ -/* routines. */ - - intstr_(&myleft, strlft, (ftnlen)16); - intstr_(&myrght, strrht, (ftnlen)16); - s_copy(margin, "LEFT", margin_len, (ftnlen)4); - suffix_(strlft, &c__1, margin, (ftnlen)16, margin_len); - suffix_("RIGHT", &c__1, margin, (ftnlen)5, margin_len); - suffix_(strrht, &c__1, margin, (ftnlen)16, margin_len); - return 0; - -L_nspslr: - -/* Set the left and right margins to be used when creating */ -/* margin style strings in the entry point above. Note */ -/* we force these to be reasonable. No error checking is */ -/* done. */ - -/* Computing MAX */ -/* Computing MIN */ - i__3 = min(*left,*right); - i__1 = 1, i__2 = min(i__3,129); - myleft = max(i__1,i__2); -/* Computing MIN */ -/* Computing MAX */ - i__3 = max(*left,*right), i__4 = myleft + 2; - i__1 = 131, i__2 = max(i__3,i__4); - myrght = min(i__1,i__2); - return 0; - -L_nspglr: - -/* Get the left and right margins that are currently */ -/* being used. */ - - *left = myleft; - *right = myrght; - return 0; -} /* nsppwd_ */ - -/* Subroutine */ int nsppwd_(char *margin, integer *left, integer *right, - ftnlen margin_len) -{ - return nsppwd_0_(0, margin, left, right, margin_len); - } - -/* Subroutine */ int nspmrg_(char *margin, ftnlen margin_len) -{ - return nsppwd_0_(1, margin, (integer *)0, (integer *)0, margin_len); - } - -/* Subroutine */ int nspslr_(integer *left, integer *right) -{ - return nsppwd_0_(2, (char *)0, left, right, (ftnint)0); - } - -/* Subroutine */ int nspglr_(integer *left, integer *right) -{ - return nsppwd_0_(3, (char *)0, left, right, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/nspsav.c b/ext/spice/src/csupport/nspsav.c deleted file mode 100644 index 7dc9f29991..0000000000 --- a/ext/spice/src/csupport/nspsav.c +++ /dev/null @@ -1,61 +0,0 @@ -/* nspsav.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ 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. */ - -/* Subroutine */ int nspsav_(char *file, char *error, ftnlen file_len, ftnlen - error_len) -{ - extern logical have_(char *, ftnlen); - extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen, - ftnlen), nspopn_(char *, char *, ftnlen, ftnlen); - - -/* This routine opens the file specified by FILE for saving all */ -/* screen output. */ - - -/* Interface to SPICELIB error handling. */ - - -/* Not much to this, just call the correct routine from NSPIO. */ - - nspopn_("SAVE", file, (ftnlen)4, file_len); - if (have_(error, error_len)) { - prefix_("NSPSAV: ", &c__1, error, (ftnlen)8, error_len); - return 0; - } - return 0; -} /* nspsav_ */ - diff --git a/ext/spice/src/csupport/nspxcp.c b/ext/spice/src/csupport/nspxcp.c deleted file mode 100644 index 645286b6ac..0000000000 --- a/ext/spice/src/csupport/nspxcp.c +++ /dev/null @@ -1,220 +0,0 @@ -/* nspxcp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ 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. */ - -/* Subroutine */ int nspxcp_0_(int n__, char *string, char *error, char * - screen, char *logfil, ftnlen string_len, ftnlen error_len, ftnlen - screen_len, ftnlen logfil_len) -{ - /* Initialized data */ - - static char lstyle[128] = "LEFT 1 RIGHT 78 " - " " - " "; - static char sstyle[128] = "LEFT 1 RIGHT 78 " - " " - " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer i__; - extern /* Subroutine */ int prclr_(void); - static char margin[128]; - extern /* Subroutine */ int nspioa_(char *, ftnlen), nspioh_(char *, - ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen), - trnlat_(char *, char *, ftnlen, ftnlen), nspmrg_(char *, ftnlen), - nspgst_(char *, logical *, ftnlen); - extern /* Subroutine */ int nspwln_(); - static logical scrstt[3], savstt[3]; - extern /* Subroutine */ int nsppst_(char *, logical *, ftnlen), - nicepr_1__(char *, char *, U_fp, ftnlen, ftnlen); - - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - /* Parameter adjustments */ - if (error) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_nsperr; - case 2: goto L_nspsty; - } - - return 0; - -L_nsperr: -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* This entry point is intended to be called once for */ -/* brief error diagnostics and a second time for more detailed */ -/* diagnostics. We can tell which is which by examining the */ -/* first entry of the error array. If it is non-blank this */ -/* must be the first such call (because we set it to blank */ -/* after we get done doing something with it). A second */ -/* call can only happen if the special command */ -/* was entered by the user ('?'). In this case the command */ -/* manager will not reset the error array and not pass the */ -/* command to any other routines. Instead it returns immediately */ -/* so that this routine can process the second part of the */ -/* error message. */ - - if (s_cmp(error, " ", error_len, (ftnlen)1) != 0) { - -/* We automatically clear the procedure stack whenever */ -/* an error occurs. */ - - prclr_(); - -/* First inhibit writing to the log file. */ - - nspioh_("LOG", (ftnlen)3); - -/* Now write out only the first component of the error message. */ - - nspmrg_(margin, (ftnlen)128); - suffix_(sstyle, &c__1, margin, (ftnlen)128, (ftnlen)128); - nicepr_1__(error, margin, (U_fp)nspwln_, error_len, (ftnlen)128); - -/* Now inhibit writing to the screen or the save file. But */ -/* fetch their current state so that we can reset them */ -/* to exactly their current states. */ - - nspgst_("SCREEN", scrstt, (ftnlen)6); - nspgst_("SAVE", savstt, (ftnlen)4); - nspioh_("SCREEN", (ftnlen)6); - nspioh_("SAVE", (ftnlen)4); - -/* Reactivate the log file. */ - - nspioa_("LOG", (ftnlen)3); - for (i__ = 1; i__ <= 2; ++i__) { - nicepr_1__(error + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : - s_rnge("error", i__1, "nspxcp_", (ftnlen)127)) * - error_len, lstyle, (U_fp)nspwln_, error_len, (ftnlen)128); - } - nsppst_("SCREEN", scrstt, (ftnlen)6); - nsppst_("SAVE", savstt, (ftnlen)4); - s_copy(error, " ", error_len, (ftnlen)1); - return 0; - } - -/* The only way to get here is for the user to have processed */ -/* the first half of an error and typed a question mark or */ -/* blank command. (This relies on all kinds of side effects. */ -/* Better talk to Bill if you want to be able to figure this out). */ - - if (s_cmp(string, "?", string_len, (ftnlen)1) == 0) { - if (s_cmp(error + error_len, " ", error_len, (ftnlen)1) == 0) { - trnlat_("NOMOREDIAGNOSTICS", error + error_len, (ftnlen)17, - error_len); - } - -/* We've already written the second part of the error */ -/* message to the log file, so we shall inhibit writing */ -/* there now. */ - - nspioh_("LOG", (ftnlen)3); - nspmrg_(margin, (ftnlen)128); - suffix_(sstyle, &c__1, margin, (ftnlen)128, (ftnlen)128); - nicepr_1__(error + error_len, margin, (U_fp)nspwln_, error_len, ( - ftnlen)128); - -/* Now re-activate the log file. */ - - nspioa_("LOG", (ftnlen)3); - s_copy(error + error_len, " ", error_len, (ftnlen)1); - } - return 0; - -/* Set the style string that shall be used for printing */ -/* errors. */ - - -L_nspsty: - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - s_copy(sstyle, screen, (ftnlen)128, screen_len); - s_copy(lstyle, logfil, (ftnlen)128, logfil_len); - return 0; -} /* nspxcp_ */ - -/* Subroutine */ int nspxcp_(char *string, char *error, char *screen, char * - logfil, ftnlen string_len, ftnlen error_len, ftnlen screen_len, - ftnlen logfil_len) -{ - return nspxcp_0_(0, string, error, screen, logfil, string_len, error_len, - screen_len, logfil_len); - } - -/* Subroutine */ int nsperr_(char *string, char *error, ftnlen string_len, - ftnlen error_len) -{ - return nspxcp_0_(1, string, error, (char *)0, (char *)0, string_len, - error_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int nspsty_(char *screen, char *logfil, ftnlen screen_len, - ftnlen logfil_len) -{ - return nspxcp_0_(2, (char *)0, (char *)0, screen, logfil, (ftnint)0, ( - ftnint)0, screen_len, logfil_len); - } - diff --git a/ext/spice/src/csupport/nthuqt.c b/ext/spice/src/csupport/nthuqt.c deleted file mode 100644 index 5fe21b6c0b..0000000000 --- a/ext/spice/src/csupport/nthuqt.c +++ /dev/null @@ -1,267 +0,0 @@ -/* nthuqt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NTHUQT ( N'th unquoted token ) */ -/* Subroutine */ int nthuqt_(char *string, integer *n, char *equote, char * - word, integer *loc, ftnlen string_len, ftnlen equote_len, ftnlen - word_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, b, e, i__, l; - logical odddq, oddsp, oddsq; - extern integer rtrim_(char *, ftnlen); - integer spcial, dquote; - logical inword; - integer wcount, squote; - -/* $ Abstract */ - -/* This routine finds the N'th non-quoted token in a string. */ -/* Quoted substrings are ignored and not treated as */ -/* blanks. */ - -/* $ 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 */ - -/* STRING */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* N I Index of the token to be returned. */ -/* EQUOTE I An extra quote character. */ -/* WORD O The N'TH unquoted token in STRING. */ -/* LOC O Location of WORD in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input string to be parsed. It contains */ -/* some number of token, where a token is any string */ -/* of consecutive non-blank, non-comma characters */ -/* not between balanced quotes. */ - -/* N is the index of the token to be returned. (One for */ -/* the first token, two for the second, and so on.) */ - -/* EQUOTE is a special character that users may supply so */ -/* that specially marked strings will be skipped */ -/* in the selection of tokens. If you do not want */ -/* any specially marked strings use a blank for EQUOTE */ - -/* $ Detailed_Output */ - -/* WORD is the N'th token in STRING. If STRING is blank, */ -/* or NTH is nonpositive or too large, WORD is blank. */ - -/* LOC is the location of WORD in STRING. (That is, WORD */ -/* begins at STRING(LOC:LOC). If STRING is blank, or */ -/* NTH is nonpositive or too large, LOC is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) */ - -/* $ Particulars */ - -/* NTHUQT, like NTHWD, is useful primarily for parsing input */ -/* commands consisting of one or more tokens, where a token is */ -/* defined to be any sequence of consecutive non-blank characters. */ - -/* The chief difference between the two routines is that */ -/* NTHUQT treats all character starting at and through */ -/* a balanced quote as blanks. Both " and ' are treated as */ -/* quote characters. */ - -/* $ Examples */ - - -/* Let STRING be ' He said, "Now is the time" and left. ' */ -/* 1234567890123456789012345678901234567 */ - -/* If N = -1 WORD = ' ' LOC = 0 */ -/* 0 ' ' 0 */ -/* 1, 'He' 2 */ -/* 2, 'said' 5 */ -/* 3, 'and' 29 */ -/* 4, 'left.' 33 */ -/* 5, ' ' 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Inspekt Version 1.0.0, 14-JUL-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Find the n'th unquoted token in a string */ - -/* -& */ - -/* Spice Functions */ - - -/* Local Variables */ - - -/* An integer */ - - -/* Take care of the dumb cases first. */ - - if (*n <= 0) { - s_copy(word, " ", word_len, (ftnlen)1); - *loc = 0; - return 0; - } - squote = '\''; - dquote = '"'; - spcial = *(unsigned char *)equote; - if (spcial == ' ') { - spcial = squote; - } - last = rtrim_(string, string_len); - wcount = 0; - odddq = FALSE_; - oddsq = FALSE_; - oddsp = FALSE_; - inword = FALSE_; - i__1 = last; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the integer value of the I'th character of string. */ - - l = *(unsigned char *)&string[i__ - 1]; - -/* If this is a quote character, then flip the ODDQ logical */ - - if (l == spcial) { - oddsp = ! oddsp; - } - if (l == squote) { - oddsq = ! oddsq; - } - if (l == dquote) { - odddq = ! odddq; - } - -/* If this is a blank ... */ - - if (l == ' ' || l == ',' || odddq || oddsq || oddsp || (l == squote || - l == dquote || l == spcial)) { - -/* if we are in the middle of a word, we are about to */ -/* end it. If the word counter WCOUNT has the same */ -/* value of N then we've found the N'th unquoted word. */ -/* Set the various outputs and return. */ - - if (inword && wcount == *n) { - s_copy(word, string + (b - 1), word_len, e - (b - 1)); - *loc = b; - return 0; - } - -/* If we get to here, we just point out that we are */ -/* not in a word. */ - - inword = FALSE_; - } else { - -/* If this is not a "blank" then ODDDQ, ODDSQ and ODDSP are */ -/* false so we are not inside a quoted string. We are either */ -/* already in a word, or we are just starting one. */ - - if (inword) { - -/* We are in a word, just bump the end of this one. */ - - e = i__; - } else { - -/* We are beginning a word. Up the word counter, */ -/* set the end and beginning of the word. */ - - inword = TRUE_; - ++wcount; - b = i__; - e = i__; - } - } - -/* Examine the next character. */ - - } - if (inword && wcount == *n) { - *loc = b; - s_copy(word, string + (b - 1), word_len, string_len - (b - 1)); - } else { - *loc = 0; - s_copy(word, " ", word_len, (ftnlen)1); - } - return 0; -} /* nthuqt_ */ - diff --git a/ext/spice/src/csupport/nthuqw.c b/ext/spice/src/csupport/nthuqw.c deleted file mode 100644 index 565e9ae966..0000000000 --- a/ext/spice/src/csupport/nthuqw.c +++ /dev/null @@ -1,267 +0,0 @@ -/* nthuqw.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure NTHUQW ( N'th unquoted word) */ -/* Subroutine */ int nthuqw_(char *string, integer *n, char *equote, char * - word, integer *loc, ftnlen string_len, ftnlen equote_len, ftnlen - word_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer last, b, e, i__, l; - logical odddq, oddsp, oddsq; - extern integer rtrim_(char *, ftnlen); - integer spcial, dquote; - logical inword; - integer wcount, squote; - -/* $ Abstract */ - -/* This routine finds the N'th non-quoted word in a string. */ -/* Quoted substrings are ignored and not treated as */ -/* blanks. */ - -/* $ 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 */ - -/* STRING */ -/* WORD */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* N I Index of the word to be returned. */ -/* EQUOTE I An extra quote character. */ -/* WORD O The N'TH unquoted word in STRING. */ -/* LOC O Location of WORD in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input string to be parsed. It contains */ -/* some number of word, where a word is any string */ -/* of consecutive non-blank characters not between */ -/* balanced quotes. */ - -/* N is the index of the word to be returned. (One for */ -/* the first word, two for the second, and so on.) */ - -/* EQUOTE is a special character that users may supply so */ -/* that specially marked strings will be skipped */ -/* in the selection of words. If you do not want */ -/* any specially marked strings use a blank for EQUOTE */ - -/* $ Detailed_Output */ - -/* WORD is the N'th word in STRING. If STRING is blank, */ -/* or NTH is nonpositive or too large, WORD is blank. */ - -/* LOC is the location of WORD in STRING. (That is, WORD */ -/* begins at STRING(LOC:LOC). If STRING is blank, or */ -/* NTH is nonpositive or too large, LOC is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) */ - -/* $ Particulars */ - -/* NTHUQW, like NTHWD, is useful primarily for parsing input */ -/* commands consisting of one or more words, where a word is */ -/* defined to be any sequence of consecutive non-blank characters. */ - -/* The chief difference between the two routines is that */ -/* NTHUQW treats all character starting at and through */ -/* a balanced quote as blanks. Both " and ' are treated as */ -/* quote characters. */ - -/* $ Examples */ - - -/* Let STRING be ' He said, "Now is the time" and left. ' */ -/* 1234567890123456789012345678901234567 */ - -/* If N = -1 WORD = ' ' LOC = 0 */ -/* 0 ' ' 0 */ -/* 1, 'He' 2 */ -/* 2, 'said,' 5 */ -/* 3, 'and' 29 */ -/* 4, 'left.' 33 */ -/* 5, ' ' 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Inspekt Version 1.0.0, 14-JUL-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Find the n'th unquoted word in a string */ - -/* -& */ - -/* Spice Functions */ - - -/* Local Variables */ - - -/* An integer */ - - -/* Take care of the dumb cases first. */ - - if (*n <= 0) { - s_copy(word, " ", word_len, (ftnlen)1); - *loc = 0; - return 0; - } - squote = '\''; - dquote = '"'; - spcial = *(unsigned char *)equote; - if (spcial == ' ') { - spcial = squote; - } - last = rtrim_(string, string_len); - wcount = 0; - odddq = FALSE_; - oddsq = FALSE_; - oddsp = FALSE_; - inword = FALSE_; - i__1 = last; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Get the integer value of the I'th character of string. */ - - l = *(unsigned char *)&string[i__ - 1]; - -/* If this is a quote character, then flip the ODDQ logical */ - - if (l == spcial) { - oddsp = ! oddsp; - } - if (l == squote) { - oddsq = ! oddsq; - } - if (l == dquote) { - odddq = ! odddq; - } - -/* If this is a blank ... */ - - if (l == ' ' || odddq || oddsq || oddsp || (l == squote || l == - dquote || l == spcial)) { - -/* if we are in the middle of a word, we are about to */ -/* end it. If the word counter WCOUNT has the same */ -/* value of N then we've found the N'th unquoted word. */ -/* Set the various outputs and return. */ - - if (inword && wcount == *n) { - s_copy(word, string + (b - 1), word_len, e - (b - 1)); - *loc = b; - return 0; - } - -/* If we get to here, we just point out that we are */ -/* not in a word. */ - - inword = FALSE_; - } else { - -/* If this is not a "blank" then ODDDQ, ODDSQ and ODDSP are */ -/* false so we are not inside a quoted string. We are either */ -/* already in a word, or we are just starting one. */ - - if (inword) { - -/* We are in a word, just bump the end of this one. */ - - e = i__; - } else { - -/* We are beginning a word. Up the word counter, */ -/* set the end and beginning of the word. */ - - inword = TRUE_; - ++wcount; - b = i__; - e = i__; - } - } - -/* Examine the next character. */ - - } - if (inword && wcount == *n) { - *loc = b; - s_copy(word, string + (b - 1), word_len, string_len - (b - 1)); - } else { - *loc = 0; - s_copy(word, " ", word_len, (ftnlen)1); - } - return 0; -} /* nthuqw_ */ - diff --git a/ext/spice/src/csupport/nxtcom.c b/ext/spice/src/csupport/nxtcom.c deleted file mode 100644 index 7a1300c492..0000000000 --- a/ext/spice/src/csupport/nxtcom.c +++ /dev/null @@ -1,719 +0,0 @@ -/* nxtcom.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static logical c_true = TRUE_; -static integer c__0 = 0; -static integer c__3 = 3; - -/* $Procedure NXTCOM ( Next command ) */ -/* Subroutine */ int nxtcom_0_(int n__, char *prompt, char *delim, char * - commnd, integer *source, ftnlen prompt_len, ftnlen delim_len, ftnlen - commnd_len) -{ - /* Initialized data */ - - static integer buffed = 0; - static logical first = TRUE_; - static logical readng = FALSE_; - static char savdlm[1] = ";"; - static char savpmt[80] = " " - " "; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char file[128], exit[32], word[80], rest[128], stop[32]; - extern logical batch_(void); - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen); - static logical nocom; - extern /* Subroutine */ int prclr_(void); - static char error[300], start[32], buffer[1024*20]; - extern integer brckti_(integer *, integer *, integer *); - extern /* Subroutine */ int prread_(char *, char *, ftnlen, ftnlen); - static integer bufsrc[20]; - static char lngmsg[300]; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), nsplog_(char *, logical *, - ftnlen); - static char shtmsg[32]; - extern /* Subroutine */ int trnlat_(char *, char *, ftnlen, ftnlen), - nextwd_(char *, char *, char *, ftnlen, ftnlen, ftnlen), prexit_( - void), rdstmt_(char *, char *, char *, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int prstrt_(char *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Get the next command from the keyboard or a file. */ - -/* $ 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 */ - -/* FILES */ -/* PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Entry */ -/* -------- --- -------------------------------------------------- */ -/* PROMPT I SETDAP */ -/* DELIM I SETDAP */ -/* COMMND O GETCOM */ -/* SOURCE O GETCOM */ - -/* $ Detailed_Input */ - -/* See the ENTRY points for a discussion of their arguments. */ - -/* $ Detailed_Output */ - -/* See the ENTRY points for a discussion of their arguments. */ - -/* $ Files */ - -/* If the commands are contained in a file, they will be read from */ -/* that file. (The 'START' keyword indicates that commands are to */ -/* be read from a specified file.) If they are not contained in a */ -/* file, they are read from the keyboard. */ - -/* $ Exceptions */ - -/* 1) If NXTCOM is called directly, the error SPICE(BOGUSENTRY) is */ -/* signalled. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* The delimeter has a fixed length of one character. The prompt has */ -/* a fixed length of eighty characters. */ - -/* The file name length has been parameterized internally to the */ -/* maximum file name length length on the VAX, 128 characters. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - Commad Loop Version 2.0.0 19-NOV-1995 (WLT) */ - -/* Added the batch mode capability. If the BATCH function */ -/* returns TRUE then all keyboard routines return EXIT. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Beta Version 1.0.0, 02-DEC-1988 (HAN) */ - -/* -& */ - -/* SPICELIB functions */ - -/* $ 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. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* The following parameters are the system parameters required */ -/* by PERCY. Be sure to read any notes before adjusting these */ - - -/* The maximum number of commands that can be buffered is */ -/* determined by the value of MAXCOM. This parameter is */ -/* used primarily by NXTCOM. */ - - -/* The parameter FILEN is the maximum length of a file name */ -/* on a particular system. */ - - -/* The parameter COMSIZ is the maximum length allowed for a */ -/* command. */ - - -/* The parameter ERRSIZ is the maximum length allowed for */ -/* error messages. */ - - -/* The parameter STYSIZ is the maximum length expected for */ -/* a NICEPR style string. */ - - -/* Below are the various sources from which */ -/* commands might come. */ - -/* NONE */ -/* COMBUF */ -/* KEYBRD */ -/* INPFIL */ - - -/* Local variables */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_getcom; - case 2: goto L_setdap; - case 3: goto L_putcom; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("NXTCOM", (ftnlen)6); - } - -/* This routine should never be called. If this routine is called, */ -/* an error is signalled. */ - - setmsg_("NXTCOM: You have called an entry which performs no run-time fun" - "ction. This may indicate a bug. Please check the documentation f" - "or the subroutine NXTCOM.", (ftnlen)152); - sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); - chkout_("NXTCOM", (ftnlen)6); - return 0; -/* $Procedure GETCOM ( Get a command ) */ - -L_getcom: -/* $ Abstract */ - -/* Get a command from a file or the keyboard. */ - -/* $ 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 */ - -/* FILES */ -/* PARSING */ - -/* $ Declarations */ - -/* CHARACTER*(*) COMMND */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* COMMND O A command read from a file or from the screen. */ -/* SOURCE O The source of the command, file, terminal etc. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* COMMND is the command which is parsed from a line read from */ -/* either the screen or a file. */ - -/* SOURCE Is an integer that indicates the source of the */ -/* command. The table below shows the various */ -/* values and their meanings. */ - -/* 0 --- None, an error occurred */ -/* 1 --- Command buffer */ -/* 2 --- From standard input */ -/* 3 --- From a STARTED File. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* If an error occurs in PRSTRT, the error SPICE(FILEREADFAILED) */ -/* is signalled. ( PRSTRT has not been modified to participate in the */ -/* new error handling. ) */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Beta Version 1.0.0, 29-NOV-1988 (HAN) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("GETCOM", (ftnlen)6); - } - if (first) { - trnlat_("STOP", stop, (ftnlen)4, (ftnlen)32); - trnlat_("EXIT", exit, (ftnlen)4, (ftnlen)32); - trnlat_("START", start, (ftnlen)5, (ftnlen)32); - trnlat_("DEFPROMPT", savpmt, (ftnlen)9, (ftnlen)80); - first = FALSE_; - } - -/* While we don't have a command, try to get one. We look */ -/* in the command buffer first. */ - - -/* We don't have a command yet. */ - - nocom = TRUE_; - while(nocom) { - if (buffed > 0) { - s_copy(commnd, buffer + (((i__1 = buffed - 1) < 20 && 0 <= i__1 ? - i__1 : s_rnge("buffer", i__1, "nxtcom_", (ftnlen)366)) << - 10), commnd_len, (ftnlen)1024); - *source = bufsrc[(i__1 = buffed - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("bufsrc", i__1, "nxtcom_", (ftnlen)367)]; - --buffed; - } else { - -/* If we're already reading from a file then just let PRREAD */ -/* take care of obtaining the command. If PRREAD reaches the */ -/* end of the current file, the previous file is popped off */ -/* the stack, and the next command from this file is read */ -/* instead. (If no files remain to be read, DELIM is returned.) */ -/* In that case we are no longer reading from files. */ - - if (readng) { - prread_(savdlm, commnd, (ftnlen)1, commnd_len); - *source = 3; - if (s_cmp(commnd, savdlm, commnd_len, (ftnlen)1) == 0) { - readng = FALSE_; - } - } - -/* If we're not reading from a file, get the command from the */ -/* keyboard. ( If the command was terminated by a blank line, */ -/* the command is returned as a blank. ) */ - - if (! readng) { - if (batch_()) { - s_copy(commnd, exit, commnd_len, (ftnlen)32); - } else { - rdstmt_(savpmt, savdlm, commnd, (ftnlen)80, (ftnlen)1, - commnd_len); - } - *source = 2; - } - } - -/* We must have a command at this point. */ - - nocom = FALSE_; - -/* We need to check to see if what we have is a control word. */ - - nextwd_(commnd, word, rest, commnd_len, (ftnlen)80, (ftnlen)128); - ucase_(word, word, (ftnlen)80, (ftnlen)80); - -/* If the control word is 'START', we know that we will be */ -/* reading from a file. Let PRSTRT take care of keeping track of */ -/* the files being read from. If there's a problem in PRSTRT we */ -/* need to signal an error here due to PRSTRT's error handling. */ -/* Bail out if there's a problem. If all goes well in PRSTR, */ -/* we will read the first command in the file the next pass */ -/* through the DO LOOP. */ - - if (s_cmp(word, start, (ftnlen)80, (ftnlen)32) == 0) { - -/* We need to log this command commented out so that anyone */ -/* using the resulting log file, will not have to worry */ -/* about starting a file twice. */ - - nsplog_(commnd, &c_true, commnd_len); - s_copy(file, " ", (ftnlen)128, (ftnlen)1); - nextwd_(rest, file, rest, (ftnlen)128, (ftnlen)128, (ftnlen)128); - if (s_cmp(file, " ", (ftnlen)128, (ftnlen)1) == 0) { - *source = 0; - trnlat_("MISSINGFILELONG", lngmsg, (ftnlen)15, (ftnlen)300); - trnlat_("MISSINGFILESHORT", shtmsg, (ftnlen)16, (ftnlen)32); - setmsg_(lngmsg, (ftnlen)300); - sigerr_(shtmsg, (ftnlen)32); - chkout_("GETCOM", (ftnlen)6); - return 0; - } - prstrt_(file, error, (ftnlen)128, (ftnlen)300); - -/* If an error occurs in PRSTRT we're in trouble. Signal an */ -/* error and bail. If there's no problem, we're now reading */ -/* from a file. */ - - if (s_cmp(error, " ", (ftnlen)300, (ftnlen)1) != 0) { - *source = 0; - trnlat_("MISSINGFILESHORT", shtmsg, (ftnlen)16, (ftnlen)32); - setmsg_(error, (ftnlen)300); - sigerr_(shtmsg, (ftnlen)32); - chkout_("GETCOM", (ftnlen)6); - return 0; - } else { - readng = TRUE_; - nocom = TRUE_; - } - -/* If the control word is 'STOP', clear the stack of files. */ -/* If we were reading commands from files, we won't be anymore. */ -/* If we were reading commands from the keyboard, the command to */ -/* return is 'STOP'. */ - - } else if (s_cmp(word, stop, (ftnlen)80, (ftnlen)32) == 0) { - if (readng) { - prclr_(); - nsplog_(commnd, &c_true, commnd_len); - readng = FALSE_; - nocom = TRUE_; - } else { - s_copy(commnd, word, commnd_len, (ftnlen)80); - } - -/* If the control word is 'EXIT', and we're reading from a file, */ -/* we need to remove that file from the stack. If we're reading */ -/* commands from the keyboard, we'll return the command 'EXIT'. */ - - } else if (s_cmp(word, exit, (ftnlen)80, (ftnlen)32) == 0) { - if (readng) { - prexit_(); - nsplog_(commnd, &c_true, commnd_len); - nocom = TRUE_; - } else { - s_copy(commnd, word, commnd_len, (ftnlen)80); - } - } - } - chkout_("GETCOM", (ftnlen)6); - return 0; -/* $Procedure SETDAP ( Set the delimeter and prompt values ) */ - -L_setdap: -/* $ Abstract */ - -/* Set the delimeter and prompt values that are used for parsing */ -/* commands. */ - -/* $ 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 */ - -/* CHARACTER */ -/* PARSING */ - -/* $ Declarations */ - -/* CHARACTER*1 DELIM */ -/* CHARACTER*80 PROMPT */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* DELIM I/O Character delimiting the end of a command. */ -/* PROMPT I/O Character string indicating the beginning of a */ -/* command. */ - -/* $ Detailed_Input */ - -/* DELIM is a single character delimiting the end of a command. */ -/* The default value of DELIM is ';'. */ - -/* PROMPT is a character string indicating the beginning of a */ -/* command. PROMPT has a maximum length of eighty */ -/* characters. The default value of PROMPT is 'Next? >'. */ - -/* $ Detailed_Output */ - -/* DELIM is the new character delimiting the end of a command. */ - -/* PROMPT is the new character string indicating the beginning */ -/* of a command. PROMPT has a maximum length of eighty */ -/* characters. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* DELIM and PROMPT have the default values of ';' and 'Next? >' */ -/* respectively. This module is called in order to change their */ -/* values. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - Beta Version 1.0.0, 02-DEC-1988 (HAN) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SETDAP", (ftnlen)6); - } - -/* Set the values of the delimeter and prompt. */ - - s_copy(savdlm, delim, (ftnlen)1, delim_len); - s_copy(savpmt, prompt, (ftnlen)80, prompt_len); - trnlat_("STOP", stop, (ftnlen)4, (ftnlen)32); - trnlat_("EXIT", exit, (ftnlen)4, (ftnlen)32); - trnlat_("START", start, (ftnlen)5, (ftnlen)32); - if (s_cmp(savpmt, " ", (ftnlen)80, (ftnlen)1) == 0) { - trnlat_("DEFPROMPT", savpmt, (ftnlen)9, (ftnlen)80); - } - first = FALSE_; - chkout_("SETDAP", (ftnlen)6); - return 0; - -/* $ Procedure */ - - -L_putcom: - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - if (buffed < 20) { - ++buffed; - s_copy(buffer + (((i__1 = buffed - 1) < 20 && 0 <= i__1 ? i__1 : - s_rnge("buffer", i__1, "nxtcom_", (ftnlen)685)) << 10), - commnd, (ftnlen)1024, commnd_len); - bufsrc[(i__1 = buffed - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("bufsrc", - i__1, "nxtcom_", (ftnlen)686)] = brckti_(source, &c__0, & - c__3); - return 0; - } - -/* If you get to this point there's a problem. No room */ -/* is left in the command buffer. */ - - chkin_("PUTCOM", (ftnlen)6); - trnlat_("COMBUFFULLLNG", lngmsg, (ftnlen)13, (ftnlen)300); - trnlat_("COMBUFFULLSHT", shtmsg, (ftnlen)13, (ftnlen)32); - setmsg_(lngmsg, (ftnlen)300); - sigerr_(shtmsg, (ftnlen)32); - chkout_("PUTCOM", (ftnlen)6); - return 0; -} /* nxtcom_ */ - -/* Subroutine */ int nxtcom_(char *prompt, char *delim, char *commnd, integer - *source, ftnlen prompt_len, ftnlen delim_len, ftnlen commnd_len) -{ - return nxtcom_0_(0, prompt, delim, commnd, source, prompt_len, delim_len, - commnd_len); - } - -/* Subroutine */ int getcom_(char *commnd, integer *source, ftnlen commnd_len) -{ - return nxtcom_0_(1, (char *)0, (char *)0, commnd, source, (ftnint)0, ( - ftnint)0, commnd_len); - } - -/* Subroutine */ int setdap_(char *delim, char *prompt, ftnlen delim_len, - ftnlen prompt_len) -{ - return nxtcom_0_(2, prompt, delim, (char *)0, (integer *)0, prompt_len, - delim_len, (ftnint)0); - } - -/* Subroutine */ int putcom_(char *commnd, integer *source, ftnlen commnd_len) -{ - return nxtcom_0_(3, (char *)0, (char *)0, commnd, source, (ftnint)0, ( - ftnint)0, commnd_len); - } - diff --git a/ext/spice/src/csupport/occurs.c b/ext/spice/src/csupport/occurs.c deleted file mode 100644 index 2b199009ef..0000000000 --- a/ext/spice/src/csupport/occurs.c +++ /dev/null @@ -1,155 +0,0 @@ -/* occurs.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure OCCURS ( Count occurrences of a substring in a string ) */ -integer occurs_(char *str, char *sub, ftnlen str_len, ftnlen sub_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer lsub, lstr, i__; - -/* $ Abstract */ - -/* Count the number of times that a substring occurs within */ -/* a character 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 */ - -/* STRING */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STR I Character string. */ -/* C I Target substring. */ - -/* $ Detailed_Input */ - -/* STR is an arbitrary character string. */ - -/* SUB is an arbitrary character string. */ - -/* $ Detailed_Output */ - -/* The function returns the number of occurrences of the substring */ -/* within the string. */ - -/* $ Exceptions. */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Typically, this would be used to count the number of times */ -/* that a single character occurs within a string: for example, */ -/* to determine whether the number of left parentheses in an */ -/* expression matches the number of right parentheses. */ - -/* The occurrences found by OCCURS are independent: that is, */ -/* the number of occurrences of 'XXX' in 'XXXXXXXX' is two, */ -/* and not six. */ - -/* $ Examples */ - -/* The following code fragment checks to make sure that the */ -/* number of left parentheses in an expression matches the number */ -/* of right delimiters in the same expression. */ - -/* IF ( OCCURS ( EXPR, '(' ) - OCCURS ( EXPR, ')' ) .NE. 0 ) THEN */ -/* WRITE (6,*) 'Parenthesis mismatch.' */ -/* END IF */ - -/* $ 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, 29-APR-1988 (WLT) (IMU) */ - -/* -& */ - -/* Local variables */ - - lstr = i_len(str, str_len); - lsub = i_len(sub, sub_len); - i__ = 0; - ret_val = 0; - while(i__ <= lstr - lsub) { - i__1 = i__; - if (s_cmp(str + i__1, sub, i__ + lsub - i__1, sub_len) == 0) { - ++ret_val; - i__ += lsub; - } else { - ++i__; - } - } - return ret_val; -} /* occurs_ */ - diff --git a/ext/spice/src/csupport/pagman.c b/ext/spice/src/csupport/pagman.c deleted file mode 100644 index 38384f3066..0000000000 --- a/ext/spice/src/csupport/pagman.c +++ /dev/null @@ -1,1348 +0,0 @@ -/* pagman.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PAGMAN (Page Manager) */ -/* Subroutine */ int pagman_0_(int n__, char *which, char *line, integer * - value, ftnlen which_len, ftnlen line_len) -{ - /* Initialized data */ - - static integer pagesz = 24; - static logical doprmt = FALSE_; - static logical didpmt = FALSE_; - static integer wfactr = 0; - static char sectn[32] = "BODY "; - static char respns[255] = " " - " " - " " - " " - " "; - static integer pagewd = 80; - static integer freq[5] = { -1,-1,-1,-1,-1 }; - static integer need[5] = { 0,0,0,0,0 }; - static integer size[5] = { 0,0,0,0,0 }; - static integer row = 0; - static integer pageno = 0; - static logical body = TRUE_; - static logical domark = FALSE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - static integer i__; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static char title[255*10]; - extern integer rtrim_(char *, ftnlen); - static char header[255*15]; - static integer pagmln; - static char pagmrk[32]; - static logical keepsp[5], visibl[5]; - static integer qlenth; - static char myline[255], footer[255*10], questn[255]; - extern /* Subroutine */ int nspwln_(char *, ftnlen), prompt_(char *, char - *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine serves as an umbrella for a collection of entry */ -/* points that manage the layout and printing of a series of */ -/* pages of text that may include fixed titles, headers, and */ -/* footers. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WHICH I indicates which section to send lines of text to */ -/* LINE I a line of text */ -/* ATTR I the name of a global page attribute to be set */ -/* VALUE I the value of some global page attribute */ - -/* $ Detailed_Input */ - -/* See the individual entry points for details */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MXWDTH is the width of the page in characters. */ - -/* ROOMH is the number of lines allowed for use in the */ -/* header section of the page. */ - -/* ROOMT is the amount of room allowed for the title section */ -/* of each page. */ - -/* ROOMF is the amount of room allowed for the footer of each */ -/* page. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Files */ - -/* This routine sends lines of output to the routine NSPWLN. */ - -/* $ Particulars */ - -/* By combining the function of the entry points in this routine you */ -/* may create a page having fixed titles, headers, and footers. */ -/* together with a variable body for each page. In addition you may */ -/* insert the current page number in either the title or footer */ -/* portion of each page. In addition you may adjust the size of */ -/* each page and the width of the page. */ - -/* In addition since the IO path has not been selected (you supply */ -/* your own routine for receiving lines for output. You may be able */ -/* to use this routine to build up pages that you may then process */ -/* further adding touches to the output that have not been provided */ -/* here. */ - -/* The capabilities provided are: */ - -/* PAGRST --- sets the page number to zero, and empties all */ -/* sections of the page format. It does not affect the */ -/* global page properties such as the frequency of */ -/* titles, headers and footers, page width and height. */ - -/* PAGSCN --- allows you to set the section to which the next */ -/* lines should be written. */ - -/* PAGSET --- allows you to set page geometry and frequency */ -/* parameters. */ - -/* PAGSMK --- allows you to set the marker that indicates "put the */ -/* current page number here." */ - -/* PAGPUT --- allows you put a line of text on the page. Note */ -/* that the "printing" of title, header and footer */ -/* text is deferred until the first line of text in */ -/* the body is sent to PAGPUT. */ - -/* PAGSFT --- is a soft page reset, the page number is not */ -/* altered but the current page is ended (causing a */ -/* footer to be written if one is to be printed on the */ -/* current page) and then empties the sections */ -/* indicated so that they can be updated with new */ -/* text. */ - -/* PAGPMT --- allows you to determine if the last call to PAGPUT */ -/* caused a prompt to be issued and if so to see what */ -/* the user's response to that prompt was. */ - -/* Note that for a prompt to be issued you must take */ -/* several steps. */ - -/* 1) You must enable prompts through the PAGSET entry */ -/* point. */ - -/* CALL PAGSET ( 'PROMPT', 0 ) */ - -/* 2) You next need to set the prompt that will be used */ -/* This is done with two calls. */ - -/* CALL PAGSCN ( 'PROMPT' ) */ -/* CALL PAGPUT ( 'your prompt value:' ) */ - -/* Having made these preparations, the page manager is */ -/* now ready to issue your prompt and retain the user's */ -/* response when a page is finished. */ - -/* Note that prompts are not issued as a result of */ -/* calling a page reset for (either soft or hard) */ - -/* Also note that once a reset is issued, the prompt */ -/* status is set back to the default value --- No */ -/* Prompts. */ - -/* You might use this routine in conjunction with NICEPR, or TABRPT. */ - -/* A typical useage might go as shown here. */ - -/* First set the basic global attributes of the page and report. */ - -/* CALL PAGSET ( 'PAGEHEIGHT', 60 ) */ -/* CALL PAGSET ( 'PAGEWIDTH', 80 ) */ -/* CALL PAGSET ( 'HEADERFREQUENCY', -1 ) */ -/* CALL PAGSET ( 'TITLEFREQUENCY', 1 ) */ -/* CALL PAGSET ( 'NOSPACEHEADER', 0 ) */ -/* CALL PAGSET ( 'SPACETITLE', 0 ) */ -/* CALL PAGSET ( 'FOOTERFREQUENCY', 1 ) */ -/* CALL PAGSMK ( '#' ) */ -/* CALL PAGRST */ - -/* Create the title that will appear on every page. */ - -/* CALL PAGSCN ( 'TITLE' ) */ -/* CALL PAGPUT ( ' ' ) */ -/* CALL PAGPUT ( 'Results of Test' ) */ -/* CALL PAGPUT ( ' ' ) */ -/* CALL PAGPUT ( ' ' ) */ - -/* Create the footer that will appear on every page. */ - -/* CALL PAGSCN ( 'FOOTER' ) */ -/* CALL PAGPUT ( ' ' ) */ -/* CALL PAGPUT ( ' ' ) */ -/* CALL PAGPUT ( ' Page # ' ) */ -/* CALL PAGPUT ( ' ' ) */ -/* CALL PAGPUT ( ' ' ) */ -/* CALL PAGSCN ( 'BODY' ) */ -/* DO I = 1, NLINES */ -/* CALL PAGPUT ( TEXT(I) ) */ -/* END DO */ -/* CALL PAGSFT */ - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* Since these routines interact by side effect, you should */ -/* read carefully the required reading documentation. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Control the format of output pages */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - -/* The arrays TITLE, HEADER and FOOTER are used to store the */ -/* text that will be written to the TITLE, HEADER and FOOTER */ -/* sections of a page. */ - - -/* The variable RESPNS is used to keep track of any response */ -/* that the user may supply to a prompt that can be triggered */ -/* at the completion of a page. */ - - -/* The variable SECTN contains the name of the section to which */ -/* lines of text should be sent. */ - - -/* The array FREQ is used to store the */ -/* frequency with which footers, headers and titles should */ -/* be displayed PAGESZ and PAGEWD give the size of the page */ -/* in height and width. */ - -/* The array SIZE is used to maintain the */ -/* size of the TITLE, HEADER, BODY, and FOOTER sections. */ - -/* The array NEED is used to determine how many lines */ -/* need to be devoted to the TITLE, HEADER and FOOTER section */ -/* on a page (the value will be a function of FREQ, the page */ -/* number and the array KEEPSP) */ - -/* The array KEEPSP is used to store whether or not sections */ -/* should be kept but presented as white space when the */ -/* page number and frequency imply that the section should */ -/* not be printed on a given page. */ - -/* The array INVIS is used to keep track of whether or not */ -/* a section should be visible on the current page. */ - - -/* The variable ROW points to the position of the last */ -/* row in the body portion of the page where text was last */ -/* written. PAGENO is the page number of the page that is */ -/* currently being filled. */ - - -/* The logical BODY is used to indicate whether the section */ -/* has been set to BODY since the last call to PAGRST to reset */ -/* the dynamic page attributes. */ - - -/* The logical DOPRMT is used to indicate whether or not a prompt */ -/* should be issued when the production of a page is finished. */ - - -/* Loop counter */ - - -/* Saved variables */ - - -/* Initial values */ - - switch(n__) { - case 1: goto L_pagrst; - case 2: goto L_pagsft; - case 3: goto L_pagset; - case 4: goto L_pagsmk; - case 5: goto L_pagscn; - case 6: goto L_pagput; - case 7: goto L_pagpmt; - } - - return 0; -/* $Procedure PAGRST (Page Reset) */ - -L_pagrst: -/* $ Abstract */ - -/* Reset the page to page zero and empty all sections of */ -/* the page. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See the subroutine header */ - -/* $ Exceptions */ - -/* None */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to reset the page manager */ -/* so that it may receive new section information and */ -/* so that the lines of text when output will start on the */ -/* first page of the sequence of pages. */ - -/* This entry point should be called only prior to the beginning */ -/* of a sequence of page productions. */ - -/* A call to this routine always halts production of the current */ -/* page. No cleanup is performed. In particular any footer */ -/* that was waiting to be output, will be elliminated and */ -/* not produced. For this reason it is better to call the */ -/* soft reset PAGSFT (which will output any footers) prior to */ -/* calling this entry point if you have already begun production */ -/* of a document and want the last page of the document */ -/* to be finished prior to beginning a new document. */ - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* See particulars. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ - row = 0; - pageno = 1; - size[1] = 0; - size[2] = 0; - size[0] = 0; - size[4] = 0; - doprmt = FALSE_; - didpmt = FALSE_; - s_copy(respns, " ", (ftnlen)255, (ftnlen)1); - wfactr = 0; - body = FALSE_; - return 0; -/* $Procedure PAGSFT (Page Soft Reset) */ - -L_pagsft: -/* $ Abstract */ - -/* Finish production of the current page, and empty all section */ -/* of the page. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See the subroutine header */ - -/* $ Exceptions */ - -/* None */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to reset the page manager */ -/* so that a new style (header, title and footer, etc). */ - -/* The page number is not altered. */ - -/* This entry point differs from PAGRST in that it cleanly */ -/* finished the current page. This routine should typically */ -/* be called after the last body text line has been sent to */ -/* the PAGE MANAGER. */ - -/* To perform a complet reset, call the entry point PAGRST. */ - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* See particulars. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ - if (row > 0) { - s_copy(myline, " ", (ftnlen)255, (ftnlen)1); - while(row < size[3]) { - nspwln_(myline, pagewd); - ++row; - } - -/* The user may want to have the page number appear */ -/* in the footer. So we replace the PAGMRK by the */ -/* number if this is the case. */ - - i__1 = need[2]; - for (i__ = 1; i__ <= i__1; ++i__) { - if (visibl[2]) { - repmi_(footer + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : - s_rnge("footer", i__2, "pagman_", (ftnlen)582)) * 255, - pagmrk, &pageno, myline, (ftnlen)255, (ftnlen)32, ( - ftnlen)255); - nspwln_(myline, pagewd); - } else { - nspwln_(myline, pagewd); - } - } - ++pageno; - } - row = 0; - size[1] = 0; - size[2] = 0; - size[0] = 0; - size[4] = 0; - doprmt = FALSE_; - didpmt = FALSE_; - s_copy(respns, " ", (ftnlen)255, (ftnlen)1); - wfactr = 0; - body = FALSE_; - return 0; -/* $Procedure PAGSET (Page Set attributes ) */ - -L_pagset: -/* $ Abstract */ - -/* Set one of the global page attributes */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ - -/* CHARACTER*(*) WHICH */ -/* INTEGER VALUE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WHICH I indicates which attribute to set */ -/* VALUE I the value of the attribute */ - -/* $ Detailed_Input */ - -/* WHICH is the name of some attribute to set. The acceptable */ -/* values are: PAGEWIDTH, PAGEHEIGHT, HEADERFREQUENCY, */ -/* TITLEFREQUENCY, SPACETITLE, NOSPACETITLE, SPACEHEADER */ -/* NOSPACEHEADER, SPACEFOOTER, NOSPACEFOOTER. */ - -/* VALUE is the value to assign to one of the page attributes. */ -/* In the case of any of the frequency attributes the */ -/* values carry the following implication: If the */ -/* frequency is less than zero, that section never */ -/* appears in the page. If the frequency is 0, that */ -/* section appears on the first page. However it does */ -/* not appear on any other pages. If the frequency is N */ -/* > 0 then the section appears on the first page and */ -/* every page of the form 1 + K*N where K is a positive */ -/* integer. */ - -/* The values supplied for the SPACE/NOSPACE WAIT/NOWAIT */ -/* attributes are ignored. The text of WHICH is used to */ -/* determine if blank lines should be used in place of */ -/* the text of the section it is not supposed to appear */ -/* in output. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See the subroutine header */ - -/* $ Exceptions */ - -/* If one of the recognized values for WHICH is not entered the state */ -/* of the page manager will not change. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* It is intended that this routine be called to set up the page */ -/* manager prior to the productio of pages. However, user's may */ -/* call this routine to change page attributes at any time. */ -/* Nevertheless, due to the method by which pages are produced, the */ -/* affects of a call to this routine may be delayed. Once the body */ -/* of a new page has begun, all attributes but PAGEWIDTH are ignored */ -/* until the page has been completed according to the attributes */ -/* that were in effect when the body section of the page was begun. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ - if (s_cmp(which, "PAGEHEIGHT", which_len, (ftnlen)10) == 0) { - pagesz = *value; - } else if (s_cmp(which, "PAGEWIDTH", which_len, (ftnlen)9) == 0) { - pagewd = *value; - } else if (s_cmp(which, "HEADERFREQUENCY", which_len, (ftnlen)15) == 0) { - freq[1] = *value; - } else if (s_cmp(which, "TITLEFREQUENCY", which_len, (ftnlen)14) == 0) { - freq[0] = *value; - } else if (s_cmp(which, "FOOTERFREQUENCY", which_len, (ftnlen)15) == 0) { - freq[2] = *value; - } else if (s_cmp(which, "SPACETITLE", which_len, (ftnlen)10) == 0) { - keepsp[0] = TRUE_; - } else if (s_cmp(which, "NOSPACETITLE", which_len, (ftnlen)12) == 0) { - keepsp[0] = FALSE_; - } else if (s_cmp(which, "SPACEHEADER", which_len, (ftnlen)11) == 0) { - keepsp[1] = TRUE_; - } else if (s_cmp(which, "NOSPACEHEADER", which_len, (ftnlen)13) == 0) { - keepsp[1] = FALSE_; - } else if (s_cmp(which, "SPACEFOOTER", which_len, (ftnlen)11) == 0) { - keepsp[2] = TRUE_; - } else if (s_cmp(which, "NOSPACEFOOTER", which_len, (ftnlen)13) == 0) { - keepsp[2] = FALSE_; - } else if (s_cmp(which, "NOPAGEMARK", which_len, (ftnlen)10) == 0) { - domark = FALSE_; - } else if (s_cmp(which, "DOPAGEMARK", which_len, (ftnlen)10) == 0) { - domark = TRUE_; - } else if (s_cmp(which, "PROMPT", which_len, (ftnlen)6) == 0) { - doprmt = TRUE_; - wfactr = 1; - size[4] = 1; - } else if (s_cmp(which, "NOPROMPT", which_len, (ftnlen)8) == 0) { - doprmt = FALSE_; - didpmt = FALSE_; - s_copy(respns, " ", (ftnlen)255, (ftnlen)1); - wfactr = 0; - size[4] = 0; - } - return 0; -/* $Procedure PAGSMK (Page set page number marker ) */ - -L_pagsmk: -/* $ Abstract */ - -/* Set the mark that will be replaced by the current page number */ -/* within the title and footer sections of a page. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ - -/* None. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WHICH I mark to be replaced by current page number */ - -/* $ Detailed_Input */ - -/* WHICH is a string which when encountered as a substring */ -/* of a line of text in either the title or footer */ -/* section will be replaced by the current page number. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See the subroutine header */ - -/* $ Exceptions */ - -/* None */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to set the "mark" that */ -/* the page manager will recognize as the position to */ -/* fill in the current page number in either the title */ -/* or footer section of a page. It has no effect in the */ -/* HEADER or BODY section of the document. */ - -/* Usually you will want to set the page number mark at the */ -/* beginning of a document and leave this unchanged throughout */ -/* the production of the document. */ - -/* The effect of a call to PAGSMK will begin on the next call */ -/* to PAGPUT. */ - - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* See particulars. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ - s_copy(pagmrk, which, (ftnlen)32, which_len); - pagmln = rtrim_(pagmrk, (ftnlen)32); - domark = TRUE_; - return 0; -/* $Procedure PAGSCN (Page Section) */ - -L_pagscn: -/* $ Abstract */ - -/* Set the section to which lines should be sent. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ - -/* CHARACTER*(*) WHICH */ -/* CHARACTER*(*) LINE */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* WHICH I indicates which section to send lines of text to */ - -/* $ Detailed_Input */ - -/* WHICH the section to which lines will be sent by */ -/* the entry point PAGPUT. Valid choices for */ -/* WHICH are 'TITLE', 'HEADER', 'FOOTER' and 'BODY'. */ -/* The routine is case sensitive. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See the subroutine header */ - -/* $ Exceptions */ - -/* If one of the recognized values is not entered, calls */ -/* to PAGPUT will have no effect. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* None. */ - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ - s_copy(sectn, which, (ftnlen)32, which_len); - body = s_cmp(sectn, "BODY", (ftnlen)32, (ftnlen)4) == 0; - return 0; -/* $Procedure PAGPUT (Page put a line of text ) */ - -L_pagput: -/* $ Abstract */ - -/* Put a line of text in the current section of the current */ -/* page. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* OUTPUT */ -/* TEXT */ -/* FORMATTING */ - -/* $ Declarations */ - -/* CHARACTER*(*) LINE */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LINE I a line of text to put on the current page */ - -/* $ Detailed_Input */ - -/* LINE is a line of text that should be output (eventually) */ -/* via the routine NSPWLN. */ - - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* See the subroutine header */ - -/* $ Exceptions */ - -/* None */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used prepare a line of text for output. */ -/* Whether the text is sent immediately to NSPWLN or is defered */ -/* depends upon which section is currently active. */ - -/* If the current section is the TITLE, HEADER or FOOTER section */ -/* the line of text is simply buffered and output is defered */ -/* until the appropriate line of the body of the page is */ -/* output. */ - -/* If the current section if BODY, the line will be output */ -/* in the appropriate order along with any of the TITLE, */ -/* HEADER and FOOTER sections that should be output along with */ -/* it. */ - -/* The calling program should ensure that if sections other than */ -/* the BODY section are to be written, that their text be */ -/* established prior to calling this entry point when the body */ -/* section is active. */ - -/* $ Examples */ - -/* See above. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 9-JAN-1992 (WLT) */ - -/* -& */ - -/* We handle the TITLE, HEADER and FOOTER sections first. */ - - didpmt = FALSE_; - if (! body) { - if (s_cmp(sectn, "TITLE", (ftnlen)32, (ftnlen)5) == 0) { -/* Computing MIN */ - i__1 = 10, i__2 = size[0] + 1; - size[0] = min(i__1,i__2); - s_copy(title + ((i__1 = size[0] - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("title", i__1, "pagman_", (ftnlen)1067)) * 255, - line, (ftnlen)255, line_len); - } else if (s_cmp(sectn, "HEADER", (ftnlen)32, (ftnlen)6) == 0) { -/* Computing MIN */ - i__1 = 15, i__2 = size[1] + 1; - size[1] = min(i__1,i__2); - s_copy(header + ((i__1 = size[1] - 1) < 15 && 0 <= i__1 ? i__1 : - s_rnge("header", i__1, "pagman_", (ftnlen)1072)) * 255, - line, (ftnlen)255, line_len); - } else if (s_cmp(sectn, "FOOTER", (ftnlen)32, (ftnlen)6) == 0) { -/* Computing MIN */ - i__1 = 10, i__2 = size[2] + 1; - size[2] = min(i__1,i__2); - s_copy(footer + ((i__1 = size[2] - 1) < 10 && 0 <= i__1 ? i__1 : - s_rnge("footer", i__1, "pagman_", (ftnlen)1077)) * 255, - line, (ftnlen)255, line_len); - } else if (s_cmp(sectn, "PROMPT", (ftnlen)32, (ftnlen)6) == 0) { - size[4] = 1; - s_copy(questn, line, (ftnlen)255, line_len); - qlenth = rtrim_(line, line_len) + 1; - } - return 0; - } - -/* The only way to get to this point is if we are working on */ -/* the body section of a page. If the row number is zero, then */ -/* we need to see how much room is available on this page for */ -/* the body. And, if appropriate output the TITLE and */ -/* HEADER sections of this page. */ - - if (row == 0) { - -/* We need to compute how much room is available */ -/* for the body of this page. */ - - for (i__ = 1; i__ <= 3; ++i__) { - -/* First determine how much room is needed for */ -/* this section and whether or not it will be */ -/* visible on this page if we simply fill it with */ -/* blanks. */ - - if (freq[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("freq", - i__1, "pagman_", (ftnlen)1109)] < 0) { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1110)] = 0; - visibl[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "visibl", i__1, "pagman_", (ftnlen)1111)] = FALSE_; - } else if (pageno == 1) { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1113)] = size[(i__2 = i__ - - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("size", i__2, - "pagman_", (ftnlen)1113)]; - visibl[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "visibl", i__1, "pagman_", (ftnlen)1114)] = TRUE_; - } else if (freq[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "freq", i__1, "pagman_", (ftnlen)1115)] == 0) { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1116)] = 0; - visibl[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "visibl", i__1, "pagman_", (ftnlen)1117)] = TRUE_; - } else if (freq[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "freq", i__1, "pagman_", (ftnlen)1118)] == 1) { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1119)] = size[(i__2 = i__ - - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("size", i__2, - "pagman_", (ftnlen)1119)]; - visibl[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "visibl", i__1, "pagman_", (ftnlen)1120)] = TRUE_; - } else if (pageno % freq[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 - : s_rnge("freq", i__1, "pagman_", (ftnlen)1121)] == 1) { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1122)] = size[(i__2 = i__ - - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("size", i__2, - "pagman_", (ftnlen)1122)]; - visibl[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "visibl", i__1, "pagman_", (ftnlen)1123)] = TRUE_; - } else { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1125)] = 0; - visibl[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "visibl", i__1, "pagman_", (ftnlen)1126)] = TRUE_; - } - if (keepsp[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge( - "keepsp", i__1, "pagman_", (ftnlen)1129)]) { - need[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("need", - i__1, "pagman_", (ftnlen)1130)] = size[(i__2 = i__ - - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("size", i__2, - "pagman_", (ftnlen)1130)]; - } - } - size[3] = pagesz - need[0] - need[1] - need[2] - wfactr * size[4]; - -/* We haven't yet written a line in the body of the */ -/* page, we will write out the title and header sections */ -/* (provided we are on the right page number) */ - -/* We allow for the possibility that the user might */ -/* place the page number in the title section. */ - - s_copy(myline, " ", (ftnlen)255, (ftnlen)1); - i__1 = need[0]; - for (i__ = 1; i__ <= i__1; ++i__) { - if (visibl[0]) { - if (domark) { - repmi_(title + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 - : s_rnge("title", i__2, "pagman_", (ftnlen)1150)) - * 255, pagmrk, &pageno, myline, (ftnlen)255, - pagmln, (ftnlen)255); - nspwln_(myline, pagewd); - } else { - nspwln_(title + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("title", i__2, "pagman_", (ftnlen) - 1154)) * 255, pagewd); - } - } else { - nspwln_(myline, pagewd); - } - } - -/* Next output whatever portion of the header section is */ -/* appropriate. */ - - s_copy(myline, " ", (ftnlen)255, (ftnlen)1); - i__1 = need[1]; - for (i__ = 1; i__ <= i__1; ++i__) { - if (visibl[1]) { - nspwln_(header + ((i__2 = i__ - 1) < 15 && 0 <= i__2 ? i__2 : - s_rnge("header", i__2, "pagman_", (ftnlen)1169)) * - 255, pagewd); - } else { - nspwln_(myline, pagewd); - } - } - } - -/* Write the line and update the number of lines we */ -/* have written so far. */ - - ++row; - s_copy(myline, line, (ftnlen)255, line_len); - nspwln_(myline, pagewd); - -/* If we reached the end of the body section, write out */ -/* the footer (provided we are on the right page). And */ -/* update the page number. */ - - if (row == size[3]) { - -/* The user may want to have the page number appear */ -/* in the footer. So we replace the PAGMRK by the */ -/* number if this is the case. */ - - s_copy(myline, " ", (ftnlen)255, (ftnlen)1); - i__1 = need[2]; - for (i__ = 1; i__ <= i__1; ++i__) { - if (visibl[2]) { - if (domark) { - repmi_(footer + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("footer", i__2, "pagman_", (ftnlen) - 1201)) * 255, pagmrk, &pageno, myline, (ftnlen) - 255, pagmln, (ftnlen)255); - nspwln_(myline, pagewd); - } else { - nspwln_(footer + ((i__2 = i__ - 1) < 10 && 0 <= i__2 ? - i__2 : s_rnge("footer", i__2, "pagman_", (ftnlen) - 1205)) * 255, pagewd); - } - } else { - nspwln_(myline, pagewd); - } - } - -/* Advance the page number and reset the row to zero. */ -/* (we won't have written anything in the body of the */ -/* next page until later.) */ - - ++pageno; - row = 0; - if (doprmt) { - prompt_(questn, respns, qlenth, (ftnlen)255); - didpmt = TRUE_; - } - } - return 0; -/* $Procedure PAGPMT ( Page prompt returned ) */ - -L_pagpmt: -/* $ Abstract */ - -/* Determine if a prompt issued and a value returned on the last */ -/* call to PAGPUT. */ - -/* $ 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 */ - -/* PAGE MANAGER */ - -/* $ Declarations */ - -/* INTEGER VALUE */ -/* CHARACTER*(*) LINE */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* VALUE O 1 if a prompt was entered, 0 otherwise. */ -/* LINE O The value of the prompt supplied */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* VALUE is an integer indicating whether or not a prompt was */ -/* displayed and a value returned. If no prompt was */ -/* issued on the last call to PAGPUT, VALUE will have the */ -/* value zero. Otherwise VALUE will have some non-zero */ -/* value. */ - -/* LINE is the value of the prompt returned if there was one. */ -/* Otherwise a blank is returned. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This entry point returns information about what happened in the */ -/* last call to PAGPUT. If a page was finished and a prompt was */ -/* displayed and the user responded, this routine will return two */ -/* a non-zero integer for VALUE and will place the results of the */ -/* prompt in the string LINE. */ - -/* Note that this routine will return the same results until some */ -/* call to PAGPUT is made again. */ - -/* $ Examples */ - -/* Suppose that you are using the page manager to send output */ -/* to some device. But that you want to allow the user to */ -/* pause in the course of sending the output. The following */ -/* illustrates how you would do this. */ - -/* CALL getnext ( LINE, MORE ) */ - -/* DO WHILE ( MORE ) */ - -/* CALL PAGPUT ( LINE ) */ -/* CALL PAGPMT ( VALUE, RESPNS ) */ - -/* IF ( VALUE .NE. 0 ) */ - -/* take some action concerning RESPNS */ - -/* END IF */ - -/* CALL getnext ( LINE, MORE ) */ - -/* END DO */ - - - -/* Alternatively you might like to just have the page manager */ -/* wait for the user after a page has been finished. To do this */ -/* you could set things up as follows. */ - -/* CALL PAGSET ( 'PROMPT', 0 ) */ -/* CALL PAGSCN ( 'PROMPT' ) */ -/* CALL PAGPUT ( '(Hit Return to Continue) >' */ - -/* CALL getnext ( LINE, MORE ) */ - -/* DO WHILE ( MORE ) */ - -/* CALL PAGPUT ( LINE ) */ -/* CALL getnext ( LINE, MORE ) */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 16-AUG-1995 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* See if the last line sent resulted in a prompt */ - -/* -& */ - if (didpmt) { - *value = 1; - s_copy(line, respns, line_len, (ftnlen)255); - } else { - *value = 0; - s_copy(line, " ", line_len, (ftnlen)1); - } - return 0; -} /* pagman_ */ - -/* Subroutine */ int pagman_(char *which, char *line, integer *value, ftnlen - which_len, ftnlen line_len) -{ - return pagman_0_(0, which, line, value, which_len, line_len); - } - -/* Subroutine */ int pagrst_(void) -{ - return pagman_0_(1, (char *)0, (char *)0, (integer *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int pagsft_(void) -{ - return pagman_0_(2, (char *)0, (char *)0, (integer *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int pagset_(char *which, integer *value, ftnlen which_len) -{ - return pagman_0_(3, which, (char *)0, value, which_len, (ftnint)0); - } - -/* Subroutine */ int pagsmk_(char *which, ftnlen which_len) -{ - return pagman_0_(4, which, (char *)0, (integer *)0, which_len, (ftnint)0); - } - -/* Subroutine */ int pagscn_(char *which, ftnlen which_len) -{ - return pagman_0_(5, which, (char *)0, (integer *)0, which_len, (ftnint)0); - } - -/* Subroutine */ int pagput_(char *line, ftnlen line_len) -{ - return pagman_0_(6, (char *)0, line, (integer *)0, (ftnint)0, line_len); - } - -/* Subroutine */ int pagpmt_(integer *value, char *line, ftnlen line_len) -{ - return pagman_0_(7, (char *)0, line, value, (ftnint)0, line_len); - } - diff --git a/ext/spice/src/csupport/pltfrm.c b/ext/spice/src/csupport/pltfrm.c deleted file mode 100644 index 3d244a842a..0000000000 --- a/ext/spice/src/csupport/pltfrm.c +++ /dev/null @@ -1,202 +0,0 @@ -/* pltfrm.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PLTFRM ( Get platform attributes ) */ -/* Subroutine */ int pltfrm_(integer *room, integer *n, char *attr, ftnlen - attr_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char item[32*3]; - extern /* Subroutine */ int zzplatfm_(char *, char *, ftnlen, ftnlen); - integer i__, limit; - -/* ~ NEXT */ -/* * IMPLICIT NONE */ -/* ~~ */ -/* $ Abstract */ - -/* Return platform id and various attributes of the platform */ -/* environment */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* ROOM I amount of room available for returning attributes */ -/* N O number of attributes returned */ -/* ATTR O string values of various attributes */ - -/* $ Detailed_Input */ - -/* ROOM is the amount of space available in the character */ -/* string array ATTR for returning platform attributes. */ - -/* $ Detailed_Output */ - -/* N is the actual number of attributes returned. N will */ -/* always be less than or equal to ROOM. */ - -/* ATTR is an array of attributes about the platform */ -/* and environment on which this routine is running. */ - -/* ATTR will contain in the following order */ - -/* 1) machine name : HP, NEXT, PC, SGI, etc. */ -/* 2) fortran compiler: HP , ABSOFT, etc. */ -/* 3) Operating System */ - -/* Other items may be added later. Check your local */ -/* listing for details. */ - -/* If a value is not available it will be returned */ -/* with the value '' */ - -/* The routine that calls this should declare */ -/* ATTR to be at least CHARACTER*(32). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If ROOM is less than or equal to zero, the N will be */ -/* returned with a value of zero and ATTR will not be */ -/* changed from it's input state. */ - -/* $ Particulars */ - -/* This routine serves to identify the platforma and compiler */ -/* used in creating SPICELIB. It is provided so that routines */ -/* and programs can make run-time decisions based upon the */ -/* ambient fortran environment. */ - -/* $ Examples */ - -/* This routine could be used so that a single routine */ -/* can be written that translates the meaning of IOSTAT values */ -/* that depend upon the machine and compiler. At run time */ -/* the routine can look up the appropriate message to associate */ -/* with an IOSTAT value. */ -/* C */ -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - Support Version 1.4.0, 28-JUL-1999 (WLT) */ - -/* Changed routine to call new SPICE private routine ZZPLATFM */ -/* The routine is no longer environment specific. */ - -/* - Inspekt Version 1.3.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - Inspekt Version 1.3.0, 05-APR-1998 (NJB) */ - -/* Added the PC-LINUX environment. */ - -/* - Inspekt Version 1.2.0, 12-AUG-1996 (WLT) */ - -/* Added the DEC-OSF1 environment. */ - -/* - Inspekt Version 1.1.0, 16-JUN-1995 (WLT) */ - -/* Master version of original machine dependent collection. */ -/* Copyright notice added. */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 21-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Determine the machine, OS and fortran version. */ - -/* -& */ - s_copy(item, "SYSTEM", (ftnlen)32, (ftnlen)6); - s_copy(item + 32, "COMPILER", (ftnlen)32, (ftnlen)8); - s_copy(item + 64, "O/S", (ftnlen)32, (ftnlen)3); -/* Computing MAX */ - i__1 = 0, i__2 = min(3,*room); - limit = max(i__1,i__2); - i__1 = limit; - for (i__ = 1; i__ <= i__1; ++i__) { - zzplatfm_(item + (((i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "item", i__2, "pltfrm_", (ftnlen)194)) << 5), attr + (i__ - 1) - * attr_len, (ftnlen)32, attr_len); - } - *n = limit; - return 0; -} /* pltfrm_ */ - diff --git a/ext/spice/src/csupport/podaec.c b/ext/spice/src/csupport/podaec.c deleted file mode 100644 index f6deb33253..0000000000 --- a/ext/spice/src/csupport/podaec.c +++ /dev/null @@ -1,204 +0,0 @@ -/* podaec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODAEC ( Pod, append elements, character ) */ -/* Subroutine */ int podaec_(char *elems, integer *n, char *pod, ftnlen - elems_len, ftnlen pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Append elements to the active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELEMS I New elements. */ -/* N I Number of new elements. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* ELEMS contains elements to be appended to the active group */ -/* of POD. */ - -/* N is the number of elements in ELEMS. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which ends with the new elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ -/* $ */ -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If there is insufficient room in the pod to append all */ -/* ofthe new elements, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a slightly more general version of APPND, which appends */ -/* a single item to a cell or to the active group of a pod. PODAE */ -/* allows you to append several items with a single subroutine call. */ - -/* $ Examples */ - -/* Elements can be appended to a POD by hand, */ - -/* END = CARDC ( POD ) */ - -/* DO I = 1, N */ -/* POD(END+I) = ELEMS(I) */ -/* END DO */ - -/* CALL SCARDC ( END + N, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for possible overflow. PODAE accomplishes the same thing, */ - -/* CALL PODAEC ( ELEMS, N, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODAEC", (ftnlen)6); - } - -/* We can't append a non-positive number of items. */ - - if (*n < 1) { - chkout_("PODAEC", (ftnlen)6); - return 0; - } - -/* First see if there is room in the pod to append N elements. */ -/* If not, bail out. */ - - if (sizec_(pod, pod_len) < cardc_(pod, pod_len) + *n) { - setmsg_("Cannot fit # elements into # spaces.", (ftnlen)36); - errint_("#", n, (ftnlen)1); - i__1 = sizec_(pod, pod_len) - cardc_(pod, pod_len); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - -/* There is ample room, so we find out where the end of the */ -/* active group is and simply loop through the individual */ -/* copies of ELEMS, adjusting the cardinality afterwards. */ -/* (Just like in $Examples, above.) */ - - } else { - end = cardc_(pod, pod_len); - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(pod + (end + i__ + 5) * pod_len, elems + (i__ - 1) * - elems_len, pod_len, elems_len); - } - i__1 = end + *n; - scardc_(&i__1, pod, pod_len); - } - chkout_("PODAEC", (ftnlen)6); - return 0; -} /* podaec_ */ - diff --git a/ext/spice/src/csupport/podaed.c b/ext/spice/src/csupport/podaed.c deleted file mode 100644 index ea04b0c43a..0000000000 --- a/ext/spice/src/csupport/podaed.c +++ /dev/null @@ -1,204 +0,0 @@ -/* podaed.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODAED ( Pod, append elements, double precision ) */ -/* Subroutine */ int podaed_(doublereal *elems, integer *n, doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Append elements to the active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELEMS I New elements. */ -/* N I Number of new elements. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* ELEMS contains elements to be appended to the active group */ -/* of POD. */ - -/* N is the number of elements in ELEMS. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which ends with the new elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ -/* $ */ -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If there is insufficient room in the pod to append all */ -/* ofthe new elements, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a slightly more general version of APPND, which appends */ -/* a single item to a cell or to the active group of a pod. PODAE */ -/* allows you to append several items with a single subroutine call. */ - -/* $ Examples */ - -/* Elements can be appended to a POD by hand, */ - -/* END = CARDD ( POD ) */ - -/* DO I = 1, N */ -/* POD(END+I) = ELEMS(I) */ -/* END DO */ - -/* CALL SCARDD ( END + N, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for possible overflow. PODAE accomplishes the same thing, */ - -/* CALL PODAED ( ELEMS, N, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SUPPORT Version 1.1.0, 24-DEC-2001 (NJB) */ - -/* Bug fix: END is now intialized before use in */ -/* constructing error message. */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODAED", (ftnlen)6); - } - -/* We can't append a non-positive number of items. */ - - if (*n < 1) { - chkout_("PODAED", (ftnlen)6); - return 0; - } - -/* First see if there is room in the pod to append N elements. */ -/* If not, bail out. */ - - end = cardd_(pod); - if (sized_(pod) < end + *n) { - setmsg_("Cannot fit # elements into # spaces.", (ftnlen)36); - errint_("#", n, (ftnlen)1); - i__1 = sized_(pod) - end; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - -/* There is ample room, so we find out where the end of the */ -/* active group is and simply loop through the individual */ -/* copies of ELEMS, adjusting the cardinality afterwards. */ -/* (Just like in $Examples, above.) */ - - } else { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - pod[end + i__ + 5] = elems[i__ - 1]; - } - i__1 = end + *n; - scardd_(&i__1, pod); - } - chkout_("PODAED", (ftnlen)6); - return 0; -} /* podaed_ */ - diff --git a/ext/spice/src/csupport/podaei.c b/ext/spice/src/csupport/podaei.c deleted file mode 100644 index a287da7f1b..0000000000 --- a/ext/spice/src/csupport/podaei.c +++ /dev/null @@ -1,204 +0,0 @@ -/* podaei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODAEI ( Pod, append elements, integer ) */ -/* Subroutine */ int podaei_(integer *elems, integer *n, integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), - errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Append elements to the active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELEMS I New elements. */ -/* N I Number of new elements. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* ELEMS contains elements to be appended to the active group */ -/* of POD. */ - -/* N is the number of elements in ELEMS. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which ends with the new elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ -/* $ */ -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If there is insufficient room in the pod to append all */ -/* ofthe new elements, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This is a slightly more general version of APPND, which appends */ -/* a single item to a cell or to the active group of a pod. PODAE */ -/* allows you to append several items with a single subroutine call. */ - -/* $ Examples */ - -/* Elements can be appended to a POD by hand, */ - -/* END = CARDI ( POD ) */ - -/* DO I = 1, N */ -/* POD(END+I) = ELEMS(I) */ -/* END DO */ - -/* CALL SCARDI ( END + N, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for possible overflow. PODAE accomplishes the same thing, */ - -/* CALL PODAEI ( ELEMS, N, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - SUPPORT Version 1.1.0, 24-DEC-2001 (NJB) */ - -/* Bug fix: END is now intialized before use in */ -/* constructing error message. */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODAEI", (ftnlen)6); - } - -/* We can't append a non-positive number of items. */ - - if (*n < 1) { - chkout_("PODAEI", (ftnlen)6); - return 0; - } - -/* First see if there is room in the pod to append N elements. */ -/* If not, bail out. */ - - end = cardi_(pod); - if (sizei_(pod) < end + *n) { - setmsg_("Cannot fit # elements into # spaces.", (ftnlen)36); - errint_("#", n, (ftnlen)1); - i__1 = sizei_(pod) - end; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - -/* There is ample room, so we find out where the end of the */ -/* active group is and simply loop through the individual */ -/* copies of ELEMS, adjusting the cardinality afterwards. */ -/* (Just like in $Examples, above.) */ - - } else { - i__1 = *n; - for (i__ = 1; i__ <= i__1; ++i__) { - pod[end + i__ + 5] = elems[i__ - 1]; - } - i__1 = end + *n; - scardi_(&i__1, pod); - } - chkout_("PODAEI", (ftnlen)6); - return 0; -} /* podaei_ */ - diff --git a/ext/spice/src/csupport/podbec.c b/ext/spice/src/csupport/podbec.c deleted file mode 100644 index 54da3eb107..0000000000 --- a/ext/spice/src/csupport/podbec.c +++ /dev/null @@ -1,169 +0,0 @@ -/* podbec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODBEC ( Pod, begin and end, character ) */ -/* Subroutine */ int podbec_(char *pod, integer *begin, integer *end, ftnlen - pod_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), podonc_(char *, - integer *, integer *, ftnlen); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the indices of the initial and final elements of the */ -/* active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I Pod. */ -/* BEGIN O Index of initial item of active group of POD. */ -/* END O Index of final item of active group of POD. */ - -/* $ Detailed_Input */ - -/* POD is a pod. */ - -/* $ Detailed_Output */ - -/* BEGIN, */ -/* END are the indices of the initial and final elements of */ -/* the active group of POD. That is, the active group */ -/* is located in POD(BEGIN), POD(BEGIN+1), ..., POD(END). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group of the pod contains no elements, */ -/* END is equal to (BEGIN - 1). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* PODBE (begin and end) and PODON (offset and number) provide */ -/* equivalent ways to access the elements of the active group */ -/* of a pod. Note that there is no way to access any group other */ -/* than the active group. */ - -/* $ Examples */ - -/* PODBE is typically used to process the elements of the active */ -/* group of a pod one at a time, e.g., */ - -/* CALL PODBEC ( POD, BEGIN, END ) */ - -/* DO I = BEGIN, END */ -/* CALL PROCESS ( ..., POD(I), ... ) */ -/* END DO */ - -/* Note that if the elements are to be correlated with the elements */ -/* of other arrays, PODON may be more convenient: */ - -/* CALL PODONC ( POD, OFFSET, N ) */ - -/* DO I = 1, N */ -/* CALL PROCESS ( ..., POD(OFFSET+I), ARRAY(I), ... ) */ -/* END DO */ - -/* Either one may be used when the group is to be passed to a */ -/* subprogram as an array: */ - -/* CALL SUBPROG ( ..., POD(BEGIN), END-BEGIN+1, ... ) */ -/* CALL SUBPROG ( ..., POD(OFFSET+1), N, ... ) */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODBEC", (ftnlen)6); - } - -/* We'll cheat: why write the same code twice? */ - - podonc_(pod, &offset, &number, pod_len); - *begin = offset + 1; - *end = offset + number; - chkout_("PODBEC", (ftnlen)6); - return 0; -} /* podbec_ */ - diff --git a/ext/spice/src/csupport/podbed.c b/ext/spice/src/csupport/podbed.c deleted file mode 100644 index f5a55c8e9b..0000000000 --- a/ext/spice/src/csupport/podbed.c +++ /dev/null @@ -1,168 +0,0 @@ -/* podbed.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODBED ( Pod, begin and end, double precision ) */ -/* Subroutine */ int podbed_(doublereal *pod, integer *begin, integer *end) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), podond_(doublereal *, - integer *, integer *); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the indices of the initial and final elements of the */ -/* active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I Pod. */ -/* BEGIN O Index of initial item of active group of POD. */ -/* END O Index of final item of active group of POD. */ - -/* $ Detailed_Input */ - -/* POD is a pod. */ - -/* $ Detailed_Output */ - -/* BEGIN, */ -/* END are the indices of the initial and final elements of */ -/* the active group of POD. That is, the active group */ -/* is located in POD(BEGIN), POD(BEGIN+1), ..., POD(END). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group of the pod contains no elements, */ -/* END is equal to (BEGIN - 1). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* PODBE (begin and end) and PODON (offset and number) provide */ -/* equivalent ways to access the elements of the active group */ -/* of a pod. Note that there is no way to access any group other */ -/* than the active group. */ - -/* $ Examples */ - -/* PODBE is typically used to process the elements of the active */ -/* group of a pod one at a time, e.g., */ - -/* CALL PODBED ( POD, BEGIN, END ) */ - -/* DO I = BEGIN, END */ -/* CALL PROCESS ( ..., POD(I), ... ) */ -/* END DO */ - -/* Note that if the elements are to be correlated with the elements */ -/* of other arrays, PODON may be more convenient: */ - -/* CALL PODOND ( POD, OFFSET, N ) */ - -/* DO I = 1, N */ -/* CALL PROCESS ( ..., POD(OFFSET+I), ARRAY(I), ... ) */ -/* END DO */ - -/* Either one may be used when the group is to be passed to a */ -/* subprogram as an array: */ - -/* CALL SUBPROG ( ..., POD(BEGIN), END-BEGIN+1, ... ) */ -/* CALL SUBPROG ( ..., POD(OFFSET+1), N, ... ) */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODBED", (ftnlen)6); - } - -/* We'll cheat: why write the same code twice? */ - - podond_(pod, &offset, &number); - *begin = offset + 1; - *end = offset + number; - chkout_("PODBED", (ftnlen)6); - return 0; -} /* podbed_ */ - diff --git a/ext/spice/src/csupport/podbei.c b/ext/spice/src/csupport/podbei.c deleted file mode 100644 index 7afb515f91..0000000000 --- a/ext/spice/src/csupport/podbei.c +++ /dev/null @@ -1,168 +0,0 @@ -/* podbei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODBEI ( Pod, begin and end, integer ) */ -/* Subroutine */ int podbei_(integer *pod, integer *begin, integer *end) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the indices of the initial and final elements of the */ -/* active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I Pod. */ -/* BEGIN O Index of initial item of active group of POD. */ -/* END O Index of final item of active group of POD. */ - -/* $ Detailed_Input */ - -/* POD is a pod. */ - -/* $ Detailed_Output */ - -/* BEGIN, */ -/* END are the indices of the initial and final elements of */ -/* the active group of POD. That is, the active group */ -/* is located in POD(BEGIN), POD(BEGIN+1), ..., POD(END). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group of the pod contains no elements, */ -/* END is equal to (BEGIN - 1). */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* PODBE (begin and end) and PODON (offset and number) provide */ -/* equivalent ways to access the elements of the active group */ -/* of a pod. Note that there is no way to access any group other */ -/* than the active group. */ - -/* $ Examples */ - -/* PODBE is typically used to process the elements of the active */ -/* group of a pod one at a time, e.g., */ - -/* CALL PODBEI ( POD, BEGIN, END ) */ - -/* DO I = BEGIN, END */ -/* CALL PROCESS ( ..., POD(I), ... ) */ -/* END DO */ - -/* Note that if the elements are to be correlated with the elements */ -/* of other arrays, PODON may be more convenient: */ - -/* CALL PODONI ( POD, OFFSET, N ) */ - -/* DO I = 1, N */ -/* CALL PROCESS ( ..., POD(OFFSET+I), ARRAY(I), ... ) */ -/* END DO */ - -/* Either one may be used when the group is to be passed to a */ -/* subprogram as an array: */ - -/* CALL SUBPROG ( ..., POD(BEGIN), END-BEGIN+1, ... ) */ -/* CALL SUBPROG ( ..., POD(OFFSET+1), N, ... ) */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODBEI", (ftnlen)6); - } - -/* We'll cheat: why write the same code twice? */ - - podoni_(pod, &offset, &number); - *begin = offset + 1; - *end = offset + number; - chkout_("PODBEI", (ftnlen)6); - return 0; -} /* podbei_ */ - diff --git a/ext/spice/src/csupport/podbgc.c b/ext/spice/src/csupport/podbgc.c deleted file mode 100644 index e22dca400e..0000000000 --- a/ext/spice/src/csupport/podbgc.c +++ /dev/null @@ -1,203 +0,0 @@ -/* podbgc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODBGC ( Pod, begin group, character ) */ -/* Subroutine */ int podbgc_(char *pod, ftnlen pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer need, have; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Begin a new (empty) group within a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, in which the active */ -/* group has been sealed, and a new active group */ -/* (containing no elements) begun. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POD does not have sufficient free space to create a new */ -/* group with room for at least one element, the pod is not */ -/* changed, and the error SPICE(TOOMANYPEAS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* There are two ways to create a new group within a pod. */ -/* PODBG (begin group) seals the current contents of the pod, */ -/* and creates a new active group containing no elements. */ -/* PODDG (duplicate group) also seals the current contents */ -/* of the pod, but places a copy of the previous active */ -/* group into the new active group. */ - -/* In both cases, the active group and all previous groups are */ -/* unavailable so long as the new group exists. */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* $ Examples */ - -/* Let the active group of POD be located in elements 21 */ -/* through 40. Then following the call */ - -/* CALL PODBGC ( POD ) */ - -/* the active group is located in elements 42 through 41. */ -/* In other words, element 41 has been appropriated by the */ -/* pod itself, and the active group is empty. */ - -/* However, following the call */ - -/* CALL PODDG ( POD ) */ - -/* the active group is located in elements 42 through 61, */ -/* and contains the same elements as the previous active */ -/* group. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODBGC", (ftnlen)6); - } - -/* There must be at least two spaces at the end of the pod: */ -/* one for bookkeeping, and one for the first element of */ -/* the new group. */ - - have = sizec_(pod, pod_len); - need = cardc_(pod, pod_len) + 2; - if (have < need) { - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODBGC", (ftnlen)6); - return 0; - } - -/* Okay: go ahead and create the group. The offset of the active */ -/* group is stored in the first empty slot of the pod; when the */ -/* new group is removed, this will be reinstated as the offset of */ -/* the active group. */ - - s_copy(pod + (cardc_(pod, pod_len) + 6) * pod_len, pod + pod_len * 3, - pod_len, pod_len); - -/* This requires the cardinality of the pod to increase by one. */ - - i__1 = cardc_(pod, pod_len) + 1; - scardc_(&i__1, pod, pod_len); - -/* Surprise! The new cardinality is the same as the offset of */ -/* the new group! */ - - s_copy(pod + pod_len * 3, pod + pod_len * 5, pod_len, pod_len); - chkout_("PODBGC", (ftnlen)6); - return 0; -} /* podbgc_ */ - diff --git a/ext/spice/src/csupport/podbgd.c b/ext/spice/src/csupport/podbgd.c deleted file mode 100644 index 004f80a795..0000000000 --- a/ext/spice/src/csupport/podbgd.c +++ /dev/null @@ -1,199 +0,0 @@ -/* podbgd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODBGD ( Pod, begin group, double precision ) */ -/* Subroutine */ int podbgd_(doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer need, have; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Begin a new (empty) group within a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, in which the active */ -/* group has been sealed, and a new active group */ -/* (containing no elements) begun. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POD does not have sufficient free space to create a new */ -/* group with room for at least one element, the pod is not */ -/* changed, and the error SPICE(TOOMANYPEAS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* There are two ways to create a new group within a pod. */ -/* PODBG (begin group) seals the current contents of the pod, */ -/* and creates a new active group containing no elements. */ -/* PODDG (duplicate group) also seals the current contents */ -/* of the pod, but places a copy of the previous active */ -/* group into the new active group. */ - -/* In both cases, the active group and all previous groups are */ -/* unavailable so long as the new group exists. */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* $ Examples */ - -/* Let the active group of POD be located in elements 21 */ -/* through 40. Then following the call */ - -/* CALL PODBGD ( POD ) */ - -/* the active group is located in elements 42 through 41. */ -/* In other words, element 41 has been appropriated by the */ -/* pod itself, and the active group is empty. */ - -/* However, following the call */ - -/* CALL PODDG ( POD ) */ - -/* the active group is located in elements 42 through 61, */ -/* and contains the same elements as the previous active */ -/* group. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODBGD", (ftnlen)6); - } - -/* There must be at least two spaces at the end of the pod: */ -/* one for bookkeeping, and one for the first element of */ -/* the new group. */ - - have = sized_(pod); - need = cardd_(pod) + 2; - if (have < need) { - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODBGD", (ftnlen)6); - return 0; - } - -/* Okay: go ahead and create the group. The offset of the active */ -/* group is stored in the first empty slot of the pod; when the */ -/* new group is removed, this will be reinstated as the offset of */ -/* the active group. */ - - pod[cardd_(pod) + 6] = pod[3]; - -/* This requires the cardinality of the pod to increase by one. */ - - i__1 = cardd_(pod) + 1; - scardd_(&i__1, pod); - -/* Surprise! The new cardinality is the same as the offset of */ -/* the new group! */ - - pod[3] = pod[5]; - chkout_("PODBGD", (ftnlen)6); - return 0; -} /* podbgd_ */ - diff --git a/ext/spice/src/csupport/podbgi.c b/ext/spice/src/csupport/podbgi.c deleted file mode 100644 index 36650b8dbc..0000000000 --- a/ext/spice/src/csupport/podbgi.c +++ /dev/null @@ -1,199 +0,0 @@ -/* podbgi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODBGI ( Pod, begin group, integer ) */ -/* Subroutine */ int podbgi_(integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer need, have; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Begin a new (empty) group within a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, in which the active */ -/* group has been sealed, and a new active group */ -/* (containing no elements) begun. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POD does not have sufficient free space to create a new */ -/* group with room for at least one element, the pod is not */ -/* changed, and the error SPICE(TOOMANYPEAS) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* There are two ways to create a new group within a pod. */ -/* PODBG (begin group) seals the current contents of the pod, */ -/* and creates a new active group containing no elements. */ -/* PODDG (duplicate group) also seals the current contents */ -/* of the pod, but places a copy of the previous active */ -/* group into the new active group. */ - -/* In both cases, the active group and all previous groups are */ -/* unavailable so long as the new group exists. */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* $ Examples */ - -/* Let the active group of POD be located in elements 21 */ -/* through 40. Then following the call */ - -/* CALL PODBGI ( POD ) */ - -/* the active group is located in elements 42 through 41. */ -/* In other words, element 41 has been appropriated by the */ -/* pod itself, and the active group is empty. */ - -/* However, following the call */ - -/* CALL PODDG ( POD ) */ - -/* the active group is located in elements 42 through 61, */ -/* and contains the same elements as the previous active */ -/* group. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODBGI", (ftnlen)6); - } - -/* There must be at least two spaces at the end of the pod: */ -/* one for bookkeeping, and one for the first element of */ -/* the new group. */ - - have = sizei_(pod); - need = cardi_(pod) + 2; - if (have < need) { - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODBGI", (ftnlen)6); - return 0; - } - -/* Okay: go ahead and create the group. The offset of the active */ -/* group is stored in the first empty slot of the pod; when the */ -/* new group is removed, this will be reinstated as the offset of */ -/* the active group. */ - - pod[cardi_(pod) + 6] = pod[3]; - -/* This requires the cardinality of the pod to increase by one. */ - - i__1 = cardi_(pod) + 1; - scardi_(&i__1, pod); - -/* Surprise! The new cardinality is the same as the offset of */ -/* the new group! */ - - pod[3] = pod[5]; - chkout_("PODBGI", (ftnlen)6); - return 0; -} /* podbgi_ */ - diff --git a/ext/spice/src/csupport/podcgc.c b/ext/spice/src/csupport/podcgc.c deleted file mode 100644 index bea85238a9..0000000000 --- a/ext/spice/src/csupport/podcgc.c +++ /dev/null @@ -1,243 +0,0 @@ -/* podcgc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODCGC ( Pod, close group, character ) */ -/* Subroutine */ int podcgc_(char *pod, ftnlen pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), scardc_(integer *, - char *, ftnlen), podonc_(char *, integer *, integer *, ftnlen); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, appending its contents to */ -/* the previous group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ -/* $ */ -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been closed. In other words, the number of groups */ -/* has been reduced by one, and the new active group */ -/* contains the ... oh, look at $Examples. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* pod is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODCGC", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. To append the original */ -/* active group to the new one, just move all of the elements */ -/* of that group by one space toward the front of the pod. */ -/* The new cardinality, of course, should be one less than the */ -/* original cardinality. (Only the marker has been removed.) */ - -/* If the pod contains only one group, we don't have to do */ -/* anything. */ - - podonc_(pod, &offset, &number, pod_len); - if (offset != 0) { - s_copy(pod + pod_len * 3, pod + (offset + 5) * pod_len, pod_len, - pod_len); - i__1 = offset + number; - for (i__ = offset + 1; i__ <= i__1; ++i__) { - s_copy(pod + (i__ + 4) * pod_len, pod + (i__ + 5) * pod_len, - pod_len, pod_len); - } - i__1 = offset + number - 1; - scardc_(&i__1, pod, pod_len); - } - chkout_("PODCGC", (ftnlen)6); - return 0; -} /* podcgc_ */ - diff --git a/ext/spice/src/csupport/podcgd.c b/ext/spice/src/csupport/podcgd.c deleted file mode 100644 index 63960952b2..0000000000 --- a/ext/spice/src/csupport/podcgd.c +++ /dev/null @@ -1,238 +0,0 @@ -/* podcgd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODCGD ( Pod, close group, double precision ) */ -/* Subroutine */ int podcgd_(doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), podond_(doublereal *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, appending its contents to */ -/* the previous group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ -/* $ */ -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been closed. In other words, the number of groups */ -/* has been reduced by one, and the new active group */ -/* contains the ... oh, look at $Examples. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* pod is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODCGD", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. To append the original */ -/* active group to the new one, just move all of the elements */ -/* of that group by one space toward the front of the pod. */ -/* The new cardinality, of course, should be one less than the */ -/* original cardinality. (Only the marker has been removed.) */ - -/* If the pod contains only one group, we don't have to do */ -/* anything. */ - - podond_(pod, &offset, &number); - if (offset != 0) { - pod[3] = pod[offset + 5]; - i__1 = offset + number; - for (i__ = offset + 1; i__ <= i__1; ++i__) { - pod[i__ + 4] = pod[i__ + 5]; - } - i__1 = offset + number - 1; - scardd_(&i__1, pod); - } - chkout_("PODCGD", (ftnlen)6); - return 0; -} /* podcgd_ */ - diff --git a/ext/spice/src/csupport/podcgi.c b/ext/spice/src/csupport/podcgi.c deleted file mode 100644 index 0b78a6418e..0000000000 --- a/ext/spice/src/csupport/podcgi.c +++ /dev/null @@ -1,239 +0,0 @@ -/* podcgi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODCGI ( Pod, close group, integer ) */ -/* Subroutine */ int podcgi_(integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), scardi_(integer *, - integer *); - integer offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, appending its contents to */ -/* the previous group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ -/* $ */ -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been closed. In other words, the number of groups */ -/* has been reduced by one, and the new active group */ -/* contains the ... oh, look at $Examples. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* pod is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODCGI", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. To append the original */ -/* active group to the new one, just move all of the elements */ -/* of that group by one space toward the front of the pod. */ -/* The new cardinality, of course, should be one less than the */ -/* original cardinality. (Only the marker has been removed.) */ - -/* If the pod contains only one group, we don't have to do */ -/* anything. */ - - podoni_(pod, &offset, &number); - if (offset != 0) { - pod[3] = pod[offset + 5]; - i__1 = offset + number; - for (i__ = offset + 1; i__ <= i__1; ++i__) { - pod[i__ + 4] = pod[i__ + 5]; - } - i__1 = offset + number - 1; - scardi_(&i__1, pod); - } - chkout_("PODCGI", (ftnlen)6); - return 0; -} /* podcgi_ */ - diff --git a/ext/spice/src/csupport/poddgc.c b/ext/spice/src/csupport/poddgc.c deleted file mode 100644 index 0416cb19f3..0000000000 --- a/ext/spice/src/csupport/poddgc.c +++ /dev/null @@ -1,198 +0,0 @@ -/* poddgc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODDGC ( Pod, duplicate group, character ) */ -/* Subroutine */ int poddgc_(char *pod, ftnlen pod_len) -{ - integer need, have; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int podaec_(char *, integer *, char *, ftnlen, - ftnlen), podbgc_(char *, ftnlen), podonc_(char *, integer *, - integer *, ftnlen); - integer offset, number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Begin a new group within a pod, containing the same elements */ -/* as the active group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, in which the active */ -/* group has been sealed, and a new active group */ -/* (containing the same elements as the previous group) */ -/* begun. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POD does not have sufficient free space to create */ -/* the new group, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. (If the active group */ -/* contains no elements, there must be sufficient free */ -/* space for the new group to contain at least one element.) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* There are two ways to create a new group within a pod. */ -/* PODBG (begin group) seals the current contents of the pod, */ -/* and creates a new active group containing no elements. */ -/* PODDG (duplicate group) also seals the current contents */ -/* of the pod, but places a copy of the previous active */ -/* group into the new active group. */ - -/* In both cases, the active group and all previous groups are */ -/* unavailable so long as the new group exists. */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* $ Examples */ - -/* Let the active group of POD be located in elements 21 */ -/* through 40. Then following the call */ - -/* CALL PODBGC ( POD ) */ - -/* the active group is located in elements 42 through 41. */ -/* In other words, element 41 has been appropriated by the */ -/* pod itself, and the active group is empty. */ - -/* However, following the call */ - -/* CALL PODDG ( POD ) */ - -/* the active group is located in elements 42 through 61, */ -/* and contains the same elements as the previous active */ -/* group. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODDGC", (ftnlen)6); - } - -/* How many spaces are needed? One for bookkeeping, and one for */ -/* each of the elements in the active group. (If there are no */ -/* elements, then one for future use.) */ - - podonc_(pod, &offset, &number, pod_len); - have = sizec_(pod, pod_len); - need = cardc_(pod, pod_len) + 1 + max(1,number); - if (have < need) { - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODDGC", (ftnlen)6); - return 0; - } - -/* Go ahead and create a new (empty) group. */ - - podbgc_(pod, pod_len); - -/* Append the old group (still in the same place) to the pod. */ -/* (Somewhat incestuous, but practical.) Kids, don't try this */ -/* at home: you aren't supposed to know that existing groups */ -/* arent't changed by the addition of new ones. */ - - podaec_(pod + (offset + 6) * pod_len, &number, pod, pod_len, pod_len); - chkout_("PODDGC", (ftnlen)6); - return 0; -} /* poddgc_ */ - diff --git a/ext/spice/src/csupport/poddgd.c b/ext/spice/src/csupport/poddgd.c deleted file mode 100644 index 30d15cea52..0000000000 --- a/ext/spice/src/csupport/poddgd.c +++ /dev/null @@ -1,198 +0,0 @@ -/* poddgd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODDGD ( Pod, duplicate group, double precision ) */ -/* Subroutine */ int poddgd_(doublereal *pod) -{ - integer need, have; - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int podaed_(doublereal *, integer *, doublereal *) - , podbgd_(doublereal *), podond_(doublereal *, integer *, integer - *); - integer offset, number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Begin a new group within a pod, containing the same elements */ -/* as the active group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, in which the active */ -/* group has been sealed, and a new active group */ -/* (containing the same elements as the previous group) */ -/* begun. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POD does not have sufficient free space to create */ -/* the new group, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. (If the active group */ -/* contains no elements, there must be sufficient free */ -/* space for the new group to contain at least one element.) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* There are two ways to create a new group within a pod. */ -/* PODBG (begin group) seals the current contents of the pod, */ -/* and creates a new active group containing no elements. */ -/* PODDG (duplicate group) also seals the current contents */ -/* of the pod, but places a copy of the previous active */ -/* group into the new active group. */ - -/* In both cases, the active group and all previous groups are */ -/* unavailable so long as the new group exists. */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* $ Examples */ - -/* Let the active group of POD be located in elements 21 */ -/* through 40. Then following the call */ - -/* CALL PODBGD ( POD ) */ - -/* the active group is located in elements 42 through 41. */ -/* In other words, element 41 has been appropriated by the */ -/* pod itself, and the active group is empty. */ - -/* However, following the call */ - -/* CALL PODDG ( POD ) */ - -/* the active group is located in elements 42 through 61, */ -/* and contains the same elements as the previous active */ -/* group. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODDGD", (ftnlen)6); - } - -/* How many spaces are needed? One for bookkeeping, and one for */ -/* each of the elements in the active group. (If there are no */ -/* elements, then one for future use.) */ - - podond_(pod, &offset, &number); - have = sized_(pod); - need = cardd_(pod) + 1 + max(1,number); - if (have < need) { - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODDGD", (ftnlen)6); - return 0; - } - -/* Go ahead and create a new (empty) group. */ - - podbgd_(pod); - -/* Append the old group (still in the same place) to the pod. */ -/* (Somewhat incestuous, but practical.) Kids, don't try this */ -/* at home: you aren't supposed to know that existing groups */ -/* arent't changed by the addition of new ones. */ - - podaed_(&pod[offset + 6], &number, pod); - chkout_("PODDGD", (ftnlen)6); - return 0; -} /* poddgd_ */ - diff --git a/ext/spice/src/csupport/poddgi.c b/ext/spice/src/csupport/poddgi.c deleted file mode 100644 index 7b1c9d44ff..0000000000 --- a/ext/spice/src/csupport/poddgi.c +++ /dev/null @@ -1,197 +0,0 @@ -/* poddgi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODDGI ( Pod, duplicate group, integer ) */ -/* Subroutine */ int poddgi_(integer *pod) -{ - integer need, have; - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - extern /* Subroutine */ int podaei_(integer *, integer *, integer *), - podbgi_(integer *); - integer offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Begin a new group within a pod, containing the same elements */ -/* as the active group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, in which the active */ -/* group has been sealed, and a new active group */ -/* (containing the same elements as the previous group) */ -/* begun. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If POD does not have sufficient free space to create */ -/* the new group, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. (If the active group */ -/* contains no elements, there must be sufficient free */ -/* space for the new group to contain at least one element.) */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* There are two ways to create a new group within a pod. */ -/* PODBG (begin group) seals the current contents of the pod, */ -/* and creates a new active group containing no elements. */ -/* PODDG (duplicate group) also seals the current contents */ -/* of the pod, but places a copy of the previous active */ -/* group into the new active group. */ - -/* In both cases, the active group and all previous groups are */ -/* unavailable so long as the new group exists. */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* $ Examples */ - -/* Let the active group of POD be located in elements 21 */ -/* through 40. Then following the call */ - -/* CALL PODBGI ( POD ) */ - -/* the active group is located in elements 42 through 41. */ -/* In other words, element 41 has been appropriated by the */ -/* pod itself, and the active group is empty. */ - -/* However, following the call */ - -/* CALL PODDG ( POD ) */ - -/* the active group is located in elements 42 through 61, */ -/* and contains the same elements as the previous active */ -/* group. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODDGI", (ftnlen)6); - } - -/* How many spaces are needed? One for bookkeeping, and one for */ -/* each of the elements in the active group. (If there are no */ -/* elements, then one for future use.) */ - - podoni_(pod, &offset, &number); - have = sizei_(pod); - need = cardi_(pod) + 1 + max(1,number); - if (have < need) { - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODDGI", (ftnlen)6); - return 0; - } - -/* Go ahead and create a new (empty) group. */ - - podbgi_(pod); - -/* Append the old group (still in the same place) to the pod. */ -/* (Somewhat incestuous, but practical.) Kids, don't try this */ -/* at home: you aren't supposed to know that existing groups */ -/* arent't changed by the addition of new ones. */ - - podaei_(&pod[offset + 6], &number, pod); - chkout_("PODDGI", (ftnlen)6); - return 0; -} /* poddgi_ */ - diff --git a/ext/spice/src/csupport/podegc.c b/ext/spice/src/csupport/podegc.c deleted file mode 100644 index 7ffd9f3bea..0000000000 --- a/ext/spice/src/csupport/podegc.c +++ /dev/null @@ -1,241 +0,0 @@ -/* podegc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure PODEGC ( Pod, end group, character ) */ -/* Subroutine */ int podegc_(char *pod, ftnlen pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scardc_(integer *, - char *, ftnlen), podonc_(char *, integer *, integer *, ftnlen); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, restoring the previous group */ -/* unchanged. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been removed and the previous group has been */ -/* restored unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* cardinality of the POD is set to zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODEGC", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. The new cardinality, */ -/* of course, should be one less than the original offset (9). */ - -/* If the pod contains only one group, it can't be removed, but */ -/* it can be emptied by setting the cardinality of the pod to */ -/* zero. */ - - - podonc_(pod, &offset, &number, pod_len); - if (offset == 0) { - scardc_(&c__0, pod, pod_len); - } else { - s_copy(pod + pod_len * 3, pod + (offset + 5) * pod_len, pod_len, - pod_len); - i__1 = offset - 1; - scardc_(&i__1, pod, pod_len); - } - chkout_("PODEGC", (ftnlen)6); - return 0; -} /* podegc_ */ - diff --git a/ext/spice/src/csupport/podegd.c b/ext/spice/src/csupport/podegd.c deleted file mode 100644 index c09285f63a..0000000000 --- a/ext/spice/src/csupport/podegd.c +++ /dev/null @@ -1,237 +0,0 @@ -/* podegd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure PODEGD ( Pod, end group, double precision ) */ -/* Subroutine */ int podegd_(doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), podond_(doublereal *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, restoring the previous group */ -/* unchanged. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been removed and the previous group has been */ -/* restored unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* cardinality of the POD is set to zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODEGD", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. The new cardinality, */ -/* of course, should be one less than the original offset (9). */ - -/* If the pod contains only one group, it can't be removed, but */ -/* it can be emptied by setting the cardinality of the pod to */ -/* zero. */ - - - podond_(pod, &offset, &number); - if (offset == 0) { - scardd_(&c__0, pod); - } else { - pod[3] = pod[offset + 5]; - i__1 = offset - 1; - scardd_(&i__1, pod); - } - chkout_("PODEGD", (ftnlen)6); - return 0; -} /* podegd_ */ - diff --git a/ext/spice/src/csupport/podegi.c b/ext/spice/src/csupport/podegi.c deleted file mode 100644 index eeac1a3336..0000000000 --- a/ext/spice/src/csupport/podegi.c +++ /dev/null @@ -1,238 +0,0 @@ -/* podegi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__0 = 0; - -/* $Procedure PODEGI ( Pod, end group, integer ) */ -/* Subroutine */ int podegi_(integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scardi_(integer *, - integer *); - integer offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, restoring the previous group */ -/* unchanged. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been removed and the previous group has been */ -/* restored unchanged. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* cardinality of the POD is set to zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODEGI", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. The new cardinality, */ -/* of course, should be one less than the original offset (9). */ - -/* If the pod contains only one group, it can't be removed, but */ -/* it can be emptied by setting the cardinality of the pod to */ -/* zero. */ - - - podoni_(pod, &offset, &number); - if (offset == 0) { - scardi_(&c__0, pod); - } else { - pod[3] = pod[offset + 5]; - i__1 = offset - 1; - scardi_(&i__1, pod); - } - chkout_("PODEGI", (ftnlen)6); - return 0; -} /* podegi_ */ - diff --git a/ext/spice/src/csupport/podiec.c b/ext/spice/src/csupport/podiec.c deleted file mode 100644 index ba2099cfc1..0000000000 --- a/ext/spice/src/csupport/podiec.c +++ /dev/null @@ -1,220 +0,0 @@ -/* podiec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODIEC ( Pod, insert elements, character ) */ -/* Subroutine */ int podiec_(char *elems, integer *n, integer *loc, char *pod, - ftnlen elems_len, ftnlen pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen), - podonc_(char *, integer *, integer *, ftnlen); - integer offset, number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Insert elements at a specified location within the active group */ -/* of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELEMS I New elements. */ -/* N I Number of new elements. */ -/* LOC I Location at which elements are to be inserted. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* ELEMS contains elements to be inserted into the active */ -/* group of POD. */ - -/* N is the number of elements in ELEMS. */ - -/* LOC is the location (within the active group of the pod) */ -/* at which the new elements are to be inserted. The new */ -/* elements are inserted in front of the element currently */ -/* at this location. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which contains the new elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If there is insufficient room in the pod to insert all */ -/* of the new elements, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. */ - -/* 3) If the location specified for location is not in the range */ -/* [1,NC+1], where NC is the number of elements in the active */ -/* group of the pod, the pod is not changed, and the error */ -/* SPICE(BADPODLOCATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to insert elements into the active */ -/* group of a pod without having to worry about checking for */ -/* overflow beforehand, or updating the cardinality afterwards. */ - -/* $ Examples */ - -/* Elements can be inserted into the active group of a pod */ -/* by hand, */ - -/* CALL PODONC ( POD, OFFSET, NUMBER ) */ -/* END = OFFSET + NUMBER */ - -/* CALL INSLAC ( ELEMS, N, OFFSET + LOC, POD(1), CUREND ) */ -/* CALL SCARDC ( CUREND, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for possible overflow. PODIE accomplishes the same thing, */ - -/* CALL PODIEC ( ELEMS, N, LOC, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODIEC", (ftnlen)6); - } - -/* Three things can go `wrong': */ - -/* 1) No items to insert. */ - -/* 2) Too many items to insert. */ - -/* 3) No place to insert them. */ - - podonc_(pod, &offset, &number, pod_len); - if (*n < 1) { - chkout_("PODIEC", (ftnlen)6); - return 0; - } else if (cardc_(pod, pod_len) + *n > sizec_(pod, pod_len)) { - setmsg_("Cannot fit # elements into # spaces.", (ftnlen)36); - errint_("#", n, (ftnlen)1); - i__1 = sizec_(pod, pod_len) - cardc_(pod, pod_len); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODIEC", (ftnlen)6); - return 0; - } else if (*loc < 1 || *loc > number + 1) { - setmsg_("Location (#) must be in the range [1,#].", (ftnlen)40); - errint_("#", loc, (ftnlen)1); - i__1 = number + 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(BADPODLOCATION)", (ftnlen)21); - chkout_("PODIEC", (ftnlen)6); - return 0; - } - -/* In theory, we are home free. The rest looks just like the */ -/* code in $Examples, above. */ - - end = offset + number; - i__1 = offset + *loc; - inslac_(elems, n, &i__1, pod + pod_len * 6, &end, elems_len, pod_len); - scardc_(&end, pod, pod_len); - chkout_("PODIEC", (ftnlen)6); - return 0; -} /* podiec_ */ - diff --git a/ext/spice/src/csupport/podied.c b/ext/spice/src/csupport/podied.c deleted file mode 100644 index 15c261b212..0000000000 --- a/ext/spice/src/csupport/podied.c +++ /dev/null @@ -1,220 +0,0 @@ -/* podied.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODIED ( Pod, insert elements, double precision ) */ -/* Subroutine */ int podied_(doublereal *elems, integer *n, integer *loc, - doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sized_(doublereal *); - extern /* Subroutine */ int scardd_(integer *, doublereal *), inslad_( - doublereal *, integer *, integer *, doublereal *, integer *), - podond_(doublereal *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Insert elements at a specified location within the active group */ -/* of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELEMS I New elements. */ -/* N I Number of new elements. */ -/* LOC I Location at which elements are to be inserted. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* ELEMS contains elements to be inserted into the active */ -/* group of POD. */ - -/* N is the number of elements in ELEMS. */ - -/* LOC is the location (within the active group of the pod) */ -/* at which the new elements are to be inserted. The new */ -/* elements are inserted in front of the element currently */ -/* at this location. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which contains the new elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If there is insufficient room in the pod to insert all */ -/* of the new elements, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. */ - -/* 3) If the location specified for location is not in the range */ -/* [1,NC+1], where NC is the number of elements in the active */ -/* group of the pod, the pod is not changed, and the error */ -/* SPICE(BADPODLOCATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to insert elements into the active */ -/* group of a pod without having to worry about checking for */ -/* overflow beforehand, or updating the cardinality afterwards. */ - -/* $ Examples */ - -/* Elements can be inserted into the active group of a pod */ -/* by hand, */ - -/* CALL PODOND ( POD, OFFSET, NUMBER ) */ -/* END = OFFSET + NUMBER */ - -/* CALL INSLAD ( ELEMS, N, OFFSET + LOC, POD(1), CUREND ) */ -/* CALL SCARDD ( CUREND, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for possible overflow. PODIE accomplishes the same thing, */ - -/* CALL PODIED ( ELEMS, N, LOC, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODIED", (ftnlen)6); - } - -/* Three things can go `wrong': */ - -/* 1) No items to insert. */ - -/* 2) Too many items to insert. */ - -/* 3) No place to insert them. */ - - podond_(pod, &offset, &number); - if (*n < 1) { - chkout_("PODIED", (ftnlen)6); - return 0; - } else if (cardd_(pod) + *n > sized_(pod)) { - setmsg_("Cannot fit # elements into # spaces.", (ftnlen)36); - errint_("#", n, (ftnlen)1); - i__1 = sized_(pod) - cardd_(pod); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODIED", (ftnlen)6); - return 0; - } else if (*loc < 1 || *loc > number + 1) { - setmsg_("Location (#) must be in the range [1,#].", (ftnlen)40); - errint_("#", loc, (ftnlen)1); - i__1 = number + 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(BADPODLOCATION)", (ftnlen)21); - chkout_("PODIED", (ftnlen)6); - return 0; - } - -/* In theory, we are home free. The rest looks just like the */ -/* code in $Examples, above. */ - - end = offset + number; - i__1 = offset + *loc; - inslad_(elems, n, &i__1, &pod[6], &end); - scardd_(&end, pod); - chkout_("PODIED", (ftnlen)6); - return 0; -} /* podied_ */ - diff --git a/ext/spice/src/csupport/podiei.c b/ext/spice/src/csupport/podiei.c deleted file mode 100644 index 732adf3b9d..0000000000 --- a/ext/spice/src/csupport/podiei.c +++ /dev/null @@ -1,219 +0,0 @@ -/* podiei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODIEI ( Pod, insert elements, integer ) */ -/* Subroutine */ int podiei_(integer *elems, integer *n, integer *loc, - integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizei_(integer *); - extern /* Subroutine */ int scardi_(integer *, integer *), inslai_( - integer *, integer *, integer *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Insert elements at a specified location within the active group */ -/* of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ELEMS I New elements. */ -/* N I Number of new elements. */ -/* LOC I Location at which elements are to be inserted. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* ELEMS contains elements to be inserted into the active */ -/* group of POD. */ - -/* N is the number of elements in ELEMS. */ - -/* LOC is the location (within the active group of the pod) */ -/* at which the new elements are to be inserted. The new */ -/* elements are inserted in front of the element currently */ -/* at this location. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which contains the new elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If there is insufficient room in the pod to insert all */ -/* of the new elements, the pod is not changed, and the error */ -/* SPICE(TOOMANYPEAS) is signalled. */ - -/* 3) If the location specified for location is not in the range */ -/* [1,NC+1], where NC is the number of elements in the active */ -/* group of the pod, the pod is not changed, and the error */ -/* SPICE(BADPODLOCATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to insert elements into the active */ -/* group of a pod without having to worry about checking for */ -/* overflow beforehand, or updating the cardinality afterwards. */ - -/* $ Examples */ - -/* Elements can be inserted into the active group of a pod */ -/* by hand, */ - -/* CALL PODONI ( POD, OFFSET, NUMBER ) */ -/* END = OFFSET + NUMBER */ - -/* CALL INSLAI ( ELEMS, N, OFFSET + LOC, POD(1), CUREND ) */ -/* CALL SCARDI ( CUREND, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for possible overflow. PODIE accomplishes the same thing, */ - -/* CALL PODIEI ( ELEMS, N, LOC, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODIEI", (ftnlen)6); - } - -/* Three things can go `wrong': */ - -/* 1) No items to insert. */ - -/* 2) Too many items to insert. */ - -/* 3) No place to insert them. */ - - podoni_(pod, &offset, &number); - if (*n < 1) { - chkout_("PODIEI", (ftnlen)6); - return 0; - } else if (cardi_(pod) + *n > sizei_(pod)) { - setmsg_("Cannot fit # elements into # spaces.", (ftnlen)36); - errint_("#", n, (ftnlen)1); - i__1 = sizei_(pod) - cardi_(pod); - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(TOOMANYPEAS)", (ftnlen)18); - chkout_("PODIEI", (ftnlen)6); - return 0; - } else if (*loc < 1 || *loc > number + 1) { - setmsg_("Location (#) must be in the range [1,#].", (ftnlen)40); - errint_("#", loc, (ftnlen)1); - i__1 = number + 1; - errint_("#", &i__1, (ftnlen)1); - sigerr_("SPICE(BADPODLOCATION)", (ftnlen)21); - chkout_("PODIEI", (ftnlen)6); - return 0; - } - -/* In theory, we are home free. The rest looks just like the */ -/* code in $Examples, above. */ - - end = offset + number; - i__1 = offset + *loc; - inslai_(elems, n, &i__1, &pod[6], &end); - scardi_(&end, pod); - chkout_("PODIEI", (ftnlen)6); - return 0; -} /* podiei_ */ - diff --git a/ext/spice/src/csupport/podonc.c b/ext/spice/src/csupport/podonc.c deleted file mode 100644 index b306092547..0000000000 --- a/ext/spice/src/csupport/podonc.c +++ /dev/null @@ -1,177 +0,0 @@ -/* podonc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODONC ( Pod, offset and number, character ) */ -/* Subroutine */ int podonc_(char *pod, integer *offset, integer *number, - ftnlen pod_len) -{ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), dcodec_(char *, - integer *, ftnlen), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the offset of the active group of a pod, and the number */ -/* of elements in the group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I Pod. */ -/* OFFSET O Offset of the active group of POD. */ -/* NUMBER O Number of elements in active group. */ - -/* $ Detailed_Input */ - -/* POD is a pod. */ - -/* $ Detailed_Output */ - -/* OFFSET is the offset of the first item in the active group */ -/* of POD. That is, POD(OFFSET + 1) is the first element */ -/* of the active group. */ - -/* NUMBER is the number of items in the active group of POD. */ -/* That is, the active group is located in POD(OFFSET+1), */ -/* POD(OFFSET+2), ..., POD(OFFSET+NUMBER). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group of the pod contains no elements, */ -/* NUMBER is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* PODBE (begin and end) and PODON (offset and number) provide */ -/* equivalent ways to access the elements of the active group */ -/* of a pod. Note that there is no way to access any group other */ -/* than the active group. */ - -/* $ Examples */ - -/* PODBE is typically used to process the elements of the active */ -/* group of a pod one at a time, e.g., */ - -/* CALL PODBEC ( POD, BEGIN, END ) */ - -/* DO I = BEGIN, END */ -/* CALL PROCESS ( ..., POD(I), ... ) */ -/* END DO */ - -/* Note that if the elements are to be correlated with the elements */ -/* of other arrays, PODON may be more convenient: */ - -/* CALL PODONC ( POD, OFFSET, N ) */ - -/* DO I = 1, N */ -/* CALL PROCESS ( ..., POD(OFFSET+I), ARRAY(I), ... ) */ -/* END DO */ - -/* PODON is also more convenient when the group is to be passed */ -/* to a subprogram as an array: */ - -/* CALL SUBPROG ( ..., N, POD(OFFSET+1), ... ) */ - -/* For example, to sort the elements of the active group of */ -/* a pod, */ - -/* CALL PODONC ( POD, OFFSET, N ) */ -/* CALL SHELLC ( N, POD( OFFSET+1 ) ) */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODONC", (ftnlen)6); - } - -/* The offset of the active group can be recovered directly from */ -/* the control area of the pod. The cardinality of the pod always */ -/* indicates the end of the active group. */ - - dcodec_(pod + pod_len * 3, offset, pod_len); - *number = cardc_(pod, pod_len) - *offset; - chkout_("PODONC", (ftnlen)6); - return 0; -} /* podonc_ */ - diff --git a/ext/spice/src/csupport/podond.c b/ext/spice/src/csupport/podond.c deleted file mode 100644 index de3d8e2925..0000000000 --- a/ext/spice/src/csupport/podond.c +++ /dev/null @@ -1,177 +0,0 @@ -/* podond.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODOND ( Pod, offset and number, double precision ) */ -/* Subroutine */ int podond_(doublereal *pod, integer *offset, integer * - number) -{ - extern integer cardd_(doublereal *); - extern /* Subroutine */ int chkin_(char *, ftnlen), dcoded_(doublereal *, - integer *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the offset of the active group of a pod, and the number */ -/* of elements in the group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I Pod. */ -/* OFFSET O Offset of the active group of POD. */ -/* NUMBER O Number of elements in active group. */ - -/* $ Detailed_Input */ - -/* POD is a pod. */ - -/* $ Detailed_Output */ - -/* OFFSET is the offset of the first item in the active group */ -/* of POD. That is, POD(OFFSET + 1) is the first element */ -/* of the active group. */ - -/* NUMBER is the number of items in the active group of POD. */ -/* That is, the active group is located in POD(OFFSET+1), */ -/* POD(OFFSET+2), ..., POD(OFFSET+NUMBER). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group of the pod contains no elements, */ -/* NUMBER is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* PODBE (begin and end) and PODON (offset and number) provide */ -/* equivalent ways to access the elements of the active group */ -/* of a pod. Note that there is no way to access any group other */ -/* than the active group. */ - -/* $ Examples */ - -/* PODBE is typically used to process the elements of the active */ -/* group of a pod one at a time, e.g., */ - -/* CALL PODBED ( POD, BEGIN, END ) */ - -/* DO I = BEGIN, END */ -/* CALL PROCESS ( ..., POD(I), ... ) */ -/* END DO */ - -/* Note that if the elements are to be correlated with the elements */ -/* of other arrays, PODON may be more convenient: */ - -/* CALL PODOND ( POD, OFFSET, N ) */ - -/* DO I = 1, N */ -/* CALL PROCESS ( ..., POD(OFFSET+I), ARRAY(I), ... ) */ -/* END DO */ - -/* PODON is also more convenient when the group is to be passed */ -/* to a subprogram as an array: */ - -/* CALL SUBPROG ( ..., N, POD(OFFSET+1), ... ) */ - -/* For example, to sort the elements of the active group of */ -/* a pod, */ - -/* CALL PODOND ( POD, OFFSET, N ) */ -/* CALL SHELLD ( N, POD( OFFSET+1 ) ) */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODOND", (ftnlen)6); - } - -/* The offset of the active group can be recovered directly from */ -/* the control area of the pod. The cardinality of the pod always */ -/* indicates the end of the active group. */ - - dcoded_(&pod[3], offset); - *number = cardd_(pod) - *offset; - chkout_("PODOND", (ftnlen)6); - return 0; -} /* podond_ */ - diff --git a/ext/spice/src/csupport/podoni.c b/ext/spice/src/csupport/podoni.c deleted file mode 100644 index e78d06f50b..0000000000 --- a/ext/spice/src/csupport/podoni.c +++ /dev/null @@ -1,176 +0,0 @@ -/* podoni.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODONI ( Pod, offset and number, integer ) */ -/* Subroutine */ int podoni_(integer *pod, integer *offset, integer *number) -{ - extern integer cardi_(integer *); - extern /* Subroutine */ int chkin_(char *, ftnlen), dcodei_(integer *, - integer *), chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the offset of the active group of a pod, and the number */ -/* of elements in the group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAYS */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I Pod. */ -/* OFFSET O Offset of the active group of POD. */ -/* NUMBER O Number of elements in active group. */ - -/* $ Detailed_Input */ - -/* POD is a pod. */ - -/* $ Detailed_Output */ - -/* OFFSET is the offset of the first item in the active group */ -/* of POD. That is, POD(OFFSET + 1) is the first element */ -/* of the active group. */ - -/* NUMBER is the number of items in the active group of POD. */ -/* That is, the active group is located in POD(OFFSET+1), */ -/* POD(OFFSET+2), ..., POD(OFFSET+NUMBER). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group of the pod contains no elements, */ -/* NUMBER is zero. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* PODBE (begin and end) and PODON (offset and number) provide */ -/* equivalent ways to access the elements of the active group */ -/* of a pod. Note that there is no way to access any group other */ -/* than the active group. */ - -/* $ Examples */ - -/* PODBE is typically used to process the elements of the active */ -/* group of a pod one at a time, e.g., */ - -/* CALL PODBEI ( POD, BEGIN, END ) */ - -/* DO I = BEGIN, END */ -/* CALL PROCESS ( ..., POD(I), ... ) */ -/* END DO */ - -/* Note that if the elements are to be correlated with the elements */ -/* of other arrays, PODON may be more convenient: */ - -/* CALL PODONI ( POD, OFFSET, N ) */ - -/* DO I = 1, N */ -/* CALL PROCESS ( ..., POD(OFFSET+I), ARRAY(I), ... ) */ -/* END DO */ - -/* PODON is also more convenient when the group is to be passed */ -/* to a subprogram as an array: */ - -/* CALL SUBPROG ( ..., N, POD(OFFSET+1), ... ) */ - -/* For example, to sort the elements of the active group of */ -/* a pod, */ - -/* CALL PODONI ( POD, OFFSET, N ) */ -/* CALL SHELLI ( N, POD( OFFSET+1 ) ) */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODONI", (ftnlen)6); - } - -/* The offset of the active group can be recovered directly from */ -/* the control area of the pod. The cardinality of the pod always */ -/* indicates the end of the active group. */ - - dcodei_(&pod[3], offset); - *number = cardi_(pod) - *offset; - chkout_("PODONI", (ftnlen)6); - return 0; -} /* podoni_ */ - diff --git a/ext/spice/src/csupport/podrec.c b/ext/spice/src/csupport/podrec.c deleted file mode 100644 index c58e93c627..0000000000 --- a/ext/spice/src/csupport/podrec.c +++ /dev/null @@ -1,213 +0,0 @@ -/* podrec.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODREC ( Pod, remove elements, character ) */ -/* Subroutine */ int podrec_(integer *n, integer *loc, char *pod, ftnlen - pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scardc_(integer *, - char *, ftnlen), remlac_(integer *, integer *, char *, integer *, - ftnlen), podonc_(char *, integer *, integer *, ftnlen); - integer offset, number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Remove elements beginning at a specified location within the */ -/* active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of elements to remove. */ -/* LOC I Location of first element to be removed. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* N is the number of elements to be removed from the */ -/* active group of POD. */ - -/* LOC is the location (within the active group of the pod) */ -/* of the first element to be removed. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which contains the elements preceding and following */ -/* the removed elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If the location of the last element to be removed (LOC+N-1) */ -/* is greater than the number of elements in the active group, */ -/* the pod is not changed, and the error SPICE(NOTENOUGHPEAS) */ -/* is signalled. */ - -/* 3) If the location specified for location is not in the range */ -/* [1,NC], where NC is the number of elements in the active */ -/* group of the pod, the pod is not changed, and the error */ -/* SPICE(BADPODLOCATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to remove elements from the active */ -/* group of a pod without having to worry about checking for */ -/* impossible requests beforehand, or updating the cardinality */ -/* afterwards. */ - -/* $ Examples */ - -/* Elements can be removed from the active group of a pod */ -/* by hand, */ - -/* CALL PODONC ( POD, OFFSET, NUMBER ) */ -/* END = OFFSET + NUMBER */ - -/* CALL REMLAC ( N, OFFSET + LOC, POD(1), END ) */ -/* CALL SCARDC ( END, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for impossible requests. PODRE accomplishes the same thing, */ - -/* CALL PODIEC ( N, LOC, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODREC", (ftnlen)6); - } - -/* Three things can go `wrong': */ - -/* 1) No items to remove. */ - -/* 2) Too many items to remove. */ - -/* 3) No place to remove them from. */ - - podonc_(pod, &offset, &number, pod_len); - if (*n < 1) { - chkout_("PODREC", (ftnlen)6); - return 0; - } else if (*loc + *n - 1 > number) { - setmsg_("LOC = #; N = #; there are only # elements.", (ftnlen)42); - errint_("#", loc, (ftnlen)1); - errint_("#", n, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(NOTENOUGHPEAS)", (ftnlen)20); - chkout_("PODREC", (ftnlen)6); - return 0; - } else if (*loc < 1 || *loc > number) { - setmsg_("Location (#) must be in the range [1,#].", (ftnlen)40); - errint_("#", loc, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(BADPODLOCATION)", (ftnlen)21); - chkout_("PODREC", (ftnlen)6); - return 0; - } - -/* No problem. This is just like $Examples, above. */ - - end = offset + number; - i__1 = offset + *loc; - remlac_(n, &i__1, pod + pod_len * 6, &end, pod_len); - scardc_(&end, pod, pod_len); - chkout_("PODREC", (ftnlen)6); - return 0; -} /* podrec_ */ - diff --git a/ext/spice/src/csupport/podred.c b/ext/spice/src/csupport/podred.c deleted file mode 100644 index b175a37f50..0000000000 --- a/ext/spice/src/csupport/podred.c +++ /dev/null @@ -1,212 +0,0 @@ -/* podred.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODRED ( Pod, remove elements, double precision ) */ -/* Subroutine */ int podred_(integer *n, integer *loc, doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *, - doublereal *), remlad_(integer *, integer *, doublereal *, - integer *), podond_(doublereal *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Remove elements beginning at a specified location within the */ -/* active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of elements to remove. */ -/* LOC I Location of first element to be removed. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* N is the number of elements to be removed from the */ -/* active group of POD. */ - -/* LOC is the location (within the active group of the pod) */ -/* of the first element to be removed. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which contains the elements preceding and following */ -/* the removed elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If the location of the last element to be removed (LOC+N-1) */ -/* is greater than the number of elements in the active group, */ -/* the pod is not changed, and the error SPICE(NOTENOUGHPEAS) */ -/* is signalled. */ - -/* 3) If the location specified for location is not in the range */ -/* [1,NC], where NC is the number of elements in the active */ -/* group of the pod, the pod is not changed, and the error */ -/* SPICE(BADPODLOCATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to remove elements from the active */ -/* group of a pod without having to worry about checking for */ -/* impossible requests beforehand, or updating the cardinality */ -/* afterwards. */ - -/* $ Examples */ - -/* Elements can be removed from the active group of a pod */ -/* by hand, */ - -/* CALL PODOND ( POD, OFFSET, NUMBER ) */ -/* END = OFFSET + NUMBER */ - -/* CALL REMLAD ( N, OFFSET + LOC, POD(1), END ) */ -/* CALL SCARDD ( END, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for impossible requests. PODRE accomplishes the same thing, */ - -/* CALL PODIED ( N, LOC, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODRED", (ftnlen)6); - } - -/* Three things can go `wrong': */ - -/* 1) No items to remove. */ - -/* 2) Too many items to remove. */ - -/* 3) No place to remove them from. */ - - podond_(pod, &offset, &number); - if (*n < 1) { - chkout_("PODRED", (ftnlen)6); - return 0; - } else if (*loc + *n - 1 > number) { - setmsg_("LOC = #; N = #; there are only # elements.", (ftnlen)42); - errint_("#", loc, (ftnlen)1); - errint_("#", n, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(NOTENOUGHPEAS)", (ftnlen)20); - chkout_("PODRED", (ftnlen)6); - return 0; - } else if (*loc < 1 || *loc > number) { - setmsg_("Location (#) must be in the range [1,#].", (ftnlen)40); - errint_("#", loc, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(BADPODLOCATION)", (ftnlen)21); - chkout_("PODRED", (ftnlen)6); - return 0; - } - -/* No problem. This is just like $Examples, above. */ - - end = offset + number; - i__1 = offset + *loc; - remlad_(n, &i__1, &pod[6], &end); - scardd_(&end, pod); - chkout_("PODRED", (ftnlen)6); - return 0; -} /* podred_ */ - diff --git a/ext/spice/src/csupport/podrei.c b/ext/spice/src/csupport/podrei.c deleted file mode 100644 index 312e73f3d4..0000000000 --- a/ext/spice/src/csupport/podrei.c +++ /dev/null @@ -1,211 +0,0 @@ -/* podrei.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODREI ( Pod, remove elements, integer ) */ -/* Subroutine */ int podrei_(integer *n, integer *loc, integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), scardi_(integer *, - integer *), remlai_(integer *, integer *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, - ftnlen), errint_(char *, integer *, ftnlen); - extern logical return_(void); - integer end; - -/* $ Abstract */ - -/* Remove elements beginning at a specified location within the */ -/* active group of a pod. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ - -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* N I Number of elements to remove. */ -/* LOC I Location of first element to be removed. */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* N is the number of elements to be removed from the */ -/* active group of POD. */ - -/* LOC is the location (within the active group of the pod) */ -/* of the first element to be removed. */ - -/* POD on input, is a pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod, the active group of */ -/* which contains the elements preceding and following */ -/* the removed elements. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If N is not positive, the pod is not changed. */ - -/* 2) If the location of the last element to be removed (LOC+N-1) */ -/* is greater than the number of elements in the active group, */ -/* the pod is not changed, and the error SPICE(NOTENOUGHPEAS) */ -/* is signalled. */ - -/* 3) If the location specified for location is not in the range */ -/* [1,NC], where NC is the number of elements in the active */ -/* group of the pod, the pod is not changed, and the error */ -/* SPICE(BADPODLOCATION) is signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to remove elements from the active */ -/* group of a pod without having to worry about checking for */ -/* impossible requests beforehand, or updating the cardinality */ -/* afterwards. */ - -/* $ Examples */ - -/* Elements can be removed from the active group of a pod */ -/* by hand, */ - -/* CALL PODONI ( POD, OFFSET, NUMBER ) */ -/* END = OFFSET + NUMBER */ - -/* CALL REMLAI ( N, OFFSET + LOC, POD(1), END ) */ -/* CALL SCARDI ( END, POD ) */ - -/* However, this is tedious, and it gets worse when you have to */ -/* check for impossible requests. PODRE accomplishes the same thing, */ - -/* CALL PODIEI ( N, LOC, POD ) */ - -/* more simply, and with error-handling built in. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODREI", (ftnlen)6); - } - -/* Three things can go `wrong': */ - -/* 1) No items to remove. */ - -/* 2) Too many items to remove. */ - -/* 3) No place to remove them from. */ - - podoni_(pod, &offset, &number); - if (*n < 1) { - chkout_("PODREI", (ftnlen)6); - return 0; - } else if (*loc + *n - 1 > number) { - setmsg_("LOC = #; N = #; there are only # elements.", (ftnlen)42); - errint_("#", loc, (ftnlen)1); - errint_("#", n, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(NOTENOUGHPEAS)", (ftnlen)20); - chkout_("PODREI", (ftnlen)6); - return 0; - } else if (*loc < 1 || *loc > number) { - setmsg_("Location (#) must be in the range [1,#].", (ftnlen)40); - errint_("#", loc, (ftnlen)1); - errint_("#", &number, (ftnlen)1); - sigerr_("SPICE(BADPODLOCATION)", (ftnlen)21); - chkout_("PODREI", (ftnlen)6); - return 0; - } - -/* No problem. This is just like $Examples, above. */ - - end = offset + number; - i__1 = offset + *loc; - remlai_(n, &i__1, &pod[6], &end); - scardi_(&end, pod); - chkout_("PODREI", (ftnlen)6); - return 0; -} /* podrei_ */ - diff --git a/ext/spice/src/csupport/podrgc.c b/ext/spice/src/csupport/podrgc.c deleted file mode 100644 index b80dac72eb..0000000000 --- a/ext/spice/src/csupport/podrgc.c +++ /dev/null @@ -1,244 +0,0 @@ -/* podrgc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODRGC ( Pod, replace group, character ) */ -/* Subroutine */ int podrgc_(char *pod, ftnlen pod_len) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dcodec_(char *, - integer *, ftnlen), scardc_(integer *, char *, ftnlen), podonc_( - char *, integer *, integer *, ftnlen); - integer newoff, offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, replacing the previous group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ -/* $ */ -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been closed. In other words, the number of groups */ -/* has been reduced by one, and the new active group */ -/* contains the ... oh, look at $Examples. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* pod is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODRGC", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. To replace the previous */ -/* group, just move all of the elements of the active group */ -/* toward the front of the pod. The new cardinality, of course, */ -/* should be the new offset plus the number of elements in the */ -/* original group. */ - -/* If the pod contains only one group, we don't have to do */ -/* anything. */ - - podonc_(pod, &offset, &number, pod_len); - if (offset != 0) { - s_copy(pod + pod_len * 3, pod + (offset + 5) * pod_len, pod_len, - pod_len); - dcodec_(pod + (offset + 5) * pod_len, &newoff, pod_len); - i__1 = number; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(pod + (newoff + i__ + 5) * pod_len, pod + (offset + i__ + - 5) * pod_len, pod_len, pod_len); - } - i__1 = newoff + number; - scardc_(&i__1, pod, pod_len); - } - chkout_("PODRGC", (ftnlen)6); - return 0; -} /* podrgc_ */ - diff --git a/ext/spice/src/csupport/podrgd.c b/ext/spice/src/csupport/podrgd.c deleted file mode 100644 index 27e2e13dfd..0000000000 --- a/ext/spice/src/csupport/podrgd.c +++ /dev/null @@ -1,240 +0,0 @@ -/* podrgd.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODRGD ( Pod, replace group, double precision ) */ -/* Subroutine */ int podrgd_(doublereal *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dcoded_(doublereal *, - integer *), scardd_(integer *, doublereal *); - integer newoff; - extern /* Subroutine */ int podond_(doublereal *, integer *, integer *); - integer offset, number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, replacing the previous group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ -/* $ */ -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been closed. In other words, the number of groups */ -/* has been reduced by one, and the new active group */ -/* contains the ... oh, look at $Examples. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* pod is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODRGD", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. To replace the previous */ -/* group, just move all of the elements of the active group */ -/* toward the front of the pod. The new cardinality, of course, */ -/* should be the new offset plus the number of elements in the */ -/* original group. */ - -/* If the pod contains only one group, we don't have to do */ -/* anything. */ - - podond_(pod, &offset, &number); - if (offset != 0) { - pod[3] = pod[offset + 5]; - dcoded_(&pod[offset + 5], &newoff); - i__1 = number; - for (i__ = 1; i__ <= i__1; ++i__) { - pod[newoff + i__ + 5] = pod[offset + i__ + 5]; - } - i__1 = newoff + number; - scardd_(&i__1, pod); - } - chkout_("PODRGD", (ftnlen)6); - return 0; -} /* podrgd_ */ - diff --git a/ext/spice/src/csupport/podrgi.c b/ext/spice/src/csupport/podrgi.c deleted file mode 100644 index 222b57c4fc..0000000000 --- a/ext/spice/src/csupport/podrgi.c +++ /dev/null @@ -1,239 +0,0 @@ -/* podrgi.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PODRGI ( Pod, replace group, integer ) */ -/* Subroutine */ int podrgi_(integer *pod) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dcodei_(integer *, - integer *), scardi_(integer *, integer *); - integer newoff, offset, number; - extern /* Subroutine */ int podoni_(integer *, integer *, integer *), - chkout_(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* End the active group of a pod, replacing the previous group. */ - -/* $ 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 */ - -/* PODS */ - -/* $ Keywords */ -/* $ */ -/* ARRAY */ -/* CELLS */ -/* PODS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* POD I,O Pod. */ - -/* $ Detailed_Input */ - -/* POD on input, is an arbitrary pod. */ - -/* $ Detailed_Output */ - -/* POD on output, is the same pod after the active group */ -/* has been closed. In other words, the number of groups */ -/* has been reduced by one, and the new active group */ -/* contains the ... oh, look at $Examples. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the active group is the only group in the pod, the */ -/* pod is not changed. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* The active group of a pod may be removed by any of the */ -/* following routines: PODEG (end group), PODCG (close group), */ -/* or PODRG (replace group). */ - -/* PODEG effectively returns the pod to its state before the */ -/* active group was created. The contents of the active group */ -/* are simply lost. */ - -/* PODCG appends the contents of the active group to the previous */ -/* group to obtain the new active group, reducing the number of */ -/* groups in the pod by one. */ - -/* PODRG also reduces the number of groups, but by replacing the */ -/* previous group with the active group, as though the previous */ -/* group had never existed. */ - -/* $ Examples */ - -/* Let NAMES be a character POD containing the following groups: */ - -/* Group 1: NEWTON */ -/* GALILEO */ -/* KEPLER */ - -/* Group 2: EINSTEIN */ -/* BOHR */ -/* HEISENBERG */ - -/* Group 3: FEYNMAN */ -/* BARDEEN */ - -/* Following the call */ - -/* CALL PODEGC ( NAMES ) */ - -/* the active group (Group 2) contains EINSTEIN, BOHR, and */ -/* HEISENBERG. Following the call */ - -/* CALL PODCGC ( NAMES ) */ - -/* the active group (again, Group 2) contains EINSTEIN, BOHR, */ -/* HEISENBERG, FEYNMAN, and BARDEEN. Following the call */ - -/* CALL PODRGC ( NAMES ) */ - -/* the active group (also Group 2) contains FEYNMAN and BARDEEN. */ - -/* $ Restrictions */ - -/* 1) In any pod, only the active group should be accessed, */ -/* and its location should always be determined by PODBE */ -/* or PODON. Never assume that the active group begins */ -/* at POD(1). */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* I.M. Underwood (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 15-JUL-1989 (WLT) (IMU) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("PODRGI", (ftnlen)6); - } - -/* At any given time, the offset of the active group is stored */ -/* in location GRPOFF of the control area, so POD(GRPOFF) tells */ -/* us the location of the element preceding the active group. */ - -/* This element is a backward pointer, containing the offset of */ -/* the previous group; and so on, with turtles all the way down. */ -/* For example, consider a pod with three groups */ - -/* G. <10> */ -/* 1. Bob */ -/* 2. Carol */ -/* 3. Ted */ -/* 4. Alice */ -/* 5. <0> */ -/* 6. Fred */ -/* 7. Wilma */ -/* 8. Barney */ -/* 9. Bettey */ -/* 10. <5> */ -/* 11. Ricky */ -/* 12. Lucy */ -/* 13. Fred */ -/* 14. Ethel */ - -/* When the second group was created, the offset of the first */ -/* group (zero) was appended to the pod; the location of this */ -/* offset became the offset for the second group. When the */ -/* third group was created, the offset of the second group (5) */ -/* was appended; the location of this offset became the offset for */ -/* the third group. The offset for the third group is located */ -/* in element GRPOFF. */ - -/* To remove a group then, all that is necessary is to look at */ -/* element GRPOFF to get the offset of the current group; go to */ -/* that location to get the offset of the previous group; and */ -/* move that offset into element GRPOFF. To replace the previous */ -/* group, just move all of the elements of the active group */ -/* toward the front of the pod. The new cardinality, of course, */ -/* should be the new offset plus the number of elements in the */ -/* original group. */ - -/* If the pod contains only one group, we don't have to do */ -/* anything. */ - - podoni_(pod, &offset, &number); - if (offset != 0) { - pod[3] = pod[offset + 5]; - dcodei_(&pod[offset + 5], &newoff); - i__1 = number; - for (i__ = 1; i__ <= i__1; ++i__) { - pod[newoff + i__ + 5] = pod[offset + i__ + 5]; - } - i__1 = newoff + number; - scardi_(&i__1, pod); - } - chkout_("PODRGI", (ftnlen)6); - return 0; -} /* podrgi_ */ - diff --git a/ext/spice/src/csupport/prcomf.c b/ext/spice/src/csupport/prcomf.c deleted file mode 100644 index 6e7ce75d2c..0000000000 --- a/ext/spice/src/csupport/prcomf.c +++ /dev/null @@ -1,868 +0,0 @@ -/* prcomf.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ Procedure */ - -/* Subroutine */ int prcomf_0_(int n__, char *file, char *delim, char * - command, char *error, char *level, ftnlen file_len, ftnlen delim_len, - ftnlen command_len, ftnlen error_len, ftnlen level_len) -{ - /* Initialized data */ - - static integer nest = 0; - - /* System generated locals */ - integer i__1; - cilist ci__1; - cllist cl__1; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), f_clos(cllist *); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), - i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern logical have_(char *, ftnlen); - static integer i__, j; - static char files[80*8]; - static integer units[8]; - extern /* Subroutine */ int lbuild_(char *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen); - static integer iostat; - extern /* Subroutine */ int rstbuf_(void), putbuf_(char *, ftnlen), - txtopr_(char *, integer *, ftnlen); - - -/* $ Abstract */ - -/* Keep track of nested command files. */ - -/* $ 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. */ - -/* $ Keywords */ - -/* PARSE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* FILE I Command file. */ -/* DELIM I Symbol delimiting the end of a command. */ -/* COMMAND O Command read from FILE. */ -/* ERROR O Error flag. */ -/* LEVEL O A list of all files currently open. */ - -/* $ Detailed_Input */ - -/* FILE is the name of a file from which a sequence of commands */ -/* is to be read. These commands may include commands to */ -/* read from other files. */ - -/* DELIM is the character which delimits the end of each */ -/* instruction in FILE. */ - -/* $ Detailed_Output */ - -/* COMMAND is a command read from the current file. */ -/* If no files are currently open, COMMAND = DELIM. */ - -/* ERROR is a descriptive error message, which is blank when */ -/* no error occurs. */ - -/* LEVEL is a list of the files currently open, in the order */ -/* in which they were opened. It is provided for trace- */ -/* back purposes. */ - -/* $ Detailed_Description */ - -/* PRCOMF opens, reads, and closes sets of (possibly nested) */ -/* command files. For example, consider the following command */ -/* files. */ - -/* FILE_A : A1 FILE_B : B1 FILE_C : C1 */ -/* A2 START FILE_C C2 */ -/* A3 B2 C3 */ -/* START FILE_B B3 */ -/* A4 B4 */ -/* A5 */ - -/* If the command 'START FILE_A' were issued, we would expect the */ -/* following sequence of commands to ensue: */ - -/* A1, A2, A3, B1, C1, C2, C3, B2, B3, B4, A4, A5. */ - -/* The first file immediately becomes, ipso facto, the current file. */ -/* Subsequently, instructions are read from the current file until */ -/* either a START or the end of the file is encountered. Each time */ -/* a new START is encountered, the current file (that is, the */ -/* location of the next command in the file) is placed on a stack, */ -/* and the first command is read from the new file (which then */ -/* becomes the current file). Each time the end of the current file */ -/* is encountered, the previous file is popped off the top of the */ -/* stack to become the current file. This continues until there are */ -/* no files remaining on the stack. */ - -/* On occasion, the user may wish to exit from a file without */ -/* reading the rest of the file. In this case, the previous file */ -/* is popped off the stack without further ado. */ - -/* Also, the user may wish to abruptly stop an entire nested */ -/* set of files. In this case, all of the files are popped off */ -/* the stack, and no further commands are returned. */ - -/* PRCOMF and its entry points may be used to process any such */ -/* set of files. These entry points are: */ - -/* - PRCLR ( ERROR ) */ - -/* This clears the stack. It may thus be used to implement */ -/* a STOP command. In any case, it must be called before */ -/* any of the other entry points are called. */ - -/* - PRSTRT ( FILE, ERROR ) */ - -/* This introduces a new file, causing the current file (if */ -/* any) to be placed on the stack, and replacing it with FILE. */ -/* It may thus be used to implement a START command. */ - -/* If the file cannot be opened, or the stack is already */ -/* full (it can hold up to seven files), ERROR will contain */ -/* a descriptive error message upon return. Otherwise, it */ -/* will be blank. */ - -/* - PRREAD ( COMMAND ) */ - -/* This causes the next command to be read from the current */ -/* file. If the end of the current file is reached, the */ -/* previous file is popped off the stack, and the next command */ -/* from this file is read instead. (If no files remain to be */ -/* read, DELIM is returned.) */ - -/* - PREXIT */ - -/* This causes the previous file to be popped off the top of */ -/* the stack to replace the current file. It may thus be used */ -/* to implement an EXIT command. */ - -/* - PRTRCE ( LEVEL ) */ - -/* Should an error occur during the execution of a nested */ -/* file, it may be helpful to know the sequence in which */ -/* the nested files were invoked. PRTRCE returns a list of */ -/* the files currently open, in the order in which they were */ -/* invoked. */ - -/* $ Input_Files */ - -/* All files read by PRCOMF are opened with logical units */ -/* determined at run time. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Common */ - -/* None. */ - -/* $ Output_Common */ - -/* None. */ - -/* $ Examples */ - -/* See Detailed_Description. */ - -/* $ Restrictions */ - -/* The declared length of ERROR should be at least 80, to avoid */ -/* truncationof error messages. */ - -/* $ Author_and_Institution */ - -/* W. L. Taber (JPL) */ -/* I. M. Underwood (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* Version 1, 6-SEP-1986 */ - -/* -& */ - -/* OPTLIB functions */ - - -/* Local variables */ - - -/* NFILES is the maximum number of files that may be open at */ -/* any given time. THus, nesting of procedures is limited to */ -/* a depth of NFILES. */ - - -/* NEST is the number of files currently open. */ - - -/* FILES are the names of the files on the stack. UNITS are */ -/* the logical units to which they are connected. */ - - switch(n__) { - case 1: goto L_prclr; - case 2: goto L_prstrt; - case 3: goto L_prread; - case 4: goto L_prexit; - case 5: goto L_prtrce; - } - - return 0; - -/* $ Procedure PRCLR */ - - -L_prclr: - -/* $ Abstract */ - -/* Clear the file stack. */ - -/* $ 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. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Detailed_Description */ - -/* Pop all the files off the stack. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - */ - while(nest > 0) { - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "prcomf_", (ftnlen)326)]; - cl__1.csta = 0; - f_clos(&cl__1); - --nest; - } - return 0; - -/* $ Procedure PRSTRT */ - - -L_prstrt: - -/* $ Abstract */ - -/* Put the current file on the stack, and replace it with FILE. */ - -/* $ 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. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* FILE I New command file. */ -/* ERROR O Error flag. */ - -/* $ Detailed_Input */ - -/* FILE is the new current file from which commands are */ -/* to be read. */ - -/* $ Detailed_Output */ - -/* ERROR is blank when no error occurs, and otherwise contains */ -/* a descriptive message. Possible errors are: */ - -/* - The stack is full. */ - -/* - FILE could not be opened. */ - -/* $ Input_Files */ - -/* FILE is opened with a logical unit determined at run time. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Detailed_Description */ - -/* If the stack is full, return an error. Otherwise, try to open */ -/* FILE. If an error occurs, return immediately. Otherwise, put */ -/* the current file on the stack, and increase the nesting level. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - */ - -/* No error yet. */ - - s_copy(error, " ", error_len, (ftnlen)1); - -/* Proceed only if the stack is not full. */ - - if (nest == 8) { - s_copy(error, "PRSTRT: Command files are nested too deeply.", - error_len, (ftnlen)44); - return 0; - } else { - ++nest; - } - -/* Get a new logical unit. If none are available, abort. */ - - txtopr_(file, &units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "prcomf_", (ftnlen)445)], file_len); - if (have_(error, error_len)) { - --nest; - } else { - s_copy(files + ((i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "files", i__1, "prcomf_", (ftnlen)450)) * 80, file, (ftnlen) - 80, file_len); - } - return 0; - -/* $ Procedure PRREAD */ - - -L_prread: - -/* $ Abstract */ - -/* Read the next command from the current file. */ - -/* $ 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. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* DELIM I Character delimiting the end of a command. */ -/* COMMAND O Next command from the current file. */ - -/* $ Detailed_Input */ - -/* DELIM is the character used to delimit the end of a */ -/* command within a command file. */ - -/* $ Detailed_Output */ - -/* COMMAND is the next command read from the current file. */ -/* If there is no current file, COMMND = DELIM. */ - -/* $ Input_Files */ - -/* All files read by PRCOMF are opened with logical units */ -/* determined at run time. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Detailed_Description */ - -/* Attempt to read the next statement from the current file. */ -/* If the end of the file is encountered, pop the previous file */ -/* off the top of the stack, and try to read from it. Keep this */ -/* up until a command is read, or until no files remain open. */ - - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - */ - -/* Don't even bother unless at least one file is open. */ - - if (nest == 0) { - s_copy(command, delim, command_len, (ftnlen)1); - return 0; - } - -/* Keep trying to read until we run out of files. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge( - "units", i__1, "prcomf_", (ftnlen)558)]; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100001; - } - iostat = do_fio(&c__1, command, command_len); - if (iostat != 0) { - goto L100001; - } - iostat = e_rsfe(); -L100001: - while(iostat != 0 && nest > 0) { - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "prcomf_", (ftnlen)562)]; - cl__1.csta = 0; - f_clos(&cl__1); - --nest; - if (nest >= 1) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "prcomf_", (ftnlen)566)]; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, command, command_len); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - ; - } - } - rstbuf_(); - if (nest == 0) { - s_copy(command, delim, command_len, (ftnlen)1); - putbuf_(command, command_len); - return 0; - } - putbuf_(command, command_len); - -/* Okay, we have something. Keep reading until DELIM is found. */ -/* (Or until the file ends.) Add each successive line read to */ -/* the end of COMMAND. Do not return the delimiter itself. */ - - j = 1; - i__ = i_indx(command, delim, command_len, (ftnlen)1); - while(i__ == 0 && iostat == 0) { - j = lastnb_(command, command_len) + 1; - *(unsigned char *)&command[j - 1] = ' '; - ++j; - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "prcomf_", (ftnlen)597)]; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, command + (j - 1), command_len - (j - 1)); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - putbuf_(command + (j - 1), command_len - (j - 1)); - i__ = i_indx(command, delim, command_len, (ftnlen)1); - } - if (i__ > 0) { - s_copy(command + (i__ - 1), " ", command_len - (i__ - 1), (ftnlen)1); - } - return 0; - -/* $ Procedure PREXIT */ - - -L_prexit: - -/* $ Abstract */ - -/* Replace the current file with the one at the top of the stack. */ - -/* $ 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. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Detailed_Description */ - -/* Close the current file. Pop the previous file off the top of */ -/* the stack. If there is no current file, of if there are no */ -/* files on the stack, that's cool too. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - */ - if (nest > 0) { - cl__1.cerr = 0; - cl__1.cunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : - s_rnge("units", i__1, "prcomf_", (ftnlen)695)]; - cl__1.csta = 0; - f_clos(&cl__1); - --nest; - } - return 0; - -/* $ Procedure PRTRCE */ - - -L_prtrce: - -/* $ Abstract */ - -/* Provide a list of the files currently open, in the order in */ -/* which they were opened. */ - -/* $ 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. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- --------------------------------------------------- */ -/* LEVEL O List of all files currently open. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* LEVEL A list of all files that are currently open, in */ -/* the order in which they were opened. For example, */ -/* if FILE_A starts FILE_B, and FILE_B starts FILE_C, */ -/* LEVEL would be 'FILE_A:FILE_B:_FILE_C'. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Detailed_Description */ - -/* Just step through the stack, Jack. */ - -/* $ Examples */ - -/* See Detailed_Description. */ - -/* $ Restrictions */ - -/* LEVEL should be declared to be at least CHARACTER*640 by the */ -/* calling program to ensure that enough space is available to */ -/* list all open files. */ -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - -/* - */ - -/* Not much to explain. Use LBUILD to build a list, delimited */ -/* by colons. */ - - s_copy(level, " ", level_len, (ftnlen)1); - if (nest > 0) { - lbuild_(files, &nest, ":", level, (ftnlen)80, (ftnlen)1, level_len); - } - return 0; -} /* prcomf_ */ - -/* Subroutine */ int prcomf_(char *file, char *delim, char *command, char * - error, char *level, ftnlen file_len, ftnlen delim_len, ftnlen - command_len, ftnlen error_len, ftnlen level_len) -{ - return prcomf_0_(0, file, delim, command, error, level, file_len, - delim_len, command_len, error_len, level_len); - } - -/* Subroutine */ int prclr_(void) -{ - return prcomf_0_(1, (char *)0, (char *)0, (char *)0, (char *)0, (char *)0, - (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int prstrt_(char *file, char *error, ftnlen file_len, ftnlen - error_len) -{ - return prcomf_0_(2, file, (char *)0, (char *)0, error, (char *)0, - file_len, (ftnint)0, (ftnint)0, error_len, (ftnint)0); - } - -/* Subroutine */ int prread_(char *delim, char *command, ftnlen delim_len, - ftnlen command_len) -{ - return prcomf_0_(3, (char *)0, delim, command, (char *)0, (char *)0, ( - ftnint)0, delim_len, command_len, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int prexit_(void) -{ - return prcomf_0_(4, (char *)0, (char *)0, (char *)0, (char *)0, (char *)0, - (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int prtrce_(char *level, ftnlen level_len) -{ - return prcomf_0_(5, (char *)0, (char *)0, (char *)0, (char *)0, level, ( - ftnint)0, (ftnint)0, (ftnint)0, (ftnint)0, level_len); - } - diff --git a/ext/spice/src/csupport/prepsn.c b/ext/spice/src/csupport/prepsn.c deleted file mode 100644 index 2f116b81dd..0000000000 --- a/ext/spice/src/csupport/prepsn.c +++ /dev/null @@ -1,316 +0,0 @@ -/* prepsn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; - -/* $Procedure PREPSN (Pretty print syntax definition) */ -/* Subroutine */ int prepsn_(char *string, ftnlen string_len) -{ - /* System generated locals */ - address a__1[2]; - integer i__1[2]; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - char long__[2000], word[63]; - integer b, e, r__; - logical begin; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - integer start; - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer - *, ftnlen); - logical indent; - integer indnby; - logical crlast; - char outdnt[63]; - integer end; - -/* $ Abstract */ - -/* This routine prepares a string having a META/2 syntax description */ -/* for printing via NICEIO, NICEPR or NICEBT */ - -/* $ 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 */ - -/* FORMATTING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I/O a string to be prepare for display */ - -/* $ Detailed_Input */ - -/* STRING is a string that contains a META/2 syntax description. */ - -/* $ Detailed_Output */ - -/* STRING is the same string after having carriage return */ -/* markers inserted into it for use by display routines */ -/* NICEIO, NICEPR or NICEBT */ - -/* $ Parameters */ - -/* MAXLEN is the maximum length string that can be supported */ -/* for pretty printing. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This routine allows you to easily prepare a META/2 syntax */ -/* specification for display using one of the routines NICEIO */ -/* NICEPR or NICEBT. The routine steps through the input */ -/* routine a word at a time to locate the markers used in */ -/* META/2 switches. It assumes the string '/cr' is used for */ -/* the new line marker within a string. */ - -/* Newlines are always inserted at the beginning of a switch (x:y){, */ -/* after a switch separator '|' and after the end of a switch }. */ -/* Care is taken so that the construct */ - -/* } (x:y){ */ - -/* becomes */ - -/* }/cr (x:y){ */ - -/* and not */ - -/* }/cr(x:y){ */ - -/* or */ - -/* }/cr/cr (x:y){ */ - -/* $ Examples */ - -/* This routine is meant for internal use by the routine */ -/* META_2. However, if you have a sequence of strings that */ -/* you would like to prepare for display in documentation */ -/* you might want to use this routine together with */ -/* NICEIO or one of its cousins for preparing your documentation. */ - -/* DO I = 1, NSYN */ - -/* TEMP = SYNTAX */ - -/* CALL PREPSN ( TEMP ) */ -/* CALL NICEIO ( TEMP, UNIT, 'LEFT 1 RIGHT 78' ) */ -/* WRITE (UNIT,*) ' ' */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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, 9-MAY-1994 (WLT) */ - -/* This is the configured version of META/2 */ -/* software as of May 9, 1994 */ - - -/* -& */ -/* $ Index_Entries */ - -/* «We need a permuted index entry */ - -/* -& */ - -/* Set the initial states. */ - -/* START we start looking at the string at the first character */ -/* E end of the first word (we have to start somewhere) */ -/* END is the end of the local buffer LONG. */ -/* INDBY is the amount we've indented things. */ -/* LONG is our local string for creating the pretty print string */ -/* OUTDNT is the string for controlling out-denting */ -/* BEGIN we have not begun processing a swithc */ -/* INDENT we have not indented */ -/* CRLAST we did not put a '/cr' in the last word we processed. */ - - start = 1; - e = 1; - end = 1; - indnby = 0; - s_copy(long__, " ", (ftnlen)2000, (ftnlen)1); - s_copy(outdnt, " ", (ftnlen)63, (ftnlen)1); - begin = FALSE_; - indent = FALSE_; - crlast = FALSE_; - -/* Process the string a word at a time untill we've seen it all. */ - - while(e != 0) { - fndnwd_(string, &start, &b, &e, string_len); - if (e > 0) { - if (*(unsigned char *)&string[e - 1] == '{') { - -/* There was a word left in the string. The beginning */ -/* of a switch ends with '{' */ - - begin = TRUE_; - indent = FALSE_; - if (crlast) { - crlast = FALSE_; -/* Writing concatenation */ - i__1[0] = 1, a__1[0] = " "; - i__1[1] = e - (b - 1), a__1[1] = string + (b - 1); - s_cat(word, a__1, i__1, &c__2, (ftnlen)63); - } else { - s_copy(word, "/cr(:1) ", (ftnlen)8, (ftnlen)8); - s_copy(word + 8, string + (b - 1), (ftnlen)55, e - (b - 1) - ); - } - -/* We shall indent (if we do at all) by the number */ -/* of characters that precede the left bracket '{' */ - - indnby = e - b; - } else if (s_cmp(string + (b - 1), "|", e - (b - 1), (ftnlen)1) == - 0) { - -/* Switch separators appear all by themselves a words. */ - - if (begin) { - -/* This is the first separator of this switch, we */ -/* are probably going to indent. And we are no */ -/* longer in the beginning simple template of the */ -/* switch. */ - - begin = FALSE_; - indent = TRUE_; - if (indnby > 0) { - -/* Create the indent and outdent strings. */ - - s_copy(word, "/cr(#:)|", (ftnlen)63, (ftnlen)8); - s_copy(outdnt, "/cr(-#:)", (ftnlen)63, (ftnlen)8); - repmi_(word, "#", &indnby, word, (ftnlen)63, (ftnlen) - 1, (ftnlen)63); - repmi_(outdnt, "#", &indnby, outdnt, (ftnlen)63, ( - ftnlen)1, (ftnlen)63); - } else { - s_copy(word, "/cr|", (ftnlen)63, (ftnlen)4); - s_copy(outdnt, "/cr(0:0)", (ftnlen)63, (ftnlen)8); - } - } else { - -/* We are not at the beginning so there is no */ -/* need to indent. */ - - s_copy(word, "/cr|", (ftnlen)63, (ftnlen)4); - } - } else if (*(unsigned char *)&string[b - 1] == '}') { - -/* We are at the end of a switch (there might be some */ -/* other stuff such as user punctuation in the string */ -/* so we don't require STRING(B:E) .EQ. '}' */ - - begin = FALSE_; - if (indent) { - indent = FALSE_; -/* Writing concatenation */ - i__1[0] = e - (b - 1), a__1[0] = string + (b - 1); - i__1[1] = 63, a__1[1] = outdnt; - s_cat(word, a__1, i__1, &c__2, (ftnlen)63); - } else { -/* Writing concatenation */ - i__1[0] = e - (b - 1), a__1[0] = string + (b - 1); - i__1[1] = 8, a__1[1] = "/cr(0:0)"; - s_cat(word, a__1, i__1, &c__2, (ftnlen)63); - } - -/* We just put in a carriage return at the end of a switch. */ -/* Set our logical flag that says we did this. */ - - crlast = TRUE_; - } else { - -/* This word is to be treated as an ordinatry word. */ - - s_copy(word, string + (b - 1), (ftnlen)63, e - (b - 1)); - crlast = FALSE_; - } - r__ = rtrim_(word, (ftnlen)63); - s_copy(long__ + (end - 1), word, end + r__ - (end - 1), (ftnlen) - 63); - end = end + r__ + 1; - } - start = e + 1; - } - -/* That's all folks. Move our long string into STRING and */ -/* return. */ - - s_copy(string, long__, string_len, end); - return 0; -} /* prepsn_ */ - diff --git a/ext/spice/src/csupport/prtrap.c b/ext/spice/src/csupport/prtrap.c deleted file mode 100644 index 539f5f15cb..0000000000 --- a/ext/spice/src/csupport/prtrap.c +++ /dev/null @@ -1,208 +0,0 @@ -/* prtrap.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PRTRAP */ -/* Subroutine */ int prtrap_(char *command, logical *tran, ftnlen command_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - char word[33*3]; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), nthwd_( - char *, integer *, char *, integer *, ftnlen, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - integer loc; - -/* $ Abstract */ - -/* Determine whether the given command should be trapped (left */ -/* untranslated). */ - -/* $ 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. */ - -/* $ Keywords */ - -/* PERCY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* COMMND I PERCY command to be evaluated. */ -/* TRAN I True if further translation is needed. */ - -/* $ Detailed_Input */ - -/* COMMAND is the input PERCY command. The following commands */ -/* should not be translated fully. (A moment's thought */ -/* will show why.) */ - -/* - SHOW SYMBOL */ - -/* - INQUIRE */ - -/* If translation has proceeded far enough for either */ -/* of these statements to be recognized, then it has */ -/* gone far enough. */ - -/* $ Detailed_Output */ - -/* TRAN is true if further translation of COMMAND is okay. */ -/* If any of the statements mentioned above is recognized, */ -/* TRAN is false. (This will prevent PERCY from trying */ -/* to resolve any more symbols.) */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* See 'SYMBOLS.INC'. */ - -/* $ Detailed_Description */ - -/* Get the first three words of COMMAND. */ - -/* - If the first two words are SHOW SYMBOL, and the */ -/* third word is not blank and does not end with '?', */ -/* then this should be trapped. */ - -/* - If the first word is INQUIRE and the second word */ -/* is not blank and does not end with '?', then this */ -/* should be trapped. */ - -/* If the statement should be trapped, set TRAN to false and return. */ - -/* $ Examples */ - -/* Command Trap? */ -/* ------------------------------------ ----- */ -/* 'SHOW SYMBOL CARROT ' Y */ -/* 'SHOW SYMBOL ' N */ -/* 'SHOW SYMBOL SYMBOL_NAME? ' N */ - -/* 'INQUIRE PRIMARY_PLANET ' N */ -/* 'INQUIRE ' Y */ -/* 'INQUIRE QUERY_NAME? ' Y */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W. L. Taber (JPL) */ -/* I. M. Underwood (JPL) */ - -/* $ Version_and_Date */ - -/* Version 1, 17-SEP-1986 */ - -/* -& */ - -/* Spicelib Functions */ - - -/* Local variables */ - - -/* Get the first three words of COMMAND. */ - - for (i__ = 1; i__ <= 3; ++i__) { - nthwd_(command, &i__, word + ((i__1 = i__ - 1) < 3 && 0 <= i__1 ? - i__1 : s_rnge("word", i__1, "prtrap_", (ftnlen)144)) * 33, & - loc, command_len, (ftnlen)33); - ucase_(word + ((i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge( - "word", i__1, "prtrap_", (ftnlen)145)) * 33, word + ((i__2 = - i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("word", i__2, "prt" - "rap_", (ftnlen)145)) * 33, (ftnlen)33, (ftnlen)33); - } - -/* Is this a SHOW SYMBOL command? */ - - if (s_cmp(word, "SHOW", (ftnlen)33, (ftnlen)4) == 0 && s_cmp(word + 33, - "SYMBOL", (ftnlen)33, (ftnlen)6) == 0) { - -/* The third word must not be blank, and must not end with '?'. */ -/* (WORD is longer than any allowable symbol or query, so there */ -/* should always be a blank at the end.) */ - - if (s_cmp(word + 66, " ", (ftnlen)33, (ftnlen)1) != 0) { - loc = rtrim_(word + 66, (ftnlen)33); - if (*(unsigned char *)&word[loc + 65] != '?') { - *tran = FALSE_; - return 0; - } - } - -/* Is this an INQUIRE command? */ - - } else if (s_cmp(word, "INQUIRE", (ftnlen)33, (ftnlen)7) == 0) { - -/* The second word must not be blank, and must not end with '?'. */ - - if (s_cmp(word + 33, " ", (ftnlen)33, (ftnlen)1) != 0) { - loc = rtrim_(word + 33, (ftnlen)33); - if (*(unsigned char *)&word[loc + 32] == '?') { - *tran = FALSE_; - chkin_("PRTRAP", (ftnlen)6); - setmsg_("INQUIRE commands must be of the form INQUIRE , You have INQUIRE # which is inquiring for " - "the value of a query. This kind of INQUIRE is not su" - "pported. ", (ftnlen)164); - errch_("#", word + 33, (ftnlen)1, (ftnlen)33); - sigerr_("INVALID_INQUIRE", (ftnlen)15); - chkout_("PRTRAP", (ftnlen)6); - return 0; - } - } - } - -/* No reason to trap this. */ - - *tran = TRUE_; - return 0; -} /* prtrap_ */ - diff --git a/ext/spice/src/csupport/pstack.c b/ext/spice/src/csupport/pstack.c deleted file mode 100644 index e328d27448..0000000000 --- a/ext/spice/src/csupport/pstack.c +++ /dev/null @@ -1,1092 +0,0 @@ -/* pstack.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure PSTACK (Save paragraphs of text in a paragraph stack) */ -/* Subroutine */ int pstack_0_(int n__, integer *depth, char *line, char * - buffer, ftnlen line_len, ftnlen buffer_len) -{ - /* Initialized data */ - - static integer buffrd = 0; - static integer currnt = 1; - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static integer last, quit, i__, range, getat; - static char lines[132*400]; - static integer bsize; - extern integer sizec_(char *, ftnlen); - static integer putat, start, begend[40] /* was [2][20] */; - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen); - static integer backup, gotten; - extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen); - -/* $ Abstract */ - -/* Buffer and fetch paragraphs of text. Buffering is performed */ -/* a line at a time. Fetching is done a "paragraph" at a time. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O ENTRY POINT */ -/* -------- --- -------------------------------------------------- */ -/* DEPTH I GETBUF, GETBSZ */ -/* LINE I PUTBUF */ -/* BUFFER I/O PUTBUF */ -/* NPGRPH P Number of paragraphs that can be buffered */ -/* AVESIZ P Average number of lines per paragraph */ -/* LNSIZE P Number of characters per line in a paragraph. */ - -/* $ Detailed_Input */ - -/* DEPTH is the depth in the "paragraph-stack" from which to */ -/* fetch a "paragraph" of text. The top-most */ -/* level of the paragraph stack is at depth 1. The */ -/* next level down in the stack is at depth 2, etc. */ - -/* LINE is a line of text that should be added to the */ -/* current "paragraph" of buffered text. */ - -/* BUFFER is a properly initialized cell that will be used */ -/* to fetch saved lines of text. */ - -/* $ Detailed_Output */ - -/* BUFFER contains the paragraph of text from paragraph buffer */ -/* at the depth specified in the call to GETBUF. */ - -/* $ Parameters */ - -/* NPGRPH is the maximum number of paragraphs that will be */ -/* buffered. This should be at least 1 */ - -/* AVESIZ is the average number of lines per paragraph. This */ -/* should be at least 10. */ - -/* LNSIZE is the number of characters per line in a paragraph. */ -/* This should be at least 80. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If the DEPTH specified is deeper than the deepest level of */ -/* the stack. The deepest paragraph will be returned. */ - -/* 2) If the DEPTH specified is zero or less, the BUFFER will be */ -/* returned with no lines of text. */ - -/* 3) If no lines were buffered at a particular depth of the */ -/* paragraph stack, the paragraph buffer will be returned */ -/* with no lines of text. */ - - - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Consider the following problem. */ - -/* 1) You have a program that uses strings of text as commands */ -/* to controll the action of the program. */ - -/* 2) Many commands are too long to fit within the space provided */ -/* by a terminal (or terminal window) line. */ - -/* 3) Your program captures full commands by reading terminal */ -/* (or terminal window) lines one at a time with continuation */ -/* and concatenation to create a full command. */ - -/* COMMAND = ' ' */ - -/* DO WHILE ( MORE(COMMAND) ) */ - -/* READ (*,FMT='(A)' ) LINE */ -/* CALL SUFFIX ( LINE, 1, COMMAND ) */ - -/* ... */ -/* END DO */ -/* (For convenience the original set of input lines forming the */ -/* command is called a paragraph.) */ - -/* 4) You would like to preserve the original format of the command */ -/* as it was typed. */ - -/* This routine serves as an umbrella routine for a family of */ -/* entry points that perform the buffering and fetching of the */ -/* original input lines to your program. Moreover, it buffers */ -/* upto 20 of the input paragraphs so that you can easily recall */ -/* the history of the command sequence entered in your program. */ - -/* $ Examples */ - -/* Following the scenario above, here is how you would go about */ -/* buffering a paragraph of input. */ - -/* Set up for the buffering of the next paragraph. */ - -/* CALL RSTBUF ( ) */ - -/* Empty out the command we will be constructing. */ - -/* COMMAND = ' ' */ -/* MORE = .TRUE. */ - -/* DO WHILE ( MORE ) */ - -/* READ (*,FMT='(A)' ) LINE */ -/* CALL PUTBUF ( LINE ) */ -/* CALL SUFFIX ( LINE, 1, COMMAND ) */ - -/* Examine line or command as appropriate to determine if */ -/* we should expect more text for the command we are */ -/* constructing. */ - -/* ... */ - -/* END DO */ - -/* Once paragraphs have been buffered, you may fetch the last command */ -/* (depth 1), next to last command (depth 2) and so on to a depth */ -/* of MAXDPT buffered paragraphs. To do this you must create */ -/* a character cell and initialize it so that the input lines */ -/* can be returned exactly as they were input. */ - -/* Declaration of the buffer used for returning input lines. */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER LNSIZE */ -/* PARAMETER ( LNSIZE = Number of characters */ -/* used the declaration of */ -/* LINE used in the last code */ -/* fragment ) */ - - -/* INTEGER MAXLIN */ -/* PARAMETER ( MAXLIN = Maximum number of lines that */ -/* will ever be used to create */ -/* a command. ) */ - -/* CHARACTER*(LNSIZE) BUFFER ( LBCELL : MAXLIN ) */ - - -/* Initialize the cell BUFFER */ - -/* CALL SSIZEC ( MAXLIN, BUFFER ) */ - -/* Fetch the next to last command entered to the program. */ - -/* DEPTH = 2 */ - -/* CALL GETBUF ( DEPTH, BUFFER ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 12-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Buffer paragraphs text a line at a time */ -/* Fetch buffered lines of text a paragraph at a time */ - -/* -& */ - -/* Local Parameters */ - - -/* Spicelib Functions */ - - -/* Local Buffers */ - - -/* In-line function dummy arguments */ - - -/* In-line functions */ - - -/* Local Variables */ - - /* Parameter adjustments */ - if (buffer) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_rstbuf; - case 2: goto L_putbuf; - case 3: goto L_getbuf; - case 4: goto L_getbsz; - case 5: goto L_dmpbuf; - } - - -/* In-line functions for computing the next and previous item */ -/* in a circular list of items. */ - - return 0; -/* $Procedure RSTBUF (Reset paragraph buffering) */ - -L_rstbuf: -/* $ Abstract */ - -/* Reset the paragraph buffering so that a new paragraph */ -/* of text can be buffered. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* Later. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point works by side effect. It resets the internal */ -/* parameters of the paragraph buffering code so that programs */ -/* may begin buffering a new paragraph of text and distinguish */ -/* it from previously buffered paragraphs. */ - -/* This routine should only be called when you want to start */ -/* buffering text as a new paragraph. */ - -/* $ Examples */ - -/* See the umbrella routine PSTACK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 12-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Prepare for buffering paragraphs of text. */ - -/* -& */ - -/* On the first call to the buffering routines we need to */ -/* initialize our buffering pointers. */ - - if (first) { - first = FALSE_; - currnt = 1; - buffrd = 1; - begend[(i__1 = (currnt << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)458)] = 1; - begend[(i__1 = (currnt << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)459)] = 1; - for (i__ = 1; i__ <= 400; ++i__) { - s_copy(lines + ((i__1 = i__ - 1) < 400 && 0 <= i__1 ? i__1 : - s_rnge("lines", i__1, "pstack_", (ftnlen)462)) * 132, - " ", (ftnlen)132, (ftnlen)1); - } - } else { - -/* Store the current buffer pointer and compute the */ -/* next one. */ - -/* Computing MIN */ - i__1 = buffrd + 1; - buffrd = min(i__1,20); - last = currnt; - range = 20; - currnt = currnt + 1 - currnt / range * range; - -/* Now compute the pointers to the beginning and ending of */ -/* data in the buffer that saves input lines. */ - - range = 400; - begend[(i__1 = (currnt << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)480)] = begend[(i__2 = ( - last << 1) - 1) < 40 && 0 <= i__2 ? i__2 : s_rnge("begend", - i__2, "pstack_", (ftnlen)480)] + 1 - begend[(i__2 = (last << - 1) - 1) < 40 && 0 <= i__2 ? i__2 : s_rnge("begend", i__2, - "pstack_", (ftnlen)480)] / range * range; - begend[(i__1 = (currnt << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)481)] = begend[(i__2 = ( - currnt << 1) - 2) < 40 && 0 <= i__2 ? i__2 : s_rnge("begend", - i__2, "pstack_", (ftnlen)481)]; - } - return 0; -/* $Procedure PUTBUF ( Put a line of text in the paragraph buffer ) */ - -L_putbuf: -/* $ Abstract */ - -/* Append the input line of text to the current paragraph */ -/* that is being buffered. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* Later. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* LINE I a line of text to append to the current paragraph */ - -/* $ Detailed_Input */ - -/* LINE is a line of text that will be appended to the */ -/* paragraph that was begun with the last call to */ -/* RSTBUF. */ - -/* LINE should be declared to be no more than LNSIZE */ -/* characters in length (See PSTACK for the value */ -/* of LNSIZE.) */ - -/* $ Detailed_Output */ - -/* None */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine works in conjuction with RSTBUF so that the input */ -/* line of text is appended to the paragraph of text that was begun */ -/* by the last call to RSTBUF. */ - -/* $ Examples */ - -/* See the example in the umbrella routine PSTACK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 12-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Add a line of text to the current paragraph of input. */ - -/* -& */ - -/* If things haven't already been initialized, we do so now. */ - - if (first) { - first = FALSE_; - currnt = 1; - buffrd = 1; - begend[(i__1 = (currnt << 1) - 2) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)616)] = 1; - begend[(i__1 = (currnt << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)617)] = 1; - for (i__ = 1; i__ <= 400; ++i__) { - s_copy(lines + ((i__1 = i__ - 1) < 400 && 0 <= i__1 ? i__1 : - s_rnge("lines", i__1, "pstack_", (ftnlen)620)) * 132, - " ", (ftnlen)132, (ftnlen)1); - } - } - -/* Store the input line. */ - - range = 400; - putat = begend[(i__1 = (currnt << 1) - 1) < 40 && 0 <= i__1 ? i__1 : - s_rnge("begend", i__1, "pstack_", (ftnlen)629)]; - s_copy(lines + ((i__1 = putat - 1) < 400 && 0 <= i__1 ? i__1 : s_rnge( - "lines", i__1, "pstack_", (ftnlen)630)) * 132, line, (ftnlen)132, - line_len); - -/* Find out where to put the next line of input. */ - - begend[(i__1 = (currnt << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge("beg" - "end", i__1, "pstack_", (ftnlen)634)] = putat + 1 - putat / range * - range; - return 0; -/* $Procedure GETBUF (Get a paragraph at specified depth in a buffer) */ - -L_getbuf: -/* $ Abstract */ - -/* Fetch the paragraph at the specified depth and return it in the */ -/* supplied buffer. */ - -/* $ 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 */ - -/* UTILITY */ - -/* $ Declarations */ - -/* Later. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DEPTH I Depth in paragraph stack to fetch data from */ -/* BUFFER I/O An pre-initialized cell to return data in. */ - -/* $ Detailed_Input */ - -/* DEPTH is the depth of the paragraph to return. DEPTH */ -/* should be a positive integer between 1 (the current */ -/* paragraph depth) and NPGRPH (the most deeply buffered */ -/* paragraph). If DEPTH is zero or more, no lines */ -/* will be returned. If DEPTH is larger than the */ -/* deepest available buffered paragraph, the most */ -/* deeply buffered paragraph will be returned. */ - -/* BUFFER a properly initialized cell into which lines of */ -/* text may be stored. */ - -/* $ Detailed_Output */ - -/* BUFFER is the input buffer but now with the requested */ -/* paragraph stored in it. The first line of the */ -/* paragraph appears in BUFFER(1), the second line */ -/* in BUFFER(2), etc. The actual number of lines */ -/* in the buffer is equal to the cardinality of BUFFER */ -/* on output. */ - -/* If no lines were available to put in BUFFER, the */ -/* cardinality of buffer will be zero. */ - -/* It is recommended that BUFFER be declared by the */ -/* calling routine with size no more than LNSIZE. */ -/* (See the umbrella routine for the value of LNSIZE). */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* 1) If DEPTH is zero or negative, BUFFER will be returned with */ -/* a cardinality of zero and no valid lines of text. */ - -/* 2) If DEPTH specifies a paragraph beyond the depth of those */ -/* that have been buffered, BUFFER will be returned with a */ -/* cardinality of zero and no valid lines of text. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point enables you to retrieve buffered paragraphs */ -/* of text. The paragraph to retrieve is specified by its depth */ -/* in the paragraph stack buffer. */ - -/* $ Examples */ - -/* See the umbrella routine for an example of usage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 12-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Retrieve a paragraph from a specified depth in the stack */ - -/* -& */ - -/* First empty the buffer where we will be sending the buffered */ -/* inputs. */ - - bsize = sizec_(buffer, buffer_len); - ssizec_(&bsize, buffer, buffer_len); - -/* DEPTH represents how deep we want to push down into the */ -/* buffer of items. 1 is the current, 2 is immediately before */ -/* that and so on... */ - -/* Computing MIN */ - i__1 = *depth - 1, i__2 = buffrd - 1; - backup = min(i__1,i__2); - if (backup < 0) { - -/* This is probably a mistake, but we will not pass any */ -/* moral judgements on the request to get data, we simply */ -/* return the buffer empty. */ - - return 0; - } - -/* Backup from the current position the appropriate number to */ -/* find out where to get the buffered input lines. */ - - getat = currnt; - range = 20; - i__1 = backup; - for (i__ = 1; i__ <= i__1; ++i__) { - getat = getat - 1 + (range - getat + 1) / range * range; - } - start = begend[(i__1 = (getat << 1) - 2) < 40 && 0 <= i__1 ? i__1 : - s_rnge("begend", i__1, "pstack_", (ftnlen)817)]; - quit = begend[(i__1 = (getat << 1) - 1) < 40 && 0 <= i__1 ? i__1 : s_rnge( - "begend", i__1, "pstack_", (ftnlen)818)]; - gotten = 0; - range = 400; - while(start != quit && gotten <= bsize) { - ++gotten; - s_copy(buffer + (gotten + 5) * buffer_len, lines + ((i__1 = start - 1) - < 400 && 0 <= i__1 ? i__1 : s_rnge("lines", i__1, "pstack_", - (ftnlen)825)) * 132, buffer_len, (ftnlen)132); - start = start + 1 - start / range * range; - } - scardc_(&gotten, buffer, buffer_len); - return 0; -/* $Procedure GETBSZ (Get current size of paragraph buffer) */ - -L_getbsz: -/* $ Abstract */ - -/* Return the number of paragraphs that are buffered. */ - -/* $ 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 */ - -/* Utility */ - -/* $ Declarations */ - -/* Later. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* DEPTH O the current maximum depth of the paragraph buffer */ - -/* $ Detailed_Input */ - -/* None */ - -/* $ Detailed_Output */ - -/* DEPTH is the maximum depth of the paragraph buffer for which */ -/* data can be returned at the time the call to GETBSZ */ -/* is issued. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point allows you to easily retrieve the number of */ -/* paragraphs that are available in the paragraph stack for */ -/* retrieval. */ - - -/* $ Examples */ - -/* Suppose that you wish to retrieve all of the paragraphs that */ -/* have been buffered. The code fragment below shows how to use */ -/* this routine in conjunction with the entry GETBUF to retrieve */ -/* the paragraphs. */ - -/* Initialize the cell we are using to retrieve paragraphs. */ - -/* CALL SSIZEC ( BSIZE, BUFFER ) */ - -/* Find out the current number of paragraphs that are available */ -/* for retrieval */ - -/* CALL GETBSZ ( N ) */ - -/* Finally fetch the paragraphs starting at the bottom of the */ -/* stack and working our way to the top of the stack. */ - -/* DO WHILE ( N .GT. 0 ) */ - -/* CALL GETBUF ( N, BUFFER ) */ - -/* Do something with the retrieved buffer */ - -/* N = N - 1 */ - -/* END DO */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 12-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the number of buffered paragraphs */ - -/* -& */ - *depth = buffrd; - return 0; -/* $Procedure DMPBUF ( Dump the last buffered paragraph ) */ - -L_dmpbuf: -/* $ Abstract */ - -/* This entry point removes the top paragraph from the top of the */ -/* paragraph stack. */ - -/* $ 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 */ - -/* Utility */ - -/* $ Declarations */ - -/* Later. */ - -/* $ Brief_I/O */ - -/* None. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine works by side effect. It makes the top paragraph */ -/* in the paragraph stack unavailable---in effect deleting it */ -/* from the paragraph stack. */ - -/* $ Examples */ - -/* Suppose that there are some paragraphs that have a special */ -/* meta-meaning in the operation of a program. It may be */ -/* desirable to remove these paragraphs from the paragraph stack. */ - -/* For example suppose that the paragraph stack contains lines */ -/* of text that make up commands to a program. And suppose that */ -/* the command RECALL is a meta-command that tells the program */ -/* to recall one of the commands in the stack. It is likely that */ -/* you do not want RECALL to be added to the stack. So when */ -/* the RECALL command is encountered in preprocessing of commands, */ -/* you can call DMPBUF to remove it from the stack of commands. */ - -/* Yes, this example is a bit vague. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* - SPICELIB Version 1.0.0, 13-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Remove a paragraph from the top of the paragraph stack */ - -/* -& */ -/* Computing MAX */ - i__1 = buffrd - 1; - buffrd = max(i__1,0); - range = 20; - currnt = currnt - 1 + (range - currnt + 1) / range * range; - return 0; -} /* pstack_ */ - -/* Subroutine */ int pstack_(integer *depth, char *line, char *buffer, ftnlen - line_len, ftnlen buffer_len) -{ - return pstack_0_(0, depth, line, buffer, line_len, buffer_len); - } - -/* Subroutine */ int rstbuf_(void) -{ - return pstack_0_(1, (integer *)0, (char *)0, (char *)0, (ftnint)0, ( - ftnint)0); - } - -/* Subroutine */ int putbuf_(char *line, ftnlen line_len) -{ - return pstack_0_(2, (integer *)0, line, (char *)0, line_len, (ftnint)0); - } - -/* Subroutine */ int getbuf_(integer *depth, char *buffer, ftnlen buffer_len) -{ - return pstack_0_(3, depth, (char *)0, buffer, (ftnint)0, buffer_len); - } - -/* Subroutine */ int getbsz_(integer *depth) -{ - return pstack_0_(4, depth, (char *)0, (char *)0, (ftnint)0, (ftnint)0); - } - -/* Subroutine */ int dmpbuf_(void) -{ - return pstack_0_(5, (integer *)0, (char *)0, (char *)0, (ftnint)0, ( - ftnint)0); - } - diff --git a/ext/spice/src/csupport/qlstnb.c b/ext/spice/src/csupport/qlstnb.c deleted file mode 100644 index afcd510c22..0000000000 --- a/ext/spice/src/csupport/qlstnb.c +++ /dev/null @@ -1,247 +0,0 @@ -/* qlstnb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure QLSTNB (Quick LAST non-blank character) */ -integer qlstnb_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, i__, l, m, blank, nl; - -/* $ Abstract */ - -/* This is a "faster" version of the SPICELIB routine LASTNB. */ - -/* $ 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 */ - -/* ASCII, CHARACTER, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input character string. */ -/* QLSTNB O Index of the last non-blank character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is the input character string. */ - -/* $ Detailed_Output */ - -/* QLSTNB is the index of the last non-blank character */ -/* in the input string. If there are no non-blank */ -/* characters in the string, QLSTNB is zero. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Particulars */ - -/* If the string is blank, return zero. Otherwise, step through */ -/* the string one character at a time until something other than */ -/* a blank is found. Return the index of that something within */ -/* the string. */ - -/* This routine has the same function as the SPICE routine */ -/* LASTNB however, it turns out to be substantially faster */ -/* when applied to longer strings. This is somewhat surprising */ -/* but happens due to a combination of machine instructions */ -/* available for comparing strings and the ineffective optimizations */ -/* performed by all compilers we've examined. See the code */ -/* for more details regarding how this routine takes advantage */ -/* of native instructions and ineffective optimizations. */ - -/* $ Examples */ - -/* The following examples illustrate the use of QLSTNB. */ - -/* QLSTNB ( 'ABCDE' ) = 5 */ -/* QLSTNB ( 'AN EXAMPLE' ) = 10 */ -/* QLSTNB ( 'AN EXAMPLE ' ) = 10 */ -/* QLSTNB ( ' ' ) = 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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 */ - - -/* - SPICELIB Version 1.0.0, 22-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the index of the last non-blank character of a string. */ - -/* -& */ - blank = ' '; - l = i_len(string, string_len); - -/* If this is a short string there is no particular advantage */ -/* to be gained by making use of the binary search idea. */ -/* The speed up just doesn't buy much when compared with */ -/* the loop overhead. */ - - if (l <= 32) { - for (i__ = l; i__ >= 1; --i__) { - if (*(unsigned char *)&string[i__ - 1] != blank) { - ret_val = i__; - return ret_val; - } - } - ret_val = 0; - return ret_val; - } - b = 1; - nl = l - 1; - -/* We want M to be ( B + NL ) / 2 but right now that's L/2 */ - - m = l / 2; - while(l - b > 16) { - -/* What is true right now? The string from L+1 on out */ -/* is blank. L > B; L-1 = NL >= B; M = (B + NL) / 2; */ -/* and M >= B, B is at least one and if greater than 1 */ -/* there must be a non-blank character between B and the */ -/* end of the string. */ - - if (*(unsigned char *)&string[l - 1] != blank) { - ret_val = l; - return ret_val; - } else if (*(unsigned char *)&string[m - 1] != blank) { - l = nl; - b = m; - } else /* if(complicated condition) */ { - i__1 = m; - if (s_cmp(string + i__1, " ", nl - i__1, (ftnlen)1) == 0) { - -/* If you got here, the STRING(L:L) is a blank. */ -/* The string from L+1 on out is blank. */ -/* The string from M to NL (=L-1) is blank. Thus the */ -/* string from M out is blank. */ - -/* M is greater than or equal to B */ -/* If M is less than B + 2, then L will become */ -/* B or less and there will not be a */ -/* next pass through the loop. That means that */ -/* we will never get to this point again and don't */ -/* have to worry about the reference STRING(M:NL) */ -/* giving us an access violation. */ - - l = m - 1; - -/* With the new value of L, we now know that STRING(L+1:) */ -/* is blank. */ - - } else { - -/* If you get to this point all of the string from */ -/* L out is blank and L is greater than M. */ -/* There is a non-blank character between M+1 and NL. */ -/* If L should become equal to B below, then the loop */ -/* will not be executed again. That means again that */ -/* we don't have to worry about STRING(M:NL) being */ -/* an ill formed string. */ - - l = nl; - b = m + 1; - -/* With the new value of L, we now know that STRING(L+1:) */ -/* is blank. */ - - } - } - nl = l - 1; - m = (b + nl) / 2; - -/* What's true now? The string from L+1 on out is blank. */ -/* Somewhere between B and L is a non-blank character. */ - - } - -/* Either B never changed from 1 or B was set to a value such that */ -/* there was a non-blank character between B and the end of */ -/* the string, And the string from L+1 out to the end is */ -/* blank. Since we want this to mimick RTRIM, we are done. */ - - for (i__ = l; i__ >= 1; --i__) { - if (*(unsigned char *)&string[i__ - 1] != blank) { - ret_val = i__; - return ret_val; - } - } - ret_val = 0; - return ret_val; -} /* qlstnb_ */ - diff --git a/ext/spice/src/csupport/qmini.c b/ext/spice/src/csupport/qmini.c deleted file mode 100644 index 21955a4c20..0000000000 --- a/ext/spice/src/csupport/qmini.c +++ /dev/null @@ -1,343 +0,0 @@ -/* qmini.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static doublereal c_b2 = -1.; -static doublereal c_b3 = 1.; - -/* $Procedure QMINI ( Quaternion linear interpolation ) */ -/* Subroutine */ int qmini_(doublereal *init, doublereal *final, doublereal * - frac, doublereal *qintrp) -{ - /* System generated locals */ - doublereal d__1; - - /* Builtin functions */ - double acos(doublereal), cos(doublereal), sin(doublereal); - - /* Local variables */ - doublereal vmag, axis[3]; - extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * - ); - doublereal q[4], angle; - extern /* Subroutine */ int unorm_(doublereal *, doublereal *, doublereal - *); - doublereal qscale[4]; - extern doublereal brcktd_(doublereal *, doublereal *, doublereal *); - doublereal intang, instar[4]; - extern /* Subroutine */ int vminus_(doublereal *, doublereal *), qxq_( - doublereal *, doublereal *, doublereal *); - -/* $ Abstract */ - -/* Interpolate between two quaternions using a constant angular */ -/* rate. */ - -/* $ 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 */ - -/* ROTATIONS */ - -/* $ Keywords */ - -/* MATH */ -/* QUATERNION */ -/* ROTATION */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* INIT I Initial quaternion representing a rotation. */ -/* FINAL I Final quaternion representing a rotation. */ -/* FRAC I Fraction of rotation from INIT to FINAL by which */ -/* to interpolate. */ -/* QINTRP O Linearly interpolated quaternion. */ - -/* $ Detailed_Input */ - -/* INIT, */ -/* FINAL, */ -/* FRAC are, respectively, two unit quaternions between */ -/* which to interpolate, and an interpolation */ -/* fraction. See the Detailed_Output and Particulars */ -/* sections for details. */ - -/* $ Detailed_Output */ - -/* QINTRP is the quaternion resulting from linear */ -/* interpolation between INIT and FINAL by the */ -/* fraction FRAC. By "linear interpolation" we mean */ -/* the following: */ - -/* We view INIT and FINAL as quaternions */ -/* representing two values of a time-varying */ -/* rotation matrix R(t) that rotates at a constant */ -/* angular velocity (that is, the row vectors of */ -/* R(t) rotate with constant angular velocity). */ -/* We can say that */ - -/* INIT represents R(t0) */ -/* FINAL represents R(t1) */ - -/* Equivalently, the SPICELIB routine Q2M maps */ -/* INIT and FINAL to rotation matrices */ -/* corresponding to R(t0) and R(t1) respectively. */ - -/* "Linear interpolation by the fraction FRAC" */ -/* means that QINTRP represents the matrix */ -/* R(t) evaluated at time */ - -/* t = t0 + FRAC * (t1 - t0) */ - -/* and that the sign of QINTRP is such that */ -/* QINTRP is closer to both INIT and FINAL */ -/* than is -QINTRP. */ - - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If either of INIT or FINAL is not a unit quaternion, the error */ -/* SPICE(NOTAROTATION) is signaled. */ - -/* 2) This routine assumes that the quaternion QUOT defined by */ - -/* * */ -/* QUOT = FINAL * INIT */ - -/* has rotation angle THETA radians, where */ - -/* 0 < THETA < pi */ -/* - */ - -/* Above the * superscript denotes quaternion conjugation. */ - -/* The caller must test this condition on THETA; it is not */ -/* tested by this routine. A quick check may be performed by */ -/* verifying that */ - -/* 0 < QUOT(0) */ - -/* Note that this inequality is strict because rotations of */ -/* pi radians cannot be linearly interpolated so as to */ -/* produce a unique result. */ - -/* This routine cannot distinguish between rotations of THETA */ -/* radians, where THETA is in the interval [0, pi), and */ -/* rotations of */ - -/* THETA + 2 * k * pi */ - -/* radians, where k is any integer. These "large" rotations will */ -/* yield invalid results when interpolated. You must ensure */ -/* that the inputs you provide to this routine will not be */ -/* subject to this sort of ambiguity. If in fact you are */ -/* interpolating a time-dependent rotation with constant angular */ -/* velocity AV between times t0 and t1, you must ensure that */ - -/* || AV || * |t1 - t0| < pi. */ - -/* Here we assume that the magnitude of AV is the angular rate */ -/* of the rotation in units of radians per second. */ - - -/* 3) When FRAC is outside of the interval [0, 1], the process */ -/* performed is "extrapolation", not interpolation. Such */ -/* values of FRAC are permitted. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* In the discussion below, we assume that the conditions specified */ -/* in item (2) of the Exceptions section have been satisfied. */ - -/* As we've said, we view INIT and FINAL as quaternions representing */ -/* two values of a time-varying rotation matrix R(t) that rotates at */ -/* a constant angular velocity; we define R(t), t0, and t1 so that */ - -/* INIT represents R(t0) */ -/* FINAL represents R(t1). */ - -/* The output quaternion QINTRP represents R(t) evaluated at the */ -/* time */ - -/* t0 + FRAC * (t1 - t0). */ - -/* How do we evaluate R at times between t0 and t1? Since the row */ -/* vectors of R are presumed to rotate with constant angular */ -/* velocity, we will first find the rotation axis of the quotient */ -/* rotation Q that maps the row vectors of R from their initial to */ -/* final position. Since the rows of R are the columns of the */ -/* transpose of R, we can write: */ - -/* T T */ -/* R(t1) = Q * R(t0), */ - -/* Since */ - -/* T T T */ -/* R(t1) = ( R(t1) * R(t0) ) * R(t0) */ - - -/* we can find Q, as well as a rotation axis A and an angle THETA */ -/* in the range [0, pi] such that Q rotates vectors by THETA */ -/* radians about axis A. */ - -/* We'll use the notation */ - -/* [ x ] */ -/* N */ - -/* to indicate a coordinate system rotation of x radians about the */ -/* vector N. Having found A and THETA, we can write (note that */ -/* the sign of the rotation angle is negated because we're using */ -/* a coordinate system rotation) */ - -/* T (t - t0) T */ -/* R(t) = [ - THETA * --------- ] * R(t0) */ -/* (t1 - t0) A */ - -/* Thus R(t) and QINTRP are determined. */ - -/* The input argument FRAC plays the role of the quotient */ - -/* t - t0 */ -/* ------- */ -/* t1 - t0 */ - -/* shown above. */ - - -/* $ Examples */ - -/* 1) Suppose we want to interpolate between quaternions */ -/* Q1 and Q2 that give the orientation of a spacecraft structure */ -/* at times t1 and t2. We wish to find an approximation of the */ -/* structure's orientation at the midpoint of the time interval */ -/* [t1, t2]. We assume that the angular velocity of the */ -/* structure equals the constant AV between times t1 and t2. We */ -/* also assume that */ - -/* || AV || * (t2 - t1) < pi. */ - -/* Then the code fragment */ - -/* CALL QMINI ( Q1, Q2, 0.5D0, QINTRP, SCLDAV ) */ - -/* produces the approximation we desire. */ - - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.1, 28-FEB-2008 (NJB) */ - -/* The discussion of exception #2 was expanded. */ - -/* - SPICELIB Version 1.0.0, 19-JUL-2005 (NJB) */ - -/* -& */ -/* $ Index_Entries */ - -/* linear interpolation between quaternions */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Use discovery check-in. */ - - - -/* Find the conjugate INSTAR of the input quaternion INIT. */ - - instar[0] = init[0]; - vminus_(&init[1], &instar[1]); - -/* Find the quotient quaternion Q that maps INIT to FINAL. */ - - qxq_(final, instar, q); - -/* Extract the rotation angle from Q. Use arccosine for */ -/* speed, sacrificing some accuracy. */ - - angle = acos(brcktd_(q, &c_b2, &c_b3)) * 2.; - -/* Create a quaternion QSCALE from the rotation axis of the quotient */ -/* and the scaled rotation angle. */ - - intang = *frac * angle / 2.; - qscale[0] = cos(intang); - -/* Get the unit vector parallel to the vector part of Q. */ -/* UNORM does exactly what we want here, because if the vector */ -/* part of Q is zero, the returned "unit" vector will be the */ -/* zero vector. */ - - unorm_(&q[1], axis, &vmag); - -/* Form the vector part of QSCALE. */ - - d__1 = sin(intang); - vscl_(&d__1, axis, &qscale[1]); - -/* Apply QSCALE to INIT to produce the interpolated quaternion we */ -/* seek. */ - - qxq_(qscale, init, qintrp); - return 0; -} /* qmini_ */ - diff --git a/ext/spice/src/csupport/qrtrim.c b/ext/spice/src/csupport/qrtrim.c deleted file mode 100644 index 34b6dbdf46..0000000000 --- a/ext/spice/src/csupport/qrtrim.c +++ /dev/null @@ -1,272 +0,0 @@ -/* qrtrim.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure QRTRIM (Quick right trim ) */ -integer qrtrim_(char *string, ftnlen string_len) -{ - /* System generated locals */ - integer ret_val, i__1; - - /* Builtin functions */ - integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, i__, l, m, blank, nl; - -/* $ Abstract */ - -/* This is a "faster" version of the SPICELIB routine RTRIM. */ - -/* $ 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 */ - -/* ASCII, CHARACTER, SEARCH */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ - -/* STRING I String to be trimmed. */ - -/* The function returns the maximum of 1 and the location of the */ -/* last non-blank character in STRING. */ - -/* $ Detailed_Input */ - -/* STRING is a string to be trimmed: the location of the */ -/* last non-blank character is desired. */ - -/* $ Detailed_Output */ - -/* The function returns the maximum of 1 and the location of the */ -/* last non-blank character in STRING. */ - -/* In particular, when STRING is blank, the function returns the */ -/* value 1. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* When writing a character string to a file, we usually are content */ -/* to omit the trailing blanks. We'd like to use LASTNB as an upper */ -/* substring bound, but we have to handle the case where LASTNB */ -/* returns 0, so we write: */ - - -/* WRITE ( UNIT, '(A)' ), STRING ( : MAX (1, LASTNB (STRING)) ) */ - - -/* This can be simplified using QRTRIM: */ - - -/* WRITE ( UNIT, '(A)' ), STRING ( : QRTRIM (STRING) ) ) */ - -/* This routine has the same function as the SPICE routine */ -/* RTRIM however, it turns out to be substantially faster */ -/* when applied to long strings. This is somewhat surprising */ -/* but happens due to a combination of machine instructions */ -/* available for comparing strings and the ineffective optimizations */ -/* performed by all compilers we've examined. See the code */ -/* for more details regarding how this routine takes advantage */ -/* of native instructions and ineffective optimizations. */ - -/* $ Examples */ - -/* 1) Write the non-blank portion of each element of a character */ -/* cell to file SPUD.DAT: */ - -/* DO I = 1, CARDC (CELL) */ - -/* CALL WRLINE ('SPUD.DAT', */ -/* . CELL(I) ( LTRIM (CELL) : QRTRIM (CELL) ) ) */ - -/* END DO */ - -/* When CELL(I) is blank, the string ' ' will be written. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ 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 */ - - -/* - SPICELIB Version 1.0.0, 22-APR-1994 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* Get the index of the last non-blank character of a string. */ -/* Right trim a string */ - -/* -& */ - blank = ' '; - l = i_len(string, string_len); - -/* If this is a short string there is no particular advantage */ -/* to be gained by making use of the binary search idea. */ -/* The speed up just doesn't buy much when compared with */ -/* the loop overhead. */ - - if (l <= 32) { - for (i__ = l; i__ >= 1; --i__) { - if (*(unsigned char *)&string[i__ - 1] != blank) { - ret_val = i__; - return ret_val; - } - } - ret_val = 1; - return ret_val; - } - b = 1; - nl = l - 1; - -/* We want M to be ( B + NL ) / 2 but right now that's L/2 */ - - m = l / 2; - while(l - b > 16) { - -/* What is true right now? The string from L+1 on out */ -/* is blank. L > B; L-1 = NL >= B; M = (B + NL) / 2; */ -/* and M >= B, B is at least one and if greater than 1 */ -/* there must be a non-blank character between B and the */ -/* end of the string. */ - - if (*(unsigned char *)&string[l - 1] != blank) { - ret_val = l; - return ret_val; - } else if (*(unsigned char *)&string[m - 1] != blank) { - l = nl; - b = m; - } else /* if(complicated condition) */ { - i__1 = m; - if (s_cmp(string + i__1, " ", nl - i__1, (ftnlen)1) == 0) { - -/* If you got here, the STRING(L:L) is a blank. */ -/* The string from L+1 on out is blank. */ -/* The string from M to NL (=L-1) is blank. Thus the */ -/* string from M out is blank. */ - -/* M is greater than or equal to B */ -/* If M is less than B + 2, then L will become */ -/* B or less and there will not be a */ -/* next pass through the loop. That means that */ -/* we will never get to this point again and don't */ -/* have to worry about the reference STRING(M:NL) */ -/* giving us an access violation. */ - - l = m - 1; - -/* With the new value of L, we now know that STRING(L+1:) */ -/* is blank. */ - - } else { - -/* If you get to this point all of the string from */ -/* L out is blank and L is greater than M. */ -/* There is a non-blank character between M+1 and NL. */ -/* If L should become equal to B below, then the loop */ -/* will not be executed again. That means again that */ -/* we don't have to worry about STRING(M:NL) being */ -/* an ill formed string. */ - - l = nl; - b = m + 1; - -/* With the new value of L, we now know that STRING(L+1:) */ -/* is blank. */ - - } - } - nl = l - 1; - m = (b + nl) / 2; - -/* What's true now? The string from L+1 on out is blank. */ -/* Somewhere between B and L is a non-blank character. */ - - } - -/* Either B never changed from 1 or B was set to a value such that */ -/* there was a non-blank character between B and the end of */ -/* the string, And the string from L+1 out to the end is */ -/* blank. Since we want this to mimick RTRIM, we are done. */ - - for (i__ = l; i__ >= 1; --i__) { - if (*(unsigned char *)&string[i__ - 1] != blank) { - ret_val = i__; - return ret_val; - } - } - ret_val = 1; - return ret_val; -} /* qrtrim_ */ - diff --git a/ext/spice/src/csupport/qtran.c b/ext/spice/src/csupport/qtran.c deleted file mode 100644 index 4eaafc17eb..0000000000 --- a/ext/spice/src/csupport/qtran.c +++ /dev/null @@ -1,203 +0,0 @@ -/* qtran.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__3 = 3; - -/* $Procedure QTRAN */ -/* Subroutine */ int qtran_(char *input, char *output, logical *tran, ftnlen - input_len, ftnlen output_len) -{ - /* System generated locals */ - address a__1[3]; - integer i__1[3], i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); - - /* Local variables */ - integer qlen, rlen, i__; - char delim[1]; - extern /* Subroutine */ int geteq_(char *, ftnlen); - char reply[128], query[33]; - extern /* Subroutine */ int getdel_(char *, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int repsub_(char *, integer *, integer *, char *, - char *, ftnlen, ftnlen, ftnlen); - char equote[1]; - extern /* Subroutine */ int rdstmn_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - char prompt[55]; - extern /* Subroutine */ int nthuqw_(char *, integer *, char *, char *, - integer *, ftnlen, ftnlen, ftnlen); - integer loc; - -/* $ Abstract */ - -/* Prompt the user to supply values for the first query in a 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. */ - -/* $ Keywords */ - -/* PARSE, QUERY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INPUT I Input string, possibly containing queries. */ -/* OUTPUT O Equivalent string, with first query replaced. */ -/* TRAN O True when a query was replaced. */ - -/* $ Detailed_Input */ - -/* INPUT is the input string. This may contain any number */ -/* of queries, for which the user will be expected to */ -/* supply values. A query is any string of up to 32 */ -/* consecutive non-blank characters ending with '?'. */ - -/* $ Detailed_Output */ - -/* OUTPUT is the equivalent of INPUT after the first of the */ -/* queries in INPUT has been supplied with a value. */ - -/* OUTPUT may overwrite INPUT. */ - -/* TRAN is true whenever a query was found and replaced, and is */ -/* false otherwise. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Exceptions */ - -/* It is possible that query resolution will result in an overflow */ -/* of the output string. This situation is dianosed by a routine */ -/* called by QTRAN. */ - -/* $ Detailed_Description */ - -/* Look for a query in INPUT. (It will end with '?'.) Ask the user */ -/* to supply a value for the query. Insert the value into OUTPUT in */ -/* place of the query itself. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I. M. Underwood (JPL) */ - -/* $ Version_and_Date */ - -/* Version 1.1, 14-SEP-1995 */ - -/* Assignment to otherwise unused variable SUPRES deleted. */ - -/* Version 1, 17-SEP-1986 */ - -/* -& */ - -/* OPTLIB functions */ - - -/* Local variables */ - - -/* Look up the special marker used for suppressing query */ -/* evaluation. */ - - geteq_(equote, (ftnlen)1); - getdel_(delim, (ftnlen)1); - -/* Look at each word. If a word ends with '?', it's a query. */ -/* (QUERY is a character longer than a valid query. So any */ -/* valid query will have at least one blank at the end.) */ - - *tran = FALSE_; - i__ = 1; - nthuqw_(input, &i__, equote, query, &loc, input_len, (ftnlen)1, (ftnlen) - 33); - while(! (*tran) && s_cmp(query, " ", (ftnlen)33, (ftnlen)1) != 0) { - -/* First we have to look for the translation supression */ -/* character. */ - - *tran = i_indx(query, "? ", (ftnlen)33, (ftnlen)2) > 0 && s_cmp(query, - "?", (ftnlen)33, (ftnlen)1) != 0; - if (! (*tran)) { - ++i__; - nthuqw_(input, &i__, equote, query, &loc, input_len, (ftnlen)1, ( - ftnlen)33); - } - } - s_copy(output, input, output_len, input_len); - -/* If we found a query, get the user's response, and insert it */ -/* in place of the query. */ - - if (*tran) { - qlen = lastnb_(query, (ftnlen)33); -/* Writing concatenation */ - i__1[0] = 16, a__1[0] = "Enter value for "; - i__1[1] = qlen - 1, a__1[1] = query; - i__1[2] = 3, a__1[2] = " > "; - s_cat(prompt, a__1, i__1, &c__3, (ftnlen)55); - rdstmn_(prompt, delim, reply, (ftnlen)55, (ftnlen)1, (ftnlen)128); -/* Computing MAX */ - i__2 = 1, i__3 = lastnb_(reply, (ftnlen)128); - rlen = max(i__2,i__3); - i__2 = loc + qlen - 1; - repsub_(output, &loc, &i__2, reply, output, output_len, rlen, - output_len); - } - return 0; -} /* qtran_ */ - diff --git a/ext/spice/src/csupport/rdstmn.c b/ext/spice/src/csupport/rdstmn.c deleted file mode 100644 index 8e62eb9f74..0000000000 --- a/ext/spice/src/csupport/rdstmn.c +++ /dev/null @@ -1,151 +0,0 @@ -/* rdstmn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ 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. */ - -/* Subroutine */ int rdstmn_(char *prmpt, char *delim, char *stmt, ftnlen - prmpt_len, ftnlen delim_len, ftnlen stmt_len) -{ - /* Initialized data */ - - static char blank[132] = " " - " " - " "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - char line[132]; - extern logical batch_(void); - char space[1]; - integer prlen; - extern integer rtrim_(char *, ftnlen); - char myprm[132]; - extern /* Subroutine */ int replch_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen), suffix_(char *, integer *, char * - , ftnlen, ftnlen), prompt_(char *, char *, ftnlen, ftnlen); - char tab[1]; - integer end; - - -/* Read a statement entered on one or more lines. */ - -/* VARIABLE I/O DESCRIPTION */ -/* PRMPT I Prompt for input. If PRMPT is not blank, */ -/* the cursor is positioned one space after the */ -/* last non-blank character. Successive lines */ -/* are indented by the length of PRMPT. */ -/* DELIM I Statement delimiter. RDSTMN will continue */ -/* to read until the either the delimiter or */ -/* a blank line is entered. */ -/* STMT O The statement entered, up to but not */ -/* including the delimiter. If RDSTMN is */ -/* terminated by the entry of a blank line, */ -/* STMT is blank. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* 7 February 1986, I.M. Underwood */ - -/* - */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Read the first statement. Use the prompt. Return immediately */ -/* if a blank line or an error is encountered. */ - - if (batch_()) { - s_copy(stmt, " ", stmt_len, (ftnlen)1); - return 0; - } - prlen = rtrim_(prmpt, prmpt_len) + 1; - s_copy(myprm, prmpt, (ftnlen)132, prmpt_len); - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - *(unsigned char *)space = ' '; - *(unsigned char *)tab = '\t'; - prompt_(myprm, line, prlen, (ftnlen)132); - if (s_cmp(line, " ", (ftnlen)132, (ftnlen)1) == 0) { - s_copy(stmt, " ", stmt_len, (ftnlen)1); - return 0; - } else { - s_copy(stmt, line, stmt_len, (ftnlen)132); - } - -/* Get rid of any of those nasty old tabs. */ - - replch_(line, tab, space, line, (ftnlen)132, (ftnlen)1, (ftnlen)1, ( - ftnlen)132); - -/* Read succeeding lines. Indent to the length of the original */ -/* prompt. Add the input line to the current statement. Quit when: */ - -/* - A delimiter is encountered. (Return the statement */ -/* up to the delimiter.) */ - -/* - A blank line or an error is encountered. (Return */ -/* a blank statement.) */ - - while(i_indx(stmt, delim, stmt_len, (ftnlen)1) == 0) { - prompt_(blank, line, prlen, (ftnlen)132); - replch_(line, tab, space, line, (ftnlen)132, (ftnlen)1, (ftnlen)1, ( - ftnlen)132); - if (s_cmp(line, " ", (ftnlen)132, (ftnlen)1) == 0) { - s_copy(stmt, " ", stmt_len, (ftnlen)1); - return 0; - } else { - suffix_(line, &c__1, stmt, (ftnlen)132, stmt_len); - } - } - -/* If we made it to here, we encountered a delimiter. Take the */ -/* entire statement up to the character before the delimiter. */ - - end = i_indx(stmt, delim, stmt_len, (ftnlen)1); - s_copy(stmt + (end - 1), " ", stmt_len - (end - 1), (ftnlen)1); - return 0; -} /* rdstmn_ */ - diff --git a/ext/spice/src/csupport/rdstmt.c b/ext/spice/src/csupport/rdstmt.c deleted file mode 100644 index 077db31fcf..0000000000 --- a/ext/spice/src/csupport/rdstmt.c +++ /dev/null @@ -1,153 +0,0 @@ -/* rdstmt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ 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. */ - -/* Subroutine */ int rdstmt_(char *prmpt, char *delim, char *stmt, ftnlen - prmpt_len, ftnlen delim_len, ftnlen stmt_len) -{ - /* Initialized data */ - - static char blank[132] = " " - " " - " "; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen); - - /* Local variables */ - char line[132], space[1]; - integer prlen; - extern integer rtrim_(char *, ftnlen); - char myprm[132]; - extern /* Subroutine */ int replch_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen), dmpbuf_(void), suffix_(char *, - integer *, char *, ftnlen, ftnlen), rstbuf_(void), putbuf_(char *, - ftnlen), prompt_(char *, char *, ftnlen, ftnlen); - char tab[1]; - integer end; - - -/* Read a statement entered on one or more lines. */ - -/* VARIABLE I/O DESCRIPTION */ -/* PRMPT I Prompt for input. If PRMPT is not blank, */ -/* the cursor is positioned one space after the */ -/* last non-blank character. Successive lines */ -/* are indented by the length of PRMPT. */ -/* DELIM I Statement delimiter. RDSTMT will continue */ -/* to read until the either the delimiter or */ -/* a blank line is entered. */ -/* STMT O The statement entered, up to but not */ -/* including the delimiter. If RDSTMT is */ -/* terminated by the entry of a blank line, */ -/* STMT is blank. */ - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* 7 February 1986, I.M. Underwood */ - -/* - */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Read the first statement. Use the prompt. Return immediately */ -/* if a blank line or an error is encountered. */ - - prlen = rtrim_(prmpt, prmpt_len) + 1; - s_copy(myprm, prmpt, (ftnlen)132, prmpt_len); - s_copy(line, " ", (ftnlen)132, (ftnlen)1); - *(unsigned char *)space = ' '; - *(unsigned char *)tab = '\t'; - -/* Set up the white-space/line-break accountant. */ - - prompt_(myprm, line, prlen, (ftnlen)132); - if (s_cmp(line, " ", (ftnlen)132, (ftnlen)1) == 0) { - s_copy(stmt, " ", stmt_len, (ftnlen)1); - return 0; - } else { - s_copy(stmt, line, stmt_len, (ftnlen)132); - } - -/* Record the size of the white-space and line-break fields. */ - - rstbuf_(); - replch_(line, tab, space, line, (ftnlen)132, (ftnlen)1, (ftnlen)1, ( - ftnlen)132); - putbuf_(line, (ftnlen)132); - -/* Read succeeding lines. Indent to the length of the original */ -/* prompt. Add the input line to the current statement. Quit when: */ - -/* - A delimiter is encountered. (Return the statement */ -/* up to the delimiter.) */ - -/* - A blank line or an error is encountered. (Return */ -/* a blank statement.) */ - - while(i_indx(stmt, delim, stmt_len, (ftnlen)1) == 0) { - prompt_(blank, line, prlen, (ftnlen)132); - replch_(line, tab, space, line, (ftnlen)132, (ftnlen)1, (ftnlen)1, ( - ftnlen)132); - putbuf_(line, (ftnlen)132); - if (s_cmp(line, " ", (ftnlen)132, (ftnlen)1) == 0) { - dmpbuf_(); - s_copy(stmt, " ", stmt_len, (ftnlen)1); - return 0; - } else { - suffix_(line, &c__1, stmt, (ftnlen)132, stmt_len); - } - } - -/* If we made it to here, we encountered a delimiter. Take the */ -/* entire statement up to the character before the delimiter. */ - - end = i_indx(stmt, delim, stmt_len, (ftnlen)1); - s_copy(stmt + (end - 1), " ", stmt_len - (end - 1), (ftnlen)1); - return 0; -} /* rdstmt_ */ - diff --git a/ext/spice/src/csupport/ressym.c b/ext/spice/src/csupport/ressym.c deleted file mode 100644 index 7141ed62c9..0000000000 --- a/ext/spice/src/csupport/ressym.c +++ /dev/null @@ -1,150 +0,0 @@ -/* ressym.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -/* Subroutine */ int ressym_(char *input, char *output, ftnlen input_len, - ftnlen output_len) -{ - logical tran1, tran2; - integer e, i__, r__; - char space[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen), geteq_(char *, ftnlen) - , qtran_(char *, char *, logical *, ftnlen, ftnlen), stran_(char * - , char *, logical *, ftnlen, ftnlen), ljust_(char *, char *, - ftnlen, ftnlen); - extern logical failed_(void); - logical change; - extern /* Subroutine */ int replch_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - char equote[1]; - extern /* Subroutine */ int prtrap_(char *, logical *, ftnlen); - char substr[255]; - extern /* Subroutine */ int nthuqw_(char *, integer *, char *, char *, - integer *, ftnlen, ftnlen, ftnlen); - char tab[1]; - integer loc; - - chkin_("RESSYM", (ftnlen)6); - *(unsigned char *)tab = '\t'; - *(unsigned char *)space = ' '; - geteq_(equote, (ftnlen)1); - replch_(input, tab, space, output, input_len, (ftnlen)1, (ftnlen)1, - output_len); - prtrap_(output, &change, output_len); - -/* Now we just loop until all translations have */ -/* been performed. We do: */ - -/* 1) symbol resolution */ -/* 2) query resolution */ -/* 3) tab removal */ - - while(change) { - change = FALSE_; - tran1 = TRUE_; - tran2 = TRUE_; - -/* First we resolve all symbols. After each pass we check */ -/* that we have not created a command that must be trapped. */ - - while(tran1 && tran2) { - stran_(output, output, &tran1, output_len, output_len); - prtrap_(output, &tran2, output_len); - -/* Determine whether or not more changes are possible */ -/* at this point. */ - - change = (change || tran1) && tran2 && ! failed_(); - } - -/* If we don't have any errors we take a stab at replacing */ -/* all queries. Note that queries can not result in changing */ -/* anything that isn't a query so we don't have to trap */ -/* inside the loop. Note that this means you can't have */ -/* a command like DEFINE? SYMBOL? VALUE? and just replace */ -/* the first two queries. You've got to do them all. If */ -/* you want a symbol to have a query you must do it this */ -/* way: DEFINE SYMBOL QUERY? That way the queries won't */ -/* get resolve too soon. */ - -/* Note: This can easily be changed so that if a query */ -/* introduces a symbol, we immediately loop back to the */ -/* symbol resolution branch. Simply change the DO WHILE */ -/* loop below to an IF. The "loop" will then terminate */ -/* after one execution leaving any remaining queries */ -/* untouched until the next pass through the loop. */ - - if (failed_()) { - chkout_("RESSYM", (ftnlen)6); - return 0; - } - tran1 = ! failed_(); - while(tran1) { - qtran_(output, output, &tran1, output_len, output_len); - replch_(output, tab, space, output, output_len, (ftnlen)1, ( - ftnlen)1, output_len); - change = change || tran1; - } - prtrap_(output, &tran2, output_len); - change = change && tran2; - if (failed_()) { - chkout_("RESSYM", (ftnlen)6); - return 0; - } - } - if (tran2) { - -/* We remove the special markers that may have been present to */ -/* protect symbol or query resolution. */ - - i__ = 1; - nthuqw_(output, &i__, " ", substr, &loc, output_len, (ftnlen)1, ( - ftnlen)255); - while(loc > 0) { - r__ = lastnb_(substr, (ftnlen)255) - 1; - e = loc + r__; - replch_(output + (loc - 1), equote, space, output + (loc - 1), e - - (loc - 1), (ftnlen)1, (ftnlen)1, e - (loc - 1)); - ++i__; - nthuqw_(output, &i__, " ", substr, &loc, output_len, (ftnlen)1, ( - ftnlen)255); - } - } - -/* Finally, left justify the commmand. */ - - ljust_(output, output, output_len, output_len); - chkout_("RESSYM", (ftnlen)6); - return 0; -} /* ressym_ */ - diff --git a/ext/spice/src/csupport/rptsym.c b/ext/spice/src/csupport/rptsym.c deleted file mode 100644 index b527e5d4ab..0000000000 --- a/ext/spice/src/csupport/rptsym.c +++ /dev/null @@ -1,132 +0,0 @@ -/* rptsym.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -/* Subroutine */ int rptsym_0_(int n__, integer *id, integer *comp, char * - string, integer *wdth, char *name__, char *def, char *value, ftnlen - string_len, ftnlen name_len, ftnlen def_len, ftnlen value_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern integer rtrim_(char *, ftnlen); - static char symdef[1000], symnam[32], symval[1000]; - - -/* This routine is a utility for setting and retrieving symbol */ -/* names, definitions and expanded values. It is intended that */ -/* this be used by a higher level routine that fetches symbol */ -/* definitions one at a time, puts the definition here and */ -/* passes the routine RETSYM to a formatting routine. */ - -/* The ENTRY point SETSYM allows you to set the symbol and its */ -/* values. */ - -/* The ENTRY point RETSYM returns the last set values. To */ -/* request a portion of a symbol you supply the following */ -/* values for ID and COMP */ - -/* 1,1 for the symbol name */ -/* 2,1 for the symbol definition */ -/* 2,2 or 3,1 for the symbol expanded value. */ - -/* If used with the routine TABRPT you can then easily display */ -/* symbols as: */ - -/* name definition fully_expanded_value */ - -/* or */ - -/* name definition */ -/* fully_expanded_value. */ - - switch(n__) { - case 1: goto L_setsym; - case 2: goto L_retsym; - } - - return 0; - -L_setsym: - s_copy(symnam, name__, (ftnlen)32, name_len); - s_copy(symdef, def, (ftnlen)1000, def_len); - s_copy(symval, value, (ftnlen)1000, value_len); - return 0; - -L_retsym: - if (*id == 1) { - if (*comp != 1) { - s_copy(string, " ", string_len, (ftnlen)1); - } else { - s_copy(string, symnam, string_len, (ftnlen)32); - } - } else if (*id == 2) { - if (*comp == 1) { - s_copy(string, symdef, string_len, (ftnlen)1000); - } else if (*comp == 2) { - s_copy(string, symval, string_len, (ftnlen)1000); - } else { - s_copy(string, " ", string_len, (ftnlen)1); - } - } else if (*id == 3) { - if (*comp == 1) { - s_copy(string, symval, string_len, (ftnlen)1000); - } else { - s_copy(string, " ", string_len, (ftnlen)1); - } - } - *wdth = rtrim_(string, string_len); - return 0; -} /* rptsym_ */ - -/* Subroutine */ int rptsym_(integer *id, integer *comp, char *string, - integer *wdth, char *name__, char *def, char *value, ftnlen - string_len, ftnlen name_len, ftnlen def_len, ftnlen value_len) -{ - return rptsym_0_(0, id, comp, string, wdth, name__, def, value, - string_len, name_len, def_len, value_len); - } - -/* Subroutine */ int setsym_(char *name__, char *def, char *value, ftnlen - name_len, ftnlen def_len, ftnlen value_len) -{ - return rptsym_0_(1, (integer *)0, (integer *)0, (char *)0, (integer *)0, - name__, def, value, (ftnint)0, name_len, def_len, value_len); - } - -/* Subroutine */ int retsym_(integer *id, integer *comp, char *string, - integer *wdth, ftnlen string_len) -{ - return rptsym_0_(2, id, comp, string, wdth, (char *)0, (char *)0, (char *) - 0, string_len, (ftnint)0, (ftnint)0, (ftnint)0); - } - diff --git a/ext/spice/src/csupport/sbget_1.c b/ext/spice/src/csupport/sbget_1.c deleted file mode 100644 index 2a5553f458..0000000000 --- a/ext/spice/src/csupport/sbget_1.c +++ /dev/null @@ -1,184 +0,0 @@ -/* sbget_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SBGET ( String buffer, get ) */ -/* Subroutine */ int sbget_1__(char *name__, char *names, integer *ptrs, char - *buffer, char *str, integer *pos, ftnlen name_len, ftnlen names_len, - ftnlen buffer_len, ftnlen str_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - logical found; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen), lbget_1__(integer *, - integer *, char *, char *, logical *, ftnlen, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Get (return) a string from a string buffer. */ - -/* $ 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 */ - -/* CB, LB, SB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the string to be returned. */ -/* NAMES, */ -/* PTRS, */ -/* BUFFER I String buffer. */ -/* STR O The string. */ -/* POS O Position of the string within the buffer. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a string contained within a string */ -/* buffer. */ - -/* NAMES, */ -/* PTRS, */ -/* BUFFER are the name, pointer, and character components */ -/* of the string buffer. */ - -/* $ Detailed_Output */ - -/* STR is the string associated with the specified name. */ -/* If STRING is shorter than the stored string, it is */ -/* truncated. If longer, STRING is padded with spaces. */ - -/* POS is the position of the specified string within the */ -/* string buffer, as determined by the ASCII collating */ -/* sequence. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the specified string is not in the list, POS is zero */ -/* and STR is not changed. */ - -/* $ Particulars */ - -/* There are two routines that you can use to retrieve a string */ -/* from a string buffer: */ - -/* SBGET which takes the name of the string, and returns */ -/* the string and its position within the buffer. */ - -/* SBGETP which takes the position of the string within */ -/* the buffer, and returns the string and its address */ -/* within the name table. */ - -/* $ Examples */ - -/* The following code fragment stores three strings, associated */ -/* with the names WHO, WHAT, and WHERE. */ - -/* CALL SBSET ( 'WHO', 'Feynman', N, P, B ) */ -/* CALL SBSET ( 'WHAT', 'Quantum electrodynamics', N, P, B ) */ -/* CALL SBSET ( 'WHERE', 'Caltech', N, P, B ) */ - -/* The strings can be retrieved using either SBGET, */ - -/* CALL SBGET ( 'WHO', S(1), N, P, B, POS ) */ -/* CALL SBGET ( 'WHAT', S(2), N, P, B, POS ) */ -/* CALL SBGET ( 'WHERE', S(3), N, P, B, POS ) */ - -/* or SBGETP, */ - -/* CALL SBGETP ( 3, S(1), N, P, B, ADDR ) */ -/* CALL SBGETP ( 1, S(2), N, P, B, ADDR ) */ -/* CALL SBGETP ( 2, S(3), N, P, B, ADDR ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SBGET_1", (ftnlen)7); - } - -/* Is this string even in the list? */ - - i__1 = cardc_(names, names_len); - *pos = bsrchc_(name__, &i__1, names + names_len * 6, name_len, names_len); - -/* If so, get it. */ - - if (*pos > 0) { - lbget_1__(pos, ptrs, buffer, str, &found, buffer_len, str_len); - } - chkout_("SBGET_1", (ftnlen)7); - return 0; -} /* sbget_1__ */ - diff --git a/ext/spice/src/csupport/sbinit_1.c b/ext/spice/src/csupport/sbinit_1.c deleted file mode 100644 index a8b9dc861b..0000000000 --- a/ext/spice/src/csupport/sbinit_1.c +++ /dev/null @@ -1,212 +0,0 @@ -/* sbinit_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SBINIT ( String buffer, initialize ) */ -/* Subroutine */ int sbinit_1__(integer *nsize, integer *psize, integer *vdim, - char *names, integer *ptrs, char *buffer, ftnlen names_len, ftnlen - buffer_len) -{ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), ssizec_(integer *, char *, - ftnlen); - integer maxptr; - extern logical return_(void); - extern /* Subroutine */ int lbinit_1__(integer *, integer *, integer *, - char *, ftnlen); - -/* $ Abstract */ - - -/* $ 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 */ - -/* CB, LB, SB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NSIZE I Name size. */ -/* PSIZE I Pointer size. */ -/* VDIM I Value dimension */ -/* NAMES, */ -/* PTRS, */ -/* BUFFER I,O String buffer. */ - -/* $ Detailed_Input */ - -/* NAMES is a character cell array to be used as the name */ -/* component of a string buffer. */ - -/* NSIZE is the declared dimension of NAMES. */ - -/* PTRS is an integer cell array to be used as the pointer */ -/* component of a string buffer. */ - -/* PSIZE is the declared dimension of PTRS. */ - -/* BUFFER is a character buffer array to be used as the */ -/* character component of a string buffer. */ - -/* VDIM is the declared dimension of BUFFER. */ - -/* $ Detailed_Output */ - -/* NAMES, */ -/* PTRS, */ -/* BUFFER together are an initialized string buffer. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the size of the pointer array is not sufficient to */ -/* hold pointers for the maximum number of strings, the */ -/* error 'SPICE(SBINSUFPTRSIZE)' is signalled. */ - -/* $ Particulars */ - -/* A string buffer must be initialized to allow subsequent */ -/* operations on the buffer to detect possible overflows. */ -/* All three components of the buffer are initialized by a */ -/* single call to SBINIT. */ - -/* In order to make full use of the name cell of the string buffer, */ -/* the arrays and name buffers should be declared as shown below. */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER MAXNL */ -/* PARAMETER ( MAXNL = maximum name length ) */ - -/* INTEGER MAXN */ -/* PARAMETER ( MAXN = maximum number of names ) */ - -/* CHARACTER*(MAXNL) NAMES ( MAXN ) */ -/* INTEGER PTRS ( MAXN * 4 + 4 ) */ - -/* The character buffer portion of the string buffer should be */ -/* declared as shown below. */ - -/* INTEGER MAXL */ -/* PARAMETER ( MAXL = maximum expected string length ) */ - -/* INTEGER AVGL */ -/* PARAMETER ( AVGL = average expected string length ) */ - -/* INTEGER LBCBUF */ -/* PARAMETER ( LBCBUF = 0 ) */ - -/* CHARACTER*(MAXL) BUFFER ( LBCBUF:(MAXN * AVGL) / MAXL + 1 ) */ - -/* $ Examples */ - -/* The following code fragment illustrates the initialization */ -/* of a typical string buffer. */ - -/* INTEGER LBCELL */ -/* PARAMETER ( LBCELL = -5 ) */ - -/* INTEGER LBCBUF */ -/* PARAMETER ( LBCBUF = 0 ) */ - -/* CHARACTER*(32) NAMES ( LBCELL:1000 ) */ -/* INTEGER PTRS ( LBCELL:4004 ) */ -/* CHARACTER*(250) BUFFER ( LBCBUF:100 ) */ -/* . */ -/* . */ - -/* CALL SBINIT ( MAXN, PSIZE, BUFDIM, NAMES, PTRS, BUFFER ) */ - -/* In this example, the buffer may be used to store up to 1000 */ -/* strings averaging 25 characters per string, or 25,000 total */ -/* characters. The length of any particular string may range from */ -/* a single character to the entire 25,000 characters. The names */ -/* used to identify the strings may contain up to 32 characters. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SBINIT_1", (ftnlen)8); - } - -/* Make sure that the line buffer is large enough (but ONLY large */ -/* enough) to hold the maximum number of strings. The name list */ -/* should be empty. The LB should be initialized as a unit. */ - - maxptr = *nsize + 1 << 2; - if (*psize < maxptr) { - sigerr_("SPICE(SBINSUFPTRSIZE)", (ftnlen)21); - } else { - ssizec_(nsize, names, names_len); - lbinit_1__(&maxptr, vdim, ptrs, buffer, buffer_len); - } - chkout_("SBINIT_1", (ftnlen)8); - return 0; -} /* sbinit_1__ */ - diff --git a/ext/spice/src/csupport/sbrem_1.c b/ext/spice/src/csupport/sbrem_1.c deleted file mode 100644 index 870a7862c2..0000000000 --- a/ext/spice/src/csupport/sbrem_1.c +++ /dev/null @@ -1,187 +0,0 @@ -/* sbrem_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SBREM ( String buffer, remove ) */ -/* Subroutine */ int sbrem_1__(char *name__, char *names, integer *ptrs, char - *buffer, ftnlen name_len, ftnlen names_len, ftnlen buffer_len) -{ - integer nstr; - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen), scardc_(integer *, - char *, ftnlen), remlac_(integer *, integer *, char *, integer *, - ftnlen); - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int lbrem_1__(integer *, integer *, char *, - ftnlen); - integer pos; - -/* $ Abstract */ - -/* Remove a string from a string buffer. */ - -/* $ 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 */ - -/* CB, LB, SB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the string to be removed. */ -/* NAMES, */ -/* PTRS, */ -/* BUFFER I,O String buffer. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a string currently stored within a */ -/* string buffer. */ - -/* NAMES, */ -/* PTRS, */ -/* BUFFER are the name, pointer, and character components */ -/* of a string buffer. */ - -/* $ Detailed_Output */ - -/* NAMES, */ -/* PTRS, */ -/* BUFFER are the name, pointer, and character components */ -/* of the same string buffer, from which the specified */ -/* string has been removed. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is longer than the maximum length of the names in */ -/* the buffer, it is truncated. Thus, long names may conflict, */ -/* removing each other's associated strings. */ - -/* 2) If a string with the specified name is not already contained */ -/* in the string buffer, nothing happens. */ - -/* $ Particulars */ - -/* SBREM is the only way to get a string out of a string buffer. */ - -/* $ Examples */ - -/* The code fragment */ - -/* CALL SBSET ( 'EINSTEIN', 'Brownian motion', N, P, B ) */ -/* CALL SBSET ( 'BOHR', 'Atomic structure', N, P, B ) */ -/* CALL SBGET ( 'EINSTEIN', N, P, B, POS ) */ - -/* WRITE (*,*) 'Found at position ', POS */ - -/* CALL SBREM ( 'EINSTEIN', N, P, B ) */ -/* CALL SBGET ( 'EINSTEIN', N, P, B, POS ) */ - -/* WRITE (*,*) 'Found at position ', POS */ - -/* Produces the following output. */ - -/* Found at position 2 */ -/* Found at position 0 */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SBREM_1", (ftnlen)7); - } - -/* Recover the essential control information. */ - - nstr = cardc_(names, names_len); - -/* Which string is to be removed? */ - - pos = bsrchc_(name__, &nstr, names + names_len * 6, name_len, names_len); - -/* If the string is not in the buffer, do nothing. */ - - if (pos > 0) { - -/* Remove the name from the name list, and the string from the */ -/* line buffer. */ - - remlac_(&c__1, &pos, names + names_len * 6, &nstr, names_len); - scardc_(&nstr, names, names_len); - lbrem_1__(&pos, ptrs, buffer, buffer_len); - } - chkout_("SBREM_1", (ftnlen)7); - return 0; -} /* sbrem_1__ */ - diff --git a/ext/spice/src/csupport/sbset_1.c b/ext/spice/src/csupport/sbset_1.c deleted file mode 100644 index f687ce3326..0000000000 --- a/ext/spice/src/csupport/sbset_1.c +++ /dev/null @@ -1,226 +0,0 @@ -/* sbset_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure SBSET ( String buffer, set value ) */ -/* Subroutine */ int sbset_1__(char *name__, char *str, char *names, integer * - ptrs, char *buffer, ftnlen name_len, ftnlen str_len, ftnlen names_len, - ftnlen buffer_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Local variables */ - integer nstr, f; - extern integer cardc_(char *, ftnlen); - integer l; - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sizec_(char *, ftnlen); - extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), inslac_( - char *, integer *, integer *, char *, integer *, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen), lstlec_(char *, integer *, char *, - ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen); - integer maxstr; - extern logical return_(void); - extern /* Subroutine */ int lbins_1__(integer *, char *, integer *, char * - , ftnlen, ftnlen), sbrem_1__(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - integer pos; - -/* $ Abstract */ - -/* Set the value of a string within a string buffer. */ - -/* $ 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 */ - -/* CB, LB, SB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I Name of the string to be stored. */ -/* STR I The string. */ -/* NAMES, */ -/* PTRS, */ -/* BUFFER I,O String buffer. */ - -/* $ Detailed_Input */ - -/* NAME is the name of a string to be stored within a string */ -/* buffer. This name may be used to retrieve the string */ -/* at some later time. */ - -/* STR is the string to be stored. */ - -/* NAMES, */ -/* PTRS, */ -/* BUFFER are the name, pointer, and character components of */ -/* a string buffer. */ - -/* $ Detailed_Output */ - -/* NAMES, */ -/* PTRS, */ -/* BUFFER are the name, pointer, and character components of */ -/* the same string buffer, now containing the specified */ -/* string. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is longer than the maximum length of the names in */ -/* the buffer, it is truncated. Thus, long names may conflict, */ -/* overwriting each other's associated strings. */ - -/* 2) If a string with the specified name is not already contained */ -/* in the string buffer, and if the maximum number of strings */ -/* is currently stored, the error 'SPICE(SBTOOMANYSTRS)' is */ -/* signalled. */ - -/* $ Particulars */ - -/* SBSET is the only way to get a string into a string buffer. */ - -/* $ Examples */ - -/* The following code fragment stores three strings, associated */ -/* with the names WHO, WHAT, and WHERE. */ - -/* CALL SBSET ( 'WHO', 'Feynman', N, P, B ) */ -/* CALL SBSET ( 'WHAT', 'Quantum electrodynamics', N, P, B ) */ -/* CALL SBSET ( 'WHERE', 'Caltech', N, P, B ) */ - -/* The strings can be retrieved using either SBGET, */ - -/* CALL SBGET ( 'WHO', S(1), N, P, B, POS ) */ -/* CALL SBGET ( 'WHAT', S(2), N, P, B, POS ) */ -/* CALL SBGET ( 'WHERE', S(3), N, P, B, POS ) */ - -/* or SBGETP, */ - -/* CALL SBGET ( 3, S(1), N, P, B, ADDR ) */ -/* CALL SBGET ( 1, S(2), N, P, B, ADDR ) */ -/* CALL SBGET ( 2, S(3), N, P, B, ADDR ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SBSET_1", (ftnlen)7); - } - -/* If the buffer already contains a string with this name, remove it. */ - - sbrem_1__(name__, names, ptrs, buffer, name_len, names_len, buffer_len); - -/* Recover the (new) essential control information. */ - - maxstr = sizec_(names, names_len); - nstr = cardc_(names, names_len); - -/* Where should the name be inserted? */ - - if (nstr == maxstr) { - setmsg_("Current limit is #.", (ftnlen)19); - errint_("#", &maxstr, (ftnlen)1); - sigerr_("SPICE(SBTOOMANYSTRS)", (ftnlen)20); - } else { - pos = lstlec_(name__, &nstr, names + names_len * 6, name_len, - names_len) + 1; - -/* Store only the non-blank part of the string. (Store a blank */ -/* string as a single blank character.) */ - -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(str, str_len); - f = max(i__1,i__2); -/* Computing MAX */ - i__1 = 1, i__2 = lastnb_(str, str_len); - l = max(i__1,i__2); - -/* Add the name of the string to the name list, and the string */ -/* itself to the LB. */ - - inslac_(name__, &c__1, &pos, names + names_len * 6, &nstr, name_len, - names_len); - scardc_(&nstr, names, names_len); - lbins_1__(&pos, str + (f - 1), ptrs, buffer, l - (f - 1), buffer_len); - } - chkout_("SBSET_1", (ftnlen)7); - return 0; -} /* sbset_1__ */ - diff --git a/ext/spice/src/csupport/scansl.c b/ext/spice/src/csupport/scansl.c deleted file mode 100644 index 289d44585a..0000000000 --- a/ext/spice/src/csupport/scansl.c +++ /dev/null @@ -1,193 +0,0 @@ -/* scansl.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SCANSL ( Scan --- select tokens ) */ -/* Subroutine */ int scansl_(integer *ids, integer *n, integer *ntokns, - integer *ident, integer *beg, integer *end) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer i__, j; - extern integer isrchi_(integer *, integer *, integer *); - -/* $ Abstract */ - -/* Select those tokens descripters whose identities are belong */ -/* to a specific list of identities. */ - -/* $ 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 */ - -/* SCANNING */ - -/* $ Keywords */ - -/* SEARCH */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* IDS I value of id's of tokens that should be kept. */ -/* N I number of id's. */ -/* NTOKNS I/O input: number of tokens input, output: number kept. */ -/* IDENT I/O identity of each of the tokens. */ -/* BEG I/O beginning indices of the tokens. */ -/* END I/O ending indices of the tokens. */ - -/* $ Detailed_Input */ - -/* IDS is a list of the identity codes for tokens that we */ -/* will want to keep. */ - -/* N is the number of identity codes for keepers. */ - -/* NTOKNS is the number of tokens to consider. */ - -/* IDENT holds the identities of each token that is up for */ -/* consideration. */ - -/* BEG holds the beginning indices of each token being */ -/* considered. */ - -/* END holds the ending indicies of each token being */ -/* considered. */ - -/* $ Detailed_Output */ - -/* NTOKNS is the number of tokens remaining after the selection */ -/* process has been completed. */ - -/* IDENT holds the identities of each token remaining. */ - -/* BEG holds the beginning indices of each token remaining. */ - -/* END holds the ending indices of each token remaining. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine serves as a macro for the selection process that */ -/* is typically performed to select tokens whose ID's fall into */ -/* some set. */ - -/* $ Examples */ - -/* Suppose you wished to scan a string to locate the beginning and */ -/* endings of words in normal text. The following code fragment */ -/* illustrates how you could use this routine to find the words. */ - -/* Words will be delimited by spaces, periods, commas, colons, */ -/* question marks, exclamation marks, semicolons, parentheses, */ -/* m-dashes, and quotes. */ - -/* MARKS(1) = ' ' */ -/* MARKS(2) = '.' */ -/* MARKS(3) = ',' */ -/* MARKS(4) = '?' */ -/* MARKS(5) = '!' */ -/* MARKS(6) = '---' */ -/* MARKS(7) = ':' */ -/* MARKS(8) = ';' */ -/* MARKS(9) = '(' */ -/* MARKS(10) = ')' */ -/* MARKS(11) = '"' */ - -/* NMARKS = 11 */ - -/* IDS(1) = 0 */ -/* N = 1 */ - - -/* CALL SCANPR ( NMARKS, MARKS, MRKLEN, MRKPTR ) */ - -/* CALL SCAN ( STRING, MARKS, MRKLEN, MRKPTR, */ -/* . ROOM, NTOKNS, IDENT, BEG, END ) */ - -/* CALL SCANSL ( IDS, N, NTOKNS, IDENT, BEG, END ) */ - - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 28-MAR-1991 (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* There's not much to do, shift forward the token attributes for */ -/* tokens whose identities belong to the selection list. */ - - j = 0; - i__1 = *ntokns; - for (i__ = 1; i__ <= i__1; ++i__) { - if (isrchi_(&ident[i__ - 1], n, ids) > 0) { - ++j; - ident[j - 1] = ident[i__ - 1]; - beg[j - 1] = beg[i__ - 1]; - end[j - 1] = end[i__ - 1]; - } - } - *ntokns = j; - return 0; -} /* scansl_ */ - diff --git a/ext/spice/src/csupport/shosym.c b/ext/spice/src/csupport/shosym.c deleted file mode 100644 index f4ce14324b..0000000000 --- a/ext/spice/src/csupport/shosym.c +++ /dev/null @@ -1,186 +0,0 @@ -/* shosym.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $ 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. */ - -/* Subroutine */ int shosym_(char *templt, ftnlen templt_len) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - char name__[32], line[132]; - integer ncol, item[3]; - logical tran; - integer size[3]; - char rest[132]; - integer i__, n, r__, space[3]; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), - repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, - ftnlen); - char value[2000]; - integer width[3]; - extern /* Subroutine */ int stran_(char *, char *, logical *, ftnlen, - ftnlen); - extern integer rtrim_(char *, ftnlen); - logical justr[3]; - integer lmarge, pagewd; - char spcial[1*3]; - extern /* Subroutine */ int pagscn_(char *, ftnlen); - char margin[32], messge[132]; - extern /* Subroutine */ int pagset_(char *, integer *, ftnlen), tabrpt_( - integer *, integer *, integer *, integer *, logical *, logical *, - char *, integer *, integer *, U_fp, ftnlen); - char myline[132]; - extern /* Subroutine */ int pagrst_(void), nspmrg_(char *, ftnlen), - symget_(char *, char *, ftnlen, ftnlen); - char frstwd[32]; - extern /* Subroutine */ int nspglr_(integer *, integer *), nextwd_(char *, - char *, char *, ftnlen, ftnlen, ftnlen), sympat_(char *, ftnlen), - nspwln_(char *, ftnlen); - extern /* Subroutine */ int retsym_(); - logical presrv[3]; - extern /* Subroutine */ int setsym_(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - char def[2000]; - extern /* Subroutine */ int nicepr_1__(char *, char *, S_fp, ftnlen, - ftnlen); - - r__ = rtrim_(templt, templt_len); - sympat_(templt, r__); - symget_(name__, def, (ftnlen)32, (ftnlen)2000); - nspmrg_(margin, (ftnlen)32); - if (s_cmp(name__, " ", (ftnlen)32, (ftnlen)1) == 0) { - s_copy(messge, "There are no symbols that match the template \"#\".", - (ftnlen)132, (ftnlen)49); - repmc_(messge, "#", templt, messge, (ftnlen)132, (ftnlen)1, r__, ( - ftnlen)132); - nicepr_1__(messge, margin, (S_fp)nspwln_, (ftnlen)132, (ftnlen)32); - return 0; - } - -/* If still here there are some matching symbols. Set up the */ -/* standard defaults. */ - - s_copy(line, "==========================================================" - "================================================================" - "==============================================", (ftnlen)132, ( - ftnlen)168); - presrv[0] = TRUE_; - presrv[1] = TRUE_; - presrv[2] = TRUE_; - lmarge = 1; - space[0] = 2; - space[1] = 2; - space[2] = 2; - *(unsigned char *)&spcial[0] = ' '; - *(unsigned char *)&spcial[1] = ' '; - *(unsigned char *)&spcial[2] = ' '; - justr[0] = FALSE_; - justr[1] = FALSE_; - justr[2] = FALSE_; - -/* Get the width of the page and based upon that determine */ -/* the basic table style that will be used to display the */ -/* symbol definition. */ - - nspglr_(&n, &pagewd); - width[0] = 14; - width[1] = 30; - width[2] = 30; - size[0] = 1; - size[1] = 1; - size[2] = 1; - item[0] = 1; - item[1] = 2; - item[2] = 3; - ncol = 3; - -/* Adjust all of the columns */ - - i__1 = ncol; - for (i__ = 1; i__ <= i__1; ++i__) { - width[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("width", i__2, - "shosym_", (ftnlen)156)] = width[(i__3 = i__ - 1) < 3 && 0 <= - i__3 ? i__3 : s_rnge("width", i__3, "shosym_", (ftnlen)156)] - * pagewd / 80; - } - pagewd = 0; - i__1 = ncol; - for (i__ = 1; i__ <= i__1; ++i__) { - pagewd = width[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge( - "width", i__2, "shosym_", (ftnlen)162)] + space[(i__3 = i__ - - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("space", i__3, "shosym_", - (ftnlen)162)] + pagewd; - } - pagewd -= space[(i__1 = ncol - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("space" - , i__1, "shosym_", (ftnlen)165)]; - nspwln_(" ", (ftnlen)1); - nspwln_("Symbols Matching Request: ", (ftnlen)26); - nspwln_(" ", (ftnlen)1); - pagrst_(); - pagset_("PAGEWIDTH", &pagewd, (ftnlen)9); - pagscn_("BODY", (ftnlen)4); - setsym_("Symbol Name", "Definition", "Expanded Value", (ftnlen)11, ( - ftnlen)10, (ftnlen)14); - tabrpt_(&ncol, item, size, width, justr, presrv, spcial, &lmarge, space, ( - U_fp)retsym_, (ftnlen)1); - s_copy(myline, line, (ftnlen)132, pagewd); - nspwln_(myline, (ftnlen)132); - while(s_cmp(name__, " ", (ftnlen)32, (ftnlen)1) != 0) { - -/* Expand this symbol until there's nothing left to do. */ - - s_copy(value, def, (ftnlen)2000, (ftnlen)2000); - tran = TRUE_; - while(tran) { - nextwd_(def, frstwd, rest, (ftnlen)2000, (ftnlen)32, (ftnlen)132); - ucase_(frstwd, frstwd, (ftnlen)32, (ftnlen)32); - if (s_cmp(frstwd, "DEFINE", (ftnlen)32, (ftnlen)6) != 0 && s_cmp( - frstwd, "UNDEFINE", (ftnlen)32, (ftnlen)8) != 0) { - stran_(value, value, &tran, (ftnlen)2000, (ftnlen)2000); - } else { - tran = FALSE_; - } - } - setsym_(name__, def, value, (ftnlen)32, (ftnlen)2000, (ftnlen)2000); - tabrpt_(&ncol, item, size, width, justr, presrv, spcial, &lmarge, - space, (U_fp)retsym_, (ftnlen)1); - symget_(name__, def, (ftnlen)32, (ftnlen)2000); - } - nspwln_(" ", (ftnlen)1); - return 0; -} /* shosym_ */ - diff --git a/ext/spice/src/csupport/signal1.h b/ext/spice/src/csupport/signal1.h deleted file mode 100644 index 360d8d0118..0000000000 --- a/ext/spice/src/csupport/signal1.h +++ /dev/null @@ -1,118 +0,0 @@ -/* - --Header_File signal1.h (CSPICE version of the f2c signal1.h header file) - --Abstract - - Define macros associated with signal handling, customized for the - host environment. - --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. - --Particulars - - This header defines the macro signal1 referenced in main.c, - which is a generic main routine used in CSPICE executables that - link to code generated by f2c. - --Literature_References - - None. - --Author_and_Institution - - N.J. Bachman (JPL) - --Restrictions - - 1) This header file must be updated whenever the f2c processor - or the f2c libraries libI77 and libF77 are updated. - - 2) This header may need to be updated to support new platforms. - The supported platforms at the time of the 03-FEB-2000 release - are: - - ALPHA-DIGITAL-UNIX_C - HP_C - NEXT_C - PC-LINUX_C - PC-MS_C - SGI-IRIX-N32_C - SGI-IRIX-NO2_C - SUN-SOLARIS-GCC_C - SUN-SOLARIS-NATIVE_C - --Version - - -CSPICE Version 1.0.0, 03-FEB-2000 (NJB) - -*/ - - - - -/* You may need to adjust the definition of signal1 to supply a */ -/* cast to the correct argument type. This detail is system- and */ -/* compiler-dependent. The #define below assumes signal.h declares */ -/* type SIG_PF for the signal function's second argument. */ - -#include - -#ifndef Sigret_t -#define Sigret_t void -#endif -#ifndef Sigarg_t -#ifdef KR_headers -#define Sigarg_t -#else -#ifdef __cplusplus -#define Sigarg_t ... -#else -#define Sigarg_t int -#endif -#endif -#endif /*Sigarg_t*/ - -#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ -#define sig_pf SIG_PF -#else -typedef Sigret_t (*sig_pf)(Sigarg_t); -#endif - -#define signal1(a,b) signal(a,(sig_pf)b) - -#ifdef __cplusplus -#define Sigarg ... -#define Use_Sigarg -#else -#define Sigarg Int n -#define Use_Sigarg n = n /* shut up compiler warning */ -#endif - diff --git a/ext/spice/src/csupport/sizecb_1.c b/ext/spice/src/csupport/sizecb_1.c deleted file mode 100644 index c5feed3ec1..0000000000 --- a/ext/spice/src/csupport/sizecb_1.c +++ /dev/null @@ -1,162 +0,0 @@ -/* sizecb_1.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SIZECB ( Size of character buffer ) */ -integer sizecb_1__(char *buffer, ftnlen buffer_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, - ftnlen); - extern integer dimcb_1__(char *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Return the total size of a character buffer. */ - -/* $ 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 */ - -/* CB */ - -/* $ Keywords */ - -/* ASCII */ -/* CHARACTER */ -/* STRING */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* BUFFER I Character buffer. */ - -/* $ Detailed_Input */ - -/* BUFFER is a character buffer. */ - -/* $ Detailed_Output */ - -/* The function returns the total size of the character buffer */ -/* (as established by a previous call to CBINIT). This is the */ -/* total number of characters that can be stored in the buffer. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* The size of a character buffer is checked before any operation */ -/* is performed on the buffer, to detect possible overflows. */ - -/* $ Examples */ - -/* The code fragment */ - -/* INTEGER LBCBUF */ -/* PARAMETER ( LBCBUF = 0 ) */ - -/* INTEGER DIMCB */ -/* INTEGER SIZECB */ -/* CHARACTER*100 BUFFER ( LBCBUF:200 ) */ - -/* CALL CBINIT ( 200, BUFFER ) */ - -/* WRITE (*,*) DIMCB ( BUFFER ), ' elements at ' */ -/* WRITE (*,*) LEN ( BUFFER(1) ), ' characters each totals ' */ -/* WRITE (*,*) SIZECB ( BUFFER ), ' characters of storage.' */ - -/* produces the following output. */ - -/* 200 elements at */ -/* 100 characters each totals */ -/* 200000 characters of storage. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* Dagny Taggart, (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 28-DEC-1994 (WLT) */ - -/* The function is assigned an initial value of 0 so that it */ -/* will have some value if we are in RETURN mode. */ - -/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Give the function some initial value. Zero seems as good as */ -/* anything. */ - - ret_val = 0; - -/* Standard error handling. */ - - if (return_()) { - return ret_val; - } else { - chkin_("SIZECB_1", (ftnlen)8); - } - -/* Size = dimension * length. */ - - ret_val = dimcb_1__(buffer, buffer_len) * i_len(buffer + buffer_len, - buffer_len); - chkout_("SIZECB_1", (ftnlen)8); - return ret_val; -} /* sizecb_1__ */ - diff --git a/ext/spice/src/csupport/spcacb.c b/ext/spice/src/csupport/spcacb.c deleted file mode 100644 index a55bb0d1b7..0000000000 --- a/ext/spice/src/csupport/spcacb.c +++ /dev/null @@ -1,446 +0,0 @@ -/* spcacb.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $ Procedure SPCACB ( SPK and CK add comments from a buffer ) */ -/* Subroutine */ int spcacb_(integer *dafhdl, char *buffer, ftnlen buffer_len) -{ - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer free; - char line[255]; - integer last; - extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); - integer i__, j; - extern integer cardc_(char *, ftnlen); - integer space; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer recno, first, nd, ni; - char ifname[255]; - extern /* Subroutine */ int dafarr_(integer *, integer *), dafrcr_( - integer *, integer *, char *, ftnlen); - char crecrd[1000]; - extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char - *, integer *, integer *, integer *, ftnlen), dafwcr_(integer *, - integer *, char *, ftnlen); - integer ncrecs, nchars; - char eocmrk[1]; - extern integer lastnb_(char *, ftnlen); - integer length, eocpos; - char eolmrk[1]; - integer nnrecs, nrrecs, nlines; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, - ftnlen); - integer curpos; - extern logical return_(void); - -/* $ Abstract */ - -/* Store text from a line buffer in the comment area of a binary SPK */ -/* or CK file, appending it to whatever text may already have */ -/* been stored there. */ - -/* $ 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 */ - -/* SPC */ - -/* $ Keywords */ - -/* FILES */ -/* UTILITY */ - -/* $ Declarations */ - - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* LBCELL P Lower bound for the CELL 'data type' */ -/* MXCREC P Maximum length of a character record in a DAF */ -/* LINLEN P The maximum length of an input line */ -/* DAFHDL I DAF file handle for output */ -/* BUFFER I Buffer of comment lines to be written */ - -/* $ Detailed_Input */ - -/* DAFHDL The NAIF DAF file handle for accessing a DAF file. */ - -/* BUFFER A list of comment lines which are to be added to the */ -/* comment area of the binary DAF file attached to the */ -/* DAF file handle DAFHDL. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* MXCREC This is the maximum length of a character record in a */ -/* DAF file. */ - -/* LBCELL This is the lower bound for the CELL data type which */ -/* is supported by SPICELIB. */ - -/* LINLEN This is the maximum length of a single text record in */ -/* a text file. */ - -/* $ Exceptions */ - -/* 1) If the length of the cell buffer is not positive, the error */ -/* SPICE(NONPOSBUFLENGTH) will be signalled. */ - -/* 2) If the end of of comment marker is not found, then the error */ -/* SPICE(MISSINGEOT) will be signalled. ( NOTE: the end comment */ -/* marker is also referred to as the end of transmission */ -/* character. ) */ - -/* 3) If the comment area of the file exists, i.e., the number of */ -/* comment records is greater than zero, and the last comment */ -/* record is not the last reserved record, then the error */ -/* SPICE(BADCOMMENTAREA) will be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine will take a character CELL buffer of text lines and */ -/* append them to the comment area of a binary SPK or CK DAF file. */ -/* The lines of text in the buffer will be 'packed' into a DAF */ -/* character record, and when the character record is full it will be */ -/* written to the comment area of the file. This is repeated until */ -/* all of the lines in the buffer have been processed. */ - -/* If there are no comments in the comment area, then space will */ -/* be allocated in the file and the text lines in BUFFER will be */ -/* written into the file. Blank text lines are allowed. If there */ -/* are already comments in the comment area, then the text lines */ -/* in BUFFER will be appended to these comments, with a single */ -/* blank line separating the two comment blocks. */ - -/* $ Examples */ - -/* Let */ -/* DAFHDL = The DAF handle for an SPK or CK file */ - -/* BUFFER = A list of text lines to be added to the comment */ -/* area of the SPK or CK file. */ - -/* The call */ - -/* CALL SPCACB( DAFHDL, BUFFER ) */ - -/* will append the text line(s) in BUFFER to the comment area of */ -/* the SPK or CK file. */ - -/* $ Restrictions */ - -/* The conventions for the comment area specified by the SPC family */ -/* of routines is used. Any SPK or CK files which do not conform */ -/* to these conventions may not have 'readable' comment areas. Only */ -/* comments are to be placed into the comment area, where a comment */ -/* consists of only ASCII printable characters. */ - -/* NOTE: The SPC family of routines should be the only routines used */ -/* to write to and read from the comment area of SPK or CK */ -/* files. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.1.0, 18-MAY-2004 (BVS) */ - -/* Removed check requiring the number of comment records to be */ -/* one less than the number of reserved records. Fixed logic */ -/* adding the end-of-comment marker to handle cases when it */ -/* "rolls" over to the next reserved record. */ - -/* - Beta Version 1.0.1, 30-MAR-1999 (BVS) */ - -/* Changed LINLEN to 255 (was 80). */ - -/* - Beta Version 1.0.0, 23-APR-1992 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* WRITE A LINE BUFFER TO AN SPK OR CK COMMENT AREA */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* Local variables */ - - -/* This is needed for the call to DAFRFR to get some of the */ -/* information needed. It is not used anywhere else. */ - - -/* These are needed to call DAFRFR to get some of the information */ -/* needed. Only FIRST will be used, and this is to determine the */ -/* number of reserved records which exist. */ - - -/* Initial values */ - - *(unsigned char *)eocmrk = '\4'; - *(unsigned char *)eolmrk = '\0'; - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("SPCACB", (ftnlen)6); - } - -/* Give some of the variables a value so that they have one. */ - - ncrecs = 0; - nnrecs = 0; - nrrecs = 0; - -/* First, extract the number of lines in the buffer */ - - nlines = cardc_(buffer, buffer_len); - -/* Check for a nonpositive number of lines. */ - - if (nlines <= 0) { - setmsg_("An invalid buffer length was found: #", (ftnlen)37); - errint_("#", &nlines, (ftnlen)1); - sigerr_("SPICE(NONPOSBUFLENGTH)", (ftnlen)22); - chkout_("SPCACB", (ftnlen)6); - return 0; - } - -/* Count the number of characters in the buffer, ignoring leading */ -/* and trailing blanks on nonblank lines. Blank lines will not count */ -/* here, their contribution to the size of the comment area will be */ -/* incorporated later. This is for determining the number of */ -/* character records to add to the file attached to handle DAFHDL. */ - - nchars = 0; - i__ = 0; - while(i__ < nlines) { - ++i__; - s_copy(line, buffer + (i__ + 5) * buffer_len, (ftnlen)255, buffer_len) - ; - length = lastnb_(line, (ftnlen)255); - nchars += length; - } - -/* Add NLINES + 1 to NCHARS to allow for the end of line markers */ -/* ( EOLMRK ) and the end of comments marker ( EOCMRK ). */ - - nchars = nchars + nlines + 1; - -/* Get the number of reserved records from the file. */ - - dafrfr_(dafhdl, &nd, &ni, ifname, &first, &last, &free, (ftnlen)255); - -/* Subtract 1 from FIRST to obtain the number of reserved records. */ - -/* Note that this should be one more than the number of comment */ -/* records in the comment area for the SPK or CK file comment area */ -/* to conform to the SPC comment area conventions. That is, the */ -/* number of reserved records = the number of comment records + 1. */ - - nrrecs = first - 1; - -/* If the number of reserved records, NRRECS, is greater then 1, */ -/* determine the number of comment records in the comment area. */ -/* The comments begin on record CASTRT and should continue to record */ -/* NRRECS - 1. The comments are terminated by and end of comment */ -/* marker EOCMRK = CHAR(4). */ - - eocpos = 0; - i__ = 0; - while(i__ < nrrecs - 1 && eocpos == 0) { - recno = i__ + 2; - dafrcr_(dafhdl, &recno, crecrd, (ftnlen)1000); - eocpos = cpos_(crecrd, eocmrk, &c__1, (ftnlen)1000, (ftnlen)1); - ++i__; - } - if (eocpos == 0 && nrrecs > 1) { - setmsg_("End-of-transmission character missing in comment area of bi" - "nary file.", (ftnlen)69); - sigerr_("SPICE(MISSINGEOT)", (ftnlen)17); - chkout_("SPCACB", (ftnlen)6); - return 0; - } - ncrecs = i__; - -/* Check to see if the number of comment records is one less than */ -/* the number of reserved records. If not, signal an error. */ - -/* IF ( NCRECS .NE. NRRECS - 1 ) THEN */ -/* CALL SETMSG ( 'The number of comment records and the'// */ -/* . ' number of reserved records do not agree.'// */ -/* . ' The comment area could be bad.' ) */ -/* CALL SIGERR ( 'SPICE(BADCOMMENTAREA)' ) */ -/* CALL CHKOUT ( 'SPCACB' ) */ -/* RETURN */ -/* END IF */ - -/* Determine the amount of free space in the comment area. This */ -/* will be the space remaining on the last comment record, i.e., */ -/* the maximum length of a DAF character record - the position */ -/* of the end of comments marker - 1. */ - - if (ncrecs > 0) { - space = 1000 - eocpos; - } else { - space = 0; - } - -/* Determine the number of extra reserved records which are */ -/* necessary to store the comments in the buffer. */ - - if (nchars > space) { - nnrecs = (nchars - space) / 1000 + 1; - } else { - nnrecs = 0; - } - -/* Now call the DAF routine to add reserved records to the file, */ -/* if we need to. */ - - if (nnrecs > 0) { - dafarr_(dafhdl, &nnrecs); - } - -/* At this point, we know that we have enough space to write the */ -/* comments in the buffer to the comment area. Either there was */ -/* enough space already there, or we figured out how many new */ -/* character records were needed, and we added them to the file. */ -/* So, now we begin 'packing' the comments into the character record. */ - -/* We begin by reading the last comment record if there is one, */ -/* otherwise we just initialize the appropriate variables. */ - - if (ncrecs == 0) { - recno = 2; - curpos = 0; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } else { - recno = ncrecs + 1; - dafrcr_(dafhdl, &recno, crecrd, (ftnlen)1000); - -/* Find the end of comment marker again. This is really not */ -/* necessary, but it is here to localize all the info needed. */ - - eocpos = cpos_(crecrd, eocmrk, &c__1, (ftnlen)1000, (ftnlen)1); - -/* Set the current record position */ - - curpos = eocpos; - -/* Put an end of line marker here to separate the new comments */ -/* from the old ones, and increment the current record position. */ - - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)eolmrk; - } - i__ = 0; - while(i__ < nlines) { - ++i__; - s_copy(line, buffer + (i__ + 5) * buffer_len, (ftnlen)255, buffer_len) - ; - length = lastnb_(line, (ftnlen)255); - j = 0; - while(j < length) { - if (curpos < 1000) { - ++j; - ++curpos; - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)& - line[j - 1]; - } else { - dafwcr_(dafhdl, &recno, crecrd, (ftnlen)1000); - ++recno; - curpos = 0; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } - } - -/* Check to see if we happened to get exactly MXCREC characters */ -/* when we stopped moving characters from LINE. If we did, then */ -/* we need to write out the current record and appropriately */ -/* adjust the necessary variables. */ - - if (curpos == 1000) { - dafwcr_(dafhdl, &recno, crecrd, (ftnlen)1000); - ++recno; - curpos = 0; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } - ++curpos; - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)eolmrk; - } - -/* We have now finished processing all of the lines, so we */ -/* need to append the end of comment marker to the current */ -/* record and write it to the file. */ - - if (curpos == 1000) { - dafwcr_(dafhdl, &recno, crecrd, (ftnlen)1000); - ++recno; - curpos = 0; - s_copy(crecrd, " ", (ftnlen)1000, (ftnlen)1); - } - ++curpos; - *(unsigned char *)&crecrd[curpos - 1] = *(unsigned char *)eocmrk; - dafwcr_(dafhdl, &recno, crecrd, (ftnlen)1000); - chkout_("SPCACB", (ftnlen)6); - return 0; -} /* spcacb_ */ - diff --git a/ext/spice/src/csupport/stran.c b/ext/spice/src/csupport/stran.c deleted file mode 100644 index 05f8c6d908..0000000000 --- a/ext/spice/src/csupport/stran.c +++ /dev/null @@ -1,714 +0,0 @@ -/* stran.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__2 = 2; -static integer c__12 = 12; - -/* $Procedure STRAN */ -/* Subroutine */ int stran_0_(int n__, char *input, char *output, logical * - tran, ftnlen input_len, ftnlen output_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1, i__2, i__3; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, - ftnlen, ftnlen), s_rnge(char *, integer, char *, integer), i_len( - char *, ftnlen); - - /* Local variables */ - static integer ldef, leno, vdim, slot, lout, lsym, ptrs[810], i__, j; - extern integer cardc_(char *, ftnlen); - static integer l, n; - static logical check[200]; - extern logical batch_(void); - static integer place; - extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen); - static char delim[1]; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static integer nname; - extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); - static char names[32*206]; - extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), - geteq_(char *, ftnlen); - extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int nthwd_(char *, integer *, char *, integer *, - ftnlen, ftnlen); - static char symbl[33]; - static integer psize; - extern integer rtrim_(char *, ftnlen); - static logical checkd[200]; - extern logical failed_(void); - static char alphab[32]; - extern /* Subroutine */ int getdel_(char *, ftnlen); - extern logical matchm_(char *, char *, char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); - static char buffer[256*52]; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), - lastnb_(char *, ftnlen); - static logical gotone; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), repsub_(char *, integer *, integer *, char *, char *, - ftnlen, ftnlen, ftnlen); - static char equote[1]; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - static char resvrd[32*12], symbol[33], pattrn[80]; - static integer nxtchr; - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen), rdstmn_(char *, char *, char *, ftnlen, ftnlen, ftnlen); - extern logical return_(void); - extern /* Subroutine */ int sbget_1__(char *, char *, integer *, char *, - char *, integer *, ftnlen, ftnlen, ftnlen, ftnlen), nthuqw_(char * - , integer *, char *, char *, integer *, ftnlen, ftnlen, ftnlen); - static char myprmt[80]; - extern /* Subroutine */ int sbrem_1__(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer lsttry; - extern /* Subroutine */ int sbset_1__(char *, char *, char *, integer *, - char *, ftnlen, ftnlen, ftnlen, ftnlen); - static char def[1024]; - static integer loc; - static char key[32]; - static logical new__; - extern /* Subroutine */ int sbinit_1__(integer *, integer *, integer *, - char *, integer *, char *, ftnlen, ftnlen); - -/* $ Abstract */ - -/* Translate the symbols in an input 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. */ - -/* $ Keywords */ - -/* PARSE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* INPUT I Input string containing symbols to be translated. */ -/* OUTPUT O Output string, with all symbols translated. */ - -/* $ Detailed_Input */ - -/* INPUT is the input string to be translated. INPUT may contain */ -/* any number of known symbols. */ - - -/* $ Detailed_Output */ - -/* OUTPUT is the translation of the input string. The first */ -/* of the symbols in INPUT will have been translated. */ -/* When INPUT is either a DEFINE or an UNDEFINE command, */ -/* OUTPUT is blank. */ - -/* OUTPUT may overwrite INPUT. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Input_Output_Common */ - -/* None. */ - -/* $ Exceptions */ - -/* The following exceptions are detected by this routine: */ - -/* 1) Attempt to define or undefine a symbol that does */ -/* not begin with a letter. */ - -/* 2) Attempt to define or undefine a symbol that ends with */ -/* a question mark '?' . */ - -/* 3) Failure to specify a symbol to define or undefine. */ - -/* 4) Attempting to define a reserved word. The reserved */ -/* words are: */ - -/* 'START' */ -/* 'STOP' */ -/* 'EXIT' */ -/* 'INQUIRE' */ -/* 'SHOW' */ -/* 'DEFINE' */ -/* 'SHOW' */ -/* 'UNDEFINE' */ -/* 'HELP' */ - -/* In all of the above cases OUTPUT is set to blank and TRAN to */ -/* FALSE. No new symbol is placed in the table of symbol */ -/* definitions. */ - -/* In all of these cases the error BAD_SYMBOL_SPC is signalled. */ - -/* 5) Recursive symbol definitions are detected and disallowed. */ -/* A long error message diagnosing the problem is set and */ -/* the error RECURSIVE_SYMBOL is signalled. */ - -/* 5) Overflow of the input command caused by symbol resolution. */ - -/* In this case the OUTPUT is left at the state it had reached */ -/* prior to the overflow condition and TRAN is returned as */ -/* FALSE. The error SYMBOL_OVERFLOW is signalled. */ - -/* $ Detailed_Description */ - -/* A new symbol may be defined with the DEFINE command. The */ -/* syntax is: */ - -/* DEFINE */ - -/* where is a valid symbol name and is any */ -/* valid definition. The DEFINE command, the symbol name, and the */ -/* definition are delimited by blanks. */ - -/* When a symbol is defined, the symbol and definition are inserted */ -/* into the symbol table. */ - -/* An existing symbol may be removed from the table with the */ -/* UNDEFINE command. The syntax is: */ - -/* UNDEFINE */ - -/* where is the name of an existing symbol. The UNDEFINE */ -/* command and the symbol name are delimited by blanks. */ - -/* If the input string does not contain a definition statement, */ -/* STRANS searches the input string for potential symbol names. */ -/* When a valid symbol is encountered, it is removed from the */ -/* string and replaced by the corresponding definition. This */ -/* continues until no untranslated symbols remain. */ - -/* $ Examples */ - -/* Suppose that we are given the following definitions: */ - -/* DEFINE BODIES PLANET AND SATS */ -/* DEFINE EUROPA 502 */ -/* DEFINE GANYMEDE 503 */ -/* DEFINE IO 501 */ -/* DEFINE JUPITER 599 */ -/* DEFINE PLANET JUPITER */ -/* DEFINE CALLISTO 504 */ -/* DEFINE SATS IO EUROPA GANYMEDE CALLISTO */ - -/* Then the string 'BODIES AND SOULS' would translate, */ -/* at various stages, to: */ - -/* 'PLANET AND SATS AND SOULS' */ - -/* 'JUPITER AND SATS AND SOULS' */ - -/* '599 AND SATS AND SOULS' */ - -/* '599 AND IO EUROPA GANYMEDE CALLISTO AND SOULS' */ - -/* '599 AND 501 EUROPA GANYMEDE CALLISTO AND SOULS' */ - -/* '599 AND 501 502 GANYMEDE CALLISTO AND SOULS' */ - -/* '599 AND 501 502 503 CALLISTO AND SOULS' */ - -/* '599 AND 501 502 503 504 AND SOULS' */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* I. M. Underwood (JPL) */ - -/* $ Version_and_Date */ - -/* Version 1.2.0 29-Aug-1996 (WLT) */ - -/* Fixed the error message for the case in which someone */ -/* tries to create a symbol that is more than 32 characters */ -/* in length. */ - -/* Version 1.1, 14-SEP-1995 */ - -/* Reference to unused variable WORD deleted. */ - -/* Version 1, 8-SEP-1986 */ - -/* -& */ -/* SPICELIB Functions */ - - -/* Other supporting functions */ - - -/* The following parameters are used to define our table */ -/* of symbol translations. */ - - -/* Longest allowed symbol name is given by WDSIZE */ - - -/* Maximum number of allowed symbols is MAXN */ - - -/* The longest we expect any symbol to be is MAXL characters */ - - -/* The average number of characters per symbol is AVGL */ - - -/* Finally, here are the arrays used to hold the symbol translations. */ - - -/* Here's the storage we need for the reserved words. */ - - switch(n__) { - case 1: goto L_sympat; - case 2: goto L_symget; - } - - -/* Set up all of the data structures and special strings in */ -/* the first pass through the routine. */ - - if (return_()) { - return 0; - } - chkin_("STRAN", (ftnlen)5); - if (first) { - first = FALSE_; - vdim = 51; - psize = 804; - nname = 200; - sbinit_1__(&nname, &psize, &vdim, names, ptrs, buffer, (ftnlen)32, ( - ftnlen)256); - s_copy(resvrd, "START", (ftnlen)32, (ftnlen)5); - s_copy(resvrd + 32, "STOP", (ftnlen)32, (ftnlen)4); - s_copy(resvrd + 64, "EXIT", (ftnlen)32, (ftnlen)4); - s_copy(resvrd + 96, "INQUIRE", (ftnlen)32, (ftnlen)7); - s_copy(resvrd + 128, "SHOW", (ftnlen)32, (ftnlen)4); - s_copy(resvrd + 160, "DEFINE", (ftnlen)32, (ftnlen)6); - s_copy(resvrd + 192, "SHOW", (ftnlen)32, (ftnlen)4); - s_copy(resvrd + 224, "UNDEFINE", (ftnlen)32, (ftnlen)8); - s_copy(resvrd + 256, "HELP", (ftnlen)32, (ftnlen)4); - s_copy(resvrd + 288, "RECALL", (ftnlen)32, (ftnlen)6); - s_copy(resvrd + 320, "DO", (ftnlen)32, (ftnlen)2); - s_copy(resvrd + 352, "EDIT", (ftnlen)32, (ftnlen)4); - s_copy(alphab, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", (ftnlen)32, (ftnlen)26); - } - -/* Find out what the special marker character is for suppressing */ -/* symbol evaluation. */ - - geteq_(equote, (ftnlen)1); - -/* Is this a definition statement? The presence of DEFINE, INQUIRE or */ -/* UNDEFINE at the beginning of the string will confirm this. */ - - nthwd_(input, &c__1, key, &loc, input_len, (ftnlen)32); - ucase_(key, key, (ftnlen)32, (ftnlen)32); - -/* The keyword must be followed by a valid symbol name. */ - - if (s_cmp(key, "DEFINE", (ftnlen)32, (ftnlen)6) == 0 || s_cmp(key, "INQU" - "IRE", (ftnlen)32, (ftnlen)7) == 0 || s_cmp(key, "UNDEFINE", ( - ftnlen)32, (ftnlen)8) == 0) { - nthwd_(input, &c__2, symbl, &loc, input_len, (ftnlen)33); - ucase_(symbl, symbol, (ftnlen)33, (ftnlen)33); - l = rtrim_(symbol, (ftnlen)33); - if (s_cmp(symbol, " ", (ftnlen)33, (ftnlen)1) == 0) { - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - setmsg_("The \"#\" command must be followed by the name of the s" - "ymbol that you want to #. ", (ftnlen)79); - errch_("#", key, (ftnlen)1, (ftnlen)32); - lcase_(key, key, (ftnlen)32, (ftnlen)32); - errch_("#", key, (ftnlen)1, (ftnlen)32); - sigerr_("BAD_SYMBOL_SPEC", (ftnlen)15); - chkout_("STRAN", (ftnlen)5); - return 0; - } else if (i_indx(alphab, symbol, (ftnlen)32, (ftnlen)1) == 0) { - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - lcase_(key, key, (ftnlen)32, (ftnlen)32); - setmsg_("You cannot # \"#\". Symbols must begin with a letter (" - "A-Z) ", (ftnlen)58); - errch_("#", key, (ftnlen)1, (ftnlen)32); - errch_("#", symbol, (ftnlen)1, (ftnlen)33); - sigerr_("BAD_SYMBOL_SPEC", (ftnlen)15); - chkout_("STRAN", (ftnlen)5); - return 0; - } else if (l > 32) { - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - lcase_(key, key, (ftnlen)32, (ftnlen)32); - setmsg_("You cannot # \"#...\". Symbols may not be longer than " - "32 characters in length.", (ftnlen)77); - errch_("#", key, (ftnlen)1, (ftnlen)32); - errch_("#", symbol, (ftnlen)1, (ftnlen)33); - sigerr_("BAD_SYMBOL_SPEC", (ftnlen)15); - chkout_("STRAN", (ftnlen)5); - return 0; - } else if (*(unsigned char *)&symbol[l - 1] == '?') { - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - lcase_(key, key, (ftnlen)32, (ftnlen)32); - setmsg_("You cannot # \"#\". Symbols may not end with a questio" - "n mark '?'. ", (ftnlen)65); - errch_("#", key, (ftnlen)1, (ftnlen)32); - errch_("#", symbol, (ftnlen)1, (ftnlen)33); - sigerr_("BAD_SYMBOL_SPEC", (ftnlen)15); - chkout_("STRAN", (ftnlen)5); - return 0; - } else if ((s_cmp(key, "DEFINE", (ftnlen)32, (ftnlen)6) == 0 || s_cmp( - key, "INQUIRE", (ftnlen)32, (ftnlen)7) == 0) && isrchc_( - symbol, &c__12, resvrd, (ftnlen)33, (ftnlen)32) > 0) { - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - setmsg_("The word '#' is a reserved word. You may not redefine i" - "t. ", (ftnlen)58); - errch_("#", symbol, (ftnlen)1, (ftnlen)33); - sigerr_("BAD_SYMBOL_SPEC", (ftnlen)15); - chkout_("STRAN", (ftnlen)5); - return 0; - } - } - if (s_cmp(key, "INQUIRE", (ftnlen)32, (ftnlen)7) == 0) { - -/* First of all we, can only INQUIRE for symbol definitions */ -/* if the program is not running in "batch" mode. */ - - if (batch_()) { - setmsg_("You've attempted to INQUIRE for the value of a symbol w" - "hile the program is running in \"batch\" mode. You can I" - "NQUIRE for a symbol value only if you are running in INT" - "ERACTIVE mode. ", (ftnlen)180); - sigerr_("WRONG_MODE", (ftnlen)10); - chkout_("STRAN", (ftnlen)5); - return 0; - } - -/* See if there is anything following the symbol that is */ -/* to be defined. This will be used as our prompt value. */ - -/* Computing MAX */ - i__3 = loc + l; - i__1 = loc + l, i__2 = ncpos_(input, " ", &i__3, input_len, (ftnlen)1) - ; - nxtchr = max(i__1,i__2); - if (s_cmp(input + (nxtchr - 1), " ", input_len - (nxtchr - 1), ( - ftnlen)1) != 0) { - s_copy(myprmt, input + (nxtchr - 1), (ftnlen)80, input_len - ( - nxtchr - 1)); - } else { - s_copy(myprmt, "Enter definition for", (ftnlen)80, (ftnlen)20); - suffix_(symbol, &c__1, myprmt, (ftnlen)33, (ftnlen)80); - suffix_(">", &c__1, myprmt, (ftnlen)1, (ftnlen)80); - } - getdel_(delim, (ftnlen)1); - rdstmn_(myprmt, delim, def, (ftnlen)80, (ftnlen)1, (ftnlen)1024); - sbset_1__(symbol, def, names, ptrs, buffer, (ftnlen)33, (ftnlen)1024, - (ftnlen)32, (ftnlen)256); - } - -/* If this is a definition, and the symbol already exists in the */ -/* symbol table, simply replace the existing definition with the */ -/* string following the symbol name. If this is a new symbol, */ -/* find the first symbol in the list that should follow the new */ -/* one. Move the rest of the symbols back, and insert the new one */ -/* at this point. */ - - if (s_cmp(key, "DEFINE", (ftnlen)32, (ftnlen)6) == 0) { -/* Computing MAX */ - i__3 = loc + l; - i__1 = loc + l, i__2 = ncpos_(input, " ", &i__3, input_len, (ftnlen)1) - ; - nxtchr = max(i__1,i__2); - sbset_1__(symbol, input + (nxtchr - 1), names, ptrs, buffer, (ftnlen) - 33, input_len - (nxtchr - 1), (ftnlen)32, (ftnlen)256); - } - if (s_cmp(key, "DEFINE", (ftnlen)32, (ftnlen)6) == 0 || s_cmp(key, "INQU" - "IRE", (ftnlen)32, (ftnlen)7) == 0) { - if (failed_()) { - chkout_("STRAN", (ftnlen)5); - return 0; - } - -/* Now check for a recursive definition. To do this we have */ -/* two parallel arrays to the NAMES array of the string */ -/* buffer. The first array CHECK is used to indicate that */ -/* in the course of the definition resolution of the */ -/* new symbol, another symbol shows up. The second array */ -/* called CHECKD indicats whether or not we have examined this */ -/* existing symbol to see if contains the newly created */ -/* symbol as part of its definition. */ - -/* So far we have nothing to check and haven't checked anything. */ - - n = cardc_(names, (ftnlen)32); - i__1 = n; - for (j = 1; j <= i__1; ++j) { - check[(i__2 = j - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("check", - i__2, "stran_", (ftnlen)545)] = FALSE_; - checkd[(i__2 = j - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("checkd", - i__2, "stran_", (ftnlen)546)] = FALSE_; - } - -/* Find the location of our new symbol in the NAMES cell. */ - - place = isrchc_(symbol, &n, names + 192, (ftnlen)33, (ftnlen)32); - new__ = TRUE_; - while(new__) { - -/* Look up the definition currently associated with */ -/* the symbol we are checking. */ - - sbget_1__(symbol, names, ptrs, buffer, def, &i__, (ftnlen)33, ( - ftnlen)32, (ftnlen)256, (ftnlen)1024); - j = 1; - nthuqw_(def, &j, equote, symbol, &loc, (ftnlen)1024, (ftnlen)1, ( - ftnlen)33); - while(loc > 0) { - ucase_(symbol, symbol, (ftnlen)33, (ftnlen)33); - slot = isrchc_(symbol, &n, names + 192, (ftnlen)33, (ftnlen) - 32); - -/* If the word is located in the same place as the */ -/* symbol we've just defined, we've introduced */ -/* a recursive symbol definition. Remove this */ -/* symbol and diagnose the error. */ - - if (slot == place) { - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - s_copy(symbol, names + (((i__1 = place + 5) < 206 && 0 <= - i__1 ? i__1 : s_rnge("names", i__1, "stran_", ( - ftnlen)582)) << 5), (ftnlen)33, (ftnlen)32); - sbrem_1__(symbol, names, ptrs, buffer, (ftnlen)33, ( - ftnlen)32, (ftnlen)256); - setmsg_("The definition of '#' is recursive. Recursivel" - "y defined symbol definitions are not allowed. ", ( - ftnlen)93); - errch_("#", symbol, (ftnlen)1, (ftnlen)33); - sigerr_("RECURSIVE_SYMBOL", (ftnlen)16); - chkout_("STRAN", (ftnlen)5); - return 0; - } else if (slot > 0) { - -/* Otherwise if this word is in the names list */ -/* we may need to check this symbol to see if */ -/* it lists the just defined symbol in its definition. */ - - if (checkd[(i__1 = slot - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("checkd", i__1, "stran_", (ftnlen)602)]) { - check[(i__1 = slot - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("check", i__1, "stran_", (ftnlen)603)] - = FALSE_; - } else { - check[(i__1 = slot - 1) < 200 && 0 <= i__1 ? i__1 : - s_rnge("check", i__1, "stran_", (ftnlen)605)] - = TRUE_; - } - } - -/* Locate the next unquoted word in the definition. */ - - ++j; - nthuqw_(def, &j, equote, symbol, &loc, (ftnlen)1024, (ftnlen) - 1, (ftnlen)33); - } - -/* See if there are any new items to check. If there */ -/* are create a new value for symbol, and mark the */ -/* new item as being checked. */ - - new__ = FALSE_; - i__1 = n; - for (j = 1; j <= i__1; ++j) { - if (check[(i__2 = j - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "check", i__2, "stran_", (ftnlen)625)] && ! new__) { - s_copy(symbol, names + (((i__2 = j + 5) < 206 && 0 <= - i__2 ? i__2 : s_rnge("names", i__2, "stran_", ( - ftnlen)626)) << 5), (ftnlen)33, (ftnlen)32); - check[(i__2 = j - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "check", i__2, "stran_", (ftnlen)627)] = FALSE_; - checkd[(i__2 = j - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge( - "checkd", i__2, "stran_", (ftnlen)628)] = TRUE_; - new__ = TRUE_; - } - } - } - -/* If we get to this point, we have a new non-recursively */ -/* defined symbol. */ - - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - chkout_("STRAN", (ftnlen)5); - return 0; - } - -/* If this is a deletion, and the symbol already exists in the */ -/* symbol table, simply move the symbols that follow toward the */ -/* front of the table. */ - - if (s_cmp(key, "UNDEFINE", (ftnlen)32, (ftnlen)8) == 0) { - sbrem_1__(symbol, names, ptrs, buffer, (ftnlen)33, (ftnlen)32, ( - ftnlen)256); - s_copy(output, " ", output_len, (ftnlen)1); - *tran = FALSE_; - chkout_("STRAN", (ftnlen)5); - return 0; - } - -/* This is not a definition statement. Look for potential symbols. */ -/* Try to resolve the first symbol in the string by substituting the */ -/* corresponding definition for the existing symbol. */ - - s_copy(output, input, output_len, input_len); - *tran = FALSE_; - j = 1; - nthuqw_(output, &j, equote, symbol, &loc, output_len, (ftnlen)1, (ftnlen) - 33); - while(! (*tran) && s_cmp(symbol, " ", (ftnlen)33, (ftnlen)1) != 0) { - ucase_(symbol, symbol, (ftnlen)33, (ftnlen)33); - sbget_1__(symbol, names, ptrs, buffer, def, &i__, (ftnlen)33, (ftnlen) - 32, (ftnlen)256, (ftnlen)1024); - if (i__ > 0) { - lsym = lastnb_(symbol, (ftnlen)33); - ldef = lastnb_(def, (ftnlen)1024) + 1; - lout = lastnb_(output, output_len); - leno = i_len(output, output_len); - if (lout - lsym + ldef > leno) { - *tran = FALSE_; - setmsg_("As a result of attempting to resolve the symbols in" - " the input command, the command has overflowed the a" - "llocated memory. This is may be due to unintentional" - "ly using symbols that you had not intended to use. " - "You may protect portions of your string from symbol " - "evaluation by enclosing that portion of your string " - "between the character # as in 'DO #THIS PART WITHOUT" - " SYMBOLS#' . ", (ftnlen)376); - errch_("#", equote, (ftnlen)1, (ftnlen)1); - errch_("#", equote, (ftnlen)1, (ftnlen)1); - errch_("#", equote, (ftnlen)1, (ftnlen)1); - sigerr_("SYMBOL_OVERFLOW", (ftnlen)15); - chkout_("STRAN", (ftnlen)5); - return 0; - } - i__1 = loc + lsym - 1; - repsub_(output, &loc, &i__1, def, output, output_len, ldef, - output_len); - *tran = TRUE_; - } else { - ++j; - } - nthuqw_(output, &j, equote, symbol, &loc, output_len, (ftnlen)1, ( - ftnlen)33); - } - chkout_("STRAN", (ftnlen)5); - return 0; - -/* The following entry point allows us to set up a search */ -/* of defined symbols that match a wild-card pattern. It must */ -/* be called prior to getting any symbol definitions. */ - - -L_sympat: - lsttry = 0; - s_copy(pattrn, input, (ftnlen)80, input_len); - return 0; - -/* The following entry point fetches the next symbol and its */ -/* definition for the next SYMBOL whose name */ -/* matches a previously supplied template via the entry point */ -/* above --- SYMPAT. */ - -/* If there is no matching symbol, we get back blanks. Note */ -/* that no translation of the definition is performed. */ - - -L_symget: - s_copy(input, " ", input_len, (ftnlen)1); - s_copy(output, " ", output_len, (ftnlen)1); - n = cardc_(names, (ftnlen)32); - while(lsttry < n) { - ++lsttry; - gotone = matchm_(names + (((i__1 = lsttry + 5) < 206 && 0 <= i__1 ? - i__1 : s_rnge("names", i__1, "stran_", (ftnlen)767)) << 5), - pattrn, "*", "%", "~", "|", (ftnlen)32, (ftnlen)80, (ftnlen)1, - (ftnlen)1, (ftnlen)1, (ftnlen)1); - if (gotone) { - s_copy(symbol, names + (((i__1 = lsttry + 5) < 206 && 0 <= i__1 ? - i__1 : s_rnge("names", i__1, "stran_", (ftnlen)771)) << 5) - , (ftnlen)33, (ftnlen)32); - s_copy(input, names + (((i__1 = lsttry + 5) < 206 && 0 <= i__1 ? - i__1 : s_rnge("names", i__1, "stran_", (ftnlen)772)) << 5) - , input_len, (ftnlen)32); - sbget_1__(symbol, names, ptrs, buffer, output, &i__, (ftnlen)33, ( - ftnlen)32, (ftnlen)256, output_len); - return 0; - } - } - return 0; -} /* stran_ */ - -/* Subroutine */ int stran_(char *input, char *output, logical *tran, ftnlen - input_len, ftnlen output_len) -{ - return stran_0_(0, input, output, tran, input_len, output_len); - } - -/* Subroutine */ int sympat_(char *input, ftnlen input_len) -{ - return stran_0_(1, input, (char *)0, (logical *)0, input_len, (ftnint)0); - } - -/* Subroutine */ int symget_(char *input, char *output, ftnlen input_len, - ftnlen output_len) -{ - return stran_0_(2, input, output, (logical *)0, input_len, output_len); - } - diff --git a/ext/spice/src/csupport/syptrc.c b/ext/spice/src/csupport/syptrc.c deleted file mode 100644 index 8cdc8bef08..0000000000 --- a/ext/spice/src/csupport/syptrc.c +++ /dev/null @@ -1,216 +0,0 @@ -/* syptrc.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYPTRC ( Symbol table, fetch pointers, generic ) */ -/* Subroutine */ int syptrc_(char *name__, char *symnam, integer *symptr, - char *symval, integer *ptr, integer *n, logical *found, ftnlen - name_len, ftnlen symnam_len, ftnlen symval_len) -{ - /* System generated locals */ - integer i__1; - char ch__1[1]; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - extern /* Character */ VOID touchc_(char *, ftnlen, char *, ftnlen); - integer number; - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* Return the address of the first value associated with a symbol */ -/* and the number of values associated with the symbol. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of a symbol. */ -/* SYMNAM I The name cell of symbol table. */ -/* SYMPTR I The pointer cell of a symbol table. */ -/* SYMVAL I The value cell of a symbol table. */ -/* PTR O The index of the first value associated with NAME. */ -/* N O The number of values associated with NAME. */ -/* FOUND O TRUE if NAME is in the symbol table, else FALSE */ - -/* $ Detailed_Input */ - -/* NAME is a string representing the name of some symbol that */ -/* might be in the symbol table SYMNAM, SYMPTR, ... */ - -/* SYMNAM is a symbol table. */ -/* SYMPTR */ -/* SYMVAL */ - - -/* $ Detailed_Output */ - -/* PTR is the location in the values cell of the symbol table */ -/* where the values associated with NAME begin. */ - -/* N is the number of values in the symbol table */ -/* associated with NAME. */ - -/* FOUND is TRUE if NAME is the name of a symbol. Otherwise, */ -/* it is FALSE. */ - - -/* $ Parameters */ - - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is not present in the symbol table, N and PTR will */ -/* both be returned with the value 0. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the index of the first value associated with */ -/* a particular name in a symbol table. It also returns the number */ -/* of values associated with the name. In this way, routines that */ -/* "read" the values associated with a symbol table name, can read */ -/* them directly without having to declare local storage for these */ -/* values. */ - -/* $ Examples */ - -/* Suppose that you need to count the number of values associated */ -/* with NAME that satisfy some property (computed by a logical */ -/* function PROP that you have written). The following block of code */ -/* would do the job. */ - -/* COUNT = 0 */ - -/* CALL SYPTRC ( NAME, SYMNAM, SYMPTR, SYMVAL, PTR, N, FOUND ) */ - -/* DO I = PTR, PTR + N - 1 */ - -/* IF ( PROP(SYMVAL(I)) ) THEN */ -/* COUNT = COUNT + 1 */ -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* User's should not attempt to access values beyond those in the */ -/* range returned returned by this routine. Also, any action that is */ -/* to be performed with the values associated with NAME should */ -/* be performed within a scope in which the symbol table cannot */ -/* be altered by other calls to symbol table routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (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 */ - - -/* - Beta Version 1.0.0, 4-MAY-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find pointers to values in a symbol table. */ - -/* -& */ - if (return_()) { - return 0; - } else { - chkin_("SYPTRC", (ftnlen)6); - } - -/* We don't use the values of the symbol table in this routine */ -/* but it is passed for the sake of uniformity in the symbol */ -/* table routine calling sequences. However, some compilers */ -/* generate warnings if a variable isn't used. So we touch */ -/* the values cell to fake out the compiler. */ - - touchc_(ch__1, (ftnlen)1, symval, symval_len); - *(unsigned char *)&symval[0] = *(unsigned char *)&ch__1[0]; - -/* Now for the real work of this routine. */ - - number = cardc_(symnam, symnam_len); - loc = bsrchc_(name__, &number, symnam + symnam_len * 6, name_len, - symnam_len); - if (loc == 0) { - *found = FALSE_; - *ptr = 0; - *n = 0; - chkout_("SYPTRC", (ftnlen)6); - return 0; - } - i__1 = loc - 1; - *ptr = sumai_(&symptr[6], &i__1) + 1; - *n = symptr[loc + 5]; - *found = TRUE_; - chkout_("SYPTRC", (ftnlen)6); - return 0; -} /* syptrc_ */ - diff --git a/ext/spice/src/csupport/syptri.c b/ext/spice/src/csupport/syptri.c deleted file mode 100644 index 2ab1cfbb88..0000000000 --- a/ext/spice/src/csupport/syptri.c +++ /dev/null @@ -1,202 +0,0 @@ -/* syptri.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure SYPTRI ( Symbol table, fetch pointers, generic ) */ -/* Subroutine */ int syptri_(char *name__, char *symnam, integer *symptr, - integer *symval, integer *ptr, integer *n, logical *found, ftnlen - name_len, ftnlen symnam_len) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - extern integer cardc_(char *, ftnlen); - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *, - char *, ftnlen, ftnlen); - integer number; - extern integer touchi_(integer *); - extern /* Subroutine */ int chkout_(char *, ftnlen); - extern logical return_(void); - integer loc; - -/* $ Abstract */ - -/* Return the address of the first value associated with a symbol */ -/* and the number of values associated with the symbol. */ - -/* $ 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 */ - -/* SYMBOLS */ - -/* $ Keywords */ - -/* SYMBOLS */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NAME I The name of a symbol. */ -/* SYMNAM I The name cell of symbol table. */ -/* SYMPTR I The pointer cell of a symbol table. */ -/* SYMVAL I The value cell of a symbol table. */ -/* PTR O The index of the first value associated with NAME. */ -/* N O The number of values associated with NAME. */ -/* FOUND O TRUE if NAME is in the symbol table, else FALSE */ - -/* $ Detailed_Input */ - -/* NAME is a string representing the name of some symbol that */ -/* might be in the symbol table SYMNAM, SYMPTR, ... */ - -/* SYMNAM is a symbol table. */ -/* SYMPTR */ -/* SYMVAL */ - - -/* $ Detailed_Output */ - -/* PTR is the location in the values cell of the symbol table */ -/* where the values associated with NAME begin. */ - -/* N is the number of values in the symbol table */ -/* associated with NAME. */ - -/* FOUND is TRUE if NAME is the name of a symbol. Otherwise, */ -/* it is FALSE. */ - - -/* $ Parameters */ - - -/* None. */ - -/* $ Exceptions */ - -/* 1) If NAME is not present in the symbol table, N and PTR will */ -/* both be returned with the value 0. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine returns the index of the first value associated with */ -/* a particular name in a symbol table. It also returns the number */ -/* of values associated with the name. In this way, routines that */ -/* "read" the values associated with a symbol table name, can read */ -/* them directly without having to declare local storage for these */ -/* values. */ - -/* $ Examples */ - -/* Suppose that you need to count the number of values associated */ -/* with NAME that satisfy some property (computed by a logical */ -/* function PROP that you have written). The following block of code */ -/* would do the job. */ - -/* COUNT = 0 */ - -/* CALL SYPTRI ( NAME, SYMNAM, SYMPTR, SYMVAL, PTR, N, FOUND ) */ - -/* DO I = PTR, PTR + N - 1 */ - -/* IF ( PROP(SYMVAL(I)) ) THEN */ -/* COUNT = COUNT + 1 */ -/* END IF */ - -/* END DO */ - - -/* $ Restrictions */ - -/* User's should not attempt to access values beyond those in the */ -/* range returned returned by this routine. Also, any action that is */ -/* to be performed with the values associated with NAME should */ -/* be performed within a scope in which the symbol table cannot */ -/* be altered by other calls to symbol table routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 4-MAY-1992 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - -/* Find pointers to values in a symbol table. */ - -/* -& */ - if (return_()) { - return 0; - } else { - chkin_("SYPTRI", (ftnlen)6); - } - -/* We don't use the values of the symbol table in this routine */ -/* but it is passed for the sake of uniformity in the symbol */ -/* table routine calling sequences. However, some compilers */ -/* generate warnings if a variable isn't used. So we touch */ -/* the values cell to fake out the compiler. */ - - symval[0] = touchi_(symval); - -/* Now for the real work of this routine. */ - - number = cardc_(symnam, symnam_len); - loc = bsrchc_(name__, &number, symnam + symnam_len * 6, name_len, - symnam_len); - if (loc == 0) { - *found = FALSE_; - *ptr = 0; - *n = 0; - chkout_("SYPTRI", (ftnlen)6); - return 0; - } - i__1 = loc - 1; - *ptr = sumai_(&symptr[6], &i__1) + 1; - *n = symptr[loc + 5]; - *found = TRUE_; - chkout_("SYPTRI", (ftnlen)6); - return 0; -} /* syptri_ */ - diff --git a/ext/spice/src/csupport/tabrpt.c b/ext/spice/src/csupport/tabrpt.c deleted file mode 100644 index d716e8c251..0000000000 --- a/ext/spice/src/csupport/tabrpt.c +++ /dev/null @@ -1,882 +0,0 @@ -/* tabrpt.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static integer c__260 = 260; - -/* $Procedure TABRPT ( Table Format Report ) */ -/* Subroutine */ int tabrpt_0_(int n__, integer *nitems, integer *item, - integer *size, integer *width, logical *justr, logical *presrv, char * - spcial, integer *lmarge, integer *space, S_fp fetch, ftnlen - spcial_len) -{ - /* Initialized data */ - - static char key[32] = "abort "; - static char hrd[60] = " " - " "; - static logical dohrd = FALSE_; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - static char page[132*520]; - static logical done[60]; - static integer left; - static char long__[1024]; - static logical full; - static integer last, wdth, room, i__, j; - extern integer cardc_(char *, ftnlen); - static integer l, r__; - extern /* Subroutine */ int chkin_(char *, ftnlen); - static char value[32]; - static integer right; - extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, - ftnlen, ftnlen, ftnlen); - static integer count[60], putat; - extern logical eqstr_(char *, char *, ftnlen, ftnlen); - static char style[80*60]; - static integer nrows; - extern /* Subroutine */ int rjust_(char *, char *, ftnlen, ftnlen); - static integer id; - extern logical failed_(void); - static logical filled; - static char buffer[132*266]; - extern /* Subroutine */ int replch_(char *, char *, char *, char *, - ftnlen, ftnlen, ftnlen, ftnlen); - static logical finish; - extern /* Subroutine */ int pagpmt_(integer *, char *, ftnlen), chkout_( - char *, ftnlen), ssizec_(integer *, char *, ftnlen), pagput_(char - *, ftnlen); - extern integer qlstnb_(char *, ftnlen); - extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, - ftnlen); - static integer toship; - static char getstr[1024]; - static logical noroom; - static integer maxrow; - extern logical return_(void); - static integer did, row[60]; - extern /* Subroutine */ int nicebt_1__(char *, char *, char *, ftnlen, - ftnlen, ftnlen); - -/* $ Abstract */ - -/* This routine creates a tabular report using the parameters */ -/* supplied for the arrangement of the report and the user */ -/* supplied routine that fetches the items to be placed in */ -/* the report. */ - -/* $ Required_Reading */ - -/* REPORTS */ - -/* $ Keywords */ - -/* IO */ -/* REPORTING */ -/* TABLE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* NITEMS I The number of columns that should appear */ -/* ITEM I An array of item codes */ -/* SIZE I The number of components associated with the items */ -/* WIDTH I The room to allow for each item */ -/* JUSTR I Justify right */ -/* SPACE I The amount of space to place between columns */ -/* LMARGE I Location of the left margin */ -/* PRESRV I Logical indicating whether to preserve components */ -/* SPCIAL I Special characters to us/recognize in a column */ -/* FETCH I Name of a routine that will fetch data for an item. */ -/* MAXWDTH P The maximum width for the report. */ -/* MAXCOL P Maximum number of columns that can be supported. */ - -/* $ Detailed_Input */ - -/* NITEMS The number of columns that should appear in this */ -/* this block of the report. */ - -/* ITEM An array of id codes that can be used to fetch */ -/* the data strings that will be formatted into the */ -/* columns of this block of the report. */ - -/* SIZE The number of components associated with each item. */ - -/* WIDTH The maximum number of characters that may appear */ -/* across a column */ - -/* JUSTR A logical array. If JUSTR(I) is true, then the */ -/* data for a column will be right justified. Otherwise */ -/* it will be left justified. */ - -/* SPACE The amount of space to place between columns */ - -/* LMARGE Location of the left margin */ - -/* PRESRV Logical indicating whether to preserve components */ -/* by starting each new component on a new line in */ -/* its column. */ - -/* SPCIAL Special instructions that may be used to alter the */ -/* style of output in a column. For example you might */ -/* want to have leaders or a trailer so that the */ -/* report will have vertical bars between columns. */ -/* Or if the column has preserved spacing you might */ -/* choose to use a flag with each component (especially */ -/* if it is likely to wrap over several lines. */ - -/* FETCH Name of a routine that will fetch data for an item. */ - -/* $ Detailed_Output */ - - -/* $ Parameters */ - -/* MXWDTH is the maximum width page that is supported for */ -/* report generation. This parameter should never */ -/* be larger than the same parameter that is used */ -/* in the PAGE MANAGER routine PAGMAN. */ - -/* MAXCOL is the maximum number of columns that can appear */ -/* in a report */ - -/* $ Exceptions */ - -/* 1) If NITEMS is larger than MAXCOL the error */ -/* SPICE(TOOMANYCOLUMNS) will be signalled. */ - -/* 2) If the space required implied by WIDTHS, SPACE and LMARGE */ -/* is greater than MXWDTH the error SPICE(REPORTTOOWIDE) will */ -/* be signalled. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine allows you to "easily" create nicely formatted */ -/* reports for output by your programs. By setting the parameters */ -/* supplied on input together with the parameters that control */ -/* page layout as used by PAGMAN you can produce a wide variety of */ -/* report formats without having to deal with the details of */ -/* arranging the output on the screen. */ - -/* $ Examples */ - -/* copy required reading examples here. */ - -/* $ Restrictions */ - -/* This routine works in conjunction with the routine PAGMAN */ -/* and its entry points. You need to be sure that PAGMAN has */ -/* been properly initialized before you begin using this routine. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 3.0.0, 2-OCT-1996 (WLT) */ - -/* Increased the internal buffer sizes and modified */ -/* the fetching logic so that the buffer will not fill */ -/* up and inadvertantly cut off data with no warning. */ - -/* - Beta Version 2.0.0, 9-Aug-1995 (WLT) */ - -/* Increased several buffer parameters and put in a check */ -/* for FAILED so that we can quit this thing if we need to. */ - -/* - Beta Version 1.0.0, 1-JAN-1994 (WLT) */ - -/* -& */ -/* $ Index_Entries */ - - -/* Arrange data in columns */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Other functions */ - - -/* Local parameters */ - - -/* The arrays below are used to store attributes on a column */ -/* by column basis. */ - -/* STYLE is the style to be used when formating text for an */ -/* individual column */ - -/* COUNT is a counter that is used to indicate how many components */ -/* have been processed for an individual column */ - -/* ROW keeps track of the last row in the local page where */ -/* formatted text was placed. */ - -/* DONE is a logical that indicates whether we have formatted */ -/* all of the data for a column. */ - - -/* Local variables */ - - -/* Saved variables */ - - /* Parameter adjustments */ - if (item) { - } - if (size) { - } - if (width) { - } - if (justr) { - } - if (presrv) { - } - - /* Function Body */ - switch(n__) { - case 1: goto L_tababt; - case 2: goto L_tabhrd; - } - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("TABRPT", (ftnlen)6); - -/* Initialize the cell that is used by NICEBT and make sure */ -/* the page is completely blank */ - - for (i__ = 1; i__ <= 520; ++i__) { - s_copy(page + ((i__1 = i__ - 1) < 520 && 0 <= i__1 ? i__1 : s_rnge( - "page", i__1, "tabrpt_", (ftnlen)294)) * 132, " ", (ftnlen) - 132, (ftnlen)1); - } - -/* Initialize the local page and set the column parameters. */ - - i__1 = *nitems; - for (i__ = 1; i__ <= i__1; ++i__) { - done[(i__2 = i__ - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("done", i__2, - "tabrpt_", (ftnlen)301)] = FALSE_; - count[(i__2 = i__ - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("count", - i__2, "tabrpt_", (ftnlen)302)] = 0; - row[(i__2 = i__ - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("row", i__2, - "tabrpt_", (ftnlen)303)] = 0; - repmi_("LEFT 1 RIGHT #", "#", &width[i__ - 1], style + ((i__2 = i__ - - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("style", i__2, "tabrpt_", - (ftnlen)304)) * 80, (ftnlen)14, (ftnlen)1, (ftnlen)80); - suffix_(spcial + (i__ - 1) * spcial_len, &c__1, style + ((i__2 = i__ - - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("style", i__2, "tabrp" - "t_", (ftnlen)305)) * 80, spcial_len, (ftnlen)80); - } - -/* The logical FINISH is used to keep track of whether or not */ -/* we have finished processing all items. Certainly we haven't */ -/* done so yet. It will be the value of the expression given */ -/* by DONE(1) .AND. DONE(2) .AND. ... .AND. DONE(NITEMS) */ - - finish = FALSE_; - while(! finish) { - -/* We need to reset the left margin of the page. */ - - left = *lmarge; - i__1 = *nitems; - for (id = 1; id <= i__1; ++id) { - -/* We are going to format items for output one at a time. */ -/* We will either fetch all of the components, or we */ -/* will fill up the room allotted for this item in the */ -/* buffer that will hold the data. */ - -/* Thus at the end of this loop, we will have filled */ -/* up as much room as there is for this part of the */ -/* report and be ready to send that stuff to the */ -/* printer. */ - -/* Set the right margin and determine whether or not */ -/* the COLUMN that holds the text to be formatted is */ -/* already filled up. */ - - filled = row[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "row", i__2, "tabrpt_", (ftnlen)337)] >= 260 || done[( - i__3 = id - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge("done", - i__3, "tabrpt_", (ftnlen)337)]; - right = left + width[id - 1] - 1; - while(! filled) { - -/* Put data into the long string for output until */ -/* it becomes full or it is appropriate to stop doing */ -/* so (there's no more data, or the PRESRV flag tells */ -/* us to stop). */ - putat = 1; - full = FALSE_; -/* Computing MIN */ - i__2 = 1024, i__3 = width[id - 1] * 130; - room = min(i__2,i__3); - s_copy(long__, " ", (ftnlen)1024, (ftnlen)1); - while(! done[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : - s_rnge("done", i__2, "tabrpt_", (ftnlen)353)] && ! - full) { - -/* Increment COUNT so that we can fetch the next */ -/* component of this item. */ - - count[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "count", i__2, "tabrpt_", (ftnlen)359)] = count[( - i__3 = id - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge( - "count", i__3, "tabrpt_", (ftnlen)359)] + 1; - (*fetch)(&item[id - 1], &count[(i__2 = id - 1) < 60 && 0 - <= i__2 ? i__2 : s_rnge("count", i__2, "tabrpt_", - (ftnlen)361)], getstr, &wdth, (ftnlen)1024); - if (failed_()) { - chkout_("TABRPT", (ftnlen)6); - return 0; - } - -/* Determine the next place to add on to this string */ -/* and see if adding on at that point would fill up */ -/* the available space in our string. */ - - l = qlstnb_(getstr, (ftnlen)1024); - last = max(l,1); - if (putat + l < room) { - s_copy(long__ + (putat - 1), getstr, 1024 - (putat - - 1), last); -/* Computing MIN */ - i__2 = putat + l + 2; - putat = min(i__2,1024); - -/* If the input was a blank, we step back to */ -/* the beginning of the string. */ - - if (putat == 2) { - putat = 1; - } - noroom = putat + width[id - 1] >= room; - } else if (putat == 1) { - -/* This case is very funky. We are at the very */ -/* beginning of the output buffer, but there still */ -/* isn't room. This means the user requested */ -/* a width such that HLFHLD * WIDTH(ID) is smaller */ -/* than the size of the data in the column. */ -/* In other words, the width must be less than */ -/* the value DATA_LENGTH/HLFHLD. Since the */ -/* maximum data length is 1024 and HLFHLD is */ -/* at last look 130, this means they have asked */ -/* to fit data that is very long into a very */ -/* column that is less than 8 characters wide. */ -/* Sorry but there doesn't seem to be a morally */ -/* compelling reason to handle this case */ -/* robustly. We just put some dots at the end */ -/* of the output to indicate there's more stuff */ -/* that can't be printed. */ - - s_copy(long__, getstr, (ftnlen)1024, (ftnlen)1024); - noroom = TRUE_; - i__2 = room - 8; - s_copy(long__ + i__2, "........", room - i__2, ( - ftnlen)8); - putat = room; - } else { - -/* There isn't room to append GETSTR to the end */ -/* of LONG. Adjust the counter back by 1 and */ -/* set NOROOM to .TRUE. */ - - count[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : - s_rnge("count", i__2, "tabrpt_", (ftnlen)421)] - = count[(i__3 = id - 1) < 60 && 0 <= i__3 ? - i__3 : s_rnge("count", i__3, "tabrpt_", ( - ftnlen)421)] - 1; - noroom = TRUE_; - } - done[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge( - "done", i__2, "tabrpt_", (ftnlen)426)] = count[( - i__3 = id - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge( - "count", i__3, "tabrpt_", (ftnlen)426)] >= size[ - id - 1]; - full = presrv[id - 1] || noroom; - } - -/* Format the string into the holding buffer. */ - - ssizec_(&c__260, buffer, (ftnlen)132); - nicebt_1__(long__, style + ((i__2 = id - 1) < 60 && 0 <= i__2 - ? i__2 : s_rnge("style", i__2, "tabrpt_", (ftnlen)435) - ) * 80, buffer, putat, (ftnlen)80, (ftnlen)132); - if (failed_()) { - chkout_("TABRPT", (ftnlen)6); - return 0; - } - nrows = cardc_(buffer, (ftnlen)132); - -/* Transfer the data from the holding buffer */ -/* to the page layout buffer. */ - - i__2 = nrows; - for (j = 1; j <= i__2; ++j) { - row[(i__3 = id - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge( - "row", i__3, "tabrpt_", (ftnlen)448)] = row[(i__4 - = id - 1) < 60 && 0 <= i__4 ? i__4 : s_rnge("row", - i__4, "tabrpt_", (ftnlen)448)] + 1; - r__ = row[(i__3 = id - 1) < 60 && 0 <= i__3 ? i__3 : - s_rnge("row", i__3, "tabrpt_", (ftnlen)449)]; - s_copy(page + (((i__3 = r__ - 1) < 520 && 0 <= i__3 ? - i__3 : s_rnge("page", i__3, "tabrpt_", (ftnlen) - 451)) * 132 + (left - 1)), buffer + ((i__4 = j + - 5) < 266 && 0 <= i__4 ? i__4 : s_rnge("buffer", - i__4, "tabrpt_", (ftnlen)451)) * 132, right - ( - left - 1), (ftnlen)132); - if (justr[id - 1]) { - rjust_(page + (((i__3 = r__ - 1) < 520 && 0 <= i__3 ? - i__3 : s_rnge("page", i__3, "tabrpt_", ( - ftnlen)454)) * 132 + (left - 1)), page + ((( - i__4 = r__ - 1) < 520 && 0 <= i__4 ? i__4 : - s_rnge("page", i__4, "tabrpt_", (ftnlen)454)) - * 132 + (left - 1)), right - (left - 1), - right - (left - 1)); - } - -/* Replace any "hardspaces" by blanks. */ - - if (dohrd) { - if (*(unsigned char *)&hrd[id - 1] != ' ') { - replch_(page + (((i__3 = r__ - 1) < 520 && 0 <= - i__3 ? i__3 : s_rnge("page", i__3, "tabr" - "pt_", (ftnlen)462)) * 132 + (left - 1)), - hrd + (id - 1), " ", page + (((i__4 = r__ - - 1) < 520 && 0 <= i__4 ? i__4 : s_rnge( - "page", i__4, "tabrpt_", (ftnlen)462)) * - 132 + (left - 1)), right - (left - 1), ( - ftnlen)1, (ftnlen)1, right - (left - 1)); - } - } - } - -/* Determine whether this column has been sufficiently */ -/* filled up. */ - - done[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("done", - i__2, "tabrpt_", (ftnlen)474)] = count[(i__3 = id - - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge("count", i__3, - "tabrpt_", (ftnlen)474)] >= size[id - 1]; - filled = done[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : - s_rnge("done", i__2, "tabrpt_", (ftnlen)475)] || row[( - i__3 = id - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge( - "row", i__3, "tabrpt_", (ftnlen)475)] >= 260; - } - -/* Once you get to this point, the current column has */ -/* been filled as much as is possible. We need to */ -/* Set the left margin for the next item to process */ - - left = right + *space + 1; - } - -/* By the time you get to this point, every column has either */ -/* filled up or there's nothing left to print. */ - -/* In either case we need to ship out the rows from */ -/* 1 to MIN ( MAX{ROW(1) ... ROW(NITEMS)}, THRSHOLD ) */ -/* and shift the rest of the stuff up in the buffer. */ - - maxrow = 0; - i__1 = *nitems; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing MAX */ - i__3 = maxrow, i__4 = row[(i__2 = i__ - 1) < 60 && 0 <= i__2 ? - i__2 : s_rnge("row", i__2, "tabrpt_", (ftnlen)501)]; - maxrow = max(i__3,i__4); - } - toship = min(maxrow,260); - -/* Ship out the rows that are ready to go. */ - - i__1 = toship; - for (r__ = 1; r__ <= i__1; ++r__) { - pagput_(page + ((i__2 = r__ - 1) < 520 && 0 <= i__2 ? i__2 : - s_rnge("page", i__2, "tabrpt_", (ftnlen)509)) * 132, ( - ftnlen)132); - pagpmt_(&did, value, (ftnlen)32); - if (did != 0) { - if (eqstr_(value, key, (ftnlen)32, (ftnlen)32)) { - chkout_("TABRPT", (ftnlen)6); - return 0; - } - } - } - -/* Shift the remaining rows up to the top of the page */ - - for (r__ = toship + 1; r__ <= 520; ++r__) { - s_copy(page + ((i__1 = r__ - toship - 1) < 520 && 0 <= i__1 ? - i__1 : s_rnge("page", i__1, "tabrpt_", (ftnlen)526)) * - 132, page + ((i__2 = r__ - 1) < 520 && 0 <= i__2 ? i__2 : - s_rnge("page", i__2, "tabrpt_", (ftnlen)526)) * 132, ( - ftnlen)132, (ftnlen)132); - } - -/* Blank out the last TOSHIP rows. */ - - for (r__ = 520 - toship + 1; r__ <= 520; ++r__) { - s_copy(page + ((i__1 = r__ - 1) < 520 && 0 <= i__1 ? i__1 : - s_rnge("page", i__1, "tabrpt_", (ftnlen)533)) * 132, - " ", (ftnlen)132, (ftnlen)1); - } - -/* Finally adjust the positions where each column should begin */ -/* filling in more data. */ - - i__1 = *nitems; - for (j = 1; j <= i__1; ++j) { -/* Computing MAX */ - i__4 = row[(i__3 = j - 1) < 60 && 0 <= i__3 ? i__3 : s_rnge("row", - i__3, "tabrpt_", (ftnlen)540)] - toship; - row[(i__2 = j - 1) < 60 && 0 <= i__2 ? i__2 : s_rnge("row", i__2, - "tabrpt_", (ftnlen)540)] = max(i__4,0); - } - -/* Now examine each of the ID's to see if we are done */ -/* processing all items. */ - - finish = TRUE_; - i__1 = *nitems; - for (id = 1; id <= i__1; ++id) { - finish = finish && done[(i__2 = id - 1) < 60 && 0 <= i__2 ? i__2 : - s_rnge("done", i__2, "tabrpt_", (ftnlen)550)]; - } - } - -/* Send any remaining rows out to the page manager. */ - - maxrow = 0; - i__1 = *nitems; - for (i__ = 1; i__ <= i__1; ++i__) { -/* Computing MAX */ - i__3 = maxrow, i__4 = row[(i__2 = i__ - 1) < 60 && 0 <= i__2 ? i__2 : - s_rnge("row", i__2, "tabrpt_", (ftnlen)561)]; - maxrow = max(i__3,i__4); - } - i__1 = maxrow; - for (r__ = 1; r__ <= i__1; ++r__) { - pagput_(page + ((i__2 = r__ - 1) < 520 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "tabrpt_", (ftnlen)565)) * 132, (ftnlen)132); - s_copy(page + ((i__2 = r__ - 1) < 520 && 0 <= i__2 ? i__2 : s_rnge( - "page", i__2, "tabrpt_", (ftnlen)566)) * 132, " ", (ftnlen) - 132, (ftnlen)1); - pagpmt_(&did, value, (ftnlen)32); - if (did != 0) { - if (eqstr_(value, key, (ftnlen)32, (ftnlen)32)) { - chkout_("TABRPT", (ftnlen)6); - return 0; - } - } - } - chkout_("TABRPT", (ftnlen)6); - return 0; -/* $Procedure TABABT ( Tabular Report Abort Key ) */ - -L_tababt: -/* $ Abstract */ - -/* Set the abort string to use if the page manager prompt has */ -/* been set. */ - -/* $ 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 */ - -/* REPORTS */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ - -/* CHARACTER*(*) SPCIAL */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* SPCIAL I String used to indicate report should be aborted. */ - -/* $ Detailed_Input */ - -/* SPCIAL is an array of strings. Only the first entry is used. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* None. */ - -/* $ Particulars */ - -/* This entry point is used to set the KEY that is used to */ -/* determine whether or not a report should be aborted */ - -/* $ Examples */ - -/* Suppose that you plan to ask the user whether or not */ -/* a report should be continued. And that the user should */ -/* type 'N' if the report should not be continued. */ - -/* CALL TABABT ( 'N' ) */ - -/* DO WHILE ( MOREDATA ) */ - -/* CALL TABRPT ( .... ) */ - -/* CALL PAGPMT ( DIDPMT, RESPNS ) */ -/* IF ( DIDPMT .EQ. 1 ) THEN */ -/* QUIT = EQSTR( RESPNS, 'N' ) */ -/* END IF */ - -/* IF ( .NOT. QUIT ) THEN */ - -/* see if there is more data */ - -/* ELSE */ - -/* MOREDATA = .FALSE. */ - -/* END IF */ - -/* END DO */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 10-SEP-1998 (WLT) */ - - -/* -& */ - s_copy(key, spcial, (ftnlen)32, spcial_len); - return 0; -/* $Procedure TABHRD ( Tabular Report Hard Space ) */ - -L_tabhrd: -/* $ Abstract */ - -/* Set the hard space to be used in reports. */ - -/* $ 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 */ - -/* REPORTS */ - -/* $ Declarations */ - -/* IMPLICIT NONE */ -/* INTEGER NITEMS */ -/* CHARACTER*(*) SPCIAL ( * ) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* NITEMS I Number of items to check in a report. */ -/* SPCIAL I SPCIAL(I)(1:1) contains that hardspace character */ - -/* The function returns */ - -/* $ Detailed_Input */ - -/* NITEMS Number of items to appear in a report. */ - -/* SPCIAL The string SPCIAL(I) contains the character that */ -/* should be filtered from the Ith entry and converted */ -/* to a space after all justifications and formatting */ -/* have been performed. */ - -/* $ Detailed_Output */ - -/* None. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Particulars */ - -/* This entry point allows you to specify some character that */ -/* should be converted to a blank character after all column */ -/* settings and justifications have been performed. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 23-SEP-1998 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* set a hard space character */ - -/* -& */ - s_copy(hrd, " ", (ftnlen)60, (ftnlen)1); - dohrd = FALSE_; - i__1 = *nitems; - for (i__ = 1; i__ <= i__1; ++i__) { - s_copy(hrd + (i__ - 1), spcial + (i__ - 1) * spcial_len, (ftnlen)1, - spcial_len); - dohrd = dohrd || *(unsigned char *)&hrd[i__ - 1] != ' '; - } - return 0; -} /* tabrpt_ */ - -/* Subroutine */ int tabrpt_(integer *nitems, integer *item, integer *size, - integer *width, logical *justr, logical *presrv, char *spcial, - integer *lmarge, integer *space, S_fp fetch, ftnlen spcial_len) -{ - return tabrpt_0_(0, nitems, item, size, width, justr, presrv, spcial, - lmarge, space, fetch, spcial_len); - } - -/* Subroutine */ int tababt_(char *spcial, ftnlen spcial_len) -{ - return tabrpt_0_(1, (integer *)0, (integer *)0, (integer *)0, (integer *) - 0, (logical *)0, (logical *)0, spcial, (integer *)0, (integer *)0, - (S_fp)0, spcial_len); - } - -/* Subroutine */ int tabhrd_(integer *nitems, char *spcial, ftnlen spcial_len) -{ - return tabrpt_0_(2, nitems, (integer *)0, (integer *)0, (integer *)0, ( - logical *)0, (logical *)0, spcial, (integer *)0, (integer *)0, ( - S_fp)0, spcial_len); - } - diff --git a/ext/spice/src/csupport/trnlat.c b/ext/spice/src/csupport/trnlat.c deleted file mode 100644 index 710cf0ebe3..0000000000 --- a/ext/spice/src/csupport/trnlat.c +++ /dev/null @@ -1,374 +0,0 @@ -/* trnlat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__28 = 28; - -/* $ 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. */ - -/* Subroutine */ int trnlat_(char *phrase, char *messge, ftnlen phrase_len, - ftnlen messge_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, - char *, integer); - - /* Local variables */ - static char lang[32]; - static integer item; - static char title[32*28]; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static char french[400*28], german[400*28]; - extern /* Subroutine */ int getlan_(char *, ftnlen), orderc_(char *, - integer *, integer *, ftnlen), reordc_(integer *, integer *, char - *, ftnlen); - static char englsh[400*28]; - static integer iorder[28]; - static char russan[400*28]; - - -/* $ Version */ - -/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */ - -/* This is the configured version of the Command Loop */ -/* software as of May 4, 1994 */ - - -/* This is a language dependent routine. */ - - -/* Spicelib functions */ - - -/* Local parameters and variables */ - - if (first) { - first = FALSE_; - s_copy(title, "ERRFLAG", (ftnlen)32, (ftnlen)7); - s_copy(englsh, "-Oops!-", (ftnlen)400, (ftnlen)7); - s_copy(french, "--%-Sacre^Bleu!!-%^^:", (ftnlen)400, (ftnlen)21); - s_copy(german, "--%-Achtung!!-%^^:", (ftnlen)400, (ftnlen)18); - s_copy(russan, "--%-ERROR-%^^:", (ftnlen)400, (ftnlen)14); - s_copy(title + 32, "EXIT", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 400, "EXIT", (ftnlen)400, (ftnlen)4); - s_copy(french + 400, "SORTIE", (ftnlen)400, (ftnlen)6); - s_copy(german + 400, "EXIT", (ftnlen)400, (ftnlen)4); - s_copy(russan + 400, "EXIT", (ftnlen)400, (ftnlen)4); - s_copy(title + 64, "START", (ftnlen)32, (ftnlen)5); - s_copy(englsh + 800, "START", (ftnlen)400, (ftnlen)5); - s_copy(french + 800, "COMMENCER", (ftnlen)400, (ftnlen)9); - s_copy(german + 800, "START", (ftnlen)400, (ftnlen)5); - s_copy(russan + 800, "START", (ftnlen)400, (ftnlen)5); - s_copy(title + 96, "STOP", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 1200, "STOP", (ftnlen)400, (ftnlen)4); - s_copy(french + 1200, "ARETE", (ftnlen)400, (ftnlen)5); - s_copy(german + 1200, "STOP", (ftnlen)400, (ftnlen)4); - s_copy(russan + 1200, "STOP", (ftnlen)400, (ftnlen)4); - s_copy(title + 128, "DEMO", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 1600, "DEMO", (ftnlen)400, (ftnlen)4); - s_copy(french + 1600, "MONTRER", (ftnlen)400, (ftnlen)7); - s_copy(german + 1600, "DEMO", (ftnlen)400, (ftnlen)4); - s_copy(russan + 1600, "DEMO", (ftnlen)400, (ftnlen)4); - s_copy(title + 160, "PAUSE", (ftnlen)32, (ftnlen)5); - s_copy(englsh + 2000, "PAUSE", (ftnlen)400, (ftnlen)5); - s_copy(french + 2000, "PAUSE", (ftnlen)400, (ftnlen)5); - s_copy(german + 2000, "PAUSE", (ftnlen)400, (ftnlen)5); - s_copy(russan + 2000, "PAUSE", (ftnlen)400, (ftnlen)5); - s_copy(title + 192, "WAIT", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 2400, "WAIT", (ftnlen)400, (ftnlen)4); - s_copy(french + 2400, "ATTENDRE", (ftnlen)400, (ftnlen)8); - s_copy(german + 2400, "WAIT", (ftnlen)400, (ftnlen)4); - s_copy(russan + 2400, "WAIT", (ftnlen)400, (ftnlen)4); - s_copy(title + 224, "QUIT", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 2800, "QUIT", (ftnlen)400, (ftnlen)4); - s_copy(french + 2800, "ARETE", (ftnlen)400, (ftnlen)5); - s_copy(german + 2800, "QUIT", (ftnlen)400, (ftnlen)4); - s_copy(russan + 2800, "QUIT", (ftnlen)400, (ftnlen)4); - s_copy(title + 256, "DEFPROMPT", (ftnlen)32, (ftnlen)9); - s_copy(englsh + 3200, "Yes? >", (ftnlen)400, (ftnlen)6); - s_copy(french + 3200, "Oui? >", (ftnlen)400, (ftnlen)6); - s_copy(german + 3200, "Ja? >", (ftnlen)400, (ftnlen)5); - s_copy(russan + 3200, "Dah? >", (ftnlen)400, (ftnlen)6); - s_copy(title + 288, "MISSINGFILELONG", (ftnlen)32, (ftnlen)15); - s_copy(englsh + 3600, "No command sequence file was specified in the" - " START command. ", (ftnlen)400, (ftnlen)61); - s_copy(french + 3600, "Le fichier command sequence n'est pas present" - " dans le command \"COMMENCER\". ", (ftnlen)400, (ftnlen)75); - s_copy(german + 3600, "No command sequence file was specified in the" - " START command. ", (ftnlen)400, (ftnlen)61); - s_copy(russan + 3600, "No command sequence file was specified in the" - " START command. ", (ftnlen)400, (ftnlen)61); - s_copy(title + 320, "MISSINGFILESHORT", (ftnlen)32, (ftnlen)16); - s_copy(englsh + 4000, "Missing_File_Name", (ftnlen)400, (ftnlen)17); - s_copy(french + 4000, "Nom_de_fichier_abscent", (ftnlen)400, (ftnlen) - 22); - s_copy(german + 4000, "Missing_File_Name", (ftnlen)400, (ftnlen)17); - s_copy(russan + 4000, "Missing_File_Name", (ftnlen)400, (ftnlen)17); - s_copy(title + 352, "UNABLETOSTART", (ftnlen)32, (ftnlen)13); - s_copy(englsh + 4400, "Unable_To_Start_File", (ftnlen)400, (ftnlen)20) - ; - s_copy(french + 4400, "Unable_To_Start_File", (ftnlen)400, (ftnlen)20) - ; - s_copy(german + 4400, "Unable_To_Start_File", (ftnlen)400, (ftnlen)20) - ; - s_copy(russan + 4400, "Unable_To_Start_File", (ftnlen)400, (ftnlen)20) - ; - s_copy(title + 384, "COMBUFFULLLNG", (ftnlen)32, (ftnlen)13); - s_copy(englsh + 4800, "The designer of the program has inadvertantly" - " exceeded the internal command buffer. Please keep your ses" - "sion log and report this problem to NAIF. ", (ftnlen)400, ( - ftnlen)147); - s_copy(french + 4800, "The designer of the program has inadvertantly" - " exceeded the internal command buffer. Please keep your ses" - "sion log and report this problem to NAIF. ", (ftnlen)400, ( - ftnlen)147); - s_copy(german + 4800, "The designer of the program has inadvertantly" - " exceeded the internal command buffer. Please keep your ses" - "sion log and report this problem to NAIF. ", (ftnlen)400, ( - ftnlen)147); - s_copy(russan + 4800, "The designer of the program has inadvertantly" - " exceeded the internal command buffer. Please keep your ses" - "sion log and report this problem to NAIF. ", (ftnlen)400, ( - ftnlen)147); - s_copy(title + 416, "COMBUFFULLSHT", (ftnlen)32, (ftnlen)13); - s_copy(englsh + 5200, "Command_Buffer_Full", (ftnlen)400, (ftnlen)19); - s_copy(french + 5200, "Command_Buffer_Full", (ftnlen)400, (ftnlen)19); - s_copy(german + 5200, "Command_Buffer_Full", (ftnlen)400, (ftnlen)19); - s_copy(russan + 5200, "Command_Buffer_Full", (ftnlen)400, (ftnlen)19); - s_copy(title + 448, "NESTINGTOODEEP", (ftnlen)32, (ftnlen)14); - s_copy(englsh + 5600, "The command sequence contained in # could not" - " be started. There are already # command sequences files tha" - "t have been started without resolution. This is the limit on" - " the number of active command sequence files that can be act" - "ive at any time. ", (ftnlen)400, (ftnlen)242); - s_copy(french + 5600, "The command sequence contained in # could not" - " be started. There are already # command sequences files tha" - "t have been started without resolution. This is the limit on" - " the number of active command sequence files that can be act" - "ive at any time. ", (ftnlen)400, (ftnlen)242); - s_copy(german + 5600, "The command sequence contained in # could not" - " be started. There are already # command sequences files tha" - "t have been started without resolution. This is the limit on" - " the number of active command sequence files that can be act" - "ive at any time. ", (ftnlen)400, (ftnlen)242); - s_copy(russan + 5600, "The command sequence contained in # could not" - " be started. There are already # command sequences files tha" - "t have been started without resolution. This is the limit on" - " the number of active command sequence files that can be act" - "ive at any time. ", (ftnlen)400, (ftnlen)242); - s_copy(title + 480, "NOLOGUNITSFREE", (ftnlen)32, (ftnlen)14); - s_copy(englsh + 6000, "The command sequence contained in # could not" - " be started. There are no FORTRAN logical units available th" - "at can be attached to the file. A possible cause for this pr" - "oblem is that there are too many files already in use by the" - " program. ", (ftnlen)400, (ftnlen)235); - s_copy(french + 6000, "The command sequence contained in # could not" - " be started. There are no FORTRAN logical units available th" - "at can be attached to the file. A possible cause for this pr" - "oblem is that there are too many files already in use by the" - " program. ", (ftnlen)400, (ftnlen)235); - s_copy(german + 6000, "The command sequence contained in # could not" - " be started. There are no FORTRAN logical units available th" - "at can be attached to the file. A possible cause for this pr" - "oblem is that there are too many files already in use by the" - " program. ", (ftnlen)400, (ftnlen)235); - s_copy(russan + 6000, "The command sequence contained in # could not" - " be started. There are no FORTRAN logical units available th" - "at can be attached to the file. A possible cause for this pr" - "oblem is that there are too many files already in use by the" - " program. ", (ftnlen)400, (ftnlen)235); - s_copy(title + 512, "FILENOTEXIST", (ftnlen)32, (ftnlen)12); - s_copy(englsh + 6400, "The file \"#\" could not be started. It doesn" - "'t exist. ", (ftnlen)400, (ftnlen)53); - s_copy(french + 6400, "The file \"#\" could not be started. It doesn" - "'t exist. ", (ftnlen)400, (ftnlen)53); - s_copy(german + 6400, "The file \"#\" could not be started. It doesn" - "'t exist. ", (ftnlen)400, (ftnlen)53); - s_copy(russan + 6400, "The file \"#\" could not be started. It doesn" - "'t exist. ", (ftnlen)400, (ftnlen)53); - s_copy(title + 544, "COMFILEOPENERROR", (ftnlen)32, (ftnlen)16); - s_copy(englsh + 6800, "The command sequence contained in # could not" - " be started. An error occurred while attempting to open the " - "file. ", (ftnlen)400, (ftnlen)111); - s_copy(french + 6800, "The command sequence contained in # could not" - " be started. An error occurred while attempting to open the " - "file. ", (ftnlen)400, (ftnlen)111); - s_copy(german + 6800, "The command sequence contained in # could not" - " be started. An error occurred while attempting to open the " - "file. ", (ftnlen)400, (ftnlen)111); - s_copy(russan + 6800, "The command sequence contained in # could not" - " be started. An error occurred while attempting to open the " - "file. ", (ftnlen)400, (ftnlen)111); - s_copy(title + 576, "LOGFILWRITTENTO", (ftnlen)32, (ftnlen)15); - s_copy(englsh + 7200, "The log file has been written to: ", (ftnlen) - 400, (ftnlen)34); - s_copy(french + 7200, "Le fichier de log s'est ecrivee : ", (ftnlen) - 400, (ftnlen)34); - s_copy(german + 7200, "Das logenfile hass bin written to: ", (ftnlen) - 400, (ftnlen)35); - s_copy(russan + 7200, "The log file has been written to: ", (ftnlen) - 400, (ftnlen)34); - s_copy(title + 608, "SAVFILWRITTENTO", (ftnlen)32, (ftnlen)15); - s_copy(englsh + 7600, "The save file has been written to: ", (ftnlen) - 400, (ftnlen)35); - s_copy(french + 7600, "Le fichier de garde s'est ecrivee : ", (ftnlen) - 400, (ftnlen)36); - s_copy(german + 7600, "Das savenfile hass bin written to: ", (ftnlen) - 400, (ftnlen)35); - s_copy(russan + 7600, "The save file has been written to: ", (ftnlen) - 400, (ftnlen)35); - s_copy(title + 640, "UNABLETOWRITETOFILE", (ftnlen)32, (ftnlen)19); - s_copy(englsh + 8000, "I was unable to write to the file: /cr/cr(3:3" - ") # /cr/cr(-3;-3) The value of IOSTAT that was returned as a" - " diagnosis of the problem was: /cr/cr(3:3) # /cr/cr(-3;-3) T" - "his file is now closed. No further attempts will be made to " - "write to it. ", (ftnlen)400, (ftnlen)238); - s_copy(french + 8000, "I was unable to write to the file: /cr/cr(3:3" - ") # /cr/cr(-3;-3) The value of IOSTAT that was returned as a" - " diagnosis of the problem was: /cr/cr(3:3) # /cr/cr(-3;-3) T" - "his file is now closed. No further attempts will be made to " - "write to it. ", (ftnlen)400, (ftnlen)238); - s_copy(german + 8000, "I was unable to write to the file: /cr/cr(3:3" - ") # /cr/cr(-3;-3) The value of IOSTAT that was returned as a" - " diagnosis of the problem was: /cr/cr(3:3) # /cr/cr(-3;-3) T" - "his file is now closed. No further attempts will be made to " - "write to it. ", (ftnlen)400, (ftnlen)238); - s_copy(russan + 8000, "I was unable to write to the file: /cr/cr(3:3" - ") # /cr/cr(-3;-3) The value of IOSTAT that was returned as a" - " diagnosis of the problem was: /cr/cr(3:3) # /cr/cr(-3;-3) T" - "his file is now closed. No further attempts will be made to " - "write to it. ", (ftnlen)400, (ftnlen)238); - s_copy(title + 672, "WARNING", (ftnlen)32, (ftnlen)7); - s_copy(englsh + 8400, "Warning:", (ftnlen)400, (ftnlen)8); - s_copy(french + 8400, "Attention: ", (ftnlen)400, (ftnlen)11); - s_copy(german + 8400, "Achtung: ", (ftnlen)400, (ftnlen)9); - s_copy(russan + 8400, "Hey!! ", (ftnlen)400, (ftnlen)6); - s_copy(title + 704, "CANNOTOPENLOG", (ftnlen)32, (ftnlen)13); - s_copy(englsh + 8800, "An error occurred while attempting to open th" - "e log file. It will not be possible to keep a log of this se" - "ssion. No further attempts to log commands will be attempted" - ". /cr/cr The cause of the failure to open the log file was d" - "iagnosed to be: /cr/cr(3:3) ", (ftnlen)400, (ftnlen)253); - s_copy(french + 8800, "An error occurred while attempting to open ze" - "e log file. It will not be possible to keep a log of this se" - "ssion. No further attempts to log commands will be attempted" - ". /cr/cr Zee cause of zee failure to open zee log file was d" - "iagnosed to be: /cr/cr(3:3) ", (ftnlen)400, (ftnlen)253); - s_copy(german + 8800, "An error occurred while attempting to open th" - "e log file. It will not be possible to keep a log of this se" - "ssion. No further attempts to log commands will be attempted" - ". /cr/cr The cause of the failure to open the log file was d" - "iagnosed to be: /cr/cr(3:3) ", (ftnlen)400, (ftnlen)253); - s_copy(german + 8800, "An error occurred while attempting to open th" - "e log file. It will not be possible to keep a log of this se" - "ssion. No further attempts to log commands will be attempted" - ". /cr/cr The cause of the failure to open the log file was d" - "iagnosed to be: /cr/cr(3:3) ", (ftnlen)400, (ftnlen)253); - s_copy(title + 736, "NOMOREDIAGNOSTICS", (ftnlen)32, (ftnlen)17); - s_copy(englsh + 9200, "Sorry, no further diagnostics are available.", - (ftnlen)400, (ftnlen)44); - s_copy(french + 9200, "Mon ami, I am so sorry. I can say no more abo" - "ut zee error I reported earlier.", (ftnlen)400, (ftnlen)77); - s_copy(german + 9200, "No further diagnostics are available.", ( - ftnlen)400, (ftnlen)37); - s_copy(russan + 9200, "Sorry, no further diagnostics are available.", - (ftnlen)400, (ftnlen)44); - s_copy(title + 768, "DONT", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 9600, "NO", (ftnlen)400, (ftnlen)2); - s_copy(french + 9600, "NO", (ftnlen)400, (ftnlen)2); - s_copy(german + 9600, "NEIN", (ftnlen)400, (ftnlen)4); - s_copy(russan + 9600, "NYET", (ftnlen)400, (ftnlen)4); - s_copy(title + 800, "ECHO", (ftnlen)32, (ftnlen)4); - s_copy(englsh + 10000, "ECHO", (ftnlen)400, (ftnlen)4); - s_copy(french + 10000, "ECHO", (ftnlen)400, (ftnlen)4); - s_copy(german + 10000, "ECHO", (ftnlen)400, (ftnlen)4); - s_copy(russan + 10000, "ECHO", (ftnlen)400, (ftnlen)4); - s_copy(title + 832, "ERRFILWRITTENTO", (ftnlen)32, (ftnlen)15); - s_copy(englsh + 10400, "The error file has been written to: ", ( - ftnlen)400, (ftnlen)36); - s_copy(french + 10400, "The error file has been written to: ", ( - ftnlen)400, (ftnlen)36); - s_copy(german + 10400, "The error file has been written to: ", ( - ftnlen)400, (ftnlen)36); - s_copy(russan + 10400, "The error file has been written to: ", ( - ftnlen)400, (ftnlen)36); - s_copy(title + 864, "ERRFILWRITEFAIL", (ftnlen)32, (ftnlen)15); - s_copy(englsh + 10800, "WARNING--Unable to create the errorfile: ", ( - ftnlen)400, (ftnlen)41); - s_copy(french + 10800, "WARNING--Unable to create the errorfile: ", ( - ftnlen)400, (ftnlen)41); - s_copy(german + 10800, "WARNING--Unable to create the errorfile: ", ( - ftnlen)400, (ftnlen)41); - s_copy(russan + 10800, "WARNING--Unable to create the errorfile: ", ( - ftnlen)400, (ftnlen)41); - orderc_(title, &c__28, iorder, (ftnlen)32); - reordc_(iorder, &c__28, title, (ftnlen)32); - reordc_(iorder, &c__28, englsh, (ftnlen)400); - reordc_(iorder, &c__28, french, (ftnlen)400); - reordc_(iorder, &c__28, german, (ftnlen)400); - reordc_(iorder, &c__28, russan, (ftnlen)400); - } - item = bsrchc_(phrase, &c__28, title, phrase_len, (ftnlen)32); - -/* Look up the current language to be used. */ - - getlan_(lang, (ftnlen)32); - if (item == 0) { - s_copy(messge, phrase, messge_len, phrase_len); - } else if (s_cmp(lang, "FRENCH", (ftnlen)32, (ftnlen)6) == 0) { - s_copy(messge, french + ((i__1 = item - 1) < 28 && 0 <= i__1 ? i__1 : - s_rnge("french", i__1, "trnlat_", (ftnlen)426)) * 400, - messge_len, (ftnlen)400); - } else if (s_cmp(lang, "GERMAN", (ftnlen)32, (ftnlen)6) == 0) { - s_copy(messge, german + ((i__1 = item - 1) < 28 && 0 <= i__1 ? i__1 : - s_rnge("german", i__1, "trnlat_", (ftnlen)428)) * 400, - messge_len, (ftnlen)400); - } else if (s_cmp(lang, "RUSSIAN", (ftnlen)32, (ftnlen)7) == 0) { - s_copy(messge, russan + ((i__1 = item - 1) < 28 && 0 <= i__1 ? i__1 : - s_rnge("russan", i__1, "trnlat_", (ftnlen)430)) * 400, - messge_len, (ftnlen)400); - } else { - s_copy(messge, englsh + ((i__1 = item - 1) < 28 && 0 <= i__1 ? i__1 : - s_rnge("englsh", i__1, "trnlat_", (ftnlen)432)) * 400, - messge_len, (ftnlen)400); - } - return 0; -} /* trnlat_ */ - diff --git a/ext/spice/src/csupport/txtops.c b/ext/spice/src/csupport/txtops.c deleted file mode 100644 index 873c3f484e..0000000000 --- a/ext/spice/src/csupport/txtops.c +++ /dev/null @@ -1,274 +0,0 @@ -/* txtops.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure TXTOPS ( Text file, open scratch ) */ -/* Subroutine */ int txtops_(integer *unit) -{ - /* System generated locals */ - olist o__1; - - /* Builtin functions */ - integer f_open(olist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), getlun_(integer *), setmsg_( - char *, ftnlen); - integer iostat; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen); - extern logical return_(void); - -/* $ Abstract */ - -/* Open a scratch text file for subsequent write access. */ - -/* $ 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 */ - -/* FILES */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* UNIT O Logical unit. */ - -/* $ Detailed_Input */ - -/* None. */ - -/* $ Detailed_Output */ - -/* UNIT is the logical unit connected to the opened */ -/* scratch file. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file cannot be opened, the error SPICE(FILEOPENFAILED) */ -/* is signalled. */ - -/* $ Files */ - -/* See UNIT above. */ - -/* $ Particulars */ - -/* In SPICELIB, a text file is formatted and sequential and may */ -/* contain only printable ASCII characters and blanks (ASCII 32-127). */ -/* When printing a text file, records are single spaced; the first */ -/* character will not be interpreted as a carriage control character. */ - -/* TXTOPS opens a scratch text file and makes use of the SPICELIB */ -/* mechanism for coordinating the use of logical units. */ - -/* System Dependencies */ -/* =================== */ - -/* The open statement will include the following keyword = value */ -/* pairs: */ - -/* UNIT = UNIT */ -/* FILE = FNAME */ -/* FORM = 'FORMATTED' */ -/* ACCESS = 'SEQUENTIAL' */ -/* STATUS = 'SCRATCH' */ -/* IOSTAT = IOSTAT */ - -/* In addition, the statement will include */ - -/* CARRIAGECONTROL = 'LIST' */ - -/* for the Vax and Macintosh. */ - -/* $ Examples */ - -/* The following example reads a line from an input file, */ -/* 'INPUT.TXT', and writes it to an output file, 'OUTPUT.TXT'. */ - -/* CALL TXTOPR ( 'INPUT.TXT', IN ) */ -/* CALL TXTOPS ( OUT ) */ - -/* READ ( IN, FMT='(A)' ) LINE */ -/* WRITE ( OUT, FMT='(A)' ) LINE */ - -/* CLOSE ( IN ) */ -/* CLOSE ( OUT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1. "Absoft FORTRAN 77 Language Reference Manual", page 7-12 for */ -/* the NeXT. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 1.10.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 1.9.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 1.8.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 1.7.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.6.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 1.5.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 1.4.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 1.3.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 1.2.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 1.1.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 1.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 1.0.3, 21-SEP-1999 (NJB) */ - -/* CSPICE and PC-LINUX environment lines were added. Some */ -/* typos were corrected. */ - -/* - SPICELIB Version 1.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - SPICELIB Version 1.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - SPICELIB Version 1.0.0, 20-FEB-1996 (WLT) */ - - -/* -& */ -/* $ Index_Entries */ - -/* text file open scratch */ - -/* -& */ -/* $ Revisions */ - -/* - SPICELIB Version 1.0.0, 20-FEB-1996 (WLT) */ - -/* This routine is basically a simple tweak of TXTOPN. */ -/* It replaces txtopn that Mike Spencer wrote because */ -/* the master file could not be located. */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("TXTOPS", (ftnlen)6); - } - getlun_(unit); - o__1.oerr = 1; - o__1.ounit = *unit; - o__1.ofnm = 0; - o__1.orl = 0; - o__1.osta = "SCRATCH"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = "FORMATTED"; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - setmsg_("Could not scratch file. IOSTAT was #. ", (ftnlen)38); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("TXTOPS", (ftnlen)6); - return 0; - } - chkout_("TXTOPS", (ftnlen)6); - return 0; -} /* txtops_ */ - diff --git a/ext/spice/src/csupport/unitp.c b/ext/spice/src/csupport/unitp.c deleted file mode 100644 index 8ee99b0007..0000000000 --- a/ext/spice/src/csupport/unitp.c +++ /dev/null @@ -1,394 +0,0 @@ -/* unitp.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__32 = 32; - -/* $Procedure UNITP ( Determine whether a string represents units) */ -logical unitp_(char *string, ftnlen string_len) -{ - /* Initialized data */ - - static logical first = TRUE_; - static integer nop = 6; - static char op[2*6] = " " "( " ") " "* " "**" "/ "; - - /* System generated locals */ - integer i__1, i__2, i__3, i__4; - logical ret_val; - - /* Builtin functions */ - integer s_rnge(char *, integer, char *, integer); - - /* Local variables */ - extern /* Subroutine */ int scan_(char *, char *, integer *, integer *, - integer *, integer *, integer *, integer *, integer *, integer *, - ftnlen, ftnlen); - integer nest; - static integer mult; - integer b, e, i__; - static integer blank; - integer ident[32], class__; - doublereal value; - static integer oplen[6]; - logical known; - integer start; - static integer opptr[20]; - extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen); - static integer lparen; - extern /* Subroutine */ int fnducv_(char *, logical *, integer *, - doublereal *, ftnlen), scanpr_(integer *, char *, integer *, - integer *, ftnlen); - static integer rparen; - integer lasttk, explev; - logical physcl, expgrp; - integer ntokns, beg[32], end[32]; - static integer div, exp__; - -/* $ Abstract */ - -/* Determine whether or not a string represents the units associated */ -/* with a physical quantity. */ - -/* $ 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 */ - -/* PARSING */ -/* UNITS */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* STRING I potentially, units describing a physical quantity */ - -/* The function returns .TRUE. if the string represents some physical */ -/* units. Otherwise it returns false. */ - -/* $ Detailed_Input */ - -/* STRING a string that potentially represents the units */ -/* associated with some physical quantity. For */ -/* example KM/SEC. A string represents a unit if */ -/* it consists of numbers and recognized */ -/* primitive units (of length, angle, mass, time or */ -/* charge) connected in a "sensible" way with */ -/* operations of multiplication, division and */ -/* exponentiation. */ - -/* $ Detailed_Output */ - -/* UNITP returns as TRUE if the string satisfies the following */ -/* rules. */ - -/* 1) All maximal substrings of STRING that do not contain */ -/* any of the character '(', ')', '*', '/' are */ -/* recognized as numbers or units of angle, length, */ -/* time, mass or charge. */ - -/* 2) The string is a properly formed multiplicative */ -/* expression. */ - -/* 3) At least one physical unit is present in the string. */ - -/* 4) No physical units appear in an exponent */ -/* subexpression. */ - -/* If these conditions are not met, the function returns */ -/* FALSE. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* Error free. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* This routine examines a string to determine whether or not */ -/* it represents the units attached to a physical quantity. */ - -/* Units are created by multiplicatively combining primitive units */ -/* of time, length, angle, charge and mass together with numeric */ -/* constants. */ - -/* $ Examples */ - -/* Below are some sample strings and the response of UNITP */ -/* when applied to these strings. */ - -/* String Value of UNITP */ -/* ---------------- -------------- */ -/* KM T */ -/* KM/SEC T */ -/* KM**3/SEC**2 T */ -/* (KM**(SEC**-2)) F ( a unit appears in the exponent ) */ -/* (KM)/SEC T */ -/* (KM/SEC F ( parentheses are unbalanced ) */ -/* (KM/+(7*DAYS) F ( /+ is not a legitimate operation ) */ -/* 12*7 F ( no physical units appear ) */ -/* 3*KG T */ -/* AU/(100*DAYS) T */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.0.0, 10-APR-1990 (WLT) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Parameters */ - - -/* Local variables */ - - -/* Here is the range of Character ASCII code */ -/* initial characters that --------- ---------- */ -/* will be used by the ' ' 32 */ -/* "known" marks. '(' 40 */ -/* ')' 41 */ -/* '*' 42 */ -/* '/' 47 */ - -/* So the required number of pointers is 47 - 32 + 5 = 20. */ - - -/* Saved variables */ - - -/* Initial values */ - - -/* On the first pass through this routine, set up the stuff */ -/* required for scanning the input string. */ - - if (first) { - first = FALSE_; - scanpr_(&nop, op, oplen, opptr, (ftnlen)2); - blank = bsrchc_(" ", &nop, op, (ftnlen)1, (ftnlen)2); - lparen = bsrchc_("(", &nop, op, (ftnlen)1, (ftnlen)2); - rparen = bsrchc_(")", &nop, op, (ftnlen)1, (ftnlen)2); - mult = bsrchc_("*", &nop, op, (ftnlen)1, (ftnlen)2); - exp__ = bsrchc_("**", &nop, op, (ftnlen)2, (ftnlen)2); - div = bsrchc_("/", &nop, op, (ftnlen)1, (ftnlen)2); - } - -/* To get started we will assume that the last token (before we */ -/* started looking at the string) was an introductory left */ -/* parenthesis. */ - - lasttk = lparen; - nest = 0; - physcl = FALSE_; - expgrp = FALSE_; - start = 1; - scan_(string, op, oplen, opptr, &c__32, &start, &ntokns, ident, beg, end, - string_len, (ftnlen)2); - while(ntokns > 0) { - i__1 = ntokns; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Look at the identity of the next token ... */ - - if (ident[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "unitp_", (ftnlen)282)] == 0) { - -/* A non-recognized item cannot follow a right parenthesis */ -/* or a non-recognized item. */ - - if (lasttk == rparen || lasttk == 0) { - ret_val = FALSE_; - return ret_val; - } - -/* So far, so good. Determine whether this object is */ -/* a recognized unit or number. */ - - b = beg[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge( - "beg", i__2, "unitp_", (ftnlen)298)]; - e = end[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge( - "end", i__2, "unitp_", (ftnlen)299)]; - fnducv_(string + (b - 1), &known, &class__, &value, e - (b - - 1)); - -/* If it wasn't recognized we don't have a unit. */ - - if (! known) { - ret_val = FALSE_; - return ret_val; - } - -/* We also need to make sure we don't have anything of */ -/* the form **UNIT or **( ... UNIT ... ) where UNIT is a */ -/* physical unit. */ - - if (class__ > 0) { - if (lasttk == exp__ || expgrp) { - ret_val = FALSE_; - return ret_val; - } - } - -/* Finally, we need to keep track of whether or not */ -/* we've seen a physical unit. */ - - physcl = physcl || class__ > 0; - } else if (ident[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "unitp_", (ftnlen)334)] == rparen) { - -/* A right parenthesis can only follow a right parenthesis, */ -/* a unit or a number. */ - - if (lasttk != 0 && lasttk != rparen) { - ret_val = FALSE_; - return ret_val; - } - --nest; - } else if (ident[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "unitp_", (ftnlen)350)] == exp__ || - ident[(i__3 = i__ - 1) < 32 && 0 <= i__3 ? i__3 : s_rnge( - "ident", i__3, "unitp_", (ftnlen)350)] == mult || ident[( - i__4 = i__ - 1) < 32 && 0 <= i__4 ? i__4 : s_rnge("ident", - i__4, "unitp_", (ftnlen)350)] == div) { - -/* An arithmetic operation can only follow a right */ -/* parenthesis, a unit or a number. */ - - if (lasttk != rparen && lasttk != 0) { - ret_val = FALSE_; - return ret_val; - } - } else if (ident[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "unitp_", (ftnlen)364)] == lparen) { - -/* A left parenthesis must be the first thing in the */ -/* string or follow one of the following: */ - -/* '(', '*', '**', '/' */ - -/* (Note by construction the last token prior to the */ -/* beginning of the string was '(' ). If this is _not_ */ -/* the case then this is not a unit. */ - - if (lasttk != lparen && lasttk != mult && lasttk != div && - lasttk != exp__) { - ret_val = FALSE_; - return ret_val; - } - -/* If the last token was exponentiation (and we were not */ -/* already in some exponentiation group), we can't have */ -/* anything but numbers until the nesting level returns */ -/* to the current level. */ - - if (lasttk == exp__ && ! expgrp) { - explev = nest; - expgrp = TRUE_; - } - -/* Increase the nesting level of the expression. */ - - ++nest; - } else if (ident[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : - s_rnge("ident", i__2, "unitp_", (ftnlen)405)] == blank) { - -/* Don't do anything. */ - - } - -/* Copy the identity of this token. */ - - lasttk = ident[(i__2 = i__ - 1) < 32 && 0 <= i__2 ? i__2 : s_rnge( - "ident", i__2, "unitp_", (ftnlen)416)]; - -/* Now for a few quick checks. If the nesting level ever drops */ -/* below zero, we don't have a unit. */ - - if (nest < 0) { - ret_val = FALSE_; - return ret_val; - } - -/* We need to see if its ok to relax the restriction on the */ -/* use of physical units. */ - - if (expgrp) { - expgrp = nest > explev; - } - } - -/* Just in case we didn't get everything the first time, */ -/* scan the string again. */ - - scan_(string, op, oplen, opptr, &c__32, &start, &ntokns, ident, beg, - end, string_len, (ftnlen)2); - } - -/* One last check. If we didn't get a physical unit somewhere in */ -/* the string or if the nesting did not return to zero, we don't */ -/* have a unit. */ - - if (nest == 0) { - ret_val = physcl; - } else { - ret_val = FALSE_; - } - return ret_val; -} /* unitp_ */ - diff --git a/ext/spice/src/csupport/upto.c b/ext/spice/src/csupport/upto.c deleted file mode 100644 index c955b4bb58..0000000000 --- a/ext/spice/src/csupport/upto.c +++ /dev/null @@ -1,211 +0,0 @@ -/* upto.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure UPTO ( Up to the next index of a substring ) */ -integer upto_(char *string, char *substr, integer *start, ftnlen string_len, - ftnlen substr_len) -{ - /* System generated locals */ - integer ret_val; - - /* Builtin functions */ - integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - integer b, i__, strlen; - -/* $ Abstract */ - -/* Return up to (but not including) the index of the next occurrence */ -/* of a substring within a string, after some initial offset. */ - -/* $ 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 */ - -/* CHARACTER, PARSING, SEARCH, STRING, TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I Input string. */ -/* SUBSTR I Target substring. */ -/* START I Begin searching here. */ - -/* $ Detailed_Input */ - -/* STRING is an arbitrary input string. */ - -/* SUBSTR is the target substring to be located. */ - -/* START is the location at which to begin searching. That is, */ -/* the search is confined to STRING(START: ). */ - -/* $ Detailed_Output */ - -/* The function returns one less than the next location of the */ -/* target substring within the string, or the length of the string */ -/* if the substring is not found. */ - -/* $ Exceptions */ - -/* 1) If START is greater than the length of the string, the */ -/* function returns zero. */ - -/* 2) If START is less than one it is treated as if were one. */ - -/* $ Particulars */ - -/* UPTO is used primarily for extracting substrings bounded by */ -/* a delimiter. Because the function returns the length of the */ -/* string when the target substring is not found, the reference */ - -/* NEXT = STRING ( START : UPTO ( STRING, SUBSTR, START ) ) */ - -/* is always legal. */ - -/* $ Examples */ - -/* The following code fragment extracts (and prints) substrings */ -/* bounded by slash (/) characters. */ - -/* BEGIN = 1 */ -/* END = BEGIN */ - -/* DO WHILE ( END .NE. 0 ) */ -/* END = UPTO ( STR, '/', BEGIN ) */ - -/* WRITE (6,*) 'Next token is ', STR(BEGIN:END) */ - -/* BEGIN = END + 2 */ -/* END DO */ - -/* Notice that the loop ends when BEGIN is greater than the length */ -/* of the string, causing the function to return zero. */ - -/* Notice also that the last token in the string is printed whether */ -/* or not the string ends with a slash. */ - -/* If STRING is */ - -/* 'first/second/third/fourth' */ - -/* the output from the fragment is */ - -/* Next token is first */ -/* Next token is second */ -/* Next token is third */ -/* Next token is fourth */ - -/* Contrast this with the following fragment, written using the */ -/* intrinsic function INDEX. */ - -/* BEGIN = 1 */ -/* END = BEGIN */ - -/* DO WHILE ( END .NE. 0 ) */ -/* I = INDEX ( STR(BEGIN: ), '/' ) */ - -/* IF ( I .GT. 0 ) THEN */ -/* END = BEGIN + I - 1 */ -/* ELSE */ -/* END = LEN ( STR ) */ -/* END IF */ - -/* WRITE (6,*) 'Next token is ', STR(BEGIN:END) */ - -/* BEGIN = END + 2 */ - -/* IF ( BEGIN .GT. LEN ( STR ) ) THEN */ -/* END = 0 */ -/* END IF */ -/* END DO */ -/* $ Files */ - -/* None. */ - -/* $ 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, 4-APR-1988, (IMU) (WLT) */ - -/* -& */ - -/* Local variables */ - - -/* Just like it says in the header. */ - - strlen = i_len(string, string_len); - b = max(1,*start); - if (b > strlen) { - ret_val = 0; - } else { - i__ = i_indx(string + (b - 1), substr, string_len - (b - 1), - substr_len); - if (i__ > 0) { - ret_val = b + i__ - 2; - } else { - ret_val = strlen; - } - } - return ret_val; -} /* upto_ */ - diff --git a/ext/spice/src/csupport/utrans_2.c b/ext/spice/src/csupport/utrans_2.c deleted file mode 100644 index db8168c6ba..0000000000 --- a/ext/spice/src/csupport/utrans_2.c +++ /dev/null @@ -1,356 +0,0 @@ -/* utrans_2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; -static doublereal c_b10 = 1.; - -/* $Procedure UTRANS_2 ( Translate Units To Default Units ) */ -/* Subroutine */ int utrans_2__(char *string, doublereal *places, ftnlen - string_len) -{ - /* System generated locals */ - integer i__1, i__2; - - /* Builtin functions */ - integer i_len(char *, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int convrt_2__(doublereal *, char *, char *, - doublereal *, ftnlen, ftnlen); - integer f, l; - doublereal x; - char dpnum[32]; - integer start; - char myerr[80]; - extern logical unitp_(char *, ftnlen); - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); - integer bu, eu; - logical erased; - char basics[127]; - logical measeq; - extern /* Subroutine */ int sigdgt_(char *, char *, ftnlen, ftnlen); - extern integer lastnb_(char *, ftnlen); - extern /* Subroutine */ int fndptk_(char *, char *, integer *, integer *, - integer *, ftnlen, ftnlen), nparsd_(char *, doublereal *, char *, - integer *, ftnlen, ftnlen), prefix_(char *, integer *, char *, - ftnlen, ftnlen); - extern integer frstnb_(char *, ftnlen); - extern /* Subroutine */ int dpstrf_(doublereal *, doublereal *, char *, - char *, ftnlen, ftnlen); - integer pointr; - extern /* Subroutine */ int transu_(char *, char *, ftnlen, ftnlen); - integer beg, end; - doublereal convert; - -/* $ Abstract */ - -/* This routine replaces quantities in STRING given in terms of UNITS */ -/* by the equivalent quantities given in terms of default units. */ - -/* $ 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. */ - -/* $ Keywords */ - -/* CHARACTERS, CONVERSION, PARSING */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* STRING I/O The input string before and after unit conversion. */ -/* PLACES I the number of significant figures in output values */ - -/* $ Detailed_Input */ - -/* STRING The input string before unit conversion. */ - - -/* PLACES is the number of significant figures that will be */ -/* used for the converted quantities. The largest number */ -/* that will be output is 14. The number of characters */ -/* actually used in the output number will be PLACES + 6 */ -/* for negative numbers, PLACES + 5 for positive numbers. */ - -/* $ Detailed_Output */ - -/* STRING the input string after unit conversion. */ - -/* $ Detailed_Description */ - -/* This routine is supposed to help translate character strings */ -/* containing measurements in various units such as: */ - -/* 32.212 253.267 7628.7827 MILES 37683219.736 FEET */ - -/* to character stings giving these measurements in terms of some */ -/* set of processing units. For example in the case of the above */ -/* string, KM might be desirable: */ - -/* 5.184E+01 4.075937E+02 1.22773E+04 1.148584E+04 */ - -/* This example is intentded to be typical, the units are left out */ -/* intentionally. After all, this representation is intended to */ -/* be used only for internal processing by the application using */ -/* this routine. After passing through this routine there should be */ -/* no question as to what units are associated with each of the */ -/* numeric strings. */ - -/* To rigourously describe the function of this routine we need to */ -/* define a few terms. */ - -/* A word within a string is a substring consisting entirely of */ -/* nonblank characters delimited by the ends of the string or */ -/* "white space" . */ - -/* A numeric word is a word that can be successfully parsed */ -/* by the NAIF routine NPARSD (all standard FORTRAN string */ -/* representations of numbers are numeric words). */ - -/* A "measurement sequence" of words is a sequence of words in */ -/* the string that satisfies: */ - -/* 1. the first word preceeding the sequence is a */ -/* non-numeric word. */ - -/* 2. the last word in the sequence is non-numeric */ -/* and belongs to the collection of words given by */ -/* the array UNITS. (UNITS would usually contain */ -/* something like 'DEGREES', 'RADIANS', 'ARCSECONDS'.) */ - -/* 3. All other words in the sequence are numeric and there */ -/* is at least 1 numeric word. */ - - -/* The default sequence associated with each measurement */ -/* sequence is the sequence of numeric words obtained by */ -/* replacing each of the numeric words of the measurement */ -/* sequence by the product of that word and the value of */ -/* CONVERT associated with the unit of the measurement */ -/* sequence. The units of the measurement sequence are not */ -/* part of the associated default sequence. */ - -/* Now that all of the terms have been described, the action of */ -/* this routine can be easily explained. Given the input string */ -/* each measurement sequence is replaced by its associated */ -/* default sequence. The numeric words in the associated default */ -/* sequences will be written in scientific notation with PLACES */ -/* significant digits. The total number of characters needed for */ -/* each of the associated default sequence words is 6+PLACES */ - -/* $ Examples */ - -/* Suppose that the input string is: */ - -/* "LATITUDE: 32.2897 DEGREES LONGITUDE: 45.28761 DEGREES */ -/* ALTITUDE: 100 FEET" */ - -/* and that the arrays UNITS and CONVERT are given by: */ - -/* UNITS CONVERT */ -/* -------- -------- */ -/* DEGREES 0.01745329 (conversion from degrees to radians) */ -/* MINUTES 0.00029088 (conversion from minutes to radians) */ -/* SECONDS 4.8481E-06 (conversion from seconds to radians) */ -/* FEET 0.30480061 (conversion from feet to meteres) */ - -/* then the output string will be: */ - -/* "LATITUDE: 5.6356E-01 LONGITUDE: 7.38058E-01 */ -/* ALTITUDE: 3.048E+01" */ - - -/* $ Restrictions */ - -/* The user should be sure that adequate space is available in */ -/* STRING to contain the translated string. */ - -/* Also it is possible (even likely) that non-numeric words of */ -/* the STRING will be shifted from their original positions. */ -/* However, the order of the non-unit words will remain the same. */ - -/* $ Input_Files */ - -/* None. */ - -/* $ Output_Files */ - -/* None. */ - -/* $ Common_Variables */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W. L. Taber (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version_and_Date */ - -/* Version 1, 26-JUN-1987 */ - -/* -& */ - -/* NAIFLIB functions */ - - -/* Local variables */ - - -/* First thing, we left justify the command. */ - - ljust_(string, string, string_len, string_len); - measeq = FALSE_; - erased = FALSE_; - -/* Find the last word of the string. */ - - start = i_len(string, string_len) + 1; - fndptk_(string, " ", &start, &beg, &end, string_len, (ftnlen)1); - while(beg > 0) { - -/* If we are in a measurement sequence, then we need to see if */ -/* the current word is a number. */ - - if (measeq) { - s_copy(myerr, " ", (ftnlen)80, (ftnlen)1); - nparsd_(string + (beg - 1), &x, myerr, &pointr, end - (beg - 1), ( - ftnlen)80); - -/* If no error occurred in the attempt to parse this number */ -/* the measurement sequence continues. */ - - if (s_cmp(myerr, " ", (ftnlen)80, (ftnlen)1) == 0) { - -/* If we haven't already erased the current unit, do so */ -/* now and record our action. */ - - if (! erased) { - s_copy(string + (bu - 1), " ", eu - (bu - 1), (ftnlen)1); - erased = TRUE_; - } - s_copy(string + (beg - 1), " ", end - (beg - 1), (ftnlen)1); - x *= convert; - dpstrf_(&x, places, "E", dpnum, (ftnlen)1, (ftnlen)32); - sigdgt_(dpnum, dpnum, (ftnlen)32, (ftnlen)32); - prefix_(dpnum, &c__1, string + (beg - 1), (ftnlen)32, - string_len - (beg - 1)); - -/* If an error DID occur while attempting to parse the */ -/* current word, we are ending the current measurment */ -/* sequence. However, we might be beginning another ... */ - - } else { - -/* ... search the list of recognized units for this word */ - - - if (unitp_(string + (beg - 1), end - (beg - 1))) { -/* WRITE (*,*) STRING(BEG:END) */ - s_copy(basics, " ", (ftnlen)127, (ftnlen)1); - transu_(string + (beg - 1), basics, end - (beg - 1), ( - ftnlen)127); -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(basics, (ftnlen)127); - f = max(i__1,i__2); -/* Computing MAX */ - i__1 = 1, i__2 = lastnb_(basics, (ftnlen)127); - l = max(i__1,i__2); -/* WRITE (*,*) BASICS(F:L) */ - convrt_2__(&c_b10, string + (beg - 1), basics + (f - 1), & - convert, end - (beg - 1), l - (f - 1)); - measeq = TRUE_; - } else { - measeq = FALSE_; - } - -/* ... if this word is on the list, record its place in the */ -/* string. */ - - if (measeq) { - bu = beg; - eu = end; - -/* We haven't erased this unit from the string yet. */ -/* Record this observation. */ - - erased = FALSE_; - } - } - } else { - -/* We were not in a measurment sequence, but we might be */ -/* starting one. Search the list of known units for the */ -/* current word. */ - - if (unitp_(string + (beg - 1), end - (beg - 1))) { -/* WRITE (*,*) STRING(BEG:END) */ - s_copy(basics, " ", (ftnlen)127, (ftnlen)1); - transu_(string + (beg - 1), basics, end - (beg - 1), (ftnlen) - 127); -/* Computing MAX */ - i__1 = 1, i__2 = frstnb_(basics, (ftnlen)127); - f = max(i__1,i__2); -/* Computing MAX */ - i__1 = 1, i__2 = lastnb_(basics, (ftnlen)127); - l = max(i__1,i__2); -/* WRITE (*,*) BASICS(F:L) */ - convrt_2__(&c_b10, string + (beg - 1), basics + (f - 1), & - convert, end - (beg - 1), l - (f - 1)); - measeq = TRUE_; - } else { - measeq = FALSE_; - } - if (measeq) { - bu = beg; - eu = end; - -/* We certainly haven't erased this unit yet. */ - - erased = FALSE_; - } - } - -/* Find the word previous to the current one. */ - - start = beg; - fndptk_(string, " ", &start, &beg, &end, string_len, (ftnlen)1); - } - return 0; -} /* utrans_2__ */ - diff --git a/ext/spice/src/csupport/zzalloc.h b/ext/spice/src/csupport/zzalloc.h deleted file mode 100644 index 572268c8eb..0000000000 --- a/ext/spice/src/csupport/zzalloc.h +++ /dev/null @@ -1,125 +0,0 @@ -/* - --Abstract - - The memory allocation prototypes and macros for use in CSPICE. - --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. - --Particulars - - The routines maintain a count of the number of mallocs vs. free, - signalling an error if any unreleased memory exists at the end - of an Icy interface call. - - The macro ALLOC_CHECK performs malloc/free test. If used, the macro - should exists at the end of any routine using these memory management - routines. - - Prototypes in this file: - - alloc_count - zzalloc_count - alloc_SpiceMemory - alloc_SpiceString_C_array - alloc_SpiceString_C_Copy_array - alloc_SpiceDouble_C_array - alloc_SpiceInt_C_array - alloc_SpiceString - alloc_SpiceString_Pointer_array - free_SpiceString_C_array - free_SpiceMemory - --Version - - CSPICE 1.0.3 02-MAY-2008 (EDW) - - Added alloc_count prototype. - - CSPICE 1.0.2 10-MAY-2007 (EDW) - - Minor edits to clarify 'size' in alloc_SpiceMemory as - size_t. - - CSPICE 1.0.1 23-JUN-2005 (EDW) - - Add prototype for alloc_SpiceString_Pointer_array, allocate - an array of pointers to SpiceChar. - - Icy 1.0.0 December 19, 2003 (EDW) - - Initial release. - -*/ - -#ifndef ZZALLOC_H -#define ZZALLOC_H - - /* - Allocation call prototypes: - */ - int alloc_count (); - - SpiceChar ** alloc_SpiceString_C_array ( int string_length, - int string_count ); - - SpiceChar ** alloc_SpiceString_C_Copy_array ( int array_len , - int string_len, - SpiceChar ** array ); - - SpiceDouble * alloc_SpiceDouble_C_array ( int rows, - int cols ); - - SpiceInt * alloc_SpiceInt_C_array ( int rows, - int cols ); - - SpiceChar * alloc_SpiceString ( int length ); - - SpiceChar ** alloc_SpiceString_Pointer_array( int array_len ); - - void free_SpiceString_C_array ( int dim, - SpiceChar ** array ); - - void * alloc_SpiceMemory ( size_t size ); - - void free_SpiceMemory ( void * ptr ); - - - /* - Simple macro to ensure a zero value alloc count at end of routine. - Note, the need to use this macro exists only in those routines - allocating/deallocating memory. - */ -#define ALLOC_CHECK if ( alloc_count() != 0 ) \ - { \ - setmsg_c ( "Malloc/Free count not zero at end of routine." \ - " Malloc count = #."); \ - errint_c ( "#", alloc_count() ); \ - sigerr_c ( "SPICE(MALLOCCOUNT)" ); \ - } - -#endif - diff --git a/ext/spice/src/csupport/zzckcvr2.c b/ext/spice/src/csupport/zzckcvr2.c deleted file mode 100644 index cddd8a5318..0000000000 --- a/ext/spice/src/csupport/zzckcvr2.c +++ /dev/null @@ -1,219 +0,0 @@ -/* zzckcvr2.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCVR2 ( Private --- C-kernel segment coverage, type 02 ) */ -/* Subroutine */ int zzckcvr2_(integer *handle, integer *arrbeg, integer * - arrend, doublereal *schedl) -{ - /* System generated locals */ - integer i__1, i__2, i__3; - doublereal d__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer); - - /* Local variables */ - integer nrec; - doublereal last[100]; - integer i__, begat, endat; - extern /* Subroutine */ int chkin_(char *, ftnlen); - doublereal first[100]; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *), chkout_(char *, ftnlen), wninsd_(doublereal *, - doublereal *, doublereal *); - integer arrsiz; - extern logical return_(void); - integer get, got; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 02 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 02 segment */ - -/* ARREND is the ending address of a type 02 segment. */ - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 02 C-kernel segment. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SUPPORT Version 2.1.0, 13-FEB-2003 (BVS) */ - -/* Replaced MAX with MIN in the assignment of GET. This bug */ -/* caused the routine either to look beyond the end of the */ -/* start/stop time blocks of the segment (for NREC < BSIZE) or to */ -/* attempt to fill in internal buffers with more data than they */ -/* were declared to hold (for NREC > BSIZE.) */ - -/* - SUPPORT Version 2.0.0, 27-AUG-2002 (FST) */ - -/* Updated this routine to use DAFGDA instead of DAFRDA. */ -/* This allows the module to process non-native kernels. */ - -/* Header and code clean up for delivery to SUPPORT. */ - -/* - SUPPORT Version 1.0.0, 14-Feb-2000 (WLT) */ - -/* Happy Valentine's Day. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Parameters */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCVR2", (ftnlen)8); - } - -/* Determine the size of the array and the number of records */ -/* in it. */ - - arrsiz = *arrend - *arrbeg + 1; - d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.; - nrec = i_dnnt(&d__1); - -/* The variable GOT tells us how many time endpoints we've */ -/* gotten so far. */ - - got = 0; - while(got < nrec) { -/* Computing MIN */ - i__1 = 100, i__2 = nrec - got; - get = min(i__1,i__2); - begat = *arrbeg + (nrec << 3) + got; - endat = *arrbeg + (nrec << 3) + nrec + got; - -/* Retrieve the list next list of windows. */ - - i__1 = begat + get - 1; - dafgda_(handle, &begat, &i__1, first); - i__1 = endat + get - 1; - dafgda_(handle, &endat, &i__1, last); - -/* Insert the coverage intervals into the schedule. */ - - i__1 = get; - for (i__ = 1; i__ <= i__1; ++i__) { - wninsd_(&first[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : - s_rnge("first", i__2, "zzckcvr2_", (ftnlen)214)], &last[( - i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge("last", - i__3, "zzckcvr2_", (ftnlen)214)], schedl); - } - got += get; - } - chkout_("ZZCKCVR2", (ftnlen)8); - return 0; -} /* zzckcvr2_ */ - diff --git a/ext/spice/src/csupport/zzckcvr3.c b/ext/spice/src/csupport/zzckcvr3.c deleted file mode 100644 index 73c8e16bb1..0000000000 --- a/ext/spice/src/csupport/zzckcvr3.c +++ /dev/null @@ -1,325 +0,0 @@ -/* zzckcvr3.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCVR3 ( Private --- C-kernel segment coverage, type 03 ) */ -/* Subroutine */ int zzckcvr3_(integer *handle, integer *arrbeg, integer * - arrend, doublereal *schedl) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer nrec; - doublereal tick; - integer ndir; - doublereal begin; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer intat, avsln, invls, rsize; - doublereal start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - integer intbeg; - doublereal buffer[2]; - integer seglen, tickat; - doublereal finish; - extern /* Subroutine */ int errhan_(char *, integer *, ftnlen), sigerr_( - char *, ftnlen), chkout_(char *, ftnlen); - integer navsln; - extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, - integer *, ftnlen), wninsd_(doublereal *, doublereal *, - doublereal *); - integer lsttik, lstint; - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 03 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 03 segment */ - -/* ARREND is the ending address of a type 03 segment. */ - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(BADCK3SEGMENT) is signaled if the derived */ -/* segment length from ARRBEG and ARREND does not match */ -/* the possible lengths computed from the segment metadata. */ - -/* 2) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 03 C-kernel segment. */ - -/* $ Examples */ - -/* See CKBRIEF's main driver. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 27-AUG-2002 (FST) */ - -/* Updated this routine to use DAFGDA instead of DAFRDA. */ -/* This allows the module to process non-native kernels. */ - -/* - SPICELIB Version 1.0.0, 14-Feb-2000 (WLT) */ - -/* Happy Valentine's Day. */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCVR3", (ftnlen)8); - } - -/* Get the number of intervals and pointing instances ( records ) */ -/* in this segment, and from that determine the number of respective */ -/* directory epochs. */ - - i__1 = *arrend - 1; - dafgda_(handle, &i__1, arrend, buffer); - invls = i_dnnt(buffer); - nrec = i_dnnt(&buffer[1]); - ndir = (nrec - 1) / 100; - -/* Determine the size of the pointing packets. This is dependent */ -/* on whether angular rate data is present in the segment or not. */ -/* We can determine this with the following computation: */ - -/* Assume a record size of 4, i.e. no angular rate data. */ - - navsln = nrec * 5 + ndir + invls + (invls - 1) / 100 + 2; - -/* Assume a record size of 7, i.e. angular rate data. */ - - avsln = (nrec << 3) + ndir + invls + (invls - 1) / 100 + 2; - -/* Compute the actual length of the segment. */ - - seglen = *arrend - *arrbeg + 1; - if (seglen == navsln) { - rsize = 4; - } else if (seglen == avsln) { - rsize = 7; - } else { - setmsg_("The requested segment in file # reports a length of # d.p. " - "numbers, but the metadata in the segment indicates the lengt" - "h must either be # (no angular rate data) or # (angular rate" - " data). Perhaps the segment is not type 3?", (ftnlen)221); - errhan_("#", handle, (ftnlen)1); - errint_("#", &seglen, (ftnlen)1); - errint_("#", &navsln, (ftnlen)1); - errint_("#", &avsln, (ftnlen)1); - sigerr_("SPICE(BADCK3SEGMENT)", (ftnlen)20); - chkout_("ZZCKCVR3", (ftnlen)8); - return 0; - } - -/* Recall that the segment is layed out as: */ - -/* +------------------------------+ */ -/* | | */ -/* | Pointing | */ -/* | | */ -/* +------------------------------+ */ -/* | | */ -/* | SCLK times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | SCLK directory | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Interval start times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Start times directory | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Number of intervals | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Number of pointing | */ -/* | instances | */ -/* | | */ -/* +------------------------+ */ - - tickat = *arrbeg + rsize * nrec; - lsttik = tickat + nrec - 1; - intbeg = *arrbeg + rsize * nrec + nrec + ndir; - intat = intbeg; - lstint = intbeg + invls - 1; - dafgda_(handle, &intat, &intat, &start); - dafgda_(handle, &tickat, &tickat, &tick); - while(tick < start && tickat < lsttik) { - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* If we did not find a TICK at least as big as START, we can */ -/* just return now. */ - - if (tick < start) { - chkout_("ZZCKCVR3", (ftnlen)8); - return 0; - } - while(intat <= lstint && tickat <= lsttik) { - -/* At this point, we have an interval that begins at START */ -/* and ends at FINISH (unless of course we never found a "good" */ -/* TICK to start with.) */ - - begin = start; - -/* If the the start of the interval was the start of the LAST */ -/* interval available, we can short cut the remainder of the */ -/* reads. */ - - if (intat == lstint) { - dafgda_(handle, &lsttik, &lsttik, &finish); - wninsd_(&start, &finish, schedl); - chkout_("ZZCKCVR3", (ftnlen)8); - return 0; - } - -/* This is the expected case. Get the start of the next */ -/* interval. */ - - ++intat; - dafgda_(handle, &intat, &intat, &start); - -/* Read forward from the last tick until we reach the */ -/* START of the next interval or until we run out of TICKS. */ - - while(tick < start && tickat < lsttik) { - finish = tick; - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* A structurally correct CK-3 segment should never allow */ -/* the next test to pass, but it's just easier to check than */ -/* police the writers of C-kernels. The only way to get into */ -/* the block below is if TICKAT .EQ. LSTTIK */ - - if (tick < start) { - finish = tick; - ++tickat; - } - -/* Insert the interval into the window. */ - - wninsd_(&begin, &finish, schedl); - } - chkout_("ZZCKCVR3", (ftnlen)8); - return 0; -} /* zzckcvr3_ */ - diff --git a/ext/spice/src/csupport/zzckcvr4.c b/ext/spice/src/csupport/zzckcvr4.c deleted file mode 100644 index d791d974a5..0000000000 --- a/ext/spice/src/csupport/zzckcvr4.c +++ /dev/null @@ -1,349 +0,0 @@ -/* zzckcvr4.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__2 = 2; -static integer c__6 = 6; - -/* $Procedure ZZCKCVR4 ( Private --- C-kernel segment coverage, type 04 ) */ -/* Subroutine */ int zzckcvr4_(integer *handle, integer *arrbeg, integer * - arrend, doublereal *schedl) -{ - /* System generated locals */ - integer i__1; - - /* Local variables */ - integer nrec, ends[2]; - doublereal left; - integer i__; - extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, - integer *, doublereal *, integer *, doublereal *); - doublereal descr[5]; - extern /* Subroutine */ int cknr04_(integer *, doublereal *, integer *); - doublereal right, dc[2]; - integer ic[6]; - extern /* Subroutine */ int chkout_(char *, ftnlen), sgfpkt_(integer *, - doublereal *, integer *, integer *, doublereal *, integer *); - doublereal values[143]; - extern integer intmax_(void); - extern /* Subroutine */ int wninsd_(doublereal *, doublereal *, - doublereal *); - extern logical return_(void); - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 04 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declarations of the CK data type specific and general CK low */ -/* level routine parameters. */ - -/* $ 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 */ - -/* CK.REQ */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* 1) If new CK types are added, the size of the record passed */ -/* between CKRxx and CKExx must be registered as separate */ -/* parameter. If this size will be greater than current value */ -/* of the CKMRSZ parameter (which specifies the maximum record */ -/* size for the record buffer used inside CKPFS) then it should */ -/* be assigned to CKMRSZ as a new value. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ -/* B.V. Semenov (JPL) */ - -/* $ Literature_References */ - -/* CK Required Reading. */ - -/* $ Version */ - -/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */ - -/* Updated to support CK type 5. */ - -/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */ - -/* -& */ - -/* Number of quaternion components and number of quaternion and */ -/* angular rate components together. */ - - -/* CK Type 1 parameters: */ - -/* CK1DTP CK data type 1 ID; */ - -/* CK1RSZ maximum size of a record passed between CKR01 */ -/* and CKE01. */ - - -/* CK Type 2 parameters: */ - -/* CK2DTP CK data type 2 ID; */ - -/* CK2RSZ maximum size of a record passed between CKR02 */ -/* and CKE02. */ - - -/* CK Type 3 parameters: */ - -/* CK3DTP CK data type 3 ID; */ - -/* CK3RSZ maximum size of a record passed between CKR03 */ -/* and CKE03. */ - - -/* CK Type 4 parameters: */ - -/* CK4DTP CK data type 4 ID; */ - -/* CK4PCD parameter defining integer to DP packing schema that */ -/* is applied when seven number integer array containing */ -/* polynomial degrees for quaternion and angular rate */ -/* components packed into a single DP number stored in */ -/* actual CK records in a file; the value of must not be */ -/* changed or compatibility with existing type 4 CK files */ -/* will be lost. */ - -/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */ -/* records; the value of this parameter must never exceed */ -/* value of the CK4PCD; */ - -/* CK4SFT number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 4 */ -/* CK record that passed between routines CKR04 and CKE04; */ - -/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */ -/* and CKE04; CK4RSZ is computed as follows: */ - -/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */ - - -/* CK Type 5 parameters: */ - - -/* CK5DTP CK data type 5 ID; */ - -/* CK5MXD maximum polynomial degree allowed in type 5 */ -/* records. */ - -/* CK5MET number of additional DPs, which are not polynomial */ -/* coefficients, located at the beginning of a type 5 */ -/* CK record that passed between routines CKR05 and CKE05; */ - -/* CK5MXP maximum packet size for any subtype. Subtype 2 */ -/* has the greatest packet size, since these packets */ -/* contain a quaternion, its derivative, an angular */ -/* velocity vector, and its derivative. See ck05.inc */ -/* for a description of the subtypes. */ - -/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */ -/* and CKE05; CK5RSZ is computed as follows: */ - -/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */ - - - -/* Maximum record size that can be handled by CKPFS. This value */ -/* must be set to the maximum of all CKxRSZ parameters (currently */ -/* CK4RSZ.) */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCHEDL I/O An initialized window/schedule of interval */ -/* CK4RSZ P C-kernel Type 04 Maximum Record Size */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 04 segment */ - -/* ARREND is the ending address of a type 04 segment. */ - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* CK4RSZ is the maximum length of a CK4 record (with angular */ -/* velocity). Defined in the include file 'ckparam.inc'. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* Routines in the call tree of this routine may signal errors */ -/* if in sufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 04 C-kernel segment. */ - -/* $ Examples */ - -/* See CKBRIEF's main driver. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 29-AUG-2002 (FST) */ - -/* -& */ - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } - chkin_("ZZCKCVR4", (ftnlen)8); - -/* Build a descriptor record that satisfies the requirements */ -/* of CKNR04 and SGFPKT. */ - -/* Note: This is a hack dependent on the implementation of */ -/* the generic segments routines. But for C-kernels it */ -/* should always work, as ND and NI aren't changing any */ -/* time soon. */ - - ic[0] = intmax_(); - ic[1] = intmax_(); - ic[2] = 4; - ic[3] = intmax_(); - ic[4] = *arrbeg; - ic[5] = *arrend; - dc[0] = 0.; - dc[1] = 0.; - dafps_(&c__2, &c__6, dc, ic, descr); - -/* Determine the number of records in the array. */ - - cknr04_(handle, descr, &nrec); - i__1 = nrec; - for (i__ = 1; i__ <= i__1; ++i__) { - -/* Extract each packet of pointing coefficients. */ - - sgfpkt_(handle, descr, &i__, &i__, values, ends); - -/* Compute the left and right end points of the interval */ -/* of coverage related to this packet. */ - - left = values[0] - values[1]; - right = values[0] + values[1]; - -/* Store the results in the schedule. */ - - wninsd_(&left, &right, schedl); - } - chkout_("ZZCKCVR4", (ftnlen)8); - return 0; -} /* zzckcvr4_ */ - diff --git a/ext/spice/src/csupport/zzckcvr5.c b/ext/spice/src/csupport/zzckcvr5.c deleted file mode 100644 index fedd90384c..0000000000 --- a/ext/spice/src/csupport/zzckcvr5.c +++ /dev/null @@ -1,403 +0,0 @@ -/* zzckcvr5.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZCKCVR5 ( Private --- C-kernel segment coverage, type 05 ) */ -/* Subroutine */ int zzckcvr5_(integer *handle, integer *arrbeg, integer * - arrend, doublereal *schedl) -{ - /* System generated locals */ - integer i__1; - - /* Builtin functions */ - integer i_dnnt(doublereal *); - - /* Local variables */ - integer nrec; - doublereal tick; - integer ndir; - doublereal begin; - extern /* Subroutine */ int chkin_(char *, ftnlen); - integer intat, invls, rsize; - doublereal start; - extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, - doublereal *); - integer intbeg; - doublereal buffer[4]; - integer tickat; - doublereal finish; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen), errint_(char *, doublereal *, - ftnlen), wninsd_(doublereal *, doublereal *, doublereal *); - integer lsttik, lstint; - extern logical return_(void); - integer subtyp; - -/* $ Abstract */ - -/* SPICE Private routine intended solely for the support of SPICE */ -/* routines. Users should not call this routine directly due */ -/* to the volatile nature of this routine. */ - -/* Determine the "window" of coverage of a type 05 C-kernel segment. */ - -/* $ 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 */ - -/* CK */ -/* DAF */ - -/* $ Keywords */ - -/* CK */ -/* UTILITY */ -/* PRIVATE */ - -/* $ Declarations */ -/* $ Abstract */ - -/* Declare parameters specific to CK type 05. */ - -/* $ 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 */ - -/* CK */ - -/* $ Keywords */ - -/* CK */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* N.J. Bachman (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ - -/* -& */ - -/* CK type 5 subtype codes: */ - - -/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ -/* and quaternion derivatives only, no angular velocity */ -/* vector provided. Quaternion elements are listed */ -/* first, followed by derivatives. Angular velocity is */ -/* derived from the quaternions and quaternion */ -/* derivatives. */ - - -/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ -/* only. Angular velocity is derived by differentiating */ -/* the interpolating polynomials. */ - - -/* Subtype 2: Hermite interpolation, 14-element packets. */ -/* Quaternion and angular angular velocity vector, as */ -/* well as derivatives of each, are provided. The */ -/* quaternion comes first, then quaternion derivatives, */ -/* then angular velocity and its derivatives. */ - - -/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ -/* and angular velocity vector provided. The quaternion */ -/* comes first. */ - - -/* Packet sizes associated with the various subtypes: */ - - -/* End of file ck05.inc. */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* HANDLE I Handle of a C-kernel open for read access */ -/* ARRBEG I Beginning DAF address */ -/* ARREND I Ending DAF address */ -/* SCHEDL I/O An initialized window/schedule of interval */ - -/* $ Detailed_Input */ - -/* HANDLE is the handle of some DAF that is open for reading. */ - -/* ARRBEG is the beginning address of a type 05 segment */ - -/* ARREND is the ending address of a type 05 segment. */ - -/* SCHEDL is a schedule (window) of intervals, to which the */ -/* intervals of coverage for this segment will be added. */ - -/* $ Detailed_Output */ - -/* SCHEDL the input schedule updated to include the intervals */ -/* of coverage for this segment. */ - -/* $ Parameters */ - -/* Several parameters associated with the type 05 C-kernel */ -/* are utilized to compute the packet size of each subtype. */ -/* See the include file 'ck05.inc' for details. */ - -/* $ Files */ - -/* This routine reads the contents of the file associated with */ -/* HANDLE to locate coverage intervals. */ - -/* $ Exceptions */ - -/* 1) The error SPICE(NOTSUPPORTED) is signaled if the subtype */ -/* of the CK type 05 segment is not recognized. */ - -/* 2) Routines in the call tree of this routine may signal errors */ -/* if insufficient room in SCHEDL exists or other error */ -/* conditions relating to file access arise. */ - -/* $ Particulars */ - -/* This is a utility routine that determines the intervals */ -/* of coverage for a type 05 C-kernel segment. */ - -/* $ Examples */ - -/* See CKBRIEF's main driver. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* W.L. Taber (JPL) */ -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - SPICELIB Version 1.0.0, 28-AUG-2002 (FST) */ - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZCKCVR5", (ftnlen)8); - } - -/* Get the meta-data associated with this segment that we */ -/* require to produce the schedule. */ - -/* BUFFER(1) = Subtype Code */ -/* BUFFER(2) = Window Size */ -/* BUFFER(3) = Number of Interpolation Intervals */ -/* BUFFER(4) = Number of Packets */ - - i__1 = *arrend - 3; - dafgda_(handle, &i__1, arrend, buffer); - subtyp = i_dnnt(buffer); - invls = i_dnnt(&buffer[2]); - nrec = i_dnnt(&buffer[3]); - ndir = (nrec - 1) / 100; - -/* Compute the packet size. This requires parameters listed */ -/* in the include file 'ck05.inc' and is based on the subtype. */ - - if (subtyp == 0) { - rsize = 8; - } else if (subtyp == 1) { - rsize = 4; - } else if (subtyp == 2) { - rsize = 14; - } else if (subtyp == 3) { - rsize = 7; - } else { - setmsg_("CK type 5 subtype <#> is not supported.", (ftnlen)39); - errint_("#", buffer, (ftnlen)1); - sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); - chkout_("ZZCKCVR5", (ftnlen)8); - return 0; - } - -/* Recall that the segment is layed out as: */ - - -/* +------------------------------+ */ -/* | | */ -/* | Pointing | */ -/* | | */ -/* +------------------------------+ */ -/* | | */ -/* | SCLK times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | SCLK directory | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Interval start times | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Start times directory | */ -/* | | */ -/* +------------------------+ */ -/* | Seconds per tick | */ -/* +------------------------+ */ -/* | Subtype code | */ -/* +------------------------+ */ -/* | Window size | */ -/* +------------------------+ */ -/* | | */ -/* | Number of intervals | */ -/* | | */ -/* +------------------------+ */ -/* | | */ -/* | Number of pointing | */ -/* | instances | */ -/* | | */ -/* +------------------------+ */ - - tickat = *arrbeg + rsize * nrec; - lsttik = tickat + nrec - 1; - intbeg = *arrbeg + rsize * nrec + nrec + ndir; - intat = intbeg; - lstint = intbeg + invls - 1; - dafgda_(handle, &intat, &intat, &start); - dafgda_(handle, &tickat, &tickat, &tick); - while(tick < start && tickat < lsttik) { - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* If we did not find a TICK at least as big as START, we can */ -/* just return now. */ - - if (tick < start) { - chkout_("ZZCKCVR5", (ftnlen)8); - return 0; - } - while(intat <= lstint && tickat <= lsttik) { - -/* At this point, we have an interval that begins at START */ -/* and ends at FINISH (unless of course we never found a "good" */ -/* TICK to start with.) */ - - begin = start; - -/* If the the start of the interval was the start of the LAST */ -/* interval available, we can short cut the remainder of the */ -/* reads. */ - - if (intat == lstint) { - dafgda_(handle, &lsttik, &lsttik, &finish); - wninsd_(&start, &finish, schedl); - chkout_("ZZCKCVR5", (ftnlen)8); - return 0; - } - -/* This is the expected case. Get the start of the next */ -/* interval. */ - - ++intat; - dafgda_(handle, &intat, &intat, &start); - -/* Read forward from the last tick until we reach the */ -/* START of the next interval or until we run out of TICKS. */ - - while(tick < start && tickat < lsttik) { - finish = tick; - ++tickat; - dafgda_(handle, &tickat, &tickat, &tick); - } - -/* A structurally correct CK-5 segment should never allow */ -/* the next test to pass, but it's just easier to check than */ -/* police the writers of C-kernels. The only way to get into */ -/* the block below is if TICKAT .EQ. LSTTIK */ - - if (tick < start) { - finish = tick; - ++tickat; - } - -/* Insert the interval into the window. */ - - wninsd_(&begin, &finish, schedl); - } - chkout_("ZZCKCVR5", (ftnlen)8); - return 0; -} /* zzckcvr5_ */ - diff --git a/ext/spice/src/csupport/zzerror.h b/ext/spice/src/csupport/zzerror.h deleted file mode 100644 index 5709c667d5..0000000000 --- a/ext/spice/src/csupport/zzerror.h +++ /dev/null @@ -1,80 +0,0 @@ -/* - --Abstract - - The error control routine prototypes for use in CSPICE. - --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. - --Particulars - - Routines prototyped in this file: - - zzerrorinit - zzerror - --Examples - - See the examples section in zzerror() and zzerrorinit(). - --Restrictions - - None. - --Exceptions - - None. - --Files - - None. - --Author_and_Institution - - E. D. Wright (JPL) - --Literature_References - - None. - --Version - - CSPICE 1.0.0 17-OCT-2005 (EDW) - - Initial release. - -*/ - -#ifndef ZZERROR_H -#define ZZERROR_H - - const char * zzerror( long cnt ); - void zzerrorinit(); - -#endif - - - diff --git a/ext/spice/src/csupport/zzgetenv.c b/ext/spice/src/csupport/zzgetenv.c deleted file mode 100644 index 2841f8b063..0000000000 --- a/ext/spice/src/csupport/zzgetenv.c +++ /dev/null @@ -1,332 +0,0 @@ -/* zzgetenv.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZGETENV ( Get environment variable value. ) */ -/* Subroutine */ int zzgetenv_(char *envvar, char *value, ftnlen envvar_len, - ftnlen value_len) -{ - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen); - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer i_len(char *, ftnlen); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen); - extern integer rtrim_(char *, ftnlen); - extern /* Subroutine */ int getenv_(char *, char *, ftnlen, ftnlen), - chkout_(char *, ftnlen); - char myvalu[255]; - extern logical return_(void); - -/* $ Abstract */ - -/* Get the value of a specified environment variable or VAX DCL */ -/* symbol, if it exists. */ - -/* $ 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 */ - -/* None. */ - -/* $ Declarations */ - -/* Length of an environment variable or DCL symbol name. */ - - -/* Length of an environment variable or DCL symbol value. */ - -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* ENVVAR I The name of the environment variable or symbol. */ -/* VALUE O The value of the environment variable or symbol. */ -/* ENVLEN P Maximum length of an environemt variable or symbol. */ -/* VALLEN P Maximum length of a value. */ - -/* $ Detailed_Input */ - -/* ENVVAR This is the name of the environment variable, or DCL */ -/* symbol, whose value is desired. The significant, i.e., */ -/* nonblank, portion of the environment variable, or DCL */ -/* symbol, name may be at most ENVLEN characters in length */ -/* and may not contain embedded blanks. */ - -/* A standard convention used for naming environment */ -/* variables is to use only the upper case characters */ -/* 'A' - 'Z', the digits '0' - '9', and the underscore */ -/* character '_', in the names. We do not enforce this */ -/* convention but we strongly recommend its use for */ -/* interface consistency across heterogeneous computing */ -/* environments. */ - -/* For a particular operating system and compiler the */ -/* maximum allowed length of an environment variable name */ -/* may be less than ENVLEN. Consult the appropriate */ -/* operating system and/or compiler manuals for details. */ - -/* $ Detailed_Output */ - -/* VALUE This is the value obtained for the environment variable */ -/* ENVVAR if it is defined. The result will be left */ -/* justified on output. */ - -/* If any of the following are true: */ - -/* 1) a value for the environment variable cannot be */ -/* obtained, */ - -/* 2) the significant portion of ENVVAR contains */ -/* embedded blanks, */ - -/* 3) the input ENVVAR is blank, */ - -/* 4) The input ENVVAR contains characters other than */ -/* the upper case characters 'A' - 'Z', the digits */ -/* '0' - '9', and the underscore '_', */ - -/* 5) The value for the environment variable is too long */ -/* to fit in the available space, */ - -/* then VALUE will be blank. */ - -/* $ Parameters */ - -/* ENVLEN The maximum allowed length of an environment variable */ -/* or DCL symbol name. */ - -/* VALLEN The maximum allowed length of an environment variable */ -/* or DCL symbol value. */ - -/* $ Exceptions */ - -/* None. */ - -/* 1) If a value for the environment variable cannot be obtained, */ -/* a blank string will be returned. */ - -/* 2) If the significant portion of ENVVAR contains embedded blanks, */ -/* a blank string will be returned. */ - -/* 3) If the input ENVVAR is blank, a blank string will be returned. */ - -/* 4) If the value for the environment variable is too long to fit */ -/* in the available space, a blank string will be returned. */ - -/* $ Files */ - -/* None. */ - -/* $ Particulars */ - -/* Call the subroutine 'GETENV( ENVVAR, VALUE )', provided for */ -/* UNIX compatibility. Given the name of an environment variable, */ -/* this subroutine storing in VALUE the value of the specified */ -/* environment variable or a blank string if an error occurs. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ - -/* $ Version */ - -/* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - SPICELIB Version 2.0.5, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - SPICELIB Version 2.0.3, 21-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - Beta Version 2.0.2, 28-JUL-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. New */ -/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ - -/* - Beta Version 2.0.1, 18-MAR-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitly given. Previously, */ -/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ -/* by the environment label SUN. */ - -/* - Beta Version 2.0.0, 05-APR-1998 (NJB) */ - -/* Added the PC-LINUX environment. */ - -/* - Beta Version 1.0.0, 31-MAY-1996 (KRG) */ - -/* -& */ -/* $ Index_Entries */ - -/* get environment variable value */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGETENV", (ftnlen)8); - } - -/* We do three things: */ - -/* 1) Check to see if the input is blank. */ -/* 2) Attempt to get the value. */ -/* 3) If we got a nonblank value, see if it will fit in the */ -/* space provided. */ - - if (s_cmp(envvar, " ", envvar_len, (ftnlen)1) == 0) { - s_copy(myvalu, " ", (ftnlen)255, (ftnlen)1); - } else { - getenv_(envvar, myvalu, envvar_len, (ftnlen)255); - if (s_cmp(myvalu, " ", (ftnlen)255, (ftnlen)1) != 0) { - if (rtrim_(myvalu, (ftnlen)255) > i_len(value, value_len)) { - s_copy(myvalu, " ", (ftnlen)255, (ftnlen)1); - } - } - } - s_copy(value, myvalu, value_len, (ftnlen)255); - chkout_("ZZGETENV", (ftnlen)8); - return 0; -} /* zzgetenv_ */ - diff --git a/ext/spice/src/csupport/zzgetfat.c b/ext/spice/src/csupport/zzgetfat.c deleted file mode 100644 index 2284c613ea..0000000000 --- a/ext/spice/src/csupport/zzgetfat.c +++ /dev/null @@ -1,752 +0,0 @@ -/* zzgetfat.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* Table of constant values */ - -static integer c__1 = 1; - -/* $Procedure ZZGETFAT ( Get file architecture, type, and unit ) */ -/* Subroutine */ int zzgetfat_(char *file, char *arch, char *type__, integer * - number, ftnlen file_len, ftnlen arch_len, ftnlen type_len) -{ - /* System generated locals */ - cilist ci__1; - olist o__1; - cllist cl__1; - inlist ioin__1; - - /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open( - olist *), s_rdue(cilist *), do_uio(integer *, char *, ftnlen), - e_rdue(void), f_clos(cllist *), s_rsfe(cilist *), do_fio(integer * - , char *, ftnlen), e_rsfe(void); - - /* Local variables */ - integer i__; - logical check; - extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, - ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen); - logical exist; - extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), - idw2at_(char *, char *, char *, ftnlen, ftnlen, ftnlen); - logical opened; - char idword[12]; - logical diropn; - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), getlun_(integer *); - integer iostat; - extern /* Subroutine */ int setmsg_(char *, ftnlen); - logical seqopn; - extern /* Subroutine */ int errint_(char *, integer *, ftnlen), nextwd_( - char *, char *, char *, ftnlen, ftnlen, ftnlen); - char tmpwrd[12]; - extern logical return_(void); - - /* Fortran I/O blocks */ - static cilist io___8 = { 1, 0, 1, 0, 1 }; - static cilist io___11 = { 1, 0, 1, 0, 1 }; - - -/* $ Abstract */ - -/* Determine the file architecture and file type of most SPICE kernel */ -/* files. */ - -/* NOTE: This routine is currently for use ONLY with the SPACIT */ -/* and TOBIN utility programs. Use it at your own risk. */ - -/* $ 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 */ - -/* KERNEL */ -/* UTILITY */ - -/* $ Declarations */ - -/* The record length should be big enough to hold 128 double */ -/* precision numbers. */ - -/* For some environments, record length is measured in longwords, */ -/* since our records are unformatted, with two longwords per double */ -/* precision number. The value of RECL is 256. */ - -/* Environment: VAX/VMS, VAX FORTRAN */ -/* Source: Programming in VAX Fortran */ - -/* Environment: Silicon Graphics IRIX OS, SGI FORTRAN 77 */ -/* Source: NAIF Program */ - -/* Environment: DEC Alpha 3000/4000, OSF/1, DEC FORTRAN-77 */ -/* Source: NAIF Program */ - -/* For the following environments, record length is measured in */ -/* characters (bytes) with eight characters per double precision */ -/* number. The value of RECL is 1024. */ - -/* Environment: Sun, Sun FORTRAN */ -/* Source: Sun Fortran Programmer's Guide */ - -/* Environment: PC, MS FORTRAN */ -/* Source: Microsoft Fortran Optimizing Compiler User's Guide */ - -/* Environment: Macintosh, Language Systems FORTRAN */ -/* Source: Language Systems FORTRAN Reference Manual, */ -/* Version 1.2, page 12-7 */ - -/* Environment: PC, Lahey F77 EM/32 Version 4.0 */ -/* Source: Lahey F77 EM/32 Language Reference Manual, */ -/* page 144 */ - -/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ -/* Source: FORTRAN/9000 Reference-Series 700 Computers, */ -/* page 5-110 */ - -/* Environment: NeXT/Mach OS, Absoft Fortran */ -/* Source: NAIF Program */ - -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* FILE I The name of a file to be examined. */ -/* ARCH O The architecture of the kernel file. */ -/* TYPE O The type of the kernel file. */ -/* NUMBER O The logical unit number for the open file FILE. */ - -/* $ Detailed_Input */ - -/* FILE is the name of a SPICE kernel file whose architecture */ -/* and type are desired. This file must be closed when */ -/* this routine is called. */ - -/* $ Detailed_Output */ - -/* ARCH is the file architecture of the SPICE kernel file */ -/* specified be FILE. If the architecture cannot be */ -/* determined or is not recognized the value '?' is */ -/* returned. */ - -/* Architectures currently recognized are: */ - -/* DAF - The file is based on the DAF architecture. */ -/* DAS - The file is based on the DAS architecture. */ -/* XFR - The file is in a SPICE transfer file format. */ -/* DEC - The file is an old SPICE decimal text file. */ -/* ASC -- An ASCII text file. */ -/* KPL -- Kernel Pool File (i.e., a text kernel) */ -/* TXT -- An ASCII text file. */ -/* TE1 -- Text E-Kernel type 1. */ -/* ? - The architecture could not be determined. */ - -/* This variable must be at least 3 characters long. */ - -/* TYPE is the type of the SPICE kernel file. If the type */ -/* can not be determined the value '?' is returned. */ - -/* Kernel file types may be any sequence of at most four */ -/* printing characters. NAIF has reserved for its use */ -/* types which contain all upper case letters. */ - -/* A file type of 'PRE' means that the file is a */ -/* pre-release file. */ - -/* This variable may be at most 4 characters long. */ - -/* NUMBER The logical unit number assigned to the file FILE */ -/* when opened. An inyteger, returned to the calling */ -/* routine. */ - -/* $ Parameters */ - -/* RECL is the record length of a binary kernel file. Each */ -/* record must be large enough to hold 128 double */ -/* precision numbers. The units in which the record */ -/* length must be specified vary from environment to */ -/* environment. For example, VAX Fortran requires */ -/* record lengths to be specified in longwords, */ -/* where two longwords equal one double precision */ -/* number. */ - -/* $ Exceptions */ - -/* 1) If the inquire on the filename specified by FILE fails for */ -/* some reason, the error SPICE(INQUIREERROR) will be signalled. */ - -/* 2) If the file specified by FILE is already open, the error */ -/* SPICE(FILECURRENTLYOPEN) will be signalled. */ - -/* 3) If the file specified by FILE does not exist, the error */ -/* SPICE(NOSUCHFILE) will be signalled. */ - -/* 4) If the attempt to open the file specified by FILE fails, the */ -/* error SPICE(FILEOPENFAILED) will be signalled. */ - -/* 5) If all attempts to open the file specified by FILE fail, the */ -/* error SPICE(FILEOPENFAILED) will be signalled. */ - -/* 6) If all attempts to read from the file specified be FILE */ -/* fail, the error SPICE(FILEREADFAILED) will be signalled. */ - -/* $ Files */ - -/* The SPICE kernel file specified by FILE is opened and then */ -/* closed by this routine to determine its file architecture and */ -/* type. Names of open files should not be passed to this routine. */ - -/* $ Particulars */ - -/* This subroutine is a support utility routine that determines the */ -/* architecture and type of a SPICE kernel file. */ - -/* $ Examples */ - -/* None. */ - -/* $ Restrictions */ - -/* This routine should only be called as part of spacit or tobin */ -/* by spat2b. */ - -/* The file to be examined must be closed when this routine is */ -/* invoked. */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Author_and_Institution */ - -/* K.R. Gehringer (JPL) */ -/* H.A. Neilan (JPL) */ -/* W.L. Taber (JPL) */ -/* E.D. Wright (JPL) */ - -/* $ Version */ - -/* - Beta Version 1.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - Beta Version 1.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - Beta Version 1.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - Beta Version 1.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - Beta Version 1.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - Beta Version 1.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - Beta Version 1.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - Beta Version 1.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - Beta Version 1.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - Beta Version 1.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - Beta Version 1.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - Beta Version 1.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - Beta Version 1.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - Beta Version 1.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - Beta Version 1.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - Beta Version 1.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - Beta Version 1.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - Beta Version 1.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - Beta Version 1.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - Beta Version 1.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - Beta Version 1.0.3, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - Beta Version 1.0.2, 08-OCT-1999 (WLT) */ - -/* The environment lines were expanded so that the supported */ -/* environments are now explicitely given. New */ -/* environments are WIN-NT */ - -/* - Beta Version 1.0.1, 21-SEP-1999 (NJB) */ - -/* CSPICE environments were added. Some typos were corrected. */ - -/* - Beta Version 1.0.0, 19-MAR-1999 (EDW) */ - -/* This routine is a modification of the GETFAT routine. */ -/* Both have the same basic functionality, but this routine */ -/* will ignore all data until a known NAIF file identifier */ -/* is found. The derivation of file type and architecture */ -/* proceeds as in GETFAT. Note: the file is not closed */ -/* on exit. */ - -/* The logic for the case architecture = DAF, type = unknown, '?', */ -/* has been removed. */ - -/* -& */ - -/* $ Index_Entries */ - -/* determine the architecture and type of a kernel file */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local parameters */ - - -/* The following parameters point to the various slots in the */ -/* integer portion of the DAF descriptor where the values are */ -/* located. */ - - -/* These parameters give the number of integer and double precision */ -/* components of the descriptor for SPK and CK files. */ - - -/* The size of a summary. */ - - -/* Set the length of a SPICE kernel file ID word. */ - - -/* Set minimum and maximum values for the range of ASCII printing */ -/* characters. */ - - -/* Local Variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZGETFAT", (ftnlen)8); - } - -/* Initialize the temporary storage variables that we use. */ - - s_copy(idword, " ", (ftnlen)12, (ftnlen)1); - seqopn = FALSE_; - check = TRUE_; - -/* If the filename we got is blank, signal an error and return. */ - - if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) { - setmsg_("The file name is blank.", (ftnlen)23); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - -/* We'll do a bit of inquiring before we try opening anything. */ - - ioin__1.inerr = 1; - ioin__1.infilen = file_len; - ioin__1.infile = file; - ioin__1.inex = ∃ - ioin__1.inopen = &opened; - ioin__1.innum = 0; - ioin__1.innamed = 0; - ioin__1.inname = 0; - ioin__1.inacc = 0; - ioin__1.inseq = 0; - ioin__1.indir = 0; - ioin__1.infmt = 0; - ioin__1.inform = 0; - ioin__1.inunf = 0; - ioin__1.inrecl = 0; - ioin__1.innrec = 0; - ioin__1.inblank = 0; - iostat = f_inqu(&ioin__1); - -/* Not too likely, but if the INQUIRE statement fails... */ - - if (iostat != 0) { - setmsg_("IOSTAT error in INQUIRE statement. IOSTAT = #.", (ftnlen)46); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(INQUIREERROR)", (ftnlen)19); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - -/* Note: the following two tests MUST be performed in the order in */ -/* which they appear, since in some environments files that do */ -/* not exist are considered to be open. */ - -/* By calling this routine, the user implies that the file exists. */ - - if (! exist) { - setmsg_("The kernel file '#' does not exist.", (ftnlen)35); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(NOSUCHFILE)", (ftnlen)17); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - -/* This routine should not be called if the file is already open. */ - - if (opened) { - setmsg_("The kernel file '#' is already open.", (ftnlen)36); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(FILECURRENTLYOPEN)", (ftnlen)24); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - -/* Open the file with a record length of RECL (the length of the */ -/* DAF and DAS records). We assume, for now, that opening the file as */ -/* a direct access file will work. */ - - diropn = TRUE_; - getlun_(number); - o__1.oerr = 1; - o__1.ounit = *number; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 1024; - o__1.osta = "OLD"; - o__1.oacc = "DIRECT"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we had trouble opening the file, try opening it as a sequential */ -/* file. */ - - if (iostat != 0) { - diropn = FALSE_; - o__1.oerr = 1; - o__1.ounit = *number; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we still have problems opening the file, we don't have a */ -/* clue about the file architecture and type. */ - - if (iostat != 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", ( - ftnlen)48); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - } - -/* We opened the file successfully, so let's try to read from the */ -/* file. We need to be sure to use the correct form of the read */ -/* statement, depending on whether the file was opened with direct */ -/* acces or sequential access. */ - - if (diropn) { - io___8.ciunit = *number; - iostat = s_rdue(&io___8); - if (iostat != 0) { - goto L100001; - } - iostat = do_uio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100001; - } - iostat = e_rdue(); -L100001: - -/* If we couldn't read from the file as a direct access file with */ -/* a fixed record length, then try to open the file as a */ -/* sequential file and read from it. */ - - if (iostat == 0) { - seqopn = TRUE_; - diropn = FALSE_; - cl__1.cerr = 0; - cl__1.cunit = *number; - cl__1.csta = 0; - f_clos(&cl__1); - o__1.oerr = 1; - o__1.ounit = *number; - o__1.ofnmlen = file_len; - o__1.ofnm = file; - o__1.orl = 0; - o__1.osta = "OLD"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = 0; - o__1.oblnk = 0; - iostat = f_open(&o__1); - -/* If we could not open the file, we don't have a clue about */ -/* the file architecture and type. */ - - if (iostat != 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", ( - ftnlen)48); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - -/* Try to read from the file. */ - - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *number; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100002; - } - iostat = do_fio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100002; - } - iostat = e_rsfe(); -L100002: - ; - } - } else { - seqopn = TRUE_; - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *number; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100003; - } - iostat = do_fio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100003; - } - iostat = e_rsfe(); -L100003: - ; - } - -/* If we had an error while reading, we don't recognize this file. */ - - if (iostat != 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - cl__1.cerr = 0; - cl__1.cunit = *number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Attempt to read from file '#' failed. IOSTAT = #.", (ftnlen) - 49); - errch_("#", file, (ftnlen)1, file_len); - errint_("#", &iostat, (ftnlen)1); - sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - -/* Loop until a known NAIF file ID word is found. */ - - while(check) { - -/* At this point, we have a candidate for an ID word. To avoid */ -/* difficulties with Fortran I/O and other things, we will now */ -/* replace any non printing ASCII characters with blanks. */ - - for (i__ = 1; i__ <= 12; ++i__) { - if (*(unsigned char *)&tmpwrd[i__ - 1] < 32 || *(unsigned char *)& - tmpwrd[i__ - 1] > 126) { - *(unsigned char *)&tmpwrd[i__ - 1] = ' '; - } - } - -/* Identify the architecture and type, if we can. */ - - ljust_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12); - ucase_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12); - nextwd_(tmpwrd, idword, tmpwrd, (ftnlen)12, (ftnlen)12, (ftnlen)12); - if (s_cmp(idword, "DAFETF", (ftnlen)12, (ftnlen)6) == 0) { - -/* We have a DAF encoded transfer file. */ - - s_copy(arch, "XFR", arch_len, (ftnlen)3); - s_copy(type__, "DAF", type_len, (ftnlen)3); - check = FALSE_; - } else if (s_cmp(idword, "DASETF", (ftnlen)12, (ftnlen)6) == 0) { - -/* We have a DAS encoded transfer file. */ - - s_copy(arch, "XFR", arch_len, (ftnlen)3); - s_copy(type__, "DAS", type_len, (ftnlen)3); - check = FALSE_; - } else if (s_cmp(idword, "'NAIF/DAF'", (ftnlen)10, (ftnlen)10) == 0) { - -/* We have an old DAF decimal text file. */ - - s_copy(arch, "DEC", arch_len, (ftnlen)3); - s_copy(type__, "DAF", type_len, (ftnlen)3); - check = FALSE_; - } else if (s_cmp(idword, "NAIF/DAS", (ftnlen)8, (ftnlen)8) == 0) { - -/* We have a pre release DAS binary file. */ - - s_copy(arch, "DAS", arch_len, (ftnlen)3); - s_copy(type__, "PRE", type_len, (ftnlen)3); - check = FALSE_; - } else { - -/* Get the architecture and type from the ID word, if we can. */ - - idw2at_(idword, arch, type__, (ftnlen)8, arch_len, type_len); - if (s_cmp(arch, "DAF", arch_len, (ftnlen)3) == 0 && s_cmp(type__, - "?", type_len, (ftnlen)1) == 0) { - check = FALSE_; - } else { - -/* No identification on line. Read another line. */ - - if (seqopn) { - ci__1.cierr = 1; - ci__1.ciend = 1; - ci__1.ciunit = *number; - ci__1.cifmt = "(A)"; - iostat = s_rsfe(&ci__1); - if (iostat != 0) { - goto L100004; - } - iostat = do_fio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100004; - } - iostat = e_rsfe(); -L100004: - ; - } else { - io___11.ciunit = *number; - iostat = s_rdue(&io___11); - if (iostat != 0) { - goto L100005; - } - iostat = do_uio(&c__1, tmpwrd, (ftnlen)12); - if (iostat != 0) { - goto L100005; - } - iostat = e_rdue(); -L100005: - ; - } - -/* If IOSTAT is a negative value, we probably hit an */ -/* end-of-file. Error out. */ - - if (iostat < 0) { - s_copy(arch, "?", arch_len, (ftnlen)1); - s_copy(type__, "?", type_len, (ftnlen)1); - cl__1.cerr = 0; - cl__1.cunit = *number; - cl__1.csta = 0; - f_clos(&cl__1); - setmsg_("Encountered end-of-file of # before finding kn" - "own SPICE ID word.", (ftnlen)65); - errch_("#", file, (ftnlen)1, file_len); - sigerr_("SPICE(ENDOFFILE)", (ftnlen)16); - chkout_("ZZGETFAT", (ftnlen)8); - return 0; - } - } - } - } - chkout_("ZZGETFAT", (ftnlen)8); - return 0; -} /* zzgetfat_ */ - diff --git a/ext/spice/src/csupport/zznsppok.c b/ext/spice/src/csupport/zznsppok.c deleted file mode 100644 index 46fd9e1993..0000000000 --- a/ext/spice/src/csupport/zznsppok.c +++ /dev/null @@ -1,159 +0,0 @@ -/* zznsppok.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZNSPPOK (Private Routine -- NSPIO Port) */ -integer zznsppok_(char *port, integer *nports, char *ports, ftnlen port_len, - ftnlen ports_len) -{ - /* System generated locals */ - integer ret_val; - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, - ftnlen, ftnlen); - integer id; - extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); - extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, - ftnlen), setmsg_(char *, ftnlen); - -/* $ Abstract */ - -/* Find the integer associated with an NSPIO PORT 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 */ - -/* TEXT */ -/* UTILITY */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* VARIABLE I/O DESCRIPTION */ -/* -------- --- -------------------------------------------------- */ -/* PORT I is a string indicating the port to find. */ -/* NPORTS I is the number of ports in the PORTS array. */ -/* PORTS I an array of strings containing the possible ports. */ - -/* The function returns an integer that represents the position */ -/* of PORT in the PORTS array. */ - -/* $ Detailed_Input */ - -/* PORT is the name of a port supported by the NSPIO */ -/* umbrella, and is an entry in the PORTS array. */ - -/* NPORTS is the number of entries in the PORTS arrray. */ - -/* PORTS is a list of acceptable PORTs supported by the */ -/* NSPIO umbrella. */ - -/* $ Detailed_Output */ - -/* The function returns an integer that represents the position */ -/* of PORT in the PORTS array. This integer is used in NSPIO */ -/* to access information in parallel arrays. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Files */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If PORT is not found in the PORTS array, then the error */ -/* NSPIO(UNKNOWNPORT) is signaled. */ - -/* $ Particulars */ - -/* This private routine is simply a place to consolidate the */ -/* PORT to integer code conversion. */ - -/* $ Examples */ - -/* This routine is a simple private routine. See NSPIO and its */ -/* entry points for samples of its usage. */ - -/* $ Restrictions */ - -/* 1) NPORTS must not be greater than the number of available */ -/* members of the PORTS array, else memory violation will */ -/* occur. */ - -/* $ Author_and_Institution */ - -/* F.S. Turner (JPL) */ - -/* $ Literature_References */ - -/* None. */ - -/* $ Version */ - -/* - NSPIO Version 2.0.0, 01-FEB-2000 (FST) */ - - -/* -& */ - -/* SPICELIB Functions */ - - -/* Local Variables */ - - -/* Find PORT in the PORTS array. */ - - id = isrchc_(port, nports, ports, port_len, ports_len); - -/* Set ZZNSPPOK to the return value. */ - - ret_val = id; - -/* Check to see if we were able to find the integer ID of PORT. */ -/* If not, use discovery check in/out and signal an error. */ - - if (id == 0) { - chkin_("ZZNSPPOK", (ftnlen)8); - setmsg_("$ is an unrecognized port.", (ftnlen)26); - errch_("$", port, (ftnlen)1, port_len); - sigerr_("NSPIO(UNKNOWNPORT)", (ftnlen)18); - chkout_("ZZNSPPOK", (ftnlen)8); - } - return ret_val; -} /* zznsppok_ */ - diff --git a/ext/spice/src/csupport/zztxtopn.c b/ext/spice/src/csupport/zztxtopn.c deleted file mode 100644 index b8e764d010..0000000000 --- a/ext/spice/src/csupport/zztxtopn.c +++ /dev/null @@ -1,290 +0,0 @@ -/* zztxtopn.f -- translated by f2c (version 19980913). - You must link the resulting object file with the libraries: - -lf2c -lm (in that order) -*/ - -#include "f2c.h" - -/* $Procedure ZZTXTOPN ( Private Routine -- Text file, open new ) */ -/* Subroutine */ int zztxtopn_(char *fname, integer *unit, logical *succss, - ftnlen fname_len) -{ - /* System generated locals */ - olist o__1; - - /* Builtin functions */ - integer s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *); - - /* Local variables */ - extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *, - ftnlen), chkout_(char *, ftnlen), getlun_(integer *), setmsg_( - char *, ftnlen); - integer iostat; - extern logical return_(void); - -/* $ Abstract */ - -/* Open a new text file for subsequent write access, without */ -/* signaling an error on failure. */ - -/* $ 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 */ - -/* FILES */ -/* TEXT */ - -/* $ Declarations */ -/* $ Brief_I/O */ - -/* Variable I/O Description */ -/* -------- --- -------------------------------------------------- */ -/* FNAME I Name of file. */ -/* UNIT O Logical unit. */ -/* SUCCSS O Logical that indicates successful open. */ - -/* $ Detailed_Input */ - -/* FNAME is the name of the new text file to be opened. */ - -/* $ Detailed_Output */ - -/* UNIT is the logical unit connected to the opened file. */ - -/* SUCCSS is the logical flag that indicates whether the */ -/* file was opened successfully or not. */ - -/* $ Parameters */ - -/* None. */ - -/* $ Exceptions */ - -/* 1) If the file cannot be opened, SUCCSS is returned .FALSE. */ - -/* 2) If FNAME is a blank string, the error SPICE(BLANKFILENAME) is */ -/* signaled. */ - -/* $ Files */ - -/* See FNAME and UNIT above. */ - -/* $ Particulars */ - -/* In SPICELIB, a text file is formatted and sequential and may */ -/* contain only printable ASCII characters and blanks (ASCII 32-127). */ -/* When printing a text file, records are single spaced; the first */ -/* character will not be interpreted as a carriage control character. */ - -/* ZZTXTOPN opens a new text file and makes use of the SPICELIB */ -/* mechanism for coordinating the use of logical units. */ - -/* System Dependencies */ -/* =================== */ - -/* The open statement will include the following keyword = value */ -/* pairs: */ - -/* UNIT = UNIT */ -/* FILE = FNAME */ -/* FORM = 'FORMATTED' */ -/* ACCESS = 'SEQUENTIAL' */ -/* STATUS = 'NEW' */ -/* IOSTAT = IOSTAT */ - -/* In addition, the statement will include */ - -/* CARRIAGECONTROL = 'LIST' */ - -/* for the Vax and Macintosh. */ - -/* $ Examples */ - -/* The following example reads a line from an input file, */ -/* 'INPUT.TXT', and writes it to an output file, 'OUTPUT.TXT'. */ - -/* CALL TXTOPR ( 'INPUT.TXT', IN ) */ -/* CALL ZZTXTOPN ( 'OUTPUT.TXT', OUT, OK ) */ - -/* IF ( OK ) THEN */ - -/* READ ( IN, FMT='(A)' ) LINE */ -/* WRITE ( OUT, FMT='(A)' ) LINE */ - -/* END IF */ - -/* CLOSE ( IN ) */ -/* CLOSE ( OUT ) */ - -/* $ Restrictions */ - -/* None. */ - -/* $ Literature_References */ - -/* 1. "Absoft FORTRAN 77 Language Reference Manual", page 7-12 for */ -/* the NeXT. */ - -/* $ Author_and_Institution */ - -/* J.E. McLean (JPL) */ -/* H.A. Neilan (JPL) */ - -/* $ Version */ - -/* - NSPIO Version 2.20.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL. */ - -/* - NSPIO Version 2.19.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-CC_C. */ - -/* - NSPIO Version 2.18.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ - -/* - NSPIO Version 2.17.0, 13-MAY-2010 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ - -/* - NSPIO Version 2.16.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-WINDOWS-64BIT-IFORT. */ - -/* - NSPIO Version 2.15.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GFORTRAN. */ - -/* - NSPIO Version 2.14.0, 13-MAY-2010 (BVS) */ - -/* Updated for PC-64BIT-MS_C. */ - -/* - NSPIO Version 2.13.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-INTEL_C. */ - -/* - NSPIO Version 2.12.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-IFORT. */ - -/* - NSPIO Version 2.11.0, 13-MAY-2010 (BVS) */ - -/* Updated for MAC-OSX-64BIT-GFORTRAN. */ - -/* - NSPIO Version 2.10.0, 18-MAR-2009 (BVS) */ - -/* Updated for PC-LINUX-GFORTRAN. */ - -/* - NSPIO Version 2.9.0, 18-MAR-2009 (BVS) */ - -/* Updated for MAC-OSX-GFORTRAN. */ - -/* - NSPIO Version 2.8.0, 19-FEB-2008 (BVS) */ - -/* Updated for PC-LINUX-IFORT. */ - -/* - NSPIO Version 2.7.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-LINUX-64BIT-GCC_C. */ - -/* - NSPIO Version 2.6.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-INTEL_C. */ - -/* - NSPIO Version 2.5.0, 14-NOV-2006 (BVS) */ - -/* Updated for MAC-OSX-IFORT. */ - -/* - NSPIO Version 2.4.0, 14-NOV-2006 (BVS) */ - -/* Updated for PC-WINDOWS-IFORT. */ - -/* - NSPIO Version 2.3.0, 26-OCT-2005 (BVS) */ - -/* Updated for SUN-SOLARIS-64BIT-GCC_C. */ - -/* - NSPIO Version 2.2.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN_C. */ - -/* - NSPIO Version 2.1.0, 03-JAN-2005 (BVS) */ - -/* Updated for PC-CYGWIN. */ - -/* - NSPIO Version 2.0.1, 17-JUL-2002 (BVS) */ - -/* Added MAC-OSX environments. */ - -/* - NSPIO Version 2.0.0, 10-FEB-2000 (FST) */ - -/* -& */ - -/* SPICELIB functions */ - - -/* Local variables */ - - -/* Standard SPICE error handling. */ - - if (return_()) { - return 0; - } else { - chkin_("ZZTXTOPN", (ftnlen)8); - } - *succss = TRUE_; - if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { - *succss = FALSE_; - setmsg_("A blank string is unacceptable as a file name", (ftnlen)45); - sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); - chkout_("ZZTXTOPN", (ftnlen)8); - return 0; - } - getlun_(unit); - o__1.oerr = 1; - o__1.ounit = *unit; - o__1.ofnmlen = fname_len; - o__1.ofnm = fname; - o__1.orl = 0; - o__1.osta = "NEW"; - o__1.oacc = "SEQUENTIAL"; - o__1.ofm = "FORMATTED"; - o__1.oblnk = 0; - iostat = f_open(&o__1); - if (iostat != 0) { - *succss = FALSE_; - chkout_("ZZTXTOPN", (ftnlen)8); - return 0; - } - chkout_("ZZTXTOPN", (ftnlen)8); - return 0; -} /* zztxtopn_ */ -